diff -Nru gnucobol-4.0~early~20200606/ABOUT-NLS gnucobol-5/ABOUT-NLS --- gnucobol-4.0~early~20200606/ABOUT-NLS 2020-06-06 20:52:02.000000000 +0000 +++ gnucobol-5/ABOUT-NLS 1970-01-01 00:00:00.000000000 +0000 @@ -1,1379 +0,0 @@ -1 Notes on the Free Translation Project -*************************************** - -Free software is going international! The Free Translation Project is a -way to get maintainers of free software, translators, and users all -together, so that free software will gradually become able to speak many -languages. A few packages already provide translations for their -messages. - - If you found this 'ABOUT-NLS' file inside a distribution, you may -assume that the distributed package does use GNU 'gettext' internally, -itself available at your nearest GNU archive site. But you do _not_ -need to install GNU 'gettext' prior to configuring, installing or using -this package with messages translated. - - Installers will find here some useful hints. These notes also -explain how users should proceed for getting the programs to use the -available translations. They tell how people wanting to contribute and -work on translations can contact the appropriate team. - -1.1 INSTALL Matters -=================== - -Some packages are "localizable" when properly installed; the programs -they contain can be made to speak your own native language. Most such -packages use GNU 'gettext'. Other packages have their own ways to -internationalization, predating GNU 'gettext'. - - By default, this package will be installed to allow translation of -messages. It will automatically detect whether the system already -provides the GNU 'gettext' functions. Installers may use special -options at configuration time for changing the default behaviour. The -command: - - ./configure --disable-nls - -will _totally_ disable translation of messages. - - When you already have GNU 'gettext' installed on your system and run -configure without an option for your new package, 'configure' will -probably detect the previously built and installed 'libintl' library and -will decide to use it. If not, you may have to to use the -'--with-libintl-prefix' option to tell 'configure' where to look for it. - - Internationalized packages usually have many 'po/LL.po' files, where -LL gives an ISO 639 two-letter code identifying the language. Unless -translations have been forbidden at 'configure' time by using the -'--disable-nls' switch, all available translations are installed -together with the package. However, the environment variable 'LINGUAS' -may be set, prior to configuration, to limit the installed set. -'LINGUAS' should then contain a space separated list of two-letter -codes, stating which languages are allowed. - -1.2 Using This Package -====================== - -As a user, if your language has been installed for this package, you -only have to set the 'LANG' environment variable to the appropriate -'LL_CC' combination. If you happen to have the 'LC_ALL' or some other -'LC_xxx' environment variables set, you should unset them before setting -'LANG', otherwise the setting of 'LANG' will not have the desired -effect. Here 'LL' is an ISO 639 two-letter language code, and 'CC' is -an ISO 3166 two-letter country code. For example, let's suppose that -you speak German and live in Germany. At the shell prompt, merely -execute 'setenv LANG de_DE' (in 'csh'), 'export LANG; LANG=de_DE' (in -'sh') or 'export LANG=de_DE' (in 'bash'). This can be done from your -'.login' or '.profile' file, once and for all. - - You might think that the country code specification is redundant. -But in fact, some languages have dialects in different countries. For -example, 'de_AT' is used for Austria, and 'pt_BR' for Brazil. The -country code serves to distinguish the dialects. - - The locale naming convention of 'LL_CC', with 'LL' denoting the -language and 'CC' denoting the country, is the one use on systems based -on GNU libc. On other systems, some variations of this scheme are used, -such as 'LL' or 'LL_CC.ENCODING'. You can get the list of locales -supported by your system for your language by running the command -'locale -a | grep '^LL''. - - Not all programs have translations for all languages. By default, an -English message is shown in place of a nonexistent translation. If you -understand other languages, you can set up a priority list of languages. -This is done through a different environment variable, called -'LANGUAGE'. GNU 'gettext' gives preference to 'LANGUAGE' over 'LANG' -for the purpose of message handling, but you still need to have 'LANG' -set to the primary language; this is required by other parts of the -system libraries. For example, some Swedish users who would rather read -translations in German than English for when Swedish is not available, -set 'LANGUAGE' to 'sv:de' while leaving 'LANG' to 'sv_SE'. - - Special advice for Norwegian users: The language code for Norwegian -bokma*l changed from 'no' to 'nb' recently (in 2003). During the -transition period, while some message catalogs for this language are -installed under 'nb' and some older ones under 'no', it's recommended -for Norwegian users to set 'LANGUAGE' to 'nb:no' so that both newer and -older translations are used. - - In the 'LANGUAGE' environment variable, but not in the 'LANG' -environment variable, 'LL_CC' combinations can be abbreviated as 'LL' to -denote the language's main dialect. For example, 'de' is equivalent to -'de_DE' (German as spoken in Germany), and 'pt' to 'pt_PT' (Portuguese -as spoken in Portugal) in this context. - -1.3 Translating Teams -===================== - -For the Free Translation Project to be a success, we need interested -people who like their own language and write it well, and who are also -able to synergize with other translators speaking the same language. -Each translation team has its own mailing list. The up-to-date list of -teams can be found at the Free Translation Project's homepage, -'https://translationproject.org/', in the "Teams" area. - - If you'd like to volunteer to _work_ at translating messages, you -should become a member of the translating team for your own language. -The subscribing address is _not_ the same as the list itself, it has -'-request' appended. For example, speakers of Swedish can send a -message to 'sv-request@li.org', having this message body: - - subscribe - - Keep in mind that team members are expected to participate _actively_ -in translations, or at solving translational difficulties, rather than -merely lurking around. If your team does not exist yet and you want to -start one, or if you are unsure about what to do or how to get started, -please write to 'coordinator@translationproject.org' to reach the -coordinator for all translator teams. - - The English team is special. It works at improving and uniformizing -the terminology in use. Proven linguistic skills are praised more than -programming skills, here. - -1.4 Available Packages -====================== - -Languages are not equally supported in all packages. The following -matrix shows the current state of internationalization, as of Jun 2014. -The matrix shows, in regard of each package, for which languages PO -files have been submitted to translation coordination, with a -translation percentage of at least 50%. - - Ready PO files af am an ar as ast az be bg bn bn_IN bs ca crh cs - +---------------------------------------------------+ - a2ps | [] [] [] | - aegis | | - anubis | | - aspell | [] [] [] | - bash | [] [] [] | - bfd | | - binutils | [] | - bison | | - bison-runtime | [] | - buzztrax | [] | - ccd2cue | | - ccide | | - cflow | | - clisp | | - coreutils | [] [] | - cpio | | - cppi | | - cpplib | [] | - cryptsetup | [] | - datamash | | - denemo | [] [] | - dfarc | [] | - dialog | [] [] [] | - dico | | - diffutils | [] | - dink | [] | - direvent | | - doodle | [] | - dos2unix | | - dos2unix-man | | - e2fsprogs | [] [] | - enscript | [] | - exif | [] | - fetchmail | [] [] | - findutils | [] | - flex | [] | - freedink | [] [] | - fusionforge | | - gas | | - gawk | [] | - gcal | [] | - gcc | | - gdbm | | - gettext-examples | [] [] [] [] [] | - gettext-runtime | [] [] [] | - gettext-tools | [] [] | - gjay | | - glunarclock | [] [] [] | - gnubiff | [] | - gnubik | [] | - gnucash | () () [] | - gnuchess | | - gnulib | [] | - gnunet | | - gnunet-gtk | | - gold | | - gphoto2 | [] | - gprof | [] | - gramadoir | | - grep | [] [] [] | - grub | [] | - gsasl | | - gss | | - gst-plugins-bad | [] [] | - gst-plugins-base | [] [] [] | - gst-plugins-good | [] [] [] | - gst-plugins-ugly | [] [] [] | - gstreamer | [] [] [] [] | - gtick | [] | - gtkam | [] [] | - gtkspell | [] [] [] [] [] | - guix | | - guix-packages | | - gutenprint | [] | - hello | [] | - help2man | | - help2man-texi | | - hylafax | | - idutils | | - iso_15924 | [] | - iso_3166 | [] [] [] [] [] [] [] [] [] [] | - iso_3166_2 | | - iso_4217 | [] | - iso_639 | [] [] [] [] [] [] [] [] [] | - iso_639_3 | [] [] | - iso_639_5 | | - jwhois | | - kbd | [] | - klavaro | [] [] [] [] [] | - ld | [] | - leafpad | [] [] [] [] | - libc | [] [] [] | - libexif | () | - libextractor | | - libgnutls | [] | - libgphoto2 | [] | - libgphoto2_port | [] | - libgsasl | | - libiconv | [] [] | - libidn | [] | - liferea | [] [] [] [] | - lilypond | [] [] | - lordsawar | [] | - lprng | | - lynx | [] [] | - m4 | [] | - mailfromd | | - mailutils | | - make | [] | - man-db | [] [] | - man-db-manpages | | - midi-instruments | [] [] [] | - minicom | [] | - mkisofs | [] | - myserver | [] | - nano | [] [] [] | - opcodes | | - parted | [] | - pies | | - pnmixer | | - popt | [] | - procps-ng | | - procps-ng-man | | - psmisc | [] | - pspp | [] | - pushover | [] | - pwdutils | | - pyspread | | - radius | [] | - recode | [] [] [] | - recutils | | - rpm | | - rush | | - sarg | | - sed | [] [] [] [] | - sharutils | [] | - shishi | | - skribilo | | - solfege | [] [] | - solfege-manual | | - spotmachine | | - sudo | [] [] | - sudoers | [] [] | - sysstat | [] | - tar | [] [] [] | - texinfo | [] [] | - texinfo_document | [] [] | - tigervnc | [] | - tin | | - tin-man | | - tracgoogleappsa... | | - trader | | - util-linux | [] | - ve | | - vice | | - vmm | | - vorbis-tools | [] | - wastesedge | | - wcd | | - wcd-man | | - wdiff | [] [] | - wget | [] | - wyslij-po | | - xboard | | - xdg-user-dirs | [] [] [] [] [] [] [] [] [] [] | - xkeyboard-config | [] [] [] | - +---------------------------------------------------+ - af am an ar as ast az be bg bn bn_IN bs ca crh cs - 4 0 2 5 3 11 0 8 25 3 3 1 55 4 74 - - da de el en en_GB en_ZA eo es et eu fa fi fr - +--------------------------------------------------+ - a2ps | [] [] [] [] [] [] [] [] [] | - aegis | [] [] [] [] | - anubis | [] [] [] [] [] | - aspell | [] [] [] [] [] [] [] | - bash | [] [] [] | - bfd | [] [] [] [] | - binutils | [] [] [] | - bison | [] [] [] [] [] [] [] [] | - bison-runtime | [] [] [] [] [] [] [] [] | - buzztrax | [] [] [] [] | - ccd2cue | [] [] [] [] | - ccide | [] [] [] [] [] [] | - cflow | [] [] [] [] [] | - clisp | [] [] [] [] [] | - coreutils | [] [] [] [] [] | - cpio | [] [] [] [] [] | - cppi | [] [] [] [] [] | - cpplib | [] [] [] [] [] [] | - cryptsetup | [] [] [] [] [] | - datamash | [] [] [] [] | - denemo | [] | - dfarc | [] [] [] [] [] [] | - dialog | [] [] [] [] [] [] [] [] [] | - dico | [] [] [] [] | - diffutils | [] [] [] [] [] [] | - dink | [] [] [] [] [] [] | - direvent | [] [] [] [] | - doodle | [] [] [] [] | - dos2unix | [] [] [] [] [] | - dos2unix-man | [] [] [] | - e2fsprogs | [] [] [] [] [] | - enscript | [] [] [] [] [] [] | - exif | [] [] [] [] [] [] | - fetchmail | [] () [] [] [] [] [] | - findutils | [] [] [] [] [] [] [] [] | - flex | [] [] [] [] [] [] | - freedink | [] [] [] [] [] [] [] [] | - fusionforge | [] [] [] | - gas | [] [] [] | - gawk | [] [] [] [] [] | - gcal | [] [] [] [] | - gcc | [] | - gdbm | [] [] [] [] [] | - gettext-examples | [] [] [] [] [] [] [] | - gettext-runtime | [] [] [] [] [] [] | - gettext-tools | [] [] [] [] [] | - gjay | [] [] [] [] | - glunarclock | [] [] [] [] [] | - gnubiff | () [] [] () | - gnubik | [] [] [] [] [] | - gnucash | [] () () () () () () | - gnuchess | [] [] [] [] | - gnulib | [] [] [] [] [] [] [] | - gnunet | [] | - gnunet-gtk | [] | - gold | [] [] [] | - gphoto2 | [] () [] [] | - gprof | [] [] [] [] [] [] | - gramadoir | [] [] [] [] [] | - grep | [] [] [] [] [] [] [] | - grub | [] [] [] [] [] | - gsasl | [] [] [] [] [] | - gss | [] [] [] [] [] | - gst-plugins-bad | [] [] [] | - gst-plugins-base | [] [] [] [] [] [] | - gst-plugins-good | [] [] [] [] [] [] [] | - gst-plugins-ugly | [] [] [] [] [] [] [] [] | - gstreamer | [] [] [] [] [] [] [] | - gtick | [] () [] [] [] | - gtkam | [] () [] [] [] [] | - gtkspell | [] [] [] [] [] [] [] [] | - guix | [] [] | - guix-packages | | - gutenprint | [] [] [] [] | - hello | [] [] [] [] [] [] [] [] | - help2man | [] [] [] [] [] [] [] | - help2man-texi | [] [] [] | - hylafax | [] [] | - idutils | [] [] [] [] [] | - iso_15924 | [] () [] [] () [] () | - iso_3166 | [] () [] [] [] [] () [] () | - iso_3166_2 | [] () () () | - iso_4217 | [] () [] [] [] () [] () | - iso_639 | [] () [] [] () [] () | - iso_639_3 | () () () | - iso_639_5 | () () () | - jwhois | [] [] [] [] [] | - kbd | [] [] [] [] [] [] | - klavaro | [] [] [] [] [] [] [] | - ld | [] [] [] [] | - leafpad | [] [] [] [] [] [] [] [] | - libc | [] [] [] [] [] | - libexif | [] [] () [] [] | - libextractor | [] | - libgnutls | [] [] [] [] | - libgphoto2 | [] () [] | - libgphoto2_port | [] () [] [] [] [] | - libgsasl | [] [] [] [] [] | - libiconv | [] [] [] [] [] [] [] | - libidn | [] [] [] [] [] | - liferea | [] () [] [] [] [] [] | - lilypond | [] [] [] [] [] [] | - lordsawar | [] [] | - lprng | | - lynx | [] [] [] [] [] [] | - m4 | [] [] [] [] [] [] | - mailfromd | [] | - mailutils | [] [] [] [] | - make | [] [] [] [] [] | - man-db | [] [] [] [] | - man-db-manpages | [] [] | - midi-instruments | [] [] [] [] [] [] [] [] [] | - minicom | [] [] [] [] [] | - mkisofs | [] [] [] | - myserver | [] [] [] [] | - nano | [] [] [] [] [] [] [] | - opcodes | [] [] [] [] [] | - parted | [] [] [] | - pies | [] | - pnmixer | [] [] | - popt | [] [] [] [] [] [] | - procps-ng | [] [] | - procps-ng-man | [] [] | - psmisc | [] [] [] [] [] [] [] | - pspp | [] [] [] | - pushover | () [] [] [] | - pwdutils | [] [] [] | - pyspread | [] [] [] | - radius | [] [] | - recode | [] [] [] [] [] [] [] | - recutils | [] [] [] [] | - rpm | [] [] [] [] [] | - rush | [] [] [] | - sarg | [] [] | - sed | [] [] [] [] [] [] [] [] | - sharutils | [] [] [] [] | - shishi | [] [] [] | - skribilo | [] [] [] | - solfege | [] [] [] [] [] [] [] [] | - solfege-manual | [] [] [] [] [] | - spotmachine | [] [] [] [] [] | - sudo | [] [] [] [] [] [] | - sudoers | [] [] [] [] [] [] | - sysstat | [] [] [] [] [] [] | - tar | [] [] [] [] [] [] [] | - texinfo | [] [] [] [] [] | - texinfo_document | [] [] [] [] | - tigervnc | [] [] [] [] [] [] | - tin | [] [] [] [] | - tin-man | [] | - tracgoogleappsa... | [] [] [] [] [] | - trader | [] [] [] [] [] [] | - util-linux | [] [] [] [] | - ve | [] [] [] [] [] | - vice | () () () | - vmm | [] [] | - vorbis-tools | [] [] [] [] | - wastesedge | [] | - wcd | [] [] [] [] | - wcd-man | [] | - wdiff | [] [] [] [] [] [] [] | - wget | [] [] [] [] [] [] | - wyslij-po | [] [] [] [] | - xboard | [] [] [] [] | - xdg-user-dirs | [] [] [] [] [] [] [] [] [] [] | - xkeyboard-config | [] [] [] [] [] [] [] | - +--------------------------------------------------+ - da de el en en_GB en_ZA eo es et eu fa fi fr - 119 131 32 1 6 0 94 95 22 13 4 102 139 - - ga gd gl gu he hi hr hu hy ia id is it ja ka kk - +-------------------------------------------------+ - a2ps | [] [] [] [] | - aegis | [] | - anubis | [] [] [] [] | - aspell | [] [] [] [] [] | - bash | [] [] [] [] | - bfd | [] [] | - binutils | [] [] [] | - bison | [] | - bison-runtime | [] [] [] [] [] [] [] [] | - buzztrax | | - ccd2cue | [] | - ccide | [] [] | - cflow | [] [] [] | - clisp | | - coreutils | [] [] | - cpio | [] [] [] [] [] [] | - cppi | [] [] [] [] [] | - cpplib | [] [] | - cryptsetup | [] | - datamash | | - denemo | [] | - dfarc | [] [] [] | - dialog | [] [] [] [] [] [] [] [] [] [] | - dico | | - diffutils | [] [] [] [] | - dink | [] | - direvent | [] | - doodle | [] [] | - dos2unix | [] [] | - dos2unix-man | | - e2fsprogs | [] [] | - enscript | [] [] [] | - exif | [] [] [] [] [] [] | - fetchmail | [] [] [] | - findutils | [] [] [] [] [] [] [] | - flex | [] | - freedink | [] [] [] [] | - fusionforge | | - gas | [] | - gawk | [] () [] | - gcal | | - gcc | | - gdbm | | - gettext-examples | [] [] [] [] [] [] [] | - gettext-runtime | [] [] [] [] [] [] [] | - gettext-tools | [] [] [] | - gjay | [] | - glunarclock | [] [] [] [] [] [] | - gnubiff | [] [] () | - gnubik | [] [] [] | - gnucash | () () () () () | - gnuchess | | - gnulib | [] [] [] [] [] | - gnunet | | - gnunet-gtk | | - gold | [] [] | - gphoto2 | [] [] [] [] | - gprof | [] [] [] [] | - gramadoir | [] [] [] | - grep | [] [] [] [] [] [] [] | - grub | [] [] [] | - gsasl | [] [] [] [] [] | - gss | [] [] [] [] [] | - gst-plugins-bad | [] [] [] | - gst-plugins-base | [] [] [] [] | - gst-plugins-good | [] [] [] [] [] [] | - gst-plugins-ugly | [] [] [] [] [] [] | - gstreamer | [] [] [] [] [] | - gtick | [] [] [] [] [] | - gtkam | [] [] [] [] [] | - gtkspell | [] [] [] [] [] [] [] [] [] [] | - guix | | - guix-packages | | - gutenprint | [] [] [] | - hello | [] [] [] [] [] | - help2man | [] [] [] | - help2man-texi | | - hylafax | [] | - idutils | [] [] | - iso_15924 | [] [] [] [] [] [] | - iso_3166 | [] [] [] [] [] [] [] [] [] [] [] [] [] | - iso_3166_2 | [] [] | - iso_4217 | [] [] [] [] [] [] | - iso_639 | [] [] [] [] [] [] [] [] [] | - iso_639_3 | [] [] | - iso_639_5 | | - jwhois | [] [] [] [] | - kbd | [] [] [] | - klavaro | [] [] [] [] [] | - ld | [] [] [] [] | - leafpad | [] [] [] [] [] [] [] () | - libc | [] [] [] [] [] | - libexif | [] | - libextractor | | - libgnutls | [] | - libgphoto2 | [] [] | - libgphoto2_port | [] [] | - libgsasl | [] [] [] [] | - libiconv | [] [] [] [] [] [] [] | - libidn | [] [] [] [] | - liferea | [] [] [] [] [] | - lilypond | [] | - lordsawar | | - lprng | [] | - lynx | [] [] [] [] | - m4 | [] [] [] [] [] | - mailfromd | | - mailutils | | - make | [] [] [] [] | - man-db | [] [] | - man-db-manpages | [] [] | - midi-instruments | [] [] [] [] [] [] [] [] [] | - minicom | [] [] [] | - mkisofs | [] [] | - myserver | [] | - nano | [] [] [] [] [] [] | - opcodes | [] [] [] | - parted | [] [] [] [] [] | - pies | | - pnmixer | [] [] | - popt | [] [] [] [] [] [] [] [] [] [] | - procps-ng | | - procps-ng-man | | - psmisc | [] [] [] [] | - pspp | [] [] | - pushover | [] | - pwdutils | [] | - pyspread | | - radius | [] | - recode | [] [] [] [] [] [] [] | - recutils | | - rpm | [] | - rush | [] | - sarg | | - sed | [] [] [] [] [] [] [] | - sharutils | | - shishi | | - skribilo | [] | - solfege | [] [] | - solfege-manual | | - spotmachine | | - sudo | [] [] [] [] | - sudoers | [] [] [] | - sysstat | [] [] [] [] | - tar | [] [] [] [] [] [] | - texinfo | [] [] [] | - texinfo_document | [] [] [] | - tigervnc | | - tin | | - tin-man | | - tracgoogleappsa... | [] [] [] [] | - trader | [] [] | - util-linux | [] | - ve | [] | - vice | () () | - vmm | | - vorbis-tools | [] [] | - wastesedge | [] | - wcd | | - wcd-man | | - wdiff | [] [] [] | - wget | [] [] [] [] | - wyslij-po | [] [] [] | - xboard | | - xdg-user-dirs | [] [] [] [] [] [] [] [] [] [] [] [] [] [] | - xkeyboard-config | [] [] [] [] [] [] | - +-------------------------------------------------+ - ga gd gl gu he hi hr hu hy ia id is it ja ka kk - 35 2 47 4 8 2 60 71 2 6 81 11 87 57 0 3 - - kn ko ku ky lg lt lv mk ml mn mr ms mt nb ne nl - +--------------------------------------------------+ - a2ps | [] [] | - aegis | [] | - anubis | [] [] [] | - aspell | [] [] | - bash | [] [] | - bfd | | - binutils | | - bison | [] | - bison-runtime | [] [] [] [] [] [] | - buzztrax | | - ccd2cue | | - ccide | [] [] | - cflow | [] | - clisp | [] | - coreutils | [] [] | - cpio | [] | - cppi | | - cpplib | [] | - cryptsetup | [] | - datamash | [] [] | - denemo | | - dfarc | [] [] | - dialog | [] [] [] [] [] [] | - dico | | - diffutils | [] [] [] | - dink | [] | - direvent | [] | - doodle | [] | - dos2unix | [] [] | - dos2unix-man | [] | - e2fsprogs | [] | - enscript | [] | - exif | [] [] [] | - fetchmail | [] | - findutils | [] [] | - flex | [] | - freedink | [] [] | - fusionforge | | - gas | | - gawk | [] | - gcal | | - gcc | | - gdbm | | - gettext-examples | [] [] [] [] [] [] | - gettext-runtime | [] [] [] | - gettext-tools | [] | - gjay | | - glunarclock | [] [] | - gnubiff | [] | - gnubik | [] [] | - gnucash | () () () () () () () [] | - gnuchess | [] [] | - gnulib | [] | - gnunet | | - gnunet-gtk | | - gold | | - gphoto2 | [] | - gprof | [] [] | - gramadoir | [] | - grep | [] [] | - grub | [] [] [] | - gsasl | [] | - gss | | - gst-plugins-bad | [] [] [] | - gst-plugins-base | [] [] [] | - gst-plugins-good | [] [] [] [] | - gst-plugins-ugly | [] [] [] [] [] | - gstreamer | [] [] [] | - gtick | [] | - gtkam | [] [] | - gtkspell | [] [] [] [] [] [] [] | - guix | | - guix-packages | | - gutenprint | [] | - hello | [] [] [] | - help2man | [] | - help2man-texi | | - hylafax | [] | - idutils | [] | - iso_15924 | () [] [] | - iso_3166 | [] [] [] () [] [] [] [] [] [] | - iso_3166_2 | () [] | - iso_4217 | () [] [] [] | - iso_639 | [] [] () [] [] [] [] | - iso_639_3 | [] () [] | - iso_639_5 | () | - jwhois | [] [] | - kbd | [] | - klavaro | [] [] | - ld | | - leafpad | [] [] [] [] [] | - libc | [] [] | - libexif | [] | - libextractor | [] | - libgnutls | [] [] | - libgphoto2 | [] | - libgphoto2_port | [] | - libgsasl | [] | - libiconv | [] [] | - libidn | [] | - liferea | [] [] [] | - lilypond | [] | - lordsawar | | - lprng | | - lynx | [] | - m4 | [] | - mailfromd | | - mailutils | | - make | [] [] | - man-db | [] | - man-db-manpages | [] | - midi-instruments | [] [] [] [] [] [] [] | - minicom | [] | - mkisofs | [] | - myserver | | - nano | [] [] [] | - opcodes | [] | - parted | [] [] | - pies | | - pnmixer | [] | - popt | [] [] [] [] [] | - procps-ng | | - procps-ng-man | | - psmisc | [] | - pspp | [] [] | - pushover | | - pwdutils | [] | - pyspread | | - radius | [] | - recode | [] [] | - recutils | [] | - rpm | [] | - rush | [] | - sarg | | - sed | [] [] | - sharutils | [] | - shishi | | - skribilo | | - solfege | [] [] | - solfege-manual | [] | - spotmachine | [] | - sudo | [] [] [] | - sudoers | [] [] [] | - sysstat | [] [] | - tar | [] [] [] | - texinfo | [] | - texinfo_document | [] | - tigervnc | [] | - tin | | - tin-man | | - tracgoogleappsa... | [] [] [] | - trader | [] | - util-linux | [] | - ve | [] | - vice | [] | - vmm | [] | - vorbis-tools | [] | - wastesedge | [] | - wcd | [] | - wcd-man | [] | - wdiff | [] | - wget | [] [] | - wyslij-po | [] | - xboard | [] | - xdg-user-dirs | [] [] [] [] [] [] [] [] [] [] [] | - xkeyboard-config | [] [] [] | - +--------------------------------------------------+ - kn ko ku ky lg lt lv mk ml mn mr ms mt nb ne nl - 5 15 4 6 0 13 23 3 3 3 4 11 2 42 1 125 - - nn or pa pl ps pt pt_BR ro ru rw sk sl sq sr - +------------------------------------------------+ - a2ps | [] [] [] [] [] [] [] | - aegis | [] [] | - anubis | [] [] [] | - aspell | [] [] [] [] [] [] [] | - bash | [] [] [] [] [] [] | - bfd | [] [] | - binutils | [] [] | - bison | [] [] [] | - bison-runtime | [] [] [] [] [] [] [] [] | - buzztrax | [] | - ccd2cue | [] [] | - ccide | [] [] [] | - cflow | [] [] [] | - clisp | [] | - coreutils | [] [] [] [] | - cpio | [] [] [] | - cppi | [] [] [] | - cpplib | [] [] [] | - cryptsetup | [] [] [] | - datamash | [] [] | - denemo | | - dfarc | [] [] [] | - dialog | [] [] [] [] [] [] [] | - dico | [] | - diffutils | [] [] [] | - dink | | - direvent | [] [] [] | - doodle | [] [] | - dos2unix | [] [] [] [] | - dos2unix-man | [] [] | - e2fsprogs | [] | - enscript | [] [] [] [] [] [] | - exif | [] [] [] [] [] [] | - fetchmail | [] [] [] | - findutils | [] [] [] [] [] [] | - flex | [] [] [] [] [] | - freedink | [] [] [] [] [] | - fusionforge | | - gas | | - gawk | [] | - gcal | | - gcc | | - gdbm | [] [] [] | - gettext-examples | [] [] [] [] [] [] [] [] | - gettext-runtime | [] [] [] [] [] [] [] [] [] | - gettext-tools | [] [] [] [] [] [] [] | - gjay | [] | - glunarclock | [] [] [] [] [] [] | - gnubiff | [] | - gnubik | [] [] [] [] | - gnucash | () () () () () [] | - gnuchess | [] [] | - gnulib | [] [] [] [] [] | - gnunet | | - gnunet-gtk | | - gold | | - gphoto2 | [] [] [] [] [] | - gprof | [] [] [] [] | - gramadoir | [] [] | - grep | [] [] [] [] [] [] | - grub | [] [] [] [] [] | - gsasl | [] [] [] | - gss | [] [] [] [] | - gst-plugins-bad | [] [] [] [] [] | - gst-plugins-base | [] [] [] [] [] [] | - gst-plugins-good | [] [] [] [] [] [] [] | - gst-plugins-ugly | [] [] [] [] [] [] [] | - gstreamer | [] [] [] [] [] [] [] | - gtick | [] [] [] [] [] | - gtkam | [] [] [] [] [] [] | - gtkspell | [] [] [] [] [] [] [] [] [] | - guix | | - guix-packages | | - gutenprint | [] [] | - hello | [] [] [] [] [] [] | - help2man | [] [] [] [] | - help2man-texi | [] | - hylafax | | - idutils | [] [] [] | - iso_15924 | [] () [] [] [] [] | - iso_3166 | [] [] [] [] () [] [] [] [] [] [] [] [] | - iso_3166_2 | [] () [] | - iso_4217 | [] [] () [] [] [] [] [] | - iso_639 | [] [] [] () [] [] [] [] [] [] | - iso_639_3 | [] () | - iso_639_5 | () [] | - jwhois | [] [] [] [] | - kbd | [] [] | - klavaro | [] [] [] [] [] | - ld | | - leafpad | [] [] [] [] [] [] [] [] | - libc | [] [] [] | - libexif | [] () [] | - libextractor | [] | - libgnutls | [] | - libgphoto2 | [] | - libgphoto2_port | [] [] [] [] [] | - libgsasl | [] [] [] [] | - libiconv | [] [] [] [] [] | - libidn | [] [] [] | - liferea | [] [] [] [] () [] [] | - lilypond | | - lordsawar | | - lprng | [] | - lynx | [] [] | - m4 | [] [] [] [] [] | - mailfromd | [] | - mailutils | [] | - make | [] [] [] | - man-db | [] [] [] | - man-db-manpages | [] [] [] | - midi-instruments | [] [] [] [] [] [] [] [] | - minicom | [] [] [] [] | - mkisofs | [] [] [] | - myserver | [] [] | - nano | [] [] [] [] [] [] | - opcodes | | - parted | [] [] [] [] [] [] | - pies | [] | - pnmixer | [] | - popt | [] [] [] [] [] [] | - procps-ng | [] | - procps-ng-man | [] | - psmisc | [] [] [] [] | - pspp | [] [] | - pushover | | - pwdutils | [] | - pyspread | [] [] | - radius | [] [] | - recode | [] [] [] [] [] [] [] [] | - recutils | [] [] | - rpm | [] | - rush | [] [] [] | - sarg | [] [] | - sed | [] [] [] [] [] [] [] [] | - sharutils | [] [] [] | - shishi | [] [] | - skribilo | [] | - solfege | [] [] [] | - solfege-manual | [] [] | - spotmachine | [] [] | - sudo | [] [] [] [] [] [] | - sudoers | [] [] [] [] | - sysstat | [] [] [] [] [] | - tar | [] [] [] [] [] | - texinfo | [] [] [] | - texinfo_document | [] [] | - tigervnc | [] [] [] | - tin | [] | - tin-man | | - tracgoogleappsa... | [] [] [] [] | - trader | [] [] | - util-linux | [] [] | - ve | [] [] [] | - vice | | - vmm | | - vorbis-tools | [] [] [] | - wastesedge | | - wcd | | - wcd-man | | - wdiff | [] [] [] [] [] | - wget | [] [] [] [] [] | - wyslij-po | [] [] [] [] | - xboard | [] [] [] | - xdg-user-dirs | [] [] [] [] [] [] [] [] [] [] [] [] [] | - xkeyboard-config | [] [] [] [] | - +------------------------------------------------+ - nn or pa pl ps pt pt_BR ro ru rw sk sl sq sr - 7 3 6 114 1 12 88 32 82 3 40 45 7 101 - - sv sw ta te tg th tr uk ur vi wa wo zh_CN - +----------------------------------------------+ - a2ps | [] [] [] [] [] | - aegis | [] | - anubis | [] [] [] [] | - aspell | [] [] [] [] [] | - bash | [] [] [] [] | - bfd | [] [] [] | - binutils | [] [] [] | - bison | [] [] [] [] | - bison-runtime | [] [] [] [] [] [] | - buzztrax | [] [] [] | - ccd2cue | [] [] [] | - ccide | [] [] [] [] | - cflow | [] [] [] [] | - clisp | | - coreutils | [] [] [] | - cpio | [] [] [] [] [] | - cppi | [] [] [] [] | - cpplib | [] [] [] [] [] | - cryptsetup | [] [] [] | - datamash | [] [] [] | - denemo | [] | - dfarc | [] [] | - dialog | [] [] [] [] [] [] | - dico | [] | - diffutils | [] [] [] [] [] | - dink | [] | - direvent | [] [] | - doodle | [] [] | - dos2unix | [] [] [] [] | - dos2unix-man | [] [] [] | - e2fsprogs | [] [] [] [] | - enscript | [] [] [] [] | - exif | [] [] [] [] [] | - fetchmail | [] [] [] [] | - findutils | [] [] [] [] [] | - flex | [] [] [] [] | - freedink | [] [] [] | - fusionforge | | - gas | [] | - gawk | [] [] [] | - gcal | [] [] [] | - gcc | [] | - gdbm | [] [] | - gettext-examples | [] [] [] [] [] | - gettext-runtime | [] [] [] [] [] | - gettext-tools | [] [] [] [] [] | - gjay | [] [] [] | - glunarclock | [] [] [] [] | - gnubiff | [] [] | - gnubik | [] [] [] [] | - gnucash | () () () () [] | - gnuchess | [] [] [] | - gnulib | [] [] [] [] | - gnunet | | - gnunet-gtk | | - gold | [] [] | - gphoto2 | [] [] [] [] | - gprof | [] [] [] [] | - gramadoir | [] [] [] | - grep | [] [] [] [] [] | - grub | [] [] [] [] | - gsasl | [] [] [] [] | - gss | [] [] [] | - gst-plugins-bad | [] [] [] [] [] | - gst-plugins-base | [] [] [] [] [] | - gst-plugins-good | [] [] [] [] [] | - gst-plugins-ugly | [] [] [] [] [] | - gstreamer | [] [] [] [] [] | - gtick | [] [] [] | - gtkam | [] [] [] [] | - gtkspell | [] [] [] [] [] [] [] | - guix | | - guix-packages | | - gutenprint | [] [] [] [] | - hello | [] [] [] [] [] [] | - help2man | [] [] [] | - help2man-texi | [] | - hylafax | [] | - idutils | [] [] [] | - iso_15924 | [] () [] [] () [] | - iso_3166 | [] [] () [] [] () [] [] | - iso_3166_2 | () [] [] () [] | - iso_4217 | [] () [] [] () [] | - iso_639 | [] [] [] () [] [] () [] [] | - iso_639_3 | [] () [] [] () | - iso_639_5 | () [] () | - jwhois | [] [] [] [] | - kbd | [] [] [] [] | - klavaro | [] [] [] [] [] [] | - ld | [] [] [] [] [] | - leafpad | [] [] [] [] [] [] | - libc | [] [] [] [] [] | - libexif | [] [] () | - libextractor | [] [] | - libgnutls | [] [] [] [] | - libgphoto2 | [] [] [] | - libgphoto2_port | [] [] [] [] | - libgsasl | [] [] [] [] | - libiconv | [] [] [] [] [] | - libidn | () [] [] [] | - liferea | [] [] [] [] [] | - lilypond | [] | - lordsawar | | - lprng | [] | - lynx | [] [] [] [] | - m4 | [] [] [] | - mailfromd | [] [] | - mailutils | [] | - make | [] [] [] [] | - man-db | [] [] [] | - man-db-manpages | [] [] | - midi-instruments | [] [] [] [] [] [] | - minicom | [] [] | - mkisofs | [] [] [] | - myserver | [] | - nano | [] [] [] [] | - opcodes | [] [] [] | - parted | [] [] [] [] [] | - pies | [] [] | - pnmixer | [] [] [] | - popt | [] [] [] [] [] [] [] | - procps-ng | [] [] | - procps-ng-man | [] | - psmisc | [] [] [] [] | - pspp | [] [] [] | - pushover | [] | - pwdutils | [] [] | - pyspread | [] | - radius | [] [] | - recode | [] [] [] [] | - recutils | [] [] [] | - rpm | [] [] [] [] | - rush | [] [] | - sarg | | - sed | [] [] [] [] [] | - sharutils | [] [] [] [] | - shishi | [] [] | - skribilo | [] [] | - solfege | [] [] [] [] | - solfege-manual | [] | - spotmachine | [] [] [] | - sudo | [] [] [] [] [] | - sudoers | [] [] [] [] | - sysstat | [] [] [] [] [] | - tar | [] [] [] [] [] | - texinfo | [] [] [] | - texinfo_document | [] | - tigervnc | [] [] [] | - tin | [] | - tin-man | | - tracgoogleappsa... | [] [] [] [] [] | - trader | [] | - util-linux | [] [] [] [] | - ve | [] [] [] [] | - vice | () () | - vmm | | - vorbis-tools | [] [] | - wastesedge | | - wcd | [] [] [] | - wcd-man | [] | - wdiff | [] [] [] [] | - wget | [] [] [] | - wyslij-po | [] [] | - xboard | [] [] | - xdg-user-dirs | [] [] [] [] [] [] [] [] | - xkeyboard-config | [] [] [] [] | - +----------------------------------------------+ - sv sw ta te tg th tr uk ur vi wa wo zh_CN - 106 1 4 3 0 13 51 115 1 125 7 1 100 - - zh_HK zh_TW - +-------------+ - a2ps | | 30 - aegis | | 9 - anubis | | 19 - aspell | | 29 - bash | [] | 23 - bfd | | 11 - binutils | | 12 - bison | [] | 18 - bison-runtime | [] | 38 - buzztrax | | 9 - ccd2cue | | 10 - ccide | | 17 - cflow | | 16 - clisp | | 10 - coreutils | | 18 - cpio | | 20 - cppi | | 17 - cpplib | [] | 19 - cryptsetup | | 14 - datamash | | 11 - denemo | | 5 - dfarc | | 17 - dialog | [] | 42 - dico | | 6 - diffutils | | 22 - dink | | 10 - direvent | | 11 - doodle | | 12 - dos2unix | [] | 18 - dos2unix-man | | 9 - e2fsprogs | | 15 - enscript | | 21 - exif | | 27 - fetchmail | | 19 - findutils | | 29 - flex | [] | 19 - freedink | | 24 - fusionforge | | 3 - gas | | 5 - gawk | | 13 - gcal | | 8 - gcc | | 2 - gdbm | | 10 - gettext-examples | [] [] | 40 - gettext-runtime | [] [] | 35 - gettext-tools | [] | 24 - gjay | | 9 - glunarclock | [] | 27 - gnubiff | | 9 - gnubik | | 19 - gnucash | () | 6 - gnuchess | | 11 - gnulib | | 23 - gnunet | | 1 - gnunet-gtk | | 1 - gold | | 7 - gphoto2 | [] | 19 - gprof | | 21 - gramadoir | | 14 - grep | [] | 31 - grub | | 21 - gsasl | [] | 19 - gss | | 17 - gst-plugins-bad | | 21 - gst-plugins-base | | 27 - gst-plugins-good | | 32 - gst-plugins-ugly | | 34 - gstreamer | [] | 32 - gtick | | 19 - gtkam | | 24 - gtkspell | [] [] | 48 - guix | | 2 - guix-packages | | 0 - gutenprint | | 15 - hello | [] | 30 - help2man | | 18 - help2man-texi | | 5 - hylafax | | 5 - idutils | | 14 - iso_15924 | [] | 23 - iso_3166 | [] [] | 58 - iso_3166_2 | | 9 - iso_4217 | [] [] | 28 - iso_639 | [] [] | 46 - iso_639_3 | | 10 - iso_639_5 | | 2 - jwhois | [] | 20 - kbd | | 17 - klavaro | | 30 - ld | [] | 15 - leafpad | [] | 39 - libc | [] | 24 - libexif | | 10 - libextractor | | 5 - libgnutls | | 13 - libgphoto2 | | 10 - libgphoto2_port | [] | 19 - libgsasl | | 18 - libiconv | [] | 29 - libidn | | 17 - liferea | | 29 - lilypond | | 11 - lordsawar | | 3 - lprng | | 3 - lynx | | 19 - m4 | [] | 22 - mailfromd | | 4 - mailutils | | 6 - make | | 19 - man-db | | 15 - man-db-manpages | | 10 - midi-instruments | [] | 43 - minicom | [] | 17 - mkisofs | | 13 - myserver | | 9 - nano | [] | 30 - opcodes | | 12 - parted | [] | 23 - pies | | 4 - pnmixer | | 9 - popt | [] | 36 - procps-ng | | 5 - procps-ng-man | | 4 - psmisc | [] | 22 - pspp | | 13 - pushover | | 6 - pwdutils | | 8 - pyspread | | 6 - radius | | 9 - recode | | 31 - recutils | | 10 - rpm | [] | 13 - rush | | 10 - sarg | | 4 - sed | [] | 35 - sharutils | | 13 - shishi | | 7 - skribilo | | 7 - solfege | | 21 - solfege-manual | | 9 - spotmachine | | 11 - sudo | | 26 - sudoers | | 22 - sysstat | | 23 - tar | [] | 30 - texinfo | | 17 - texinfo_document | | 13 - tigervnc | | 14 - tin | [] | 7 - tin-man | | 1 - tracgoogleappsa... | [] | 22 - trader | | 12 - util-linux | | 13 - ve | | 14 - vice | | 1 - vmm | | 3 - vorbis-tools | | 13 - wastesedge | | 3 - wcd | | 8 - wcd-man | | 3 - wdiff | [] | 23 - wget | | 21 - wyslij-po | | 14 - xboard | | 10 - xdg-user-dirs | [] [] | 68 - xkeyboard-config | [] | 28 - +-------------+ - 89 teams zh_HK zh_TW - 166 domains 7 42 2809 - - Some counters in the preceding matrix are higher than the number of -visible blocks let us expect. This is because a few extra PO files are -used for implementing regional variants of languages, or language -dialects. - - For a PO file in the matrix above to be effective, the package to -which it applies should also have been internationalized and distributed -as such by its maintainer. There might be an observable lag between the -mere existence a PO file and its wide availability in a distribution. - - If Jun 2014 seems to be old, you may fetch a more recent copy of this -'ABOUT-NLS' file on most GNU archive sites. The most up-to-date matrix -with full percentage details can be found at -'https://translationproject.org/extra/matrix.html'. - -1.5 Using 'gettext' in new packages -=================================== - -If you are writing a freely available program and want to -internationalize it you are welcome to use GNU 'gettext' in your -package. Of course you have to respect the GNU Lesser General Public -License which covers the use of the GNU 'gettext' library. This means -in particular that even non-free programs can use 'libintl' as a shared -library, whereas only free software can use 'libintl' as a static -library or use modified versions of 'libintl'. - - Once the sources are changed appropriately and the setup can handle -the use of 'gettext' the only thing missing are the translations. The -Free Translation Project is also available for packages which are not -developed inside the GNU project. Therefore the information given above -applies also for every other Free Software Project. Contact -'coordinator@translationproject.org' to make the '.pot' files available -to the translation teams. \ No newline at end of file diff -Nru gnucobol-4.0~early~20200606/aclocal.m4 gnucobol-5/aclocal.m4 --- gnucobol-4.0~early~20200606/aclocal.m4 2020-06-06 20:56:36.000000000 +0000 +++ gnucobol-5/aclocal.m4 1970-01-01 00:00:00.000000000 +0000 @@ -1,1188 +0,0 @@ -# generated automatically by aclocal 1.15.1 -*- Autoconf -*- - -# Copyright (C) 1996-2017 Free Software Foundation, Inc. - -# This file is free software; the Free Software Foundation -# gives unlimited permission to copy and/or distribute it, -# with or without modifications, as long as this notice is preserved. - -# This program is distributed in the hope that it will be useful, -# but WITHOUT ANY WARRANTY, to the extent permitted by law; without -# even the implied warranty of MERCHANTABILITY or FITNESS FOR A -# PARTICULAR PURPOSE. - -m4_ifndef([AC_CONFIG_MACRO_DIRS], [m4_defun([_AM_CONFIG_MACRO_DIRS], [])m4_defun([AC_CONFIG_MACRO_DIRS], [_AM_CONFIG_MACRO_DIRS($@)])]) -m4_ifndef([AC_AUTOCONF_VERSION], - [m4_copy([m4_PACKAGE_VERSION], [AC_AUTOCONF_VERSION])])dnl -m4_if(m4_defn([AC_AUTOCONF_VERSION]), [2.69],, -[m4_warning([this file was generated for autoconf 2.69. -You have another version of autoconf. It may work, but is not guaranteed to. -If you have problems, you may need to regenerate the build system entirely. -To do so, use the procedure documented by the package, typically 'autoreconf'.])]) - -# Copyright (C) 2002-2017 Free Software Foundation, Inc. -# -# This file is free software; the Free Software Foundation -# gives unlimited permission to copy and/or distribute it, -# with or without modifications, as long as this notice is preserved. - -# AM_AUTOMAKE_VERSION(VERSION) -# ---------------------------- -# Automake X.Y traces this macro to ensure aclocal.m4 has been -# generated from the m4 files accompanying Automake X.Y. -# (This private macro should not be called outside this file.) -AC_DEFUN([AM_AUTOMAKE_VERSION], -[am__api_version='1.15' -dnl Some users find AM_AUTOMAKE_VERSION and mistake it for a way to -dnl require some minimum version. Point them to the right macro. -m4_if([$1], [1.15.1], [], - [AC_FATAL([Do not call $0, use AM_INIT_AUTOMAKE([$1]).])])dnl -]) - -# _AM_AUTOCONF_VERSION(VERSION) -# ----------------------------- -# aclocal traces this macro to find the Autoconf version. -# This is a private macro too. Using m4_define simplifies -# the logic in aclocal, which can simply ignore this definition. -m4_define([_AM_AUTOCONF_VERSION], []) - -# AM_SET_CURRENT_AUTOMAKE_VERSION -# ------------------------------- -# Call AM_AUTOMAKE_VERSION and AM_AUTOMAKE_VERSION so they can be traced. -# This function is AC_REQUIREd by AM_INIT_AUTOMAKE. -AC_DEFUN([AM_SET_CURRENT_AUTOMAKE_VERSION], -[AM_AUTOMAKE_VERSION([1.15.1])dnl -m4_ifndef([AC_AUTOCONF_VERSION], - [m4_copy([m4_PACKAGE_VERSION], [AC_AUTOCONF_VERSION])])dnl -_AM_AUTOCONF_VERSION(m4_defn([AC_AUTOCONF_VERSION]))]) - -# AM_AUX_DIR_EXPAND -*- Autoconf -*- - -# Copyright (C) 2001-2017 Free Software Foundation, Inc. -# -# This file is free software; the Free Software Foundation -# gives unlimited permission to copy and/or distribute it, -# with or without modifications, as long as this notice is preserved. - -# For projects using AC_CONFIG_AUX_DIR([foo]), Autoconf sets -# $ac_aux_dir to '$srcdir/foo'. In other projects, it is set to -# '$srcdir', '$srcdir/..', or '$srcdir/../..'. -# -# Of course, Automake must honor this variable whenever it calls a -# tool from the auxiliary directory. The problem is that $srcdir (and -# therefore $ac_aux_dir as well) can be either absolute or relative, -# depending on how configure is run. This is pretty annoying, since -# it makes $ac_aux_dir quite unusable in subdirectories: in the top -# source directory, any form will work fine, but in subdirectories a -# relative path needs to be adjusted first. -# -# $ac_aux_dir/missing -# fails when called from a subdirectory if $ac_aux_dir is relative -# $top_srcdir/$ac_aux_dir/missing -# fails if $ac_aux_dir is absolute, -# fails when called from a subdirectory in a VPATH build with -# a relative $ac_aux_dir -# -# The reason of the latter failure is that $top_srcdir and $ac_aux_dir -# are both prefixed by $srcdir. In an in-source build this is usually -# harmless because $srcdir is '.', but things will broke when you -# start a VPATH build or use an absolute $srcdir. -# -# So we could use something similar to $top_srcdir/$ac_aux_dir/missing, -# iff we strip the leading $srcdir from $ac_aux_dir. That would be: -# am_aux_dir='\$(top_srcdir)/'`expr "$ac_aux_dir" : "$srcdir//*\(.*\)"` -# and then we would define $MISSING as -# MISSING="\${SHELL} $am_aux_dir/missing" -# This will work as long as MISSING is not called from configure, because -# unfortunately $(top_srcdir) has no meaning in configure. -# However there are other variables, like CC, which are often used in -# configure, and could therefore not use this "fixed" $ac_aux_dir. -# -# Another solution, used here, is to always expand $ac_aux_dir to an -# absolute PATH. The drawback is that using absolute paths prevent a -# configured tree to be moved without reconfiguration. - -AC_DEFUN([AM_AUX_DIR_EXPAND], -[AC_REQUIRE([AC_CONFIG_AUX_DIR_DEFAULT])dnl -# Expand $ac_aux_dir to an absolute path. -am_aux_dir=`cd "$ac_aux_dir" && pwd` -]) - -# AM_CONDITIONAL -*- Autoconf -*- - -# Copyright (C) 1997-2017 Free Software Foundation, Inc. -# -# This file is free software; the Free Software Foundation -# gives unlimited permission to copy and/or distribute it, -# with or without modifications, as long as this notice is preserved. - -# AM_CONDITIONAL(NAME, SHELL-CONDITION) -# ------------------------------------- -# Define a conditional. -AC_DEFUN([AM_CONDITIONAL], -[AC_PREREQ([2.52])dnl - m4_if([$1], [TRUE], [AC_FATAL([$0: invalid condition: $1])], - [$1], [FALSE], [AC_FATAL([$0: invalid condition: $1])])dnl -AC_SUBST([$1_TRUE])dnl -AC_SUBST([$1_FALSE])dnl -_AM_SUBST_NOTMAKE([$1_TRUE])dnl -_AM_SUBST_NOTMAKE([$1_FALSE])dnl -m4_define([_AM_COND_VALUE_$1], [$2])dnl -if $2; then - $1_TRUE= - $1_FALSE='#' -else - $1_TRUE='#' - $1_FALSE= -fi -AC_CONFIG_COMMANDS_PRE( -[if test -z "${$1_TRUE}" && test -z "${$1_FALSE}"; then - AC_MSG_ERROR([[conditional "$1" was never defined. -Usually this means the macro was only invoked conditionally.]]) -fi])]) - -# Copyright (C) 1999-2017 Free Software Foundation, Inc. -# -# This file is free software; the Free Software Foundation -# gives unlimited permission to copy and/or distribute it, -# with or without modifications, as long as this notice is preserved. - - -# There are a few dirty hacks below to avoid letting 'AC_PROG_CC' be -# written in clear, in which case automake, when reading aclocal.m4, -# will think it sees a *use*, and therefore will trigger all it's -# C support machinery. Also note that it means that autoscan, seeing -# CC etc. in the Makefile, will ask for an AC_PROG_CC use... - - -# _AM_DEPENDENCIES(NAME) -# ---------------------- -# See how the compiler implements dependency checking. -# NAME is "CC", "CXX", "OBJC", "OBJCXX", "UPC", or "GJC". -# We try a few techniques and use that to set a single cache variable. -# -# We don't AC_REQUIRE the corresponding AC_PROG_CC since the latter was -# modified to invoke _AM_DEPENDENCIES(CC); we would have a circular -# dependency, and given that the user is not expected to run this macro, -# just rely on AC_PROG_CC. -AC_DEFUN([_AM_DEPENDENCIES], -[AC_REQUIRE([AM_SET_DEPDIR])dnl -AC_REQUIRE([AM_OUTPUT_DEPENDENCY_COMMANDS])dnl -AC_REQUIRE([AM_MAKE_INCLUDE])dnl -AC_REQUIRE([AM_DEP_TRACK])dnl - -m4_if([$1], [CC], [depcc="$CC" am_compiler_list=], - [$1], [CXX], [depcc="$CXX" am_compiler_list=], - [$1], [OBJC], [depcc="$OBJC" am_compiler_list='gcc3 gcc'], - [$1], [OBJCXX], [depcc="$OBJCXX" am_compiler_list='gcc3 gcc'], - [$1], [UPC], [depcc="$UPC" am_compiler_list=], - [$1], [GCJ], [depcc="$GCJ" am_compiler_list='gcc3 gcc'], - [depcc="$$1" am_compiler_list=]) - -AC_CACHE_CHECK([dependency style of $depcc], - [am_cv_$1_dependencies_compiler_type], -[if test -z "$AMDEP_TRUE" && test -f "$am_depcomp"; then - # We make a subdir and do the tests there. Otherwise we can end up - # making bogus files that we don't know about and never remove. For - # instance it was reported that on HP-UX the gcc test will end up - # making a dummy file named 'D' -- because '-MD' means "put the output - # in D". - rm -rf conftest.dir - mkdir conftest.dir - # Copy depcomp to subdir because otherwise we won't find it if we're - # using a relative directory. - cp "$am_depcomp" conftest.dir - cd conftest.dir - # We will build objects and dependencies in a subdirectory because - # it helps to detect inapplicable dependency modes. For instance - # both Tru64's cc and ICC support -MD to output dependencies as a - # side effect of compilation, but ICC will put the dependencies in - # the current directory while Tru64 will put them in the object - # directory. - mkdir sub - - am_cv_$1_dependencies_compiler_type=none - if test "$am_compiler_list" = ""; then - am_compiler_list=`sed -n ['s/^#*\([a-zA-Z0-9]*\))$/\1/p'] < ./depcomp` - fi - am__universal=false - m4_case([$1], [CC], - [case " $depcc " in #( - *\ -arch\ *\ -arch\ *) am__universal=true ;; - esac], - [CXX], - [case " $depcc " in #( - *\ -arch\ *\ -arch\ *) am__universal=true ;; - esac]) - - for depmode in $am_compiler_list; do - # Setup a source with many dependencies, because some compilers - # like to wrap large dependency lists on column 80 (with \), and - # we should not choose a depcomp mode which is confused by this. - # - # We need to recreate these files for each test, as the compiler may - # overwrite some of them when testing with obscure command lines. - # This happens at least with the AIX C compiler. - : > sub/conftest.c - for i in 1 2 3 4 5 6; do - echo '#include "conftst'$i'.h"' >> sub/conftest.c - # Using ": > sub/conftst$i.h" creates only sub/conftst1.h with - # Solaris 10 /bin/sh. - echo '/* dummy */' > sub/conftst$i.h - done - echo "${am__include} ${am__quote}sub/conftest.Po${am__quote}" > confmf - - # We check with '-c' and '-o' for the sake of the "dashmstdout" - # mode. It turns out that the SunPro C++ compiler does not properly - # handle '-M -o', and we need to detect this. Also, some Intel - # versions had trouble with output in subdirs. - am__obj=sub/conftest.${OBJEXT-o} - am__minus_obj="-o $am__obj" - case $depmode in - gcc) - # This depmode causes a compiler race in universal mode. - test "$am__universal" = false || continue - ;; - nosideeffect) - # After this tag, mechanisms are not by side-effect, so they'll - # only be used when explicitly requested. - if test "x$enable_dependency_tracking" = xyes; then - continue - else - break - fi - ;; - msvc7 | msvc7msys | msvisualcpp | msvcmsys) - # This compiler won't grok '-c -o', but also, the minuso test has - # not run yet. These depmodes are late enough in the game, and - # so weak that their functioning should not be impacted. - am__obj=conftest.${OBJEXT-o} - am__minus_obj= - ;; - none) break ;; - esac - if depmode=$depmode \ - source=sub/conftest.c object=$am__obj \ - depfile=sub/conftest.Po tmpdepfile=sub/conftest.TPo \ - $SHELL ./depcomp $depcc -c $am__minus_obj sub/conftest.c \ - >/dev/null 2>conftest.err && - grep sub/conftst1.h sub/conftest.Po > /dev/null 2>&1 && - grep sub/conftst6.h sub/conftest.Po > /dev/null 2>&1 && - grep $am__obj sub/conftest.Po > /dev/null 2>&1 && - ${MAKE-make} -s -f confmf > /dev/null 2>&1; then - # icc doesn't choke on unknown options, it will just issue warnings - # or remarks (even with -Werror). So we grep stderr for any message - # that says an option was ignored or not supported. - # When given -MP, icc 7.0 and 7.1 complain thusly: - # icc: Command line warning: ignoring option '-M'; no argument required - # The diagnosis changed in icc 8.0: - # icc: Command line remark: option '-MP' not supported - if (grep 'ignoring option' conftest.err || - grep 'not supported' conftest.err) >/dev/null 2>&1; then :; else - am_cv_$1_dependencies_compiler_type=$depmode - break - fi - fi - done - - cd .. - rm -rf conftest.dir -else - am_cv_$1_dependencies_compiler_type=none -fi -]) -AC_SUBST([$1DEPMODE], [depmode=$am_cv_$1_dependencies_compiler_type]) -AM_CONDITIONAL([am__fastdep$1], [ - test "x$enable_dependency_tracking" != xno \ - && test "$am_cv_$1_dependencies_compiler_type" = gcc3]) -]) - - -# AM_SET_DEPDIR -# ------------- -# Choose a directory name for dependency files. -# This macro is AC_REQUIREd in _AM_DEPENDENCIES. -AC_DEFUN([AM_SET_DEPDIR], -[AC_REQUIRE([AM_SET_LEADING_DOT])dnl -AC_SUBST([DEPDIR], ["${am__leading_dot}deps"])dnl -]) - - -# AM_DEP_TRACK -# ------------ -AC_DEFUN([AM_DEP_TRACK], -[AC_ARG_ENABLE([dependency-tracking], [dnl -AS_HELP_STRING( - [--enable-dependency-tracking], - [do not reject slow dependency extractors]) -AS_HELP_STRING( - [--disable-dependency-tracking], - [speeds up one-time build])]) -if test "x$enable_dependency_tracking" != xno; then - am_depcomp="$ac_aux_dir/depcomp" - AMDEPBACKSLASH='\' - am__nodep='_no' -fi -AM_CONDITIONAL([AMDEP], [test "x$enable_dependency_tracking" != xno]) -AC_SUBST([AMDEPBACKSLASH])dnl -_AM_SUBST_NOTMAKE([AMDEPBACKSLASH])dnl -AC_SUBST([am__nodep])dnl -_AM_SUBST_NOTMAKE([am__nodep])dnl -]) - -# Generate code to set up dependency tracking. -*- Autoconf -*- - -# Copyright (C) 1999-2017 Free Software Foundation, Inc. -# -# This file is free software; the Free Software Foundation -# gives unlimited permission to copy and/or distribute it, -# with or without modifications, as long as this notice is preserved. - - -# _AM_OUTPUT_DEPENDENCY_COMMANDS -# ------------------------------ -AC_DEFUN([_AM_OUTPUT_DEPENDENCY_COMMANDS], -[{ - # Older Autoconf quotes --file arguments for eval, but not when files - # are listed without --file. Let's play safe and only enable the eval - # if we detect the quoting. - case $CONFIG_FILES in - *\'*) eval set x "$CONFIG_FILES" ;; - *) set x $CONFIG_FILES ;; - esac - shift - for mf - do - # Strip MF so we end up with the name of the file. - mf=`echo "$mf" | sed -e 's/:.*$//'` - # Check whether this is an Automake generated Makefile or not. - # We used to match only the files named 'Makefile.in', but - # some people rename them; so instead we look at the file content. - # Grep'ing the first line is not enough: some people post-process - # each Makefile.in and add a new line on top of each file to say so. - # Grep'ing the whole file is not good either: AIX grep has a line - # limit of 2048, but all sed's we know have understand at least 4000. - if sed -n 's,^#.*generated by automake.*,X,p' "$mf" | grep X >/dev/null 2>&1; then - dirpart=`AS_DIRNAME("$mf")` - else - continue - fi - # Extract the definition of DEPDIR, am__include, and am__quote - # from the Makefile without running 'make'. - DEPDIR=`sed -n 's/^DEPDIR = //p' < "$mf"` - test -z "$DEPDIR" && continue - am__include=`sed -n 's/^am__include = //p' < "$mf"` - test -z "$am__include" && continue - am__quote=`sed -n 's/^am__quote = //p' < "$mf"` - # Find all dependency output files, they are included files with - # $(DEPDIR) in their names. We invoke sed twice because it is the - # simplest approach to changing $(DEPDIR) to its actual value in the - # expansion. - for file in `sed -n " - s/^$am__include $am__quote\(.*(DEPDIR).*\)$am__quote"'$/\1/p' <"$mf" | \ - sed -e 's/\$(DEPDIR)/'"$DEPDIR"'/g'`; do - # Make sure the directory exists. - test -f "$dirpart/$file" && continue - fdir=`AS_DIRNAME(["$file"])` - AS_MKDIR_P([$dirpart/$fdir]) - # echo "creating $dirpart/$file" - echo '# dummy' > "$dirpart/$file" - done - done -} -])# _AM_OUTPUT_DEPENDENCY_COMMANDS - - -# AM_OUTPUT_DEPENDENCY_COMMANDS -# ----------------------------- -# This macro should only be invoked once -- use via AC_REQUIRE. -# -# This code is only required when automatic dependency tracking -# is enabled. FIXME. This creates each '.P' file that we will -# need in order to bootstrap the dependency handling code. -AC_DEFUN([AM_OUTPUT_DEPENDENCY_COMMANDS], -[AC_CONFIG_COMMANDS([depfiles], - [test x"$AMDEP_TRUE" != x"" || _AM_OUTPUT_DEPENDENCY_COMMANDS], - [AMDEP_TRUE="$AMDEP_TRUE" ac_aux_dir="$ac_aux_dir"]) -]) - -# Do all the work for Automake. -*- Autoconf -*- - -# Copyright (C) 1996-2017 Free Software Foundation, Inc. -# -# This file is free software; the Free Software Foundation -# gives unlimited permission to copy and/or distribute it, -# with or without modifications, as long as this notice is preserved. - -# This macro actually does too much. Some checks are only needed if -# your package does certain things. But this isn't really a big deal. - -dnl Redefine AC_PROG_CC to automatically invoke _AM_PROG_CC_C_O. -m4_define([AC_PROG_CC], -m4_defn([AC_PROG_CC]) -[_AM_PROG_CC_C_O -]) - -# AM_INIT_AUTOMAKE(PACKAGE, VERSION, [NO-DEFINE]) -# AM_INIT_AUTOMAKE([OPTIONS]) -# ----------------------------------------------- -# The call with PACKAGE and VERSION arguments is the old style -# call (pre autoconf-2.50), which is being phased out. PACKAGE -# and VERSION should now be passed to AC_INIT and removed from -# the call to AM_INIT_AUTOMAKE. -# We support both call styles for the transition. After -# the next Automake release, Autoconf can make the AC_INIT -# arguments mandatory, and then we can depend on a new Autoconf -# release and drop the old call support. -AC_DEFUN([AM_INIT_AUTOMAKE], -[AC_PREREQ([2.65])dnl -dnl Autoconf wants to disallow AM_ names. We explicitly allow -dnl the ones we care about. -m4_pattern_allow([^AM_[A-Z]+FLAGS$])dnl -AC_REQUIRE([AM_SET_CURRENT_AUTOMAKE_VERSION])dnl -AC_REQUIRE([AC_PROG_INSTALL])dnl -if test "`cd $srcdir && pwd`" != "`pwd`"; then - # Use -I$(srcdir) only when $(srcdir) != ., so that make's output - # is not polluted with repeated "-I." - AC_SUBST([am__isrc], [' -I$(srcdir)'])_AM_SUBST_NOTMAKE([am__isrc])dnl - # test to see if srcdir already configured - if test -f $srcdir/config.status; then - AC_MSG_ERROR([source directory already configured; run "make distclean" there first]) - fi -fi - -# test whether we have cygpath -if test -z "$CYGPATH_W"; then - if (cygpath --version) >/dev/null 2>/dev/null; then - CYGPATH_W='cygpath -w' - else - CYGPATH_W=echo - fi -fi -AC_SUBST([CYGPATH_W]) - -# Define the identity of the package. -dnl Distinguish between old-style and new-style calls. -m4_ifval([$2], -[AC_DIAGNOSE([obsolete], - [$0: two- and three-arguments forms are deprecated.]) -m4_ifval([$3], [_AM_SET_OPTION([no-define])])dnl - AC_SUBST([PACKAGE], [$1])dnl - AC_SUBST([VERSION], [$2])], -[_AM_SET_OPTIONS([$1])dnl -dnl Diagnose old-style AC_INIT with new-style AM_AUTOMAKE_INIT. -m4_if( - m4_ifdef([AC_PACKAGE_NAME], [ok]):m4_ifdef([AC_PACKAGE_VERSION], [ok]), - [ok:ok],, - [m4_fatal([AC_INIT should be called with package and version arguments])])dnl - AC_SUBST([PACKAGE], ['AC_PACKAGE_TARNAME'])dnl - AC_SUBST([VERSION], ['AC_PACKAGE_VERSION'])])dnl - -_AM_IF_OPTION([no-define],, -[AC_DEFINE_UNQUOTED([PACKAGE], ["$PACKAGE"], [Name of package]) - AC_DEFINE_UNQUOTED([VERSION], ["$VERSION"], [Version number of package])])dnl - -# Some tools Automake needs. -AC_REQUIRE([AM_SANITY_CHECK])dnl -AC_REQUIRE([AC_ARG_PROGRAM])dnl -AM_MISSING_PROG([ACLOCAL], [aclocal-${am__api_version}]) -AM_MISSING_PROG([AUTOCONF], [autoconf]) -AM_MISSING_PROG([AUTOMAKE], [automake-${am__api_version}]) -AM_MISSING_PROG([AUTOHEADER], [autoheader]) -AM_MISSING_PROG([MAKEINFO], [makeinfo]) -AC_REQUIRE([AM_PROG_INSTALL_SH])dnl -AC_REQUIRE([AM_PROG_INSTALL_STRIP])dnl -AC_REQUIRE([AC_PROG_MKDIR_P])dnl -# For better backward compatibility. To be removed once Automake 1.9.x -# dies out for good. For more background, see: -# -# -AC_SUBST([mkdir_p], ['$(MKDIR_P)']) -# We need awk for the "check" target (and possibly the TAP driver). The -# system "awk" is bad on some platforms. -AC_REQUIRE([AC_PROG_AWK])dnl -AC_REQUIRE([AC_PROG_MAKE_SET])dnl -AC_REQUIRE([AM_SET_LEADING_DOT])dnl -_AM_IF_OPTION([tar-ustar], [_AM_PROG_TAR([ustar])], - [_AM_IF_OPTION([tar-pax], [_AM_PROG_TAR([pax])], - [_AM_PROG_TAR([v7])])]) -_AM_IF_OPTION([no-dependencies],, -[AC_PROVIDE_IFELSE([AC_PROG_CC], - [_AM_DEPENDENCIES([CC])], - [m4_define([AC_PROG_CC], - m4_defn([AC_PROG_CC])[_AM_DEPENDENCIES([CC])])])dnl -AC_PROVIDE_IFELSE([AC_PROG_CXX], - [_AM_DEPENDENCIES([CXX])], - [m4_define([AC_PROG_CXX], - m4_defn([AC_PROG_CXX])[_AM_DEPENDENCIES([CXX])])])dnl -AC_PROVIDE_IFELSE([AC_PROG_OBJC], - [_AM_DEPENDENCIES([OBJC])], - [m4_define([AC_PROG_OBJC], - m4_defn([AC_PROG_OBJC])[_AM_DEPENDENCIES([OBJC])])])dnl -AC_PROVIDE_IFELSE([AC_PROG_OBJCXX], - [_AM_DEPENDENCIES([OBJCXX])], - [m4_define([AC_PROG_OBJCXX], - m4_defn([AC_PROG_OBJCXX])[_AM_DEPENDENCIES([OBJCXX])])])dnl -]) -AC_REQUIRE([AM_SILENT_RULES])dnl -dnl The testsuite driver may need to know about EXEEXT, so add the -dnl 'am__EXEEXT' conditional if _AM_COMPILER_EXEEXT was seen. This -dnl macro is hooked onto _AC_COMPILER_EXEEXT early, see below. -AC_CONFIG_COMMANDS_PRE(dnl -[m4_provide_if([_AM_COMPILER_EXEEXT], - [AM_CONDITIONAL([am__EXEEXT], [test -n "$EXEEXT"])])])dnl - -# POSIX will say in a future version that running "rm -f" with no argument -# is OK; and we want to be able to make that assumption in our Makefile -# recipes. So use an aggressive probe to check that the usage we want is -# actually supported "in the wild" to an acceptable degree. -# See automake bug#10828. -# To make any issue more visible, cause the running configure to be aborted -# by default if the 'rm' program in use doesn't match our expectations; the -# user can still override this though. -if rm -f && rm -fr && rm -rf; then : OK; else - cat >&2 <<'END' -Oops! - -Your 'rm' program seems unable to run without file operands specified -on the command line, even when the '-f' option is present. This is contrary -to the behaviour of most rm programs out there, and not conforming with -the upcoming POSIX standard: - -Please tell bug-automake@gnu.org about your system, including the value -of your $PATH and any error possibly output before this message. This -can help us improve future automake versions. - -END - if test x"$ACCEPT_INFERIOR_RM_PROGRAM" = x"yes"; then - echo 'Configuration will proceed anyway, since you have set the' >&2 - echo 'ACCEPT_INFERIOR_RM_PROGRAM variable to "yes"' >&2 - echo >&2 - else - cat >&2 <<'END' -Aborting the configuration process, to ensure you take notice of the issue. - -You can download and install GNU coreutils to get an 'rm' implementation -that behaves properly: . - -If you want to complete the configuration process using your problematic -'rm' anyway, export the environment variable ACCEPT_INFERIOR_RM_PROGRAM -to "yes", and re-run configure. - -END - AC_MSG_ERROR([Your 'rm' program is bad, sorry.]) - fi -fi -dnl The trailing newline in this macro's definition is deliberate, for -dnl backward compatibility and to allow trailing 'dnl'-style comments -dnl after the AM_INIT_AUTOMAKE invocation. See automake bug#16841. -]) - -dnl Hook into '_AC_COMPILER_EXEEXT' early to learn its expansion. Do not -dnl add the conditional right here, as _AC_COMPILER_EXEEXT may be further -dnl mangled by Autoconf and run in a shell conditional statement. -m4_define([_AC_COMPILER_EXEEXT], -m4_defn([_AC_COMPILER_EXEEXT])[m4_provide([_AM_COMPILER_EXEEXT])]) - -# When config.status generates a header, we must update the stamp-h file. -# This file resides in the same directory as the config header -# that is generated. The stamp files are numbered to have different names. - -# Autoconf calls _AC_AM_CONFIG_HEADER_HOOK (when defined) in the -# loop where config.status creates the headers, so we can generate -# our stamp files there. -AC_DEFUN([_AC_AM_CONFIG_HEADER_HOOK], -[# Compute $1's index in $config_headers. -_am_arg=$1 -_am_stamp_count=1 -for _am_header in $config_headers :; do - case $_am_header in - $_am_arg | $_am_arg:* ) - break ;; - * ) - _am_stamp_count=`expr $_am_stamp_count + 1` ;; - esac -done -echo "timestamp for $_am_arg" >`AS_DIRNAME(["$_am_arg"])`/stamp-h[]$_am_stamp_count]) - -# Copyright (C) 2001-2017 Free Software Foundation, Inc. -# -# This file is free software; the Free Software Foundation -# gives unlimited permission to copy and/or distribute it, -# with or without modifications, as long as this notice is preserved. - -# AM_PROG_INSTALL_SH -# ------------------ -# Define $install_sh. -AC_DEFUN([AM_PROG_INSTALL_SH], -[AC_REQUIRE([AM_AUX_DIR_EXPAND])dnl -if test x"${install_sh+set}" != xset; then - case $am_aux_dir in - *\ * | *\ *) - install_sh="\${SHELL} '$am_aux_dir/install-sh'" ;; - *) - install_sh="\${SHELL} $am_aux_dir/install-sh" - esac -fi -AC_SUBST([install_sh])]) - -# Copyright (C) 2003-2017 Free Software Foundation, Inc. -# -# This file is free software; the Free Software Foundation -# gives unlimited permission to copy and/or distribute it, -# with or without modifications, as long as this notice is preserved. - -# Check whether the underlying file-system supports filenames -# with a leading dot. For instance MS-DOS doesn't. -AC_DEFUN([AM_SET_LEADING_DOT], -[rm -rf .tst 2>/dev/null -mkdir .tst 2>/dev/null -if test -d .tst; then - am__leading_dot=. -else - am__leading_dot=_ -fi -rmdir .tst 2>/dev/null -AC_SUBST([am__leading_dot])]) - -# Copyright (C) 1998-2017 Free Software Foundation, Inc. -# -# This file is free software; the Free Software Foundation -# gives unlimited permission to copy and/or distribute it, -# with or without modifications, as long as this notice is preserved. - -# AM_PROG_LEX -# ----------- -# Autoconf leaves LEX=: if lex or flex can't be found. Change that to a -# "missing" invocation, for better error output. -AC_DEFUN([AM_PROG_LEX], -[AC_PREREQ([2.50])dnl -AC_REQUIRE([AM_MISSING_HAS_RUN])dnl -AC_REQUIRE([AC_PROG_LEX])dnl -if test "$LEX" = :; then - LEX=${am_missing_run}flex -fi]) - -# Check to see how 'make' treats includes. -*- Autoconf -*- - -# Copyright (C) 2001-2017 Free Software Foundation, Inc. -# -# This file is free software; the Free Software Foundation -# gives unlimited permission to copy and/or distribute it, -# with or without modifications, as long as this notice is preserved. - -# AM_MAKE_INCLUDE() -# ----------------- -# Check to see how make treats includes. -AC_DEFUN([AM_MAKE_INCLUDE], -[am_make=${MAKE-make} -cat > confinc << 'END' -am__doit: - @echo this is the am__doit target -.PHONY: am__doit -END -# If we don't find an include directive, just comment out the code. -AC_MSG_CHECKING([for style of include used by $am_make]) -am__include="#" -am__quote= -_am_result=none -# First try GNU make style include. -echo "include confinc" > confmf -# Ignore all kinds of additional output from 'make'. -case `$am_make -s -f confmf 2> /dev/null` in #( -*the\ am__doit\ target*) - am__include=include - am__quote= - _am_result=GNU - ;; -esac -# Now try BSD make style include. -if test "$am__include" = "#"; then - echo '.include "confinc"' > confmf - case `$am_make -s -f confmf 2> /dev/null` in #( - *the\ am__doit\ target*) - am__include=.include - am__quote="\"" - _am_result=BSD - ;; - esac -fi -AC_SUBST([am__include]) -AC_SUBST([am__quote]) -AC_MSG_RESULT([$_am_result]) -rm -f confinc confmf -]) - -# Fake the existence of programs that GNU maintainers use. -*- Autoconf -*- - -# Copyright (C) 1997-2017 Free Software Foundation, Inc. -# -# This file is free software; the Free Software Foundation -# gives unlimited permission to copy and/or distribute it, -# with or without modifications, as long as this notice is preserved. - -# AM_MISSING_PROG(NAME, PROGRAM) -# ------------------------------ -AC_DEFUN([AM_MISSING_PROG], -[AC_REQUIRE([AM_MISSING_HAS_RUN]) -$1=${$1-"${am_missing_run}$2"} -AC_SUBST($1)]) - -# AM_MISSING_HAS_RUN -# ------------------ -# Define MISSING if not defined so far and test if it is modern enough. -# If it is, set am_missing_run to use it, otherwise, to nothing. -AC_DEFUN([AM_MISSING_HAS_RUN], -[AC_REQUIRE([AM_AUX_DIR_EXPAND])dnl -AC_REQUIRE_AUX_FILE([missing])dnl -if test x"${MISSING+set}" != xset; then - case $am_aux_dir in - *\ * | *\ *) - MISSING="\${SHELL} \"$am_aux_dir/missing\"" ;; - *) - MISSING="\${SHELL} $am_aux_dir/missing" ;; - esac -fi -# Use eval to expand $SHELL -if eval "$MISSING --is-lightweight"; then - am_missing_run="$MISSING " -else - am_missing_run= - AC_MSG_WARN(['missing' script is too old or missing]) -fi -]) - -# Helper functions for option handling. -*- Autoconf -*- - -# Copyright (C) 2001-2017 Free Software Foundation, Inc. -# -# This file is free software; the Free Software Foundation -# gives unlimited permission to copy and/or distribute it, -# with or without modifications, as long as this notice is preserved. - -# _AM_MANGLE_OPTION(NAME) -# ----------------------- -AC_DEFUN([_AM_MANGLE_OPTION], -[[_AM_OPTION_]m4_bpatsubst($1, [[^a-zA-Z0-9_]], [_])]) - -# _AM_SET_OPTION(NAME) -# -------------------- -# Set option NAME. Presently that only means defining a flag for this option. -AC_DEFUN([_AM_SET_OPTION], -[m4_define(_AM_MANGLE_OPTION([$1]), [1])]) - -# _AM_SET_OPTIONS(OPTIONS) -# ------------------------ -# OPTIONS is a space-separated list of Automake options. -AC_DEFUN([_AM_SET_OPTIONS], -[m4_foreach_w([_AM_Option], [$1], [_AM_SET_OPTION(_AM_Option)])]) - -# _AM_IF_OPTION(OPTION, IF-SET, [IF-NOT-SET]) -# ------------------------------------------- -# Execute IF-SET if OPTION is set, IF-NOT-SET otherwise. -AC_DEFUN([_AM_IF_OPTION], -[m4_ifset(_AM_MANGLE_OPTION([$1]), [$2], [$3])]) - -# Copyright (C) 1999-2017 Free Software Foundation, Inc. -# -# This file is free software; the Free Software Foundation -# gives unlimited permission to copy and/or distribute it, -# with or without modifications, as long as this notice is preserved. - -# _AM_PROG_CC_C_O -# --------------- -# Like AC_PROG_CC_C_O, but changed for automake. We rewrite AC_PROG_CC -# to automatically call this. -AC_DEFUN([_AM_PROG_CC_C_O], -[AC_REQUIRE([AM_AUX_DIR_EXPAND])dnl -AC_REQUIRE_AUX_FILE([compile])dnl -AC_LANG_PUSH([C])dnl -AC_CACHE_CHECK( - [whether $CC understands -c and -o together], - [am_cv_prog_cc_c_o], - [AC_LANG_CONFTEST([AC_LANG_PROGRAM([])]) - # Make sure it works both with $CC and with simple cc. - # Following AC_PROG_CC_C_O, we do the test twice because some - # compilers refuse to overwrite an existing .o file with -o, - # though they will create one. - am_cv_prog_cc_c_o=yes - for am_i in 1 2; do - if AM_RUN_LOG([$CC -c conftest.$ac_ext -o conftest2.$ac_objext]) \ - && test -f conftest2.$ac_objext; then - : OK - else - am_cv_prog_cc_c_o=no - break - fi - done - rm -f core conftest* - unset am_i]) -if test "$am_cv_prog_cc_c_o" != yes; then - # Losing compiler, so override with the script. - # FIXME: It is wrong to rewrite CC. - # But if we don't then we get into trouble of one sort or another. - # A longer-term fix would be to have automake use am__CC in this case, - # and then we could set am__CC="\$(top_srcdir)/compile \$(CC)" - CC="$am_aux_dir/compile $CC" -fi -AC_LANG_POP([C])]) - -# For backward compatibility. -AC_DEFUN_ONCE([AM_PROG_CC_C_O], [AC_REQUIRE([AC_PROG_CC])]) - -# Copyright (C) 2001-2017 Free Software Foundation, Inc. -# -# This file is free software; the Free Software Foundation -# gives unlimited permission to copy and/or distribute it, -# with or without modifications, as long as this notice is preserved. - -# AM_RUN_LOG(COMMAND) -# ------------------- -# Run COMMAND, save the exit status in ac_status, and log it. -# (This has been adapted from Autoconf's _AC_RUN_LOG macro.) -AC_DEFUN([AM_RUN_LOG], -[{ echo "$as_me:$LINENO: $1" >&AS_MESSAGE_LOG_FD - ($1) >&AS_MESSAGE_LOG_FD 2>&AS_MESSAGE_LOG_FD - ac_status=$? - echo "$as_me:$LINENO: \$? = $ac_status" >&AS_MESSAGE_LOG_FD - (exit $ac_status); }]) - -# Check to make sure that the build environment is sane. -*- Autoconf -*- - -# Copyright (C) 1996-2017 Free Software Foundation, Inc. -# -# This file is free software; the Free Software Foundation -# gives unlimited permission to copy and/or distribute it, -# with or without modifications, as long as this notice is preserved. - -# AM_SANITY_CHECK -# --------------- -AC_DEFUN([AM_SANITY_CHECK], -[AC_MSG_CHECKING([whether build environment is sane]) -# Reject unsafe characters in $srcdir or the absolute working directory -# name. Accept space and tab only in the latter. -am_lf=' -' -case `pwd` in - *[[\\\"\#\$\&\'\`$am_lf]]*) - AC_MSG_ERROR([unsafe absolute working directory name]);; -esac -case $srcdir in - *[[\\\"\#\$\&\'\`$am_lf\ \ ]]*) - AC_MSG_ERROR([unsafe srcdir value: '$srcdir']);; -esac - -# Do 'set' in a subshell so we don't clobber the current shell's -# arguments. Must try -L first in case configure is actually a -# symlink; some systems play weird games with the mod time of symlinks -# (eg FreeBSD returns the mod time of the symlink's containing -# directory). -if ( - am_has_slept=no - for am_try in 1 2; do - echo "timestamp, slept: $am_has_slept" > conftest.file - set X `ls -Lt "$srcdir/configure" conftest.file 2> /dev/null` - if test "$[*]" = "X"; then - # -L didn't work. - set X `ls -t "$srcdir/configure" conftest.file` - fi - if test "$[*]" != "X $srcdir/configure conftest.file" \ - && test "$[*]" != "X conftest.file $srcdir/configure"; then - - # If neither matched, then we have a broken ls. This can happen - # if, for instance, CONFIG_SHELL is bash and it inherits a - # broken ls alias from the environment. This has actually - # happened. Such a system could not be considered "sane". - AC_MSG_ERROR([ls -t appears to fail. Make sure there is not a broken - alias in your environment]) - fi - if test "$[2]" = conftest.file || test $am_try -eq 2; then - break - fi - # Just in case. - sleep 1 - am_has_slept=yes - done - test "$[2]" = conftest.file - ) -then - # Ok. - : -else - AC_MSG_ERROR([newly created file is older than distributed files! -Check your system clock]) -fi -AC_MSG_RESULT([yes]) -# If we didn't sleep, we still need to ensure time stamps of config.status and -# generated files are strictly newer. -am_sleep_pid= -if grep 'slept: no' conftest.file >/dev/null 2>&1; then - ( sleep 1 ) & - am_sleep_pid=$! -fi -AC_CONFIG_COMMANDS_PRE( - [AC_MSG_CHECKING([that generated files are newer than configure]) - if test -n "$am_sleep_pid"; then - # Hide warnings about reused PIDs. - wait $am_sleep_pid 2>/dev/null - fi - AC_MSG_RESULT([done])]) -rm -f conftest.file -]) - -# Copyright (C) 2009-2017 Free Software Foundation, Inc. -# -# This file is free software; the Free Software Foundation -# gives unlimited permission to copy and/or distribute it, -# with or without modifications, as long as this notice is preserved. - -# AM_SILENT_RULES([DEFAULT]) -# -------------------------- -# Enable less verbose build rules; with the default set to DEFAULT -# ("yes" being less verbose, "no" or empty being verbose). -AC_DEFUN([AM_SILENT_RULES], -[AC_ARG_ENABLE([silent-rules], [dnl -AS_HELP_STRING( - [--enable-silent-rules], - [less verbose build output (undo: "make V=1")]) -AS_HELP_STRING( - [--disable-silent-rules], - [verbose build output (undo: "make V=0")])dnl -]) -case $enable_silent_rules in @%:@ ((( - yes) AM_DEFAULT_VERBOSITY=0;; - no) AM_DEFAULT_VERBOSITY=1;; - *) AM_DEFAULT_VERBOSITY=m4_if([$1], [yes], [0], [1]);; -esac -dnl -dnl A few 'make' implementations (e.g., NonStop OS and NextStep) -dnl do not support nested variable expansions. -dnl See automake bug#9928 and bug#10237. -am_make=${MAKE-make} -AC_CACHE_CHECK([whether $am_make supports nested variables], - [am_cv_make_support_nested_variables], - [if AS_ECHO([['TRUE=$(BAR$(V)) -BAR0=false -BAR1=true -V=1 -am__doit: - @$(TRUE) -.PHONY: am__doit']]) | $am_make -f - >/dev/null 2>&1; then - am_cv_make_support_nested_variables=yes -else - am_cv_make_support_nested_variables=no -fi]) -if test $am_cv_make_support_nested_variables = yes; then - dnl Using '$V' instead of '$(V)' breaks IRIX make. - AM_V='$(V)' - AM_DEFAULT_V='$(AM_DEFAULT_VERBOSITY)' -else - AM_V=$AM_DEFAULT_VERBOSITY - AM_DEFAULT_V=$AM_DEFAULT_VERBOSITY -fi -AC_SUBST([AM_V])dnl -AM_SUBST_NOTMAKE([AM_V])dnl -AC_SUBST([AM_DEFAULT_V])dnl -AM_SUBST_NOTMAKE([AM_DEFAULT_V])dnl -AC_SUBST([AM_DEFAULT_VERBOSITY])dnl -AM_BACKSLASH='\' -AC_SUBST([AM_BACKSLASH])dnl -_AM_SUBST_NOTMAKE([AM_BACKSLASH])dnl -]) - -# Copyright (C) 2001-2017 Free Software Foundation, Inc. -# -# This file is free software; the Free Software Foundation -# gives unlimited permission to copy and/or distribute it, -# with or without modifications, as long as this notice is preserved. - -# AM_PROG_INSTALL_STRIP -# --------------------- -# One issue with vendor 'install' (even GNU) is that you can't -# specify the program used to strip binaries. This is especially -# annoying in cross-compiling environments, where the build's strip -# is unlikely to handle the host's binaries. -# Fortunately install-sh will honor a STRIPPROG variable, so we -# always use install-sh in "make install-strip", and initialize -# STRIPPROG with the value of the STRIP variable (set by the user). -AC_DEFUN([AM_PROG_INSTALL_STRIP], -[AC_REQUIRE([AM_PROG_INSTALL_SH])dnl -# Installed binaries are usually stripped using 'strip' when the user -# run "make install-strip". However 'strip' might not be the right -# tool to use in cross-compilation environments, therefore Automake -# will honor the 'STRIP' environment variable to overrule this program. -dnl Don't test for $cross_compiling = yes, because it might be 'maybe'. -if test "$cross_compiling" != no; then - AC_CHECK_TOOL([STRIP], [strip], :) -fi -INSTALL_STRIP_PROGRAM="\$(install_sh) -c -s" -AC_SUBST([INSTALL_STRIP_PROGRAM])]) - -# Copyright (C) 2006-2017 Free Software Foundation, Inc. -# -# This file is free software; the Free Software Foundation -# gives unlimited permission to copy and/or distribute it, -# with or without modifications, as long as this notice is preserved. - -# _AM_SUBST_NOTMAKE(VARIABLE) -# --------------------------- -# Prevent Automake from outputting VARIABLE = @VARIABLE@ in Makefile.in. -# This macro is traced by Automake. -AC_DEFUN([_AM_SUBST_NOTMAKE]) - -# AM_SUBST_NOTMAKE(VARIABLE) -# -------------------------- -# Public sister of _AM_SUBST_NOTMAKE. -AC_DEFUN([AM_SUBST_NOTMAKE], [_AM_SUBST_NOTMAKE($@)]) - -# Check how to create a tarball. -*- Autoconf -*- - -# Copyright (C) 2004-2017 Free Software Foundation, Inc. -# -# This file is free software; the Free Software Foundation -# gives unlimited permission to copy and/or distribute it, -# with or without modifications, as long as this notice is preserved. - -# _AM_PROG_TAR(FORMAT) -# -------------------- -# Check how to create a tarball in format FORMAT. -# FORMAT should be one of 'v7', 'ustar', or 'pax'. -# -# Substitute a variable $(am__tar) that is a command -# writing to stdout a FORMAT-tarball containing the directory -# $tardir. -# tardir=directory && $(am__tar) > result.tar -# -# Substitute a variable $(am__untar) that extract such -# a tarball read from stdin. -# $(am__untar) < result.tar -# -AC_DEFUN([_AM_PROG_TAR], -[# Always define AMTAR for backward compatibility. Yes, it's still used -# in the wild :-( We should find a proper way to deprecate it ... -AC_SUBST([AMTAR], ['$${TAR-tar}']) - -# We'll loop over all known methods to create a tar archive until one works. -_am_tools='gnutar m4_if([$1], [ustar], [plaintar]) pax cpio none' - -m4_if([$1], [v7], - [am__tar='$${TAR-tar} chof - "$$tardir"' am__untar='$${TAR-tar} xf -'], - - [m4_case([$1], - [ustar], - [# The POSIX 1988 'ustar' format is defined with fixed-size fields. - # There is notably a 21 bits limit for the UID and the GID. In fact, - # the 'pax' utility can hang on bigger UID/GID (see automake bug#8343 - # and bug#13588). - am_max_uid=2097151 # 2^21 - 1 - am_max_gid=$am_max_uid - # The $UID and $GID variables are not portable, so we need to resort - # to the POSIX-mandated id(1) utility. Errors in the 'id' calls - # below are definitely unexpected, so allow the users to see them - # (that is, avoid stderr redirection). - am_uid=`id -u || echo unknown` - am_gid=`id -g || echo unknown` - AC_MSG_CHECKING([whether UID '$am_uid' is supported by ustar format]) - if test $am_uid -le $am_max_uid; then - AC_MSG_RESULT([yes]) - else - AC_MSG_RESULT([no]) - _am_tools=none - fi - AC_MSG_CHECKING([whether GID '$am_gid' is supported by ustar format]) - if test $am_gid -le $am_max_gid; then - AC_MSG_RESULT([yes]) - else - AC_MSG_RESULT([no]) - _am_tools=none - fi], - - [pax], - [], - - [m4_fatal([Unknown tar format])]) - - AC_MSG_CHECKING([how to create a $1 tar archive]) - - # Go ahead even if we have the value already cached. We do so because we - # need to set the values for the 'am__tar' and 'am__untar' variables. - _am_tools=${am_cv_prog_tar_$1-$_am_tools} - - for _am_tool in $_am_tools; do - case $_am_tool in - gnutar) - for _am_tar in tar gnutar gtar; do - AM_RUN_LOG([$_am_tar --version]) && break - done - am__tar="$_am_tar --format=m4_if([$1], [pax], [posix], [$1]) -chf - "'"$$tardir"' - am__tar_="$_am_tar --format=m4_if([$1], [pax], [posix], [$1]) -chf - "'"$tardir"' - am__untar="$_am_tar -xf -" - ;; - plaintar) - # Must skip GNU tar: if it does not support --format= it doesn't create - # ustar tarball either. - (tar --version) >/dev/null 2>&1 && continue - am__tar='tar chf - "$$tardir"' - am__tar_='tar chf - "$tardir"' - am__untar='tar xf -' - ;; - pax) - am__tar='pax -L -x $1 -w "$$tardir"' - am__tar_='pax -L -x $1 -w "$tardir"' - am__untar='pax -r' - ;; - cpio) - am__tar='find "$$tardir" -print | cpio -o -H $1 -L' - am__tar_='find "$tardir" -print | cpio -o -H $1 -L' - am__untar='cpio -i -H $1 -d' - ;; - none) - am__tar=false - am__tar_=false - am__untar=false - ;; - esac - - # If the value was cached, stop now. We just wanted to have am__tar - # and am__untar set. - test -n "${am_cv_prog_tar_$1}" && break - - # tar/untar a dummy directory, and stop if the command works. - rm -rf conftest.dir - mkdir conftest.dir - echo GrepMe > conftest.dir/file - AM_RUN_LOG([tardir=conftest.dir && eval $am__tar_ >conftest.tar]) - rm -rf conftest.dir - if test -s conftest.tar; then - AM_RUN_LOG([$am__untar /dev/null 2>&1 && break - fi - done - rm -rf conftest.dir - - AC_CACHE_VAL([am_cv_prog_tar_$1], [am_cv_prog_tar_$1=$_am_tool]) - AC_MSG_RESULT([$am_cv_prog_tar_$1])]) - -AC_SUBST([am__tar]) -AC_SUBST([am__untar]) -]) # _AM_PROG_TAR - -m4_include([m4/codeset.m4]) -m4_include([m4/gettext.m4]) -m4_include([m4/iconv.m4]) -m4_include([m4/intlmacosx.m4]) -m4_include([m4/lib-ld.m4]) -m4_include([m4/lib-link.m4]) -m4_include([m4/lib-prefix.m4]) -m4_include([m4/libtool.m4]) -m4_include([m4/ltoptions.m4]) -m4_include([m4/ltsugar.m4]) -m4_include([m4/ltversion.m4]) -m4_include([m4/lt~obsolete.m4]) -m4_include([m4/m4_ax_check_define.m4]) -m4_include([m4/m4_ax_code_coverage.m4]) -m4_include([m4/nls.m4]) -m4_include([m4/pkg.m4]) -m4_include([m4/po.m4]) -m4_include([m4/progtest.m4]) diff -Nru gnucobol-4.0~early~20200606/AUTHORS gnucobol-5/AUTHORS --- gnucobol-4.0~early~20200606/AUTHORS 2020-06-06 20:52:02.000000000 +0000 +++ gnucobol-5/AUTHORS 1970-01-01 00:00:00.000000000 +0000 @@ -1,17 +0,0 @@ -* Keisuke Nishida wrote -cobc/*, libcob/*, libcob.h, libcob.conf, cob-config.in, -and po/ja.po. - -* lib/getopt1.c, lib/getopt.h, lib/getopt1.c were extracted -from the GNU C Library 2.3.2. Distributed under GNU LGPL. - -* lib/gettext.h was extracted from the GNU gettext 0.11.2. -Distributed under GNU LGPL. - -* libcob/byteswap.h (included in libcob/common.h later on) -was extracted from GLIB 2.2.2 and modified by Keisuke Nishida -and Roger While. Distributed under GNU LGPL. - -* bin/gcdiff.c was written by Ron Norman - -* libcob/reportio.c was written by Ron Norman diff -Nru gnucobol-4.0~early~20200606/autogen.sh gnucobol-5/autogen.sh --- gnucobol-4.0~early~20200606/autogen.sh 2020-06-06 20:52:02.000000000 +0000 +++ gnucobol-5/autogen.sh 1970-01-01 00:00:00.000000000 +0000 @@ -1,44 +0,0 @@ -#!/bin/sh -# autogen.sh gnucobol -# Bootstrap gnucobol package from checked-out sources -# Note: call as ./autogen.sh if you don't have readlink -f -# -# Copyright (C) 2019 Free Software Foundation, Inc. -# Written by Simon Sobisch -# -# This file is part of GnuCOBOL. -# -# The GnuCOBOL compiler is free software: you can redistribute it -# and/or modify it under the terms of the GNU General Public License -# as published by the Free Software Foundation, either version 3 of the -# License, or (at your option) any later version. -# -# GnuCOBOL is distributed in the hope that it will be useful, -# but WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -# GNU General Public License for more details. -# -# You should have received a copy of the GNU General Public License -# along with GnuCOBOL. If not, see . - -me=autogen.sh - -# get path to GnuCOBOL main directory -if test "$0" = "./$me"; then - MAINPATH=. - GCMAINPATH=".." -else - MAINPATH=$(dirname $(readlink -f "$0")) - GCMAINPATH="$MAINPATH" -fi -if test ! -f $MAINPATH/$me; then - echo; echo "ERROR - cannot set main directory [checked $MAINPATH/build_aux/$me] - aborting $me" && exit 1 -fi - -olddir_autogen=`pwd` -cd $MAINPATH/build_aux && (chmod -f u+x ./bootstrap; ./bootstrap); ret=$? -cd $olddir_autogen - -if test $ret -ne 0; then - exit $ret -fi diff -Nru gnucobol-4.0~early~20200606/bin/ChangeLog gnucobol-5/bin/ChangeLog --- gnucobol-4.0~early~20200606/bin/ChangeLog 2020-06-06 20:52:01.000000000 +0000 +++ gnucobol-5/bin/ChangeLog 1970-01-01 00:00:00.000000000 +0000 @@ -1,236 +0,0 @@ - -2020-03-11 Simon Sobisch - - * Makefile.am: honor new conditional MAKE_HAS_PREREQ_ONLY - * Makefile.am: adjusted invocation of help2man, using new defines - HELPSOURCES and HELP2MAN_OPTS - -2019-06-05 Simon Sobisch - - * Makefile.am: gcdiff - removed extra link and compiler flags fixing - build on systems that don't link via -lcob - -2019-04-07 Simon Sobisch - - * Makefile.am (COBCRUN): use pre-inst-env ensuring to use the built version - -2019-03-19 Simon Sobisch - - * cobcrun.c: use of COB_MAX_NAMELEN - -2018-07-16 Brian Tiffin - - * Makefile.am: add cob-config.1 to dist_man - -2018-06-16 Ludwin Janvier - - * cob-config.1: added minimal manpage for cob-config - -2018-06-04 Simon Sobisch - - * Makefile.am: remove path output when creating manpage - -2018-03-05 Simon Sobisch - - * Makefile.am (maintainer-clean): remove generated manpage - -2018-02-12 Simon Sobisch - - * cobcrun.c: renamed -runtime-conf to -runtime-config - -2018-01-23 Simon Sobisch - - * cobcrun.c (process_command_line): added missing arg shift for --brief/-q - -2018-01-19 Simon Sobisch - - * cobcrun.c (main): raise explicit error if called without any PROGRAM - name given - * cobcrun.c (cobcrun_initial_module): removed code parts for extending - environment options where not needed - -2017-12-27 Simon Sobisch - - * cobcrun.c (main): use of cob_resolve_cobol instead of cob_resolve - as we want its error handling in any case - -2017-12-05 Simon Sobisch - - * cobcrun.c [_WIN32]: added missing headers - * cobcrun.c (cobcrun_split_path_file): no trailing slash for pathname - -2017-11-21 Simon Sobisch - - * cobcrun.c [_WIN32]: allowing tests to result in the expected line - ending for messages returned from cobcrun.c directly - -2017-11-15 Simon Sobisch - - * cobcrun.c: use (cob_init_nomain) instead of (cob_init) as it includes - no functions intended for COBOL use (speedup + workaround ltdl leak) - -2017-11-02 Simon Sobisch - - * cobcrun.c: check missing evaluation of command line option; - fixed printing newline to stderr instead of stdout; - code-coverage specific changes - -2017-10-22 Simon Sobisch - - * Makefile.am: moved include of top_srcdir to AM_CPPFLAGS to prevent - user-specified CPPFLAGS to override own includes, see bug #452 - -2017-08-08 Simon Sobisch - - * cobcrun.c: use only memory and environment functions provided by libcob - * cobcrun.c (cobcrun_setenv): removed - -2017-06-16 Simon Sobisch - - * Makefile.am: added CODE_COVERAGE parts as provided by AX_CODE_COVERAGE - * cobcrun.c: don't print runtime env when program name > max length, - surrounded exception ABORTs that cannot be tested by LCOV_EXCP markers - -2017-02-05 Ron Norman - - * gcdiff.c: Updates to handle time compares and look for run options - in gcdiff.conf in current directory, started unified diff - -2017-02-04 Simon 'sf-mensch/human' Sobisch - - * gcdiff.c: added option to read files from stdin (GCD_DASH) - * gcdiff.c: added NLS and locale, changed fprintf calls to puts/printf, - added version output and used output for usage similar to cobcrun - * gcdiff.c [_WIN32]: compatibility changes - -2017-02-03 Ron Norman - - * gcdiff.c : New module for doing a 'diff' for test cases - * Makefile.am : Updated for gcdiff.c - -2017-01-10 Simon Sobisch - - * cobcrun.c: Copyright year 2017 - -2016-08-20 Simon Sobisch - - * cobcrun.c: fixed missing cob_stop_run() for --print-runtime-conf, - apply possible configuration files given on the command line before - and allow to use it together with starting a program - -2016-08-10 Simon Sobisch - - * cobcrun.c: added option --brief (-q) to remove the path to cobcrun - in argv[0] - -2016-06-29 Simon Sobisch - - * cobcrun.c (cobcrun_initial_module) [_WIN32]: fixed setting of - COB_PRE_LOAD and COB_LIBRARY_PATH to use PATHSEP_CHAR - -2016-06-21 Brian Tiffin - - * cobcrun.c : replaced cob_strdup. Need to revisit. - -2016-05-16 Brian Tiffin - - * cobcrun.c : replaced non-portable strndup, and fixed free with cob_free - -2016-05-15 Brian Tiffin - - * cobcrun.c : Added -M path/module command line option - if path/ found, prepend to COB_LIBRARY_PATH - if module (no slash) found, prepend to COB_PRE_LOAD - may set both. - -2016-01-30 Simon Sobisch - - * cobcrun.c (cobcrun_print_version): changed generation of build stamp - -2015-03-06 Simon Sobisch - - * cobcrun.c : new option --config= / -c for setting the - runtime configuration file to be loaded during initialisation - -2014-08-25 Simon Sobisch - - * cobcrun.c : Changed output of --help for help2man - * Makefile.am : Added manpage generation + install - -2014-05-06 Philipp Böhme - - * cobcrun.c : Added --runtime-env for displaying current runtime variables.; - --version shows both version numbers of cobcrun (new) and libcob.; - moved print_info (along with print_var) to libcob/common.c - -2014-02-17 Simon Sobisch - - * cobcrun.c : Tweaked --info for showing current settings (environment) along - with settings hard-wired during build (COB_xyz), - removed entries in output that belongs to cobc only - -2012-05-09 Simon Sobisch - - * cobcrun.c : Added conversion for enabling options in WIN style; - Use getopt for option parsing; - Set LC_ALL "" for native messages - -2010-06-28 Roger While - - * MARK - Version 2.0 - * Move to GPL/LGPL 3 - -2010-??-?? Roger While - - * Added --info - -2008-10-20 Roger While - - * cobcrun.c : Allow help and version options - -2007-12-27 Roger While - - ** Mark 1.0 RELEASE - -2006-10-23 Roger While - - * Makefile.am : Remove gcc options - -2005-12-31 Roger While - - * Makefile.am : Only generate version with shared library - -2005-08-04 Roger While - - * Change exit to cob_stop_run - -2005-05-27 Roger While - - * Fix Makefile again - -2005-05-03 Roger While - - * Fix makefile - -2005-02-02 Roger While - - * Forgot the GPL license - -2004-11-29 Roger While - - * Initial checkout - * cobcrun.c, Makefile.am, Makefile.in - * syntax : cobcrun MYPROG [ arguments to MYPROG] - * This allows complete applications to be compiled - as modules and offers similar functionality to - MF's cobrun and ACU's runcbl. - In fact, you can run all three in the same - directory and, if your scripts use an environment - variable for the driver program (e.g. $COBEXEC), - then you can switch easily. - - -Copyright 2004-2008,2010,2012,2014-2020 Free Software Foundation, Inc. - -Copying and distribution of this file, with or without modification, are -permitted provided the copyright notice and this notice are preserved. diff -Nru gnucobol-4.0~early~20200606/bin/cob-config.1 gnucobol-5/bin/cob-config.1 --- gnucobol-4.0~early~20200606/bin/cob-config.1 2020-06-06 20:52:01.000000000 +0000 +++ gnucobol-5/bin/cob-config.1 1970-01-01 00:00:00.000000000 +0000 @@ -1,27 +0,0 @@ -.TH cob-config "1" "July 2018" "cob-config (GnuCOBOL)" "User Commands" -.SH NAME -cob-config \- helper script for libcob (GnuCOBOL) -.SH SYNOPSIS -.B cob-config -[\fIoptions\fR] -.SH DESCRIPTION -This is a shell script which simplifies building applications against libcob. -.SH OPTIONS -.TP -\fB\-\-prefix\fR -echos the package\-prefix of libcob -.TP -\fB\-\-exec\-prefix\fR -echos the executable\-prefix of libcob -.TP -\fB\-\-version\fR -echos the release version of libcob -.TP -\fB\-\-libs\fR -echos the libraries needed to link with libcob -.TP -\fB\-\-cflags\fR -echos the C compiler flags needed to compile with libcob -.SH "SEE ALSO" -.BR cobc (1) -.BR cobcrun(1) diff -Nru gnucobol-4.0~early~20200606/bin/cob-config.in gnucobol-5/bin/cob-config.in --- gnucobol-4.0~early~20200606/bin/cob-config.in 2020-06-06 20:52:01.000000000 +0000 +++ gnucobol-5/bin/cob-config.in 1970-01-01 00:00:00.000000000 +0000 @@ -1,105 +0,0 @@ -#!/bin/sh -# -# cob-config -# -# Copyright (C) 2003-2012 Free Software Foundation, Inc. -# Written by Keisuke Nishida, Roger While -# -# This file is part of GnuCOBOL. -# -# The GnuCOBOL compiler is free software: you can redistribute it -# and/or modify it under the terms of the GNU General Public License -# as published by the Free Software Foundation, either version 3 of the -# License, or (at your option) any later version. -# -# GnuCOBOL is distributed in the hope that it will be useful, -# but WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -# GNU General Public License for more details. -# -# You should have received a copy of the GNU General Public License -# along with GnuCOBOL. If not, see . - - -prefix=@prefix@ -exec_prefix=${prefix} -exec_prefix_set=no -libdir=@libdir@ -includedir=@includedir@ - -version="@VERSION@.@COB_PATCH_LEVEL@" -cflags="@COB_CFLAGS@" -libs="@COB_LIBS@" - -usage() -{ - cat <&2 -fi - -while test $# -gt 0; do - case "$1" in - -*=*) optarg=`echo "$1" | sed 's/[-_a-zA-Z0-9]*=//'` ;; - *) optarg= ;; - esac - - case $1 in - --prefix=*) - prefix=$optarg - if test $exec_prefix_set = no ; then - exec_prefix=$optarg - fi - ;; - --prefix) - echo_prefix=yes - ;; - --exec-prefix=*) - exec_prefix=$optarg - exec_prefix_set=yes - ;; - --exec-prefix) - echo_exec_prefix=yes - ;; - --version) - echo $version - ;; - --cflags) - echo_cflags=yes - ;; - --libs) - echo_libs=yes - ;; - *) - usage 1 1>&2 - ;; - esac - shift -done - -if test "$echo_prefix" = "yes"; then - echo $prefix -fi - -if test "$echo_exec_prefix" = "yes"; then - echo $exec_prefix -fi - -if test "$echo_cflags" = "yes"; then - echo $cflags -fi - -if test "$echo_libs" = "yes"; then - echo $libs -fi diff -Nru gnucobol-4.0~early~20200606/bin/cobcrun.1 gnucobol-5/bin/cobcrun.1 --- gnucobol-4.0~early~20200606/bin/cobcrun.1 2020-06-06 20:52:36.000000000 +0000 +++ gnucobol-5/bin/cobcrun.1 1970-01-01 00:00:00.000000000 +0000 @@ -1,75 +0,0 @@ -.\" DO NOT MODIFY THIS FILE! It was generated by help2man 1.47.6. -.TH COBCRUN "1" "June 2020" "cobcrun (GnuCOBOL) 4.0-early-dev.0" "User Commands" -.SH NAME -cobcrun \- manual page for cobcrun (GnuCOBOL) 4.0-early-dev.0 -.SH SYNOPSIS -.B cobcrun -[\fI\,options\/\fR] \fI\,PROGRAM \/\fR[\fI\,parameter \/\fR...] -.br -.B cobcrun -\fI\,options\/\fR -.SH DESCRIPTION -GnuCOBOL module loader -.SH OPTIONS -.TP -\fB\-h\fR, \fB\-help\fR -display this help and exit -.TP -\fB\-V\fR, \fB\-version\fR -display cobcrun and runtime version and exit -.TP -\fB\-i\fR, \fB\-info\fR -display runtime information (build/environment) -.TP -\fB\-c\fR , \fB\-config=\fR -set runtime configuration from -.TP -\fB\-r\fR, \fB\-runtime\-config\fR -display current runtime configuration -(value and origin for all settings) -.TP -\fB\-M\fR , \fB\-module=\fR -set entry point module name and/or load path -where \fB\-M\fR module prepends any directory to the -dynamic link loader library search path -and any basename to the module preload list -(COB_LIBRARY_PATH and/or COB_PRELOAD) -.SH AUTHOR -Written by Roger While, Simon Sobisch, Brian Tiffin -Built Jun 06 2020 20:52:35 -Packaged Jun 06 2020 20:52:05 UTC -.PP -libcob (GnuCOBOL) 4.0\-early\-dev.0 -Copyright \(co 2020 Free Software Foundation, Inc. -License LGPLv3+: GNU LGPL version 3 or later -This is free software; see the source for copying conditions. There is NO -warranty; not even for MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. -.PP -Written by Keisuke Nishida, Roger While, Ron Norman, Simon Sobisch, Edward Hart -Built Jun 06 2020 20:52:19 -Packaged Jun 06 2020 20:52:05 UTC -.SH "REPORTING BUGS" -Report bugs to: bug\-gnucobol@gnu.org -or (preferably) use the issue tracker via the home page. -.br -GnuCOBOL home page: -.br -General help using GNU software: -.SH COPYRIGHT -Copyright \(co 2019 Free Software Foundation, Inc. -License GPLv3+: GNU GPL version 3 or later -.br -This is free software; see the source for copying conditions. There is NO -warranty; not even for MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. -.SH "SEE ALSO" -The full documentation for -.B cobcrun -is maintained as a Texinfo manual. If the -.B info -and -.B cobcrun -programs are properly installed at your site, the command -.IP -.B info gnucobol -.PP -should give you access to the complete manual. diff -Nru gnucobol-4.0~early~20200606/bin/cobcrun.c gnucobol-5/bin/cobcrun.c --- gnucobol-4.0~early~20200606/bin/cobcrun.c 2020-06-06 20:52:01.000000000 +0000 +++ gnucobol-5/bin/cobcrun.c 1970-01-01 00:00:00.000000000 +0000 @@ -1,405 +0,0 @@ -/* - Copyright (C) 2004-2012, 2014-2019 Free Software Foundation, Inc. - Written by Roger While, Simon Sobisch, Brian Tiffin - - This file is part of GnuCOBOL. - - The GnuCOBOL module loader is free software: you can redistribute it - and/or modify it under the terms of the GNU General Public License - as published by the Free Software Foundation, either version 3 of the - License, or (at your option) any later version. - - GnuCOBOL is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with GnuCOBOL. If not, see . -*/ - -#include -#include - -#include -#include -#include -#include -#include - -#ifdef HAVE_LOCALE_H -#include -#endif -#ifdef HAVE_UNISTD_H -#include -#endif -#ifdef _WIN32 -#include -#include -#endif - -#include "../libcob/sysdefines.h" -#include "libcob.h" -#include "tarstamp.h" - -#include "libcob/cobgetopt.h" - -static int arg_shift = 1; -static int print_runtime_wanted = 0; - -static const char short_options[] = "+hirc:VqM:"; - -#define CB_NO_ARG no_argument -#define CB_RQ_ARG required_argument -#define CB_OP_ARG optional_argument - -static const struct option long_options[] = { - {"help", CB_NO_ARG, NULL, 'h'}, - {"info", CB_NO_ARG, NULL, 'i'}, - {"brief", CB_NO_ARG, NULL, 'q'}, - {"runtime-config", CB_NO_ARG, NULL, 'r'}, - {"config", CB_RQ_ARG, NULL, 'C'}, - {"version", CB_NO_ARG, NULL, 'V'}, - {"module", CB_RQ_ARG, NULL, 'm'}, - {NULL, 0, NULL, 0} -}; - -#ifdef ENABLE_NLS -#include "lib/gettext.h" -#define _(s) gettext(s) -#define N_(s) gettext_noop(s) -#else -#define _(s) s -#define N_(s) s -#endif - - -/** - * Display cobcrun build and version date - */ -static void -cobcrun_print_version (void) -{ - char cob_build_stamp[COB_MINI_BUFF]; - char month[64]; - int status, day, year; - - /* Set up build time stamp */ - memset (cob_build_stamp, 0, (size_t)COB_MINI_BUFF); - memset (month, 0, sizeof(month)); - day = 0; - year = 0; - status = sscanf (__DATE__, "%s %d %d", month, &day, &year); - /* LCOV_EXCL_START */ - if (status != 3) { - snprintf (cob_build_stamp, (size_t)COB_MINI_MAX, - "%s %s", __DATE__, __TIME__); - /* LCOV_EXCL_STOP */ - } else { - snprintf (cob_build_stamp, (size_t)COB_MINI_MAX, - "%s %2.2d %4.4d %s", month, day, year, __TIME__); - } - - printf ("cobcrun (%s) %s.%d\n", - PACKAGE_NAME, PACKAGE_VERSION, PATCH_LEVEL); - puts ("Copyright (C) 2019 Free Software Foundation, Inc."); - puts (_("License GPLv3+: GNU GPL version 3 or later ")); - puts (_("This is free software; see the source for copying conditions. There is NO\n" - "warranty; not even for MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.")); - printf (_("Written by %s\n"), "Roger While, Simon Sobisch, Brian Tiffin"); - printf (_("Built %s"), cob_build_stamp); - putchar ('\n'); - printf (_("Packaged %s"), COB_TAR_DATE); - putchar ('\n'); -} - -/** - * Display cobcrun help - */ -static void -cobcrun_print_usage (char * prog) -{ - puts (_("GnuCOBOL module loader")); - putchar ('\n'); - printf (_("Usage: %s [options] PROGRAM [parameter ...]"), prog); - putchar ('\n'); - printf (_(" or: %s options"), prog); - putchar ('\n'); - putchar ('\n'); - puts (_("Options:")); - puts (_(" -h, -help display this help and exit")); - puts (_(" -V, -version display cobcrun and runtime version and exit")); - puts (_(" -i, -info display runtime information (build/environment)")); -#if 0 /* Simon: currently only removing the path from cobcrun in output --> don't show */ - puts (_(" -q, -brief reduced displays")); -#endif - puts (_(" -c , -config= set runtime configuration from ")); - puts (_(" -r, -runtime-config display current runtime configuration\n" - " (value and origin for all settings)")); - puts (_(" -M , -module= set entry point module name and/or load path\n" - " where -M module prepends any directory to the\n" - " dynamic link loader library search path\n" - " and any basename to the module preload list\n" - " (COB_LIBRARY_PATH and/or COB_PRELOAD)")); - putchar ('\n'); - printf (_("Report bugs to: %s\n" - "or (preferably) use the issue tracker via the home page."), "bug-gnucobol@gnu.org"); - putchar ('\n'); - puts (_("GnuCOBOL home page: ")); - puts (_("General help using GNU software: ")); -} - -/** - * split into path and file, or just path, or just file - * returns allocated strings (possible emtpy) for both - * Note: cob_free must be called with *pathname and *filename - * for releasing memory after use - */ -static void -cobcrun_split_path_file (char** pathname, char** filename, char *pf) -{ - char *pos = pf; - char *next_pos; - - char sav; - - /* set pos to last slash (if any) */ - while ((next_pos = strpbrk (pos + 1, "\\/")) != NULL) { - pos = next_pos; - } - /* copy string up to last slash as pathname (possible emtpy) */ - sav = *pos; - *pos = 0; - *pathname = cob_strdup (pf); - *pos = sav; - - /* set pos to first character after last slash (if any) */ - if (pf != pos) { - pos++; - } - - /* copy string after last slash as filename (possible emtpy) */ - *filename = cob_strdup (pos); -} - -/** - * Prepend a new directory path to the library search COB_LIBRARY_PATH - * and setup a module COB_PRE_LOAD, for each component included. - */ -static const char * -cobcrun_initial_module (char *module_argument) -{ - char *pathname, *filename; - char env_space[COB_MEDIUM_BUFF], *envptr; - /* FIXME: split in two functions (one setting module, one setting path) - after allowing module with path in COB_PRE_LOAD */ - - /* LCOV_EXCL_START */ - if (!module_argument) { - /* never reached (getopt ensures that we have an argument), - just in to keep the analyzer happy */ - return "missing argument"; - } - /* LCOV_EXCL_STOP */ - - /* See if we have a /dir/path/module, or a /dir/path/ or a module (no slash) */ - cobcrun_split_path_file (&pathname, &filename, module_argument); - if (*pathname) { - /* TODO: check content, see libcob/common.h */ - envptr = getenv ("COB_LIBRARY_PATH"); - if (envptr - && strlen (envptr) + strlen (pathname) + 1 < COB_MEDIUM_MAX) { - memset (env_space, 0, COB_MEDIUM_BUFF); - snprintf (env_space, COB_MEDIUM_MAX, "%s%c%s", - pathname, PATHSEP_CHAR, envptr); - env_space[COB_MEDIUM_MAX] = 0; /* fixing code analyser warning */ - (void) cob_setenv ("COB_LIBRARY_PATH", env_space, 1); - } else { - (void) cob_setenv ("COB_LIBRARY_PATH", pathname, 1); - } - } - cob_free((void *)pathname); - - if (*filename) { - /* TODO: check content, see libcob/common.h */ - envptr = getenv ("COB_PRE_LOAD"); - if (envptr - && strlen (envptr) + strlen (filename) + 1 < COB_MEDIUM_MAX) { - memset (env_space, 0, COB_MEDIUM_BUFF); - snprintf (env_space, COB_MEDIUM_MAX, "%s%c%s", filename, - PATHSEP_CHAR, envptr); - env_space[COB_MEDIUM_MAX] = 0; /* fixing code analyser warning */ - (void) cob_setenv ("COB_PRE_LOAD", env_space, 1); - } else { - (void) cob_setenv ("COB_PRE_LOAD", filename, 1); - } - } - cob_free ((void *)filename); - return NULL; -} - -/** - * process the cobcrun command options - */ -static void -process_command_line (int argc, char *argv[]) -{ - int c, idx; - const char *err_msg; -#ifdef _WIN32 - int argnum; - - /* Translate command line arguments from WIN to UNIX style */ - argnum = 1; - while (++argnum <= argc) { - if (strrchr(argv[argnum - 1], '/') == argv[argnum - 1]) { - argv[argnum - 1][0] = '-'; - } - } -#endif - - /* c = -1 if idx > argc or argv[idx] has non-option */ - while ((c = cob_getopt_long_long (argc, argv, short_options, - long_options, &idx, 1)) >= 0) { - switch (c) { - case '?': - /* Unknown option or ambiguous */ - exit (1); - - case 'c': - case 'C': - /* -c , --config= */ - /* LCOV_EXCL_START */ - if (strlen (cob_optarg) > COB_SMALL_MAX) { - fputs (_("invalid configuration file name"), stderr); - putc ('\n', stderr); - fflush (stderr); - exit (1); - } - /* LCOV_EXCL_STOP */ - arg_shift++; - (void) cob_setenv ("COB_RUNTIME_CONFIG", cob_optarg, 1); - /* shift argument again if two part argument was used */ - if (c == 'c') { - arg_shift++; - } - break; - - case 'h': - /* --help */ - cobcrun_print_usage (argv[0]); - exit (0); - - case 'i': - /* --info */ - print_info (); - exit (0); - - case 'q': - /* --brief : reduced reporting */ - /* removes the path to cobc in argv[0] */ - strcpy (argv[0], "cobcrun"); /* set for simple compare in test suite - and other static output */ - arg_shift++; - break; - - case 'r': - /* --runtime-conf */ - print_runtime_wanted = 1; - arg_shift++; - break; - - case 'V': - /* --version */ - cobcrun_print_version (); - putchar ('\n'); - print_version (); - exit (0); - - case 'M': - case 'm': - /* -M , --module= */ - arg_shift++; - err_msg = cobcrun_initial_module (cob_optarg); - if (err_msg != NULL) { - fprintf (stderr, _("invalid module argument '%s'"), cob_optarg); - putc ('\n', stderr); - fputs (err_msg, stderr); - fflush (stderr); - exit (1); - } - /* shift argument again if two part argument was used */ - if (c == 'M') { - arg_shift++; - } - break; - - /* LCOV_EXCL_START */ - default: - /* not translated as it is an unlikely internal error: */ - fprintf (stderr, "missing evaluation of command line option '%c'", c); - putc ('\n', stderr); - fputs (_("Please report this!"), stderr); - fflush (stderr); - exit (1); - /* LCOV_EXCL_STOP */ - - } - } -} - -/** - * cobcrun, for invoking entry points from dynamic shared object libraries - */ -int -main (int argc, char **argv) -{ - cob_call_union unifunc; - -#ifdef HAVE_SETLOCALE - setlocale (LC_ALL, ""); -#endif - - /* minimal initialization of the environment like binding textdomain, - allowing test to be run under WIN32 (implied in cob_init(), - no need to call outside of GnuCOBOL) */ - cob_common_init (NULL); - - process_command_line (argc, argv); - - /* At least one option or module name needed */ - if (argc <= arg_shift) { - if (print_runtime_wanted) { - cob_init_nomain (0, &argv[0]); - print_runtime_conf (); - cob_stop_run (0); - } - fprintf (stderr, _("%s: missing PROGRAM name"), argv[0]); - putc ('\n', stderr); - fprintf (stderr, _("Try '%s --help' for more information."), argv[0]); - putc ('\n', stderr); - fflush (stderr); - return 1; - } - - if (strlen (argv[arg_shift]) > COB_MAX_NAMELEN) { - /* note: we allow up to COB_MAX_WORDLEN for relaxed syntax... */ - fprintf (stderr, _("%s: PROGRAM name exceeds %d characters"), argv[0], COB_MAX_NAMELEN); - putc ('\n', stderr); - fflush (stderr); - return 1; - } - - /* Initialize the COBOL system, resolve the PROGRAM name */ - /* and invoke, wrapped in a STOP RUN, if found */ - /* note: we use cob_init_nomain here as there are no functions */ - /* linked here we want to provide for the COBOL environment */ - cob_init_nomain (argc - arg_shift, &argv[arg_shift]); - if (print_runtime_wanted) { - print_runtime_conf (); - putc ('\n', stdout); - } - /* Note: cob_resolve_cobol takes care for call errors, no need to check here */ - unifunc.funcvoid = cob_resolve_cobol (argv[arg_shift], 0, 1); - cob_stop_run (unifunc.funcint()); -} diff -Nru gnucobol-4.0~early~20200606/bin/gcdiff.c gnucobol-5/bin/gcdiff.c --- gnucobol-4.0~early~20200606/bin/gcdiff.c 2020-06-06 20:52:01.000000000 +0000 +++ gnucobol-5/bin/gcdiff.c 1970-01-01 00:00:00.000000000 +0000 @@ -1,774 +0,0 @@ -/* - Copyright (C) 2017 Free Software Foundation, Inc. - Written by Ron Norman, Simon Sobisch - - This file is part of GnuCOBOL. - - The GnuCOBOL diff helper program is free software: you can redistribute it - and/or modify it under the terms of the GNU General Public License - as published by the Free Software Foundation, either version 3 of the - License, or (at your option) any later version. - - GnuCOBOL is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU Lesser General Public License for more details. - - You should have received a copy of the GNU Lesser General Public License - along with GnuCOBOL. If not, see . -*/ - -/* - Program: gcdiff.c - - Function: This program is used to compare GnuCOBOL test results - and handle expected difference such as Date/Time -*/ - -#include "config.h" -#include -#include -#ifdef HAVE_UNISTD_H -#include -#endif -#include -#include -#ifdef HAVE_SYS_TIME_H -#include -#endif -#include -#include -#include -#include -#include "tarstamp.h" -#include "libcob/cobgetopt.h" - -/* needed for time checks */ -#ifdef HAVE_LOCALE_H -#include -#endif - - -#if defined(ENABLE_NLS) && defined(COB_NLS_RUNTIME) -#include "defaults.h" /* get LOCALEDIR */ -#include "lib/gettext.h" -#define _(s) gettext(s) -#define N_(s) gettext_noop(s) -#else -#define _(s) s -#define N_(s) s -#endif - -/* Support for gcdiff from stdin */ -#define GCD_DASH "-" - -static char ign_char = '~'; /* This 'char' in reference file ignores same byte position in test file */ -static int ign_spaces = 0; /* If '1' then all spaces are ignored */ -static int be_quiet = 0; /* Be less wordy */ -static int unify = 0; /* Display changes 'unify' style */ -static int time_tol = (60*5); /* Times need to be this close */ -static struct stat st_ref; -static struct stat st_test; -static time_t nowis; -static char referencefile[256] = ""; -static char testfile[256] = ""; - -static const char short_options[] = "hqwuVr:t:C:e:I:f:T:x:v:"; - -#define CB_NO_ARG no_argument -#define CB_RQ_ARG required_argument -#define CB_OP_ARG optional_argument - -static const struct option long_options[] = { - {"help", CB_NO_ARG, NULL, 'h'}, - {"quiet", CB_NO_ARG, NULL, 'q'}, - {"spaces", CB_NO_ARG, NULL, 'w'}, - {"ref", CB_RQ_ARG, NULL, 'r'}, - {"test", CB_RQ_ARG, NULL, 't'}, - {"ign-char", CB_RQ_ARG, NULL, 'C'}, - {"ignore", CB_RQ_ARG, NULL, 'e'}, - {"skip", CB_RQ_ARG, NULL, 'I'}, - {"file-time", CB_RQ_ARG, NULL, 'f'}, - {"verify-time", CB_RQ_ARG, NULL, 'v'}, - {"current-time",CB_RQ_ARG, NULL, 'T'}, - {"tolerance", CB_RQ_ARG, NULL, 'x'}, - {"version", CB_NO_ARG, NULL, 'V'}, - {"unified", CB_NO_ARG, NULL, 'u'}, - {NULL, 0, NULL, 0} -}; - - -#define MAX_TEMPLATES 64 -static struct template_t { - short len; /* Length of 'pat' */ - short is_num; /* Alpha letters are really Digits */ - enum { - NOT_TIME = 0, - MODIFY_TIME = 1, /* Compare to 'testfile' modification time */ - CURRENT_TIME = 2, /* Compare to current time */ - VERIFY_TIME = 3 /* Just verify reasonable value */ - } is_time; /* Reconstruct and verify date/time */ - char *pat; -} templates[MAX_TEMPLATES] = { - {20,1,MODIFY_TIME, (char*)"MMM DD YYYY HH:MI:SS"}, - {20,1,CURRENT_TIME, (char*)"MMM DD YYYY HH-MI-SS"}, - {14,1,VERIFY_TIME, (char*)"YYYY/MM/DD HH:MI:SS"}, - {10,1,NOT_TIME, (char*)"YYYY/MM/DD"}, - { 8,1,NOT_TIME, (char*)"HH:MM:SS"}, - { 8,1,CURRENT_TIME, (char*)"HH:MI:SS"}, - { 8,1,NOT_TIME, (char*)"YY/MM/DD"}, - { 5,1,NOT_TIME, (char*)"HH:MM"}, - { 5,1,CURRENT_TIME, (char*)"HH:MI"}, - { 4,1,NOT_TIME, (char*)"YYYY"}, - { 3,0,NOT_TIME, (char*)"MMM"}, - { 3,0,NOT_TIME, (char*)"DDD"}, - { 2,1,NOT_TIME, (char*)"DD"}, - {-1,0,NOT_TIME,(char*)0} -}; - -static const char *days[7] = - {"Sunday", "Monday","Tuesday","Wednesday", - "Thursday","Friday","Saturday"}; -static const char *months[12] = - {"January", "February","March", "April", - "May", "June", "July", "August", - "September","October", "November","December"}; - -#define MAX_SKIP 64 -static struct { - short len; - char *pat; -} skip_lines[MAX_TEMPLATES]; - -/* Bubble sort Templates for longest first */ -static void -sort_templates() -{ - int i,j; - struct template_t tt; - - i = 1; - while ( i ) { - i = 0; - for (j=0; templates[j].len != -1; j++) { - if (templates[j+1].len != -1 - && templates[j].len < templates[j+1].len) { - i = 1; /* Swap is being done */ - memcpy(&tt, &templates[j], sizeof(struct template_t)); - memcpy(&templates[j], &templates[j+1],sizeof(struct template_t)); - memcpy(&templates[j+1], &tt, sizeof(struct template_t)); - } - } - } -} - -/* Add (or update) template string */ -static void -add_template(char *string, int num, int istime) -{ - int i, len; - len = strlen(string); - for (i=0; i < MAX_TEMPLATES-1; i++) { - if (templates[i].len == -1) { - templates[i].pat = strdup(string); - templates[i].len = len; - templates[i].is_num = num; - templates[i].is_time = istime; - sort_templates(); - break; - } - if (strcmp(templates[i].pat,string) == 0) { - templates[i].is_num = num; - templates[i].is_time = istime; - break; - } - } -} - -static void -print_template(const char *opt, const char *what, int type) -{ - int i,k; - const char *nl = ""; - - k = 100; - for (i=0; i < MAX_TEMPLATES-1 && templates[i].len > 0; i++) { - if (templates[i].is_time == type) { - if (k + templates[i].len > 58) { - printf("%s%16s %s : ",nl,what,opt); - k = 0; - } - if (k > 0) - printf(", "); - k += templates[i].len + 4; - printf("%.*s",templates[i].len,templates[i].pat); - what = " "; - opt = " "; - nl = "\n"; - } - } - if (k > 0) - putchar('\n'); -} - -static int -num_val( char *s, int len) -{ - int i, val; - for (i=val=0; i < len; i++) { - if (isdigit(*s)) - val = val * 10 + (*s - '0'); - s++; - } - return val; -} - -/* -* Output version information -*/ -static void -gcd_print_version (void) -{ - char cob_build_stamp[COB_MINI_BUFF]; - char month[64]; - int status, day, year; - - /* Set up build time stamp */ - memset (cob_build_stamp, 0, (size_t)COB_MINI_BUFF); - memset (month, 0, sizeof(month)); - day = 0; - year = 0; - status = sscanf (__DATE__, "%s %d %d", month, &day, &year); - if (status == 3) { - snprintf (cob_build_stamp, (size_t)COB_MINI_MAX, - "%s %02d %04d %s", month, day, year, __TIME__); - } else { - snprintf (cob_build_stamp, (size_t)COB_MINI_MAX, - "%s %s", __DATE__, __TIME__); - } - - printf ("gcdiff (%s) %s.%d\n", - PACKAGE_NAME, PACKAGE_VERSION, PATCH_LEVEL); - puts ("Copyright (C) 2017 Free Software Foundation, Inc."); - puts (_("License GPLv3+: GNU GPL version 3 or later ")); - puts (_("This is free software; see the source for copying conditions. There is NO\n" - "warranty; not even for MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.")); - printf (_("Written by %s"), "Ron Norman, Simon Sobisch"); - putchar ('\n'); - printf (_("Built %s"), cob_build_stamp); - putchar ('\n'); - printf (_("Packaged %s"), COB_TAR_DATE); - putchar ('\n'); -} - -/* - * Display program usage information -*/ -static void -gcd_usage (char *prog, char * referencefile) -{ - int i, k; - - puts (_("Compare GnuCOBOL test case files")); - putchar ('\n'); - printf (_("usage: %s [options] referencefile testfile"), prog); - putchar ('\n'); - putchar ('\n'); - puts (_("Options:")); - printf (_(" -C x character 'x' indicates ignore")); - if (ign_char) { - printf ("; %s: '%c'", _("default"), ign_char); - } - putchar('\n'); - puts (_(" -e STR string STR is ignored")); - puts (_(" -n STR string STR is ignored; alpha chars are DIGITS in testfile")); - puts (_(" -f STR STR is date/time pattern; date/time in testfile must be\n" - " close to modification time of testfile")); - puts (_(" -T STR STR is date/time pattern; date/time in testfile must be\n" - " close to current time of day")); - puts (_(" -v STR STR is date/time pattern; verify date/time in testfile")); - puts (_(" -I STR if STR is on line of referencefile, ignore complete line")); - printf (_(" -x secs seconds of difference allowed in time compare; default: %d"),time_tol); - putchar ('\n'); - puts (_(" -w ignore all spaces")); - puts (_(" -h, -help display this help and exit")); - puts (_(" -V, -version display version and exit")); - putchar ('\n'); - puts (_(" referencefile base text file (reference case) to compare with")); - puts (_(" testfile text file created by the test case to be compared")); - if (referencefile) { - sort_templates(); - putchar ('\n'); - printf (_("patterns looked for in '%s'"), - referencefile[0] > ' '?referencefile:"referencefile"); - putchar ('\n'); - print_template ("-T","current time",CURRENT_TIME); - print_template ("-v","verify time",VERIFY_TIME); - print_template ("-f","'testfile' time",MODIFY_TIME); - print_template ("-e","just ignore",NOT_TIME); - if (skip_lines[0].len > 0) { - putchar ('\n'); - puts (_("default strings to cause line to be ignored")); - for (i=k=0; i < MAX_SKIP-1 && skip_lines[i].len > 0; i++) { - k += skip_lines[i].len; - if (k + skip_lines[i].len > 70) { - putchar('\n'); - k = 0; - } - printf("%.*s ",skip_lines[i].len,skip_lines[i].pat); - } - putchar ('\n'); - } - } - putchar ('\n'); - printf (_("Report bugs to: %s or\n" - "use the preferred issue tracker via home page"), "bug-gnucobol@gnu.org"); - putchar ('\n'); - puts (_("GnuCOBOL home page: ")); - puts (_("General help using GNU software: ")); -} - -static int -trim_line(char *buf) -{ - int k; - for (k=strlen(buf); k > 0 - && (buf[k-1] == '\r' || buf[k-1] == '\n' || buf[k-1] == ' '); ) - buf[--k] = 0; - return k; -} - -/* - * Compare 'ref' to 'rslt' - */ -static int -compare_file(FILE *ref, FILE *rslt, FILE *rpt) -{ - char rbuf[4096], nbuf[4096]; - const char *tagout, *tagin; - int i, j, k, n, t, val, numdiff, linenum; - struct tm tval, *ptm; - time_t time_sec, time_diff; - - if (ref == NULL - || ferror(ref) - || feof(ref)) - return 2; - if (rslt == NULL - || ferror(rslt) - || feof(rslt)) - return 2; - if (unify) { - tagout = "-"; - tagin = "+"; - } else { - tagout = "< "; - tagin = "> "; - } - linenum = numdiff = 0; - memset(nbuf,0,sizeof(nbuf)); - memset(rbuf,0,sizeof(rbuf)); - while (fgets(rbuf,sizeof(rbuf),ref) != NULL) { - k = trim_line (rbuf); - if (fgets(nbuf,sizeof(nbuf),rslt) == NULL) - break; - j = trim_line (nbuf); - linenum++; - - for (t=0; skip_lines[t].len > 0; t++) { - if (strstr(rbuf, skip_lines[t].pat) != NULL) /* Is string on the line */ - break; - } - if (skip_lines[t].len > 0) /* Ignore complete line */ - continue; - for (i=j=0; i < k; i++,j++) { - if (ign_spaces) { - while (rbuf[i] == ' ' && i < k) i++; - while (nbuf[j] == ' ' && j < k) j++; - } - for (t=0; templates[t].len > 0; t++) { - if (memcmp(templates[t].pat, &rbuf[i], templates[t].len) == 0) - break; - } - if (templates[t].len > 0) { - if (templates[t].is_time) { /* Valid date/time expected */ - ptm = localtime(&nowis); - memcpy(&tval, (void*)ptm, sizeof(struct tm)); - - for (n=0; n < templates[t].len; i++,j++,n++) { - if (rbuf[i] == nbuf[j]) - continue; - if (memcmp(&rbuf[i],"YYYY",4) == 0) { - tval.tm_year = num_val (&nbuf[i], 4) - 1900; - i+=3,j+=3,n+=3; - } else if (memcmp(&rbuf[i],"YY",2) == 0) { - tval.tm_year = num_val (&nbuf[i], 2); - if (tval.tm_year < 70) - tval.tm_year += 100; /* 20yy */ - i++,j++,n++; - } else if (memcmp(&rbuf[i],"MMM",3) == 0) { - tval.tm_mon = -1; - for (val = 0; val < 12; val++) { - if (strncasecmp(&nbuf[i],months[val],3) == 0) { - tval.tm_mon = val; - break; - } - } - i+=2,j+=2,n+=2; - } else if (memcmp(&rbuf[i],"MM",2) == 0) { - tval.tm_mon = num_val (&nbuf[i], 2) - 1; - i++,j++,n++; - } else if (memcmp(&rbuf[i],"DDD",3) == 0) { - tval.tm_wday = -1; - for (val = 0; val < 7; val++) { - if (strncasecmp(&nbuf[i],days[val],3) == 0) { - tval.tm_wday = val; - break; - } - } - } else if (memcmp(&rbuf[i],"DD",2) == 0) { - tval.tm_mday = num_val (&nbuf[i], 2); - i++,j++,n++; - } else if (memcmp(&rbuf[i],"HH",2) == 0) { - tval.tm_hour = num_val (&nbuf[i], 2); - i++,j++,n++; - } else if (memcmp(&rbuf[i],"MI",2) == 0) { - tval.tm_min = num_val (&nbuf[i], 2); - i++,j++,n++; - } else if (memcmp(&rbuf[i],"SS",2) == 0) { - tval.tm_sec = num_val (&nbuf[i], 2); - i++,j++,n++; - } - } - time_sec = mktime(&tval); - if(templates[t].is_time == CURRENT_TIME) { - if (time_sec < nowis) - time_diff = nowis - time_sec; - else - time_diff = time_sec - nowis; - if (time_diff > time_tol) { - printf(_("Time: %04d/%02d/%02d %02d:%02d:%02d too far off current time"), - tval.tm_year+1900, tval.tm_mon+1, tval.tm_mday, - tval.tm_hour, tval.tm_min, tval.tm_sec); - printf(" %04d/%02d/%02d %02d:%02d:%02d\n", - ptm->tm_year+1900, ptm->tm_mon+1, ptm->tm_mday, - ptm->tm_hour, ptm->tm_min, ptm->tm_sec); - goto mis_match; - } - } else - if(templates[t].is_time == MODIFY_TIME) { - if (time_sec < st_test.st_mtime) - time_diff = st_test.st_mtime - time_sec; - else - time_diff = time_sec - st_test.st_mtime; - if (time_diff > time_tol) { - ptm = localtime(&st_test.st_mtime); - printf(_("Time: %04d/%02d/%02d %02d:%02d:%02d too far off file time"), - tval.tm_year+1900, tval.tm_mon+1, tval.tm_mday, - tval.tm_hour, tval.tm_min, tval.tm_sec); - printf(" %04d/%02d/%02d %02d:%02d:%02d\n", - ptm->tm_year+1900, ptm->tm_mon+1, ptm->tm_mday, - ptm->tm_hour, ptm->tm_min, ptm->tm_sec); - goto mis_match; - } - } else - if(templates[t].is_time == VERIFY_TIME) { - if (tval.tm_mon < 0 - || tval.tm_mon > 11) { - printf(_("Time: %04d/%02d/%02d %02d:%02d:%02d has invalid month"), - tval.tm_year+1900, tval.tm_mon+1, tval.tm_mday, - tval.tm_hour, tval.tm_min, tval.tm_sec); - putchar ('\n'); - goto mis_match; - } - if (tval.tm_mday < 1 - || tval.tm_mday > 31) { - printf(_("Time: %04d/%02d/%02d %02d:%02d:%02d has invalid day"), - tval.tm_year+1900, tval.tm_mon+1, tval.tm_mday, - tval.tm_hour, tval.tm_min, tval.tm_sec); - putchar ('\n'); - goto mis_match; - } - if (tval.tm_hour < 0 - || tval.tm_hour > 24) { - printf(_("Time: %04d/%02d/%02d %02d:%02d:%02d has invalid hour"), - tval.tm_year+1900, tval.tm_mon+1, tval.tm_mday, - tval.tm_hour, tval.tm_min, tval.tm_sec); - putchar ('\n'); - goto mis_match; - } - if (tval.tm_min < 0 - || tval.tm_min > 60) { - printf(_("Time: %04d/%02d/%02d %02d:%02d:%02d has invalid minutes"), - tval.tm_year+1900, tval.tm_mon+1, tval.tm_mday, - tval.tm_hour, tval.tm_min, tval.tm_sec); - putchar ('\n'); - goto mis_match; - } - if (tval.tm_sec < 0 - || tval.tm_sec > 60) { - printf(_("Time: %04d/%02d/%02d %02d:%02d:%02d has invalid seconds"), - tval.tm_year+1900, tval.tm_mon+1, tval.tm_mday, - tval.tm_hour, tval.tm_min, tval.tm_sec); - putchar ('\n'); - goto mis_match; - } - } - } else - if (templates[t].is_num) { /* Numeric data expected */ - for (n=0; n < templates[t].len; i++,j++,n++) { - if (rbuf[i] == nbuf[j]) - continue; - if (!isdigit(nbuf[j])) { - while (n < templates[t].len-1) - i++,j++,n++; - goto mis_match; - } - } - } else { - i += templates[t].len; - j += templates[t].len; - } - i--; j--; - continue; - } - if (rbuf[i] == nbuf[j]) - continue; - if (rbuf[i] == ign_char) - continue; -mis_match: - numdiff++; - if (!be_quiet) { - if (unify) { - fprintf(rpt,"@@ %d @@\n",linenum); - fprintf(rpt,"%s%s\n",tagout,rbuf); - fprintf(rpt,"%s%s\n",tagin,nbuf); - } else { - fprintf(rpt,"%dc%d\n",linenum,linenum); - fprintf(rpt,"%s%s\n",tagout,rbuf); - fprintf(rpt,"---\n"); - fprintf(rpt,"%s%s\n",tagin,nbuf); - } - } - break; - } - } - k = 0; - if (!feof(rslt) ) { - if(fgets(nbuf,sizeof(nbuf),rslt) != NULL) { - numdiff++; - j = trim_line (nbuf); - fprintf(rpt,"%da\n",linenum); - fprintf(rpt,"%s%s\n",tagin,nbuf); - k++; - } - } - if (feof(ref) - && feof(rslt)) - return 0; - if (!feof(rslt) - && !be_quiet) { - while (fgets(nbuf,sizeof(nbuf),rslt) != NULL) { - j = trim_line (nbuf); - if (k == 0) - fprintf(rpt,"%da\n",linenum); - fprintf(rpt,"%s%s\n",tagin,nbuf); - k++; - numdiff++; - } - } - if (numdiff > 0) - return 1; - return 1; -} - -static void -set_option (char *binary, int opt, char *arg) -{ - int i; - switch(opt) { - case 'w': - ign_spaces = 1; - break; - case 'q': - be_quiet = 1; - break; - case 'u': - unify = 1; - break; - case 'C': - ign_char = arg[0]; - break; - case 'r': - strcpy(referencefile,arg); - break; - case 't': - strcpy(testfile,arg); - break; - - case 'e': /* Ignore this 'string' */ - add_template(arg, 0, NOT_TIME); - break; - - case 'n': /* Ignore this 'string', ALPHA chars are really digits */ - add_template(arg, 1, NOT_TIME); - break; - - case 'f': /* Check date/time in testfile against testfile modification time */ - add_template(arg, 1, MODIFY_TIME); - break; - - case 'v': /* Verify valid date/time in testfile */ - add_template(arg, 1, VERIFY_TIME); - break; - - case 'x': /* Set date/time tolerance in seconds */ - time_tol = (int)atol(arg); - break; - - case 'T': /* Check date/time in testfile against current time */ - add_template(arg, 1, CURRENT_TIME); - break; - - case 'I': /* Ignore complete line based on given 'string' */ - for (i=0; i < MAX_SKIP-1; i++) { - if (skip_lines[i].len == -1) { - skip_lines[i].pat = strdup(arg); - skip_lines[i].len = strlen(arg); - break; - } - } - break; - - case '?': - default: - printf(_("unknown parameter '%c' for %s"),opt,binary); - putchar ('\n'); - gcd_usage((char*)"gcdiff", NULL); - exit(2); - break; - - case 'h': - gcd_usage((char*)"gcdiff", referencefile); - exit(2); - break; - - case 'V': - gcd_print_version (); - exit(2); - break; - } -} - -/* - * M A I N L I N E Starts here - */ -int -main( - int argc, - char *argv[]) -{ - int opt,idx,i,k; - FILE *ref,*rslt; - char buf[1024]; - -#ifdef HAVE_SETLOCALE - setlocale (LC_ALL, ""); -#endif - for (i=0; i < MAX_TEMPLATES; i++) { - if (templates[i].len == -1) { - while (i < MAX_TEMPLATES) { - templates[i].len = -1; - templates[i].pat = NULL; - i++; - } - } else if (templates[i].pat != NULL) { - templates[i].len = strlen(templates[i].pat); - } - } - for (i=0; i < MAX_SKIP; i++) { - skip_lines[i].len = -1; - skip_lines[i].pat = NULL; - } - memset(referencefile,0,sizeof(referencefile)); - memset(testfile,0,sizeof(testfile)); - - /* Process gcdiff.conf from current directory */ - ref = fopen("gcdiff.conf","r"); - if(ref) { - while (fgets(buf,sizeof(buf),ref) != NULL) { - k = trim_line (buf); - if (buf[0] == '-') { /* Option for gcdiff ?*/ - opt = buf[1]; - for (i=2; isspace(buf[i]); i++); - set_option((char*)"gcdiff.conf",opt,&buf[i]); - } - } - fclose(ref); - } - - idx = 0; - cob_optind = 1; - while ((opt = cob_getopt_long_long (argc, argv, short_options, - long_options, &idx, 1)) >= 0) { - set_option(argv[0], opt, cob_optarg); - } - - if (cob_optind < argc - && referencefile[0] <= ' ') { - strcpy(referencefile,argv[cob_optind++]); - } - if (cob_optind < argc - && testfile[0] <= ' ') { - strcpy(testfile,argv[cob_optind++]); - } - if (referencefile[0] <= ' ') { - puts (_("missing 'referencefile'")); - putchar ('\n'); - gcd_usage(argv[0], NULL); - exit(2); - } - if (testfile[0] <= ' ') { - puts (_("missing 'testfile'")); - putchar ('\n'); - gcd_usage(argv[0], NULL); - exit(2); - } - - sort_templates(); - time(&nowis); - - if (strcmp(referencefile, GCD_DASH) == 0) { - ref = stdin; - st_ref.st_atime = nowis; - st_ref.st_ctime = nowis; - st_ref.st_mtime = nowis; - } else { - stat (referencefile, &st_ref); - ref = fopen(referencefile,"r"); - } - if (ref == NULL) { - perror(referencefile); - exit(2); - } - if (strcmp(testfile, GCD_DASH) == 0) { - rslt = stdin; - st_test.st_atime = nowis; - st_test.st_ctime = nowis; - st_test.st_mtime = nowis; - } else { - stat (testfile, &st_test); - rslt = fopen(testfile,"r"); - } - if (rslt == NULL) { - perror(testfile); - exit(2); - } - k = compare_file (ref, rslt, stdout); - if (ref != stdin) - fclose(ref); - if (rslt != stdin) - fclose(rslt); - exit(k); - return k; -} diff -Nru gnucobol-4.0~early~20200606/bin/Makefile.am gnucobol-5/bin/Makefile.am --- gnucobol-4.0~early~20200606/bin/Makefile.am 2020-06-06 20:52:01.000000000 +0000 +++ gnucobol-5/bin/Makefile.am 1970-01-01 00:00:00.000000000 +0000 @@ -1,52 +0,0 @@ -# -# Makefile gnucobol/bin -# -# Copyright (C) 2001-2012, 2014, 2017-2020 Free Software Foundation, Inc. -# Written by Roger While, Simon Sobisch -# -# This file is part of GnuCOBOL. -# -# The GnuCOBOL compiler is free software: you can redistribute it -# and/or modify it under the terms of the GNU General Public License -# as published by the Free Software Foundation, either version 3 of the -# License, or (at your option) any later version. -# -# GnuCOBOL is distributed in the hope that it will be useful, -# but WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -# GNU General Public License for more details. -# -# You should have received a copy of the GNU General Public License -# along with GnuCOBOL. If not, see . - -bin_SCRIPTS = cob-config -bin_PROGRAMS = cobcrun gcdiff -cobcrun_SOURCES = cobcrun.c -dist_man_MANS = cobcrun.1 cob-config.1 -COBCRUN = cobcrun$(EXEEXT) -gcdiff_SOURCES = gcdiff.c - -AM_LDFLAGS = $(COB_EXPORT_DYN) -AM_CPPFLAGS = -I$(top_srcdir) -AM_CFLAGS = $(CODE_COVERAGE_CFLAGS) -cobcrun_LDADD = $(top_builddir)/lib/libsupport.a $(top_builddir)/libcob/libcob.la \ - $(CODE_COVERAGE_LIBS) -gcdiff_LDADD = $(top_builddir)/lib/libsupport.a $(top_builddir)/libcob/libcob.la - -# Add rules for code-coverage testing, as provided AX_CODE_COVERAGE -@CODE_COVERAGE_RULES@ -CODE_COVERAGE_BRANCH_COVERAGE=1 -CODE_COVERAGE_LCOV_OPTIONS = --no-external - -MAINTAINERCLEANFILES = cobcrun.1 - -HELPSOURCES = cobcrun.c $(top_srcdir)/configure.ac -HELP2MAN_OPTS = --info-page=$(PACKAGE) - -if MAKE_HAS_PREREQ_ONLY -cobcrun.1: $(HELPSOURCES) | $(COBCRUN) - "$(top_builddir)/pre-inst-env" $(HELP2MAN) --output=$@ $(HELP2MAN_OPTS) $(COBCRUN) -else -cobcrun.1: $(HELPSOURCES) - "$(top_builddir)/pre-inst-env" $(HELP2MAN) --output=$@ $(HELP2MAN_OPTS) $(COBCRUN) -endif diff -Nru gnucobol-4.0~early~20200606/bin/Makefile.in gnucobol-5/bin/Makefile.in --- gnucobol-4.0~early~20200606/bin/Makefile.in 2020-06-06 20:56:36.000000000 +0000 +++ gnucobol-5/bin/Makefile.in 1970-01-01 00:00:00.000000000 +0000 @@ -1,893 +0,0 @@ -# Makefile.in generated by automake 1.15.1 from Makefile.am. -# @configure_input@ - -# Copyright (C) 1994-2017 Free Software Foundation, Inc. - -# This Makefile.in is free software; the Free Software Foundation -# gives unlimited permission to copy and/or distribute it, -# with or without modifications, as long as this notice is preserved. - -# This program is distributed in the hope that it will be useful, -# but WITHOUT ANY WARRANTY, to the extent permitted by law; without -# even the implied warranty of MERCHANTABILITY or FITNESS FOR A -# PARTICULAR PURPOSE. - -@SET_MAKE@ - -# -# Makefile gnucobol/bin -# -# Copyright (C) 2001-2012, 2014, 2017-2020 Free Software Foundation, Inc. -# Written by Roger While, Simon Sobisch -# -# This file is part of GnuCOBOL. -# -# The GnuCOBOL compiler is free software: you can redistribute it -# and/or modify it under the terms of the GNU General Public License -# as published by the Free Software Foundation, either version 3 of the -# License, or (at your option) any later version. -# -# GnuCOBOL is distributed in the hope that it will be useful, -# but WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -# GNU General Public License for more details. -# -# You should have received a copy of the GNU General Public License -# along with GnuCOBOL. If not, see . - - -VPATH = @srcdir@ -am__is_gnu_make = { \ - if test -z '$(MAKELEVEL)'; then \ - false; \ - elif test -n '$(MAKE_HOST)'; then \ - true; \ - elif test -n '$(MAKE_VERSION)' && test -n '$(CURDIR)'; then \ - true; \ - else \ - false; \ - fi; \ -} -am__make_running_with_option = \ - case $${target_option-} in \ - ?) ;; \ - *) echo "am__make_running_with_option: internal error: invalid" \ - "target option '$${target_option-}' specified" >&2; \ - exit 1;; \ - esac; \ - has_opt=no; \ - sane_makeflags=$$MAKEFLAGS; \ - if $(am__is_gnu_make); then \ - sane_makeflags=$$MFLAGS; \ - else \ - case $$MAKEFLAGS in \ - *\\[\ \ ]*) \ - bs=\\; \ - sane_makeflags=`printf '%s\n' "$$MAKEFLAGS" \ - | sed "s/$$bs$$bs[$$bs $$bs ]*//g"`;; \ - esac; \ - fi; \ - skip_next=no; \ - strip_trailopt () \ - { \ - flg=`printf '%s\n' "$$flg" | sed "s/$$1.*$$//"`; \ - }; \ - for flg in $$sane_makeflags; do \ - test $$skip_next = yes && { skip_next=no; continue; }; \ - case $$flg in \ - *=*|--*) continue;; \ - -*I) strip_trailopt 'I'; skip_next=yes;; \ - -*I?*) strip_trailopt 'I';; \ - -*O) strip_trailopt 'O'; skip_next=yes;; \ - -*O?*) strip_trailopt 'O';; \ - -*l) strip_trailopt 'l'; skip_next=yes;; \ - -*l?*) strip_trailopt 'l';; \ - -[dEDm]) skip_next=yes;; \ - -[JT]) skip_next=yes;; \ - esac; \ - case $$flg in \ - *$$target_option*) has_opt=yes; break;; \ - esac; \ - done; \ - test $$has_opt = yes -am__make_dryrun = (target_option=n; $(am__make_running_with_option)) -am__make_keepgoing = (target_option=k; $(am__make_running_with_option)) -pkgdatadir = $(datadir)/@PACKAGE@ -pkgincludedir = $(includedir)/@PACKAGE@ -pkglibdir = $(libdir)/@PACKAGE@ -pkglibexecdir = $(libexecdir)/@PACKAGE@ -am__cd = CDPATH="$${ZSH_VERSION+.}$(PATH_SEPARATOR)" && cd -install_sh_DATA = $(install_sh) -c -m 644 -install_sh_PROGRAM = $(install_sh) -c -install_sh_SCRIPT = $(install_sh) -c -INSTALL_HEADER = $(INSTALL_DATA) -transform = $(program_transform_name) -NORMAL_INSTALL = : -PRE_INSTALL = : -POST_INSTALL = : -NORMAL_UNINSTALL = : -PRE_UNINSTALL = : -POST_UNINSTALL = : -build_triplet = @build@ -host_triplet = @host@ -bin_PROGRAMS = cobcrun$(EXEEXT) gcdiff$(EXEEXT) -subdir = bin -ACLOCAL_M4 = $(top_srcdir)/aclocal.m4 -am__aclocal_m4_deps = $(top_srcdir)/m4/codeset.m4 \ - $(top_srcdir)/m4/gettext.m4 $(top_srcdir)/m4/iconv.m4 \ - $(top_srcdir)/m4/intlmacosx.m4 $(top_srcdir)/m4/lib-ld.m4 \ - $(top_srcdir)/m4/lib-link.m4 $(top_srcdir)/m4/lib-prefix.m4 \ - $(top_srcdir)/m4/libtool.m4 $(top_srcdir)/m4/ltoptions.m4 \ - $(top_srcdir)/m4/ltsugar.m4 $(top_srcdir)/m4/ltversion.m4 \ - $(top_srcdir)/m4/lt~obsolete.m4 \ - $(top_srcdir)/m4/m4_ax_check_define.m4 \ - $(top_srcdir)/m4/m4_ax_code_coverage.m4 \ - $(top_srcdir)/m4/nls.m4 $(top_srcdir)/m4/pkg.m4 \ - $(top_srcdir)/m4/po.m4 $(top_srcdir)/m4/progtest.m4 \ - $(top_srcdir)/configure.ac -am__configure_deps = $(am__aclocal_m4_deps) $(CONFIGURE_DEPENDENCIES) \ - $(ACLOCAL_M4) -DIST_COMMON = $(srcdir)/Makefile.am $(am__DIST_COMMON) -mkinstalldirs = $(SHELL) $(top_srcdir)/build_aux/mkinstalldirs -CONFIG_HEADER = $(top_builddir)/config.h -CONFIG_CLEAN_FILES = cob-config -CONFIG_CLEAN_VPATH_FILES = -am__installdirs = "$(DESTDIR)$(bindir)" "$(DESTDIR)$(bindir)" \ - "$(DESTDIR)$(man1dir)" -PROGRAMS = $(bin_PROGRAMS) -am_cobcrun_OBJECTS = cobcrun.$(OBJEXT) -cobcrun_OBJECTS = $(am_cobcrun_OBJECTS) -am__DEPENDENCIES_1 = -cobcrun_DEPENDENCIES = $(top_builddir)/lib/libsupport.a \ - $(top_builddir)/libcob/libcob.la $(am__DEPENDENCIES_1) -AM_V_lt = $(am__v_lt_@AM_V@) -am__v_lt_ = $(am__v_lt_@AM_DEFAULT_V@) -am__v_lt_0 = --silent -am__v_lt_1 = -am_gcdiff_OBJECTS = gcdiff.$(OBJEXT) -gcdiff_OBJECTS = $(am_gcdiff_OBJECTS) -gcdiff_DEPENDENCIES = $(top_builddir)/lib/libsupport.a \ - $(top_builddir)/libcob/libcob.la -am__vpath_adj_setup = srcdirstrip=`echo "$(srcdir)" | sed 's|.|.|g'`; -am__vpath_adj = case $$p in \ - $(srcdir)/*) f=`echo "$$p" | sed "s|^$$srcdirstrip/||"`;; \ - *) f=$$p;; \ - esac; -am__strip_dir = f=`echo $$p | sed -e 's|^.*/||'`; -am__install_max = 40 -am__nobase_strip_setup = \ - srcdirstrip=`echo "$(srcdir)" | sed 's/[].[^$$\\*|]/\\\\&/g'` -am__nobase_strip = \ - for p in $$list; do echo "$$p"; done | sed -e "s|$$srcdirstrip/||" -am__nobase_list = $(am__nobase_strip_setup); \ - for p in $$list; do echo "$$p $$p"; done | \ - sed "s| $$srcdirstrip/| |;"' / .*\//!s/ .*/ ./; s,\( .*\)/[^/]*$$,\1,' | \ - $(AWK) 'BEGIN { files["."] = "" } { files[$$2] = files[$$2] " " $$1; \ - if (++n[$$2] == $(am__install_max)) \ - { print $$2, files[$$2]; n[$$2] = 0; files[$$2] = "" } } \ - END { for (dir in files) print dir, files[dir] }' -am__base_list = \ - sed '$$!N;$$!N;$$!N;$$!N;$$!N;$$!N;$$!N;s/\n/ /g' | \ - sed '$$!N;$$!N;$$!N;$$!N;s/\n/ /g' -am__uninstall_files_from_dir = { \ - test -z "$$files" \ - || { test ! -d "$$dir" && test ! -f "$$dir" && test ! -r "$$dir"; } \ - || { echo " ( cd '$$dir' && rm -f" $$files ")"; \ - $(am__cd) "$$dir" && rm -f $$files; }; \ - } -SCRIPTS = $(bin_SCRIPTS) -AM_V_P = $(am__v_P_@AM_V@) -am__v_P_ = $(am__v_P_@AM_DEFAULT_V@) -am__v_P_0 = false -am__v_P_1 = : -AM_V_GEN = $(am__v_GEN_@AM_V@) -am__v_GEN_ = $(am__v_GEN_@AM_DEFAULT_V@) -am__v_GEN_0 = @echo " GEN " $@; -am__v_GEN_1 = -AM_V_at = $(am__v_at_@AM_V@) -am__v_at_ = $(am__v_at_@AM_DEFAULT_V@) -am__v_at_0 = @ -am__v_at_1 = -DEFAULT_INCLUDES = -I.@am__isrc@ -I$(top_builddir) -depcomp = $(SHELL) $(top_srcdir)/build_aux/depcomp -am__depfiles_maybe = depfiles -am__mv = mv -f -COMPILE = $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) \ - $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -LTCOMPILE = $(LIBTOOL) $(AM_V_lt) --tag=CC $(AM_LIBTOOLFLAGS) \ - $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) \ - $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) \ - $(AM_CFLAGS) $(CFLAGS) -AM_V_CC = $(am__v_CC_@AM_V@) -am__v_CC_ = $(am__v_CC_@AM_DEFAULT_V@) -am__v_CC_0 = @echo " CC " $@; -am__v_CC_1 = -CCLD = $(CC) -LINK = $(LIBTOOL) $(AM_V_lt) --tag=CC $(AM_LIBTOOLFLAGS) \ - $(LIBTOOLFLAGS) --mode=link $(CCLD) $(AM_CFLAGS) $(CFLAGS) \ - $(AM_LDFLAGS) $(LDFLAGS) -o $@ -AM_V_CCLD = $(am__v_CCLD_@AM_V@) -am__v_CCLD_ = $(am__v_CCLD_@AM_DEFAULT_V@) -am__v_CCLD_0 = @echo " CCLD " $@; -am__v_CCLD_1 = -SOURCES = $(cobcrun_SOURCES) $(gcdiff_SOURCES) -DIST_SOURCES = $(cobcrun_SOURCES) $(gcdiff_SOURCES) -am__can_run_installinfo = \ - case $$AM_UPDATE_INFO_DIR in \ - n|no|NO) false;; \ - *) (install-info --version) >/dev/null 2>&1;; \ - esac -man1dir = $(mandir)/man1 -NROFF = nroff -MANS = $(dist_man_MANS) -am__tagged_files = $(HEADERS) $(SOURCES) $(TAGS_FILES) $(LISP) -# Read a list of newline-separated strings from the standard input, -# and print each of them once, without duplicates. Input order is -# *not* preserved. -am__uniquify_input = $(AWK) '\ - BEGIN { nonempty = 0; } \ - { items[$$0] = 1; nonempty = 1; } \ - END { if (nonempty) { for (i in items) print i; }; } \ -' -# Make sure the list of sources is unique. This is necessary because, -# e.g., the same source file might be shared among _SOURCES variables -# for different programs/libraries. -am__define_uniq_tagged_files = \ - list='$(am__tagged_files)'; \ - unique=`for i in $$list; do \ - if test -f "$$i"; then echo $$i; else echo $(srcdir)/$$i; fi; \ - done | $(am__uniquify_input)` -ETAGS = etags -CTAGS = ctags -am__DIST_COMMON = $(dist_man_MANS) $(srcdir)/Makefile.in \ - $(srcdir)/cob-config.in $(top_srcdir)/build_aux/depcomp \ - $(top_srcdir)/build_aux/mkinstalldirs ChangeLog -DISTFILES = $(DIST_COMMON) $(DIST_SOURCES) $(TEXINFOS) $(EXTRA_DIST) -ACLOCAL = @ACLOCAL@ -AMTAR = @AMTAR@ -AM_DEFAULT_VERBOSITY = @AM_DEFAULT_VERBOSITY@ -AR = @AR@ -AS = @AS@ -AUTOCONF = @AUTOCONF@ -AUTOHEADER = @AUTOHEADER@ -AUTOMAKE = @AUTOMAKE@ -AWK = @AWK@ -CC = @CC@ -CCDEPMODE = @CCDEPMODE@ -CFLAGS = @CFLAGS@ -CJSON_CFLAGS = @CJSON_CFLAGS@ -CJSON_LIBS = @CJSON_LIBS@ -COBC_LIBS = @COBC_LIBS@ -COB_BIGENDIAN = @COB_BIGENDIAN@ -COB_CC = @COB_CC@ -COB_CFLAGS = @COB_CFLAGS@ -COB_CONFIG_DIR = @COB_CONFIG_DIR@ -COB_COPY_DIR = @COB_COPY_DIR@ -COB_EXE_EXT = @COB_EXE_EXT@ -COB_EXPORT_DYN = @COB_EXPORT_DYN@ -COB_FIX_LIB = @COB_FIX_LIB@ -COB_FIX_LIBTOOL = @COB_FIX_LIBTOOL@ -COB_HAS_64_BIT_POINTER = @COB_HAS_64_BIT_POINTER@ -COB_HAS_BDB = @COB_HAS_BDB@ -COB_HAS_CISAM = @COB_HAS_CISAM@ -COB_HAS_CJSON = @COB_HAS_CJSON@ -COB_HAS_CURSES = @COB_HAS_CURSES@ -COB_HAS_DISAM = @COB_HAS_DISAM@ -COB_HAS_ISAM = @COB_HAS_ISAM@ -COB_HAS_LMDB = @COB_HAS_LMDB@ -COB_HAS_OCEXTFH = @COB_HAS_OCEXTFH@ -COB_HAS_OCI = @COB_HAS_OCI@ -COB_HAS_ODBC = @COB_HAS_ODBC@ -COB_HAS_VBISAM = @COB_HAS_VBISAM@ -COB_HAS_XML2 = @COB_HAS_XML2@ -COB_KEYWORD_INLINE = @COB_KEYWORD_INLINE@ -COB_LDFLAGS = @COB_LDFLAGS@ -COB_LIBRARY_PATH = @COB_LIBRARY_PATH@ -COB_LIBS = @COB_LIBS@ -COB_MODULE_EXT = @COB_MODULE_EXT@ -COB_OBJECT_EXT = @COB_OBJECT_EXT@ -COB_PATCH_LEVEL = @COB_PATCH_LEVEL@ -COB_PIC_FLAGS = @COB_PIC_FLAGS@ -COB_SCHEMA_DIR = @COB_SCHEMA_DIR@ -COB_SHARED_OPT = @COB_SHARED_OPT@ -CODE_COVERAGE_CFLAGS = @CODE_COVERAGE_CFLAGS@ -CODE_COVERAGE_CPPFLAGS = @CODE_COVERAGE_CPPFLAGS@ -CODE_COVERAGE_CXXFLAGS = @CODE_COVERAGE_CXXFLAGS@ -CODE_COVERAGE_ENABLED = @CODE_COVERAGE_ENABLED@ -CODE_COVERAGE_LDFLAGS = @CODE_COVERAGE_LDFLAGS@ -CODE_COVERAGE_LIBS = @CODE_COVERAGE_LIBS@ -CPP = @CPP@ -CPPFLAGS = @CPPFLAGS@ -CYGPATH_W = @CYGPATH_W@ -DEFS = @DEFS@ -DEPDIR = @DEPDIR@ -DIFF_FLAGS = @DIFF_FLAGS@ -DLLTOOL = @DLLTOOL@ -DSYMUTIL = @DSYMUTIL@ -DUMPBIN = @DUMPBIN@ -ECHO_C = @ECHO_C@ -ECHO_N = @ECHO_N@ -ECHO_T = @ECHO_T@ -EGREP = @EGREP@ -EXEEXT = @EXEEXT@ -FGREP = @FGREP@ -GCOV = @GCOV@ -GENHTML = @GENHTML@ -GETTEXT_MACRO_VERSION = @GETTEXT_MACRO_VERSION@ -GMSGFMT = @GMSGFMT@ -GMSGFMT_015 = @GMSGFMT_015@ -GREP = @GREP@ -HELP2MAN = @HELP2MAN@ -INSTALL = @INSTALL@ -INSTALL_DATA = @INSTALL_DATA@ -INSTALL_PROGRAM = @INSTALL_PROGRAM@ -INSTALL_SCRIPT = @INSTALL_SCRIPT@ -INSTALL_STRIP_PROGRAM = @INSTALL_STRIP_PROGRAM@ -INTLLIBS = @INTLLIBS@ -INTL_MACOSX_LIBS = @INTL_MACOSX_LIBS@ -LCOV = @LCOV@ -LD = @LD@ -LDFLAGS = @LDFLAGS@ -LEX = @LEX@ -LEXLIB = @LEXLIB@ -LEX_OUTPUT_ROOT = @LEX_OUTPUT_ROOT@ -LIBCOB_CISAM = @LIBCOB_CISAM@ -LIBCOB_CPPFLAGS = @LIBCOB_CPPFLAGS@ -LIBCOB_DISAM = @LIBCOB_DISAM@ -LIBCOB_LIBS = @LIBCOB_LIBS@ -LIBCOB_VBISAM = @LIBCOB_VBISAM@ -LIBICONV = @LIBICONV@ -LIBINTL = @LIBINTL@ -LIBOBJS = @LIBOBJS@ -LIBS = @LIBS@ -LIBTOOL = @LIBTOOL@ -LIPO = @LIPO@ -LN_S = @LN_S@ -LTLIBICONV = @LTLIBICONV@ -LTLIBINTL = @LTLIBINTL@ -LTLIBOBJS = @LTLIBOBJS@ -LT_SYS_LIBRARY_PATH = @LT_SYS_LIBRARY_PATH@ -MAKE = @MAKE@ -MAKEINFO = @MAKEINFO@ -MANIFEST_TOOL = @MANIFEST_TOOL@ -MKDIR_P = @MKDIR_P@ -MSGFMT = @MSGFMT@ -MSGFMT_015 = @MSGFMT_015@ -MSGMERGE = @MSGMERGE@ -NM = @NM@ -NMEDIT = @NMEDIT@ -OBJDUMP = @OBJDUMP@ -OBJEXT = @OBJEXT@ -ODBC_CFLAGS = @ODBC_CFLAGS@ -ODBC_LIBS = @ODBC_LIBS@ -OTOOL = @OTOOL@ -OTOOL64 = @OTOOL64@ -PACKAGE = @PACKAGE@ -PACKAGE_BUGREPORT = @PACKAGE_BUGREPORT@ -PACKAGE_NAME = @PACKAGE_NAME@ -PACKAGE_STRING = @PACKAGE_STRING@ -PACKAGE_TARNAME = @PACKAGE_TARNAME@ -PACKAGE_URL = @PACKAGE_URL@ -PACKAGE_VERSION = @PACKAGE_VERSION@ -PATH_SEPARATOR = @PATH_SEPARATOR@ -PKG_CONFIG = @PKG_CONFIG@ -PKG_CONFIG_LIBDIR = @PKG_CONFIG_LIBDIR@ -PKG_CONFIG_PATH = @PKG_CONFIG_PATH@ -POSUB = @POSUB@ -RANLIB = @RANLIB@ -SED = @SED@ -SET_MAKE = @SET_MAKE@ -SHELL = @SHELL@ -STRIP = @STRIP@ -USE_NLS = @USE_NLS@ -VERSION = @VERSION@ -XGETTEXT = @XGETTEXT@ -XGETTEXT_015 = @XGETTEXT_015@ -XGETTEXT_EXTRA_OPTIONS = @XGETTEXT_EXTRA_OPTIONS@ -XML2_CFLAGS = @XML2_CFLAGS@ -XML2_LIBS = @XML2_LIBS@ -YACC = @YACC@ -YFLAGS = @YFLAGS@ -abs_builddir = @abs_builddir@ -abs_srcdir = @abs_srcdir@ -abs_top_builddir = @abs_top_builddir@ -abs_top_srcdir = @abs_top_srcdir@ -ac_ct_AR = @ac_ct_AR@ -ac_ct_CC = @ac_ct_CC@ -ac_ct_DUMPBIN = @ac_ct_DUMPBIN@ -am__include = @am__include@ -am__leading_dot = @am__leading_dot@ -am__quote = @am__quote@ -am__tar = @am__tar@ -am__untar = @am__untar@ -bindir = @bindir@ -build = @build@ -build_alias = @build_alias@ -build_cpu = @build_cpu@ -build_os = @build_os@ -build_vendor = @build_vendor@ -builddir = @builddir@ -configured_make = @configured_make@ -datadir = @datadir@ -datarootdir = @datarootdir@ -docdir = @docdir@ -dvidir = @dvidir@ -exec_prefix = @exec_prefix@ -host = @host@ -host_alias = @host_alias@ -host_cpu = @host_cpu@ -host_os = @host_os@ -host_vendor = @host_vendor@ -htmldir = @htmldir@ -includedir = @includedir@ -infodir = @infodir@ -install_sh = @install_sh@ -libdir = @libdir@ -libexecdir = @libexecdir@ -localedir = @localedir@ -localstatedir = @localstatedir@ -mandir = @mandir@ -mkdir_p = @mkdir_p@ -oldincludedir = @oldincludedir@ -pdfdir = @pdfdir@ -prefix = @prefix@ -program_transform_name = @program_transform_name@ -psdir = @psdir@ -runstatedir = @runstatedir@ -sbindir = @sbindir@ -sharedstatedir = @sharedstatedir@ -srcdir = @srcdir@ -sysconfdir = @sysconfdir@ -target_alias = @target_alias@ -top_build_prefix = @top_build_prefix@ -top_builddir = @top_builddir@ -top_srcdir = @top_srcdir@ -xml2_config_found = @xml2_config_found@ -bin_SCRIPTS = cob-config -cobcrun_SOURCES = cobcrun.c -dist_man_MANS = cobcrun.1 cob-config.1 -COBCRUN = cobcrun$(EXEEXT) -gcdiff_SOURCES = gcdiff.c -AM_LDFLAGS = $(COB_EXPORT_DYN) -AM_CPPFLAGS = -I$(top_srcdir) -AM_CFLAGS = $(CODE_COVERAGE_CFLAGS) -cobcrun_LDADD = $(top_builddir)/lib/libsupport.a $(top_builddir)/libcob/libcob.la \ - $(CODE_COVERAGE_LIBS) - -gcdiff_LDADD = $(top_builddir)/lib/libsupport.a $(top_builddir)/libcob/libcob.la -CODE_COVERAGE_BRANCH_COVERAGE = 1 -CODE_COVERAGE_LCOV_OPTIONS = --no-external -MAINTAINERCLEANFILES = cobcrun.1 -HELPSOURCES = cobcrun.c $(top_srcdir)/configure.ac -HELP2MAN_OPTS = --info-page=$(PACKAGE) -all: all-am - -.SUFFIXES: -.SUFFIXES: .c .lo .o .obj -$(srcdir)/Makefile.in: $(srcdir)/Makefile.am $(am__configure_deps) - @for dep in $?; do \ - case '$(am__configure_deps)' in \ - *$$dep*) \ - ( cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh ) \ - && { if test -f $@; then exit 0; else break; fi; }; \ - exit 1;; \ - esac; \ - done; \ - echo ' cd $(top_srcdir) && $(AUTOMAKE) --gnu bin/Makefile'; \ - $(am__cd) $(top_srcdir) && \ - $(AUTOMAKE) --gnu bin/Makefile -Makefile: $(srcdir)/Makefile.in $(top_builddir)/config.status - @case '$?' in \ - *config.status*) \ - cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh;; \ - *) \ - echo ' cd $(top_builddir) && $(SHELL) ./config.status $(subdir)/$@ $(am__depfiles_maybe)'; \ - cd $(top_builddir) && $(SHELL) ./config.status $(subdir)/$@ $(am__depfiles_maybe);; \ - esac; - -$(top_builddir)/config.status: $(top_srcdir)/configure $(CONFIG_STATUS_DEPENDENCIES) - cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh - -$(top_srcdir)/configure: $(am__configure_deps) - cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh -$(ACLOCAL_M4): $(am__aclocal_m4_deps) - cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh -$(am__aclocal_m4_deps): -cob-config: $(top_builddir)/config.status $(srcdir)/cob-config.in - cd $(top_builddir) && $(SHELL) ./config.status $(subdir)/$@ -install-binPROGRAMS: $(bin_PROGRAMS) - @$(NORMAL_INSTALL) - @list='$(bin_PROGRAMS)'; test -n "$(bindir)" || list=; \ - if test -n "$$list"; then \ - echo " $(MKDIR_P) '$(DESTDIR)$(bindir)'"; \ - $(MKDIR_P) "$(DESTDIR)$(bindir)" || exit 1; \ - fi; \ - for p in $$list; do echo "$$p $$p"; done | \ - sed 's/$(EXEEXT)$$//' | \ - while read p p1; do if test -f $$p \ - || test -f $$p1 \ - ; then echo "$$p"; echo "$$p"; else :; fi; \ - done | \ - sed -e 'p;s,.*/,,;n;h' \ - -e 's|.*|.|' \ - -e 'p;x;s,.*/,,;s/$(EXEEXT)$$//;$(transform);s/$$/$(EXEEXT)/' | \ - sed 'N;N;N;s,\n, ,g' | \ - $(AWK) 'BEGIN { files["."] = ""; dirs["."] = 1 } \ - { d=$$3; if (dirs[d] != 1) { print "d", d; dirs[d] = 1 } \ - if ($$2 == $$4) files[d] = files[d] " " $$1; \ - else { print "f", $$3 "/" $$4, $$1; } } \ - END { for (d in files) print "f", d, files[d] }' | \ - while read type dir files; do \ - if test "$$dir" = .; then dir=; else dir=/$$dir; fi; \ - test -z "$$files" || { \ - echo " $(INSTALL_PROGRAM_ENV) $(LIBTOOL) $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=install $(INSTALL_PROGRAM) $$files '$(DESTDIR)$(bindir)$$dir'"; \ - $(INSTALL_PROGRAM_ENV) $(LIBTOOL) $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=install $(INSTALL_PROGRAM) $$files "$(DESTDIR)$(bindir)$$dir" || exit $$?; \ - } \ - ; done - -uninstall-binPROGRAMS: - @$(NORMAL_UNINSTALL) - @list='$(bin_PROGRAMS)'; test -n "$(bindir)" || list=; \ - files=`for p in $$list; do echo "$$p"; done | \ - sed -e 'h;s,^.*/,,;s/$(EXEEXT)$$//;$(transform)' \ - -e 's/$$/$(EXEEXT)/' \ - `; \ - test -n "$$list" || exit 0; \ - echo " ( cd '$(DESTDIR)$(bindir)' && rm -f" $$files ")"; \ - cd "$(DESTDIR)$(bindir)" && rm -f $$files - -clean-binPROGRAMS: - @list='$(bin_PROGRAMS)'; test -n "$$list" || exit 0; \ - echo " rm -f" $$list; \ - rm -f $$list || exit $$?; \ - test -n "$(EXEEXT)" || exit 0; \ - list=`for p in $$list; do echo "$$p"; done | sed 's/$(EXEEXT)$$//'`; \ - echo " rm -f" $$list; \ - rm -f $$list - -cobcrun$(EXEEXT): $(cobcrun_OBJECTS) $(cobcrun_DEPENDENCIES) $(EXTRA_cobcrun_DEPENDENCIES) - @rm -f cobcrun$(EXEEXT) - $(AM_V_CCLD)$(LINK) $(cobcrun_OBJECTS) $(cobcrun_LDADD) $(LIBS) - -gcdiff$(EXEEXT): $(gcdiff_OBJECTS) $(gcdiff_DEPENDENCIES) $(EXTRA_gcdiff_DEPENDENCIES) - @rm -f gcdiff$(EXEEXT) - $(AM_V_CCLD)$(LINK) $(gcdiff_OBJECTS) $(gcdiff_LDADD) $(LIBS) -install-binSCRIPTS: $(bin_SCRIPTS) - @$(NORMAL_INSTALL) - @list='$(bin_SCRIPTS)'; test -n "$(bindir)" || list=; \ - if test -n "$$list"; then \ - echo " $(MKDIR_P) '$(DESTDIR)$(bindir)'"; \ - $(MKDIR_P) "$(DESTDIR)$(bindir)" || exit 1; \ - fi; \ - for p in $$list; do \ - if test -f "$$p"; then d=; else d="$(srcdir)/"; fi; \ - if test -f "$$d$$p"; then echo "$$d$$p"; echo "$$p"; else :; fi; \ - done | \ - sed -e 'p;s,.*/,,;n' \ - -e 'h;s|.*|.|' \ - -e 'p;x;s,.*/,,;$(transform)' | sed 'N;N;N;s,\n, ,g' | \ - $(AWK) 'BEGIN { files["."] = ""; dirs["."] = 1; } \ - { d=$$3; if (dirs[d] != 1) { print "d", d; dirs[d] = 1 } \ - if ($$2 == $$4) { files[d] = files[d] " " $$1; \ - if (++n[d] == $(am__install_max)) { \ - print "f", d, files[d]; n[d] = 0; files[d] = "" } } \ - else { print "f", d "/" $$4, $$1 } } \ - END { for (d in files) print "f", d, files[d] }' | \ - while read type dir files; do \ - if test "$$dir" = .; then dir=; else dir=/$$dir; fi; \ - test -z "$$files" || { \ - echo " $(INSTALL_SCRIPT) $$files '$(DESTDIR)$(bindir)$$dir'"; \ - $(INSTALL_SCRIPT) $$files "$(DESTDIR)$(bindir)$$dir" || exit $$?; \ - } \ - ; done - -uninstall-binSCRIPTS: - @$(NORMAL_UNINSTALL) - @list='$(bin_SCRIPTS)'; test -n "$(bindir)" || exit 0; \ - files=`for p in $$list; do echo "$$p"; done | \ - sed -e 's,.*/,,;$(transform)'`; \ - dir='$(DESTDIR)$(bindir)'; $(am__uninstall_files_from_dir) - -mostlyclean-compile: - -rm -f *.$(OBJEXT) - -distclean-compile: - -rm -f *.tab.c - -@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/cobcrun.Po@am__quote@ -@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/gcdiff.Po@am__quote@ - -.c.o: -@am__fastdepCC_TRUE@ $(AM_V_CC)$(COMPILE) -MT $@ -MD -MP -MF $(DEPDIR)/$*.Tpo -c -o $@ $< -@am__fastdepCC_TRUE@ $(AM_V_at)$(am__mv) $(DEPDIR)/$*.Tpo $(DEPDIR)/$*.Po -@AMDEP_TRUE@@am__fastdepCC_FALSE@ $(AM_V_CC)source='$<' object='$@' libtool=no @AMDEPBACKSLASH@ -@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ -@am__fastdepCC_FALSE@ $(AM_V_CC@am__nodep@)$(COMPILE) -c -o $@ $< - -.c.obj: -@am__fastdepCC_TRUE@ $(AM_V_CC)$(COMPILE) -MT $@ -MD -MP -MF $(DEPDIR)/$*.Tpo -c -o $@ `$(CYGPATH_W) '$<'` -@am__fastdepCC_TRUE@ $(AM_V_at)$(am__mv) $(DEPDIR)/$*.Tpo $(DEPDIR)/$*.Po -@AMDEP_TRUE@@am__fastdepCC_FALSE@ $(AM_V_CC)source='$<' object='$@' libtool=no @AMDEPBACKSLASH@ -@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ -@am__fastdepCC_FALSE@ $(AM_V_CC@am__nodep@)$(COMPILE) -c -o $@ `$(CYGPATH_W) '$<'` - -.c.lo: -@am__fastdepCC_TRUE@ $(AM_V_CC)$(LTCOMPILE) -MT $@ -MD -MP -MF $(DEPDIR)/$*.Tpo -c -o $@ $< -@am__fastdepCC_TRUE@ $(AM_V_at)$(am__mv) $(DEPDIR)/$*.Tpo $(DEPDIR)/$*.Plo -@AMDEP_TRUE@@am__fastdepCC_FALSE@ $(AM_V_CC)source='$<' object='$@' libtool=yes @AMDEPBACKSLASH@ -@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ -@am__fastdepCC_FALSE@ $(AM_V_CC@am__nodep@)$(LTCOMPILE) -c -o $@ $< - -mostlyclean-libtool: - -rm -f *.lo - -clean-libtool: - -rm -rf .libs _libs -install-man1: $(dist_man_MANS) - @$(NORMAL_INSTALL) - @list1=''; \ - list2='$(dist_man_MANS)'; \ - test -n "$(man1dir)" \ - && test -n "`echo $$list1$$list2`" \ - || exit 0; \ - echo " $(MKDIR_P) '$(DESTDIR)$(man1dir)'"; \ - $(MKDIR_P) "$(DESTDIR)$(man1dir)" || exit 1; \ - { for i in $$list1; do echo "$$i"; done; \ - if test -n "$$list2"; then \ - for i in $$list2; do echo "$$i"; done \ - | sed -n '/\.1[a-z]*$$/p'; \ - fi; \ - } | while read p; do \ - if test -f $$p; then d=; else d="$(srcdir)/"; fi; \ - echo "$$d$$p"; echo "$$p"; \ - done | \ - sed -e 'n;s,.*/,,;p;h;s,.*\.,,;s,^[^1][0-9a-z]*$$,1,;x' \ - -e 's,\.[0-9a-z]*$$,,;$(transform);G;s,\n,.,' | \ - sed 'N;N;s,\n, ,g' | { \ - list=; while read file base inst; do \ - if test "$$base" = "$$inst"; then list="$$list $$file"; else \ - echo " $(INSTALL_DATA) '$$file' '$(DESTDIR)$(man1dir)/$$inst'"; \ - $(INSTALL_DATA) "$$file" "$(DESTDIR)$(man1dir)/$$inst" || exit $$?; \ - fi; \ - done; \ - for i in $$list; do echo "$$i"; done | $(am__base_list) | \ - while read files; do \ - test -z "$$files" || { \ - echo " $(INSTALL_DATA) $$files '$(DESTDIR)$(man1dir)'"; \ - $(INSTALL_DATA) $$files "$(DESTDIR)$(man1dir)" || exit $$?; }; \ - done; } - -uninstall-man1: - @$(NORMAL_UNINSTALL) - @list=''; test -n "$(man1dir)" || exit 0; \ - files=`{ for i in $$list; do echo "$$i"; done; \ - l2='$(dist_man_MANS)'; for i in $$l2; do echo "$$i"; done | \ - sed -n '/\.1[a-z]*$$/p'; \ - } | sed -e 's,.*/,,;h;s,.*\.,,;s,^[^1][0-9a-z]*$$,1,;x' \ - -e 's,\.[0-9a-z]*$$,,;$(transform);G;s,\n,.,'`; \ - dir='$(DESTDIR)$(man1dir)'; $(am__uninstall_files_from_dir) - -ID: $(am__tagged_files) - $(am__define_uniq_tagged_files); mkid -fID $$unique -tags: tags-am -TAGS: tags - -tags-am: $(TAGS_DEPENDENCIES) $(am__tagged_files) - set x; \ - here=`pwd`; \ - $(am__define_uniq_tagged_files); \ - shift; \ - if test -z "$(ETAGS_ARGS)$$*$$unique"; then :; else \ - test -n "$$unique" || unique=$$empty_fix; \ - if test $$# -gt 0; then \ - $(ETAGS) $(ETAGSFLAGS) $(AM_ETAGSFLAGS) $(ETAGS_ARGS) \ - "$$@" $$unique; \ - else \ - $(ETAGS) $(ETAGSFLAGS) $(AM_ETAGSFLAGS) $(ETAGS_ARGS) \ - $$unique; \ - fi; \ - fi -ctags: ctags-am - -CTAGS: ctags -ctags-am: $(TAGS_DEPENDENCIES) $(am__tagged_files) - $(am__define_uniq_tagged_files); \ - test -z "$(CTAGS_ARGS)$$unique" \ - || $(CTAGS) $(CTAGSFLAGS) $(AM_CTAGSFLAGS) $(CTAGS_ARGS) \ - $$unique - -GTAGS: - here=`$(am__cd) $(top_builddir) && pwd` \ - && $(am__cd) $(top_srcdir) \ - && gtags -i $(GTAGS_ARGS) "$$here" -cscopelist: cscopelist-am - -cscopelist-am: $(am__tagged_files) - list='$(am__tagged_files)'; \ - case "$(srcdir)" in \ - [\\/]* | ?:[\\/]*) sdir="$(srcdir)" ;; \ - *) sdir=$(subdir)/$(srcdir) ;; \ - esac; \ - for i in $$list; do \ - if test -f "$$i"; then \ - echo "$(subdir)/$$i"; \ - else \ - echo "$$sdir/$$i"; \ - fi; \ - done >> $(top_builddir)/cscope.files - -distclean-tags: - -rm -f TAGS ID GTAGS GRTAGS GSYMS GPATH tags - -distdir: $(DISTFILES) - @srcdirstrip=`echo "$(srcdir)" | sed 's/[].[^$$\\*]/\\\\&/g'`; \ - topsrcdirstrip=`echo "$(top_srcdir)" | sed 's/[].[^$$\\*]/\\\\&/g'`; \ - list='$(DISTFILES)'; \ - dist_files=`for file in $$list; do echo $$file; done | \ - sed -e "s|^$$srcdirstrip/||;t" \ - -e "s|^$$topsrcdirstrip/|$(top_builddir)/|;t"`; \ - case $$dist_files in \ - */*) $(MKDIR_P) `echo "$$dist_files" | \ - sed '/\//!d;s|^|$(distdir)/|;s,/[^/]*$$,,' | \ - sort -u` ;; \ - esac; \ - for file in $$dist_files; do \ - if test -f $$file || test -d $$file; then d=.; else d=$(srcdir); fi; \ - if test -d $$d/$$file; then \ - dir=`echo "/$$file" | sed -e 's,/[^/]*$$,,'`; \ - if test -d "$(distdir)/$$file"; then \ - find "$(distdir)/$$file" -type d ! -perm -700 -exec chmod u+rwx {} \;; \ - fi; \ - if test -d $(srcdir)/$$file && test $$d != $(srcdir); then \ - cp -fpR $(srcdir)/$$file "$(distdir)$$dir" || exit 1; \ - find "$(distdir)/$$file" -type d ! -perm -700 -exec chmod u+rwx {} \;; \ - fi; \ - cp -fpR $$d/$$file "$(distdir)$$dir" || exit 1; \ - else \ - test -f "$(distdir)/$$file" \ - || cp -p $$d/$$file "$(distdir)/$$file" \ - || exit 1; \ - fi; \ - done -check-am: all-am -check: check-am -all-am: Makefile $(PROGRAMS) $(SCRIPTS) $(MANS) -installdirs: - for dir in "$(DESTDIR)$(bindir)" "$(DESTDIR)$(bindir)" "$(DESTDIR)$(man1dir)"; do \ - test -z "$$dir" || $(MKDIR_P) "$$dir"; \ - done -install: install-am -install-exec: install-exec-am -install-data: install-data-am -uninstall: uninstall-am - -install-am: all-am - @$(MAKE) $(AM_MAKEFLAGS) install-exec-am install-data-am - -installcheck: installcheck-am -install-strip: - if test -z '$(STRIP)'; then \ - $(MAKE) $(AM_MAKEFLAGS) INSTALL_PROGRAM="$(INSTALL_STRIP_PROGRAM)" \ - install_sh_PROGRAM="$(INSTALL_STRIP_PROGRAM)" INSTALL_STRIP_FLAG=-s \ - install; \ - else \ - $(MAKE) $(AM_MAKEFLAGS) INSTALL_PROGRAM="$(INSTALL_STRIP_PROGRAM)" \ - install_sh_PROGRAM="$(INSTALL_STRIP_PROGRAM)" INSTALL_STRIP_FLAG=-s \ - "INSTALL_PROGRAM_ENV=STRIPPROG='$(STRIP)'" install; \ - fi -mostlyclean-generic: - -clean-generic: - -distclean-generic: - -test -z "$(CONFIG_CLEAN_FILES)" || rm -f $(CONFIG_CLEAN_FILES) - -test . = "$(srcdir)" || test -z "$(CONFIG_CLEAN_VPATH_FILES)" || rm -f $(CONFIG_CLEAN_VPATH_FILES) - -maintainer-clean-generic: - @echo "This command is intended for maintainers to use" - @echo "it deletes files that may require special tools to rebuild." - -test -z "$(MAINTAINERCLEANFILES)" || rm -f $(MAINTAINERCLEANFILES) -clean: clean-am - -clean-am: clean-binPROGRAMS clean-generic clean-libtool mostlyclean-am - -distclean: distclean-am - -rm -rf ./$(DEPDIR) - -rm -f Makefile -distclean-am: clean-am distclean-compile distclean-generic \ - distclean-tags - -dvi: dvi-am - -dvi-am: - -html: html-am - -html-am: - -info: info-am - -info-am: - -install-data-am: install-man - -install-dvi: install-dvi-am - -install-dvi-am: - -install-exec-am: install-binPROGRAMS install-binSCRIPTS - -install-html: install-html-am - -install-html-am: - -install-info: install-info-am - -install-info-am: - -install-man: install-man1 - -install-pdf: install-pdf-am - -install-pdf-am: - -install-ps: install-ps-am - -install-ps-am: - -installcheck-am: - -maintainer-clean: maintainer-clean-am - -rm -rf ./$(DEPDIR) - -rm -f Makefile -maintainer-clean-am: distclean-am maintainer-clean-generic - -mostlyclean: mostlyclean-am - -mostlyclean-am: mostlyclean-compile mostlyclean-generic \ - mostlyclean-libtool - -pdf: pdf-am - -pdf-am: - -ps: ps-am - -ps-am: - -uninstall-am: uninstall-binPROGRAMS uninstall-binSCRIPTS uninstall-man - -uninstall-man: uninstall-man1 - -.MAKE: install-am install-strip - -.PHONY: CTAGS GTAGS TAGS all all-am check check-am clean \ - clean-binPROGRAMS clean-generic clean-libtool cscopelist-am \ - ctags ctags-am distclean distclean-compile distclean-generic \ - distclean-libtool distclean-tags distdir dvi dvi-am html \ - html-am info info-am install install-am install-binPROGRAMS \ - install-binSCRIPTS install-data install-data-am install-dvi \ - install-dvi-am install-exec install-exec-am install-html \ - install-html-am install-info install-info-am install-man \ - install-man1 install-pdf install-pdf-am install-ps \ - install-ps-am install-strip installcheck installcheck-am \ - installdirs maintainer-clean maintainer-clean-generic \ - mostlyclean mostlyclean-compile mostlyclean-generic \ - mostlyclean-libtool pdf pdf-am ps ps-am tags tags-am uninstall \ - uninstall-am uninstall-binPROGRAMS uninstall-binSCRIPTS \ - uninstall-man uninstall-man1 - -.PRECIOUS: Makefile - - -# Add rules for code-coverage testing, as provided AX_CODE_COVERAGE -@CODE_COVERAGE_RULES@ - -@MAKE_HAS_PREREQ_ONLY_TRUE@cobcrun.1: $(HELPSOURCES) | $(COBCRUN) -@MAKE_HAS_PREREQ_ONLY_TRUE@ "$(top_builddir)/pre-inst-env" $(HELP2MAN) --output=$@ $(HELP2MAN_OPTS) $(COBCRUN) -@MAKE_HAS_PREREQ_ONLY_FALSE@cobcrun.1: $(HELPSOURCES) -@MAKE_HAS_PREREQ_ONLY_FALSE@ "$(top_builddir)/pre-inst-env" $(HELP2MAN) --output=$@ $(HELP2MAN_OPTS) $(COBCRUN) - -# Tell versions [3.59,3.63) of GNU make to not export all variables. -# Otherwise a system limit (for SysV at least) may be exceeded. -.NOEXPORT: diff -Nru gnucobol-4.0~early~20200606/build_aux/bootstrap gnucobol-5/build_aux/bootstrap --- gnucobol-4.0~early~20200606/build_aux/bootstrap 2020-06-06 20:52:02.000000000 +0000 +++ gnucobol-5/build_aux/bootstrap 1970-01-01 00:00:00.000000000 +0000 @@ -1,100 +0,0 @@ -#!/bin/sh -# bootstrap gnucobol/build_aux -# Bootstrap gnucobol package from checked-out sources -# Note: call as ./bootstrap if you don't have readlink -f -# -# Copyright (C) 2017-2020 Free Software Foundation, Inc. -# Written by Simon Sobisch -# -# This file is part of GnuCOBOL. -# -# The GnuCOBOL compiler is free software: you can redistribute it -# and/or modify it under the terms of the GNU General Public License -# as published by the Free Software Foundation, either version 3 of the -# License, or (at your option) any later version. -# -# GnuCOBOL is distributed in the hope that it will be useful, -# but WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -# GNU General Public License for more details. -# -# You should have received a copy of the GNU General Public License -# along with GnuCOBOL. If not, see . - -me=bootstrap - -echo "start to bootstrap GnuCOBOL" -# get path to GnuCOBOL main directory, possibly set with GCMAINPATH -if test -z "$GCMAINPATH"; then - if test "$0" = "./$me"; then - MAINPATH=.. - else - MAINPATH=$(dirname $(readlink -f "$0"))/.. - fi -else - MAINPATH=$GCMAINPATH -fi -if test ! -f $MAINPATH/build_aux/$me; then - echo; echo "ERROR - cannot set main directory [checked $MAINPATH/build_aux/$me] - aborting $me" && exit 1 -fi - -echo -if test ! -f $MAINPATH/tarstamp.h; then - echo creating tarstamp.h... - echo "#define COB_TAR_DATE \"`LC_ALL=C date -u +'%b %d %Y %T'` UTC\"" > $MAINPATH/tarstamp.h - echo "#define COB_NUM_TAR_DATE ` LC_ALL=C date -u +'%Y%m%d'`" >> $MAINPATH/tarstamp.h - echo "#define COB_NUM_TAR_TIME ` LC_ALL=C date -u +'%H%M%S'`" >> $MAINPATH/tarstamp.h -else - echo "tarstamp.h exists already, is not touched" -fi - -echo; echo "ensure that we have executable scripts..." -scripts="compile config.guess config.rpath config.sub depcomp install-sh ltmain.sh mdate-sh missing mkinstalldirs ylwrap create_win_dist.sh" -for file in $scripts ; do - if test -f $MAINPATH/build_aux/$file; then - chmod -f u+x $MAINPATH/build_aux/$file - else - echo "WARNING, file $MAINPATH/build-aux/$file is missing." - fi -done - -scripts="autogen.sh doc/cobcinfo.sh po/update_linguas.sh tests/listings-sed.sh" -for file in $scripts ; do - if test -f $MAINPATH/$file; then - chmod -f u+x $MAINPATH/$file - else - echo "WARNING, file $MAINPATH/$file is missing." - fi -done - -echo; echo "running autoreconf..." -ret=0 - -# changing build_aux scripts at large: -#autoreconf --verbose --force --install --include=m4 $MAINPATH; ret=$? - -# changing files possibly needed for new systems: -#config_file_url="https://git.savannah.gnu.org/gitweb/?p=gnulib.git;a=blob_plain;f=build-aux" -#for file in config.guess config.sub; do -# echo "$0: getting $file..." -# wget -q --timeout=5 -O $MAINPATH/build_aux/$file.tmp "${config_file_url}/${file};hb=HEAD" \ -# && mv $MAINPATH/build_aux/$file.tmp $MAINPATH/build_aux/$file \ -# && chmod a+x $MAINPATH/build_aux/$file -# retval=$? -# rm -f $MAINPATH/build_aux/$file.tmp -# test $retval -eq 0 # || exit $retval -#done - -# ensure the configure and Makefile parts are up-to-date: -autoreconf --verbose --force --include=m4 $MAINPATH; ret=$? - -if test $ret -ne 0; then - echo; echo "ERROR, autoreconf returned $ret - aborting bootstrap" && exit $ret -fi - -echo; echo "bootstrap is finished" -echo; echo "now run configure with your desired options, for instance:" -echo " ./configure CFLAGS='-g' # in $MAINPATH" -echo "or, especially preferred for development:" -echo " mkdir build && cd build \ " -echo " && $MAINPATH/configure --enable-cobc-internal-checks --enable-debug" diff -Nru gnucobol-4.0~early~20200606/build_aux/ChangeLog gnucobol-5/build_aux/ChangeLog --- gnucobol-4.0~early~20200606/build_aux/ChangeLog 2020-06-06 20:52:02.000000000 +0000 +++ gnucobol-5/build_aux/ChangeLog 1970-01-01 00:00:00.000000000 +0000 @@ -1,102 +0,0 @@ - -2019-07-06 Simon Sobisch - - * create_mingw_bindist.sh: initial commit of script to generate binary - distribution from MinGW environments - * create_win_dist.sh: moved from top_srcdir - -2019-05-05 Simon Sobisch - - * bootstrap: only set executable bit for current user, - suppress most error messages (that can also occur if - execution rights are already available but we can't set them) - -2019-04-06 Simon Sobisch - - * pre-inst-env.in: new file, for launching programs - from build directory, after Mathieu Lirzin (automake) - -2019-03-19 Simon Sobisch - - * config.guess, config.sub, texinfo.tex: - updated to recent version from - https://git.savannah.gnu.org/cgit/gnulib.git/tree/build-aux/ - -2019-02-18 Simon Sobisch - - * bootstrap: additional user hints, - reading GCMAINPATH to get clean main path (adjusted in autogen.sh) - -2018-11-25 Simon Sobisch - - * bootstrap: added missing setting of LC_ALL for generating tarstamp.h, - added parts (currently commented out) to update files in build-aux, - refactoring - -2018-10-22 Simon Sobisch - - * config.guess, config.sub, install-sh, texinfo.tex: - updated to recent version from - https://git.savannah.gnu.org/cgit/gnulib.git/tree/build-aux/ - -2018-06-04 Simon Sobisch - - * ltmain.sh [WIN32, !GCC]: local fix for libtool issue #109514 to - support buildinf with configure using other Win32 compilers than MSC - -2018-02-28 Simon Sobisch - - * bootstrap: ensure auxiliary scripts are executable before - running autoconf; only create tarstamp.h if missing - -2017-12-06 Simon Sobisch - - * bootstrap: ensure auxiliary scripts are executable - -2017-12-08 Simon Sobisch - - * compile, config.guess, config.sub, depcomp, install-sh, mdate-sh, - texinfo.tex: updated to recent version from - https://git.savannah.gnu.org/cgit/gnulib.git/tree/build-aux/ - * ylwrap, missing: updated to recent version from - https://git.savannah.gnu.org/cgit/automake.git/tree/lib/ - * missing: adjusted perl_URL and flex_URL - -2017-08-13 Simon Sobisch - - * bootstrap: new script for creating missing files after checkout - * config.guess: updated to recent version - -2017-07-15 Simon Sobisch - - * compile, config.guess, config.sub: updated to recent version from - http://git.savannah.gnu.org/cgit/gnulib.git/tree/build-aux/ - * texinfo.tex: updated from https://ftp.gnu.org/gnu/texinfo - -2017-04-28 Simon Sobisch - - * ylwrap: updated to recent version from - http://git.savannah.gnu.org/cgit/automake.git/tree/lib/ylwrap - -2016-08-10 Simon Sobisch - - * general: updated to versions from automake 1.15 - * ylwrap: added from automake 1.15 - * config.sub, config.guess: updated to recent versions from - git.savannah.gnu.org/gitweb/?p=config.git, backported support - for "ancient" systems without uname(1) - -2015-07-10 Simon Sobisch - - * general: moved additional build-scripts from rootdir to build_aux - * mdate-sh: added from automake 1.11.1 - * config.sub, config.guess: updated to recent versions from - git.savannah.gnu.org/gitweb/?p=config.git to solve build issues - on different machines, but backported support for "ancient" systems - without uname(1) [removed 2014-01-25] from old version - - -Copyright 2015-2019 Free Software Foundation, Inc. - -Copying and distribution of this file, with or without modification, are -permitted provided the copyright notice and this notice are preserved. diff -Nru gnucobol-4.0~early~20200606/build_aux/compile gnucobol-5/build_aux/compile --- gnucobol-4.0~early~20200606/build_aux/compile 2020-06-06 20:52:02.000000000 +0000 +++ gnucobol-5/build_aux/compile 1970-01-01 00:00:00.000000000 +0000 @@ -1,348 +0,0 @@ -#! /bin/sh -# Wrapper for compilers which do not understand '-c -o'. - -scriptversion=2017-09-16.17; # UTC - -# Copyright (C) 1999-2017 Free Software Foundation, Inc. -# Written by Tom Tromey . -# -# This program is free software; you can redistribute it and/or modify -# it under the terms of the GNU General Public License as published by -# the Free Software Foundation; either version 2, or (at your option) -# any later version. -# -# This program is distributed in the hope that it will be useful, -# but WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -# GNU General Public License for more details. -# -# You should have received a copy of the GNU General Public License -# along with this program. If not, see . - -# As a special exception to the GNU General Public License, if you -# distribute this file as part of a program that contains a -# configuration script generated by Autoconf, you may include it under -# the same distribution terms that you use for the rest of that program. - -# This file is maintained in Automake, please report -# bugs to or send patches to -# . - -nl=' -' - -# We need space, tab and new line, in precisely that order. Quoting is -# there to prevent tools from complaining about whitespace usage. -IFS=" "" $nl" - -file_conv= - -# func_file_conv build_file lazy -# Convert a $build file to $host form and store it in $file -# Currently only supports Windows hosts. If the determined conversion -# type is listed in (the comma separated) LAZY, no conversion will -# take place. -func_file_conv () -{ - file=$1 - case $file in - / | /[!/]*) # absolute file, and not a UNC file - if test -z "$file_conv"; then - # lazily determine how to convert abs files - case `uname -s` in - MINGW*) - file_conv=mingw - ;; - CYGWIN*) - file_conv=cygwin - ;; - *) - file_conv=wine - ;; - esac - fi - case $file_conv/,$2, in - *,$file_conv,*) - ;; - mingw/*) - file=`cmd //C echo "$file " | sed -e 's/"\(.*\) " *$/\1/'` - ;; - cygwin/*) - file=`cygpath -m "$file" || echo "$file"` - ;; - wine/*) - file=`winepath -w "$file" || echo "$file"` - ;; - esac - ;; - esac -} - -# func_cl_dashL linkdir -# Make cl look for libraries in LINKDIR -func_cl_dashL () -{ - func_file_conv "$1" - if test -z "$lib_path"; then - lib_path=$file - else - lib_path="$lib_path;$file" - fi - linker_opts="$linker_opts -LIBPATH:$file" -} - -# func_cl_dashl library -# Do a library search-path lookup for cl -func_cl_dashl () -{ - lib=$1 - found=no - save_IFS=$IFS - IFS=';' - for dir in $lib_path $LIB - do - IFS=$save_IFS - if $shared && test -f "$dir/$lib.dll.lib"; then - found=yes - lib=$dir/$lib.dll.lib - break - fi - if test -f "$dir/$lib.lib"; then - found=yes - lib=$dir/$lib.lib - break - fi - if test -f "$dir/lib$lib.a"; then - found=yes - lib=$dir/lib$lib.a - break - fi - done - IFS=$save_IFS - - if test "$found" != yes; then - lib=$lib.lib - fi -} - -# func_cl_wrapper cl arg... -# Adjust compile command to suit cl -func_cl_wrapper () -{ - # Assume a capable shell - lib_path= - shared=: - linker_opts= - for arg - do - if test -n "$eat"; then - eat= - else - case $1 in - -o) - # configure might choose to run compile as 'compile cc -o foo foo.c'. - eat=1 - case $2 in - *.o | *.[oO][bB][jJ]) - func_file_conv "$2" - set x "$@" -Fo"$file" - shift - ;; - *) - func_file_conv "$2" - set x "$@" -Fe"$file" - shift - ;; - esac - ;; - -I) - eat=1 - func_file_conv "$2" mingw - set x "$@" -I"$file" - shift - ;; - -I*) - func_file_conv "${1#-I}" mingw - set x "$@" -I"$file" - shift - ;; - -l) - eat=1 - func_cl_dashl "$2" - set x "$@" "$lib" - shift - ;; - -l*) - func_cl_dashl "${1#-l}" - set x "$@" "$lib" - shift - ;; - -L) - eat=1 - func_cl_dashL "$2" - ;; - -L*) - func_cl_dashL "${1#-L}" - ;; - -static) - shared=false - ;; - -Wl,*) - arg=${1#-Wl,} - save_ifs="$IFS"; IFS=',' - for flag in $arg; do - IFS="$save_ifs" - linker_opts="$linker_opts $flag" - done - IFS="$save_ifs" - ;; - -Xlinker) - eat=1 - linker_opts="$linker_opts $2" - ;; - -*) - set x "$@" "$1" - shift - ;; - *.cc | *.CC | *.cxx | *.CXX | *.[cC]++) - func_file_conv "$1" - set x "$@" -Tp"$file" - shift - ;; - *.c | *.cpp | *.CPP | *.lib | *.LIB | *.Lib | *.OBJ | *.obj | *.[oO]) - func_file_conv "$1" mingw - set x "$@" "$file" - shift - ;; - *) - set x "$@" "$1" - shift - ;; - esac - fi - shift - done - if test -n "$linker_opts"; then - linker_opts="-link$linker_opts" - fi - exec "$@" $linker_opts - exit 1 -} - -eat= - -case $1 in - '') - echo "$0: No command. Try '$0 --help' for more information." 1>&2 - exit 1; - ;; - -h | --h*) - cat <<\EOF -Usage: compile [--help] [--version] PROGRAM [ARGS] - -Wrapper for compilers which do not understand '-c -o'. -Remove '-o dest.o' from ARGS, run PROGRAM with the remaining -arguments, and rename the output as expected. - -If you are trying to build a whole package this is not the -right script to run: please start by reading the file 'INSTALL'. - -Report bugs to . -EOF - exit $? - ;; - -v | --v*) - echo "compile $scriptversion" - exit $? - ;; - cl | *[/\\]cl | cl.exe | *[/\\]cl.exe | \ - icl | *[/\\]icl | icl.exe | *[/\\]icl.exe ) - func_cl_wrapper "$@" # Doesn't return... - ;; -esac - -ofile= -cfile= - -for arg -do - if test -n "$eat"; then - eat= - else - case $1 in - -o) - # configure might choose to run compile as 'compile cc -o foo foo.c'. - # So we strip '-o arg' only if arg is an object. - eat=1 - case $2 in - *.o | *.obj) - ofile=$2 - ;; - *) - set x "$@" -o "$2" - shift - ;; - esac - ;; - *.c) - cfile=$1 - set x "$@" "$1" - shift - ;; - *) - set x "$@" "$1" - shift - ;; - esac - fi - shift -done - -if test -z "$ofile" || test -z "$cfile"; then - # If no '-o' option was seen then we might have been invoked from a - # pattern rule where we don't need one. That is ok -- this is a - # normal compilation that the losing compiler can handle. If no - # '.c' file was seen then we are probably linking. That is also - # ok. - exec "$@" -fi - -# Name of file we expect compiler to create. -cofile=`echo "$cfile" | sed 's|^.*[\\/]||; s|^[a-zA-Z]:||; s/\.c$/.o/'` - -# Create the lock directory. -# Note: use '[/\\:.-]' here to ensure that we don't use the same name -# that we are using for the .o file. Also, base the name on the expected -# object file name, since that is what matters with a parallel build. -lockdir=`echo "$cofile" | sed -e 's|[/\\:.-]|_|g'`.d -while true; do - if mkdir "$lockdir" >/dev/null 2>&1; then - break - fi - sleep 1 -done -# FIXME: race condition here if user kills between mkdir and trap. -trap "rmdir '$lockdir'; exit 1" 1 2 15 - -# Run the compile. -"$@" -ret=$? - -if test -f "$cofile"; then - test "$cofile" = "$ofile" || mv "$cofile" "$ofile" -elif test -f "${cofile}bj"; then - test "${cofile}bj" = "$ofile" || mv "${cofile}bj" "$ofile" -fi - -rmdir "$lockdir" -exit $ret - -# Local Variables: -# mode: shell-script -# sh-indentation: 2 -# eval: (add-hook 'write-file-hooks 'time-stamp) -# time-stamp-start: "scriptversion=" -# time-stamp-format: "%:y-%02m-%02d.%02H" -# time-stamp-time-zone: "UTC0" -# time-stamp-end: "; # UTC" -# End: diff -Nru gnucobol-4.0~early~20200606/build_aux/config.guess gnucobol-5/build_aux/config.guess --- gnucobol-4.0~early~20200606/build_aux/config.guess 2020-06-06 20:52:02.000000000 +0000 +++ gnucobol-5/build_aux/config.guess 1970-01-01 00:00:00.000000000 +0000 @@ -1,1645 +0,0 @@ -#! /bin/sh -# Attempt to guess a canonical system name. -# Copyright 1992-2019 Free Software Foundation, Inc. - -timestamp='2019-03-04' - -# This file is free software; you can redistribute it and/or modify it -# under the terms of the GNU General Public License as published by -# the Free Software Foundation; either version 3 of the License, or -# (at your option) any later version. -# -# This program is distributed in the hope that it will be useful, but -# WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU -# General Public License for more details. -# -# You should have received a copy of the GNU General Public License -# along with this program; if not, see . -# -# As a special exception to the GNU General Public License, if you -# distribute this file as part of a program that contains a -# configuration script generated by Autoconf, you may include it under -# the same distribution terms that you use for the rest of that -# program. This Exception is an additional permission under section 7 -# of the GNU General Public License, version 3 ("GPLv3"). -# -# Originally written by Per Bothner; maintained since 2000 by Ben Elliston. -# -# You can get the latest version of this script from: -# https://git.savannah.gnu.org/gitweb/?p=config.git;a=blob_plain;f=config.guess -# -# Please send patches to . - - -me=`echo "$0" | sed -e 's,.*/,,'` - -usage="\ -Usage: $0 [OPTION] - -Output the configuration name of the system \`$me' is run on. - -Options: - -h, --help print this help, then exit - -t, --time-stamp print date of last modification, then exit - -v, --version print version number, then exit - -Report bugs and patches to ." - -version="\ -GNU config.guess ($timestamp) - -Originally written by Per Bothner. -Copyright 1992-2019 Free Software Foundation, Inc. - -This is free software; see the source for copying conditions. There is NO -warranty; not even for MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE." - -help=" -Try \`$me --help' for more information." - -# Parse command line -while test $# -gt 0 ; do - case $1 in - --time-stamp | --time* | -t ) - echo "$timestamp" ; exit ;; - --version | -v ) - echo "$version" ; exit ;; - --help | --h* | -h ) - echo "$usage"; exit ;; - -- ) # Stop option processing - shift; break ;; - - ) # Use stdin as input. - break ;; - -* ) - echo "$me: invalid option $1$help" >&2 - exit 1 ;; - * ) - break ;; - esac -done - -if test $# != 0; then - echo "$me: too many arguments$help" >&2 - exit 1 -fi - -# CC_FOR_BUILD -- compiler used by this script. Note that the use of a -# compiler to aid in system detection is discouraged as it requires -# temporary files to be created and, as you can see below, it is a -# headache to deal with in a portable fashion. - -# Historically, `CC_FOR_BUILD' used to be named `HOST_CC'. We still -# use `HOST_CC' if defined, but it is deprecated. - -# Portable tmp directory creation inspired by the Autoconf team. - -tmp= -# shellcheck disable=SC2172 -trap 'test -z "$tmp" || rm -fr "$tmp"' 0 1 2 13 15 - -set_cc_for_build() { - : "${TMPDIR=/tmp}" - # shellcheck disable=SC2039 - { tmp=`(umask 077 && mktemp -d "$TMPDIR/cgXXXXXX") 2>/dev/null` && test -n "$tmp" && test -d "$tmp" ; } || - { test -n "$RANDOM" && tmp=$TMPDIR/cg$$-$RANDOM && (umask 077 && mkdir "$tmp" 2>/dev/null) ; } || - { tmp=$TMPDIR/cg-$$ && (umask 077 && mkdir "$tmp" 2>/dev/null) && echo "Warning: creating insecure temp directory" >&2 ; } || - { echo "$me: cannot create a temporary directory in $TMPDIR" >&2 ; exit 1 ; } - dummy=$tmp/dummy - case ${CC_FOR_BUILD-},${HOST_CC-},${CC-} in - ,,) echo "int x;" > "$dummy.c" - for driver in cc gcc c89 c99 ; do - if ($driver -c -o "$dummy.o" "$dummy.c") >/dev/null 2>&1 ; then - CC_FOR_BUILD="$driver" - break - fi - done - if test x"$CC_FOR_BUILD" = x ; then - CC_FOR_BUILD=no_compiler_found - fi - ;; - ,,*) CC_FOR_BUILD=$CC ;; - ,*,*) CC_FOR_BUILD=$HOST_CC ;; - esac -} - -# This is needed to find uname on a Pyramid OSx when run in the BSD universe. -# (ghazi@noc.rutgers.edu 1994-08-24) -if test -f /.attbin/uname ; then - PATH=$PATH:/.attbin ; export PATH -fi - -UNAME_MACHINE=`(uname -m) 2>/dev/null` || UNAME_MACHINE=unknown -UNAME_RELEASE=`(uname -r) 2>/dev/null` || UNAME_RELEASE=unknown -UNAME_SYSTEM=`(uname -s) 2>/dev/null` || UNAME_SYSTEM=unknown -UNAME_VERSION=`(uname -v) 2>/dev/null` || UNAME_VERSION=unknown - -case "$UNAME_SYSTEM" in -Linux|GNU|GNU/*) - # If the system lacks a compiler, then just pick glibc. - # We could probably try harder. - LIBC=gnu - - set_cc_for_build - cat <<-EOF > "$dummy.c" - #include - #if defined(__UCLIBC__) - LIBC=uclibc - #elif defined(__dietlibc__) - LIBC=dietlibc - #else - LIBC=gnu - #endif - EOF - eval "`$CC_FOR_BUILD -E "$dummy.c" 2>/dev/null | grep '^LIBC' | sed 's, ,,g'`" - - # If ldd exists, use it to detect musl libc. - if command -v ldd >/dev/null && \ - ldd --version 2>&1 | grep -q ^musl - then - LIBC=musl - fi - ;; -esac - -# Note: order is significant - the case branches are not exclusive. - -case "$UNAME_MACHINE:$UNAME_SYSTEM:$UNAME_RELEASE:$UNAME_VERSION" in - *:NetBSD:*:*) - # NetBSD (nbsd) targets should (where applicable) match one or - # more of the tuples: *-*-netbsdelf*, *-*-netbsdaout*, - # *-*-netbsdecoff* and *-*-netbsd*. For targets that recently - # switched to ELF, *-*-netbsd* would select the old - # object file format. This provides both forward - # compatibility and a consistent mechanism for selecting the - # object file format. - # - # Note: NetBSD doesn't particularly care about the vendor - # portion of the name. We always set it to "unknown". - sysctl="sysctl -n hw.machine_arch" - UNAME_MACHINE_ARCH=`(uname -p 2>/dev/null || \ - "/sbin/$sysctl" 2>/dev/null || \ - "/usr/sbin/$sysctl" 2>/dev/null || \ - echo unknown)` - case "$UNAME_MACHINE_ARCH" in - armeb) machine=armeb-unknown ;; - arm*) machine=arm-unknown ;; - sh3el) machine=shl-unknown ;; - sh3eb) machine=sh-unknown ;; - sh5el) machine=sh5le-unknown ;; - earmv*) - arch=`echo "$UNAME_MACHINE_ARCH" | sed -e 's,^e\(armv[0-9]\).*$,\1,'` - endian=`echo "$UNAME_MACHINE_ARCH" | sed -ne 's,^.*\(eb\)$,\1,p'` - machine="${arch}${endian}"-unknown - ;; - *) machine="$UNAME_MACHINE_ARCH"-unknown ;; - esac - # The Operating System including object format, if it has switched - # to ELF recently (or will in the future) and ABI. - case "$UNAME_MACHINE_ARCH" in - earm*) - os=netbsdelf - ;; - arm*|i386|m68k|ns32k|sh3*|sparc|vax) - set_cc_for_build - if echo __ELF__ | $CC_FOR_BUILD -E - 2>/dev/null \ - | grep -q __ELF__ - then - # Once all utilities can be ECOFF (netbsdecoff) or a.out (netbsdaout). - # Return netbsd for either. FIX? - os=netbsd - else - os=netbsdelf - fi - ;; - *) - os=netbsd - ;; - esac - # Determine ABI tags. - case "$UNAME_MACHINE_ARCH" in - earm*) - expr='s/^earmv[0-9]/-eabi/;s/eb$//' - abi=`echo "$UNAME_MACHINE_ARCH" | sed -e "$expr"` - ;; - esac - # The OS release - # Debian GNU/NetBSD machines have a different userland, and - # thus, need a distinct triplet. However, they do not need - # kernel version information, so it can be replaced with a - # suitable tag, in the style of linux-gnu. - case "$UNAME_VERSION" in - Debian*) - release='-gnu' - ;; - *) - release=`echo "$UNAME_RELEASE" | sed -e 's/[-_].*//' | cut -d. -f1,2` - ;; - esac - # Since CPU_TYPE-MANUFACTURER-KERNEL-OPERATING_SYSTEM: - # contains redundant information, the shorter form: - # CPU_TYPE-MANUFACTURER-OPERATING_SYSTEM is used. - echo "$machine-${os}${release}${abi-}" - exit ;; - *:Bitrig:*:*) - UNAME_MACHINE_ARCH=`arch | sed 's/Bitrig.//'` - echo "$UNAME_MACHINE_ARCH"-unknown-bitrig"$UNAME_RELEASE" - exit ;; - *:OpenBSD:*:*) - UNAME_MACHINE_ARCH=`arch | sed 's/OpenBSD.//'` - echo "$UNAME_MACHINE_ARCH"-unknown-openbsd"$UNAME_RELEASE" - exit ;; - *:LibertyBSD:*:*) - UNAME_MACHINE_ARCH=`arch | sed 's/^.*BSD\.//'` - echo "$UNAME_MACHINE_ARCH"-unknown-libertybsd"$UNAME_RELEASE" - exit ;; - *:MidnightBSD:*:*) - echo "$UNAME_MACHINE"-unknown-midnightbsd"$UNAME_RELEASE" - exit ;; - *:ekkoBSD:*:*) - echo "$UNAME_MACHINE"-unknown-ekkobsd"$UNAME_RELEASE" - exit ;; - *:SolidBSD:*:*) - echo "$UNAME_MACHINE"-unknown-solidbsd"$UNAME_RELEASE" - exit ;; - macppc:MirBSD:*:*) - echo powerpc-unknown-mirbsd"$UNAME_RELEASE" - exit ;; - *:MirBSD:*:*) - echo "$UNAME_MACHINE"-unknown-mirbsd"$UNAME_RELEASE" - exit ;; - *:Sortix:*:*) - echo "$UNAME_MACHINE"-unknown-sortix - exit ;; - *:Redox:*:*) - echo "$UNAME_MACHINE"-unknown-redox - exit ;; - mips:OSF1:*.*) - echo mips-dec-osf1 - exit ;; - alpha:OSF1:*:*) - case $UNAME_RELEASE in - *4.0) - UNAME_RELEASE=`/usr/sbin/sizer -v | awk '{print $3}'` - ;; - *5.*) - UNAME_RELEASE=`/usr/sbin/sizer -v | awk '{print $4}'` - ;; - esac - # According to Compaq, /usr/sbin/psrinfo has been available on - # OSF/1 and Tru64 systems produced since 1995. I hope that - # covers most systems running today. This code pipes the CPU - # types through head -n 1, so we only detect the type of CPU 0. - ALPHA_CPU_TYPE=`/usr/sbin/psrinfo -v | sed -n -e 's/^ The alpha \(.*\) processor.*$/\1/p' | head -n 1` - case "$ALPHA_CPU_TYPE" in - "EV4 (21064)") - UNAME_MACHINE=alpha ;; - "EV4.5 (21064)") - UNAME_MACHINE=alpha ;; - "LCA4 (21066/21068)") - UNAME_MACHINE=alpha ;; - "EV5 (21164)") - UNAME_MACHINE=alphaev5 ;; - "EV5.6 (21164A)") - UNAME_MACHINE=alphaev56 ;; - "EV5.6 (21164PC)") - UNAME_MACHINE=alphapca56 ;; - "EV5.7 (21164PC)") - UNAME_MACHINE=alphapca57 ;; - "EV6 (21264)") - UNAME_MACHINE=alphaev6 ;; - "EV6.7 (21264A)") - UNAME_MACHINE=alphaev67 ;; - "EV6.8CB (21264C)") - UNAME_MACHINE=alphaev68 ;; - "EV6.8AL (21264B)") - UNAME_MACHINE=alphaev68 ;; - "EV6.8CX (21264D)") - UNAME_MACHINE=alphaev68 ;; - "EV6.9A (21264/EV69A)") - UNAME_MACHINE=alphaev69 ;; - "EV7 (21364)") - UNAME_MACHINE=alphaev7 ;; - "EV7.9 (21364A)") - UNAME_MACHINE=alphaev79 ;; - esac - # A Pn.n version is a patched version. - # A Vn.n version is a released version. - # A Tn.n version is a released field test version. - # A Xn.n version is an unreleased experimental baselevel. - # 1.2 uses "1.2" for uname -r. - echo "$UNAME_MACHINE"-dec-osf"`echo "$UNAME_RELEASE" | sed -e 's/^[PVTX]//' | tr ABCDEFGHIJKLMNOPQRSTUVWXYZ abcdefghijklmnopqrstuvwxyz`" - # Reset EXIT trap before exiting to avoid spurious non-zero exit code. - exitcode=$? - trap '' 0 - exit $exitcode ;; - Amiga*:UNIX_System_V:4.0:*) - echo m68k-unknown-sysv4 - exit ;; - *:[Aa]miga[Oo][Ss]:*:*) - echo "$UNAME_MACHINE"-unknown-amigaos - exit ;; - *:[Mm]orph[Oo][Ss]:*:*) - echo "$UNAME_MACHINE"-unknown-morphos - exit ;; - *:OS/390:*:*) - echo i370-ibm-openedition - exit ;; - *:z/VM:*:*) - echo s390-ibm-zvmoe - exit ;; - *:OS400:*:*) - echo powerpc-ibm-os400 - exit ;; - arm:RISC*:1.[012]*:*|arm:riscix:1.[012]*:*) - echo arm-acorn-riscix"$UNAME_RELEASE" - exit ;; - arm*:riscos:*:*|arm*:RISCOS:*:*) - echo arm-unknown-riscos - exit ;; - SR2?01:HI-UX/MPP:*:* | SR8000:HI-UX/MPP:*:*) - echo hppa1.1-hitachi-hiuxmpp - exit ;; - Pyramid*:OSx*:*:* | MIS*:OSx*:*:* | MIS*:SMP_DC-OSx*:*:*) - # akee@wpdis03.wpafb.af.mil (Earle F. Ake) contributed MIS and NILE. - if test "`(/bin/universe) 2>/dev/null`" = att ; then - echo pyramid-pyramid-sysv3 - else - echo pyramid-pyramid-bsd - fi - exit ;; - NILE*:*:*:dcosx) - echo pyramid-pyramid-svr4 - exit ;; - DRS?6000:unix:4.0:6*) - echo sparc-icl-nx6 - exit ;; - DRS?6000:UNIX_SV:4.2*:7* | DRS?6000:isis:4.2*:7*) - case `/usr/bin/uname -p` in - sparc) echo sparc-icl-nx7; exit ;; - esac ;; - s390x:SunOS:*:*) - echo "$UNAME_MACHINE"-ibm-solaris2"`echo "$UNAME_RELEASE" | sed -e 's/[^.]*//'`" - exit ;; - sun4H:SunOS:5.*:*) - echo sparc-hal-solaris2"`echo "$UNAME_RELEASE"|sed -e 's/[^.]*//'`" - exit ;; - sun4*:SunOS:5.*:* | tadpole*:SunOS:5.*:*) - echo sparc-sun-solaris2"`echo "$UNAME_RELEASE" | sed -e 's/[^.]*//'`" - exit ;; - i86pc:AuroraUX:5.*:* | i86xen:AuroraUX:5.*:*) - echo i386-pc-auroraux"$UNAME_RELEASE" - exit ;; - i86pc:SunOS:5.*:* | i86xen:SunOS:5.*:*) - set_cc_for_build - SUN_ARCH=i386 - # If there is a compiler, see if it is configured for 64-bit objects. - # Note that the Sun cc does not turn __LP64__ into 1 like gcc does. - # This test works for both compilers. - if [ "$CC_FOR_BUILD" != no_compiler_found ]; then - if (echo '#ifdef __amd64'; echo IS_64BIT_ARCH; echo '#endif') | \ - (CCOPTS="" $CC_FOR_BUILD -E - 2>/dev/null) | \ - grep IS_64BIT_ARCH >/dev/null - then - SUN_ARCH=x86_64 - fi - fi - echo "$SUN_ARCH"-pc-solaris2"`echo "$UNAME_RELEASE"|sed -e 's/[^.]*//'`" - exit ;; - sun4*:SunOS:6*:*) - # According to config.sub, this is the proper way to canonicalize - # SunOS6. Hard to guess exactly what SunOS6 will be like, but - # it's likely to be more like Solaris than SunOS4. - echo sparc-sun-solaris3"`echo "$UNAME_RELEASE"|sed -e 's/[^.]*//'`" - exit ;; - sun4*:SunOS:*:*) - case "`/usr/bin/arch -k`" in - Series*|S4*) - UNAME_RELEASE=`uname -v` - ;; - esac - # Japanese Language versions have a version number like `4.1.3-JL'. - echo sparc-sun-sunos"`echo "$UNAME_RELEASE"|sed -e 's/-/_/'`" - exit ;; - sun3*:SunOS:*:*) - echo m68k-sun-sunos"$UNAME_RELEASE" - exit ;; - sun*:*:4.2BSD:*) - UNAME_RELEASE=`(sed 1q /etc/motd | awk '{print substr($5,1,3)}') 2>/dev/null` - test "x$UNAME_RELEASE" = x && UNAME_RELEASE=3 - case "`/bin/arch`" in - sun3) - echo m68k-sun-sunos"$UNAME_RELEASE" - ;; - sun4) - echo sparc-sun-sunos"$UNAME_RELEASE" - ;; - esac - exit ;; - aushp:SunOS:*:*) - echo sparc-auspex-sunos"$UNAME_RELEASE" - exit ;; - # The situation for MiNT is a little confusing. The machine name - # can be virtually everything (everything which is not - # "atarist" or "atariste" at least should have a processor - # > m68000). The system name ranges from "MiNT" over "FreeMiNT" - # to the lowercase version "mint" (or "freemint"). Finally - # the system name "TOS" denotes a system which is actually not - # MiNT. But MiNT is downward compatible to TOS, so this should - # be no problem. - atarist[e]:*MiNT:*:* | atarist[e]:*mint:*:* | atarist[e]:*TOS:*:*) - echo m68k-atari-mint"$UNAME_RELEASE" - exit ;; - atari*:*MiNT:*:* | atari*:*mint:*:* | atarist[e]:*TOS:*:*) - echo m68k-atari-mint"$UNAME_RELEASE" - exit ;; - *falcon*:*MiNT:*:* | *falcon*:*mint:*:* | *falcon*:*TOS:*:*) - echo m68k-atari-mint"$UNAME_RELEASE" - exit ;; - milan*:*MiNT:*:* | milan*:*mint:*:* | *milan*:*TOS:*:*) - echo m68k-milan-mint"$UNAME_RELEASE" - exit ;; - hades*:*MiNT:*:* | hades*:*mint:*:* | *hades*:*TOS:*:*) - echo m68k-hades-mint"$UNAME_RELEASE" - exit ;; - *:*MiNT:*:* | *:*mint:*:* | *:*TOS:*:*) - echo m68k-unknown-mint"$UNAME_RELEASE" - exit ;; - m68k:machten:*:*) - echo m68k-apple-machten"$UNAME_RELEASE" - exit ;; - powerpc:machten:*:*) - echo powerpc-apple-machten"$UNAME_RELEASE" - exit ;; - RISC*:Mach:*:*) - echo mips-dec-mach_bsd4.3 - exit ;; - RISC*:ULTRIX:*:*) - echo mips-dec-ultrix"$UNAME_RELEASE" - exit ;; - VAX*:ULTRIX*:*:*) - echo vax-dec-ultrix"$UNAME_RELEASE" - exit ;; - 2020:CLIX:*:* | 2430:CLIX:*:*) - echo clipper-intergraph-clix"$UNAME_RELEASE" - exit ;; - mips:*:*:UMIPS | mips:*:*:RISCos) - set_cc_for_build - sed 's/^ //' << EOF > "$dummy.c" -#ifdef __cplusplus -#include /* for printf() prototype */ - int main (int argc, char *argv[]) { -#else - int main (argc, argv) int argc; char *argv[]; { -#endif - #if defined (host_mips) && defined (MIPSEB) - #if defined (SYSTYPE_SYSV) - printf ("mips-mips-riscos%ssysv\\n", argv[1]); exit (0); - #endif - #if defined (SYSTYPE_SVR4) - printf ("mips-mips-riscos%ssvr4\\n", argv[1]); exit (0); - #endif - #if defined (SYSTYPE_BSD43) || defined(SYSTYPE_BSD) - printf ("mips-mips-riscos%sbsd\\n", argv[1]); exit (0); - #endif - #endif - exit (-1); - } -EOF - $CC_FOR_BUILD -o "$dummy" "$dummy.c" && - dummyarg=`echo "$UNAME_RELEASE" | sed -n 's/\([0-9]*\).*/\1/p'` && - SYSTEM_NAME=`"$dummy" "$dummyarg"` && - { echo "$SYSTEM_NAME"; exit; } - echo mips-mips-riscos"$UNAME_RELEASE" - exit ;; - Motorola:PowerMAX_OS:*:*) - echo powerpc-motorola-powermax - exit ;; - Motorola:*:4.3:PL8-*) - echo powerpc-harris-powermax - exit ;; - Night_Hawk:*:*:PowerMAX_OS | Synergy:PowerMAX_OS:*:*) - echo powerpc-harris-powermax - exit ;; - Night_Hawk:Power_UNIX:*:*) - echo powerpc-harris-powerunix - exit ;; - m88k:CX/UX:7*:*) - echo m88k-harris-cxux7 - exit ;; - m88k:*:4*:R4*) - echo m88k-motorola-sysv4 - exit ;; - m88k:*:3*:R3*) - echo m88k-motorola-sysv3 - exit ;; - AViiON:dgux:*:*) - # DG/UX returns AViiON for all architectures - UNAME_PROCESSOR=`/usr/bin/uname -p` - if [ "$UNAME_PROCESSOR" = mc88100 ] || [ "$UNAME_PROCESSOR" = mc88110 ] - then - if [ "$TARGET_BINARY_INTERFACE"x = m88kdguxelfx ] || \ - [ "$TARGET_BINARY_INTERFACE"x = x ] - then - echo m88k-dg-dgux"$UNAME_RELEASE" - else - echo m88k-dg-dguxbcs"$UNAME_RELEASE" - fi - else - echo i586-dg-dgux"$UNAME_RELEASE" - fi - exit ;; - M88*:DolphinOS:*:*) # DolphinOS (SVR3) - echo m88k-dolphin-sysv3 - exit ;; - M88*:*:R3*:*) - # Delta 88k system running SVR3 - echo m88k-motorola-sysv3 - exit ;; - XD88*:*:*:*) # Tektronix XD88 system running UTekV (SVR3) - echo m88k-tektronix-sysv3 - exit ;; - Tek43[0-9][0-9]:UTek:*:*) # Tektronix 4300 system running UTek (BSD) - echo m68k-tektronix-bsd - exit ;; - *:IRIX*:*:*) - echo mips-sgi-irix"`echo "$UNAME_RELEASE"|sed -e 's/-/_/g'`" - exit ;; - ????????:AIX?:[12].1:2) # AIX 2.2.1 or AIX 2.1.1 is RT/PC AIX. - echo romp-ibm-aix # uname -m gives an 8 hex-code CPU id - exit ;; # Note that: echo "'`uname -s`'" gives 'AIX ' - i*86:AIX:*:*) - echo i386-ibm-aix - exit ;; - ia64:AIX:*:*) - if [ -x /usr/bin/oslevel ] ; then - IBM_REV=`/usr/bin/oslevel` - else - IBM_REV="$UNAME_VERSION.$UNAME_RELEASE" - fi - echo "$UNAME_MACHINE"-ibm-aix"$IBM_REV" - exit ;; - *:AIX:2:3) - if grep bos325 /usr/include/stdio.h >/dev/null 2>&1; then - set_cc_for_build - sed 's/^ //' << EOF > "$dummy.c" - #include - - main() - { - if (!__power_pc()) - exit(1); - puts("powerpc-ibm-aix3.2.5"); - exit(0); - } -EOF - if $CC_FOR_BUILD -o "$dummy" "$dummy.c" && SYSTEM_NAME=`"$dummy"` - then - echo "$SYSTEM_NAME" - else - echo rs6000-ibm-aix3.2.5 - fi - elif grep bos324 /usr/include/stdio.h >/dev/null 2>&1; then - echo rs6000-ibm-aix3.2.4 - else - echo rs6000-ibm-aix3.2 - fi - exit ;; - *:AIX:*:[4567]) - IBM_CPU_ID=`/usr/sbin/lsdev -C -c processor -S available | sed 1q | awk '{ print $1 }'` - if /usr/sbin/lsattr -El "$IBM_CPU_ID" | grep ' POWER' >/dev/null 2>&1; then - IBM_ARCH=rs6000 - else - IBM_ARCH=powerpc - fi - if [ -x /usr/bin/lslpp ] ; then - IBM_REV=`/usr/bin/lslpp -Lqc bos.rte.libc | - awk -F: '{ print $3 }' | sed s/[0-9]*$/0/` - else - IBM_REV="$UNAME_VERSION.$UNAME_RELEASE" - fi - echo "$IBM_ARCH"-ibm-aix"$IBM_REV" - exit ;; - *:AIX:*:*) - echo rs6000-ibm-aix - exit ;; - ibmrt:4.4BSD:*|romp-ibm:4.4BSD:*) - echo romp-ibm-bsd4.4 - exit ;; - ibmrt:*BSD:*|romp-ibm:BSD:*) # covers RT/PC BSD and - echo romp-ibm-bsd"$UNAME_RELEASE" # 4.3 with uname added to - exit ;; # report: romp-ibm BSD 4.3 - *:BOSX:*:*) - echo rs6000-bull-bosx - exit ;; - DPX/2?00:B.O.S.:*:*) - echo m68k-bull-sysv3 - exit ;; - 9000/[34]??:4.3bsd:1.*:*) - echo m68k-hp-bsd - exit ;; - hp300:4.4BSD:*:* | 9000/[34]??:4.3bsd:2.*:*) - echo m68k-hp-bsd4.4 - exit ;; - 9000/[34678]??:HP-UX:*:*) - HPUX_REV=`echo "$UNAME_RELEASE"|sed -e 's/[^.]*.[0B]*//'` - case "$UNAME_MACHINE" in - 9000/31?) HP_ARCH=m68000 ;; - 9000/[34]??) HP_ARCH=m68k ;; - 9000/[678][0-9][0-9]) - if [ -x /usr/bin/getconf ]; then - sc_cpu_version=`/usr/bin/getconf SC_CPU_VERSION 2>/dev/null` - sc_kernel_bits=`/usr/bin/getconf SC_KERNEL_BITS 2>/dev/null` - case "$sc_cpu_version" in - 523) HP_ARCH=hppa1.0 ;; # CPU_PA_RISC1_0 - 528) HP_ARCH=hppa1.1 ;; # CPU_PA_RISC1_1 - 532) # CPU_PA_RISC2_0 - case "$sc_kernel_bits" in - 32) HP_ARCH=hppa2.0n ;; - 64) HP_ARCH=hppa2.0w ;; - '') HP_ARCH=hppa2.0 ;; # HP-UX 10.20 - esac ;; - esac - fi - if [ "$HP_ARCH" = "" ]; then - set_cc_for_build - sed 's/^ //' << EOF > "$dummy.c" - - #define _HPUX_SOURCE - #include - #include - - int main () - { - #if defined(_SC_KERNEL_BITS) - long bits = sysconf(_SC_KERNEL_BITS); - #endif - long cpu = sysconf (_SC_CPU_VERSION); - - switch (cpu) - { - case CPU_PA_RISC1_0: puts ("hppa1.0"); break; - case CPU_PA_RISC1_1: puts ("hppa1.1"); break; - case CPU_PA_RISC2_0: - #if defined(_SC_KERNEL_BITS) - switch (bits) - { - case 64: puts ("hppa2.0w"); break; - case 32: puts ("hppa2.0n"); break; - default: puts ("hppa2.0"); break; - } break; - #else /* !defined(_SC_KERNEL_BITS) */ - puts ("hppa2.0"); break; - #endif - default: puts ("hppa1.0"); break; - } - exit (0); - } -EOF - (CCOPTS="" $CC_FOR_BUILD -o "$dummy" "$dummy.c" 2>/dev/null) && HP_ARCH=`"$dummy"` - test -z "$HP_ARCH" && HP_ARCH=hppa - fi ;; - esac - if [ "$HP_ARCH" = hppa2.0w ] - then - set_cc_for_build - - # hppa2.0w-hp-hpux* has a 64-bit kernel and a compiler generating - # 32-bit code. hppa64-hp-hpux* has the same kernel and a compiler - # generating 64-bit code. GNU and HP use different nomenclature: - # - # $ CC_FOR_BUILD=cc ./config.guess - # => hppa2.0w-hp-hpux11.23 - # $ CC_FOR_BUILD="cc +DA2.0w" ./config.guess - # => hppa64-hp-hpux11.23 - - if echo __LP64__ | (CCOPTS="" $CC_FOR_BUILD -E - 2>/dev/null) | - grep -q __LP64__ - then - HP_ARCH=hppa2.0w - else - HP_ARCH=hppa64 - fi - fi - echo "$HP_ARCH"-hp-hpux"$HPUX_REV" - exit ;; - ia64:HP-UX:*:*) - HPUX_REV=`echo "$UNAME_RELEASE"|sed -e 's/[^.]*.[0B]*//'` - echo ia64-hp-hpux"$HPUX_REV" - exit ;; - 3050*:HI-UX:*:*) - set_cc_for_build - sed 's/^ //' << EOF > "$dummy.c" - #include - int - main () - { - long cpu = sysconf (_SC_CPU_VERSION); - /* The order matters, because CPU_IS_HP_MC68K erroneously returns - true for CPU_PA_RISC1_0. CPU_IS_PA_RISC returns correct - results, however. */ - if (CPU_IS_PA_RISC (cpu)) - { - switch (cpu) - { - case CPU_PA_RISC1_0: puts ("hppa1.0-hitachi-hiuxwe2"); break; - case CPU_PA_RISC1_1: puts ("hppa1.1-hitachi-hiuxwe2"); break; - case CPU_PA_RISC2_0: puts ("hppa2.0-hitachi-hiuxwe2"); break; - default: puts ("hppa-hitachi-hiuxwe2"); break; - } - } - else if (CPU_IS_HP_MC68K (cpu)) - puts ("m68k-hitachi-hiuxwe2"); - else puts ("unknown-hitachi-hiuxwe2"); - exit (0); - } -EOF - $CC_FOR_BUILD -o "$dummy" "$dummy.c" && SYSTEM_NAME=`"$dummy"` && - { echo "$SYSTEM_NAME"; exit; } - echo unknown-hitachi-hiuxwe2 - exit ;; - 9000/7??:4.3bsd:*:* | 9000/8?[79]:4.3bsd:*:*) - echo hppa1.1-hp-bsd - exit ;; - 9000/8??:4.3bsd:*:*) - echo hppa1.0-hp-bsd - exit ;; - *9??*:MPE/iX:*:* | *3000*:MPE/iX:*:*) - echo hppa1.0-hp-mpeix - exit ;; - hp7??:OSF1:*:* | hp8?[79]:OSF1:*:*) - echo hppa1.1-hp-osf - exit ;; - hp8??:OSF1:*:*) - echo hppa1.0-hp-osf - exit ;; - i*86:OSF1:*:*) - if [ -x /usr/sbin/sysversion ] ; then - echo "$UNAME_MACHINE"-unknown-osf1mk - else - echo "$UNAME_MACHINE"-unknown-osf1 - fi - exit ;; - parisc*:Lites*:*:*) - echo hppa1.1-hp-lites - exit ;; - C1*:ConvexOS:*:* | convex:ConvexOS:C1*:*) - echo c1-convex-bsd - exit ;; - C2*:ConvexOS:*:* | convex:ConvexOS:C2*:*) - if getsysinfo -f scalar_acc - then echo c32-convex-bsd - else echo c2-convex-bsd - fi - exit ;; - C34*:ConvexOS:*:* | convex:ConvexOS:C34*:*) - echo c34-convex-bsd - exit ;; - C38*:ConvexOS:*:* | convex:ConvexOS:C38*:*) - echo c38-convex-bsd - exit ;; - C4*:ConvexOS:*:* | convex:ConvexOS:C4*:*) - echo c4-convex-bsd - exit ;; - CRAY*Y-MP:*:*:*) - echo ymp-cray-unicos"$UNAME_RELEASE" | sed -e 's/\.[^.]*$/.X/' - exit ;; - CRAY*[A-Z]90:*:*:*) - echo "$UNAME_MACHINE"-cray-unicos"$UNAME_RELEASE" \ - | sed -e 's/CRAY.*\([A-Z]90\)/\1/' \ - -e y/ABCDEFGHIJKLMNOPQRSTUVWXYZ/abcdefghijklmnopqrstuvwxyz/ \ - -e 's/\.[^.]*$/.X/' - exit ;; - CRAY*TS:*:*:*) - echo t90-cray-unicos"$UNAME_RELEASE" | sed -e 's/\.[^.]*$/.X/' - exit ;; - CRAY*T3E:*:*:*) - echo alphaev5-cray-unicosmk"$UNAME_RELEASE" | sed -e 's/\.[^.]*$/.X/' - exit ;; - CRAY*SV1:*:*:*) - echo sv1-cray-unicos"$UNAME_RELEASE" | sed -e 's/\.[^.]*$/.X/' - exit ;; - *:UNICOS/mp:*:*) - echo craynv-cray-unicosmp"$UNAME_RELEASE" | sed -e 's/\.[^.]*$/.X/' - exit ;; - F30[01]:UNIX_System_V:*:* | F700:UNIX_System_V:*:*) - FUJITSU_PROC=`uname -m | tr ABCDEFGHIJKLMNOPQRSTUVWXYZ abcdefghijklmnopqrstuvwxyz` - FUJITSU_SYS=`uname -p | tr ABCDEFGHIJKLMNOPQRSTUVWXYZ abcdefghijklmnopqrstuvwxyz | sed -e 's/\///'` - FUJITSU_REL=`echo "$UNAME_RELEASE" | sed -e 's/ /_/'` - echo "${FUJITSU_PROC}-fujitsu-${FUJITSU_SYS}${FUJITSU_REL}" - exit ;; - 5000:UNIX_System_V:4.*:*) - FUJITSU_SYS=`uname -p | tr ABCDEFGHIJKLMNOPQRSTUVWXYZ abcdefghijklmnopqrstuvwxyz | sed -e 's/\///'` - FUJITSU_REL=`echo "$UNAME_RELEASE" | tr ABCDEFGHIJKLMNOPQRSTUVWXYZ abcdefghijklmnopqrstuvwxyz | sed -e 's/ /_/'` - echo "sparc-fujitsu-${FUJITSU_SYS}${FUJITSU_REL}" - exit ;; - i*86:BSD/386:*:* | i*86:BSD/OS:*:* | *:Ascend\ Embedded/OS:*:*) - echo "$UNAME_MACHINE"-pc-bsdi"$UNAME_RELEASE" - exit ;; - sparc*:BSD/OS:*:*) - echo sparc-unknown-bsdi"$UNAME_RELEASE" - exit ;; - *:BSD/OS:*:*) - echo "$UNAME_MACHINE"-unknown-bsdi"$UNAME_RELEASE" - exit ;; - arm:FreeBSD:*:*) - UNAME_PROCESSOR=`uname -p` - set_cc_for_build - if echo __ARM_PCS_VFP | $CC_FOR_BUILD -E - 2>/dev/null \ - | grep -q __ARM_PCS_VFP - then - echo "${UNAME_PROCESSOR}"-unknown-freebsd"`echo ${UNAME_RELEASE}|sed -e 's/[-(].*//'`"-gnueabi - else - echo "${UNAME_PROCESSOR}"-unknown-freebsd"`echo ${UNAME_RELEASE}|sed -e 's/[-(].*//'`"-gnueabihf - fi - exit ;; - *:FreeBSD:*:*) - UNAME_PROCESSOR=`/usr/bin/uname -p` - case "$UNAME_PROCESSOR" in - amd64) - UNAME_PROCESSOR=x86_64 ;; - i386) - UNAME_PROCESSOR=i586 ;; - esac - echo "$UNAME_PROCESSOR"-unknown-freebsd"`echo "$UNAME_RELEASE"|sed -e 's/[-(].*//'`" - exit ;; - i*:CYGWIN*:*) - echo "$UNAME_MACHINE"-pc-cygwin - exit ;; - *:MINGW64*:*) - echo "$UNAME_MACHINE"-pc-mingw64 - exit ;; - *:MINGW*:*) - echo "$UNAME_MACHINE"-pc-mingw32 - exit ;; - *:MSYS*:*) - echo "$UNAME_MACHINE"-pc-msys - exit ;; - i*:PW*:*) - echo "$UNAME_MACHINE"-pc-pw32 - exit ;; - *:Interix*:*) - case "$UNAME_MACHINE" in - x86) - echo i586-pc-interix"$UNAME_RELEASE" - exit ;; - authenticamd | genuineintel | EM64T) - echo x86_64-unknown-interix"$UNAME_RELEASE" - exit ;; - IA64) - echo ia64-unknown-interix"$UNAME_RELEASE" - exit ;; - esac ;; - i*:UWIN*:*) - echo "$UNAME_MACHINE"-pc-uwin - exit ;; - amd64:CYGWIN*:*:* | x86_64:CYGWIN*:*:*) - echo x86_64-pc-cygwin - exit ;; - prep*:SunOS:5.*:*) - echo powerpcle-unknown-solaris2"`echo "$UNAME_RELEASE"|sed -e 's/[^.]*//'`" - exit ;; - *:GNU:*:*) - # the GNU system - echo "`echo "$UNAME_MACHINE"|sed -e 's,[-/].*$,,'`-unknown-$LIBC`echo "$UNAME_RELEASE"|sed -e 's,/.*$,,'`" - exit ;; - *:GNU/*:*:*) - # other systems with GNU libc and userland - echo "$UNAME_MACHINE-unknown-`echo "$UNAME_SYSTEM" | sed 's,^[^/]*/,,' | tr "[:upper:]" "[:lower:]"``echo "$UNAME_RELEASE"|sed -e 's/[-(].*//'`-$LIBC" - exit ;; - *:Minix:*:*) - echo "$UNAME_MACHINE"-unknown-minix - exit ;; - aarch64:Linux:*:*) - echo "$UNAME_MACHINE"-unknown-linux-"$LIBC" - exit ;; - aarch64_be:Linux:*:*) - UNAME_MACHINE=aarch64_be - echo "$UNAME_MACHINE"-unknown-linux-"$LIBC" - exit ;; - alpha:Linux:*:*) - case `sed -n '/^cpu model/s/^.*: \(.*\)/\1/p' < /proc/cpuinfo` in - EV5) UNAME_MACHINE=alphaev5 ;; - EV56) UNAME_MACHINE=alphaev56 ;; - PCA56) UNAME_MACHINE=alphapca56 ;; - PCA57) UNAME_MACHINE=alphapca56 ;; - EV6) UNAME_MACHINE=alphaev6 ;; - EV67) UNAME_MACHINE=alphaev67 ;; - EV68*) UNAME_MACHINE=alphaev68 ;; - esac - objdump --private-headers /bin/sh | grep -q ld.so.1 - if test "$?" = 0 ; then LIBC=gnulibc1 ; fi - echo "$UNAME_MACHINE"-unknown-linux-"$LIBC" - exit ;; - arc:Linux:*:* | arceb:Linux:*:*) - echo "$UNAME_MACHINE"-unknown-linux-"$LIBC" - exit ;; - arm*:Linux:*:*) - set_cc_for_build - if echo __ARM_EABI__ | $CC_FOR_BUILD -E - 2>/dev/null \ - | grep -q __ARM_EABI__ - then - echo "$UNAME_MACHINE"-unknown-linux-"$LIBC" - else - if echo __ARM_PCS_VFP | $CC_FOR_BUILD -E - 2>/dev/null \ - | grep -q __ARM_PCS_VFP - then - echo "$UNAME_MACHINE"-unknown-linux-"$LIBC"eabi - else - echo "$UNAME_MACHINE"-unknown-linux-"$LIBC"eabihf - fi - fi - exit ;; - avr32*:Linux:*:*) - echo "$UNAME_MACHINE"-unknown-linux-"$LIBC" - exit ;; - cris:Linux:*:*) - echo "$UNAME_MACHINE"-axis-linux-"$LIBC" - exit ;; - crisv32:Linux:*:*) - echo "$UNAME_MACHINE"-axis-linux-"$LIBC" - exit ;; - e2k:Linux:*:*) - echo "$UNAME_MACHINE"-unknown-linux-"$LIBC" - exit ;; - frv:Linux:*:*) - echo "$UNAME_MACHINE"-unknown-linux-"$LIBC" - exit ;; - hexagon:Linux:*:*) - echo "$UNAME_MACHINE"-unknown-linux-"$LIBC" - exit ;; - i*86:Linux:*:*) - echo "$UNAME_MACHINE"-pc-linux-"$LIBC" - exit ;; - ia64:Linux:*:*) - echo "$UNAME_MACHINE"-unknown-linux-"$LIBC" - exit ;; - k1om:Linux:*:*) - echo "$UNAME_MACHINE"-unknown-linux-"$LIBC" - exit ;; - m32r*:Linux:*:*) - echo "$UNAME_MACHINE"-unknown-linux-"$LIBC" - exit ;; - m68*:Linux:*:*) - echo "$UNAME_MACHINE"-unknown-linux-"$LIBC" - exit ;; - mips:Linux:*:* | mips64:Linux:*:*) - set_cc_for_build - IS_GLIBC=0 - test x"${LIBC}" = xgnu && IS_GLIBC=1 - sed 's/^ //' << EOF > "$dummy.c" - #undef CPU - #undef mips - #undef mipsel - #undef mips64 - #undef mips64el - #if ${IS_GLIBC} && defined(_ABI64) - LIBCABI=gnuabi64 - #else - #if ${IS_GLIBC} && defined(_ABIN32) - LIBCABI=gnuabin32 - #else - LIBCABI=${LIBC} - #endif - #endif - - #if ${IS_GLIBC} && defined(__mips64) && defined(__mips_isa_rev) && __mips_isa_rev>=6 - CPU=mipsisa64r6 - #else - #if ${IS_GLIBC} && !defined(__mips64) && defined(__mips_isa_rev) && __mips_isa_rev>=6 - CPU=mipsisa32r6 - #else - #if defined(__mips64) - CPU=mips64 - #else - CPU=mips - #endif - #endif - #endif - - #if defined(__MIPSEL__) || defined(__MIPSEL) || defined(_MIPSEL) || defined(MIPSEL) - MIPS_ENDIAN=el - #else - #if defined(__MIPSEB__) || defined(__MIPSEB) || defined(_MIPSEB) || defined(MIPSEB) - MIPS_ENDIAN= - #else - MIPS_ENDIAN= - #endif - #endif -EOF - eval "`$CC_FOR_BUILD -E "$dummy.c" 2>/dev/null | grep '^CPU\|^MIPS_ENDIAN\|^LIBCABI'`" - test "x$CPU" != x && { echo "$CPU${MIPS_ENDIAN}-unknown-linux-$LIBCABI"; exit; } - ;; - mips64el:Linux:*:*) - echo "$UNAME_MACHINE"-unknown-linux-"$LIBC" - exit ;; - openrisc*:Linux:*:*) - echo or1k-unknown-linux-"$LIBC" - exit ;; - or32:Linux:*:* | or1k*:Linux:*:*) - echo "$UNAME_MACHINE"-unknown-linux-"$LIBC" - exit ;; - padre:Linux:*:*) - echo sparc-unknown-linux-"$LIBC" - exit ;; - parisc64:Linux:*:* | hppa64:Linux:*:*) - echo hppa64-unknown-linux-"$LIBC" - exit ;; - parisc:Linux:*:* | hppa:Linux:*:*) - # Look for CPU level - case `grep '^cpu[^a-z]*:' /proc/cpuinfo 2>/dev/null | cut -d' ' -f2` in - PA7*) echo hppa1.1-unknown-linux-"$LIBC" ;; - PA8*) echo hppa2.0-unknown-linux-"$LIBC" ;; - *) echo hppa-unknown-linux-"$LIBC" ;; - esac - exit ;; - ppc64:Linux:*:*) - echo powerpc64-unknown-linux-"$LIBC" - exit ;; - ppc:Linux:*:*) - echo powerpc-unknown-linux-"$LIBC" - exit ;; - ppc64le:Linux:*:*) - echo powerpc64le-unknown-linux-"$LIBC" - exit ;; - ppcle:Linux:*:*) - echo powerpcle-unknown-linux-"$LIBC" - exit ;; - riscv32:Linux:*:* | riscv64:Linux:*:*) - echo "$UNAME_MACHINE"-unknown-linux-"$LIBC" - exit ;; - s390:Linux:*:* | s390x:Linux:*:*) - echo "$UNAME_MACHINE"-ibm-linux-"$LIBC" - exit ;; - sh64*:Linux:*:*) - echo "$UNAME_MACHINE"-unknown-linux-"$LIBC" - exit ;; - sh*:Linux:*:*) - echo "$UNAME_MACHINE"-unknown-linux-"$LIBC" - exit ;; - sparc:Linux:*:* | sparc64:Linux:*:*) - echo "$UNAME_MACHINE"-unknown-linux-"$LIBC" - exit ;; - tile*:Linux:*:*) - echo "$UNAME_MACHINE"-unknown-linux-"$LIBC" - exit ;; - vax:Linux:*:*) - echo "$UNAME_MACHINE"-dec-linux-"$LIBC" - exit ;; - x86_64:Linux:*:*) - echo "$UNAME_MACHINE"-pc-linux-"$LIBC" - exit ;; - xtensa*:Linux:*:*) - echo "$UNAME_MACHINE"-unknown-linux-"$LIBC" - exit ;; - i*86:DYNIX/ptx:4*:*) - # ptx 4.0 does uname -s correctly, with DYNIX/ptx in there. - # earlier versions are messed up and put the nodename in both - # sysname and nodename. - echo i386-sequent-sysv4 - exit ;; - i*86:UNIX_SV:4.2MP:2.*) - # Unixware is an offshoot of SVR4, but it has its own version - # number series starting with 2... - # I am not positive that other SVR4 systems won't match this, - # I just have to hope. -- rms. - # Use sysv4.2uw... so that sysv4* matches it. - echo "$UNAME_MACHINE"-pc-sysv4.2uw"$UNAME_VERSION" - exit ;; - i*86:OS/2:*:*) - # If we were able to find `uname', then EMX Unix compatibility - # is probably installed. - echo "$UNAME_MACHINE"-pc-os2-emx - exit ;; - i*86:XTS-300:*:STOP) - echo "$UNAME_MACHINE"-unknown-stop - exit ;; - i*86:atheos:*:*) - echo "$UNAME_MACHINE"-unknown-atheos - exit ;; - i*86:syllable:*:*) - echo "$UNAME_MACHINE"-pc-syllable - exit ;; - i*86:LynxOS:2.*:* | i*86:LynxOS:3.[01]*:* | i*86:LynxOS:4.[02]*:*) - echo i386-unknown-lynxos"$UNAME_RELEASE" - exit ;; - i*86:*DOS:*:*) - echo "$UNAME_MACHINE"-pc-msdosdjgpp - exit ;; - i*86:*:4.*:*) - UNAME_REL=`echo "$UNAME_RELEASE" | sed 's/\/MP$//'` - if grep Novell /usr/include/link.h >/dev/null 2>/dev/null; then - echo "$UNAME_MACHINE"-univel-sysv"$UNAME_REL" - else - echo "$UNAME_MACHINE"-pc-sysv"$UNAME_REL" - fi - exit ;; - i*86:*:5:[678]*) - # UnixWare 7.x, OpenUNIX and OpenServer 6. - case `/bin/uname -X | grep "^Machine"` in - *486*) UNAME_MACHINE=i486 ;; - *Pentium) UNAME_MACHINE=i586 ;; - *Pent*|*Celeron) UNAME_MACHINE=i686 ;; - esac - echo "$UNAME_MACHINE-unknown-sysv${UNAME_RELEASE}${UNAME_SYSTEM}${UNAME_VERSION}" - exit ;; - i*86:*:3.2:*) - if test -f /usr/options/cb.name; then - UNAME_REL=`sed -n 's/.*Version //p' /dev/null >/dev/null ; then - UNAME_REL=`(/bin/uname -X|grep Release|sed -e 's/.*= //')` - (/bin/uname -X|grep i80486 >/dev/null) && UNAME_MACHINE=i486 - (/bin/uname -X|grep '^Machine.*Pentium' >/dev/null) \ - && UNAME_MACHINE=i586 - (/bin/uname -X|grep '^Machine.*Pent *II' >/dev/null) \ - && UNAME_MACHINE=i686 - (/bin/uname -X|grep '^Machine.*Pentium Pro' >/dev/null) \ - && UNAME_MACHINE=i686 - echo "$UNAME_MACHINE"-pc-sco"$UNAME_REL" - else - echo "$UNAME_MACHINE"-pc-sysv32 - fi - exit ;; - pc:*:*:*) - # Left here for compatibility: - # uname -m prints for DJGPP always 'pc', but it prints nothing about - # the processor, so we play safe by assuming i586. - # Note: whatever this is, it MUST be the same as what config.sub - # prints for the "djgpp" host, or else GDB configure will decide that - # this is a cross-build. - echo i586-pc-msdosdjgpp - exit ;; - Intel:Mach:3*:*) - echo i386-pc-mach3 - exit ;; - paragon:*:*:*) - echo i860-intel-osf1 - exit ;; - i860:*:4.*:*) # i860-SVR4 - if grep Stardent /usr/include/sys/uadmin.h >/dev/null 2>&1 ; then - echo i860-stardent-sysv"$UNAME_RELEASE" # Stardent Vistra i860-SVR4 - else # Add other i860-SVR4 vendors below as they are discovered. - echo i860-unknown-sysv"$UNAME_RELEASE" # Unknown i860-SVR4 - fi - exit ;; - mini*:CTIX:SYS*5:*) - # "miniframe" - echo m68010-convergent-sysv - exit ;; - mc68k:UNIX:SYSTEM5:3.51m) - echo m68k-convergent-sysv - exit ;; - M680?0:D-NIX:5.3:*) - echo m68k-diab-dnix - exit ;; - M68*:*:R3V[5678]*:*) - test -r /sysV68 && { echo 'm68k-motorola-sysv'; exit; } ;; - 3[345]??:*:4.0:3.0 | 3[34]??A:*:4.0:3.0 | 3[34]??,*:*:4.0:3.0 | 3[34]??/*:*:4.0:3.0 | 4400:*:4.0:3.0 | 4850:*:4.0:3.0 | SKA40:*:4.0:3.0 | SDS2:*:4.0:3.0 | SHG2:*:4.0:3.0 | S7501*:*:4.0:3.0) - OS_REL='' - test -r /etc/.relid \ - && OS_REL=.`sed -n 's/[^ ]* [^ ]* \([0-9][0-9]\).*/\1/p' < /etc/.relid` - /bin/uname -p 2>/dev/null | grep 86 >/dev/null \ - && { echo i486-ncr-sysv4.3"$OS_REL"; exit; } - /bin/uname -p 2>/dev/null | /bin/grep entium >/dev/null \ - && { echo i586-ncr-sysv4.3"$OS_REL"; exit; } ;; - 3[34]??:*:4.0:* | 3[34]??,*:*:4.0:*) - /bin/uname -p 2>/dev/null | grep 86 >/dev/null \ - && { echo i486-ncr-sysv4; exit; } ;; - NCR*:*:4.2:* | MPRAS*:*:4.2:*) - OS_REL='.3' - test -r /etc/.relid \ - && OS_REL=.`sed -n 's/[^ ]* [^ ]* \([0-9][0-9]\).*/\1/p' < /etc/.relid` - /bin/uname -p 2>/dev/null | grep 86 >/dev/null \ - && { echo i486-ncr-sysv4.3"$OS_REL"; exit; } - /bin/uname -p 2>/dev/null | /bin/grep entium >/dev/null \ - && { echo i586-ncr-sysv4.3"$OS_REL"; exit; } - /bin/uname -p 2>/dev/null | /bin/grep pteron >/dev/null \ - && { echo i586-ncr-sysv4.3"$OS_REL"; exit; } ;; - m68*:LynxOS:2.*:* | m68*:LynxOS:3.0*:*) - echo m68k-unknown-lynxos"$UNAME_RELEASE" - exit ;; - mc68030:UNIX_System_V:4.*:*) - echo m68k-atari-sysv4 - exit ;; - TSUNAMI:LynxOS:2.*:*) - echo sparc-unknown-lynxos"$UNAME_RELEASE" - exit ;; - rs6000:LynxOS:2.*:*) - echo rs6000-unknown-lynxos"$UNAME_RELEASE" - exit ;; - PowerPC:LynxOS:2.*:* | PowerPC:LynxOS:3.[01]*:* | PowerPC:LynxOS:4.[02]*:*) - echo powerpc-unknown-lynxos"$UNAME_RELEASE" - exit ;; - SM[BE]S:UNIX_SV:*:*) - echo mips-dde-sysv"$UNAME_RELEASE" - exit ;; - RM*:ReliantUNIX-*:*:*) - echo mips-sni-sysv4 - exit ;; - RM*:SINIX-*:*:*) - echo mips-sni-sysv4 - exit ;; - *:SINIX-*:*:*) - if uname -p 2>/dev/null >/dev/null ; then - UNAME_MACHINE=`(uname -p) 2>/dev/null` - echo "$UNAME_MACHINE"-sni-sysv4 - else - echo ns32k-sni-sysv - fi - exit ;; - PENTIUM:*:4.0*:*) # Unisys `ClearPath HMP IX 4000' SVR4/MP effort - # says - echo i586-unisys-sysv4 - exit ;; - *:UNIX_System_V:4*:FTX*) - # From Gerald Hewes . - # How about differentiating between stratus architectures? -djm - echo hppa1.1-stratus-sysv4 - exit ;; - *:*:*:FTX*) - # From seanf@swdc.stratus.com. - echo i860-stratus-sysv4 - exit ;; - i*86:VOS:*:*) - # From Paul.Green@stratus.com. - echo "$UNAME_MACHINE"-stratus-vos - exit ;; - *:VOS:*:*) - # From Paul.Green@stratus.com. - echo hppa1.1-stratus-vos - exit ;; - mc68*:A/UX:*:*) - echo m68k-apple-aux"$UNAME_RELEASE" - exit ;; - news*:NEWS-OS:6*:*) - echo mips-sony-newsos6 - exit ;; - R[34]000:*System_V*:*:* | R4000:UNIX_SYSV:*:* | R*000:UNIX_SV:*:*) - if [ -d /usr/nec ]; then - echo mips-nec-sysv"$UNAME_RELEASE" - else - echo mips-unknown-sysv"$UNAME_RELEASE" - fi - exit ;; - BeBox:BeOS:*:*) # BeOS running on hardware made by Be, PPC only. - echo powerpc-be-beos - exit ;; - BeMac:BeOS:*:*) # BeOS running on Mac or Mac clone, PPC only. - echo powerpc-apple-beos - exit ;; - BePC:BeOS:*:*) # BeOS running on Intel PC compatible. - echo i586-pc-beos - exit ;; - BePC:Haiku:*:*) # Haiku running on Intel PC compatible. - echo i586-pc-haiku - exit ;; - x86_64:Haiku:*:*) - echo x86_64-unknown-haiku - exit ;; - SX-4:SUPER-UX:*:*) - echo sx4-nec-superux"$UNAME_RELEASE" - exit ;; - SX-5:SUPER-UX:*:*) - echo sx5-nec-superux"$UNAME_RELEASE" - exit ;; - SX-6:SUPER-UX:*:*) - echo sx6-nec-superux"$UNAME_RELEASE" - exit ;; - SX-7:SUPER-UX:*:*) - echo sx7-nec-superux"$UNAME_RELEASE" - exit ;; - SX-8:SUPER-UX:*:*) - echo sx8-nec-superux"$UNAME_RELEASE" - exit ;; - SX-8R:SUPER-UX:*:*) - echo sx8r-nec-superux"$UNAME_RELEASE" - exit ;; - SX-ACE:SUPER-UX:*:*) - echo sxace-nec-superux"$UNAME_RELEASE" - exit ;; - Power*:Rhapsody:*:*) - echo powerpc-apple-rhapsody"$UNAME_RELEASE" - exit ;; - *:Rhapsody:*:*) - echo "$UNAME_MACHINE"-apple-rhapsody"$UNAME_RELEASE" - exit ;; - *:Darwin:*:*) - UNAME_PROCESSOR=`uname -p` || UNAME_PROCESSOR=unknown - set_cc_for_build - if test "$UNAME_PROCESSOR" = unknown ; then - UNAME_PROCESSOR=powerpc - fi - if test "`echo "$UNAME_RELEASE" | sed -e 's/\..*//'`" -le 10 ; then - if [ "$CC_FOR_BUILD" != no_compiler_found ]; then - if (echo '#ifdef __LP64__'; echo IS_64BIT_ARCH; echo '#endif') | \ - (CCOPTS="" $CC_FOR_BUILD -E - 2>/dev/null) | \ - grep IS_64BIT_ARCH >/dev/null - then - case $UNAME_PROCESSOR in - i386) UNAME_PROCESSOR=x86_64 ;; - powerpc) UNAME_PROCESSOR=powerpc64 ;; - esac - fi - # On 10.4-10.6 one might compile for PowerPC via gcc -arch ppc - if (echo '#ifdef __POWERPC__'; echo IS_PPC; echo '#endif') | \ - (CCOPTS="" $CC_FOR_BUILD -E - 2>/dev/null) | \ - grep IS_PPC >/dev/null - then - UNAME_PROCESSOR=powerpc - fi - fi - elif test "$UNAME_PROCESSOR" = i386 ; then - # Avoid executing cc on OS X 10.9, as it ships with a stub - # that puts up a graphical alert prompting to install - # developer tools. Any system running Mac OS X 10.7 or - # later (Darwin 11 and later) is required to have a 64-bit - # processor. This is not true of the ARM version of Darwin - # that Apple uses in portable devices. - UNAME_PROCESSOR=x86_64 - fi - echo "$UNAME_PROCESSOR"-apple-darwin"$UNAME_RELEASE" - exit ;; - *:procnto*:*:* | *:QNX:[0123456789]*:*) - UNAME_PROCESSOR=`uname -p` - if test "$UNAME_PROCESSOR" = x86; then - UNAME_PROCESSOR=i386 - UNAME_MACHINE=pc - fi - echo "$UNAME_PROCESSOR"-"$UNAME_MACHINE"-nto-qnx"$UNAME_RELEASE" - exit ;; - *:QNX:*:4*) - echo i386-pc-qnx - exit ;; - NEO-*:NONSTOP_KERNEL:*:*) - echo neo-tandem-nsk"$UNAME_RELEASE" - exit ;; - NSE-*:NONSTOP_KERNEL:*:*) - echo nse-tandem-nsk"$UNAME_RELEASE" - exit ;; - NSR-*:NONSTOP_KERNEL:*:*) - echo nsr-tandem-nsk"$UNAME_RELEASE" - exit ;; - NSV-*:NONSTOP_KERNEL:*:*) - echo nsv-tandem-nsk"$UNAME_RELEASE" - exit ;; - NSX-*:NONSTOP_KERNEL:*:*) - echo nsx-tandem-nsk"$UNAME_RELEASE" - exit ;; - *:NonStop-UX:*:*) - echo mips-compaq-nonstopux - exit ;; - BS2000:POSIX*:*:*) - echo bs2000-siemens-sysv - exit ;; - DS/*:UNIX_System_V:*:*) - echo "$UNAME_MACHINE"-"$UNAME_SYSTEM"-"$UNAME_RELEASE" - exit ;; - *:Plan9:*:*) - # "uname -m" is not consistent, so use $cputype instead. 386 - # is converted to i386 for consistency with other x86 - # operating systems. - # shellcheck disable=SC2154 - if test "$cputype" = 386; then - UNAME_MACHINE=i386 - else - UNAME_MACHINE="$cputype" - fi - echo "$UNAME_MACHINE"-unknown-plan9 - exit ;; - *:TOPS-10:*:*) - echo pdp10-unknown-tops10 - exit ;; - *:TENEX:*:*) - echo pdp10-unknown-tenex - exit ;; - KS10:TOPS-20:*:* | KL10:TOPS-20:*:* | TYPE4:TOPS-20:*:*) - echo pdp10-dec-tops20 - exit ;; - XKL-1:TOPS-20:*:* | TYPE5:TOPS-20:*:*) - echo pdp10-xkl-tops20 - exit ;; - *:TOPS-20:*:*) - echo pdp10-unknown-tops20 - exit ;; - *:ITS:*:*) - echo pdp10-unknown-its - exit ;; - SEI:*:*:SEIUX) - echo mips-sei-seiux"$UNAME_RELEASE" - exit ;; - *:DragonFly:*:*) - echo "$UNAME_MACHINE"-unknown-dragonfly"`echo "$UNAME_RELEASE"|sed -e 's/[-(].*//'`" - exit ;; - *:*VMS:*:*) - UNAME_MACHINE=`(uname -p) 2>/dev/null` - case "$UNAME_MACHINE" in - A*) echo alpha-dec-vms ; exit ;; - I*) echo ia64-dec-vms ; exit ;; - V*) echo vax-dec-vms ; exit ;; - esac ;; - *:XENIX:*:SysV) - echo i386-pc-xenix - exit ;; - i*86:skyos:*:*) - echo "$UNAME_MACHINE"-pc-skyos"`echo "$UNAME_RELEASE" | sed -e 's/ .*$//'`" - exit ;; - i*86:rdos:*:*) - echo "$UNAME_MACHINE"-pc-rdos - exit ;; - i*86:AROS:*:*) - echo "$UNAME_MACHINE"-pc-aros - exit ;; - x86_64:VMkernel:*:*) - echo "$UNAME_MACHINE"-unknown-esx - exit ;; - amd64:Isilon\ OneFS:*:*) - echo x86_64-unknown-onefs - exit ;; - *:Unleashed:*:*) - echo "$UNAME_MACHINE"-unknown-unleashed"$UNAME_RELEASE" - exit ;; -esac - -# No uname command or uname output not recognized. -set_cc_for_build -cat > "$dummy.c" < -#include -#endif -main () -{ -#if defined (sony) -#if defined (MIPSEB) - /* BFD wants "bsd" instead of "newsos". Perhaps BFD should be changed, - I don't know.... */ - printf ("mips-sony-bsd\n"); exit (0); -#else -#include - printf ("m68k-sony-newsos%s\n", -#ifdef NEWSOS4 - "4" -#else - "" -#endif - ); exit (0); -#endif -#endif - -#if defined (NeXT) -#if !defined (__ARCHITECTURE__) -#define __ARCHITECTURE__ "m68k" -#endif - int version; - version=`(hostinfo | sed -n 's/.*NeXT Mach \([0-9]*\).*/\1/p') 2>/dev/null`; - if (version < 4) - printf ("%s-next-nextstep%d\n", __ARCHITECTURE__, version); - else - printf ("%s-next-openstep%d\n", __ARCHITECTURE__, version); - exit (0); -#endif - -#if defined (MULTIMAX) || defined (n16) -#if defined (UMAXV) - printf ("ns32k-encore-sysv\n"); exit (0); -#else -#if defined (CMU) - printf ("ns32k-encore-mach\n"); exit (0); -#else - printf ("ns32k-encore-bsd\n"); exit (0); -#endif -#endif -#endif - -#if defined (__386BSD__) - printf ("i386-pc-bsd\n"); exit (0); -#endif - -#if defined (sequent) -#if defined (i386) - printf ("i386-sequent-dynix\n"); exit (0); -#endif -#if defined (ns32000) - printf ("ns32k-sequent-dynix\n"); exit (0); -#endif -#endif - -#if defined (_SEQUENT_) - struct utsname un; - - uname(&un); - if (strncmp(un.version, "V2", 2) == 0) { - printf ("i386-sequent-ptx2\n"); exit (0); - } - if (strncmp(un.version, "V1", 2) == 0) { /* XXX is V1 correct? */ - printf ("i386-sequent-ptx1\n"); exit (0); - } - printf ("i386-sequent-ptx\n"); exit (0); -#endif - -#if defined (vax) -#if !defined (ultrix) -#include -#if defined (BSD) -#if BSD == 43 - printf ("vax-dec-bsd4.3\n"); exit (0); -#else -#if BSD == 199006 - printf ("vax-dec-bsd4.3reno\n"); exit (0); -#else - printf ("vax-dec-bsd\n"); exit (0); -#endif -#endif -#else - printf ("vax-dec-bsd\n"); exit (0); -#endif -#else - printf ("vax-dec-ultrix\n"); exit (0); -#endif -#endif -#if defined(ultrix) || defined(_ultrix) || defined(__ultrix) || defined(__ultrix__) -#if defined(mips) || defined(__mips) || defined(__mips__) || defined(MIPS) || defined(__MIPS__) -#include -#if defined(_SIZE_T_) /* >= ULTRIX4 */ - printf ("mips-dec-ultrix4\n"); exit (0); -#else -#if defined(ULTRIX3) || defined(ultrix3) || defined(SIGLOST) - printf ("mips-dec-ultrix3\n"); exit (0); -#endif -#endif -#endif -#endif - -#if defined (alliant) && defined (i860) - printf ("i860-alliant-bsd\n"); exit (0); -#endif - - exit (1); -} -EOF - -$CC_FOR_BUILD -o "$dummy" "$dummy.c" 2>/dev/null && SYSTEM_NAME=`$dummy` && - { echo "$SYSTEM_NAME"; exit; } - -# Apollos put the system type in the environment. -test -d /usr/apollo && { echo "$ISP-apollo-$SYSTYPE"; exit; } - -echo "$0: unable to guess system type" >&2 - -case "$UNAME_MACHINE:$UNAME_SYSTEM" in - mips:Linux | mips64:Linux) - # If we got here on MIPS GNU/Linux, output extra information. - cat >&2 <&2 </dev/null || echo unknown` -uname -r = `(uname -r) 2>/dev/null || echo unknown` -uname -s = `(uname -s) 2>/dev/null || echo unknown` -uname -v = `(uname -v) 2>/dev/null || echo unknown` - -/usr/bin/uname -p = `(/usr/bin/uname -p) 2>/dev/null` -/bin/uname -X = `(/bin/uname -X) 2>/dev/null` - -hostinfo = `(hostinfo) 2>/dev/null` -/bin/universe = `(/bin/universe) 2>/dev/null` -/usr/bin/arch -k = `(/usr/bin/arch -k) 2>/dev/null` -/bin/arch = `(/bin/arch) 2>/dev/null` -/usr/bin/oslevel = `(/usr/bin/oslevel) 2>/dev/null` -/usr/convex/getsysinfo = `(/usr/convex/getsysinfo) 2>/dev/null` - -UNAME_MACHINE = "$UNAME_MACHINE" -UNAME_RELEASE = "$UNAME_RELEASE" -UNAME_SYSTEM = "$UNAME_SYSTEM" -UNAME_VERSION = "$UNAME_VERSION" -EOF - -exit 1 - -# Local variables: -# eval: (add-hook 'before-save-hook 'time-stamp) -# time-stamp-start: "timestamp='" -# time-stamp-format: "%:y-%02m-%02d" -# time-stamp-end: "'" -# End: diff -Nru gnucobol-4.0~early~20200606/build_aux/config.rpath gnucobol-5/build_aux/config.rpath --- gnucobol-4.0~early~20200606/build_aux/config.rpath 2020-06-06 20:52:02.000000000 +0000 +++ gnucobol-5/build_aux/config.rpath 1970-01-01 00:00:00.000000000 +0000 @@ -1,684 +0,0 @@ -#! /bin/sh -# Output a system dependent set of variables, describing how to set the -# run time search path of shared libraries in an executable. -# -# Copyright 1996-2016 Free Software Foundation, Inc. -# Taken from GNU libtool, 2001 -# Originally by Gordon Matzigkeit , 1996 -# -# This file is free software; the Free Software Foundation gives -# unlimited permission to copy and/or distribute it, with or without -# modifications, as long as this notice is preserved. -# -# The first argument passed to this file is the canonical host specification, -# CPU_TYPE-MANUFACTURER-OPERATING_SYSTEM -# or -# CPU_TYPE-MANUFACTURER-KERNEL-OPERATING_SYSTEM -# The environment variables CC, GCC, LDFLAGS, LD, with_gnu_ld -# should be set by the caller. -# -# The set of defined variables is at the end of this script. - -# Known limitations: -# - On IRIX 6.5 with CC="cc", the run time search patch must not be longer -# than 256 bytes, otherwise the compiler driver will dump core. The only -# known workaround is to choose shorter directory names for the build -# directory and/or the installation directory. - -# All known linkers require a '.a' archive for static linking (except MSVC, -# which needs '.lib'). -libext=a -shrext=.so - -host="$1" -host_cpu=`echo "$host" | sed 's/^\([^-]*\)-\([^-]*\)-\(.*\)$/\1/'` -host_vendor=`echo "$host" | sed 's/^\([^-]*\)-\([^-]*\)-\(.*\)$/\2/'` -host_os=`echo "$host" | sed 's/^\([^-]*\)-\([^-]*\)-\(.*\)$/\3/'` - -# Code taken from libtool.m4's _LT_CC_BASENAME. - -for cc_temp in $CC""; do - case $cc_temp in - compile | *[\\/]compile | ccache | *[\\/]ccache ) ;; - distcc | *[\\/]distcc | purify | *[\\/]purify ) ;; - \-*) ;; - *) break;; - esac -done -cc_basename=`echo "$cc_temp" | sed -e 's%^.*/%%'` - -# Code taken from libtool.m4's _LT_COMPILER_PIC. - -wl= -if test "$GCC" = yes; then - wl='-Wl,' -else - case "$host_os" in - aix*) - wl='-Wl,' - ;; - mingw* | cygwin* | pw32* | os2* | cegcc*) - ;; - hpux9* | hpux10* | hpux11*) - wl='-Wl,' - ;; - irix5* | irix6* | nonstopux*) - wl='-Wl,' - ;; - linux* | k*bsd*-gnu | kopensolaris*-gnu) - case $cc_basename in - ecc*) - wl='-Wl,' - ;; - icc* | ifort*) - wl='-Wl,' - ;; - lf95*) - wl='-Wl,' - ;; - nagfor*) - wl='-Wl,-Wl,,' - ;; - pgcc* | pgf77* | pgf90* | pgf95* | pgfortran*) - wl='-Wl,' - ;; - ccc*) - wl='-Wl,' - ;; - xl* | bgxl* | bgf* | mpixl*) - wl='-Wl,' - ;; - como) - wl='-lopt=' - ;; - *) - case `$CC -V 2>&1 | sed 5q` in - *Sun\ F* | *Sun*Fortran*) - wl= - ;; - *Sun\ C*) - wl='-Wl,' - ;; - esac - ;; - esac - ;; - newsos6) - ;; - *nto* | *qnx*) - ;; - osf3* | osf4* | osf5*) - wl='-Wl,' - ;; - rdos*) - ;; - solaris*) - case $cc_basename in - f77* | f90* | f95* | sunf77* | sunf90* | sunf95*) - wl='-Qoption ld ' - ;; - *) - wl='-Wl,' - ;; - esac - ;; - sunos4*) - wl='-Qoption ld ' - ;; - sysv4 | sysv4.2uw2* | sysv4.3*) - wl='-Wl,' - ;; - sysv4*MP*) - ;; - sysv5* | unixware* | sco3.2v5* | sco5v6* | OpenUNIX*) - wl='-Wl,' - ;; - unicos*) - wl='-Wl,' - ;; - uts4*) - ;; - esac -fi - -# Code taken from libtool.m4's _LT_LINKER_SHLIBS. - -hardcode_libdir_flag_spec= -hardcode_libdir_separator= -hardcode_direct=no -hardcode_minus_L=no - -case "$host_os" in - cygwin* | mingw* | pw32* | cegcc*) - # FIXME: the MSVC++ port hasn't been tested in a loooong time - # When not using gcc, we currently assume that we are using - # Microsoft Visual C++. - if test "$GCC" != yes; then - with_gnu_ld=no - fi - ;; - interix*) - # we just hope/assume this is gcc and not c89 (= MSVC++) - with_gnu_ld=yes - ;; - openbsd*) - with_gnu_ld=no - ;; -esac - -ld_shlibs=yes -if test "$with_gnu_ld" = yes; then - # Set some defaults for GNU ld with shared library support. These - # are reset later if shared libraries are not supported. Putting them - # here allows them to be overridden if necessary. - # Unlike libtool, we use -rpath here, not --rpath, since the documented - # option of GNU ld is called -rpath, not --rpath. - hardcode_libdir_flag_spec='${wl}-rpath ${wl}$libdir' - case "$host_os" in - aix[3-9]*) - # On AIX/PPC, the GNU linker is very broken - if test "$host_cpu" != ia64; then - ld_shlibs=no - fi - ;; - amigaos*) - case "$host_cpu" in - powerpc) - ;; - m68k) - hardcode_libdir_flag_spec='-L$libdir' - hardcode_minus_L=yes - ;; - esac - ;; - beos*) - if $LD --help 2>&1 | grep ': supported targets:.* elf' > /dev/null; then - : - else - ld_shlibs=no - fi - ;; - cygwin* | mingw* | pw32* | cegcc*) - # hardcode_libdir_flag_spec is actually meaningless, as there is - # no search path for DLLs. - hardcode_libdir_flag_spec='-L$libdir' - if $LD --help 2>&1 | grep 'auto-import' > /dev/null; then - : - else - ld_shlibs=no - fi - ;; - haiku*) - ;; - interix[3-9]*) - hardcode_direct=no - hardcode_libdir_flag_spec='${wl}-rpath,$libdir' - ;; - gnu* | linux* | tpf* | k*bsd*-gnu | kopensolaris*-gnu) - if $LD --help 2>&1 | grep ': supported targets:.* elf' > /dev/null; then - : - else - ld_shlibs=no - fi - ;; - netbsd*) - ;; - solaris*) - if $LD -v 2>&1 | grep 'BFD 2\.8' > /dev/null; then - ld_shlibs=no - elif $LD --help 2>&1 | grep ': supported targets:.* elf' > /dev/null; then - : - else - ld_shlibs=no - fi - ;; - sysv5* | sco3.2v5* | sco5v6* | unixware* | OpenUNIX*) - case `$LD -v 2>&1` in - *\ [01].* | *\ 2.[0-9].* | *\ 2.1[0-5].*) - ld_shlibs=no - ;; - *) - if $LD --help 2>&1 | grep ': supported targets:.* elf' > /dev/null; then - hardcode_libdir_flag_spec='`test -z "$SCOABSPATH" && echo ${wl}-rpath,$libdir`' - else - ld_shlibs=no - fi - ;; - esac - ;; - sunos4*) - hardcode_direct=yes - ;; - *) - if $LD --help 2>&1 | grep ': supported targets:.* elf' > /dev/null; then - : - else - ld_shlibs=no - fi - ;; - esac - if test "$ld_shlibs" = no; then - hardcode_libdir_flag_spec= - fi -else - case "$host_os" in - aix3*) - # Note: this linker hardcodes the directories in LIBPATH if there - # are no directories specified by -L. - hardcode_minus_L=yes - if test "$GCC" = yes; then - # Neither direct hardcoding nor static linking is supported with a - # broken collect2. - hardcode_direct=unsupported - fi - ;; - aix[4-9]*) - if test "$host_cpu" = ia64; then - # On IA64, the linker does run time linking by default, so we don't - # have to do anything special. - aix_use_runtimelinking=no - else - aix_use_runtimelinking=no - # Test if we are trying to use run time linking or normal - # AIX style linking. If -brtl is somewhere in LDFLAGS, we - # need to do runtime linking. - case $host_os in aix4.[23]|aix4.[23].*|aix[5-9]*) - for ld_flag in $LDFLAGS; do - if (test $ld_flag = "-brtl" || test $ld_flag = "-Wl,-brtl"); then - aix_use_runtimelinking=yes - break - fi - done - ;; - esac - fi - hardcode_direct=yes - hardcode_libdir_separator=':' - if test "$GCC" = yes; then - case $host_os in aix4.[012]|aix4.[012].*) - collect2name=`${CC} -print-prog-name=collect2` - if test -f "$collect2name" && \ - strings "$collect2name" | grep resolve_lib_name >/dev/null - then - # We have reworked collect2 - : - else - # We have old collect2 - hardcode_direct=unsupported - hardcode_minus_L=yes - hardcode_libdir_flag_spec='-L$libdir' - hardcode_libdir_separator= - fi - ;; - esac - fi - # Begin _LT_AC_SYS_LIBPATH_AIX. - echo 'int main () { return 0; }' > conftest.c - ${CC} ${LDFLAGS} conftest.c -o conftest - aix_libpath=`dump -H conftest 2>/dev/null | sed -n -e '/Import File Strings/,/^$/ { /^0/ { s/^0 *\(.*\)$/\1/; p; } -}'` - if test -z "$aix_libpath"; then - aix_libpath=`dump -HX64 conftest 2>/dev/null | sed -n -e '/Import File Strings/,/^$/ { /^0/ { s/^0 *\(.*\)$/\1/; p; } -}'` - fi - if test -z "$aix_libpath"; then - aix_libpath="/usr/lib:/lib" - fi - rm -f conftest.c conftest - # End _LT_AC_SYS_LIBPATH_AIX. - if test "$aix_use_runtimelinking" = yes; then - hardcode_libdir_flag_spec='${wl}-blibpath:$libdir:'"$aix_libpath" - else - if test "$host_cpu" = ia64; then - hardcode_libdir_flag_spec='${wl}-R $libdir:/usr/lib:/lib' - else - hardcode_libdir_flag_spec='${wl}-blibpath:$libdir:'"$aix_libpath" - fi - fi - ;; - amigaos*) - case "$host_cpu" in - powerpc) - ;; - m68k) - hardcode_libdir_flag_spec='-L$libdir' - hardcode_minus_L=yes - ;; - esac - ;; - bsdi[45]*) - ;; - cygwin* | mingw* | pw32* | cegcc*) - # When not using gcc, we currently assume that we are using - # Microsoft Visual C++. - # hardcode_libdir_flag_spec is actually meaningless, as there is - # no search path for DLLs. - hardcode_libdir_flag_spec=' ' - libext=lib - ;; - darwin* | rhapsody*) - hardcode_direct=no - if { case $cc_basename in ifort*) true;; *) test "$GCC" = yes;; esac; }; then - : - else - ld_shlibs=no - fi - ;; - dgux*) - hardcode_libdir_flag_spec='-L$libdir' - ;; - freebsd2.[01]*) - hardcode_direct=yes - hardcode_minus_L=yes - ;; - freebsd* | dragonfly*) - hardcode_libdir_flag_spec='-R$libdir' - hardcode_direct=yes - ;; - hpux9*) - hardcode_libdir_flag_spec='${wl}+b ${wl}$libdir' - hardcode_libdir_separator=: - hardcode_direct=yes - # hardcode_minus_L: Not really in the search PATH, - # but as the default location of the library. - hardcode_minus_L=yes - ;; - hpux10*) - if test "$with_gnu_ld" = no; then - hardcode_libdir_flag_spec='${wl}+b ${wl}$libdir' - hardcode_libdir_separator=: - hardcode_direct=yes - # hardcode_minus_L: Not really in the search PATH, - # but as the default location of the library. - hardcode_minus_L=yes - fi - ;; - hpux11*) - if test "$with_gnu_ld" = no; then - hardcode_libdir_flag_spec='${wl}+b ${wl}$libdir' - hardcode_libdir_separator=: - case $host_cpu in - hppa*64*|ia64*) - hardcode_direct=no - ;; - *) - hardcode_direct=yes - # hardcode_minus_L: Not really in the search PATH, - # but as the default location of the library. - hardcode_minus_L=yes - ;; - esac - fi - ;; - irix5* | irix6* | nonstopux*) - hardcode_libdir_flag_spec='${wl}-rpath ${wl}$libdir' - hardcode_libdir_separator=: - ;; - netbsd*) - hardcode_libdir_flag_spec='-R$libdir' - hardcode_direct=yes - ;; - newsos6) - hardcode_direct=yes - hardcode_libdir_flag_spec='${wl}-rpath ${wl}$libdir' - hardcode_libdir_separator=: - ;; - *nto* | *qnx*) - ;; - openbsd*) - if test -f /usr/libexec/ld.so; then - hardcode_direct=yes - if test -z "`echo __ELF__ | $CC -E - | grep __ELF__`" || test "$host_os-$host_cpu" = "openbsd2.8-powerpc"; then - hardcode_libdir_flag_spec='${wl}-rpath,$libdir' - else - case "$host_os" in - openbsd[01].* | openbsd2.[0-7] | openbsd2.[0-7].*) - hardcode_libdir_flag_spec='-R$libdir' - ;; - *) - hardcode_libdir_flag_spec='${wl}-rpath,$libdir' - ;; - esac - fi - else - ld_shlibs=no - fi - ;; - os2*) - hardcode_libdir_flag_spec='-L$libdir' - hardcode_minus_L=yes - ;; - osf3*) - hardcode_libdir_flag_spec='${wl}-rpath ${wl}$libdir' - hardcode_libdir_separator=: - ;; - osf4* | osf5*) - if test "$GCC" = yes; then - hardcode_libdir_flag_spec='${wl}-rpath ${wl}$libdir' - else - # Both cc and cxx compiler support -rpath directly - hardcode_libdir_flag_spec='-rpath $libdir' - fi - hardcode_libdir_separator=: - ;; - solaris*) - hardcode_libdir_flag_spec='-R$libdir' - ;; - sunos4*) - hardcode_libdir_flag_spec='-L$libdir' - hardcode_direct=yes - hardcode_minus_L=yes - ;; - sysv4) - case $host_vendor in - sni) - hardcode_direct=yes # is this really true??? - ;; - siemens) - hardcode_direct=no - ;; - motorola) - hardcode_direct=no #Motorola manual says yes, but my tests say they lie - ;; - esac - ;; - sysv4.3*) - ;; - sysv4*MP*) - if test -d /usr/nec; then - ld_shlibs=yes - fi - ;; - sysv4*uw2* | sysv5OpenUNIX* | sysv5UnixWare7.[01].[10]* | unixware7* | sco3.2v5.0.[024]*) - ;; - sysv5* | sco3.2v5* | sco5v6*) - hardcode_libdir_flag_spec='`test -z "$SCOABSPATH" && echo ${wl}-R,$libdir`' - hardcode_libdir_separator=':' - ;; - uts4*) - hardcode_libdir_flag_spec='-L$libdir' - ;; - *) - ld_shlibs=no - ;; - esac -fi - -# Check dynamic linker characteristics -# Code taken from libtool.m4's _LT_SYS_DYNAMIC_LINKER. -# Unlike libtool.m4, here we don't care about _all_ names of the library, but -# only about the one the linker finds when passed -lNAME. This is the last -# element of library_names_spec in libtool.m4, or possibly two of them if the -# linker has special search rules. -library_names_spec= # the last element of library_names_spec in libtool.m4 -libname_spec='lib$name' -case "$host_os" in - aix3*) - library_names_spec='$libname.a' - ;; - aix[4-9]*) - library_names_spec='$libname$shrext' - ;; - amigaos*) - case "$host_cpu" in - powerpc*) - library_names_spec='$libname$shrext' ;; - m68k) - library_names_spec='$libname.a' ;; - esac - ;; - beos*) - library_names_spec='$libname$shrext' - ;; - bsdi[45]*) - library_names_spec='$libname$shrext' - ;; - cygwin* | mingw* | pw32* | cegcc*) - shrext=.dll - library_names_spec='$libname.dll.a $libname.lib' - ;; - darwin* | rhapsody*) - shrext=.dylib - library_names_spec='$libname$shrext' - ;; - dgux*) - library_names_spec='$libname$shrext' - ;; - freebsd[23].*) - library_names_spec='$libname$shrext$versuffix' - ;; - freebsd* | dragonfly*) - library_names_spec='$libname$shrext' - ;; - gnu*) - library_names_spec='$libname$shrext' - ;; - haiku*) - library_names_spec='$libname$shrext' - ;; - hpux9* | hpux10* | hpux11*) - case $host_cpu in - ia64*) - shrext=.so - ;; - hppa*64*) - shrext=.sl - ;; - *) - shrext=.sl - ;; - esac - library_names_spec='$libname$shrext' - ;; - interix[3-9]*) - library_names_spec='$libname$shrext' - ;; - irix5* | irix6* | nonstopux*) - library_names_spec='$libname$shrext' - case "$host_os" in - irix5* | nonstopux*) - libsuff= shlibsuff= - ;; - *) - case $LD in - *-32|*"-32 "|*-melf32bsmip|*"-melf32bsmip ") libsuff= shlibsuff= ;; - *-n32|*"-n32 "|*-melf32bmipn32|*"-melf32bmipn32 ") libsuff=32 shlibsuff=N32 ;; - *-64|*"-64 "|*-melf64bmip|*"-melf64bmip ") libsuff=64 shlibsuff=64 ;; - *) libsuff= shlibsuff= ;; - esac - ;; - esac - ;; - linux*oldld* | linux*aout* | linux*coff*) - ;; - linux* | k*bsd*-gnu | kopensolaris*-gnu) - library_names_spec='$libname$shrext' - ;; - knetbsd*-gnu) - library_names_spec='$libname$shrext' - ;; - netbsd*) - library_names_spec='$libname$shrext' - ;; - newsos6) - library_names_spec='$libname$shrext' - ;; - *nto* | *qnx*) - library_names_spec='$libname$shrext' - ;; - openbsd*) - library_names_spec='$libname$shrext$versuffix' - ;; - os2*) - libname_spec='$name' - shrext=.dll - library_names_spec='$libname.a' - ;; - osf3* | osf4* | osf5*) - library_names_spec='$libname$shrext' - ;; - rdos*) - ;; - solaris*) - library_names_spec='$libname$shrext' - ;; - sunos4*) - library_names_spec='$libname$shrext$versuffix' - ;; - sysv4 | sysv4.3*) - library_names_spec='$libname$shrext' - ;; - sysv4*MP*) - library_names_spec='$libname$shrext' - ;; - sysv5* | sco3.2v5* | sco5v6* | unixware* | OpenUNIX* | sysv4*uw2*) - library_names_spec='$libname$shrext' - ;; - tpf*) - library_names_spec='$libname$shrext' - ;; - uts4*) - library_names_spec='$libname$shrext' - ;; -esac - -sed_quote_subst='s/\(["`$\\]\)/\\\1/g' -escaped_wl=`echo "X$wl" | sed -e 's/^X//' -e "$sed_quote_subst"` -shlibext=`echo "$shrext" | sed -e 's,^\.,,'` -escaped_libname_spec=`echo "X$libname_spec" | sed -e 's/^X//' -e "$sed_quote_subst"` -escaped_library_names_spec=`echo "X$library_names_spec" | sed -e 's/^X//' -e "$sed_quote_subst"` -escaped_hardcode_libdir_flag_spec=`echo "X$hardcode_libdir_flag_spec" | sed -e 's/^X//' -e "$sed_quote_subst"` - -LC_ALL=C sed -e 's/^\([a-zA-Z0-9_]*\)=/acl_cv_\1=/' <. -# -# As a special exception to the GNU General Public License, if you -# distribute this file as part of a program that contains a -# configuration script generated by Autoconf, you may include it under -# the same distribution terms that you use for the rest of that -# program. This Exception is an additional permission under section 7 -# of the GNU General Public License, version 3 ("GPLv3"). - - -# Please send patches to . -# -# Configuration subroutine to validate and canonicalize a configuration type. -# Supply the specified configuration type as an argument. -# If it is invalid, we print an error message on stderr and exit with code 1. -# Otherwise, we print the canonical config type on stdout and succeed. - -# You can get the latest version of this script from: -# https://git.savannah.gnu.org/gitweb/?p=config.git;a=blob_plain;f=config.sub - -# This file is supposed to be the same for all GNU packages -# and recognize all the CPU types, system types and aliases -# that are meaningful with *any* GNU software. -# Each package is responsible for reporting which valid configurations -# it does not support. The user should be able to distinguish -# a failure to support a valid configuration from a meaningless -# configuration. - -# The goal of this file is to map all the various variations of a given -# machine specification into a single specification in the form: -# CPU_TYPE-MANUFACTURER-OPERATING_SYSTEM -# or in some cases, the newer four-part form: -# CPU_TYPE-MANUFACTURER-KERNEL-OPERATING_SYSTEM -# It is wrong to echo any other type of specification. - -me=`echo "$0" | sed -e 's,.*/,,'` - -usage="\ -Usage: $0 [OPTION] CPU-MFR-OPSYS or ALIAS - -Canonicalize a configuration name. - -Options: - -h, --help print this help, then exit - -t, --time-stamp print date of last modification, then exit - -v, --version print version number, then exit - -Report bugs and patches to ." - -version="\ -GNU config.sub ($timestamp) - -Copyright 1992-2019 Free Software Foundation, Inc. - -This is free software; see the source for copying conditions. There is NO -warranty; not even for MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE." - -help=" -Try \`$me --help' for more information." - -# Parse command line -while test $# -gt 0 ; do - case $1 in - --time-stamp | --time* | -t ) - echo "$timestamp" ; exit ;; - --version | -v ) - echo "$version" ; exit ;; - --help | --h* | -h ) - echo "$usage"; exit ;; - -- ) # Stop option processing - shift; break ;; - - ) # Use stdin as input. - break ;; - -* ) - echo "$me: invalid option $1$help" >&2 - exit 1 ;; - - *local*) - # First pass through any local machine types. - echo "$1" - exit ;; - - * ) - break ;; - esac -done - -case $# in - 0) echo "$me: missing argument$help" >&2 - exit 1;; - 1) ;; - *) echo "$me: too many arguments$help" >&2 - exit 1;; -esac - -# Split fields of configuration type -# shellcheck disable=SC2162 -IFS="-" read field1 field2 field3 field4 <&2 - exit 1 - ;; - *-*-*-*) - basic_machine=$field1-$field2 - os=$field3-$field4 - ;; - *-*-*) - # Ambiguous whether COMPANY is present, or skipped and KERNEL-OS is two - # parts - maybe_os=$field2-$field3 - case $maybe_os in - nto-qnx* | linux-gnu* | linux-android* | linux-dietlibc \ - | linux-newlib* | linux-musl* | linux-uclibc* | uclinux-uclibc* \ - | uclinux-gnu* | kfreebsd*-gnu* | knetbsd*-gnu* | netbsd*-gnu* \ - | netbsd*-eabi* | kopensolaris*-gnu* | cloudabi*-eabi* \ - | storm-chaos* | os2-emx* | rtmk-nova*) - basic_machine=$field1 - os=$maybe_os - ;; - android-linux) - basic_machine=$field1-unknown - os=linux-android - ;; - *) - basic_machine=$field1-$field2 - os=$field3 - ;; - esac - ;; - *-*) - # A lone config we happen to match not fitting any pattern - case $field1-$field2 in - decstation-3100) - basic_machine=mips-dec - os= - ;; - *-*) - # Second component is usually, but not always the OS - case $field2 in - # Prevent following clause from handling this valid os - sun*os*) - basic_machine=$field1 - os=$field2 - ;; - # Manufacturers - dec* | mips* | sequent* | encore* | pc533* | sgi* | sony* \ - | att* | 7300* | 3300* | delta* | motorola* | sun[234]* \ - | unicom* | ibm* | next | hp | isi* | apollo | altos* \ - | convergent* | ncr* | news | 32* | 3600* | 3100* \ - | hitachi* | c[123]* | convex* | sun | crds | omron* | dg \ - | ultra | tti* | harris | dolphin | highlevel | gould \ - | cbm | ns | masscomp | apple | axis | knuth | cray \ - | microblaze* | sim | cisco \ - | oki | wec | wrs | winbond) - basic_machine=$field1-$field2 - os= - ;; - *) - basic_machine=$field1 - os=$field2 - ;; - esac - ;; - esac - ;; - *) - # Convert single-component short-hands not valid as part of - # multi-component configurations. - case $field1 in - 386bsd) - basic_machine=i386-pc - os=bsd - ;; - a29khif) - basic_machine=a29k-amd - os=udi - ;; - adobe68k) - basic_machine=m68010-adobe - os=scout - ;; - alliant) - basic_machine=fx80-alliant - os= - ;; - altos | altos3068) - basic_machine=m68k-altos - os= - ;; - am29k) - basic_machine=a29k-none - os=bsd - ;; - amdahl) - basic_machine=580-amdahl - os=sysv - ;; - amiga) - basic_machine=m68k-unknown - os= - ;; - amigaos | amigados) - basic_machine=m68k-unknown - os=amigaos - ;; - amigaunix | amix) - basic_machine=m68k-unknown - os=sysv4 - ;; - apollo68) - basic_machine=m68k-apollo - os=sysv - ;; - apollo68bsd) - basic_machine=m68k-apollo - os=bsd - ;; - aros) - basic_machine=i386-pc - os=aros - ;; - aux) - basic_machine=m68k-apple - os=aux - ;; - balance) - basic_machine=ns32k-sequent - os=dynix - ;; - blackfin) - basic_machine=bfin-unknown - os=linux - ;; - cegcc) - basic_machine=arm-unknown - os=cegcc - ;; - convex-c1) - basic_machine=c1-convex - os=bsd - ;; - convex-c2) - basic_machine=c2-convex - os=bsd - ;; - convex-c32) - basic_machine=c32-convex - os=bsd - ;; - convex-c34) - basic_machine=c34-convex - os=bsd - ;; - convex-c38) - basic_machine=c38-convex - os=bsd - ;; - cray) - basic_machine=j90-cray - os=unicos - ;; - crds | unos) - basic_machine=m68k-crds - os= - ;; - da30) - basic_machine=m68k-da30 - os= - ;; - decstation | pmax | pmin | dec3100 | decstatn) - basic_machine=mips-dec - os= - ;; - delta88) - basic_machine=m88k-motorola - os=sysv3 - ;; - dicos) - basic_machine=i686-pc - os=dicos - ;; - djgpp) - basic_machine=i586-pc - os=msdosdjgpp - ;; - ebmon29k) - basic_machine=a29k-amd - os=ebmon - ;; - es1800 | OSE68k | ose68k | ose | OSE) - basic_machine=m68k-ericsson - os=ose - ;; - gmicro) - basic_machine=tron-gmicro - os=sysv - ;; - go32) - basic_machine=i386-pc - os=go32 - ;; - h8300hms) - basic_machine=h8300-hitachi - os=hms - ;; - h8300xray) - basic_machine=h8300-hitachi - os=xray - ;; - h8500hms) - basic_machine=h8500-hitachi - os=hms - ;; - harris) - basic_machine=m88k-harris - os=sysv3 - ;; - hp300) - basic_machine=m68k-hp - ;; - hp300bsd) - basic_machine=m68k-hp - os=bsd - ;; - hp300hpux) - basic_machine=m68k-hp - os=hpux - ;; - hppaosf) - basic_machine=hppa1.1-hp - os=osf - ;; - hppro) - basic_machine=hppa1.1-hp - os=proelf - ;; - i386mach) - basic_machine=i386-mach - os=mach - ;; - vsta) - basic_machine=i386-pc - os=vsta - ;; - isi68 | isi) - basic_machine=m68k-isi - os=sysv - ;; - m68knommu) - basic_machine=m68k-unknown - os=linux - ;; - magnum | m3230) - basic_machine=mips-mips - os=sysv - ;; - merlin) - basic_machine=ns32k-utek - os=sysv - ;; - mingw64) - basic_machine=x86_64-pc - os=mingw64 - ;; - mingw32) - basic_machine=i686-pc - os=mingw32 - ;; - mingw32ce) - basic_machine=arm-unknown - os=mingw32ce - ;; - monitor) - basic_machine=m68k-rom68k - os=coff - ;; - morphos) - basic_machine=powerpc-unknown - os=morphos - ;; - moxiebox) - basic_machine=moxie-unknown - os=moxiebox - ;; - msdos) - basic_machine=i386-pc - os=msdos - ;; - msys) - basic_machine=i686-pc - os=msys - ;; - mvs) - basic_machine=i370-ibm - os=mvs - ;; - nacl) - basic_machine=le32-unknown - os=nacl - ;; - ncr3000) - basic_machine=i486-ncr - os=sysv4 - ;; - netbsd386) - basic_machine=i386-pc - os=netbsd - ;; - netwinder) - basic_machine=armv4l-rebel - os=linux - ;; - news | news700 | news800 | news900) - basic_machine=m68k-sony - os=newsos - ;; - news1000) - basic_machine=m68030-sony - os=newsos - ;; - necv70) - basic_machine=v70-nec - os=sysv - ;; - nh3000) - basic_machine=m68k-harris - os=cxux - ;; - nh[45]000) - basic_machine=m88k-harris - os=cxux - ;; - nindy960) - basic_machine=i960-intel - os=nindy - ;; - mon960) - basic_machine=i960-intel - os=mon960 - ;; - nonstopux) - basic_machine=mips-compaq - os=nonstopux - ;; - os400) - basic_machine=powerpc-ibm - os=os400 - ;; - OSE68000 | ose68000) - basic_machine=m68000-ericsson - os=ose - ;; - os68k) - basic_machine=m68k-none - os=os68k - ;; - paragon) - basic_machine=i860-intel - os=osf - ;; - parisc) - basic_machine=hppa-unknown - os=linux - ;; - pw32) - basic_machine=i586-unknown - os=pw32 - ;; - rdos | rdos64) - basic_machine=x86_64-pc - os=rdos - ;; - rdos32) - basic_machine=i386-pc - os=rdos - ;; - rom68k) - basic_machine=m68k-rom68k - os=coff - ;; - sa29200) - basic_machine=a29k-amd - os=udi - ;; - sei) - basic_machine=mips-sei - os=seiux - ;; - sequent) - basic_machine=i386-sequent - os= - ;; - sps7) - basic_machine=m68k-bull - os=sysv2 - ;; - st2000) - basic_machine=m68k-tandem - os= - ;; - stratus) - basic_machine=i860-stratus - os=sysv4 - ;; - sun2) - basic_machine=m68000-sun - os= - ;; - sun2os3) - basic_machine=m68000-sun - os=sunos3 - ;; - sun2os4) - basic_machine=m68000-sun - os=sunos4 - ;; - sun3) - basic_machine=m68k-sun - os= - ;; - sun3os3) - basic_machine=m68k-sun - os=sunos3 - ;; - sun3os4) - basic_machine=m68k-sun - os=sunos4 - ;; - sun4) - basic_machine=sparc-sun - os= - ;; - sun4os3) - basic_machine=sparc-sun - os=sunos3 - ;; - sun4os4) - basic_machine=sparc-sun - os=sunos4 - ;; - sun4sol2) - basic_machine=sparc-sun - os=solaris2 - ;; - sun386 | sun386i | roadrunner) - basic_machine=i386-sun - os= - ;; - sv1) - basic_machine=sv1-cray - os=unicos - ;; - symmetry) - basic_machine=i386-sequent - os=dynix - ;; - t3e) - basic_machine=alphaev5-cray - os=unicos - ;; - t90) - basic_machine=t90-cray - os=unicos - ;; - toad1) - basic_machine=pdp10-xkl - os=tops20 - ;; - tpf) - basic_machine=s390x-ibm - os=tpf - ;; - udi29k) - basic_machine=a29k-amd - os=udi - ;; - ultra3) - basic_machine=a29k-nyu - os=sym1 - ;; - v810 | necv810) - basic_machine=v810-nec - os=none - ;; - vaxv) - basic_machine=vax-dec - os=sysv - ;; - vms) - basic_machine=vax-dec - os=vms - ;; - vxworks960) - basic_machine=i960-wrs - os=vxworks - ;; - vxworks68) - basic_machine=m68k-wrs - os=vxworks - ;; - vxworks29k) - basic_machine=a29k-wrs - os=vxworks - ;; - xbox) - basic_machine=i686-pc - os=mingw32 - ;; - ymp) - basic_machine=ymp-cray - os=unicos - ;; - *) - basic_machine=$1 - os= - ;; - esac - ;; -esac - -# Decode 1-component or ad-hoc basic machines -case $basic_machine in - # Here we handle the default manufacturer of certain CPU types. It is in - # some cases the only manufacturer, in others, it is the most popular. - w89k) - cpu=hppa1.1 - vendor=winbond - ;; - op50n) - cpu=hppa1.1 - vendor=oki - ;; - op60c) - cpu=hppa1.1 - vendor=oki - ;; - ibm*) - cpu=i370 - vendor=ibm - ;; - orion105) - cpu=clipper - vendor=highlevel - ;; - mac | mpw | mac-mpw) - cpu=m68k - vendor=apple - ;; - pmac | pmac-mpw) - cpu=powerpc - vendor=apple - ;; - - # Recognize the various machine names and aliases which stand - # for a CPU type and a company and sometimes even an OS. - 3b1 | 7300 | 7300-att | att-7300 | pc7300 | safari | unixpc) - cpu=m68000 - vendor=att - ;; - 3b*) - cpu=we32k - vendor=att - ;; - bluegene*) - cpu=powerpc - vendor=ibm - os=cnk - ;; - decsystem10* | dec10*) - cpu=pdp10 - vendor=dec - os=tops10 - ;; - decsystem20* | dec20*) - cpu=pdp10 - vendor=dec - os=tops20 - ;; - delta | 3300 | motorola-3300 | motorola-delta \ - | 3300-motorola | delta-motorola) - cpu=m68k - vendor=motorola - ;; - dpx2*) - cpu=m68k - vendor=bull - os=sysv3 - ;; - encore | umax | mmax) - cpu=ns32k - vendor=encore - ;; - elxsi) - cpu=elxsi - vendor=elxsi - os=${os:-bsd} - ;; - fx2800) - cpu=i860 - vendor=alliant - ;; - genix) - cpu=ns32k - vendor=ns - ;; - h3050r* | hiux*) - cpu=hppa1.1 - vendor=hitachi - os=hiuxwe2 - ;; - hp3k9[0-9][0-9] | hp9[0-9][0-9]) - cpu=hppa1.0 - vendor=hp - ;; - hp9k2[0-9][0-9] | hp9k31[0-9]) - cpu=m68000 - vendor=hp - ;; - hp9k3[2-9][0-9]) - cpu=m68k - vendor=hp - ;; - hp9k6[0-9][0-9] | hp6[0-9][0-9]) - cpu=hppa1.0 - vendor=hp - ;; - hp9k7[0-79][0-9] | hp7[0-79][0-9]) - cpu=hppa1.1 - vendor=hp - ;; - hp9k78[0-9] | hp78[0-9]) - # FIXME: really hppa2.0-hp - cpu=hppa1.1 - vendor=hp - ;; - hp9k8[67]1 | hp8[67]1 | hp9k80[24] | hp80[24] | hp9k8[78]9 | hp8[78]9 | hp9k893 | hp893) - # FIXME: really hppa2.0-hp - cpu=hppa1.1 - vendor=hp - ;; - hp9k8[0-9][13679] | hp8[0-9][13679]) - cpu=hppa1.1 - vendor=hp - ;; - hp9k8[0-9][0-9] | hp8[0-9][0-9]) - cpu=hppa1.0 - vendor=hp - ;; - i*86v32) - cpu=`echo "$1" | sed -e 's/86.*/86/'` - vendor=pc - os=sysv32 - ;; - i*86v4*) - cpu=`echo "$1" | sed -e 's/86.*/86/'` - vendor=pc - os=sysv4 - ;; - i*86v) - cpu=`echo "$1" | sed -e 's/86.*/86/'` - vendor=pc - os=sysv - ;; - i*86sol2) - cpu=`echo "$1" | sed -e 's/86.*/86/'` - vendor=pc - os=solaris2 - ;; - j90 | j90-cray) - cpu=j90 - vendor=cray - os=${os:-unicos} - ;; - iris | iris4d) - cpu=mips - vendor=sgi - case $os in - irix*) - ;; - *) - os=irix4 - ;; - esac - ;; - miniframe) - cpu=m68000 - vendor=convergent - ;; - *mint | mint[0-9]* | *MiNT | *MiNT[0-9]*) - cpu=m68k - vendor=atari - os=mint - ;; - news-3600 | risc-news) - cpu=mips - vendor=sony - os=newsos - ;; - next | m*-next) - cpu=m68k - vendor=next - case $os in - nextstep* ) - ;; - ns2*) - os=nextstep2 - ;; - *) - os=nextstep3 - ;; - esac - ;; - np1) - cpu=np1 - vendor=gould - ;; - op50n-* | op60c-*) - cpu=hppa1.1 - vendor=oki - os=proelf - ;; - pa-hitachi) - cpu=hppa1.1 - vendor=hitachi - os=hiuxwe2 - ;; - pbd) - cpu=sparc - vendor=tti - ;; - pbb) - cpu=m68k - vendor=tti - ;; - pc532) - cpu=ns32k - vendor=pc532 - ;; - pn) - cpu=pn - vendor=gould - ;; - power) - cpu=power - vendor=ibm - ;; - ps2) - cpu=i386 - vendor=ibm - ;; - rm[46]00) - cpu=mips - vendor=siemens - ;; - rtpc | rtpc-*) - cpu=romp - vendor=ibm - ;; - sde) - cpu=mipsisa32 - vendor=sde - os=${os:-elf} - ;; - simso-wrs) - cpu=sparclite - vendor=wrs - os=vxworks - ;; - tower | tower-32) - cpu=m68k - vendor=ncr - ;; - vpp*|vx|vx-*) - cpu=f301 - vendor=fujitsu - ;; - w65) - cpu=w65 - vendor=wdc - ;; - w89k-*) - cpu=hppa1.1 - vendor=winbond - os=proelf - ;; - none) - cpu=none - vendor=none - ;; - leon|leon[3-9]) - cpu=sparc - vendor=$basic_machine - ;; - leon-*|leon[3-9]-*) - cpu=sparc - vendor=`echo "$basic_machine" | sed 's/-.*//'` - ;; - - *-*) - # shellcheck disable=SC2162 - IFS="-" read cpu vendor <&2 - exit 1 - ;; - esac - ;; -esac - -# Here we canonicalize certain aliases for manufacturers. -case $vendor in - digital*) - vendor=dec - ;; - commodore*) - vendor=cbm - ;; - *) - ;; -esac - -# Decode manufacturer-specific aliases for certain operating systems. - -if [ x$os != x ] -then -case $os in - # First match some system type aliases that might get confused - # with valid system types. - # solaris* is a basic system type, with this one exception. - auroraux) - os=auroraux - ;; - bluegene*) - os=cnk - ;; - solaris1 | solaris1.*) - os=`echo $os | sed -e 's|solaris1|sunos4|'` - ;; - solaris) - os=solaris2 - ;; - unixware*) - os=sysv4.2uw - ;; - gnu/linux*) - os=`echo $os | sed -e 's|gnu/linux|linux-gnu|'` - ;; - # es1800 is here to avoid being matched by es* (a different OS) - es1800*) - os=ose - ;; - # Some version numbers need modification - chorusos*) - os=chorusos - ;; - isc) - os=isc2.2 - ;; - sco6) - os=sco5v6 - ;; - sco5) - os=sco3.2v5 - ;; - sco4) - os=sco3.2v4 - ;; - sco3.2.[4-9]*) - os=`echo $os | sed -e 's/sco3.2./sco3.2v/'` - ;; - sco3.2v[4-9]* | sco5v6*) - # Don't forget version if it is 3.2v4 or newer. - ;; - scout) - # Don't match below - ;; - sco*) - os=sco3.2v2 - ;; - psos*) - os=psos - ;; - # Now accept the basic system types. - # The portable systems comes first. - # Each alternative MUST end in a * to match a version number. - # sysv* is not here because it comes later, after sysvr4. - gnu* | bsd* | mach* | minix* | genix* | ultrix* | irix* \ - | *vms* | esix* | aix* | cnk* | sunos | sunos[34]*\ - | hpux* | unos* | osf* | luna* | dgux* | auroraux* | solaris* \ - | sym* | kopensolaris* | plan9* \ - | amigaos* | amigados* | msdos* | newsos* | unicos* | aof* \ - | aos* | aros* | cloudabi* | sortix* \ - | nindy* | vxsim* | vxworks* | ebmon* | hms* | mvs* \ - | clix* | riscos* | uniplus* | iris* | isc* | rtu* | xenix* \ - | knetbsd* | mirbsd* | netbsd* \ - | bitrig* | openbsd* | solidbsd* | libertybsd* \ - | ekkobsd* | kfreebsd* | freebsd* | riscix* | lynxos* \ - | bosx* | nextstep* | cxux* | aout* | elf* | oabi* \ - | ptx* | coff* | ecoff* | winnt* | domain* | vsta* \ - | udi* | eabi* | lites* | ieee* | go32* | aux* | hcos* \ - | chorusrdb* | cegcc* | glidix* \ - | cygwin* | msys* | pe* | moss* | proelf* | rtems* \ - | midipix* | mingw32* | mingw64* | linux-gnu* | linux-android* \ - | linux-newlib* | linux-musl* | linux-uclibc* \ - | uxpv* | beos* | mpeix* | udk* | moxiebox* \ - | interix* | uwin* | mks* | rhapsody* | darwin* \ - | openstep* | oskit* | conix* | pw32* | nonstopux* \ - | storm-chaos* | tops10* | tenex* | tops20* | its* \ - | os2* | vos* | palmos* | uclinux* | nucleus* \ - | morphos* | superux* | rtmk* | windiss* \ - | powermax* | dnix* | nx6 | nx7 | sei* | dragonfly* \ - | skyos* | haiku* | rdos* | toppers* | drops* | es* \ - | onefs* | tirtos* | phoenix* | fuchsia* | redox* | bme* \ - | midnightbsd* | amdhsa* | unleashed* | emscripten*) - # Remember, each alternative MUST END IN *, to match a version number. - ;; - qnx*) - case $cpu in - x86 | i*86) - ;; - *) - os=nto-$os - ;; - esac - ;; - hiux*) - os=hiuxwe2 - ;; - nto-qnx*) - ;; - nto*) - os=`echo $os | sed -e 's|nto|nto-qnx|'` - ;; - sim | xray | os68k* | v88r* \ - | windows* | osx | abug | netware* | os9* \ - | macos* | mpw* | magic* | mmixware* | mon960* | lnews*) - ;; - linux-dietlibc) - os=linux-dietlibc - ;; - linux*) - os=`echo $os | sed -e 's|linux|linux-gnu|'` - ;; - lynx*178) - os=lynxos178 - ;; - lynx*5) - os=lynxos5 - ;; - lynx*) - os=lynxos - ;; - mac*) - os=`echo "$os" | sed -e 's|mac|macos|'` - ;; - opened*) - os=openedition - ;; - os400*) - os=os400 - ;; - sunos5*) - os=`echo "$os" | sed -e 's|sunos5|solaris2|'` - ;; - sunos6*) - os=`echo "$os" | sed -e 's|sunos6|solaris3|'` - ;; - wince*) - os=wince - ;; - utek*) - os=bsd - ;; - dynix*) - os=bsd - ;; - acis*) - os=aos - ;; - atheos*) - os=atheos - ;; - syllable*) - os=syllable - ;; - 386bsd) - os=bsd - ;; - ctix* | uts*) - os=sysv - ;; - nova*) - os=rtmk-nova - ;; - ns2) - os=nextstep2 - ;; - nsk*) - os=nsk - ;; - # Preserve the version number of sinix5. - sinix5.*) - os=`echo $os | sed -e 's|sinix|sysv|'` - ;; - sinix*) - os=sysv4 - ;; - tpf*) - os=tpf - ;; - triton*) - os=sysv3 - ;; - oss*) - os=sysv3 - ;; - svr4*) - os=sysv4 - ;; - svr3) - os=sysv3 - ;; - sysvr4) - os=sysv4 - ;; - # This must come after sysvr4. - sysv*) - ;; - ose*) - os=ose - ;; - *mint | mint[0-9]* | *MiNT | MiNT[0-9]*) - os=mint - ;; - zvmoe) - os=zvmoe - ;; - dicos*) - os=dicos - ;; - pikeos*) - # Until real need of OS specific support for - # particular features comes up, bare metal - # configurations are quite functional. - case $cpu in - arm*) - os=eabi - ;; - *) - os=elf - ;; - esac - ;; - nacl*) - ;; - ios) - ;; - none) - ;; - *-eabi) - ;; - *) - echo Invalid configuration \`"$1"\': system \`"$os"\' not recognized 1>&2 - exit 1 - ;; -esac -else - -# Here we handle the default operating systems that come with various machines. -# The value should be what the vendor currently ships out the door with their -# machine or put another way, the most popular os provided with the machine. - -# Note that if you're going to try to match "-MANUFACTURER" here (say, -# "-sun"), then you have to tell the case statement up towards the top -# that MANUFACTURER isn't an operating system. Otherwise, code above -# will signal an error saying that MANUFACTURER isn't an operating -# system, and we'll never get to this point. - -case $cpu-$vendor in - score-*) - os=elf - ;; - spu-*) - os=elf - ;; - *-acorn) - os=riscix1.2 - ;; - arm*-rebel) - os=linux - ;; - arm*-semi) - os=aout - ;; - c4x-* | tic4x-*) - os=coff - ;; - c8051-*) - os=elf - ;; - clipper-intergraph) - os=clix - ;; - hexagon-*) - os=elf - ;; - tic54x-*) - os=coff - ;; - tic55x-*) - os=coff - ;; - tic6x-*) - os=coff - ;; - # This must come before the *-dec entry. - pdp10-*) - os=tops20 - ;; - pdp11-*) - os=none - ;; - *-dec | vax-*) - os=ultrix4.2 - ;; - m68*-apollo) - os=domain - ;; - i386-sun) - os=sunos4.0.2 - ;; - m68000-sun) - os=sunos3 - ;; - m68*-cisco) - os=aout - ;; - mep-*) - os=elf - ;; - mips*-cisco) - os=elf - ;; - mips*-*) - os=elf - ;; - or32-*) - os=coff - ;; - *-tti) # must be before sparc entry or we get the wrong os. - os=sysv3 - ;; - sparc-* | *-sun) - os=sunos4.1.1 - ;; - pru-*) - os=elf - ;; - *-be) - os=beos - ;; - *-ibm) - os=aix - ;; - *-knuth) - os=mmixware - ;; - *-wec) - os=proelf - ;; - *-winbond) - os=proelf - ;; - *-oki) - os=proelf - ;; - *-hp) - os=hpux - ;; - *-hitachi) - os=hiux - ;; - i860-* | *-att | *-ncr | *-altos | *-motorola | *-convergent) - os=sysv - ;; - *-cbm) - os=amigaos - ;; - *-dg) - os=dgux - ;; - *-dolphin) - os=sysv3 - ;; - m68k-ccur) - os=rtu - ;; - m88k-omron*) - os=luna - ;; - *-next) - os=nextstep - ;; - *-sequent) - os=ptx - ;; - *-crds) - os=unos - ;; - *-ns) - os=genix - ;; - i370-*) - os=mvs - ;; - *-gould) - os=sysv - ;; - *-highlevel) - os=bsd - ;; - *-encore) - os=bsd - ;; - *-sgi) - os=irix - ;; - *-siemens) - os=sysv4 - ;; - *-masscomp) - os=rtu - ;; - f30[01]-fujitsu | f700-fujitsu) - os=uxpv - ;; - *-rom68k) - os=coff - ;; - *-*bug) - os=coff - ;; - *-apple) - os=macos - ;; - *-atari*) - os=mint - ;; - *-wrs) - os=vxworks - ;; - *) - os=none - ;; -esac -fi - -# Here we handle the case where we know the os, and the CPU type, but not the -# manufacturer. We pick the logical manufacturer. -case $vendor in - unknown) - case $os in - riscix*) - vendor=acorn - ;; - sunos*) - vendor=sun - ;; - cnk*|-aix*) - vendor=ibm - ;; - beos*) - vendor=be - ;; - hpux*) - vendor=hp - ;; - mpeix*) - vendor=hp - ;; - hiux*) - vendor=hitachi - ;; - unos*) - vendor=crds - ;; - dgux*) - vendor=dg - ;; - luna*) - vendor=omron - ;; - genix*) - vendor=ns - ;; - clix*) - vendor=intergraph - ;; - mvs* | opened*) - vendor=ibm - ;; - os400*) - vendor=ibm - ;; - ptx*) - vendor=sequent - ;; - tpf*) - vendor=ibm - ;; - vxsim* | vxworks* | windiss*) - vendor=wrs - ;; - aux*) - vendor=apple - ;; - hms*) - vendor=hitachi - ;; - mpw* | macos*) - vendor=apple - ;; - *mint | mint[0-9]* | *MiNT | MiNT[0-9]*) - vendor=atari - ;; - vos*) - vendor=stratus - ;; - esac - ;; -esac - -echo "$cpu-$vendor-$os" -exit - -# Local variables: -# eval: (add-hook 'before-save-hook 'time-stamp) -# time-stamp-start: "timestamp='" -# time-stamp-format: "%:y-%02m-%02d" -# time-stamp-end: "'" -# End: diff -Nru gnucobol-4.0~early~20200606/build_aux/create_mingw_bindist.sh gnucobol-5/build_aux/create_mingw_bindist.sh --- gnucobol-4.0~early~20200606/build_aux/create_mingw_bindist.sh 2020-06-06 20:52:02.000000000 +0000 +++ gnucobol-5/build_aux/create_mingw_bindist.sh 1970-01-01 00:00:00.000000000 +0000 @@ -1,244 +0,0 @@ -#!/bin/sh -# create_mingw_bindist.sh gnucobol -# -# Copyright (C) 2016-2019 Free Software Foundation, Inc. -# Written by Simon Sobisch -# -# This file is part of GnuCOBOL. -# -# The GnuCOBOL compiler is free software: you can redistribute it -# and/or modify it under the terms of the GNU General Public License -# as published by the Free Software Foundation, either version 3 of the -# License, or (at your option) any later version. -# -# GnuCOBOL is distributed in the hope that it will be useful, -# but WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -# GNU General Public License for more details. -# -# You should have received a copy of the GNU General Public License -# along with GnuCOBOL. If not, see . - - -# This shell script needs to be sourced from Makefile processing, -# otherwise set EXTSRCDIR and EXTBUILDDIR before calling this script -# AND make sure EXTBUILDDIR exists with the right content - -# Check we're in a MinGW environment -if test ! -d "/mingw/bin"; then - echo "binary mingw dist packages can only be created from MSYS/MinGW" - echo "directory /mingw/bin not found" - exit 99 -fi - -# Check necessary vars: -if test "x$EXTBUILDDIR" = "x"; then - EXTBUILDDIR="." - echo "EXTBUILDDIR" not set, "." assumed -fi -if test "x$EXTSRCDIR" = "x"; then - EXTSRCDIR="." - echo "EXTSRCDIR" not set, "." assumed -fi -if test ! -f "$EXTBUILDDIR/config.log"; then - echo "$EXTBUILDDIR/config.log" does not exist, aborting $0 - exit 5 -fi -if test ! -f "$EXTSRCDIR/configure"; then - echo "$EXTSRCDIR/configure" does not exist, aborting $0 - exit 5 -fi - -# Create folder -target_dir=$EXTBUILDDIR/GnuCOBOL_mingw -echo -echo "Building MinGW dist package for GnuCOBOL" -echo "target: $target_dir" -echo -if test -e "$target_dir"; then - fdate=$(date +%F_%h%m%S) - echo "target directory already exist - renaming it to $target_dir-$fdate" - mv "$target_dir" "$target_dir-$fdate" - if test -e "$target_dir"; then - echo "cannot move old target directory" && exit 98 - fi -fi -mkdir "$target_dir" || (echo "cannot create target directory" && exit 97) -pushd "$target_dir" 1>/dev/null -if test "$target_dir" != "$(pwd)"; then - target_dir="$(pwd)" - echo "target (resolved): $target_dir" -fi -popd 1>/dev/null - -echo && echo copying MinGW files... -echo " bin..." -cp -pr "/mingw/bin" "$target_dir/" -echo " include..." -cp -pr "/mingw/include" "$target_dir/" -echo " lib..." -cp -pr "/mingw/lib" "$target_dir/" -echo " libexec..." -cp -pr "/mingw/libexec" "$target_dir/" - -echo && echo copying GnuCOBOL files... -cp -pr "$EXTBUILDDIR/extras" "$target_dir/" -cp -pr "$EXTSRCDIR/copy" "$target_dir/" -cp -pr "$EXTSRCDIR/config" "$target_dir/" - -cp -p "$EXTBUILDDIR/cobc/.libs/cobc.exe" "$target_dir/bin/" -cp -p "$EXTBUILDDIR/bin/.libs/cobcrun.exe" "$target_dir/bin/" -cp -p $EXTBUILDDIR/libcob/.libs/libcob*.dll "$target_dir/bin/" -cp -p $EXTBUILDDIR/libcob/.libs/libcob.* "$target_dir/lib/" -mkdir "$target_dir/include/libcob" -cp -p $EXTSRCDIR/libcob.h "$target_dir/include/" -cp -p $EXTSRCDIR/libcob/*.h "$target_dir/include/libcob" -cp -p $EXTSRCDIR/libcob/*.def "$target_dir/include/libcob" - -echo && echo copying docs... - -pushd "$EXTSRCDIR" 1>/dev/null -cp README "$target_dir/README.txt" - -for file in \ - "ChangeLog" \ - "NEWS" \ - "THANKS" \ - "COPYING" \ - "COPYING.LESSER" \ - "COPYING.DOC" \ - "COPYING.DOC" -do - sed -e 's/\r*$/\r/' "$file" > "$target_dir/$(basename "$file").txt" -done -sed -e 's/\r*$/\r/' "bin/ChangeLog" > "$target_dir/ChangeLog_bin.txt" -sed -e 's/\r*$/\r/' "cobc/ChangeLog" > "$target_dir/ChangeLog_cobc.txt" -sed -e 's/\r*$/\r/' "libcob/ChangeLog" > "$target_dir/ChangeLog_libcob.txt" - -# copy manpages and translations -#cp bin/cobcrun.1 -#cp cobc/cobc.1 -##cp libcob/libcob.3 - -popd 1>/dev/null - -pushd "$EXTBUILDDIR" 1>/dev/null -sed -e 's/\r*$/\r/' "config.log" > "$target_dir/config.log" -if test -f "tests/testsuite.log"; then - sed -e 's/\r*$/\r/' "tests/testsuite.log" > "$target_dir/testsuite.log" -else - echo "WARNING: GnuCOBOL testsuite results not found!" -fi -if test -f "tests/cobol85/summary.log"; then - sed -e 's/\r*$/\r/' "tests/cobol85/summary.log" > "$target_dir/NIST_summary.log" -else - echo "WARNING: NIST results not found!" -fi - -if test -f "doc/gnucobol.pdf"; then - cp -p "doc/gnucobol.pdf" "$target_dir/GnuCOBOL.pdf" -else - if test -f "$EXTSRCDIR/doc/gnucobol.pdf"; then - cp -p "$EXTSRCDIR/doc/gnucobol.pdf" "$target_dir/GnuCOBOL.pdf" - else - echo "WARNING: GnuCOBOL.pdf will be missing" - fi -fi -popd 1>/dev/null - - -echo && echo stripping binaries... -rm -rf "$target_dir/bin_stripped" -cp -rp "$target_dir/bin" "$target_dir/bin_stripped" -rm -rf "$target_dir/lib_stripped" -cp -rp "$target_dir/lib" "$target_dir/lib_stripped" -pushd "$target_dir/bin_stripped" 1>/dev/null -strip -p --strip-debug --strip-unneeded *.dll *.exe 2>/dev/null -cd "../lib_stripped" -strip -p --strip-debug --strip-unneeded *.a 2>/dev/null -popd 1>/dev/null - -cat >$target_dir/set_env.cmd <<'_FEOF' -@echo off - -echo. -echo Setting environment for GnuCOBOL 3.1 with MinGW binaries -echo (GCC 4.8.1, BDB 6.1.23, PDcurses 3.4, MPIR 2.7.0) - -:: Check if called already -:: if yes, check if called from here - exit, in any other case -:: raise warning and reset env vars -if not "%COB_MAIN_DIR%" == "" ( - echo. - if "%COB_MAIN_DIR%" == "%~dp0" ( - echo Information: batch was called alread from "%COB_MAIN_DIR%" - echo skipping environment setting... - goto :cobcver - ) else ( - echo Warning: batch was called before from "%COB_MAIN_DIR%" - echo resetting COB_CFLAGS, COB_LDFLAGS - set COB_CFLAGS= - set COB_LDLAGS= - ) -) - -:: Get the main dir from the batch's position (only works in NT environments) -set COB_MAIN_DIR=%~dp0 - -:: settings for cobc -set COB_CONFIG_DIR=%COB_MAIN_DIR%config -set COB_COPY_DIR=%COB_MAIN_DIR%copy -set COB_CFLAGS=-I"%COB_MAIN_DIR%include" %COB_CFLAGS% -set COB_LDFLAGS=-L"%COB_MAIN_DIR%lib" %COB_LDFLAGS% - -:: settings for libcob -rem the following won't work in GnuCOBOL 1.1 if there are spaces in COB_MAIN_DIR -set COB_LIBRARY_PATH=%COB_MAIN_DIR%extras - -:: Add the bin path of GnuCOBOL (including GCC) to PATH for further references -set PATH=%COB_MAIN_DIR%bin;%PATH% - -:: Compiler version output -:cobcver -echo. -cobc --version - -_FEOF - -sed -i -e 's/\r*$/\r/' "$target_dir/set_env.cmd" - - -cat >$target_dir/BUGS.txt <<'_FEOF' - -Known bugs found in this distribution, which are normally not in GnuCOBOL n.n: - -* NONE - -_FEOF - -sed -i -e 's/\r*$/\r/' "$target_dir/BUGS.txt" - - -# only add to README -cat >>$target_dir/README.txt <<'_FEOF' - -This package (MinGW based) is intended for testing purposes on Windows systems -and has everything needed to run the compiler and runtime, including GCC 4.8.1 -as C compiler. -Other components are BDB 6.1.23, PDcurses 3.4, MPIR 2.7.0 (gmpcompat, without -any processor optimization). - -It is NOT optimized and may have some minor bugs other binaries created from the -source tarball don't have. - -Important: See BUGS.txt for possible known issues in this distribution! - -For running GnuCOBOL simply open a command prompt and call set_env.cmd in this -folder once. You can use cobc/cobcrun in the command prompt afterwards. - -_FEOF - -sed -i -e 's/\r*$/\r/' "$target_dir/README.txt" - -echo && echo FINISHED -echo && echo make sure to adjust set_env.cmd, README.txt and BUGS.txt diff -Nru gnucobol-4.0~early~20200606/build_aux/create_win_dist.sh gnucobol-5/build_aux/create_win_dist.sh --- gnucobol-4.0~early~20200606/build_aux/create_win_dist.sh 2020-06-06 20:52:02.000000000 +0000 +++ gnucobol-5/build_aux/create_win_dist.sh 1970-01-01 00:00:00.000000000 +0000 @@ -1,106 +0,0 @@ -#!/bin/sh -# create_win_dist.sh gnucobol -# -# Copyright (C) 2016-2017,2019 Free Software Foundation, Inc. -# Written by Simon Sobisch -# -# This file is part of GnuCOBOL. -# -# The GnuCOBOL compiler is free software: you can redistribute it -# and/or modify it under the terms of the GNU General Public License -# as published by the Free Software Foundation, either version 3 of the -# License, or (at your option) any later version. -# -# GnuCOBOL is distributed in the hope that it will be useful, -# but WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -# GNU General Public License for more details. -# -# You should have received a copy of the GNU General Public License -# along with GnuCOBOL. If not, see . - - -# This shell script needs to be sourced from Makefile processing, -# otherwise set EXTSRCDIR, EXTDISTDIR and EXTWINDISTDIR before calling -# this script AND make sure EXTDISTDIR exists with the right content. - -# check necessary vars: - -if test "x$EXTDISTDIR" = "x"; then - echo "EXTDISTDIR" not set, aborting $0 - exit 1 -fi -if test ! -d "$EXTDISTDIR"; then - echo "$EXTDISTDIR" does not exist, aborting $0 - exit 5 -fi - -if test "x$EXTSRCDIR" = "x"; then - echo "EXTSRCDIR" not set, aborting $0 - exit 1 -fi -if test ! -d "$EXTSRCDIR/build_windows"; then - echo "$EXTSRCDIR/build_windows" does not exist, aborting $0 - exit 5 -fi - -if test "x$EXTWINDISTDIR" = "x"; then - echo "EXTWINDISTDIR" not set, aborting $0 - exit 1 -fi -if test -d "$EXTWINDISTDIR"; then - rm -rf "$EXTWINDISTDIR" -fi - -echo cp -p -r "$EXTDISTDIR" "$EXTWINDISTDIR" -cp -p -r "$EXTDISTDIR" "$EXTWINDISTDIR" || exit 1 - -# add content only necessary for windows dist zip - -echo rsync -av "$EXTSRCDIR/build_windows" "$EXTWINDISTDIR/" -rsync -a "$EXTSRCDIR/build_windows" "$EXTWINDISTDIR/" --exclude=x64 --exclude=Win32 --exclude=".vs" --exclude=".ncb" --exclude=".bak" --exclude=distnew -echo cp "$EXTSRCDIR/tests/atlocal_win" "$EXTWINDISTDIR/tests/atlocal_win" -cp "$EXTSRCDIR/tests/atlocal_win" "$EXTWINDISTDIR/tests/atlocal_win" || exit 2 - -olddir="$(pwd)" -cd "$EXTWINDISTDIR" || exit 3 - -# rename templates for faster setup -cd build_windows || exit 5 -mv "config.h.in" "config.h" -mv "defaults.h.in" "defaults.h" -cd .. - -# remove content not necessary for windows-only distribution --> breaks make dist[check] -# rm -r -f m4 - -# change line ending for files in windows distribution -find -regextype posix-egrep -regex ".*(\.([chyl]|def|cpy|cob|conf|cfg)|(README|ChangeLog|AUTHORS|ABOUT-NLS|NEWS|THANKS|TODO|COPYING.*))$" \ - -exec sed -i -e 's/\r*$/\r/' {} \; - -# fix timestamps again -chmod +x ./doc/cobcinfo.sh -cd doc -./cobcinfo.sh "fixtimestamps" -cd .. -touch "./bin/cobcrun.1" -touch "./cobc/cobc.1" -touch "./cobc/ppparse.c" -touch "./cobc/parser.c" -#touch "./cobc/pplex.c" -#touch "./cobc/scanner.c" -#touch "./libcob/libcob.3" -touch "./tests/testsuite" -touch "./tests/testsuite_manual" - -# bugfix for old _MSC versions that define __STDC_VERSION__ >= 199901L but don't work correct -for file in "./cobc/pplex.c" "./cobc/scanner.c"; do -# "sed -i" isn't supported on all systems --> maybe use sed && mv - do we actually want to care for this here? -# sed -e 's/199901L/199901L \&\&(!defined(_MSC_VER) || _MSC_VER >= 1800)/g' \ -# $file > $file.tmp && mv -f $file.tmp $file - sed -i -e 's/199901L/199901L \&\&(!defined(_MSC_VER) || _MSC_VER >= 1800)/g' $file -done -cd .. # back in win-dist - -cd "$olddir" # back in starting directory - diff -Nru gnucobol-4.0~early~20200606/build_aux/depcomp gnucobol-5/build_aux/depcomp --- gnucobol-4.0~early~20200606/build_aux/depcomp 2020-06-06 20:52:02.000000000 +0000 +++ gnucobol-5/build_aux/depcomp 1970-01-01 00:00:00.000000000 +0000 @@ -1,791 +0,0 @@ -#! /bin/sh -# depcomp - compile a program generating dependencies as side-effects - -scriptversion=2017-09-16.17; # UTC - -# Copyright (C) 1999-2017 Free Software Foundation, Inc. - -# This program is free software; you can redistribute it and/or modify -# it under the terms of the GNU General Public License as published by -# the Free Software Foundation; either version 2, or (at your option) -# any later version. - -# This program is distributed in the hope that it will be useful, -# but WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -# GNU General Public License for more details. - -# You should have received a copy of the GNU General Public License -# along with this program. If not, see . - -# As a special exception to the GNU General Public License, if you -# distribute this file as part of a program that contains a -# configuration script generated by Autoconf, you may include it under -# the same distribution terms that you use for the rest of that program. - -# Originally written by Alexandre Oliva . - -case $1 in - '') - echo "$0: No command. Try '$0 --help' for more information." 1>&2 - exit 1; - ;; - -h | --h*) - cat <<\EOF -Usage: depcomp [--help] [--version] PROGRAM [ARGS] - -Run PROGRAMS ARGS to compile a file, generating dependencies -as side-effects. - -Environment variables: - depmode Dependency tracking mode. - source Source file read by 'PROGRAMS ARGS'. - object Object file output by 'PROGRAMS ARGS'. - DEPDIR directory where to store dependencies. - depfile Dependency file to output. - tmpdepfile Temporary file to use when outputting dependencies. - libtool Whether libtool is used (yes/no). - -Report bugs to . -EOF - exit $? - ;; - -v | --v*) - echo "depcomp $scriptversion" - exit $? - ;; -esac - -# Get the directory component of the given path, and save it in the -# global variables '$dir'. Note that this directory component will -# be either empty or ending with a '/' character. This is deliberate. -set_dir_from () -{ - case $1 in - */*) dir=`echo "$1" | sed -e 's|/[^/]*$|/|'`;; - *) dir=;; - esac -} - -# Get the suffix-stripped basename of the given path, and save it the -# global variable '$base'. -set_base_from () -{ - base=`echo "$1" | sed -e 's|^.*/||' -e 's/\.[^.]*$//'` -} - -# If no dependency file was actually created by the compiler invocation, -# we still have to create a dummy depfile, to avoid errors with the -# Makefile "include basename.Plo" scheme. -make_dummy_depfile () -{ - echo "#dummy" > "$depfile" -} - -# Factor out some common post-processing of the generated depfile. -# Requires the auxiliary global variable '$tmpdepfile' to be set. -aix_post_process_depfile () -{ - # If the compiler actually managed to produce a dependency file, - # post-process it. - if test -f "$tmpdepfile"; then - # Each line is of the form 'foo.o: dependency.h'. - # Do two passes, one to just change these to - # $object: dependency.h - # and one to simply output - # dependency.h: - # which is needed to avoid the deleted-header problem. - { sed -e "s,^.*\.[$lower]*:,$object:," < "$tmpdepfile" - sed -e "s,^.*\.[$lower]*:[$tab ]*,," -e 's,$,:,' < "$tmpdepfile" - } > "$depfile" - rm -f "$tmpdepfile" - else - make_dummy_depfile - fi -} - -# A tabulation character. -tab=' ' -# A newline character. -nl=' -' -# Character ranges might be problematic outside the C locale. -# These definitions help. -upper=ABCDEFGHIJKLMNOPQRSTUVWXYZ -lower=abcdefghijklmnopqrstuvwxyz -digits=0123456789 -alpha=${upper}${lower} - -if test -z "$depmode" || test -z "$source" || test -z "$object"; then - echo "depcomp: Variables source, object and depmode must be set" 1>&2 - exit 1 -fi - -# Dependencies for sub/bar.o or sub/bar.obj go into sub/.deps/bar.Po. -depfile=${depfile-`echo "$object" | - sed 's|[^\\/]*$|'${DEPDIR-.deps}'/&|;s|\.\([^.]*\)$|.P\1|;s|Pobj$|Po|'`} -tmpdepfile=${tmpdepfile-`echo "$depfile" | sed 's/\.\([^.]*\)$/.T\1/'`} - -rm -f "$tmpdepfile" - -# Avoid interferences from the environment. -gccflag= dashmflag= - -# Some modes work just like other modes, but use different flags. We -# parameterize here, but still list the modes in the big case below, -# to make depend.m4 easier to write. Note that we *cannot* use a case -# here, because this file can only contain one case statement. -if test "$depmode" = hp; then - # HP compiler uses -M and no extra arg. - gccflag=-M - depmode=gcc -fi - -if test "$depmode" = dashXmstdout; then - # This is just like dashmstdout with a different argument. - dashmflag=-xM - depmode=dashmstdout -fi - -cygpath_u="cygpath -u -f -" -if test "$depmode" = msvcmsys; then - # This is just like msvisualcpp but w/o cygpath translation. - # Just convert the backslash-escaped backslashes to single forward - # slashes to satisfy depend.m4 - cygpath_u='sed s,\\\\,/,g' - depmode=msvisualcpp -fi - -if test "$depmode" = msvc7msys; then - # This is just like msvc7 but w/o cygpath translation. - # Just convert the backslash-escaped backslashes to single forward - # slashes to satisfy depend.m4 - cygpath_u='sed s,\\\\,/,g' - depmode=msvc7 -fi - -if test "$depmode" = xlc; then - # IBM C/C++ Compilers xlc/xlC can output gcc-like dependency information. - gccflag=-qmakedep=gcc,-MF - depmode=gcc -fi - -case "$depmode" in -gcc3) -## gcc 3 implements dependency tracking that does exactly what -## we want. Yay! Note: for some reason libtool 1.4 doesn't like -## it if -MD -MP comes after the -MF stuff. Hmm. -## Unfortunately, FreeBSD c89 acceptance of flags depends upon -## the command line argument order; so add the flags where they -## appear in depend2.am. Note that the slowdown incurred here -## affects only configure: in makefiles, %FASTDEP% shortcuts this. - for arg - do - case $arg in - -c) set fnord "$@" -MT "$object" -MD -MP -MF "$tmpdepfile" "$arg" ;; - *) set fnord "$@" "$arg" ;; - esac - shift # fnord - shift # $arg - done - "$@" - stat=$? - if test $stat -ne 0; then - rm -f "$tmpdepfile" - exit $stat - fi - mv "$tmpdepfile" "$depfile" - ;; - -gcc) -## Note that this doesn't just cater to obsosete pre-3.x GCC compilers. -## but also to in-use compilers like IMB xlc/xlC and the HP C compiler. -## (see the conditional assignment to $gccflag above). -## There are various ways to get dependency output from gcc. Here's -## why we pick this rather obscure method: -## - Don't want to use -MD because we'd like the dependencies to end -## up in a subdir. Having to rename by hand is ugly. -## (We might end up doing this anyway to support other compilers.) -## - The DEPENDENCIES_OUTPUT environment variable makes gcc act like -## -MM, not -M (despite what the docs say). Also, it might not be -## supported by the other compilers which use the 'gcc' depmode. -## - Using -M directly means running the compiler twice (even worse -## than renaming). - if test -z "$gccflag"; then - gccflag=-MD, - fi - "$@" -Wp,"$gccflag$tmpdepfile" - stat=$? - if test $stat -ne 0; then - rm -f "$tmpdepfile" - exit $stat - fi - rm -f "$depfile" - echo "$object : \\" > "$depfile" - # The second -e expression handles DOS-style file names with drive - # letters. - sed -e 's/^[^:]*: / /' \ - -e 's/^['$alpha']:\/[^:]*: / /' < "$tmpdepfile" >> "$depfile" -## This next piece of magic avoids the "deleted header file" problem. -## The problem is that when a header file which appears in a .P file -## is deleted, the dependency causes make to die (because there is -## typically no way to rebuild the header). We avoid this by adding -## dummy dependencies for each header file. Too bad gcc doesn't do -## this for us directly. -## Some versions of gcc put a space before the ':'. On the theory -## that the space means something, we add a space to the output as -## well. hp depmode also adds that space, but also prefixes the VPATH -## to the object. Take care to not repeat it in the output. -## Some versions of the HPUX 10.20 sed can't process this invocation -## correctly. Breaking it into two sed invocations is a workaround. - tr ' ' "$nl" < "$tmpdepfile" \ - | sed -e 's/^\\$//' -e '/^$/d' -e "s|.*$object$||" -e '/:$/d' \ - | sed -e 's/$/ :/' >> "$depfile" - rm -f "$tmpdepfile" - ;; - -hp) - # This case exists only to let depend.m4 do its work. It works by - # looking at the text of this script. This case will never be run, - # since it is checked for above. - exit 1 - ;; - -sgi) - if test "$libtool" = yes; then - "$@" "-Wp,-MDupdate,$tmpdepfile" - else - "$@" -MDupdate "$tmpdepfile" - fi - stat=$? - if test $stat -ne 0; then - rm -f "$tmpdepfile" - exit $stat - fi - rm -f "$depfile" - - if test -f "$tmpdepfile"; then # yes, the sourcefile depend on other files - echo "$object : \\" > "$depfile" - # Clip off the initial element (the dependent). Don't try to be - # clever and replace this with sed code, as IRIX sed won't handle - # lines with more than a fixed number of characters (4096 in - # IRIX 6.2 sed, 8192 in IRIX 6.5). We also remove comment lines; - # the IRIX cc adds comments like '#:fec' to the end of the - # dependency line. - tr ' ' "$nl" < "$tmpdepfile" \ - | sed -e 's/^.*\.o://' -e 's/#.*$//' -e '/^$/ d' \ - | tr "$nl" ' ' >> "$depfile" - echo >> "$depfile" - # The second pass generates a dummy entry for each header file. - tr ' ' "$nl" < "$tmpdepfile" \ - | sed -e 's/^.*\.o://' -e 's/#.*$//' -e '/^$/ d' -e 's/$/:/' \ - >> "$depfile" - else - make_dummy_depfile - fi - rm -f "$tmpdepfile" - ;; - -xlc) - # This case exists only to let depend.m4 do its work. It works by - # looking at the text of this script. This case will never be run, - # since it is checked for above. - exit 1 - ;; - -aix) - # The C for AIX Compiler uses -M and outputs the dependencies - # in a .u file. In older versions, this file always lives in the - # current directory. Also, the AIX compiler puts '$object:' at the - # start of each line; $object doesn't have directory information. - # Version 6 uses the directory in both cases. - set_dir_from "$object" - set_base_from "$object" - if test "$libtool" = yes; then - tmpdepfile1=$dir$base.u - tmpdepfile2=$base.u - tmpdepfile3=$dir.libs/$base.u - "$@" -Wc,-M - else - tmpdepfile1=$dir$base.u - tmpdepfile2=$dir$base.u - tmpdepfile3=$dir$base.u - "$@" -M - fi - stat=$? - if test $stat -ne 0; then - rm -f "$tmpdepfile1" "$tmpdepfile2" "$tmpdepfile3" - exit $stat - fi - - for tmpdepfile in "$tmpdepfile1" "$tmpdepfile2" "$tmpdepfile3" - do - test -f "$tmpdepfile" && break - done - aix_post_process_depfile - ;; - -tcc) - # tcc (Tiny C Compiler) understand '-MD -MF file' since version 0.9.26 - # FIXME: That version still under development at the moment of writing. - # Make that this statement remains true also for stable, released - # versions. - # It will wrap lines (doesn't matter whether long or short) with a - # trailing '\', as in: - # - # foo.o : \ - # foo.c \ - # foo.h \ - # - # It will put a trailing '\' even on the last line, and will use leading - # spaces rather than leading tabs (at least since its commit 0394caf7 - # "Emit spaces for -MD"). - "$@" -MD -MF "$tmpdepfile" - stat=$? - if test $stat -ne 0; then - rm -f "$tmpdepfile" - exit $stat - fi - rm -f "$depfile" - # Each non-empty line is of the form 'foo.o : \' or ' dep.h \'. - # We have to change lines of the first kind to '$object: \'. - sed -e "s|.*:|$object :|" < "$tmpdepfile" > "$depfile" - # And for each line of the second kind, we have to emit a 'dep.h:' - # dummy dependency, to avoid the deleted-header problem. - sed -n -e 's|^ *\(.*\) *\\$|\1:|p' < "$tmpdepfile" >> "$depfile" - rm -f "$tmpdepfile" - ;; - -## The order of this option in the case statement is important, since the -## shell code in configure will try each of these formats in the order -## listed in this file. A plain '-MD' option would be understood by many -## compilers, so we must ensure this comes after the gcc and icc options. -pgcc) - # Portland's C compiler understands '-MD'. - # Will always output deps to 'file.d' where file is the root name of the - # source file under compilation, even if file resides in a subdirectory. - # The object file name does not affect the name of the '.d' file. - # pgcc 10.2 will output - # foo.o: sub/foo.c sub/foo.h - # and will wrap long lines using '\' : - # foo.o: sub/foo.c ... \ - # sub/foo.h ... \ - # ... - set_dir_from "$object" - # Use the source, not the object, to determine the base name, since - # that's sadly what pgcc will do too. - set_base_from "$source" - tmpdepfile=$base.d - - # For projects that build the same source file twice into different object - # files, the pgcc approach of using the *source* file root name can cause - # problems in parallel builds. Use a locking strategy to avoid stomping on - # the same $tmpdepfile. - lockdir=$base.d-lock - trap " - echo '$0: caught signal, cleaning up...' >&2 - rmdir '$lockdir' - exit 1 - " 1 2 13 15 - numtries=100 - i=$numtries - while test $i -gt 0; do - # mkdir is a portable test-and-set. - if mkdir "$lockdir" 2>/dev/null; then - # This process acquired the lock. - "$@" -MD - stat=$? - # Release the lock. - rmdir "$lockdir" - break - else - # If the lock is being held by a different process, wait - # until the winning process is done or we timeout. - while test -d "$lockdir" && test $i -gt 0; do - sleep 1 - i=`expr $i - 1` - done - fi - i=`expr $i - 1` - done - trap - 1 2 13 15 - if test $i -le 0; then - echo "$0: failed to acquire lock after $numtries attempts" >&2 - echo "$0: check lockdir '$lockdir'" >&2 - exit 1 - fi - - if test $stat -ne 0; then - rm -f "$tmpdepfile" - exit $stat - fi - rm -f "$depfile" - # Each line is of the form `foo.o: dependent.h', - # or `foo.o: dep1.h dep2.h \', or ` dep3.h dep4.h \'. - # Do two passes, one to just change these to - # `$object: dependent.h' and one to simply `dependent.h:'. - sed "s,^[^:]*:,$object :," < "$tmpdepfile" > "$depfile" - # Some versions of the HPUX 10.20 sed can't process this invocation - # correctly. Breaking it into two sed invocations is a workaround. - sed 's,^[^:]*: \(.*\)$,\1,;s/^\\$//;/^$/d;/:$/d' < "$tmpdepfile" \ - | sed -e 's/$/ :/' >> "$depfile" - rm -f "$tmpdepfile" - ;; - -hp2) - # The "hp" stanza above does not work with aCC (C++) and HP's ia64 - # compilers, which have integrated preprocessors. The correct option - # to use with these is +Maked; it writes dependencies to a file named - # 'foo.d', which lands next to the object file, wherever that - # happens to be. - # Much of this is similar to the tru64 case; see comments there. - set_dir_from "$object" - set_base_from "$object" - if test "$libtool" = yes; then - tmpdepfile1=$dir$base.d - tmpdepfile2=$dir.libs/$base.d - "$@" -Wc,+Maked - else - tmpdepfile1=$dir$base.d - tmpdepfile2=$dir$base.d - "$@" +Maked - fi - stat=$? - if test $stat -ne 0; then - rm -f "$tmpdepfile1" "$tmpdepfile2" - exit $stat - fi - - for tmpdepfile in "$tmpdepfile1" "$tmpdepfile2" - do - test -f "$tmpdepfile" && break - done - if test -f "$tmpdepfile"; then - sed -e "s,^.*\.[$lower]*:,$object:," "$tmpdepfile" > "$depfile" - # Add 'dependent.h:' lines. - sed -ne '2,${ - s/^ *// - s/ \\*$// - s/$/:/ - p - }' "$tmpdepfile" >> "$depfile" - else - make_dummy_depfile - fi - rm -f "$tmpdepfile" "$tmpdepfile2" - ;; - -tru64) - # The Tru64 compiler uses -MD to generate dependencies as a side - # effect. 'cc -MD -o foo.o ...' puts the dependencies into 'foo.o.d'. - # At least on Alpha/Redhat 6.1, Compaq CCC V6.2-504 seems to put - # dependencies in 'foo.d' instead, so we check for that too. - # Subdirectories are respected. - set_dir_from "$object" - set_base_from "$object" - - if test "$libtool" = yes; then - # Libtool generates 2 separate objects for the 2 libraries. These - # two compilations output dependencies in $dir.libs/$base.o.d and - # in $dir$base.o.d. We have to check for both files, because - # one of the two compilations can be disabled. We should prefer - # $dir$base.o.d over $dir.libs/$base.o.d because the latter is - # automatically cleaned when .libs/ is deleted, while ignoring - # the former would cause a distcleancheck panic. - tmpdepfile1=$dir$base.o.d # libtool 1.5 - tmpdepfile2=$dir.libs/$base.o.d # Likewise. - tmpdepfile3=$dir.libs/$base.d # Compaq CCC V6.2-504 - "$@" -Wc,-MD - else - tmpdepfile1=$dir$base.d - tmpdepfile2=$dir$base.d - tmpdepfile3=$dir$base.d - "$@" -MD - fi - - stat=$? - if test $stat -ne 0; then - rm -f "$tmpdepfile1" "$tmpdepfile2" "$tmpdepfile3" - exit $stat - fi - - for tmpdepfile in "$tmpdepfile1" "$tmpdepfile2" "$tmpdepfile3" - do - test -f "$tmpdepfile" && break - done - # Same post-processing that is required for AIX mode. - aix_post_process_depfile - ;; - -msvc7) - if test "$libtool" = yes; then - showIncludes=-Wc,-showIncludes - else - showIncludes=-showIncludes - fi - "$@" $showIncludes > "$tmpdepfile" - stat=$? - grep -v '^Note: including file: ' "$tmpdepfile" - if test $stat -ne 0; then - rm -f "$tmpdepfile" - exit $stat - fi - rm -f "$depfile" - echo "$object : \\" > "$depfile" - # The first sed program below extracts the file names and escapes - # backslashes for cygpath. The second sed program outputs the file - # name when reading, but also accumulates all include files in the - # hold buffer in order to output them again at the end. This only - # works with sed implementations that can handle large buffers. - sed < "$tmpdepfile" -n ' -/^Note: including file: *\(.*\)/ { - s//\1/ - s/\\/\\\\/g - p -}' | $cygpath_u | sort -u | sed -n ' -s/ /\\ /g -s/\(.*\)/'"$tab"'\1 \\/p -s/.\(.*\) \\/\1:/ -H -$ { - s/.*/'"$tab"'/ - G - p -}' >> "$depfile" - echo >> "$depfile" # make sure the fragment doesn't end with a backslash - rm -f "$tmpdepfile" - ;; - -msvc7msys) - # This case exists only to let depend.m4 do its work. It works by - # looking at the text of this script. This case will never be run, - # since it is checked for above. - exit 1 - ;; - -#nosideeffect) - # This comment above is used by automake to tell side-effect - # dependency tracking mechanisms from slower ones. - -dashmstdout) - # Important note: in order to support this mode, a compiler *must* - # always write the preprocessed file to stdout, regardless of -o. - "$@" || exit $? - - # Remove the call to Libtool. - if test "$libtool" = yes; then - while test "X$1" != 'X--mode=compile'; do - shift - done - shift - fi - - # Remove '-o $object'. - IFS=" " - for arg - do - case $arg in - -o) - shift - ;; - $object) - shift - ;; - *) - set fnord "$@" "$arg" - shift # fnord - shift # $arg - ;; - esac - done - - test -z "$dashmflag" && dashmflag=-M - # Require at least two characters before searching for ':' - # in the target name. This is to cope with DOS-style filenames: - # a dependency such as 'c:/foo/bar' could be seen as target 'c' otherwise. - "$@" $dashmflag | - sed "s|^[$tab ]*[^:$tab ][^:][^:]*:[$tab ]*|$object: |" > "$tmpdepfile" - rm -f "$depfile" - cat < "$tmpdepfile" > "$depfile" - # Some versions of the HPUX 10.20 sed can't process this sed invocation - # correctly. Breaking it into two sed invocations is a workaround. - tr ' ' "$nl" < "$tmpdepfile" \ - | sed -e 's/^\\$//' -e '/^$/d' -e '/:$/d' \ - | sed -e 's/$/ :/' >> "$depfile" - rm -f "$tmpdepfile" - ;; - -dashXmstdout) - # This case only exists to satisfy depend.m4. It is never actually - # run, as this mode is specially recognized in the preamble. - exit 1 - ;; - -makedepend) - "$@" || exit $? - # Remove any Libtool call - if test "$libtool" = yes; then - while test "X$1" != 'X--mode=compile'; do - shift - done - shift - fi - # X makedepend - shift - cleared=no eat=no - for arg - do - case $cleared in - no) - set ""; shift - cleared=yes ;; - esac - if test $eat = yes; then - eat=no - continue - fi - case "$arg" in - -D*|-I*) - set fnord "$@" "$arg"; shift ;; - # Strip any option that makedepend may not understand. Remove - # the object too, otherwise makedepend will parse it as a source file. - -arch) - eat=yes ;; - -*|$object) - ;; - *) - set fnord "$@" "$arg"; shift ;; - esac - done - obj_suffix=`echo "$object" | sed 's/^.*\././'` - touch "$tmpdepfile" - ${MAKEDEPEND-makedepend} -o"$obj_suffix" -f"$tmpdepfile" "$@" - rm -f "$depfile" - # makedepend may prepend the VPATH from the source file name to the object. - # No need to regex-escape $object, excess matching of '.' is harmless. - sed "s|^.*\($object *:\)|\1|" "$tmpdepfile" > "$depfile" - # Some versions of the HPUX 10.20 sed can't process the last invocation - # correctly. Breaking it into two sed invocations is a workaround. - sed '1,2d' "$tmpdepfile" \ - | tr ' ' "$nl" \ - | sed -e 's/^\\$//' -e '/^$/d' -e '/:$/d' \ - | sed -e 's/$/ :/' >> "$depfile" - rm -f "$tmpdepfile" "$tmpdepfile".bak - ;; - -cpp) - # Important note: in order to support this mode, a compiler *must* - # always write the preprocessed file to stdout. - "$@" || exit $? - - # Remove the call to Libtool. - if test "$libtool" = yes; then - while test "X$1" != 'X--mode=compile'; do - shift - done - shift - fi - - # Remove '-o $object'. - IFS=" " - for arg - do - case $arg in - -o) - shift - ;; - $object) - shift - ;; - *) - set fnord "$@" "$arg" - shift # fnord - shift # $arg - ;; - esac - done - - "$@" -E \ - | sed -n -e '/^# [0-9][0-9]* "\([^"]*\)".*/ s:: \1 \\:p' \ - -e '/^#line [0-9][0-9]* "\([^"]*\)".*/ s:: \1 \\:p' \ - | sed '$ s: \\$::' > "$tmpdepfile" - rm -f "$depfile" - echo "$object : \\" > "$depfile" - cat < "$tmpdepfile" >> "$depfile" - sed < "$tmpdepfile" '/^$/d;s/^ //;s/ \\$//;s/$/ :/' >> "$depfile" - rm -f "$tmpdepfile" - ;; - -msvisualcpp) - # Important note: in order to support this mode, a compiler *must* - # always write the preprocessed file to stdout. - "$@" || exit $? - - # Remove the call to Libtool. - if test "$libtool" = yes; then - while test "X$1" != 'X--mode=compile'; do - shift - done - shift - fi - - IFS=" " - for arg - do - case "$arg" in - -o) - shift - ;; - $object) - shift - ;; - "-Gm"|"/Gm"|"-Gi"|"/Gi"|"-ZI"|"/ZI") - set fnord "$@" - shift - shift - ;; - *) - set fnord "$@" "$arg" - shift - shift - ;; - esac - done - "$@" -E 2>/dev/null | - sed -n '/^#line [0-9][0-9]* "\([^"]*\)"/ s::\1:p' | $cygpath_u | sort -u > "$tmpdepfile" - rm -f "$depfile" - echo "$object : \\" > "$depfile" - sed < "$tmpdepfile" -n -e 's% %\\ %g' -e '/^\(.*\)$/ s::'"$tab"'\1 \\:p' >> "$depfile" - echo "$tab" >> "$depfile" - sed < "$tmpdepfile" -n -e 's% %\\ %g' -e '/^\(.*\)$/ s::\1\::p' >> "$depfile" - rm -f "$tmpdepfile" - ;; - -msvcmsys) - # This case exists only to let depend.m4 do its work. It works by - # looking at the text of this script. This case will never be run, - # since it is checked for above. - exit 1 - ;; - -none) - exec "$@" - ;; - -*) - echo "Unknown depmode $depmode" 1>&2 - exit 1 - ;; -esac - -exit 0 - -# Local Variables: -# mode: shell-script -# sh-indentation: 2 -# eval: (add-hook 'write-file-hooks 'time-stamp) -# time-stamp-start: "scriptversion=" -# time-stamp-format: "%:y-%02m-%02d.%02H" -# time-stamp-time-zone: "UTC0" -# time-stamp-end: "; # UTC" -# End: diff -Nru gnucobol-4.0~early~20200606/build_aux/install-sh gnucobol-5/build_aux/install-sh --- gnucobol-4.0~early~20200606/build_aux/install-sh 2020-06-06 20:52:02.000000000 +0000 +++ gnucobol-5/build_aux/install-sh 1970-01-01 00:00:00.000000000 +0000 @@ -1,518 +0,0 @@ -#!/bin/sh -# install - install a program, script, or datafile - -scriptversion=2018-03-11.20; # UTC - -# This originates from X11R5 (mit/util/scripts/install.sh), which was -# later released in X11R6 (xc/config/util/install.sh) with the -# following copyright and license. -# -# Copyright (C) 1994 X Consortium -# -# Permission is hereby granted, free of charge, to any person obtaining a copy -# of this software and associated documentation files (the "Software"), to -# deal in the Software without restriction, including without limitation the -# rights to use, copy, modify, merge, publish, distribute, sublicense, and/or -# sell copies of the Software, and to permit persons to whom the Software is -# furnished to do so, subject to the following conditions: -# -# The above copyright notice and this permission notice shall be included in -# all copies or substantial portions of the Software. -# -# THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR -# IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, -# FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE -# X CONSORTIUM BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN -# AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNEC- -# TION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. -# -# Except as contained in this notice, the name of the X Consortium shall not -# be used in advertising or otherwise to promote the sale, use or other deal- -# ings in this Software without prior written authorization from the X Consor- -# tium. -# -# -# FSF changes to this file are in the public domain. -# -# Calling this script install-sh is preferred over install.sh, to prevent -# 'make' implicit rules from creating a file called install from it -# when there is no Makefile. -# -# This script is compatible with the BSD install script, but was written -# from scratch. - -tab=' ' -nl=' -' -IFS=" $tab$nl" - -# Set DOITPROG to "echo" to test this script. - -doit=${DOITPROG-} -doit_exec=${doit:-exec} - -# Put in absolute file names if you don't have them in your path; -# or use environment vars. - -chgrpprog=${CHGRPPROG-chgrp} -chmodprog=${CHMODPROG-chmod} -chownprog=${CHOWNPROG-chown} -cmpprog=${CMPPROG-cmp} -cpprog=${CPPROG-cp} -mkdirprog=${MKDIRPROG-mkdir} -mvprog=${MVPROG-mv} -rmprog=${RMPROG-rm} -stripprog=${STRIPPROG-strip} - -posix_mkdir= - -# Desired mode of installed file. -mode=0755 - -chgrpcmd= -chmodcmd=$chmodprog -chowncmd= -mvcmd=$mvprog -rmcmd="$rmprog -f" -stripcmd= - -src= -dst= -dir_arg= -dst_arg= - -copy_on_change=false -is_target_a_directory=possibly - -usage="\ -Usage: $0 [OPTION]... [-T] SRCFILE DSTFILE - or: $0 [OPTION]... SRCFILES... DIRECTORY - or: $0 [OPTION]... -t DIRECTORY SRCFILES... - or: $0 [OPTION]... -d DIRECTORIES... - -In the 1st form, copy SRCFILE to DSTFILE. -In the 2nd and 3rd, copy all SRCFILES to DIRECTORY. -In the 4th, create DIRECTORIES. - -Options: - --help display this help and exit. - --version display version info and exit. - - -c (ignored) - -C install only if different (preserve the last data modification time) - -d create directories instead of installing files. - -g GROUP $chgrpprog installed files to GROUP. - -m MODE $chmodprog installed files to MODE. - -o USER $chownprog installed files to USER. - -s $stripprog installed files. - -t DIRECTORY install into DIRECTORY. - -T report an error if DSTFILE is a directory. - -Environment variables override the default commands: - CHGRPPROG CHMODPROG CHOWNPROG CMPPROG CPPROG MKDIRPROG MVPROG - RMPROG STRIPPROG -" - -while test $# -ne 0; do - case $1 in - -c) ;; - - -C) copy_on_change=true;; - - -d) dir_arg=true;; - - -g) chgrpcmd="$chgrpprog $2" - shift;; - - --help) echo "$usage"; exit $?;; - - -m) mode=$2 - case $mode in - *' '* | *"$tab"* | *"$nl"* | *'*'* | *'?'* | *'['*) - echo "$0: invalid mode: $mode" >&2 - exit 1;; - esac - shift;; - - -o) chowncmd="$chownprog $2" - shift;; - - -s) stripcmd=$stripprog;; - - -t) - is_target_a_directory=always - dst_arg=$2 - # Protect names problematic for 'test' and other utilities. - case $dst_arg in - -* | [=\(\)!]) dst_arg=./$dst_arg;; - esac - shift;; - - -T) is_target_a_directory=never;; - - --version) echo "$0 $scriptversion"; exit $?;; - - --) shift - break;; - - -*) echo "$0: invalid option: $1" >&2 - exit 1;; - - *) break;; - esac - shift -done - -# We allow the use of options -d and -T together, by making -d -# take the precedence; this is for compatibility with GNU install. - -if test -n "$dir_arg"; then - if test -n "$dst_arg"; then - echo "$0: target directory not allowed when installing a directory." >&2 - exit 1 - fi -fi - -if test $# -ne 0 && test -z "$dir_arg$dst_arg"; then - # When -d is used, all remaining arguments are directories to create. - # When -t is used, the destination is already specified. - # Otherwise, the last argument is the destination. Remove it from $@. - for arg - do - if test -n "$dst_arg"; then - # $@ is not empty: it contains at least $arg. - set fnord "$@" "$dst_arg" - shift # fnord - fi - shift # arg - dst_arg=$arg - # Protect names problematic for 'test' and other utilities. - case $dst_arg in - -* | [=\(\)!]) dst_arg=./$dst_arg;; - esac - done -fi - -if test $# -eq 0; then - if test -z "$dir_arg"; then - echo "$0: no input file specified." >&2 - exit 1 - fi - # It's OK to call 'install-sh -d' without argument. - # This can happen when creating conditional directories. - exit 0 -fi - -if test -z "$dir_arg"; then - if test $# -gt 1 || test "$is_target_a_directory" = always; then - if test ! -d "$dst_arg"; then - echo "$0: $dst_arg: Is not a directory." >&2 - exit 1 - fi - fi -fi - -if test -z "$dir_arg"; then - do_exit='(exit $ret); exit $ret' - trap "ret=129; $do_exit" 1 - trap "ret=130; $do_exit" 2 - trap "ret=141; $do_exit" 13 - trap "ret=143; $do_exit" 15 - - # Set umask so as not to create temps with too-generous modes. - # However, 'strip' requires both read and write access to temps. - case $mode in - # Optimize common cases. - *644) cp_umask=133;; - *755) cp_umask=22;; - - *[0-7]) - if test -z "$stripcmd"; then - u_plus_rw= - else - u_plus_rw='% 200' - fi - cp_umask=`expr '(' 777 - $mode % 1000 ')' $u_plus_rw`;; - *) - if test -z "$stripcmd"; then - u_plus_rw= - else - u_plus_rw=,u+rw - fi - cp_umask=$mode$u_plus_rw;; - esac -fi - -for src -do - # Protect names problematic for 'test' and other utilities. - case $src in - -* | [=\(\)!]) src=./$src;; - esac - - if test -n "$dir_arg"; then - dst=$src - dstdir=$dst - test -d "$dstdir" - dstdir_status=$? - else - - # Waiting for this to be detected by the "$cpprog $src $dsttmp" command - # might cause directories to be created, which would be especially bad - # if $src (and thus $dsttmp) contains '*'. - if test ! -f "$src" && test ! -d "$src"; then - echo "$0: $src does not exist." >&2 - exit 1 - fi - - if test -z "$dst_arg"; then - echo "$0: no destination specified." >&2 - exit 1 - fi - dst=$dst_arg - - # If destination is a directory, append the input filename. - if test -d "$dst"; then - if test "$is_target_a_directory" = never; then - echo "$0: $dst_arg: Is a directory" >&2 - exit 1 - fi - dstdir=$dst - dstbase=`basename "$src"` - case $dst in - */) dst=$dst$dstbase;; - *) dst=$dst/$dstbase;; - esac - dstdir_status=0 - else - dstdir=`dirname "$dst"` - test -d "$dstdir" - dstdir_status=$? - fi - fi - - case $dstdir in - */) dstdirslash=$dstdir;; - *) dstdirslash=$dstdir/;; - esac - - obsolete_mkdir_used=false - - if test $dstdir_status != 0; then - case $posix_mkdir in - '') - # Create intermediate dirs using mode 755 as modified by the umask. - # This is like FreeBSD 'install' as of 1997-10-28. - umask=`umask` - case $stripcmd.$umask in - # Optimize common cases. - *[2367][2367]) mkdir_umask=$umask;; - .*0[02][02] | .[02][02] | .[02]) mkdir_umask=22;; - - *[0-7]) - mkdir_umask=`expr $umask + 22 \ - - $umask % 100 % 40 + $umask % 20 \ - - $umask % 10 % 4 + $umask % 2 - `;; - *) mkdir_umask=$umask,go-w;; - esac - - # With -d, create the new directory with the user-specified mode. - # Otherwise, rely on $mkdir_umask. - if test -n "$dir_arg"; then - mkdir_mode=-m$mode - else - mkdir_mode= - fi - - posix_mkdir=false - case $umask in - *[123567][0-7][0-7]) - # POSIX mkdir -p sets u+wx bits regardless of umask, which - # is incompatible with FreeBSD 'install' when (umask & 300) != 0. - ;; - *) - # Note that $RANDOM variable is not portable (e.g. dash); Use it - # here however when possible just to lower collision chance. - tmpdir=${TMPDIR-/tmp}/ins$RANDOM-$$ - - trap 'ret=$?; rmdir "$tmpdir/a/b" "$tmpdir/a" "$tmpdir" 2>/dev/null; exit $ret' 0 - - # Because "mkdir -p" follows existing symlinks and we likely work - # directly in world-writeable /tmp, make sure that the '$tmpdir' - # directory is successfully created first before we actually test - # 'mkdir -p' feature. - if (umask $mkdir_umask && - $mkdirprog $mkdir_mode "$tmpdir" && - exec $mkdirprog $mkdir_mode -p -- "$tmpdir/a/b") >/dev/null 2>&1 - then - if test -z "$dir_arg" || { - # Check for POSIX incompatibilities with -m. - # HP-UX 11.23 and IRIX 6.5 mkdir -m -p sets group- or - # other-writable bit of parent directory when it shouldn't. - # FreeBSD 6.1 mkdir -m -p sets mode of existing directory. - test_tmpdir="$tmpdir/a" - ls_ld_tmpdir=`ls -ld "$test_tmpdir"` - case $ls_ld_tmpdir in - d????-?r-*) different_mode=700;; - d????-?--*) different_mode=755;; - *) false;; - esac && - $mkdirprog -m$different_mode -p -- "$test_tmpdir" && { - ls_ld_tmpdir_1=`ls -ld "$test_tmpdir"` - test "$ls_ld_tmpdir" = "$ls_ld_tmpdir_1" - } - } - then posix_mkdir=: - fi - rmdir "$tmpdir/a/b" "$tmpdir/a" "$tmpdir" - else - # Remove any dirs left behind by ancient mkdir implementations. - rmdir ./$mkdir_mode ./-p ./-- "$tmpdir" 2>/dev/null - fi - trap '' 0;; - esac;; - esac - - if - $posix_mkdir && ( - umask $mkdir_umask && - $doit_exec $mkdirprog $mkdir_mode -p -- "$dstdir" - ) - then : - else - - # The umask is ridiculous, or mkdir does not conform to POSIX, - # or it failed possibly due to a race condition. Create the - # directory the slow way, step by step, checking for races as we go. - - case $dstdir in - /*) prefix='/';; - [-=\(\)!]*) prefix='./';; - *) prefix='';; - esac - - oIFS=$IFS - IFS=/ - set -f - set fnord $dstdir - shift - set +f - IFS=$oIFS - - prefixes= - - for d - do - test X"$d" = X && continue - - prefix=$prefix$d - if test -d "$prefix"; then - prefixes= - else - if $posix_mkdir; then - (umask=$mkdir_umask && - $doit_exec $mkdirprog $mkdir_mode -p -- "$dstdir") && break - # Don't fail if two instances are running concurrently. - test -d "$prefix" || exit 1 - else - case $prefix in - *\'*) qprefix=`echo "$prefix" | sed "s/'/'\\\\\\\\''/g"`;; - *) qprefix=$prefix;; - esac - prefixes="$prefixes '$qprefix'" - fi - fi - prefix=$prefix/ - done - - if test -n "$prefixes"; then - # Don't fail if two instances are running concurrently. - (umask $mkdir_umask && - eval "\$doit_exec \$mkdirprog $prefixes") || - test -d "$dstdir" || exit 1 - obsolete_mkdir_used=true - fi - fi - fi - - if test -n "$dir_arg"; then - { test -z "$chowncmd" || $doit $chowncmd "$dst"; } && - { test -z "$chgrpcmd" || $doit $chgrpcmd "$dst"; } && - { test "$obsolete_mkdir_used$chowncmd$chgrpcmd" = false || - test -z "$chmodcmd" || $doit $chmodcmd $mode "$dst"; } || exit 1 - else - - # Make a couple of temp file names in the proper directory. - dsttmp=${dstdirslash}_inst.$$_ - rmtmp=${dstdirslash}_rm.$$_ - - # Trap to clean up those temp files at exit. - trap 'ret=$?; rm -f "$dsttmp" "$rmtmp" && exit $ret' 0 - - # Copy the file name to the temp name. - (umask $cp_umask && $doit_exec $cpprog "$src" "$dsttmp") && - - # and set any options; do chmod last to preserve setuid bits. - # - # If any of these fail, we abort the whole thing. If we want to - # ignore errors from any of these, just make sure not to ignore - # errors from the above "$doit $cpprog $src $dsttmp" command. - # - { test -z "$chowncmd" || $doit $chowncmd "$dsttmp"; } && - { test -z "$chgrpcmd" || $doit $chgrpcmd "$dsttmp"; } && - { test -z "$stripcmd" || $doit $stripcmd "$dsttmp"; } && - { test -z "$chmodcmd" || $doit $chmodcmd $mode "$dsttmp"; } && - - # If -C, don't bother to copy if it wouldn't change the file. - if $copy_on_change && - old=`LC_ALL=C ls -dlL "$dst" 2>/dev/null` && - new=`LC_ALL=C ls -dlL "$dsttmp" 2>/dev/null` && - set -f && - set X $old && old=:$2:$4:$5:$6 && - set X $new && new=:$2:$4:$5:$6 && - set +f && - test "$old" = "$new" && - $cmpprog "$dst" "$dsttmp" >/dev/null 2>&1 - then - rm -f "$dsttmp" - else - # Rename the file to the real destination. - $doit $mvcmd -f "$dsttmp" "$dst" 2>/dev/null || - - # The rename failed, perhaps because mv can't rename something else - # to itself, or perhaps because mv is so ancient that it does not - # support -f. - { - # Now remove or move aside any old file at destination location. - # We try this two ways since rm can't unlink itself on some - # systems and the destination file might be busy for other - # reasons. In this case, the final cleanup might fail but the new - # file should still install successfully. - { - test ! -f "$dst" || - $doit $rmcmd -f "$dst" 2>/dev/null || - { $doit $mvcmd -f "$dst" "$rmtmp" 2>/dev/null && - { $doit $rmcmd -f "$rmtmp" 2>/dev/null; :; } - } || - { echo "$0: cannot unlink or rename $dst" >&2 - (exit 1); exit 1 - } - } && - - # Now rename the file to the real destination. - $doit $mvcmd "$dsttmp" "$dst" - } - fi || exit 1 - - trap '' 0 - fi -done - -# Local variables: -# eval: (add-hook 'before-save-hook 'time-stamp) -# time-stamp-start: "scriptversion=" -# time-stamp-format: "%:y-%02m-%02d.%02H" -# time-stamp-time-zone: "UTC0" -# time-stamp-end: "; # UTC" -# End: diff -Nru gnucobol-4.0~early~20200606/build_aux/ltmain.sh gnucobol-5/build_aux/ltmain.sh --- gnucobol-4.0~early~20200606/build_aux/ltmain.sh 2020-06-06 20:52:02.000000000 +0000 +++ gnucobol-5/build_aux/ltmain.sh 1970-01-01 00:00:00.000000000 +0000 @@ -1,11147 +0,0 @@ -#! /bin/sh -## DO NOT EDIT - This file generated from ./build-aux/ltmain.in -## by inline-source v2014-01-03.01 - -# libtool (GNU libtool) 2.4.6 -# Provide generalized library-building support services. -# Written by Gordon Matzigkeit , 1996 - -# Copyright (C) 1996-2015, 2018 Free Software Foundation, Inc. -# This is free software; see the source for copying conditions. There is NO -# warranty; not even for MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. - -# GNU Libtool is free software; you can redistribute it and/or modify -# it under the terms of the GNU General Public License as published by -# the Free Software Foundation; either version 2 of the License, or -# (at your option) any later version. -# -# As a special exception to the GNU General Public License, -# if you distribute this file as part of a program or library that -# is built using GNU Libtool, you may include this file under the -# same distribution terms that you use for the rest of that program. -# -# GNU Libtool is distributed in the hope that it will be useful, but -# WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU -# General Public License for more details. -# -# You should have received a copy of the GNU General Public License -# along with this program. If not, see . - - -PROGRAM=libtool -PACKAGE=libtool -VERSION=2.4.6 -package_revision=2.4.6 - - -## ------ ## -## Usage. ## -## ------ ## - -# Run './libtool --help' for help with using this script from the -# command line. - - -## ------------------------------- ## -## User overridable command paths. ## -## ------------------------------- ## - -# After configure completes, it has a better idea of some of the -# shell tools we need than the defaults used by the functions shared -# with bootstrap, so set those here where they can still be over- -# ridden by the user, but otherwise take precedence. - -: ${AUTOCONF="autoconf"} -: ${AUTOMAKE="automake"} - - -## -------------------------- ## -## Source external libraries. ## -## -------------------------- ## - -# Much of our low-level functionality needs to be sourced from external -# libraries, which are installed to $pkgauxdir. - -# Set a version string for this script. -scriptversion=2015-01-20.17; # UTC - -# General shell script boiler plate, and helper functions. -# Written by Gary V. Vaughan, 2004 - -# Copyright (C) 2004-2015 Free Software Foundation, Inc. -# This is free software; see the source for copying conditions. There is NO -# warranty; not even for MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. - -# This program is free software; you can redistribute it and/or modify -# it under the terms of the GNU General Public License as published by -# the Free Software Foundation; either version 3 of the License, or -# (at your option) any later version. - -# As a special exception to the GNU General Public License, if you distribute -# this file as part of a program or library that is built using GNU Libtool, -# you may include this file under the same distribution terms that you use -# for the rest of that program. - -# This program is distributed in the hope that it will be useful, -# but WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNES FOR A PARTICULAR PURPOSE. See the GNU -# General Public License for more details. - -# You should have received a copy of the GNU General Public License -# along with this program. If not, see . - -# Please report bugs or propose patches to gary@gnu.org. - - -## ------ ## -## Usage. ## -## ------ ## - -# Evaluate this file near the top of your script to gain access to -# the functions and variables defined here: -# -# . `echo "$0" | ${SED-sed} 's|[^/]*$||'`/build-aux/funclib.sh -# -# If you need to override any of the default environment variable -# settings, do that before evaluating this file. - - -## -------------------- ## -## Shell normalisation. ## -## -------------------- ## - -# Some shells need a little help to be as Bourne compatible as possible. -# Before doing anything else, make sure all that help has been provided! - -DUALCASE=1; export DUALCASE # for MKS sh -if test -n "${ZSH_VERSION+set}" && (emulate sh) >/dev/null 2>&1; then : - emulate sh - NULLCMD=: - # Pre-4.2 versions of Zsh do word splitting on ${1+"$@"}, which - # is contrary to our usage. Disable this feature. - alias -g '${1+"$@"}'='"$@"' - setopt NO_GLOB_SUBST -else - case `(set -o) 2>/dev/null` in *posix*) set -o posix ;; esac -fi - -# NLS nuisances: We save the old values in case they are required later. -_G_user_locale= -_G_safe_locale= -for _G_var in LANG LANGUAGE LC_ALL LC_CTYPE LC_COLLATE LC_MESSAGES -do - eval "if test set = \"\${$_G_var+set}\"; then - save_$_G_var=\$$_G_var - $_G_var=C - export $_G_var - _G_user_locale=\"$_G_var=\\\$save_\$_G_var; \$_G_user_locale\" - _G_safe_locale=\"$_G_var=C; \$_G_safe_locale\" - fi" -done - -# CDPATH. -(unset CDPATH) >/dev/null 2>&1 && unset CDPATH - -# Make sure IFS has a sensible default -sp=' ' -nl=' -' -IFS="$sp $nl" - -# There are apparently some retarded systems that use ';' as a PATH separator! -if test "${PATH_SEPARATOR+set}" != set; then - PATH_SEPARATOR=: - (PATH='/bin;/bin'; FPATH=$PATH; sh -c :) >/dev/null 2>&1 && { - (PATH='/bin:/bin'; FPATH=$PATH; sh -c :) >/dev/null 2>&1 || - PATH_SEPARATOR=';' - } -fi - - - -## ------------------------- ## -## Locate command utilities. ## -## ------------------------- ## - - -# func_executable_p FILE -# ---------------------- -# Check that FILE is an executable regular file. -func_executable_p () -{ - test -f "$1" && test -x "$1" -} - - -# func_path_progs PROGS_LIST CHECK_FUNC [PATH] -# -------------------------------------------- -# Search for either a program that responds to --version with output -# containing "GNU", or else returned by CHECK_FUNC otherwise, by -# trying all the directories in PATH with each of the elements of -# PROGS_LIST. -# -# CHECK_FUNC should accept the path to a candidate program, and -# set $func_check_prog_result if it truncates its output less than -# $_G_path_prog_max characters. -func_path_progs () -{ - _G_progs_list=$1 - _G_check_func=$2 - _G_PATH=${3-"$PATH"} - - _G_path_prog_max=0 - _G_path_prog_found=false - _G_save_IFS=$IFS; IFS=${PATH_SEPARATOR-:} - for _G_dir in $_G_PATH; do - IFS=$_G_save_IFS - test -z "$_G_dir" && _G_dir=. - for _G_prog_name in $_G_progs_list; do - for _exeext in '' .EXE; do - _G_path_prog=$_G_dir/$_G_prog_name$_exeext - func_executable_p "$_G_path_prog" || continue - case `"$_G_path_prog" --version 2>&1` in - *GNU*) func_path_progs_result=$_G_path_prog _G_path_prog_found=: ;; - *) $_G_check_func $_G_path_prog - func_path_progs_result=$func_check_prog_result - ;; - esac - $_G_path_prog_found && break 3 - done - done - done - IFS=$_G_save_IFS - test -z "$func_path_progs_result" && { - echo "no acceptable sed could be found in \$PATH" >&2 - exit 1 - } -} - - -# We want to be able to use the functions in this file before configure -# has figured out where the best binaries are kept, which means we have -# to search for them ourselves - except when the results are already set -# where we skip the searches. - -# Unless the user overrides by setting SED, search the path for either GNU -# sed, or the sed that truncates its output the least. -test -z "$SED" && { - _G_sed_script=s/aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa/bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb/ - for _G_i in 1 2 3 4 5 6 7; do - _G_sed_script=$_G_sed_script$nl$_G_sed_script - done - echo "$_G_sed_script" 2>/dev/null | sed 99q >conftest.sed - _G_sed_script= - - func_check_prog_sed () - { - _G_path_prog=$1 - - _G_count=0 - printf 0123456789 >conftest.in - while : - do - cat conftest.in conftest.in >conftest.tmp - mv conftest.tmp conftest.in - cp conftest.in conftest.nl - echo '' >> conftest.nl - "$_G_path_prog" -f conftest.sed conftest.out 2>/dev/null || break - diff conftest.out conftest.nl >/dev/null 2>&1 || break - _G_count=`expr $_G_count + 1` - if test "$_G_count" -gt "$_G_path_prog_max"; then - # Best one so far, save it but keep looking for a better one - func_check_prog_result=$_G_path_prog - _G_path_prog_max=$_G_count - fi - # 10*(2^10) chars as input seems more than enough - test 10 -lt "$_G_count" && break - done - rm -f conftest.in conftest.tmp conftest.nl conftest.out - } - - func_path_progs "sed gsed" func_check_prog_sed $PATH:/usr/xpg4/bin - rm -f conftest.sed - SED=$func_path_progs_result -} - - -# Unless the user overrides by setting GREP, search the path for either GNU -# grep, or the grep that truncates its output the least. -test -z "$GREP" && { - func_check_prog_grep () - { - _G_path_prog=$1 - - _G_count=0 - _G_path_prog_max=0 - printf 0123456789 >conftest.in - while : - do - cat conftest.in conftest.in >conftest.tmp - mv conftest.tmp conftest.in - cp conftest.in conftest.nl - echo 'GREP' >> conftest.nl - "$_G_path_prog" -e 'GREP$' -e '-(cannot match)-' conftest.out 2>/dev/null || break - diff conftest.out conftest.nl >/dev/null 2>&1 || break - _G_count=`expr $_G_count + 1` - if test "$_G_count" -gt "$_G_path_prog_max"; then - # Best one so far, save it but keep looking for a better one - func_check_prog_result=$_G_path_prog - _G_path_prog_max=$_G_count - fi - # 10*(2^10) chars as input seems more than enough - test 10 -lt "$_G_count" && break - done - rm -f conftest.in conftest.tmp conftest.nl conftest.out - } - - func_path_progs "grep ggrep" func_check_prog_grep $PATH:/usr/xpg4/bin - GREP=$func_path_progs_result -} - - -## ------------------------------- ## -## User overridable command paths. ## -## ------------------------------- ## - -# All uppercase variable names are used for environment variables. These -# variables can be overridden by the user before calling a script that -# uses them if a suitable command of that name is not already available -# in the command search PATH. - -: ${CP="cp -f"} -: ${ECHO="printf %s\n"} -: ${EGREP="$GREP -E"} -: ${FGREP="$GREP -F"} -: ${LN_S="ln -s"} -: ${MAKE="make"} -: ${MKDIR="mkdir"} -: ${MV="mv -f"} -: ${RM="rm -f"} -: ${SHELL="${CONFIG_SHELL-/bin/sh}"} - - -## -------------------- ## -## Useful sed snippets. ## -## -------------------- ## - -sed_dirname='s|/[^/]*$||' -sed_basename='s|^.*/||' - -# Sed substitution that helps us do robust quoting. It backslashifies -# metacharacters that are still active within double-quoted strings. -sed_quote_subst='s|\([`"$\\]\)|\\\1|g' - -# Same as above, but do not quote variable references. -sed_double_quote_subst='s/\(["`\\]\)/\\\1/g' - -# Sed substitution that turns a string into a regex matching for the -# string literally. -sed_make_literal_regex='s|[].[^$\\*\/]|\\&|g' - -# Sed substitution that converts a w32 file name or path -# that contains forward slashes, into one that contains -# (escaped) backslashes. A very naive implementation. -sed_naive_backslashify='s|\\\\*|\\|g;s|/|\\|g;s|\\|\\\\|g' - -# Re-'\' parameter expansions in output of sed_double_quote_subst that -# were '\'-ed in input to the same. If an odd number of '\' preceded a -# '$' in input to sed_double_quote_subst, that '$' was protected from -# expansion. Since each input '\' is now two '\'s, look for any number -# of runs of four '\'s followed by two '\'s and then a '$'. '\' that '$'. -_G_bs='\\' -_G_bs2='\\\\' -_G_bs4='\\\\\\\\' -_G_dollar='\$' -sed_double_backslash="\ - s/$_G_bs4/&\\ -/g - s/^$_G_bs2$_G_dollar/$_G_bs&/ - s/\\([^$_G_bs]\\)$_G_bs2$_G_dollar/\\1$_G_bs2$_G_bs$_G_dollar/g - s/\n//g" - - -## ----------------- ## -## Global variables. ## -## ----------------- ## - -# Except for the global variables explicitly listed below, the following -# functions in the '^func_' namespace, and the '^require_' namespace -# variables initialised in the 'Resource management' section, sourcing -# this file will not pollute your global namespace with anything -# else. There's no portable way to scope variables in Bourne shell -# though, so actually running these functions will sometimes place -# results into a variable named after the function, and often use -# temporary variables in the '^_G_' namespace. If you are careful to -# avoid using those namespaces casually in your sourcing script, things -# should continue to work as you expect. And, of course, you can freely -# overwrite any of the functions or variables defined here before -# calling anything to customize them. - -EXIT_SUCCESS=0 -EXIT_FAILURE=1 -EXIT_MISMATCH=63 # $? = 63 is used to indicate version mismatch to missing. -EXIT_SKIP=77 # $? = 77 is used to indicate a skipped test to automake. - -# Allow overriding, eg assuming that you follow the convention of -# putting '$debug_cmd' at the start of all your functions, you can get -# bash to show function call trace with: -# -# debug_cmd='eval echo "${FUNCNAME[0]} $*" >&2' bash your-script-name -debug_cmd=${debug_cmd-":"} -exit_cmd=: - -# By convention, finish your script with: -# -# exit $exit_status -# -# so that you can set exit_status to non-zero if you want to indicate -# something went wrong during execution without actually bailing out at -# the point of failure. -exit_status=$EXIT_SUCCESS - -# Work around backward compatibility issue on IRIX 6.5. On IRIX 6.4+, sh -# is ksh but when the shell is invoked as "sh" and the current value of -# the _XPG environment variable is not equal to 1 (one), the special -# positional parameter $0, within a function call, is the name of the -# function. -progpath=$0 - -# The name of this program. -progname=`$ECHO "$progpath" |$SED "$sed_basename"` - -# Make sure we have an absolute progpath for reexecution: -case $progpath in - [\\/]*|[A-Za-z]:\\*) ;; - *[\\/]*) - progdir=`$ECHO "$progpath" |$SED "$sed_dirname"` - progdir=`cd "$progdir" && pwd` - progpath=$progdir/$progname - ;; - *) - _G_IFS=$IFS - IFS=${PATH_SEPARATOR-:} - for progdir in $PATH; do - IFS=$_G_IFS - test -x "$progdir/$progname" && break - done - IFS=$_G_IFS - test -n "$progdir" || progdir=`pwd` - progpath=$progdir/$progname - ;; -esac - - -## ----------------- ## -## Standard options. ## -## ----------------- ## - -# The following options affect the operation of the functions defined -# below, and should be set appropriately depending on run-time para- -# meters passed on the command line. - -opt_dry_run=false -opt_quiet=false -opt_verbose=false - -# Categories 'all' and 'none' are always available. Append any others -# you will pass as the first argument to func_warning from your own -# code. -warning_categories= - -# By default, display warnings according to 'opt_warning_types'. Set -# 'warning_func' to ':' to elide all warnings, or func_fatal_error to -# treat the next displayed warning as a fatal error. -warning_func=func_warn_and_continue - -# Set to 'all' to display all warnings, 'none' to suppress all -# warnings, or a space delimited list of some subset of -# 'warning_categories' to display only the listed warnings. -opt_warning_types=all - - -## -------------------- ## -## Resource management. ## -## -------------------- ## - -# This section contains definitions for functions that each ensure a -# particular resource (a file, or a non-empty configuration variable for -# example) is available, and if appropriate to extract default values -# from pertinent package files. Call them using their associated -# 'require_*' variable to ensure that they are executed, at most, once. -# -# It's entirely deliberate that calling these functions can set -# variables that don't obey the namespace limitations obeyed by the rest -# of this file, in order that that they be as useful as possible to -# callers. - - -# require_term_colors -# ------------------- -# Allow display of bold text on terminals that support it. -require_term_colors=func_require_term_colors -func_require_term_colors () -{ - $debug_cmd - - test -t 1 && { - # COLORTERM and USE_ANSI_COLORS environment variables take - # precedence, because most terminfo databases neglect to describe - # whether color sequences are supported. - test -n "${COLORTERM+set}" && : ${USE_ANSI_COLORS="1"} - - if test 1 = "$USE_ANSI_COLORS"; then - # Standard ANSI escape sequences - tc_reset='' - tc_bold=''; tc_standout='' - tc_red=''; tc_green='' - tc_blue=''; tc_cyan='' - else - # Otherwise trust the terminfo database after all. - test -n "`tput sgr0 2>/dev/null`" && { - tc_reset=`tput sgr0` - test -n "`tput bold 2>/dev/null`" && tc_bold=`tput bold` - tc_standout=$tc_bold - test -n "`tput smso 2>/dev/null`" && tc_standout=`tput smso` - test -n "`tput setaf 1 2>/dev/null`" && tc_red=`tput setaf 1` - test -n "`tput setaf 2 2>/dev/null`" && tc_green=`tput setaf 2` - test -n "`tput setaf 4 2>/dev/null`" && tc_blue=`tput setaf 4` - test -n "`tput setaf 5 2>/dev/null`" && tc_cyan=`tput setaf 5` - } - fi - } - - require_term_colors=: -} - - -## ----------------- ## -## Function library. ## -## ----------------- ## - -# This section contains a variety of useful functions to call in your -# scripts. Take note of the portable wrappers for features provided by -# some modern shells, which will fall back to slower equivalents on -# less featureful shells. - - -# func_append VAR VALUE -# --------------------- -# Append VALUE onto the existing contents of VAR. - - # We should try to minimise forks, especially on Windows where they are - # unreasonably slow, so skip the feature probes when bash or zsh are - # being used: - if test set = "${BASH_VERSION+set}${ZSH_VERSION+set}"; then - : ${_G_HAVE_ARITH_OP="yes"} - : ${_G_HAVE_XSI_OPS="yes"} - # The += operator was introduced in bash 3.1 - case $BASH_VERSION in - [12].* | 3.0 | 3.0*) ;; - *) - : ${_G_HAVE_PLUSEQ_OP="yes"} - ;; - esac - fi - - # _G_HAVE_PLUSEQ_OP - # Can be empty, in which case the shell is probed, "yes" if += is - # useable or anything else if it does not work. - test -z "$_G_HAVE_PLUSEQ_OP" \ - && (eval 'x=a; x+=" b"; test "a b" = "$x"') 2>/dev/null \ - && _G_HAVE_PLUSEQ_OP=yes - -if test yes = "$_G_HAVE_PLUSEQ_OP" -then - # This is an XSI compatible shell, allowing a faster implementation... - eval 'func_append () - { - $debug_cmd - - eval "$1+=\$2" - }' -else - # ...otherwise fall back to using expr, which is often a shell builtin. - func_append () - { - $debug_cmd - - eval "$1=\$$1\$2" - } -fi - - -# func_append_quoted VAR VALUE -# ---------------------------- -# Quote VALUE and append to the end of shell variable VAR, separated -# by a space. -if test yes = "$_G_HAVE_PLUSEQ_OP"; then - eval 'func_append_quoted () - { - $debug_cmd - - func_quote_for_eval "$2" - eval "$1+=\\ \$func_quote_for_eval_result" - }' -else - func_append_quoted () - { - $debug_cmd - - func_quote_for_eval "$2" - eval "$1=\$$1\\ \$func_quote_for_eval_result" - } -fi - - -# func_append_uniq VAR VALUE -# -------------------------- -# Append unique VALUE onto the existing contents of VAR, assuming -# entries are delimited by the first character of VALUE. For example: -# -# func_append_uniq options " --another-option option-argument" -# -# will only append to $options if " --another-option option-argument " -# is not already present somewhere in $options already (note spaces at -# each end implied by leading space in second argument). -func_append_uniq () -{ - $debug_cmd - - eval _G_current_value='`$ECHO $'$1'`' - _G_delim=`expr "$2" : '\(.\)'` - - case $_G_delim$_G_current_value$_G_delim in - *"$2$_G_delim"*) ;; - *) func_append "$@" ;; - esac -} - - -# func_arith TERM... -# ------------------ -# Set func_arith_result to the result of evaluating TERMs. - test -z "$_G_HAVE_ARITH_OP" \ - && (eval 'test 2 = $(( 1 + 1 ))') 2>/dev/null \ - && _G_HAVE_ARITH_OP=yes - -if test yes = "$_G_HAVE_ARITH_OP"; then - eval 'func_arith () - { - $debug_cmd - - func_arith_result=$(( $* )) - }' -else - func_arith () - { - $debug_cmd - - func_arith_result=`expr "$@"` - } -fi - - -# func_basename FILE -# ------------------ -# Set func_basename_result to FILE with everything up to and including -# the last / stripped. -if test yes = "$_G_HAVE_XSI_OPS"; then - # If this shell supports suffix pattern removal, then use it to avoid - # forking. Hide the definitions single quotes in case the shell chokes - # on unsupported syntax... - _b='func_basename_result=${1##*/}' - _d='case $1 in - */*) func_dirname_result=${1%/*}$2 ;; - * ) func_dirname_result=$3 ;; - esac' - -else - # ...otherwise fall back to using sed. - _b='func_basename_result=`$ECHO "$1" |$SED "$sed_basename"`' - _d='func_dirname_result=`$ECHO "$1" |$SED "$sed_dirname"` - if test "X$func_dirname_result" = "X$1"; then - func_dirname_result=$3 - else - func_append func_dirname_result "$2" - fi' -fi - -eval 'func_basename () -{ - $debug_cmd - - '"$_b"' -}' - - -# func_dirname FILE APPEND NONDIR_REPLACEMENT -# ------------------------------------------- -# Compute the dirname of FILE. If nonempty, add APPEND to the result, -# otherwise set result to NONDIR_REPLACEMENT. -eval 'func_dirname () -{ - $debug_cmd - - '"$_d"' -}' - - -# func_dirname_and_basename FILE APPEND NONDIR_REPLACEMENT -# -------------------------------------------------------- -# Perform func_basename and func_dirname in a single function -# call: -# dirname: Compute the dirname of FILE. If nonempty, -# add APPEND to the result, otherwise set result -# to NONDIR_REPLACEMENT. -# value returned in "$func_dirname_result" -# basename: Compute filename of FILE. -# value retuned in "$func_basename_result" -# For efficiency, we do not delegate to the functions above but instead -# duplicate the functionality here. -eval 'func_dirname_and_basename () -{ - $debug_cmd - - '"$_b"' - '"$_d"' -}' - - -# func_echo ARG... -# ---------------- -# Echo program name prefixed message. -func_echo () -{ - $debug_cmd - - _G_message=$* - - func_echo_IFS=$IFS - IFS=$nl - for _G_line in $_G_message; do - IFS=$func_echo_IFS - $ECHO "$progname: $_G_line" - done - IFS=$func_echo_IFS -} - - -# func_echo_all ARG... -# -------------------- -# Invoke $ECHO with all args, space-separated. -func_echo_all () -{ - $ECHO "$*" -} - - -# func_echo_infix_1 INFIX ARG... -# ------------------------------ -# Echo program name, followed by INFIX on the first line, with any -# additional lines not showing INFIX. -func_echo_infix_1 () -{ - $debug_cmd - - $require_term_colors - - _G_infix=$1; shift - _G_indent=$_G_infix - _G_prefix="$progname: $_G_infix: " - _G_message=$* - - # Strip color escape sequences before counting printable length - for _G_tc in "$tc_reset" "$tc_bold" "$tc_standout" "$tc_red" "$tc_green" "$tc_blue" "$tc_cyan" - do - test -n "$_G_tc" && { - _G_esc_tc=`$ECHO "$_G_tc" | $SED "$sed_make_literal_regex"` - _G_indent=`$ECHO "$_G_indent" | $SED "s|$_G_esc_tc||g"` - } - done - _G_indent="$progname: "`echo "$_G_indent" | $SED 's|.| |g'`" " ## exclude from sc_prohibit_nested_quotes - - func_echo_infix_1_IFS=$IFS - IFS=$nl - for _G_line in $_G_message; do - IFS=$func_echo_infix_1_IFS - $ECHO "$_G_prefix$tc_bold$_G_line$tc_reset" >&2 - _G_prefix=$_G_indent - done - IFS=$func_echo_infix_1_IFS -} - - -# func_error ARG... -# ----------------- -# Echo program name prefixed message to standard error. -func_error () -{ - $debug_cmd - - $require_term_colors - - func_echo_infix_1 " $tc_standout${tc_red}error$tc_reset" "$*" >&2 -} - - -# func_fatal_error ARG... -# ----------------------- -# Echo program name prefixed message to standard error, and exit. -func_fatal_error () -{ - $debug_cmd - - func_error "$*" - exit $EXIT_FAILURE -} - - -# func_grep EXPRESSION FILENAME -# ----------------------------- -# Check whether EXPRESSION matches any line of FILENAME, without output. -func_grep () -{ - $debug_cmd - - $GREP "$1" "$2" >/dev/null 2>&1 -} - - -# func_len STRING -# --------------- -# Set func_len_result to the length of STRING. STRING may not -# start with a hyphen. - test -z "$_G_HAVE_XSI_OPS" \ - && (eval 'x=a/b/c; - test 5aa/bb/cc = "${#x}${x%%/*}${x%/*}${x#*/}${x##*/}"') 2>/dev/null \ - && _G_HAVE_XSI_OPS=yes - -if test yes = "$_G_HAVE_XSI_OPS"; then - eval 'func_len () - { - $debug_cmd - - func_len_result=${#1} - }' -else - func_len () - { - $debug_cmd - - func_len_result=`expr "$1" : ".*" 2>/dev/null || echo $max_cmd_len` - } -fi - - -# func_mkdir_p DIRECTORY-PATH -# --------------------------- -# Make sure the entire path to DIRECTORY-PATH is available. -func_mkdir_p () -{ - $debug_cmd - - _G_directory_path=$1 - _G_dir_list= - - if test -n "$_G_directory_path" && test : != "$opt_dry_run"; then - - # Protect directory names starting with '-' - case $_G_directory_path in - -*) _G_directory_path=./$_G_directory_path ;; - esac - - # While some portion of DIR does not yet exist... - while test ! -d "$_G_directory_path"; do - # ...make a list in topmost first order. Use a colon delimited - # list incase some portion of path contains whitespace. - _G_dir_list=$_G_directory_path:$_G_dir_list - - # If the last portion added has no slash in it, the list is done - case $_G_directory_path in */*) ;; *) break ;; esac - - # ...otherwise throw away the child directory and loop - _G_directory_path=`$ECHO "$_G_directory_path" | $SED -e "$sed_dirname"` - done - _G_dir_list=`$ECHO "$_G_dir_list" | $SED 's|:*$||'` - - func_mkdir_p_IFS=$IFS; IFS=: - for _G_dir in $_G_dir_list; do - IFS=$func_mkdir_p_IFS - # mkdir can fail with a 'File exist' error if two processes - # try to create one of the directories concurrently. Don't - # stop in that case! - $MKDIR "$_G_dir" 2>/dev/null || : - done - IFS=$func_mkdir_p_IFS - - # Bail out if we (or some other process) failed to create a directory. - test -d "$_G_directory_path" || \ - func_fatal_error "Failed to create '$1'" - fi -} - - -# func_mktempdir [BASENAME] -# ------------------------- -# Make a temporary directory that won't clash with other running -# libtool processes, and avoids race conditions if possible. If -# given, BASENAME is the basename for that directory. -func_mktempdir () -{ - $debug_cmd - - _G_template=${TMPDIR-/tmp}/${1-$progname} - - if test : = "$opt_dry_run"; then - # Return a directory name, but don't create it in dry-run mode - _G_tmpdir=$_G_template-$$ - else - - # If mktemp works, use that first and foremost - _G_tmpdir=`mktemp -d "$_G_template-XXXXXXXX" 2>/dev/null` - - if test ! -d "$_G_tmpdir"; then - # Failing that, at least try and use $RANDOM to avoid a race - _G_tmpdir=$_G_template-${RANDOM-0}$$ - - func_mktempdir_umask=`umask` - umask 0077 - $MKDIR "$_G_tmpdir" - umask $func_mktempdir_umask - fi - - # If we're not in dry-run mode, bomb out on failure - test -d "$_G_tmpdir" || \ - func_fatal_error "cannot create temporary directory '$_G_tmpdir'" - fi - - $ECHO "$_G_tmpdir" -} - - -# func_normal_abspath PATH -# ------------------------ -# Remove doubled-up and trailing slashes, "." path components, -# and cancel out any ".." path components in PATH after making -# it an absolute path. -func_normal_abspath () -{ - $debug_cmd - - # These SED scripts presuppose an absolute path with a trailing slash. - _G_pathcar='s|^/\([^/]*\).*$|\1|' - _G_pathcdr='s|^/[^/]*||' - _G_removedotparts=':dotsl - s|/\./|/|g - t dotsl - s|/\.$|/|' - _G_collapseslashes='s|/\{1,\}|/|g' - _G_finalslash='s|/*$|/|' - - # Start from root dir and reassemble the path. - func_normal_abspath_result= - func_normal_abspath_tpath=$1 - func_normal_abspath_altnamespace= - case $func_normal_abspath_tpath in - "") - # Empty path, that just means $cwd. - func_stripname '' '/' "`pwd`" - func_normal_abspath_result=$func_stripname_result - return - ;; - # The next three entries are used to spot a run of precisely - # two leading slashes without using negated character classes; - # we take advantage of case's first-match behaviour. - ///*) - # Unusual form of absolute path, do nothing. - ;; - //*) - # Not necessarily an ordinary path; POSIX reserves leading '//' - # and for example Cygwin uses it to access remote file shares - # over CIFS/SMB, so we conserve a leading double slash if found. - func_normal_abspath_altnamespace=/ - ;; - /*) - # Absolute path, do nothing. - ;; - *) - # Relative path, prepend $cwd. - func_normal_abspath_tpath=`pwd`/$func_normal_abspath_tpath - ;; - esac - - # Cancel out all the simple stuff to save iterations. We also want - # the path to end with a slash for ease of parsing, so make sure - # there is one (and only one) here. - func_normal_abspath_tpath=`$ECHO "$func_normal_abspath_tpath" | $SED \ - -e "$_G_removedotparts" -e "$_G_collapseslashes" -e "$_G_finalslash"` - while :; do - # Processed it all yet? - if test / = "$func_normal_abspath_tpath"; then - # If we ascended to the root using ".." the result may be empty now. - if test -z "$func_normal_abspath_result"; then - func_normal_abspath_result=/ - fi - break - fi - func_normal_abspath_tcomponent=`$ECHO "$func_normal_abspath_tpath" | $SED \ - -e "$_G_pathcar"` - func_normal_abspath_tpath=`$ECHO "$func_normal_abspath_tpath" | $SED \ - -e "$_G_pathcdr"` - # Figure out what to do with it - case $func_normal_abspath_tcomponent in - "") - # Trailing empty path component, ignore it. - ;; - ..) - # Parent dir; strip last assembled component from result. - func_dirname "$func_normal_abspath_result" - func_normal_abspath_result=$func_dirname_result - ;; - *) - # Actual path component, append it. - func_append func_normal_abspath_result "/$func_normal_abspath_tcomponent" - ;; - esac - done - # Restore leading double-slash if one was found on entry. - func_normal_abspath_result=$func_normal_abspath_altnamespace$func_normal_abspath_result -} - - -# func_notquiet ARG... -# -------------------- -# Echo program name prefixed message only when not in quiet mode. -func_notquiet () -{ - $debug_cmd - - $opt_quiet || func_echo ${1+"$@"} - - # A bug in bash halts the script if the last line of a function - # fails when set -e is in force, so we need another command to - # work around that: - : -} - - -# func_relative_path SRCDIR DSTDIR -# -------------------------------- -# Set func_relative_path_result to the relative path from SRCDIR to DSTDIR. -func_relative_path () -{ - $debug_cmd - - func_relative_path_result= - func_normal_abspath "$1" - func_relative_path_tlibdir=$func_normal_abspath_result - func_normal_abspath "$2" - func_relative_path_tbindir=$func_normal_abspath_result - - # Ascend the tree starting from libdir - while :; do - # check if we have found a prefix of bindir - case $func_relative_path_tbindir in - $func_relative_path_tlibdir) - # found an exact match - func_relative_path_tcancelled= - break - ;; - $func_relative_path_tlibdir*) - # found a matching prefix - func_stripname "$func_relative_path_tlibdir" '' "$func_relative_path_tbindir" - func_relative_path_tcancelled=$func_stripname_result - if test -z "$func_relative_path_result"; then - func_relative_path_result=. - fi - break - ;; - *) - func_dirname $func_relative_path_tlibdir - func_relative_path_tlibdir=$func_dirname_result - if test -z "$func_relative_path_tlibdir"; then - # Have to descend all the way to the root! - func_relative_path_result=../$func_relative_path_result - func_relative_path_tcancelled=$func_relative_path_tbindir - break - fi - func_relative_path_result=../$func_relative_path_result - ;; - esac - done - - # Now calculate path; take care to avoid doubling-up slashes. - func_stripname '' '/' "$func_relative_path_result" - func_relative_path_result=$func_stripname_result - func_stripname '/' '/' "$func_relative_path_tcancelled" - if test -n "$func_stripname_result"; then - func_append func_relative_path_result "/$func_stripname_result" - fi - - # Normalisation. If bindir is libdir, return '.' else relative path. - if test -n "$func_relative_path_result"; then - func_stripname './' '' "$func_relative_path_result" - func_relative_path_result=$func_stripname_result - fi - - test -n "$func_relative_path_result" || func_relative_path_result=. - - : -} - - -# func_quote_for_eval ARG... -# -------------------------- -# Aesthetically quote ARGs to be evaled later. -# This function returns two values: -# i) func_quote_for_eval_result -# double-quoted, suitable for a subsequent eval -# ii) func_quote_for_eval_unquoted_result -# has all characters that are still active within double -# quotes backslashified. -func_quote_for_eval () -{ - $debug_cmd - - func_quote_for_eval_unquoted_result= - func_quote_for_eval_result= - while test 0 -lt $#; do - case $1 in - *[\\\`\"\$]*) - _G_unquoted_arg=`printf '%s\n' "$1" |$SED "$sed_quote_subst"` ;; - *) - _G_unquoted_arg=$1 ;; - esac - if test -n "$func_quote_for_eval_unquoted_result"; then - func_append func_quote_for_eval_unquoted_result " $_G_unquoted_arg" - else - func_append func_quote_for_eval_unquoted_result "$_G_unquoted_arg" - fi - - case $_G_unquoted_arg in - # Double-quote args containing shell metacharacters to delay - # word splitting, command substitution and variable expansion - # for a subsequent eval. - # Many Bourne shells cannot handle close brackets correctly - # in scan sets, so we specify it separately. - *[\[\~\#\^\&\*\(\)\{\}\|\;\<\>\?\'\ \ ]*|*]*|"") - _G_quoted_arg=\"$_G_unquoted_arg\" - ;; - *) - _G_quoted_arg=$_G_unquoted_arg - ;; - esac - - if test -n "$func_quote_for_eval_result"; then - func_append func_quote_for_eval_result " $_G_quoted_arg" - else - func_append func_quote_for_eval_result "$_G_quoted_arg" - fi - shift - done -} - - -# func_quote_for_expand ARG -# ------------------------- -# Aesthetically quote ARG to be evaled later; same as above, -# but do not quote variable references. -func_quote_for_expand () -{ - $debug_cmd - - case $1 in - *[\\\`\"]*) - _G_arg=`$ECHO "$1" | $SED \ - -e "$sed_double_quote_subst" -e "$sed_double_backslash"` ;; - *) - _G_arg=$1 ;; - esac - - case $_G_arg in - # Double-quote args containing shell metacharacters to delay - # word splitting and command substitution for a subsequent eval. - # Many Bourne shells cannot handle close brackets correctly - # in scan sets, so we specify it separately. - *[\[\~\#\^\&\*\(\)\{\}\|\;\<\>\?\'\ \ ]*|*]*|"") - _G_arg=\"$_G_arg\" - ;; - esac - - func_quote_for_expand_result=$_G_arg -} - - -# func_stripname PREFIX SUFFIX NAME -# --------------------------------- -# strip PREFIX and SUFFIX from NAME, and store in func_stripname_result. -# PREFIX and SUFFIX must not contain globbing or regex special -# characters, hashes, percent signs, but SUFFIX may contain a leading -# dot (in which case that matches only a dot). -if test yes = "$_G_HAVE_XSI_OPS"; then - eval 'func_stripname () - { - $debug_cmd - - # pdksh 5.2.14 does not do ${X%$Y} correctly if both X and Y are - # positional parameters, so assign one to ordinary variable first. - func_stripname_result=$3 - func_stripname_result=${func_stripname_result#"$1"} - func_stripname_result=${func_stripname_result%"$2"} - }' -else - func_stripname () - { - $debug_cmd - - case $2 in - .*) func_stripname_result=`$ECHO "$3" | $SED -e "s%^$1%%" -e "s%\\\\$2\$%%"`;; - *) func_stripname_result=`$ECHO "$3" | $SED -e "s%^$1%%" -e "s%$2\$%%"`;; - esac - } -fi - - -# func_show_eval CMD [FAIL_EXP] -# ----------------------------- -# Unless opt_quiet is true, then output CMD. Then, if opt_dryrun is -# not true, evaluate CMD. If the evaluation of CMD fails, and FAIL_EXP -# is given, then evaluate it. -func_show_eval () -{ - $debug_cmd - - _G_cmd=$1 - _G_fail_exp=${2-':'} - - func_quote_for_expand "$_G_cmd" - eval "func_notquiet $func_quote_for_expand_result" - - $opt_dry_run || { - eval "$_G_cmd" - _G_status=$? - if test 0 -ne "$_G_status"; then - eval "(exit $_G_status); $_G_fail_exp" - fi - } -} - - -# func_show_eval_locale CMD [FAIL_EXP] -# ------------------------------------ -# Unless opt_quiet is true, then output CMD. Then, if opt_dryrun is -# not true, evaluate CMD. If the evaluation of CMD fails, and FAIL_EXP -# is given, then evaluate it. Use the saved locale for evaluation. -func_show_eval_locale () -{ - $debug_cmd - - _G_cmd=$1 - _G_fail_exp=${2-':'} - - $opt_quiet || { - func_quote_for_expand "$_G_cmd" - eval "func_echo $func_quote_for_expand_result" - } - - $opt_dry_run || { - eval "$_G_user_locale - $_G_cmd" - _G_status=$? - eval "$_G_safe_locale" - if test 0 -ne "$_G_status"; then - eval "(exit $_G_status); $_G_fail_exp" - fi - } -} - - -# func_tr_sh -# ---------- -# Turn $1 into a string suitable for a shell variable name. -# Result is stored in $func_tr_sh_result. All characters -# not in the set a-zA-Z0-9_ are replaced with '_'. Further, -# if $1 begins with a digit, a '_' is prepended as well. -func_tr_sh () -{ - $debug_cmd - - case $1 in - [0-9]* | *[!a-zA-Z0-9_]*) - func_tr_sh_result=`$ECHO "$1" | $SED -e 's/^\([0-9]\)/_\1/' -e 's/[^a-zA-Z0-9_]/_/g'` - ;; - * ) - func_tr_sh_result=$1 - ;; - esac -} - - -# func_verbose ARG... -# ------------------- -# Echo program name prefixed message in verbose mode only. -func_verbose () -{ - $debug_cmd - - $opt_verbose && func_echo "$*" - - : -} - - -# func_warn_and_continue ARG... -# ----------------------------- -# Echo program name prefixed warning message to standard error. -func_warn_and_continue () -{ - $debug_cmd - - $require_term_colors - - func_echo_infix_1 "${tc_red}warning$tc_reset" "$*" >&2 -} - - -# func_warning CATEGORY ARG... -# ---------------------------- -# Echo program name prefixed warning message to standard error. Warning -# messages can be filtered according to CATEGORY, where this function -# elides messages where CATEGORY is not listed in the global variable -# 'opt_warning_types'. -func_warning () -{ - $debug_cmd - - # CATEGORY must be in the warning_categories list! - case " $warning_categories " in - *" $1 "*) ;; - *) func_internal_error "invalid warning category '$1'" ;; - esac - - _G_category=$1 - shift - - case " $opt_warning_types " in - *" $_G_category "*) $warning_func ${1+"$@"} ;; - esac -} - - -# func_sort_ver VER1 VER2 -# ----------------------- -# 'sort -V' is not generally available. -# Note this deviates from the version comparison in automake -# in that it treats 1.5 < 1.5.0, and treats 1.4.4a < 1.4-p3a -# but this should suffice as we won't be specifying old -# version formats or redundant trailing .0 in bootstrap.conf. -# If we did want full compatibility then we should probably -# use m4_version_compare from autoconf. -func_sort_ver () -{ - $debug_cmd - - printf '%s\n%s\n' "$1" "$2" \ - | sort -t. -k 1,1n -k 2,2n -k 3,3n -k 4,4n -k 5,5n -k 6,6n -k 7,7n -k 8,8n -k 9,9n -} - -# func_lt_ver PREV CURR -# --------------------- -# Return true if PREV and CURR are in the correct order according to -# func_sort_ver, otherwise false. Use it like this: -# -# func_lt_ver "$prev_ver" "$proposed_ver" || func_fatal_error "..." -func_lt_ver () -{ - $debug_cmd - - test "x$1" = x`func_sort_ver "$1" "$2" | $SED 1q` -} - - -# Local variables: -# mode: shell-script -# sh-indentation: 2 -# eval: (add-hook 'before-save-hook 'time-stamp) -# time-stamp-pattern: "10/scriptversion=%:y-%02m-%02d.%02H; # UTC" -# time-stamp-time-zone: "UTC" -# End: -#! /bin/sh - -# Set a version string for this script. -scriptversion=2014-01-07.03; # UTC - -# A portable, pluggable option parser for Bourne shell. -# Written by Gary V. Vaughan, 2010 - -# Copyright (C) 2010-2015 Free Software Foundation, Inc. -# This is free software; see the source for copying conditions. There is NO -# warranty; not even for MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. - -# This program is free software: you can redistribute it and/or modify -# it under the terms of the GNU General Public License as published by -# the Free Software Foundation, either version 3 of the License, or -# (at your option) any later version. - -# This program is distributed in the hope that it will be useful, -# but WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -# GNU General Public License for more details. - -# You should have received a copy of the GNU General Public License -# along with this program. If not, see . - -# Please report bugs or propose patches to gary@gnu.org. - - -## ------ ## -## Usage. ## -## ------ ## - -# This file is a library for parsing options in your shell scripts along -# with assorted other useful supporting features that you can make use -# of too. -# -# For the simplest scripts you might need only: -# -# #!/bin/sh -# . relative/path/to/funclib.sh -# . relative/path/to/options-parser -# scriptversion=1.0 -# func_options ${1+"$@"} -# eval set dummy "$func_options_result"; shift -# ...rest of your script... -# -# In order for the '--version' option to work, you will need to have a -# suitably formatted comment like the one at the top of this file -# starting with '# Written by ' and ending with '# warranty; '. -# -# For '-h' and '--help' to work, you will also need a one line -# description of your script's purpose in a comment directly above the -# '# Written by ' line, like the one at the top of this file. -# -# The default options also support '--debug', which will turn on shell -# execution tracing (see the comment above debug_cmd below for another -# use), and '--verbose' and the func_verbose function to allow your script -# to display verbose messages only when your user has specified -# '--verbose'. -# -# After sourcing this file, you can plug processing for additional -# options by amending the variables from the 'Configuration' section -# below, and following the instructions in the 'Option parsing' -# section further down. - -## -------------- ## -## Configuration. ## -## -------------- ## - -# You should override these variables in your script after sourcing this -# file so that they reflect the customisations you have added to the -# option parser. - -# The usage line for option parsing errors and the start of '-h' and -# '--help' output messages. You can embed shell variables for delayed -# expansion at the time the message is displayed, but you will need to -# quote other shell meta-characters carefully to prevent them being -# expanded when the contents are evaled. -usage='$progpath [OPTION]...' - -# Short help message in response to '-h' and '--help'. Add to this or -# override it after sourcing this library to reflect the full set of -# options your script accepts. -usage_message="\ - --debug enable verbose shell tracing - -W, --warnings=CATEGORY - report the warnings falling in CATEGORY [all] - -v, --verbose verbosely report processing - --version print version information and exit - -h, --help print short or long help message and exit -" - -# Additional text appended to 'usage_message' in response to '--help'. -long_help_message=" -Warning categories include: - 'all' show all warnings - 'none' turn off all the warnings - 'error' warnings are treated as fatal errors" - -# Help message printed before fatal option parsing errors. -fatal_help="Try '\$progname --help' for more information." - - - -## ------------------------- ## -## Hook function management. ## -## ------------------------- ## - -# This section contains functions for adding, removing, and running hooks -# to the main code. A hook is just a named list of of function, that can -# be run in order later on. - -# func_hookable FUNC_NAME -# ----------------------- -# Declare that FUNC_NAME will run hooks added with -# 'func_add_hook FUNC_NAME ...'. -func_hookable () -{ - $debug_cmd - - func_append hookable_fns " $1" -} - - -# func_add_hook FUNC_NAME HOOK_FUNC -# --------------------------------- -# Request that FUNC_NAME call HOOK_FUNC before it returns. FUNC_NAME must -# first have been declared "hookable" by a call to 'func_hookable'. -func_add_hook () -{ - $debug_cmd - - case " $hookable_fns " in - *" $1 "*) ;; - *) func_fatal_error "'$1' does not accept hook functions." ;; - esac - - eval func_append ${1}_hooks '" $2"' -} - - -# func_remove_hook FUNC_NAME HOOK_FUNC -# ------------------------------------ -# Remove HOOK_FUNC from the list of functions called by FUNC_NAME. -func_remove_hook () -{ - $debug_cmd - - eval ${1}_hooks='`$ECHO "\$'$1'_hooks" |$SED "s| '$2'||"`' -} - - -# func_run_hooks FUNC_NAME [ARG]... -# --------------------------------- -# Run all hook functions registered to FUNC_NAME. -# It is assumed that the list of hook functions contains nothing more -# than a whitespace-delimited list of legal shell function names, and -# no effort is wasted trying to catch shell meta-characters or preserve -# whitespace. -func_run_hooks () -{ - $debug_cmd - - case " $hookable_fns " in - *" $1 "*) ;; - *) func_fatal_error "'$1' does not support hook funcions.n" ;; - esac - - eval _G_hook_fns=\$$1_hooks; shift - - for _G_hook in $_G_hook_fns; do - eval $_G_hook '"$@"' - - # store returned options list back into positional - # parameters for next 'cmd' execution. - eval _G_hook_result=\$${_G_hook}_result - eval set dummy "$_G_hook_result"; shift - done - - func_quote_for_eval ${1+"$@"} - func_run_hooks_result=$func_quote_for_eval_result -} - - - -## --------------- ## -## Option parsing. ## -## --------------- ## - -# In order to add your own option parsing hooks, you must accept the -# full positional parameter list in your hook function, remove any -# options that you action, and then pass back the remaining unprocessed -# options in '_result', escaped suitably for -# 'eval'. Like this: -# -# my_options_prep () -# { -# $debug_cmd -# -# # Extend the existing usage message. -# usage_message=$usage_message' -# -s, --silent don'\''t print informational messages -# ' -# -# func_quote_for_eval ${1+"$@"} -# my_options_prep_result=$func_quote_for_eval_result -# } -# func_add_hook func_options_prep my_options_prep -# -# -# my_silent_option () -# { -# $debug_cmd -# -# # Note that for efficiency, we parse as many options as we can -# # recognise in a loop before passing the remainder back to the -# # caller on the first unrecognised argument we encounter. -# while test $# -gt 0; do -# opt=$1; shift -# case $opt in -# --silent|-s) opt_silent=: ;; -# # Separate non-argument short options: -# -s*) func_split_short_opt "$_G_opt" -# set dummy "$func_split_short_opt_name" \ -# "-$func_split_short_opt_arg" ${1+"$@"} -# shift -# ;; -# *) set dummy "$_G_opt" "$*"; shift; break ;; -# esac -# done -# -# func_quote_for_eval ${1+"$@"} -# my_silent_option_result=$func_quote_for_eval_result -# } -# func_add_hook func_parse_options my_silent_option -# -# -# my_option_validation () -# { -# $debug_cmd -# -# $opt_silent && $opt_verbose && func_fatal_help "\ -# '--silent' and '--verbose' options are mutually exclusive." -# -# func_quote_for_eval ${1+"$@"} -# my_option_validation_result=$func_quote_for_eval_result -# } -# func_add_hook func_validate_options my_option_validation -# -# You'll alse need to manually amend $usage_message to reflect the extra -# options you parse. It's preferable to append if you can, so that -# multiple option parsing hooks can be added safely. - - -# func_options [ARG]... -# --------------------- -# All the functions called inside func_options are hookable. See the -# individual implementations for details. -func_hookable func_options -func_options () -{ - $debug_cmd - - func_options_prep ${1+"$@"} - eval func_parse_options \ - ${func_options_prep_result+"$func_options_prep_result"} - eval func_validate_options \ - ${func_parse_options_result+"$func_parse_options_result"} - - eval func_run_hooks func_options \ - ${func_validate_options_result+"$func_validate_options_result"} - - # save modified positional parameters for caller - func_options_result=$func_run_hooks_result -} - - -# func_options_prep [ARG]... -# -------------------------- -# All initialisations required before starting the option parse loop. -# Note that when calling hook functions, we pass through the list of -# positional parameters. If a hook function modifies that list, and -# needs to propogate that back to rest of this script, then the complete -# modified list must be put in 'func_run_hooks_result' before -# returning. -func_hookable func_options_prep -func_options_prep () -{ - $debug_cmd - - # Option defaults: - opt_verbose=false - opt_warning_types= - - func_run_hooks func_options_prep ${1+"$@"} - - # save modified positional parameters for caller - func_options_prep_result=$func_run_hooks_result -} - - -# func_parse_options [ARG]... -# --------------------------- -# The main option parsing loop. -func_hookable func_parse_options -func_parse_options () -{ - $debug_cmd - - func_parse_options_result= - - # this just eases exit handling - while test $# -gt 0; do - # Defer to hook functions for initial option parsing, so they - # get priority in the event of reusing an option name. - func_run_hooks func_parse_options ${1+"$@"} - - # Adjust func_parse_options positional parameters to match - eval set dummy "$func_run_hooks_result"; shift - - # Break out of the loop if we already parsed every option. - test $# -gt 0 || break - - _G_opt=$1 - shift - case $_G_opt in - --debug|-x) debug_cmd='set -x' - func_echo "enabling shell trace mode" - $debug_cmd - ;; - - --no-warnings|--no-warning|--no-warn) - set dummy --warnings none ${1+"$@"} - shift - ;; - - --warnings|--warning|-W) - test $# = 0 && func_missing_arg $_G_opt && break - case " $warning_categories $1" in - *" $1 "*) - # trailing space prevents matching last $1 above - func_append_uniq opt_warning_types " $1" - ;; - *all) - opt_warning_types=$warning_categories - ;; - *none) - opt_warning_types=none - warning_func=: - ;; - *error) - opt_warning_types=$warning_categories - warning_func=func_fatal_error - ;; - *) - func_fatal_error \ - "unsupported warning category: '$1'" - ;; - esac - shift - ;; - - --verbose|-v) opt_verbose=: ;; - --version) func_version ;; - -\?|-h) func_usage ;; - --help) func_help ;; - - # Separate optargs to long options (plugins may need this): - --*=*) func_split_equals "$_G_opt" - set dummy "$func_split_equals_lhs" \ - "$func_split_equals_rhs" ${1+"$@"} - shift - ;; - - # Separate optargs to short options: - -W*) - func_split_short_opt "$_G_opt" - set dummy "$func_split_short_opt_name" \ - "$func_split_short_opt_arg" ${1+"$@"} - shift - ;; - - # Separate non-argument short options: - -\?*|-h*|-v*|-x*) - func_split_short_opt "$_G_opt" - set dummy "$func_split_short_opt_name" \ - "-$func_split_short_opt_arg" ${1+"$@"} - shift - ;; - - --) break ;; - -*) func_fatal_help "unrecognised option: '$_G_opt'" ;; - *) set dummy "$_G_opt" ${1+"$@"}; shift; break ;; - esac - done - - # save modified positional parameters for caller - func_quote_for_eval ${1+"$@"} - func_parse_options_result=$func_quote_for_eval_result -} - - -# func_validate_options [ARG]... -# ------------------------------ -# Perform any sanity checks on option settings and/or unconsumed -# arguments. -func_hookable func_validate_options -func_validate_options () -{ - $debug_cmd - - # Display all warnings if -W was not given. - test -n "$opt_warning_types" || opt_warning_types=" $warning_categories" - - func_run_hooks func_validate_options ${1+"$@"} - - # Bail if the options were screwed! - $exit_cmd $EXIT_FAILURE - - # save modified positional parameters for caller - func_validate_options_result=$func_run_hooks_result -} - - - -## ----------------- ## -## Helper functions. ## -## ----------------- ## - -# This section contains the helper functions used by the rest of the -# hookable option parser framework in ascii-betical order. - - -# func_fatal_help ARG... -# ---------------------- -# Echo program name prefixed message to standard error, followed by -# a help hint, and exit. -func_fatal_help () -{ - $debug_cmd - - eval \$ECHO \""Usage: $usage"\" - eval \$ECHO \""$fatal_help"\" - func_error ${1+"$@"} - exit $EXIT_FAILURE -} - - -# func_help -# --------- -# Echo long help message to standard output and exit. -func_help () -{ - $debug_cmd - - func_usage_message - $ECHO "$long_help_message" - exit 0 -} - - -# func_missing_arg ARGNAME -# ------------------------ -# Echo program name prefixed message to standard error and set global -# exit_cmd. -func_missing_arg () -{ - $debug_cmd - - func_error "Missing argument for '$1'." - exit_cmd=exit -} - - -# func_split_equals STRING -# ------------------------ -# Set func_split_equals_lhs and func_split_equals_rhs shell variables after -# splitting STRING at the '=' sign. -test -z "$_G_HAVE_XSI_OPS" \ - && (eval 'x=a/b/c; - test 5aa/bb/cc = "${#x}${x%%/*}${x%/*}${x#*/}${x##*/}"') 2>/dev/null \ - && _G_HAVE_XSI_OPS=yes - -if test yes = "$_G_HAVE_XSI_OPS" -then - # This is an XSI compatible shell, allowing a faster implementation... - eval 'func_split_equals () - { - $debug_cmd - - func_split_equals_lhs=${1%%=*} - func_split_equals_rhs=${1#*=} - test "x$func_split_equals_lhs" = "x$1" \ - && func_split_equals_rhs= - }' -else - # ...otherwise fall back to using expr, which is often a shell builtin. - func_split_equals () - { - $debug_cmd - - func_split_equals_lhs=`expr "x$1" : 'x\([^=]*\)'` - func_split_equals_rhs= - test "x$func_split_equals_lhs" = "x$1" \ - || func_split_equals_rhs=`expr "x$1" : 'x[^=]*=\(.*\)$'` - } -fi #func_split_equals - - -# func_split_short_opt SHORTOPT -# ----------------------------- -# Set func_split_short_opt_name and func_split_short_opt_arg shell -# variables after splitting SHORTOPT after the 2nd character. -if test yes = "$_G_HAVE_XSI_OPS" -then - # This is an XSI compatible shell, allowing a faster implementation... - eval 'func_split_short_opt () - { - $debug_cmd - - func_split_short_opt_arg=${1#??} - func_split_short_opt_name=${1%"$func_split_short_opt_arg"} - }' -else - # ...otherwise fall back to using expr, which is often a shell builtin. - func_split_short_opt () - { - $debug_cmd - - func_split_short_opt_name=`expr "x$1" : 'x-\(.\)'` - func_split_short_opt_arg=`expr "x$1" : 'x-.\(.*\)$'` - } -fi #func_split_short_opt - - -# func_usage -# ---------- -# Echo short help message to standard output and exit. -func_usage () -{ - $debug_cmd - - func_usage_message - $ECHO "Run '$progname --help |${PAGER-more}' for full usage" - exit 0 -} - - -# func_usage_message -# ------------------ -# Echo short help message to standard output. -func_usage_message () -{ - $debug_cmd - - eval \$ECHO \""Usage: $usage"\" - echo - $SED -n 's|^# || - /^Written by/{ - x;p;x - } - h - /^Written by/q' < "$progpath" - echo - eval \$ECHO \""$usage_message"\" -} - - -# func_version -# ------------ -# Echo version message to standard output and exit. -func_version () -{ - $debug_cmd - - printf '%s\n' "$progname $scriptversion" - $SED -n ' - /(C)/!b go - :more - /\./!{ - N - s|\n# | | - b more - } - :go - /^# Written by /,/# warranty; / { - s|^# || - s|^# *$|| - s|\((C)\)[ 0-9,-]*[ ,-]\([1-9][0-9]* \)|\1 \2| - p - } - /^# Written by / { - s|^# || - p - } - /^warranty; /q' < "$progpath" - - exit $? -} - - -# Local variables: -# mode: shell-script -# sh-indentation: 2 -# eval: (add-hook 'before-save-hook 'time-stamp) -# time-stamp-pattern: "10/scriptversion=%:y-%02m-%02d.%02H; # UTC" -# time-stamp-time-zone: "UTC" -# End: - -# Set a version string. -scriptversion='(GNU libtool) 2.4.6' - - -# func_echo ARG... -# ---------------- -# Libtool also displays the current mode in messages, so override -# funclib.sh func_echo with this custom definition. -func_echo () -{ - $debug_cmd - - _G_message=$* - - func_echo_IFS=$IFS - IFS=$nl - for _G_line in $_G_message; do - IFS=$func_echo_IFS - $ECHO "$progname${opt_mode+: $opt_mode}: $_G_line" - done - IFS=$func_echo_IFS -} - - -# func_warning ARG... -# ------------------- -# Libtool warnings are not categorized, so override funclib.sh -# func_warning with this simpler definition. -func_warning () -{ - $debug_cmd - - $warning_func ${1+"$@"} -} - - -## ---------------- ## -## Options parsing. ## -## ---------------- ## - -# Hook in the functions to make sure our own options are parsed during -# the option parsing loop. - -usage='$progpath [OPTION]... [MODE-ARG]...' - -# Short help message in response to '-h'. -usage_message="Options: - --config show all configuration variables - --debug enable verbose shell tracing - -n, --dry-run display commands without modifying any files - --features display basic configuration information and exit - --mode=MODE use operation mode MODE - --no-warnings equivalent to '-Wnone' - --preserve-dup-deps don't remove duplicate dependency libraries - --quiet, --silent don't print informational messages - --tag=TAG use configuration variables from tag TAG - -v, --verbose print more informational messages than default - --version print version information - -W, --warnings=CATEGORY report the warnings falling in CATEGORY [all] - -h, --help, --help-all print short, long, or detailed help message -" - -# Additional text appended to 'usage_message' in response to '--help'. -func_help () -{ - $debug_cmd - - func_usage_message - $ECHO "$long_help_message - -MODE must be one of the following: - - clean remove files from the build directory - compile compile a source file into a libtool object - execute automatically set library path, then run a program - finish complete the installation of libtool libraries - install install libraries or executables - link create a library or an executable - uninstall remove libraries from an installed directory - -MODE-ARGS vary depending on the MODE. When passed as first option, -'--mode=MODE' may be abbreviated as 'MODE' or a unique abbreviation of that. -Try '$progname --help --mode=MODE' for a more detailed description of MODE. - -When reporting a bug, please describe a test case to reproduce it and -include the following information: - - host-triplet: $host - shell: $SHELL - compiler: $LTCC - compiler flags: $LTCFLAGS - linker: $LD (gnu? $with_gnu_ld) - version: $progname (GNU libtool) 2.4.6 - automake: `($AUTOMAKE --version) 2>/dev/null |$SED 1q` - autoconf: `($AUTOCONF --version) 2>/dev/null |$SED 1q` - -Report bugs to . -GNU libtool home page: . -General help using GNU software: ." - exit 0 -} - - -# func_lo2o OBJECT-NAME -# --------------------- -# Transform OBJECT-NAME from a '.lo' suffix to the platform specific -# object suffix. - -lo2o=s/\\.lo\$/.$objext/ -o2lo=s/\\.$objext\$/.lo/ - -if test yes = "$_G_HAVE_XSI_OPS"; then - eval 'func_lo2o () - { - case $1 in - *.lo) func_lo2o_result=${1%.lo}.$objext ;; - * ) func_lo2o_result=$1 ;; - esac - }' - - # func_xform LIBOBJ-OR-SOURCE - # --------------------------- - # Transform LIBOBJ-OR-SOURCE from a '.o' or '.c' (or otherwise) - # suffix to a '.lo' libtool-object suffix. - eval 'func_xform () - { - func_xform_result=${1%.*}.lo - }' -else - # ...otherwise fall back to using sed. - func_lo2o () - { - func_lo2o_result=`$ECHO "$1" | $SED "$lo2o"` - } - - func_xform () - { - func_xform_result=`$ECHO "$1" | $SED 's|\.[^.]*$|.lo|'` - } -fi - - -# func_fatal_configuration ARG... -# ------------------------------- -# Echo program name prefixed message to standard error, followed by -# a configuration failure hint, and exit. -func_fatal_configuration () -{ - func__fatal_error ${1+"$@"} \ - "See the $PACKAGE documentation for more information." \ - "Fatal configuration error." -} - - -# func_config -# ----------- -# Display the configuration for all the tags in this script. -func_config () -{ - re_begincf='^# ### BEGIN LIBTOOL' - re_endcf='^# ### END LIBTOOL' - - # Default configuration. - $SED "1,/$re_begincf CONFIG/d;/$re_endcf CONFIG/,\$d" < "$progpath" - - # Now print the configurations for the tags. - for tagname in $taglist; do - $SED -n "/$re_begincf TAG CONFIG: $tagname\$/,/$re_endcf TAG CONFIG: $tagname\$/p" < "$progpath" - done - - exit $? -} - - -# func_features -# ------------- -# Display the features supported by this script. -func_features () -{ - echo "host: $host" - if test yes = "$build_libtool_libs"; then - echo "enable shared libraries" - else - echo "disable shared libraries" - fi - if test yes = "$build_old_libs"; then - echo "enable static libraries" - else - echo "disable static libraries" - fi - - exit $? -} - - -# func_enable_tag TAGNAME -# ----------------------- -# Verify that TAGNAME is valid, and either flag an error and exit, or -# enable the TAGNAME tag. We also add TAGNAME to the global $taglist -# variable here. -func_enable_tag () -{ - # Global variable: - tagname=$1 - - re_begincf="^# ### BEGIN LIBTOOL TAG CONFIG: $tagname\$" - re_endcf="^# ### END LIBTOOL TAG CONFIG: $tagname\$" - sed_extractcf=/$re_begincf/,/$re_endcf/p - - # Validate tagname. - case $tagname in - *[!-_A-Za-z0-9,/]*) - func_fatal_error "invalid tag name: $tagname" - ;; - esac - - # Don't test for the "default" C tag, as we know it's - # there but not specially marked. - case $tagname in - CC) ;; - *) - if $GREP "$re_begincf" "$progpath" >/dev/null 2>&1; then - taglist="$taglist $tagname" - - # Evaluate the configuration. Be careful to quote the path - # and the sed script, to avoid splitting on whitespace, but - # also don't use non-portable quotes within backquotes within - # quotes we have to do it in 2 steps: - extractedcf=`$SED -n -e "$sed_extractcf" < "$progpath"` - eval "$extractedcf" - else - func_error "ignoring unknown tag $tagname" - fi - ;; - esac -} - - -# func_check_version_match -# ------------------------ -# Ensure that we are using m4 macros, and libtool script from the same -# release of libtool. -func_check_version_match () -{ - if test "$package_revision" != "$macro_revision"; then - if test "$VERSION" != "$macro_version"; then - if test -z "$macro_version"; then - cat >&2 <<_LT_EOF -$progname: Version mismatch error. This is $PACKAGE $VERSION, but the -$progname: definition of this LT_INIT comes from an older release. -$progname: You should recreate aclocal.m4 with macros from $PACKAGE $VERSION -$progname: and run autoconf again. -_LT_EOF - else - cat >&2 <<_LT_EOF -$progname: Version mismatch error. This is $PACKAGE $VERSION, but the -$progname: definition of this LT_INIT comes from $PACKAGE $macro_version. -$progname: You should recreate aclocal.m4 with macros from $PACKAGE $VERSION -$progname: and run autoconf again. -_LT_EOF - fi - else - cat >&2 <<_LT_EOF -$progname: Version mismatch error. This is $PACKAGE $VERSION, revision $package_revision, -$progname: but the definition of this LT_INIT comes from revision $macro_revision. -$progname: You should recreate aclocal.m4 with macros from revision $package_revision -$progname: of $PACKAGE $VERSION and run autoconf again. -_LT_EOF - fi - - exit $EXIT_MISMATCH - fi -} - - -# libtool_options_prep [ARG]... -# ----------------------------- -# Preparation for options parsed by libtool. -libtool_options_prep () -{ - $debug_mode - - # Option defaults: - opt_config=false - opt_dlopen= - opt_dry_run=false - opt_help=false - opt_mode= - opt_preserve_dup_deps=false - opt_quiet=false - - nonopt= - preserve_args= - - # Shorthand for --mode=foo, only valid as the first argument - case $1 in - clean|clea|cle|cl) - shift; set dummy --mode clean ${1+"$@"}; shift - ;; - compile|compil|compi|comp|com|co|c) - shift; set dummy --mode compile ${1+"$@"}; shift - ;; - execute|execut|execu|exec|exe|ex|e) - shift; set dummy --mode execute ${1+"$@"}; shift - ;; - finish|finis|fini|fin|fi|f) - shift; set dummy --mode finish ${1+"$@"}; shift - ;; - install|instal|insta|inst|ins|in|i) - shift; set dummy --mode install ${1+"$@"}; shift - ;; - link|lin|li|l) - shift; set dummy --mode link ${1+"$@"}; shift - ;; - uninstall|uninstal|uninsta|uninst|unins|unin|uni|un|u) - shift; set dummy --mode uninstall ${1+"$@"}; shift - ;; - esac - - # Pass back the list of options. - func_quote_for_eval ${1+"$@"} - libtool_options_prep_result=$func_quote_for_eval_result -} -func_add_hook func_options_prep libtool_options_prep - - -# libtool_parse_options [ARG]... -# --------------------------------- -# Provide handling for libtool specific options. -libtool_parse_options () -{ - $debug_cmd - - # Perform our own loop to consume as many options as possible in - # each iteration. - while test $# -gt 0; do - _G_opt=$1 - shift - case $_G_opt in - --dry-run|--dryrun|-n) - opt_dry_run=: - ;; - - --config) func_config ;; - - --dlopen|-dlopen) - opt_dlopen="${opt_dlopen+$opt_dlopen -}$1" - shift - ;; - - --preserve-dup-deps) - opt_preserve_dup_deps=: ;; - - --features) func_features ;; - - --finish) set dummy --mode finish ${1+"$@"}; shift ;; - - --help) opt_help=: ;; - - --help-all) opt_help=': help-all' ;; - - --mode) test $# = 0 && func_missing_arg $_G_opt && break - opt_mode=$1 - case $1 in - # Valid mode arguments: - clean|compile|execute|finish|install|link|relink|uninstall) ;; - - # Catch anything else as an error - *) func_error "invalid argument for $_G_opt" - exit_cmd=exit - break - ;; - esac - shift - ;; - - --no-silent|--no-quiet) - opt_quiet=false - func_append preserve_args " $_G_opt" - ;; - - --no-warnings|--no-warning|--no-warn) - opt_warning=false - func_append preserve_args " $_G_opt" - ;; - - --no-verbose) - opt_verbose=false - func_append preserve_args " $_G_opt" - ;; - - --silent|--quiet) - opt_quiet=: - opt_verbose=false - func_append preserve_args " $_G_opt" - ;; - - --tag) test $# = 0 && func_missing_arg $_G_opt && break - opt_tag=$1 - func_append preserve_args " $_G_opt $1" - func_enable_tag "$1" - shift - ;; - - --verbose|-v) opt_quiet=false - opt_verbose=: - func_append preserve_args " $_G_opt" - ;; - - # An option not handled by this hook function: - *) set dummy "$_G_opt" ${1+"$@"}; shift; break ;; - esac - done - - - # save modified positional parameters for caller - func_quote_for_eval ${1+"$@"} - libtool_parse_options_result=$func_quote_for_eval_result -} -func_add_hook func_parse_options libtool_parse_options - - - -# libtool_validate_options [ARG]... -# --------------------------------- -# Perform any sanity checks on option settings and/or unconsumed -# arguments. -libtool_validate_options () -{ - # save first non-option argument - if test 0 -lt $#; then - nonopt=$1 - shift - fi - - # preserve --debug - test : = "$debug_cmd" || func_append preserve_args " --debug" - - case $host in - # Solaris2 added to fix http://debbugs.gnu.org/cgi/bugreport.cgi?bug=16452 - # see also: http://gcc.gnu.org/bugzilla/show_bug.cgi?id=59788 - *cygwin* | *mingw* | *pw32* | *cegcc* | *solaris2* | *os2*) - # don't eliminate duplications in $postdeps and $predeps - opt_duplicate_compiler_generated_deps=: - ;; - *) - opt_duplicate_compiler_generated_deps=$opt_preserve_dup_deps - ;; - esac - - $opt_help || { - # Sanity checks first: - func_check_version_match - - test yes != "$build_libtool_libs" \ - && test yes != "$build_old_libs" \ - && func_fatal_configuration "not configured to build any kind of library" - - # Darwin sucks - eval std_shrext=\"$shrext_cmds\" - - # Only execute mode is allowed to have -dlopen flags. - if test -n "$opt_dlopen" && test execute != "$opt_mode"; then - func_error "unrecognized option '-dlopen'" - $ECHO "$help" 1>&2 - exit $EXIT_FAILURE - fi - - # Change the help message to a mode-specific one. - generic_help=$help - help="Try '$progname --help --mode=$opt_mode' for more information." - } - - # Pass back the unparsed argument list - func_quote_for_eval ${1+"$@"} - libtool_validate_options_result=$func_quote_for_eval_result -} -func_add_hook func_validate_options libtool_validate_options - - -# Process options as early as possible so that --help and --version -# can return quickly. -func_options ${1+"$@"} -eval set dummy "$func_options_result"; shift - - - -## ----------- ## -## Main. ## -## ----------- ## - -magic='%%%MAGIC variable%%%' -magic_exe='%%%MAGIC EXE variable%%%' - -# Global variables. -extracted_archives= -extracted_serial=0 - -# If this variable is set in any of the actions, the command in it -# will be execed at the end. This prevents here-documents from being -# left over by shells. -exec_cmd= - - -# A function that is used when there is no print builtin or printf. -func_fallback_echo () -{ - eval 'cat <<_LTECHO_EOF -$1 -_LTECHO_EOF' -} - -# func_generated_by_libtool -# True iff stdin has been generated by Libtool. This function is only -# a basic sanity check; it will hardly flush out determined imposters. -func_generated_by_libtool_p () -{ - $GREP "^# Generated by .*$PACKAGE" > /dev/null 2>&1 -} - -# func_lalib_p file -# True iff FILE is a libtool '.la' library or '.lo' object file. -# This function is only a basic sanity check; it will hardly flush out -# determined imposters. -func_lalib_p () -{ - test -f "$1" && - $SED -e 4q "$1" 2>/dev/null | func_generated_by_libtool_p -} - -# func_lalib_unsafe_p file -# True iff FILE is a libtool '.la' library or '.lo' object file. -# This function implements the same check as func_lalib_p without -# resorting to external programs. To this end, it redirects stdin and -# closes it afterwards, without saving the original file descriptor. -# As a safety measure, use it only where a negative result would be -# fatal anyway. Works if 'file' does not exist. -func_lalib_unsafe_p () -{ - lalib_p=no - if test -f "$1" && test -r "$1" && exec 5<&0 <"$1"; then - for lalib_p_l in 1 2 3 4 - do - read lalib_p_line - case $lalib_p_line in - \#\ Generated\ by\ *$PACKAGE* ) lalib_p=yes; break;; - esac - done - exec 0<&5 5<&- - fi - test yes = "$lalib_p" -} - -# func_ltwrapper_script_p file -# True iff FILE is a libtool wrapper script -# This function is only a basic sanity check; it will hardly flush out -# determined imposters. -func_ltwrapper_script_p () -{ - test -f "$1" && - $lt_truncate_bin < "$1" 2>/dev/null | func_generated_by_libtool_p -} - -# func_ltwrapper_executable_p file -# True iff FILE is a libtool wrapper executable -# This function is only a basic sanity check; it will hardly flush out -# determined imposters. -func_ltwrapper_executable_p () -{ - func_ltwrapper_exec_suffix= - case $1 in - *.exe) ;; - *) func_ltwrapper_exec_suffix=.exe ;; - esac - $GREP "$magic_exe" "$1$func_ltwrapper_exec_suffix" >/dev/null 2>&1 -} - -# func_ltwrapper_scriptname file -# Assumes file is an ltwrapper_executable -# uses $file to determine the appropriate filename for a -# temporary ltwrapper_script. -func_ltwrapper_scriptname () -{ - func_dirname_and_basename "$1" "" "." - func_stripname '' '.exe' "$func_basename_result" - func_ltwrapper_scriptname_result=$func_dirname_result/$objdir/${func_stripname_result}_ltshwrapper -} - -# func_ltwrapper_p file -# True iff FILE is a libtool wrapper script or wrapper executable -# This function is only a basic sanity check; it will hardly flush out -# determined imposters. -func_ltwrapper_p () -{ - func_ltwrapper_script_p "$1" || func_ltwrapper_executable_p "$1" -} - - -# func_execute_cmds commands fail_cmd -# Execute tilde-delimited COMMANDS. -# If FAIL_CMD is given, eval that upon failure. -# FAIL_CMD may read-access the current command in variable CMD! -func_execute_cmds () -{ - $debug_cmd - - save_ifs=$IFS; IFS='~' - for cmd in $1; do - IFS=$sp$nl - eval cmd=\"$cmd\" - IFS=$save_ifs - func_show_eval "$cmd" "${2-:}" - done - IFS=$save_ifs -} - - -# func_source file -# Source FILE, adding directory component if necessary. -# Note that it is not necessary on cygwin/mingw to append a dot to -# FILE even if both FILE and FILE.exe exist: automatic-append-.exe -# behavior happens only for exec(3), not for open(2)! Also, sourcing -# 'FILE.' does not work on cygwin managed mounts. -func_source () -{ - $debug_cmd - - case $1 in - */* | *\\*) . "$1" ;; - *) . "./$1" ;; - esac -} - - -# func_resolve_sysroot PATH -# Replace a leading = in PATH with a sysroot. Store the result into -# func_resolve_sysroot_result -func_resolve_sysroot () -{ - func_resolve_sysroot_result=$1 - case $func_resolve_sysroot_result in - =*) - func_stripname '=' '' "$func_resolve_sysroot_result" - func_resolve_sysroot_result=$lt_sysroot$func_stripname_result - ;; - esac -} - -# func_replace_sysroot PATH -# If PATH begins with the sysroot, replace it with = and -# store the result into func_replace_sysroot_result. -func_replace_sysroot () -{ - case $lt_sysroot:$1 in - ?*:"$lt_sysroot"*) - func_stripname "$lt_sysroot" '' "$1" - func_replace_sysroot_result='='$func_stripname_result - ;; - *) - # Including no sysroot. - func_replace_sysroot_result=$1 - ;; - esac -} - -# func_infer_tag arg -# Infer tagged configuration to use if any are available and -# if one wasn't chosen via the "--tag" command line option. -# Only attempt this if the compiler in the base compile -# command doesn't match the default compiler. -# arg is usually of the form 'gcc ...' -func_infer_tag () -{ - $debug_cmd - - if test -n "$available_tags" && test -z "$tagname"; then - CC_quoted= - for arg in $CC; do - func_append_quoted CC_quoted "$arg" - done - CC_expanded=`func_echo_all $CC` - CC_quoted_expanded=`func_echo_all $CC_quoted` - case $@ in - # Blanks in the command may have been stripped by the calling shell, - # but not from the CC environment variable when configure was run. - " $CC "* | "$CC "* | " $CC_expanded "* | "$CC_expanded "* | \ - " $CC_quoted"* | "$CC_quoted "* | " $CC_quoted_expanded "* | "$CC_quoted_expanded "*) ;; - # Blanks at the start of $base_compile will cause this to fail - # if we don't check for them as well. - *) - for z in $available_tags; do - if $GREP "^# ### BEGIN LIBTOOL TAG CONFIG: $z$" < "$progpath" > /dev/null; then - # Evaluate the configuration. - eval "`$SED -n -e '/^# ### BEGIN LIBTOOL TAG CONFIG: '$z'$/,/^# ### END LIBTOOL TAG CONFIG: '$z'$/p' < $progpath`" - CC_quoted= - for arg in $CC; do - # Double-quote args containing other shell metacharacters. - func_append_quoted CC_quoted "$arg" - done - CC_expanded=`func_echo_all $CC` - CC_quoted_expanded=`func_echo_all $CC_quoted` - case "$@ " in - " $CC "* | "$CC "* | " $CC_expanded "* | "$CC_expanded "* | \ - " $CC_quoted"* | "$CC_quoted "* | " $CC_quoted_expanded "* | "$CC_quoted_expanded "*) - # The compiler in the base compile command matches - # the one in the tagged configuration. - # Assume this is the tagged configuration we want. - tagname=$z - break - ;; - esac - fi - done - # If $tagname still isn't set, then no tagged configuration - # was found and let the user know that the "--tag" command - # line option must be used. - if test -z "$tagname"; then - func_echo "unable to infer tagged configuration" - func_fatal_error "specify a tag with '--tag'" -# else -# func_verbose "using $tagname tagged configuration" - fi - ;; - esac - fi -} - - - -# func_write_libtool_object output_name pic_name nonpic_name -# Create a libtool object file (analogous to a ".la" file), -# but don't create it if we're doing a dry run. -func_write_libtool_object () -{ - write_libobj=$1 - if test yes = "$build_libtool_libs"; then - write_lobj=\'$2\' - else - write_lobj=none - fi - - if test yes = "$build_old_libs"; then - write_oldobj=\'$3\' - else - write_oldobj=none - fi - - $opt_dry_run || { - cat >${write_libobj}T </dev/null` - if test "$?" -eq 0 && test -n "$func_convert_core_file_wine_to_w32_tmp"; then - func_convert_core_file_wine_to_w32_result=`$ECHO "$func_convert_core_file_wine_to_w32_tmp" | - $SED -e "$sed_naive_backslashify"` - else - func_convert_core_file_wine_to_w32_result= - fi - fi -} -# end: func_convert_core_file_wine_to_w32 - - -# func_convert_core_path_wine_to_w32 ARG -# Helper function used by path conversion functions when $build is *nix, and -# $host is mingw, cygwin, or some other w32 environment. Relies on a correctly -# configured wine environment available, with the winepath program in $build's -# $PATH. Assumes ARG has no leading or trailing path separator characters. -# -# ARG is path to be converted from $build format to win32. -# Result is available in $func_convert_core_path_wine_to_w32_result. -# Unconvertible file (directory) names in ARG are skipped; if no directory names -# are convertible, then the result may be empty. -func_convert_core_path_wine_to_w32 () -{ - $debug_cmd - - # unfortunately, winepath doesn't convert paths, only file names - func_convert_core_path_wine_to_w32_result= - if test -n "$1"; then - oldIFS=$IFS - IFS=: - for func_convert_core_path_wine_to_w32_f in $1; do - IFS=$oldIFS - func_convert_core_file_wine_to_w32 "$func_convert_core_path_wine_to_w32_f" - if test -n "$func_convert_core_file_wine_to_w32_result"; then - if test -z "$func_convert_core_path_wine_to_w32_result"; then - func_convert_core_path_wine_to_w32_result=$func_convert_core_file_wine_to_w32_result - else - func_append func_convert_core_path_wine_to_w32_result ";$func_convert_core_file_wine_to_w32_result" - fi - fi - done - IFS=$oldIFS - fi -} -# end: func_convert_core_path_wine_to_w32 - - -# func_cygpath ARGS... -# Wrapper around calling the cygpath program via LT_CYGPATH. This is used when -# when (1) $build is *nix and Cygwin is hosted via a wine environment; or (2) -# $build is MSYS and $host is Cygwin, or (3) $build is Cygwin. In case (1) or -# (2), returns the Cygwin file name or path in func_cygpath_result (input -# file name or path is assumed to be in w32 format, as previously converted -# from $build's *nix or MSYS format). In case (3), returns the w32 file name -# or path in func_cygpath_result (input file name or path is assumed to be in -# Cygwin format). Returns an empty string on error. -# -# ARGS are passed to cygpath, with the last one being the file name or path to -# be converted. -# -# Specify the absolute *nix (or w32) name to cygpath in the LT_CYGPATH -# environment variable; do not put it in $PATH. -func_cygpath () -{ - $debug_cmd - - if test -n "$LT_CYGPATH" && test -f "$LT_CYGPATH"; then - func_cygpath_result=`$LT_CYGPATH "$@" 2>/dev/null` - if test "$?" -ne 0; then - # on failure, ensure result is empty - func_cygpath_result= - fi - else - func_cygpath_result= - func_error "LT_CYGPATH is empty or specifies non-existent file: '$LT_CYGPATH'" - fi -} -#end: func_cygpath - - -# func_convert_core_msys_to_w32 ARG -# Convert file name or path ARG from MSYS format to w32 format. Return -# result in func_convert_core_msys_to_w32_result. -func_convert_core_msys_to_w32 () -{ - $debug_cmd - - # awkward: cmd appends spaces to result - func_convert_core_msys_to_w32_result=`( cmd //c echo "$1" ) 2>/dev/null | - $SED -e 's/[ ]*$//' -e "$sed_naive_backslashify"` -} -#end: func_convert_core_msys_to_w32 - - -# func_convert_file_check ARG1 ARG2 -# Verify that ARG1 (a file name in $build format) was converted to $host -# format in ARG2. Otherwise, emit an error message, but continue (resetting -# func_to_host_file_result to ARG1). -func_convert_file_check () -{ - $debug_cmd - - if test -z "$2" && test -n "$1"; then - func_error "Could not determine host file name corresponding to" - func_error " '$1'" - func_error "Continuing, but uninstalled executables may not work." - # Fallback: - func_to_host_file_result=$1 - fi -} -# end func_convert_file_check - - -# func_convert_path_check FROM_PATHSEP TO_PATHSEP FROM_PATH TO_PATH -# Verify that FROM_PATH (a path in $build format) was converted to $host -# format in TO_PATH. Otherwise, emit an error message, but continue, resetting -# func_to_host_file_result to a simplistic fallback value (see below). -func_convert_path_check () -{ - $debug_cmd - - if test -z "$4" && test -n "$3"; then - func_error "Could not determine the host path corresponding to" - func_error " '$3'" - func_error "Continuing, but uninstalled executables may not work." - # Fallback. This is a deliberately simplistic "conversion" and - # should not be "improved". See libtool.info. - if test "x$1" != "x$2"; then - lt_replace_pathsep_chars="s|$1|$2|g" - func_to_host_path_result=`echo "$3" | - $SED -e "$lt_replace_pathsep_chars"` - else - func_to_host_path_result=$3 - fi - fi -} -# end func_convert_path_check - - -# func_convert_path_front_back_pathsep FRONTPAT BACKPAT REPL ORIG -# Modifies func_to_host_path_result by prepending REPL if ORIG matches FRONTPAT -# and appending REPL if ORIG matches BACKPAT. -func_convert_path_front_back_pathsep () -{ - $debug_cmd - - case $4 in - $1 ) func_to_host_path_result=$3$func_to_host_path_result - ;; - esac - case $4 in - $2 ) func_append func_to_host_path_result "$3" - ;; - esac -} -# end func_convert_path_front_back_pathsep - - -################################################## -# $build to $host FILE NAME CONVERSION FUNCTIONS # -################################################## -# invoked via '$to_host_file_cmd ARG' -# -# In each case, ARG is the path to be converted from $build to $host format. -# Result will be available in $func_to_host_file_result. - - -# func_to_host_file ARG -# Converts the file name ARG from $build format to $host format. Return result -# in func_to_host_file_result. -func_to_host_file () -{ - $debug_cmd - - $to_host_file_cmd "$1" -} -# end func_to_host_file - - -# func_to_tool_file ARG LAZY -# converts the file name ARG from $build format to toolchain format. Return -# result in func_to_tool_file_result. If the conversion in use is listed -# in (the comma separated) LAZY, no conversion takes place. -func_to_tool_file () -{ - $debug_cmd - - case ,$2, in - *,"$to_tool_file_cmd",*) - func_to_tool_file_result=$1 - ;; - *) - $to_tool_file_cmd "$1" - func_to_tool_file_result=$func_to_host_file_result - ;; - esac -} -# end func_to_tool_file - - -# func_convert_file_noop ARG -# Copy ARG to func_to_host_file_result. -func_convert_file_noop () -{ - func_to_host_file_result=$1 -} -# end func_convert_file_noop - - -# func_convert_file_msys_to_w32 ARG -# Convert file name ARG from (mingw) MSYS to (mingw) w32 format; automatic -# conversion to w32 is not available inside the cwrapper. Returns result in -# func_to_host_file_result. -func_convert_file_msys_to_w32 () -{ - $debug_cmd - - func_to_host_file_result=$1 - if test -n "$1"; then - func_convert_core_msys_to_w32 "$1" - func_to_host_file_result=$func_convert_core_msys_to_w32_result - fi - func_convert_file_check "$1" "$func_to_host_file_result" -} -# end func_convert_file_msys_to_w32 - - -# func_convert_file_cygwin_to_w32 ARG -# Convert file name ARG from Cygwin to w32 format. Returns result in -# func_to_host_file_result. -func_convert_file_cygwin_to_w32 () -{ - $debug_cmd - - func_to_host_file_result=$1 - if test -n "$1"; then - # because $build is cygwin, we call "the" cygpath in $PATH; no need to use - # LT_CYGPATH in this case. - func_to_host_file_result=`cygpath -m "$1"` - fi - func_convert_file_check "$1" "$func_to_host_file_result" -} -# end func_convert_file_cygwin_to_w32 - - -# func_convert_file_nix_to_w32 ARG -# Convert file name ARG from *nix to w32 format. Requires a wine environment -# and a working winepath. Returns result in func_to_host_file_result. -func_convert_file_nix_to_w32 () -{ - $debug_cmd - - func_to_host_file_result=$1 - if test -n "$1"; then - func_convert_core_file_wine_to_w32 "$1" - func_to_host_file_result=$func_convert_core_file_wine_to_w32_result - fi - func_convert_file_check "$1" "$func_to_host_file_result" -} -# end func_convert_file_nix_to_w32 - - -# func_convert_file_msys_to_cygwin ARG -# Convert file name ARG from MSYS to Cygwin format. Requires LT_CYGPATH set. -# Returns result in func_to_host_file_result. -func_convert_file_msys_to_cygwin () -{ - $debug_cmd - - func_to_host_file_result=$1 - if test -n "$1"; then - func_convert_core_msys_to_w32 "$1" - func_cygpath -u "$func_convert_core_msys_to_w32_result" - func_to_host_file_result=$func_cygpath_result - fi - func_convert_file_check "$1" "$func_to_host_file_result" -} -# end func_convert_file_msys_to_cygwin - - -# func_convert_file_nix_to_cygwin ARG -# Convert file name ARG from *nix to Cygwin format. Requires Cygwin installed -# in a wine environment, working winepath, and LT_CYGPATH set. Returns result -# in func_to_host_file_result. -func_convert_file_nix_to_cygwin () -{ - $debug_cmd - - func_to_host_file_result=$1 - if test -n "$1"; then - # convert from *nix to w32, then use cygpath to convert from w32 to cygwin. - func_convert_core_file_wine_to_w32 "$1" - func_cygpath -u "$func_convert_core_file_wine_to_w32_result" - func_to_host_file_result=$func_cygpath_result - fi - func_convert_file_check "$1" "$func_to_host_file_result" -} -# end func_convert_file_nix_to_cygwin - - -############################################# -# $build to $host PATH CONVERSION FUNCTIONS # -############################################# -# invoked via '$to_host_path_cmd ARG' -# -# In each case, ARG is the path to be converted from $build to $host format. -# The result will be available in $func_to_host_path_result. -# -# Path separators are also converted from $build format to $host format. If -# ARG begins or ends with a path separator character, it is preserved (but -# converted to $host format) on output. -# -# All path conversion functions are named using the following convention: -# file name conversion function : func_convert_file_X_to_Y () -# path conversion function : func_convert_path_X_to_Y () -# where, for any given $build/$host combination the 'X_to_Y' value is the -# same. If conversion functions are added for new $build/$host combinations, -# the two new functions must follow this pattern, or func_init_to_host_path_cmd -# will break. - - -# func_init_to_host_path_cmd -# Ensures that function "pointer" variable $to_host_path_cmd is set to the -# appropriate value, based on the value of $to_host_file_cmd. -to_host_path_cmd= -func_init_to_host_path_cmd () -{ - $debug_cmd - - if test -z "$to_host_path_cmd"; then - func_stripname 'func_convert_file_' '' "$to_host_file_cmd" - to_host_path_cmd=func_convert_path_$func_stripname_result - fi -} - - -# func_to_host_path ARG -# Converts the path ARG from $build format to $host format. Return result -# in func_to_host_path_result. -func_to_host_path () -{ - $debug_cmd - - func_init_to_host_path_cmd - $to_host_path_cmd "$1" -} -# end func_to_host_path - - -# func_convert_path_noop ARG -# Copy ARG to func_to_host_path_result. -func_convert_path_noop () -{ - func_to_host_path_result=$1 -} -# end func_convert_path_noop - - -# func_convert_path_msys_to_w32 ARG -# Convert path ARG from (mingw) MSYS to (mingw) w32 format; automatic -# conversion to w32 is not available inside the cwrapper. Returns result in -# func_to_host_path_result. -func_convert_path_msys_to_w32 () -{ - $debug_cmd - - func_to_host_path_result=$1 - if test -n "$1"; then - # Remove leading and trailing path separator characters from ARG. MSYS - # behavior is inconsistent here; cygpath turns them into '.;' and ';.'; - # and winepath ignores them completely. - func_stripname : : "$1" - func_to_host_path_tmp1=$func_stripname_result - func_convert_core_msys_to_w32 "$func_to_host_path_tmp1" - func_to_host_path_result=$func_convert_core_msys_to_w32_result - func_convert_path_check : ";" \ - "$func_to_host_path_tmp1" "$func_to_host_path_result" - func_convert_path_front_back_pathsep ":*" "*:" ";" "$1" - fi -} -# end func_convert_path_msys_to_w32 - - -# func_convert_path_cygwin_to_w32 ARG -# Convert path ARG from Cygwin to w32 format. Returns result in -# func_to_host_file_result. -func_convert_path_cygwin_to_w32 () -{ - $debug_cmd - - func_to_host_path_result=$1 - if test -n "$1"; then - # See func_convert_path_msys_to_w32: - func_stripname : : "$1" - func_to_host_path_tmp1=$func_stripname_result - func_to_host_path_result=`cygpath -m -p "$func_to_host_path_tmp1"` - func_convert_path_check : ";" \ - "$func_to_host_path_tmp1" "$func_to_host_path_result" - func_convert_path_front_back_pathsep ":*" "*:" ";" "$1" - fi -} -# end func_convert_path_cygwin_to_w32 - - -# func_convert_path_nix_to_w32 ARG -# Convert path ARG from *nix to w32 format. Requires a wine environment and -# a working winepath. Returns result in func_to_host_file_result. -func_convert_path_nix_to_w32 () -{ - $debug_cmd - - func_to_host_path_result=$1 - if test -n "$1"; then - # See func_convert_path_msys_to_w32: - func_stripname : : "$1" - func_to_host_path_tmp1=$func_stripname_result - func_convert_core_path_wine_to_w32 "$func_to_host_path_tmp1" - func_to_host_path_result=$func_convert_core_path_wine_to_w32_result - func_convert_path_check : ";" \ - "$func_to_host_path_tmp1" "$func_to_host_path_result" - func_convert_path_front_back_pathsep ":*" "*:" ";" "$1" - fi -} -# end func_convert_path_nix_to_w32 - - -# func_convert_path_msys_to_cygwin ARG -# Convert path ARG from MSYS to Cygwin format. Requires LT_CYGPATH set. -# Returns result in func_to_host_file_result. -func_convert_path_msys_to_cygwin () -{ - $debug_cmd - - func_to_host_path_result=$1 - if test -n "$1"; then - # See func_convert_path_msys_to_w32: - func_stripname : : "$1" - func_to_host_path_tmp1=$func_stripname_result - func_convert_core_msys_to_w32 "$func_to_host_path_tmp1" - func_cygpath -u -p "$func_convert_core_msys_to_w32_result" - func_to_host_path_result=$func_cygpath_result - func_convert_path_check : : \ - "$func_to_host_path_tmp1" "$func_to_host_path_result" - func_convert_path_front_back_pathsep ":*" "*:" : "$1" - fi -} -# end func_convert_path_msys_to_cygwin - - -# func_convert_path_nix_to_cygwin ARG -# Convert path ARG from *nix to Cygwin format. Requires Cygwin installed in a -# a wine environment, working winepath, and LT_CYGPATH set. Returns result in -# func_to_host_file_result. -func_convert_path_nix_to_cygwin () -{ - $debug_cmd - - func_to_host_path_result=$1 - if test -n "$1"; then - # Remove leading and trailing path separator characters from - # ARG. msys behavior is inconsistent here, cygpath turns them - # into '.;' and ';.', and winepath ignores them completely. - func_stripname : : "$1" - func_to_host_path_tmp1=$func_stripname_result - func_convert_core_path_wine_to_w32 "$func_to_host_path_tmp1" - func_cygpath -u -p "$func_convert_core_path_wine_to_w32_result" - func_to_host_path_result=$func_cygpath_result - func_convert_path_check : : \ - "$func_to_host_path_tmp1" "$func_to_host_path_result" - func_convert_path_front_back_pathsep ":*" "*:" : "$1" - fi -} -# end func_convert_path_nix_to_cygwin - - -# func_dll_def_p FILE -# True iff FILE is a Windows DLL '.def' file. -# Keep in sync with _LT_DLL_DEF_P in libtool.m4 -func_dll_def_p () -{ - $debug_cmd - - func_dll_def_p_tmp=`$SED -n \ - -e 's/^[ ]*//' \ - -e '/^\(;.*\)*$/d' \ - -e 's/^\(EXPORTS\|LIBRARY\)\([ ].*\)*$/DEF/p' \ - -e q \ - "$1"` - test DEF = "$func_dll_def_p_tmp" -} - - -# func_mode_compile arg... -func_mode_compile () -{ - $debug_cmd - - # Get the compilation command and the source file. - base_compile= - srcfile=$nonopt # always keep a non-empty value in "srcfile" - suppress_opt=yes - suppress_output= - arg_mode=normal - libobj= - later= - pie_flag= - - for arg - do - case $arg_mode in - arg ) - # do not "continue". Instead, add this to base_compile - lastarg=$arg - arg_mode=normal - ;; - - target ) - libobj=$arg - arg_mode=normal - continue - ;; - - normal ) - # Accept any command-line options. - case $arg in - -o) - test -n "$libobj" && \ - func_fatal_error "you cannot specify '-o' more than once" - arg_mode=target - continue - ;; - - -pie | -fpie | -fPIE) - func_append pie_flag " $arg" - continue - ;; - - -shared | -static | -prefer-pic | -prefer-non-pic) - func_append later " $arg" - continue - ;; - - -no-suppress) - suppress_opt=no - continue - ;; - - -Xcompiler) - arg_mode=arg # the next one goes into the "base_compile" arg list - continue # The current "srcfile" will either be retained or - ;; # replaced later. I would guess that would be a bug. - - -Wc,*) - func_stripname '-Wc,' '' "$arg" - args=$func_stripname_result - lastarg= - save_ifs=$IFS; IFS=, - for arg in $args; do - IFS=$save_ifs - func_append_quoted lastarg "$arg" - done - IFS=$save_ifs - func_stripname ' ' '' "$lastarg" - lastarg=$func_stripname_result - - # Add the arguments to base_compile. - func_append base_compile " $lastarg" - continue - ;; - - *) - # Accept the current argument as the source file. - # The previous "srcfile" becomes the current argument. - # - lastarg=$srcfile - srcfile=$arg - ;; - esac # case $arg - ;; - esac # case $arg_mode - - # Aesthetically quote the previous argument. - func_append_quoted base_compile "$lastarg" - done # for arg - - case $arg_mode in - arg) - func_fatal_error "you must specify an argument for -Xcompile" - ;; - target) - func_fatal_error "you must specify a target with '-o'" - ;; - *) - # Get the name of the library object. - test -z "$libobj" && { - func_basename "$srcfile" - libobj=$func_basename_result - } - ;; - esac - - # Recognize several different file suffixes. - # If the user specifies -o file.o, it is replaced with file.lo - case $libobj in - *.[cCFSifmso] | \ - *.ada | *.adb | *.ads | *.asm | \ - *.c++ | *.cc | *.ii | *.class | *.cpp | *.cxx | \ - *.[fF][09]? | *.for | *.java | *.go | *.obj | *.sx | *.cu | *.cup) - func_xform "$libobj" - libobj=$func_xform_result - ;; - esac - - case $libobj in - *.lo) func_lo2o "$libobj"; obj=$func_lo2o_result ;; - *) - func_fatal_error "cannot determine name of library object from '$libobj'" - ;; - esac - - func_infer_tag $base_compile - - for arg in $later; do - case $arg in - -shared) - test yes = "$build_libtool_libs" \ - || func_fatal_configuration "cannot build a shared library" - build_old_libs=no - continue - ;; - - -static) - build_libtool_libs=no - build_old_libs=yes - continue - ;; - - -prefer-pic) - pic_mode=yes - continue - ;; - - -prefer-non-pic) - pic_mode=no - continue - ;; - esac - done - - func_quote_for_eval "$libobj" - test "X$libobj" != "X$func_quote_for_eval_result" \ - && $ECHO "X$libobj" | $GREP '[]~#^*{};<>?"'"'"' &()|`$[]' \ - && func_warning "libobj name '$libobj' may not contain shell special characters." - func_dirname_and_basename "$obj" "/" "" - objname=$func_basename_result - xdir=$func_dirname_result - lobj=$xdir$objdir/$objname - - test -z "$base_compile" && \ - func_fatal_help "you must specify a compilation command" - - # Delete any leftover library objects. - if test yes = "$build_old_libs"; then - removelist="$obj $lobj $libobj ${libobj}T" - else - removelist="$lobj $libobj ${libobj}T" - fi - - # On Cygwin there's no "real" PIC flag so we must build both object types - case $host_os in - cygwin* | mingw* | pw32* | os2* | cegcc*) - pic_mode=default - ;; - esac - if test no = "$pic_mode" && test pass_all != "$deplibs_check_method"; then - # non-PIC code in shared libraries is not supported - pic_mode=default - fi - - # Calculate the filename of the output object if compiler does - # not support -o with -c - if test no = "$compiler_c_o"; then - output_obj=`$ECHO "$srcfile" | $SED 's%^.*/%%; s%\.[^.]*$%%'`.$objext - lockfile=$output_obj.lock - else - output_obj= - need_locks=no - lockfile= - fi - - # Lock this critical section if it is needed - # We use this script file to make the link, it avoids creating a new file - if test yes = "$need_locks"; then - until $opt_dry_run || ln "$progpath" "$lockfile" 2>/dev/null; do - func_echo "Waiting for $lockfile to be removed" - sleep 2 - done - elif test warn = "$need_locks"; then - if test -f "$lockfile"; then - $ECHO "\ -*** ERROR, $lockfile exists and contains: -`cat $lockfile 2>/dev/null` - -This indicates that another process is trying to use the same -temporary object file, and libtool could not work around it because -your compiler does not support '-c' and '-o' together. If you -repeat this compilation, it may succeed, by chance, but you had better -avoid parallel builds (make -j) in this platform, or get a better -compiler." - - $opt_dry_run || $RM $removelist - exit $EXIT_FAILURE - fi - func_append removelist " $output_obj" - $ECHO "$srcfile" > "$lockfile" - fi - - $opt_dry_run || $RM $removelist - func_append removelist " $lockfile" - trap '$opt_dry_run || $RM $removelist; exit $EXIT_FAILURE' 1 2 15 - - func_to_tool_file "$srcfile" func_convert_file_msys_to_w32 - srcfile=$func_to_tool_file_result - func_quote_for_eval "$srcfile" - qsrcfile=$func_quote_for_eval_result - - # Only build a PIC object if we are building libtool libraries. - if test yes = "$build_libtool_libs"; then - # Without this assignment, base_compile gets emptied. - fbsd_hideous_sh_bug=$base_compile - - if test no != "$pic_mode"; then - command="$base_compile $qsrcfile $pic_flag" - else - # Don't build PIC code - command="$base_compile $qsrcfile" - fi - - func_mkdir_p "$xdir$objdir" - - if test -z "$output_obj"; then - # Place PIC objects in $objdir - func_append command " -o $lobj" - fi - - func_show_eval_locale "$command" \ - 'test -n "$output_obj" && $RM $removelist; exit $EXIT_FAILURE' - - if test warn = "$need_locks" && - test "X`cat $lockfile 2>/dev/null`" != "X$srcfile"; then - $ECHO "\ -*** ERROR, $lockfile contains: -`cat $lockfile 2>/dev/null` - -but it should contain: -$srcfile - -This indicates that another process is trying to use the same -temporary object file, and libtool could not work around it because -your compiler does not support '-c' and '-o' together. If you -repeat this compilation, it may succeed, by chance, but you had better -avoid parallel builds (make -j) in this platform, or get a better -compiler." - - $opt_dry_run || $RM $removelist - exit $EXIT_FAILURE - fi - - # Just move the object if needed, then go on to compile the next one - if test -n "$output_obj" && test "X$output_obj" != "X$lobj"; then - func_show_eval '$MV "$output_obj" "$lobj"' \ - 'error=$?; $opt_dry_run || $RM $removelist; exit $error' - fi - - # Allow error messages only from the first compilation. - if test yes = "$suppress_opt"; then - suppress_output=' >/dev/null 2>&1' - fi - fi - - # Only build a position-dependent object if we build old libraries. - if test yes = "$build_old_libs"; then - if test yes != "$pic_mode"; then - # Don't build PIC code - command="$base_compile $qsrcfile$pie_flag" - else - command="$base_compile $qsrcfile $pic_flag" - fi - if test yes = "$compiler_c_o"; then - func_append command " -o $obj" - fi - - # Suppress compiler output if we already did a PIC compilation. - func_append command "$suppress_output" - func_show_eval_locale "$command" \ - '$opt_dry_run || $RM $removelist; exit $EXIT_FAILURE' - - if test warn = "$need_locks" && - test "X`cat $lockfile 2>/dev/null`" != "X$srcfile"; then - $ECHO "\ -*** ERROR, $lockfile contains: -`cat $lockfile 2>/dev/null` - -but it should contain: -$srcfile - -This indicates that another process is trying to use the same -temporary object file, and libtool could not work around it because -your compiler does not support '-c' and '-o' together. If you -repeat this compilation, it may succeed, by chance, but you had better -avoid parallel builds (make -j) in this platform, or get a better -compiler." - - $opt_dry_run || $RM $removelist - exit $EXIT_FAILURE - fi - - # Just move the object if needed - if test -n "$output_obj" && test "X$output_obj" != "X$obj"; then - func_show_eval '$MV "$output_obj" "$obj"' \ - 'error=$?; $opt_dry_run || $RM $removelist; exit $error' - fi - fi - - $opt_dry_run || { - func_write_libtool_object "$libobj" "$objdir/$objname" "$objname" - - # Unlock the critical section if it was locked - if test no != "$need_locks"; then - removelist=$lockfile - $RM "$lockfile" - fi - } - - exit $EXIT_SUCCESS -} - -$opt_help || { - test compile = "$opt_mode" && func_mode_compile ${1+"$@"} -} - -func_mode_help () -{ - # We need to display help for each of the modes. - case $opt_mode in - "") - # Generic help is extracted from the usage comments - # at the start of this file. - func_help - ;; - - clean) - $ECHO \ -"Usage: $progname [OPTION]... --mode=clean RM [RM-OPTION]... FILE... - -Remove files from the build directory. - -RM is the name of the program to use to delete files associated with each FILE -(typically '/bin/rm'). RM-OPTIONS are options (such as '-f') to be passed -to RM. - -If FILE is a libtool library, object or program, all the files associated -with it are deleted. Otherwise, only FILE itself is deleted using RM." - ;; - - compile) - $ECHO \ -"Usage: $progname [OPTION]... --mode=compile COMPILE-COMMAND... SOURCEFILE - -Compile a source file into a libtool library object. - -This mode accepts the following additional options: - - -o OUTPUT-FILE set the output file name to OUTPUT-FILE - -no-suppress do not suppress compiler output for multiple passes - -prefer-pic try to build PIC objects only - -prefer-non-pic try to build non-PIC objects only - -shared do not build a '.o' file suitable for static linking - -static only build a '.o' file suitable for static linking - -Wc,FLAG pass FLAG directly to the compiler - -COMPILE-COMMAND is a command to be used in creating a 'standard' object file -from the given SOURCEFILE. - -The output file name is determined by removing the directory component from -SOURCEFILE, then substituting the C source code suffix '.c' with the -library object suffix, '.lo'." - ;; - - execute) - $ECHO \ -"Usage: $progname [OPTION]... --mode=execute COMMAND [ARGS]... - -Automatically set library path, then run a program. - -This mode accepts the following additional options: - - -dlopen FILE add the directory containing FILE to the library path - -This mode sets the library path environment variable according to '-dlopen' -flags. - -If any of the ARGS are libtool executable wrappers, then they are translated -into their corresponding uninstalled binary, and any of their required library -directories are added to the library path. - -Then, COMMAND is executed, with ARGS as arguments." - ;; - - finish) - $ECHO \ -"Usage: $progname [OPTION]... --mode=finish [LIBDIR]... - -Complete the installation of libtool libraries. - -Each LIBDIR is a directory that contains libtool libraries. - -The commands that this mode executes may require superuser privileges. Use -the '--dry-run' option if you just want to see what would be executed." - ;; - - install) - $ECHO \ -"Usage: $progname [OPTION]... --mode=install INSTALL-COMMAND... - -Install executables or libraries. - -INSTALL-COMMAND is the installation command. The first component should be -either the 'install' or 'cp' program. - -The following components of INSTALL-COMMAND are treated specially: - - -inst-prefix-dir PREFIX-DIR Use PREFIX-DIR as a staging area for installation - -The rest of the components are interpreted as arguments to that command (only -BSD-compatible install options are recognized)." - ;; - - link) - $ECHO \ -"Usage: $progname [OPTION]... --mode=link LINK-COMMAND... - -Link object files or libraries together to form another library, or to -create an executable program. - -LINK-COMMAND is a command using the C compiler that you would use to create -a program from several object files. - -The following components of LINK-COMMAND are treated specially: - - -all-static do not do any dynamic linking at all - -avoid-version do not add a version suffix if possible - -bindir BINDIR specify path to binaries directory (for systems where - libraries must be found in the PATH setting at runtime) - -dlopen FILE '-dlpreopen' FILE if it cannot be dlopened at runtime - -dlpreopen FILE link in FILE and add its symbols to lt_preloaded_symbols - -export-dynamic allow symbols from OUTPUT-FILE to be resolved with dlsym(3) - -export-symbols SYMFILE - try to export only the symbols listed in SYMFILE - -export-symbols-regex REGEX - try to export only the symbols matching REGEX - -LLIBDIR search LIBDIR for required installed libraries - -lNAME OUTPUT-FILE requires the installed library libNAME - -module build a library that can dlopened - -no-fast-install disable the fast-install mode - -no-install link a not-installable executable - -no-undefined declare that a library does not refer to external symbols - -o OUTPUT-FILE create OUTPUT-FILE from the specified objects - -objectlist FILE use a list of object files found in FILE to specify objects - -os2dllname NAME force a short DLL name on OS/2 (no effect on other OSes) - -precious-files-regex REGEX - don't remove output files matching REGEX - -release RELEASE specify package release information - -rpath LIBDIR the created library will eventually be installed in LIBDIR - -R[ ]LIBDIR add LIBDIR to the runtime path of programs and libraries - -shared only do dynamic linking of libtool libraries - -shrext SUFFIX override the standard shared library file extension - -static do not do any dynamic linking of uninstalled libtool libraries - -static-libtool-libs - do not do any dynamic linking of libtool libraries - -version-info CURRENT[:REVISION[:AGE]] - specify library version info [each variable defaults to 0] - -weak LIBNAME declare that the target provides the LIBNAME interface - -Wc,FLAG - -Xcompiler FLAG pass linker-specific FLAG directly to the compiler - -Wl,FLAG - -Xlinker FLAG pass linker-specific FLAG directly to the linker - -XCClinker FLAG pass link-specific FLAG to the compiler driver (CC) - -All other options (arguments beginning with '-') are ignored. - -Every other argument is treated as a filename. Files ending in '.la' are -treated as uninstalled libtool libraries, other files are standard or library -object files. - -If the OUTPUT-FILE ends in '.la', then a libtool library is created, -only library objects ('.lo' files) may be specified, and '-rpath' is -required, except when creating a convenience library. - -If OUTPUT-FILE ends in '.a' or '.lib', then a standard library is created -using 'ar' and 'ranlib', or on Windows using 'lib'. - -If OUTPUT-FILE ends in '.lo' or '.$objext', then a reloadable object file -is created, otherwise an executable program is created." - ;; - - uninstall) - $ECHO \ -"Usage: $progname [OPTION]... --mode=uninstall RM [RM-OPTION]... FILE... - -Remove libraries from an installation directory. - -RM is the name of the program to use to delete files associated with each FILE -(typically '/bin/rm'). RM-OPTIONS are options (such as '-f') to be passed -to RM. - -If FILE is a libtool library, all the files associated with it are deleted. -Otherwise, only FILE itself is deleted using RM." - ;; - - *) - func_fatal_help "invalid operation mode '$opt_mode'" - ;; - esac - - echo - $ECHO "Try '$progname --help' for more information about other modes." -} - -# Now that we've collected a possible --mode arg, show help if necessary -if $opt_help; then - if test : = "$opt_help"; then - func_mode_help - else - { - func_help noexit - for opt_mode in compile link execute install finish uninstall clean; do - func_mode_help - done - } | $SED -n '1p; 2,$s/^Usage:/ or: /p' - { - func_help noexit - for opt_mode in compile link execute install finish uninstall clean; do - echo - func_mode_help - done - } | - $SED '1d - /^When reporting/,/^Report/{ - H - d - } - $x - /information about other modes/d - /more detailed .*MODE/d - s/^Usage:.*--mode=\([^ ]*\) .*/Description of \1 mode:/' - fi - exit $? -fi - - -# func_mode_execute arg... -func_mode_execute () -{ - $debug_cmd - - # The first argument is the command name. - cmd=$nonopt - test -z "$cmd" && \ - func_fatal_help "you must specify a COMMAND" - - # Handle -dlopen flags immediately. - for file in $opt_dlopen; do - test -f "$file" \ - || func_fatal_help "'$file' is not a file" - - dir= - case $file in - *.la) - func_resolve_sysroot "$file" - file=$func_resolve_sysroot_result - - # Check to see that this really is a libtool archive. - func_lalib_unsafe_p "$file" \ - || func_fatal_help "'$lib' is not a valid libtool archive" - - # Read the libtool library. - dlname= - library_names= - func_source "$file" - - # Skip this library if it cannot be dlopened. - if test -z "$dlname"; then - # Warn if it was a shared library. - test -n "$library_names" && \ - func_warning "'$file' was not linked with '-export-dynamic'" - continue - fi - - func_dirname "$file" "" "." - dir=$func_dirname_result - - if test -f "$dir/$objdir/$dlname"; then - func_append dir "/$objdir" - else - if test ! -f "$dir/$dlname"; then - func_fatal_error "cannot find '$dlname' in '$dir' or '$dir/$objdir'" - fi - fi - ;; - - *.lo) - # Just add the directory containing the .lo file. - func_dirname "$file" "" "." - dir=$func_dirname_result - ;; - - *) - func_warning "'-dlopen' is ignored for non-libtool libraries and objects" - continue - ;; - esac - - # Get the absolute pathname. - absdir=`cd "$dir" && pwd` - test -n "$absdir" && dir=$absdir - - # Now add the directory to shlibpath_var. - if eval "test -z \"\$$shlibpath_var\""; then - eval "$shlibpath_var=\"\$dir\"" - else - eval "$shlibpath_var=\"\$dir:\$$shlibpath_var\"" - fi - done - - # This variable tells wrapper scripts just to set shlibpath_var - # rather than running their programs. - libtool_execute_magic=$magic - - # Check if any of the arguments is a wrapper script. - args= - for file - do - case $file in - -* | *.la | *.lo ) ;; - *) - # Do a test to see if this is really a libtool program. - if func_ltwrapper_script_p "$file"; then - func_source "$file" - # Transform arg to wrapped name. - file=$progdir/$program - elif func_ltwrapper_executable_p "$file"; then - func_ltwrapper_scriptname "$file" - func_source "$func_ltwrapper_scriptname_result" - # Transform arg to wrapped name. - file=$progdir/$program - fi - ;; - esac - # Quote arguments (to preserve shell metacharacters). - func_append_quoted args "$file" - done - - if $opt_dry_run; then - # Display what would be done. - if test -n "$shlibpath_var"; then - eval "\$ECHO \"\$shlibpath_var=\$$shlibpath_var\"" - echo "export $shlibpath_var" - fi - $ECHO "$cmd$args" - exit $EXIT_SUCCESS - else - if test -n "$shlibpath_var"; then - # Export the shlibpath_var. - eval "export $shlibpath_var" - fi - - # Restore saved environment variables - for lt_var in LANG LANGUAGE LC_ALL LC_CTYPE LC_COLLATE LC_MESSAGES - do - eval "if test \"\${save_$lt_var+set}\" = set; then - $lt_var=\$save_$lt_var; export $lt_var - else - $lt_unset $lt_var - fi" - done - - # Now prepare to actually exec the command. - exec_cmd=\$cmd$args - fi -} - -test execute = "$opt_mode" && func_mode_execute ${1+"$@"} - - -# func_mode_finish arg... -func_mode_finish () -{ - $debug_cmd - - libs= - libdirs= - admincmds= - - for opt in "$nonopt" ${1+"$@"} - do - if test -d "$opt"; then - func_append libdirs " $opt" - - elif test -f "$opt"; then - if func_lalib_unsafe_p "$opt"; then - func_append libs " $opt" - else - func_warning "'$opt' is not a valid libtool archive" - fi - - else - func_fatal_error "invalid argument '$opt'" - fi - done - - if test -n "$libs"; then - if test -n "$lt_sysroot"; then - sysroot_regex=`$ECHO "$lt_sysroot" | $SED "$sed_make_literal_regex"` - sysroot_cmd="s/\([ ']\)$sysroot_regex/\1/g;" - else - sysroot_cmd= - fi - - # Remove sysroot references - if $opt_dry_run; then - for lib in $libs; do - echo "removing references to $lt_sysroot and '=' prefixes from $lib" - done - else - tmpdir=`func_mktempdir` - for lib in $libs; do - $SED -e "$sysroot_cmd s/\([ ']-[LR]\)=/\1/g; s/\([ ']\)=/\1/g" $lib \ - > $tmpdir/tmp-la - mv -f $tmpdir/tmp-la $lib - done - ${RM}r "$tmpdir" - fi - fi - - if test -n "$finish_cmds$finish_eval" && test -n "$libdirs"; then - for libdir in $libdirs; do - if test -n "$finish_cmds"; then - # Do each command in the finish commands. - func_execute_cmds "$finish_cmds" 'admincmds="$admincmds -'"$cmd"'"' - fi - if test -n "$finish_eval"; then - # Do the single finish_eval. - eval cmds=\"$finish_eval\" - $opt_dry_run || eval "$cmds" || func_append admincmds " - $cmds" - fi - done - fi - - # Exit here if they wanted silent mode. - $opt_quiet && exit $EXIT_SUCCESS - - if test -n "$finish_cmds$finish_eval" && test -n "$libdirs"; then - echo "----------------------------------------------------------------------" - echo "Libraries have been installed in:" - for libdir in $libdirs; do - $ECHO " $libdir" - done - echo - echo "If you ever happen to want to link against installed libraries" - echo "in a given directory, LIBDIR, you must either use libtool, and" - echo "specify the full pathname of the library, or use the '-LLIBDIR'" - echo "flag during linking and do at least one of the following:" - if test -n "$shlibpath_var"; then - echo " - add LIBDIR to the '$shlibpath_var' environment variable" - echo " during execution" - fi - if test -n "$runpath_var"; then - echo " - add LIBDIR to the '$runpath_var' environment variable" - echo " during linking" - fi - if test -n "$hardcode_libdir_flag_spec"; then - libdir=LIBDIR - eval flag=\"$hardcode_libdir_flag_spec\" - - $ECHO " - use the '$flag' linker flag" - fi - if test -n "$admincmds"; then - $ECHO " - have your system administrator run these commands:$admincmds" - fi - if test -f /etc/ld.so.conf; then - echo " - have your system administrator add LIBDIR to '/etc/ld.so.conf'" - fi - echo - - echo "See any operating system documentation about shared libraries for" - case $host in - solaris2.[6789]|solaris2.1[0-9]) - echo "more information, such as the ld(1), crle(1) and ld.so(8) manual" - echo "pages." - ;; - *) - echo "more information, such as the ld(1) and ld.so(8) manual pages." - ;; - esac - echo "----------------------------------------------------------------------" - fi - exit $EXIT_SUCCESS -} - -test finish = "$opt_mode" && func_mode_finish ${1+"$@"} - - -# func_mode_install arg... -func_mode_install () -{ - $debug_cmd - - # There may be an optional sh(1) argument at the beginning of - # install_prog (especially on Windows NT). - if test "$SHELL" = "$nonopt" || test /bin/sh = "$nonopt" || - # Allow the use of GNU shtool's install command. - case $nonopt in *shtool*) :;; *) false;; esac - then - # Aesthetically quote it. - func_quote_for_eval "$nonopt" - install_prog="$func_quote_for_eval_result " - arg=$1 - shift - else - install_prog= - arg=$nonopt - fi - - # The real first argument should be the name of the installation program. - # Aesthetically quote it. - func_quote_for_eval "$arg" - func_append install_prog "$func_quote_for_eval_result" - install_shared_prog=$install_prog - case " $install_prog " in - *[\\\ /]cp\ *) install_cp=: ;; - *) install_cp=false ;; - esac - - # We need to accept at least all the BSD install flags. - dest= - files= - opts= - prev= - install_type= - isdir=false - stripme= - no_mode=: - for arg - do - arg2= - if test -n "$dest"; then - func_append files " $dest" - dest=$arg - continue - fi - - case $arg in - -d) isdir=: ;; - -f) - if $install_cp; then :; else - prev=$arg - fi - ;; - -g | -m | -o) - prev=$arg - ;; - -s) - stripme=" -s" - continue - ;; - -*) - ;; - *) - # If the previous option needed an argument, then skip it. - if test -n "$prev"; then - if test X-m = "X$prev" && test -n "$install_override_mode"; then - arg2=$install_override_mode - no_mode=false - fi - prev= - else - dest=$arg - continue - fi - ;; - esac - - # Aesthetically quote the argument. - func_quote_for_eval "$arg" - func_append install_prog " $func_quote_for_eval_result" - if test -n "$arg2"; then - func_quote_for_eval "$arg2" - fi - func_append install_shared_prog " $func_quote_for_eval_result" - done - - test -z "$install_prog" && \ - func_fatal_help "you must specify an install program" - - test -n "$prev" && \ - func_fatal_help "the '$prev' option requires an argument" - - if test -n "$install_override_mode" && $no_mode; then - if $install_cp; then :; else - func_quote_for_eval "$install_override_mode" - func_append install_shared_prog " -m $func_quote_for_eval_result" - fi - fi - - if test -z "$files"; then - if test -z "$dest"; then - func_fatal_help "no file or destination specified" - else - func_fatal_help "you must specify a destination" - fi - fi - - # Strip any trailing slash from the destination. - func_stripname '' '/' "$dest" - dest=$func_stripname_result - - # Check to see that the destination is a directory. - test -d "$dest" && isdir=: - if $isdir; then - destdir=$dest - destname= - else - func_dirname_and_basename "$dest" "" "." - destdir=$func_dirname_result - destname=$func_basename_result - - # Not a directory, so check to see that there is only one file specified. - set dummy $files; shift - test "$#" -gt 1 && \ - func_fatal_help "'$dest' is not a directory" - fi - case $destdir in - [\\/]* | [A-Za-z]:[\\/]*) ;; - *) - for file in $files; do - case $file in - *.lo) ;; - *) - func_fatal_help "'$destdir' must be an absolute directory name" - ;; - esac - done - ;; - esac - - # This variable tells wrapper scripts just to set variables rather - # than running their programs. - libtool_install_magic=$magic - - staticlibs= - future_libdirs= - current_libdirs= - for file in $files; do - - # Do each installation. - case $file in - *.$libext) - # Do the static libraries later. - func_append staticlibs " $file" - ;; - - *.la) - func_resolve_sysroot "$file" - file=$func_resolve_sysroot_result - - # Check to see that this really is a libtool archive. - func_lalib_unsafe_p "$file" \ - || func_fatal_help "'$file' is not a valid libtool archive" - - library_names= - old_library= - relink_command= - func_source "$file" - - # Add the libdir to current_libdirs if it is the destination. - if test "X$destdir" = "X$libdir"; then - case "$current_libdirs " in - *" $libdir "*) ;; - *) func_append current_libdirs " $libdir" ;; - esac - else - # Note the libdir as a future libdir. - case "$future_libdirs " in - *" $libdir "*) ;; - *) func_append future_libdirs " $libdir" ;; - esac - fi - - func_dirname "$file" "/" "" - dir=$func_dirname_result - func_append dir "$objdir" - - if test -n "$relink_command"; then - # Determine the prefix the user has applied to our future dir. - inst_prefix_dir=`$ECHO "$destdir" | $SED -e "s%$libdir\$%%"` - - # Don't allow the user to place us outside of our expected - # location b/c this prevents finding dependent libraries that - # are installed to the same prefix. - # At present, this check doesn't affect windows .dll's that - # are installed into $libdir/../bin (currently, that works fine) - # but it's something to keep an eye on. - test "$inst_prefix_dir" = "$destdir" && \ - func_fatal_error "error: cannot install '$file' to a directory not ending in $libdir" - - if test -n "$inst_prefix_dir"; then - # Stick the inst_prefix_dir data into the link command. - relink_command=`$ECHO "$relink_command" | $SED "s%@inst_prefix_dir@%-inst-prefix-dir $inst_prefix_dir%"` - else - relink_command=`$ECHO "$relink_command" | $SED "s%@inst_prefix_dir@%%"` - fi - - func_warning "relinking '$file'" - func_show_eval "$relink_command" \ - 'func_fatal_error "error: relink '\''$file'\'' with the above command before installing it"' - fi - - # See the names of the shared library. - set dummy $library_names; shift - if test -n "$1"; then - realname=$1 - shift - - srcname=$realname - test -n "$relink_command" && srcname=${realname}T - - # Install the shared library and build the symlinks. - func_show_eval "$install_shared_prog $dir/$srcname $destdir/$realname" \ - 'exit $?' - tstripme=$stripme - case $host_os in - cygwin* | mingw* | pw32* | cegcc*) - case $realname in - *.dll.a) - tstripme= - ;; - esac - ;; - os2*) - case $realname in - *_dll.a) - tstripme= - ;; - esac - ;; - esac - if test -n "$tstripme" && test -n "$striplib"; then - func_show_eval "$striplib $destdir/$realname" 'exit $?' - fi - - if test "$#" -gt 0; then - # Delete the old symlinks, and create new ones. - # Try 'ln -sf' first, because the 'ln' binary might depend on - # the symlink we replace! Solaris /bin/ln does not understand -f, - # so we also need to try rm && ln -s. - for linkname - do - test "$linkname" != "$realname" \ - && func_show_eval "(cd $destdir && { $LN_S -f $realname $linkname || { $RM $linkname && $LN_S $realname $linkname; }; })" - done - fi - - # Do each command in the postinstall commands. - lib=$destdir/$realname - func_execute_cmds "$postinstall_cmds" 'exit $?' - fi - - # Install the pseudo-library for information purposes. - func_basename "$file" - name=$func_basename_result - instname=$dir/${name}i - func_show_eval "$install_prog $instname $destdir/$name" 'exit $?' - - # Maybe install the static library, too. - test -n "$old_library" && func_append staticlibs " $dir/$old_library" - ;; - - *.lo) - # Install (i.e. copy) a libtool object. - - # Figure out destination file name, if it wasn't already specified. - if test -n "$destname"; then - destfile=$destdir/$destname - else - func_basename "$file" - destfile=$func_basename_result - destfile=$destdir/$destfile - fi - - # Deduce the name of the destination old-style object file. - case $destfile in - *.lo) - func_lo2o "$destfile" - staticdest=$func_lo2o_result - ;; - *.$objext) - staticdest=$destfile - destfile= - ;; - *) - func_fatal_help "cannot copy a libtool object to '$destfile'" - ;; - esac - - # Install the libtool object if requested. - test -n "$destfile" && \ - func_show_eval "$install_prog $file $destfile" 'exit $?' - - # Install the old object if enabled. - if test yes = "$build_old_libs"; then - # Deduce the name of the old-style object file. - func_lo2o "$file" - staticobj=$func_lo2o_result - func_show_eval "$install_prog \$staticobj \$staticdest" 'exit $?' - fi - exit $EXIT_SUCCESS - ;; - - *) - # Figure out destination file name, if it wasn't already specified. - if test -n "$destname"; then - destfile=$destdir/$destname - else - func_basename "$file" - destfile=$func_basename_result - destfile=$destdir/$destfile - fi - - # If the file is missing, and there is a .exe on the end, strip it - # because it is most likely a libtool script we actually want to - # install - stripped_ext= - case $file in - *.exe) - if test ! -f "$file"; then - func_stripname '' '.exe' "$file" - file=$func_stripname_result - stripped_ext=.exe - fi - ;; - esac - - # Do a test to see if this is really a libtool program. - case $host in - *cygwin* | *mingw*) - if func_ltwrapper_executable_p "$file"; then - func_ltwrapper_scriptname "$file" - wrapper=$func_ltwrapper_scriptname_result - else - func_stripname '' '.exe' "$file" - wrapper=$func_stripname_result - fi - ;; - *) - wrapper=$file - ;; - esac - if func_ltwrapper_script_p "$wrapper"; then - notinst_deplibs= - relink_command= - - func_source "$wrapper" - - # Check the variables that should have been set. - test -z "$generated_by_libtool_version" && \ - func_fatal_error "invalid libtool wrapper script '$wrapper'" - - finalize=: - for lib in $notinst_deplibs; do - # Check to see that each library is installed. - libdir= - if test -f "$lib"; then - func_source "$lib" - fi - libfile=$libdir/`$ECHO "$lib" | $SED 's%^.*/%%g'` - if test -n "$libdir" && test ! -f "$libfile"; then - func_warning "'$lib' has not been installed in '$libdir'" - finalize=false - fi - done - - relink_command= - func_source "$wrapper" - - outputname= - if test no = "$fast_install" && test -n "$relink_command"; then - $opt_dry_run || { - if $finalize; then - tmpdir=`func_mktempdir` - func_basename "$file$stripped_ext" - file=$func_basename_result - outputname=$tmpdir/$file - # Replace the output file specification. - relink_command=`$ECHO "$relink_command" | $SED 's%@OUTPUT@%'"$outputname"'%g'` - - $opt_quiet || { - func_quote_for_expand "$relink_command" - eval "func_echo $func_quote_for_expand_result" - } - if eval "$relink_command"; then : - else - func_error "error: relink '$file' with the above command before installing it" - $opt_dry_run || ${RM}r "$tmpdir" - continue - fi - file=$outputname - else - func_warning "cannot relink '$file'" - fi - } - else - # Install the binary that we compiled earlier. - file=`$ECHO "$file$stripped_ext" | $SED "s%\([^/]*\)$%$objdir/\1%"` - fi - fi - - # remove .exe since cygwin /usr/bin/install will append another - # one anyway - case $install_prog,$host in - */usr/bin/install*,*cygwin*) - case $file:$destfile in - *.exe:*.exe) - # this is ok - ;; - *.exe:*) - destfile=$destfile.exe - ;; - *:*.exe) - func_stripname '' '.exe' "$destfile" - destfile=$func_stripname_result - ;; - esac - ;; - esac - func_show_eval "$install_prog\$stripme \$file \$destfile" 'exit $?' - $opt_dry_run || if test -n "$outputname"; then - ${RM}r "$tmpdir" - fi - ;; - esac - done - - for file in $staticlibs; do - func_basename "$file" - name=$func_basename_result - - # Set up the ranlib parameters. - oldlib=$destdir/$name - func_to_tool_file "$oldlib" func_convert_file_msys_to_w32 - tool_oldlib=$func_to_tool_file_result - - func_show_eval "$install_prog \$file \$oldlib" 'exit $?' - - if test -n "$stripme" && test -n "$old_striplib"; then - func_show_eval "$old_striplib $tool_oldlib" 'exit $?' - fi - - # Do each command in the postinstall commands. - func_execute_cmds "$old_postinstall_cmds" 'exit $?' - done - - test -n "$future_libdirs" && \ - func_warning "remember to run '$progname --finish$future_libdirs'" - - if test -n "$current_libdirs"; then - # Maybe just do a dry run. - $opt_dry_run && current_libdirs=" -n$current_libdirs" - exec_cmd='$SHELL "$progpath" $preserve_args --finish$current_libdirs' - else - exit $EXIT_SUCCESS - fi -} - -test install = "$opt_mode" && func_mode_install ${1+"$@"} - - -# func_generate_dlsyms outputname originator pic_p -# Extract symbols from dlprefiles and create ${outputname}S.o with -# a dlpreopen symbol table. -func_generate_dlsyms () -{ - $debug_cmd - - my_outputname=$1 - my_originator=$2 - my_pic_p=${3-false} - my_prefix=`$ECHO "$my_originator" | $SED 's%[^a-zA-Z0-9]%_%g'` - my_dlsyms= - - if test -n "$dlfiles$dlprefiles" || test no != "$dlself"; then - if test -n "$NM" && test -n "$global_symbol_pipe"; then - my_dlsyms=${my_outputname}S.c - else - func_error "not configured to extract global symbols from dlpreopened files" - fi - fi - - if test -n "$my_dlsyms"; then - case $my_dlsyms in - "") ;; - *.c) - # Discover the nlist of each of the dlfiles. - nlist=$output_objdir/$my_outputname.nm - - func_show_eval "$RM $nlist ${nlist}S ${nlist}T" - - # Parse the name list into a source file. - func_verbose "creating $output_objdir/$my_dlsyms" - - $opt_dry_run || $ECHO > "$output_objdir/$my_dlsyms" "\ -/* $my_dlsyms - symbol resolution table for '$my_outputname' dlsym emulation. */ -/* Generated by $PROGRAM (GNU $PACKAGE) $VERSION */ - -#ifdef __cplusplus -extern \"C\" { -#endif - -#if defined __GNUC__ && (((__GNUC__ == 4) && (__GNUC_MINOR__ >= 4)) || (__GNUC__ > 4)) -#pragma GCC diagnostic ignored \"-Wstrict-prototypes\" -#endif - -/* Keep this code in sync between libtool.m4, ltmain, lt_system.h, and tests. */ -#if defined _WIN32 || defined __CYGWIN__ || defined _WIN32_WCE -/* DATA imports from DLLs on WIN32 can't be const, because runtime - relocations are performed -- see ld's documentation on pseudo-relocs. */ -# define LT_DLSYM_CONST -#elif defined __osf__ -/* This system does not cope well with relocations in const data. */ -# define LT_DLSYM_CONST -#else -# define LT_DLSYM_CONST const -#endif - -#define STREQ(s1, s2) (strcmp ((s1), (s2)) == 0) - -/* External symbol declarations for the compiler. */\ -" - - if test yes = "$dlself"; then - func_verbose "generating symbol list for '$output'" - - $opt_dry_run || echo ': @PROGRAM@ ' > "$nlist" - - # Add our own program objects to the symbol list. - progfiles=`$ECHO "$objs$old_deplibs" | $SP2NL | $SED "$lo2o" | $NL2SP` - for progfile in $progfiles; do - func_to_tool_file "$progfile" func_convert_file_msys_to_w32 - func_verbose "extracting global C symbols from '$func_to_tool_file_result'" - $opt_dry_run || eval "$NM $func_to_tool_file_result | $global_symbol_pipe >> '$nlist'" - done - - if test -n "$exclude_expsyms"; then - $opt_dry_run || { - eval '$EGREP -v " ($exclude_expsyms)$" "$nlist" > "$nlist"T' - eval '$MV "$nlist"T "$nlist"' - } - fi - - if test -n "$export_symbols_regex"; then - $opt_dry_run || { - eval '$EGREP -e "$export_symbols_regex" "$nlist" > "$nlist"T' - eval '$MV "$nlist"T "$nlist"' - } - fi - - # Prepare the list of exported symbols - if test -z "$export_symbols"; then - export_symbols=$output_objdir/$outputname.exp - $opt_dry_run || { - $RM $export_symbols - eval "$SED -n -e '/^: @PROGRAM@ $/d' -e 's/^.* \(.*\)$/\1/p' "'< "$nlist" > "$export_symbols"' - case $host in - *cygwin* | *mingw* | *cegcc* ) - eval "echo EXPORTS "'> "$output_objdir/$outputname.def"' - eval 'cat "$export_symbols" >> "$output_objdir/$outputname.def"' - ;; - esac - } - else - $opt_dry_run || { - eval "$SED -e 's/\([].[*^$]\)/\\\\\1/g' -e 's/^/ /' -e 's/$/$/'"' < "$export_symbols" > "$output_objdir/$outputname.exp"' - eval '$GREP -f "$output_objdir/$outputname.exp" < "$nlist" > "$nlist"T' - eval '$MV "$nlist"T "$nlist"' - case $host in - *cygwin* | *mingw* | *cegcc* ) - eval "echo EXPORTS "'> "$output_objdir/$outputname.def"' - eval 'cat "$nlist" >> "$output_objdir/$outputname.def"' - ;; - esac - } - fi - fi - - for dlprefile in $dlprefiles; do - func_verbose "extracting global C symbols from '$dlprefile'" - func_basename "$dlprefile" - name=$func_basename_result - case $host in - *cygwin* | *mingw* | *cegcc* ) - # if an import library, we need to obtain dlname - if func_win32_import_lib_p "$dlprefile"; then - func_tr_sh "$dlprefile" - eval "curr_lafile=\$libfile_$func_tr_sh_result" - dlprefile_dlbasename= - if test -n "$curr_lafile" && func_lalib_p "$curr_lafile"; then - # Use subshell, to avoid clobbering current variable values - dlprefile_dlname=`source "$curr_lafile" && echo "$dlname"` - if test -n "$dlprefile_dlname"; then - func_basename "$dlprefile_dlname" - dlprefile_dlbasename=$func_basename_result - else - # no lafile. user explicitly requested -dlpreopen . - $sharedlib_from_linklib_cmd "$dlprefile" - dlprefile_dlbasename=$sharedlib_from_linklib_result - fi - fi - $opt_dry_run || { - if test -n "$dlprefile_dlbasename"; then - eval '$ECHO ": $dlprefile_dlbasename" >> "$nlist"' - else - func_warning "Could not compute DLL name from $name" - eval '$ECHO ": $name " >> "$nlist"' - fi - func_to_tool_file "$dlprefile" func_convert_file_msys_to_w32 - eval "$NM \"$func_to_tool_file_result\" 2>/dev/null | $global_symbol_pipe | - $SED -e '/I __imp/d' -e 's/I __nm_/D /;s/_nm__//' >> '$nlist'" - } - else # not an import lib - $opt_dry_run || { - eval '$ECHO ": $name " >> "$nlist"' - func_to_tool_file "$dlprefile" func_convert_file_msys_to_w32 - eval "$NM \"$func_to_tool_file_result\" 2>/dev/null | $global_symbol_pipe >> '$nlist'" - } - fi - ;; - *) - $opt_dry_run || { - eval '$ECHO ": $name " >> "$nlist"' - func_to_tool_file "$dlprefile" func_convert_file_msys_to_w32 - eval "$NM \"$func_to_tool_file_result\" 2>/dev/null | $global_symbol_pipe >> '$nlist'" - } - ;; - esac - done - - $opt_dry_run || { - # Make sure we have at least an empty file. - test -f "$nlist" || : > "$nlist" - - if test -n "$exclude_expsyms"; then - $EGREP -v " ($exclude_expsyms)$" "$nlist" > "$nlist"T - $MV "$nlist"T "$nlist" - fi - - # Try sorting and uniquifying the output. - if $GREP -v "^: " < "$nlist" | - if sort -k 3 /dev/null 2>&1; then - sort -k 3 - else - sort +2 - fi | - uniq > "$nlist"S; then - : - else - $GREP -v "^: " < "$nlist" > "$nlist"S - fi - - if test -f "$nlist"S; then - eval "$global_symbol_to_cdecl"' < "$nlist"S >> "$output_objdir/$my_dlsyms"' - else - echo '/* NONE */' >> "$output_objdir/$my_dlsyms" - fi - - func_show_eval '$RM "${nlist}I"' - if test -n "$global_symbol_to_import"; then - eval "$global_symbol_to_import"' < "$nlist"S > "$nlist"I' - fi - - echo >> "$output_objdir/$my_dlsyms" "\ - -/* The mapping between symbol names and symbols. */ -typedef struct { - const char *name; - void *address; -} lt_dlsymlist; -extern LT_DLSYM_CONST lt_dlsymlist -lt_${my_prefix}_LTX_preloaded_symbols[];\ -" - - if test -s "$nlist"I; then - echo >> "$output_objdir/$my_dlsyms" "\ -static void lt_syminit(void) -{ - LT_DLSYM_CONST lt_dlsymlist *symbol = lt_${my_prefix}_LTX_preloaded_symbols; - for (; symbol->name; ++symbol) - {" - $SED 's/.*/ if (STREQ (symbol->name, \"&\")) symbol->address = (void *) \&&;/' < "$nlist"I >> "$output_objdir/$my_dlsyms" - echo >> "$output_objdir/$my_dlsyms" "\ - } -}" - fi - echo >> "$output_objdir/$my_dlsyms" "\ -LT_DLSYM_CONST lt_dlsymlist -lt_${my_prefix}_LTX_preloaded_symbols[] = -{ {\"$my_originator\", (void *) 0}," - - if test -s "$nlist"I; then - echo >> "$output_objdir/$my_dlsyms" "\ - {\"@INIT@\", (void *) <_syminit}," - fi - - case $need_lib_prefix in - no) - eval "$global_symbol_to_c_name_address" < "$nlist" >> "$output_objdir/$my_dlsyms" - ;; - *) - eval "$global_symbol_to_c_name_address_lib_prefix" < "$nlist" >> "$output_objdir/$my_dlsyms" - ;; - esac - echo >> "$output_objdir/$my_dlsyms" "\ - {0, (void *) 0} -}; - -/* This works around a problem in FreeBSD linker */ -#ifdef FREEBSD_WORKAROUND -static const void *lt_preloaded_setup() { - return lt_${my_prefix}_LTX_preloaded_symbols; -} -#endif - -#ifdef __cplusplus -} -#endif\ -" - } # !$opt_dry_run - - pic_flag_for_symtable= - case "$compile_command " in - *" -static "*) ;; - *) - case $host in - # compiling the symbol table file with pic_flag works around - # a FreeBSD bug that causes programs to crash when -lm is - # linked before any other PIC object. But we must not use - # pic_flag when linking with -static. The problem exists in - # FreeBSD 2.2.6 and is fixed in FreeBSD 3.1. - *-*-freebsd2.*|*-*-freebsd3.0*|*-*-freebsdelf3.0*) - pic_flag_for_symtable=" $pic_flag -DFREEBSD_WORKAROUND" ;; - *-*-hpux*) - pic_flag_for_symtable=" $pic_flag" ;; - *) - $my_pic_p && pic_flag_for_symtable=" $pic_flag" - ;; - esac - ;; - esac - symtab_cflags= - for arg in $LTCFLAGS; do - case $arg in - -pie | -fpie | -fPIE) ;; - *) func_append symtab_cflags " $arg" ;; - esac - done - - # Now compile the dynamic symbol file. - func_show_eval '(cd $output_objdir && $LTCC$symtab_cflags -c$no_builtin_flag$pic_flag_for_symtable "$my_dlsyms")' 'exit $?' - - # Clean up the generated files. - func_show_eval '$RM "$output_objdir/$my_dlsyms" "$nlist" "${nlist}S" "${nlist}T" "${nlist}I"' - - # Transform the symbol file into the correct name. - symfileobj=$output_objdir/${my_outputname}S.$objext - case $host in - *cygwin* | *mingw* | *cegcc* ) - if test -f "$output_objdir/$my_outputname.def"; then - compile_command=`$ECHO "$compile_command" | $SED "s%@SYMFILE@%$output_objdir/$my_outputname.def $symfileobj%"` - finalize_command=`$ECHO "$finalize_command" | $SED "s%@SYMFILE@%$output_objdir/$my_outputname.def $symfileobj%"` - else - compile_command=`$ECHO "$compile_command" | $SED "s%@SYMFILE@%$symfileobj%"` - finalize_command=`$ECHO "$finalize_command" | $SED "s%@SYMFILE@%$symfileobj%"` - fi - ;; - *) - compile_command=`$ECHO "$compile_command" | $SED "s%@SYMFILE@%$symfileobj%"` - finalize_command=`$ECHO "$finalize_command" | $SED "s%@SYMFILE@%$symfileobj%"` - ;; - esac - ;; - *) - func_fatal_error "unknown suffix for '$my_dlsyms'" - ;; - esac - else - # We keep going just in case the user didn't refer to - # lt_preloaded_symbols. The linker will fail if global_symbol_pipe - # really was required. - - # Nullify the symbol file. - compile_command=`$ECHO "$compile_command" | $SED "s% @SYMFILE@%%"` - finalize_command=`$ECHO "$finalize_command" | $SED "s% @SYMFILE@%%"` - fi -} - -# func_cygming_gnu_implib_p ARG -# This predicate returns with zero status (TRUE) if -# ARG is a GNU/binutils-style import library. Returns -# with nonzero status (FALSE) otherwise. -func_cygming_gnu_implib_p () -{ - $debug_cmd - - func_to_tool_file "$1" func_convert_file_msys_to_w32 - func_cygming_gnu_implib_tmp=`$NM "$func_to_tool_file_result" | eval "$global_symbol_pipe" | $EGREP ' (_head_[A-Za-z0-9_]+_[ad]l*|[A-Za-z0-9_]+_[ad]l*_iname)$'` - test -n "$func_cygming_gnu_implib_tmp" -} - -# func_cygming_ms_implib_p ARG -# This predicate returns with zero status (TRUE) if -# ARG is an MS-style import library. Returns -# with nonzero status (FALSE) otherwise. -func_cygming_ms_implib_p () -{ - $debug_cmd - - func_to_tool_file "$1" func_convert_file_msys_to_w32 - func_cygming_ms_implib_tmp=`$NM "$func_to_tool_file_result" | eval "$global_symbol_pipe" | $GREP '_NULL_IMPORT_DESCRIPTOR'` - test -n "$func_cygming_ms_implib_tmp" -} - -# func_win32_libid arg -# return the library type of file 'arg' -# -# Need a lot of goo to handle *both* DLLs and import libs -# Has to be a shell function in order to 'eat' the argument -# that is supplied when $file_magic_command is called. -# Despite the name, also deal with 64 bit binaries. -func_win32_libid () -{ - $debug_cmd - - win32_libid_type=unknown - win32_fileres=`file -L $1 2>/dev/null` - case $win32_fileres in - *ar\ archive\ import\ library*) # definitely import - win32_libid_type="x86 archive import" - ;; - *ar\ archive*) # could be an import, or static - # Keep the egrep pattern in sync with the one in _LT_CHECK_MAGIC_METHOD. - if eval $OBJDUMP -f $1 | $SED -e '10q' 2>/dev/null | - $EGREP 'file format (pei*-i386(.*architecture: i386)?|pe-arm-wince|pe-x86-64)' >/dev/null; then - case $nm_interface in - "MS dumpbin") - if func_cygming_ms_implib_p "$1" || - func_cygming_gnu_implib_p "$1" - then - win32_nmres=import - else - win32_nmres= - fi - ;; - *) - func_to_tool_file "$1" func_convert_file_msys_to_w32 - win32_nmres=`eval $NM -f posix -A \"$func_to_tool_file_result\" | - $SED -n -e ' - 1,100{ - / I /{ - s|.*|import| - p - q - } - }'` - ;; - esac - case $win32_nmres in - import*) win32_libid_type="x86 archive import";; - *) win32_libid_type="x86 archive static";; - esac - fi - ;; - *DLL*) - win32_libid_type="x86 DLL" - ;; - *executable*) # but shell scripts are "executable" too... - case $win32_fileres in - *MS\ Windows\ PE\ Intel*) - win32_libid_type="x86 DLL" - ;; - esac - ;; - esac - $ECHO "$win32_libid_type" -} - -# func_cygming_dll_for_implib ARG -# -# Platform-specific function to extract the -# name of the DLL associated with the specified -# import library ARG. -# Invoked by eval'ing the libtool variable -# $sharedlib_from_linklib_cmd -# Result is available in the variable -# $sharedlib_from_linklib_result -func_cygming_dll_for_implib () -{ - $debug_cmd - - sharedlib_from_linklib_result=`$DLLTOOL --identify-strict --identify "$1"` -} - -# func_cygming_dll_for_implib_fallback_core SECTION_NAME LIBNAMEs -# -# The is the core of a fallback implementation of a -# platform-specific function to extract the name of the -# DLL associated with the specified import library LIBNAME. -# -# SECTION_NAME is either .idata$6 or .idata$7, depending -# on the platform and compiler that created the implib. -# -# Echos the name of the DLL associated with the -# specified import library. -func_cygming_dll_for_implib_fallback_core () -{ - $debug_cmd - - match_literal=`$ECHO "$1" | $SED "$sed_make_literal_regex"` - $OBJDUMP -s --section "$1" "$2" 2>/dev/null | - $SED '/^Contents of section '"$match_literal"':/{ - # Place marker at beginning of archive member dllname section - s/.*/====MARK====/ - p - d - } - # These lines can sometimes be longer than 43 characters, but - # are always uninteresting - /:[ ]*file format pe[i]\{,1\}-/d - /^In archive [^:]*:/d - # Ensure marker is printed - /^====MARK====/p - # Remove all lines with less than 43 characters - /^.\{43\}/!d - # From remaining lines, remove first 43 characters - s/^.\{43\}//' | - $SED -n ' - # Join marker and all lines until next marker into a single line - /^====MARK====/ b para - H - $ b para - b - :para - x - s/\n//g - # Remove the marker - s/^====MARK====// - # Remove trailing dots and whitespace - s/[\. \t]*$// - # Print - /./p' | - # we now have a list, one entry per line, of the stringified - # contents of the appropriate section of all members of the - # archive that possess that section. Heuristic: eliminate - # all those that have a first or second character that is - # a '.' (that is, objdump's representation of an unprintable - # character.) This should work for all archives with less than - # 0x302f exports -- but will fail for DLLs whose name actually - # begins with a literal '.' or a single character followed by - # a '.'. - # - # Of those that remain, print the first one. - $SED -e '/^\./d;/^.\./d;q' -} - -# func_cygming_dll_for_implib_fallback ARG -# Platform-specific function to extract the -# name of the DLL associated with the specified -# import library ARG. -# -# This fallback implementation is for use when $DLLTOOL -# does not support the --identify-strict option. -# Invoked by eval'ing the libtool variable -# $sharedlib_from_linklib_cmd -# Result is available in the variable -# $sharedlib_from_linklib_result -func_cygming_dll_for_implib_fallback () -{ - $debug_cmd - - if func_cygming_gnu_implib_p "$1"; then - # binutils import library - sharedlib_from_linklib_result=`func_cygming_dll_for_implib_fallback_core '.idata$7' "$1"` - elif func_cygming_ms_implib_p "$1"; then - # ms-generated import library - sharedlib_from_linklib_result=`func_cygming_dll_for_implib_fallback_core '.idata$6' "$1"` - else - # unknown - sharedlib_from_linklib_result= - fi -} - - -# func_extract_an_archive dir oldlib -func_extract_an_archive () -{ - $debug_cmd - - f_ex_an_ar_dir=$1; shift - f_ex_an_ar_oldlib=$1 - if test yes = "$lock_old_archive_extraction"; then - lockfile=$f_ex_an_ar_oldlib.lock - until $opt_dry_run || ln "$progpath" "$lockfile" 2>/dev/null; do - func_echo "Waiting for $lockfile to be removed" - sleep 2 - done - fi - func_show_eval "(cd \$f_ex_an_ar_dir && $AR x \"\$f_ex_an_ar_oldlib\")" \ - 'stat=$?; rm -f "$lockfile"; exit $stat' - if test yes = "$lock_old_archive_extraction"; then - $opt_dry_run || rm -f "$lockfile" - fi - if ($AR t "$f_ex_an_ar_oldlib" | sort | sort -uc >/dev/null 2>&1); then - : - else - func_fatal_error "object name conflicts in archive: $f_ex_an_ar_dir/$f_ex_an_ar_oldlib" - fi -} - - -# func_extract_archives gentop oldlib ... -func_extract_archives () -{ - $debug_cmd - - my_gentop=$1; shift - my_oldlibs=${1+"$@"} - my_oldobjs= - my_xlib= - my_xabs= - my_xdir= - - for my_xlib in $my_oldlibs; do - # Extract the objects. - case $my_xlib in - [\\/]* | [A-Za-z]:[\\/]*) my_xabs=$my_xlib ;; - *) my_xabs=`pwd`"/$my_xlib" ;; - esac - func_basename "$my_xlib" - my_xlib=$func_basename_result - my_xlib_u=$my_xlib - while :; do - case " $extracted_archives " in - *" $my_xlib_u "*) - func_arith $extracted_serial + 1 - extracted_serial=$func_arith_result - my_xlib_u=lt$extracted_serial-$my_xlib ;; - *) break ;; - esac - done - extracted_archives="$extracted_archives $my_xlib_u" - my_xdir=$my_gentop/$my_xlib_u - - func_mkdir_p "$my_xdir" - - case $host in - *-darwin*) - func_verbose "Extracting $my_xabs" - # Do not bother doing anything if just a dry run - $opt_dry_run || { - darwin_orig_dir=`pwd` - cd $my_xdir || exit $? - darwin_archive=$my_xabs - darwin_curdir=`pwd` - func_basename "$darwin_archive" - darwin_base_archive=$func_basename_result - darwin_arches=`$LIPO -info "$darwin_archive" 2>/dev/null | $GREP Architectures 2>/dev/null || true` - if test -n "$darwin_arches"; then - darwin_arches=`$ECHO "$darwin_arches" | $SED -e 's/.*are://'` - darwin_arch= - func_verbose "$darwin_base_archive has multiple architectures $darwin_arches" - for darwin_arch in $darwin_arches; do - func_mkdir_p "unfat-$$/$darwin_base_archive-$darwin_arch" - $LIPO -thin $darwin_arch -output "unfat-$$/$darwin_base_archive-$darwin_arch/$darwin_base_archive" "$darwin_archive" - cd "unfat-$$/$darwin_base_archive-$darwin_arch" - func_extract_an_archive "`pwd`" "$darwin_base_archive" - cd "$darwin_curdir" - $RM "unfat-$$/$darwin_base_archive-$darwin_arch/$darwin_base_archive" - done # $darwin_arches - ## Okay now we've a bunch of thin objects, gotta fatten them up :) - darwin_filelist=`find unfat-$$ -type f -name \*.o -print -o -name \*.lo -print | $SED -e "$sed_basename" | sort -u` - darwin_file= - darwin_files= - for darwin_file in $darwin_filelist; do - darwin_files=`find unfat-$$ -name $darwin_file -print | sort | $NL2SP` - $LIPO -create -output "$darwin_file" $darwin_files - done # $darwin_filelist - $RM -rf unfat-$$ - cd "$darwin_orig_dir" - else - cd $darwin_orig_dir - func_extract_an_archive "$my_xdir" "$my_xabs" - fi # $darwin_arches - } # !$opt_dry_run - ;; - *) - func_extract_an_archive "$my_xdir" "$my_xabs" - ;; - esac - my_oldobjs="$my_oldobjs "`find $my_xdir -name \*.$objext -print -o -name \*.lo -print | sort | $NL2SP` - done - - func_extract_archives_result=$my_oldobjs -} - - -# func_emit_wrapper [arg=no] -# -# Emit a libtool wrapper script on stdout. -# Don't directly open a file because we may want to -# incorporate the script contents within a cygwin/mingw -# wrapper executable. Must ONLY be called from within -# func_mode_link because it depends on a number of variables -# set therein. -# -# ARG is the value that the WRAPPER_SCRIPT_BELONGS_IN_OBJDIR -# variable will take. If 'yes', then the emitted script -# will assume that the directory where it is stored is -# the $objdir directory. This is a cygwin/mingw-specific -# behavior. -func_emit_wrapper () -{ - func_emit_wrapper_arg1=${1-no} - - $ECHO "\ -#! $SHELL - -# $output - temporary wrapper script for $objdir/$outputname -# Generated by $PROGRAM (GNU $PACKAGE) $VERSION -# -# The $output program cannot be directly executed until all the libtool -# libraries that it depends on are installed. -# -# This wrapper script should never be moved out of the build directory. -# If it is, it will not operate correctly. - -# Sed substitution that helps us do robust quoting. It backslashifies -# metacharacters that are still active within double-quoted strings. -sed_quote_subst='$sed_quote_subst' - -# Be Bourne compatible -if test -n \"\${ZSH_VERSION+set}\" && (emulate sh) >/dev/null 2>&1; then - emulate sh - NULLCMD=: - # Zsh 3.x and 4.x performs word splitting on \${1+\"\$@\"}, which - # is contrary to our usage. Disable this feature. - alias -g '\${1+\"\$@\"}'='\"\$@\"' - setopt NO_GLOB_SUBST -else - case \`(set -o) 2>/dev/null\` in *posix*) set -o posix;; esac -fi -BIN_SH=xpg4; export BIN_SH # for Tru64 -DUALCASE=1; export DUALCASE # for MKS sh - -# The HP-UX ksh and POSIX shell print the target directory to stdout -# if CDPATH is set. -(unset CDPATH) >/dev/null 2>&1 && unset CDPATH - -relink_command=\"$relink_command\" - -# This environment variable determines our operation mode. -if test \"\$libtool_install_magic\" = \"$magic\"; then - # install mode needs the following variables: - generated_by_libtool_version='$macro_version' - notinst_deplibs='$notinst_deplibs' -else - # When we are sourced in execute mode, \$file and \$ECHO are already set. - if test \"\$libtool_execute_magic\" != \"$magic\"; then - file=\"\$0\"" - - qECHO=`$ECHO "$ECHO" | $SED "$sed_quote_subst"` - $ECHO "\ - -# A function that is used when there is no print builtin or printf. -func_fallback_echo () -{ - eval 'cat <<_LTECHO_EOF -\$1 -_LTECHO_EOF' -} - ECHO=\"$qECHO\" - fi - -# Very basic option parsing. These options are (a) specific to -# the libtool wrapper, (b) are identical between the wrapper -# /script/ and the wrapper /executable/ that is used only on -# windows platforms, and (c) all begin with the string "--lt-" -# (application programs are unlikely to have options that match -# this pattern). -# -# There are only two supported options: --lt-debug and -# --lt-dump-script. There is, deliberately, no --lt-help. -# -# The first argument to this parsing function should be the -# script's $0 value, followed by "$@". -lt_option_debug= -func_parse_lt_options () -{ - lt_script_arg0=\$0 - shift - for lt_opt - do - case \"\$lt_opt\" in - --lt-debug) lt_option_debug=1 ;; - --lt-dump-script) - lt_dump_D=\`\$ECHO \"X\$lt_script_arg0\" | $SED -e 's/^X//' -e 's%/[^/]*$%%'\` - test \"X\$lt_dump_D\" = \"X\$lt_script_arg0\" && lt_dump_D=. - lt_dump_F=\`\$ECHO \"X\$lt_script_arg0\" | $SED -e 's/^X//' -e 's%^.*/%%'\` - cat \"\$lt_dump_D/\$lt_dump_F\" - exit 0 - ;; - --lt-*) - \$ECHO \"Unrecognized --lt- option: '\$lt_opt'\" 1>&2 - exit 1 - ;; - esac - done - - # Print the debug banner immediately: - if test -n \"\$lt_option_debug\"; then - echo \"$outputname:$output:\$LINENO: libtool wrapper (GNU $PACKAGE) $VERSION\" 1>&2 - fi -} - -# Used when --lt-debug. Prints its arguments to stdout -# (redirection is the responsibility of the caller) -func_lt_dump_args () -{ - lt_dump_args_N=1; - for lt_arg - do - \$ECHO \"$outputname:$output:\$LINENO: newargv[\$lt_dump_args_N]: \$lt_arg\" - lt_dump_args_N=\`expr \$lt_dump_args_N + 1\` - done -} - -# Core function for launching the target application -func_exec_program_core () -{ -" - case $host in - # Backslashes separate directories on plain windows - *-*-mingw | *-*-os2* | *-cegcc*) - $ECHO "\ - if test -n \"\$lt_option_debug\"; then - \$ECHO \"$outputname:$output:\$LINENO: newargv[0]: \$progdir\\\\\$program\" 1>&2 - func_lt_dump_args \${1+\"\$@\"} 1>&2 - fi - exec \"\$progdir\\\\\$program\" \${1+\"\$@\"} -" - ;; - - *) - $ECHO "\ - if test -n \"\$lt_option_debug\"; then - \$ECHO \"$outputname:$output:\$LINENO: newargv[0]: \$progdir/\$program\" 1>&2 - func_lt_dump_args \${1+\"\$@\"} 1>&2 - fi - exec \"\$progdir/\$program\" \${1+\"\$@\"} -" - ;; - esac - $ECHO "\ - \$ECHO \"\$0: cannot exec \$program \$*\" 1>&2 - exit 1 -} - -# A function to encapsulate launching the target application -# Strips options in the --lt-* namespace from \$@ and -# launches target application with the remaining arguments. -func_exec_program () -{ - case \" \$* \" in - *\\ --lt-*) - for lt_wr_arg - do - case \$lt_wr_arg in - --lt-*) ;; - *) set x \"\$@\" \"\$lt_wr_arg\"; shift;; - esac - shift - done ;; - esac - func_exec_program_core \${1+\"\$@\"} -} - - # Parse options - func_parse_lt_options \"\$0\" \${1+\"\$@\"} - - # Find the directory that this script lives in. - thisdir=\`\$ECHO \"\$file\" | $SED 's%/[^/]*$%%'\` - test \"x\$thisdir\" = \"x\$file\" && thisdir=. - - # Follow symbolic links until we get to the real thisdir. - file=\`ls -ld \"\$file\" | $SED -n 's/.*-> //p'\` - while test -n \"\$file\"; do - destdir=\`\$ECHO \"\$file\" | $SED 's%/[^/]*\$%%'\` - - # If there was a directory component, then change thisdir. - if test \"x\$destdir\" != \"x\$file\"; then - case \"\$destdir\" in - [\\\\/]* | [A-Za-z]:[\\\\/]*) thisdir=\"\$destdir\" ;; - *) thisdir=\"\$thisdir/\$destdir\" ;; - esac - fi - - file=\`\$ECHO \"\$file\" | $SED 's%^.*/%%'\` - file=\`ls -ld \"\$thisdir/\$file\" | $SED -n 's/.*-> //p'\` - done - - # Usually 'no', except on cygwin/mingw when embedded into - # the cwrapper. - WRAPPER_SCRIPT_BELONGS_IN_OBJDIR=$func_emit_wrapper_arg1 - if test \"\$WRAPPER_SCRIPT_BELONGS_IN_OBJDIR\" = \"yes\"; then - # special case for '.' - if test \"\$thisdir\" = \".\"; then - thisdir=\`pwd\` - fi - # remove .libs from thisdir - case \"\$thisdir\" in - *[\\\\/]$objdir ) thisdir=\`\$ECHO \"\$thisdir\" | $SED 's%[\\\\/][^\\\\/]*$%%'\` ;; - $objdir ) thisdir=. ;; - esac - fi - - # Try to get the absolute directory name. - absdir=\`cd \"\$thisdir\" && pwd\` - test -n \"\$absdir\" && thisdir=\"\$absdir\" -" - - if test yes = "$fast_install"; then - $ECHO "\ - program=lt-'$outputname'$exeext - progdir=\"\$thisdir/$objdir\" - - if test ! -f \"\$progdir/\$program\" || - { file=\`ls -1dt \"\$progdir/\$program\" \"\$progdir/../\$program\" 2>/dev/null | $SED 1q\`; \\ - test \"X\$file\" != \"X\$progdir/\$program\"; }; then - - file=\"\$\$-\$program\" - - if test ! -d \"\$progdir\"; then - $MKDIR \"\$progdir\" - else - $RM \"\$progdir/\$file\" - fi" - - $ECHO "\ - - # relink executable if necessary - if test -n \"\$relink_command\"; then - if relink_command_output=\`eval \$relink_command 2>&1\`; then : - else - \$ECHO \"\$relink_command_output\" >&2 - $RM \"\$progdir/\$file\" - exit 1 - fi - fi - - $MV \"\$progdir/\$file\" \"\$progdir/\$program\" 2>/dev/null || - { $RM \"\$progdir/\$program\"; - $MV \"\$progdir/\$file\" \"\$progdir/\$program\"; } - $RM \"\$progdir/\$file\" - fi" - else - $ECHO "\ - program='$outputname' - progdir=\"\$thisdir/$objdir\" -" - fi - - $ECHO "\ - - if test -f \"\$progdir/\$program\"; then" - - # fixup the dll searchpath if we need to. - # - # Fix the DLL searchpath if we need to. Do this before prepending - # to shlibpath, because on Windows, both are PATH and uninstalled - # libraries must come first. - if test -n "$dllsearchpath"; then - $ECHO "\ - # Add the dll search path components to the executable PATH - PATH=$dllsearchpath:\$PATH -" - fi - - # Export our shlibpath_var if we have one. - if test yes = "$shlibpath_overrides_runpath" && test -n "$shlibpath_var" && test -n "$temp_rpath"; then - $ECHO "\ - # Add our own library path to $shlibpath_var - $shlibpath_var=\"$temp_rpath\$$shlibpath_var\" - - # Some systems cannot cope with colon-terminated $shlibpath_var - # The second colon is a workaround for a bug in BeOS R4 sed - $shlibpath_var=\`\$ECHO \"\$$shlibpath_var\" | $SED 's/::*\$//'\` - - export $shlibpath_var -" - fi - - $ECHO "\ - if test \"\$libtool_execute_magic\" != \"$magic\"; then - # Run the actual program with our arguments. - func_exec_program \${1+\"\$@\"} - fi - else - # The program doesn't exist. - \$ECHO \"\$0: error: '\$progdir/\$program' does not exist\" 1>&2 - \$ECHO \"This script is just a wrapper for \$program.\" 1>&2 - \$ECHO \"See the $PACKAGE documentation for more information.\" 1>&2 - exit 1 - fi -fi\ -" -} - - -# func_emit_cwrapperexe_src -# emit the source code for a wrapper executable on stdout -# Must ONLY be called from within func_mode_link because -# it depends on a number of variable set therein. -func_emit_cwrapperexe_src () -{ - cat < -#include -#if defined (_WIN32) && !defined (__GNUC__) -# include -# include -# include -#else -# include -# include -# ifdef __CYGWIN__ -# include -# endif -#endif -#include -#include -#include -#include -#include -#include -#include -#include - -#define STREQ(s1, s2) (strcmp ((s1), (s2)) == 0) - -/* declarations of non-ANSI functions */ -#if defined __MINGW32__ -# ifdef __STRICT_ANSI__ -int _putenv (const char *); -# endif -#elif defined __CYGWIN__ -# ifdef __STRICT_ANSI__ -char *realpath (const char *, char *); -int putenv (char *); -int setenv (const char *, const char *, int); -# endif -/* #elif defined other_platform || defined ... */ -#endif - -/* portability defines, excluding path handling macros */ -#if defined _MSC_VER -# define setmode _setmode -# define stat _stat -# define chmod _chmod -# define getcwd _getcwd -# define putenv _putenv -# define S_IXUSR _S_IEXEC -#elif defined __MINGW32__ -# define setmode _setmode -# define stat _stat -# define chmod _chmod -# define getcwd _getcwd -# define putenv _putenv -#elif defined __CYGWIN__ -# define HAVE_SETENV -# define FOPEN_WB "wb" -/* #elif defined other platforms ... */ -#endif - -#if defined PATH_MAX -# define LT_PATHMAX PATH_MAX -#elif defined MAXPATHLEN -# define LT_PATHMAX MAXPATHLEN -#else -# define LT_PATHMAX 1024 -#endif - -#ifndef S_IXOTH -# define S_IXOTH 0 -#endif -#ifndef S_IXGRP -# define S_IXGRP 0 -#endif - -/* path handling portability macros */ -#ifndef DIR_SEPARATOR -# define DIR_SEPARATOR '/' -# define PATH_SEPARATOR ':' -#endif - -#if defined _WIN32 || defined __MSDOS__ || defined __DJGPP__ || \ - defined __OS2__ -# define HAVE_DOS_BASED_FILE_SYSTEM -# define FOPEN_WB "wb" -# ifndef DIR_SEPARATOR_2 -# define DIR_SEPARATOR_2 '\\' -# endif -# ifndef PATH_SEPARATOR_2 -# define PATH_SEPARATOR_2 ';' -# endif -#endif - -#ifndef DIR_SEPARATOR_2 -# define IS_DIR_SEPARATOR(ch) ((ch) == DIR_SEPARATOR) -#else /* DIR_SEPARATOR_2 */ -# define IS_DIR_SEPARATOR(ch) \ - (((ch) == DIR_SEPARATOR) || ((ch) == DIR_SEPARATOR_2)) -#endif /* DIR_SEPARATOR_2 */ - -#ifndef PATH_SEPARATOR_2 -# define IS_PATH_SEPARATOR(ch) ((ch) == PATH_SEPARATOR) -#else /* PATH_SEPARATOR_2 */ -# define IS_PATH_SEPARATOR(ch) ((ch) == PATH_SEPARATOR_2) -#endif /* PATH_SEPARATOR_2 */ - -#ifndef FOPEN_WB -# define FOPEN_WB "w" -#endif -#ifndef _O_BINARY -# define _O_BINARY 0 -#endif - -#define XMALLOC(type, num) ((type *) xmalloc ((num) * sizeof(type))) -#define XFREE(stale) do { \ - if (stale) { free (stale); stale = 0; } \ -} while (0) - -#if defined LT_DEBUGWRAPPER -static int lt_debug = 1; -#else -static int lt_debug = 0; -#endif - -const char *program_name = "libtool-wrapper"; /* in case xstrdup fails */ - -void *xmalloc (size_t num); -char *xstrdup (const char *string); -const char *base_name (const char *name); -char *find_executable (const char *wrapper); -char *chase_symlinks (const char *pathspec); -int make_executable (const char *path); -int check_executable (const char *path); -char *strendzap (char *str, const char *pat); -void lt_debugprintf (const char *file, int line, const char *fmt, ...); -void lt_fatal (const char *file, int line, const char *message, ...); -static const char *nonnull (const char *s); -static const char *nonempty (const char *s); -void lt_setenv (const char *name, const char *value); -char *lt_extend_str (const char *orig_value, const char *add, int to_end); -void lt_update_exe_path (const char *name, const char *value); -void lt_update_lib_path (const char *name, const char *value); -char **prepare_spawn (char **argv); -void lt_dump_script (FILE *f); -EOF - - cat <= 0) - && (st.st_mode & (S_IXUSR | S_IXGRP | S_IXOTH))) - return 1; - else - return 0; -} - -int -make_executable (const char *path) -{ - int rval = 0; - struct stat st; - - lt_debugprintf (__FILE__, __LINE__, "(make_executable): %s\n", - nonempty (path)); - if ((!path) || (!*path)) - return 0; - - if (stat (path, &st) >= 0) - { - rval = chmod (path, st.st_mode | S_IXOTH | S_IXGRP | S_IXUSR); - } - return rval; -} - -/* Searches for the full path of the wrapper. Returns - newly allocated full path name if found, NULL otherwise - Does not chase symlinks, even on platforms that support them. -*/ -char * -find_executable (const char *wrapper) -{ - int has_slash = 0; - const char *p; - const char *p_next; - /* static buffer for getcwd */ - char tmp[LT_PATHMAX + 1]; - size_t tmp_len; - char *concat_name; - - lt_debugprintf (__FILE__, __LINE__, "(find_executable): %s\n", - nonempty (wrapper)); - - if ((wrapper == NULL) || (*wrapper == '\0')) - return NULL; - - /* Absolute path? */ -#if defined HAVE_DOS_BASED_FILE_SYSTEM - if (isalpha ((unsigned char) wrapper[0]) && wrapper[1] == ':') - { - concat_name = xstrdup (wrapper); - if (check_executable (concat_name)) - return concat_name; - XFREE (concat_name); - } - else - { -#endif - if (IS_DIR_SEPARATOR (wrapper[0])) - { - concat_name = xstrdup (wrapper); - if (check_executable (concat_name)) - return concat_name; - XFREE (concat_name); - } -#if defined HAVE_DOS_BASED_FILE_SYSTEM - } -#endif - - for (p = wrapper; *p; p++) - if (*p == '/') - { - has_slash = 1; - break; - } - if (!has_slash) - { - /* no slashes; search PATH */ - const char *path = getenv ("PATH"); - if (path != NULL) - { - for (p = path; *p; p = p_next) - { - const char *q; - size_t p_len; - for (q = p; *q; q++) - if (IS_PATH_SEPARATOR (*q)) - break; - p_len = (size_t) (q - p); - p_next = (*q == '\0' ? q : q + 1); - if (p_len == 0) - { - /* empty path: current directory */ - if (getcwd (tmp, LT_PATHMAX) == NULL) - lt_fatal (__FILE__, __LINE__, "getcwd failed: %s", - nonnull (strerror (errno))); - tmp_len = strlen (tmp); - concat_name = - XMALLOC (char, tmp_len + 1 + strlen (wrapper) + 1); - memcpy (concat_name, tmp, tmp_len); - concat_name[tmp_len] = '/'; - strcpy (concat_name + tmp_len + 1, wrapper); - } - else - { - concat_name = - XMALLOC (char, p_len + 1 + strlen (wrapper) + 1); - memcpy (concat_name, p, p_len); - concat_name[p_len] = '/'; - strcpy (concat_name + p_len + 1, wrapper); - } - if (check_executable (concat_name)) - return concat_name; - XFREE (concat_name); - } - } - /* not found in PATH; assume curdir */ - } - /* Relative path | not found in path: prepend cwd */ - if (getcwd (tmp, LT_PATHMAX) == NULL) - lt_fatal (__FILE__, __LINE__, "getcwd failed: %s", - nonnull (strerror (errno))); - tmp_len = strlen (tmp); - concat_name = XMALLOC (char, tmp_len + 1 + strlen (wrapper) + 1); - memcpy (concat_name, tmp, tmp_len); - concat_name[tmp_len] = '/'; - strcpy (concat_name + tmp_len + 1, wrapper); - - if (check_executable (concat_name)) - return concat_name; - XFREE (concat_name); - return NULL; -} - -char * -chase_symlinks (const char *pathspec) -{ -#ifndef S_ISLNK - return xstrdup (pathspec); -#else - char buf[LT_PATHMAX]; - struct stat s; - char *tmp_pathspec = xstrdup (pathspec); - char *p; - int has_symlinks = 0; - while (strlen (tmp_pathspec) && !has_symlinks) - { - lt_debugprintf (__FILE__, __LINE__, - "checking path component for symlinks: %s\n", - tmp_pathspec); - if (lstat (tmp_pathspec, &s) == 0) - { - if (S_ISLNK (s.st_mode) != 0) - { - has_symlinks = 1; - break; - } - - /* search backwards for last DIR_SEPARATOR */ - p = tmp_pathspec + strlen (tmp_pathspec) - 1; - while ((p > tmp_pathspec) && (!IS_DIR_SEPARATOR (*p))) - p--; - if ((p == tmp_pathspec) && (!IS_DIR_SEPARATOR (*p))) - { - /* no more DIR_SEPARATORS left */ - break; - } - *p = '\0'; - } - else - { - lt_fatal (__FILE__, __LINE__, - "error accessing file \"%s\": %s", - tmp_pathspec, nonnull (strerror (errno))); - } - } - XFREE (tmp_pathspec); - - if (!has_symlinks) - { - return xstrdup (pathspec); - } - - tmp_pathspec = realpath (pathspec, buf); - if (tmp_pathspec == 0) - { - lt_fatal (__FILE__, __LINE__, - "could not follow symlinks for %s", pathspec); - } - return xstrdup (tmp_pathspec); -#endif -} - -char * -strendzap (char *str, const char *pat) -{ - size_t len, patlen; - - assert (str != NULL); - assert (pat != NULL); - - len = strlen (str); - patlen = strlen (pat); - - if (patlen <= len) - { - str += len - patlen; - if (STREQ (str, pat)) - *str = '\0'; - } - return str; -} - -void -lt_debugprintf (const char *file, int line, const char *fmt, ...) -{ - va_list args; - if (lt_debug) - { - (void) fprintf (stderr, "%s:%s:%d: ", program_name, file, line); - va_start (args, fmt); - (void) vfprintf (stderr, fmt, args); - va_end (args); - } -} - -static void -lt_error_core (int exit_status, const char *file, - int line, const char *mode, - const char *message, va_list ap) -{ - fprintf (stderr, "%s:%s:%d: %s: ", program_name, file, line, mode); - vfprintf (stderr, message, ap); - fprintf (stderr, ".\n"); - - if (exit_status >= 0) - exit (exit_status); -} - -void -lt_fatal (const char *file, int line, const char *message, ...) -{ - va_list ap; - va_start (ap, message); - lt_error_core (EXIT_FAILURE, file, line, "FATAL", message, ap); - va_end (ap); -} - -static const char * -nonnull (const char *s) -{ - return s ? s : "(null)"; -} - -static const char * -nonempty (const char *s) -{ - return (s && !*s) ? "(empty)" : nonnull (s); -} - -void -lt_setenv (const char *name, const char *value) -{ - lt_debugprintf (__FILE__, __LINE__, - "(lt_setenv) setting '%s' to '%s'\n", - nonnull (name), nonnull (value)); - { -#ifdef HAVE_SETENV - /* always make a copy, for consistency with !HAVE_SETENV */ - char *str = xstrdup (value); - setenv (name, str, 1); -#else - size_t len = strlen (name) + 1 + strlen (value) + 1; - char *str = XMALLOC (char, len); - sprintf (str, "%s=%s", name, value); - if (putenv (str) != EXIT_SUCCESS) - { - XFREE (str); - } -#endif - } -} - -char * -lt_extend_str (const char *orig_value, const char *add, int to_end) -{ - char *new_value; - if (orig_value && *orig_value) - { - size_t orig_value_len = strlen (orig_value); - size_t add_len = strlen (add); - new_value = XMALLOC (char, add_len + orig_value_len + 1); - if (to_end) - { - strcpy (new_value, orig_value); - strcpy (new_value + orig_value_len, add); - } - else - { - strcpy (new_value, add); - strcpy (new_value + add_len, orig_value); - } - } - else - { - new_value = xstrdup (add); - } - return new_value; -} - -void -lt_update_exe_path (const char *name, const char *value) -{ - lt_debugprintf (__FILE__, __LINE__, - "(lt_update_exe_path) modifying '%s' by prepending '%s'\n", - nonnull (name), nonnull (value)); - - if (name && *name && value && *value) - { - char *new_value = lt_extend_str (getenv (name), value, 0); - /* some systems can't cope with a ':'-terminated path #' */ - size_t len = strlen (new_value); - while ((len > 0) && IS_PATH_SEPARATOR (new_value[len-1])) - { - new_value[--len] = '\0'; - } - lt_setenv (name, new_value); - XFREE (new_value); - } -} - -void -lt_update_lib_path (const char *name, const char *value) -{ - lt_debugprintf (__FILE__, __LINE__, - "(lt_update_lib_path) modifying '%s' by prepending '%s'\n", - nonnull (name), nonnull (value)); - - if (name && *name && value && *value) - { - char *new_value = lt_extend_str (getenv (name), value, 0); - lt_setenv (name, new_value); - XFREE (new_value); - } -} - -EOF - case $host_os in - mingw*) - cat <<"EOF" - -/* Prepares an argument vector before calling spawn(). - Note that spawn() does not by itself call the command interpreter - (getenv ("COMSPEC") != NULL ? getenv ("COMSPEC") : - ({ OSVERSIONINFO v; v.dwOSVersionInfoSize = sizeof(OSVERSIONINFO); - GetVersionEx(&v); - v.dwPlatformId == VER_PLATFORM_WIN32_NT; - }) ? "cmd.exe" : "command.com"). - Instead it simply concatenates the arguments, separated by ' ', and calls - CreateProcess(). We must quote the arguments since Win32 CreateProcess() - interprets characters like ' ', '\t', '\\', '"' (but not '<' and '>') in a - special way: - - Space and tab are interpreted as delimiters. They are not treated as - delimiters if they are surrounded by double quotes: "...". - - Unescaped double quotes are removed from the input. Their only effect is - that within double quotes, space and tab are treated like normal - characters. - - Backslashes not followed by double quotes are not special. - - But 2*n+1 backslashes followed by a double quote become - n backslashes followed by a double quote (n >= 0): - \" -> " - \\\" -> \" - \\\\\" -> \\" - */ -#define SHELL_SPECIAL_CHARS "\"\\ \001\002\003\004\005\006\007\010\011\012\013\014\015\016\017\020\021\022\023\024\025\026\027\030\031\032\033\034\035\036\037" -#define SHELL_SPACE_CHARS " \001\002\003\004\005\006\007\010\011\012\013\014\015\016\017\020\021\022\023\024\025\026\027\030\031\032\033\034\035\036\037" -char ** -prepare_spawn (char **argv) -{ - size_t argc; - char **new_argv; - size_t i; - - /* Count number of arguments. */ - for (argc = 0; argv[argc] != NULL; argc++) - ; - - /* Allocate new argument vector. */ - new_argv = XMALLOC (char *, argc + 1); - - /* Put quoted arguments into the new argument vector. */ - for (i = 0; i < argc; i++) - { - const char *string = argv[i]; - - if (string[0] == '\0') - new_argv[i] = xstrdup ("\"\""); - else if (strpbrk (string, SHELL_SPECIAL_CHARS) != NULL) - { - int quote_around = (strpbrk (string, SHELL_SPACE_CHARS) != NULL); - size_t length; - unsigned int backslashes; - const char *s; - char *quoted_string; - char *p; - - length = 0; - backslashes = 0; - if (quote_around) - length++; - for (s = string; *s != '\0'; s++) - { - char c = *s; - if (c == '"') - length += backslashes + 1; - length++; - if (c == '\\') - backslashes++; - else - backslashes = 0; - } - if (quote_around) - length += backslashes + 1; - - quoted_string = XMALLOC (char, length + 1); - - p = quoted_string; - backslashes = 0; - if (quote_around) - *p++ = '"'; - for (s = string; *s != '\0'; s++) - { - char c = *s; - if (c == '"') - { - unsigned int j; - for (j = backslashes + 1; j > 0; j--) - *p++ = '\\'; - } - *p++ = c; - if (c == '\\') - backslashes++; - else - backslashes = 0; - } - if (quote_around) - { - unsigned int j; - for (j = backslashes; j > 0; j--) - *p++ = '\\'; - *p++ = '"'; - } - *p = '\0'; - - new_argv[i] = quoted_string; - } - else - new_argv[i] = (char *) string; - } - new_argv[argc] = NULL; - - return new_argv; -} -EOF - ;; - esac - - cat <<"EOF" -void lt_dump_script (FILE* f) -{ -EOF - func_emit_wrapper yes | - $SED -n -e ' -s/^\(.\{79\}\)\(..*\)/\1\ -\2/ -h -s/\([\\"]\)/\\\1/g -s/$/\\n/ -s/\([^\n]*\).*/ fputs ("\1", f);/p -g -D' - cat <<"EOF" -} -EOF -} -# end: func_emit_cwrapperexe_src - -# func_win32_import_lib_p ARG -# True if ARG is an import lib, as indicated by $file_magic_cmd -func_win32_import_lib_p () -{ - $debug_cmd - - case `eval $file_magic_cmd \"\$1\" 2>/dev/null | $SED -e 10q` in - *import*) : ;; - *) false ;; - esac -} - -# func_suncc_cstd_abi -# !!ONLY CALL THIS FOR SUN CC AFTER $compile_command IS FULLY EXPANDED!! -# Several compiler flags select an ABI that is incompatible with the -# Cstd library. Avoid specifying it if any are in CXXFLAGS. -func_suncc_cstd_abi () -{ - $debug_cmd - - case " $compile_command " in - *" -compat=g "*|*\ -std=c++[0-9][0-9]\ *|*" -library=stdcxx4 "*|*" -library=stlport4 "*) - suncc_use_cstd_abi=no - ;; - *) - suncc_use_cstd_abi=yes - ;; - esac -} - -# func_mode_link arg... -func_mode_link () -{ - $debug_cmd - - case $host in - *-*-cygwin* | *-*-mingw* | *-*-pw32* | *-*-os2* | *-cegcc*) - # It is impossible to link a dll without this setting, and - # we shouldn't force the makefile maintainer to figure out - # what system we are compiling for in order to pass an extra - # flag for every libtool invocation. - # allow_undefined=no - - # FIXME: Unfortunately, there are problems with the above when trying - # to make a dll that has undefined symbols, in which case not - # even a static library is built. For now, we need to specify - # -no-undefined on the libtool link line when we can be certain - # that all symbols are satisfied, otherwise we get a static library. - allow_undefined=yes - ;; - *) - allow_undefined=yes - ;; - esac - libtool_args=$nonopt - base_compile="$nonopt $@" - compile_command=$nonopt - finalize_command=$nonopt - - compile_rpath= - finalize_rpath= - compile_shlibpath= - finalize_shlibpath= - convenience= - old_convenience= - deplibs= - old_deplibs= - compiler_flags= - linker_flags= - dllsearchpath= - lib_search_path=`pwd` - inst_prefix_dir= - new_inherited_linker_flags= - - avoid_version=no - bindir= - dlfiles= - dlprefiles= - dlself=no - export_dynamic=no - export_symbols= - export_symbols_regex= - generated= - libobjs= - ltlibs= - module=no - no_install=no - objs= - os2dllname= - non_pic_objects= - precious_files_regex= - prefer_static_libs=no - preload=false - prev= - prevarg= - release= - rpath= - xrpath= - perm_rpath= - temp_rpath= - thread_safe=no - vinfo= - vinfo_number=no - weak_libs= - single_module=$wl-single_module - func_infer_tag $base_compile - - # We need to know -static, to get the right output filenames. - for arg - do - case $arg in - -shared) - test yes != "$build_libtool_libs" \ - && func_fatal_configuration "cannot build a shared library" - build_old_libs=no - break - ;; - -all-static | -static | -static-libtool-libs) - case $arg in - -all-static) - if test yes = "$build_libtool_libs" && test -z "$link_static_flag"; then - func_warning "complete static linking is impossible in this configuration" - fi - if test -n "$link_static_flag"; then - dlopen_self=$dlopen_self_static - fi - prefer_static_libs=yes - ;; - -static) - if test -z "$pic_flag" && test -n "$link_static_flag"; then - dlopen_self=$dlopen_self_static - fi - prefer_static_libs=built - ;; - -static-libtool-libs) - if test -z "$pic_flag" && test -n "$link_static_flag"; then - dlopen_self=$dlopen_self_static - fi - prefer_static_libs=yes - ;; - esac - build_libtool_libs=no - build_old_libs=yes - break - ;; - esac - done - - # See if our shared archives depend on static archives. - test -n "$old_archive_from_new_cmds" && build_old_libs=yes - - # Go through the arguments, transforming them on the way. - while test "$#" -gt 0; do - arg=$1 - shift - func_quote_for_eval "$arg" - qarg=$func_quote_for_eval_unquoted_result - func_append libtool_args " $func_quote_for_eval_result" - - # If the previous option needs an argument, assign it. - if test -n "$prev"; then - case $prev in - output) - func_append compile_command " @OUTPUT@" - func_append finalize_command " @OUTPUT@" - ;; - esac - - case $prev in - bindir) - bindir=$arg - prev= - continue - ;; - dlfiles|dlprefiles) - $preload || { - # Add the symbol object into the linking commands. - func_append compile_command " @SYMFILE@" - func_append finalize_command " @SYMFILE@" - preload=: - } - case $arg in - *.la | *.lo) ;; # We handle these cases below. - force) - if test no = "$dlself"; then - dlself=needless - export_dynamic=yes - fi - prev= - continue - ;; - self) - if test dlprefiles = "$prev"; then - dlself=yes - elif test dlfiles = "$prev" && test yes != "$dlopen_self"; then - dlself=yes - else - dlself=needless - export_dynamic=yes - fi - prev= - continue - ;; - *) - if test dlfiles = "$prev"; then - func_append dlfiles " $arg" - else - func_append dlprefiles " $arg" - fi - prev= - continue - ;; - esac - ;; - expsyms) - export_symbols=$arg - test -f "$arg" \ - || func_fatal_error "symbol file '$arg' does not exist" - prev= - continue - ;; - expsyms_regex) - export_symbols_regex=$arg - prev= - continue - ;; - framework) - case $host in - *-*-darwin*) - case "$deplibs " in - *" $qarg.ltframework "*) ;; - *) func_append deplibs " $qarg.ltframework" # this is fixed later - ;; - esac - ;; - esac - prev= - continue - ;; - inst_prefix) - inst_prefix_dir=$arg - prev= - continue - ;; - mllvm) - # Clang does not use LLVM to link, so we can simply discard any - # '-mllvm $arg' options when doing the link step. - prev= - continue - ;; - objectlist) - if test -f "$arg"; then - save_arg=$arg - moreargs= - for fil in `cat "$save_arg"` - do -# func_append moreargs " $fil" - arg=$fil - # A libtool-controlled object. - - # Check to see that this really is a libtool object. - if func_lalib_unsafe_p "$arg"; then - pic_object= - non_pic_object= - - # Read the .lo file - func_source "$arg" - - if test -z "$pic_object" || - test -z "$non_pic_object" || - test none = "$pic_object" && - test none = "$non_pic_object"; then - func_fatal_error "cannot find name of object for '$arg'" - fi - - # Extract subdirectory from the argument. - func_dirname "$arg" "/" "" - xdir=$func_dirname_result - - if test none != "$pic_object"; then - # Prepend the subdirectory the object is found in. - pic_object=$xdir$pic_object - - if test dlfiles = "$prev"; then - if test yes = "$build_libtool_libs" && test yes = "$dlopen_support"; then - func_append dlfiles " $pic_object" - prev= - continue - else - # If libtool objects are unsupported, then we need to preload. - prev=dlprefiles - fi - fi - - # CHECK ME: I think I busted this. -Ossama - if test dlprefiles = "$prev"; then - # Preload the old-style object. - func_append dlprefiles " $pic_object" - prev= - fi - - # A PIC object. - func_append libobjs " $pic_object" - arg=$pic_object - fi - - # Non-PIC object. - if test none != "$non_pic_object"; then - # Prepend the subdirectory the object is found in. - non_pic_object=$xdir$non_pic_object - - # A standard non-PIC object - func_append non_pic_objects " $non_pic_object" - if test -z "$pic_object" || test none = "$pic_object"; then - arg=$non_pic_object - fi - else - # If the PIC object exists, use it instead. - # $xdir was prepended to $pic_object above. - non_pic_object=$pic_object - func_append non_pic_objects " $non_pic_object" - fi - else - # Only an error if not doing a dry-run. - if $opt_dry_run; then - # Extract subdirectory from the argument. - func_dirname "$arg" "/" "" - xdir=$func_dirname_result - - func_lo2o "$arg" - pic_object=$xdir$objdir/$func_lo2o_result - non_pic_object=$xdir$func_lo2o_result - func_append libobjs " $pic_object" - func_append non_pic_objects " $non_pic_object" - else - func_fatal_error "'$arg' is not a valid libtool object" - fi - fi - done - else - func_fatal_error "link input file '$arg' does not exist" - fi - arg=$save_arg - prev= - continue - ;; - os2dllname) - os2dllname=$arg - prev= - continue - ;; - precious_regex) - precious_files_regex=$arg - prev= - continue - ;; - release) - release=-$arg - prev= - continue - ;; - rpath | xrpath) - # We need an absolute path. - case $arg in - [\\/]* | [A-Za-z]:[\\/]*) ;; - *) - func_fatal_error "only absolute run-paths are allowed" - ;; - esac - if test rpath = "$prev"; then - case "$rpath " in - *" $arg "*) ;; - *) func_append rpath " $arg" ;; - esac - else - case "$xrpath " in - *" $arg "*) ;; - *) func_append xrpath " $arg" ;; - esac - fi - prev= - continue - ;; - shrext) - shrext_cmds=$arg - prev= - continue - ;; - weak) - func_append weak_libs " $arg" - prev= - continue - ;; - xcclinker) - func_append linker_flags " $qarg" - func_append compiler_flags " $qarg" - prev= - func_append compile_command " $qarg" - func_append finalize_command " $qarg" - continue - ;; - xcompiler) - func_append compiler_flags " $qarg" - prev= - func_append compile_command " $qarg" - func_append finalize_command " $qarg" - continue - ;; - xlinker) - func_append linker_flags " $qarg" - func_append compiler_flags " $wl$qarg" - prev= - func_append compile_command " $wl$qarg" - func_append finalize_command " $wl$qarg" - continue - ;; - *) - eval "$prev=\"\$arg\"" - prev= - continue - ;; - esac - fi # test -n "$prev" - - prevarg=$arg - - case $arg in - -all-static) - if test -n "$link_static_flag"; then - # See comment for -static flag below, for more details. - func_append compile_command " $link_static_flag" - func_append finalize_command " $link_static_flag" - fi - continue - ;; - - -allow-undefined) - # FIXME: remove this flag sometime in the future. - func_fatal_error "'-allow-undefined' must not be used because it is the default" - ;; - - -avoid-version) - avoid_version=yes - continue - ;; - - -bindir) - prev=bindir - continue - ;; - - -dlopen) - prev=dlfiles - continue - ;; - - -dlpreopen) - prev=dlprefiles - continue - ;; - - -export-dynamic) - export_dynamic=yes - continue - ;; - - -export-symbols | -export-symbols-regex) - if test -n "$export_symbols" || test -n "$export_symbols_regex"; then - func_fatal_error "more than one -exported-symbols argument is not allowed" - fi - if test X-export-symbols = "X$arg"; then - prev=expsyms - else - prev=expsyms_regex - fi - continue - ;; - - -framework) - prev=framework - continue - ;; - - -inst-prefix-dir) - prev=inst_prefix - continue - ;; - - # The native IRIX linker understands -LANG:*, -LIST:* and -LNO:* - # so, if we see these flags be careful not to treat them like -L - -L[A-Z][A-Z]*:*) - case $with_gcc/$host in - no/*-*-irix* | /*-*-irix*) - func_append compile_command " $arg" - func_append finalize_command " $arg" - ;; - esac - continue - ;; - - -L*) - func_stripname "-L" '' "$arg" - if test -z "$func_stripname_result"; then - if test "$#" -gt 0; then - func_fatal_error "require no space between '-L' and '$1'" - else - func_fatal_error "need path for '-L' option" - fi - fi - func_resolve_sysroot "$func_stripname_result" - dir=$func_resolve_sysroot_result - # We need an absolute path. - case $dir in - [\\/]* | [A-Za-z]:[\\/]*) ;; - *) - absdir=`cd "$dir" && pwd` - test -z "$absdir" && \ - func_fatal_error "cannot determine absolute directory name of '$dir'" - dir=$absdir - ;; - esac - case "$deplibs " in - *" -L$dir "* | *" $arg "*) - # Will only happen for absolute or sysroot arguments - ;; - *) - # Preserve sysroot, but never include relative directories - case $dir in - [\\/]* | [A-Za-z]:[\\/]* | =*) func_append deplibs " $arg" ;; - *) func_append deplibs " -L$dir" ;; - esac - func_append lib_search_path " $dir" - ;; - esac - case $host in - *-*-cygwin* | *-*-mingw* | *-*-pw32* | *-*-os2* | *-cegcc*) - testbindir=`$ECHO "$dir" | $SED 's*/lib$*/bin*'` - case :$dllsearchpath: in - *":$dir:"*) ;; - ::) dllsearchpath=$dir;; - *) func_append dllsearchpath ":$dir";; - esac - case :$dllsearchpath: in - *":$testbindir:"*) ;; - ::) dllsearchpath=$testbindir;; - *) func_append dllsearchpath ":$testbindir";; - esac - ;; - esac - continue - ;; - - -l*) - if test X-lc = "X$arg" || test X-lm = "X$arg"; then - case $host in - *-*-cygwin* | *-*-mingw* | *-*-pw32* | *-*-beos* | *-cegcc* | *-*-haiku*) - # These systems don't actually have a C or math library (as such) - continue - ;; - *-*-os2*) - # These systems don't actually have a C library (as such) - test X-lc = "X$arg" && continue - ;; - *-*-openbsd* | *-*-freebsd* | *-*-dragonfly* | *-*-bitrig*) - # Do not include libc due to us having libc/libc_r. - test X-lc = "X$arg" && continue - ;; - *-*-rhapsody* | *-*-darwin1.[012]) - # Rhapsody C and math libraries are in the System framework - func_append deplibs " System.ltframework" - continue - ;; - *-*-sco3.2v5* | *-*-sco5v6*) - # Causes problems with __ctype - test X-lc = "X$arg" && continue - ;; - *-*-sysv4.2uw2* | *-*-sysv5* | *-*-unixware* | *-*-OpenUNIX*) - # Compiler inserts libc in the correct place for threads to work - test X-lc = "X$arg" && continue - ;; - esac - elif test X-lc_r = "X$arg"; then - case $host in - *-*-openbsd* | *-*-freebsd* | *-*-dragonfly* | *-*-bitrig*) - # Do not include libc_r directly, use -pthread flag. - continue - ;; - esac - fi - func_append deplibs " $arg" - continue - ;; - - -mllvm) - prev=mllvm - continue - ;; - - -module) - module=yes - continue - ;; - - # Tru64 UNIX uses -model [arg] to determine the layout of C++ - # classes, name mangling, and exception handling. - # Darwin uses the -arch flag to determine output architecture. - -model|-arch|-isysroot|--sysroot) - func_append compiler_flags " $arg" - func_append compile_command " $arg" - func_append finalize_command " $arg" - prev=xcompiler - continue - ;; - - -mt|-mthreads|-kthread|-Kthread|-pthread|-pthreads|--thread-safe \ - |-threads|-fopenmp|-openmp|-mp|-xopenmp|-omp|-qsmp=*) - func_append compiler_flags " $arg" - func_append compile_command " $arg" - func_append finalize_command " $arg" - case "$new_inherited_linker_flags " in - *" $arg "*) ;; - * ) func_append new_inherited_linker_flags " $arg" ;; - esac - continue - ;; - - -multi_module) - single_module=$wl-multi_module - continue - ;; - - -no-fast-install) - fast_install=no - continue - ;; - - -no-install) - case $host in - *-*-cygwin* | *-*-mingw* | *-*-pw32* | *-*-os2* | *-*-darwin* | *-cegcc*) - # The PATH hackery in wrapper scripts is required on Windows - # and Darwin in order for the loader to find any dlls it needs. - func_warning "'-no-install' is ignored for $host" - func_warning "assuming '-no-fast-install' instead" - fast_install=no - ;; - *) no_install=yes ;; - esac - continue - ;; - - -no-undefined) - allow_undefined=no - continue - ;; - - -objectlist) - prev=objectlist - continue - ;; - - -os2dllname) - prev=os2dllname - continue - ;; - - -o) prev=output ;; - - -precious-files-regex) - prev=precious_regex - continue - ;; - - -release) - prev=release - continue - ;; - - -rpath) - prev=rpath - continue - ;; - - -R) - prev=xrpath - continue - ;; - - -R*) - func_stripname '-R' '' "$arg" - dir=$func_stripname_result - # We need an absolute path. - case $dir in - [\\/]* | [A-Za-z]:[\\/]*) ;; - =*) - func_stripname '=' '' "$dir" - dir=$lt_sysroot$func_stripname_result - ;; - *) - func_fatal_error "only absolute run-paths are allowed" - ;; - esac - case "$xrpath " in - *" $dir "*) ;; - *) func_append xrpath " $dir" ;; - esac - continue - ;; - - -shared) - # The effects of -shared are defined in a previous loop. - continue - ;; - - -shrext) - prev=shrext - continue - ;; - - -static | -static-libtool-libs) - # The effects of -static are defined in a previous loop. - # We used to do the same as -all-static on platforms that - # didn't have a PIC flag, but the assumption that the effects - # would be equivalent was wrong. It would break on at least - # Digital Unix and AIX. - continue - ;; - - -thread-safe) - thread_safe=yes - continue - ;; - - -version-info) - prev=vinfo - continue - ;; - - -version-number) - prev=vinfo - vinfo_number=yes - continue - ;; - - -weak) - prev=weak - continue - ;; - - -Wc,*) - func_stripname '-Wc,' '' "$arg" - args=$func_stripname_result - arg= - save_ifs=$IFS; IFS=, - for flag in $args; do - IFS=$save_ifs - func_quote_for_eval "$flag" - func_append arg " $func_quote_for_eval_result" - func_append compiler_flags " $func_quote_for_eval_result" - done - IFS=$save_ifs - func_stripname ' ' '' "$arg" - arg=$func_stripname_result - ;; - - -Wl,*) - func_stripname '-Wl,' '' "$arg" - args=$func_stripname_result - arg= - save_ifs=$IFS; IFS=, - for flag in $args; do - IFS=$save_ifs - func_quote_for_eval "$flag" - func_append arg " $wl$func_quote_for_eval_result" - func_append compiler_flags " $wl$func_quote_for_eval_result" - func_append linker_flags " $func_quote_for_eval_result" - done - IFS=$save_ifs - func_stripname ' ' '' "$arg" - arg=$func_stripname_result - ;; - - -Xcompiler) - prev=xcompiler - continue - ;; - - -Xlinker) - prev=xlinker - continue - ;; - - -XCClinker) - prev=xcclinker - continue - ;; - - # -msg_* for osf cc - -msg_*) - func_quote_for_eval "$arg" - arg=$func_quote_for_eval_result - ;; - - # Flags to be passed through unchanged, with rationale: - # -64, -mips[0-9] enable 64-bit mode for the SGI compiler - # -r[0-9][0-9]* specify processor for the SGI compiler - # -xarch=*, -xtarget=* enable 64-bit mode for the Sun compiler - # +DA*, +DD* enable 64-bit mode for the HP compiler - # -q* compiler args for the IBM compiler - # -m*, -t[45]*, -txscale* architecture-specific flags for GCC - # -F/path path to uninstalled frameworks, gcc on darwin - # -p, -pg, --coverage, -fprofile-* profiling flags for GCC - # -fstack-protector* stack protector flags for GCC - # @file GCC response files - # -tp=* Portland pgcc target processor selection - # --sysroot=* for sysroot support - # -O*, -g*, -flto*, -fwhopr*, -fuse-linker-plugin GCC link-time optimization - # -stdlib=* select c++ std lib with clang - -64|-mips[0-9]|-r[0-9][0-9]*|-xarch=*|-xtarget=*|+DA*|+DD*|-q*|-m*| \ - -t[45]*|-txscale*|-p|-pg|--coverage|-fprofile-*|-F*|@*|-tp=*|--sysroot=*| \ - -O*|-g*|-flto*|-fwhopr*|-fuse-linker-plugin|-fstack-protector*|-stdlib=*) - func_quote_for_eval "$arg" - arg=$func_quote_for_eval_result - func_append compile_command " $arg" - func_append finalize_command " $arg" - func_append compiler_flags " $arg" - continue - ;; - - -Z*) - if test os2 = "`expr $host : '.*\(os2\)'`"; then - # OS/2 uses -Zxxx to specify OS/2-specific options - compiler_flags="$compiler_flags $arg" - func_append compile_command " $arg" - func_append finalize_command " $arg" - case $arg in - -Zlinker | -Zstack) - prev=xcompiler - ;; - esac - continue - else - # Otherwise treat like 'Some other compiler flag' below - func_quote_for_eval "$arg" - arg=$func_quote_for_eval_result - fi - ;; - - # Some other compiler flag. - -* | +*) - func_quote_for_eval "$arg" - arg=$func_quote_for_eval_result - ;; - - *.$objext) - # A standard object. - func_append objs " $arg" - ;; - - *.lo) - # A libtool-controlled object. - - # Check to see that this really is a libtool object. - if func_lalib_unsafe_p "$arg"; then - pic_object= - non_pic_object= - - # Read the .lo file - func_source "$arg" - - if test -z "$pic_object" || - test -z "$non_pic_object" || - test none = "$pic_object" && - test none = "$non_pic_object"; then - func_fatal_error "cannot find name of object for '$arg'" - fi - - # Extract subdirectory from the argument. - func_dirname "$arg" "/" "" - xdir=$func_dirname_result - - test none = "$pic_object" || { - # Prepend the subdirectory the object is found in. - pic_object=$xdir$pic_object - - if test dlfiles = "$prev"; then - if test yes = "$build_libtool_libs" && test yes = "$dlopen_support"; then - func_append dlfiles " $pic_object" - prev= - continue - else - # If libtool objects are unsupported, then we need to preload. - prev=dlprefiles - fi - fi - - # CHECK ME: I think I busted this. -Ossama - if test dlprefiles = "$prev"; then - # Preload the old-style object. - func_append dlprefiles " $pic_object" - prev= - fi - - # A PIC object. - func_append libobjs " $pic_object" - arg=$pic_object - } - - # Non-PIC object. - if test none != "$non_pic_object"; then - # Prepend the subdirectory the object is found in. - non_pic_object=$xdir$non_pic_object - - # A standard non-PIC object - func_append non_pic_objects " $non_pic_object" - if test -z "$pic_object" || test none = "$pic_object"; then - arg=$non_pic_object - fi - else - # If the PIC object exists, use it instead. - # $xdir was prepended to $pic_object above. - non_pic_object=$pic_object - func_append non_pic_objects " $non_pic_object" - fi - else - # Only an error if not doing a dry-run. - if $opt_dry_run; then - # Extract subdirectory from the argument. - func_dirname "$arg" "/" "" - xdir=$func_dirname_result - - func_lo2o "$arg" - pic_object=$xdir$objdir/$func_lo2o_result - non_pic_object=$xdir$func_lo2o_result - func_append libobjs " $pic_object" - func_append non_pic_objects " $non_pic_object" - else - func_fatal_error "'$arg' is not a valid libtool object" - fi - fi - ;; - - *.$libext) - # An archive. - func_append deplibs " $arg" - func_append old_deplibs " $arg" - continue - ;; - - *.la) - # A libtool-controlled library. - - func_resolve_sysroot "$arg" - if test dlfiles = "$prev"; then - # This library was specified with -dlopen. - func_append dlfiles " $func_resolve_sysroot_result" - prev= - elif test dlprefiles = "$prev"; then - # The library was specified with -dlpreopen. - func_append dlprefiles " $func_resolve_sysroot_result" - prev= - else - func_append deplibs " $func_resolve_sysroot_result" - fi - continue - ;; - - # Some other compiler argument. - *) - # Unknown arguments in both finalize_command and compile_command need - # to be aesthetically quoted because they are evaled later. - func_quote_for_eval "$arg" - arg=$func_quote_for_eval_result - ;; - esac # arg - - # Now actually substitute the argument into the commands. - if test -n "$arg"; then - func_append compile_command " $arg" - func_append finalize_command " $arg" - fi - done # argument parsing loop - - test -n "$prev" && \ - func_fatal_help "the '$prevarg' option requires an argument" - - if test yes = "$export_dynamic" && test -n "$export_dynamic_flag_spec"; then - eval arg=\"$export_dynamic_flag_spec\" - func_append compile_command " $arg" - func_append finalize_command " $arg" - fi - - oldlibs= - # calculate the name of the file, without its directory - func_basename "$output" - outputname=$func_basename_result - libobjs_save=$libobjs - - if test -n "$shlibpath_var"; then - # get the directories listed in $shlibpath_var - eval shlib_search_path=\`\$ECHO \"\$$shlibpath_var\" \| \$SED \'s/:/ /g\'\` - else - shlib_search_path= - fi - eval sys_lib_search_path=\"$sys_lib_search_path_spec\" - eval sys_lib_dlsearch_path=\"$sys_lib_dlsearch_path_spec\" - - # Definition is injected by LT_CONFIG during libtool generation. - func_munge_path_list sys_lib_dlsearch_path "$LT_SYS_LIBRARY_PATH" - - func_dirname "$output" "/" "" - output_objdir=$func_dirname_result$objdir - func_to_tool_file "$output_objdir/" - tool_output_objdir=$func_to_tool_file_result - # Create the object directory. - func_mkdir_p "$output_objdir" - - # Determine the type of output - case $output in - "") - func_fatal_help "you must specify an output file" - ;; - *.$libext) linkmode=oldlib ;; - *.lo | *.$objext) linkmode=obj ;; - *.la) linkmode=lib ;; - *) linkmode=prog ;; # Anything else should be a program. - esac - - specialdeplibs= - - libs= - # Find all interdependent deplibs by searching for libraries - # that are linked more than once (e.g. -la -lb -la) - for deplib in $deplibs; do - if $opt_preserve_dup_deps; then - case "$libs " in - *" $deplib "*) func_append specialdeplibs " $deplib" ;; - esac - fi - func_append libs " $deplib" - done - - if test lib = "$linkmode"; then - libs="$predeps $libs $compiler_lib_search_path $postdeps" - - # Compute libraries that are listed more than once in $predeps - # $postdeps and mark them as special (i.e., whose duplicates are - # not to be eliminated). - pre_post_deps= - if $opt_duplicate_compiler_generated_deps; then - for pre_post_dep in $predeps $postdeps; do - case "$pre_post_deps " in - *" $pre_post_dep "*) func_append specialdeplibs " $pre_post_deps" ;; - esac - func_append pre_post_deps " $pre_post_dep" - done - fi - pre_post_deps= - fi - - deplibs= - newdependency_libs= - newlib_search_path= - need_relink=no # whether we're linking any uninstalled libtool libraries - notinst_deplibs= # not-installed libtool libraries - notinst_path= # paths that contain not-installed libtool libraries - - case $linkmode in - lib) - passes="conv dlpreopen link" - for file in $dlfiles $dlprefiles; do - case $file in - *.la) ;; - *) - func_fatal_help "libraries can '-dlopen' only libtool libraries: $file" - ;; - esac - done - ;; - prog) - compile_deplibs= - finalize_deplibs= - alldeplibs=false - newdlfiles= - newdlprefiles= - passes="conv scan dlopen dlpreopen link" - ;; - *) passes="conv" - ;; - esac - - for pass in $passes; do - # The preopen pass in lib mode reverses $deplibs; put it back here - # so that -L comes before libs that need it for instance... - if test lib,link = "$linkmode,$pass"; then - ## FIXME: Find the place where the list is rebuilt in the wrong - ## order, and fix it there properly - tmp_deplibs= - for deplib in $deplibs; do - tmp_deplibs="$deplib $tmp_deplibs" - done - deplibs=$tmp_deplibs - fi - - if test lib,link = "$linkmode,$pass" || - test prog,scan = "$linkmode,$pass"; then - libs=$deplibs - deplibs= - fi - if test prog = "$linkmode"; then - case $pass in - dlopen) libs=$dlfiles ;; - dlpreopen) libs=$dlprefiles ;; - link) libs="$deplibs %DEPLIBS% $dependency_libs" ;; - esac - fi - if test lib,dlpreopen = "$linkmode,$pass"; then - # Collect and forward deplibs of preopened libtool libs - for lib in $dlprefiles; do - # Ignore non-libtool-libs - dependency_libs= - func_resolve_sysroot "$lib" - case $lib in - *.la) func_source "$func_resolve_sysroot_result" ;; - esac - - # Collect preopened libtool deplibs, except any this library - # has declared as weak libs - for deplib in $dependency_libs; do - func_basename "$deplib" - deplib_base=$func_basename_result - case " $weak_libs " in - *" $deplib_base "*) ;; - *) func_append deplibs " $deplib" ;; - esac - done - done - libs=$dlprefiles - fi - if test dlopen = "$pass"; then - # Collect dlpreopened libraries - save_deplibs=$deplibs - deplibs= - fi - - for deplib in $libs; do - lib= - found=false - case $deplib in - -mt|-mthreads|-kthread|-Kthread|-pthread|-pthreads|--thread-safe \ - |-threads|-fopenmp|-openmp|-mp|-xopenmp|-omp|-qsmp=*) - if test prog,link = "$linkmode,$pass"; then - compile_deplibs="$deplib $compile_deplibs" - finalize_deplibs="$deplib $finalize_deplibs" - else - func_append compiler_flags " $deplib" - if test lib = "$linkmode"; then - case "$new_inherited_linker_flags " in - *" $deplib "*) ;; - * ) func_append new_inherited_linker_flags " $deplib" ;; - esac - fi - fi - continue - ;; - -l*) - if test lib != "$linkmode" && test prog != "$linkmode"; then - func_warning "'-l' is ignored for archives/objects" - continue - fi - func_stripname '-l' '' "$deplib" - name=$func_stripname_result - if test lib = "$linkmode"; then - searchdirs="$newlib_search_path $lib_search_path $compiler_lib_search_dirs $sys_lib_search_path $shlib_search_path" - else - searchdirs="$newlib_search_path $lib_search_path $sys_lib_search_path $shlib_search_path" - fi - for searchdir in $searchdirs; do - for search_ext in .la $std_shrext .so .a; do - # Search the libtool library - lib=$searchdir/lib$name$search_ext - if test -f "$lib"; then - if test .la = "$search_ext"; then - found=: - else - found=false - fi - break 2 - fi - done - done - if $found; then - # deplib is a libtool library - # If $allow_libtool_libs_with_static_runtimes && $deplib is a stdlib, - # We need to do some special things here, and not later. - if test yes = "$allow_libtool_libs_with_static_runtimes"; then - case " $predeps $postdeps " in - *" $deplib "*) - if func_lalib_p "$lib"; then - library_names= - old_library= - func_source "$lib" - for l in $old_library $library_names; do - ll=$l - done - if test "X$ll" = "X$old_library"; then # only static version available - found=false - func_dirname "$lib" "" "." - ladir=$func_dirname_result - lib=$ladir/$old_library - if test prog,link = "$linkmode,$pass"; then - compile_deplibs="$deplib $compile_deplibs" - finalize_deplibs="$deplib $finalize_deplibs" - else - deplibs="$deplib $deplibs" - test lib = "$linkmode" && newdependency_libs="$deplib $newdependency_libs" - fi - continue - fi - fi - ;; - *) ;; - esac - fi - else - # deplib doesn't seem to be a libtool library - if test prog,link = "$linkmode,$pass"; then - compile_deplibs="$deplib $compile_deplibs" - finalize_deplibs="$deplib $finalize_deplibs" - else - deplibs="$deplib $deplibs" - test lib = "$linkmode" && newdependency_libs="$deplib $newdependency_libs" - fi - continue - fi - ;; # -l - *.ltframework) - if test prog,link = "$linkmode,$pass"; then - compile_deplibs="$deplib $compile_deplibs" - finalize_deplibs="$deplib $finalize_deplibs" - else - deplibs="$deplib $deplibs" - if test lib = "$linkmode"; then - case "$new_inherited_linker_flags " in - *" $deplib "*) ;; - * ) func_append new_inherited_linker_flags " $deplib" ;; - esac - fi - fi - continue - ;; - -L*) - case $linkmode in - lib) - deplibs="$deplib $deplibs" - test conv = "$pass" && continue - newdependency_libs="$deplib $newdependency_libs" - func_stripname '-L' '' "$deplib" - func_resolve_sysroot "$func_stripname_result" - func_append newlib_search_path " $func_resolve_sysroot_result" - ;; - prog) - if test conv = "$pass"; then - deplibs="$deplib $deplibs" - continue - fi - if test scan = "$pass"; then - deplibs="$deplib $deplibs" - else - compile_deplibs="$deplib $compile_deplibs" - finalize_deplibs="$deplib $finalize_deplibs" - fi - func_stripname '-L' '' "$deplib" - func_resolve_sysroot "$func_stripname_result" - func_append newlib_search_path " $func_resolve_sysroot_result" - ;; - *) - func_warning "'-L' is ignored for archives/objects" - ;; - esac # linkmode - continue - ;; # -L - -R*) - if test link = "$pass"; then - func_stripname '-R' '' "$deplib" - func_resolve_sysroot "$func_stripname_result" - dir=$func_resolve_sysroot_result - # Make sure the xrpath contains only unique directories. - case "$xrpath " in - *" $dir "*) ;; - *) func_append xrpath " $dir" ;; - esac - fi - deplibs="$deplib $deplibs" - continue - ;; - *.la) - func_resolve_sysroot "$deplib" - lib=$func_resolve_sysroot_result - ;; - *.$libext) - if test conv = "$pass"; then - deplibs="$deplib $deplibs" - continue - fi - case $linkmode in - lib) - # Linking convenience modules into shared libraries is allowed, - # but linking other static libraries is non-portable. - case " $dlpreconveniencelibs " in - *" $deplib "*) ;; - *) - valid_a_lib=false - case $deplibs_check_method in - match_pattern*) - set dummy $deplibs_check_method; shift - match_pattern_regex=`expr "$deplibs_check_method" : "$1 \(.*\)"` - if eval "\$ECHO \"$deplib\"" 2>/dev/null | $SED 10q \ - | $EGREP "$match_pattern_regex" > /dev/null; then - valid_a_lib=: - fi - ;; - pass_all) - valid_a_lib=: - ;; - esac - if $valid_a_lib; then - echo - $ECHO "*** Warning: Linking the shared library $output against the" - $ECHO "*** static library $deplib is not portable!" - deplibs="$deplib $deplibs" - else - echo - $ECHO "*** Warning: Trying to link with static lib archive $deplib." - echo "*** I have the capability to make that library automatically link in when" - echo "*** you link to this library. But I can only do this if you have a" - echo "*** shared version of the library, which you do not appear to have" - echo "*** because the file extensions .$libext of this argument makes me believe" - echo "*** that it is just a static archive that I should not use here." - fi - ;; - esac - continue - ;; - prog) - if test link != "$pass"; then - deplibs="$deplib $deplibs" - else - compile_deplibs="$deplib $compile_deplibs" - finalize_deplibs="$deplib $finalize_deplibs" - fi - continue - ;; - esac # linkmode - ;; # *.$libext - *.lo | *.$objext) - if test conv = "$pass"; then - deplibs="$deplib $deplibs" - elif test prog = "$linkmode"; then - if test dlpreopen = "$pass" || test yes != "$dlopen_support" || test no = "$build_libtool_libs"; then - # If there is no dlopen support or we're linking statically, - # we need to preload. - func_append newdlprefiles " $deplib" - compile_deplibs="$deplib $compile_deplibs" - finalize_deplibs="$deplib $finalize_deplibs" - else - func_append newdlfiles " $deplib" - fi - fi - continue - ;; - %DEPLIBS%) - alldeplibs=: - continue - ;; - esac # case $deplib - - $found || test -f "$lib" \ - || func_fatal_error "cannot find the library '$lib' or unhandled argument '$deplib'" - - # Check to see that this really is a libtool archive. - func_lalib_unsafe_p "$lib" \ - || func_fatal_error "'$lib' is not a valid libtool archive" - - func_dirname "$lib" "" "." - ladir=$func_dirname_result - - dlname= - dlopen= - dlpreopen= - libdir= - library_names= - old_library= - inherited_linker_flags= - # If the library was installed with an old release of libtool, - # it will not redefine variables installed, or shouldnotlink - installed=yes - shouldnotlink=no - avoidtemprpath= - - - # Read the .la file - func_source "$lib" - - # Convert "-framework foo" to "foo.ltframework" - if test -n "$inherited_linker_flags"; then - tmp_inherited_linker_flags=`$ECHO "$inherited_linker_flags" | $SED 's/-framework \([^ $]*\)/\1.ltframework/g'` - for tmp_inherited_linker_flag in $tmp_inherited_linker_flags; do - case " $new_inherited_linker_flags " in - *" $tmp_inherited_linker_flag "*) ;; - *) func_append new_inherited_linker_flags " $tmp_inherited_linker_flag";; - esac - done - fi - dependency_libs=`$ECHO " $dependency_libs" | $SED 's% \([^ $]*\).ltframework% -framework \1%g'` - if test lib,link = "$linkmode,$pass" || - test prog,scan = "$linkmode,$pass" || - { test prog != "$linkmode" && test lib != "$linkmode"; }; then - test -n "$dlopen" && func_append dlfiles " $dlopen" - test -n "$dlpreopen" && func_append dlprefiles " $dlpreopen" - fi - - if test conv = "$pass"; then - # Only check for convenience libraries - deplibs="$lib $deplibs" - if test -z "$libdir"; then - if test -z "$old_library"; then - func_fatal_error "cannot find name of link library for '$lib'" - fi - # It is a libtool convenience library, so add in its objects. - func_append convenience " $ladir/$objdir/$old_library" - func_append old_convenience " $ladir/$objdir/$old_library" - elif test prog != "$linkmode" && test lib != "$linkmode"; then - func_fatal_error "'$lib' is not a convenience library" - fi - tmp_libs= - for deplib in $dependency_libs; do - deplibs="$deplib $deplibs" - if $opt_preserve_dup_deps; then - case "$tmp_libs " in - *" $deplib "*) func_append specialdeplibs " $deplib" ;; - esac - fi - func_append tmp_libs " $deplib" - done - continue - fi # $pass = conv - - - # Get the name of the library we link against. - linklib= - if test -n "$old_library" && - { test yes = "$prefer_static_libs" || - test built,no = "$prefer_static_libs,$installed"; }; then - linklib=$old_library - else - for l in $old_library $library_names; do - linklib=$l - done - fi - if test -z "$linklib"; then - func_fatal_error "cannot find name of link library for '$lib'" - fi - - # This library was specified with -dlopen. - if test dlopen = "$pass"; then - test -z "$libdir" \ - && func_fatal_error "cannot -dlopen a convenience library: '$lib'" - if test -z "$dlname" || - test yes != "$dlopen_support" || - test no = "$build_libtool_libs" - then - # If there is no dlname, no dlopen support or we're linking - # statically, we need to preload. We also need to preload any - # dependent libraries so libltdl's deplib preloader doesn't - # bomb out in the load deplibs phase. - func_append dlprefiles " $lib $dependency_libs" - else - func_append newdlfiles " $lib" - fi - continue - fi # $pass = dlopen - - # We need an absolute path. - case $ladir in - [\\/]* | [A-Za-z]:[\\/]*) abs_ladir=$ladir ;; - *) - abs_ladir=`cd "$ladir" && pwd` - if test -z "$abs_ladir"; then - func_warning "cannot determine absolute directory name of '$ladir'" - func_warning "passing it literally to the linker, although it might fail" - abs_ladir=$ladir - fi - ;; - esac - func_basename "$lib" - laname=$func_basename_result - - # Find the relevant object directory and library name. - if test yes = "$installed"; then - if test ! -f "$lt_sysroot$libdir/$linklib" && test -f "$abs_ladir/$linklib"; then - func_warning "library '$lib' was moved." - dir=$ladir - absdir=$abs_ladir - libdir=$abs_ladir - else - dir=$lt_sysroot$libdir - absdir=$lt_sysroot$libdir - fi - test yes = "$hardcode_automatic" && avoidtemprpath=yes - else - if test ! -f "$ladir/$objdir/$linklib" && test -f "$abs_ladir/$linklib"; then - dir=$ladir - absdir=$abs_ladir - # Remove this search path later - func_append notinst_path " $abs_ladir" - else - dir=$ladir/$objdir - absdir=$abs_ladir/$objdir - # Remove this search path later - func_append notinst_path " $abs_ladir" - fi - fi # $installed = yes - func_stripname 'lib' '.la' "$laname" - name=$func_stripname_result - - # This library was specified with -dlpreopen. - if test dlpreopen = "$pass"; then - if test -z "$libdir" && test prog = "$linkmode"; then - func_fatal_error "only libraries may -dlpreopen a convenience library: '$lib'" - fi - case $host in - # special handling for platforms with PE-DLLs. - *cygwin* | *mingw* | *cegcc* ) - # Linker will automatically link against shared library if both - # static and shared are present. Therefore, ensure we extract - # symbols from the import library if a shared library is present - # (otherwise, the dlopen module name will be incorrect). We do - # this by putting the import library name into $newdlprefiles. - # We recover the dlopen module name by 'saving' the la file - # name in a special purpose variable, and (later) extracting the - # dlname from the la file. - if test -n "$dlname"; then - func_tr_sh "$dir/$linklib" - eval "libfile_$func_tr_sh_result=\$abs_ladir/\$laname" - func_append newdlprefiles " $dir/$linklib" - else - func_append newdlprefiles " $dir/$old_library" - # Keep a list of preopened convenience libraries to check - # that they are being used correctly in the link pass. - test -z "$libdir" && \ - func_append dlpreconveniencelibs " $dir/$old_library" - fi - ;; - * ) - # Prefer using a static library (so that no silly _DYNAMIC symbols - # are required to link). - if test -n "$old_library"; then - func_append newdlprefiles " $dir/$old_library" - # Keep a list of preopened convenience libraries to check - # that they are being used correctly in the link pass. - test -z "$libdir" && \ - func_append dlpreconveniencelibs " $dir/$old_library" - # Otherwise, use the dlname, so that lt_dlopen finds it. - elif test -n "$dlname"; then - func_append newdlprefiles " $dir/$dlname" - else - func_append newdlprefiles " $dir/$linklib" - fi - ;; - esac - fi # $pass = dlpreopen - - if test -z "$libdir"; then - # Link the convenience library - if test lib = "$linkmode"; then - deplibs="$dir/$old_library $deplibs" - elif test prog,link = "$linkmode,$pass"; then - compile_deplibs="$dir/$old_library $compile_deplibs" - finalize_deplibs="$dir/$old_library $finalize_deplibs" - else - deplibs="$lib $deplibs" # used for prog,scan pass - fi - continue - fi - - - if test prog = "$linkmode" && test link != "$pass"; then - func_append newlib_search_path " $ladir" - deplibs="$lib $deplibs" - - linkalldeplibs=false - if test no != "$link_all_deplibs" || test -z "$library_names" || - test no = "$build_libtool_libs"; then - linkalldeplibs=: - fi - - tmp_libs= - for deplib in $dependency_libs; do - case $deplib in - -L*) func_stripname '-L' '' "$deplib" - func_resolve_sysroot "$func_stripname_result" - func_append newlib_search_path " $func_resolve_sysroot_result" - ;; - esac - # Need to link against all dependency_libs? - if $linkalldeplibs; then - deplibs="$deplib $deplibs" - else - # Need to hardcode shared library paths - # or/and link against static libraries - newdependency_libs="$deplib $newdependency_libs" - fi - if $opt_preserve_dup_deps; then - case "$tmp_libs " in - *" $deplib "*) func_append specialdeplibs " $deplib" ;; - esac - fi - func_append tmp_libs " $deplib" - done # for deplib - continue - fi # $linkmode = prog... - - if test prog,link = "$linkmode,$pass"; then - if test -n "$library_names" && - { { test no = "$prefer_static_libs" || - test built,yes = "$prefer_static_libs,$installed"; } || - test -z "$old_library"; }; then - # We need to hardcode the library path - if test -n "$shlibpath_var" && test -z "$avoidtemprpath"; then - # Make sure the rpath contains only unique directories. - case $temp_rpath: in - *"$absdir:"*) ;; - *) func_append temp_rpath "$absdir:" ;; - esac - fi - - # Hardcode the library path. - # Skip directories that are in the system default run-time - # search path. - case " $sys_lib_dlsearch_path " in - *" $absdir "*) ;; - *) - case "$compile_rpath " in - *" $absdir "*) ;; - *) func_append compile_rpath " $absdir" ;; - esac - ;; - esac - case " $sys_lib_dlsearch_path " in - *" $libdir "*) ;; - *) - case "$finalize_rpath " in - *" $libdir "*) ;; - *) func_append finalize_rpath " $libdir" ;; - esac - ;; - esac - fi # $linkmode,$pass = prog,link... - - if $alldeplibs && - { test pass_all = "$deplibs_check_method" || - { test yes = "$build_libtool_libs" && - test -n "$library_names"; }; }; then - # We only need to search for static libraries - continue - fi - fi - - link_static=no # Whether the deplib will be linked statically - use_static_libs=$prefer_static_libs - if test built = "$use_static_libs" && test yes = "$installed"; then - use_static_libs=no - fi - if test -n "$library_names" && - { test no = "$use_static_libs" || test -z "$old_library"; }; then - case $host in - *cygwin* | *mingw* | *cegcc* | *os2*) - # No point in relinking DLLs because paths are not encoded - func_append notinst_deplibs " $lib" - need_relink=no - ;; - *) - if test no = "$installed"; then - func_append notinst_deplibs " $lib" - need_relink=yes - fi - ;; - esac - # This is a shared library - - # Warn about portability, can't link against -module's on some - # systems (darwin). Don't bleat about dlopened modules though! - dlopenmodule= - for dlpremoduletest in $dlprefiles; do - if test "X$dlpremoduletest" = "X$lib"; then - dlopenmodule=$dlpremoduletest - break - fi - done - if test -z "$dlopenmodule" && test yes = "$shouldnotlink" && test link = "$pass"; then - echo - if test prog = "$linkmode"; then - $ECHO "*** Warning: Linking the executable $output against the loadable module" - else - $ECHO "*** Warning: Linking the shared library $output against the loadable module" - fi - $ECHO "*** $linklib is not portable!" - fi - if test lib = "$linkmode" && - test yes = "$hardcode_into_libs"; then - # Hardcode the library path. - # Skip directories that are in the system default run-time - # search path. - case " $sys_lib_dlsearch_path " in - *" $absdir "*) ;; - *) - case "$compile_rpath " in - *" $absdir "*) ;; - *) func_append compile_rpath " $absdir" ;; - esac - ;; - esac - case " $sys_lib_dlsearch_path " in - *" $libdir "*) ;; - *) - case "$finalize_rpath " in - *" $libdir "*) ;; - *) func_append finalize_rpath " $libdir" ;; - esac - ;; - esac - fi - - if test -n "$old_archive_from_expsyms_cmds"; then - # figure out the soname - set dummy $library_names - shift - realname=$1 - shift - libname=`eval "\\$ECHO \"$libname_spec\""` - # use dlname if we got it. it's perfectly good, no? - if test -n "$dlname"; then - soname=$dlname - elif test -n "$soname_spec"; then - # bleh windows - case $host in - *cygwin* | mingw* | *cegcc* | *os2*) - func_arith $current - $age - major=$func_arith_result - versuffix=-$major - ;; - esac - eval soname=\"$soname_spec\" - else - soname=$realname - fi - - # Make a new name for the extract_expsyms_cmds to use - soroot=$soname - func_basename "$soroot" - soname=$func_basename_result - func_stripname 'lib' '.dll' "$soname" - newlib=libimp-$func_stripname_result.a - - # If the library has no export list, then create one now - if test -f "$output_objdir/$soname-def"; then : - else - func_verbose "extracting exported symbol list from '$soname'" - func_execute_cmds "$extract_expsyms_cmds" 'exit $?' - fi - - # Create $newlib - if test -f "$output_objdir/$newlib"; then :; else - func_verbose "generating import library for '$soname'" - func_execute_cmds "$old_archive_from_expsyms_cmds" 'exit $?' - fi - # make sure the library variables are pointing to the new library - dir=$output_objdir - linklib=$newlib - fi # test -n "$old_archive_from_expsyms_cmds" - - if test prog = "$linkmode" || test relink != "$opt_mode"; then - add_shlibpath= - add_dir= - add= - lib_linked=yes - case $hardcode_action in - immediate | unsupported) - if test no = "$hardcode_direct"; then - add=$dir/$linklib - case $host in - *-*-sco3.2v5.0.[024]*) add_dir=-L$dir ;; - *-*-sysv4*uw2*) add_dir=-L$dir ;; - *-*-sysv5OpenUNIX* | *-*-sysv5UnixWare7.[01].[10]* | \ - *-*-unixware7*) add_dir=-L$dir ;; - *-*-darwin* ) - # if the lib is a (non-dlopened) module then we cannot - # link against it, someone is ignoring the earlier warnings - if /usr/bin/file -L $add 2> /dev/null | - $GREP ": [^:]* bundle" >/dev/null; then - if test "X$dlopenmodule" != "X$lib"; then - $ECHO "*** Warning: lib $linklib is a module, not a shared library" - if test -z "$old_library"; then - echo - echo "*** And there doesn't seem to be a static archive available" - echo "*** The link will probably fail, sorry" - else - add=$dir/$old_library - fi - elif test -n "$old_library"; then - add=$dir/$old_library - fi - fi - esac - elif test no = "$hardcode_minus_L"; then - case $host in - *-*-sunos*) add_shlibpath=$dir ;; - esac - add_dir=-L$dir - add=-l$name - elif test no = "$hardcode_shlibpath_var"; then - add_shlibpath=$dir - add=-l$name - else - lib_linked=no - fi - ;; - relink) - if test yes = "$hardcode_direct" && - test no = "$hardcode_direct_absolute"; then - add=$dir/$linklib - elif test yes = "$hardcode_minus_L"; then - add_dir=-L$absdir - # Try looking first in the location we're being installed to. - if test -n "$inst_prefix_dir"; then - case $libdir in - [\\/]*) - func_append add_dir " -L$inst_prefix_dir$libdir" - ;; - esac - fi - add=-l$name - elif test yes = "$hardcode_shlibpath_var"; then - add_shlibpath=$dir - add=-l$name - else - lib_linked=no - fi - ;; - *) lib_linked=no ;; - esac - - if test yes != "$lib_linked"; then - func_fatal_configuration "unsupported hardcode properties" - fi - - if test -n "$add_shlibpath"; then - case :$compile_shlibpath: in - *":$add_shlibpath:"*) ;; - *) func_append compile_shlibpath "$add_shlibpath:" ;; - esac - fi - if test prog = "$linkmode"; then - test -n "$add_dir" && compile_deplibs="$add_dir $compile_deplibs" - test -n "$add" && compile_deplibs="$add $compile_deplibs" - else - test -n "$add_dir" && deplibs="$add_dir $deplibs" - test -n "$add" && deplibs="$add $deplibs" - if test yes != "$hardcode_direct" && - test yes != "$hardcode_minus_L" && - test yes = "$hardcode_shlibpath_var"; then - case :$finalize_shlibpath: in - *":$libdir:"*) ;; - *) func_append finalize_shlibpath "$libdir:" ;; - esac - fi - fi - fi - - if test prog = "$linkmode" || test relink = "$opt_mode"; then - add_shlibpath= - add_dir= - add= - # Finalize command for both is simple: just hardcode it. - if test yes = "$hardcode_direct" && - test no = "$hardcode_direct_absolute"; then - add=$libdir/$linklib - elif test yes = "$hardcode_minus_L"; then - add_dir=-L$libdir - add=-l$name - elif test yes = "$hardcode_shlibpath_var"; then - case :$finalize_shlibpath: in - *":$libdir:"*) ;; - *) func_append finalize_shlibpath "$libdir:" ;; - esac - add=-l$name - elif test yes = "$hardcode_automatic"; then - if test -n "$inst_prefix_dir" && - test -f "$inst_prefix_dir$libdir/$linklib"; then - add=$inst_prefix_dir$libdir/$linklib - else - add=$libdir/$linklib - fi - else - # We cannot seem to hardcode it, guess we'll fake it. - add_dir=-L$libdir - # Try looking first in the location we're being installed to. - if test -n "$inst_prefix_dir"; then - case $libdir in - [\\/]*) - func_append add_dir " -L$inst_prefix_dir$libdir" - ;; - esac - fi - add=-l$name - fi - - if test prog = "$linkmode"; then - test -n "$add_dir" && finalize_deplibs="$add_dir $finalize_deplibs" - test -n "$add" && finalize_deplibs="$add $finalize_deplibs" - else - test -n "$add_dir" && deplibs="$add_dir $deplibs" - test -n "$add" && deplibs="$add $deplibs" - fi - fi - elif test prog = "$linkmode"; then - # Here we assume that one of hardcode_direct or hardcode_minus_L - # is not unsupported. This is valid on all known static and - # shared platforms. - if test unsupported != "$hardcode_direct"; then - test -n "$old_library" && linklib=$old_library - compile_deplibs="$dir/$linklib $compile_deplibs" - finalize_deplibs="$dir/$linklib $finalize_deplibs" - else - compile_deplibs="-l$name -L$dir $compile_deplibs" - finalize_deplibs="-l$name -L$dir $finalize_deplibs" - fi - elif test yes = "$build_libtool_libs"; then - # Not a shared library - if test pass_all != "$deplibs_check_method"; then - # We're trying link a shared library against a static one - # but the system doesn't support it. - - # Just print a warning and add the library to dependency_libs so - # that the program can be linked against the static library. - echo - $ECHO "*** Warning: This system cannot link to static lib archive $lib." - echo "*** I have the capability to make that library automatically link in when" - echo "*** you link to this library. But I can only do this if you have a" - echo "*** shared version of the library, which you do not appear to have." - if test yes = "$module"; then - echo "*** But as you try to build a module library, libtool will still create " - echo "*** a static module, that should work as long as the dlopening application" - echo "*** is linked with the -dlopen flag to resolve symbols at runtime." - if test -z "$global_symbol_pipe"; then - echo - echo "*** However, this would only work if libtool was able to extract symbol" - echo "*** lists from a program, using 'nm' or equivalent, but libtool could" - echo "*** not find such a program. So, this module is probably useless." - echo "*** 'nm' from GNU binutils and a full rebuild may help." - fi - if test no = "$build_old_libs"; then - build_libtool_libs=module - build_old_libs=yes - else - build_libtool_libs=no - fi - fi - else - deplibs="$dir/$old_library $deplibs" - link_static=yes - fi - fi # link shared/static library? - - if test lib = "$linkmode"; then - if test -n "$dependency_libs" && - { test yes != "$hardcode_into_libs" || - test yes = "$build_old_libs" || - test yes = "$link_static"; }; then - # Extract -R from dependency_libs - temp_deplibs= - for libdir in $dependency_libs; do - case $libdir in - -R*) func_stripname '-R' '' "$libdir" - temp_xrpath=$func_stripname_result - case " $xrpath " in - *" $temp_xrpath "*) ;; - *) func_append xrpath " $temp_xrpath";; - esac;; - *) func_append temp_deplibs " $libdir";; - esac - done - dependency_libs=$temp_deplibs - fi - - func_append newlib_search_path " $absdir" - # Link against this library - test no = "$link_static" && newdependency_libs="$abs_ladir/$laname $newdependency_libs" - # ... and its dependency_libs - tmp_libs= - for deplib in $dependency_libs; do - newdependency_libs="$deplib $newdependency_libs" - case $deplib in - -L*) func_stripname '-L' '' "$deplib" - func_resolve_sysroot "$func_stripname_result";; - *) func_resolve_sysroot "$deplib" ;; - esac - if $opt_preserve_dup_deps; then - case "$tmp_libs " in - *" $func_resolve_sysroot_result "*) - func_append specialdeplibs " $func_resolve_sysroot_result" ;; - esac - fi - func_append tmp_libs " $func_resolve_sysroot_result" - done - - if test no != "$link_all_deplibs"; then - # Add the search paths of all dependency libraries - for deplib in $dependency_libs; do - path= - case $deplib in - -L*) path=$deplib ;; - *.la) - func_resolve_sysroot "$deplib" - deplib=$func_resolve_sysroot_result - func_dirname "$deplib" "" "." - dir=$func_dirname_result - # We need an absolute path. - case $dir in - [\\/]* | [A-Za-z]:[\\/]*) absdir=$dir ;; - *) - absdir=`cd "$dir" && pwd` - if test -z "$absdir"; then - func_warning "cannot determine absolute directory name of '$dir'" - absdir=$dir - fi - ;; - esac - if $GREP "^installed=no" $deplib > /dev/null; then - case $host in - *-*-darwin*) - depdepl= - eval deplibrary_names=`$SED -n -e 's/^library_names=\(.*\)$/\1/p' $deplib` - if test -n "$deplibrary_names"; then - for tmp in $deplibrary_names; do - depdepl=$tmp - done - if test -f "$absdir/$objdir/$depdepl"; then - depdepl=$absdir/$objdir/$depdepl - darwin_install_name=`$OTOOL -L $depdepl | awk '{if (NR == 2) {print $1;exit}}'` - if test -z "$darwin_install_name"; then - darwin_install_name=`$OTOOL64 -L $depdepl | awk '{if (NR == 2) {print $1;exit}}'` - fi - func_append compiler_flags " $wl-dylib_file $wl$darwin_install_name:$depdepl" - func_append linker_flags " -dylib_file $darwin_install_name:$depdepl" - path= - fi - fi - ;; - *) - path=-L$absdir/$objdir - ;; - esac - else - eval libdir=`$SED -n -e 's/^libdir=\(.*\)$/\1/p' $deplib` - test -z "$libdir" && \ - func_fatal_error "'$deplib' is not a valid libtool archive" - test "$absdir" != "$libdir" && \ - func_warning "'$deplib' seems to be moved" - - path=-L$absdir - fi - ;; - esac - case " $deplibs " in - *" $path "*) ;; - *) deplibs="$path $deplibs" ;; - esac - done - fi # link_all_deplibs != no - fi # linkmode = lib - done # for deplib in $libs - if test link = "$pass"; then - if test prog = "$linkmode"; then - compile_deplibs="$new_inherited_linker_flags $compile_deplibs" - finalize_deplibs="$new_inherited_linker_flags $finalize_deplibs" - else - compiler_flags="$compiler_flags "`$ECHO " $new_inherited_linker_flags" | $SED 's% \([^ $]*\).ltframework% -framework \1%g'` - fi - fi - dependency_libs=$newdependency_libs - if test dlpreopen = "$pass"; then - # Link the dlpreopened libraries before other libraries - for deplib in $save_deplibs; do - deplibs="$deplib $deplibs" - done - fi - if test dlopen != "$pass"; then - test conv = "$pass" || { - # Make sure lib_search_path contains only unique directories. - lib_search_path= - for dir in $newlib_search_path; do - case "$lib_search_path " in - *" $dir "*) ;; - *) func_append lib_search_path " $dir" ;; - esac - done - newlib_search_path= - } - - if test prog,link = "$linkmode,$pass"; then - vars="compile_deplibs finalize_deplibs" - else - vars=deplibs - fi - for var in $vars dependency_libs; do - # Add libraries to $var in reverse order - eval tmp_libs=\"\$$var\" - new_libs= - for deplib in $tmp_libs; do - # FIXME: Pedantically, this is the right thing to do, so - # that some nasty dependency loop isn't accidentally - # broken: - #new_libs="$deplib $new_libs" - # Pragmatically, this seems to cause very few problems in - # practice: - case $deplib in - -L*) new_libs="$deplib $new_libs" ;; - -R*) ;; - *) - # And here is the reason: when a library appears more - # than once as an explicit dependence of a library, or - # is implicitly linked in more than once by the - # compiler, it is considered special, and multiple - # occurrences thereof are not removed. Compare this - # with having the same library being listed as a - # dependency of multiple other libraries: in this case, - # we know (pedantically, we assume) the library does not - # need to be listed more than once, so we keep only the - # last copy. This is not always right, but it is rare - # enough that we require users that really mean to play - # such unportable linking tricks to link the library - # using -Wl,-lname, so that libtool does not consider it - # for duplicate removal. - case " $specialdeplibs " in - *" $deplib "*) new_libs="$deplib $new_libs" ;; - *) - case " $new_libs " in - *" $deplib "*) ;; - *) new_libs="$deplib $new_libs" ;; - esac - ;; - esac - ;; - esac - done - tmp_libs= - for deplib in $new_libs; do - case $deplib in - -L*) - case " $tmp_libs " in - *" $deplib "*) ;; - *) func_append tmp_libs " $deplib" ;; - esac - ;; - *) func_append tmp_libs " $deplib" ;; - esac - done - eval $var=\"$tmp_libs\" - done # for var - fi - - # Add Sun CC postdeps if required: - test CXX = "$tagname" && { - case $host_os in - linux*) - case `$CC -V 2>&1 | sed 5q` in - *Sun\ C*) # Sun C++ 5.9 - func_suncc_cstd_abi - - if test no != "$suncc_use_cstd_abi"; then - func_append postdeps ' -library=Cstd -library=Crun' - fi - ;; - esac - ;; - - solaris*) - func_cc_basename "$CC" - case $func_cc_basename_result in - CC* | sunCC*) - func_suncc_cstd_abi - - if test no != "$suncc_use_cstd_abi"; then - func_append postdeps ' -library=Cstd -library=Crun' - fi - ;; - esac - ;; - esac - } - - # Last step: remove runtime libs from dependency_libs - # (they stay in deplibs) - tmp_libs= - for i in $dependency_libs; do - case " $predeps $postdeps $compiler_lib_search_path " in - *" $i "*) - i= - ;; - esac - if test -n "$i"; then - func_append tmp_libs " $i" - fi - done - dependency_libs=$tmp_libs - done # for pass - if test prog = "$linkmode"; then - dlfiles=$newdlfiles - fi - if test prog = "$linkmode" || test lib = "$linkmode"; then - dlprefiles=$newdlprefiles - fi - - case $linkmode in - oldlib) - if test -n "$dlfiles$dlprefiles" || test no != "$dlself"; then - func_warning "'-dlopen' is ignored for archives" - fi - - case " $deplibs" in - *\ -l* | *\ -L*) - func_warning "'-l' and '-L' are ignored for archives" ;; - esac - - test -n "$rpath" && \ - func_warning "'-rpath' is ignored for archives" - - test -n "$xrpath" && \ - func_warning "'-R' is ignored for archives" - - test -n "$vinfo" && \ - func_warning "'-version-info/-version-number' is ignored for archives" - - test -n "$release" && \ - func_warning "'-release' is ignored for archives" - - test -n "$export_symbols$export_symbols_regex" && \ - func_warning "'-export-symbols' is ignored for archives" - - # Now set the variables for building old libraries. - build_libtool_libs=no - oldlibs=$output - func_append objs "$old_deplibs" - ;; - - lib) - # Make sure we only generate libraries of the form 'libNAME.la'. - case $outputname in - lib*) - func_stripname 'lib' '.la' "$outputname" - name=$func_stripname_result - eval shared_ext=\"$shrext_cmds\" - eval libname=\"$libname_spec\" - ;; - *) - test no = "$module" \ - && func_fatal_help "libtool library '$output' must begin with 'lib'" - - if test no != "$need_lib_prefix"; then - # Add the "lib" prefix for modules if required - func_stripname '' '.la' "$outputname" - name=$func_stripname_result - eval shared_ext=\"$shrext_cmds\" - eval libname=\"$libname_spec\" - else - func_stripname '' '.la' "$outputname" - libname=$func_stripname_result - fi - ;; - esac - - if test -n "$objs"; then - if test pass_all != "$deplibs_check_method"; then - func_fatal_error "cannot build libtool library '$output' from non-libtool objects on this host:$objs" - else - echo - $ECHO "*** Warning: Linking the shared library $output against the non-libtool" - $ECHO "*** objects $objs is not portable!" - func_append libobjs " $objs" - fi - fi - - test no = "$dlself" \ - || func_warning "'-dlopen self' is ignored for libtool libraries" - - set dummy $rpath - shift - test 1 -lt "$#" \ - && func_warning "ignoring multiple '-rpath's for a libtool library" - - install_libdir=$1 - - oldlibs= - if test -z "$rpath"; then - if test yes = "$build_libtool_libs"; then - # Building a libtool convenience library. - # Some compilers have problems with a '.al' extension so - # convenience libraries should have the same extension an - # archive normally would. - oldlibs="$output_objdir/$libname.$libext $oldlibs" - build_libtool_libs=convenience - build_old_libs=yes - fi - - test -n "$vinfo" && \ - func_warning "'-version-info/-version-number' is ignored for convenience libraries" - - test -n "$release" && \ - func_warning "'-release' is ignored for convenience libraries" - else - - # Parse the version information argument. - save_ifs=$IFS; IFS=: - set dummy $vinfo 0 0 0 - shift - IFS=$save_ifs - - test -n "$7" && \ - func_fatal_help "too many parameters to '-version-info'" - - # convert absolute version numbers to libtool ages - # this retains compatibility with .la files and attempts - # to make the code below a bit more comprehensible - - case $vinfo_number in - yes) - number_major=$1 - number_minor=$2 - number_revision=$3 - # - # There are really only two kinds -- those that - # use the current revision as the major version - # and those that subtract age and use age as - # a minor version. But, then there is irix - # that has an extra 1 added just for fun - # - case $version_type in - # correct linux to gnu/linux during the next big refactor - darwin|freebsd-elf|linux|osf|windows|none) - func_arith $number_major + $number_minor - current=$func_arith_result - age=$number_minor - revision=$number_revision - ;; - freebsd-aout|qnx|sunos) - current=$number_major - revision=$number_minor - age=0 - ;; - irix|nonstopux) - func_arith $number_major + $number_minor - current=$func_arith_result - age=$number_minor - revision=$number_minor - lt_irix_increment=no - ;; - esac - ;; - no) - current=$1 - revision=$2 - age=$3 - ;; - esac - - # Check that each of the things are valid numbers. - case $current in - 0|[1-9]|[1-9][0-9]|[1-9][0-9][0-9]|[1-9][0-9][0-9][0-9]|[1-9][0-9][0-9][0-9][0-9]) ;; - *) - func_error "CURRENT '$current' must be a nonnegative integer" - func_fatal_error "'$vinfo' is not valid version information" - ;; - esac - - case $revision in - 0|[1-9]|[1-9][0-9]|[1-9][0-9][0-9]|[1-9][0-9][0-9][0-9]|[1-9][0-9][0-9][0-9][0-9]) ;; - *) - func_error "REVISION '$revision' must be a nonnegative integer" - func_fatal_error "'$vinfo' is not valid version information" - ;; - esac - - case $age in - 0|[1-9]|[1-9][0-9]|[1-9][0-9][0-9]|[1-9][0-9][0-9][0-9]|[1-9][0-9][0-9][0-9][0-9]) ;; - *) - func_error "AGE '$age' must be a nonnegative integer" - func_fatal_error "'$vinfo' is not valid version information" - ;; - esac - - if test "$age" -gt "$current"; then - func_error "AGE '$age' is greater than the current interface number '$current'" - func_fatal_error "'$vinfo' is not valid version information" - fi - - # Calculate the version variables. - major= - versuffix= - verstring= - case $version_type in - none) ;; - - darwin) - # Like Linux, but with the current version available in - # verstring for coding it into the library header - func_arith $current - $age - major=.$func_arith_result - versuffix=$major.$age.$revision - # Darwin ld doesn't like 0 for these options... - func_arith $current + 1 - minor_current=$func_arith_result - xlcverstring="$wl-compatibility_version $wl$minor_current $wl-current_version $wl$minor_current.$revision" - verstring="-compatibility_version $minor_current -current_version $minor_current.$revision" - # On Darwin other compilers - case $CC in - nagfor*) - verstring="$wl-compatibility_version $wl$minor_current $wl-current_version $wl$minor_current.$revision" - ;; - *) - verstring="-compatibility_version $minor_current -current_version $minor_current.$revision" - ;; - esac - ;; - - freebsd-aout) - major=.$current - versuffix=.$current.$revision - ;; - - freebsd-elf) - func_arith $current - $age - major=.$func_arith_result - versuffix=$major.$age.$revision - ;; - - irix | nonstopux) - if test no = "$lt_irix_increment"; then - func_arith $current - $age - else - func_arith $current - $age + 1 - fi - major=$func_arith_result - - case $version_type in - nonstopux) verstring_prefix=nonstopux ;; - *) verstring_prefix=sgi ;; - esac - verstring=$verstring_prefix$major.$revision - - # Add in all the interfaces that we are compatible with. - loop=$revision - while test 0 -ne "$loop"; do - func_arith $revision - $loop - iface=$func_arith_result - func_arith $loop - 1 - loop=$func_arith_result - verstring=$verstring_prefix$major.$iface:$verstring - done - - # Before this point, $major must not contain '.'. - major=.$major - versuffix=$major.$revision - ;; - - linux) # correct to gnu/linux during the next big refactor - func_arith $current - $age - major=.$func_arith_result - versuffix=$major.$age.$revision - ;; - - osf) - func_arith $current - $age - major=.$func_arith_result - versuffix=.$current.$age.$revision - verstring=$current.$age.$revision - - # Add in all the interfaces that we are compatible with. - loop=$age - while test 0 -ne "$loop"; do - func_arith $current - $loop - iface=$func_arith_result - func_arith $loop - 1 - loop=$func_arith_result - verstring=$verstring:$iface.0 - done - - # Make executables depend on our current version. - func_append verstring ":$current.0" - ;; - - qnx) - major=.$current - versuffix=.$current - ;; - - sco) - major=.$current - versuffix=.$current - ;; - - sunos) - major=.$current - versuffix=.$current.$revision - ;; - - windows) - # Use '-' rather than '.', since we only want one - # extension on DOS 8.3 file systems. - func_arith $current - $age - major=$func_arith_result - versuffix=-$major - ;; - - *) - func_fatal_configuration "unknown library version type '$version_type'" - ;; - esac - - # Clear the version info if we defaulted, and they specified a release. - if test -z "$vinfo" && test -n "$release"; then - major= - case $version_type in - darwin) - # we can't check for "0.0" in archive_cmds due to quoting - # problems, so we reset it completely - verstring= - ;; - *) - verstring=0.0 - ;; - esac - if test no = "$need_version"; then - versuffix= - else - versuffix=.0.0 - fi - fi - - # Remove version info from name if versioning should be avoided - if test yes,no = "$avoid_version,$need_version"; then - major= - versuffix= - verstring= - fi - - # Check to see if the archive will have undefined symbols. - if test yes = "$allow_undefined"; then - if test unsupported = "$allow_undefined_flag"; then - if test yes = "$build_old_libs"; then - func_warning "undefined symbols not allowed in $host shared libraries; building static only" - build_libtool_libs=no - else - func_fatal_error "can't build $host shared library unless -no-undefined is specified" - fi - fi - else - # Don't allow undefined symbols. - allow_undefined_flag=$no_undefined_flag - fi - - fi - - func_generate_dlsyms "$libname" "$libname" : - func_append libobjs " $symfileobj" - test " " = "$libobjs" && libobjs= - - if test relink != "$opt_mode"; then - # Remove our outputs, but don't remove object files since they - # may have been created when compiling PIC objects. - removelist= - tempremovelist=`$ECHO "$output_objdir/*"` - for p in $tempremovelist; do - case $p in - *.$objext | *.gcno) - ;; - $output_objdir/$outputname | $output_objdir/$libname.* | $output_objdir/$libname$release.*) - if test -n "$precious_files_regex"; then - if $ECHO "$p" | $EGREP -e "$precious_files_regex" >/dev/null 2>&1 - then - continue - fi - fi - func_append removelist " $p" - ;; - *) ;; - esac - done - test -n "$removelist" && \ - func_show_eval "${RM}r \$removelist" - fi - - # Now set the variables for building old libraries. - if test yes = "$build_old_libs" && test convenience != "$build_libtool_libs"; then - func_append oldlibs " $output_objdir/$libname.$libext" - - # Transform .lo files to .o files. - oldobjs="$objs "`$ECHO "$libobjs" | $SP2NL | $SED "/\.$libext$/d; $lo2o" | $NL2SP` - fi - - # Eliminate all temporary directories. - #for path in $notinst_path; do - # lib_search_path=`$ECHO "$lib_search_path " | $SED "s% $path % %g"` - # deplibs=`$ECHO "$deplibs " | $SED "s% -L$path % %g"` - # dependency_libs=`$ECHO "$dependency_libs " | $SED "s% -L$path % %g"` - #done - - if test -n "$xrpath"; then - # If the user specified any rpath flags, then add them. - temp_xrpath= - for libdir in $xrpath; do - func_replace_sysroot "$libdir" - func_append temp_xrpath " -R$func_replace_sysroot_result" - case "$finalize_rpath " in - *" $libdir "*) ;; - *) func_append finalize_rpath " $libdir" ;; - esac - done - if test yes != "$hardcode_into_libs" || test yes = "$build_old_libs"; then - dependency_libs="$temp_xrpath $dependency_libs" - fi - fi - - # Make sure dlfiles contains only unique files that won't be dlpreopened - old_dlfiles=$dlfiles - dlfiles= - for lib in $old_dlfiles; do - case " $dlprefiles $dlfiles " in - *" $lib "*) ;; - *) func_append dlfiles " $lib" ;; - esac - done - - # Make sure dlprefiles contains only unique files - old_dlprefiles=$dlprefiles - dlprefiles= - for lib in $old_dlprefiles; do - case "$dlprefiles " in - *" $lib "*) ;; - *) func_append dlprefiles " $lib" ;; - esac - done - - if test yes = "$build_libtool_libs"; then - if test -n "$rpath"; then - case $host in - *-*-cygwin* | *-*-mingw* | *-*-pw32* | *-*-os2* | *-*-beos* | *-cegcc* | *-*-haiku*) - # these systems don't actually have a c library (as such)! - ;; - *-*-rhapsody* | *-*-darwin1.[012]) - # Rhapsody C library is in the System framework - func_append deplibs " System.ltframework" - ;; - *-*-netbsd*) - # Don't link with libc until the a.out ld.so is fixed. - ;; - *-*-openbsd* | *-*-freebsd* | *-*-dragonfly*) - # Do not include libc due to us having libc/libc_r. - ;; - *-*-sco3.2v5* | *-*-sco5v6*) - # Causes problems with __ctype - ;; - *-*-sysv4.2uw2* | *-*-sysv5* | *-*-unixware* | *-*-OpenUNIX*) - # Compiler inserts libc in the correct place for threads to work - ;; - *) - # Add libc to deplibs on all other systems if necessary. - if test yes = "$build_libtool_need_lc"; then - func_append deplibs " -lc" - fi - ;; - esac - fi - - # Transform deplibs into only deplibs that can be linked in shared. - name_save=$name - libname_save=$libname - release_save=$release - versuffix_save=$versuffix - major_save=$major - # I'm not sure if I'm treating the release correctly. I think - # release should show up in the -l (ie -lgmp5) so we don't want to - # add it in twice. Is that correct? - release= - versuffix= - major= - newdeplibs= - droppeddeps=no - case $deplibs_check_method in - pass_all) - # Don't check for shared/static. Everything works. - # This might be a little naive. We might want to check - # whether the library exists or not. But this is on - # osf3 & osf4 and I'm not really sure... Just - # implementing what was already the behavior. - newdeplibs=$deplibs - ;; - test_compile) - # This code stresses the "libraries are programs" paradigm to its - # limits. Maybe even breaks it. We compile a program, linking it - # against the deplibs as a proxy for the library. Then we can check - # whether they linked in statically or dynamically with ldd. - $opt_dry_run || $RM conftest.c - cat > conftest.c </dev/null` - $nocaseglob - else - potential_libs=`ls $i/$libnameglob[.-]* 2>/dev/null` - fi - for potent_lib in $potential_libs; do - # Follow soft links. - if ls -lLd "$potent_lib" 2>/dev/null | - $GREP " -> " >/dev/null; then - continue - fi - # The statement above tries to avoid entering an - # endless loop below, in case of cyclic links. - # We might still enter an endless loop, since a link - # loop can be closed while we follow links, - # but so what? - potlib=$potent_lib - while test -h "$potlib" 2>/dev/null; do - potliblink=`ls -ld $potlib | $SED 's/.* -> //'` - case $potliblink in - [\\/]* | [A-Za-z]:[\\/]*) potlib=$potliblink;; - *) potlib=`$ECHO "$potlib" | $SED 's|[^/]*$||'`"$potliblink";; - esac - done - if eval $file_magic_cmd \"\$potlib\" 2>/dev/null | - $SED -e 10q | - $EGREP "$file_magic_regex" > /dev/null; then - func_append newdeplibs " $a_deplib" - a_deplib= - break 2 - fi - done - done - fi - if test -n "$a_deplib"; then - droppeddeps=yes - echo - $ECHO "*** Warning: linker path does not have real file for library $a_deplib." - echo "*** I have the capability to make that library automatically link in when" - echo "*** you link to this library. But I can only do this if you have a" - echo "*** shared version of the library, which you do not appear to have" - echo "*** because I did check the linker path looking for a file starting" - if test -z "$potlib"; then - $ECHO "*** with $libname but no candidates were found. (...for file magic test)" - else - $ECHO "*** with $libname and none of the candidates passed a file format test" - $ECHO "*** using a file magic. Last file checked: $potlib" - fi - fi - ;; - *) - # Add a -L argument. - func_append newdeplibs " $a_deplib" - ;; - esac - done # Gone through all deplibs. - ;; - match_pattern*) - set dummy $deplibs_check_method; shift - match_pattern_regex=`expr "$deplibs_check_method" : "$1 \(.*\)"` - for a_deplib in $deplibs; do - case $a_deplib in - -l*) - func_stripname -l '' "$a_deplib" - name=$func_stripname_result - if test yes = "$allow_libtool_libs_with_static_runtimes"; then - case " $predeps $postdeps " in - *" $a_deplib "*) - func_append newdeplibs " $a_deplib" - a_deplib= - ;; - esac - fi - if test -n "$a_deplib"; then - libname=`eval "\\$ECHO \"$libname_spec\""` - for i in $lib_search_path $sys_lib_search_path $shlib_search_path; do - potential_libs=`ls $i/$libname[.-]* 2>/dev/null` - for potent_lib in $potential_libs; do - potlib=$potent_lib # see symlink-check above in file_magic test - if eval "\$ECHO \"$potent_lib\"" 2>/dev/null | $SED 10q | \ - $EGREP "$match_pattern_regex" > /dev/null; then - func_append newdeplibs " $a_deplib" - a_deplib= - break 2 - fi - done - done - fi - if test -n "$a_deplib"; then - droppeddeps=yes - echo - $ECHO "*** Warning: linker path does not have real file for library $a_deplib." - echo "*** I have the capability to make that library automatically link in when" - echo "*** you link to this library. But I can only do this if you have a" - echo "*** shared version of the library, which you do not appear to have" - echo "*** because I did check the linker path looking for a file starting" - if test -z "$potlib"; then - $ECHO "*** with $libname but no candidates were found. (...for regex pattern test)" - else - $ECHO "*** with $libname and none of the candidates passed a file format test" - $ECHO "*** using a regex pattern. Last file checked: $potlib" - fi - fi - ;; - *) - # Add a -L argument. - func_append newdeplibs " $a_deplib" - ;; - esac - done # Gone through all deplibs. - ;; - none | unknown | *) - newdeplibs= - tmp_deplibs=`$ECHO " $deplibs" | $SED 's/ -lc$//; s/ -[LR][^ ]*//g'` - if test yes = "$allow_libtool_libs_with_static_runtimes"; then - for i in $predeps $postdeps; do - # can't use Xsed below, because $i might contain '/' - tmp_deplibs=`$ECHO " $tmp_deplibs" | $SED "s|$i||"` - done - fi - case $tmp_deplibs in - *[!\ \ ]*) - echo - if test none = "$deplibs_check_method"; then - echo "*** Warning: inter-library dependencies are not supported in this platform." - else - echo "*** Warning: inter-library dependencies are not known to be supported." - fi - echo "*** All declared inter-library dependencies are being dropped." - droppeddeps=yes - ;; - esac - ;; - esac - versuffix=$versuffix_save - major=$major_save - release=$release_save - libname=$libname_save - name=$name_save - - case $host in - *-*-rhapsody* | *-*-darwin1.[012]) - # On Rhapsody replace the C library with the System framework - newdeplibs=`$ECHO " $newdeplibs" | $SED 's/ -lc / System.ltframework /'` - ;; - esac - - if test yes = "$droppeddeps"; then - if test yes = "$module"; then - echo - echo "*** Warning: libtool could not satisfy all declared inter-library" - $ECHO "*** dependencies of module $libname. Therefore, libtool will create" - echo "*** a static module, that should work as long as the dlopening" - echo "*** application is linked with the -dlopen flag." - if test -z "$global_symbol_pipe"; then - echo - echo "*** However, this would only work if libtool was able to extract symbol" - echo "*** lists from a program, using 'nm' or equivalent, but libtool could" - echo "*** not find such a program. So, this module is probably useless." - echo "*** 'nm' from GNU binutils and a full rebuild may help." - fi - if test no = "$build_old_libs"; then - oldlibs=$output_objdir/$libname.$libext - build_libtool_libs=module - build_old_libs=yes - else - build_libtool_libs=no - fi - else - echo "*** The inter-library dependencies that have been dropped here will be" - echo "*** automatically added whenever a program is linked with this library" - echo "*** or is declared to -dlopen it." - - if test no = "$allow_undefined"; then - echo - echo "*** Since this library must not contain undefined symbols," - echo "*** because either the platform does not support them or" - echo "*** it was explicitly requested with -no-undefined," - echo "*** libtool will only create a static version of it." - if test no = "$build_old_libs"; then - oldlibs=$output_objdir/$libname.$libext - build_libtool_libs=module - build_old_libs=yes - else - build_libtool_libs=no - fi - fi - fi - fi - # Done checking deplibs! - deplibs=$newdeplibs - fi - # Time to change all our "foo.ltframework" stuff back to "-framework foo" - case $host in - *-*-darwin*) - newdeplibs=`$ECHO " $newdeplibs" | $SED 's% \([^ $]*\).ltframework% -framework \1%g'` - new_inherited_linker_flags=`$ECHO " $new_inherited_linker_flags" | $SED 's% \([^ $]*\).ltframework% -framework \1%g'` - deplibs=`$ECHO " $deplibs" | $SED 's% \([^ $]*\).ltframework% -framework \1%g'` - ;; - esac - - # move library search paths that coincide with paths to not yet - # installed libraries to the beginning of the library search list - new_libs= - for path in $notinst_path; do - case " $new_libs " in - *" -L$path/$objdir "*) ;; - *) - case " $deplibs " in - *" -L$path/$objdir "*) - func_append new_libs " -L$path/$objdir" ;; - esac - ;; - esac - done - for deplib in $deplibs; do - case $deplib in - -L*) - case " $new_libs " in - *" $deplib "*) ;; - *) func_append new_libs " $deplib" ;; - esac - ;; - *) func_append new_libs " $deplib" ;; - esac - done - deplibs=$new_libs - - # All the library-specific variables (install_libdir is set above). - library_names= - old_library= - dlname= - - # Test again, we may have decided not to build it any more - if test yes = "$build_libtool_libs"; then - # Remove $wl instances when linking with ld. - # FIXME: should test the right _cmds variable. - case $archive_cmds in - *\$LD\ *) wl= ;; - esac - if test yes = "$hardcode_into_libs"; then - # Hardcode the library paths - hardcode_libdirs= - dep_rpath= - rpath=$finalize_rpath - test relink = "$opt_mode" || rpath=$compile_rpath$rpath - for libdir in $rpath; do - if test -n "$hardcode_libdir_flag_spec"; then - if test -n "$hardcode_libdir_separator"; then - func_replace_sysroot "$libdir" - libdir=$func_replace_sysroot_result - if test -z "$hardcode_libdirs"; then - hardcode_libdirs=$libdir - else - # Just accumulate the unique libdirs. - case $hardcode_libdir_separator$hardcode_libdirs$hardcode_libdir_separator in - *"$hardcode_libdir_separator$libdir$hardcode_libdir_separator"*) - ;; - *) - func_append hardcode_libdirs "$hardcode_libdir_separator$libdir" - ;; - esac - fi - else - eval flag=\"$hardcode_libdir_flag_spec\" - func_append dep_rpath " $flag" - fi - elif test -n "$runpath_var"; then - case "$perm_rpath " in - *" $libdir "*) ;; - *) func_append perm_rpath " $libdir" ;; - esac - fi - done - # Substitute the hardcoded libdirs into the rpath. - if test -n "$hardcode_libdir_separator" && - test -n "$hardcode_libdirs"; then - libdir=$hardcode_libdirs - eval "dep_rpath=\"$hardcode_libdir_flag_spec\"" - fi - if test -n "$runpath_var" && test -n "$perm_rpath"; then - # We should set the runpath_var. - rpath= - for dir in $perm_rpath; do - func_append rpath "$dir:" - done - eval "$runpath_var='$rpath\$$runpath_var'; export $runpath_var" - fi - test -n "$dep_rpath" && deplibs="$dep_rpath $deplibs" - fi - - shlibpath=$finalize_shlibpath - test relink = "$opt_mode" || shlibpath=$compile_shlibpath$shlibpath - if test -n "$shlibpath"; then - eval "$shlibpath_var='$shlibpath\$$shlibpath_var'; export $shlibpath_var" - fi - - # Get the real and link names of the library. - eval shared_ext=\"$shrext_cmds\" - eval library_names=\"$library_names_spec\" - set dummy $library_names - shift - realname=$1 - shift - - if test -n "$soname_spec"; then - eval soname=\"$soname_spec\" - else - soname=$realname - fi - if test -z "$dlname"; then - dlname=$soname - fi - - lib=$output_objdir/$realname - linknames= - for link - do - func_append linknames " $link" - done - - # Use standard objects if they are pic - test -z "$pic_flag" && libobjs=`$ECHO "$libobjs" | $SP2NL | $SED "$lo2o" | $NL2SP` - test "X$libobjs" = "X " && libobjs= - - delfiles= - if test -n "$export_symbols" && test -n "$include_expsyms"; then - $opt_dry_run || cp "$export_symbols" "$output_objdir/$libname.uexp" - export_symbols=$output_objdir/$libname.uexp - func_append delfiles " $export_symbols" - fi - - orig_export_symbols= - case $host_os in - cygwin* | mingw* | cegcc*) - if test -n "$export_symbols" && test -z "$export_symbols_regex"; then - # exporting using user supplied symfile - func_dll_def_p "$export_symbols" || { - # and it's NOT already a .def file. Must figure out - # which of the given symbols are data symbols and tag - # them as such. So, trigger use of export_symbols_cmds. - # export_symbols gets reassigned inside the "prepare - # the list of exported symbols" if statement, so the - # include_expsyms logic still works. - orig_export_symbols=$export_symbols - export_symbols= - always_export_symbols=yes - } - fi - ;; - esac - - # Prepare the list of exported symbols - if test -z "$export_symbols"; then - if test yes = "$always_export_symbols" || test -n "$export_symbols_regex"; then - func_verbose "generating symbol list for '$libname.la'" - export_symbols=$output_objdir/$libname.exp - $opt_dry_run || $RM $export_symbols - cmds=$export_symbols_cmds - save_ifs=$IFS; IFS='~' - for cmd1 in $cmds; do - IFS=$save_ifs - # Take the normal branch if the nm_file_list_spec branch - # doesn't work or if tool conversion is not needed. - case $nm_file_list_spec~$to_tool_file_cmd in - *~func_convert_file_noop | *~func_convert_file_msys_to_w32 | ~*) - try_normal_branch=yes - eval cmd=\"$cmd1\" - func_len " $cmd" - len=$func_len_result - ;; - *) - try_normal_branch=no - ;; - esac - if test yes = "$try_normal_branch" \ - && { test "$len" -lt "$max_cmd_len" \ - || test "$max_cmd_len" -le -1; } - then - func_show_eval "$cmd" 'exit $?' - skipped_export=false - elif test -n "$nm_file_list_spec"; then - func_basename "$output" - output_la=$func_basename_result - save_libobjs=$libobjs - save_output=$output - output=$output_objdir/$output_la.nm - func_to_tool_file "$output" - libobjs=$nm_file_list_spec$func_to_tool_file_result - func_append delfiles " $output" - func_verbose "creating $NM input file list: $output" - for obj in $save_libobjs; do - func_to_tool_file "$obj" - $ECHO "$func_to_tool_file_result" - done > "$output" - eval cmd=\"$cmd1\" - func_show_eval "$cmd" 'exit $?' - output=$save_output - libobjs=$save_libobjs - skipped_export=false - else - # The command line is too long to execute in one step. - func_verbose "using reloadable object file for export list..." - skipped_export=: - # Break out early, otherwise skipped_export may be - # set to false by a later but shorter cmd. - break - fi - done - IFS=$save_ifs - if test -n "$export_symbols_regex" && test : != "$skipped_export"; then - func_show_eval '$EGREP -e "$export_symbols_regex" "$export_symbols" > "${export_symbols}T"' - func_show_eval '$MV "${export_symbols}T" "$export_symbols"' - fi - fi - fi - - if test -n "$export_symbols" && test -n "$include_expsyms"; then - tmp_export_symbols=$export_symbols - test -n "$orig_export_symbols" && tmp_export_symbols=$orig_export_symbols - $opt_dry_run || eval '$ECHO "$include_expsyms" | $SP2NL >> "$tmp_export_symbols"' - fi - - if test : != "$skipped_export" && test -n "$orig_export_symbols"; then - # The given exports_symbols file has to be filtered, so filter it. - func_verbose "filter symbol list for '$libname.la' to tag DATA exports" - # FIXME: $output_objdir/$libname.filter potentially contains lots of - # 's' commands, which not all seds can handle. GNU sed should be fine - # though. Also, the filter scales superlinearly with the number of - # global variables. join(1) would be nice here, but unfortunately - # isn't a blessed tool. - $opt_dry_run || $SED -e '/[ ,]DATA/!d;s,\(.*\)\([ \,].*\),s|^\1$|\1\2|,' < $export_symbols > $output_objdir/$libname.filter - func_append delfiles " $export_symbols $output_objdir/$libname.filter" - export_symbols=$output_objdir/$libname.def - $opt_dry_run || $SED -f $output_objdir/$libname.filter < $orig_export_symbols > $export_symbols - fi - - tmp_deplibs= - for test_deplib in $deplibs; do - case " $convenience " in - *" $test_deplib "*) ;; - *) - func_append tmp_deplibs " $test_deplib" - ;; - esac - done - deplibs=$tmp_deplibs - - if test -n "$convenience"; then - if test -n "$whole_archive_flag_spec" && - test yes = "$compiler_needs_object" && - test -z "$libobjs"; then - # extract the archives, so we have objects to list. - # TODO: could optimize this to just extract one archive. - whole_archive_flag_spec= - fi - if test -n "$whole_archive_flag_spec"; then - save_libobjs=$libobjs - eval libobjs=\"\$libobjs $whole_archive_flag_spec\" - test "X$libobjs" = "X " && libobjs= - else - gentop=$output_objdir/${outputname}x - func_append generated " $gentop" - - func_extract_archives $gentop $convenience - func_append libobjs " $func_extract_archives_result" - test "X$libobjs" = "X " && libobjs= - fi - fi - - if test yes = "$thread_safe" && test -n "$thread_safe_flag_spec"; then - eval flag=\"$thread_safe_flag_spec\" - func_append linker_flags " $flag" - fi - - # Make a backup of the uninstalled library when relinking - if test relink = "$opt_mode"; then - $opt_dry_run || eval '(cd $output_objdir && $RM ${realname}U && $MV $realname ${realname}U)' || exit $? - fi - - # Do each of the archive commands. - if test yes = "$module" && test -n "$module_cmds"; then - if test -n "$export_symbols" && test -n "$module_expsym_cmds"; then - eval test_cmds=\"$module_expsym_cmds\" - cmds=$module_expsym_cmds - else - eval test_cmds=\"$module_cmds\" - cmds=$module_cmds - fi - else - if test -n "$export_symbols" && test -n "$archive_expsym_cmds"; then - eval test_cmds=\"$archive_expsym_cmds\" - cmds=$archive_expsym_cmds - else - eval test_cmds=\"$archive_cmds\" - cmds=$archive_cmds - fi - fi - - if test : != "$skipped_export" && - func_len " $test_cmds" && - len=$func_len_result && - test "$len" -lt "$max_cmd_len" || test "$max_cmd_len" -le -1; then - : - else - # The command line is too long to link in one step, link piecewise - # or, if using GNU ld and skipped_export is not :, use a linker - # script. - - # Save the value of $output and $libobjs because we want to - # use them later. If we have whole_archive_flag_spec, we - # want to use save_libobjs as it was before - # whole_archive_flag_spec was expanded, because we can't - # assume the linker understands whole_archive_flag_spec. - # This may have to be revisited, in case too many - # convenience libraries get linked in and end up exceeding - # the spec. - if test -z "$convenience" || test -z "$whole_archive_flag_spec"; then - save_libobjs=$libobjs - fi - save_output=$output - func_basename "$output" - output_la=$func_basename_result - - # Clear the reloadable object creation command queue and - # initialize k to one. - test_cmds= - concat_cmds= - objlist= - last_robj= - k=1 - - if test -n "$save_libobjs" && test : != "$skipped_export" && test yes = "$with_gnu_ld"; then - output=$output_objdir/$output_la.lnkscript - func_verbose "creating GNU ld script: $output" - echo 'INPUT (' > $output - for obj in $save_libobjs - do - func_to_tool_file "$obj" - $ECHO "$func_to_tool_file_result" >> $output - done - echo ')' >> $output - func_append delfiles " $output" - func_to_tool_file "$output" - output=$func_to_tool_file_result - elif test -n "$save_libobjs" && test : != "$skipped_export" && test -n "$file_list_spec"; then - output=$output_objdir/$output_la.lnk - func_verbose "creating linker input file list: $output" - : > $output - set x $save_libobjs - shift - firstobj= - if test yes = "$compiler_needs_object"; then - firstobj="$1 " - shift - fi - for obj - do - func_to_tool_file "$obj" - $ECHO "$func_to_tool_file_result" >> $output - done - func_append delfiles " $output" - func_to_tool_file "$output" - output=$firstobj\"$file_list_spec$func_to_tool_file_result\" - else - if test -n "$save_libobjs"; then - func_verbose "creating reloadable object files..." - output=$output_objdir/$output_la-$k.$objext - eval test_cmds=\"$reload_cmds\" - func_len " $test_cmds" - len0=$func_len_result - len=$len0 - - # Loop over the list of objects to be linked. - for obj in $save_libobjs - do - func_len " $obj" - func_arith $len + $func_len_result - len=$func_arith_result - if test -z "$objlist" || - test "$len" -lt "$max_cmd_len"; then - func_append objlist " $obj" - else - # The command $test_cmds is almost too long, add a - # command to the queue. - if test 1 -eq "$k"; then - # The first file doesn't have a previous command to add. - reload_objs=$objlist - eval concat_cmds=\"$reload_cmds\" - else - # All subsequent reloadable object files will link in - # the last one created. - reload_objs="$objlist $last_robj" - eval concat_cmds=\"\$concat_cmds~$reload_cmds~\$RM $last_robj\" - fi - last_robj=$output_objdir/$output_la-$k.$objext - func_arith $k + 1 - k=$func_arith_result - output=$output_objdir/$output_la-$k.$objext - objlist=" $obj" - func_len " $last_robj" - func_arith $len0 + $func_len_result - len=$func_arith_result - fi - done - # Handle the remaining objects by creating one last - # reloadable object file. All subsequent reloadable object - # files will link in the last one created. - test -z "$concat_cmds" || concat_cmds=$concat_cmds~ - reload_objs="$objlist $last_robj" - eval concat_cmds=\"\$concat_cmds$reload_cmds\" - if test -n "$last_robj"; then - eval concat_cmds=\"\$concat_cmds~\$RM $last_robj\" - fi - func_append delfiles " $output" - - else - output= - fi - - ${skipped_export-false} && { - func_verbose "generating symbol list for '$libname.la'" - export_symbols=$output_objdir/$libname.exp - $opt_dry_run || $RM $export_symbols - libobjs=$output - # Append the command to create the export file. - test -z "$concat_cmds" || concat_cmds=$concat_cmds~ - eval concat_cmds=\"\$concat_cmds$export_symbols_cmds\" - if test -n "$last_robj"; then - eval concat_cmds=\"\$concat_cmds~\$RM $last_robj\" - fi - } - - test -n "$save_libobjs" && - func_verbose "creating a temporary reloadable object file: $output" - - # Loop through the commands generated above and execute them. - save_ifs=$IFS; IFS='~' - for cmd in $concat_cmds; do - IFS=$save_ifs - $opt_quiet || { - func_quote_for_expand "$cmd" - eval "func_echo $func_quote_for_expand_result" - } - $opt_dry_run || eval "$cmd" || { - lt_exit=$? - - # Restore the uninstalled library and exit - if test relink = "$opt_mode"; then - ( cd "$output_objdir" && \ - $RM "${realname}T" && \ - $MV "${realname}U" "$realname" ) - fi - - exit $lt_exit - } - done - IFS=$save_ifs - - if test -n "$export_symbols_regex" && ${skipped_export-false}; then - func_show_eval '$EGREP -e "$export_symbols_regex" "$export_symbols" > "${export_symbols}T"' - func_show_eval '$MV "${export_symbols}T" "$export_symbols"' - fi - fi - - ${skipped_export-false} && { - if test -n "$export_symbols" && test -n "$include_expsyms"; then - tmp_export_symbols=$export_symbols - test -n "$orig_export_symbols" && tmp_export_symbols=$orig_export_symbols - $opt_dry_run || eval '$ECHO "$include_expsyms" | $SP2NL >> "$tmp_export_symbols"' - fi - - if test -n "$orig_export_symbols"; then - # The given exports_symbols file has to be filtered, so filter it. - func_verbose "filter symbol list for '$libname.la' to tag DATA exports" - # FIXME: $output_objdir/$libname.filter potentially contains lots of - # 's' commands, which not all seds can handle. GNU sed should be fine - # though. Also, the filter scales superlinearly with the number of - # global variables. join(1) would be nice here, but unfortunately - # isn't a blessed tool. - $opt_dry_run || $SED -e '/[ ,]DATA/!d;s,\(.*\)\([ \,].*\),s|^\1$|\1\2|,' < $export_symbols > $output_objdir/$libname.filter - func_append delfiles " $export_symbols $output_objdir/$libname.filter" - export_symbols=$output_objdir/$libname.def - $opt_dry_run || $SED -f $output_objdir/$libname.filter < $orig_export_symbols > $export_symbols - fi - } - - libobjs=$output - # Restore the value of output. - output=$save_output - - if test -n "$convenience" && test -n "$whole_archive_flag_spec"; then - eval libobjs=\"\$libobjs $whole_archive_flag_spec\" - test "X$libobjs" = "X " && libobjs= - fi - # Expand the library linking commands again to reset the - # value of $libobjs for piecewise linking. - - # Do each of the archive commands. - if test yes = "$module" && test -n "$module_cmds"; then - if test -n "$export_symbols" && test -n "$module_expsym_cmds"; then - cmds=$module_expsym_cmds - else - cmds=$module_cmds - fi - else - if test -n "$export_symbols" && test -n "$archive_expsym_cmds"; then - cmds=$archive_expsym_cmds - else - cmds=$archive_cmds - fi - fi - fi - - if test -n "$delfiles"; then - # Append the command to remove temporary files to $cmds. - eval cmds=\"\$cmds~\$RM $delfiles\" - fi - - # Add any objects from preloaded convenience libraries - if test -n "$dlprefiles"; then - gentop=$output_objdir/${outputname}x - func_append generated " $gentop" - - func_extract_archives $gentop $dlprefiles - func_append libobjs " $func_extract_archives_result" - test "X$libobjs" = "X " && libobjs= - fi - - save_ifs=$IFS; IFS='~' - for cmd in $cmds; do - IFS=$sp$nl - eval cmd=\"$cmd\" - IFS=$save_ifs - $opt_quiet || { - func_quote_for_expand "$cmd" - eval "func_echo $func_quote_for_expand_result" - } - $opt_dry_run || eval "$cmd" || { - lt_exit=$? - - # Restore the uninstalled library and exit - if test relink = "$opt_mode"; then - ( cd "$output_objdir" && \ - $RM "${realname}T" && \ - $MV "${realname}U" "$realname" ) - fi - - exit $lt_exit - } - done - IFS=$save_ifs - - # Restore the uninstalled library and exit - if test relink = "$opt_mode"; then - $opt_dry_run || eval '(cd $output_objdir && $RM ${realname}T && $MV $realname ${realname}T && $MV ${realname}U $realname)' || exit $? - - if test -n "$convenience"; then - if test -z "$whole_archive_flag_spec"; then - func_show_eval '${RM}r "$gentop"' - fi - fi - - exit $EXIT_SUCCESS - fi - - # Create links to the real library. - for linkname in $linknames; do - if test "$realname" != "$linkname"; then - func_show_eval '(cd "$output_objdir" && $RM "$linkname" && $LN_S "$realname" "$linkname")' 'exit $?' - fi - done - - # If -module or -export-dynamic was specified, set the dlname. - if test yes = "$module" || test yes = "$export_dynamic"; then - # On all known operating systems, these are identical. - dlname=$soname - fi - fi - ;; - - obj) - if test -n "$dlfiles$dlprefiles" || test no != "$dlself"; then - func_warning "'-dlopen' is ignored for objects" - fi - - case " $deplibs" in - *\ -l* | *\ -L*) - func_warning "'-l' and '-L' are ignored for objects" ;; - esac - - test -n "$rpath" && \ - func_warning "'-rpath' is ignored for objects" - - test -n "$xrpath" && \ - func_warning "'-R' is ignored for objects" - - test -n "$vinfo" && \ - func_warning "'-version-info' is ignored for objects" - - test -n "$release" && \ - func_warning "'-release' is ignored for objects" - - case $output in - *.lo) - test -n "$objs$old_deplibs" && \ - func_fatal_error "cannot build library object '$output' from non-libtool objects" - - libobj=$output - func_lo2o "$libobj" - obj=$func_lo2o_result - ;; - *) - libobj= - obj=$output - ;; - esac - - # Delete the old objects. - $opt_dry_run || $RM $obj $libobj - - # Objects from convenience libraries. This assumes - # single-version convenience libraries. Whenever we create - # different ones for PIC/non-PIC, this we'll have to duplicate - # the extraction. - reload_conv_objs= - gentop= - # if reload_cmds runs $LD directly, get rid of -Wl from - # whole_archive_flag_spec and hope we can get by with turning comma - # into space. - case $reload_cmds in - *\$LD[\ \$]*) wl= ;; - esac - if test -n "$convenience"; then - if test -n "$whole_archive_flag_spec"; then - eval tmp_whole_archive_flags=\"$whole_archive_flag_spec\" - test -n "$wl" || tmp_whole_archive_flags=`$ECHO "$tmp_whole_archive_flags" | $SED 's|,| |g'` - reload_conv_objs=$reload_objs\ $tmp_whole_archive_flags - else - gentop=$output_objdir/${obj}x - func_append generated " $gentop" - - func_extract_archives $gentop $convenience - reload_conv_objs="$reload_objs $func_extract_archives_result" - fi - fi - - # If we're not building shared, we need to use non_pic_objs - test yes = "$build_libtool_libs" || libobjs=$non_pic_objects - - # Create the old-style object. - reload_objs=$objs$old_deplibs' '`$ECHO "$libobjs" | $SP2NL | $SED "/\.$libext$/d; /\.lib$/d; $lo2o" | $NL2SP`' '$reload_conv_objs - - output=$obj - func_execute_cmds "$reload_cmds" 'exit $?' - - # Exit if we aren't doing a library object file. - if test -z "$libobj"; then - if test -n "$gentop"; then - func_show_eval '${RM}r "$gentop"' - fi - - exit $EXIT_SUCCESS - fi - - test yes = "$build_libtool_libs" || { - if test -n "$gentop"; then - func_show_eval '${RM}r "$gentop"' - fi - - # Create an invalid libtool object if no PIC, so that we don't - # accidentally link it into a program. - # $show "echo timestamp > $libobj" - # $opt_dry_run || eval "echo timestamp > $libobj" || exit $? - exit $EXIT_SUCCESS - } - - if test -n "$pic_flag" || test default != "$pic_mode"; then - # Only do commands if we really have different PIC objects. - reload_objs="$libobjs $reload_conv_objs" - output=$libobj - func_execute_cmds "$reload_cmds" 'exit $?' - fi - - if test -n "$gentop"; then - func_show_eval '${RM}r "$gentop"' - fi - - exit $EXIT_SUCCESS - ;; - - prog) - case $host in - *cygwin*) func_stripname '' '.exe' "$output" - output=$func_stripname_result.exe;; - esac - test -n "$vinfo" && \ - func_warning "'-version-info' is ignored for programs" - - test -n "$release" && \ - func_warning "'-release' is ignored for programs" - - $preload \ - && test unknown,unknown,unknown = "$dlopen_support,$dlopen_self,$dlopen_self_static" \ - && func_warning "'LT_INIT([dlopen])' not used. Assuming no dlopen support." - - case $host in - *-*-rhapsody* | *-*-darwin1.[012]) - # On Rhapsody replace the C library is the System framework - compile_deplibs=`$ECHO " $compile_deplibs" | $SED 's/ -lc / System.ltframework /'` - finalize_deplibs=`$ECHO " $finalize_deplibs" | $SED 's/ -lc / System.ltframework /'` - ;; - esac - - case $host in - *-*-darwin*) - # Don't allow lazy linking, it breaks C++ global constructors - # But is supposedly fixed on 10.4 or later (yay!). - if test CXX = "$tagname"; then - case ${MACOSX_DEPLOYMENT_TARGET-10.0} in - 10.[0123]) - func_append compile_command " $wl-bind_at_load" - func_append finalize_command " $wl-bind_at_load" - ;; - esac - fi - # Time to change all our "foo.ltframework" stuff back to "-framework foo" - compile_deplibs=`$ECHO " $compile_deplibs" | $SED 's% \([^ $]*\).ltframework% -framework \1%g'` - finalize_deplibs=`$ECHO " $finalize_deplibs" | $SED 's% \([^ $]*\).ltframework% -framework \1%g'` - ;; - esac - - - # move library search paths that coincide with paths to not yet - # installed libraries to the beginning of the library search list - new_libs= - for path in $notinst_path; do - case " $new_libs " in - *" -L$path/$objdir "*) ;; - *) - case " $compile_deplibs " in - *" -L$path/$objdir "*) - func_append new_libs " -L$path/$objdir" ;; - esac - ;; - esac - done - for deplib in $compile_deplibs; do - case $deplib in - -L*) - case " $new_libs " in - *" $deplib "*) ;; - *) func_append new_libs " $deplib" ;; - esac - ;; - *) func_append new_libs " $deplib" ;; - esac - done - compile_deplibs=$new_libs - - - func_append compile_command " $compile_deplibs" - func_append finalize_command " $finalize_deplibs" - - if test -n "$rpath$xrpath"; then - # If the user specified any rpath flags, then add them. - for libdir in $rpath $xrpath; do - # This is the magic to use -rpath. - case "$finalize_rpath " in - *" $libdir "*) ;; - *) func_append finalize_rpath " $libdir" ;; - esac - done - fi - - # Now hardcode the library paths - rpath= - hardcode_libdirs= - for libdir in $compile_rpath $finalize_rpath; do - if test -n "$hardcode_libdir_flag_spec"; then - if test -n "$hardcode_libdir_separator"; then - if test -z "$hardcode_libdirs"; then - hardcode_libdirs=$libdir - else - # Just accumulate the unique libdirs. - case $hardcode_libdir_separator$hardcode_libdirs$hardcode_libdir_separator in - *"$hardcode_libdir_separator$libdir$hardcode_libdir_separator"*) - ;; - *) - func_append hardcode_libdirs "$hardcode_libdir_separator$libdir" - ;; - esac - fi - else - eval flag=\"$hardcode_libdir_flag_spec\" - func_append rpath " $flag" - fi - elif test -n "$runpath_var"; then - case "$perm_rpath " in - *" $libdir "*) ;; - *) func_append perm_rpath " $libdir" ;; - esac - fi - case $host in - *-*-cygwin* | *-*-mingw* | *-*-pw32* | *-*-os2* | *-cegcc*) - testbindir=`$ECHO "$libdir" | $SED -e 's*/lib$*/bin*'` - case :$dllsearchpath: in - *":$libdir:"*) ;; - ::) dllsearchpath=$libdir;; - *) func_append dllsearchpath ":$libdir";; - esac - case :$dllsearchpath: in - *":$testbindir:"*) ;; - ::) dllsearchpath=$testbindir;; - *) func_append dllsearchpath ":$testbindir";; - esac - ;; - esac - done - # Substitute the hardcoded libdirs into the rpath. - if test -n "$hardcode_libdir_separator" && - test -n "$hardcode_libdirs"; then - libdir=$hardcode_libdirs - eval rpath=\" $hardcode_libdir_flag_spec\" - fi - compile_rpath=$rpath - - rpath= - hardcode_libdirs= - for libdir in $finalize_rpath; do - if test -n "$hardcode_libdir_flag_spec"; then - if test -n "$hardcode_libdir_separator"; then - if test -z "$hardcode_libdirs"; then - hardcode_libdirs=$libdir - else - # Just accumulate the unique libdirs. - case $hardcode_libdir_separator$hardcode_libdirs$hardcode_libdir_separator in - *"$hardcode_libdir_separator$libdir$hardcode_libdir_separator"*) - ;; - *) - func_append hardcode_libdirs "$hardcode_libdir_separator$libdir" - ;; - esac - fi - else - eval flag=\"$hardcode_libdir_flag_spec\" - func_append rpath " $flag" - fi - elif test -n "$runpath_var"; then - case "$finalize_perm_rpath " in - *" $libdir "*) ;; - *) func_append finalize_perm_rpath " $libdir" ;; - esac - fi - done - # Substitute the hardcoded libdirs into the rpath. - if test -n "$hardcode_libdir_separator" && - test -n "$hardcode_libdirs"; then - libdir=$hardcode_libdirs - eval rpath=\" $hardcode_libdir_flag_spec\" - fi - finalize_rpath=$rpath - - if test -n "$libobjs" && test yes = "$build_old_libs"; then - # Transform all the library objects into standard objects. - compile_command=`$ECHO "$compile_command" | $SP2NL | $SED "$lo2o" | $NL2SP` - finalize_command=`$ECHO "$finalize_command" | $SP2NL | $SED "$lo2o" | $NL2SP` - fi - - func_generate_dlsyms "$outputname" "@PROGRAM@" false - - # template prelinking step - if test -n "$prelink_cmds"; then - func_execute_cmds "$prelink_cmds" 'exit $?' - fi - - wrappers_required=: - case $host in - *cegcc* | *mingw32ce*) - # Disable wrappers for cegcc and mingw32ce hosts, we are cross compiling anyway. - wrappers_required=false - ;; - *cygwin* | *mingw* ) - test yes = "$build_libtool_libs" || wrappers_required=false - ;; - *) - if test no = "$need_relink" || test yes != "$build_libtool_libs"; then - wrappers_required=false - fi - ;; - esac - $wrappers_required || { - # Replace the output file specification. - compile_command=`$ECHO "$compile_command" | $SED 's%@OUTPUT@%'"$output"'%g'` - link_command=$compile_command$compile_rpath - - # We have no uninstalled library dependencies, so finalize right now. - exit_status=0 - func_show_eval "$link_command" 'exit_status=$?' - - if test -n "$postlink_cmds"; then - func_to_tool_file "$output" - postlink_cmds=`func_echo_all "$postlink_cmds" | $SED -e 's%@OUTPUT@%'"$output"'%g' -e 's%@TOOL_OUTPUT@%'"$func_to_tool_file_result"'%g'` - func_execute_cmds "$postlink_cmds" 'exit $?' - fi - - # Delete the generated files. - if test -f "$output_objdir/${outputname}S.$objext"; then - func_show_eval '$RM "$output_objdir/${outputname}S.$objext"' - fi - - exit $exit_status - } - - if test -n "$compile_shlibpath$finalize_shlibpath"; then - compile_command="$shlibpath_var=\"$compile_shlibpath$finalize_shlibpath\$$shlibpath_var\" $compile_command" - fi - if test -n "$finalize_shlibpath"; then - finalize_command="$shlibpath_var=\"$finalize_shlibpath\$$shlibpath_var\" $finalize_command" - fi - - compile_var= - finalize_var= - if test -n "$runpath_var"; then - if test -n "$perm_rpath"; then - # We should set the runpath_var. - rpath= - for dir in $perm_rpath; do - func_append rpath "$dir:" - done - compile_var="$runpath_var=\"$rpath\$$runpath_var\" " - fi - if test -n "$finalize_perm_rpath"; then - # We should set the runpath_var. - rpath= - for dir in $finalize_perm_rpath; do - func_append rpath "$dir:" - done - finalize_var="$runpath_var=\"$rpath\$$runpath_var\" " - fi - fi - - if test yes = "$no_install"; then - # We don't need to create a wrapper script. - link_command=$compile_var$compile_command$compile_rpath - # Replace the output file specification. - link_command=`$ECHO "$link_command" | $SED 's%@OUTPUT@%'"$output"'%g'` - # Delete the old output file. - $opt_dry_run || $RM $output - # Link the executable and exit - func_show_eval "$link_command" 'exit $?' - - if test -n "$postlink_cmds"; then - func_to_tool_file "$output" - postlink_cmds=`func_echo_all "$postlink_cmds" | $SED -e 's%@OUTPUT@%'"$output"'%g' -e 's%@TOOL_OUTPUT@%'"$func_to_tool_file_result"'%g'` - func_execute_cmds "$postlink_cmds" 'exit $?' - fi - - exit $EXIT_SUCCESS - fi - - case $hardcode_action,$fast_install in - relink,*) - # Fast installation is not supported - link_command=$compile_var$compile_command$compile_rpath - relink_command=$finalize_var$finalize_command$finalize_rpath - - func_warning "this platform does not like uninstalled shared libraries" - func_warning "'$output' will be relinked during installation" - ;; - *,yes) - link_command=$finalize_var$compile_command$finalize_rpath - relink_command=`$ECHO "$compile_var$compile_command$compile_rpath" | $SED 's%@OUTPUT@%\$progdir/\$file%g'` - ;; - *,no) - link_command=$compile_var$compile_command$compile_rpath - relink_command=$finalize_var$finalize_command$finalize_rpath - ;; - *,needless) - link_command=$finalize_var$compile_command$finalize_rpath - relink_command= - ;; - esac - - # Replace the output file specification. - link_command=`$ECHO "$link_command" | $SED 's%@OUTPUT@%'"$output_objdir/$outputname"'%g'` - - # Delete the old output files. - $opt_dry_run || $RM $output $output_objdir/$outputname $output_objdir/lt-$outputname - - func_show_eval "$link_command" 'exit $?' - - if test -n "$postlink_cmds"; then - func_to_tool_file "$output_objdir/$outputname" - postlink_cmds=`func_echo_all "$postlink_cmds" | $SED -e 's%@OUTPUT@%'"$output_objdir/$outputname"'%g' -e 's%@TOOL_OUTPUT@%'"$func_to_tool_file_result"'%g'` - func_execute_cmds "$postlink_cmds" 'exit $?' - fi - - # Now create the wrapper script. - func_verbose "creating $output" - - # Quote the relink command for shipping. - if test -n "$relink_command"; then - # Preserve any variables that may affect compiler behavior - for var in $variables_saved_for_relink; do - if eval test -z \"\${$var+set}\"; then - relink_command="{ test -z \"\${$var+set}\" || $lt_unset $var || { $var=; export $var; }; }; $relink_command" - elif eval var_value=\$$var; test -z "$var_value"; then - relink_command="$var=; export $var; $relink_command" - else - func_quote_for_eval "$var_value" - relink_command="$var=$func_quote_for_eval_result; export $var; $relink_command" - fi - done - relink_command="(cd `pwd`; $relink_command)" - relink_command=`$ECHO "$relink_command" | $SED "$sed_quote_subst"` - fi - - # Only actually do things if not in dry run mode. - $opt_dry_run || { - # win32 will think the script is a binary if it has - # a .exe suffix, so we strip it off here. - case $output in - *.exe) func_stripname '' '.exe' "$output" - output=$func_stripname_result ;; - esac - # test for cygwin because mv fails w/o .exe extensions - case $host in - *cygwin*) - exeext=.exe - func_stripname '' '.exe' "$outputname" - outputname=$func_stripname_result ;; - *) exeext= ;; - esac - case $host in - *cygwin* | *mingw* ) - func_dirname_and_basename "$output" "" "." - output_name=$func_basename_result - output_path=$func_dirname_result - cwrappersource=$output_path/$objdir/lt-$output_name.c - cwrapper=$output_path/$output_name.exe - $RM $cwrappersource $cwrapper - trap "$RM $cwrappersource $cwrapper; exit $EXIT_FAILURE" 1 2 15 - - func_emit_cwrapperexe_src > $cwrappersource - - # The wrapper executable is built using the $host compiler, - # because it contains $host paths and files. If cross- - # compiling, it, like the target executable, must be - # executed on the $host or under an emulation environment. - $opt_dry_run || { - $LTCC $LTCFLAGS -o $cwrapper $cwrappersource - $STRIP $cwrapper - } - - # Now, create the wrapper script for func_source use: - func_ltwrapper_scriptname $cwrapper - $RM $func_ltwrapper_scriptname_result - trap "$RM $func_ltwrapper_scriptname_result; exit $EXIT_FAILURE" 1 2 15 - $opt_dry_run || { - # note: this script will not be executed, so do not chmod. - if test "x$build" = "x$host"; then - $cwrapper --lt-dump-script > $func_ltwrapper_scriptname_result - else - func_emit_wrapper no > $func_ltwrapper_scriptname_result - fi - } - ;; - * ) - $RM $output - trap "$RM $output; exit $EXIT_FAILURE" 1 2 15 - - func_emit_wrapper no > $output - chmod +x $output - ;; - esac - } - exit $EXIT_SUCCESS - ;; - esac - - # See if we need to build an old-fashioned archive. - for oldlib in $oldlibs; do - - case $build_libtool_libs in - convenience) - oldobjs="$libobjs_save $symfileobj" - addlibs=$convenience - build_libtool_libs=no - ;; - module) - oldobjs=$libobjs_save - addlibs=$old_convenience - build_libtool_libs=no - ;; - *) - oldobjs="$old_deplibs $non_pic_objects" - $preload && test -f "$symfileobj" \ - && func_append oldobjs " $symfileobj" - addlibs=$old_convenience - ;; - esac - - if test -n "$addlibs"; then - gentop=$output_objdir/${outputname}x - func_append generated " $gentop" - - func_extract_archives $gentop $addlibs - func_append oldobjs " $func_extract_archives_result" - fi - - # Do each command in the archive commands. - if test -n "$old_archive_from_new_cmds" && test yes = "$build_libtool_libs"; then - cmds=$old_archive_from_new_cmds - else - - # Add any objects from preloaded convenience libraries - if test -n "$dlprefiles"; then - gentop=$output_objdir/${outputname}x - func_append generated " $gentop" - - func_extract_archives $gentop $dlprefiles - func_append oldobjs " $func_extract_archives_result" - fi - - # POSIX demands no paths to be encoded in archives. We have - # to avoid creating archives with duplicate basenames if we - # might have to extract them afterwards, e.g., when creating a - # static archive out of a convenience library, or when linking - # the entirety of a libtool archive into another (currently - # not supported by libtool). - if (for obj in $oldobjs - do - func_basename "$obj" - $ECHO "$func_basename_result" - done | sort | sort -uc >/dev/null 2>&1); then - : - else - echo "copying selected object files to avoid basename conflicts..." - gentop=$output_objdir/${outputname}x - func_append generated " $gentop" - func_mkdir_p "$gentop" - save_oldobjs=$oldobjs - oldobjs= - counter=1 - for obj in $save_oldobjs - do - func_basename "$obj" - objbase=$func_basename_result - case " $oldobjs " in - " ") oldobjs=$obj ;; - *[\ /]"$objbase "*) - while :; do - # Make sure we don't pick an alternate name that also - # overlaps. - newobj=lt$counter-$objbase - func_arith $counter + 1 - counter=$func_arith_result - case " $oldobjs " in - *[\ /]"$newobj "*) ;; - *) if test ! -f "$gentop/$newobj"; then break; fi ;; - esac - done - func_show_eval "ln $obj $gentop/$newobj || cp $obj $gentop/$newobj" - func_append oldobjs " $gentop/$newobj" - ;; - *) func_append oldobjs " $obj" ;; - esac - done - fi - func_to_tool_file "$oldlib" func_convert_file_msys_to_w32 - tool_oldlib=$func_to_tool_file_result - eval cmds=\"$old_archive_cmds\" - - func_len " $cmds" - len=$func_len_result - if test "$len" -lt "$max_cmd_len" || test "$max_cmd_len" -le -1; then - cmds=$old_archive_cmds - elif test -n "$archiver_list_spec"; then - func_verbose "using command file archive linking..." - for obj in $oldobjs - do - func_to_tool_file "$obj" - $ECHO "$func_to_tool_file_result" - done > $output_objdir/$libname.libcmd - func_to_tool_file "$output_objdir/$libname.libcmd" - oldobjs=" $archiver_list_spec$func_to_tool_file_result" - cmds=$old_archive_cmds - else - # the command line is too long to link in one step, link in parts - func_verbose "using piecewise archive linking..." - save_RANLIB=$RANLIB - RANLIB=: - objlist= - concat_cmds= - save_oldobjs=$oldobjs - oldobjs= - # Is there a better way of finding the last object in the list? - for obj in $save_oldobjs - do - last_oldobj=$obj - done - eval test_cmds=\"$old_archive_cmds\" - func_len " $test_cmds" - len0=$func_len_result - len=$len0 - for obj in $save_oldobjs - do - func_len " $obj" - func_arith $len + $func_len_result - len=$func_arith_result - func_append objlist " $obj" - if test "$len" -lt "$max_cmd_len"; then - : - else - # the above command should be used before it gets too long - oldobjs=$objlist - if test "$obj" = "$last_oldobj"; then - RANLIB=$save_RANLIB - fi - test -z "$concat_cmds" || concat_cmds=$concat_cmds~ - eval concat_cmds=\"\$concat_cmds$old_archive_cmds\" - objlist= - len=$len0 - fi - done - RANLIB=$save_RANLIB - oldobjs=$objlist - if test -z "$oldobjs"; then - eval cmds=\"\$concat_cmds\" - else - eval cmds=\"\$concat_cmds~\$old_archive_cmds\" - fi - fi - fi - func_execute_cmds "$cmds" 'exit $?' - done - - test -n "$generated" && \ - func_show_eval "${RM}r$generated" - - # Now create the libtool archive. - case $output in - *.la) - old_library= - test yes = "$build_old_libs" && old_library=$libname.$libext - func_verbose "creating $output" - - # Preserve any variables that may affect compiler behavior - for var in $variables_saved_for_relink; do - if eval test -z \"\${$var+set}\"; then - relink_command="{ test -z \"\${$var+set}\" || $lt_unset $var || { $var=; export $var; }; }; $relink_command" - elif eval var_value=\$$var; test -z "$var_value"; then - relink_command="$var=; export $var; $relink_command" - else - func_quote_for_eval "$var_value" - relink_command="$var=$func_quote_for_eval_result; export $var; $relink_command" - fi - done - # Quote the link command for shipping. - relink_command="(cd `pwd`; $SHELL \"$progpath\" $preserve_args --mode=relink $libtool_args @inst_prefix_dir@)" - relink_command=`$ECHO "$relink_command" | $SED "$sed_quote_subst"` - if test yes = "$hardcode_automatic"; then - relink_command= - fi - - # Only create the output if not a dry run. - $opt_dry_run || { - for installed in no yes; do - if test yes = "$installed"; then - if test -z "$install_libdir"; then - break - fi - output=$output_objdir/${outputname}i - # Replace all uninstalled libtool libraries with the installed ones - newdependency_libs= - for deplib in $dependency_libs; do - case $deplib in - *.la) - func_basename "$deplib" - name=$func_basename_result - func_resolve_sysroot "$deplib" - eval libdir=`$SED -n -e 's/^libdir=\(.*\)$/\1/p' $func_resolve_sysroot_result` - test -z "$libdir" && \ - func_fatal_error "'$deplib' is not a valid libtool archive" - func_append newdependency_libs " ${lt_sysroot:+=}$libdir/$name" - ;; - -L*) - func_stripname -L '' "$deplib" - func_replace_sysroot "$func_stripname_result" - func_append newdependency_libs " -L$func_replace_sysroot_result" - ;; - -R*) - func_stripname -R '' "$deplib" - func_replace_sysroot "$func_stripname_result" - func_append newdependency_libs " -R$func_replace_sysroot_result" - ;; - *) func_append newdependency_libs " $deplib" ;; - esac - done - dependency_libs=$newdependency_libs - newdlfiles= - - for lib in $dlfiles; do - case $lib in - *.la) - func_basename "$lib" - name=$func_basename_result - eval libdir=`$SED -n -e 's/^libdir=\(.*\)$/\1/p' $lib` - test -z "$libdir" && \ - func_fatal_error "'$lib' is not a valid libtool archive" - func_append newdlfiles " ${lt_sysroot:+=}$libdir/$name" - ;; - *) func_append newdlfiles " $lib" ;; - esac - done - dlfiles=$newdlfiles - newdlprefiles= - for lib in $dlprefiles; do - case $lib in - *.la) - # Only pass preopened files to the pseudo-archive (for - # eventual linking with the app. that links it) if we - # didn't already link the preopened objects directly into - # the library: - func_basename "$lib" - name=$func_basename_result - eval libdir=`$SED -n -e 's/^libdir=\(.*\)$/\1/p' $lib` - test -z "$libdir" && \ - func_fatal_error "'$lib' is not a valid libtool archive" - func_append newdlprefiles " ${lt_sysroot:+=}$libdir/$name" - ;; - esac - done - dlprefiles=$newdlprefiles - else - newdlfiles= - for lib in $dlfiles; do - case $lib in - [\\/]* | [A-Za-z]:[\\/]*) abs=$lib ;; - *) abs=`pwd`"/$lib" ;; - esac - func_append newdlfiles " $abs" - done - dlfiles=$newdlfiles - newdlprefiles= - for lib in $dlprefiles; do - case $lib in - [\\/]* | [A-Za-z]:[\\/]*) abs=$lib ;; - *) abs=`pwd`"/$lib" ;; - esac - func_append newdlprefiles " $abs" - done - dlprefiles=$newdlprefiles - fi - $RM $output - # place dlname in correct position for cygwin - # In fact, it would be nice if we could use this code for all target - # systems that can't hard-code library paths into their executables - # and that have no shared library path variable independent of PATH, - # but it turns out we can't easily determine that from inspecting - # libtool variables, so we have to hard-code the OSs to which it - # applies here; at the moment, that means platforms that use the PE - # object format with DLL files. See the long comment at the top of - # tests/bindir.at for full details. - tdlname=$dlname - case $host,$output,$installed,$module,$dlname in - *cygwin*,*lai,yes,no,*.dll | *mingw*,*lai,yes,no,*.dll | *cegcc*,*lai,yes,no,*.dll) - # If a -bindir argument was supplied, place the dll there. - if test -n "$bindir"; then - func_relative_path "$install_libdir" "$bindir" - tdlname=$func_relative_path_result/$dlname - else - # Otherwise fall back on heuristic. - tdlname=../bin/$dlname - fi - ;; - esac - $ECHO > $output "\ -# $outputname - a libtool library file -# Generated by $PROGRAM (GNU $PACKAGE) $VERSION -# -# Please DO NOT delete this file! -# It is necessary for linking the library. - -# The name that we can dlopen(3). -dlname='$tdlname' - -# Names of this library. -library_names='$library_names' - -# The name of the static archive. -old_library='$old_library' - -# Linker flags that cannot go in dependency_libs. -inherited_linker_flags='$new_inherited_linker_flags' - -# Libraries that this one depends upon. -dependency_libs='$dependency_libs' - -# Names of additional weak libraries provided by this library -weak_library_names='$weak_libs' - -# Version information for $libname. -current=$current -age=$age -revision=$revision - -# Is this an already installed library? -installed=$installed - -# Should we warn about portability when linking against -modules? -shouldnotlink=$module - -# Files to dlopen/dlpreopen -dlopen='$dlfiles' -dlpreopen='$dlprefiles' - -# Directory that this library needs to be installed in: -libdir='$install_libdir'" - if test no,yes = "$installed,$need_relink"; then - $ECHO >> $output "\ -relink_command=\"$relink_command\"" - fi - done - } - - # Do a symbolic link so that the libtool archive can be found in - # LD_LIBRARY_PATH before the program is installed. - func_show_eval '( cd "$output_objdir" && $RM "$outputname" && $LN_S "../$outputname" "$outputname" )' 'exit $?' - ;; - esac - exit $EXIT_SUCCESS -} - -if test link = "$opt_mode" || test relink = "$opt_mode"; then - func_mode_link ${1+"$@"} -fi - - -# func_mode_uninstall arg... -func_mode_uninstall () -{ - $debug_cmd - - RM=$nonopt - files= - rmforce=false - exit_status=0 - - # This variable tells wrapper scripts just to set variables rather - # than running their programs. - libtool_install_magic=$magic - - for arg - do - case $arg in - -f) func_append RM " $arg"; rmforce=: ;; - -*) func_append RM " $arg" ;; - *) func_append files " $arg" ;; - esac - done - - test -z "$RM" && \ - func_fatal_help "you must specify an RM program" - - rmdirs= - - for file in $files; do - func_dirname "$file" "" "." - dir=$func_dirname_result - if test . = "$dir"; then - odir=$objdir - else - odir=$dir/$objdir - fi - func_basename "$file" - name=$func_basename_result - test uninstall = "$opt_mode" && odir=$dir - - # Remember odir for removal later, being careful to avoid duplicates - if test clean = "$opt_mode"; then - case " $rmdirs " in - *" $odir "*) ;; - *) func_append rmdirs " $odir" ;; - esac - fi - - # Don't error if the file doesn't exist and rm -f was used. - if { test -L "$file"; } >/dev/null 2>&1 || - { test -h "$file"; } >/dev/null 2>&1 || - test -f "$file"; then - : - elif test -d "$file"; then - exit_status=1 - continue - elif $rmforce; then - continue - fi - - rmfiles=$file - - case $name in - *.la) - # Possibly a libtool archive, so verify it. - if func_lalib_p "$file"; then - func_source $dir/$name - - # Delete the libtool libraries and symlinks. - for n in $library_names; do - func_append rmfiles " $odir/$n" - done - test -n "$old_library" && func_append rmfiles " $odir/$old_library" - - case $opt_mode in - clean) - case " $library_names " in - *" $dlname "*) ;; - *) test -n "$dlname" && func_append rmfiles " $odir/$dlname" ;; - esac - test -n "$libdir" && func_append rmfiles " $odir/$name $odir/${name}i" - ;; - uninstall) - if test -n "$library_names"; then - # Do each command in the postuninstall commands. - func_execute_cmds "$postuninstall_cmds" '$rmforce || exit_status=1' - fi - - if test -n "$old_library"; then - # Do each command in the old_postuninstall commands. - func_execute_cmds "$old_postuninstall_cmds" '$rmforce || exit_status=1' - fi - # FIXME: should reinstall the best remaining shared library. - ;; - esac - fi - ;; - - *.lo) - # Possibly a libtool object, so verify it. - if func_lalib_p "$file"; then - - # Read the .lo file - func_source $dir/$name - - # Add PIC object to the list of files to remove. - if test -n "$pic_object" && test none != "$pic_object"; then - func_append rmfiles " $dir/$pic_object" - fi - - # Add non-PIC object to the list of files to remove. - if test -n "$non_pic_object" && test none != "$non_pic_object"; then - func_append rmfiles " $dir/$non_pic_object" - fi - fi - ;; - - *) - if test clean = "$opt_mode"; then - noexename=$name - case $file in - *.exe) - func_stripname '' '.exe' "$file" - file=$func_stripname_result - func_stripname '' '.exe' "$name" - noexename=$func_stripname_result - # $file with .exe has already been added to rmfiles, - # add $file without .exe - func_append rmfiles " $file" - ;; - esac - # Do a test to see if this is a libtool program. - if func_ltwrapper_p "$file"; then - if func_ltwrapper_executable_p "$file"; then - func_ltwrapper_scriptname "$file" - relink_command= - func_source $func_ltwrapper_scriptname_result - func_append rmfiles " $func_ltwrapper_scriptname_result" - else - relink_command= - func_source $dir/$noexename - fi - - # note $name still contains .exe if it was in $file originally - # as does the version of $file that was added into $rmfiles - func_append rmfiles " $odir/$name $odir/${name}S.$objext" - if test yes = "$fast_install" && test -n "$relink_command"; then - func_append rmfiles " $odir/lt-$name" - fi - if test "X$noexename" != "X$name"; then - func_append rmfiles " $odir/lt-$noexename.c" - fi - fi - fi - ;; - esac - func_show_eval "$RM $rmfiles" 'exit_status=1' - done - - # Try to remove the $objdir's in the directories where we deleted files - for dir in $rmdirs; do - if test -d "$dir"; then - func_show_eval "rmdir $dir >/dev/null 2>&1" - fi - done - - exit $exit_status -} - -if test uninstall = "$opt_mode" || test clean = "$opt_mode"; then - func_mode_uninstall ${1+"$@"} -fi - -test -z "$opt_mode" && { - help=$generic_help - func_fatal_help "you must specify a MODE" -} - -test -z "$exec_cmd" && \ - func_fatal_help "invalid operation mode '$opt_mode'" - -if test -n "$exec_cmd"; then - eval exec "$exec_cmd" - exit $EXIT_FAILURE -fi - -exit $exit_status - - -# The TAGs below are defined such that we never get into a situation -# where we disable both kinds of libraries. Given conflicting -# choices, we go for a static library, that is the most portable, -# since we can't tell whether shared libraries were disabled because -# the user asked for that or because the platform doesn't support -# them. This is particularly important on AIX, because we don't -# support having both static and shared libraries enabled at the same -# time on that platform, so we default to a shared-only configuration. -# If a disable-shared tag is given, we'll fallback to a static-only -# configuration. But we'll never go from static-only to shared-only. - -# ### BEGIN LIBTOOL TAG CONFIG: disable-shared -build_libtool_libs=no -build_old_libs=yes -# ### END LIBTOOL TAG CONFIG: disable-shared - -# ### BEGIN LIBTOOL TAG CONFIG: disable-static -build_old_libs=`case $build_libtool_libs in yes) echo no;; *) echo yes;; esac` -# ### END LIBTOOL TAG CONFIG: disable-static - -# Local Variables: -# mode:shell-script -# sh-indentation:2 -# End: diff -Nru gnucobol-4.0~early~20200606/build_aux/mdate-sh gnucobol-5/build_aux/mdate-sh --- gnucobol-4.0~early~20200606/build_aux/mdate-sh 2020-06-06 20:52:02.000000000 +0000 +++ gnucobol-5/build_aux/mdate-sh 1970-01-01 00:00:00.000000000 +0000 @@ -1,228 +0,0 @@ -#!/bin/sh -# Get modification time of a file or directory and pretty-print it. - -scriptversion=2017-09-22.02; # UTC - -# Copyright (C) 1995-2017 Free Software Foundation, Inc. -# written by Ulrich Drepper , June 1995 -# -# This program is free software; you can redistribute it and/or modify -# it under the terms of the GNU General Public License as published by -# the Free Software Foundation; either version 2, or (at your option) -# any later version. -# -# This program is distributed in the hope that it will be useful, -# but WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -# GNU General Public License for more details. -# -# You should have received a copy of the GNU General Public License -# along with this program. If not, see . - -# As a special exception to the GNU General Public License, if you -# distribute this file as part of a program that contains a -# configuration script generated by Autoconf, you may include it under -# the same distribution terms that you use for the rest of that program. - -# This file is maintained in Automake, please report -# bugs to or send patches to -# . - -if test -n "${ZSH_VERSION+set}" && (emulate sh) >/dev/null 2>&1; then - emulate sh - NULLCMD=: - # Pre-4.2 versions of Zsh do word splitting on ${1+"$@"}, which - # is contrary to our usage. Disable this feature. - alias -g '${1+"$@"}'='"$@"' - setopt NO_GLOB_SUBST -fi - -case $1 in - '') - echo "$0: No file. Try '$0 --help' for more information." 1>&2 - exit 1; - ;; - -h | --h*) - cat <<\EOF -Usage: mdate-sh [--help] [--version] FILE - -Pretty-print the modification day of FILE, in the format: -1 January 1970 - -Report bugs to . -EOF - exit $? - ;; - -v | --v*) - echo "mdate-sh $scriptversion" - exit $? - ;; -esac - -error () -{ - echo "$0: $1" >&2 - exit 1 -} - - -# Prevent date giving response in another language. -LANG=C -export LANG -LC_ALL=C -export LC_ALL -LC_TIME=C -export LC_TIME - -# Use UTC to get reproducible result. -TZ=UTC0 -export TZ - -# GNU ls changes its time format in response to the TIME_STYLE -# variable. Since we cannot assume 'unset' works, revert this -# variable to its documented default. -if test "${TIME_STYLE+set}" = set; then - TIME_STYLE=posix-long-iso - export TIME_STYLE -fi - -save_arg1=$1 - -# Find out how to get the extended ls output of a file or directory. -if ls -L /dev/null 1>/dev/null 2>&1; then - ls_command='ls -L -l -d' -else - ls_command='ls -l -d' -fi -# Avoid user/group names that might have spaces, when possible. -if ls -n /dev/null 1>/dev/null 2>&1; then - ls_command="$ls_command -n" -fi - -# A 'ls -l' line looks as follows on OS/2. -# drwxrwx--- 0 Aug 11 2001 foo -# This differs from Unix, which adds ownership information. -# drwxrwx--- 2 root root 4096 Aug 11 2001 foo -# -# To find the date, we split the line on spaces and iterate on words -# until we find a month. This cannot work with files whose owner is a -# user named "Jan", or "Feb", etc. However, it's unlikely that '/' -# will be owned by a user whose name is a month. So we first look at -# the extended ls output of the root directory to decide how many -# words should be skipped to get the date. - -# On HPUX /bin/sh, "set" interprets "-rw-r--r--" as options, so the "x" below. -set x`$ls_command /` - -# Find which argument is the month. -month= -command= -until test $month -do - test $# -gt 0 || error "failed parsing '$ls_command /' output" - shift - # Add another shift to the command. - command="$command shift;" - case $1 in - Jan) month=January; nummonth=1;; - Feb) month=February; nummonth=2;; - Mar) month=March; nummonth=3;; - Apr) month=April; nummonth=4;; - May) month=May; nummonth=5;; - Jun) month=June; nummonth=6;; - Jul) month=July; nummonth=7;; - Aug) month=August; nummonth=8;; - Sep) month=September; nummonth=9;; - Oct) month=October; nummonth=10;; - Nov) month=November; nummonth=11;; - Dec) month=December; nummonth=12;; - esac -done - -test -n "$month" || error "failed parsing '$ls_command /' output" - -# Get the extended ls output of the file or directory. -set dummy x`eval "$ls_command \"\\\$save_arg1\""` - -# Remove all preceding arguments -eval $command - -# Because of the dummy argument above, month is in $2. -# -# On a POSIX system, we should have -# -# $# = 5 -# $1 = file size -# $2 = month -# $3 = day -# $4 = year or time -# $5 = filename -# -# On Darwin 7.7.0 and 7.6.0, we have -# -# $# = 4 -# $1 = day -# $2 = month -# $3 = year or time -# $4 = filename - -# Get the month. -case $2 in - Jan) month=January; nummonth=1;; - Feb) month=February; nummonth=2;; - Mar) month=March; nummonth=3;; - Apr) month=April; nummonth=4;; - May) month=May; nummonth=5;; - Jun) month=June; nummonth=6;; - Jul) month=July; nummonth=7;; - Aug) month=August; nummonth=8;; - Sep) month=September; nummonth=9;; - Oct) month=October; nummonth=10;; - Nov) month=November; nummonth=11;; - Dec) month=December; nummonth=12;; -esac - -case $3 in - ???*) day=$1;; - *) day=$3; shift;; -esac - -# Here we have to deal with the problem that the ls output gives either -# the time of day or the year. -case $3 in - *:*) set `date`; eval year=\$$# - case $2 in - Jan) nummonthtod=1;; - Feb) nummonthtod=2;; - Mar) nummonthtod=3;; - Apr) nummonthtod=4;; - May) nummonthtod=5;; - Jun) nummonthtod=6;; - Jul) nummonthtod=7;; - Aug) nummonthtod=8;; - Sep) nummonthtod=9;; - Oct) nummonthtod=10;; - Nov) nummonthtod=11;; - Dec) nummonthtod=12;; - esac - # For the first six month of the year the time notation can also - # be used for files modified in the last year. - if (expr $nummonth \> $nummonthtod) > /dev/null; - then - year=`expr $year - 1` - fi;; - *) year=$3;; -esac - -# The result. -echo $day $month $year - -# Local Variables: -# mode: shell-script -# sh-indentation: 2 -# eval: (add-hook 'write-file-hooks 'time-stamp) -# time-stamp-start: "scriptversion=" -# time-stamp-format: "%:y-%02m-%02d.%02H" -# time-stamp-time-zone: "UTC0" -# time-stamp-end: "; # UTC" -# End: diff -Nru gnucobol-4.0~early~20200606/build_aux/missing gnucobol-5/build_aux/missing --- gnucobol-4.0~early~20200606/build_aux/missing 2020-06-06 20:52:02.000000000 +0000 +++ gnucobol-5/build_aux/missing 1970-01-01 00:00:00.000000000 +0000 @@ -1,215 +0,0 @@ -#! /bin/sh -# Common wrapper for a few potentially missing GNU programs. - -scriptversion=2017-12-05.17gnucobol; # UTC - -# Copyright (C) 1996-2017 Free Software Foundation, Inc. -# Originally written by Fran,cois Pinard , 1996. - -# This program is free software; you can redistribute it and/or modify -# it under the terms of the GNU General Public License as published by -# the Free Software Foundation; either version 2, or (at your option) -# any later version. - -# This program is distributed in the hope that it will be useful, -# but WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -# GNU General Public License for more details. - -# You should have received a copy of the GNU General Public License -# along with this program. If not, see . - -# As a special exception to the GNU General Public License, if you -# distribute this file as part of a program that contains a -# configuration script generated by Autoconf, you may include it under -# the same distribution terms that you use for the rest of that program. - -if test $# -eq 0; then - echo 1>&2 "Try '$0 --help' for more information" - exit 1 -fi - -case $1 in - - --is-lightweight) - # Used by our autoconf macros to check whether the available missing - # script is modern enough. - exit 0 - ;; - - --run) - # Back-compat with the calling convention used by older automake. - shift - ;; - - -h|--h|--he|--hel|--help) - echo "\ -$0 [OPTION]... PROGRAM [ARGUMENT]... - -Run 'PROGRAM [ARGUMENT]...', returning a proper advice when this fails due -to PROGRAM being missing or too old. - -Options: - -h, --help display this help and exit - -v, --version output version information and exit - -Supported PROGRAM values: - aclocal autoconf autoheader autom4te automake makeinfo - bison yacc flex lex help2man - -Version suffixes to PROGRAM as well as the prefixes 'gnu-', 'gnu', and -'g' are ignored when checking the name. - -Send bug reports to ." - exit $? - ;; - - -v|--v|--ve|--ver|--vers|--versi|--versio|--version) - echo "missing $scriptversion (GNU Automake)" - exit $? - ;; - - -*) - echo 1>&2 "$0: unknown '$1' option" - echo 1>&2 "Try '$0 --help' for more information" - exit 1 - ;; - -esac - -# Run the given program, remember its exit status. -"$@"; st=$? - -# If it succeeded, we are done. -test $st -eq 0 && exit 0 - -# Also exit now if we it failed (or wasn't found), and '--version' was -# passed; such an option is passed most likely to detect whether the -# program is present and works. -case $2 in --version|--help) exit $st;; esac - -# Exit code 63 means version mismatch. This often happens when the user -# tries to use an ancient version of a tool on a file that requires a -# minimum version. -if test $st -eq 63; then - msg="probably too old" -elif test $st -eq 127; then - # Program was missing. - msg="missing on your system" -else - # Program was found and executed, but failed. Give up. - exit $st -fi - -perl_URL=https://www.perl.org/ -flex_URL=https://github.com/westes/flex -gnu_software_URL=https://www.gnu.org/software - -program_details () -{ - case $1 in - aclocal|automake) - echo "The '$1' program is part of the GNU Automake package:" - echo "<$gnu_software_URL/automake>" - echo "It also requires GNU Autoconf, GNU m4 and Perl in order to run:" - echo "<$gnu_software_URL/autoconf>" - echo "<$gnu_software_URL/m4/>" - echo "<$perl_URL>" - ;; - autoconf|autom4te|autoheader) - echo "The '$1' program is part of the GNU Autoconf package:" - echo "<$gnu_software_URL/autoconf/>" - echo "It also requires GNU m4 and Perl in order to run:" - echo "<$gnu_software_URL/m4/>" - echo "<$perl_URL>" - ;; - esac -} - -give_advice () -{ - # Normalize program name to check for. - normalized_program=`echo "$1" | sed ' - s/^gnu-//; t - s/^gnu//; t - s/^g//; t'` - - printf '%s\n' "'$1' is $msg." - - configure_deps="'configure.ac' or m4 files included by 'configure.ac'" - case $normalized_program in - autoconf*) - echo "You should only need it if you modified 'configure.ac'," - echo "or m4 files included by it." - program_details 'autoconf' - ;; - autoheader*) - echo "You should only need it if you modified 'acconfig.h' or" - echo "$configure_deps." - program_details 'autoheader' - ;; - automake*) - echo "You should only need it if you modified 'Makefile.am' or" - echo "$configure_deps." - program_details 'automake' - ;; - aclocal*) - echo "You should only need it if you modified 'acinclude.m4' or" - echo "$configure_deps." - program_details 'aclocal' - ;; - autom4te*) - echo "You might have modified some maintainer files that require" - echo "the 'autom4te' program to be rebuilt." - program_details 'autom4te' - ;; - bison*|yacc*) - echo "You should only need it if you modified a '.y' file." - echo "You may want to install the GNU Bison package:" - echo "<$gnu_software_URL/bison/>" - ;; - lex*|flex*) - echo "You should only need it if you modified a '.l' file." - echo "You may want to install the Fast Lexical Analyzer package:" - echo "<$flex_URL>" - ;; - help2man*) - echo "You should only need it if you modified a dependency" \ - "of a man page." - echo "You may want to install the GNU Help2man package:" - echo "<$gnu_software_URL/help2man/>" - ;; - makeinfo*) - echo "You should only need it if you modified a '.texi' file, or" - echo "any other file indirectly affecting the aspect of the manual." - echo "You might want to install the Texinfo package:" - echo "<$gnu_software_URL/texinfo/>" - echo "The spurious makeinfo call might also be the consequence of" - echo "using a buggy 'make' (AIX, DU, IRIX), in which case you might" - echo "want to install GNU make:" - echo "<$gnu_software_URL/make/>" - ;; - *) - echo "You might have modified some files without having the proper" - echo "tools for further handling them. Check the 'README' file, it" - echo "often tells you about the needed prerequisites for installing" - echo "this package. You may also peek at any GNU archive site, in" - echo "case some other package contains this missing '$1' program." - ;; - esac -} - -give_advice "$1" | sed -e '1s/^/WARNING: /' \ - -e '2,$s/^/ /' >&2 - -# Propagate the correct exit status (expected to be 127 for a program -# not found, 63 for a program that failed due to version mismatch). -exit $st - -# Local variables: -# eval: (add-hook 'write-file-hooks 'time-stamp) -# time-stamp-start: "scriptversion=" -# time-stamp-format: "%:y-%02m-%02d.%02H" -# time-stamp-time-zone: "UTC0" -# time-stamp-end: "; # UTC" -# End: diff -Nru gnucobol-4.0~early~20200606/build_aux/mkinstalldirs gnucobol-5/build_aux/mkinstalldirs --- gnucobol-4.0~early~20200606/build_aux/mkinstalldirs 2020-06-06 20:52:02.000000000 +0000 +++ gnucobol-5/build_aux/mkinstalldirs 1970-01-01 00:00:00.000000000 +0000 @@ -1,162 +0,0 @@ -#! /bin/sh -# mkinstalldirs --- make directory hierarchy - -scriptversion=2009-04-28.21; # UTC - -# Original author: Noah Friedman -# Created: 1993-05-16 -# Public domain. -# -# This file is maintained in Automake, please report -# bugs to or send patches to -# . - -nl=' -' -IFS=" "" $nl" -errstatus=0 -dirmode= - -usage="\ -Usage: mkinstalldirs [-h] [--help] [--version] [-m MODE] DIR ... - -Create each directory DIR (with mode MODE, if specified), including all -leading file name components. - -Report bugs to ." - -# process command line arguments -while test $# -gt 0 ; do - case $1 in - -h | --help | --h*) # -h for help - echo "$usage" - exit $? - ;; - -m) # -m PERM arg - shift - test $# -eq 0 && { echo "$usage" 1>&2; exit 1; } - dirmode=$1 - shift - ;; - --version) - echo "$0 $scriptversion" - exit $? - ;; - --) # stop option processing - shift - break - ;; - -*) # unknown option - echo "$usage" 1>&2 - exit 1 - ;; - *) # first non-opt arg - break - ;; - esac -done - -for file -do - if test -d "$file"; then - shift - else - break - fi -done - -case $# in - 0) exit 0 ;; -esac - -# Solaris 8's mkdir -p isn't thread-safe. If you mkdir -p a/b and -# mkdir -p a/c at the same time, both will detect that a is missing, -# one will create a, then the other will try to create a and die with -# a "File exists" error. This is a problem when calling mkinstalldirs -# from a parallel make. We use --version in the probe to restrict -# ourselves to GNU mkdir, which is thread-safe. -case $dirmode in - '') - if mkdir -p --version . >/dev/null 2>&1 && test ! -d ./--version; then - echo "mkdir -p -- $*" - exec mkdir -p -- "$@" - else - # On NextStep and OpenStep, the 'mkdir' command does not - # recognize any option. It will interpret all options as - # directories to create, and then abort because '.' already - # exists. - test -d ./-p && rmdir ./-p - test -d ./--version && rmdir ./--version - fi - ;; - *) - if mkdir -m "$dirmode" -p --version . >/dev/null 2>&1 && - test ! -d ./--version; then - echo "mkdir -m $dirmode -p -- $*" - exec mkdir -m "$dirmode" -p -- "$@" - else - # Clean up after NextStep and OpenStep mkdir. - for d in ./-m ./-p ./--version "./$dirmode"; - do - test -d $d && rmdir $d - done - fi - ;; -esac - -for file -do - case $file in - /*) pathcomp=/ ;; - *) pathcomp= ;; - esac - oIFS=$IFS - IFS=/ - set fnord $file - shift - IFS=$oIFS - - for d - do - test "x$d" = x && continue - - pathcomp=$pathcomp$d - case $pathcomp in - -*) pathcomp=./$pathcomp ;; - esac - - if test ! -d "$pathcomp"; then - echo "mkdir $pathcomp" - - mkdir "$pathcomp" || lasterr=$? - - if test ! -d "$pathcomp"; then - errstatus=$lasterr - else - if test ! -z "$dirmode"; then - echo "chmod $dirmode $pathcomp" - lasterr= - chmod "$dirmode" "$pathcomp" || lasterr=$? - - if test ! -z "$lasterr"; then - errstatus=$lasterr - fi - fi - fi - fi - - pathcomp=$pathcomp/ - done -done - -exit $errstatus - -# Local Variables: -# mode: shell-script -# sh-indentation: 2 -# eval: (add-hook 'write-file-hooks 'time-stamp) -# time-stamp-start: "scriptversion=" -# time-stamp-format: "%:y-%02m-%02d.%02H" -# time-stamp-time-zone: "UTC" -# time-stamp-end: "; # UTC" -# End: diff -Nru gnucobol-4.0~early~20200606/build_aux/pre-inst-env.in gnucobol-5/build_aux/pre-inst-env.in --- gnucobol-4.0~early~20200606/build_aux/pre-inst-env.in 2020-06-06 20:52:02.000000000 +0000 +++ gnucobol-5/build_aux/pre-inst-env.in 1970-01-01 00:00:00.000000000 +0000 @@ -1,68 +0,0 @@ -#! /bin/sh -# -# pre-inst-env gnucobol -# -# Copyright (C) 2017,2019 Free Software Foundation, Inc. -# Written by Mathieu Lirzin, Simon Sobisch, -# -# This file is part of GnuCOBOL. -# -# The GnuCOBOL compiler is free software: you can redistribute it -# and/or modify it under the terms of the GNU General Public License -# as published by the Free Software Foundation, either version 3 of the -# License, or (at your option) any later version. -# -# GnuCOBOL is distributed in the hope that it will be useful, -# but WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -# GNU General Public License for more details. -# -# You should have received a copy of the GNU General Public License -# along with GnuCOBOL. If not, see . - -abs_top_srcdir="@abs_top_srcdir@" -abs_top_builddir="@abs_top_builddir@" - -sep='@PATH_SEPARATOR@' - -PATH="$abs_top_builddir/cobc/.libs${sep}$abs_top_builddir/cobc${sep}$PATH" -PATH="$abs_top_builddir/bin/.libs${sep}$abs_top_builddir/bin${sep}$PATH" -PATH="$abs_top_builddir/libcob/.libs${sep}$abs_top_builddir/libcob${sep}$PATH" -export PATH - - -# trigger the preference of local instead of installed files -#GNUCOBOL_UNINSTALLED=1 -#export GNUCOBOL_UNINSTALLED - -# let atlocal know that there's less to setup -GNUCOBOL_ENV_SETUP=1 -export GNUCOBOL_ENV_SETUP - -# options that are also used in atlocal (always add to both) -COB_CFLAGS="-I${abs_top_srcdir} @COB_CFLAGS@" -COB_LDFLAGS="@COB_LDFLAGS@" -COB_LIBS="-L${abs_top_builddir}/libcob/.libs -lcob @LIBCOB_LIBS@" -COB_CONFIG_DIR="${abs_top_srcdir}/config" -COB_COPY_DIR="${abs_top_srcdir}/copy" -LD_LIBRARY_PATH="${abs_top_builddir}/libcob/.libs:$LD_LIBRARY_PATH" -DYLD_LIBRARY_PATH="${abs_top_builddir}/libcob/.libs:$DYLD_LIBRARY_PATH" -SHLIB_PATH="${abs_top_builddir}/libcob/.libs:$SHLIB_PATH" -LIBPATH="${abs_top_builddir}/libcob/.libs:$LIBPATH" -COB_LIBRARY_PATH="${abs_top_builddir}/extras:$COB_LIBRARY_PATH" - -export COB_CFLAGS COB_LDFLAGS COB_LIBS -export COB_CONFIG_DIR COB_COPY_DIR -export LD_LIBRARY_PATH DYLD_LIBRARY_PATH SHLIB_PATH LIBPATH -export COB_LIBRARY_PATH - -# not robust check, but better than none -if test "x${BASH_SOURCE}" != "x" -a "${BASH_SOURCE}" != "$0"; then - echo "This script should not be sourced but called instead!" -else - if test "x$1" != "x"; then - exec "$@" - else - $SHELL - fi -fi diff -Nru gnucobol-4.0~early~20200606/build_aux/texinfo.tex gnucobol-5/build_aux/texinfo.tex --- gnucobol-4.0~early~20200606/build_aux/texinfo.tex 2020-06-06 20:52:02.000000000 +0000 +++ gnucobol-5/build_aux/texinfo.tex 1970-01-01 00:00:00.000000000 +0000 @@ -1,11561 +0,0 @@ -% texinfo.tex -- TeX macros to handle Texinfo files. -% -% Load plain if necessary, i.e., if running under initex. -\expandafter\ifx\csname fmtname\endcsname\relax\input plain\fi -% -\def\texinfoversion{2019-03-16.20} - -% -% Copyright 1985, 1986, 1988, 1990-2019 Free Software Foundation, Inc. -% -% This texinfo.tex file is free software: you can redistribute it and/or -% modify it under the terms of the GNU General Public License as -% published by the Free Software Foundation, either version 3 of the -% License, or (at your option) any later version. -% -% This texinfo.tex file is distributed in the hope that it will be -% useful, but WITHOUT ANY WARRANTY; without even the implied warranty -% of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU -% General Public License for more details. -% -% You should have received a copy of the GNU General Public License -% along with this program. If not, see . -% -% As a special exception, when this file is read by TeX when processing -% a Texinfo source document, you may use the result without -% restriction. This Exception is an additional permission under section 7 -% of the GNU General Public License, version 3 ("GPLv3"). -% -% Please try the latest version of texinfo.tex before submitting bug -% reports; you can get the latest version from: -% https://ftp.gnu.org/gnu/texinfo/ (the Texinfo release area), or -% https://ftpmirror.gnu.org/texinfo/ (same, via a mirror), or -% https://www.gnu.org/software/texinfo/ (the Texinfo home page) -% The texinfo.tex in any given distribution could well be out -% of date, so if that's what you're using, please check. -% -% Send bug reports to bug-texinfo@gnu.org. Please include including a -% complete document in each bug report with which we can reproduce the -% problem. Patches are, of course, greatly appreciated. -% -% To process a Texinfo manual with TeX, it's most reliable to use the -% texi2dvi shell script that comes with the distribution. For a simple -% manual foo.texi, however, you can get away with this: -% tex foo.texi -% texindex foo.?? -% tex foo.texi -% tex foo.texi -% dvips foo.dvi -o # or whatever; this makes foo.ps. -% The extra TeX runs get the cross-reference information correct. -% Sometimes one run after texindex suffices, and sometimes you need more -% than two; texi2dvi does it as many times as necessary. -% -% It is possible to adapt texinfo.tex for other languages, to some -% extent. You can get the existing language-specific files from the -% full Texinfo distribution. -% -% The GNU Texinfo home page is https://www.gnu.org/software/texinfo. - - -\message{Loading texinfo [version \texinfoversion]:} - -% If in a .fmt file, print the version number -% and turn on active characters that we couldn't do earlier because -% they might have appeared in the input file name. -\everyjob{\message{[Texinfo version \texinfoversion]}% - \catcode`+=\active \catcode`\_=\active} - -% LaTeX's \typeout. This ensures that the messages it is used for -% are identical in format to the corresponding ones from latex/pdflatex. -\def\typeout{\immediate\write17}% - -\chardef\other=12 - -% We never want plain's \outer definition of \+ in Texinfo. -% For @tex, we can use \tabalign. -\let\+ = \relax - -% Save some plain tex macros whose names we will redefine. -\let\ptexb=\b -\let\ptexbullet=\bullet -\let\ptexc=\c -\let\ptexcomma=\, -\let\ptexdot=\. -\let\ptexdots=\dots -\let\ptexend=\end -\let\ptexequiv=\equiv -\let\ptexexclam=\! -\let\ptexfootnote=\footnote -\let\ptexgtr=> -\let\ptexhat=^ -\let\ptexi=\i -\let\ptexindent=\indent -\let\ptexinsert=\insert -\let\ptexlbrace=\{ -\let\ptexless=< -\let\ptexnewwrite\newwrite -\let\ptexnoindent=\noindent -\let\ptexplus=+ -\let\ptexraggedright=\raggedright -\let\ptexrbrace=\} -\let\ptexslash=\/ -\let\ptexsp=\sp -\let\ptexstar=\* -\let\ptexsup=\sup -\let\ptext=\t -\let\ptextop=\top -{\catcode`\'=\active \global\let\ptexquoteright'}% active in plain's math mode - -% If this character appears in an error message or help string, it -% starts a new line in the output. -\newlinechar = `^^J - -% Use TeX 3.0's \inputlineno to get the line number, for better error -% messages, but if we're using an old version of TeX, don't do anything. -% -\ifx\inputlineno\thisisundefined - \let\linenumber = \empty % Pre-3.0. -\else - \def\linenumber{l.\the\inputlineno:\space} -\fi - -% Set up fixed words for English if not already set. -\ifx\putwordAppendix\undefined \gdef\putwordAppendix{Appendix}\fi -\ifx\putwordChapter\undefined \gdef\putwordChapter{Chapter}\fi -\ifx\putworderror\undefined \gdef\putworderror{error}\fi -\ifx\putwordfile\undefined \gdef\putwordfile{file}\fi -\ifx\putwordin\undefined \gdef\putwordin{in}\fi -\ifx\putwordIndexIsEmpty\undefined \gdef\putwordIndexIsEmpty{(Index is empty)}\fi -\ifx\putwordIndexNonexistent\undefined \gdef\putwordIndexNonexistent{(Index is nonexistent)}\fi -\ifx\putwordInfo\undefined \gdef\putwordInfo{Info}\fi -\ifx\putwordInstanceVariableof\undefined \gdef\putwordInstanceVariableof{Instance Variable of}\fi -\ifx\putwordMethodon\undefined \gdef\putwordMethodon{Method on}\fi -\ifx\putwordNoTitle\undefined \gdef\putwordNoTitle{No Title}\fi -\ifx\putwordof\undefined \gdef\putwordof{of}\fi -\ifx\putwordon\undefined \gdef\putwordon{on}\fi -\ifx\putwordpage\undefined \gdef\putwordpage{page}\fi -\ifx\putwordsection\undefined \gdef\putwordsection{section}\fi -\ifx\putwordSection\undefined \gdef\putwordSection{Section}\fi -\ifx\putwordsee\undefined \gdef\putwordsee{see}\fi -\ifx\putwordSee\undefined \gdef\putwordSee{See}\fi -\ifx\putwordShortTOC\undefined \gdef\putwordShortTOC{Short Contents}\fi -\ifx\putwordTOC\undefined \gdef\putwordTOC{Table of Contents}\fi -% -\ifx\putwordMJan\undefined \gdef\putwordMJan{January}\fi -\ifx\putwordMFeb\undefined \gdef\putwordMFeb{February}\fi -\ifx\putwordMMar\undefined \gdef\putwordMMar{March}\fi -\ifx\putwordMApr\undefined \gdef\putwordMApr{April}\fi -\ifx\putwordMMay\undefined \gdef\putwordMMay{May}\fi -\ifx\putwordMJun\undefined \gdef\putwordMJun{June}\fi -\ifx\putwordMJul\undefined \gdef\putwordMJul{July}\fi -\ifx\putwordMAug\undefined \gdef\putwordMAug{August}\fi -\ifx\putwordMSep\undefined \gdef\putwordMSep{September}\fi -\ifx\putwordMOct\undefined \gdef\putwordMOct{October}\fi -\ifx\putwordMNov\undefined \gdef\putwordMNov{November}\fi -\ifx\putwordMDec\undefined \gdef\putwordMDec{December}\fi -% -\ifx\putwordDefmac\undefined \gdef\putwordDefmac{Macro}\fi -\ifx\putwordDefspec\undefined \gdef\putwordDefspec{Special Form}\fi -\ifx\putwordDefvar\undefined \gdef\putwordDefvar{Variable}\fi -\ifx\putwordDefopt\undefined \gdef\putwordDefopt{User Option}\fi -\ifx\putwordDeffunc\undefined \gdef\putwordDeffunc{Function}\fi - -% Give the space character the catcode for a space. -\def\spaceisspace{\catcode`\ =10\relax} - -% Likewise for ^^M, the end of line character. -\def\endlineisspace{\catcode13=10\relax} - -\chardef\dashChar = `\- -\chardef\slashChar = `\/ -\chardef\underChar = `\_ - -% Ignore a token. -% -\def\gobble#1{} - -% The following is used inside several \edef's. -\def\makecsname#1{\expandafter\noexpand\csname#1\endcsname} - -% Hyphenation fixes. -\hyphenation{ - Flor-i-da Ghost-script Ghost-view Mac-OS Post-Script - ap-pen-dix bit-map bit-maps - data-base data-bases eshell fall-ing half-way long-est man-u-script - man-u-scripts mini-buf-fer mini-buf-fers over-view par-a-digm - par-a-digms rath-er rec-tan-gu-lar ro-bot-ics se-vere-ly set-up spa-ces - spell-ing spell-ings - stand-alone strong-est time-stamp time-stamps which-ever white-space - wide-spread wrap-around -} - -% Sometimes it is convenient to have everything in the transcript file -% and nothing on the terminal. We don't just call \tracingall here, -% since that produces some useless output on the terminal. We also make -% some effort to order the tracing commands to reduce output in the log -% file; cf. trace.sty in LaTeX. -% -\def\gloggingall{\begingroup \globaldefs = 1 \loggingall \endgroup}% -\def\loggingall{% - \tracingstats2 - \tracingpages1 - \tracinglostchars2 % 2 gives us more in etex - \tracingparagraphs1 - \tracingoutput1 - \tracingmacros2 - \tracingrestores1 - \showboxbreadth\maxdimen \showboxdepth\maxdimen - \ifx\eTeXversion\thisisundefined\else % etex gives us more logging - \tracingscantokens1 - \tracingifs1 - \tracinggroups1 - \tracingnesting2 - \tracingassigns1 - \fi - \tracingcommands3 % 3 gives us more in etex - \errorcontextlines16 -}% - -% @errormsg{MSG}. Do the index-like expansions on MSG, but if things -% aren't perfect, it's not the end of the world, being an error message, -% after all. -% -\def\errormsg{\begingroup \indexnofonts \doerrormsg} -\def\doerrormsg#1{\errmessage{#1}} - -% add check for \lastpenalty to plain's definitions. If the last thing -% we did was a \nobreak, we don't want to insert more space. -% -\def\smallbreak{\ifnum\lastpenalty<10000\par\ifdim\lastskip<\smallskipamount - \removelastskip\penalty-50\smallskip\fi\fi} -\def\medbreak{\ifnum\lastpenalty<10000\par\ifdim\lastskip<\medskipamount - \removelastskip\penalty-100\medskip\fi\fi} -\def\bigbreak{\ifnum\lastpenalty<10000\par\ifdim\lastskip<\bigskipamount - \removelastskip\penalty-200\bigskip\fi\fi} - -% Output routine -% - -% For a final copy, take out the rectangles -% that mark overfull boxes (in case you have decided -% that the text looks ok even though it passes the margin). -% -\def\finalout{\overfullrule=0pt } - -\newdimen\outerhsize \newdimen\outervsize % set by the paper size routines -\newdimen\topandbottommargin \topandbottommargin=.75in - -% Output a mark which sets \thischapter, \thissection and \thiscolor. -% We dump everything together because we only have one kind of mark. -% This works because we only use \botmark / \topmark, not \firstmark. -% -% A mark contains a subexpression of the \ifcase ... \fi construct. -% \get*marks macros below extract the needed part using \ifcase. -% -% Another complication is to let the user choose whether \thischapter -% (\thissection) refers to the chapter (section) in effect at the top -% of a page, or that at the bottom of a page. - -% \domark is called twice inside \chapmacro, to add one -% mark before the section break, and one after. -% In the second call \prevchapterdefs is the same as \currentchapterdefs, -% and \prevsectiondefs is the same as \currentsectiondefs. -% Then if the page is not broken at the mark, some of the previous -% section appears on the page, and we can get the name of this section -% from \firstmark for @everyheadingmarks top. -% @everyheadingmarks bottom uses \botmark. -% -% See page 260 of The TeXbook. -\def\domark{% - \toks0=\expandafter{\currentchapterdefs}% - \toks2=\expandafter{\currentsectiondefs}% - \toks4=\expandafter{\prevchapterdefs}% - \toks6=\expandafter{\prevsectiondefs}% - \toks8=\expandafter{\currentcolordefs}% - \mark{% - \the\toks0 \the\toks2 % 0: marks for @everyheadingmarks top - \noexpand\or \the\toks4 \the\toks6 % 1: for @everyheadingmarks bottom - \noexpand\else \the\toks8 % 2: color marks - }% -} - -% \gettopheadingmarks, \getbottomheadingmarks, -% \getcolormarks - extract needed part of mark. -% -% \topmark doesn't work for the very first chapter (after the title -% page or the contents), so we use \firstmark there -- this gets us -% the mark with the chapter defs, unless the user sneaks in, e.g., -% @setcolor (or @url, or @link, etc.) between @contents and the very -% first @chapter. -\def\gettopheadingmarks{% - \ifcase0\the\savedtopmark\fi - \ifx\thischapter\empty \ifcase0\firstmark\fi \fi -} -\def\getbottomheadingmarks{\ifcase1\botmark\fi} -\def\getcolormarks{\ifcase2\the\savedtopmark\fi} - -% Avoid "undefined control sequence" errors. -\def\currentchapterdefs{} -\def\currentsectiondefs{} -\def\currentsection{} -\def\prevchapterdefs{} -\def\prevsectiondefs{} -\def\currentcolordefs{} - -% Margin to add to right of even pages, to left of odd pages. -\newdimen\bindingoffset -\newdimen\normaloffset -\newdimen\txipagewidth \newdimen\txipageheight - -% Main output routine. -% -\chardef\PAGE = 255 -\newtoks\defaultoutput -\defaultoutput = {\savetopmark\onepageout{\pagecontents\PAGE}} -\output=\expandafter{\the\defaultoutput} - -\newbox\headlinebox -\newbox\footlinebox - -% When outputting the double column layout for indices, an output routine -% is run several times, which hides the original value of \topmark. This -% can lead to a page heading being output and duplicating the chapter heading -% of the index. Hence, save the contents of \topmark at the beginning of -% the output routine. The saved contents are valid until we actually -% \shipout a page. -% -% (We used to run a short output routine to actually set \topmark and -% \firstmark to the right values, but if this was called with an empty page -% containing whatsits for writing index entries, the whatsits would be thrown -% away and the index auxiliary file would remain empty.) -% -\newtoks\savedtopmark -\newif\iftopmarksaved -\topmarksavedtrue -\def\savetopmark{% - \iftopmarksaved\else - \global\savedtopmark=\expandafter{\topmark}% - \global\topmarksavedtrue - \fi -} - -% \onepageout takes a vbox as an argument. -% \shipout a vbox for a single page, adding an optional header, footer -% and footnote. This also causes index entries for this page to be written -% to the auxiliary files. -% -\def\onepageout#1{% - \hoffset=\normaloffset - % - \ifodd\pageno \advance\hoffset by \bindingoffset - \else \advance\hoffset by -\bindingoffset\fi - % - % Retrieve the information for the headings from the marks in the page, - % and call Plain TeX's \makeheadline and \makefootline, which use the - % values in \headline and \footline. - % - % This is used to check if we are on the first page of a chapter. - \ifcase1\the\savedtopmark\fi - \let\prevchaptername\thischaptername - \ifcase0\firstmark\fi - \let\curchaptername\thischaptername - % - \ifodd\pageno \getoddheadingmarks \else \getevenheadingmarks \fi - % - \ifx\curchaptername\prevchaptername - \let\thischapterheading\thischapter - \else - % \thischapterheading is the same as \thischapter except it is blank - % for the first page of a chapter. This is to prevent the chapter name - % being shown twice. - \def\thischapterheading{}% - \fi - % - % Common context changes for both heading and footing. - % Do this outside of the \shipout so @code etc. will be expanded in - % the headline as they should be, not taken literally (outputting ''code). - \def\commmonheadfootline{\let\hsize=\txipagewidth \texinfochars} - % - \global\setbox\headlinebox = \vbox{\commmonheadfootline \makeheadline}% - % - \ifodd\pageno \getoddfootingmarks \else \getevenfootingmarks \fi - \global\setbox\footlinebox = \vbox{\commmonheadfootline \makefootline}% - % - {% - % Set context for writing to auxiliary files like index files. - % Have to do this stuff outside the \shipout because we want it to - % take effect in \write's, yet the group defined by the \vbox ends - % before the \shipout runs. - % - \atdummies % don't expand commands in the output. - \turnoffactive - \shipout\vbox{% - % Do this early so pdf references go to the beginning of the page. - \ifpdfmakepagedest \pdfdest name{\the\pageno} xyz\fi - % - \unvbox\headlinebox - \pagebody{#1}% - \ifdim\ht\footlinebox > 0pt - % Only leave this space if the footline is nonempty. - % (We lessened \vsize for it in \oddfootingyyy.) - % The \baselineskip=24pt in plain's \makefootline has no effect. - \vskip 24pt - \unvbox\footlinebox - \fi - % - }% - }% - \global\topmarksavedfalse - \advancepageno - \ifnum\outputpenalty>-20000 \else\dosupereject\fi -} - -\newinsert\margin \dimen\margin=\maxdimen - -% Main part of page, including any footnotes -\def\pagebody#1{\vbox to\txipageheight{\boxmaxdepth=\maxdepth #1}} -{\catcode`\@ =11 -\gdef\pagecontents#1{\ifvoid\topins\else\unvbox\topins\fi -% marginal hacks, juha@viisa.uucp (Juha Takala) -\ifvoid\margin\else % marginal info is present - \rlap{\kern\hsize\vbox to\z@{\kern1pt\box\margin \vss}}\fi -\dimen@=\dp#1\relax \unvbox#1\relax -\ifvoid\footins\else\vskip\skip\footins\footnoterule \unvbox\footins\fi -\ifr@ggedbottom \kern-\dimen@ \vfil \fi} -} - - -% Argument parsing - -% Parse an argument, then pass it to #1. The argument is the rest of -% the input line (except we remove a trailing comment). #1 should be a -% macro which expects an ordinary undelimited TeX argument. -% For example, \def\foo{\parsearg\fooxxx}. -% -\def\parsearg{\parseargusing{}} -\def\parseargusing#1#2{% - \def\argtorun{#2}% - \begingroup - \obeylines - \spaceisspace - #1% - \parseargline\empty% Insert the \empty token, see \finishparsearg below. -} - -{\obeylines % - \gdef\parseargline#1^^M{% - \endgroup % End of the group started in \parsearg. - \argremovecomment #1\comment\ArgTerm% - }% -} - -% First remove any @comment, then any @c comment. Also remove a @texinfoc -% comment (see \scanmacro for details). Pass the result on to \argcheckspaces. -\def\argremovecomment#1\comment#2\ArgTerm{\argremovec #1\c\ArgTerm} -\def\argremovec#1\c#2\ArgTerm{\argremovetexinfoc #1\texinfoc\ArgTerm} -\def\argremovetexinfoc#1\texinfoc#2\ArgTerm{\argcheckspaces#1\^^M\ArgTerm} - -% Each occurrence of `\^^M' or `\^^M' is replaced by a single space. -% -% \argremovec might leave us with trailing space, e.g., -% @end itemize @c foo -% This space token undergoes the same procedure and is eventually removed -% by \finishparsearg. -% -\def\argcheckspaces#1\^^M{\argcheckspacesX#1\^^M \^^M} -\def\argcheckspacesX#1 \^^M{\argcheckspacesY#1\^^M} -\def\argcheckspacesY#1\^^M#2\^^M#3\ArgTerm{% - \def\temp{#3}% - \ifx\temp\empty - % Do not use \next, perhaps the caller of \parsearg uses it; reuse \temp: - \let\temp\finishparsearg - \else - \let\temp\argcheckspaces - \fi - % Put the space token in: - \temp#1 #3\ArgTerm -} - -% If a _delimited_ argument is enclosed in braces, they get stripped; so -% to get _exactly_ the rest of the line, we had to prevent such situation. -% We prepended an \empty token at the very beginning and we expand it now, -% just before passing the control to \argtorun. -% (Similarly, we have to think about #3 of \argcheckspacesY above: it is -% either the null string, or it ends with \^^M---thus there is no danger -% that a pair of braces would be stripped. -% -% But first, we have to remove the trailing space token. -% -\def\finishparsearg#1 \ArgTerm{\expandafter\argtorun\expandafter{#1}} - - -% \parseargdef - define a command taking an argument on the line -% -% \parseargdef\foo{...} -% is roughly equivalent to -% \def\foo{\parsearg\Xfoo} -% \def\Xfoo#1{...} -\def\parseargdef#1{% - \expandafter \doparseargdef \csname\string#1\endcsname #1% -} -\def\doparseargdef#1#2{% - \def#2{\parsearg#1}% - \def#1##1% -} - -% Several utility definitions with active space: -{ - \obeyspaces - \gdef\obeyedspace{ } - - % Make each space character in the input produce a normal interword - % space in the output. Don't allow a line break at this space, as this - % is used only in environments like @example, where each line of input - % should produce a line of output anyway. - % - \gdef\sepspaces{\obeyspaces\let =\tie} - - % If an index command is used in an @example environment, any spaces - % therein should become regular spaces in the raw index file, not the - % expansion of \tie (\leavevmode \penalty \@M \ ). - \gdef\unsepspaces{\let =\space} -} - - -\def\flushcr{\ifx\par\lisppar \def\next##1{}\else \let\next=\relax \fi \next} - -% Define the framework for environments in texinfo.tex. It's used like this: -% -% \envdef\foo{...} -% \def\Efoo{...} -% -% It's the responsibility of \envdef to insert \begingroup before the -% actual body; @end closes the group after calling \Efoo. \envdef also -% defines \thisenv, so the current environment is known; @end checks -% whether the environment name matches. The \checkenv macro can also be -% used to check whether the current environment is the one expected. -% -% Non-false conditionals (@iftex, @ifset) don't fit into this, so they -% are not treated as environments; they don't open a group. (The -% implementation of @end takes care not to call \endgroup in this -% special case.) - - -% At run-time, environments start with this: -\def\startenvironment#1{\begingroup\def\thisenv{#1}} -% initialize -\let\thisenv\empty - -% ... but they get defined via ``\envdef\foo{...}'': -\long\def\envdef#1#2{\def#1{\startenvironment#1#2}} -\def\envparseargdef#1#2{\parseargdef#1{\startenvironment#1#2}} - -% Check whether we're in the right environment: -\def\checkenv#1{% - \def\temp{#1}% - \ifx\thisenv\temp - \else - \badenverr - \fi -} - -% Environment mismatch, #1 expected: -\def\badenverr{% - \errhelp = \EMsimple - \errmessage{This command can appear only \inenvironment\temp, - not \inenvironment\thisenv}% -} -\def\inenvironment#1{% - \ifx#1\empty - outside of any environment% - \else - in environment \expandafter\string#1% - \fi -} - -% @end foo executes the definition of \Efoo. -% But first, it executes a specialized version of \checkenv -% -\parseargdef\end{% - \if 1\csname iscond.#1\endcsname - \else - % The general wording of \badenverr may not be ideal. - \expandafter\checkenv\csname#1\endcsname - \csname E#1\endcsname - \endgroup - \fi -} - -\newhelp\EMsimple{Press RETURN to continue.} - - -% Be sure we're in horizontal mode when doing a tie, since we make space -% equivalent to this in @example-like environments. Otherwise, a space -% at the beginning of a line will start with \penalty -- and -% since \penalty is valid in vertical mode, we'd end up putting the -% penalty on the vertical list instead of in the new paragraph. -{\catcode`@ = 11 - % Avoid using \@M directly, because that causes trouble - % if the definition is written into an index file. - \global\let\tiepenalty = \@M - \gdef\tie{\leavevmode\penalty\tiepenalty\ } -} - -% @: forces normal size whitespace following. -\def\:{\spacefactor=1000 } - -% @* forces a line break. -\def\*{\unskip\hfil\break\hbox{}\ignorespaces} - -% @/ allows a line break. -\let\/=\allowbreak - -% @. is an end-of-sentence period. -\def\.{.\spacefactor=\endofsentencespacefactor\space} - -% @! is an end-of-sentence bang. -\def\!{!\spacefactor=\endofsentencespacefactor\space} - -% @? is an end-of-sentence query. -\def\?{?\spacefactor=\endofsentencespacefactor\space} - -% @frenchspacing on|off says whether to put extra space after punctuation. -% -\def\onword{on} -\def\offword{off} -% -\parseargdef\frenchspacing{% - \def\temp{#1}% - \ifx\temp\onword \plainfrenchspacing - \else\ifx\temp\offword \plainnonfrenchspacing - \else - \errhelp = \EMsimple - \errmessage{Unknown @frenchspacing option `\temp', must be on|off}% - \fi\fi -} - -% @w prevents a word break. Without the \leavevmode, @w at the -% beginning of a paragraph, when TeX is still in vertical mode, would -% produce a whole line of output instead of starting the paragraph. -\def\w#1{\leavevmode\hbox{#1}} - -% @group ... @end group forces ... to be all on one page, by enclosing -% it in a TeX vbox. We use \vtop instead of \vbox to construct the box -% to keep its height that of a normal line. According to the rules for -% \topskip (p.114 of the TeXbook), the glue inserted is -% max (\topskip - \ht (first item), 0). If that height is large, -% therefore, no glue is inserted, and the space between the headline and -% the text is small, which looks bad. -% -% Another complication is that the group might be very large. This can -% cause the glue on the previous page to be unduly stretched, because it -% does not have much material. In this case, it's better to add an -% explicit \vfill so that the extra space is at the bottom. The -% threshold for doing this is if the group is more than \vfilllimit -% percent of a page (\vfilllimit can be changed inside of @tex). -% -\newbox\groupbox -\def\vfilllimit{0.7} -% -\envdef\group{% - \ifnum\catcode`\^^M=\active \else - \errhelp = \groupinvalidhelp - \errmessage{@group invalid in context where filling is enabled}% - \fi - \startsavinginserts - % - \setbox\groupbox = \vtop\bgroup - % Do @comment since we are called inside an environment such as - % @example, where each end-of-line in the input causes an - % end-of-line in the output. We don't want the end-of-line after - % the `@group' to put extra space in the output. Since @group - % should appear on a line by itself (according to the Texinfo - % manual), we don't worry about eating any user text. - \comment -} -% -% The \vtop produces a box with normal height and large depth; thus, TeX puts -% \baselineskip glue before it, and (when the next line of text is done) -% \lineskip glue after it. Thus, space below is not quite equal to space -% above. But it's pretty close. -\def\Egroup{% - % To get correct interline space between the last line of the group - % and the first line afterwards, we have to propagate \prevdepth. - \endgraf % Not \par, as it may have been set to \lisppar. - \global\dimen1 = \prevdepth - \egroup % End the \vtop. - \addgroupbox - \prevdepth = \dimen1 - \checkinserts -} - -\def\addgroupbox{ - % \dimen0 is the vertical size of the group's box. - \dimen0 = \ht\groupbox \advance\dimen0 by \dp\groupbox - % \dimen2 is how much space is left on the page (more or less). - \dimen2 = \txipageheight \advance\dimen2 by -\pagetotal - % if the group doesn't fit on the current page, and it's a big big - % group, force a page break. - \ifdim \dimen0 > \dimen2 - \ifdim \pagetotal < \vfilllimit\txipageheight - \page - \fi - \fi - \box\groupbox -} - -% -% TeX puts in an \escapechar (i.e., `@') at the beginning of the help -% message, so this ends up printing `@group can only ...'. -% -\newhelp\groupinvalidhelp{% -group can only be used in environments such as @example,^^J% -where each line of input produces a line of output.} - -% @need space-in-mils -% forces a page break if there is not space-in-mils remaining. - -\newdimen\mil \mil=0.001in - -\parseargdef\need{% - % Ensure vertical mode, so we don't make a big box in the middle of a - % paragraph. - \par - % - % If the @need value is less than one line space, it's useless. - \dimen0 = #1\mil - \dimen2 = \ht\strutbox - \advance\dimen2 by \dp\strutbox - \ifdim\dimen0 > \dimen2 - % - % Do a \strut just to make the height of this box be normal, so the - % normal leading is inserted relative to the preceding line. - % And a page break here is fine. - \vtop to #1\mil{\strut\vfil}% - % - % TeX does not even consider page breaks if a penalty added to the - % main vertical list is 10000 or more. But in order to see if the - % empty box we just added fits on the page, we must make it consider - % page breaks. On the other hand, we don't want to actually break the - % page after the empty box. So we use a penalty of 9999. - % - % There is an extremely small chance that TeX will actually break the - % page at this \penalty, if there are no other feasible breakpoints in - % sight. (If the user is using lots of big @group commands, which - % almost-but-not-quite fill up a page, TeX will have a hard time doing - % good page breaking, for example.) However, I could not construct an - % example where a page broke at this \penalty; if it happens in a real - % document, then we can reconsider our strategy. - \penalty9999 - % - % Back up by the size of the box, whether we did a page break or not. - \kern -#1\mil - % - % Do not allow a page break right after this kern. - \nobreak - \fi -} - -% @br forces paragraph break (and is undocumented). - -\let\br = \par - -% @page forces the start of a new page. -% -\def\page{\par\vfill\supereject} - -% @exdent text.... -% outputs text on separate line in roman font, starting at standard page margin - -% This records the amount of indent in the innermost environment. -% That's how much \exdent should take out. -\newskip\exdentamount - -% This defn is used inside fill environments such as @defun. -\parseargdef\exdent{\hfil\break\hbox{\kern -\exdentamount{\rm#1}}\hfil\break} - -% This defn is used inside nofill environments such as @example. -\parseargdef\nofillexdent{{\advance \leftskip by -\exdentamount - \leftline{\hskip\leftskip{\rm#1}}}} - -% @inmargin{WHICH}{TEXT} puts TEXT in the WHICH margin next to the current -% paragraph. For more general purposes, use the \margin insertion -% class. WHICH is `l' or `r'. Not documented, written for gawk manual. -% -\newskip\inmarginspacing \inmarginspacing=1cm -\def\strutdepth{\dp\strutbox} -% -\def\doinmargin#1#2{\strut\vadjust{% - \nobreak - \kern-\strutdepth - \vtop to \strutdepth{% - \baselineskip=\strutdepth - \vss - % if you have multiple lines of stuff to put here, you'll need to - % make the vbox yourself of the appropriate size. - \ifx#1l% - \llap{\ignorespaces #2\hskip\inmarginspacing}% - \else - \rlap{\hskip\hsize \hskip\inmarginspacing \ignorespaces #2}% - \fi - \null - }% -}} -\def\inleftmargin{\doinmargin l} -\def\inrightmargin{\doinmargin r} -% -% @inmargin{TEXT [, RIGHT-TEXT]} -% (if RIGHT-TEXT is given, use TEXT for left page, RIGHT-TEXT for right; -% else use TEXT for both). -% -\def\inmargin#1{\parseinmargin #1,,\finish} -\def\parseinmargin#1,#2,#3\finish{% not perfect, but better than nothing. - \setbox0 = \hbox{\ignorespaces #2}% - \ifdim\wd0 > 0pt - \def\lefttext{#1}% have both texts - \def\righttext{#2}% - \else - \def\lefttext{#1}% have only one text - \def\righttext{#1}% - \fi - % - \ifodd\pageno - \def\temp{\inrightmargin\righttext}% odd page -> outside is right margin - \else - \def\temp{\inleftmargin\lefttext}% - \fi - \temp -} - -% @include FILE -- \input text of FILE. -% -\def\include{\parseargusing\filenamecatcodes\includezzz} -\def\includezzz#1{% - \pushthisfilestack - \def\thisfile{#1}% - {% - \makevalueexpandable % we want to expand any @value in FILE. - \turnoffactive % and allow special characters in the expansion - \indexnofonts % Allow `@@' and other weird things in file names. - \wlog{texinfo.tex: doing @include of #1^^J}% - \edef\temp{\noexpand\input #1 }% - % - % This trickery is to read FILE outside of a group, in case it makes - % definitions, etc. - \expandafter - }\temp - \popthisfilestack -} -\def\filenamecatcodes{% - \catcode`\\=\other - \catcode`~=\other - \catcode`^=\other - \catcode`_=\other - \catcode`|=\other - \catcode`<=\other - \catcode`>=\other - \catcode`+=\other - \catcode`-=\other - \catcode`\`=\other - \catcode`\'=\other -} - -\def\pushthisfilestack{% - \expandafter\pushthisfilestackX\popthisfilestack\StackTerm -} -\def\pushthisfilestackX{% - \expandafter\pushthisfilestackY\thisfile\StackTerm -} -\def\pushthisfilestackY #1\StackTerm #2\StackTerm {% - \gdef\popthisfilestack{\gdef\thisfile{#1}\gdef\popthisfilestack{#2}}% -} - -\def\popthisfilestack{\errthisfilestackempty} -\def\errthisfilestackempty{\errmessage{Internal error: - the stack of filenames is empty.}} -% -\def\thisfile{} - -% @center line -% outputs that line, centered. -% -\parseargdef\center{% - \ifhmode - \let\centersub\centerH - \else - \let\centersub\centerV - \fi - \centersub{\hfil \ignorespaces#1\unskip \hfil}% - \let\centersub\relax % don't let the definition persist, just in case -} -\def\centerH#1{{% - \hfil\break - \advance\hsize by -\leftskip - \advance\hsize by -\rightskip - \line{#1}% - \break -}} -% -\newcount\centerpenalty -\def\centerV#1{% - % The idea here is the same as in \startdefun, \cartouche, etc.: if - % @center is the first thing after a section heading, we need to wipe - % out the negative parskip inserted by \sectionheading, but still - % prevent a page break here. - \centerpenalty = \lastpenalty - \ifnum\centerpenalty>10000 \vskip\parskip \fi - \ifnum\centerpenalty>9999 \penalty\centerpenalty \fi - \line{\kern\leftskip #1\kern\rightskip}% -} - -% @sp n outputs n lines of vertical space -% -\parseargdef\sp{\vskip #1\baselineskip} - -% @comment ...line which is ignored... -% @c is the same as @comment -% @ignore ... @end ignore is another way to write a comment - - -\def\c{\begingroup \catcode`\^^M=\active% -\catcode`\@=\other \catcode`\{=\other \catcode`\}=\other% -\cxxx} -{\catcode`\^^M=\active \gdef\cxxx#1^^M{\endgroup}} -% -\let\comment\c - -% @paragraphindent NCHARS -% We'll use ems for NCHARS, close enough. -% NCHARS can also be the word `asis' or `none'. -% We cannot feasibly implement @paragraphindent asis, though. -% -\def\asisword{asis} % no translation, these are keywords -\def\noneword{none} -% -\parseargdef\paragraphindent{% - \def\temp{#1}% - \ifx\temp\asisword - \else - \ifx\temp\noneword - \defaultparindent = 0pt - \else - \defaultparindent = #1em - \fi - \fi - \parindent = \defaultparindent -} - -% @exampleindent NCHARS -% We'll use ems for NCHARS like @paragraphindent. -% It seems @exampleindent asis isn't necessary, but -% I preserve it to make it similar to @paragraphindent. -\parseargdef\exampleindent{% - \def\temp{#1}% - \ifx\temp\asisword - \else - \ifx\temp\noneword - \lispnarrowing = 0pt - \else - \lispnarrowing = #1em - \fi - \fi -} - -% @firstparagraphindent WORD -% If WORD is `none', then suppress indentation of the first paragraph -% after a section heading. If WORD is `insert', then do indent at such -% paragraphs. -% -% The paragraph indentation is suppressed or not by calling -% \suppressfirstparagraphindent, which the sectioning commands do. -% We switch the definition of this back and forth according to WORD. -% By default, we suppress indentation. -% -\def\suppressfirstparagraphindent{\dosuppressfirstparagraphindent} -\def\insertword{insert} -% -\parseargdef\firstparagraphindent{% - \def\temp{#1}% - \ifx\temp\noneword - \let\suppressfirstparagraphindent = \dosuppressfirstparagraphindent - \else\ifx\temp\insertword - \let\suppressfirstparagraphindent = \relax - \else - \errhelp = \EMsimple - \errmessage{Unknown @firstparagraphindent option `\temp'}% - \fi\fi -} - -% Here is how we actually suppress indentation. Redefine \everypar to -% \kern backwards by \parindent, and then reset itself to empty. -% -% We also make \indent itself not actually do anything until the next -% paragraph. -% -\gdef\dosuppressfirstparagraphindent{% - \gdef\indent {\restorefirstparagraphindent \indent}% - \gdef\noindent{\restorefirstparagraphindent \noindent}% - \global\everypar = {\kern -\parindent \restorefirstparagraphindent}% -} -% -\gdef\restorefirstparagraphindent{% - \global\let\indent = \ptexindent - \global\let\noindent = \ptexnoindent - \global\everypar = {}% -} - - -% @refill is a no-op. -\let\refill=\relax - -% @setfilename INFO-FILENAME - ignored -\let\setfilename=\comment - -% @bye. -\outer\def\bye{\pagealignmacro\tracingstats=1\ptexend} - - -\message{pdf,} -% adobe `portable' document format -\newcount\tempnum -\newcount\lnkcount -\newtoks\filename -\newcount\filenamelength -\newcount\pgn -\newtoks\toksA -\newtoks\toksB -\newtoks\toksC -\newtoks\toksD -\newbox\boxA -\newbox\boxB -\newcount\countA -\newif\ifpdf -\newif\ifpdfmakepagedest - -% -% For LuaTeX -% - -\newif\iftxiuseunicodedestname -\txiuseunicodedestnamefalse % For pdfTeX etc. - -\ifx\luatexversion\thisisundefined -\else - % Use Unicode destination names - \txiuseunicodedestnametrue - % Escape PDF strings with converting UTF-16 from UTF-8 - \begingroup - \catcode`\%=12 - \directlua{ - function UTF16oct(str) - tex.sprint(string.char(0x5c) .. '376' .. string.char(0x5c) .. '377') - for c in string.utfvalues(str) do - if c < 0x10000 then - tex.sprint( - string.format(string.char(0x5c) .. string.char(0x25) .. '03o' .. - string.char(0x5c) .. string.char(0x25) .. '03o', - (c / 256), (c % 256))) - else - c = c - 0x10000 - local c_hi = c / 1024 + 0xd800 - local c_lo = c % 1024 + 0xdc00 - tex.sprint( - string.format(string.char(0x5c) .. string.char(0x25) .. '03o' .. - string.char(0x5c) .. string.char(0x25) .. '03o' .. - string.char(0x5c) .. string.char(0x25) .. '03o' .. - string.char(0x5c) .. string.char(0x25) .. '03o', - (c_hi / 256), (c_hi % 256), - (c_lo / 256), (c_lo % 256))) - end - end - end - } - \endgroup - \def\pdfescapestrutfsixteen#1{\directlua{UTF16oct('\luaescapestring{#1}')}} - % Escape PDF strings without converting - \begingroup - \directlua{ - function PDFescstr(str) - for c in string.bytes(str) do - if c <= 0x20 or c >= 0x80 or c == 0x28 or c == 0x29 or c == 0x5c then - tex.sprint( - string.format(string.char(0x5c) .. string.char(0x25) .. '03o', - c)) - else - tex.sprint(string.char(c)) - end - end - end - } - \endgroup - \def\pdfescapestring#1{\directlua{PDFescstr('\luaescapestring{#1}')}} - \ifnum\luatexversion>84 - % For LuaTeX >= 0.85 - \def\pdfdest{\pdfextension dest} - \let\pdfoutput\outputmode - \def\pdfliteral{\pdfextension literal} - \def\pdfcatalog{\pdfextension catalog} - \def\pdftexversion{\numexpr\pdffeedback version\relax} - \let\pdfximage\saveimageresource - \let\pdfrefximage\useimageresource - \let\pdflastximage\lastsavedimageresourceindex - \def\pdfendlink{\pdfextension endlink\relax} - \def\pdfoutline{\pdfextension outline} - \def\pdfstartlink{\pdfextension startlink} - \def\pdffontattr{\pdfextension fontattr} - \def\pdfobj{\pdfextension obj} - \def\pdflastobj{\numexpr\pdffeedback lastobj\relax} - \let\pdfpagewidth\pagewidth - \let\pdfpageheight\pageheight - \edef\pdfhorigin{\pdfvariable horigin} - \edef\pdfvorigin{\pdfvariable vorigin} - \fi -\fi - -% when pdftex is run in dvi mode, \pdfoutput is defined (so \pdfoutput=1 -% can be set). So we test for \relax and 0 as well as being undefined. -\ifx\pdfoutput\thisisundefined -\else - \ifx\pdfoutput\relax - \else - \ifcase\pdfoutput - \else - \pdftrue - \fi - \fi -\fi - -\newif\ifpdforxetex -\pdforxetexfalse -\ifpdf - \pdforxetextrue -\fi -\ifx\XeTeXrevision\thisisundefined\else - \pdforxetextrue -\fi - - -% PDF uses PostScript string constants for the names of xref targets, -% for display in the outlines, and in other places. Thus, we have to -% double any backslashes. Otherwise, a name like "\node" will be -% interpreted as a newline (\n), followed by o, d, e. Not good. -% -% See http://www.ntg.nl/pipermail/ntg-pdftex/2004-July/000654.html and -% related messages. The final outcome is that it is up to the TeX user -% to double the backslashes and otherwise make the string valid, so -% that's what we do. pdftex 1.30.0 (ca.2005) introduced a primitive to -% do this reliably, so we use it. - -% #1 is a control sequence in which to do the replacements, -% which we \xdef. -\def\txiescapepdf#1{% - \ifx\pdfescapestring\thisisundefined - % No primitive available; should we give a warning or log? - % Many times it won't matter. - \xdef#1{#1}% - \else - % The expandable \pdfescapestring primitive escapes parentheses, - % backslashes, and other special chars. - \xdef#1{\pdfescapestring{#1}}% - \fi -} -\def\txiescapepdfutfsixteen#1{% - \ifx\pdfescapestrutfsixteen\thisisundefined - % No UTF-16 converting macro available. - \txiescapepdf{#1}% - \else - \xdef#1{\pdfescapestrutfsixteen{#1}}% - \fi -} - -\newhelp\nopdfimagehelp{Texinfo supports .png, .jpg, .jpeg, and .pdf images -with PDF output, and none of those formats could be found. (.eps cannot -be supported due to the design of the PDF format; use regular TeX (DVI -output) for that.)} - -\ifpdf - % - % Color manipulation macros using ideas from pdfcolor.tex, - % except using rgb instead of cmyk; the latter is said to render as a - % very dark gray on-screen and a very dark halftone in print, instead - % of actual black. The dark red here is dark enough to print on paper as - % nearly black, but still distinguishable for online viewing. We use - % black by default, though. - \def\rgbDarkRed{0.50 0.09 0.12} - \def\rgbBlack{0 0 0} - % - % rg sets the color for filling (usual text, etc.); - % RG sets the color for stroking (thin rules, e.g., normal _'s). - \def\pdfsetcolor#1{\pdfliteral{#1 rg #1 RG}} - % - % Set color, and create a mark which defines \thiscolor accordingly, - % so that \makeheadline knows which color to restore. - \def\setcolor#1{% - \xdef\currentcolordefs{\gdef\noexpand\thiscolor{#1}}% - \domark - \pdfsetcolor{#1}% - } - % - \def\maincolor{\rgbBlack} - \pdfsetcolor{\maincolor} - \edef\thiscolor{\maincolor} - \def\currentcolordefs{} - % - \def\makefootline{% - \baselineskip24pt - \line{\pdfsetcolor{\maincolor}\the\footline}% - } - % - \def\makeheadline{% - \vbox to 0pt{% - \vskip-22.5pt - \line{% - \vbox to8.5pt{}% - % Extract \thiscolor definition from the marks. - \getcolormarks - % Typeset the headline with \maincolor, then restore the color. - \pdfsetcolor{\maincolor}\the\headline\pdfsetcolor{\thiscolor}% - }% - \vss - }% - \nointerlineskip - } - % - % - \pdfcatalog{/PageMode /UseOutlines} - % - % #1 is image name, #2 width (might be empty/whitespace), #3 height (ditto). - \def\dopdfimage#1#2#3{% - \def\pdfimagewidth{#2}\setbox0 = \hbox{\ignorespaces #2}% - \def\pdfimageheight{#3}\setbox2 = \hbox{\ignorespaces #3}% - % - % pdftex (and the PDF format) support .pdf, .png, .jpg (among - % others). Let's try in that order, PDF first since if - % someone has a scalable image, presumably better to use that than a - % bitmap. - \let\pdfimgext=\empty - \begingroup - \openin 1 #1.pdf \ifeof 1 - \openin 1 #1.PDF \ifeof 1 - \openin 1 #1.png \ifeof 1 - \openin 1 #1.jpg \ifeof 1 - \openin 1 #1.jpeg \ifeof 1 - \openin 1 #1.JPG \ifeof 1 - \errhelp = \nopdfimagehelp - \errmessage{Could not find image file #1 for pdf}% - \else \gdef\pdfimgext{JPG}% - \fi - \else \gdef\pdfimgext{jpeg}% - \fi - \else \gdef\pdfimgext{jpg}% - \fi - \else \gdef\pdfimgext{png}% - \fi - \else \gdef\pdfimgext{PDF}% - \fi - \else \gdef\pdfimgext{pdf}% - \fi - \closein 1 - \endgroup - % - % without \immediate, ancient pdftex seg faults when the same image is - % included twice. (Version 3.14159-pre-1.0-unofficial-20010704.) - \ifnum\pdftexversion < 14 - \immediate\pdfimage - \else - \immediate\pdfximage - \fi - \ifdim \wd0 >0pt width \pdfimagewidth \fi - \ifdim \wd2 >0pt height \pdfimageheight \fi - \ifnum\pdftexversion<13 - #1.\pdfimgext - \else - {#1.\pdfimgext}% - \fi - \ifnum\pdftexversion < 14 \else - \pdfrefximage \pdflastximage - \fi} - % - \def\setpdfdestname#1{{% - % We have to set dummies so commands such as @code, and characters - % such as \, aren't expanded when present in a section title. - \indexnofonts - \makevalueexpandable - \turnoffactive - \iftxiuseunicodedestname - \ifx \declaredencoding \latone - % Pass through Latin-1 characters. - % LuaTeX with byte wise I/O converts Latin-1 characters to Unicode. - \else - \ifx \declaredencoding \utfeight - % Pass through Unicode characters. - \else - % Use ASCII approximations in destination names. - \passthroughcharsfalse - \fi - \fi - \else - % Use ASCII approximations in destination names. - \passthroughcharsfalse - \fi - \def\pdfdestname{#1}% - \txiescapepdf\pdfdestname - }} - % - \def\setpdfoutlinetext#1{{% - \indexnofonts - \makevalueexpandable - \turnoffactive - \ifx \declaredencoding \latone - % The PDF format can use an extended form of Latin-1 in bookmark - % strings. See Appendix D of the PDF Reference, Sixth Edition, for - % the "PDFDocEncoding". - \passthroughcharstrue - % Pass through Latin-1 characters. - % LuaTeX: Convert to Unicode - % pdfTeX: Use Latin-1 as PDFDocEncoding - \def\pdfoutlinetext{#1}% - \else - \ifx \declaredencoding \utfeight - \ifx\luatexversion\thisisundefined - % For pdfTeX with UTF-8. - % TODO: the PDF format can use UTF-16 in bookmark strings, - % but the code for this isn't done yet. - % Use ASCII approximations. - \passthroughcharsfalse - \def\pdfoutlinetext{#1}% - \else - % For LuaTeX with UTF-8. - % Pass through Unicode characters for title texts. - \passthroughcharstrue - \def\pdfoutlinetext{#1}% - \fi - \else - % For non-Latin-1 or non-UTF-8 encodings. - % Use ASCII approximations. - \passthroughcharsfalse - \def\pdfoutlinetext{#1}% - \fi - \fi - % LuaTeX: Convert to UTF-16 - % pdfTeX: Use Latin-1 as PDFDocEncoding - \txiescapepdfutfsixteen\pdfoutlinetext - }} - % - \def\pdfmkdest#1{% - \setpdfdestname{#1}% - \safewhatsit{\pdfdest name{\pdfdestname} xyz}% - } - % - % used to mark target names; must be expandable. - \def\pdfmkpgn#1{#1} - % - % by default, use black for everything. - \def\urlcolor{\rgbBlack} - \def\linkcolor{\rgbBlack} - \def\endlink{\setcolor{\maincolor}\pdfendlink} - % - % Adding outlines to PDF; macros for calculating structure of outlines - % come from Petr Olsak - \def\expnumber#1{\expandafter\ifx\csname#1\endcsname\relax 0% - \else \csname#1\endcsname \fi} - \def\advancenumber#1{\tempnum=\expnumber{#1}\relax - \advance\tempnum by 1 - \expandafter\xdef\csname#1\endcsname{\the\tempnum}} - % - % #1 is the section text, which is what will be displayed in the - % outline by the pdf viewer. #2 is the pdf expression for the number - % of subentries (or empty, for subsubsections). #3 is the node text, - % which might be empty if this toc entry had no corresponding node. - % #4 is the page number - % - \def\dopdfoutline#1#2#3#4{% - % Generate a link to the node text if that exists; else, use the - % page number. We could generate a destination for the section - % text in the case where a section has no node, but it doesn't - % seem worth the trouble, since most documents are normally structured. - \setpdfoutlinetext{#1} - \setpdfdestname{#3} - \ifx\pdfdestname\empty - \def\pdfdestname{#4}% - \fi - % - \pdfoutline goto name{\pdfmkpgn{\pdfdestname}}#2{\pdfoutlinetext}% - } - % - \def\pdfmakeoutlines{% - \begingroup - % Read toc silently, to get counts of subentries for \pdfoutline. - \def\partentry##1##2##3##4{}% ignore parts in the outlines - \def\numchapentry##1##2##3##4{% - \def\thischapnum{##2}% - \def\thissecnum{0}% - \def\thissubsecnum{0}% - }% - \def\numsecentry##1##2##3##4{% - \advancenumber{chap\thischapnum}% - \def\thissecnum{##2}% - \def\thissubsecnum{0}% - }% - \def\numsubsecentry##1##2##3##4{% - \advancenumber{sec\thissecnum}% - \def\thissubsecnum{##2}% - }% - \def\numsubsubsecentry##1##2##3##4{% - \advancenumber{subsec\thissubsecnum}% - }% - \def\thischapnum{0}% - \def\thissecnum{0}% - \def\thissubsecnum{0}% - % - % use \def rather than \let here because we redefine \chapentry et - % al. a second time, below. - \def\appentry{\numchapentry}% - \def\appsecentry{\numsecentry}% - \def\appsubsecentry{\numsubsecentry}% - \def\appsubsubsecentry{\numsubsubsecentry}% - \def\unnchapentry{\numchapentry}% - \def\unnsecentry{\numsecentry}% - \def\unnsubsecentry{\numsubsecentry}% - \def\unnsubsubsecentry{\numsubsubsecentry}% - \readdatafile{toc}% - % - % Read toc second time, this time actually producing the outlines. - % The `-' means take the \expnumber as the absolute number of - % subentries, which we calculated on our first read of the .toc above. - % - % We use the node names as the destinations. - \def\numchapentry##1##2##3##4{% - \dopdfoutline{##1}{count-\expnumber{chap##2}}{##3}{##4}}% - \def\numsecentry##1##2##3##4{% - \dopdfoutline{##1}{count-\expnumber{sec##2}}{##3}{##4}}% - \def\numsubsecentry##1##2##3##4{% - \dopdfoutline{##1}{count-\expnumber{subsec##2}}{##3}{##4}}% - \def\numsubsubsecentry##1##2##3##4{% count is always zero - \dopdfoutline{##1}{}{##3}{##4}}% - % - % PDF outlines are displayed using system fonts, instead of - % document fonts. Therefore we cannot use special characters, - % since the encoding is unknown. For example, the eogonek from - % Latin 2 (0xea) gets translated to a | character. Info from - % Staszek Wawrykiewicz, 19 Jan 2004 04:09:24 +0100. - % - % TODO this right, we have to translate 8-bit characters to - % their "best" equivalent, based on the @documentencoding. Too - % much work for too little return. Just use the ASCII equivalents - % we use for the index sort strings. - % - \indexnofonts - \setupdatafile - % We can have normal brace characters in the PDF outlines, unlike - % Texinfo index files. So set that up. - \def\{{\lbracecharliteral}% - \def\}{\rbracecharliteral}% - \catcode`\\=\active \otherbackslash - \input \tocreadfilename - \endgroup - } - {\catcode`[=1 \catcode`]=2 - \catcode`{=\other \catcode`}=\other - \gdef\lbracecharliteral[{]% - \gdef\rbracecharliteral[}]% - ] - % - \def\skipspaces#1{\def\PP{#1}\def\D{|}% - \ifx\PP\D\let\nextsp\relax - \else\let\nextsp\skipspaces - \addtokens{\filename}{\PP}% - \advance\filenamelength by 1 - \fi - \nextsp} - \def\getfilename#1{% - \filenamelength=0 - % If we don't expand the argument now, \skipspaces will get - % snagged on things like "@value{foo}". - \edef\temp{#1}% - \expandafter\skipspaces\temp|\relax - } - \ifnum\pdftexversion < 14 - \let \startlink \pdfannotlink - \else - \let \startlink \pdfstartlink - \fi - % make a live url in pdf output. - \def\pdfurl#1{% - \begingroup - % it seems we really need yet another set of dummies; have not - % tried to figure out what each command should do in the context - % of @url. for now, just make @/ a no-op, that's the only one - % people have actually reported a problem with. - % - \normalturnoffactive - \def\@{@}% - \let\/=\empty - \makevalueexpandable - % do we want to go so far as to use \indexnofonts instead of just - % special-casing \var here? - \def\var##1{##1}% - % - \leavevmode\setcolor{\urlcolor}% - \startlink attr{/Border [0 0 0]}% - user{/Subtype /Link /A << /S /URI /URI (#1) >>}% - \endgroup} - % \pdfgettoks - Surround page numbers in #1 with @pdflink. #1 may - % be a simple number, or a list of numbers in the case of an index - % entry. - \def\pdfgettoks#1.{\setbox\boxA=\hbox{\toksA={#1.}\toksB={}\maketoks}} - \def\addtokens#1#2{\edef\addtoks{\noexpand#1={\the#1#2}}\addtoks} - \def\adn#1{\addtokens{\toksC}{#1}\global\countA=1\let\next=\maketoks} - \def\poptoks#1#2|ENDTOKS|{\let\first=#1\toksD={#1}\toksA={#2}} - \def\maketoks{% - \expandafter\poptoks\the\toksA|ENDTOKS|\relax - \ifx\first0\adn0 - \else\ifx\first1\adn1 \else\ifx\first2\adn2 \else\ifx\first3\adn3 - \else\ifx\first4\adn4 \else\ifx\first5\adn5 \else\ifx\first6\adn6 - \else\ifx\first7\adn7 \else\ifx\first8\adn8 \else\ifx\first9\adn9 - \else - \ifnum0=\countA\else\makelink\fi - \ifx\first.\let\next=\done\else - \let\next=\maketoks - \addtokens{\toksB}{\the\toksD} - \ifx\first,\addtokens{\toksB}{\space}\fi - \fi - \fi\fi\fi\fi\fi\fi\fi\fi\fi\fi - \next} - \def\makelink{\addtokens{\toksB}% - {\noexpand\pdflink{\the\toksC}}\toksC={}\global\countA=0} - \def\pdflink#1{% - \startlink attr{/Border [0 0 0]} goto name{\pdfmkpgn{#1}} - \setcolor{\linkcolor}#1\endlink} - \def\done{\edef\st{\global\noexpand\toksA={\the\toksB}}\st} -\else - % non-pdf mode - \let\pdfmkdest = \gobble - \let\pdfurl = \gobble - \let\endlink = \relax - \let\setcolor = \gobble - \let\pdfsetcolor = \gobble - \let\pdfmakeoutlines = \relax -\fi % \ifx\pdfoutput - -% -% For XeTeX -% -\ifx\XeTeXrevision\thisisundefined -\else - % - % XeTeX version check - % - \ifnum\strcmp{\the\XeTeXversion\XeTeXrevision}{0.99996}>-1 - % TeX Live 2016 contains XeTeX 0.99996 and xdvipdfmx 20160307. - % It can use the `dvipdfmx:config' special (from TeX Live SVN r40941). - % For avoiding PDF destination name replacement, we use this special - % instead of xdvipdfmx's command line option `-C 0x0010'. - \special{dvipdfmx:config C 0x0010} - % XeTeX 0.99995+ comes with xdvipdfmx 20160307+. - % It can handle Unicode destination names for PDF. - \txiuseunicodedestnametrue - \else - % XeTeX < 0.99996 (TeX Live < 2016) cannot use the - % `dvipdfmx:config' special. - % So for avoiding PDF destination name replacement, - % xdvipdfmx's command line option `-C 0x0010' is necessary. - % - % XeTeX < 0.99995 can not handle Unicode destination names for PDF - % because xdvipdfmx 20150315 has a UTF-16 conversion issue. - % It is fixed by xdvipdfmx 20160106 (TeX Live SVN r39753). - \txiuseunicodedestnamefalse - \fi - % - % Color support - % - \def\rgbDarkRed{0.50 0.09 0.12} - \def\rgbBlack{0 0 0} - % - \def\pdfsetcolor#1{\special{pdf:scolor [#1]}} - % - % Set color, and create a mark which defines \thiscolor accordingly, - % so that \makeheadline knows which color to restore. - \def\setcolor#1{% - \xdef\currentcolordefs{\gdef\noexpand\thiscolor{#1}}% - \domark - \pdfsetcolor{#1}% - } - % - \def\maincolor{\rgbBlack} - \pdfsetcolor{\maincolor} - \edef\thiscolor{\maincolor} - \def\currentcolordefs{} - % - \def\makefootline{% - \baselineskip24pt - \line{\pdfsetcolor{\maincolor}\the\footline}% - } - % - \def\makeheadline{% - \vbox to 0pt{% - \vskip-22.5pt - \line{% - \vbox to8.5pt{}% - % Extract \thiscolor definition from the marks. - \getcolormarks - % Typeset the headline with \maincolor, then restore the color. - \pdfsetcolor{\maincolor}\the\headline\pdfsetcolor{\thiscolor}% - }% - \vss - }% - \nointerlineskip - } - % - % PDF outline support - % - % Emulate pdfTeX primitive - \def\pdfdest name#1 xyz{% - \special{pdf:dest (#1) [@thispage /XYZ @xpos @ypos null]}% - } - % - \def\setpdfdestname#1{{% - % We have to set dummies so commands such as @code, and characters - % such as \, aren't expanded when present in a section title. - \indexnofonts - \makevalueexpandable - \turnoffactive - \iftxiuseunicodedestname - % Pass through Unicode characters. - \else - % Use ASCII approximations in destination names. - \passthroughcharsfalse - \fi - \def\pdfdestname{#1}% - \txiescapepdf\pdfdestname - }} - % - \def\setpdfoutlinetext#1{{% - \turnoffactive - % Always use Unicode characters in title texts. - \def\pdfoutlinetext{#1}% - % For XeTeX, xdvipdfmx converts to UTF-16. - % So we do not convert. - \txiescapepdf\pdfoutlinetext - }} - % - \def\pdfmkdest#1{% - \setpdfdestname{#1}% - \safewhatsit{\pdfdest name{\pdfdestname} xyz}% - } - % - % by default, use black for everything. - \def\urlcolor{\rgbBlack} - \def\linkcolor{\rgbBlack} - \def\endlink{\setcolor{\maincolor}\pdfendlink} - % - \def\dopdfoutline#1#2#3#4{% - \setpdfoutlinetext{#1} - \setpdfdestname{#3} - \ifx\pdfdestname\empty - \def\pdfdestname{#4}% - \fi - % - \special{pdf:out [-] #2 << /Title (\pdfoutlinetext) /A - << /S /GoTo /D (\pdfdestname) >> >> }% - } - % - \def\pdfmakeoutlines{% - \begingroup - % - % For XeTeX, counts of subentries are not necessary. - % Therefore, we read toc only once. - % - % We use node names as destinations. - \def\partentry##1##2##3##4{}% ignore parts in the outlines - \def\numchapentry##1##2##3##4{% - \dopdfoutline{##1}{1}{##3}{##4}}% - \def\numsecentry##1##2##3##4{% - \dopdfoutline{##1}{2}{##3}{##4}}% - \def\numsubsecentry##1##2##3##4{% - \dopdfoutline{##1}{3}{##3}{##4}}% - \def\numsubsubsecentry##1##2##3##4{% - \dopdfoutline{##1}{4}{##3}{##4}}% - % - \let\appentry\numchapentry% - \let\appsecentry\numsecentry% - \let\appsubsecentry\numsubsecentry% - \let\appsubsubsecentry\numsubsubsecentry% - \let\unnchapentry\numchapentry% - \let\unnsecentry\numsecentry% - \let\unnsubsecentry\numsubsecentry% - \let\unnsubsubsecentry\numsubsubsecentry% - % - % For XeTeX, xdvipdfmx converts strings to UTF-16. - % Therefore, the encoding and the language may not be considered. - % - \indexnofonts - \setupdatafile - % We can have normal brace characters in the PDF outlines, unlike - % Texinfo index files. So set that up. - \def\{{\lbracecharliteral}% - \def\}{\rbracecharliteral}% - \catcode`\\=\active \otherbackslash - \input \tocreadfilename - \endgroup - } - {\catcode`[=1 \catcode`]=2 - \catcode`{=\other \catcode`}=\other - \gdef\lbracecharliteral[{]% - \gdef\rbracecharliteral[}]% - ] - - \special{pdf:docview << /PageMode /UseOutlines >> } - % ``\special{pdf:tounicode ...}'' is not necessary - % because xdvipdfmx converts strings from UTF-8 to UTF-16 without it. - % However, due to a UTF-16 conversion issue of xdvipdfmx 20150315, - % ``\special{pdf:dest ...}'' cannot handle non-ASCII strings. - % It is fixed by xdvipdfmx 20160106 (TeX Live SVN r39753). -% - \def\skipspaces#1{\def\PP{#1}\def\D{|}% - \ifx\PP\D\let\nextsp\relax - \else\let\nextsp\skipspaces - \addtokens{\filename}{\PP}% - \advance\filenamelength by 1 - \fi - \nextsp} - \def\getfilename#1{% - \filenamelength=0 - % If we don't expand the argument now, \skipspaces will get - % snagged on things like "@value{foo}". - \edef\temp{#1}% - \expandafter\skipspaces\temp|\relax - } - % make a live url in pdf output. - \def\pdfurl#1{% - \begingroup - % it seems we really need yet another set of dummies; have not - % tried to figure out what each command should do in the context - % of @url. for now, just make @/ a no-op, that's the only one - % people have actually reported a problem with. - % - \normalturnoffactive - \def\@{@}% - \let\/=\empty - \makevalueexpandable - % do we want to go so far as to use \indexnofonts instead of just - % special-casing \var here? - \def\var##1{##1}% - % - \leavevmode\setcolor{\urlcolor}% - \special{pdf:bann << /Border [0 0 0] - /Subtype /Link /A << /S /URI /URI (#1) >> >>}% - \endgroup} - \def\endlink{\setcolor{\maincolor}\special{pdf:eann}} - \def\pdfgettoks#1.{\setbox\boxA=\hbox{\toksA={#1.}\toksB={}\maketoks}} - \def\addtokens#1#2{\edef\addtoks{\noexpand#1={\the#1#2}}\addtoks} - \def\adn#1{\addtokens{\toksC}{#1}\global\countA=1\let\next=\maketoks} - \def\poptoks#1#2|ENDTOKS|{\let\first=#1\toksD={#1}\toksA={#2}} - \def\maketoks{% - \expandafter\poptoks\the\toksA|ENDTOKS|\relax - \ifx\first0\adn0 - \else\ifx\first1\adn1 \else\ifx\first2\adn2 \else\ifx\first3\adn3 - \else\ifx\first4\adn4 \else\ifx\first5\adn5 \else\ifx\first6\adn6 - \else\ifx\first7\adn7 \else\ifx\first8\adn8 \else\ifx\first9\adn9 - \else - \ifnum0=\countA\else\makelink\fi - \ifx\first.\let\next=\done\else - \let\next=\maketoks - \addtokens{\toksB}{\the\toksD} - \ifx\first,\addtokens{\toksB}{\space}\fi - \fi - \fi\fi\fi\fi\fi\fi\fi\fi\fi\fi - \next} - \def\makelink{\addtokens{\toksB}% - {\noexpand\pdflink{\the\toksC}}\toksC={}\global\countA=0} - \def\pdflink#1{% - \special{pdf:bann << /Border [0 0 0] - /Type /Annot /Subtype /Link /A << /S /GoTo /D (#1) >> >>}% - \setcolor{\linkcolor}#1\endlink} - \def\done{\edef\st{\global\noexpand\toksA={\the\toksB}}\st} -% - % - % @image support - % - % #1 is image name, #2 width (might be empty/whitespace), #3 height (ditto). - \def\doxeteximage#1#2#3{% - \def\xeteximagewidth{#2}\setbox0 = \hbox{\ignorespaces #2}% - \def\xeteximageheight{#3}\setbox2 = \hbox{\ignorespaces #3}% - % - % XeTeX (and the PDF format) supports .pdf, .png, .jpg (among - % others). Let's try in that order, PDF first since if - % someone has a scalable image, presumably better to use that than a - % bitmap. - \let\xeteximgext=\empty - \begingroup - \openin 1 #1.pdf \ifeof 1 - \openin 1 #1.PDF \ifeof 1 - \openin 1 #1.png \ifeof 1 - \openin 1 #1.jpg \ifeof 1 - \openin 1 #1.jpeg \ifeof 1 - \openin 1 #1.JPG \ifeof 1 - \errmessage{Could not find image file #1 for XeTeX}% - \else \gdef\xeteximgext{JPG}% - \fi - \else \gdef\xeteximgext{jpeg}% - \fi - \else \gdef\xeteximgext{jpg}% - \fi - \else \gdef\xeteximgext{png}% - \fi - \else \gdef\xeteximgext{PDF}% - \fi - \else \gdef\xeteximgext{pdf}% - \fi - \closein 1 - \endgroup - % - \def\xetexpdfext{pdf}% - \ifx\xeteximgext\xetexpdfext - \XeTeXpdffile "#1".\xeteximgext "" - \else - \def\xetexpdfext{PDF}% - \ifx\xeteximgext\xetexpdfext - \XeTeXpdffile "#1".\xeteximgext "" - \else - \XeTeXpicfile "#1".\xeteximgext "" - \fi - \fi - \ifdim \wd0 >0pt width \xeteximagewidth \fi - \ifdim \wd2 >0pt height \xeteximageheight \fi \relax - } -\fi - - -% -\message{fonts,} - -% Set the baselineskip to #1, and the lineskip and strut size -% correspondingly. There is no deep meaning behind these magic numbers -% used as factors; they just match (closely enough) what Knuth defined. -% -\def\lineskipfactor{.08333} -\def\strutheightpercent{.70833} -\def\strutdepthpercent {.29167} -% -% can get a sort of poor man's double spacing by redefining this. -\def\baselinefactor{1} -% -\newdimen\textleading -\def\setleading#1{% - \dimen0 = #1\relax - \normalbaselineskip = \baselinefactor\dimen0 - \normallineskip = \lineskipfactor\normalbaselineskip - \normalbaselines - \setbox\strutbox =\hbox{% - \vrule width0pt height\strutheightpercent\baselineskip - depth \strutdepthpercent \baselineskip - }% -} - -% PDF CMaps. See also LaTeX's t1.cmap. -% -% do nothing with this by default. -\expandafter\let\csname cmapOT1\endcsname\gobble -\expandafter\let\csname cmapOT1IT\endcsname\gobble -\expandafter\let\csname cmapOT1TT\endcsname\gobble - -% if we are producing pdf, and we have \pdffontattr, then define cmaps. -% (\pdffontattr was introduced many years ago, but people still run -% older pdftex's; it's easy to conditionalize, so we do.) -\ifpdf \ifx\pdffontattr\thisisundefined \else - \begingroup - \catcode`\^^M=\active \def^^M{^^J}% Output line endings as the ^^J char. - \catcode`\%=12 \immediate\pdfobj stream {%!PS-Adobe-3.0 Resource-CMap -%%DocumentNeededResources: ProcSet (CIDInit) -%%IncludeResource: ProcSet (CIDInit) -%%BeginResource: CMap (TeX-OT1-0) -%%Title: (TeX-OT1-0 TeX OT1 0) -%%Version: 1.000 -%%EndComments -/CIDInit /ProcSet findresource begin -12 dict begin -begincmap -/CIDSystemInfo -<< /Registry (TeX) -/Ordering (OT1) -/Supplement 0 ->> def -/CMapName /TeX-OT1-0 def -/CMapType 2 def -1 begincodespacerange -<00> <7F> -endcodespacerange -8 beginbfrange -<00> <01> <0393> -<09> <0A> <03A8> -<23> <26> <0023> -<28> <3B> <0028> -<3F> <5B> <003F> -<5D> <5E> <005D> -<61> <7A> <0061> -<7B> <7C> <2013> -endbfrange -40 beginbfchar -<02> <0398> -<03> <039B> -<04> <039E> -<05> <03A0> -<06> <03A3> -<07> <03D2> -<08> <03A6> -<0B> <00660066> -<0C> <00660069> -<0D> <0066006C> -<0E> <006600660069> -<0F> <00660066006C> -<10> <0131> -<11> <0237> -<12> <0060> -<13> <00B4> -<14> <02C7> -<15> <02D8> -<16> <00AF> -<17> <02DA> -<18> <00B8> -<19> <00DF> -<1A> <00E6> -<1B> <0153> -<1C> <00F8> -<1D> <00C6> -<1E> <0152> -<1F> <00D8> -<21> <0021> -<22> <201D> -<27> <2019> -<3C> <00A1> -<3D> <003D> -<3E> <00BF> -<5C> <201C> -<5F> <02D9> -<60> <2018> -<7D> <02DD> -<7E> <007E> -<7F> <00A8> -endbfchar -endcmap -CMapName currentdict /CMap defineresource pop -end -end -%%EndResource -%%EOF - }\endgroup - \expandafter\edef\csname cmapOT1\endcsname#1{% - \pdffontattr#1{/ToUnicode \the\pdflastobj\space 0 R}% - }% -% -% \cmapOT1IT - \begingroup - \catcode`\^^M=\active \def^^M{^^J}% Output line endings as the ^^J char. - \catcode`\%=12 \immediate\pdfobj stream {%!PS-Adobe-3.0 Resource-CMap -%%DocumentNeededResources: ProcSet (CIDInit) -%%IncludeResource: ProcSet (CIDInit) -%%BeginResource: CMap (TeX-OT1IT-0) -%%Title: (TeX-OT1IT-0 TeX OT1IT 0) -%%Version: 1.000 -%%EndComments -/CIDInit /ProcSet findresource begin -12 dict begin -begincmap -/CIDSystemInfo -<< /Registry (TeX) -/Ordering (OT1IT) -/Supplement 0 ->> def -/CMapName /TeX-OT1IT-0 def -/CMapType 2 def -1 begincodespacerange -<00> <7F> -endcodespacerange -8 beginbfrange -<00> <01> <0393> -<09> <0A> <03A8> -<25> <26> <0025> -<28> <3B> <0028> -<3F> <5B> <003F> -<5D> <5E> <005D> -<61> <7A> <0061> -<7B> <7C> <2013> -endbfrange -42 beginbfchar -<02> <0398> -<03> <039B> -<04> <039E> -<05> <03A0> -<06> <03A3> -<07> <03D2> -<08> <03A6> -<0B> <00660066> -<0C> <00660069> -<0D> <0066006C> -<0E> <006600660069> -<0F> <00660066006C> -<10> <0131> -<11> <0237> -<12> <0060> -<13> <00B4> -<14> <02C7> -<15> <02D8> -<16> <00AF> -<17> <02DA> -<18> <00B8> -<19> <00DF> -<1A> <00E6> -<1B> <0153> -<1C> <00F8> -<1D> <00C6> -<1E> <0152> -<1F> <00D8> -<21> <0021> -<22> <201D> -<23> <0023> -<24> <00A3> -<27> <2019> -<3C> <00A1> -<3D> <003D> -<3E> <00BF> -<5C> <201C> -<5F> <02D9> -<60> <2018> -<7D> <02DD> -<7E> <007E> -<7F> <00A8> -endbfchar -endcmap -CMapName currentdict /CMap defineresource pop -end -end -%%EndResource -%%EOF - }\endgroup - \expandafter\edef\csname cmapOT1IT\endcsname#1{% - \pdffontattr#1{/ToUnicode \the\pdflastobj\space 0 R}% - }% -% -% \cmapOT1TT - \begingroup - \catcode`\^^M=\active \def^^M{^^J}% Output line endings as the ^^J char. - \catcode`\%=12 \immediate\pdfobj stream {%!PS-Adobe-3.0 Resource-CMap -%%DocumentNeededResources: ProcSet (CIDInit) -%%IncludeResource: ProcSet (CIDInit) -%%BeginResource: CMap (TeX-OT1TT-0) -%%Title: (TeX-OT1TT-0 TeX OT1TT 0) -%%Version: 1.000 -%%EndComments -/CIDInit /ProcSet findresource begin -12 dict begin -begincmap -/CIDSystemInfo -<< /Registry (TeX) -/Ordering (OT1TT) -/Supplement 0 ->> def -/CMapName /TeX-OT1TT-0 def -/CMapType 2 def -1 begincodespacerange -<00> <7F> -endcodespacerange -5 beginbfrange -<00> <01> <0393> -<09> <0A> <03A8> -<21> <26> <0021> -<28> <5F> <0028> -<61> <7E> <0061> -endbfrange -32 beginbfchar -<02> <0398> -<03> <039B> -<04> <039E> -<05> <03A0> -<06> <03A3> -<07> <03D2> -<08> <03A6> -<0B> <2191> -<0C> <2193> -<0D> <0027> -<0E> <00A1> -<0F> <00BF> -<10> <0131> -<11> <0237> -<12> <0060> -<13> <00B4> -<14> <02C7> -<15> <02D8> -<16> <00AF> -<17> <02DA> -<18> <00B8> -<19> <00DF> -<1A> <00E6> -<1B> <0153> -<1C> <00F8> -<1D> <00C6> -<1E> <0152> -<1F> <00D8> -<20> <2423> -<27> <2019> -<60> <2018> -<7F> <00A8> -endbfchar -endcmap -CMapName currentdict /CMap defineresource pop -end -end -%%EndResource -%%EOF - }\endgroup - \expandafter\edef\csname cmapOT1TT\endcsname#1{% - \pdffontattr#1{/ToUnicode \the\pdflastobj\space 0 R}% - }% -\fi\fi - - -% Set the font macro #1 to the font named \fontprefix#2. -% #3 is the font's design size, #4 is a scale factor, #5 is the CMap -% encoding (only OT1, OT1IT and OT1TT are allowed, or empty to omit). -% Example: -% #1 = \textrm -% #2 = \rmshape -% #3 = 10 -% #4 = \mainmagstep -% #5 = OT1 -% -\def\setfont#1#2#3#4#5{% - \font#1=\fontprefix#2#3 scaled #4 - \csname cmap#5\endcsname#1% -} -% This is what gets called when #5 of \setfont is empty. -\let\cmap\gobble -% -% (end of cmaps) - -% Use cm as the default font prefix. -% To specify the font prefix, you must define \fontprefix -% before you read in texinfo.tex. -\ifx\fontprefix\thisisundefined -\def\fontprefix{cm} -\fi -% Support font families that don't use the same naming scheme as CM. -\def\rmshape{r} -\def\rmbshape{bx} % where the normal face is bold -\def\bfshape{b} -\def\bxshape{bx} -\def\ttshape{tt} -\def\ttbshape{tt} -\def\ttslshape{sltt} -\def\itshape{ti} -\def\itbshape{bxti} -\def\slshape{sl} -\def\slbshape{bxsl} -\def\sfshape{ss} -\def\sfbshape{ss} -\def\scshape{csc} -\def\scbshape{csc} - -% Definitions for a main text size of 11pt. (The default in Texinfo.) -% -\def\definetextfontsizexi{% -% Text fonts (11.2pt, magstep1). -\def\textnominalsize{11pt} -\edef\mainmagstep{\magstephalf} -\setfont\textrm\rmshape{10}{\mainmagstep}{OT1} -\setfont\texttt\ttshape{10}{\mainmagstep}{OT1TT} -\setfont\textbf\bfshape{10}{\mainmagstep}{OT1} -\setfont\textit\itshape{10}{\mainmagstep}{OT1IT} -\setfont\textsl\slshape{10}{\mainmagstep}{OT1} -\setfont\textsf\sfshape{10}{\mainmagstep}{OT1} -\setfont\textsc\scshape{10}{\mainmagstep}{OT1} -\setfont\textttsl\ttslshape{10}{\mainmagstep}{OT1TT} -\font\texti=cmmi10 scaled \mainmagstep -\font\textsy=cmsy10 scaled \mainmagstep -\def\textecsize{1095} - -% A few fonts for @defun names and args. -\setfont\defbf\bfshape{10}{\magstep1}{OT1} -\setfont\deftt\ttshape{10}{\magstep1}{OT1TT} -\setfont\defsl\slshape{10}{\magstep1}{OT1TT} -\setfont\defttsl\ttslshape{10}{\magstep1}{OT1TT} -\def\df{\let\ttfont=\deftt \let\bffont = \defbf -\let\ttslfont=\defttsl \let\slfont=\defsl \bf} - -% Fonts for indices, footnotes, small examples (9pt). -\def\smallnominalsize{9pt} -\setfont\smallrm\rmshape{9}{1000}{OT1} -\setfont\smalltt\ttshape{9}{1000}{OT1TT} -\setfont\smallbf\bfshape{10}{900}{OT1} -\setfont\smallit\itshape{9}{1000}{OT1IT} -\setfont\smallsl\slshape{9}{1000}{OT1} -\setfont\smallsf\sfshape{9}{1000}{OT1} -\setfont\smallsc\scshape{10}{900}{OT1} -\setfont\smallttsl\ttslshape{10}{900}{OT1TT} -\font\smalli=cmmi9 -\font\smallsy=cmsy9 -\def\smallecsize{0900} - -% Fonts for small examples (8pt). -\def\smallernominalsize{8pt} -\setfont\smallerrm\rmshape{8}{1000}{OT1} -\setfont\smallertt\ttshape{8}{1000}{OT1TT} -\setfont\smallerbf\bfshape{10}{800}{OT1} -\setfont\smallerit\itshape{8}{1000}{OT1IT} -\setfont\smallersl\slshape{8}{1000}{OT1} -\setfont\smallersf\sfshape{8}{1000}{OT1} -\setfont\smallersc\scshape{10}{800}{OT1} -\setfont\smallerttsl\ttslshape{10}{800}{OT1TT} -\font\smalleri=cmmi8 -\font\smallersy=cmsy8 -\def\smallerecsize{0800} - -% Fonts for math mode superscripts (7pt). -\def\sevennominalsize{7pt} -\setfont\sevenrm\rmshape{7}{1000}{OT1} -\setfont\seventt\ttshape{10}{700}{OT1TT} -\setfont\sevenbf\bfshape{10}{700}{OT1} -\setfont\sevenit\itshape{7}{1000}{OT1IT} -\setfont\sevensl\slshape{10}{700}{OT1} -\setfont\sevensf\sfshape{10}{700}{OT1} -\setfont\sevensc\scshape{10}{700}{OT1} -\setfont\seventtsl\ttslshape{10}{700}{OT1TT} -\font\seveni=cmmi7 -\font\sevensy=cmsy7 -\def\sevenecsize{0700} - -% Fonts for title page (20.4pt): -\def\titlenominalsize{20pt} -\setfont\titlerm\rmbshape{12}{\magstep3}{OT1} -\setfont\titleit\itbshape{10}{\magstep4}{OT1IT} -\setfont\titlesl\slbshape{10}{\magstep4}{OT1} -\setfont\titlett\ttbshape{12}{\magstep3}{OT1TT} -\setfont\titlettsl\ttslshape{10}{\magstep4}{OT1TT} -\setfont\titlesf\sfbshape{17}{\magstep1}{OT1} -\let\titlebf=\titlerm -\setfont\titlesc\scbshape{10}{\magstep4}{OT1} -\font\titlei=cmmi12 scaled \magstep3 -\font\titlesy=cmsy10 scaled \magstep4 -\def\titleecsize{2074} - -% Chapter (and unnumbered) fonts (17.28pt). -\def\chapnominalsize{17pt} -\setfont\chaprm\rmbshape{12}{\magstep2}{OT1} -\setfont\chapit\itbshape{10}{\magstep3}{OT1IT} -\setfont\chapsl\slbshape{10}{\magstep3}{OT1} -\setfont\chaptt\ttbshape{12}{\magstep2}{OT1TT} -\setfont\chapttsl\ttslshape{10}{\magstep3}{OT1TT} -\setfont\chapsf\sfbshape{17}{1000}{OT1} -\let\chapbf=\chaprm -\setfont\chapsc\scbshape{10}{\magstep3}{OT1} -\font\chapi=cmmi12 scaled \magstep2 -\font\chapsy=cmsy10 scaled \magstep3 -\def\chapecsize{1728} - -% Section fonts (14.4pt). -\def\secnominalsize{14pt} -\setfont\secrm\rmbshape{12}{\magstep1}{OT1} -\setfont\secrmnotbold\rmshape{12}{\magstep1}{OT1} -\setfont\secit\itbshape{10}{\magstep2}{OT1IT} -\setfont\secsl\slbshape{10}{\magstep2}{OT1} -\setfont\sectt\ttbshape{12}{\magstep1}{OT1TT} -\setfont\secttsl\ttslshape{10}{\magstep2}{OT1TT} -\setfont\secsf\sfbshape{12}{\magstep1}{OT1} -\let\secbf\secrm -\setfont\secsc\scbshape{10}{\magstep2}{OT1} -\font\seci=cmmi12 scaled \magstep1 -\font\secsy=cmsy10 scaled \magstep2 -\def\sececsize{1440} - -% Subsection fonts (13.15pt). -\def\ssecnominalsize{13pt} -\setfont\ssecrm\rmbshape{12}{\magstephalf}{OT1} -\setfont\ssecit\itbshape{10}{1315}{OT1IT} -\setfont\ssecsl\slbshape{10}{1315}{OT1} -\setfont\ssectt\ttbshape{12}{\magstephalf}{OT1TT} -\setfont\ssecttsl\ttslshape{10}{1315}{OT1TT} -\setfont\ssecsf\sfbshape{12}{\magstephalf}{OT1} -\let\ssecbf\ssecrm -\setfont\ssecsc\scbshape{10}{1315}{OT1} -\font\sseci=cmmi12 scaled \magstephalf -\font\ssecsy=cmsy10 scaled 1315 -\def\ssececsize{1200} - -% Reduced fonts for @acronym in text (10pt). -\def\reducednominalsize{10pt} -\setfont\reducedrm\rmshape{10}{1000}{OT1} -\setfont\reducedtt\ttshape{10}{1000}{OT1TT} -\setfont\reducedbf\bfshape{10}{1000}{OT1} -\setfont\reducedit\itshape{10}{1000}{OT1IT} -\setfont\reducedsl\slshape{10}{1000}{OT1} -\setfont\reducedsf\sfshape{10}{1000}{OT1} -\setfont\reducedsc\scshape{10}{1000}{OT1} -\setfont\reducedttsl\ttslshape{10}{1000}{OT1TT} -\font\reducedi=cmmi10 -\font\reducedsy=cmsy10 -\def\reducedecsize{1000} - -\textleading = 13.2pt % line spacing for 11pt CM -\textfonts % reset the current fonts -\rm -} % end of 11pt text font size definitions, \definetextfontsizexi - - -% Definitions to make the main text be 10pt Computer Modern, with -% section, chapter, etc., sizes following suit. This is for the GNU -% Press printing of the Emacs 22 manual. Maybe other manuals in the -% future. Used with @smallbook, which sets the leading to 12pt. -% -\def\definetextfontsizex{% -% Text fonts (10pt). -\def\textnominalsize{10pt} -\edef\mainmagstep{1000} -\setfont\textrm\rmshape{10}{\mainmagstep}{OT1} -\setfont\texttt\ttshape{10}{\mainmagstep}{OT1TT} -\setfont\textbf\bfshape{10}{\mainmagstep}{OT1} -\setfont\textit\itshape{10}{\mainmagstep}{OT1IT} -\setfont\textsl\slshape{10}{\mainmagstep}{OT1} -\setfont\textsf\sfshape{10}{\mainmagstep}{OT1} -\setfont\textsc\scshape{10}{\mainmagstep}{OT1} -\setfont\textttsl\ttslshape{10}{\mainmagstep}{OT1TT} -\font\texti=cmmi10 scaled \mainmagstep -\font\textsy=cmsy10 scaled \mainmagstep -\def\textecsize{1000} - -% A few fonts for @defun names and args. -\setfont\defbf\bfshape{10}{\magstephalf}{OT1} -\setfont\deftt\ttshape{10}{\magstephalf}{OT1TT} -\setfont\defsl\slshape{10}{\magstephalf}{OT1TT} -\setfont\defttsl\ttslshape{10}{\magstephalf}{OT1TT} -\def\df{\let\ttfont=\deftt \let\bffont = \defbf -\let\slfont=\defsl \let\ttslfont=\defttsl \bf} - -% Fonts for indices, footnotes, small examples (9pt). -\def\smallnominalsize{9pt} -\setfont\smallrm\rmshape{9}{1000}{OT1} -\setfont\smalltt\ttshape{9}{1000}{OT1TT} -\setfont\smallbf\bfshape{10}{900}{OT1} -\setfont\smallit\itshape{9}{1000}{OT1IT} -\setfont\smallsl\slshape{9}{1000}{OT1} -\setfont\smallsf\sfshape{9}{1000}{OT1} -\setfont\smallsc\scshape{10}{900}{OT1} -\setfont\smallttsl\ttslshape{10}{900}{OT1TT} -\font\smalli=cmmi9 -\font\smallsy=cmsy9 -\def\smallecsize{0900} - -% Fonts for small examples (8pt). -\def\smallernominalsize{8pt} -\setfont\smallerrm\rmshape{8}{1000}{OT1} -\setfont\smallertt\ttshape{8}{1000}{OT1TT} -\setfont\smallerbf\bfshape{10}{800}{OT1} -\setfont\smallerit\itshape{8}{1000}{OT1IT} -\setfont\smallersl\slshape{8}{1000}{OT1} -\setfont\smallersf\sfshape{8}{1000}{OT1} -\setfont\smallersc\scshape{10}{800}{OT1} -\setfont\smallerttsl\ttslshape{10}{800}{OT1TT} -\font\smalleri=cmmi8 -\font\smallersy=cmsy8 -\def\smallerecsize{0800} - -% Fonts for math mode superscripts (7pt). -\def\sevennominalsize{7pt} -\setfont\sevenrm\rmshape{7}{1000}{OT1} -\setfont\seventt\ttshape{10}{700}{OT1TT} -\setfont\sevenbf\bfshape{10}{700}{OT1} -\setfont\sevenit\itshape{7}{1000}{OT1IT} -\setfont\sevensl\slshape{10}{700}{OT1} -\setfont\sevensf\sfshape{10}{700}{OT1} -\setfont\sevensc\scshape{10}{700}{OT1} -\setfont\seventtsl\ttslshape{10}{700}{OT1TT} -\font\seveni=cmmi7 -\font\sevensy=cmsy7 -\def\sevenecsize{0700} - -% Fonts for title page (20.4pt): -\def\titlenominalsize{20pt} -\setfont\titlerm\rmbshape{12}{\magstep3}{OT1} -\setfont\titleit\itbshape{10}{\magstep4}{OT1IT} -\setfont\titlesl\slbshape{10}{\magstep4}{OT1} -\setfont\titlett\ttbshape{12}{\magstep3}{OT1TT} -\setfont\titlettsl\ttslshape{10}{\magstep4}{OT1TT} -\setfont\titlesf\sfbshape{17}{\magstep1}{OT1} -\let\titlebf=\titlerm -\setfont\titlesc\scbshape{10}{\magstep4}{OT1} -\font\titlei=cmmi12 scaled \magstep3 -\font\titlesy=cmsy10 scaled \magstep4 -\def\titleecsize{2074} - -% Chapter fonts (14.4pt). -\def\chapnominalsize{14pt} -\setfont\chaprm\rmbshape{12}{\magstep1}{OT1} -\setfont\chapit\itbshape{10}{\magstep2}{OT1IT} -\setfont\chapsl\slbshape{10}{\magstep2}{OT1} -\setfont\chaptt\ttbshape{12}{\magstep1}{OT1TT} -\setfont\chapttsl\ttslshape{10}{\magstep2}{OT1TT} -\setfont\chapsf\sfbshape{12}{\magstep1}{OT1} -\let\chapbf\chaprm -\setfont\chapsc\scbshape{10}{\magstep2}{OT1} -\font\chapi=cmmi12 scaled \magstep1 -\font\chapsy=cmsy10 scaled \magstep2 -\def\chapecsize{1440} - -% Section fonts (12pt). -\def\secnominalsize{12pt} -\setfont\secrm\rmbshape{12}{1000}{OT1} -\setfont\secit\itbshape{10}{\magstep1}{OT1IT} -\setfont\secsl\slbshape{10}{\magstep1}{OT1} -\setfont\sectt\ttbshape{12}{1000}{OT1TT} -\setfont\secttsl\ttslshape{10}{\magstep1}{OT1TT} -\setfont\secsf\sfbshape{12}{1000}{OT1} -\let\secbf\secrm -\setfont\secsc\scbshape{10}{\magstep1}{OT1} -\font\seci=cmmi12 -\font\secsy=cmsy10 scaled \magstep1 -\def\sececsize{1200} - -% Subsection fonts (10pt). -\def\ssecnominalsize{10pt} -\setfont\ssecrm\rmbshape{10}{1000}{OT1} -\setfont\ssecit\itbshape{10}{1000}{OT1IT} -\setfont\ssecsl\slbshape{10}{1000}{OT1} -\setfont\ssectt\ttbshape{10}{1000}{OT1TT} -\setfont\ssecttsl\ttslshape{10}{1000}{OT1TT} -\setfont\ssecsf\sfbshape{10}{1000}{OT1} -\let\ssecbf\ssecrm -\setfont\ssecsc\scbshape{10}{1000}{OT1} -\font\sseci=cmmi10 -\font\ssecsy=cmsy10 -\def\ssececsize{1000} - -% Reduced fonts for @acronym in text (9pt). -\def\reducednominalsize{9pt} -\setfont\reducedrm\rmshape{9}{1000}{OT1} -\setfont\reducedtt\ttshape{9}{1000}{OT1TT} -\setfont\reducedbf\bfshape{10}{900}{OT1} -\setfont\reducedit\itshape{9}{1000}{OT1IT} -\setfont\reducedsl\slshape{9}{1000}{OT1} -\setfont\reducedsf\sfshape{9}{1000}{OT1} -\setfont\reducedsc\scshape{10}{900}{OT1} -\setfont\reducedttsl\ttslshape{10}{900}{OT1TT} -\font\reducedi=cmmi9 -\font\reducedsy=cmsy9 -\def\reducedecsize{0900} - -\divide\parskip by 2 % reduce space between paragraphs -\textleading = 12pt % line spacing for 10pt CM -\textfonts % reset the current fonts -\rm -} % end of 10pt text font size definitions, \definetextfontsizex - -% Fonts for short table of contents. -\setfont\shortcontrm\rmshape{12}{1000}{OT1} -\setfont\shortcontbf\bfshape{10}{\magstep1}{OT1} % no cmb12 -\setfont\shortcontsl\slshape{12}{1000}{OT1} -\setfont\shortconttt\ttshape{12}{1000}{OT1TT} - - -% We provide the user-level command -% @fonttextsize 10 -% (or 11) to redefine the text font size. pt is assumed. -% -\def\xiword{11} -\def\xword{10} -\def\xwordpt{10pt} -% -\parseargdef\fonttextsize{% - \def\textsizearg{#1}% - %\wlog{doing @fonttextsize \textsizearg}% - % - % Set \globaldefs so that documents can use this inside @tex, since - % makeinfo 4.8 does not support it, but we need it nonetheless. - % - \begingroup \globaldefs=1 - \ifx\textsizearg\xword \definetextfontsizex - \else \ifx\textsizearg\xiword \definetextfontsizexi - \else - \errhelp=\EMsimple - \errmessage{@fonttextsize only supports `10' or `11', not `\textsizearg'} - \fi\fi - \endgroup -} - -% -% Change the current font style to #1, remembering it in \curfontstyle. -% For now, we do not accumulate font styles: @b{@i{foo}} prints foo in -% italics, not bold italics. -% -\def\setfontstyle#1{% - \def\curfontstyle{#1}% not as a control sequence, because we are \edef'd. - \csname #1font\endcsname % change the current font -} - -\def\rm{\fam=0 \setfontstyle{rm}} -\def\it{\fam=\itfam \setfontstyle{it}} -\def\sl{\fam=\slfam \setfontstyle{sl}} -\def\bf{\fam=\bffam \setfontstyle{bf}}\def\bfstylename{bf} -\def\tt{\fam=\ttfam \setfontstyle{tt}} - -% Texinfo sort of supports the sans serif font style, which plain TeX does not. -% So we set up a \sf. -\newfam\sffam -\def\sf{\fam=\sffam \setfontstyle{sf}} - -% We don't need math for this font style. -\def\ttsl{\setfontstyle{ttsl}} - - -% In order for the font changes to affect most math symbols and letters, -% we have to define the \textfont of the standard families. -% We don't bother to reset \scriptscriptfont; awaiting user need. -% -\def\resetmathfonts{% - \textfont0=\rmfont \textfont1=\ifont \textfont2=\syfont - \textfont\itfam=\itfont \textfont\slfam=\slfont \textfont\bffam=\bffont - \textfont\ttfam=\ttfont \textfont\sffam=\sffont - % - % Fonts for superscript. Note that the 7pt fonts are used regardless - % of the current font size. - \scriptfont0=\sevenrm \scriptfont1=\seveni \scriptfont2=\sevensy - \scriptfont\itfam=\sevenit \scriptfont\slfam=\sevensl - \scriptfont\bffam=\sevenbf \scriptfont\ttfam=\seventt - \scriptfont\sffam=\sevensf -} - -% - -% The font-changing commands (all called \...fonts) redefine the meanings -% of \STYLEfont, instead of just \STYLE. We do this because \STYLE needs -% to also set the current \fam for math mode. Our \STYLE (e.g., \rm) -% commands hardwire \STYLEfont to set the current font. -% -% The fonts used for \ifont are for "math italics" (\itfont is for italics -% in regular text). \syfont is also used in math mode only. -% -% Each font-changing command also sets the names \lsize (one size lower) -% and \lllsize (three sizes lower). These relative commands are used -% in, e.g., the LaTeX logo and acronyms. -% -% This all needs generalizing, badly. -% - -\def\assignfonts#1{% - \expandafter\let\expandafter\rmfont\csname #1rm\endcsname - \expandafter\let\expandafter\itfont\csname #1it\endcsname - \expandafter\let\expandafter\slfont\csname #1sl\endcsname - \expandafter\let\expandafter\bffont\csname #1bf\endcsname - \expandafter\let\expandafter\ttfont\csname #1tt\endcsname - \expandafter\let\expandafter\smallcaps\csname #1sc\endcsname - \expandafter\let\expandafter\sffont \csname #1sf\endcsname - \expandafter\let\expandafter\ifont \csname #1i\endcsname - \expandafter\let\expandafter\syfont \csname #1sy\endcsname - \expandafter\let\expandafter\ttslfont\csname #1ttsl\endcsname -} - -\newif\ifrmisbold - -% Select smaller font size with the current style. Used to change font size -% in, e.g., the LaTeX logo and acronyms. If we are using bold fonts for -% normal roman text, also use bold fonts for roman text in the smaller size. -\def\switchtolllsize{% - \expandafter\assignfonts\expandafter{\lllsize}% - \ifrmisbold - \let\rmfont\bffont - \fi - \csname\curfontstyle\endcsname -}% - -\def\switchtolsize{% - \expandafter\assignfonts\expandafter{\lsize}% - \ifrmisbold - \let\rmfont\bffont - \fi - \csname\curfontstyle\endcsname -}% - -\def\definefontsetatsize#1#2#3#4#5{% -\expandafter\def\csname #1fonts\endcsname{% - \def\curfontsize{#1}% - \def\lsize{#2}\def\lllsize{#3}% - \csname rmisbold#5\endcsname - \assignfonts{#1}% - \resetmathfonts - \setleading{#4}% -}} - -\definefontsetatsize{text} {reduced}{smaller}{\textleading}{false} -\definefontsetatsize{title} {chap} {subsec} {27pt} {true} -\definefontsetatsize{chap} {sec} {text} {19pt} {true} -\definefontsetatsize{sec} {subsec} {reduced}{17pt} {true} -\definefontsetatsize{ssec} {text} {small} {15pt} {true} -\definefontsetatsize{reduced}{small} {smaller}{10.5pt}{false} -\definefontsetatsize{small} {smaller}{smaller}{10.5pt}{false} -\definefontsetatsize{smaller}{smaller}{smaller}{9.5pt} {false} - -\def\titlefont#1{{\titlefonts\rm #1}} -\let\subsecfonts = \ssecfonts -\let\subsubsecfonts = \ssecfonts - -% Define these just so they can be easily changed for other fonts. -\def\angleleft{$\langle$} -\def\angleright{$\rangle$} - -% Set the fonts to use with the @small... environments. -\let\smallexamplefonts = \smallfonts - -% About \smallexamplefonts. If we use \smallfonts (9pt), @smallexample -% can fit this many characters: -% 8.5x11=86 smallbook=72 a4=90 a5=69 -% If we use \scriptfonts (8pt), then we can fit this many characters: -% 8.5x11=90+ smallbook=80 a4=90+ a5=77 -% For me, subjectively, the few extra characters that fit aren't worth -% the additional smallness of 8pt. So I'm making the default 9pt. -% -% By the way, for comparison, here's what fits with @example (10pt): -% 8.5x11=71 smallbook=60 a4=75 a5=58 -% --karl, 24jan03. - -% Set up the default fonts, so we can use them for creating boxes. -% -\definetextfontsizexi - - -\message{markup,} - -% Check if we are currently using a typewriter font. Since all the -% Computer Modern typewriter fonts have zero interword stretch (and -% shrink), and it is reasonable to expect all typewriter fonts to have -% this property, we can check that font parameter. -% -\def\ifmonospace{\ifdim\fontdimen3\font=0pt } - -% Markup style infrastructure. \defmarkupstylesetup\INITMACRO will -% define and register \INITMACRO to be called on markup style changes. -% \INITMACRO can check \currentmarkupstyle for the innermost -% style. - -\let\currentmarkupstyle\empty - -\def\setupmarkupstyle#1{% - \def\currentmarkupstyle{#1}% - \markupstylesetup -} - -\let\markupstylesetup\empty - -\def\defmarkupstylesetup#1{% - \expandafter\def\expandafter\markupstylesetup - \expandafter{\markupstylesetup #1}% - \def#1% -} - -% Markup style setup for left and right quotes. -\defmarkupstylesetup\markupsetuplq{% - \expandafter\let\expandafter \temp - \csname markupsetuplq\currentmarkupstyle\endcsname - \ifx\temp\relax \markupsetuplqdefault \else \temp \fi -} - -\defmarkupstylesetup\markupsetuprq{% - \expandafter\let\expandafter \temp - \csname markupsetuprq\currentmarkupstyle\endcsname - \ifx\temp\relax \markupsetuprqdefault \else \temp \fi -} - -{ -\catcode`\'=\active -\catcode`\`=\active - -\gdef\markupsetuplqdefault{\let`\lq} -\gdef\markupsetuprqdefault{\let'\rq} - -\gdef\markupsetcodequoteleft{\let`\codequoteleft} -\gdef\markupsetcodequoteright{\let'\codequoteright} -} - -\let\markupsetuplqcode \markupsetcodequoteleft -\let\markupsetuprqcode \markupsetcodequoteright -% -\let\markupsetuplqexample \markupsetcodequoteleft -\let\markupsetuprqexample \markupsetcodequoteright -% -\let\markupsetuplqkbd \markupsetcodequoteleft -\let\markupsetuprqkbd \markupsetcodequoteright -% -\let\markupsetuplqsamp \markupsetcodequoteleft -\let\markupsetuprqsamp \markupsetcodequoteright -% -\let\markupsetuplqverb \markupsetcodequoteleft -\let\markupsetuprqverb \markupsetcodequoteright -% -\let\markupsetuplqverbatim \markupsetcodequoteleft -\let\markupsetuprqverbatim \markupsetcodequoteright - -% Allow an option to not use regular directed right quote/apostrophe -% (char 0x27), but instead the undirected quote from cmtt (char 0x0d). -% The undirected quote is ugly, so don't make it the default, but it -% works for pasting with more pdf viewers (at least evince), the -% lilypond developers report. xpdf does work with the regular 0x27. -% -\def\codequoteright{% - \ifmonospace - \expandafter\ifx\csname SETtxicodequoteundirected\endcsname\relax - \expandafter\ifx\csname SETcodequoteundirected\endcsname\relax - '% - \else \char'15 \fi - \else \char'15 \fi - \else - '% - \fi -} -% -% and a similar option for the left quote char vs. a grave accent. -% Modern fonts display ASCII 0x60 as a grave accent, so some people like -% the code environments to do likewise. -% -\def\codequoteleft{% - \ifmonospace - \expandafter\ifx\csname SETtxicodequotebacktick\endcsname\relax - \expandafter\ifx\csname SETcodequotebacktick\endcsname\relax - % [Knuth] pp. 380,381,391 - % \relax disables Spanish ligatures ?` and !` of \tt font. - \relax`% - \else \char'22 \fi - \else \char'22 \fi - \else - \relax`% - \fi -} - -% Commands to set the quote options. -% -\parseargdef\codequoteundirected{% - \def\temp{#1}% - \ifx\temp\onword - \expandafter\let\csname SETtxicodequoteundirected\endcsname - = t% - \else\ifx\temp\offword - \expandafter\let\csname SETtxicodequoteundirected\endcsname - = \relax - \else - \errhelp = \EMsimple - \errmessage{Unknown @codequoteundirected value `\temp', must be on|off}% - \fi\fi -} -% -\parseargdef\codequotebacktick{% - \def\temp{#1}% - \ifx\temp\onword - \expandafter\let\csname SETtxicodequotebacktick\endcsname - = t% - \else\ifx\temp\offword - \expandafter\let\csname SETtxicodequotebacktick\endcsname - = \relax - \else - \errhelp = \EMsimple - \errmessage{Unknown @codequotebacktick value `\temp', must be on|off}% - \fi\fi -} - -% [Knuth] pp. 380,381,391, disable Spanish ligatures ?` and !` of \tt font. -\def\noligaturesquoteleft{\relax\lq} - -% Count depth in font-changes, for error checks -\newcount\fontdepth \fontdepth=0 - -% Font commands. - -% #1 is the font command (\sl or \it), #2 is the text to slant. -% If we are in a monospaced environment, however, 1) always use \ttsl, -% and 2) do not add an italic correction. -\def\dosmartslant#1#2{% - \ifusingtt - {{\ttsl #2}\let\next=\relax}% - {\def\next{{#1#2}\futurelet\next\smartitaliccorrection}}% - \next -} -\def\smartslanted{\dosmartslant\sl} -\def\smartitalic{\dosmartslant\it} - -% Output an italic correction unless \next (presumed to be the following -% character) is such as not to need one. -\def\smartitaliccorrection{% - \ifx\next,% - \else\ifx\next-% - \else\ifx\next.% - \else\ifx\next\.% - \else\ifx\next\comma% - \else\ptexslash - \fi\fi\fi\fi\fi - \aftersmartic -} - -% Unconditional use \ttsl, and no ic. @var is set to this for defuns. -\def\ttslanted#1{{\ttsl #1}} - -% @cite is like \smartslanted except unconditionally use \sl. We never want -% ttsl for book titles, do we? -\def\cite#1{{\sl #1}\futurelet\next\smartitaliccorrection} - -\def\aftersmartic{} -\def\var#1{% - \let\saveaftersmartic = \aftersmartic - \def\aftersmartic{\null\let\aftersmartic=\saveaftersmartic}% - \smartslanted{#1}% -} - -\let\i=\smartitalic -\let\slanted=\smartslanted -\let\dfn=\smartslanted -\let\emph=\smartitalic - -% Explicit font changes: @r, @sc, undocumented @ii. -\def\r#1{{\rm #1}} % roman font -\def\sc#1{{\smallcaps#1}} % smallcaps font -\def\ii#1{{\it #1}} % italic font - -% @b, explicit bold. Also @strong. -\def\b#1{{\bf #1}} -\let\strong=\b - -% @sansserif, explicit sans. -\def\sansserif#1{{\sf #1}} - -% We can't just use \exhyphenpenalty, because that only has effect at -% the end of a paragraph. Restore normal hyphenation at the end of the -% group within which \nohyphenation is presumably called. -% -\def\nohyphenation{\hyphenchar\font = -1 \aftergroup\restorehyphenation} -\def\restorehyphenation{\hyphenchar\font = `- } - -% Set sfcode to normal for the chars that usually have another value. -% Can't use plain's \frenchspacing because it uses the `\x notation, and -% sometimes \x has an active definition that messes things up. -% -\catcode`@=11 - \def\plainfrenchspacing{% - \sfcode`\.=\@m \sfcode`\?=\@m \sfcode`\!=\@m - \sfcode`\:=\@m \sfcode`\;=\@m \sfcode`\,=\@m - \def\endofsentencespacefactor{1000}% for @. and friends - } - \def\plainnonfrenchspacing{% - \sfcode`\.3000\sfcode`\?3000\sfcode`\!3000 - \sfcode`\:2000\sfcode`\;1500\sfcode`\,1250 - \def\endofsentencespacefactor{3000}% for @. and friends - } -\catcode`@=\other -\def\endofsentencespacefactor{3000}% default - -% @t, explicit typewriter. -\def\t#1{% - {\tt \plainfrenchspacing #1}% - \null -} - -% @samp. -\def\samp#1{{\setupmarkupstyle{samp}\lq\tclose{#1}\rq\null}} - -% @indicateurl is \samp, that is, with quotes. -\let\indicateurl=\samp - -% @code (and similar) prints in typewriter, but with spaces the same -% size as normal in the surrounding text, without hyphenation, etc. -% This is a subroutine for that. -\def\tclose#1{% - {% - % Change normal interword space to be same as for the current font. - \spaceskip = \fontdimen2\font - % - % Switch to typewriter. - \tt - % - % But `\ ' produces the large typewriter interword space. - \def\ {{\spaceskip = 0pt{} }}% - % - % Turn off hyphenation. - \nohyphenation - % - \plainfrenchspacing - #1% - }% - \null % reset spacefactor to 1000 -} - -% We *must* turn on hyphenation at `-' and `_' in @code. -% (But see \codedashfinish below.) -% Otherwise, it is too hard to avoid overfull hboxes -% in the Emacs manual, the Library manual, etc. -% -% Unfortunately, TeX uses one parameter (\hyphenchar) to control -% both hyphenation at - and hyphenation within words. -% We must therefore turn them both off (\tclose does that) -% and arrange explicitly to hyphenate at a dash. -- rms. -{ - \catcode`\-=\active \catcode`\_=\active - \catcode`\'=\active \catcode`\`=\active - \global\let'=\rq \global\let`=\lq % default definitions - % - \global\def\code{\begingroup - \setupmarkupstyle{code}% - % The following should really be moved into \setupmarkupstyle handlers. - \catcode\dashChar=\active \catcode\underChar=\active - \ifallowcodebreaks - \let-\codedash - \let_\codeunder - \else - \let-\normaldash - \let_\realunder - \fi - % Given -foo (with a single dash), we do not want to allow a break - % after the hyphen. - \global\let\codedashprev=\codedash - % - \codex - } - % - \gdef\codedash{\futurelet\next\codedashfinish} - \gdef\codedashfinish{% - \normaldash % always output the dash character itself. - % - % Now, output a discretionary to allow a line break, unless - % (a) the next character is a -, or - % (b) the preceding character is a -. - % E.g., given --posix, we do not want to allow a break after either -. - % Given --foo-bar, we do want to allow a break between the - and the b. - \ifx\next\codedash \else - \ifx\codedashprev\codedash - \else \discretionary{}{}{}\fi - \fi - % we need the space after the = for the case when \next itself is a - % space token; it would get swallowed otherwise. As in @code{- a}. - \global\let\codedashprev= \next - } -} -\def\normaldash{-} -% -\def\codex #1{\tclose{#1}\endgroup} - -\def\codeunder{% - % this is all so @math{@code{var_name}+1} can work. In math mode, _ - % is "active" (mathcode"8000) and \normalunderscore (or \char95, etc.) - % will therefore expand the active definition of _, which is us - % (inside @code that is), therefore an endless loop. - \ifusingtt{\ifmmode - \mathchar"075F % class 0=ordinary, family 7=ttfam, pos 0x5F=_. - \else\normalunderscore \fi - \discretionary{}{}{}}% - {\_}% -} - -% An additional complication: the above will allow breaks after, e.g., -% each of the four underscores in __typeof__. This is bad. -% @allowcodebreaks provides a document-level way to turn breaking at - -% and _ on and off. -% -\newif\ifallowcodebreaks \allowcodebreakstrue - -\def\keywordtrue{true} -\def\keywordfalse{false} - -\parseargdef\allowcodebreaks{% - \def\txiarg{#1}% - \ifx\txiarg\keywordtrue - \allowcodebreakstrue - \else\ifx\txiarg\keywordfalse - \allowcodebreaksfalse - \else - \errhelp = \EMsimple - \errmessage{Unknown @allowcodebreaks option `\txiarg', must be true|false}% - \fi\fi -} - -% For @command, @env, @file, @option quotes seem unnecessary, -% so use \code rather than \samp. -\let\command=\code -\let\env=\code -\let\file=\code -\let\option=\code - -% @uref (abbreviation for `urlref') aka @url takes an optional -% (comma-separated) second argument specifying the text to display and -% an optional third arg as text to display instead of (rather than in -% addition to) the url itself. First (mandatory) arg is the url. - -% TeX-only option to allow changing PDF output to show only the second -% arg (if given), and not the url (which is then just the link target). -\newif\ifurefurlonlylink - -% The main macro is \urefbreak, which allows breaking at expected -% places within the url. (There used to be another version, which -% didn't support automatic breaking.) -\def\urefbreak{\begingroup \urefcatcodes \dourefbreak} -\let\uref=\urefbreak -% -\def\dourefbreak#1{\urefbreakfinish #1,,,\finish} -\def\urefbreakfinish#1,#2,#3,#4\finish{% doesn't work in @example - \unsepspaces - \pdfurl{#1}% - \setbox0 = \hbox{\ignorespaces #3}% - \ifdim\wd0 > 0pt - \unhbox0 % third arg given, show only that - \else - \setbox0 = \hbox{\ignorespaces #2}% look for second arg - \ifdim\wd0 > 0pt - \ifpdf - % For pdfTeX and LuaTeX - \ifurefurlonlylink - % PDF plus option to not display url, show just arg - \unhbox0 - \else - % PDF, normally display both arg and url for consistency, - % visibility, if the pdf is eventually used to print, etc. - \unhbox0\ (\urefcode{#1})% - \fi - \else - \ifx\XeTeXrevision\thisisundefined - \unhbox0\ (\urefcode{#1})% DVI, always show arg and url - \else - % For XeTeX - \ifurefurlonlylink - % PDF plus option to not display url, show just arg - \unhbox0 - \else - % PDF, normally display both arg and url for consistency, - % visibility, if the pdf is eventually used to print, etc. - \unhbox0\ (\urefcode{#1})% - \fi - \fi - \fi - \else - \urefcode{#1}% only url given, so show it - \fi - \fi - \endlink -\endgroup} - -% Allow line breaks around only a few characters (only). -\def\urefcatcodes{% - \catcode`\&=\active \catcode`\.=\active - \catcode`\#=\active \catcode`\?=\active - \catcode`\/=\active -} -{ - \urefcatcodes - % - \global\def\urefcode{\begingroup - \setupmarkupstyle{code}% - \urefcatcodes - \let&\urefcodeamp - \let.\urefcodedot - \let#\urefcodehash - \let?\urefcodequest - \let/\urefcodeslash - \codex - } - % - % By default, they are just regular characters. - \global\def&{\normalamp} - \global\def.{\normaldot} - \global\def#{\normalhash} - \global\def?{\normalquest} - \global\def/{\normalslash} -} - -\def\urefcodeamp{\urefprebreak \&\urefpostbreak} -\def\urefcodedot{\urefprebreak .\urefpostbreak} -\def\urefcodehash{\urefprebreak \#\urefpostbreak} -\def\urefcodequest{\urefprebreak ?\urefpostbreak} -\def\urefcodeslash{\futurelet\next\urefcodeslashfinish} -{ - \catcode`\/=\active - \global\def\urefcodeslashfinish{% - \urefprebreak \slashChar - % Allow line break only after the final / in a sequence of - % slashes, to avoid line break between the slashes in http://. - \ifx\next/\else \urefpostbreak \fi - } -} - -% By default we'll break after the special characters, but some people like to -% break before the special chars, so allow that. Also allow no breaking at -% all, for manual control. -% -\parseargdef\urefbreakstyle{% - \def\txiarg{#1}% - \ifx\txiarg\wordnone - \def\urefprebreak{\nobreak}\def\urefpostbreak{\nobreak} - \else\ifx\txiarg\wordbefore - \def\urefprebreak{\urefallowbreak}\def\urefpostbreak{\nobreak} - \else\ifx\txiarg\wordafter - \def\urefprebreak{\nobreak}\def\urefpostbreak{\urefallowbreak} - \else - \errhelp = \EMsimple - \errmessage{Unknown @urefbreakstyle setting `\txiarg'}% - \fi\fi\fi -} -\def\wordafter{after} -\def\wordbefore{before} -\def\wordnone{none} - -% Allow a ragged right output to aid breaking long URL's. Putting stretch in -% between characters of the URL doesn't look good. -\def\urefallowbreak{% - \hskip 0pt plus 1fil\relax - \allowbreak - \hskip 0pt plus -1fil\relax -} - -\urefbreakstyle after - -% @url synonym for @uref, since that's how everyone uses it. -% -\let\url=\uref - -% rms does not like angle brackets --karl, 17may97. -% So now @email is just like @uref, unless we are pdf. -% -%\def\email#1{\angleleft{\tt #1}\angleright} -\ifpdforxetex - \def\email#1{\doemail#1,,\finish} - \def\doemail#1,#2,#3\finish{\begingroup - \unsepspaces - \pdfurl{mailto:#1}% - \setbox0 = \hbox{\ignorespaces #2}% - \ifdim\wd0>0pt\unhbox0\else\code{#1}\fi - \endlink - \endgroup} -\else - \let\email=\uref -\fi - -% @kbdinputstyle -- arg is `distinct' (@kbd uses slanted tty font always), -% `example' (@kbd uses ttsl only inside of @example and friends), -% or `code' (@kbd uses normal tty font always). -\parseargdef\kbdinputstyle{% - \def\txiarg{#1}% - \ifx\txiarg\worddistinct - \gdef\kbdexamplefont{\ttsl}\gdef\kbdfont{\ttsl}% - \else\ifx\txiarg\wordexample - \gdef\kbdexamplefont{\ttsl}\gdef\kbdfont{\tt}% - \else\ifx\txiarg\wordcode - \gdef\kbdexamplefont{\tt}\gdef\kbdfont{\tt}% - \else - \errhelp = \EMsimple - \errmessage{Unknown @kbdinputstyle setting `\txiarg'}% - \fi\fi\fi -} -\def\worddistinct{distinct} -\def\wordexample{example} -\def\wordcode{code} - -% Default is `distinct'. -\kbdinputstyle distinct - -% @kbd is like @code, except that if the argument is just one @key command, -% then @kbd has no effect. -\def\kbd#1{{\def\look{#1}\expandafter\kbdsub\look??\par}} - -\def\xkey{\key} -\def\kbdsub#1#2#3\par{% - \def\one{#1}\def\three{#3}\def\threex{??}% - \ifx\one\xkey\ifx\threex\three \key{#2}% - \else{\tclose{\kbdfont\setupmarkupstyle{kbd}\look}}\fi - \else{\tclose{\kbdfont\setupmarkupstyle{kbd}\look}}\fi -} - -% definition of @key that produces a lozenge. Doesn't adjust to text size. -%\setfont\keyrm\rmshape{8}{1000}{OT1} -%\font\keysy=cmsy9 -%\def\key#1{{\keyrm\textfont2=\keysy \leavevmode\hbox{% -% \raise0.4pt\hbox{\angleleft}\kern-.08em\vtop{% -% \vbox{\hrule\kern-0.4pt -% \hbox{\raise0.4pt\hbox{\vphantom{\angleleft}}#1}}% -% \kern-0.4pt\hrule}% -% \kern-.06em\raise0.4pt\hbox{\angleright}}}} - -% definition of @key with no lozenge. If the current font is already -% monospace, don't change it; that way, we respect @kbdinputstyle. But -% if it isn't monospace, then use \tt. -% -\def\key#1{{\setupmarkupstyle{key}% - \nohyphenation - \ifmonospace\else\tt\fi - #1}\null} - -% @clicksequence{File @click{} Open ...} -\def\clicksequence#1{\begingroup #1\endgroup} - -% @clickstyle @arrow (by default) -\parseargdef\clickstyle{\def\click{#1}} -\def\click{\arrow} - -% Typeset a dimension, e.g., `in' or `pt'. The only reason for the -% argument is to make the input look right: @dmn{pt} instead of @dmn{}pt. -% -\def\dmn#1{\thinspace #1} - -% @acronym for "FBI", "NATO", and the like. -% We print this one point size smaller, since it's intended for -% all-uppercase. -% -\def\acronym#1{\doacronym #1,,\finish} -\def\doacronym#1,#2,#3\finish{% - {\switchtolsize #1}% - \def\temp{#2}% - \ifx\temp\empty \else - \space ({\unsepspaces \ignorespaces \temp \unskip})% - \fi - \null % reset \spacefactor=1000 -} - -% @abbr for "Comput. J." and the like. -% No font change, but don't do end-of-sentence spacing. -% -\def\abbr#1{\doabbr #1,,\finish} -\def\doabbr#1,#2,#3\finish{% - {\plainfrenchspacing #1}% - \def\temp{#2}% - \ifx\temp\empty \else - \space ({\unsepspaces \ignorespaces \temp \unskip})% - \fi - \null % reset \spacefactor=1000 -} - -% @asis just yields its argument. Used with @table, for example. -% -\def\asis#1{#1} - -% @math outputs its argument in math mode. -% -% One complication: _ usually means subscripts, but it could also mean -% an actual _ character, as in @math{@var{some_variable} + 1}. So make -% _ active, and distinguish by seeing if the current family is \slfam, -% which is what @var uses. -{ - \catcode`\_ = \active - \gdef\mathunderscore{% - \catcode`\_=\active - \def_{\ifnum\fam=\slfam \_\else\sb\fi}% - } -} -% Another complication: we want \\ (and @\) to output a math (or tt) \. -% FYI, plain.tex uses \\ as a temporary control sequence (for no -% particular reason), but this is not advertised and we don't care. -% -% The \mathchar is class=0=ordinary, family=7=ttfam, position=5C=\. -\def\mathbackslash{\ifnum\fam=\ttfam \mathchar"075C \else\backslash \fi} -% -\def\math{% - \ifmmode\else % only go into math if not in math mode already - \tex - \mathunderscore - \let\\ = \mathbackslash - \mathactive - % make the texinfo accent commands work in math mode - \let\"=\ddot - \let\'=\acute - \let\==\bar - \let\^=\hat - \let\`=\grave - \let\u=\breve - \let\v=\check - \let\~=\tilde - \let\dotaccent=\dot - % have to provide another name for sup operator - \let\mathopsup=\sup - $\expandafter\finishmath\fi -} -\def\finishmath#1{#1$\endgroup} % Close the group opened by \tex. - -% Some active characters (such as <) are spaced differently in math. -% We have to reset their definitions in case the @math was an argument -% to a command which sets the catcodes (such as @item or @section). -% -{ - \catcode`^ = \active - \catcode`< = \active - \catcode`> = \active - \catcode`+ = \active - \catcode`' = \active - \gdef\mathactive{% - \let^ = \ptexhat - \let< = \ptexless - \let> = \ptexgtr - \let+ = \ptexplus - \let' = \ptexquoteright - } -} - -% for @sub and @sup, if in math mode, just do a normal sub/superscript. -% If in text, use math to place as sub/superscript, but switch -% into text mode, with smaller fonts. This is a different font than the -% one used for real math sub/superscripts (8pt vs. 7pt), but let's not -% fix it (significant additions to font machinery) until someone notices. -% -\def\sub{\ifmmode \expandafter\sb \else \expandafter\finishsub\fi} -\def\finishsub#1{$\sb{\hbox{\switchtolllsize #1}}$}% -% -\def\sup{\ifmmode \expandafter\ptexsp \else \expandafter\finishsup\fi} -\def\finishsup#1{$\ptexsp{\hbox{\switchtolllsize #1}}$}% - -% @inlinefmt{FMTNAME,PROCESSED-TEXT} and @inlineraw{FMTNAME,RAW-TEXT}. -% Ignore unless FMTNAME == tex; then it is like @iftex and @tex, -% except specified as a normal braced arg, so no newlines to worry about. -% -\def\outfmtnametex{tex} -% -\long\def\inlinefmt#1{\doinlinefmt #1,\finish} -\long\def\doinlinefmt#1,#2,\finish{% - \def\inlinefmtname{#1}% - \ifx\inlinefmtname\outfmtnametex \ignorespaces #2\fi -} -% -% @inlinefmtifelse{FMTNAME,THEN-TEXT,ELSE-TEXT} expands THEN-TEXT if -% FMTNAME is tex, else ELSE-TEXT. -\long\def\inlinefmtifelse#1{\doinlinefmtifelse #1,,,\finish} -\long\def\doinlinefmtifelse#1,#2,#3,#4,\finish{% - \def\inlinefmtname{#1}% - \ifx\inlinefmtname\outfmtnametex \ignorespaces #2\else \ignorespaces #3\fi -} -% -% For raw, must switch into @tex before parsing the argument, to avoid -% setting catcodes prematurely. Doing it this way means that, for -% example, @inlineraw{html, foo{bar} gets a parse error instead of being -% ignored. But this isn't important because if people want a literal -% *right* brace they would have to use a command anyway, so they may as -% well use a command to get a left brace too. We could re-use the -% delimiter character idea from \verb, but it seems like overkill. -% -\long\def\inlineraw{\tex \doinlineraw} -\long\def\doinlineraw#1{\doinlinerawtwo #1,\finish} -\def\doinlinerawtwo#1,#2,\finish{% - \def\inlinerawname{#1}% - \ifx\inlinerawname\outfmtnametex \ignorespaces #2\fi - \endgroup % close group opened by \tex. -} - -% @inlineifset{VAR, TEXT} expands TEXT if VAR is @set. -% -\long\def\inlineifset#1{\doinlineifset #1,\finish} -\long\def\doinlineifset#1,#2,\finish{% - \def\inlinevarname{#1}% - \expandafter\ifx\csname SET\inlinevarname\endcsname\relax - \else\ignorespaces#2\fi -} - -% @inlineifclear{VAR, TEXT} expands TEXT if VAR is not @set. -% -\long\def\inlineifclear#1{\doinlineifclear #1,\finish} -\long\def\doinlineifclear#1,#2,\finish{% - \def\inlinevarname{#1}% - \expandafter\ifx\csname SET\inlinevarname\endcsname\relax \ignorespaces#2\fi -} - - -\message{glyphs,} -% and logos. - -% @@ prints an @, as does @atchar{}. -\def\@{\char64 } -\let\atchar=\@ - -% @{ @} @lbracechar{} @rbracechar{} all generate brace characters. -\def\lbracechar{{\ifmonospace\char123\else\ensuremath\lbrace\fi}} -\def\rbracechar{{\ifmonospace\char125\else\ensuremath\rbrace\fi}} -\let\{=\lbracechar -\let\}=\rbracechar - -% @comma{} to avoid , parsing problems. -\let\comma = , - -% Accents: @, @dotaccent @ringaccent @ubaraccent @udotaccent -% Others are defined by plain TeX: @` @' @" @^ @~ @= @u @v @H. -\let\, = \ptexc -\let\dotaccent = \ptexdot -\def\ringaccent#1{{\accent23 #1}} -\let\tieaccent = \ptext -\let\ubaraccent = \ptexb -\let\udotaccent = \d - -% Other special characters: @questiondown @exclamdown @ordf @ordm -% Plain TeX defines: @AA @AE @O @OE @L (plus lowercase versions) @ss. -\def\questiondown{?`} -\def\exclamdown{!`} -\def\ordf{\leavevmode\raise1ex\hbox{\switchtolllsize \underbar{a}}} -\def\ordm{\leavevmode\raise1ex\hbox{\switchtolllsize \underbar{o}}} - -% Dotless i and dotless j, used for accents. -\def\imacro{i} -\def\jmacro{j} -\def\dotless#1{% - \def\temp{#1}% - \ifx\temp\imacro \ifmmode\imath \else\ptexi \fi - \else\ifx\temp\jmacro \ifmmode\jmath \else\j \fi - \else \errmessage{@dotless can be used only with i or j}% - \fi\fi -} - -% The \TeX{} logo, as in plain, but resetting the spacing so that a -% period following counts as ending a sentence. (Idea found in latex.) -% -\edef\TeX{\TeX \spacefactor=1000 } - -% @LaTeX{} logo. Not quite the same results as the definition in -% latex.ltx, since we use a different font for the raised A; it's most -% convenient for us to use an explicitly smaller font, rather than using -% the \scriptstyle font (since we don't reset \scriptstyle and -% \scriptscriptstyle). -% -\def\LaTeX{% - L\kern-.36em - {\setbox0=\hbox{T}% - \vbox to \ht0{\hbox{% - \ifx\textnominalsize\xwordpt - % for 10pt running text, lllsize (8pt) is too small for the A in LaTeX. - % Revert to plain's \scriptsize, which is 7pt. - \count255=\the\fam $\fam\count255 \scriptstyle A$% - \else - % For 11pt, we can use our lllsize. - \switchtolllsize A% - \fi - }% - \vss - }}% - \kern-.15em - \TeX -} - -% Some math mode symbols. Define \ensuremath to switch into math mode -% unless we are already there. Expansion tricks may not be needed here, -% but safer, and can't hurt. -\def\ensuremath{\ifmmode \expandafter\asis \else\expandafter\ensuredmath \fi} -\def\ensuredmath#1{$\relax#1$} -% -\def\bullet{\ensuremath\ptexbullet} -\def\geq{\ensuremath\ge} -\def\leq{\ensuremath\le} -\def\minus{\ensuremath-} - -% @dots{} outputs an ellipsis using the current font. -% We do .5em per period so that it has the same spacing in the cm -% typewriter fonts as three actual period characters; on the other hand, -% in other typewriter fonts three periods are wider than 1.5em. So do -% whichever is larger. -% -\def\dots{% - \leavevmode - \setbox0=\hbox{...}% get width of three periods - \ifdim\wd0 > 1.5em - \dimen0 = \wd0 - \else - \dimen0 = 1.5em - \fi - \hbox to \dimen0{% - \hskip 0pt plus.25fil - .\hskip 0pt plus1fil - .\hskip 0pt plus1fil - .\hskip 0pt plus.5fil - }% -} - -% @enddots{} is an end-of-sentence ellipsis. -% -\def\enddots{% - \dots - \spacefactor=\endofsentencespacefactor -} - -% @point{}, @result{}, @expansion{}, @print{}, @equiv{}. -% -% Since these characters are used in examples, they should be an even number of -% \tt widths. Each \tt character is 1en, so two makes it 1em. -% -\def\point{$\star$} -\def\arrow{\leavevmode\raise.05ex\hbox to 1em{\hfil$\rightarrow$\hfil}} -\def\result{\leavevmode\raise.05ex\hbox to 1em{\hfil$\Rightarrow$\hfil}} -\def\expansion{\leavevmode\hbox to 1em{\hfil$\mapsto$\hfil}} -\def\print{\leavevmode\lower.1ex\hbox to 1em{\hfil$\dashv$\hfil}} -\def\equiv{\leavevmode\hbox to 1em{\hfil$\ptexequiv$\hfil}} - -% The @error{} command. -% Adapted from the TeXbook's \boxit. -% -\newbox\errorbox -% -{\ttfont \global\dimen0 = 3em}% Width of the box. -\dimen2 = .55pt % Thickness of rules -% The text. (`r' is open on the right, `e' somewhat less so on the left.) -\setbox0 = \hbox{\kern-.75pt \reducedsf \putworderror\kern-1.5pt} -% -\setbox\errorbox=\hbox to \dimen0{\hfil - \hsize = \dimen0 \advance\hsize by -5.8pt % Space to left+right. - \advance\hsize by -2\dimen2 % Rules. - \vbox{% - \hrule height\dimen2 - \hbox{\vrule width\dimen2 \kern3pt % Space to left of text. - \vtop{\kern2.4pt \box0 \kern2.4pt}% Space above/below. - \kern3pt\vrule width\dimen2}% Space to right. - \hrule height\dimen2} - \hfil} -% -\def\error{\leavevmode\lower.7ex\copy\errorbox} - -% @pounds{} is a sterling sign, which Knuth put in the CM italic font. -% -\def\pounds{{\it\$}} - -% @euro{} comes from a separate font, depending on the current style. -% We use the free feym* fonts from the eurosym package by Henrik -% Theiling, which support regular, slanted, bold and bold slanted (and -% "outlined" (blackboard board, sort of) versions, which we don't need). -% It is available from http://www.ctan.org/tex-archive/fonts/eurosym. -% -% Although only regular is the truly official Euro symbol, we ignore -% that. The Euro is designed to be slightly taller than the regular -% font height. -% -% feymr - regular -% feymo - slanted -% feybr - bold -% feybo - bold slanted -% -% There is no good (free) typewriter version, to my knowledge. -% A feymr10 euro is ~7.3pt wide, while a normal cmtt10 char is ~5.25pt wide. -% Hmm. -% -% Also doesn't work in math. Do we need to do math with euro symbols? -% Hope not. -% -% -\def\euro{{\eurofont e}} -\def\eurofont{% - % We set the font at each command, rather than predefining it in - % \textfonts and the other font-switching commands, so that - % installations which never need the symbol don't have to have the - % font installed. - % - % There is only one designed size (nominal 10pt), so we always scale - % that to the current nominal size. - % - % By the way, simply using "at 1em" works for cmr10 and the like, but - % does not work for cmbx10 and other extended/shrunken fonts. - % - \def\eurosize{\csname\curfontsize nominalsize\endcsname}% - % - \ifx\curfontstyle\bfstylename - % bold: - \font\thiseurofont = \ifusingit{feybo10}{feybr10} at \eurosize - \else - % regular: - \font\thiseurofont = \ifusingit{feymo10}{feymr10} at \eurosize - \fi - \thiseurofont -} - -% Glyphs from the EC fonts. We don't use \let for the aliases, because -% sometimes we redefine the original macro, and the alias should reflect -% the redefinition. -% -% Use LaTeX names for the Icelandic letters. -\def\DH{{\ecfont \char"D0}} % Eth -\def\dh{{\ecfont \char"F0}} % eth -\def\TH{{\ecfont \char"DE}} % Thorn -\def\th{{\ecfont \char"FE}} % thorn -% -\def\guillemetleft{{\ecfont \char"13}} -\def\guillemotleft{\guillemetleft} -\def\guillemetright{{\ecfont \char"14}} -\def\guillemotright{\guillemetright} -\def\guilsinglleft{{\ecfont \char"0E}} -\def\guilsinglright{{\ecfont \char"0F}} -\def\quotedblbase{{\ecfont \char"12}} -\def\quotesinglbase{{\ecfont \char"0D}} -% -% This positioning is not perfect (see the ogonek LaTeX package), but -% we have the precomposed glyphs for the most common cases. We put the -% tests to use those glyphs in the single \ogonek macro so we have fewer -% dummy definitions to worry about for index entries, etc. -% -% ogonek is also used with other letters in Lithuanian (IOU), but using -% the precomposed glyphs for those is not so easy since they aren't in -% the same EC font. -\def\ogonek#1{{% - \def\temp{#1}% - \ifx\temp\macrocharA\Aogonek - \else\ifx\temp\macrochara\aogonek - \else\ifx\temp\macrocharE\Eogonek - \else\ifx\temp\macrochare\eogonek - \else - \ecfont \setbox0=\hbox{#1}% - \ifdim\ht0=1ex\accent"0C #1% - \else\ooalign{\unhbox0\crcr\hidewidth\char"0C \hidewidth}% - \fi - \fi\fi\fi\fi - }% -} -\def\Aogonek{{\ecfont \char"81}}\def\macrocharA{A} -\def\aogonek{{\ecfont \char"A1}}\def\macrochara{a} -\def\Eogonek{{\ecfont \char"86}}\def\macrocharE{E} -\def\eogonek{{\ecfont \char"A6}}\def\macrochare{e} -% -% Use the European Computer Modern fonts (cm-super in outline format) -% for non-CM glyphs. That is ec* for regular text and tc* for the text -% companion symbols (LaTeX TS1 encoding). Both are part of the ec -% package and follow the same conventions. -% -\def\ecfont{\etcfont{e}} -\def\tcfont{\etcfont{t}} -% -\def\etcfont#1{% - % We can't distinguish serif/sans and italic/slanted, but this - % is used for crude hacks anyway (like adding French and German - % quotes to documents typeset with CM, where we lose kerning), so - % hopefully nobody will notice/care. - \edef\ecsize{\csname\curfontsize ecsize\endcsname}% - \edef\nominalsize{\csname\curfontsize nominalsize\endcsname}% - \ifmonospace - % typewriter: - \font\thisecfont = #1ctt\ecsize \space at \nominalsize - \else - \ifx\curfontstyle\bfstylename - % bold: - \font\thisecfont = #1cb\ifusingit{i}{x}\ecsize \space at \nominalsize - \else - % regular: - \font\thisecfont = #1c\ifusingit{ti}{rm}\ecsize \space at \nominalsize - \fi - \fi - \thisecfont -} - -% @registeredsymbol - R in a circle. The font for the R should really -% be smaller yet, but lllsize is the best we can do for now. -% Adapted from the plain.tex definition of \copyright. -% -\def\registeredsymbol{% - $^{{\ooalign{\hfil\raise.07ex\hbox{\switchtolllsize R}% - \hfil\crcr\Orb}}% - }$% -} - -% @textdegree - the normal degrees sign. -% -\def\textdegree{$^\circ$} - -% Laurent Siebenmann reports \Orb undefined with: -% Textures 1.7.7 (preloaded format=plain 93.10.14) (68K) 16 APR 2004 02:38 -% so we'll define it if necessary. -% -\ifx\Orb\thisisundefined -\def\Orb{\mathhexbox20D} -\fi - -% Quotes. -\chardef\quotedblleft="5C -\chardef\quotedblright=`\" -\chardef\quoteleft=`\` -\chardef\quoteright=`\' - - -\message{page headings,} - -\newskip\titlepagetopglue \titlepagetopglue = 1.5in -\newskip\titlepagebottomglue \titlepagebottomglue = 2pc - -% First the title page. Must do @settitle before @titlepage. -\newif\ifseenauthor -\newif\iffinishedtitlepage - -% @setcontentsaftertitlepage used to do an implicit @contents or -% @shortcontents after @end titlepage, but it is now obsolete. -\def\setcontentsaftertitlepage{% - \errmessage{@setcontentsaftertitlepage has been removed as a Texinfo - command; move your @contents command if you want the contents - after the title page.}}% -\def\setshortcontentsaftertitlepage{% - \errmessage{@setshortcontentsaftertitlepage has been removed as a Texinfo - command; move your @shortcontents and @contents commands if you - want the contents after the title page.}}% - -\parseargdef\shorttitlepage{% - \begingroup \hbox{}\vskip 1.5in \chaprm \centerline{#1}% - \endgroup\page\hbox{}\page} - -\envdef\titlepage{% - % Open one extra group, as we want to close it in the middle of \Etitlepage. - \begingroup - \parindent=0pt \textfonts - % Leave some space at the very top of the page. - \vglue\titlepagetopglue - % No rule at page bottom unless we print one at the top with @title. - \finishedtitlepagetrue - % - % Most title ``pages'' are actually two pages long, with space - % at the top of the second. We don't want the ragged left on the second. - \let\oldpage = \page - \def\page{% - \iffinishedtitlepage\else - \finishtitlepage - \fi - \let\page = \oldpage - \page - \null - }% -} - -\def\Etitlepage{% - \iffinishedtitlepage\else - \finishtitlepage - \fi - % It is important to do the page break before ending the group, - % because the headline and footline are only empty inside the group. - % If we use the new definition of \page, we always get a blank page - % after the title page, which we certainly don't want. - \oldpage - \endgroup - % - % Need this before the \...aftertitlepage checks so that if they are - % in effect the toc pages will come out with page numbers. - \HEADINGSon -} - -\def\finishtitlepage{% - \vskip4pt \hrule height 2pt width \hsize - \vskip\titlepagebottomglue - \finishedtitlepagetrue -} - -% Settings used for typesetting titles: no hyphenation, no indentation, -% don't worry much about spacing, ragged right. This should be used -% inside a \vbox, and fonts need to be set appropriately first. \par should -% be specified before the end of the \vbox, since a vbox is a group. -% -\def\raggedtitlesettings{% - \rm - \hyphenpenalty=10000 - \parindent=0pt - \tolerance=5000 - \ptexraggedright -} - -% Macros to be used within @titlepage: - -\let\subtitlerm=\rmfont -\def\subtitlefont{\subtitlerm \normalbaselineskip = 13pt \normalbaselines} - -\parseargdef\title{% - \checkenv\titlepage - \vbox{\titlefonts \raggedtitlesettings #1\par}% - % print a rule at the page bottom also. - \finishedtitlepagefalse - \vskip4pt \hrule height 4pt width \hsize \vskip4pt -} - -\parseargdef\subtitle{% - \checkenv\titlepage - {\subtitlefont \rightline{#1}}% -} - -% @author should come last, but may come many times. -% It can also be used inside @quotation. -% -\parseargdef\author{% - \def\temp{\quotation}% - \ifx\thisenv\temp - \def\quotationauthor{#1}% printed in \Equotation. - \else - \checkenv\titlepage - \ifseenauthor\else \vskip 0pt plus 1filll \seenauthortrue \fi - {\secfonts\rm \leftline{#1}}% - \fi -} - - -% Set up page headings and footings. - -\let\thispage=\folio - -\newtoks\evenheadline % headline on even pages -\newtoks\oddheadline % headline on odd pages -\newtoks\evenfootline % footline on even pages -\newtoks\oddfootline % footline on odd pages - -% Now make \makeheadline and \makefootline in Plain TeX use those variables -\headline={{\textfonts\rm \ifodd\pageno \the\oddheadline - \else \the\evenheadline \fi}} -\footline={{\textfonts\rm \ifodd\pageno \the\oddfootline - \else \the\evenfootline \fi}\HEADINGShook} -\let\HEADINGShook=\relax - -% Commands to set those variables. -% For example, this is what @headings on does -% @evenheading @thistitle|@thispage|@thischapter -% @oddheading @thischapter|@thispage|@thistitle -% @evenfooting @thisfile|| -% @oddfooting ||@thisfile - - -\def\evenheading{\parsearg\evenheadingxxx} -\def\evenheadingxxx #1{\evenheadingyyy #1\|\|\|\|\finish} -\def\evenheadingyyy #1\|#2\|#3\|#4\finish{% -\global\evenheadline={\rlap{\centerline{#2}}\line{#1\hfil#3}}} - -\def\oddheading{\parsearg\oddheadingxxx} -\def\oddheadingxxx #1{\oddheadingyyy #1\|\|\|\|\finish} -\def\oddheadingyyy #1\|#2\|#3\|#4\finish{% -\global\oddheadline={\rlap{\centerline{#2}}\line{#1\hfil#3}}} - -\parseargdef\everyheading{\oddheadingxxx{#1}\evenheadingxxx{#1}}% - -\def\evenfooting{\parsearg\evenfootingxxx} -\def\evenfootingxxx #1{\evenfootingyyy #1\|\|\|\|\finish} -\def\evenfootingyyy #1\|#2\|#3\|#4\finish{% -\global\evenfootline={\rlap{\centerline{#2}}\line{#1\hfil#3}}} - -\def\oddfooting{\parsearg\oddfootingxxx} -\def\oddfootingxxx #1{\oddfootingyyy #1\|\|\|\|\finish} -\def\oddfootingyyy #1\|#2\|#3\|#4\finish{% - \global\oddfootline = {\rlap{\centerline{#2}}\line{#1\hfil#3}}% - % - % Leave some space for the footline. Hopefully ok to assume - % @evenfooting will not be used by itself. - \global\advance\txipageheight by -12pt - \global\advance\vsize by -12pt -} - -\parseargdef\everyfooting{\oddfootingxxx{#1}\evenfootingxxx{#1}} - -% @evenheadingmarks top \thischapter <- chapter at the top of a page -% @evenheadingmarks bottom \thischapter <- chapter at the bottom of a page -% -% The same set of arguments for: -% -% @oddheadingmarks -% @evenfootingmarks -% @oddfootingmarks -% @everyheadingmarks -% @everyfootingmarks - -% These define \getoddheadingmarks, \getevenheadingmarks, -% \getoddfootingmarks, and \getevenfootingmarks, each to one of -% \gettopheadingmarks, \getbottomheadingmarks. -% -\def\evenheadingmarks{\headingmarks{even}{heading}} -\def\oddheadingmarks{\headingmarks{odd}{heading}} -\def\evenfootingmarks{\headingmarks{even}{footing}} -\def\oddfootingmarks{\headingmarks{odd}{footing}} -\parseargdef\everyheadingmarks{\headingmarks{even}{heading}{#1} - \headingmarks{odd}{heading}{#1} } -\parseargdef\everyfootingmarks{\headingmarks{even}{footing}{#1} - \headingmarks{odd}{footing}{#1} } -% #1 = even/odd, #2 = heading/footing, #3 = top/bottom. -\def\headingmarks#1#2#3 {% - \expandafter\let\expandafter\temp \csname get#3headingmarks\endcsname - \global\expandafter\let\csname get#1#2marks\endcsname \temp -} - -\everyheadingmarks bottom -\everyfootingmarks bottom - -% @headings double turns headings on for double-sided printing. -% @headings single turns headings on for single-sided printing. -% @headings off turns them off. -% @headings on same as @headings double, retained for compatibility. -% @headings after turns on double-sided headings after this page. -% @headings doubleafter turns on double-sided headings after this page. -% @headings singleafter turns on single-sided headings after this page. -% By default, they are off at the start of a document, -% and turned `on' after @end titlepage. - -\parseargdef\headings{\csname HEADINGS#1\endcsname} - -\def\headingsoff{% non-global headings elimination - \evenheadline={\hfil}\evenfootline={\hfil}% - \oddheadline={\hfil}\oddfootline={\hfil}% -} - -\def\HEADINGSoff{{\globaldefs=1 \headingsoff}} % global setting -\HEADINGSoff % it's the default - -% When we turn headings on, set the page number to 1. -% For double-sided printing, put current file name in lower left corner, -% chapter name on inside top of right hand pages, document -% title on inside top of left hand pages, and page numbers on outside top -% edge of all pages. -\def\HEADINGSdouble{% -\global\pageno=1 -\global\evenfootline={\hfil} -\global\oddfootline={\hfil} -\global\evenheadline={\line{\folio\hfil\thistitle}} -\global\oddheadline={\line{\thischapterheading\hfil\folio}} -\global\let\contentsalignmacro = \chapoddpage -} -\let\contentsalignmacro = \chappager - -% For single-sided printing, chapter title goes across top left of page, -% page number on top right. -\def\HEADINGSsingle{% -\global\pageno=1 -\global\evenfootline={\hfil} -\global\oddfootline={\hfil} -\global\evenheadline={\line{\thischapterheading\hfil\folio}} -\global\oddheadline={\line{\thischapterheading\hfil\folio}} -\global\let\contentsalignmacro = \chappager -} -\def\HEADINGSon{\HEADINGSdouble} - -\def\HEADINGSafter{\let\HEADINGShook=\HEADINGSdoublex} -\let\HEADINGSdoubleafter=\HEADINGSafter -\def\HEADINGSdoublex{% -\global\evenfootline={\hfil} -\global\oddfootline={\hfil} -\global\evenheadline={\line{\folio\hfil\thistitle}} -\global\oddheadline={\line{\thischapterheading\hfil\folio}} -\global\let\contentsalignmacro = \chapoddpage -} - -\def\HEADINGSsingleafter{\let\HEADINGShook=\HEADINGSsinglex} -\def\HEADINGSsinglex{% -\global\evenfootline={\hfil} -\global\oddfootline={\hfil} -\global\evenheadline={\line{\thischapterheading\hfil\folio}} -\global\oddheadline={\line{\thischapterheading\hfil\folio}} -\global\let\contentsalignmacro = \chappager -} - -% Subroutines used in generating headings -% This produces Day Month Year style of output. -% Only define if not already defined, in case a txi-??.tex file has set -% up a different format (e.g., txi-cs.tex does this). -\ifx\today\thisisundefined -\def\today{% - \number\day\space - \ifcase\month - \or\putwordMJan\or\putwordMFeb\or\putwordMMar\or\putwordMApr - \or\putwordMMay\or\putwordMJun\or\putwordMJul\or\putwordMAug - \or\putwordMSep\or\putwordMOct\or\putwordMNov\or\putwordMDec - \fi - \space\number\year} -\fi - -% @settitle line... specifies the title of the document, for headings. -% It generates no output of its own. -\def\thistitle{\putwordNoTitle} -\def\settitle{\parsearg{\gdef\thistitle}} - - -\message{tables,} -% Tables -- @table, @ftable, @vtable, @item(x). - -% default indentation of table text -\newdimen\tableindent \tableindent=.8in -% default indentation of @itemize and @enumerate text -\newdimen\itemindent \itemindent=.3in -% margin between end of table item and start of table text. -\newdimen\itemmargin \itemmargin=.1in - -% used internally for \itemindent minus \itemmargin -\newdimen\itemmax - -% Note @table, @ftable, and @vtable define @item, @itemx, etc., with -% these defs. -% They also define \itemindex -% to index the item name in whatever manner is desired (perhaps none). - -\newif\ifitemxneedsnegativevskip - -\def\itemxpar{\par\ifitemxneedsnegativevskip\nobreak\vskip-\parskip\nobreak\fi} - -\def\internalBitem{\smallbreak \parsearg\itemzzz} -\def\internalBitemx{\itemxpar \parsearg\itemzzz} - -\def\itemzzz #1{\begingroup % - \advance\hsize by -\rightskip - \advance\hsize by -\tableindent - \setbox0=\hbox{\itemindicate{#1}}% - \itemindex{#1}% - \nobreak % This prevents a break before @itemx. - % - % If the item text does not fit in the space we have, put it on a line - % by itself, and do not allow a page break either before or after that - % line. We do not start a paragraph here because then if the next - % command is, e.g., @kindex, the whatsit would get put into the - % horizontal list on a line by itself, resulting in extra blank space. - \ifdim \wd0>\itemmax - % - % Make this a paragraph so we get the \parskip glue and wrapping, - % but leave it ragged-right. - \begingroup - \advance\leftskip by-\tableindent - \advance\hsize by\tableindent - \advance\rightskip by0pt plus1fil\relax - \leavevmode\unhbox0\par - \endgroup - % - % We're going to be starting a paragraph, but we don't want the - % \parskip glue -- logically it's part of the @item we just started. - \nobreak \vskip-\parskip - % - % Stop a page break at the \parskip glue coming up. However, if - % what follows is an environment such as @example, there will be no - % \parskip glue; then the negative vskip we just inserted would - % cause the example and the item to crash together. So we use this - % bizarre value of 10001 as a signal to \aboveenvbreak to insert - % \parskip glue after all. Section titles are handled this way also. - % - \penalty 10001 - \endgroup - \itemxneedsnegativevskipfalse - \else - % The item text fits into the space. Start a paragraph, so that the - % following text (if any) will end up on the same line. - \noindent - % Do this with kerns and \unhbox so that if there is a footnote in - % the item text, it can migrate to the main vertical list and - % eventually be printed. - \nobreak\kern-\tableindent - \dimen0 = \itemmax \advance\dimen0 by \itemmargin \advance\dimen0 by -\wd0 - \unhbox0 - \nobreak\kern\dimen0 - \endgroup - \itemxneedsnegativevskiptrue - \fi -} - -\def\item{\errmessage{@item while not in a list environment}} -\def\itemx{\errmessage{@itemx while not in a list environment}} - -% @table, @ftable, @vtable. -\envdef\table{% - \let\itemindex\gobble - \tablecheck{table}% -} -\envdef\ftable{% - \def\itemindex ##1{\doind {fn}{\code{##1}}}% - \tablecheck{ftable}% -} -\envdef\vtable{% - \def\itemindex ##1{\doind {vr}{\code{##1}}}% - \tablecheck{vtable}% -} -\def\tablecheck#1{% - \ifnum \the\catcode`\^^M=\active - \endgroup - \errmessage{This command won't work in this context; perhaps the problem is - that we are \inenvironment\thisenv}% - \def\next{\doignore{#1}}% - \else - \let\next\tablex - \fi - \next -} -\def\tablex#1{% - \def\itemindicate{#1}% - \parsearg\tabley -} -\def\tabley#1{% - {% - \makevalueexpandable - \edef\temp{\noexpand\tablez #1\space\space\space}% - \expandafter - }\temp \endtablez -} -\def\tablez #1 #2 #3 #4\endtablez{% - \aboveenvbreak - \ifnum 0#1>0 \advance \leftskip by #1\mil \fi - \ifnum 0#2>0 \tableindent=#2\mil \fi - \ifnum 0#3>0 \advance \rightskip by #3\mil \fi - \itemmax=\tableindent - \advance \itemmax by -\itemmargin - \advance \leftskip by \tableindent - \exdentamount=\tableindent - \parindent = 0pt - \parskip = \smallskipamount - \ifdim \parskip=0pt \parskip=2pt \fi - \let\item = \internalBitem - \let\itemx = \internalBitemx -} -\def\Etable{\endgraf\afterenvbreak} -\let\Eftable\Etable -\let\Evtable\Etable -\let\Eitemize\Etable -\let\Eenumerate\Etable - -% This is the counter used by @enumerate, which is really @itemize - -\newcount \itemno - -\envdef\itemize{\parsearg\doitemize} - -\def\doitemize#1{% - \aboveenvbreak - \itemmax=\itemindent - \advance\itemmax by -\itemmargin - \advance\leftskip by \itemindent - \exdentamount=\itemindent - \parindent=0pt - \parskip=\smallskipamount - \ifdim\parskip=0pt \parskip=2pt \fi - % - % Try typesetting the item mark so that if the document erroneously says - % something like @itemize @samp (intending @table), there's an error - % right away at the @itemize. It's not the best error message in the - % world, but it's better than leaving it to the @item. This means if - % the user wants an empty mark, they have to say @w{} not just @w. - \def\itemcontents{#1}% - \setbox0 = \hbox{\itemcontents}% - % - % @itemize with no arg is equivalent to @itemize @bullet. - \ifx\itemcontents\empty\def\itemcontents{\bullet}\fi - % - \let\item=\itemizeitem -} - -% Definition of @item while inside @itemize and @enumerate. -% -\def\itemizeitem{% - \advance\itemno by 1 % for enumerations - {\let\par=\endgraf \smallbreak}% reasonable place to break - {% - % If the document has an @itemize directly after a section title, a - % \nobreak will be last on the list, and \sectionheading will have - % done a \vskip-\parskip. In that case, we don't want to zero - % parskip, or the item text will crash with the heading. On the - % other hand, when there is normal text preceding the item (as there - % usually is), we do want to zero parskip, or there would be too much - % space. In that case, we won't have a \nobreak before. At least - % that's the theory. - \ifnum\lastpenalty<10000 \parskip=0in \fi - \noindent - \hbox to 0pt{\hss \itemcontents \kern\itemmargin}% - % - \ifinner\else - \vadjust{\penalty 1200}% not good to break after first line of item. - \fi - % We can be in inner vertical mode in a footnote, although an - % @itemize looks awful there. - }% - \flushcr -} - -% \splitoff TOKENS\endmark defines \first to be the first token in -% TOKENS, and \rest to be the remainder. -% -\def\splitoff#1#2\endmark{\def\first{#1}\def\rest{#2}}% - -% Allow an optional argument of an uppercase letter, lowercase letter, -% or number, to specify the first label in the enumerated list. No -% argument is the same as `1'. -% -\envparseargdef\enumerate{\enumeratey #1 \endenumeratey} -\def\enumeratey #1 #2\endenumeratey{% - % If we were given no argument, pretend we were given `1'. - \def\thearg{#1}% - \ifx\thearg\empty \def\thearg{1}\fi - % - % Detect if the argument is a single token. If so, it might be a - % letter. Otherwise, the only valid thing it can be is a number. - % (We will always have one token, because of the test we just made. - % This is a good thing, since \splitoff doesn't work given nothing at - % all -- the first parameter is undelimited.) - \expandafter\splitoff\thearg\endmark - \ifx\rest\empty - % Only one token in the argument. It could still be anything. - % A ``lowercase letter'' is one whose \lccode is nonzero. - % An ``uppercase letter'' is one whose \lccode is both nonzero, and - % not equal to itself. - % Otherwise, we assume it's a number. - % - % We need the \relax at the end of the \ifnum lines to stop TeX from - % continuing to look for a . - % - \ifnum\lccode\expandafter`\thearg=0\relax - \numericenumerate % a number (we hope) - \else - % It's a letter. - \ifnum\lccode\expandafter`\thearg=\expandafter`\thearg\relax - \lowercaseenumerate % lowercase letter - \else - \uppercaseenumerate % uppercase letter - \fi - \fi - \else - % Multiple tokens in the argument. We hope it's a number. - \numericenumerate - \fi -} - -% An @enumerate whose labels are integers. The starting integer is -% given in \thearg. -% -\def\numericenumerate{% - \itemno = \thearg - \startenumeration{\the\itemno}% -} - -% The starting (lowercase) letter is in \thearg. -\def\lowercaseenumerate{% - \itemno = \expandafter`\thearg - \startenumeration{% - % Be sure we're not beyond the end of the alphabet. - \ifnum\itemno=0 - \errmessage{No more lowercase letters in @enumerate; get a bigger - alphabet}% - \fi - \char\lccode\itemno - }% -} - -% The starting (uppercase) letter is in \thearg. -\def\uppercaseenumerate{% - \itemno = \expandafter`\thearg - \startenumeration{% - % Be sure we're not beyond the end of the alphabet. - \ifnum\itemno=0 - \errmessage{No more uppercase letters in @enumerate; get a bigger - alphabet} - \fi - \char\uccode\itemno - }% -} - -% Call \doitemize, adding a period to the first argument and supplying the -% common last two arguments. Also subtract one from the initial value in -% \itemno, since @item increments \itemno. -% -\def\startenumeration#1{% - \advance\itemno by -1 - \doitemize{#1.}\flushcr -} - -% @alphaenumerate and @capsenumerate are abbreviations for giving an arg -% to @enumerate. -% -\def\alphaenumerate{\enumerate{a}} -\def\capsenumerate{\enumerate{A}} -\def\Ealphaenumerate{\Eenumerate} -\def\Ecapsenumerate{\Eenumerate} - - -% @multitable macros -% Amy Hendrickson, 8/18/94, 3/6/96 -% -% @multitable ... @end multitable will make as many columns as desired. -% Contents of each column will wrap at width given in preamble. Width -% can be specified either with sample text given in a template line, -% or in percent of \hsize, the current width of text on page. - -% Table can continue over pages but will only break between lines. - -% To make preamble: -% -% Either define widths of columns in terms of percent of \hsize: -% @multitable @columnfractions .25 .3 .45 -% @item ... -% -% Numbers following @columnfractions are the percent of the total -% current hsize to be used for each column. You may use as many -% columns as desired. - - -% Or use a template: -% @multitable {Column 1 template} {Column 2 template} {Column 3 template} -% @item ... -% using the widest term desired in each column. - -% Each new table line starts with @item, each subsequent new column -% starts with @tab. Empty columns may be produced by supplying @tab's -% with nothing between them for as many times as empty columns are needed, -% ie, @tab@tab@tab will produce two empty columns. - -% @item, @tab do not need to be on their own lines, but it will not hurt -% if they are. - -% Sample multitable: - -% @multitable {Column 1 template} {Column 2 template} {Column 3 template} -% @item first col stuff @tab second col stuff @tab third col -% @item -% first col stuff -% @tab -% second col stuff -% @tab -% third col -% @item first col stuff @tab second col stuff -% @tab Many paragraphs of text may be used in any column. -% -% They will wrap at the width determined by the template. -% @item@tab@tab This will be in third column. -% @end multitable - -% Default dimensions may be reset by user. -% @multitableparskip is vertical space between paragraphs in table. -% @multitableparindent is paragraph indent in table. -% @multitablecolmargin is horizontal space to be left between columns. -% @multitablelinespace is space to leave between table items, baseline -% to baseline. -% 0pt means it depends on current normal line spacing. -% -\newskip\multitableparskip -\newskip\multitableparindent -\newdimen\multitablecolspace -\newskip\multitablelinespace -\multitableparskip=0pt -\multitableparindent=6pt -\multitablecolspace=12pt -\multitablelinespace=0pt - -% Macros used to set up halign preamble: -% -\let\endsetuptable\relax -\def\xendsetuptable{\endsetuptable} -\let\columnfractions\relax -\def\xcolumnfractions{\columnfractions} -\newif\ifsetpercent - -% #1 is the @columnfraction, usually a decimal number like .5, but might -% be just 1. We just use it, whatever it is. -% -\def\pickupwholefraction#1 {% - \global\advance\colcount by 1 - \expandafter\xdef\csname col\the\colcount\endcsname{#1\hsize}% - \setuptable -} - -\newcount\colcount -\def\setuptable#1{% - \def\firstarg{#1}% - \ifx\firstarg\xendsetuptable - \let\go = \relax - \else - \ifx\firstarg\xcolumnfractions - \global\setpercenttrue - \else - \ifsetpercent - \let\go\pickupwholefraction - \else - \global\advance\colcount by 1 - \setbox0=\hbox{#1\unskip\space}% Add a normal word space as a - % separator; typically that is always in the input, anyway. - \expandafter\xdef\csname col\the\colcount\endcsname{\the\wd0}% - \fi - \fi - \ifx\go\pickupwholefraction - % Put the argument back for the \pickupwholefraction call, so - % we'll always have a period there to be parsed. - \def\go{\pickupwholefraction#1}% - \else - \let\go = \setuptable - \fi% - \fi - \go -} - -% multitable-only commands. -% -% @headitem starts a heading row, which we typeset in bold. Assignments -% have to be global since we are inside the implicit group of an -% alignment entry. \everycr below resets \everytab so we don't have to -% undo it ourselves. -\def\headitemfont{\b}% for people to use in the template row; not changeable -\def\headitem{% - \checkenv\multitable - \crcr - \gdef\headitemcrhook{\nobreak}% attempt to avoid page break after headings - \global\everytab={\bf}% can't use \headitemfont since the parsing differs - \the\everytab % for the first item -}% -% -% default for tables with no headings. -\let\headitemcrhook=\relax -% -% A \tab used to include \hskip1sp. But then the space in a template -% line is not enough. That is bad. So let's go back to just `&' until -% we again encounter the problem the 1sp was intended to solve. -% --karl, nathan@acm.org, 20apr99. -\def\tab{\checkenv\multitable &\the\everytab}% - -% @multitable ... @end multitable definitions: -% -\newtoks\everytab % insert after every tab. -% -\envdef\multitable{% - \vskip\parskip - \startsavinginserts - % - % @item within a multitable starts a normal row. - % We use \def instead of \let so that if one of the multitable entries - % contains an @itemize, we don't choke on the \item (seen as \crcr aka - % \endtemplate) expanding \doitemize. - \def\item{\crcr}% - % - \tolerance=9500 - \hbadness=9500 - \setmultitablespacing - \parskip=\multitableparskip - \parindent=\multitableparindent - \overfullrule=0pt - \global\colcount=0 - % - \everycr = {% - \noalign{% - \global\everytab={}% Reset from possible headitem. - \global\colcount=0 % Reset the column counter. - % - % Check for saved footnotes, etc.: - \checkinserts - % - % Perhaps a \nobreak, then reset: - \headitemcrhook - \global\let\headitemcrhook=\relax - }% - }% - % - \parsearg\domultitable -} -\def\domultitable#1{% - % To parse everything between @multitable and @item: - \setuptable#1 \endsetuptable - % - % This preamble sets up a generic column definition, which will - % be used as many times as user calls for columns. - % \vtop will set a single line and will also let text wrap and - % continue for many paragraphs if desired. - \halign\bgroup &% - \global\advance\colcount by 1 - \multistrut - \vtop{% - % Use the current \colcount to find the correct column width: - \hsize=\expandafter\csname col\the\colcount\endcsname - % - % In order to keep entries from bumping into each other - % we will add a \leftskip of \multitablecolspace to all columns after - % the first one. - % - % If a template has been used, we will add \multitablecolspace - % to the width of each template entry. - % - % If the user has set preamble in terms of percent of \hsize we will - % use that dimension as the width of the column, and the \leftskip - % will keep entries from bumping into each other. Table will start at - % left margin and final column will justify at right margin. - % - % Make sure we don't inherit \rightskip from the outer environment. - \rightskip=0pt - \ifnum\colcount=1 - % The first column will be indented with the surrounding text. - \advance\hsize by\leftskip - \else - \ifsetpercent \else - % If user has not set preamble in terms of percent of \hsize - % we will advance \hsize by \multitablecolspace. - \advance\hsize by \multitablecolspace - \fi - % In either case we will make \leftskip=\multitablecolspace: - \leftskip=\multitablecolspace - \fi - % Ignoring space at the beginning and end avoids an occasional spurious - % blank line, when TeX decides to break the line at the space before the - % box from the multistrut, so the strut ends up on a line by itself. - % For example: - % @multitable @columnfractions .11 .89 - % @item @code{#} - % @tab Legal holiday which is valid in major parts of the whole country. - % Is automatically provided with highlighting sequences respectively - % marking characters. - \noindent\ignorespaces##\unskip\multistrut - }\cr -} -\def\Emultitable{% - \crcr - \egroup % end the \halign - \global\setpercentfalse -} - -\def\setmultitablespacing{% - \def\multistrut{\strut}% just use the standard line spacing - % - % Compute \multitablelinespace (if not defined by user) for use in - % \multitableparskip calculation. We used define \multistrut based on - % this, but (ironically) that caused the spacing to be off. - % See bug-texinfo report from Werner Lemberg, 31 Oct 2004 12:52:20 +0100. -\ifdim\multitablelinespace=0pt -\setbox0=\vbox{X}\global\multitablelinespace=\the\baselineskip -\global\advance\multitablelinespace by-\ht0 -\fi -% Test to see if parskip is larger than space between lines of -% table. If not, do nothing. -% If so, set to same dimension as multitablelinespace. -\ifdim\multitableparskip>\multitablelinespace -\global\multitableparskip=\multitablelinespace -\global\advance\multitableparskip-7pt % to keep parskip somewhat smaller - % than skip between lines in the table. -\fi% -\ifdim\multitableparskip=0pt -\global\multitableparskip=\multitablelinespace -\global\advance\multitableparskip-7pt % to keep parskip somewhat smaller - % than skip between lines in the table. -\fi} - - -\message{conditionals,} - -% @iftex, @ifnotdocbook, @ifnothtml, @ifnotinfo, @ifnotplaintext, -% @ifnotxml always succeed. They currently do nothing; we don't -% attempt to check whether the conditionals are properly nested. But we -% have to remember that they are conditionals, so that @end doesn't -% attempt to close an environment group. -% -\def\makecond#1{% - \expandafter\let\csname #1\endcsname = \relax - \expandafter\let\csname iscond.#1\endcsname = 1 -} -\makecond{iftex} -\makecond{ifnotdocbook} -\makecond{ifnothtml} -\makecond{ifnotinfo} -\makecond{ifnotplaintext} -\makecond{ifnotxml} - -% Ignore @ignore, @ifhtml, @ifinfo, and the like. -% -\def\direntry{\doignore{direntry}} -\def\documentdescription{\doignore{documentdescription}} -\def\docbook{\doignore{docbook}} -\def\html{\doignore{html}} -\def\ifdocbook{\doignore{ifdocbook}} -\def\ifhtml{\doignore{ifhtml}} -\def\ifinfo{\doignore{ifinfo}} -\def\ifnottex{\doignore{ifnottex}} -\def\ifplaintext{\doignore{ifplaintext}} -\def\ifxml{\doignore{ifxml}} -\def\ignore{\doignore{ignore}} -\def\menu{\doignore{menu}} -\def\xml{\doignore{xml}} - -% Ignore text until a line `@end #1', keeping track of nested conditionals. -% -% A count to remember the depth of nesting. -\newcount\doignorecount - -\def\doignore#1{\begingroup - % Scan in ``verbatim'' mode: - \obeylines - \catcode`\@ = \other - \catcode`\{ = \other - \catcode`\} = \other - % - % Make sure that spaces turn into tokens that match what \doignoretext wants. - \spaceisspace - % - % Count number of #1's that we've seen. - \doignorecount = 0 - % - % Swallow text until we reach the matching `@end #1'. - \dodoignore{#1}% -} - -{ \catcode`_=11 % We want to use \_STOP_ which cannot appear in texinfo source. - \obeylines % - % - \gdef\dodoignore#1{% - % #1 contains the command name as a string, e.g., `ifinfo'. - % - % Define a command to find the next `@end #1'. - \long\def\doignoretext##1^^M@end #1{% - \doignoretextyyy##1^^M@#1\_STOP_}% - % - % And this command to find another #1 command, at the beginning of a - % line. (Otherwise, we would consider a line `@c @ifset', for - % example, to count as an @ifset for nesting.) - \long\def\doignoretextyyy##1^^M@#1##2\_STOP_{\doignoreyyy{##2}\_STOP_}% - % - % And now expand that command. - \doignoretext ^^M% - }% -} - -\def\doignoreyyy#1{% - \def\temp{#1}% - \ifx\temp\empty % Nothing found. - \let\next\doignoretextzzz - \else % Found a nested condition, ... - \advance\doignorecount by 1 - \let\next\doignoretextyyy % ..., look for another. - % If we're here, #1 ends with ^^M\ifinfo (for example). - \fi - \next #1% the token \_STOP_ is present just after this macro. -} - -% We have to swallow the remaining "\_STOP_". -% -\def\doignoretextzzz#1{% - \ifnum\doignorecount = 0 % We have just found the outermost @end. - \let\next\enddoignore - \else % Still inside a nested condition. - \advance\doignorecount by -1 - \let\next\doignoretext % Look for the next @end. - \fi - \next -} - -% Finish off ignored text. -{ \obeylines% - % Ignore anything after the last `@end #1'; this matters in verbatim - % environments, where otherwise the newline after an ignored conditional - % would result in a blank line in the output. - \gdef\enddoignore#1^^M{\endgroup\ignorespaces}% -} - - -% @set VAR sets the variable VAR to an empty value. -% @set VAR REST-OF-LINE sets VAR to the value REST-OF-LINE. -% -% Since we want to separate VAR from REST-OF-LINE (which might be -% empty), we can't just use \parsearg; we have to insert a space of our -% own to delimit the rest of the line, and then take it out again if we -% didn't need it. -% We rely on the fact that \parsearg sets \catcode`\ =10. -% -\parseargdef\set{\setyyy#1 \endsetyyy} -\def\setyyy#1 #2\endsetyyy{% - {% - \makevalueexpandable - \def\temp{#2}% - \edef\next{\gdef\makecsname{SET#1}}% - \ifx\temp\empty - \next{}% - \else - \setzzz#2\endsetzzz - \fi - }% -} -% Remove the trailing space \setxxx inserted. -\def\setzzz#1 \endsetzzz{\next{#1}} - -% @clear VAR clears (i.e., unsets) the variable VAR. -% -\parseargdef\clear{% - {% - \makevalueexpandable - \global\expandafter\let\csname SET#1\endcsname=\relax - }% -} - -% @value{foo} gets the text saved in variable foo. -\def\value{\begingroup\makevalueexpandable\valuexxx} -\def\valuexxx#1{\expandablevalue{#1}\endgroup} -{ - \catcode`\-=\active \catcode`\_=\active - % - \gdef\makevalueexpandable{% - \let\value = \expandablevalue - % We don't want these characters active, ... - \catcode`\-=\other \catcode`\_=\other - % ..., but we might end up with active ones in the argument if - % we're called from @code, as @code{@value{foo-bar_}}, though. - % So \let them to their normal equivalents. - \let-\normaldash \let_\normalunderscore - } -} - -% We have this subroutine so that we can handle at least some @value's -% properly in indexes (we call \makevalueexpandable in \indexdummies). -% The command has to be fully expandable (if the variable is set), since -% the result winds up in the index file. This means that if the -% variable's value contains other Texinfo commands, it's almost certain -% it will fail (although perhaps we could fix that with sufficient work -% to do a one-level expansion on the result, instead of complete). -% -% Unfortunately, this has the consequence that when _ is in the *value* -% of an @set, it does not print properly in the roman fonts (get the cmr -% dot accent at position 126 instead). No fix comes to mind, and it's -% been this way since 2003 or earlier, so just ignore it. -% -\def\expandablevalue#1{% - \expandafter\ifx\csname SET#1\endcsname\relax - {[No value for ``#1'']}% - \message{Variable `#1', used in @value, is not set.}% - \else - \csname SET#1\endcsname - \fi -} - -% Like \expandablevalue, but completely expandable (the \message in the -% definition above operates at the execution level of TeX). Used when -% writing to auxiliary files, due to the expansion that \write does. -% If flag is undefined, pass through an unexpanded @value command: maybe it -% will be set by the time it is read back in. -% -% NB flag names containing - or _ may not work here. -\def\dummyvalue#1{% - \expandafter\ifx\csname SET#1\endcsname\relax - \noexpand\value{#1}% - \else - \csname SET#1\endcsname - \fi -} - -% Used for @value's in index entries to form the sort key: expand the @value -% if possible, otherwise sort late. -\def\indexnofontsvalue#1{% - \expandafter\ifx\csname SET#1\endcsname\relax - ZZZZZZZ - \else - \csname SET#1\endcsname - \fi -} - -% @ifset VAR ... @end ifset reads the `...' iff VAR has been defined -% with @set. -% -% To get the special treatment we need for `@end ifset,' we call -% \makecond and then redefine. -% -\makecond{ifset} -\def\ifset{\parsearg{\doifset{\let\next=\ifsetfail}}} -\def\doifset#1#2{% - {% - \makevalueexpandable - \let\next=\empty - \expandafter\ifx\csname SET#2\endcsname\relax - #1% If not set, redefine \next. - \fi - \expandafter - }\next -} -\def\ifsetfail{\doignore{ifset}} - -% @ifclear VAR ... @end executes the `...' iff VAR has never been -% defined with @set, or has been undefined with @clear. -% -% The `\else' inside the `\doifset' parameter is a trick to reuse the -% above code: if the variable is not set, do nothing, if it is set, -% then redefine \next to \ifclearfail. -% -\makecond{ifclear} -\def\ifclear{\parsearg{\doifset{\else \let\next=\ifclearfail}}} -\def\ifclearfail{\doignore{ifclear}} - -% @ifcommandisdefined CMD ... @end executes the `...' if CMD (written -% without the @) is in fact defined. We can only feasibly check at the -% TeX level, so something like `mathcode' is going to considered -% defined even though it is not a Texinfo command. -% -\makecond{ifcommanddefined} -\def\ifcommanddefined{\parsearg{\doifcmddefined{\let\next=\ifcmddefinedfail}}} -% -\def\doifcmddefined#1#2{{% - \makevalueexpandable - \let\next=\empty - \expandafter\ifx\csname #2\endcsname\relax - #1% If not defined, \let\next as above. - \fi - \expandafter - }\next -} -\def\ifcmddefinedfail{\doignore{ifcommanddefined}} - -% @ifcommandnotdefined CMD ... handled similar to @ifclear above. -\makecond{ifcommandnotdefined} -\def\ifcommandnotdefined{% - \parsearg{\doifcmddefined{\else \let\next=\ifcmdnotdefinedfail}}} -\def\ifcmdnotdefinedfail{\doignore{ifcommandnotdefined}} - -% Set the `txicommandconditionals' variable, so documents have a way to -% test if the @ifcommand...defined conditionals are available. -\set txicommandconditionals - -% @dircategory CATEGORY -- specify a category of the dir file -% which this file should belong to. Ignore this in TeX. -\let\dircategory=\comment - -% @defininfoenclose. -\let\definfoenclose=\comment - - -\message{indexing,} -% Index generation facilities - -% Define \newwrite to be identical to plain tex's \newwrite -% except not \outer, so it can be used within macros and \if's. -\edef\newwrite{\makecsname{ptexnewwrite}} - -% \newindex {foo} defines an index named IX. -% It automatically defines \IXindex such that -% \IXindex ...rest of line... puts an entry in the index IX. -% It also defines \IXindfile to be the number of the output channel for -% the file that accumulates this index. The file's extension is IX. -% The name of an index should be no more than 2 characters long -% for the sake of vms. -% -\def\newindex#1{% - \expandafter\chardef\csname#1indfile\endcsname=0 - \expandafter\xdef\csname#1index\endcsname{% % Define @#1index - \noexpand\doindex{#1}} -} - -% @defindex foo == \newindex{foo} -% -\def\defindex{\parsearg\newindex} - -% Define @defcodeindex, like @defindex except put all entries in @code. -% -\def\defcodeindex{\parsearg\newcodeindex} -% -\def\newcodeindex#1{% - \expandafter\chardef\csname#1indfile\endcsname=0 - \expandafter\xdef\csname#1index\endcsname{% - \noexpand\docodeindex{#1}}% -} - -% The default indices: -\newindex{cp}% concepts, -\newcodeindex{fn}% functions, -\newcodeindex{vr}% variables, -\newcodeindex{tp}% types, -\newcodeindex{ky}% keys -\newcodeindex{pg}% and programs. - - -% @synindex foo bar makes index foo feed into index bar. -% Do this instead of @defindex foo if you don't want it as a separate index. -% -% @syncodeindex foo bar similar, but put all entries made for index foo -% inside @code. -% -\def\synindex#1 #2 {\dosynindex\doindex{#1}{#2}} -\def\syncodeindex#1 #2 {\dosynindex\docodeindex{#1}{#2}} - -% #1 is \doindex or \docodeindex, #2 the index getting redefined (foo), -% #3 the target index (bar). -\def\dosynindex#1#2#3{% - \requireopenindexfile{#3}% - % redefine \fooindfile: - \expandafter\let\expandafter\temp\expandafter=\csname#3indfile\endcsname - \expandafter\let\csname#2indfile\endcsname=\temp - % redefine \fooindex: - \expandafter\xdef\csname#2index\endcsname{\noexpand#1{#3}}% -} - -% Define \doindex, the driver for all index macros. -% Argument #1 is generated by the calling \fooindex macro, -% and it is the two-letter name of the index. - -\def\doindex#1{\edef\indexname{#1}\parsearg\doindexxxx} -\def\doindexxxx #1{\doind{\indexname}{#1}} - -% like the previous two, but they put @code around the argument. -\def\docodeindex#1{\edef\indexname{#1}\parsearg\docodeindexxxx} -\def\docodeindexxxx #1{\doind{\indexname}{\code{#1}}} - - -% Used for the aux, toc and index files to prevent expansion of Texinfo -% commands. -% -\def\atdummies{% - \definedummyletter\@% - \definedummyletter\ % - \definedummyletter\{% - \definedummyletter\}% - % - % Do the redefinitions. - \definedummies - \otherbackslash -} - -% \definedummyword defines \#1 as \string\#1\space, thus effectively -% preventing its expansion. This is used only for control words, -% not control letters, because the \space would be incorrect for -% control characters, but is needed to separate the control word -% from whatever follows. -% -% These can be used both for control words that take an argument and -% those that do not. If it is followed by {arg} in the input, then -% that will dutifully get written to the index (or wherever). -% -% For control letters, we have \definedummyletter, which omits the -% space. -% -\def\definedummyword #1{\def#1{\string#1\space}}% -\def\definedummyletter#1{\def#1{\string#1}}% -\let\definedummyaccent\definedummyletter - -% Called from \atdummies to prevent the expansion of commands. -% -\def\definedummies{% - % - \let\commondummyword\definedummyword - \let\commondummyletter\definedummyletter - \let\commondummyaccent\definedummyaccent - \commondummiesnofonts - % - \definedummyletter\_% - \definedummyletter\-% - % - % Non-English letters. - \definedummyword\AA - \definedummyword\AE - \definedummyword\DH - \definedummyword\L - \definedummyword\O - \definedummyword\OE - \definedummyword\TH - \definedummyword\aa - \definedummyword\ae - \definedummyword\dh - \definedummyword\exclamdown - \definedummyword\l - \definedummyword\o - \definedummyword\oe - \definedummyword\ordf - \definedummyword\ordm - \definedummyword\questiondown - \definedummyword\ss - \definedummyword\th - % - % Although these internal commands shouldn't show up, sometimes they do. - \definedummyword\bf - \definedummyword\gtr - \definedummyword\hat - \definedummyword\less - \definedummyword\sf - \definedummyword\sl - \definedummyword\tclose - \definedummyword\tt - % - \definedummyword\LaTeX - \definedummyword\TeX - % - % Assorted special characters. - \definedummyword\atchar - \definedummyword\arrow - \definedummyword\bullet - \definedummyword\comma - \definedummyword\copyright - \definedummyword\registeredsymbol - \definedummyword\dots - \definedummyword\enddots - \definedummyword\entrybreak - \definedummyword\equiv - \definedummyword\error - \definedummyword\euro - \definedummyword\expansion - \definedummyword\geq - \definedummyword\guillemetleft - \definedummyword\guillemetright - \definedummyword\guilsinglleft - \definedummyword\guilsinglright - \definedummyword\lbracechar - \definedummyword\leq - \definedummyword\mathopsup - \definedummyword\minus - \definedummyword\ogonek - \definedummyword\pounds - \definedummyword\point - \definedummyword\print - \definedummyword\quotedblbase - \definedummyword\quotedblleft - \definedummyword\quotedblright - \definedummyword\quoteleft - \definedummyword\quoteright - \definedummyword\quotesinglbase - \definedummyword\rbracechar - \definedummyword\result - \definedummyword\sub - \definedummyword\sup - \definedummyword\textdegree - % - % We want to disable all macros so that they are not expanded by \write. - \macrolist - \let\value\dummyvalue - % - \normalturnoffactive -} - -% \commondummiesnofonts: common to \definedummies and \indexnofonts. -% Define \commondummyletter, \commondummyaccent and \commondummyword before -% using. Used for accents, font commands, and various control letters. -% -\def\commondummiesnofonts{% - % Control letters and accents. - \commondummyletter\!% - \commondummyaccent\"% - \commondummyaccent\'% - \commondummyletter\*% - \commondummyaccent\,% - \commondummyletter\.% - \commondummyletter\/% - \commondummyletter\:% - \commondummyaccent\=% - \commondummyletter\?% - \commondummyaccent\^% - \commondummyaccent\`% - \commondummyaccent\~% - \commondummyword\u - \commondummyword\v - \commondummyword\H - \commondummyword\dotaccent - \commondummyword\ogonek - \commondummyword\ringaccent - \commondummyword\tieaccent - \commondummyword\ubaraccent - \commondummyword\udotaccent - \commondummyword\dotless - % - % Texinfo font commands. - \commondummyword\b - \commondummyword\i - \commondummyword\r - \commondummyword\sansserif - \commondummyword\sc - \commondummyword\slanted - \commondummyword\t - % - % Commands that take arguments. - \commondummyword\abbr - \commondummyword\acronym - \commondummyword\anchor - \commondummyword\cite - \commondummyword\code - \commondummyword\command - \commondummyword\dfn - \commondummyword\dmn - \commondummyword\email - \commondummyword\emph - \commondummyword\env - \commondummyword\file - \commondummyword\image - \commondummyword\indicateurl - \commondummyword\inforef - \commondummyword\kbd - \commondummyword\key - \commondummyword\math - \commondummyword\option - \commondummyword\pxref - \commondummyword\ref - \commondummyword\samp - \commondummyword\strong - \commondummyword\tie - \commondummyword\U - \commondummyword\uref - \commondummyword\url - \commondummyword\var - \commondummyword\verb - \commondummyword\w - \commondummyword\xref -} - -\let\indexlbrace\relax -\let\indexrbrace\relax -\let\indexatchar\relax - -{\catcode`\@=0 -\catcode`\\=13 - @gdef@backslashdisappear{@def\{}} -} - -{ -\catcode`\<=13 -\catcode`\-=13 -\catcode`\`=13 - \gdef\indexnonalnumdisappear{% - \expandafter\ifx\csname SETtxiindexlquoteignore\endcsname\relax\else - % @set txiindexlquoteignore makes us ignore left quotes in the sort term. - % (Introduced for FSFS 2nd ed.) - \let`=\empty - \fi - % - \expandafter\ifx\csname SETtxiindexbackslashignore\endcsname\relax\else - \backslashdisappear - \fi - % - \expandafter\ifx\csname SETtxiindexhyphenignore\endcsname\relax\else - \def-{}% - \fi - \expandafter\ifx\csname SETtxiindexlessthanignore\endcsname\relax\else - \def<{}% - \fi - \expandafter\ifx\csname SETtxiindexatsignignore\endcsname\relax\else - \def\@{}% - \fi - } - - \gdef\indexnonalnumreappear{% - \let-\normaldash - \let<\normalless - } -} - - -% \indexnofonts is used when outputting the strings to sort the index -% by, and when constructing control sequence names. It eliminates all -% control sequences and just writes whatever the best ASCII sort string -% would be for a given command (usually its argument). -% -\def\indexnofonts{% - % Accent commands should become @asis. - \def\commondummyaccent##1{\let##1\asis}% - % We can just ignore other control letters. - \def\commondummyletter##1{\let##1\empty}% - % All control words become @asis by default; overrides below. - \let\commondummyword\commondummyaccent - \commondummiesnofonts - % - % Don't no-op \tt, since it isn't a user-level command - % and is used in the definitions of the active chars like <, >, |, etc. - % Likewise with the other plain tex font commands. - %\let\tt=\asis - % - \def\ { }% - \def\@{@}% - \def\_{\normalunderscore}% - \def\-{}% @- shouldn't affect sorting - % - \uccode`\1=`\{ \uppercase{\def\{{1}}% - \uccode`\1=`\} \uppercase{\def\}{1}}% - \let\lbracechar\{% - \let\rbracechar\}% - % - % Non-English letters. - \def\AA{AA}% - \def\AE{AE}% - \def\DH{DZZ}% - \def\L{L}% - \def\OE{OE}% - \def\O{O}% - \def\TH{TH}% - \def\aa{aa}% - \def\ae{ae}% - \def\dh{dzz}% - \def\exclamdown{!}% - \def\l{l}% - \def\oe{oe}% - \def\ordf{a}% - \def\ordm{o}% - \def\o{o}% - \def\questiondown{?}% - \def\ss{ss}% - \def\th{th}% - % - \def\LaTeX{LaTeX}% - \def\TeX{TeX}% - % - % Assorted special characters. \defglyph gives the control sequence a - % definition that removes the {} that follows its use. - \defglyph\atchar{@}% - \defglyph\arrow{->}% - \defglyph\bullet{bullet}% - \defglyph\comma{,}% - \defglyph\copyright{copyright}% - \defglyph\dots{...}% - \defglyph\enddots{...}% - \defglyph\equiv{==}% - \defglyph\error{error}% - \defglyph\euro{euro}% - \defglyph\expansion{==>}% - \defglyph\geq{>=}% - \defglyph\guillemetleft{<<}% - \defglyph\guillemetright{>>}% - \defglyph\guilsinglleft{<}% - \defglyph\guilsinglright{>}% - \defglyph\leq{<=}% - \defglyph\lbracechar{\{}% - \defglyph\minus{-}% - \defglyph\point{.}% - \defglyph\pounds{pounds}% - \defglyph\print{-|}% - \defglyph\quotedblbase{"}% - \defglyph\quotedblleft{"}% - \defglyph\quotedblright{"}% - \defglyph\quoteleft{`}% - \defglyph\quoteright{'}% - \defglyph\quotesinglbase{,}% - \defglyph\rbracechar{\}}% - \defglyph\registeredsymbol{R}% - \defglyph\result{=>}% - \defglyph\textdegree{o}% - % - % We need to get rid of all macros, leaving only the arguments (if present). - % Of course this is not nearly correct, but it is the best we can do for now. - % makeinfo does not expand macros in the argument to @deffn, which ends up - % writing an index entry, and texindex isn't prepared for an index sort entry - % that starts with \. - % - % Since macro invocations are followed by braces, we can just redefine them - % to take a single TeX argument. The case of a macro invocation that - % goes to end-of-line is not handled. - % - \macrolist - \let\value\indexnofontsvalue -} -\def\defglyph#1#2{\def#1##1{#2}} % see above - - - - -% #1 is the index name, #2 is the entry text. -\def\doind#1#2{% - \iflinks - {% - % - \requireopenindexfile{#1}% - \edef\writeto{\csname#1indfile\endcsname}% - % - \def\indextext{#2}% - \safewhatsit\doindwrite - }% - \fi -} - -% Check if an index file has been opened, and if not, open it. -\def\requireopenindexfile#1{% -\ifnum\csname #1indfile\endcsname=0 - \expandafter\newwrite \csname#1indfile\endcsname - \edef\suffix{#1}% - % A .fls suffix would conflict with the file extension for the output - % of -recorder, so use .f1s instead. - \ifx\suffix\indexisfl\def\suffix{f1}\fi - % Open the file - \immediate\openout\csname#1indfile\endcsname \jobname.\suffix - % Using \immediate above here prevents an object entering into the current - % box, which could confound checks such as those in \safewhatsit for - % preceding skips. - \typeout{Writing index file \jobname.\suffix}% -\fi} -\def\indexisfl{fl} - -% Definition for writing index entry sort key. -{ -\catcode`\-=13 -\gdef\indexwritesortas{% - \begingroup - \indexnonalnumreappear - \indexwritesortasxxx} -\gdef\indexwritesortasxxx#1{% - \xdef\indexsortkey{#1}\endgroup} -} - -\def\indexwriteseealso#1{ - \gdef\pagenumbertext{@seealso{#1}}% -} - -% The default definitions -\def\sortas#1{}% -\def\seealso#1{\i{\putwordSeeAlso}\ #1}% for sorted index file only -\def\putwordSeeAlso{see also} - -% Given index entry text like "aaa @subentry bbb @sortas{ZZZ}": -% * Set \bracedtext to "{aaa}{bbb}" -% * Set \fullindexsortkey to "aaa @subentry ZZZ" -% * If @seealso occurs, set \pagenumbertext -% -\def\splitindexentry#1{% - \gdef\fullindexsortkey{}% - \xdef\bracedtext{}% - \def\sep{}% - \def\seealso##1{}% - \expandafter\doindexsegment#1\subentry\finish\subentry -} - -% append the results from the next segment -\def\doindexsegment#1\subentry{% - \def\segment{#1}% - \ifx\segment\isfinish - \else - % - % Fully expand the segment, throwing away any @sortas directives, and - % trim spaces. - \edef\trimmed{\segment}% - \edef\trimmed{\expandafter\eatspaces\expandafter{\trimmed}}% - % - \xdef\bracedtext{\bracedtext{\trimmed}}% - % - % Get the string to sort by. Process the segment with all - % font commands turned off. - \bgroup - \let\sortas\indexwritesortas - \let\seealso\indexwriteseealso - \indexnofonts - % The braces around the commands are recognized by texindex. - \def\lbracechar{{\indexlbrace}}% - \def\rbracechar{{\indexrbrace}}% - \let\{=\lbracechar - \let\}=\rbracechar - \def\@{{\indexatchar}}% - \def\atchar##1{\@}% - % - \let\indexsortkey\empty - \global\let\pagenumbertext\empty - % Execute the segment and throw away the typeset output. This executes - % any @sortas or @seealso commands in this segment. - \setbox\dummybox = \hbox{\segment}% - \ifx\indexsortkey\empty{% - \indexnonalnumdisappear - \xdef\trimmed{\segment}% - \xdef\trimmed{\expandafter\eatspaces\expandafter{\trimmed}}% - \xdef\indexsortkey{\trimmed}% - \ifx\indexsortkey\empty\xdef\indexsortkey{ }\fi - }\fi - % - % Append to \fullindexsortkey. - \edef\tmp{\gdef\noexpand\fullindexsortkey{% - \fullindexsortkey\sep\indexsortkey}}% - \tmp - \egroup - \def\sep{\subentry}% - % - \expandafter\doindexsegment - \fi -} -\def\isfinish{\finish}% -\newbox\dummybox % used above - -\let\subentry\relax - -% Write the entry in \toks0 to the index file. -% -\def\doindwrite{% - \maybemarginindex - % - \atdummies - % - % For texindex which always views { and } as separators. - \def\{{\lbracechar{}}% - \def\}{\rbracechar{}}% - % - % Split the entry into primary entry and any subentries, and get the index - % sort key. - \splitindexentry\indextext - % - % Set up the complete index entry, with both the sort key and - % the original text, including any font commands. We write - % three arguments to \entry to the .?? file (four in the - % subentry case), texindex reduces to two when writing the .??s - % sorted result. - % - \edef\temp{% - \write\writeto{% - \string\entry{\fullindexsortkey}% - {\ifx\pagenumbertext\empty\noexpand\folio\else\pagenumbertext\fi}% - \bracedtext}% - }% - \temp -} - -% Put the index entry in the margin if desired (undocumented). -\def\maybemarginindex{% - \ifx\SETmarginindex\relax\else - \insert\margin{\hbox{\vrule height8pt depth3pt width0pt \relax\indextext}}% - \fi -} -\let\SETmarginindex=\relax - - -% Take care of unwanted page breaks/skips around a whatsit: -% -% If a skip is the last thing on the list now, preserve it -% by backing up by \lastskip, doing the \write, then inserting -% the skip again. Otherwise, the whatsit generated by the -% \write or \pdfdest will make \lastskip zero. The result is that -% sequences like this: -% @end defun -% @tindex whatever -% @defun ... -% will have extra space inserted, because the \medbreak in the -% start of the @defun won't see the skip inserted by the @end of -% the previous defun. -% -% But don't do any of this if we're not in vertical mode. We -% don't want to do a \vskip and prematurely end a paragraph. -% -% Avoid page breaks due to these extra skips, too. -% -% But wait, there is a catch there: -% We'll have to check whether \lastskip is zero skip. \ifdim is not -% sufficient for this purpose, as it ignores stretch and shrink parts -% of the skip. The only way seems to be to check the textual -% representation of the skip. -% -% The following is almost like \def\zeroskipmacro{0.0pt} except that -% the ``p'' and ``t'' characters have catcode \other, not 11 (letter). -% -\edef\zeroskipmacro{\expandafter\the\csname z@skip\endcsname} -% -\newskip\whatsitskip -\newcount\whatsitpenalty -% -% ..., ready, GO: -% -\def\safewhatsit#1{\ifhmode - #1% - \else - % \lastskip and \lastpenalty cannot both be nonzero simultaneously. - \whatsitskip = \lastskip - \edef\lastskipmacro{\the\lastskip}% - \whatsitpenalty = \lastpenalty - % - % If \lastskip is nonzero, that means the last item was a - % skip. And since a skip is discardable, that means this - % -\whatsitskip glue we're inserting is preceded by a - % non-discardable item, therefore it is not a potential - % breakpoint, therefore no \nobreak needed. - \ifx\lastskipmacro\zeroskipmacro - \else - \vskip-\whatsitskip - \fi - % - #1% - % - \ifx\lastskipmacro\zeroskipmacro - % If \lastskip was zero, perhaps the last item was a penalty, and - % perhaps it was >=10000, e.g., a \nobreak. In that case, we want - % to re-insert the same penalty (values >10000 are used for various - % signals); since we just inserted a non-discardable item, any - % following glue (such as a \parskip) would be a breakpoint. For example: - % @deffn deffn-whatever - % @vindex index-whatever - % Description. - % would allow a break between the index-whatever whatsit - % and the "Description." paragraph. - \ifnum\whatsitpenalty>9999 \penalty\whatsitpenalty \fi - \else - % On the other hand, if we had a nonzero \lastskip, - % this make-up glue would be preceded by a non-discardable item - % (the whatsit from the \write), so we must insert a \nobreak. - \nobreak\vskip\whatsitskip - \fi -\fi} - -% The index entry written in the file actually looks like -% \entry {sortstring}{page}{topic} -% or -% \entry {sortstring}{page}{topic}{subtopic} -% The texindex program reads in these files and writes files -% containing these kinds of lines: -% \initial {c} -% before the first topic whose initial is c -% \entry {topic}{pagelist} -% for a topic that is used without subtopics -% \primary {topic} -% \entry {topic}{} -% for the beginning of a topic that is used with subtopics -% \secondary {subtopic}{pagelist} -% for each subtopic. -% \secondary {subtopic}{} -% for a subtopic with sub-subtopics -% \tertiary {subtopic}{subsubtopic}{pagelist} -% for each sub-subtopic. - -% Define the user-accessible indexing commands -% @findex, @vindex, @kindex, @cindex. - -\def\findex {\fnindex} -\def\kindex {\kyindex} -\def\cindex {\cpindex} -\def\vindex {\vrindex} -\def\tindex {\tpindex} -\def\pindex {\pgindex} - -% Define the macros used in formatting output of the sorted index material. - -% @printindex causes a particular index (the ??s file) to get printed. -% It does not print any chapter heading (usually an @unnumbered). -% -\parseargdef\printindex{\begingroup - \dobreak \chapheadingskip{10000}% - % - \smallfonts \rm - \tolerance = 9500 - \plainfrenchspacing - \everypar = {}% don't want the \kern\-parindent from indentation suppression. - % - % See comment in \requireopenindexfile. - \def\indexname{#1}\ifx\indexname\indexisfl\def\indexname{f1}\fi - % - % See if the index file exists and is nonempty. - \openin 1 \jobname.\indexname s - \ifeof 1 - % \enddoublecolumns gets confused if there is no text in the index, - % and it loses the chapter title and the aux file entries for the - % index. The easiest way to prevent this problem is to make sure - % there is some text. - \putwordIndexNonexistent - \typeout{No file \jobname.\indexname s.}% - \else - % If the index file exists but is empty, then \openin leaves \ifeof - % false. We have to make TeX try to read something from the file, so - % it can discover if there is anything in it. - \read 1 to \thisline - \ifeof 1 - \putwordIndexIsEmpty - \else - \expandafter\printindexzz\thisline\relax\relax\finish% - \fi - \fi - \closein 1 -\endgroup} - -% If the index file starts with a backslash, forgo reading the index -% file altogether. If somebody upgrades texinfo.tex they may still have -% old index files using \ as the escape character. Reading this would -% at best lead to typesetting garbage, at worst a TeX syntax error. -\def\printindexzz#1#2\finish{% - % NB this won't work if the index file starts with a group... - \uccode`\~=`\\ \uppercase{\if\noexpand~}\noexpand#1 - \message{skipping sorted index file}% - (Skipped sorted index file in obsolete format) - \else - \begindoublecolumns - \input \jobname.\indexname s - \enddoublecolumns - \fi -} - -% These macros are used by the sorted index file itself. -% Change them to control the appearance of the index. - -{\catcode`\/=13 \catcode`\-=13 \catcode`\^=13 \catcode`\~=13 \catcode`\_=13 -\catcode`\|=13 \catcode`\<=13 \catcode`\>=13 \catcode`\+=13 \catcode`\"=13 -\catcode`\$=3 -\gdef\initialglyphs{% - % special control sequences used in the index sort key - \let\indexlbrace\{% - \let\indexrbrace\}% - \let\indexatchar\@% - % - % Some changes for non-alphabetic characters. Using the glyphs from the - % math fonts looks more consistent than the typewriter font used elsewhere - % for these characters. - \uccode`\~=`\\ \uppercase{\def~{\math{\backslash}}} - % - % In case @\ is used for backslash - \uppercase{\let\\=~} - % Can't get bold backslash so don't use bold forward slash - \catcode`\/=13 - \def/{{\secrmnotbold \normalslash}}% - \def-{{\normaldash\normaldash}}% en dash `--' - \def^{{\chapbf \normalcaret}}% - \def~{{\chapbf \normaltilde}}% - \def\_{% - \leavevmode \kern.07em \vbox{\hrule width.3em height.1ex}\kern .07em }% - \def|{$\vert$}% - \def<{$\less$}% - \def>{$\gtr$}% - \def+{$\normalplus$}% -}} - -\def\initial{% - \bgroup - \initialglyphs - \initialx -} - -\def\initialx#1{% - % Remove any glue we may have, we'll be inserting our own. - \removelastskip - % - % We like breaks before the index initials, so insert a bonus. - % The glue before the bonus allows a little bit of space at the - % bottom of a column to reduce an increase in inter-line spacing. - \nobreak - \vskip 0pt plus 5\baselineskip - \penalty -300 - \vskip 0pt plus -5\baselineskip - % - % Typeset the initial. Making this add up to a whole number of - % baselineskips increases the chance of the dots lining up from column - % to column. It still won't often be perfect, because of the stretch - % we need before each entry, but it's better. - % - % No shrink because it confuses \balancecolumns. - \vskip 1.67\baselineskip plus 1\baselineskip - \leftline{\secfonts \kern-0.05em \secbf #1}% - % \secfonts is inside the argument of \leftline so that the change of - % \baselineskip will not affect any glue inserted before the vbox that - % \leftline creates. - % Do our best not to break after the initial. - \nobreak - \vskip .33\baselineskip plus .1\baselineskip - \egroup % \initialglyphs -} - -\newdimen\entryrightmargin -\entryrightmargin=0pt - -% \entry typesets a paragraph consisting of the text (#1), dot leaders, and -% then page number (#2) flushed to the right margin. It is used for index -% and table of contents entries. The paragraph is indented by \leftskip. -% -\def\entry{% - \begingroup - % - % Start a new paragraph if necessary, so our assignments below can't - % affect previous text. - \par - % - % No extra space above this paragraph. - \parskip = 0in - % - % When reading the text of entry, convert explicit line breaks - % from @* into spaces. The user might give these in long section - % titles, for instance. - \def\*{\unskip\space\ignorespaces}% - \def\entrybreak{\hfil\break}% An undocumented command - % - % Swallow the left brace of the text (first parameter): - \afterassignment\doentry - \let\temp = -} -\def\entrybreak{\unskip\space\ignorespaces}% -\def\doentry{% - % Save the text of the entry - \global\setbox\boxA=\hbox\bgroup - \bgroup % Instead of the swallowed brace. - \noindent - \aftergroup\finishentry - % And now comes the text of the entry. - % Not absorbing as a macro argument reduces the chance of problems - % with catcodes occurring. -} -{\catcode`\@=11 -\gdef\finishentry#1{% - \egroup % end box A - \dimen@ = \wd\boxA % Length of text of entry - \global\setbox\boxA=\hbox\bgroup - \unhbox\boxA - % #1 is the page number. - % - % Get the width of the page numbers, and only use - % leaders if they are present. - \global\setbox\boxB = \hbox{#1}% - \ifdim\wd\boxB = 0pt - \null\nobreak\hfill\ % - \else - % - \null\nobreak\indexdotfill % Have leaders before the page number. - % - \ifpdforxetex - \pdfgettoks#1.% - \hskip\skip\thinshrinkable\the\toksA - \else - \hskip\skip\thinshrinkable #1% - \fi - \fi - \egroup % end \boxA - \ifdim\wd\boxB = 0pt - \noindent\unhbox\boxA\par - \nobreak - \else\bgroup - % We want the text of the entries to be aligned to the left, and the - % page numbers to be aligned to the right. - % - \parindent = 0pt - \advance\leftskip by 0pt plus 1fil - \advance\leftskip by 0pt plus -1fill - \rightskip = 0pt plus -1fil - \advance\rightskip by 0pt plus 1fill - % Cause last line, which could consist of page numbers on their own - % if the list of page numbers is long, to be aligned to the right. - \parfillskip=0pt plus -1fill - % - \advance\rightskip by \entryrightmargin - % Determine how far we can stretch into the margin. - % This allows, e.g., "Appendix H GNU Free Documentation License" to - % fit on one line in @letterpaper format. - \ifdim\entryrightmargin>2.1em - \dimen@i=2.1em - \else - \dimen@i=0em - \fi - \advance \parfillskip by 0pt minus 1\dimen@i - % - \dimen@ii = \hsize - \advance\dimen@ii by -1\leftskip - \advance\dimen@ii by -1\entryrightmargin - \advance\dimen@ii by 1\dimen@i - \ifdim\wd\boxA > \dimen@ii % If the entry doesn't fit in one line - \ifdim\dimen@ > 0.8\dimen@ii % due to long index text - % Try to split the text roughly evenly. \dimen@ will be the length of - % the first line. - \dimen@ = 0.7\dimen@ - \dimen@ii = \hsize - \ifnum\dimen@>\dimen@ii - % If the entry is too long (for example, if it needs more than - % two lines), use all the space in the first line. - \dimen@ = \dimen@ii - \fi - \advance\leftskip by 0pt plus 1fill % ragged right - \advance \dimen@ by 1\rightskip - \parshape = 2 0pt \dimen@ 0em \dimen@ii - % Ideally we'd add a finite glue at the end of the first line only, - % instead of using \parshape with explicit line lengths, but TeX - % doesn't seem to provide a way to do such a thing. - % - % Indent all lines but the first one. - \advance\leftskip by 1em - \advance\parindent by -1em - \fi\fi - \indent % start paragraph - \unhbox\boxA - % - % Do not prefer a separate line ending with a hyphen to fewer lines. - \finalhyphendemerits = 0 - % - % Word spacing - no stretch - \spaceskip=\fontdimen2\font minus \fontdimen4\font - % - \linepenalty=1000 % Discourage line breaks. - \hyphenpenalty=5000 % Discourage hyphenation. - % - \par % format the paragraph - \egroup % The \vbox - \fi - \endgroup -}} - -\newskip\thinshrinkable -\skip\thinshrinkable=.15em minus .15em - -% Like plain.tex's \dotfill, except uses up at least 1 em. -% The filll stretch here overpowers both the fil and fill stretch to push -% the page number to the right. -\def\indexdotfill{\cleaders - \hbox{$\mathsurround=0pt \mkern1.5mu.\mkern1.5mu$}\hskip 1em plus 1filll} - - -\def\primary #1{\line{#1\hfil}} - -\def\secondary{\indententry{0.5cm}} -\def\tertiary{\indententry{1cm}} - -\def\indententry#1#2#3{% - \bgroup - \leftskip=#1 - \entry{#2}{#3}% - \egroup -} - -% Define two-column mode, which we use to typeset indexes. -% Adapted from the TeXbook, page 416, which is to say, -% the manmac.tex format used to print the TeXbook itself. -\catcode`\@=11 % private names - -\newbox\partialpage -\newdimen\doublecolumnhsize - -\def\begindoublecolumns{\begingroup % ended by \enddoublecolumns - % If not much space left on page, start a new page. - \ifdim\pagetotal>0.8\vsize\vfill\eject\fi - % - % Grab any single-column material above us. - \output = {% - \savetopmark - % - % Here is a possibility not foreseen in manmac: if we accumulate a - % whole lot of material, we might end up calling this \output - % routine twice in a row (see the doublecol-lose test, which is - % essentially a couple of indexes with @setchapternewpage off). In - % that case we just ship out what is in \partialpage with the normal - % output routine. Generally, \partialpage will be empty when this - % runs and this will be a no-op. See the indexspread.tex test case. - \ifvoid\partialpage \else - \onepageout{\pagecontents\partialpage}% - \fi - % - \global\setbox\partialpage = \vbox{% - % Unvbox the main output page. - \unvbox\PAGE - \kern-\topskip \kern\baselineskip - }% - }% - \eject % run that output routine to set \partialpage - % - % Use the double-column output routine for subsequent pages. - \output = {\doublecolumnout}% - % - % Change the page size parameters. We could do this once outside this - % routine, in each of @smallbook, @afourpaper, and the default 8.5x11 - % format, but then we repeat the same computation. Repeating a couple - % of assignments once per index is clearly meaningless for the - % execution time, so we may as well do it in one place. - % - % First we halve the line length, less a little for the gutter between - % the columns. We compute the gutter based on the line length, so it - % changes automatically with the paper format. The magic constant - % below is chosen so that the gutter has the same value (well, +-<1pt) - % as it did when we hard-coded it. - % - % We put the result in a separate register, \doublecolumhsize, so we - % can restore it in \pagesofar, after \hsize itself has (potentially) - % been clobbered. - % - \doublecolumnhsize = \hsize - \advance\doublecolumnhsize by -.04154\hsize - \divide\doublecolumnhsize by 2 - \hsize = \doublecolumnhsize - % - % Get the available space for the double columns -- the normal - % (undoubled) page height minus any material left over from the - % previous page. - \advance\vsize by -\ht\partialpage - \vsize = 2\vsize - % - % For the benefit of balancing columns - \advance\baselineskip by 0pt plus 0.5pt -} - -% The double-column output routine for all double-column pages except -% the last, which is done by \balancecolumns. -% -\def\doublecolumnout{% - % - \savetopmark - \splittopskip=\topskip \splitmaxdepth=\maxdepth - \dimen@ = \vsize - \divide\dimen@ by 2 - % - % box0 will be the left-hand column, box2 the right. - \setbox0=\vsplit\PAGE to\dimen@ \setbox2=\vsplit\PAGE to\dimen@ - \global\advance\vsize by 2\ht\partialpage - \onepageout\pagesofar % empty except for the first time we are called - \unvbox\PAGE - \penalty\outputpenalty -} -% -% Re-output the contents of the output page -- any previous material, -% followed by the two boxes we just split, in box0 and box2. -\def\pagesofar{% - \unvbox\partialpage - % - \hsize = \doublecolumnhsize - \wd0=\hsize \wd2=\hsize - \hbox to\txipagewidth{\box0\hfil\box2}% -} - - -% Finished with with double columns. -\def\enddoublecolumns{% - % The following penalty ensures that the page builder is exercised - % _before_ we change the output routine. This is necessary in the - % following situation: - % - % The last section of the index consists only of a single entry. - % Before this section, \pagetotal is less than \pagegoal, so no - % break occurs before the last section starts. However, the last - % section, consisting of \initial and the single \entry, does not - % fit on the page and has to be broken off. Without the following - % penalty the page builder will not be exercised until \eject - % below, and by that time we'll already have changed the output - % routine to the \balancecolumns version, so the next-to-last - % double-column page will be processed with \balancecolumns, which - % is wrong: The two columns will go to the main vertical list, with - % the broken-off section in the recent contributions. As soon as - % the output routine finishes, TeX starts reconsidering the page - % break. The two columns and the broken-off section both fit on the - % page, because the two columns now take up only half of the page - % goal. When TeX sees \eject from below which follows the final - % section, it invokes the new output routine that we've set after - % \balancecolumns below; \onepageout will try to fit the two columns - % and the final section into the vbox of \txipageheight (see - % \pagebody), causing an overfull box. - % - % Note that glue won't work here, because glue does not exercise the - % page builder, unlike penalties (see The TeXbook, pp. 280-281). - \penalty0 - % - \output = {% - % Split the last of the double-column material. - \savetopmark - \balancecolumns - }% - \eject % call the \output just set - \ifdim\pagetotal=0pt - % Having called \balancecolumns once, we do not - % want to call it again. Therefore, reset \output to its normal - % definition right away. - \global\output=\expandafter{\the\defaultoutput} - % - \endgroup % started in \begindoublecolumns - % Leave the double-column material on the current page, no automatic - % page break. - \box\balancedcolumns - % - % \pagegoal was set to the doubled \vsize above, since we restarted - % the current page. We're now back to normal single-column - % typesetting, so reset \pagegoal to the normal \vsize. - \global\vsize = \txipageheight % - \pagegoal = \txipageheight % - \else - % We had some left-over material. This might happen when \doublecolumnout - % is called in \balancecolumns. Try again. - \expandafter\enddoublecolumns - \fi -} -\newbox\balancedcolumns -\setbox\balancedcolumns=\vbox{shouldnt see this}% -% -% Only called for the last of the double column material. \doublecolumnout -% does the others. -\def\balancecolumns{% - \setbox0 = \vbox{\unvbox\PAGE}% like \box255 but more efficient, see p.120. - \dimen@ = \ht0 - \ifdim\dimen@<7\baselineskip - % Don't split a short final column in two. - \setbox2=\vbox{}% - \global\setbox\balancedcolumns=\vbox{\pagesofar}% - \else - % double the leading vertical space - \advance\dimen@ by \topskip - \advance\dimen@ by-\baselineskip - \divide\dimen@ by 2 % target to split to - \dimen@ii = \dimen@ - \splittopskip = \topskip - % Loop until left column is at least as high as the right column. - {% - \vbadness = 10000 - \loop - \global\setbox3 = \copy0 - \global\setbox1 = \vsplit3 to \dimen@ - \ifdim\ht1<\ht3 - \global\advance\dimen@ by 1pt - \repeat - }% - % Now the left column is in box 1, and the right column in box 3. - % - % Check whether the left column has come out higher than the page itself. - % (Note that we have doubled \vsize for the double columns, so - % the actual height of the page is 0.5\vsize). - \ifdim2\ht1>\vsize - % It appears that we have been called upon to balance too much material. - % Output some of it with \doublecolumnout, leaving the rest on the page. - \setbox\PAGE=\box0 - \doublecolumnout - \else - % Compare the heights of the two columns. - \ifdim4\ht1>5\ht3 - % Column heights are too different, so don't make their bottoms - % flush with each other. - \setbox2=\vbox to \ht1 {\unvbox3\vfill}% - \setbox0=\vbox to \ht1 {\unvbox1\vfill}% - \else - % Make column bottoms flush with each other. - \setbox2=\vbox to\ht1{\unvbox3\unskip}% - \setbox0=\vbox to\ht1{\unvbox1\unskip}% - \fi - \global\setbox\balancedcolumns=\vbox{\pagesofar}% - \fi - \fi - % -} -\catcode`\@ = \other - - -\message{sectioning,} -% Chapters, sections, etc. - -% Let's start with @part. -\outer\parseargdef\part{\partzzz{#1}} -\def\partzzz#1{% - \chapoddpage - \null - \vskip.3\vsize % move it down on the page a bit - \begingroup - \noindent \titlefonts\rm #1\par % the text - \let\lastnode=\empty % no node to associate with - \writetocentry{part}{#1}{}% but put it in the toc - \headingsoff % no headline or footline on the part page - % This outputs a mark at the end of the page that clears \thischapter - % and \thissection, as is done in \startcontents. - \let\pchapsepmacro\relax - \chapmacro{}{Yomitfromtoc}{}% - \chapoddpage - \endgroup -} - -% \unnumberedno is an oxymoron. But we count the unnumbered -% sections so that we can refer to them unambiguously in the pdf -% outlines by their "section number". We avoid collisions with chapter -% numbers by starting them at 10000. (If a document ever has 10000 -% chapters, we're in trouble anyway, I'm sure.) -\newcount\unnumberedno \unnumberedno = 10000 -\newcount\chapno -\newcount\secno \secno=0 -\newcount\subsecno \subsecno=0 -\newcount\subsubsecno \subsubsecno=0 - -% This counter is funny since it counts through charcodes of letters A, B, ... -\newcount\appendixno \appendixno = `\@ -% -% \def\appendixletter{\char\the\appendixno} -% We do the following ugly conditional instead of the above simple -% construct for the sake of pdftex, which needs the actual -% letter in the expansion, not just typeset. -% -\def\appendixletter{% - \ifnum\appendixno=`A A% - \else\ifnum\appendixno=`B B% - \else\ifnum\appendixno=`C C% - \else\ifnum\appendixno=`D D% - \else\ifnum\appendixno=`E E% - \else\ifnum\appendixno=`F F% - \else\ifnum\appendixno=`G G% - \else\ifnum\appendixno=`H H% - \else\ifnum\appendixno=`I I% - \else\ifnum\appendixno=`J J% - \else\ifnum\appendixno=`K K% - \else\ifnum\appendixno=`L L% - \else\ifnum\appendixno=`M M% - \else\ifnum\appendixno=`N N% - \else\ifnum\appendixno=`O O% - \else\ifnum\appendixno=`P P% - \else\ifnum\appendixno=`Q Q% - \else\ifnum\appendixno=`R R% - \else\ifnum\appendixno=`S S% - \else\ifnum\appendixno=`T T% - \else\ifnum\appendixno=`U U% - \else\ifnum\appendixno=`V V% - \else\ifnum\appendixno=`W W% - \else\ifnum\appendixno=`X X% - \else\ifnum\appendixno=`Y Y% - \else\ifnum\appendixno=`Z Z% - % The \the is necessary, despite appearances, because \appendixletter is - % expanded while writing the .toc file. \char\appendixno is not - % expandable, thus it is written literally, thus all appendixes come out - % with the same letter (or @) in the toc without it. - \else\char\the\appendixno - \fi\fi\fi\fi\fi\fi\fi\fi\fi\fi\fi\fi\fi - \fi\fi\fi\fi\fi\fi\fi\fi\fi\fi\fi\fi\fi} - -% Each @chapter defines these (using marks) as the number+name, number -% and name of the chapter. Page headings and footings can use -% these. @section does likewise. -\def\thischapter{} -\def\thischapternum{} -\def\thischaptername{} -\def\thissection{} -\def\thissectionnum{} -\def\thissectionname{} - -\newcount\absseclevel % used to calculate proper heading level -\newcount\secbase\secbase=0 % @raisesections/@lowersections modify this count - -% @raisesections: treat @section as chapter, @subsection as section, etc. -\def\raisesections{\global\advance\secbase by -1} -\let\up=\raisesections % original BFox name - -% @lowersections: treat @chapter as section, @section as subsection, etc. -\def\lowersections{\global\advance\secbase by 1} -\let\down=\lowersections % original BFox name - -% we only have subsub. -\chardef\maxseclevel = 3 -% -% A numbered section within an unnumbered changes to unnumbered too. -% To achieve this, remember the "biggest" unnum. sec. we are currently in: -\chardef\unnlevel = \maxseclevel -% -% Trace whether the current chapter is an appendix or not: -% \chapheadtype is "N" or "A", unnumbered chapters are ignored. -\def\chapheadtype{N} - -% Choose a heading macro -% #1 is heading type -% #2 is heading level -% #3 is text for heading -\def\genhead#1#2#3{% - % Compute the abs. sec. level: - \absseclevel=#2 - \advance\absseclevel by \secbase - % Make sure \absseclevel doesn't fall outside the range: - \ifnum \absseclevel < 0 - \absseclevel = 0 - \else - \ifnum \absseclevel > 3 - \absseclevel = 3 - \fi - \fi - % The heading type: - \def\headtype{#1}% - \if \headtype U% - \ifnum \absseclevel < \unnlevel - \chardef\unnlevel = \absseclevel - \fi - \else - % Check for appendix sections: - \ifnum \absseclevel = 0 - \edef\chapheadtype{\headtype}% - \else - \if \headtype A\if \chapheadtype N% - \errmessage{@appendix... within a non-appendix chapter}% - \fi\fi - \fi - % Check for numbered within unnumbered: - \ifnum \absseclevel > \unnlevel - \def\headtype{U}% - \else - \chardef\unnlevel = 3 - \fi - \fi - % Now print the heading: - \if \headtype U% - \ifcase\absseclevel - \unnumberedzzz{#3}% - \or \unnumberedseczzz{#3}% - \or \unnumberedsubseczzz{#3}% - \or \unnumberedsubsubseczzz{#3}% - \fi - \else - \if \headtype A% - \ifcase\absseclevel - \appendixzzz{#3}% - \or \appendixsectionzzz{#3}% - \or \appendixsubseczzz{#3}% - \or \appendixsubsubseczzz{#3}% - \fi - \else - \ifcase\absseclevel - \chapterzzz{#3}% - \or \seczzz{#3}% - \or \numberedsubseczzz{#3}% - \or \numberedsubsubseczzz{#3}% - \fi - \fi - \fi - \suppressfirstparagraphindent -} - -% an interface: -\def\numhead{\genhead N} -\def\apphead{\genhead A} -\def\unnmhead{\genhead U} - -% @chapter, @appendix, @unnumbered. Increment top-level counter, reset -% all lower-level sectioning counters to zero. -% -% Also set \chaplevelprefix, which we prepend to @float sequence numbers -% (e.g., figures), q.v. By default (before any chapter), that is empty. -\let\chaplevelprefix = \empty -% -\outer\parseargdef\chapter{\numhead0{#1}} % normally numhead0 calls chapterzzz -\def\chapterzzz#1{% - % section resetting is \global in case the chapter is in a group, such - % as an @include file. - \global\secno=0 \global\subsecno=0 \global\subsubsecno=0 - \global\advance\chapno by 1 - % - % Used for \float. - \gdef\chaplevelprefix{\the\chapno.}% - \resetallfloatnos - % - % \putwordChapter can contain complex things in translations. - \toks0=\expandafter{\putwordChapter}% - \message{\the\toks0 \space \the\chapno}% - % - % Write the actual heading. - \chapmacro{#1}{Ynumbered}{\the\chapno}% - % - % So @section and the like are numbered underneath this chapter. - \global\let\section = \numberedsec - \global\let\subsection = \numberedsubsec - \global\let\subsubsection = \numberedsubsubsec -} - -\outer\parseargdef\appendix{\apphead0{#1}} % normally calls appendixzzz -% -\def\appendixzzz#1{% - \global\secno=0 \global\subsecno=0 \global\subsubsecno=0 - \global\advance\appendixno by 1 - \gdef\chaplevelprefix{\appendixletter.}% - \resetallfloatnos - % - % \putwordAppendix can contain complex things in translations. - \toks0=\expandafter{\putwordAppendix}% - \message{\the\toks0 \space \appendixletter}% - % - \chapmacro{#1}{Yappendix}{\appendixletter}% - % - \global\let\section = \appendixsec - \global\let\subsection = \appendixsubsec - \global\let\subsubsection = \appendixsubsubsec -} - -% normally unnmhead0 calls unnumberedzzz: -\outer\parseargdef\unnumbered{\unnmhead0{#1}} -\def\unnumberedzzz#1{% - \global\secno=0 \global\subsecno=0 \global\subsubsecno=0 - \global\advance\unnumberedno by 1 - % - % Since an unnumbered has no number, no prefix for figures. - \global\let\chaplevelprefix = \empty - \resetallfloatnos - % - % This used to be simply \message{#1}, but TeX fully expands the - % argument to \message. Therefore, if #1 contained @-commands, TeX - % expanded them. For example, in `@unnumbered The @cite{Book}', TeX - % expanded @cite (which turns out to cause errors because \cite is meant - % to be executed, not expanded). - % - % Anyway, we don't want the fully-expanded definition of @cite to appear - % as a result of the \message, we just want `@cite' itself. We use - % \the to achieve this: TeX expands \the only once, - % simply yielding the contents of . (We also do this for - % the toc entries.) - \toks0 = {#1}% - \message{(\the\toks0)}% - % - \chapmacro{#1}{Ynothing}{\the\unnumberedno}% - % - \global\let\section = \unnumberedsec - \global\let\subsection = \unnumberedsubsec - \global\let\subsubsection = \unnumberedsubsubsec -} - -% @centerchap is like @unnumbered, but the heading is centered. -\outer\parseargdef\centerchap{% - \let\centerparametersmaybe = \centerparameters - \unnmhead0{#1}% - \let\centerparametersmaybe = \relax -} - -% @top is like @unnumbered. -\let\top\unnumbered - -% Sections. -% -\outer\parseargdef\numberedsec{\numhead1{#1}} % normally calls seczzz -\def\seczzz#1{% - \global\subsecno=0 \global\subsubsecno=0 \global\advance\secno by 1 - \sectionheading{#1}{sec}{Ynumbered}{\the\chapno.\the\secno}% -} - -% normally calls appendixsectionzzz: -\outer\parseargdef\appendixsection{\apphead1{#1}} -\def\appendixsectionzzz#1{% - \global\subsecno=0 \global\subsubsecno=0 \global\advance\secno by 1 - \sectionheading{#1}{sec}{Yappendix}{\appendixletter.\the\secno}% -} -\let\appendixsec\appendixsection - -% normally calls unnumberedseczzz: -\outer\parseargdef\unnumberedsec{\unnmhead1{#1}} -\def\unnumberedseczzz#1{% - \global\subsecno=0 \global\subsubsecno=0 \global\advance\secno by 1 - \sectionheading{#1}{sec}{Ynothing}{\the\unnumberedno.\the\secno}% -} - -% Subsections. -% -% normally calls numberedsubseczzz: -\outer\parseargdef\numberedsubsec{\numhead2{#1}} -\def\numberedsubseczzz#1{% - \global\subsubsecno=0 \global\advance\subsecno by 1 - \sectionheading{#1}{subsec}{Ynumbered}{\the\chapno.\the\secno.\the\subsecno}% -} - -% normally calls appendixsubseczzz: -\outer\parseargdef\appendixsubsec{\apphead2{#1}} -\def\appendixsubseczzz#1{% - \global\subsubsecno=0 \global\advance\subsecno by 1 - \sectionheading{#1}{subsec}{Yappendix}% - {\appendixletter.\the\secno.\the\subsecno}% -} - -% normally calls unnumberedsubseczzz: -\outer\parseargdef\unnumberedsubsec{\unnmhead2{#1}} -\def\unnumberedsubseczzz#1{% - \global\subsubsecno=0 \global\advance\subsecno by 1 - \sectionheading{#1}{subsec}{Ynothing}% - {\the\unnumberedno.\the\secno.\the\subsecno}% -} - -% Subsubsections. -% -% normally numberedsubsubseczzz: -\outer\parseargdef\numberedsubsubsec{\numhead3{#1}} -\def\numberedsubsubseczzz#1{% - \global\advance\subsubsecno by 1 - \sectionheading{#1}{subsubsec}{Ynumbered}% - {\the\chapno.\the\secno.\the\subsecno.\the\subsubsecno}% -} - -% normally appendixsubsubseczzz: -\outer\parseargdef\appendixsubsubsec{\apphead3{#1}} -\def\appendixsubsubseczzz#1{% - \global\advance\subsubsecno by 1 - \sectionheading{#1}{subsubsec}{Yappendix}% - {\appendixletter.\the\secno.\the\subsecno.\the\subsubsecno}% -} - -% normally unnumberedsubsubseczzz: -\outer\parseargdef\unnumberedsubsubsec{\unnmhead3{#1}} -\def\unnumberedsubsubseczzz#1{% - \global\advance\subsubsecno by 1 - \sectionheading{#1}{subsubsec}{Ynothing}% - {\the\unnumberedno.\the\secno.\the\subsecno.\the\subsubsecno}% -} - -% These macros control what the section commands do, according -% to what kind of chapter we are in (ordinary, appendix, or unnumbered). -% Define them by default for a numbered chapter. -\let\section = \numberedsec -\let\subsection = \numberedsubsec -\let\subsubsection = \numberedsubsubsec - -% Define @majorheading, @heading and @subheading - -\def\majorheading{% - {\advance\chapheadingskip by 10pt \chapbreak }% - \parsearg\chapheadingzzz -} - -\def\chapheading{\chapbreak \parsearg\chapheadingzzz} -\def\chapheadingzzz#1{% - \vbox{\chapfonts \raggedtitlesettings #1\par}% - \nobreak\bigskip \nobreak - \suppressfirstparagraphindent -} - -% @heading, @subheading, @subsubheading. -\parseargdef\heading{\sectionheading{#1}{sec}{Yomitfromtoc}{} - \suppressfirstparagraphindent} -\parseargdef\subheading{\sectionheading{#1}{subsec}{Yomitfromtoc}{} - \suppressfirstparagraphindent} -\parseargdef\subsubheading{\sectionheading{#1}{subsubsec}{Yomitfromtoc}{} - \suppressfirstparagraphindent} - -% These macros generate a chapter, section, etc. heading only -% (including whitespace, linebreaking, etc. around it), -% given all the information in convenient, parsed form. - -% Args are the skip and penalty (usually negative) -\def\dobreak#1#2{\par\ifdim\lastskip<#1\removelastskip\penalty#2\vskip#1\fi} - -% Parameter controlling skip before chapter headings (if needed) -\newskip\chapheadingskip - -% Define plain chapter starts, and page on/off switching for it. -\def\chapbreak{\dobreak \chapheadingskip {-4000}} - -% Start a new page -\def\chappager{\par\vfill\supereject} - -% \chapoddpage - start on an odd page for a new chapter -% Because \domark is called before \chapoddpage, the filler page will -% get the headings for the next chapter, which is wrong. But we don't -% care -- we just disable all headings on the filler page. -\def\chapoddpage{% - \chappager - \ifodd\pageno \else - \begingroup - \headingsoff - \null - \chappager - \endgroup - \fi -} - -\parseargdef\setchapternewpage{\csname CHAPPAG#1\endcsname} - -\def\CHAPPAGoff{% -\global\let\contentsalignmacro = \chappager -\global\let\pchapsepmacro=\chapbreak -\global\let\pagealignmacro=\chappager} - -\def\CHAPPAGon{% -\global\let\contentsalignmacro = \chappager -\global\let\pchapsepmacro=\chappager -\global\let\pagealignmacro=\chappager -\global\def\HEADINGSon{\HEADINGSsingle}} - -\def\CHAPPAGodd{% -\global\let\contentsalignmacro = \chapoddpage -\global\let\pchapsepmacro=\chapoddpage -\global\let\pagealignmacro=\chapoddpage -\global\def\HEADINGSon{\HEADINGSdouble}} - -\CHAPPAGon - -% \chapmacro - Chapter opening. -% -% #1 is the text, #2 is the section type (Ynumbered, Ynothing, -% Yappendix, Yomitfromtoc), #3 the chapter number. -% Not used for @heading series. -% -% To test against our argument. -\def\Ynothingkeyword{Ynothing} -\def\Yappendixkeyword{Yappendix} -\def\Yomitfromtockeyword{Yomitfromtoc} -% -\def\chapmacro#1#2#3{% - \expandafter\ifx\thisenv\titlepage\else - \checkenv{}% chapters, etc., should not start inside an environment. - \fi - % Insert the first mark before the heading break (see notes for \domark). - \let\prevchapterdefs=\currentchapterdefs - \let\prevsectiondefs=\currentsectiondefs - \gdef\currentsectiondefs{\gdef\thissectionname{}\gdef\thissectionnum{}% - \gdef\thissection{}}% - % - \def\temptype{#2}% - \ifx\temptype\Ynothingkeyword - \gdef\currentchapterdefs{\gdef\thischaptername{#1}\gdef\thischapternum{}% - \gdef\thischapter{\thischaptername}}% - \else\ifx\temptype\Yomitfromtockeyword - \gdef\currentchapterdefs{\gdef\thischaptername{#1}\gdef\thischapternum{}% - \gdef\thischapter{}}% - \else\ifx\temptype\Yappendixkeyword - \toks0={#1}% - \xdef\currentchapterdefs{% - \gdef\noexpand\thischaptername{\the\toks0}% - \gdef\noexpand\thischapternum{\appendixletter}% - % \noexpand\putwordAppendix avoids expanding indigestible - % commands in some of the translations. - \gdef\noexpand\thischapter{\noexpand\putwordAppendix{} - \noexpand\thischapternum: - \noexpand\thischaptername}% - }% - \else - \toks0={#1}% - \xdef\currentchapterdefs{% - \gdef\noexpand\thischaptername{\the\toks0}% - \gdef\noexpand\thischapternum{\the\chapno}% - % \noexpand\putwordChapter avoids expanding indigestible - % commands in some of the translations. - \gdef\noexpand\thischapter{\noexpand\putwordChapter{} - \noexpand\thischapternum: - \noexpand\thischaptername}% - }% - \fi\fi\fi - % - % Output the mark. Pass it through \safewhatsit, to take care of - % the preceding space. - \safewhatsit\domark - % - % Insert the chapter heading break. - \pchapsepmacro - % - % Now the second mark, after the heading break. No break points - % between here and the heading. - \let\prevchapterdefs=\currentchapterdefs - \let\prevsectiondefs=\currentsectiondefs - \domark - % - {% - \chapfonts \rm - \let\footnote=\errfootnoteheading % give better error message - % - % Have to define \currentsection before calling \donoderef, because the - % xref code eventually uses it. On the other hand, it has to be called - % after \pchapsepmacro, or the headline will change too soon. - \gdef\currentsection{#1}% - % - % Only insert the separating space if we have a chapter/appendix - % number, and don't print the unnumbered ``number''. - \ifx\temptype\Ynothingkeyword - \setbox0 = \hbox{}% - \def\toctype{unnchap}% - \else\ifx\temptype\Yomitfromtockeyword - \setbox0 = \hbox{}% contents like unnumbered, but no toc entry - \def\toctype{omit}% - \else\ifx\temptype\Yappendixkeyword - \setbox0 = \hbox{\putwordAppendix{} #3\enspace}% - \def\toctype{app}% - \else - \setbox0 = \hbox{#3\enspace}% - \def\toctype{numchap}% - \fi\fi\fi - % - % Write the toc entry for this chapter. Must come before the - % \donoderef, because we include the current node name in the toc - % entry, and \donoderef resets it to empty. - \writetocentry{\toctype}{#1}{#3}% - % - % For pdftex, we have to write out the node definition (aka, make - % the pdfdest) after any page break, but before the actual text has - % been typeset. If the destination for the pdf outline is after the - % text, then jumping from the outline may wind up with the text not - % being visible, for instance under high magnification. - \donoderef{#2}% - % - % Typeset the actual heading. - \nobreak % Avoid page breaks at the interline glue. - \vbox{\raggedtitlesettings \hangindent=\wd0 \centerparametersmaybe - \unhbox0 #1\par}% - }% - \nobreak\bigskip % no page break after a chapter title - \nobreak -} - -% @centerchap -- centered and unnumbered. -\let\centerparametersmaybe = \relax -\def\centerparameters{% - \advance\rightskip by 3\rightskip - \leftskip = \rightskip - \parfillskip = 0pt -} - - -% Section titles. These macros combine the section number parts and -% call the generic \sectionheading to do the printing. -% -\newskip\secheadingskip -\def\secheadingbreak{\dobreak \secheadingskip{-1000}} - -% Subsection titles. -\newskip\subsecheadingskip -\def\subsecheadingbreak{\dobreak \subsecheadingskip{-500}} - -% Subsubsection titles. -\def\subsubsecheadingskip{\subsecheadingskip} -\def\subsubsecheadingbreak{\subsecheadingbreak} - - -% Print any size, any type, section title. -% -% #1 is the text of the title, -% #2 is the section level (sec/subsec/subsubsec), -% #3 is the section type (Ynumbered, Ynothing, Yappendix, Yomitfromtoc), -% #4 is the section number. -% -\def\seckeyword{sec} -% -\def\sectionheading#1#2#3#4{% - {% - \def\sectionlevel{#2}% - \def\temptype{#3}% - % - % It is ok for the @heading series commands to appear inside an - % environment (it's been historically allowed, though the logic is - % dubious), but not the others. - \ifx\temptype\Yomitfromtockeyword\else - \checkenv{}% non-@*heading should not be in an environment. - \fi - \let\footnote=\errfootnoteheading - % - % Switch to the right set of fonts. - \csname #2fonts\endcsname \rm - % - % Insert first mark before the heading break (see notes for \domark). - \let\prevsectiondefs=\currentsectiondefs - \ifx\temptype\Ynothingkeyword - \ifx\sectionlevel\seckeyword - \gdef\currentsectiondefs{\gdef\thissectionname{#1}\gdef\thissectionnum{}% - \gdef\thissection{\thissectionname}}% - \fi - \else\ifx\temptype\Yomitfromtockeyword - % Don't redefine \thissection. - \else\ifx\temptype\Yappendixkeyword - \ifx\sectionlevel\seckeyword - \toks0={#1}% - \xdef\currentsectiondefs{% - \gdef\noexpand\thissectionname{\the\toks0}% - \gdef\noexpand\thissectionnum{#4}% - % \noexpand\putwordSection avoids expanding indigestible - % commands in some of the translations. - \gdef\noexpand\thissection{\noexpand\putwordSection{} - \noexpand\thissectionnum: - \noexpand\thissectionname}% - }% - \fi - \else - \ifx\sectionlevel\seckeyword - \toks0={#1}% - \xdef\currentsectiondefs{% - \gdef\noexpand\thissectionname{\the\toks0}% - \gdef\noexpand\thissectionnum{#4}% - % \noexpand\putwordSection avoids expanding indigestible - % commands in some of the translations. - \gdef\noexpand\thissection{\noexpand\putwordSection{} - \noexpand\thissectionnum: - \noexpand\thissectionname}% - }% - \fi - \fi\fi\fi - % - % Go into vertical mode. Usually we'll already be there, but we - % don't want the following whatsit to end up in a preceding paragraph - % if the document didn't happen to have a blank line. - \par - % - % Output the mark. Pass it through \safewhatsit, to take care of - % the preceding space. - \safewhatsit\domark - % - % Insert space above the heading. - \csname #2headingbreak\endcsname - % - % Now the second mark, after the heading break. No break points - % between here and the heading. - \global\let\prevsectiondefs=\currentsectiondefs - \domark - % - % Only insert the space after the number if we have a section number. - \ifx\temptype\Ynothingkeyword - \setbox0 = \hbox{}% - \def\toctype{unn}% - \gdef\currentsection{#1}% - \else\ifx\temptype\Yomitfromtockeyword - % for @headings -- no section number, don't include in toc, - % and don't redefine \currentsection. - \setbox0 = \hbox{}% - \def\toctype{omit}% - \let\sectionlevel=\empty - \else\ifx\temptype\Yappendixkeyword - \setbox0 = \hbox{#4\enspace}% - \def\toctype{app}% - \gdef\currentsection{#1}% - \else - \setbox0 = \hbox{#4\enspace}% - \def\toctype{num}% - \gdef\currentsection{#1}% - \fi\fi\fi - % - % Write the toc entry (before \donoderef). See comments in \chapmacro. - \writetocentry{\toctype\sectionlevel}{#1}{#4}% - % - % Write the node reference (= pdf destination for pdftex). - % Again, see comments in \chapmacro. - \donoderef{#3}% - % - % Interline glue will be inserted when the vbox is completed. - % That glue will be a valid breakpoint for the page, since it'll be - % preceded by a whatsit (usually from the \donoderef, or from the - % \writetocentry if there was no node). We don't want to allow that - % break, since then the whatsits could end up on page n while the - % section is on page n+1, thus toc/etc. are wrong. Debian bug 276000. - \nobreak - % - % Output the actual section heading. - \vbox{\hyphenpenalty=10000 \tolerance=5000 \parindent=0pt \ptexraggedright - \hangindent=\wd0 % zero if no section number - \unhbox0 #1}% - }% - % Add extra space after the heading -- half of whatever came above it. - % Don't allow stretch, though. - \kern .5 \csname #2headingskip\endcsname - % - % Do not let the kern be a potential breakpoint, as it would be if it - % was followed by glue. - \nobreak - % - % We'll almost certainly start a paragraph next, so don't let that - % glue accumulate. (Not a breakpoint because it's preceded by a - % discardable item.) However, when a paragraph is not started next - % (\startdefun, \cartouche, \center, etc.), this needs to be wiped out - % or the negative glue will cause weirdly wrong output, typically - % obscuring the section heading with something else. - \vskip-\parskip - % - % This is so the last item on the main vertical list is a known - % \penalty > 10000, so \startdefun, etc., can recognize the situation - % and do the needful. - \penalty 10001 -} - - -\message{toc,} -% Table of contents. -\newwrite\tocfile - -% Write an entry to the toc file, opening it if necessary. -% Called from @chapter, etc. -% -% Example usage: \writetocentry{sec}{Section Name}{\the\chapno.\the\secno} -% We append the current node name (if any) and page number as additional -% arguments for the \{chap,sec,...}entry macros which will eventually -% read this. The node name is used in the pdf outlines as the -% destination to jump to. -% -% We open the .toc file for writing here instead of at @setfilename (or -% any other fixed time) so that @contents can be anywhere in the document. -% But if #1 is `omit', then we don't do anything. This is used for the -% table of contents chapter openings themselves. -% -\newif\iftocfileopened -\def\omitkeyword{omit}% -% -\def\writetocentry#1#2#3{% - \edef\writetoctype{#1}% - \ifx\writetoctype\omitkeyword \else - \iftocfileopened\else - \immediate\openout\tocfile = \jobname.toc - \global\tocfileopenedtrue - \fi - % - \iflinks - {\atdummies - \edef\temp{% - \write\tocfile{@#1entry{#2}{#3}{\lastnode}{\noexpand\folio}}}% - \temp - }% - \fi - \fi - % - % Tell \shipout to create a pdf destination on each page, if we're - % writing pdf. These are used in the table of contents. We can't - % just write one on every page because the title pages are numbered - % 1 and 2 (the page numbers aren't printed), and so are the first - % two pages of the document. Thus, we'd have two destinations named - % `1', and two named `2'. - \ifpdforxetex - \global\pdfmakepagedesttrue - \fi -} - - -% These characters do not print properly in the Computer Modern roman -% fonts, so we must take special care. This is more or less redundant -% with the Texinfo input format setup at the end of this file. -% -\def\activecatcodes{% - \catcode`\"=\active - \catcode`\$=\active - \catcode`\<=\active - \catcode`\>=\active - \catcode`\\=\active - \catcode`\^=\active - \catcode`\_=\active - \catcode`\|=\active - \catcode`\~=\active -} - - -% Read the toc file, which is essentially Texinfo input. -\def\readtocfile{% - \setupdatafile - \activecatcodes - \input \tocreadfilename -} - -\newskip\contentsrightmargin \contentsrightmargin=1in -\newcount\savepageno -\newcount\lastnegativepageno \lastnegativepageno = -1 - -% Prepare to read what we've written to \tocfile. -% -\def\startcontents#1{% - % If @setchapternewpage on, and @headings double, the contents should - % start on an odd page, unlike chapters. Thus, we maintain - % \contentsalignmacro in parallel with \pagealignmacro. - % From: Torbjorn Granlund - \contentsalignmacro - \immediate\closeout\tocfile - % - % Don't need to put `Contents' or `Short Contents' in the headline. - % It is abundantly clear what they are. - \chapmacro{#1}{Yomitfromtoc}{}% - % - \savepageno = \pageno - \begingroup % Set up to handle contents files properly. - \raggedbottom % Worry more about breakpoints than the bottom. - \entryrightmargin=\contentsrightmargin % Don't use the full line length. - % - % Roman numerals for page numbers. - \ifnum \pageno>0 \global\pageno = \lastnegativepageno \fi -} - -% redefined for the two-volume lispref. We always output on -% \jobname.toc even if this is redefined. -% -\def\tocreadfilename{\jobname.toc} - -% Normal (long) toc. -% -\def\contents{% - \startcontents{\putwordTOC}% - \openin 1 \tocreadfilename\space - \ifeof 1 \else - \readtocfile - \fi - \vfill \eject - \contentsalignmacro % in case @setchapternewpage odd is in effect - \ifeof 1 \else - \pdfmakeoutlines - \fi - \closein 1 - \endgroup - \lastnegativepageno = \pageno - \global\pageno = \savepageno -} - -% And just the chapters. -\def\summarycontents{% - \startcontents{\putwordShortTOC}% - % - \let\partentry = \shortpartentry - \let\numchapentry = \shortchapentry - \let\appentry = \shortchapentry - \let\unnchapentry = \shortunnchapentry - % We want a true roman here for the page numbers. - \secfonts - \let\rm=\shortcontrm \let\bf=\shortcontbf - \let\sl=\shortcontsl \let\tt=\shortconttt - \rm - \hyphenpenalty = 10000 - \advance\baselineskip by 1pt % Open it up a little. - \def\numsecentry##1##2##3##4{} - \let\appsecentry = \numsecentry - \let\unnsecentry = \numsecentry - \let\numsubsecentry = \numsecentry - \let\appsubsecentry = \numsecentry - \let\unnsubsecentry = \numsecentry - \let\numsubsubsecentry = \numsecentry - \let\appsubsubsecentry = \numsecentry - \let\unnsubsubsecentry = \numsecentry - \openin 1 \tocreadfilename\space - \ifeof 1 \else - \readtocfile - \fi - \closein 1 - \vfill \eject - \contentsalignmacro % in case @setchapternewpage odd is in effect - \endgroup - \lastnegativepageno = \pageno - \global\pageno = \savepageno -} -\let\shortcontents = \summarycontents - -% Typeset the label for a chapter or appendix for the short contents. -% The arg is, e.g., `A' for an appendix, or `3' for a chapter. -% -\def\shortchaplabel#1{% - % This space should be enough, since a single number is .5em, and the - % widest letter (M) is 1em, at least in the Computer Modern fonts. - % But use \hss just in case. - % (This space doesn't include the extra space that gets added after - % the label; that gets put in by \shortchapentry above.) - % - % We'd like to right-justify chapter numbers, but that looks strange - % with appendix letters. And right-justifying numbers and - % left-justifying letters looks strange when there is less than 10 - % chapters. Have to read the whole toc once to know how many chapters - % there are before deciding ... - \hbox to 1em{#1\hss}% -} - -% These macros generate individual entries in the table of contents. -% The first argument is the chapter or section name. -% The last argument is the page number. -% The arguments in between are the chapter number, section number, ... - -% Parts, in the main contents. Replace the part number, which doesn't -% exist, with an empty box. Let's hope all the numbers have the same width. -% Also ignore the page number, which is conventionally not printed. -\def\numeralbox{\setbox0=\hbox{8}\hbox to \wd0{\hfil}} -\def\partentry#1#2#3#4{% - % Add stretch and a bonus for breaking the page before the part heading. - % This reduces the chance of the page being broken immediately after the - % part heading, before a following chapter heading. - \vskip 0pt plus 5\baselineskip - \penalty-300 - \vskip 0pt plus -5\baselineskip - \dochapentry{\numeralbox\labelspace#1}{}% -} -% -% Parts, in the short toc. -\def\shortpartentry#1#2#3#4{% - \penalty-300 - \vskip.5\baselineskip plus.15\baselineskip minus.1\baselineskip - \shortchapentry{{\bf #1}}{\numeralbox}{}{}% -} - -% Chapters, in the main contents. -\def\numchapentry#1#2#3#4{\dochapentry{#2\labelspace#1}{#4}} - -% Chapters, in the short toc. -% See comments in \dochapentry re vbox and related settings. -\def\shortchapentry#1#2#3#4{% - \tocentry{\shortchaplabel{#2}\labelspace #1}{\doshortpageno\bgroup#4\egroup}% -} - -% Appendices, in the main contents. -% Need the word Appendix, and a fixed-size box. -% -\def\appendixbox#1{% - % We use M since it's probably the widest letter. - \setbox0 = \hbox{\putwordAppendix{} M}% - \hbox to \wd0{\putwordAppendix{} #1\hss}} -% -\def\appentry#1#2#3#4{\dochapentry{\appendixbox{#2}\hskip.7em#1}{#4}} - -% Unnumbered chapters. -\def\unnchapentry#1#2#3#4{\dochapentry{#1}{#4}} -\def\shortunnchapentry#1#2#3#4{\tocentry{#1}{\doshortpageno\bgroup#4\egroup}} - -% Sections. -\def\numsecentry#1#2#3#4{\dosecentry{#2\labelspace#1}{#4}} -\let\appsecentry=\numsecentry -\def\unnsecentry#1#2#3#4{\dosecentry{#1}{#4}} - -% Subsections. -\def\numsubsecentry#1#2#3#4{\dosubsecentry{#2\labelspace#1}{#4}} -\let\appsubsecentry=\numsubsecentry -\def\unnsubsecentry#1#2#3#4{\dosubsecentry{#1}{#4}} - -% And subsubsections. -\def\numsubsubsecentry#1#2#3#4{\dosubsubsecentry{#2\labelspace#1}{#4}} -\let\appsubsubsecentry=\numsubsubsecentry -\def\unnsubsubsecentry#1#2#3#4{\dosubsubsecentry{#1}{#4}} - -% This parameter controls the indentation of the various levels. -% Same as \defaultparindent. -\newdimen\tocindent \tocindent = 15pt - -% Now for the actual typesetting. In all these, #1 is the text and #2 is the -% page number. -% -% If the toc has to be broken over pages, we want it to be at chapters -% if at all possible; hence the \penalty. -\def\dochapentry#1#2{% - \penalty-300 \vskip1\baselineskip plus.33\baselineskip minus.25\baselineskip - \begingroup - % Move the page numbers slightly to the right - \advance\entryrightmargin by -0.05em - \chapentryfonts - \tocentry{#1}{\dopageno\bgroup#2\egroup}% - \endgroup - \nobreak\vskip .25\baselineskip plus.1\baselineskip -} - -\def\dosecentry#1#2{\begingroup - \secentryfonts \leftskip=\tocindent - \tocentry{#1}{\dopageno\bgroup#2\egroup}% -\endgroup} - -\def\dosubsecentry#1#2{\begingroup - \subsecentryfonts \leftskip=2\tocindent - \tocentry{#1}{\dopageno\bgroup#2\egroup}% -\endgroup} - -\def\dosubsubsecentry#1#2{\begingroup - \subsubsecentryfonts \leftskip=3\tocindent - \tocentry{#1}{\dopageno\bgroup#2\egroup}% -\endgroup} - -% We use the same \entry macro as for the index entries. -\let\tocentry = \entry - -% Space between chapter (or whatever) number and the title. -\def\labelspace{\hskip1em \relax} - -\def\dopageno#1{{\rm #1}} -\def\doshortpageno#1{{\rm #1}} - -\def\chapentryfonts{\secfonts \rm} -\def\secentryfonts{\textfonts} -\def\subsecentryfonts{\textfonts} -\def\subsubsecentryfonts{\textfonts} - - -\message{environments,} -% @foo ... @end foo. - -% @tex ... @end tex escapes into raw TeX temporarily. -% One exception: @ is still an escape character, so that @end tex works. -% But \@ or @@ will get a plain @ character. - -\envdef\tex{% - \setupmarkupstyle{tex}% - \catcode `\\=0 \catcode `\{=1 \catcode `\}=2 - \catcode `\$=3 \catcode `\&=4 \catcode `\#=6 - \catcode `\^=7 \catcode `\_=8 \catcode `\~=\active \let~=\tie - \catcode `\%=14 - \catcode `\+=\other - \catcode `\"=\other - \catcode `\|=\other - \catcode `\<=\other - \catcode `\>=\other - \catcode `\`=\other - \catcode `\'=\other - % - % ' is active in math mode (mathcode"8000). So reset it, and all our - % other math active characters (just in case), to plain's definitions. - \mathactive - % - % Inverse of the list at the beginning of the file. - \let\b=\ptexb - \let\bullet=\ptexbullet - \let\c=\ptexc - \let\,=\ptexcomma - \let\.=\ptexdot - \let\dots=\ptexdots - \let\equiv=\ptexequiv - \let\!=\ptexexclam - \let\i=\ptexi - \let\indent=\ptexindent - \let\noindent=\ptexnoindent - \let\{=\ptexlbrace - \let\+=\tabalign - \let\}=\ptexrbrace - \let\/=\ptexslash - \let\sp=\ptexsp - \let\*=\ptexstar - %\let\sup=\ptexsup % do not redefine, we want @sup to work in math mode - \let\t=\ptext - \expandafter \let\csname top\endcsname=\ptextop % we've made it outer - \let\frenchspacing=\plainfrenchspacing - % - \def\endldots{\mathinner{\ldots\ldots\ldots\ldots}}% - \def\enddots{\relax\ifmmode\endldots\else$\mathsurround=0pt \endldots\,$\fi}% - \def\@{@}% -} -% There is no need to define \Etex. - -% Define @lisp ... @end lisp. -% @lisp environment forms a group so it can rebind things, -% including the definition of @end lisp (which normally is erroneous). - -% Amount to narrow the margins by for @lisp. -\newskip\lispnarrowing \lispnarrowing=0.4in - -% This is the definition that ^^M gets inside @lisp, @example, and other -% such environments. \null is better than a space, since it doesn't -% have any width. -\def\lisppar{\null\endgraf} - -% This space is always present above and below environments. -\newskip\envskipamount \envskipamount = 0pt - -% Make spacing and below environment symmetrical. We use \parskip here -% to help in doing that, since in @example-like environments \parskip -% is reset to zero; thus the \afterenvbreak inserts no space -- but the -% start of the next paragraph will insert \parskip. -% -\def\aboveenvbreak{{% - % =10000 instead of <10000 because of a special case in \itemzzz and - % \sectionheading, q.v. - \ifnum \lastpenalty=10000 \else - \advance\envskipamount by \parskip - \endgraf - \ifdim\lastskip<\envskipamount - \removelastskip - \ifnum\lastpenalty<10000 - % Penalize breaking before the environment, because preceding text - % often leads into it. - \penalty100 - \fi - \vskip\envskipamount - \fi - \fi -}} - -\def\afterenvbreak{{% - % =10000 instead of <10000 because of a special case in \itemzzz and - % \sectionheading, q.v. - \ifnum \lastpenalty=10000 \else - \advance\envskipamount by \parskip - \endgraf - \ifdim\lastskip<\envskipamount - \removelastskip - % it's not a good place to break if the last penalty was \nobreak - % or better ... - \ifnum\lastpenalty<10000 \penalty-50 \fi - \vskip\envskipamount - \fi - \fi -}} - -% \nonarrowing is a flag. If "set", @lisp etc don't narrow margins; it will -% also clear it, so that its embedded environments do the narrowing again. -\let\nonarrowing=\relax - -% @cartouche ... @end cartouche: draw rectangle w/rounded corners around -% environment contents. - -% -\def\ctl{{\circle\char'013\hskip -6pt}}% 6pt from pl file: 1/2charwidth -\def\ctr{{\hskip 6pt\circle\char'010}} -\def\cbl{{\circle\char'012\hskip -6pt}} -\def\cbr{{\hskip 6pt\circle\char'011}} -\def\carttop{\hbox to \cartouter{\hskip\lskip - \ctl\leaders\hrule height\circthick\hfil\ctr - \hskip\rskip}} -\def\cartbot{\hbox to \cartouter{\hskip\lskip - \cbl\leaders\hrule height\circthick\hfil\cbr - \hskip\rskip}} -% -\newskip\lskip\newskip\rskip - -% only require the font if @cartouche is actually used -\def\cartouchefontdefs{% - \font\circle=lcircle10\relax - \circthick=\fontdimen8\circle -} -\newdimen\circthick -\newdimen\cartouter\newdimen\cartinner -\newskip\normbskip\newskip\normpskip\newskip\normlskip - - -\envdef\cartouche{% - \cartouchefontdefs - \ifhmode\par\fi % can't be in the midst of a paragraph. - \startsavinginserts - \lskip=\leftskip \rskip=\rightskip - \leftskip=0pt\rightskip=0pt % we want these *outside*. - \cartinner=\hsize \advance\cartinner by-\lskip - \advance\cartinner by-\rskip - \cartouter=\hsize - \advance\cartouter by 18.4pt % allow for 3pt kerns on either - % side, and for 6pt waste from - % each corner char, and rule thickness - \normbskip=\baselineskip \normpskip=\parskip \normlskip=\lineskip - % - % If this cartouche directly follows a sectioning command, we need the - % \parskip glue (backspaced over by default) or the cartouche can - % collide with the section heading. - \ifnum\lastpenalty>10000 \vskip\parskip \penalty\lastpenalty \fi - % - \setbox\groupbox=\vbox\bgroup - \baselineskip=0pt\parskip=0pt\lineskip=0pt - \carttop - \hbox\bgroup - \hskip\lskip - \vrule\kern3pt - \vbox\bgroup - \kern3pt - \hsize=\cartinner - \baselineskip=\normbskip - \lineskip=\normlskip - \parskip=\normpskip - \vskip -\parskip - \comment % For explanation, see the end of def\group. -} -\def\Ecartouche{% - \ifhmode\par\fi - \kern3pt - \egroup - \kern3pt\vrule - \hskip\rskip - \egroup - \cartbot - \egroup - \addgroupbox - \checkinserts -} - - -% This macro is called at the beginning of all the @example variants, -% inside a group. -\newdimen\nonfillparindent -\def\nonfillstart{% - \aboveenvbreak - \ifdim\hfuzz < 12pt \hfuzz = 12pt \fi % Don't be fussy - \sepspaces % Make spaces be word-separators rather than space tokens. - \let\par = \lisppar % don't ignore blank lines - \obeylines % each line of input is a line of output - \parskip = 0pt - % Turn off paragraph indentation but redefine \indent to emulate - % the normal \indent. - \nonfillparindent=\parindent - \parindent = 0pt - \let\indent\nonfillindent - % - \emergencystretch = 0pt % don't try to avoid overfull boxes - \ifx\nonarrowing\relax - \advance \leftskip by \lispnarrowing - \exdentamount=\lispnarrowing - \else - \let\nonarrowing = \relax - \fi - \let\exdent=\nofillexdent -} - -\begingroup -\obeyspaces -% We want to swallow spaces (but not other tokens) after the fake -% @indent in our nonfill-environments, where spaces are normally -% active and set to @tie, resulting in them not being ignored after -% @indent. -\gdef\nonfillindent{\futurelet\temp\nonfillindentcheck}% -\gdef\nonfillindentcheck{% -\ifx\temp % -\expandafter\nonfillindentgobble% -\else% -\leavevmode\nonfillindentbox% -\fi% -}% -\endgroup -\def\nonfillindentgobble#1{\nonfillindent} -\def\nonfillindentbox{\hbox to \nonfillparindent{\hss}} - -% If you want all examples etc. small: @set dispenvsize small. -% If you want even small examples the full size: @set dispenvsize nosmall. -% This affects the following displayed environments: -% @example, @display, @format, @lisp -% -\def\smallword{small} -\def\nosmallword{nosmall} -\let\SETdispenvsize\relax -\def\setnormaldispenv{% - \ifx\SETdispenvsize\smallword - % end paragraph for sake of leading, in case document has no blank - % line. This is redundant with what happens in \aboveenvbreak, but - % we need to do it before changing the fonts, and it's inconvenient - % to change the fonts afterward. - \ifnum \lastpenalty=10000 \else \endgraf \fi - \smallexamplefonts \rm - \fi -} -\def\setsmalldispenv{% - \ifx\SETdispenvsize\nosmallword - \else - \ifnum \lastpenalty=10000 \else \endgraf \fi - \smallexamplefonts \rm - \fi -} - -% We often define two environments, @foo and @smallfoo. -% Let's do it in one command. #1 is the env name, #2 the definition. -\def\makedispenvdef#1#2{% - \expandafter\envdef\csname#1\endcsname {\setnormaldispenv #2}% - \expandafter\envdef\csname small#1\endcsname {\setsmalldispenv #2}% - \expandafter\let\csname E#1\endcsname \afterenvbreak - \expandafter\let\csname Esmall#1\endcsname \afterenvbreak -} - -% Define two environment synonyms (#1 and #2) for an environment. -\def\maketwodispenvdef#1#2#3{% - \makedispenvdef{#1}{#3}% - \makedispenvdef{#2}{#3}% -} -% -% @lisp: indented, narrowed, typewriter font; -% @example: same as @lisp. -% -% @smallexample and @smalllisp: use smaller fonts. -% Originally contributed by Pavel@xerox. -% -\maketwodispenvdef{lisp}{example}{% - \nonfillstart - \tt\setupmarkupstyle{example}% - \let\kbdfont = \kbdexamplefont % Allow @kbd to do something special. - \gobble % eat return -} -% @display/@smalldisplay: same as @lisp except keep current font. -% -\makedispenvdef{display}{% - \nonfillstart - \gobble -} - -% @format/@smallformat: same as @display except don't narrow margins. -% -\makedispenvdef{format}{% - \let\nonarrowing = t% - \nonfillstart - \gobble -} - -% @flushleft: same as @format, but doesn't obey \SETdispenvsize. -\envdef\flushleft{% - \let\nonarrowing = t% - \nonfillstart - \gobble -} -\let\Eflushleft = \afterenvbreak - -% @flushright. -% -\envdef\flushright{% - \let\nonarrowing = t% - \nonfillstart - \advance\leftskip by 0pt plus 1fill\relax - \gobble -} -\let\Eflushright = \afterenvbreak - - -% @raggedright does more-or-less normal line breaking but no right -% justification. From plain.tex. -\envdef\raggedright{% - \rightskip0pt plus2.4em \spaceskip.3333em \xspaceskip.5em\relax -} -\let\Eraggedright\par - -\envdef\raggedleft{% - \parindent=0pt \leftskip0pt plus2em - \spaceskip.3333em \xspaceskip.5em \parfillskip=0pt - \hbadness=10000 % Last line will usually be underfull, so turn off - % badness reporting. -} -\let\Eraggedleft\par - -\envdef\raggedcenter{% - \parindent=0pt \rightskip0pt plus1em \leftskip0pt plus1em - \spaceskip.3333em \xspaceskip.5em \parfillskip=0pt - \hbadness=10000 % Last line will usually be underfull, so turn off - % badness reporting. -} -\let\Eraggedcenter\par - - -% @quotation does normal linebreaking (hence we can't use \nonfillstart) -% and narrows the margins. We keep \parskip nonzero in general, since -% we're doing normal filling. So, when using \aboveenvbreak and -% \afterenvbreak, temporarily make \parskip 0. -% -\makedispenvdef{quotation}{\quotationstart} -% -\def\quotationstart{% - \indentedblockstart % same as \indentedblock, but increase right margin too. - \ifx\nonarrowing\relax - \advance\rightskip by \lispnarrowing - \fi - \parsearg\quotationlabel -} - -% We have retained a nonzero parskip for the environment, since we're -% doing normal filling. -% -\def\Equotation{% - \par - \ifx\quotationauthor\thisisundefined\else - % indent a bit. - \leftline{\kern 2\leftskip \sl ---\quotationauthor}% - \fi - {\parskip=0pt \afterenvbreak}% -} -\def\Esmallquotation{\Equotation} - -% If we're given an argument, typeset it in bold with a colon after. -\def\quotationlabel#1{% - \def\temp{#1}% - \ifx\temp\empty \else - {\bf #1: }% - \fi -} - -% @indentedblock is like @quotation, but indents only on the left and -% has no optional argument. -% -\makedispenvdef{indentedblock}{\indentedblockstart} -% -\def\indentedblockstart{% - {\parskip=0pt \aboveenvbreak}% because \aboveenvbreak inserts \parskip - \parindent=0pt - % - % @cartouche defines \nonarrowing to inhibit narrowing at next level down. - \ifx\nonarrowing\relax - \advance\leftskip by \lispnarrowing - \exdentamount = \lispnarrowing - \else - \let\nonarrowing = \relax - \fi -} - -% Keep a nonzero parskip for the environment, since we're doing normal filling. -% -\def\Eindentedblock{% - \par - {\parskip=0pt \afterenvbreak}% -} -\def\Esmallindentedblock{\Eindentedblock} - - -% LaTeX-like @verbatim...@end verbatim and @verb{...} -% If we want to allow any as delimiter, -% we need the curly braces so that makeinfo sees the @verb command, eg: -% `@verbx...x' would look like the '@verbx' command. --janneke@gnu.org -% -% [Knuth]: Donald Ervin Knuth, 1996. The TeXbook. -% -% [Knuth] p.344; only we need to do the other characters Texinfo sets -% active too. Otherwise, they get lost as the first character on a -% verbatim line. -\def\dospecials{% - \do\ \do\\\do\{\do\}\do\$\do\&% - \do\#\do\^\do\^^K\do\_\do\^^A\do\%\do\~% - \do\<\do\>\do\|\do\@\do+\do\"% - % Don't do the quotes -- if we do, @set txicodequoteundirected and - % @set txicodequotebacktick will not have effect on @verb and - % @verbatim, and ?` and !` ligatures won't get disabled. - %\do\`\do\'% -} -% -% [Knuth] p. 380 -\def\uncatcodespecials{% - \def\do##1{\catcode`##1=\other}\dospecials} -% -% Setup for the @verb command. -% -% Eight spaces for a tab -\begingroup - \catcode`\^^I=\active - \gdef\tabeightspaces{\catcode`\^^I=\active\def^^I{\ \ \ \ \ \ \ \ }} -\endgroup -% -\def\setupverb{% - \tt % easiest (and conventionally used) font for verbatim - \def\par{\leavevmode\endgraf}% - \setupmarkupstyle{verb}% - \tabeightspaces - % Respect line breaks, - % print special symbols as themselves, and - % make each space count - % must do in this order: - \obeylines \uncatcodespecials \sepspaces -} - -% Setup for the @verbatim environment -% -% Real tab expansion. -\newdimen\tabw \setbox0=\hbox{\tt\space} \tabw=8\wd0 % tab amount -% -% We typeset each line of the verbatim in an \hbox, so we can handle -% tabs. The \global is in case the verbatim line starts with an accent, -% or some other command that starts with a begin-group. Otherwise, the -% entire \verbbox would disappear at the corresponding end-group, before -% it is typeset. Meanwhile, we can't have nested verbatim commands -% (can we?), so the \global won't be overwriting itself. -\newbox\verbbox -\def\starttabbox{\global\setbox\verbbox=\hbox\bgroup} -% -\begingroup - \catcode`\^^I=\active - \gdef\tabexpand{% - \catcode`\^^I=\active - \def^^I{\leavevmode\egroup - \dimen\verbbox=\wd\verbbox % the width so far, or since the previous tab - \divide\dimen\verbbox by\tabw - \multiply\dimen\verbbox by\tabw % compute previous multiple of \tabw - \advance\dimen\verbbox by\tabw % advance to next multiple of \tabw - \wd\verbbox=\dimen\verbbox \box\verbbox \starttabbox - }% - } -\endgroup - -% start the verbatim environment. -\def\setupverbatim{% - \let\nonarrowing = t% - \nonfillstart - \tt % easiest (and conventionally used) font for verbatim - % The \leavevmode here is for blank lines. Otherwise, we would - % never \starttabbox and the \egroup would end verbatim mode. - \def\par{\leavevmode\egroup\box\verbbox\endgraf}% - \tabexpand - \setupmarkupstyle{verbatim}% - % Respect line breaks, - % print special symbols as themselves, and - % make each space count. - % Must do in this order: - \obeylines \uncatcodespecials \sepspaces - \everypar{\starttabbox}% -} - -% Do the @verb magic: verbatim text is quoted by unique -% delimiter characters. Before first delimiter expect a -% right brace, after last delimiter expect closing brace: -% -% \def\doverb'{'#1'}'{#1} -% -% [Knuth] p. 382; only eat outer {} -\begingroup - \catcode`[=1\catcode`]=2\catcode`\{=\other\catcode`\}=\other - \gdef\doverb{#1[\def\next##1#1}[##1\endgroup]\next] -\endgroup -% -\def\verb{\begingroup\setupverb\doverb} -% -% -% Do the @verbatim magic: define the macro \doverbatim so that -% the (first) argument ends when '@end verbatim' is reached, ie: -% -% \def\doverbatim#1@end verbatim{#1} -% -% For Texinfo it's a lot easier than for LaTeX, -% because texinfo's \verbatim doesn't stop at '\end{verbatim}': -% we need not redefine '\', '{' and '}'. -% -% Inspired by LaTeX's verbatim command set [latex.ltx] -% -\begingroup - \catcode`\ =\active - \obeylines % - % ignore everything up to the first ^^M, that's the newline at the end - % of the @verbatim input line itself. Otherwise we get an extra blank - % line in the output. - \xdef\doverbatim#1^^M#2@end verbatim{#2\noexpand\end\gobble verbatim}% - % We really want {...\end verbatim} in the body of the macro, but - % without the active space; thus we have to use \xdef and \gobble. -\endgroup -% -\envdef\verbatim{% - \setupverbatim\doverbatim -} -\let\Everbatim = \afterenvbreak - - -% @verbatiminclude FILE - insert text of file in verbatim environment. -% -\def\verbatiminclude{\parseargusing\filenamecatcodes\doverbatiminclude} -% -\def\doverbatiminclude#1{% - {% - \makevalueexpandable - \setupverbatim - {% - \indexnofonts % Allow `@@' and other weird things in file names. - \wlog{texinfo.tex: doing @verbatiminclude of #1^^J}% - \edef\tmp{\noexpand\input #1 } - \expandafter - }\tmp - \afterenvbreak - }% -} - -% @copying ... @end copying. -% Save the text away for @insertcopying later. -% -% We save the uninterpreted tokens, rather than creating a box. -% Saving the text in a box would be much easier, but then all the -% typesetting commands (@smallbook, font changes, etc.) have to be done -% beforehand -- and a) we want @copying to be done first in the source -% file; b) letting users define the frontmatter in as flexible order as -% possible is desirable. -% -\def\copying{\checkenv{}\begingroup\scanargctxt\docopying} -\def\docopying#1@end copying{\endgroup\def\copyingtext{#1}} -% -\def\insertcopying{% - \begingroup - \parindent = 0pt % paragraph indentation looks wrong on title page - \scanexp\copyingtext - \endgroup -} - - -\message{defuns,} -% @defun etc. - -\newskip\defbodyindent \defbodyindent=.4in -\newskip\defargsindent \defargsindent=50pt -\newskip\deflastargmargin \deflastargmargin=18pt -\newcount\defunpenalty - -% Start the processing of @deffn: -\def\startdefun{% - \ifnum\lastpenalty<10000 - \medbreak - \defunpenalty=10003 % Will keep this @deffn together with the - % following @def command, see below. - \else - % If there are two @def commands in a row, we'll have a \nobreak, - % which is there to keep the function description together with its - % header. But if there's nothing but headers, we need to allow a - % break somewhere. Check specifically for penalty 10002, inserted - % by \printdefunline, instead of 10000, since the sectioning - % commands also insert a nobreak penalty, and we don't want to allow - % a break between a section heading and a defun. - % - % As a further refinement, we avoid "club" headers by signalling - % with penalty of 10003 after the very first @deffn in the - % sequence (see above), and penalty of 10002 after any following - % @def command. - \ifnum\lastpenalty=10002 \penalty2000 \else \defunpenalty=10002 \fi - % - % Similarly, after a section heading, do not allow a break. - % But do insert the glue. - \medskip % preceded by discardable penalty, so not a breakpoint - \fi - % - \parindent=0in - \advance\leftskip by \defbodyindent - \exdentamount=\defbodyindent -} - -\def\dodefunx#1{% - % First, check whether we are in the right environment: - \checkenv#1% - % - % As above, allow line break if we have multiple x headers in a row. - % It's not a great place, though. - \ifnum\lastpenalty=10002 \penalty3000 \else \defunpenalty=10002 \fi - % - % And now, it's time to reuse the body of the original defun: - \expandafter\gobbledefun#1% -} -\def\gobbledefun#1\startdefun{} - -% \printdefunline \deffnheader{text} -% -\def\printdefunline#1#2{% - \begingroup - % call \deffnheader: - #1#2 \endheader - % common ending: - \interlinepenalty = 10000 - \advance\rightskip by 0pt plus 1fil\relax - \endgraf - \nobreak\vskip -\parskip - \penalty\defunpenalty % signal to \startdefun and \dodefunx - % Some of the @defun-type tags do not enable magic parentheses, - % rendering the following check redundant. But we don't optimize. - \checkparencounts - \endgroup -} - -\def\Edefun{\endgraf\medbreak} - -% \makedefun{deffn} creates \deffn, \deffnx and \Edeffn; -% the only thing remaining is to define \deffnheader. -% -\def\makedefun#1{% - \expandafter\let\csname E#1\endcsname = \Edefun - \edef\temp{\noexpand\domakedefun - \makecsname{#1}\makecsname{#1x}\makecsname{#1header}}% - \temp -} - -% \domakedefun \deffn \deffnx \deffnheader { (defn. of \deffnheader) } -% -% Define \deffn and \deffnx, without parameters. -% \deffnheader has to be defined explicitly. -% -\def\domakedefun#1#2#3{% - \envdef#1{% - \startdefun - \doingtypefnfalse % distinguish typed functions from all else - \parseargusing\activeparens{\printdefunline#3}% - }% - \def#2{\dodefunx#1}% - \def#3% -} - -\newif\ifdoingtypefn % doing typed function? -\newif\ifrettypeownline % typeset return type on its own line? - -% @deftypefnnewline on|off says whether the return type of typed functions -% are printed on their own line. This affects @deftypefn, @deftypefun, -% @deftypeop, and @deftypemethod. -% -\parseargdef\deftypefnnewline{% - \def\temp{#1}% - \ifx\temp\onword - \expandafter\let\csname SETtxideftypefnnl\endcsname - = \empty - \else\ifx\temp\offword - \expandafter\let\csname SETtxideftypefnnl\endcsname - = \relax - \else - \errhelp = \EMsimple - \errmessage{Unknown @txideftypefnnl value `\temp', - must be on|off}% - \fi\fi -} - -% \dosubind {index}{topic}{subtopic} -% -% If SUBTOPIC is present, precede it with a space, and call \doind. -% (At some time during the 20th century, this made a two-level entry in an -% index such as the operation index. Nobody seemed to notice the change in -% behaviour though.) -\def\dosubind#1#2#3{% - \def\thirdarg{#3}% - \ifx\thirdarg\empty - \doind{#1}{#2}% - \else - \doind{#1}{#2\space#3}% - \fi -} - -% Untyped functions: - -% @deffn category name args -\makedefun{deffn}{\deffngeneral{}} - -% @deffn category class name args -\makedefun{defop}#1 {\defopon{#1\ \putwordon}} - -% \defopon {category on}class name args -\def\defopon#1#2 {\deffngeneral{\putwordon\ \code{#2}}{#1\ \code{#2}} } - -% \deffngeneral {subind}category name args -% -\def\deffngeneral#1#2 #3 #4\endheader{% - \dosubind{fn}{\code{#3}}{#1}% - \defname{#2}{}{#3}\magicamp\defunargs{#4\unskip}% -} - -% Typed functions: - -% @deftypefn category type name args -\makedefun{deftypefn}{\deftypefngeneral{}} - -% @deftypeop category class type name args -\makedefun{deftypeop}#1 {\deftypeopon{#1\ \putwordon}} - -% \deftypeopon {category on}class type name args -\def\deftypeopon#1#2 {\deftypefngeneral{\putwordon\ \code{#2}}{#1\ \code{#2}} } - -% \deftypefngeneral {subind}category type name args -% -\def\deftypefngeneral#1#2 #3 #4 #5\endheader{% - \dosubind{fn}{\code{#4}}{#1}% - \doingtypefntrue - \defname{#2}{#3}{#4}\defunargs{#5\unskip}% -} - -% Typed variables: - -% @deftypevr category type var args -\makedefun{deftypevr}{\deftypecvgeneral{}} - -% @deftypecv category class type var args -\makedefun{deftypecv}#1 {\deftypecvof{#1\ \putwordof}} - -% \deftypecvof {category of}class type var args -\def\deftypecvof#1#2 {\deftypecvgeneral{\putwordof\ \code{#2}}{#1\ \code{#2}} } - -% \deftypecvgeneral {subind}category type var args -% -\def\deftypecvgeneral#1#2 #3 #4 #5\endheader{% - \dosubind{vr}{\code{#4}}{#1}% - \defname{#2}{#3}{#4}\defunargs{#5\unskip}% -} - -% Untyped variables: - -% @defvr category var args -\makedefun{defvr}#1 {\deftypevrheader{#1} {} } - -% @defcv category class var args -\makedefun{defcv}#1 {\defcvof{#1\ \putwordof}} - -% \defcvof {category of}class var args -\def\defcvof#1#2 {\deftypecvof{#1}#2 {} } - -% Types: - -% @deftp category name args -\makedefun{deftp}#1 #2 #3\endheader{% - \doind{tp}{\code{#2}}% - \defname{#1}{}{#2}\defunargs{#3\unskip}% -} - -% Remaining @defun-like shortcuts: -\makedefun{defun}{\deffnheader{\putwordDeffunc} } -\makedefun{defmac}{\deffnheader{\putwordDefmac} } -\makedefun{defspec}{\deffnheader{\putwordDefspec} } -\makedefun{deftypefun}{\deftypefnheader{\putwordDeffunc} } -\makedefun{defvar}{\defvrheader{\putwordDefvar} } -\makedefun{defopt}{\defvrheader{\putwordDefopt} } -\makedefun{deftypevar}{\deftypevrheader{\putwordDefvar} } -\makedefun{defmethod}{\defopon\putwordMethodon} -\makedefun{deftypemethod}{\deftypeopon\putwordMethodon} -\makedefun{defivar}{\defcvof\putwordInstanceVariableof} -\makedefun{deftypeivar}{\deftypecvof\putwordInstanceVariableof} - -% \defname, which formats the name of the @def (not the args). -% #1 is the category, such as "Function". -% #2 is the return type, if any. -% #3 is the function name. -% -% We are followed by (but not passed) the arguments, if any. -% -\def\defname#1#2#3{% - \par - % Get the values of \leftskip and \rightskip as they were outside the @def... - \advance\leftskip by -\defbodyindent - % - % Determine if we are typesetting the return type of a typed function - % on a line by itself. - \rettypeownlinefalse - \ifdoingtypefn % doing a typed function specifically? - % then check user option for putting return type on its own line: - \expandafter\ifx\csname SETtxideftypefnnl\endcsname\relax \else - \rettypeownlinetrue - \fi - \fi - % - % How we'll format the category name. Putting it in brackets helps - % distinguish it from the body text that may end up on the next line - % just below it. - \def\temp{#1}% - \setbox0=\hbox{\kern\deflastargmargin \ifx\temp\empty\else [\rm\temp]\fi} - % - % Figure out line sizes for the paragraph shape. We'll always have at - % least two. - \tempnum = 2 - % - % The first line needs space for \box0; but if \rightskip is nonzero, - % we need only space for the part of \box0 which exceeds it: - \dimen0=\hsize \advance\dimen0 by -\wd0 \advance\dimen0 by \rightskip - % - % If doing a return type on its own line, we'll have another line. - \ifrettypeownline - \advance\tempnum by 1 - \def\maybeshapeline{0in \hsize}% - \else - \def\maybeshapeline{}% - \fi - % - % The continuations: - \dimen2=\hsize \advance\dimen2 by -\defargsindent - % - % The final paragraph shape: - \parshape \tempnum 0in \dimen0 \maybeshapeline \defargsindent \dimen2 - % - % Put the category name at the right margin. - \noindent - \hbox to 0pt{% - \hfil\box0 \kern-\hsize - % \hsize has to be shortened this way: - \kern\leftskip - % Intentionally do not respect \rightskip, since we need the space. - }% - % - % Allow all lines to be underfull without complaint: - \tolerance=10000 \hbadness=10000 - \exdentamount=\defbodyindent - {% - % defun fonts. We use typewriter by default (used to be bold) because: - % . we're printing identifiers, they should be in tt in principle. - % . in languages with many accents, such as Czech or French, it's - % common to leave accents off identifiers. The result looks ok in - % tt, but exceedingly strange in rm. - % . we don't want -- and --- to be treated as ligatures. - % . this still does not fix the ?` and !` ligatures, but so far no - % one has made identifiers using them :). - \df \tt - \def\temp{#2}% text of the return type - \ifx\temp\empty\else - \tclose{\temp}% typeset the return type - \ifrettypeownline - % put return type on its own line; prohibit line break following: - \hfil\vadjust{\nobreak}\break - \else - \space % type on same line, so just followed by a space - \fi - \fi % no return type - #3% output function name - }% - {\rm\enskip}% hskip 0.5 em of \rmfont - % - \boldbrax - % arguments will be output next, if any. -} - -% Print arguments in slanted roman (not ttsl), inconsistently with using -% tt for the name. This is because literal text is sometimes needed in -% the argument list (groff manual), and ttsl and tt are not very -% distinguishable. Prevent hyphenation at `-' chars. -% -\def\defunargs#1{% - % use sl by default (not ttsl), - % tt for the names. - \df \sl \hyphenchar\font=0 - % - % On the other hand, if an argument has two dashes (for instance), we - % want a way to get ttsl. We used to recommend @var for that, so - % leave the code in, but it's strange for @var to lead to typewriter. - % Nowadays we recommend @code, since the difference between a ttsl hyphen - % and a tt hyphen is pretty tiny. @code also disables ?` !`. - \def\var##1{{\setupmarkupstyle{var}\ttslanted{##1}}}% - #1% - \sl\hyphenchar\font=45 -} - -% We want ()&[] to print specially on the defun line. -% -\def\activeparens{% - \catcode`\(=\active \catcode`\)=\active - \catcode`\[=\active \catcode`\]=\active - \catcode`\&=\active -} - -% Make control sequences which act like normal parenthesis chars. -\let\lparen = ( \let\rparen = ) - -% Be sure that we always have a definition for `(', etc. For example, -% if the fn name has parens in it, \boldbrax will not be in effect yet, -% so TeX would otherwise complain about undefined control sequence. -{ - \activeparens - \global\let(=\lparen \global\let)=\rparen - \global\let[=\lbrack \global\let]=\rbrack - \global\let& = \& - - \gdef\boldbrax{\let(=\opnr\let)=\clnr\let[=\lbrb\let]=\rbrb} - \gdef\magicamp{\let&=\amprm} -} -\let\ampchar\& - -\newcount\parencount - -% If we encounter &foo, then turn on ()-hacking afterwards -\newif\ifampseen -\def\amprm#1 {\ampseentrue{\bf\ }} - -\def\parenfont{% - \ifampseen - % At the first level, print parens in roman, - % otherwise use the default font. - \ifnum \parencount=1 \rm \fi - \else - % The \sf parens (in \boldbrax) actually are a little bolder than - % the contained text. This is especially needed for [ and ] . - \sf - \fi -} -\def\infirstlevel#1{% - \ifampseen - \ifnum\parencount=1 - #1% - \fi - \fi -} -\def\bfafterword#1 {#1 \bf} - -\def\opnr{% - \global\advance\parencount by 1 - {\parenfont(}% - \infirstlevel \bfafterword -} -\def\clnr{% - {\parenfont)}% - \infirstlevel \sl - \global\advance\parencount by -1 -} - -\newcount\brackcount -\def\lbrb{% - \global\advance\brackcount by 1 - {\bf[}% -} -\def\rbrb{% - {\bf]}% - \global\advance\brackcount by -1 -} - -\def\checkparencounts{% - \ifnum\parencount=0 \else \badparencount \fi - \ifnum\brackcount=0 \else \badbrackcount \fi -} -% these should not use \errmessage; the glibc manual, at least, actually -% has such constructs (when documenting function pointers). -\def\badparencount{% - \message{Warning: unbalanced parentheses in @def...}% - \global\parencount=0 -} -\def\badbrackcount{% - \message{Warning: unbalanced square brackets in @def...}% - \global\brackcount=0 -} - - -\message{macros,} -% @macro. - -% To do this right we need a feature of e-TeX, \scantokens, -% which we arrange to emulate with a temporary file in ordinary TeX. -\ifx\eTeXversion\thisisundefined - \newwrite\macscribble - \def\scantokens#1{% - \toks0={#1}% - \immediate\openout\macscribble=\jobname.tmp - \immediate\write\macscribble{\the\toks0}% - \immediate\closeout\macscribble - \input \jobname.tmp - } -\fi - -% alias because \c means cedilla in @tex or @math -\let\texinfoc=\c - -% Used at the time of macro expansion. -% Argument is macro body with arguments substituted -\def\scanmacro#1{% - \newlinechar`\^^M - \def\xeatspaces{\eatspaces}% - % - % Process the macro body under the current catcode regime. - \scantokens{#1@texinfoc}% - % - % The \texinfoc is to remove the \newlinechar added by \scantokens, and - % can be noticed by \parsearg. -} - -% Used for copying and captions -\def\scanexp#1{% - \expandafter\scanmacro\expandafter{#1}% -} - -\newcount\paramno % Count of parameters -\newtoks\macname % Macro name -\newif\ifrecursive % Is it recursive? - -% List of all defined macros in the form -% \commondummyword\macro1\commondummyword\macro2... -% Currently is also contains all @aliases; the list can be split -% if there is a need. -\def\macrolist{} - -% Add the macro to \macrolist -\def\addtomacrolist#1{\expandafter \addtomacrolistxxx \csname#1\endcsname} -\def\addtomacrolistxxx#1{% - \toks0 = \expandafter{\macrolist\commondummyword#1}% - \xdef\macrolist{\the\toks0}% -} - -% Utility routines. -% This does \let #1 = #2, with \csnames; that is, -% \let \csname#1\endcsname = \csname#2\endcsname -% (except of course we have to play expansion games). -% -\def\cslet#1#2{% - \expandafter\let - \csname#1\expandafter\endcsname - \csname#2\endcsname -} - -% Trim leading and trailing spaces off a string. -% Concepts from aro-bend problem 15 (see CTAN). -{\catcode`\@=11 -\gdef\eatspaces #1{\expandafter\trim@\expandafter{#1 }} -\gdef\trim@ #1{\trim@@ @#1 @ #1 @ @@} -\gdef\trim@@ #1@ #2@ #3@@{\trim@@@\empty #2 @} -\def\unbrace#1{#1} -\unbrace{\gdef\trim@@@ #1 } #2@{#1} -} - -% Trim a single trailing ^^M off a string. -{\catcode`\^^M=\other \catcode`\Q=3% -\gdef\eatcr #1{\eatcra #1Q^^MQ}% -\gdef\eatcra#1^^MQ{\eatcrb#1Q}% -\gdef\eatcrb#1Q#2Q{#1}% -} - -% Macro bodies are absorbed as an argument in a context where -% all characters are catcode 10, 11 or 12, except \ which is active -% (as in normal texinfo). It is necessary to change the definition of \ -% to recognize macro arguments; this is the job of \mbodybackslash. -% -% Non-ASCII encodings make 8-bit characters active, so un-activate -% them to avoid their expansion. Must do this non-globally, to -% confine the change to the current group. -% -% It's necessary to have hard CRs when the macro is executed. This is -% done by making ^^M (\endlinechar) catcode 12 when reading the macro -% body, and then making it the \newlinechar in \scanmacro. -% -\def\scanctxt{% used as subroutine - \catcode`\"=\other - \catcode`\+=\other - \catcode`\<=\other - \catcode`\>=\other - \catcode`\^=\other - \catcode`\_=\other - \catcode`\|=\other - \catcode`\~=\other - \passthroughcharstrue -} - -\def\scanargctxt{% used for copying and captions, not macros. - \scanctxt - \catcode`\@=\other - \catcode`\\=\other - \catcode`\^^M=\other -} - -\def\macrobodyctxt{% used for @macro definitions - \scanctxt - \catcode`\ =\other - \catcode`\@=\other - \catcode`\{=\other - \catcode`\}=\other - \catcode`\^^M=\other - \usembodybackslash -} - -% Used when scanning braced macro arguments. Note, however, that catcode -% changes here are ineffectual if the macro invocation was nested inside -% an argument to another Texinfo command. -\def\macroargctxt{% - \scanctxt - \catcode`\ =\active - \catcode`\@=\other - \catcode`\^^M=\other - \catcode`\\=\active -} - -\def\macrolineargctxt{% used for whole-line arguments without braces - \scanctxt - \catcode`\@=\other - \catcode`\{=\other - \catcode`\}=\other -} - -% \mbodybackslash is the definition of \ in @macro bodies. -% It maps \foo\ => \csname macarg.foo\endcsname => #N -% where N is the macro parameter number. -% We define \csname macarg.\endcsname to be \realbackslash, so -% \\ in macro replacement text gets you a backslash. -% -{\catcode`@=0 @catcode`@\=@active - @gdef@usembodybackslash{@let\=@mbodybackslash} - @gdef@mbodybackslash#1\{@csname macarg.#1@endcsname} -} -\expandafter\def\csname macarg.\endcsname{\realbackslash} - -\def\margbackslash#1{\char`\#1 } - -\def\macro{\recursivefalse\parsearg\macroxxx} -\def\rmacro{\recursivetrue\parsearg\macroxxx} - -\def\macroxxx#1{% - \getargs{#1}% now \macname is the macname and \argl the arglist - \ifx\argl\empty % no arguments - \paramno=0\relax - \else - \expandafter\parsemargdef \argl;% - \if\paramno>256\relax - \ifx\eTeXversion\thisisundefined - \errhelp = \EMsimple - \errmessage{You need eTeX to compile a file with macros with more than 256 arguments} - \fi - \fi - \fi - \if1\csname ismacro.\the\macname\endcsname - \message{Warning: redefining \the\macname}% - \else - \expandafter\ifx\csname \the\macname\endcsname \relax - \else \errmessage{Macro name \the\macname\space already defined}\fi - \global\cslet{macsave.\the\macname}{\the\macname}% - \global\expandafter\let\csname ismacro.\the\macname\endcsname=1% - \addtomacrolist{\the\macname}% - \fi - \begingroup \macrobodyctxt - \ifrecursive \expandafter\parsermacbody - \else \expandafter\parsemacbody - \fi} - -\parseargdef\unmacro{% - \if1\csname ismacro.#1\endcsname - \global\cslet{#1}{macsave.#1}% - \global\expandafter\let \csname ismacro.#1\endcsname=0% - % Remove the macro name from \macrolist: - \begingroup - \expandafter\let\csname#1\endcsname \relax - \let\commondummyword\unmacrodo - \xdef\macrolist{\macrolist}% - \endgroup - \else - \errmessage{Macro #1 not defined}% - \fi -} - -% Called by \do from \dounmacro on each macro. The idea is to omit any -% macro definitions that have been changed to \relax. -% -\def\unmacrodo#1{% - \ifx #1\relax - % remove this - \else - \noexpand\commondummyword \noexpand#1% - \fi -} - -% \getargs -- Parse the arguments to a @macro line. Set \macname to -% the name of the macro, and \argl to the braced argument list. -\def\getargs#1{\getargsxxx#1{}} -\def\getargsxxx#1#{\getmacname #1 \relax\getmacargs} -\def\getmacname#1 #2\relax{\macname={#1}} -\def\getmacargs#1{\def\argl{#1}} -% This made use of the feature that if the last token of a -% is #, then the preceding argument is delimited by -% an opening brace, and that opening brace is not consumed. - -% Parse the optional {params} list to @macro or @rmacro. -% Set \paramno to the number of arguments, -% and \paramlist to a parameter text for the macro (e.g. #1,#2,#3 for a -% three-param macro.) Define \macarg.BLAH for each BLAH in the params -% list to some hook where the argument is to be expanded. If there are -% less than 10 arguments that hook is to be replaced by ##N where N -% is the position in that list, that is to say the macro arguments are to be -% defined `a la TeX in the macro body. -% -% That gets used by \mbodybackslash (above). -% -% If there are 10 or more arguments, a different technique is used: see -% \parsemmanyargdef. -% -\def\parsemargdef#1;{% - \paramno=0\def\paramlist{}% - \let\hash\relax - % \hash is redefined to `#' later to get it into definitions - \let\xeatspaces\relax - \parsemargdefxxx#1,;,% - \ifnum\paramno<10\relax\else - \paramno0\relax - \parsemmanyargdef@@#1,;,% 10 or more arguments - \fi -} -\def\parsemargdefxxx#1,{% - \if#1;\let\next=\relax - \else \let\next=\parsemargdefxxx - \advance\paramno by 1 - \expandafter\edef\csname macarg.\eatspaces{#1}\endcsname - {\xeatspaces{\hash\the\paramno}}% - \edef\paramlist{\paramlist\hash\the\paramno,}% - \fi\next} - -% \parsemacbody, \parsermacbody -% -% Read recursive and nonrecursive macro bodies. (They're different since -% rec and nonrec macros end differently.) -% -% We are in \macrobodyctxt, and the \xdef causes backslashshes in the macro -% body to be transformed. -% Set \macrobody to the body of the macro, and call \defmacro. -% -{\catcode`\ =\other\long\gdef\parsemacbody#1@end macro{% -\xdef\macrobody{\eatcr{#1}}\endgroup\defmacro}}% -{\catcode`\ =\other\long\gdef\parsermacbody#1@end rmacro{% -\xdef\macrobody{\eatcr{#1}}\endgroup\defmacro}}% - -% Make @ a letter, so that we can make private-to-Texinfo macro names. -\edef\texiatcatcode{\the\catcode`\@} -\catcode `@=11\relax - -%%%%%%%%%%%%%% Code for > 10 arguments only %%%%%%%%%%%%%%%%%% - -% If there are 10 or more arguments, a different technique is used, where the -% hook remains in the body, and when macro is to be expanded the body is -% processed again to replace the arguments. -% -% In that case, the hook is \the\toks N-1, and we simply set \toks N-1 to the -% argument N value and then \edef the body (nothing else will expand because of -% the catcode regime under which the body was input). -% -% If you compile with TeX (not eTeX), and you have macros with 10 or more -% arguments, no macro can have more than 256 arguments (else error). -% -% In case that there are 10 or more arguments we parse again the arguments -% list to set new definitions for the \macarg.BLAH macros corresponding to -% each BLAH argument. It was anyhow needed to parse already once this list -% in order to count the arguments, and as macros with at most 9 arguments -% are by far more frequent than macro with 10 or more arguments, defining -% twice the \macarg.BLAH macros does not cost too much processing power. -\def\parsemmanyargdef@@#1,{% - \if#1;\let\next=\relax - \else - \let\next=\parsemmanyargdef@@ - \edef\tempb{\eatspaces{#1}}% - \expandafter\def\expandafter\tempa - \expandafter{\csname macarg.\tempb\endcsname}% - % Note that we need some extra \noexpand\noexpand, this is because we - % don't want \the to be expanded in the \parsermacbody as it uses an - % \xdef . - \expandafter\edef\tempa - {\noexpand\noexpand\noexpand\the\toks\the\paramno}% - \advance\paramno by 1\relax - \fi\next} - - -\let\endargs@\relax -\let\nil@\relax -\def\nilm@{\nil@}% -\long\def\nillm@{\nil@}% - -% This macro is expanded during the Texinfo macro expansion, not during its -% definition. It gets all the arguments' values and assigns them to macros -% macarg.ARGNAME -% -% #1 is the macro name -% #2 is the list of argument names -% #3 is the list of argument values -\def\getargvals@#1#2#3{% - \def\macargdeflist@{}% - \def\saveparamlist@{#2}% Need to keep a copy for parameter expansion. - \def\paramlist{#2,\nil@}% - \def\macroname{#1}% - \begingroup - \macroargctxt - \def\argvaluelist{#3,\nil@}% - \def\@tempa{#3}% - \ifx\@tempa\empty - \setemptyargvalues@ - \else - \getargvals@@ - \fi -} -\def\getargvals@@{% - \ifx\paramlist\nilm@ - % Some sanity check needed here that \argvaluelist is also empty. - \ifx\argvaluelist\nillm@ - \else - \errhelp = \EMsimple - \errmessage{Too many arguments in macro `\macroname'!}% - \fi - \let\next\macargexpandinbody@ - \else - \ifx\argvaluelist\nillm@ - % No more arguments values passed to macro. Set remaining named-arg - % macros to empty. - \let\next\setemptyargvalues@ - \else - % pop current arg name into \@tempb - \def\@tempa##1{\pop@{\@tempb}{\paramlist}##1\endargs@}% - \expandafter\@tempa\expandafter{\paramlist}% - % pop current argument value into \@tempc - \def\@tempa##1{\longpop@{\@tempc}{\argvaluelist}##1\endargs@}% - \expandafter\@tempa\expandafter{\argvaluelist}% - % Here \@tempb is the current arg name and \@tempc is the current arg value. - % First place the new argument macro definition into \@tempd - \expandafter\macname\expandafter{\@tempc}% - \expandafter\let\csname macarg.\@tempb\endcsname\relax - \expandafter\def\expandafter\@tempe\expandafter{% - \csname macarg.\@tempb\endcsname}% - \edef\@tempd{\long\def\@tempe{\the\macname}}% - \push@\@tempd\macargdeflist@ - \let\next\getargvals@@ - \fi - \fi - \next -} - -\def\push@#1#2{% - \expandafter\expandafter\expandafter\def - \expandafter\expandafter\expandafter#2% - \expandafter\expandafter\expandafter{% - \expandafter#1#2}% -} - -% Replace arguments by their values in the macro body, and place the result -% in macro \@tempa. -% -\def\macvalstoargs@{% - % To do this we use the property that token registers that are \the'ed - % within an \edef expand only once. So we are going to place all argument - % values into respective token registers. - % - % First we save the token context, and initialize argument numbering. - \begingroup - \paramno0\relax - % Then, for each argument number #N, we place the corresponding argument - % value into a new token list register \toks#N - \expandafter\putargsintokens@\saveparamlist@,;,% - % Then, we expand the body so that argument are replaced by their - % values. The trick for values not to be expanded themselves is that they - % are within tokens and that tokens expand only once in an \edef . - \edef\@tempc{\csname mac.\macroname .body\endcsname}% - % Now we restore the token stack pointer to free the token list registers - % which we have used, but we make sure that expanded body is saved after - % group. - \expandafter - \endgroup - \expandafter\def\expandafter\@tempa\expandafter{\@tempc}% - } - -% Define the named-macro outside of this group and then close this group. -% -\def\macargexpandinbody@{% - \expandafter - \endgroup - \macargdeflist@ - % First the replace in body the macro arguments by their values, the result - % is in \@tempa . - \macvalstoargs@ - % Then we point at the \norecurse or \gobble (for recursive) macro value - % with \@tempb . - \expandafter\let\expandafter\@tempb\csname mac.\macroname .recurse\endcsname - % Depending on whether it is recursive or not, we need some tailing - % \egroup . - \ifx\@tempb\gobble - \let\@tempc\relax - \else - \let\@tempc\egroup - \fi - % And now we do the real job: - \edef\@tempd{\noexpand\@tempb{\macroname}\noexpand\scanmacro{\@tempa}\@tempc}% - \@tempd -} - -\def\putargsintokens@#1,{% - \if#1;\let\next\relax - \else - \let\next\putargsintokens@ - % First we allocate the new token list register, and give it a temporary - % alias \@tempb . - \toksdef\@tempb\the\paramno - % Then we place the argument value into that token list register. - \expandafter\let\expandafter\@tempa\csname macarg.#1\endcsname - \expandafter\@tempb\expandafter{\@tempa}% - \advance\paramno by 1\relax - \fi - \next -} - -% Trailing missing arguments are set to empty. -% -\def\setemptyargvalues@{% - \ifx\paramlist\nilm@ - \let\next\macargexpandinbody@ - \else - \expandafter\setemptyargvaluesparser@\paramlist\endargs@ - \let\next\setemptyargvalues@ - \fi - \next -} - -\def\setemptyargvaluesparser@#1,#2\endargs@{% - \expandafter\def\expandafter\@tempa\expandafter{% - \expandafter\def\csname macarg.#1\endcsname{}}% - \push@\@tempa\macargdeflist@ - \def\paramlist{#2}% -} - -% #1 is the element target macro -% #2 is the list macro -% #3,#4\endargs@ is the list value -\def\pop@#1#2#3,#4\endargs@{% - \def#1{#3}% - \def#2{#4}% -} -\long\def\longpop@#1#2#3,#4\endargs@{% - \long\def#1{#3}% - \long\def#2{#4}% -} - - -%%%%%%%%%%%%%% End of code for > 10 arguments %%%%%%%%%%%%%%%%%% - - -% This defines a Texinfo @macro or @rmacro, called by \parsemacbody. -% \macrobody has the body of the macro in it, with placeholders for -% its parameters, looking like "\xeatspaces{\hash 1}". -% \paramno is the number of parameters -% \paramlist is a TeX parameter text, e.g. "#1,#2,#3," -% There are four cases: macros of zero, one, up to nine, and many arguments. -% \xdef is used so that macro definitions will survive the file -% they're defined in: @include reads the file inside a group. -% -\def\defmacro{% - \let\hash=##% convert placeholders to macro parameter chars - \ifnum\paramno=1 - \def\xeatspaces##1{##1}% - % This removes the pair of braces around the argument. We don't - % use \eatspaces, because this can cause ends of lines to be lost - % when the argument to \eatspaces is read, leading to line-based - % commands like "@itemize" not being read correctly. - \else - \let\xeatspaces\relax % suppress expansion - \fi - \ifcase\paramno - % 0 - \expandafter\xdef\csname\the\macname\endcsname{% - \bgroup - \noexpand\spaceisspace - \noexpand\endlineisspace - \noexpand\expandafter % skip any whitespace after the macro name. - \expandafter\noexpand\csname\the\macname @@@\endcsname}% - \expandafter\xdef\csname\the\macname @@@\endcsname{% - \egroup - \noexpand\scanmacro{\macrobody}}% - \or % 1 - \expandafter\xdef\csname\the\macname\endcsname{% - \bgroup - \noexpand\braceorline - \expandafter\noexpand\csname\the\macname @@@\endcsname}% - \expandafter\xdef\csname\the\macname @@@\endcsname##1{% - \egroup - \noexpand\scanmacro{\macrobody}% - }% - \else % at most 9 - \ifnum\paramno<10\relax - % @MACNAME sets the context for reading the macro argument - % @MACNAME@@ gets the argument, processes backslashes and appends a - % comma. - % @MACNAME@@@ removes braces surrounding the argument list. - % @MACNAME@@@@ scans the macro body with arguments substituted. - \expandafter\xdef\csname\the\macname\endcsname{% - \bgroup - \noexpand\expandafter % This \expandafter skip any spaces after the - \noexpand\macroargctxt % macro before we change the catcode of space. - \noexpand\expandafter - \expandafter\noexpand\csname\the\macname @@\endcsname}% - \expandafter\xdef\csname\the\macname @@\endcsname##1{% - \noexpand\passargtomacro - \expandafter\noexpand\csname\the\macname @@@\endcsname{##1,}}% - \expandafter\xdef\csname\the\macname @@@\endcsname##1{% - \expandafter\noexpand\csname\the\macname @@@@\endcsname ##1}% - \expandafter\expandafter - \expandafter\xdef - \expandafter\expandafter - \csname\the\macname @@@@\endcsname\paramlist{% - \egroup\noexpand\scanmacro{\macrobody}}% - \else % 10 or more: - \expandafter\xdef\csname\the\macname\endcsname{% - \noexpand\getargvals@{\the\macname}{\argl}% - }% - \global\expandafter\let\csname mac.\the\macname .body\endcsname\macrobody - \global\expandafter\let\csname mac.\the\macname .recurse\endcsname\gobble - \fi - \fi} - -\catcode `\@\texiatcatcode\relax % end private-to-Texinfo catcodes - -\def\norecurse#1{\bgroup\cslet{#1}{macsave.#1}} - - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -% -{\catcode`\@=0 \catcode`\\=13 % We need to manipulate \ so use @ as escape -@catcode`@_=11 % private names -@catcode`@!=11 % used as argument separator - -% \passargtomacro#1#2 - -% Call #1 with a list of tokens #2, with any doubled backslashes in #2 -% compressed to one. -% -% This implementation works by expansion, and not execution (so we cannot use -% \def or similar). This reduces the risk of this failing in contexts where -% complete expansion is done with no execution (for example, in writing out to -% an auxiliary file for an index entry). -% -% State is kept in the input stream: the argument passed to -% @look_ahead, @gobble_and_check_finish and @add_segment is -% -% THE_MACRO ARG_RESULT ! {PENDING_BS} NEXT_TOKEN (... rest of input) -% -% where: -% THE_MACRO - name of the macro we want to call -% ARG_RESULT - argument list we build to pass to that macro -% PENDING_BS - either a backslash or nothing -% NEXT_TOKEN - used to look ahead in the input stream to see what's coming next - -@gdef@passargtomacro#1#2{% - @add_segment #1!{}@relax#2\@_finish\% -} -@gdef@_finish{@_finishx} @global@let@_finishx@relax - -% #1 - THE_MACRO ARG_RESULT -% #2 - PENDING_BS -% #3 - NEXT_TOKEN -% #4 used to look ahead -% -% If the next token is not a backslash, process the rest of the argument; -% otherwise, remove the next token. -@gdef@look_ahead#1!#2#3#4{% - @ifx#4\% - @expandafter@gobble_and_check_finish - @else - @expandafter@add_segment - @fi#1!{#2}#4#4% -} - -% #1 - THE_MACRO ARG_RESULT -% #2 - PENDING_BS -% #3 - NEXT_TOKEN -% #4 should be a backslash, which is gobbled. -% #5 looks ahead -% -% Double backslash found. Add a single backslash, and look ahead. -@gdef@gobble_and_check_finish#1!#2#3#4#5{% - @add_segment#1\!{}#5#5% -} - -@gdef@is_fi{@fi} - -% #1 - THE_MACRO ARG_RESULT -% #2 - PENDING_BS -% #3 - NEXT_TOKEN -% #4 is input stream until next backslash -% -% Input stream is either at the start of the argument, or just after a -% backslash sequence, either a lone backslash, or a doubled backslash. -% NEXT_TOKEN contains the first token in the input stream: if it is \finish, -% finish; otherwise, append to ARG_RESULT the segment of the argument up until -% the next backslash. PENDING_BACKSLASH contains a backslash to represent -% a backslash just before the start of the input stream that has not been -% added to ARG_RESULT. -@gdef@add_segment#1!#2#3#4\{% -@ifx#3@_finish - @call_the_macro#1!% -@else - % append the pending backslash to the result, followed by the next segment - @expandafter@is_fi@look_ahead#1#2#4!{\}@fi - % this @fi is discarded by @look_ahead. - % we can't get rid of it with \expandafter because we don't know how - % long #4 is. -} - -% #1 - THE_MACRO -% #2 - ARG_RESULT -% #3 discards the res of the conditional in @add_segment, and @is_fi ends the -% conditional. -@gdef@call_the_macro#1#2!#3@fi{@is_fi #1{#2}} - -} -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - -% \braceorline MAC is used for a one-argument macro MAC. It checks -% whether the next non-whitespace character is a {. It sets the context -% for reading the argument (slightly different in the two cases). Then, -% to read the argument, in the whole-line case, it then calls the regular -% \parsearg MAC; in the lbrace case, it calls \passargtomacro MAC. -% -\def\braceorline#1{\let\macnamexxx=#1\futurelet\nchar\braceorlinexxx} -\def\braceorlinexxx{% - \ifx\nchar\bgroup - \macroargctxt - \expandafter\passargtomacro - \else - \macrolineargctxt\expandafter\parsearg - \fi \macnamexxx} - - -% @alias. -% We need some trickery to remove the optional spaces around the equal -% sign. Make them active and then expand them all to nothing. -% -\def\alias{\parseargusing\obeyspaces\aliasxxx} -\def\aliasxxx #1{\aliasyyy#1\relax} -\def\aliasyyy #1=#2\relax{% - {% - \expandafter\let\obeyedspace=\empty - \addtomacrolist{#1}% - \xdef\next{\global\let\makecsname{#1}=\makecsname{#2}}% - }% - \next -} - - -\message{cross references,} - -\newwrite\auxfile -\newif\ifhavexrefs % True if xref values are known. -\newif\ifwarnedxrefs % True if we warned once that they aren't known. - -% @inforef is relatively simple. -\def\inforef #1{\inforefzzz #1,,,,**} -\def\inforefzzz #1,#2,#3,#4**{% - \putwordSee{} \putwordInfo{} \putwordfile{} \file{\ignorespaces #3{}}, - node \samp{\ignorespaces#1{}}} - -% @node's only job in TeX is to define \lastnode, which is used in -% cross-references. The @node line might or might not have commas, and -% might or might not have spaces before the first comma, like: -% @node foo , bar , ... -% We don't want such trailing spaces in the node name. -% -\parseargdef\node{\checkenv{}\donode #1 ,\finishnodeparse} -% -% also remove a trailing comma, in case of something like this: -% @node Help-Cross, , , Cross-refs -\def\donode#1 ,#2\finishnodeparse{\dodonode #1,\finishnodeparse} -\def\dodonode#1,#2\finishnodeparse{\gdef\lastnode{#1}} - -\let\nwnode=\node -\let\lastnode=\empty - -% Write a cross-reference definition for the current node. #1 is the -% type (Ynumbered, Yappendix, Ynothing). -% -\def\donoderef#1{% - \ifx\lastnode\empty\else - \setref{\lastnode}{#1}% - \global\let\lastnode=\empty - \fi -} - -% @anchor{NAME} -- define xref target at arbitrary point. -% -\newcount\savesfregister -% -\def\savesf{\relax \ifhmode \savesfregister=\spacefactor \fi} -\def\restoresf{\relax \ifhmode \spacefactor=\savesfregister \fi} -\def\anchor#1{\savesf \setref{#1}{Ynothing}\restoresf \ignorespaces} - -% \setref{NAME}{SNT} defines a cross-reference point NAME (a node or an -% anchor), which consists of three parts: -% 1) NAME-title - the current sectioning name taken from \currentsection, -% or the anchor name. -% 2) NAME-snt - section number and type, passed as the SNT arg, or -% empty for anchors. -% 3) NAME-pg - the page number. -% -% This is called from \donoderef, \anchor, and \dofloat. In the case of -% floats, there is an additional part, which is not written here: -% 4) NAME-lof - the text as it should appear in a @listoffloats. -% -\def\setref#1#2{% - \pdfmkdest{#1}% - \iflinks - {% - \requireauxfile - \atdummies % preserve commands, but don't expand them - % match definition in \xrdef, \refx, \xrefX. - \def\value##1{##1}% - \edef\writexrdef##1##2{% - \write\auxfile{@xrdef{#1-% #1 of \setref, expanded by the \edef - ##1}{##2}}% these are parameters of \writexrdef - }% - \toks0 = \expandafter{\currentsection}% - \immediate \writexrdef{title}{\the\toks0 }% - \immediate \writexrdef{snt}{\csname #2\endcsname}% \Ynumbered etc. - \safewhatsit{\writexrdef{pg}{\folio}}% will be written later, at \shipout - }% - \fi -} - -% @xrefautosectiontitle on|off says whether @section(ing) names are used -% automatically in xrefs, if the third arg is not explicitly specified. -% This was provided as a "secret" @set xref-automatic-section-title -% variable, now it's official. -% -\parseargdef\xrefautomaticsectiontitle{% - \def\temp{#1}% - \ifx\temp\onword - \expandafter\let\csname SETxref-automatic-section-title\endcsname - = \empty - \else\ifx\temp\offword - \expandafter\let\csname SETxref-automatic-section-title\endcsname - = \relax - \else - \errhelp = \EMsimple - \errmessage{Unknown @xrefautomaticsectiontitle value `\temp', - must be on|off}% - \fi\fi -} - -% -% @xref, @pxref, and @ref generate cross-references. For \xrefX, #1 is -% the node name, #2 the name of the Info cross-reference, #3 the printed -% node name, #4 the name of the Info file, #5 the name of the printed -% manual. All but the node name can be omitted. -% -\def\pxref{\putwordsee{} \xrefXX} -\def\xref{\putwordSee{} \xrefXX} -\def\ref{\xrefXX} - -\def\xrefXX#1{\def\xrefXXarg{#1}\futurelet\tokenafterxref\xrefXXX} -\def\xrefXXX{\expandafter\xrefX\expandafter[\xrefXXarg,,,,,,,]} -% -\newbox\toprefbox -\newbox\printedrefnamebox -\newbox\infofilenamebox -\newbox\printedmanualbox -% -\def\xrefX[#1,#2,#3,#4,#5,#6]{\begingroup - \unsepspaces - % - % Get args without leading/trailing spaces. - \def\printedrefname{\ignorespaces #3}% - \setbox\printedrefnamebox = \hbox{\printedrefname\unskip}% - % - \def\infofilename{\ignorespaces #4}% - \setbox\infofilenamebox = \hbox{\infofilename\unskip}% - % - \def\printedmanual{\ignorespaces #5}% - \setbox\printedmanualbox = \hbox{\printedmanual\unskip}% - % - % If the printed reference name (arg #3) was not explicitly given in - % the @xref, figure out what we want to use. - \ifdim \wd\printedrefnamebox = 0pt - % No printed node name was explicitly given. - \expandafter\ifx\csname SETxref-automatic-section-title\endcsname \relax - % Not auto section-title: use node name inside the square brackets. - \def\printedrefname{\ignorespaces #1}% - \else - % Auto section-title: use chapter/section title inside - % the square brackets if we have it. - \ifdim \wd\printedmanualbox > 0pt - % It is in another manual, so we don't have it; use node name. - \def\printedrefname{\ignorespaces #1}% - \else - \ifhavexrefs - % We (should) know the real title if we have the xref values. - \def\printedrefname{\refx{#1-title}{}}% - \else - % Otherwise just copy the Info node name. - \def\printedrefname{\ignorespaces #1}% - \fi% - \fi - \fi - \fi - % - % Make link in pdf output. - \ifpdf - % For pdfTeX and LuaTeX - {\indexnofonts - \makevalueexpandable - \turnoffactive - % This expands tokens, so do it after making catcode changes, so _ - % etc. don't get their TeX definitions. This ignores all spaces in - % #4, including (wrongly) those in the middle of the filename. - \getfilename{#4}% - % - % This (wrongly) does not take account of leading or trailing - % spaces in #1, which should be ignored. - \setpdfdestname{#1}% - % - \ifx\pdfdestname\empty - \def\pdfdestname{Top}% no empty targets - \fi - % - \leavevmode - \startlink attr{/Border [0 0 0]}% - \ifnum\filenamelength>0 - goto file{\the\filename.pdf} name{\pdfdestname}% - \else - goto name{\pdfmkpgn{\pdfdestname}}% - \fi - }% - \setcolor{\linkcolor}% - \else - \ifx\XeTeXrevision\thisisundefined - \else - % For XeTeX - {\indexnofonts - \makevalueexpandable - \turnoffactive - % This expands tokens, so do it after making catcode changes, so _ - % etc. don't get their TeX definitions. This ignores all spaces in - % #4, including (wrongly) those in the middle of the filename. - \getfilename{#4}% - % - % This (wrongly) does not take account of leading or trailing - % spaces in #1, which should be ignored. - \setpdfdestname{#1}% - % - \ifx\pdfdestname\empty - \def\pdfdestname{Top}% no empty targets - \fi - % - \leavevmode - \ifnum\filenamelength>0 - % With default settings, - % XeTeX (xdvipdfmx) replaces link destination names with integers. - % In this case, the replaced destination names of - % remote PDFs are no longer known. In order to avoid a replacement, - % you can use xdvipdfmx's command line option `-C 0x0010'. - % If you use XeTeX 0.99996+ (TeX Live 2016+), - % this command line option is no longer necessary - % because we can use the `dvipdfmx:config' special. - \special{pdf:bann << /Border [0 0 0] /Type /Annot /Subtype /Link /A - << /S /GoToR /F (\the\filename.pdf) /D (\pdfdestname) >> >>}% - \else - \special{pdf:bann << /Border [0 0 0] /Type /Annot /Subtype /Link /A - << /S /GoTo /D (\pdfdestname) >> >>}% - \fi - }% - \setcolor{\linkcolor}% - \fi - \fi - {% - % Have to otherify everything special to allow the \csname to - % include an _ in the xref name, etc. - \indexnofonts - \turnoffactive - \def\value##1{##1}% - \expandafter\global\expandafter\let\expandafter\Xthisreftitle - \csname XR#1-title\endcsname - }% - % - % Float references are printed completely differently: "Figure 1.2" - % instead of "[somenode], p.3". \iffloat distinguishes them by - % \Xthisreftitle being set to a magic string. - \iffloat\Xthisreftitle - % If the user specified the print name (third arg) to the ref, - % print it instead of our usual "Figure 1.2". - \ifdim\wd\printedrefnamebox = 0pt - \refx{#1-snt}{}% - \else - \printedrefname - \fi - % - % If the user also gave the printed manual name (fifth arg), append - % "in MANUALNAME". - \ifdim \wd\printedmanualbox > 0pt - \space \putwordin{} \cite{\printedmanual}% - \fi - \else - % node/anchor (non-float) references. - % - % If we use \unhbox to print the node names, TeX does not insert - % empty discretionaries after hyphens, which means that it will not - % find a line break at a hyphen in a node names. Since some manuals - % are best written with fairly long node names, containing hyphens, - % this is a loss. Therefore, we give the text of the node name - % again, so it is as if TeX is seeing it for the first time. - % - \ifdim \wd\printedmanualbox > 0pt - % Cross-manual reference with a printed manual name. - % - \crossmanualxref{\cite{\printedmanual\unskip}}% - % - \else\ifdim \wd\infofilenamebox > 0pt - % Cross-manual reference with only an info filename (arg 4), no - % printed manual name (arg 5). This is essentially the same as - % the case above; we output the filename, since we have nothing else. - % - \crossmanualxref{\code{\infofilename\unskip}}% - % - \else - % Reference within this manual. - % - % _ (for example) has to be the character _ for the purposes of the - % control sequence corresponding to the node, but it has to expand - % into the usual \leavevmode...\vrule stuff for purposes of - % printing. So we \turnoffactive for the \refx-snt, back on for the - % printing, back off for the \refx-pg. - {\turnoffactive - % Only output a following space if the -snt ref is nonempty; for - % @unnumbered and @anchor, it won't be. - \setbox2 = \hbox{\ignorespaces \refx{#1-snt}{}}% - \ifdim \wd2 > 0pt \refx{#1-snt}\space\fi - }% - % output the `[mynode]' via the macro below so it can be overridden. - \xrefprintnodename\printedrefname - % - % But we always want a comma and a space: - ,\space - % - % output the `page 3'. - \turnoffactive \putwordpage\tie\refx{#1-pg}{}% - % Add a , if xref followed by a space - \if\space\noexpand\tokenafterxref ,% - \else\ifx\ \tokenafterxref ,% @TAB - \else\ifx\*\tokenafterxref ,% @* - \else\ifx\ \tokenafterxref ,% @SPACE - \else\ifx\ - \tokenafterxref ,% @NL - \else\ifx\tie\tokenafterxref ,% @tie - \fi\fi\fi\fi\fi\fi - \fi\fi - \fi - \endlink -\endgroup} - -% Output a cross-manual xref to #1. Used just above (twice). -% -% Only include the text "Section ``foo'' in" if the foo is neither -% missing or Top. Thus, @xref{,,,foo,The Foo Manual} outputs simply -% "see The Foo Manual", the idea being to refer to the whole manual. -% -% But, this being TeX, we can't easily compare our node name against the -% string "Top" while ignoring the possible spaces before and after in -% the input. By adding the arbitrary 7sp below, we make it much less -% likely that a real node name would have the same width as "Top" (e.g., -% in a monospaced font). Hopefully it will never happen in practice. -% -% For the same basic reason, we retypeset the "Top" at every -% reference, since the current font is indeterminate. -% -\def\crossmanualxref#1{% - \setbox\toprefbox = \hbox{Top\kern7sp}% - \setbox2 = \hbox{\ignorespaces \printedrefname \unskip \kern7sp}% - \ifdim \wd2 > 7sp % nonempty? - \ifdim \wd2 = \wd\toprefbox \else % same as Top? - \putwordSection{} ``\printedrefname'' \putwordin{}\space - \fi - \fi - #1% -} - -% This macro is called from \xrefX for the `[nodename]' part of xref -% output. It's a separate macro only so it can be changed more easily, -% since square brackets don't work well in some documents. Particularly -% one that Bob is working on :). -% -\def\xrefprintnodename#1{[#1]} - -% Things referred to by \setref. -% -\def\Ynothing{} -\def\Yomitfromtoc{} -\def\Ynumbered{% - \ifnum\secno=0 - \putwordChapter@tie \the\chapno - \else \ifnum\subsecno=0 - \putwordSection@tie \the\chapno.\the\secno - \else \ifnum\subsubsecno=0 - \putwordSection@tie \the\chapno.\the\secno.\the\subsecno - \else - \putwordSection@tie \the\chapno.\the\secno.\the\subsecno.\the\subsubsecno - \fi\fi\fi -} -\def\Yappendix{% - \ifnum\secno=0 - \putwordAppendix@tie @char\the\appendixno{}% - \else \ifnum\subsecno=0 - \putwordSection@tie @char\the\appendixno.\the\secno - \else \ifnum\subsubsecno=0 - \putwordSection@tie @char\the\appendixno.\the\secno.\the\subsecno - \else - \putwordSection@tie - @char\the\appendixno.\the\secno.\the\subsecno.\the\subsubsecno - \fi\fi\fi -} - -% \refx{NAME}{SUFFIX} - reference a cross-reference string named NAME. SUFFIX -% is output afterwards if non-empty. -\def\refx#1#2{% - \requireauxfile - {% - \indexnofonts - \otherbackslash - \def\value##1{##1}% - \expandafter\global\expandafter\let\expandafter\thisrefX - \csname XR#1\endcsname - }% - \ifx\thisrefX\relax - % If not defined, say something at least. - \angleleft un\-de\-fined\angleright - \iflinks - \ifhavexrefs - {\toks0 = {#1}% avoid expansion of possibly-complex value - \message{\linenumber Undefined cross reference `\the\toks0'.}}% - \else - \ifwarnedxrefs\else - \global\warnedxrefstrue - \message{Cross reference values unknown; you must run TeX again.}% - \fi - \fi - \fi - \else - % It's defined, so just use it. - \thisrefX - \fi - #2% Output the suffix in any case. -} - -% This is the macro invoked by entries in the aux file. Define a control -% sequence for a cross-reference target (we prepend XR to the control sequence -% name to avoid collisions). The value is the page number. If this is a float -% type, we have more work to do. -% -\def\xrdef#1#2{% - {% Expand the node or anchor name to remove control sequences. - % \turnoffactive stops 8-bit characters being changed to commands - % like @'e. \refx does the same to retrieve the value in the definition. - \indexnofonts - \turnoffactive - \def\value##1{##1}% - \xdef\safexrefname{#1}% - }% - % - \bgroup - \expandafter\gdef\csname XR\safexrefname\endcsname{#2}% - \egroup - % We put the \gdef inside a group to avoid the definitions building up on - % TeX's save stack, which can cause it to run out of space for aux files with - % thousands of lines. \gdef doesn't use the save stack, but \csname does - % when it defines an unknown control sequence as \relax. - % - % Was that xref control sequence that we just defined for a float? - \expandafter\iffloat\csname XR\safexrefname\endcsname - % it was a float, and we have the (safe) float type in \iffloattype. - \expandafter\let\expandafter\floatlist - \csname floatlist\iffloattype\endcsname - % - % Is this the first time we've seen this float type? - \expandafter\ifx\floatlist\relax - \toks0 = {\do}% yes, so just \do - \else - % had it before, so preserve previous elements in list. - \toks0 = \expandafter{\floatlist\do}% - \fi - % - % Remember this xref in the control sequence \floatlistFLOATTYPE, - % for later use in \listoffloats. - \expandafter\xdef\csname floatlist\iffloattype\endcsname{\the\toks0 - {\safexrefname}}% - \fi -} - -% If working on a large document in chapters, it is convenient to -% be able to disable indexing, cross-referencing, and contents, for test runs. -% This is done with @novalidate at the beginning of the file. -% -\newif\iflinks \linkstrue % by default we want the aux files. -\let\novalidate = \linksfalse - -% Used when writing to the aux file, or when using data from it. -\def\requireauxfile{% - \iflinks - \tryauxfile - % Open the new aux file. TeX will close it automatically at exit. - \immediate\openout\auxfile=\jobname.aux - \fi - \global\let\requireauxfile=\relax % Only do this once. -} - -% Read the last existing aux file, if any. No error if none exists. -% -\def\tryauxfile{% - \openin 1 \jobname.aux - \ifeof 1 \else - \readdatafile{aux}% - \global\havexrefstrue - \fi - \closein 1 -} - -\def\setupdatafile{% - \catcode`\^^@=\other - \catcode`\^^A=\other - \catcode`\^^B=\other - \catcode`\^^C=\other - \catcode`\^^D=\other - \catcode`\^^E=\other - \catcode`\^^F=\other - \catcode`\^^G=\other - \catcode`\^^H=\other - \catcode`\^^K=\other - \catcode`\^^L=\other - \catcode`\^^N=\other - \catcode`\^^P=\other - \catcode`\^^Q=\other - \catcode`\^^R=\other - \catcode`\^^S=\other - \catcode`\^^T=\other - \catcode`\^^U=\other - \catcode`\^^V=\other - \catcode`\^^W=\other - \catcode`\^^X=\other - \catcode`\^^Z=\other - \catcode`\^^[=\other - \catcode`\^^\=\other - \catcode`\^^]=\other - \catcode`\^^^=\other - \catcode`\^^_=\other - \catcode`\^=\other - % - % Special characters. Should be turned off anyway, but... - \catcode`\~=\other - \catcode`\[=\other - \catcode`\]=\other - \catcode`\"=\other - \catcode`\_=\other - \catcode`\|=\other - \catcode`\<=\other - \catcode`\>=\other - \catcode`\$=\other - \catcode`\#=\other - \catcode`\&=\other - \catcode`\%=\other - \catcode`+=\other % avoid \+ for paranoia even though we've turned it off - % - \catcode`\\=\active - % - % @ is our escape character in .aux files, and we need braces. - \catcode`\{=1 - \catcode`\}=2 - \catcode`\@=0 -} - -\def\readdatafile#1{% -\begingroup - \setupdatafile - \input\jobname.#1 -\endgroup} - - -\message{insertions,} -% including footnotes. - -\newcount \footnoteno - -% The trailing space in the following definition for supereject is -% vital for proper filling; pages come out unaligned when you do a -% pagealignmacro call if that space before the closing brace is -% removed. (Generally, numeric constants should always be followed by a -% space to prevent strange expansion errors.) -\def\supereject{\par\penalty -20000\footnoteno =0 } - -% @footnotestyle is meaningful for Info output only. -\let\footnotestyle=\comment - -{\catcode `\@=11 -% -% Auto-number footnotes. Otherwise like plain. -\gdef\footnote{% - \global\advance\footnoteno by \@ne - \edef\thisfootno{$^{\the\footnoteno}$}% - % - % In case the footnote comes at the end of a sentence, preserve the - % extra spacing after we do the footnote number. - \let\@sf\empty - \ifhmode\edef\@sf{\spacefactor\the\spacefactor}\ptexslash\fi - % - % Remove inadvertent blank space before typesetting the footnote number. - \unskip - \thisfootno\@sf - \dofootnote -}% - -% Don't bother with the trickery in plain.tex to not require the -% footnote text as a parameter. Our footnotes don't need to be so general. -% -% Oh yes, they do; otherwise, @ifset (and anything else that uses -% \parseargline) fails inside footnotes because the tokens are fixed when -% the footnote is read. --karl, 16nov96. -% -\gdef\dofootnote{% - \insert\footins\bgroup - % - % Nested footnotes are not supported in TeX, that would take a lot - % more work. (\startsavinginserts does not suffice.) - \let\footnote=\errfootnotenest - % - % We want to typeset this text as a normal paragraph, even if the - % footnote reference occurs in (for example) a display environment. - % So reset some parameters. - \hsize=\txipagewidth - \interlinepenalty\interfootnotelinepenalty - \splittopskip\ht\strutbox % top baseline for broken footnotes - \splitmaxdepth\dp\strutbox - \floatingpenalty\@MM - \leftskip\z@skip - \rightskip\z@skip - \spaceskip\z@skip - \xspaceskip\z@skip - \parindent\defaultparindent - % - \smallfonts \rm - % - % Because we use hanging indentation in footnotes, a @noindent appears - % to exdent this text, so make it be a no-op. makeinfo does not use - % hanging indentation so @noindent can still be needed within footnote - % text after an @example or the like (not that this is good style). - \let\noindent = \relax - % - % Hang the footnote text off the number. Use \everypar in case the - % footnote extends for more than one paragraph. - \everypar = {\hang}% - \textindent{\thisfootno}% - % - % Don't crash into the line above the footnote text. Since this - % expands into a box, it must come within the paragraph, lest it - % provide a place where TeX can split the footnote. - \footstrut - % - % Invoke rest of plain TeX footnote routine. - \futurelet\next\fo@t -} -}%end \catcode `\@=11 - -\def\errfootnotenest{% - \errhelp=\EMsimple - \errmessage{Nested footnotes not supported in texinfo.tex, - even though they work in makeinfo; sorry} -} - -\def\errfootnoteheading{% - \errhelp=\EMsimple - \errmessage{Footnotes in chapters, sections, etc., are not supported} -} - -% In case a @footnote appears in a vbox, save the footnote text and create -% the real \insert just after the vbox finished. Otherwise, the insertion -% would be lost. -% Similarly, if a @footnote appears inside an alignment, save the footnote -% text to a box and make the \insert when a row of the table is finished. -% And the same can be done for other insert classes. --kasal, 16nov03. -% -% Replace the \insert primitive by a cheating macro. -% Deeper inside, just make sure that the saved insertions are not spilled -% out prematurely. -% -\def\startsavinginserts{% - \ifx \insert\ptexinsert - \let\insert\saveinsert - \else - \let\checkinserts\relax - \fi -} - -% This \insert replacement works for both \insert\footins{foo} and -% \insert\footins\bgroup foo\egroup, but it doesn't work for \insert27{foo}. -% -\def\saveinsert#1{% - \edef\next{\noexpand\savetobox \makeSAVEname#1}% - \afterassignment\next - % swallow the left brace - \let\temp = -} -\def\makeSAVEname#1{\makecsname{SAVE\expandafter\gobble\string#1}} -\def\savetobox#1{\global\setbox#1 = \vbox\bgroup \unvbox#1} - -\def\checksaveins#1{\ifvoid#1\else \placesaveins#1\fi} - -\def\placesaveins#1{% - \ptexinsert \csname\expandafter\gobblesave\string#1\endcsname - {\box#1}% -} - -% eat @SAVE -- beware, all of them have catcode \other: -{ - \def\dospecials{\do S\do A\do V\do E} \uncatcodespecials % ;-) - \gdef\gobblesave @SAVE{} -} - -% initialization: -\def\newsaveins #1{% - \edef\next{\noexpand\newsaveinsX \makeSAVEname#1}% - \next -} -\def\newsaveinsX #1{% - \csname newbox\endcsname #1% - \expandafter\def\expandafter\checkinserts\expandafter{\checkinserts - \checksaveins #1}% -} - -% initialize: -\let\checkinserts\empty -\newsaveins\footins -\newsaveins\margin - - -% @image. We use the macros from epsf.tex to support this. -% If epsf.tex is not installed and @image is used, we complain. -% -% Check for and read epsf.tex up front. If we read it only at @image -% time, we might be inside a group, and then its definitions would get -% undone and the next image would fail. -\openin 1 = epsf.tex -\ifeof 1 \else - % Do not bother showing banner with epsf.tex v2.7k (available in - % doc/epsf.tex and on ctan). - \def\epsfannounce{\toks0 = }% - \input epsf.tex -\fi -\closein 1 -% -% We will only complain once about lack of epsf.tex. -\newif\ifwarnednoepsf -\newhelp\noepsfhelp{epsf.tex must be installed for images to - work. It is also included in the Texinfo distribution, or you can get - it from https://ctan.org/texarchive/macros/texinfo/texinfo/doc/epsf.tex.} -% -\def\image#1{% - \ifx\epsfbox\thisisundefined - \ifwarnednoepsf \else - \errhelp = \noepsfhelp - \errmessage{epsf.tex not found, images will be ignored}% - \global\warnednoepsftrue - \fi - \else - \imagexxx #1,,,,,\finish - \fi -} -% -% Arguments to @image: -% #1 is (mandatory) image filename; we tack on .eps extension. -% #2 is (optional) width, #3 is (optional) height. -% #4 is (ignored optional) html alt text. -% #5 is (ignored optional) extension. -% #6 is just the usual extra ignored arg for parsing stuff. -\newif\ifimagevmode -\def\imagexxx#1,#2,#3,#4,#5,#6\finish{\begingroup - \catcode`\^^M = 5 % in case we're inside an example - \normalturnoffactive % allow _ et al. in names - \def\xprocessmacroarg{\eatspaces}% in case we are being used via a macro - % If the image is by itself, center it. - \ifvmode - \imagevmodetrue - \else \ifx\centersub\centerV - % for @center @image, we need a vbox so we can have our vertical space - \imagevmodetrue - \vbox\bgroup % vbox has better behavior than vtop herev - \fi\fi - % - \ifimagevmode - \nobreak\medskip - % Usually we'll have text after the image which will insert - % \parskip glue, so insert it here too to equalize the space - % above and below. - \nobreak\vskip\parskip - \nobreak - \fi - % - % Leave vertical mode so that indentation from an enclosing - % environment such as @quotation is respected. - % However, if we're at the top level, we don't want the - % normal paragraph indentation. - % On the other hand, if we are in the case of @center @image, we don't - % want to start a paragraph, which will create a hsize-width box and - % eradicate the centering. - \ifx\centersub\centerV\else \noindent \fi - % - % Output the image. - \ifpdf - % For pdfTeX and LuaTeX <= 0.80 - \dopdfimage{#1}{#2}{#3}% - \else - \ifx\XeTeXrevision\thisisundefined - % For epsf.tex - % \epsfbox itself resets \epsf?size at each figure. - \setbox0 = \hbox{\ignorespaces #2}% - \ifdim\wd0 > 0pt \epsfxsize=#2\relax \fi - \setbox0 = \hbox{\ignorespaces #3}% - \ifdim\wd0 > 0pt \epsfysize=#3\relax \fi - \epsfbox{#1.eps}% - \else - % For XeTeX - \doxeteximage{#1}{#2}{#3}% - \fi - \fi - % - \ifimagevmode - \medskip % space after a standalone image - \fi - \ifx\centersub\centerV \egroup \fi -\endgroup} - - -% @float FLOATTYPE,LABEL,LOC ... @end float for displayed figures, tables, -% etc. We don't actually implement floating yet, we always include the -% float "here". But it seemed the best name for the future. -% -\envparseargdef\float{\eatcommaspace\eatcommaspace\dofloat#1, , ,\finish} - -% There may be a space before second and/or third parameter; delete it. -\def\eatcommaspace#1, {#1,} - -% #1 is the optional FLOATTYPE, the text label for this float, typically -% "Figure", "Table", "Example", etc. Can't contain commas. If omitted, -% this float will not be numbered and cannot be referred to. -% -% #2 is the optional xref label. Also must be present for the float to -% be referable. -% -% #3 is the optional positioning argument; for now, it is ignored. It -% will somehow specify the positions allowed to float to (here, top, bottom). -% -% We keep a separate counter for each FLOATTYPE, which we reset at each -% chapter-level command. -\let\resetallfloatnos=\empty -% -\def\dofloat#1,#2,#3,#4\finish{% - \let\thiscaption=\empty - \let\thisshortcaption=\empty - % - % don't lose footnotes inside @float. - % - % BEWARE: when the floats start float, we have to issue warning whenever an - % insert appears inside a float which could possibly float. --kasal, 26may04 - % - \startsavinginserts - % - % We can't be used inside a paragraph. - \par - % - \vtop\bgroup - \def\floattype{#1}% - \def\floatlabel{#2}% - \def\floatloc{#3}% we do nothing with this yet. - % - \ifx\floattype\empty - \let\safefloattype=\empty - \else - {% - % the floattype might have accents or other special characters, - % but we need to use it in a control sequence name. - \indexnofonts - \turnoffactive - \xdef\safefloattype{\floattype}% - }% - \fi - % - % If label is given but no type, we handle that as the empty type. - \ifx\floatlabel\empty \else - % We want each FLOATTYPE to be numbered separately (Figure 1, - % Table 1, Figure 2, ...). (And if no label, no number.) - % - \expandafter\getfloatno\csname\safefloattype floatno\endcsname - \global\advance\floatno by 1 - % - {% - % This magic value for \currentsection is output by \setref as the - % XREFLABEL-title value. \xrefX uses it to distinguish float - % labels (which have a completely different output format) from - % node and anchor labels. And \xrdef uses it to construct the - % lists of floats. - % - \edef\currentsection{\floatmagic=\safefloattype}% - \setref{\floatlabel}{Yfloat}% - }% - \fi - % - % start with \parskip glue, I guess. - \vskip\parskip - % - % Don't suppress indentation if a float happens to start a section. - \restorefirstparagraphindent -} - -% we have these possibilities: -% @float Foo,lbl & @caption{Cap}: Foo 1.1: Cap -% @float Foo,lbl & no caption: Foo 1.1 -% @float Foo & @caption{Cap}: Foo: Cap -% @float Foo & no caption: Foo -% @float ,lbl & Caption{Cap}: 1.1: Cap -% @float ,lbl & no caption: 1.1 -% @float & @caption{Cap}: Cap -% @float & no caption: -% -\def\Efloat{% - \let\floatident = \empty - % - % In all cases, if we have a float type, it comes first. - \ifx\floattype\empty \else \def\floatident{\floattype}\fi - % - % If we have an xref label, the number comes next. - \ifx\floatlabel\empty \else - \ifx\floattype\empty \else % if also had float type, need tie first. - \appendtomacro\floatident{\tie}% - \fi - % the number. - \appendtomacro\floatident{\chaplevelprefix\the\floatno}% - \fi - % - % Start the printed caption with what we've constructed in - % \floatident, but keep it separate; we need \floatident again. - \let\captionline = \floatident - % - \ifx\thiscaption\empty \else - \ifx\floatident\empty \else - \appendtomacro\captionline{: }% had ident, so need a colon between - \fi - % - % caption text. - \appendtomacro\captionline{\scanexp\thiscaption}% - \fi - % - % If we have anything to print, print it, with space before. - % Eventually this needs to become an \insert. - \ifx\captionline\empty \else - \vskip.5\parskip - \captionline - % - % Space below caption. - \vskip\parskip - \fi - % - % If have an xref label, write the list of floats info. Do this - % after the caption, to avoid chance of it being a breakpoint. - \ifx\floatlabel\empty \else - % Write the text that goes in the lof to the aux file as - % \floatlabel-lof. Besides \floatident, we include the short - % caption if specified, else the full caption if specified, else nothing. - {% - \requireauxfile - \atdummies - % - \ifx\thisshortcaption\empty - \def\gtemp{\thiscaption}% - \else - \def\gtemp{\thisshortcaption}% - \fi - \immediate\write\auxfile{@xrdef{\floatlabel-lof}{\floatident - \ifx\gtemp\empty \else : \gtemp \fi}}% - }% - \fi - \egroup % end of \vtop - % - \checkinserts -} - -% Append the tokens #2 to the definition of macro #1, not expanding either. -% -\def\appendtomacro#1#2{% - \expandafter\def\expandafter#1\expandafter{#1#2}% -} - -% @caption, @shortcaption -% -\def\caption{\docaption\thiscaption} -\def\shortcaption{\docaption\thisshortcaption} -\def\docaption{\checkenv\float \bgroup\scanargctxt\defcaption} -\def\defcaption#1#2{\egroup \def#1{#2}} - -% The parameter is the control sequence identifying the counter we are -% going to use. Create it if it doesn't exist and assign it to \floatno. -\def\getfloatno#1{% - \ifx#1\relax - % Haven't seen this figure type before. - \csname newcount\endcsname #1% - % - % Remember to reset this floatno at the next chap. - \expandafter\gdef\expandafter\resetallfloatnos - \expandafter{\resetallfloatnos #1=0 }% - \fi - \let\floatno#1% -} - -% \setref calls this to get the XREFLABEL-snt value. We want an @xref -% to the FLOATLABEL to expand to "Figure 3.1". We call \setref when we -% first read the @float command. -% -\def\Yfloat{\floattype@tie \chaplevelprefix\the\floatno}% - -% Magic string used for the XREFLABEL-title value, so \xrefX can -% distinguish floats from other xref types. -\def\floatmagic{!!float!!} - -% #1 is the control sequence we are passed; we expand into a conditional -% which is true if #1 represents a float ref. That is, the magic -% \currentsection value which we \setref above. -% -\def\iffloat#1{\expandafter\doiffloat#1==\finish} -% -% #1 is (maybe) the \floatmagic string. If so, #2 will be the -% (safe) float type for this float. We set \iffloattype to #2. -% -\def\doiffloat#1=#2=#3\finish{% - \def\temp{#1}% - \def\iffloattype{#2}% - \ifx\temp\floatmagic -} - -% @listoffloats FLOATTYPE - print a list of floats like a table of contents. -% -\parseargdef\listoffloats{% - \def\floattype{#1}% floattype - {% - % the floattype might have accents or other special characters, - % but we need to use it in a control sequence name. - \indexnofonts - \turnoffactive - \xdef\safefloattype{\floattype}% - }% - % - % \xrdef saves the floats as a \do-list in \floatlistSAFEFLOATTYPE. - \expandafter\ifx\csname floatlist\safefloattype\endcsname \relax - \ifhavexrefs - % if the user said @listoffloats foo but never @float foo. - \message{\linenumber No `\safefloattype' floats to list.}% - \fi - \else - \begingroup - \leftskip=\tocindent % indent these entries like a toc - \let\do=\listoffloatsdo - \csname floatlist\safefloattype\endcsname - \endgroup - \fi -} - -% This is called on each entry in a list of floats. We're passed the -% xref label, in the form LABEL-title, which is how we save it in the -% aux file. We strip off the -title and look up \XRLABEL-lof, which -% has the text we're supposed to typeset here. -% -% Figures without xref labels will not be included in the list (since -% they won't appear in the aux file). -% -\def\listoffloatsdo#1{\listoffloatsdoentry#1\finish} -\def\listoffloatsdoentry#1-title\finish{{% - % Can't fully expand XR#1-lof because it can contain anything. Just - % pass the control sequence. On the other hand, XR#1-pg is just the - % page number, and we want to fully expand that so we can get a link - % in pdf output. - \toksA = \expandafter{\csname XR#1-lof\endcsname}% - % - % use the same \entry macro we use to generate the TOC and index. - \edef\writeentry{\noexpand\entry{\the\toksA}{\csname XR#1-pg\endcsname}}% - \writeentry -}} - - -\message{localization,} - -% For single-language documents, @documentlanguage is usually given very -% early, just after @documentencoding. Single argument is the language -% (de) or locale (de_DE) abbreviation. -% -{ - \catcode`\_ = \active - \globaldefs=1 -\parseargdef\documentlanguage{% - \tex % read txi-??.tex file in plain TeX. - % Read the file by the name they passed if it exists. - \let_ = \normalunderscore % normal _ character for filename test - \openin 1 txi-#1.tex - \ifeof 1 - \documentlanguagetrywithoutunderscore #1_\finish - \else - \globaldefs = 1 % everything in the txi-LL files needs to persist - \input txi-#1.tex - \fi - \closein 1 - \endgroup % end raw TeX -} -% -% If they passed de_DE, and txi-de_DE.tex doesn't exist, -% try txi-de.tex. -% -\gdef\documentlanguagetrywithoutunderscore#1_#2\finish{% - \openin 1 txi-#1.tex - \ifeof 1 - \errhelp = \nolanghelp - \errmessage{Cannot read language file txi-#1.tex}% - \else - \globaldefs = 1 % everything in the txi-LL files needs to persist - \input txi-#1.tex - \fi - \closein 1 -} -}% end of special _ catcode -% -\newhelp\nolanghelp{The given language definition file cannot be found or -is empty. Maybe you need to install it? Putting it in the current -directory should work if nowhere else does.} - -% This macro is called from txi-??.tex files; the first argument is the -% \language name to set (without the "\lang@" prefix), the second and -% third args are \{left,right}hyphenmin. -% -% The language names to pass are determined when the format is built. -% See the etex.log file created at that time, e.g., -% /usr/local/texlive/2008/texmf-var/web2c/pdftex/etex.log. -% -% With TeX Live 2008, etex now includes hyphenation patterns for all -% available languages. This means we can support hyphenation in -% Texinfo, at least to some extent. (This still doesn't solve the -% accented characters problem.) -% -\catcode`@=11 -\def\txisetlanguage#1#2#3{% - % do not set the language if the name is undefined in the current TeX. - \expandafter\ifx\csname lang@#1\endcsname \relax - \message{no patterns for #1}% - \else - \global\language = \csname lang@#1\endcsname - \fi - % but there is no harm in adjusting the hyphenmin values regardless. - \global\lefthyphenmin = #2\relax - \global\righthyphenmin = #3\relax -} - -% XeTeX and LuaTeX can handle Unicode natively. -% Their default I/O uses UTF-8 sequences instead of a byte-wise operation. -% Other TeX engines' I/O (pdfTeX, etc.) is byte-wise. -% -\newif\iftxinativeunicodecapable -\newif\iftxiusebytewiseio - -\ifx\XeTeXrevision\thisisundefined - \ifx\luatexversion\thisisundefined - \txinativeunicodecapablefalse - \txiusebytewiseiotrue - \else - \txinativeunicodecapabletrue - \txiusebytewiseiofalse - \fi -\else - \txinativeunicodecapabletrue - \txiusebytewiseiofalse -\fi - -% Set I/O by bytes instead of UTF-8 sequence for XeTeX and LuaTex -% for non-UTF-8 (byte-wise) encodings. -% -\def\setbytewiseio{% - \ifx\XeTeXrevision\thisisundefined - \else - \XeTeXdefaultencoding "bytes" % For subsequent files to be read - \XeTeXinputencoding "bytes" % For document root file - % Unfortunately, there seems to be no corresponding XeTeX command for - % output encoding. This is a problem for auxiliary index and TOC files. - % The only solution would be perhaps to write out @U{...} sequences in - % place of non-ASCII characters. - \fi - - \ifx\luatexversion\thisisundefined - \else - \directlua{ - local utf8_char, byte, gsub = unicode.utf8.char, string.byte, string.gsub - local function convert_char (char) - return utf8_char(byte(char)) - end - - local function convert_line (line) - return gsub(line, ".", convert_char) - end - - callback.register("process_input_buffer", convert_line) - - local function convert_line_out (line) - local line_out = "" - for c in string.utfvalues(line) do - line_out = line_out .. string.char(c) - end - return line_out - end - - callback.register("process_output_buffer", convert_line_out) - } - \fi - - \txiusebytewiseiotrue -} - - -% Helpers for encodings. -% Set the catcode of characters 128 through 255 to the specified number. -% -\def\setnonasciicharscatcode#1{% - \count255=128 - \loop\ifnum\count255<256 - \global\catcode\count255=#1\relax - \advance\count255 by 1 - \repeat -} - -\def\setnonasciicharscatcodenonglobal#1{% - \count255=128 - \loop\ifnum\count255<256 - \catcode\count255=#1\relax - \advance\count255 by 1 - \repeat -} - -% @documentencoding sets the definition of non-ASCII characters -% according to the specified encoding. -% -\def\documentencoding{\parseargusing\filenamecatcodes\documentencodingzzz} -\def\documentencodingzzz#1{% - % - % Encoding being declared for the document. - \def\declaredencoding{\csname #1.enc\endcsname}% - % - % Supported encodings: names converted to tokens in order to be able - % to compare them with \ifx. - \def\ascii{\csname US-ASCII.enc\endcsname}% - \def\latnine{\csname ISO-8859-15.enc\endcsname}% - \def\latone{\csname ISO-8859-1.enc\endcsname}% - \def\lattwo{\csname ISO-8859-2.enc\endcsname}% - \def\utfeight{\csname UTF-8.enc\endcsname}% - % - \ifx \declaredencoding \ascii - \asciichardefs - % - \else \ifx \declaredencoding \lattwo - \iftxinativeunicodecapable - \setbytewiseio - \fi - \setnonasciicharscatcode\active - \lattwochardefs - % - \else \ifx \declaredencoding \latone - \iftxinativeunicodecapable - \setbytewiseio - \fi - \setnonasciicharscatcode\active - \latonechardefs - % - \else \ifx \declaredencoding \latnine - \iftxinativeunicodecapable - \setbytewiseio - \fi - \setnonasciicharscatcode\active - \latninechardefs - % - \else \ifx \declaredencoding \utfeight - \iftxinativeunicodecapable - % For native Unicode handling (XeTeX and LuaTeX) - \nativeunicodechardefs - \else - % For treating UTF-8 as byte sequences (TeX, eTeX and pdfTeX) - \setnonasciicharscatcode\active - % since we already invoked \utfeightchardefs at the top level - % (below), do not re-invoke it, otherwise our check for duplicated - % definitions gets triggered. Making non-ascii chars active is - % sufficient. - \fi - % - \else - \message{Ignoring unknown document encoding: #1.}% - % - \fi % utfeight - \fi % latnine - \fi % latone - \fi % lattwo - \fi % ascii - % - \ifx\XeTeXrevision\thisisundefined - \else - \ifx \declaredencoding \utfeight - \else - \ifx \declaredencoding \ascii - \else - \message{Warning: XeTeX with non-UTF-8 encodings cannot handle % - non-ASCII characters in auxiliary files.}% - \fi - \fi - \fi -} - -% emacs-page -% A message to be logged when using a character that isn't available -% the default font encoding (OT1). -% -\def\missingcharmsg#1{\message{Character missing, sorry: #1.}} - -% Take account of \c (plain) vs. \, (Texinfo) difference. -\def\cedilla#1{\ifx\c\ptexc\c{#1}\else\,{#1}\fi} - -% First, make active non-ASCII characters in order for them to be -% correctly categorized when TeX reads the replacement text of -% macros containing the character definitions. -\setnonasciicharscatcode\active -% - -\def\gdefchar#1#2{% -\gdef#1{% - \ifpassthroughchars - \string#1% - \else - #2% - \fi -}} - -% Latin1 (ISO-8859-1) character definitions. -\def\latonechardefs{% - \gdefchar^^a0{\tie} - \gdefchar^^a1{\exclamdown} - \gdefchar^^a2{{\tcfont \char162}} % cent - \gdefchar^^a3{\pounds{}} - \gdefchar^^a4{{\tcfont \char164}} % currency - \gdefchar^^a5{{\tcfont \char165}} % yen - \gdefchar^^a6{{\tcfont \char166}} % broken bar - \gdefchar^^a7{\S} - \gdefchar^^a8{\"{}} - \gdefchar^^a9{\copyright{}} - \gdefchar^^aa{\ordf} - \gdefchar^^ab{\guillemetleft{}} - \gdefchar^^ac{\ensuremath\lnot} - \gdefchar^^ad{\-} - \gdefchar^^ae{\registeredsymbol{}} - \gdefchar^^af{\={}} - % - \gdefchar^^b0{\textdegree} - \gdefchar^^b1{$\pm$} - \gdefchar^^b2{$^2$} - \gdefchar^^b3{$^3$} - \gdefchar^^b4{\'{}} - \gdefchar^^b5{$\mu$} - \gdefchar^^b6{\P} - \gdefchar^^b7{\ensuremath\cdot} - \gdefchar^^b8{\cedilla\ } - \gdefchar^^b9{$^1$} - \gdefchar^^ba{\ordm} - \gdefchar^^bb{\guillemetright{}} - \gdefchar^^bc{$1\over4$} - \gdefchar^^bd{$1\over2$} - \gdefchar^^be{$3\over4$} - \gdefchar^^bf{\questiondown} - % - \gdefchar^^c0{\`A} - \gdefchar^^c1{\'A} - \gdefchar^^c2{\^A} - \gdefchar^^c3{\~A} - \gdefchar^^c4{\"A} - \gdefchar^^c5{\ringaccent A} - \gdefchar^^c6{\AE} - \gdefchar^^c7{\cedilla C} - \gdefchar^^c8{\`E} - \gdefchar^^c9{\'E} - \gdefchar^^ca{\^E} - \gdefchar^^cb{\"E} - \gdefchar^^cc{\`I} - \gdefchar^^cd{\'I} - \gdefchar^^ce{\^I} - \gdefchar^^cf{\"I} - % - \gdefchar^^d0{\DH} - \gdefchar^^d1{\~N} - \gdefchar^^d2{\`O} - \gdefchar^^d3{\'O} - \gdefchar^^d4{\^O} - \gdefchar^^d5{\~O} - \gdefchar^^d6{\"O} - \gdefchar^^d7{$\times$} - \gdefchar^^d8{\O} - \gdefchar^^d9{\`U} - \gdefchar^^da{\'U} - \gdefchar^^db{\^U} - \gdefchar^^dc{\"U} - \gdefchar^^dd{\'Y} - \gdefchar^^de{\TH} - \gdefchar^^df{\ss} - % - \gdefchar^^e0{\`a} - \gdefchar^^e1{\'a} - \gdefchar^^e2{\^a} - \gdefchar^^e3{\~a} - \gdefchar^^e4{\"a} - \gdefchar^^e5{\ringaccent a} - \gdefchar^^e6{\ae} - \gdefchar^^e7{\cedilla c} - \gdefchar^^e8{\`e} - \gdefchar^^e9{\'e} - \gdefchar^^ea{\^e} - \gdefchar^^eb{\"e} - \gdefchar^^ec{\`{\dotless i}} - \gdefchar^^ed{\'{\dotless i}} - \gdefchar^^ee{\^{\dotless i}} - \gdefchar^^ef{\"{\dotless i}} - % - \gdefchar^^f0{\dh} - \gdefchar^^f1{\~n} - \gdefchar^^f2{\`o} - \gdefchar^^f3{\'o} - \gdefchar^^f4{\^o} - \gdefchar^^f5{\~o} - \gdefchar^^f6{\"o} - \gdefchar^^f7{$\div$} - \gdefchar^^f8{\o} - \gdefchar^^f9{\`u} - \gdefchar^^fa{\'u} - \gdefchar^^fb{\^u} - \gdefchar^^fc{\"u} - \gdefchar^^fd{\'y} - \gdefchar^^fe{\th} - \gdefchar^^ff{\"y} -} - -% Latin9 (ISO-8859-15) encoding character definitions. -\def\latninechardefs{% - % Encoding is almost identical to Latin1. - \latonechardefs - % - \gdefchar^^a4{\euro{}} - \gdefchar^^a6{\v S} - \gdefchar^^a8{\v s} - \gdefchar^^b4{\v Z} - \gdefchar^^b8{\v z} - \gdefchar^^bc{\OE} - \gdefchar^^bd{\oe} - \gdefchar^^be{\"Y} -} - -% Latin2 (ISO-8859-2) character definitions. -\def\lattwochardefs{% - \gdefchar^^a0{\tie} - \gdefchar^^a1{\ogonek{A}} - \gdefchar^^a2{\u{}} - \gdefchar^^a3{\L} - \gdefchar^^a4{\missingcharmsg{CURRENCY SIGN}} - \gdefchar^^a5{\v L} - \gdefchar^^a6{\'S} - \gdefchar^^a7{\S} - \gdefchar^^a8{\"{}} - \gdefchar^^a9{\v S} - \gdefchar^^aa{\cedilla S} - \gdefchar^^ab{\v T} - \gdefchar^^ac{\'Z} - \gdefchar^^ad{\-} - \gdefchar^^ae{\v Z} - \gdefchar^^af{\dotaccent Z} - % - \gdefchar^^b0{\textdegree{}} - \gdefchar^^b1{\ogonek{a}} - \gdefchar^^b2{\ogonek{ }} - \gdefchar^^b3{\l} - \gdefchar^^b4{\'{}} - \gdefchar^^b5{\v l} - \gdefchar^^b6{\'s} - \gdefchar^^b7{\v{}} - \gdefchar^^b8{\cedilla\ } - \gdefchar^^b9{\v s} - \gdefchar^^ba{\cedilla s} - \gdefchar^^bb{\v t} - \gdefchar^^bc{\'z} - \gdefchar^^bd{\H{}} - \gdefchar^^be{\v z} - \gdefchar^^bf{\dotaccent z} - % - \gdefchar^^c0{\'R} - \gdefchar^^c1{\'A} - \gdefchar^^c2{\^A} - \gdefchar^^c3{\u A} - \gdefchar^^c4{\"A} - \gdefchar^^c5{\'L} - \gdefchar^^c6{\'C} - \gdefchar^^c7{\cedilla C} - \gdefchar^^c8{\v C} - \gdefchar^^c9{\'E} - \gdefchar^^ca{\ogonek{E}} - \gdefchar^^cb{\"E} - \gdefchar^^cc{\v E} - \gdefchar^^cd{\'I} - \gdefchar^^ce{\^I} - \gdefchar^^cf{\v D} - % - \gdefchar^^d0{\DH} - \gdefchar^^d1{\'N} - \gdefchar^^d2{\v N} - \gdefchar^^d3{\'O} - \gdefchar^^d4{\^O} - \gdefchar^^d5{\H O} - \gdefchar^^d6{\"O} - \gdefchar^^d7{$\times$} - \gdefchar^^d8{\v R} - \gdefchar^^d9{\ringaccent U} - \gdefchar^^da{\'U} - \gdefchar^^db{\H U} - \gdefchar^^dc{\"U} - \gdefchar^^dd{\'Y} - \gdefchar^^de{\cedilla T} - \gdefchar^^df{\ss} - % - \gdefchar^^e0{\'r} - \gdefchar^^e1{\'a} - \gdefchar^^e2{\^a} - \gdefchar^^e3{\u a} - \gdefchar^^e4{\"a} - \gdefchar^^e5{\'l} - \gdefchar^^e6{\'c} - \gdefchar^^e7{\cedilla c} - \gdefchar^^e8{\v c} - \gdefchar^^e9{\'e} - \gdefchar^^ea{\ogonek{e}} - \gdefchar^^eb{\"e} - \gdefchar^^ec{\v e} - \gdefchar^^ed{\'{\dotless{i}}} - \gdefchar^^ee{\^{\dotless{i}}} - \gdefchar^^ef{\v d} - % - \gdefchar^^f0{\dh} - \gdefchar^^f1{\'n} - \gdefchar^^f2{\v n} - \gdefchar^^f3{\'o} - \gdefchar^^f4{\^o} - \gdefchar^^f5{\H o} - \gdefchar^^f6{\"o} - \gdefchar^^f7{$\div$} - \gdefchar^^f8{\v r} - \gdefchar^^f9{\ringaccent u} - \gdefchar^^fa{\'u} - \gdefchar^^fb{\H u} - \gdefchar^^fc{\"u} - \gdefchar^^fd{\'y} - \gdefchar^^fe{\cedilla t} - \gdefchar^^ff{\dotaccent{}} -} - -% UTF-8 character definitions. -% -% This code to support UTF-8 is based on LaTeX's utf8.def, with some -% changes for Texinfo conventions. It is included here under the GPL by -% permission from Frank Mittelbach and the LaTeX team. -% -\newcount\countUTFx -\newcount\countUTFy -\newcount\countUTFz - -\gdef\UTFviiiTwoOctets#1#2{\expandafter - \UTFviiiDefined\csname u8:#1\string #2\endcsname} -% -\gdef\UTFviiiThreeOctets#1#2#3{\expandafter - \UTFviiiDefined\csname u8:#1\string #2\string #3\endcsname} -% -\gdef\UTFviiiFourOctets#1#2#3#4{\expandafter - \UTFviiiDefined\csname u8:#1\string #2\string #3\string #4\endcsname} - -\gdef\UTFviiiDefined#1{% - \ifx #1\relax - \message{\linenumber Unicode char \string #1 not defined for Texinfo}% - \else - \expandafter #1% - \fi -} - -% Give non-ASCII bytes the active definitions for processing UTF-8 sequences -\begingroup - \catcode`\~13 - \catcode`\$12 - \catcode`\"12 - - % Loop from \countUTFx to \countUTFy, performing \UTFviiiTmp - % substituting ~ and $ with a character token of that value. - \def\UTFviiiLoop{% - \global\catcode\countUTFx\active - \uccode`\~\countUTFx - \uccode`\$\countUTFx - \uppercase\expandafter{\UTFviiiTmp}% - \advance\countUTFx by 1 - \ifnum\countUTFx < \countUTFy - \expandafter\UTFviiiLoop - \fi} - - % For bytes other than the first in a UTF-8 sequence. Not expected to - % be expanded except when writing to auxiliary files. - \countUTFx = "80 - \countUTFy = "C2 - \def\UTFviiiTmp{% - \gdef~{% - \ifpassthroughchars $\fi}}% - \UTFviiiLoop - - \countUTFx = "C2 - \countUTFy = "E0 - \def\UTFviiiTmp{% - \gdef~{% - \ifpassthroughchars $% - \else\expandafter\UTFviiiTwoOctets\expandafter$\fi}}% - \UTFviiiLoop - - \countUTFx = "E0 - \countUTFy = "F0 - \def\UTFviiiTmp{% - \gdef~{% - \ifpassthroughchars $% - \else\expandafter\UTFviiiThreeOctets\expandafter$\fi}}% - \UTFviiiLoop - - \countUTFx = "F0 - \countUTFy = "F4 - \def\UTFviiiTmp{% - \gdef~{% - \ifpassthroughchars $% - \else\expandafter\UTFviiiFourOctets\expandafter$\fi - }}% - \UTFviiiLoop -\endgroup - -\def\globallet{\global\let} % save some \expandafter's below - -% @U{xxxx} to produce U+xxxx, if we support it. -\def\U#1{% - \expandafter\ifx\csname uni:#1\endcsname \relax - \iftxinativeunicodecapable - % All Unicode characters can be used if native Unicode handling is - % active. However, if the font does not have the glyph, - % letters are missing. - \begingroup - \uccode`\.="#1\relax - \uppercase{.} - \endgroup - \else - \errhelp = \EMsimple - \errmessage{Unicode character U+#1 not supported, sorry}% - \fi - \else - \csname uni:#1\endcsname - \fi -} - -% These macros are used here to construct the name of a control -% sequence to be defined. -\def\UTFviiiTwoOctetsName#1#2{% - \csname u8:#1\string #2\endcsname}% -\def\UTFviiiThreeOctetsName#1#2#3{% - \csname u8:#1\string #2\string #3\endcsname}% -\def\UTFviiiFourOctetsName#1#2#3#4{% - \csname u8:#1\string #2\string #3\string #4\endcsname}% - -% For UTF-8 byte sequences (TeX, e-TeX and pdfTeX), -% provide a definition macro to replace a Unicode character; -% this gets used by the @U command -% -\begingroup - \catcode`\"=12 - \catcode`\<=12 - \catcode`\.=12 - \catcode`\,=12 - \catcode`\;=12 - \catcode`\!=12 - \catcode`\~=13 - \gdef\DeclareUnicodeCharacterUTFviii#1#2{% - \countUTFz = "#1\relax - \begingroup - \parseXMLCharref - - % Give \u8:... its definition. The sequence of seven \expandafter's - % expands after the \gdef three times, e.g. - % - % 1. \UTFviiTwoOctetsName B1 B2 - % 2. \csname u8:B1 \string B2 \endcsname - % 3. \u8: B1 B2 (a single control sequence token) - % - \expandafter\expandafter - \expandafter\expandafter - \expandafter\expandafter - \expandafter\gdef \UTFviiiTmp{#2}% - % - \expandafter\ifx\csname uni:#1\endcsname \relax \else - \message{Internal error, already defined: #1}% - \fi - % - % define an additional control sequence for this code point. - \expandafter\globallet\csname uni:#1\endcsname \UTFviiiTmp - \endgroup} - % - % Given the value in \countUTFz as a Unicode code point, set \UTFviiiTmp - % to the corresponding UTF-8 sequence. - \gdef\parseXMLCharref{% - \ifnum\countUTFz < "A0\relax - \errhelp = \EMsimple - \errmessage{Cannot define Unicode char value < 00A0}% - \else\ifnum\countUTFz < "800\relax - \parseUTFviiiA,% - \parseUTFviiiB C\UTFviiiTwoOctetsName.,% - \else\ifnum\countUTFz < "10000\relax - \parseUTFviiiA;% - \parseUTFviiiA,% - \parseUTFviiiB E\UTFviiiThreeOctetsName.{,;}% - \else - \parseUTFviiiA;% - \parseUTFviiiA,% - \parseUTFviiiA!% - \parseUTFviiiB F\UTFviiiFourOctetsName.{!,;}% - \fi\fi\fi - } - - % Extract a byte from the end of the UTF-8 representation of \countUTFx. - % It must be a non-initial byte in the sequence. - % Change \uccode of #1 for it to be used in \parseUTFviiiB as one - % of the bytes. - \gdef\parseUTFviiiA#1{% - \countUTFx = \countUTFz - \divide\countUTFz by 64 - \countUTFy = \countUTFz % Save to be the future value of \countUTFz. - \multiply\countUTFz by 64 - - % \countUTFz is now \countUTFx with the last 5 bits cleared. Subtract - % in order to get the last five bits. - \advance\countUTFx by -\countUTFz - - % Convert this to the byte in the UTF-8 sequence. - \advance\countUTFx by 128 - \uccode `#1\countUTFx - \countUTFz = \countUTFy} - - % Used to put a UTF-8 byte sequence into \UTFviiiTmp - % #1 is the increment for \countUTFz to yield a the first byte of the UTF-8 - % sequence. - % #2 is one of the \UTFviii*OctetsName macros. - % #3 is always a full stop (.) - % #4 is a template for the other bytes in the sequence. The values for these - % bytes is substituted in here with \uppercase using the \uccode's. - \gdef\parseUTFviiiB#1#2#3#4{% - \advance\countUTFz by "#10\relax - \uccode `#3\countUTFz - \uppercase{\gdef\UTFviiiTmp{#2#3#4}}} -\endgroup - -% For native Unicode handling (XeTeX and LuaTeX), -% provide a definition macro that sets a catcode to `other' non-globally -% -\def\DeclareUnicodeCharacterNativeOther#1#2{% - \catcode"#1=\other -} - -% https://en.wikipedia.org/wiki/Plane_(Unicode)#Basic_M -% U+0000..U+007F = https://en.wikipedia.org/wiki/Basic_Latin_(Unicode_block) -% U+0080..U+00FF = https://en.wikipedia.org/wiki/Latin-1_Supplement_(Unicode_block) -% U+0100..U+017F = https://en.wikipedia.org/wiki/Latin_Extended-A -% U+0180..U+024F = https://en.wikipedia.org/wiki/Latin_Extended-B -% -% Many of our renditions are less than wonderful, and all the missing -% characters are available somewhere. Loading the necessary fonts -% awaits user request. We can't truly support Unicode without -% reimplementing everything that's been done in LaTeX for many years, -% plus probably using luatex or xetex, and who knows what else. -% We won't be doing that here in this simple file. But we can try to at -% least make most of the characters not bomb out. -% -\def\unicodechardefs{% - \DeclareUnicodeCharacter{00A0}{\tie}% - \DeclareUnicodeCharacter{00A1}{\exclamdown}% - \DeclareUnicodeCharacter{00A2}{{\tcfont \char162}}% 0242=cent - \DeclareUnicodeCharacter{00A3}{\pounds{}}% - \DeclareUnicodeCharacter{00A4}{{\tcfont \char164}}% 0244=currency - \DeclareUnicodeCharacter{00A5}{{\tcfont \char165}}% 0245=yen - \DeclareUnicodeCharacter{00A6}{{\tcfont \char166}}% 0246=brokenbar - \DeclareUnicodeCharacter{00A7}{\S}% - \DeclareUnicodeCharacter{00A8}{\"{ }}% - \DeclareUnicodeCharacter{00A9}{\copyright{}}% - \DeclareUnicodeCharacter{00AA}{\ordf}% - \DeclareUnicodeCharacter{00AB}{\guillemetleft{}}% - \DeclareUnicodeCharacter{00AC}{\ensuremath\lnot}% - \DeclareUnicodeCharacter{00AD}{\-}% - \DeclareUnicodeCharacter{00AE}{\registeredsymbol{}}% - \DeclareUnicodeCharacter{00AF}{\={ }}% - % - \DeclareUnicodeCharacter{00B0}{\ringaccent{ }}% - \DeclareUnicodeCharacter{00B1}{\ensuremath\pm}% - \DeclareUnicodeCharacter{00B2}{$^2$}% - \DeclareUnicodeCharacter{00B3}{$^3$}% - \DeclareUnicodeCharacter{00B4}{\'{ }}% - \DeclareUnicodeCharacter{00B5}{$\mu$}% - \DeclareUnicodeCharacter{00B6}{\P}% - \DeclareUnicodeCharacter{00B7}{\ensuremath\cdot}% - \DeclareUnicodeCharacter{00B8}{\cedilla{ }}% - \DeclareUnicodeCharacter{00B9}{$^1$}% - \DeclareUnicodeCharacter{00BA}{\ordm}% - \DeclareUnicodeCharacter{00BB}{\guillemetright{}}% - \DeclareUnicodeCharacter{00BC}{$1\over4$}% - \DeclareUnicodeCharacter{00BD}{$1\over2$}% - \DeclareUnicodeCharacter{00BE}{$3\over4$}% - \DeclareUnicodeCharacter{00BF}{\questiondown}% - % - \DeclareUnicodeCharacter{00C0}{\`A}% - \DeclareUnicodeCharacter{00C1}{\'A}% - \DeclareUnicodeCharacter{00C2}{\^A}% - \DeclareUnicodeCharacter{00C3}{\~A}% - \DeclareUnicodeCharacter{00C4}{\"A}% - \DeclareUnicodeCharacter{00C5}{\AA}% - \DeclareUnicodeCharacter{00C6}{\AE}% - \DeclareUnicodeCharacter{00C7}{\cedilla{C}}% - \DeclareUnicodeCharacter{00C8}{\`E}% - \DeclareUnicodeCharacter{00C9}{\'E}% - \DeclareUnicodeCharacter{00CA}{\^E}% - \DeclareUnicodeCharacter{00CB}{\"E}% - \DeclareUnicodeCharacter{00CC}{\`I}% - \DeclareUnicodeCharacter{00CD}{\'I}% - \DeclareUnicodeCharacter{00CE}{\^I}% - \DeclareUnicodeCharacter{00CF}{\"I}% - % - \DeclareUnicodeCharacter{00D0}{\DH}% - \DeclareUnicodeCharacter{00D1}{\~N}% - \DeclareUnicodeCharacter{00D2}{\`O}% - \DeclareUnicodeCharacter{00D3}{\'O}% - \DeclareUnicodeCharacter{00D4}{\^O}% - \DeclareUnicodeCharacter{00D5}{\~O}% - \DeclareUnicodeCharacter{00D6}{\"O}% - \DeclareUnicodeCharacter{00D7}{\ensuremath\times}% - \DeclareUnicodeCharacter{00D8}{\O}% - \DeclareUnicodeCharacter{00D9}{\`U}% - \DeclareUnicodeCharacter{00DA}{\'U}% - \DeclareUnicodeCharacter{00DB}{\^U}% - \DeclareUnicodeCharacter{00DC}{\"U}% - \DeclareUnicodeCharacter{00DD}{\'Y}% - \DeclareUnicodeCharacter{00DE}{\TH}% - \DeclareUnicodeCharacter{00DF}{\ss}% - % - \DeclareUnicodeCharacter{00E0}{\`a}% - \DeclareUnicodeCharacter{00E1}{\'a}% - \DeclareUnicodeCharacter{00E2}{\^a}% - \DeclareUnicodeCharacter{00E3}{\~a}% - \DeclareUnicodeCharacter{00E4}{\"a}% - \DeclareUnicodeCharacter{00E5}{\aa}% - \DeclareUnicodeCharacter{00E6}{\ae}% - \DeclareUnicodeCharacter{00E7}{\cedilla{c}}% - \DeclareUnicodeCharacter{00E8}{\`e}% - \DeclareUnicodeCharacter{00E9}{\'e}% - \DeclareUnicodeCharacter{00EA}{\^e}% - \DeclareUnicodeCharacter{00EB}{\"e}% - \DeclareUnicodeCharacter{00EC}{\`{\dotless{i}}}% - \DeclareUnicodeCharacter{00ED}{\'{\dotless{i}}}% - \DeclareUnicodeCharacter{00EE}{\^{\dotless{i}}}% - \DeclareUnicodeCharacter{00EF}{\"{\dotless{i}}}% - % - \DeclareUnicodeCharacter{00F0}{\dh}% - \DeclareUnicodeCharacter{00F1}{\~n}% - \DeclareUnicodeCharacter{00F2}{\`o}% - \DeclareUnicodeCharacter{00F3}{\'o}% - \DeclareUnicodeCharacter{00F4}{\^o}% - \DeclareUnicodeCharacter{00F5}{\~o}% - \DeclareUnicodeCharacter{00F6}{\"o}% - \DeclareUnicodeCharacter{00F7}{\ensuremath\div}% - \DeclareUnicodeCharacter{00F8}{\o}% - \DeclareUnicodeCharacter{00F9}{\`u}% - \DeclareUnicodeCharacter{00FA}{\'u}% - \DeclareUnicodeCharacter{00FB}{\^u}% - \DeclareUnicodeCharacter{00FC}{\"u}% - \DeclareUnicodeCharacter{00FD}{\'y}% - \DeclareUnicodeCharacter{00FE}{\th}% - \DeclareUnicodeCharacter{00FF}{\"y}% - % - \DeclareUnicodeCharacter{0100}{\=A}% - \DeclareUnicodeCharacter{0101}{\=a}% - \DeclareUnicodeCharacter{0102}{\u{A}}% - \DeclareUnicodeCharacter{0103}{\u{a}}% - \DeclareUnicodeCharacter{0104}{\ogonek{A}}% - \DeclareUnicodeCharacter{0105}{\ogonek{a}}% - \DeclareUnicodeCharacter{0106}{\'C}% - \DeclareUnicodeCharacter{0107}{\'c}% - \DeclareUnicodeCharacter{0108}{\^C}% - \DeclareUnicodeCharacter{0109}{\^c}% - \DeclareUnicodeCharacter{010A}{\dotaccent{C}}% - \DeclareUnicodeCharacter{010B}{\dotaccent{c}}% - \DeclareUnicodeCharacter{010C}{\v{C}}% - \DeclareUnicodeCharacter{010D}{\v{c}}% - \DeclareUnicodeCharacter{010E}{\v{D}}% - \DeclareUnicodeCharacter{010F}{d'}% - % - \DeclareUnicodeCharacter{0110}{\DH}% - \DeclareUnicodeCharacter{0111}{\dh}% - \DeclareUnicodeCharacter{0112}{\=E}% - \DeclareUnicodeCharacter{0113}{\=e}% - \DeclareUnicodeCharacter{0114}{\u{E}}% - \DeclareUnicodeCharacter{0115}{\u{e}}% - \DeclareUnicodeCharacter{0116}{\dotaccent{E}}% - \DeclareUnicodeCharacter{0117}{\dotaccent{e}}% - \DeclareUnicodeCharacter{0118}{\ogonek{E}}% - \DeclareUnicodeCharacter{0119}{\ogonek{e}}% - \DeclareUnicodeCharacter{011A}{\v{E}}% - \DeclareUnicodeCharacter{011B}{\v{e}}% - \DeclareUnicodeCharacter{011C}{\^G}% - \DeclareUnicodeCharacter{011D}{\^g}% - \DeclareUnicodeCharacter{011E}{\u{G}}% - \DeclareUnicodeCharacter{011F}{\u{g}}% - % - \DeclareUnicodeCharacter{0120}{\dotaccent{G}}% - \DeclareUnicodeCharacter{0121}{\dotaccent{g}}% - \DeclareUnicodeCharacter{0122}{\cedilla{G}}% - \DeclareUnicodeCharacter{0123}{\cedilla{g}}% - \DeclareUnicodeCharacter{0124}{\^H}% - \DeclareUnicodeCharacter{0125}{\^h}% - \DeclareUnicodeCharacter{0126}{\missingcharmsg{H WITH STROKE}}% - \DeclareUnicodeCharacter{0127}{\missingcharmsg{h WITH STROKE}}% - \DeclareUnicodeCharacter{0128}{\~I}% - \DeclareUnicodeCharacter{0129}{\~{\dotless{i}}}% - \DeclareUnicodeCharacter{012A}{\=I}% - \DeclareUnicodeCharacter{012B}{\={\dotless{i}}}% - \DeclareUnicodeCharacter{012C}{\u{I}}% - \DeclareUnicodeCharacter{012D}{\u{\dotless{i}}}% - \DeclareUnicodeCharacter{012E}{\ogonek{I}}% - \DeclareUnicodeCharacter{012F}{\ogonek{i}}% - % - \DeclareUnicodeCharacter{0130}{\dotaccent{I}}% - \DeclareUnicodeCharacter{0131}{\dotless{i}}% - \DeclareUnicodeCharacter{0132}{IJ}% - \DeclareUnicodeCharacter{0133}{ij}% - \DeclareUnicodeCharacter{0134}{\^J}% - \DeclareUnicodeCharacter{0135}{\^{\dotless{j}}}% - \DeclareUnicodeCharacter{0136}{\cedilla{K}}% - \DeclareUnicodeCharacter{0137}{\cedilla{k}}% - \DeclareUnicodeCharacter{0138}{\ensuremath\kappa}% - \DeclareUnicodeCharacter{0139}{\'L}% - \DeclareUnicodeCharacter{013A}{\'l}% - \DeclareUnicodeCharacter{013B}{\cedilla{L}}% - \DeclareUnicodeCharacter{013C}{\cedilla{l}}% - \DeclareUnicodeCharacter{013D}{L'}% should kern - \DeclareUnicodeCharacter{013E}{l'}% should kern - \DeclareUnicodeCharacter{013F}{L\U{00B7}}% - % - \DeclareUnicodeCharacter{0140}{l\U{00B7}}% - \DeclareUnicodeCharacter{0141}{\L}% - \DeclareUnicodeCharacter{0142}{\l}% - \DeclareUnicodeCharacter{0143}{\'N}% - \DeclareUnicodeCharacter{0144}{\'n}% - \DeclareUnicodeCharacter{0145}{\cedilla{N}}% - \DeclareUnicodeCharacter{0146}{\cedilla{n}}% - \DeclareUnicodeCharacter{0147}{\v{N}}% - \DeclareUnicodeCharacter{0148}{\v{n}}% - \DeclareUnicodeCharacter{0149}{'n}% - \DeclareUnicodeCharacter{014A}{\missingcharmsg{ENG}}% - \DeclareUnicodeCharacter{014B}{\missingcharmsg{eng}}% - \DeclareUnicodeCharacter{014C}{\=O}% - \DeclareUnicodeCharacter{014D}{\=o}% - \DeclareUnicodeCharacter{014E}{\u{O}}% - \DeclareUnicodeCharacter{014F}{\u{o}}% - % - \DeclareUnicodeCharacter{0150}{\H{O}}% - \DeclareUnicodeCharacter{0151}{\H{o}}% - \DeclareUnicodeCharacter{0152}{\OE}% - \DeclareUnicodeCharacter{0153}{\oe}% - \DeclareUnicodeCharacter{0154}{\'R}% - \DeclareUnicodeCharacter{0155}{\'r}% - \DeclareUnicodeCharacter{0156}{\cedilla{R}}% - \DeclareUnicodeCharacter{0157}{\cedilla{r}}% - \DeclareUnicodeCharacter{0158}{\v{R}}% - \DeclareUnicodeCharacter{0159}{\v{r}}% - \DeclareUnicodeCharacter{015A}{\'S}% - \DeclareUnicodeCharacter{015B}{\'s}% - \DeclareUnicodeCharacter{015C}{\^S}% - \DeclareUnicodeCharacter{015D}{\^s}% - \DeclareUnicodeCharacter{015E}{\cedilla{S}}% - \DeclareUnicodeCharacter{015F}{\cedilla{s}}% - % - \DeclareUnicodeCharacter{0160}{\v{S}}% - \DeclareUnicodeCharacter{0161}{\v{s}}% - \DeclareUnicodeCharacter{0162}{\cedilla{T}}% - \DeclareUnicodeCharacter{0163}{\cedilla{t}}% - \DeclareUnicodeCharacter{0164}{\v{T}}% - \DeclareUnicodeCharacter{0165}{\v{t}}% - \DeclareUnicodeCharacter{0166}{\missingcharmsg{H WITH STROKE}}% - \DeclareUnicodeCharacter{0167}{\missingcharmsg{h WITH STROKE}}% - \DeclareUnicodeCharacter{0168}{\~U}% - \DeclareUnicodeCharacter{0169}{\~u}% - \DeclareUnicodeCharacter{016A}{\=U}% - \DeclareUnicodeCharacter{016B}{\=u}% - \DeclareUnicodeCharacter{016C}{\u{U}}% - \DeclareUnicodeCharacter{016D}{\u{u}}% - \DeclareUnicodeCharacter{016E}{\ringaccent{U}}% - \DeclareUnicodeCharacter{016F}{\ringaccent{u}}% - % - \DeclareUnicodeCharacter{0170}{\H{U}}% - \DeclareUnicodeCharacter{0171}{\H{u}}% - \DeclareUnicodeCharacter{0172}{\ogonek{U}}% - \DeclareUnicodeCharacter{0173}{\ogonek{u}}% - \DeclareUnicodeCharacter{0174}{\^W}% - \DeclareUnicodeCharacter{0175}{\^w}% - \DeclareUnicodeCharacter{0176}{\^Y}% - \DeclareUnicodeCharacter{0177}{\^y}% - \DeclareUnicodeCharacter{0178}{\"Y}% - \DeclareUnicodeCharacter{0179}{\'Z}% - \DeclareUnicodeCharacter{017A}{\'z}% - \DeclareUnicodeCharacter{017B}{\dotaccent{Z}}% - \DeclareUnicodeCharacter{017C}{\dotaccent{z}}% - \DeclareUnicodeCharacter{017D}{\v{Z}}% - \DeclareUnicodeCharacter{017E}{\v{z}}% - \DeclareUnicodeCharacter{017F}{\missingcharmsg{LONG S}}% - % - \DeclareUnicodeCharacter{01C4}{D\v{Z}}% - \DeclareUnicodeCharacter{01C5}{D\v{z}}% - \DeclareUnicodeCharacter{01C6}{d\v{z}}% - \DeclareUnicodeCharacter{01C7}{LJ}% - \DeclareUnicodeCharacter{01C8}{Lj}% - \DeclareUnicodeCharacter{01C9}{lj}% - \DeclareUnicodeCharacter{01CA}{NJ}% - \DeclareUnicodeCharacter{01CB}{Nj}% - \DeclareUnicodeCharacter{01CC}{nj}% - \DeclareUnicodeCharacter{01CD}{\v{A}}% - \DeclareUnicodeCharacter{01CE}{\v{a}}% - \DeclareUnicodeCharacter{01CF}{\v{I}}% - % - \DeclareUnicodeCharacter{01D0}{\v{\dotless{i}}}% - \DeclareUnicodeCharacter{01D1}{\v{O}}% - \DeclareUnicodeCharacter{01D2}{\v{o}}% - \DeclareUnicodeCharacter{01D3}{\v{U}}% - \DeclareUnicodeCharacter{01D4}{\v{u}}% - % - \DeclareUnicodeCharacter{01E2}{\={\AE}}% - \DeclareUnicodeCharacter{01E3}{\={\ae}}% - \DeclareUnicodeCharacter{01E6}{\v{G}}% - \DeclareUnicodeCharacter{01E7}{\v{g}}% - \DeclareUnicodeCharacter{01E8}{\v{K}}% - \DeclareUnicodeCharacter{01E9}{\v{k}}% - % - \DeclareUnicodeCharacter{01F0}{\v{\dotless{j}}}% - \DeclareUnicodeCharacter{01F1}{DZ}% - \DeclareUnicodeCharacter{01F2}{Dz}% - \DeclareUnicodeCharacter{01F3}{dz}% - \DeclareUnicodeCharacter{01F4}{\'G}% - \DeclareUnicodeCharacter{01F5}{\'g}% - \DeclareUnicodeCharacter{01F8}{\`N}% - \DeclareUnicodeCharacter{01F9}{\`n}% - \DeclareUnicodeCharacter{01FC}{\'{\AE}}% - \DeclareUnicodeCharacter{01FD}{\'{\ae}}% - \DeclareUnicodeCharacter{01FE}{\'{\O}}% - \DeclareUnicodeCharacter{01FF}{\'{\o}}% - % - \DeclareUnicodeCharacter{021E}{\v{H}}% - \DeclareUnicodeCharacter{021F}{\v{h}}% - % - \DeclareUnicodeCharacter{0226}{\dotaccent{A}}% - \DeclareUnicodeCharacter{0227}{\dotaccent{a}}% - \DeclareUnicodeCharacter{0228}{\cedilla{E}}% - \DeclareUnicodeCharacter{0229}{\cedilla{e}}% - \DeclareUnicodeCharacter{022E}{\dotaccent{O}}% - \DeclareUnicodeCharacter{022F}{\dotaccent{o}}% - % - \DeclareUnicodeCharacter{0232}{\=Y}% - \DeclareUnicodeCharacter{0233}{\=y}% - \DeclareUnicodeCharacter{0237}{\dotless{j}}% - % - \DeclareUnicodeCharacter{02DB}{\ogonek{ }}% - % - % Greek letters upper case - \DeclareUnicodeCharacter{0391}{{\it A}}% - \DeclareUnicodeCharacter{0392}{{\it B}}% - \DeclareUnicodeCharacter{0393}{\ensuremath{\mit\Gamma}}% - \DeclareUnicodeCharacter{0394}{\ensuremath{\mit\Delta}}% - \DeclareUnicodeCharacter{0395}{{\it E}}% - \DeclareUnicodeCharacter{0396}{{\it Z}}% - \DeclareUnicodeCharacter{0397}{{\it H}}% - \DeclareUnicodeCharacter{0398}{\ensuremath{\mit\Theta}}% - \DeclareUnicodeCharacter{0399}{{\it I}}% - \DeclareUnicodeCharacter{039A}{{\it K}}% - \DeclareUnicodeCharacter{039B}{\ensuremath{\mit\Lambda}}% - \DeclareUnicodeCharacter{039C}{{\it M}}% - \DeclareUnicodeCharacter{039D}{{\it N}}% - \DeclareUnicodeCharacter{039E}{\ensuremath{\mit\Xi}}% - \DeclareUnicodeCharacter{039F}{{\it O}}% - \DeclareUnicodeCharacter{03A0}{\ensuremath{\mit\Pi}}% - \DeclareUnicodeCharacter{03A1}{{\it P}}% - %\DeclareUnicodeCharacter{03A2}{} % none - corresponds to final sigma - \DeclareUnicodeCharacter{03A3}{\ensuremath{\mit\Sigma}}% - \DeclareUnicodeCharacter{03A4}{{\it T}}% - \DeclareUnicodeCharacter{03A5}{\ensuremath{\mit\Upsilon}}% - \DeclareUnicodeCharacter{03A6}{\ensuremath{\mit\Phi}}% - \DeclareUnicodeCharacter{03A7}{{\it X}}% - \DeclareUnicodeCharacter{03A8}{\ensuremath{\mit\Psi}}% - \DeclareUnicodeCharacter{03A9}{\ensuremath{\mit\Omega}}% - % - % Vowels with accents - \DeclareUnicodeCharacter{0390}{\ensuremath{\ddot{\acute\iota}}}% - \DeclareUnicodeCharacter{03AC}{\ensuremath{\acute\alpha}}% - \DeclareUnicodeCharacter{03AD}{\ensuremath{\acute\epsilon}}% - \DeclareUnicodeCharacter{03AE}{\ensuremath{\acute\eta}}% - \DeclareUnicodeCharacter{03AF}{\ensuremath{\acute\iota}}% - \DeclareUnicodeCharacter{03B0}{\ensuremath{\acute{\ddot\upsilon}}}% - % - % Standalone accent - \DeclareUnicodeCharacter{0384}{\ensuremath{\acute{\ }}}% - % - % Greek letters lower case - \DeclareUnicodeCharacter{03B1}{\ensuremath\alpha}% - \DeclareUnicodeCharacter{03B2}{\ensuremath\beta}% - \DeclareUnicodeCharacter{03B3}{\ensuremath\gamma}% - \DeclareUnicodeCharacter{03B4}{\ensuremath\delta}% - \DeclareUnicodeCharacter{03B5}{\ensuremath\epsilon}% - \DeclareUnicodeCharacter{03B6}{\ensuremath\zeta}% - \DeclareUnicodeCharacter{03B7}{\ensuremath\eta}% - \DeclareUnicodeCharacter{03B8}{\ensuremath\theta}% - \DeclareUnicodeCharacter{03B9}{\ensuremath\iota}% - \DeclareUnicodeCharacter{03BA}{\ensuremath\kappa}% - \DeclareUnicodeCharacter{03BB}{\ensuremath\lambda}% - \DeclareUnicodeCharacter{03BC}{\ensuremath\mu}% - \DeclareUnicodeCharacter{03BD}{\ensuremath\nu}% - \DeclareUnicodeCharacter{03BE}{\ensuremath\xi}% - \DeclareUnicodeCharacter{03BF}{{\it o}}% omicron - \DeclareUnicodeCharacter{03C0}{\ensuremath\pi}% - \DeclareUnicodeCharacter{03C1}{\ensuremath\rho}% - \DeclareUnicodeCharacter{03C2}{\ensuremath\varsigma}% - \DeclareUnicodeCharacter{03C3}{\ensuremath\sigma}% - \DeclareUnicodeCharacter{03C4}{\ensuremath\tau}% - \DeclareUnicodeCharacter{03C5}{\ensuremath\upsilon}% - \DeclareUnicodeCharacter{03C6}{\ensuremath\phi}% - \DeclareUnicodeCharacter{03C7}{\ensuremath\chi}% - \DeclareUnicodeCharacter{03C8}{\ensuremath\psi}% - \DeclareUnicodeCharacter{03C9}{\ensuremath\omega}% - % - % More Greek vowels with accents - \DeclareUnicodeCharacter{03CA}{\ensuremath{\ddot\iota}}% - \DeclareUnicodeCharacter{03CB}{\ensuremath{\ddot\upsilon}}% - \DeclareUnicodeCharacter{03CC}{\ensuremath{\acute o}}% - \DeclareUnicodeCharacter{03CD}{\ensuremath{\acute\upsilon}}% - \DeclareUnicodeCharacter{03CE}{\ensuremath{\acute\omega}}% - % - % Variant Greek letters - \DeclareUnicodeCharacter{03D1}{\ensuremath\vartheta}% - \DeclareUnicodeCharacter{03D6}{\ensuremath\varpi}% - \DeclareUnicodeCharacter{03F1}{\ensuremath\varrho}% - % - \DeclareUnicodeCharacter{1E02}{\dotaccent{B}}% - \DeclareUnicodeCharacter{1E03}{\dotaccent{b}}% - \DeclareUnicodeCharacter{1E04}{\udotaccent{B}}% - \DeclareUnicodeCharacter{1E05}{\udotaccent{b}}% - \DeclareUnicodeCharacter{1E06}{\ubaraccent{B}}% - \DeclareUnicodeCharacter{1E07}{\ubaraccent{b}}% - \DeclareUnicodeCharacter{1E0A}{\dotaccent{D}}% - \DeclareUnicodeCharacter{1E0B}{\dotaccent{d}}% - \DeclareUnicodeCharacter{1E0C}{\udotaccent{D}}% - \DeclareUnicodeCharacter{1E0D}{\udotaccent{d}}% - \DeclareUnicodeCharacter{1E0E}{\ubaraccent{D}}% - \DeclareUnicodeCharacter{1E0F}{\ubaraccent{d}}% - % - \DeclareUnicodeCharacter{1E1E}{\dotaccent{F}}% - \DeclareUnicodeCharacter{1E1F}{\dotaccent{f}}% - % - \DeclareUnicodeCharacter{1E20}{\=G}% - \DeclareUnicodeCharacter{1E21}{\=g}% - \DeclareUnicodeCharacter{1E22}{\dotaccent{H}}% - \DeclareUnicodeCharacter{1E23}{\dotaccent{h}}% - \DeclareUnicodeCharacter{1E24}{\udotaccent{H}}% - \DeclareUnicodeCharacter{1E25}{\udotaccent{h}}% - \DeclareUnicodeCharacter{1E26}{\"H}% - \DeclareUnicodeCharacter{1E27}{\"h}% - % - \DeclareUnicodeCharacter{1E30}{\'K}% - \DeclareUnicodeCharacter{1E31}{\'k}% - \DeclareUnicodeCharacter{1E32}{\udotaccent{K}}% - \DeclareUnicodeCharacter{1E33}{\udotaccent{k}}% - \DeclareUnicodeCharacter{1E34}{\ubaraccent{K}}% - \DeclareUnicodeCharacter{1E35}{\ubaraccent{k}}% - \DeclareUnicodeCharacter{1E36}{\udotaccent{L}}% - \DeclareUnicodeCharacter{1E37}{\udotaccent{l}}% - \DeclareUnicodeCharacter{1E3A}{\ubaraccent{L}}% - \DeclareUnicodeCharacter{1E3B}{\ubaraccent{l}}% - \DeclareUnicodeCharacter{1E3E}{\'M}% - \DeclareUnicodeCharacter{1E3F}{\'m}% - % - \DeclareUnicodeCharacter{1E40}{\dotaccent{M}}% - \DeclareUnicodeCharacter{1E41}{\dotaccent{m}}% - \DeclareUnicodeCharacter{1E42}{\udotaccent{M}}% - \DeclareUnicodeCharacter{1E43}{\udotaccent{m}}% - \DeclareUnicodeCharacter{1E44}{\dotaccent{N}}% - \DeclareUnicodeCharacter{1E45}{\dotaccent{n}}% - \DeclareUnicodeCharacter{1E46}{\udotaccent{N}}% - \DeclareUnicodeCharacter{1E47}{\udotaccent{n}}% - \DeclareUnicodeCharacter{1E48}{\ubaraccent{N}}% - \DeclareUnicodeCharacter{1E49}{\ubaraccent{n}}% - % - \DeclareUnicodeCharacter{1E54}{\'P}% - \DeclareUnicodeCharacter{1E55}{\'p}% - \DeclareUnicodeCharacter{1E56}{\dotaccent{P}}% - \DeclareUnicodeCharacter{1E57}{\dotaccent{p}}% - \DeclareUnicodeCharacter{1E58}{\dotaccent{R}}% - \DeclareUnicodeCharacter{1E59}{\dotaccent{r}}% - \DeclareUnicodeCharacter{1E5A}{\udotaccent{R}}% - \DeclareUnicodeCharacter{1E5B}{\udotaccent{r}}% - \DeclareUnicodeCharacter{1E5E}{\ubaraccent{R}}% - \DeclareUnicodeCharacter{1E5F}{\ubaraccent{r}}% - % - \DeclareUnicodeCharacter{1E60}{\dotaccent{S}}% - \DeclareUnicodeCharacter{1E61}{\dotaccent{s}}% - \DeclareUnicodeCharacter{1E62}{\udotaccent{S}}% - \DeclareUnicodeCharacter{1E63}{\udotaccent{s}}% - \DeclareUnicodeCharacter{1E6A}{\dotaccent{T}}% - \DeclareUnicodeCharacter{1E6B}{\dotaccent{t}}% - \DeclareUnicodeCharacter{1E6C}{\udotaccent{T}}% - \DeclareUnicodeCharacter{1E6D}{\udotaccent{t}}% - \DeclareUnicodeCharacter{1E6E}{\ubaraccent{T}}% - \DeclareUnicodeCharacter{1E6F}{\ubaraccent{t}}% - % - \DeclareUnicodeCharacter{1E7C}{\~V}% - \DeclareUnicodeCharacter{1E7D}{\~v}% - \DeclareUnicodeCharacter{1E7E}{\udotaccent{V}}% - \DeclareUnicodeCharacter{1E7F}{\udotaccent{v}}% - % - \DeclareUnicodeCharacter{1E80}{\`W}% - \DeclareUnicodeCharacter{1E81}{\`w}% - \DeclareUnicodeCharacter{1E82}{\'W}% - \DeclareUnicodeCharacter{1E83}{\'w}% - \DeclareUnicodeCharacter{1E84}{\"W}% - \DeclareUnicodeCharacter{1E85}{\"w}% - \DeclareUnicodeCharacter{1E86}{\dotaccent{W}}% - \DeclareUnicodeCharacter{1E87}{\dotaccent{w}}% - \DeclareUnicodeCharacter{1E88}{\udotaccent{W}}% - \DeclareUnicodeCharacter{1E89}{\udotaccent{w}}% - \DeclareUnicodeCharacter{1E8A}{\dotaccent{X}}% - \DeclareUnicodeCharacter{1E8B}{\dotaccent{x}}% - \DeclareUnicodeCharacter{1E8C}{\"X}% - \DeclareUnicodeCharacter{1E8D}{\"x}% - \DeclareUnicodeCharacter{1E8E}{\dotaccent{Y}}% - \DeclareUnicodeCharacter{1E8F}{\dotaccent{y}}% - % - \DeclareUnicodeCharacter{1E90}{\^Z}% - \DeclareUnicodeCharacter{1E91}{\^z}% - \DeclareUnicodeCharacter{1E92}{\udotaccent{Z}}% - \DeclareUnicodeCharacter{1E93}{\udotaccent{z}}% - \DeclareUnicodeCharacter{1E94}{\ubaraccent{Z}}% - \DeclareUnicodeCharacter{1E95}{\ubaraccent{z}}% - \DeclareUnicodeCharacter{1E96}{\ubaraccent{h}}% - \DeclareUnicodeCharacter{1E97}{\"t}% - \DeclareUnicodeCharacter{1E98}{\ringaccent{w}}% - \DeclareUnicodeCharacter{1E99}{\ringaccent{y}}% - % - \DeclareUnicodeCharacter{1EA0}{\udotaccent{A}}% - \DeclareUnicodeCharacter{1EA1}{\udotaccent{a}}% - % - \DeclareUnicodeCharacter{1EB8}{\udotaccent{E}}% - \DeclareUnicodeCharacter{1EB9}{\udotaccent{e}}% - \DeclareUnicodeCharacter{1EBC}{\~E}% - \DeclareUnicodeCharacter{1EBD}{\~e}% - % - \DeclareUnicodeCharacter{1ECA}{\udotaccent{I}}% - \DeclareUnicodeCharacter{1ECB}{\udotaccent{i}}% - \DeclareUnicodeCharacter{1ECC}{\udotaccent{O}}% - \DeclareUnicodeCharacter{1ECD}{\udotaccent{o}}% - % - \DeclareUnicodeCharacter{1EE4}{\udotaccent{U}}% - \DeclareUnicodeCharacter{1EE5}{\udotaccent{u}}% - % - \DeclareUnicodeCharacter{1EF2}{\`Y}% - \DeclareUnicodeCharacter{1EF3}{\`y}% - \DeclareUnicodeCharacter{1EF4}{\udotaccent{Y}}% - % - \DeclareUnicodeCharacter{1EF8}{\~Y}% - \DeclareUnicodeCharacter{1EF9}{\~y}% - % - % Punctuation - \DeclareUnicodeCharacter{2013}{--}% - \DeclareUnicodeCharacter{2014}{---}% - \DeclareUnicodeCharacter{2018}{\quoteleft{}}% - \DeclareUnicodeCharacter{2019}{\quoteright{}}% - \DeclareUnicodeCharacter{201A}{\quotesinglbase{}}% - \DeclareUnicodeCharacter{201C}{\quotedblleft{}}% - \DeclareUnicodeCharacter{201D}{\quotedblright{}}% - \DeclareUnicodeCharacter{201E}{\quotedblbase{}}% - \DeclareUnicodeCharacter{2020}{\ensuremath\dagger}% - \DeclareUnicodeCharacter{2021}{\ensuremath\ddagger}% - \DeclareUnicodeCharacter{2022}{\bullet{}}% - \DeclareUnicodeCharacter{202F}{\thinspace}% - \DeclareUnicodeCharacter{2026}{\dots{}}% - \DeclareUnicodeCharacter{2039}{\guilsinglleft{}}% - \DeclareUnicodeCharacter{203A}{\guilsinglright{}}% - % - \DeclareUnicodeCharacter{20AC}{\euro{}}% - % - \DeclareUnicodeCharacter{2192}{\expansion{}}% - \DeclareUnicodeCharacter{21D2}{\result{}}% - % - % Mathematical symbols - \DeclareUnicodeCharacter{2200}{\ensuremath\forall}% - \DeclareUnicodeCharacter{2203}{\ensuremath\exists}% - \DeclareUnicodeCharacter{2208}{\ensuremath\in}% - \DeclareUnicodeCharacter{2212}{\minus{}}% - \DeclareUnicodeCharacter{2217}{\ast}% - \DeclareUnicodeCharacter{221E}{\ensuremath\infty}% - \DeclareUnicodeCharacter{2225}{\ensuremath\parallel}% - \DeclareUnicodeCharacter{2227}{\ensuremath\wedge}% - \DeclareUnicodeCharacter{2229}{\ensuremath\cap}% - \DeclareUnicodeCharacter{2261}{\equiv{}}% - \DeclareUnicodeCharacter{2264}{\ensuremath\leq}% - \DeclareUnicodeCharacter{2265}{\ensuremath\geq}% - \DeclareUnicodeCharacter{2282}{\ensuremath\subset}% - \DeclareUnicodeCharacter{2287}{\ensuremath\supseteq}% - % - \DeclareUnicodeCharacter{2016}{\ensuremath\Vert}% - \DeclareUnicodeCharacter{2032}{\ensuremath\prime}% - \DeclareUnicodeCharacter{210F}{\ensuremath\hbar}% - \DeclareUnicodeCharacter{2111}{\ensuremath\Im}% - \DeclareUnicodeCharacter{2113}{\ensuremath\ell}% - \DeclareUnicodeCharacter{2118}{\ensuremath\wp}% - \DeclareUnicodeCharacter{211C}{\ensuremath\Re}% - \DeclareUnicodeCharacter{2135}{\ensuremath\aleph}% - \DeclareUnicodeCharacter{2190}{\ensuremath\leftarrow}% - \DeclareUnicodeCharacter{2191}{\ensuremath\uparrow}% - \DeclareUnicodeCharacter{2193}{\ensuremath\downarrow}% - \DeclareUnicodeCharacter{2194}{\ensuremath\leftrightarrow}% - \DeclareUnicodeCharacter{2195}{\ensuremath\updownarrow}% - \DeclareUnicodeCharacter{2196}{\ensuremath\nwarrow}% - \DeclareUnicodeCharacter{2197}{\ensuremath\nearrow}% - \DeclareUnicodeCharacter{2198}{\ensuremath\searrow}% - \DeclareUnicodeCharacter{2199}{\ensuremath\swarrow}% - \DeclareUnicodeCharacter{21A6}{\ensuremath\mapsto}% - \DeclareUnicodeCharacter{21A9}{\ensuremath\hookleftarrow}% - \DeclareUnicodeCharacter{21AA}{\ensuremath\hookrightarrow}% - \DeclareUnicodeCharacter{21BC}{\ensuremath\leftharpoonup}% - \DeclareUnicodeCharacter{21BD}{\ensuremath\leftharpoondown}% - \DeclareUnicodeCharacter{21C0}{\ensuremath\rightharpoonup}% - \DeclareUnicodeCharacter{21C1}{\ensuremath\rightharpoondown}% - \DeclareUnicodeCharacter{21CC}{\ensuremath\rightleftharpoons}% - \DeclareUnicodeCharacter{21D0}{\ensuremath\Leftarrow}% - \DeclareUnicodeCharacter{21D1}{\ensuremath\Uparrow}% - \DeclareUnicodeCharacter{21D3}{\ensuremath\Downarrow}% - \DeclareUnicodeCharacter{21D4}{\ensuremath\Leftrightarrow}% - \DeclareUnicodeCharacter{21D5}{\ensuremath\Updownarrow}% - \DeclareUnicodeCharacter{2202}{\ensuremath\partial}% - \DeclareUnicodeCharacter{2205}{\ensuremath\emptyset}% - \DeclareUnicodeCharacter{2207}{\ensuremath\nabla}% - \DeclareUnicodeCharacter{2209}{\ensuremath\notin}% - \DeclareUnicodeCharacter{220B}{\ensuremath\owns}% - \DeclareUnicodeCharacter{220F}{\ensuremath\prod}% - \DeclareUnicodeCharacter{2210}{\ensuremath\coprod}% - \DeclareUnicodeCharacter{2211}{\ensuremath\sum}% - \DeclareUnicodeCharacter{2213}{\ensuremath\mp}% - \DeclareUnicodeCharacter{2218}{\ensuremath\circ}% - \DeclareUnicodeCharacter{221A}{\ensuremath\surd}% - \DeclareUnicodeCharacter{221D}{\ensuremath\propto}% - \DeclareUnicodeCharacter{2220}{\ensuremath\angle}% - \DeclareUnicodeCharacter{2223}{\ensuremath\mid}% - \DeclareUnicodeCharacter{2228}{\ensuremath\vee}% - \DeclareUnicodeCharacter{222A}{\ensuremath\cup}% - \DeclareUnicodeCharacter{222B}{\ensuremath\smallint}% - \DeclareUnicodeCharacter{222E}{\ensuremath\oint}% - \DeclareUnicodeCharacter{223C}{\ensuremath\sim}% - \DeclareUnicodeCharacter{2240}{\ensuremath\wr}% - \DeclareUnicodeCharacter{2243}{\ensuremath\simeq}% - \DeclareUnicodeCharacter{2245}{\ensuremath\cong}% - \DeclareUnicodeCharacter{2248}{\ensuremath\approx}% - \DeclareUnicodeCharacter{224D}{\ensuremath\asymp}% - \DeclareUnicodeCharacter{2250}{\ensuremath\doteq}% - \DeclareUnicodeCharacter{2260}{\ensuremath\neq}% - \DeclareUnicodeCharacter{226A}{\ensuremath\ll}% - \DeclareUnicodeCharacter{226B}{\ensuremath\gg}% - \DeclareUnicodeCharacter{227A}{\ensuremath\prec}% - \DeclareUnicodeCharacter{227B}{\ensuremath\succ}% - \DeclareUnicodeCharacter{2283}{\ensuremath\supset}% - \DeclareUnicodeCharacter{2286}{\ensuremath\subseteq}% - \DeclareUnicodeCharacter{228E}{\ensuremath\uplus}% - \DeclareUnicodeCharacter{2291}{\ensuremath\sqsubseteq}% - \DeclareUnicodeCharacter{2292}{\ensuremath\sqsupseteq}% - \DeclareUnicodeCharacter{2293}{\ensuremath\sqcap}% - \DeclareUnicodeCharacter{2294}{\ensuremath\sqcup}% - \DeclareUnicodeCharacter{2295}{\ensuremath\oplus}% - \DeclareUnicodeCharacter{2296}{\ensuremath\ominus}% - \DeclareUnicodeCharacter{2297}{\ensuremath\otimes}% - \DeclareUnicodeCharacter{2298}{\ensuremath\oslash}% - \DeclareUnicodeCharacter{2299}{\ensuremath\odot}% - \DeclareUnicodeCharacter{22A2}{\ensuremath\vdash}% - \DeclareUnicodeCharacter{22A3}{\ensuremath\dashv}% - \DeclareUnicodeCharacter{22A4}{\ensuremath\ptextop}% - \DeclareUnicodeCharacter{22A5}{\ensuremath\bot}% - \DeclareUnicodeCharacter{22A8}{\ensuremath\models}% - \DeclareUnicodeCharacter{22C0}{\ensuremath\bigwedge}% - \DeclareUnicodeCharacter{22C1}{\ensuremath\bigvee}% - \DeclareUnicodeCharacter{22C2}{\ensuremath\bigcap}% - \DeclareUnicodeCharacter{22C3}{\ensuremath\bigcup}% - \DeclareUnicodeCharacter{22C4}{\ensuremath\diamond}% - \DeclareUnicodeCharacter{22C5}{\ensuremath\cdot}% - \DeclareUnicodeCharacter{22C6}{\ensuremath\star}% - \DeclareUnicodeCharacter{22C8}{\ensuremath\bowtie}% - \DeclareUnicodeCharacter{2308}{\ensuremath\lceil}% - \DeclareUnicodeCharacter{2309}{\ensuremath\rceil}% - \DeclareUnicodeCharacter{230A}{\ensuremath\lfloor}% - \DeclareUnicodeCharacter{230B}{\ensuremath\rfloor}% - \DeclareUnicodeCharacter{2322}{\ensuremath\frown}% - \DeclareUnicodeCharacter{2323}{\ensuremath\smile}% - % - \DeclareUnicodeCharacter{25B3}{\ensuremath\triangle}% - \DeclareUnicodeCharacter{25B7}{\ensuremath\triangleright}% - \DeclareUnicodeCharacter{25BD}{\ensuremath\bigtriangledown}% - \DeclareUnicodeCharacter{25C1}{\ensuremath\triangleleft}% - \DeclareUnicodeCharacter{25C7}{\ensuremath\diamond}% - \DeclareUnicodeCharacter{2660}{\ensuremath\spadesuit}% - \DeclareUnicodeCharacter{2661}{\ensuremath\heartsuit}% - \DeclareUnicodeCharacter{2662}{\ensuremath\diamondsuit}% - \DeclareUnicodeCharacter{2663}{\ensuremath\clubsuit}% - \DeclareUnicodeCharacter{266D}{\ensuremath\flat}% - \DeclareUnicodeCharacter{266E}{\ensuremath\natural}% - \DeclareUnicodeCharacter{266F}{\ensuremath\sharp}% - \DeclareUnicodeCharacter{26AA}{\ensuremath\bigcirc}% - \DeclareUnicodeCharacter{27B9}{\ensuremath\rangle}% - \DeclareUnicodeCharacter{27C2}{\ensuremath\perp}% - \DeclareUnicodeCharacter{27E8}{\ensuremath\langle}% - \DeclareUnicodeCharacter{27F5}{\ensuremath\longleftarrow}% - \DeclareUnicodeCharacter{27F6}{\ensuremath\longrightarrow}% - \DeclareUnicodeCharacter{27F7}{\ensuremath\longleftrightarrow}% - \DeclareUnicodeCharacter{27FC}{\ensuremath\longmapsto}% - \DeclareUnicodeCharacter{29F5}{\ensuremath\setminus}% - \DeclareUnicodeCharacter{2A00}{\ensuremath\bigodot}% - \DeclareUnicodeCharacter{2A01}{\ensuremath\bigoplus}% - \DeclareUnicodeCharacter{2A02}{\ensuremath\bigotimes}% - \DeclareUnicodeCharacter{2A04}{\ensuremath\biguplus}% - \DeclareUnicodeCharacter{2A06}{\ensuremath\bigsqcup}% - \DeclareUnicodeCharacter{2A3F}{\ensuremath\amalg}% - \DeclareUnicodeCharacter{2AAF}{\ensuremath\preceq}% - \DeclareUnicodeCharacter{2AB0}{\ensuremath\succeq}% - % - \global\mathchardef\checkmark="1370% actually the square root sign - \DeclareUnicodeCharacter{2713}{\ensuremath\checkmark}% -}% end of \unicodechardefs - -% UTF-8 byte sequence (pdfTeX) definitions (replacing and @U command) -% It makes the setting that replace UTF-8 byte sequence. -\def\utfeightchardefs{% - \let\DeclareUnicodeCharacter\DeclareUnicodeCharacterUTFviii - \unicodechardefs -} - -% Whether the active definitions of non-ASCII characters expand to -% non-active tokens with the same character code. This is used to -% write characters literally, instead of using active definitions for -% printing the correct glyphs. -\newif\ifpassthroughchars -\passthroughcharsfalse - -% For native Unicode handling (XeTeX and LuaTeX), -% provide a definition macro to replace/pass-through a Unicode character -% -\def\DeclareUnicodeCharacterNative#1#2{% - \catcode"#1=\active - \def\dodeclareunicodecharacternative##1##2##3{% - \begingroup - \uccode`\~="##2\relax - \uppercase{\gdef~}{% - \ifpassthroughchars - ##1% - \else - ##3% - \fi - } - \endgroup - } - \begingroup - \uccode`\.="#1\relax - \uppercase{\def\UTFNativeTmp{.}}% - \expandafter\dodeclareunicodecharacternative\UTFNativeTmp{#1}{#2}% - \endgroup -} - -% Native Unicode handling (XeTeX and LuaTeX) character replacing definition. -% It activates the setting that replaces Unicode characters. -\def\nativeunicodechardefs{% - \let\DeclareUnicodeCharacter\DeclareUnicodeCharacterNative - \unicodechardefs -} - -% For native Unicode handling (XeTeX and LuaTeX), -% make the character token expand -% to the sequences given in \unicodechardefs for printing. -\def\DeclareUnicodeCharacterNativeAtU#1#2{% - \def\UTFAtUTmp{#2} - \expandafter\globallet\csname uni:#1\endcsname \UTFAtUTmp -} - -% @U command definitions for native Unicode handling (XeTeX and LuaTeX). -\def\nativeunicodechardefsatu{% - \let\DeclareUnicodeCharacter\DeclareUnicodeCharacterNativeAtU - \unicodechardefs -} - -% US-ASCII character definitions. -\def\asciichardefs{% nothing need be done - \relax -} - -% Define all Unicode characters we know about. This makes UTF-8 the default -% input encoding and allows @U to work. -\iftxinativeunicodecapable - \nativeunicodechardefsatu -\else - \utfeightchardefs -\fi - -\message{formatting,} - -\newdimen\defaultparindent \defaultparindent = 15pt - -\chapheadingskip = 15pt plus 4pt minus 2pt -\secheadingskip = 12pt plus 3pt minus 2pt -\subsecheadingskip = 9pt plus 2pt minus 2pt - -% Prevent underfull vbox error messages. -\vbadness = 10000 - -% Don't be very finicky about underfull hboxes, either. -\hbadness = 6666 - -% Following George Bush, get rid of widows and orphans. -\widowpenalty=10000 -\clubpenalty=10000 - -% Use TeX 3.0's \emergencystretch to help line breaking, but if we're -% using an old version of TeX, don't do anything. We want the amount of -% stretch added to depend on the line length, hence the dependence on -% \hsize. We call this whenever the paper size is set. -% -\def\setemergencystretch{% - \ifx\emergencystretch\thisisundefined - % Allow us to assign to \emergencystretch anyway. - \def\emergencystretch{\dimen0}% - \else - \emergencystretch = .15\hsize - \fi -} - -% Parameters in order: 1) textheight; 2) textwidth; -% 3) voffset; 4) hoffset; 5) binding offset; 6) topskip; -% 7) physical page height; 8) physical page width. -% -% We also call \setleading{\textleading}, so the caller should define -% \textleading. The caller should also set \parskip. -% -\def\internalpagesizes#1#2#3#4#5#6#7#8{% - \voffset = #3\relax - \topskip = #6\relax - \splittopskip = \topskip - % - \vsize = #1\relax - \advance\vsize by \topskip - \outervsize = \vsize - \advance\outervsize by 2\topandbottommargin - \txipageheight = \vsize - % - \hsize = #2\relax - \outerhsize = \hsize - \advance\outerhsize by 0.5in - \txipagewidth = \hsize - % - \normaloffset = #4\relax - \bindingoffset = #5\relax - % - \ifpdf - \pdfpageheight #7\relax - \pdfpagewidth #8\relax - % if we don't reset these, they will remain at "1 true in" of - % whatever layout pdftex was dumped with. - \pdfhorigin = 1 true in - \pdfvorigin = 1 true in - \else - \ifx\XeTeXrevision\thisisundefined - \special{papersize=#8,#7}% - \else - \pdfpageheight #7\relax - \pdfpagewidth #8\relax - % XeTeX does not have \pdfhorigin and \pdfvorigin. - \fi - \fi - % - \setleading{\textleading} - % - \parindent = \defaultparindent - \setemergencystretch -} - -% @letterpaper (the default). -\def\letterpaper{{\globaldefs = 1 - \parskip = 3pt plus 2pt minus 1pt - \textleading = 13.2pt - % - % If page is nothing but text, make it come out even. - \internalpagesizes{607.2pt}{6in}% that's 46 lines - {\voffset}{.25in}% - {\bindingoffset}{36pt}% - {11in}{8.5in}% -}} - -% Use @smallbook to reset parameters for 7x9.25 trim size. -\def\smallbook{{\globaldefs = 1 - \parskip = 2pt plus 1pt - \textleading = 12pt - % - \internalpagesizes{7.5in}{5in}% - {-.2in}{0in}% - {\bindingoffset}{16pt}% - {9.25in}{7in}% - % - \lispnarrowing = 0.3in - \tolerance = 700 - \contentsrightmargin = 0pt - \defbodyindent = .5cm -}} - -% Use @smallerbook to reset parameters for 6x9 trim size. -% (Just testing, parameters still in flux.) -\def\smallerbook{{\globaldefs = 1 - \parskip = 1.5pt plus 1pt - \textleading = 12pt - % - \internalpagesizes{7.4in}{4.8in}% - {-.2in}{-.4in}% - {0pt}{14pt}% - {9in}{6in}% - % - \lispnarrowing = 0.25in - \tolerance = 700 - \contentsrightmargin = 0pt - \defbodyindent = .4cm -}} - -% Use @afourpaper to print on European A4 paper. -\def\afourpaper{{\globaldefs = 1 - \parskip = 3pt plus 2pt minus 1pt - \textleading = 13.2pt - % - % Double-side printing via postscript on Laserjet 4050 - % prints double-sided nicely when \bindingoffset=10mm and \hoffset=-6mm. - % To change the settings for a different printer or situation, adjust - % \normaloffset until the front-side and back-side texts align. Then - % do the same for \bindingoffset. You can set these for testing in - % your texinfo source file like this: - % @tex - % \global\normaloffset = -6mm - % \global\bindingoffset = 10mm - % @end tex - \internalpagesizes{673.2pt}{160mm}% that's 51 lines - {\voffset}{\hoffset}% - {\bindingoffset}{44pt}% - {297mm}{210mm}% - % - \tolerance = 700 - \contentsrightmargin = 0pt - \defbodyindent = 5mm -}} - -% Use @afivepaper to print on European A5 paper. -% From romildo@urano.iceb.ufop.br, 2 July 2000. -% He also recommends making @example and @lisp be small. -\def\afivepaper{{\globaldefs = 1 - \parskip = 2pt plus 1pt minus 0.1pt - \textleading = 12.5pt - % - \internalpagesizes{160mm}{120mm}% - {\voffset}{\hoffset}% - {\bindingoffset}{8pt}% - {210mm}{148mm}% - % - \lispnarrowing = 0.2in - \tolerance = 800 - \contentsrightmargin = 0pt - \defbodyindent = 2mm - \tableindent = 12mm -}} - -% A specific text layout, 24x15cm overall, intended for A4 paper. -\def\afourlatex{{\globaldefs = 1 - \afourpaper - \internalpagesizes{237mm}{150mm}% - {\voffset}{4.6mm}% - {\bindingoffset}{7mm}% - {297mm}{210mm}% - % - % Must explicitly reset to 0 because we call \afourpaper. - \globaldefs = 0 -}} - -% Use @afourwide to print on A4 paper in landscape format. -\def\afourwide{{\globaldefs = 1 - \afourpaper - \internalpagesizes{241mm}{165mm}% - {\voffset}{-2.95mm}% - {\bindingoffset}{7mm}% - {297mm}{210mm}% - \globaldefs = 0 -}} - -% @pagesizes TEXTHEIGHT[,TEXTWIDTH] -% Perhaps we should allow setting the margins, \topskip, \parskip, -% and/or leading, also. Or perhaps we should compute them somehow. -% -\parseargdef\pagesizes{\pagesizesyyy #1,,\finish} -\def\pagesizesyyy#1,#2,#3\finish{{% - \setbox0 = \hbox{\ignorespaces #2}\ifdim\wd0 > 0pt \hsize=#2\relax \fi - \globaldefs = 1 - % - \parskip = 3pt plus 2pt minus 1pt - \setleading{\textleading}% - % - \dimen0 = #1\relax - \advance\dimen0 by \voffset - \advance\dimen0 by 1in % reference point for DVI is 1 inch from top of page - % - \dimen2 = \hsize - \advance\dimen2 by \normaloffset - \advance\dimen2 by 1in % reference point is 1 inch from left edge of page - % - \internalpagesizes{#1}{\hsize}% - {\voffset}{\normaloffset}% - {\bindingoffset}{44pt}% - {\dimen0}{\dimen2}% -}} - -% Set default to letter. -% -\letterpaper - -% Default value of \hfuzz, for suppressing warnings about overfull hboxes. -\hfuzz = 1pt - - -\message{and turning on texinfo input format.} - -\def^^L{\par} % remove \outer, so ^L can appear in an @comment - -% DEL is a comment character, in case @c does not suffice. -\catcode`\^^? = 14 - -% Define macros to output various characters with catcode for normal text. -\catcode`\"=\other \def\normaldoublequote{"} -\catcode`\$=\other \def\normaldollar{$}%$ font-lock fix -\catcode`\+=\other \def\normalplus{+} -\catcode`\<=\other \def\normalless{<} -\catcode`\>=\other \def\normalgreater{>} -\catcode`\^=\other \def\normalcaret{^} -\catcode`\_=\other \def\normalunderscore{_} -\catcode`\|=\other \def\normalverticalbar{|} -\catcode`\~=\other \def\normaltilde{~} - -% This macro is used to make a character print one way in \tt -% (where it can probably be output as-is), and another way in other fonts, -% where something hairier probably needs to be done. -% -% #1 is what to print if we are indeed using \tt; #2 is what to print -% otherwise. Since all the Computer Modern typewriter fonts have zero -% interword stretch (and shrink), and it is reasonable to expect all -% typewriter fonts to have this, we can check that font parameter. -% -\def\ifusingtt#1#2{\ifdim \fontdimen3\font=0pt #1\else #2\fi} - -% Same as above, but check for italic font. Actually this also catches -% non-italic slanted fonts since it is impossible to distinguish them from -% italic fonts. But since this is only used by $ and it uses \sl anyway -% this is not a problem. -\def\ifusingit#1#2{\ifdim \fontdimen1\font>0pt #1\else #2\fi} - -% Set catcodes for Texinfo file - -% Active characters for printing the wanted glyph. -% Most of these we simply print from the \tt font, but for some, we can -% use math or other variants that look better in normal text. -% -\catcode`\"=\active -\def\activedoublequote{{\tt\char34}} -\let"=\activedoublequote -\catcode`\~=\active \def\activetilde{{\tt\char126}} \let~ = \activetilde -\chardef\hatchar=`\^ -\catcode`\^=\active \def\activehat{{\tt \hatchar}} \let^ = \activehat - -\catcode`\_=\active -\def_{\ifusingtt\normalunderscore\_} -\def\_{\leavevmode \kern.07em \vbox{\hrule width.3em height.1ex}\kern .07em } -\let\realunder=_ - -\catcode`\|=\active \def|{{\tt\char124}} - -\chardef \less=`\< -\catcode`\<=\active \def\activeless{{\tt \less}}\let< = \activeless -\chardef \gtr=`\> -\catcode`\>=\active \def\activegtr{{\tt \gtr}}\let> = \activegtr -\catcode`\+=\active \def+{{\tt \char 43}} -\catcode`\$=\active \def${\ifusingit{{\sl\$}}\normaldollar}%$ font-lock fix -\catcode`\-=\active \let-=\normaldash - - -% used for headline/footline in the output routine, in case the page -% breaks in the middle of an @tex block. -\def\texinfochars{% - \let< = \activeless - \let> = \activegtr - \let~ = \activetilde - \let^ = \activehat - \markupsetuplqdefault \markupsetuprqdefault - \let\b = \strong - \let\i = \smartitalic - % in principle, all other definitions in \tex have to be undone too. -} - -% Used sometimes to turn off (effectively) the active characters even after -% parsing them. -\def\turnoffactive{% - \normalturnoffactive - \otherbackslash -} - -\catcode`\@=0 - -% \backslashcurfont outputs one backslash character in current font, -% as in \char`\\. -\global\chardef\backslashcurfont=`\\ - -% \realbackslash is an actual character `\' with catcode other. -{\catcode`\\=\other @gdef@realbackslash{\}} - -% In Texinfo, backslash is an active character; it prints the backslash -% in fixed width font. -\catcode`\\=\active % @ for escape char from now on. - -% Print a typewriter backslash. For math mode, we can't simply use -% \backslashcurfont: the story here is that in math mode, the \char -% of \backslashcurfont ends up printing the roman \ from the math symbol -% font (because \char in math mode uses the \mathcode, and plain.tex -% sets \mathcode`\\="026E). Hence we use an explicit \mathchar, -% which is the decimal equivalent of "715c (class 7, e.g., use \fam; -% ignored family value; char position "5C). We can't use " for the -% usual hex value because it has already been made active. - -@def@ttbackslash{{@tt @ifmmode @mathchar29020 @else @backslashcurfont @fi}} -@let@backslashchar = @ttbackslash % @backslashchar{} is for user documents. - -% \otherbackslash defines an active \ to be a literal `\' character with -% catcode other. -@gdef@otherbackslash{@let\=@realbackslash} - -% Same as @turnoffactive except outputs \ as {\tt\char`\\} instead of -% the literal character `\'. -% -{@catcode`- = @active - @gdef@normalturnoffactive{% - @passthroughcharstrue - @let-=@normaldash - @let"=@normaldoublequote - @let$=@normaldollar %$ font-lock fix - @let+=@normalplus - @let<=@normalless - @let>=@normalgreater - @let^=@normalcaret - @let_=@normalunderscore - @let|=@normalverticalbar - @let~=@normaltilde - @let\=@ttbackslash - @markupsetuplqdefault - @markupsetuprqdefault - @unsepspaces - } -} - -% If a .fmt file is being used, characters that might appear in a file -% name cannot be active until we have parsed the command line. -% So turn them off again, and have @fixbackslash turn them back on. -@catcode`+=@other @catcode`@_=@other - -% \enablebackslashhack - allow file to begin `\input texinfo' -% -% If a .fmt file is being used, we don't want the `\input texinfo' to show up. -% That is what \eatinput is for; after that, the `\' should revert to printing -% a backslash. -% If the file did not have a `\input texinfo', then it is turned off after -% the first line; otherwise the first `\' in the file would cause an error. -% This is used on the very last line of this file, texinfo.tex. -% We also use @c to call @fixbackslash, in case ends of lines are hidden. -{ -@catcode`@^=7 -@catcode`@^^M=13@gdef@enablebackslashhack{% - @global@let\ = @eatinput% - @catcode`@^^M=13% - @def@c{@fixbackslash@c}% - % Definition for the newline at the end of this file. - @def ^^M{@let^^M@secondlinenl}% - % Definition for a newline in the main Texinfo file. - @gdef @secondlinenl{@fixbackslash}% - % In case the first line has a whole-line command on it - @let@originalparsearg@parsearg - @def@parsearg{@fixbackslash@originalparsearg} -}} - -{@catcode`@^=7 @catcode`@^^M=13% -@gdef@eatinput input texinfo#1^^M{@fixbackslash}} - -% Emergency active definition of newline, in case an active newline token -% appears by mistake. -{@catcode`@^=7 @catcode13=13% -@gdef@enableemergencynewline{% - @gdef^^M{% - @par% - %@par% -}}} - - -@gdef@fixbackslash{% - @ifx\@eatinput @let\ = @ttbackslash @fi - @catcode13=5 % regular end of line - @enableemergencynewline - @let@c=@texinfoc - @let@parsearg@originalparsearg - % Also turn back on active characters that might appear in the input - % file name, in case not using a pre-dumped format. - @catcode`+=@active - @catcode`@_=@active - % - % If texinfo.cnf is present on the system, read it. - % Useful for site-wide @afourpaper, etc. This macro, @fixbackslash, gets - % called at the beginning of every Texinfo file. Not opening texinfo.cnf - % directly in this file, texinfo.tex, makes it possible to make a format - % file for Texinfo. - % - @openin 1 texinfo.cnf - @ifeof 1 @else @input texinfo.cnf @fi - @closein 1 -} - - -% Say @foo, not \foo, in error messages. -@escapechar = `@@ - -% These (along with & and #) are made active for url-breaking, so need -% active definitions as the normal characters. -@def@normaldot{.} -@def@normalquest{?} -@def@normalslash{/} - -% These look ok in all fonts, so just make them not special. -% @hashchar{} gets its own user-level command, because of #line. -@catcode`@& = @other @def@normalamp{&} -@catcode`@# = @other @def@normalhash{#} -@catcode`@% = @other @def@normalpercent{%} - -@let @hashchar = @normalhash - -@c Finally, make ` and ' active, so that txicodequoteundirected and -@c txicodequotebacktick work right in, e.g., @w{@code{`foo'}}. If we -@c don't make ` and ' active, @code will not get them as active chars. -@c Do this last of all since we use ` in the previous @catcode assignments. -@catcode`@'=@active -@catcode`@`=@active -@markupsetuplqdefault -@markupsetuprqdefault - -@c Local variables: -@c eval: (add-hook 'before-save-hook 'time-stamp) -@c page-delimiter: "^\\\\message\\|emacs-page" -@c time-stamp-start: "def\\\\texinfoversion{" -@c time-stamp-format: "%:y-%02m-%02d.%02H" -@c time-stamp-end: "}" -@c End: - -@c vim:sw=2: - -@enablebackslashhack diff -Nru gnucobol-4.0~early~20200606/build_aux/ylwrap gnucobol-5/build_aux/ylwrap --- gnucobol-4.0~early~20200606/build_aux/ylwrap 2020-06-06 20:52:02.000000000 +0000 +++ gnucobol-5/build_aux/ylwrap 1970-01-01 00:00:00.000000000 +0000 @@ -1,247 +0,0 @@ -#! /bin/sh -# ylwrap - wrapper for lex/yacc invocations. - -scriptversion=2017-09-16.17; # UTC - -# Copyright (C) 1996-2017 Free Software Foundation, Inc. -# -# Written by Tom Tromey . -# -# This program is free software; you can redistribute it and/or modify -# it under the terms of the GNU General Public License as published by -# the Free Software Foundation; either version 2, or (at your option) -# any later version. -# -# This program is distributed in the hope that it will be useful, -# but WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -# GNU General Public License for more details. -# -# You should have received a copy of the GNU General Public License -# along with this program. If not, see . - -# As a special exception to the GNU General Public License, if you -# distribute this file as part of a program that contains a -# configuration script generated by Autoconf, you may include it under -# the same distribution terms that you use for the rest of that program. - -# This file is maintained in Automake, please report -# bugs to or send patches to -# . - -get_dirname () -{ - case $1 in - */*|*\\*) printf '%s\n' "$1" | sed -e 's|\([\\/]\)[^\\/]*$|\1|';; - # Otherwise, we want the empty string (not "."). - esac -} - -# guard FILE -# ---------- -# The CPP macro used to guard inclusion of FILE. -guard () -{ - printf '%s\n' "$1" \ - | sed \ - -e 'y/abcdefghijklmnopqrstuvwxyz/ABCDEFGHIJKLMNOPQRSTUVWXYZ/' \ - -e 's/[^ABCDEFGHIJKLMNOPQRSTUVWXYZ]/_/g' \ - -e 's/__*/_/g' -} - -# quote_for_sed [STRING] -# ---------------------- -# Return STRING (or stdin) quoted to be used as a sed pattern. -quote_for_sed () -{ - case $# in - 0) cat;; - 1) printf '%s\n' "$1";; - esac \ - | sed -e 's|[][\\.*]|\\&|g' -} - -case "$1" in - '') - echo "$0: No files given. Try '$0 --help' for more information." 1>&2 - exit 1 - ;; - --basedir) - basedir=$2 - shift 2 - ;; - -h|--h*) - cat <<\EOF -Usage: ylwrap [--help|--version] INPUT [OUTPUT DESIRED]... -- PROGRAM [ARGS]... - -Wrapper for lex/yacc invocations, renaming files as desired. - - INPUT is the input file - OUTPUT is one file PROG generates - DESIRED is the file we actually want instead of OUTPUT - PROGRAM is program to run - ARGS are passed to PROG - -Any number of OUTPUT,DESIRED pairs may be used. - -Report bugs to . -EOF - exit $? - ;; - -v|--v*) - echo "ylwrap $scriptversion" - exit $? - ;; -esac - - -# The input. -input=$1 -shift -# We'll later need for a correct munging of "#line" directives. -input_sub_rx=`get_dirname "$input" | quote_for_sed` -case $input in - [\\/]* | ?:[\\/]*) - # Absolute path; do nothing. - ;; - *) - # Relative path. Make it absolute. - input=`pwd`/$input - ;; -esac -input_rx=`get_dirname "$input" | quote_for_sed` - -# Since DOS filename conventions don't allow two dots, -# the DOS version of Bison writes out y_tab.c instead of y.tab.c -# and y_tab.h instead of y.tab.h. Test to see if this is the case. -y_tab_nodot=false -if test -f y_tab.c || test -f y_tab.h; then - y_tab_nodot=true -fi - -# The parser itself, the first file, is the destination of the .y.c -# rule in the Makefile. -parser=$1 - -# A sed program to s/FROM/TO/g for all the FROM/TO so that, for -# instance, we rename #include "y.tab.h" into #include "parse.h" -# during the conversion from y.tab.c to parse.c. -sed_fix_filenames= - -# Also rename header guards, as Bison 2.7 for instance uses its header -# guard in its implementation file. -sed_fix_header_guards= - -while test $# -ne 0; do - if test x"$1" = x"--"; then - shift - break - fi - from=$1 - # Handle y_tab.c and y_tab.h output by DOS - if $y_tab_nodot; then - case $from in - "y.tab.c") from=y_tab.c;; - "y.tab.h") from=y_tab.h;; - esac - fi - shift - to=$1 - shift - sed_fix_filenames="${sed_fix_filenames}s|"`quote_for_sed "$from"`"|$to|g;" - sed_fix_header_guards="${sed_fix_header_guards}s|"`guard "$from"`"|"`guard "$to"`"|g;" -done - -# The program to run. -prog=$1 -shift -# Make any relative path in $prog absolute. -case $prog in - [\\/]* | ?:[\\/]*) ;; - *[\\/]*) prog=`pwd`/$prog ;; -esac - -dirname=ylwrap$$ -do_exit="cd '`pwd`' && rm -rf $dirname > /dev/null 2>&1;"' (exit $ret); exit $ret' -trap "ret=129; $do_exit" 1 -trap "ret=130; $do_exit" 2 -trap "ret=141; $do_exit" 13 -trap "ret=143; $do_exit" 15 -mkdir $dirname || exit 1 - -cd $dirname - -case $# in - 0) "$prog" "$input" ;; - *) "$prog" "$@" "$input" ;; -esac -ret=$? - -if test $ret -eq 0; then - for from in * - do - to=`printf '%s\n' "$from" | sed "$sed_fix_filenames"` - if test -f "$from"; then - # If $2 is an absolute path name, then just use that, - # otherwise prepend '../'. - case $to in - [\\/]* | ?:[\\/]*) target=$to;; - *) target=../$to;; - esac - - # Do not overwrite unchanged header files to avoid useless - # recompilations. Always update the parser itself: it is the - # destination of the .y.c rule in the Makefile. Divert the - # output of all other files to a temporary file so we can - # compare them to existing versions. - if test $from != $parser; then - realtarget=$target - target=tmp-`printf '%s\n' "$target" | sed 's|.*[\\/]||g'` - fi - - # Munge "#line" or "#" directives. Don't let the resulting - # debug information point at an absolute srcdir. Use the real - # output file name, not yy.lex.c for instance. Adjust the - # include guards too. - sed -e "/^#/!b" \ - -e "s|$input_rx|$input_sub_rx|" \ - -e "$sed_fix_filenames" \ - -e "$sed_fix_header_guards" \ - "$from" >"$target" || ret=$? - - # Check whether files must be updated. - if test "$from" != "$parser"; then - if test -f "$realtarget" && cmp -s "$realtarget" "$target"; then - echo "$to is unchanged" - rm -f "$target" - else - echo "updating $to" - mv -f "$target" "$realtarget" - fi - fi - else - # A missing file is only an error for the parser. This is a - # blatant hack to let us support using "yacc -d". If -d is not - # specified, don't fail when the header file is "missing". - if test "$from" = "$parser"; then - ret=1 - fi - fi - done -fi - -# Remove the directory. -cd .. -rm -rf $dirname - -exit $ret - -# Local Variables: -# mode: shell-script -# sh-indentation: 2 -# eval: (add-hook 'write-file-hooks 'time-stamp) -# time-stamp-start: "scriptversion=" -# time-stamp-format: "%:y-%02m-%02d.%02H" -# time-stamp-time-zone: "UTC0" -# time-stamp-end: "; # UTC" -# End: diff -Nru gnucobol-4.0~early~20200606/ChangeLog gnucobol-5/ChangeLog --- gnucobol-4.0~early~20200606/ChangeLog 2020-06-06 20:52:01.000000000 +0000 +++ gnucobol-5/ChangeLog 1970-01-01 00:00:00.000000000 +0000 @@ -1,1211 +0,0 @@ - -2020-04-17 Simon Sobisch - - * gnucobol.spec: minor cleanup - -2020-04-16 Edward Hart - - * configure.ac: fixed cleaning of COB_CFLAGS again (see Patches #49). - -2020-03-11 Simon Sobisch - - * configure.ac: new check for MAKE supporting order-only prerequisites - resulting in new conditional MAKE_HAS_PREREQ_ONLY - -2020-02-02 Simon Sobisch - - * configure.ac: version bump to 4.0 (lt-version 5.0.0) - * configure.ac: document the existing environment vars LIBCOB_CPPFLAGS, - LIBCOB_LIBS and COBC_LIBS and test if those actually work - * Makefile.am (dist_noinst_SCRIPTS): moved doc/cobcinfo.sh here - * extras/Makefile.am: use of return_path instead of atlocal - * removed support for Bison < 3 - -2020-01-03 Simon Sobisch - - * configure.ac: fix auto-setup for OCI via ORACLE_HOME - -2019-12-01 Simon Sobisch - - * configure.ac: new options --with-indexed=odbc/oci, supporting - ODBC_CFLAGS ODBC_LIBS OCI_CFLAGS OCI_LIBS - -2019-10-24 Ron Norman - - * configure.ac: The -with-indexed now check that the handler had - also been include via -with-db|lmdb|cisam|disam|vbisam - -2019-10-21 Ron Norman - - * configure.ac: Updated for multiple INDEXED file handlers - --with-indexed=db|lmdb|cisam|disam|vbisam defines default - handler. If multiple of C/D/VB-ISAM are used then they are - built as a shared library and loaded at run time - -2019-08-12 Simon Sobisch - - * configure.ac: check for make - -2019-06-30 Simon Sobisch - - * configure.ac: changed the manual test runner to be a script handled - by autoconf instead of make - * configure.ac: check for HAVE_MOUSEINTERVAL - -2019-06-16 Simon Sobisch - - * Makefile.am (tarstamp.h, $(top_distdir)/tarstamp.h): targets added - * Makefile.am: fixed SUBDIRS handling - -2019-06-05 Simon Sobisch - - * general: include all (possibly) generated headers by '#include
' - (search "system directories" [which in all known compilers are pre-fixed - with the ones specified with '-I', which is done for the builddir - already]) instead of '#include "header"' (which is searched next to the - including file first). This applies to all files that include config.h, - defaults.h, tarstamp.h, parser.h, ppparse.h. - -2019-05-30 Simon Sobisch - - * configure.ac: fix bug #559 avoid useless dependencies (all but libm, - needs to be inspected later) by not copying LIBCOB_LIBS to COB_LIBS - and resetting LIBS after XML2/CJSON check; - now substituting LIBCOB_CPPFLAGS - * configure.ac: --with-cjson=local added (defines LOCAL_CJSON), - allowing to built-in cjson into libcob when its sources are found and - linkable in folder libcob (both srcdir and builddir supported); - takes precedence over search by means of pkg-config and/or - CJSON_CFLAGS and CJSON_LIBS - * Makefile.am (dist-hook): moved creation of windows source zip to a - separate target and make it work for out-of-tree builds, too - * create_win_dist.sh: all external paths are now specified by - environment variables; use rsync with exclude filters for - build_windows instead of plain cp - -2019-05-20 Simon Sobisch - - * configure.ac: set YFLAGS and DIFF_FLAGS depending on - available/requested options - -2019-05-17 Simon Sobisch - - * configure.ac: don't error on bad libxml2 if not explicit requested - -2019-05-13 Simon Sobisch - - * configure.ac, gnucobol.spec: version dump to 3.1-dev - * configure.ac: checks/defines HAVE_CJSON_H as an alternative to - HAVE_CJSON_CJSON_H - -2019-05-05 Simon Sobisch - - * autogen.sh: suppress most error messages (that can also occur if - execution rights are already available but we can't set them) - * configure.ac: check for curses has_mouse - -2019-04-14 Ron Norman - - * configure.ac [__xlc__]: suppress compiler warning about MAXMEM - optimization - -2019-04-06 Simon Sobisch - - * Makefile.am (noinst_SCRIPTS) add pre-inst-env - * configure.ac (AC_CONFIG_FILES): add pre-inst-env (template file - build_aux/pre-inst-env.in) and split existing entries to initialize - scripts to be executable - -2019-04-06 Simon Sobisch - - * Makefile.am (noinst_SCRIPTS) add pre-inst-env - * configure.ac (AC_CONFIG_FILES): add pre-inst-env (template file - build_aux/pre-inst-env.in) and split existing entries to initialize - scripts to be executable - -2019-03-15 Simon Sobisch - - * autogen.sh: fixed to work correctly when called as "./autogen.sh" - -2019-02-18 Simon Sobisch - - * autogen.sh: new, wrapper for build_aux/bootstrap - * Makefile.am: cleanup distribution rules - -2019-01-06 Simon Sobisch - - * configure.ac: added action "comment" for PKG_CHECK_MODULES - cJSON for action-not-found as the empty (default) action is - to abort configure - -2019-01-05 Edward Hart - - * configure.ac: added detection of cJSON. - -2019-01-01 Simon Sobisch - - * configure.ac: only check for finite function if isfinite is not found - -2018-11-25 Simon Sobisch - - * configure.ac: only warn once about missing headers needed for libxml2 - -2018-11-01 Simon Sobisch - - * libcob.h [COB_WITHOUT_DECIMAL]: allow include of libcob.h without - gmp header (for link-only; providing compatibility to GnuCOBOL 1.1) - -2018-10-01 Simon Sobisch - - * Makefile.am: prefer user-specified localedir - -2018-09-30 Simon Sobisch - - * general: activated translated messages for COBOL runtime - -2018-09-01 Simon Sobisch - - * configure.ac: fixed non-working auto-check for libxml2 - -2018-08-30 Hal Duston - - * configure.ac: fixed removal of -DFORTIFY_SOURCE not removing -Wp also. - -2018-08-19 Simon Sobisch - - * m4/pkg.m4: added for PKG_PROG_PKG_CONFIG / PKG_CHECK_MODULES macros - from current pkg-config release - * configure.ac: included optional pkg-config (cross-compile aware), - currently only used for libxml2 (and only if xml2-config not found); - always check for existing header / linkable library for xml2 - * configure.ac: check for libxml2, but don't abort if not available; - prefer pkg-config over xml2-config - -2018-08-19 Edward Hart - - * configure.ac: added detection of libxml2 - * m4/m4_ax_check_define.m4: added for AC_CHECK_DEFINE macro from the - GNU Autoconf Archive - -2018-06-19 Ludwin Janvier - - * configure.ac: remove -g from default options and remove removal - of -g from CFLAGS - -2018-06-04 Simon Sobisch - - * configure.ac [_WIN32]: only set GCC export and linker flag - if we actually compile with GCC - -2018-05-18 Simon Sobisch - - * configure.ac [_WIN32]: define __GMP_LIBGMP_DLL when importing - and calling gmp functions (done for version check) - to use - a static version define __GMP_LIBGMP_DLL=0 via CPPFLAGS - -2018-05-08 Simon Sobisch - - * configure.ac (AC_CHECK_FUNCS): removed unused strxfrm, added popen - * configure.ac: ensure that we don't replace too much when adjusting - CFLAGS concerning -g - -2018-04-10 Simon Sobisch - - * configure.ac: removed use of line breaks in sysout from C - test compilation for extracting GMP/BDB version numbers - -2018-04-04 Simon Sobisch - - * configure.ac: added --enable-cobc-internal-checks to define - COB_TREE_DEBUG in config.h - -2018-04-01 Simon Sobisch - - * extras/Makefile.am: compile with -O2 and retry without optimization - if first compilation did not work, see Bug #439 - -2018-03-25 Simon Sobisch - - * Makefile.am (checkmanual): new target for running manual tests, - note: if needed the test runner tests/run_prog_manual.sh may - be changed by the user - -2018-03-24 Simon Sobisch - - * configure.ac: check for curses define_key function - -2018-03-11 Ron Norman - - * configure.ac: COB_STRFTIME and COB_HAS_UTC_OFFSET removed as - no longer needed - -2018-02-18 Simon Sobisch - - * README: Explicitly state we use ranges in copyright years and - mention the INSTALL file as suggested by the GNU maintainer manual - * general: add license notice to Changelog files - -2018-01-23 Simon Sobisch - - * configure.ac: fix setting of COB_CFLAGS when CFLAGS contains - -fstack-protector-all or -fstack-protector-strong - -2017-12-06 Simon Sobisch - - * configure.ac: version bump to 3.0-dev - * general: merged code for REPORTWRITER module from reportwriter branch - -2017-12-05 Simon Sobisch - - * Makefile.am: always use non-localized date formatting for tarstamp.h - -2017-11-20 Simon Sobisch - - * Makefile.am: tweaked dependencies to make sure defaults.h is - even build if another target than all/check is used - -2017-11-05 Simon Sobisch - - * configure.ac: new template COB_COMPUTED_GOTO, defined if - computed gotos can be compiled - -2017-10-30 Simon Sobisch - - * configure.ac: if --with-vbisam is given: check for isfullclose - (available since 2.0) instead of isopen (available since 1.0) - -2017-10-28 Simon Sobisch - - * configure.ac: fixed --with-curses (without option) and adjusted its - help text - -2017-10-22 Simon Sobisch - - * configure.ac: revised all uses of AC_RUN_IFELSE and changed to - AC_COMPILE_IFELSE where the preparser output is enough - * configure.ac: allow cross-compiling with --host and --build; - allow to change compiler executable called by cobc with COB_CC - * extras/Makefile.am, doc/Makefile.am: don't call generated binaries - if not possible because of cross-compiling - -2017-10-19 Simon Sobisch - - * bin/Makefile.am, cobcrun/Makefile.am: fixed bug #448 parallel build - breaking by matching prerequisites 100% (pointed out by Nick Bowler) - -2017-08-13 Simon Sobisch - - * general: removed all Makefiles and configure script generated by - autoconf and automake from version control - use build_aux/bootstrap - * Makefile.am: ensure correct time stamps for make dist - * configure.ac: adjusted GMP version checks, - substitute COB_HAS_64_BIT_POINTER for use in testsuite - -2017-08-08 Simon Sobisch - - * create_win_dist.sh: remove ".in" suffix from template files config.h.in - and defaults.h.in in generated win dist package - -2017-07-19 Simon Sobisch - - * configure.ac: version bump to 2.3-dev - -2017-07-13 Simon Sobisch - - * configure.ac [_BSD_SOURCE]: set COB_HAS_UTC_OFFSET to "yes" if C compiler - defines _BSD_SOURCE as we can access the offset directly in this case - * configure.ac: output detailed version information for BDB, if available - -2017-06-16 Simon Sobisch - - * configure.ac: added --enable-code-coverage and test for code-coverage - tools if enabled by AX_CODE_COVERAGE, - always check if user specified optimization options in CFLAGS, - not only when --enable-debug is active, - compile with -O0 for both --enable-debug and --enable-code-coverage - * Makefile.am: added CODE_COVERAGE parts as provided by AX_CODE_COVERAGE - which provides new target `make check-code-coverage` - -2017-06-15 Simon Sobisch - - * Makefile.am: added .PHONY to correctly declare logical targets that - always have to be executed and don't result in a file, - define prerequisites to fix parallel builds - -2017-06-07 Ron Norman - - * configure.ac,configure,config.h.in: Add check for atoll, strtoll - * coblocal.h: if 'atoll' is not available, then use strtoll in #define - -2017-05-31 Ron Norman - - * configure.ac: set COB_HAS_ISAM to type of ISAM handler instead of 'yes' - 'cisam', 'disam', 'vbisam', 'db', 'index_extfh' - if no ISAM then it is - set to 'no' - -2017-05-11 Simon Sobisch - - * configure.ac: change in library check for BDB - prefer library - with version number from db.h included (-ldb-6.1 over -ldb) to - prevent errors on system with multiple versions that linked - against wrong version, see bug #100 - -2017-04-28 Simon Sobisch - - * configure.ac: removed AM_MAINTAINER_MODE, added AM_PROG_LEX, - AC_PROG_YACC, AM_MISSING_PROG([HELP2MAN], [help2man]) - * create_win_dist.sh: integrated hack for _MSC_VER from - cobc/Makefile.am; use a clean temporary folder for building - -2017-04-18 Ron Norman - - * configure.ac: check for 'isfinite' (HAVE_ISFINITE) - 'isfinite' is in the C99 standard and 'finite' deprecated with some - compilers - -2017-02-24 Simon Sobisch - - * HACKING: added info how to prepare a distribution - * Makefile.am: don't touch any generated files, see HACKING - * Makefile.am: chmod for all files to 644, - executable scripts and directories get 755 - -2017-02-09 Simon Sobisch - - * HACKING, README: moved instructions for development/svn-builds - from README to new file HACKING and added missing information - -2017-02-06 Simon Sobisch - - * configure.ac: fixed use of undefined COB_TIMEZONE - -2017-02-04 Edward Hart - - * configure.ac: fixed bug where -g3 in CFLAGS was replaced by 3, - instead of being removed. - -2016-12-26 Simon Sobisch - - * configure.ac: #bugs 346 moved compiler specific COB_CFLAGS from - cobc/cobc.c to configure, removes the use of HAVE_PSIGN_OPT, too - -2016-12-25 Edward Hart - - * configure.ac: added -Qunused-arguments to clang CFLAGS. - -2016-12-22 Simon Sobisch - - * configure.ac: additional test for libdisam names - -2016-12-06 Simon Sobisch - - * configure.ac: changed package-name to gnucobol - * configure.ac: fixing bug #339 added COB_MODULE_EXT to config.h, - renamed COB_OBJEXT->COB_OBJECT_EXT, COB_EXEEXT->COB_EXE_EXT, - * configure.ac: exported COB_EXE_EXT to makefiles (used in testsuite) - * Makefile.am: fixing bug #339 removed COB_MODULE_EXT and COB_OBJECT_EXT - from being generated in defaults.h - * Makefile.am: cleanup of EXTRA_DIST - -2016-11-17 Ron Norman - - * configure.ac: check for sys/wait.h (for CBL_GC_WAITPID) - -2016-11-06 Simon Sobisch - - * configure.ac: limit PATCH_LEVEL to numeric, max 8 digits - * configure.ac: use AS_HELP_STRING for all options - -2016-11-05 Simon Sobisch - - * Bootstrap up to libtool 2.4.6 / automake 1.15 - -2016-11-05 gettextize - - * m4/gettext.m4: Upgrade to gettext-0.19.8.1. - * m4/iconv.m4: Upgrade to gettext-0.19.8.1. - * m4/lib-ld.m4: Upgrade to gettext-0.19.8.1. - * m4/lib-link.m4: Upgrade to gettext-0.19.8.1. - * m4/lib-prefix.m4: Upgrade to gettext-0.19.8.1. - * m4/nls.m4: Upgrade to gettext-0.19.8.1. - * m4/po.m4: Upgrade to gettext-0.19.8.1. - * m4/progtest.m4: Upgrade to gettext-0.19.8.1. - * configure.ac (AM_GNU_GETTEXT_VERSION): Bump to 0.19.8. - -2016-08-10 Simon Sobisch - - * Makefile.am: added manual hook for creating a windows source zip - (not possible with the dist-zip target as this is identical to - dist-gzip), done with optional external shell create_win_dist.sh - * create_win_dist.sh: copy an existing source distribution folder, - include build_windows from source tree, change line endings and - create DISTNAME_win.zip - -2016-08-10 Edward Hart - - * configure.ac: added -g3 to CFLAGS with --enable-debug and GCC. - -2016-08-01 Simon Sobisch - - * general: revised all message strings - -2016-05-04 Simon Sobisch - - * general: removed project files and references to Visual C < 2005 - (GC 2+ will not build with these versions) including define of - COB_USE_VC2005_OR_GREATER - -2016-01-30 Simon Sobisch - - * configure.ac: removed AC_FUNC_ALLOCA - -2016-01-12 Simon Sobisch - - * Makefile.am: added targets "test" (running ANSI testsuite) and - "checkall" (running both GnuCOBOL and ANSI testsuite), both do a - full build of GnuCOBOL if necessary - -2015-12-20 Simon Sobisch - - * Taken into account all copyright assignments and rechecking the dates - * Changed name spelling to GnuCOBOL - * general: update of automake/autoconf/bison/flex - -2015-09-15 Brian Tiffin - - * configure.ac, moved COB_DASH names to cobc/cobc.h - -2015-08-03 Brian Tiffin - - * configure.ac: added COB_DASH, COB_DASH_NAME, COB_DASH_OUT - to support compile from stdin - -2015-04-27 Ron Norman - - * Added support for Micro Focus format sequential and relative - files. New compiler directive -fmf-files sets all sequential - and relative files to match what Micro Focus would create - Numerous runtime.cfg settings added for selecting file - format. - -2015-07-10 Simon Sobisch - - * general: moved additional build-scripts to build_aux, - regenerated all Makefiles - * configure.ac: added AC_CONFIG_AUX_DIR([build_aux]) - -2015-02-27 Simon Sobisch - - * general: removed "Experimental" marker from CISAM/DISAM/VBISAM - * configure.ac: define WITH_CURSES for printing library for screenio - -2015-02-16 Ron Norman - - Implemented DEBUG logging for Compiler developers - * configure.ac: Added --enable-debug-log to configure.ac - Logging can be turned and set to certain level using - an environment variable COB_DEBUG_LOG - -2015-03-06 gettextize - - * m4/gettext.m4: Upgrade to gettext-0.19.4. - * m4/iconv.m4: Upgrade to gettext-0.19.4. - * m4/lib-ld.m4: Upgrade to gettext-0.19.4. - * m4/lib-link.m4: Upgrade to gettext-0.19.4. - * m4/lib-prefix.m4: Upgrade to gettext-0.19.4. - * m4/nls.m4: Upgrade to gettext-0.19.4. - * m4/po.m4: Upgrade to gettext-0.19.4. - * m4/progtest.m4: Upgrade to gettext-0.19.4. - * configure.ac (AM_GNU_GETTEXT_VERSION): Bump to 0.19.4. - -2015-02-12 Ron Norman - - * Merged Report Writer code into 2.0 code base to create a new 2.0 - with all collective features - -2014-08-07 Simon Sobisch - - * general: revised message strings (not all done yet); - similar message strings combined (23 translatable strings removed); - removed line breaks from translatable strings - * configure.ac: don't disable NLS automatically for CYGWIN - (--disable-nls can be used by the user instead) - -2014-12-04 Edward Hart - - * configure.ac: #44 Disable optimisation with --enable-debug - -2014-09-09 Philipp Böhme - - * configure.ac: new check for mp_get_memory_functions in - libgmp and new preprocessor define HAVE_MP_GET_MEMORY_FUNCTIONS - -2014-08-07 Simon Sobisch - - * configure.ac: add new parameter --with-curses for explicit - selection of used curses library (including "no"); - better check of matching version header/library for GMP and BDB; - additional output of configuration summary to config.log; - respect --quite (don't echo or printf to stdout) - -2014-06-20 Philipp Böhme - - * New folder build_windows - * Added project files for Visual Studio 2003 and newer - -2014-06-14 Simon Sobisch - - * General: Win compatibility: define COB_OBJEXT in defaults.h - -2014-04-14 Philipp Böhme - - * moved cobgetopt.c from lib to libcob - * link cobc to libcob - -2014-04-11 Simon Sobisch - - * configure.ac: bugfix for systems with prototype for finite function - in ieeefp.h instead of math.h - -2013-09-29 Brian Tiffin & Simon Sobisch - - * Change package name, and project to GNU Cobol - * GNU-ification of source code commencing - -2012-??-?? Roger While - - * General: Affects most directories - use a modified - version of getopt_long_long (placed in lib) - -2011-??-?? Roger While - - * General: Affects most directories - Let make check - skip ISAM tests if not configured with ISAM - -2010-06-28 Roger While - - * MARK - Version 2.0 - * Move to GPL/LGPL 3 - -2009-04-11 Roger While - - * configure.ac: Changes for BDB support, support icc - * General: Affects all directories - Rebase to latest stable - autoxxxx tools - -2009-03-12 Roger While - - * configure.ac: Fix for newest development tools - -2009-03-09 Roger While - - * configure.ac: Fix up m4 quoting - -2009-03-02 Roger While - - * configure.ac: Correctly test for gcc and icc - * cpucheck.c: Remove - -2008-11-17 Roger While - - * configure.ac: Correct sed usage - -2008-11-15 Roger While - - * configure.ac: Remove lfs64 option, reinstate --enable-debug - -2008-11-01 Roger While - - * configure.ac: nanosleep on Solaris needs extra libs - -2008-09-29 Roger While - - * Makefile.am: Revise format of tarstamp.h - -2008-08-20 Roger While - - * configure.ac: Option changes for AIX - -2008-08-16 Roger While - - * configure.ac: Fix AIX xlc - -2008-08-08 Roger While - - * configure.ac: Take out --enable-debug - * Makefile.am: Force permissions when making dist - -2008-07-05 Roger While - - * configure.ac: No need to check for regex or mvgetnstr - -2008-04-16 Roger While - - * configure.ac: Add in "copy" directory for OC supplied COPY elements - -2008-01-03 Roger While - - * configure.ac: Fix invalid usage of square brackets - -2007-12-29 Roger While - - * Bump version to 1.1 - -2007-12-27 Roger While - - * Release 1.0 - -2007-12-21 Roger While - - * configure.ac: Change order of checking various things - -2007-12-18 Roger While - - * configure.ac: Fix WITH_VARSEQ setting - -2007-12-03 Roger While - - * configure.ac: Add checks for headers/libraries when using - CISAM/DISAM/VBISAM - -2007-11-21 Roger While - - * configure.ac: Add --with-cisam, --with-disam, --with-vbisam - -2007-11-09 Roger While - - * configure.ac: Check for sizeof long int == long long - -2007-10-23 Roger While - - * configure.ac: Check for __attribute__((aligned)) - -2007-10-14 Roger While - - * libcob.h: Add gmp include for C++ - -2007-10-10 Roger While - - * General: bootstrap up to libtool 1.5.24 - * configure.ac: HP specific options - -2007-09-18 Roger While - - * configure.ac: Check for mvgetnstr in curses lib - -2007-08-31 Roger While - - * configure.ac: Fix insufficient tests for enable/disable - -2007-08-09 Roger While - - * configure.ac: Shared option for Solaris - New configure option --with-index-extfh, allows - usage of an external ISAM file handler - -2007-07-14 Roger While - - * configure.ac: Changes for AIX - -2007-06-27 Roger While - - * configure.ac: Check if we can use strftime to get timezone - -2007-03-13 Roger While - - * configure.ac: Check for sys/time.h - -2007-01-30 Roger While - - * configure.ac: Check for langinfo/iconv - * README: Update - -2007-01-25 Roger While - - * All: Update Coypright info on all files - * README: Update - SORT does not require BDB; Fix typo - * cpucheck.c: Uck, Intel, in their infinite wisdom, decided - to assign the same family to Core 2 Duo as - Pentium (pro/2/3). Check the model number. - -2006-10-25 Roger While - - * README: Update - -2006-10-23 Roger While - - * configure.ac: Remove gcc specific options from the - Makefile templates and pull it back into configure. - This should make building on non-gcc systems somewhat easier. - -2006-08-29 Roger While - - * General: FSF address change - * COPYING.DOC: New file, GNU Free Documentation license - -2006-08-28 Roger While - - * configure.ac: Implement --disable-param-check - and --enable-experimental - -2006-08-22 Roger While - - * configure.ac: BDB neeeds stdlib.h for 64-bit build - -2006-08-03 Roger While - - * README update - -2006-07-06 Roger While - - * configure.ac: Revise BDB >= 4.1 checking - -2006-06-29 Roger While - - * configure.ac: Revise BDB >= 4.1 checking - -2006-06-25 Roger While - - * configure.ac: Check for BDB version major/minor in db.h, - if >= 4.1 set extended BDB mode - -2006-05-24 Roger While - - * configure.ac: Fix check for GMP - -2006-05-05 Roger While - - * configure.ac: Fix default include in COB_CFLAGS - -2006-03-31 Roger While - - * configure.ac: Fix AIX64 AR/NM - -2006-02-18 Roger While - - * configure.ac: Define __USE_STRING_INLINES - -2006-01-26 Roger While - - * configure.ac: Add (OpenCOBOL) to configure help text - so that OC parameters can be easily seen - -2006-01-17 Roger While - - * configure.ac: Minor fixes - README: Put in a comment regarding spaces in path names - -2006-01-05 Roger While - - * Bootstrap up to libtool 1.5.22 / automake 1.9.6 - * configure.ac: Changes for AIX/HP/Sun - default to using system dynamic loading - pass LDFLAGS into COB_LDFLAGS - -2006-01-03 Roger While - - * configure.ac: pass CFLAGS into COB_CFLAGS, - default to using system dynamic loading - -2005-12-31 Roger While - - * Remove COBCRUN SHARE variable - -2005-12-30 Roger While - - * configure.ac: Check timezone/gettimeofday - -2005-12-21 Roger While - - * configure.ac: WITH_VARSEQ - Define the format of - variable length sequential files - -2005-12-13 Roger While - - * cpucheck.c: Revert to i686 with -mcpu/tune= - -2005-12-08 Roger While - - * configure.ac: Compile cpucheck with COB_CC. - Pass extra compile options as own define. - Put in a hack to stop CXX/F77 checking - - Anybody know a better way ? - -2005-12-05 Roger While - - * configure.ac: Pass down EXEEXT - -2005-11-25 Roger While - - * configure.ac: Fix typos, cater for DB 4.4 and 4.5 - Check for signal.h and sys/types.h - Clean up getopt - -2005-11-06 Roger While - - * configure.ac: minor help text cleanup - -2005-11-04 Roger While - - * configure.ac: Fix COB_CC not equal CC - -2005-11-01 Roger While - - * configure.ac: Fix missing EGREP - Check for various libdb's individually as libdb may - not be linked to newer version (or at all - Cygwin) - Check for ncurses.h in include/ncurses/ncurses.h - -2005-10-31 Roger While - - * configure.ac: Pick up -Wno-pointer-sign - and the visibility attribute - -2005-10-28 Roger While - - * configure.ac: Propagate endian value - -2005-10-27 Roger While - - * configure.ac: MAC (Darwin) has different options when creating a - shared library as opposed to creating a loadable module. - Pick this up and export it to the Makefile's. - -2005-10-26 Roger While - - * configure.ac: Fix DB checking again - * README: Minor corrections/additions - -2005-10-14 Roger While - - * configure.ac: Specify srcdir for cpucheck (make distcheck) - -2005-10-13 Roger While - - * configure.ac: Use basename for gcc - -2005-10-06 Roger While - - * README: Typo for Bison - -2005-10-01 Roger While - - * cpucheck.c: Some versions of GCC generate wrong SSE code - when compiling with P3/4 options. Stop this by also - specifying -mno-sse. - -2005-07-31 Roger While - - * Change configure default options for db, lfs64, ltdl - Add --with-patch-level= - * Add cpucheck.c to top level for configure - -2005-06-28 Roger While - - * Finally FUNCTIONS - -2005-06-13 Roger While - - * If ncurses not found, check for pdcurses - -2005-06-11 Roger While - - * New m4 macro cattribute.m4, autoreconf run - -2005-06-01 Roger While - - * configure.ac, configure: Change for MingW - -2005-05-27 Roger While - - * DB headers can also be in db4/ db4.1/ db4.2/ db4.3/ - -2005-05-21 Roger While - - * Allow configure option --with-dl for native dynamic - linking instead of ltdl. This is a win eg. on Linux - as native dl is anyway used. - -2005-05-17 Roger While - - * configure, configure.ac, all Makefile.in - Fix up COB_CFLAGS and COB_LIBS. - Cater for defining CPPFLAGS and LDFLAGS. - We have to propogate these to the compiler. - -2005-05-13 Roger While - - * CVS Version bumped to 0.33 - -2005-05-12 Roger While - - * Version 0.32 released - -2005-05-03 Roger While - - * configure.ac: Revert WORDS_BIGENDIAN. We do not need it. - configure.ac, configure, Mak**: Fix missing variables. - Run autoreconf - -2005-04-15 Keisuke Nishida - - * configure.ac (WORDS_BIGENDIAN): New variable. - -2005-04-13 Keisuke Nishida - - * configure.ac (LIBCOB_CFLAGS): Set -fPIC when necessary. - -2005-03-03 Roger While - - * configure.ac, configure, config.h.in : - Version to 0.32 - Pull out the hard-coded -shared from cobc.c - and define it in configure. - Get the strip command and put into config.h - * ltmain.sh: Latest version - -2005-02-07 Roger While - - * configure.ac: Check for cygwin/mingw on - cobcrun make - -2005-02-01 Roger While - - * Version 0.31 released - -2005-01-13 Roger While - - * configure.ac, configure, config.h.in - * Generate compiler/linker options in config.h - for exporting symbols and PIC code. - Will eventually be used by cobc.c. - -2004-11-29 Roger While - - * New directory bin for cobcrun driver program - * configure.ac, Makefile.am - -2004-10-30 Roger While - - * configure.ac, configure (over autoconf) : - Change entry point name check from __db_dbopen - to __db_open. This fixes configuring against - the NPTL versions of DB (eg. Red Hat, Suse). - -2004-08-02 Keisuke Nishida - - * Version 0.30 released. - -2004-03-06 Keisuke Nishida - - * configure.ac: Checks for fcntl. - -2003-08-22 Keisuke Nishida - - * libcob.conf: Removed. - -2003-06-12 Keisuke Nishida - - * Version 0.23 released. - -2003-06-08 Keisuke Nishida - - * Version 0.22 released. - -2003-05-19 Keisuke Nishida - - * Version 0.21 released. - -2003-04-26 Keisuke Nishida - - * Version 0.20 released. - -2003-04-19 Keisuke Nishida - - * cob.pc.in: Removed. - - * cobpp: Removed. - -2002-03-01 Keisuke Nishida - - * Version 0.12 released. - -2002-01-31 Keisuke Nishida - - * Version 0.11 released. - -2002-12-10 Keisuke Nishida - - * Version 0.10 released. - - * configure.ac: Updated for autoconf-2.57, and automake-1.7.2. - -2002-12-01 Keisuke Nishida - - * configure.ac: Updated for autoconf-2.56, automake-1.7.1, - and libtool-1.4.3. - -2002-11-08 Keisuke Nishida - - * libcob.h: Don't include support.h. - -2002-10-14 Keisuke Nishida - - * Makefile.am: Install libcob.conf in $(sysconfdir), not in - $(sysconfdir)/open-cobol. - * configure.ac (COB_CONFIG_FILE): Updated. - -2002-09-30 Keisuke Nishida - - * configure.ac: Updated for autoconf-2.54 and automake-1.7. - Do not generate libcob/cobconfig.h. - -2002-09-24 Keisuke Nishida - - * configure.ac: Generate libcob/cobconfig.h using AM_CONFIG_HEADER. - Check db.h as well as db1/db.h. - -2002-09-12 Keisuke Nishida - - * configure.ac: Add check for regex. - -2002-09-09 Keisuke Nishida - - * Makefile.am (deb, rpm): Removed. - -2002-09-06 Keisuke Nishida - - * configure.ac: Check for db1 instead of db2/db3. - -2002-09-05 Keisuke Nishida - - * Use pkg-config scheme. - * cob.pc.in: New file. - * cob.m4, cob-config.in: Removed. - * Makefile.am, configure.ac: Add cob.pc. Remove cob-config and cob.m4. - -2002-08-30 Keisuke Nishida - - * configure.ac (AM_INIT_AUTOMAKE): Option 'gnu' and 'no-texinfo.tex'. - (AC_FUNC_STAT, AC_HEADER_STAT): Removed. - (LTLIBINTL): Used instead of LIBINTL. - * Makefile.am (EXTRA_DIST): Don't include 'redhat' and 'debian'. - -2002-08-28 Keisuke Nishida - - * configure.ac: Use AC_LIBOBJ scheme. - -2002-08-27 Keisuke Nishida - - * HACKING: Use automake-1.6.3 and gettext-0.11.5. - * configure.ac (COB_COBPP): Don't set path. - (AM_GNU_GETTEXT_VERSION): Use gettext-0.11.5. - (AC_CONFIG_AUX_DIR): Set to 'config'. - -2002-08-05 Keisuke Nishida - - * configure.ac (LIBCOB_LIBS): Add $LIBINTL. - -2002-08-02 Keisuke Nishida - - * Version 0.9.7 released. - -2002-07-30 Keisuke Nishida - - * configure.ac (LIBCOB_LIBS): Set one by one. - -2002-07-29 Keisuke Nishida - - * configure.ac (COB_CONFIG_FILE): Use sysconfdir, not datadir. - * Makefile.am (libcob.conf): Install into pkgconfdir, not pkgdatadir. - -2002-07-01 Keisuke Nishida - - * configure.ac: Checks for ncurses. - - * libcob.h: #include - -2002-06-18 Keisuke Nishida - - * configure.ac (COB_MODULE_EXT): Convert dll.a to dll. - -2002-06-17 Keisuke Nishida - - * Makefile.am (EXTRA_DIST): Don't include config.rpath. - -2002-06-12 Keisuke Nishida - - * Version 0.9.6 released. - -2002-06-11 Keisuke Nishida - - * configure.ac (COB_MODULE_EXT): New variable. - * Makefile.am (defaults.h): Output COB_MODULE_EXT. - -2002-06-08 Keisuke Nishida - - * configure.ac: Check the existence of gcc (or cc). - -2002-06-04 Keisuke Nishida - - * libcob.conf (ding-on-error): New option. - -2002-06-02 Keisuke Nishida - - * testsuite: New directory. - -2002-05-31 Keisuke Nishida - - * configure.ac (maintainer-mode): Do not define. - (LIBCOB_LIBS): Include '-lm' - - * Makefile.am (DISTCLEANFILES): Renamed from CLEANFILES. - -2002-05-29 Keisuke Nishida - - * README, AUTHORS: Add more information. - * HACKING: Renamed from README.CVS. Add more information. - * Makefile.am: Include HACKING in the distribution. - -2002-05-29 Keisuke Nishida - - * configure.ac: Check readline only when --with-readline is given. - -2002-05-29 Keisuke Nishida - - * libcob.conf: New file. - * configure.ac, Makefile.am: Add 'COB_CONFIG_FILE'. - -2002-05-29 Keisuke Nishida - - * configure.ac, Makefile.am: Rename 'COB_LDADD' to 'COB_LIBS' - -2002-05-19 Keisuke Nishida - - * Version 0.9.5 released. - -2002-05-08 Keisuke Nishida - - * Version 0.9.4 released. - -2002-03-10 Keisuke Nishida - - * Version 0.9.3 released. - -2002-02-26 Keisuke Nishida - - * Version 0.9.2 released. - -2002-02-03 Keisuke Nishida - - * Version 0.9.1 released. - -2002-01-25 Keisuke Nishida - - * Version 0.9 released. - - -Copyright 2002-2020 Free Software Foundation, Inc. - -Copying and distribution of this file, with or without modification, are -permitted provided the copyright notice and this notice are preserved. diff -Nru gnucobol-4.0~early~20200606/cobc/ChangeLog gnucobol-5/cobc/ChangeLog --- gnucobol-4.0~early~20200606/cobc/ChangeLog 2020-06-06 20:51:59.000000000 +0000 +++ gnucobol-5/cobc/ChangeLog 1970-01-01 00:00:00.000000000 +0000 @@ -1,7496 +0,0 @@ - -2020-06-06 Ron Norman - * codegen.c: Changes to module entry to better handle - C mod calls COBOL mod calls C mod calls COBOL mod - -2020-06-03 Ron Norman - - * tree.c, typeck.c: fixed code for 'arithmetic-osvs' option - which computes intermediate results similar to IBM OSVS & MVS - It should take the largest decimal position usage in expression - -2020-05-26 Ron Norman - * codegen.c: In output_local_field_cache if REPORT field - then use output_emit_field - -2020-05-06 Ron Norman - * cobc.c: Added -G to experiment with 'gdb' and COBOL source - This is experimental and not for production. - * codegen.c: Added code to emit #line with reference only to - the COBOL source code. - 'gdb' sort of works but not good enough yet - -2020-05-05 Ron Norman - * flag.def, cobc.c, codegen.c: removed -fif-cutoff completely - -2020-04-27 Ron Norman - * codeoptim.def,codeoptim.c: Add COB_A_INLINE to new routines - to convert DISPLAY into binary values - * codegen.c,typeck.c: Additional refinements to computing - integer expressions faster. Now includes BINARY data - fields even on little endian systems. - -2020-04-26 Ron Norman - * codeoptim.def,codeoptim.c: New routines to convert DISPLAY into - binary values - * codegen.c: Use new get_numdisps/64/s64 routines - * typeck.c: Check for integer expression and emit faster arithmetic - code by using the C language to do the arithmetic - * flag.def: New flag -fno-fast-math to disable these changes - for additional testing - -2020-04-23 Simon Sobisch - - * parser.y: added ACCEPT with CURSOR parsing - -2020-04-22 Ron Norman - - * codegen.c: New internal function $: for emitting - a compare of integer values - - * typeck.c: Check for field that is native short/int/long - and emit direct C operators for add/subtract - instead of an inline function call - -2020-04-14 Ron Norman - - * typeck.c: Remove ERROR for OPEN I-O of LINE SEQUENTIAL - OPEN I-O is required for bi-directional pipe - * typeck.c: Remove ERROR for REWRITE of LINE SEQUENTIAL - This has been supported for a while - -2020-04-03 Ron Norman - - * codegen.c: Based on 'align-record' 01s & 77s in LOCAL-STORAGE - will now also be aligned as defined - -2020-04-01 Simon Sobisch - - * warning.def, cobc.h, cobc.c, error.c, field.c, typeck.c, parser.y: - new warning option -Wextra, replacing previous warningopt, allowing to - disable them or have them as error and fixing the previous behaviour - where -W effectively set them to be handled as error - * parser.y: removed some duplicate warnings and always raise PENDING, - not only in case of -W/-Wall - * tree.h, tree.c, error.c (cb_warning_dialect_x): new function, - possibly to be replaced later - * reerved.c: added COBOL 202x FUNCTION CONCAT - * tree.c (get_category_from_arguments): new function; - added missing implementation of "type of function depends on arguments" - and "check that arguments are of a matching type" - * tree.c, parser.y: changed "FUNCTION parameter" to "FUNCTION argument" - * typeck.c: FR #222 numeric checks for CRT STATUS (may be >= 4 digits) - -2020-03-31 Simon Sobisch - - * field.c.y (cb_validate_78_item): full validation and resolving - of level 78 value, even when not supported - * typeck.c (cb_validate_program_data): skip lvl 66 entries in odo-check - * parser.y, field.c: moved function (error_if_invalid_level_for_renames) - to field.c - * field.c (cb_validate_renames_item): reordered checks - * field.c (cb_validate_renames_item), tree.h: cb_validate_program_data - * typeck.c (cb_build_length): workaround for bug #623 RENAMES with length 0 - * parser.y (renames_entry): extended syntax checks for RENAMES - -2020-03-31 Ron Norman - - * codegen.c,config.def: Based on 'align-record' 01s & 77s will be grouped - into the same 'static cob_u8_t' and aligned on an address - boundary defined by 'align-record'. - If 'align-record' has a 0 value, then no grouping is done - Also 'align-opt' with 'yes' meaning like MF ALIGN"n OPT" - and the if 'no' then like MF ALIGN"n FIXED" - -2020-03-28 Ron Norman - - * config.def, cob.c, config.c: Added support for new config type of - CB_CONFIG_SIZE which may end with K, M, G (eg. 250M) - -2020-03-27 Edward Hart - - * parser.y (check_preceding_tallying_phrases): allow consecutives - CHARACTERS keywords (revival of bug #47). - -2020-03-27 Simon Sobisch - - * config.def, typeck.c: switched "select-working" to support option, - deactivated it (see bug #421) - -2020-03-22 Simon Sobisch - - * parser.y (call_body): warn ON EXCEPTION for CALL STATIC and ignore - it instead of having them mutually exclusive - * codegen.c (increase_output_line): fixed declaration of inline - -2020-03-11 Simon Sobisch - - * Makefile.am: honor new conditional MAKE_HAS_PREREQ_ONLY - * Makefile.am: adjusted invocation of help2man, using new defines - HELPSOURCES and HELP2MAN_OPTS - -2020-03-01 Brian Tiffin - - * cobc.c: bug #618, fix -j mode with -o name that includes a directory - and when multiple inputs are involved in a compile pass - -2020-02-13 Simon Sobisch - - * sqlxfdgen.c (output_xfd_file): fixed typo leading to broken reference - * codegen.c: cleanup for output_line_and_trace_info - -2020-02-12 Ron Norman - - * sqlxfdgen.c: Generate more database independent SQL column types - * codegen.c: Check for $XFD ALL being set which indicates that - all files are being defined for SQL use - Only emit filename.xd for INDEXED and RELATIVE files - -2020-02-10 Ron Norman - - * cobc.c, cobc.h, codegen.c, help.c, warning.def: - Add new define CB_ERRWARNDEF - -2020-02-09 Simon Sobisch - - * flag.def: adjusted some definitions CB_FLAG_RQ->CB_FLAG_NQ - -2020-02-09 Ron Norman - - * cobc.c, codegen.c, typeck.c, sysdefines.h, warning.def: FR #117 - report when the COBOL code is using a feature which GnuCOBOL was not - configured to support; - -Wunsupported is set to 'error' by default but can be downgraded - warning/error is given for unsupported use of - XML, JSON, file with ORGANIZATION INDEXED, extended screen-io - -2020-02-05 Ron Norman - - * codegen.c: emit warning if ORANIZATION INDEXED used but not supported - * typeck.c: emit warning if XML or JSON used but not supported - -2020-02-02 Simon Sobisch - - * cobc.c, cobc.h: added check for COB_UNIX_LF again, - externalized cb_unix_lf for use in sqlxfdgen.c - * parser.y, ppparse.y: removed support for Bison < 3, - fixing deprecation warnings - -2020-01-28 Ron Norman - - * sqlxfdgen.c, typeck.c: update to avoid C compile warnings - * field.c, codegen.c: update to avoid C compile warnings - -2020-01-24 Ron Norman - - * parser.y: add SUPPRESS WHEN "string" - * tree.h: removed CB_PREFIX_KEYS and added 'suppress' to cb_alt_key - * codegen.c: changed to no longer reference field in cob_file; - all setup for cob_file is now done with function calls - -2020-01-12 Simon Sobisch - - * parser.y, config.def: bug #513 (partial) added dialect option - cb_sync_left_right and if it isn't ignored warn again about it being - not implemented - * parser.y, tree.h: added flag_sync_left, flag_sync_right - (currently not taken care of in codegen!) - * parser.y, field.c, tree.h: removed flag_ignore_sync, instead handle - cb_binary_sync_clause == CB_IGNORE in (validate_pic) - -2020-01-11 Simon Sobisch - - * codegen.c (output_module_init): split module initialization into - calling of new generated function which includes every static reference - and the "local" part that references program-local variables, - fixing #611 RECURSIVE programs without correct source references - * codegen.c (output_function_prototypes, output_internal_function): - generate module initialization function and invoke it - -2020-01-02 Ron Norman - - * parser.y: Reenable READ ADVANCING/RETRY/IGNORE clauses - * codegen.c: Add code back for READ ADVANCING - -2020-01-04 Simon Sobisch - - * codegen.c (output_stmt): fixed bad check in file related statements - -2020-01-04 Edward Hart - - * cobc.h, parser.y, tree.h, typeck.c: strengthened ASSIGN syntax checks - (bug #553). - * config.def: added new options assign-variable, assign-using-variable, - assign-ext-dyn and assign-disk-from. - * config.def: improved assign-clause help. - -2020-01-03 Simon Sobisch - - * tree.c (cb_name_errmsg), tree.h, typeck.c (cb_emit_move): new function - for better error messages - * tree.c (cb_field_size), tree.h, field.c, typeck.c: use new define - FIELD_SIZE_UNKNOWN instead of -1 - * typeck.c (validate_move): skip truncation warnings if target and/or - source sizes are unknown - * codegen.c, tree.h: replacing old conflicting constant prefix s_ - by new CB_PREFIX_SCR_FIELD - * codegen.c: partially limited variable scope - * tree.c (cb_tree_category), tree.h: guard cb_category by CB_CATEGORY_ERROR - * error.c (print_error): used fixed COB_SMALL_BUFF instead of - unrelated system-specific BUFSIZ - * parser.y, reserved.c: PROGRAM-ID/FUNCTION-ID added prototype parsing - * parser.y, reserved.c, tree.h: added PROGRAM-ID IS RESIDENT - (without any codegen yet) - * parser.y, reserved.c: added parsing for ACUCOBOL transaction management - * parser.y: fixed parsing for ACUCOBOL's graphical control syntax - - screen and control options may be intermixed now - * parser.y, reserved.c: parsing for screen clauses ENABLED, VISIBLE, HELP-ID - * tree.h, parser.y, field.c, codegen.c, cobc.c: added CB_USAGE_CONTROL and - handling it which fixes several internal compiler errors for sources - that contain those - -2020-01-02 Ron Norman - - * sqlxfdgen.c: Check for SQL reserved words used as column names - -2020-01-01 Simon Sobisch - - * parser.y, field.c (copy_into_field), tree.h, config.def: - FR #193 implementation of SAME AS - * cobc.c: Copyright year update - -2020-01-01 Ron Norman - - * sqlxfdgen.c: Updates for ODBC interface - -2019-12-28 Edward Hart - - * config.c, config.def, ppparse.y, pplex.l: added ASSIGN directive and new option - implict-assign-dynamic-var (see bug #571). - * config.c: added options external (= ibm) and dynamic (= mf) to - assign-clause. - * typeck.c (cb_build_assignment_name): refactored. - -2019-12-23 Simon Sobisch - - * parser.y (sort_body): fixed class cast errors, - actually use the specified order if no data-name was specified - -2019-12-16 Ron Norman - - * sqlxfdgen.c: Outputs 'WHEN' conditions in 'posfix' sequence - -2019-12-15 Simon Sobisch - - * parser.y: bug #543 check for condition-name in ADDRESS OF - -2019-12-03 Simon Sobisch - - * codegen.c: minor refactoring for file related output - * parser.y: minor refactoring - use of set_current_field to remove - duplicated code, limit scope of some variables - * parser.y: new identifier_field (checked field-identifier), - adjustment of some msgIds (obviously not part of any test before) - -2019-12-01 Ron Norman - - * field.c, sqlxfdgen.c: Fix up some compile warnings - moved cb_parse_xfd from field.c to sqlxfdgen.c - -2019-11-30 Ron Norman - - * sqlxfdgen.c: Starter version to create DDL/XD files from record - descriptions and $XFD directives (more to come) - -2019-11-28 Ron Norman - - * Updates to prepare framework for generated - an exernal file description and SQL - and adding support for ODBC/OCI use for INDEXED file - -2019-11-18 Simon Sobisch - - * codegen.c (output_key_components): extracted - from (output_file_initialization) - * codegen.c (perform_label): minor refactoring - * codgenc.c: call output_storage instead of output where the result is - fixed to be in the header - * tree.h, parser.y: added flag_entry_for_goto to cb_field - -2019-11-18 Ron Norman - - * tree.h, parser.y, typeck.c: Updates to support - SET ... TO ADDRESS OF FH--FCD OF file - SET ... TO ADDRESS OF FH--KEYDEF OF file - -2019-11-17 Simon Sobisch - - * codegen.c (output_header): use current output target instead of - file pointer - * codegen.c (output_indent): replaced by new functions - (output_block_open, output_block_close) - * codegen.c: count lines in generated source file in output_line_number, - to do so adjust many calls to use the "correct" output function and never - include a newline within the output string - * codegen.c (codegen), tree.h, cobc.c: adjust function to get generated - sourcefile name, keep static reference to it in "output_name" - * flag.def, cobc.c: added flags for adjusted C source generation - -fgen-c-line-directives and -fgen-c-labels - * codegen.c (output_cobol_info, output_c_info): added - -2019-10-27 Ron Norman - - * tree.c: Correct computing size of REPORT lines and fields - -2019-10-25 Edward Hart - - * tree.c (cb_name_1): prevent buffer overflows (bug #586). - * parser.y (end_scope_of_program_name): free correct program when a - nested program has the same name as a containing program (bug #587). - * codegen.c, parser.y: fixed minor memory leaks. - -2019-10-17 Simon Sobisch - - * typeck.c (valid_screen_pos): inlining some macro-like functions back - * typeck.c (cb_validate_crt_status, valid_screen_pos): more validation - -2019-09-30 Edward Hart - - * parser.y, reserved.c: added more (D)OS/VS and ACUCOBOL APPLY phrases. - -2019-09-29 Edward Hart - - * parser.y, reserved.c: added detection of OS/VS-era I/O extensions. - * parser.y: added ASSIGN VARYING variant of ASSIGN USING. - * reserved.c (lookup_reserved_word): allow SELECT and I-O-CONTROL to - have multiple context-sensitive words occur in one sentence. - * config.def: clarified -fline-col-zero-default. - -2019-09-28 Ron Norman - - * typeck.c: If MOVE "literal" is all SPACES then process as - cb_space so MOVE SPACE & MOVE " " are identical - -2019-09-27 Ron Norman - - * typeck.c: Check for reference modification when using literals - -2019-09-26 Ron Norman - - * libcob/sysdefines.h: New header to keep system dependent #defines - * cob.c,cob.hi,codegen.c: Uses sysdefines.h - -2019-09-26 Ron Norman - - * typeck.c: Compile time checking of reference modification - is now based on reference-bounds-check config option - -2019-09-23 Simon Sobisch - - * codegen.c: moved alignment defines from libcob/common.h here - * cobc.h: moved alignment exception for hpux from libcob/common.h here - * codeoptim.c, cobc.h: generate the actual requested code w/o the attribute - __unaligned instead of overriding the attribute in the header - * tree.h: removed duplicate redefinition of atol/atoll - -2019-09-22 Ron Norman - - * codegen.c: Fix logic error in output_field_display - -2019-09-22 Ron Norman - - * parser.y: Fixed 'integer' to allow signed values in report - for example COLUMN +2 vs COLUMN 2 - when -std=xxxx has report-column-plus: yes - * codegen.c,field.c: Corrections to handling of COLUMN - With OCCURS COLUMN +num is no longer an alternative for STEP - -2019-09-15 Ron Norman - - * cobc.h: For HPUX set COB_ALLOW_UNALIGNED as undefined - * typeck.c: Emit ADD/SUBTRACT shortcut for COMP-5 only - if COB_ALLOW_UNALIGNED defined - * tree.h: Revert 'lock_mode' back to an 'int' - * codegen.c, debug.c: Changes for 'lock_mode' being an 'int' - * cobc.h: Add COB_MEM_SIZE as size of cob_mem_struct rounded up to - multiple of sizeof(long long) - * cobc.c: Use COB_MEM_SIZE as size of cob_mem_struct - To avoid aborts on system that requires aligned data - -2019-09-12 Simon Sobisch - - * scanner.l, parser.y: allow LENGTH *OF* to remove the ambiguity for - REPOSITORY. FUNCTION LENGTH INTRINSIC. and register LENGTH OF - -2019-09-09 Ron Norman - - * cobc.h: Add defines for COB_ALIGN_8 to set 8 byte boundary alignment - * codegen.c: Emit attributes and/or pragma to align 01/77 fields on - 8 byte boundary - -2019-09-04 Ron Norman - - * codegen.c: Set temp-field.data after all declarations to - avoid problems with some C compilers (SUN is one) - * typeck.c: Fix for use of cob_pointer_manip - * codeoptim.c: Adjust cob_pointer_manip to match usage - -2019-09-03 Ron Norman - - * tree.h: Add checks for C compiler presence of __FUNCTION__ - * typeck.c: Fix some #if to include missing conditions - -2019-08-28 Ron Norman - - * tree.h: Add flag_usage_defined - * parser.y: set flag_synchronized for [UN]SIGNED-SHORT/INT/LONG - set flag_synchronized for BINARY-C-LONG - * field.c: validate that group USAGE is compatible with any field usage - -2019-08-27 Simon Sobisch - - * cobc.c (process_command_line), flag.def: removed duplicated flag handling - by removing cb_flag_arithmetic_osvs and cb_flag_move_ibm - -2019-08-26 Ron Norman - - * cobc.h: Add extern cb_mf_ibm_comp - * tree.h: Add flag_ignore_sync - * parser.y: set flag_ignore_sync for BINARY-SHORT/LONG/DOUBLE - * field.c: test flag_ignore_sync for BINARY-SHORT/LONG/DOUBLE - which are never SYNCed - * flag.def : fix help info - * help.c : display -fibmcomp info - -2019-08-25 Simon Sobisch - - * common.h: allow to force aligned pointer access by external - define of COB_NON_ALIGNED - -2019-08-17 Simon Sobisch - - * typeck.c (cb_encode_program_id), parser.y, codegen.c, cobc.c: changed - method signature to remove unnecessary check for path separators and - do case folding as requested - callers use explicit COB_FOLD_UPPER for - functions now instead of additional folding after the call, also lead - to removing (user_func_upper) from codegen.c - * typeck.c (cb_encode_program_id): check for path separators now backwards - * typeck.c: removed duplicated code for program-id encoding - using libcob's new cob_encode_program_id with explicit check - for buffer size fixing bug #584 - * scanner.l (read_literal): fixed bug #583 buffer overflow - * cobc.c: PROGRAM-ID verification with explicit check for empty PROGRAM-ID - and cut of PROGRAM-IDs that are too long in the error message - * config.def (cb_lit_length): changed internal maximum length of a literal - from LONG_MAX to COB_MAX_LITERAL_LEN, a new define with currently 256k - * cobc.c (cobc_deciph_optarg): explicit check for integer overflow and - return INT_MAX in this case - -2019-08-14 Simon Sobisch - - * field.c (cb_evaluate_expr): return error_node on expression overflow - * field.c (validate_elementary_item): don't re-set f->flag_synchronized - depending on cb_mf_ibm_comp as the flag is not set because of the ignored - synchronized clause - * cobc.h, config.def: moved defines all CB_CONFIG_ANY entries to to new - enums: cb_binary_size_options, cb_binary_byteorder_options, - cb_assign_clause_options; used these instead of unsigned int - * field.c (compute_binary_size): switch over cb_binary_size - * typeck.c (cb_build_assignment_name): switch over cb_assign_clause - * field.c (compute_binary_size): removed superfluous check of cb_mf_ibm_comp - after checking a binary size which is never active with that switch - * field.c (compute_size): check cb_binary_size instead of cb_mf_ibm_comp - -2019-08-12 Simon Sobisch - - * scanner.l (scan_floating_numeric): fixed stack_overflow_buffer - reported by AddressSanitizer - * reserved.c: TOP as mnemonic CB_FEATURE_FORMFEED - * parser.y: added top_clause as we won't be able to define the mnemonic - as it duplicates a reserved word (FIXME: general adjustment needed) - -2019-08-11 Simon Sobisch - - * scanner.l, config.def: added support for HP COBOL octal literals - unfinished as its type should be context-sensitive (so far chosen - by scanner.l), configured by dialect configuration hp-octal-literals - * flag.def, cobc.c, help.c: moved -f[no-]ibmcomp out of flags.def and - activated the "non-flag" as "normal option" - -2019-08-01 Ron Norman - - * field.c: bug #582 add bounds check on expression stack and report error - -2019-07-14 Simon Sobisch - - * parser.y (special_name_list): better error recovery (at least as long - as one valid SPECIAL-NAMES entry was found) - -2019-07-13 Simon Sobisch - - * parser.y (emit_entry_goto, entry_name_list, entry_name), - typeck.c (cb_emit_goto_entry), config.def, tree.h, - codegen.c (output_goto, output_goto_entry): added extension - GO TO ENTRY / ENTRY FOR GO TO, intended mainly for generated code; - guarded by compiler configuration "goto-entry", defaults to warning - -2019-06-29 Simon Sobisch - - * pplex.l (ppinput): check for conflict markers (similar to GCC) - -2019-06-28 Simon Sobisch - - * pplex.l (ppcopy): ensure to have original errno, not the one from - one of the files in search path - * pplex.l (ppcopy) [_WIN32]: fixed EINVAL for path argument access doesn't - allow mixed slashes or anything before a partition identifier - * parser.y: extracted program_init_without_program_id - * parser.y: moved _options_paragraph references into _program_body - -2019-06-23 Simon Sobisch - - * cobc.c, codegen.c, pplex.l, ppparse.y, reserved.c, scanner.l, tree.c, - typeck.c: fixed possible arithmetic overflow - -2019-06-08 Simon Sobisch - - * config.def, parser.y: removed compiler support options cb_json_generate - and cb_xml_generate, as soon as those words are reserved we take those - statements as supported - -2019-06-07 Simon Sobisch - - * codegen.c (get_prev_ml_tree_entry): fixed null-pointer access with code - similar to use in other places - * tree.c, tree.h: added struct cb_next_elem to be used for any structure - that has a next pointer as first entry, to be used by (cb_next_length) - to get the size of the complete entry (only reasonable to call with the - "main" entry normally attached to a program) - * typeck.c (cb_validate_program_data): set alphabet->custom_list to error - node once seen as bad, partially limited variable scope - * tree.c (validate_file): explicit check for number of keys (limited - to MAX_FILE_KEYS, currently 255, per file) - -2019-06-06 Simon Sobisch - - * help.c: new file, extracted from cobc.c to limit the generation of docs - to actual changes in the help output; also separated help parts into one - function per help section - * Makefile.am, cobc.c, cobc.h: adjustments for help.c - -2019-06-05 Simon Sobisch - - * tree.h: allow compilation with compilers that don't have __func__ - -2019-06-02 Simon Sobisch - - * tree.c (cb_get_int): return 0 for cb_error_node not raise errors - on fields that got an error raised before - * parser.y: removed duplicate parts for integer handling, - disabled the non-standard "COL/LINE +1/-1" variant (which is not supported - by any known COBOL dialect, must be "COL/LINE + 1 / - 1") - * parser.y (set_record_size): extracted from (record_clause) variants - * config.def: added records-mismatch-record-clause - * parser.y (set_record_size), tree.c (finalize_file): handle record sizes - that don't match the record clause (auto-adjust file min/max) via - records-mismatch-record-clause as it is effectively a comment for IBM - -2019-05-31 Simon Sobisch - - * parser.y (restore_backup_pos): extracted for common use - * parser.y (evaluate_when_list), typeck.c (build_evaluate): assign and - use position of the WHEN clause for better error handling - * flag.def: don't suppress static call flags in help - -2019-05-30 Simon Sobisch - - * parser.y, reserved.c, tree.h, config.def: FR #311 added Fujitsu - specification of call convention by WITH ... LINKAGE, - added the two new c/s words PASCAL and C to the additional - implementor defined call-convention; - added configuration options for both extensions for specifying the - call-convention - -2019-05-20 Simon Sobisch - - * Makefile.am: setting of YFLAGS by configure instead of fixed AM_YFLAGS - -2019-04-28 Simon Sobisch - - * parser.y (line_keyword_clause): added missing RW line syntax variants - * parser.y (_acu_size): initial parsing for size specification on pointers - -2019-04-15 Simon Sobisch - - * tree.c: removed superfluous inline prototypes for cb_ref/cb_try_ref - -2019-04-12 Ron Norman - - * typeck.c: If field has children with OCCURS UNBOUNDED then do - cob_check_ref_mod at runtime and not compile time - -2019-04-07 Simon Sobisch - - * Makefile.am (COBC): use pre-inst-env ensuring to use the built version - * parser.y, typeck.c, tree.h, config.def: FR #354 added CONTINUE AFTER - to suspend runtime execution - * parser.y (begin_statement_from_backup_pos): new function used for postponed - statement start - -2019-03-26 Simon Sobisch - - * tree.c, tree.h: added cb_int7, cb_int8, cb_int16 - * parser.y: replaced cb_int(0,4,8,16) by pre-created cb_int0-cb_int16 - * typeck.c (cb_emit_open): replaced comparison of cached cb_int to compare - the actual integer value - * tree.c (cb_int): minimized struct int_node and access providing minimal - speed for integer lookup and minimal less memory consumption - * tree.c (cb_int_hex): fixed to not adjust hex-attribute of cached integers - by using a different cache - * codgen.c, tree.c, tree.h: deactivated hex-attribute of CB_INTEGER for now - (marked with USE_INT_HEX) as this increases the struct and we *should* - pass the flags as constants in any case - * tree.c (cb_int, cb_int_hex): disabled caching of integer values (other - than 0-8) for now (test, reactivate by defining CACHED_INTEGERS=1) as the - necessary lookup can take much time with many different integer values - -2019-03-25 Simon Sobisch - - * field.c (cb_is_expr, cb_evaluate_expr, create_implicit_picture): fixed - check of literal type before accessing values as literals in some places - * cobc.c (cobc_print_info): output endianess and native EBCDIC - -2019-03-24 Simon Sobisch - - * codegen.c (output_bin_field) [__SUNPRO_C]: split generated initialization - of the field into two statements as some compilers don't allow an - assignment of a local field there - after Ron Norman 2015 - -2019-03-23 Simon Sobisch - - * typeck.c (decimal_compute), tree.h: track if cob_decimal computations - will be used with new flag_decimal_comp - * codegen.c (output_standard_includes): additional include gmp.h when - cob_decimal is used in one of the generated (sub-)programs - * codegen.c (output_standard_includes): don't include currently unused - stdlib.h, stddef.h, math.h - * typeck.c (cb_resolve_debug_refs): fixed bug #570 invalid tree cast for - CD-entries with debug reference - * tree.c (cb_name_1), cobc.c (cobc_enum_explain): cater for CB_TAG_CD - -2019-03-19 Simon Sobisch - - * cobc.c: use of COB_MAX_NAMELEN - * cobc.h: comment-explanation for cb_flag_main / cobc_flag_main - -2019-03-18 Simon Sobisch - - * scanner.l, config.def: FR #352 added national-character-literals setting - and read of NC"" literals (identical to N"" literals) - -2019-03-17 Simon Sobisch - - * tree.c: improved error handling for wrong PICTURE clause, - including a new warning for uncommon parentheses and - only error once for same invalid character - * tree.c, tree.h, scanner.l, typeck.c, codegen.c, cobc.c: added compiler - part for floating-point numeric-edited item (libcob open) - * parser.y: added parsing for PICTURE clause locale-format - -2019-03-16 Simon Sobisch - - * parser.y: added unqualified_word which consumes qualification - checking that it does not occur; used for INDEXED BY and OCCURS KEY - * parser.y, tree.h, reserved.c, typeck.c: added parsing for - LOCALE/NATIONAL ALPHABET, NATIONAL COLLATING SEQUENCE and - COLLATING SEQUENCE OF key - -2019-03-15 Simon Sobisch - - * Makefile.am: drop yacc-compatibility warnings via AM_YFLAGS -Wno-yacc - as only bison is supported in any case - -2019-03-14 Simon Sobisch - - * config.c: hand-merged change 2015-04-27 with an option to go back, - see COBC_STORES_CONFIG_VALUES - -2019-03-12 Simon Sobisch - - * parser.y, typeck: implemented table SORT without specifying key, - see Patch #42 - -2019-03-11 Simon Sobisch - - * cobc.c (cobc_print_info): changed msgid for "file handler" and - already output if RTD-version of VB-ISAM is used (even if this - wouldn't work currently), partially after Ron Norman - -2019-03-10 Simon Sobisch - - * parser.y, reserved.c: added RAISE statement as PENDING - * parser.y: work on pending USE ON exception-name - * parser.y, reserved.c, cobc.h, tree.h, typeck.c: added APPLY COMMIT clause - from 202x draft as PENDING (making I-O-CONTROL mandatory for its clauses) - * typeck.c (cb_check_overlapping): do only the check, logic and messages - moved to (validate_move) - * parser.y: minor refactoring - -2019-03-09 Simon Sobisch - - * codegen.c: fixed freeing LOCAL-STORAGE memory using the wrong "free" - * codegen.c (output_function_prototypes): use expected declaration - for EXTFH modules to possibly catch modules using different interface - -2019-02-17 Simon Sobisch - - * parser.y: renamed build_nested_special -> build_words_for_nested_programs - * parser.y: fixed bug #566 nested programs do not inherit class-names - -2019-02-16 Simon Sobisch - - * parser.y, typeck.c: fixed bug #567 missing error recovery in conditions - -2019-02-09 Simon Sobisch - - * parser.y, tree.h, reserved.c: moved translation "word to system name" from - parser.y (mnemonic_name_clause) to reserved.c (get_system_name_translated) - * tree.c (cb_list_map), tree.h: directly check for error node, - return 1 if found - * typeck.c (cb_check_numeric_name, cb_check_numeric_edited_name): always - check for error node outside these functions, minor refactoring - -2019-02-05 Simon Sobisch - - * parser.y, tree.h, tree.c: splitted cb_category_is_national from - cb_category_is_alphanumeric - -2019-01-29 Simon Sobisch - - * tree.h, reserved.c, typeck.c: added SYSPUNCH/SYSPCH as CB_DEVICE_SYSPCH - * reserved.c: added S01-S05, currently internally as CB_FEATURE_FORMFEED - * typeck.c (cb_build_display_name): don't warn about - ACCEPT FROM / DISPLAY UPON device-name in IBM/MVS/MF mode - -2019-01-27 Simon Sobisch - - * cobc.c, reserved.c: fixed compiler warnings - -2019-01-20 Simon Sobisch - - * cobc.c (cobc_print_info): added note for cJSON - -2019-01-05 Edward Hart - - * general: added JSON GENERATE statement - * parser.y: added detection of JSON PARSE statement - -2019-01-04 Simon Sobisch - - * cobc.c (cobc_abort): increase error counter - * error.c, cobc.h (cb_add_error_to_listing): extracted from (print_error) - and extended to display source reference if error message is not cached - * cobc.c (cobc_err_msg, cobc_abort_terminate): include error message - in listing, if active - * cobc.c (print_program_trailer): prevent printing of NULL file / prefix - and respect cb_msg_style - * field.c (create_implicit_picture): fixed to not raise an abort for - FROM figurative-constant without PICTURE - -2019-01-04 Edward Hart - - * reserved.c (get_reserved_words_with_amendments): if a user reserves a - default reserved word, context-sensitivity is now preserved only if - they specify it - * reserved.c (default_reserved_words): fixed context-sensitive words - marked as not context-sensitive - -2019-01-02 Ron Norman - * field.c: Check for duplicate LINE in REPORT and ignore it - * codegen.c: Skip initialize to SPACES for REPORT lines as - all lines are cleared to SPACES - -2019-01-02 Simon Sobisch - - * field.c (set_report_field): renamed to (set_report_field_offset) - * field.c: refactored static functions and their calls to reduce - the number of calls and limited the scope of variables - -2018-12-31 Simon Sobisch - - * tree.c, tree.h, codegen.c, cobc.h: use EXTFH call per program, - not globally - * pplex.l, ppparse.y, scanner.l, codegen.c: implement CALLFH - directive (Micro Focus) - * reserved.c: fixed redefinition warning - * scanner.l (#LINE): removed unneeded temporary string duplication - * scanner.l (scan_x): minor refactoring and fixing compiler warning - * parser.y, reserved.c: added parsing for ADDRESS OF FH--FCD / - FH--KEYDEF OF file-name (context-sensitive to SET) - -2018-12-29 Simon Sobisch - - * typeck.c (validate_inspect): moved duplicate ref-mod size calculation to - (calc_reference_size) and fixed it to never skip the specified length - -2018-12-29 Edward Hart - - * reserved.c: replaced the array reserved_words and the list - amendment_list with hashmaps (see FR #295). - -2018-12-28 Edward Hart - - * codegen.c: fixed heap overflow by using strncmp instead of memcmp - * parser.y (split_key): fixed memory leak - -2018-12-28 Simon Sobisch - - * parser.y: fixed bug #564 by allowing INSPECT CONVERTING FROM/TO - alphabet names and removed functions from the possible list - -2018-12-04 Simon Sobisch - - * parser.y: finishing FR #244 missing-statement by allowing - WHEN expression with missing imperative statement (= directly - followed by END-EVALUATE or a separator period) - -2018-11-26 Simon Sobisch - - * cobc.c: fix listing issues when source is suppressed like printed - headers without data and missing output of errors - * flag.def: renamed new listing options according to NEWS and docs - * parser.y: msgid change "runtime elements" instead of unclear "sources" - -2018-11-25 Simon Sobisch - - * tree.c (cb_tree_category): correct category for reference-modified - NATIONAL/NATIONAL-EDITED items - -2018-11-22 Simon Sobisch - - * pplex.l, pparse.y: FR #344 Support copybook and library names - as text-names (not literals) with periods, always upper-cased - if not requested otherwise by FOLD-CALL=LOWER - -2018-10-28 Simon Sobisch - - * cobc.c [__ORANGEC__]: adjustments of command line options - -2018-10-24 Simon Sobisch - - * pplex.l: minor refactoring (creating ppecho_direct) and comments - -2018-10-15 Simon Sobisch - - * reserved.c (cb_list_registers): output "ADRESS OF" as "phrase" - -2018-10-13 Edward Hart - - * field.c (create_implicit_picture): handle case where f->screen_from or - f->screen_to are error nodes. - * parser.y (screen_description): prevent double free of level-number - field in error handling. - * parser.y (perform_body): fixed internal error with empty PERFORM. - -2018-10-12 Simon Sobisch - - * pplex.l: fixed TITLE being consumed as statement when actually starting - a user defined word - -2018-10-08 Simon Sobisch - - * parser.y: warn about unimplemented OPEN REVERSED / WITH NO REWIND, - see FR #343 - * parser.y: RM/COBOL compatibility - allow LOCK clause on - OPEN REVERSED / WITH NO REWIND - -2018-10-02 Simon Sobisch - - * typeck.c (cb_validate_program_environment, cb_validate_program_data, - cb_validate_program_body): only use the specified parameter - cb_program prog instead of current_program - * typeck.c (cb_validate_program_body): splitted cb_validate_labels() - and cb_resolve_debug_refs() to own functions - * typeck.v (cb_resolve_debug_refs): added size handling for cd-names - * parser.y (debugging_target), typeck.c (cb_resolve_debug_refs): - added check for duplicate reference of items in DEBUGGING procedures; - allow subscripts/refmod during parse to provide a clean check later - -2018-09-28 Simon Sobisch - - * parser.y: ACCEPT x FROM ESCAPE _key - * parser.y, reserved.c: extended parsing for ACUCOBOL-GT - DISPLAY WINDOW - -2018-09-27 Simon Sobisch - - * parser.y, reserved.c: added ACUCOBOL-GT statements - ACCEPT FROM TERMINAL-INFO / SYSTEM-INFO as PENDING - * parser.y: added parsing for explicit "NO" BELL - -2018-09-23 Simon Sobisch - - * tree.c (validate_indexed_key_field): added missing checked for - valid keys in files with split keys - * parser.y, tree.h, typeck.c: added NATIONAL COLLATING SEQUENCE - as PENDING - * cobc.h (CB_CS_OPEN), reserved.c: new context-sensitivity for OPEN - * parser.y: added extension duplicate clause on primary key as PENDING - and extension WITH NO DUPLICATES - -2018-09-22 Simon Sobisch - - * field.c (cb_validate_field): deactivated questionable incrementing - if reference-counter for GLOBAL fields - -2018-09-12 Simon Sobisch - - * parser.y (file_description_entry): unset current_file on error; - check for duplicate file description - * tree.c (finalize_file): check for missing file description - * tree.c (finalize_report): early set of flag_report - * typeck.c (warning_destination): added missing check for tree tag - * typeck.c (move_warning): allow literals in all contexts other - than SET to be used as source reference - * typeck.c (error_if_invalid_file_from_clause_literal): - allow [RE]WRITE FILE FROM constant / numeric literal if - cb_relaxed_syntax_checks is set as MicroFocus/ACUCOBOL allow this - non-standard option; only raise either figurative or literal error - -2018-09-11 Simon Sobisch - - * parser.y (evaluate_other): partial implementation of FR #288 - WHEN OTHER without imperative statement - * codegen.c (output_stmt): disabled lookup_source calls that seem - to be not needed - * parser.y (perform_body): partial implementation of FR #288 - check inline PERFORM without imperative statement against - configuration "missing-statement" - * cobc.c (process_command_line): make sure cb_missing_statement - is not stricter than CB_WARNING when cb_relaxed_syntax_checks is active - * scanner.l (copy_literal): check that passed argument is a literal - -2018-09-11 Ron Norman - - * tree.c, codegen.c: added checks for cb_flag_remove_unreachable - * scanner.l: duplicate 78/CONSTANT and then assign line number - * tree.c: improved warnings to be more inclusive - -2018-09-10 Ron Norman - - * tree.c: removed redundant warnings about xyz 'is always' TRUE/FALSE - * flag.def: new compile option: 'remove-unreachable' defaults to on - So then -fno-remove-unreachable does not remove unreachable code - * typeck.c: checks cb_flag_remove_unreachable - * cobc.c: if -g then clear cb_flag_remove_unreachable - -2018-09-06 Simon Sobisch - - * typeck.c (validate_move): always check full length for VALUE - without trimming the literal if alphanumeric - -2018-09-01 Simon Sobisch - - * codegen.c (output_module_register_init): partially fix bug #548: - used previous reference creation for XML registers - -2018-08-24 Simon Sobisch - - * typeck.c (cb_build_cond): keep source-reference for trace/position - code generation and compiler messages - * typeck.c (build_evaluate): store source-reference for WHEN OTHER - * tree.c (copy_file_line): disabled save/restore source-reference - of expressions as the current code works identical without it - * codegen.c (output_stmt): use source-reference of expression for - WHEN / WHEN OTHER, output its location to return correct position - for runtime messages and tracing - -2018-08-21 Simon Sobisch - - * parser.y: implemented MS-COBOL position-specifier for DISPLAY/ACCEPT - and DISPLAY ERASE - * parser.y, reserved.c: added COMP-0 as PENDING - * typeck.c: set reference for CRT-STATUS field on ACCEPT/DISPLAY - for cross-reference in listing - -2018-08-19 Edward Hart - - * general: added XML GENERATE statement. - * parser.y: added detection of XML PARSE statement. - -2018-08-17 Simon Sobisch - - * reserved.c: added COL/LIN registers (default to disabled) - * typeck.c, parser.y, cobc.h, tree.c, tree.h, field.c: first approach - on generic register creation (currently works only for TALLY/COL/LIN) - -2018-08-09 Simon Sobisch - - FR #219 Support for COMP-N (ACU compatibility) - * parser.y, reserved.c: added COMP-N/COMPUTATIONAL-N - * tree.h (cb_usage): new CB_USAGE_COMP_N - * cobc.c, codegen.c, field.c, tree.c, typeck.c: identical handling - for CB_USAGE_COMP_N as CB_USAGE_COMP_X - * field.c (setup_parameters): always use portable big-endian format - for CB_USAGE_COMP_N - -2018-08-07 Brian Tiffin - - * parser.y, reserved.c, tree.c, tree.h: CONTENTS-OF renamed to - CONTENT-OF - -2018-08-07 Simon Sobisch - - * typeck.c (cb_build_identifier): added missing validation for - depending item, fixing bug #544 - * typeck.c (cb_emit_arithmetic): early check for valid field, - provides better message for condition-names FR #339 and reduces - the number of errors in numeric checks to the first invalid part - of the statement - * typeck.c (cb_validate_one), parser.y (check_not_88_level): - FR #339 msgid change for invalid references - * typeck.c (cb_emit_string): added missing validation of delimiter - and source items, fixing bug #543 - * parser.y (check_not_88_level): invalidate wrong items to prevent - multiple errors for same field - -2018-07-31 Ron Norman - * config.def: Added 'cb_length_in_data_division' and if 'no' then - LENGTH OF is not allowed for 78 VALUEs - * typeck.c: Checks cb_length_in_data_division - ACU Cobol variation on computing LENGTH OF occurs-fld - when no subscript is provided - * typeck.c: Improved checks for cb_pretty_display - All DISPLAY for LENGTH displays up to 10 digits as the - value is unsigned - * typeck.c: IBM does not allow LENGTH for 78 VALUEs - -2018-07-29 Ron Norman - * config.def: Added 'cb_occurs_max_length_without_subscript' - * typeck.c: Checks cb_occurs_max_length_without_subscript for - ACU Cobol variation on computing LENGTH OF occurs-fld - when no subscript is provided - -2018-07-19 Simon Sobisch - - * scanner.l: allow floating-point literals containing no digit after - decimal point in significand (explicit specified in ACUCOBOL docs) - * reserved.c, parser.y, field.c, tree.h: added parsing for VOLATILE clause - * typeck.c (cb_build_expr): use correct line number for warning - "suggest parentheses around AND within OR" - -2018-07-18 Simon Sobisch - - * parser.y: adjusted length_of handling to distinguish constant-entry - from register - -2018-07-18 Edward Hart - - * typeck.c: added checks for (RE)WRITE FILE f FROM literal (bug #411) - * parser.y (file_control_entry): fixed regression caused when fixing - bug #405 - -2018-07-13 Simon Sobisch - - * reserved.c, parser.y: added IBM's ALLOCATE format by including the - ignored LOC phrase - -2018-07-12 Ron Norman - * parser.y: Set CB_CALL_BY_CONTENT for literal parameters - * codegen.c: Make copy of fields for BY CONTENT & BY VALUE - -2018-07-05 Ron Norman - * config.def: Added 'depending-on-not-fixed' - * codegen.c,tree.h: Made 'chk_field_variable_size' extern - * typeck.c: Added code for 'depending-on-not-fixed' - which checks if a DEPENDING ON field is in a fixed location - -2018-07-05 Ron Norman - * parser.y,scanner.l: Removed LENGTH_OF as it is no longer used - - * parser.y, scanner.l: removed LENGTH_OF as it is no longer used - -2018-07-04 Edward Hart - - * tree.c (cb_build_picture): fixed calculation of number of decimal - digits in PICs with floating +/- after decimal point, e.g. --.--. - See bug #220 - -2018-07-04 Ron Norman - * codegen.c: Fixed 'output_size' to compute size of OCCURS DEPENDING - for -fodoslide as well as when the field is BASED or - is in LINKAGE SECTION - * typeck.c: If destination of a MOVE is variable_size - and there is no reference mod (or start position is 1) - and the field is BASED or in LINKAGE SECTION - then emit code to MOVE fixed size header of field first as it - may be holding the DEPENDING ON fields/values - and then do a complete MOVE. - If the field is NOT BASED and NOT LINKAGE - then MOVE for the maximum size of the destination field - -2018-07-04 Ron Norman - - * parser.y: accept both LENGTH and LENGTH OF in all places - -2018-07-03 Simon Sobisch - - * codeoptim.c: removed inclusion of defaults.h (no definitions used) - -2018-06-29 Simon Sobisch - - * codegen.c (output_internal_function): fixed bug #98 "SIGSEGV - on CANCEL of RECURSIVE programs" by adjusting generation of - CANCEL callback - -2018-06-28 Ron Norman - - * typeck.c (cb_build_expr): fix bug #526 - Check for properly formed - 'Abbreviated conditional expressions' - -2018-06-26 Simon Sobisch - - * field.c (validate_usage): fixed SIGSEGV when PICTURE is missing - * field.c: renamed (check_picture_item) to (create_implicit_picture) - and always define an implicit picture (even for fields with errors - because of their references) - * field.c: renamed (check_picture_item, is_numeric_usage): define - numeric implicit pictures for numeric USAGEs - -2018-06-24 Ron Norman - * typeck.c: If destination of a MOVE is variable_size handle - starting position that is more than 1 and less than fixed - header of an ODO field - -2018-06-24 Ron Norman - * codegen.c: Fixed 'output_size' to adjust size by starting offset - * typeck.c: If destination of a MOVE is variable_size and - there is no reference mod (or start position is 1) then - emit code to MOVE fixed size header of field first as it - may be holding the DEPENDING ON fields/values then do - a complete MOVE. - -2018-06-24 Simon Sobisch - - * typeck.c (cb_emit_call): use X"nn" as name for error messages - concerning system library CALLs - -2018-06-21 Brian Tiffin - - * parser.y, reserved.c, tree.c, tree.h: added intrinsic functions - CONTENT-LENGTH and CONTENTS-OF - -2018-06-20 Ron Norman - - * codgen.c: emit code for 'Default Error Handler' in nested - subroutines when the main module has GLOBAL files, fixing bug #87 - -2018-06-06 Simon Sobisch - - * parser.y, reserved.c: added POS (only reserved for acu and default) - as alternative for AT POSITION, allow both in SCREEN definitions - * parser.y: improved ACUCOBOL-GT parsing of USAGE HANDLE: allow - HANDLE [OF] control-type (support pending), better error messages - for unknown HANDLE types - * parser.y, reserved.c: added COMP-0 as PENDING - * parser.y: added Micosoft COBOL position specifier - -2018-06-04 Simon Sobisch - - * Makefile.am: remove path output when creating manpage - -2018-05-24 Ron Norman - * tree.c: Limit compile time constant expression resolution - to values small than 9 digits. (To avoid a problem on macOS) - -2018-05-23 Ron Norman - * codegen.c: For report records, initialize to SPACEs and - when setting to a literal, skip clear of trailing spaces - -2018-05-21 Ron Norman - * cobc.c: If LANG is undefined in environment, then set it to "C" - * config.c: hand-merged change 2015-04-27 with an option to go back - -2018-05-16 Simon Sobisch - - * typeck.c (compare_field_literal): compare literals also against - group items - -2018-05-15 Ron Norman - * field.c: When -fibmcomp is used, COMP-5 as well as COMP-4/BINARY - should have the size computed as binary-size = 2-4-8 - -2018-05-15 Simon Sobisch - - * parser.y (usage_clause): better error message if USAGE is explicit - coded and an undefined word follows; this is especially helpful - for words that are only not reserved in the current dialect - * field.c (compute_size): fix error position for SNYCH dialect messages - -2018-05-14 Simon Sobisch - - * typeck.c (cb_check_overlapping): resolve one-level subscripts - for checking and warn if both subscripts reference the same - variable or numeric value - -2018-05-10 Simon Sobisch - - Fixed Bug #521 - issues with source cache: - * pplex.l (ppopen): deactivated changing \ to / in source names - * codegen.c (output_source_cache, output_string_cache, - output_gnucobol_defines): escape \ and " for output to C strings - -2018-05-08 Simon Sobisch - - * cobc.c: added OrangeC version info - * warning.def: fixed grammar in warning descriptions - * cobc.c, flags.def: use "* " instead of "- " to better distinguish - descriptions from options - -2018-04-26 Dave Pitts - - * cobc.c (reflow_replace_*_format_text): Changed to malloc token based on - newline length instead of hardcoded. - -2018-04-24 Dave Pitts - - * cobc.c (reflow_replace_*_format_text): BUG #515 malloc'd token to - large size. - * cobc.c (print_replace_text): BUG #515 malloc and realloc newline - based on length of tokens. - -2018-04-21 Simon Sobisch - - * parser.y, config.def: FR #306 added Fujitsu extension - SYMBOLIC CONSTANT in SPECIAL-NAMES, effectively defining - GLOBAL constants from literals, - adjusted by compiler configuration symbolic-constant - -2018-04-19 Simon Sobisch - - * pplex.l: FR #305 for now - skip Fujitsu @OPTIONS - -2018-04-15 Simon Sobisch - - * cobc.c: prevent output file name "-" for all levels but preprocess, - allow listing to be output to stdout with listing name "-" - * cobc.c, flag.def: replaced -tsymbols by -f[no-]tsymbols, - added option to suppress specific listing parts with new options - -fno-theader, -fno-tmessages, -fno-tsource (see NEWS) - * parser.y, reserved.c, typeck.c, field.c, tree.c: FR 303 - added USAGE BIT and PIC 1 as pending (at least parsing - of sources containing these should work now) - -2018-04-13 Simon Sobisch - - * codegen.c (process_command_line): minimal size for -tlines=20 - to prevent endless loops on typos like -tlines=2 - -2018-04-12 Simon Sobisch - - * codegen.c (output_internal_function): prevent SIGSEGV for - ANY LENGTH items in LINKAGE when program is first COBOL program - * tree.c (cb_build_intrinsic): leave size of national literals to - runtime (as it is done for national items), note: we currently - still generate national literals as alphanumeric literals - * parser.y, typeck.c (cb_build_const_length): allow non-numeric - literals to be used with LENGTH OF and prohibit use of numeric - literals as parameters for FUNCTION LENGTH/BYTE-LENGTH/LENGTH-AN - * parser.y, field.c (cb_validate_78_item): fix issues with invalid - VALUE clauses - -2018-04-09 Simon Sobisch - - * tree.c (cb_field_size): report ANY LENGTH items as "unknown size", - fixing Bug #511 - -2018-04-04 Simon Sobisch - - * codegen.c: cosmetic change - label exit_program/exit_function - depending on program type - * tree.h: moved definition of COB_MAX_SUBSCRIPTS to libcob/common.h - * tree.c (finalize_report): removed double check for field (which I've - added previously) - * codegen.c (output_report_def_fields), error.c (print_error), - parser.y (emit_entry), typeck.c (cb_build_move): - check pointer before dereferencing it - -2018-04-03 Simon Sobisch - - * cobc.c (process_translate): initialize cb_source_file with correct value - * parser.y (end_scope_of_program_name), tree.h (cb_program): store end - of program/function definition in last_source_line - * codegen.c (output_internal_function): output source location of program - / function end (to be set for fall-through end of its definition) - * tree.c (cb_build_program): store start position of program definition - * parser.y, typeck.c (cb_emit_call), tree.h: pass position of CALL in the - function call instead of a global variable - * parser.y: store position of entry points with (backup_current_pos) - -2018-04-02 Simon Sobisch - - * reserved.c (cb_register_list_get_first, cb_register_list_get_next), - typeck.c (cb_build_registers), tree.h: actually create register - definition, not only the name - -2018-03-31 Edward Hart - - * config.def, scanner.l: added zero-length-literals config option. - * scanner.l: make zero-length Boolean/hex literals default to zero. - -2018-03-30 Edward Hart - - * typeck.c (validate_move): fixed segfault with zero-length hex literal. - -2018-03-27 Simon Sobisch - - * typeck.c (build_cond_88): for VALUE THRU pass generation of this - clause by temporarily changing current_statement->name, changed - generation of the two conditions to the more natural variant - "var >= a && var <= b" instead of "a <= var && var <= b" - * tree.c (compare_field_literal): added warning for numerical values - when compared against their maximum value - * codegen.c (codegen): generate some comments only when relevant - -2018-03-26 Simon Sobisch - - * field.c (validate_any_length_item): fixed missing error position - * tree.c (word_hash): renamed from hash - * tree.c: check for alphabetic after checking for more common - USAGE/categories - -2018-03-25 Ron Norman - - * tree.c (warn_cannot_get_utc): removed as we always have it available - -2018-03-24 Edward Hart - - * tree.c, tree.h: emit error if RECORD VARYING has equal implied limits. - * reserved.c: replaced most instances of cb_strcasecmp with strcmp for - efficiency. - -2018-03-22 Simon Sobisch - - * tree.c (cb_fits_int, cb_fits_long_long, cb_get_int, cb_get_long_long, - cb_get_u_long_long): adjust literal size with negative scale - -2018-03-16 Simon Sobisch - - * typeck.c (cb_build_move): speedup, especially for programs not - defining any reports - -2018-03-14 Simon Sobisch - - * scanner.l, parser.y: new token LEVEL_NUMBER for clear separated - handling from WORD (and minimal speedup in scanning) - * field.c (cb_get_level, cb_build_field_tree): simplified level - handling as we only have valid level numbers in this tree - * parser.y (data_description): removed early free of level number - token that results in invalid calls to (cobc_parse_free) - * parser.y (_data_description_clause_sequence, add_body): simplified - * parser.y (usage_clause), field.c, tree.h: catch unknown USAGE - -2018-03-13 Simon Sobisch - - * cobc.c [__TINYC__]: added Tiny C version info and verbose option - * cobc.c: change for command line option --version / -V: - depending on verbose option additionally call C compiler - for more version information - -2018-03-12 Simon Sobisch - - * parser.y: unreached warning after EXIT SECTION/PARAGRAPH/PERFORM[CYCLE] - -2018-03-11 Simon Sobisch - - * typeck.c (validate_move): SET ... TO TRUE with figurative constant - * scanner.l: fix bug #499 tokenizer combining partial words - -2018-03-10 Ron Norman - * codegen.c,tree.h: Make chk_field_variable_size available - * typeck.c: If destination of a MOVE is variable_size then - emit code as if dest (1:) had been coded so entire - field is copied. To avoid ODO limiting length of MOVE. - -2018-03-10 Ron Norman - * codegen.c: Fix for INITIALIZE of signed numeric use 'cob_move' - - * codegen.c: Fix for INITIALIZE of signed numeric (2018-03-08) - -2018-03-09 Simon Sobisch - - * scanner.l (scan_floating_numeric): rewritten to merge 2018-01-12, - significant allows 36 digits now (according to COBOL 202x) - * typeck.c (validate_move): adjustments to merge 2018-01-14 - * typeck.c (validate_move), config.def: check for new config option - cb_move_fig_space_to_numeric / move-figurative-space-to-numeric - -2018-03-08 Ron Norman - - * codegen.c (deduce_initialize_type): use 'cob_move' for signed numeric - items to fix wrong group initialization (issue mentioned in bug #61) - -2018-03-08 Simon Sobisch - - * tree.c: actually handle items of CB_CATEGORY_NATIONAL / PIC_NATIONAL - as national items, not as alphanumeric - * reserved.c (function_list): adjustments for CB_CATEGORY_NATIONAL - * field.c (validate_any_length_item): adjustments for CB_CATEGORY_NATIONAL - * typeck.c (validate_move): added missing warning for truncation of - numeric binary fields when -fbinary-truncate is active; - removed false warning for truncation of literal to alphanumeric field - when only spaces were truncated - -2018-03-06 Simon Sobisch - - * tree.c (cb_name_1): adjustments for CB_TAG_REPORT/CB_TAG_REPORT_LINE - * field.c (check_picture_item): fixed tree cast error for setting - implied size/type for VALUE SPACE - -2018-03-05 Ron Norman - - Changes to solve REPORT problems related to COB_TREE_DEBUG - * tree.h: added CB_REF_OR_REPORT_P and CB_REPORT_PTR - * tree.c (cb_ref): verify caller passed a CB_REFERENCE - * parser.y: remove report_name_list, use CB_REF_OR_REPORT_P - * codegen.c, typeck.c: fixed problems found by COB_TREE_DEBUG - -2018-03-05 Simon Sobisch - - * Makefile.am (clean): remove output files generated by bison - * Makefile.am (maintainer-clean): remove generated manpage and all - files created by bison/flex - * pplex.l, scanner.l: fixed quoting of ' and " in regexes to - let xgettext process these files without error (also fixes - rendering in editors/ide's), note: generated C files are binary - identical - -2018-02-26 Simon Sobisch - - * parser.y (string_statement): fixed bug #497 STRING within - STRING did override the target list - * parser.y, reserved.c: work on FR #183 added VALIDATE statement - as PENDING - -2018-02-25 Simon Sobisch - - * codegen.c (output_display_fields): activated dump code for - BASED items - -2018-02-23 Simon Sobisch - - * codegen.c (output_module_init): cater for empty source_cache; - disabled generation of flag_debug_trace=COB_MODULE_DEBUG as - this is currently not checked anywhere - * warning.def: change cb_warn_filler to be always active - * error.c, field.c, tree.c, typeck.c: only raise some cb_warn_filler - warnings if -W/-Wall was used - -2018-02-21 Simon Sobisch - - * typeck.y (validate_move): check for ADDRESS OF var as invalid - (bug #495), fixed check for SET statement - -2018-02-19 Simon Sobisch - - * parser.y (select_clause): minimized context-sensitive settings - * reserved.c, cobc.h, parser.y: added CB_CS_SELECT - * tree.h: added password (reference) to struct cb_file / cb_alternate_key - * parser.y, reserved.c: added PASSWORD as PENDING (currently only for - indexed files) - -2018-02-17 Simon Sobisch - - * parser.y (report_description_option): fixed reference for CODE IS - * parser.y (page_line_column): adjusted check for duplicate LINE LIMIT - * codegen.c (output_internal_function): fixed position of - initialization for report files in INITIAL programs - * pplex.l, scanner.l: don't consume trailing whitespace/newline - if not necessary, combined some groups with optional/or modifiers - -2018-02-16 Dave Pitts - - * cobc.c (get_next_token): BUG #494 Fixed scanning of tokens with - embedded quotes, eg. 'yyy-'hello - -2018-02-15 Simon Sobisch - - * typeck.c (validate_move, move_warning): show literal size for - size overflow warnings (for numeric literals the actual literal) - * cobc.c (preprocess): FR #81 preprocess to stdout if no output file - is given (= revert back to behaviour of GnuCOBOL pre 2.x) - -2018-02-09 Simon Sobisch - - * reserved.c: renamed cob_strcasecmp to cb_strcasecmp - * reserved.c (default_reserved_words_list): removed EBCDIC handling - as the list is always sorted now - * reserved.c (initialize_reserved_words_if_needed): use case - sensitive comparison when sorting default_reserved_words_list - * field.c: adjustments for REPORT/SCREEN USAGE checks - * cobc.c, typeck.c, field.c, tree.h: moved (cobc_enum_explain_storage) - to typeck.c as enum_explain_storage - * typeck.c: minor refactoring of arithmetic_osvs code - -2018-02-02 Simon Sobisch - - * tree.c (cb_get_long_long, cb_get_u_long_long): fix bug #492 - adjusted literal size check - * tree.c, typeck.c, codegen.c: first approach to fix tree cast - errors in REPORTWRITER code - * codegen.c: moved parts of (output_funcall) to new functions - (output_funcall_typed) and (output_funcall_typed_report) - -2018-02-01 Simon Sobisch - - * cobc.c, tree.h [COB_TREE_DEBUG]: make sure that we don't enter - a loop of cb_tree cast errors, possible as (cb_name) is called - which may result in another call of (cobc_tree_cast_error); - removed compiler specific handling - * cobc.c (cobc_abort_terminate): add parameter indicating that - the user should report the error - -2018-01-30 Ron Norman - - * codegen.c: Fix generation of dump-code for fields with IS EXTERNAL - * parser.y: Have REPORT fields parse all USAGEs to provide - meaningful errors and to allow USAGE NATIONAL - * field.c: Add check for REPORT/SCREEN field not DISPLAY - 'fieldname' should be USAGE DISPLAY for REPORT/SCREEN - -2018-01-29 Ron Norman - - * tree.c, tree.h, typeck.c: Fine tuning of arithmetic_osvs - -2018-01-25 Simon Sobisch - - * parser.y, typeck.c: postponed check for dangling LINKAGE items - from entry point generation to program validation, allowing to - only warn items that are actually in use, checked in new - function (has_sub_reference) - * cobc.c (process_filename): set internal filename before checking - for valid name to get better error messages - -2018-01-25 Edward Hart - - * reserved.c (default_reserved_words_list): no longer assumed to be - sorted - this caused hard to understand errors when it - wasn't. (initialize_reserved_words_if_needed) now sorts it. - -2018-01-24 Simon Sobisch - - * reserved.c: added ACUCOBOL synonyms FLOAT -> FLOAT-SHORT, - DOUBLE -> FLOAT-LONG - -2018-01-23 Ron Norman - - * tree.c: fixed coding error to use CB_FIELD_PTR - * codegen.c, typeck.c: changed to use CB_FIELD_PTR as needed - -2018-01-23 Simon Sobisch - - * parser.y: use position of last section when defining an implicit - paragraph - * typeck.c (cb_build_identifier): adjusted debug checks for - EC-PROGRAM-ARG-OMITTED and EC-DATA-PTR-NULL - * typeck.c: minor code refactoring - -2018-01-22 Simon Sobisch - - * codgen.c (output_internal_function): don't clear sticky-linkage pointers - when program has CHAINING - * parser.y: added SAME phrase for screen i/o as PENDING - * field.c (compute_size): fixed check for report line - -2018-01-18 Simon Sobisch - - * typeck.c (cb_build_identifier): also check for ref-mod length - overflow when offset is is a variable - * typeck.c (cb_build_identifier): only build field name if actual - needed, moved code building to new static cb_build_name_reference - * tree.c (compare_field_literal): added check for comparisions against - a reference modified field when the offset or length is known - -2018-01-16 Simon Sobisch - - * typeck.c (cb_build_assignment_name): only warn ASSIGN EXTERNAL fname - interpretation when fname was changed - -2018-01-14 Ron Norman - - * typeck.c (validate_move), config.def: check for new config option - cb_move_nonnumlit_to_numeric_is_zero / move-non-numeric-lit-to-numeric-is-zero - and auto-convert MOVE LOW-VALUES/HIGH-VALUES/SPACES to PIC 9 DISPLAY field - into MOVE ZERO like MicroFocus does this - -2018-01-12 Ron Norman - * typeck.c,config.def: Check for config option - move-figurative-constant-to-numeric and - allow MOVE LOW-VALUES or HIGH-VALUES to PIC 9 DISPLAY field - Micro Focus allows this and some old COBOL code expects this behaviour - -2018-01-12 Ron Norman - * scanner.l (scan_floating_numeric): allow larger float constants - -2018-01-12 Simon Sobisch - - * config.def: added cb_missing_statement, see FR #288 - * parser.y (if_statement): first change for FR #288 leading to warning - message for "IF cond ELSE statements" - * tree.c (cb_build_reference, cb_ref), parser.y (procedure_name): - store position (section/paragraph) for all references not only for labels - * error.c (cb_verify_x, cb_set_ignore_error): never ignore errors that - depend on compiler configuration - * parser.y (procedure_name), typeck.c (cb_validate_program_body), tree.h: - don't raise errors for labels in ignored code parts and skip some - verifications on these - -2018-01-07 Simon Sobisch - - * codegen.c: moved all code parts for (output_function_entry_function) - to this function and adjusted the callers - * typeck.c, parser.y, tree.h: adjusted (cb_build_program_id) to directly - get the external name passed, removing duplicated code - -2018-01-03 Ron Norman - * codegen.c: For FUNCTION-ID copy RETURNING 'cob_field' - so as to avoid passing pointer to data in C stack - after 'return'; This should avoid a MS C compiler warning - -2018-01-03 Edward Hart - - * typeck.c (cb_build_move_literal): fixed bug #486, where literals moved - to an ANY LENGTH item where truncated to one character. - * typeck.c (validate_move): fixed spurious "value exceeds data size" - warning for ANY LENGTH items. - -2017-12-31 Ron Norman - - * codegen.c, tree.c: fix bug #471 Mark report fields as being - referenced so that the cob_field is always emitted - -2017-12-26 Edward Hart - - * cobc.h, config.c, field.c: added more lax "gc" option to - screen-section-rules. - -2017-12-25 Simon Sobisch - - * cobc.c, codegen.c, parser.y, scanner.l, tree.h, tree.c: renamed - CB_PROGRAM_TYPE to COB_MODULE_TYPE_PROGRAM and CB_FUNCTION_TYPE to - COB_MODULE_TYPE_FUNCTION and moved definition to libcob/common.h - * codegen.c (output_module_init): deactivated generation of currently - unused module_returning - -2017-12-24 Simon Sobisch - - * parser.y (file_status_clause): FR #51 added parsing for - secondary VSAM status, unconformable to any other than IBM/MVS - where it is ignored (with a warning with -Wall) - * config.c, cobc.h: parse standard-define, checking for valid entry - and actually setting it again - -2017-12-24 Edward Hart - - * config.def, config.c, field.c: added screen-section-rules option to - set rules for SCREEN SECTION item clauses. - * field.c: removed "alphanumeric value is expected" warning when using - numeric VALUEs in the SCREEN SECTION. - -2017-12-22 Simon Sobisch - - * tree.h, parser.y (begin_implicit_statement), codegen.c (output_stmt): - fixed duplicated trace code generation for implicit statements - -2017-12-22 Ron Norman - - * codegen.c (output_attr): set flag COB_FLAG_IS_FP for all FLOAT types - -2017-12-21 Ron Norman - - * codegen.c: For REPORT pass CODE value to report structure - * parser.y: pass back CODE value - -2017-12-17 Simon Sobisch - - * scanner.l (read_literal): fix endless loop on invalid literals for - systems that define EOF as -1 - -2017-12-15 Edward Hart - - * reserved.c: adding/removing a register now removes the reserved word - with the same name (if it exists) (feature request #278). - * cobc.c (cobc_print_usage): added help text for -f(not-)register. - -2017-12-15 Simon Sobisch - - * cobc.c (process_command_line) [_MSC_VER]: check if -l was specified - including ".lib" before adding it - * cobc.c (process_filename): don't allocate and set fn->object for - most used cb_compile_level == CB_LEVEL_MODULE as it is is compiled - without intermediate object file - * reserved.c (function_list): corrected number of parameters according - to all other checked implementations and the Programmer's Guide - (PRESENT-VALUE min 1->2, RANDOM max unlimited->1) - -2017-12-13 Edward Hart - - * tree.h: renamed special_index to index_type and replaced magic - constants with (cb_index_type) enum. - -2017-12-12 Edward Hart - - * parser.y (rep_name_list): handle case where $1 == cb_error_node - (bug #472). - -2017-12-12 Simon Sobisch - - * cobc.c: fix --list-registers to list these, not mnemonics... - -2017-12-11 Ron Norman - * codegen.c: For FUNCTION-ID and RECURSIVE, generate all LINKAGE - and LOCAL-STORAGE fields with the 'cob_field' on the function - stack instead of making them 'static'. If static then the fields - end up as a side effect with the same memory address which is - not correct. Additional change for C compiler issue of returning - a local variable. - -2017-12-11 Simon Sobisch - - * parser.y: set RW VARYING clause as PENDING - * parser.y: FR #167 added ACUCOBOL CONTROL KEY as PENDING - * codegen.c, tree.c: fixed compiler warnings in RW code - * field.c, ppparse.def: removed constant evaluations of pointer size - by using COB_64_BIT_POINTER - -2017-12-11 Edward Hart - - * config.def, field.c, parser.y: added binary-comp-1 option (feature - request #272). - * pplex.l, ppparse.y: added COMP1 directive. - * ppparse.y: removed redundant checks for well-formed literals. - * ppparse.y: slightly improved error messages for invalid directives. - * parser.y: added syntax checks for PAGE LIMITS clause. - * reserved.c: fixed COLUMNS not being detected by GnuCOBOL. - * parser.y (report_group_description_entry): added syntax error handler. - -2017-12-10 Edward Hart - - * reserved.c (get_reserved_words_with_amendments): no longer ignore - user-specified aliases for default reserved words. - * pplex.l, ppparse.y, reserved.c, scanner.l: added support for MF's - reserved word directives ADDRSV, ADDSYN, MAKESYN, OVERRIDE and REMOVE. - -2017-12-10 Simon Sobisch - - * parser.y: adjustments after merge of split/sparse keys from rw-branch, - minimized the number of necessary rules - -2017-12-06 Simon Sobisch - - * parser.y, tree.c, tree.h, typeck.c: minor adjustments after merge - of reportwriter branch - * codegen.c: adjustments after merge of reportwriter branch for - refactored code parts (no additional refactoring so far) - * cobc.c (cobc_enum_explain): added CB_TAG_REPORT_LINE - * cobc.c (process_run) [_WIN32]: change / in given output name to \ - -2017-12-04 Simon Sobisch - - * typeck.c (build_evaluate): error position improvement for - "wrong number of WHEN parameters" - -2017-12-02 Simon Sobisch - - * config.def, parser.y: FR #158 added cb_perform_varying_without_by - * parser.y: FR #168 adding missing compile time checks for - PERFORM BY ZERO - -2017-12-01 Simon Sobisch - - * cobc.c: FR 259 delete temporary files as soon as possible: - moved cleanup of intermediates for a single processed file - from (cobc_clean_up) to (clean_up_intermediates) and call this in - main after processing the single file - * parser.y, typeck.c: fixed some errors spotted by COB_TREE_DEBUG - -2017-11-30 Simon Sobisch - - * cobc.h, cobc.c (process_translate), codegen.c: local_filename with - additional attribute local_include_name as short name, - local_name containing the full name for file handling again - -2017-11-29 Simon Sobisch - - * error.c (undefined_error): always raise "not defined" error if - word is already qualified - * parser.y, reserved.c, cobc.h: FR #265 added parsing for ACUCOBOL - graphical controls, control styles, control properties and rough - parsing of INQUIRE and MODIFY statements - * tree.h, field.c (validate_pic, setup_parameters): set new attribute - pic->flag_is_calculated where picture wasn't originally specified - and don't check this pseudo PICTURE later. - * tree.c, tree.h: disabled pic->real_digits as it is currently not - in use anywhere (just calculated in tree.c) - -2017-11-25 Simon Sobisch - - * reserved.c: moved aliases VALUES/ZEROES/ZEROS to default.conf - -2017-11-25 Ron Norman - - Bug #175 fixed: LENGTH OF constants with grouped fields - * typeck.c: make sure field has been verified for constant LENGTH - * field.c: set pic.category for POINTER and ignore PIC for it later - * field.c (setup_parameters): set PIC 9(17) for pointer in 64 bit mode - -2017-11-23 Ron Norman - - * codegen.c: change in generation of comments concerning returning items - -2017-11-23 Ron Norman - * codegen.c: For FUNCTION-ID and RECURSIVE, generate all LINKAGE - and LOCAL-STORAGE fields with the 'cob_field' on the function - stack instead of making them 'static'. If static then the fields - end up as a side effect with the same memory address which is - not correct. - -2017-11-22 Simon Sobisch - - * parser.y, reserved.c: added parsing for ARITHMETIC clause - * parser.y, reserved.c, cobc.h: added context sensitivity for - SCREEN SECTION, adjusted reserved words to CB_CS_SCREEN and CB_CS_SET - * parser.y: renamed "not" to much more clearer "not_expr" to prevent - confusing it with "flag_not" - * reserved.c: moved aliases LOW-VALUES/HIGH-VALUES to default.conf - * parser.y: moved reset of cobc_cs_check from _mnemonic_conv to end of - call_statement - * reserved.c (lookup_reserved_word): fixed returning of context-sensitive - word without context (happened when the word *set* a context, too); - no auto-reset within CB_CS_SCREEN context - -2017-11-21 Simon Sobisch - - * cobc.c (process_run): fixed possible SIGSEGV for long run options, - use output_name, with stripped extension if necessary (see bug #466) - * cobc.c (process_translate): fixed bug #466 by removing path from - C source names after fopen - * cobc.c: fixed possible SIGSEGV for long COB_STRIP_CMD - * cobc.c (process_link): only add COB_EXE_EXT for running strip command - if is isn't already specified - * pplex.l (ppopen): fixed bug #467 by adding missing checks for - recursive sources before fopen - * cobc.c, error.c: allowed messages with filenames only, line number - isn't printed if -1 - -2017-11-20 Simon Sobisch - - * cobc.c (process_assemble, process_filename)[__OS400__]: fixed - SIGSEGV by ensuring bufflen to always include the size of the full - path for fn->translate and a minor memory issue by calling - cobc_main_free with original fn->translate before assigning it with - the full path - * cobc.c (process_assemble)[__OS400__, __WATCOMC__]: removed running - the created object file - * cobc.c: renamed cobc_stradd_dup to cobc_main_stradd_dup and added - a new version of cobc_stradd_dup that uses temporary memory - * cobc.c: added optional parameter to file_basename to specify which - extension to remove (if NULL all extensions will be removed) - * cobc.c (process_filename): use strcasecmp instead of strcmp - because of possible compilation on FAT/NTFS - * cobc.c: removed wants_nonfinal, directly check cb_compile_level instead - * cobc.c (set_compile_level_from_file_extension): new function to - adjust cb_compile_level if outputname was specified but no option - to set the compile level - -2017-11-15 Simon Sobisch - - * pplex.l, cobc.c: removed superfluous memset to 0 after cobc_malloc - in listing functions - * cobc.c, cobc.h: always store cb_source_format as enum cb_format, - using getopt return values for --fixed / --free instead as - getopt assigns an integer which is not guaranteed to be sizeof(enum) - * cobc.c (cobc_xref_call): bug #463 - fixed memory leak in Xref code - * cobc.c: modularized cleanup code to (cleanup_copybook_reference) - * cobc.c: bug #463 - reset cb_current_file->copy_tail on listing setup - * cobc.c: modularized processing of files from (main) to (process_file) - and separated functions (begin_setup_compiler_env), - (finish_setup_compiler_env), (begin_setup_internal_and_compiler_env), - (finish_setup_internal_env) from (main) function - -2017-11-14 Simon Sobisch - - * cobc.c: removed artificial limit for -fmax-errors - * cobc.c: FR #255 new command line option -O0 (short-opt: '0') for - disabling optimizations (new define CB_COPT_0), - postpone addition for -O option group to cflags - * tree.c (cb_int, cb_build_label): set source position for integers - and labels on tree creation - * parser.y: removed position setting for integers and labels - * parser.y (backup_current_pos, set_pos_from_backup): new functions for - position corrections (currently not used) - * codegen.c (output_call), parser.y (call_body): fixing bug #462 - don't generate static calls if ON EXCEPTION is given - -2017-11-13 Ron Norman - - fixed Bug #461: - * codegen.c: new function cb_init_codegen to clear local variables - * cobc.c: call cb_init_codegen after releasing cob_parsemem_base or - cobc_mainmem_base - -2017-11-12 Simon Sobisch - - * tree.h, tree.c, typeck.c: removed level_redundant_error and moved - the only part of it that was used once to typeck.c (validate_occurs) - * typeck.c (validate_occurs): check level before raising a warning on - use of level 01/77 OCCURS, warn with correct position - -2017-11-11 Simon Sobisch - - * typeck.c: increase size for DEBUG-CONTENT according to file record length - * codegen.c: initialize return_address_ptr to an existing label to ensure - that at least one label is available for computed goto, see bug 439# - -2017-11-09 Simon Sobisch - - * codegen.c (output_call): change to exception handling: only check for - exceptions that are the result of the current CALL - -2017-11-09 Simon Sobisch - - * reserved.c, typeck.c: add DEBUG-ITEM to be handled as register - * typeck.c: change definition of DEBUG-ITEM: DEBUG-LINE is alphanumeric, - DEBUG-NAME and DEBUG-CONTENT X(31) -> X(30) - -2017-11-07 Simon Sobisch - - * codegen.c: change to USE FOR DEBUGGING procedures - don't generate a - local cob_debugging_mode and use runtime setting instead - -2017-11-05 Simon Sobisch - - * parser.y: only switch CALL ... BY VALUE to BY CONTENT for a single - parameter and output its name - * warning.def, cobc.h: allow -Wno-other to suppress messages generated - because of "COBC_WARN_FILLER" - * warning.def, error.c, typeck.c: allow -Wno-dialect to suppress messages - generated because of dialect option value "warning" - * cobc.c: default cb_flag_computed_goto depending on COB_COMPUTED_GOTO - instead of a fixed list of compiler (version) defines - * flag.def, cobc.c, codegen.c: disabled -fif-cutoff (cb_if_cutoff, - gen_if_level), can be re-activated by -DCOBC_HAS_CUTOFF_FLAG (likely - to be removed completely later), see bug #456 - -2017-11-03 Simon Sobisch - - * pplex.l: fixed bug #458 by adding error handling for copybooks - that couldn't be opened because of external limits - -2017-11-02 Simon Sobisch - - * cobc.c: check missing evaluation of command line option; - code-coverage specific changes - -2017-10-31 Ron Norman - * flag.def: effectively remove use of -fif-cutoff by setting large - default. This code should be removed in the near future - * codegen.c: Emit code to use cob_global_exception - -2017-10-25 Ron Norman - - * typeck.c (validate_move invalid:) fixed bug #225 report - 'invalid SET statement' when appropriate - -2017-10-25 Simon Sobisch - - * Makefile.am: specify all generated source files in BUILT_SOURCES - that have to be built _before_ other sources, fixing parallel builds - -2017-10-24 Simon Sobisch - - * parser.y: fixed bug #454 suspicious warning with actual working - CURRENCY SIGN, better error messages for this clause - * error.c, cobc.c: changed message format back to old version, - see bug #455 - * typeck.c: fixed bug #266 - false error on duplicate characters in - class definition - * parser.y: added *parsing* for COBOL2002 options to specify class type - and referenced alphabet in SPECIAL-NAMES, CLASS clause - -2017-10-22 Simon Sobisch - - * Makefile.am: moved include of top_srcdir to AM_CPPFLAGS to prevent - user-specified CPPFLAGS to override own includes, see bug #452 - * cobc.c: minimal support for DJGGP, including generation of 8.3 filenames - * cobc.c: don't halt immediately on first PATH error during startup, - postponed until command line arguments are processed - -2017-10-18 Ron Norman - - * codegen.c (output_internal_function): Fixed problem with braces in - variable dump code - -2017-10-17 Ron Norman - - Fixed bug #449 - debug should not imply trace - * cobc.c: change so -debug does NOT set -ftrace - * codegen.c: set module flags on entry to indicate if module - was compiled with -debug or -ftrace[all] so that the module - is not traced at runtime unless it had been compiled with that - option - -2017-10-14 Edward Hart - - * typeck.c: refactored and improved variable names in external form - functions. - -2017-10-07 Ron Norman - - * codegen.c: correction for -fodoslide - -2017-10-06 Edward Hart - - * parser.y, tree.c, tree.h: added RECORD DELIMITER syntax checks. - * parser.y, cobc.h, reserved.c: added BINARY-SEQUENTIAL and - LINE-SEQUENTIAL phrases to RECORD DELIMITER. - * config.def: added config options for RECORD DELIMITER clause. - -2017-09-28 Edward Hart - - * parser.y (stop_statement): set context-sensitive flag (bug #433). - -2017-09-26 Ron Norman - - * Changes to catch Divide by Zero errors when on ON SIZE ERROR - * parser.y: - Indicate that there was no [NOT] ON SIZE ERROR - by setting handler_id to -1 - * typeck.c: Ignore handler_id if -1 - * codegen.c: Ignore handler_id is -1 then emit code - to set cob_exception_code to -1 to indicate there - was no ON SIZE ERROR clause and handle an error - accordingly - -2017-09-22 Simon Sobisch - - * cobc.c (cobc_abort_msg): output orig_program_id instead of C-converted - * codegen.c (codegen): adjust current_program used for error messages - during code generation of nested programs - * parser.y: fixed missing warning for pending CURRENCY SIGN other than '$' - * cobc.c, tree.c, tree.h: fixed #435 - nested programs had no access to - identifiers in its parent's scope: added next_program_ordered to - struct cb_program set in (restore_program_list_order) and used for - checking nested lookups afterwards - -2017-09-22 Edward Hart - - * typeck.c (cb_set_intr_when_compiled): #436 fixed timezone printf format - * cobc.c (cobc_enum_explain): added missing tags - -2017-09-21 Simon Sobisch - - * cobc.c: ensure correct order of the programs during processing - * codegen.c (output_param): added missing check after calling (cb_ref) - to prevent SIGSEGV, see Bug #435 - * typeck.c, tree.c: checked result of (cb_ref) where missing - -2017-09-18 Ron Norman - - * codegen.c: eemit decimal constants for all module types - * config.def: added boolean select-working, see bug #421 - SELECT RELATIVE KEY and ASSIGN fields must be in WORKING-STORAGE - * typeck.c: - Report 'declared outside WORKING-STORAGE' if 'select-working: yes' - and SELECT RELATIVE KEY or ASSIGN field is not in WORKING-STORAGE - * codegen.c: - When SELECT RELATIVE KEY or ASSIGN field is not in WORKING-STORAGE - Then set current data address in each OPEN and for RELATIVE files - on every I/O operation - * tree.c: - Fix compile time resolve of FUNCTION INTEGER with negative value - -2017-09-16 Edward Hart - - * parser.y, config.def: added free-redefines-position config option. - -2017-09-15 Ron Norman - - * flag.def,tree.c: - Added -finline-intrinsic, defaults to ON - In tree.c . cb_build_intrinsic . if arguments as constants - then for some functions the value is computed at compile - time. Some functions are not done due to difference in - precision expected by some test cases. - More could be done with this later... - -2017-09-15 Ron Norman - - * tree.c (cb_build_intrinsic): compute CB_INTR_LENGTH CB_INTR_BYTE_LENGTH - at compile time if field is fixed-length, non-national. - NOTE (Simon): other functions are postponed to later - -2017-09-10 Edward Hart - - * tree.c (cb_int): corrected bitmask. - * config.def, typeck.c: added line-col-zero-default and display-special- - fig-consts options. This reinstates GnuCOBOL's previous behaviour of - DISPLAYing a field on screen at the current position of the cursor and - disabling the MF DISPLAY SPACES extension. - * parser.y: increase number of places which accept ZERO (including SIZE - clause). - -2017-09-05 Edward Hart - - * tree.c (cb_int): add bitmask to suppress runtime loss-of-data warning - on Windows. - -2017-09-05 Simon Sobisch - - * typeck.c (cb_validate_program_data): temporarily disabled ASSIGN - fields with changing address (BASED + LINKAGE) to prevent SIGSEGV - until code generation is changed, see bug #421 - * codegen.c: changed generated newlines/comments for file initialization - -2017-09-04 Simon Sobisch - - * codegen.c, tree.c, tree.h, typeck.c: started to change compiler - internal variables to be unsigned int instead of int to prevent - C compiler warnings about a possible negative access to arrays - and sign mismatches in comparisons - * codegen.c: output comment for decimal constants only if we have - actually generate decimal constants - -2017-09-02 Simon Sobisch - - * reserved.c: adjusted some missing context-sensitive options - * reserved.c, parser.y: added parsing of PHYSICAL attribute in - LENGTH functions - -2017-08-28 Edward Hart - - * field.c (validate_field_1): refactored. - -2017-08-23 Edward Hart - - * cobc.c (cobc_clean_up): added calls to (plex_call_destroy) and - (ylex_call_destroy), *actually* fixing bug #407. - * pplex.l (ylex_clear_all): added calls to (cb_reset_78) and - (cb_reset_global_78) to prevent memory leak on abort (bug #417). - -2017-08-20 Simon Sobisch - - * tree.c: work on expression warning messages and added more - -2017-08-19 Simon Sobisch - - * cobc.c, flag.def, warnings.def, cobc.h: changed handling for - cobc --help, mainly to provide translators with context for msgids - * field.c: adjusted message for cb_warn_ignored_initial_val - -2017-08-18 Simon Sobisch - - * flag.def: always activate cb_flag_recursive_check by CB_FLAG_ON - * tree.c, codegen.c: assume RECURSIVE for -fno-recursive-check - -2017-08-18 Ron Norman - - * codegen.c: emit code for CALL to handle ON EXCEPTION - -2017-08-17 Ron Norman - - * scanner.l: Added SET_LOCATION when returning 'literal' - which is a 78/01 constant - * codegen.c: Emit cob_module_global_entry instead of cob_module_enter and - pass the 'entry' value (currently only set in rw-branch). - -2017-08-17 Simon Sobisch - - * tree.c: work on expression warning messages - -2017-08-18 Edward Hart - - * parser.y (screen_occurs_clause): marked as pending. - -2017-08-15 Simon Sobisch - - * typeck.c: bug #413 don't generate cob_check_based for UDF return fields - * cobc.c (xref_print): output marker for receiving references - -2017-08-14 Simon Sobisch - - * tree.c: fixed tree cast error for literals - * typeck.c (cb_build_cond): fixed tree cast error with cb_arithmetic_osvs - -2017-08-13 Simon Sobisch - - * cobc.c: added cobc_early_exit and adjusted exit calls to fix missing free - * ppparse.y: CDF: warn if compiler flag is unknown - * typeck.c: allow figurative constants to be used for CALL USING as - documented for IBM COBOL - -2017-08-12 Ron Norman - - * codegen.c: Place all code to clear Decimal Constant values under - label P_clear_decimal and invoke that code when 'entry' is -20 - -2017-08-11 Edward Hart - - * reserved.c: implemented (not-)register: DIALECT-ALL. - * codegen.c (output_internal_function): fixed C compile error when - RETURN-CODE register is disabled. - -2017-08-10 Edward Hart - - * cobc.c (cobc_clean_up): added calls to (plex_clear_all) and - (ylex_clear_all), fixing bug #407. - -2017-08-09 Edward Hart - - * config.c (cb_config_entry): removed extraneous free (bug #409). - * config.c (cb_config_entry): fixed indentation. - -2017-08-07 Simon Sobisch - - * parser.y, reserved.c, typeck.c, tree.h: adjusted and included - Patch #27 by Wim Niemans 2016-06-13 for FR #100 as PENDING - * field.c, tree.c: adjustments for EXTERNAL-FORM - * cobc.c, error.c, parser.y, typeck.c: msgid specific changes - -2017-08-07 Edward Hart - - * typeck.c: moved RELATIVE KEY validating code to - (validate_relative_key), called in (cb_validate_program_data). - * typeck.c (validate_relative_key): altered to check key is not the - associated file's records and improved category check. - * parser.y: added check that correct KEY clause is used with - RELATIVE/INDEXED files (bug #405). - -2017-07-29 Edward Hart - - * reserved.c (system_name_table): added switches USW-0 thru USW-31. - * field.c (validate_field_1): added warning for useless FULL clause on - numeric items. - * parser.y (error_stmt_recover): removed ELSE from list of verbs, - preventing recursion on syntax error in IF statements (bug #403). - -2017-07-27 Simon Sobisch - - * reserved.c: fixed bug #402 - optional WITH clause functional - * parser.y, reserved.c: FR #78 more phrases for DISPLAY WINDOW - * parser.y, typeck.c: FR #77 fixed HANDLE references - * parser.y, reserved.c: FR #190 minimal support for DISPLAY MESSAGE BOX - * parser.y, typeck.c: fixed SIGSEGV in cobc for DISPLAY OMITTED - -2017-07-26 Simon Sobisch - - * parser.y, reserved.c: added clauses COLOR and SIZE as PENDING - * parser.y: added ACCEPT FROM SCREEN as PENDING - -2017-07-27 Ron Norman - - * tree.c: - Improve warning messages for comparing literals to fields - -2017-07-23 Ron Norman - - * tree.c: Improve line number used in warnings about 'always TRUE/FALSE' - Check for IF/WHEN with NOT condition to resolve compile time expr - * typeck.c: Turn off ignore of errors as required - * codegen.c: Emit line # in C code for WHEN statements - -2017-07-20 Simon Sobisch - - * cobc.c: fixed memory overlap for long strings in listing title - * cobc.c [_MSC_VER](process_filtered): fixed cobc_free of NULL pointer - -2017-07-19 Ron Norman - - * typeck.c, parser.y, tree.h, tree.c: - Limit ignoring errors to IF, WHEN and PERFORM UNTIL - when the condition is resolved at compile time - * tree.c: When comparing a display numeric field to a literal - and the literal is longer than the field, the result - can be determined at compile time as TRUE or FALSE - -2017-07-18 Simon Sobisch - - * parser.y, tree.c: check both increased MAX_FD_RECORD and the new - introduced MAX_FD_RECORD_IDX depending on file organization - * config.c: for -fnot-reserved=word: additional to removing "word" - from reserved word list remove "word" from register, system-names - and intrinsic function list - -2017-07-17 Edward Hart - - * typeck.c (cb_expr_shift): corrected r1347 - only set expr_lh to NULL - if the token in parentheses is a relational expression (see bug #321). - -2017-07-17 Simon Sobisch - - * config.c: better handling of empty/comment only lines - * tree.h, tree.c, typeck.c: added explain_operator and used where - appropriate - -2017-07-17 Ron Norman - - * tree.c: in cb_build_binary_op provide details on why an - expression is always TRUE or FALSE and better indicate which - line this happened on - * tree.c: in cb_build_binary_op check for '@' parens operator - with a numeric literal inside the parens - -2017-07-14 Simon Sobisch - - * parser.y: only allow RETURNING/GIVING in EXIT PROGRAM/GOBACK - if RETURN-CODE register is not disabled; always return 0 on - STOP RUN if no RETURN-CODE register is available - * reserved.c, tree.h: new functions cb_register_list_get_first and - cb_register_list_get_next for iterating through all active registers - * typeck.c: modularize register creation - -2017-07-13 Simon Sobisch - - * config.def: added support options cb_move_fig_constant_to_numeric - "move-figurative-constant-to-numeric" and cb_move_fig_quote_to_numeric - "move-figurative-quote-to-numeric" - * typeck.c: re-allow move of figurative constants to numeric/numeric - edited fields, cater for new compiler support flags - cb_move_fig_constant_to_numeric and cb_move_fig_quote_to_numeric; - removed the explicit internal change in this case to ALL ZERO - * typeck.c, cobc.h, cobc.c: renamed cb_list_system - to cb_list_system_routines - * reserved.c, cobc.h, cobc.c: renamed cb_list_mnemonics - to cb_list_system_names - * reserved.c: added switch alias-names UPSI-0 to UPSI-8 - * cobc.c (cobc_enum_explain), codegen.c (output_param), tree.h: - added missing parts for CB_TAG_DECIMAL_LITERAL to fix - cast check errors - -2017-07-12 Simon Sobisch - - * typeck.c, parser.y, tree.c, codegen.c: checked the now optional fields - cb_return_code, cb_call_params, cb_sort_return before accessing them - * flag.def: removed -fsyntax-extension "cb_syntax_extension" because - there's no actual use any more as non-standard switches can now be - activated by compiler configuration and/or command line option - -fsystem-name=SW1 - * reserved.c: added ACUCOBOL synonym ABSOLUTE-VALUE for function ABS - -2017-07-11 Simon Sobisch - - * reserved.c: added functions for (de)activating registers, system names, - intrinsics; removed ext_system_table and added its entries as deactived - to system_table - * config.c: added options to (de)activate registers, system names, - intrinsics - * cobc.c: added --list-registers and -f[no-]intrinsic-function, - -f[no-]system-name, -f[no-]register - * parser.y: don't stop parsing on wrong entries in REPOSITORY - -2017-07-10 Simon Sobisch - - * cobc.c: FR #206 added -O3 option - -2017-07-09 Edward Hart - - * reserved.c: output a reserved word's aliases during --list-reserved - (feature request #214). - -2017-07-07 Edward Hart - - * codegen.c: Prevent undefined behaviour and fixed typos in RW code - -2017-07-07 Simon Sobisch - - * tree.c: RECORD KEY in SELECT does not support FD in name bug #331 - * tree.h: added cb_feature_mode for compiler features we can have - activated, disabled (by compiler configuration), or not implemented; - (cb_intrinsic_table): replaced "const int implemented" by - "enum cb_feature_mode active" - * reserved.c, tree.c: adjusted cb_intrinsic_table to use cb_feature_mode - -2017-07-06 Simon Sobisch - - * parser.y, reserved.c, typeck.c, tree.h: added parsing for ACU - extensions DISPLAY WINDOW, CLOSE WINDOW and DESTROY statements - -2017-07-05 Ron Norman - - * codegen.c, typeck.c, error.c, parser.y, tree.c, tree.h: - Updates to skip emiting code for IF, WHEN in cases where - the condition is resolved down to TRUE or FALSE at compile time - cb_error reports as 'Error (ignored)' when code is not being emitted - -2017-07-04 Simon Sobisch - - * error.c: don't output "[re]defined here" messages when there - is no actual location to reference - * parser.y, reserved.c: added ACU extension USAGE HANDLE (both generic - and typed variants), added parser part for ACU THREADs (started via - CALL/PERFORM) and THREAD statements (SET THREAD PRIORITY and STOP THREAD) - [nothing done in libcob yet] - * codegen.c, field.c: changes for USAGE HANDLE - -2017-07-03 Ron Norman - - * typeck.c: Move check for cb_warn_parentheses to cb_build_expr routine - so that the check is done before constant expressions get folded - -2017-07-03 Simon Sobisch - - * tree.c (cb_build_binary_op): raise "invalid expression" for - invalid elements instead of COBC_ABORT - * config.def, cobc.c (cb_build_binary_op): added cb_constant_folding - "constant-folding" configuration option to provide a way to disable - this optimization (which is active in nearly all conf-files) - * config.def: reordered for nicer help output - * warning.def, typeck.c (validate_move): renamed cb_warn_truncate - "-Wtruncate" to cb_warn_pos_truncate "-Wpossible-truncate" and - cb_warn_constant "-Wconstant" to cb_warn_truncate "-Wtruncate" - * config.def, scanner.l: renamed cb_acucobol_literals - "acucobol-literals" option to cb_acu_literals "acu-literals" - * parser.y: set context CB_CS_ALLOCATE and CB_CS_READ - -2017-07-02 Simon Sobisch - - * cobc.c (cobc_print_usage): added -std=rm and all strict variants - -2017-07-02 Ron Norman - - * field.c: Additional fix so that SYNC with -std=mf works as MF does - -2017-06-30 Simon Sobisch - - * config.c: allow support options to be prefixed with '+' - to override the valaue previous set only if it is less strict - ok and +warning => ok, warning and +ok => ok - * parser.y (terminator_warning, terminator_error): don't warn/error - for missing terminators that don't exist in the current dialect - -2017-06-24 Ron Norman - - * field.c: For COMP-2 and a few other align to 8 byte boundary - -2017-06-24 Ron Norman - - * field.c,tree.h: Fixed to carry USAGE, SYNC, SIGN LEADING/TRAILING - attributes from group item to elementary data field - Fixed SYNC so it aligns the same as Micro Focus on 2 or 4 byte - boundary only. - -2017-06-22 Ron Norman - - * codgen.c: emit dummy reference to 'frame_overflow' to avoid - C compiler warnings - -2017-06-22 Simon Sobisch - - * cobc.c, cobc.h, config.def, config.c, reserved.c: replaced - "specify-all-reserved" (cb_specify_all_reserved) by - "reserved-words" (cb_reserved_words) - * cobc.c (process_command_line): process -std= and -conf= even when - specified after --list-reserved - -2017-06-20 Dave Pitts - - * cobc.c: Added CALL cross reference functions. - * tree.h: Added CALL cross reference structures. - * typeck.c: Added CALL cross reference calls. - -2017-06-16 Simon Sobisch - - * Makefile.am: added CODE_COVERAGE parts as provided by AX_CODE_COVERAGE - * cobc.c, codegen.c, codeoptim.c, error.c, field.c, pplex.l, tree.c - typeck.c: surrounded exception ABORTs that cannot be tested by LCOV_EXCP - markers - -2017-06-16 Dave Pitts - - * cobc.c (reflow_replaced_fixed_format_text): listings: Fixed multiple - line output. - -2017-06-13 Dave Pitts - - * cobc.c (get_next_token): listings: Keep string as a single token. - -2017-06-13 Ron Norman - - * typeck.c: #306 check for misplaced operators and report error - -2017-06-12 Simon Sobisch - - * config.def: renamed "debugging-line" option (cb_debugging_line) - to "debugging-mode" (cb_debugging_mode) because of name conflict - with option -fdebugging-line to activate these lines - * parser.y, pplex.l: moved compiler verification for DEBUGGING MODE - from parser.y to pplex.l - * pplex.l: actual compiler verification for debugging indicators - -2017-06-10 Simon Sobisch - - * pplex.l: error on $SET var lit OVERRIDE (as this isn't available it was - interpreted as unknown SET OPTION) - -2017-06-09 Ron Norman - - * ppparse.y, scanner.l: pass OVERRIDE thru the - preprocessor to allow variables to be redefined - -2017-06-09 Simon Sobisch - - * pplex.l: remove trailing spaces and inline comments - for >> DISPLAY and $DISPLAY, remove surrounding quotation symbols - * typeck.c (cb_build_const_from): create numeric constant instead - of alphanumeric if the compile-time variable is numeric - -2017-06-07 Simon Sobisch - - * ppparse.y, config.def: only allow extension ">> DEFINE CONSTANT var [AS]" - depending on configuration option define-constant-directive - --> use plain >> DEFINE var [AS] literal for conditional compilation - and use 01 CONSTANT with/without FROM clause for constant definitions - -2017-05-14 Edward Hart - - * parser.y, config.def: part reverted r837 - allow incorrect - configuration section paragraph order with - incorrect-conf-sec-order option (see bug #224). - * parser.y (check_comp_duplicate): removed redundant code checking - for duplicate SOURCE-/OBJECT-COMPUTER paragraphs. - -2017-06-05 Simon Sobisch - - * cobc.c: prevent memory leak when options are specified multiple times - * cobc.c (print_program_trailer): correct program order in listing - for both with/without code generation - * cobc.c (process_translate): on processing errors set cb_flag_syntax_only - to not loose the information "no codegen occured" - * cobc.c: replaced --no-symbols (cb_no_symbols) by - -tsymbols (cb_listing_symbols) - * cobc.c: added (cobc_enum_explain_storage) to output - storage note in symbol listing - -2017-06-03 Simon Sobisch - - * config.def, pplex.l: renamed cb_eject_statement to cb_listing_statements, - added title-statement - * pplex.l, ppparse.y: added parsing for *CONTROL statement (PENDING) - and EJECT/SKIP1/SKIP2/SKIP3 + TITLE statements (either "removing" from - further handling [processed in cobc.c directly] or pass for example as - user-defined word) - * cobc.c: handle listing-directive statements for listing creation - -2017-06-02 Simon Sobisch - - * reserved.c, cobc.h, parser.y: added context check for OBJECT-COMPUTER - * parser.y: added missing parts to MEMORY SIZE (parsing only) - * parser.y: checking of segment values in SEGMENT LIMIT and SECTION, - allow segment numbers in declaratives (PENDING) - -2017-05-30 Simon Sobisch - - * pplex.l, ppparse.y: removed PAGE_DIRECTIVE (checked in pplex.l, - processed in cobc.c) - * pplex.l: don't skip separator period in directives, - combined common parts for directives in a single place, - better error handling for directives - * pplex.l: added MF extension $DISPLAY VCS = version string as PENDING - * cobc.c: directly pass the source_format to (line_has_page_eject), - (line_has_listing_directive) and process it there - * cobc.c: added (get_first_nonspace, get_directive_start) to correctly - process listing related directives - -2017-05-30 Simon Sobisch - - * pplex.l, ppparse.y: removed undocumented extension - "optional AS in $SET CONSTANT VAR [AS] VAL" - as this is a MF extension - MF doesn't allow the AS at all - * pplex.l, ppparse.y: implemented >> LEAP-SECOND directive (while keeping - the ON setting as PENDING) - -2017-05-29 Simon Sobisch - - * parser.y, typeck.c: adjustments of constant value changes - -2017-05-28 Ron Norman - - * field.c, typeck.c: check for misplaced operators in constant expressions - -2017-05-26 Ron Norman - - Work on constant values: - * checks for application 78 versus internal 78 and allow internal 78 - to get handled - * add constant-01 and constant-78 compile options - -2017-05-25 Simon Sobisch - - Work on constant values: - * parser.y, typeck.c, tree.h: tightened syntax checks for NEXT / - START OF as 78 VALUE - * typeck.c: set correct values for NEXT / START OF as 78 VALUE - -2017-05-24 Ron Norman - - Work on constant values: - * parser.y, typeck.c, tree.h: 78/CONSTANT accepts VALUE expression - * parser.y, typeck.c, tree.h: implemented NEXT / START OF as 78 VALUE - * ppparse.y, cobc.c, cobc.h: allow define list to be - searched outside of ppparse - * parser.y, typeck.c: implemented CONSTANT FROM - -2017-05-22 Ron Norman - - * codegen.c: create numeric literals with correct attributes - COB_FLAG_HAVE_SIGN | COB_FLAG_SIGN_SEPARATE | COB_FLAG_SIGN_LEADING - As this is how the literal is coded in the COBOL code. - -2017-05-21 Ron Norman - - * parser.y: accept ACUCOBOL SET var TO SIZE OF field, handle as - MOVE LENGTH OF field TO var - -2017-05-20 Ron Norman - - * codegen.c, tree.c, tree.h, typeck.c, codeoptim.c: Enhancements to - handle nested OCCURS DEPENDING ON including -fodoslide - -2017-05-18 Simon Sobisch - - * codegen.c (output_call): for static calls only generate parameters - up to the maximum number of the call, otherwise the static calls - cannot be resolved at compile time. - Note: currently only done for system library calls, we'd need an - external repository for doing this with other calls, too. - * typeck.c (cb_emit_call): warn if more than the max parameters is - used for system library calls - * typeck.c (cb_list_system): output min/max parameters for system - library entries - -2017-05-15 Simon Sobisch - - * parser.y: bug #373 - level 78 constants: only allow a single value - and no optional ARE - * parser.y: don't check the warning option for cb_warning[_x] twice - -2017-05-14 Ron Norman - - * typeck.c (cb_build_binary_op): use integer arithmetic for compile - time configuration instead of (pow) - -2017-05-13 Edward Hart - - * typeck.c (validate_move): make warning on numeric literals in VALUE - clause of numeric-edited items configurable (original patch thanks to - David Newall). - -2017-05-10 Dave Pitts - - * cobc.c: Added "Too many errors" message to listing. - -2017-05-08 Dave Pitts - - * cobc.c: Added code to generate listing when max error count exceeded. - -2017-05-07 Simon Sobisch - - * parser.y (emit_entry): checked RETURNING item for not having - REDEFINES clause, use field name instead of cb_name(reference) - -2017-05-01 Ron Norman - - * tree.c: improved resolving constant expressions at compile time: - now handles cases with decimal constants, too - * parser.y, typeck.c, tree.h: Implement arithmetic-osvs for conditions; - compute intermediate results to precision of variables used in expression - -2017-04-30 Ron Norman - * codegen.c,typeck.c: Update to handle figurative constants on CALL; - CALL xyz USING BY CONTENT ZERO and SPACES - -2017-04-30 Simon Sobisch - - * cobc.c, error.c, flag.def: added -fmax-errors / cb_max_errors - for early/late aborting depending on number of errors, defaulting - to the old value: 100 - * cobc.c: added -W[no-]fatal-errors for aborting on first error - note: this option takes precedence over -fmax-errors - * cobc.c: return 97 for aborts, not 99 as autotest recognizes 99 - as hard failure and we may want to check for aborts - * cobc.c: simplified --no-symbols option handling - -2017-04-28 Simon Sobisch - - * Makefile.am: using builtin rule for bison and cleaned rule for - flexx, moved hack for _MSC_VER to ../create_win_dist.sh - -2017-04-27 Ron Norman - * tree.h: replaced 'flag_anylen_done' with 'flag_data_set' - * codegen.c: enhancements to handle ENTRY USING BY VALUE/CONTENT - Emit code to check if being called from COBOL or C by checking - 'cob_glob_ptr->cob_call_name_hash' for a has value from the - subroutine name. If a match then the CALL came from COBOL, - else it was called from C. - When called from COBOL, the parameters are picked up using - 'cob_procedure_params' field descriptions - If called from C, ANY LENGTH gets set via 'strlen' - Use of COB_SET_DATA is reduced when field was setup on - subroutine entry - - * field.c: Specific error messages for ANY NUMERIC - -2017-04-27 Ron Norman - - * field.c: Specific error messages for ANY NUMERIC - -2017-04-27 Sergey Kashyrin - - * parser.y: Fix for CALL-CONVENTION (was broken) - * codegen.c: on Windows we need to output entries prototypes - with dllexport, otherwise they will not be seen. - * cobc.c: print_error_for_line cut continuation - snprintf returns -1 in MSC and on HPUX if max is reached - -2017-04-13 Simon Sobisch - - * cobc.c (print_fields, print_88_values): removed indent parameter as - we no longer indent by level number - * cobc.c: cb_listing_linecount and cb_lines_per_page as unsigned int - * cobc.c: finished implementation of -Werror - -2017-04-22 Edward Hart - - * parser.y (stop_statement): added support for STOP identifier. - -2017-04-22 Brian Tiffin - - * error.c, cobc.h, cobc.c, field.c, parser.y, ppparse.y, tree.h, - scanner.l, tree.c, pplex.l: cb_warning[_x] change with - preference argument, refactor undefined_error to account for new - prototype. - -2017-04-17 Edward Hart - - * cobc.c (process_translate): reverse program list in place so that - current_program doesn't point to last program in file (see bug #265). - * codegen.c: reinstated local variable current_prog removed in - r1309. (codegen) would leave current_program pointing to the last - program in a file, from which you cannot get the first program. This - caused the listing code to break (bug #265) because it assumed - current_program would point to the first program in the file. - -2017-04-13 Edward Hart - - * cobc.c: fixed buffer overflows and memory leaks in listing code. - * cobc.c, pplex.l: refactored listing code: added comments, - improved variable names and modularised code. - -2017-04-13 Simon Sobisch - - * typeck.c: don't generate DEBUGGING code for empty PERFORMs, - fixes #368 (SIGSEGV) - * cobc.c (cobc_sig_handler): don't ask for bug report on SIGPIPE - -2017-04-10 Brian Tiffin - - * codegen.c: remove use of cob_get_prog_pointer. - -2017-04-09 Simon Sobisch - - * parser.y: fixed missing initialization for programs without - PROCEDURE DIVISION - -2017-04-08 Edward Hart - - * cobc.c, codegen.c, pplex.l: fixed buffer overflows and double - frees in listing code, SORT of table with OCCURS DEPENDING 0 TO n - and when aborting compilation in the lexer. - -2017-04-04 Ron Norman - * codegen.c: - For LENGTH OF passed as parameter on CALL, build temporary - field so that the internal field is passed as S9(9) COMP-4 - This is to be consistent with other numeric literals as - CALL parameters. - -2017-03-31 Ron Norman - - * parser.y: allow ASCENDING/DESCENING and INDEXED BY to follow OCCURS - in any order with -frelax-syntax - -2017-03-31 Edward Hart - - * typeck.c (cb_emit_set_to): added error when trying to set address of a - non-01/77-level linkage item. Also improved error messages. - -2017-03-30 Ron Norman - * parser.y: - Fixed to allow ASCENDING/DESCENING and INDEXED BY - to follow OCCURS in any order with -frelax-syntax - -2017-03-30 Edward Hart - - * field.c (compute_size): padding for aligned OCCURS items should go - after the last item, not the beginning of the group (bug #155). - -2017-03-22 Dave Pitts - - * cobc.c, cobc.h: Added Error/Warning summary to listings. - * error.c: Added filename to error struct for summary. - * cobc.c: Added code to close and open append the listing file when - calling the external cross reference, cobxref. - -2017-03-21 Dave Pitts - - * cobc.c: Changed symbol listing indentation and added redefines clause - to symbol listing. - -2017-03-19 Ron Norman - - * codegen.c: fixed emission of decimal constants to go into program.c.h - -2017-03-19 Simon Sobisch - - * codegen.c: bug #364 moved (output_initialize_chaining) out of - (output_initialize_one), special handling for chaining only during - program initialization - * codegen.c (output_internal_function): [bugs:#354] generate code for - raising COB_FERROR_CHAINING when CHAINING program is not the - main program instead of when it is called the second time - -2017-03-19 Dave Pitts - - * cobc.h, pplex.l: Restored copy_tail functionality. The copy books were - not being chained for the listing processor. - -2017-03-19 Edward Hart - - * parser.y (setup_program_start): moved call to (cb_build_program) to - (setup_program), after the PROGRAM-ID has been checked for - redefinition (see bug #271). - * parser.y (file_control_entry): fixed bug #352 by not setting - current_file to NULL in invalid SELECT entries. - * parser.y (file_control_entry): added parser error handler so typos - don't define an erroneous SELECT entry. - -2017-03-18 Simon Sobisch - - * typeck.c (cb_check_overlapping): return a possible overlap if at least - one of the vars can have an assignment of a different address - * parser.y (end_scope_of_program_name): fix possible access of NULL var - * typeck.c [_MSC_VER] (cb_check_overlapping): silence wrong warning 6011 - -2017-03-12 Simon Sobisch - - * cobc.c, error.c: fix minor memory leaks in listing / configuration code - * field.c: fix mismatching memory allocation in picture handling - -2017-03-11 Ron Norman - - * codegen.c (output_call): Fixed #353 to correctly emit parameter for - CALL BY CONTENT with an INTRINSIC function - -2017-03-05 Simon Sobisch - - * parser.y: fix #362 one-liner not generating by setting entry_convention - -2017-02-18 Simon Sobisch - - * parser.y: do (setup_program_start) early in IDENTIFICATION DIVISION - if given, otherwise in PROGRAM ID / FUNCTION ID as we did before - -2017-02-06 Ron Norman - - * codegen.c: - Emit routines cob_file_external_addr, cob_file_malloc, cob_file_free - so that 'cob_file' is allocated within libcob - This will allow the structure have fields added to the end - without forcing a recompile. COB_FILE_VERSION is unchanged - Emit cob_module_free so that structure gets freed within libcob - -2017-02-06 Simon Sobisch - - * tree.c: fixed use of warn_cannot_get_utc while available - -2017-02-02 Brian Tiffin - - * cobc.h: Updated CB_PENDING CB_UNFINISHED macros with quieter ONCE_COB - -2017-02-02 Brian Tiffin - - * cobc.h, warning.def: test cb_warn_pending in CB_PENDING message macro. - -2017-01-30 Ron Norman - - * codegen.c: emit call to pass address of file for dump of - specific fields such as FILE STATUS - -2017-01-30 Edward Hart - - * parser.y, reserved.c, tree.h: allow EXTERN, STDCALL and STATIC to be - disabled by mnemonics by removing (part of) their context flags. - -2017-01-29 Simon Sobisch - - * cobc.h: removed CB_CS_PROCEDURE, alphabetical order for CB_CS_... - * pplex.l, ppparse.y, cobc.h, parser.y, tree.c: - implemented CALL-CONVENTION directive - * parser.y, tree.h: removed cb_entry_convention - stored as - call-convention now - * parser.y, codegen.c: implemented entry-convention for entry points - including stdcall generation - * reserved.c, parser.y: removed WINAPI - -2017-01-25 Ron Norman - - * flag.def, cobc.h: new option -fdump= added (cb_flag_dump) - * cobc.c: added code to set cb_flag_dump - * cobc.h: added defines for values - * codegen.c: added code to emit calls to new trace & dump routines - -2017-01-22 Simon Sobisch - - * parser.y: fix bug #271 by raising an error on UDF without PROCEDURE - DIVISION and generating a minimal entry when this occurs with a program - * parser.y: work on SIZE IS for items passed BY VALUE - * cobc.c (cobc_abort_msg): output "FUNCTION-ID" if we abort in a UDF - -2017-01-22 Edward Hart - - * cobc.h: added CB_CS_OPTIONS. - * parser.y: added the OPTIONS paragraph, with DEFAULT ROUNDED MODE and - ENTRY-CONVENTION implemented. - -2017-01-22 Simon Sobisch - - FR #194: generate a WinMain() function instead of main - * flag.def: new cb_flag_winmain / -fwinmain for generating a WinMain() - function instead of main when compiling as executable - * codegen.c (output_standard_includes): generate additional include - "windows.h" if cb_flag_winmain is active - * codegen.c (output_main_function): generate WinMain instead of main - if cb_flag_winmain is active - -2017-01-20 Brian Tiffin - - * tree.h: add PROCEDURE DIVISION entry convention types - * cobc.h: add CB_CS_PROCEDURE context test value - * parser.y: PROCEDURE DIVISION EXTERN support - * reserved.c: EXTERN, COBOL, WINAPI context sensitive words - * codegen.c: EXTERN program entry - -2017-01-19 Simon Sobisch - - * cobc.c: fixed output of error messages (result of previous change) - by adding and using (list_error_reverse) - * parser.y: reactivate check PROCEDURE DIVISION returning item needs - to be in LINKAGE SECTION - * codegen.c (output_internal_function): only allocate UDF RETURNING items - when in LINKAGE SECTION - -2017-01-18 Ron Norman - - * field.c: set COB_FLAG_REAL_BINARY to on for COMP-5 - * codegen.c: for numeric literals passed on CALL, COB_FLAG_REAL_BINARY is - not set on since the internal field is actually S9(9) COMP-4 - -2017-01-17 Ron Norman - - * parser.y: fixed coding errors in referencing CB_LITERAL before - verifying that the token is a literal in REPORT DIVISION - -2017-01-17 Ron Norman - - * codegen.c (output_integer) [COB_NON_ALIGNED]: insert (cob_u8_ptr) - before cob_get_pointer (..) for systems not allowing pointer arithmetic - on (void*) - -2017-01-16 Simon Sobisch - - * parser.y, reserved.c: some work on program-prototypes, - added parsing of COBOL 2002 NESTED phrase for CALL - * cobc.c, cobc.h, errror.c: removed error_tail and copy_tail - * cobc.c: fixed SIGSEGV in listing on machines where char is signed - and COBOL sources contain characters > 127 - * cobc.c: fixed SIGSEGV in listing when compiling from multiple sources - which all show errors - -2017-01-15 Simon Sobisch - - * tree.h, cobc.h, parser.y: removed unused cb_statement->statement and - its assignment from cobc_glob_line which wasn't set at all - * parser.y (begin_implicit_statement): copy attributes common and name - from current_statement when creating an implicit new current_statement - -2017-01-14 Edward Hart - - * tree.c (userbp): fixed bug #350 - caused by userbp initialisation not - matching current cb_intrinsic_table layout. - * tree.c (userbp), tree.h: made cb_intrinsic_table pointers const. - -2017-01-13 Simon Sobisch - - * cobc.c [_MSC_VER]: swapped order of parameters for C compiler - and linking so that -L options come before -l - * cobc.c: swapped order of setting and size calculation of compiler/linker - options to match the order used for the actual call - -2017-01-11 Simon Sobisch - - * tree.c (cb_name_1): output name for USER FUNCTIONs - -2017-01-11 Mário Matos - - * codegen.c (output_entry_function): - fixed bug #349 (compatibility for C89 / _MSC_VER < 1800) - moved - generation of pointer fields for BY VALUE items before any code - -2017-01-10 Simon Sobisch - - * cobc.c: Copyright year 2017 - -2017-01-10 Ron Norman - - * codegen.c: - For CALL statements parameters passed BY VALUE or CONTENT are copied - to a temporary variable with the attribute of COB_FLAG_CONSTANT. - This is done so that the subroutine will not accidentally try to - overwrite these parameter fields. - -2017-01-09 Edward Hart - - * parser.y (expr_token): restricted IS to before ZERO/classes/condition - words. - -2017-01-09 Simon Sobisch - - * typeck.c (cb_build_identifier): corrected minimum check for OCCURS - * cobc.c: updates for generation of cross reference / symbol listing - -2017-01-08 Simon Sobisch - - * cobc.c (print_program_header): print only one page header when -tlines=0 - is used and removed the " Page 0001" that would always be printed - * cobc.c: new function print_program_data for output of data to the list - file - needed for suppressing empty lines after page header and for - correct counting of lines per page - * cobc.h, cobc.c: moved all listing #define from cobc.h to cobc.c - * cobc.c, tree.h, tree.c, parser.y: added receiving flag to cb_xref_elem, - set it on appropriate places (especially from references) - -2017-01-07 Simon Sobisch - - * cobc.h: added CB_CS_ALLOCATE - * reserved.c: set context sensitivity: CAPACITY -> OCCURS, - INITIALIZED -> ALLOCATE, OCCURS - -2017-01-06 Simon Sobisch - - * typeck.c: always emit an internal move for WRITE/REWRITE if the FROM - clause consist of a literal - * typeck.c (cb_check_overlapping): fixed handling when called with a field - instead of with a reference (which is the case for level 88 validation) - * codegen.c (output_data): added resolve of CB_TAG_FIELD - -2017-01-05 Simon Sobisch - - * parser.y (accept_body): check that PROMPT and SIZE clauses are not set - for ACCEPT OMITTED (as these are ignored at run-time) - * typeck.c (cb_emit_accept): bugfix - extended ACCEPT wasn't used if the - only attributes set were: timeout || prompt || size_is - * cobc.c (cobc_sig_handler): fixed TODO about unused var - * cobc.c (process)[WIFSIGNALED]: use cob_raise instead of cobc_sig_handler - -2017-01-02 Simon Sobisch - - * cobc.c, cobc.h: new variable current_compile_time for resolving all - compilation dates, set by call to libcob's cob_get_current_date_and_time - * typeck.c (cb_build_registers): use time from current_compile_time - providing a higher precision and is identical to the listing which is - requested by COBOL 2002+ - * cobc.c, cobc.h, codegen.h: renamed cb_oc_build_stamp to - cb_cobc_build_stamp - * cobc.c: if -t listing_file is passed multiple times use the last option - value instead of the first one - * cobc.c, cobc.h, tree.c, tree.h, parser.y: numerous changes for generation - of internal symbol-table and cross-reference listing - nearly all - references are now stored in tree.c (cb_ref), ANY LENGTH/NUMERIC, OCCURS - with PICTURE or UNBOUNDED are shown correctly now, - references by parent/child only are shown, too - -2017-01-02 Brian Tiffin - - * cobc.h: test cb_warn_unfinished in CB_UNFINISHED message macro. - -2017-01-02 Ron Norman - - * cobc.c, warning.def: - renamed cb_warn_external_val to cb_warn_ignored_initial_val - -2016-12-30 Ron Norman - - * cobc.c --info, Give BDB version when being used - Also give VB-ISAM version info when used - -2016-12-29 Simon Sobisch - - * cobc.c: changes for -verbose, optional argument for verbose level, - -vv output shows information from the compiler, -vvv from linker, - -v -help shows help from compiler/linker, - -### shows external commands but doesn't execute them - * cobc.c (cobc_sig_handler): only ask for bug report if the signal isn't - a user-requested one - * codegen.c (codegen): reset pic_cache pointer - * cobc.c (xref_print): corrected size of numbuf - -2016-12-28 Simon Sobisch - - * typeck.c: disabled nested ODO as the current implementation - has too many flaws (see re-opened FR #99) - -2016-12-27 Ron Norman - - * typeck.c: Added checks for RELATIVE KEY field being - integer in WORKING-STORAGE and having no OCCURS - -2016-12-27 Simon Sobisch - - integrating patch #30 by Frank Swarbrick and make sure it works - * parser.y: finished OCCURS ... TO UNBOUNDED - * reserved.c: new token LENGTH_FUNC for BYTE-LENGTH, LENGTH, LENGTH-AN - * parser.y, tree.h, typeck.c: new var suppress_data_exceptions used with - LENGTH_FUNC for suppressing runtime checks for field-allocation - * typeck.c: passing additional parameters for table name / flag for ODO - in generation of cob_check_odo and cob_check_subscript - -2016-12-24 Ron Norman - - * cobc.c - Changed --info to say 'INDEXED file handler' - -2016-12-22 Simon Sobisch - - * cobc.c (main): bugs #346 moved compiler specific COB_CFLAGS from - to configure to provide transparency and full control to the user - -2016-12-22 Edward Hart - - * scanner.l, pplex.l: suppress unused function warning in clang. - -2016-12-22 Simon Sobisch - - * codegen.c: use global current_program instead of local current_prog - * cobc.c (cobc_abort_msg): part of fixing bug #344 - distinguish between compilation and final code generation - * cobc.c: added message for internal compiler errors to report them - * codegen.c (output_param): part of fixing bug #344 - check for field reference to prevent SIGSEGV - * typeck.c (cb_emit_move): fixing bug #344 check that MOVE target is - no label or program prototypes - * tree.c (cb_name): only use as much parsing memory for names as necessary - -2016-12-19 Simon Sobisch - - * parser.y, typeck.c: stricter syntax checking for WRITE|REWRITE FILE - -2016-12-16 Simon Sobisch - - * scanner.l: limit for ACUCOBOL literals: UINT_MAX - * tree.c: check for LLONG_MAX and define it if it is defined as - LONG_LONG_MAX / _I64_MAX - * parser.y, reserved.c: added ACUCOBOL line sequential - device names for ASSIGN - -2016-12-12 Simon Sobisch - - * parser.y, typeck.c, tree.h: FR#182 added ADD|SUBTRACT TABLE as pending - -2016-12-08 Simon Sobisch - - * cobc.c (cobc_print_info): output exact C compiler which was used - to build cobc and if GMP/MPIR header was used - -2016-12-06 Simon Sobisch - - * cobc.c (process_filename) [_WIN32]: check extension .asm along to .s - * cobc.c (process_compile) [!_MSC_VER]: use COB_PIC_FLAGS when compiling - to a module, surround the translation name by quotes - -2016-11-30 Ron Norman - - * parser.y, typeck.c: FR #170 implement WRITE|REWRITE FILE filename - -2016-11-30 Ron Norman - - * parser.y,codegen.c,typeck.c,tree.h,tree.c: - Compiler updated for handling the SHARING, RETRY, ADVANCING LOCK - and IGNORE LOCK phrases, Mainly for RELATIVE files now. - This is a 'work in progress' and more updates will follow to include - support for INDEXED and SEQUENTIAL files - -2016-11-22 Dave Pitts - - * cobc.c (print_program_code): Free replace text. Realloc replace text - instead of memcpy of source. - * pplex.l (ppopen): Only strdup filename if NULL. - -2016-11-21 Simon Sobisch - - * tree.c, parser.y: fixing tree cast errors (found by COB_TREE_DEBUG) - * cobc.c (print_88_values, get_next_listing_line): fix SIGSEGV for uncommon - long names / lines - * cobc.c: fix minor memory leaks in listing code - * pplex.l, cobc.h: commented copy_tail as it doesn't seem to be used - -2016-11-19 Edward Hart - - * parser.y, reserved.c, etc.: added complete recognition of all - COMMUNICATION SECTION syntax. - * config.def: added use-for-debugging config option. - -2016-11-07 Ron Norman - - * typeck.c, cobc.c, config.def: added code for 'move-ibm' option which does - MOVE same as IBM MVC instruction - -2016-11-16 Simon Sobisch - - * codegen.c (output_call_cache): fix bug #341 added generation of macro - check in C function declarations for static CALLs - -2016-11-15 Ron Norman - - * codegen.c ((output_call, output_bin_field)): - Numeric literals being passed BY REFERENCE or BY CONTENT - will have the value passed as PIC S9(9) BINARY - and now get the correct field attributes set. - -2016-11-14 Simon Sobisch - - * typeck.c (cb_trim_program_id): change warning message for remove of - spaces in program-id to be more specific and don't warn embedded spaces - -2016-11-13 Simon Sobisch - - * parser.y, typeck.c (cb_trim_program_id), tree.h: added code to warn - if SPACES are used in a PROGRAM-ID or CALL 'literal' plus the SPACES - are removed - -2016-11-12 Ron Norman - - * codegen.c ((output_call, output_bin_field)): Numeric literals being - passed BY REFERENCE will now get the correct field attributes set. - -2016-11-12 Simon Sobisch - - * parser.y: fixed extended_with_lock by differentiating between WITH - LOCK / NO LOCK / KEPT LOCK - * typeck.c (cb_emit_read): set read_opts COB_READ_LOCK and - COB_READ_KEPT_LOCK for I/O statements with KEPT LOCK - -2016-11-11 Dave Pitts - - * cobc.c, cobc.h: Multiple changes to support 5 digit variable size and - cross reference changes. - -2016-11-10 Simon Sobisch - - * tree.h: added cb_field->validation (First level 88 field, if any) - * field.c (cb_build_field_tree): add validation entry and sisters - * cobc.c (print_88_values, xref_88_values): use new validation entries - instead of checking all word references against the field - (huge! time saver and correct order) - -2016-11-09 Dave Pitts - - * cobc.c, cobc.h, parser.y, tree.h, typeck.c: Added internal cross - reference support. - -2016-11-07 Jim Rinn - - * parser.y (lock_mode): OR-ing SELECT settings into file->lock_mode as they - would override COB_LOCK_MULTIPLE (set in _lock_with) otherwise - -2016-11-07 Dave Pitts - - * cobc.c (print_88_values): Added to print 88 level values. - (print_fields): call print_88_values for a variable. - -2016-11-06 Simon Sobisch - - * cobc/cobc.c (print_program_header): changed the version string limit - (including patch level) to 14 digits - -2016-11-04 Simon Sobisch - - * parser.y (terminator_warning, terminator_error, terminator_clear): - COBC_ABORT for invalid calls, warn/error with current_statement and - only free stmt when it is valid (currently isn't the case when an alias - for a statement is used) - -2016-11-03 Simon Sobisch - - * config.c (read_string): fixing changes to pointer generated by - cobc_main_malloc (needs to stay for later cobc_main_free) - * error.c, cobc.h: defined own error procedure flex_fatal_error for - running cobc's internal error procedures (including showing the - current source/line of both the processed COBOL and the generated - flex source) instead of a simple error exit - * pplex.l, scanner.l [__GNUC__]: added pragma to ignore unused - functions there as flex generates unused ones - * Makefile.am: change to auto-edit of files generated by flex - -2016-11-02 Edward Hart - - * pplex.l (ppinput): fixed comment paragraphs being rejected in free - format (see bug #297). - * reserved.c (try_remove_removal): stopped freed memory being read. - -2016-11-02 Dave Pitts - - * cobc.c (main): Change calls from free() to cobc_free(). - -2016-11-01 Dave Pitts - - * cobc.c (print_program_code): Scan for "#line " and set line number. - * pplex.l (ppcopy): Restore old list file and emit "#line..." on error. - -2016-10-31 Dave Pitts - - * cobc.c (cobc_terminate): Added calls to print header/trailer. - -2016-10-31 Simon Sobisch - - * parser.y: renamed COB_MAX_FIELD_PARAMS to MAX_CALL_FIELD_PARAMS - * parser.y: bug #110 fix LENGTH OF not working in some places - * codegen.c: bug #314 (output_search_all): SEARCH ALL with ODO zero - did not exit early - -2016-10-30 Simon Sobisch - - * cobc.c: added cb_unix_lf to enable possible output of generated files - with unix lf (especially for listing files and testsuite) - * codegen.c (output_entry_function): don't generate "return" for - void functions - * parser.y, reserved.c, cobc.h: added part of COMMUNICATION SECTION - syntax for being able to check this in NIST - -2016-10-29 Dave Pitts - - * cobc.c (print_program_header): Changed to allow for 9 character - version field (eg. VV.RR.PPP). - -2016-10-28 Dave Pitts - - * cobc.h: Moved CB_LIST_PICSIZE here and increased length to 80. - * cobc.c (set_picure): Added picture_len argument and reorganized. - * cobc.c (print_fields): Added picture_len argument set to width of - listing. - -2016-10-27 Simon Sobisch - - * cobc.c (process_run): use COB_EXEEXT for systems that need it - * parser.y: added "local_" prefix for function parameters that used - identical names as static vars - -2016-10-26 Simon Sobisch - - * typeck.c: fixed checks of overlapping MOVE and don't raise warnings for - items in occurs as the check for this was borked - * warning.def, typeck.c: added new CB_NOWARNDEF -Wpossible-overlap for - items that only *may* overlap (-Woverlap only warns if overlap is sure) - -2016-10-25 Simon Sobisch - - * cobc.c. cobc.h: moved multiple #undef of internal used macros to cobc.h - * config.def: feature-request #173 added reference-out-of-declaratives - * typeck.c (cb_validate_program_body): use cb_reference_out_of_declaratives - * cobc.c (process_command_line): make sure cb_reference_out_of_declaratives - is not stricter than CB_WARNING when cb_relaxed_syntax_checks is active - -2016-10-23 Simon Sobisch - - * tree.h, tree.c, typeck.c, parser.y: fixed missing type changes - from int to cob_flags_t for functions using disp_attrs - -2016-10-23 Edward Hart - - * scanner.l: Fixed bug introduced in r1116 which broke lowercase comment - paragraphs. - -2016-10-22 Dave Pitts - - * cobc.c: added --no-symbols for symbol table listing - -2016-10-18 Dave Pitts - - * cobc.c (print_fixed_line): fixed SOURCEFORMAT VARIABLE bug - -2016-10-17 Edward Hart - - * scanner.l (RETURN): renamed to RETURN_TOK (see bug #330) - -2016-10-16 Simon Sobisch - - * typeck.c (cb_list_system): simplified, removed hard-coded values - * cobc.c: listing: allow page break to be disabled with -tlines=0 - -2016-10-15 Simon Sobisch - - * parser.y: improved checks for duplicate/conflicting clauses in ACCEPT - and DISPLAY statements (finished Edwards changes from 2016-10-02) - -2016-10-13 Simon Sobisch - - * codegen.c: fixed missing initialization of static_call_cache - * flags.def, cobc.c: added CB_FLAG_ON for compiler flags that are - active by default - * flags.def, codegen.c: added new cb_flag_c_decl_for_static_call as - CB_FLAG_ON, to create the option for disabling the auto-generation - of C function declarations for static CALLs - -2016-10-12 Simon Sobisch - - * parser.y: refactored handling of occurs to (setup_occurs) and - (setup_occurs_min_max) - * parser.y (setup_occurs): check for TO without DEPENDING (allow for - relaxed syntax) - * cobc.c (print_fields): print fixed size OCCURS without TO phrase - * ppparse.y (set_choice): fixed bug #328 SIGSEGV for SET SOURCEFORMAT - directive without active listing - * parser.y (mnemonic_name_clause): fixed buffer overflow on long - (unknown) system names - -2016-10-11 Dave Pitts - - * cobc.c: Added OCCURS TO to print_fields() and - corrected length printout. - Also added "-R" to TYPE field for REDEFINES. - -2016-10-08 Edward Hart - - * config.c: let reserved and not-reserved accept comma-separated lists - -2016-10-13 Ron Norman - - * typeck.c, config.def: added code for 'arithmetic-osvs' option - which computes intermediate results similar to IBM OSVS & MVS - -2016-10-02 Edward Hart - - * parser.y: improved checks for duplicate/conflicting clauses in ACCEPT - and DISPLAY statements - * codegen.c, parser.y, tree.h: introduced cob_flags_t typedef for - variables made up of bit flags - * parser.y: improved function names - * parser.y: improved support for ACUCOBOL screen phrases - * config.def: added no-echo-means-secure config option - -2016-09-28 Simon Sobisch - - * cobc.c: use at least one tab for spacing between option and text in help - * config.c: check range (defined in config.def) for all integer flags - -2016-09-27 Simon Sobisch - - * tree.c (cb_build_picture), config.def: feature-request #173 - compiler configuration pic-length for number of characters - in PICTURE clause - * config.c: check range (defined in config.def) for all integer flags - -2016-09-25 Simon Sobisch - - * codegen.c: fix bug #316 static linking with stdcall was broken - * new struct static_call_list (including convention and - return-type), removing return-type from call_list - * store call-convention and generate __stdcall modifiers if requested - * codegen.c (call_list_reverse, static_call_list_reverse): added for - keeping the generated variables in the same order it has in COBOL, - called in (codegen) - -2016-09-24 Edward Hart - - * reserved.c: changed reserved and no-reserved options to generate - amendments to the reserved word list so that specify-all-reserved can - be examined at the end of configuration processing (allowing it to be - unset after being set). - * cobc.c: removed -R/-reserve-all option. - -2016-09-21 Edward Hart - - * parser.y: added RETRY and ADVANCING ON LOCK as pending features. - * parser.y, reserved.c: made FOREVER context-sensitive. - * reserved.c (default_reserved_words): corrected year of standard from - 2008 to 2014. - * reserved.c (lookup_reserved_word): changed to allow context-sensitive - words to be activated by different words. - -2016-09-19 Ron Norman - - * codegen.c, tree.c, tree.h: added code to optimize handling of - 'decimal constants' in expressions - -2016-09-18 Simon Sobisch - - * typeck.c (cb_validate_program_data): moved check for record depending - to (validate_record_depending) and activated storage check - relax-syntax - can be used to compile legacy programs - -2016-09-16 Simon Sobisch - - * tree.c (finalize_file): bug #278 move key field checks - to (validate_key_field) and verify that variable record size - is at least large enough to hold the keys - -2016-09-16 Edward Hart - - * typeck.c (cb_build_move_literal): fixed bug #69 by forcing a call to - cob_move when binary-truncate is in effect. - -2016-09-15 Edward Hart - - * pplex.l (ppinput): fixed bug #297 where quote marks were parsed in - comment paragraphs. - * error.c, cobc.h: added (cb_plex_verify). - -2016-09-12 Edward Hart - - * parser.y (accept_clause): added ACCEPT ... BEFORE TIME extension. - -2016-09-11 Simon Sobisch - - * pplex.l (ppinput): bug #312 don't ignore directives starting with $ - at column 7 when in fixed format (if acucomment doesn't apply) - -2016-09-11 Edward Hart - - * ppparse.y, cobc.c: simplified implementation of variable format by - treating it as fixed-format with the program-text area ending at - column 250. - -2016-09-06 Dave Pitts - - * cobc.c: Rearranged pline allocation and added some checks. - Added pline_check_limit() function. - -2016-09-06 Dave Pitts - - * cobc.c: Changed the pline array to an array of pointers. - The lines are allocated and the allocation limits are checked. - If the the CB_READ_AHEAD is exceeded an abort is issued. - * cobc.h: Increase CB_READ_AHEAD to 800. - -2016-09-05 Edward Hart - - * cobc.c, cobc.h: delete references to cobc_init_scanner, which was - deleted in [r1100]. - -2016-09-04 Edward Hart - - * tree.c, scanner.l: replaced code parsing constant-names in PICTURE - strings with new implementation containing more checks. - -2016-09-03 Edward Hart - - * pplex.l, ppparse.y, cobc.c: added support for Micro Focus' variable - format. - * cobc.h: moved CB_FORMAT defines into new cb_format enum. - -2016-09-03 Simon Sobisch - - * tree.c (cb_concat_literals): allow concatenation of national and - Boolean literals - -2016-09-02 Simon Sobisch - - * cobc.h: added CB_UNFINISHED as replacement for CB_PENDING for code that - compiles and "works somehow" (not necessarily according to specs) - * cobc.c, cobc.h, warning.def: CB_ONWARNDEF for warnings that default to on - * cobc.c. cobc.h, warning.def: new warning option "unfinished" - (defaults to on) - don't warn if unfinished features are used - * tree.c, parser.y: marking "USAGE NATIONAL" and - "parameters passed by VALUE" as UNFINISHED instead of PENDING - * parser.y: added more checks and pending messages to CURRENCY SIGN with - and without PICTURE SYMBOL - -2016-09-02 Edward Hart - - * codegen.c (codegen, output_entry_function): modularised and shortened - code. - -2016-09-01 Edward Hart - - * field.c (validate_field_1), parser.y (sign_clause): fixed bug #305 by - adding checks that elementary item with SIGN has S in PIC and is USAGE - DISPLAY or NATIONAL. - * tree.h (cb_usage): deleted unused CB_USAGE_PROGRAM. - * cobc.c: refactored (set_picture) and improved some function names. - * field.c (validate_field_1): refactored SIGN and BLANK ZERO checks. - * field.c: fixed bug #310 by adding cb_get_usage_string. - -2016-08-31 Edward Hart - - * cobc.c (cobc_check_valid_name): refactored to take enum parameters - instead of magic numbers. - * parser.y (print_bits): improved style. - * tree.c (cb_build_picture): added warning message to PIC N. - -2016-08-30 Simon Sobisch - - * scanner.l: added premature implementation of national-literals, - hexadecimal-national-literals, hexadecimal-boolean-literals - * tree.c, tree.h: new function cb_build_national_literal - * tree.c (cb_concat_literals): allow concatenation of national and - boolean literals within the same category - -2016-08-28 Simon Sobisch - - * typeck.c: added hint to change dialect if a known system device - is used which is not reserved in current dialect - -2016-08-25 Edward Hart - - * parser.y, scanner.l, tree.h: fixed bug #305, where the - error_stmt_recover token was consumed when it was needed to resume - normal parsing. - -2016-08-20 Simon Sobisch - - * codegen.c (output_interal_function): deactivated storing module call - parameters after module entry - * codegen.c: generating a local cob_call_params and using it for all - parameter checks - * codegen.c (output_entry_function): don't generate a call to - cob_get_global_ptr() without checking that the runtime is initialized - -2016-08-20 Edward Hart - - * parser.y (identifier): added check that identifier references a field. - * parser.y: added checks that INSPECT and TRANSFORM have USAGE DISPLAY - operands. - * parser.y, scanner.l: split class-names into separate token from WORD, - as they can only be referenced in class conditions. - * scanner.l: improved style. - * typeck.c: refactored checking of INSPECT/TRANSFORM targets. - -2016-08-16 Edward Hart - - * typeck.c (emit_screen_displays): fixed bug introduced in the previous - commit where invalid MOVEs were generated (see discussion [eed1ec4a]). - -2016-08-15 Edward Hart - - * parser.y, typeck.c: fixed bug #299 (cannot have multiple screens in - one DISPLAY). - -2016-08-13 Frank Swarbrick - - patch #30 adding IBM extension OCCURS ... TO UNBOUNDED - * tree.h: new field flag_unbounded for OCCURS ... TO UNBOUNDED - * cobc.h: added CB_CS_OCCURS - * reserved.c: added UNBOUNDED as context sensitive reserved word for OCCURS - * parser.y: added token UNBOUNDED and first attemt for adding - OCCURS ... TO UNBOUNDED in the parser - -2016-08-13 Simon Sobisch - - * cobc.c, reserved.c: temporarily added new command line option - -R, -reserve-all for unsetting specify-all-reserved in compiler conf; - FIXME: should be possible with -fno-specify-all-reserved-words - -2016-08-12 Simon Sobisch - - * reserved.c (is_invalid_word): new function for checking the words, - currently only checks user defined words to be < COB_MAX_WORDLEN - * reserved.c: don't compare/print indicators and alias as part of the words - * config.c (cb_config_entry): reserved words handling - remove whitespace - and translate : to = - * cobc, config.c: set output name for -f= in cobc.c instead - in multiple functions in config.c and show the complete parameter - -2016-08-11 Simon Sobisch - - * config.def: renamed compiler configuration relaxed-syntax-check to - relax-syntax-checks for supporting the removed -frelax-syntax when set - on command line - * general: renamed cb_relaxed_syntax_check to cb_relaxed_syntax_checks - -2016-08-10 Simon Sobisch - - * reserved.c: use printf to do formatting instead of tabs - * cobc.c: added option --brief (-q) to reset -verbose and - remove the path to cobc in argv[0] - * cobc.c, cobc.h: better help for compiler flags - * flag.def, cobc.c, cobc.h: added more parameters in flag.def for better - help output; changed defines for CB_FLAG_RQ and CB_FLAG_NQ - * Makefile.am: add config.def as prerequisite for manpage - -2016-08-09 Edward Hart - - * parser.y, typeck.c, codegen.c: added support for program-prototypes in - REPOSITORY and CALL and CANCEL statements. - * tree.h (cb_func_prototype): renamed to cb_prototype. - * condig.def: added program-name-redefinition (thus fixing bug #268) and - program-prototypes. - -2016-08-08 Simon Sobisch - - * error.c, tree.h, typeck.c, parser.y: suppress listing output and - counting of warnings/errors with the new functions - listprint_suppress/listprint_restore - * cobc.c (print_program_trailer): correct grammar for 1 error/warning - - -2016-08-08 Edward Hart - - * parser.y (x): fixed bug #209, where invalid mnemonic message had line - number of mnemonic entry in SPECIAL-NAMES. - -2016-08-05 Simon Sobisch - - * cobc.c: don't stop if preprocessing errors but activate - cb_flag_syntax_only and let the parser do further checks - * cobc.c: initialize errorcount only for each source file instead - of for each processing stage - * pplex.l (ppinput): don't fake EOF on buffer overrun for - continuation lines (still process all following lines) - * cobc.c, pplex.l: only do listing specific parts if vars - cb_src_list_file/cb_current_file are set - * cobc.c: moved code for listing titles to own functions - (set_listing_title_code) and (set_listing_title_symbols) - * cobc.c (terminate_str_at_first_of_char): changed to terminate at - passed char instead of '\n' - -2016-08-04 Edward Hart - - * codegen.c (initialize_type): renamed to deduce_initialize_type. - * codegen.c (deduce_initialize_type): fixed bug #287, where reference- - modified group item was not treated as an elementary item. - -2016-08-04 Simon Sobisch - - * cobc.c (process_command_line): save conf_ret via |= instead of extra var - -2016-08-03 Dave Pitts - - * cobc.c: Redo listings when copybooks are missing. Changed replace - string positioning in free format listings. - * cobc.h: Add list file source format field. - * pplex.l, ppparse.y: Record source format in the list file struct. - -2016-08-03 Simon Sobisch - - * scanner.l (read_literal): Fix SIGSEGV for uncommon literals - bug 195 - * cobc.c, cobc.h: changes to listfile generation: start use of compiler - configurations (cb_tab_width, cb_text_col) - -2016-08-02 Dave Pitts - - * cobc.c: Fixes to put file not found into the listing file. Also, - changes to list the "file.i" preprocessed file. - -2016-08-02 Simon Sobisch - - * cobc.c (set_picture): fixed SIGSEGV on processing invalid - picture definitions, print "INVALID" as picture instead - * error.c (print_error): fixed SIGSEGVs for empty prefix and - missing source files - * parser.y: bug #259 - better checks for STRING syntax - -2016-08-01 Dave Pitts - - * cobc.c, error.c, pplex.l: Changes to change fixed sized character - arrays to pointers. Allocate strings based on length. - * cobc.h: Moved structure declatations and added comments. - -2016-08-01 Simon Sobisch - - * error.c, cobc.h (cb_get_strerror): own reentrant version of strerror - * error.c: extracted (configuration_error_head) from (configuration_error) - * error.c: adjusted (cb_perror) to receive a formatted message - * adjusted callers of (cb_perror) - -2016-08-01 Edward Hart - - * parser.y (renames_entry): fixed bug #289 where PICTURE of renamed - field was not copied to the RENAMES item. - -2016-07-31 Simon Sobisch - - * cobc.c: FR #127 extracted (cobc_abort_msg) from (cobc_abort_terminate) - and using it in (cobc_sig_handler), too - * cobc.c: minimized (cob_reg_sighnd) and register libcob's signal handler - instead of self-registering one - -2016-07-31 Edward Hart - - * parser.y (program_type_clause): marked EXTERNAL as pending. - -2016-07-30 Edward Hart - - * parser.y (return_at_end): allow NOT AT END before AT END (bugs #242). - -2016-07-29 Simon Sobisch - - * cobc.c, cobc.h, tree.c, typeck.c: removed COBC_DUMP_ABORT as it did not - work as intended (fixing compiler warnings because of return not reached) - * pplex.l, scanner.l: removed standard C headers already included by flex - * error.c: removed inline attribute from (cb_verify), (cb_verify_x) and - removed extra function (cb_verify_common) - -2016-07-27 Simon Sobisch - - * error.c, cobc.h: new function cb_perror for returning system errors - * error.c (print_error): changes for cb_perror - * cobc.c (cobc_terminate), config.c (cb_load_conf_file), pplex.l (ppcopy): - use cb_perror instead of output of a guessed error message - -2016-07-27 Edward Hart - - * parser.y, scanner.l: separated 66-, 78- and 88-level handling from - data_description, making it impossible to specify improper clauses. - * field.c: removed code made redundant by the above change. - * field.c, tree.h (cb_validate_renames_item): strengthened 66-level - syntax checks. - * config.def: added renames-uncommon-levels config option (for MF - extension). - * pplex.l: reverted gobbling of redundant periods after COPY/REPLACE - (bugs #283). - -2016-07-24 Dave Pitts - - * cobc.c: Additional picture information. TYPE field additions/changes. - -2016-07-18 Dave Pitts - - * cobc.c: Added symbol listing support for LINKAGE and SCREEN sections. - Added function support in print_program_trailer. - * pplex.l, cobc.c, tree.c: Fixed compile warnings. - -2016-07-18 Edward Hart - - * parser.y (screen_or_device_display): changed permitted DISPLAY - combinations (to follow Micro Focus). Now screens must have their own, - individual displays and cannot be mixed with the display of - non-screens on CRT. CRT and non-CRT displays can no longer be mixed. - * parser.y, typeck.c: added support for LINE/COLUMN/AT 0 and removed - requirement of LINE/COLUMN clause on CRT displays. - * config.def: added accept-display-extensions to enable/disable - the above and any other non-standard extensions. - * config.def: added console-is-crt to set the default DISPLAY/ACCEPT - device to CRT (for ACUCOBOL). - * parser.y (accept_statement): fixed bug where context-sensitive words - were not detected. - -2016-07-17 Brian Tiffin - - * codegen.c: when emitting source for a function entry, if cob_call_params - is zero, and cob_module is not set, set cob_call_params to the number of - arguments in GnuCOBOL using_list. Need to document that C can't call a - GnuCOBOL function with zero arguments if GnuCOBOL expects at least one, - even if all are optional from the GnuCOBOL perspective. Except for that - edge case, this fixes bug #208 (and possibly others). - * codegen.c: allow for ENTRY lookup inside main module. - -2016-07-15 Edward Hart - - * scanner.l, pplex.l: fixed bug #269. GnuCOBOL now gobbles redundant - periods, instead of releasing them to the parser. - -2016-07-15 Brian Tiffin - - * codegen.c: correction to exception code tested for ACCEPT ON EXCEPTION - -2016-07-10 Edward Hart - - * parser.y, scanner.l, tree.h: fixed bug #270 by only returning - PROGRAM_NAME's from scanner inside the identification division. - -2016-07-06 Edward Hart - - * typeck.c: fixed bug #264, where fields of category CB_CATEGORY_UNKNOWN - were rejected in the AT clause despite being numeric (or having only - numeric children). - * typeck.c (valid_screen_pos): removed extension to AT clause where less - than 4 digits was permitted (I'd added this because I thought leading - zeroes were truncated from literals). - -2016-06-30 Edward Hart - - * pplex.l (is_condition_directive_clause): fixed bug #263 where >>IF's - where not detected inside false >>IF's. - -2016-06-29 Edward Hart - - * cobc.c, cobc.h: Added comments to functions, improved names where possible and - fixed style issues (see below). - * cobc.c (print_replace_main): Made cb_inreplace a static variable - in_replace. Also split code into new functions free_replace_list and - copy_list_replace. - -2016-06-28 Dave Pitts - - * cobc.c: Fixed mystery edits that broke FILE and FILLER listing. - -2016-06-27 Edward Hart - - * field.c (validate_field_1): fixed bug #260, where + or - in PIC was - mistaken for S. - -2016-06-26 Simon Sobisch - - * codegen.c (codegen): renamed parameter nested to subsequent_call - removing the confusing title (for nested check nested_level) - -2016-06-26 Dave Pitts - - * cobc.c, cobc.h, pplex.l, ppparse.y: Added LISTING ON/OFF directive. - -2016-06-26 Edward Hart - - * cobc.c: lengthened variable names, fixed style issues (see below, also - replacing while loops with for where appropriate) and simplified and - modularised code. - -2016-06-25 Edward Hart - - * pplex.l: fixed bug #248, where any directive was evaluated inside the - false part of a conditional directive. Restricted this to ELSE, - END(-IF), WHEN, etc. - * cobc.c, error.c: fixed style issues: non_snake_case variable names, - non-K&R or missing braces, no space before parentheses or around + or - -, spaces instead of tabs, variable declarations without names - indented and more than one declaration per line. - * cobc.c (print_program_code): fixed corrupt doubled-linked list error - caused when cb_listing_files and cb_current_file pointed to the same - struct and cb_current_file was freed. - * pplex.l: moved COPY-specific code to get_new_listing_file and added - call to it from INCLUDE. - * cobc.h, parser.y, pplex.l, ppparse.y: moved PENDING macro to cobc.h as - CB_PENDING. - -2016-06-22 Edward Hart - - * parser.y, error.c: added hints to change dialect if an undefined word - is used which is reserved in another dialect (see Wish List #107). - * parser.y (_identification_header): reinstate ID DIVISION option. - * parser.y (setup_program): fixed bug #255, where function could be - defined within a program. - -2016-06-21 Ron Norman - - * error.c (print_error): fixed to verify 'file' is NOT NULL before using it - * cobc.c: FR #138 added checks for some env vars which are not allowed to - have PATHSEP_CHAR in them - -2016-06-20 Dave Pitts - - * cobc.c, cobc.h, error.c, pplex.l, ppparse.y: Added support for compiler - listings. - -2016-06-20 Simon Sobisch - - * codegen.c (output_internal_function): fixing bug #234 segfault by - generating code for setting not passed parameter pointers to NULL as if - they would have been passed as OMITTED, allowing (cob_is_omitted) to work - -2016-06-18 Simon Sobisch - - * ppparse.def: Added compiler constants GNUCOBOL (alias for OPENCOBOL) - and GCCOMP (alias for OCCOMP) - -2016-06-15 Brian Tiffin - - * cobc.c: Added optional arguments for -j job submits and -job alias - -2016-06-14 Edward Hart - - * reserved.c (default_reserved_words): moved uncommon, non-standard - aliases (e.g., AUTOTERMINATE for AUTO) to config files. - * parser.y: renamed TIMEOUT token to TIME-OUT. - -2016-06-13 Wim Niemans - - * parser.y, reserved.c, typeck.c, tree.h: added ACUCOBOL CGI extension - EXTERNAL-FORM / IDENTIFIED BY as DATA DIVISION clauses processed in - handling of DISPLAY / ACCEPT statements - -2016-06-13 Simon Sobisch - - * pplex.l (ppinput): FR #126 treat invalid indicator (free format) as - line comment instead of aborting compilation - * typeck.c (cb_validate_program_environment): FR #67 output duplicate values - in errornous alphabet-names at correct error position - -2016-06-12 Simon Sobisch - - * general: revised all message strings - * cobc.h: changed PENDING to not use apostrophe - -2016-06-12 Edward Hart - - * tree.c (cb_build_picture): fixed bug where PIC SS9 was not detected as - invalid. (See bug #40.) Also improved error messages. - * parser.y (check_preceding_tallying_phrases): fixed bug where - consecutive FOR phrases were allowed. - -2016-06-08 Simon Sobisch - - * general: renamed (cobc_abort_pr) to (cobc_err_msg), - revised message strings for exceptional/fatal errors - -2016-06-03 Edward Hart - - * config.def, parser.y: added not-exception-before-exception - configuration option (see bug #242). - * parser.y (program_id_paragraph), tree.c: fixed bug #244 and allow - INITIAL or RECURSIVE before COMMON. - -2016-06-02 Edward Hart - - * parser.y (display_atom): fixed bug #243, which was caused by a - begin_implicit_statement causing exceptions to be set to off before - checking which exception handler to go to. - * codegen.c: fixed another cause of bug #243, where only EC-IMP-DISPLAY - (and not EC-SCREEN) triggered the ON EXCEPTION phrase. As part of - this, refactored the handling of exception handlers. - * tree.h (cb_statement): renamed handler1 and handler2 to ex_handler and - not_ex_handler, respectively. - -2016-06-01 Edward Hart - - * parser.y: fixed bug #242 and allowed exception handlers to be in any - order. - -2016-05-31 Brian Tiffin - - * typeck.c: fix bug #235 ADD/SUBTRACT CORRESPONDING only for NUMERIC items. - -2016-05-31 Edward Hart - - * parser.y: fixed bug #47 - tightened INSPECT syntax rules. - -2016-05-22 Edward Hart - - * tree.c, field.c, codegen.c: replaced PICTURE strings containing packed ints with - array of (cob_pic_symbol) structs which are easier to use. - * codegen.c (codegen): split large chunks of code in separate functions. - -2016-05-21 Brian Tiffin - - * codegen.c: improving CALL BY VALUE. One step of many, more to do. - -2016-05-20 Edward Hart - - * tree.c: fixed bug #232, tightening permitted PICTURE strings and - improving error messages. - * field.c: improved error checking for BLANK WHEN ZERO with invalid - PICs. - -2016-05-16 Brian Tiffin - - * codeoptim.c: bug #229, missed patching cob_cmp_align_u64. - -2016-05-15 Brian Tiffin - - * cobc.c: correct process_run return code for systems with WEXITSTATUS - -2016-05-05 Simon 'sf-mensch/human' Sobisch - - * tree.c: give correct error position (cb_source_file + cb_exp_line) - for expression warnings (did not work with constants before) - -2016-05-03 Simon 'sf-mensch/human' Sobisch - - * warning.def, tree.c: added cb_warn_constant_expr for warnings added - by Ron Norman on 2016-05-01 - * tree.c: resolve the value at compile time if literal size differs - and checks are for = or != - -2016-05-01 Ron Norman - - * tree.c: for binary (arithmetic & relational) operations between integer constants - resolve the value at compile time and reduce the expression down to the - computed value - * tree.c Also, added checks to validate resolving contant expressions - -2016-04-24 Simon Sobisch - - * parser.y: implement STOP RUN integer/identifier (RM/COBOL extension) - * parser.y, pparse.y: remove printf non literal spec warning. - -2016-04-24 Edward Hart - - * parser.y, tree.c: fixed bug #231: tightened handling of alphabet-names - and recording-modes. Also added FOR clause syntax to CODE-SET clause. - -2016-04-23 Brian Tiffin - - * typeck.c: 64bit signed constant did not allow max negative. - -2016-04-23 Brian Tiffin - - * typeck.c: 64bit unsigned treated as signed when long int - same size as long long. - * tree.h: realign some tabs. - * codegen.c, error.c, pplex.l, scanner.l, tree.c, typeck.c: remove printf - non literal spec warning. - -2016-04-23 Brian Tiffin - - * codeoptim.c: Bug #229: binary-double unsigned compares failed when high - bit set. - -2016-04-22 Ron Norman - - * parser.y, scanner.l, reserved.c, codegen.c: support features of an - IBM REPORT WRITER - LINE LIMIT, PRESENT AFTER & ABSENT AFTER - -2016-04-17 Edward Hart - - * parser.y (screen_description): fixed bug #227: code now handles case - where no screen precedes a 78-level item. - * parser.y (undefined_word): Added error case to improve error handling. - This required a slight change to file_control_entry. - -2016-04-15 Edward Hart - - * parser.y: fixed bug #224: disallow configuration section elements in - any order. - * scanner.l, parser.y: moved handling of IDENTIFICATION DIVISION header - to parser.y. - * parser.y: disallow functions without END FUNCTION. - * parser.y: allow nested programs to omit END PROGRAM, per standard. - * parser.y: emit error if nested programs are defined in a program - without a PROCEDURE DIVISION header. - * parser.y: refactored grammar of source_element and program_body. - * parser.y: renamed all optional tokens to be begin with underscore for - consistency. - -2016-03-29 Edward Hart - - * codegen.c (find_func_ext_name): moved missing prototype/function check - to tree.c, to be done when REPOSITORY entry is given. - * tree.h (cb_func_prototype): removed now redundant check_needed flag. - * warning.def: added prototype warning flag for above. - * parser.y, tree.h, typeck.c: added SET LAST EXCEPTION TO OFF. - -2016-03-27 Edward Hart - - * codegen.c (find_func_ext_name), tree.h: corrected AS clause of - REPOSITORY FUNCTION phrase: actually gives function (prototype) - external name, not actual function-(prototype-)name. This fixed bug - #124. - * parser.y: allow redundant FUNCTION clauses. - * tree.c (cb_build_func_prototype): set check_needed to 0 when ext_name - is given. - -2016-03-26 Edward Hart - - * codegen.c (find_func_ext_name), tree.h: created to find external name - of functions from a given prototype. Also created struct - (cb_func_prototype). - * tree.c (cb_build_repo_func_prototype): dropped repo_ from name. - * parser.y, tree.c (cb_build_func_prototype): made FUNCTION-ID - generate implicit REPOSITORY entry to permit recursion. - * scanner.l: moved code for finding program based on program-name to - separate function (cb_find_defined_program). - * typeck.c: stopped function-names being converted to upper-case. - -2016-03-25 Edward Hart - - * parser.y, scanner.l, tree.c, tree.h, typeck.c: added checks for - redefinition of program and function-prototype names. (See bugs #212 - and #205). - * parser.y: moved duplicated PROGRAM/FUNCTION-ID and END PROGRAM/ - FUNCTION code into functions. - -2016-03-23 Edward Hart - - * parser.y: added check that BY VALUE formal parameters are not ANY - LENGTH (see bug #219). - -2016-03-19 Brian Tiffin - - * codegen.c, reserved.c, parser.y, tree.h: Allow for - PROCEDURE DIVISION RETURNING OMITTED and CALL ... RETURNING NOTHING - -2016-03-18 Edward Hart - - * reserved.c, config.c, cobc.h: added ability to specify aliases for - default reserved words (Wish List #112). - -2016-03-09 Edward Hart - - * reserved.c, cobc.h: enhanced reserved conf. option to allow - specification of context-sensitive words. - -2016-03-05 Edward Hart - - * parser.y: disabled formal BY VALUE parameters, pending fix of bug - #109. - -2016-02-29 Simon Sobisch - - * cobc.c (process_command_line): Fix missing memory release for cobc -V, - let --list-reserved work together with other --list-options again - -2016-02-28 Edward Hart - - * config.def, config.c, reserved.c: added reserved and specify-all- - reserved options to let configs specify all the reserved words. Also - removed now redundant cobol85-reserved option. - * reserved.c (default_reserved_word_list): removed unimplemented - COBOL-85 words. - * reserved.c (cob_strcasecmp): removed assumption that second arg was - all caps. - * cobc.c (process_command_line): moved cb_list_reserved call to after - the configuration has loaded. - * cobc.h (noreserve): renamed to reserved_word_list. - * tree.h (cobc_reserved): removed const qualifiers from members. - -2016-02-23 Simon Sobisch - - * scanner.l, typeck.c (cb_check_word_length), tree.h: moved word length - check out of scanner.l to also check numeric-only words that bypass - the checks in scanner.l - -2016-02-21 Simon Sobisch - - * scanner.l (read_literal): Fix wrong error about max-literal length - when the last position is an escaped literal mark - -2016-02-20 Edward Hart - - * parser.y (procedure_returning): fixed bug #203: emit error if function - returning item has ANY LENGTH clause. - -2016-02-17 Edward Hart - - * parser.y (display_atom): prepare for DISPLAY OMITTED. - * typeck.c (cb_emit_display): refactored. - * typeck.c: added non-functional version of (cb_emit_display_omitted). - -2016-02-17 Simon Sobisch - - * typeck.c (cb_expr_finish): tweak line number to match the error - -2016-02-16 Edward Hart - - * parser.y: fixed bug #201 - where a specified UPON device was replaced - with the default. - -2016-02-13 Edward Hart - - * parser.y: permit DISPLAY and ACCEPT clauses in any order. - * parser.y: add optional WITH before every disp/accp_attr and optional - AT before each LINE/COL clause. - * parser.y: allow the screen and device formats of the DISPLAY statement - to be mixed in one statement. - -2016-02-02 Simon Sobisch - - * scanner.l (read_literal): Fix multiple heap corruptions - for uncommon literals - bug 195 - -2016-01-31 Simon Sobisch - - * config.c (cb_config_entry): remove CR/LF for error "invalid conf. tag" - -2016-01-30 Simon Sobisch - - * general: fixing all warnings generated by msc code analysis - (possible memory related issues) - * cobc.c (process_filename): don't check object files for valid COBOL - file names - * cobc.c (process_library) [_MSC_VER]: check all input filenames - preventing deletion of passed lib file - * cobc.c (process_filtered) [_MSC_VER]: fix deletion of passed obj file, - only filter for file basename (not including directory) - * cobc.c (line_contains) [_MSC_VER]: only return if all patterns matched - * Makefile.am: included a move for manual post-fix of sources generated - by flex (otherwise the #line directives use the intermediate tmp file) - -2016-01-22 Edward Hart - - * parser.y: refactored handling of conflicting screen clauses. - -2016-01-20 Edward Hart - - * parser.y: fixed bug #190 - added check that ERASE EOL and EOS are not - specified at the same time. - * parser.y: added [END OF] LINE/SCREEN as synonym for EOL/EOS. - * parser.y: fixed bug #191 - added check that BLANK LINE and SCREEN are - not specified at the same time. - -2016-01-17 Edward Hart - - * parser.y (screen_description): fixed bug #186 - only the clauses - in the current screen item are checked for duplication. - * scanner.l (scan_*): suppressed compiler warnings by casting size_t to - int in printf calls. - -2016-01-10 Edward Hart - - * parser.y: fixed bug #182 - ON/OFF in SWITCH clause causing incorrect - duplicate CURRENCY clause error. - * parser.y (check_repeated): merged check_*_repeated functions into one - function. - -2016-01-09 Simon Sobisch - - * scanner.l, tree.c: postponed numerical literal checks for possible labels - from scanner.l to tree.c (check_lit_length, error_numeric_literal) - -2016-01-08 Edward Hart - - * pplex.l, config.def: reverted [r605]. Marked continuation of COBOL - words as archaic in standard-conforming implementations. - -2016-01-04 Edward Hart - - * parser.y: fixed bug #180 - added check that HIGHLIGHT and LOWLIGHT are - not specified at the same time. - * codegen.c (output_set_attribute): made HIGHLIGHT ON imply LOWLIGHT off - and vice versa. - -2016-01-03 Edward Hart - - * parser.y: fixed bug #178 - added check that certain identifiers are - not 88-level items. - -2016-01-02 Ron Norman - - * codegen.c (output_index): If subscript is unsigned then output the - code as if it was signed. This is to avoid a core dump when an - unsigned binary subscript has a value of ZERO. - -2016-01-01 Simon Sobisch - - * scanner.l: moved SET_LOCALATION to tree.c (cb_build_xyz) - * tree.c (cb_concat_literals): the new literal inherits its position from - the first literal, check for cb_literal_length - ODO checks: - * parser.y (integer): return numeric literal -1 instead of cb_int1 - for incorrect numerical literals - * parser.y: add check OCCURS max. must be greater than OCCURS min. - NESTED OCCURS with DEPENDING - feature-requests:#99: - * tree.h: remove flag_odo_item, add odo_level instead - * typeck.c: compute odo_level in (cb_validate_program_data), - add check for nested ODO to (cb_validate_one) - -2015-12-31 Edward Hart - - * reserved.c (reserved_words), parser.y: corrected GRID implementation; - is different to LEFTLINE. - -2015-12-30 Edward Hart - - * codegen.c, codeoptim.c: Changed code to generate cob_screen as a - doubly linked list. - * reserved.c (reserved_words): added GRID as synonym for LEFTLINE. - -2015-12-30 Simon Sobisch - - * cobc.c, config.c: changes for replacing -cb_conf=: with - additional flags -f= including -f[no-] for binary confs - * config.def, cobc.c, cobc.h, config.c: added additional parameter in - config.def for help output; changed defines for CB_CONFIG_* - -2015-12-28 Simon Sobisch - - part fixed bug #177 - added missing ODO checks for subordinate items - * tree.h: renamed flag_odo_item to flag_odo_relative, add new flag_odo_item - * typeck.c, codegen.c: adjustments for changes to tree.h - * typeck.c (cb_validate_program_data): set flag_odo_item for ODO parents - * typeck.c (cb_build_identifier): generate cob_check_odo for all sub-items - of items with flag_odo_item (instead of only for ODO fields of itself) - -2015-12-27 Simon Sobisch - - * config.c (invalid_value): added output for not-numeric, min, max - * config.c (cb_config_entry): validate word length against COB_MAX_WORDLEN - * cobc.c (process_command_line): moved check of configuration values for - tab-width and text-columns to config.c (cb_config_entry) - * cobc.c (process_command_line): process the command line twice: first time - for handling all options that read a complete configuration or are - output-only options, the second time for every other option including - overriding of single configuration flags - * error.c, cobc.h: new (configuration_warning) - * config.c (cb_load_conf): issue a warning if a previous loaded configuration - is discarded - -2015-12-25 Simon Sobisch - - first implementation of feature-requests:#99 - NESTED OCCURS with DEPENDING - * field.c (validate_field_1): allow nested ODO with complex-odo = yes - * codegen.c (output_data): recalculate size for nested ODO by -fodoslide - -2015-12-24 Edward Hart - - * parser.y: added checks of number of args passed to - FORMATTED-(DATE)TIME. - * parser.y, reserved.c: added SYSTEM-OFFSET to FORMATTED-(DATE)TIME. - * parser.y: removed PENDING from FULL and REQUIRED clauses. - * tree.c: added (warn_cannot_get_utc). - -2015-12-22 Simon Sobisch - - * Makefile.am: post-process generated flex sources via sed for non-GNU - compilers that define __STDC_VERSION__ >= 199901L but don't work correct - -2015-12-20 Simon Sobisch - - * cobc.c: exit on -V for GNU-coding-conformance, added -vv (very verbose) - resulting in a call to cobc_print_version() after command line parsing, - removed -R as we have a short version for --debug in -d already - * cobc.h: added CB_STD_ACU and CB_STD_2014 - -2015-12-19 Simon Sobisch - - * tree.h: change order of fields in cb_intrinsic_table - * tree.c (cb_build_intrinsic): better check of min/max arguments - * reserved.c: set correct min/max values in function_list, - (cb_list_intrinsics): output min/max value - -2015-12-18 Simon Sobisch - - * config.def: new configuration "call-overflow" - * parser.y: split exception_or_overflow to value cb_call_overflow - -2015-12-15 Brian Tiffin - - * cobc.c (cobc_print_usage, process_command_line): command line option -a - replaced with -R, as animator will eventually get -a. - -2015-12-05 Edward Hart - - * tree.c (offset_time_format, offset_arg_param_num): deleted functions - as offset parameter for the formatted datetime functions is optional. - -2015-12-03 Edward Hart - - * tree.c (offset_time_format): fixed bug #169 - require datetime - functions with Z format to take an offset parameter. - -2015-11-25 Sergey Kashyrin - - * codegen.c (output_integer): cast program-pointer to unsigned char *, - not to void * - -2015-11-23 Simon Sobisch - - * tree.c (cb_get_int): Fix for Bug #167 - activated size check and set - limit depending on INT_MAX - * tree.c (cb_get_int, cb_get_long_long, cb_get_u_long_long): don't call - COBC_ABORT if numeric literals are too big but raise a normal compiler - error showing the actual (system specific) limit - -2015-11-11 Simon Sobisch - - Fix for Bug #165: - * pplex.l (ppopen): activated check for BOM independent of WIN32, skipped - it on compilations from stdin - * cobc.c [_MSC_VER]: build and pass exename to cl.exe and mt.exe - Fix for Bug #166: - * cobc.c [_MSC_VER]: split (process) to (process_filtered) for filtering - cl.exe's verbose output - now filtering *all* lines instead of first three - * cobc.c [_MSC_VER]: rewritten (line_contains) for matching "special" names - -2015-11-06 Simon Sobisch - - * cobc.c (process) [_MSC_VER]: bugfix in output filter - * cobc.c (process_run): enable -j to work on systems that need ".\", too - -2015-10-28 Simon Sobisch - - * scanner.l: maximum word-length always resulted in error if -W[all] - was set, now only raise an error if -frelax-syntax is not set and - raise a warning if both -frelax-syntax and -W[all] are active - * tree.h: new field flag flag_is_pdiv_opt - * parser.y: set f->flag_is_pdiv_opt for vars in USING with OPTIONAL clause - * typeck.c (cb_build_identifier): add check for access of OPTIONAL LINKAGE - items if COB_EC_PROGRAM_ARG_OMITTED is active - * typeck.c (cb_build_identifier): build and use full name (including the - actual used var, not only the name of the parent) for runtime checks of - BASED items and OPTIONAL LINKAGE items - -2015-10-27 Simon Sobisch - - * error.c: warning/error output for compiler support options - -2015-10-25 Simon Sobisch - - * config.c: tweaked error messages, added possible values if invalid - * config.c (cb_load_conf_file): if include file is not found prefix it - with path of current loaded configuration file - -2015-10-18 Edward Hart - - * parser.y, scanner.l: added support for MF's/ACUCOBOL's ON ESCAPE - phrase for ACCEPT. - -2015-10-25 Simon Sobisch - - * parser.y, reserved.c: added RM/ACU extension ASSIGN TO PRINT/PRINTER-1, - both with and without assign names - -2015-09-24 Edward Hart - - * scanner.l: added non-standard numeric literals: MF's numeric - boolean and ACUCOBOL's B#, O#, X# and H# literals. - * tree.c: improved error messages and refactored (cb_concat_literals). - -2015-09-21 Simon Sobisch - - * cobc.c [_MSC_VER]: make sure that only temporary lib-files are removed - -2015-09-15 Brian Tiffin - - * cobc.h, moved COB_DASH defines out of ../configure.ac - -2015-08-30 Ron Norman - - * In tree.c, for binary operations between integer constants, resolve - the value at compile time and reduce the expression down to the - computed value - -2015-08-25 Edward Hart - - * parser.y: tightened AT clause definition. - * typeck.c (valid_screen_pos): improved error message and refactored. - -2015-08-23 Edward Hart - - * parser.y: improved error messages of integer and report_integer. - -2015-08-21 Edward Hart - - * parser.y: removed PENDING from LOWLIGHT clause. - -2015-08-20 Edward Hart - - * typeck.c: adding check for ACCEPT/DISPLAY statements taking - the cursor position as a single field so that the position is an - integer with 6 digits or less than 4 digits. - * parser.y: improved error messages of integer and report_integer. - -2015-08-19 Ron Norman - - * If -frelax-syntax then just give Warning when VALUEs in REDEFINES - instead of an error. Some legacy COBOL code can be doing this. - -2015-08-19 Ron Norman - - * cobc.c: swapped order of parameters for C compiler and linking so that - -L options come before -l - Otherwise the linker does not find things correctly on Linux - * field.c (validate_field_1): warning instead of an error for VALUEs in - REDEFINES with -frelax-syntax as some legacy COBOL code does this - -2015-08-03 Brian Tiffin - - * cobc.h, cobc.c, pplex.l: allow compiles from stdin - * cobc.c: add -j after build run - added short aliases for -free (-F) and -debug (-a) - -2015-07-07 Ron Norman - - * parser.y, typeck.c, reserved.c, tree.h: - Added CB_DEVICE_PRINTER with a new value to differentiate between - PRINTER and SYSOUT. DISPLAY ... UPON PRINTER can be redirected via - the env var COBPRINTER similar to what Micro Focus supports - -2015-07-06 Simon Sobisch - - * scanner.l: Improved parsing of all literals including error messages, - fixing bug ".e000-expand-macro-calls." being misinterpreted as (wrong) - floating-point literal - - compiler configuration, including feature-request #43: - * config.def: new configurations "literal-length" and - "numeric-literal-length" - * typeck.c (non_integer_move): don't value suppress_warn more than - cb_move_noninteger_to_alphanumeric - * scanner.l: value cb_numeric_literal_length and cb_literal_length - -2015-07-05 Edward Hart - - * typeck.c: added TALLY special register (Wish List #34). - * scanner.l: Improved error detection of invalid floating-point literals - and associated error messages. Also minor refactoring. - -2015-07-03 Simon Sobisch - - * codegen.c (output_size): Fix Bug #146 reference modification - ignored ODO size - -2015-07-02 Ron Norman - - * Fixes to tree.c, tree,h typeck.c field.c codegen.c to correctly - handle COMP-X data fields. This now works the same as Micro Focus - -2015-06-29 Ron Norman - - * parser.y: fixed so unstring works with identifier/literal/function - -2015-06-12 Edward Hart - - * codegen.c: bug #78 - changed location of initialization of - local-storage items. - * pplex.l: bug #102 - added check for continuation line without literal - or word to continue. - -2015-06-09 Edward Hart - - * parser.y: bug #83 - added check for relative LINE/COLUMN clauses in - screen section occurs items. - -2015-06-08 Luke Smith - - FR #37 - Added WITH SIZE to ACCEPT/DISPLAY field - * parser.y (accp_attr): added [PROTECTED] SIZE clause - * parser.y (disp_attr): added SIZE clause - * reserved.c: added context-sensitive PROTECTED - * tree.c, tree.h (cb_build_funcall): additional parameter, - new macro CB_BUILD_FUNCALL_10 - * typeck.c (cb_emit_accept, cb_emit_display): cater for new size attribute - -2015-05-29 Ron Norman - - * parser.y fixed so UNSTRING works with identifier/literal/function - -2015-05-16 Simon Sobisch - - * parser.y: bug #136 added check for duplicate on/off clauses for switches - * reserved.c, tree.h: fr #65 added more switches "SWITCH-16" to "SWITCH-36" - * parser.y, reserved.c, scanner.l: fr #65 better support for ACUCOBOL - extension "SWITCH 1" to "SWITCH 26", added alias SWITCH [A-Z], - allow this extension only with -fsyntax-extension - -2015-05-12 Simon Sobisch - - * config.c: new options "includeif" to include only if file exists - (implemented according to runtime configuration by Ron Norman) - -2015-05-07 Simon Sobisch - - * parser.y, typeck.c, cobc.h: bug #135 - give correct error position - (cb_source_file + new cb_exp_line) for expression errors - -2015-04-30 Ron Norman - * common.h, change cob_file record_off to type cob_s64_t (from off_t) - so that the size does not change depending on C comppiler - This is most likely the cause of the previous issue. - -2015-04-28 Ron Norman - - * codegen.c: now emits extern (); - for each subroutine called statically to avoid - C compiler warnings - -2015-04-27 Ron Norman - - * cobc.c, codegen.c, common.h, typeck.c: - updated to handle more options for support of Micro Focus - format files. New compile option -fmf-files sets all - sequential/relative files to be MF compatible - REWRITE is now allowed for LINE SEQUENTIAL files although - a status of 44 may happen if the new record will not - fit in the original record slot on disk. - New compile option -fibmcomp effectively sets: - binary-size: 2-4-8 & synchronized-clause: ok - And compile option -fno-ibmcomp effectively sets: - binary-size: 1--8 & synchronized-clause: ignore - * config.c: don't store configuration values additional to the setting - - -2015-04-28 Ron Norman - - * codegen.c now emits extern (); - for each subroutine called statically to avoid - C compiler warnings - -2015-04-25 Simon Sobisch - - * typeck.c (cb_emit_initialize): bug #84 check target for INITIALIZE, - almost fixed as suggested by Edward Hard - -2015-04-14 Ron Norman - - * codegen.c: for RELATIVE files ACCESS SEQUENTIAL if no KEY is - defined then an internal one is created. This was required as - parts of fileio.c expect there to be a key field for RELATIVE - files to hold the record number being processed. - * cobc.c, cobc.h, flag.def: new option -fcallfh (alias CIT compatibility: - -use-extfh) with option function-name to include support for Micro Focus - style EXTFH interface, see NEWS - * tree.c, tree.h (struct cb_file): added extfh parameter - * typeck.c: generate call to EXTFH depending on cb_file->extfh - -2015-04-14 Ron Norman - - * cobc.c codegen.c common.h tree.h parser.y typeck.c: - updated to include support REPORT COLUMN LEFT/RIGHT/CENTER - Also REPORT: PLUS, STEP on OCCURS and multi COLUMN numbers - NOTE (Simon): -fibmcomp is deactivated for now - * cobc.c, flag.def: added -fibmcomp: Handle COMP fields like MF IBMCOMP - (binary-size: 1--8 & synchronized-clause: ignore) - -2015-04-12 Simon Sobisch - - * config.c: load configuration file from COB_CONFIG_DIR if file cannot be - accessed in current directory, only check for missing definitions if - configuration file loaded without errors - -2015-04-02 Edward Hart - - * reserved.c: set FORMATTED-CURRENT-DATE, INTEGER-OF-FORMATTED-DATE, and - TEST-FORMATTED-DATETIME and INTEGER-OF-FORMATTED-DATE to implemented - -2015-04-02 Edward Hart - - * cobc.c: replaced "MSC_VER >= 1400" with COB_USE_VC2005_OR_GREATER - -2015-04-01 Simon Sobisch - - * reserved.c, parser.y : added column orientation as pending - * reserved.c : marked SYNCHRONIZED RIGHT as pending as generation was LEFT - -2015-03-10 Simon Sobisch - - * config.c: support for multiple inclusion of conf files while - checking for recursion - -2015-03-09 Simon Sobisch - - * typeck.c: added more checks of overlapping MOVE, - generate MOVEs as overlapping if it's not sure it isn't - -2015-03-05 Simon Sobisch - - * codegen.c: added check of recursive CALL for INITIAL programs - -2015-03-03 Ron Norman - - * codeoptim.c & typeck.c: fixes for systems which require aligned - data but the C compile does not support __unaligned directive - codegen.c: fix for C compilers (old SUN for one) that do not - handle initializing a local variable with address of another - local variable - tree.c: Check for NULL passed to cb_get_int and report error - -2015-02-23 Ron Norman - - * tree.c, tree.h, typeck.c: moved cb_field_size to tree.c - * codegen.c, parser.y, tree.c, tree.h, typeck.c: FR #23 + FR #281 - Implemented support for sparse and split keys for INDEXED files - Most of the compiler code was borrowed from the fileio-rewrite - -2015-02-13 Ron Norman - - * tree.c: fix to only adjust up file record_max for REPORT files - -2015-02-12 Ron Norman - - * Merged Report Writer code into 2.0 code base to create a new 2.0 - with all collective features - -2015-01-31 Edward Hart - - * tree.c: updated valid_time_format and valid_datetime_format to pass - decimal points - -2015-01-16 Edward Hart - - * reserved.c: set TEST-FORMATTED-DATETIME and INTEGER-OF-FORMATTED-DATE - to implemented - -2015-01-06 Brian Tiffin - - * parser.y: fixed segfault with STOP "literal" with the ACCEPT OMITTED - feature attempting to generate code with null pointer - -2014-12-11 Ron Norman - - * Fixes so WARNING is given if no DETAIL lines in a report - -2014-06-16 Simon Sobisch - - * parser.y: fixing Bug #79 by defining PLUS_KEYWORD: PLUS|+ - -2014-06-14 Ron Norman - - * Fixes for LINE|COL 0 to get error message - -2014-12-02 Sergey Kashyrin - - * codegen.c: fix for bug #52 incorrect premature memory release (CANCEL) - of INITIAL programs - -2014-12-01 Simon Sobisch - - * parser.y: fix bug #108 figurative constants not accepted in screen items - -2014-11-18 Sergey Kashyrin - - * field.c: fix bug #89 incorrect LENGTH OF redefined - -2014-11-06 Simon Sobisch - - * typeck.c (decimal_expand): fix bug #106 allocating cob_decimal too often - -2014-10-29 Simon Sobisch - - * config.c (cb_config_entry): remove inline comments from entry - * config.def, scanner.l: check maximum word length depending on new - configuration word-length - * cobc.c: added std=acu - -2014-10-17 Simon Sobisch - - * parser.y: added SUPPRESS clause as PENDING, see request #23 - -2014-09-18 Simon Sobisch - - * pplex.l: bug #96 prevent line overflow, add warning "Source text too long" - * pplex.l: only show warning "Source text after column ..." if no comment was - started in this line before - -2014-09-17 Edward Hart - - * reserved.c: Set FORMATTED-DATE/DATETIME/TIME functions to implemented - * reserved.c, parser.y: replaced FORMATTED_CURRENT_FUNC with FUNCTION_NAME - * tree.c: added compile time checking of date/time formats and offset - time presence. - -2014-09-12 Simon Sobisch - - * cobc.c [_MSC_VER]: correct handling of -l (add .lib and pass to linker) - * cobc.c, cobc.h, error.c: message style change according to C compiler, - can be changed via COB_MSG_FORMAT (GCC/MSC) - * cobc.c (process) [_MSC_VER]: bugfix in output filter - * parser.y, reserved.c, typeck.c: Added parser support for OCCURS DYNAMIC - along with CAPACITY clause as not implemented - -2014-09-08 Philipp Böhme - - * cobc.c (process) [_MSC_VER]: bugfix in output filter - -2014-09-03 Philipp Böhme - - * cobc.c, cobc.h: added cobc_free() function - (Own freeing functions for debugging purposes. - (e.g. to locate heap crashes caused by malloc/free)) - * change all free() to cobc_free() - * cobc.c (process) [_MSC_VER]: cob_malloc() to cobc_malloc() - * cobc.c: use COB_PIC_FLAGS for CB_LEVEL_ASSEMBLE - -2014-08-25 Simon Sobisch - - * parser.y: never warn ENTRY as unreachable - -2014-08-25 Simon Sobisch - - * cobc.c: Changed output of --help for help2man - * Makefile.am: Added manpage generation + install - -2014-07-31 Simon Sobisch - - * pplex.l, flag.def: new flag acucomment: - '$' in indicator area treated as '*', '|' treated as floating comment - -2014-07-29 Simon Sobisch - - * cobc.c, config.c: new option -cb_conf for overriding configuration - options - * config.c, cobc.c, error.c (configuration_error): new function for errors - concerning configuration options --conf / --cb_conf / - configuration parsing, complete rewrite of configuration error messages - * parser.y : Added WITH DEFAULT as alias for WITH UPDATE - * config.def, parser.y : new configuration option accept-update - for setting WITH UPDATE/DEFAULT clause as standard, adding new extension - WITH NO UPDATE/DEFAULT to disable this behaviour explicit - * config.def, parser.y : new configuration option accept-auto - for setting WITH AUTO clause as standard, adding new extension - WITH TAB to disable this behaviour explicit - -2014-07-28 Simon Sobisch - - * parser.y: fix #88 false unreachable warning after END DECLARATIVES - without main section/paragraph - -2014-07-18 Edward Hart - - * pplex.l: fixed bug #86 whitespace handling for IDENTIFICATION DIVISION - and DEBUGGING MODE - -2014-07-10 Philipp Böhme - - * typeck.c (cb_emit_sort_init): calculation of table key offset fixed - -2014-07-02 Philipp Böhme - - * cobc.c [_MSC_VER]: filter output of cl.exe (instead of redirecting to - NUL), errors are printed in non-verbose mode now; new: (read_buffer_line) - (line_contains) - * cobc.c [_MSC_VER]: remove temporary object files after building - -2014-06-30 Simon Sobisch - - * cobc.c: move cobc's (cobc_temp_name) to libcob as (cob_temp_name) - * cobc.c: use (cob_sys_getpid) everywhere instead of (getpid) - -2014-06-29 Simon Sobisch - - * tree.c: Detect missing ASSIGN at compile time - -2014-06-19 Simon Sobisch - - * cobc.c: Fixing compilers (like MSC) that don't HAVE_DESIGNATED_INITS - cobc_init_reserved() has to be called before process_command_line() - -2014-05-20 Simon Sobisch - - * scanner.l: Fixing #71 Referencing GLOBAL 78/CONSTANT in SELECT - causes internal error - -2014-05-26 Ron Norman - - * typeck.c: use memmove for move of LINKAGE items - -2014-05-26 Simon Sobisch - - * scanner.l : Fixing #71 Referencing GLOBAL 78/CONSTANT in SELECT causes - internal error - -2014-05-20 Simon Sobisch - - * parser.y: Added extension "USE AT PROGRAM START/END" as not implemented - -2014-05-14 Philipp Böhme - - * cobc.c: Catch and treat error when no disc space is available for - output files - -2014-05-07 Ron Norman - - * typeck.c: use memmove for move of LINKAGE items - -2014-04-30 Simon Sobisch - - * parser.y: Added extension "GOBACK/EXIT PROGRAM RETURNING/GIVING x" - -2014-04-29 Philipp Böhme - - * codeoptim.c: Fixed bug in COB_ADD_PACKED_INT. - Computing COMP-3 failed in MSVC-build versions, - in output_storage() calls '%' should be '%%'. - -2014-03-10 Simon Sobisch - - * cobc.c: support for user-defined LOCALEDIR via environment - -2014-03-07 Simon Sobisch - - * field.c: Added check for maximum size of group/alphanumeric items - -2014-02-17 Simon Sobisch - - * cobc.c: Tweaked --info for showing current settings (environment) along - with settings hard-wired during build (COB_xyz) - -2014-01-07 Simon Sobisch - - * parser.y: Bugfix: no exception check for NULL address on FREE statement - (as this is explicit allowed) - -2014-01-02 Simon Sobisch - - * codegen.c: Fixing Bug #55 UDF with no parameters does not compile - -2013-11-20 Ron Norman - - * Report Writer module - -201?-??-?? Sergey Kashyrin - - * codeoptim.c : Fixed bug in COB_ADD_PACKED_INT. - Computing COMP-3 failed in MSVC-build versions, - in output_storage() calls '%' should be '%%'. - -2012-05-09 Simon Sobisch - - * cobc.c: Added conversion for enabling options in WIN style - -201?-??-?? ?? - - * parser.y: Added checks for RETURNING item: OCCURS, LOCAL-STORAGE - -2010-06-28 Roger While - - * MARK - Version 2.0 - * Move to GPL/LGPL 3 - -2010-0?-?? Roger While ? - - * flag.def, cobc.h, parser.y, scanner.l, tree.c: removed -ffunctions-all - * flag.def, cobc.h, scanner.l: added -fintrinsics=, with - being [ALL|intrinsic function name(,name,...) to prevent reuse of - user-defined names and to mimic CONFIGURATION SECTION. REPOSITORY. - -2010-05-?? Roger While ? - - * flag.def, cobc.c: remove compiler flags if-cutoff, extra-brace, - optional-file - * error.c: remove special warnings for lvl-78 - * pplex.l [_WIN32]: check for UTF-8 BOM in source files and skip it - -2009-??-?? Roger While - - * parser.y, reserved.c, tree.c, tree.h, codegen.c: full support of ANSI 85 - debugging module by adding USE FOR DEBUGGING declarative procedures - (only part of the generation if WITH DEBUGGING MODE is active during - compilation) and special register DEBUG-ITEM - note: the execution at runtime is depending on COB_SET_DEBUG - -2009-??-?? Roger While - - * cobc.c, cobc.h, codegen.c, tree.h, typeck.c: Adding new commands to cobc - --info with most important configuration/environment details - --list-system for displaying all registered system routines - -2009-??-?? Roger While - - * parser.y, typeck.c (cb_emit_accept_escape_key): Implementing - ACCEPT .. FROM ESCAPE KEY - -20??-??-?? Simon Sobisch - - * codegen.c : Simplify by handling stuff for different compilers - by general define (COB_ALIGN) - -20??-??-?? Roger While - - * cobc.c, cobc.h, tree.h: Simplify by handling stuff for - different compilers by general defines (CB_COPT_x, COB_A_...), - added parsing step and source name to verbose messages, - added some comments - -20??-??-?? Simon Sobisch - - * cobc.c, cobc.h, tree.c, typeck.c : adjustments for MSC, - fix some compiler warnings, support possible spaces in different - path names, enable linking of already assembled modules for - different UNIXes - -2009-12-25 Roger While - - * typeck.c : Added validate_inspect for check of operands in - INSPECT REPLACING/CONVERTING - -2009-10-29 Simon Sobisch - - * cobc.c : Warn if -Debug is used (because likely -debug was intended) - -2009-10-08 Simon Sobisch - - * error.c, field.c, typeck.c : Fix field names "WORK$"->"FILLER" - in warning/error messages - -2009-08-18 Roger While - - * codegen.c : initialize_type corrected to handle occurs at 01 level, - output_initialize_compound corrected, output_perform_exit - OSVS corrected - -2009-??-?? Roger While - - * typeck.c : fix move to SIGN TRAILING SEPARATE field - -20??-??-?? ?? - - * parser.y : exclude level 77 from "Item requires a data name" check - -2009-08-06 Simon Sobisch - - * parser.y : Add output of unreachable statement to -Wunreachable - -2009-06-19 Roger While - - * parser.y : Fix invalid syntax with OPEN/CLOSE - * parser.y, tree.h : Preliminary RW changes - -2009-06-17 Roger While - - * pplex.l : Save/restore fixed/free status on COPY - -2009-06-09 Roger While - - * typeck.c : Fix constant calculation for redefines/renames - -2009-06-01 Roger While - - * codegen.c : Revise trace processing - -2009-05-25 Roger While - - * parser.y, typeck.c, codegen.c : CALL ... RETURNING NULL - -2009-05-11 Roger While - - * parser.y, typeck.c : Implement ACCEPT OMITTED - * parser.y : UNTIL EXIT as alternative to FOREVER - -2009-05-01 Roger While - - * General : Code clean/sanitize - -2009-04-11 Roger While - - * General : Support icc - * parser.y, typeck.c : Support LOCK clause on OPEN - -2009-03-16 Roger While - - * codegen.c : Cancel contained programs - -2009-03-12 Roger While - - * Makefile.am : Fix for newest development tools - -2009-03-09 Roger While - - * codegen.c : Fix valid multi-source nested and contained programs - -2009-03-06 Roger While - - * field.c : Fix up LENGTH clause with CONSTANT - -2009-03-03 Roger While - - * codegen.c : Fixes for icc - -2009-02-23 Roger While - - * parser.y : Allow figurative literal on FROM clause - * cobc.c : Harden against stack smash/buffer overflow attacks - * typeck.c : Fix up COLUMN clause - -2009-02-16 Roger While - - * parser.y, scanner.l : Differentiate LENGTH OF as special - -2009-02-14 Roger While - - * tree.c, tree.h, typeck.c, field.c : Fix size warning for BINARY-xxx - * scanner.l : Fix compiling a listing output from a previous compile - -2009-02-12 Roger While - - * tree.c, tree.h, typeck.c, codegen.c : Fix CANCEL for contained programs - * pplex.l : Ignore $SET at column 7 when fixed format - -2009-02-11 Roger While - - * tree.h, typeck.c, field.c : Fix up ODO checking - * codegen.c, parser.y, tree.c, tree.h, cobc.c : - Nested/contained visibility fixes - -2009-02-06 Roger While - - * pplex.l : Check all of "Area A" after AUTHOR etc. - -2009-02-02 Roger While - - * scanner.l : Fix parsing of # lines - -2009-01-30 Roger While - - * warning.def, parser.y, scanner.l, tree.h : Unreachable statement warn - * cobc.c : Fix program name - -2009-01-29 Roger While - - * parser.y, scanner.l, tree.h : Force LITERAL for PROGRAM-ID - -2009-01-28 Roger While - - * parser.y : Fix warning on non-USING LINKAGE item redefines - * codegen.c : Remove refs to call.def - * cobc.c, codegen.c, typeck.c : Remove -dynopt usage - * Makefile.am : Remove call.def - -2009-01-27 Roger While - - * parser.y : Fix PROGRAM-ID types - * typeck.c : Change hyphen interpretation - * codegen.c : Optimize CALL literal - -2009-01-24 Roger While - - * cobc.c, codegen.c : Fix up labels - -2009-01-24 Roger While - - * cobc.c : Fix signals for MinGW - -2009-01-23 Roger While - - * tree.c, typeck.c : RETURN-CODE is GLOBAL in nested programs - * reserved.c : Allow not-reserved from config on functions - -2009-01-22 Roger While - - * typeck.c, tree.c, tree.h, codegen.c : - Change warning for special registers - * parser.y : Divorce constant fields from the working list - * typeck.c : Fix ACCEPT/DISPLAY AT llcc for screen items - * reserved.c, tree.c, tree.h, scanner.l, parser.y : - Functions CONCATENATE and SUBSTITUTE-CASE - -2009-01-20 Roger While - - * scanner.l : Allow empty alphanumeric literal - * parser.y, codegen.c : Minimal value occurs support for screen items - -2009-01-18 Roger While - - * parser.y, reserved.c : Preliminary parse syntax for RW - * field.c : Fix 78 level - -2009-01-17 Roger While - - * cobc.c, tree.h, reserved.c : --list-mnemonics - -2009-01-15 Roger While - - * parser.y, tree.h, typeck.c, codegen.c : SCROLL for ACCEPT/DISPLAY - * tree.c : Fix usage of FUNCTION as PERFORM subject - -2009-01-14 Roger While - - * parser.y, tree.h, typeck.c : ACCEPT .. FROM LINES/COLUMNS - -2009-01-12 Roger While - - * scanner.l : Fix DISPLAY UPON - * parser.y, tree.h, field.c : Allow 78 level within record description - -2009-01-03 Roger While - - * codegen.c : Fix group initialization with ODO subitems - -2008-12-31 Roger While - - * codegen.c : Fix LOCAL-STORAGE variable definition - * parser.y, scanner.l : Tighten checks - -2008-12-21 Roger While - - * field.c : Fix GLOBAL INDEXED - * scanner.l : Fix comma parsing yet again - -2008-12-20 Roger While - - * General : Clean up - * tree.c, tree.h, reserved.c, scanner.l : Implement SUBSTITUTE function - -2008-12-16 Roger While - - * codegen.c : Fix local storage - * parser.y, scanner.l, tree.c, flag.def : - CONFIGURATION SECTION is not allowed in nested programs. - CONFIGURATION SECTION is inherited by nested programs. - FUNCTION ALL INTRINSIC in REPOSITORY allows functions - without FUNCTION keyword. Can also be activated - with -ffunctions-all. - -2008-12-15 Roger While - - * scanner.l : Clean up - * parser.y : Fix program type parsing - * parser.y, scanner.l, typeck.c : Split out display constructs - -2008-12-12 Roger While - - * scanner.l : Fix comma parsing - * cobc.c, tree.h, reserved.c : Option --list-intrinsics - -2008-12-08 Roger While - - * parser.y, tree.h, codegen.c, reserved.c : Implement infinite PERFORM - * tree.h, typeck.c, codegen.c : Do not gen internal registers unnecessarily - -2008-12-03 Roger While - - * codegen.c : Better code for handling file errors - -2008-12-01 Roger While - - * parser.y : Fix up OBJECT-COMPUTER paragraph - * codegen.c : Use pointer for frame stack manipulation - -2008-11-28 Roger While - - * parser.y, cobc.c, tree.c, tree.h, codegen.c : USE GLOBAL changes - -2008-11-21 Roger While - - * typeck.c : Fix binary initialization - -2008-11-20 Roger While - - * General : Tidy up - * typeck.c : Fix abort due to invalid syntax - * parser.y : Tighten up checking - -2008-11-14 Roger While - - * cobc.c : Insert signal processing - -2008-11-12 Roger While - - * parser.y : Preliminary acceptance of REPOSITORY. - LOCAL-STORAGE is not allowed in nested programs - -2008-11-11 Roger While - - * tree.h, typeck.c, codegen.c : Fix BASED NULL check, add NULL check - for LINKAGE item (-debug) when not a PROC DIV USING param - -2008-11-09 Roger While - - * General : Correct CALL conventions, tidy code - -2008-11-07 Roger While - - * General : Preliminary support for GLOBAL - -2008-11-02 Roger While - - * cobc.c, cobc.h, tree.h, codegen.c, typeck.c : - Handling of local fields, alphabet names, etc. - Create local include file for each, possibly nested, program - -2008-11-01 Roger While - - * scanner.l : Relax comma separator rule - -2008-10-31 Roger While - - * typeck.c : Figurative constant as call parameter is invalid - -2008-10-30 Roger While - - * typeck.c : ASSIGN to 88 item is invalid - -2008-10-27 Roger While - - * flags.def, pplex.l : New -fmfcomment - '*' and '/' in col 1 - -2008-10-26 Roger While - - * tree.h, typeck.c, codegen.c : Fix sign manipulation on overflow fields - * typeck.c : Relax checking on literal to binary move - -2008-10-24 Roger While - - * parser.y : Implement legacy TRANSFORM - * parser.y : Allow SORT STATUS - -2008-10-17 Roger While - - * typeck.c : Check BASED items in debug mode - -2008-10-11 Roger While - - * field.c : Do not allow edited PIC with binary/packed fields - -2008-10-05 Roger While - - * parser.y : Fix invalid SEARCH abort - -2008-09-29 Roger While - - * codegen.c : Fix bug in multi-program source file genning - * codegen.c : Tidy up date/time info in genned C code - -2008-09-22 Roger While - - * typeck.c : Pass FILE STATUS for SORT files - -2008-09-15 Roger While - - * cobc.c : -I options must also be passed to the C compiler - * reserved.c, parser.y, typeck.c : Preliminary WAIT support - -2008-08-20 Roger While - - * codegen.c : Change to check for __builtin_expect - -2008-08-16 Roger While - - * codegen.c : Unions for function pointers - -2008-08-10 Roger While - - * parser.y, cobc.c, cobc.h, typeck.c : Do not allow C keywords - as file names or PROGRAM-ID's - -2008-08-01 Roger While - - * pplex.l : Specific fix for >>D - -2008-07-31 Roger While - - * parser.y : FOREGROUND/BACKGROUND must be propagated from parent - -2008-07-28 Roger While - - * typeck.c : Check min/max values on BINARY-xxx/COMP-5/COMP-X properly - -2008-07-26 Roger While - - * parser.y : Allow literal on FROM clause for WRITE/REWRITE/RELEASE - * pplex.l : Rewrite source reading - * warning.def : Don't set column-overflow/terminator with -Wall - -2008-07-22 Roger While - - * cobc.c, cobc.h, warning.def : Remove unused field from macros - -2008-07-21 Roger While - - * typeck.c : Tighten up 88 level checking - * pplex.l : Directives parsing rewrite - -2008-07-20 Roger While - - * parser.y : Catch mutliple PROGRAM-ID without matching END PROGRAM - -2008-07-19 Roger While - - * General : Tidy up syntax - -2008-07-18 Roger While - - * General : Tighten up invalid syntax checking - * parser.y, tree.c, tree.h, typeck.c : Experimental CONSTANT support - -2008-07-16 Roger While - - * typeck.c : Fix segfault on invalid expressions, fix gcc warning - * parser.y : Preliminary CONSTANT support - * reserved.c : ACU keywords - -2008-07-11 Roger While - - * parser.y, tree.c, typeck.c, codegen.c : ALPHABET/CLASS - syntax/checking changes - -2008-07-09 Roger While - - * tree.h, typeck.c, codegen.c : Fix up SCREEN handling - -2008-07-08 Roger While - - * cobc.c : Prevent display of -fstatic-call in help text - -2008-07-07 Roger While - - * codegen.c : Remove gcc nested function code - -2008-07-05 Roger While - - * codegen.c : Prevent C warning with -fstatic-call and pointer return - -2008-07-04 Roger While - - * General : Cleanup - * pplex.l : Fix for strict directive parsing - -2008-07-02 Roger While - - * reserved.c, parser.y : Implement BINARY-C-LONG - * parser.y : Proper checks for missing END-xxx terminators - -2008-07-01 Roger While - - * codegen.c : Fix BY VALUE passing of POINTER - -2008-06-29 Roger While - - * tree.c : Temporary nuke of literal length test - -2008-06-25 Roger While - - * parser.y : SCREEN section input field definition - -2008-06-22 Roger While - - * pplex.l, ppparse.y : Fix SOURCE FORMAT directive - -2008-06-17 Roger While - - * parser.y : Amendments to SCREEN/ACCEPT/DISPLAY - -2008-06-12 Roger While - - * tree.c, codegen.c : Fix possible segfault - -2008-06-11 Roger While - - * parser.y : Fix ALTERNATE key - -2008-06-10 Roger While - - * parser.y, tree.c, tree.h, typeck.c, codegen.c : More SCREEN changes - -2008-06-05 Roger While - - * codegen.c : Prepare for linptr reuse - -2008-06-03 Roger While - - * tree.h, parser.y, typeck.c : Support UNLOCK statement - -2008-05-31 Roger While - - * parser.y, tree.c : Allow VARYING on LINE SEQUENTIAL - * tree.h, typeck.c : Prepare for parser changes - * codegen.c : Do not do screen initialization until required - -2008-05-23 Roger While - - * parser.y, typeck.c : Allow FUNCTION (obviously only alphanumeric) as the - object of a CALL (e.g. CALL FUNCTION UPPER-CASE (dataitem) ... - * parser.y, tree.h, codegen.c : Better display of POINTER items - -2008-05-22 Roger While - - * codegen.c : Fix pointer usage for non-aligned architecture - -2008-05-21 Roger While - - * codegen.c : Fix use of special literals in CLASS clause - -2008-05-19 Roger While - - * cobc.c : Fix "translating" verbose message being printed too early - * parser.y, codegen.c, tree.h : More support for SCREEN - -2008-05-16 Roger While - - * typeck.c : Allow MOVE NULL to index item - -2008-05-14 Roger While - - * tree.h, typeck.c, parser.y : Simplify accept from environment - * pplex.l : Add legacy REMARKS - -2008-05-12 Roger While - - * codegen.c : Fix NULL params for sticky linkage - * field.c, typeck.c, codegen.c : Add some more SCREEN code - * typeck.c : Allow DISPLAY on stderr when screen active - -2008-04-21 Roger While - - * codegen.c : Fix offset for fields following an ODO (MF) - -2008-04-18 Roger While - - * typeck.c : Fix initialization of fractional packed fields - -2008-04-15 Roger While - - * tree.c, tree.h, parser.y, typeck.c : Handle qualified INDEXED BY items - * cobc.c, codegen.c : Add build date to info lines - -2008-04-02 Roger While - - * reserved.c, tree.c, tree.h : Implement FUNCTION COMBINED-DATETIME - -2008-03-31 Roger While - - * reserved.c, scanner.l, tree.c, tree.h : Implement function - LOCALE-TIME-FROM-SECONDS - -2008-03-29 Roger While - - * General : Fix up sparse warnings - -2008-03-24 Roger While - - * parser.y, tree.c, tree.h, codegen.c : Refmodding for some FUNCTIONS - -2008-03-19 Roger While - - * ppparse.y, pplex.l : Correct COPY ... IN .. processing - * parser.y : Relax syntax for MF - * parser.y, reserved.c : Allow PRINTER - -2008-03-17 Roger While - - * typeck.c : Optimize MOVE ALL - -2008-03-06 Roger While - - * flag.def : Remove line-directive, tidy up comments - * codegen.c : Take out line directive - * cobc.c : Turn on source location for -g - * cobc.c, cobc.h : Define ABORT to cobc_abort, make cob_jmpbuf static - * cobc.c, cobc.h, scanner.l, typeck.c : Use new routine cobc_realloc - * cobc.c : In case of unrecognized option, exit immediately - -2008-03-05 Roger While - - * tree.c : Cater for SELECT without corresponding FD clause - * cobc.c : Retain .c and .c.h files when -g option specified - -2008-03-04 Roger While - - * cobc.c : The -ext option must take precedence over default suffixes - -2008-02-22 Roger While - - * codegen.c : NULL terminate CALL, clean up - -2008-02-19 Roger While - - * codegen.c : Fix INITIALIZE on field reference modification - -2008-02-16 Roger While - - * parser.y, codegen.c, tree.c, tree.h, field.c : Preliminary support for - ANY LENGTH - -2008-02-14 Roger While - - * tree.c : Tighten checking on field size - * parser.y : Produce real names instead of tokenized names on error - Change "$end" to "end of file" - -2008-02-12 Roger While - - * codegen.c : Use new function cob_set_location - -2008-01-19 Roger While - - * warning.def, typeck.c : Warn when ASSIGN references implicit field - -2008-01-10 Roger While - - * codegen.c : Fix up BY REFERENCE/CONTENT/VALUE processing - -2008-01-09 Roger While - - * parser.y : BY CONTENT is not allowed in PROCEDURE header - -2008-01-07 Roger While - - * parser.y, reserved.c, tree.c : Allow MF syntax for ASSIGN DISK/FILE-ID - * parser.y, typeck.c, tree.c, tree.h : DISPLAY .. UPON COMMAND-LINE - -2008-01-06 Roger While - - * typeck.c, codegen.c : Fix CALL statement returning a pointer - Note, this needs fixing for alignment intolerant machines - -2008-01-03 Roger While - - * typeck.c, codegen.c : Remove references to own_memxxx and SUPER_OPTIMIZE - -2008-01-02 Roger While - - * parser.y : Fix up VALUE OF in FD clause - -2007-12-27 Roger While - - ** Mark 1.0 RELEASE - -2007-12-12 Roger While - - * typeck.c : numeric literal is not allowed with ALL - -2007-12-03 Roger While - - * typeck.c : Fix values of PI and E - -2007-10-30 Roger While - - * cobc.c, codegen.c : Fix size_t <-> int casts - * typeck.c, codegen.c : Fix binary alignment on non-tolerant machines - * typeck.c : Fix abort with invalid condition syntax - -2007-10-24 Roger While - - * typeck.c : Fix unsigned comparison - -2007-10-23 Roger While - - * codegen.c : Check HAVE_ATTRIBUTE_ALIGNED - * typeck.c : Fix C-5 comparison - -2007-10-22 Roger While - - * cobc.c : Fix -fnotrunc - * typeck.c : Enumerate PI and E to 35 digits - -2007-10-18 Roger While - - * typeck.c : Tighten up 88 level usage in conditions - -2007-10-12 Roger While - - * tree.c, tree.h, typeck.c, codegen.c : The special registers - RETURN-CODE, SORT-RETURN and NUMBER-OF-CALL-PARAMETERS must be - per module and not per compilation unit. - -2007-10-10 Roger While - - * field.c : More checking for 77/78 levels - -2007-09-20 Roger While - - * field.c : Fix up PIC string encoding - -2007-09-12 Roger While - - * tree.h, typeck.c, reserved.c : Add in definitions for channels - -2007-09-11 Roger While - - * codegen.c : Fix a PERFORM problem whereby the UNTIL was comparing - signed to unsigned. - -2007-09-10 Roger While - - * typeck.c, codegen.c : Fix unsafe optimization - -2007-09-08 Roger While - - * parser.y, error.c : Fixes for EXIT SECTION/PARAGRAPH - * flag.def, cobc.c : New option -fnotrunc ala MF - -2007-09-07 Roger While - - * General : unistd.h is not available on native Win - * codegen.c, tree.c, typeck.c : Fix up pic string creation - * reserved.c, parser.y : Implement EXIT SECTION/PARAGRAPH - -2007-08-31 Roger While - - * flags.def, codegen.c : New option -fstack-check, autoset when - --debug or -g set, no longer reliant on a -O option - - * All : 78 levels in ASSIGN - * typeck.c : Better checking for source moves - * codegen.c : Cater for changed fileio struct - -2007-08-23 Roger While - - * All : Remove ASCII 10/20, default display sign according to target machine, - allow -fsign-ascii, -fsign-ebcdic - -2007-08-20 Roger While - - * typeck.c : Fix a segfault with invalid expression - -2007-08-17 Roger While - - * cobc.h, codegen.c : Detect native EBCDIC machine. - Treat ALPHABET/COLLATING EBCDIC as native on EBCDIC machines. - ALPHABET/COLLATING STANDARD-1/2 must go through transaltion on - EBCDIC machines - -2007-08-14 Roger While - - * codegen.c : Set file version - -2007-08-12 Roger While - - * typeck.c : Fix for EBCDIC machines - -2007-08-10 Roger While - - * parser.y, typeck.c, tree.h, flag.def : Implement -fassign-external - This allows MF conform ASSIGN EXTERNAL filename mapping - -2007-08-09 Roger While - - * cobc.c : Allow environment variable COBCPY to specify copy directories - -2007-08-01 Roger While - - * codegen.c : If -fimplicit-init is specified, always set up the cancel - callback - -2007-07-30 Roger While - - * parser.y : Allow unqualified names in the OCCURS KEY clause - -2007-07-26 Roger While - - * tree.h, parser.y, codegen.c : Trace improvements - * parser.y, error.c, codegen.c : Fix a problem with valid duplicate - paragraph names - * typeck.c : Optimize comparison of unsigned numeric display fields - -2007-07-24 Roger While - - * codegen.c : Reinstate aligned attribute - -2007-07-21 Roger While - - * cobc.h, typeck.c, codegen.c : Fixup for DEC Alpha alignment - * cobc.c : Use calloc instead of malloc - -2007-07-18 Roger While - - * codegen.c : Fix a leak of cob_decimal structures when doing CANCEL - -2007-07-09 Roger While - - * typeck.c : Fix debugging subscript check to report correct - field name - * tree.c, typeck.c : Optimize VARYING always - -2007-07-07 Roger While - - * parser.y, tree.c : Tighten checks on RECORD clause - -2007-07-05 Roger While - - * codegen.c : Fix wrong BY VALUE parameter generation - -2007-07-01 Roger While - - * cobc.c : Always export TMPDIR to the enviroment - * typeck.c : Further optimization - -2007-06-26 Roger While - - * codegen.c : Fix C warning on CLASS clause - -2007-06-25 Roger While - - * parser.y, typeck.c : Fix up EVALUATE checks yet again - * parser.y, pplex.l : Constify string params to cb_error(_x) - -2007-06-21 Roger While - - * tree.c : Produce error for partial expression code on WHEN clause - * codegen.c : When calling a "system" function (e.g. CBL_OPEN_FILE) with - implicit "sticky linkage" (ie. -std=mvs), do not extend the parameter list - with NULL's - * cobc.c : Help was missing for -conf= - -2007-06-19 Roger While - - * parser.y : Fix up WHEN NOT - -2007-06-18 Roger While - - * General : Replace the word illegal with invalid - -2007-06-16 Roger While - - * tree.h, parser.y, typeck.c, codegen.c : Fix subtle difference between GOBACK - and EXIT PROGRAM - -2007-06-14 Roger While - - * codegen.c : Fix field access on REDEFINES of BASED/EXTERNAL items - -2007-06-06 Roger While - - * parser.y, typeck.c : LOCK clause on WRITE/REWRITE - -2007-05-21 Roger While - - * parser.y, typeck.c : Implement IGNORING LOCK - * parser.y : Take out PENDING status for LOCK on READ - -2007-05-18 Roger While - - * parser.y : Prevent duplicate ORGANIZATION use; particularly the mistake - INDEXED SEQUENTIAL - -2007-05-16 Roger While - - * parser.y : LOCK clause on a READ is illegal when the SELECT clause specifies - LOCK AUTOMATIC - -2007-05-15 Roger While - - * parser.y : The END PROGRAM identifier must agree with the PROGRAM-ID - -2007-05-14 Roger While - - * parser.y, codegen.c : Use original names, not the mangled names when tracing - -2007-05-11 Roger While - - * codegen.c : Fix miscompilation with nested source programs - * cobc.c : Tighten up checking for presence of input files - -2007-05-09 Roger While - - * cobc.c : Implement -D option to specify defines for C compiles and - and eventuallly for conditional COBOL compilation. - Fix up HP-UX machines that per default do not honour SHLIB_PATH. - Implement -b option to create a single dynamically loadable object from - multiple input files. - -2007-05-08 Roger While - - * codegen.c : More fixes alignment intolerant machines - -2007-05-04 Roger While - - * parser.y, codegen.c, tree.h : Preliminary support for LOCK clause in SELECT - -2007-04-30 Roger While - - * field.c : BINARY-CHAR is always one byte regardless of -std= - -2007-04-28 Roger While - - * codegen.c : If -fimplicit-init is used, we must always honour an EXIT PROGRAM - -2007-04-26 Roger While - - * typeck.c, codegen.c : Fix POINTER on alignment intolerant architecture - -2007-04-11 Roger While - - * parser.y, typeck.c, tree.c, tree.h : Either LINE or COLUMN - can be optional on DISPLAY/ACCEPT - -2007-04-10 Roger While - - * typeck.c : Enable runtime numeric checks for ADD/SUBTRACT in debug mode - Pass number of delimiters for unstring - * pplex.l : If -fdebugging-line is specified, treat a "D" in column 7 - (fixed format) as a space - -2007-03-29 Roger While - - * codegen.c : EXIT PROGRAM should be ignored for main program - -2007-03-28 Roger While - - * field.c : Fix loop caused by ODO field item following ODO clause - -2007-03-27 Roger While - - * codegen.c : Fix warning on 64-bit, display prog id with trace - -2007-03-16 Roger While - - * typeck.c : Do more param checking otherwise we get a cast abort - -2007-03-01 Roger While - - * codegen.c : Fix LOCALE reference, general code cleanup - * parser.y : Allow LOCALE field reference - -2007-02-23 Roger While - - * parser.y : Fix multiple EXIT PERFORM - * cobc.c, cobc.h, tree.c, codegen.c : Use separate id fields for attributes, - literals and fields - -2007-02-13 Roger While - - * tree.h, typeck.c, codegen.c : Gen cob_decimal_set_int if required - * cobc.c : Test -Wno-pointer-sign only with _GNUC_ - -2007-02-11 Roger While - - * codegen.c : Change char to int for flags - * warning.def : Check for non 01/77 levels on CALL params - should/is not activated per default (standards) - -2007-02-09 Roger While - - * tree.c, tree.h, typeck.c : Implement SORT-RETURN - -2007-02-07 Roger While - - * parser.y, tree.c, tree.h, reserved.c, scanner.l, codegen.c : - Implement LOCALE in special names - Implement FUNCTION's LOCALE-DATE, LOCALE-TIME - -2007-02-01 Roger While - - * tree.h, typeck.c : A READ/RETURN INTO must not move contents - when the AT END/INVALID KEY condition is met. - -2007-01-29 Roger While - - * parser.y, tree.[hc] : Preliminary stuff for LOCALE - * parser.y, config.def : Implement odo-without-to; For - 85/2002, an ODO without a TO clause is not allowed - -2007-01-26 Roger While - - * typeck.c : Harden validity tests - -2007-01-24 Roger While - - * parser.y, typeck.c : Implement new SORT routines - Note that these no longer need the ISAM handler - -2007-01-17 Roger While - - * parser.y, typeck.c, tree.c : - Add support for OMITTED as parameter to a CALL. - Add support for "IF item OMITTED" - -2007-01-16 Roger While - - * reserved.c, tree.c, tree.h : Implement FUNCTIONs - SECONDS-PAST-MIDNIGHT, SECONDS-FROM-FORMATTED-TIME - -2007-01-15 Roger While - - * typeck.c, codegen.c : Pass field offsets for keys - * parser.y, tree.c, tree.h, codegen.c, typeck.c : Allow special - ASSIGN [TO] DISPLAY - -2007-01-10 Roger While - - * parser.y : A file SORT (as opposed to a table SORT) must have - a KEY phrase and a USING or INPUT PROCEDURE and a - GIVING or OUTPUT PROCEDURE. - A table SORT must not have USING/INPUT or GIVING/OUTPUT. - * parser.y, tree.c, tree.h, codegen.c, typeck.c : Allow special - ASSIGN [TO] KEYBOARD - -2007-01-08 Roger While - - * codegen.c : Implement new cancel processing - -2006-12-19 Roger While - - * parser.y : Fix DECLARATIVES followed by non-section, cleanup - * flex files cleanup - -2006-12-17 Roger While - - * reserved.c, tree.c, parser.y, codegen.c, scanner.l : Correct the NUMVAL-C function - -2006-12-07 Roger While - - * reserved.c, tree.c, parser.y : Implement TRIM function - -2006-11-28 Roger While - - * tree.[hc], error.c field.c : Fix incorrect line reporting of FILLER items - * typeck.c : Use new compare routines - -2006-11-18 Roger While - - * parser.y : Initialize EVALUATE check stack at current level - at statement start - -2006-11-12 Roger While - - * pplex.l : Check source suffixes also when a COPY refers to - an absolute path name - Fix an obscure problem whereby a 2 line data definition - following a COPY and the second line was a literal - continuation would not compile - * typeck.c : Remaining cmp/add/sub optimizations - -2006-11-06 Roger While - - * tree.h, typeck.c, error.c, field.c : - Fix incorrect line number on redefinition warning - Fix abort when ASSIGN data name duplicates SELECT name - -2006-10-25 Roger While - - * parser.y : Allow COBOL standard of INSPECT REPLACING - NOTE - TALLYING is still deficient - -2006-10-23 Roger While - - * Makefile.am : Remove gcc options - cobc.c : Check for .lib suffix on MSC compile - -2006-10-18 Roger While - - * typeck.c : Fix ODO subscript checking - -2006-10-15 Roger While - - * typeck.c : Use table for optimization - * cobc.c : Compilation defines generated by codegen - * codegen.c : Generate optimization defines - -2006-10-14 Roger While - - * scanner.l : Fix a problem with 78 level - * tree.c, tree.h : Fix abort, clean up and new cb_fits_long_long - -2006-09-30 Roger While - - * codegen.c : Sergey's non-gcc fixes - * parser.y : Fix an abort with ENTRY - * general : clean up - -2006-08-23 Roger While - - * scanner.l, tree.c : Fix 78 levels - -2006-08-11 Roger While - - * parser.y, cobc.h, typeck.c : The target of an INSPECT can be - a FUNCTION/Literal provided there is only a TALLYING clause - -2006-08-09 Roger While - - * reserved.c : Fix wrong categories for some functions - -2006-08-03 Roger While - - * flags.def, codegen.c : -fimplicit-init, allow libraries - to be built. - -2006-07-31 Roger While - - * field.c : Fix COMP-X allocation - -2006-07-28 Roger While - - * scanner.l : Usage of 78 is allowed in PIC clauses - * typeck.c : Allow 66 as CALL parameter - -2006-07-26 Roger While - - * All : clean up for gcc 4 - * typeck.c, tree.c, tree.h, codegen.c : System routines - -2006-07-19 Roger While - - * parser.y, typeck.c : Tighten up field checking - * All : General clean up - -2006-07-14 Roger While - - * parser.y, field.c : Change EXTERNAL checking - -2006-07-12 Roger While - - * parse.y, reserved.c, tree.h, tree.c typeck.c, codegen.c : - Implement ALLOCATE/FREE - -2006-07-02 Roger While - - * tree.c, typeck.c : Check not referenced SELECT - -2006-06-28 Roger While - - * All : Change cob_malloc to cobc_malloc - -2006-06-08 Roger While - - * typeck.c : With --debug, we should be generating subscript checking - * pplex.l, cobc.c : Change listing output - -2006-06-06 Roger While - - * parser.y : Initialize INDEXED BY fields to 1 - * codegen.c, typeck.c : Optimization for machines that are not alignment tolerant - -2006-06-05 Roger While - - * codegen.c, typeck.c, reserved.c, parser.y : - Accept [WITH] [NO] LOCK on READ - Accept UNLOCK filename [RECORD[S]] - Implement PREVIOUS for IS files - -2006-06-02 Roger While - - * typeck.c : Fix wrongly optimized partial reference - -2006-05-27 Roger While - - * codegen.c : Stack overflow check, implement new cob_fatal_error, - fix null ref on cob_current_section/paragraph - -2006-05-23 Roger While - - * parser.y, scanner.l, field.c : Change 78 level processing - -2006-05-20 Roger While - - * warning.def, cobc.c, cobc.h : Change CB_WARNING to CB_WARNDEF - Just to simplify as we have an enumerator with this name - * warning.def, cobc.c, typeck.c : Implement -Wtruncate - Thanks to Hans-Martin Rasch for providing the meat of this code. - This warns when a MOVE might cause truncation. - The option is NOT turned on by -Wall - * typeck.c : Fixes for extended ACCEPT/DISPLAY - -2006-05-18 Roger While - - * reserved.c, tree.c, codegen.c : Implement FUNCTION's EXCEPTION-FILE, - EXCEPTION-STATEMENT, EXCEPTION-LOCATION and EXCEPTION-STATUS - * codegen.c : Fixes for HP IA64 port - -2006-05-13 Roger While - - * parser.y : Allow slightly different DISPLAY syntax - * warning.def, typeck.c : Warning option "call-params" to check - that CALL parameters are 01 or 77 - * codegen.c : Fix a possible out-of-bounds reference discovered - with valgrind - -2006-05-12 Roger While - - * typeck.c : Do not accept 66, 88 levels as USING params - * parser.y, typeck.c : [NOT] EXCEPTION on ACCEPT/DISPLAY - -2006-05-10 Roger While - - * parser.y, typeck.c, codegen.c : Prelimary syntax support for - CURSOR IS and CRT STATUS IS - * reserved.c, tree.c, codegen.c : Implement STORED-CHAR-LENGTH (Fujitsu) - -2006-05-09 Roger While - - * parser.y, reserved.c, field.c : Implement BINARY-(CHAR/SHORT/LONG/DOUBLE) - and the ACU synonyms (UN)SIGNED-(SHORT/INT/LONG) - -2006-05-08 Roger While - - * parser.y, tree.h, typeck.c : Implement TRAILING in INSPECT clause (ACU) - -2006-05-06 Roger While - - * reserved.c, parser.y,codegen.c : PROCEDURE DIVISION CHAINING - -2006-05-04 Roger While - - * codegen.c : Use likely/unlikely macros - -2006-05-03 Roger While - - * parser.y, typeck.c, codegen.c : Preliminary changes for screen - and extended accept/display - * scanner.l : Allow MF extension from SPECIAL-NAMES SWITCH syntax - -2006-05-01 Roger While - - * All : General clean up - Changes for native EBCDIC machines - Optimization - See libcob/ChangeLog - * parser.y, typeck.c : Allow ACU's SET ENVIRONMENT - * parser.y, typeck.c : Start changes for WHEN partial expression - * parser.y : Allow CONSOLE [IS] CRT (MF, ACU) - * cobc.c : Add CPY and cpy to automatically detected COPY extensions - * codegen.c : Detect gcc < 3 (Doesn't like nested functions) - * config.c : Fix an enum - Allow sign-ebcdic and sign-ascii20 - * pplex.l, scanner.l : Allow underscore '_' in user names (2002 standard) - * field.c : Implement support for 78 level (MF, ACU) - -2006-04-17 Roger While - - * typeck.c : Optimize cob_add_xxx, cob_cmp_xxx - codegen.c, parser.y : Fix SPACE, ZERO in CLASS - -2006-04-05 Roger While - - * field.c : Fix memory allocation when OCCURS at 01 level - parser.y, codegen.c : Fix CLASS clause in SPECIAL-NAMES - -2006-04-04 Roger While - - * parser.y : Correctly produce minimal one-line program: - PROGRAM-ID. MYPROG. - * codegen.c, field.c : Run lindent - -2006-03-31 Roger While - - * typeck.c : Fix abort on invalid SET - typeck.c, codegen.c, tree.c : Tidy abort reporting - Allow usage of ALPHABET names as identifiers - -2006-03-30 Roger While - - * reserved.c, parser.y : Allow DISK in SELECT - -2006-03-25 Roger While - - * cobc.[hc], codegen.c : Allow alternate ASCII/EBCDIC - SORT sequence. Exporting environment variable - COB_EBCDIC=FULL will activate *at compile time* - the full ASCII-EBDIC (256 character) sequence. - Otherwise, we use, as it was upto now, the MF - sequence. - -2006-03-22 Roger While - - * reserved.c : Fix reserved table sequence (INTO) - codegen.c : Fix ASCII/EBCDIC table again - -2006-03-22 Roger While - - * typeck.c : Implement COLLATING on table SORT - codegen.c : Update ASCII/EBCDIC table - -2006-03-21 Roger While - - * pplex.l : Fix regression in comma processing - -2006-03-20 Roger While - - * parser.y : Restrict values for CURRENCY SIGN - parser.y, typeck.c, tree.h, tree.c, codegen.c : - Support for PROGRAM-POINTER and PROCEDURE-POINTER. - Allow CALL PROGRAM-POINTER. - pplex.l, scanner.l, parser.y : Process comma in expressions - -2006-03-16 Roger While - - * parser.y : Fix param check for PROCEDUE/ENTRY - Allow EXTERNAL/DYNAMIC in SELECT - typeck.c : Force ref count for display items - -2006-03-10 Roger While - - * parser.y, tree.h, tree.c, typeck.c reserved.c : - Prepare support for PROGRAM-POINTER and - PROCEDURE-POINTER - -2006-03-05 Roger While - - * parser.y : Make syntax more correct - -2006-03-04 Roger While - - * codegen.c : Don't generate NULL params on CALL for !cb_sticky_linkage - parser.y : Allow ACU variant of ACCEPT FROM ENVIRONMENT - parser.y, tree.h, typeck.c : Implement WHEN SET TO FALSE IS - Also SET TO FALSE - -2006-03-02 Roger While - - * tree.c : cb_int cannot use hash table as value may be negative - * typeck.c : Param to cb_build_memset should be int - -2006-02-28 Roger While - - * parser.y, tree.h, tree.c, typeck.c, codegen.c : Handle CONTINUE - -2006-02-21 Roger While - - * typeck.c, codegen.c : Implement new inlines in - libcob/codegen.h - -2006-02-15 Roger While - - * parser.y : Check that PROCEDURE/ENTRY USING params - are in the LINKAGE SECTION - Check for executable program ("-x") and PROCEDURE/ENTRY - with USING params - -2006-02-12 Roger While - - * parser.y : Check duplicate ENTRY - -2006-02-08 Roger While - - * parser.y : Fix EVALUATE/88 again - parser.y, typeck.c, tree.h : Allow multiple destinations - on MOVE CORRESPONDING - typeck.c, codegen.c : Optimize COMP/COMP-3 - -2006-02-02 Roger While - - * parser.y : Fix EVALUATE and 88 level checking - -2006-02-01 Roger While - - * All : Changes for nested programs - Changes for EXTERNAL FD - -2006-01-28 Roger While - - * typeck.c : Optimize move literals, check PROG-ID not = source name - * parser.y : ID DIV is optional, don't abort on rubbish input, - generate "source name" entry point when != PROG-ID - -2006-01-26 Roger While - - * reserved.c : Allow not-reserved for not implemented words - -2006-01-25 Roger While - - * tree.h, tree.c, typeck.c, codegen.c : When using - CALL .. RETURNING .. with an OVERFLOW clause, do - not overwrite the returning field - -2006-01-20 Roger While - - * parser.y, field.c : Prepare for duplicate paragraph names - * scanner.l : Fix incorrect parsing - * field.c : Allow mismatched level numbers based on config - parameter relax-level-hierarchy - * codegen.c : Generate memset instead of memcpy for literals - when literal is a repeated character - * pplex.l : Fix fixed format literal continuation - -2006-01-18 Roger While - - * parser.y : Allow EQUAL in COMPUTE, Fix OBJECT-COMPUTER - -2006-01-17 Roger While - - * cobc.c : Don't warn -x/-m when using -E - field.c : Don't allow binary fields > 18 digits - -2006-01-08 Roger While - - * tree.c, field.c, typeck.c : Preliminary support for numeric - fields with up to 36 digits - -2006-01-07 Roger While - - * cobc.c : Remove --verbose long option. getopt_long_only - has a problem with e.g. -mv - Change 'Version' back to 'version'. - -2006-01-05 Roger While - - * General : Bootstrap to new libtool/automake - * cobc.c [MSC_VER]: MS VS/VC specific changes - Get COB_LDFLAGS from config - * tree.c : Fix invalid picture - * codegen.c : Non-gcc and MS VS/VC fixes - -2006-01-03 Roger While - - * scanner.l : Fix wrong numeric scan - -2005-12-30 Roger While - - * Change ifdef's on MINGW to WIN32 (Also defined on 64-bit Win) - -2005-12-28 Roger While - - * General : Further fixes for non-gcc - codegen.c : Don't use computed goto's for non-gcc - -2005-12-27 Roger While - - * General : Change all occurrences of "char[variable]" - * typeck.c : Fix huge literal generation - Hack for systems that need pointer alignment - -2005-12-23 Roger While - - * reserved.c : Use bsearch - -2005-12-19 Roger While - - * codegen.c : Fix sticky-linkage with ENTRY - -2005-12-18 Roger While - - * All : cleanup of "shadowed" variables - * codegen.c : File struct initialization - Save/restore params for sticky-linkage - Generate Ebcdic table when needed - -2005-12-13 Roger While - - * codegen.c : sticky-linkage changes - -2005-12-13 Roger While - - * codegen.c : Do not statically initialize the file structure - * cobc.c : Change long_opt "version" to "Version" - * parser.y : Extra EXTERNAL checking - -2005-12-09 Roger While - - * cobc.c : Show a warning to use '-x' for executables. - * typeck.c : Implement new display code. - -2005-12-08 Roger While - - * cobc.h : New defines - COB_SMALL_BUFF, COB_MEDIUM_BUFF, COB_LARGE_BUFF - * Relevant files : Replace all occurences of FILENAME_MAX/BUFSIZ - * codegen.c : Do not use arrays for cob_decimal - * flags.def : Mark -fmain as deprecated - * cobc.c : Implement '-x' option (Create executable). - Harden buffer checking for command lines. - Check illegal option combinations. - -2005-12-05 Roger While - - * tree.c : Take out unnecessary zero clears (Done by cob_malloc) - * cobc.c : Use the executable extension when stripping - -2005-12-04 Roger While - - * tree.c : Fix buffer usage - * typeck.c : Fix strftime for MingW - -2005-12-04 Roger While - - * codegen.c : Fix INITIALIZE - -2005-11-28 Roger While - - * parser.y, tree.c, typeck.c : Improve error checking - * codegen.c : Fix -debug code generation - -2005-11-25 Roger While - - * scanner.l, pplex.l : clean up - * cobc.c : don't use mkstemp on non-Win, tidy cleanup code, - add in bs2000 to help text, getopt includes, put back in -fno-gcse - * codegen.c : preliminary sticky-linkage code, - further mods for perform-osvs - -2005-11-09 Roger While - - * parser.y, tree.h, tree.c : Implement SAME RECORD - -2005-11-06 Roger While - - * parser.y, cobc.h, typeck.c, codegen.c : EXTERNAL changes - * typeck.c, codegen.c : character test optimization - -2005-11-05 Roger While - - * codegen.c : Preliminary code for perform OSVS - -2005-11-04 Roger While - - * cobc.c : Take out option -no-gcse - * codegen.c : Don't use arrays for local stack variables - Put in experimental (deactivated) setjmp/longjmp code for performs. - -2005-11-01 Roger While - - * codegen.c : Take out attribute aligned. It borks under latest Cygwin. - -2005-10-31 Roger While - - * cobc.c : Cater for -Wno-pointer-check correctly - -2005-10-26 Roger While - - * typeck.c : Remove HAVE_DB ifdef - -2005-10-25 Roger While - - * cobc.c, typeck.c : Add in optimizations (memset/memcpy) - -2005-10-14 Roger While - - * All : More GCC 4 fixes - * typeck.c : Take out last references to cb_runtime_inlining - * flag.def : Mark -fruntime_inlining as deprecated in help text - -2005-10-13 Roger While - - * cobc.c : For GCC >= 4, add -Wnopointer-sign - -2005-10-06 Roger While - - * pplex.l : Ignore DATE-MODIFIED - -2005-10-06 Roger While - - * Indent again - typeck.c - indents too far - need to look at cb_build_identifier - -2005-10-01 Roger While - - * Indent run on most source - * typeck.c/codegen.c: Start optimizing - - Unsigned numeric (Pic 9) field optimize - Retrieval of binary-swap 2,4,8 byte fields - Retrieval of 1 byte binary fields always optimized - Optimize referencing linkage section items - Test/set of 1 byte fields - * cobc.c : Print patch level for -V (e.g. 0.33.0) - -2005-08-07 Roger While - - * codegen.c : Prototypes, unneeded fields - * parser.y : unneeded fields - * config.c : indent - -2005-08-04 Roger While - - * codegen.c : Change initialization point of cob_screen_init - Change generated exit to cob_stop_run - * typeck.c : Typo - -2005-07-31 Roger While - - * parser.y : Fix a DISPLAY usage clash - * typeck.c : Bump the ref count for the field referred to by an 88 - * codegen.c : Implement program versioning - Change the aligned attribute again - Let the compiler do it - except if the field is >= 64; then align 64 - Only for - Intel/AMD 32-bit (Intel Optimization Manual) - * cobc.c : Allow -g when optimizing with -Os or -O2 - -2005-07-14 Roger While - - * pplex.l : Carriage-return must be ignored if not - followed by new-line. - -2005-07-14 Roger While - - * parser.y : Check for START on SEQ file - * All : Do malloc's through own new routine cob_malloc - This will produce an error and terminate if memory - cannot be acquired. - -2005-07-02 Roger While - - * scanner.l : Fix bugs in early parsing (Bug list) - * pplex.l : Fix REPLACING (Bug list) - * codegen.c : Change cob_module bit fields to char - -2005-06-28 Roger While - - * Cater for FUNCTION's - * Fix a LENGTH bug - * Fix the 2 compile warnings in cobc.c - -2005-06-13 Roger While - - * reserved.c : Add in missing 2002 reserved words. - -2005-06-11 Roger While - - * Some cleanups - -2005-06-09 Roger While - - * parser.y : Fix 88 level check for nested EVALUATE's. - -2005-06-07 Roger While - - * parser.y : INITIALIZE WITH FILLER - * tree.h, tree.c, typeck.c, codegen.c : Handle above and - also handle an INITIALIZE on a REDEFINE. - -2005-06-04 Roger While - - * typeck.c : disable optimization until we can do it really. - -2005-06-01 Roger While - - * cobc.c : Include unistd.h for MinGW. - * field.c : Warning for VALUE on EXTERNAL field. - -2005-05-31 Roger While - - * codegen.c : Fix code for children of external items. - * field.c, tree.h, tree.c, typeck.c, reserved.c : - Rough implementation of COMP-1/2. - -2005-05-31 Roger While - - * codegen.c : Fix false placement of the c.h file. - -2005-05-23 Roger While - - * cobc.c : New option -dynopt - * codegen.c : cater for -dynopt - Optimize dynamic calling - Move the include of the c.h down into the internal function. - This is necessary for upcoming nested programs. - * parser.y : cater for optimized dynamic calling. - -2005-05-21 Roger While - - * New file call.def : Defines entry points that will be generated as - static calls in COBOL programs. - e.g. own C routines or other software entry points that are - linked to the main program (or cobcrun). - - * codegen.c : Inline cob_module_xxx, cater for above call.def - check for cob_initialized in initialization path - -2005-05-15 Roger While - - * error.c - Change "warning: " to "Warning: " and insert "Error: ". - -2005-05-13 Roger While - - * cobc.c: Allow multiple input files when producing executable. - -2005-05-03 Roger While - - * tree.h : bit fields are unsigned. Round to boundaries. - typeck.c :Internal register NUMBER-OF-CALL-PARAMETERS. - tree.c : Fix ambiguous paragraph errors. - scanner.l : Move some syntax from the parser to here in the lexxer. - pplex.l : Initialize variables. - parser.y Move some syntax to the lexer. - Initialize variables. - Allow MF relaxed syntax. - SORT DUPLICATES is default. No need for warning. - field.c : Allow larger redefines than original field for - -std=cobol2002 and -std=mf. - config.def : New variables - larger-redefines-ok and - relaxed-syntax-check. - codegen.c : Do not generate unnecessary code e.g. switch - statement for only one entry point, loop counters. - Cater for NUMBER-OF-CALL-PARAMETERS. - Initialize variables. - Restructure generated C code. - Use builtin_expect. - cobc.c : Initialize variables. - Pass -fsigned-char to the compiler. - Fix dangling file with multiple compile. - cobc.h : Extern definitions. - -2005-04-15 Keisuke Nishida - - * Makefile.am (cobc_CFLAGS): Add -fsigned-char. - - * codegen.c (output_perform_call): Work around the GCC bug on ppc. - (Thanks to Tristan Gingold and Tom Murtagh) - -2005-03-07 Roger While - - * cobc.h, config.c, reserved.c : - New config variable - not-reserved - -2005-03-03 Roger While - - * cobc.h, tree.h, parser.y, reserved.c, cobc.c, tree.c, codegen.c, - typeck.c : - Implement LINAGE - Implement -Os - Implement stripping of main/modules with O2 or Os - Fix dangling preprocess file after non-existent file - Fix ASSIGN implicit data-item when not referenced - Implement some options for gcc >= 3 - Change an incorrect long to int - Change bit fields from long to int - -2005-02-22 Roger While - - * codegen.c : Generated C code indentation - * typeck.c : Check usage of 66 level with pointer - -2005-02-15 Roger While - - * codegen.c : Fix incorrect cast check, - LENGTH OF past as int (COMP-5) - -2005-02-15 Roger While - - * codegen.c : Fix .. BY VALUE LENGTH OF - -2005-02-12 Roger While - - * tree.h, tree.c, typeck.c, field.c, codegen.c : - .. BY CONTENT LENGTH OF .. - -2005-02-11 Roger While - - * codegen.c : small optimization and module - initialization sequence. - -2005-02-09 Roger While - - * codegen.c : Change order of generating variable - assignment. In the generated C header, we now - have firstly the item definitions, then the - attributes and finally the cob_field items. - EXTERNAL variable pointers are generated local - to the static prog function. - We are fairly close to acieving Keisuke's - wish for generating just one source file. - -2005-02-08 Roger While - - * parser.y, codegen.c, tree.h, tree.c - Implement EXTERNAL AS Literal - -2005-02-08 Roger While - - * codegen.c : Rearrange generated code slightly - Do not gen stack values we do not need - Generate static function prototype so that we - can gen code in order : main (if appropriate), - entry points, static function - -2005-02-07 Roger While - - * cobc.c : Slight change for Cygwin - * codegen.c : Adjust handling for EXTERNAL items - -2005-02-04 Roger While - - * codegen.c : Fix code gen for tag NULL - -2005-02-04 Roger While - - * parser.y, typeck.c, tree.h, tree.c, reserved.c : - implement DISPLAY .. UPON ENVIRONMENT-VALUE - implement DISPLAY .. UPON ARGUMENT-NUMBER - implement ACCEPT .. FROM ARGUMENT-NUMBER - implement ACCEPT .. FROM ARGUMENT-VALUE - -2005-02-01 Roger While - - * cobc.c : Add help text for -std= - -2004-11-05 Roger While - - * codegen.c : readjust align to 8 - -2004-11-05 Roger While - - * cobc.h : Print file/line when ABORT() - -2004-11-05 Roger While - - * codegen.c, field.c, tree.c, typeck.c : Handle arithemetic - for !binary_trunc. - -2004-11-02 Roger While - - * codegen.c : Thinko by me - Do not exit execution - if there is a file USE declarative and no FILE STATUS. - -2004-11-01 Roger While - - * tree.c : Fix bug 1014371 - 88 on POINTER - -2004-10-31 Roger While - - * cobc.c, codegen.c : Activate exceptions for I/O - -2004-10-31 Keisuke Nishida - - * parser.y (evaluate_object): Print error in the case when the - compiler cannot handle the expression correctly. Need fix. - -2004-10-30 Roger While - - * typeck.c, parser.y, error.c, field.c config.c, tree.c, tree.h, - pplex.l : Replace back-tick "'" with quote "'" - * codegen.c : specify aligned(4) and not just aligned. On IA32, - with gcc, default alignment is 16 which is non-optimal. - For 64-bit non-Intel platforms we may need 8 here to cater - for eventual direct casts for pointers and COMP-1/2 fields. - -2004-10-29 Keisuke Nishida - - * typeck.c (cb_build_length_1): New function. - (cb_build_length): Create an anonymous index and use it for length. - -2004-09-28 Keisuke Nishida - - * typeck.c (cb_build_move_field): Compare flag_binary_swap for - numeric moves. (Thanks to Roger While) - -2004-09-07 Keisuke Nishida - - * tree.c (finalize_file): Use cb_build_implicit_field to create record. - -2004-07-06 Keisuke Nishida - - * parser.y (add_statement, add_body, compute_statement, compute_body) - (divide_statement, divide_body, multiply_statement, multiply_body) - (subtract_statement, subtract_body): Parse on_size_error before - emitting the statement. - * typeck.c (build_store_option): New function. - (decimal_assign, build_decimal_assign, cb_build_add) - (cb_build_sub, cb_emit_divide): Updated for the new store scheme - in libcob. - -2004-05-15 Keisuke Nishida - - * parser.y (stop_statement): Accept RETURNING/GIVING phrase. - * typeck.c, tree.h (cb_emit_stop_run): Take an argument. - -2004-05-06 Keisuke Nishida - - * parser.y (procedure_division, entry_statement): Use using_clause. - * codegen.c (codegen, output_entry_function): Handle using_list - with BY REFERENCE/CONTENT/VALUE. - * typeck.c, tree.h (cb_build_using_list): Removed. - * cobc.c (process_translate): Do not call codegen when no entry. - -2004-05-04 Keisuke Nishida - - * parser.y (x): Accept literal with LENGTH OF operator. - * typeck.c (cb_build_length): Handle non-references. - -2004-05-04 Keisuke Nishida - - * typeck.c (cb_build_move_field): Optimize when the usage of src - and dst are the same, not only when they are DISPLAY. - (cb_build_move_high, cb_build_move_low): Really move low/high - values to numeric fields. - (cb_build_move): Do not convert 0 literal to ZERO. - -2004-04-19 Keisuke Nishida - - * tree.h (cb_perform): New members 'exit_label' and 'cycle_label'. - * reserved.c (CYCLE): New reserved word. - * parser.y (exit_statement): EXIT PERFORM [CYCLE] statement. - * codegen.c (output_perform_once, output_perform): Output labels. - -2004-04-07 Keisuke Nishida - - * parser.y (basic_literal, alnum_literal): Literal concatenation. - * tree.c, tree.h (cb_concat_literals): New function. - -2004-04-07 Keisuke Nishida - - * parser.y (sort_statement): Table sort. - * typeck.c (cb_emit_sort_init): Updated for table sort. - -2004-03-30 Keisuke Nishida - - * tree.c (cb_ref): Resolve by file name. - -2004-03-29 Keisuke Nishida - - * cobc.c (process_link) [__CYGWIN__, __MINGW32__]: Set - -Wl,--export-all-symbols instead of -Wl,--export-dynamic. - (Thanks to peg@coboler.com) - -2004-03-12 Keisuke Nishida - - * cobc.c (process_module, process_link): Modify compile options - for Win32. - -2004-03-10 Keisuke Nishida - - * parser.y (lock_mode_clause): Full parse without codegen. - * reserved.c (AUTOMATIC, EXCLUSIVE, MANUAL, ROLLBACK): New words. - -2004-03-10 Keisuke Nishida - - * codegen.c (output_call): Byte swap for literals. - -2004-03-10 Keisuke Nishida - - * parser.y (assignment_name): Accept qualified_word. - -2004-03-08 Keisuke Nishida - - * config.def (cb_synchronized_clause): New option. - * field.c (compute_size): Handle the SYNCHRONIZED clause. - * tree.c, tree.h (cb_field_align_size): Removed. - -2004-03-08 Keisuke Nishida - - * pplex.l (switch_to_buffer): Duplicate file name. - -2004-03-06 Keisuke Nishida - - * codegen.c (output_base): Always align the 01 items. - * field.c (compute_size): No alignment for now. - * tree.c, tree.h (cb_field_need_aligned): Removed. - -2004-03-06 Keisuke Nishida - - * reserved.c (system_table): Add "SYSLST". - -2004-03-06 Keisuke Nishida - - * typeck.c (cb_build_move): Handle cb_error_node. - (cb_build_add, cb_build_sub): Native arithmetic for pointers. - -2004-03-06 Keisuke Nishida - - * cobc.c: Use _WIN32 instead of __CYGWIN__ or __MINGW32__. - -2003-05-21 Keisuke Nishida - - * tree.h (cb_class, cb_category): New enums. - -2003-05-19 Keisuke Nishida - - * cobc.h (CB_STANDARD_GNU): New standard. - * cobc.h, cobc.c (cb_standard): Default compiler is now gnu. - -2003-05-18 Keisuke Nishida - - * cobc.c (short_options): New option '-O' - * flag.def (cb_flag_inline_get_int, cb_flag_inline_move): New flags. - * codegen.c (output_int32): Inlining cob_get_int. - (output_move): Inlining cob_move. - -2003-05-06 Keisuke Nishida - - * flag.def (cb_flag_check_numeric): Removed. - (cb_flag_check_subscript): Removed. - (cb_flag_check_ref_mod): Removed. - * warning.def (cb_warn_obsolete): New variable. - * cobc.h (cb_standard, cb_binary_rep): New variables. - (cb_exception_table): New variable. - (CB_EXCEPTION_CODE, CB_EXCEPTION_NAME, CB_EXCEPTION_ENABLE): New macro. - * cobc.c (long_options): New option -std and -debug. - (short_options): Remove -T. - (process_command_line): Handle new/old options. - (cb_obsolete, cb_unconformable): New functions. - * tree.c (compute_size): Compute size depending on cb_binary_rep. - * parser.y (push_file_handler): New macro. - -2003-05-04 Keisuke Nishida - - * flag.def: New file. - -2002-11-01 Keisuke Nishida - - * parser.y (resolve_predefined_names): Call recursively. - - * tree.h (YYLTYPE): Moved from parser.y. - -2002-10-30 Keisuke Nishida - - * inline.c (output_search): Move index to variable. - * inline.c (output_search_all): Unified 'cmp' variable. - -2002-10-30 Keisuke Nishida - - * codegen.c (output_perform_until): Merge 'output_perform_before' - and 'output_perform_after'. - (output_perform): Call 'output_perform_until'. - -2002-10-08 Keisuke Nishida - - * codegen.h (cobc_program_spec): New member 'loop_counter'. - * parser.y (perform_option): Increment loop_counter. - * codegen.c (loop_counter, loop_counter_max): Removed. - (output_perform): Declare loop_counter as a local variable. - (global_label, output_switch): Removed. - (output_perform_call): Don't use global_label. - (codegen): Merge codegen_1. Traverse the tree only once. - -2002-10-06 Keisuke Nishida - - * Integrate numeric expressions and conditional expressions. - * tree.h (cobc_tag_cond, cobc_cond_type, cobc_cond): Removed. - (make_negative): New macro. - * tree.c (make_expr): Build conditional as well. - (make_cond, make_negative): Removed. - * codegen.c, inline.c, parser.y: Updated. - -2002-10-06 Keisuke Nishida - - * tree.h (cobc_evaluate): Removed. - * tree.c (make_evaluate): Removed. - * codegen.c (output_tree): Do not handle cobc_evaluate. - (output_evaluate, output_evaluate_test): Removed. - * parser.y (make_evaluate, make_evaluate_test): Build evaluate tree. - -2002-10-02 Keisuke Nishida - - * parser.y (CONDITIONAL_NAME): Removed. - (condition_name_list, condition_name, qualified_cond_name): Removed. - (data_name, expr_item): Handle conditional names here. - * scanner.l: Don't return CONDITIONAL_NAME. - -2002-10-02 Keisuke Nishida - - * Rename 'label_name' to 'label'. - * Rename 'file_name' to 'file'. - -2002-10-01 Keisuke Nishida - - * tree.h (cobc_tag_register, cobc_register): Removed. - * tree.c (make_register): Removed. - -2002-09-30 Keisuke Nishida - - * cobc.h (COBC_PACKAGE): Use PACKAGE_NAME. - -2002-09-29 Keisuke Nishida - - * codegen.c (output_file_name): Updated for new cob_file scheme. - * parser.y (sort_keys): Rename 'cob_sort_keys' to 'cob_sort_init'. - -2002-09-28 Keisuke Nishida - - * tree.c (init_constants): Typo fixed. Thanks to Mike Black. - -2002-09-24 Keisuke Nishida - - * scanner.l: Do not support single-quoted strings. - -2002-09-24 Keisuke Nishida - - * codegen.c (codegen_1): Do not support non-computed-goto jump. - -2002-09-24 Keisuke Nishida - - * tree.h (cobc_parameter): Renamed from cobc_generic. - All files updated. - -2002-09-24 Keisuke Nishida - - * inline.c (output_call_statement): Output the pointer to the - content length for COBC_CALL_BY_LENGTH. - -2002-09-23 Keisuke Nishida - - * cobc.c (process_translate): Verbose output. - -2002-09-17 Keisuke Nishida - - * cobc.c (probe_source_format): Removed. - (preprocess): Don't set source format. - (process_command_line): Set cobpp flags here. - -2002-09-17 Keisuke Nishida - - * tree.h (COBC_CALL_BY_LENGTH): New macro. - * reserved.c (reserved_words): Add LENGTH. - * parser.y (call_mode): Add CONTENT LENGTH. - * inline.c (output_call_statement): Handle COBC_CALL_BY_LENGTH. - -2002-09-13 Keisuke Nishida - - * tree.h (cobc_field): Remove 'category'. Related files updated. - * tree.c (setup_parameters): Merge 'validate_field' and 'setup_cname'. - * parser.y (validate_field): Removed. - -2002-09-12 Keisuke Nishida - - * cobc.c (temp_name): Call GetTempFileName with 3rd argument 0. - Call DeleteFile to remove the temporary file. - -2002-09-12 Keisuke Nishida - - * parser.y (validate_field_tree): Validate groups not having PICTURE. - (validate_field_tree): Create PICTURE of INDEX here, not in USAGE. - -2002-09-09 Keisuke Nishida - - * parser.y (ambiguous_error): display all fields with the same name. - (occurs_index): Use undefined_word. Set cobc_location. - -2002-08-29 Keisuke Nishida - - * cobc.c (temp_name): Use GetTempFileName on MinGW. - -2002-08-28 Keisuke Nishida - - * cobc.c (terminate): Renamed from 'error'. - (temp_name): Use GetTempPath on MinGW environment. - -2002-08-20 Keisuke Nishida - - * parser.y: No support of comments in IDENTIFICATION DIVISION. - (AUTHOR, DATE_WRITTEN, DATE_COMPILED, INSTALLATION, SECURITY): Removed. - (identification_division_options, identification_division_option) - (comment): Removed. - * reserved.c (reserved_words): Removed the tokens above. - * scanner.h, scanner.l (cobc_skip_comment): Removed. - * scanner.l: Don't handle the case of cobc_skip_comment. - -2002-08-20 Keisuke Nishida - - * cobc.c: New option -semi-fixed. - -2002-08-02 Keisuke Nishida - - * codegen.c (output_compare): Use the new cob_cmp_all scheme. - -2002-08-01 Keisuke Nishida - - * parser.y, reserved.c: SORT and MERGE support. - -2002-08-01 Keisuke Nishida - - * tree.h (cobc_key): Define 'dir' as int. - Use COB_ASCENDING or COB_DESCENDING for this. - * inline.c (output_search_all): Updated. - * parser.y (ascending_or_descending): Updated. - -2002-08-01 Keisuke Nishida - - * parser.y (occurs_clause): Use predefined_name for DEPENDING ON. - (record_depending): Set 'record_depending' directly. - -2002-07-31 Keisuke Nishida - - * codegen.h (cobc_program_spec): Renamed from 'program_spec'. - * parser.y (program_spec): Updated. - * codegen.c: (output_switch): New variable. - (output, output_newline, output_prefix, output_line): Updated. - (loop_counter, loop_counter_max): New variables. - (codegen_1): Renamed from codegen. Set counter variables. - (codegen): New function. - (output_perform): Use loop_counter. - -2002-07-31 Keisuke Nishida - - * codegen.c (codegen): Return cob_return_code from main. - -2002-07-30 Keisuke Nishida - - * tree.c, tree.h (make_perform_once): New function. - -2002-07-26 Keisuke Nishida - - * parser.y: Accept SD clause. - -2002-07-26 Keisuke Nishida - - * tree.c (make_word): Take constant and duplicate the name. - -2002-07-22 Keisuke Nishida - - * parser.y (FUNCTION_NAME): Defined as the string type. - * scanner.l (FUNCTION_STATE): Set value for FUNCTION_NAME. - -2002-07-22 Keisuke Nishida - - * parser.y (display_with_no_advancing): Fixed port number. - -2002-07-08 Keisuke Nishida - - * codegen.c (output_field): Support literals. - (output_file_name): Output ASSIGN clause. - * parser.y (open_list): Call "cob_open" without file name. - -2002-07-08 Keisuke Nishida - - * codegen.c (output_field): New function. - (output_file_name): Use it. - -2002-07-05 Keisuke Nishida - - * parser.y (screen_description): Set default line/column. - * codegen.c (output_screen_definition): Updated. - Handle COB_SCREEN_TYPE_ATTRIBUTE. - -2002-07-04 Keisuke Nishida - - * codegen.c (output_file_name): Rename 'cob_file_desc' to 'cob_file'. - -2002-07-04 Keisuke Nishida - - * codegen.c (output_field_definition): New arguments 'gen_data' - and 'gen_filler'. - (output_file_name, codegen): Updated. - * parser.y (screen_option): Set LINE/COLUMN flags appropriately. - (screen_plus_minus): PLUS/MINUS flags. - -2002-07-03 Keisuke Nishida - - * parser.y (program_sequence): Removed. - -2002-07-01 Keisuke Nishida - - * tree.h (cobc_field): New members: f.screen, screen_line, - screen_column, screen_from, screen_to, and screen_flag. - * codegen.h (screen_storage): New members: enable_screen and - screen_storage. - * codegen.c (output_screen_definition): New function. - (output_tree): Output screen data. - (codegen): Output screen definition. - * parser.y (special_name): Add CURSOR and CRT STATUS. - (screen_section): New rules. - (accept_statement, display_statement): Support screen data. - * reserved.c (reserved_words): Add related tokens. - -2002-06-26 Keisuke Nishida - - * tree.c (compute_size): Handle SIGN SEPARATE only for numeric fields. - * parser.y (validate_field): Don't throw error for multiple redefines. - -2002-06-26 Keisuke Nishida - - * cobc.c, cobc.h (cobc_flags): New variable. - (LINK_STATIC, LINK_DYNAMIC): Removed. - (cobc_main_flag, cobc_debug_flag, cobc_verbose_flag) - (cobc_optimize_flag, cobc_failsafe_flag, cobc_link_style): Removed. - * codegen.c (codegen, output_expr, output_line_directive): Updated. - * inline.c (output_call_statement): Updated. - -2002-06-24 Keisuke Nishida - - * parser.y (delete_statement, read_statement, start_statement) - (write_statement): set $$ instead of current_file_name. - (at_end, opt_invalid_key): Updated. - -2002-06-18 Keisuke Nishida - - * Makefile.am (cobc_LDADD): Add LIBCOB_LIBS. - -2002-06-17 Keisuke Nishida - - * inline.c, inline.h (output_call_statement): Take st1 and st2. - * parser.y (call_mode): Renamed from 'current_call_mode'. - (call_statement): Updated and clean up. - -2002-06-11 Keisuke Nishida - - * cobc.c (process_module): Use COB_MODULE_EXT. - Don't use -soname. - -2002-06-11 Keisuke Nishida - - * codegen.c: Use 'cob_alnum_desc' where appropriate. - -2002-06-11 Keisuke Nishida - - * codegen.c (output_field_definition): Output NULL for - cob_field.desc when it is a group. - -2002-06-11 Keisuke Nishida - - * codegen.c, inline.c: Updated for the change in libcob that - moved the 'size' field from cob_field_desc to cob_field. - -2002-06-09 Keisuke Nishida - - * tree.h (cobc_field): New member 'in_redefines'. - * parser.y (validate_field): Set 'in_redefines' and validate REDEFINES. - Display error if a field under REDEFINES has VALUE clause. - (init_field): Inherit the 'in_redefines' flag. - -2002-06-09 Keisuke Nishida - - * tree.c (make_tree, make_picture, make_word): Use memset to - initialize the memory allocated. - (make_literal, make_field, make_file_name, make_label_name_nodef) - (make_perform): Let make_tree initialize the memory by zero. - -2002-06-08 Keisuke Nishida - - * cobc.c (long_options): Accept '-main' option. - * cobc.c, cobc.h: New variable cobc_main_flag, removed cobc_module_flag - * codegen.c (OUTPUT_HANDLER): Removed. - * codegen.c (codegen): Updated. - * parser.y (procedure_using): Don't show -m warning. - -2002-06-06 Keisuke Nishida - - * inline.c (search_set_keys): Dont check syntax error. - * parser.y (search_statement): Check syntax error here. - * parser.y (resolve_predefined_name): Return filler on error. - -2002-06-06 Keisuke Nishida - - * codegen.c (codegen): Always generate program function, - putting main() at the end. - -2002-06-06 Keisuke Nishida - - * cobc.c (process_command_line, print_usage): Activate -g. - -2002-06-05 Keisuke Nishida - - * cobc.c (print_usage): Don't show -g. - -2002-06-04 Keisuke Nishida - - * codegen.c (output_perform_call): New function. - * codegen.c (output_perform_once): Use 'output_perform_call'. - * inline.c (output_file_handler): Use 'output_perform_call'. Cleanup. - -2002-06-04 Keisuke Nishida - - * Makefile.am (cobc_CFLAGS): -I$(top_srcdir), not -I$(top_srcdir)/lib. - * cobc.c, parser.y, scanner.l: Updated. - -2002-06-03 Keisuke Nishida - - * cobc.c (init_environment): Recognize COB_LDADD. - -2002-06-03 Keisuke Nishida - - * Makefile.am: Add libsupport.a to cobc_LDADD, removed cobc_LIBS - -2002-05-31 Keisuke Nishida - - * functions.h: Removed. - * tree.h (cobc_call): New field 'name' and 'func'. Remove 'tag'. - (make_call): Exported - (make_call_0, make_call_1, make_call_2, make_call_3, make_call_4): - Defined as macros. - (make_inline_0, make_inline_1, make_inline_2, make_inline_3, - make_inline_4, make_call_1_list): New macros. - * tree.c (make_call): Updated and Exported. - (make_call_0,make_call_1,make_call_2,make_call_3,make_call_4): Removed. - * inline.c, codegen.h: (output_goto, output_goto_depending, - output_move, output_initialize, output_initialize_replacing, - output_display, output_search, output_search_all, - output_call_statement): Exported. - * codegen.c, codegen.h: Don't include functions.h. - * codegen.c (output_call): Updated. - * parser.y: Updated. - (push_call_1_list, push_inline_0, push_inline_1, push_inline_2, - push_inline_3, push_inline_4): New macros. - * Makefile.am (cobc_SOURCES): Updated. - -2002-05-31 Keisuke Nishida - - * Display index name with the error message. - * codegen.c (output_refmod_offset, output_length) - * codegen.c (output_field_definition): Updated. - -2002-05-31 Keisuke Nishida - - * tree.c, tree.h (cobc_return_code): New variable. - * parser.y (call_returning): Move RETURN-CODE to RETURNING field. - * inline.c (output_move_index): New function. - * inline.c (output_call_statement): Don't take ret. - -2002-05-31 Keisuke Nishida - - * codegen.c (output_expr): Give field name to cob_check_numeric. - * codegen.c (output_field_definition): No longer output field name. - -2002-05-29 Keisuke Nishida - - * parser.y (expr_item_list): Better source location. - * codegen.c (output_compare): Take additional argument for better - source location. - * codegen.c (output_condition): Updated. - * inline.c (output_search_all): Updated. - -2002-05-29 Keisuke Nishida - - * codegen.c (output_recursive): Process top-level redefinition. - -2002-05-29 Keisuke Nishida - - * Keep field names at run-time. - * codegen.c (output_field_definition): Output field name. - -2002-05-29 Keisuke Nishida - - * cobc.c: Rename 'COB_LDADD' to 'COB_LIBS' - -2002-05-29 Keisuke Nishida - - * cobc.c (cobc_verbose_flag): New variable. - * cobc.c (short_options, long_options): New option -v and --verbose. - * cobc.c (process_command_line): Handle -v option. - * cobc.h (cobc_verbose_flag): Declared. - - -Copyright 2002-2020 Free Software Foundation, Inc. - -Copying and distribution of this file, with or without modification, are -permitted provided the copyright notice and this notice are preserved. diff -Nru gnucobol-4.0~early~20200606/cobc/cobc.1 gnucobol-5/cobc/cobc.1 --- gnucobol-4.0~early~20200606/cobc/cobc.1 2020-06-06 20:52:54.000000000 +0000 +++ gnucobol-5/cobc/cobc.1 1970-01-01 00:00:00.000000000 +0000 @@ -1,755 +0,0 @@ -.\" DO NOT MODIFY THIS FILE! It was generated by help2man 1.47.6. -.TH COBC "1" "June 2020" "cobc (GnuCOBOL) 4.0-early-dev.0" "User Commands" -.SH NAME -cobc \- manual page for cobc (GnuCOBOL) 4.0-early-dev.0 -.SH SYNOPSIS -.B cobc -[\fI\,options\/\fR]... \fI\,file\/\fR... -.SH DESCRIPTION -GnuCOBOL compiler for most COBOL dialects with lots of extensions -.SH OPTIONS -.TP -\fB\-h\fR, \fB\-help\fR -display this help and exit -.TP -\fB\-V\fR, \fB\-version\fR -display compiler version and exit -.TP -\fB\-i\fR, \fB\-info\fR -display compiler information (build/environment) -and exit -.TP -\fB\-v\fR, \fB\-verbose\fR -display compiler version and the commands -invoked by the compiler -.TP -\fB\-vv\fR, \fB\-verbose\fR=\fI\,2\/\fR -like \fB\-v\fR but additional pass verbose option -to assembler/compiler -.TP -\fB\-vvv\fR, \fB\-verbose\fR=\fI\,3\/\fR -like \fB\-vv\fR but additional pass verbose option -to linker -.TP -\fB\-q\fR, \fB\-brief\fR -reduced displays, commands invoked not shown -.TP -\-### -like \fB\-v\fR but commands not executed -.TP -\fB\-x\fR -build an executable program -.TP -\fB\-m\fR -build a dynamically loadable module (default) -.TP -\fB\-j\fR [], \fB\-job[=\fR] -run program after build, passing -.TP -\fB\-std=\fR -warnings/features for a specific dialect - can be one of: -default, cobol2014, cobol2002, cobol85, xopen, -ibm\-strict, ibm, mvs\-strict, mvs, -mf\-strict, mf, bs2000\-strict, bs2000, -acu\-strict, acu, rm\-strict, rm; -see configuration files in directory config -.TP -\fB\-F\fR, \fB\-free\fR -use free source format -.TP -\fB\-fixed\fR -use fixed source format (default) -.TP -\fB\-O\fR, \fB\-O2\fR, \fB\-O3\fR, \fB\-Os\fR -enable optimization -.TP -\fB\-O0\fR -disable optimization -.TP -\fB\-g\fR -enable C compiler debug / stack check / trace -.TP -\fB\-d\fR, \fB\-debug\fR -enable all run\-time error checking -.TP -\fB\-o\fR -place the output into -.TP -\fB\-b\fR -combine all input files into a single -dynamically loadable module -.TP -\fB\-E\fR -preprocess only; do not compile or link -.TP -\fB\-C\fR -translation only; convert COBOL to C -.TP -\fB\-S\fR -compile only; output assembly file -.TP -\fB\-c\fR -compile and assemble, but do not link -.TP -\fB\-T\fR -generate and place a wide program listing into -.TP -\fB\-t\fR -generate and place a program listing into -.TP -\fB\-\-tlines=\fR -specify lines per page in listing, default = 55 -.TP -\fB\-P[=\fR] -generate preprocessed program listing (.lst) -.TP -\fB\-Xref\fR -generate cross reference through 'cobxref' -(V. Coen's 'cobxref' must be in path) -.TP -\fB\-I\fR -add to copy/include search path -.TP -\fB\-L\fR -add to library search path -.TP -\fB\-l\fR -link the library -.TP -\fB\-A\fR -add to the C compile phase -.TP -\fB\-Q\fR -add to the C link phase -.TP -\fB\-D\fR -define for COBOL compilation -.TP -\fB\-K\fR -generate CALL to as static -.TP -\fB\-conf=\fR -user\-defined dialect configuration; see \fB\-std\fR -.TP -\fB\-list\-reserved\fR -display reserved words -.TP -\fB\-list\-intrinsics\fR -display intrinsic functions -.TP -\fB\-list\-mnemonics\fR -display mnemonic names -.TP -\fB\-list\-system\fR -display system routines -.TP -\fB\-save\-temps[=\fR] -save intermediate files -* default: current directory -.TP -\fB\-ext\fR -add file extension for resolving COPY -.SS "Warning options:" -.TP -\fB\-W\fR -enable all warnings -.TP -\fB\-Wall\fR -enable most warnings (all except as noted below) -.TP -\fB\-Wno\-\fR -disable warning enabled by default, \fB\-W\fR or \fB\-Wall\fR -.TP -\fB\-Wextra\fR -additional warnings only raised with \fB\-W\fR or \fB\-Wall\fR -.TP -\fB\-Wno\-unfinished\fR -do not warn if unfinished features are used -* ALWAYS active -.TP -\fB\-Wno\-pending\fR -do not warn if pending features are mentioned -* ALWAYS active -.TP -\fB\-Wobsolete\fR -warn if obsolete features are used -.TP -\fB\-Warchaic\fR -warn if archaic features are used -.TP -\fB\-Wredefinition\fR -warn about incompatible redefinition of data items -.TP -\fB\-Wtruncate\fR -warn about field truncation from constant assignments -.TP -\fB\-Wpossible\-truncate\fR -warn about possible field truncation -* NOT set with \fB\-Wall\fR -.TP -\fB\-Woverlap\fR -warn about overlapping MOVE of items -.TP -\fB\-Wpossible\-overlap\fR -warn about MOVE of items that may overlap depending on variables -* NOT set with \fB\-Wall\fR -.TP -\fB\-Wparentheses\fR -warn about lack of parentheses around AND within OR -.TP -\fB\-Wstrict\-typing\fR -warn strictly about type mismatch -.TP -\fB\-Wimplicit\-define\fR -warn about implicitly defined data items -.TP -\fB\-Wcorresponding\fR -warn about CORRESPONDING with no matching items -.TP -\fB\-Winitial\-value\fR -warn if initial VALUE clause is ignored -.TP -\fB\-Wprototypes\fR -warn about missing FUNCTION prototypes/definitions -.TP -\fB\-Warithmetic\-osvs\fR -warn if arithmetic expression precision has changed -.TP -\fB\-Wcall\-params\fR -warn about non 01/77 items for CALL parameters -* NOT set with \fB\-Wall\fR -.TP -\fB\-Wconstant\-expression\fR -warn about expressions that always resolve to true/false -.TP -\fB\-Wcolumn\-overflow\fR -warn about text after program\-text area, FIXED format -* NOT set with \fB\-Wall\fR -.TP -\fB\-Wterminator\fR -warn about lack of scope terminator END\-XXX -* NOT set with \fB\-Wall\fR -.TP -\fB\-Wlinkage\fR -warn about dangling LINKAGE items -* NOT set with \fB\-Wall\fR -.TP -\fB\-Wunreachable\fR -warn about likely unreachable statements -* NOT set with \fB\-Wall\fR -.TP -\fB\-Wno\-dialect\fR -do not warn about dialect specific issues -* ALWAYS active -.TP -\fB\-Wothers\fR -do not warn about different issues -* ALWAYS active -.TP -\fB\-Wno\-unsupported\fR -do not warn if runtime does not support a feature used -* NOT set with \fB\-Wall\fR -.TP -\fB\-Werror\fR -treat all warnings as errors -.TP -\fB\-Werror=\fR -treat specified as error -.SS "Compiler options:" -.TP -\fB\-fsign\fR=\fI\,[ASCII\/\fR|EBCDIC] define display sign representation -* default: machine native -.TP -\fB\-ffold\-copy\fR=\fI\,[UPPER\/\fR|LOWER] -fold COPY subject to value -* default: no transformation -.TP -\fB\-ffold\-call\fR=\fI\,[UPPER\/\fR|LOWER] -fold PROGRAM\-ID, CALL, CANCEL subject to value -* default: no transformation -.TP -\fB\-fdefaultbyte=\fR initialize fields without VALUE to value -* decimal 0..255 or any quoted character -* default: initialize to picture -.TP -\fB\-fmax\-errors=\fR maximum number of errors to report before -compilation is aborted -* default: 128 -.TP -\fB\-fintrinsics\fR=\fI\,[ALL\/\fR|intrinsic function name(,name,...)] -intrinsics to be used without FUNCTION keyword -.TP -\fB\-fdump=\fR -dump data fields on abort, may be -a combination of: ALL, WS, LS, RD, FD, SC -.TP -\fB\-fcallfh=\fR -use external provided EXTFH interface module - for I/O -.TP -\fB\-fsqldb=\fR -which Database is used, may be -MySQL, MSSQL, Oracle10, Oracle11, Oracle12 -.TP -\fB\-fsqlschema=\fR -define database schema name -.TP -\fB\-fno\-recursive\-check\fR -disable check of recursive program call; -effectively compiling as RECURSIVE program -.TP -\fB\-fno\-remove\-unreachable\fR -disable remove of unreachable code -* turned off by \fB\-g\fR -.TP -\fB\-finline\-intrinsic\fR -when possible resolve intrinsic FUNCTIONs at compile time -.TP -\fB\-ftrace\fR -generate trace code -* scope: executed SECTION/PARAGRAPH -.TP -\fB\-ftraceall\fR -generate trace code -* scope: executed SECTION/PARAGRAPH/STATEMENTS -* turned on by \fB\-debug\fR -.TP -\fB\-fsyntax\-only\fR -syntax error checking only; don't emit any output -.TP -\fB\-fdebugging\-line\fR -enable debugging lines -* 'D' in indicator column or floating >>D -.TP -\fB\-fsource\-location\fR -generate source location code -* turned on by \fB\-debug\fR/\-g/\-ftraceall -.TP -\fB\-fimplicit\-init\fR -automatic initialization of the COBOL runtime system -.TP -\fB\-fstack\-check\fR -PERFORM stack checking -* turned on by \fB\-debug\fR or \fB\-g\fR -.TP -\fB\-fwrite\-after\fR -use AFTER 1 for WRITE of LINE SEQUENTIAL -* default: BEFORE 1 -.TP -\fB\-fmfcomment\fR -\&'*' or '/' in column 1 treated as comment -* FIXED format only -.TP -\fB\-facucomment\fR -\&'$' in indicator area treated as '*', -\&'|' treated as floating comment -.TP -\fB\-fnotrunc\fR -allow numeric field overflow -* non\-ANSI behaviour -.TP -\fB\-fodoslide\fR -adjust items following OCCURS DEPENDING -* implies \fB\-fcomplex\-odo\fR -.TP -\fB\-fsingle\-quote\fR -use a single quote (apostrophe) for QUOTE -* default: double quote -.TP -\fB\-foptional\-file\fR -treat all files as OPTIONAL -* unless NOT OPTIONAL specified -.TP -\fB\-fstatic\-call\fR -output static function calls for the CALL statement -.TP -\fB\-fno\-gen\-c\-decl\-static\-call\fR -disable generation of C function declations -for subroutines with static CALL -.TP -\fB\-fmf\-files\fR -Sequential & Relative files will match Micro Focus format -.TP -\fB\-fno\-theaders\fR -suppress all headers and output of compilation -options from listing while keeping page breaks -.TP -\fB\-fno\-tsource\fR -suppress source from listing -.TP -\fB\-fno\-tmessages\fR -suppress warning and error summary from listing -.TP -\fB\-ftsymbols\fR -specify symbols in listing -.TP -\fB\-fibmcomp\fR -sets \fB\-fbinary\-size\fR=\fI\,2\-4\-8\/\fR \fB\-fsynchronized\-clause\fR=\fI\,ok\/\fR -.TP -\fB\-fno\-ibmcomp\fR -sets \fB\-fbinary\-size\fR=\fI\,1\-\-8\/\fR \fB\-fsynchronized\-clause\fR=\fI\,ignore\/\fR -.SS "Compiler dialect configuration options:" -.TP -\fB\-freserved\-words=\fR -use of complete/fixed reserved words -.TP -\fB\-ftab\-width\fR=\fI\,1\/\fR..12 -set number of spaces that are assumed for tabs -.TP -\fB\-ftext\-column\fR=\fI\,72\/\fR..255 -set right margin for source (fixed format only) -.TP -\fB\-fpic\-length=\fR -maximum number of characters allowed in the PICTURE character\-string -.TP -\fB\-fword\-length\fR=\fI\,1\/\fR..63 -maximum word\-length for COBOL (= programmer defined) words -.TP -\fB\-fliteral\-length=\fR -maximum literal size in general -.TP -\fB\-fnumeric\-literal\-length\fR=\fI\,1\/\fR..38 -maximum numeric literal size -.TP -\fB\-falign\-record\fR=\fI\,0\/\fR..256 -align WORKING\-STORAGE/LOCAL\-STORAGE record on boundary -.TP -\fB\-falign\-opt\fR -align like MF OPT, Default: false (Like MF ALIGN=FIXED) -.TP -\fB\-fbinary\-size=\fR -binary byte size \- defines the allocated bytes according to PIC, may be one of: 2\-4\-8, 1\-2\-4\-8, 1\-\-8 -.TP -\fB\-fbinary\-byteorder=\fR -binary byte order, may be one of: native, big\-endian -.TP -\fB\-fassign\-clause=\fR -how to interpret 'ASSIGN word': as 'ASSIGN EXTERNAL word' or 'ASSIGN DYNAMIC word' -.TP -\fB\-fscreen\-section\-rules=\fR -which compiler's rules to apply to SCREEN SECTION item clauses -.TP -\fB\-ffilename\-mapping\fR -resolve file names at run time using environment variables. -.TP -\fB\-fpretty\-display\fR -alternate formatting of numeric fields -.TP -\fB\-fbinary\-truncate\fR -numeric truncation according to ANSI -.TP -\fB\-fcomplex\-odo\fR -allow complex OCCURS DEPENDING ON -.TP -\fB\-findirect\-redefines\fR -allow REDEFINES to other than last equal level number -.TP -\fB\-flarger\-redefines\-ok\fR -allow larger REDEFINES items -.TP -\fB\-frelax\-syntax\-checks\fR -allow certain syntax variations (e.g. REDEFINES position) -.TP -\fB\-frelax\-level\-hierarchy\fR -allow non\-matching level numbers -.TP -\fB\-fsticky\-linkage\fR -LINKAGE\-SECTION items remain allocated between invocations -.TP -\fB\-fmove\-ibm\fR -MOVE operates as on IBM (left to right, byte by byte), otherwise no propagating move -.TP -\fB\-fperform\-osvs\fR -exit point of any currently executing perform is recognized if reached -.TP -\fB\-farithmetic\-osvs\fR -limit precision in intermediate results to precision of final result (less accurate) -.TP -\fB\-fconstant\-folding\fR -evaluate constant expressions at compile time -.TP -\fB\-fhostsign\fR -allow hexadecimal value 'F' for NUMERIC test of signed PACKED DECIMAL field -.TP -\fB\-fprogram\-name\-redefinition\fR -program names don't lead to a reserved identifier -.TP -\fB\-faccept\-update\fR -set WITH UPDATE clause as default for ACCEPT dest\-item, instead of WITH NO UPDATE -.TP -\fB\-faccept\-auto\fR -set WITH AUTO clause as default for ACCEPT dest\-item, instead of WITH TAB -.TP -\fB\-fconsole\-is\-crt\fR -assume CONSOLE IS CRT if not set otherwise -.TP -\fB\-fno\-echo\-means\-secure\fR -NO\-ECHO hides input with asterisks like SECURE -.TP -\fB\-fline\-col\-zero\-default\fR -assume a field DISPLAY starts at LINE 0 COL 0 (i.e. at the cursor), not LINE 1 COL 1 -.TP -\fB\-freport\-column\-plus\fR -in a REPORT COLUMN may have PLUS num, + num, or +num -.TP -\fB\-fdisplay\-special\-fig\-consts\fR -special behaviour of DISPLAY SPACE/ALL X'01'/ALL X'02'/ALL X'07' -.TP -\fB\-fbinary\-comp\-1\fR -COMP\-1 is a 16\-bit signed integer -.TP -\fB\-fmove\-non\-numeric\-lit\-to\-numeric\-is\-zero\fR -imply zero in move of non\-numeric literal to numeric items -.HP -\fB\-fimplicit\-assign\-dynamic\-var\fR implicitly define a variable if an ASSIGN DYNAMIC does not match any data item -.TP -\fB\-fcomment\-paragraphs=\fR -comment paragraphs in IDENTIFICATION DIVISION (AUTHOR, DATE\-WRITTEN, ...) -.TP -\fB\-fmemory\-size\-clause=\fR -MEMORY\-SIZE clause -.HP -\fB\-fmultiple\-file\-tape\-clause=\fR MULTIPLE\-FILE\-TAPE clause -.TP -\fB\-flabel\-records\-clause=\fR -LABEL\-RECORDS clause -.TP -\fB\-fvalue\-of\-clause=\fR -VALUE\-OF clause -.TP -\fB\-fdata\-records\-clause=\fR -DATA\-RECORDS clause -.TP -\fB\-ftop\-level\-occurs\-clause=\fR -OCCURS clause on top\-level -.TP -\fB\-fsame\-as\-clause=\fR -SAME AS clause -.TP -\fB\-fsynchronized\-clause=\fR -SYNCHRONIZED clause -.TP -\fB\-fsync\-left\-right=\fR -LEFT/RIGHT phrases in SYNCHRONIZED clause -.TP -\fB\-fspecial\-names\-clause=\fR -SPECIAL\-NAMES clause -.TP -\fB\-fgoto\-statement\-without\-name=\fR -GOTO statement without name -.TP -\fB\-fstop\-literal\-statement=\fR -STOP\-literal statement -.HP -\fB\-fstop\-identifier\-statement=\fR STOP\-identifier statement -.TP -\fB\-fdebugging\-mode=\fR -DEBUGGING MODE and debugging indicator -.HP -\fB\-fuse\-for\-debugging=\fR USE FOR DEBUGGING -.TP -\fB\-fpadding\-character\-clause=\fR -PADDING CHARACTER clause -.TP -\fB\-fnext\-sentence\-phrase=\fR -NEXT SENTENCE phrase -.TP -\fB\-flisting\-statements=\fR -listing\-directive statements EJECT, SKIP1, SKIP2, SKIP3 -.TP -\fB\-ftitle\-statement=\fR -listing\-directive statement TITLE -.TP -\fB\-fentry\-statement=\fR -ENTRY statement -.TP -\fB\-fmove\-noninteger\-to\-alphanumeric=\fR -move noninteger to alphanumeric -.HP -\fB\-foccurs\-max\-length\-without\-subscript\fR occurs max length without subscript -.TP -\fB\-flength\-in\-data\-division\fR -length in data division -.TP -\fB\-fmove\-figurative\-constant\-to\-numeric=\fR -move figurative constants to numeric -.TP -\fB\-fmove\-figurative\-space\-to\-numeric=\fR -move figurative constant SPACE to numeric -.TP -\fB\-fmove\-figurative\-quote\-to\-numeric=\fR -move figurative constant QUOTE to numeric -.TP -\fB\-fodo\-without\-to=\fR -OCCURS DEPENDING ON without to -.TP -\fB\-fsection\-segments=\fR -section segments -.TP -\fB\-falter\-statement=\fR -ALTER statement -.TP -\fB\-fcall\-overflow=\fR -OVERFLOW clause for CALL -.TP -\fB\-fnumeric\-boolean=\fR -boolean literals (B'1010') -.TP -\fB\-fhexadecimal\-boolean=\fR -hexadecimal\-boolean literals (BX'A') -.HP -\fB\-fnational\-literals=\fR national literals (N'UTF\-16 string') -.TP -\fB\-fhexadecimal\-national\-literals=\fR -hexadecimal\-national literals (NX'265E') -.TP -\fB\-fnational\-character\-literals=\fR -non\-standard national literals (NC'UTF\-16 string') -.HP -\fB\-fhp\-octal\-literals=\fR HP COBOL octal literals (%377) -.TP -\fB\-facu\-literals=\fR -ACUCOBOL\-GT literals (#B #O #H #X) -.HP -\fB\-fword\-continuation=\fR continuation of COBOL words -.TP -\fB\-fnot\-exception\-before\-exception=\fR -NOT ON EXCEPTION before ON EXCEPTION -.HP -\fB\-faccept\-display\-extensions=\fR extensions to ACCEPT and DISPLAY -.TP -\fB\-frenames\-uncommon\-levels=\fR -RENAMES of 01\-, 66\- and 77\-level items -.HP -\fB\-fsymbolic\-constant=\fR constants defined in SPECIAL\-NAMES -.TP -\fB\-fconstant\-78=\fR -constant with level 78 item (note: has left to right precedence in expressions) -.TP -\fB\-fconstant\-01=\fR -constant with level 01 CONSTANT AS/FROM item -.TP -\fB\-fperform\-varying\-without\-by=\fR -PERFORM VARYING without BY phrase (implies BY 1) -.TP -\fB\-freference\-out\-of\-declaratives=\fR -references to sections not in DECLARATIVES from within DECLARATIVES -.TP -\fB\-freference\-bounds\-check=\fR -reference modification strict bounds check -.TP -\fB\-fprogram\-prototypes=\fR -CALL/CANCEL with program\-prototype\-name -.TP -\fB\-fcall\-convention\-mnemonic=\fR -specifying call\-convention by mnemonic -.TP -\fB\-fcall\-convention\-linkage=\fR -specifying call\-convention by WITH ... LINKAGE -.TP -\fB\-fnumeric\-value\-for\-edited\-item=\fR -numeric literals in VALUE clause of numeric\-edited items -.TP -\fB\-fincorrect\-conf\-sec\-order=\fR -incorrect order of CONFIGURATION SECTION paragraphs -.HP -\fB\-fdefine\-constant\-directive=\fR allow >> DEFINE CONSTANT var AS literal -.TP -\fB\-ffree\-redefines\-position=\fR -REDEFINES clause not following entry\-name in definition -.TP -\fB\-frecords\-mismatch\-record\-clause=\fR -record sizes does not match RECORD clause -.TP -\fB\-frecord\-delimiter=\fR -RECORD DELIMITER clause -.TP -\fB\-fsequential\-delimiters=\fR -BINARY\-SEQUENTIAL and LINE\-SEQUENTIAL phrases in RECORD DELIMITER -.TP -\fB\-frecord\-delim\-with\-fixed\-recs=\fR -RECORD DELIMITER clause on file with fixed\-length records -.HP -\fB\-fmissing\-statement=\fR missing statement (e.g. empty IF / PERFORM) -.TP -\fB\-fzero\-length\-literals=\fR -zero\-length literals, e.g. '' and "" -.TP -\fB\-fxml\-generate\-extra\-phrases=\fR -XML GENERATE's phrases other than COUNT IN -.TP -\fB\-fcontinue\-after=\fR -AFTER phrase in CONTINUE statement -.TP -\fB\-fgoto\-entry=\fR -ENTRY FOR GOTO and GOTO ENTRY statements -.TP -\fB\-fdepending\-on\-not\-fixed=\fR -depending\-on\-not\-fixed -.TP -\fB\-fbinary\-sync\-clause=\fR -BINARY\-SHORT/LONG/DOUBLE SYNCHRONIZED clause -.TP -\fB\-fnonnumeric\-with\-numeric\-group\-usage=\fR -Non\-numeric item with numeric group USAGE clause -.TP -\fB\-fassign\-variable=\fR -ASSIGN [TO] variable in SELECT -.TP -\fB\-fassign\-using\-variable=\fR -ASSIGN USING/VARYING variable in SELECT -.TP -\fB\-fassign\-ext\-dyn=\fR -ASSIGN EXTERNAL/DYNAMIC in SELECT -.TP -\fB\-fassign\-disk\-from=\fR -ASSIGN DISK FROM variable in SELECT -.IP -where is one of the following: -\&'ok', 'warning', 'archaic', 'obsolete', 'skip', 'ignore', 'error', 'unconformable' -.TP -\fB\-fnot\-reserved=\fR -word to be taken out of the reserved words list -.TP -\fB\-freserved=\fR -word to be added to reserved words list -.TP -\fB\-freserved=\fR: -word to be added to reserved words list as alias -.TP -\fB\-fnot\-register=\fR -special register to disable -.TP -\fB\-fregister=\fR -special register to enable -.SH AUTHOR -Written by Keisuke Nishida, Roger While, Ron Norman, Simon Sobisch, Edward Hart -Built Jun 06 2020 20:52:39 -Packaged Jun 06 2020 20:52:05 UTC -C version "7.5.0" -.SH "REPORTING BUGS" -Report bugs to: bug\-gnucobol@gnu.org -or (preferably) use the issue tracker via the home page. -.br -GnuCOBOL home page: -.br -General help using GNU software: -.SH COPYRIGHT -Copyright \(co 2020 Free Software Foundation, Inc. -License GPLv3+: GNU GPL version 3 or later -.br -This is free software; see the source for copying conditions. There is NO -warranty; not even for MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. -.SH "SEE ALSO" -The full documentation for -.B cobc -is maintained as a Texinfo manual. If the -.B info -and -.B cobc -programs are properly installed at your site, the command -.IP -.B info gnucobol -.PP -should give you access to the complete manual. diff -Nru gnucobol-4.0~early~20200606/cobc/cobc.c gnucobol-5/cobc/cobc.c --- gnucobol-4.0~early~20200606/cobc/cobc.c 2020-06-06 20:51:59.000000000 +0000 +++ gnucobol-5/cobc/cobc.c 1970-01-01 00:00:00.000000000 +0000 @@ -1,8326 +0,0 @@ -/* - Copyright (C) 2001-2020 Free Software Foundation, Inc. - - Authors: - Keisuke Nishida, Roger While, Ron Norman, Simon Sobisch, Brian Tiffin, - Edward Hart, Dave Pitts - - This file is part of GnuCOBOL. - - The GnuCOBOL compiler is free software: you can redistribute it - and/or modify it under the terms of the GNU General Public License - as published by the Free Software Foundation, either version 3 of the - License, or (at your option) any later version. - - GnuCOBOL is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with GnuCOBOL. If not, see . -*/ - -/* #define DEBUG_REPLACE */ - -#include -#include - -#include -#include -#include -#include -#include -#include -#include -#include -#include -#ifdef HAVE_UNISTD_H -#include -#endif -#ifdef HAVE_SIGNAL_H -#include -#endif - -#ifdef _WIN32 -#define WIN32_LEAN_AND_MEAN -#include -#undef MOUSE_MOVED -#include -#include -#include -#endif - -#if defined(WITH_VBISAM) -/* included to check for VB_RTD definition */ -#include -#endif - -#ifdef HAVE_LOCALE_H -#include -#endif - -#include - -#include "tarstamp.h" - -#include "cobc.h" -#include "tree.h" - -#include "lib/gettext.h" - -#include "libcob/cobgetopt.h" - -#ifdef WITH_DB -#include -#endif -#ifdef WITH_LMDB -#include -#endif -#ifdef WITH_OCI -#include -#endif -#if defined (WITH_ODBC) -#include -#include -#endif - -#if defined (COB_EXPERIMENTAL) || 1 -#define COB_INTERNAL_XREF -enum xref_type { - XREF_FIELD, - XREF_FILE, - XREF_LABEL, - XREF_FUNCTION -}; -#endif - -struct strcache { - struct strcache *next; - void *val; -}; - -/* Compile level */ -#define CB_LEVEL_PREPROCESS 1 -#define CB_LEVEL_TRANSLATE 2 -#define CB_LEVEL_COMPILE 3 -#define CB_LEVEL_ASSEMBLE 4 -#define CB_LEVEL_MODULE 5 -#define CB_LEVEL_LIBRARY 6 -#define CB_LEVEL_EXECUTABLE 7 - -/* Info display limits */ -#define CB_IMSG_SIZE 24 -#define CB_IVAL_SIZE (74 - CB_IMSG_SIZE - 4) - -#define COBC_ADD_STR(v,x,y,z) cobc_add_str (&v, &v##_size, x, y, z); -#define COBC_INV_PAR _("invalid parameter: %s") - -#define CB_TEXT_LIST_ADD(y,z) y = cb_text_list_add (y, z) -#define CB_TEXT_LIST_CHK(y,z) y = cb_text_list_chk (y, z) - - -/* Global variables */ - -const char *cb_source_file = NULL; -const char *cb_cobc_build_stamp = NULL; -const char *demangle_name = NULL; -const char *cb_storage_file_name = NULL; -const char *cb_call_extfh = NULL; -const char *cb_sqldb_name = NULL; -const char *cb_sqldb_schema = NULL; -struct cb_text_list *cb_include_list = NULL; -struct cb_text_list *cb_intrinsic_list = NULL; -struct cb_text_list *cb_extension_list = NULL; -struct cb_text_list *cb_static_call_list = NULL; -struct cb_text_list *cb_early_exit_list = NULL; -char **cb_saveargv = NULL; -const char *cob_config_dir = NULL; -const char *cob_schema_dir = NULL; -FILE *cb_storage_file = NULL; -FILE *cb_listing_file = NULL; - -/* Listing structures and externals */ - -#define CB_LINE_LENGTH 1024 /* hint: we only read PPLEX_BUF_LEN bytes */ -#define CB_READ_AHEAD 800 /* lines to read ahead */ - -/* TODO: add new compiler configuration flags for this*/ -#define CB_MARGIN_A cb_indicator_column -#define CB_MARGIN_B 11 /* careful, for COBOL 85 this would be 11, - for COBOL 2002 (removed it) would be 7 */ -#define CB_INDICATOR CB_MARGIN_A - 1 -#define CB_SEQUENCE cb_text_column /* the only configuration available...*/ -#define CB_ENDLINE cb_text_column + cb_indicator_column + 1 - -#define CB_MAX_LINES 55 -#define CB_LIST_PICSIZE 80 -#define CB_PRINT_LEN 132 - -char print_data[CB_PRINT_LEN + 1]; -size_t pd_off; - -#define IS_DEBUG_LINE(line) ((line)[CB_INDICATOR] == 'D') -#define IS_CONTINUE_LINE(line) ((line)[CB_INDICATOR] == '-') -#define IS_COMMENT_LINE(line) \ - ((line)[CB_INDICATOR] == '*' || (line)[CB_INDICATOR] == '/') - -FILE *cb_src_list_file = NULL; -int cb_listing_page = 0; -int cb_listing_wide = 0; -unsigned int cb_lines_per_page = CB_MAX_LINES; -int cb_listing_xref = 0; -#define CB_LISTING_DATE_BUFF 26 -#define CB_LISTING_DATE_MAX (CB_LISTING_DATE_BUFF - 1) -char cb_listing_date[CB_LISTING_DATE_BUFF]; /* Date/Time buffer for listing */ -struct list_files *cb_current_file = NULL; -#define LCL_NAME_LEN 80 -#define LCL_NAME_MAX (LCL_NAME_LEN - 1) - -/* compilation date/time of current source file */ -struct cob_time current_compile_time = { 0 }; -struct tm current_compile_tm = { 0 }; - -#if 0 /* RXWRXW - source format */ -char *source_name = NULL; -#endif - -enum cb_format cb_source_format = CB_FORMAT_FIXED; -int cb_text_column; -int cb_indicator_column; -int cb_id = 0; -int cb_pic_id = 0; -int cb_attr_id = 0; -int cb_literal_id = 0; -int cb_field_id = 0; -int cb_ml_attr_id = 0; -int cb_ml_tree_id = 0; -int cobc_flag_main = 0; -int cb_flag_main = 0; -int cobc_wants_debug = 0; -int cb_flag_functions_all = 0; -int cb_flag_dump = 0; -int cobc_seen_stdin = 0; -int cb_unix_lf = 0; - -int fatal_startup_error = 0; -int errorcount = 0; -int warningcount = 0; -int fatal_errors_flag = 0; -int no_physical_cancel = 0; -int cb_source_line = 0; -int cb_saveargc = 0; -unsigned int cobc_gen_listing = 0; -unsigned int cb_correct_program_order = 0; - -cob_u32_t optimize_defs[COB_OPTIM_MAX] = { 0 }; - -#define COB_EXCEPTION(code,tag,name,critical) {name, 0x##code, 0}, -struct cb_exception cb_exception_table[] = { - {NULL, 0, 0}, /* CB_EC_ZERO */ -#include "libcob/exception.def" - {NULL, 0, 0} /* CB_EC_MAX */ -}; -#undef COB_EXCEPTION - -#define CB_FLAG(var,print_help,name,doc) int var = 0; -#define CB_FLAG_ON(var,print_help,name,doc) int var = 1; -#define CB_FLAG_RQ(var,print_help,name,def,opt,doc) int var = def; -#define CB_FLAG_NQ(print_help,name,opt,doc) -#include "flag.def" -#undef CB_FLAG -#undef CB_FLAG_ON -#undef CB_FLAG_RQ -#undef CB_FLAG_NQ -int cb_mf_ibm_comp = -1; -int cb_cob_line_num = 0; -int cb_all_files_xfd = 0; - -#define CB_ERRWARNDEF(var,name,doc) int var = COBC_WARN_AS_ERROR; -#define CB_NOWARNDEF(var,name,doc) int var = COBC_WARN_DISABLED; -#define CB_ONWARNDEF(var,name,doc) int var = COBC_WARN_ENABLED; -#define CB_WARNDEF(var,name,doc) int var = COBC_WARN_DISABLED; -#include "warning.def" -#undef CB_ERRWARNDEF -#undef CB_NOWARNDEF -#undef CB_ONWARNDEF -#undef CB_WARNDEF - -/* Local variables */ - -static struct cb_define_struct *cb_define_list = NULL; - -static struct cobc_mem_struct *cobc_mainmem_base = NULL; -static struct cobc_mem_struct *cobc_parsemem_base = NULL; -static struct cobc_mem_struct *cobc_plexmem_base = NULL; - -static const char *cobc_cc; /* C compiler */ -static char *cobc_cflags; /* C compiler flags */ -static char *cobc_libs; /* -l... */ -static char *cobc_lib_paths; /* -L... */ -static char *cobc_include; /* -I... */ -static char *cobc_ldflags; /* -Q / COB_LDFLAGS */ - -static size_t cobc_cflags_size; -static size_t cobc_libs_size; -static size_t cobc_lib_paths_size; -static size_t cobc_include_size; -static size_t cobc_ldflags_size; - -static size_t cobc_cc_len; -static size_t cobc_cflags_len; -static size_t cobc_libs_len; -static size_t cobc_lib_paths_len; -static size_t cobc_include_len; -static size_t cobc_ldflags_len; -static size_t cobc_export_dyn_len; -static size_t cobc_shared_opt_len; -static size_t cobc_pic_flags_len; - -static char *save_temps_dir = NULL; -static struct strcache *base_string; - -static char *cobc_list_dir = NULL; -static char *cobc_list_file = NULL; - -static char *output_name = NULL; -static char *cobc_buffer; -static char *cobc_objects_buffer; -static char *output_name_buff; -static char *basename_buffer; - -static size_t cobc_objects_len; -static size_t basename_len; -static size_t cobc_buffer_size; - -static struct filename *file_list; - -static unsigned int cb_compile_level = 0; - -static int iargs; - -static size_t cobc_flag_module = 0; -static size_t cobc_flag_library = 0; -static size_t cobc_flag_run = 0; -static char *cobc_run_args = NULL; -static size_t save_temps = 0; -static size_t save_all_src = 0; -static size_t save_c_src = 0; -static signed int verbose_output = 0; -static size_t cob_optimize = 0; - -static unsigned int cb_listing_linecount; -static int cb_listing_eject = 0; -static char cb_listing_filename[FILENAME_MAX]; -static char *cb_listing_outputfile = NULL; -static char cb_listing_title[81]; /* Listing title (defaults to PACKAGE_NAME + Version */ -static char cb_listing_header[133]; /* Listing header */ -static struct list_files *cb_listing_file_struct = NULL; -static struct list_error *cb_listing_error_head = NULL; -static struct list_error *cb_listing_error_tail = NULL; - -#ifdef _MSC_VER -static const char *manicmd; -static const char *manilink; -static size_t manilink_len; -#define PATTERN_DELIM '|' -#endif - -static size_t strip_output = 0; -static size_t gflag_set = 0; -static size_t aflag_set = 0; - -static const char *const cob_csyns[] = { -#ifndef COB_EBCDIC_MACHINE - "NULL", - "P_cancel", - "P_initialize", - "P_ret_initialize", - "P_switch", -#endif -#ifdef COB_EBCDIC_MACHINE - "_float128", -#endif - "_Bool", - "_Complex", - "_Imaginary", -#ifndef COB_EBCDIC_MACHINE - "_float128", -#endif - "alignof", - "asm", - "auto", - "bool", - "break", - "case", - "catch", - "char", - "class", - "const", - "const_cast", - "continue", - "default", - "delete", - "do", - "double", - "dynamic_cast", - "else", - "enum", - "exit_program", - "explicit", - "extern", - "false", - "float", - "for", - "frame_pointer", - "frame_stack", - "friend", - "goto", - "if", - "inline", - "int", - "long", - "mutable", - "namespace", - "new", - "offsetof", - "operator", - "private", - "protected", - "public", - "register", - "reinterpret_cast", - "restrict", - "return", - "short", - "signed", - "sizeof", - "static", - "static_cast", - "struct", - "switch", - "template", - "this", - "throw", - "true", - "try", - "typedef", - "typeid", - "typename", - "typeof", - "union", - "unsigned", - "using", - "virtual", - "void", - "volatile", -#ifndef COB_EBCDIC_MACHINE - "wchar_t" -#else - "wchar_t", - "NULL", - "P_cancel", - "P_initialize", - "P_ret_initialize", - "P_switch" -#endif -}; - -#define COB_NUM_CSYNS sizeof(cob_csyns) / sizeof(cob_csyns[0]) - -static const char short_options[] = "hVivqECScbmxjdFROPgGwo:t:T:I:L:l:D:K:k:"; - -#define CB_NO_ARG no_argument -#define CB_RQ_ARG required_argument -#define CB_OP_ARG optional_argument - -static const struct option long_options[] = { - {"help", CB_NO_ARG, NULL, 'h'}, - {"version", CB_NO_ARG, NULL, 'V'}, - {"verbose", CB_OP_ARG, NULL, 'v'}, - {"brief", CB_NO_ARG, NULL, 'q'}, - {"###", CB_NO_ARG, NULL, '#'}, - {"info", CB_NO_ARG, NULL, 'i'}, - {"list-reserved", CB_NO_ARG, NULL, '5'}, - {"list-intrinsics", CB_NO_ARG, NULL, '6'}, - {"list-mnemonics", CB_NO_ARG, NULL, '7'}, - {"list-system", CB_NO_ARG, NULL, '8'}, - {"list-registers", CB_NO_ARG, NULL, '9'}, - {"O0", CB_NO_ARG, NULL, '0'}, - {"O2", CB_NO_ARG, NULL, '2'}, - {"O3", CB_NO_ARG, NULL, '3'}, - {"Os", CB_NO_ARG, NULL, 's'}, - {"save-temps", CB_OP_ARG, NULL, '_'}, - {"std", CB_RQ_ARG, NULL, '$'}, - {"conf", CB_RQ_ARG, NULL, '&'}, - {"debug", CB_NO_ARG, NULL, 'd'}, - {"ext", CB_RQ_ARG, NULL, 'e'}, - {"free", CB_NO_ARG, NULL, 'F'}, /* note: not assigned directly as this is only valid for */ - {"fixed", CB_NO_ARG, NULL, 'f'}, /* `int` and sizeof(enum) isn't always sizeof (int) */ - {"static", CB_NO_ARG, &cb_flag_static_call, 1}, - {"dynamic", CB_NO_ARG, &cb_flag_static_call, 0}, - {"job", CB_OP_ARG, NULL, 'j'}, - {"j", CB_OP_ARG, NULL, 'j'}, - {"Q", CB_RQ_ARG, NULL, 'Q'}, - {"A", CB_RQ_ARG, NULL, 'A'}, - {"P", CB_OP_ARG, NULL, 'P'}, - {"Xref", CB_NO_ARG, NULL, 'X'}, - {"use-extfh", CB_RQ_ARG, NULL, 9}, /* This is used by COBOL-IT; Same is -fcallfh= */ - {"Wall", CB_NO_ARG, NULL, 'W'}, - {"W", CB_NO_ARG, NULL, 'Y'}, - {"Werror", CB_OP_ARG, NULL, 'Z'}, - {"tlines", CB_RQ_ARG, NULL, '*'}, - {"tsymbols", CB_NO_ARG, &cb_listing_symbols, 1}, /* kept for backwards-compatibility */ - -#define CB_FLAG(var,print_help,name,doc) \ - {"f" name, CB_NO_ARG, &var, 1}, \ - {"fno-" name, CB_NO_ARG, &var, 0}, -#define CB_FLAG_ON(var,print_help,name,doc) \ - {"f" name, CB_NO_ARG, &var, 1}, \ - {"fno-" name, CB_NO_ARG, &var, 0}, -#define CB_FLAG_RQ(var,print_help,name,def,opt,doc) \ - {"f" name, CB_RQ_ARG, NULL, opt}, -#define CB_FLAG_NQ(print_help,name,opt,doc) \ - {"f" name, CB_RQ_ARG, NULL, opt}, -#include "flag.def" -#undef CB_FLAG -#undef CB_FLAG_ON -#undef CB_FLAG_RQ -#undef CB_FLAG_NQ - {"fibmcomp", CB_NO_ARG, &cb_mf_ibm_comp, 1}, - {"fno-ibmcomp", CB_NO_ARG, &cb_mf_ibm_comp, 0}, - -#define CB_CONFIG_ANY(type,var,name,doc) \ - {"f" name, CB_RQ_ARG, NULL, '%'}, -#define CB_CONFIG_INT(var,name,min,max,odoc,doc) \ - {"f" name, CB_RQ_ARG, NULL, '%'}, -#define CB_CONFIG_SIZE(var,name,min,max,odoc,doc) \ - {"f" name, CB_RQ_ARG, NULL, '%'}, -#define CB_CONFIG_STRING(var,name,doc) \ - {"f" name, CB_RQ_ARG, NULL, '%'}, -#define CB_CONFIG_BOOLEAN(var,name,doc) \ - {"f" name, CB_NO_ARG, &var, 1}, \ - {"fno-" name, CB_NO_ARG, &var, 0}, -#define CB_CONFIG_SUPPORT(var,name,doc) \ - {"f" name, CB_RQ_ARG, NULL, '%'}, -#include "config.def" -#undef CB_CONFIG_ANY -#undef CB_CONFIG_INT -#undef CB_CONFIG_SIZE -#undef CB_CONFIG_STRING -#undef CB_CONFIG_BOOLEAN -#undef CB_CONFIG_SUPPORT - {"freserved", CB_RQ_ARG, NULL, '%'}, - {"fnot-reserved", CB_RQ_ARG, NULL, '%'}, - {"fintrinsic-function", CB_RQ_ARG, NULL, '%'}, - {"fnot-intrinsic-function", CB_RQ_ARG, NULL, '%'}, - {"fsystem-name", CB_RQ_ARG, NULL, '%'}, - {"fnot-system-name", CB_RQ_ARG, NULL, '%'}, - {"fregister", CB_RQ_ARG, NULL, '%'}, - {"fnot-register", CB_RQ_ARG, NULL, '%'}, - -#define CB_WARNDEF(var,name,doc) \ - {"W" name, CB_NO_ARG, &var, COBC_WARN_ENABLED}, \ - {"Wno-" name, CB_NO_ARG, &var, COBC_WARN_DISABLED}, -#define CB_ONWARNDEF(var,name,doc) \ - {"W" name, CB_NO_ARG, &var, COBC_WARN_ENABLED}, \ - {"Wno-" name, CB_NO_ARG, &var, COBC_WARN_DISABLED}, -#define CB_NOWARNDEF(var,name,doc) \ - {"W" name, CB_NO_ARG, &var, COBC_WARN_ENABLED}, \ - {"Wno-" name, CB_NO_ARG, &var, COBC_WARN_DISABLED}, -#define CB_ERRWARNDEF(var,name,doc) \ - {"W" name, CB_NO_ARG, &var, COBC_WARN_ENABLED}, \ - {"Wno-" name, CB_NO_ARG, &var, COBC_WARN_DISABLED}, -#include "warning.def" -#undef CB_WARNDEF -#undef CB_ONWARNDEF -#undef CB_NOWARNDEF -#undef CB_ERRWARNDEF - {"Wfatal-errors", CB_NO_ARG, &fatal_errors_flag, 1}, - {"Wno-fatal-errors", CB_NO_ARG, &fatal_errors_flag, 0}, - - {NULL, 0, NULL, 0} -}; - -#undef CB_NO_ARG -#undef CB_RQ_ARG -#undef CB_OP_ARG - -/* Prototype */ -DECLNORET static void COB_A_NORETURN cobc_abort_terminate (int); -DECLNORET static void COB_A_NORETURN cobc_early_exit (int); -DECLNORET static void COB_A_NORETURN cobc_err_exit (const char *, ...) COB_A_FORMAT12; -static void free_list_file (struct list_files *); -static void print_program (struct list_files *, int); -static void set_standard_title (void); -static void print_program_header (void); -static void print_program_data (const char *); -static void print_program_trailer (void); -static void print_program_listing (void); -static int process (const char *); - -/* cobc functions */ - -static void -cobc_free_mem (void) -{ - struct cobc_mem_struct *reps; - struct cobc_mem_struct *repsl; - - if (save_temps_dir) { - cobc_free (save_temps_dir); - save_temps_dir = NULL; - } - if (cobc_list_dir) { - cobc_free (cobc_list_dir); - cobc_list_dir = NULL; - } - if (cobc_list_file) { - cobc_free (cobc_list_file); - cobc_list_file = NULL; - } - if (cb_listing_file_struct) { - free_list_file (cb_listing_file_struct); - cb_listing_file_struct = NULL; - } - if (cobc_run_args) { - cobc_free (cobc_run_args); - cobc_run_args = NULL; - } - for (reps = cobc_plexmem_base; reps; ) { - repsl = reps; - reps = reps->next; - cobc_free (repsl); - } - cobc_plexmem_base = NULL; - for (reps = cobc_parsemem_base; reps; ) { - repsl = reps; - reps = reps->next; - cobc_free (repsl); - } - cobc_parsemem_base = NULL; - for (reps = cobc_mainmem_base; reps; ) { - repsl = reps; - reps = reps->next; - cobc_free (repsl); - } - cobc_mainmem_base = NULL; - cb_init_codegen (); - ppp_clear_lists (); -} - -#ifdef COB_TREE_DEBUG -static const char * -cobc_enum_explain (const enum cb_tag tag) -{ - switch (tag) { - case CB_TAG_CONST: - return "CONSTANT"; - case CB_TAG_INTEGER: - return "INTEGER"; - case CB_TAG_STRING: - return "STRING"; - case CB_TAG_ALPHABET_NAME: - return "ALPHABET"; - case CB_TAG_CLASS_NAME: - return "CLASS"; - case CB_TAG_LOCALE_NAME: - return "LOCALE"; - case CB_TAG_SYSTEM_NAME: - return "SYSTEM"; - case CB_TAG_LITERAL: - return "LITERAL"; - case CB_TAG_DECIMAL: - return "DECIMAL"; - case CB_TAG_FIELD: - return "FIELD"; - case CB_TAG_FILE: - return "FILE"; - case CB_TAG_REPORT: - return "REPORT"; - case CB_TAG_REFERENCE: - return "REFERENCE"; - case CB_TAG_BINARY_OP: - return "BINARY OP"; - case CB_TAG_FUNCALL: - return "FUNCTION CALL"; - case CB_TAG_CAST: - return "CAST"; - case CB_TAG_INTRINSIC: - return "INTRINSIC"; - case CB_TAG_LABEL: - return "LABEL"; - case CB_TAG_ASSIGN: - return "ASSIGN"; - case CB_TAG_INITIALIZE: - return "INITIALIZE"; - case CB_TAG_SEARCH: - return "SEARCH"; - case CB_TAG_CALL: - return "CALL"; - case CB_TAG_GOTO: - return "GO TO"; - case CB_TAG_IF: - return "IF"; - case CB_TAG_PERFORM: - return "PERFORM"; - case CB_TAG_STATEMENT: - return "STATEMENT"; - case CB_TAG_CONTINUE: - return "CONTINUE"; - case CB_TAG_CANCEL: - return "CANCEL"; - case CB_TAG_ALTER: - return "ALTER"; - case CB_TAG_SET_ATTR: - return "SET ATTRIBUTE"; - case CB_TAG_PERFORM_VARYING: - return "PERFORM"; - case CB_TAG_PICTURE: - return "PICTURE"; - case CB_TAG_LIST: - return "LIST"; - case CB_TAG_DIRECT: - return "DIRECT"; - case CB_TAG_DEBUG: - return "DEBUG"; - case CB_TAG_DEBUG_CALL: - return "DEBUG CALL"; - case CB_TAG_PROGRAM: - return "PROGRAM"; - case CB_TAG_PROTOTYPE: - return "PROTOTYPE"; - case CB_TAG_DECIMAL_LITERAL: - return "DECIMAL LITERAL"; - case CB_TAG_REPORT_LINE: - return "REPORT LINE"; - case CB_TAG_ML_SUPPRESS: - return "ML SUPPRESS CLAUSE"; - case CB_TAG_ML_TREE: - return "ML OUTPUT TREE"; - case CB_TAG_ML_SUPPRESS_CHECKS: - return "ML SUPPRESS CHECKS"; - case CB_TAG_CD: - return "COMMUNICATION DESCRIPTION"; - default: - break; - } - return "UNKNOWN"; -} -#endif - -static void -free_error_list (struct list_error *err) -{ - struct list_error *next; - - do { - if (err->file) { - cobc_free (err->file); - } - if (err->prefix) { - cobc_free (err->prefix); - } - if (err->msg) { - cobc_free (err->msg); - } - - next = err->next; - cobc_free (err); - err = next; - } while (err); -} - -static void -free_replace_list (struct list_replace *replace) -{ - struct list_replace *next; - - do { - if (replace->from) { - cobc_free (replace->from); - } - if (replace->to) { - cobc_free (replace->to); - } - - next = replace->next; - cobc_free (replace); - replace = next; - } while (replace); -} - -static void -free_list_skip (struct list_skip *skip) -{ - struct list_skip *next; - - do { - next = skip->next; - cobc_free (skip); - skip = next; - } while (skip); - -} - -static void -free_list_file (struct list_files *list_files_struct) -{ - struct list_files *next; - - do { - /* Delete the resources held by the struct. */ - if (list_files_struct->copy_head) { - free_list_file (list_files_struct->copy_head); - } - if (list_files_struct->err_head) { - free_error_list (list_files_struct->err_head); - } - if (list_files_struct->replace_head) { - free_replace_list (list_files_struct->replace_head); - } - if (list_files_struct->skip_head) { - free_list_skip (list_files_struct->skip_head); - } - if (list_files_struct->name) { - cobc_free ((char *) list_files_struct->name); - } - - /* Delete the struct itself */ - next = list_files_struct->next; - cobc_free (list_files_struct); - list_files_struct = next; - } while (list_files_struct); -} - -/* Global functions */ - -/* Output a formatted message to stderr */ -void -cobc_err_msg (const char *fmt, ...) -{ - va_list ap; - - fprintf (stderr, "cobc: "); - va_start (ap, fmt); - vfprintf (stderr, fmt, ap); - - if (cb_src_list_file - && cb_listing_file_struct - && cb_listing_file_struct->name) { - - char errmsg[BUFSIZ]; - vsprintf (errmsg, fmt, ap); - - cb_add_error_to_listing (NULL, 0, - "cobc: ", errmsg); - } - va_end (ap); - putc ('\n', stderr); - fflush (stderr); -} - -void -cobc_too_many_errors (void) -{ - cobc_err_msg (_("too many errors")); - cobc_abort_terminate (0); -} - -/* Output cobc source/line where an internal error occurs and exit */ -/* LCOV_EXCL_START */ -void -cobc_abort (const char * filename, const int line_num) -{ - ++errorcount; - - cobc_err_msg ("%s: %d: %s", filename, line_num, - _("internal compiler error")); - cobc_abort_terminate (1); -} -/* LCOV_EXCL_STOP */ - -#ifdef COB_TREE_DEBUG -/* LCOV_EXCL_START */ - -DECLNORET static void cobc_tree_cast_error (const cb_tree, const char *, - const int, const enum cb_tag) COB_A_NORETURN; - -static int cast_error_raised = 0; - -/* Output cobc source/line where a tree cast error occurs and exit */ -static void -cobc_tree_cast_error (const cb_tree x, const char * filename, const int line_num, - const enum cb_tag tagnum) -{ - const char *name, *type; - - cast_error_raised = 1; - if (!x) { - name = "NULL"; - type = "None"; - } else { - name = cb_name (x); - type = cobc_enum_explain (CB_TREE_TAG (x)); - } - - putc ('\n', stderr); - /* not translated as this only occurs if developer-only setup is used: */ - cobc_err_msg ("%s: %d: invalid cast from '%s' type %s to type %s", - filename, line_num, name, type, - cobc_enum_explain (tagnum)); - - if (cast_error_raised != 1) { - cobc_err_msg ("additional cast error was raised during name lookup"); - } - cobc_abort_terminate (1); -} - -cb_tree -cobc_tree_cast_check (const cb_tree x, const char * file, - const int line, const enum cb_tag tag) -{ - if (!x || x == cb_error_node || CB_TREE_TAG (x) != tag) { - /* if recursive don't raise a tree cast error */ - if (!cast_error_raised) {; - cobc_tree_cast_error (x, file, line, tag); - } else { - cast_error_raised = 2; - } - } - return x; -} -/* LCOV_EXCL_STOP */ -#endif - -void * -cobc_malloc (const size_t size) -{ - void *mptr; - - mptr = calloc ((size_t)1, size); - /* LCOV_EXCL_START */ - if (unlikely (!mptr)) { - cobc_err_msg (_("cannot allocate %d bytes of memory"), - (int)size); - cobc_abort_terminate (0); - } - /* LCOV_EXCL_STOP */ - return mptr; -} - -void -cobc_free (void * mptr) -{ - /* LCOV_EXCL_START */ - if (unlikely (!mptr)) { - cobc_err_msg (_("call to %s with NULL pointer"), "cobc_free"); - cobc_abort_terminate (1); - } - /* LCOV_EXCL_STOP */ - free (mptr); -} - -void * -cobc_strdup (const char *dupstr) -{ - void *p; - size_t n; - -#ifdef COB_TREE_DEBUG - /* LCOV_EXCL_START */ - if (unlikely (!dupstr)) { - cobc_err_msg (_("call to %s with NULL pointer"), "cobc_strdup"); - cobc_abort_terminate (1); - } - /* LCOV_EXCL_STOP */ -#endif - n = strlen (dupstr); - p = cobc_malloc (n + 1); - memcpy (p, dupstr, n); - return p; -} - -#ifdef _MSC_VER -static char * -cobc_stradd_dup (const char *str1, const char *str2) -{ - char *p; - size_t m, n; - - /* LCOV_EXCL_START */ - if (unlikely (!str1 || !str2)) { - cobc_err_msg (_("call to %s with NULL pointer"), "cobc_stradd_dup"); - cobc_abort_terminate (1); - } - /* LCOV_EXCL_STOP */ - m = strlen (str1); - n = strlen (str2); - p = cobc_malloc (m + n + 1); - memcpy (p, str1, m); - memcpy (p + m, str2, n); - return p; -} -#endif - -void * -cobc_realloc (void *prevptr, const size_t size) -{ - void *mptr; - - mptr = realloc (prevptr, size); - /* LCOV_EXCL_START */ - if (unlikely (!mptr)) { - cobc_err_msg (_("cannot reallocate %d bytes of memory"), - (int)size); - cobc_abort_terminate (0); - } - /* LCOV_EXCL_STOP */ - return mptr; -} - -/* Memory allocate/strdup/reallocate/free for complete execution */ -void * -cobc_main_malloc (const size_t size) -{ - struct cobc_mem_struct *m; - - m = calloc ((size_t)1, COBC_MEM_SIZE + size); - /* LCOV_EXCL_START */ - if (unlikely (!m)) { - cobc_err_msg (_("cannot allocate %d bytes of memory"), - (int)size); - cobc_abort_terminate (0); - } - /* LCOV_EXCL_STOP */ - m->next = cobc_mainmem_base; - m->memptr = (char *)m + COBC_MEM_SIZE; - m->memlen = size; - cobc_mainmem_base = m; - return m->memptr; -} - -void * -cobc_main_strdup (const char *dupstr) -{ - void *p; - size_t n; - - /* LCOV_EXCL_START */ - if (unlikely (!dupstr)) { - cobc_err_msg (_("call to %s with NULL pointer"), "cobc_main_strdup"); - cobc_abort_terminate (1); - } - /* LCOV_EXCL_STOP */ - n = strlen (dupstr); - p = cobc_main_malloc (n + 1); - memcpy (p, dupstr, n); - return p; -} - -static char * -cobc_main_stradd_dup (const char *str1, const char *str2) -{ - char *p; - size_t m, n; - - /* LCOV_EXCL_START */ - if (unlikely (!str1 || !str2)) { - cobc_err_msg (_("call to %s with NULL pointer"), "cobc_main_stradd_dup"); - cobc_abort_terminate (1); - } - /* LCOV_EXCL_STOP */ - m = strlen (str1); - n = strlen (str2); - p = cobc_main_malloc (m + n + 1); - memcpy (p, str1, m); - memcpy (p + m, str2, n); - return p; -} - -void * -cobc_main_realloc (void *prevptr, const size_t size) -{ - struct cobc_mem_struct *m; - struct cobc_mem_struct *curr; - struct cobc_mem_struct *prev; - - m = calloc ((size_t)1, COBC_MEM_SIZE + size); - /* LCOV_EXCL_START */ - if (unlikely (!m)) { - cobc_err_msg (_("cannot allocate %d bytes of memory"), - (int)size); - cobc_abort_terminate (0); - } - /* LCOV_EXCL_STOP */ - m->memptr = (char *)m + COBC_MEM_SIZE; - m->memlen = size; - - prev = NULL; - for (curr = cobc_mainmem_base; curr; curr = curr->next) { - if (curr->memptr == prevptr) { - break; - } - prev = curr; - } - /* LCOV_EXCL_START */ - if (unlikely (!curr)) { - cobc_err_msg (_("attempt to reallocate non-allocated memory")); - cobc_abort_terminate (0); - } - /* LCOV_EXCL_STOP */ - m->next = curr->next; - if (prev) { - prev->next = m; - } else { - /* At mainmem_base */ - cobc_mainmem_base = m; - } - memcpy (m->memptr, curr->memptr, curr->memlen); - cobc_free (curr); - - return m->memptr; -} - -void -cobc_main_free (void *prevptr) -{ - struct cobc_mem_struct *curr; - struct cobc_mem_struct *prev; - - prev = NULL; - for (curr = cobc_mainmem_base; curr; curr = curr->next) { - if (curr->memptr == prevptr) { - break; - } - prev = curr; - } - /* LCOV_EXCL_START */ - if (unlikely (!curr)) { -#ifdef COB_TREE_DEBUG - cobc_err_msg (_("call to %s with invalid pointer, as it is missing in list"), - "cobc_main_free"); - cobc_abort_terminate (1); -#else - return; -#endif - } - /* LCOV_EXCL_STOP */ - if (prev) { - prev->next = curr->next; - } else { - /* At mainmem_base */ - cobc_mainmem_base = curr->next; - } - cobc_free (curr); -} - -/* Memory allocate/strdup/reallocate/free for parser */ -void * -cobc_parse_malloc (const size_t size) -{ - struct cobc_mem_struct *m; - - m = calloc ((size_t)1, COBC_MEM_SIZE + size); - /* LCOV_EXCL_START */ - if (unlikely (!m)) { - cobc_err_msg (_("cannot allocate %d bytes of memory"), - (int)size); - cobc_abort_terminate (0); - } - /* LCOV_EXCL_STOP */ - m->next = cobc_parsemem_base; - m->memptr = (char *)m + COBC_MEM_SIZE; - m->memlen = size; - cobc_parsemem_base = m; - return m->memptr; -} - -void * -cobc_parse_strdup (const char *dupstr) -{ - void *p; - size_t n; - - /* LCOV_EXCL_START */ - if (unlikely (!dupstr)) { - cobc_err_msg (_("call to %s with NULL pointer"), "cobc_parse_strdup"); - cobc_abort_terminate (1); - } - /* LCOV_EXCL_STOP */ - n = strlen (dupstr); - p = cobc_parse_malloc (n + 1); - memcpy (p, dupstr, n); - return p; -} - -void * -cobc_parse_realloc (void *prevptr, const size_t size) -{ - struct cobc_mem_struct *m; - struct cobc_mem_struct *curr; - struct cobc_mem_struct *prev; - - m = calloc ((size_t)1, COBC_MEM_SIZE + size); - /* LCOV_EXCL_START */ - if (unlikely (!m)) { - cobc_err_msg (_("cannot allocate %d bytes of memory"), - (int)size); - cobc_abort_terminate (0); - } - /* LCOV_EXCL_STOP */ - m->memptr = (char *)m + COBC_MEM_SIZE; - m->memlen = size; - - prev = NULL; - for (curr = cobc_parsemem_base; curr; curr = curr->next) { - if (curr->memptr == prevptr) { - break; - } - prev = curr; - } - /* LCOV_EXCL_START */ - if (unlikely (!curr)) { - cobc_err_msg (_("attempt to reallocate non-allocated memory")); - cobc_abort_terminate (0); - } - /* LCOV_EXCL_STOP */ - m->next = curr->next; - if (prev) { - prev->next = m; - } else { - /* At parsemem_base */ - cobc_parsemem_base = m; - } - memcpy (m->memptr, curr->memptr, curr->memlen); - cobc_free (curr); - - return m->memptr; -} - -void -cobc_parse_free (void *prevptr) -{ - struct cobc_mem_struct *curr; - struct cobc_mem_struct *prev; - - prev = NULL; - for (curr = cobc_parsemem_base; curr; curr = curr->next) { - if (curr->memptr == prevptr) { - break; - } - prev = curr; - } - /* LCOV_EXCL_START */ - if (unlikely (!curr)) { -#ifdef COB_TREE_DEBUG - cobc_err_msg (_("call to %s with invalid pointer, as it is missing in list"), - "cobc_parse_free"); - cobc_abort_terminate (1); -#else - return; -#endif - } - /* LCOV_EXCL_STOP */ - if (prev) { - prev->next = curr->next; - } else { - /* At parsemem_base */ - cobc_parsemem_base = curr->next; - } - cobc_free (curr); -} - -/* Memory allocate/strdup/reallocate/free for preprocessor */ -void * -cobc_plex_malloc (const size_t size) -{ - struct cobc_mem_struct *m; - - m = calloc ((size_t)1, COBC_MEM_SIZE + size); - /* LCOV_EXCL_START */ - if (unlikely (!m)) { - cobc_err_msg (_("cannot allocate %d bytes of memory"), - (int)size); - cobc_abort_terminate (0); - } - /* LCOV_EXCL_STOP */ - m->memptr = (char *)m + COBC_MEM_SIZE; - m->next = cobc_plexmem_base; - cobc_plexmem_base = m; - return m->memptr; -} - -void * -cobc_plex_strdup (const char *dupstr) -{ - void *p; - size_t n; - - /* LCOV_EXCL_START */ - if (unlikely (!dupstr)) { - cobc_err_msg (_("call to %s with NULL pointer"), "cobc_plex_strdup"); - cobc_abort_terminate (1); - } - /* LCOV_EXCL_STOP */ - n = strlen (dupstr); - p = cobc_plex_malloc (n + 1); - memcpy (p, dupstr, n); - return p; -} - -void * -cobc_check_string (const char *dupstr) -{ - struct strcache *s; - - /* LCOV_EXCL_START */ - if (unlikely (!dupstr)) { - cobc_err_msg (_("call to %s with NULL pointer"), "cobc_check_string"); - cobc_abort_terminate (1); - } - /* LCOV_EXCL_STOP */ - - /* FIXME - optimize performance: - this loop is extensively used for comparision of picture strings, - it consumes ~6% of the compilation time with ~3% in strcmp */ - for (s = base_string; s; s = s->next) { - if (!strcmp (dupstr, (const char *)s->val)) { - return s->val; - } - } - s = cobc_main_malloc (sizeof(struct strcache)); - s->next = base_string; - s->val = cobc_main_strdup (dupstr); - base_string = s; - return s->val; -} - -static struct cb_text_list * -cb_text_list_add (struct cb_text_list *list, const char *text) -{ - struct cb_text_list *p; - - p = cobc_main_malloc (sizeof (struct cb_text_list)); - p->text = cobc_main_strdup (text); - if (!list) { - p->last = p; - return p; - } - list->last->next = p; - list->last = p; - return list; -} - -static struct cb_text_list * -cb_text_list_chk (struct cb_text_list *list, const char *text) -{ - struct cb_text_list *p; - - for (p = list; p; p = p->next) { - if (!strcmp (text, p->text)) { - return list; - } - } - return cb_text_list_add (list, text); -} - -static unsigned int -cobc_set_value (struct cb_define_struct *p, const char *value) -{ - const char *s; - size_t size; - unsigned int dot_seen; - unsigned int sign_seen; - - if (!value) { - p->deftype = PLEX_DEF_NONE; - p->value = NULL; - p->sign = 0; - p->int_part = 0; - p->dec_part = 0; - return 0; - } - - /* Quoted value */ - if (*value == '"' || *value == '\'') { - size = strlen (value) - 1U; - if (value[0] != value[size]) { - p->value = NULL; - p->deftype = PLEX_DEF_NONE; - return 1; - } - p->value = cobc_main_strdup (value); - - p->deftype = PLEX_DEF_LIT; - p->sign = 0; - p->int_part = 0; - p->dec_part = 0; - return 0; - } - - /* Non-quoted value - Check if possible numeric */ - dot_seen = 0; - sign_seen = 0; - size = 0; - s = value; - if (*s == '+' || *s == '-') { - sign_seen = 1; - size++; - s++; - } - for (; *s; ++s) { - if (*s == '.') { - if (dot_seen) { - break; - } - dot_seen = 1; - size++; - continue; - } - if (*s > '9' || *s < '0') { - break; - } - size++; - } - - if (*s || size <= ((size_t)dot_seen + sign_seen)) { - /* Not numeric */ -#if 0 /* RXWRXW - Lit warn */ - cb_warning (COBC_WARN_FILLER, _("assuming literal for unquoted '%s'"), - value); -#endif - size = strlen (value); - p->value = cobc_main_malloc (size + 4U); - sprintf (p->value, "'%s'", value); - p->deftype = PLEX_DEF_LIT; - p->sign = 0; - p->int_part = 0; - p->dec_part = 0; - return 0; - } - - p->value = cobc_main_strdup (value); - p->deftype = PLEX_DEF_NUM; - p->sign = 0; - p->int_part = 0; - p->dec_part = 0; - return 0; -} - -static int -cobc_bcompare (const void *p1, const void *p2) -{ - const void **tptr; - - tptr = (const void **)p2; - return strcmp (p1, *tptr); -} - -enum name_error_reason { - INVALID_LENGTH = 1, - EMPTY_NAME, - SPACE_UNDERSCORE_FIRST_CHAR, - GNUCOBOL_PREFIX, - C_KEYWORD, - CONTAINS_DIRECTORY_SEPARATOR -}; - -static void -cobc_error_name (const char *name, const enum cobc_name_type type, - const enum name_error_reason reason) -{ - const char *s; - - switch (reason) { - case INVALID_LENGTH: /* > COB_MAX_NAMELEN ("normal mode ") || > COB_MAX_WORDLEN */ - s = _(" - length exceeds maximum"); - strcpy ((char *)(name + 32), "..."); - break; - case EMPTY_NAME: - s = _(" - name cannot be empty"); - break; - case SPACE_UNDERSCORE_FIRST_CHAR: - s = _(" - name cannot begin with space or underscore"); - break; - case GNUCOBOL_PREFIX: - s = _(" - name cannot begin with 'cob_' or 'COB_'"); - break; - case C_KEYWORD: - s = _(" - name duplicates a 'C' keyword"); - break; - case CONTAINS_DIRECTORY_SEPARATOR: - s = _(" - name cannot contain a directory separator"); - break; - default: - s = ""; - break; - } - - switch (type) { - case FILE_BASE_NAME: - cb_error (_("invalid file base name '%s'%s"), - name, s); - break; - case ENTRY_NAME: - cb_error (_("invalid ENTRY '%s'%s"), name, s); - break; - case PROGRAM_ID_NAME: - cb_error (_("invalid PROGRAM-ID '%s'%s"), name, s); - break; - default: - /* internal rare error (should be raised for 'a-[150 times]-b'), - no need for translation */ - cobc_err_msg ("unknown name error '%s'%s", name, s); - break; - } -} - -size_t -cobc_check_valid_name (const char *name, const enum cobc_name_type prechk) -{ - const char *p; - size_t len; - - /* Check name doesn't contain path separator. */ - for (p = name, len = 0; *p; p++, len++) { - if (*p == '/' || *p == '\\') { - cobc_error_name (name, prechk, - CONTAINS_DIRECTORY_SEPARATOR); - return 1; - } - } - - /* Check name is of valid length. */ - if (len < 1) { - cobc_error_name (name, prechk, EMPTY_NAME); - return 1; - } - if (cb_flag_main || !cb_relaxed_syntax_checks) { - if (len > COB_MAX_NAMELEN) { - cobc_error_name (name, prechk, INVALID_LENGTH); - return 1; - } - } else { - if (len > COB_MAX_WORDLEN) { - cobc_error_name (name, prechk, INVALID_LENGTH); - return 1; - } - } - - /* missing check (here): encoded length > internal buffer, - see cob_encode_program_id */ - - if (*name == '_' || *name == ' ') { - cobc_error_name (name, prechk, SPACE_UNDERSCORE_FIRST_CHAR); - return 1; - } - - /* Check name does not begin with the libcob prefixes cob_ and COB_. */ - if (prechk && len > 3 && - (!memcmp (name, "cob_", (size_t)4) || - !memcmp (name, "COB_", (size_t)4))) { - cobc_error_name (name, prechk, GNUCOBOL_PREFIX); - return 1; - } - - /* Check name is not a C keyword. */ - if (bsearch (name, cob_csyns, COB_NUM_CSYNS, - sizeof (name), cobc_bcompare)) { - cobc_error_name (name, prechk, C_KEYWORD); - return 1; - } - - return 0; -} - -/* Local functions */ - -static void -cobc_chk_buff_size (const size_t bufflen) -{ - if (bufflen >= cobc_buffer_size) { - cobc_buffer_size = bufflen + 32; - cobc_buffer = cobc_main_realloc (cobc_buffer, cobc_buffer_size); - } -} - -/* decipher a positive int from option argument, - if allow_quote is set and quotes are used set int from char, - returns -1 on error */ -static int -cobc_deciph_optarg (const char *p, const int allow_quote) -{ - const unsigned char *s; - size_t len; - size_t i; - size_t n; - - len = strlen (p); - if (!len) { - return -1; - } - s = (const unsigned char *)p; - if (allow_quote) { - if (*s == '"' || *s == '\'') { - if (len != 3 || *(s + 2) != *s) { - return -1; - } - return (int)(*(s + 1)); - } - if (*s < '0' || *s > '9') { - if (len != 1) { - return -1; - } - return (int)*s; - } - } - n = 0; - for (i = 0; i < len; ++i) { - if (s[i] < '0' || s[i] > '9') { - return -1; - } - n *= 10; - n += (s[i] & 0x0F); - if (n > INT_MAX) return INT_MAX; - } - return (int)n; -} - -/* exit to OS before processing a COBOL/C source file */ -DECLNORET static void COB_A_NORETURN -cobc_early_exit (int retcode) -{ - if (fatal_startup_error) { - fatal_startup_error = 0; - cobc_err_exit (_("please check environment variables as noted above")); - } - cobc_free_mem (); - exit (retcode); -} - -DECLNORET static void COB_A_NORETURN -cobc_err_exit (const char *fmt, ...) -{ - va_list ap; - - fputs ("cobc: ", stderr); - fputs (_("error: "), stderr); - va_start (ap, fmt); - vfprintf (stderr, fmt, ap); - va_end (ap); - putc ('\n', stderr); - fflush (stderr); - cobc_early_exit (1); -} - -static struct cb_define_struct * -cb_define_list_add (struct cb_define_struct *list, const char *text) -{ - struct cb_define_struct *p; - struct cb_define_struct *l; - char *s; - char *x; - - x = cobc_strdup (text); - s = strtok (x, "="); - - /* Check duplicate */ - for (l = list; l; l = l->next) { - if (!strcasecmp (s, l->name)) { - cobc_err_msg (_("duplicate DEFINE '%s' - ignored"), s); - cobc_free (x); - return list; - } - } - - p = cobc_main_malloc (sizeof (struct cb_define_struct)); - p->next = NULL; - p->name = cobc_check_string (s); - p->deftype = PLEX_DEF_NONE; - s = strtok (NULL, ""); - if (cobc_set_value (p, s)) { - cobc_free (x); - return NULL; - } - - cobc_free (x); - - if (!list) { - p->last = p; - return p; - } - list->last->next = p; - list->last = p; - return list; -} - -static char * -cobc_getenv (const char *env) -{ - char *p; - - p = getenv (env); - if (!p || *p == 0 || *p == ' ') { - return NULL; - } - return cobc_main_strdup (p); -} - -/* - * Like cobc_getenv, except value is not allowed to hold any PATHSEP_CHAR - */ -static char * -cobc_getenv_path (const char *env) -{ - char *p; - - p = getenv (env); - if (!p || *p == 0 || *p == ' ') { - return NULL; - } - if (strchr (p, PATHSEP_CHAR) != NULL) { - cobc_err_msg (_("environment variable '%s' is '%s'; should not contain '%c'"), env, p, PATHSEP_CHAR); - fatal_startup_error = 1; - } - return cobc_main_strdup (p); -} - -/* compiler startup phase: add string to internal flags which keep its own length, - if target field is too small reallocate the memory with doubled size */ -static void -cobc_add_str (char **var, size_t *cursize, const char *s1, const char *s2, - const char *s3) -{ - size_t calcsize; - - if (!s1) { - return; - } - - calcsize = strlen (*var); - calcsize += strlen (s1); - if (s2) { - calcsize += strlen (s2); - } - if (s3) { - calcsize += strlen (s3); - } - /* LCOV_EXCL_START */ - if (calcsize >= 131072) { - /* Arbitrary limit */ - cobc_err_exit (_("parameter buffer size exceeded")); - } - /* LCOV_EXCL_STOP */ - if (calcsize >= *cursize) { - while (*cursize <= calcsize) { - *cursize *= 2; - } - *var = cobc_main_realloc (*var, *cursize); - } - strcat (*var, s1); - if (s2) { - strcat (*var, s2); - } - if (s3) { - strcat (*var, s3); - } -} - -static void -cobc_check_action (const char *name) -{ - int ret; - if (!name || access (name, F_OK)) { - return; - } - if (!save_temps) { - (void)unlink (name); - return; - } - if (save_temps_dir) { - char temp_buff[COB_MEDIUM_BUFF]; - - snprintf (temp_buff, (size_t)COB_MEDIUM_MAX, - "%s%s%s", save_temps_dir, SLASH_STR, name); - temp_buff[COB_MEDIUM_MAX] = 0; - /* Remove possible target file - ignore return */ - (void)unlink (temp_buff); - ret = rename (name, temp_buff); - /* LCOV_EXCL_START */ - if (ret) { - cobc_err_msg (_("warning: could not move temporary file to %s"), - temp_buff); - } - /* LCOV_EXCL_STOP */ - } -} - -static void -clean_up_intermediates (struct filename *fn, const int status) -{ - struct local_filename *lf; - cob_u32_t i; -#ifdef HAVE_8DOT3_FILENAMES - char *buffer; -#endif - for (lf = fn->localfile; lf; lf = lf->next) { - if (unlikely(lf->local_fp)) { - fclose (lf->local_fp); - lf->local_fp = NULL; - } - } - if (save_all_src) { - return; - } - if (fn->need_preprocess && - (status || cb_compile_level > CB_LEVEL_PREPROCESS || - (cb_compile_level == CB_LEVEL_PREPROCESS && save_temps))) { - cobc_check_action (fn->preprocess); - } - if (save_c_src) { - return; - } - if (fn->need_translate && - (status || cb_compile_level > CB_LEVEL_TRANSLATE || - (cb_compile_level == CB_LEVEL_TRANSLATE && save_temps))) { - cobc_check_action (fn->translate); - cobc_check_action (fn->trstorage); - if (fn->localfile) { - for (lf = fn->localfile; lf; lf = lf->next) { - cobc_check_action (lf->local_name); - } - } else if (fn->translate) { - /* If we get syntax errors, we do not - know the number of local include files */ -#ifndef HAVE_8DOT3_FILENAMES - snprintf (cobc_buffer, cobc_buffer_size, - "%s.l.h", fn->translate); -#else - /* for 8.3 filenames use no ".c" prefix and only one period */ - buffer = cobc_strdup (fn->translate); - *(buffer + strlen(buffer) - 2) = 'l'; - *(buffer + strlen(buffer) - 1) = 0; - snprintf (cobc_buffer, cobc_buffer_size, - "%s.h", buffer); - cobc_free (buffer); -#endif - cobc_buffer[cobc_buffer_size] = 0; - for (i = 0; i < 30U; ++i) { - if (i) { -#ifndef HAVE_8DOT3_FILENAMES - snprintf (cobc_buffer, cobc_buffer_size, - "%s.l%u.h", fn->translate, i); -#else - snprintf (cobc_buffer, cobc_buffer_size, - "%s%u.h", buffer, i); -#endif - cobc_buffer[cobc_buffer_size] = 0; - } - if (!access (cobc_buffer, F_OK)) { - unlink (cobc_buffer); - } else if (i) { - break; - } - } -#ifdef HAVE_8DOT3_FILENAMES - cobc_free (buffer); -#endif - } - } -} - -static void -cobc_clean_up (const int status) -{ - struct filename *fn; - - if (cb_src_list_file) { - if (cb_src_list_file != stdout) { - fclose (cb_src_list_file); - } - cb_src_list_file = NULL; - } - if (cb_listing_file) { - fclose (cb_listing_file); - cb_listing_file = NULL; - } - if (cb_storage_file) { - fclose (cb_storage_file); - cb_storage_file = NULL; - } - - if (ppin) { - fclose (ppin); - ppin = NULL; - } - - if (ppout) { - fclose (ppout); - ppout = NULL; - } - plex_call_destroy (); - plex_clear_all (); - - if (yyin) { - fclose (yyin); - yyin = NULL; - } - if (yyout) { - fclose (yyout); - yyout = NULL; - } - ylex_call_destroy (); - ylex_clear_all (); - - for (fn = file_list; fn; fn = fn->next) { - if (fn->need_assemble && - (status || cb_compile_level > CB_LEVEL_ASSEMBLE || - (cb_compile_level == CB_LEVEL_ASSEMBLE && save_temps))) { - cobc_check_action (fn->object); - } - clean_up_intermediates (fn, status); - } - cobc_free_mem (); - file_list = NULL; -} - -static void -set_listing_date (void) -{ - char *time_buff; - if (!current_compile_time.year) { - current_compile_time = cob_get_current_date_and_time(); - } - - /* the following code is likely to get replaced by a self-written format */ - current_compile_tm.tm_sec = current_compile_time.second; - current_compile_tm.tm_min = current_compile_time.minute; - current_compile_tm.tm_hour = current_compile_time.hour; - current_compile_tm.tm_mday = current_compile_time.day_of_month; - current_compile_tm.tm_mon = current_compile_time.month - 1; - current_compile_tm.tm_year = current_compile_time.year - 1900; - if (current_compile_time.day_of_week == 7) { - current_compile_tm.tm_wday = 0; - } else { - current_compile_tm.tm_wday = current_compile_time.day_of_week; - } - current_compile_tm.tm_yday = current_compile_time.day_of_year; - current_compile_tm.tm_isdst = current_compile_time.is_daylight_saving_time; - time_buff = asctime (¤t_compile_tm); - /* LCOV_EXCL_START */ - if (!time_buff) { - strncpy (cb_listing_date, "DATE BUG, PLEASE REPORT", CB_LISTING_DATE_MAX); - return; - } - /* LCOV_EXCL_STOP */ - *strchr (time_buff, '\n') = '\0'; - strncpy (cb_listing_date, time_buff, CB_LISTING_DATE_MAX); -} - - -DECLNORET static void COB_A_NORETURN -cobc_terminate (const char *str) -{ - if (cb_src_list_file) { - set_listing_date (); - set_standard_title (); - cb_listing_linecount = cb_lines_per_page; - strncpy (cb_listing_filename, str, FILENAME_MAX); - cb_listing_filename[FILENAME_MAX - 1] = 0; - print_program_header (); - } - cb_perror (0, "cobc: %s: %s", str, cb_get_strerror ()); - if (cb_src_list_file) { - print_program_trailer (); - } - cobc_clean_up (1); - exit (1); -} - -static void -cobc_abort_msg (void) -{ - char *prog_id; - const char *prog_type; - - if (cb_source_file) { - if (current_program) { - if (current_program->prog_type == COB_MODULE_TYPE_FUNCTION) { - prog_type = "FUNCTION-ID"; - } else { - prog_type = "PROGRAM-ID"; - } - if (current_program->orig_program_id) { - prog_id = (char *)current_program->orig_program_id; - } else { - prog_id = (char *)_("unknown"); - } - } else { - prog_type = prog_id = (char *)_("unknown"); - } - if (!cb_source_line) { - cobc_err_msg (_("aborting codegen for %s (%s: %s)"), - cb_source_file, prog_type, prog_id); - } else { - cobc_err_msg (_("aborting compile of %s at line %d (%s: %s)"), - cb_source_file, cb_source_line, prog_type, prog_id); - } - } else { - cobc_err_msg (_("aborting")); - } -} - -/* return to OS in case of hard errors after trying to output the error to - listing file if active */ -DECLNORET static void COB_A_NORETURN -cobc_abort_terminate (int should_be_reported) -{ - /* note we returned 99 for aborts earlier but autotest will - "recognize" status 99 as failure (you cannot "expect" the return 99 */ - const int ret_code = 97; - - if (!should_be_reported - && cb_src_list_file - && cb_listing_file_struct - && cb_listing_file_struct->name) { - print_program_listing (); - } - putc ('\n', stderr); - cobc_abort_msg (); - - if (should_be_reported) { - cobc_err_msg (_("Please report this!")); - if (cb_src_list_file - && cb_listing_file_struct - && cb_listing_file_struct->name) { - print_program_listing (); - } - } - cobc_clean_up (ret_code); - exit (ret_code); -} - -static void -cobc_sig_handler (int sig) -{ -#if defined (SIGINT) ||defined (SIGQUIT) || defined (SIGTERM) || defined (SIGPIPE) - int ret = 0; -#endif - - cobc_abort_msg (); -#if defined (SIGINT) ||defined (SIGQUIT) || defined (SIGTERM) || defined (SIGPIPE) -#ifdef SIGINT - if (sig == SIGINT) ret = 1; -#endif -#ifdef SIGQUIT - if (sig == SIGQUIT) ret = 1; -#endif -#ifdef SIGTERM - if (sig == SIGTERM) ret = 1; -#endif -#ifdef SIGPIPE - if (sig == SIGPIPE) ret = 1; -#endif - - /* LCOV_EXCL_START */ - if (!ret) { - cobc_err_msg (_("Please report this!")); - } - /* LCOV_EXCL_STOP */ -#else - COB_UNUSED (sig); -#endif - save_temps = 0; - cobc_clean_up (1); -} - -/* Command line */ - -static void -cobc_print_version (void) -{ - printf ("cobc (%s) %s.%d\n", - PACKAGE_NAME, PACKAGE_VERSION, PATCH_LEVEL); - puts ("Copyright (C) 2020 Free Software Foundation, Inc."); - puts (_("License GPLv3+: GNU GPL version 3 or later ")); - puts (_("This is free software; see the source for copying conditions. There is NO\n" - "warranty; not even for MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.")); - printf (_("Written by %s\n"), "Keisuke Nishida, Roger While, Ron Norman, Simon Sobisch, Edward Hart"); - printf (_("Built %s"), cb_cobc_build_stamp); - putchar ('\n'); - printf (_("Packaged %s"), COB_TAR_DATE); - putchar ('\n'); - printf (_("C version %s%s"), GC_C_VERSION_PRF, GC_C_VERSION); - putchar ('\n'); -} - -static void -cobc_print_shortversion (void) -{ - printf ("cobc (%s) %s.%d\n", - PACKAGE_NAME, PACKAGE_VERSION, PATCH_LEVEL); - printf (_("Built %s"), cb_cobc_build_stamp); - putchar ('\t'); - printf (_("Packaged %s"), COB_TAR_DATE); - putchar ('\n'); - printf (_("C version %s%s"), GC_C_VERSION_PRF, GC_C_VERSION); - putchar ('\n'); -} - -static void -cobc_cmd_print (const char *cmd) -{ - char *p; - char *token; - size_t n; - size_t toklen; - - if (verbose_output >= 0) { - fputs (_("executing:"), stderr); - } else { - fputs (_("to be executed:"), stderr); - } - /* Check if it fits in 80 characters */ - if (strlen (cmd) < 64) { - fprintf (stderr, "\t%s\n", (char *)cmd); - fflush (stderr); - return; - } - putc ('\t', stderr); - p = cobc_strdup (cmd); - n = 0; - token = strtok (p, " "); - for (; token; token = strtok (NULL, " ")) { - toklen = strlen (token) + 1; - if ((n + toklen) > 63) { - fprintf (stderr, "\n\t\t"); - n = 0; - } - fprintf (stderr, "%s%s", (n ? " " : ""), token); - n += toklen; - } - cobc_free (p); - putc ('\n', stderr); - fflush (stderr); -} - -static void -cobc_var_print (const char *msg, const char *val, const unsigned int env) -{ - char *p; - char *token; - size_t n; - int lablen; - size_t toklen; - - if (!env) { - printf ("%-*.*s : ", CB_IMSG_SIZE, CB_IMSG_SIZE, msg); - } else { - printf (" %s: ", _("env")); - lablen = CB_IMSG_SIZE - 2 - (int)strlen (_("env")) - 2; - printf ("%-*.*s : ", lablen, lablen, msg); - } - if (strlen (val) <= CB_IVAL_SIZE) { - printf ("%s\n", val); - return; - } - p = cobc_strdup (val); - n = 0; - token = strtok (p, " "); - for (; token; token = strtok (NULL, " ")) { - toklen = strlen (token) + 1; - if ((n + toklen) > CB_IVAL_SIZE) { - if (n) { - printf ("\n%*.*s", CB_IMSG_SIZE + 3, - CB_IMSG_SIZE + 3, " "); - } - n = 0; - } - printf ("%s%s", (n ? " " : ""), token); - n += toklen; - } - putchar ('\n'); - cobc_free (p); -} - -static void -cobc_print_info (void) -{ - char buff[16]; - char versbuff[56]; - char *s; - - cobc_print_version (); - putchar ('\n'); - puts (_("build information")); - cobc_var_print (_("build environment"), COB_BLD_BUILD, 0); - cobc_var_print ("CC", COB_BLD_CC, 0); - /* Note: newline because most compilers define a long version string (> 30 characters) */ - snprintf (versbuff, 55, "%s%s", GC_C_VERSION_PRF, GC_C_VERSION); - cobc_var_print ("C version", versbuff, 0); - cobc_var_print ("CPPFLAGS", COB_BLD_CPPFLAGS, 0); - cobc_var_print ("CFLAGS", COB_BLD_CFLAGS, 0); - cobc_var_print ("LD", COB_BLD_LD, 0); - cobc_var_print ("LDFLAGS", COB_BLD_LDFLAGS, 0); - putchar ('\n'); - puts (_("GnuCOBOL information")); - cobc_var_print ("COB_CC", COB_CC, 0); - if ((s = getenv ("COB_CC")) != NULL) { - cobc_var_print ("COB_CC", s, 1); - } - cobc_var_print ("COB_CFLAGS", COB_CFLAGS, 0); - if ((s = getenv ("COB_CFLAGS")) != NULL) { - cobc_var_print ("COB_CFLAGS", s, 1); - } - cobc_var_print ("COB_LDFLAGS", COB_LDFLAGS, 0); - if ((s = getenv ("COB_LDFLAGS")) != NULL) { - cobc_var_print ("COB_LDFLAGS", s, 1); - } - cobc_var_print ("COB_LIBS", COB_LIBS, 0); - if ((s = getenv ("COB_LIBS")) != NULL) { - cobc_var_print ("COB_LIBS", s, 1); - } - cobc_var_print ("COB_CONFIG_DIR", COB_CONFIG_DIR, 0); - if ((s = getenv ("COB_CONFIG_DIR")) != NULL) { - cobc_var_print ("COB_CONFIG_DIR", s, 1); - } - cobc_var_print ("COB_COPY_DIR", COB_COPY_DIR, 0); - if ((s = getenv ("COB_COPY_DIR")) != NULL) { - cobc_var_print ("COB_COPY_DIR", s, 1); - } - cobc_var_print ("COB_SCHEMA_DIR", COB_SCHEMA_DIR, 0); - if ((s = getenv ("COB_SCHEMA_DIR")) != NULL) { - cobc_var_print ("COB_SCHEMA_DIR", s, 1); - } - if ((s = getenv ("COBCPY")) != NULL) { - cobc_var_print ("COBCPY", s, 1); - } -#if defined (_MSC_VER) - cobc_var_print ("COB_MSG_FORMAT", "MSC", 0); -#else - cobc_var_print ("COB_MSG_FORMAT", "GCC", 0); -#endif - if ((s = getenv ("COB_MSG_FORMAT")) != NULL) { - cobc_var_print ("COB_MSG_FORMAT", s, 1); - } - cobc_var_print ("COB_OBJECT_EXT", COB_OBJECT_EXT, 0); - cobc_var_print ("COB_MODULE_EXT", COB_MODULE_EXT, 0); - cobc_var_print ("COB_EXE_EXT", COB_EXE_EXT, 0); - -#ifdef COB_64_BIT_POINTER - cobc_var_print ("64bit-mode", _("yes"), 0); -#else - cobc_var_print ("64bit-mode", _("no"), 0); -#endif - -#ifdef COB_LI_IS_LL - cobc_var_print ("BINARY-C-LONG", _("8 bytes"), 0); -#else - cobc_var_print ("BINARY-C-LONG", _("4 bytes"), 0); -#endif - -#ifdef WORDS_BIGENDIAN - cobc_var_print (_("endianness"), _("big-endian"), 0); -#else - cobc_var_print (_("endianness"), _("little-endian"), 0); -#endif - -#ifdef COB_EBCDIC_MACHINE - cobc_var_print (_("native character set"), _("EBCDIC"), 0); -#else - cobc_var_print (_("native character set"), _("ASCII"), 0); -#endif - - cobc_var_print (_("extended screen I/O"), WITH_CURSES, 0); - - snprintf (buff, sizeof(buff), "%d", WITH_VARSEQ); - cobc_var_print (_("variable file format"), buff, 0); - if ((s = getenv ("COB_VARSEQ_FORMAT")) != NULL) { - cobc_var_print ("COB_VARSEQ_FORMAT", s, 1); - } - -#ifdef WITH_SEQRA_EXTFH - cobc_var_print (_("sequential file handler"), "EXTFH (obsolete)", 0); -#else - cobc_var_print (_("sequential file handler"), _("built-in"), 0); -#endif - - -#if defined(WITH_INDEX_EXTFH) || defined(WITH_CISAM) || defined(WITH_DISAM) \ - || defined(WITH_VBISAM) || defined(WITH_DB) || defined(WITH_LMDB) \ - || defined(WITH_ODBC) || defined(WITH_OCI) -#if defined (WITH_INDEX_EXTFH) - cobc_var_print (_("indexed file handler"), "EXTFH (obsolete)", 0); -#endif -#if defined (WITH_DB) -#if defined(DB_VERSION_MAJOR) && defined(DB_VERSION_MINOR) && defined(DB_VERSION_PATCH) - snprintf (versbuff, 55, "%s version %d.%d.%d", - "BDB", DB_VERSION_MAJOR, DB_VERSION_MINOR,DB_VERSION_PATCH); - cobc_var_print (_("indexed file handler"), versbuff, 0); -#else - cobc_var_print (_("indexed file handler"), "BDB", 0); -#endif -#endif -#if defined (WITH_LMDB) -#if defined(MDB_VERSION_MAJOR) && defined(MDB_VERSION_MINOR) && defined(MDB_VERSION_PATCH) - snprintf (versbuff, 55, "%s version %d.%d.%d", - "LMDB", MDB_VERSION_MAJOR, MDB_VERSION_MINOR,MDB_VERSION_PATCH); - cobc_var_print (_("indexed file handler"), versbuff, 0); -#else - cobc_var_print (_("indexed file handler"), "LMDB", 0); -#endif -#endif -#if defined (WITH_CISAM) - cobc_var_print (_("indexed file handler"), "C-ISAM", 0); -#endif -#if defined (WITH_DISAM) - cobc_var_print (_("indexed file handler"), "D-ISAM", 0); -#endif -#if defined (WITH_VBISAM) -# if defined (VB_RTD) - cobc_var_print (_("indexed file handler"), "VBISAM (RTD)", 0); -# else - cobc_var_print (_("indexed file handler"), "VBISAM", 0); -# endif -#endif -#if defined (WITH_ODBC) -#if defined (SQL_SPEC_STRING) - cobc_var_print (_("indexed file handler"), "ODBC " SQL_SPEC_STRING, 0); -#else - cobc_var_print (_("indexed file handler"), "ODBC", 0); -#endif -#endif -#if defined (WITH_OCI) -#if defined(OCI_MAJOR_VERSION) && defined(OCI_MINOR_VERSION) - snprintf (versbuff, 55, "%s - %d.%d", - "OCI (Oracle)", OCI_MAJOR_VERSION, OCI_MINOR_VERSION); - cobc_var_print (_("indexed file handler"), versbuff, 0); -#else - cobc_var_print (_("indexed file handler"), "OCI (Oracle)", 0); -#endif -#endif -#if defined(WITH_IXDFLT) && defined(WITH_MULTI_ISAM) - cobc_var_print (_("default indexed handler"), WITH_IXDFLT, 0); -#endif -#else - cobc_var_print (_("indexed file handler"), _("disabled"), 0); -#endif - -#if defined(__MPIR_VERSION) - cobc_var_print (_("mathematical library"), "MPIR - GMP", 0); -#else - cobc_var_print (_("mathematical library"), "GMP", 0); -#endif - -#ifdef WITH_XML2 - cobc_var_print (_("XML library"), "libxml2", 0); -#else - cobc_var_print (_("XML library"), _("disabled"), 0); -#endif - -#ifdef WITH_CJSON - cobc_var_print (_("JSON library"), "cJSON", 0); -#else - cobc_var_print (_("JSON library"), _("disabled"), 0); -#endif -} - -static void -cobc_options_error_nonfinal (void) -{ - cobc_err_exit (_("only one of options 'E', 'S', 'C', 'c' may be specified")); -} - -static void -cobc_options_error_build (void) -{ - cobc_err_exit (_("only one of options 'm', 'x', 'b' may be specified")); -} - -/* decipher dump options given on command line */ -static void -cobc_def_dump_opts (const char *opt) -{ - char *p, *q; - if (!strcasecmp (opt, "ALL")) { - cb_flag_dump = COB_DUMP_ALL; - return; - } - - p = cobc_strdup (opt); - q = strtok (p, ","); - while (q) { - if (!strcasecmp (q, "FD")) { - cb_flag_dump |= COB_DUMP_FD; - } else if (!strcasecmp (q, "WS")) { - cb_flag_dump |= COB_DUMP_WS; - } else if (!strcasecmp (q, "LS")) { - cb_flag_dump |= COB_DUMP_LS; - } else if (!strcasecmp (q, "RD")) { - cb_flag_dump |= COB_DUMP_RD; - } else if (!strcasecmp (q, "SD")) { - cb_flag_dump |= COB_DUMP_SD; - } else if (!strcasecmp (q, "SC")) { - cb_flag_dump |= COB_DUMP_SC; - } else { - cobc_err_exit (_("-fdump= requires one of 'ALL', 'FD', 'WS', 'LS', " - "'RD', 'FD', 'SC' not '%s'"), opt); - } - q = strtok (NULL, ","); - } - cobc_free (p); -} - -/* decipher functions given on command line, - checking that these are actually intrinsic functions */ -static void -cobc_deciph_funcs (const char *opt) -{ - char *p; - char *q; - - if (!strcasecmp (opt, "ALL")) { - cb_flag_functions_all = 1; - return; - } - - p = cobc_strdup (opt); - q = strtok (p, ","); - while (q) { - if (!lookup_intrinsic (q, 1)) { - cobc_err_exit (_("'%s' is not an intrinsic function"), q); - } - CB_TEXT_LIST_ADD (cb_intrinsic_list, q); - q = strtok (NULL, ","); - } - cobc_free (p); -} - -#if defined (_MSC_VER) || defined(__OS400__) || defined(__WATCOMC__) || defined(__BORLANDC__) -static void -file_stripext (char *buff) -{ - char *endp; - - endp = buff + strlen (buff) - 1U; - while (endp > buff) { - if (*endp == '/' || *endp == '\\') { - break; - } - if (*endp == '.') { - *endp = 0; - } - --endp; - } -} -#endif - -# define COB_BASENAME_KEEP_EXT "" -/* get basename from file, if optional parameter strip_ext is given then only - strip the extension if it matches the parameter (must include the period), - don't strip the extension if the parameter equals COB_BASENAME_KEEP_EXT; - returns a pointer to the previous allocated basename_buffer */ -static char * -file_basename (const char *filename, const char *strip_ext) -{ - const char *p; - const char *startp; - const char *endp; - size_t len; - - /* LCOV_EXCL_START */ - if (!filename) { - cobc_err_msg (_("call to '%s' with invalid parameter '%s'"), - "file_basename", "filename"); - COBC_ABORT (); - } - /* LCOV_EXCL_STOP */ - - /* Remove directory name */ - startp = NULL; - for (p = filename; *p; p++) { - if (*p == '/' || *p == '\\') { - startp = p; - } - } - if (startp) { - startp++; - } else { - startp = filename; - } - - /* Remove extension */ - if (!strip_ext || strcmp (strip_ext, COB_BASENAME_KEEP_EXT)) { - endp = strrchr (filename, '.'); - } else { - endp = startp; - } - if (endp > startp - && (!strip_ext || strcasecmp (endp, strip_ext) == 0)) { - len = endp - startp; - } else { - len = strlen (startp); - } - - if (len >= basename_len) { - basename_len = len + 16; - basename_buffer = cobc_main_realloc (basename_buffer, basename_len); - } - /* Copy base name (possibly done before -> memmove) */ - memmove (basename_buffer, startp, len); - basename_buffer[len] = 0; - return basename_buffer; -} - -/* get file extension from filename (without the leading period) */ -static const char * -file_extension (const char *filename) -{ - const char *p; - - p = strrchr (filename, '.'); - if (p) { - return p + 1; - } - return ""; -} - -/* set compile_level from output file if not set already */ -static void -set_compile_level_from_file_extension (const char *filename) -{ - const char *ext; - - if (cb_flag_syntax_only) { - return; - } - - ext = file_extension (filename); - - if (strcasecmp (ext, "i") == 0) { - cb_compile_level = CB_LEVEL_PREPROCESS; - } else if (strcasecmp (ext, "c") == 0) { - cb_compile_level = CB_LEVEL_TRANSLATE; - save_c_src = 1; - } else if (strcasecmp (ext, "s") == 0 || strcasecmp (ext, "asm") == 0) { - cb_compile_level = CB_LEVEL_COMPILE; - } else if (strcasecmp (ext, COB_OBJECT_EXT) == 0) { - cb_compile_level = CB_LEVEL_ASSEMBLE; - } else if (strcasecmp (ext, COB_MODULE_EXT) == 0 && !cobc_flag_main) { - if (cobc_flag_library) { - cb_compile_level = CB_LEVEL_LIBRARY; - } else { - cb_compile_level = CB_LEVEL_MODULE; - cobc_flag_module = 1; - } - /* note: no setting of CB_LEVEL_EXECUTABLE as this should be explicit requested */ - } -} - -/* process command line options */ -static int -process_command_line (const int argc, char **argv) -{ - struct cb_define_struct *p; - size_t osize; - int c; - int idx; - int n; - int exit_option = 0; - int list_reserved = 0; - int list_registers = 0; - int list_intrinsics = 0; - int list_system_names = 0; - int list_system_routines = 0; -#if defined (_WIN32) || defined (__DJGPP__) - int argnum; -#endif - enum cob_exception_id i; - char ext[COB_MINI_BUFF]; - char *conf_label; /* we want a dynamic address for erroc.c, not a static one */ - char *conf_entry; - const char *copt = NULL; /* C optimization options */ -#if defined (_MSC_VER) - const char *extension; -#endif - - int conf_ret = 0; - int error_all_warnings = 0; - - cb_mf_ibm_comp = -1; - cb_warn_unsupported = COBC_WARN_AS_ERROR; - -#if defined (_WIN32) || defined (__DJGPP__) - /* Translate command line arguments from DOS/WIN to UNIX style */ - argnum = 1; - while (++argnum <= argc) { - if (strrchr(argv[argnum - 1], '/') == argv[argnum - 1]) { - argv[argnum - 1][0] = '-'; - } - } -#endif - - /* First run of getopt: handle std/conf and all listing options - We need to postpone single configuration flags as we need - a full configuration to be loaded before */ - cob_optind = 1; - while ((c = cob_getopt_long_long (argc, argv, short_options, - long_options, &idx, 1)) >= 0) { - switch (c) { - - case '?': - /* Unknown option or ambiguous */ - cobc_early_exit (1); - - case 'h': - /* --help */ - cobc_print_usage (argv[0]); - if (verbose_output) { - puts ("\n"); - fflush (stdout); -#ifdef _MSC_VER - process ("cl.exe /help"); - puts ("\n"); - fflush (stdout); - process ("link.exe"); -#else - cobc_buffer_size = strlen (cobc_cc) + 11; - cobc_buffer = cobc_malloc (cobc_buffer_size); - snprintf (cobc_buffer, cobc_buffer_size, "%s --help", cobc_cc); -#if (defined(__GNUC__) && !defined(__INTEL_COMPILER)) || defined(__TINYC__) - if (verbose_output > 1) { - snprintf (cobc_buffer, cobc_buffer_size, "%s -v --help", cobc_cc); - } -#endif - cobc_buffer[cobc_buffer_size] = 0; - process (cobc_buffer); - cobc_free (cobc_buffer); - cobc_buffer = NULL; -#endif - } - cobc_early_exit (0); - - case 'V': - /* --version */ - cobc_print_version (); - if (verbose_output) { - puts ("\n"); - fflush (stdout); -#ifdef _MSC_VER - process ("cl.exe"); - puts ("\n"); -#else - cobc_buffer_size = strlen (cobc_cc) + 11; - cobc_buffer = cobc_malloc (cobc_buffer_size); -#if defined(__TINYC__) - snprintf (cobc_buffer, cobc_buffer_size, "%s -v", cobc_cc); -#else - snprintf (cobc_buffer, cobc_buffer_size, "%s --version", cobc_cc); -#endif -#if (defined(__GNUC__) && !defined(__INTEL_COMPILER)) - if (verbose_output > 2) { - snprintf (cobc_buffer, cobc_buffer_size, "%s -v", cobc_cc); - } -#endif - cobc_buffer[cobc_buffer_size] = 0; - process (cobc_buffer); - cobc_free (cobc_buffer); - cobc_buffer = NULL; -#endif - } - cobc_early_exit (0); - - case 'i': - /* --info */ - cobc_print_info (); - cobc_early_exit (0); - - /* - The following list options are postponed until - until the configuration and exceptions are processed. - */ - case '5': - /* --list-reserved */ - list_reserved = 1; - exit_option = 1; - break; - - case '6': - /* --list-intrinsics */ - list_intrinsics = 1; - exit_option = 1; - break; - - case '7': - /* --list-mnemonics */ - list_system_names = 1; - exit_option = 1; - break; - - case '8': - /* --list-system */ - list_system_routines = 1; - exit_option = 1; - break; - - case '9': - /* --list-registers */ - list_registers = 1; - exit_option = 1; - break; - - case 'q': - /* --brief : reduced reporting */ - /* resets -verbose and removes the path to cobc in argv[0] */ - verbose_output = 0; - strcpy (argv[0], "cobc"); /* set for simple compare in test suite - and other static output */ - break; - - case '#': - /* --### : verbose output of commands, but don't execute them */ - if (!verbose_output) { - cobc_print_shortversion (); - } - verbose_output = -1; - break; - - case 'v': - /* --verbose : Verbose reporting */ - /* VERY special case as we set different level by multiple calls */ - /* output version information when running very verbose -vv */ - /* pass verbose switch to invoked commands when running very very verbose -vvv */ - if (cob_optarg) { - n = cobc_deciph_optarg (cob_optarg, 0); - if (n == -1) { - cobc_err_exit (COBC_INV_PAR, "-verbose"); - } - verbose_output = n; - if (verbose_output >= 1) { - cobc_print_shortversion (); - } - } else { - verbose_output++; - if (verbose_output == 1) { - cobc_print_shortversion (); - } - } - break; - - case '$': - /* -std= : Specify dialect */ - if (strlen (cob_optarg) > COB_MINI_MAX) { - cobc_err_exit (COBC_INV_PAR, "-std"); - } - snprintf (ext, (size_t)COB_MINI_MAX, "%s.conf", cob_optarg); - conf_ret |= cb_load_std (ext); - break; - - case '&': - /* -conf= : Specify dialect configuration file */ - if (strlen (cob_optarg) > COB_SMALL_MAX) { - cobc_err_exit (COBC_INV_PAR, "-conf"); - } - conf_ret |= cb_load_conf (cob_optarg, 0); - break; - - default: - /* as we postpone most options simply skip everything other here */ - break; - } - } - - /* Load default configuration file if necessary */ - if (cb_config_name == NULL) { - if (verbose_output) { - fputs (_("loading standard configuration file 'default.conf'"), stderr); - fputc ('\n', stderr); - } - conf_ret |= cb_load_std ("default.conf"); - } - - /* Exit for configuration errors resulting from -std/-conf/default.conf */ - if (conf_ret != 0) { - cobc_early_exit (1); - } - - cob_optind = 1; - while ((c = cob_getopt_long_long (argc, argv, short_options, - long_options, &idx, 1)) >= 0) { - switch (c) { - case 0: - /* Defined flag */ - break; - - case 'h': - /* --help */ - case 'V': - /* --version */ - case 'i': - /* --info */ - case '5': - /* --list-reserved */ - case '6': - /* --list-intrinsics */ - case '7': - /* --list-mnemonics */ - case '8': - /* --list-system */ - case '9': - /* --list-registers */ - /* These options were all processed in the first getopt-run */ - break; - - case 'E': - /* -E : Preprocess */ - if (cb_compile_level != 0) { - cobc_options_error_nonfinal (); - } - cb_compile_level = CB_LEVEL_PREPROCESS; - break; - - case 'C': - /* -C : Generate C code */ - if (cb_compile_level != 0) { - cobc_options_error_nonfinal (); - } - save_c_src = 1; - cb_compile_level = CB_LEVEL_TRANSLATE; - break; - - case 'S': - /* -S : Generate assembler code */ - if (cb_compile_level != 0) { - cobc_options_error_nonfinal (); - } - cb_compile_level = CB_LEVEL_COMPILE; - break; - - case 'c': - /* -c : Generate C object code */ - if (cb_compile_level != 0) { - cobc_options_error_nonfinal (); - } - cb_compile_level = CB_LEVEL_ASSEMBLE; - break; - - case 'b': - /* -b : Generate combined library module */ - if (cobc_flag_main || cobc_flag_module) { - cobc_options_error_build (); - } - cobc_flag_library = 1; - no_physical_cancel = 1; - /* note: implied -fimplicit-init until GC 3.1 */ - break; - - case 'm': - /* -m : Generate loadable module (default) */ - if (cobc_flag_main || cobc_flag_library) { - cobc_options_error_build (); - } - cobc_flag_module = 1; - break; - - case 'x': - /* -x : Generate executable */ - if (cobc_flag_module || cobc_flag_library) { - cobc_options_error_build (); - } - cobc_flag_main = 1; - cb_flag_main = 1; - no_physical_cancel = 1; - break; - - case 'j': - /* -j : Run job; compile, link and go, either by ./ or cobcrun */ - /* allows optional arguments, passed to program */ - cobc_flag_run = 1; - if (cobc_run_args) { - cobc_free (cobc_run_args); - } - if (cob_optarg) { - cobc_run_args = cobc_strdup (cob_optarg); - } - break; - - case 'F': - /* --free */ - cb_source_format = CB_FORMAT_FREE; - break; - - case 'f': - /* --fixed */ - cb_source_format = CB_FORMAT_FIXED; - break; - - case 'q': - /* --brief : reduced reporting */ - case '#': - /* --### : verbose output of commands, but don't execute them */ - case 'v': - /* --verbose : Verbose reporting */ - /* these options were processed in the first getopt-run */ - break; - - case 'o': - /* -o : Output file */ - osize = strlen (cob_optarg); - if (osize > COB_SMALL_MAX) { - cobc_err_exit (_("invalid output file name")); - } - if (output_name) { - cobc_main_free (output_name); - cobc_main_free (output_name_buff); - } - output_name = cobc_main_strdup (cob_optarg); - /* Allocate buffer plus extension reserve */ - output_name_buff = cobc_main_malloc (osize + 32U); - break; - - case '0': - /* -O0 : disable optimizations (or at least minimize them) */ - cob_optimize = 0; - strip_output = 0; - cb_constant_folding = 0; - copt = CB_COPT_0; - break; - - case 'O': - /* -O : Optimize */ - cob_optimize = 1; - copt = CB_COPT_1; - break; - - case '2': - /* -O2 : Optimize */ - cob_optimize = 1; - strip_output = 1; - copt = CB_COPT_2; - break; - - case '3': - /* -O3 : Optimize */ - cob_optimize = 1; - strip_output = 1; - copt = CB_COPT_3; - break; - - case 's': - /* -Os : Optimize */ - cob_optimize = 1; - strip_output = 1; - copt = CB_COPT_S; - break; - - case 'g': - /* -g : Generate C debug code */ - save_all_src = 1; - gflag_set = 1; - cb_flag_stack_check = 1; - cb_flag_source_location = 1; - cb_flag_remove_unreachable = 0; - break; - - case 'G': - /* -G : Generate C debug code for use with gdb on COBOL source */ - gflag_set = 1; - cb_cob_line_num = 1; - cb_flag_remove_unreachable = 0; - break; - - case '$': - /* -std= : Specify dialect */ - case '&': - /* -conf= : Specify dialect configuration file */ - /* These options were all processed in the first getopt-run */ - break; - - case '%': - /* -f= : Override configuration entry */ - /* hint: -f[no-] sets the var directly */ - /* including options -freserved=word / -fregister=word */ - conf_label = cobc_main_malloc (COB_MINI_BUFF); - conf_entry = cobc_malloc (COB_MINI_BUFF - 2); - snprintf (conf_label, COB_MINI_MAX, "-%s=%s", - long_options[idx].name, cob_optarg); - strncpy(conf_entry, conf_label + 2, COB_MINI_MAX - 2); - conf_ret |= cb_config_entry (conf_entry, conf_label, 0); - cobc_free (conf_entry); - break; - - case 'd': - /* -debug : Turn on all runtime checks */ - cb_flag_source_location = 1; - cb_flag_stack_check = 1; - cobc_wants_debug = 1; - break; - - case '_': - /* --save-temps : Save intermediary files */ - save_temps = 1; - if (cob_optarg) { - struct stat st; - if (save_temps_dir) { - cobc_free (save_temps_dir); - save_temps_dir = NULL; - } - if (stat (cob_optarg, &st) != 0 || - !(S_ISDIR (st.st_mode))) { - cobc_err_msg (_("warning: '%s' is not a directory, defaulting to current directory"), - cob_optarg); - } else { - save_temps_dir = cobc_strdup (cob_optarg); - } - } - break; - - case 'T': - /* -T : Generate wide listing */ - cb_listing_wide = 1; - /* fall through */ - case 't': - /* -t : Generate listing */ - if (cb_listing_outputfile) { - cobc_main_free (cb_listing_outputfile); - } - /* FIXME: add option to place each source in a single listing - by specifying a directory (similar to -P) */ - cb_listing_outputfile = cobc_main_strdup (cob_optarg); - break; - - case '*': - /* --tlines=nn : Lines per page */ - cb_lines_per_page = atoi (cob_optarg); - if (cb_lines_per_page - && cb_lines_per_page < 20) { - cobc_err_msg (_("warning: %d lines per listing page specified, using %d"), - cb_lines_per_page, 20); - cb_lines_per_page = 20; - } - break; - - case 'P': - /* -P : Generate preproc listing */ - if (cob_optarg) { - struct stat st; - if (cobc_list_dir) { - cobc_free (cobc_list_dir); - cobc_list_dir = NULL; - } - if (cobc_list_file) { - cobc_free (cobc_list_file); - cobc_list_file = NULL; - } - if (!stat (cob_optarg, &st) && S_ISDIR (st.st_mode)) { - cobc_list_dir = cobc_strdup (cob_optarg); - } else { - cobc_list_file = cobc_strdup (cob_optarg); - } - } - if (!cobc_gen_listing) { - cobc_gen_listing = 1; - } - break; - - case 'X': -#ifndef COB_INTERNAL_XREF - /* -Xref : Generate listing through 'cobxref' */ - cobc_gen_listing = 2; - /* temporary: check if we run the testsuite and skip - the run if we don't have the internal xref */ - if (getenv ("COB_IS_RUNNING_IN_TESTMODE")) { - cobc_early_exit (77); - } -#else - /* -Xref : Generate internal listing */ - cb_listing_xref = 1; -#endif - break; - - case 'D': - /* -D xx(=yy) : Define variables */ - if (strlen (cob_optarg) > 64U) { - cobc_err_exit (COBC_INV_PAR, "-D"); - } - if (!strcasecmp (cob_optarg, "ebug")) { - cobc_err_msg (_("warning: assuming '%s' is a DEFINE - did you intend to use -debug?"), - cob_optarg); - } - p = cb_define_list_add (cb_define_list, cob_optarg); - if (!p) { - cobc_err_exit (COBC_INV_PAR, "-D"); - } - cb_define_list = p; - break; - - case 'I': - /* -I : Include/copy directory */ - if (strlen (cob_optarg) > COB_SMALL_MAX) { - cobc_err_exit (COBC_INV_PAR, "-I"); - } - { - struct stat st; - if (stat (cob_optarg, &st) != 0 - || !(S_ISDIR (st.st_mode))) { - break; - } - } -#ifdef _MSC_VER - COBC_ADD_STR (cobc_include, " /I \"", cob_optarg, "\""); -#elif defined (__WATCOMC__) - COBC_ADD_STR (cobc_include, " -i\"", cob_optarg, "\""); -#else - COBC_ADD_STR (cobc_include, " -I\"", cob_optarg, "\""); -#endif - CB_TEXT_LIST_ADD (cb_include_list, cob_optarg); - break; - - case 'L': - /* -L : Directory for library search */ - if (strlen (cob_optarg) > COB_SMALL_MAX) { - cobc_err_exit (COBC_INV_PAR, "-L"); - } - { - struct stat st; - if (stat (cob_optarg, &st) != 0 - || !(S_ISDIR (st.st_mode))) { - break; - } - } -#ifdef _MSC_VER - COBC_ADD_STR (cobc_lib_paths, " /LIBPATH:\"", cob_optarg, "\""); -#else - COBC_ADD_STR (cobc_lib_paths, " -L\"", cob_optarg, "\""); -#endif - break; - - case 'l': - /* -l : Add library to link phase */ - if (strlen (cob_optarg) > COB_SMALL_MAX) { - cobc_err_exit (COBC_INV_PAR, "-l"); - } -#ifdef _MSC_VER - extension = file_extension (cob_optarg); - /* note: strcasecmp because of possible different specified extension */ - if (!strcasecmp (extension, "lib")) { - COBC_ADD_STR (cobc_libs, " \"", cob_optarg, "\""); - } else { - COBC_ADD_STR (cobc_libs, " \"", cob_optarg, ".lib\""); - } -#else - COBC_ADD_STR (cobc_libs, " -l\"", cob_optarg, "\""); -#endif - break; - - case 'e': - /* -e : Add an extension suffix */ - if (strlen (cob_optarg) > 15U) { - cobc_err_exit (COBC_INV_PAR, "--ext"); - } - snprintf (ext, (size_t)COB_MINI_MAX, ".%s", cob_optarg); - CB_TEXT_LIST_ADD (cb_extension_list, ext); - break; - - case 'K': - /* -K : Define literal CALL to xx as static */ - if (strlen (cob_optarg) > 32U) { - cobc_err_exit (COBC_INV_PAR, "-K"); - } - CB_TEXT_LIST_ADD (cb_static_call_list, cob_optarg); - break; - - case 'k': - /* -k : Check for exit after CALL to xx */ - /* This is to cater for legacy German DIN standard */ - /* Check after CALL if an exit program required */ - /* Not in --help as subject to change and highly specific */ - if (strlen (cob_optarg) > 32U) { - cobc_err_exit (COBC_INV_PAR, "-k"); - } - CB_TEXT_LIST_ADD (cb_early_exit_list, cob_optarg); - break; - - case 1: - /* -fstack-size= : Specify stack (perform) size */ - n = cobc_deciph_optarg (cob_optarg, 0); - if (n < 16 || n > 512) { - cobc_err_exit (COBC_INV_PAR, "-fstack-size"); - } - cb_stack_size = n; - break; - - case 3: - /* -fsign= : Specify display sign */ - if (!strcasecmp (cob_optarg, "EBCDIC")) { - cb_ebcdic_sign = 1; - } else if (!strcasecmp (cob_optarg, "ASCII")) { - cb_ebcdic_sign = 0; - } else { - cobc_err_exit (COBC_INV_PAR, "-fsign"); - } - break; - - case 4: - /* -ffold-copy= : COPY fold case */ - if (!strcasecmp (cob_optarg, "UPPER")) { - cb_fold_copy = COB_FOLD_UPPER; - } else if (!strcasecmp (cob_optarg, "LOWER")) { - cb_fold_copy = COB_FOLD_LOWER; - } else { - cobc_err_exit (COBC_INV_PAR, "-ffold-copy"); - } - break; - - case 5: - /* -ffold-call= : CALL/PROG-ID fold case */ - if (!strcasecmp (cob_optarg, "UPPER")) { - cb_fold_call = COB_FOLD_UPPER; - } else if (!strcasecmp (cob_optarg, "LOWER")) { - cb_fold_call = COB_FOLD_LOWER; - } else { - cobc_err_exit (COBC_INV_PAR, "-ffold-call"); - } - break; - - case 6: - /* -fdefaultbyte= : Default initialization byte */ - n = cobc_deciph_optarg (cob_optarg, 1); - if (n < 0 || n > 255) { - cobc_err_exit (COBC_INV_PAR, "-fdefaultbyte"); - } - cb_default_byte = n; - break; - - case 7: - /* -fmax-errors= : maximum errors until abort */ - n = cobc_deciph_optarg (cob_optarg, 0); - if (n < 0) { - cobc_err_exit (COBC_INV_PAR, "-fmax-errors"); - } - cb_max_errors = n; - break; - - case 8: - cobc_def_dump_opts (cob_optarg); - break; - - case 9: - /* -fcallfh= : function for EXTFH */ - cb_call_extfh = cobc_main_strdup (cob_optarg); - break; - - case 10: - /* -fintrinsics= : Intrinsic name or ALL */ - cobc_deciph_funcs (cob_optarg); - break; - - case 11: - /* -fsqldb= : Database type for XFD */ - cb_sqldb_name = cobc_main_strdup (cob_optarg); - break; - - case 12: - /* -fsqlschema= : Database schema name for XFD */ - cb_sqldb_schema = cobc_main_strdup (cob_optarg); - if (cob_schema_dir != NULL) { - char temp_buff[COB_MEDIUM_BUFF]; - strcpy(temp_buff,cob_schema_dir); - cobc_main_free ((void*)cob_schema_dir); - cob_schema_dir = cobc_main_malloc (strlen(temp_buff) + strlen(cb_sqldb_schema) + 8); - sprintf((void*)cob_schema_dir,"%s%s%s",temp_buff,SLASH_STR,cb_sqldb_schema); - } else { - cob_schema_dir = cobc_main_malloc (strlen(COB_SCHEMA_DIR) + strlen(cb_sqldb_schema) + 8); - sprintf((void*)cob_schema_dir,"%s%s%s",COB_SCHEMA_DIR,SLASH_STR,cb_sqldb_schema); - } -#ifdef _WIN32 /* simon: come back to this later... */ - _mkdir (cob_schema_dir); - _chmod (cob_schema_dir, _S_IREAD | _S_IWRITE); -#else - mkdir (cob_schema_dir, 0777); - chmod (cob_schema_dir, 0777); -#endif - break; - - case 'A': - /* -A : Add options to C compile phase */ - COBC_ADD_STR (cobc_cflags, " ", cob_optarg, NULL); - aflag_set = 1; - break; - - case 'Q': - /* -Q : Add options to C link phase */ - COBC_ADD_STR (cobc_ldflags, " ", cob_optarg, NULL); - break; - - case 'w': - /* -w : Turn off all warnings (disables -W/-Wall if passed later) */ -#define CB_WARNDEF(var,name,doc) var = COBC_WARN_DISABLED; -#define CB_ONWARNDEF(var,name,doc) var = COBC_WARN_DISABLED; -#define CB_NOWARNDEF(var,name,doc) var = COBC_WARN_DISABLED; -#define CB_ERRWARNDEF(var,name,doc) var = COBC_WARN_ENABLED; -#include "warning.def" -#undef CB_WARNDEF -#undef CB_ONWARNDEF -#undef CB_NOWARNDEF -#undef CB_ERRWARNDEF - break; - - case 'W': - /* -Wall : Turn on most warnings */ -#define CB_WARNDEF(var,name,doc) var = COBC_WARN_ENABLED; -#define CB_ONWARNDEF(var,name,doc) -#define CB_NOWARNDEF(var,name,doc) -#define CB_ERRWARNDEF(var,name,doc) var = COBC_WARN_AS_ERROR; -#include "warning.def" -#undef CB_WARNDEF -#undef CB_ONWARNDEF -#undef CB_NOWARNDEF -#undef CB_ERRWARNDEF - break; - - case 'Y': - /* -W : Turn on every warning */ -#define CB_WARNDEF(var,name,doc) var = COBC_WARN_ENABLED; -#define CB_ONWARNDEF(var,name,doc) -#define CB_NOWARNDEF(var,name,doc) var = COBC_WARN_ENABLED; -#define CB_ERRWARNDEF(var,name,doc) var = COBC_WARN_AS_ERROR; -#include "warning.def" -#undef CB_WARNDEF -#undef CB_ONWARNDEF -#undef CB_NOWARNDEF -#undef CB_ERRWARNDEF - break; - - case 'Z': - /* -Werror[=warning] : Treat all/single warnings as errors */ - if (cob_optarg) { -#define CB_CHECK_WARNING(var,name) \ - if (strcmp (cob_optarg, name) == 0) { \ - var = COBC_WARN_AS_ERROR; \ - } else -#define CB_WARNDEF(var,name,doc) CB_CHECK_WARNING(var, name) -#define CB_ONWARNDEF(var,name,doc) CB_CHECK_WARNING(var, name) -#define CB_NOWARNDEF(var,name,doc) CB_CHECK_WARNING(var, name) -#define CB_ERRWARNDEF(var,name,doc) CB_CHECK_WARNING(var, name) -#include "warning.def" -#undef CB_CHECK_WARNING -#undef CB_WARNDEF -#undef CB_ONWARNDEF -#undef CB_NOWARNDEF -#undef CB_ERRWARNDEF - /* note: ends block from last CB_CHECK_WARNING */ - /* else */ if (verbose_output) { - cobc_err_msg (_("unknown warning option '%s'"), - cob_optarg); - } - } else { - error_all_warnings = 1; - } - break; - - /* LCOV_EXCL_START */ - default: - cobc_err_msg ("missing evaluation of command line option '%c'", c); /* not translated as unlikely */ - COBC_ABORT (); - /* LCOV_EXCL_STOP */ - - } - } - - /* Load reserved words from fixed word-list if specified */ - if (cb_reserved_words != NULL) { - cb_load_words(); - } - - /* Exit for configuration errors resulting from -f[=] */ - if (conf_ret != 0) { - cobc_early_exit (1); - } - - /* handling of list options */ - if (list_reserved) { - /* includes register list */ - cb_list_reserved (); - } else if (list_registers) { - cb_list_registers (); - } - if (list_intrinsics) { - cb_list_intrinsics (); - } - if (list_system_names) { - cb_list_system_names (); - } - if (list_system_routines) { - cb_list_system_routines (); - } - - /* Exit if list options were specified */ - if (exit_option) { - cobc_early_exit (0); - } - - /* Exit on missing options */ -#ifdef COB_INTERNAL_XREF - if (cb_listing_xref && !cb_listing_outputfile) { - cobc_err_exit (_("%s option requires a listing file"), "-Xref"); - } -#endif - - if (output_name && strcmp (output_name, COB_DASH) == 0) { - cb_src_list_file = stdout; - if (cb_compile_level != CB_LEVEL_PREPROCESS) { - cobc_err_exit (_("output to stdout only valid for preprocess")); - } - cobc_main_free (output_name); - cobc_main_free (output_name_buff); - } - - /* Set relaxed syntax configuration options if requested */ - /* part 1: relaxed syntax compiler configuration option */ - if (cb_relaxed_syntax_checks) { - if (cb_reference_out_of_declaratives > CB_WARNING) { - cb_reference_out_of_declaratives = CB_WARNING; - } - if (cb_missing_statement > CB_WARNING) { - cb_missing_statement = CB_WARNING; - } - /* FIXME - the warning was only raised if not relaxed */ - cb_warn_ignored_initial_val = 0; - } -#if 0 /* deactivated as -frelaxed-syntax-checks and other compiler configurations - are available at command line - maybe re-add with another name */ - /* 2: relaxed syntax group option from command line */ - if (cb_flag_relaxed_syntax_group) { - cb_relaxed_syntax_checks = 1; - cb_larger_redefines_ok = 1; - cb_relax_level_hierarchy = 1; - cb_top_level_occurs_clause = CB_OK; - } -#endif - - /* Set active warnings to errors, if requested */ - if (error_all_warnings) { -#define CB_CHECK_WARNING(var) \ - if (var == COBC_WARN_ENABLED) { \ - var = COBC_WARN_AS_ERROR; \ - } -#define CB_WARNDEF(var,name,doc) CB_CHECK_WARNING(var) -#define CB_ONWARNDEF(var,name,doc) CB_CHECK_WARNING(var) -#define CB_NOWARNDEF(var,name,doc) CB_CHECK_WARNING(var) -#define CB_ERRWARNDEF(var,name,doc) CB_CHECK_WARNING(var) -#include "warning.def" -#undef CB_CHECK_WARNING -#undef CB_WARNDEF -#undef CB_ONWARNDEF -#undef CB_NOWARNDEF -#undef CB_ERRWARNDEF - } - - if (cb_flag_odoslide) { - cb_complex_odo = 1; - } - - if (fatal_errors_flag) { - cb_max_errors = 0; - } - - /* Set postponed options */ - if (copt != NULL) { - COBC_ADD_STR (cobc_cflags, copt, NULL, NULL); - } - - /* Set implied options */ - if (cb_title_statement <= CB_OBSOLETE - && cb_listing_statements > CB_OBSOLETE) { - cb_listing_statements = cb_title_statement; - } - if (cb_flag_notrunc) { - cb_binary_truncate = 0; - cb_pretty_display = 0; - } - if (cb_flag_traceall) { - cb_flag_trace = 1; - cb_flag_source_location = 1; - } - if (cb_flag_c_line_directives) { - save_all_src = 1; - } -#ifndef _MSC_VER - if (gflag_set) { -#ifndef __ORANGEC__ - COBC_ADD_STR (cobc_cflags, " -g", NULL, NULL); -#else - COBC_ADD_STR (cobc_cflags, " +v", NULL, NULL); -#endif - } -#endif - - /* debug: Turn on all exception conditions */ - if (cobc_wants_debug) { - for (i = (enum cob_exception_id)1; i < COB_EC_MAX; ++i) { - CB_EXCEPTION_ENABLE (i) = 1; - } - if (verbose_output > 1) { - fputs (_("all runtime checks are enabled"), stderr); - fputc ('\n', stderr); - } - } - - /* If C debug, do not strip output */ - if (gflag_set) { - strip_output = 0; - } - - /* set compile_level from output file if not set already */ - if (cb_compile_level == 0 - && output_name != NULL) { - set_compile_level_from_file_extension (output_name); - } - - /* note: this is a "legacy" option, not a flag - - better use the two separate dialect flags */ - if (cb_mf_ibm_comp == 0) { /* NO-IBMCOMP */ - cb_binary_size = CB_BINARY_SIZE_1__8; - cb_synchronized_clause = CB_IGNORE; - } else if (cb_mf_ibm_comp == 1) { /* IBMCOMP */ - cb_binary_size = CB_BINARY_SIZE_2_4_8; - cb_synchronized_clause = CB_OK; - cb_align_record = 8; - cb_align_opt = 1; - } - - return cob_optind; -} - -/* Restore the order in list of programs */ -static void -restore_program_list_order (void) -{ - struct cb_program *last; - - /* ensure that this function is only processed once - as we must call it from multiple places */ - if (cb_correct_program_order) { - return; - } - cb_correct_program_order = 1; - - last = NULL; - for (; current_program; current_program = current_program->next_program_ordered) { - current_program->next_program_ordered = current_program->next_program; - current_program->next_program = last; - last = current_program; - } - current_program = last; -} - -static void -process_env_copy_path (const char *p) -{ - char *value; - char *token; - struct stat st; - - if (p == NULL || !*p || *p == ' ') { - return; - } - - /* Clone value for destructive strtok */ - value = cobc_strdup (p); - - /* Tokenize for path sep. */ - token = strtok (value, PATHSEP_STR); - while (token) { - if (!stat (token, &st) && (S_ISDIR (st.st_mode))) { - CB_TEXT_LIST_CHK (cb_include_list, token); - } - token = strtok (NULL, PATHSEP_STR); - } - - cobc_free (value); - return; -} - -/* process setup for a single filename, - returns a (struct filename *) if the file - is to be processed, otherwise NULL */ -static struct filename * -process_filename (const char *filename) -{ - const char *extension; - struct filename *fn; - struct filename *ffn; - char *fbasename; - char *listptr; - size_t fsize; - int file_is_stdin; -#ifdef HAVE_8DOT3_FILENAMES - char *buffer; -#endif -#ifdef __OS400__ - char *full_path; -#endif - - if (strcmp (filename, COB_DASH) == 0) { - if (cobc_seen_stdin == 0) { - cobc_seen_stdin = 1; - file_is_stdin = 1; - filename = COB_DASH_NAME; - } else { - cobc_err_msg (_("only one stdin input allowed")); - return NULL; - } - } else { - file_is_stdin = 0; - } - - fsize = strlen (filename); - /* LCOV_EXCL_START */ - if (fsize > COB_NORMAL_MAX) { - cobc_err_msg (_("invalid file name parameter (length > %d)"), COB_NORMAL_MAX); - return NULL; - } - /* LCOV_EXCL_STOP */ - -#ifdef __OS400__ - if (strchr (filename, '.') != NULL) { -#endif - - if (!file_is_stdin && access (filename, R_OK) != 0) { - cobc_terminate (filename); - } - -#ifdef __OS400__ - } -#endif - - fbasename = file_basename (filename, NULL); - extension = file_extension (filename); - /* set source file for possible error message */ - cb_source_file = filename; - /* note: strcasecmp because of possible compilation on FAT/NTFS */ - if (strcasecmp (extension, "lib") - && strcasecmp (extension, "a") - && strcasecmp (extension, COB_OBJECT_EXT)) { - if (cobc_check_valid_name (fbasename, FILE_BASE_NAME)) { - return NULL; - } - } - fn = cobc_main_malloc (sizeof (struct filename)); - fn->need_preprocess = 1; - fn->need_translate = 1; - fn->need_assemble = 1; - fn->file_is_stdin = file_is_stdin; - fn->next = NULL; - - if (!file_list) { - file_list = fn; - } else { - for (ffn = file_list; ffn->next; ffn = ffn->next) - ; - ffn->next = fn; - } - - fn->demangle_source = cb_encode_program_id (fbasename, 0, cb_fold_call); - - /* Check input file type */ - if (strcasecmp (extension, "i") == 0) { - /* Already preprocessed */ - fn->need_preprocess = 0; - } else if (strcasecmp (extension, "c") == 0 -#if defined(_WIN32) - || strcasecmp (extension, "asm") == 0 -#endif - || strcasecmp (extension, "s") == 0) { - /* Already compiled */ - fn->need_preprocess = 0; - fn->need_translate = 0; - } else if ( -#if defined(__OS400__) - extension[0] == 0 -#else - strcasecmp (extension, COB_OBJECT_EXT) == 0 -#if defined(_WIN32) - || strcasecmp (extension, "lib") == 0 -#endif -#if !defined(_WIN32) || defined(__MINGW32__) || defined(__MINGW64__) - || strcasecmp (extension, "a") == 0 - || strcasecmp (extension, "so") == 0 - || strcasecmp (extension, "dylib") == 0 - || strcasecmp (extension, "sl") == 0 -#endif -#endif - ) { - /* Already assembled */ - fn->need_preprocess = 0; - fn->need_translate = 0; - fn->need_assemble = 0; - } - - /* Set source filename */ - fn->source = cobc_main_strdup (filename); - - /* Set preprocess filename */ - if (!fn->need_preprocess) { - fn->preprocess = cobc_main_strdup (fn->source); - } else if (output_name && cb_compile_level == CB_LEVEL_PREPROCESS) { - fn->preprocess = cobc_main_strdup (output_name); - } else if (save_all_src || save_temps || - cb_compile_level == CB_LEVEL_PREPROCESS) { - fn->preprocess = cobc_main_stradd_dup (fbasename, ".i"); - } else { - fn->preprocess = cobc_main_malloc (COB_FILE_MAX); - cob_temp_name ((char *)fn->preprocess, ".cob"); - } - - /* Set translate filename */ - if (!fn->need_translate) { - fn->translate = cobc_main_strdup (fn->source); - } else if (output_name && cb_compile_level == CB_LEVEL_TRANSLATE) { - fn->translate = cobc_main_strdup (output_name); - } else if (save_all_src || save_temps || save_c_src || - cb_compile_level == CB_LEVEL_TRANSLATE) { - fn->translate = cobc_main_stradd_dup (fbasename, ".c"); - } else { - fn->translate = cobc_main_malloc (COB_FILE_MAX); - cob_temp_name ((char *)fn->translate, ".c"); - } -#ifdef __OS400__ - /* adjustment of fn->translate, seems to need a full path - for later command line for cc; note - while it is unlikely that - cob_temp_name isn't starting with "/" it is still possible */ - if (fn->translate[0] != '/') { - full_path = cobc_main_malloc (COB_LARGE_BUFF); - getcwd (full_path, COB_LARGE_BUFF); - strcat (full_path, "/"); - strcat (full_path, fn->translate); - cobc_main_free (fn->translate); - fn->translate = full_path; - } -#endif - fn->translate_len = strlen (fn->translate); - - /* Set storage filename */ - if (fn->need_translate) { -#ifndef HAVE_8DOT3_FILENAMES - fn->trstorage = cobc_main_stradd_dup (fn->translate, ".h"); -#else - /* for 8.3 filenames use no ".c" prefix */ - buffer = cobc_strdup (fn->translate); - *(buffer + strlen (buffer) - 1) = 'h'; - fn->trstorage = buffer; -#endif - } - - /* Set object filename */ - if (!fn->need_assemble) { - fn->object = cobc_main_strdup (fn->source); - } else if (output_name && cb_compile_level == CB_LEVEL_ASSEMBLE) { - fn->object = cobc_main_strdup (output_name); - } else if (save_temps || cb_compile_level == CB_LEVEL_ASSEMBLE) { - fn->object = cobc_main_stradd_dup (fbasename, "." COB_OBJECT_EXT); - } else if (cb_compile_level != CB_LEVEL_MODULE) { - /* note: CB_LEVEL_MODULE is compiled without an intermediate object file */ - fn->object = cobc_main_malloc (COB_FILE_MAX); - cob_temp_name ((char *)fn->object, "." COB_OBJECT_EXT); - } - if (fn->object) { - fn->object_len = strlen (fn->object); - cobc_objects_len += fn->object_len + 8U; - } else { - fn->object_len = 0; - } - - /* Set listing filename */ - if (cobc_gen_listing == 1) { - if (cobc_list_file) { - fn->listing_file = cobc_list_file; - } else if (cobc_list_dir) { - fsize = strlen (cobc_list_dir) + strlen (fbasename) + 8U; - listptr = cobc_main_malloc (fsize); - snprintf (listptr, fsize, "%s%c%s.lst", - cobc_list_dir, SLASH_CHAR, fbasename); - fn->listing_file = listptr; - } else { - fn->listing_file = cobc_main_stradd_dup (fbasename, ".lst"); - } -#ifndef COB_INTERNAL_XREF - /* LCOV_EXCL_START */ - } else if (cobc_gen_listing == 2) { - fn->listing_file = cobc_main_stradd_dup (fbasename, ".xrf"); - /* LCOV_EXCL_STOP */ -#endif - } - - cob_incr_temp_iteration(); - return fn; -} - -#ifdef _MSC_VER -/* - * search_pattern can contain one or more search strings separated by '|' - * search_patterns must have a final '|' - */ -static int -line_contains (char* line_start, char* line_end, char* search_patterns) -{ - int pattern_end, pattern_start, pattern_length, full_length; - char* line_pos; - - if (search_patterns == NULL) return 0; - - pattern_start = 0; - full_length = (int)strlen (search_patterns) - 1; - for (pattern_end = 0; pattern_end < (int)strlen (search_patterns); pattern_end++) { - if (search_patterns[pattern_end] == PATTERN_DELIM) { - pattern_length = pattern_end - pattern_start; - for (line_pos = line_start; line_pos + pattern_length <= line_end; line_pos++) { - /* Find matching substring */ - if (memcmp (line_pos, search_patterns + pattern_start, pattern_length) == 0) { - /* Exit if all patterns found, skip to next pattern otherwise */ - if (pattern_start + pattern_length == full_length) { - return 1; - } else { - break; - } - } - } - pattern_start = pattern_end + 1; - } - } - - return 0; -} -#endif - -/** -j run job after build */ -static int -process_run (const char *name) -{ - int ret, status; - size_t curr_size; - const char *buffer; - - if (cb_compile_level < CB_LEVEL_MODULE) { - fputs (_("nothing for -j to run"), stderr); - fflush (stderr); - return 0; - } - - if (output_name) { - name = output_name; - /* ensure enough space (output name) */ - cobc_chk_buff_size (strlen (output_name) + 18); - } else { - name = file_basename (name, NULL); - } - - if (cb_compile_level == CB_LEVEL_MODULE || - cb_compile_level == CB_LEVEL_LIBRARY) { - curr_size = snprintf (cobc_buffer, cobc_buffer_size, "cobcrun%s %s", - COB_EXE_EXT, name); - /* strip period + COB_MODULE_EXT if specified */ - if (output_name && curr_size < cobc_buffer_size) { - buffer = file_extension (output_name); - if (!strcasecmp (buffer, COB_MODULE_EXT)) { - *(cobc_buffer + curr_size - strlen (buffer) - 1) = 0; - } - } - } else { /* executable */ - /* only add COB_EXE_EXT if it is not specified */ - buffer = file_extension (name); - /* only prefix with ./ if there is no directory portion in name */ - if (strchr (name, SLASH_CHAR) == NULL) { - if (COB_EXE_EXT[0] && strcasecmp (buffer, COB_EXE_EXT + 1)) { - curr_size = snprintf (cobc_buffer, cobc_buffer_size, ".%c%s%s", - SLASH_CHAR, name, COB_EXE_EXT); - } else { - curr_size = snprintf (cobc_buffer, cobc_buffer_size, ".%c%s", - SLASH_CHAR, name); - } - } else { - if (COB_EXE_EXT[0] && strcasecmp (buffer, COB_EXE_EXT + 1)) { - curr_size = snprintf (cobc_buffer, cobc_buffer_size, "%s%s", - name, COB_EXE_EXT); - } else { - curr_size = snprintf (cobc_buffer, cobc_buffer_size, "%s", - name); - } - } - } -#ifdef _WIN32 /* "fix" given output name */ - if (output_name) { - char *ptr; - for (ptr = cobc_buffer; *ptr; ptr++) { - if (*ptr == '/') *ptr = '\\'; - } - } -#endif - if (cobc_run_args) { - cobc_chk_buff_size (curr_size + 1 + strlen (cobc_run_args)); - strncat (cobc_buffer, " ", cobc_buffer_size); - strncat (cobc_buffer, cobc_run_args, cobc_buffer_size); - } - if (verbose_output) { - cobc_cmd_print (cobc_buffer); - } - if (verbose_output < 0) { - return 0; - } - status = system (cobc_buffer); -#ifdef WEXITSTATUS - if (WIFEXITED(status)) { - ret = WEXITSTATUS(status); - } else { - ret = status; - } -#else - ret = status; -#endif - if (verbose_output) { - fputs (_("return status:"), stderr); - fprintf (stderr, "\t%d\n", ret); - fflush (stderr); - } - return ret; -} - -#ifdef __OS400__ -static int -process (char *cmd) -{ - char *buffptr; - char *name = NULL; - char *objname = NULL; - char *cobjname = NULL; - char *token; - char *incl[100]; - char *defs[100]; - char *objs[100]; - char *libs[100]; - char *optc[100]; - char *optl[100]; - int nincl = 0; - int ndefs = 0; - int nobjs = 0; - int nlibs = 0; - int noptc = 0; - int noptl = 0; - int dbg = 0; - int comp_only = 0; - int shared = 0; - int optimize = 0; - int i; - int len; - int ret; - - if (verbose_output) { - cobc_cmd_print (cmd); - } - if (gflag_set) { - dbg = 1; - } - token = strtok (cmd, " "); - if (token != NULL) { - /* Skip C compiler */ - token = strtok (NULL, " "); - } - for (; token; token = strtok (NULL, " ")) { - if (*token != '-') { - len = strlen (token); - if (*token == '"') { - len -= 2; - ++token; - token[len] = 0; - } - if (token[len-2] == '.' && token[len - 1] == 'c') { - /* C source */ - name = token; - continue; - } - /* Assuming module */ - objs[nobjs++] = token; - continue; - } - ++token; - switch (*token) { - case 'c': - comp_only = 1; - break; - case 'I': - ++token; - if (*token == 0) { - token = strtok (NULL, " "); - } - if (*token == '"') { - ++token; - token[strlen (token) - 1] = 0; - } - incl[nincl++] = token; - break; - case 'D': - ++token; - if (*token == 0) { - token = strtok (NULL, " "); - } - if (*token == '"') { - ++token; - token[strlen (token) - 1] = 0; - } - defs[ndefs++] = token; - break; - case 'A': - ++token; - optc[noptc++] = token; - break; - case 'Q': - ++token; - optl[noptl++] = token; - break; - case 'o': - ++token; - if (*token == 0) { - token = strtok (NULL, " "); - } - if (*token == '"') { - ++token; - token[strlen (token) - 1] = 0; - } - objname = token; - break; - case 'l': - ++token; - if (*token == 0) { - token = strtok (NULL, " "); - } - libs[nlibs++] = token; - break; - case 'G': - shared = 1; - break; - case 'g': - dbg = 1; - break; - case 'O': - optimize = 1; - break; - default: - /* rare issue only on OS400 where translation - may not even work - untranslated */ - cobc_err_msg ("unknown option ignored:\t%s", - token - 1); - } - } - - buffptr = cobc_malloc (COB_LARGE_BUFF); - if (name != NULL) { - /* Requires compilation */ - if (objname == NULL) { - cobjname = file_basename (name, NULL); - } else { - cobjname = objname; - } - sprintf (buffptr, "CRTCMOD MODULE(%s) SRCSTMF('%s') ", - cobjname, name); - if (nincl > 0) { - strcat (buffptr, "INCDIR("); - for (i = 0; i < nincl; ++i) { - if (i != 0) { - strcat (buffptr, " "); - } - strcat (buffptr, "'"); - strcat (buffptr, incl[i]); - strcat (buffptr, "' "); - } - strcat (buffptr, ") "); - } - if (ndefs > 0) { - strcat (buffptr, "DEFINE("); - for (i = 0; i < ndefs; ++i) { - if (i != 0) { - strcat (buffptr, " "); - } - strcat (buffptr, "'"); - strcat (buffptr, defs[i]); - strcat (buffptr, "' "); - } - strcat (buffptr, ") "); - } - strcat (buffptr, "SYSIFCOPT(*IFSIO)"); - for (i = 0; i < noptc; ++i) { - strcat (buffptr, " "); - strcat (buffptr, optc[i]); - } - if (optimize) { - strcat (buffptr, " OPTIMIZE(40)"); - } - if (dbg) { - strcat (buffptr, " DBGVIEW(*ALL)"); - } - if (cobc_gen_listing) { - strcat (buffptr, " OUTPUT(*PRINT)"); - } - if (verbose_output) { - cobc_cmd_print (buffptr); - } - if (verbose_output >= 0) { - ret = system (buffptr); - if (verbose_output) { - fputs (_("return status:"), stderr); - fprintf (stderr, "\t%d\n", ret); - fflush (stderr); - } - } else { - ret = 0; - } - if (comp_only || ret != 0) { - cobc_free (buffptr); - return ret; - } - } - if (objname == NULL) { - if (name != NULL) { - objname = cobjname; - } else if (nobjs > 0) { - objname = objs[0]; - } else { - objname = (char *)"AOUT"; - } - } - if (shared) { - sprintf (buffptr, "CRTSRVPGM SRVPGM(%s) MODULE(", objname); - } else { - sprintf (buffptr, "CRTPGM PGM(%s) MODULE(", objname); - } - if (name != NULL) { - strcat (buffptr, cobjname); - } - for (i = 0; i < nobjs; ++i) { - if (i != 0 || name != NULL) { - strcat (buffptr, " "); - } - strcat (buffptr, objs[i]); - } - strcat (buffptr, ")"); - if (nlibs > 0) { - strcat (buffptr, " BNDSRVPGM("); - for (i = 0; i < nlibs; ++i) { - if (i != 0) { - strcat (buffptr, " "); - } - strcat (buffptr, libs[i]); - } - strcat (buffptr, ")"); - } - for (i = 0; i < noptl; ++i) { - strcat (buffptr, " "); - strcat (buffptr, optl[i]); - } - if (shared) { - strcat (buffptr, " EXPORT(*ALL)"); - } - if (verbose_output) { - cobc_cmd_print (buffptr); - } - if (verbose_output >= 0) { - ret = system (buffptr); - if (verbose_output) { - fputs (_("return status:"), stderr); - fprintf (stderr, "\t%d\n", ret); - fflush (stderr); - } - } else { - ret = 0; - } - cobc_free (buffptr); - return ret; -} - -#elif defined(_MSC_VER) -#ifndef HAVE_POPEN -#error HAVE_POPEN is missing in config.h -#endif -static int -process (const char *cmd) -{ - int ret; - - if (verbose_output) { - cobc_cmd_print (cmd); - } - if (verbose_output < 0) { - return 0; - } - ret = system (cmd); - if (verbose_output) { - fputs (_("return status:"), stderr); - fprintf (stderr, "\t%d\n", ret); - fflush (stderr); - } - return !!ret; -} - -static int -process_filtered (const char *cmd, struct filename *fn) -{ - FILE* pipe; - char* read_buffer; - char *line_start, *line_end; - char* search_pattern, *search_pattern2 = NULL; - char* output_name_temp; - int i; - int ret; - - if (verbose_output) { - cobc_cmd_print (cmd); - } - if (verbose_output < 0) { - return 0; - } - - /* Open pipe to catch output of cl.exe */ - pipe = popen (cmd, "r"); - - if (!pipe) { - return 1; /* checkme */ - } - - /* building search_patterns */ - if (output_name) { - if (cobc_flag_main) { - output_name_temp = file_basename (output_name, COB_EXE_EXT); - } else if (cb_compile_level == CB_LEVEL_ASSEMBLE) { - output_name_temp = file_basename (output_name, "." COB_OBJECT_EXT); - } else { - output_name_temp = file_basename (output_name, "." COB_MODULE_EXT); - } - } else { - /* demangle_source is encoded and cannot be used - -> set to file.something and strip at period */ - output_name_temp = file_basename (cobc_strdup (fn->source), NULL); - } - - /* check for last path separator as we only need the file name */ - for (i = fn->translate_len; i > 0; i--) { - if (fn->translate[i - 1] == '\\' || fn->translate[i - 1] == '/') break; - } - - search_pattern = (char*)cobc_malloc ((fn->translate_len - i + 2) + 1); - sprintf (search_pattern, "%s\n%c", fn->translate + i, PATTERN_DELIM); - if (cb_compile_level > CB_LEVEL_ASSEMBLE) { - search_pattern2 = (char*)cobc_malloc (2 * (strlen (output_name_temp) + 5) + 1); - sprintf (search_pattern2, "%s.lib%c%s.exp%c", output_name_temp, PATTERN_DELIM, - output_name_temp, PATTERN_DELIM); - } - - /* prepare buffer and read from pipe */ - read_buffer = (char*) cobc_malloc (COB_FILE_BUFF); - line_start = fgets (read_buffer, COB_FILE_BUFF - 1, pipe); - - while (line_start != NULL) { - /* read one line from buffer, returning line end position */ - line_end = line_start + strlen (line_start); - - /* if non of the patterns was found, print line */ - if (line_start == line_end - || (!line_contains (line_start, line_end, search_pattern) - && !line_contains (line_start, line_end, search_pattern2))) - { - fprintf (stdout, "%*s", (int)(line_end - line_start + 2), line_start); - } - line_start = fgets (read_buffer, COB_FILE_BUFF - 1, pipe); - } - fflush (stdout); - - cobc_free (read_buffer); - cobc_free (search_pattern); - if (search_pattern2) { - cobc_free (search_pattern2); - } - - /* close pipe and get return code of cl.exe */ - ret = !!_pclose (pipe); - - if (verbose_output) { - fputs (_("return status:"), stderr); - fprintf (stderr, "\t%d\n", ret); - fflush (stderr); - } - return ret; -} - -#else -static int -process (const char *cmd) -{ - char *p; - char *buffptr; - size_t clen; - int ret; - - if (likely(strchr (cmd, '$') == NULL)) { - buffptr = (char *)cmd; - } else { - clen = strlen (cmd) + 64U; - clen = clen + 6U; - buffptr = (char *)cobc_malloc (clen); - p = buffptr; - /* Quote '$' */ - for (; *cmd; ++cmd) { - if (*cmd == '$') { - p += sprintf (p, "\\$"); - } else { - *p++ = *cmd; - } - } - *p = 0; - } - - if (verbose_output) { - cobc_cmd_print (buffptr); - } - - ret = system (buffptr); - - if (unlikely(buffptr != cmd)) { - cobc_free (buffptr); - } - -#ifdef WIFSIGNALED - if (WIFSIGNALED(ret)) { -#ifdef SIGINT - if (WTERMSIG(ret) == SIGINT) { - cob_raise (SIGINT); - } -#endif -#ifdef SIGQUIT - if (WTERMSIG(ret) == SIGQUIT) { - cob_raise (SIGQUIT); - } -#endif - } -#endif - if (verbose_output) { - fputs (_("return status:"), stderr); - fprintf (stderr, "\t%d\n", ret); - fflush (stderr); - } - return !!ret; -} -#endif - -static COB_INLINE COB_A_INLINE void -force_new_page_for_next_line (void) -{ - cb_listing_linecount = cb_lines_per_page; -} - -/* Preprocess source */ - -static int -preprocess (struct filename *fn) -{ - const char *sourcename; - int save_source_format; - int save_fold_copy; - int save_fold_call; -#ifndef COB_INTERNAL_XREF -#ifdef _WIN32 - const char *envname = "%PATH%"; -#else - const char *envname = "$PATH"; -#endif - int ret; -#endif - - if (output_name || cb_compile_level > CB_LEVEL_PREPROCESS) { - if (cb_unix_lf) { - ppout = fopen(fn->preprocess, "wb"); - } else { - ppout = fopen(fn->preprocess, "w"); - } - if (!ppout) { - cobc_terminate (fn->preprocess); - } - } else { - ppout = stdout; - } - - if (fn->file_is_stdin) { - sourcename = COB_DASH; - } else { - sourcename = fn->source; - } - if (ppopen (sourcename, NULL) != 0) { - cobc_terminate (sourcename); - } - - if (verbose_output) { - fputs (_("preprocessing:"), stderr); - fprintf (stderr, "\t%s -> %s\n", - sourcename, fn->preprocess); - fflush (stderr); - } - - if (cobc_gen_listing && !cobc_list_file) { - if (cb_unix_lf) { - cb_listing_file = fopen (fn->listing_file, "wb"); - } else { - cb_listing_file = fopen (fn->listing_file, "w"); - } - if (!cb_listing_file) { - cobc_terminate (fn->listing_file); - } - } - - /* Reset pplex/ppparse variables */ - plex_clear_vars (); - ppparse_clear_vars (cb_define_list); - - /* Save default flags in case program directives change them */ - save_source_format = cb_source_format; - save_fold_copy = cb_fold_copy; - save_fold_call = cb_fold_call; - - /* Preprocess */ - ppparse (); - - /* Restore default flags */ - cb_source_format = save_source_format; - cb_fold_copy = save_fold_copy; - cb_fold_call = save_fold_call; - - if (ppin) { - fclose (ppin); - ppin = NULL; - } - - if (ppout) { - if (unlikely (fclose (ppout) != 0)) { - cobc_terminate (fn->preprocess); - } - ppout = NULL; - } - - /* Release flex buffers - After file close */ - plex_call_destroy (); - - if (cobc_gen_listing && !cobc_list_file) { - if (unlikely (fclose (cb_listing_file) != 0)) { - cobc_terminate (fn->listing_file); - } -#ifndef COB_INTERNAL_XREF - /* LCOV_EXCL_START */ - /* external cross-reference with cobxref */ - if (cobc_gen_listing == 2) { - if (cb_src_list_file) { - fclose (cb_src_list_file); - } - - snprintf (cobc_buffer, cobc_buffer_size, - "cobxref %s -R", fn->listing_file); - cobc_buffer[cobc_buffer_size] = 0; - if (verbose_output) { - cobc_cmd_print (cobc_buffer); - } - ret = system (cobc_buffer); - if (verbose_output) { - fputs (_("return status:"), stderr); - fprintf (stderr, "\t%d\n", ret); - fflush (stderr); - } - if (ret) { - fputs (_("'cobxref' execution unsuccessful"), - stderr); - putc ('\n', stderr); - fprintf (stderr, _("check that 'cobxref' is in %s"), envname); - putc ('\n', stderr); - fputs (_("no listing produced"), - stderr); - putc ('\n', stderr); - fflush (stderr); - } - if (cb_listing_outputfile) { - if (strcmp (cb_listing_outputfile, COB_DASH) == 0) { - cb_src_list_file = stdout; - } else { - if (cb_unix_lf) { - cb_src_list_file = fopen (cb_listing_outputfile, "ab"); - } else { - cb_src_list_file = fopen (cb_listing_outputfile, "a"); - } - if (!cb_src_list_file) { - cobc_terminate (cb_listing_outputfile); - } - } - cb_listing_eject = 1; - force_new_page_for_next_line (); - } - unlink (fn->listing_file); - } - /* LCOV_EXCL_STOP */ -#endif - cb_listing_file = NULL; - } - - if (verbose_output) { - fputs (_("return status:"), stderr); - fprintf (stderr, "\t%d\n", errorcount); - fflush (stderr); - } - return !!errorcount; -} - -/* Routines to generate program listing */ - - -static void -set_listing_header_code (void) -{ - strcpy (cb_listing_header, "LINE "); - if (cb_listing_file_struct->source_format != CB_FORMAT_FREE) { - strcat (cb_listing_header, - "PG/LN A...B..............................." - "............................."); - if (cb_listing_wide) { - if (cb_listing_file_struct->source_format == CB_FORMAT_FIXED - && cb_text_column == 72 && cb_indicator_column == 7) { - strcat (cb_listing_header, "SEQUENCE"); - } else { - strcat (cb_listing_header, - "........................................"); - } - } - } else { - if (cb_listing_wide) { - strcat (cb_listing_header, - "................................"); - } - strcat (cb_listing_header, - ".....................SOURCE..................." - ".........................."); - if (cb_listing_wide) { - strcat (cb_listing_header, "........"); - } - } -} - -static void -set_listing_header_symbols (void) -{ - strcpy (cb_listing_header, - "SIZE TYPE LVL NAME PICTURE"); -} - -#ifdef COB_INTERNAL_XREF -/* listing header for internal xref */ -static void -set_listing_header_xref (const enum xref_type type) -{ - if (!cb_listing_with_header) { - return; - } - if (type == XREF_FUNCTION) { - strcpy (cb_listing_header, "FUNCTION"); - } else if (type == XREF_LABEL) { - strcpy (cb_listing_header, "LABEL "); - } else { - strcpy (cb_listing_header, "NAME "); - } - if (type == XREF_FUNCTION) { - strcat (cb_listing_header, - " TYPE "); - } else { - strcat (cb_listing_header, - " DEFINED "); - } - if (cb_listing_wide) { - strcat (cb_listing_header, " "); - } - strcat (cb_listing_header, "REFERENCES"); -} -#endif - -/* listing header empty */ -static void -set_listing_header_none (void) -{ - cb_listing_header[0] = 0; -} - -/* standard title for listing - (TODO: option to set by directive and/or command line option) */ -static void -set_standard_title (void) -{ - char version[30]; - snprintf (version, sizeof (version), "%s.%d", PACKAGE_VERSION, PATCH_LEVEL); - snprintf (cb_listing_title, 80, "%s %s", - PACKAGE_NAME, - version); -} - -/* print header */ -static void -print_program_header (void) -{ - const char *format_str; - - cb_listing_linecount = 1; - - /* header for print listing (with page breaks) */ - if (cb_lines_per_page != 0) { - if (cb_listing_eject) { - fputs ("\f", cb_src_list_file); - } else { - cb_listing_eject = 1; - } - if (!cb_listing_with_header) { - fputc ('\n', cb_src_list_file); - return; - } - if (cb_listing_wide) { - format_str = "%-23.23s %-61.61s %s Page %04d\n"; - } else { - format_str = "%-23.23s %-20.20s %s Page %04d\n"; - } - fprintf (cb_src_list_file, - format_str, - cb_listing_title, - cb_listing_filename, - cb_listing_date, - ++cb_listing_page); - - /* header for listing without page breaks: --tlines=0 */ - } else { - if (!cb_listing_with_header) { - fputc ('\n', cb_src_list_file); - return; - } - - if (cb_listing_page == 0) { - cb_listing_page = 1; - if (cb_listing_wide) { - format_str = "%-28.28s %-66.66s %s\n"; - } else { - format_str = "%-28.28s %-26.26s %s\n"; - } - fprintf (cb_src_list_file, - format_str, - cb_listing_title, - cb_listing_filename, - cb_listing_date); - } - } - fputc ('\n', cb_src_list_file); - - /* print second header if set */ - if (cb_listing_header[0]) { - print_program_data (cb_listing_header); - print_program_data (""); - } -} - -static void -print_program_data (const char *data) -{ - /* no check for header if page break is disabled and not forced */ - if (cb_lines_per_page != 0 || cb_listing_linecount == 0) { - /* increase listing line number and print header if necessary */ - if (++cb_listing_linecount >= cb_lines_per_page) { - /* empty string - don't print anything */ - if (!data[0]) { - return; - } - print_program_header (); - } - } - - /* print data + newline */ - fprintf (cb_src_list_file, "%s\n", data); -} - -static char * -check_filler_name (char *name) -{ - if (strlen (name) >= 6 && memcmp (name, "FILLER", 6) == 0) { - name = (char *)"FILLER"; - } - return name; -} - -static int -set_picture (struct cb_field *field, char *picture, size_t picture_len) -{ - size_t usage_len; - char picture_usage[CB_LIST_PICSIZE]; - - memset (picture, 0, CB_LIST_PICSIZE); - - /* Check non-picture information first */ - switch (field->usage) { - case CB_USAGE_INDEX: - case CB_USAGE_LENGTH: - case CB_USAGE_OBJECT: - case CB_USAGE_POINTER: - case CB_USAGE_PROGRAM_POINTER: - case CB_USAGE_LONG_DOUBLE: - case CB_USAGE_FP_BIN32: - case CB_USAGE_FP_BIN64: - case CB_USAGE_FP_BIN128: - case CB_USAGE_FP_DEC64: - case CB_USAGE_FP_DEC128: - case CB_USAGE_SIGNED_CHAR: - case CB_USAGE_SIGNED_SHORT: - case CB_USAGE_SIGNED_INT: - case CB_USAGE_SIGNED_LONG: - case CB_USAGE_UNSIGNED_CHAR: - case CB_USAGE_UNSIGNED_SHORT: - case CB_USAGE_UNSIGNED_INT: - case CB_USAGE_UNSIGNED_LONG: - case CB_USAGE_CONTROL: - return 0; - default: - break; - } - - /* check for invalid picture next */ - if (field->pic && !field->pic->orig) { - strcpy (picture, "INVALID"); - return 1; - } - - /* Get usage for this picture */ - strcpy (picture_usage, cb_get_usage_string (field->usage)); - usage_len = strlen (picture_usage); - - /* set picture for the rest */ - if (field->usage == CB_USAGE_BINARY - || field->usage == CB_USAGE_FLOAT - || field->usage == CB_USAGE_DOUBLE - || field->usage == CB_USAGE_PACKED - || field->usage == CB_USAGE_COMP_5 - || field->usage == CB_USAGE_COMP_6 - || field->usage == CB_USAGE_COMP_X - || field->usage == CB_USAGE_COMP_N) { - if (field->pic) { - strncpy (picture, field->pic->orig, picture_len - 1 - usage_len); - picture[CB_LIST_PICSIZE - 1] = 0; - strcat (picture, " "); - } - } else if (field->flag_any_numeric) { - strncpy (picture, "9 ANY NUMERIC", 14); - return 1; - } else if (field->flag_any_length) { - strncpy (picture, "X ANY LENGTH", 13); - return 1; - } else { - if (!field->pic) { - return 0; - } - strncpy (picture, field->pic->orig, picture_len - 1); - return 1; - } - - strcat (picture, picture_usage); - return 1; -} - -static void -set_category_from_usage (int usage, char *type) -{ - switch (usage) { - case CB_USAGE_INDEX: - strcpy (type, "INDEX"); - break; - case CB_USAGE_POINTER: - case CB_USAGE_PROGRAM_POINTER: - strcpy (type, "POINTER"); - break; - case CB_USAGE_DISPLAY: - strcpy (type, "ALPHANUMERIC"); - break; - case CB_USAGE_NATIONAL: - strcpy (type, "NATIONAL"); - break; - case CB_USAGE_BIT: - strcpy (type, "BOOLEAN"); - break; - default: - strcpy (type, "NUMERIC"); - break; - } -} - -static void -set_category (int category, int usage, char *type) -{ - switch (category) { - case CB_CATEGORY_UNKNOWN: - set_category_from_usage (usage, type); - break; - case CB_CATEGORY_ALPHABETIC: - strcpy (type, "ALPHABETIC"); - break; - case CB_CATEGORY_ALPHANUMERIC: - case CB_CATEGORY_ALPHANUMERIC_EDITED: - strcpy (type, "ALPHANUMERIC"); - break; - case CB_CATEGORY_BOOLEAN: - strcpy (type, "BOOLEAN"); - break; - case CB_CATEGORY_INDEX: - strcpy (type, "INDEX"); - break; - case CB_CATEGORY_NATIONAL: - case CB_CATEGORY_NATIONAL_EDITED: - strcpy (type, "NATIONAL"); - break; - case CB_CATEGORY_NUMERIC: - case CB_CATEGORY_NUMERIC_EDITED: - case CB_CATEGORY_FLOATING_EDITED: - strcpy (type, "NUMERIC"); - break; - case CB_CATEGORY_OBJECT_REFERENCE: - strcpy (type, "OBJECT REF"); - break; - case CB_CATEGORY_DATA_POINTER: - case CB_CATEGORY_PROGRAM_POINTER: - strcpy (type, "POINTER"); - break; - default: - strcpy (type, "UNKNOWN"); /* LCOV_EXCL_LINE */ - } -} - -/* terminate string at first trailing space and return its length */ -static int -terminate_str_at_first_trailing_space (char * const str) -{ - int i; - - for (i = strlen (str) - 1; i && isspace ((unsigned char)str[i]); i--) { - str[i] = '\0'; - } - return i; -} - -static void -print_88_values (struct cb_field *field) -{ - struct cb_field *f; - char lcl_name[LCL_NAME_LEN] = { '\0' }; - - for (f = field->validation; f; f = f->sister) { - strncpy (lcl_name, (char *)f->name, LCL_NAME_MAX); - snprintf (print_data, CB_PRINT_LEN, - " %-14.14s %02d %s", - "CONDITIONAL", f->level, lcl_name); - print_program_data (print_data); - } -} - -/* print all fields including sister and child elements */ -static void -print_fields (struct cb_field *top, int *found) -{ - int first = 1; - int get_cat; - int got_picture; - int old_level = 0; - size_t picture_len = cb_listing_wide ? 64 : 24; - char type[20]; - char picture[CB_LIST_PICSIZE]; - char lcl_name[LCL_NAME_LEN]; - - for (; top; top = top->sister) { - if (!top->level) { - continue; - } - if (*found == 0) { - *found = 1; - /* MAYBE use a second header line and a forced page break instead */ - snprintf (print_data, CB_PRINT_LEN, - " %s", enum_explain_storage(top->storage)); - print_program_data (print_data); - print_program_data (""); - } - - strncpy (lcl_name, check_filler_name ((char *)top->name), - LCL_NAME_MAX); - get_cat = 1; - got_picture = 1; - - if (top->children) { - strcpy (type, "GROUP"); - get_cat = 0; - got_picture = 0; - if (top->level == 01 && !first) { - print_program_data (""); - } - } else if (top->level == 01) { - if (!first) { - print_program_data (""); - } - } else if (top->level == 77 && !first - && old_level != 77) { - print_program_data (""); - } - - if (get_cat) { - set_category (top->common.category, top->usage, type); - if (top->flag_any_length) { - picture[0] = 0; - } - got_picture = set_picture (top, picture, picture_len); - } - - if (top->flag_any_length || top->flag_unbounded) { - pd_off = sprintf (print_data, "????? "); - } else if (top->flag_occurs && !got_picture) { - pd_off = sprintf (print_data, "%05d ", top->size * top->occurs_max); - } else { - pd_off = sprintf (print_data, "%05d ", top->size); - } - pd_off += sprintf (print_data + pd_off, "%-14.14s %02d ", type, top->level); - if (top->flag_occurs && got_picture) { - pd_off += sprintf (print_data + pd_off, "%-30.30s %s, ", lcl_name, picture); - } else if (got_picture) { - pd_off += sprintf (print_data + pd_off, "%-30.30s %s", lcl_name, picture); - } else if (top->flag_occurs) { - pd_off += sprintf (print_data + pd_off, "%-30.30s ", lcl_name); - } else { /* Trailing spaces break testsuite AT_DATA */ - pd_off += sprintf (print_data + pd_off, "%s", lcl_name); - } - if (top->flag_occurs) { - if (top->depending && top->flag_unbounded) { - pd_off += sprintf (print_data + pd_off, "OCCURS %d TO UNBOUNDED", top->occurs_min); - } else if (top->depending) { - pd_off += sprintf (print_data + pd_off, "OCCURS %d TO %d", top->occurs_min, top->occurs_max); - } else { - pd_off += sprintf (print_data + pd_off, "OCCURS %d", top->occurs_max); - } - } - if (top->redefines && !top->file) { - pd_off += sprintf (print_data + pd_off, ", REDEFINES %s", top->redefines->name); - } - print_program_data (print_data); - - first = 0; - old_level = top->level; - print_88_values (top); - - if (top->children) { - print_fields (top->children, found); - } - } -} - -static void -print_files_and_their_records (cb_tree file_list_p) -{ - cb_tree l; - int dummy = 1; - - for (l = file_list_p; l; l = CB_CHAIN (l)) { - snprintf (print_data, CB_PRINT_LEN, - "%05d %-14.14s %s", - CB_FILE (CB_VALUE (l))->record_max, - "FILE", - CB_FILE (CB_VALUE (l))->name); - print_program_data (print_data); - if (CB_FILE (CB_VALUE (l))->record) { - print_fields (CB_FILE (CB_VALUE (l))->record, &dummy); - print_program_data (""); - } - } -} - -static int -print_fields_in_section (struct cb_field *first_field_in_section) -{ - int found = 0; - if (first_field_in_section != NULL) { - print_fields (first_field_in_section, &found); - if (found) { - print_program_data (""); - } - } - return found; -} - -/* create xref_elem with line number for existing xref entry */ -void -cobc_xref_link (struct cb_xref *list, const int line, const int receiving) -{ -#ifdef COB_INTERNAL_XREF - struct cb_xref_elem *elem; - - for (elem = list->head; elem; elem = elem->next) { - if (elem->line == line) { - if (receiving) { - elem->receive = 1; - } - return; - } - } - - elem = cobc_parse_malloc (sizeof (struct cb_xref_elem)); - elem->line = line; - elem->receive = receiving; - - /* add xref_elem to head/tail - remark: if head == NULL, then tail may contain reference to child's - head marking it as "referenced by child" - we don't want to preserve - this information but overwrite it with the actual reference */ - if (list->head == NULL) { - list->head = elem; - } else if (list->tail != NULL) { - list->tail->next = elem; - } - list->tail = elem; -#else - COB_UNUSED (list); - COB_UNUSED (line); - COB_UNUSED (receiving); -#endif -} - -/* set "referenced by child" (including lvl 88 validation) for field's parents */ -void -cobc_xref_link_parent (const struct cb_field *field) -{ -#ifdef COB_INTERNAL_XREF - struct cb_field *f; - const struct cb_xref *f_xref = &field->xref; - struct cb_xref *p_xref; - - for (f = field->parent; f; f = f->parent) { - /* parent has own reference already -> exit */ - p_xref = &f->xref; - if (p_xref->head != NULL) { - return; - } - p_xref->tail = f_xref->tail; - } -#else - COB_UNUSED (field); -#endif -} - -/* add a "receiving" entry for a given field reference */ -void -cobc_xref_set_receiving (const cb_tree target_ext) -{ -#ifdef COB_INTERNAL_XREF - cb_tree target = target_ext; - struct cb_field *target_fld; - int xref_line; - - if (CB_CAST_P (target)) { - target = CB_CAST (target)->val; - } - if (CB_REF_OR_FIELD_P (target)) { - target_fld = CB_FIELD_PTR (target); - } else { - return; - } - if (CB_REFERENCE_P (target)) { - xref_line = CB_REFERENCE (target)->common.source_line; - } else if (current_statement) { - xref_line = current_statement->common.source_line; - } else { - xref_line = cb_source_line; - } - cobc_xref_link (&target_fld->xref, xref_line, 1); -#else - COB_UNUSED (target_ext); -#endif -} - -void -cobc_xref_call (const char *name, const int line, const int is_ident, const int is_sys) -{ -#ifdef COB_INTERNAL_XREF - struct cb_call_elem *elem; - - for (elem = current_program->call_xref.head; elem; elem = elem->next) { - if (!strcmp (name, elem->name)) { - cobc_xref_link (&elem->xref, line, 0); - return; - } - } - - elem = cobc_parse_malloc (sizeof (struct cb_call_elem)); - elem->name = cobc_parse_strdup (name); - elem->is_identifier = is_ident; - elem->is_system = is_sys; - cobc_xref_link (&elem->xref, line, 0); - - if (current_program->call_xref.head == NULL) { - current_program->call_xref.head = elem; - } else if (current_program->call_xref.tail != NULL) { - current_program->call_xref.tail->next = elem; - } - current_program->call_xref.tail = elem; -#else - COB_UNUSED (name); - COB_UNUSED (line); - COB_UNUSED (is_ident); -#endif -} - -#ifdef COB_INTERNAL_XREF -static void -xref_print (struct cb_xref *xref, const enum xref_type type, struct cb_xref *xref_parent) -{ - struct cb_xref_elem *elem; - int cnt; - int maxcnt = cb_listing_wide ? 10 : 5; - - if (xref->head == NULL) { - sprintf (print_data + pd_off, " "); - if (type == XREF_FIELD) { - /* check if parent has any reference and use it for the current field */ - if (xref_parent && xref_parent->head) { - xref->head = xref_parent->head; - } - /* references by child only are stored in xref->tail if xref->head was NULL */ - if (xref->head && xref->tail) { - sprintf (print_data + pd_off, "referenced by parent/child"); - } else if (xref->head) { - sprintf (print_data + pd_off, "referenced by parent"); - } else if (xref->tail) { - sprintf (print_data + pd_off, "referenced by child"); - } else { - sprintf (print_data + pd_off, "not referenced"); - } - } else { - sprintf (print_data + pd_off, "not referenced"); - } - print_program_data (print_data); - return; - } - - cnt = 0; - for (elem = xref->head; elem; elem = elem->next) { - pd_off += sprintf (print_data + pd_off, " %c%-6u", - elem->receive ? '*' : ' ', elem->line); - if (++cnt >= maxcnt) { - cnt = 0; - (void)terminate_str_at_first_trailing_space (print_data); - print_program_data (print_data); - if (elem->next) { - pd_off = sprintf (print_data, "%38.38s", " "); - } - } - } - if (cnt) { - (void)terminate_str_at_first_trailing_space (print_data); - print_program_data (print_data); - } -} - -static void -xref_88_values (struct cb_field *field) -{ - struct cb_field *f; - char lcl_name[LCL_NAME_LEN] = { '\0' }; - - for (f = field->validation; f; f = f->sister) { - strncpy (lcl_name, (char *)f->name, LCL_NAME_MAX); - pd_off = sprintf (print_data, - "%-30.30s %-6u ", - lcl_name, f->common.source_line); - xref_print (&f->xref, XREF_FIELD, NULL); - - } -} - -static int -xref_fields (struct cb_field *top) -{ - char lcl_name[LCL_NAME_LEN]; - int found = 0; - - for (; top; top = top->sister) { - /* no entry for internal generated fields - other than used special indexes */ - if (!top->level || (top->index_type != CB_NORMAL_INDEX - && !top->count)) { - continue; - } - - strncpy (lcl_name, check_filler_name ((char *)top->name), LCL_NAME_MAX); - lcl_name[LCL_NAME_MAX] = 0; /* make sure we always have the trailing NULL */ - if (!strcmp (lcl_name, "FILLER") && !top->validation) { - if (top->children) { - found += xref_fields (top->children); - } - continue; - } - found = 1; - pd_off = sprintf (print_data, "%-30.30s %-6u ", - lcl_name, top->common.source_line); - - /* print xref for field */ - if (top->parent) { - xref_print (&top->xref, XREF_FIELD, &top->parent->xref); - } else { - xref_print (&top->xref, XREF_FIELD, NULL); - } - - /* print xref for all assigned 88 validation entries */ - if (top->validation) { - xref_88_values (top); - } - - /* print xref for all children */ - if (top->children) { - (void)xref_fields (top->children); - } - } - return found; -} - -static void -xref_files_and_their_records (cb_tree file_list_p) -{ - cb_tree l; - - for (l = file_list_p; l; l = CB_CHAIN (l)) { - pd_off = sprintf (print_data, "%-30.30s %-6u ", - CB_FILE (CB_VALUE (l))->name, - CB_FILE (CB_VALUE (l))->common.source_line); - xref_print (&CB_FILE (CB_VALUE (l))->xref, XREF_FILE, NULL); - if (CB_FILE (CB_VALUE (l))->record) { - (void)xref_fields (CB_FILE (CB_VALUE (l))->record); - } - print_program_data (""); - } -} - -static int -xref_fields_in_section (struct cb_field *first_field_in_section) -{ - int found = 0; - - if (first_field_in_section != NULL) { - found = !!xref_fields (first_field_in_section); - print_program_data (""); - } - return found; -} - -static int -xref_labels (cb_tree label_list_p) -{ - cb_tree l; - char label_type = ' '; - struct cb_label *lab; - - for (l = label_list_p; l; l = CB_CHAIN (l)) { - if (CB_LABEL_P(CB_VALUE(l))) { - lab = CB_LABEL (CB_VALUE (l)); - if (lab->xref.skip) { - continue; - } - if (lab->flag_entry) { - label_type = 'E'; - sprintf (print_data, "E %-28.28s %d", - lab->name, lab->common.source_line); - print_program_data (print_data); - continue; - } else if (lab->flag_section) { - label_type = 'S'; - } else { - label_type = 'P'; - } - pd_off = sprintf (print_data, "%c %-28.28s %-6u ", - label_type, lab->name, lab->common.source_line); - xref_print (&lab->xref, XREF_LABEL, NULL); - } - } - if (label_type == ' ') { - return 0; - } else { - return 1; - } -} - -static int -xref_calls (struct cb_call_xref *list) -{ - struct cb_call_elem *elem; - int gotone = 0; - - if (list->head) { - set_listing_header_xref (XREF_FUNCTION); - force_new_page_for_next_line (); - print_program_header (); - } - - for (elem = list->head; elem; elem = elem->next) { - gotone = 1; - pd_off = sprintf (print_data, "%c %-28.28s %-6.6s ", - elem->is_identifier ? 'I' : 'L', - elem->name, - elem->is_system ? "SYSTEM" : "EXTERN"); - xref_print (&elem->xref, XREF_FUNCTION, NULL); - } - return gotone; -} -#endif - -static void -print_program_trailer (void) -{ - struct cb_program *p; - struct list_error *err; - int print_names = 0; - int print_break = 1; - int found; - char err_msg[BUFSIZ]; - - if (current_program != NULL) { - - /* ensure correct order in program list */ - restore_program_list_order (); - - /* Print program in symbol table / cross-reference if more than one program */ - /* MAYBE use a second header line and a forced page break instead */ - if (current_program->next_program) { - print_names = 1; - } - - /* Print file/symbol tables if requested */ - if (cb_listing_symbols) { - if (cb_listing_with_header) { - set_listing_header_symbols (); - } - force_new_page_for_next_line (); - print_program_header (); - - for (p = current_program; p; p = p->next_program) { - if (print_names) { - sprintf (print_data, - " %-14s %s", - (p->prog_type == COB_MODULE_TYPE_FUNCTION ? - "FUNCTION" : "PROGRAM"), - p->program_name); - print_program_data (print_data); - print_program_data (""); - } - found = 0; - if (p->file_list) { - print_files_and_their_records (p->file_list); - found++; - } - found += print_fields_in_section (p->working_storage); - found += print_fields_in_section (p->local_storage); - found += print_fields_in_section (p->linkage_storage); - found += print_fields_in_section (p->screen_storage); - found += print_fields_in_section (p->report_storage); - if (!found) { - snprintf (print_data, CB_PRINT_LEN, " %s", - _("No fields defined.")); - print_program_data (print_data); - print_program_data (""); - } - } - print_break = 0; - } - -#ifdef COB_INTERNAL_XREF - /* Print internal cross reference if requested */ - if (cb_listing_xref) { - - for (p = current_program; p; p = p->next_program) { - - set_listing_header_xref (XREF_FIELD); - force_new_page_for_next_line (); - print_program_header (); - - if (print_names) { - sprintf (print_data, - "%s %s", - (p->prog_type == COB_MODULE_TYPE_FUNCTION ? - "FUNCTION" : "PROGRAM"), - p->program_name); - print_program_data (print_data); - print_program_data (""); - } - found = 0; - if (p->file_list) { - xref_files_and_their_records (p->file_list); - found++; - } - found += xref_fields_in_section (p->working_storage); - found += xref_fields_in_section (p->local_storage); - found += xref_fields_in_section (p->linkage_storage); - found += xref_fields_in_section (p->screen_storage); - found += xref_fields_in_section (p->report_storage); - if (!found) { - snprintf (print_data, CB_PRINT_LEN, " %s", - _("No fields defined.")); - print_program_data (print_data); - print_program_data (""); - } - - set_listing_header_xref (XREF_LABEL); - force_new_page_for_next_line (); - print_program_header (); - - if (print_names) { - sprintf (print_data, - "%s %s", - (p->prog_type == COB_MODULE_TYPE_FUNCTION ? - "FUNCTION" : "PROGRAM"), - p->program_name); - print_program_data (print_data); - print_program_data (""); - } - if (!xref_labels (p->exec_list)) { - snprintf (print_data, CB_PRINT_LEN, " %s", - _("No labels defined.")); - print_program_data (print_data); - print_program_data (""); - }; - - xref_calls (&p->call_xref); - } - print_break = 0; - } -#endif - } - - set_listing_header_none(); - print_program_data (""); - if (print_break) { - print_program_data (""); - } - - /* Print error/warning summary (this note may be always included later) - and/or be replaced to be the secondary title of the listing */ - if (cb_listing_error_head && cb_listing_with_messages) { - force_new_page_for_next_line (); - print_program_data (_("Error/Warning summary:")); - print_program_data (""); - } - if (cb_listing_error_head) { - if (cb_listing_with_messages) { - err = cb_listing_error_head; - do { - const char *prefix = err->prefix ? err->prefix : ""; - if (err->file) { - if (err->line > 0) { - if (cb_msg_style == CB_MSG_STYLE_MSC) { - snprintf (err_msg, BUFSIZ, "%s(%d): %s%s", - err->file, err->line, prefix, err->msg); - } else { - snprintf (err_msg, BUFSIZ, "%s:%d: %s%s", - err->file, err->line, prefix, err->msg); - } - } else { - snprintf (err_msg, BUFSIZ, "%s: %s%s", - err->file, prefix, err->msg); - } - } else { - snprintf (err_msg, BUFSIZ, "%s%s", - prefix, err->msg); - } - print_program_data (err_msg); - err = err->next; - } while (err); - print_program_data (""); - } - - free_error_list (cb_listing_error_head); - cb_listing_error_head = NULL; - cb_listing_error_tail = NULL; - } - - if (!cb_listing_with_messages) { - return; - } - - /* Print error counts */ - - switch (warningcount) { - case 0: - print_program_data (_("0 warnings in compilation group")); - break; - case 1: - /* FIXME: Change to P_, needs changes to Makevars and tests */ - print_program_data (_("1 warning in compilation group")); - break; - default: - snprintf (print_data, CB_PRINT_LEN, - _("%d warnings in compilation group"), warningcount); - print_program_data (print_data); - break; - } - switch (errorcount) { - case 0: - print_program_data (_("0 errors in compilation group")); - break; - case 1: - /* FIXME: Change to P_, needs changes to Makevars and tests */ - print_program_data (_("1 error in compilation group")); - break; - default: - snprintf (print_data, CB_PRINT_LEN, - _("%d errors in compilation group"), errorcount); - print_program_data (print_data); - break; - } - if (errorcount > cb_max_errors) { - snprintf (print_data, CB_PRINT_LEN, - _("Too many errors in compilation group: %d maximum errors"), - cb_max_errors); - print_program_data (print_data); - } - force_new_page_for_next_line (); -} - -/* - return pointer to next non-space character -*/ -static COB_INLINE COB_A_INLINE char * -get_next_nonspace (char * pos) -{ - while (*pos != '\0' && isspace ((unsigned char)*pos)) { - pos++; - } - return pos; -} - -/* - Find next token after bp, copy it to token and copy the token terminator to - term. Return pointer to the character after the terminator. -*/ -static char * -get_next_token (char *bp, char *token, char *term) -{ - char *token_start = token; - int in_string = 0; - - /* Repeat until a token is found */ - do { - bp = get_next_nonspace (bp); - - term[0] = '\0'; - term[1] = '\0'; - if (*bp == '\0') { - return NULL; - } - - /* Copy characters into token until a terminator is found. */ - while (*bp) { - /* Return character strings as a single token */ - if (*bp == '"' || *bp == '\'') { - in_string = !in_string; - *token++ = *bp++; - if (!in_string) { - if (isspace ((unsigned char)*bp) || *bp == ',' || *bp == '.' || *bp == ';') { - term[0] = *bp++; - } - break; - } - continue; - } - if (in_string) { - *token++ = *bp++; - continue; - } - if (*bp == '.' && isdigit((unsigned char)*(bp + 1))) { - ; - } else if (isspace ((unsigned char)*bp) || *bp == ',' || *bp == '.' || *bp == ';') { - term[0] = *bp++; - break; - } - *token++ = *bp++; - } - *token = '\0'; - } while (*token_start == '\0' && *term != '\0'); - - return bp; -} - -static void -terminate_str_at_first_of_char (const char c, char * const str) -{ - char *first_instance = strchr (str, c); - - if (first_instance != NULL) { - *first_instance = '\0'; - } -} - -/* - Copies the next CB_LINE_LENGTH chars from fd into out_line. If fixed is true, - out_line is padded with spaces to column CB_ENDLINE. The return value is - either the length of out_line, or -1 if the end of fd is reached. -*/ -static int -get_next_listing_line (FILE *fd, char **pline, int fixed) -{ - char *in_char, *out_line; - unsigned int i = 0; - char in_line[CB_LINE_LENGTH + 2]; - - if (*pline == NULL) { - *pline = cobc_malloc (CB_LINE_LENGTH + 2); - } - out_line = *pline; - - if (!fgets (in_line, CB_LINE_LENGTH, fd)) { - memset (out_line, 0, CB_LINE_LENGTH); - return -1; - } - - terminate_str_at_first_of_char ('\n', in_line); - terminate_str_at_first_of_char ('\r', in_line); - - for (in_char = in_line; i != CB_LINE_LENGTH && *in_char; in_char++) { - if (*in_char == '\t') { - out_line[i++] = ' '; - while (i % cb_tab_width != 0) { - out_line[i++] = ' '; - if (i == CB_LINE_LENGTH) { - break; - } - } - } else { - out_line[i++] = *in_char; - } - } - - if (fixed) { - while (i < (unsigned int)CB_ENDLINE) { - out_line[i++] = ' '; - } - } else { - out_line[i++] = ' '; - } - out_line[i] = 0; - - return i; -} - -/* - return pointer to first non-space character (ignoring sequence area) -*/ -static COB_INLINE COB_A_INLINE char * -get_first_nonspace (char *line, const enum cb_format source_format) -{ - if (source_format != CB_FORMAT_FREE) { - return get_next_nonspace (line + CB_INDICATOR + 1); - } else { - return get_next_nonspace (line); - } -} - -/* - check for compiler directive indicator and return - position of compiler instruction or NULL if not found -*/ -static char * -get_directive_start (char *line, const enum cb_format source_format) -{ - char *curr_pos; - - curr_pos = get_first_nonspace (line, source_format); - if (*curr_pos == '>' && *++curr_pos == '>') { - curr_pos = get_next_nonspace (++curr_pos); - if (*curr_pos != 0) { - return curr_pos; - } - } - return NULL; -} - -/* - check for >> LISTING directive and set on_off value -*/ -static int -line_has_listing_directive (char *line, const enum cb_format source_format, int *on_off) -{ - char *token; - - token = get_directive_start (line, source_format); - - if (token != NULL && - !strncasecmp (token, "LISTING", 7)) { - token += 7; - *on_off = 1; - token = get_next_nonspace (token); - if (!strncasecmp (token, "OFF", 3)) - *on_off = 0; - return 1; - } - return 0; -} - -/* - check for >> PAGE directive and page eject indicator -*/ -static int -line_has_page_eject (char *line, const enum cb_format source_format) -{ - char *directive_start; - - if (source_format != CB_FORMAT_FREE && line[CB_INDICATOR] == '/') { - return 1; - } else { - directive_start = get_directive_start (line, source_format); - return directive_start != NULL - && !strncasecmp (directive_start, "PAGE", 4); - } -} -/* - check for listing statements in current line and handle them -*/ -static int -line_has_listing_statement (char *line, const enum cb_format source_format) -{ - char *statement_start, *curr_pos; - int size; - - /* check if we actually want to process any listing statement */ - if (cb_listing_statements > CB_OBSOLETE) { - return 0; - } - - curr_pos = get_first_nonspace (line, source_format); - - if (curr_pos == NULL) { - return 0; - } - - statement_start = curr_pos++; - - /* extract first word with max. length of 6 */ - for (size = 1; size < 6 && curr_pos != 0; size++, curr_pos++) { - if ((*curr_pos == ' ' ) - || (*curr_pos == '.' ) - || (*curr_pos == '*' && (*(curr_pos + 1) == '>' ) )) { - break; - } - } - - /* compare word against listing statements */ - if (size != 5) { - return 0; - } - if ((strncasecmp (statement_start, "EJECT", 5)) - && (strncasecmp (statement_start, "SKIP1", 5)) - && (strncasecmp (statement_start, "SKIP2", 5)) - && (strncasecmp (statement_start, "SKIP3", 5)) - && (strncasecmp (statement_start, "TITLE", 5))) { - return 0; - } - - /* handle statements */ - if (!strncasecmp (statement_start, "TITLE", 5)) { - /* check if we actually want to process TITLE as a statement - note: the title statement is an extra listing-directive statement */ - if (cb_title_statement > CB_OBSOLETE) { - return 0; - } - - /* FIXME: the title should be handled correctly as literal */ - while (*curr_pos != 0) { - if (*++curr_pos != ' ') { - curr_pos++; /* skip start of literal */ - break; - } - } - statement_start = curr_pos; - for (size = 1; size < 80 && curr_pos != 0; size++, curr_pos++) { - if ((*curr_pos == '.' ) - || (*curr_pos == '*' && (*(curr_pos + 1) == '>' ) )) { - break; - } - } - snprintf (print_data, size, "%s", statement_start); - size = terminate_str_at_first_trailing_space (print_data); - print_data[size] = 0; - print_data[sizeof (cb_listing_title)] = 0; - strcpy (cb_listing_title, print_data); - force_new_page_for_next_line (); - } else { - if (!strncasecmp (statement_start, "EJECT", 5)) { - force_new_page_for_next_line (); - } else if (!strncasecmp (statement_start, "SKIP1", 5)) { - print_program_data ("\n"); - } else if (!strncasecmp (statement_start, "SKIP2", 5)) { - print_program_data ("\n\n"); - } else if (!strncasecmp (statement_start, "SKIP3", 5)) { - print_program_data ("\n\n\n"); - } - } - return 1; -} - -static void -print_fixed_line (const int line_num, char pch, char *line) -{ - int i; - int len = strlen (line); - const int max_chars_on_line = cb_listing_wide ? 112 : 72; - const char *format_str; - - if (line[CB_INDICATOR] == '&') { - line[CB_INDICATOR] = '-'; - pch = '+'; - } - - for (i = 0; len > 0; i += max_chars_on_line, len -= max_chars_on_line) { - if (cb_listing_wide) { - format_str = "%06d%c %-112.112s"; - } else { - format_str = "%06d%c %-72.72s"; - } - sprintf (print_data, format_str, line_num, pch, line + i); - (void)terminate_str_at_first_trailing_space (print_data); - print_program_data (print_data); - - if (cb_text_column == 72) { - break; - } - pch = '+'; - } -} - -static void -print_free_line (const int line_num, char pch, char *line) -{ - int i; - int len = strlen (line); - const int max_chars_on_line = cb_listing_wide ? 112 : 72; - const char *format_str; - - for (i = 0; len > 0; i += max_chars_on_line, len -= max_chars_on_line) { - if (cb_listing_wide) { - format_str = "%06d%c %-112.112s"; - } else { - format_str = "%06d%c %-72.72s"; - } - sprintf (print_data, format_str, line_num, pch, line + i); - (void)terminate_str_at_first_trailing_space (print_data); - print_program_data (print_data); - pch = '+'; - } -} - -static void -print_errors_for_line (const struct list_error * const first_error, - const int line_num) -{ - const struct list_error *err; - const unsigned int max_chars_on_line = cb_listing_wide ? 120 : 80; - size_t msg_off; - - for (err = first_error; err; err = err->next) { - if (err->line == line_num) { - pd_off = snprintf (print_data, max_chars_on_line, "%s%s", err->prefix, err->msg); - if (pd_off == -1) { /* snprintf returns -1 in MS and on HPUX if max is reached */ - pd_off = max_chars_on_line; - print_data[max_chars_on_line - 1] = 0; - } - if (pd_off >= max_chars_on_line) { - /* trim on last space */ - pd_off = strlen (print_data) - 1; - while (pd_off && !isspace (print_data[pd_off])) { - pd_off--; - } - print_data[pd_off] = '\0'; - print_program_data (print_data); - msg_off = strlen (err->prefix); - pd_off = strlen (print_data) - msg_off; - if (msg_off < 2) msg_off = 2; - memset (print_data, ' ', msg_off - 1); - snprintf (print_data + msg_off - 2, max_chars_on_line, "%c%s", '+', err->msg + pd_off); - } - print_program_data (print_data); - } - } -} - -static void -print_line (struct list_files *cfile, char *line, int line_num, int in_copy) -{ - struct list_skip *skip; - int do_print; - int on_off; - char pch; - - do_print = cfile->listing_on; - if (line_has_listing_directive (line, cfile->source_format, &on_off)) { - cfile->listing_on = on_off; - /* always print the directive itself */ - do_print = 1; - } else if (line_has_page_eject (line, cfile->source_format)) { - force_new_page_for_next_line (); - } else if (line_has_listing_statement (line, cfile->source_format)) { - do_print = 0; - } - - if (do_print) { - pch = in_copy ? 'C' : ' '; - for (skip = cfile->skip_head; skip; skip = skip->next) { - if (skip->skipline == line_num) { - pch = 'X'; - break; - } - } - - (void)terminate_str_at_first_trailing_space (line); - if (cfile->source_format == CB_FORMAT_FIXED) { - print_fixed_line (line_num, pch, line); - } else { /* CB_FORMAT_FREE */ - print_free_line (line_num, pch, line); - } - } - - /* Print errors regardless of LISTING setting */ - if (cfile->err_head) { - print_errors_for_line (cfile->err_head, line_num); - } -} - -/* - Copy each token in pline from the start of pline[first_idx] to the end of - pline[last_idx] into cmp_line, separated by a space. Tokens are copied from - the first_col of each line and up to the end of line or the sequence area (if - fixed is true). - Return the column to which pline[last_idx] was read up to. - - first_col is zero-indexed. -*/ -static int -compare_prepare (char *cmp_line, char *pline[CB_READ_AHEAD], - int first_idx, int last_idx, int first_col, int fixed) -{ - int i; - int out_pos = 0; - int line_idx; - int in_string = 0; - int last_col = CB_SEQUENCE; - int last_nonspace; - - cmp_line[0] = 0; - - /* Collapse pline into a string of tokens separated by spaces */ - for (line_idx = first_idx; line_idx < last_idx; line_idx++) { - if (!fixed) { - last_col = strlen (pline[line_idx]) - 1; - } - - /* Go to the last non-space character */ - for (last_nonspace = last_col; - isspace ((unsigned char)pline[line_idx][last_nonspace]) && last_nonspace > first_col; - last_nonspace--); - /* Go to first non-space character */ - for (i = first_col; (i <= last_nonspace) && isspace ((unsigned char)pline[line_idx][i]); i++); - - /* Copy chars between the first and last non-space characters */ - while (i <= last_nonspace) { - if (isspace ((unsigned char)pline[line_idx][i])) { - cmp_line[out_pos++] = ' '; - for (i++; (i <= last_nonspace) && isspace ((unsigned char)pline[line_idx][i]); i++); - if (i > last_nonspace) { - break; - } - } else if (pline[line_idx][i] == '"') { - /* - Merge multi-part strings into one string, - reading another line if necessary to find the - end. - */ - if (in_string) { - i++; - } else { - cmp_line[out_pos++] = pline[line_idx][i++]; - in_string = 1; - } - - for (; (i <= last_nonspace) && (pline[line_idx][i] != '"'); ) { - cmp_line[out_pos++] = pline[line_idx][i++]; - } - if (pline[line_idx][i] == '"') { - cmp_line[out_pos++] = pline[line_idx][i++]; - in_string = 0; - } - if (i > last_nonspace) { - break; - } - } else { - cmp_line[out_pos++] = pline[line_idx][i++]; - } - } - } - cmp_line[out_pos] = 0; -#ifdef DEBUG_REPLACE - fprintf (stdout, " last_col = %d\n cmp_line: %s\n", last_col, cmp_line); -#endif - return last_col; -} - -/* - Add adjust to each line number less than line_num (if appropriate) in cfile's - copy, replace and error lists. -*/ -static void -adjust_line_numbers (struct list_files *cfile, int line_num, int adjust) -{ - struct list_files *cur; - struct list_replace *rep; - struct list_error *err; - - for (cur = cfile->copy_head; cur; cur = cur->next) { - cur->copy_line += adjust; - } - - for (rep = cfile->replace_head; rep; rep = rep->next) { - if (rep->firstline > line_num) { - rep->firstline += adjust; - } - } - - for (err = cfile->err_head; err; err = err->next) { - err->line += adjust; - } -} - -static COB_INLINE COB_A_INLINE int -is_debug_line (char *line, int fixed) -{ - if (line == NULL || line[0] == 0) { - return 0; - } - return !cb_flag_debugging_line - && ((fixed && IS_DEBUG_LINE (line)) - || (!fixed && !strncasecmp (line, "D ", 2))); -} - -static COB_INLINE COB_A_INLINE int -is_comment_line (char *line, int fixed) -{ - if (line == NULL || line[0] == 0) { - return 0; - } - return (fixed && IS_COMMENT_LINE (line)) - || (!fixed && !strncmp (line, "*>", 2)); -} - -static int -is_continuation_line (char *line, int fixed) -{ - int i; - - if (line == NULL || line[0] == 0) { - return 0; - } - if (fixed) { - /* check for "-" in column 7 */ - if (IS_CONTINUE_LINE (line)) { - return 1; - } - } else { - /* check for "&" as last character */ - /* CHECKME: does this work with inline comments after "&"? */ - i = strlen (line) - 1; - while (i && isspace (line[i])) i--; - if (line[i] == '&') { - return 1; - } - } - - return 0; -} - -static void -abort_if_too_many_continuation_lines (int pline_cnt, const char *filename, int line_num) -{ - if (pline_cnt >= CB_READ_AHEAD) { - cobc_err_msg (_("%s: %d: Too many continuation lines"), - filename, line_num); - cobc_abort_terminate (0); - } -} - -static void -make_new_continuation_line (const char *cfile_name, char *pline[CB_READ_AHEAD], - int * const pline_cnt, int line_num) -{ - abort_if_too_many_continuation_lines (*pline_cnt + 1, cfile_name, - line_num); - if (pline[*pline_cnt + 1] == NULL) { - pline[*pline_cnt + 1] = cobc_malloc (CB_LINE_LENGTH + 2); - } - strcpy (pline[*pline_cnt + 1], pline[*pline_cnt]); - strcpy (pline[*pline_cnt], pline[*pline_cnt - 1]); - memset (&pline[*pline_cnt][CB_MARGIN_A], ' ', - CB_SEQUENCE - CB_MARGIN_A); - pline[*pline_cnt][CB_INDICATOR] = '&'; - - (*pline_cnt)++; -} - -static void -add_token_over_multiple_lines (const char *cfile_name, - char *pline[CB_READ_AHEAD], - int * const pline_cnt, - const int line_num, - const char *new_token, - const int first_col, - int new_token_len, - int * const out_line, - int * const out_col) -{ - int tok_char = 0; - -#ifdef DEBUG_REPLACE - fprintf (stdout, " new_token_len = %d\n", new_token_len); -#endif - - while (new_token_len) { - /* Copy the token one character at a time. */ - pline[*out_line][(*out_col)++] = new_token[tok_char++]; - new_token_len--; - - /* - Move to the next line when reach the end of the current one. - */ - if (*out_col == CB_SEQUENCE) { -#ifdef DEBUG_REPLACE - fprintf (stdout, " NEW pline[%2d] = %s\n", - *out_line, pline[*out_line]); -#endif - - *out_col = first_col; - (*out_line)++; - - /* - Allocate a new out_line if we are on the last - out_line. - */ - if (*out_line == *pline_cnt) { - make_new_continuation_line (cfile_name, pline, - pline_cnt, line_num); - } - } - } - - pline[*out_line][(*out_col)++] = ' '; -} - -static void -reflow_replaced_fixed_format_text (const char *cfile_name, char *pline[CB_READ_AHEAD], - int * const pline_cnt, const int line_num, - char *newline, int first_col, const int last) -{ - int first_nonspace; - char *new_line_ptr; - char *new_token; - char token_terminator[2]; - int out_col; - int out_line; - int force_next_line; - int new_token_len; - - new_token = cobc_malloc (strlen(newline) + 2); - new_line_ptr = get_next_token (newline, new_token, token_terminator); - - /* - Start adding tokens from margin B or the first non-space character. - */ - for (first_nonspace = first_col; - (first_nonspace < last) && isspace (pline[0][first_nonspace]); - first_nonspace++); - if (first_nonspace >= CB_MARGIN_B) { - first_col = CB_MARGIN_B; - } - - /* For each line, */ - for (out_line = 0; out_line < *pline_cnt; out_line++) { - force_next_line = 0; - out_col = first_col; - - /* Add as many token as possible to the current line. */ - while (new_line_ptr && !force_next_line) { - new_token_len = strlen (new_token); - if (new_token_len >= (CB_SEQUENCE - first_col)) { - /* - If the new token does not fit on this line, - reflow it onto the next line. - */ - add_token_over_multiple_lines (cfile_name, pline, pline_cnt, line_num, - new_token, first_col, new_token_len, - &out_line, &out_col); - } else if ((out_col + 2 + new_token_len) < last) { - /* - If the new token *and* its terminator fits, - copy it all onto the current line. - */ - strcpy (&pline[out_line][out_col], new_token); - out_col += strlen (new_token); - - if (token_terminator[0]) { - pline[out_line][out_col++] = token_terminator[0]; - } else { - pline[out_line][out_col++] = ' '; - } - if (token_terminator[0] == '.') { - pline[out_line][out_col++] = ' '; - } - } else { - force_next_line = 1; - make_new_continuation_line (cfile_name, pline, - pline_cnt, line_num); - continue; - } - new_line_ptr = get_next_token (new_line_ptr, new_token, token_terminator); - } - - if (out_col == first_col) { - pline[out_line][CB_INDICATOR] = ' '; - } - while (out_col < last) { - pline[out_line][out_col++] = ' '; - } - -#ifdef DEBUG_REPLACE - fprintf (stdout, " NEW pline[%2d] = %s\n", out_line, pline[out_line]); -#endif - } - cobc_free (new_token); -} - -static void -reflow_replaced_free_format_text (char *pline[CB_READ_AHEAD], - const int pline_cnt, char *newline, - const int first_col) -{ - char *new_line_ptr; - char *new_token; - char token_terminator[2]; - int i; - int j; - - new_token = cobc_malloc (strlen(newline) + 2); - new_line_ptr = get_next_token (newline, new_token, token_terminator); - - for (i = 0; i < pline_cnt; i++) { - /* - Terminate the line at null or the first non-space character. - */ - for (j = first_col; pline[i][j] && pline[i][j] == ' '; j++); - pline[i][j] = '\0'; - - /* - If the text has not been copied yet, copy it to the start of - the line. - */ - while (new_line_ptr) { - /* TO-DO: Replace with strncat? */ - strcat (pline[i], new_token); - strcat (pline[i], token_terminator); - j++; - new_line_ptr = get_next_token (new_line_ptr, new_token, - token_terminator); - } - - if (j == first_col) { - strcat (pline[i], " "); - } - } - cobc_free (new_token); -} - -static int -reflow_replaced_text (const char *cfile_name, char *pline[CB_READ_AHEAD], - int pline_cnt, int line_num, char *newline, int first_col, - int last_col, int fixed) -{ - if (fixed) { - reflow_replaced_fixed_format_text (cfile_name, pline, - &pline_cnt, line_num, - newline, first_col, - last_col); - } else { - reflow_replaced_free_format_text (pline, pline_cnt, newline, - first_col); - } - - return pline_cnt; -} - -/* TODO: Modularise! */ - -static int -print_replace_text (struct list_files *cfile, FILE *fd, - struct list_replace *rep, char *pline[CB_READ_AHEAD], - int pline_cnt, int line_num) -{ - char *rfp = rep->from; - char *from_ptr; - char *to_ptr; - char *newline; - const int fixed = (cfile->source_format == CB_FORMAT_FIXED); - int first_col = fixed ? CB_MARGIN_A : 0; - int last; - int multi_token; - int match = 0; - int eof = 0; - int submatch = 0; - int seccount = 0; - int overread = 0; - int tokmatch = 0; - int subword = 0; - size_t ttix, ttlen, from_token_len; - size_t newlinelen; - char lterm[2]; - char fterm[2]; - char ftoken[CB_LINE_LENGTH + 2]; - char tterm[2]; - char ttoken[CB_LINE_LENGTH + 2]; - char cmp_line[CB_LINE_LENGTH + 2]; - char from_line[CB_LINE_LENGTH + 2]; - - if (is_comment_line (pline[0], fixed)) { - return pline_cnt; - } - - /* Trim the string to search and replace */ - (void)terminate_str_at_first_trailing_space (rfp); - while (*rfp && isspace (*rfp)) { - rfp++; - } - multi_token = (strchr (rfp, ' ') != NULL); - -#ifdef DEBUG_REPLACE - fprintf (stdout, "print_replace_text: line_num = %d", line_num); - fprintf (stdout, ", multi_token = %s, fixed = %s\n", - multi_token ? "TRUE" : "FALSE", fixed ? "TRUE" : "FALSE"); - fprintf (stdout, " pline_cnt = %d\n", pline_cnt); - for (int i = 0; i < pline_cnt; i++) { - fprintf (stdout, " pline[%2d]: %s\n", i, pline[i]); - } - fprintf (stdout, " rep: first = %d, last = %d, lead_trail = %d\n", - rep->firstline, rep->lastline, rep->lead_trail); - fprintf (stdout, " fromlen: %d\n", strlen(rfp)); - fprintf (stdout, " from: '%80.80s'\n", rfp); - fprintf (stdout, " tolen: %d\n", strlen(rep->to)); - fprintf (stdout, " to: '%80.80s'\n", rep->to); -#endif - - newlinelen = CB_LINE_LENGTH+2; - newline = cobc_malloc (newlinelen); - - last = compare_prepare (cmp_line, pline, 0, pline_cnt, first_col, fixed); - - newline[0] = 0; - if (multi_token) { - /* - Attempt to match the source text from the beginning of each - line (continuing the match to the next line if need be). If a - match is found, output the line to newline with the match - replaced. - */ - - strcpy (from_line, rfp); - from_ptr = get_next_token (from_line, ftoken, fterm); - force_next_line: - to_ptr = get_next_token (cmp_line, ttoken, tterm); - - /* - Read tokens until the match is complete or until a match - fails. - */ - while (to_ptr && from_ptr) { - if (!strcasecmp (ttoken, ftoken)) { - /* - Mark two tokens as matched, then read next - pair. - */ - submatch = 1; - if (fterm[0] == tterm[0]) { - lterm[0] = 0; - } else { - lterm[0] = tterm[0]; - } - lterm[1] = tterm[1]; - to_ptr = get_next_token (to_ptr, ttoken, tterm); - from_ptr = get_next_token (from_ptr, ftoken, fterm); - } else { - /* Discard partial match. */ - if (seccount == 0) { - if ((strlen (newline) + strlen (ttoken) + strlen (tterm)) >= newlinelen) { - newlinelen += strlen (ttoken) + CB_LINE_LENGTH; - newline = cobc_realloc (newline, newlinelen); - } - strcat (newline, ttoken); - strcat (newline, tterm); - } - submatch = 0; - - /* Start matching from beginning of from_line again. */ - strcpy (from_line, rfp); - from_ptr = get_next_token (from_line, ftoken, fterm); - to_ptr = get_next_token (to_ptr, ttoken, tterm); - break; - } - } - if (!from_ptr && submatch) { - /* - If the match is complete, output the match's - replacement. - */ - match = 1; - if ((strlen (newline) + strlen (rep->to) + strlen (lterm)) >= newlinelen) { - newlinelen += strlen (rep->to) + CB_LINE_LENGTH; - newline = cobc_realloc (newline, newlinelen); - } - strcat (newline, rep->to); - strcat (newline, lterm); - if (to_ptr) { - if ((strlen (newline) + strlen (ttoken) + strlen (to_ptr)) >= newlinelen) { - newlinelen += strlen (ttoken) + strlen (to_ptr) + CB_LINE_LENGTH; - newline = cobc_realloc (newline, newlinelen); - } - strcat (newline, ttoken); - strcat (newline, tterm); - strcat (newline, to_ptr); - } - } else if (!to_ptr && submatch) { - /* - If we run out of chars from the original source, get - more. - */ - -#ifdef DEBUG_REPLACE - fprintf (stdout, " submatch = TRUE\n"); -#endif - if (eof) { - cobc_free (newline); - return pline_cnt; - } - - /* - Overwrite the current line if it is a comment or debug - line. - */ - if (is_comment_line (pline[pline_cnt], fixed)) { - adjust_line_numbers (cfile, line_num, -1); - overread = 1; - } - if (is_debug_line (pline[pline_cnt], fixed)) { - adjust_line_numbers (cfile, line_num, -1); - overread = 1; - } - - /* - Read lines until we find a non-comment, non-debug - line. - */ - next_rec: - if (!is_comment_line (pline[pline_cnt], fixed)) { - pline_cnt++; - } - abort_if_too_many_continuation_lines (pline_cnt, cfile->name, line_num); - if (get_next_listing_line (fd, &pline[pline_cnt], fixed) < 0) { - pline[pline_cnt][0] = 0; - eof = 1; - } - if (is_debug_line (pline[pline_cnt], fixed) - || is_comment_line (pline[pline_cnt], fixed)) { - adjust_line_numbers (cfile, line_num, -1); - goto next_rec; - } -#ifdef DEBUG_REPLACE - fprintf (stdout, " pline[%2d]: %s\n", pline_cnt - 1, - pline[pline_cnt - 1]); -#endif - line_num++; - seccount++; - if (overread) { - overread = 0; - goto next_rec; - } - last = compare_prepare (cmp_line, pline, pline_cnt - 1, pline_cnt, - first_col, fixed); - strcat (newline, " "); - goto force_next_line; - } - } else { - strcpy (from_line, rfp); - from_ptr = get_next_token (from_line, ftoken, fterm); - if (ftoken[0] == ':' || ftoken[0] == '(') { - subword = 1; - } - from_token_len = strlen (ftoken); - - /* - For each token in cmp_line, try to match it with the token in - from_line. - */ - for (to_ptr = get_next_token (cmp_line, ttoken, tterm); to_ptr; - to_ptr = get_next_token (to_ptr, ttoken, tterm)) { -#ifdef DEBUG_REPLACE - fprintf (stdout, " tterm = '%s', ttoken = '%s', ftoken = '%s'\n", - tterm, ttoken, ftoken); -#endif - ttlen = strlen (ttoken); - ttix = 0; - if (rep->lead_trail == CB_REPLACE_LEADING) { - subword = 1; - } else if (rep->lead_trail == CB_REPLACE_TRAILING) { - if (ttlen >= from_token_len) { - subword = 1; - ttix = ttlen - from_token_len; - ttlen = ttix; - } - } - if (subword) { - tokmatch = !strncasecmp (&ttoken[ttix], ftoken, from_token_len); - } else { - tokmatch = !strcasecmp (ttoken, ftoken); - } - if (tokmatch) { - if ((strlen (newline) + strlen (ttoken) + strlen (rep->to)) >= newlinelen) { - newlinelen += strlen (ttoken) + strlen (rep->to) + CB_LINE_LENGTH; - newline = cobc_realloc (newline, newlinelen); - } - if (subword) { - if (rep->lead_trail == CB_REPLACE_LEADING) { - strcat (newline, rep->to); - strcat (newline, &ttoken[from_token_len]); - } else if (rep->lead_trail == CB_REPLACE_TRAILING) { - strncat (newline, ttoken, ttlen); - strcat (newline, rep->to); - } else { - strcat (newline, rep->to); - } - } else { - strcat (newline, rep->to); - } - match = 1; - } else { - if ((strlen (newline) + strlen (ttoken) + strlen (tterm)) >= newlinelen) { - newlinelen += strlen (ttoken) + CB_LINE_LENGTH; - newline = cobc_realloc (newline, newlinelen); - } - strcat (newline, ttoken); - } - strcat (newline, tterm); - } - } - - if (match) { -#ifdef DEBUG_REPLACE - fprintf (stdout, " match = TRUE\n newline = %s\n", newline); -#endif - pline_cnt = reflow_replaced_text (cfile->name, pline, pline_cnt, - line_num, newline, first_col, - last, fixed); - } - - cobc_free (newline); - return pline_cnt; -} - -static void -remove_replace_entries_before_line (struct list_files *cfile, const int line_num) -{ - struct list_replace *rep; - - while (cfile->replace_head - && cfile->replace_head->firstline < line_num) { - rep = cfile->replace_head; - cfile->replace_head = rep->next; - - if (rep->from) { - cobc_free (rep->from); - } - if (rep->to) { - cobc_free (rep->to); - } - cobc_free (rep); - } -} - -static void -deep_copy_list_replace (struct list_replace *src, struct list_files *dst_file) -{ - struct list_replace *copy; - - copy = cobc_malloc (sizeof (struct list_replace)); - memcpy (copy, src, sizeof (struct list_replace)); - copy->next = NULL; - if (src->to) { - copy->to = cobc_strdup (src->to); - } - if (src->from) { - copy->from = cobc_strdup (src->from); - } - - if (dst_file->replace_tail) { - dst_file->replace_tail->next = copy; - } - if (!dst_file->replace_head) { - dst_file->replace_head = copy; - } - dst_file->replace_tail = copy; -} - -static void -cleanup_copybook_reference (struct list_files *cur) -{ - if (cur->name) { - cobc_free ((void *)cur->name); - } - cobc_free (cur); -} - - -/* TO-DO: Modularise! */ -/* - Applies active REPLACE statements to the source lines in pline. Returns the - number of lines after the replacement has been performed. -*/ -static int -print_replace_main (struct list_files *cfile, FILE *fd, - char *pline[CB_READ_AHEAD], int pline_cnt, int line_num) -{ - static int active_replace_stmt = 0; - char *to_ptr; - struct list_replace *rep; - struct list_files *cur; - int i; - const int fixed = (cfile->source_format == CB_FORMAT_FIXED); - const int first_col = fixed ? CB_MARGIN_A : 0; - int is_copy_line; - int is_replace_line; - int is_replace_off = 0; - char tterm[2] = { '\0' }; - char ttoken[CB_LINE_LENGTH + 2] = { '\0' }; - char cmp_line[CB_LINE_LENGTH + 2] = { '\0' }; - - if (is_comment_line (pline[0], cfile->source_format != CB_FORMAT_FREE)) { - return pline_cnt; - } - -#ifdef DEBUG_REPLACE - fprintf (stdout, "print_replace_main: line_num = %d\n", line_num); - fprintf (stdout, " pline_cnt = %d\n", pline_cnt); - for (i = 0; i < pline_cnt; i++) { - fprintf (stdout, " pline[%2d]: %s\n", i, pline[i]); - } -#endif - - compare_prepare (cmp_line, pline, 0, pline_cnt, first_col, - cfile->source_format != CB_FORMAT_FREE); - - /* Check whether we're given a COPY or REPLACE statement. */ - to_ptr = get_next_token (cmp_line, ttoken, tterm); - is_copy_line = !strcasecmp (ttoken, "COPY"); - is_replace_line = !strcasecmp (ttoken, "REPLACE"); - if (is_replace_line && to_ptr) { - to_ptr = get_next_token (to_ptr, ttoken, tterm); - is_replace_off = !strcasecmp (ttoken, "OFF"); - } - - /* - If no REPLACE is active, print nothing. If one is active, perform - replacements on the text. - */ - if (!active_replace_stmt && is_replace_line) { - if (!is_replace_off) { - active_replace_stmt = 1; -#ifdef DEBUG_REPLACE - for (i = 0, rep = cfile->replace_head; rep; i++, rep = rep->next) { - if (rep->firstline < (line_num + 10)) { - if (i == 0) - fprintf (stdout, " replace_list: \n"); - fprintf (stdout, " line[%d]: %d\n", i, rep->firstline); - fprintf (stdout, " from[%d]:%d: '%80.80s'\n", i, strlen(rep->from), rep->from); - fprintf (stdout, " to [%d]:%d: '%80.80s'\n", i, strlen(rep->to), rep->to); - } - } -#endif - } - } else if (active_replace_stmt) { - if (is_replace_line && is_replace_off) { - active_replace_stmt = 0; - remove_replace_entries_before_line (cfile, line_num); - } else if (is_copy_line) { - if (cfile->copy_head) { - /* List all lines read so far and then discard them. */ - for (i = 0; i < pline_cnt; i++) { - print_line (cfile, pline[i], line_num + i, 0); - pline[i][0] = 0; - } - - cur = cfile->copy_head; - - /* Print copybook, with REPLACE'd text. */ - if (!cur->replace_head) { - for (rep = cfile->replace_head; - rep && rep->firstline <= line_num; - rep = rep->next) { - deep_copy_list_replace (rep, cur); - } - } - print_program (cur, 1); - - /* Delete the copybook reference when done */ - cfile->copy_head = cur->next; - cleanup_copybook_reference (cur); - } - } else { - /* Print text with replacements */ - for (rep = cfile->replace_head; - rep && rep->firstline < line_num; - rep = rep->next) { - pline_cnt = print_replace_text (cfile, fd, rep, pline, - pline_cnt, line_num); - } - } - } - - return pline_cnt; -} - -static struct list_error * -list_error_reverse (struct list_error *p) -{ - struct list_error *next; - struct list_error *last; - - last = NULL; - for (; p; p = next) { - next = p->next; - p->next = last; - last = p; - } - return last; -} - -/* -Print the listing for the file in cfile, with copybooks expanded and -after text has been REPLACE'd. - -FIXME: this code doesn't check for huge replace values and will abort - when these are used - see Bug #515 -*/ -static void -print_program_code (struct list_files *cfile, int in_copy) -{ - FILE *fd = NULL; - struct list_replace *rep; - struct list_files *cur; - struct list_error *err; - int i; - int line_num = 1; - const int fixed = (cfile->source_format == CB_FORMAT_FIXED); - int eof = 0; - int pline_cnt = 0; - char *pline[CB_READ_AHEAD] = { NULL }; - int lines_read; - - cfile->listing_on = 1; - -#ifdef DEBUG_REPLACE - struct list_skip *skip; - - fprintf (stdout, "print_program_code: in_copy = %s\n", - in_copy ? "YES" : "NO"); - fprintf (stdout, " name: %s\n", cfile->name); - fprintf (stdout, " copy_line: %d\n", cfile->copy_line); - for (i = 0, cur = cfile->copy_head; cur; i++, cur = cur->next) { - if (i == 0) { - fprintf (stdout, " copy_books: \n"); - } - fprintf (stdout, " name[%d]: %s\n", i, cur->name); - fprintf (stdout, " line[%d]: %d\n", i, cur->copy_line); - } - for (i = 0, rep = cfile->replace_head; rep; i++, rep = rep->next) { - if (i == 0) { - fprintf (stdout, " replace_list: \n"); - } - fprintf (stdout, " line[%d]: %d\n", i, rep->firstline); - fprintf (stdout, " from[%d]:%d: '%80.80s'\n", i, strlen(rep->from), rep->from); - fprintf (stdout, " to [%d]:%d: '%80.80s'\n", i, strlen(rep->to), rep->to); - } - for (i = 0, err = cfile->err_head; err; i++, err = err->next) { - if (i == 0) { - fprintf (stdout, " error_list: \n"); - } - fprintf (stdout, " line[%d]: %d\n", i, err->line); - fprintf (stdout, " pref[%d]: '%s'\n", i, err->prefix); - fprintf (stdout, " msg [%d]: '%s'\n", i, err->msg); - } - for (i = 0, skip = cfile->skip_head; skip; i++, skip = skip->next) { - if (i == 0) { - fprintf (stdout, " skip_list: \n"); - } - fprintf (stdout, " line[%d]: %d\n", i, skip->skipline); - } -#endif - - if (cfile->name) { - fd = fopen (cfile->name, "r"); - } - if (fd != NULL) { - abort_if_too_many_continuation_lines (pline_cnt, cfile->name, line_num); - if (get_next_listing_line (fd, &pline[pline_cnt], fixed) >= 0) { - do { - abort_if_too_many_continuation_lines (pline_cnt, cfile->name, line_num); - if (get_next_listing_line (fd, &pline[pline_cnt + 1], fixed) < 0) { - eof = 1; - } - pline_cnt++; - lines_read = 0; - - /* Collect all adjacent continuation lines */ - if (is_continuation_line (pline[fixed ? pline_cnt : pline_cnt - 1], - cfile->source_format != CB_FORMAT_FREE)) { - continue; - } - /* handling for preprocessed directives */ - if (pline[0][0] == '#') { - /* Set line number as specified by #line directive. */ - if (!strncmp (pline[0], "#line ", 6)) { - line_num = atoi (&pline[0][6]); - /* CHECKME: read the filename if given, too */ - } - lines_read = -1; - } - - /* Perform text replacement on the lines. */ - if (!in_copy) { - pline_cnt = print_replace_main (cfile, fd, pline, pline_cnt, - line_num); - } else if (cfile->replace_head) { - rep = cfile->replace_head; - while (rep) { - pline_cnt = print_replace_text (cfile, fd, rep, pline, - pline_cnt, line_num); - rep = rep->next; - } - } - - /* Print each line except the last. */ - for (i = 0; i < pline_cnt; i++) { - if (pline[i][0]) { - if (fixed && pline[i][CB_INDICATOR] == '&') { - print_line (cfile, pline[i], line_num, in_copy); - } else { - print_line (cfile, pline[i], line_num + i, in_copy); - lines_read++; - } - } - } - - /* Output copybooks which are COPY'd at the current line */ - if (cfile->copy_head - && cfile->copy_head->copy_line == line_num) { - - cur = cfile->copy_head; - - /* Add the current text replacements to the copybook */ - for (rep = cfile->replace_head; rep && in_copy; - rep = rep->next) { - deep_copy_list_replace (rep, cur); - } - print_program (cur, 1); - - /* Delete the copybook reference when done */ - cfile->copy_head = cur->next; - cleanup_copybook_reference (cur); - } - - /* Delete all but the last line. */ - strcpy (pline[0], pline[pline_cnt]); - for (i = 1; i < pline_cnt + 1; i++) { - memset (pline[i], 0, CB_LINE_LENGTH); - } - - line_num += lines_read; - pline_cnt = 0; - if (pline[0][0] == 0) { - eof = 1; - } - } while (!eof); - } - fclose (fd); - - /* Non-existent file, print errors to listing */ - } else { - - if (cfile->err_head) { - for (err = cfile->err_head; err; err = err->next) { - snprintf (print_data, CB_PRINT_LEN, "%s%s", err->prefix, err->msg); - print_program_data (print_data); - } - } - } - - for (i = 0; i < CB_READ_AHEAD; i++) { - if (pline[i] == NULL) { - break; - } - cobc_free (pline[i]); - } -} - -/* - Print the listing for the file in cfile, with copybooks expanded and - after text has been REPLACE'd. - - This function also frees contents of cfile's copy_head and replace_head - members, then sets them to NULL. -*/ -static void -print_program (struct list_files *cfile, int in_copy) -{ - struct list_error *err; - struct list_files *cur; - - if (cfile->err_head) { - cfile->err_head = list_error_reverse (cfile->err_head); - } - - if (cb_listing_with_source) { - /* actual printing of program code, copybooks included */ - print_program_code (cfile, in_copy); - } else { - /* Internal handling for copybooks (normally done within the source listing) */ - while (cfile->copy_head) { - cur = cfile->copy_head; - print_program (cur, 1); - /* Delete the copybook reference when done */ - cfile->copy_head = cur->next; - cleanup_copybook_reference (cur); - } - } - /* Free replace data */ - if (cfile->replace_head) { - free_replace_list (cfile->replace_head); - cfile->replace_head = NULL; - } - - /* Put errors on summary list */ - while (cfile->err_head) { - err = cfile->err_head; - cfile->err_head = err->next; - if (cb_listing_error_tail) { - cb_listing_error_tail->next = err; - } - if (!cb_listing_error_head) { - cb_listing_error_head = err; - } - cb_listing_error_tail = err; - } -} - - -/* Print the listing for the current file */ -static void -print_program_listing (void) -{ - print_program (cb_listing_file_struct, 0); - - print_program_trailer (); - - /* TO-DO: Should this be here? */ - cobc_free ((void *)cb_listing_file_struct->name); - cb_listing_file_struct->name = NULL; -} - -/* Create single-element C source */ - -static int -process_translate (struct filename *fn) -{ - struct cb_program *p; - struct cb_program *r; - struct nested_list *nlp; - struct handler_struct *hstr1; - struct handler_struct *hstr2; - struct local_filename *lf; - int ret; - int i; - char *buffer; - - /* Initialize */ - cb_source_file = NULL; - cb_source_line = 0; - - /* Open the input file */ - yyin = fopen (fn->preprocess, "r"); - if (!yyin) { - cobc_terminate (fn->preprocess); - } - - if (verbose_output) { - fputs (_("parsing:"), stderr); - fprintf (stderr, "\t%s (%s)\n", fn->preprocess, fn->source); - fflush (stderr); - } - - current_program = NULL; - cb_correct_program_order = 0; - cb_source_file = fn->source; - - cb_init_constants (); - - /* Parse */ - ret = yyparse (); - - fclose (yyin); - yyin = NULL; - - /* Release flex buffers - After file close */ - ylex_call_destroy (); - - if (verbose_output) { - fputs (_("return status:"), stderr); - fprintf (stderr, "\t%d\n", ret); - fflush (stderr); - } - - if (ret) { - /* If processing raised errors set syntax-only flag to not - loose the information "no codegen occurred" */ - cb_flag_syntax_only = 1; - return 1; - } - if (cb_flag_syntax_only) { - return 0; - } - - /* Set up USE GLOBAL handlers */ - for (p = current_program; p; p = p->next_program) { - p->global_file_list = cb_list_reverse (p->global_file_list); - if (p->nested_level) { - for (r = p->next_program; r; r = r->next_program) { - if (r->nested_level >= p->nested_level) { - continue; - } - for (i = COB_OPEN_INPUT; i <= COB_OPEN_EXTEND; ++i) { - hstr1 = &p->global_handler[i]; - hstr2 = &r->global_handler[i]; - if (!hstr1->handler_label && - hstr2->handler_label && - hstr2->handler_label->flag_global) { - hstr1->handler_label = hstr2->handler_label; - hstr1->handler_prog = r; - } - } - if (!r->nested_level) { - break; - } - } - } - } - - if (verbose_output) { - fputs (_("translating:"), stderr); - fprintf (stderr, "\t%s -> %s (%s)\n", - fn->preprocess, fn->translate, fn->source); - fflush (stderr); - } - current_section = NULL; - current_paragraph = NULL; - current_statement = NULL; - cb_source_line = 0; - - /* Open the output file */ - if (cb_unix_lf) { - yyout = fopen (fn->translate, "wb"); - } else { - yyout = fopen (fn->translate, "w"); - } - if (!yyout) { - cobc_terminate (fn->translate); - } - - /* Open the common storage file */ - cb_storage_file_name = cobc_main_strdup (fn->trstorage); - if (cb_unix_lf) { - cb_storage_file = fopen (cb_storage_file_name, "wb"); - } else { - cb_storage_file = fopen (cb_storage_file_name, "w"); - } - if (!cb_storage_file) { - cobc_terminate (cb_storage_file_name); - } - /* remove possible path from header name for later codegen */ - if (strrchr (cb_storage_file_name, '/') - || strrchr (cb_storage_file_name, '\\')) { - buffer = file_basename (cb_storage_file_name, COB_BASENAME_KEEP_EXT); - memcpy ((void *) cb_storage_file_name, (void *) buffer, strlen (buffer) + 1); - } - - /* Process programs in original order */ - restore_program_list_order (); - - /* Set up local storage files */ - lf = NULL; - ret = 1; - for (p = current_program; p; p = p->next_program, ret++) { - lf = cobc_main_malloc (sizeof(struct local_filename)); - lf->local_name = cobc_main_malloc (fn->translate_len + 12U); -#ifndef HAVE_8DOT3_FILENAMES - if (p == current_program && !p->next_program) { - sprintf (lf->local_name, "%s.l.h", fn->translate); - } else { - sprintf (lf->local_name, "%s.l%d.h", fn->translate, ret); - } -#else - /* for 8.3 filenames use no ".c" prefix and only one period */ - buffer = cobc_strdup (fn->translate); - *(buffer + strlen(buffer) - 2) = 'l'; - *(buffer + strlen(buffer) - 1) = 0; - if (p == current_program && !p->next_program) { - sprintf (lf->local_name, "%s.h", buffer); - } else { - sprintf (lf->local_name, "%s%d.h", buffer, ret); - } - cobc_free (buffer); -#endif - if (cb_unix_lf) { - lf->local_fp = fopen (lf->local_name, "wb"); - } else { - lf->local_fp = fopen (lf->local_name, "w"); - } - if (!lf->local_fp) { - cobc_terminate (lf->local_name); - } - /* remove possible path from header name for later codegen */ - lf->local_include_name = cobc_main_strdup (file_basename (lf->local_name, COB_BASENAME_KEEP_EXT)); - p->local_include = lf; - lf->next = fn->localfile; - fn->localfile = lf; - } - - /* Entries for COMMON programs */ - for (p = current_program; p; p = p->next_program) { - i = p->nested_level; - for (nlp = p->common_prog_list; nlp; nlp = nlp->next) { - for (r = p->next_program; r; r = r->next_program) { - if (r->nested_level <= i) { - break; - } - cb_insert_common_prog (r, nlp->nested_prog); - } - } - } - - /* Translate to C */ - current_section = NULL; - current_paragraph = NULL; - current_statement = NULL; - cb_source_line = 0; - /* Temporarily disable cross-reference during C generation */ - if (cb_listing_xref) { - cb_listing_xref = 0; - codegen (current_program, fn->translate, 0); - cb_listing_xref = 1; - } else { - codegen (current_program, fn->translate, 0); - } - - /* Close files */ - if (unlikely(fclose (cb_storage_file) != 0)) { - cobc_terminate (fn->trstorage); - } - cb_storage_file = NULL; - if (unlikely (fclose (yyout) != 0)) { - cobc_terminate (fn->translate); - } - yyout = NULL; - for (p = current_program; p; p = p->next_program) { - if (unlikely(!p->local_include->local_fp)) { - continue; - } - if (unlikely(fclose (p->local_include->local_fp) != 0)) { - cobc_terminate(lf->local_name); - } - p->local_include->local_fp = NULL; - } - return !!errorcount; -} - -/* Create single-element assembly source */ - -static int -process_compile (struct filename *fn) -{ - char *name; - size_t bufflen; - size_t size; - - if (output_name) { - name = output_name; - } else { - name = file_basename (fn->source, NULL); -#ifndef _MSC_VER - strcat (name, ".s"); -#endif - } - size = strlen (name); -#ifdef _MSC_VER - size *= 2U; -#endif - - bufflen = cobc_cc_len + cobc_cflags_len - + size + fn->translate_len - + cobc_include_len + 64U; - - cobc_chk_buff_size (bufflen); - -#ifdef _MSC_VER - sprintf (cobc_buffer, gflag_set ? - "%s /c %s %s /Od /MDd /Zi /FR /c /Fa\"%s\" /Fo\"%s\" \"%s\"" : - "%s /c %s %s /MD /c /Fa\"%s\" /Fo\"%s\" \"%s\"", - cobc_cc, cobc_cflags, cobc_include, name, - name, fn->translate); - if (verbose_output > 1) { - return process (cobc_buffer); - } else { - return process_filtered (cobc_buffer, fn); - } -#elif defined(__WATCOMC__) - sprintf (cobc_buffer, "%s -fe=\"%s\" -s %s %s %s", cobc_cc, name, - cobc_cflags, cobc_include, fn->translate); - return process (cobc_buffer); -#else - /* TODO: check ORANGEC options */ - if (!cb_flag_main) { - sprintf (cobc_buffer, "%s -S -o \"%s\" %s %s %s \"%s\"", cobc_cc, name, - cobc_cflags, cobc_include, COB_PIC_FLAGS, fn->translate); - } else { - sprintf (cobc_buffer, "%s -S -o \"%s\" %s %s \"%s\"", cobc_cc, name, - cobc_cflags, cobc_include, fn->translate); - } - return process(cobc_buffer); -#endif - -} - -/* Create single-element assembled object */ - -static int -process_assemble (struct filename *fn) -{ -#ifndef _MSC_VER - int ret; -#endif - size_t bufflen; -#ifdef __OS400__ - char *name; -#endif - - bufflen = cobc_cc_len + cobc_cflags_len + fn->object_len - + fn->translate_len + cobc_include_len -#ifndef __OS400__ - + cobc_pic_flags_len -#endif - + 64U; - - cobc_chk_buff_size (bufflen); - -#ifdef _MSC_VER - sprintf (cobc_buffer, gflag_set ? - "%s /c %s %s /Od /MDd /Zi /FR /Fo\"%s\" \"%s\"" : - "%s /c %s %s /MD /Fo\"%s\" \"%s\"", - cobc_cc, cobc_cflags, cobc_include, - fn->object, fn->translate); - if (verbose_output > 1) { - return process (cobc_buffer); - } else { - return process_filtered (cobc_buffer, fn); - } -#elif defined(__OS400__) - file_stripext ((char *) fn->object); - sprintf (cobc_buffer, "%s -c %s %s -o %s %s", - cobc_cc, cobc_cflags, cobc_include, - fn->object, fn->translate); - ret = process (cobc_buffer); - return ret; -#elif defined(__WATCOMC__) - if (cb_compile_level == CB_LEVEL_MODULE || - cb_compile_level == CB_LEVEL_LIBRARY) { - sprintf (cobc_buffer, "%s -c %s %s %s -fe=\"%s\" \"%s\"", - cobc_cc, cobc_cflags, cobc_include, - COB_PIC_FLAGS, fn->object, fn->translate); - } else { - sprintf (cobc_buffer, "%s -c %s %s -fe=\"%s\" \"%s\"", - cobc_cc, cobc_cflags, cobc_include, - fn->object, fn->translate); - } - ret = process (cobc_buffer); - return ret; -#else - if (cb_compile_level == CB_LEVEL_MODULE || - cb_compile_level == CB_LEVEL_LIBRARY || - cb_compile_level == CB_LEVEL_ASSEMBLE) { - sprintf (cobc_buffer, "%s -c %s %s %s -o \"%s\" \"%s\"", - cobc_cc, cobc_cflags, cobc_include, - COB_PIC_FLAGS, fn->object, fn->translate); - } else { - /* Only for CB_LEVEL_EXECUTABLE */ - sprintf (cobc_buffer, "%s -c %s %s -o \"%s\" \"%s\"", - cobc_cc, cobc_cflags, cobc_include, - fn->object, fn->translate); - } - ret = process (cobc_buffer); - return ret; -#endif - -} - -/* Create single-element loadable object (as module) - without intermediate stages */ - -static int -process_module_direct (struct filename *fn) -{ - char *name; -#ifdef _MSC_VER - char *exe_name; -#endif - size_t bufflen; - size_t size; - int ret; - - if (output_name) { - name = output_name_buff; - strcpy (name, output_name); -#if defined(_MSC_VER) || defined(__OS400__) || defined(__WATCOMC__) || defined(__BORLANDC__) - file_stripext (name); -#else - if (strchr (output_name, '.') == NULL) { - strcat (name, "." COB_MODULE_EXT); - } -#endif - } else { - name = file_basename (fn->source, NULL); -#if !defined(_MSC_VER) && !defined(__OS400__) && !defined(__WATCOMC__) && !defined(__BORLANDC__) - strcat (name, "." COB_MODULE_EXT); -#endif - } -#ifdef _MSC_VER - exe_name = cobc_stradd_dup (name, "." COB_MODULE_EXT); -#endif - - size = strlen (name); -#ifdef _MSC_VER - size *= 2U; -#endif - - bufflen = cobc_cc_len + cobc_cflags_len - + cobc_include_len + cobc_shared_opt_len - + cobc_pic_flags_len + cobc_export_dyn_len - + size + fn->translate_len -#ifdef _MSC_VER - + manilink_len -#endif - + cobc_ldflags_len + cobc_lib_paths_len + cobc_libs_len - + 128U; - - cobc_chk_buff_size (bufflen); - -#ifdef _MSC_VER - sprintf (cobc_buffer, gflag_set ? - "%s %s %s /Od /MDd /LDd /Zi /FR /Fe\"%s\" /Fo\"%s\" \"%s\" %s %s %s %s" : - "%s %s %s /MD /LD /Fe\"%s\" /Fo\"%s\" \"%s\" %s %s %s %s", - cobc_cc, cobc_cflags, cobc_include, exe_name, name, - fn->translate, - manilink, cobc_ldflags, cobc_lib_paths, cobc_libs); - if (verbose_output > 1) { - ret = process (cobc_buffer); - } else { - ret = process_filtered (cobc_buffer, fn); - } - /* Embedding manifest */ - if (ret == 0) { - sprintf (cobc_buffer, - "%s /manifest \"%s.manifest\" /outputresource:\"%s\";#2", - manicmd, exe_name, exe_name); - ret = process (cobc_buffer); - sprintf (cobc_buffer, "%s.manifest", exe_name); - cobc_check_action (cobc_buffer); - } - cobc_free ((void *) exe_name); - sprintf (cobc_buffer, "%s.exp", name); - cobc_check_action (cobc_buffer); - sprintf (cobc_buffer, "%s.lib", name); - if (strstr (fn->source, cobc_buffer) == NULL) cobc_check_action (cobc_buffer); - sprintf (cobc_buffer, "%s.%s", name, COB_OBJECT_EXT); - if (strstr (fn->source, cobc_buffer) == NULL) cobc_check_action (cobc_buffer); -#else /* _MSC_VER */ -#ifdef __OS400__ - if (fn->translate[0] != '/') { - char *p; - - p = cobc_main_malloc (COB_LARGE_BUFF); - getcwd (p, COB_LARGE_BUFF); - strcat (p, "/"); - strcat (p, fn->translate); - fn->translate = p; - fn->translate_len = strlen (p); - } -#endif -#ifdef __WATCOMC__ - sprintf (cobc_buffer, "%s %s %s %s %s %s -fe=\"%s\" \"%s\" %s %s %s", - cobc_cc, cobc_cflags, cobc_include, COB_SHARED_OPT, - COB_PIC_FLAGS, COB_EXPORT_DYN, name, - fn->translate, cobc_ldflags, cobc_lib_paths, cobc_libs); -#else - sprintf (cobc_buffer, "%s %s %s %s %s %s -o \"%s\" \"%s\" %s %s %s", - cobc_cc, cobc_cflags, cobc_include, COB_SHARED_OPT, - COB_PIC_FLAGS, COB_EXPORT_DYN, name, - fn->translate, cobc_ldflags, cobc_lib_paths, cobc_libs); -#endif - ret = process (cobc_buffer); -#ifdef COB_STRIP_CMD - if (strip_output && ret == 0) { - cobc_chk_buff_size (strlen (COB_STRIP_CMD) + 3 + strlen (name)); - sprintf (cobc_buffer, "%s \"%s\"", COB_STRIP_CMD, name); - ret = process (cobc_buffer); - } -#endif -#endif /* _MSC_VER */ - return ret; -} - -/* Create single-element loadable object */ - -static int -process_module (struct filename *fn) -{ - char *name; -#ifdef _MSC_VER - char *exe_name; -#endif - size_t bufflen; - size_t size; - int ret; - - if (output_name) { - name = output_name_buff; - strcpy (name, output_name); -#if defined(_MSC_VER) || defined(__OS400__) || defined(__WATCOMC__) || defined(__BORLANDC__) - file_stripext (name); -#else - if (strchr (output_name, '.') == NULL) { - strcat (name, "." COB_MODULE_EXT); - } -#endif - } else { - name = file_basename (fn->source, NULL); -#if !defined(_MSC_VER) && !defined(__OS400__) && !defined(__WATCOMC__) &&! defined(__BORLANDC__) - strcat (name, "." COB_MODULE_EXT); -#endif - } -#ifdef _MSC_VER - exe_name = cobc_stradd_dup (name, "." COB_MODULE_EXT); -#endif - - size = strlen (name); - bufflen = cobc_cc_len - + cobc_shared_opt_len - + cobc_pic_flags_len + cobc_export_dyn_len - + size + fn->object_len -#ifdef _MSC_VER - + manilink_len -#endif - + cobc_ldflags_len + cobc_lib_paths_len + cobc_libs_len - + 128U; - - cobc_chk_buff_size (bufflen); - -#ifdef _MSC_VER - sprintf (cobc_buffer, gflag_set ? - "%s /Od /MDd /LDd /Zi /FR /Fe\"%s\" \"%s\" %s %s %s %s" : - "%s /MD /LD /Fe\"%s\" \"%s\" %s %s %s %s", - cobc_cc, exe_name, fn->object, - manilink, cobc_ldflags, cobc_libs, cobc_lib_paths); - if (verbose_output > 1) { - ret = process (cobc_buffer); - } else { - ret = process_filtered (cobc_buffer, fn); - } - /* Embedding manifest */ - if (ret == 0) { - sprintf (cobc_buffer, - "%s /manifest \"%s.manifest\" /outputresource:\"%s\";#2", - manicmd, exe_name, exe_name); - ret = process (cobc_buffer); - sprintf (cobc_buffer, "%s.manifest", exe_name); - cobc_check_action (cobc_buffer); - } - cobc_free ((void *) exe_name); - sprintf (cobc_buffer, "%s.exp", name); - cobc_check_action (cobc_buffer); - sprintf (cobc_buffer, "%s.lib", name); - if (strstr (fn->source, cobc_buffer) == NULL) cobc_check_action (cobc_buffer); - sprintf (cobc_buffer, "%s.obj", name); - if (strstr (fn->source, cobc_buffer) == NULL) cobc_check_action (cobc_buffer); -#else /* _MSC_VER */ -#ifdef __WATCOMC__ - sprintf (cobc_buffer, "%s %s %s %s -fe=\"%s\" \"%s\" %s %s %s", - cobc_cc, COB_SHARED_OPT, COB_PIC_FLAGS, COB_EXPORT_DYN, - name, fn->object, cobc_ldflags, cobc_lib_paths, cobc_libs); -#else - sprintf (cobc_buffer, "%s %s %s %s -o \"%s\" \"%s\" %s %s %s", - cobc_cc, COB_SHARED_OPT, COB_PIC_FLAGS, COB_EXPORT_DYN, - name, fn->object, cobc_ldflags, cobc_lib_paths, cobc_libs); -#endif - ret = process (cobc_buffer); -#ifdef COB_STRIP_CMD - if (strip_output && ret == 0) { - cobc_chk_buff_size (strlen (COB_STRIP_CMD) + 3 + strlen (name)); - sprintf (cobc_buffer, "%s \"%s\"", COB_STRIP_CMD, name); - ret = process (cobc_buffer); - } -#endif -#endif /* _MSC_VER */ - return ret; -} - -/* Create multi-element loadable object */ - -static int -process_library (struct filename *l) -{ - struct filename *f; - char *name; -#ifdef _MSC_VER - char *exe_name; -#endif - size_t bufflen; - size_t size; - int ret; - - /* LCOV_EXCL_START */ - if (!l) { - cobc_err_msg (_("call to '%s' with invalid parameter '%s'"), - "process_library", "l"); - COBC_ABORT (); - } - /* LCOV_EXCL_STOP */ - - for (f = l; f; f = f->next) { - strcat (cobc_objects_buffer, "\""); - strcat (cobc_objects_buffer, f->object); - strcat (cobc_objects_buffer, "\" "); - } - - if (output_name) { - name = output_name_buff; - strcpy (name, output_name); -#if defined(_MSC_VER) || defined(__OS400__) || defined(__WATCOMC__) || defined(__BORLANDC__) - file_stripext (name); -#else - if (strchr (output_name, '.') == NULL) { - strcat (name, "." COB_MODULE_EXT); - } -#endif - } else { - name = file_basename (l->source, NULL); -#if !defined(_MSC_VER) && !defined(__OS400__) && !defined(__WATCOMC__) && !defined(__BORLANDC__) - strcat (name, "." COB_MODULE_EXT); -#endif - } -#ifdef _MSC_VER - exe_name = cobc_stradd_dup (name, "." COB_MODULE_EXT); -#endif - - size = strlen (name); - bufflen = cobc_cc_len + cobc_shared_opt_len - + cobc_pic_flags_len + cobc_export_dyn_len - + size + cobc_objects_len + cobc_libs_len -#ifdef _MSC_VER - + manilink_len -#endif - + cobc_ldflags_len + cobc_lib_paths_len - + 64U; - - cobc_chk_buff_size (bufflen); - -#ifdef _MSC_VER - sprintf (cobc_buffer, gflag_set ? - "%s /Od /MDd /LDd /Zi /FR /Fe\"%s\" %s %s %s %s %s" : - "%s /MD /LD /Fe\"%s\" %s %s %s %s %s", - cobc_cc, exe_name, cobc_objects_buffer, - manilink, cobc_ldflags, cobc_lib_paths, cobc_libs); - if (verbose_output > 1) { - ret = process (cobc_buffer); - } else { - ret = process_filtered (cobc_buffer, l); - } - /* Embedding manifest */ - if (ret == 0) { - sprintf (cobc_buffer, - "%s /manifest \"%s.manifest\" /outputresource:\"%s\";#2", - manicmd, exe_name, exe_name); - ret = process (cobc_buffer); - sprintf (cobc_buffer, "%s.manifest", exe_name); - cobc_check_action (cobc_buffer); - } - cobc_free ((void *) exe_name); - sprintf (cobc_buffer, "%s.exp", name); - cobc_check_action (cobc_buffer); - sprintf (cobc_buffer, "%s.lib", name); - - for (f = l; f; f = f->next) { - if (strstr (f->source, cobc_buffer) != NULL) { - break; - } - } - if (!f) cobc_check_action (cobc_buffer); -#else /* _MSC_VER */ -#ifdef __WATCOMC__ - sprintf (cobc_buffer, "%s %s %s %s -fe=\"%s\" %s %s %s %s", - cobc_cc, COB_SHARED_OPT, COB_PIC_FLAGS, - COB_EXPORT_DYN, name, cobc_objects_buffer, - cobc_ldflags, cobc_lib_paths, cobc_libs); -#else - sprintf (cobc_buffer, "%s %s %s %s -o \"%s\" %s %s %s %s", - cobc_cc, COB_SHARED_OPT, COB_PIC_FLAGS, - COB_EXPORT_DYN, name, cobc_objects_buffer, - cobc_ldflags, cobc_lib_paths, cobc_libs); -#endif - ret = process (cobc_buffer); -#ifdef COB_STRIP_CMD - if (strip_output && ret == 0) { - sprintf (cobc_buffer, "%s \"%s\"", COB_STRIP_CMD, name); - ret = process (cobc_buffer); - } -#endif -#endif /* _MSC_VER */ - return ret; -} - -/* Create executable */ - -static int -process_link (struct filename *l) -{ - struct filename *f; - const char *name; -#if defined(_MSC_VER) || defined (COB_STRIP_CMD) - const char *exe_name; -#endif - size_t bufflen; - size_t size; - int ret; - - /* LCOV_EXCL_START */ - if (!l) { - cobc_err_msg (_("call to '%s' with invalid parameter '%s'"), - "process_link", "l"); - COBC_ABORT (); - } - /* LCOV_EXCL_STOP */ - - for (f = l; f; f = f->next) { -#ifdef __OS400__ - file_stripext ((char *) f->object); - strcat (cobc_objects_buffer, f->object); - strcat (cobc_objects_buffer, " "); -#else - strcat (cobc_objects_buffer, "\""); - strcat (cobc_objects_buffer, f->object); - strcat (cobc_objects_buffer, "\" "); -#endif - } - - if (output_name) { -#if defined(_MSC_VER) || defined(__OS400__) || defined(__WATCOMC__) || defined(__BORLANDC__) - name = cobc_main_strdup (output_name); - file_stripext ((char *)name); -#else - name = output_name; -#endif - } else { - if (l->file_is_stdin) { - name = COB_DASH_OUT; - } else { - name = file_basename (l->source, NULL); - } - } -#ifdef _MSC_VER - exe_name = cobc_stradd_dup (name, COB_EXE_EXT); -#endif - - size = strlen (name); - bufflen = cobc_cc_len + cobc_export_dyn_len - + size + cobc_objects_len -#ifdef _MSC_VER - + manilink_len -#endif - + cobc_ldflags_len + cobc_libs_len + cobc_lib_paths_len - + 64U; - - cobc_chk_buff_size (bufflen); - -#ifdef _MSC_VER - sprintf (cobc_buffer, gflag_set ? - "%s /Od /MDd /Zi /FR /Fe\"%s\" %s %s %s %s %s" : - "%s /MD /Fe\"%s\" %s %s %s %s %s", - cobc_cc, exe_name, cobc_objects_buffer, - manilink, cobc_ldflags, cobc_lib_paths, cobc_libs); - if (verbose_output > 1) { - ret = process (cobc_buffer); - } else { - ret = process_filtered (cobc_buffer, l); - } - /* Embedding manifest */ - if (ret == 0) { - sprintf (cobc_buffer, - "%s /manifest \"%s.manifest\" /outputresource:\"%s\";#1", - manicmd, exe_name, exe_name); - ret = process (cobc_buffer); - sprintf (cobc_buffer, "%s.manifest", exe_name); - cobc_check_action (cobc_buffer); - } - cobc_free ((void *) exe_name); -#else /* _MSC_VER */ -#ifdef __WATCOMC__ - sprintf (cobc_buffer, "%s %s -fe=\"%s\" %s %s %s %s", - cobc_cc, COB_EXPORT_DYN, name, cobc_objects_buffer, - cobc_ldflags, cobc_lib_paths, cobc_libs); -#else - sprintf (cobc_buffer, "%s %s -o \"%s\" %s %s %s %s", - cobc_cc, COB_EXPORT_DYN, name, cobc_objects_buffer, - cobc_ldflags, cobc_lib_paths, cobc_libs); -#endif - - ret = process (cobc_buffer); - -#ifdef __hpux - if (ret == 0) { - sprintf (cobc_buffer, "chatr -s +s enable \"%s%s\" 1>/dev/null 2>&1", - name, COB_EXE_EXT); - process (cobc_buffer); - } -#endif - -#ifdef COB_STRIP_CMD - if (strip_output && ret == 0) { - cobc_chk_buff_size (strlen (COB_STRIP_CMD) + 3 + strlen (name) + strlen (COB_EXE_EXT)); - /* only add COB_EXE_EXT if it is not specified */ - exe_name = file_extension (name); - if (COB_EXE_EXT[0] && strcasecmp (exe_name, COB_EXE_EXT + 1)) { - sprintf (cobc_buffer, "%s \"%s%s\"", - COB_STRIP_CMD, name, COB_EXE_EXT); - } else { - sprintf (cobc_buffer, "%s \"%s\"", - COB_STRIP_CMD, name); - } - ret = process (cobc_buffer); - } -#endif - -#endif /* _MSC_VER */ - return ret; -} - -/* Set up build time stamp */ -static void -set_const_cobc_build_stamp (void) -{ - int year; - int day; - char month[32]; - - memset (month, 0, sizeof(month)); - day = 0; - year = 0; - if (sscanf (__DATE__, "%s %d %d", month, &day, &year) == 3) { - snprintf (cobc_buffer, (size_t)COB_MINI_MAX, - "%s %2.2d %4.4d %s", month, day, year, __TIME__); - } else { - snprintf (cobc_buffer, (size_t)COB_MINI_MAX, - "%s %s", __DATE__, __TIME__); - } - cb_cobc_build_stamp = (const char *)cobc_main_strdup (cobc_buffer); -} - -/* Set up compiler defaults from environment/builtin */ -static void -set_cobc_defaults (void) -{ - char *p; - - cobc_cc = cobc_getenv_path ("COB_CC"); - if (cobc_cc == NULL) { - cobc_cc = COB_CC; - } - - cob_config_dir = cobc_getenv_path ("COB_CONFIG_DIR"); - if (cob_config_dir == NULL) { - cob_config_dir = COB_CONFIG_DIR; - } - cob_schema_dir = cobc_getenv_path ("COB_SCHEMA_DIR"); - if (cob_schema_dir == NULL) { - cob_schema_dir = COB_SCHEMA_DIR; - } - - p = cobc_getenv ("COB_CFLAGS"); - if (p) { - COBC_ADD_STR (cobc_cflags, p, NULL, NULL); - } else { - COBC_ADD_STR (cobc_cflags, COB_CFLAGS, NULL, NULL); - } - - p = cobc_getenv ("COB_LDFLAGS"); - if (p) { - COBC_ADD_STR (cobc_ldflags, p, NULL, NULL); - } else { - COBC_ADD_STR (cobc_ldflags, COB_LDFLAGS, NULL, NULL); - } - - p = cobc_getenv ("COB_LIBS"); - if (p) { - COBC_ADD_STR (cobc_libs, p, NULL, NULL); - } else { - COBC_ADD_STR (cobc_libs, COB_LIBS, NULL, NULL); - } - - p = cobc_getenv ("COB_LDADD"); - if (p) { - COBC_ADD_STR (cobc_libs, " ", p, NULL); - } - - p = cobc_getenv ("COB_LIB_PATHS"); - if (p) { - COBC_ADD_STR (cobc_lib_paths, p, NULL, NULL); - } else { - COBC_ADD_STR (cobc_lib_paths, " ", NULL, NULL); - } - - /* Different styles for warning/error messages */ - p = cobc_getenv ("COB_MSG_FORMAT"); -#if defined (_MSC_VER) - if (p && strcasecmp (p, "GCC") == 0) { - cb_msg_style = CB_MSG_STYLE_GCC; - } else { - cb_msg_style = CB_MSG_STYLE_MSC; - } -#else - if (p && strcasecmp (p, "MSC") == 0) { - cb_msg_style = CB_MSG_STYLE_MSC; - } else { - cb_msg_style = CB_MSG_STYLE_GCC; - } -#endif - p = cobc_getenv ("COB_UNIX_LF"); - if (p - && (*p == 'Y' || *p == 'y' || - *p == 'O' || *p == 'o' || - *p == 'T' || *p == 't' || - *p == '1')) { - cb_unix_lf = 1; - } -} - -/* Setup for the C compiler/linker */ -static void -begin_setup_compiler_env (void) -{ - cobc_libs = cobc_main_malloc ((size_t)COB_SMALL_BUFF); - cobc_lib_paths = cobc_main_malloc ((size_t)COB_SMALL_BUFF); - cobc_cflags = cobc_main_malloc ((size_t)COB_MINI_BUFF); - cobc_ldflags = cobc_main_malloc ((size_t)COB_MINI_BUFF); - cobc_include = cobc_main_malloc ((size_t)COB_MINI_BUFF); - - cobc_libs_size = COB_SMALL_MAX; - cobc_lib_paths_size = COB_SMALL_MAX; - cobc_cflags_size = COB_MINI_MAX; - cobc_include_size = COB_MINI_MAX; - cobc_ldflags_size = COB_MINI_MAX; - - cobc_objects_len = 0; -} - -/* Setup for the C compiler/linker */ -static void -finish_setup_compiler_env (void) -{ - /* compiler specific options for (non/very) verbose output */ -#if defined(__GNUC__) || defined(__TINYC__) - if (verbose_output > 1) { - COBC_ADD_STR (cobc_cflags, " -v", NULL, NULL); -#if !defined (__INTEL_COMPILER) && !defined(__TINYC__) - if (verbose_output > 2) { - COBC_ADD_STR (cobc_ldflags, " -t", NULL, NULL); - } -#endif - } -#elif defined(_MSC_VER) - /* MSC stuff reliant upon verbose option */ - switch (verbose_output) { - case 0: - /* -v */ - case 1: - COBC_ADD_STR (cobc_cflags, " /nologo", NULL, NULL); - manicmd = "mt /nologo"; - manilink = "/link /manifest /nologo"; - break; - /* -vv */ - case 2: - manicmd = "mt"; - manilink = "/link /manifest"; - break; - /* -vvv */ - default: - manicmd = "mt /verbose"; - manilink = "/link /manifest /verbose"; - } - manilink_len = strlen (manilink); -#elif defined(__ORANGEC__) - if (verbose_output <= 1) { - COBC_ADD_STR (cobc_cflags, " --nologo", NULL, NULL); - COBC_ADD_STR (cobc_ldflags, " --nologo", NULL, NULL); - } else { - COBC_ADD_STR (cobc_cflags, " -yy", NULL, NULL); - COBC_ADD_STR (cobc_ldflags, " -yy", NULL, NULL); - } -#elif defined(__WATCOMC__) - if (verbose_output < 2) { - COBC_ADD_STR (cobc_cflags, " -q", NULL, NULL); - } -#endif - - /* Set length of compiler strings */ - cobc_cc_len = strlen (cobc_cc); - cobc_cflags_len = strlen (cobc_cflags); - cobc_include_len = strlen (cobc_include); - cobc_shared_opt_len = strlen (COB_SHARED_OPT); - cobc_pic_flags_len = strlen (COB_PIC_FLAGS); - cobc_export_dyn_len = strlen (COB_EXPORT_DYN); - cobc_ldflags_len = strlen (cobc_ldflags); - cobc_lib_paths_len = strlen (cobc_lib_paths); - cobc_libs_len = strlen (cobc_libs); -} - - -static void -begin_setup_internal_and_compiler_env (void) -{ - /* register signal handlers from cobc */ - cob_reg_sighnd (&cobc_sig_handler); - - file_list = NULL; - cb_listing_file = NULL; - cb_src_list_file = NULL; - ppin = NULL; - ppout = NULL; - yyin = NULL; - yyout = NULL; - - /* General buffers */ - cobc_buffer = cobc_main_malloc ((size_t)COB_LARGE_BUFF); - cobc_buffer_size = COB_LARGE_MAX; - basename_buffer = cobc_main_malloc ((size_t)COB_MINI_BUFF); - basename_len = COB_MINI_MAX - 16; - - cb_source_file = NULL; - save_temps_dir = NULL; - base_string = NULL; - cb_id = 1; - cb_pic_id = 1; - cb_attr_id = 1; - cb_literal_id = 1; - cb_field_id = 1; -#ifdef COB_EBCDIC_MACHINE - cb_ebcdic_sign = 1; -#else - cb_ebcdic_sign = 0; -#endif - -#ifdef HAVE_SETLOCALE - setlocale (LC_ALL, ""); - setlocale (LC_NUMERIC, "C"); -#endif - - /* minimal initialization of the environment like binding textdomain, - allowing test to be run under WIN32 (implied in cob_init(), - no need to call outside of GnuCOBOL) */ - cob_common_init (NULL); - - /* Initialize variables */ - begin_setup_compiler_env (); - - set_const_cobc_build_stamp(); - set_cobc_defaults(); - - output_name = NULL; - - /* Set default computed goto usage if appropriate */ -#if defined(COB_COMPUTED_GOTO) && COB_COMPUTED_GOTO - cb_flag_computed_goto = 1; -#endif - - /* Enable default I/O exceptions */ - CB_EXCEPTION_ENABLE (COB_EC_I_O) = 1; - -#ifndef HAVE_DESIGNATED_INITS - cobc_init_reserved (); -#endif -} - - -static void -finish_setup_internal_env (void) -{ -#ifndef HAVE_DESIGNATED_INITS - cobc_init_typeck (); -#endif - - /* Append default extensions */ - CB_TEXT_LIST_ADD (cb_extension_list, ".CPY"); - CB_TEXT_LIST_ADD (cb_extension_list, ".CBL"); - CB_TEXT_LIST_ADD (cb_extension_list, ".COB"); - CB_TEXT_LIST_ADD (cb_extension_list, ".cpy"); - CB_TEXT_LIST_ADD (cb_extension_list, ".cbl"); - CB_TEXT_LIST_ADD (cb_extension_list, ".cob"); - CB_TEXT_LIST_ADD (cb_extension_list, ""); - - /* Process COB_COPY_DIR and COBCPY environment variables */ - process_env_copy_path (getenv ("COB_COPY_DIR")); - process_env_copy_path (getenv ("COBCPY")); - - /* Add default COB_COPY_DIR directory */ - CB_TEXT_LIST_CHK (cb_include_list, COB_COPY_DIR); -} - -static int -process_file (struct filename *fn, int status) -{ - struct cobc_mem_struct *mptr; - struct cobc_mem_struct *mptrt; - - current_compile_time = cob_get_current_date_and_time (); - - /* Initialize listing */ - if (cb_src_list_file) { - set_listing_date (); - set_standard_title (); - - cb_current_file = cb_listing_file_struct; - cb_current_file->copy_tail = NULL; /* may include an old reference */ - cb_current_file->name = cobc_strdup (fn->source); - cb_current_file->source_format = cb_source_format; - force_new_page_for_next_line (); - } - - /* Initialize general vars */ - errorcount = 0; - cb_source_file = NULL; - cb_source_line = 0; - current_section = NULL; - current_paragraph = NULL; - current_program = NULL; - cb_id = 1; - cb_pic_id = 1; - cb_attr_id = 1; - cb_literal_id = 1; - cb_field_id = 1; - cb_ml_attr_id = 1; - cb_ml_tree_id = 1; - demangle_name = fn->demangle_source; - memset (optimize_defs, 0, sizeof (optimize_defs)); - - if (cb_src_list_file) { - cb_listing_page = 0; - strncpy (cb_listing_filename, fn->source, FILENAME_MAX - 1); - cb_listing_filename[FILENAME_MAX - 1] = 0; - set_listing_header_code (); - } - - if (cb_compile_level >= CB_LEVEL_PREPROCESS && - fn->need_preprocess) { - /* Preprocess */ - fn->has_error = preprocess (fn); - status |= fn->has_error; - /* If preprocessing raised errors go on but only check syntax */ - if (fn->has_error) { - cb_flag_syntax_only = 1; - } - } - - if (cobc_list_file) { - putc ('\n', cb_listing_file); - } - - if (cb_compile_level < CB_LEVEL_TRANSLATE) { - if (cb_src_list_file) { - print_program_listing (); - } - return status; - } - if (fn->need_translate) { - /* Parse / Translate (to C code) */ - fn->has_error = process_translate (fn); - status |= fn->has_error; - if (cb_src_list_file) { - print_program_listing (); - } - /* Free parse memory */ - for (mptr = cobc_parsemem_base; mptr; ) { - mptrt = mptr; - mptr = mptr->next; - cobc_free (mptrt); - } - cobc_parsemem_base = NULL; - cb_init_codegen (); - } else { - if (cb_src_list_file) { - print_program_listing (); - } - } - if (cb_compile_level < CB_LEVEL_COMPILE || - cb_flag_syntax_only || fn->has_error) { - return status; - } - if (cb_compile_level == CB_LEVEL_COMPILE) { - /* Compile to assembler code */ - fn->has_error = process_compile (fn); - status |= fn->has_error; - return status; - } - - if (cb_compile_level == CB_LEVEL_MODULE && fn->need_assemble) { - /* Build module direct */ - fn->has_error = process_module_direct (fn); - status |= fn->has_error; - } else { - /* Compile to object code */ - if (cb_compile_level >= CB_LEVEL_ASSEMBLE && - fn->need_assemble) { - fn->has_error = process_assemble (fn); - status |= fn->has_error; - } - if (fn->has_error) { - return status; - } - - /* Build module */ - if (cb_compile_level == CB_LEVEL_MODULE) { - fn->has_error = process_module (fn); - status |= fn->has_error; - } - } - return status; -} - -/* Main function */ -int -main (int argc, char **argv) -{ - struct filename *fn; - unsigned int iparams; - unsigned int local_level; - int status; - int statuses; - int i; - const char *run_name = NULL; - - /* Setup routines I */ - begin_setup_internal_and_compiler_env (); - - cb_saveargc = argc; - cb_saveargv = argv; - - /* Process command line arguments */ - iargs = process_command_line (argc, argv); - - if (fatal_startup_error) { - cobc_err_msg (_("please check environment variables as noted above")); - cobc_abort_terminate (0); - } - - /* Check the filename */ - if (iargs == argc) { - cobc_err_exit (_("no input files")); - } - - /* Defaults are set here */ - if (!cb_flag_syntax_only) { - if (cb_compile_level == 0) { - if (cobc_flag_main) { - cb_compile_level = CB_LEVEL_EXECUTABLE; - } else if (cobc_flag_module) { - cb_compile_level = CB_LEVEL_MODULE; - } else if (cobc_flag_library) { - cb_compile_level = CB_LEVEL_LIBRARY; - } else { - cb_compile_level = CB_LEVEL_MODULE; - cobc_flag_module = 1; - } - } else if (cb_compile_level != CB_LEVEL_PREPROCESS && - !cobc_flag_main && !cobc_flag_module && !cobc_flag_library) { - cobc_flag_module = 1; - } - } else { - cb_compile_level = CB_LEVEL_TRANSLATE; - cobc_flag_main = 0; - cobc_flag_module = 0; - cobc_flag_library = 0; - } - - if (output_name && cb_compile_level < CB_LEVEL_LIBRARY && - (argc - iargs) > 1) { - cobc_err_exit (_("%s option invalid in this combination"), "-o"); - } - - /* Setup routines II */ - finish_setup_compiler_env (); - finish_setup_internal_env (); - - cb_text_column = cb_config_text_column; - cb_indicator_column = 7; - - memset (cb_listing_header, 0, sizeof (cb_listing_header)); - /* If -P=file specified, all lists go to this file */ - if (cobc_list_file) { - if (cb_unix_lf) { - cb_listing_file = fopen (cobc_list_file, "wb"); - } else { - cb_listing_file = fopen (cobc_list_file, "w"); - } - if (!cb_listing_file) { - cobc_terminate (cobc_list_file); - } - } - - /* internal complete source listing file */ - if (cb_listing_outputfile) { - if (strcmp (cb_listing_outputfile, COB_DASH) == 0) { - cb_src_list_file = stdout; - } else { - if (cb_unix_lf) { - cb_src_list_file = fopen (cb_listing_outputfile, "wb"); - } else { - cb_src_list_file = fopen (cb_listing_outputfile, "w"); - } - if (!cb_src_list_file) { - cobc_terminate (cb_listing_outputfile); - } - } - cb_listing_file_struct = cobc_malloc (sizeof (struct list_files)); - } - - if (verbose_output) { - fputs (_("command line:"), stderr); - putc ('\t', stderr); - for (i = 0; i < argc; ++i) { - fprintf (stderr, "%s ", argv[i]); - } - putc ('\n', stderr); - fflush (stderr); - } - - /* Process input files */ - - /* Set up file parameters, if any are missing: abort */ - while (iargs < argc) { - fn = process_filename (argv[iargs++]); - if (!fn) { - cobc_clean_up (1); - return 1; - } - } - - /* process all files */ - status = 0; - iparams = 0; - local_level = 0; - - for (fn = file_list; fn; fn = fn->next) { - iparams++; - if (iparams == 1 && cobc_flag_run) { - run_name = fn->source; - } - if (iparams > 1 && cb_compile_level == CB_LEVEL_EXECUTABLE) { - /* only the first source has the compile_level and main flag set */ - local_level = cb_compile_level; - cb_compile_level = CB_LEVEL_ASSEMBLE; - cobc_flag_main = 0; - } - status = process_file (fn, status); - statuses += status; - - /* take care for all intermediate files which aren't needed for linking */ - clean_up_intermediates (fn, status); - } - - if (cobc_list_file) { - fclose (cb_listing_file); - cb_listing_file = NULL; - } - - /* Clear rest of preprocess stuff */ - plex_clear_all (); - - /* Clear rest of parser stuff */ - ylex_clear_all (); - - if (local_level == CB_LEVEL_EXECUTABLE) { - cb_compile_level = CB_LEVEL_EXECUTABLE; - } - - if ((cb_compile_level < CB_LEVEL_LIBRARY) && cobc_flag_run && run_name) { - /* Run job after module with cobcrun */ - if (status == 0) { - status = process_run (run_name); - } - } - - if (cb_compile_level < CB_LEVEL_LIBRARY - || status || cb_flag_syntax_only) { - /* Finished */ - cobc_clean_up (status); - return status; - } - - /* Allocate objects buffer */ - cobc_objects_buffer = cobc_main_malloc (cobc_objects_len); - - /* All processing must be ok before a job run will be attempted */ - statuses = 0; - - if (file_list) { - /* Link */ - if (cb_compile_level == CB_LEVEL_LIBRARY) { - /* Multi-program module */ - status = process_library (file_list); - } else { - /* Executable */ - status = process_link (file_list); - } - statuses += status; - } - - /* Run job after compile? Use first (or only) filename */ - if ((statuses == 0) && cobc_flag_run && run_name) { - status = process_run (file_basename(run_name, NULL)); - } - - /* We have completed */ - cobc_clean_up (status); - - return status; -} diff -Nru gnucobol-4.0~early~20200606/cobc/cobc.h gnucobol-5/cobc/cobc.h --- gnucobol-4.0~early~20200606/cobc/cobc.h 2020-06-06 20:51:59.000000000 +0000 +++ gnucobol-5/cobc/cobc.h 1970-01-01 00:00:00.000000000 +0000 @@ -1,654 +0,0 @@ -/* - Copyright (C) 2001-2012, 2014-2020 Free Software Foundation, Inc. - Written by Keisuke Nishida, Roger While, Simon Sobisch, - Edward Hart, Ron Norman, Dave Pitts - - This file is part of GnuCOBOL. - - The GnuCOBOL compiler is free software: you can redistribute it - and/or modify it under the terms of the GNU General Public License - as published by the Free Software Foundation, either version 3 of the - License, or (at your option) any later version. - - GnuCOBOL is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with GnuCOBOL. If not, see . -*/ - - -#ifndef CB_COBC_H -#define CB_COBC_H - -#include -#ifdef HAVE_UNISTD_H -#include -#endif -#ifdef HAVE_STRINGS_H -#include -#endif - -#include "libcob.h" - -#ifdef ENABLE_NLS -#include "lib/gettext.h" -#define _(s) gettext(s) -#define N_(s) gettext_noop(s) -#else -#define _(s) s -#define N_(s) s -#endif - -#include "../libcob/sysdefines.h" - -/* Defines for access() */ -#ifndef F_OK -#define F_OK 0 -#endif - -#ifndef X_OK -#define X_OK 1 -#endif - -#ifndef W_OK -#define W_OK 2 -#endif - -#ifndef R_OK -#define R_OK 4 -#endif - -#define COBC_ABORT() cobc_abort(__FILE__, __LINE__) -#define YY_FATAL_ERROR(msg) \ - flex_fatal_error (msg, __FILE__, __LINE__) - -/* Source format enum */ -enum cb_format { - CB_FORMAT_FIXED = 0, - CB_FORMAT_FREE -}; - -/* COPY extended syntax defines */ -#define CB_REPLACE_LEADING 1U -#define CB_REPLACE_TRAILING 2U - -/* Flex directive actions */ -#define PLEX_ACT_IF 0 -#define PLEX_ACT_ELSE 1U -#define PLEX_ACT_END 2U -#define PLEX_ACT_ELIF 3U - -/* Flex value types */ -#define PLEX_DEF_NONE 0 -#define PLEX_DEF_LIT 1U -#define PLEX_DEF_NUM 2U -#define PLEX_DEF_DEL 3U - -/* Context sensitive keyword defines (trigger words) */ -#define CB_CS_ACCEPT (1U << 0) /* within ACCEPT statement */ -#define CB_CS_ALLOCATE (1U << 1) /* within ALLOCATE statement */ -#define CB_CS_ALPHABET (1U << 2) -#define CB_CS_ASSIGN (1U << 3) -#define CB_CS_CALL (1U << 4) /* within CALL statement */ -#define CB_CS_CONSTANT (1U << 5) -#define CB_CS_DATE (1U << 6) -#define CB_CS_DAY (1U << 7) -#define CB_CS_DISPLAY (1U << 8) /* within DISPLAY statement */ -#define CB_CS_ERASE (1U << 9) -#define CB_CS_EXIT (1U << 10) /* within EXIT statement */ -#define CB_CS_FROM (1U << 11) -#define CB_CS_OCCURS (1U << 12) -#define CB_CS_OPTIONS (1U << 13) -#define CB_CS_PERFORM (1U << 14) /* within PERFORM statement */ -#define CB_CS_PROGRAM_ID (1U << 15) /* within PROGRAM-ID definition */ -#define CB_CS_READ (1U << 16) /* within READ statement */ -#define CB_CS_RECORDING (1U << 17) -#define CB_CS_RETRY (1U << 18) -#define CB_CS_ROUNDED (1U << 19) -#define CB_CS_SET (1U << 20) /* within SET statement */ -#define CB_CS_STOP (1U << 21) -#define CB_CS_OBJECT_COMPUTER (1U << 22) -#define CB_CS_DELIMITER (1U << 23) -#define CB_CS_SCREEN (1U << 24) /* within SCREEN section */ -#define CB_CS_INQUIRE_MODIFY (1U << 25) /* within INQUIRE or MODIFY statement */ -#define CB_CS_GRAPHICAL_CONTROL (1U << 26) /* within ACUCOBOL-GT graphical control */ -#define CB_CS_SELECT (1U << 27) /* within SELECT */ -#define CB_CS_XML_GENERATE (1U << 28) -#define CB_CS_XML_PARSE (1U << 29) -#define CB_CS_OPEN (1U << 30) /* within OPEN */ -#define CB_CS_JSON_GENERATE (1U << 31) -/* HACK: no more space - using minor one until re-written */ -#define CB_CS_I_O_CONTROL CB_CS_DAY - -/* Support for cobc from stdin */ -#define COB_DASH "-" -#define COB_DASH_NAME "a.cob" -#define COB_DASH_OUT "a.out" - - -/* Operand operation type */ -enum cb_operation_type { - CB_OPERATION_READ = 0, - CB_OPERATION_WRITE, - CB_OPERATION_ASSIGN -}; - -/* Config dialect support types */ -enum cb_support { - CB_OK = 0, - CB_WARNING, - CB_ARCHAIC, - CB_OBSOLETE, - CB_SKIP, - CB_IGNORE, - CB_ERROR, - CB_UNCONFORMABLE -}; - -/* Config dialect support types */ -enum cb_std_def { - CB_STD_GC = 0, - CB_STD_MF, - CB_STD_IBM, - CB_STD_MVS, - CB_STD_BS2000, - CB_STD_ACU, - CB_STD_RM, - /* the following must contain ANSI/ISO standards in order */ - CB_STD_85, - CB_STD_2002, - CB_STD_2014, - /* the following must be the last and is invalid */ - CB_STD_MAX -}; - -/* Binary field sizes */ -enum cb_binary_size_options { - CB_BINARY_SIZE_1_2_4_8 = 0, /* 1,2,4,8 bytes */ - CB_BINARY_SIZE_1__8, /* 1,2,3,4,5,6,7,8 bytes */ - CB_BINARY_SIZE_2_4_8 /* 2,4,8 bytes */ -}; - -/* COMP/BINARY byte order */ -enum cb_binary_byteorder_options { - CB_BYTEORDER_BIG_ENDIAN = 0, - CB_BYTEORDER_NATIVE -}; - -/* Type of device specified in ASSIGN clause */ -enum cb_assign_device { - CB_ASSIGN_NO_DEVICE, - CB_ASSIGN_GENERAL_DEVICE, - CB_ASSIGN_LINE_SEQ_DEVICE, - CB_ASSIGN_DISPLAY_DEVICE, - CB_ASSIGN_KEYBOARD_DEVICE, - CB_ASSIGN_PRINTER_DEVICE, - CB_ASSIGN_PRINTER_1_DEVICE, - CB_ASSIGN_PRINT_DEVICE -}; - -/* Clauses an elementary screen item is required to have */ -enum cb_screen_clauses_rules { - CB_ACU_SCREEN_RULES, - CB_GC_SCREEN_RULES, - CB_MF_SCREEN_RULES, - CB_RM_SCREEN_RULES, - CB_STD_SCREEN_RULES, - CB_XOPEN_SCREEN_RULES -}; - -/* Generic text list structure */ -struct cb_text_list { - struct cb_text_list *next; /* next pointer */ - struct cb_text_list *last; - const char *text; -}; - -/* Generic replace list structure */ -struct cb_replace_list { - int line_num; - struct cb_replace_list *next; /* next pointer */ - struct cb_replace_list *last; - struct cb_replace_list *prev; - const struct cb_text_list *old_text; - const struct cb_text_list *new_text; - unsigned int lead_trail; -}; - -/* Generic define list structure */ -struct cb_define_struct { - struct cb_define_struct *next; /* next pointer */ - struct cb_define_struct *last; - char *name; - char *value; - unsigned int deftype; - int sign; - int int_part; - int dec_part; -}; - -/* Structure for extended filenames */ -struct local_filename { - struct local_filename *next; /* next pointer */ - char *local_name; /* foo.c.l[n].h (full path) */ - char *local_include_name; /* foo.c.l[n].h (for #include)*/ - FILE *local_fp; -}; - -/* Structure for filename */ -struct filename { - struct filename *next; - const char *source; /* foo.cob (path from command line) */ - const char *preprocess; /* foo.i / foo.cob (full path) */ - const char *translate; /* foo.c (full path) */ - const char *trstorage; /* foo.c.h (full path) */ - const char *object; /* foo.o (full path) */ - const char *demangle_source; /* foo */ - const char *listing_file; /* foo.lst */ - struct local_filename *localfile; /* foo.c.l[n].h */ - size_t translate_len; /* strlen translate */ - size_t object_len; /* strlen object */ - unsigned int need_preprocess; /* Needs preprocess */ - unsigned int need_translate; /* Needs parse */ - unsigned int need_assemble; /* Needs C compile */ - int has_error; /* Error detected */ - int file_is_stdin; /* dash used as filename */ -}; - -/* Exception structure */ -struct cb_exception { - const char *name; /* Exception name */ - const int code; /* Exception code */ - int enable; /* If turned on */ -}; - -/* Basic memory structure */ -struct cobc_mem_struct { - struct cobc_mem_struct *next; /* next pointer */ - void *memptr; - size_t memlen; -}; -#define COBC_MEM_SIZE ((sizeof(struct cobc_mem_struct) + sizeof(long long) - 1) \ - / sizeof(long long)) * sizeof(long long) - -/* Type of name to check in cobc_check_valid_name */ -enum cobc_name_type { - FILE_BASE_NAME = 0, - ENTRY_NAME, - PROGRAM_ID_NAME -}; - -/* Listing structures and externals */ - -/* List of error messages */ -struct list_error { - struct list_error *next; - int line; /* Line number for error */ - char *file; /* File name */ - char *prefix; /* Error prefix */ - char *msg; /* Error Message text */ -}; - -/* List of REPLACE text blocks */ -struct list_replace { - struct list_replace *next; - int firstline; /* First line for replace */ - int lastline; /* Last line for replace */ - int lead_trail; /* LEADING/TRAILING flag */ - char *from; /* Old (from) text */ - char *to; /* New (to) text */ -}; - -/* List of skipped lines (conditional compilation) */ -struct list_skip { - struct list_skip *next; - int skipline; /* line number of skipped line */ -}; - -/* Listing file control structure */ -struct list_files { - struct list_files *next; - struct list_files *copy_head; /* COPY book list head */ - struct list_files *copy_tail; /* COPY book list tail */ - struct list_error *err_head; /* Error message list head */ - struct list_replace *replace_head; /* REPLACE list head */ - struct list_replace *replace_tail; /* REPLACE list tail */ - struct list_skip *skip_head; /* Skip list head */ - struct list_skip *skip_tail; /* Skip list tail */ - int copy_line; /* Line start for copy book */ - int listing_on; /* Listing flag for this file */ - enum cb_format source_format; /* source format for file */ - const char *name; /* Name of this file */ -}; - -extern struct list_files *cb_listing_files; -extern struct list_files *cb_current_file; - -extern enum cb_format cb_source_format; -extern int cb_text_column; /* end of area B (in single-byte characters) */ -extern int cb_mf_ibm_comp; -extern int cb_cob_line_num; -extern int cb_all_files_xfd; - -extern struct cb_exception cb_exception_table[]; - -#define CB_EXCEPTION_NAME(id) cb_exception_table[id].name -#define CB_EXCEPTION_CODE(id) cb_exception_table[id].code -#define CB_EXCEPTION_ENABLE(id) cb_exception_table[id].enable - -/* undef macros that are only for internal use with def-files */ - -#undef CB_FLAG -#undef CB_FLAG_ON -#undef CB_FLAG_RQ -#undef CB_FLAG_NQ - -#undef CB_WARNDEF -#undef CB_ONWARNDEF -#undef CB_NOWARNDEF - -#undef CB_OPTIM_DEF - -#undef CB_CONFIG_ANY -#undef CB_CONFIG_INT -#undef CB_CONFIG_SIZE -#undef CB_CONFIG_STRING -#undef CB_CONFIG_BOOLEAN -#undef CB_CONFIG_SUPPORT - -#undef COB_EXCEPTION - - -#define CB_FLAG(var,print_help,name,doc) extern int var; -#define CB_FLAG_ON(var,print_help,name,doc) extern int var; -#define CB_FLAG_RQ(var,print_help,name,def,opt,doc) extern int var; -#define CB_FLAG_NQ(print_help,name,opt,doc) -#include "flag.def" -#undef CB_FLAG -#undef CB_FLAG_ON -#undef CB_FLAG_RQ -#undef CB_FLAG_NQ - -#define CB_WARNDEF(var,name,doc) extern int var; -#define CB_ONWARNDEF(var,name,doc) extern int var; -#define CB_NOWARNDEF(var,name,doc) extern int var; -#define CB_ERRWARNDEF(var,name,doc) extern int var; -#include "warning.def" -#undef CB_WARNDEF -#undef CB_ONWARNDEF -#undef CB_NOWARNDEF -#undef CB_ERRWARNDEF - -#define COBC_WARN_FILLER cb_warn_filler -#define COBC_WARN_DISABLED 0 -#define COBC_WARN_ENABLED 1 -#define COBC_WARN_AS_ERROR 2 - - -#define CB_OPTIM_DEF(x) x, -enum cb_optim { - COB_OPTIM_MIN = 0, -#include "codeoptim.def" - COB_OPTIM_MAX -}; -#undef CB_OPTIM_DEF - -extern int cb_id; -extern int cb_pic_id; -extern int cb_attr_id; -extern int cb_literal_id; -extern int cb_field_id; -extern int cb_ml_attr_id; -extern int cb_ml_tree_id; -extern int cb_flag_functions_all; - -extern int cb_flag_dump; -#define COB_DUMP_FD 0x0001 -#define COB_DUMP_WS 0x0002 -#define COB_DUMP_RD 0x0004 -#define COB_DUMP_SD 0x0008 -#define COB_DUMP_SC 0x0010 -#define COB_DUMP_LS 0x0020 -#define COB_DUMP_ALL (COB_DUMP_FD|COB_DUMP_WS|COB_DUMP_RD|COB_DUMP_SD|COB_DUMP_SC|COB_DUMP_LS) - - -extern int cb_unix_lf; - -extern int cb_flag_main; /* set if "main" requested by -x */ -extern int cobc_flag_main; /* set only until first program compiled, for general: use cb_flag_main*/ -extern int cobc_wants_debug; -extern int cb_listing_xref; -extern int cobc_seen_stdin; - -extern int errorcount; -extern int warningcount; -extern int no_physical_cancel; -extern cob_u32_t optimize_defs[]; - -extern const char *cb_cobc_build_stamp; -extern const char *cb_source_file; -extern int cb_source_line; -extern const char *cb_call_extfh; - -extern struct cob_time current_compile_time; -extern struct tm current_compile_tm; - -extern const char *cob_config_dir; -extern const char *cob_schema_dir; -extern const char *cb_sqldb_name; -extern const char *cb_sqldb_schema; - -extern unsigned int cobc_gen_listing; - -extern const char *demangle_name; -extern FILE *cb_storage_file; -extern const char *cb_storage_file_name; - -extern char **cb_saveargv; -extern int cb_saveargc; - -extern FILE *cb_listing_file; -extern FILE *cb_src_list_file; -extern struct cb_text_list *cb_include_list; -extern struct cb_text_list *cb_intrinsic_list; -extern struct cb_text_list *cb_extension_list; -extern struct cb_text_list *cb_static_call_list; -extern struct cb_text_list *cb_early_exit_list; - -extern struct cb_program *current_program; -extern struct cb_statement *current_statement; -extern struct cb_label *current_section; -extern struct cb_label *current_paragraph; -extern int cb_exp_line; -extern int functions_are_all; -extern struct cb_tree_common *defined_prog_list; -extern int current_call_convention; -extern struct cb_field *external_defined_fields_ws; -extern struct cb_field *external_defined_fields_global; - -/* Functions */ - -/* cobc.c */ - -extern struct reserved_word_list *cob_user_res_list; - -extern void *cobc_malloc (const size_t); -extern void cobc_free (void *); -extern void *cobc_strdup (const char *); -extern void *cobc_realloc (void *, const size_t); - -extern void *cobc_main_malloc (const size_t); -extern void *cobc_main_strdup (const char *); -extern void *cobc_main_realloc (void *, const size_t); -extern void cobc_main_free (void *); - -extern void *cobc_parse_malloc (const size_t); -extern void *cobc_parse_strdup (const char *); -extern void *cobc_parse_realloc (void *, const size_t); -extern void cobc_parse_free (void *); - -extern void *cobc_plex_malloc (const size_t); -extern void *cobc_plex_strdup (const char *); - -extern void *cobc_check_string (const char *); -extern void cobc_err_msg (const char *, ...) COB_A_FORMAT12; - -DECLNORET extern void cobc_abort (const char *, - const int) COB_A_NORETURN; -DECLNORET extern void cobc_too_many_errors (void) COB_A_NORETURN; - -extern size_t cobc_check_valid_name (const char *, - const enum cobc_name_type); - -/* help.c (used only within cobc.c) */ - -extern void cobc_print_usage (char *); -extern void cobc_print_usage_common_options (void); -extern void cobc_print_usage_dialect (void); -extern void cobc_print_usage_warnings (void); -extern void cobc_print_usage_flags (void); - -/* config.c */ - -#define CB_CONFIG_ANY(type,var,name,doc) \ -extern type var; -#define CB_CONFIG_INT(var,name,min,max,odoc,doc) \ -extern unsigned int var; -#define CB_CONFIG_SIZE(var,name,min,max,odoc,doc) \ -extern unsigned long var; -#define CB_CONFIG_STRING(var,name,doc) \ -extern const char *var; -#define CB_CONFIG_BOOLEAN(var,name,doc) \ -extern int var; -#define CB_CONFIG_SUPPORT(var,name,doc) \ -extern enum cb_support var; - -#include "config.def" - -#undef CB_CONFIG_ANY -#undef CB_CONFIG_INT -#undef CB_CONFIG_SIZE -#undef CB_CONFIG_STRING -#undef CB_CONFIG_BOOLEAN -#undef CB_CONFIG_SUPPORT - -extern int cb_load_std (const char *); -extern int cb_config_entry (char *, const char *, const int); -extern int cb_load_conf (const char *, const int); -extern int cb_load_words (void); - -#ifndef HAVE_DESIGNATED_INITS -/* Initialization routines in typeck.c and reserved.c */ -extern void cobc_init_typeck (void); -extern void cobc_init_reserved (void); -#endif - -/* preprocessor (in pplex.l, ppparse.y) */ -#if !defined (COB_IN_SCANNER ) && !defined (COB_IN_PPLEX) -extern FILE *ppin; -extern FILE *ppout; -extern int pplex (void); -#endif - -#ifndef COB_IN_PPPARSE -extern int ppparse (void); -#endif - -extern int ppopen (const char *, struct cb_replace_list *); -extern int ppcopy (const char *, const char *, - struct cb_replace_list *); -extern void pp_set_replace_list (struct cb_replace_list *, - const cob_u32_t); -extern void ppparse_error (const char *); -extern void ppparse_clear_vars (const struct cb_define_struct *); -extern struct cb_define_struct *ppp_search_lists (const char *name); -extern void ppp_clear_lists (void); -extern void plex_clear_vars (void); -extern void plex_clear_all (void); -extern void plex_call_destroy (void); -extern void plex_action_directive (const unsigned int, - const unsigned int); - -/* parser (in scanner.l, parser.y) */ -#if !defined (COB_IN_SCANNER ) && !defined (COB_IN_PPLEX) && \ - !defined (COB_IN_PPPARSE) -extern FILE *yyin; -extern FILE *yyout; -extern int yylex (void); -#endif - -#if !defined (COB_IN_PPPARSE) && !defined (COB_IN_PARSER) -extern int yyparse (void); -#endif - -extern void ylex_clear_all (void); -extern void ylex_call_destroy (void); - -/* typeck.c */ -extern size_t suppress_warn; /* no warnings for internal generated stuff */ - -/* codeoptim.c */ -extern void cob_gen_optim (const enum cb_optim); - -/* codegen.c */ -extern void cb_init_codegen (void); - -/* error.c */ -#define CB_MSG_STYLE_GCC 0 -#define CB_MSG_STYLE_MSC 1U - -#define CB_PENDING(x) \ - do { cb_warning (cb_warn_pending, _("%s is not implemented"), x); } ONCE_COB -#define CB_PENDING_X(x,y) \ - do { cb_warning_x (cb_warn_pending, x, _("%s is not implemented"), y); } ONCE_COB -#define CB_UNFINISHED(x) \ - do { cb_warning (cb_warn_unfinished, \ - _("handling of %s is unfinished; implementation is likely to be changed"), x); \ - } ONCE_COB -#define CB_UNFINISHED_X(x,y) \ - do { cb_warning_x (cb_warn_unfinished, x, \ - _("handling of %s is unfinished; implementation is likely to be changed"), y); \ - } ONCE_COB - -extern size_t cb_msg_style; - -extern void cb_warning (int, const char *, ...) COB_A_FORMAT23; -extern void cb_error (const char *, ...) COB_A_FORMAT12; -extern void cb_error_always (const char *, ...) COB_A_FORMAT12; -extern void cb_perror (const int, const char *, ...) COB_A_FORMAT23; -extern void cb_plex_warning (int, const size_t, - const char *, ...) COB_A_FORMAT34; -extern void cb_plex_error (const size_t, - const char *, ...) COB_A_FORMAT23; -extern unsigned int cb_plex_verify (const size_t, const enum cb_support, - const char *); -extern void configuration_warning (const char *, const int, - const char *, ...) COB_A_FORMAT34; -extern void configuration_error (const char *, const int, - const int, const char *, ...) COB_A_FORMAT45; -extern char * cb_get_strerror (void); -extern void cb_add_error_to_listing (const char *, int, const char *, char *); -DECLNORET extern void flex_fatal_error (const char *, const char *, - const int) COB_A_NORETURN; - -/* reserved.c */ -extern struct reserved_word_list *cobc_user_res_list; - -extern void remove_reserved_word (const char *, const char *, const int); -extern void add_reserved_word (const char *, const char *, const int); -extern void remove_reserved_word_now (char * const); -extern void add_reserved_word_now (char * const, char * const); - -extern void remove_register (const char *, const char *, const int); -extern void add_register (const char *, const char *, const int); - -extern void deactivate_intrinsic (const char *, const char *, const int); -extern void activate_intrinsic (const char *, const char *, const int); - -extern void deactivate_system_name (const char *, const char *, const int); -extern void activate_system_name (const char *, const char *, const int); - -#endif /* CB_COBC_H */ diff -Nru gnucobol-4.0~early~20200606/cobc/codegen.c gnucobol-5/cobc/codegen.c --- gnucobol-4.0~early~20200606/cobc/codegen.c 2020-06-06 20:51:59.000000000 +0000 +++ gnucobol-5/cobc/codegen.c 1970-01-01 00:00:00.000000000 +0000 @@ -1,12913 +0,0 @@ -/* - Copyright (C) 2003-2020 Free Software Foundation, Inc. - Written by Keisuke Nishida, Roger While, Ron Norman, Simon Sobisch, - Edward Hart - - This file is part of GnuCOBOL. - - The GnuCOBOL compiler is free software: you can redistribute it - and/or modify it under the terms of the GNU General Public License - as published by the Free Software Foundation, either version 3 of the - License, or (at your option) any later version. - - GnuCOBOL is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with GnuCOBOL. If not, see . -*/ - - -#include - -#include -#include -#include -#include -#include -#include -#include -#include - -#include "tarstamp.h" - -#include "cobc.h" -#include "tree.h" - -#if !defined(COB_ALIGN_KNOWN) && !defined(COB_ALLOW_UNALIGNED) -#error System requires data alignment which is unknown -#endif - -#define COB_MAX_SUBSCRIPTS 16 - -#define COB_MALLOC_ALIGN 15 - -#define COB_INSIDE_SIZE 64 - -#define INITIALIZE_NONE 0 -#define INITIALIZE_ONE 1 -#define INITIALIZE_DEFAULT 2 -#define INITIALIZE_COMPOUND 3 - -#define CB_NEED_HIGH (1U << 0) -#define CB_NEED_LOW (1U << 1) -#define CB_NEED_QUOTE (1U << 2) -#define CB_NEED_SPACE (1U << 3) -#define CB_NEED_ZERO (1U << 4) - -struct sort_list { - struct sort_list *next; -}; - -struct system_table { - const char *syst_name; - const char *syst_call; - const unsigned int syst_max_params; -}; - -struct label_list { - struct label_list *next; - int id; - int call_num; -}; - -struct string_list { - struct string_list *next; - char *text; - int id; -}; - -struct pic_list { - struct pic_list *next; - const cob_pic_symbol *str; - int length; - int id; -}; - -struct attr_list { - struct attr_list *next; - int pic_id; - int id; - int type; - cob_u32_t digits; - int scale; - cob_u32_t flags; -}; - -struct literal_list { - struct literal_list *next; - struct cb_literal *literal; - cb_tree x; - int id; - int make_decimal; -}; - -struct field_list { - struct field_list *next; - struct cb_field *f; - cb_tree x; - const char *curr_prog; -}; - -struct call_list { - struct call_list *next; - const char *call_name; -}; - -#define COB_RETURN_INT 0 -#define COB_RETURN_ADDRESS_OF 1 -#define COB_RETURN_NULL 2 -struct static_call_list { - struct static_call_list *next; - const char *call_name; - int convention; - int return_type; -}; - -struct base_list { - struct base_list *next; - struct cb_field *f; - const char *curr_prog; -}; - - -/* Local variables */ - -static struct pic_list *pic_cache = NULL; -static struct attr_list *attr_cache = NULL; -static struct literal_list *literal_cache = NULL; -static struct field_list *field_cache = NULL; -static struct field_list *local_field_cache = NULL; -static struct call_list *call_cache = NULL; -static struct call_list *func_call_cache = NULL; -static struct static_call_list *static_call_cache = NULL; -static struct base_list *base_cache = NULL; -static struct base_list *globext_cache = NULL; -static struct base_list *local_base_cache = NULL; -static struct string_list *string_cache = NULL; -static struct string_list *source_cache = NULL; -static char *string_buffer = NULL; -static struct label_list *label_cache = NULL; -static struct ml_tree_list *ml_tree_cache = NULL; - - -static FILE *output_target = NULL; -static char *output_name = NULL; -static unsigned int output_line_number = 0; -static FILE *cb_local_file = NULL; -static const char *excp_current_program_id = NULL; -static const char *excp_current_section = NULL; -static const char *excp_current_paragraph = NULL; -static struct cb_program *current_prog = NULL; -static struct cb_program *recent_prog = NULL; - -static struct cb_label *last_section = NULL; -static unsigned char *litbuff = NULL; -static int litsize = 0; - -static unsigned int has_global_file = 0; -static unsigned int needs_exit_prog = 0; -static unsigned int needs_unifunc = 0; -static unsigned int need_save_exception = 0; -static unsigned int gen_nested_tab = 0; -static unsigned int gen_alt_ebcdic = 0; -static unsigned int gen_ebcdic_ascii = 0; -static unsigned int gen_full_ebcdic = 0; -static unsigned int gen_native = 0; -static unsigned int gen_custom = 0; -static unsigned int gen_figurative = 0; -static unsigned int gen_dynamic = 0; -static char last_line_num[80] = ""; -static int skip_line_num = 0; -static int report_field_id = 0; -static int generate_id = 0; -static int generate_bgn_lbl = -1; - -static int param_id = 0; -static int stack_id = 0; -static int string_id = 1; -static int source_id = 1; -static int num_cob_fields = 0; -static int non_nested_count = 0; -static int loop_counter = 0; -static int progid = 0; -static int last_line = 0; -static cob_u32_t field_iteration = 0; -static int screenptr = 0; -static int local_mem = 0; -static int working_mem = 0; -static int local_working_mem = 0; -static int output_indent_level = 0; -static int last_segment = 0; -static int gen_init_working = 0; -static int need_plus_sign = 0; -static int odo_stop_now = 0; -static int gen_num_lit_big_end = 1; -static unsigned int nolitcast = 0; - -static unsigned int inside_check = 0; -static unsigned int inside_stack[COB_INSIDE_SIZE]; - -static unsigned int i_counters[COB_MAX_SUBSCRIPTS]; -static const cob_s64_t cob_exp10_ll[19] = { - COB_S64_C(1), - COB_S64_C(10), - COB_S64_C(100), - COB_S64_C(1000), - COB_S64_C(10000), - COB_S64_C(100000), - COB_S64_C(1000000), - COB_S64_C(10000000), - COB_S64_C(100000000), - COB_S64_C(1000000000), - COB_S64_C(10000000000), - COB_S64_C(100000000000), - COB_S64_C(1000000000000), - COB_S64_C(10000000000000), - COB_S64_C(100000000000000), - COB_S64_C(1000000000000000), - COB_S64_C(10000000000000000), - COB_S64_C(100000000000000000), - COB_S64_C(1000000000000000000) -}; - -#undef COB_SYSTEM_GEN -#define COB_SYSTEM_GEN(cob_name, pmin, pmax, c_name) { cob_name, #c_name, pmax }, - -static const struct system_table system_tab[] = { -#include "libcob/system.def" - { NULL, NULL, 0 } -}; - -#undef COB_SYSTEM_GEN - -/* Declarations */ -static void output (const char *, ...) COB_A_FORMAT12; -static void output_line (const char *, ...) COB_A_FORMAT12; -static void output_storage (const char *, ...) COB_A_FORMAT12; -static void output_local (const char *, ...) COB_A_FORMAT12; - -static int out_odoslide_grp_offset (struct cb_field *p, struct cb_field *fld); -static void out_odoslide_grp_size (struct cb_field *p, struct cb_field *fld); - -static void output_stmt (cb_tree); -static void output_integer (cb_tree); -static void output_index (cb_tree); -static void output_func_1 (const char *, cb_tree); -static void output_param (cb_tree, int); -static void output_funcall (cb_tree); -static void output_report_summed_field (struct cb_field *); - -/* Local functions */ - -static struct cb_field * -cb_code_field (cb_tree x) -{ - if (likely(CB_REFERENCE_P (x))) { - if (unlikely(!CB_REFERENCE (x)->value)) { - return CB_FIELD (cb_ref (x)); - } - return CB_FIELD (CB_REFERENCE (x)->value); - } - if (CB_LIST_P (x)) { - return cb_code_field (CB_VALUE (x)); - } - return CB_FIELD (x); -} - -static int -lookup_string (const char *p) -{ - struct string_list *stp; - - for (stp = string_cache; stp; stp = stp->next) { - if (strcmp (p, stp->text) == 0) { - return stp->id; - } - } - stp = cobc_parse_malloc (sizeof (struct string_list)); - stp->text = cobc_parse_strdup (p); - stp->id = string_id; - stp->next = string_cache; - string_cache = stp; - return string_id++; -} - -static int -lookup_source (const char *p) -{ - struct string_list *stp; - - for (stp = source_cache; stp; stp = stp->next) { - if (strcmp (p, stp->text) == 0) { - return stp->id; - } - } - stp = cobc_parse_malloc (sizeof (struct string_list)); - stp->text = cobc_parse_strdup (p); - stp->id = source_id; - stp->next = source_cache; - source_cache = stp; - return source_id++; -} - -static void -lookup_call (const char *p) -{ - struct call_list *clp; - - for (clp = call_cache; clp; clp = clp->next) { - if (strcmp (p, clp->call_name) == 0) { - return; - } - } - clp = cobc_parse_malloc (sizeof (struct call_list)); - clp->call_name = p; - clp->next = call_cache; - call_cache = clp; -} - -static void -lookup_func_call (const char *p) -{ - struct call_list *clp; - - for (clp = func_call_cache; clp; clp = clp->next) { - if (strcmp (p, clp->call_name) == 0) { - return; - } - } - clp = cobc_parse_malloc (sizeof (struct call_list)); - clp->call_name = p; - clp->next = func_call_cache; - func_call_cache = clp; -} - -static void -lookup_static_call (const char *p, int convention, int return_type) -{ - struct static_call_list *sclp; - - for (sclp = static_call_cache; sclp; sclp = sclp->next) { - if (strcmp (p, sclp->call_name) == 0) { - return; - } - } - sclp = cobc_parse_malloc (sizeof (struct static_call_list)); - sclp->call_name = p; - sclp->convention = convention; - sclp->return_type = return_type; - sclp->next = static_call_cache; - static_call_cache = sclp; -} - -#define LIST_REVERSE_FUNC(list_struct) \ - static struct list_struct * \ - list_struct##_reverse (struct list_struct *p) \ - { \ - struct list_struct *next; \ - struct list_struct *last; \ - \ - last = NULL; \ - for (; p; p = next) { \ - next = p->next; \ - p->next = last; \ - last = p; \ - } \ - return last; \ - } - -LIST_REVERSE_FUNC (call_list) -LIST_REVERSE_FUNC (static_call_list) -LIST_REVERSE_FUNC (pic_list) -LIST_REVERSE_FUNC (attr_list) -LIST_REVERSE_FUNC (string_list) -LIST_REVERSE_FUNC (literal_list) - -static int field_cache_cmp (const void *mp1, const void *mp2) -{ - const struct field_list *fl1; - const struct field_list *fl2; - int ret; - - fl1 = (const struct field_list *)mp1; - fl2 = (const struct field_list *)mp2; - ret = strcasecmp (fl1->curr_prog, fl2->curr_prog); - if (ret) { - return ret; - } - return fl1->f->id - fl2->f->id; -} - -static int base_cache_cmp (const void *mp1, const void *mp2) -{ - const struct base_list *fl1; - const struct base_list *fl2; - - fl1 = (const struct base_list *)mp1; - fl2 = (const struct base_list *)mp2; - return fl1->f->id - fl2->f->id; -} - -/* Sort a structure linked list in place */ -/* Assumed that pointer "next" is first item in structure */ - -static void * -list_cache_sort (void *inlist, int (*cmpfunc)(const void *mp1, const void *mp2)) -{ - struct sort_list *p; - struct sort_list *q; - struct sort_list *e; - struct sort_list *tail; - struct sort_list *list; - size_t insize; - size_t nmerges; - size_t psize; - size_t qsize; - size_t i; - - if (!inlist) { - return NULL; - } - list = (struct sort_list *)inlist; - insize = 1; - for (;;) { - p = list; - list = NULL; - tail = NULL; - nmerges = 0; - while (p) { - nmerges++; - q = p; - psize = 0; - for (i = 0; i < insize; i++) { - psize++; - q = q->next; - if (!q) { - break; - } - } - qsize = insize; - while (psize > 0 || (qsize > 0 && q)) { - if (psize == 0) { - e = q; - q = q->next; - if (qsize) { - qsize--; - } - } else if (qsize == 0 || !q) { - e = p; - p = p->next; - if (psize) { - psize--; - } - } else if ((*cmpfunc) (p, q) <= 0) { - e = p; - p = p->next; - if (psize) { - psize--; - } - } else { - e = q; - q = q->next; - if (qsize) { - qsize--; - } - } - if (tail) { - tail->next = e; - } else { - list = e; - } - tail = e; - } - p = q; - } - if (tail) tail->next = NULL; - if (nmerges <= 1) { - return (void *)list; - } - insize *= 2; - } -} - -/* Clear local variables */ -void -cb_init_codegen (void) -{ - attr_cache = NULL; - base_cache = NULL; - call_cache = NULL; - field_cache = NULL; - func_call_cache = NULL; - globext_cache = NULL; - label_cache = NULL; - literal_cache = NULL; - local_base_cache = NULL; - local_field_cache = NULL; - static_call_cache = NULL; - string_buffer = NULL; - string_cache = NULL; - ml_tree_cache = NULL; -} - -/* Output routines */ - -static void -increase_output_line () -{ - if (output_target == yyout) { - output_line_number++; - if (skip_line_num > 0) - skip_line_num--; - else - if (last_line_num[0] > ' ' - && cb_cob_line_num) - fprintf (output_target, "%s\n", last_line_num); - } -} - -/* output parts of a line to current target, - should not contain any "\n" */ -static void -output (const char *fmt, ...) -{ - va_list ap; - int ln = strlen(fmt); - - if (output_target) { - va_start (ap, fmt); - vfprintf (output_target, fmt, ap); - va_end (ap); - if (fmt[ln-1] == '\n') - increase_output_line (); - } -} - -/* output a new line to current target */ -static void -output_newline (void) -{ - if (output_target) { - fputc ('\n', output_target); - increase_output_line (); - } -} - -/* output indentation prefix depending on current level - to current target */ -static void -output_prefix (void) -{ - int i; - - if (output_target) { - for (i = 0; i < output_indent_level; i++) { - fputc (' ', output_target); - } - } -} - -/* output a complete line with given data to current target, - should not include additional "\n" */ -static void -output_line (const char *fmt, ...) -{ - va_list ap; - - if (output_target) { - output_prefix (); - va_start (ap, fmt); - vfprintf (output_target, fmt, ap); - va_end (ap); - fputc ('\n', output_target); - increase_output_line (); - } -} - -static const int indent_adjust_level = 2; - -/* output a block opening to current target, adjusting the - current indentation level */ -static void -output_block_open (void) -{ - if (output_target) { - output_prefix (); - fputc ('{', output_target); - fputc ('\n', output_target); - skip_line_num++; - increase_output_line (); - } - output_indent_level += indent_adjust_level; -} - -/* output a block close to current target, adjusting the - current indentation level */ -static void -output_block_close (void) -{ - output_indent_level -= indent_adjust_level; - if (output_target) { - output_prefix (); - fputc ('}', output_target); - fputc ('\n', output_target); - increase_output_line (); - } -} - -/* output string to current target, "*s" should not contain any "\n" */ -static void -output_string (const unsigned char *s, const int size, const cob_u32_t llit) -{ - int i; - int c; - - if (!s) { - output ("NULL"); - return; - } - output ("\""); - for (i = 0; i < size; i++) { - c = s[i]; -#ifndef COB_EBCDIC_MACHINE - if (c >= 0x7F) { - output ("\\%03o", c); - } else -#endif - if (!isprint (c)) { - output ("\\%03o", c); - } else if (c == '\"') { - output ("\\%c", c); - } else if ((c == '\\' || c == '?') && !llit) { - output ("\\%c", c); - } else { - output ("%c", c); - } - } - output ("\""); -} - -/* output data to current storage include file */ -static void -output_storage (const char *fmt, ...) -{ - va_list ap; - - if (cb_storage_file) { - va_start (ap, fmt); - vfprintf (cb_storage_file, fmt, ap); - va_end (ap); - } -} - -/* output data to current local include file */ -static void -output_local (const char *fmt, ...) -{ - va_list ap; - - if (cb_local_file) { - va_start (ap, fmt); - vfprintf (cb_local_file, fmt, ap); - va_end (ap); - } -} - -/* Field */ - -static struct cb_field * -real_field_founder (const struct cb_field *f) -{ - while (f->parent) { - f = f->parent; - } - if (f->redefines) { - f = f->redefines; - } - return (struct cb_field *)f; -} - -struct cb_field * -chk_field_variable_size (struct cb_field *f) -{ - struct cb_field *p; - struct cb_field *fc; - - if (f->flag_vsize_done) { - return f->vsize; - } - for (fc = f->children; fc; fc = fc->sister) { - if (fc->depending) { - f->vsize = fc; - f->flag_vsize_done = 1; - return fc; - } else if ((p = chk_field_variable_size (fc)) != NULL) { - return p; - } - } - f->vsize = NULL; - f->flag_vsize_done = 1; - return NULL; -} - -/* Check if previous field on current or higher level has variable size */ -unsigned int -chk_field_variable_address (struct cb_field *fld) -{ - struct cb_field *p; - struct cb_field *f; - - if (fld->flag_vaddr_done) { - return fld->vaddr; - } - f = fld; - for (p = f->parent; p; f = f->parent, p = f->parent) { - for (p = p->children; p != f; p = p->sister) { - if (p->depending || chk_field_variable_size (p)) { - fld->vaddr = 1; - fld->flag_vaddr_done = 1; - return 1; - } - } - } - fld->vaddr = 0; - fld->flag_vaddr_done = 1; - return 0; -} - -/* - * Output field offset from base, handle DEPENDING ON with 'odoslide' - */ -static int -out_odoslide_fld_offset (struct cb_field *p, struct cb_field *fld) -{ - - if (p == fld) /* Single field */ - return 1; - - if (p->children) { - if (out_odoslide_grp_offset (p, fld)) - return 1; - } else { - if (need_plus_sign) { - output ("+"); - need_plus_sign = 0; - } - if (p->depending) { - if (p->size != 1) { - output ("%d*", p->size); - } - output_integer (p->depending); - } else if (p->occurs_max > 1) { - output ("%d", p->size * p->occurs_max); - } else { - output ("%d", p->size); - } - } - return 0; -} - -static int -out_odoslide_grp_offset (struct cb_field *p, struct cb_field *fld) -{ - struct cb_field *f; - int found_it; - int add_size; - - if (p == fld - || odo_stop_now) { - return 1; - } - if (p->children) { - for (f = p->children; f; f = f->children) { - if (f == fld) { - need_plus_sign = 0; - odo_stop_now = 1; - return 1; - } - } - if (need_plus_sign) { - output ("+"); - need_plus_sign = 0; - } - found_it = 0; - f = p->children; - if (f->sister == NULL - && f->children == NULL - && f->depending == NULL) { - found_it = out_odoslide_fld_offset (f, fld); - } else { - output ("("); - add_size = 0; - for (f = p->children; f; f = f->sister) { - if (f == fld) { - found_it = 1; - if (add_size > 0) { - if (need_plus_sign) { - output ("+"); - need_plus_sign = 0; - } - output ("%d",add_size); - add_size = 0; - } - output (")"); - return 1; - } - if (f != fld - && f->depending == NULL - && f->sister != NULL - && f->children == NULL) { - if (f->occurs_max > 1) { - add_size += (f->size * f->occurs_max); - } else { - add_size += f->size; - } - continue; - } - if (add_size > 0) { - if (need_plus_sign) { - output ("+"); - need_plus_sign = 0; - } - output ("%d",add_size); - add_size = 0; - need_plus_sign = 1; - } - found_it = out_odoslide_fld_offset (f, fld); - if (found_it) - break; - need_plus_sign = 1; - } - need_plus_sign = 0; - output (")"); - if (found_it) - return 1; - } - if (odo_stop_now) - return 1; - if (p->depending) { - output ("*"); - output_integer (p->depending); - } else if (p->occurs_max > 1) { - output ("*%d", p->occurs_max); - } - if (found_it) - return 1; - } else { - if (out_odoslide_fld_offset (p, fld)) - return 1; - } - return 0; -} - -static void -out_odoslide_offset (struct cb_field *f01, struct cb_field *fld) -{ - need_plus_sign = 1; - odo_stop_now = 0; - out_odoslide_fld_offset (f01, fld); -} - -/* - * Output field size, handle DEPENDING ON with 'odoslide' - */ -static void -out_odoslide_fld_size (struct cb_field *p, struct cb_field *fld) -{ - if (p->children) { - out_odoslide_grp_size (p, fld); - } else { - if (p->depending) { - if (p->size != 1) { - output ("%d*", p->size); - } - output_integer (p->depending); - } else if (p->occurs_max > 1) { - output ("%d", p->size * p->occurs_max); - } else { - output ("%d", p->size); - } - } -} - -static void -out_odoslide_grp_size (struct cb_field *p, struct cb_field *fld) -{ - struct cb_field *f; - int add_size; - - if (p->children) { - need_plus_sign = 0; - f = p->children; - if (f->sister == NULL - && f->children == NULL - && f->depending == NULL) { - out_odoslide_fld_size (f, fld); - } else { - output ("("); - add_size = 0; - for (f = p->children; f; f = f->sister) { - if (need_plus_sign) { - output ("+"); - need_plus_sign = 0; - } - if (f != fld - && f->depending == NULL - && f->sister != NULL - && f->children == NULL) { - if (f->occurs_max > 1) { - add_size += (f->size * f->occurs_max); - } else { - add_size += f->size; - } - continue; - } - if (add_size > 0) { - if (need_plus_sign) { - output ("+"); - } - output ("%d+",add_size); - add_size = 0; - need_plus_sign = 0; - } - out_odoslide_fld_size (f, fld); - need_plus_sign = 1; - } - output (")"); - } - need_plus_sign = 0; - if (p == fld) { - return; - } - if (p->depending) { - output ("*"); - output_integer (p->depending); - } else if (p->occurs_max > 1) { - output ("*%d", p->occurs_max); - } - } else { - out_odoslide_fld_size (p, fld); - } -} - -static void -out_odoslide_size (struct cb_field *fld) -{ - need_plus_sign = 0; - out_odoslide_fld_size (fld, fld); -} - -static void -output_base (struct cb_field *f, const cob_u32_t no_output) -{ - struct cb_field *f01; - struct cb_field *p; - struct cb_field *v; - struct base_list *bl; - - /* LCOV_EXCL_START */ - if (unlikely(f->flag_item_78)) { - cobc_err_msg (_("unexpected CONSTANT item")); - COBC_ABORT (); - } - /* LCOV_EXCL_STOP */ - - f01 = real_field_founder (f); - - /* Base storage */ - - if (!f01->flag_base) { - if (f01->index_type == CB_INT_INDEX) { - bl = cobc_parse_malloc (sizeof (struct base_list)); - bl->f = f01; - bl->curr_prog = excp_current_program_id; - bl->next = local_base_cache; - local_base_cache = bl; - } else if (!f01->flag_external && !f01->flag_local_storage) { - if (!f01->flag_local || f01->flag_is_global) { - bl = cobc_parse_malloc (sizeof (struct base_list)); - bl->f = f01; - bl->curr_prog = excp_current_program_id; - if (f01->flag_is_global - || current_prog->flag_file_global) { - bl->next = base_cache; - base_cache = bl; - } else { - bl->next = local_base_cache; - local_base_cache = bl; - } - } else { - if (current_prog->flag_global_use) { - output_local ("unsigned char\t\t*%s%d = NULL;", - CB_PREFIX_BASE, f01->id); - output_local ("\t/* %s */\n", f01->name); - output_local ("static unsigned char\t*save_%s%d;\n", - CB_PREFIX_BASE, f01->id); - } else { - output_local ("unsigned char\t*%s%d = NULL;", - CB_PREFIX_BASE, f01->id); - output_local ("\t/* %s */\n", f01->name); - } - } - } - f01->flag_base = 1; - } - if (no_output) { - return; - } - - if (f01->index_type != CB_NORMAL_INDEX) { - output ("(cob_u8_t *)&%s%d", CB_PREFIX_BASE, f01->id); - return; - } else if (f01->flag_local_storage) { - if (f01->mem_offset) { - output ("cob_local_ptr + %d", f01->mem_offset); - } else { - output ("cob_local_ptr"); - } - } else if (f01->flag_data_set) { - /* cob_field.data is set upon entry so use that here */ - output ("%s%d.data", CB_PREFIX_FIELD, f01->id); - } else { - output ("%s%d", CB_PREFIX_BASE, f01->id); - } - - if (!gen_init_working - && chk_field_variable_address (f)) { - if (f01->level == 0 - && f01->sister - && strstr (f01->name, " Record")) { /* Skip to First 01 within FD */ - f01 = f01->sister; - } - if (cb_flag_odoslide) { - out_odoslide_offset (f01, f); - } else { - for (p = f->parent; p; f = f->parent, p = f->parent) { - for (p = p->children; p != f; p = p->sister) { - v = chk_field_variable_size (p); - if (v) { - output (" + %d + ", v->offset - p->offset); - if (v->size != 1) { - output ("%d * ", v->size); - } - output_integer (v->depending); - } else { - output (" + %d", p->size * p->occurs_max); - } - } - } - } - } else if (f->offset > 0) { - output (" + %d", f->offset); - } -} - -static int -is_index_1 (cb_tree x) -{ - switch (CB_TREE_TAG (x)) { - case CB_TAG_INTEGER: - if (CB_INTEGER (x)->val == 1) { - return 1; - } - break; - case CB_TAG_LITERAL: - if (cb_get_int (x) == 1) { - return 1; - } - break; - default: - return 0; - } - return 0; -} - -static void -output_data (cb_tree x) -{ - switch (CB_TREE_TAG (x)) { - case CB_TAG_LITERAL: { - struct cb_literal *l = CB_LITERAL (x); - if (CB_TREE_CLASS (x) == CB_CLASS_NUMERIC) { - output ("(cob_u8_ptr)\"%s%s\"", - (l->sign < 0) ? "-" : (l->sign > 0) ? "+" : "", - (char *)l->data); - } else { - output ("(cob_u8_ptr)"); - output_string (l->data, (int) l->size, l->llit); - } - break; - } - case CB_TAG_FIELD: { - struct cb_field *f = CB_FIELD (x); - output("/* %s */",f->name); - /* Base address */ - output_base (f, 0); - break; - } - case CB_TAG_REFERENCE: { - struct cb_reference *r = CB_REFERENCE (x); - struct cb_field *f = CB_FIELD (r->value); - - /* Base address */ - output_base (f, 0); - - /* Subscripts */ - if (r->subs) { - struct cb_field *o_slide = NULL; - struct cb_field *o = f; - cb_tree lsub = r->subs; - for (; f && lsub; f = f->parent) { - /* add current field size for OCCURS */ - if (f->flag_occurs) { - /* 1 - 1 is 0 so skip it */ - if (is_index_1 (CB_VALUE (lsub)) ) { - lsub = CB_CHAIN (lsub); - continue; - } - - if (cb_flag_odoslide - && !gen_init_working - && f != o - && chk_field_variable_size(f)) { - output (" + "); - out_odoslide_size (f); - output (" * "); - } else { - /* recalculate size for nested ODO ... */ - if (unlikely(o_slide)) { - for (o = o_slide; o; o = o->children) { - if (o->depending) { - output (" + (%d * ", o->size); - output_integer (o->depending); - output (")"); - } - } - output (" * "); - } else { - /* ... use field size otherwise */ - output (" + "); - if (f->size != 1) { - output ("%d * ", f->size); - } - } - if (cb_flag_odoslide - && !gen_init_working - && f->depending) { - o_slide = f; - } - } - - output_index (CB_VALUE (lsub)); - lsub = CB_CHAIN (lsub); - } - } - } - - /* Offset */ - if (r->offset) { - output (" + "); - output_index (r->offset); - } - break; - } - case CB_TAG_CAST: - output ("&"); - output_param (x, 0); - break; - case CB_TAG_INTRINSIC: - output ("cob_procedure_params[%u]->data", - field_iteration); - break; - case CB_TAG_CONST: - /* LCOV_EXCL_START */ - if (x != cb_null) { - cobc_err_msg (_("unexpected tree tag: %d"), (int)CB_TREE_TAG (x)); - COBC_ABORT (); - } - /* LCOV_EXCL_STOP */ - output ("NULL"); - break; - /* LCOV_EXCL_START */ - default: - cobc_err_msg (_("unexpected tree tag: %d"), (int)CB_TREE_TAG (x)); - COBC_ABORT (); - /* LCOV_EXCL_STOP */ - } -} - -static void -output_size (const cb_tree x) -{ - struct cb_literal *l; - struct cb_reference *r; - struct cb_field *f; - struct cb_field *p; - struct cb_field *q; - - switch (CB_TREE_TAG (x)) { - case CB_TAG_CONST: - output ("1"); - break; - case CB_TAG_LITERAL: - l = CB_LITERAL (x); - output ("%d", (int)(l->size + (l->sign != 0))); - break; - case CB_TAG_REFERENCE: - r = CB_REFERENCE (x); - f = CB_FIELD (r->value); - if (f->flag_no_field) { - output ("0"); - break; - } - if (r->length) { - output_integer (r->length); - break; - } - if (r->offset && !chk_field_variable_size (f)) { - if (f->flag_any_length) { - output ("%s%d.size - ", CB_PREFIX_FIELD, f->id); - } else { - output ("%d - ", f->size); - } - output_index (r->offset); - break; - } - if (chk_field_variable_size (f) - && (cb_flag_odoslide - || f->flag_local - || f->flag_item_based - || f->storage == CB_STORAGE_LINKAGE) - && !gen_init_working) { - out_odoslide_size (f); - } else { - p = chk_field_variable_size (f); - q = f; -again: - if ((!cb_flag_odoslide || gen_init_working) - && p - && p->flag_odo_relative) { - q = p; - output ("%d", p->size * p->occurs_max); - } else if (p && (!r->flag_receiving || - !cb_field_subordinate (cb_code_field (p->depending), q))) { - if (p->offset - q->offset > 0) { - output ("%d + ", p->offset - q->offset); - } - if (p->size != 1) { - output ("%d * ", p->size); - } - output_integer (p->depending); - q = p; - } else if(q->usage == CB_USAGE_COMP_X - && q->compx_size > 0) { - output ("%d", q->compx_size); - } else { - output ("%d", q->size); - } - - for (; q != f; q = q->parent) { - if (q->sister && !q->sister->redefines) { - q = q->sister; - p = q->depending ? q : chk_field_variable_size (q); - output (" + "); - goto again; - } - } - } - if (r->offset) { /* Size is reduced by initial offset (if any) */ - output (" - "); - output_index (r->offset); - } - break; - case CB_TAG_FIELD: - output ("(int)%s%d.size", CB_PREFIX_FIELD, CB_FIELD (x)->id); - break; - /* LCOV_EXCL_START */ - default: - cobc_err_msg (_("unexpected tree tag: %d"), (int)CB_TREE_TAG (x)); - COBC_ABORT (); - /* LCOV_EXCL_STOP */ - } -} - - -/* Generate goto label */ - -static void -perform_label (const char *to_prefix, int to_lbl, int call_num) -{ - if (!cb_flag_computed_goto) { - struct label_list *l; - if (call_num > 0) { - for (l = label_cache; l && l->call_num != call_num; l = l->next); - /* LCOV_EXCL_START */ - if (l == NULL) { - cobc_err_msg ("could not find label for %d", call_num); - COBC_ABORT (); - } - /* LCOV_EXCL_STOP */ - output_line ("frame_ptr->return_address_num = %d; /* %s%d */", - call_num, CB_PREFIX_LABEL, l->id); - output_line ("goto %s%d;", to_prefix, to_lbl); - return; - } - l = cobc_parse_malloc (sizeof (struct label_list)); - l->next = label_cache; - l->id = cb_id; - if (label_cache == NULL) { - l->call_num = 0; - } else { - l->call_num = label_cache->call_num + 1; - } - label_cache = l; - output_line ("frame_ptr->return_address_num = %d; /* %s%d */", - l->call_num, CB_PREFIX_LABEL, cb_id); - } else { - if (call_num < 0) { - call_num = cb_id; - } - output_line ("frame_ptr->return_address_ptr = &&%s%d;", - CB_PREFIX_LABEL, call_num); - } - output_line ("goto %s%d;", to_prefix, to_lbl); - output_line ("%s%d:", CB_PREFIX_LABEL, cb_id); - cb_id++; -} - -static int -add_new_label () -{ - if (!cb_flag_computed_goto) { - struct label_list *l; - l = cobc_parse_malloc (sizeof (struct label_list)); - l->next = label_cache; - l->id = cb_id; - if (label_cache == NULL) { - l->call_num = 0; - } else { - l->call_num = label_cache->call_num + 1; - } - label_cache = l; - output_line ("%s%d:", CB_PREFIX_LABEL, cb_id++); - return l->call_num; - } - output_line ("%s%d:", CB_PREFIX_LABEL, cb_id++); - return cb_id - 1; -} - -/* - * Emit case for each control Declaratives - * for GENERATE to execute - */ -static void -cb_emit_decl_case (struct cb_report *r, struct cb_field *f) -{ - struct cb_field *p; - - for (p = f; p; p = p->sister) { - if (p->report_decl_id) { - output_line ("case %d:\t/* %s */",p->report_decl_id,p->name); - output_line ("\tframe_ptr++;"); - output_line ("\tframe_ptr->perform_through = %d;", p->report_decl_id); - perform_label (CB_PREFIX_LABEL, p->report_decl_id, generate_bgn_lbl); - output_line ("\tbreak;"); - } - if (p->children) { - cb_emit_decl_case (r, p->children); - } - } -} -/* Picture strings */ - -static int -lookup_pic (const cob_pic_symbol *pic, const int length) -{ - struct pic_list *l; - int i; - int different_pic_str; - - /* Search picture string cache */ - for (l = pic_cache; l; l = l->next) { - if (length != l->length) { - continue; - } - - different_pic_str = 0; - for (i = 0; i < l->length; ++i) { - if (pic[i].symbol != l->str[i].symbol - || pic[i].times_repeated != l->str[i].times_repeated) { - different_pic_str = 1; - break; - } - } - - if (different_pic_str) { - continue; - } - - return l->id; - } - - /* Cache new picture string */ - - l = cobc_parse_malloc (sizeof (struct pic_list)); - l->id = cb_pic_id; - l->length = length; - l->str = pic; - l->next = pic_cache; - pic_cache = l; - - return cb_pic_id++; -} - -static void -output_pic_cache (void) -{ - struct pic_list *pic; - int pos; - - if (!pic_cache) { - return; - } - - output_storage ("\n/* Picture strings */\n\n"); - pic_cache = pic_list_reverse (pic_cache); - - for (pic = pic_cache; pic; pic = pic->next) { - output_storage ("static const cob_pic_symbol %s%d[] = {\n", - CB_PREFIX_PIC, pic->id); - - for (pos = 0; pos < pic->length - && pic->str[pos].symbol != '\0'; ++pos) { - output_storage ("\t{'%c', %u}", - pic->str[pos].symbol, - pic->str[pos].times_repeated); - output_storage (",\n"); - } - output_storage ("\t{'\\0', 1}"); - output_storage ("\n};\n"); - } - output_storage ("\n"); -} - -/* Attributes */ - -static int -lookup_attr (const int type, const cob_u32_t digits, const int scale, - const cob_u32_t flags, cob_pic_symbol *pic, const int lenstr) -{ - const int pic_id = pic ? lookup_pic (pic, lenstr) : -1; - struct attr_list *l; - - /* Search attribute cache */ - for (l = attr_cache; l; l = l->next) { - if (type == l->type && - digits == l->digits && - scale == l->scale && - flags == l->flags && - pic_id == l->pic_id) { - return l->id; - } - } - - /* Cache new attribute */ - - l = cobc_parse_malloc (sizeof (struct attr_list)); - l->id = cb_attr_id; - l->type = type; - l->digits = digits; - l->scale = scale; - l->flags = flags; - l->pic_id = pic_id; - l->next = attr_cache; - attr_cache = l; - - return cb_attr_id++; -} - - -static void -output_attr (const cb_tree x) -{ - int id; - cob_u32_t flags; - - id = 0; - switch (CB_TREE_TAG (x)) { - case CB_TAG_LITERAL: { - struct cb_literal *l = CB_LITERAL (x); - if (CB_TREE_CLASS (x) == CB_CLASS_NUMERIC) { - flags = COB_FLAG_CONSTANT; - if (l->sign != 0) { - flags = COB_FLAG_HAVE_SIGN | COB_FLAG_SIGN_SEPARATE | COB_FLAG_SIGN_LEADING; - } - id = lookup_attr (COB_TYPE_NUMERIC_DISPLAY, - l->size, l->scale, flags, NULL, 0); - } else { - if (l->all) { - id = lookup_attr (COB_TYPE_ALPHANUMERIC_ALL, 0, 0, COB_FLAG_CONSTANT, NULL, 0); - } else { - id = lookup_attr (COB_TYPE_ALPHANUMERIC, 0, 0, COB_FLAG_CONSTANT, NULL, 0); - } - } - break; - } - case CB_TAG_REFERENCE: { - struct cb_reference *r = CB_REFERENCE (x); - struct cb_field *f = CB_FIELD (r->value); - flags = 0; - if (r->offset) { - id = lookup_attr (COB_TYPE_ALPHANUMERIC, 0, 0, 0, NULL, 0); - } else if (f->usage == CB_USAGE_CONTROL) { - id = lookup_attr (COB_TYPE_ALPHANUMERIC, 0, 0, 0, NULL, 0); - } else { - int type = cb_tree_type (x, f); - switch (type) { - case COB_TYPE_GROUP: - case COB_TYPE_ALPHANUMERIC: - if (f->flag_justified) { - id = lookup_attr (type, 0, 0, COB_FLAG_JUSTIFIED, NULL, 0); - } else { - id = lookup_attr (type, 0, 0, 0, NULL, 0); - } - break; - default: - if (f->pic->have_sign) { - flags |= COB_FLAG_HAVE_SIGN; - if (f->flag_sign_separate) { - flags |= COB_FLAG_SIGN_SEPARATE; - } - if (f->flag_sign_leading) { - flags |= COB_FLAG_SIGN_LEADING; - } - } - if (f->flag_blank_zero) { - flags |= COB_FLAG_BLANK_ZERO; - } - if (f->flag_justified) { - flags |= COB_FLAG_JUSTIFIED; - } - if (f->flag_binary_swap) { - flags |= COB_FLAG_BINARY_SWAP; - } - if (f->flag_real_binary) { - flags |= COB_FLAG_REAL_BINARY; - } - if (f->flag_is_pointer) { - flags |= COB_FLAG_IS_POINTER; - } - if (cb_binary_truncate - && f->usage == CB_USAGE_BINARY - && !f->flag_real_binary) { - flags |= COB_FLAG_BINARY_TRUNC; - } - - switch (f->usage) { - case CB_USAGE_COMP_6: - flags |= COB_FLAG_NO_SIGN_NIBBLE; - break; - case CB_USAGE_DOUBLE: - case CB_USAGE_FLOAT: - case CB_USAGE_LONG_DOUBLE: - case CB_USAGE_FP_BIN32: - case CB_USAGE_FP_BIN64: - case CB_USAGE_FP_BIN128: - case CB_USAGE_FP_DEC64: - case CB_USAGE_FP_DEC128: - flags |= COB_FLAG_IS_FP; - break; - default: - if (f->pic->category == CB_CATEGORY_FLOATING_EDITED) { - flags |= COB_FLAG_IS_FP; - } - break; - } - - id = lookup_attr (type, f->pic->digits, - f->pic->scale, flags, - f->pic->str, f->pic->lenstr); - break; - } - } - break; - } - case CB_TAG_ALPHABET_NAME: - id = lookup_attr (COB_TYPE_ALPHANUMERIC, 0, 0, 0, NULL, 0); - break; - /* LCOV_EXCL_START */ - default: - cobc_err_msg (_("unexpected tree tag: %d"), (int)CB_TREE_TAG (x)); - COBC_ABORT (); - /* LCOV_EXCL_STOP */ - } - - output ("&%s%d", CB_PREFIX_ATTR, id); -} - -static void -output_attributes (void) -{ - struct attr_list *attr; - - if (!(attr_cache || gen_figurative)) { - return; - } - - output_storage ("\n/* Attributes */\n\n"); - - attr_cache = attr_list_reverse (attr_cache); - for (attr = attr_cache; attr; attr = attr->next) { - output_storage ("static const cob_field_attr %s%d =\t", - CB_PREFIX_ATTR, attr->id); - output_storage ("{0x%02x, %3u, %3d, 0x%04x, ", - attr->type, attr->digits, - attr->scale, attr->flags); - if (attr->pic_id != -1) { - output_storage ("%s%d", CB_PREFIX_PIC, attr->pic_id); - } else { - output_storage ("NULL"); - } - output_storage ("};\n"); - } - - if (gen_figurative) { - output_storage ("\nstatic const cob_field_attr cob_all_attr = "); - output_storage ("{0x%02x, 0, 0, 0, NULL};\n", - COB_TYPE_ALPHANUMERIC_ALL); - } - - output_storage ("\n"); -} - -/* GLOBAL EXTERNAL pointers */ - -static void -output_globext_cache (void) -{ - struct base_list *blp; - - if (!globext_cache) { - return; - } - - output_storage ("\n/* GLOBAL EXTERNAL pointers */\n"); - - globext_cache = list_cache_sort (globext_cache, &base_cache_cmp); - for (blp = globext_cache; blp; blp = blp->next) { - output_storage ("static unsigned char\t\t*%s%d = NULL;", - CB_PREFIX_BASE, blp->f->id); - output_storage ("\t/* %s */\n", blp->f->name); - } -} - -/* Headers */ - -static void -output_standard_includes (struct cb_program *prog) -{ -#if !defined (_GNU_SOURCE) && defined (_XOPEN_SOURCE_EXTENDED) - output_line ("#ifndef\t_XOPEN_SOURCE_EXTENDED"); - output_line ("#define\t_XOPEN_SOURCE_EXTENDED 1"); - output_line ("#endif"); -#endif - output_line ("#include "); - output_line ("#include "); -#ifdef WORDS_BIGENDIAN - output_line ("#define WORDS_BIGENDIAN 1"); -#endif -#ifdef COB_KEYWORD_INLINE - output_line ("#define COB_KEYWORD_INLINE %s", - CB_XSTRINGIFY(COB_KEYWORD_INLINE)); -#endif - if (cb_flag_winmain) { - output_line ("#include "); - } - if (prog->decimal_index_max || prog->flag_decimal_comp) { - output_line ("#include "); - } - output_line ("#include "); - output_newline (); -} - -/* GnuCOBOL defines */ - -static void -output_gnucobol_defines (const char *formatted_date, struct tm *local_time) -{ - int i; - - if (!strrchr (cb_source_file, '\\') - && !strrchr (cb_source_file, '"')) { - output_line ("#define COB_SOURCE_FILE\t\t\"%s\"", cb_source_file); - } else { - char cb_source_file_cleaned[FILENAME_MAX]; - int pos = 0; - const char *c; - - for (c = cb_source_file; *c; ++c) { - if (*c == '\\' || *c == '"') { - cb_source_file_cleaned[pos++] = '\\'; - } - cb_source_file_cleaned[pos++] = *c; - } - cb_source_file_cleaned[pos] = 0; - output_line ("#define COB_SOURCE_FILE\t\t\"%s\"", cb_source_file_cleaned); - } - output_line ("#define COB_PACKAGE_VERSION\t\t\"%s\"", PACKAGE_VERSION); - output_line ("#define COB_PATCH_LEVEL\t\t%d", PATCH_LEVEL); - output_line ("#define COB_MODULE_FORMATTED_DATE\t\"%s\"", formatted_date); - - if (local_time) { - i = ((local_time->tm_year + 1900) * 10000) + - ((local_time->tm_mon + 1) * 100) + - local_time->tm_mday; - output_line ("#define COB_MODULE_DATE\t\t%d", i); - i = (local_time->tm_hour * 10000) + - (local_time->tm_min * 100) + - local_time->tm_sec; - output_line ("#define COB_MODULE_TIME\t\t%d", i); - } else { - output_line ("#define COB_MODULE_DATE\t\t0"); - output_line ("#define COB_MODULE_TIME\t\t0"); - } - -} - -/* CALL cache */ - -static void -output_call_cache (void) -{ - struct call_list *call; - struct static_call_list *static_call; - const char *convention_modifier; - - if (needs_unifunc || call_cache || func_call_cache) { - output_local ("\n/* Call pointers */\n"); - } - if (needs_unifunc) { - output_local ("cob_call_union\t\tcob_unifunc;\n"); - } - call_cache = call_list_reverse (call_cache); - for (call = call_cache; call; call = call->next) { - output_local ("static cob_call_union\tcall_%s;\n", - call->call_name); - } - func_call_cache = call_list_reverse (func_call_cache); - for (call = func_call_cache; call; call = call->next) { - output_local ("static cob_call_union\tfunc_%s;\n", - call->call_name); - } - if (static_call_cache) { - static_call_cache = static_call_list_reverse (static_call_cache); - output_local ("/* Define external subroutines being called statically */\n"); - for (static_call = static_call_cache; static_call; - static_call = static_call->next) { - if (static_call->convention & CB_CONV_STDCALL) { - convention_modifier = "__stdcall "; - } else { - convention_modifier = ""; - } - output_local ("#ifndef %s\n", static_call->call_name); - if (static_call->return_type == COB_RETURN_NULL) { - output_local ("extern void %s%s ();\n", convention_modifier, - static_call->call_name); - } else if (static_call->return_type == COB_RETURN_ADDRESS_OF) { - output_local ("extern void * %s%s ();\n", convention_modifier, - static_call->call_name); - } else { - output_local ("extern int %s%s ();\n", convention_modifier, - static_call->call_name); - } - output_local ("#endif\n"); - } - } - needs_unifunc = 0; -} - -/* Nested CALL table */ - -static void -output_nested_call_table (struct cb_program *prog) -{ - struct nested_list *nlp; - - if (!(prog->nested_prog_list && gen_nested_tab)) { - return; - } - - /* Generate contained program list */ - output_local ("\n/* Nested call table */\n"); - output_local ("static struct cob_call_struct\tcob_nest_tab[] = {\n"); - for (nlp = prog->nested_prog_list; nlp; nlp = nlp->next) { - if (nlp->nested_prog == prog) { - output_local ("\t{ \"%s\", { (void *(*)())%s_%d__ }, { NULL } },\n", - nlp->nested_prog->orig_program_id, - nlp->nested_prog->program_id, - nlp->nested_prog->toplev_count); - } else { - output_local ("\t{ \"%s\", { (void *(*)())%s_%d__ }, { (void *(*)())%s_%d_ } },\n", - nlp->nested_prog->orig_program_id, - nlp->nested_prog->program_id, - nlp->nested_prog->toplev_count, - nlp->nested_prog->program_id, - nlp->nested_prog->toplev_count); - } - } - output_local ("\t{ NULL, { NULL }, { NULL } }\n"); - output_local ("};\n"); -} - -/* Local indexes */ - -static void -output_local_indexes (void) -{ - int i; - int found = 0; - - for (i = 0; i < COB_MAX_SUBSCRIPTS; i++) { - if (i_counters[i]) { - if (!found) { - found = 1; - output_local ("\n/* Subscripts */\n"); - } - output_local ("int\t\ti%d;\n", i); - } - } -} - -/* PERFORM TIMES counters */ -static void -output_perform_times_counters (void) -{ - int i; - - if (loop_counter) { - output_local ("\n/* Loop counters */\n"); - for (i = 0; i < loop_counter; i++) { - output_local ("cob_s64_t\tn%d = 0;\n", i); - } - output_local ("\n"); - } -} - -/* Local implicit fields */ - -static void -output_local_implicit_fields (void) -{ - int i; - - if (num_cob_fields) { - output_local ("\n/* Local cob_field items */\n"); - for (i = 0; i < num_cob_fields; i++) { - output_local ("cob_field\t\tf%d;\n", i); - } - output_local ("\n"); - } -} - -/* DEBUGGING fields */ - -static void -output_debugging_fields (struct cb_program *prog) -{ - COB_UNUSED (prog); - if (need_save_exception) { - output_local ("\n/* DEBUG exception code save */\n"); - output_local ("int\t\tsave_exception_code = 0;\n"); - } -} - -/* LOCAL-STORAGE pointer */ - -static void -output_local_storage_pointer (struct cb_program *prog) -{ - if (prog->local_storage && local_mem) { - output_local ("\n/* LOCAL storage pointer */\n"); - output_local ("unsigned char\t\t*cob_local_ptr = NULL;\n"); - if (current_prog->flag_global_use) { - output_local ("static unsigned char\t*cob_local_save = NULL;\n"); - } - } -} - -/* CALL parameter stack */ - -static void -output_call_parameter_stack_pointers (struct cb_program *prog) -{ - output_local ("\n/* Call parameters */\n"); - if (cb_flag_stack_on_heap || prog->flag_recursive) { - output_local ("cob_field\t\t**cob_procedure_params;\n"); - } else { - output_local ("cob_field\t\t*cob_procedure_params[%u];\n", - prog->max_call_param ? prog->max_call_param : 1); - } -} - -/* Frame stack */ - -static void -output_frame_stack (struct cb_program *prog) -{ - output_local ("\n/* Perform frame stack */\n"); - if (cb_perform_osvs && current_prog->prog_type == COB_MODULE_TYPE_PROGRAM) { - output_local ("struct cob_frame\t*temp_index;\n"); - } - if (cb_flag_stack_check) { - output_local ("struct cob_frame\t*frame_overflow;\n"); - } - output_local ("struct cob_frame\t*frame_ptr;\n"); - if (cb_flag_stack_on_heap || prog->flag_recursive) { - output_local ("struct cob_frame\t*frame_stack;\n\n"); - } else { - output_local ("struct cob_frame\tframe_stack[%d];\n\n", - cb_stack_size); - } -} - -/* Dynamic field FUNCTION-ID pointers */ - -static void -output_dynamic_field_function_id_pointers (void) -{ - cob_u32_t i; - - if (gen_dynamic) { - output_local ("\n/* Dynamic field FUNCTION-ID pointers */\n"); - for (i = 0; i < gen_dynamic; i++) { - output_local ("cob_field\t*cob_dyn_%u = NULL;\n", i); - } - } -} - - -/* Based data */ - -static int ws_id = 0; -static size_t ws_used = 0; -/* - * Compute memory size based on align-record and align-opt settings - */ -static size_t -compute_align_size (size_t fs, int dflt) -{ - int align_on; - align_on = cb_align_record; - if (cb_align_opt) { - if (fs >= 16) { - align_on = 16; - } else if (fs >= 8) { - if (cb_align_record != 16) - align_on = 8; - } else if (fs >= 4) { - if (cb_align_record != 8 - && cb_align_record != 16) - align_on = 4; - } else if (fs >= 2) { - if (cb_align_record != 4 - && cb_align_record != 8 - && cb_align_record != 16) - align_on = 2; - } - } - if (align_on == 0) - align_on = dflt; - fs = (fs + align_on - 1) / align_on; - return fs * align_on; -} - -/* - * Emit storage collector variable - */ -static void -output_local_ws_group (void) -{ - if (ws_used > 0 - && cb_align_record) { -#ifdef HAVE_ATTRIBUTE_ALIGNED - output_local ("static cob_u8_t %s%d[%ld]%s;", - CB_PREFIX_WS_GROUP, ws_id, ws_used, COB_ALIGN); -#else -#if defined(COB_ALIGN_PRAGMA_8) - output_local ("#pragma align 8 (%s%d)\n", CB_PREFIX_WS_GROUP, ws_id); -#endif - output_local ("static %scob_u8_t%s %s%d[%ld];", - COB_ALIGN_DECL_8, COB_ALIGN_ATTR_8, CB_PREFIX_WS_GROUP, ws_id, ws_used); -#endif - } -} - -/* - * Emit all WORKING-STORAGE records - */ -static void -output_local_base_cache (void) -{ - struct base_list *blp; - size_t fs; - - if (!local_base_cache) { - return; - } - - output_local ("\n/* WORKING-STORAGE Data */\n"); - - local_base_cache = list_cache_sort (local_base_cache, &base_cache_cmp); - ws_id++; - ws_used = 0; - for (blp = local_base_cache; blp; blp = blp->next) { - if (blp->f->index_type == CB_INT_INDEX) { - output_local ("int %s%d;", - CB_PREFIX_BASE, blp->f->id); - } else if (blp->f->index_type == CB_STATIC_INT_INDEX) { - output_local ("static int %s%d;", - CB_PREFIX_BASE, blp->f->id); - } else if( !(blp->f->report_flag & COB_REPORT_REF_EMITTED)) { - if (!cb_align_record - || blp->f->memory_size >= COB_MAX_CHAR_SIZE) { -#ifdef HAVE_ATTRIBUTE_ALIGNED - output_local ("static cob_u8_t %s%d[%d]%s;", - CB_PREFIX_BASE, blp->f->id, - blp->f->memory_size, COB_ALIGN); -#else -#if defined(COB_ALIGN_PRAGMA_8) - output_local ("#pragma align 8 (%s%d)\n", CB_PREFIX_BASE, blp->f->id); -#endif - output_local ("static %scob_u8_t%s %s%d[%d];", - COB_ALIGN_DECL_8, COB_ALIGN_ATTR_8, CB_PREFIX_BASE, - blp->f->id, blp->f->memory_size); -#endif - } else { - fs = compute_align_size (blp->f->memory_size, 1); - if (ws_used + fs > COB_MAX_CHAR_SIZE) { - output_local_ws_group (); - ws_id++; - ws_used = 0; - } - - output_local ("#define %s%d\t(%s%d + %ld)", - CB_PREFIX_BASE, blp->f->id, CB_PREFIX_WS_GROUP, ws_id, ws_used); - ws_used += fs; - } - } - output_local ("\t/* %s */\n", blp->f->name); - } - - output_local_ws_group (); - - output_local ("\n/* End of WORKING-STORAGE data */\n\n"); -} - -static void -output_nonlocal_base_cache (void) -{ - struct base_list *blp; - const char *prev_prog = NULL; - - if (!base_cache) { - return; - } - - output_storage ("\n/* Data storage */\n"); - base_cache = list_cache_sort (base_cache, &base_cache_cmp); - - for (blp = base_cache; blp; blp = blp->next) { - if (blp->curr_prog != prev_prog) { - prev_prog = blp->curr_prog; - output_storage ("\n/* PROGRAM-ID : %s */\n", - prev_prog); - } - - if (blp->f->index_type != CB_NORMAL_INDEX) { - output_storage ("static int %s%d;", - CB_PREFIX_BASE, blp->f->id); - } else { -#ifdef HAVE_ATTRIBUTE_ALIGNED - output_storage ("static cob_u8_t %s%d[%d]%s;", - CB_PREFIX_BASE, blp->f->id, - blp->f->memory_size, COB_ALIGN); -#else -#if defined(COB_ALIGN_PRAGMA_8) - output_storage ("#pragma align 8 (%s%d)\n", CB_PREFIX_BASE, blp->f->id); -#endif - output_storage ("static %scob_u8_t%s %s%d[%d];", - COB_ALIGN_DECL_8, COB_ALIGN_ATTR_8, CB_PREFIX_BASE, - blp->f->id, blp->f->memory_size); -#endif - } - output_storage ("\t/* %s */\n", blp->f->name); - } - - output_storage ("\n/* End of data storage */\n\n"); -} - -/* Fields */ - -static void -output_field (cb_tree x) -{ - output ("{"); - output_size (x); - output (", "); - output_data (x); - output (", "); - output_attr (x); - output ("}"); -} - -static void -output_data_sub (cb_tree x, int subscript) -{ - switch (CB_TREE_TAG (x)) { - case CB_TAG_LITERAL: { - struct cb_literal *l = CB_LITERAL (x); - if (CB_TREE_CLASS (x) == CB_CLASS_NUMERIC) { - output ("(cob_u8_ptr)\"%s%s\"", (char *)l->data, - (l->sign < 0) ? "-" : (l->sign > 0) ? "+" : ""); - } else { - output ("(cob_u8_ptr)"); - output_string (l->data, (int) l->size, l->llit); - } - break; - } - case CB_TAG_REFERENCE: { - struct cb_reference *r = CB_REFERENCE (x); - struct cb_field *f = CB_FIELD (r->value); - - /* Base address */ - output_base (f, 0); - - if(subscript > 0 - && f->flag_occurs) { - output (" + "); - if (f->size != 1) { - output ("%d * ", f->size); - } - output ("(%d - 1)",subscript); - } - - /* Subscripts */ - if (r->subs) { - cb_tree lsub = r->subs; - for (; f && lsub; f = f->parent) { - if (f->flag_occurs) { - output (" + "); - if (f->size != 1) { - output ("%d * ", f->size); - } - output_index (CB_VALUE (lsub)); - lsub = CB_CHAIN (lsub); - } - } - } - - /* Offset */ - if (r->offset) { - output (" + "); - output_index (r->offset); - } - break; - } - case CB_TAG_FIELD: { - struct cb_field *f = CB_FIELD (x); - output("/* %s */", f->name); - /* Base address */ - output_base (f, 0); - break; - } - case CB_TAG_CAST: - output ("&"); - output_param (x, 0); - break; - case CB_TAG_INTRINSIC: - output ("cob_procedure_params[%u]->data", - field_iteration); - break; - case CB_TAG_CONST: - if (x == cb_null) { - output ("NULL"); - return; - } - /* Fall through */ - /* LCOV_EXCL_START */ - default: - cobc_err_msg (_("unexpected tree tag: %d"), (int)CB_TREE_TAG (x)); - COBC_ABORT (); - /* LCOV_EXCL_STOP */ - } -} - -static void -output_field_sub (cb_tree x, int subscript) -{ - output ("{"); - output_size (x); - output (", "); - output_data_sub (x,subscript); - output (", "); - output_attr (x); - output ("}"); -} - -/* - * Emit cob_field with comments - */ -static void -output_emit_field (cb_tree x, const char *cmt) -{ - struct cb_field *f = cb_code_field (x); - - if (!f) { - return; - } - - if (!(f->report_flag & COB_REPORT_REF_EMITTED)) { - int i; - - f->report_flag |= COB_REPORT_REF_EMITTED; - if (f->step_count < f->size) { - f->step_count = f->size; - } - if (f->flag_occurs && f->occurs_max > 1) { - output_local("\t\t/* col%3d %s OCCURS %d ", f->report_column, f->name, f->occurs_max); - if(cmt && strlen(cmt) > 0) - output_local(": %s ",cmt); - output_local("*/\n"); - for (i=1; i <= f->occurs_max; i++) { - if(i == 1) { - output ("static cob_field %s%d\t= ", CB_PREFIX_FIELD, f->id); - } else { - output ("static cob_field %s%d_%d\t= ", CB_PREFIX_FIELD, f->id,i); - } - output_field_sub (x, i); - output_local(";\t/* col%3d %s [%d]", f->report_column + (f->size * (i-1)), f->name, i); - output_local("*/\n"); - } - } else { - output ("static cob_field %s%d\t= ", CB_PREFIX_FIELD, f->id); - output_field (x); - output_local(";\t/* "); - if(f->report_column > 0) - output_local("col%3d ", f->report_column); - if(strncmp(f->name,"FILLER ",7) != 0) - output_local("%s ", f->name); - if((f->report_flag & COB_REPORT_COLUMN_RIGHT)) { - output_local("RIGHT "); - } else - if((f->report_flag & COB_REPORT_COLUMN_LEFT)) { - output_local("LEFT "); - } else - if((f->report_flag & COB_REPORT_COLUMN_CENTER)) { - output_local("CENTER "); - } - if(cmt && strlen(cmt) > 0) - output_local(": %s ",cmt); - output_local("*/\n"); - } - } -} - -static void -output_local_field_cache (struct cb_program *prog) -{ - cb_tree l; - struct field_list *field; - struct cb_field *f; - struct cb_report *rep; - - if (!local_field_cache) { - return; - } - - /* Switch to local storage file */ - output_target = current_prog->local_include->local_fp; - if (prog->flag_recursive) { - output_local ("\n/* Fields for recursive routine */\n"); - } else { - output_local ("\n/* Local Fields */\n"); - } - - local_field_cache = list_cache_sort (local_field_cache, - &field_cache_cmp); - for (field = local_field_cache; field; field = field->next) { - - f = field->f; - if (!f->flag_local - && !f->flag_external) { - if (prog->flag_recursive - && !f->flag_filler) { - output ("/* %s is not local */", f->name); - output_newline (); - } - if (f->storage == CB_STORAGE_REPORT - && f->flag_occurs - && f->occurs_max > 1) { - output_emit_field (cb_build_field_reference (f, NULL), NULL); - } else { - output ("static cob_field %s%d\t= ", CB_PREFIX_FIELD, f->id); - output_field (field->x); - } - } else { - output ("%scob_field %s%d\t= ", prog->flag_recursive ? "\t" : "static ", - CB_PREFIX_FIELD, f->id); - output ("{"); - output_size (field->x); - output (", NULL, "); - output_attr (field->x); - output ("}"); - } - - if (field->f->flag_filler) { - output (";\t/* Implicit FILLER */"); - } else { - output (";\t/* %s */", field->f->name); - } - output_newline (); - field->f->report_flag |= COB_REPORT_REF_EMITTED; - } - for (l = prog->parameter_list; l; l = CB_CHAIN (l)) { - /* Force field cache */ - f = cb_code_field (CB_VALUE (l)); - if (!f->flag_field - && (chk_field_variable_size (f) - || chk_field_variable_address (f))) { - output ("static cob_field %s%d\t= ", CB_PREFIX_FIELD, f->id); - output ("{"); - output ("0, NULL, "); - output_attr (cb_build_field_reference (f, NULL)); - output ("}; /* %s */",f->name); - output_newline (); - } - - } - /* Report special fields */ - if (prog->report_storage) { - for (l = prog->report_list; l; l = CB_CHAIN (l)) { - rep = CB_REPORT(CB_VALUE(l)); - for (f = rep->records; f; f = f->sister) { - if (f->storage == CB_STORAGE_WORKING - && !(f->report_flag & COB_REPORT_REF_EMITTED)) { - output_emit_field(cb_build_field_reference (f, NULL), NULL); - } - } - } - for (l = prog->report_list; l; l = CB_CHAIN (l)) { - rep = CB_REPORT(CB_VALUE(l)); - if(rep) { - output_report_summed_field (rep->records); - } - } - } - - output_local ("\n/* End of fields */\n\n"); - /* Switch to main storage file */ - output_target = cb_storage_file; -} - -static void -output_nonlocal_field_cache (void) -{ - struct field_list *field; - const char *prev_prog = NULL; - - if (!field_cache) { - return; - } - - output_storage ("\n/* Fields */\n"); - - field_cache = list_cache_sort (field_cache, &field_cache_cmp); - for (field = field_cache; field; field = field->next) { - if (field->curr_prog != prev_prog) { - prev_prog = field->curr_prog; - output_storage ("\n/* PROGRAM-ID : %s */\n", - prev_prog); - } - - output ("static cob_field %s%d\t= ", CB_PREFIX_FIELD, - field->f->id); - if (!field->f->flag_local) { - output_field (field->x); - } else { - output ("{"); - output_size (field->x); - output (", NULL, "); - output_attr (field->x); - output ("}"); - } - if (field->f->flag_filler) { - output (";\t/* Implicit FILLER */"); - } else { - output (";\t/* %s */", field->f->name); - } - output_newline (); - } - - output_storage ("\n/* End of fields */\n\n"); -} - -/* Literals, figurative constants and user-defined constants */ - -static void -output_low_value (void) -{ - if (gen_figurative & CB_NEED_LOW) { - output ("static cob_field cob_all_low\t= "); - output ("{1, "); - output ("(cob_u8_ptr)\"\\0\", "); - output ("&cob_all_attr};"); - output_newline (); - } -} - -static void -output_high_value (void) -{ - if (gen_figurative & CB_NEED_HIGH) { - output ("static cob_field cob_all_high\t= "); - output ("{1, "); - output ("(cob_u8_ptr)\"\\xff\", "); - output ("&cob_all_attr};"); - output_newline (); - } -} - -static void -output_quote (void) -{ - if (gen_figurative & CB_NEED_QUOTE) { - output ("static cob_field cob_all_quote\t= "); - output ("{1, "); - if (cb_flag_apostrophe) { - output ("(cob_u8_ptr)\"'\", "); - } else { - output ("(cob_u8_ptr)\"\\\"\", "); - } - output ("&cob_all_attr};"); - output_newline (); - } -} - -static void -output_space (void) -{ - if (gen_figurative & CB_NEED_SPACE) { - output ("static cob_field cob_all_space\t= "); - output ("{1, "); - output ("(cob_u8_ptr)\" \", "); - output ("&cob_all_attr};"); - output_newline (); - } -} - -static void -output_zero (void) -{ - if (gen_figurative & CB_NEED_ZERO) { - output ("static cob_field cob_all_zero\t= "); - output ("{1, "); - output ("(cob_u8_ptr)\"0\", "); - output ("&cob_all_attr};"); - output_newline (); - } -} - -static void -output_literals_figuratives_and_constants (void) -{ - struct literal_list *lit; - - if (!(literal_cache || gen_figurative)) { - return; - } - - output_storage ("\n/* Constants */\n"); - - literal_cache = literal_list_reverse (literal_cache); - for (lit = literal_cache; lit; lit = lit->next) { - output ("static const cob_field %s%d\t= ", - CB_PREFIX_CONST, lit->id); - output_field (lit->x); - output (";"); - output_newline (); - } - - if (gen_figurative) { - output_newline (); - output_low_value (); - output_high_value (); - output_quote (); - output_space (); - output_zero (); - } - - output_newline (); -} - -/* Collating tables */ - -static void -output_alt_ebcdic_table (void) -{ - if (!gen_alt_ebcdic) { - return; - } - - output_storage ("\n/* ASCII to EBCDIC translate table (restricted) */\n"); - output_storage ("static const unsigned char\tcob_a2e[256] = {\n"); - /* Restricted table */ - output_storage ("\t0x00, 0x01, 0x02, 0x03, 0x1D, 0x19, 0x1A, 0x1B,\n"); - output_storage ("\t0x0F, 0x04, 0x16, 0x06, 0x07, 0x08, 0x09, 0x0A,\n"); - output_storage ("\t0x0B, 0x0C, 0x0D, 0x0E, 0x1E, 0x1F, 0x1C, 0x17,\n"); - output_storage ("\t0x10, 0x11, 0x20, 0x18, 0x12, 0x13, 0x14, 0x15,\n"); - output_storage ("\t0x21, 0x27, 0x3A, 0x36, 0x28, 0x30, 0x26, 0x38,\n"); - output_storage ("\t0x24, 0x2A, 0x29, 0x25, 0x2F, 0x2C, 0x22, 0x2D,\n"); - output_storage ("\t0x73, 0x74, 0x75, 0x76, 0x77, 0x78, 0x79, 0x7A,\n"); - output_storage ("\t0x7B, 0x7C, 0x35, 0x2B, 0x23, 0x39, 0x32, 0x33,\n"); - output_storage ("\t0x37, 0x57, 0x58, 0x59, 0x5A, 0x5B, 0x5C, 0x5D,\n"); - output_storage ("\t0x5E, 0x5F, 0x61, 0x62, 0x63, 0x64, 0x65, 0x66,\n"); - output_storage ("\t0x67, 0x68, 0x69, 0x6B, 0x6C, 0x6D, 0x6E, 0x6F,\n"); - output_storage ("\t0x70, 0x71, 0x72, 0x7D, 0x6A, 0x7E, 0x7F, 0x31,\n"); - output_storage ("\t0x34, 0x3B, 0x3C, 0x3D, 0x3E, 0x3F, 0x40, 0x41,\n"); - output_storage ("\t0x42, 0x43, 0x44, 0x45, 0x46, 0x47, 0x48, 0x49,\n"); - output_storage ("\t0x4A, 0x4B, 0x4C, 0x4E, 0x4F, 0x50, 0x51, 0x52,\n"); - output_storage ("\t0x53, 0x54, 0x55, 0x56, 0x2E, 0x60, 0x4D, 0x05,\n"); - output_storage ("\t0x80, 0x81, 0x82, 0x83, 0x84, 0x85, 0x86, 0x87,\n"); - output_storage ("\t0x88, 0x89, 0x8A, 0x8B, 0x8C, 0x8D, 0x8E, 0x8F,\n"); - output_storage ("\t0x90, 0x91, 0x92, 0x93, 0x94, 0x95, 0x96, 0x97,\n"); - output_storage ("\t0x98, 0x99, 0x9A, 0x9B, 0x9C, 0x9D, 0x9E, 0x9F,\n"); - output_storage ("\t0xA0, 0xA1, 0xA2, 0xA3, 0xA4, 0xA5, 0xA6, 0xA7,\n"); - output_storage ("\t0xA8, 0xA9, 0xAA, 0xAB, 0xAC, 0xAD, 0xAE, 0xAF,\n"); - output_storage ("\t0xB0, 0xB1, 0xB2, 0xB3, 0xB4, 0xB5, 0xB6, 0xB7,\n"); - output_storage ("\t0xB8, 0xB9, 0xBA, 0xBB, 0xBC, 0xBD, 0xBE, 0xBF,\n"); - output_storage ("\t0xC0, 0xC1, 0xC2, 0xC3, 0xC4, 0xC5, 0xC6, 0xC7,\n"); - output_storage ("\t0xC8, 0xC9, 0xCA, 0xCB, 0xCC, 0xCD, 0xCE, 0xCF,\n"); - output_storage ("\t0xD0, 0xD1, 0xD2, 0xD3, 0xD4, 0xD5, 0xD6, 0xD7,\n"); - output_storage ("\t0xD8, 0xD9, 0xDA, 0xDB, 0xDC, 0xDD, 0xDE, 0xDF,\n"); - output_storage ("\t0xE0, 0xE1, 0xE2, 0xE3, 0xE4, 0xE5, 0xE6, 0xE7,\n"); - output_storage ("\t0xE8, 0xE9, 0xEA, 0xEB, 0xEC, 0xED, 0xEE, 0xEF,\n"); - output_storage ("\t0xF0, 0xF1, 0xF2, 0xF3, 0xF4, 0xF5, 0xF6, 0xF7,\n"); - output_storage ("\t0xF8, 0xF9, 0xFA, 0xFB, 0xFC, 0xFD, 0xFE, 0xFF\n"); - output_storage ("};\n"); - output_storage ("\n"); -} - -static void -output_full_ebcdic_table (void) -{ - int i; - - if (!gen_full_ebcdic) { - return; - } - - output_storage ("\n/* ASCII to EBCDIC table */\n"); - output_storage ("static const unsigned char\tcob_ascii_ebcdic[256] = {\n"); - output_storage ("\t0x00, 0x01, 0x02, 0x03, 0x37, 0x2D, 0x2E, 0x2F,\n"); - output_storage ("\t0x16, 0x05, 0x25, 0x0B, 0x0C, 0x0D, 0x0E, 0x0F,\n"); - output_storage ("\t0x10, 0x11, 0x12, 0x13, 0x3C, 0x3D, 0x32, 0x26,\n"); - output_storage ("\t0x18, 0x19, 0x3F, 0x27, 0x1C, 0x1D, 0x1E, 0x1F,\n"); - output_storage ("\t0x40, 0x5A, 0x7F, 0x7B, 0x5B, 0x6C, 0x50, 0x7D,\n"); - output_storage ("\t0x4D, 0x5D, 0x5C, 0x4E, 0x6B, 0x60, 0x4B, 0x61,\n"); - output_storage ("\t0xF0, 0xF1, 0xF2, 0xF3, 0xF4, 0xF5, 0xF6, 0xF7,\n"); - output_storage ("\t0xF8, 0xF9, 0x7A, 0x5E, 0x4C, 0x7E, 0x6E, 0x6F,\n"); - output_storage ("\t0x7C, 0xC1, 0xC2, 0xC3, 0xC4, 0xC5, 0xC6, 0xC7,\n"); - output_storage ("\t0xC8, 0xC9, 0xD1, 0xD2, 0xD3, 0xD4, 0xD5, 0xD6,\n"); - output_storage ("\t0xD7, 0xD8, 0xD9, 0xE2, 0xE3, 0xE4, 0xE5, 0xE6,\n"); - output_storage ("\t0xE7, 0xE8, 0xE9, 0xAD, 0xE0, 0xBD, 0x5F, 0x6D,\n"); - output_storage ("\t0x79, 0x81, 0x82, 0x83, 0x84, 0x85, 0x86, 0x87,\n"); - output_storage ("\t0x88, 0x89, 0x91, 0x92, 0x93, 0x94, 0x95, 0x96,\n"); - output_storage ("\t0x97, 0x98, 0x99, 0xA2, 0xA3, 0xA4, 0xA5, 0xA6,\n"); - output_storage ("\t0xA7, 0xA8, 0xA9, 0xC0, 0x6A, 0xD0, 0xA1, 0x07,\n"); - output_storage ("\t0x68, 0xDC, 0x51, 0x42, 0x43, 0x44, 0x47, 0x48,\n"); - output_storage ("\t0x52, 0x53, 0x54, 0x57, 0x56, 0x58, 0x63, 0x67,\n"); - output_storage ("\t0x71, 0x9C, 0x9E, 0xCB, 0xCC, 0xCD, 0xDB, 0xDD,\n"); - output_storage ("\t0xDF, 0xEC, 0xFC, 0xB0, 0xB1, 0xB2, 0x3E, 0xB4,\n"); - output_storage ("\t0x45, 0x55, 0xCE, 0xDE, 0x49, 0x69, 0x9A, 0x9B,\n"); - output_storage ("\t0xAB, 0x9F, 0xBA, 0xB8, 0xB7, 0xAA, 0x8A, 0x8B,\n"); - output_storage ("\t0xB6, 0xB5, 0x62, 0x4F, 0x64, 0x65, 0x66, 0x20,\n"); - output_storage ("\t0x21, 0x22, 0x70, 0x23, 0x72, 0x73, 0x74, 0xBE,\n"); - output_storage ("\t0x76, 0x77, 0x78, 0x80, 0x24, 0x15, 0x8C, 0x8D,\n"); - output_storage ("\t0x8E, 0x41, 0x06, 0x17, 0x28, 0x29, 0x9D, 0x2A,\n"); - output_storage ("\t0x2B, 0x2C, 0x09, 0x0A, 0xAC, 0x4A, 0xAE, 0xAF,\n"); - output_storage ("\t0x1B, 0x30, 0x31, 0xFA, 0x1A, 0x33, 0x34, 0x35,\n"); - output_storage ("\t0x36, 0x59, 0x08, 0x38, 0xBC, 0x39, 0xA0, 0xBF,\n"); - output_storage ("\t0xCA, 0x3A, 0xFE, 0x3B, 0x04, 0xCF, 0xDA, 0x14,\n"); - output_storage ("\t0xE1, 0x8F, 0x46, 0x75, 0xFD, 0xEB, 0xEE, 0xED,\n"); - output_storage ("\t0x90, 0xEF, 0xB3, 0xFB, 0xB9, 0xEA, 0xBB, 0xFF\n"); - output_storage ("};\n"); - - if (gen_full_ebcdic > 1) { - i = lookup_attr (COB_TYPE_ALPHANUMERIC, 0, 0, 0, NULL, 0); - output_storage ("static cob_field f_ascii_ebcdic = { 256, (cob_u8_ptr)cob_ascii_ebcdic, &%s%d };\n", - CB_PREFIX_ATTR, i); - } - - output_storage ("\n"); - -} - -static void -output_ebcdic_to_ascii_table (void) -{ - int i; - - if (!gen_ebcdic_ascii) { - return; - } - - output_storage ("\n/* EBCDIC to ASCII table */\n"); - output_storage ("static const unsigned char\tcob_ebcdic_ascii[256] = {\n"); - output_storage ("\t0x00, 0x01, 0x02, 0x03, 0xEC, 0x09, 0xCA, 0x7F,\n"); - output_storage ("\t0xE2, 0xD2, 0xD3, 0x0B, 0x0C, 0x0D, 0x0E, 0x0F,\n"); - output_storage ("\t0x10, 0x11, 0x12, 0x13, 0xEF, 0xC5, 0x08, 0xCB,\n"); - output_storage ("\t0x18, 0x19, 0xDC, 0xD8, 0x1C, 0x1D, 0x1E, 0x1F,\n"); - output_storage ("\t0xB7, 0xB8, 0xB9, 0xBB, 0xC4, 0x0A, 0x17, 0x1B,\n"); - output_storage ("\t0xCC, 0xCD, 0xCF, 0xD0, 0xD1, 0x05, 0x06, 0x07,\n"); - output_storage ("\t0xD9, 0xDA, 0x16, 0xDD, 0xDE, 0xDF, 0xE0, 0x04,\n"); - output_storage ("\t0xE3, 0xE5, 0xE9, 0xEB, 0x14, 0x15, 0x9E, 0x1A,\n"); - output_storage ("\t0x20, 0xC9, 0x83, 0x84, 0x85, 0xA0, 0xF2, 0x86,\n"); - output_storage ("\t0x87, 0xA4, 0xD5, 0x2E, 0x3C, 0x28, 0x2B, 0xB3,\n"); - output_storage ("\t0x26, 0x82, 0x88, 0x89, 0x8A, 0xA1, 0x8C, 0x8B,\n"); - output_storage ("\t0x8D, 0xE1, 0x21, 0x24, 0x2A, 0x29, 0x3B, 0x5E,\n"); - output_storage ("\t0x2D, 0x2F, 0xB2, 0x8E, 0xB4, 0xB5, 0xB6, 0x8F,\n"); - output_storage ("\t0x80, 0xA5, 0x7C, 0x2C, 0x25, 0x5F, 0x3E, 0x3F,\n"); - output_storage ("\t0xBA, 0x90, 0xBC, 0xBD, 0xBE, 0xF3, 0xC0, 0xC1,\n"); - output_storage ("\t0xC2, 0x60, 0x3A, 0x23, 0x40, 0x27, 0x3D, 0x22,\n"); - output_storage ("\t0xC3, 0x61, 0x62, 0x63, 0x64, 0x65, 0x66, 0x67,\n"); - output_storage ("\t0x68, 0x69, 0xAE, 0xAF, 0xC6, 0xC7, 0xC8, 0xF1,\n"); - output_storage ("\t0xF8, 0x6A, 0x6B, 0x6C, 0x6D, 0x6E, 0x6F, 0x70,\n"); - output_storage ("\t0x71, 0x72, 0xA6, 0xA7, 0x91, 0xCE, 0x92, 0xA9,\n"); - output_storage ("\t0xE6, 0x7E, 0x73, 0x74, 0x75, 0x76, 0x77, 0x78,\n"); - output_storage ("\t0x79, 0x7A, 0xAD, 0xA8, 0xD4, 0x5B, 0xD6, 0xD7,\n"); - output_storage ("\t0x9B, 0x9C, 0x9D, 0xFA, 0x9F, 0xB1, 0xB0, 0xAC,\n"); - output_storage ("\t0xAB, 0xFC, 0xAA, 0xFE, 0xE4, 0x5D, 0xBF, 0xE7,\n"); - output_storage ("\t0x7B, 0x41, 0x42, 0x43, 0x44, 0x45, 0x46, 0x47,\n"); - output_storage ("\t0x48, 0x49, 0xE8, 0x93, 0x94, 0x95, 0xA2, 0xED,\n"); - output_storage ("\t0x7D, 0x4A, 0x4B, 0x4C, 0x4D, 0x4E, 0x4F, 0x50,\n"); - output_storage ("\t0x51, 0x52, 0xEE, 0x96, 0x81, 0x97, 0xA3, 0x98,\n"); - output_storage ("\t0x5C, 0xF0, 0x53, 0x54, 0x55, 0x56, 0x57, 0x58,\n"); - output_storage ("\t0x59, 0x5A, 0xFD, 0xF5, 0x99, 0xF7, 0xF6, 0xF9,\n"); - output_storage ("\t0x30, 0x31, 0x32, 0x33, 0x34, 0x35, 0x36, 0x37,\n"); - output_storage ("\t0x38, 0x39, 0xDB, 0xFB, 0x9A, 0xF4, 0xEA, 0xFF\n"); - output_storage ("};\n"); - - if (gen_ebcdic_ascii > 1) { - i = lookup_attr (COB_TYPE_ALPHANUMERIC, 0, 0, 0, NULL, 0); - output_storage ("static cob_field f_ebcdic_ascii = { 256, (cob_u8_ptr)cob_ebcdic_ascii, &%s%d };\n", - CB_PREFIX_ATTR, i); - } - - output_storage ("\n"); - -} - -static void -output_native_table (void) -{ - int i; - - if (!gen_native) { - return; - } - - output_storage ("\n/* NATIVE table */\n"); - output_storage ("static const unsigned char\tcob_native[256] = {\n"); - output_storage ("\t0, 1, 2, 3, 4, 5, 6, 7,\n"); - output_storage ("\t8, 9, 10, 11, 12, 13, 14, 15,\n"); - output_storage ("\t16, 17, 18, 19, 20, 21, 22, 23,\n"); - output_storage ("\t24, 25, 26, 27, 28, 29, 30, 31,\n"); - output_storage ("\t32, 33, 34, 35, 36, 37, 38, 39,\n"); - output_storage ("\t40, 41, 42, 43, 44, 45, 46, 47,\n"); - output_storage ("\t48, 49, 50, 51, 52, 53, 54, 55,\n"); - output_storage ("\t56, 57, 58, 59, 60, 61, 62, 63,\n"); - output_storage ("\t64, 65, 66, 67, 68, 69, 70, 71,\n"); - output_storage ("\t72, 73, 74, 75, 76, 77, 78, 79,\n"); - output_storage ("\t80, 81, 82, 83, 84, 85, 86, 87,\n"); - output_storage ("\t88, 89, 90, 91, 92, 93, 94, 95,\n"); - output_storage ("\t96, 97, 98, 99, 100, 101, 102, 103,\n"); - output_storage ("\t104, 105, 106, 107, 108, 109, 110, 111,\n"); - output_storage ("\t112, 113, 114, 115, 116, 117, 118, 119,\n"); - output_storage ("\t120, 121, 122, 123, 124, 125, 126, 127,\n"); - output_storage ("\t128, 129, 130, 131, 132, 133, 134, 135,\n"); - output_storage ("\t136, 137, 138, 139, 140, 141, 142, 143,\n"); - output_storage ("\t144, 145, 146, 147, 148, 149, 150, 151,\n"); - output_storage ("\t152, 153, 154, 155, 156, 157, 158, 159,\n"); - output_storage ("\t160, 161, 162, 163, 164, 165, 166, 167,\n"); - output_storage ("\t168, 169, 170, 171, 172, 173, 174, 175,\n"); - output_storage ("\t176, 177, 178, 179, 180, 181, 182, 183,\n"); - output_storage ("\t184, 185, 186, 187, 188, 189, 190, 191,\n"); - output_storage ("\t192, 193, 194, 195, 196, 197, 198, 199,\n"); - output_storage ("\t200, 201, 202, 203, 204, 205, 206, 207,\n"); - output_storage ("\t208, 209, 210, 211, 212, 213, 214, 215,\n"); - output_storage ("\t216, 217, 218, 219, 220, 221, 222, 223,\n"); - output_storage ("\t224, 225, 226, 227, 228, 229, 230, 231,\n"); - output_storage ("\t232, 233, 234, 235, 236, 237, 238, 239,\n"); - output_storage ("\t240, 241, 242, 243, 244, 245, 246, 247,\n"); - output_storage ("\t248, 249, 250, 251, 252, 253, 254, 255\n"); - output_storage ("};\n"); - - if (gen_native > 1) { - i = lookup_attr (COB_TYPE_ALPHANUMERIC, 0, 0, 0, NULL, 0); - output_storage ("static cob_field f_native = { 256, (cob_u8_ptr)cob_native, &%s%d };\n", - CB_PREFIX_ATTR, i); - } - - output_storage ("\n"); - -} - -static void -output_collating_tables (void) -{ - output_alt_ebcdic_table (); - output_full_ebcdic_table (); - output_ebcdic_to_ascii_table (); - output_native_table (); -} - -/* Strings */ - -static void -output_string_cache (void) -{ - struct string_list *stp; - - if (!string_cache) { - return; - } - - output_storage ("\n/* Strings */\n"); - - string_cache = string_list_reverse (string_cache); - for (stp = string_cache; stp; stp = stp->next) { - if (!strrchr (stp->text, '\\') - && !strrchr (stp->text, '"')) { - output_storage ("static const char %s%d[]\t= \"%s\";\n", - CB_PREFIX_STRING, stp->id, stp->text); - } else { - char text_cleaned[FILENAME_MAX]; - int pos = 0; - const char *c; - - for (c = stp->text; *c; ++c) { - if (*c == '\\' || *c == '"') { - text_cleaned[pos++] = '\\'; - } - text_cleaned[pos++] = *c; - } - text_cleaned[pos] = 0; - output_storage ("static const char %s%d[]\t= \"%s\";\n", - CB_PREFIX_STRING, stp->id, text_cleaned); - } - } - - output_storage ("\n"); -} - -/* Source file names */ - -static void -output_source_cache (void) -{ - struct string_list *stp; - - if (!source_cache) { - return; - } - - output_storage ("\n/* Source file names */\n"); - source_cache = string_list_reverse (source_cache); - output_storage ("static const char *%ssource_files[]\t= { \"\" ", CB_PREFIX_STRING); - if (source_cache) { - for (stp = source_cache; stp; stp = stp->next) { - if (!strrchr (stp->text, '\\') - && !strrchr (stp->text, '"')) { - output_storage ("\n\t\t,\"%s\"", stp->text); - } else { - char text_cleaned[FILENAME_MAX]; - int pos = 0; - const char *c; - - for (c = stp->text; *c; ++c) { - if (*c == '\\' || *c == '"') { - text_cleaned[pos++] = '\\'; - } - text_cleaned[pos++] = *c; - } - text_cleaned[pos] = 0; - output_storage ("\n\t\t,\"%s\"", text_cleaned); - } - } - } - output_storage ("};\n"); -} - -/* Literal */ - -int -cb_lookup_literal (cb_tree x, int make_decimal) -{ - struct cb_literal *literal; - struct literal_list *l; - FILE *savetarget; - - literal = CB_LITERAL (x); - /* Search literal cache */ - for (l = literal_cache; l; l = l->next) { - if (CB_TREE_CLASS (literal) == CB_TREE_CLASS (l->literal) - && literal->size == l->literal->size - && literal->all == l->literal->all - && literal->sign == l->literal->sign - && literal->scale == l->literal->scale - && memcmp (literal->data, l->literal->data, - (size_t)literal->size) == 0) { - if (make_decimal) { - l->make_decimal = 1; - } - return l->id; - } - } - - /* Output new literal */ - savetarget = output_target; - output_target = NULL; - output_field (x); - - output_target = savetarget; - - /* Cache it */ - l = cobc_parse_malloc (sizeof (struct literal_list)); - l->id = cb_literal_id; - l->literal = literal; - l->make_decimal = make_decimal; - l->x = x; - l->next = literal_cache; - literal_cache = l; - - return cb_literal_id++; -} - -/* - * Should numeric literal for truncated into a PIC S9(9) BINARY field, ignoring scale? - * (This is the way that Micro Focus COBOL works; RJN Nov 2016) - */ -static int -cb_fit_to_int (const cb_tree x) -{ - struct cb_literal *l; - int scale, sts; - -#ifndef WORDS_BIGENDIAN - if (cb_binary_byteorder == CB_BYTEORDER_BIG_ENDIAN) { - gen_num_lit_big_end = 1; - } else { - gen_num_lit_big_end = 0; - } -#else - gen_num_lit_big_end = 1; -#endif - - if (CB_NUMERIC_LITERAL_P (x)) { - if (gen_num_lit_big_end) - return 1; - l = CB_LITERAL (x); - if (l->scale > 0) { - scale = l->scale; - l->scale = 0; - sts = cb_fits_int ( x ); - l->scale = scale; - return sts; - } - } - - return cb_fits_int ( x ); -} - -/* Integer */ - -static void -output_integer (cb_tree x) -{ - struct cb_binary_op *p; - struct cb_cast *cp; - struct cb_field *f; - - switch (CB_TREE_TAG (x)) { - case CB_TAG_CONST: - if (x == cb_zero) { - output ("0"); - } else if (x == cb_null) { - output ("(cob_u8_ptr)NULL"); - } else { - output ("%s", CB_CONST (x)->val); - } - break; - case CB_TAG_INTEGER: -#ifdef USE_INT_HEX /* Simon: using this increases the struct and we - *should* pass the flags as constants in any case... */ - if (CB_INTEGER (x)->hexval) { - output ("0x%X", CB_INTEGER (x)->val); - } else { - output ("%d", CB_INTEGER (x)->val); - } -#else - output ("%d", CB_INTEGER (x)->val); -#endif - break; - case CB_TAG_LITERAL: - output ("%d", cb_get_int (x)); - break; - case CB_TAG_BINARY_OP: - p = CB_BINARY_OP (x); - if (p->flag) { - if (!cb_fits_int (p->x) || !cb_fits_int (p->y)) { - output ("cob_get_int ("); - output_param (x, -1); - output (")"); - break; - } - } - if (p->op == '^') { - output ("(int) pow ("); - output_integer (p->x); - output (", "); - output_integer (p->y); - output (")"); - } else { - output ("("); -#ifdef COB_NON_ALIGNED - if (CB_TREE_TAG (p->x) == CB_TAG_REFERENCE - && p->x != cb_null) { - f = cb_code_field (p->x); - /* typecast is required on Sun because pointer - * arithmetic is not allowed on (void *) - */ - if (f->usage == CB_USAGE_POINTER - || f->usage == CB_USAGE_PROGRAM_POINTER) { - output ("(cob_u8_ptr)"); - } - } -#endif - output_integer (p->x); - output (" %c ", p->op); -#ifdef COB_NON_ALIGNED - if (CB_TREE_TAG (p->y) == CB_TAG_REFERENCE - && p->y != cb_null) { - f = cb_code_field (p->y); - /* typecast is required on Sun because pointer - * arithmetic is not allowed on (void *) - */ - if (f->usage == CB_USAGE_POINTER - || f->usage == CB_USAGE_PROGRAM_POINTER) { - output ("(cob_u8_ptr)"); - } - } -#endif - output_integer (p->y); - output (")"); - } - break; - case CB_TAG_CAST: - cp = CB_CAST (x); - switch (cp->cast_type) { - case CB_CAST_ADDRESS: - output ("("); - output_data (cp->val); - output (")"); - break; - case CB_CAST_PROGRAM_POINTER: - output ("cob_call_field ("); - output_param (x, -1); - if (current_prog->nested_prog_list) { - gen_nested_tab = 1; - output (", cob_nest_tab, 0, %d)", cb_fold_call); - } else { - output (", NULL, 0, %d)", cb_fold_call); - } - break; - /* LCOV_EXCL_START */ - default: - cobc_err_msg (_("unexpected cast type: %d"), - (int)cp->cast_type); - COBC_ABORT (); - /* LCOV_EXCL_STOP */ - } - break; - case CB_TAG_REFERENCE: - f = cb_code_field (x); - switch (f->usage) { - case CB_USAGE_INDEX: - if (f->index_type != CB_NORMAL_INDEX) { - output_base (f, 1U); - output ("%s%d", CB_PREFIX_BASE, f->id); - return; - } - /* Fall through */ - case CB_USAGE_HNDL: - case CB_USAGE_HNDL_WINDOW: - case CB_USAGE_HNDL_SUBWINDOW: - case CB_USAGE_HNDL_FONT: - case CB_USAGE_HNDL_THREAD: - case CB_USAGE_HNDL_MENU: - case CB_USAGE_HNDL_VARIANT: - case CB_USAGE_HNDL_LM: - case CB_USAGE_LENGTH: - output ("(*(int *) ("); - output_data (x); - output ("))"); - return; - - case CB_USAGE_POINTER: - case CB_USAGE_PROGRAM_POINTER: -#ifdef COB_NON_ALIGNED - output ("(cob_get_pointer ("); - output_data (x); - output ("))"); -#else - output ("(*(unsigned char **) ("); - output_data (x); - output ("))"); -#endif - return; - - case CB_USAGE_DISPLAY: - if (f->pic - && f->pic->scale == 0 - && f->size > 8 - && f->size < 16 - && !f->flag_sign_clause - && !f->flag_any_numeric /* ANY NUMERIC format & usage could change */ - && !cb_ebcdic_sign) { - if (f->pic->have_sign) { - optimize_defs[COB_GET_NUMDISPS64] = 1; - output ("cob_get_numdisps64 ("); - } else { - optimize_defs[COB_GET_NUMDISP64] = 1; - output ("cob_get_numdisp64 ("); - } - output_data (x); - output (", %d)", f->size - f->pic->scale); - return; - } - if (f->pic - && f->pic->scale >= 0 - && f->size - f->pic->scale > 0 - && f->size - f->pic->scale <= 9 - && !f->flag_sign_clause - && !f->flag_any_numeric /* ANY NUMERIC format & usage could change */ - && !cb_ebcdic_sign) { - if (f->pic->have_sign) { - optimize_defs[COB_GET_NUMDISPS] = 1; - output ("cob_get_numdisps ("); - } else { - optimize_defs[COB_GET_NUMDISP] = 1; - output ("cob_get_numdisp ("); - } - output_data (x); - output (", %d)", f->size - f->pic->scale); - return; - } - break; - - case CB_USAGE_PACKED: - if (f->pic->scale == 0 && f->pic->digits < 10) { - optimize_defs[COB_GET_PACKED_INT] = 1; - output_func_1 ("cob_get_packed_int", x); - return; - } - break; - - case CB_USAGE_BINARY: - case CB_USAGE_COMP_5: - case CB_USAGE_COMP_X: - case CB_USAGE_COMP_N: - if (f->size == 1) { - output ("(*("); - if (!f->pic->have_sign) { - output ("cob_u8_ptr) ("); - } else { - output ("cob_s8_ptr) ("); - } - output_data (x); - output ("))"); - return; - } -#ifdef COB_NON_ALIGNED - if (f->storage != CB_STORAGE_LINKAGE && f->indexes == 0 && ( -#ifdef COB_SHORT_BORK - (f->size == 2 && (f->offset % 4 == 0)) || -#else - (f->size == 2 && (f->offset % 2 == 0)) || -#endif - (f->size == 4 && (f->offset % 4 == 0)) || - (f->size == 8 && (f->offset % 8 == 0)))) -#else - if (f->size == 2 || f->size == 4 || f->size == 8) -#endif - { - if (f->flag_binary_swap) { - output ("(("); - switch (f->size) { - case 2: - if (!f->pic->have_sign) { - output ("unsigned short)COB_BSWAP_16("); - } else { - output ("short)COB_BSWAP_16("); - } - break; - case 4: - if (!f->pic->have_sign) { - output ("unsigned int)COB_BSWAP_32("); - } else { - output ("int)COB_BSWAP_32("); - } - break; - case 8: - if (!f->pic->have_sign) { - output ("cob_u64_t)COB_BSWAP_64("); - } else { - output ("cob_s64_t)COB_BSWAP_64("); - } - break; - default: - break; - } - output ("*("); - switch (f->size) { - case 2: - output ("short *)("); - break; - case 4: - output ("int *)("); - break; - case 8: - output ("cob_s64_t *)("); - break; - default: - break; - } - output_data (x); - output (")))"); - return; - } else { - output ("(*("); - switch (f->size) { - case 2: - if (!f->pic->have_sign) { - output ("unsigned short *)("); - } else { - output ("short *)("); - } - break; - case 4: - if (!f->pic->have_sign) { - output ("unsigned int *)("); - } else { - output ("int *)("); - } - break; - case 8: - if (!f->pic->have_sign) { - output ("cob_u64_ptr)("); - } else { - output ("cob_s64_ptr)("); - } - break; - default: - break; - } - output_data (x); - output ("))"); - return; - } - } - if (f->pic->have_sign == 0) { - output ("(unsigned int)"); - } - break; - - default: - break; - } - - output_func_1 ("cob_get_int", x); - break; - - case CB_TAG_INTRINSIC: - output ("cob_get_int ("); - output_param (x, -1); - output (")"); - break; - /* LCOV_EXCL_START */ - default: - cobc_err_msg (_("unexpected tree tag: %d"), (int)CB_TREE_TAG (x)); - COBC_ABORT (); - /* LCOV_EXCL_STOP */ - } -} - -static void -output_long_integer (cb_tree x) -{ - struct cb_binary_op *p; - struct cb_cast *cp; - struct cb_field *f; - - switch (CB_TREE_TAG (x)) { - case CB_TAG_CONST: - if (x == cb_zero) { - output ("0"); - } else if (x == cb_null) { - output ("(cob_u8_ptr)NULL"); - } else { - output ("%s", CB_CONST (x)->val); - } - break; - case CB_TAG_INTEGER: -#ifdef USE_INT_HEX /* Simon: using this increases the struct and we - *should* pass the flags as constants in any case... */ - if (CB_INTEGER (x)->hexval) { - output ("0x%X", CB_INTEGER (x)->val); - } else { - output ("%d", CB_INTEGER (x)->val); - } -#else - output ("%d", CB_INTEGER (x)->val); -#endif - break; - case CB_TAG_LITERAL: - output (CB_FMT_LLD_F, cb_get_long_long (x)); - break; - case CB_TAG_BINARY_OP: - p = CB_BINARY_OP (x); - if (p->flag) { - if (!cb_fits_long_long (p->x) - || !cb_fits_long_long (p->y)) { - output ("cob_get_llint ("); - output_param (x, -1); - output (")"); - break; - } - } - if (p->op == '^') { - output ("(cob_s64_t) pow ("); - output_long_integer (p->x); - output (", "); - output_long_integer (p->y); - output (")"); - } else { - output ("("); - output_long_integer (p->x); - output (" %c ", p->op); - output_long_integer (p->y); - output (")"); - } - break; - case CB_TAG_CAST: - cp = CB_CAST (x); - switch (cp->cast_type) { - case CB_CAST_ADDRESS: - output ("("); - output_data (cp->val); - output (")"); - break; - case CB_CAST_PROGRAM_POINTER: - output ("cob_call_field ("); - output_param (x, -1); - if (current_prog->nested_prog_list) { - gen_nested_tab = 1; - output (", cob_nest_tab, 0, %d)", cb_fold_call); - } else { - output (", NULL, 0, %d)", cb_fold_call); - } - break; - /* LCOV_EXCL_START */ - default: - cobc_err_msg (_("unexpected cast type: %d"), - (int)cp->cast_type); - COBC_ABORT (); - /* LCOV_EXCL_STOP */ - } - break; - case CB_TAG_REFERENCE: - f = cb_code_field (x); - switch (f->usage) { - case CB_USAGE_INDEX: - if (f->index_type != CB_NORMAL_INDEX) { - output_base (f, 1U); - output ("(cob_s64_t)%s%d", CB_PREFIX_BASE, f->id); - return; - } - /* Fall through */ - case CB_USAGE_HNDL: - case CB_USAGE_HNDL_WINDOW: - case CB_USAGE_HNDL_SUBWINDOW: - case CB_USAGE_HNDL_FONT: - case CB_USAGE_HNDL_THREAD: - case CB_USAGE_HNDL_MENU: - case CB_USAGE_HNDL_VARIANT: - case CB_USAGE_HNDL_LM: - case CB_USAGE_LENGTH: - output ("(cob_s64_t)(*(int *) ("); - output_data (x); - output ("))"); - return; - - case CB_USAGE_POINTER: - case CB_USAGE_PROGRAM_POINTER: -#ifdef COB_NON_ALIGNED - output ("(cob_get_pointer ("); - output_data (x); - output ("))"); -#else - output ("(*(unsigned char **) ("); - output_data (x); - output ("))"); -#endif - return; - - case CB_USAGE_BINARY: - case CB_USAGE_COMP_5: - case CB_USAGE_COMP_X: - if (f->size == 1) { - output ("(*("); - if (!f->pic->have_sign) { - output ("cob_u8_ptr) ("); - } else { - output ("cob_s8_ptr) ("); - } - output_data (x); - output ("))"); - return; - } -#ifdef COB_NON_ALIGNED - if (f->storage != CB_STORAGE_LINKAGE && f->indexes == 0 && ( -#ifdef COB_SHORT_BORK - (f->size == 2 && (f->offset % 4 == 0)) || -#else - (f->size == 2 && (f->offset % 2 == 0)) || -#endif - (f->size == 4 && (f->offset % 4 == 0)) || - (f->size == 8 && (f->offset % 8 == 0)))) { -#else - if (f->size == 2 || f->size == 4 || f->size == 8) { -#endif - if (f->flag_binary_swap) { - output ("(("); - switch (f->size) { - case 2: - if (!f->pic->have_sign) { - output ("unsigned short)COB_BSWAP_16("); - } else { - output ("short)COB_BSWAP_16("); - } - break; - case 4: - if (!f->pic->have_sign) { - output ("unsigned int)COB_BSWAP_32("); - } else { - output ("int)COB_BSWAP_32("); - } - break; - case 8: - if (!f->pic->have_sign) { - output ("cob_u64_t)COB_BSWAP_64("); - } else { - output ("cob_s64_t)COB_BSWAP_64("); - } - break; - default: - break; - } - output ("*("); - switch (f->size) { - case 2: - output ("short *)("); - break; - case 4: - output ("int *)("); - break; - case 8: - output ("cob_s64_t *)("); - break; - default: - break; - } - output_data (x); - output (")))"); - return; - } else { - output ("(*("); - switch (f->size) { - case 2: - if (!f->pic->have_sign) { - output ("unsigned short *)("); - } else { - output ("short *)("); - } - break; - case 4: - if (!f->pic->have_sign) { - output ("unsigned int *)("); - } else { - output ("int *)("); - } - break; - case 8: - if (!f->pic->have_sign) { - output ("cob_u64_ptr)("); - } else { - output ("cob_s64_ptr)("); - } - break; - default: - break; - } - output_data (x); - output ("))"); - return; - } - } - break; - - default: - break; - } - - output_func_1 ("cob_get_llint", x); - break; - case CB_TAG_INTRINSIC: - output ("cob_get_llint ("); - output_param (x, -1); - output (")"); - break; - /* LCOV_EXCL_START */ - default: - cobc_err_msg (_("unexpected tree tag: %d"), (int)CB_TREE_TAG (x)); - COBC_ABORT (); - /* LCOV_EXCL_STOP */ - } -} - -static void -output_index (cb_tree x) -{ - struct cb_field *f; - switch (CB_TREE_TAG (x)) { - case CB_TAG_INTEGER: - output ("%d", CB_INTEGER (x)->val - 1); - break; - case CB_TAG_LITERAL: - output ("%d", cb_get_int (x) - 1); - break; - default: - output ("("); - if (CB_TREE_TAG (x) == CB_TAG_REFERENCE) { - f = cb_code_field (x); - if (f->pic - && f->pic->have_sign == 0) { /* Avoid ((unsigned int)(0 - 1)) */ - f->pic->have_sign = 1; /* Handle subscript as signed */ - output_integer (x); - f->pic->have_sign = 0; /* Restore to unsigned */ - } else { - output_integer (x); - } - } else { - output_integer (x); - } - output (" - 1)"); - break; - } -} - -/* ML output trees */ - -static struct cb_ml_generate_tree * -get_last_attr (const struct cb_ml_generate_tree * const s) -{ - struct cb_ml_generate_tree *attr; - - for (attr = s->attrs; attr->sibling; attr = attr->sibling); - return attr; -} - -static struct cb_ml_generate_tree * -get_last_child (const struct cb_ml_generate_tree * const s) -{ - struct cb_ml_generate_tree *child; - - for (child = s->children; child->sibling; child = child->sibling); - - if (child->children) { - return get_last_child (child); - } else { - return child; - } -} - -static struct cb_ml_generate_tree * -get_prev_ml_tree_entry (const struct cb_ml_generate_tree * const s) -{ - if (s->prev_sibling) { - if (s->prev_sibling->children) { - return get_last_child (s->prev_sibling); - } else if (s->prev_sibling->attrs) { - return get_last_attr (s->prev_sibling); - } else { - return s->prev_sibling; - } - } else if (s->attrs) { - return get_last_attr (s); - } else if (s->parent) { - return s->parent; - } else { - return NULL; - } -} - -static void -output_ml_attrs_definitions (struct cb_ml_generate_tree *attr) -{ - /* TO-DO: Where does xa_7 come from?? (See test.c.l.h) */ - for (; attr; attr = attr->sibling) { - output_local ("static cob_ml_attr\t%s%d;\n", - CB_PREFIX_ML_ATTR, attr->id); - } -} - -static void -output_ml_trees_definitions (struct cb_ml_generate_tree *tree) -{ - for (; tree; tree = tree->sibling) { - output_ml_attrs_definitions (tree->attrs); - output_ml_trees_definitions (tree->children); - output_local ("static cob_ml_tree\t%s%d;\n", CB_PREFIX_ML_TREE, tree->id); - } -} - -/* Parameter */ - -static void -output_param (cb_tree x, int id) -{ - struct cb_reference *r; - struct cb_field *f; - struct cb_field *ff; - struct cb_cast *cp; - struct cb_binary_op *bp; - struct field_list *fl; - FILE *savetarget; - struct cb_intrinsic *ip; - struct cb_alphabet_name *abp; - struct cb_alphabet_name *rbp; - cb_tree l; - char *func; - int n; - int sav_stack_id; - char fname[12]; - - if (x == NULL) { - output ("NULL"); - return; - } - - param_id = id; - - switch (CB_TREE_TAG (x)) { - case CB_TAG_CONST: - if (x == cb_quote) { - gen_figurative |= CB_NEED_QUOTE; - } else if (x == cb_norm_low) { - gen_figurative |= CB_NEED_LOW; - } else if (x == cb_norm_high) { - gen_figurative |= CB_NEED_HIGH; - } else if (x == cb_space) { - gen_figurative |= CB_NEED_SPACE; - } else if (x == cb_zero) { - gen_figurative |= CB_NEED_ZERO; - } - output ("%s", CB_CONST (x)->val); - break; - case CB_TAG_INTEGER: - output_integer (x); - break; - case CB_TAG_STRING: - output_string (CB_STRING (x)->data, (int) CB_STRING (x)->size, 0); - break; - case CB_TAG_LOCALE_NAME: - output_param (CB_LOCALE_NAME(x)->list, id); - break; - case CB_TAG_ALPHABET_NAME: - abp = CB_ALPHABET_NAME (x); - switch (abp->alphabet_type) { - case CB_ALPHABET_ASCII: -#ifdef COB_EBCDIC_MACHINE - gen_ebcdic_ascii = 1; - output ("cob_ebcdic_ascii"); - break; -#endif - /* Fall through for ASCII */ - case CB_ALPHABET_NATIVE: - if (current_prog->collating_sequence) { - gen_native = 1; - output ("cob_native"); - } else { - output ("NULL"); - } - break; - case CB_ALPHABET_EBCDIC: -#ifdef COB_EBCDIC_MACHINE - if (current_prog->collating_sequence) { - gen_native = 1; - output ("cob_native"); - } else { - output ("NULL"); - } -#else - if (cb_flag_alt_ebcdic) { - gen_alt_ebcdic = 1; - output ("cob_a2e"); - } else { - gen_full_ebcdic = 1; - output ("cob_ascii_ebcdic"); - } -#endif - break; - case CB_ALPHABET_CUSTOM: - gen_custom = 1; - output ("%s%s", CB_PREFIX_SEQUENCE, abp->cname); - break; - default: - break; - } - break; - case CB_TAG_CAST: - cp = CB_CAST (x); - switch (cp->cast_type) { - case CB_CAST_INTEGER: - output_integer (cp->val); - break; - case CB_CAST_LONG_INT: - output_long_integer (cp->val); - break; - case CB_CAST_ADDRESS: - output_data (cp->val); - break; - case CB_CAST_ADDR_OF_ADDR: - output ("&"); - output_data (cp->val); - break; - case CB_CAST_LENGTH: - output_size (cp->val); - break; - case CB_CAST_PROGRAM_POINTER: - output_param (cp->val, id); - break; - default: - break; - } - break; - case CB_TAG_DECIMAL: - output ("d%d", CB_DECIMAL (x)->id); - break; - case CB_TAG_DECIMAL_LITERAL: - output ("%s%d", CB_PREFIX_DEC_CONST, CB_DECIMAL_LITERAL (x)->id); - break; - case CB_TAG_FILE: - output ("%s%s", CB_PREFIX_FILE, CB_FILE (x)->cname); - break; - case CB_TAG_REPORT: - output ("&%s%s", CB_PREFIX_REPORT, CB_REPORT_PTR (x)->cname); - break; - case CB_TAG_REPORT_LINE: -#if 1 /* FIXME: Why do we need the unchecked cast here? */ - r = (struct cb_reference *)x; -#else - r = CB_REFERENCE (x); -#endif - f = CB_FIELD (r->value); - output ("&%s%d", CB_PREFIX_REPORT_LINE, f->id); - break; - case CB_TAG_LITERAL: - if (nolitcast) { - output ("&%s%d", CB_PREFIX_CONST, cb_lookup_literal (x, 0)); - } else { - output ("(cob_field *)&%s%d", CB_PREFIX_CONST, - cb_lookup_literal (x, 0)); - } - break; - case CB_TAG_FIELD: - x = cb_build_field_reference (CB_FIELD (x), NULL); - /* Fall through */ - case CB_TAG_REFERENCE: - r = CB_REFERENCE (x); - if (CB_LOCALE_NAME_P (r->value)) { - output_param (CB_LOCALE_NAME(r->value)->list, id); - break; - } - if (CB_REPORT_P (r->value)) { - output ("&%s%s", CB_PREFIX_REPORT, CB_REPORT_PTR (r->value)->cname); - break; - } - if (r->check) { - inside_stack[inside_check++] = 0; - /* LCOV_EXCL_START */ - if (inside_check >= COB_INSIDE_SIZE) { - cobc_err_msg (_("internal statement stack depth exceeded: %d"), - COB_INSIDE_SIZE); - COBC_ABORT (); - } - /* LCOV_EXCL_STOP */ - output_newline (); - output_prefix (); - output ("("); - n = output_indent_level; - output_indent_level = 0; - for (l = r->check; l; l = CB_CHAIN (l)) { - sav_stack_id = stack_id; - output_stmt (CB_VALUE (l)); - stack_id = sav_stack_id; - if (l == r->check) { - output_indent_level = n; - } - } - } - - if (CB_FILE_P (r->value)) { - output ("%s%s", CB_PREFIX_FILE, CB_FILE (r->value)->cname); - if (r->check) { - if (inside_check) { - --inside_check; - } - output (" )"); - } - break; - } - if (CB_ALPHABET_NAME_P (r->value)) { - rbp = CB_ALPHABET_NAME (r->value); - switch (rbp->alphabet_type) { - case CB_ALPHABET_ASCII: -#ifdef COB_EBCDIC_MACHINE - gen_ebcdic_ascii = 2; - output ("&f_ebcdic_ascii"); - break; -#endif - /* Fall through for ASCII */ - case CB_ALPHABET_NATIVE: - gen_native = 2; - output ("&f_native"); - break; - case CB_ALPHABET_EBCDIC: -#ifdef COB_EBCDIC_MACHINE - gen_native = 2; - output ("&f_native"); -#else - gen_full_ebcdic = 2; - output ("&f_ascii_ebcdic"); -#endif - break; - case CB_ALPHABET_CUSTOM: - gen_custom = 1; - output ("&%s%s", CB_PREFIX_FIELD, rbp->cname); - break; - default: - break; - } - if (r->check) { - if (inside_check) { - --inside_check; - } - output (" )"); - } - break; - } - - /* LCOV_EXCL_START */ - if (!CB_FIELD_P (r->value)) { - cobc_err_msg (_("call to '%s' with invalid parameter '%s'"), - "output_param", "x"); - cobc_err_msg (_("%s is not a field"), r->word->name); - COBC_ABORT (); - } - /* LCOV_EXCL_STOP */ - - f = CB_FIELD (r->value); - - ff = real_field_founder (f); - - if (ff->flag_external) { - f->flag_external = 1; - f->flag_local = 1; - } else if (ff->flag_item_based) { - f->flag_local = 1; - } - - if (!r->subs - && !r->offset - && f->count > 0 - && !chk_field_variable_size (f) - && !chk_field_variable_address (f)) { - if (!f->flag_field) { - savetarget = output_target; - output_target = NULL; - output_field (x); - - fl = cobc_parse_malloc (sizeof (struct field_list)); - fl->x = x; - fl->f = f; - fl->curr_prog = excp_current_program_id; - if (f->index_type != CB_INT_INDEX - && (f->flag_is_global - || current_prog->flag_file_global)) { - fl->next = field_cache; - field_cache = fl; - } else { - fl->next = local_field_cache; - local_field_cache = fl; - } - - f->flag_field = 1; - output_target = savetarget; - } - if (f->flag_local - && !f->flag_data_set) { - output ("COB_SET_DATA (%s%d, ", - CB_PREFIX_FIELD, f->id); - output_data (x); - output (")"); - } else { - if (screenptr && f->storage == CB_STORAGE_SCREEN) { - output ("&%s%d", CB_PREFIX_SCR_FIELD, f->id); - } else { - output ("&%s%d", CB_PREFIX_FIELD, f->id); - } - } - } else { - if (stack_id >= num_cob_fields) { - num_cob_fields = stack_id + 1; - } - sprintf (fname, "f%d", stack_id++); - if (inside_check != 0) { - if (inside_stack[inside_check - 1] != 0) { - inside_stack[inside_check - 1] = 0; - output (","); - output_newline (); - output_prefix (); - } - } - output ("COB_SET_FLD(%s, ", fname); - output_size (x); - output (", "); - output_data (x); - output (", "); - output_attr (x); - output (")"); - } - - if (r->check) { - if (inside_check) { - --inside_check; - } - output (" )"); - } - break; - case CB_TAG_BINARY_OP: - bp = CB_BINARY_OP (x); - output ("cob_intr_binop ("); - output_param (bp->x, id); - output (", "); - if (isprint(bp->op) - && bp->op != '"' - && bp->op != '\'') { - output ("'%c'", bp->op); - } else { - output ("%d", bp->op); - } - output (", "); - output_param (bp->y, id); - output (")"); - break; - case CB_TAG_INTRINSIC: - ip = CB_INTRINSIC (x); - if (ip->isuser) { - l = cb_ref (ip->name); - /* LCOV_EXCL_START */ - if (l == cb_error_node) { - cobc_err_msg (_("call to '%s' with invalid parameter '%s'"), - "output_param", "x"); - /* not translated as it is a highly unlikely internal abort */ - cobc_err_msg ("%s is no valid reference", cb_name (ip->name)); - COBC_ABORT (); - } - /* LCOV_EXCL_STOP */ - /* always convert function names to upper case */ - func = cb_encode_program_id (CB_PROTOTYPE (l)->ext_name, 0, COB_FOLD_UPPER); - lookup_func_call (func); - output ("func_%s.funcfld (&cob_dyn_%u", func, gen_dynamic); - gen_dynamic++; - if (ip->intr_field || ip->args) { - output (", "); - } -#if 0 /* RXWRXW Func */ - if (ip->intr_tab->refmod) { - if (ip->offset) { - output_integer (ip->offset); - output (", "); - } else { - output ("0, "); - } - if (ip->length) { - output_integer (ip->length); - } else { - output ("0"); - } - if (ip->intr_field || ip->args) { - output (", "); - } - } -#endif - } else { - output ("%s (", ip->intr_tab->intr_routine); - if (ip->intr_tab->refmod) { - if (ip->offset) { - output_integer (ip->offset); - output (", "); - } else { - output ("0, "); - } - if (ip->length) { - output_integer (ip->length); - } else { - output ("0"); - } - if (ip->intr_field || ip->args) { - output (", "); - } - } - } - if (ip->intr_field) { - if (ip->intr_field == cb_int0) { - output ("NULL"); - } else if (ip->intr_field == cb_int1) { - output ("%u", cb_list_length (ip->args)); - } else { - output_param (ip->intr_field, id); - } - if (ip->args) { - output (", "); - } - } - for (l = ip->args; l; l = CB_CHAIN (l)) { - output_param (CB_VALUE (l), id); - id++; - param_id++; - if (CB_CHAIN (l)) { - output (", "); - } - } - output (")"); - break; - case CB_TAG_ML_TREE: - output ("&%s%d", CB_PREFIX_ML_TREE, CB_ML_TREE (x)->id); - break; - - case CB_TAG_FUNCALL: - output_funcall (x); - break; - /* LCOV_EXCL_START */ - default: - cobc_err_msg (_("unexpected tree tag: %d"), (int)CB_TREE_TAG (x)); - COBC_ABORT (); - /* LCOV_EXCL_STOP */ - } -} - -/* Function call */ - -static void -output_funcall_typed_report (struct cb_funcall *p, const char type) -{ - struct cb_report *r; - - /* initialization for report */ - r = CB_REPORT_PTR (p->argv[0]); - - switch (type) { - - case 'R': /* Generate REPORT line */ - generate_id++; - generate_bgn_lbl = -1; - if (r->has_declarative) { - output_block_open (); - output_line ("static\tint ctl;"); - output_line ("ctl = 0;"); - output_line ("goto gen_%d;",generate_id); - generate_bgn_lbl = add_new_label (); - output_line ("frame_ptr--;"); - output_line ("gen_%d:",generate_id); - if (r->id) { - output_line ("frame_ptr++;"); - output_line ("frame_ptr->perform_through = 0;"); - perform_label ("rwmove_",r->id,-1); - output_line("frame_ptr--;"); - } - output("\tctl = cob_report_generate ("); - output_param (p->argv[0], 0); - output(", "); - output_param (p->argv[1], 1); - output(", ctl);"); - output_newline (); - output_line ("switch(ctl) {"); - cb_emit_decl_case (r,r->records); - output ("\t}"); - output_newline (); - output_block_close (); - } else { - if (r->id) { - output_line ("\tframe_ptr++;"); - output_line ("\tframe_ptr->perform_through = 0;"); - perform_label ("rwmove_",r->id,-1); - output_line ("\tframe_ptr--;"); - output("\t"); - } - output ("cob_report_generate ("); - output_param (p->argv[0], 0); - output(", "); - output_param (p->argv[1], 1); - output (", 0)"); - } - break; - - case 'T': /* Terminate REPORT */ - generate_id++; - generate_bgn_lbl = -1; - if(r->has_declarative) { - output_block_open (); - output_line("static\tint ctl;"); - output_line("\tctl = 0;"); - output_line("\tgoto gen_%d;", generate_id); - generate_bgn_lbl = add_new_label(); - output_line ("\tframe_ptr--;"); - output_line ("gen_%d:", generate_id); - if (r->id) { - output_line ("\tframe_ptr++;"); - output_line ("\tframe_ptr->perform_through = 0;"); - perform_label("rwfoot_",r->id,-1); - output_line ("\tframe_ptr--;"); - } - output ("\tctl = cob_report_terminate ("); - output_param (p->argv[0], 0); - output_line (", ctl);"); - output_line ("\tswitch(ctl) {"); - cb_emit_decl_case(r,r->records); - output("\t}"); - output_newline (); - output_block_close (); - } else { - if(r->id) { - output_line ("\tframe_ptr++;"); - perform_label ("rwfoot_", r->id,-1); - output_line ("\tframe_ptr--;"); - output ("\t"); - } - output ("cob_report_terminate ("); - output_param (p->argv[0], 0); - output (", 0)"); - } - break; - - case 'M': /* Move data for REPORT */ - output_line ("\tgoto rwexit_%d;", r->id); - output("rwmove_%d: ",r->id); - break; - - case 't': /* Label for MOVE for just Footings */ - output("rwfoot_%d: ",r->id); - break; - - case 'm': /* End of Move data for REPORT */ - if (!cb_flag_computed_goto) { - output_line ("\tgoto P_switch;"); - } else { - output_line ("\tgoto *frame_ptr->return_address_ptr;"); - } - output("rwexit_%d: ",r->id); - break; - - case 'I': /* Initiate REPORT */ - if(r->t_lines) { - output_line ("/* Page Limit is %s */",cb_name (r->t_lines)); - output_prefix (); - output ("%s%s.def_lines = ", CB_PREFIX_REPORT, r->cname); - output_integer(r->t_lines); - output (";"); - output_newline (); - } - if(r->t_columns) { - output_line ("/* Page Limit is %s */",cb_name (r->t_columns)); - output_prefix (); - output ("%s%s.def_cols = ", CB_PREFIX_REPORT, r->cname); - output_integer(r->t_columns); - output (";"); - output_newline (); - } - if(r->t_heading) { - output_line ("/* Heading is %s */",cb_name (r->t_heading)); - output_prefix (); - output ("%s%s.def_heading = ", CB_PREFIX_REPORT, r->cname); - output_integer(r->t_heading); - output (";"); - output_newline (); - } - if(r->t_footing) { - output_line ("/* Footing is %s */",cb_name (r->t_footing)); - output_prefix (); - output ("%s%s.def_footing = ", CB_PREFIX_REPORT, r->cname); - output_integer(r->t_footing); - output (";"); - output_newline (); - } - if(r->t_first_detail) { - output_line ("/* First Detail is %s */",cb_name (r->t_first_detail)); - output_prefix (); - output ("%s%s.def_first_detail = ", CB_PREFIX_REPORT, r->cname); - output_integer(r->t_first_detail); - output (";"); - output_newline (); - } - if(r->t_last_detail) { - output_line ("/* Last Detail is %s */",cb_name (r->t_last_detail)); - output_prefix (); - output ("%s%s.def_last_detail = ", CB_PREFIX_REPORT, r->cname); - output_integer(r->t_last_detail); - output (";"); - output_newline (); - } - if(r->t_last_control) { - output_line ("/* Last Control is %s */",cb_name (r->t_last_control)); - output_prefix (); - output ("%s%s.def_last_control = ", CB_PREFIX_REPORT, r->cname); - output_integer(r->t_last_control); - output (";"); - output_newline (); - } - if (r->code_clause) { - output_prefix (); - output ("%s%s.code_is = (char*)", CB_PREFIX_REPORT, r->cname); - output_data (r->code_clause); - output (";"); - output_newline (); - output_prefix (); - output ("%s%s.code_len = ", CB_PREFIX_REPORT, r->cname); - output_size (r->code_clause); - output (";"); - output_newline (); - output_line ("%s%s.code_is_present = 1;", CB_PREFIX_REPORT, r->cname); - } else { - output_line ("%s%s.code_is_present = 0;", CB_PREFIX_REPORT, r->cname); - } - output_prefix (); - output ("cob_report_initiate ("); - output_param (p->argv[0], 0); - output (")"); - break; - - /* LCOV_EXCL_START */ - default: - cobc_err_msg (_("unexpected function: %s"), p->name); - COBC_ABORT (); - /* LCOV_EXCL_STOP */ - } -} - -static void -output_funcall_typed (struct cb_funcall *p, const char type) -{ - switch (type) { - - case 'E': /* Set of one character */ - output ("*("); - output_data (p->argv[0]); - output (") = "); - output_param (p->argv[1], 1); - break; - - case 'F': /* Move of one character */ - output ("*("); - output_data (p->argv[0]); - output (") = *("); - output_data (p->argv[1]); - output (")"); - break; - - case 'G': - /* Test of one character */ - output ("(int)(*("); - output_data (p->argv[0]); - if (p->argv[1] == cb_space) { - output (") - ' ')"); - } else if (p->argv[1] == cb_zero) { - output (") - '0')"); - } else if (p->argv[1] == cb_low) { - output ("))"); - } else if (p->argv[1] == cb_high) { - output (") - 255)"); - } else if (CB_LITERAL_P (p->argv[1])) { - output (") - %d)", *(CB_LITERAL (p->argv[1])->data)); - } else { - output (") - *("); - output_data (p->argv[1]); - output ("))"); - } - break; - - case 'R': /* Generate REPORT line */ - case 'T': /* Terminate REPORT */ - case 'M': /* Move data for REPORT */ - case 't': /* Label for MOVE for just Footings */ - case 'm': /* End of Move data for REPORT */ - case 'I': /* Initiate REPORT */ - output_funcall_typed_report (p, type); - break; - - case 'S': /* Suppress flag on */ - output ("%s", CB_PREFIX_REPORT_LINE); - output_param (p->argv[1], 0); - output (".suppress = 1;"); - output_newline (); - output("cob_report_suppress ("); - output_param (p->argv[0], 0); - output(", "); - output ("&%s",CB_PREFIX_REPORT_LINE); - output_param (p->argv[1], 0); - output(");"); - break; - - case ':': - output (" ("); - output_integer (p->argv[0]); - switch ((int)(long)(p->argv[1])) { - case '=': output(" == "); break; - case '<': output(" < "); break; - case '[': output(" <= "); break; - case '>': output(" > "); break; - case ']': output(" >= "); break; - case '~': output(" != "); break; - case '*': output(" * "); break; - case '-': output(" - "); break; - case '+': output(" + "); break; - case '/': output(" / "); break; - default: - cobc_err_msg (_("unexpected operator: %c"), (int)(long)p->argv[1]); - COBC_ABORT (); - } - output_integer (p->argv[2]); - output (") "); - break; - - /* LCOV_EXCL_START */ - default: - cobc_err_msg (_("unexpected function: %s"), p->name); - COBC_ABORT (); - /* LCOV_EXCL_STOP */ - } -} - - -static void -output_funcall (cb_tree x) -{ - struct cb_funcall *p; - cb_tree l; - int i; - - p = CB_FUNCALL (x); - if (p->name[0] == '$') { - output_funcall_typed (p, p->name[1]); - return; - } - - screenptr = p->screenptr; - output ("%s (", p->name); - for (i = 0; i < p->argc; i++) { - if (p->varcnt && i + 1 == p->argc) { - output ("%d, ", p->varcnt); - for (l = p->argv[i]; l; l = CB_CHAIN (l)) { - if (CB_VALUE (l) && CB_LITERAL_P (CB_VALUE (l))) { - nolitcast = p->nolitcast; - } - output_param (CB_VALUE (l), i); - nolitcast = 0; - i++; - if (CB_CHAIN (l)) { - output (", "); - } - } - } else { - if (p->argv[i] && CB_LITERAL_P (p->argv[i])) { - nolitcast = p->nolitcast; - } - output_param (p->argv[i], i); - nolitcast = 0; - if (i + 1 < p->argc) { - output (", "); - } - } - } - output (")"); - nolitcast = 0; - screenptr = 0; -} - -static void -output_func_1 (const char *name, cb_tree x) -{ - output ("%s (", name); - output_param (x, param_id); - output (")"); -} - -/* Condition */ - -static void -output_cond (cb_tree x, const int save_flag) -{ - struct cb_binary_op *p; - - switch (CB_TREE_TAG (x)) { - case CB_TAG_CONST: - if (x == cb_true) { - output ("1"); - } else if (x == cb_false) { - output ("0"); - /* LCOV_EXCL_START */ - } else { - cobc_err_msg ("invalid constant"); - COBC_ABORT (); - } - /* LCOV_EXCL_STOP */ - break; - case CB_TAG_BINARY_OP: - p = CB_BINARY_OP (x); - switch (p->op) { - case '!': - output ("!"); - output_cond (p->x, save_flag); - break; - - case '&': - case '|': - output ("("); - output_cond (p->x, save_flag); - output (p->op == '&' ? " && " : " || "); - output_newline (); - output_prefix (); - output (" "); - output_cond (p->y, save_flag); - output (")"); - break; - - case '=': - case '<': - case '[': - case '>': - case ']': - case '~': - output ("((int)"); - output_cond (p->x, save_flag); - switch (p->op) { - case '=': - output (" == 0"); - break; - case '<': - output (" < 0"); - break; - case '[': - output (" <= 0"); - break; - case '>': - output (" > 0"); - break; - case ']': - output (" >= 0"); - break; - case '~': - output (" != 0"); - break; - default: - /* FIXME - Check */ - break; - } - output (")"); - break; - - default: - output_integer (x); - break; - } - break; - case CB_TAG_FUNCALL: - if (save_flag) { - output ("(ret = "); - } - output_funcall (x); - if (save_flag) { - output (")"); - } - break; - case CB_TAG_LIST: - if (save_flag) { - output ("(ret = "); - } - inside_stack[inside_check++] = 0; - /* LCOV_EXCL_START */ - if (inside_check >= COB_INSIDE_SIZE) { - cobc_err_msg (_("internal statement stack depth exceeded: %d"), - COB_INSIDE_SIZE); - COBC_ABORT (); - } - /* LCOV_EXCL_STOP */ - output ("("); - output_newline (); - for (; x; x = CB_CHAIN (x)) { - output_stmt (CB_VALUE (x)); - } - if (inside_check) { - --inside_check; - } - output (")"); - if (save_flag) { - output (")"); - } - break; - /* LCOV_EXCL_START */ - default: - cobc_err_msg (_("unexpected tree tag: %d"), (int)CB_TREE_TAG (x)); - COBC_ABORT (); - /* LCOV_EXCL_STOP */ - } -} - -/* MOVE */ - -static void -output_move (cb_tree src, cb_tree dst) -{ - cb_tree x; - - /* Suppress warnings */ - suppress_warn = 1; - x = cb_build_move (src, dst); - if (x != cb_error_node) { - output_stmt (x); - } - suppress_warn = 0; -} - -/* INITIALIZE */ - -static int -deduce_initialize_type (struct cb_initialize *p, struct cb_field *f, - const int topfield) -{ - cb_tree l; - int type; - - /* LCOV_EXCL_START */ - if (f->flag_item_78) { - cobc_err_msg (_("unexpected CONSTANT item")); - COBC_ABORT (); - } - /* LCOV_EXCL_STOP */ - - if (f->flag_sign_separate /* Need to use cob_move for this one */ - && !f->children) { - return INITIALIZE_ONE; - } - - if (f->flag_external && !p->flag_init_statement) { - return INITIALIZE_NONE; - } - - if (f->redefines && (!topfield || !p->flag_init_statement)) { - return INITIALIZE_NONE; - } - - if (f->flag_filler && p->flag_no_filler_init && !f->children) { - return INITIALIZE_NONE; - } - - if (f->usage == CB_USAGE_CONTROL) { - return INITIALIZE_NONE; - } - - if (p->val && f->values) { - return INITIALIZE_ONE; - } - - if (p->var && CB_REFERENCE_P (p->var) - && CB_REFERENCE (p->var)->offset) { - /* Reference modified item */ - return INITIALIZE_ONE; - } - - if (f->children) { - type = deduce_initialize_type (p, f->children, 0); - if (type == INITIALIZE_ONE) { - return INITIALIZE_COMPOUND; - } - for (f = f->children->sister; f; f = f->sister) { - if (type != deduce_initialize_type (p, f, 0)) { - return INITIALIZE_COMPOUND; - } - } - return type; - } else { - for (l = p->rep; l; l = CB_CHAIN (l)) { - if ((int)CB_PURPOSE_INT (l) == (int)CB_TREE_CATEGORY (f)) { - return INITIALIZE_ONE; - } - } - } - - if (p->flag_default) { - if (cb_default_byte >= 0 && !p->flag_init_statement) { - return INITIALIZE_DEFAULT; - } - switch (f->usage) { - case CB_USAGE_FLOAT: - case CB_USAGE_DOUBLE: - case CB_USAGE_LONG_DOUBLE: - case CB_USAGE_FP_BIN32: - case CB_USAGE_FP_BIN64: - case CB_USAGE_FP_BIN128: - case CB_USAGE_FP_DEC64: - case CB_USAGE_FP_DEC128: - return INITIALIZE_ONE; - default: - break; - } - switch (CB_TREE_CATEGORY (f)) { - case CB_CATEGORY_NUMERIC_EDITED: - case CB_CATEGORY_ALPHANUMERIC_EDITED: - case CB_CATEGORY_NATIONAL_EDITED: - case CB_CATEGORY_FLOATING_EDITED: - return INITIALIZE_ONE; - default: - if (cb_tree_type (CB_TREE (f), f) == COB_TYPE_NUMERIC_PACKED) { - return INITIALIZE_ONE; - } else { - return INITIALIZE_DEFAULT; - } - } - } - - return INITIALIZE_NONE; -} - -static int -initialize_uniform_char (const struct cb_field *f, - const struct cb_initialize *p) -{ - int c; - - if (f->children) { - c = initialize_uniform_char (f->children, p); - for (f = f->children->sister; f; f = f->sister) { - if (!f->redefines) { - if (c != initialize_uniform_char (f, p)) { - return -1; - } - } - } - return c; - } else { - if (cb_default_byte >= 0 && !p->flag_init_statement) { - return cb_default_byte; - } - switch (cb_tree_type (CB_TREE (f), f)) { - case COB_TYPE_NUMERIC_BINARY: - return 0; - case COB_TYPE_NUMERIC_DISPLAY: - return '0'; - case COB_TYPE_ALPHANUMERIC: - return ' '; - default: - return -1; - } - } -} - -static void -output_figurative (cb_tree x, const struct cb_field *f, const int value, - const int init_occurs) -{ - /* REPORT lines are cleared to SPACES */ - if (f->storage == CB_STORAGE_REPORT - && value == ' ') - return; - output_prefix (); - /* Check for non-standard 01 OCCURS */ - if (init_occurs) { - output ("memset ("); - output_data (x); - output (", %d, %d);", value, f->occurs_max); - } else if (f->size == 1) { - output ("*(cob_u8_ptr)("); - output_data (x); - output (") = %d;", value); - } else { - output ("memset ("); - output_data (x); - if (CB_REFERENCE_P(x) && CB_REFERENCE(x)->length) { - output (", %d, ", value); - output_size (x); - output (");"); - } else { - output (", %d, %d);", value, f->size); - } - } - output_newline (); -} - -static void -output_initialize_literal (cb_tree x, struct cb_field *f, - struct cb_literal *l, const int init_occurs) -{ - int i; - int n; - int size; - int lsize; - - /* Check for non-standard 01 OCCURS */ - if (init_occurs) { - size = f->occurs_max; - lsize = (int)l->size; - /* Check truncated literal */ - if (lsize > f->size) { - lsize = f->size; - } - } else { - size = f->size; - lsize = (int)l->size; - } - if (lsize == 1) { - /* REPORT lines are cleared to SPACES */ - if (f->storage == CB_STORAGE_REPORT - && l->data[0] == ' ') - return; - output_prefix (); - output ("memset ("); - output_data (x); - if (CB_REFERENCE_P(x) && CB_REFERENCE(x)->length) { - output (", %d, ", l->data[0]); - output_size (x); - output (");"); - } else { - output (", %d, %d);", l->data[0], size); - } - output_newline (); - return; - } - if (lsize >= size) { - output_prefix (); - output ("memcpy ("); - output_data (x); - output (", "); - output_string (l->data, size, l->llit); - output (", %d);", size); - output_newline (); - return; - } - i = size / lsize; - i_counters[0] = 1; - output_line ("for (i0 = 0; i0 < %d; i0++)", i); - output_block_open (); - output_prefix (); - output ("memcpy ("); - output_data (x); - output (" + (i0 * %d), ", lsize); - output_string (l->data, lsize, l->llit); - output (", %d);", lsize); - output_newline (); - output_block_close (); - n = size % lsize; - if (n) { - output_prefix (); - output ("memcpy ("); - output_data (x); - output (" + (i0 * %d), ", lsize); - output_string (l->data, n, l->llit); - output (", %d);", n); - output_newline (); - } -} - -static void -output_initialize_fp_bindec (cb_tree x, struct cb_field *f) -{ - output_prefix (); - output ("memset ("); - output_data (x); - output (", 0, %d);", (int)f->size); - output_newline (); -} - -static void -output_initialize_fp (cb_tree x, struct cb_field *f) -{ - output_prefix (); - if (f->usage == CB_USAGE_FLOAT) { - output ("{float temp = 0.0;"); - } else { - output ("{double temp = 0.0;"); - } - output (" memcpy ("); - output_data (x); - output (", (void *)&temp, sizeof(temp));}"); - output_newline (); -} - -static void -output_initialize_uniform (cb_tree x, const int c, const int size) -{ - struct cb_field *f; - f = cb_code_field (x); - /* REPORT lines are cleared to SPACES */ - if (f->storage == CB_STORAGE_REPORT - && c == ' ') - return; - output_prefix (); - if (size == 1) { - output ("*(cob_u8_ptr)("); - output_data (x); - output (") = %d;", c); - } else { - output ("memset ("); - output_data (x); - if (size <= 0) { - output (", %d, ", c); - output_size (x); - output (");"); - } else if (CB_REFERENCE_P(x) && CB_REFERENCE(x)->length) { - output (", %d, ", c); - output_size (x); - output (");"); - } else { - output (", %d, %d);", c, size); - } - } - output_newline (); -} - -static void -output_initialize_chaining (struct cb_field *f, struct cb_initialize *p) -{ - /* only handle CHAINING for program initialization*/ - if (p->flag_init_statement) { - return; - } - /* Note: CHAINING must be an extra initialization step as parameters not passed - must have standard initialization */ - if (f->flag_chained) { - output_prefix (); - output ("cob_chain_setup ("); - output_data (p->var); - output (", %d, %d);", f->param_num, f->size); - output_newline (); - } -} - -static void -output_initialize_one (struct cb_initialize *p, cb_tree x) -{ - struct cb_field *f; - cb_tree value; - cb_tree lrp; - struct cb_literal *l; - size_t lsize; - cob_u32_t inci; - int i; - int n; - int size; - int offset; - int init_occurs; - unsigned char buffchar; - - f = cb_code_field (x); - - /* Initialize by value */ - if (p->val && f->values) { - value = CB_VALUE (f->values); - /* Check for non-standard OCCURS */ - if ((f->level == 1 || f->level == 77) && - f->flag_occurs && !p->flag_init_statement) { - init_occurs = 1; - } else { - init_occurs = 0; - } - if (value == cb_space) { - output_figurative (x, f, ' ', init_occurs); - return; - } else if (value == cb_low) { - output_figurative (x, f, 0, init_occurs); - return; - } else if (value == cb_high) { - output_figurative (x, f, 255, init_occurs); - return; - } else if (value == cb_quote) { - if (cb_flag_apostrophe) { - output_figurative (x, f, '\'', init_occurs); - } else { - output_figurative (x, f, '"', init_occurs); - } - return; - } else if (value == cb_zero && f->usage == CB_USAGE_DISPLAY) { - if (!f->flag_sign_separate && !f->flag_blank_zero) { - output_figurative (x, f, '0', init_occurs); - } else { - output_move (cb_zero, x); - } - return; - } else if (value == cb_null && f->usage == CB_USAGE_DISPLAY) { - output_figurative (x, f, 0, init_occurs); - return; - } else if (CB_LITERAL_P (value) && CB_LITERAL (value)->all) { - /* ALL literal */ - output_initialize_literal (x, f, - CB_LITERAL (value), init_occurs); - return; - } else if (CB_CONST_P (value) - || CB_TREE_CLASS (value) == CB_CLASS_NUMERIC) { - /* Figurative literal, numeric literal */ - /* Check for non-standard 01 OCCURS */ - if (init_occurs) { - i_counters[0] = 1; - output_line ("for (i0 = 1; i0 <= %d; i0++)", - f->occurs_max); - output_block_open (); - CB_REFERENCE (x)->subs = - CB_BUILD_CHAIN (cb_i[0], CB_REFERENCE (x)->subs); - output_move (value, x); - CB_REFERENCE (x)->subs = - CB_CHAIN (CB_REFERENCE (x)->subs); - output_block_close (); - } else { - output_move (value, x); - } - return; - } - /* Alphanumeric literal */ - /* We do not use output_move here because - we do not want to have the value be edited. */ - - l = CB_LITERAL (value); - - /* Check for non-standard 01 OCCURS */ - if (init_occurs) { - output_initialize_literal (x, f, l, 1); - return; - } - - size = f->size; - - if (size == 1) { - output_prefix (); - output ("*(cob_u8_ptr)("); - output_data (x); - output (") = %u;", l->data[0]); - output_newline (); - return; - } - - buffchar = l->data[0]; - for (lsize = 0; lsize < l->size; lsize++) { - if (l->data[lsize] != buffchar) { - break; - } - } - if (lsize == l->size) { - output_prefix (); - output ("memset ("); - output_data (x); - output (", %u, %d);", (unsigned int)buffchar, - (int)lsize); - output_newline (); - /* REPORT lines are cleared to SPACES */ - if (f->storage == CB_STORAGE_REPORT) { - return; - } - if ((int)l->size < (int)size) { - output_prefix (); - output ("memset ("); - output_data (x); - output (" + %d, ' ', %d);", - (int)lsize, (int)(size - lsize)); - output_newline (); - } - return; - } - - if (size > litsize) { - litsize = size + 128; - if (litbuff) { - litbuff = cobc_main_realloc (litbuff, (size_t)litsize); - } else { - litbuff = cobc_main_malloc ((size_t)litsize); - } - } - - if ((int)l->size >= (int)size) { - memcpy (litbuff, l->data, (size_t)size); - } else { - memcpy (litbuff, l->data, (size_t)l->size); - memset (litbuff + l->size, ' ', (size_t)size - l->size); - } - - buffchar = *(litbuff + size - 1); - n = 0; - for (i = size - 1; i >= 0; i--, n++) { - if (*(litbuff + i) != buffchar) { - break; - } - } - if (i < 0) { - output_prefix (); - output ("memset ("); - output_data (x); - output (", %u, %d);", (unsigned int)buffchar, size); - output_newline (); - return; - } - - if (n > 2) { - offset = size - n; - size -= n; - } else { - offset = 0; - } - - inci = 0; - for (; size > 509; size -= 509, inci += 509) { - output_prefix (); - output ("memcpy ("); - output_data (x); - if (!inci) { - output (", "); - } else { - output (" + %u, ", inci); - } - output_string (litbuff + inci, 509, l->llit); - output (", 509);"); - output_newline (); - } - - output_prefix (); - output ("memcpy ("); - output_data (x); - if (!inci) { - output (", "); - } else { - output (" + %u, ", inci); - } - output_string (litbuff + inci, size, l->llit); - output (", %d);", size); - output_newline (); - - if (offset > 0 - && n > 0) { - if (f->storage == CB_STORAGE_REPORT /* REPORT lines are cleared to SPACES */ - && buffchar == ' ') - return; - output_prefix (); - output ("memset ("); - output_data (x); - output (" + %d, %u, %d);", - offset, (unsigned int)buffchar, n); - output_newline (); - } - return; - } - - /* Initialize replacing */ - if (!f->children) { - for (lrp = p->rep; lrp; lrp = CB_CHAIN (lrp)) { - if ((int)CB_PURPOSE_INT (lrp) == (int)CB_TREE_CATEGORY (x)) { - output_move (CB_VALUE (lrp), x); - return; - } - } - } - - /* Initialize by default */ - if (p->flag_default) { - switch (f->usage) { - case CB_USAGE_FLOAT: - case CB_USAGE_DOUBLE: - case CB_USAGE_LONG_DOUBLE: - output_initialize_fp (x, f); - return; - case CB_USAGE_FP_BIN32: - case CB_USAGE_FP_BIN64: - case CB_USAGE_FP_BIN128: - case CB_USAGE_FP_DEC64: - case CB_USAGE_FP_DEC128: - output_initialize_fp_bindec (x, f); - return; - default: - break; - } - switch (CB_TREE_CATEGORY (x)) { - case CB_CATEGORY_NUMERIC: - case CB_CATEGORY_NUMERIC_EDITED: - case CB_CATEGORY_FLOATING_EDITED: - output_move (cb_zero, x); - break; - case CB_CATEGORY_ALPHANUMERIC: - case CB_CATEGORY_ALPHANUMERIC_EDITED: - case CB_CATEGORY_NATIONAL: - case CB_CATEGORY_NATIONAL_EDITED: - output_move (cb_space, x); - break; - /* LCOV_EXCL_START */ - default: - cobc_err_msg (_("unexpected tree category: %d"), - (int)CB_TREE_CATEGORY (x)); - COBC_ABORT (); - /* LCOV_EXCL_STOP */ - } - } -} - -static void -output_initialize_compound (struct cb_initialize *p, cb_tree x) -{ - struct cb_field *ff; - struct cb_field *f; - struct cb_field *last_field; - cb_tree c; - int type; - - ff = cb_code_field (x); - for (f = ff->children; f; f = f->sister) { - type = deduce_initialize_type (p, f, 0); - c = cb_build_field_reference (f, x); - - switch (type) { - case INITIALIZE_NONE: - break; - case INITIALIZE_DEFAULT: { - int last_char; - last_field = f; - last_char = initialize_uniform_char (f, p); - - if (last_char != -1) { - if (f->flag_occurs) { - CB_REFERENCE (c)->subs = - CB_BUILD_CHAIN (cb_int1, - CB_REFERENCE (c)->subs); - } - - for (; f->sister; f = f->sister) { - if (!f->sister->redefines) { - if (deduce_initialize_type (p, f->sister, 0) != INITIALIZE_DEFAULT || - initialize_uniform_char (f->sister, p) != last_char) { - break; - } - } - } - { - int size; - if (f->sister) { - size = f->sister->offset - last_field->offset; - } else { - size = ff->offset + ff->size - last_field->offset; - } - - output_initialize_uniform (c, last_char, size); - } - break; - } - } - /* Fall through */ - default: - if (f->flag_occurs) { - /* Begin occurs loop */ - int i = f->indexes; - i_counters[i] = 1; - output_line ("for (i%d = 1; i%d <= %d; i%d++)", - i, i, f->occurs_max, i); - output_block_open (); - CB_REFERENCE (c)->subs = - CB_BUILD_CHAIN (cb_i[i], CB_REFERENCE (c)->subs); - } - - if (type == INITIALIZE_ONE) { - output_initialize_one (p, c); - } else { - output_initialize_compound (p, c); - } - - if (f->flag_occurs) { - /* Close loop */ - CB_REFERENCE (c)->subs = CB_CHAIN (CB_REFERENCE (c)->subs); - output_block_close (); - } - } - } -} - -static void -output_initialize (struct cb_initialize *p) -{ - struct cb_field *f; - cb_tree x; - int c; - int type; - - f = cb_code_field (p->var); - type = deduce_initialize_type (p, f, 1); - /* Check for non-standard OCCURS */ - if ((f->level == 1 || f->level == 77) && - f->flag_occurs && !p->flag_init_statement) { - switch (type) { - case INITIALIZE_NONE: - return; - case INITIALIZE_ONE: - output_initialize_one (p, p->var); - output_initialize_chaining (f, p); - return; - case INITIALIZE_DEFAULT: - c = initialize_uniform_char (f, p); - if (c != -1) { - output_initialize_uniform (p->var, c, f->occurs_max); - output_initialize_chaining (f, p); - return; - } - /* Fall through */ - case INITIALIZE_COMPOUND: - i_counters[0] = 1; - output_line ("for (i0 = 1; i0 <= %d; i0++)", f->occurs_max); - output_block_open (); - x = cb_build_field_reference (f, NULL); - CB_REFERENCE (x)->subs = - CB_BUILD_CHAIN (cb_i[0], CB_REFERENCE (x)->subs); - output_initialize_compound (p, x); - CB_REFERENCE (x)->subs = - CB_CHAIN (CB_REFERENCE (x)->subs); - output_block_close (); - output_initialize_chaining (f, p); - return; - default: - break; - } - } - switch (type) { - case INITIALIZE_NONE: - return; - case INITIALIZE_ONE: - output_initialize_one (p, p->var); - output_initialize_chaining (f, p); - return; - case INITIALIZE_DEFAULT: - c = initialize_uniform_char (f, p); - if (c != -1) { - output_initialize_uniform (p->var, c, f->size); - output_initialize_chaining (f, p); - return; - } - /* Fall through */ - case INITIALIZE_COMPOUND: - output_initialize_compound (p, p->var); - output_initialize_chaining (f, p); - return; - default: - break; - } -} - -/* SEARCH */ - -static void -output_occurs (struct cb_field *p) -{ - if (p->depending) { - output_integer (p->depending); - } else { - output ("%d", p->occurs_max); - } -} - -static void -output_search_whens (cb_tree table, struct cb_field *p, cb_tree stmt, - cb_tree var, cb_tree whens) -{ - cb_tree l; - cb_tree idx = NULL; - - COB_UNUSED(table); /* to be handled later */ - - /* LCOV_EXCL_START */ - if (!p->index_list) { - cobc_err_msg (_("call to '%s' with invalid parameter '%s'"), - "output_search", "table"); - COBC_ABORT (); - } - /* LCOV_EXCL_STOP */ - - /* Determine the index to use */ - if (var) { - for (l = p->index_list; l; l = CB_CHAIN (l)) { - if (cb_ref (CB_VALUE (l)) == cb_ref (var)) { - idx = var; - } - } - } - if (!idx) { - idx = CB_VALUE (p->index_list); - } - - /* Start loop */ - skip_line_num++; - output_line ("for (;;) {"); - output_indent_level += 2; - - /* End test */ - output_prefix (); - output ("if ("); - output_integer (idx); - output (" > "); - output_occurs (p); - output (")"); - output_newline (); - output_block_open (); - output_line ("/* Table end */"); - if (stmt) { - output_stmt (stmt); - } else { - output_line ("break;"); - } - output_block_close (); - - /* WHEN test */ - output_stmt (whens); - - /* Iteration */ - output_newline (); - output_prefix (); - output_integer (idx); - output ("++;"); - output_newline (); - if (var && var != idx) { - output_move (idx, var); - } - output_line ("/* Iterate */"); - /* End loop */ - output_indent_level -= 2; - output_line ("}"); -} - -static void -output_search_all (cb_tree table, struct cb_field *p, cb_tree stmt, - cb_tree cond, cb_tree when) -{ - cb_tree idx; - - COB_UNUSED(table); /* to be handled later */ - - idx = CB_VALUE (p->index_list); - /* Header */ - output_block_open (); - output_line ("int ret;"); - output_line ("int head = 0;"); - output_prefix (); - output ("int tail = "); - output_occurs (p); - output (" + 1;"); - output_newline (); - - /* Check for at least one entry */ - output_prefix (); - output ("if ("); - output_occurs (p); - output (" == 0) head = tail;"); - output_newline (); - - /* Start loop */ - output_line ("for (;;)"); - output_block_open (); - - /* End test */ - output_line ("if (head >= tail - 1)"); - output_block_open (); - output_line ("/* Table end */"); - if (stmt) { - output_stmt (stmt); - } else { - output_line ("break;"); - } - output_block_close (); - - /* Next index */ - output_prefix (); - output_integer (idx); - output (" = (head + tail) / 2;"); - output_newline (); - output_newline (); - - /* WHEN test */ - output_line ("/* WHEN */"); - output_prefix (); - output ("if ("); - output_cond (cond, 1); - output (")"); - output_newline (); - output_block_open (); - output_stmt (when); - output_block_close (); - - output_line ("if (ret < 0)"); - output_prefix (); - output (" head = "); - output_integer (idx); - output (";"); - output_newline (); - output_line ("else"); - output_prefix (); - output (" tail = "); - output_integer (idx); - output (";"); - output_newline (); - output_block_close (); - output_block_close (); -} - -static void -output_search (struct cb_search *p) -{ - struct cb_field *fp = cb_code_field (p->table); - - /* TODO: Add run-time checks for the table, including ODO */ - - if (p->flag_all) { - output_search_all (p->table, fp, p->end_stmt, - CB_IF (p->whens)->test, CB_IF (p->whens)->stmt1); - } else { - output_search_whens (p->table, fp, p->end_stmt, p->var, p->whens); - } -} - -/* CALL */ - -#if 0 /* BWT, working through CALL BY VALUE */ -static void -debug_call_by_value(cb_tree x, cb_tree l) { - struct cb_field *f; - printf("CB_TREE_TAG(x) = %d\n", CB_TREE_TAG(x)); - printf("CB_TREE_CLASS(x) = %d\n", CB_TREE_CLASS(x)); - printf("CB_TREE_TAG(l) = %d\n", CB_TREE_TAG(l)); - printf("CB_TREE_CLASS(l) = %d\n", CB_TREE_CLASS(l)); - - f = cb_code_field (x); - printf("cb_code_field(x)->usage = %d\n", f->usage); - return; -} -#endif - -/** - * cast function pointer call frame to avoid default argument promotion - */ -static void -output_call_protocast (cb_tree x, cb_tree l) -{ - struct cb_field *f; - const char *s; - cob_s64_t val; - cob_u64_t uval; - int sizes; - int sign; - - switch (CB_TREE_TAG (x)) { - case CB_TAG_CAST: - output ("int"); - return; - case CB_TAG_INTRINSIC: - if (CB_INTRINSIC(x)->intr_tab->category == CB_CATEGORY_NUMERIC) { - output ("int"); - } else { - output ("void *"); - } - return; - case CB_TAG_LITERAL: - if (CB_TREE_CLASS (x) != CB_CLASS_NUMERIC) { - output ("int"); - return; - } - if (CB_SIZES_INT_UNSIGNED(l)) { - uval = cb_get_u_long_long (x); - switch (CB_SIZES_INT (l)) { - case CB_SIZE_AUTO: - if (uval > UINT_MAX) { - output ("cob_u64_t"); - return; - } - /* Fall through to case 4 */ - case CB_SIZE_4: - output ("cob_u32_t"); - return; - case CB_SIZE_1: - output ("cob_u8_t"); - return; - case CB_SIZE_2: - output ("cob_u16_t"); - return; - case CB_SIZE_8: - output ("cob_u64_t"); - return; - /* LCOV_EXCL_START */ - default: - cobc_err_msg (_("unexpected size: %d"), CB_SIZES_INT (l)); - COBC_ABORT (); - /* LCOV_EXCL_STOP */ - } - } - val = cb_get_long_long (x); - switch (CB_SIZES_INT (l)) { - case CB_SIZE_AUTO: - if (val > INT_MAX) { - output ("cob_s64_t"); - return; - } - /* Fall through to case 4 */ - case CB_SIZE_4: - output ("cob_s32_t"); - return; - case CB_SIZE_1: - output ("cob_s8_t"); - return; - case CB_SIZE_2: - output ("cob_s16_t"); - return; - case CB_SIZE_8: - output ("cob_s64_t"); - return; - /* LCOV_EXCL_START */ - default: - cobc_err_msg (_("unexpected size: %d"), CB_SIZES_INT (l)); - COBC_ABORT (); - /* LCOV_EXCL_STOP */ - } - return; - default: - f = cb_code_field (x); - switch (f->usage) { - case CB_USAGE_BINARY: - case CB_USAGE_COMP_5: - case CB_USAGE_COMP_X: - case CB_USAGE_COMP_N: - case CB_USAGE_PACKED: - case CB_USAGE_DISPLAY: - case CB_USAGE_COMP_6: - sizes = CB_SIZES_INT (l); - sign = 0; - if (sizes == CB_SIZE_AUTO) { - if (f->pic->have_sign) { - sign = 1; - } - if (f->usage == CB_USAGE_PACKED - || f->usage == CB_USAGE_DISPLAY - || f->usage == CB_USAGE_COMP_6) { - sizes = f->pic->digits - f->pic->scale; - } else { - sizes = f->size; - } - switch (sizes) { - case 0: - sizes = CB_SIZE_4; - break; - case 1: - sizes = CB_SIZE_1; - break; - case 2: - sizes = CB_SIZE_2; - break; - case 3: - sizes = CB_SIZE_4; - break; - case 4: - sizes = CB_SIZE_4; - break; - case 5: - sizes = CB_SIZE_8; - break; - case 6: - sizes = CB_SIZE_8; - break; - case 7: - sizes = CB_SIZE_8; - break; - default: - sizes = CB_SIZE_8; - break; - } - } else { - if (!CB_SIZES_INT_UNSIGNED(l)) { - sign = 1; - } - } - switch (sizes) { - case CB_SIZE_1: - if (sign) { - s = "cob_c8_t"; - } else { - s = "cob_u8_t"; - } - break; - case CB_SIZE_2: - if (sign) { - s = "cob_s16_t"; - } else { - s = "cob_u16_t"; - } - break; - case CB_SIZE_4: - if (sign) { - s = "cob_s32_t"; - } else { - s = "cob_u32_t"; - } - break; - case CB_SIZE_8: - if (sign) { - s = "cob_s64_t"; - } else { - s = "cob_u64_t"; - } - break; - default: - if (sign) { - s = "cob_s32_t"; - } else { - s = "cob_u32_t"; - } - break; - } - output ("%s", s); - return; - case CB_USAGE_INDEX: - output ("cob_s32_t"); - return; - case CB_USAGE_LENGTH: - output ("cob_u32_t"); - return; - case CB_USAGE_POINTER: - case CB_USAGE_PROGRAM_POINTER: - output ("void *"); - return; - case CB_USAGE_FLOAT: - output ("float"); - return; - case CB_USAGE_DOUBLE: - output ("double"); - return; - case CB_USAGE_LONG_DOUBLE: - output ("long double"); - return; - case CB_USAGE_FP_BIN32: - output ("cob_u32_t"); - return; - case CB_USAGE_FP_BIN64: - case CB_USAGE_FP_DEC64: - output ("cob_u64_t"); - return; - case CB_USAGE_FP_BIN128: - case CB_USAGE_FP_DEC128: - output ("cob_fp_128"); - return; - default: - output ("void *"); - return; - } - } -} - -/** - * dereference BY VALUE arguments, sync with call_output_protocast - */ -static void -output_call_by_value_args (cb_tree x, cb_tree l) -{ - struct cb_field *f; - const char *s; - cob_s64_t val; - cob_u64_t uval; - int sizes; - int sign; - - switch (CB_TREE_TAG (x)) { - case CB_TAG_CAST: - output_integer (x); - return; - case CB_TAG_INTRINSIC: - if (CB_INTRINSIC(x)->intr_tab->category == CB_CATEGORY_NUMERIC) { - output ("cob_get_int ("); - output_param (x, -1); - output (")"); - } else { - output_data (x); - } - return; - case CB_TAG_LITERAL: - if (CB_TREE_CLASS (x) != CB_CLASS_NUMERIC) { - output ("%d", CB_LITERAL (x)->data[0]); - return; - } - if (CB_SIZES_INT_UNSIGNED(l)) { - uval = cb_get_u_long_long (x); - switch (CB_SIZES_INT (l)) { - case CB_SIZE_AUTO: - if (uval > UINT_MAX) { - output ("(cob_u64_t)"); - output (CB_FMT_LLU_F, uval); - return; - } - /* Fall through to case 4 */ - case CB_SIZE_4: - output ("(cob_u32_t)"); - output (CB_FMT_LLU_F, uval); - return; - case CB_SIZE_1: - output ("(cob_u8_t)"); - output (CB_FMT_LLU_F, uval); - return; - case CB_SIZE_2: - output ("(cob_u16_t)"); - output (CB_FMT_LLU_F, uval); - return; - case CB_SIZE_8: - output ("(cob_u64_t)"); - output (CB_FMT_LLU_F, uval); - return; - /* LCOV_EXCL_START */ - default: - cobc_err_msg (_("unexpected size: %d"), CB_SIZES_INT (l)); - COBC_ABORT (); - /* LCOV_EXCL_STOP */ - } - } - val = cb_get_long_long (x); - switch (CB_SIZES_INT (l)) { - case CB_SIZE_AUTO: - if (val > INT_MAX) { - output ("(cob_s64_t)"); - output (CB_FMT_LLD_F, val); - return; - } - /* Fall through to case 4 */ - case CB_SIZE_4: - output ("(cob_s32_t)"); - output (CB_FMT_LLD_F, val); - return; - case CB_SIZE_1: - output ("(cob_s8_t)"); - output (CB_FMT_LLD_F, val); - return; - case CB_SIZE_2: - output ("(cob_s16_t)"); - output (CB_FMT_LLD_F, val); - return; - case CB_SIZE_8: - output ("(cob_s64_t)"); - output (CB_FMT_LLD_F, val); - return; - /* LCOV_EXCL_START */ - default: - cobc_err_msg (_("unexpected size: %d"), CB_SIZES_INT (l)); - COBC_ABORT (); - /* LCOV_EXCL_STOP */ - } - return; - default: - f = cb_code_field (x); - switch (f->usage) { - case CB_USAGE_BINARY: - case CB_USAGE_COMP_5: - case CB_USAGE_COMP_X: - case CB_USAGE_COMP_N: - case CB_USAGE_PACKED: - case CB_USAGE_DISPLAY: - case CB_USAGE_COMP_6: - sizes = CB_SIZES_INT (l); - sign = 0; - if (sizes == CB_SIZE_AUTO) { - if (f->pic->have_sign) { - sign = 1; - } - if (f->usage == CB_USAGE_PACKED - || f->usage == CB_USAGE_DISPLAY - || f->usage == CB_USAGE_COMP_6) { - sizes = f->pic->digits - f->pic->scale; - } else { - sizes = f->size; - } - switch (sizes) { - case 0: - sizes = CB_SIZE_4; - break; - case 1: - sizes = CB_SIZE_1; - break; - case 2: - sizes = CB_SIZE_2; - break; - case 3: - sizes = CB_SIZE_4; - break; - case 4: - sizes = CB_SIZE_4; - break; - case 5: - sizes = CB_SIZE_8; - break; - case 6: - sizes = CB_SIZE_8; - break; - case 7: - sizes = CB_SIZE_8; - break; - default: - sizes = CB_SIZE_8; - break; - } - } else { - if (!CB_SIZES_INT_UNSIGNED(l)) { - sign = 1; - } - } - switch (sizes) { - case CB_SIZE_1: - if (sign) { - s = "cob_c8_t"; - } else { - s = "cob_u8_t"; - } - break; - case CB_SIZE_2: - if (sign) { - s = "cob_s16_t"; - } else { - s = "cob_u16_t"; - } - break; - case CB_SIZE_4: - if (sign) { - s = "cob_s32_t"; - } else { - s = "cob_u32_t"; - } - break; - case CB_SIZE_8: - if (sign) { - s = "cob_s64_t"; - } else { - s = "cob_u64_t"; - } - break; - default: - if (sign) { - s = "cob_s32_t"; - } else { - s = "cob_u32_t"; - } - break; - } - output ("(%s)(", s); - output_integer (x); - output (")"); - return; - case CB_USAGE_INDEX: - case CB_USAGE_HNDL: - case CB_USAGE_HNDL_WINDOW: - case CB_USAGE_HNDL_SUBWINDOW: - case CB_USAGE_HNDL_FONT: - case CB_USAGE_HNDL_THREAD: - case CB_USAGE_HNDL_MENU: - case CB_USAGE_HNDL_VARIANT: - case CB_USAGE_HNDL_LM: - case CB_USAGE_LENGTH: - case CB_USAGE_POINTER: - case CB_USAGE_PROGRAM_POINTER: - output_integer (x); - return; - case CB_USAGE_FLOAT: - output ("*(float *)("); - output_data (x); - output (")"); - return; - case CB_USAGE_DOUBLE: - output ("*(double *)("); - output_data (x); - output (")"); - return; - case CB_USAGE_LONG_DOUBLE: - output ("*(long double *)("); - output_data (x); - output (")"); - return; - case CB_USAGE_FP_BIN32: - output ("*(cob_u32_t *)("); - output_data (x); - output (")"); - return; - case CB_USAGE_FP_BIN64: - case CB_USAGE_FP_DEC64: - output ("*(cob_u64_t *)("); - output_data (x); - output (")"); - return; - case CB_USAGE_FP_BIN128: - case CB_USAGE_FP_DEC128: - output ("*(cob_fp_128 *)("); - output_data (x); - output (")"); - return; - default: - output ("*("); - output_data (x); - output (")"); - return; - } - } -} - -static void -output_bin_field (const cb_tree x, const cob_u32_t id) -{ - int i; - cob_u32_t size; - cob_u32_t aflags; - cob_u32_t digits; - - if (!CB_NUMERIC_LITERAL_P (x)) { - return; - } - aflags = COB_FLAG_REAL_BINARY; - if (cb_fit_to_int (x)) { - size = 4; - digits = 9; - aflags = COB_FLAG_HAVE_SIGN; /* Drop: COB_FLAG_REAL_BINARY */ -#ifndef WORDS_BIGENDIAN - if (cb_binary_byteorder == CB_BYTEORDER_BIG_ENDIAN) { - aflags |= COB_FLAG_BINARY_SWAP; - } -#endif - } else { - size = 8; - digits = 18; - if (CB_LITERAL (x)->sign < 0) { - aflags |= COB_FLAG_HAVE_SIGN; - } - } - aflags |= COB_FLAG_CONSTANT; - i = lookup_attr (COB_TYPE_NUMERIC_BINARY, digits, 0, aflags, NULL, 0); - /* Note: some C compilers (SUN for one) will not accept inline initialization - with 'content_%u.data' because that is a local variable, - therefore generate this part of the assignment separately */ - output_line ("cob_field\tcontent_fb_%u = { %u, NULL, &%s%d };", - id, size, CB_PREFIX_ATTR, i); -} - -static COB_INLINE COB_A_INLINE int -is_literal_or_prototype_ref (cb_tree x) -{ - return CB_LITERAL_P (x) - || (CB_REFERENCE_P (x) && CB_PROTOTYPE_P (cb_ref (x))); -} - -static char * -get_program_id_str (cb_tree id_item) -{ - if (CB_LITERAL_P (id_item)) { - return (char *)(CB_LITERAL (id_item)->data); - } else { /* prototype */ - return (char *)CB_PROTOTYPE (cb_ref (id_item))->ext_name; - } -} - -static struct nested_list * -find_nested_prog_with_id (const char *encoded_id) -{ - struct nested_list *nlp; - - for (nlp = current_prog->nested_prog_list; nlp; nlp = nlp->next) { - if (!strcmp (encoded_id, nlp->nested_prog->program_id)) { - break; - } - } - - return nlp; -} - -static void -output_content (cb_tree x, int n, int addnul) -{ - output_line ("union {"); - output_prefix (); - output_indent_level += indent_adjust_level; - output ("unsigned char data["); - if (CB_REF_OR_FIELD_P (x)) { - output ("%u", (cob_u32_t)cb_code_field (x)->size); - } else { - output_size (x); - } - if (addnul) { - output ("+%d];",addnul); - } else { - output ("];"); - } - output_newline (); - output_line ("cob_s64_t datall;"); - output_line ("cob_u64_t dataull;"); - output_line ("int dataint;"); - output_indent_level -= indent_adjust_level; - output_line ("} content_%u;", n); -} - -static void -output_field_constant (cb_tree x, int n, const char *flagname) -{ - output_prefix (); - if (flagname) - output ("cob_field_%s (",flagname); - else - output ("cob_field_constant ("); - if (x != NULL) - output_param (x, -1); - else - output ("&content_fb_%u", n); - output (", &content_%s%u ", CB_PREFIX_FIELD, n); - output (", &content_%s%u ", CB_PREFIX_ATTR, n); - output (", &content_%u);", n); - output_newline (); -} - -static void -output_call (struct cb_call *p) -{ - cb_tree x; - cb_tree l; - const char *name_str; - struct nested_list *nlp; - const struct system_table *psyst = NULL; - const char *convention; - struct cb_text_list *ctl; - char *s, *callname, *system_call; - cob_u32_t n; - size_t ret_ptr = 0; - size_t gen_exit_program = 0; - size_t dynamic_link = 1; - size_t need_brace; - const int name_is_literal_or_prototype - = is_literal_or_prototype_ref (p->name); - int except_id; - unsigned int pval; - - except_id = 0; - if (p->call_returning && p->call_returning != cb_null && - CB_TREE_CLASS(p->call_returning) == CB_CLASS_POINTER) { - ret_ptr = 1; - } - system_call = NULL; - -#ifdef _WIN32 - if (p->convention & CB_CONV_STDCALL) { - convention = "_std"; - } else { - convention = ""; - } -#else - convention = ""; -#endif - - /* System routine entry points */ - if (p->is_system) { - psyst = &system_tab[p->is_system - 1]; - dynamic_link = 0; - system_call = (char *)psyst->syst_call; - } - - if (dynamic_link && name_is_literal_or_prototype) { - /* no static link for calls with exception statement */ - if ((cb_flag_static_call && !p->stmt1) - || (p->convention & CB_CONV_STATIC_LINK)) { - dynamic_link = 0; - } - - if (CB_LITERAL_P (p->name)) { - name_str = (const char *) CB_LITERAL (p->name)->data; - } else { /* prototype */ - name_str = CB_PROTOTYPE (cb_ref (p->name))->ext_name; - } - - for (ctl = cb_static_call_list; ctl; ctl = ctl->next) { - if (!strcmp (name_str, ctl->text)) { - dynamic_link = 0; - break; - } - } - for (ctl = cb_early_exit_list; ctl; ctl = ctl->next) { - if (!strcmp (name_str, ctl->text)) { - gen_exit_program = 1; - break; - } - } - } - need_brace = 0; - -#ifdef COB_NON_ALIGNED - if (dynamic_link && ret_ptr) { - if (!need_brace) { - need_brace = 1; - output_block_open (); - } - output_line ("void *temptr;"); - } -#endif - - if (CB_REFERENCE_P (p->name) - && CB_FIELD_P (CB_REFERENCE (p->name)->value) - && CB_FIELD (CB_REFERENCE (p->name)->value)->usage == CB_USAGE_PROGRAM_POINTER) { - dynamic_link = 0; - } - - /* - * Check for LENGTH OF as BY REFERENCE and change to BY CONTENT - * as LENGTH OF is effectively a numeric literal - */ - for (l = p->args, n = 1; l; l = CB_CHAIN (l), n++) { - x = CB_VALUE (l); - if (CB_PURPOSE_INT (l) == CB_CALL_BY_REFERENCE - && CB_REF_OR_FIELD_P (x) - && CB_TREE_CATEGORY (x) == CB_CATEGORY_NUMERIC - && cb_code_field (x)->usage == CB_USAGE_LENGTH) { - CB_PURPOSE (l) = cb_int (CB_CALL_BY_CONTENT); - } - } - - /* Set up arguments */ - for (l = p->args, n = 1; l; l = CB_CHAIN (l), n++) { - x = CB_VALUE (l); - switch (CB_PURPOSE_INT (l)) { - case CB_CALL_BY_REFERENCE: - if (CB_NUMERIC_LITERAL_P (x) || CB_BINARY_OP_P (x)) { - if (!need_brace) { - need_brace = 1; - output_block_open (); - } - output_line ("cob_content\tcontent_%u;", n); - output_bin_field (x, n); - } else if (CB_CAST_P (x)) { - if (!need_brace) { - need_brace = 1; - output_block_open (); - } - output_line ("void *ptr_%u;", n); - } - break; - case CB_CALL_BY_CONTENT: - if (CB_CAST_P (x)) { - if (!need_brace) { - need_brace = 1; - output_block_open (); - } - output_line ("void *ptr_%u;", n); - } else if (CB_TREE_TAG (x) != CB_TAG_INTRINSIC - && x != cb_null - && !(CB_CAST_P (x))) { - if (!need_brace) { - need_brace = 1; - output_block_open (); - } - if (CB_NUMERIC_LITERAL_P (x) - || CB_BINARY_OP_P (x) - || CB_CAST_P(x)) { - output_line ("cob_content\tcontent_%u;", n); - } else { - output_content (x, n, 1); - } - output_line ("cob_field content_%s%u;", CB_PREFIX_FIELD, n); - output_line ("cob_field_attr content_%s%u;", CB_PREFIX_ATTR, n); - output_bin_field (x, n); - } - break; - case CB_CALL_BY_VALUE: - if (!need_brace) { - need_brace = 1; - output_block_open (); - } - if (CB_TREE_TAG (x) == CB_TAG_REFERENCE - && CB_TREE_TAG (CB_REFERENCE(x)->value) == CB_TAG_FIELD - && CB_TREE_CATEGORY (x) == CB_CATEGORY_NUMERIC - && cb_code_field (x)->usage == CB_USAGE_LENGTH) { - if (CB_NUMERIC_LITERAL_P (x) - || CB_BINARY_OP_P (x) - || CB_CAST_P(x)) { - output_line ("cob_content\tcontent_%u;", n); - } else { - output_content (x, n, 0); - output_line ("cob_field content_%s%u;", CB_PREFIX_FIELD, n); - } - output_line ("cob_field_attr content_%s%u;", CB_PREFIX_ATTR, n); - output_bin_field (x, n); - } else { - if (CB_NUMERIC_LITERAL_P (x) - || CB_BINARY_OP_P (x) - || CB_CAST_P(x)) { - output_line ("cob_content\tcontent_%u;", n); - } else { - output_content (x, n, 0); - } - output_line ("cob_field_attr content_%s%u;", CB_PREFIX_ATTR, n); - output_line ("cob_field content_%s%u;", CB_PREFIX_FIELD, n); - } - break; - default: - break; - } - } - - if (need_brace) { - output_newline (); - } - - for (l = p->args, n = 1; l; l = CB_CHAIN (l), n++) { - x = CB_VALUE (l); - switch (CB_PURPOSE_INT (l)) { - case CB_CALL_BY_REFERENCE: - if (CB_NUMERIC_LITERAL_P (x)) { - /* Set 'data' after all variable declarations */ - output_line ("content_fb_%u.data = content_%u.data;", n, n); - - output_prefix (); - if (cb_fit_to_int (x)) { - pval = (unsigned int)cb_get_int (x); - output ("cob_set_int(&content_fb_%d, %d)",n,pval); - } else { - if (CB_LITERAL (x)->sign >= 0) { - output ("content_%u.dataull = ", n); - output (CB_FMT_LLU_F, - cb_get_u_long_long (x)); - } else { - output ("content_%u.datall = ", n); - output (CB_FMT_LLD_F, - cb_get_long_long (x)); - } - } - output (";"); - output_newline (); - } else if (CB_BINARY_OP_P (x)) { - output_prefix (); - output ("content_%u.dataint = ", n); - output_integer (x); - output (";"); - output_newline (); - } else if (CB_CAST_P (x)) { - output_prefix (); - output ("ptr_%u = ", n); - output_integer (x); - output (";"); - output_newline (); - } - break; - case CB_CALL_BY_CONTENT: - if (CB_CAST_P (x)) { - output_prefix (); - output ("ptr_%u = ", n); - output_integer (x); - output (";"); - output_newline (); - } else if (CB_TREE_TAG (x) != CB_TAG_INTRINSIC) { - if (CB_NUMERIC_LITERAL_P (x)) { - /* Set 'data' after all variable declarations */ - output_line ("content_fb_%u.data = content_%u.data;", n, n); - - output_prefix (); - if (cb_fit_to_int (x)) { - pval = (unsigned int)cb_get_int (x); - output ("cob_set_int(&content_fb_%d, %d)",n,pval); - } else if (CB_LITERAL (x)->sign >= 0) { - output ("content_%u.dataull = ", n); - output (CB_FMT_LLU_F, cb_get_u_long_long (x)); - } else { - output ("content_%u.datall = ", n); - output (CB_FMT_LLD_F, cb_get_long_long (x)); - } - output (";"); - output_newline (); - - output_field_constant (NULL, n, NULL); - } else if (CB_REF_OR_FIELD_P (x) - && CB_TREE_CATEGORY (x) == CB_CATEGORY_NUMERIC - && cb_code_field (x)->usage == CB_USAGE_LENGTH) { - output_field_constant (x, n, NULL); -#ifndef WORDS_BIGENDIAN - if (cb_binary_byteorder == CB_BYTEORDER_BIG_ENDIAN) { - output_line ("content_%s%u.flags |= COB_FLAG_BINARY_SWAP;", - CB_PREFIX_ATTR, n); - output_prefix (); - output ("content_%u.dataint = ", n); - output ("(unsigned int)COB_BSWAP_32("); - output_integer (x); - output (");"); - output_newline (); - } -#endif - } else if (x != cb_null && !(CB_CAST_P (x))) { - /* - * Create copy of cob_field&attr pointing to local copy of data - * and setting flag COB_FLAG_CONSTANT - */ - output_field_constant (x, n, "content"); - if (CB_LITERAL_P (x) - && !CB_NUMERIC_LITERAL_P (x)) { - output_line ("content_%u.data[%d] = 0;",n,CB_LITERAL (x)->size); - } - } - } - break; - case CB_CALL_BY_VALUE: - output_field_constant (x, n, "value"); - break; - default: - break; - } - } - - /* Set up parameter types */ - n = 0; - for (l = p->args; l; l = CB_CHAIN (l), n++) { - x = CB_VALUE (l); - field_iteration = n; - output_prefix (); - output ("cob_procedure_params[%u] = ", n); - switch (CB_TREE_TAG (x)) { - case CB_TAG_LITERAL: - if (CB_NUMERIC_LITERAL_P (x) - && CB_PURPOSE_INT (l) != CB_CALL_BY_VALUE) { - output ("&content_fb_%u", n + 1); - break; - } - /* Fall through */ - case CB_TAG_FIELD: - if (CB_PURPOSE_INT (l) == CB_CALL_BY_CONTENT - || CB_PURPOSE_INT (l) == CB_CALL_BY_VALUE) { - output ("&content_%s%u", CB_PREFIX_FIELD, n + 1); - break; - } - output_param (x, -1); - break; - case CB_TAG_INTRINSIC: - output_param (x, -1); - break; - case CB_TAG_REFERENCE: - switch (CB_TREE_TAG (CB_REFERENCE(x)->value)) { - case CB_TAG_LITERAL: - case CB_TAG_INTRINSIC: - if (CB_PURPOSE_INT (l) == CB_CALL_BY_CONTENT - || CB_PURPOSE_INT (l) == CB_CALL_BY_VALUE) { - output ("&content_%s%u", CB_PREFIX_FIELD, n + 1); - break; - } - output_param (x, -1); - break; - case CB_TAG_FIELD: - if (CB_PURPOSE_INT (l) == CB_CALL_BY_CONTENT - || CB_PURPOSE_INT (l) == CB_CALL_BY_VALUE - || (CB_TREE_CATEGORY (x) == CB_CATEGORY_NUMERIC - && cb_code_field (x)->usage == CB_USAGE_LENGTH)) { - output ("&content_%s%u", CB_PREFIX_FIELD, n + 1); - break; - } - output_param (x, -1); - break; - default: - output ("NULL"); - break; - } - break; - case CB_TAG_CONST: - if (CB_PURPOSE_INT (l) == CB_CALL_BY_CONTENT - || CB_PURPOSE_INT (l) == CB_CALL_BY_VALUE) { - output ("&content_%s%u", CB_PREFIX_FIELD, n + 1); - break; - } - if (x == cb_null) { - output ("NULL /*OMITTED*/"); - break; - } - default: - output ("NULL"); - break; - } - output (";"); - output_newline (); - } - - /* Set number of parameters */ - output_line ("cob_glob_ptr->cob_call_params = %u;", n); - if (recent_prog != NULL - && recent_prog->max_call_param > n) { - if ((recent_prog->max_call_param - n) > 1) { - output_line ("memset(&cob_procedure_params[%d],0,sizeof(cob_procedure_params[0])*%d);", - n, (recent_prog->max_call_param - n)); - } else { - output_line ("cob_procedure_params[%u] = NULL;", n); - } - } - callname = NULL; - - /* pass information about available ON EXCEPTION */ - if (p->stmt1) { - output_line ("cob_glob_ptr->cob_stmt_exception = 1;"); - output_line ("COB_RESET_EXCEPTION (0);"); - } else { - output_line ("cob_glob_ptr->cob_stmt_exception = 0;"); - } - - /* ensure that we don't have a program exception set already - as this will be checked directly when returning from CALL */ - output_line ("if (unlikely((cob_global_exception & 0x%04x) == 0x%04x)) " - "cob_global_exception = 0;", - CB_EXCEPTION_CODE(COB_EC_PROGRAM), CB_EXCEPTION_CODE(COB_EC_PROGRAM)); - - /* Function name */ - output_prefix (); - /* Special for program pointers */ - if (CB_REFERENCE_P (p->name) - && CB_FIELD_P (CB_REFERENCE (p->name)->value) - && CB_FIELD (CB_REFERENCE (p->name)->value)->usage - == CB_USAGE_PROGRAM_POINTER) { - needs_unifunc = 1; - output ("cob_unifunc.funcvoid = "); - output_integer (p->name); - output (";"); - output_newline (); - output_prefix (); - if (p->call_returning == cb_null) { - output ("cob_unifunc.funcnull"); - } else if (ret_ptr) { -#ifdef COB_NON_ALIGNED - output ("temptr"); -#else - output_integer (p->call_returning); -#endif - output (" = cob_unifunc.funcptr"); - } else { - if (p->convention & CB_CONV_NO_RET_UPD - || !current_prog->cb_return_code) { - output ("(void)cob_unifunc.funcint"); - } else { - output_integer (current_prog->cb_return_code); - output (" = cob_unifunc.funcint"); - } - } - } else if (!dynamic_link) { - /* Static link */ - if (system_call) { - callname = system_call; - } else { - callname = (char *)(CB_LITERAL (p->name)->data); - } - output_line ("cob_glob_ptr->cob_call_name_hash = 0x%X;", - cob_get_name_hash(callname)); - output_line ("COB_RESET_EXCEPTION (0);"); - output_prefix (); - if (p->call_returning != cb_null) { - if (ret_ptr) { -#ifdef COB_NON_ALIGNED - output ("temptr"); -#else - output_integer (p->call_returning); -#endif - output (" = (void *)"); - } else if (!(p->convention & CB_CONV_NO_RET_UPD) - && current_prog->cb_return_code) { - output_integer (current_prog->cb_return_code); - output (" = "); - } else { - output ("(void)"); - } - } - if (psyst) { - output ("%s", (char *)psyst->syst_call); - } else { - s = get_program_id_str (p->name); - name_str = cb_encode_program_id (s, 1, cb_fold_call); - - /* Check contained programs */ - nlp = find_nested_prog_with_id (name_str); - if (nlp) { - output ("%s_%d__", name_str, - nlp->nested_prog->toplev_count); - } else { - output ("%s", name_str); - if (cb_flag_c_decl_for_static_call) { - if (p->call_returning == cb_null) { - lookup_static_call (name_str, p->convention, COB_RETURN_NULL); - } else if (ret_ptr == 1) { - lookup_static_call (name_str, p->convention, COB_RETURN_ADDRESS_OF); - } else { - lookup_static_call (name_str, p->convention, COB_RETURN_INT); - } - } - } - } - } else { - /* Dynamic link */ - if (name_is_literal_or_prototype) { - s = get_program_id_str (p->name); - name_str = cb_encode_program_id (s, 1, cb_fold_call); - lookup_call (name_str); - callname = s; - - output_line ("if (unlikely(call_%s.funcvoid == NULL || cob_glob_ptr->cob_physical_cancel))", name_str); - output_block_open (); - output_prefix (); - - nlp = find_nested_prog_with_id (name_str); - if (nlp) { - output ("call_%s.funcint = %s_%d__;", - name_str, name_str, - nlp->nested_prog->toplev_count); - } else { - output ("call_%s.funcvoid = ", name_str); - output ("cob_resolve_cobol ("); - output_string ((const unsigned char *)s, - (int)strlen (s), 0); - output (", %d, %d);", cb_fold_call, !p->stmt1); - } - output_newline (); - output_block_close (); - } else { - name_str = NULL; - needs_unifunc = 1; - output ("cob_unifunc.funcvoid = cob_call_field ("); - output_param (p->name, -1); - if (current_prog->nested_prog_list) { - gen_nested_tab = 1; - output (", cob_nest_tab, %d, %d);", - !p->stmt1, cb_fold_call); - } else { - output (", NULL, %d, %d);", - !p->stmt1, cb_fold_call); - } - output_newline (); - } - if (p->stmt1) { - if (name_str) { - output_line ("if (unlikely(call_%s.funcvoid == NULL))", name_str); - } else { - output_line ("if (unlikely(cob_unifunc.funcvoid == NULL))"); - } - output_block_open (); - except_id = cb_id++; - output_line ("%s%d:", CB_PREFIX_LABEL, except_id); - output_stmt (p->stmt1); - output_block_close (); - output_line ("else"); - output_block_open (); - } - if (callname) { - output_line ("cob_glob_ptr->cob_call_name_hash = 0x%X;", - cob_get_name_hash(callname)); - output_line ("COB_RESET_EXCEPTION (0);"); - } - output_prefix (); - /* call frame cast prototype */ - if (ret_ptr) { -#ifdef COB_NON_ALIGNED - output ("temptr"); -#else - output_integer (p->call_returning); -#endif - output (" = ((void *(*)"); - } else { - if (p->call_returning != cb_null) { - if (p->convention & CB_CONV_NO_RET_UPD - || !current_prog->cb_return_code) { - output ("((int (*)"); - } else { - output_integer (current_prog->cb_return_code); - output (" = ((int (*)"); - } - } else { - output ("((void (*)"); - } - } - if (p->args) { - output ("("); - } else { - output ("(void)"); - } - for (l = p->args, n = 1; l; l = CB_CHAIN (l), n++) { - x = CB_VALUE (l); - field_iteration = n - 1U; - switch (CB_PURPOSE_INT (l)) { - case CB_CALL_BY_REFERENCE: - case CB_CALL_BY_CONTENT: - output ("void *"); - break; - case CB_CALL_BY_VALUE: - output_call_protocast (x, l); - break; - default: - break; - } - if (CB_CHAIN (l)) { - output (", "); - } - } - if (p->args) { - output (")"); - } - output(")"); - - if (p->call_returning == cb_null) { - if (name_str) { - output ("call_%s.funcnull%s", name_str, convention); - } else { - output ("cob_unifunc.funcnull%s", convention); - } - } else if (ret_ptr) { - if (name_str) { - output ("call_%s.funcptr%s", name_str, convention); - } else { - output ("cob_unifunc.funcptr%s", convention); - } - } else { - if (name_str) { - output ("call_%s.funcint%s", name_str, convention); - } else { - output ("cob_unifunc.funcint%s", convention); - } - } - output (")"); - } - - /* Arguments */ - output (" ("); - for (l = p->args, n = 1; l; l = CB_CHAIN (l), n++) { - x = CB_VALUE (l); - field_iteration = n - 1U; - switch (CB_PURPOSE_INT (l)) { - case CB_CALL_BY_REFERENCE: - if (CB_NUMERIC_LITERAL_P (x) || CB_BINARY_OP_P (x)) { - output ("content_%u.data", n); - } else if (CB_REFERENCE_P (x) && CB_FILE_P (cb_ref (x))) { - output_param (cb_ref (x), -1); - } else if (CB_CAST_P (x)) { - output ("&ptr_%u", n); - } else { - output_data (x); - } - break; - case CB_CALL_BY_CONTENT: - if (CB_TREE_TAG (x) != CB_TAG_INTRINSIC && x != cb_null) { - if (CB_CAST_P (x)) { - output ("&ptr_%u", n); - } else { - output ("content_%u.data", n); - } - } else { - output_data (x); - } - break; - case CB_CALL_BY_VALUE: - output_call_by_value_args (x, l); - break; - default: - break; - } - /* early exit if call parameters don't match, this is actually - needed for all static calls, but only possible with an - external program repository, so just do so for system calls - */ - if (psyst && psyst->syst_max_params == n) { - break; - } - if (CB_CHAIN (l)) { - output (", "); - } - } - - output (");"); - output_newline (); - - if (except_id > 0) { - output_line ("if (unlikely((cob_glob_ptr->cob_exception_code & 0x%04x) == 0x%04x))", - CB_EXCEPTION_CODE(COB_EC_PROGRAM), CB_EXCEPTION_CODE(COB_EC_PROGRAM)); - output_line ("\tgoto %s%d;", CB_PREFIX_LABEL, except_id); - } - - if (p->call_returning - && (!(p->convention & CB_CONV_NO_RET_UPD)) - && current_prog->cb_return_code) { - if (p->call_returning == cb_null) { - output_prefix (); - output_integer (current_prog->cb_return_code); - output (" = 0;"); - output_newline (); - } else if (!ret_ptr) { - output_move (current_prog->cb_return_code, - p->call_returning); -#ifdef COB_NON_ALIGNED - } else { - output_prefix (); - output ("memcpy ("); - output_data (p->call_returning); - output (", &temptr, %u);", (cob_u32_t)sizeof (void *)); - output_newline (); -#endif - } - } - if (gen_exit_program) { - needs_exit_prog = 1; - output_line ("if (unlikely(module->flag_exit_program))"); - output_block_open (); - output_line ("module->flag_exit_program = 0;"); - if (current_prog->prog_type == COB_MODULE_TYPE_FUNCTION) { - output_line ("goto exit_function;"); - } else { - output_line ("goto exit_program;"); - } - output_block_close (); - } - if (p->stmt2) { - output_stmt (p->stmt2); - } - - if (dynamic_link && p->stmt1) { - output_block_close (); - } - - if (need_brace) { - output_block_close (); - } -} - -/* SET ATTRIBUTE */ - -static void -output_set_attribute (const struct cb_field *f, cob_flags_t val_on, - cob_flags_t val_off) -{ - /* Extension */ - /* Prevent specifying HIGHLIGHT and LOWLIGHT simultaneously. */ - if (val_on & COB_SCREEN_HIGHLIGHT) { - val_off |= COB_SCREEN_LOWLIGHT; - } else if (val_on & COB_SCREEN_LOWLIGHT) { - val_off |= COB_SCREEN_HIGHLIGHT; - } - - if (val_on) { - output_line ("%s%d.attr |= 0x" CB_FMT_LLX ";", CB_PREFIX_SCR_FIELD, f->id, val_on); - } - if (val_off) { - output_line ("%s%d.attr &= ~0x" CB_FMT_LLX ";", CB_PREFIX_SCR_FIELD, f->id, val_off); - } -} - -/* CANCEL */ - -static void -output_cancel (struct cb_cancel *p) -{ - struct nested_list *nlp; - char *name_str; - char *s; - unsigned int i; - - if (is_literal_or_prototype_ref (p->target)) { - s = get_program_id_str (p->target); - name_str = cb_encode_program_id (s, 0, cb_fold_call); - nlp = find_nested_prog_with_id (name_str); - output_prefix (); - if (nlp) { - output ("(void)%s_%d_ (-1", name_str, - nlp->nested_prog->toplev_count); - for (i = 0; i < nlp->nested_prog->num_proc_params; ++i) { - output (", NULL"); - } - output (");"); - } else { - output ("cob_cancel ("); - output_string ((const unsigned char *)s, - (int)strlen (s), 0); - output (");"); - } - output_newline (); - return; - } - output_prefix (); - output ("cob_cancel_field ("); - output_param (p->target, -1); - if (current_prog->nested_prog_list) { - gen_nested_tab = 1; - output (", cob_nest_tab"); - } else { - output (", NULL"); - } - output (");"); - output_newline (); -} - -/* PERFORM */ - -static void -output_perform_call (struct cb_label *lb, struct cb_label *le) -{ - struct cb_para_label *p; - struct label_list *l; - - skip_line_num = 0; - if (lb == current_prog->all_procedure || lb->flag_is_debug_sect) { - output_line ("/* DEBUGGING Callback PERFORM %s */", - (const char *)lb->name); - } else if (lb == le) { - output_line ("/* PERFORM %s */", (const char *)lb->name); - } else { - output_line ("/* PERFORM %s THRU %s */", (const char *)lb->name, - (const char *)le->name); - } - - /* Save current independent segment pointers */ - if (current_prog->flag_segments && last_section && - last_section->section_id != lb->section_id) { - p = last_section->para_label; - for (; p; p = p->next) { - if (p->para->segment > 49 && - p->para->flag_alter) { - output_line ("save_label_%s%d = label_%s%d;", - CB_PREFIX_LABEL, p->para->id, - CB_PREFIX_LABEL, p->para->id); - } - } - } - /* Zap target independent labels */ - if (current_prog->flag_segments && last_segment != lb->segment) { - if (lb->flag_section) { - p = lb->para_label; - } else if (lb->section) { - p = lb->section->para_label; - } else { - p = NULL; - } - for (; p; p = p->next) { - if (p->para->segment > 49 && - p->para->flag_alter) { - output_line ("label_%s%d = 0;", - CB_PREFIX_LABEL, p->para->id); - } - } - } - - /* Update debugging name */ - if (current_prog->flag_gen_debug && lb->flag_real_label && - (current_prog->all_procedure || lb->flag_debugging_mode)) { - output_stmt (cb_build_debug (cb_debug_name, - (const char *)lb->name, NULL)); - } - - skip_line_num = 0; - output_line ("frame_ptr++;"); - if (cb_flag_stack_check) { - output_line ("if (unlikely(frame_ptr == frame_overflow))"); - output_line ("\tcob_fatal_error (COB_FERROR_STACK);"); - } - output_line ("frame_ptr->perform_through = %d;", le->id); - if (!cb_flag_computed_goto) { - l = cobc_parse_malloc (sizeof (struct label_list)); - l->next = label_cache; - l->id = cb_id; - if (label_cache == NULL) { - l->call_num = 0; - } else { - l->call_num = label_cache->call_num + 1; - } - label_cache = l; - output_line ("frame_ptr->return_address_num = %d;", l->call_num); - output_line ("goto %s%d;", CB_PREFIX_LABEL, lb->id); - output_line ("%s%d:", CB_PREFIX_LABEL, cb_id); - } else { - output_line ("frame_ptr->return_address_ptr = &&%s%d;", - CB_PREFIX_LABEL, cb_id); - output_line ("goto %s%d;", CB_PREFIX_LABEL, lb->id); - output_line ("%s%d:", CB_PREFIX_LABEL, cb_id); - } - output_line ("frame_ptr--;"); - cb_id++; - - if (current_prog->flag_segments && last_section && - last_section->section_id != lb->section_id) { - /* Restore current independent segment pointers */ - p = last_section->para_label; - for (; p; p = p->next) { - if (p->para->segment > 49 && - p->para->flag_alter) { - output_line ("label_%s%d = save_label_%s%d;", - CB_PREFIX_LABEL, p->para->id, - CB_PREFIX_LABEL, p->para->id); - } - } - /* Zap target independent labels */ - if (lb->flag_section) { - p = lb->para_label; - } else if (lb->section) { - p = lb->section->para_label; - } else { - p = NULL; - } - for (; p; p = p->next) { - if (p->para->segment > 49 && - p->para->flag_alter) { - output_line ("label_%s%d = 0;", - CB_PREFIX_LABEL, p->para->id); - } - } - } -} - -static void -output_perform_exit (struct cb_label *l) -{ - if (l->flag_global) { - output_newline (); - output_line ("/* Implicit GLOBAL DECLARATIVE return */"); - output_line ("if (entry == %d) {", l->id); - output_line (" cob_module_leave (module);"); - if (cb_flag_stack_on_heap || current_prog->flag_recursive) { - output_line (" cob_free (frame_stack);"); - output_line (" cob_free (cob_procedure_params);"); - output_line (" cob_module_free (&module);"); - } - output_line (" return 0;"); - output_line ("}"); - } - output_newline (); - memset(last_line_num, ' ', 30); - - if (l->flag_declarative_exit) { - output_line ("/* Implicit DECLARATIVE return */"); - } else if (l->flag_default_handler) { - output_line ("/* Implicit Default Error Handler return */"); - } else { - output_line ("/* Implicit PERFORM return */"); - } - - if (cb_perform_osvs && current_prog->prog_type == COB_MODULE_TYPE_PROGRAM) { - output_line - ("for (temp_index = frame_ptr; temp_index->perform_through; temp_index--) {"); - output_line (" if (temp_index->perform_through == %d) {", l->id); - output_line (" frame_ptr = temp_index;"); - if (!cb_flag_computed_goto) { - output_line (" goto P_switch;"); - } else { - output_line (" goto *frame_ptr->return_address_ptr;"); - } - output_line (" }"); - output_line ("}"); - } else { - output_line ("if (frame_ptr->perform_through == %d)", l->id); - if (!cb_flag_computed_goto) { - output_line (" goto P_switch;"); - } else { - output_line (" goto *frame_ptr->return_address_ptr;"); - } - } - - if (l->flag_fatal_check) { - output_newline (); - output_line ("/* Fatal error if reached */"); - output_line ("cob_fatal_error (COB_FERROR_GLOBAL);"); - } -} - -static void -output_funcall_debug (cb_tree x) -{ - struct cb_funcall *p; - cb_tree l; - cb_tree z; - int i; - - p = CB_FUNCALL (x); - if (p->name[0] == '$') { - z = p->argv[0]; - if (CB_REF_OR_FIELD_P (z) && - cb_code_field (z)->flag_field_debug) { - /* DEBUG */ - output_stmt (cb_build_debug (cb_debug_name, - (const char *)cb_code_field (z)->name, NULL)); - output_stmt (cb_build_debug (cb_debug_contents, - NULL, z)); - output_perform_call (cb_code_field (z)->debug_section, - cb_code_field (z)->debug_section); - } - z = p->argv[1]; - if (CB_REF_OR_FIELD_P (z) && - cb_code_field (z)->flag_field_debug) { - /* DEBUG */ - output_stmt (cb_build_debug (cb_debug_name, - (const char *)cb_code_field (z)->name, NULL)); - output_stmt (cb_build_debug (cb_debug_contents, - NULL, z)); - output_perform_call (cb_code_field (z)->debug_section, - cb_code_field (z)->debug_section); - } - return; - } - for (i = 0; i < p->argc; i++) { - if (p->varcnt && i + 1 == p->argc) { - for (l = p->argv[i]; l; l = CB_CHAIN (l)) { - output_param (CB_VALUE (l), i); - z = CB_VALUE (l); - if (CB_REF_OR_FIELD_P (z) && - cb_code_field (z)->flag_field_debug) { - /* DEBUG */ - output_stmt (cb_build_debug (cb_debug_name, - (const char *)cb_code_field (z)->name, NULL)); - output_stmt (cb_build_debug (cb_debug_contents, - NULL, z)); - output_perform_call (cb_code_field (z)->debug_section, - cb_code_field (z)->debug_section); - } - i++; - } - } else { - z = p->argv[i]; - if (CB_REF_OR_FIELD_P (z) && - cb_code_field (z)->flag_field_debug) { - /* DEBUG */ - output_stmt (cb_build_debug (cb_debug_name, - (const char *)cb_code_field (z)->name, NULL)); - output_stmt (cb_build_debug (cb_debug_contents, - NULL, z)); - output_perform_call (cb_code_field (z)->debug_section, - cb_code_field (z)->debug_section); - } - } - } -} - -static void -output_cond_debug (cb_tree x) -{ - struct cb_binary_op *p; - - switch (CB_TREE_TAG (x)) { - case CB_TAG_FUNCALL: - output_funcall_debug (x); - break; - case CB_TAG_LIST: - break; - case CB_TAG_BINARY_OP: - p = CB_BINARY_OP (x); - switch (p->op) { - case '!': - output_cond_debug (p->x); - break; - - case '&': - case '|': - output_cond_debug (p->x); - output_cond_debug (p->y); - break; - - case '=': - case '<': - case '[': - case '>': - case ']': - case '~': - output_cond_debug (p->x); - break; - - default: - if (CB_REF_OR_FIELD_P (x) && - cb_code_field (x)->flag_field_debug) { - output_stmt (cb_build_debug (cb_debug_name, - (const char *)cb_code_field (x)->name, NULL)); - output_stmt (cb_build_debug (cb_debug_contents, - NULL, x)); - output_perform_call (cb_code_field (x)->debug_section, - cb_code_field (x)->debug_section); - } - break; - } - break; - default: - break; - } -} - -static void -output_perform_once (struct cb_perform *p) -{ - if (p->body && CB_PAIR_P (p->body)) { - output_perform_call (CB_LABEL (cb_ref (CB_PAIR_X (p->body))), - CB_LABEL (cb_ref (CB_PAIR_Y (p->body)))); - } else { - output_stmt (p->body); - } - if (p->cycle_label) { - output_stmt (cb_ref (p->cycle_label)); - } -} - -static void -output_perform_until (struct cb_perform *p, cb_tree l) -{ - struct cb_perform_varying *v; - struct cb_field *f; - cb_tree next; - - if (l == NULL) { - /* Perform body at the end */ - output_perform_once (p); - return; - } - - v = CB_PERFORM_VARYING (CB_VALUE (l)); - next = CB_CHAIN (l); - - skip_line_num++; - output_line ("for (;;)"); - output_block_open (); - - if (next && CB_PERFORM_VARYING (CB_VALUE (next))->name) { - output_move (CB_PERFORM_VARYING (CB_VALUE (next))->from, - CB_PERFORM_VARYING (CB_VALUE (next))->name); - /* DEBUG */ - if (current_prog->flag_gen_debug) { - f = CB_FIELD (cb_ref (CB_PERFORM_VARYING (CB_VALUE (next))->name)); - if (f->flag_field_debug) { - output_stmt (cb_build_debug (cb_debug_name, - (const char *)f->name, NULL)); - output_stmt (cb_build_debug (cb_debug_contents, - NULL, CB_PERFORM_VARYING (CB_VALUE (next))->name)); - output_perform_call (f->debug_section, - f->debug_section); - } - } - - } - - if (p->test == CB_AFTER) { - output_perform_until (p, next); - } - - /* DEBUG */ - if (current_prog->flag_gen_debug) { - output_cond_debug (v->until); - } - - output_prefix (); - output ("if ("); - output_cond (v->until, 0); - output (")"); - output_newline (); - output_line (" break;"); - - if (p->test == CB_BEFORE) { - output_perform_until (p, next); - } - - if (v->step) { - output_stmt (v->step); - } - - output_block_close (); -} - -static void -output_perform (struct cb_perform *p) -{ - struct cb_perform_varying *v; - struct cb_field *f; - - switch (p->perform_type) { - case CB_PERFORM_EXIT: - if (CB_LABEL (p->data)->flag_return) { - output_perform_exit (CB_LABEL (p->data)); - } - break; - case CB_PERFORM_ONCE: - output_perform_once (p); - break; - case CB_PERFORM_TIMES: - output_prefix (); - output ("for (n%d = ", loop_counter); - output_param (cb_build_cast_llint (p->data), 0); - output ("; n%d > 0; n%d--)", loop_counter, loop_counter); - output_newline (); - loop_counter++; - output_block_open (); - output_perform_once (p); - output_block_close (); - break; - case CB_PERFORM_UNTIL: - v = CB_PERFORM_VARYING (CB_VALUE (p->varying)); - if (v->name) { - output_move (v->from, v->name); - /* DEBUG */ - if (current_prog->flag_gen_debug) { - f = CB_FIELD (cb_ref (v->name)); - if (f->flag_field_debug) { - output_stmt (cb_build_debug (cb_debug_name, - (const char *)f->name, NULL)); - output_stmt (cb_build_debug (cb_debug_contents, - NULL, v->name)); - output_perform_call (f->debug_section, - f->debug_section); - } - } - - } - output_perform_until (p, p->varying); - break; - case CB_PERFORM_FOREVER: - output_line ("for (;;)"); - output_block_open (); - output_perform_once (p); - output_block_close (); - break; - default: - break; - } - if (p->exit_label) { - output_stmt (cb_ref (p->exit_label)); - } -} - -static void -output_file_error (struct cb_file *pfile) -{ - struct cb_file *fl; - cb_tree l; - - if (current_prog->flag_gen_debug) { - output_stmt (cb_build_debug (cb_debug_contents, - "USE PROCEDURE", NULL)); - } - for (l = current_prog->local_file_list; l; l = CB_CHAIN (l)) { - fl = CB_FILE(CB_VALUE (l)); - if (!strcmp (pfile->name, fl->name)) { - output_perform_call (fl->handler, - fl->handler); - return; - } - } - for (l = current_prog->global_file_list; l; l = CB_CHAIN (l)) { - fl = CB_FILE(CB_VALUE (l)); - if (!strcmp (pfile->name, fl->name)) { - if (fl->handler_prog == current_prog) { - output_perform_call (fl->handler, - fl->handler); - } else { - if (fl->handler_prog->nested_level) { - output_line ("%s_%d_ (%d);", - fl->handler_prog->program_id, - fl->handler_prog->toplev_count, - fl->handler->id); - } else { - output_line ("%s_ (%d);", - fl->handler_prog->program_id, - fl->handler->id); - } - } - return; - } - } - output_perform_call (pfile->handler, pfile->handler); -} - -/* GO TO */ - -static void -output_goto_1 (cb_tree x) -{ - struct cb_label *lb = CB_LABEL (x); - - if (current_prog->flag_segments && last_segment != lb->segment) { - /* Zap independent labels */ - struct cb_para_label *p; - if (lb->flag_section) { - p = lb->para_label; - } else if (lb->section) { - p = lb->section->para_label; - } else { - p = NULL; - } - for (; p; p = p->next) { - if (p->para->segment > 49 && - p->para->flag_alter) { - output_line ("label_%s%d = 0;", - CB_PREFIX_LABEL, p->para->id); - } - } - } - - /* Check for debugging on procedure */ - if (current_prog->flag_gen_debug && lb->flag_real_label - && (current_prog->all_procedure || lb->flag_debugging_mode)) { - output_stmt (cb_build_debug (cb_debug_name, - (const char *)lb->name, NULL)); - output_move (cb_space, cb_debug_contents); - } - - output_line ("goto %s%d;", CB_PREFIX_LABEL, lb->id); -} - -/* extension in test, may be removed again */ -static void -output_goto_entry (cb_tree target) -{ - cb_tree l; - struct cb_reference *r = CB_REFERENCE (target); - const char *name = r->word->name; - for (l = current_program->entry_list_goto; l; l = CB_CHAIN (l)) { - struct cb_label *label = CB_LABEL (CB_VALUE (l)); - if (strcmp (name, label->name) == 0) { - output_line ("goto %s%d;", CB_PREFIX_LABEL, label->id); - return; - } - } - cb_error_x (target, _("No ENTRY FOR GO TO '%s'"), name); -} - - -static void -output_goto (struct cb_goto *p) -{ - cb_tree l; - struct cb_field *f; - int i; - - i = 1; - if (p->depending) { - /* Check for debugging on the DEPENDING item */ - if (current_prog->flag_gen_debug) { - f = CB_FIELD (cb_ref (p->depending)); - if (f->flag_all_debug) { - output_stmt (cb_build_debug (cb_debug_name, - (const char *)f->name, NULL)); - output_stmt (cb_build_debug (cb_debug_contents, - NULL, p->depending)); - output_perform_call (f->debug_section, - f->debug_section); - } - } - output_prefix (); - output ("switch ("); - output_param (cb_build_cast_int (p->depending), 0); - output (")"); - output_newline (); - output_block_open (); - for (l = p->target; l; l = CB_CHAIN (l)) { - cb_tree target = CB_VALUE (l); - cb_tree ref = cb_try_ref (target); - output_indent_level -= 2; - output_line ("case %d:", i++); - output_indent_level += 2; - if (ref != cb_error_node) { - output_goto_1 (ref); - } else { - output_goto_entry (target); - } - } - output_block_close (); - } else if (p->target == NULL - || p->target == cb_int1) { - /* EXIT PROGRAM/FUNCTION */ - needs_exit_prog = 1; - if (current_prog->prog_type == COB_MODULE_TYPE_FUNCTION) { - output_line ("goto exit_function;"); - } else if (p->target == cb_int1 - || cb_flag_implicit_init || current_prog->nested_level) { - output_line ("goto exit_program;"); - } else { - /* Ignore if not a callee */ - output_line ("if (module->next)"); - output_line (" goto exit_program;"); - } - } else { - cb_tree target = p->target; - cb_tree ref = cb_try_ref (target); - if (ref != cb_error_node) { - output_goto_1 (ref); - } else { - output_goto_entry (target); - } - } -} - -/* ALTER */ - -static void -output_alter (struct cb_alter *p) -{ - struct cb_label *l1; - struct cb_label *l2; - - l1 = CB_LABEL (CB_REFERENCE(p->source)->value); - l2 = CB_LABEL (CB_REFERENCE(p->target)->value); - output_line ("label_%s%d = %d;", CB_PREFIX_LABEL, l1->id, l2->id); - - /* Check for debugging on procedure name */ - if (current_prog->flag_gen_debug && l1->flag_real_label && - (current_prog->all_procedure || l1->flag_debugging_mode)) { - output_stmt (cb_build_debug (cb_debug_name, - (const char *)l1->name, NULL)); - output_stmt (cb_build_debug (cb_debug_contents, - (const char *)l2->name, NULL)); - if (current_prog->all_procedure) { - output_perform_call (current_prog->all_procedure, - current_prog->all_procedure); - } else if (l1->flag_debugging_mode) { - output_perform_call (l1->debug_section, - l1->debug_section); - } - } -} - -/* JSON/XML GENERATE suppress checks */ - -static void -output_ml_tree_suppress_cond (struct cb_ml_generate_tree *tree) -{ - output_prefix (); - if (tree->type == CB_ML_ATTRIBUTE) { - output ("%s%d.is_suppressed = ", CB_PREFIX_ML_ATTR, tree->id); - } else { - output ("%s%d.is_suppressed = ", CB_PREFIX_ML_TREE, tree->id); - } - output_cond (tree->suppress_cond, 0); - output (";"); - output_newline (); -} - -static int -one_tree_in_list_is_never_suppressed (struct cb_ml_generate_tree *tree) -{ - for (; tree; tree = tree->sibling) { - if (!tree->suppress_cond) { - return 1; - } - } - - return 0; -} - -static int -one_child_or_attr_is_never_suppressed (struct cb_ml_generate_tree *tree) -{ - return one_tree_in_list_is_never_suppressed (tree->attrs) - || one_tree_in_list_is_never_suppressed (tree->children); -} - -static void -output_all_tree_list_suppressed_cond (struct cb_ml_generate_tree *tree, - const char *prefix, - int * const cond_emitted) -{ - for (; tree; tree = tree->sibling) { - if (*cond_emitted) { - output (" && "); - } else { - *cond_emitted = 1; - } - output ("%s%d.is_suppressed", prefix, tree->id); - } - -} - -static void -output_parent_tree_suppress_check (struct cb_ml_generate_tree *tree) -{ - int child_check_emitted = 0; - - if (one_child_or_attr_is_never_suppressed (tree)) { - /* In this case, tree is always emitted; no check is needed. */ - return; - } - - output_prefix (); - output ("%s%d.is_suppressed |= ", CB_PREFIX_ML_TREE, tree->id); - output_all_tree_list_suppressed_cond (tree->attrs, CB_PREFIX_ML_ATTR, - &child_check_emitted); - output_all_tree_list_suppressed_cond (tree->children, CB_PREFIX_ML_TREE, - &child_check_emitted); - output (";"); - output_newline (); - -} - -static void -output_ml_suppress_checks (struct cb_ml_suppress_checks * const suppress_checks) -{ - struct cb_ml_generate_tree *orig_tree = suppress_checks->tree; - struct cb_ml_generate_tree *tree; - - /* - To resolve dependency problems, start from last child of last element. - */ - if (orig_tree->children) { - tree = get_last_child (orig_tree); - } else if (orig_tree->attrs) { - tree = get_last_attr (orig_tree); - } else { - tree = orig_tree; - } - - for (;;) { - if (tree->suppress_cond) { - output_ml_tree_suppress_cond (tree); - } - /* - Suppress the (non-root) element if all its children are - suppressed. - */ - if ((tree->children || tree->attrs) && tree != orig_tree) { - output_parent_tree_suppress_check (tree); - } - - if (tree == orig_tree) { - break; - } else { - tree = get_prev_ml_tree_entry (tree); - } - } -} - -/* Output statement */ - -static int -get_ec_code_for_handler (const enum cb_handler_type handler_type) -{ - switch (handler_type) { - case AT_END_HANDLER: - return CB_EXCEPTION_CODE (COB_EC_I_O_AT_END); - case EOP_HANDLER: - return CB_EXCEPTION_CODE (COB_EC_I_O_EOP); - case INVALID_KEY_HANDLER: - return CB_EXCEPTION_CODE (COB_EC_I_O_INVALID_KEY); - /* LCOV_EXCL_START */ - default: - cobc_err_msg (_("unexpected handler type: %d"), (int) handler_type); - COBC_ABORT (); - /* LCOV_EXCL_STOP */ - } -} - -static void -output_ferror_stmt (struct cb_statement *stmt) -{ - output_line ("if (unlikely(cob_glob_ptr->cob_exception_code != 0))"); - output_block_open (); - if (stmt->ex_handler) { - output_line ("if (cob_glob_ptr->cob_exception_code == 0x%04x)", - get_ec_code_for_handler (stmt->handler_type)); - output_block_open (); - output_stmt (stmt->ex_handler); - output_block_close (); - output_line ("else"); - output_block_open (); - } - output_file_error (CB_FILE (stmt->file)); - output_block_close (); - if (stmt->ex_handler) { - output_block_close (); - } - if (stmt->not_ex_handler || stmt->handler3) { - output_line ("else"); - output_block_open (); - if (stmt->handler3) { - output_stmt (stmt->handler3); - } - if (stmt->not_ex_handler) { - output_stmt (stmt->not_ex_handler); - } - output_block_close (); - } -} - -static void -output_c_info (void) -{ - if (cb_flag_c_line_directives) { - output ("#line %d \"%s\"", output_line_number + 1, output_name); - output_newline (); - } -} - -static void -output_cobol_info (cb_tree x) -{ - if (!cb_cob_line_num) { - skip_line_num = 0; - return; - } - if (!cb_flag_c_line_directives) - sprintf (last_line_num, "#line %d \"%s\"", x->source_line, x->source_file); - output ("#line %d \"%s\"", x->source_line, x->source_file); - skip_line_num++; - output_newline (); -} - -static void -output_section_info (struct cb_label *lp) -{ - if (CB_TREE (lp) == cb_standard_error_handler) { - return; - } - if (lp->flag_dummy_exit) { - return; - } - - if (CB_TREE (lp)->source_file) { - if (last_line != CB_TREE (lp)->source_line) { - output_line ("module->module_stmt = 0x%08X;", - COB_SET_LINE_FILE(CB_TREE (lp)->source_line, lookup_source(CB_TREE (lp)->source_file))); - last_line = CB_TREE (lp)->source_line; - } - } - - if (lp->flag_entry) { - output_line ("cob_trace_entry (%s%d);", - CB_PREFIX_STRING, lookup_string (lp->orig_name)); - return; - } - - if (lp->flag_section) { - if (!lp->flag_dummy_section) { - output_line ("cob_trace_sect (%s%d);", - CB_PREFIX_STRING, lookup_string (lp->orig_name)); - } else { - output_line ("cob_trace_sect (NULL);"); - } - return; - } - if (!lp->flag_dummy_paragraph) { - output_line ("cob_trace_para (%s%d);", - CB_PREFIX_STRING, lookup_string (lp->orig_name)); - } else { - output_line ("cob_trace_para (NULL);"); - } -} - -static void -output_line_and_trace_info (cb_tree x, const char *name) -{ - if ( (cb_flag_c_line_directives - || cb_flag_source_location - || cb_cob_line_num) - && x->source_file) { - output_cobol_info (x); - if (cb_flag_source_location - && name) { - output_line ("cob_trace_stmt (%s%d);", - CB_PREFIX_STRING, lookup_string (name)); - } else if (cb_flag_c_line_directives) { - output_line (";"); - output_c_info (); - } - } else { - if (cb_flag_source_location - && name) { - output_line ("cob_trace_stmt (%s%d);", - CB_PREFIX_STRING, lookup_string (name)); - } - } -} - -static void -output_label_info (cb_tree x, struct cb_label *lp) -{ - if (lp->flag_dummy_section || lp->flag_dummy_paragraph) { - return; - } - - output_newline (); - - if (lp->flag_dummy_exit) { - output_line ("/* Implicit EXIT label */"); - return; - } else if (lp->flag_next_sentence) { - output_line ("/* Implicit NEXT SENTENCE label */"); - return; - } - - output_prefix (); - if (x->source_file) { - output ("/* Line: %-10d: ", x->source_line); - } else { - output ("/* "); - } - if (lp->flag_section) { - output ("Section %-24s", (const char *)lp->name); - excp_current_section = (const char *)lp->name; - excp_current_paragraph = NULL; - } else if (lp->flag_entry) { - output ("Entry %-24s", lp->orig_name); - excp_current_section = NULL; - excp_current_paragraph = NULL; - } else { - output ("Paragraph %-24s", (const char *)lp->name); - excp_current_paragraph = (const char *)lp->name; - } - if (x->source_file) { - output (": %s */", x->source_file); - } else { - output ("*/"); - } - skip_line_num = 2; - output_newline (); -} - -static void -output_alter_check (struct cb_label *lp) -{ - struct cb_alter_id *aid; - - output_local ("static int\tlabel_%s%d = 0;\n", - CB_PREFIX_LABEL, lp->id); - if (current_prog->flag_segments) { - output_local ("static int\tsave_label_%s%d = 0;\n", - CB_PREFIX_LABEL, lp->id); - } - output_newline (); - output_line ("/* ALTER processing */"); - output_line ("switch (label_%s%d)", - CB_PREFIX_LABEL, lp->id); - output_block_open (); - for (aid = lp->alter_gotos; aid; aid = aid->next) { - output_line ("case %d:", aid->goto_id); - output_line ("goto %s%d;", CB_PREFIX_LABEL, aid->goto_id); - } - output_block_close (); - output_newline (); -} - -static void -output_level_2_ex_condition (const int level_2_ec) -{ - output_line ("if (unlikely ((cob_glob_ptr->cob_exception_code & 0xff00) == 0x%04x))", - CB_EXCEPTION_CODE (level_2_ec)); -} - -static void -output_display_accept_ex_condition (const enum cb_handler_type handler_type) -{ - int imp_ec; - - output_line ("if (unlikely ((cob_glob_ptr->cob_exception_code & 0xff00) == 0x%04x", - CB_EXCEPTION_CODE (COB_EC_SCREEN)); - - if (handler_type == DISPLAY_HANDLER) { - imp_ec = COB_EC_IMP_DISPLAY; - } else { /* ACCEPT_HANDLER */ - imp_ec = COB_EC_IMP_ACCEPT; - } - output_line (" || cob_glob_ptr->cob_exception_code == 0x%04x))", - CB_EXCEPTION_CODE (imp_ec)); -} - -static void -output_ec_condition_for_handler (const enum cb_handler_type handler_type) -{ - - switch (handler_type) { - case DISPLAY_HANDLER: - output_display_accept_ex_condition (DISPLAY_HANDLER); - break; - - case ACCEPT_HANDLER: - output_display_accept_ex_condition (ACCEPT_HANDLER); - break; - - case SIZE_ERROR_HANDLER: - output_level_2_ex_condition (COB_EC_SIZE); - break; - - case OVERFLOW_HANDLER: - output_level_2_ex_condition (COB_EC_OVERFLOW); - break; - - case XML_HANDLER: - output_level_2_ex_condition (COB_EC_XML); - break; - - case JSON_HANDLER: - output_level_2_ex_condition (COB_EC_JSON); - break; - - /* LCOV_EXCL_START */ - default: - cobc_err_msg (_("unexpected handler type: %d"), (int) handler_type); - COBC_ABORT (); - /* LCOV_EXCL_STOP */ - } -} - -static void -output_handler (struct cb_statement *stmt) -{ - if (stmt->file) { - output_ferror_stmt (stmt); - return; - } - - if (stmt->ex_handler) { - output_ec_condition_for_handler (stmt->handler_type); - output_block_open (); - output_stmt (stmt->ex_handler); - output_block_close (); - if (stmt->not_ex_handler) { - output_line ("else"); - } - } - if (stmt->not_ex_handler) { - if (stmt->ex_handler == NULL) { - output_line ("if (!cob_glob_ptr->cob_exception_code)"); - } - output_block_open (); - output_stmt (stmt->not_ex_handler); - output_block_close (); - } -} - - -/* - * For OPEN and file has SELECT fields which are LINKAGE or BASED - * set the current address of the field at OPEN time - */ -static void -output_file_variable (cb_tree x, struct cb_file *fl, - struct cb_funcall *c, const char *set_field, int always) -{ - struct cb_field *f; - - if (x == NULL || !CB_REF_OR_FIELD_P (x)) return; - - f = cb_code_field(x); - if (!f) return; - - /* Check: do we need to set the fields address at OPEN time? */ - if (f->flag_local - || f->flag_item_based - || f->flag_local_storage - || f->storage == CB_STORAGE_LINKAGE - || f->storage == CB_STORAGE_LOCAL) { - /* result: yes */ - } else { - return; - } - - if (strcmp(c->name, "cob_open") == 0 - || strcmp(c->name, "cob_extfh_open") == 0 - || always) { - output_prefix (); - output ("%s%s->%s = ", CB_PREFIX_FILE, fl->cname, set_field); - output_param (x, -1); - output (";"); - output_newline (); - } -} - -static void -output_stmt (cb_tree x) -{ - struct cb_binary_op *bop; - cb_tree w; - struct cb_statement *p; - struct cb_label *lp; - struct cb_assign *ap; - struct cb_if *ip; - struct cb_para_label *pal; - struct cb_set_attr *sap; - struct cb_field *f1, *f2; - FILE *savetarget; - char *px; -#ifdef COB_NON_ALIGNED - struct cb_cast *cp; -#endif - size_t size; - int code, skip_else; - - stack_id = 0; - if (x == NULL) { - output_line (";"); - return; - } - /* LCOV_EXCL_START */ - if (unlikely(x == cb_error_node)) { - cobc_err_msg (_("unexpected error_node parameter")); - COBC_ABORT (); - } - /* LCOV_EXCL_STOP */ - - if (inside_check != 0) { - if (inside_stack[inside_check - 1] != 0) { - inside_stack[inside_check - 1] = 0; - output (","); - output_newline (); - } - } - - switch (CB_TREE_TAG (x)) { - case CB_TAG_STATEMENT: - p = CB_STATEMENT (x); - /* note: p->name and x->sourcefile/line are always available here */ - - /* Output source location, but only if it isn't an implicit statement */ - if (!p->flag_implicit) { - /* Output source location as a comment */ - skip_line_num = 4; - output_line ("/* Line: %-10d: %-19.19s: %s */", - x->source_line, p->name, x->source_file); - /* Output source location as code */ - if (cb_flag_source_location - || cb_flag_dump) { - if (last_line != x->source_line) { - output_line ("module->module_stmt = 0x%08X;", - COB_SET_LINE_FILE(x->source_line, lookup_source(x->source_file))); - } - } - /* Output source location as code */ - output_line_and_trace_info (x, p->name); - /* USE FOR DEBUGGING: pre-fill DEBUG-LINE - FIXME: postpone to actual DEBUGGING procedure, - using module->module_stmt there - */ - if (current_prog->flag_gen_debug && - !p->flag_in_debug) { - output_prefix (); - output ("memcpy ("); - output_data (cb_debug_line); - output (", \"%6d\", 6);", x->source_line); - output_newline (); - } - last_line = x->source_line; - skip_line_num = 0; - } - - if (!p->file) { - - if (p->ex_handler || p->not_ex_handler) { - output_line ("COB_RESET_EXCEPTION (0);"); - } else - if (cobc_wants_debug) { - output_line ("cob_global_exception = -1;"); - } - - } else { - - struct cb_file *fl = CB_FILE (p->file); - - if (p->body && CB_VALUE (p->body)) { - cb_tree body_value = CB_VALUE (p->body); - switch (CB_TREE_TAG (body_value)) { - case CB_TAG_FUNCALL: { - struct cb_funcall *c = CB_FUNCALL (body_value); - if (fl->organization == COB_ORG_RELATIVE) { - output_file_variable (fl->key, fl, c, "keys[0].field", 1); - } - output_file_variable (fl->assign, fl, c, "assign", 0); - break; - } - case CB_TAG_DEBUG: - /* CHECKME: anything needed here? */ - break; - /* LCOV_EXCL_START */ - default: - cobc_err_msg (_("unexpected tree tag: %d"), - (int)CB_TREE_TAG (body_value)); - COBC_ABORT (); - /* LCOV_EXCL_END */ - } - /* LCOV_EXCL_START */ - } else { - cobc_err_msg ("unexpected state"); - COBC_ABORT (); - } - /* LCOV_EXCL_END */ - - if (p->flag_retry_forever) { - output_line ("cob_file_set_retry (%s%s,COB_RETRY_FOREVER,0);", - CB_PREFIX_FILE, fl->cname); - } else - if (p->flag_retry_times) { - output_prefix (); - output ("cob_file_set_retry (%s%s,COB_RETRY_TIMES,", - CB_PREFIX_FILE, fl->cname); - output_integer (p->retry); - output (");"); - output_newline (); - } else - if (p->flag_retry_seconds) { - output_prefix (); - output ("cob_file_set_retry (%s%s,COB_RETRY_SECONDS,", - CB_PREFIX_FILE, fl->cname); - output_integer (p->retry); - output (");"); - output_newline (); - } else - if (p->flag_advancing_lock) { - output_line ("cob_file_set_retry (%s%s,COB_ADVANCING_LOCK,0);", - CB_PREFIX_FILE, fl->cname); - } - } - - if (p->null_check) { - output_stmt (p->null_check); - } - - if (p->body) { - output_stmt (p->body); - } - - /* USE FOR DEBUGGING: Output field debugging statements */ - /* FIXME: for statements with body like IF / EVALUATE and - DISPLAY / CALL [NOT] ON EXCEPTION this comes too late, - should be included in all possible branches as first item */ - if (current_prog->flag_gen_debug && p->debug_check) { - /* FIXME: codegen should generate a surrounding - "if (cob_glob_ptr->cob_debugging_mode)" - here */ - output_stmt (p->debug_check); - } - - /* Special debugging callback for START / DELETE */ - /* Must be done immediately after I/O and before */ - /* status check */ - if (current_prog->flag_gen_debug && p->file && p->flag_callback) { - output_line ("save_exception_code = cob_global_exception;"); - output_stmt (cb_build_debug (cb_debug_name, - CB_FILE(p->file)->name, NULL)); - output_move (cb_space, cb_debug_contents); - output_perform_call (CB_FILE(p->file)->debug_section, - CB_FILE(p->file)->debug_section); - output_line ("cob_global_exception = save_exception_code;"); - need_save_exception = 1; - } - - if (p->ex_handler || p->not_ex_handler || - (p->file && CB_EXCEPTION_ENABLE (COB_EC_I_O))) { - output_handler (p); - } - break; - case CB_TAG_LABEL: - lp = CB_LABEL (x); - if (lp->flag_skip_label) { - break; - } - output_label_info (x, lp); - if (lp->flag_section) { - for (pal = lp->para_label; pal; pal = pal->next) { - if (pal->para->segment > 49 - && pal->para->flag_alter) { - output_line ("label_%s%d = 0;", - CB_PREFIX_LABEL, pal->para->id); - } - } - last_segment = lp->segment; - last_section = lp; - } - if (lp->flag_begin) { - output_line ("%s%d:;", CB_PREFIX_LABEL, lp->id); - } - if (cb_flag_c_line_directives) { - output_cobol_info (x); - } - if (cb_flag_c_labels && (lp->flag_entry || lp->flag_section)) { - /* possibly come back later adding paragraphs, too */ - const char *prf; - unsigned char buff[COB_MINI_BUFF]; - unsigned char *ptr = (unsigned char *)&buff; - cob_encode_program_id ((unsigned char*)lp->orig_name, ptr, - COB_MINI_MAX, COB_FOLD_UPPER); - if (lp->flag_section) prf = "SECTION"; - else if (lp->flag_entry_for_goto) prf = "ENTRY_GOTO"; - else prf = "ENTRY"; - if (*ptr == '_') ptr++; - output_line ("%s_%s:;", prf, ptr); - if (cb_flag_c_line_directives) { - output_c_info (); - } - } else { - if (cb_flag_c_line_directives) { - output_line (";"); - output_c_info (); - } - } - - /* Check for runtime debug flag */ - if (current_prog->flag_debugging && lp->flag_is_debug_sect) { - output_line ("if (!cob_glob_ptr->cob_debugging_mode)"); - output_line ("\tgoto %s%d;", - CB_PREFIX_LABEL, CB_LABEL (lp->exit_label)->id); - } - - if (cb_flag_trace - || cobc_wants_debug) { - output_section_info (lp); - } - - /* Check procedure debugging */ - if (current_prog->flag_gen_debug && lp->flag_real_label) { - output_stmt (cb_build_debug (cb_debug_name, - (const char *)lp->name, NULL)); - if (current_prog->all_procedure) { - output_perform_call (current_prog->all_procedure, - current_prog->all_procedure); - } else if (lp->flag_debugging_mode) { - output_perform_call (lp->debug_section, - lp->debug_section); - } - } - - /* Check ALTER processing */ - if (lp->flag_alter) { - output_alter_check (lp); - } - - break; - case CB_TAG_FUNCALL: - output_prefix (); - output_funcall (x); - if (inside_check == 0) { - output (";"); - output_newline (); - } else { - inside_stack[inside_check - 1] = 1; - } - break; - case CB_TAG_ASSIGN: - ap = CB_ASSIGN (x); - if (CB_TREE_CLASS (ap->var) == CB_CLASS_NUMERIC - || CB_TREE_CLASS (ap->var) == CB_CLASS_ALPHANUMERIC - || CB_TREE_CLASS (ap->var) == CB_CLASS_ALPHABETIC) { - f1 = cb_code_field(ap->var); - if (!f1->flag_real_binary - && f1->pic) { - output_prefix (); - if (CB_NUMERIC_LITERAL_P (ap->val) - && CB_LITERAL (ap->val)->scale == 0 - && cb_get_long_long (ap->val) < cob_exp10_ll[f1->pic->digits]) { - output ("cob_set_llcon ("); - output_param (ap->var, 0); - } else { - output ("cob_set_llint ("); - output_param (ap->var, 0); - output (", "); - output (CB_FMT_LLD_F, cob_exp10_ll[f1->pic->digits]); - } - output (", (cob_s64_t)"); - output_integer (ap->val); - output (");\n"); - break; - } - } -#ifdef COB_NON_ALIGNED - /* Nonaligned */ - if (CB_TREE_CLASS (ap->var) == CB_CLASS_POINTER - || CB_TREE_CLASS (ap->val) == CB_CLASS_POINTER) { - /* Pointer assignment */ - output_block_open (); - output_line ("void *temp_ptr;"); - - /* temp_ptr = source address; */ - output_prefix (); - if (ap->val == cb_null || ap->val == cb_zero) { - /* MOVE NULL ... */ - output ("temp_ptr = 0;"); - } else if (CB_TREE_TAG (ap->val) == CB_TAG_CAST) { - /* MOVE ADDRESS OF val ... */ - cp = CB_CAST (ap->val); - output ("temp_ptr = "); - switch (cp->cast_type) { - case CB_CAST_ADDRESS: - output_data (cp->val); - break; - case CB_CAST_PROGRAM_POINTER: - output ("cob_call_field ("); - output_param (ap->val, -1); - if (current_prog->nested_prog_list) { - gen_nested_tab = 1; - output (", cob_nest_tab, 0, %d)", - cb_fold_call); - } else { - output (", NULL, 0, %d)", - cb_fold_call); - } - break; - /* LCOV_EXCL_START */ - default: - cobc_err_msg (_("unexpected cast type: %d"), - cp->cast_type); - COBC_ABORT (); - /* LCOV_EXCL_STOP */ - } - output (";"); - } else { - /* MOVE val ... */ - output ("memcpy(&temp_ptr, "); - output_data (ap->val); - output (", sizeof(temp_ptr));"); - } - output_newline (); - - /* Destination address = temp_ptr; */ - output_prefix (); - if (CB_TREE_TAG (ap->var) == CB_TAG_CAST) { - /* SET ADDRESS OF var ... */ - cp = CB_CAST (ap->var); - /* LCOV_EXCL_START */ - if (cp->cast_type != CB_CAST_ADDRESS) { - cobc_err_msg (_("unexpected tree type: %d"), - cp->cast_type); - COBC_ABORT (); - } - /* LCOV_EXCL_STOP */ - output_data (cp->val); - output (" = temp_ptr;"); - } else { - /* MOVE ... TO var */ - output ("memcpy("); - output_data (ap->var); - output (", &temp_ptr, sizeof(temp_ptr));"); - } - output_newline (); - - output_block_close (); - } else { - /* Numeric assignment */ - output_prefix (); - output_integer (ap->var); - output (" = "); - output_integer (ap->val); - if (inside_check == 0) { - output (";"); - output_newline (); - if (CB_TREE_TAG (ap->var) == CB_TAG_CAST - && CB_CAST (ap->var)->cast_type == CB_CAST_ADDRESS - && CB_TREE_TAG (ap->val) == CB_TAG_CAST - && CB_CAST (ap->val)->cast_type == CB_CAST_ADDRESS) { - f1 = cb_code_field (CB_CAST(ap->var)->val); - if (!f1->flag_field) { - savetarget = output_target; - output_target = NULL; - output_param (cb_build_field_reference (f1, NULL), 0); - output_target = savetarget; - } - if (f1->flag_any_length) { - f2 = cb_code_field (CB_CAST(ap->val)->val); - if (!f2->flag_field) { - savetarget = output_target; - output_target = NULL; - output_param (cb_build_field_reference (f2, NULL), 0); - output_target = savetarget; - } - output_line ("%s%d.size = %s%d.size;", - CB_PREFIX_FIELD, f1->id, - CB_PREFIX_FIELD, f2->id); - } - } - } else { - inside_stack[inside_check - 1] = 1; - } - } -#else /* Nonaligned */ - /* Numeric assignment */ - output_prefix (); - output_integer (ap->var); - output (" = "); - output_integer (ap->val); - if (inside_check == 0) { - output (";"); - output_newline (); - if (CB_TREE_TAG (ap->var) == CB_TAG_CAST - && CB_CAST (ap->var)->cast_type == CB_CAST_ADDRESS - && CB_TREE_TAG (ap->val) == CB_TAG_CAST - && CB_CAST (ap->val)->cast_type == CB_CAST_ADDRESS) { - f1 = cb_code_field (CB_CAST(ap->var)->val); - if (f1->flag_any_length) { - f2 = cb_code_field (CB_CAST(ap->val)->val); - if (!f2->flag_field) { - savetarget = output_target; - output_target = NULL; - output_param (cb_build_field_reference (f2, NULL), 0); - output_target = savetarget; - } - output_line ("%s%d.size = %s%d.size;", - CB_PREFIX_FIELD, f1->id, - CB_PREFIX_FIELD, f2->id); - } - } - } else { - inside_stack[inside_check - 1] = 1; - } -#endif /* Nonaligned */ - break; - case CB_TAG_INITIALIZE: - output_initialize (CB_INITIALIZE (x)); - break; - case CB_TAG_SEARCH: - output_search (CB_SEARCH (x)); - break; - case CB_TAG_CALL: - output_call (CB_CALL (x)); - break; - case CB_TAG_GOTO: - output_goto (CB_GOTO (x)); - break; - case CB_TAG_CANCEL: - output_cancel (CB_CANCEL (x)); - break; - case CB_TAG_SET_ATTR: - sap = CB_SET_ATTR (x); - output_set_attribute (sap->fld, sap->val_on, sap->val_off); - break; - case CB_TAG_ALTER: - output_alter (CB_ALTER (x)); - break; - case CB_TAG_IF: - ip = CB_IF (x); - if (ip->stmt1 == NULL - && ip->stmt2 == NULL) { - if (!ip->is_if) { - output_line ("/* WHEN has code omitted */"); - } else { - output_line ("/* IF has code omitted */"); - } - break; - } - if (!ip->is_if) { - output_newline (); - if (ip->test == cb_true - && cb_flag_remove_unreachable) { - output_line ("/* WHEN is always TRUE */"); - } else if (ip->test == cb_false - && cb_flag_remove_unreachable) { - output_line ("/* WHEN is always FALSE */"); - } else - if (ip->test - && CB_TREE_TAG (ip->test) == CB_TAG_BINARY_OP) { - bop = CB_BINARY_OP (ip->test); - w = NULL; - if (bop->op == '!') { - w = bop->x; - } else if (bop->y) { - w = bop->y; - } else if (bop->x) { - w = bop->x; - } - if (w == cb_true) { - output_line ("/* WHEN is always %s */", bop->op == '!'?"FALSE":"TRUE"); - } else if (w == cb_false) { - output_line ("/* WHEN is always %s */", bop->op != '!'?"FALSE":"TRUE"); - } else if (ip->test->source_line || (w && w->source_line)) { - if (ip->test->source_line) { - w = ip->test; - } - output_prefix (); - output ("/* Line: %-10d: %-19s", w->source_line, "WHEN"); - if (w->source_file) { - output (": %s ", w->source_file); - } - output ("*/"); - output_newline (); - /* Output source location as code */ - if (cb_flag_source_location - || cb_flag_dump) { - if (last_line != w->source_line) { - output_line ("module->module_stmt = 0x%08X;", - COB_SET_LINE_FILE(w->source_line, lookup_source(w->source_file))); - } - } - if (last_line != w->source_line) { - /* Output source location as code */ - output_line_and_trace_info (w, "WHEN"); - } - } else { - output_line ("/* WHEN */"); - } - } else if (ip->test->source_line) { - output_line ("/* Line: %-10d: WHEN */", ip->test->source_line); - if (last_line != ip->test->source_line) { - /* Output source location as code */ - output_line_and_trace_info (ip->test, "WHEN"); - } - } else { - output_line ("/* WHEN */"); - } - output_newline (); - } - code = 0; - output_prefix (); - /* Really PRESENT WHEN for Report field */ - if (ip->is_if == 2 - && ip->stmt1 == NULL - && ip->stmt2 != NULL) { - struct cb_field *p2 = (struct cb_field *)ip->stmt2; - if((p2->report_flag & COB_REPORT_LINE)) { - px = (char*)CB_PREFIX_REPORT_LINE; - output_line ("/* PRESENT WHEN Line */"); - } else { - px = (char*)CB_PREFIX_REPORT_FIELD; - output_line ("/* PRESENT WHEN field */"); - } - output_prefix (); - output ("if ("); - output_cond (ip->test, 0); - output (")"); - output_newline (); - output_line ("{"); - output_line ("\t%s%d.suppress = 0;", px, p2->id); - output_line ("} else {"); - output_line ("\t%s%d.suppress = 1;", px, p2->id); - output_line ("}"); - break; - } - /* Really PRESENT WHEN for Report line */ - if (ip->is_if == 3 - && ip->stmt1 == NULL - && ip->stmt2 != NULL) { - struct cb_field *p2 = (struct cb_field *)ip->stmt2; - if((p2->report_flag & COB_REPORT_LINE)) { - px = (char*)CB_PREFIX_REPORT_LINE; - output_line ("/* PRESENT WHEN line */"); - } else { - px = (char*)CB_PREFIX_REPORT_FIELD; - output_line ("/* PRESENT WHEN Field */"); - } - output_prefix (); - output ("if ("); - output_cond (ip->test, 0); - output (")"); - output_newline (); - output_line ("{"); - output_line ("\t%s%d.suppress = 0;", px, p2->id); - output_line ("} else {"); - output_line ("\t%s%d.suppress = 1;", px, p2->id); - output_line ("}"); - break; - } - if (ip->test == cb_false - && ip->stmt1 == NULL - && cb_flag_remove_unreachable) { - output_line (" /* FALSE condition and code omitted */"); - skip_else = 1; - } else { - skip_else = 0; - output ("if ("); - output_cond (ip->test, 0); - output (")"); - output_newline (); - output_block_open (); - if (ip->stmt1) { - output_stmt (ip->stmt1); - } else { - output_line ("; /* Nothing */"); - } - output_block_close (); - } - if (ip->stmt2) { - if (!skip_else) { - output_line ("else"); - } - output_line ("{"); - output_indent_level += 2; - if (ip->is_if) { - output_line ("/* ELSE */"); - } else { - output_line ("/* WHEN */"); - } - output_stmt (ip->stmt2); - output_indent_level -= 2; - output_line ("}"); - } - break; - case CB_TAG_PERFORM: - output_perform (CB_PERFORM (x)); - break; - /* "common" CONTINUE, note: - CONTINUE AFTER exp SECONDS is already translated into a funcall */ - case CB_TAG_CONTINUE: - output_line (";"); - break; - case CB_TAG_LIST: - if (cb_flag_extra_brace) { - output_block_open (); - } - for (; x; x = CB_CHAIN (x)) { - output_stmt (CB_VALUE (x)); - } - if (cb_flag_extra_brace) { - output_block_close (); - } - break; - case CB_TAG_REFERENCE: - output_stmt (CB_REFERENCE(x)->value); - break; - case CB_TAG_DIRECT: - if (CB_DIRECT (x)->flag_is_direct) { - if (CB_DIRECT (x)->flag_new_line) { - output_newline (); - } - output_line ("%s", (const char *)(CB_DIRECT (x)->line)); - } else { - output_newline (); - output_line ("/* %s */", (const char *)(CB_DIRECT (x)->line)); - } - break; - case CB_TAG_DEBUG: - if (!current_prog->flag_gen_debug) { - break; - } - output_prefix (); - size = cb_code_field (CB_DEBUG(x)->target)->size; - if (CB_DEBUG(x)->value) { - if (size <= CB_DEBUG(x)->size) { - output ("memcpy ("); - output_data (CB_DEBUG(x)->target); - output (", %s%d, %d);", CB_PREFIX_STRING, - lookup_string (CB_DEBUG(x)->value), - (int)size); - output_newline (); - } else { - output ("memcpy ("); - output_data (CB_DEBUG(x)->target); - output (", %s%d, %d);\n", CB_PREFIX_STRING, - lookup_string (CB_DEBUG(x)->value), - (int)CB_DEBUG(x)->size); - output_newline (); - output_prefix (); - output ("memset ("); - output_data (CB_DEBUG(x)->target); - code = (int)(size - CB_DEBUG(x)->size); - output (" + %d, ' ', %d);", - (int)CB_DEBUG(x)->size, code); - output_newline (); - - } - } else { - if (size <= CB_DEBUG(x)->size) { - output ("memcpy ("); - output_data (CB_DEBUG(x)->target); - output (", "); - output_data (CB_DEBUG(x)->fld); - output (", %d);", (int)size); - output_newline (); - } else { - output ("memcpy ("); - output_data (CB_DEBUG(x)->target); - output (", "); - output_data (CB_DEBUG(x)->fld); - output (", %d);", (int)CB_DEBUG(x)->size); - output_newline (); - output_prefix (); - output ("memset ("); - output_data (CB_DEBUG(x)->target); - code = (int)(size - CB_DEBUG(x)->size); - output (" + %d, ' ', %d);", - (int)CB_DEBUG(x)->size, code); - output_newline (); - } - } - break; - case CB_TAG_DEBUG_CALL: - output_perform_call (CB_DEBUG_CALL(x)->target, - CB_DEBUG_CALL(x)->target); - break; - case CB_TAG_ML_SUPPRESS_CHECKS: - output_ml_suppress_checks (CB_ML_SUPPRESS_CHECKS (x)); - break; - /* LCOV_EXCL_START */ - default: - cobc_err_msg (_("unexpected tree tag: %d"), (int)CB_TREE_TAG (x)); - COBC_ABORT (); - /* LCOV_EXCL_STOP */ - } -} - -/* File definition */ - -static int -output_file_allocation (struct cb_file *f) -{ - if (f->flag_global) { - output_storage ("\n/* Global file %s */\n", f->name); - output_storage ("static cob_file\t\t*%s%s = NULL;\n",CB_PREFIX_FILE, f->cname); - if (f->organization == COB_ORG_RELATIVE - && f->key == NULL) { - int i = lookup_attr (COB_TYPE_NUMERIC_DISPLAY, 0, 0, 0, NULL, 0); - output_storage ("static unsigned char\t%s%s_recnum[12+1] = \"000000000000\";\n", - CB_PREFIX_SEQUENCE, f->cname); - output_storage ("static cob_field %s%s_recnum = { 12, (cob_u8_ptr)%s%s_recnum, &%s%d };\n", - CB_PREFIX_FIELD, f->cname, - CB_PREFIX_SEQUENCE, f->cname, - CB_PREFIX_ATTR, i); - } - } else { - output_local ("\n/* File %s */\n", f->name); - output_local ("static cob_file\t\t*%s%s = NULL;\n",CB_PREFIX_FILE, f->cname); - if (f->organization == COB_ORG_RELATIVE - && f->key == NULL) { - int i = lookup_attr (COB_TYPE_NUMERIC_DISPLAY, 0, 0, 0, NULL, 0); - output_local ("static unsigned char\t%s%s_recnum[12+1] = \"000000000000\";\n", - CB_PREFIX_SEQUENCE, f->cname); - output_local ("static cob_field %s%s_recnum = { 12, (cob_u8_ptr)%s%s_recnum, &%s%d };\n", - CB_PREFIX_FIELD, f->cname, - CB_PREFIX_SEQUENCE, f->cname, - CB_PREFIX_ATTR, i); - } - } - - if (f->code_set) { - gen_native = 1; - switch (f->code_set->alphabet_type) { - case CB_ALPHABET_ASCII: - gen_ebcdic_ascii = 1; - break; - case CB_ALPHABET_EBCDIC: - gen_full_ebcdic = 1; - break; - case CB_ALPHABET_CUSTOM: - gen_custom = 1; - break; - default: - break; - } - } - - if (f->linage) { - return 1; - } - return 0; -} - -static void -output_key_components (struct cb_file* f, struct cb_key_component* key_component, int key) -{ - int parts; - struct cb_key_component* comp = key_component; - COB_UNUSED(f); - COB_UNUSED(key); - if (key_component != NULL) { - for (parts = 0; comp != NULL; comp = comp->next, ++parts); - output (","); - if (parts > 1) { - output_newline (); - output_indent_level += 18; - output_prefix (); - } - output ("%d",parts); - for (comp = key_component; comp != NULL; comp = comp->next) { - output (","); - output_param (comp->component, -1); - } - if (parts > 1) { - output_indent_level -= 18; - } - } else { - output (",0,NULL"); - } - output (");"); - output_newline (); -} - -static void -output_file_initialization (struct cb_file *f) -{ - struct cb_alt_key *l; - int nkeys; - char nxt[8]; - char features[128]; -#define FNAME_SIZE 64 - char file_name[FNAME_SIZE], extname[FNAME_SIZE + 2]; -#undef FNAME_SIZE - const char *org_name = "0"; - const char *acc_name = "0"; - const char *fmt_name = "0"; - const char *file_features = "0"; - switch (f->organization) { - case COB_ORG_SEQUENTIAL: - org_name = "COB_ORG_SEQUENTIAL"; - break; - case COB_ORG_RELATIVE: - org_name = "COB_ORG_RELATIVE"; - break; - case COB_ORG_LINE_SEQUENTIAL: - org_name = "COB_ORG_LINE_SEQUENTIAL"; - break; - case COB_ORG_INDEXED: - org_name = "COB_ORG_INDEXED"; - break; - case COB_ORG_SORT: - org_name = "COB_ORG_SORT"; - break; - } - switch (f->access_mode) { - case COB_ACCESS_SEQUENTIAL: - acc_name = "COB_ACCESS_SEQUENTIAL"; - break; - case COB_ACCESS_RANDOM: - acc_name = "COB_ACCESS_RANDOM"; - break; - case COB_ACCESS_DYNAMIC: - acc_name = "COB_ACCESS_DYNAMIC"; - break; - } - if (cb_mf_files) { - fmt_name = "COB_FILE_IS_MF"; - if (f->organization == COB_ORG_LINE_SEQUENTIAL) { - file_features = "COB_FILE_LS_NULLS"; - } - } else { - fmt_name = "COB_FILE_IS_DFLT"; - } - strcpy (features,""); - strcpy (nxt,""); - if (f->file_status) { - sprintf(&features[strlen(features)],"%sCOB_SELECT_FILE_STATUS",nxt); - strcpy(nxt,"|"); - } - if (f->linage) { - sprintf(&features[strlen(features)],"%sCOB_SELECT_LINAGE",nxt); - strcpy(nxt,"|"); - } - if (f->flag_external) { - sprintf(&features[strlen(features)],"%sCOB_SELECT_EXTERNAL",nxt); - strcpy(nxt,"|"); - } - if (f->special) { /* Special assignment */ - sprintf(&features[strlen(features)],"%s%d",nxt,f->special); - strcpy(nxt,"|"); - } - if (features[0] < ' ') - strcpy(features,"0"); - - output_line ("/* File initialization for %s */", f->name); - sprintf (file_name, "%s%s", CB_PREFIX_FILE, f->cname); - if (f->organization == COB_ORG_RELATIVE - || f->organization == COB_ORG_INDEXED) { - nkeys = 1; - for (l = f->alt_key_list; l; l = l->next) { - nkeys++; - } - } else { - nkeys = 0; - } - if (f->flag_external) { - sprintf (extname, "\"%s\"", file_name); - } else { - strcpy (extname, "NULL"); - } - output_line ("cob_file_create (&%s, %s, \"%s\",", file_name, extname, f->name); - output_indent_level += 17; - output_line ("%s,%s,%d,",org_name,acc_name,f->optional); - output_line ("%s,%s,%d,%d,%d,",fmt_name,features,nkeys,f->record_min,f->record_max); - output_prefix (); - output_param (f->assign, -1); - output (","); - output_param (CB_TREE (f->record), -1); - output (");"); - output_indent_level -= 17; - output_newline (); - -#ifndef HAS_WITH_INDEXED - if (f->organization == COB_ORG_INDEXED) { - char msg[80]; - snprintf(msg,sizeof(msg),"ORGANIZATION INDEXED; FD %s",f->name); - cb_warning (cb_warn_unsupported, - _("compiler is not configured to support %s"), msg); - } -#endif - - nkeys = 1; - /* Output RELATIVE/RECORD KEY's */ - if (f->organization == COB_ORG_RELATIVE - || f->organization == COB_ORG_INDEXED) { - output_prefix (); - output ("cob_file_set_key (%s,0,",file_name); - if (f->organization == COB_ORG_RELATIVE - && f->key == NULL) { - output ("&%s%s_recnum", CB_PREFIX_FIELD, f->cname); - } else { - output_param (f->key, -1); - } - output (",0,0,-1,NULL"); - output_key_components (f, f->component_list, 0); - - for (l = f->alt_key_list; l; l = l->next) { - output_prefix (); - output ("cob_file_set_key (%s,%d,",file_name,nkeys); - output_param (l->key, -1); - output (",%d,0",l->duplicates); - if (l->suppress - && CB_LITERAL_P(l->suppress)) { - struct cb_literal *lit = CB_LITERAL (l->suppress); - output (",%d,\"%.*s\"",lit->size,lit->size,lit->data); - } else - if (l->tf_suppress) { - if (isprint((char)l->char_suppress)) - output (",0,(const unsigned char *)\"%c\"",l->char_suppress); - else - output (",0,(const unsigned char *)\"\\%03o\"",l->char_suppress); - } else { - output (",-1,NULL"); - } - output_key_components (f, l->component_list, nkeys); - nkeys++; - } - } - - if (f->flag_line_adv - || f->record_depending - || strcmp(file_features,"0") != 0) { - output_prefix (); - output ("cob_file_set_attr (%s,",file_name); - if (f->record_depending) { - output_param (f->record_depending, -1); - } else { - output ("NULL"); - } - output (",%d,%s", f->flag_line_adv,file_features); - output (",NULL"); /* codeset */ - output (",NULL"); /* password */ - output (",NULL"); /* cryptkey */ - output (");"); - output_newline (); - } - - if (f->lock_mode) { - strcpy(nxt,""); - output_prefix (); - output ("cob_file_set_lock (%s,",file_name); - if ((f->lock_mode & COB_LOCK_OPEN_EXCLUSIVE)) { - output("%sCOB_LOCK_OPEN_EXCLUSIVE",nxt); - strcpy(nxt,"|"); - } - if ((f->lock_mode & COB_LOCK_EXCLUSIVE)) { - output("%sCOB_LOCK_EXCLUSIVE",nxt); - strcpy(nxt,"|"); - } - if ((f->lock_mode & COB_LOCK_MANUAL)) { - output("%sCOB_LOCK_MANUAL",nxt); - strcpy(nxt,"|"); - } - if ((f->lock_mode & COB_LOCK_AUTOMATIC)) { - output("%sCOB_LOCK_AUTOMATIC",nxt); - strcpy(nxt,"|"); - } - if ((f->lock_mode & COB_LOCK_MULTIPLE)) { - output("%sCOB_LOCK_MULTIPLE",nxt); - strcpy(nxt,"|"); - } - if ((f->lock_mode & COB_LOCK_ROLLBACK)) { - output("%sCOB_LOCK_ROLLBACK",nxt); - strcpy(nxt,"|"); - } - if (nxt[0] < ' ') - output("%d",f->lock_mode); - output (");"); - output_newline (); - } - - if (f->linage) { - output_prefix (); - output ("cob_file_set_linage (%s,",file_name); - output_param (f->linage, -1); - output (","); - output_param (f->linage_ctr, -1); - output (","); - if (f->latfoot) { - output_param (f->latfoot, -1); - } else { - output ("NULL"); - } - output (","); - output_newline (); - output_indent_level += 18; - output_prefix (); - if (f->lattop) { - output_param (f->lattop, -1); - } else { - output ("NULL"); - } - output (","); - if (f->latbot) { - output_param (f->latbot, -1); - } else { - output ("NULL"); - } - output (");"); - output_indent_level -= 18; - output_newline (); - } - - if (f->organization == COB_ORG_RELATIVE - || f->organization == COB_ORG_INDEXED) { - if ((f->flag_sql_xfd || cb_all_files_xfd) - && cb_sqldb_name) { - if (f->sql_name) { - output_line ("cob_file_xfdname (%s%s, \"%s\");", - CB_PREFIX_FILE, f->cname, f->sql_name); - } - output_xfd_file (f); - } - } - output_line ("cob_file_complete (%s);",file_name); - output_newline (); -} - -/* Screen definition */ - -static void -output_screen_definition (struct cb_field *p) -{ - int type; - - if (p->sister) { - output_screen_definition (p->sister); - } - if (p->children) { - output_screen_definition (p->children); - } - - type = (p->children ? COB_SCREEN_TYPE_GROUP : - p->values ? COB_SCREEN_TYPE_VALUE : - (p->size > 0) ? COB_SCREEN_TYPE_FIELD : COB_SCREEN_TYPE_ATTRIBUTE); - if (type == COB_SCREEN_TYPE_FIELD || type == COB_SCREEN_TYPE_VALUE) { - p->count++; - } - - output_local ("static cob_screen\t%s%d;\n", CB_PREFIX_SCR_FIELD, p->id); -} - -static void -output_screen_init (struct cb_field *p, struct cb_field *previous) -{ - int type; - - type = (p->children ? COB_SCREEN_TYPE_GROUP : - p->values ? COB_SCREEN_TYPE_VALUE : - (p->size > 0) ? COB_SCREEN_TYPE_FIELD : COB_SCREEN_TYPE_ATTRIBUTE); - output_prefix (); - output ("cob_set_screen (&%s%d, ", CB_PREFIX_SCR_FIELD, p->id); - - if (p->sister && p->sister->level != 1) { - output ("&%s%d, ", CB_PREFIX_SCR_FIELD, p->sister->id); - } else { - output ("NULL, "); - } - - if (previous && previous->level != 1) { - output ("&%s%d, ", CB_PREFIX_SCR_FIELD, previous->id); - } else { - output ("NULL, "); - } - - output_newline (); - output_prefix (); - output ("\t\t "); - - if (type == COB_SCREEN_TYPE_GROUP) { - output ("&%s%d, ", CB_PREFIX_SCR_FIELD, p->children->id); - } else { - output ("NULL, "); - } - - if (p->parent) { - output ("&%s%d, ", CB_PREFIX_SCR_FIELD, p->parent->id); - } else { - output ("NULL, "); - } - - if (type == COB_SCREEN_TYPE_FIELD) { - output_param (cb_build_field_reference (p, NULL), -1); - output (", "); - } else { - output ("NULL, "); - } - - output_newline (); - output_prefix (); - output ("\t\t "); - - if (type == COB_SCREEN_TYPE_VALUE) { - /* Need a field reference here */ - output_param (cb_build_field_reference (p, NULL), -1); - output (", "); - } else { - output ("NULL, "); - } - - if (p->screen_line) { - output_param (p->screen_line, 0); - output (", "); - } else { - output ("NULL, "); - } - - if (p->screen_column) { - output_param (p->screen_column, 0); - output (", "); - } else { - output ("NULL, "); - } - - output_newline (); - output_prefix (); - output ("\t\t "); - - if (p->screen_foreg) { - output_param (p->screen_foreg, 0); - output (", "); - } else { - output ("NULL, "); - } - - if (p->screen_backg) { - output_param (p->screen_backg, 0); - output (", "); - } else { - output ("NULL, "); - } - - if (p->screen_prompt) { - output_param (p->screen_prompt, 0); - output (", "); - } else { - output ("NULL, "); - } - - output_newline (); - output_line ("\t\t %d, %d, 0x" CB_FMT_LLX ");", - type, p->occurs_min, p->screen_flag); - - /* TODO: pass information for USAGE CONTROL items here */ - - if (p->parent) { - /* Generate useless reference to avoid C compile warning */ - output_prefix (); - output("COB_UNUSED("); - output_param (cb_build_field_reference (p->parent, NULL), -1); - output (");"); - output_newline (); - } - - if (p->children) { - output_screen_init (p->children, NULL); - } - if (p->sister) { - output_screen_init (p->sister, p); - } -} - -/* JSON/XML GENERATE trees */ - -static void -output_ml_attrs_init (struct cb_ml_generate_tree *attr) -{ - for (; attr; attr = attr->sibling) { - output_prefix (); - output ("cob_set_ml_attr (&%s%d, ", CB_PREFIX_ML_ATTR, attr->id); - - output_param (attr->name, -1); - output (", "); - - output_param (attr->value, -1); - output (", 0, "); - - if (attr->sibling) { - output ("&%s%d", CB_PREFIX_ML_ATTR, attr->sibling->id); - } else { - output ("NULL"); - } - output (");"); - output_newline (); - } -} - -static void -output_ml_elt_init (struct cb_ml_generate_tree *tree) -{ - output_prefix (); - output ("cob_set_ml_tree (&%s%d, ", CB_PREFIX_ML_TREE, tree->id); - - output_param (tree->name, -1); - - if (tree->attrs) { - output (", &%s%d, ", CB_PREFIX_ML_ATTR, tree->attrs->id); - } else { - output (", NULL, "); - } - - if (tree->value) { - output_param (tree->value, -1); - } else { - output ("NULL"); - } - - output (", 0, "); - - if (tree->children) { - output ("&%s%d, ", CB_PREFIX_ML_TREE, tree->children->id); - } else { - output ("NULL, "); - } - - if (tree->sibling) { - output ("&%s%d", CB_PREFIX_ML_TREE, tree->sibling->id); - } else { - output ("NULL"); - } - - output (");"); - output_newline (); -} - -static void -output_ml_generate_init (struct cb_ml_generate_tree *tree) -{ - for (; tree; tree = tree->sibling) { - if (tree->attrs) { - output_ml_attrs_init (tree->attrs); - } - if (tree->children) { - output_ml_generate_init (tree->children); - } - output_ml_elt_init (tree); - } -} - -/* Handle REPORTs */ - -static void -compute_report_rcsz (struct cb_field *p) -{ - if (p->sister) { - compute_report_rcsz (p->sister); - } - if (p->children) { - compute_report_rcsz (p->children); - } - p->count++; -} - -/* Report data definition */ - -/* Individual fields of the report(s) */ -static int report_col_pos = 1; -static void -output_report_data (struct cb_field *p) -{ - int prev_col_pos,idx; - struct cb_field *pp; - cb_tree x, l; - - if (p->storage == CB_STORAGE_REPORT) { - if (p->level == 1 - || (p->report_flag & COB_REPORT_LINE) - || (p->report_flag & COB_REPORT_LINE_PLUS) - || (p->report_flag & COB_REPORT_DETAIL) - || (p->report_flag & COB_REPORT_HEADING) - || (p->report_flag & COB_REPORT_FOOTING) - || (p->report_flag & COB_REPORT_PAGE_HEADING) - || (p->report_flag & COB_REPORT_PAGE_FOOTING)) { - prev_col_pos = report_col_pos = 1; - } else { - if((p->report_flag & COB_REPORT_COLUMN_PLUS) - && p->report_column > 0) { - p->report_column = report_col_pos + p->report_column - 1; - /*p->report_flag &= ~COB_REPORT_COLUMN_PLUS;*/ - } else if(p->report_column <= 0) { /* No COLUMN was given */ - p->report_column = report_col_pos; - } - prev_col_pos = report_col_pos; - if(p->flag_occurs && p->occurs_max > 1) { - if(p->step_count < p->size) - p->step_count = p->size; - x = NULL; - idx = 0; - for (l = p->report_column_list; l; l = CB_CHAIN (l)) { - x = CB_VALUE (l); - idx++; - } - if(x && idx >= p->occurs_max) { - report_col_pos = cb_get_int(x) + p->step_count; - } else - if(x && idx > 1) { - report_col_pos = cb_get_int(x) + (p->step_count * (p->occurs_max - idx + 1)); - } else { - report_col_pos = p->report_column + (p->step_count * p->occurs_max); - } - for(pp=p->parent; pp; pp = pp->parent) { - if(pp->flag_occurs) { - CB_PENDING_X(CB_TREE(pp), _("Nested OCCURS in report")); - break; - } - } - } else - if((p->report_flag & COB_REPORT_COLUMN_RIGHT)) { - report_col_pos = p->report_column + 1; - p->report_column = report_col_pos - p->size; - } else - if((p->report_flag & COB_REPORT_COLUMN_CENTER)) { - if(p->size & 1) { - p->report_column = p->report_column - ((p->size - 1) / 2); - report_col_pos = p->report_column + (p->size / 2) + 1; - } else { - p->report_column = p->report_column - (p->size / 2) + 1; - report_col_pos = p->report_column + (p->size / 2) + 1; - } - } else { - report_col_pos = p->report_column + p->size; - } - } - output_emit_field(cb_build_field_reference (p, NULL), NULL); - if(p->report_sum_counter) { - output_emit_field (p->report_sum_counter, "SUM"); - } - if(p->report_source) { - output_emit_field (p->report_source, "SOURCE"); - } - if(p->report_control) { - output_emit_field (p->report_control, "CONTROL"); - } - if (p->children) { - report_col_pos = prev_col_pos; - output_report_data (p->children); - } - } - if (p->sister) { - output_report_data (p->sister); - } -} - -static void -output_report_sum_control_field (struct cb_field *p) -{ - cb_tree l,x; - if(p == NULL) - return; - if(p->storage == CB_STORAGE_REPORT) { - if(p->level == 01) { - output_base(p,1U); - } - if(p->report_sum_counter) { - output_base(cb_code_field(p->report_sum_counter),1U); - } - if(p->report_control) { - output_base(cb_code_field(p->report_control),1U); - } - if(p->report_source) { - output_base(cb_code_field(p->report_source),1U); - } - for (l = p->report_sum_list; l; l = CB_CHAIN (l)) { - x = CB_VALUE (l); - output_base(cb_code_field(x),1); - } - if (p->children) { - output_report_sum_control_field (p->children); - } - } - if (p->sister) { - output_report_sum_control_field (p->sister); - } -} - -static void -output_report_summed_field (struct cb_field *p) -{ - cb_tree l, x; - struct cb_field *f; - if(p == NULL) - return; - if(p->storage == CB_STORAGE_REPORT) { - for (l = p->report_sum_list; l; l = CB_CHAIN (l)) { - x = CB_VALUE (l); - f = cb_code_field(x); - if (f->storage == CB_STORAGE_WORKING - && !(f->report_flag & COB_REPORT_REF_EMITTED)) { - output_emit_field(cb_build_field_reference (f, NULL), NULL); - } - } - if (p->children) { - output_report_summed_field (p->children); - } - } - if (p->sister) { - output_report_summed_field (p->sister); - } -} - -/* Report definition */ - -static void -output_report_control (struct cb_report *p, int id, cb_tree ctl, cb_tree nx) -{ - struct cb_field *s; - struct cb_field *f; - cb_tree l, x; - int i, bfound, prvid, seq; - - x = CB_VALUE (ctl); - s = cb_code_field(x); - if(nx) { - output_report_control(p, id, nx, CB_CHAIN(nx)); - } - output_local("/* Report %s: CONTROL %s */\n",p->name,s->name); - prvid = 0; - for(i = 0; i < p->num_lines; i++) { - if(p->line_ids[i]->report_control) { - struct cb_field *c = cb_code_field (p->line_ids[i]->report_control); - if(c == s) { - f = p->line_ids[i]; - if(f->report_flag & COB_REPORT_CONTROL_HEADING) { - output_local("/* CONTROL HEADING: %s */\n",s->name); - } else if(f->report_flag & COB_REPORT_CONTROL_FOOTING) { - output_local("/* CONTROL FOOTING: %s */\n",s->name); - } - output_local("static cob_report_control_ref %s%d = {", - CB_PREFIX_REPORT_REF,p->line_ids[i]->id); - if(prvid == 0) { - output_local("NULL,"); - } else { - output_local("&%s%d,",CB_PREFIX_REPORT_REF,prvid); - } - output_local("&%s%d",CB_PREFIX_REPORT_LINE,p->line_ids[i]->id); - output_local("};\n"); - prvid = p->line_ids[i]->id; - } - } - } - output_local ("static cob_report_control %s%d_%d\t= {", CB_PREFIX_REPORT_CONTROL,id,s->id); - if(nx) { - output_local("&%s%d_%d,",CB_PREFIX_REPORT_CONTROL,id,cb_code_field(CB_VALUE(nx))->id); - } else { - output_local("NULL,"); - } - output_local ("\"%s\",",s->name); - output_local("&%s%d,NULL,NULL",CB_PREFIX_FIELD,s->id); - bfound = 0; - /* CB_PREFIX_REPORT_REF */ - for(i= p->num_lines-1; i >= 0; i--) { - if(p->line_ids[i]->report_control) { - struct cb_field *c = cb_code_field (p->line_ids[i]->report_control); - if(c == s) { - bfound = 1; - output_local(",&%s%d",CB_PREFIX_REPORT_REF,p->line_ids[i]->id); - break; - } - } - } - if(!bfound) { - printf("Control field %s is not referenced in report\n",s->name); - output_local(",NULL"); - } - seq = i = 0; - for (l = p->controls; l; l = CB_CHAIN (l)) { - x = CB_VALUE (l); - f = cb_code_field(x); - i++; - if(s == f) { - seq = i; - break; - } - } - output_local(",%d,0,0,0,0",seq); - output_local("};\n"); -} - -static void -output_report_def_fields (int bgn, int id, struct cb_field *f, struct cb_report *r, int subscript) -{ - int idx, colnum; - cb_tree l, x; - cb_tree value; - unsigned int i, j; - - if(bgn == 1) - report_field_id = 0; - - if (bgn == 0 - && (f->report_flag & COB_REPORT_LINE)) { /* Start of next Line */ - return; - } - if(subscript <= 0) { - if(f->flag_occurs && f->occurs_max > 1) { - if (f->sister) { - output_report_def_fields (0,id,f->sister,r,0); - } - for(idx = f->occurs_max; idx >= 1; idx--) { - output_report_def_fields (0,id,f,r,idx); - } - return; - } - - if (f->sister) { - output_report_def_fields (0,id,f->sister,r,0); - } - if (f->children - && f->storage == CB_STORAGE_REPORT - && f->report == r) { - output_report_def_fields (0,id,f->children,r,0); - } - if (f->report_source || f->report_control || (f->report_flag & COB_REPORT_PRESENT)) { - output_local("\t\t/* "); - if(f->report_source) { - struct cb_field *s = cb_code_field (f->report_source); - if(s) output_local("SOURCE %s; ",s->name); - } - if((f->report_flag & COB_REPORT_PRESENT)) { - output_local("PRESENT "); - if((f->report_flag & COB_REPORT_BEFORE)) - output_local("BEFORE "); - else - output_local("AFTER "); - if((f->report_flag & COB_REPORT_ALL)) - output_local("ALL "); - if((f->report_flag & COB_REPORT_PAGE)) - output_local("PAGE "); - if(f->report_control) { - struct cb_field *s = cb_code_field (f->report_control); - if((f->report_flag & COB_REPORT_PAGE)) - output_local("OR "); - if(s) output_local("%s; ",s->name); - } - } else - if(f->report_control) { - struct cb_field *s = cb_code_field (f->report_control); - if(s) output_local("CONTROL %s; ",s->name); - } - output_local("*/\n"); - } - output_local ("static cob_report_field %s%d\t= {", CB_PREFIX_REPORT_FIELD,f->id); - if(report_field_id == 0) - output_local("NULL,"); - else - output_local("&%s%d,",CB_PREFIX_REPORT_FIELD,report_field_id); - output_local("&%s%d,",CB_PREFIX_FIELD,f->id); - } else { - if(subscript == 1) { - output_local ("static cob_report_field %s%d\t= {", CB_PREFIX_REPORT_FIELD,f->id); - output_local("&%s%d_2,",CB_PREFIX_REPORT_FIELD,f->id); - output_local("&%s%d,",CB_PREFIX_FIELD,f->id); - } else if(subscript == f->occurs_max) { - output_local ("static cob_report_field %s%d_%d\t= {", CB_PREFIX_REPORT_FIELD,f->id,subscript); - if(report_field_id == 0) - output_local("NULL,"); - else - output_local("&%s%d,",CB_PREFIX_REPORT_FIELD,report_field_id); - output_local("&%s%d_%d,",CB_PREFIX_FIELD,f->id,subscript); - } else { - output_local ("static cob_report_field %s%d_%d\t= {", CB_PREFIX_REPORT_FIELD,f->id,subscript); - output_local("&%s%d_%d,",CB_PREFIX_REPORT_FIELD,f->id,subscript+1); - output_local("&%s%d_%d,",CB_PREFIX_FIELD,f->id,subscript); - } - } - report_field_id = f->id; - - if(f->report_source) { - output_param (f->report_source, 0); - } else if(f->report_sum_counter) { - output_local("/*SUM*/"); - output_param (f->report_sum_counter, 0); - } else { - output_local("NULL"); - } - output_local(","); - if(f->report_control) { - output_param (f->report_control, 0); - } else { - output_local("NULL"); - } - output_local(","); - if (f->values) { - value = CB_VALUE (f->values); - - if (CB_TREE_TAG (value) == CB_TAG_LITERAL) { - char *val; - size_t ref_size; - struct cb_literal *lit = CB_LITERAL (value); - if (lit->all) { - ref_size = f->size; - } else { - ref_size = lit->size; - } - if (lit->all) { - val = (char *)cobc_malloc (ref_size * 2 + 2); - if (lit->data[0] == '"' - || lit->data[0] == '\\') { /* Fix string for C code */ - for (i = j = 0; j < (unsigned int)f->size; j++) { - val[i++] = '\\'; - val[i++] = lit->data[0]; - } - } else { - memset (val, lit->data[0], f->size); - i = f->size; - } - } else { - val = (char *)cobc_malloc (lit->size * 2 + 2); - for (i = j = 0; j < lit->size; j++) { - if (lit->data[j] == '"' - || lit->data[j] == '\\') /* Fix string for C code */ - val[i++] = '\\'; - val[i++] = lit->data[j]; - } - } - val[i] = 0; - output_local("\"%s\",%d,", val, (int)ref_size); - cobc_free((void*) val); - } else { - output_local("NULL,0,"); - } - } else { - output_local("NULL,0,"); - } - if(f->step_count < f->size) - f->step_count = f->size; - if(f->report_column <= 0) /* No COLUMN was given */ - f->report_column = 1; - if(f->children) - f->report_flag |= COB_REPORT_GROUP_ITEM; - if(f->report_when) - f->report_flag |= COB_REPORT_HAD_WHEN; - if((f->report_flag&~(COB_REPORT_EMITTED|COB_REPORT_COLUMN_PLUS)) == 0) { - output_local("0,%d",f->report_line); - }else - if(subscript > 0) { - output_local("0x%X,%d",f->report_flag&~(COB_REPORT_EMITTED|COB_REPORT_GROUP_ITEM),f->report_line); - } else { - output_local("0x%X,%d",f->report_flag&~COB_REPORT_EMITTED,f->report_line); - } - if(subscript > 1) { - idx = 1; - colnum = 1; - x = NULL; - for (l = f->report_column_list; l && idx < subscript; l = CB_CHAIN (l)) { - idx++; - x = CB_VALUE (l); - colnum = cb_get_int(x); - } - if(l) { - x = CB_VALUE (l); - output_local(",%d",cb_get_int(x)); - } else - if(idx > 2) { - output_local(",%d",colnum + (f->step_count * (subscript - idx + 1))); - } else { - output_local(",%d",f->report_column + (f->step_count * (subscript-1))); - } - } else { - output_local(",%d",f->report_column); - } - output_local(",%d,%d",f->step_count,f->next_group_line); - output_local(",%d",f->level); - output_local(",0,0"); /* reportio flags: group_indicate & suppress */ - output_local ("};\n"); -} - -static void -output_report_define_lines (int top, struct cb_field *f, struct cb_report *r) -{ - struct cb_field *n, *c; - char fname[64]; - int fld_id; - - if(f == NULL) - return; - n = f->sister; - c = f->children; - if(n - && n->storage != CB_STORAGE_REPORT) - n = NULL; - if(n - && n->report != r) - n = NULL; - if(c - && c->storage != CB_STORAGE_REPORT) - c = NULL; - if(n - && (n->report_flag & COB_REPORT_LINE)) { - output_report_define_lines(top, n, r); - } - if(c - && (c->report_flag & COB_REPORT_LINE)) { - output_report_define_lines(0, c, r); - } else { - c = NULL; - } - if(!top) - c = NULL; - - if(f->report_flag & COB_REPORT_LINE_EMITTED) /* Already emitted? */ - return; - f->report_flag |= COB_REPORT_LINE_EMITTED; - - if(strncmp(f->name,"FILLER ",7) == 0) { - if(f->report_flag & COB_REPORT_PAGE_HEADING) { - strcpy(fname,"PAGE HEADING"); - } else if(f->report_flag & COB_REPORT_PAGE_FOOTING) { - strcpy(fname,"PAGE HEADING"); - } else if(f->report_flag & COB_REPORT_HEADING) { - strcpy(fname,"REPORT HEADING"); - } else if(f->report_flag & COB_REPORT_FOOTING) { - strcpy(fname,"REPORT FOOTING"); - } else if(f->report_flag & COB_REPORT_CONTROL_HEADING) { - strcpy(fname,"CONTROL HEADING"); - } else if(f->report_flag & COB_REPORT_CONTROL_FOOTING) { - strcpy(fname,"CONTROL FOOTING"); - } else if(f->report_flag & COB_REPORT_CONTROL_FOOTING_FINAL) { - strcpy(fname,"CONTROL FOOTING FINAL"); - } else if(f->report_flag & COB_REPORT_CONTROL_HEADING_FINAL) { - strcpy(fname,"CONTROL HEADING FINAL"); - } else { - strcpy(fname,""); - } - if(f->report_control) { - sprintf(&fname[strlen(fname)]," %s",cb_code_field(f->report_control)->name); - } - if(strlen(fname) > 1) - strcat(fname," of "); - } else { - sprintf(fname,"%s of ",f->name); - } - output_local("\n/* %s%s ",fname,r->name); - if((f->report_flag & COB_REPORT_LINE) - && f->children - && (f->children->report_flag & COB_REPORT_LINE)) { - printf("Warning: Ignoring nested LINE %s %d\n", - (f->report_flag & COB_REPORT_LINE_PLUS)?"PLUS":"", - f->report_line); - f->report_line = 0; - f->report_flag &= ~COB_REPORT_LINE_PLUS; - f->report_flag &= ~COB_REPORT_LINE; - } - if(f->report_flag & COB_REPORT_LINE) - output_local("LINE %s %d ", - (f->report_flag & COB_REPORT_LINE_PLUS)?"PLUS":"", - f->report_line); - output_local("*/\n"); - fld_id = 0; - if((f->report_flag & COB_REPORT_LINE) - && f->children != NULL) { - output_report_def_fields (1,f->id,f->children,r,0); - fld_id = f->children->id; - } else if(f->children == NULL) { - if(f->report_flag & COB_REPORT_LINE) { - output_report_def_fields (1,f->id,f,r,0); - fld_id = f->id; - } - } - output_local ("static cob_report_line %s%d\t= {", CB_PREFIX_REPORT_LINE,f->id); - if(n == NULL) { - output_local("NULL,"); - } else if(n->level > 1 - && !(n->report_flag & COB_REPORT_LINE)) { - output_local("NULL, "); - } else { - output_local("&%s%d,",CB_PREFIX_REPORT_LINE,n->id); - } - if(c == NULL) - output_local("NULL,"); - else - output_local("&%s%d,",CB_PREFIX_REPORT_LINE,c->id); - if(fld_id != 0) - output_local("&%s%d,",CB_PREFIX_REPORT_FIELD,fld_id); - else - output_local("NULL,"); - if(f->report_control) { - output_param (f->report_control, 0); - } else { - output_local("NULL"); - } - output_local(",%d",f->report_decl_id); - if(f->report_decl_id) - output_local("/* Declaratives */"); - output_local(",%d,%d,%d,%d",f->report_flag&~COB_REPORT_EMITTED, - f->report_line, f->step_count,f->next_group_line); - output_local(",%d,0",f->report_flag&~COB_REPORT_EMITTED); - output_local ("};\n"); -} - -static int sum_prv = 0; -static int sum_nxt = 0; -static int r_ctl_id = 0; - -/* Find data field for given internal SUM counter */ -struct cb_field * -get_sum_data_field (struct cb_report *r, struct cb_field *f) -{ - int k; - for (k=0; k < r->num_sums; k++) { - if (r->sums[k*2 + 0] == f) { - return r->sums[k*2 + 1]; - } - if (r->sums[k*2 + 1] == f) { - return r->sums[k*2 + 0]; - } - } - return NULL; -} - -/* - * Generate list of SUM counters - */ -static void -output_report_sum_counters (const int top, struct cb_field *f, struct cb_report *r) -{ - struct cb_field *n, *c, *p, *z; - cb_tree l, x; - char fname[64]; - int rsid, rsseq, rsprv; - int ctl_foot, sub_ttl, cross_foot; - - n = f->sister; - c = f->children; - if (n - && n->storage != CB_STORAGE_REPORT) - n = NULL; - if (n - && n->report != r) - n = NULL; - if (c - && c->storage != CB_STORAGE_REPORT) - c = NULL; - if (n) { - output_report_sum_counters(top, n, r); - } - if (c) { - output_report_sum_counters(0, c, r); - } - if (!top) { - c = NULL; - } - - if (f->report_sum_list == NULL) - return; - if (f->report_flag & COB_REPORT_SUM_EMITTED) /* Was this already emitted? */ - return; - f->report_flag |= COB_REPORT_SUM_EMITTED; - - if(strncmp(f->name,"FILLER ",7) == 0) { - if(f->report_flag & COB_REPORT_PAGE_HEADING) { - strcpy(fname,"PAGE HEADING"); - } else if(f->report_flag & COB_REPORT_PAGE_FOOTING) { - strcpy(fname,"PAGE HEADING"); - } else if(f->report_flag & COB_REPORT_CONTROL_HEADING) { - strcpy(fname,"CONTROL HEADING"); - } else if(f->report_flag & COB_REPORT_CONTROL_FOOTING) { - strcpy(fname,"CONTROL FOOTING"); - } else if(f->report_flag & COB_REPORT_CONTROL_FOOTING_FINAL) { - strcpy(fname,"CONTROL FOOTING FINAL"); - } else if(f->report_flag & COB_REPORT_CONTROL_HEADING_FINAL) { - strcpy(fname,"CONTROL HEADING FINAL"); - } else { - strcpy(fname,""); - } - if(f->report_control) { - sprintf(&fname[strlen(fname)]," %s",cb_code_field(f->report_control)->name); - } - } else { - sprintf(fname,"%s",f->name); - } - output_local("\n/* %s SUM ",fname); - for (l = f->report_sum_list; l; l = CB_CHAIN (l)) { - x = CB_VALUE (l); - output_local("%s ",cb_code_field(x)->name); - } - if(f->report_flag & COB_REPORT_RESET_FINAL) - output_local(" RESET ON FINAL "); - if(f->report_reset) { - x = CB_VALUE(f->report_reset); - output_local(" RESET ON %s ",cb_code_field(x)->name); - } - output_local("*/\n"); - ctl_foot = sub_ttl = cross_foot = 0; - rsid = f->id; - rsseq = rsprv = 0; - for (l = f->report_sum_list; l; l = CB_CHAIN (l)) { - x = CB_VALUE (l); - output_local("static cob_report_sum %s%d_%d = {",CB_PREFIX_REPORT_SUM,rsid,++rsseq); - if(rsprv) { - output_local("&%s%d_%d,",CB_PREFIX_REPORT_SUM,rsid,rsprv); - } else { - output_local("NULL,"); - } - z = get_sum_data_field(r, cb_code_field(x)); - if (z) { - output_local("&%s%d",CB_PREFIX_FIELD, z->id); - sub_ttl = 1; - } else { - output_local("&%s%d",CB_PREFIX_FIELD, cb_code_field(x)->id); - } - output_local ("};"); - output_local ("\n"); - rsprv = rsseq; - } - output_local ("static cob_report_sum_ctr %s%d = {", CB_PREFIX_REPORT_SUM_CTR,++sum_nxt); - if (sum_prv) { - output_local("&%s%d,",CB_PREFIX_REPORT_SUM_CTR,sum_prv); - } else { - output_local("NULL,"); - } - output_local ("\"%s\",",fname); - output_local("&%s%d_%d,",CB_PREFIX_REPORT_SUM,rsid,rsprv); - if (f->report_sum_counter) { - output_local("&%s%d,",CB_PREFIX_FIELD, cb_code_field(f->report_sum_counter)->id); - z = get_sum_data_field(r, cb_code_field(f->report_sum_counter)); - } else { - output_local("NULL,"); - z = NULL; - } - if (z) { - output_local("&%s%d,",CB_PREFIX_FIELD, z->id); - } else { - output_local("NULL,"); - } - for (p = f; p; p = p->parent) { - if (p->report_control) { - output_local("&%s%d_%d,", - CB_PREFIX_REPORT_CONTROL, r_ctl_id, cb_code_field(p->report_control)->id); - break; - } else if(p->report_flag & COB_REPORT_CONTROL_FOOTING_FINAL) { - ctl_foot = 1; - output_local("NULL,"); - break; - } - } - if (p == NULL) { - output_local("NULL, /* No CONTROL field */"); - } - if (f && f->report_flag & COB_REPORT_RESET_FINAL) { - output_local("1"); - } else { - output_local("0"); - } - output_local(",%d,%d,%d",ctl_foot,sub_ttl,cross_foot); - output_local ("};\n"); - sum_prv = sum_nxt; -} - -static void -output_report_definition (struct cb_report *p, struct cb_report *n) -{ - int i; - struct cb_field *s = NULL; - cb_tree l; - - output_local("\n"); - for(i= p->num_lines-1; i >= 0; i--) { - if(p->line_ids[i]->level == 1) - output_report_define_lines(1,p->line_ids[i], p); - } - output_local ("\n"); - if(p->controls) { - for (l = p->controls; l; l = CB_CHAIN (l)) { - s = cb_code_field(l); - s->count++; - } - output_report_control(p,++r_ctl_id,p->controls,CB_CHAIN(p->controls)); - output_local ("\n"); - } - sum_prv = 0; - for (i= p->num_lines-1; i >= 0; i--) { - if (p->line_ids[i]->level == 1) { - output_report_sum_counters (1, p->line_ids[i], p); - } - } - - output_local ("\n"); - output_local ("static cob_report %s%s = {\n", CB_PREFIX_REPORT,p->cname); - output_local ("\t\t\"%s\",\n\t\t",p->name); - if(n != NULL) { - output_local ("&%s%s,", CB_PREFIX_REPORT, n->cname); /* next report */ - } else { - output_local ("NULL,"); - } - output_local ("NULL,"); /* report file (address set at run-time) */ - if (p->page_counter) { - output_param (p->page_counter, 0); - output_local (","); - } else { - output_local("NULL,"); - } - if (p->line_counter) { - output_param (p->line_counter, 0); - output_local (","); - } else { - output_local("NULL,"); - } - if(p->num_lines > 0) { - output_local ("&%s%d,",CB_PREFIX_REPORT_LINE,p->line_ids[0]->id); - } else { - output_local("NULL,"); - } - if(p->controls) { - s = cb_code_field(p->controls); - output_local ("&%s%d_%d,",CB_PREFIX_REPORT_CONTROL,r_ctl_id,s->id); - } else { - output_local("NULL,"); - } - if(sum_prv > 0) { - output_local("&%s%d,",CB_PREFIX_REPORT_SUM_CTR,sum_prv); - } else { - output_local("NULL,"); - } - output_local ("\n"); - output_local ("\t\t%d,%d,%d,%d,%d,%d,%d,\n", - p->lines,p->columns,p->heading, - p->first_detail,p->last_control, - p->last_detail,p->footing); - output_local ("\t\t0,0,0,0,0,"); - output_local ("%d,%d\n",p->control_final,p->global); - output_local ("};\n"); -} - -static void -output_report_list (cb_tree l, cb_tree n) -{ - cb_tree nl; - struct cb_report *rep, *nxrep; - - if (CB_LIST_P (l)) - rep = CB_REPORT_PTR (CB_VALUE(l)); - else - rep = CB_REPORT_PTR (l); - if(n != NULL) { - if (CB_LIST_P (l)) - nxrep = CB_REPORT_PTR (CB_VALUE(n)); - else - nxrep = CB_REPORT_PTR (l); - } else { - nxrep = NULL; - } - nl = CB_CHAIN (l); - output_emit_field(rep->line_counter,NULL); - output_emit_field(rep->page_counter,NULL); - if(nl) { - output_report_list(nl, CB_CHAIN (nl)); - } - output_report_definition (rep, nxrep); -} - -static void -output_report_init (struct cb_report *rep) -{ - output_prefix (); - output ("cob_set_report (&%s%s, ", CB_PREFIX_REPORT,rep->cname); - - if (rep->file) { - output ("%s%s", CB_PREFIX_FILE, rep->file->cname); - } else { - output ("NULL"); - } - output (");"); - output_newline (); - -} - - -/* Alphabet-name */ - -static int -literal_value (cb_tree x) -{ - if (x == cb_space) { - return ' '; - } else if (x == cb_zero) { - return '0'; - } else if (x == cb_quote) { - return cb_flag_apostrophe ? '\'' : '"'; - } else if (x == cb_norm_low) { - return 0; - } else if (x == cb_norm_high) { - return 255; - } else if (x == cb_null) { - return 0; - } else if (CB_TREE_CLASS (x) == CB_CLASS_NUMERIC) { - return cb_get_int (x) - 1; - } else { - return CB_LITERAL (x)->data[0]; - } -} - -static void -output_alphabet_name_definition (struct cb_alphabet_name *p) -{ - int i; - - if (p->alphabet_type != CB_ALPHABET_CUSTOM) { - return; - } - - /* Output the table */ - output_local ("static const unsigned char %s%s[256] = {\n", - CB_PREFIX_SEQUENCE, p->cname); - for (i = 0; i < 256; i++) { - if (i == 255) { - output_local (" %d", p->values[i]); - } else { - output_local (" %d,", p->values[i]); - } - if (i % 16 == 15) { - output_local ("\n"); - } - } - output_local ("};\n"); - i = lookup_attr (COB_TYPE_ALPHANUMERIC, 0, 0, 0, NULL, 0); - output_local ("static cob_field %s%s = { 256, (cob_u8_ptr)%s%s, &%s%d };\n", - CB_PREFIX_FIELD, p->cname, - CB_PREFIX_SEQUENCE, p->cname, - CB_PREFIX_ATTR, i); - output_local ("\n"); -} - -/* Class definition */ - -static void -output_class_name_definition (struct cb_class_name *p) -{ - cb_tree l; - cb_tree x; - unsigned char *data; - size_t i; - size_t size; - int n; - int lower; - int upper; - int vals[256]; - - output_line ("static int"); - output_line ("%s (cob_field *f)", p->cname); - output_block_open (); - output_line ("size_t\ti;"); - output_newline (); - output_line ("for (i = 0; i < f->size; i++)"); - output_block_open (); - output_line ("switch (f->data[i]) {"); - memset (vals, 0, sizeof(vals)); - for (l = p->list; l; l = CB_CHAIN (l)) { - x = CB_VALUE (l); - if (CB_PAIR_P (x)) { - lower = literal_value (CB_PAIR_X (x)); - upper = literal_value (CB_PAIR_Y (x)); - for (n = lower; n <= upper; ++n) { - vals[n] = 1; - } - } else { - if (CB_NUMERIC_LITERAL_P (x)) { - vals[literal_value (x)] = 1; - } else if (x == cb_space) { - vals[' '] = 1; - } else if (x == cb_zero) { - vals['0'] = 1; - } else if (x == cb_quote) { - if (cb_flag_apostrophe) { - vals['\''] = 1; - } else { - vals['"'] = 1; - } - } else if (x == cb_null) { - vals[0] = 1; - } else if (x == cb_low) { - vals[0] = 1; - } else if (x == cb_high) { - vals[255] = 1; - } else { - size = CB_LITERAL (x)->size; - data = CB_LITERAL (x)->data; - for (i = 0; i < size; i++) { - vals[data[i]] = 1; - } - } - } - } - for (i = 0; i < 256; ++i) { - if (vals[i]) { - output_line ("case %d:", (int)i); - } - } - output_line (" break;"); - output_line ("default:"); - output_line (" return 0;"); - output_line ("}"); - output_block_close (); - output_line ("return 1;"); - output_block_close (); - output_newline (); -} - -static void -output_class_names (struct cb_program *prog) -{ - cb_tree l; - - if (!prog->nested_level && prog->class_name_list) { - output_line ("/* Class names */"); - for (l = prog->class_name_list; l; l = CB_CHAIN (l)) { - output_class_name_definition (CB_CLASS_NAME (CB_VALUE (l))); - } - } -} - -static void -output_initial_values (struct cb_field *f) -{ - struct cb_field *p; - cb_tree x; - - for (p = f; p; p = p->sister) { - x = cb_build_field_reference (p, NULL); - if (p->flag_item_based) { - continue; - } - /* For special registers */ - if (p->flag_no_init && !p->count) { - continue; - } - output_stmt (cb_build_initialize (x, cb_true, NULL, 1, 0, 0)); - } -} - -/* Code for displaying hex dumps - Ron Norman */ -static int field_subscript[12] = {0,0,0,0,0,0,0,0,0,0,0,0}; -static int size_subscript[12] = {0,0,0,0,0,0,0,0,0,0,0,0}; - -static void -output_field_display (struct cb_field *f, int offset, int idx) -{ - struct cb_field *p; - cb_tree x; - int i, svlocal; - char *fname = (char*)f->name; - - if (strncmp(fname,"FILLER ",7) == 0) - fname = (char*)"FILLER"; - svlocal = f->flag_local; - f->flag_local = 0; - x = cb_build_field_reference (f, NULL); - output_prefix (); - output ("cob_dump_field (%2d, \"%s\", ", f->level, fname); - if (f->flag_local) { - output ("COB_SET_DATA (%s%d, ", - CB_PREFIX_FIELD, f->id); - output_data (x); - output (")"); - } else - if (f->count > 0) { - output_param (x, 0); - } else { - output ("COB_SET_FLD(%s, ", "f0"); - output_size (x); - output (", "); - output_data (x); - output (", "); - output_attr (x); - output (")"); - } - output (", %d, %d", offset, idx); - if (idx > 0) { - p = f->parent; - for (i=0; i < idx; i++) { - if (field_subscript[i] < 0) { - output (", i_%d, ",-field_subscript[i]); - if (cb_flag_odoslide - && p - && p->depending) { - output_size (cb_build_field_reference (p, NULL)); - } else { - output ("%d",size_subscript[i]); - } - } else { - output (", %d, 0",field_subscript[i]); - } - if (p) { - p = p->parent; - } - } - } - output (");"); - output_newline (); - f->flag_local = svlocal; -} - -static void -output_display_fields (struct cb_field *f, int offset, int idx) -{ - struct cb_field *p; - int adjust,i; - - for (p = f; p; p = p->sister) { - if (p->redefines - || (p->level == 0 && p->file == NULL) - || p->level == 66 - || p->level == 78 - || p->level == 88) { - continue; - } - /* For special registers */ - if (p->flag_no_init && !p->count) { - continue; - } - if (p->children) { - output_field_display (p, offset, idx); - if (p->occurs_max > 2) { - idx++; - if (p->depending) { - output_line ("{ int i_%d,m_%d;",idx,idx); - output_indent_level += 2; - output_prefix (); - output ("m_%d = ",idx); - output_integer (p->depending); - output (";"); - output_newline (); - output_line ("for (i_%d=0; i_%d < m_%d; i_%d++) {",idx,idx,idx,idx); - } else { - output_line ("{ int i_%d;",idx); - output_indent_level += 2; - output_line ("for (i_%d=0; i_%d < %d; i_%d++) {",idx,idx,p->occurs_max,idx); - } - output_indent_level += 2; - field_subscript[idx-1] = -idx; - size_subscript[idx-1] = p->size; - output_display_fields (p->children, offset, idx); - output_indent_level -= 2; - output_line ("}"); - output_indent_level -= 2; - output_line ("}"); - idx--; - } else if (p->occurs_max > 1) { - adjust = 0; - for (i=1; i <= p->occurs_max; i++) { - field_subscript[idx] = i; - output_display_fields (p->children, offset+adjust, idx+1); - adjust += p->size; - } - } else { - output_display_fields (p->children, offset, idx); - } - } else { - if (p->occurs_max > 2) { - idx++; - if (p->depending) { - output_line ("{ int i_%d,m_%d;",idx,idx); - output_indent_level += 2; - output_prefix (); - output ("m_%d = ",idx); - output_integer (p->depending); - output (";"); - output_newline (); - output_line ("for (i_%d=0; i_%d < m_%d; i_%d++) {",idx,idx,idx,idx); - } else { - output_line ("{ int i_%d;",idx); - output_indent_level += 2; - output_line ("for (i_%d=0; i_%d < %d; i_%d++) {",idx,idx,p->occurs_max,idx); - } - output_indent_level += 2; - field_subscript[idx-1] = -idx; - size_subscript[idx-1] = p->size; - output_field_display (p, offset, idx); - output_indent_level -= 2; - output_line ("}"); - output_indent_level -= 2; - output_line ("}"); - idx--; - } else if (p->occurs_max > 1) { - adjust = 0; - for (i=1; i <= p->occurs_max; i++) { - field_subscript[idx] = i; - output_field_display (p, offset+adjust, idx+1); - adjust += p->size; - } - } else { - output_field_display (p, offset, idx); - } - } - } -} - -static void -output_error_handler (struct cb_program *prog) -{ - struct handler_struct *hstr; - size_t seen; - unsigned int parameter_count, pcounter, hcounter; - - recent_prog = prog; - output_newline (); - seen = 0; - for (hcounter = COB_OPEN_INPUT; hcounter <= COB_OPEN_EXTEND; hcounter++) { - if (prog->global_handler[hcounter].handler_label) { - seen = 1; - break; - } - } - skip_line_num = 0; - output_stmt (cb_standard_error_handler); - skip_line_num = 1; - output_newline (); - if (seen) { - output_line ("switch (cob_glob_ptr->cob_error_file->last_open_mode)"); - output_block_open (); - for (hcounter = COB_OPEN_INPUT; hcounter <= COB_OPEN_EXTEND; hcounter++) { - hstr = &prog->global_handler[hcounter]; - if (hstr->handler_label) { - output_line ("case %u:", hcounter); - output_block_open (); - if (prog == hstr->handler_prog) { - output_perform_call (hstr->handler_label, - hstr->handler_label); - } else { - output_prefix (); - if (hstr->handler_prog->nested_level) { - output ("%s_%d_ (%d", - hstr->handler_prog->program_id, - hstr->handler_prog->toplev_count, - hstr->handler_label->id); - } else { - output ("%s_ (%d", - hstr->handler_prog->program_id, - hstr->handler_label->id); - } - parameter_count = cb_list_length (hstr->handler_prog->parameter_list); - for (pcounter = 0; pcounter < parameter_count; pcounter++) { - output (", NULL"); - } - output (");"); - output_newline (); - } - output_line ("break;"); - output_block_close (); - } - } - output_line ("default:"); - output_block_open (); - } - output_line ("if (!(cob_glob_ptr->cob_error_file->flag_select_features & COB_SELECT_FILE_STATUS)) {"); - output_line ("\tcob_fatal_error (COB_FERROR_FILE);"); - if (cb_standard_error_handler) { /* Emit 'goto' to avoid unreferenced label C warning */ - output_line (" goto %s%d;", CB_PREFIX_LABEL, - CB_LABEL (cb_standard_error_handler)->id); - } - output_line ("}"); - if (seen) { - output_line ("break;"); - output_block_close (); - output_block_close (); - } - output_perform_exit (CB_LABEL (cb_standard_error_handler)); - output_newline (); - output_line ("/* Fatal error if reached */"); - output_line ("cob_fatal_error (COB_FERROR_CODEGEN);"); - output_newline (); -} - -static void -output_module_register_init (cb_tree reg, const char *name) -{ - if (!reg) { - return; - } - - /* LCOV_EXCL_START */ - if (!CB_REF_OR_FIELD_P (reg)) { - cobc_err_msg (_("unexpected tree tag: %d"), (int)CB_TREE_TAG (reg)); - COBC_ABORT (); - } - /* LCOV_EXCL_STOP */ - - if (CB_REFERENCE_P (reg)) { - reg = cb_ref (reg); - if (CB_FIELD_P (reg) && !CB_FIELD (reg)->count) { - return; - } - } else { - struct cb_field *field = CB_FIELD (reg); - if (!field->count) { - return; - } - reg = cb_build_field_reference (field, NULL); - } - output_prefix (); - output ("module->%s = ", name); - output_param (reg, -1); - output (";"); - output_newline (); -} - -/* outputs function for setting variables in the module structure - that reference static values */ -static void -output_module_init_function (struct cb_program *prog) -{ - output_indent_level = 0; - if (!prog->nested_level) { - output_line ("/* Initialize module structure for %s */", - prog->orig_program_id); - output_line ("static void %s_module_init (cob_module *module)", - prog->program_id); - } else { - output_line ("/* Initialize module structure for %s (nested %d) */", - prog->program_id, prog->toplev_count); - output_line ("static void %s_%d_module_init (cob_module *module)", - prog->program_id, prog->toplev_count); - } - output_block_open (); - -#if 0 /* Module comments, maybe extend and only include if - explicit requested via flag (auto-active for -c + -g)? */ - output_line ("/* Next pointer, Parameter list pointer, Module name, */"); - output_line ("/* Module formatted date, Module source, */"); - output_line ("/* Module entry, Module cancel, */"); - output_line ("/* Collating, CRT status, CURSOR, */"); - output_line ("/* Module reference count, Module path, Module active, */"); - output_line ("/* Module date, Module time, */"); - output_line ("/* Module type, Number of USING parameters, Return type */"); - output_line ("/* Current parameter count */"); - output_line ("/* Display sign, Decimal point, Currency symbol, */"); - output_line ("/* Numeric separator, File name mapping, Binary truncate, */"); - output_line ("/* Alternate numeric display, Host sign, No physical cancel */"); - output_line ("/* Flag main program, Fold call, Exit after CALL */"); -#endif - - recent_prog = prog; - /* Do not initialize next pointer, parameter list pointer + count */ - output_line ("module->module_name = \"%s\";", prog->orig_program_id); - output_line ("module->module_formatted_date = COB_MODULE_FORMATTED_DATE;"); - output_line ("module->module_source = COB_SOURCE_FILE;"); - if (!prog->nested_level) { - output_line ("module->module_entry.funcptr = (void *(*)())%s;", - prog->program_id); - if (prog->prog_type == COB_MODULE_TYPE_FUNCTION) { - output_line ("module->module_cancel.funcptr = NULL;"); - } else { - output_line ("module->module_cancel.funcptr = (void *(*)())%s_;", - prog->program_id); - } - } else { - output_line ("module->module_entry.funcvoid = NULL;"); - output_line ("module->module_cancel.funcvoid = NULL;"); - } - - if (!cobc_flag_main && non_nested_count > 1) { - output_line ("module->module_ref_count = &cob_reference_count;"); - } else { - output_line ("module->module_ref_count = NULL;"); - } - output_line ("module->module_path = &cob_module_path;"); - output_line ("module->module_active = 0;"); - output_line ("module->module_date = COB_MODULE_DATE;"); - output_line ("module->module_time = COB_MODULE_TIME;"); - output_line ("module->module_type = %u;", prog->prog_type); - output_line ("module->module_param_cnt = %u;", prog->num_proc_params); -#if 0 /* currently not checked anywhere, may use for void or more general type */ - output_line ("module->module_returning = %u;", prog->flag_void ? 0 : 1); -#endif - output_line ("module->ebcdic_sign = %d;", cb_ebcdic_sign); - output_line ("module->decimal_point = '%c';", prog->decimal_point); - output_line ("module->currency_symbol = '%c';", prog->currency_symbol); - output_line ("module->numeric_separator = '%c';", prog->numeric_separator); - output_line ("module->flag_filename_mapping = %d;", cb_filename_mapping); - output_line ("module->flag_binary_truncate = %d;", cb_binary_truncate); - output_line ("module->flag_pretty_display = %d;", cb_pretty_display); - output_line ("module->flag_host_sign = %d;", cb_host_sign); - output_line ("module->flag_no_phys_canc = %d;", no_physical_cancel); - output_line ("module->flag_main = %d;", cobc_flag_main); - output_line ("module->flag_fold_call = %d;", cb_fold_call); - output_line ("module->flag_exit_program = 0;"); - { - int opt = 0; - if (cb_flag_traceall) { - opt |= COB_MODULE_TRACE; - opt |= COB_MODULE_TRACEALL; - } else - if (cb_flag_trace) { - opt |= COB_MODULE_TRACE; - } - output_line ("module->flag_debug_trace = %d;", opt); - } - output_line ("module->flag_dump_ready = %u;", cb_flag_dump ? 1 : 0); - output_line ("module->module_stmt = 0;"); - if (source_cache) { - output_line ("module->module_sources = %ssource_files;", - CB_PREFIX_STRING); - } else { - output_line ("module->module_sources = NULL;"); - } - - output_block_close (); - output_newline (); -} - -/* outputs code for setting variables in the module structure - that reference non-static values */ -static void -output_module_init_non_static (struct cb_program *prog) -{ - output_module_register_init (prog->collating_sequence, "collating_sequence"); - if (prog->crt_status && cb_code_field (prog->crt_status)->count) { - output_prefix (); - output ("module->crt_status = "); - output_param (cb_ref (prog->crt_status), -1); - output (";"); - output_newline (); - } else { - output_line ("module->crt_status = NULL;"); - } - - /* TODO for later: Check for possible implementation without adding a multitude - of module local registers to cob_module structure */ - output_module_register_init (prog->cursor_pos, "cursor_pos"); - - output_module_register_init (prog->xml_code, "xml_code"); - output_module_register_init (prog->xml_event, "xml_event"); - output_module_register_init (prog->xml_information, "xml_information"); - output_module_register_init (prog->xml_namespace, "xml_namespace"); - output_module_register_init (prog->xml_namespace_prefix, "xml_namespace_prefix"); - output_module_register_init (prog->xml_nnamespace, "xml_nnamespace"); - output_module_register_init (prog->xml_nnamespace_prefix, "xml_nnamespace_prefix"); - output_module_register_init (prog->xml_ntext, "xml_ntext"); - output_module_register_init (prog->xml_text, "xml_text"); - - output_module_register_init (prog->json_code, "json_code"); - output_module_register_init (prog->json_status, "json_status"); -} - -static void -output_module_init (struct cb_program *prog) -{ - if (!prog->nested_level) { - output_line ("%s_module_init (module);", - prog->program_id); - } else { - output_line ("%s_%d_module_init (module);", - prog->program_id, prog->toplev_count); - } - output_newline (); - output_module_init_non_static (prog); - output_newline (); -} - -/* Common setup logic for pickup_param routines */ -static struct cb_field * -setup_param (cb_tree l, int *is_value_parm, int *is_any_numeric) -{ - FILE *savetarget; - struct cb_field *f; - - f = cb_code_field (CB_VALUE (l)); - if (CB_PURPOSE (l) - && (CB_PURPOSE_INT (l) == CB_CALL_BY_VALUE - || CB_PURPOSE_INT (l) == CB_CALL_BY_CONTENT)) { - *is_value_parm = 1; - } else { - *is_value_parm = 0; - } - if (f->flag_any_numeric - || (f->pic && f->pic->category == CB_CATEGORY_NUMERIC)) { - *is_any_numeric = 1; - } else { - *is_any_numeric = 0; - } - - /* Force PROCEDURE/ENTRY USING fields to cache */ - if (!f->flag_field) { - savetarget = output_target; - output_target = NULL; - output_param (CB_VALUE (l), 0); - output_target = savetarget; - } - return f; -} - -/* Set given parameter address to NULL */ -static void -setnull_param (cb_tree l) -{ - struct cb_field *f; - f = cb_code_field (CB_VALUE (l)); - - output_line ("%s%d.data = NULL;", CB_PREFIX_FIELD, f->id); - return; -} - -/* Pickup parameter knowing the caller is COBOL */ -static void -pickup_cob_param (cb_tree l, int i) -{ - char wrk[64]; - cb_tree x; - struct cb_field *f; - int is_value_parm, is_any_numeric; - - f = setup_param (l, &is_value_parm, &is_any_numeric); - - x = cb_build_field_reference (f, NULL); - - f->flag_data_set = 0; - if (is_value_parm) { - if (f->flag_any_length) { - sprintf(wrk,"module->next->cob_procedure_params[%d]->size",i); - } else { - strcpy(wrk,"0"); - } - output_line ("if (cob_glob_ptr->cob_call_params > %d) { /* BY VALUE %s */", i, f->name); - output_line (" cob_alloc_move(%s[%d], &%s%d, %s);", - "module->next->cob_procedure_params", i, - CB_PREFIX_FIELD, f->id, wrk); - if (!cb_sticky_linkage) { - output_line ("} else {"); - output_line (" %s%d.data = NULL;", CB_PREFIX_FIELD, f->id); - } - output_line ("}"); - } else - if (f->flag_any_length) { - output_line ("if (cob_glob_ptr->cob_call_params > %d", i); - output_line ("&& module->next"); - if (is_any_numeric) { - output_line ("&& %s[%d]) { /* ANY NUMERIC %s */", - "module->next->cob_procedure_params", i, f->name); - output_indent_level += 2; - /* Copy complete structure */ - output_line (" %s%d = *(%s[%d]);", - CB_PREFIX_FIELD, f->id, - "module->next->cob_procedure_params", i); - } else { - output_line ("&& %s[%d]) { /* BY REFERENCE %s */", - "module->next->cob_procedure_params", i, f->name); - output_indent_level += 2; - /* Copy size */ - output_line ("%s%d.size = %s[%d]->size;", - CB_PREFIX_FIELD, f->id, - "module->next->cob_procedure_params", i); - /* Copy data address */ - output_line ("%s%d.data = %s[%d]->data;", - CB_PREFIX_FIELD, f->id, - "module->next->cob_procedure_params", i); - } - if (!cb_sticky_linkage) { - output_indent_level -= 2; - output_line ("} else {"); - output_indent_level += 2; - output_line ("%s%d.data = NULL;", CB_PREFIX_FIELD, f->id); - } - output_indent_level -= 2; - output_line ("}"); - } else { - output_line ("if (cob_glob_ptr->cob_call_params > %d)", i); - output_indent_level += 2; - output_prefix (); - output ("%s%d.data = (cob_u8_t*)", CB_PREFIX_FIELD, f->id); - output_data (x); - output ("; /* %s */", f->name); - output_newline (); - output_indent_level -= 2; - } - f->flag_data_set = 1; -} - -/* Pickup parameter size for ANY LENGTH */ -static void -pickup_any_length (cb_tree l, int i) -{ - struct cb_field *f; - int is_value_parm, is_any_numeric; - - f = setup_param (l, &is_value_parm, &is_any_numeric); - - if (f->flag_any_length) { - f->flag_data_set = 0; - output_line ("if (module->module_num_params > %d && " - "module->next && " - "module->next->cob_procedure_params[%d])", - i, i); - if (f->flag_any_numeric) { /* Copy complete structure */ - output_line (" %s%d = *(module->next->cob_procedure_params[%d]);", - CB_PREFIX_FIELD, f->id, i); - } else { /* Copy size */ - output_line (" %s%d.size = module->next->cob_procedure_params[%d]->size;", - CB_PREFIX_FIELD, f->id, i); - } - output_prefix (); - output ("%s%d.data = ", CB_PREFIX_FIELD, f->id); - output_data (CB_VALUE (l)); - output (";"); - output_newline (); - f->flag_data_set = 1; - } -} - -/* Pickup parameter knowing the caller is C */ -static void -pickup_c_param (cb_tree l, int i, int is_enter) -{ - char wrk[64]; - cb_tree x; - struct cb_field *f; - int is_value_parm, is_any_numeric; - - f = setup_param (l, &is_value_parm, &is_any_numeric); - - x = cb_build_field_reference (f, NULL); - - f->flag_data_set = 0; - if (is_value_parm) { - if (f->flag_any_length) { - sprintf(wrk,"module->next->cob_procedure_params[%d]->size",i); - } else { - strcpy(wrk,"0"); - } - output_prefix (); - output ("%s%d.data = (cob_u8_t*)", CB_PREFIX_FIELD, f->id); - output_data (x); - output (";"); - output_newline (); - if (f->flag_any_length) { - output_line ("if (%s%d.data != NULL)",CB_PREFIX_FIELD, f->id); - output_line (" %s%d.size = strlen((char*)%s%d.data);", - CB_PREFIX_FIELD, f->id, - CB_PREFIX_FIELD, f->id); - } - } else - if (f->flag_any_length) { - output_prefix (); - output ("%s%d.data = (cob_u8_t*)", CB_PREFIX_FIELD, f->id); - output_data (x); - output (";"); - output_newline (); - if (is_any_numeric) { - output_line ("if (%s%d.data != NULL) {", CB_PREFIX_FIELD, f->id); - output_indent_level += 2; - output_line ("%s%d.size = strlen((char*)%s%d.data);", - CB_PREFIX_FIELD, f->id, - CB_PREFIX_FIELD, f->id); - output_line ("if (%s%d.size > 0 && %s%d.size < 20)", - CB_PREFIX_FIELD, f->id,CB_PREFIX_FIELD, f->id); - output_line (" %s%d.attr = cob_alloc_attr(COB_TYPE_NUMERIC_DISPLAY,%s%d.size,0,0);", - CB_PREFIX_FIELD, f->id, CB_PREFIX_FIELD, f->id); - output_indent_level -= 2; - output_line ("}"); - } else { - output_line ("if (%s%d.data != NULL)", CB_PREFIX_FIELD, f->id); - output_line (" %s%d.size = strlen((char*)%s%d.data);", - CB_PREFIX_FIELD, f->id, - CB_PREFIX_FIELD, f->id); - } - } else { - if (is_enter) { - if(i == 0) { - output_line ("if (cob_glob_ptr->cob_call_params >= 0)"); - output_indent_level += 2; - } else if(i > 0) { - output_line ("if (cob_glob_ptr->cob_call_params == 0"); - output_line ("|| cob_glob_ptr->cob_call_params > %d)", i); - output_indent_level += 2; - } - } - output_prefix (); - output ("%s%d.data = (cob_u8_t*)", CB_PREFIX_FIELD, f->id); - output_data (x); - output ("; /* %s */", f->name); - output_newline (); - if (is_enter) { - if(i >= 0) - output_indent_level -= 2; - } - } - f->flag_data_set = 1; -} - -static void -pickup_param (cb_tree l, int i) -{ - cb_tree x; - struct cb_field *f; - int is_value_parm, is_any_numeric; - - f = setup_param (l, &is_value_parm, &is_any_numeric); - - if (is_value_parm - || f->flag_any_length) { - output_line ("if (cob_glob_ptr->cob_call_from_c) {"); - output_indent_level += 2; - pickup_c_param (l, i, 1); - output_indent_level -= 2; - output_line ("} else {"); - output_indent_level += 2; - pickup_cob_param (l, i); - output_indent_level -= 2; - output_line ("}"); - } else { - x = cb_build_field_reference (f, NULL); - f->flag_data_set = 0; - output_prefix (); - output ("%s%d.data = (cob_u8_t*)", CB_PREFIX_FIELD, f->id); - output_data (x); - output ("; /* %s */", f->name); - output_newline (); - f->flag_data_set = 1; - } -} - -static void -output_internal_function (struct cb_program *prog, cb_tree parameter_list) -{ - cb_tree l; - cb_tree l2; - cb_tree using_list; - struct cb_field *f; - struct cb_program *next_prog; - struct cb_file *fl; - struct cb_report *rep; - char *p; - struct label_list *pl; - struct cb_alter_id *cpl; - struct call_list *clp; - struct base_list *bl; - struct literal_list *m; - const char *s; - int i, j; - cob_u32_t inc; - unsigned int name_hash; - int parmnum, nested_dump; - int seen; - int anyseen; - - recent_prog = prog; - /* Program function */ - if (prog->prog_type == COB_MODULE_TYPE_FUNCTION) { - output_line ("static cob_field *"); - output ("%s_ (const int entry", - prog->program_id); - } else if (!prog->nested_level) { - output_line ("static int"); - output ("%s_ (const int entry", prog->program_id); - } else { - output_line ("static int"); - output ("%s_%d_ (const int entry", - prog->program_id, prog->toplev_count); - } - parmnum = 0; - if (!prog->flag_chained) { - for (l = parameter_list; l; l = CB_CHAIN (l)) { - if (l == parameter_list) { - output (", "); - } - if (parmnum && !(parmnum % 2)) { - output_newline (); - output ("\t"); - } - output ("cob_u8_t *%s%d", - CB_PREFIX_BASE, cb_code_field (CB_VALUE (l))->id); - if (CB_CHAIN (l)) { - output (", "); - } - parmnum++; - } - } - output (")"); - output_newline (); - output_block_open (); - - /* Program local variables */ - output_line ("/* Program local variables */"); - output_line ("#include \"%s\"", prog->local_include->local_include_name); - output_newline (); - - /* Alphabet-names */ - if (prog->alphabet_name_list) { - for (l = prog->alphabet_name_list; l; l = CB_CHAIN (l)) { - output_alphabet_name_definition (CB_ALPHABET_NAME (CB_VALUE (l))); - } - } - - output_line ("/* Entry point name_hash values */"); - output_line ("static const unsigned int %sname_hash [] = {",CB_PREFIX_STRING); - if (cb_list_length (prog->entry_list) > 1) { - for (i = 0, l = prog->entry_list; l; l = CB_CHAIN (l)) { - name_hash = cob_get_name_hash (CB_LABEL (CB_PURPOSE (l))->name); - output_line ("\t0x%X,\t/* %d: %s */", - name_hash, i, CB_LABEL (CB_PURPOSE (l))->name); - i++; - } - } else { - name_hash = cob_get_name_hash (prog->orig_program_id); - output_line ("\t0x%X,\t/* %s */", - name_hash, prog->orig_program_id); - } - output_line ("0};"); - - /* Module initialization indicator */ - - output_local ("/* Module initialization indicator */\n"); - output_local ("static unsigned int\tinitialized = 0;\n\n"); - if (prog->flag_recursive) { - output_local ("/* Module structure pointer for recursive */\n"); - output_local ("cob_module\t\t*module = NULL;\n\n"); - } else { - output_local ("/* Module structure pointer */\n"); - output_local ("static cob_module\t*module = NULL;\n\n"); - } - - output_local ("/* Global variable pointer */\n"); - output_local ("cob_global\t\t*cob_glob_ptr;\n\n"); - - /* Decimal structures */ - if (prog->decimal_index_max) { - output_local ("/* Decimal structures */\n"); - for (i = 0; i < prog->decimal_index_max; i++) { - output_local ("cob_decimal\t*d%d = NULL;\n", i); - } - output_local ("\n"); - } - - /* External items */ - seen = 0; - for (f = prog->working_storage; f; f = f->sister) { - if (f->flag_external) { - if (f->flag_is_global) { - bl = cobc_parse_malloc (sizeof (struct base_list)); - bl->f = f; - bl->curr_prog = excp_current_program_id; - bl->next = globext_cache; - globext_cache = bl; - continue; - } - if (!seen) { - seen = 1; - output_local ("/* EXTERNAL items */\n"); - } - output_local ("static unsigned char\t*%s%d = NULL;", - CB_PREFIX_BASE, f->id); - output_local (" /* %s */\n", f->name); - } - } - if (seen) { - output_local ("\n"); - } - for (l = prog->file_list; l; l = CB_CHAIN (l)) { - f = CB_FILE (CB_VALUE (l))->record; - if (f->flag_external) { - if (f->flag_is_global) { - bl = cobc_parse_malloc (sizeof (struct base_list)); - bl->f = f; - bl->curr_prog = excp_current_program_id; - bl->next = globext_cache; - globext_cache = bl; - continue; - } - output_local ("static unsigned char\t*%s%d = NULL;", - CB_PREFIX_BASE, f->id); - output_local (" /* %s */\n", f->name); - } - } - - /* Allocate files */ - if (prog->file_list) { - i = 0; - for (l = prog->file_list; l; l = CB_CHAIN (l)) { - i += output_file_allocation (CB_FILE (CB_VALUE (l))); - } - if (i) { - output_local ("\n/* LINAGE pointer */\n"); - output_local ("static cob_linage\t\t*lingptr;\n"); - } - } - - /* BASED working-storage */ - i = 0; - for (f = prog->working_storage; f; f = f->sister) { - if (f->redefines) { - continue; - } - if (f->flag_item_based) { - if (!i) { - i = 1; - output_local("\n/* BASED WORKING-STORAGE SECTION */\n"); - } - output_local ("static unsigned char\t*%s%d = NULL; /* %s */\n", - CB_PREFIX_BASE, f->id, f->name); - } - } - if (i) { - output_local ("\n"); - } - - /* BASED local-storage */ - i = 0; - for (f = prog->local_storage; f; f = f->sister) { - if (f->redefines) { - continue; - } - if (f->flag_item_based) { - if (!i) { - i = 1; - output_local("\n/* BASED LOCAL-STORAGE */\n"); - } - output_local ("static unsigned char\t*%s%d = NULL; /* %s */\n", - CB_PREFIX_BASE, f->id, f->name); - } - } - if (i) { - output_local ("\n"); - } - - /* Dangling linkage section items */ - seen = 0; - for (f = prog->linkage_storage; f; f = f->sister) { - if (f->redefines) { - continue; - } - for (l = parameter_list; l; l = CB_CHAIN (l)) { - if (f == cb_code_field (CB_VALUE (l))) { - break; - } - } - if (l == NULL) { - if (!seen) { - seen = 1; - output_local ("\n/* LINKAGE SECTION (Items not referenced by USING clause) */\n"); - } - if (!f->flag_is_returning) { - output_local ("static "); - } - output_local ("unsigned char\t*%s%d = NULL; /* %s */\n", - CB_PREFIX_BASE, f->id, f->name); - } - } - if (seen) { - output_local ("\n"); - } - - /* Screens */ - if (prog->screen_storage) { - optimize_defs[COB_SET_SCREEN] = 1; - output_local ("\n/* Screens */\n\n"); - output_screen_definition (prog->screen_storage); - output_local ("\n"); - } - - if (prog->report_storage) { - optimize_defs[COB_SET_REPORT] = 1; - } - - if (prog->ml_trees) { - output_local ("\n/* JSON/XML GENERATE trees */\n"); - output_ml_trees_definitions (prog->ml_trees); - } - - /* Save variables for global callback */ - if (prog->flag_global_use && parameter_list) { - output_local ("/* Parameter save */\n"); - for (l = parameter_list; l; l = CB_CHAIN (l)) { - f = cb_code_field (CB_VALUE (l)); - output_local ("static unsigned char\t*save_%s%d;\n", - CB_PREFIX_BASE, f->id); - } - output_local ("\n"); - } - - /* Start of function proper */ - output_line ("/* Start of function code */"); - output_newline (); - - /* CANCEL callback */ - if (prog->prog_type == COB_MODULE_TYPE_PROGRAM) { - output_line ("/* CANCEL callback */"); - output_line ("if (unlikely(entry < 0)) {"); - output_line ("\tif (entry == -10)"); - output_line ("\t\tgoto P_dump;"); - output_line ("\tif (entry == -20)"); - output_line ("\t\tgoto P_clear_decimal;"); - output_line ("\tgoto P_cancel;"); - output_line ("}"); - output_newline (); - } - - output_line ("/* Check initialized, check module allocated, */"); - output_line ("/* set global pointer, */"); - output_line ("/* push module stack, save call parameter count */"); - output_line ("if (cob_module_global_enter (&module, &cob_glob_ptr, %d, entry, %sname_hash))", - cb_flag_implicit_init, CB_PREFIX_STRING); - if (prog->prog_type == COB_MODULE_TYPE_FUNCTION) { - output_line ("\treturn NULL;"); - } else { - output_line ("\treturn -1;"); - } - output_newline (); - - if (prog->flag_chained) { - output_line ("/* Check program with CHAINING being main program */"); - output_line ("if (cob_glob_ptr->cob_current_module->next)"); - output_line ("\tcob_fatal_error (COB_FERROR_CHAINING);"); - output_newline (); - } - - /* Recursive module initialization */ - if (prog->flag_recursive) { - output_module_init (prog); - } - - /* Module Parameters */ - output_line ("/* Set address of module parameter list */"); - if (cb_flag_stack_on_heap || prog->flag_recursive) { - if (prog->max_call_param) { - i = prog->max_call_param; - } else { - i = 1; - } - output_line ("cob_procedure_params = cob_malloc (%dU * sizeof(void *));", - i); - } - output_line ("module->cob_procedure_params = cob_procedure_params;"); - output_newline (); - - output_line ("/* Set frame stack pointer */"); - if (cb_flag_stack_on_heap || prog->flag_recursive) { - if (prog->flag_recursive && cb_stack_size == 255) { - i = 63; - } else { - i = cb_stack_size; - } - output_line ("frame_stack = cob_malloc (%dU * sizeof(struct cob_frame));", - i); - output_line ("frame_ptr = frame_stack;"); - if (cb_flag_stack_check) { - output_line ("frame_overflow = frame_ptr + %d - 1;", - i); - } - } else { - output_line ("frame_ptr = frame_stack;"); - output_line ("frame_ptr->perform_through = 0;"); - if (cb_flag_computed_goto) { - output_line ("frame_ptr->return_address_ptr = &&P_cgerror;"); - } - if (cb_flag_stack_check) { - output_line ("frame_overflow = frame_ptr + %d - 1;", - cb_stack_size); - } - } - - /* To Avoid C compiler warning: -Wunused-but-set-variable */ - if (cb_flag_stack_check) { - output_line ("if (frame_ptr == frame_overflow) {}"); - } - - output_newline (); - - /* Set up LOCAL-STORAGE size */ - if (prog->local_storage) { - for (f = prog->local_storage; f; f = f->sister) { - if (f->flag_item_based || f->flag_local_alloced) { - continue; - } - if (f->redefines) { - continue; - } - /* LCOV_EXCL_START */ - if (f->flag_item_78) { - cobc_err_msg (_("unexpected CONSTANT item")); - COBC_ABORT (); - } - /* LCOV_EXCL_STOP */ - f->flag_local_storage = 1; - f->flag_local_alloced = 1; - f->mem_offset = local_mem; - local_mem += compute_align_size (f->memory_size, 16); - } - } - - /* Initialization */ - - /* Allocate and initialize LOCAL storage */ - if (prog->local_storage) { - if (local_mem) { - output_line ("/* Allocate LOCAL storage */"); - output_line ("cob_local_ptr = cob_malloc (%dU);", - local_mem); - if (prog->flag_global_use) { - output_line ("cob_local_save = cob_local_ptr;"); - } - } - output_newline (); - output_line ("/* Initialize LOCAL storage */"); - output_initial_values (prog->local_storage); - output_newline (); - } - - output_line ("/* Initialize rest of program */"); - output_line ("if (unlikely(initialized == 0)) {"); - output_line ("\tgoto P_initialize;"); - output_line ("}"); - output_line ("P_ret_initialize:"); - output_newline (); - - if (prog->decimal_index_max) { - output_line ("/* Allocate decimal numbers */"); - output_prefix (); - if (prog->flag_recursive) { - output ("cob_decimal_push (%u", prog->decimal_index_max); - } else { - output ("cob_decimal_alloc (%u", prog->decimal_index_max); - } - for (i = 0; i < prog->decimal_index_max; i++) { - output (", &d%u", i); - } - output (");"); - output_newline (); - output_newline (); - } - - /* Global entry dispatch */ - if (prog->global_list) { - output_line ("/* Global entry dispatch */"); - output_newline (); - for (l = prog->global_list; l; l = CB_CHAIN (l)) { - output_line ("if (unlikely(entry == %d)) {", - CB_LABEL (CB_VALUE (l))->id); - if (local_mem) { - output_line ("\tcob_local_ptr = cob_local_save;"); - } - for (l2 = parameter_list; l2; l2 = CB_CHAIN (l2)) { - f = cb_code_field (CB_VALUE (l2)); - output_line ("\t%s%d = save_%s%d;", - CB_PREFIX_BASE, f->id, - CB_PREFIX_BASE, f->id); - } - output_line ("\tgoto %s%d;", - CB_PREFIX_LABEL, - CB_LABEL (CB_VALUE (l))->id); - output_line ("}"); - } - output_newline (); - } - - if (!prog->flag_recursive) { - output_line ("/* Increment module active */"); - output_line ("module->module_active++;"); - output_newline (); - } - - if (!cobc_flag_main && non_nested_count > 1) { - output_line ("/* Increment module reference count */"); - output_line ("cob_reference_count++;"); - output_newline (); - } - - /* Initialize W/S and files unconditionally when INITIAL program */ - if (prog->flag_initial) { - if (prog->working_storage) { - output_line ("/* Initialize INITIAL program WORKING-STORAGE */"); - output_initial_values (prog->working_storage); - output_newline (); - } - if (prog->file_list) { - for (l = prog->file_list; l; l = CB_CHAIN (l)) { - output_file_initialization (CB_FILE (CB_VALUE (l))); - } - } - - /* Do Reports again here */ - if (prog->report_list) { - optimize_defs[COB_SET_REPORT] = 1; - output_line ("/* Init Reports for INITIAL program */"); - for (l = prog->report_list; l; l = CB_CHAIN (l)) { - rep = CB_REPORT_PTR (CB_VALUE(l)); - output_report_init (rep); - } - output_newline (); - } - } - - if (!cb_sticky_linkage - && !prog->flag_chained - && prog->prog_type != COB_MODULE_TYPE_FUNCTION - && cb_list_length(parameter_list) > 0) { - output_line ("/* No sticky-linkage so NULL LINKAGE addresses */"); - for (l2 = parameter_list; l2; l2 = CB_CHAIN (l2)) { - setnull_param (l2); - } - } - - /* Set up ANY length items */ - if (cb_list_length (prog->entry_list) <= 1 - && !prog->flag_chained) { - - i = 0; - anyseen = 0; - for (l = parameter_list; l; l = CB_CHAIN (l), i++) { - f = cb_code_field (CB_VALUE (l)); - if (f->flag_any_length) { - if (!anyseen) { - anyseen = 1; - name_hash = cob_get_name_hash (prog->orig_program_id); - output_line ("if (cob_glob_ptr->cob_call_name_hash == 0x%X) {", name_hash); - output_indent_level += 2; - output_line ("/* Initialize ANY LENGTH parameters */"); - output_line ("module->module_num_params = cob_glob_ptr->cob_call_params;"); - } - pickup_any_length (l, i); - } - } - if (anyseen) { - output_indent_level -= 2; - output_line ("}"); - output_newline (); - } - - if (cb_list_length (parameter_list) > 0 - && prog->prog_type != COB_MODULE_TYPE_FUNCTION) { - int basic_param = 1; - for (l = parameter_list; l && basic_param; l = CB_CHAIN (l)) { - struct cb_field *f; - int is_value_parm, is_any_numeric; - - f = setup_param (l, &is_value_parm, &is_any_numeric); - if (is_value_parm - || is_any_numeric - || f->flag_any_length) { - basic_param = 0; - break; - } - } - name_hash = cob_get_name_hash (prog->orig_program_id); - output_line ("if (cob_glob_ptr->cob_call_name_hash != 0x%X) {", name_hash); - output_indent_level += 2; - output_line ("cob_glob_ptr->cob_call_from_c = 1; /* Called by C */"); - for (i = 0, l = parameter_list; l; l = CB_CHAIN (l), i++) { - pickup_c_param (l, i, !basic_param); - } - output_line ("cob_glob_ptr->cob_call_params = %u;", i); - output_indent_level -= 2; - output_line ("} else {"); - output_indent_level += 2; - output_line ("cob_glob_ptr->cob_call_from_c = 0; /* Called by COBOL */"); - for (i = 0, l = parameter_list; l; l = CB_CHAIN (l), i++) { - pickup_cob_param (l, i); - } - output_indent_level -= 2; - output_line ("}"); - output_line ("cob_glob_ptr->cob_call_name_hash = %u;", 0); - } - } - - /* Call parameters */ - if (prog->cb_call_params && cb_code_field (prog->cb_call_params)->count) { - output_line ("/* Set NUMBER-OF-CALL-PARAMETERS (independent from LINKAGE) */"); - output_prefix (); - output_integer (prog->cb_call_params); - output (" = cob_glob_ptr->cob_call_params;"); - output_newline (); - output_newline (); - } - - output_line ("/* Save number of call params */"); - output_line ("module->module_num_params = cob_glob_ptr->cob_call_params;"); - output_newline (); - - if (prog->prog_type == COB_MODULE_TYPE_FUNCTION - && CB_FIELD_PTR(prog->returning)->storage == CB_STORAGE_LINKAGE) { - output_line ("/* Storage for returning item */"); - output_prefix (); - output_data (prog->returning); - output (" = cob_malloc ("); - output_size (prog->returning); - output ("U);"); - output_newline (); - output_newline (); - } - - if (prog->flag_global_use && parameter_list) { - output_line ("/* Parameter save */"); - for (l = parameter_list; l; l = CB_CHAIN (l)) { - f = cb_code_field (CB_VALUE (l)); - output_line ("save_%s%d = %s%d;", - CB_PREFIX_BASE, f->id, - CB_PREFIX_BASE, f->id); - } - output_newline (); - } - - /* Classification */ - if (prog->classification) { - if (prog->classification == cb_int1) { - output_line ("cob_set_locale (NULL, COB_LC_CLASS);"); - } else { - output_prefix (); - output ("cob_set_locale ("); - output_param (prog->classification, -1); - output (", COB_LC_CTYPE);"); - } - output_newline (); - } - - /* Entry dispatch */ - if (cb_list_length (prog->entry_list) > 1) { - output_line ("/* Entry dispatch */"); - output_line ("if (module->next == NULL)"); - output_line (" cob_glob_ptr->cob_call_from_c = 1;"); - output_newline (); - output_line ("switch (entry)"); - output_block_open (); - for (i = 0, l = prog->entry_list; l; l = CB_CHAIN (l), i++) { - using_list = CB_VALUE (CB_VALUE (l)); - if (using_list) { - output_line ("case %d: /* Initialize %d parameters for '%s' */",i, - cb_list_length(using_list),CB_LABEL (CB_PURPOSE (l))->name); - output_indent_level += 4; - output_line ("module->module_name = \"%s\";", CB_LABEL (CB_PURPOSE (l))->name); - for (j=0,l2 = using_list; l2; l2 = CB_CHAIN (l2), j++) { - pickup_param (l2, j); - } - output_indent_level -= 4; - } else { - output_line ("case %d: /* No parameters for '%s' */",i, - CB_LABEL (CB_PURPOSE (l))->name); - output_indent_level += 4; - output_line ("module->module_name = \"%s\";", CB_LABEL (CB_PURPOSE (l))->name); - output_indent_level -= 4; - } - output_line ("cob_glob_ptr->cob_call_params = %u;", 0); - output_line (" goto %s%d;", CB_PREFIX_LABEL, - CB_LABEL (CB_PURPOSE (l))->id); - } - output_block_close (); - output_line ("/* This should never be reached */"); - output_line ("cob_fatal_error (COB_FERROR_MODULE);"); - } else { - l = prog->entry_list; - name_hash = cob_get_name_hash (CB_LABEL (CB_PURPOSE (l))->name); - output_line ("goto %s%d;", CB_PREFIX_LABEL, - CB_LABEL (CB_PURPOSE (l))->id); - } - output_line ("cob_glob_ptr->cob_call_params = %u;", 0); - output_newline (); - - /* PROCEDURE DIVISION */ - output_line ("/* PROCEDURE DIVISION */"); - for (l = prog->exec_list; l; l = CB_CHAIN (l)) { - output_stmt (CB_VALUE (l)); - } - output_newline (); - - /* End of program / function */ - - /* Output source location as code */ - if (cb_flag_source_location - || cb_flag_dump) { - l = CB_TREE (prog); - output_line ("module->module_stmt = 0x%08X;", - COB_SET_LINE_FILE(prog->last_source_line, lookup_source(l->source_file))); - output_newline (); - } - - if (current_prog->prog_type == COB_MODULE_TYPE_FUNCTION) { - output_line ("/* Function exit */"); - output_newline (); - if (needs_exit_prog) { - output_line ("exit_function:"); - output_newline (); - } - } else { - output_line ("/* Program exit */"); - output_newline (); - if (needs_exit_prog) { - output_line ("exit_program:"); - output_newline (); - } - } - - if (!prog->flag_recursive) { - output_line ("/* Decrement module active count */"); - output_line ("if (module->module_active) {"); - output_line ("\tmodule->module_active--;"); - output_line ("}"); - output_newline (); - } - - if (!cobc_flag_main && non_nested_count > 1) { - output_line ("/* Decrement module reference count */"); - output_line ("if (cob_reference_count) {"); - output_line ("\tcob_reference_count--;"); - output_line ("}"); - output_newline (); - } - - if (gen_dynamic) { - output_line ("/* Deallocate dynamic FUNCTION-ID fields */"); - for (inc = 0; inc < gen_dynamic; inc++) { - output_line ("if (cob_dyn_%u) {", inc); - output_line (" if (cob_dyn_%u->data) {", inc); - output_line (" cob_free (cob_dyn_%u->data);", inc); - output_line (" }"); - output_line (" cob_free (cob_dyn_%u);", inc); - output_line (" cob_dyn_%u = NULL;", inc); - output_line ("}"); - } - output_newline (); - } - - if (prog->local_storage) { - output_line ("/* Deallocate LOCAL storage */"); - if (local_mem) { - output_line ("if (cob_local_ptr) {"); - output_line ("\tcob_free (cob_local_ptr);"); - output_line ("\tcob_local_ptr = NULL;"); - if (current_prog->flag_global_use) { - output_line ("\tcob_local_save = NULL;"); - } - output_line ("}"); - } - for (f = prog->local_storage; f; f = f->sister) { - if (f->flag_item_based) { - output_line ("if (%s%d) {", CB_PREFIX_BASE, f->id); - output_line ("\tcob_free_alloc (&%s%d, NULL);", - CB_PREFIX_BASE, f->id); - output_line ("\t%s%d = NULL;", - CB_PREFIX_BASE, f->id); - output_line ("}"); - } - } - output_newline (); - } - - if (prog->decimal_index_max && prog->flag_recursive) { - output_line ("/* Free decimal structures */"); - output_prefix (); - output ("cob_decimal_pop (%u", prog->decimal_index_max); - for (i = 0; i < prog->decimal_index_max; i++) { - output (", d%u", i); - } - output (");"); - output_newline (); - output_newline (); - } - - if (cb_flag_stack_on_heap || prog->flag_recursive) { - output_line ("/* Free frame stack / call parameters */"); - output_line ("cob_free (frame_stack);"); - output_line ("cob_free (cob_procedure_params);"); - output_newline (); - } - - if (cb_flag_trace) { - output_line ("/* Trace program exit */"); - output_line ("cob_trace_exit (%s%d);", - CB_PREFIX_STRING, lookup_string(excp_current_program_id)); - output_newline (); - } - - output_line ("/* Pop module stack */"); - output_line ("cob_module_leave (module);"); - output_newline (); - - if (prog->flag_recursive) { - output_line ("/* Free for recursive module */"); - output_line ("cob_module_free (&module);"); - output_newline (); - } - - /* Implicit CANCEL for INITIAL program */ - if (prog->flag_initial) { - output_line ("/* CANCEL for INITIAL program */"); - output_prefix (); - if (!prog->nested_level) { - output ("%s_ (-1", prog->program_id); - } else { - output ("%s_%d_ (-1", prog->program_id, - prog->toplev_count); - } - if (!prog->flag_chained) { - for (l = parameter_list; l; l = CB_CHAIN (l)) { - output (", NULL"); - } - } - output (");"); - output_newline (); - output_newline (); - } - - if (prog->prog_type == COB_MODULE_TYPE_FUNCTION) { - output_line ("/* Function return */"); - output_prefix (); - output ("return cob_function_return ("); - output_param (prog->returning, -1); - output (")"); - } else { - output_line ("/* Program return */"); - if (prog->returning && prog->cb_return_code) { - output_move (prog->returning, prog->cb_return_code); - } - output_prefix (); - output ("return "); - if (prog->cb_return_code) { - output_integer (prog->cb_return_code); - } else { - output ("0"); - } - } - output (";"); - output_newline (); - - /* Error handlers */ - if (prog->file_list - || prog->flag_gen_error - || has_global_file) { - output_error_handler (prog); - } - - /* Frame stack jump table for compiler without computed goto */ - if (!cb_flag_computed_goto) { - output_newline (); - output_line ("/* Frame stack jump table */"); - output_line ("P_switch:"); - if (label_cache) { - output_line (" switch (frame_ptr->return_address_num) {"); - for (pl = label_cache; pl; pl = pl->next) { - output_line (" case %d:", pl->call_num); - output_line (" goto %s%d;", CB_PREFIX_LABEL, pl->id); - } - output_line (" }"); - } - } - output_line ("P_cgerror:"); - output_line ("\tcob_fatal_error (COB_FERROR_CODEGEN);"); - output_newline (); - - /* Program initialization */ - - output_newline (); - output_line ("/* Program initialization */"); - output_line ("P_initialize:"); - output_newline (); - - /* Check matching version */ - if (!prog->nested_level) { - output_line ("cob_check_version (COB_SOURCE_FILE, COB_PACKAGE_VERSION, COB_PATCH_LEVEL);"); - output_newline (); - } - - /* Resolve user functions */ - for (clp = func_call_cache; clp; clp = clp->next) { - output_line ("func_%s.funcvoid = cob_resolve_func (\"%s\");", - clp->call_name, clp->call_name); - } - - if (cobc_flag_main && !prog->nested_level) { - output_line ("cob_module_path = cob_glob_ptr->cob_main_argv0;"); - output_newline (); - } - - /* Module initialization */ - if (!prog->flag_recursive) { - output_module_init (prog); - } - - /* Setup up CANCEL callback */ - if (!prog->nested_level && prog->prog_type == COB_MODULE_TYPE_PROGRAM) { - output_line ("/* Initialize cancel callback */"); - output_line ("cob_set_cancel (module);"); - output_newline (); - } - - /* Initialize EXTERNAL files */ - for (l = prog->file_list; l; l = CB_CHAIN (l)) { - f = CB_FILE (CB_VALUE (l))->record; - if (f->flag_external) { - strcpy (string_buffer, f->name); - for (p = string_buffer; *p; p++) { - if (*p == '-' || *p == ' ') { - *p = '_'; - } - } - output_line ("%s%d = cob_external_addr (\"%s\", %d);", - CB_PREFIX_BASE, f->id, string_buffer, - CB_FILE (CB_VALUE (l))->record_max); - } - } - - gen_init_working = 1; /* Disable use of DEPENDING ON fields */ - /* Initialize WORKING-STORAGE EXTERNAL items */ - for (f = prog->working_storage; f; f = f->sister) { - if (f->redefines) { - continue; - } - if (!f->flag_external) { - continue; - } - output_prefix (); - output_base (f, 0); - output (" = cob_external_addr (\"%s\", %d);", - f->ename, f->size); - output_newline (); - } - - /* Initialize WORKING-STORAGE/files if not INITIAL program */ - if (!prog->flag_initial) { - if (prog->working_storage) { - output_line ("/* Initialize WORKING-STORAGE */"); - output_initial_values (prog->working_storage); - output_newline (); - } - if (prog->file_list) { - for (l = prog->file_list; l; l = CB_CHAIN (l)) { - output_file_initialization (CB_FILE (CB_VALUE (l))); - } - } - } - - i = 1; - for (m = literal_cache; m; m = m->next) { - if (CB_TREE_CLASS (m->x) == CB_CLASS_NUMERIC - && m->make_decimal) { - if (i) { - i = 0; - output_line ("/* Set Decimal Constant values */"); - } - output_line ("%s%d = &%s%d;", CB_PREFIX_DEC_CONST,m->id, - CB_PREFIX_DEC_FIELD,m->id); - output_line ("cob_decimal_init(%s%d);",CB_PREFIX_DEC_CONST,m->id); - output_line ("cob_decimal_set_field (%s%d, (cob_field *)&%s%d);", - CB_PREFIX_DEC_CONST,m->id, - CB_PREFIX_CONST,m->id); - output_newline (); - } - } - -#if 0 /* BWT coerce linkage to picture */ - /* Manage linkage section */ - if (prog->linkage_storage) { - output_line ("/* Initialize LINKAGE */"); - output_coerce_linkage (prog->linkage_storage); - output_newline (); - } -#endif - - if (prog->screen_storage) { - output_line ("/* Initialize SCREEN items */"); - /* Initialize items with VALUE */ - output_initial_values (prog->screen_storage); - output_screen_init (prog->screen_storage, NULL); - output_newline (); - } - - if (prog->report_storage) { - output_line ("/* Initialize REPORT data items */"); - /* Initialize items with VALUE */ - for (l = prog->report_list; l; l = CB_CHAIN (l)) { - rep = CB_REPORT_PTR (CB_VALUE(l)); - if (rep) { - for (f=rep->records; f; f = f->sister) { - /* Clear report lines to SPACES */ - output_prefix (); - output ("memset ("); - output_base (f, 0); - output (", ' ', %d);", f->size); - output_newline (); - } - output_initial_values (rep->records); - } - } - output_newline (); - } - - /* JSON/XML GENERATE trees */ - if (prog->ml_trees) { - optimize_defs[COB_SET_ML_TREE] = 1; - output_line ("/* Initialize JSON/XML GENERATE output trees */"); - output_ml_generate_init (prog->ml_trees); - output_newline (); - } - - /* Reports */ - if (prog->report_list) { - optimize_defs[COB_SET_REPORT] = 1; - output_newline (); - output_line ("/* Init Reports */"); - output_newline (); - for (l = prog->report_list; l; l = CB_CHAIN (l)) { - rep = CB_REPORT_PTR (CB_VALUE(l)); - output_report_init (rep); - } - output_newline (); - } - - gen_init_working = 0; /* re-enable use of DEPENDING ON fields */ - - /* ensure references needed to prevent compilation warnings/errors*/ - output_line ("if (0 == 1) goto P_cgerror;"); - - output_line ("initialized = 1;"); - output_line ("goto P_ret_initialize;"); - - output_newline (); - output_line ("P_dump:"); - if (num_cob_fields == 0 - && cb_flag_dump != 0) { - output_line ("{ cob_field f0;"); - output_indent_level += 2; - output_line ("memset(&f0,0,sizeof(f0));"); - nested_dump = 1; - } else { - nested_dump = 0; - } - - for (l = prog->file_list; l; l = CB_CHAIN (l)) { - fl = CB_FILE(CB_VALUE (l)); - if (fl->record - && (cb_flag_dump & COB_DUMP_FD)) { - char fdname[48]; - sprintf (fdname, "FD %s", fl->name); - output_line ("/* Dump %s */", fdname); - output_line ("cob_dump_field (-1, \"%s\", NULL, 0, 0);", fdname); - output_line ("cob_dump_field (-2, (const char*)%s%s, NULL, 0, 0);", - CB_PREFIX_FILE, fl->cname); - if (fl->record->sister - && fl->record->sister->sister == NULL) { /* Only one record layout */ - f = fl->record->sister->redefines; - fl->record->sister->redefines = NULL; /* Temp remove of redefines */ - output_display_fields (fl->record->sister, 0, 0); - fl->record->sister->redefines = f; - } else if (fl->record->file == NULL) { - fl->record->file = fl; - output_display_fields (fl->record, 0, 0); - fl->record->file = NULL; - } else { - output_display_fields (fl->record, 0, 0); - } - } - } - - if (prog->working_storage - && (cb_flag_dump & COB_DUMP_WS)) { - output_line ("/* Dump WORKING-STORAGE */"); - output_line ("cob_dump_field (-1, \"%s\", NULL, 0, 0);", "WORKING-STORAGE"); - output_display_fields (prog->working_storage, 0, 0); - } - if (prog->screen_storage - && (cb_flag_dump & COB_DUMP_SC)) { - output_line ("/* Dump SCREEN SECTION */"); - output_line ("cob_dump_field (-1, \"%s\", NULL, 0, 0);", "SCREEN"); - output_display_fields (prog->screen_storage, 0, 0); - } - if (prog->report_storage - && (cb_flag_dump & COB_DUMP_RD)) { - output_line ("/* Dump REPORT SECTION */"); - output_line ("cob_dump_field (-1, \"%s\", NULL, 0, 0);", "REPORT"); - output_display_fields (prog->report_storage, 0, 0); - } - if (prog->linkage_storage - && (cb_flag_dump & COB_DUMP_LS)) { - output_newline (); - output_line ("/* Dump LINKAGE SECTION */"); - output_line ("cob_dump_field (-1, \"%s\", NULL, 0, 0);", "LINKAGE"); - output_display_fields (prog->linkage_storage, 0, 0); - } - if (nested_dump) { - output_indent_level -= 2; - output_line ("}"); - } - if (prog->prog_type == CB_FUNCTION_TYPE) { - output_line (" return NULL;"); - } else { - output_line (" return 0;"); - } - output_newline (); - - /* Set up CANCEL callback code */ - - if (prog->prog_type != COB_MODULE_TYPE_PROGRAM) { - goto prog_cancel_end; - } - - output_newline (); - output_line ("/* CANCEL callback handling */"); - output_line ("P_cancel:"); - output_newline (); - output_line ("if (!initialized)"); - output_line ("\treturn 0;"); - output_line ("if (module && module->module_active)"); - output_line ("\tcob_fatal_error (COB_FERROR_CANCEL);"); - output_newline (); - - if (prog->flag_main) { - goto cancel_end; - } - - next_prog = prog->next_program; - - /* Check for implicit cancel of contained programs */ - for (; next_prog; next_prog = next_prog->next_program) { - if (next_prog->nested_level == prog->nested_level + 1) { - output_prefix (); - output ("(void)%s_%d_ (-1", next_prog->program_id, - next_prog->toplev_count); - for (i = 0; i < (int)(next_prog->num_proc_params); ++i) { - output (", NULL"); - } - output (");"); - output_newline (); - } - } - - /* Close files on cancel */ - for (l = prog->file_list; l; l = CB_CHAIN (l)) { - fl = CB_FILE (CB_VALUE (l)); - if (fl->organization != COB_ORG_SORT) { - output_line ("cob_close (%s%s, NULL, COB_CLOSE_NORMAL, 1);", - CB_PREFIX_FILE, fl->cname); - if (!fl->flag_external) { - output_line ("cob_file_destroy (&%s%s);", - CB_PREFIX_FILE, fl->cname); - } - } else { - output_line ("cob_cache_free (%s%s);", - CB_PREFIX_FILE, fl->cname); - output_line ("%s%s = NULL;", - CB_PREFIX_FILE, fl->cname); - } - } - - /* Clear alter indicators */ - for (cpl = prog->alter_gotos; cpl; cpl = cpl->next) { - output_line ("label_%s%d = 0;", - CB_PREFIX_LABEL, cpl->goto_id); - if (prog->flag_segments) { - output_line ("save_label_%s%d = 0;", - CB_PREFIX_LABEL, cpl->goto_id); - } - } - - /* Release based storage */ - for (f = prog->working_storage; f; f = f->sister) { - if (f->flag_item_based) { - output_line ("if (%s%d) {", CB_PREFIX_BASE, f->id); - output_line ("\tcob_free_alloc (&%s%d, NULL);", - CB_PREFIX_BASE, f->id); - output_line ("}"); - } - } - - /* Clear CALL pointers */ - for (clp = call_cache; clp; clp = clp->next) { - output_line ("call_%s.funcvoid = NULL;", clp->call_name); - } - for (clp = func_call_cache; clp; clp = clp->next) { - output_line ("func_%s.funcvoid = NULL;", clp->call_name); - } - - /* Clear sticky-linkage pointers */ - if (cb_sticky_linkage && !prog->flag_chained) { - for (l = prog->parameter_list; l; l = CB_CHAIN (l)) { - output_line ("cob_parm_%d = NULL;", - cb_code_field (CB_VALUE (l))->id); - } - } - - /* Clear RETURN-CODE */ - if (!prog->nested_level && prog->cb_return_code) { - output_prefix (); - output_integer (current_prog->cb_return_code); - output (" = 0;"); - output_newline (); - } - - output_line ("cob_module_free (&module);"); - output_newline (); - -cancel_end: - output_line ("initialized = 0;"); - output_newline (); - output_line ("P_clear_decimal:"); - i = 1; - for (m = literal_cache; m; m = m->next) { - if (CB_TREE_CLASS (m->x) == CB_CLASS_NUMERIC - && m->make_decimal) { - if (i) { - i = 0; - output_line ("/* Clear Decimal Constant values */"); - } - output_line ("cob_decimal_clear(%s%d);",CB_PREFIX_DEC_CONST,m->id); - output_line ("%s%d = NULL;",CB_PREFIX_DEC_CONST,m->id); - } - } - output_newline (); - output_line ("return 0;"); - output_newline (); - /* End of CANCEL callback code */ - -prog_cancel_end: - output_block_close (); - output_newline (); - if (prog->prog_type == COB_MODULE_TYPE_FUNCTION) { - s = "FUNCTION-ID"; - } else { - s = "PROGRAM-ID"; - } - output_line ("/* End %s '%s' */", s, prog->orig_program_id); - output_newline (); - output_module_init_function (prog); -} - -/* Output the entry function for a COBOL function. */ -static void -output_function_entry_function (struct cb_program *prog, cb_tree entry, - const int gencode) -{ - const char *entry_name; - cb_tree using_list; - cb_tree l; - cob_u32_t parmnum; - cob_u32_t n; - - recent_prog = prog; - entry_name = CB_LABEL (CB_PURPOSE (entry))->name; - using_list = CB_VALUE (CB_VALUE (entry)); - - if (gencode) { - output_line ("/* ENTRY '%s' */", entry_name); - output_newline (); - output_line ("cob_field *"); - output ("%s (", entry_name); - output ("cob_field **cob_fret, const int cob_pam"); - } else { -#if (defined(_WIN32) || defined(__CYGWIN__)) && !defined(__clang__) - if (!prog->nested_level) { - output ("__declspec(dllexport) "); - } -#endif - output ("cob_field\t\t*%s (", entry_name); - output ("cob_field **, const int"); - } - parmnum = 0; - if (using_list) { - output (", "); - n = 0; - for (l = using_list; l; l = CB_CHAIN (l), ++n, ++parmnum) { - if (!gencode) { - output ("cob_field *"); - } else { - output ("cob_field *f%u", n); - } - if (CB_CHAIN (l)) { - output (", "); - } - } - } - if (!gencode) { - /* Finish prototype and return */ - output (");"); - output_newline (); - return; - } - output (")"); - output_newline (); - - output_block_open (); - output_line ("struct cob_func_loc\t*floc;"); - output_line ("cob_field\t*ret = NULL;"); - output_newline (); - output_line ("/* Save environment */"); - output_prefix (); - output ("floc = cob_save_func (cob_fret, cob_pam, %u", parmnum); - - for (n = 0; n < parmnum; ++n) { - output (", f%u", n); - } - output (");"); - output_newline (); - - output_prefix (); - output ("floc->ret_fld = %s_ (0", prog->program_id); - if (parmnum != 0) { - output (", "); - for (n = 0; n < parmnum; ++n) { - output ("floc->data[%u]", n); - if (n != parmnum - 1) { - output (", "); - } - } - } - output (");"); - output_newline (); - output_line ("if (floc->ret_fld != NULL) {"); - output_line (" **cob_fret = *floc->ret_fld;"); - output_line (" ret = *cob_fret;"); - output_line ("}"); - output_newline (); - output_line ("/* Restore environment */"); - output_line ("cob_restore_func (floc);"); - output_line ("return ret;"); - output_block_close (); - output_newline (); -} - -/* Returns NULL if it could not deduce the parameter type. */ -static const char * -try_get_by_value_parameter_type (const enum cb_usage usage, - cb_tree param_list_elt) -{ - const int is_unsigned = - CB_SIZES (param_list_elt) == CB_SIZE_UNSIGNED; - - if (usage == CB_USAGE_FLOAT) { - return "float"; - } else if (usage == CB_USAGE_DOUBLE) { - return "double"; - } else if (usage == CB_USAGE_LONG_DOUBLE) { - return "long double"; - } else if (usage == CB_USAGE_FP_BIN32) { - return "cob_u32_t"; - } else if (usage == CB_USAGE_FP_BIN64 - || usage == CB_USAGE_FP_DEC64) { - return "cob_u64_t"; - } else if (usage == CB_USAGE_FP_BIN128 - || usage == CB_USAGE_FP_DEC128) { - return "cob_fp_128"; - } else if (CB_TREE_CLASS (CB_VALUE (param_list_elt)) - == CB_CLASS_NUMERIC) { - /* To-do: Split this duplicated code into another function */ - switch (CB_SIZES_INT (param_list_elt)) { - case CB_SIZE_1: - if (is_unsigned) { - return "cob_u8_t"; - } else { - return "cob_c8_t"; - } - - case CB_SIZE_2: - if (is_unsigned) { - return "cob_u16_t"; - } else { - return "cob_s16_t"; - } - - case CB_SIZE_4: - if (is_unsigned) { - return "cob_u32_t"; - } else { - return "cob_s32_t"; - } - - case CB_SIZE_8: - if (is_unsigned) { - return "cob_u64_t"; - } else { - return "cob_s64_t"; - } - - default: - break; - } - } - - return NULL; -} - - -static void -output_program_entry_function_parameters (cb_tree using_list, const int gencode, - const char ** const s_type) -{ - cob_u32_t n = 0; - cb_tree l; - struct cb_field *f; - const char *type; - - for (l = using_list; l; l = CB_CHAIN (l), ++n) { - f = cb_code_field (CB_VALUE (l)); - switch (CB_PURPOSE_INT (l)) { - case CB_CALL_BY_VALUE: - type = try_get_by_value_parameter_type (f->usage, l); - if (type) { - if (gencode) { - output ("%s %s%d", type, CB_PREFIX_BASE, - f->id); - } else { - output ("%s", type); - } - - if (cb_sticky_linkage) { - s_type[n] = ""; - } else { - s_type[n] = "(cob_u8_ptr)&"; - } - break; - } - - /* Fall through */ - case CB_CALL_BY_REFERENCE: - case CB_CALL_BY_CONTENT: - if (gencode) { - output ("cob_u8_t *%s%d", - CB_PREFIX_BASE, f->id); - } else { - output ("cob_u8_t *"); - } - s_type[n] = ""; - break; - - default: - break; - } - - if (CB_CHAIN (l)) { - output (", "); - } - } -} - -static void -output_entry_function (struct cb_program *prog, cb_tree entry, - cb_tree parameter_list, const int gencode) -{ - const char *entry_name; - cb_tree using_list; - cb_tree l; - cb_tree l1; - cb_tree l2; - struct cb_field *f; - struct cb_field *f1; - struct cb_field *f2; - const char *s; - const char *s2; - const char *s_prefix; - const char *s_type[MAX_CALL_FIELD_PARAMS]; - cob_u32_t parmnum; - cob_u32_t n; - int sticky_ids[MAX_CALL_FIELD_PARAMS] = { 0 }; - int sticky_nonp[MAX_CALL_FIELD_PARAMS] = { 0 }; - int entry_convention = 0; - - entry_name = CB_LABEL (CB_PURPOSE (entry))->name; - using_list = CB_VALUE (CB_VALUE (entry)); - - /* entry convention */ - l = CB_PURPOSE (CB_VALUE (entry)); - /* LCOV_EXCL_START */ - if (!l || !(CB_INTEGER_P (l) || CB_NUMERIC_LITERAL_P (l))) { - /* not translated as it is a highly unlikely internal abort */ - cobc_err_msg ("Missing/wrong internal entry convention!"); - COBC_ABORT (); - } - /* LCOV_EXCL_STOP */ - if (CB_INTEGER_P (l)) { - entry_convention = CB_INTEGER (l)->val; - } else if (CB_NUMERIC_LITERAL_P (l)) { - entry_convention = cb_get_int (l); - } - - if (gencode) { - output_line ("/* ENTRY '%s' */", entry_name); - output_newline (); -#if (defined(_WIN32) || defined(__CYGWIN__)) && !defined(__clang__) - } else { - if (!prog->nested_level) { - output ("__declspec(dllexport) "); - } -#endif - } - - /* Output return type. */ - if ((prog->nested_level && !prog->flag_void) - || (prog->flag_main && !prog->flag_recursive - && !strcmp(prog->program_id, entry_name))) { - output ("static "); - } - if (prog->flag_void) { - output ("void"); - } else { - output ("int"); - } - if (entry_convention & CB_CONV_STDCALL) { - output (" __stdcall"); - } - if (gencode) { - output_newline (); - } else { - output ("\t\t"); - } - - /* Output function name */ - if (prog->nested_level) { - output ("%s_%d__ (", entry_name, prog->toplev_count); - } else { - output ("%s (", entry_name); - } - - /* Output parameter list */ - - if (prog->flag_chained) { - using_list = NULL; - parameter_list = NULL; - } - - if (!gencode) { - /* Finish prototype and return */ - if (using_list) { - output_program_entry_function_parameters (using_list, 0, s_type); - output (");"); - } else { - output ("void);"); - } - output_newline (); - return; - } - - output_program_entry_function_parameters (using_list, 1, s_type); - output (")"); - output_newline (); - - output_block_open (); - - /* By value pointer fields */ - for (l2 = using_list; l2; l2 = CB_CHAIN (l2)) { - f2 = cb_code_field (CB_VALUE (l2)); - if (CB_PURPOSE_INT (l2) == CB_CALL_BY_VALUE && - (f2->usage == CB_USAGE_POINTER - || f2->usage == CB_USAGE_PROGRAM_POINTER)) { - output_line ("unsigned char\t\t*ptr_%d;", f2->id); - } - } - - - /* - We have to cater for sticky-linkage here at the entry point - site. Doing it in the internal function is too late as we then do not - have the information as to possible ENTRY clauses. - */ - - /* Sticky linkage parameters */ - if (cb_sticky_linkage && using_list) { - for (l = using_list, parmnum = 0; l; l = CB_CHAIN (l), parmnum++) { - f = cb_code_field (CB_VALUE (l)); - sticky_ids[parmnum] = f->id; - if (CB_PURPOSE_INT (l) == CB_CALL_BY_VALUE) { - s = try_get_by_value_parameter_type (f->usage, l); - if (f->usage == CB_USAGE_FP_BIN128 - || f->usage == CB_USAGE_FP_DEC128) { - s2 = "{{0, 0}}"; - } else { - s2 = "0"; - } - - if (s) { - output_line ("static %s\tcob_parm_l_%d = %s;", - s, f->id, s2); - sticky_nonp[parmnum] = 1; - } - } - } - } - - /* FIXME: add check for COB_EC_PROGRAM_ARG_MISMATCH here, - including checking for OPTIONAL items. - See comment in typeck.c (cb_build_identifier), too. */ - - /* Sticky linkage set up */ - if (cb_sticky_linkage && using_list) { - if ((parmnum = cb_list_length(using_list)) > 1) { - output_line (" cob_global *cob_glob_ptr = cob_get_global_ptr();"); - parmnum = 0; - output_line ("if (cob_glob_ptr->cob_call_name_hash != 0x%X)", - cob_get_name_hash (prog->orig_program_id)); - output_line (" cob_glob_ptr->cob_call_params = %u;", cb_list_length(using_list)); - output_line ("/* Set the parameter list */"); - output_line ("switch (cob_glob_ptr->cob_call_params) {"); - for (l = using_list; l; l = CB_CHAIN (l), parmnum++) { - if (parmnum == 0) { - continue; - } - output_line ("case %u:", parmnum); - for (n = 0; n < parmnum; ++n) { - if (sticky_nonp[n]) { - output_line ("\tcob_parm_l_%d = %s%d;", - sticky_ids[n], CB_PREFIX_BASE, - sticky_ids[n]); - output_line ("\tcob_parm_%d = (cob_u8_ptr)&cob_parm_l_%d;", - sticky_ids[n], - sticky_ids[n]); - } else { - output_line ("\tcob_parm_%d = %s%d;", - sticky_ids[n], CB_PREFIX_BASE, - sticky_ids[n]); - } - } - output_line ("\tbreak;"); - } - output_line ("default:"); - } - for (n = 0; n < parmnum; ++n) { - if (sticky_nonp[n]) { - output_line ("\tcob_parm_l_%d = %s%d;", - sticky_ids[n], CB_PREFIX_BASE, - sticky_ids[n]); - output_line ("\tcob_parm_%d = (cob_u8_ptr)&cob_parm_l_%d;", - sticky_ids[n], - sticky_ids[n]); - } else { - output_line ("\tcob_parm_%d = %s%d;", - sticky_ids[n], CB_PREFIX_BASE, - sticky_ids[n]); - } - } - if (cb_list_length(using_list) > 1) { - output_line ("\tbreak;"); - output_line ("}"); - } - } - - if (cb_sticky_linkage) { - s_prefix = "cob_parm_"; - } else { - s_prefix = CB_PREFIX_BASE; - } - - for (l2 = using_list; l2; l2 = CB_CHAIN (l2)) { - f2 = cb_code_field (CB_VALUE (l2)); - if (CB_PURPOSE_INT (l2) == CB_CALL_BY_VALUE - && (f2->usage == CB_USAGE_POINTER - || f2->usage == CB_USAGE_PROGRAM_POINTER)) { - output_line ("ptr_%d = %s%d;", - f2->id, s_prefix, f2->id); - } - } - - output_prefix (); - if (prog->flag_void) { - output ("(void)"); - } else { - output ("return "); - } - if (!prog->nested_level) { - output ("%s_ (%d", prog->program_id, progid); - } else { - output ("%s_%d_ (%d", prog->program_id, prog->toplev_count, progid); - } - - if (using_list || parameter_list) { - - /* Output parameter list for final function call. */ - for (l1 = parameter_list; l1; l1 = CB_CHAIN (l1)) { - f1 = cb_code_field (CB_VALUE (l1)); - n = 0; - for (l2 = using_list; l2; l2 = CB_CHAIN (l2), ++n) { - f2 = cb_code_field (CB_VALUE (l2)); - if (strcasecmp (f1->name, f2->name) == 0) { - switch (CB_PURPOSE_INT (l2)) { - case CB_CALL_BY_VALUE: - if (f2->usage == CB_USAGE_POINTER - || f2->usage == CB_USAGE_PROGRAM_POINTER) { - output (", (cob_u8_ptr)&ptr_%d", f2->id); - break; - } - /* Fall through */ - case CB_CALL_BY_REFERENCE: - case CB_CALL_BY_CONTENT: - output (", %s%s%d", - s_type[n], s_prefix, f2->id); - break; - default: - break; - } - break; - } - } - if (l2 == NULL) { - if (cb_sticky_linkage) { - output (", %s%d", - s_prefix, f1->id); - } else { - output (", NULL"); - } - } - } - } - output (");"); - output_newline (); - output_block_close (); - output_newline (); -} - -static void -output_function_prototypes (struct cb_program *prog) -{ - struct cb_program *cp; - struct cb_file *f; - cb_tree l; - - /* LCOV_EXCL_START */ - if (!prog) { - /* checked to keep the analyzer happy, TODO: real fix later */ - cobc_err_msg (_ ("call to '%s' with invalid parameter '%s'"), - "output_function_prototypes", "prog");; - COBC_ABORT (); - } - /* LCOV_EXCL_STOP */ - - output ("/* Function prototypes */"); - output_newline (); - output_newline (); - - for (cp = prog; cp; cp = cp->next_program) { - /* - Collect all items used as parameters in the PROCEDURE DIVISION - header and ENTRY statements in the parameter list. - */ - cb_tree entry; - for (entry = cp->entry_list; entry; entry = CB_CHAIN (entry)) { - cb_tree entry_param, prog_param; - for (entry_param = CB_VALUE (CB_VALUE (entry)); entry_param; - entry_param = CB_CHAIN (entry_param)) { - for (prog_param = cp->parameter_list; prog_param; - prog_param = CB_CHAIN (prog_param)) { - if (strcasecmp (cb_code_field (CB_VALUE (entry_param))->name, - cb_code_field (CB_VALUE (prog_param))->name) == 0) { - break; - } - } - if (prog_param == NULL) { - cp->parameter_list = cb_list_add (cp->parameter_list, CB_VALUE (entry_param)); - } - } - } - - if (cp->flag_main) { - /* Output prototype for main program wrapper. */ - if (!cp->flag_recursive) { - output ("static int\t\t%s ();", - cp->program_id); - } else { - output ("int\t\t\t%s ();", - cp->program_id); - } - output_newline (); -#if (defined(_WIN32) || defined(__CYGWIN__)) && !defined(__clang__) - for (l = cp->entry_list; l; l = CB_CHAIN (l)) { - const char * entry_name = CB_LABEL (CB_PURPOSE (l))->name; - if (0 == strcmp (entry_name, cp->program_id)) { - continue; - } - output_entry_function (cp, l, cp->parameter_list, 0); - } -#endif - } else { - /* Output implementation of other program wrapper. */ - if (likely(cp->prog_type == COB_MODULE_TYPE_PROGRAM)) { - for (l = cp->entry_list; l; l = CB_CHAIN (l)) { - output_entry_function (cp, l, cp->parameter_list, 0); - } - } else { - for (l = cp->entry_list; l; l = CB_CHAIN (l)) { - output_function_entry_function (cp, l, 0); - } - } - } - - /* Output prototype for the actual function */ - if (cp->prog_type == COB_MODULE_TYPE_FUNCTION) { - non_nested_count++; - output ("static cob_field\t*%s_ (const int", - cp->program_id); - } else if (!cp->nested_level) { - non_nested_count++; - output ("static int\t\t%s_ (const int", - cp->program_id); - } else { - output ("static int\t\t%s_%d_ (const int", - cp->program_id, cp->toplev_count); - } - - /* Output prototype parameters */ - if (!cp->flag_chained) { - for (l = cp->parameter_list; l; l = CB_CHAIN (l)) { - output (", cob_u8_t *"); - if (cb_sticky_linkage) { - output_storage ("static cob_u8_t\t\t\t*cob_parm_%d = NULL;\n", - cb_code_field (CB_VALUE (l))->id); - } - } - } - - output (");"); - output_newline (); - - /* prototype for file specific EXTFH function */ - for (l = prog->file_list; l; l = CB_CHAIN (l)) { - f = CB_FILE (CB_VALUE (l)); - /* FIXME: add to an external call chain instead, multiple files - may use the same but not-default function */ - if (f->extfh - && strcmp (prog->extfh, CB_CONST (f->extfh)->val) != 0 - && strcmp ("EXTFH", CB_CONST (f->extfh)->val) != 0) { - output_line ("extern int %s (unsigned char *opcode, FCD3 *fcd);", - CB_CONST (f->extfh)->val); - } - } - - /* prototype for module initialization */ - if (!cp->nested_level) { - output_line ("static void\t\t%s_module_init (cob_module *module);", - cp->program_id); - } else { - output_line ("static void\t\t%s_%d_module_init (cob_module *module);", - cp->program_id, cp->toplev_count); - } - - } - - /* prototype for general EXTFH function */ - if (prog->file_list && prog->extfh - && strcmp ("EXTFH", prog->extfh) != 0) { - output ("extern int %s (unsigned char *opcode, FCD3 *fcd);", prog->extfh); - output_newline (); - } - - output_newline (); -} - -static void -output_main_function (struct cb_program *prog) -{ - output_line ("/* Main function */"); - if (!cb_flag_winmain) { - output_line ("int"); - output_line ("main (int argc, char **argv)"); - output_block_open (); - output_line ("cob_init (argc, argv);"); - } else { - output_line ("int WINAPI"); - output_line ("WinMain (HINSTANCE hInstance, HINSTANCE hPrevInstance, PSTR pCmdLine, int nCmdShow)"); - output_block_open (); - output_line ("cob_init (__argc, __argv);"); - } - output_line ("cob_stop_run (%s ());", prog->program_id); - output_block_close (); - output_newline (); -} - -static void -output_header (const char *locbuff, const struct cb_program *cp) -{ - int i; - - if (!output_target) { - return; - } - - output_line ("/* Generated by cobc %s.%d */", - PACKAGE_VERSION, PATCH_LEVEL); - output_line ("/* Generated from %s */", cb_source_file); - if (*locbuff) { - output_line ("/* Generated at %s */", locbuff); - } - output_line ("/* GnuCOBOL build date %s */", cb_cobc_build_stamp); - output_line ("/* GnuCOBOL package date %s */", COB_TAR_DATE); - output ("/* Compile command "); - for (i = 0; i < cb_saveargc; i++) { - output ("%s ", cb_saveargv[i]); - } - output_line ("*/"); - output_newline (); - if (cp) { - output_line ("/* Program local variables for '%s' */", - cp->orig_program_id); - output_newline (); - } -} - -void -codegen (struct cb_program *prog, const char *translate_name, const int subsequent_call) -{ - cb_tree l; - struct literal_list *m; - struct cb_program *cp; - struct tm *loctime; - int i; - enum cb_optim optidx; - time_t sectime; - - int comment_gen; - - struct cb_report *rep; - - /* Clear local program stuff */ - current_prog = prog; - param_id = 0; - stack_id = 0; - num_cob_fields = 0; - progid = 0; - loop_counter = 0; - output_indent_level = 0; - last_line = 0; - needs_exit_prog = 0; - gen_custom = 0; - gen_nested_tab = 0; - gen_dynamic = 0; - local_mem = 0; - local_working_mem = 0; - need_save_exception = 0; - last_segment = 0; - last_section = NULL; - call_cache = NULL; - func_call_cache = NULL; - static_call_cache = NULL; - label_cache = NULL; - local_base_cache = NULL; - local_field_cache = NULL; - inside_check = 0; - for (i = 0; i < COB_INSIDE_SIZE; ++i) { - inside_stack[i] = 0; - } - excp_current_program_id = prog->orig_program_id; - excp_current_section = NULL; - excp_current_paragraph = NULL; - memset ((void *)i_counters, 0, sizeof (i_counters)); - - output_target = yyout; - output_name = (char *)translate_name; - cb_local_file = current_prog->local_include->local_fp; - - if (!subsequent_call) { - /* First iteration */ - output_line_number = 1; - if (strchr (output_name, '\\')) { - char buff[COB_MEDIUM_BUFF]; - int pos = 0; - char *s; - for (s = output_name; *s; s++) { - if (*s == '\\') { - buff[pos++] = '\\'; - } - buff[pos++] = *s; - } - buff[pos] = 0; - output_name = cobc_check_string (buff); - } - gen_alt_ebcdic = 0; - gen_ebcdic_ascii = 0; - gen_full_ebcdic = 0; - gen_native = 0; - gen_figurative = 0; - non_nested_count = 0; - working_mem = 0; - pic_cache = NULL; - base_cache = NULL; - globext_cache = NULL; - field_cache = NULL; - if (!string_buffer) { - string_buffer = cobc_main_malloc ((size_t)COB_MINI_BUFF); - } - - sectime = time (NULL); - loctime = localtime (§ime); - if (loctime) { - /* Leap seconds ? */ - if (loctime->tm_sec >= 60) { - loctime->tm_sec = 59; - } - strftime (string_buffer, (size_t)COB_MINI_MAX, - "%b %d %Y %H:%M:%S", loctime); - } else { - string_buffer[0] = 0; - } - output_header (string_buffer, NULL); - output_target = cb_storage_file; - output_header (string_buffer, NULL); - for (cp = prog; cp; cp = cp->next_program) { - output_target = cp->local_include->local_fp; - output_header (string_buffer, cp); - } - output_target = yyout; - - output_standard_includes (prog); - /* string_buffer has formatted date from above */ - output_gnucobol_defines (string_buffer, loctime); - - output_newline (); - output_line ("/* Global variables */"); - output ("#include \"%s\"", cb_storage_file_name); - output_newline (); - output_newline (); - - output_function_prototypes (prog); - } - - output_class_names (prog); - - /* Main function */ - if (prog->flag_main) { - output_main_function (prog); - } - - /* Functions */ - if (!subsequent_call) { - output ("/* Functions */"); - output_newline (); - output_newline (); - } - - if (prog->prog_type == COB_MODULE_TYPE_FUNCTION) { - output_line ("/* FUNCTION-ID '%s' */", prog->orig_program_id); - output_newline (); - for (l = prog->entry_list; l; l = CB_CHAIN (l)) { - output_function_entry_function (prog, l, 1); - } - } else { - output_line ("/* PROGRAM-ID '%s' */", prog->orig_program_id); - output_newline (); - for (l = prog->entry_list; l; l = CB_CHAIN (l)) { - output_entry_function (prog, l, prog->parameter_list, 1); - progid++; - } - } - - - output_internal_function (prog, prog->parameter_list); - - if (!prog->next_program) { - output_line ("/* End functions */"); - output_newline (); - } - - if (gen_native || gen_full_ebcdic || - gen_ebcdic_ascii || prog->alphabet_name_list) { - (void)lookup_attr (COB_TYPE_ALPHANUMERIC, 0, 0, 0, NULL, 0); - } - - output_target = cb_storage_file; - - /* Program local stuff */ - - output_call_cache (); - output_nested_call_table (prog); - - /* Report data fields */ - if (prog->report_storage) { - for (l = prog->report_list; l; l = CB_CHAIN (l)) { - if (!CB_VALUE (l)) { - continue; - } - rep = CB_REPORT_PTR (CB_VALUE(l)); - if (rep) { - compute_report_rcsz (rep->records); - } - } - } - - output_local_indexes (); - output_perform_times_counters (); - output_local_implicit_fields (); - output_debugging_fields (prog); - output_local_storage_pointer (prog); - output_call_parameter_stack_pointers (prog); - output_frame_stack (prog); - output_dynamic_field_function_id_pointers (); - - if (prog->report_storage) { - output_target = current_prog->local_include->local_fp; - for (l = prog->report_list; l; l = CB_CHAIN (l)) { - if (!CB_VALUE (l)) { - continue; - } - rep = CB_REPORT_PTR (CB_VALUE(l)); - if (rep) { - output_report_sum_control_field (rep->records); - } - } - } - - output_local_base_cache (); - output_local_field_cache (prog); - - /* Report data fields */ - if (prog->report_storage) { - comment_gen = 0; - for (l = prog->report_list; l; l = CB_CHAIN (l)) { - if (!CB_VALUE (l)) { - continue; - } - rep = CB_REPORT_PTR (CB_VALUE(l)); - if (rep) { - if (!comment_gen) { - comment_gen = 1; - output_target = current_prog->local_include->local_fp; - output_local ("\n/* Report data fields */\n\n"); - } - output_emit_field (rep->line_counter ,NULL); - output_emit_field (rep->page_counter, NULL); - report_col_pos = 1; - output_report_data (rep->records); - output_local ("\n"); - } - } - if (comment_gen) { - output_local ("\n"); - output_target = cb_storage_file; - } - } - - /* Reports */ - if (prog->report_list) { - /* Switch to local storage file */ - output_target = current_prog->local_include->local_fp; - optimize_defs[COB_SET_REPORT] = 1; - output_local ("\n/* Reports */\n"); - output_report_list(prog->report_list, CB_CHAIN (prog->report_list)); - output_local ("\n/* End of Reports */\n"); - /* Switch to main storage file */ - output_target = cb_storage_file; - } - - /* Skip to next program contained in the source and - adjust current_program used for error messages */ - - if (prog->next_program) { - cp = current_program; - current_program = prog->next_program; - if (cp->flag_file_global && current_program->nested_level) { - has_global_file = 1; - } else { - has_global_file = 0; - } - codegen (prog->next_program, output_name, 1); - current_program = cp; - return; - } - - /* Finalize the main include file */ - - if (!cobc_flag_main && non_nested_count > 1) { - output_storage ("\n/* Module reference count */\n"); - output_storage ("static unsigned int\t\tcob_reference_count = 0;\n"); - } - - output_storage ("\n/* Module path */\n"); - output_storage ("static const char\t\t*cob_module_path = NULL;\n"); - - output_globext_cache (); - output_nonlocal_base_cache (); - output_pic_cache (); - output_attributes (); - output_nonlocal_field_cache (); - output_literals_figuratives_and_constants (); - output_collating_tables (); - output_string_cache (); - output_source_cache (); - - /* Optimizer output */ - for (optidx = COB_OPTIM_MIN; optidx < COB_OPTIM_MAX; ++optidx) { - if (optimize_defs[optidx]) { - cob_gen_optim (optidx); - output_storage ("\n"); - } - } - - comment_gen = 0; - for (m = literal_cache; m; m = m->next) { - if (CB_TREE_CLASS (m->x) == CB_CLASS_NUMERIC - && m->make_decimal) { - if (!comment_gen) { - comment_gen = 1; - output_storage ("\n/* Decimal constants */\n"); - } - output_storage ("static\tcob_decimal\t%s%d;\n", CB_PREFIX_DEC_FIELD,m->id); - output_storage ("static\tcob_decimal\t*%s%d = NULL;\n", CB_PREFIX_DEC_CONST,m->id); - } - } - if (comment_gen) { - output_storage ("\n"); - } - - /* Clean up by clearing these */ - attr_cache = NULL; - literal_cache = NULL; - string_cache = NULL; - string_id = 1; - source_cache = NULL; - source_id = 1; -} diff -Nru gnucobol-4.0~early~20200606/cobc/codeoptim.c gnucobol-5/cobc/codeoptim.c --- gnucobol-4.0~early~20200606/cobc/codeoptim.c 2020-06-06 20:51:59.000000000 +0000 +++ gnucobol-5/cobc/codeoptim.c 1970-01-01 00:00:00.000000000 +0000 @@ -1,2766 +0,0 @@ -/* - Copyright (C) 2006-2012, 2013, 2017-2018 Free Software Foundation, Inc. - Written by Roger While, Ron Norman - - This file is part of GnuCOBOL. - - The GnuCOBOL compiler is free software: you can redistribute it - and/or modify it under the terms of the GNU General Public License - as published by the Free Software Foundation, either version 3 of the - License, or (at your option) any later version. - - GnuCOBOL is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with GnuCOBOL. If not, see . -*/ - -#include - -#include -#include -#include -#include -#include -#include - -#include "cobc.h" -#include "tree.h" - -#ifdef COB_NO_UNALIGNED_ATTRIBUTE -#define UNALIGNED_ATTRIBUTE "" -#else -#define UNALIGNED_ATTRIBUTE "__unaligned " -#endif - -static void -output_storage (const char *fmt, ...) -{ - va_list ap; - - if (cb_storage_file) { - va_start (ap, fmt); - vfprintf (cb_storage_file, fmt, ap); - va_end (ap); - fputc ('\n', cb_storage_file); - } -} - -void -cob_gen_optim (const enum cb_optim val) -{ - output_storage (""); - switch (val) { - - case COB_SET_SCREEN: - output_storage ("static void COB_NOINLINE"); - output_storage ("cob_set_screen (cob_screen *s, cob_screen *next,"); - output_storage (" cob_screen *prev, cob_screen *child, cob_screen *parent,"); - output_storage (" cob_field *field, cob_field *value,"); - output_storage (" cob_field *line, cob_field *column,"); - output_storage (" cob_field *foreg, cob_field *backg, cob_field *prompt,"); - output_storage (" const int type, const int occurs, const int attr)"); - output_storage ("{"); - output_storage (" s->next = next;"); - output_storage (" s->prev = prev;"); - output_storage (" s->child = child;"); - output_storage (" s->parent = parent;"); - output_storage (" s->field = field;"); - output_storage (" s->value = value;"); - output_storage (" s->line = line;"); - output_storage (" s->column = column;"); - output_storage (" s->foreg = foreg;"); - output_storage (" s->backg = backg;"); - output_storage (" s->prompt = prompt;"); - output_storage (" s->type = type;"); - output_storage (" s->occurs = occurs;"); - output_storage (" s->attr = attr;"); - output_storage ("}"); - return; - - case COB_SET_REPORT: - output_storage ("static void COB_NOINLINE"); - output_storage ("cob_set_report (cob_report *r, cob_file *pfile)"); - output_storage ("{"); - output_storage (" r->report_file = pfile;"); - output_storage ("}"); - return; - - case COB_SET_ML_TREE: - output_storage ("static void COB_NOINLINE"); - output_storage ("cob_set_ml_attr (cob_ml_attr *attr, cob_field *name,"); - output_storage (" cob_field *value, unsigned int is_suppressed,"); - output_storage (" cob_ml_attr *sibling)"); - output_storage ("{"); - output_storage (" attr->name = name;"); - output_storage (" attr->value = value;"); - output_storage (" attr->is_suppressed = is_suppressed;"); - output_storage (" attr->sibling = sibling;"); - output_storage ("}"); - output_storage ("static void COB_NOINLINE"); - output_storage ("cob_set_ml_tree (cob_ml_tree *tree, cob_field *name, cob_ml_attr *attrs,"); - output_storage (" cob_field *content, unsigned int is_suppressed,"); - output_storage (" cob_ml_tree *children, cob_ml_tree *sibling)"); - output_storage ("{"); - output_storage (" tree->name = name;"); - output_storage (" tree->attrs = attrs;"); - output_storage (" tree->content = content;"); - output_storage (" tree->is_suppressed = is_suppressed;"); - output_storage (" tree->children = children;"); - output_storage (" tree->sibling = sibling;"); - output_storage ("}"); - return; - - case COB_POINTER_MANIP: - output_storage ("static void COB_NOINLINE"); - output_storage ("cob_pointer_manip (void *f1, cob_field *f2, const unsigned int addsub)"); - output_storage ("{"); - output_storage (" unsigned char *tmptr;"); - output_storage (" memcpy (&tmptr, f1, sizeof(unsigned char *));"); - output_storage (" if (addsub) {"); - output_storage (" tmptr -= cob_get_int (f2);"); - output_storage (" } else {"); - output_storage (" tmptr += cob_get_int (f2);"); - output_storage (" }"); - output_storage (" memcpy (f1, &tmptr, sizeof(unsigned char *));"); - output_storage ("}"); - return; - - case COB_GET_NUMDISP: - output_storage ("static int COB_INLINE COB_A_INLINE"); - output_storage ("cob_get_numdisp (const void *data, const int size)"); - output_storage ("{"); - output_storage (" register const unsigned char *p;"); - output_storage (" register int n;"); - output_storage (" register int retval = 0;"); - output_storage (" p = (const unsigned char *)data;"); - output_storage (" for (n = 0; n < size; ++n, ++p) {"); - output_storage (" if (*p > '0' && *p <= '9')"); - output_storage (" break;"); - output_storage (" }"); - output_storage (" for (; n < size; ++n, ++p) {"); - output_storage (" retval = (retval * 10)"); - output_storage (" + ((*p > '0' && *p <= '9') ? (*p - '0') : 0);"); - output_storage (" }"); - output_storage (" return retval;"); - output_storage ("}"); - return; - - case COB_GET_NUMDISPS: - output_storage ("static int COB_INLINE COB_A_INLINE"); - output_storage ("cob_get_numdisps (const void *data, const int size)"); - output_storage ("{"); - output_storage (" register const unsigned char *p;"); - output_storage (" register int n;"); - output_storage (" register int retval = 0;"); - output_storage (" p = (const unsigned char *)data;"); - output_storage (" for (n = 0; n < size-1; ++n, ++p) {"); - output_storage (" if (*p > '0' && *p <= '9')"); - output_storage (" break;"); - output_storage (" }"); - output_storage (" for (; n < size; ++n, ++p) {"); - output_storage (" retval *= 10;"); - output_storage (" if (*p > '0' && *p <= '9') {"); - output_storage (" retval += (*p - '0');"); - output_storage (" } else if ((*p & 0x40) && (n + 1) == size) {"); - output_storage (" retval += (*p & 0x0F);"); - output_storage (" retval = -retval;"); - output_storage (" }"); - output_storage (" }"); - output_storage (" return retval;"); - output_storage ("}"); - return; - - case COB_GET_NUMDISP64: - output_storage ("static cob_s64_t COB_INLINE COB_A_INLINE"); - output_storage ("cob_get_numdisp64 (const void *data, const int size)"); - output_storage ("{"); - output_storage (" register const unsigned char *p;"); - output_storage (" register int n;"); - output_storage (" register cob_s64_t retval = 0;"); - output_storage (" p = (const unsigned char *)data;"); - output_storage (" for (n = 0; n < size; ++n, ++p) {"); - output_storage (" if (*p > '0' && *p <= '9')"); - output_storage (" break;"); - output_storage (" }"); - output_storage (" for (; n < size; ++n, ++p) {"); - output_storage (" retval = (retval * 10)"); - output_storage (" + ((*p > '0' && *p <= '9') ? (*p - '0') : 0);"); - output_storage (" }"); - output_storage (" return retval;"); - output_storage ("}"); - return; - - case COB_GET_NUMDISPS64: - output_storage ("static cob_s64_t COB_INLINE COB_A_INLINE"); - output_storage ("cob_get_numdisps64 (const void *data, const int size)"); - output_storage ("{"); - output_storage (" register const unsigned char *p;"); - output_storage (" register cob_s64_t n;"); - output_storage (" register cob_s64_t retval = 0;"); - output_storage (" p = (const unsigned char *)data;"); - output_storage (" for (n = 0; n < size-1; ++n, ++p) {"); - output_storage (" if (*p > '0' && *p <= '9')"); - output_storage (" break;"); - output_storage (" }"); - output_storage (" for (; n < size; ++n, ++p) {"); - output_storage (" retval *= 10;"); - output_storage (" if (*p > '0' && *p <= '9') {"); - output_storage (" retval += (*p - '0');"); - output_storage (" } else if ((*p & 0x40) && (n + 1) == size) {"); - output_storage (" retval += (*p & 0x0F);"); - output_storage (" retval = -retval;"); - output_storage (" }"); - output_storage (" }"); - output_storage (" return retval;"); - output_storage ("}"); - return; - - case COB_CMP_PACKED_INT: - output_storage ("static int COB_NOINLINE"); - output_storage ("cob_cmp_packed_int (const cob_field *f, const cob_s64_t n)"); - output_storage ("{"); - output_storage (" unsigned char *p;"); - output_storage (" size_t size;"); - output_storage (" cob_s64_t val;"); - - output_storage (" val = 0;"); - output_storage (" p = f->data;"); - output_storage (" for (size = 0; size < f->size - 1; ++size, ++p) {"); - output_storage (" val *= 10;"); - output_storage (" val += *p >> 4;"); - output_storage (" val *= 10;"); - output_storage (" val += *p & 0x0f;"); - output_storage (" }"); - output_storage (" val *= 10;"); - output_storage (" val += *p >> 4;"); - output_storage (" if ((*p & 0x0f) == 0x0d) {"); - output_storage (" val = -val;"); - output_storage (" }"); - output_storage (" return (val < n) ? -1 : (val > n);"); - output_storage ("}"); - return; - - case COB_GET_PACKED_INT: - output_storage ("static int COB_NOINLINE"); - output_storage ("cob_get_packed_int (const cob_field *f)"); - output_storage ("{"); - output_storage (" unsigned char *p;"); - output_storage (" size_t size;"); - output_storage (" int val = 0;"); - - output_storage (" p = f->data;"); - output_storage (" for (size = 0; size < f->size - 1; ++size, ++p) {"); - output_storage (" val *= 10;"); - output_storage (" val += *p >> 4;"); - output_storage (" val *= 10;"); - output_storage (" val += *p & 0x0f;"); - output_storage (" }"); - output_storage (" val *= 10;"); - output_storage (" val += *p >> 4;"); - output_storage (" if ((*p & 0x0f) == 0x0d) {"); - output_storage (" val = -val;"); - output_storage (" }"); - output_storage (" return val;"); - output_storage ("}"); - return; - - case COB_ADD_PACKED_INT: - output_storage ("static int COB_NOINLINE"); - output_storage ("cob_add_packed_int (cob_field *f, const int val)"); - output_storage ("{"); - output_storage (" unsigned char *p;"); - output_storage (" size_t size;"); - output_storage (" int carry = 0;"); - output_storage (" int n;"); - output_storage (" int inc;"); - - output_storage (" if (val == 0) {"); - output_storage (" return 0;"); - output_storage (" }"); - output_storage (" p = f->data + f->size - 1;"); - output_storage (" if ((*p & 0x0f) == 0x0d) {"); - output_storage (" if (val > 0) {"); - output_storage (" return cob_add_int (f, val, 0);"); - output_storage (" }"); - output_storage (" n = -val;"); - output_storage (" } else {"); - output_storage (" if (val < 0) {"); - output_storage (" return cob_add_int (f, val, 0);"); - output_storage (" }"); - output_storage (" n = val;"); - output_storage (" }"); - output_storage (" inc = (*p >> 4) + (n %% 10);"); - output_storage (" n /= 10;"); - output_storage (" carry = inc / 10;"); - output_storage (" *p = ((inc %% 10) << 4) | (*p & 0x0f);"); - output_storage (" p--;"); - - output_storage (" for (size = 0; size < f->size - 1; ++size, --p) {"); - output_storage (" if (!carry && !n) {"); - output_storage (" break;"); - output_storage (" }"); - output_storage (" inc = ((*p >> 4) * 10) + (*p & 0x0f) + carry + (n %% 100);"); - output_storage (" carry = inc / 100;"); - output_storage (" n /= 100;"); - output_storage (" inc %%= 100;"); - output_storage (" *p = ((inc / 10) << 4) | (inc %% 10);"); - output_storage (" }"); - output_storage (" return 0;"); - output_storage ("}"); - return; - - /* Aligned variants */ - - /* Aligned compares */ - - case COB_CMP_ALIGN_U16: - output_storage ("static COB_INLINE COB_A_INLINE int"); - output_storage ("cob_cmp_align_u16 (const void *p, const cob_s64_t n)"); - output_storage ("{"); - output_storage (" unsigned short val;"); - - output_storage (" if (unlikely(n < 0)) {"); - output_storage (" return 1;"); - output_storage (" }"); - -#ifdef COB_ALLOW_UNALIGNED - output_storage (" val = *(unsigned short " UNALIGNED_ATTRIBUTE "*)p;"); -#else - output_storage (" optim_memcpy ((void*)&val,p,sizeof(unsigned short));"); -#endif - output_storage (" return (val < n) ? -1 : (val > n);"); - output_storage ("}"); - return; - - case COB_CMP_ALIGN_S16: - output_storage ("static COB_INLINE COB_A_INLINE int"); - output_storage ("cob_cmp_align_s16 (const void *p, const cob_s64_t n)"); - output_storage ("{"); - output_storage (" short val;"); - -#ifdef COB_ALLOW_UNALIGNED - output_storage (" val = *(short " UNALIGNED_ATTRIBUTE "*)p;"); -#else - output_storage (" optim_memcpy ((void*)&val,p,sizeof(short));"); -#endif - output_storage (" return (val < n) ? -1 : (val > n);"); - output_storage ("}"); - return; - - case COB_CMP_ALIGN_U32: - output_storage ("static COB_INLINE COB_A_INLINE int"); - output_storage ("cob_cmp_align_u32 (const void *p, const cob_s64_t n)"); - output_storage ("{"); - output_storage (" unsigned int val;"); - - output_storage (" if (unlikely(n < 0)) {"); - output_storage (" return 1;"); - output_storage (" }"); - -#ifdef COB_ALLOW_UNALIGNED - output_storage (" val = *(unsigned int " UNALIGNED_ATTRIBUTE "*)p;"); -#else - output_storage (" optim_memcpy ((void*)&val,p,sizeof(unsigned int));"); -#endif - output_storage (" return (val < n) ? -1 : (val > n);"); - output_storage ("}"); - return; - - case COB_CMP_ALIGN_S32: - output_storage ("static COB_INLINE COB_A_INLINE int"); - output_storage ("cob_cmp_align_s32 (const void *p, const cob_s64_t n)"); - output_storage ("{"); - output_storage (" int val;"); - -#ifdef COB_ALLOW_UNALIGNED - output_storage (" val = *(int " UNALIGNED_ATTRIBUTE "*)p;"); -#else - output_storage (" optim_memcpy ((void*)&val,p,sizeof(int));"); -#endif - output_storage (" return (val < n) ? -1 : (val > n);"); - output_storage ("}"); - return; - - case COB_CMP_ALIGN_U64: - output_storage ("static COB_INLINE COB_A_INLINE int"); - output_storage ("cob_cmp_align_u64 (const void *p, const cob_u64_t n)"); - output_storage ("{"); - output_storage (" cob_u64_t val;"); - -#ifdef COB_ALLOW_UNALIGNED - output_storage (" val = *(cob_u64_t " UNALIGNED_ATTRIBUTE "*)p;"); -#else - output_storage (" optim_memcpy ((void*)&val,p,sizeof(cob_u64_t));"); -#endif - output_storage (" return (val < n) ? -1 : (val > n);"); - output_storage ("}"); - return; - - case COB_CMP_ALIGN_S64: - output_storage ("static COB_INLINE COB_A_INLINE int"); - output_storage ("cob_cmp_align_s64 (const void *p, const cob_s64_t n)"); - output_storage ("{"); - output_storage (" cob_s64_t val;"); - -#ifdef COB_ALLOW_UNALIGNED - output_storage (" val = *(cob_s64_t " UNALIGNED_ATTRIBUTE "*)p;"); -#else - output_storage (" optim_memcpy((void*)&val,p,sizeof(cob_s64_t));"); -#endif - output_storage (" return (val < n) ? -1 : (val > n);"); - output_storage ("}"); - return; - - /* Aligned adds */ - - case COB_ADD_ALIGN_U16: - output_storage ("static COB_INLINE COB_A_INLINE void"); - output_storage ("cob_add_align_u16 (void *p, const int val)"); - output_storage ("{"); - output_storage (" *(unsigned short " UNALIGNED_ATTRIBUTE "*)p += val;"); - output_storage ("}"); - return; - - case COB_ADD_ALIGN_S16: - output_storage ("static COB_INLINE COB_A_INLINE void"); - output_storage ("cob_add_align_s16 (void *p, const int val)"); - output_storage ("{"); - output_storage (" *(short " UNALIGNED_ATTRIBUTE "*)p += val;"); - output_storage ("}"); - return; - - case COB_ADD_ALIGN_U32: - output_storage ("static COB_INLINE COB_A_INLINE void"); - output_storage ("cob_add_align_u32 (void *p, const int val)"); - output_storage ("{"); - output_storage (" *(unsigned int " UNALIGNED_ATTRIBUTE "*)p += val;"); - output_storage ("}"); - return; - - case COB_ADD_ALIGN_S32: - output_storage ("static COB_INLINE COB_A_INLINE void"); - output_storage ("cob_add_align_s32 (void *p, const int val)"); - output_storage ("{"); - output_storage (" *(int " UNALIGNED_ATTRIBUTE "*)p += val;"); - output_storage ("}"); - return; - - case COB_ADD_ALIGN_U64: - output_storage ("static COB_INLINE COB_A_INLINE void"); - output_storage ("cob_add_align_u64 (void *p, const int val)"); - output_storage ("{"); - output_storage (" *(cob_u64_t " UNALIGNED_ATTRIBUTE "*)p += val;"); - output_storage ("}"); - return; - - case COB_ADD_ALIGN_S64: - output_storage ("static COB_INLINE COB_A_INLINE void"); - output_storage ("cob_add_align_s64 (void *p, const int val)"); - output_storage ("{"); - output_storage (" *(cob_s64_t " UNALIGNED_ATTRIBUTE "*)p += val;"); - output_storage ("}"); - return; - - /* Aligned subtracts */ - - case COB_SUB_ALIGN_U16: - output_storage ("static COB_INLINE COB_A_INLINE void"); - output_storage ("cob_sub_align_u16 (void *p, const int val)"); - output_storage ("{"); - output_storage (" *(unsigned short " UNALIGNED_ATTRIBUTE "*)p -= val;"); - output_storage ("}"); - return; - - case COB_SUB_ALIGN_S16: - output_storage ("static COB_INLINE COB_A_INLINE void"); - output_storage ("cob_sub_align_s16 (void *p, const int val)"); - output_storage ("{"); - output_storage (" *(short " UNALIGNED_ATTRIBUTE "*)p -= val;"); - output_storage ("}"); - return; - - case COB_SUB_ALIGN_U32: - output_storage ("static COB_INLINE COB_A_INLINE void"); - output_storage ("cob_sub_align_u32 (void *p, const int val)"); - output_storage ("{"); - output_storage (" *(unsigned int " UNALIGNED_ATTRIBUTE "*)p -= val;"); - output_storage ("}"); - return; - - case COB_SUB_ALIGN_S32: - output_storage ("static COB_INLINE COB_A_INLINE void"); - output_storage ("cob_sub_align_s32 (void *p, const int val)"); - output_storage ("{"); - output_storage (" *(int " UNALIGNED_ATTRIBUTE "*)p -= val;"); - output_storage ("}"); - return; - - case COB_SUB_ALIGN_U64: - output_storage ("static COB_INLINE COB_A_INLINE void"); - output_storage ("cob_sub_align_u64 (void *p, const int val)"); - output_storage ("{"); - output_storage (" *(cob_u64_t " UNALIGNED_ATTRIBUTE "*)p -= val;"); - output_storage ("}"); - return; - - case COB_SUB_ALIGN_S64: - output_storage ("static COB_INLINE COB_A_INLINE void"); - output_storage ("cob_sub_align_s64 (void *p, const int val)"); - output_storage ("{"); - output_storage (" *(cob_s64_t " UNALIGNED_ATTRIBUTE "*)p -= val;"); - output_storage ("}"); - return; - - case COB_CMPSWP_ALIGN_U16: - output_storage ("static COB_INLINE COB_A_INLINE int"); - output_storage ("cob_cmpswp_align_u16 (const void *p, const cob_s64_t n)"); - output_storage ("{"); - output_storage (" unsigned short val;"); - - output_storage (" if (unlikely(n < 0)) {"); - output_storage (" return 1;"); - output_storage (" }"); - output_storage (" val = COB_BSWAP_16 (*(unsigned short " UNALIGNED_ATTRIBUTE "*)p);"); - output_storage (" return (val < n) ? -1 : (val > n);"); - output_storage ("}"); - return; - - case COB_CMPSWP_ALIGN_S16: - output_storage ("static COB_INLINE COB_A_INLINE int"); - output_storage ("cob_cmpswp_align_s16 (const void *p, const cob_s64_t n)"); - output_storage ("{"); - output_storage (" short val;"); - - output_storage (" val = COB_BSWAP_16 (*(short " UNALIGNED_ATTRIBUTE "*)p);"); - output_storage (" return (val < n) ? -1 : (val > n);"); - output_storage ("}"); - return; - - case COB_CMPSWP_ALIGN_U32: - output_storage ("static COB_INLINE COB_A_INLINE int"); - output_storage ("cob_cmpswp_align_u32 (const void *p, const cob_s64_t n)"); - output_storage ("{"); - output_storage (" unsigned int val;"); - - output_storage (" if (unlikely(n < 0)) {"); - output_storage (" return 1;"); - output_storage (" }"); - output_storage (" val = COB_BSWAP_32 (*(unsigned int " UNALIGNED_ATTRIBUTE "*)p);"); - output_storage (" return (val < n) ? -1 : (val > n);"); - output_storage ("}"); - return; - - case COB_CMPSWP_ALIGN_S32: - output_storage ("static COB_INLINE COB_A_INLINE int"); - output_storage ("cob_cmpswp_align_s32 (const void *p, const cob_s64_t n)"); - output_storage ("{"); - output_storage (" int val;"); - - output_storage (" val = COB_BSWAP_32 (*(int " UNALIGNED_ATTRIBUTE "*)p);"); - output_storage (" return (val < n) ? -1 : (val > n);"); - output_storage ("}"); - return; - - case COB_CMPSWP_ALIGN_U64: - output_storage ("static COB_INLINE COB_A_INLINE int"); - output_storage ("cob_cmpswp_align_u64 (const void *p, const cob_s64_t n)"); - output_storage ("{"); - output_storage (" cob_u64_t val;"); - - output_storage (" if (unlikely(n < 0)) {"); - output_storage (" return 1;"); - output_storage (" }"); - output_storage (" val = COB_BSWAP_64 (*(cob_u64_t " UNALIGNED_ATTRIBUTE "*)p);"); - output_storage (" return (val < n) ? -1 : (val > n);"); - output_storage ("}"); - return; - - case COB_CMPSWP_ALIGN_S64: - output_storage ("static COB_INLINE COB_A_INLINE int"); - output_storage ("cob_cmpswp_align_s64 (const void *p, const cob_s64_t n)"); - output_storage ("{"); - output_storage (" cob_s64_t val;"); - - output_storage (" val = COB_BSWAP_64 (*(cob_s64_t " UNALIGNED_ATTRIBUTE "*)p);"); - output_storage (" return (val < n) ? -1 : (val > n);"); - output_storage ("}"); - return; - - /* Binary compare */ - - case COB_CMP_U8: - output_storage ("static COB_INLINE COB_A_INLINE int"); - output_storage ("cob_cmp_u8 (const void *p, const cob_s64_t n)"); - output_storage ("{"); - output_storage (" if (unlikely(n < 0)) {"); - output_storage (" return 1;"); - output_storage (" }"); - output_storage (" return (*(const unsigned char *)p < n) ? -1 : (*(const unsigned char *)p > n);"); - output_storage ("}"); - return; - - case COB_CMP_S8: - output_storage ("static COB_INLINE COB_A_INLINE int"); - output_storage ("cob_cmp_s8 (const void *p, const cob_s64_t n)"); - output_storage ("{"); - output_storage (" return (*(const signed char *)p < n) ? -1 : (*(const signed char *)p > n);"); - output_storage ("}"); - return; - - case COB_CMP_U16: - output_storage ("static COB_INLINE COB_A_INLINE int"); - output_storage ("cob_cmp_u16 (const void *p, const cob_s64_t n)"); - output_storage ("{"); -#ifndef COB_ALLOW_UNALIGNED - output_storage (" void *x;"); -#endif - output_storage (" unsigned short val;"); - - output_storage (" if (unlikely(n < 0)) {"); - output_storage (" return 1;"); - output_storage (" }"); -#ifdef COB_ALLOW_UNALIGNED - output_storage (" val = *(const unsigned short " UNALIGNED_ATTRIBUTE "*)p;"); -#else - output_storage (" x = &val;"); - output_storage (" optim_memcpy (x, p, 2);"); -#endif - output_storage (" return (val < n) ? -1 : (val > n);"); - output_storage ("}"); - return; - - case COB_CMP_S16: - output_storage ("static COB_INLINE COB_A_INLINE int"); - output_storage ("cob_cmp_s16 (const void *p, const cob_s64_t n)"); - output_storage ("{"); - output_storage (" short val;"); - -#ifdef COB_ALLOW_UNALIGNED - output_storage (" val = *(const short " UNALIGNED_ATTRIBUTE "*)p;"); -#else - output_storage (" void *x;"); - - output_storage (" x = &val;"); - output_storage (" optim_memcpy (x, p, 2);"); -#endif - output_storage (" return (val < n) ? -1 : (val > n);"); - output_storage ("}"); - return; - - case COB_CMP_U24: - output_storage ("static COB_INLINE COB_A_INLINE int"); - output_storage ("cob_cmp_u24 (const void *p, const cob_s64_t n)"); - output_storage ("{"); - output_storage (" unsigned char *x;"); - output_storage (" unsigned int val = 0;"); - - output_storage (" if (unlikely(n < 0)) {"); - output_storage (" return 1;"); - output_storage (" }"); -#ifdef WORDS_BIGENDIAN - output_storage (" x = ((unsigned char *)&val) + 1;"); -#else - output_storage (" x = (unsigned char *)&val;"); -#endif - output_storage (" optim_memcpy (x, p, 3);"); - output_storage (" return (val < n) ? -1 : (val > n);"); - output_storage ("}"); - return; - - case COB_CMP_S24: - output_storage ("static COB_INLINE COB_A_INLINE int"); - output_storage ("cob_cmp_s24 (const void *p, const cob_s64_t n)"); - output_storage ("{"); - output_storage (" unsigned char *x;"); - output_storage (" int val = 0;"); - -#ifdef WORDS_BIGENDIAN - output_storage (" x = (unsigned char *)&val;"); -#else - output_storage (" x = ((unsigned char *)&val) + 1;"); -#endif - output_storage (" optim_memcpy (x, p, 3);"); - output_storage (" val >>= 8; /* Shift with sign */"); - output_storage (" return (val < n) ? -1 : (val > n);"); - output_storage ("}"); - return; - - case COB_CMP_U32: - output_storage ("static COB_INLINE COB_A_INLINE int"); - output_storage ("cob_cmp_u32 (const void *p, const cob_s64_t n)"); - output_storage ("{"); -#ifndef COB_ALLOW_UNALIGNED - output_storage (" void *x;"); -#endif - output_storage (" unsigned int val;"); - - output_storage (" if (unlikely(n < 0)) {"); - output_storage (" return 1;"); - output_storage (" }"); -#ifdef COB_ALLOW_UNALIGNED - output_storage (" val = *(const unsigned int " UNALIGNED_ATTRIBUTE "*)p;"); -#else - output_storage (" x = &val;"); - output_storage (" optim_memcpy (x, p, 4);"); -#endif - output_storage (" return (val < n) ? -1 : (val > n);"); - output_storage ("}"); - return; - - case COB_CMP_S32: - output_storage ("static COB_INLINE COB_A_INLINE int"); - output_storage ("cob_cmp_s32 (const void *p, const cob_s64_t n)"); - output_storage ("{"); - output_storage (" int val;"); - -#ifdef COB_ALLOW_UNALIGNED - output_storage (" val = *(const int " UNALIGNED_ATTRIBUTE "*)p;"); -#else - output_storage (" void *x;"); - - output_storage (" x = &val;"); - output_storage (" optim_memcpy (x, p, 4);"); -#endif - output_storage (" return (val < n) ? -1 : (val > n);"); - output_storage ("}"); - return; - - case COB_CMP_U40: - output_storage ("static COB_INLINE COB_A_INLINE int"); - output_storage ("cob_cmp_u40 (const void *p, const cob_s64_t n)"); - output_storage ("{"); - output_storage (" cob_u64_t val = 0;"); - output_storage (" unsigned char *x;"); - - output_storage (" if (unlikely(n < 0)) {"); - output_storage (" return 1;"); - output_storage (" }"); -#ifdef WORDS_BIGENDIAN - output_storage (" x = ((unsigned char *)&val) + 3;"); -#else - output_storage (" x = (unsigned char *)&val;"); -#endif - output_storage (" optim_memcpy (x, p, 5);"); - output_storage (" return (val < n) ? -1 : (val > n);"); - output_storage ("}"); - return; - - case COB_CMP_S40: - output_storage ("static COB_INLINE COB_A_INLINE int"); - output_storage ("cob_cmp_s40 (const void *p, const cob_s64_t n)"); - output_storage ("{"); - output_storage (" cob_s64_t val = 0;"); - output_storage (" unsigned char *x;"); - -#ifdef WORDS_BIGENDIAN - output_storage (" x = (unsigned char *)&val;"); -#else - output_storage (" x = ((unsigned char *)&val) + 3;"); -#endif - output_storage (" optim_memcpy (x, p, 5);"); - output_storage (" val >>= 24; /* Shift with sign */"); - output_storage (" return (val < n) ? -1 : (val > n);"); - output_storage ("}"); - return; - - case COB_CMP_U48: - output_storage ("static COB_INLINE COB_A_INLINE int"); - output_storage ("cob_cmp_u48 (const void *p, const cob_s64_t n)"); - output_storage ("{"); - output_storage (" cob_u64_t val = 0;"); - output_storage (" unsigned char *x;"); - - output_storage (" if (unlikely(n < 0)) {"); - output_storage (" return 1;"); - output_storage (" }"); -#ifdef WORDS_BIGENDIAN - output_storage (" x = ((unsigned char *)&val) + 2;"); -#else - output_storage (" x = (unsigned char *)&val;"); -#endif - output_storage (" optim_memcpy (x, p, 6);"); - output_storage (" return (val < n) ? -1 : (val > n);"); - output_storage ("}"); - return; - - case COB_CMP_S48: - output_storage ("static COB_INLINE COB_A_INLINE int"); - output_storage ("cob_cmp_s48 (const void *p, const cob_s64_t n)"); - output_storage ("{"); - output_storage (" cob_s64_t val = 0;"); - output_storage (" unsigned char *x;"); - -#ifdef WORDS_BIGENDIAN - output_storage (" x = (unsigned char *)&val;"); -#else - output_storage (" x = ((unsigned char *)&val) + 2;"); -#endif - output_storage (" optim_memcpy (x, p, 6);"); - output_storage (" val >>= 16; /* Shift with sign */"); - output_storage (" return (val < n) ? -1 : (val > n);"); - output_storage ("}"); - return; - - case COB_CMP_U56: - output_storage ("static COB_INLINE COB_A_INLINE int"); - output_storage ("cob_cmp_u56 (const void *p, const cob_s64_t n)"); - output_storage ("{"); - output_storage (" cob_u64_t val = 0;"); - output_storage (" unsigned char *x;"); - - output_storage (" if (unlikely(n < 0)) {"); - output_storage (" return 1;"); - output_storage (" }"); -#ifdef WORDS_BIGENDIAN - output_storage (" x = ((unsigned char *)&val) + 1;"); -#else - output_storage (" x = (unsigned char *)&val;"); -#endif - output_storage (" optim_memcpy (x, p, 7);"); - output_storage (" return (val < n) ? -1 : (val > n);"); - output_storage ("}"); - return; - - case COB_CMP_S56: - output_storage ("static COB_INLINE COB_A_INLINE int"); - output_storage ("cob_cmp_s56 (const void *p, const cob_s64_t n)"); - output_storage ("{"); - output_storage (" cob_s64_t val = 0;"); - output_storage (" unsigned char *x;"); - -#ifdef WORDS_BIGENDIAN - output_storage (" x = (unsigned char *)&val;"); -#else - output_storage (" x = ((unsigned char *)&val) + 1;"); -#endif - output_storage (" optim_memcpy (x, p, 7);"); - output_storage (" val >>= 8; /* Shift with sign */"); - output_storage (" return (val < n) ? -1 : (val > n);"); - output_storage ("}"); - return; - - case COB_CMP_U64: - output_storage ("static COB_INLINE COB_A_INLINE int"); - output_storage ("cob_cmp_u64 (const void *p, const cob_u64_t n)"); - output_storage ("{"); -#ifndef COB_ALLOW_UNALIGNED - output_storage (" void *x;"); -#endif - output_storage (" cob_u64_t val;"); - -#ifdef COB_ALLOW_UNALIGNED - output_storage (" val = *(const cob_u64_t " UNALIGNED_ATTRIBUTE "*)p;"); -#else - output_storage (" x = &val;"); - output_storage (" optim_memcpy (x, p, 8);"); -#endif - output_storage (" return (val < n) ? -1 : (val > n);"); - output_storage ("}"); - return; - - case COB_CMP_S64: - output_storage ("static COB_INLINE COB_A_INLINE int"); - output_storage ("cob_cmp_s64 (const void *p, const cob_s64_t n)"); - output_storage ("{"); - output_storage (" cob_s64_t val;"); - -#ifdef COB_ALLOW_UNALIGNED - output_storage (" val = *(const cob_s64_t " UNALIGNED_ATTRIBUTE "*)p;"); -#else - output_storage (" void *x;"); - - output_storage (" x = &val;"); - output_storage (" optim_memcpy (x, p, 8);"); -#endif - output_storage (" return (val < n) ? -1 : (val > n);"); - output_storage ("}"); - return; - - /* Add/Subtract */ - - case COB_ADD_U8: - output_storage ("static COB_INLINE COB_A_INLINE void"); - output_storage ("cob_add_u8 (void *p, const int val)"); - output_storage ("{"); - output_storage (" *(unsigned char *)p += val;"); - output_storage ("}"); - return; - - case COB_ADD_S8: - output_storage ("static COB_INLINE COB_A_INLINE void"); - output_storage ("cob_add_s8 (void *p, const int val)"); - output_storage ("{"); - output_storage (" *(signed char *)p += val;"); - output_storage ("}"); - return; - - case COB_ADD_U16: - output_storage ("static COB_INLINE COB_A_INLINE void"); - output_storage ("cob_add_u16 (void *p, const int val)"); - output_storage ("{"); -#ifdef COB_ALLOW_UNALIGNED - output_storage (" *(unsigned short " UNALIGNED_ATTRIBUTE "*)p += val;"); -#else - output_storage (" void *x;"); - output_storage (" unsigned short n;"); - - output_storage (" x = &n;"); - output_storage (" optim_memcpy (x, p, 2);"); - output_storage (" n += val;"); - output_storage (" optim_memcpy (p, x, 2);"); -#endif - output_storage ("}"); - return; - - case COB_ADD_S16: - output_storage ("static COB_INLINE COB_A_INLINE void"); - output_storage ("cob_add_s16 (void *p, const int val)"); - output_storage ("{"); -#ifdef COB_ALLOW_UNALIGNED - output_storage (" *(short " UNALIGNED_ATTRIBUTE "*)p += val;"); -#else - output_storage (" void *x;"); - output_storage (" short n;"); - - output_storage (" x = &n;"); - output_storage (" optim_memcpy (x, p, 2);"); - output_storage (" n += val;"); - output_storage (" optim_memcpy (p, x, 2);"); -#endif - output_storage ("}"); - return; - - case COB_ADD_U24: - output_storage ("static COB_INLINE COB_A_INLINE void"); - output_storage ("cob_add_u24 (void *p, const int val)"); - output_storage ("{"); - output_storage (" unsigned char *x;"); - output_storage (" unsigned int n = 0;"); - -#ifdef WORDS_BIGENDIAN - output_storage (" x = ((unsigned char *)&n) + 1;"); -#else - output_storage (" x = (unsigned char *)&n;"); -#endif - output_storage (" optim_memcpy (x, p, 3);"); - output_storage (" n += val;"); - output_storage (" optim_memcpy (p, x, 3);"); - output_storage ("}"); - return; - - case COB_ADD_S24: - output_storage ("static COB_INLINE COB_A_INLINE void"); - output_storage ("cob_add_s24 (void *p, const int val)"); - output_storage ("{"); - output_storage (" unsigned char *x;"); - output_storage (" int n = 0;"); - -#ifdef WORDS_BIGENDIAN - output_storage (" x = (unsigned char *)&n;"); -#else - output_storage (" x = ((unsigned char *)&n) + 1;"); -#endif - output_storage (" optim_memcpy (x, p, 3);"); - output_storage (" n >>= 8; /* Shift with sign */"); - output_storage (" n += val;"); -#ifdef WORDS_BIGENDIAN - output_storage (" x = ((unsigned char *)&n) + 1;"); -#else - output_storage (" x = (unsigned char *)&n;"); -#endif - output_storage (" optim_memcpy (p, x, 3);"); - output_storage ("}"); - return; - - case COB_ADD_U32: - output_storage ("static COB_INLINE COB_A_INLINE void"); - output_storage ("cob_add_u32 (void *p, const int val)"); - output_storage ("{"); -#ifdef COB_ALLOW_UNALIGNED - output_storage (" *(unsigned int " UNALIGNED_ATTRIBUTE "*)p += val;"); -#else - output_storage (" void *x;"); - output_storage (" unsigned int n;"); - - output_storage (" x = &n;"); - output_storage (" optim_memcpy (x, p, 4);"); - output_storage (" n += val;"); - output_storage (" optim_memcpy (p, x, 4);"); -#endif - output_storage ("}"); - return; - - case COB_ADD_S32: - output_storage ("static COB_INLINE COB_A_INLINE void"); - output_storage ("cob_add_s32 (void *p, const int val)"); - output_storage ("{"); -#ifdef COB_ALLOW_UNALIGNED - output_storage (" *(int " UNALIGNED_ATTRIBUTE "*)p += val;"); -#else - output_storage (" void *x;"); - output_storage (" int n;"); - - output_storage (" x = &n;"); - output_storage (" optim_memcpy (x, p, 4);"); - output_storage (" n += val;"); - output_storage (" optim_memcpy (p, x, 4);"); -#endif - output_storage ("}"); - return; - - case COB_ADD_U40: - output_storage ("static COB_INLINE COB_A_INLINE void"); - output_storage ("cob_add_u40 (void *p, const int val)"); - output_storage ("{"); - output_storage (" cob_u64_t n = 0;"); - output_storage (" unsigned char *x;"); - -#ifdef WORDS_BIGENDIAN - output_storage (" x = ((unsigned char *)&n) + 3;"); -#else - output_storage (" x = (unsigned char *)&n;"); -#endif - output_storage (" optim_memcpy (x, p, 5);"); - output_storage (" n += val;"); - output_storage (" optim_memcpy (p, x, 5);"); - output_storage ("}"); - return; - - case COB_ADD_S40: - output_storage ("static COB_INLINE COB_A_INLINE void"); - output_storage ("cob_add_s40 (void *p, const int val)"); - output_storage ("{"); - output_storage (" cob_s64_t n = 0;"); - output_storage (" unsigned char *x;"); - -#ifdef WORDS_BIGENDIAN - output_storage (" x = (unsigned char *)&n;"); -#else - output_storage (" x = ((unsigned char *)&n) + 3;"); -#endif - output_storage (" optim_memcpy (x, p, 5);"); - output_storage (" n >>= 24; /* Shift with sign */"); - output_storage (" n += val;"); -#ifdef WORDS_BIGENDIAN - output_storage (" x = ((unsigned char *)&n) + 3;"); -#else - output_storage (" x = (unsigned char *)&n;"); -#endif - output_storage (" optim_memcpy (p, x, 5);"); - output_storage ("}"); - return; - - case COB_ADD_U48: - output_storage ("static COB_INLINE COB_A_INLINE void"); - output_storage ("cob_add_u48 (void *p, const int val)"); - output_storage ("{"); - output_storage (" cob_u64_t n = 0;"); - output_storage (" unsigned char *x;"); - -#ifdef WORDS_BIGENDIAN - output_storage (" x = ((unsigned char *)&n) + 2;"); -#else - output_storage (" x = (unsigned char *)&n;"); -#endif - output_storage (" optim_memcpy (x, p, 6);"); - output_storage (" n += val;"); - output_storage (" optim_memcpy (p, x, 6);"); - output_storage ("}"); - return; - - case COB_ADD_S48: - output_storage ("static COB_INLINE COB_A_INLINE void"); - output_storage ("cob_add_s48 (void *p, const int val)"); - output_storage ("{"); - output_storage (" cob_s64_t n = 0;"); - output_storage (" unsigned char *x;"); - -#ifdef WORDS_BIGENDIAN - output_storage (" x = (unsigned char *)&n;"); -#else - output_storage (" x = ((unsigned char *)&n) + 2;"); -#endif - output_storage (" optim_memcpy (x, p, 6);"); - output_storage (" n >>= 16; /* Shift with sign */"); - output_storage (" n += val;"); -#ifdef WORDS_BIGENDIAN - output_storage (" x = ((unsigned char *)&n) + 2;"); -#else - output_storage (" x = (unsigned char *)&n;"); -#endif - output_storage (" optim_memcpy (p, x, 6);"); - output_storage ("}"); - return; - - case COB_ADD_U56: - output_storage ("static COB_INLINE COB_A_INLINE void"); - output_storage ("cob_add_u56 (void *p, const int val)"); - output_storage ("{"); - output_storage (" cob_u64_t n = 0;"); - output_storage (" unsigned char *x;"); - -#ifdef WORDS_BIGENDIAN - output_storage (" x = ((unsigned char *)&n) + 1;"); -#else - output_storage (" x = (unsigned char *)&n;"); -#endif - output_storage (" optim_memcpy (x, p, 7);"); - output_storage (" n += val;"); - output_storage (" optim_memcpy (p, x, 7);"); - output_storage ("}"); - return; - - case COB_ADD_S56: - output_storage ("static COB_INLINE COB_A_INLINE void"); - output_storage ("cob_add_s56 (void *p, const int val)"); - output_storage ("{"); - output_storage (" cob_s64_t n = 0;"); - output_storage (" unsigned char *x;"); - -#ifdef WORDS_BIGENDIAN - output_storage (" x = (unsigned char *)&n;"); -#else - output_storage (" x = ((unsigned char *)&n) + 1;"); -#endif - output_storage (" optim_memcpy (x, p, 7);"); - output_storage (" n >>= 8; /* Shift with sign */"); - output_storage (" n += val;"); -#ifdef WORDS_BIGENDIAN - output_storage (" x = ((unsigned char *)&n) + 1;"); -#else - output_storage (" x = (unsigned char *)&n;"); -#endif - output_storage (" optim_memcpy (p, x, 7);"); - output_storage ("}"); - return; - - case COB_ADD_U64: - output_storage ("static COB_INLINE COB_A_INLINE void"); - output_storage ("cob_add_u64 (void *p, const int val)"); - output_storage ("{"); -#ifdef COB_ALLOW_UNALIGNED - output_storage (" *(cob_u64_t " UNALIGNED_ATTRIBUTE "*)p += val;"); -#else - output_storage (" void *x;"); - output_storage (" cob_u64_t n;"); - - output_storage (" x = &n;"); - output_storage (" optim_memcpy (x, p, 8);"); - output_storage (" n += val;"); - output_storage (" optim_memcpy (p, x, 8);"); -#endif - output_storage ("}"); - return; - - case COB_ADD_S64: - output_storage ("static COB_INLINE COB_A_INLINE void"); - output_storage ("cob_add_s64 (void *p, const int val)"); - output_storage ("{"); -#ifdef COB_ALLOW_UNALIGNED - output_storage (" *(cob_s64_t " UNALIGNED_ATTRIBUTE "*)p += val;"); -#else - output_storage (" void *x;"); - output_storage (" cob_s64_t n;"); - - output_storage (" x = &n;"); - output_storage (" optim_memcpy (x, p, 8);"); - output_storage (" n += val;"); - output_storage (" optim_memcpy (p, x, 8);"); -#endif - output_storage ("}"); - return; - - case COB_SUB_U8: - output_storage ("static COB_INLINE COB_A_INLINE void"); - output_storage ("cob_sub_u8 (void *p, const int val)"); - output_storage ("{"); - output_storage (" *(unsigned char *)p -= val;"); - output_storage ("}"); - return; - - case COB_SUB_S8: - output_storage ("static COB_INLINE COB_A_INLINE void"); - output_storage ("cob_sub_s8 (void *p, const int val)"); - output_storage ("{"); - output_storage (" *(signed char *)p -= val;"); - output_storage ("}"); - return; - - case COB_SUB_U16: - output_storage ("static COB_INLINE COB_A_INLINE void"); - output_storage ("cob_sub_u16 (void *p, const int val)"); - output_storage ("{"); -#ifdef COB_ALLOW_UNALIGNED - output_storage (" *(unsigned short " UNALIGNED_ATTRIBUTE "*)p -= val;"); -#else - output_storage (" void *x;"); - output_storage (" unsigned short n;"); - - output_storage (" x = &n;"); - output_storage (" optim_memcpy (x, p, 2);"); - output_storage (" n -= val;"); - output_storage (" optim_memcpy (p, x, 2);"); -#endif - output_storage ("}"); - return; - - case COB_SUB_S16: - output_storage ("static COB_INLINE COB_A_INLINE void"); - output_storage ("cob_sub_s16 (void *p, const int val)"); - output_storage ("{"); -#ifdef COB_ALLOW_UNALIGNED - output_storage (" *(short " UNALIGNED_ATTRIBUTE "*)p -= val;"); -#else - output_storage (" void *x;"); - output_storage (" short n;"); - - output_storage (" x = &n;"); - output_storage (" optim_memcpy (x, p, 2);"); - output_storage (" n -= val;"); - output_storage (" optim_memcpy (p, x, 2);"); -#endif - output_storage ("}"); - return; - - case COB_SUB_U24: - output_storage ("static COB_INLINE COB_A_INLINE void"); - output_storage ("cob_sub_u24 (void *p, const int val)"); - output_storage ("{"); - output_storage (" unsigned char *x;"); - output_storage (" unsigned int n = 0;"); - -#ifdef WORDS_BIGENDIAN - output_storage (" x = ((unsigned char *)&n) + 1;"); -#else - output_storage (" x = (unsigned char *)&n;"); -#endif - output_storage (" optim_memcpy (x, p, 3);"); - output_storage (" n -= val;"); - output_storage (" optim_memcpy (p, x, 3);"); - output_storage ("}"); - return; - - case COB_SUB_S24: - output_storage ("static COB_INLINE COB_A_INLINE void"); - output_storage ("cob_sub_s24 (void *p, const int val)"); - output_storage ("{"); - output_storage (" unsigned char *x;"); - output_storage (" int n = 0;"); - -#ifdef WORDS_BIGENDIAN - output_storage (" x = (unsigned char *)&n;"); -#else - output_storage (" x = ((unsigned char *)&n) + 1;"); -#endif - output_storage (" optim_memcpy (x, p, 3);"); - output_storage (" n >>= 8; /* Shift with sign */"); - output_storage (" n -= val;"); -#ifdef WORDS_BIGENDIAN - output_storage (" x = ((unsigned char *)&n) + 1;"); -#else - output_storage (" x = (unsigned char *)&n;"); -#endif - output_storage (" optim_memcpy (p, x, 3);"); - output_storage ("}"); - return; - - case COB_SUB_U32: - output_storage ("static COB_INLINE COB_A_INLINE void"); - output_storage ("cob_sub_u32 (void *p, const int val)"); - output_storage ("{"); -#ifdef COB_ALLOW_UNALIGNED - output_storage (" *(unsigned int " UNALIGNED_ATTRIBUTE "*)p -= val;"); -#else - output_storage (" void *x;"); - output_storage (" unsigned int n;"); - - output_storage (" x = &n;"); - output_storage (" optim_memcpy (x, p, 4);"); - output_storage (" n -= val;"); - output_storage (" optim_memcpy (p, x, 4);"); -#endif - output_storage ("}"); - return; - - case COB_SUB_S32: - output_storage ("static COB_INLINE COB_A_INLINE void"); - output_storage ("cob_sub_s32 (void *p, const int val)"); - output_storage ("{"); -#ifdef COB_ALLOW_UNALIGNED - output_storage (" *(int " UNALIGNED_ATTRIBUTE "*)p -= val;"); -#else - output_storage (" void *x;"); - output_storage (" int n;"); - - output_storage (" x = &n;"); - output_storage (" optim_memcpy (x, p, 4);"); - output_storage (" n -= val;"); - output_storage (" optim_memcpy (p, x, 4);"); -#endif - output_storage ("}"); - return; - - case COB_SUB_U40: - output_storage ("static COB_INLINE COB_A_INLINE void"); - output_storage ("cob_sub_u40 (void *p, const int val)"); - output_storage ("{"); - output_storage (" cob_u64_t n = 0;"); - output_storage (" unsigned char *x;"); - -#ifdef WORDS_BIGENDIAN - output_storage (" x = ((unsigned char *)&n) + 3;"); -#else - output_storage (" x = (unsigned char *)&n;"); -#endif - output_storage (" optim_memcpy (x, p, 5);"); - output_storage (" n -= val;"); - output_storage (" optim_memcpy (p, x, 5);"); - output_storage ("}"); - return; - - case COB_SUB_S40: - output_storage ("static COB_INLINE COB_A_INLINE void"); - output_storage ("cob_sub_s40 (void *p, const int val)"); - output_storage ("{"); - output_storage (" cob_s64_t n = 0;"); - output_storage (" unsigned char *x;"); - -#ifdef WORDS_BIGENDIAN - output_storage (" x = (unsigned char *)&n;"); -#else - output_storage (" x = ((unsigned char *)&n) + 3;"); -#endif - output_storage (" optim_memcpy (x, p, 5);"); - output_storage (" n >>= 24; /* Shift with sign */"); - output_storage (" n -= val;"); -#ifdef WORDS_BIGENDIAN - output_storage (" x = ((unsigned char *)&n) + 3;"); -#else - output_storage (" x = (unsigned char *)&n;"); -#endif - output_storage (" optim_memcpy (p, x, 5);"); - output_storage ("}"); - return; - - case COB_SUB_U48: - output_storage ("static COB_INLINE COB_A_INLINE void"); - output_storage ("cob_sub_u48 (void *p, const int val)"); - output_storage ("{"); - output_storage (" cob_u64_t n = 0;"); - output_storage (" unsigned char *x;"); - -#ifdef WORDS_BIGENDIAN - output_storage (" x = ((unsigned char *)&n) + 2;"); -#else - output_storage (" x = (unsigned char *)&n;"); -#endif - output_storage (" optim_memcpy (x, p, 6);"); - output_storage (" n -= val;"); - output_storage (" optim_memcpy (p, x, 6);"); - output_storage ("}"); - return; - - case COB_SUB_S48: - output_storage ("static COB_INLINE COB_A_INLINE void"); - output_storage ("cob_sub_s48 (void *p, const int val)"); - output_storage ("{"); - output_storage (" cob_s64_t n = 0;"); - output_storage (" unsigned char *x;"); - -#ifdef WORDS_BIGENDIAN - output_storage (" x = (unsigned char *)&n;"); -#else - output_storage (" x = ((unsigned char *)&n) + 2;"); -#endif - output_storage (" optim_memcpy (x, p, 6);"); - output_storage (" n >>= 16; /* Shift with sign */"); - output_storage (" n -= val;"); -#ifdef WORDS_BIGENDIAN - output_storage (" x = ((unsigned char *)&n) + 2;"); -#else - output_storage (" x = (unsigned char *)&n;"); -#endif - output_storage (" optim_memcpy (p, x, 6);"); - output_storage ("}"); - return; - - case COB_SUB_U56: - output_storage ("static COB_INLINE COB_A_INLINE void"); - output_storage ("cob_sub_u56 (void *p, const int val)"); - output_storage ("{"); - output_storage (" cob_u64_t n = 0;"); - output_storage (" unsigned char *x;"); - -#ifdef WORDS_BIGENDIAN - output_storage (" x = ((unsigned char *)&n) + 1;"); -#else - output_storage (" x = (unsigned char *)&n;"); -#endif - output_storage (" optim_memcpy (x, p, 7);"); - output_storage (" n -= val;"); - output_storage (" optim_memcpy (p, x, 7);"); - output_storage ("}"); - return; - - case COB_SUB_S56: - output_storage ("static COB_INLINE COB_A_INLINE void"); - output_storage ("cob_sub_s56 (void *p, const int val)"); - output_storage ("{"); - output_storage (" cob_s64_t n = 0;"); - output_storage (" unsigned char *x;"); - -#ifdef WORDS_BIGENDIAN - output_storage (" x = (unsigned char *)&n;"); -#else - output_storage (" x = ((unsigned char *)&n) + 1;"); -#endif - output_storage (" optim_memcpy (x, p, 7);"); - output_storage (" n >>= 8; /* Shift with sign */"); - output_storage (" n -= val;"); -#ifdef WORDS_BIGENDIAN - output_storage (" x = ((unsigned char *)&n) + 1;"); -#else - output_storage (" x = (unsigned char *)&n;"); -#endif - output_storage (" optim_memcpy (p, x, 7);"); - output_storage ("}"); - return; - - case COB_SUB_U64: - output_storage ("static COB_INLINE COB_A_INLINE void"); - output_storage ("cob_sub_u64 (void *p, const int val)"); - output_storage ("{"); -#ifdef COB_ALLOW_UNALIGNED - output_storage (" *(cob_u64_t " UNALIGNED_ATTRIBUTE "*)p -= val;"); -#else - output_storage (" void *x;"); - output_storage (" cob_u64_t n;"); - - output_storage (" x = &n;"); - output_storage (" optim_memcpy (x, p, 8);"); - output_storage (" n -= val;"); - output_storage (" optim_memcpy (p, x, 8);"); -#endif - output_storage ("}"); - return; - - case COB_SUB_S64: - output_storage ("static COB_INLINE COB_A_INLINE void"); - output_storage ("cob_sub_s64 (void *p, const int val)"); - output_storage ("{"); -#ifdef COB_ALLOW_UNALIGNED - output_storage (" *(cob_s64_t " UNALIGNED_ATTRIBUTE "*)p -= val;"); -#else - output_storage (" void *x;"); - output_storage (" cob_s64_t n;"); - - output_storage (" x = &n;"); - output_storage (" optim_memcpy (x, p, 8);"); - output_storage (" n -= val;"); - output_storage (" optim_memcpy (p, x, 8);"); -#endif - output_storage ("}"); - return; - - /* Binary swapped compare */ - - case COB_CMPSWP_U16: - output_storage ("static COB_INLINE COB_A_INLINE int"); - output_storage ("cob_cmpswp_u16 (const void *p, const cob_s64_t n)"); - output_storage ("{"); -#ifndef COB_ALLOW_UNALIGNED - output_storage (" void *x;"); -#endif - output_storage (" unsigned short val;"); - - output_storage (" if (unlikely(n < 0)) {"); - output_storage (" return 1;"); - output_storage (" }"); -#ifdef COB_ALLOW_UNALIGNED - output_storage (" val = COB_BSWAP_16 (*(unsigned short " UNALIGNED_ATTRIBUTE "*)p);"); -#else - output_storage (" x = &val;"); - output_storage (" optim_memcpy (x, p, 2);"); - output_storage (" val = COB_BSWAP_16 (val);"); -#endif - output_storage (" return (val < n) ? -1 : (val > n);"); - output_storage ("}"); - return; - - case COB_CMPSWP_S16: - output_storage ("static COB_INLINE COB_A_INLINE int"); - output_storage ("cob_cmpswp_s16 (const void *p, const cob_s64_t n)"); - output_storage ("{"); - output_storage (" short val;"); - -#ifdef COB_ALLOW_UNALIGNED - output_storage (" val = COB_BSWAP_16 (*(short " UNALIGNED_ATTRIBUTE "*)p);"); -#else - output_storage (" void *x;"); - - output_storage (" x = &val;"); - output_storage (" optim_memcpy (x, p, 2);"); - output_storage (" val = COB_BSWAP_16 (val);"); -#endif - output_storage (" return (val < n) ? -1 : (val > n);"); - output_storage ("}"); - return; - - case COB_CMPSWP_U24: - output_storage ("static COB_INLINE COB_A_INLINE int"); - output_storage ("cob_cmpswp_u24 (const void *p, const cob_s64_t n)"); - output_storage ("{"); - output_storage (" unsigned char *x;"); - output_storage (" unsigned int val = 0;"); - - output_storage (" if (unlikely(n < 0)) {"); - output_storage (" return 1;"); - output_storage (" }"); - output_storage (" x = ((unsigned char *)&val) + 1;"); - output_storage (" optim_memcpy (x, p, 3);"); - output_storage (" val = COB_BSWAP_32 (val);"); - output_storage (" return (val < n) ? -1 : (val > n);"); - output_storage ("}"); - return; - - case COB_CMPSWP_S24: - output_storage ("static COB_INLINE COB_A_INLINE int"); - output_storage ("cob_cmpswp_s24 (const void *p, const cob_s64_t n)"); - output_storage ("{"); - output_storage (" unsigned char *x;"); - output_storage (" int val = 0;"); - - output_storage (" x = (unsigned char *)&val;"); - output_storage (" optim_memcpy (x, p, 3);"); - output_storage (" val = COB_BSWAP_32 (val);"); - output_storage (" val >>= 8; /* Shift with sign */"); - output_storage (" return (val < n) ? -1 : (val > n);"); - output_storage ("}"); - return; - - case COB_CMPSWP_U32: - output_storage ("static COB_INLINE COB_A_INLINE int"); - output_storage ("cob_cmpswp_u32 (const void *p, const cob_s64_t n)"); - output_storage ("{"); -#ifndef COB_ALLOW_UNALIGNED - output_storage (" void *x;"); -#endif - output_storage (" unsigned int val;"); - - output_storage (" if (unlikely(n < 0)) {"); - output_storage (" return 1;"); - output_storage (" }"); -#ifdef COB_ALLOW_UNALIGNED - output_storage (" val = COB_BSWAP_32 (*(const unsigned int " UNALIGNED_ATTRIBUTE "*)p);"); -#else - output_storage (" x = &val;"); - output_storage (" optim_memcpy (x, p, 4);"); - output_storage (" val = COB_BSWAP_32 (val);"); -#endif - output_storage (" return (val < n) ? -1 : (val > n);"); - output_storage ("}"); - return; - - case COB_CMPSWP_S32: - output_storage ("static COB_INLINE COB_A_INLINE int"); - output_storage ("cob_cmpswp_s32 (const void *p, const cob_s64_t n)"); - output_storage ("{"); - output_storage (" int val;"); - -#ifdef COB_ALLOW_UNALIGNED - output_storage (" val = COB_BSWAP_32 (*(const int " UNALIGNED_ATTRIBUTE "*)p);"); -#else - output_storage (" void *x;"); - - output_storage (" x = &val;"); - output_storage (" optim_memcpy (x, p, 4);"); - output_storage (" val = COB_BSWAP_32 (val);"); -#endif - output_storage (" return (val < n) ? -1 : (val > n);"); - output_storage ("}"); - return; - - case COB_CMPSWP_U40: - output_storage ("static COB_INLINE COB_A_INLINE int"); - output_storage ("cob_cmpswp_u40 (const void *p, const cob_s64_t n)"); - output_storage ("{"); - output_storage (" cob_u64_t val = 0;"); - output_storage (" unsigned char *x;"); - - output_storage (" if (unlikely(n < 0)) {"); - output_storage (" return 1;"); - output_storage (" }"); - output_storage (" x = ((unsigned char *)&val) + 3;"); - output_storage (" optim_memcpy (x, p, 5);"); - output_storage (" val = COB_BSWAP_64 (val);"); - output_storage (" return (val < n) ? -1 : (val > n);"); - output_storage ("}"); - return; - - case COB_CMPSWP_S40: - output_storage ("static COB_INLINE COB_A_INLINE int"); - output_storage ("cob_cmpswp_s40 (const void *p, const cob_s64_t n)"); - output_storage ("{"); - output_storage (" cob_s64_t val = 0;"); - output_storage (" unsigned char *x;"); - - output_storage (" x = (unsigned char *)&val;"); - output_storage (" optim_memcpy (x, p, 5);"); - output_storage (" val = COB_BSWAP_64 (val);"); - output_storage (" val >>= 24; /* Shift with sign */"); - output_storage (" return (val < n) ? -1 : (val > n);"); - output_storage ("}"); - return; - - case COB_CMPSWP_U48: - output_storage ("static COB_INLINE COB_A_INLINE int"); - output_storage ("cob_cmpswp_u48 (const void *p, const cob_s64_t n)"); - output_storage ("{"); - output_storage (" cob_u64_t val = 0;"); - output_storage (" unsigned char *x;"); - - output_storage (" if (unlikely(n < 0)) {"); - output_storage (" return 1;"); - output_storage (" }"); - output_storage (" x = ((unsigned char *)&val) + 2;"); - output_storage (" optim_memcpy (x, p, 6);"); - output_storage (" val = COB_BSWAP_64 (val);"); - output_storage (" return (val < n) ? -1 : (val > n);"); - output_storage ("}"); - return; - - case COB_CMPSWP_S48: - output_storage ("static COB_INLINE COB_A_INLINE int"); - output_storage ("cob_cmpswp_s48 (const void *p, const cob_s64_t n)"); - output_storage ("{"); - output_storage (" cob_s64_t val = 0;"); - output_storage (" unsigned char *x;"); - - output_storage (" x = (unsigned char *)&val;"); - output_storage (" optim_memcpy (x, p, 6);"); - output_storage (" val = COB_BSWAP_64 (val);"); - output_storage (" val >>= 16; /* Shift with sign */"); - output_storage (" return (val < n) ? -1 : (val > n);"); - output_storage ("}"); - return; - - case COB_CMPSWP_U56: - output_storage ("static COB_INLINE COB_A_INLINE int"); - output_storage ("cob_cmpswp_u56 (const void *p, const cob_s64_t n)"); - output_storage ("{"); - output_storage (" cob_u64_t val = 0;"); - output_storage (" unsigned char *x;"); - - output_storage (" if (unlikely(n < 0)) {"); - output_storage (" return 1;"); - output_storage (" }"); - output_storage (" x = ((unsigned char *)&val) + 1;"); - output_storage (" optim_memcpy (x, p, 7);"); - output_storage (" val = COB_BSWAP_64 (val);"); - output_storage (" return (val < n) ? -1 : (val > n);"); - output_storage ("}"); - return; - - case COB_CMPSWP_S56: - output_storage ("static COB_INLINE COB_A_INLINE int"); - output_storage ("cob_cmpswp_s56 (const void *p, const cob_s64_t n)"); - output_storage ("{"); - output_storage (" cob_s64_t val = 0;"); - output_storage (" unsigned char *x;"); - - output_storage (" x = (unsigned char *)&val;"); - output_storage (" optim_memcpy (x, p, 7);"); - output_storage (" val = COB_BSWAP_64 (val);"); - output_storage (" val >>= 8; /* Shift with sign */"); - output_storage (" return (val < n) ? -1 : (val > n);"); - output_storage ("}"); - return; - - case COB_CMPSWP_U64: - output_storage ("static COB_INLINE COB_A_INLINE int"); - output_storage ("cob_cmpswp_u64 (const void *p, const cob_s64_t n)"); - output_storage ("{"); -#ifndef COB_ALLOW_UNALIGNED - output_storage (" void *x;"); -#endif - output_storage (" cob_u64_t val;"); - - output_storage (" if (unlikely(n < 0)) {"); - output_storage (" return 1;"); - output_storage (" }"); -#ifdef COB_ALLOW_UNALIGNED - output_storage (" val = COB_BSWAP_64 (*(const cob_u64_t " UNALIGNED_ATTRIBUTE "*)p);"); -#else - output_storage (" x = &val;"); - output_storage (" optim_memcpy (x, p, 8);"); - output_storage (" val = COB_BSWAP_64 (val);"); -#endif - output_storage (" return (val < n) ? -1 : (val > n);"); - output_storage ("}"); - return; - - case COB_CMPSWP_S64: - output_storage ("static COB_INLINE COB_A_INLINE int"); - output_storage ("cob_cmpswp_s64 (const void *p, const cob_s64_t n)"); - output_storage ("{"); - output_storage (" cob_s64_t val;"); - -#ifdef COB_ALLOW_UNALIGNED - output_storage (" val = COB_BSWAP_64 (*(const cob_s64_t " UNALIGNED_ATTRIBUTE "*)p);"); -#else - output_storage (" void *x;"); - output_storage (" x = &val;"); - output_storage (" optim_memcpy (x, p, 8);"); - output_storage (" val = COB_BSWAP_64 (val);"); -#endif - output_storage (" return (val < n) ? -1 : (val > n);"); - output_storage ("}"); - return; - - /* Binary swapped add */ - - case COB_ADDSWP_U16: - output_storage ("static COB_INLINE COB_A_INLINE void"); - output_storage ("cob_addswp_u16 (void *p, const int val)"); - output_storage ("{"); - output_storage (" unsigned short n;"); - -#ifdef COB_ALLOW_UNALIGNED - output_storage (" n = COB_BSWAP_16 (*(unsigned short " UNALIGNED_ATTRIBUTE "*)p);"); - output_storage (" n += val;"); - output_storage (" *(unsigned short " UNALIGNED_ATTRIBUTE "*)p = COB_BSWAP_16(n);"); -#else - output_storage (" unsigned char *x;"); - output_storage (" unsigned char *px = p;"); - - output_storage (" x = (unsigned char *)&n;"); - output_storage (" x[0] = px[1];"); - output_storage (" x[1] = px[0];"); - output_storage (" n += val;"); - output_storage (" px[0] = x[1];"); - output_storage (" px[1] = x[0];"); -#endif - output_storage ("}"); - return; - - case COB_ADDSWP_S16: - output_storage ("static COB_INLINE COB_A_INLINE void"); - output_storage ("cob_addswp_s16 (void *p, const int val)"); - output_storage ("{"); - output_storage (" short n;"); - -#ifdef COB_ALLOW_UNALIGNED - output_storage (" n = COB_BSWAP_16 (*(short " UNALIGNED_ATTRIBUTE "*)p);"); - output_storage (" n += val;"); - output_storage (" *(short " UNALIGNED_ATTRIBUTE "*)p = COB_BSWAP_16(n);"); -#else - output_storage (" unsigned char *x;"); - output_storage (" unsigned char *px = p;"); - - output_storage (" x = (unsigned char *)&n;"); - output_storage (" x[0] = px[1];"); - output_storage (" x[1] = px[0];"); - output_storage (" n += val;"); - output_storage (" px[0] = x[1];"); - output_storage (" px[1] = x[0];"); -#endif - output_storage ("}"); - return; - - case COB_ADDSWP_U24: - output_storage ("static COB_INLINE COB_A_INLINE void"); - output_storage ("cob_addswp_u24 (void *p, const int val)"); - output_storage ("{"); - output_storage (" unsigned char *x;"); - output_storage (" unsigned char *px = p;"); - output_storage (" unsigned int n = 0;"); - - output_storage (" x = (unsigned char *)&n;"); - output_storage (" x[0] = px[2];"); - output_storage (" x[1] = px[1];"); - output_storage (" x[2] = px[0];"); - output_storage (" n += val;"); - output_storage (" px[0] = x[2];"); - output_storage (" px[1] = x[1];"); - output_storage (" px[2] = x[0];"); - output_storage ("}"); - return; - - case COB_ADDSWP_S24: - output_storage ("static COB_INLINE COB_A_INLINE void"); - output_storage ("cob_addswp_s24 (void *p, const int val)"); - output_storage ("{"); - output_storage (" unsigned char *x;"); - output_storage (" unsigned char *px = p;"); - output_storage (" int n = 0;"); - - output_storage (" x = ((unsigned char *)&n) + 1;"); - output_storage (" x[0] = px[2];"); - output_storage (" x[1] = px[1];"); - output_storage (" x[2] = px[0];"); - output_storage (" n >>= 8; /* Shift with sign */"); - output_storage (" n += val;"); - output_storage (" x = (unsigned char *)&n;"); - output_storage (" px[0] = x[2];"); - output_storage (" px[1] = x[1];"); - output_storage (" px[2] = x[0];"); - output_storage ("}"); - return; - - case COB_ADDSWP_U32: - output_storage ("static COB_INLINE COB_A_INLINE void"); - output_storage ("cob_addswp_u32 (void *p, const int val)"); - output_storage ("{"); - output_storage (" unsigned int n;"); - -#ifdef COB_ALLOW_UNALIGNED - output_storage (" n = COB_BSWAP_32 (*(unsigned int " UNALIGNED_ATTRIBUTE "*)p);"); - output_storage (" n += val;"); - output_storage (" *(unsigned int " UNALIGNED_ATTRIBUTE "*)p = COB_BSWAP_32(n);"); -#else - output_storage (" unsigned char *x;"); - output_storage (" unsigned char *px = p;"); - - output_storage (" x = (unsigned char *)&n;"); - output_storage (" x[0] = px[3];"); - output_storage (" x[1] = px[2];"); - output_storage (" x[2] = px[1];"); - output_storage (" x[3] = px[0];"); - output_storage (" n += val;"); - output_storage (" px[0] = x[3];"); - output_storage (" px[1] = x[2];"); - output_storage (" px[2] = x[1];"); - output_storage (" px[3] = x[0];"); -#endif - output_storage ("}"); - return; - - case COB_ADDSWP_S32: - output_storage ("static COB_INLINE COB_A_INLINE void"); - output_storage ("cob_addswp_s32 (void *p, const int val)"); - output_storage ("{"); - output_storage (" int n;"); - -#ifdef COB_ALLOW_UNALIGNED - output_storage (" n = COB_BSWAP_32 (*(int " UNALIGNED_ATTRIBUTE "*)p);"); - output_storage (" n += val;"); - output_storage (" *(int " UNALIGNED_ATTRIBUTE "*)p = COB_BSWAP_32(n);"); -#else - output_storage (" unsigned char *x;"); - output_storage (" unsigned char *px = p;"); - - output_storage (" x = (unsigned char *)&n;"); - output_storage (" x[0] = px[3];"); - output_storage (" x[1] = px[2];"); - output_storage (" x[2] = px[1];"); - output_storage (" x[3] = px[0];"); - output_storage (" n += val;"); - output_storage (" px[0] = x[3];"); - output_storage (" px[1] = x[2];"); - output_storage (" px[2] = x[1];"); - output_storage (" px[3] = x[0];"); -#endif - output_storage ("}"); - return; - - case COB_ADDSWP_U40: - output_storage ("static COB_INLINE COB_A_INLINE void"); - output_storage ("cob_addswp_u40 (void *p, const int val)"); - output_storage ("{"); - output_storage (" cob_u64_t n = 0;"); - output_storage (" unsigned char *x;"); - output_storage (" unsigned char *px = p;"); - - output_storage (" x = (unsigned char *)&n;"); - output_storage (" x[0] = px[4];"); - output_storage (" x[1] = px[3];"); - output_storage (" x[2] = px[2];"); - output_storage (" x[3] = px[1];"); - output_storage (" x[4] = px[0];"); - output_storage (" n += val;"); - output_storage (" px[0] = x[4];"); - output_storage (" px[1] = x[3];"); - output_storage (" px[2] = x[2];"); - output_storage (" px[3] = x[1];"); - output_storage (" px[4] = x[0];"); - output_storage ("}"); - return; - - case COB_ADDSWP_S40: - output_storage ("static COB_INLINE COB_A_INLINE void"); - output_storage ("cob_addswp_s40 (void *p, const int val)"); - output_storage ("{"); - output_storage (" cob_s64_t n = 0;"); - output_storage (" unsigned char *x;"); - output_storage (" unsigned char *px = p;"); - - output_storage (" x = ((unsigned char *)&n) + 3;"); - output_storage (" x[0] = px[4];"); - output_storage (" x[1] = px[3];"); - output_storage (" x[2] = px[2];"); - output_storage (" x[3] = px[1];"); - output_storage (" x[4] = px[0];"); - output_storage (" n >>= 24; /* Shift with sign */"); - output_storage (" n += val;"); - output_storage (" x = (unsigned char *)&n;"); - output_storage (" px[0] = x[4];"); - output_storage (" px[1] = x[3];"); - output_storage (" px[2] = x[2];"); - output_storage (" px[3] = x[1];"); - output_storage (" px[4] = x[0];"); - output_storage ("}"); - return; - - case COB_ADDSWP_U48: - output_storage ("static COB_INLINE COB_A_INLINE void"); - output_storage ("cob_addswp_u48 (void *p, const int val)"); - output_storage ("{"); - output_storage (" cob_u64_t n = 0;"); - output_storage (" unsigned char *x;"); - output_storage (" unsigned char *px = p;"); - - output_storage (" x = (unsigned char *)&n;"); - output_storage (" x[0] = px[5];"); - output_storage (" x[1] = px[4];"); - output_storage (" x[2] = px[3];"); - output_storage (" x[3] = px[2];"); - output_storage (" x[4] = px[1];"); - output_storage (" x[5] = px[0];"); - output_storage (" n += val;"); - output_storage (" px[0] = x[5];"); - output_storage (" px[1] = x[4];"); - output_storage (" px[2] = x[3];"); - output_storage (" px[3] = x[2];"); - output_storage (" px[4] = x[1];"); - output_storage (" px[5] = x[0];"); - output_storage ("}"); - return; - - case COB_ADDSWP_S48: - output_storage ("static COB_INLINE COB_A_INLINE void"); - output_storage ("cob_addswp_s48 (void *p, const int val)"); - output_storage ("{"); - output_storage (" cob_s64_t n = 0;"); - output_storage (" unsigned char *x;"); - output_storage (" unsigned char *px = p;"); - - output_storage (" x = ((unsigned char *)&n) + 2;"); - output_storage (" x[0] = px[5];"); - output_storage (" x[1] = px[4];"); - output_storage (" x[2] = px[3];"); - output_storage (" x[3] = px[2];"); - output_storage (" x[4] = px[1];"); - output_storage (" x[5] = px[0];"); - output_storage (" n >>= 16; /* Shift with sign */"); - output_storage (" n += val;"); - output_storage (" x = (unsigned char *)&n;"); - output_storage (" px[0] = x[5];"); - output_storage (" px[1] = x[4];"); - output_storage (" px[2] = x[3];"); - output_storage (" px[3] = x[2];"); - output_storage (" px[4] = x[1];"); - output_storage (" px[5] = x[0];"); - output_storage ("}"); - return; - - case COB_ADDSWP_U56: - output_storage ("static COB_INLINE COB_A_INLINE void"); - output_storage ("cob_addswp_u56 (void *p, const int val)"); - output_storage ("{"); - output_storage (" cob_u64_t n = 0;"); - output_storage (" unsigned char *x;"); - output_storage (" unsigned char *px = p;"); - - output_storage (" x = (unsigned char *)&n;"); - output_storage (" x[0] = px[6];"); - output_storage (" x[1] = px[5];"); - output_storage (" x[2] = px[4];"); - output_storage (" x[3] = px[3];"); - output_storage (" x[4] = px[2];"); - output_storage (" x[5] = px[1];"); - output_storage (" x[6] = px[0];"); - output_storage (" n += val;"); - output_storage (" px[0] = x[6];"); - output_storage (" px[1] = x[5];"); - output_storage (" px[2] = x[4];"); - output_storage (" px[3] = x[3];"); - output_storage (" px[4] = x[2];"); - output_storage (" px[5] = x[1];"); - output_storage (" px[6] = x[0];"); - output_storage ("}"); - return; - - case COB_ADDSWP_S56: - output_storage ("static COB_INLINE COB_A_INLINE void"); - output_storage ("cob_addswp_s56 (void *p, const int val)"); - output_storage ("{"); - output_storage (" cob_s64_t n = 0;"); - output_storage (" unsigned char *x;"); - output_storage (" unsigned char *px = p;"); - - output_storage (" x = ((unsigned char *)&n) + 1;"); - output_storage (" x[0] = px[6];"); - output_storage (" x[1] = px[5];"); - output_storage (" x[2] = px[4];"); - output_storage (" x[3] = px[3];"); - output_storage (" x[4] = px[2];"); - output_storage (" x[5] = px[1];"); - output_storage (" x[6] = px[0];"); - output_storage (" n >>= 8; /* Shift with sign */"); - output_storage (" n += val;"); - output_storage (" x = (unsigned char *)&n;"); - output_storage (" px[0] = x[6];"); - output_storage (" px[1] = x[5];"); - output_storage (" px[2] = x[4];"); - output_storage (" px[3] = x[3];"); - output_storage (" px[4] = x[2];"); - output_storage (" px[5] = x[1];"); - output_storage (" px[6] = x[0];"); - output_storage ("}"); - return; - - case COB_ADDSWP_U64: - output_storage ("static COB_INLINE COB_A_INLINE void"); - output_storage ("cob_addswp_u64 (void *p, const int val)"); - output_storage ("{"); - output_storage (" cob_u64_t n;"); - -#ifdef COB_ALLOW_UNALIGNED - output_storage (" n = COB_BSWAP_64 (*(cob_u64_t " UNALIGNED_ATTRIBUTE "*)p);"); - output_storage (" n += val;"); - output_storage (" *(cob_u64_t " UNALIGNED_ATTRIBUTE "*)p = COB_BSWAP_64(n);"); -#else - output_storage (" unsigned char *x;"); - output_storage (" unsigned char *px = p;"); - - output_storage (" x = (unsigned char *)&n;"); - output_storage (" x[0] = px[7];"); - output_storage (" x[1] = px[6];"); - output_storage (" x[2] = px[5];"); - output_storage (" x[3] = px[4];"); - output_storage (" x[4] = px[3];"); - output_storage (" x[5] = px[2];"); - output_storage (" x[6] = px[1];"); - output_storage (" x[7] = px[0];"); - output_storage (" n += val;"); - output_storage (" px[0] = x[7];"); - output_storage (" px[1] = x[6];"); - output_storage (" px[2] = x[5];"); - output_storage (" px[3] = x[4];"); - output_storage (" px[4] = x[3];"); - output_storage (" px[5] = x[2];"); - output_storage (" px[6] = x[1];"); - output_storage (" px[7] = x[0];"); -#endif - output_storage ("}"); - return; - - case COB_ADDSWP_S64: - output_storage ("static COB_INLINE COB_A_INLINE void"); - output_storage ("cob_addswp_s64 (void *p, const int val)"); - output_storage ("{"); - output_storage (" cob_s64_t n;"); - -#ifdef COB_ALLOW_UNALIGNED - output_storage (" n = COB_BSWAP_64 (*(cob_s64_t " UNALIGNED_ATTRIBUTE "*)p);"); - output_storage (" n += val;"); - output_storage (" *(cob_s64_t " UNALIGNED_ATTRIBUTE "*)p = COB_BSWAP_64(n);"); -#else - output_storage (" unsigned char *x;"); - output_storage (" unsigned char *px = p;"); - - output_storage (" x = (unsigned char *)&n;"); - output_storage (" x[0] = px[7];"); - output_storage (" x[1] = px[6];"); - output_storage (" x[2] = px[5];"); - output_storage (" x[3] = px[4];"); - output_storage (" x[4] = px[3];"); - output_storage (" x[5] = px[2];"); - output_storage (" x[6] = px[1];"); - output_storage (" x[7] = px[0];"); - output_storage (" n += val;"); - output_storage (" px[0] = x[7];"); - output_storage (" px[1] = x[6];"); - output_storage (" px[2] = x[5];"); - output_storage (" px[3] = x[4];"); - output_storage (" px[4] = x[3];"); - output_storage (" px[5] = x[2];"); - output_storage (" px[6] = x[1];"); - output_storage (" px[7] = x[0];"); -#endif - output_storage ("}"); - return; - - /* Binary swapped subtract */ - - case COB_SUBSWP_U16: - output_storage ("static COB_INLINE COB_A_INLINE void"); - output_storage ("cob_subswp_u16 (void *p, const int val)"); - output_storage ("{"); - output_storage (" unsigned short n;"); - -#ifdef COB_ALLOW_UNALIGNED - output_storage (" n = COB_BSWAP_16 (*(unsigned short " UNALIGNED_ATTRIBUTE "*)p);"); - output_storage (" n -= val;"); - output_storage (" *(unsigned short " UNALIGNED_ATTRIBUTE "*)p = COB_BSWAP_16(n);"); -#else - output_storage (" unsigned char *x;"); - output_storage (" unsigned char *px = p;"); - - output_storage (" x = (unsigned char *)&n;"); - output_storage (" x[0] = px[1];"); - output_storage (" x[1] = px[0];"); - output_storage (" n -= val;"); - output_storage (" px[0] = x[1];"); - output_storage (" px[1] = x[0];"); -#endif - output_storage ("}"); - return; - - case COB_SUBSWP_S16: - output_storage ("static COB_INLINE COB_A_INLINE void"); - output_storage ("cob_subswp_s16 (void *p, const int val)"); - output_storage ("{"); - output_storage (" short n;"); - -#ifdef COB_ALLOW_UNALIGNED - output_storage (" n = COB_BSWAP_16 (*(short " UNALIGNED_ATTRIBUTE "*)p);"); - output_storage (" n -= val;"); - output_storage (" *(short " UNALIGNED_ATTRIBUTE "*)p = COB_BSWAP_16(n);"); -#else - output_storage (" unsigned char *x;"); - output_storage (" unsigned char *px = p;"); - - output_storage (" x = (unsigned char *)&n;"); - output_storage (" x[0] = px[1];"); - output_storage (" x[1] = px[0];"); - output_storage (" n -= val;"); - output_storage (" px[0] = x[1];"); - output_storage (" px[1] = x[0];"); -#endif - output_storage ("}"); - return; - - case COB_SUBSWP_U24: - output_storage ("static COB_INLINE COB_A_INLINE void"); - output_storage ("cob_subswp_u24 (void *p, const int val)"); - output_storage ("{"); - output_storage (" unsigned char *x;"); - output_storage (" unsigned char *px = p;"); - output_storage (" unsigned int n = 0;"); - - output_storage (" x = (unsigned char *)&n;"); - output_storage (" x[0] = px[2];"); - output_storage (" x[1] = px[1];"); - output_storage (" x[2] = px[0];"); - output_storage (" n -= val;"); - output_storage (" px[0] = x[2];"); - output_storage (" px[1] = x[1];"); - output_storage (" px[2] = x[0];"); - output_storage ("}"); - return; - - case COB_SUBSWP_S24: - output_storage ("static COB_INLINE COB_A_INLINE void"); - output_storage ("cob_subswp_s24 (void *p, const int val)"); - output_storage ("{"); - output_storage (" unsigned char *x;"); - output_storage (" unsigned char *px = p;"); - output_storage (" int n = 0;"); - - output_storage (" x = ((unsigned char *)&n) + 1;"); - output_storage (" x[0] = px[2];"); - output_storage (" x[1] = px[1];"); - output_storage (" x[2] = px[0];"); - output_storage (" n >>= 8; /* Shift with sign */"); - output_storage (" n -= val;"); - output_storage (" x = (unsigned char *)&n;"); - output_storage (" px[0] = x[2];"); - output_storage (" px[1] = x[1];"); - output_storage (" px[2] = x[0];"); - output_storage ("}"); - return; - - case COB_SUBSWP_U32: - output_storage ("static COB_INLINE COB_A_INLINE void"); - output_storage ("cob_subswp_u32 (void *p, const int val)"); - output_storage ("{"); - output_storage (" unsigned int n;"); - -#ifdef COB_ALLOW_UNALIGNED - output_storage (" n = COB_BSWAP_32 (*(unsigned int " UNALIGNED_ATTRIBUTE "*)p);"); - output_storage (" n -= val;"); - output_storage (" *(unsigned int " UNALIGNED_ATTRIBUTE "*)p = COB_BSWAP_32(n);"); -#else - output_storage (" unsigned char *x;"); - output_storage (" unsigned char *px = p;"); - - output_storage (" x = (unsigned char *)&n;"); - output_storage (" x[0] = px[3];"); - output_storage (" x[1] = px[2];"); - output_storage (" x[2] = px[1];"); - output_storage (" x[3] = px[0];"); - output_storage (" n -= val;"); - output_storage (" px[0] = x[3];"); - output_storage (" px[1] = x[2];"); - output_storage (" px[2] = x[1];"); - output_storage (" px[3] = x[0];"); -#endif - output_storage ("}"); - return; - - case COB_SUBSWP_S32: - output_storage ("static COB_INLINE COB_A_INLINE void"); - output_storage ("cob_subswp_s32 (void *p, const int val)"); - output_storage ("{"); - output_storage (" int n;"); - -#ifdef COB_ALLOW_UNALIGNED - output_storage (" n = COB_BSWAP_32 (*(int " UNALIGNED_ATTRIBUTE "*)p);"); - output_storage (" n -= val;"); - output_storage (" *(int " UNALIGNED_ATTRIBUTE "*)p = COB_BSWAP_32(n);"); -#else - output_storage (" unsigned char *x;"); - output_storage (" unsigned char *px = p;"); - - output_storage (" x = (unsigned char *)&n;"); - output_storage (" x[0] = px[3];"); - output_storage (" x[1] = px[2];"); - output_storage (" x[2] = px[1];"); - output_storage (" x[3] = px[0];"); - output_storage (" n -= val;"); - output_storage (" px[0] = x[3];"); - output_storage (" px[1] = x[2];"); - output_storage (" px[2] = x[1];"); - output_storage (" px[3] = x[0];"); -#endif - output_storage ("}"); - return; - - case COB_SUBSWP_U40: - output_storage ("static COB_INLINE COB_A_INLINE void"); - output_storage ("cob_subswp_u40 (void *p, const int val)"); - output_storage ("{"); - output_storage (" cob_u64_t n = 0;"); - output_storage (" unsigned char *x;"); - output_storage (" unsigned char *px = p;"); - - output_storage (" x = (unsigned char *)&n;"); - output_storage (" x[0] = px[4];"); - output_storage (" x[1] = px[3];"); - output_storage (" x[2] = px[2];"); - output_storage (" x[3] = px[1];"); - output_storage (" x[4] = px[0];"); - output_storage (" n -= val;"); - output_storage (" px[0] = x[4];"); - output_storage (" px[1] = x[3];"); - output_storage (" px[2] = x[2];"); - output_storage (" px[3] = x[1];"); - output_storage (" px[4] = x[0];"); - output_storage ("}"); - return; - - case COB_SUBSWP_S40: - output_storage ("static COB_INLINE COB_A_INLINE void"); - output_storage ("cob_subswp_s40 (void *p, const int val)"); - output_storage ("{"); - output_storage (" cob_s64_t n = 0;"); - output_storage (" unsigned char *x;"); - output_storage (" unsigned char *px = p;"); - - output_storage (" x = ((unsigned char *)&n) + 3;"); - output_storage (" x[0] = px[4];"); - output_storage (" x[1] = px[3];"); - output_storage (" x[2] = px[2];"); - output_storage (" x[3] = px[1];"); - output_storage (" x[4] = px[0];"); - output_storage (" n >>= 24; /* Shift with sign */"); - output_storage (" n -= val;"); - output_storage (" x = (unsigned char *)&n;"); - output_storage (" px[0] = x[4];"); - output_storage (" px[1] = x[3];"); - output_storage (" px[2] = x[2];"); - output_storage (" px[3] = x[1];"); - output_storage (" px[4] = x[0];"); - output_storage ("}"); - return; - - case COB_SUBSWP_U48: - output_storage ("static COB_INLINE COB_A_INLINE void"); - output_storage ("cob_subswp_u48 (void *p, const int val)"); - output_storage ("{"); - output_storage (" cob_u64_t n = 0;"); - output_storage (" unsigned char *x;"); - output_storage (" unsigned char *px = p;"); - - output_storage (" x = (unsigned char *)&n;"); - output_storage (" x[0] = px[5];"); - output_storage (" x[1] = px[4];"); - output_storage (" x[2] = px[3];"); - output_storage (" x[3] = px[2];"); - output_storage (" x[4] = px[1];"); - output_storage (" x[5] = px[0];"); - output_storage (" n -= val;"); - output_storage (" px[0] = x[5];"); - output_storage (" px[1] = x[4];"); - output_storage (" px[2] = x[3];"); - output_storage (" px[3] = x[2];"); - output_storage (" px[4] = x[1];"); - output_storage (" px[5] = x[0];"); - output_storage ("}"); - return; - - case COB_SUBSWP_S48: - output_storage ("static COB_INLINE COB_A_INLINE void"); - output_storage ("cob_subswp_s48 (void *p, const int val)"); - output_storage ("{"); - output_storage (" cob_s64_t n = 0;"); - output_storage (" unsigned char *x;"); - output_storage (" unsigned char *px = p;"); - - output_storage (" x = ((unsigned char *)&n) + 2;"); - output_storage (" x[0] = px[5];"); - output_storage (" x[1] = px[4];"); - output_storage (" x[2] = px[3];"); - output_storage (" x[3] = px[2];"); - output_storage (" x[4] = px[1];"); - output_storage (" x[5] = px[0];"); - output_storage (" n >>= 16; /* Shift with sign */"); - output_storage (" n -= val;"); - output_storage (" x = (unsigned char *)&n;"); - output_storage (" px[0] = x[5];"); - output_storage (" px[1] = x[4];"); - output_storage (" px[2] = x[3];"); - output_storage (" px[3] = x[2];"); - output_storage (" px[4] = x[1];"); - output_storage (" px[5] = x[0];"); - output_storage ("}"); - return; - - case COB_SUBSWP_U56: - output_storage ("static COB_INLINE COB_A_INLINE void"); - output_storage ("cob_subswp_u56 (void *p, const int val)"); - output_storage ("{"); - output_storage (" cob_u64_t n = 0;"); - output_storage (" unsigned char *x;"); - output_storage (" unsigned char *px = p;"); - - output_storage (" x = (unsigned char *)&n;"); - output_storage (" x[0] = px[6];"); - output_storage (" x[1] = px[5];"); - output_storage (" x[2] = px[4];"); - output_storage (" x[3] = px[3];"); - output_storage (" x[4] = px[2];"); - output_storage (" x[5] = px[1];"); - output_storage (" x[6] = px[0];"); - output_storage (" n -= val;"); - output_storage (" px[0] = x[6];"); - output_storage (" px[1] = x[5];"); - output_storage (" px[2] = x[4];"); - output_storage (" px[3] = x[3];"); - output_storage (" px[4] = x[2];"); - output_storage (" px[5] = x[1];"); - output_storage (" px[6] = x[0];"); - output_storage ("}"); - return; - - case COB_SUBSWP_S56: - output_storage ("static COB_INLINE COB_A_INLINE void"); - output_storage ("cob_subswp_s56 (void *p, const int val)"); - output_storage ("{"); - output_storage (" cob_s64_t n = 0;"); - output_storage (" unsigned char *x;"); - output_storage (" unsigned char *px = p;"); - - output_storage (" x = ((unsigned char *)&n) + 1;"); - output_storage (" x[0] = px[6];"); - output_storage (" x[1] = px[5];"); - output_storage (" x[2] = px[4];"); - output_storage (" x[3] = px[3];"); - output_storage (" x[4] = px[2];"); - output_storage (" x[5] = px[1];"); - output_storage (" x[6] = px[0];"); - output_storage (" n >>= 8; /* Shift with sign */"); - output_storage (" n -= val;"); - output_storage (" x = (unsigned char *)&n;"); - output_storage (" px[0] = x[6];"); - output_storage (" px[1] = x[5];"); - output_storage (" px[2] = x[4];"); - output_storage (" px[3] = x[3];"); - output_storage (" px[4] = x[2];"); - output_storage (" px[5] = x[1];"); - output_storage (" px[6] = x[0];"); - output_storage ("}"); - return; - - case COB_SUBSWP_U64: - output_storage ("static COB_INLINE COB_A_INLINE void"); - output_storage ("cob_subswp_u64 (void *p, const int val)"); - output_storage ("{"); - output_storage (" cob_u64_t n;"); - -#ifdef COB_ALLOW_UNALIGNED - output_storage (" n = COB_BSWAP_64 (*(cob_u64_t " UNALIGNED_ATTRIBUTE "*)p);"); - output_storage (" n -= val;"); - output_storage (" *(cob_u64_t " UNALIGNED_ATTRIBUTE "*)p = COB_BSWAP_64(n);"); -#else - output_storage (" unsigned char *x;"); - output_storage (" unsigned char *px = p;"); - - output_storage (" x = (unsigned char *)&n;"); - output_storage (" x[0] = px[7];"); - output_storage (" x[1] = px[6];"); - output_storage (" x[2] = px[5];"); - output_storage (" x[3] = px[4];"); - output_storage (" x[4] = px[3];"); - output_storage (" x[5] = px[2];"); - output_storage (" x[6] = px[1];"); - output_storage (" x[7] = px[0];"); - output_storage (" n -= val;"); - output_storage (" px[0] = x[7];"); - output_storage (" px[1] = x[6];"); - output_storage (" px[2] = x[5];"); - output_storage (" px[3] = x[4];"); - output_storage (" px[4] = x[3];"); - output_storage (" px[5] = x[2];"); - output_storage (" px[6] = x[1];"); - output_storage (" px[7] = x[0];"); -#endif - output_storage ("}"); - return; - - case COB_SUBSWP_S64: - output_storage ("static COB_INLINE COB_A_INLINE void"); - output_storage ("cob_subswp_s64 (void *p, const int val)"); - output_storage ("{"); - output_storage (" cob_s64_t n;"); - -#ifdef COB_ALLOW_UNALIGNED - output_storage (" n = COB_BSWAP_64 (*(cob_s64_t " UNALIGNED_ATTRIBUTE "*)p);"); - output_storage (" n -= val;"); - output_storage (" *(cob_s64_t " UNALIGNED_ATTRIBUTE "*)p = COB_BSWAP_64(n);"); -#else - output_storage (" unsigned char *x;"); - output_storage (" unsigned char *px = p;"); - - output_storage (" x = (unsigned char *)&n;"); - output_storage (" x[0] = px[7];"); - output_storage (" x[1] = px[6];"); - output_storage (" x[2] = px[5];"); - output_storage (" x[3] = px[4];"); - output_storage (" x[4] = px[3];"); - output_storage (" x[5] = px[2];"); - output_storage (" x[6] = px[1];"); - output_storage (" x[7] = px[0];"); - output_storage (" n -= val;"); - output_storage (" px[0] = x[7];"); - output_storage (" px[1] = x[6];"); - output_storage (" px[2] = x[5];"); - output_storage (" px[3] = x[4];"); - output_storage (" px[4] = x[3];"); - output_storage (" px[5] = x[2];"); - output_storage (" px[6] = x[1];"); - output_storage (" px[7] = x[0];"); -#endif - output_storage ("}"); - return; - - /* Binary set swapped value */ - case COB_SETSWP_U16: - output_storage ("static COB_INLINE COB_A_INLINE void"); - output_storage ("cob_setswp_u16 (void *p, const int val)"); - output_storage ("{"); - output_storage (" unsigned short n;"); - -#ifdef COB_ALLOW_UNALIGNED - output_storage (" n = val;"); - output_storage (" *(unsigned short " UNALIGNED_ATTRIBUTE "*)p = COB_BSWAP_16(n);"); -#else - output_storage (" unsigned char *x;"); - output_storage (" unsigned char *px = p;"); - - output_storage (" n = val;"); - output_storage (" x = (unsigned char *)&n;"); - output_storage (" px[0] = x[1];"); - output_storage (" px[1] = x[0];"); -#endif - output_storage ("}"); - return; - - case COB_SETSWP_S16: - output_storage ("static COB_INLINE COB_A_INLINE void"); - output_storage ("cob_setswp_s16 (void *p, const int val)"); - output_storage ("{"); - output_storage (" short n;"); - -#ifdef COB_ALLOW_UNALIGNED - output_storage (" n = val;"); - output_storage (" *(short " UNALIGNED_ATTRIBUTE "*)p = COB_BSWAP_16(n);"); -#else - output_storage (" unsigned char *x;"); - output_storage (" unsigned char *px = p;"); - - output_storage (" n = val;"); - output_storage (" x = (unsigned char *)&n;"); - output_storage (" px[0] = x[1];"); - output_storage (" px[1] = x[0];"); -#endif - output_storage ("}"); - return; - - case COB_SETSWP_U24: - output_storage ("static COB_INLINE COB_A_INLINE void"); - output_storage ("cob_setswp_u24 (void *p, const int val)"); - output_storage ("{"); - output_storage (" unsigned char *x;"); - output_storage (" unsigned char *px = p;"); - output_storage (" unsigned int n;"); - - output_storage (" n = val;"); - output_storage (" x = (unsigned char *)&n;"); - output_storage (" px[0] = x[2];"); - output_storage (" px[1] = x[1];"); - output_storage (" px[2] = x[0];"); - output_storage ("}"); - return; - - case COB_SETSWP_S24: - output_storage ("static COB_INLINE COB_A_INLINE void"); - output_storage ("cob_setswp_s24 (void *p, const int val)"); - output_storage ("{"); - output_storage (" unsigned char *x;"); - output_storage (" unsigned char *px = p;"); - output_storage (" int n;"); - - output_storage (" n = val;"); - output_storage (" x = (unsigned char *)&n;"); - output_storage (" px[0] = x[2];"); - output_storage (" px[1] = x[1];"); - output_storage (" px[2] = x[0];"); - output_storage ("}"); - return; - - case COB_SETSWP_U32: - output_storage ("static COB_INLINE COB_A_INLINE void"); - output_storage ("cob_setswp_u32 (void *p, const int val)"); - output_storage ("{"); - output_storage (" unsigned int n;"); - -#ifdef COB_ALLOW_UNALIGNED - output_storage (" n = val;"); - output_storage (" *(unsigned int " UNALIGNED_ATTRIBUTE "*)p = COB_BSWAP_32(n);"); -#else - output_storage (" unsigned char *x;"); - output_storage (" unsigned char *px = p;"); - - output_storage (" n = val;"); - output_storage (" x = (unsigned char *)&n;"); - output_storage (" px[0] = x[3];"); - output_storage (" px[1] = x[2];"); - output_storage (" px[2] = x[1];"); - output_storage (" px[3] = x[0];"); -#endif - output_storage ("}"); - return; - - case COB_SETSWP_S32: - output_storage ("static COB_INLINE COB_A_INLINE void"); - output_storage ("cob_setswp_s32 (void *p, const int val)"); - output_storage ("{"); - output_storage (" int n;"); - -#ifdef COB_ALLOW_UNALIGNED - output_storage (" n = val;"); - output_storage (" *(int " UNALIGNED_ATTRIBUTE "*)p = COB_BSWAP_32(n);"); -#else - output_storage (" unsigned char *x;"); - output_storage (" unsigned char *px = p;"); - - output_storage (" n = val;"); - output_storage (" x = (unsigned char *)&n;"); - output_storage (" px[0] = x[3];"); - output_storage (" px[1] = x[2];"); - output_storage (" px[2] = x[1];"); - output_storage (" px[3] = x[0];"); -#endif - output_storage ("}"); - return; - - case COB_SETSWP_U40: - output_storage ("static COB_INLINE COB_A_INLINE void"); - output_storage ("cob_setswp_u40 (void *p, const int val)"); - output_storage ("{"); - output_storage (" cob_u64_t n;"); - output_storage (" unsigned char *x;"); - output_storage (" unsigned char *px = p;"); - - output_storage (" n = val;"); - output_storage (" x = (unsigned char *)&n;"); - output_storage (" px[0] = x[4];"); - output_storage (" px[1] = x[3];"); - output_storage (" px[2] = x[2];"); - output_storage (" px[3] = x[1];"); - output_storage (" px[4] = x[0];"); - output_storage ("}"); - return; - - case COB_SETSWP_S40: - output_storage ("static COB_INLINE COB_A_INLINE void"); - output_storage ("cob_setswp_s40 (void *p, const int val)"); - output_storage ("{"); - output_storage (" cob_s64_t n;"); - output_storage (" unsigned char *x;"); - output_storage (" unsigned char *px = p;"); - - output_storage (" n = val;"); - output_storage (" x = (unsigned char *)&n;"); - output_storage (" px[0] = x[4];"); - output_storage (" px[1] = x[3];"); - output_storage (" px[2] = x[2];"); - output_storage (" px[3] = x[1];"); - output_storage (" px[4] = x[0];"); - output_storage ("}"); - return; - - case COB_SETSWP_U48: - output_storage ("static COB_INLINE COB_A_INLINE void"); - output_storage ("cob_setswp_u48 (void *p, const int val)"); - output_storage ("{"); - output_storage (" cob_u64_t n;"); - output_storage (" unsigned char *x;"); - output_storage (" unsigned char *px = p;"); - - output_storage (" n = val;"); - output_storage (" x = (unsigned char *)&n;"); - output_storage (" px[0] = x[5];"); - output_storage (" px[1] = x[4];"); - output_storage (" px[2] = x[3];"); - output_storage (" px[3] = x[2];"); - output_storage (" px[4] = x[1];"); - output_storage (" px[5] = x[0];"); - output_storage ("}"); - return; - - case COB_SETSWP_S48: - output_storage ("static COB_INLINE COB_A_INLINE void"); - output_storage ("cob_setswp_s48 (void *p, const int val)"); - output_storage ("{"); - output_storage (" cob_s64_t n;"); - output_storage (" unsigned char *x;"); - output_storage (" unsigned char *px = p;"); - - output_storage (" n = val;"); - output_storage (" x = (unsigned char *)&n;"); - output_storage (" px[0] = x[5];"); - output_storage (" px[1] = x[4];"); - output_storage (" px[2] = x[3];"); - output_storage (" px[3] = x[2];"); - output_storage (" px[4] = x[1];"); - output_storage (" px[5] = x[0];"); - output_storage ("}"); - return; - - case COB_SETSWP_U56: - output_storage ("static COB_INLINE COB_A_INLINE void"); - output_storage ("cob_setswp_u56 (void *p, const int val)"); - output_storage ("{"); - output_storage (" cob_u64_t n;"); - output_storage (" unsigned char *x;"); - output_storage (" unsigned char *px = p;"); - - output_storage (" n = val;"); - output_storage (" x = (unsigned char *)&n;"); - output_storage (" px[0] = x[6];"); - output_storage (" px[1] = x[5];"); - output_storage (" px[2] = x[4];"); - output_storage (" px[3] = x[3];"); - output_storage (" px[4] = x[2];"); - output_storage (" px[5] = x[1];"); - output_storage (" px[6] = x[0];"); - output_storage ("}"); - return; - - case COB_SETSWP_S56: - output_storage ("static COB_INLINE COB_A_INLINE void"); - output_storage ("cob_setswp_s56 (void *p, const int val)"); - output_storage ("{"); - output_storage (" cob_s64_t n;"); - output_storage (" unsigned char *x;"); - output_storage (" unsigned char *px = p;"); - - output_storage (" n = val;"); - output_storage (" x = (unsigned char *)&n;"); - output_storage (" px[0] = x[6];"); - output_storage (" px[1] = x[5];"); - output_storage (" px[2] = x[4];"); - output_storage (" px[3] = x[3];"); - output_storage (" px[4] = x[2];"); - output_storage (" px[5] = x[1];"); - output_storage (" px[6] = x[0];"); - output_storage ("}"); - return; - - case COB_SETSWP_U64: - output_storage ("static COB_INLINE COB_A_INLINE void"); - output_storage ("cob_setswp_u64 (void *p, const int val)"); - output_storage ("{"); - output_storage (" cob_u64_t n;"); - -#ifdef COB_ALLOW_UNALIGNED - output_storage (" n = val;"); - output_storage (" *(cob_u64_t " UNALIGNED_ATTRIBUTE "*)p = COB_BSWAP_64(n);"); -#else - output_storage (" unsigned char *x;"); - output_storage (" unsigned char *px = p;"); - - output_storage (" n = val;"); - output_storage (" x = (unsigned char *)&n;"); - output_storage (" px[0] = x[7];"); - output_storage (" px[1] = x[6];"); - output_storage (" px[2] = x[5];"); - output_storage (" px[3] = x[4];"); - output_storage (" px[4] = x[3];"); - output_storage (" px[5] = x[2];"); - output_storage (" px[6] = x[1];"); - output_storage (" px[7] = x[0];"); -#endif - output_storage ("}"); - return; - - case COB_SETSWP_S64: - output_storage ("static COB_INLINE COB_A_INLINE void"); - output_storage ("cob_setswp_s64 (void *p, const int val)"); - output_storage ("{"); - output_storage (" cob_s64_t n;"); - -#ifdef COB_ALLOW_UNALIGNED - output_storage (" n = val;"); - output_storage (" *(cob_s64_t " UNALIGNED_ATTRIBUTE "*)p = COB_BSWAP_64(n);"); -#else - output_storage (" unsigned char *x;"); - output_storage (" unsigned char *px = p;"); - - output_storage (" n = val;"); - output_storage (" x = (unsigned char *)&n;"); - output_storage (" px[0] = x[7];"); - output_storage (" px[1] = x[6];"); - output_storage (" px[2] = x[5];"); - output_storage (" px[3] = x[4];"); - output_storage (" px[4] = x[3];"); - output_storage (" px[5] = x[2];"); - output_storage (" px[6] = x[1];"); - output_storage (" px[7] = x[0];"); -#endif - output_storage ("}"); - return; - /* LCOV_EXCL_START */ - default: - cobc_err_msg (_("unexpected optimization value: %d"), val); - COBC_ABORT (); - /* LCOV_EXCL_STOP */ - } -} diff -Nru gnucobol-4.0~early~20200606/cobc/codeoptim.def gnucobol-5/cobc/codeoptim.def --- gnucobol-4.0~early~20200606/cobc/codeoptim.def 2020-06-06 20:51:59.000000000 +0000 +++ gnucobol-5/cobc/codeoptim.def 1970-01-01 00:00:00.000000000 +0000 @@ -1,172 +0,0 @@ -/* - Copyright (C) 2009-2013, 2018-2019 Free Software Foundation, Inc. - Written by Roger While - - This file is part of GnuCOBOL. - - The GnuCOBOL compiler is free software: you can redistribute it - and/or modify it under the terms of the GNU General Public License - as published by the Free Software Foundation, either version 3 of the - License, or (at your option) any later version. - - GnuCOBOL is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with GnuCOBOL. If not, see . -*/ - -/* Optimization enumeration definitions */ - -CB_OPTIM_DEF (COB_SET_SCREEN) -CB_OPTIM_DEF (COB_SET_REPORT) -CB_OPTIM_DEF (COB_SET_ML_TREE) -CB_OPTIM_DEF (COB_POINTER_MANIP) -CB_OPTIM_DEF (COB_GET_NUMDISP) -CB_OPTIM_DEF (COB_CMP_PACKED_INT) -CB_OPTIM_DEF (COB_GET_PACKED_INT) -CB_OPTIM_DEF (COB_ADD_PACKED_INT) - -CB_OPTIM_DEF (COB_CMP_ALIGN_U16) -CB_OPTIM_DEF (COB_CMP_ALIGN_S16) -CB_OPTIM_DEF (COB_CMP_ALIGN_U32) -CB_OPTIM_DEF (COB_CMP_ALIGN_S32) -CB_OPTIM_DEF (COB_CMP_ALIGN_U64) -CB_OPTIM_DEF (COB_CMP_ALIGN_S64) - -CB_OPTIM_DEF (COB_ADD_ALIGN_U16) -CB_OPTIM_DEF (COB_ADD_ALIGN_S16) -CB_OPTIM_DEF (COB_ADD_ALIGN_U32) -CB_OPTIM_DEF (COB_ADD_ALIGN_S32) -CB_OPTIM_DEF (COB_ADD_ALIGN_U64) -CB_OPTIM_DEF (COB_ADD_ALIGN_S64) - -CB_OPTIM_DEF (COB_SUB_ALIGN_U16) -CB_OPTIM_DEF (COB_SUB_ALIGN_S16) -CB_OPTIM_DEF (COB_SUB_ALIGN_U32) -CB_OPTIM_DEF (COB_SUB_ALIGN_S32) -CB_OPTIM_DEF (COB_SUB_ALIGN_U64) -CB_OPTIM_DEF (COB_SUB_ALIGN_S64) - -CB_OPTIM_DEF (COB_CMPSWP_ALIGN_U16) -CB_OPTIM_DEF (COB_CMPSWP_ALIGN_S16) -CB_OPTIM_DEF (COB_CMPSWP_ALIGN_U32) -CB_OPTIM_DEF (COB_CMPSWP_ALIGN_S32) -CB_OPTIM_DEF (COB_CMPSWP_ALIGN_U64) -CB_OPTIM_DEF (COB_CMPSWP_ALIGN_S64) - -CB_OPTIM_DEF (COB_CMP_U8) -CB_OPTIM_DEF (COB_CMP_S8) -CB_OPTIM_DEF (COB_CMP_U16) -CB_OPTIM_DEF (COB_CMP_S16) -CB_OPTIM_DEF (COB_CMP_U24) -CB_OPTIM_DEF (COB_CMP_S24) -CB_OPTIM_DEF (COB_CMP_U32) -CB_OPTIM_DEF (COB_CMP_S32) -CB_OPTIM_DEF (COB_CMP_U40) -CB_OPTIM_DEF (COB_CMP_S40) -CB_OPTIM_DEF (COB_CMP_U48) -CB_OPTIM_DEF (COB_CMP_S48) -CB_OPTIM_DEF (COB_CMP_U56) -CB_OPTIM_DEF (COB_CMP_S56) -CB_OPTIM_DEF (COB_CMP_U64) -CB_OPTIM_DEF (COB_CMP_S64) - -CB_OPTIM_DEF (COB_ADD_U8) -CB_OPTIM_DEF (COB_ADD_S8) -CB_OPTIM_DEF (COB_ADD_U16) -CB_OPTIM_DEF (COB_ADD_S16) -CB_OPTIM_DEF (COB_ADD_U24) -CB_OPTIM_DEF (COB_ADD_S24) -CB_OPTIM_DEF (COB_ADD_U32) -CB_OPTIM_DEF (COB_ADD_S32) -CB_OPTIM_DEF (COB_ADD_U40) -CB_OPTIM_DEF (COB_ADD_S40) -CB_OPTIM_DEF (COB_ADD_U48) -CB_OPTIM_DEF (COB_ADD_S48) -CB_OPTIM_DEF (COB_ADD_U56) -CB_OPTIM_DEF (COB_ADD_S56) -CB_OPTIM_DEF (COB_ADD_U64) -CB_OPTIM_DEF (COB_ADD_S64) - -CB_OPTIM_DEF (COB_SUB_U8) -CB_OPTIM_DEF (COB_SUB_S8) -CB_OPTIM_DEF (COB_SUB_U16) -CB_OPTIM_DEF (COB_SUB_S16) -CB_OPTIM_DEF (COB_SUB_U24) -CB_OPTIM_DEF (COB_SUB_S24) -CB_OPTIM_DEF (COB_SUB_U32) -CB_OPTIM_DEF (COB_SUB_S32) -CB_OPTIM_DEF (COB_SUB_U40) -CB_OPTIM_DEF (COB_SUB_S40) -CB_OPTIM_DEF (COB_SUB_U48) -CB_OPTIM_DEF (COB_SUB_S48) -CB_OPTIM_DEF (COB_SUB_U56) -CB_OPTIM_DEF (COB_SUB_S56) -CB_OPTIM_DEF (COB_SUB_U64) -CB_OPTIM_DEF (COB_SUB_S64) - -CB_OPTIM_DEF (COB_CMPSWP_U16) -CB_OPTIM_DEF (COB_CMPSWP_S16) -CB_OPTIM_DEF (COB_CMPSWP_U24) -CB_OPTIM_DEF (COB_CMPSWP_S24) -CB_OPTIM_DEF (COB_CMPSWP_U32) -CB_OPTIM_DEF (COB_CMPSWP_S32) -CB_OPTIM_DEF (COB_CMPSWP_U40) -CB_OPTIM_DEF (COB_CMPSWP_S40) -CB_OPTIM_DEF (COB_CMPSWP_U48) -CB_OPTIM_DEF (COB_CMPSWP_S48) -CB_OPTIM_DEF (COB_CMPSWP_U56) -CB_OPTIM_DEF (COB_CMPSWP_S56) -CB_OPTIM_DEF (COB_CMPSWP_U64) -CB_OPTIM_DEF (COB_CMPSWP_S64) - -CB_OPTIM_DEF (COB_ADDSWP_U16) -CB_OPTIM_DEF (COB_ADDSWP_S16) -CB_OPTIM_DEF (COB_ADDSWP_U24) -CB_OPTIM_DEF (COB_ADDSWP_S24) -CB_OPTIM_DEF (COB_ADDSWP_U32) -CB_OPTIM_DEF (COB_ADDSWP_S32) -CB_OPTIM_DEF (COB_ADDSWP_U40) -CB_OPTIM_DEF (COB_ADDSWP_S40) -CB_OPTIM_DEF (COB_ADDSWP_U48) -CB_OPTIM_DEF (COB_ADDSWP_S48) -CB_OPTIM_DEF (COB_ADDSWP_U56) -CB_OPTIM_DEF (COB_ADDSWP_S56) -CB_OPTIM_DEF (COB_ADDSWP_U64) -CB_OPTIM_DEF (COB_ADDSWP_S64) - -CB_OPTIM_DEF (COB_SUBSWP_U16) -CB_OPTIM_DEF (COB_SUBSWP_S16) -CB_OPTIM_DEF (COB_SUBSWP_U24) -CB_OPTIM_DEF (COB_SUBSWP_S24) -CB_OPTIM_DEF (COB_SUBSWP_U32) -CB_OPTIM_DEF (COB_SUBSWP_S32) -CB_OPTIM_DEF (COB_SUBSWP_U40) -CB_OPTIM_DEF (COB_SUBSWP_S40) -CB_OPTIM_DEF (COB_SUBSWP_U48) -CB_OPTIM_DEF (COB_SUBSWP_S48) -CB_OPTIM_DEF (COB_SUBSWP_U56) -CB_OPTIM_DEF (COB_SUBSWP_S56) -CB_OPTIM_DEF (COB_SUBSWP_U64) -CB_OPTIM_DEF (COB_SUBSWP_S64) - -CB_OPTIM_DEF (COB_SETSWP_U16) -CB_OPTIM_DEF (COB_SETSWP_S16) -CB_OPTIM_DEF (COB_SETSWP_U24) -CB_OPTIM_DEF (COB_SETSWP_S24) -CB_OPTIM_DEF (COB_SETSWP_U32) -CB_OPTIM_DEF (COB_SETSWP_S32) -CB_OPTIM_DEF (COB_SETSWP_U40) -CB_OPTIM_DEF (COB_SETSWP_S40) -CB_OPTIM_DEF (COB_SETSWP_U48) -CB_OPTIM_DEF (COB_SETSWP_S48) -CB_OPTIM_DEF (COB_SETSWP_U56) -CB_OPTIM_DEF (COB_SETSWP_S56) -CB_OPTIM_DEF (COB_SETSWP_U64) -CB_OPTIM_DEF (COB_SETSWP_S64) -CB_OPTIM_DEF (COB_GET_NUMDISP64) -CB_OPTIM_DEF (COB_GET_NUMDISPS) -CB_OPTIM_DEF (COB_GET_NUMDISPS64) diff -Nru gnucobol-4.0~early~20200606/cobc/config.c gnucobol-5/cobc/config.c --- gnucobol-4.0~early~20200606/cobc/config.c 2020-06-06 20:51:59.000000000 +0000 +++ gnucobol-5/cobc/config.c 1970-01-01 00:00:00.000000000 +0000 @@ -1,817 +0,0 @@ -/* - Copyright (C) 2003-2012, 2014-2017, 2019-2020 Free Software Foundation, Inc. - Written by Keisuke Nishida, Roger While, Simon Sobisch - - This file is part of GnuCOBOL. - - The GnuCOBOL compiler is free software: you can redistribute it - and/or modify it under the terms of the GNU General Public License - as published by the Free Software Foundation, either version 3 of the - License, or (at your option) any later version. - - GnuCOBOL is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with GnuCOBOL. If not, see . -*/ - - -#include -#include - -#include -#include -#include -#include -#include -#include - -#include "cobc.h" -#include "tree.h" - -enum cb_config_type { - CB_ANY = 0, - CB_INT, /* integer */ - CB_STRING, /* "..." */ - CB_BOOLEAN, /* 'yes', 'no' */ - CB_SUPPORT, /* 'ok', 'archaic', 'obsolete', - 'skip', 'ignore', 'unconformable' */ - CB_SIZE /* size so may have K M G appended */ -}; - -/* Global variables */ - -#define CB_CONFIG_ANY(type,var,name,doc) type var = (type)0; -#define CB_CONFIG_INT(var,name,min,max,odoc,doc) unsigned int var = 0; -#define CB_CONFIG_SIZE(var,name,min,max,odoc,doc) unsigned long var = 0; -#define CB_CONFIG_STRING(var,name,doc) const char *var = NULL; -#define CB_CONFIG_BOOLEAN(var,name,doc) int var = 0; -#define CB_CONFIG_SUPPORT(var,name,doc) enum cb_support var = CB_OK; - -#include "config.def" - -#undef CB_CONFIG_ANY -#undef CB_CONFIG_INT -#undef CB_CONFIG_SIZE -#undef CB_CONFIG_STRING -#undef CB_CONFIG_BOOLEAN -#undef CB_CONFIG_SUPPORT - -/* Previously done, but currently not actually used, - recheck this later (possible output on cobc --print-config) */ -#define COBC_STORES_CONFIG_VALUES 0 - -#define CB_CONFIG_ANY(type,var,name,doc) , {CB_ANY, name, (void *)&var} -#if COBC_STORES_CONFIG_VALUES -#define CB_CONFIG_INT(var,name,min,max,odoc,doc) , {CB_INT, name, (void *)&var, NULL, min, max} -#define CB_CONFIG_SIZE(var,name,min,max,odoc,doc) , {CB_SIZE, name, (void *)&var, NULL, min, max} -#else -#define CB_CONFIG_INT(var,name,min,max,odoc,doc) , {CB_INT, name, (void *)&var, 0, min, max} -#define CB_CONFIG_SIZE(var,name,min,max,odoc,doc) , {CB_SIZE, name, (void *)&var, 0, min, max} -#endif -#define CB_CONFIG_STRING(var,name,doc) , {CB_STRING, name, (void *)&var} -#define CB_CONFIG_BOOLEAN(var,name,doc) , {CB_BOOLEAN, name, (void *)&var} -#define CB_CONFIG_SUPPORT(var,name,doc) , {CB_SUPPORT, name, (void *)&var} - -/* Local variables */ - -static struct config_struct { - const enum cb_config_type type; - const char *name; /* Print name set in compiler configuration */ - void *var; /* Var name */ -#if COBC_STORES_CONFIG_VALUES - char *val; /* value from configuration / command line */ -#else - int set; /* value was set by configuration / command line */ -#endif -#if 0 /* Currently not used */ - const int doc; /* documented, 1 = yes */ -#endif - int min_value; /* Minimum accepted value */ - long max_value; /* Maximum accepted value */ - -} config_table[] = { - {CB_STRING, "include"}, - {CB_STRING, "includeif"}, - {CB_STRING, "not-reserved"}, - {CB_STRING, "reserved"}, - {CB_STRING, "not-intrinsic-function"}, - {CB_STRING, "intrinsic-function"}, - {CB_STRING, "not-system-name"}, - {CB_STRING, "system-name"}, - {CB_STRING, "not-register"}, - {CB_STRING, "register"} -#include "config.def" -}; - -#undef CB_CONFIG_ANY -#undef CB_CONFIG_INT -#undef CB_CONFIG_SIZE -#undef CB_CONFIG_STRING -#undef CB_CONFIG_BOOLEAN -#undef CB_CONFIG_SUPPORT - -#define CB_CONFIG_SIZE sizeof(config_table) / sizeof(struct config_struct) - -/* Configuration includes */ -static struct include_list { - struct include_list *next; - const char *name; -} *conf_includes = NULL; - -/* type of include */ -enum cb_include_type { - CB_INCLUDE_MANDATORY = 0, - CB_INCLUDE_OPTIONAL, - CB_INCLUDE_RESOLVE_WORDS -}; - -const char *words_file = NULL; - -/* Local declarations */ - -static int cb_read_conf (const char *, FILE *); - -/* Local functions */ - -static char * -read_string (char *text) -{ - char *s; - - if (*text == '\"') { - text++; - } - s = cobc_main_strdup (text); - for (text = s; *text; text++) { - if (*text == '\"') { - *text = '\0'; - } - } - return s; -} - -static void -invalid_value (const char *fname, const int line, const char *name, const char *val, - const char *str, const int min, const long max) -{ - configuration_error (fname, line, 0, - _("invalid value '%s' for configuration tag '%s'"), val, name); - if (str) { - configuration_error (fname, line, 1, - _("should be one of the following values: %s"), str); - } else if (max == min && max == 0) { - configuration_error (fname, line, 1, _("must be numeric")); - } else if (max) { - configuration_error (fname, line, 1, _("maximum value: %lu"), (unsigned long)max); - } else { - configuration_error (fname, line, 1, _("minimum value: %d"), min); - } -} - -static int -check_valid_value (const char *fname, const int line, const char *name, const char *val, - const void *var, const int min_value, const long max_value) -{ - int ret = 1; - long v; - - v = atol (val); - - if (v < min_value) { - invalid_value (fname, line, name, val, NULL, min_value, 0); - ret = 0; - } - if (v > max_value) { - invalid_value (fname, line, name, val, NULL, 0, max_value); - ret = 0; - } - if (ret) { - *((int *)var) = v; - } - return ret; -} - -#if 0 -static void -unsupported_value (const char *fname, const int line, const char *name, const char *val) -{ - configuration_error (fname, line, 1, - _("unsupported value '%s' for configuration tag '%s'"), val, name); -} -#endif - -static void -split_and_iterate_on_comma_separated_str ( - void (* const func)(const char *, const char *, const int), - const int transform_case, const int replace_colons, - const char *val, const char *fname, const int line) -{ - unsigned int i; - unsigned int j = 0; - char word_buff[COB_MINI_BUFF]; - - for (i = 0; val[i] && j < COB_MINI_MAX; i++) { - /* note: we actually want spaces in, - especially for mnemonics "SWITCH A" and registers "LENGTH OF" - */ - switch (val[i]) { - case ' ': - /* Remove spaces if not escaped, especially needed for - mnemonics "SWITCH A" and registers "LENGTH OF" */ - if (j > 0 && word_buff[j - 1] == '\\') { - word_buff[j - 1] = ' '; - } - break; - case '\t': - /* Tabs are always removed. */ - break; - case ',': - word_buff[j] = 0; - (*func) (word_buff, fname, line); - memset (word_buff, 0, COB_MINI_BUFF); - j = 0; - break; - case ':': - if (replace_colons) { - word_buff[j++] = '='; - break; - } - default: - if (transform_case == 1) { - word_buff[j++] = (char)toupper ((int)val[i]); - } else if (transform_case == 2) { - word_buff[j++] = (char)tolower ((int)val[i]); - } else {; - word_buff[j++] = val[i]; - } - break; - } - } - word_buff[j] = 0; - - if (j != 0) { - (*func) (word_buff, fname, line); - } -} - -static int -cb_load_conf_file (const char *conf_file, const enum cb_include_type include_type) -{ - FILE *fp; - char buff[COB_SMALL_BUFF]; - char filename[COB_NORMAL_BUFF]; - struct include_list *c, *cc; - int i, ret; - - for (i = 0; conf_file[i] != 0 && conf_file[i] != SLASH_CHAR; i++); - if (conf_file[i] == 0) { /* Just a name, No directory */ - if (access(conf_file, F_OK) != 0) { /* and file does not exist */ - /* check for path of previous configuration file (for includes) */ - c = conf_includes; - if (c) { - while (c->next != NULL) { - c = c->next; - } - } - filename[0] = 0; - if (c && c->name) { - strncpy (buff, conf_includes->name, (size_t)COB_SMALL_MAX); - buff[COB_SMALL_MAX] = 0; - for (i = (int)strlen (buff); i != 0 && buff[i] != SLASH_CHAR; i--); - if (i != 0) { - buff[i] = 0; - snprintf (filename, (size_t)COB_NORMAL_MAX, "%s%c%s", buff, SLASH_CHAR, conf_file); - filename[COB_NORMAL_MAX] = 0; - if (access (filename, F_OK) == 0) { /* and prefixed file exist */ - conf_file = filename; /* Prefix last directory */ - } else { - filename[0] = 0; - } - } - } - if (filename[0] == 0) { - /* check for COB_CONFIG_DIR (use default if not in environment) */ - snprintf (filename, (size_t)COB_NORMAL_MAX, "%s%c%s", cob_config_dir, SLASH_CHAR, conf_file); - filename[COB_NORMAL_MAX] = 0; - if (access (filename, F_OK) == 0) { /* and prefixed file exist */ - conf_file = filename; /* Prefix COB_CONFIG_DIR */ - } - } - } - } - - /* check for recursion */ - c = cc = conf_includes; - while (c != NULL) { - if (c->name /* <- silence warnings */ && strcmp (c->name, conf_file) == 0) { - configuration_error (conf_file, 0, 1, _("recursive inclusion")); - return -2; - } - cc = c; - c = c->next; - } - - /* Special "check only" type */ - if (include_type == CB_INCLUDE_RESOLVE_WORDS) { - words_file = cobc_main_strdup (conf_file); - return access (words_file, F_OK); - } - - /* Open the configuration file */ - fp = fopen (conf_file, "r"); - if (fp == NULL) { - if (include_type != CB_INCLUDE_OPTIONAL) { - cb_perror (1, "%s: %s", conf_file, cb_get_strerror ()); - return -1; - } else { - return 0; - } - } - - /* add current entry to list*/ - c = cob_malloc (sizeof (struct include_list)); - c->next = NULL; - c->name = conf_file; - if (cc != NULL) { - cc->next = c; - } else { - conf_includes = c; - } - - /* Read the configuration file */ - ret = cb_read_conf (conf_file, fp); - - fclose (fp); - - /* remove current entry from memory and list*/ - if (cc) { - cc->next = NULL; - } else { - conf_includes = NULL; - } - cob_free (c); - - return ret; -} - -/* Read the configuration file previously opened */ -static int -cb_read_conf (const char *conf_file, FILE *fp) -{ - int sub_ret, ret; - int line; - char buff[COB_SMALL_BUFF]; - enum cb_include_type include_type; - - /* Read the configuration file */ - ret = 0; - line = 0; - while (fgets (buff, COB_SMALL_BUFF, fp)) { - line++; - sub_ret = cb_config_entry (buff, conf_file, line); - if (sub_ret == 1 || sub_ret == 3) { - if (sub_ret == 1) { - include_type = CB_INCLUDE_MANDATORY; - } else { - include_type = CB_INCLUDE_OPTIONAL; - } - sub_ret = cb_load_conf_file (buff, include_type); - if (sub_ret < 0) { - ret = -1; - configuration_error (conf_file, line, 1, - _("configuration file was included here")); - break; - } - } - if (sub_ret != 0) ret = sub_ret; - } - return ret; -} - - -/* Global functions */ - -int -cb_load_std (const char *name) -{ - return cb_load_conf (name, CB_INCLUDE_MANDATORY); -} - -int -cb_load_conf (const char *fname, const int prefix_dir) -{ - const char *name; - int ret; - size_t i; - char buff[COB_NORMAL_BUFF]; - - /* Warn if we drop the configuration read already */ - if (unlikely(cb_config_name != NULL)) { - configuration_warning (fname, 0, - _("The previous loaded configuration '%s' will be discarded."), - cb_config_name); - } - - /* Initialize the configuration table */ - for (i = 0; i < CB_CONFIG_SIZE; i++) { -#if COBC_STORES_CONFIG_VALUES - config_table[i].val = NULL; -#else - config_table[i].set = 0; -#endif - } - - /* Get the name for the configuration file */ - if (prefix_dir) { - snprintf (buff, (size_t)COB_NORMAL_MAX, - "%s%c%s", cob_config_dir, SLASH_CHAR, fname); - name = buff; - } else { - name = fname; - } - - ret = cb_load_conf_file (name, CB_INCLUDE_MANDATORY); - - /* Checks for missing definitions */ - if (ret == 0) { - for (i = 10U; i < CB_CONFIG_SIZE; i++) { -#if COBC_STORES_CONFIG_VALUES - if (config_table[i].val == NULL) { -#else - if (config_table[i].set == 0) { -#endif - /* as there are likely more than one definition missing group it */ - if (ret == 0) { - configuration_error (fname, 0, 1, _("missing definitions:")); - } - configuration_error (fname, 0, 1, _("\tno definition of '%s'"), - config_table[i].name); - ret = -1; - } - } - } - - return ret; -} - -int -cb_load_words (void) -{ - FILE *fp; - int ret; - - /* Open the word-list file */ - fp = fopen (words_file, "r"); - if (fp == NULL) { - cb_perror (1, "%s: %s", words_file, cb_get_strerror ()); - return -1; - } - - /* Read the word-list file */ - ret = cb_read_conf (words_file, fp); - - fclose (fp); - - return ret; -} - -int -cb_config_entry (char *buff, const char *fname, const int line) -{ - char *s; - const char *name; - char *e; - char *val, valx[24]; - void *var; - enum cb_support support_val; - size_t i; - size_t j; - - /* ignore leading white-spaces */ - while (*buff == '\t' || *buff == ' ') { - buff++; - } - - /* ignore empty / comment line */ - if (*buff == 0 || *buff == '\r' || *buff == '\n' || *buff == '#') { - return 0; - } - - /* get tag */ - s = strpbrk (buff, " \t:="); - if (!s) { - /* no tag separator --> error (remove CR LF for message) */ - for (j = strlen(buff); buff[j - 1] == '\r' || buff[j - 1] == '\n';) { - buff[--j] = 0; - } - configuration_error (fname, line, 1, - _("invalid configuration tag '%s'"), buff); - return -1; - } - *s = 0; - - /* Find entry */ - for (i = 0; i < CB_CONFIG_SIZE; i++) { - if (strcmp (buff, config_table[i].name) == 0) { - break; - } - } - if (i == CB_CONFIG_SIZE) { - configuration_error (fname, line, 1, - _("unknown configuration tag '%s'"), buff); - return -1; - } -#if 0 /* currently not possible (all entries from config.def are included - --> no gettext for messages here */ - /* if not included in documentation: reject for command line */ - if (!fname && config_table[i].doc == 0) { - configuration_error (NULL, 0, 1, - "'%s' cannot be set via command line", config_table[i].name); - return -1; - } -#endif - - /* Check for reserved word tag, if requested */ - if (fname == words_file) { - if (strcmp (buff, "reserved") - && strcmp (buff, "not-reserved") - && strcmp (buff, "intrinsic-function") - && strcmp (buff, "not-intrinsic-function") - && strcmp (buff, "system-name") - && strcmp (buff, "not-system-name") - && strcmp (buff, "register") - && strcmp (buff, "not-register")) { - configuration_error (fname, line, 1, - _("invalid configuration tag '%s' in word-list"), buff); - return -1; - } - } - - /* Get value */ - /* Move pointer to beginning of value */ - for (s++; *s && strchr (" \t:=", *s); s++) { - ; - } - /* Set end pointer to first # (comment) or end of value */ - for (e = s + 1; *e && !strchr ("#", *e); e++) { - ; - } - /* Remove trailing white-spaces */ - for (--e; e >= s && strchr (" \t\r\n", *e); e--) { - ; - } - e[1] = 0; - - /* Set value */ - name = config_table[i].name; - var = config_table[i].var; - val = s; - - switch (config_table[i].type) { - case CB_STRING: - val = read_string (val); - - if (strcmp (name, "include") == 0 - || strcmp (name, "includeif") == 0) { - /* Include another conf file */ - s = cob_expand_env_string ((char *)val); - cobc_main_free ((void *) val); - strncpy (buff, s, COB_SMALL_MAX); - /* special case: use cob_free (libcob) here as the memory - was allocated in cob_expand_env_string -> libcob */ - cob_free (s); - if (strcmp (name, "includeif") == 0) { - return 3; - } else { - return 1; - } - } else if (strcmp (name, "reserved-words") == 0) { - /* store translated to lower case */ - for (e = (char *)val; *e; e++) { - if (isupper (*e)) { - *e = (cob_u8_t)tolower (*e); - } - } - /* if explicit requested: disable */ - if (strcmp (val, "default") == 0 - || strcmp (val, "off") == 0) { - *((const char **)var) = NULL; - } else { - *((const char **)var) = val; - snprintf (buff, (size_t)COB_NORMAL_MAX, "%s.words", val); - /* check if name.words exists and store the resolved name to words_file */ - if (cb_load_conf_file (buff, CB_INCLUDE_RESOLVE_WORDS) != 0) { - configuration_error (fname, line, 1, _("Could not access word list for '%s'"), val); - /*cb_perror (1, "%s: %s", words_file, cb_get_strerror ()); */ - return -1; - }; - } - } else if (strcmp (name, "not-reserved") == 0) { - split_and_iterate_on_comma_separated_str (&remove_reserved_word, 0, 0, val, fname, line); - split_and_iterate_on_comma_separated_str (&deactivate_intrinsic, 1, 0, val, fname, line); - split_and_iterate_on_comma_separated_str (&deactivate_system_name, 1, 0, val, fname, line); - split_and_iterate_on_comma_separated_str (&remove_register, 1, 0, val, fname, line); - } else if (strcmp (name, "reserved") == 0) { - split_and_iterate_on_comma_separated_str (&add_reserved_word, 0, 1, val, fname, line); - } else if (strcmp (name, "not-intrinsic-function") == 0) { - split_and_iterate_on_comma_separated_str (&deactivate_intrinsic, 1, 0, val, fname, line); - } else if (strcmp (name, "intrinsic-function") == 0) { - split_and_iterate_on_comma_separated_str (&activate_intrinsic, 1, 1, val, fname, line); - } else if (strcmp (name, "not-system-name") == 0) { - split_and_iterate_on_comma_separated_str (&deactivate_system_name, 1, 0, val, fname, line); - } else if (strcmp (name, "system-name") == 0) { - split_and_iterate_on_comma_separated_str (&activate_system_name, 1, 1, val, fname, line); - } else if (strcmp (name, "not-register") == 0) { - split_and_iterate_on_comma_separated_str (&remove_register, 1, 0, val, fname, line); - } else if (strcmp (name, "register") == 0) { - split_and_iterate_on_comma_separated_str (&add_register, 1, 1, val, fname, line); - } else { - *((const char **)var) = val; - } - break; - - case CB_BOOLEAN: - if (strcmp (val, "yes") == 0) { - *((int *)var) = 1; - } else if (strcmp (val, "no") == 0) { - *((int *)var) = 0; - } else { - invalid_value (fname, line, name, val, "yes, no", 0, 0); - return -1; - } - break; - - case CB_SUPPORT: - /* check if we are in "minimal mode" */ - s = (char *)val; - if (*s == '+') s++; - if (strcmp (s, "ok") == 0) { - support_val = CB_OK; - } else if (strcmp (s, "warning") == 0) { - support_val = CB_WARNING; - } else if (strcmp (s, "archaic") == 0) { - support_val = CB_ARCHAIC; - } else if (strcmp (s, "obsolete") == 0) { - support_val = CB_OBSOLETE; - } else if (strcmp (s, "skip") == 0) { - support_val = CB_SKIP; - } else if (strcmp (s, "ignore") == 0) { - support_val = CB_IGNORE; - } else if (strcmp (s, "error") == 0) { - support_val = CB_ERROR; - } else if (strcmp (s, "unconformable") == 0) { - support_val = CB_UNCONFORMABLE; - } else { - invalid_value (fname, line, name, s, - "ok, warning, archaic, obsolete, skip, ignore, error, unconformable", 0, 0); - return -1; - } - /* handling of special "adjust" mode */ - if (s != val) { - if (*((enum cb_support *)var) != CB_SKIP - && *((enum cb_support *)var) != CB_IGNORE - && *((enum cb_support *)var) > support_val) { - *((enum cb_support *)var) = support_val; - } - break; - } - /* normal handling */ - *((enum cb_support *)var) = support_val; - break; - - - case CB_ANY: - if (strcmp (name, "assign-clause") == 0) { - if ((strcmp (val, "dynamic") == 0) - || (strcmp (val, "mf") == 0)) { - cb_assign_type_default = CB_ASSIGN_VARIABLE_DEFAULT; - } else if ((strcmp (val, "external") == 0) - || (strcmp (val, "ibm") == 0)) { - cb_assign_type_default = CB_ASSIGN_EXT_FILE_NAME_REQUIRED; - } else { - invalid_value (fname, line, name, val, "dynamic, external, mf, ibm", 0, 0); - return -1; - } - break; - } else if (strcmp (name, "binary-size") == 0) { - if (strcmp (val, "2-4-8") == 0) { - cb_binary_size = CB_BINARY_SIZE_2_4_8; - } else if (strcmp (val, "1-2-4-8") == 0) { - cb_binary_size = CB_BINARY_SIZE_1_2_4_8; - } else if (strcmp (val, "1--8") == 0) { - cb_binary_size = CB_BINARY_SIZE_1__8; - } else { - invalid_value (fname, line, name, val, "2-4-8, 1-2-4-8, 1--8", 0, 0); - return -1; - } - break; - } else if (strcmp (name, "binary-byteorder") == 0) { - if (strcmp (val, "native") == 0) { - cb_binary_byteorder = CB_BYTEORDER_NATIVE; - } else if (strcmp (val, "big-endian") == 0) { - cb_binary_byteorder = CB_BYTEORDER_BIG_ENDIAN; - } else { - invalid_value (fname, line, name, val, "native, big-endian", 0, 0); - return -1; - } - break; - } else if (strcmp (name, "screen-section-rules") == 0) { - if (strcmp (val, "acu") == 0) { - cb_screen_section_clauses = CB_ACU_SCREEN_RULES; - } else if (strcmp (val, "gc") == 0) { - cb_screen_section_clauses = CB_GC_SCREEN_RULES; - } else if (strcmp (val, "mf") == 0) { - cb_screen_section_clauses = CB_MF_SCREEN_RULES; - } else if (strcmp (val, "rm") == 0) { - cb_screen_section_clauses = CB_RM_SCREEN_RULES; - } else if (strcmp (val, "std") == 0) { - cb_screen_section_clauses = CB_STD_SCREEN_RULES; - } else if (strcmp (val, "xopen") == 0) { - cb_screen_section_clauses = CB_XOPEN_SCREEN_RULES; - } else { - invalid_value (fname, line, name, val, "acu, gc, mf, rm, std, xopen", 0, 0); - return -1; - } - break; - /* for enums without a string value: set max_value and fall through to CB_INT */ - } else if (strcmp (name, "standard-define") == 0) { - config_table[i].max_value = CB_STD_MAX - 1; - /* fall through */ - /* LCOV_EXCL_START */ - } else { - /* note: internal error only (config.def doesn't match config.c), - therefore not translated */ - cobc_err_msg ("Invalid type %s for '%s'", "ANY", name); - COBC_ABORT (); - } - /* LCOV_EXCL_STOP */ - - case CB_INT: - for (j = 0; val[j]; j++) { - if (val[j] < '0' || val[j] > '9') { - invalid_value (fname, line, name, val, NULL, 0, 0); - return -1; - } - } - - if (check_valid_value (fname, line, name, val, var, - config_table[i].min_value, config_table[i].max_value)) { - break; - } else { - return -1; - } - - case CB_SIZE: - for (j = 0; val[j]; j++) { - if (toupper(val[j]) == 'K') { - sprintf(valx,"%ld",atol(val)*1024); - val = valx; - break; - } - if (toupper(val[j]) == 'M') { - sprintf(valx,"%ld",atol(val)*1024*1024); - val = valx; - break; - } - if (toupper(val[j]) == 'G') { - sprintf(valx,"%ld",atol(val)*1024*1024*1024); - val = valx; - break; - } - if (val[j] < '0' || val[j] > '9') { - invalid_value (fname, line, name, val, NULL, 0, 0); - return -1; - } - } - - if (check_valid_value (fname, line, name, val, var, - config_table[i].min_value, config_table[i].max_value)) { - break; - } else { - return -1; - } - - /* LCOV_EXCL_START */ - default: - /* note: internal error only (config.def doesn't match config.c), - therefore no translation */ - cobc_err_msg ("Invalid type %ds for '%s'", config_table[i].type, name); - COBC_ABORT (); - /* LCOV_EXCL_STOP */ - } - -#if COBC_STORES_CONFIG_VALUES - /* copy valid entries to config table */ - if (config_table[i].val) { - cobc_main_free ((void *)config_table[i].val); - } - config_table[i].val = cobc_main_strdup (val); -#else - config_table[i].set = 1; -#endif - return 0; -} diff -Nru gnucobol-4.0~early~20200606/cobc/config.def gnucobol-5/cobc/config.def --- gnucobol-4.0~early~20200606/cobc/config.def 2020-06-06 20:51:59.000000000 +0000 +++ gnucobol-5/cobc/config.def 1970-01-01 00:00:00.000000000 +0000 @@ -1,386 +0,0 @@ -/* - Copyright (C) 2001-2012, 2014-2020 Free Software Foundation, Inc. - Written by Keisuke Nishida, Roger While, Simon Sobisch, Edward Hart - - This file is part of GnuCOBOL. - - The GnuCOBOL compiler is free software: you can redistribute it - and/or modify it under the terms of the GNU General Public License - as published by the Free Software Foundation, either version 3 of the - License, or (at your option) any later version. - - GnuCOBOL is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with GnuCOBOL. If not, see . -*/ - -/* Definitions of variables in config/xxx.conf files - Possible override via -f(no-)tag or -ftag=value - */ - -/* Compiler configuration defines */ - -/* String (label) flags */ -/* CB_CONFIG_STRING (var, name, help) */ - -/* Flags with required parameter */ -/* Integer flags */ -/* CB_CONFIG_INT (var, name, min, max, option-help, help) */ -/* Support flags */ -/* CB_CONFIG_SUPPORT (var, name, help) */ - -/* Normal boolean flags */ -/* CB_CONFIG_BOOLEAN (var, name, help) */ - -/* Flags with required parameter and special values */ -/* CB_CONFIG_ANY (type, var, name, help) */ - - -/* String (label) flags */ - -CB_CONFIG_STRING (cb_config_name, "name", NULL) /* Configuration Name, any value */ - -CB_CONFIG_STRING (cb_reserved_words, "reserved-words", _("use of complete/fixed reserved words")) /* Reserved word list, filename */ - -/* Integer flags */ - -CB_CONFIG_INT (cb_tab_width, "tab-width", 1, 12, CB_XRANGE(1,12), - _("set number of spaces that are assumed for tabs")) - -CB_CONFIG_INT (cb_config_text_column, "text-column", 72, 255, CB_XRANGE(72,255), - _("set right margin for source (fixed format only)")) - -CB_CONFIG_INT (cb_pic_length, "pic-length", 1, COB_MINI_MAX, _(""), - _("maximum number of characters allowed in the PICTURE character-string")) - -CB_CONFIG_INT (cb_word_length, "word-length", 1, COB_MAX_WORDLEN, CB_XRANGE(1,COB_MAX_WORDLEN), - _("maximum word-length for COBOL (= programmer defined) words")) - -CB_CONFIG_INT (cb_lit_length, "literal-length", 1, COB_MAX_LITERAL_LEN, _(""), - _("maximum literal size in general")) - -CB_CONFIG_INT (cb_numlit_length, "numeric-literal-length", 1, COB_MAX_DIGITS, CB_XRANGE(1,COB_MAX_DIGITS), - _("maximum numeric literal size")) - -CB_CONFIG_INT (cb_align_record, "align-record", 0, 256, CB_XRANGE(0,256), - _("align WORKING-STORAGE/LOCAL-STORAGE record on boundary")) - -CB_CONFIG_BOOLEAN (cb_align_opt, "align-opt", - _("align like MF OPT, Default: false (Like MF ALIGN=FIXED)")) - - -/* Flags with required parameter and special values */ - -CB_CONFIG_ANY (enum cb_std_def, cb_std_define, "standard-define", NULL) /* Used Standard (set via -std) */ - -CB_CONFIG_ANY (enum cb_binary_size_options, cb_binary_size, "binary-size", - _("binary byte size - defines the allocated bytes according to PIC, may be one of: 2-4-8, 1-2-4-8, 1--8")) - -CB_CONFIG_ANY (enum cb_binary_byteorder_options, cb_binary_byteorder, "binary-byteorder", - _("binary byte order, may be one of: native, big-endian")) - -CB_CONFIG_ANY (enum cb_assign_type, cb_assign_type_default, "assign-clause", - _("how to interpret 'ASSIGN word': as 'ASSIGN EXTERNAL word' or 'ASSIGN DYNAMIC word'")) - -CB_CONFIG_ANY (enum cb_screen_clauses_rules, cb_screen_section_clauses, "screen-section-rules", - _("which compiler's rules to apply to SCREEN SECTION item clauses")) - -/* Normal boolean flags */ - -CB_CONFIG_BOOLEAN (cb_filename_mapping, "filename-mapping", - _("resolve file names at run time using environment variables.")) - -CB_CONFIG_BOOLEAN (cb_pretty_display, "pretty-display", - _("alternate formatting of numeric fields")) - -CB_CONFIG_BOOLEAN (cb_binary_truncate, "binary-truncate", - _("numeric truncation according to ANSI")) - -CB_CONFIG_BOOLEAN (cb_complex_odo, "complex-odo", - _("allow complex OCCURS DEPENDING ON")) - -CB_CONFIG_BOOLEAN (cb_indirect_redefines, "indirect-redefines", - _("allow REDEFINES to other than last equal level number")) - -CB_CONFIG_BOOLEAN (cb_larger_redefines_ok, "larger-redefines-ok", /* TO-DO: change to CB_CONFIG_SUPPORT */ - _("allow larger REDEFINES items")) - -CB_CONFIG_BOOLEAN (cb_relaxed_syntax_checks, "relax-syntax-checks", - _("allow certain syntax variations (e.g. REDEFINES position)")) - -CB_CONFIG_BOOLEAN (cb_relax_level_hierarchy, "relax-level-hierarchy", - _("allow non-matching level numbers")) - -CB_CONFIG_BOOLEAN (cb_sticky_linkage, "sticky-linkage", - _("LINKAGE-SECTION items remain allocated between invocations")) - -CB_CONFIG_BOOLEAN (cb_move_ibm, "move-ibm", /* counterpart for MF's BYTE-MODE-MOVE */ - _("MOVE operates as on IBM (left to right, byte by byte), otherwise no propagating move")) - -CB_CONFIG_BOOLEAN (cb_perform_osvs, "perform-osvs", - _("exit point of any currently executing perform is recognized if reached")) - -CB_CONFIG_BOOLEAN (cb_arithmetic_osvs, "arithmetic-osvs", - _("limit precision in intermediate results to precision of final result (less accurate)")) - -CB_CONFIG_BOOLEAN (cb_constant_folding, "constant-folding", - _("evaluate constant expressions at compile time")) - -CB_CONFIG_BOOLEAN (cb_host_sign, "hostsign", - _("allow hexadecimal value 'F' for NUMERIC test of signed PACKED DECIMAL field")) - -CB_CONFIG_BOOLEAN (cb_program_name_redefinition, "program-name-redefinition", - _("program names don't lead to a reserved identifier")) - -CB_CONFIG_BOOLEAN (cb_accept_update, "accept-update", - _("set WITH UPDATE clause as default for ACCEPT dest-item, instead of WITH NO UPDATE")) - -CB_CONFIG_BOOLEAN (cb_accept_auto, "accept-auto", - _("set WITH AUTO clause as default for ACCEPT dest-item, instead of WITH TAB")) - -CB_CONFIG_BOOLEAN (cb_console_is_crt, "console-is-crt", - _("assume CONSOLE IS CRT if not set otherwise")) - -CB_CONFIG_BOOLEAN (cb_no_echo_means_secure, "no-echo-means-secure", - _("NO-ECHO hides input with asterisks like SECURE")) - -CB_CONFIG_BOOLEAN (cb_line_col_zero_default, "line-col-zero-default", - _("assume a field DISPLAY starts at LINE 0 COL 0 (i.e. at the cursor), not LINE 1 COL 1")) - -CB_CONFIG_BOOLEAN (cb_report_column_plus, "report-column-plus", - _("in a REPORT COLUMN may have PLUS num, + num, or +num")) - -CB_CONFIG_BOOLEAN (cb_display_special_fig_consts, "display-special-fig-consts", - _("special behaviour of DISPLAY SPACE/ALL X'01'/ALL X'02'/ALL X'07'")) - -CB_CONFIG_BOOLEAN (cb_binary_comp_1, "binary-comp-1", - _("COMP-1 is a 16-bit signed integer")) - -CB_CONFIG_BOOLEAN (cb_move_nonnumlit_to_numeric_is_zero, "move-non-numeric-lit-to-numeric-is-zero", - _("imply zero in move of non-numeric literal to numeric items")) - -CB_CONFIG_BOOLEAN (cb_implicit_assign_dynamic_var, "implicit-assign-dynamic-var", - _("implicitly define a variable if an ASSIGN DYNAMIC does not match any data item")) - -/* Support flags */ - -CB_CONFIG_SUPPORT (cb_comment_paragraphs, "comment-paragraphs", - _("comment paragraphs in IDENTIFICATION DIVISION (AUTHOR, DATE-WRITTEN, ...)")) - -CB_CONFIG_SUPPORT (cb_memory_size_clause, "memory-size-clause", - _("MEMORY-SIZE clause")) - -CB_CONFIG_SUPPORT (cb_multiple_file_tape_clause, "multiple-file-tape-clause", - _("MULTIPLE-FILE-TAPE clause")) - -CB_CONFIG_SUPPORT (cb_label_records_clause, "label-records-clause", - _("LABEL-RECORDS clause")) - -CB_CONFIG_SUPPORT (cb_value_of_clause, "value-of-clause", - _("VALUE-OF clause")) - -CB_CONFIG_SUPPORT (cb_data_records_clause, "data-records-clause", - _("DATA-RECORDS clause")) - -CB_CONFIG_SUPPORT (cb_top_level_occurs_clause, "top-level-occurs-clause", - _("OCCURS clause on top-level")) - -#if 0 /* Simon: deemed to be not neccessary, see related bug #421 */ -CB_CONFIG_SUPPORT (cb_select_working, "select-working", - _("ASSIGN USING items outside of WORKING-STORAGE")) -#endif - -CB_CONFIG_SUPPORT (cb_same_as_clause, "same-as-clause", - _("SAME AS clause")) - -CB_CONFIG_SUPPORT (cb_synchronized_clause, "synchronized-clause", - _("SYNCHRONIZED clause")) - -CB_CONFIG_SUPPORT (cb_sync_left_right, "sync-left-right", - _("LEFT/RIGHT phrases in SYNCHRONIZED clause")) - -CB_CONFIG_SUPPORT (cb_special_names_clause, "special-names-clause", - _("SPECIAL-NAMES clause")) - -CB_CONFIG_SUPPORT (cb_goto_statement_without_name, "goto-statement-without-name", - _("GOTO statement without name")) - -CB_CONFIG_SUPPORT (cb_stop_literal_statement, "stop-literal-statement", - _("STOP-literal statement")) - -CB_CONFIG_SUPPORT (cb_stop_identifier_statement, "stop-identifier-statement", - _("STOP-identifier statement")) - -CB_CONFIG_SUPPORT (cb_debugging_mode, "debugging-mode", - _("DEBUGGING MODE and debugging indicator")) - -CB_CONFIG_SUPPORT (cb_use_for_debugging, "use-for-debugging", - "USE FOR DEBUGGING") - -CB_CONFIG_SUPPORT (cb_padding_character_clause, "padding-character-clause", - _("PADDING CHARACTER clause")) - -CB_CONFIG_SUPPORT (cb_next_sentence_phrase, "next-sentence-phrase", - _("NEXT SENTENCE phrase")) - -CB_CONFIG_SUPPORT (cb_listing_statements, "listing-statements", - _("listing-directive statements EJECT, SKIP1, SKIP2, SKIP3")) - -CB_CONFIG_SUPPORT (cb_title_statement, "title-statement", - _("listing-directive statement TITLE")) - -CB_CONFIG_SUPPORT (cb_entry_statement, "entry-statement", - _("ENTRY statement")) - -CB_CONFIG_SUPPORT (cb_move_noninteger_to_alphanumeric, "move-noninteger-to-alphanumeric", - _("move noninteger to alphanumeric")) - -CB_CONFIG_BOOLEAN (cb_occurs_max_length_without_subscript, "occurs-max-length-without-subscript", - _("occurs max length without subscript")) - -CB_CONFIG_BOOLEAN (cb_length_in_data_division, "length-in-data-division", - _("length in data division")) - -CB_CONFIG_SUPPORT (cb_move_fig_constant_to_numeric, "move-figurative-constant-to-numeric", - _("move figurative constants to numeric")) - -CB_CONFIG_SUPPORT (cb_move_fig_space_to_numeric, "move-figurative-space-to-numeric", - _("move figurative constant SPACE to numeric")) - -CB_CONFIG_SUPPORT (cb_move_fig_quote_to_numeric, "move-figurative-quote-to-numeric", - _("move figurative constant QUOTE to numeric")) - -CB_CONFIG_SUPPORT (cb_odo_without_to, "odo-without-to", - _("OCCURS DEPENDING ON without to")) - -CB_CONFIG_SUPPORT (cb_section_segments, "section-segments", - _("section segments")) - -CB_CONFIG_SUPPORT (cb_alter_statement, "alter-statement", - _("ALTER statement")) - -CB_CONFIG_SUPPORT (cb_call_overflow, "call-overflow", - _("OVERFLOW clause for CALL")) - -CB_CONFIG_SUPPORT (cb_numeric_boolean, "numeric-boolean", - _("boolean literals (B'1010')")) - -CB_CONFIG_SUPPORT (cb_hexadecimal_boolean, "hexadecimal-boolean", - _("hexadecimal-boolean literals (BX'A')")) - -CB_CONFIG_SUPPORT (cb_national_literals, "national-literals", - _("national literals (N'UTF-16 string')")) - -CB_CONFIG_SUPPORT (cb_national_hex_literals, "hexadecimal-national-literals", - _("hexadecimal-national literals (NX'265E')")) - -CB_CONFIG_SUPPORT (cb_nationalc_literals, "national-character-literals", - _("non-standard national literals (NC'UTF-16 string')")) - -CB_CONFIG_SUPPORT (cb_hp_octal_literals, "hp-octal-literals", - _("HP COBOL octal literals (%377)")) - -CB_CONFIG_SUPPORT (cb_acu_literals, "acu-literals", - _("ACUCOBOL-GT literals (#B #O #H #X)")) - -CB_CONFIG_SUPPORT (cb_word_continuation, "word-continuation", - _("continuation of COBOL words")) - -CB_CONFIG_SUPPORT (cb_not_exception_before_exception, "not-exception-before-exception", - _("NOT ON EXCEPTION before ON EXCEPTION")) - -CB_CONFIG_SUPPORT (cb_accept_display_extensions, "accept-display-extensions", - _("extensions to ACCEPT and DISPLAY")) - -CB_CONFIG_SUPPORT (cb_renames_uncommon_levels, "renames-uncommon-levels", - _("RENAMES of 01-, 66- and 77-level items")) - -CB_CONFIG_SUPPORT (cb_symbolic_constant, "symbolic-constant", - _("constants defined in SPECIAL-NAMES")) - -CB_CONFIG_SUPPORT (cb_constant_78, "constant-78", - _("constant with level 78 item (note: has left to right precedence in expressions)")) - -CB_CONFIG_SUPPORT (cb_constant_01, "constant-01", - _("constant with level 01 CONSTANT AS/FROM item")) /* COBOL 2002+ */ - -CB_CONFIG_SUPPORT (cb_perform_varying_without_by, "perform-varying-without-by", - _("PERFORM VARYING without BY phrase (implies BY 1)")) - -CB_CONFIG_SUPPORT (cb_reference_out_of_declaratives, "reference-out-of-declaratives", - _("references to sections not in DECLARATIVES from within DECLARATIVES")) - -CB_CONFIG_SUPPORT (cb_reference_bounds_check, "reference-bounds-check", - _("reference modification strict bounds check")) - -CB_CONFIG_SUPPORT (cb_program_prototypes, "program-prototypes", - _("CALL/CANCEL with program-prototype-name")) - -CB_CONFIG_SUPPORT (cb_call_convention_mnemonic, "call-convention-mnemonic", - _("specifying call-convention by mnemonic")) - -CB_CONFIG_SUPPORT (cb_call_convention_linkage, "call-convention-linkage", - _("specifying call-convention by WITH ... LINKAGE")) - -CB_CONFIG_SUPPORT (cb_numeric_value_for_edited_item, "numeric-value-for-edited-item", - _("numeric literals in VALUE clause of numeric-edited items")) - -CB_CONFIG_SUPPORT (cb_incorrect_conf_sec_order, "incorrect-conf-sec-order", - _("incorrect order of CONFIGURATION SECTION paragraphs")) /* OpenCOBOL/GnuCOBOL extension */ - -CB_CONFIG_SUPPORT (cb_define_constant_directive, "define-constant-directive", - _("allow >> DEFINE CONSTANT var AS literal")) /* OpenCOBOL/GnuCOBOL extension */ - -CB_CONFIG_SUPPORT (cb_free_redefines_position, "free-redefines-position", - _("REDEFINES clause not following entry-name in definition")) - -CB_CONFIG_SUPPORT (cb_records_mismatch_record_clause, "records-mismatch-record-clause", - _("record sizes does not match RECORD clause")) - -CB_CONFIG_SUPPORT (cb_record_delimiter, "record-delimiter", - _("RECORD DELIMITER clause")) - -CB_CONFIG_SUPPORT (cb_sequential_delimiters, "sequential-delimiters", - _("BINARY-SEQUENTIAL and LINE-SEQUENTIAL phrases in RECORD DELIMITER")) - -CB_CONFIG_SUPPORT (cb_record_delim_with_fixed_recs, "record-delim-with-fixed-recs", - _("RECORD DELIMITER clause on file with fixed-length records")) - -CB_CONFIG_SUPPORT (cb_missing_statement, "missing-statement", - _("missing statement (e.g. empty IF / PERFORM)")) - -CB_CONFIG_SUPPORT (cb_zero_length_lit, "zero-length-literals", - _("zero-length literals, e.g. '' and \"\"")) - -CB_CONFIG_SUPPORT (cb_xml_generate_extra_phrases, "xml-generate-extra-phrases", - _("XML GENERATE's phrases other than COUNT IN")) - -CB_CONFIG_SUPPORT (cb_continue_after, "continue-after", - _("AFTER phrase in CONTINUE statement")) - -CB_CONFIG_SUPPORT (cb_goto_entry, "goto-entry", - _("ENTRY FOR GOTO and GOTO ENTRY statements")) - -CB_CONFIG_SUPPORT (cb_depending_on_not_fixed, "depending-on-not-fixed", _("depending-on-not-fixed")) - -CB_CONFIG_SUPPORT (cb_binary_sync_clause, "binary-sync-clause", - _("BINARY-SHORT/LONG/DOUBLE SYNCHRONIZED clause")) - -CB_CONFIG_SUPPORT (cb_nonnumeric_with_numeric_group_usage, "nonnumeric-with-numeric-group-usage", - _("Non-numeric item with numeric group USAGE clause")) - -CB_CONFIG_SUPPORT (cb_assign_variable, "assign-variable", - _("ASSIGN [TO] variable in SELECT")) - -CB_CONFIG_SUPPORT (cb_assign_using_variable, "assign-using-variable", - _("ASSIGN USING/VARYING variable in SELECT")) - -CB_CONFIG_SUPPORT (cb_assign_ext_dyn, "assign-ext-dyn", - _("ASSIGN EXTERNAL/DYNAMIC in SELECT")) - -CB_CONFIG_SUPPORT (cb_assign_disk_from, "assign-disk-from", - _("ASSIGN DISK FROM variable in SELECT")) diff -Nru gnucobol-4.0~early~20200606/cobc/error.c gnucobol-5/cobc/error.c --- gnucobol-4.0~early~20200606/cobc/error.c 2020-06-06 20:51:59.000000000 +0000 +++ gnucobol-5/cobc/error.c 1970-01-01 00:00:00.000000000 +0000 @@ -1,819 +0,0 @@ -/* - Copyright (C) 2001-2012, 2014-2020 Free Software Foundation, Inc. - Written by Keisuke Nishida, Roger While, Simon Sobisch - - This file is part of GnuCOBOL. - - The GnuCOBOL compiler is free software: you can redistribute it - and/or modify it under the terms of the GNU General Public License - as published by the Free Software Foundation, either version 3 of the - License, or (at your option) any later version. - - GnuCOBOL is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with GnuCOBOL. If not, see . -*/ - - -#include - -#include -#include -#include -#include -#include -#include -#include - -#include "cobc.h" -#include "tree.h" - -static char *errnamebuff = NULL; -static struct cb_label *last_section = NULL; -static struct cb_label *last_paragraph = NULL; - -static int conf_error_displayed = 0; -static int last_error_line = 0; -static const char *last_error_file = "unknown"; /* no gettext for static initializer */ -static FILE *sav_lst_file = NULL; -static int ignore_error = 0; - -#define COBC_ERRBUF_SIZE 1024 - -size_t cb_msg_style; - -static void -print_error_prefix (const char *file, int line, const char *prefix) -{ - if (file) { - if (line > 0) { - if (cb_msg_style == CB_MSG_STYLE_MSC) { - fprintf (stderr, "%s(%d): ", file, line); - } else { - fprintf (stderr, "%s:%d: ", file, line); - } - } else { - fprintf (stderr, "%s: ", file); - } - } - if (prefix) { - fprintf (stderr, "%s", prefix); - } -} - -static void -print_error (const char *file, int line, const char *prefix, - const char *fmt, va_list ap) -{ - char errmsg[COB_SMALL_BUFF]; - - if (!file) { - file = cb_source_file; - } - if (!line) { - line = cb_source_line; - } - - /* Print section and/or paragraph name */ - if (current_section != last_section) { - if (current_section && !current_section->flag_dummy_section) { - if (file) { - fprintf (stderr, "%s: ", file); - } - fprintf (stderr, _("in section '%s':"), - (char *)current_section->name); - fputs ("\n", stderr); - } - last_section = current_section; - } - if (current_paragraph != last_paragraph) { - if (current_paragraph && !current_paragraph->flag_dummy_paragraph) { - if (file) { - fprintf (stderr, "%s: ", file); - } - fprintf (stderr, _("in paragraph '%s':"), - (char *)current_paragraph->name); - fputs ("\n", stderr); - } - last_paragraph = current_paragraph; - } - - /* Print the error */ - print_error_prefix (file, line, prefix); - vsprintf (errmsg, fmt, ap); - fprintf (stderr, "%s\n", errmsg); - - if (cb_src_list_file) { - cb_add_error_to_listing (file, line, prefix, errmsg); - } -} -static void -configuration_error_head (void) -{ - if (conf_error_displayed) { - return; - } - conf_error_displayed = 1; - fputs (_("configuration error:"), stderr); - putc ('\n', stderr); -} - -/* reentrant version of strerror */ -char * -cb_get_strerror (void) -{ -#ifdef HAVE_STRERROR - return (char *)cobc_main_strdup (strerror (errno)); -#else - char * msg; - msg = cobc_main_malloc ((size_t)COBC_ERRBUF_SIZE); - snprintf (msg, COBC_ERRBUF_SIZE - 1, _("system error %d"), errno); - return msg; -#endif -} - -/* set the value for "ignore errors because instruction is - in a constant FALSE path which gets no codegen at all" - if state is -1, don't set the value - - returns the value which was active on call -*/ -int -cb_set_ignore_error (int state) -{ - int prev = ignore_error; - if (state != -1) { - ignore_error = state; - } - return prev; -} - -void -cb_add_error_to_listing (const char *file, int line, - const char *prefix, char *errmsg) -{ - /* If we have a file, queue message for listing processing */ - if (cb_current_file) { - struct list_error *err; - struct list_files *cfile; - - /* set up listing error */ - err = cobc_malloc (sizeof (struct list_error)); - err->line = line; - if (file) { - err->file = cobc_strdup (file); - } else { - err->file = NULL; - } - if (prefix) { - err->prefix = cobc_strdup (prefix); - } else { - err->prefix = NULL; - } - err->msg = cobc_strdup (errmsg); - - /* set correct listing entry for this file */ - cfile = cb_current_file; - if (!cfile->name - || (file && strcmp (cfile->name, file))) { - cfile = cfile->copy_head; - while (cfile) { - if (file && cfile->name - && !strcmp (cfile->name, file)) { - break; - } - cfile = cfile->next; - } - } - /* if file doesn't exist in the list then add to current file */ - if (!cfile) { - cfile = cb_current_file; - } - /* add error to listing entry */ - err->next = cfile->err_head; - cfile->err_head = err; - - /* Otherwise, just write error to the listing file */ - } else { - if (file) { - if (line > 0) { - if (cb_msg_style == CB_MSG_STYLE_MSC) { - fprintf (stderr, "%s(%d): ", file, line); - } else { - fprintf (stderr, "%s:%d: ", file, line); - } - } else { - fprintf (cb_src_list_file, "%s: ", file); - } - } - if (prefix) { - fprintf (cb_src_list_file, "%s ", prefix); - } - fprintf (cb_src_list_file, "%s\n", errmsg); - } -} - -void -cb_warning (int pref, const char *fmt, ...) -{ - va_list ap; - - if (!pref) { - return; - } - - va_start (ap, fmt); - print_error (NULL, 0, - (pref == COBC_WARN_AS_ERROR) ? _("error [-Werror]: ") : _("warning: "), - fmt, ap); - va_end (ap); - - if (sav_lst_file) { - return; - } - if (pref == COBC_WARN_AS_ERROR) { - if (++errorcount > cb_max_errors) { - cobc_too_many_errors (); - } - } else { - warningcount++; - } -} - -void -cb_error_always (const char *fmt, ...) -{ - va_list ap; - - cobc_in_repository = 0; - va_start (ap, fmt); - print_error (NULL, 0, _("error: "), fmt, ap); - va_end (ap); - - if (sav_lst_file) { - return; - } - if (++errorcount > cb_max_errors) { - cobc_too_many_errors (); - } -} - -/* raise error (or warning if current branch is not generated) */ -void -cb_error (const char *fmt, ...) -{ - va_list ap; - - cobc_in_repository = 0; - va_start (ap, fmt); - print_error (NULL, 0, ignore_error ? - _("error (ignored): "):_("error: "), fmt, ap); - va_end (ap); - - if (sav_lst_file) { - return; - } - if (ignore_error) { - warningcount++; - } else { - if (++errorcount > cb_max_errors) { - cobc_too_many_errors (); - } - } -} - -void -cb_perror (const int config_error, const char *fmt, ...) -{ - va_list ap; - - if (config_error) { - configuration_error_head(); - } - - va_start (ap, fmt); - print_error (NULL, 0, "", fmt, ap); - va_end (ap); - - - if (++errorcount > cb_max_errors) { - cobc_too_many_errors (); - } -} - -/* Warning/error for pplex.l input routine */ -/* At this stage we have not parsed the newline so that */ -/* cb_source_line needs to be adjusted by newline_count in pplex.l */ - -void -cb_plex_warning (int pref, const size_t sline, const char *fmt, ...) -{ - va_list ap; - - if (!pref) { - return; - } - - va_start (ap, fmt); - print_error (NULL, (int)(cb_source_line + sline), - (pref == COBC_WARN_AS_ERROR) ? _("error [-Werror]: ") : _("warning: "), - fmt, ap); - va_end (ap); - - if (sav_lst_file) { - return; - } - if (pref == COBC_WARN_AS_ERROR) { - if (++errorcount > cb_max_errors) { - cobc_too_many_errors (); - } - } else { - warningcount++; - } -} - -void -cb_plex_error (const size_t sline, const char *fmt, ...) -{ - va_list ap; - - va_start (ap, fmt); - print_error (NULL, (int)(cb_source_line + sline), ("error: "), fmt, ap); - va_end (ap); - - if (sav_lst_file) { - return; - } - if (++errorcount > cb_max_errors) { - cobc_too_many_errors (); - } -} - -unsigned int -cb_plex_verify (const size_t sline, const enum cb_support tag, - const char *feature) -{ - switch (tag) { - case CB_OK: - return 1; - case CB_WARNING: - cb_plex_warning (cb_warn_dialect, sline, _("%s used"), feature); - return 1; - case CB_ARCHAIC: - cb_plex_warning (cb_warn_archaic, sline, _("%s is archaic in %s"), - feature, cb_config_name); - return 1; - case CB_OBSOLETE: - cb_plex_warning (cb_warn_obsolete, sline, _("%s is obsolete in %s"), - feature, cb_config_name); - return 1; - case CB_SKIP: - return 0; - case CB_IGNORE: - cb_plex_warning (cb_warn_extra, sline, _("%s ignored"), feature); - return 0; - case CB_ERROR: - cb_plex_error (sline, _("%s used"), feature); - return 0; - case CB_UNCONFORMABLE: - cb_plex_error (sline, _("%s does not conform to %s"), - feature, cb_config_name); - return 0; - default: - break; - } - return 0; -} - -/* Warning/Error for config.c */ -void -configuration_warning (const char *fname, const int line, const char *fmt, ...) -{ - va_list args; - - conf_error_displayed = 0; - fputs (_("configuration warning:"), stderr); - fputc (' ', stderr); - - /* Prefix */ - if (fname != last_error_file - || line != last_error_line) { - last_error_file = fname; - last_error_line = line; - print_error_prefix (fname, line, NULL); - } - - /* Body */ - va_start(args, fmt); - vfprintf (stderr, fmt, args); - va_end(args); - - /* Postfix */ - putc('\n', stderr); - fflush(stderr); - - if (sav_lst_file) { - return; - } - warningcount++; -} - -void -configuration_error (const char *fname, const int line, - const int finish_error, const char *fmt, ...) -{ - va_list args; - - configuration_error_head (); - - /* Prefix */ - if (fname != last_error_file - || line != last_error_line) { - last_error_file = fname; - last_error_line = line; - print_error_prefix (fname, line, NULL); - } - - /* Body */ - va_start (args, fmt); - vfprintf (stderr, fmt, args); - va_end (args); - - /* Postfix */ - if (!finish_error) { - putc (';', stderr); - putc ('\n', stderr); - putc ('\t', stderr); - return; - } - - putc ('\n', stderr); - fflush (stderr); - - if (sav_lst_file) { - return; - } - - if (++errorcount > cb_max_errors) { - cobc_too_many_errors (); - } -} - -/* Generic warning/error routines */ -void -cb_warning_x (int pref, cb_tree x, const char *fmt, ...) -{ - va_list ap; - - if (!pref) { - return; - } - - va_start (ap, fmt); - print_error (x->source_file, x->source_line, - (pref == COBC_WARN_AS_ERROR) ? _("error [-Werror]: ") : _("warning: "), - fmt, ap); - va_end (ap); - - if (sav_lst_file) { - return; - } - if (pref == COBC_WARN_AS_ERROR) { - if (++errorcount > cb_max_errors) { - cobc_too_many_errors (); - } - } else { - warningcount++; - } -} - -void -cb_warning_dialect_x (const enum cb_support tag, cb_tree x, const char *fmt, ...) -{ - va_list ap; - - if (tag == CB_OK) { - return; - } - - va_start (ap, fmt); - print_error (x->source_file, x->source_line, - (tag == CB_ERROR) ? _("error: ") : _("warning: "), - fmt, ap); - va_end (ap); - - if (sav_lst_file) { - return; - } - if (tag == CB_ERROR) { - if (++errorcount > cb_max_errors) { - cobc_too_many_errors (); - } - } else { - warningcount++; - } -} - -void -cb_error_x (cb_tree x, const char *fmt, ...) -{ - va_list ap; - - va_start (ap, fmt); - print_error (x->source_file, x->source_line, ignore_error ? - _("error (ignored): "):_("error: "), fmt, ap); - va_end (ap); - - if (sav_lst_file) { - return; - } - if (ignore_error) { - warningcount++; - } else { - if (++errorcount > cb_max_errors) { - cobc_too_many_errors (); - } - } -} - -/** - * verify if the given compiler option is supported by the current std/configuration - * \param x tree whose position is used for raising warning/errors - * \return 1 = ok/warning/obsolete, 0 = skip/ignore/error/unconformable - */ -unsigned int -cb_verify_x (cb_tree x, const enum cb_support tag, const char *feature) -{ - int ignore_error_sav; - - if (!x) { - x = cobc_parse_malloc (sizeof (struct cb_tree_common)); - x->source_file = NULL; - x->source_line = 0; - } - - switch (tag) { - case CB_OK: - return 1; - case CB_WARNING: - cb_warning_x (cb_warn_dialect, x, _("%s used"), feature); - return 1; - case CB_ARCHAIC: - cb_warning_x (cb_warn_archaic, x, _("%s is archaic in %s"), - feature, cb_config_name); - return 1; - case CB_OBSOLETE: - cb_warning_x (cb_warn_obsolete, x, _("%s is obsolete in %s"), - feature, cb_config_name); - return 1; - case CB_SKIP: - return 0; - case CB_IGNORE: - cb_warning_x (cb_warn_extra, x, _("%s ignored"), feature); - return 0; - case CB_ERROR: - /* Fall-through */ - case CB_UNCONFORMABLE: - /* raise error in any case */ - ignore_error_sav = cb_set_ignore_error (0); - if (tag == CB_ERROR) { - cb_error_x (x, _("%s used"), feature); - } else { - cb_error_x (x, _("%s does not conform to %s"), feature, cb_config_name); - } - (void) cb_set_ignore_error (ignore_error_sav); - return 0; - - /* LCOV_EXCL_START */ - default: - /* This should never happen (and therefore doesn't get a translation) */ - cobc_err_msg ("unexpected compiler option value: %d", tag); - COBC_ABORT (); - /* LCOV_EXCL_STOP */ - } -#ifndef _MSC_VER - /* not reached */ - return 0; -#endif -} - -/** - * verify if the given compiler option is supported by the current std/configuration - * current position is used for raising warning/errors - * \returns 1 = ok/warning/obsolete, 0 = skip/ignore/error/unconformable - */ -unsigned int -cb_verify (const enum cb_support tag, const char *feature) -{ - return cb_verify_x (NULL, tag, feature); -} - -void -redefinition_error (cb_tree x) -{ - struct cb_word *w; - - w = CB_REFERENCE (x)->word; - cb_error_x (x, _("redefinition of '%s'"), w->name); - if (w->items) { - if (CB_VALUE (w->items)->source_line == 0) { - return; - } - listprint_suppress (); - cb_error_x (CB_VALUE (w->items), - _("'%s' previously defined here"), w->name); - listprint_restore (); - } -} - -void -redefinition_warning (cb_tree x, cb_tree y) -{ - struct cb_word *w; - cb_tree z; - - w = CB_REFERENCE (x)->word; - cb_warning_x (cb_warn_extra, x, _("redefinition of '%s'"), w->name); - z = NULL; - if (y) { - z = y; - } else if (w->items) { - z = CB_VALUE (w->items); - } - - if (z) { - if (z->source_line == 0) { - return; - } - listprint_suppress (); - cb_warning_x (cb_warn_extra, z, _("'%s' previously defined here"), w->name); - listprint_restore (); - } -} - -void -undefined_error (cb_tree x) -{ - struct cb_reference *r = CB_REFERENCE (x); - cb_tree c; - const char *error_message; - - if (!errnamebuff) { - errnamebuff = cobc_main_malloc ((size_t)COB_NORMAL_BUFF); - } - - /* Get complete variable name */ - snprintf (errnamebuff, (size_t)COB_NORMAL_MAX, "%s", CB_NAME (x)); - errnamebuff[COB_NORMAL_MAX] = 0; - if (r->chain) { - for (c = r->chain; c; c = CB_REFERENCE (c)->chain) { - strcat (errnamebuff, " IN "); - strcat (errnamebuff, CB_NAME (c)); - } - error_message = _("'%s' is not defined"); - } else { - if (is_reserved_word (CB_NAME (x))) { - error_message = _("'%s' cannot be used here"); - } else if (is_default_reserved_word (CB_NAME (x))) { - error_message = _("'%s' is not defined, but is a reserved word in another dialect"); - } else { - error_message = _("'%s' is not defined"); - } - } - - if (r->flag_optional) { - cb_warning_x (cb_warn_extra, x, error_message, errnamebuff); - } else { - cb_error_x (x, error_message, errnamebuff); - } -} - -void -ambiguous_error (cb_tree x) -{ - struct cb_word *w; - struct cb_field *p; - struct cb_label *l2; - cb_tree l; - cb_tree y; - - w = CB_REFERENCE (x)->word; - if (w->error == 0) { - if (!errnamebuff) { - errnamebuff = cobc_main_malloc ((size_t)COB_NORMAL_BUFF); - } - /* Display error the first time */ - snprintf (errnamebuff, (size_t)COB_NORMAL_MAX, "%s", CB_NAME (x)); - errnamebuff[COB_NORMAL_MAX] = 0; - for (l = CB_REFERENCE (x)->chain; l; l = CB_REFERENCE (l)->chain) { - strcat (errnamebuff, " IN "); - strcat (errnamebuff, CB_NAME (l)); - } - cb_error_x (x, _("'%s' is ambiguous; needs qualification"), errnamebuff); - w->error = 1; - - /* Display all fields with the same name */ - for (l = w->items; l; l = CB_CHAIN (l)) { - y = CB_VALUE (l); - errnamebuff[0] = 0; - strcat (errnamebuff, w->name); - switch (CB_TREE_TAG (y)) { - case CB_TAG_FIELD: - for (p = CB_FIELD (y)->parent; p; p = p->parent) { - strcat (errnamebuff, " IN "); - strcat (errnamebuff, cb_name (CB_TREE(p))); - } - break; - case CB_TAG_LABEL: - l2 = CB_LABEL (y); - if (l2->section) { - strcat (errnamebuff, " IN "); - strcat (errnamebuff, - (const char *)(l2->section->name)); - } - break; - default: - break; - } - if (y->source_line == 0) { - continue; - } - listprint_suppress (); - cb_error_x (y, _("'%s' defined here"), errnamebuff); - listprint_restore (); - } - } -} - -/* error routine for flex */ -void -flex_fatal_error (const char *msg, const char * filename, const int line_num) -{ - /* LCOV_EXCL_START */ - cobc_err_msg (_ ("fatal error: %s"), msg); - cobc_abort (filename, line_num); - /* LCOV_EXCL_STOP */ -} - -void -group_error (cb_tree x, const char *clause) -{ - cb_error_x (x, _("group item '%s' cannot have %s clause"), - cb_name (x), clause); -} - - -void -level_require_error (cb_tree x, const char *clause) -{ - const char *s; - const struct cb_field *f; - - s = cb_name (x); - f = CB_FIELD_PTR (x); - if (f->flag_item_78) { - cb_error_x (x, _("constant item '%s' requires a %s clause"), s, clause); - } else { - cb_error_x (x, _("level %02d item '%s' requires a %s clause"), f->level, - s, clause); - } -} - -void -level_except_error (cb_tree x, const char *clause) -{ - const char *s; - const struct cb_field *f; - - s = cb_name (x); - f = CB_FIELD_PTR (x); - if (f->flag_item_78) { - cb_error_x (x, _("constant item '%s' can only have a %s clause"), s, clause); - } else { - cb_error_x (x, _("level %02d item '%s' can only have a %s clause"), f->level, - s, clause); - } -} - -/* routines for temporary disable listing output of warnings/errors */ -void -listprint_suppress (void) -{ - if (cb_src_list_file) { - sav_lst_file = cb_src_list_file; - cb_src_list_file = NULL; - } -} - -void -listprint_restore (void) -{ - if (sav_lst_file) { - cb_src_list_file = sav_lst_file; - sav_lst_file = NULL; - } -} diff -Nru gnucobol-4.0~early~20200606/cobc/field.c gnucobol-5/cobc/field.c --- gnucobol-4.0~early~20200606/cobc/field.c 2020-06-06 20:51:59.000000000 +0000 +++ gnucobol-5/cobc/field.c 1970-01-01 00:00:00.000000000 +0000 @@ -1,3241 +0,0 @@ -/* - Copyright (C) 2001-2020 Free Software Foundation, Inc. - Written by Keisuke Nishida, Roger While, Simon Sobisch, Ron Norman, - Edward Hart - - This file is part of GnuCOBOL. - - The GnuCOBOL compiler is free software: you can redistribute it - and/or modify it under the terms of the GNU General Public License - as published by the Free Software Foundation, either version 3 of the - License, or (at your option) any later version. - - GnuCOBOL is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with GnuCOBOL. If not, see . -*/ - - -#include - -#include -#include -#include -#include -#include -#include - -#include "cobc.h" -#include "tree.h" - -/* sanity checks */ -#if COB_MAX_FIELD_SIZE > INT_MAX -#error COB_MAX_FIELD_SIZE is too big, must be less than INT_MAX -#endif -#if COB_MAX_UNBOUNDED_SIZE > INT_MAX -#error COB_MAX_UNBOUNDED_SIZE is too big, must be less than INT_MAX -#endif - -/* Function prototypes */ -static unsigned int validate_field_1 (struct cb_field *f); - -/* Global variables */ - -cb_tree cb_depend_check = NULL; -size_t cb_needs_01 = 0; - -/* Local variables */ - -static struct cb_field *last_real_field = NULL; -static int occur_align_size = 0; -static const int pic_digits[] = { 3, 5, 8, 10, 13, 15, 17, 19 }; -#define CB_MAX_OPS 32 -static int op_pos = 1, op_val_pos; -static char op_type [CB_MAX_OPS+1]; -static char op_prec [CB_MAX_OPS+1]; -static cob_s64_t op_val [CB_MAX_OPS+1]; -static int op_scale[CB_MAX_OPS+1]; - -/* Is list of values really an expression */ -static int -cb_is_expr (cb_tree ch) -{ - cb_tree t, l; - int num; - - if (op_pos >= 0) { - for (num=0; num < CB_MAX_OPS; num++) { - op_type [num] = ' '; - op_prec [num] = 0; - op_val [num] = 0; - } - } - op_pos = op_val_pos = -1; - num = 0; - for (l = ch; l; l = CB_CHAIN (l)) { - t = CB_VALUE (l); - if (t && CB_LITERAL_P (t)) { - if (++num > 1) - return 1; - } - } - return 0; -} - -static void -cb_eval_op ( void ) -{ - cob_s64_t lval, rval, xval; - int lscale, rscale, xscale; - - if (op_pos >= 0 - && op_val_pos > 0) { - lval = op_val [op_val_pos-1]; - lscale = op_scale [op_val_pos-1]; - rval = op_val [op_val_pos]; - rscale = op_scale [op_val_pos]; - op_val_pos--; - switch (op_type [op_pos]) { - case '+': - case '-': - while (lscale > rscale) { - rval = rval * 10; - rscale++; - } - while (lscale < rscale) { - lval = lval * 10; - lscale++; - } - xscale = lscale; - if (op_type [op_pos] == '+') - xval = lval + rval; - else - xval = lval - rval; - break; - case '*': - xscale = lscale + rscale; - xval = lval * rval; - break; - case '/': - while (rscale > 0) { - lval = lval * 10; - rscale--; - } - if (rval == 0) { - xscale = 0; - xval = 0; - cb_error (_("constant expression has Divide by ZERO")); - } else { - xscale = lscale; - xval = lval / rval; - } - break; - case '^': - while (rscale > 0) { /* Only whole number exponents */ - rval = rval / 10; - rscale--; - } - if (rval == 0 || lval == 1) { - xval = 1; - xscale = 0; - } else { - xval = lval; - xscale = lscale; - while(--rval > 0) { - xscale = xscale + lscale; - xval = xval * lval; - } - } - break; - case '&': - xscale = 0; - xval = (lval && rval); - break; - case '|': - xscale = 0; - xval = (lval || rval); - break; - case '>': - xscale = 0; - xval = (lval > rval); - break; - case '<': - xscale = 0; - xval = (lval < rval); - break; - case '=': - xscale = 0; - xval = (lval == rval); - break; - case ']': - xscale = 0; - xval = (lval >= rval); - break; - case '[': - xscale = 0; - xval = (lval <= rval); - break; - case '~': - xscale = 0; - xval = (lval != rval); - break; - case '(': - cb_error (_("missing right parenthesis")); - op_pos--; - return; - default: - op_pos--; - return; - } - op_pos--; - while (xscale > 0 - && (xval % 10) == 0) { - xscale--; - xval = xval / 10; - } - op_scale [op_val_pos] = xscale; - op_val [op_val_pos] = xval; - } -} - -static void -cb_push_op ( char op, int prec ) -{ - while (op_pos >= 0 - && op_val_pos > 0 - && prec > 0 - && op_type [op_pos] != '(' - && prec <= op_prec [op_pos]) { - cb_eval_op (); - } - if (op_pos >= CB_MAX_OPS) { - cb_error (_("expression stack overflow at %d entries for operation '%c'"), op_pos, op); - return; - } - op_pos++; - op_type [op_pos] = op; - op_prec [op_pos] = (char) prec; -} - -/* Evaluate expression and store as new Numeric Literal */ -static cb_tree -cb_evaluate_expr (cb_tree ch, int normal_prec) -{ - cb_tree t, l; - cob_s64_t xval; - int unop = 1, xscale, k; - char result[48]; - struct cb_literal *lp; - - for (l = ch; l; l = CB_CHAIN (l)) { - t = CB_VALUE (l); - if (t && CB_LITERAL_P (t)) { - lp = CB_LITERAL (t); - if (CB_NUMERIC_LITERAL_P (t)) { - xval = atoll((const char *)lp->data); - xscale = lp->scale; - if (unop) { - if (lp->sign < 0) /* Unary op, change sign */ - xval = -xval; - } else { - if (lp->sign < 0) { /* Treat 'sign' as binary op */ - cb_push_op ('-', 4); - } else if (lp->sign > 0) { - cb_push_op ('+', 4); - } - } - while (xscale > 0 - && (xval % 10) == 0) { /* Remove decimal zeros */ - xscale--; - xval = xval / 10; - } - if (op_val_pos >= CB_MAX_OPS) { - cb_error (_("expression stack overflow at %d entries"), op_val_pos); - return cb_error_node; - } - op_val_pos++; - op_val [op_val_pos] = xval; - op_scale [op_val_pos] = xscale; - unop = 0; - } else { - switch (lp->data[0]) { - case '(': - cb_push_op ('(', 0); - unop = 1; - break; - case ')': - unop = 0; - for (k=op_pos; k > 0 && op_type[k] != '('; k--); - if (op_type [k] != '(') - cb_error (_("missing left parenthesis")); - while (op_pos >= 0 - && op_val_pos > 0) { - if (op_type [op_pos] == '(') { - break; - } - cb_eval_op (); - } - if (op_pos >= 0 - && op_type [op_pos] == '(') - op_pos--; - break; - case '+': - cb_push_op ('+', 4); - unop = 1; - break; - case '-': - cb_push_op ('-', 4); - unop = 1; - break; - case '*': - cb_push_op ('*', normal_prec ? 6 : 4); - unop = 1; - break; - case '/': - cb_push_op ('/', normal_prec ? 6 : 4); - unop = 1; - break; - case '&': - cb_push_op ('&', normal_prec ? 8 : 4); - unop = 1; - break; - case '|': - cb_push_op ('|', normal_prec ? 8 : 4); - unop = 1; - break; - case '^': - cb_push_op ('^', normal_prec ? 7 : 4); - unop = 1; - break; - default: - cb_error (_("invalid operator '%s' in expression"),lp->data); - break; - } - } - } - } - while (op_pos >= 0 - && op_val_pos > 0) { - if (op_type [op_pos] == '(') { - cb_error (_("missing right parenthesis")); - op_pos--; - continue; - } - cb_eval_op (); - } - if (op_pos >= 0) { - if (op_type[op_pos] == '(') { - cb_error (_("missing right parenthesis")); - } else { - cb_error (_("'%c' operator misplaced"), op_type [op_pos]); - } - } - xval = op_val [0]; - xscale = op_scale [0]; - while (xscale > 0) { /* Reduce to 'fixed point numeric' */ - xscale--; - xval = xval / 10; - } - while (xscale < 0) { /* Reduce to 'fixed point numeric' */ - xscale++; - xval = xval * 10; - } - sprintf (result, CB_FMT_LLD, xval); - return cb_build_numeric_literal (0, result, xscale); -} - -int -cb_get_level (cb_tree x) -{ -#if 1 /* level always contains a valid tree with valid numeric values only - --> all validation is done in scanner.l */ - return atoi (CB_NAME (x)); -#else - const unsigned char *p; - const char *name; - int level; - - if (CB_INVALID_TREE (x)) { - return 0; - } - name = CB_NAME (x); - level = 0; - /* Get level */ - for (p = (const unsigned char *)name; *p; p++) { - if (!isdigit ((int)(*p))) { - goto level_error; - } - level = level * 10 + (*p - '0'); - if (level > 88) { - goto level_error; - } - } - - /* Check level */ - switch (level) { - case 66: - case 77: - case 78: - case 88: - break; - default: - if (level < 1 || level > 49) { - goto level_error; - } - break; - } - - return level; - -level_error: - cb_error_x (x, _("invalid level number '%s'"), name); - return 0; -#endif -} - -cb_tree -cb_build_field_tree (cb_tree level, cb_tree name, struct cb_field *last_field, - enum cb_storage storage, struct cb_file *fn, - const int expl_level) -{ - struct cb_reference *r; - struct cb_field *f; - struct cb_field *p; - struct cb_field *field_fill; - cb_tree dummy_fill; - cb_tree l; - cb_tree x; - int lv; - - if (!expl_level) { - /* note: the level number is always a valid tree, - the name may be a defined constant which leads to an error node here */ - if (name == cb_error_node) { - return cb_error_node; - } - /* Check the level number */ - lv = cb_get_level (level); -#if 0 /*level is always valid --> 01 thru 49, 77, 66, 78, 88 */ - if (!lv) { - return cb_error_node; - } -#endif - } else { - lv = expl_level; - } - - /* Build the field */ - r = CB_REFERENCE (name); - f = CB_FIELD (cb_build_field (name)); - f->storage = storage; - last_real_field = last_field; - if (lv == 78) { - f->level = 01; - f->flag_item_78 = 1; - f->flag_constant = 0; - return CB_TREE (f); - } else { - f->level = lv; - } - if (storage == CB_STORAGE_FILE && fn && f->level == 01) { - if (fn->flag_external) { - f->flag_external = 1; - current_program->flag_has_external = 1; - } else if (fn->flag_global) { - f->flag_is_global = 1; - } - } - if (last_field) { - if (last_field->same_as && f->level != 77 && f->level != 66 && f->level > last_field->level) { - cb_error_x (name, _("entry following SAME AS may not be subordinate to it")); - return cb_error_node; - } - if (last_field->level == 77 && f->level != 01 && - f->level != 77 && f->level != 66 && f->level != 88) { - cb_error_x (name, _("level number must begin with 01 or 77")); - return cb_error_node; - } - } - - /* Checks for redefinition */ - if (cb_warn_redefinition && r->word->count > 1 && !r->flag_filler_ref) { - if (f->level == 01 || f->level == 77) { - redefinition_warning (name, NULL); - } else { - for (l = r->word->items; l; l = CB_CHAIN (l)) { - x = CB_VALUE (l); - if (!CB_FIELD_P (x) - || CB_FIELD (x)->level == 01 - || CB_FIELD (x)->level == 77 - || (last_field && last_field->level == f->level - && last_field->parent == CB_FIELD (x)->parent)) { - redefinition_warning (name, x); - break; - } - } - } - } - - if (last_field && last_field->level == 88) { - last_field = last_field->parent; - } - - /* Link the field into the tree */ - if (f->level == 01 || f->level == 77) { - /* Top level */ - cb_needs_01 = 0; - if (last_field) { - cb_field_founder (last_field)->sister = f; - } - } else if (!last_field || cb_needs_01) { - /* Invalid top level */ - cb_error_x (name, _("level number must begin with 01 or 77")); - return cb_error_node; - } else if (f->level == 66) { - /* Level 66 */ - f->parent = cb_field_founder (last_field); - for (p = f->parent->children; p && p->sister; p = p->sister) ; - if (p) { - p->sister = f; - } - } else if (f->level == 88) { - /* Level 88 */ - f->parent = last_field; - if (last_real_field && last_real_field->level == 88) { - /* Level 88 sister */ - last_real_field->sister = f; - } else { - /* First Level 88 on this item */ - last_field->validation = f; - last_field = f; - } - } else if (f->level > last_field->level) { - /* Lower level */ - last_field->children = f; - f->parent = last_field; - } else if (f->level == last_field->level) { - /* Same level */ -same_level: - last_field->sister = f; - f->parent = last_field->parent; - } else { - /* Upper level */ - for (p = last_field->parent; p /* <- silence warnings */; p = p->parent) { - if (p->level == f->level) { - last_field = p; - goto same_level; - } - if (cb_relax_level_hierarchy && p->level < f->level) { - break; - } - } - if (cb_relax_level_hierarchy - && p /* <- silence warnings */) { - dummy_fill = cb_build_filler (); - field_fill = CB_FIELD (cb_build_field (dummy_fill)); - cb_warning_x (COBC_WARN_FILLER, name, - _("no previous data item of level %02d"), - f->level); - field_fill->level = f->level; - field_fill->flag_filler = 1; - field_fill->storage = storage; - field_fill->children = p->children; - field_fill->parent = p; - for (p = p->children; p; p = p->sister) { - p->parent = field_fill; - } - field_fill->parent->children = field_fill; - field_fill->sister = f; - f->parent = field_fill->parent; - /* last_field = field_fill; */ - } else { - cb_error_x (name, - _("no previous data item of level %02d"), - f->level); - return cb_error_node; - } - } - - /* Inherit parents properties */ - if (f->parent) { - f->usage = CB_USAGE_DISPLAY; /* Default to DISPLAY data */ - f->indexes = f->parent->indexes; - f->flag_sign_leading = f->parent->flag_sign_leading; - f->flag_sign_separate = f->parent->flag_sign_separate; - f->flag_is_global = f->parent->flag_is_global; - if (f->level <= 66) { - f->flag_volatile = f->parent->flag_volatile; - } - } - - if (storage == CB_STORAGE_FILE - && fn) { - if (cb_sqldb_name) - cb_parse_xfd (fn, f); - } - return CB_TREE (f); -} - -struct cb_field * -cb_resolve_redefines (struct cb_field *field, cb_tree redefines) -{ - struct cb_field *f; - struct cb_reference *r; - const char *name; - cb_tree x; - cb_tree candidate; - cb_tree items; - - r = CB_REFERENCE (redefines); - name = CB_NAME (redefines); - x = CB_TREE (field); - - /* Check qualification */ - if (r->chain) { - cb_error_x (x, _("'%s' cannot be qualified here"), name); - return NULL; - } - - /* Check subscripts */ - if (r->subs) { - cb_error_x (x, _("'%s' cannot be subscripted here"), name); - return NULL; - } - - /* Resolve the name in the current group (if any) */ - if (field->parent && field->parent->children) { - for (f = field->parent->children; f; f = f->sister) { - if (strcasecmp (f->name, name) == 0) { - break; - } - } - if (f == NULL) { - cb_error_x (x, _("'%s' is not defined in '%s'"), name, field->parent->name); - return NULL; - } - } else { - /* Get last defined name */ - candidate = NULL; - items = r->word->items; - for (; items; items = CB_CHAIN (items)) { - if (CB_FIELD_P (CB_VALUE (items))) { - candidate = CB_VALUE (items); - } - } - if (!candidate) { - undefined_error (redefines); - return NULL; - } - f = CB_FIELD_PTR (candidate); - } - - /* Check level number */ - if (f->level != field->level) { - cb_error_x (x, _("level number of REDEFINES entries must be identical")); - return NULL; - } - - if (!cb_indirect_redefines && f->redefines) { - cb_error_x (x, _("'%s' is not the original definition"), f->name); - return NULL; - } - - /* Return the original definition */ - while (f->redefines) { - f = f->redefines; - } - return f; -} - -struct cb_field * -copy_into_field (struct cb_field *source, struct cb_field *target, const int first) -{ - /* backup some entries */ - struct cb_tree_common common = target->common; - int id = target->id; - int level = target->level; - int occurs_min = target->occurs_min; - int occurs_max = target->occurs_max; - unsigned int occurs = target->flag_occurs; - unsigned char external = target->flag_external; - unsigned char global = target->flag_is_global; - enum cb_storage storage = target->storage; - const char *name = target->name; - const char *ename = target->ename; - struct cb_field *parent = target->parent; - struct cb_field *result_fld = target; - struct cb_field *redefines = target->redefines; - - /* copy everything and restore */ - memcpy (target, source, sizeof (struct cb_field)); - - target->common = common; - target->id = id; - target->level = level; - target->storage = storage; - target->flag_is_global = global; - target->flag_external = external; - target->flag_occurs = occurs; - target->occurs_min = occurs_min; - target->occurs_max = occurs_max; - if (name) { - target->name = name; - } - if (ename) { - target->name = ename; - } - target->parent = parent; -#if 0 /* temporary code to resolve a redefine from the source, likely not reasonable... */ - if (target->redefines) { - cb_tree x = cb_build_reference (target->redefines->name); - if (x != cb_error_node) { - target->redefines = cb_resolve_redefines (target, x); - } - } -#else - target->redefines = redefines; -#endif - - /* duplicate and reset */ - if (target->pic) { - target->pic = CB_PICTURE (cb_build_picture (target->pic->orig)); - } - target->children = NULL; - target->sister = NULL; - - /* likely more to reset here ... */ - - if (source->children) { - cb_tree n, x; - int level_new; - if (source->children->level > level) { - level_new = source->children->level; - } else { - level_new = level + 1; - if (level_new == 66 || level_new == 77 - || level_new == 78 || level_new == 88) { - level_new++; - } - } - - if (source->children->name) { - n = cb_build_reference (source->children->name); - } else { - n = cb_build_filler (); - } - x = cb_build_field_tree (NULL, n, target, storage, NULL, level_new); - if (x != cb_error_node) { - result_fld = copy_into_field (source->children, CB_FIELD (x), 0); - } - } - if (first) { - /* adjust reference counter to allow "no codegen" if only used as type */ - source->count--; - target->count--; - } else if (source->sister) { - /* for children: all sister entries need to be copied */ - cb_tree n, x; - if (source->sister->name) { - n = cb_build_reference (source->sister->name); - } else { - n = cb_build_filler (); - } - x = cb_build_field_tree (NULL, n, target, storage, NULL, level); - if (x != cb_error_node) { - result_fld = copy_into_field (source->sister, CB_FIELD (x), 0); - } - } - return result_fld; -} - -static COB_INLINE COB_A_INLINE void -emit_incompatible_pic_and_usage_error (cb_tree item, const enum cb_usage usage) -{ - cb_error_x (item, _("PICTURE clause not compatible with USAGE %s"), - cb_get_usage_string (usage)); -} - -static COB_INLINE COB_A_INLINE int -is_numeric_usage (const enum cb_usage usage) -{ - switch (usage) { - case CB_USAGE_DISPLAY: - case CB_USAGE_NATIONAL: - case CB_USAGE_OBJECT: - case CB_USAGE_CONTROL: - return 0; - /* case CB_USAGE_ERROR: assume numeric */ - default: - return 1; - } -} - -static COB_INLINE COB_A_INLINE int -is_numeric_field (struct cb_field *f) -{ - if (f->pic - && f->pic->category == CB_CATEGORY_NUMERIC) - return 1; - return is_numeric_usage (f->usage); -} - -/* create an implicit picture for items that miss it but need one, - return 1 if not possible */ -static unsigned int -create_implicit_picture (struct cb_field *f) -{ - cb_tree x = CB_TREE (f); - cb_tree first_value; - char *pp; - struct cb_literal *lp; - struct cb_field *p; - int size_implied = 1; - int is_numeric = 0; - int ret; - char pic[24]; - - if (f->values) { - first_value = CB_VALUE (f->values); - if (first_value == cb_error_node) { - first_value = NULL; - } else { - if (CB_LITERAL_P (first_value)) { - size_implied = (int)CB_LITERAL (first_value)->size; - is_numeric = CB_NUMERIC_LITERAL_P (first_value); - } else if (CB_CONST_P (first_value)) { - size_implied = 1; - if (first_value == cb_zero) { - is_numeric = 1; - } else { - is_numeric = 0; - } - } else { - cobc_err_msg (_("unexpected tree tag: %d"), (int)CB_TREE_TAG (x)); - COBC_ABORT (); /* LCOV_EXCL_LINE */ - } - } - } else { - first_value = NULL; - } - - if (!first_value) { - /* FIXME: ensure this in another place */ - if (f->flag_item_78) { - level_require_error (x, "VALUE"); - return 1; - } - is_numeric = is_numeric_usage (f->usage); - } - - if (f->storage == CB_STORAGE_SCREEN) { - cb_tree impl_tree = f->screen_from ? f->screen_from : f->screen_to ? f->screen_to : NULL; - if (impl_tree) { - if (impl_tree == cb_error_node) { - return 1; - } - if (!CB_CONST_P (impl_tree)) { - size_implied = cb_field_size (impl_tree); - is_numeric = CB_TREE_CATEGORY (impl_tree) == CB_CATEGORY_NUMERIC; - } else { - size_implied = FIELD_SIZE_UNKNOWN; - } - } else if (first_value) { - /* done later*/ - } else { - f->flag_no_field = 1; - f->pic = CB_PICTURE (cb_build_picture ("X")); - return 0; - } - - if (size_implied == FIELD_SIZE_UNKNOWN) { - cb_error_x (x, _("PICTURE clause required for '%s'"), - cb_name (x)); - return 1; - } - - if (is_numeric) { - sprintf (pic, "9(%d)", size_implied); - } else { - sprintf (pic, "X(%d)", size_implied); - } - f->pic = CB_PICTURE (cb_build_picture (pic)); - return 0; - } - - if (f->storage == CB_STORAGE_REPORT) { - if (first_value) { - sprintf (pic, "X(%d)", size_implied); - } else { - /* CHECKME: Where do we want to generate a not-field in the C code? - instead of raising an error here? */ - f->flag_no_field = 1; - strcpy (pic, "X"); - } - f->pic = CB_PICTURE (cb_build_picture (pic)); - return 0; - } - - if (f->flag_item_78 && first_value && CB_LITERAL_P (first_value)) { -#if 0 /* CHECKME: Do we need this here? */ - f->count++; -#endif - lp = CB_LITERAL (first_value); - if (CB_NUMERIC_LITERAL_P (first_value)) { - memset (pic, 0, sizeof (pic)); - pp = pic; - if (lp->sign) { - *pp++ = 'S'; - } - size_implied = (int)lp->size - lp->scale; - if (size_implied) { - pp += sprintf (pp, "9(%d)", size_implied); - } - if (lp->scale) { - sprintf (pp, "V9(%d)", lp->scale); - } - if (lp->size < 10) { - f->usage = CB_USAGE_COMP_5; - } else { - f->usage = CB_USAGE_DISPLAY; - } - f->pic = CB_PICTURE (cb_build_picture (pic)); - f->pic->category = CB_CATEGORY_NUMERIC; - } else { - sprintf (pic, "X(%d)", (int)lp->size); - f->pic = CB_PICTURE (cb_build_picture (pic)); - f->pic->category = CB_CATEGORY_ALPHANUMERIC; - f->usage = CB_USAGE_DISPLAY; - } - return 0; - } - - if (f->usage == CB_USAGE_DISPLAY) { - for (p = f->parent; p; p = p->parent) { - if (p->usage == CB_USAGE_FLOAT - || p->usage == CB_USAGE_DOUBLE - || p->usage == CB_USAGE_INDEX) { - f->usage = p->usage; /* Propogate group USAGE to elementary field */ - return 0; - } - } - } - - ret = 0; - - if (f->level == 1 || f->level == 77 || !first_value) { - cb_error_x (x, _("PICTURE clause required for '%s'"), - cb_name (x)); - ret = 1; - } - - if (first_value && CB_NUMERIC_LITERAL_P (first_value)) { - if (!is_numeric_usage(f->usage)) { - cb_error_x (x, _("a non-numeric literal is expected for '%s'"), - cb_name (x)); - } - if (!ret) { - cb_error_x (x, _("PICTURE clause required for '%s'"), - cb_name (x)); - ret = 1; - } - } - - /* Checkme: should we raise an error for !cb_relaxed_syntax_checks? */ - if (!ret) { - cb_warning_x (cb_warn_extra, x, _("defining implicit picture size %d for '%s'"), - size_implied, cb_name (x)); - } - if (is_numeric) { - sprintf (pic, "9(%d)", size_implied); - } else { - sprintf (pic, "X(%d)", size_implied); - } - f->pic = CB_PICTURE (cb_build_picture (pic)); - f->pic->category = CB_CATEGORY_ALPHANUMERIC; - f->usage = CB_USAGE_DISPLAY; - return ret; -} - -static unsigned int -validate_any_length_item (struct cb_field *f) -{ - cb_tree x = CB_TREE (f); - - if (f->storage != CB_STORAGE_LINKAGE) { - cb_error_x (x, _("'%s' ANY LENGTH only allowed in LINKAGE"), cb_name (x)); - return 1; - } - if (f->level != 01) { - cb_error_x (x, _("'%s' ANY LENGTH must be 01 level"), cb_name (x)); - return 1; - } - if (f->flag_item_based || f->flag_external) { - cb_error_x (x, _("'%s' ANY LENGTH cannot be BASED/EXTERNAL"), cb_name (x)); - return 1; - } - if (f->flag_occurs || f->depending || - f->children || f->values || f->flag_blank_zero) { - cb_error_x (x, _("'%s' ANY LENGTH has invalid definition"), cb_name (x)); - return 1; - } - if (!f->pic) { - if (f->flag_any_numeric) { - f->pic = CB_PICTURE (cb_build_picture ("9")); - } else { - f->pic = CB_PICTURE (cb_build_picture ("X")); - } - } else if (f->flag_any_numeric) { - if (f->pic->category != CB_CATEGORY_NUMERIC) { - cb_error_x (x, _("'%s' ANY NUMERIC must be PIC 9"), - f->name); - } - } else if (f->pic->category != CB_CATEGORY_ALPHANUMERIC - && f->pic->category != CB_CATEGORY_NATIONAL) { - cb_error_x (x, _("'%s' ANY LENGTH must be PIC X or PIC N"), - f->name); - } - /* - TO-DO: Replace pic->category check with f->usage == CB_USAGE_NATIONAL. - Currently NATIONAL items are marked as having USAGE DISPLAY. - */ - if (!((f->pic->size == 1 && f->usage == CB_USAGE_DISPLAY) - || (f->pic->size == 2 && f->pic->category == CB_CATEGORY_NATIONAL))) { - if (f->flag_any_numeric) { - cb_error_x (x, _("'%s' ANY NUMERIC has invalid definition"), cb_name (x)); - } else { - cb_error_x (x, _("'%s' ANY LENGTH has invalid definition"), cb_name (x)); - } - return 1; - } - - /* TO-DO: Why do we increase the reference counter here and not in another place? */ - f->count++; - return 0; -} - -static void -validate_external (const struct cb_field * const f) -{ - const cb_tree x = CB_TREE (f); - - if (f->level != 01 && f->level != 77) { - cb_error_x (x, _("'%s' EXTERNAL must be specified at 01/77 level"), cb_name (x)); - } - if (f->storage != CB_STORAGE_WORKING && - f->storage != CB_STORAGE_FILE) { - cb_error_x (x, _("'%s' EXTERNAL can only be specified in WORKING-STORAGE section"), - cb_name (x)); - } - if (f->flag_item_based) { - cb_error_x (x, _("'%s' EXTERNAL and BASED are mutually exclusive"), cb_name (x)); - } - if (f->redefines) { - cb_error_x (x, _("'%s' EXTERNAL not allowed with REDEFINES"), cb_name (x)); - } -} - -static void -validate_based (const struct cb_field * const f) -{ - const cb_tree x = CB_TREE (f); - - if (f->storage != CB_STORAGE_WORKING && - f->storage != CB_STORAGE_LOCAL && - f->storage != CB_STORAGE_LINKAGE) { - cb_error_x (x, _("'%s' BASED not allowed here"), cb_name (x)); - } - if (f->redefines) { - cb_error_x (x, _("'%s' BASED not allowed with REDEFINES"), cb_name (x)); - } - if (f->level != 01 && f->level != 77) { - cb_error_x (x, _("'%s' BASED only allowed at the 01 and 77 levels"), cb_name (x)); - } -} - -static void -validate_occurs (const struct cb_field * const f) -{ - const cb_tree x = CB_TREE (f); - const struct cb_field *p; - - if ((f->level == 01 || f->level == 77) - && !cb_verify_x (x, cb_top_level_occurs_clause, "01/77 OCCURS")) { - cb_error_x (x, _("level %02d item '%s' cannot have a %s clause"), - f->level, cb_name (x), "OCCURS"); - } - - /* Validate OCCURS DEPENDING */ - if (f->depending) { - /* Cache field for later checking */ - cb_depend_check = cb_list_add (cb_depend_check, x); - - if (!cb_complex_odo) { - /* The data item that contains a OCCURS DEPENDING clause shall not - be subordinate to a data item that has an OCCURS clause */ - for (p = f->parent; p; p = p->parent) { - if (p->flag_occurs) { - cb_error_x (CB_TREE (p), - _("'%s' cannot have the OCCURS clause due to '%s'"), - cb_name (CB_TREE (p)), - cb_name (x)); - break; - } - } - } - } -} - -static void -validate_redefines (const struct cb_field * const f) -{ - const cb_tree x = CB_TREE (f); - const struct cb_field *p; - - /* Check OCCURS */ - if (f->redefines->flag_occurs) { - cb_warning_x (COBC_WARN_FILLER, x, - _("the original definition '%s' should not have OCCURS clause"), - f->redefines->name); - } - - /* Check definition */ - for (p = f->redefines->sister; p && p != f; p = p->sister) { - if (!p->redefines) { - cb_error_x (x, _("REDEFINES must follow the original definition")); - break; - } - } - - /* Check variable occurrence */ - if (f->depending || cb_field_variable_size (f)) { - cb_error_x (x, _("'%s' cannot be variable length"), f->name); - } - if (cb_field_variable_size (f->redefines)) { - cb_error_x (x, _("the original definition '%s' cannot be variable length"), - f->redefines->name); - } -} - -/* Perform group-specific validation of f. */ -static unsigned int -validate_group (struct cb_field *f) -{ - cb_tree x = CB_TREE (f); - unsigned int ret = 0; - - if (f->pic) { - group_error (x, "PICTURE"); - } - if (f->flag_justified) { - group_error (x, "JUSTIFIED RIGHT"); - } - if (f->flag_blank_zero) { - group_error (x, "BLANK WHEN ZERO"); - } - - if (f->storage == CB_STORAGE_SCREEN && - (f->screen_from || f->screen_to || f->values || f->pic)) { - cb_error_x (x, _("SCREEN group item '%s' has invalid clause"), - cb_name (x)); - ret = 1; - } - - for (f = f->children; f; f = f->sister) { - ret |= validate_field_1 (f); - } - - return ret; -} - -static unsigned int -validate_pic (struct cb_field *f) -{ - int need_picture; - cb_tree x = CB_TREE (f); - - switch (f->usage) { - case CB_USAGE_INDEX: - case CB_USAGE_HNDL: - case CB_USAGE_HNDL_WINDOW: - case CB_USAGE_HNDL_SUBWINDOW: - case CB_USAGE_HNDL_FONT: - case CB_USAGE_HNDL_THREAD: - case CB_USAGE_HNDL_MENU: - case CB_USAGE_HNDL_VARIANT: - case CB_USAGE_HNDL_LM: - case CB_USAGE_LENGTH: - case CB_USAGE_OBJECT: - case CB_USAGE_POINTER: - case CB_USAGE_PROGRAM_POINTER: - case CB_USAGE_FLOAT: - case CB_USAGE_DOUBLE: - case CB_USAGE_LONG_DOUBLE: - case CB_USAGE_FP_BIN32: - case CB_USAGE_FP_BIN64: - case CB_USAGE_FP_BIN128: - case CB_USAGE_FP_DEC64: - case CB_USAGE_FP_DEC128: - case CB_USAGE_SIGNED_CHAR: - case CB_USAGE_SIGNED_SHORT: - case CB_USAGE_SIGNED_INT: - case CB_USAGE_SIGNED_LONG: - case CB_USAGE_UNSIGNED_CHAR: - case CB_USAGE_UNSIGNED_SHORT: - case CB_USAGE_UNSIGNED_INT: - case CB_USAGE_UNSIGNED_LONG: - case CB_USAGE_CONTROL: - need_picture = 0; - break; - case CB_USAGE_ERROR: - return 1; - default: - need_picture = !f->flag_is_external_form; - break; - } - - if (f->pic == NULL && need_picture) { - /* try to built an implicit picture, stop if not possible */ - if (create_implicit_picture (f)) { - return 1; - } - } - - /* ACUCOBOL/RM-COBOL-style COMP-1 ignores the PICTURE clause. */ - if (f->flag_comp_1 && cb_binary_comp_1) { - return 0; - } - - /* Check for Group attributes to be carried to elementary field */ - if (!f->flag_validated - && cb_nonnumeric_with_numeric_group_usage == CB_OK - && f->parent - && !f->children) { - struct cb_field *p; - if (f->flag_usage_defined - && is_numeric_field (f)) { - for (p = f->parent; p; p = p->parent) { - if (p->usage != CB_USAGE_DISPLAY - && f->usage != p->usage) { - cb_error_x (x, _("%s USAGE %s incompatible with %s USAGE %s"), - p->flag_filler?"FILLER":p->name, cb_get_usage_string (p->usage), - f->flag_filler?"FILLER":f->name, cb_get_usage_string (f->usage)); - break; - } - } - } - if (!f->flag_usage_defined - && is_numeric_field (f)) { - for (p = f->parent; p; p = p->parent) { - if (p->usage != CB_USAGE_DISPLAY) { - f->usage = p->usage; - break; - } - } - } - /* TODO: handle this "per dialect", some disallow this (per ANSI85) or ignore it */ - if (!f->flag_synchronized - && f->parent - && (f->usage == CB_USAGE_BINARY - || f->usage == CB_USAGE_FLOAT - || f->usage == CB_USAGE_DOUBLE - || f->usage == CB_USAGE_UNSIGNED_SHORT - || f->usage == CB_USAGE_SIGNED_SHORT - || f->usage == CB_USAGE_UNSIGNED_INT - || f->usage == CB_USAGE_SIGNED_INT - || f->usage == CB_USAGE_UNSIGNED_LONG - || f->usage == CB_USAGE_SIGNED_LONG - || f->usage == CB_USAGE_COMP_5 - || f->usage == CB_USAGE_COMP_6 - || f->usage == CB_USAGE_FP_DEC64 - || f->usage == CB_USAGE_FP_DEC128 - || f->usage == CB_USAGE_FP_BIN32 - || f->usage == CB_USAGE_FP_BIN64 - || f->usage == CB_USAGE_FP_BIN128 - || f->usage == CB_USAGE_LONG_DOUBLE)) { - struct cb_field *pp; - for (pp = f->parent; pp; pp = pp->parent) { - if (pp->flag_synchronized) { - f->flag_synchronized = 1; - break; - } - } - } - /* ignore sync for binary items */ - if (f->flag_synchronized - && cb_binary_sync_clause == CB_IGNORE) { - switch (f->usage) { - case CB_USAGE_SIGNED_SHORT: - case CB_USAGE_UNSIGNED_SHORT: - case CB_USAGE_SIGNED_INT: - case CB_USAGE_UNSIGNED_INT: - case CB_USAGE_SIGNED_LONG: - case CB_USAGE_UNSIGNED_LONG: - f->flag_synchronized = 0; - break; - default: - break; - } - } - if (f->pic - && f->pic->category == CB_CATEGORY_NUMERIC - && f->flag_sign_separate == 0 - && f->flag_sign_leading == 0) { - for (p = f->parent; p; p = p->parent) { - if (p->flag_sign_separate - || p->flag_sign_leading) { - f->flag_sign_separate = p->flag_sign_separate; - f->flag_sign_leading = p->flag_sign_leading; - break; - } - } - } - } - f->flag_validated = 1; - - /* if picture is not needed it is an error to specify it - note: we may have set the picture internal */ - if (f->pic != NULL && !f->pic->flag_is_calculated && !need_picture) { - cb_error_x (x, _("'%s' cannot have PICTURE clause"), - cb_name (x)); - } - - return 0; -} - -static int -validate_usage (struct cb_field * const f) -{ - cb_tree x = CB_TREE (f); - - if (f->storage == CB_STORAGE_REPORT - && f->usage != CB_USAGE_DISPLAY - && f->usage != CB_USAGE_NATIONAL) { - cb_error_x (CB_TREE(f), - _("%s item '%s' should be USAGE DISPLAY"), - enum_explain_storage (f->storage), cb_name (x)); - return 1; - } - - if (f->storage == CB_STORAGE_SCREEN - && f->usage != CB_USAGE_DISPLAY - && f->usage != CB_USAGE_NATIONAL - && f->usage != CB_USAGE_CONTROL) { - cb_error_x (CB_TREE(f), - _("%s item '%s' should be USAGE DISPLAY"), - enum_explain_storage (f->storage), cb_name (x)); - return 1; - } - - switch (f->usage) { - case CB_USAGE_BINARY: - case CB_USAGE_PACKED: - case CB_USAGE_BIT: - if (f->pic - && f->pic->category != CB_CATEGORY_NUMERIC) { - emit_incompatible_pic_and_usage_error (x, f->usage); - return 1; - } - break; - case CB_USAGE_COMP_6: - if (f->pic - && f->pic->category != CB_CATEGORY_NUMERIC) { - emit_incompatible_pic_and_usage_error (x, f->usage); - return 1; - } - if (f->pic - && f->pic->have_sign) { - cb_warning_x (COBC_WARN_FILLER, x, _("'%s' COMP-6 with sign - changing to COMP-3"), cb_name (x)); - f->usage = CB_USAGE_PACKED; - } - break; - case CB_USAGE_COMP_5: - case CB_USAGE_COMP_X: - case CB_USAGE_COMP_N: - if (f->pic - && f->pic->category != CB_CATEGORY_NUMERIC - && f->pic->category != CB_CATEGORY_ALPHANUMERIC) { - emit_incompatible_pic_and_usage_error (x, f->usage); - return 1; - } - break; - default: - break; - } - return 0; -} - -static void -validate_sign (const struct cb_field * const f) -{ - const cb_tree x = CB_TREE (f); - - if (!(f->pic && f->pic->have_sign)) { - cb_error_x (x, _("elementary items with SIGN clause must have S in PICTURE")); - } else if (f->usage != CB_USAGE_DISPLAY - && f->usage != CB_USAGE_NATIONAL) { - cb_error_x (x, _("elementary items with SIGN clause must be USAGE DISPLAY or NATIONAL")); - } -} - -static void -validate_justified_right (const struct cb_field * const f) -{ - const cb_tree x = CB_TREE (f); - - /* TO-DO: Error if no PIC? */ - - if (f->flag_justified - && f->pic - && f->pic->category != CB_CATEGORY_ALPHABETIC - && f->pic->category != CB_CATEGORY_ALPHANUMERIC - && f->pic->category != CB_CATEGORY_BOOLEAN - && f->pic->category != CB_CATEGORY_NATIONAL) { - cb_error_x (x, _("'%s' cannot have JUSTIFIED RIGHT"), cb_name (x)); - } -} - -static void -validate_blank_when_zero (const struct cb_field * const f) -{ - const cb_tree x = CB_TREE (f); - int i; - - if (f->pic - && f->pic->have_sign - && f->pic->category != CB_CATEGORY_NUMERIC_EDITED) { - cb_error_x (x, _("'%s' cannot have S in PICTURE string and BLANK WHEN ZERO"), - cb_name (x)); - } - - if (f->usage != CB_USAGE_DISPLAY && f->usage != CB_USAGE_NATIONAL) { - cb_error_x (x, _("'%s' cannot have BLANK WHEN ZERO without being USAGE DISPLAY or NATIONAL"), - cb_name (x)); - } - - if (f->pic) { - switch (f->pic->category) { - case CB_CATEGORY_NUMERIC: - break; - case CB_CATEGORY_NUMERIC_EDITED: - for (i = 0; f->pic->str[i].symbol != '\0'; ++i) { - if (f->pic->str[i].symbol == '*') { - cb_error_x (x, _("'%s' cannot have * in PICTURE string and BLANK WHEN ZERO"), - cb_name (x)); - break; - } - } - break; - default: - cb_error_x (x, _("'%s' is not numeric, so cannot have BLANK WHEN ZERO"), cb_name (x)); - break; - } - } -} - -static void -validate_elem_value (const struct cb_field * const f) -{ - const cb_tree x = CB_TREE (f); - const struct cb_field *p; - - if (CB_PAIR_P (CB_VALUE (f->values)) || CB_CHAIN (f->values)) { - cb_error_x (x, _("only level 88 items may have multiple values")); - } - - /* ISO+IEC+1989-2002: 13.16.42.2-10 */ - if (cb_warn_ignored_initial_val) { - for (p = f; p; p = p->parent) { - if (p->flag_external) { - cb_warning_x (cb_warn_ignored_initial_val, x, - _("initial VALUE clause ignored for %s item '%s'"), - "EXTERNAL", cb_name (CB_TREE(f))); - } else if (p->redefines) { - cb_warning_x (cb_warn_ignored_initial_val, x, - _("initial VALUE clause ignored for %s item '%s'"), - "REDEFINES", cb_name (CB_TREE(f))); - } - } - } -} - -static void -warn_full_on_numeric_items_is_useless (const struct cb_field * const f) -{ - if ((f->screen_flag & COB_SCREEN_FULL) - && f->pic && f->pic->category == CB_CATEGORY_NUMERIC) { - cb_warning_x (cb_warn_extra, CB_TREE (f), - _("FULL has no effect on numeric items; you may want REQUIRED or PIC Z")); - } -} - -static int -has_std_needed_screen_clause (const struct cb_field * const f) -{ - return (f->pic && (f->screen_from - || f->screen_to - || (f->values && CB_NUMERIC_LITERAL_P (CB_VALUE (f->values))))) - || (f->values - && (CB_LITERAL_P (CB_VALUE (f->values)) - || CB_CONST_P (CB_VALUE (f->values))) - && (CB_TREE_CATEGORY (CB_VALUE (f->values)) == CB_CATEGORY_ALPHANUMERIC - || CB_TREE_CATEGORY (CB_VALUE (f->values)) == CB_CATEGORY_BOOLEAN - || CB_TREE_CATEGORY (CB_VALUE (f->values)) == CB_CATEGORY_NATIONAL)) - || f->screen_flag & COB_SCREEN_BELL - || f->screen_flag & COB_SCREEN_BLANK_LINE - || f->screen_flag & COB_SCREEN_BLANK_SCREEN - || f->screen_flag & COB_SCREEN_ERASE_EOL - || f->screen_flag & COB_SCREEN_ERASE_EOS; -} - -static void -error_value_figurative_constant(const struct cb_field * const f) -{ - if (f->values - && cb_is_figurative_constant (CB_VALUE (f->values))) { - cb_error_x (CB_TREE (f), _("VALUE may not contain a figurative constant")); - } -} - -static void -error_both_full_and_justified (const struct cb_field * const f) -{ - if ((f->screen_flag & COB_SCREEN_FULL) && f->flag_justified) { - cb_error_x (CB_TREE (f), _("cannot specify both FULL and JUSTIFIED")); - } -} - -static int -warn_from_to_using_without_pic (const struct cb_field * const f) -{ - const cb_tree x = CB_TREE (f); - - if ((f->screen_from || f->screen_to) && !f->pic) { - /* TO-DO: Change to dialect option */ - cb_warning_x (cb_warn_extra, x, - _("'%s' has FROM, TO or USING without PIC; PIC will be implied"), - cb_name (x)); - /* TO-DO: Add setting of PIC below here or move warnings to the code which sets the PIC */ - return 1; - } else { - return 0; - } -} - -static int -warn_pic_for_numeric_value_implied (const struct cb_field * const f) -{ - if (f->values && CB_NUMERIC_LITERAL_P (CB_VALUE (f->values))) { - cb_warning_x (cb_warn_extra, CB_TREE (f), - _("'%s' has numeric VALUE without PIC; PIC will be implied"), - cb_name (CB_TREE (f))); - return 1; - } else { - return 0; - } -} - -static void -validate_elem_screen_clauses_std (struct cb_field * const f) -{ - const cb_tree x = CB_TREE (f); - - if (!has_std_needed_screen_clause (f)) { - if (f->pic) { - cb_error_x (x, _("'%s' cannot have PIC without FROM, TO, USING or numeric VALUE"), - cb_name (x)); - } else if (warn_from_to_using_without_pic (f)) { - /* - The above rule is not explicitly stated, but the general rules of FROM, - TO and USING assume the item has a PICTURE clause. - */ - ; - } else if (warn_pic_for_numeric_value_implied (f)) { - ; - /* TO-DO: Add setting of PIC below here or move warnings to the code which sets the PIC */ - } else { - cb_error_x (x, _("'%s' needs a PIC, FROM, TO, USING, VALUE, BELL, BLANK or ERASE clause"), - cb_name (x)); - } - } - - error_both_full_and_justified (f); - - error_value_figurative_constant (f); -} - -static void -error_both_pic_and_value (const struct cb_field * const f) -{ - if (f->pic && f->values) { - cb_error_x (CB_TREE (f), _("cannot specify both PIC and VALUE")); - } -} - -static void -error_pic_without_from_to_using (const struct cb_field * const f) -{ - if (f->pic && !(f->screen_from || f->screen_to)) { - cb_error_x (CB_TREE (f), _("cannot have PIC without FROM, TO or USING")); - } -} - -static void -error_from_to_using_without_pic (const struct cb_field * const f) -{ - /* TO-DO: Replace warning, like in validate_elem_screen_clauses_std? */ - if ((f->screen_from || f->screen_to) && !f->pic) { - cb_error_x (CB_TREE (f), _("cannot have FROM, TO or USING without PIC")); - } -} - -static void -error_value_numeric (const struct cb_field * const f) -{ - if (f->values - && CB_TREE_CATEGORY (CB_VALUE (f->values)) == CB_CATEGORY_NUMERIC) { - cb_error_x (CB_TREE (f), _("VALUE item may not be numeric")); - } -} - -static void -error_no_screen_clause_needed_by_xopen (const struct cb_field * const f) -{ - const cb_tree x = CB_TREE (f); - - if (!(f->pic - || f->screen_column - || f->screen_flag & COB_SCREEN_BELL - || f->screen_flag & COB_SCREEN_BLANK_LINE - || f->screen_flag & COB_SCREEN_BLANK_SCREEN - || f->screen_line - || f->values)) { - cb_error_x (x, _("'%s' needs a PIC, COL, LINE, VALUE, BELL or BLANK clause"), - cb_name (x)); - } -} - -static void -validate_elem_screen_clauses_mf (const struct cb_field * const f) -{ - const cb_tree x = CB_TREE (f); - - error_no_screen_clause_needed_by_xopen (f); - - error_both_pic_and_value (f); - error_pic_without_from_to_using (f); - - /* - The below rule isn't explicitly stated, but it follows from the - PICTURE's general rule which says the PIC character string determines - the length and category of the item. - */ - warn_from_to_using_without_pic (f); - - error_value_figurative_constant (f); - error_value_numeric (f); - - if (!f->screen_to - && ((f->screen_flag & COB_SCREEN_AUTO) - || (f->screen_flag & COB_SCREEN_FULL) - || (f->screen_flag & COB_SCREEN_PROMPT) - || (f->screen_flag & COB_SCREEN_REQUIRED) - || (f->screen_flag & COB_SCREEN_SECURE))) { - cb_error_x (x, _("cannot use AUTO, FULL, PROMPT, REQUIRED or SECURE on elementary item without TO or USING")); - } - if (!f->screen_from && !f->screen_to - && (f->flag_blank_zero - || f->flag_justified - || f->flag_occurs - || f->flag_sign_clause)) { - cb_error_x (x, _("cannot use BLANK WHEN ZERO, JUSTIFIED, OCCURS or SIGN on item without FROM, TO or USING")); - } -} - -static void -validate_elem_screen_clauses_rm (struct cb_field *f) -{ - const cb_tree x = CB_TREE (f); - - error_both_pic_and_value (f); - error_pic_without_from_to_using (f); - error_from_to_using_without_pic (f); - - error_value_numeric (f); - - if (!f->pic) { - if ((f->screen_flag & COB_SCREEN_AUTO) - || (f->screen_flag & COB_SCREEN_FULL) - || (f->screen_flag & COB_SCREEN_REQUIRED) - || (f->screen_flag & COB_SCREEN_SECURE)) { - cb_error_x (x, _("cannot use AUTO, FULL, REQUIRED or SECURE on elementary item without FROM, TO or USING")); - } - if (f->flag_blank_zero - || f->flag_justified - || f->flag_sign_clause) { - cb_error_x (x, _("cannot use BLANK WHEN ZERO, JUSTIFIED or SIGN without FROM, TO or USING")); - } - } -} - -static void -validate_elem_screen_clauses_acu (struct cb_field *f) -{ - const cb_tree x = CB_TREE (f); - - error_both_pic_and_value (f); - error_pic_without_from_to_using (f); - - error_value_numeric (f); - - warn_from_to_using_without_pic (f); - if (!f->pic) { - if (f->flag_blank_zero) { - cb_error_x (x, _("cannot have BLANK WHEN ZERO without PIC")); - } - if (f->flag_justified) { - cb_error_x (x, _("cannot have JUSTIFIED without PIC")); - } - } -} - -static void -validate_elem_screen_clauses_xopen (struct cb_field *f) -{ - const cb_tree x = CB_TREE (f); - - error_no_screen_clause_needed_by_xopen (f); - - error_both_pic_and_value (f); - error_pic_without_from_to_using (f); - error_from_to_using_without_pic (f); - - error_value_numeric (f); - - if (!f->screen_to && !f->screen_from - && (f->screen_flag & COB_SCREEN_AUTO)) { - cb_error_x (x, _("cannot have AUTO without FROM, TO or USING")); - } - if (!f->screen_to - && ((f->screen_flag & COB_SCREEN_FULL) - || (f->screen_flag & COB_SCREEN_REQUIRED))) { - cb_error_x (x, _("cannot use FULL or REQUIRED on item without TO or USING")); - } - - error_both_full_and_justified (f); - - if ((f->screen_flag & COB_SCREEN_SECURE)) { - if (f->screen_from) { - cb_error_x (x, _("SECURE can be used with TO only")); - } else if (!f->screen_to) { - cb_error_x (x, _("SECURE must be used with TO")); - } - } -} - -static void -warn_has_no_useful_clause (const struct cb_field * const f) -{ - if (!( f->screen_column - || f->screen_flag & COB_SCREEN_BELL - || f->screen_flag & COB_SCREEN_BLANK_LINE - || f->screen_flag & COB_SCREEN_BLANK_SCREEN - || f->screen_flag & COB_SCREEN_ERASE_EOL - || f->screen_flag & COB_SCREEN_ERASE_EOS - || f->screen_from - || f->screen_line - || f->screen_to - || f->values)) { - cb_warning_x (COBC_WARN_FILLER, CB_TREE (f), - _("'%s' does nothing"), cb_name (CB_TREE (f))); - } -} - -static void -validate_elem_screen_clauses_gc (const struct cb_field * const f) -{ - /* We aim for the least restrictive rules possible. */ - warn_has_no_useful_clause (f); - warn_from_to_using_without_pic (f); - warn_pic_for_numeric_value_implied (f); -} - -static void -validate_elem_screen (struct cb_field *f) -{ - switch (cb_screen_section_clauses) { - case CB_STD_SCREEN_RULES: - validate_elem_screen_clauses_std (f); - break; - case CB_MF_SCREEN_RULES: - validate_elem_screen_clauses_mf (f); - break; - case CB_ACU_SCREEN_RULES: - validate_elem_screen_clauses_acu (f); - break; - case CB_RM_SCREEN_RULES: - validate_elem_screen_clauses_rm (f); - break; - case CB_XOPEN_SCREEN_RULES: - validate_elem_screen_clauses_xopen (f); - break; - case CB_GC_SCREEN_RULES: - validate_elem_screen_clauses_gc (f); - break; - } - - warn_full_on_numeric_items_is_useless (f); -} - -static void -validate_field_clauses (cb_tree x, struct cb_field *f) -{ - if (f->flag_blank_zero) { - cb_error_x (x, _("BLANK ZERO not compatible with USAGE")); - } - if (f->flag_sign_leading || f->flag_sign_separate) { - cb_error_x (x, _("SIGN clause not compatible with USAGE")); - } -} - -/* Perform validation of a non-66-or-88-level elementary item. */ -static unsigned int -validate_elementary_item (struct cb_field *f) -{ - unsigned int ret; - cob_pic_symbol *pstr = NULL; - int n = 0; - - ret = validate_usage (f); - if (f->flag_sign_clause) { - validate_sign (f); - } - validate_justified_right (f); - - if (f->flag_blank_zero) { - validate_blank_when_zero (f); - } - - if (f->values) { - validate_elem_value (f); - } - if (!ret && f->storage == CB_STORAGE_SCREEN) { - validate_elem_screen (f); - } - - /* Validate PICTURE */ - ret |= validate_pic (f); - - /* TO-DO: This is not validation and should be elsewhere. */ - switch (f->usage) { - case CB_USAGE_DISPLAY: - if (current_program - && current_program->flag_trailing_separate - && f->pic - && f->pic->category == CB_CATEGORY_NUMERIC - && !f->flag_sign_leading) { - f->flag_sign_separate = 1; - } - break; - case CB_USAGE_SIGNED_CHAR: - f->usage = CB_USAGE_COMP_5; - f->pic = cb_build_binary_picture ("BINARY-CHAR", 2, 1); - f->flag_real_binary = 1; - break; - case CB_USAGE_SIGNED_SHORT: - f->usage = CB_USAGE_COMP_5; - f->pic = cb_build_binary_picture ("BINARY-SHORT", 4, 1); - f->flag_real_binary = 1; - break; - case CB_USAGE_SIGNED_INT: - f->usage = CB_USAGE_COMP_5; - f->pic = cb_build_binary_picture ("BINARY-LONG", 9, 1); - f->flag_real_binary = 1; - break; - case CB_USAGE_SIGNED_LONG: - f->usage = CB_USAGE_COMP_5; - f->pic = cb_build_binary_picture ("BINARY-DOUBLE", 18, 1); - f->flag_real_binary = 1; - break; - case CB_USAGE_UNSIGNED_CHAR: - f->usage = CB_USAGE_COMP_5; - f->pic = cb_build_binary_picture ("BINARY-CHAR", 2, 0); - f->flag_real_binary = 1; - break; - case CB_USAGE_UNSIGNED_SHORT: - f->usage = CB_USAGE_COMP_5; - f->pic = cb_build_binary_picture ("BINARY-SHORT", 4, 0); - f->flag_real_binary = 1; - break; - case CB_USAGE_UNSIGNED_INT: - f->usage = CB_USAGE_COMP_5; - f->pic = cb_build_binary_picture ("BINARY-LONG", 9, 0); - f->flag_real_binary = 1; - break; - case CB_USAGE_UNSIGNED_LONG: - f->usage = CB_USAGE_COMP_5; - f->pic = cb_build_binary_picture ("BINARY-DOUBLE", 18, 0); - f->flag_real_binary = 1; - break; - case CB_USAGE_COMP_5: - f->flag_real_binary = 1; - break; - default: - break; - } - - /* TO-DO: Also move, this is not validation */ - if (f->flag_blank_zero - && f->pic - && f->pic->category == CB_CATEGORY_NUMERIC) { - cb_tree x; - /* Reconstruct the picture string */ - if (f->pic->scale > 0) { - /* Size for genned string */ - if (f->pic->have_sign) { - n = 4; - } else { - n = 3; - } - - f->pic->str = cobc_parse_malloc ((size_t)n * sizeof (cob_pic_symbol)); - pstr = f->pic->str; - if (f->pic->have_sign) { - pstr->symbol = '+'; - pstr->times_repeated = 1; - ++pstr; - } - } - x = CB_TREE (f); - - switch (f->usage) { - default: - break; - case CB_USAGE_DISPLAY: - if (current_program->flag_trailing_separate && - f->pic && - f->pic->category == CB_CATEGORY_NUMERIC && - !f->flag_sign_leading) { - f->flag_sign_separate = 1; - } - break; - case CB_USAGE_SIGNED_CHAR: - f->usage = CB_USAGE_COMP_5; - f->pic = cb_build_binary_picture ("BINARY-CHAR", 2, 1); - f->flag_real_binary = 1; - validate_field_clauses (x, f); - break; - case CB_USAGE_SIGNED_SHORT: - f->usage = CB_USAGE_COMP_5; - f->pic = cb_build_binary_picture ("BINARY-SHORT", 4, 1); - f->flag_real_binary = 1; - validate_field_clauses (x, f); - break; - case CB_USAGE_SIGNED_INT: - f->usage = CB_USAGE_COMP_5; - f->pic = cb_build_binary_picture ("BINARY-LONG", 9, 1); - f->flag_real_binary = 1; - validate_field_clauses (x, f); - break; - case CB_USAGE_SIGNED_LONG: - f->usage = CB_USAGE_COMP_5; - f->pic = cb_build_binary_picture ("BINARY-DOUBLE", 18, 1); - f->flag_real_binary = 1; - validate_field_clauses (x, f); - break; - case CB_USAGE_UNSIGNED_CHAR: - f->usage = CB_USAGE_COMP_5; - f->pic = cb_build_binary_picture ("BINARY-CHAR", 2, 0); - f->flag_real_binary = 1; - validate_field_clauses (x, f); - break; - case CB_USAGE_UNSIGNED_SHORT: - f->usage = CB_USAGE_COMP_5; - f->pic = cb_build_binary_picture ("BINARY-SHORT", 4, 0); - f->flag_real_binary = 1; - validate_field_clauses (x, f); - break; - case CB_USAGE_UNSIGNED_INT: - f->usage = CB_USAGE_COMP_5; - f->pic = cb_build_binary_picture ("BINARY-LONG", 9, 0); - f->flag_real_binary = 1; - validate_field_clauses (x, f); - break; - case CB_USAGE_UNSIGNED_LONG: - f->usage = CB_USAGE_COMP_5; - f->pic = cb_build_binary_picture ("BINARY-DOUBLE", 18, 0); - f->flag_real_binary = 1; - validate_field_clauses (x, f); - break; - case CB_USAGE_BINARY: - case CB_USAGE_PACKED: - case CB_USAGE_BIT: - if (f->pic->category != CB_CATEGORY_NUMERIC) { - cb_error_x (x, _("'%s' PICTURE clause not compatible with USAGE"), cb_name (x)); - } - pstr->symbol = '9'; - pstr->times_repeated = (int)f->pic->digits - f->pic->scale; - ++pstr; - pstr->symbol = 'V'; - pstr->times_repeated = 1; - ++pstr; - - pstr->symbol = '9'; - pstr->times_repeated = f->pic->scale; - ++pstr; - - f->pic->size++; - break; - } - f->pic->lenstr = n; - f->pic->category = CB_CATEGORY_NUMERIC_EDITED; - } - - return ret; -} - -static unsigned int -validate_field_1 (struct cb_field *f) -{ - cb_tree x; - -#if 0 - /* LCOV_EXCL_START */ - if (unlikely (!f)) { /* checked to keep the analyzer happy */ - cobc_err_msg (_("call to %s with NULL pointer"), "validate_field_1"); - COBC_ABORT(); - } - /* LCOV_EXCL_STOP */ -#endif - - if (f->flag_invalid) { - return 1; - } - - if (f->flag_any_length) { - return validate_any_length_item (f); - } - - x = CB_TREE (f); - if (f->level == 77) { - if (f->storage != CB_STORAGE_WORKING && - f->storage != CB_STORAGE_LOCAL && - f->storage != CB_STORAGE_LINKAGE) { - cb_error_x (x, _("'%s' 77 level is not allowed here"), cb_name (x)); - } - } - - if (f->flag_external) { - validate_external (f); - } else - if (f->flag_item_based) { - validate_based (f); - } - - if (f->flag_occurs) { - /* TO-DO: Not validation, so should not be in this function! */ - cb_tree l; - for (l = f->index_list; l; l = CB_CHAIN (l)) { - CB_FIELD_PTR (CB_VALUE (l))->flag_is_global = f->flag_is_global; - } - /* END: Not validation */ - validate_occurs (f); - } - - if (f->level == 66) { - /* no check for redefines here */ - return 0; - } - if (f->redefines) { - /* CHECKME - seems to be missing: - COBOL 202x doesn't allow REDEFINES in SCREEN/REPORT */ - validate_redefines (f); - } - - if (f->children) { - return validate_group (f); - } else { - return validate_elementary_item (f); - } -} - -static void -setup_parameters (struct cb_field *f) -{ - if (f->children) { - /* Group field */ - unsigned int flag_local = !!f->flag_local; - for (f = f->children; f; f = f->sister) { - f->flag_local = flag_local; - setup_parameters (f); - } - return; - } - - /* Regular field */ - /* Determine the class */ - switch (f->usage) { - case CB_USAGE_BINARY: -#ifndef WORDS_BIGENDIAN - if (cb_binary_byteorder == CB_BYTEORDER_BIG_ENDIAN) { - f->flag_binary_swap = 1; - } -#endif - break; - - case CB_USAGE_INDEX: - case CB_USAGE_HNDL: - case CB_USAGE_HNDL_WINDOW: - case CB_USAGE_HNDL_SUBWINDOW: - case CB_USAGE_HNDL_FONT: - case CB_USAGE_HNDL_THREAD: - case CB_USAGE_HNDL_MENU: - case CB_USAGE_HNDL_VARIANT: - case CB_USAGE_HNDL_LM: - f->pic = CB_PICTURE (cb_build_picture ("S9(9)")); - f->pic->flag_is_calculated = 1; -#if 0 - /* REMIND: The category should be set, but doing so causes - * other problems as more checks need to be added to - * accept a category of CB_CATEGORY_INDEX so this change - * is deferred until a later time - * RJN: Nov 2017 - */ - f->pic->category = CB_CATEGORY_INDEX; -#endif - break; - - case CB_USAGE_LENGTH: - f->pic = CB_PICTURE (cb_build_picture ("9(9)")); - f->pic->flag_is_calculated = 1; - break; - - case CB_USAGE_POINTER: - case CB_USAGE_PROGRAM_POINTER: -#ifdef COB_64_BIT_POINTER - f->pic = CB_PICTURE (cb_build_picture ("9(17)")); -#else - f->pic = CB_PICTURE (cb_build_picture ("9(10)")); -#endif - f->pic->flag_is_calculated = 1; - break; - case CB_USAGE_FLOAT: - f->pic = CB_PICTURE (cb_build_picture ("S9(7)V9(8)")); - f->pic->flag_is_calculated = 1; - break; - case CB_USAGE_DOUBLE: - f->pic = CB_PICTURE (cb_build_picture ("S9(17)V9(17)")); - f->pic->flag_is_calculated = 1; - break; - case CB_USAGE_FP_DEC64: - /* RXWRXW - Scale Fix me */ - f->pic = CB_PICTURE (cb_build_picture ("S9(17)V9(16)")); - f->pic->flag_is_calculated = 1; - break; - case CB_USAGE_FP_DEC128: - /* RXWRXW - Scale Fix me */ - f->pic = CB_PICTURE (cb_build_picture ("S999V9(34)")); - f->pic->flag_is_calculated = 1; - break; - - case CB_USAGE_COMP_5: - case CB_USAGE_COMP_N: - if (f->pic - && f->pic->orig - && f->pic->orig[0] == 'X') { - f->usage = CB_USAGE_COMP_X; - } - f->flag_real_binary = 1; - /* Fall-through */ - case CB_USAGE_COMP_X: - if (f->pic - && f->pic->category == CB_CATEGORY_ALPHANUMERIC - && f->usage == CB_USAGE_COMP_X) { - f->compx_size = f->size = f->pic->size; - if (f->pic->size > 8) { - f->pic = CB_PICTURE (cb_build_picture ("9(36)")); - } else { - char pic[8]; - sprintf (pic, "9(%d)", pic_digits[f->pic->size - 1]); - f->pic = CB_PICTURE (cb_build_picture (pic)); - if(f->compx_size > 0) - f->pic->size = f->compx_size; - } - } -#ifndef WORDS_BIGENDIAN - if (f->usage == CB_USAGE_COMP_X && - cb_binary_byteorder == CB_BYTEORDER_BIG_ENDIAN) { - f->flag_binary_swap = 1; - } - if (f->usage == CB_USAGE_COMP_N) { - f->flag_binary_swap = 1; - } -#endif - break; - - default: - break; - } -} - -static void -compute_binary_size (struct cb_field *f, const int size) -{ - switch (cb_binary_size) { - case CB_BINARY_SIZE_1_2_4_8: - f->size = ((size <= 2) ? 1 : - (size <= 4) ? 2 : - (size <= 9) ? 4 : (size <= 18) ? 8 : 16); - return; - case CB_BINARY_SIZE_2_4_8: - if (f->flag_real_binary - && size <= 2 - && cb_mf_ibm_comp != 1) { - f->size = 1; - } else { - f->size = ((size <= 4) ? 2 : - (size <= 9) ? 4 : (size <= 18) ? 8 : 16); - } - return; - case CB_BINARY_SIZE_1__8: - if (f->pic->have_sign) { - switch (size) { - case 0: - case 1: - case 2: - f->size = 1; - return; - case 3: - case 4: - f->size = 2; - return; - case 5: - case 6: - f->size = 3; - return; - case 7: - case 8: - case 9: - f->size = 4; - return; - case 10: - case 11: - f->size = 5; - return; - case 12: - case 13: - case 14: - f->size = 6; - return; - case 15: - case 16: - f->size = 7; - return; - case 17: - case 18: - f->size = 8; - return; - case 19: - case 20: - case 21: - f->size = 9; - return; - case 22: - case 23: - f->size = 10; - return; - case 24: - case 25: - case 26: - f->size = 11; - return; - case 27: - case 28: - f->size = 12; - return; - case 29: - case 30: - case 31: - f->size = 13; - return; - case 32: - case 33: - f->size = 14; - return; - case 34: - case 35: - f->size = 15; - return; - default: - f->size = 16; - return; - } - } - switch (size) { - case 0: - case 1: - case 2: - f->size = 1; - return; - case 3: - case 4: - f->size = 2; - return; - case 5: - case 6: - case 7: - f->size = 3; - return; - case 8: - case 9: - f->size = 4; - return; - case 10: - case 11: - case 12: - f->size = 5; - return; - case 13: - case 14: - f->size = 6; - return; - case 15: - case 16: - f->size = 7; - return; - case 17: - case 18: - case 19: - f->size = 8; - return; - case 20: - case 21: - f->size = 9; - return; - case 22: - case 23: - case 24: - f->size = 10; - return; - case 25: - case 26: - f->size = 11; - return; - case 27: - case 28: - f->size = 12; - return; - case 29: - case 30: - case 31: - f->size = 13; - return; - case 32: - case 33: - f->size = 14; - return; - case 34: - case 35: - case 36: - f->size = 15; - return; - default: - f->size = 16; - return; - } - return; -#if 0 /* how should this happen ... */ - default: - f->size = size; - return; -#endif - } -} - -static struct cb_field * -get_last_child (struct cb_field *f) -{ - do { - f = f->children; - while (f->sister) { - f = f->sister; - } - } while (f->children); - - return f; -} - -static void -set_report_field_offset (struct cb_field *f) -{ - struct cb_field *pp; - -#if 0 /* That would be a bad error as this function is only called for report_column > 0 */ - if (f->storage != CB_STORAGE_REPORT) { - return; - } -#endif - if (!(f->report_flag & COB_REPORT_COLUMN_PLUS)) { - f->offset = f->report_column - 1; /* offset based on COLUMN value */ - return; - } - pp = f->parent; - if (pp) { - if (pp->children == f) { - f->offset = f->report_column - 1; /* First in line */ - } else { - struct cb_field *c; - for (c = pp->children; c; c = c->sister) { /* Find previous field */ - if (c->sister == f) { - if (c->occurs_max > 1) { - f->offset = c->offset + c->size * c->occurs_max + f->report_column; - } - else { - f->offset = c->offset + c->size + f->report_column; - } - break; - } - } - } - } -} - -static int -compute_size (struct cb_field *f) -{ - struct cb_field *c; - int size = 0; - int size_check = 0; - int align_size; - int pad; - int unbounded_items = 0; - int unbounded_parts = 1; - - int maxsz; - struct cb_field *c0; - - if (f->storage == CB_STORAGE_REPORT) { - if (f->report_num_col > 1) { - if (f->flag_occurs) { - /* FIXME: this is no size calculation and likely not reachable (if it is: move) */ - cb_error_x (CB_TREE (f), _("OCCURS and multi COLUMNs is not allowed")); - } else { - f->occurs_max = f->occurs_min = f->report_num_col; - f->flag_occurs = 1; - f->indexes = 1; - } - } - } - if (f->level == 66) { - /* Rename */ - if (f->rename_thru) { - f->size = f->rename_thru->offset + f->rename_thru->size - - f->redefines->offset; - } else { - f->size = f->redefines->size; - } - return f->size; - } - if (f->storage == CB_STORAGE_REPORT - && (f->report_flag & COB_REPORT_LINE) - && !(f->report_flag & COB_REPORT_LINE_PLUS) - && f->parent - && f->parent->children != f) { - for(c = f->parent->children; c && c != f; c = c->sister) { - if ((c->report_flag & COB_REPORT_LINE) - && !(c->report_flag & COB_REPORT_LINE_PLUS) - && c->report_line == f->report_line) { - cb_warning_x (cb_warn_extra, CB_TREE (f), - _("duplicate LINE %d ignored"), f->report_line); - f->report_line = 0; - f->report_flag &= ~COB_REPORT_LINE; - } - } - } - - if (f->children) { - if (f->storage == CB_STORAGE_REPORT - && (f->report_flag & COB_REPORT_LINE) ) { - f->offset = 0; - } - - /* Groups */ - if (f->flag_synchronized) { - /* TODO: handle this "per dialect", some disallow this (per ANSI85) or ignore it */ - cb_warning_x (cb_warn_extra, CB_TREE (f), - _("ignoring SYNCHRONIZED for group item '%s'"), - cb_name (CB_TREE (f))); - } -unbounded_again: - size_check = 0; - occur_align_size = 1; - for (c = f->children; c; c = c->sister) { - if (c->redefines) { - c->offset = c->redefines->offset; - compute_size (c); - /* Increase the size if redefinition is larger */ - if (c->level != 66 && - c->size * c->occurs_max > - c->redefines->size * c->redefines->occurs_max) { - if (cb_larger_redefines_ok) { - cb_warning_x (cb_warn_extra, CB_TREE (c), - _("size of '%s' larger than size of '%s'"), - c->name, c->redefines->name); - maxsz = c->redefines->size * c->redefines->occurs_max; - for (c0 = c->redefines->sister; c0 != c; c0 = c0->sister) { - if (c0->size * c0->occurs_max > maxsz) { - maxsz = c0->size * c0->occurs_max; - } - } - if (c->size * c->occurs_max > maxsz) { - size_check += (c->size * c->occurs_max) - maxsz; - } - } else { - cb_error_x (CB_TREE (c), - _("size of '%s' larger than size of '%s'"), - c->name, c->redefines->name); - } - } - } else { - c->offset = f->offset + (int) size_check; - compute_size (c); - if (c->flag_unbounded) { - unbounded_items++; - c->occurs_max = (COB_MAX_UNBOUNDED_SIZE / c->size / unbounded_parts) - 1; - } - size_check += c->size * c->occurs_max; - - if (c->report_column > 0) { /* offset based on COLUMN value */ - set_report_field_offset(c); - } - - /* Word alignment */ - if (c->flag_synchronized) { - align_size = 1; - switch (c->usage) { - case CB_USAGE_BINARY: - case CB_USAGE_COMP_5: - case CB_USAGE_FLOAT: - case CB_USAGE_DOUBLE: - if (c->size == 2 - || c->size == 4) { - align_size = c->size; - } else if (c->size == 8 - || c->size == 16) { - if (cb_binary_size == CB_BINARY_SIZE_2_4_8) { - if (c->usage == CB_USAGE_DOUBLE) - align_size = 8; /* COMP-2 */ - else - align_size = 4; - } else if (sizeof (void *) == 4) { - align_size = 4; /* 32 bit mode */ - } else { - align_size = 8; /* 64 bit mode */ - } - } - break; - case CB_USAGE_UNSIGNED_SHORT: - case CB_USAGE_SIGNED_SHORT: - align_size = sizeof(short); - break; - case CB_USAGE_UNSIGNED_INT: - case CB_USAGE_SIGNED_INT: - align_size = sizeof(int); - break; - case CB_USAGE_UNSIGNED_LONG: - case CB_USAGE_SIGNED_LONG: - align_size = sizeof(long); - break; - case CB_USAGE_LONG_DOUBLE: - case CB_USAGE_FP_BIN32: - case CB_USAGE_FP_BIN64: - case CB_USAGE_FP_BIN128: - case CB_USAGE_FP_DEC64: - case CB_USAGE_FP_DEC128: - if (c->size == 2 - || c->size == 4 - || c->size == 8 - || c->size == 16) { - align_size = c->size; - } - break; - case CB_USAGE_INDEX: - case CB_USAGE_HNDL: - case CB_USAGE_HNDL_WINDOW: - case CB_USAGE_HNDL_SUBWINDOW: - case CB_USAGE_HNDL_FONT: - case CB_USAGE_HNDL_THREAD: - case CB_USAGE_HNDL_MENU: - case CB_USAGE_HNDL_VARIANT: - case CB_USAGE_HNDL_LM: - case CB_USAGE_LENGTH: - align_size = sizeof (int); - break; - case CB_USAGE_OBJECT: - case CB_USAGE_POINTER: - case CB_USAGE_PROGRAM_POINTER: - align_size = sizeof (void *); - break; - case CB_USAGE_COMP_X: - case CB_USAGE_COMP_N: - break; - default: - break; - } - if ((c->offset % align_size) != 0) { - pad = align_size - (c->offset % align_size); - c->offset += pad; - size_check += pad; - } - if (align_size > occur_align_size) { - occur_align_size = align_size; - } - } - } - - if (c->sister == NULL - && c->storage == CB_STORAGE_REPORT) { /* To set parent size */ - if((c->offset + c->size) > size_check) - size_check = (c->offset + c->size); - } - } - /* Ensure items within OCCURS are aligned correctly. */ - if (f->occurs_max > 1 && (size_check % occur_align_size) != 0) { - pad = occur_align_size - (size_check % occur_align_size); - size_check += pad; - /* - Add padding to last item, which will be (partly) - responsible for misalignment. If the item is not SYNC, - we have no problem. If it is SYNC, then it has been - aligned on a smaller boundary than occur_align_size: a - 2-, 4- or 8-byte boundary. The needed padding will - be a multiple of 2, 4 or 8 bytes, so adding extra - padding will not break its alignment. - */ - if (f->children) { - get_last_child (f)->offset += pad; - } else { - /* ToDo: add appropriate message (untranslated) */ - COBC_ABORT (); /* LCOV_EXCL_LINE */ - } - } - /* size check for group items */ - if (unbounded_items) { - if (size_check > COB_MAX_UNBOUNDED_SIZE) { - /* Hack: run again for finding the correct max_occurs for unbounded items */ - if (unbounded_parts == 1 && unbounded_items != 1) { - unbounded_parts = unbounded_items; - } else { - unbounded_parts++; - } - goto unbounded_again; - } - } else if (size_check > COB_MAX_FIELD_SIZE) { - cb_error_x (CB_TREE (f), - _("'%s' cannot be larger than %d bytes"), - f->name, COB_MAX_FIELD_SIZE); - } - f->size = (int) size_check; - } else if (!f->flag_is_external_form) { - /* Elementary item */ - if (f->report_column > 0) { /* offset based on COLUMN value */ - set_report_field_offset (f); - } - - switch (f->usage) { - case CB_USAGE_COMP_X: - if(f->compx_size > 0) { - size = f->compx_size; - break; - } - case CB_USAGE_COMP_N: - if (f->pic->category == CB_CATEGORY_ALPHANUMERIC) { - break; - } - size = f->pic->size; - f->size = ((size <= 2) ? 1 : (size <= 4) ? 2 : - (size <= 7) ? 3 : (size <= 9) ? 4 : - (size <= 12) ? 5 : (size <= 14) ? 6 : - (size <= 16) ? 7 : (size <= 19) ? 8 : - (size <= 21) ? 9 : (size <= 24) ? 10 : - (size <= 26) ? 11 : (size <= 28) ? 12 : - (size <= 31) ? 13 : (size <= 33) ? 14 : - (size <= 36) ? 15 : 16); - break; - case CB_USAGE_BINARY: - case CB_USAGE_COMP_5: - size = f->pic->size; -#if 0 /* RXWRXW - Max binary */ - if (size > COB_MAX_BINARY) { - f->flag_binary_swap = 0; - size = 38; - cb_error_x (CB_TREE (f), - _("'%s' binary field cannot be larger than %d digits"), - f->name, COB_MAX_BINARY); - } -#else - if (size > 18) { - f->flag_binary_swap = 0; - size = 18; - cb_error_x (CB_TREE (f), - _("'%s' binary field cannot be larger than %d digits"), - f->name, 18); - } -#endif - compute_binary_size (f, size); - break; - case CB_USAGE_DISPLAY: - /* boolean items without USAGE BIT */ - if (f->pic->category == CB_CATEGORY_BOOLEAN) { - f->size = f->pic->size / 8; - if (f->pic->size % 8 != 0) { - f->size++; - } - break; - } - f->size = f->pic->size; - /* size check for single items */ - if (f->size > COB_MAX_FIELD_SIZE) { - cb_error_x (CB_TREE (f), - _("'%s' cannot be larger than %d bytes"), - f->name, COB_MAX_FIELD_SIZE); - } - if (f->pic->have_sign && f->flag_sign_separate) { - f->size++; - } - break; - case CB_USAGE_PACKED: - f->size = f->pic->size / 2 + 1; - break; - case CB_USAGE_COMP_6: - f->size = (f->pic->size + 1) / 2; - break; - case CB_USAGE_INDEX: - case CB_USAGE_HNDL: - case CB_USAGE_HNDL_WINDOW: - case CB_USAGE_HNDL_SUBWINDOW: - case CB_USAGE_HNDL_FONT: - case CB_USAGE_HNDL_THREAD: - case CB_USAGE_HNDL_MENU: - case CB_USAGE_HNDL_VARIANT: - case CB_USAGE_HNDL_LM: - case CB_USAGE_LENGTH: - f->size = sizeof (int); - break; - case CB_USAGE_FLOAT: - f->size = sizeof (float); - break; - case CB_USAGE_DOUBLE: - f->size = sizeof (double); - break; - case CB_USAGE_LONG_DOUBLE: - f->size = 16; - break; - case CB_USAGE_FP_BIN32: - f->size = 4; - break; - case CB_USAGE_FP_BIN64: - case CB_USAGE_FP_DEC64: - f->size = 8; - break; - case CB_USAGE_FP_BIN128: - case CB_USAGE_FP_DEC128: - f->size = 16; - break; - case CB_USAGE_OBJECT: - case CB_USAGE_POINTER: - case CB_USAGE_PROGRAM_POINTER: - f->size = sizeof (void *); - break; - case CB_USAGE_CONTROL: - break; - case CB_USAGE_BIT: - /* note: similar is found in DISPLAY */ - f->size = f->pic->size / 8; - if (f->pic->size % 8 != 0) { - f->size++; - } - break; - /* LCOV_EXCL_START */ - default: - cobc_err_msg (_("unexpected USAGE: %d"), - (int)f->usage); - COBC_ABORT (); - /* LCOV_EXCL_STOP */ - } - } - - /* The size of redefining field should not be larger than - the size of redefined field unless the redefined field - is level 01 and non-external */ - if (f->redefines && f->redefines->flag_external && - (f->size * f->occurs_max > f->redefines->size * f->redefines->occurs_max)) { - if (cb_larger_redefines_ok) { - cb_warning_x (cb_warn_extra, CB_TREE (f), - _("size of '%s' larger than size of '%s'"), - f->name, f->redefines->name); - } else { - cb_error_x (CB_TREE (f), _("size of '%s' larger than size of '%s'"), - f->name, f->redefines->name); - } - } - - return f->size; -} - -static int -validate_field_value (struct cb_field *f) -{ - if (f->values) { - if (f->usage != CB_USAGE_CONTROL) { - validate_move (CB_VALUE (f->values), CB_TREE (f), 1, NULL); - } else { - /* CHECK: possibly add validation according to control type */ - } - } - - if (f->children) { - for (f = f->children; f; f = f->sister) { - validate_field_value (f); - } - } - - return 0; -} - -void -cb_validate_field (struct cb_field *f) -{ - if (f->flag_is_verified) { - return; - } - if (validate_field_1 (f) != 0) { - f->flag_invalid = 1; - return; - } - if (f->flag_item_78) { - f->flag_is_verified = 1; - return; - } - - /* Set up parameters */ - if (f->storage == CB_STORAGE_LOCAL || - f->storage == CB_STORAGE_LINKAGE || - f->flag_item_based) { - f->flag_local = 1; - } - if (f->storage == CB_STORAGE_LINKAGE || f->flag_item_based) { - f->flag_base = 1; - } - setup_parameters (f); - - /* Compute size */ - occur_align_size = 1; - compute_size (f); - if (!f->redefines) { - f->memory_size = f->size * f->occurs_max; - } else if (f->redefines->memory_size < f->size * f->occurs_max) { - f->redefines->memory_size = f->size * f->occurs_max; - } - - validate_field_value (f); - if (f->flag_is_global) { - struct cb_field *c; -#if 0 /* CHECKME: Why should we adjust the field count here? */ - f->count++; - for (c = f->children; c; c = c->sister) { - c->flag_is_global = 1; - c->count++; - } -#else - for (c = f->children; c; c = c->sister) { - c->flag_is_global = 1; - } -#endif - } - - f->flag_is_verified = 1; -} - -void -cb_validate_88_item (struct cb_field *f) -{ - cb_tree x = CB_TREE (f); - cb_tree l; - cb_tree t; - - if (CB_VALID_TREE (f->parent) && - CB_TREE_CLASS (f->parent) == CB_CLASS_NUMERIC) { - for (l = f->values; l; l = CB_CHAIN (l)) { - t = CB_VALUE (l); - if (t == cb_space || t == cb_low || - t == cb_high || t == cb_quote) { - cb_error_x (x, _("literal type does not match numeric data type")); - } - } - } -} - -struct cb_field * -cb_validate_78_item (struct cb_field *f, const cob_u32_t no78add) -{ - cb_tree x; - cob_u32_t noadd, prec; - - if (!f) { - return last_real_field; - } - if (f->flag_internal_constant) { /* Keep all internal CONSTANTs */ - prec = 1; - } else if (f->flag_constant) { /* 01 CONSTANT is verified in parser.y */ - prec = 1; - } else { - cb_verify (cb_constant_78, "78 VALUE"); - prec = 0; - } - - if (cb_is_expr (f->values) ) { - f->values = CB_LIST_INIT(cb_evaluate_expr (f->values, prec)); - } - - x = CB_TREE (f); - noadd = no78add; - if (CB_INVALID_TREE (f->values) - || CB_INVALID_TREE(CB_VALUE(f->values))) { - level_require_error (x, "VALUE"); - noadd = 1; - } - - if (f->pic || f->flag_occurs) { - level_except_error (x, "VALUE"); - noadd = 1; - } - - if (!noadd) { - cb_add_78 (f); - } - return last_real_field; -} - -static struct cb_field * -get_next_record_field (const struct cb_field *f) -{ - if (f->children) { - return f->children; - } - - while (f) { - if (f->sister) { - return f->sister; - } else { - f = f->parent; - } - } - - return NULL; -} - -static int -error_if_rename_thru_is_before_redefines (const struct cb_field * const item) -{ - struct cb_field *f = cb_field_founder (item->redefines); - - /* - Perform depth-first search on the record containing the RENAMES items. - */ - while (f) { - /* Error if we find rename_thru before redefines */ - if (f == item->rename_thru) { - cb_error_x (CB_TREE (item), - _("THRU item '%s' may not come before '%s'"), - cb_name (CB_TREE (item->rename_thru)), - cb_name (CB_TREE (item->redefines))); - return 1; - } else if (f == item->redefines) { - return 0; - } - - f = get_next_record_field (f); - } - - return 0; -} - -static int -error_if_is_or_in_occurs (const struct cb_field * const field, - const struct cb_field * const referring_field) -{ - struct cb_field *parent; - int ret = 0; - - if (field->flag_occurs) { - cb_error_x (CB_TREE (referring_field), - _("RENAMES cannot start/end at the OCCURS item '%s'"), - cb_name (CB_TREE (field))); - ret = 1; - } - - for (parent = field->parent; parent; parent = parent->parent) { - if (parent->flag_occurs) { - cb_error_x (CB_TREE (referring_field), - _("cannot use RENAMES on part of the table '%s'"), - cb_name (CB_TREE (parent))); - ret = 1; - } - } - - return ret; -} - -static int -error_if_invalid_type_in_renames_range (const struct cb_field * const item) -{ - const struct cb_field *end; - const struct cb_field *f = item->redefines; - enum cb_category category; - int ret = 0; - - /* Find last item in RENAMES range */ - if (item->rename_thru) { - if (item->rename_thru->children) { - end = get_last_child (item->rename_thru); - } else { - end = item->rename_thru; - } - } else { - end = item->redefines; - } - - /* - Check all items are not pointers, object references or OCCURS - DEPENDING tables. - */ - while (f) { - category = cb_tree_category (CB_TREE (f)); - if (category == CB_CATEGORY_OBJECT_REFERENCE - || category == CB_CATEGORY_DATA_POINTER - || category == CB_CATEGORY_PROGRAM_POINTER) { - cb_error_x (CB_TREE (item), - _("RENAMES may not contain '%s' as it is a pointer or object reference"), - cb_name (CB_TREE (f))); - ret = 1; - } else if (f->depending) { - cb_error_x (CB_TREE (item), - _("RENAMES may not contain '%s' as it is an OCCURS DEPENDING table"), - cb_name (CB_TREE (f))); - ret = 1; - } - - if (f == end) { - break; - } else { - f = get_next_record_field (f); - } - } - return ret; -} - -static int -error_if_invalid_level_for_renames (struct cb_field const *field, cb_tree ref) -{ - int level = field->level; - - if (level == 1 || level == 66 || level == 77) { - /* don't pass error here as this should not invalidate the field */ - cb_verify_x (ref, cb_renames_uncommon_levels, - _("RENAMES of 01-, 66- and 77-level items")); - } else if (level == 88) { - cb_error_x (ref, _("RENAMES may not reference a level 88")); - return 1; - } - return 0; -} - -int -cb_validate_renames_item (struct cb_field *item, - cb_tree ref_renames, cb_tree ref_thru) -{ - const cb_tree item_tree = CB_TREE (item); - const char *redefines_name = cb_name (CB_TREE (item->redefines)); - const char *rename_thru_name = cb_name (CB_TREE (item->rename_thru)); - struct cb_field *founder; - struct cb_field *f; - int ret = 0; - - if (error_if_invalid_level_for_renames (item->redefines, ref_renames)) { - return 1; - } - - founder = cb_field_founder (item->redefines); - if (item->parent != founder) { - cb_error_x (item_tree, - _("'%s' must immediately follow the record '%s'"), - cb_name (item_tree), - cb_name (CB_TREE (founder))); - ret = 1; - } - - if (item->redefines == item->rename_thru) { - cb_error_x (item_tree, - _("THRU item must be different to '%s'"), - redefines_name); - ret = 1; - } else if (item->rename_thru) { - if (founder != cb_field_founder (item->rename_thru)) { - cb_error_x (item_tree, - _("'%s' and '%s' must be in the same record"), - redefines_name, rename_thru_name); - return 1; - } - if (error_if_rename_thru_is_before_redefines (item) - || error_if_invalid_level_for_renames (item->rename_thru, ref_thru)) { - return 1; - } - for (f = item->rename_thru; f; f = f->parent) { - if (f->parent == item->redefines) { - cb_error_x (item_tree, - _("THRU item '%s' may not be subordinate to '%s'"), - rename_thru_name, redefines_name); - return 1; - } - } - } - ret |= error_if_invalid_type_in_renames_range (item); - - if (!error_if_is_or_in_occurs (item->redefines, item) - && item->rename_thru) { - ret |= error_if_is_or_in_occurs (item->rename_thru, item); - } - - return ret; -} - -void -cb_clear_real_field (void) -{ - last_real_field = NULL; -} - -struct cb_field * -cb_get_real_field (void) -{ - return last_real_field; -} - -const char * -cb_get_usage_string (const enum cb_usage usage) -{ - switch (usage) { - case CB_USAGE_BINARY: - return "COMP"; - case CB_USAGE_BIT: - return "BIT"; - case CB_USAGE_COMP_5: - return "COMP-5"; - case CB_USAGE_COMP_X: - return "COMP-X"; - case CB_USAGE_COMP_N: - return "COMP-N"; - case CB_USAGE_DISPLAY: - return "DISPLAY"; - case CB_USAGE_FLOAT: - return "COMP-1"; - /* return "FLOAT-SHORT"; */ - case CB_USAGE_DOUBLE: - return "COMP-2"; - /* return "FLOAT-LONG"; */ - case CB_USAGE_INDEX: - return "INDEX"; - case CB_USAGE_NATIONAL: - return "NATIONAL"; - case CB_USAGE_OBJECT: - return "OBJECT REFERENCE"; - case CB_USAGE_PACKED: - return "COMP-3"; - /* return "PACKED-DECIMAL"; */ - case CB_USAGE_POINTER: - return "POINTER"; - case CB_USAGE_LENGTH: - /* Probably---generates a cob_u32_t item.*/ - return "BINARY-LONG"; - case CB_USAGE_PROGRAM_POINTER: - return "PROGRAM-POINTER"; - case CB_USAGE_UNSIGNED_CHAR: - return "UNSIGNED-CHAR"; - case CB_USAGE_SIGNED_CHAR: - return "SIGNED-CHAR"; - case CB_USAGE_UNSIGNED_SHORT: - return "UNSIGNED-SHORT"; - case CB_USAGE_SIGNED_SHORT: - return "SIGNED-SHORT"; - case CB_USAGE_UNSIGNED_INT: - return "UNSIGNED-INT"; - case CB_USAGE_SIGNED_INT: - return "SIGNED-INT"; - case CB_USAGE_UNSIGNED_LONG: - return "UNSIGNED-LONG"; - case CB_USAGE_SIGNED_LONG: - return "SIGNED-LONG"; - case CB_USAGE_COMP_6: - return "COMP-6"; - case CB_USAGE_FP_DEC64: - return "FLOAT-DECIMAL-16"; - case CB_USAGE_FP_DEC128: - return "FLOAT-DECIMAL-34"; - case CB_USAGE_FP_BIN32: - return "FLOAT-BINARY-32"; - case CB_USAGE_FP_BIN64: - return "FLOAT-BINARY-64"; - case CB_USAGE_FP_BIN128: - return "FLOAT-BINARY-128"; - case CB_USAGE_LONG_DOUBLE: - return "FLOAT-EXTENDED"; - case CB_USAGE_HNDL: - return "HANDLE"; - case CB_USAGE_HNDL_WINDOW: - return "HANDLE OF WINDOW"; - case CB_USAGE_HNDL_SUBWINDOW: - return "HANDLE OF SUBWINDOW"; - case CB_USAGE_HNDL_FONT: - return "HANDLE OF FONT"; - case CB_USAGE_HNDL_THREAD: - return "HANDLE OF THREAD"; - case CB_USAGE_HNDL_MENU: - return "HANDLE OF MENU"; - case CB_USAGE_HNDL_VARIANT: - return "VARIANT"; - case CB_USAGE_HNDL_LM: - return "HANDLE OF LAYOUT-MANAGER"; - case CB_USAGE_CONTROL: - return "CONTROL"; - /* LCOV_EXCL_START */ - default: - cb_error (_("unexpected USAGE: %d"), usage); - COBC_ABORT (); - /* LCOV_EXCL_STOP */ - } -} - -int -cb_is_figurative_constant (const cb_tree x) -{ - return x == cb_null - || x == cb_zero - || x == cb_space - || x == cb_low - || x == cb_norm_low - || x == cb_high - || x == cb_norm_high - || x == cb_quote - || (CB_REFERENCE_P (x) - && CB_REFERENCE (x)->flag_all); -} - -int -cb_field_is_ignored_in_ml_gen (struct cb_field * const f) -{ - return f->flag_filler || f->redefines || f->rename_thru; -} diff -Nru gnucobol-4.0~early~20200606/cobc/flag.def gnucobol-5/cobc/flag.def --- gnucobol-4.0~early~20200606/cobc/flag.def 2020-06-06 20:51:59.000000000 +0000 +++ gnucobol-5/cobc/flag.def 1970-01-01 00:00:00.000000000 +0000 @@ -1,213 +0,0 @@ -/* - Copyright (C) 2003-2012, 2014-2020 Free Software Foundation, Inc. - Written by Keisuke Nishida, Roger While, Simon Sobisch - - This file is part of GnuCOBOL. - - The GnuCOBOL compiler is free software: you can redistribute it - and/or modify it under the terms of the GNU General Public License - as published by the Free Software Foundation, either version 3 of the - License, or (at your option) any later version. - - GnuCOBOL is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with GnuCOBOL. If not, see . -*/ - - -/* Compiler flag defines */ - -/* Normal binary flags (standard: off) */ -/* CB_FLAG (var, help switch, name, help) */ - -/* Normal binary flags (standard: on) */ -/* CB_FLAG_ON (var, help switch, name, help) */ - -/* Flags with required parameter (standard: default)*/ -/* CB_FLAG_RQ (var, help switch, name, default, getopt return, help) */ - -/* Flags with required parameter and no associated variable */ -/* CB_FLAG_NQ (help switch, name, getopt return, help) */ - - -/* Flags with required parameter */ - -CB_FLAG_RQ (cb_stack_size, 0, "stack-size", 255, 1, - _(" -fstack-size=\tdefine PERFORM stack size\n" - " * default: 255")) - -CB_FLAG_RQ (cb_ebcdic_sign, 1, "sign", 0, 3, - _(" -fsign=[ASCII|EBCDIC]\tdefine display sign representation\n" - " * default: machine native")) - -CB_FLAG_RQ (cb_fold_copy, 1, "fold-copy", 0, 4, - _(" -ffold-copy=[UPPER|LOWER]\tfold COPY subject to value\n" - " * default: no transformation")) - -CB_FLAG_RQ (cb_fold_call, 1, "fold-call", 0, 5, - _(" -ffold-call=[UPPER|LOWER]\tfold PROGRAM-ID, CALL, CANCEL subject to value\n" - " * default: no transformation")) - -CB_FLAG_RQ (cb_default_byte, 1, "defaultbyte", -1, 6, - _(" -fdefaultbyte=\tinitialize fields without VALUE to value\n" - " * decimal 0..255 or any quoted character\n" - " * default: initialize to picture")) - -CB_FLAG_RQ (cb_max_errors, 1, "max-errors", 128, 7, - _(" -fmax-errors=\tmaximum number of errors to report before\n" - " compilation is aborted\n" - " * default: 128")) - -/* Flags with required parameter and no associated variable */ - -CB_FLAG_NQ (1, "intrinsics", 10, /* added to cb_intrinsic_list */ - _(" -fintrinsics=[ALL|intrinsic function name(,name,...)]\n" - " intrinsics to be used without FUNCTION keyword")) - -CB_FLAG_NQ (1, "dump", 8, /* ORed to cb_flag_dump */ - _(" -fdump= dump data fields on abort, may be\n" - " a combination of: ALL, WS, LS, RD, FD, SC")) - -CB_FLAG_NQ (1, "callfh", 9, /* stored in cb_call_extfh */ - _(" -fcallfh= use external provided EXTFH interface module\n" - " for I/O")) - -CB_FLAG_NQ (1, "sqldb", 11, /* stored in cb_sqldb_name */ - _(" -fsqldb= which Database is used, may be\n" - " MySQL, MSSQL, Oracle10, Oracle11, Oracle12")) - -CB_FLAG_NQ (1, "sqlschema", 12, /* stored in cb_sqldb_schema */ - _(" -fsqlschema= define database schema name")) - -/* Binary flags */ - -/* Flags with suppressed help */ - -CB_FLAG_ON (cb_flag_recursive_check, 1, "recursive-check", - _(" -fno-recursive-check disable check of recursive program call;\n" - " effectively compiling as RECURSIVE program")) - -CB_FLAG (cb_flag_winmain, 0, "winmain", - _(" -fwinmain generate WinMain instead of main when compiling\n" - " as executable")) - -CB_FLAG (cb_flag_computed_goto, 0, "computed-goto", - _(" -fcomputed-goto generate computed goto C statements")) - -CB_FLAG (cb_flag_alt_ebcdic, 0, "alternate-ebcdic", - _(" -falternate-ebcdic use restricted ASCII to EBCDIC translate")) - -CB_FLAG (cb_flag_extra_brace, 0, "extra-brace", - _(" -fextra-brace generate extra braces in C source")) - -CB_FLAG (cb_flag_c_line_directives, 0, "gen-c-line-directives", - _(" -fgen-c-line-directives\tgenerate source location directives in C code")) - -CB_FLAG (cb_flag_c_labels, 0, "gen-c-labels", - _(" -fgen-c-labels generate extra labels in C sources")) - -CB_FLAG (cb_flag_correct_numeric, 0, "correct-numeric", - _(" -fcorrect-numeric attempt correction of invalid numeric display items")) - -CB_FLAG (cb_flag_stack_on_heap, 0, "stack-on-heap", - _(" -fstack-on-heap PERFORM stack allocated on heap")) - -CB_FLAG_ON (cb_flag_fast_math, 0, "fast-math", - _(" -ffast-math Disables emitting faster arithmetic logic")) - -/* Normal flags */ - -CB_FLAG_ON (cb_flag_remove_unreachable, 1, "remove-unreachable", - _(" -fno-remove-unreachable\tdisable remove of unreachable code\n" - " * turned off by -g")) - -CB_FLAG_ON (cb_flag_inline_intrinsic, 1, "inline-intrinsic", - _(" -finline-intrinsic\twhen possible resolve intrinsic FUNCTIONs at compile time")) - -CB_FLAG (cb_flag_trace, 1, "trace", - _(" -ftrace generate trace code\n" - " * scope: executed SECTION/PARAGRAPH")) - -CB_FLAG (cb_flag_traceall, 1, "traceall", - _(" -ftraceall generate trace code\n" - " * scope: executed SECTION/PARAGRAPH/STATEMENTS\n" - " * turned on by -debug")) - -CB_FLAG (cb_flag_syntax_only, 1, "syntax-only", - _(" -fsyntax-only syntax error checking only; don't emit any output")) - -CB_FLAG (cb_flag_debugging_line, 1, "debugging-line", - _(" -fdebugging-line enable debugging lines\n" - " * 'D' in indicator column or floating >>D")) - -CB_FLAG (cb_flag_source_location, 1, "source-location", - _(" -fsource-location generate source location code\n" - " * turned on by -debug/-g/-ftraceall")) - -CB_FLAG (cb_flag_implicit_init, 1, "implicit-init", - _(" -fimplicit-init automatic initialization of the COBOL runtime system")) - -CB_FLAG (cb_flag_stack_check, 1, "stack-check", - _(" -fstack-check PERFORM stack checking\n" - " * turned on by -debug or -g")) - -CB_FLAG (cb_flag_write_after, 1, "write-after", - _(" -fwrite-after use AFTER 1 for WRITE of LINE SEQUENTIAL\n" - " * default: BEFORE 1")) - -CB_FLAG (cb_flag_mfcomment, 1, "mfcomment", - _(" -fmfcomment '*' or '/' in column 1 treated as comment\n" - " * FIXED format only")) - -CB_FLAG (cb_flag_acucomment, 1, "acucomment", - _(" -facucomment '$' in indicator area treated as '*',\n" - " '|' treated as floating comment")) - -CB_FLAG (cb_flag_notrunc, 1, "notrunc", - _(" -fnotrunc allow numeric field overflow\n" - " * non-ANSI behaviour")) - -CB_FLAG (cb_flag_odoslide, 1, "odoslide", - _(" -fodoslide adjust items following OCCURS DEPENDING\n" - " * implies -fcomplex-odo")) - -CB_FLAG (cb_flag_apostrophe, 1, "single-quote", - _(" -fsingle-quote use a single quote (apostrophe) for QUOTE\n" - " * default: double quote")) - -#if 0 /* deactivated + untranslated as -frelaxed-syntax (compiler configuration) is available */ -CB_FLAG (cb_flag_relaxed_syntax, 1, "relax-syntax", - " -frelax-syntax relax syntax checking\n" - " * e.g. REDEFINES position") -#endif - -CB_FLAG (cb_flag_optional_file, 1, "optional-file", - _(" -foptional-file treat all files as OPTIONAL\n" - " * unless NOT OPTIONAL specified")) - -CB_FLAG (cb_flag_static_call, 1, "static-call", - _(" -fstatic-call output static function calls for the CALL statement")) - -CB_FLAG_ON (cb_flag_c_decl_for_static_call, 1, "gen-c-decl-static-call", - _(" -fno-gen-c-decl-static-call\tdisable generation of C function declations\n" - " for subroutines with static CALL")) - -CB_FLAG (cb_mf_files, 1, "mf-files", - _(" -fmf-files Sequential & Relative files will match Micro Focus format")) - -CB_FLAG_ON (cb_listing_with_header, 1, "theaders", - _(" -fno-theaders suppress all headers and output of compilation\n" - " options from listing while keeping page breaks")) - -CB_FLAG_ON (cb_listing_with_source, 1, "tsource", - _(" -fno-tsource suppress source from listing")) - -CB_FLAG_ON (cb_listing_with_messages, 1, "tmessages", - _(" -fno-tmessages suppress warning and error summary from listing")) - -CB_FLAG (cb_listing_symbols, 1, "tsymbols", - _(" -ftsymbols specify symbols in listing")) diff -Nru gnucobol-4.0~early~20200606/cobc/help.c gnucobol-5/cobc/help.c --- gnucobol-4.0~early~20200606/cobc/help.c 2020-06-06 20:51:59.000000000 +0000 +++ gnucobol-5/cobc/help.c 1970-01-01 00:00:00.000000000 +0000 @@ -1,265 +0,0 @@ -/* - Copyright (C) 2001-2019 Free Software Foundation, Inc. - Written by Keisuke Nishida, Roger While, Ron Norman, Simon Sobisch, - Brian Tiffin, Edward Hart, Dave Pitts - - This file is part of GnuCOBOL. - - The GnuCOBOL compiler is free software: you can redistribute it - and/or modify it under the terms of the GNU General Public License - as published by the Free Software Foundation, either version 3 of the - License, or (at your option) any later version. - - GnuCOBOL is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with GnuCOBOL. If not, see . -*/ - -#include - -#include - -#include "cobc.h" -#include "lib/gettext.h" - -void -cobc_print_usage (char * prog) -{ - puts (_("GnuCOBOL compiler for most COBOL dialects with lots of extensions")); - putchar ('\n'); - printf (_("Usage: %s [options]... file..."), prog); - putchar ('\n'); - putchar ('\n'); - - cobc_print_usage_common_options (); - - cobc_print_usage_warnings (); - - cobc_print_usage_flags (); - - cobc_print_usage_dialect (); - - putchar ('\n'); - printf (_("Report bugs to: %s\n" - "or (preferably) use the issue tracker via the home page."), - "bug-gnucobol@gnu.org"); - putchar ('\n'); - puts (_("GnuCOBOL home page: ")); - puts (_("General help using GNU software: ")); -} - -void -cobc_print_usage_common_options (void) -{ - puts (_("Options:")); - puts (_(" -h, -help display this help and exit")); - puts (_(" -V, -version display compiler version and exit")); - puts (_(" -i, -info display compiler information (build/environment)\n" \ - " and exit")); - puts (_(" -v, -verbose display compiler version and the commands\n" \ - " invoked by the compiler")); - puts (_(" -vv, -verbose=2 like -v but additional pass verbose option\n" \ - " to assembler/compiler")); - puts (_(" -vvv, -verbose=3 like -vv but additional pass verbose option\n" \ - " to linker")); - puts (_(" -q, -brief reduced displays, commands invoked not shown")); - puts (_(" -### like -v but commands not executed")); - puts (_(" -x build an executable program")); - puts (_(" -m build a dynamically loadable module (default)")); - puts (_(" -j [], -job[=]\trun program after build, passing ")); - puts (_(" -std= warnings/features for a specific dialect\n" - " can be one of:\n" - " default, cobol2014, cobol2002, cobol85, xopen,\n" - " ibm-strict, ibm, mvs-strict, mvs,\n" - " mf-strict, mf, bs2000-strict, bs2000,\n" - " acu-strict, acu, rm-strict, rm;\n" - " see configuration files in directory config")); - puts (_(" -F, -free use free source format")); - puts (_(" -fixed use fixed source format (default)")); - puts (_(" -O, -O2, -O3, -Os enable optimization")); - puts (_(" -O0 disable optimization")); - puts (_(" -g enable C compiler debug / stack check / trace")); - puts (_(" -d, -debug enable all run-time error checking")); - puts (_(" -o place the output into ")); - puts (_(" -b combine all input files into a single\n" - " dynamically loadable module")); - puts (_(" -E preprocess only; do not compile or link")); - puts (_(" -C translation only; convert COBOL to C")); - puts (_(" -S compile only; output assembly file")); - puts (_(" -c compile and assemble, but do not link")); - puts (_(" -T generate and place a wide program listing into ")); - puts (_(" -t generate and place a program listing into ")); - puts (_(" --tlines= specify lines per page in listing, default = 55")); -#if 0 /* to be hidden later, use -f[no-]tsymbols instead */ - puts (_(" --tsymbols specify symbols in listing, use -ftsymbols instead")); -#endif - puts (_(" -P[=] generate preprocessed program listing (.lst)")); -#ifndef COB_INTERNAL_XREF - puts (_(" -Xref generate cross reference through 'cobxref'\n" - " (V. Coen's 'cobxref' must be in path)")); -#else - puts (_(" -Xref specify cross reference in listing")); -#endif - puts (_(" -I add to copy/include search path")); - puts (_(" -L add to library search path")); - puts (_(" -l link the library ")); - puts (_(" -A add to the C compile phase")); - puts (_(" -Q add to the C link phase")); - puts (_(" -D define for COBOL compilation")); - puts (_(" -K generate CALL to as static")); - puts (_(" -conf= user-defined dialect configuration; see -std")); - puts (_(" -list-reserved display reserved words")); - puts (_(" -list-intrinsics display intrinsic functions")); - puts (_(" -list-mnemonics display mnemonic names")); - puts (_(" -list-system display system routines")); - puts (_(" -save-temps[=] save intermediate files\n" - " * default: current directory")); - puts (_(" -ext add file extension for resolving COPY")); - putchar ('\n'); -} - -void -cobc_print_usage_warnings (void) -{ - puts (_("Warning options:")); - puts (_(" -W enable all warnings")); - puts (_(" -Wall enable most warnings (all except as noted below)")); - puts (_(" -Wno- disable warning enabled by default, -W or -Wall")); -#define CB_WARNDEF(var,name,doc) \ - puts (doc); -#define CB_ONWARNDEF(var,name,doc) \ - puts (doc); \ - /* TRANSLATORS: This msgid is appended to msgid for -Wno-pending and others */ \ - puts (_(" * ALWAYS active")); -#define CB_NOWARNDEF(var,name,doc) \ - puts (doc); \ - /* TRANSLATORS: This msgid is appended to msgid for -Wpossible-truncate and others */ \ - puts (_(" * NOT set with -Wall")); -#define CB_ERRWARNDEF(var,name,doc) \ - puts (doc); \ - /* TRANSLATORS: This msgid is appended to msgid for -Wpossible-truncate and others */ \ - puts (_(" * NOT set with -Wall")); -#include "warning.def" -#undef CB_WARNDEF -#undef CB_ONWARNDEF -#undef CB_NOWARNDEF -#undef CB_ERRWARNDEF - puts (_(" -Werror treat all warnings as errors")); - puts (_(" -Werror= treat specified as error")); - putchar ('\n'); -} - -static void -cobc_print_active (const char *doc, const int print_help) -{ - if (!print_help) { - return; - } - puts (doc); -} - -void -cobc_print_usage_flags (void) -{ - puts (_("Compiler options:")); -#define CB_FLAG(var,print_help,name,doc) \ - cobc_print_active (doc, print_help); -#define CB_FLAG_ON(var,print_help,name,doc) \ - cobc_print_active (doc, print_help); -#define CB_FLAG_RQ(var,print_help,name,def,opt,doc) \ - cobc_print_active (doc, print_help); -#define CB_FLAG_NQ(print_help,name,opt,doc) \ - cobc_print_active (doc, print_help); -#include "flag.def" -#undef CB_FLAG -#undef CB_FLAG_ON -#undef CB_FLAG_RQ -#undef CB_FLAG_NQ - cobc_print_active ( - _(" -fibmcomp sets -fbinary-size=2-4-8 -fsynchronized-clause=ok\n" - " -fno-ibmcomp sets -fbinary-size=1--8 -fsynchronized-clause=ignore"), 1); - putchar ('\n'); -} - -static void -cobc_print_config_flag (const char *name, const char *doc, - const char *odoc) -{ - char buff[78]; - - if (!doc) { - return; - } - if (odoc) { - snprintf (buff, sizeof (buff) - 1, "%s=%s", name, odoc); - buff [77] = 0; /* keep analyzer happy ... */ - name = (const char *) &buff; - } - if (strlen (name) <= 19) { - printf (" -f%-19s %s\n", name, doc); - } else { - printf (" -f%s\t%s\n", name, doc); - } -} - -void -cobc_print_usage_dialect (void) -{ - puts (_("Compiler dialect configuration options:")); -#define CB_CONFIG_STRING(var,name,doc) \ - cobc_print_config_flag (name, doc, _("")); -#define CB_CONFIG_INT(var,name,min,max,odoc,doc) \ - cobc_print_config_flag (name, doc, odoc); -#define CB_CONFIG_SIZE(var,name,min,max,odoc,doc) \ - cobc_print_config_flag (name, doc, odoc); -#define CB_CONFIG_ANY(type,var,name,doc) \ - cobc_print_config_flag (name, doc, _("")); -#define CB_CONFIG_BOOLEAN(var,name,doc) \ - cobc_print_config_flag (name, doc, NULL); -#define CB_CONFIG_SUPPORT(var,name,doc) \ - cobc_print_config_flag (name, doc, _("")); -#include "config.def" -#undef CB_CONFIG_ANY -#undef CB_CONFIG_INT -#undef CB_CONFIG_SIZE -#undef CB_CONFIG_STRING -#undef CB_CONFIG_BOOLEAN -#undef CB_CONFIG_SUPPORT - putchar ('\t'); - puts (_("where is one of the following:")); - putchar ('\t'); - /* Note: separated as translators should be able to replace the single quote */ - printf (_("'%s'"), "ok"); - putchar (','); - putchar (' '); - printf (_("'%s'"), "warning"); - putchar (','); - putchar (' '); - printf (_("'%s'"), "archaic"); - putchar (','); - putchar (' '); - printf (_("'%s'"), "obsolete"); - putchar (','); - putchar (' '); - printf (_("'%s'"), "skip"); - putchar (','); - putchar (' '); - printf (_("'%s'"), "ignore"); - putchar (','); - putchar (' '); - printf (_("'%s'"), "error"); - putchar (','); - putchar (' '); - printf (_("'%s'"), "unconformable"); - putchar ('\n'); - cobc_print_config_flag ("not-reserved", _("word to be taken out of the reserved words list"), _("")); - cobc_print_config_flag ("reserved", _("word to be added to reserved words list"), _("")); - cobc_print_config_flag ("reserved", _("word to be added to reserved words list as alias"), _(":")); - cobc_print_config_flag ("not-register", _("special register to disable"), _("")); - cobc_print_config_flag ("register", _("special register to enable"), _("")); - putchar ('\n'); -} diff -Nru gnucobol-4.0~early~20200606/cobc/Makefile.am gnucobol-5/cobc/Makefile.am --- gnucobol-4.0~early~20200606/cobc/Makefile.am 2020-06-06 20:51:59.000000000 +0000 +++ gnucobol-5/cobc/Makefile.am 1970-01-01 00:00:00.000000000 +0000 @@ -1,63 +0,0 @@ -# -# Makefile gnucobol/cobc -# -# Copyright (C) 2003-2012, 2014-2020 Free Software Foundation, Inc. -# Written by Keisuke Nishida, Roger While, Simon Sobisch -# -# This file is part of GnuCOBOL. -# -# The GnuCOBOL compiler is free software: you can redistribute it -# and/or modify it under the terms of the GNU General Public License -# as published by the Free Software Foundation, either version 3 of the -# License, or (at your option) any later version. -# -# GnuCOBOL is distributed in the hope that it will be useful, -# but WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -# GNU General Public License for more details. -# -# You should have received a copy of the GNU General Public License -# along with GnuCOBOL. If not, see . - -bin_PROGRAMS = cobc -cobc_SOURCES = cobc.c cobc.h ppparse.y pplex.c parser.y scanner.c config.c \ - reserved.c error.c tree.c tree.h field.c typeck.c codegen.c help.c \ - sqlxfdgen.c \ - config.def flag.def warning.def codeoptim.def ppparse.def codeoptim.c - -#cobc_SOURCES = cobc.c cobc.h ppparse.y pplex.l parser.y scanner.l config.c - -AM_CPPFLAGS = -I$(top_srcdir) -AM_CFLAGS = $(CODE_COVERAGE_CFLAGS) -cobc_LDADD = $(COBC_LIBS) $(top_builddir)/libcob/libcob.la $(top_builddir)/lib/libsupport.a \ - $(CODE_COVERAGE_LIBS) - -dist_man_MANS = cobc.1 -COBC = cobc$(EXEEXT) - -# sources that needs to be built *before* any other file -# note: we actually want their header files... -BUILT_SOURCES = ppparse.c parser.c -EXTRA_DIST = pplex.l scanner.l ppparse.h parser.h - -MAINTAINERCLEANFILES = pplex.c scanner.c ppparse.h parser.h cobc.1 -CLEANFILES = parser.output ppparse.output - -# Add rules for code-coverage testing, as provided by AX_CODE_COVERAGE -@CODE_COVERAGE_RULES@ -CODE_COVERAGE_BRANCH_COVERAGE=1 -CODE_COVERAGE_LCOV_OPTIONS = --no-external - -HELPSOURCES = help.c config.def flag.def warning.def $(top_srcdir)/configure.ac -HELP2MAN_OPTS = --info-page=$(PACKAGE) - -if MAKE_HAS_PREREQ_ONLY -cobc.1: $(HELPSOURCES) | $(COBC) - "$(top_builddir)/pre-inst-env" $(HELP2MAN) --output=$@ $(HELP2MAN_OPTS) $(COBC) -else -cobc.1: $(HELPSOURCES) - "$(top_builddir)/pre-inst-env" $(HELP2MAN) --output=$@ $(HELP2MAN_OPTS) $(COBC) -endif - -.l.c: - LC_CTYPE=C $(LEX) -o$@ $< diff -Nru gnucobol-4.0~early~20200606/cobc/Makefile.in gnucobol-5/cobc/Makefile.in --- gnucobol-4.0~early~20200606/cobc/Makefile.in 2020-06-06 20:56:36.000000000 +0000 +++ gnucobol-5/cobc/Makefile.in 1970-01-01 00:00:00.000000000 +0000 @@ -1,894 +0,0 @@ -# Makefile.in generated by automake 1.15.1 from Makefile.am. -# @configure_input@ - -# Copyright (C) 1994-2017 Free Software Foundation, Inc. - -# This Makefile.in is free software; the Free Software Foundation -# gives unlimited permission to copy and/or distribute it, -# with or without modifications, as long as this notice is preserved. - -# This program is distributed in the hope that it will be useful, -# but WITHOUT ANY WARRANTY, to the extent permitted by law; without -# even the implied warranty of MERCHANTABILITY or FITNESS FOR A -# PARTICULAR PURPOSE. - -@SET_MAKE@ - -# -# Makefile gnucobol/cobc -# -# Copyright (C) 2003-2012, 2014-2020 Free Software Foundation, Inc. -# Written by Keisuke Nishida, Roger While, Simon Sobisch -# -# This file is part of GnuCOBOL. -# -# The GnuCOBOL compiler is free software: you can redistribute it -# and/or modify it under the terms of the GNU General Public License -# as published by the Free Software Foundation, either version 3 of the -# License, or (at your option) any later version. -# -# GnuCOBOL is distributed in the hope that it will be useful, -# but WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -# GNU General Public License for more details. -# -# You should have received a copy of the GNU General Public License -# along with GnuCOBOL. If not, see . - -VPATH = @srcdir@ -am__is_gnu_make = { \ - if test -z '$(MAKELEVEL)'; then \ - false; \ - elif test -n '$(MAKE_HOST)'; then \ - true; \ - elif test -n '$(MAKE_VERSION)' && test -n '$(CURDIR)'; then \ - true; \ - else \ - false; \ - fi; \ -} -am__make_running_with_option = \ - case $${target_option-} in \ - ?) ;; \ - *) echo "am__make_running_with_option: internal error: invalid" \ - "target option '$${target_option-}' specified" >&2; \ - exit 1;; \ - esac; \ - has_opt=no; \ - sane_makeflags=$$MAKEFLAGS; \ - if $(am__is_gnu_make); then \ - sane_makeflags=$$MFLAGS; \ - else \ - case $$MAKEFLAGS in \ - *\\[\ \ ]*) \ - bs=\\; \ - sane_makeflags=`printf '%s\n' "$$MAKEFLAGS" \ - | sed "s/$$bs$$bs[$$bs $$bs ]*//g"`;; \ - esac; \ - fi; \ - skip_next=no; \ - strip_trailopt () \ - { \ - flg=`printf '%s\n' "$$flg" | sed "s/$$1.*$$//"`; \ - }; \ - for flg in $$sane_makeflags; do \ - test $$skip_next = yes && { skip_next=no; continue; }; \ - case $$flg in \ - *=*|--*) continue;; \ - -*I) strip_trailopt 'I'; skip_next=yes;; \ - -*I?*) strip_trailopt 'I';; \ - -*O) strip_trailopt 'O'; skip_next=yes;; \ - -*O?*) strip_trailopt 'O';; \ - -*l) strip_trailopt 'l'; skip_next=yes;; \ - -*l?*) strip_trailopt 'l';; \ - -[dEDm]) skip_next=yes;; \ - -[JT]) skip_next=yes;; \ - esac; \ - case $$flg in \ - *$$target_option*) has_opt=yes; break;; \ - esac; \ - done; \ - test $$has_opt = yes -am__make_dryrun = (target_option=n; $(am__make_running_with_option)) -am__make_keepgoing = (target_option=k; $(am__make_running_with_option)) -pkgdatadir = $(datadir)/@PACKAGE@ -pkgincludedir = $(includedir)/@PACKAGE@ -pkglibdir = $(libdir)/@PACKAGE@ -pkglibexecdir = $(libexecdir)/@PACKAGE@ -am__cd = CDPATH="$${ZSH_VERSION+.}$(PATH_SEPARATOR)" && cd -install_sh_DATA = $(install_sh) -c -m 644 -install_sh_PROGRAM = $(install_sh) -c -install_sh_SCRIPT = $(install_sh) -c -INSTALL_HEADER = $(INSTALL_DATA) -transform = $(program_transform_name) -NORMAL_INSTALL = : -PRE_INSTALL = : -POST_INSTALL = : -NORMAL_UNINSTALL = : -PRE_UNINSTALL = : -POST_UNINSTALL = : -build_triplet = @build@ -host_triplet = @host@ -bin_PROGRAMS = cobc$(EXEEXT) -subdir = cobc -ACLOCAL_M4 = $(top_srcdir)/aclocal.m4 -am__aclocal_m4_deps = $(top_srcdir)/m4/codeset.m4 \ - $(top_srcdir)/m4/gettext.m4 $(top_srcdir)/m4/iconv.m4 \ - $(top_srcdir)/m4/intlmacosx.m4 $(top_srcdir)/m4/lib-ld.m4 \ - $(top_srcdir)/m4/lib-link.m4 $(top_srcdir)/m4/lib-prefix.m4 \ - $(top_srcdir)/m4/libtool.m4 $(top_srcdir)/m4/ltoptions.m4 \ - $(top_srcdir)/m4/ltsugar.m4 $(top_srcdir)/m4/ltversion.m4 \ - $(top_srcdir)/m4/lt~obsolete.m4 \ - $(top_srcdir)/m4/m4_ax_check_define.m4 \ - $(top_srcdir)/m4/m4_ax_code_coverage.m4 \ - $(top_srcdir)/m4/nls.m4 $(top_srcdir)/m4/pkg.m4 \ - $(top_srcdir)/m4/po.m4 $(top_srcdir)/m4/progtest.m4 \ - $(top_srcdir)/configure.ac -am__configure_deps = $(am__aclocal_m4_deps) $(CONFIGURE_DEPENDENCIES) \ - $(ACLOCAL_M4) -DIST_COMMON = $(srcdir)/Makefile.am $(am__DIST_COMMON) -mkinstalldirs = $(SHELL) $(top_srcdir)/build_aux/mkinstalldirs -CONFIG_HEADER = $(top_builddir)/config.h -CONFIG_CLEAN_FILES = -CONFIG_CLEAN_VPATH_FILES = -am__installdirs = "$(DESTDIR)$(bindir)" "$(DESTDIR)$(man1dir)" -PROGRAMS = $(bin_PROGRAMS) -am_cobc_OBJECTS = cobc.$(OBJEXT) ppparse.$(OBJEXT) pplex.$(OBJEXT) \ - parser.$(OBJEXT) scanner.$(OBJEXT) config.$(OBJEXT) \ - reserved.$(OBJEXT) error.$(OBJEXT) tree.$(OBJEXT) \ - field.$(OBJEXT) typeck.$(OBJEXT) codegen.$(OBJEXT) \ - help.$(OBJEXT) sqlxfdgen.$(OBJEXT) codeoptim.$(OBJEXT) -cobc_OBJECTS = $(am_cobc_OBJECTS) -am__DEPENDENCIES_1 = -cobc_DEPENDENCIES = $(am__DEPENDENCIES_1) \ - $(top_builddir)/libcob/libcob.la \ - $(top_builddir)/lib/libsupport.a $(am__DEPENDENCIES_1) -AM_V_lt = $(am__v_lt_@AM_V@) -am__v_lt_ = $(am__v_lt_@AM_DEFAULT_V@) -am__v_lt_0 = --silent -am__v_lt_1 = -AM_V_P = $(am__v_P_@AM_V@) -am__v_P_ = $(am__v_P_@AM_DEFAULT_V@) -am__v_P_0 = false -am__v_P_1 = : -AM_V_GEN = $(am__v_GEN_@AM_V@) -am__v_GEN_ = $(am__v_GEN_@AM_DEFAULT_V@) -am__v_GEN_0 = @echo " GEN " $@; -am__v_GEN_1 = -AM_V_at = $(am__v_at_@AM_V@) -am__v_at_ = $(am__v_at_@AM_DEFAULT_V@) -am__v_at_0 = @ -am__v_at_1 = -DEFAULT_INCLUDES = -I.@am__isrc@ -I$(top_builddir) -depcomp = $(SHELL) $(top_srcdir)/build_aux/depcomp -am__depfiles_maybe = depfiles -am__mv = mv -f -COMPILE = $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) \ - $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -LTCOMPILE = $(LIBTOOL) $(AM_V_lt) --tag=CC $(AM_LIBTOOLFLAGS) \ - $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) \ - $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) \ - $(AM_CFLAGS) $(CFLAGS) -AM_V_CC = $(am__v_CC_@AM_V@) -am__v_CC_ = $(am__v_CC_@AM_DEFAULT_V@) -am__v_CC_0 = @echo " CC " $@; -am__v_CC_1 = -CCLD = $(CC) -LINK = $(LIBTOOL) $(AM_V_lt) --tag=CC $(AM_LIBTOOLFLAGS) \ - $(LIBTOOLFLAGS) --mode=link $(CCLD) $(AM_CFLAGS) $(CFLAGS) \ - $(AM_LDFLAGS) $(LDFLAGS) -o $@ -AM_V_CCLD = $(am__v_CCLD_@AM_V@) -am__v_CCLD_ = $(am__v_CCLD_@AM_DEFAULT_V@) -am__v_CCLD_0 = @echo " CCLD " $@; -am__v_CCLD_1 = -am__yacc_c2h = sed -e s/cc$$/hh/ -e s/cpp$$/hpp/ -e s/cxx$$/hxx/ \ - -e s/c++$$/h++/ -e s/c$$/h/ -YACCCOMPILE = $(YACC) $(AM_YFLAGS) $(YFLAGS) -LTYACCCOMPILE = $(LIBTOOL) $(AM_V_lt) $(AM_LIBTOOLFLAGS) \ - $(LIBTOOLFLAGS) --mode=compile $(YACC) $(AM_YFLAGS) $(YFLAGS) -AM_V_YACC = $(am__v_YACC_@AM_V@) -am__v_YACC_ = $(am__v_YACC_@AM_DEFAULT_V@) -am__v_YACC_0 = @echo " YACC " $@; -am__v_YACC_1 = -YLWRAP = $(top_srcdir)/build_aux/ylwrap -SOURCES = $(cobc_SOURCES) -DIST_SOURCES = $(cobc_SOURCES) -am__can_run_installinfo = \ - case $$AM_UPDATE_INFO_DIR in \ - n|no|NO) false;; \ - *) (install-info --version) >/dev/null 2>&1;; \ - esac -am__vpath_adj_setup = srcdirstrip=`echo "$(srcdir)" | sed 's|.|.|g'`; -am__vpath_adj = case $$p in \ - $(srcdir)/*) f=`echo "$$p" | sed "s|^$$srcdirstrip/||"`;; \ - *) f=$$p;; \ - esac; -am__strip_dir = f=`echo $$p | sed -e 's|^.*/||'`; -am__install_max = 40 -am__nobase_strip_setup = \ - srcdirstrip=`echo "$(srcdir)" | sed 's/[].[^$$\\*|]/\\\\&/g'` -am__nobase_strip = \ - for p in $$list; do echo "$$p"; done | sed -e "s|$$srcdirstrip/||" -am__nobase_list = $(am__nobase_strip_setup); \ - for p in $$list; do echo "$$p $$p"; done | \ - sed "s| $$srcdirstrip/| |;"' / .*\//!s/ .*/ ./; s,\( .*\)/[^/]*$$,\1,' | \ - $(AWK) 'BEGIN { files["."] = "" } { files[$$2] = files[$$2] " " $$1; \ - if (++n[$$2] == $(am__install_max)) \ - { print $$2, files[$$2]; n[$$2] = 0; files[$$2] = "" } } \ - END { for (dir in files) print dir, files[dir] }' -am__base_list = \ - sed '$$!N;$$!N;$$!N;$$!N;$$!N;$$!N;$$!N;s/\n/ /g' | \ - sed '$$!N;$$!N;$$!N;$$!N;s/\n/ /g' -am__uninstall_files_from_dir = { \ - test -z "$$files" \ - || { test ! -d "$$dir" && test ! -f "$$dir" && test ! -r "$$dir"; } \ - || { echo " ( cd '$$dir' && rm -f" $$files ")"; \ - $(am__cd) "$$dir" && rm -f $$files; }; \ - } -man1dir = $(mandir)/man1 -NROFF = nroff -MANS = $(dist_man_MANS) -am__tagged_files = $(HEADERS) $(SOURCES) $(TAGS_FILES) $(LISP) -# Read a list of newline-separated strings from the standard input, -# and print each of them once, without duplicates. Input order is -# *not* preserved. -am__uniquify_input = $(AWK) '\ - BEGIN { nonempty = 0; } \ - { items[$$0] = 1; nonempty = 1; } \ - END { if (nonempty) { for (i in items) print i; }; } \ -' -# Make sure the list of sources is unique. This is necessary because, -# e.g., the same source file might be shared among _SOURCES variables -# for different programs/libraries. -am__define_uniq_tagged_files = \ - list='$(am__tagged_files)'; \ - unique=`for i in $$list; do \ - if test -f "$$i"; then echo $$i; else echo $(srcdir)/$$i; fi; \ - done | $(am__uniquify_input)` -ETAGS = etags -CTAGS = ctags -am__DIST_COMMON = $(dist_man_MANS) $(srcdir)/Makefile.in \ - $(top_srcdir)/build_aux/depcomp \ - $(top_srcdir)/build_aux/mkinstalldirs \ - $(top_srcdir)/build_aux/ylwrap ChangeLog parser.c ppparse.c -DISTFILES = $(DIST_COMMON) $(DIST_SOURCES) $(TEXINFOS) $(EXTRA_DIST) -ACLOCAL = @ACLOCAL@ -AMTAR = @AMTAR@ -AM_DEFAULT_VERBOSITY = @AM_DEFAULT_VERBOSITY@ -AR = @AR@ -AS = @AS@ -AUTOCONF = @AUTOCONF@ -AUTOHEADER = @AUTOHEADER@ -AUTOMAKE = @AUTOMAKE@ -AWK = @AWK@ -CC = @CC@ -CCDEPMODE = @CCDEPMODE@ -CFLAGS = @CFLAGS@ -CJSON_CFLAGS = @CJSON_CFLAGS@ -CJSON_LIBS = @CJSON_LIBS@ -COBC_LIBS = @COBC_LIBS@ -COB_BIGENDIAN = @COB_BIGENDIAN@ -COB_CC = @COB_CC@ -COB_CFLAGS = @COB_CFLAGS@ -COB_CONFIG_DIR = @COB_CONFIG_DIR@ -COB_COPY_DIR = @COB_COPY_DIR@ -COB_EXE_EXT = @COB_EXE_EXT@ -COB_EXPORT_DYN = @COB_EXPORT_DYN@ -COB_FIX_LIB = @COB_FIX_LIB@ -COB_FIX_LIBTOOL = @COB_FIX_LIBTOOL@ -COB_HAS_64_BIT_POINTER = @COB_HAS_64_BIT_POINTER@ -COB_HAS_BDB = @COB_HAS_BDB@ -COB_HAS_CISAM = @COB_HAS_CISAM@ -COB_HAS_CJSON = @COB_HAS_CJSON@ -COB_HAS_CURSES = @COB_HAS_CURSES@ -COB_HAS_DISAM = @COB_HAS_DISAM@ -COB_HAS_ISAM = @COB_HAS_ISAM@ -COB_HAS_LMDB = @COB_HAS_LMDB@ -COB_HAS_OCEXTFH = @COB_HAS_OCEXTFH@ -COB_HAS_OCI = @COB_HAS_OCI@ -COB_HAS_ODBC = @COB_HAS_ODBC@ -COB_HAS_VBISAM = @COB_HAS_VBISAM@ -COB_HAS_XML2 = @COB_HAS_XML2@ -COB_KEYWORD_INLINE = @COB_KEYWORD_INLINE@ -COB_LDFLAGS = @COB_LDFLAGS@ -COB_LIBRARY_PATH = @COB_LIBRARY_PATH@ -COB_LIBS = @COB_LIBS@ -COB_MODULE_EXT = @COB_MODULE_EXT@ -COB_OBJECT_EXT = @COB_OBJECT_EXT@ -COB_PATCH_LEVEL = @COB_PATCH_LEVEL@ -COB_PIC_FLAGS = @COB_PIC_FLAGS@ -COB_SCHEMA_DIR = @COB_SCHEMA_DIR@ -COB_SHARED_OPT = @COB_SHARED_OPT@ -CODE_COVERAGE_CFLAGS = @CODE_COVERAGE_CFLAGS@ -CODE_COVERAGE_CPPFLAGS = @CODE_COVERAGE_CPPFLAGS@ -CODE_COVERAGE_CXXFLAGS = @CODE_COVERAGE_CXXFLAGS@ -CODE_COVERAGE_ENABLED = @CODE_COVERAGE_ENABLED@ -CODE_COVERAGE_LDFLAGS = @CODE_COVERAGE_LDFLAGS@ -CODE_COVERAGE_LIBS = @CODE_COVERAGE_LIBS@ -CPP = @CPP@ -CPPFLAGS = @CPPFLAGS@ -CYGPATH_W = @CYGPATH_W@ -DEFS = @DEFS@ -DEPDIR = @DEPDIR@ -DIFF_FLAGS = @DIFF_FLAGS@ -DLLTOOL = @DLLTOOL@ -DSYMUTIL = @DSYMUTIL@ -DUMPBIN = @DUMPBIN@ -ECHO_C = @ECHO_C@ -ECHO_N = @ECHO_N@ -ECHO_T = @ECHO_T@ -EGREP = @EGREP@ -EXEEXT = @EXEEXT@ -FGREP = @FGREP@ -GCOV = @GCOV@ -GENHTML = @GENHTML@ -GETTEXT_MACRO_VERSION = @GETTEXT_MACRO_VERSION@ -GMSGFMT = @GMSGFMT@ -GMSGFMT_015 = @GMSGFMT_015@ -GREP = @GREP@ -HELP2MAN = @HELP2MAN@ -INSTALL = @INSTALL@ -INSTALL_DATA = @INSTALL_DATA@ -INSTALL_PROGRAM = @INSTALL_PROGRAM@ -INSTALL_SCRIPT = @INSTALL_SCRIPT@ -INSTALL_STRIP_PROGRAM = @INSTALL_STRIP_PROGRAM@ -INTLLIBS = @INTLLIBS@ -INTL_MACOSX_LIBS = @INTL_MACOSX_LIBS@ -LCOV = @LCOV@ -LD = @LD@ -LDFLAGS = @LDFLAGS@ -LEX = @LEX@ -LEXLIB = @LEXLIB@ -LEX_OUTPUT_ROOT = @LEX_OUTPUT_ROOT@ -LIBCOB_CISAM = @LIBCOB_CISAM@ -LIBCOB_CPPFLAGS = @LIBCOB_CPPFLAGS@ -LIBCOB_DISAM = @LIBCOB_DISAM@ -LIBCOB_LIBS = @LIBCOB_LIBS@ -LIBCOB_VBISAM = @LIBCOB_VBISAM@ -LIBICONV = @LIBICONV@ -LIBINTL = @LIBINTL@ -LIBOBJS = @LIBOBJS@ -LIBS = @LIBS@ -LIBTOOL = @LIBTOOL@ -LIPO = @LIPO@ -LN_S = @LN_S@ -LTLIBICONV = @LTLIBICONV@ -LTLIBINTL = @LTLIBINTL@ -LTLIBOBJS = @LTLIBOBJS@ -LT_SYS_LIBRARY_PATH = @LT_SYS_LIBRARY_PATH@ -MAKE = @MAKE@ -MAKEINFO = @MAKEINFO@ -MANIFEST_TOOL = @MANIFEST_TOOL@ -MKDIR_P = @MKDIR_P@ -MSGFMT = @MSGFMT@ -MSGFMT_015 = @MSGFMT_015@ -MSGMERGE = @MSGMERGE@ -NM = @NM@ -NMEDIT = @NMEDIT@ -OBJDUMP = @OBJDUMP@ -OBJEXT = @OBJEXT@ -ODBC_CFLAGS = @ODBC_CFLAGS@ -ODBC_LIBS = @ODBC_LIBS@ -OTOOL = @OTOOL@ -OTOOL64 = @OTOOL64@ -PACKAGE = @PACKAGE@ -PACKAGE_BUGREPORT = @PACKAGE_BUGREPORT@ -PACKAGE_NAME = @PACKAGE_NAME@ -PACKAGE_STRING = @PACKAGE_STRING@ -PACKAGE_TARNAME = @PACKAGE_TARNAME@ -PACKAGE_URL = @PACKAGE_URL@ -PACKAGE_VERSION = @PACKAGE_VERSION@ -PATH_SEPARATOR = @PATH_SEPARATOR@ -PKG_CONFIG = @PKG_CONFIG@ -PKG_CONFIG_LIBDIR = @PKG_CONFIG_LIBDIR@ -PKG_CONFIG_PATH = @PKG_CONFIG_PATH@ -POSUB = @POSUB@ -RANLIB = @RANLIB@ -SED = @SED@ -SET_MAKE = @SET_MAKE@ -SHELL = @SHELL@ -STRIP = @STRIP@ -USE_NLS = @USE_NLS@ -VERSION = @VERSION@ -XGETTEXT = @XGETTEXT@ -XGETTEXT_015 = @XGETTEXT_015@ -XGETTEXT_EXTRA_OPTIONS = @XGETTEXT_EXTRA_OPTIONS@ -XML2_CFLAGS = @XML2_CFLAGS@ -XML2_LIBS = @XML2_LIBS@ -YACC = @YACC@ -YFLAGS = @YFLAGS@ -abs_builddir = @abs_builddir@ -abs_srcdir = @abs_srcdir@ -abs_top_builddir = @abs_top_builddir@ -abs_top_srcdir = @abs_top_srcdir@ -ac_ct_AR = @ac_ct_AR@ -ac_ct_CC = @ac_ct_CC@ -ac_ct_DUMPBIN = @ac_ct_DUMPBIN@ -am__include = @am__include@ -am__leading_dot = @am__leading_dot@ -am__quote = @am__quote@ -am__tar = @am__tar@ -am__untar = @am__untar@ -bindir = @bindir@ -build = @build@ -build_alias = @build_alias@ -build_cpu = @build_cpu@ -build_os = @build_os@ -build_vendor = @build_vendor@ -builddir = @builddir@ -configured_make = @configured_make@ -datadir = @datadir@ -datarootdir = @datarootdir@ -docdir = @docdir@ -dvidir = @dvidir@ -exec_prefix = @exec_prefix@ -host = @host@ -host_alias = @host_alias@ -host_cpu = @host_cpu@ -host_os = @host_os@ -host_vendor = @host_vendor@ -htmldir = @htmldir@ -includedir = @includedir@ -infodir = @infodir@ -install_sh = @install_sh@ -libdir = @libdir@ -libexecdir = @libexecdir@ -localedir = @localedir@ -localstatedir = @localstatedir@ -mandir = @mandir@ -mkdir_p = @mkdir_p@ -oldincludedir = @oldincludedir@ -pdfdir = @pdfdir@ -prefix = @prefix@ -program_transform_name = @program_transform_name@ -psdir = @psdir@ -runstatedir = @runstatedir@ -sbindir = @sbindir@ -sharedstatedir = @sharedstatedir@ -srcdir = @srcdir@ -sysconfdir = @sysconfdir@ -target_alias = @target_alias@ -top_build_prefix = @top_build_prefix@ -top_builddir = @top_builddir@ -top_srcdir = @top_srcdir@ -xml2_config_found = @xml2_config_found@ -cobc_SOURCES = cobc.c cobc.h ppparse.y pplex.c parser.y scanner.c config.c \ - reserved.c error.c tree.c tree.h field.c typeck.c codegen.c help.c \ - sqlxfdgen.c \ - config.def flag.def warning.def codeoptim.def ppparse.def codeoptim.c - - -#cobc_SOURCES = cobc.c cobc.h ppparse.y pplex.l parser.y scanner.l config.c -AM_CPPFLAGS = -I$(top_srcdir) -AM_CFLAGS = $(CODE_COVERAGE_CFLAGS) -cobc_LDADD = $(COBC_LIBS) $(top_builddir)/libcob/libcob.la $(top_builddir)/lib/libsupport.a \ - $(CODE_COVERAGE_LIBS) - -dist_man_MANS = cobc.1 -COBC = cobc$(EXEEXT) - -# sources that needs to be built *before* any other file -# note: we actually want their header files... -BUILT_SOURCES = ppparse.c parser.c -EXTRA_DIST = pplex.l scanner.l ppparse.h parser.h -MAINTAINERCLEANFILES = pplex.c scanner.c ppparse.h parser.h cobc.1 -CLEANFILES = parser.output ppparse.output -CODE_COVERAGE_BRANCH_COVERAGE = 1 -CODE_COVERAGE_LCOV_OPTIONS = --no-external -HELPSOURCES = help.c config.def flag.def warning.def $(top_srcdir)/configure.ac -HELP2MAN_OPTS = --info-page=$(PACKAGE) -all: $(BUILT_SOURCES) - $(MAKE) $(AM_MAKEFLAGS) all-am - -.SUFFIXES: -.SUFFIXES: .c .l .lo .o .obj .y -$(srcdir)/Makefile.in: $(srcdir)/Makefile.am $(am__configure_deps) - @for dep in $?; do \ - case '$(am__configure_deps)' in \ - *$$dep*) \ - ( cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh ) \ - && { if test -f $@; then exit 0; else break; fi; }; \ - exit 1;; \ - esac; \ - done; \ - echo ' cd $(top_srcdir) && $(AUTOMAKE) --gnu cobc/Makefile'; \ - $(am__cd) $(top_srcdir) && \ - $(AUTOMAKE) --gnu cobc/Makefile -Makefile: $(srcdir)/Makefile.in $(top_builddir)/config.status - @case '$?' in \ - *config.status*) \ - cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh;; \ - *) \ - echo ' cd $(top_builddir) && $(SHELL) ./config.status $(subdir)/$@ $(am__depfiles_maybe)'; \ - cd $(top_builddir) && $(SHELL) ./config.status $(subdir)/$@ $(am__depfiles_maybe);; \ - esac; - -$(top_builddir)/config.status: $(top_srcdir)/configure $(CONFIG_STATUS_DEPENDENCIES) - cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh - -$(top_srcdir)/configure: $(am__configure_deps) - cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh -$(ACLOCAL_M4): $(am__aclocal_m4_deps) - cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh -$(am__aclocal_m4_deps): -install-binPROGRAMS: $(bin_PROGRAMS) - @$(NORMAL_INSTALL) - @list='$(bin_PROGRAMS)'; test -n "$(bindir)" || list=; \ - if test -n "$$list"; then \ - echo " $(MKDIR_P) '$(DESTDIR)$(bindir)'"; \ - $(MKDIR_P) "$(DESTDIR)$(bindir)" || exit 1; \ - fi; \ - for p in $$list; do echo "$$p $$p"; done | \ - sed 's/$(EXEEXT)$$//' | \ - while read p p1; do if test -f $$p \ - || test -f $$p1 \ - ; then echo "$$p"; echo "$$p"; else :; fi; \ - done | \ - sed -e 'p;s,.*/,,;n;h' \ - -e 's|.*|.|' \ - -e 'p;x;s,.*/,,;s/$(EXEEXT)$$//;$(transform);s/$$/$(EXEEXT)/' | \ - sed 'N;N;N;s,\n, ,g' | \ - $(AWK) 'BEGIN { files["."] = ""; dirs["."] = 1 } \ - { d=$$3; if (dirs[d] != 1) { print "d", d; dirs[d] = 1 } \ - if ($$2 == $$4) files[d] = files[d] " " $$1; \ - else { print "f", $$3 "/" $$4, $$1; } } \ - END { for (d in files) print "f", d, files[d] }' | \ - while read type dir files; do \ - if test "$$dir" = .; then dir=; else dir=/$$dir; fi; \ - test -z "$$files" || { \ - echo " $(INSTALL_PROGRAM_ENV) $(LIBTOOL) $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=install $(INSTALL_PROGRAM) $$files '$(DESTDIR)$(bindir)$$dir'"; \ - $(INSTALL_PROGRAM_ENV) $(LIBTOOL) $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=install $(INSTALL_PROGRAM) $$files "$(DESTDIR)$(bindir)$$dir" || exit $$?; \ - } \ - ; done - -uninstall-binPROGRAMS: - @$(NORMAL_UNINSTALL) - @list='$(bin_PROGRAMS)'; test -n "$(bindir)" || list=; \ - files=`for p in $$list; do echo "$$p"; done | \ - sed -e 'h;s,^.*/,,;s/$(EXEEXT)$$//;$(transform)' \ - -e 's/$$/$(EXEEXT)/' \ - `; \ - test -n "$$list" || exit 0; \ - echo " ( cd '$(DESTDIR)$(bindir)' && rm -f" $$files ")"; \ - cd "$(DESTDIR)$(bindir)" && rm -f $$files - -clean-binPROGRAMS: - @list='$(bin_PROGRAMS)'; test -n "$$list" || exit 0; \ - echo " rm -f" $$list; \ - rm -f $$list || exit $$?; \ - test -n "$(EXEEXT)" || exit 0; \ - list=`for p in $$list; do echo "$$p"; done | sed 's/$(EXEEXT)$$//'`; \ - echo " rm -f" $$list; \ - rm -f $$list - -cobc$(EXEEXT): $(cobc_OBJECTS) $(cobc_DEPENDENCIES) $(EXTRA_cobc_DEPENDENCIES) - @rm -f cobc$(EXEEXT) - $(AM_V_CCLD)$(LINK) $(cobc_OBJECTS) $(cobc_LDADD) $(LIBS) - -mostlyclean-compile: - -rm -f *.$(OBJEXT) - -distclean-compile: - -rm -f *.tab.c - -@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/cobc.Po@am__quote@ -@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/codegen.Po@am__quote@ -@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/codeoptim.Po@am__quote@ -@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/config.Po@am__quote@ -@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/error.Po@am__quote@ -@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/field.Po@am__quote@ -@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/help.Po@am__quote@ -@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/parser.Po@am__quote@ -@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/pplex.Po@am__quote@ -@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/ppparse.Po@am__quote@ -@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/reserved.Po@am__quote@ -@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/scanner.Po@am__quote@ -@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/sqlxfdgen.Po@am__quote@ -@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/tree.Po@am__quote@ -@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/typeck.Po@am__quote@ - -.c.o: -@am__fastdepCC_TRUE@ $(AM_V_CC)$(COMPILE) -MT $@ -MD -MP -MF $(DEPDIR)/$*.Tpo -c -o $@ $< -@am__fastdepCC_TRUE@ $(AM_V_at)$(am__mv) $(DEPDIR)/$*.Tpo $(DEPDIR)/$*.Po -@AMDEP_TRUE@@am__fastdepCC_FALSE@ $(AM_V_CC)source='$<' object='$@' libtool=no @AMDEPBACKSLASH@ -@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ -@am__fastdepCC_FALSE@ $(AM_V_CC@am__nodep@)$(COMPILE) -c -o $@ $< - -.c.obj: -@am__fastdepCC_TRUE@ $(AM_V_CC)$(COMPILE) -MT $@ -MD -MP -MF $(DEPDIR)/$*.Tpo -c -o $@ `$(CYGPATH_W) '$<'` -@am__fastdepCC_TRUE@ $(AM_V_at)$(am__mv) $(DEPDIR)/$*.Tpo $(DEPDIR)/$*.Po -@AMDEP_TRUE@@am__fastdepCC_FALSE@ $(AM_V_CC)source='$<' object='$@' libtool=no @AMDEPBACKSLASH@ -@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ -@am__fastdepCC_FALSE@ $(AM_V_CC@am__nodep@)$(COMPILE) -c -o $@ `$(CYGPATH_W) '$<'` - -.c.lo: -@am__fastdepCC_TRUE@ $(AM_V_CC)$(LTCOMPILE) -MT $@ -MD -MP -MF $(DEPDIR)/$*.Tpo -c -o $@ $< -@am__fastdepCC_TRUE@ $(AM_V_at)$(am__mv) $(DEPDIR)/$*.Tpo $(DEPDIR)/$*.Plo -@AMDEP_TRUE@@am__fastdepCC_FALSE@ $(AM_V_CC)source='$<' object='$@' libtool=yes @AMDEPBACKSLASH@ -@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ -@am__fastdepCC_FALSE@ $(AM_V_CC@am__nodep@)$(LTCOMPILE) -c -o $@ $< - -.y.c: - $(AM_V_YACC)$(am__skipyacc) $(SHELL) $(YLWRAP) $< y.tab.c $@ y.tab.h `echo $@ | $(am__yacc_c2h)` y.output $*.output -- $(YACCCOMPILE) - -mostlyclean-libtool: - -rm -f *.lo - -clean-libtool: - -rm -rf .libs _libs -install-man1: $(dist_man_MANS) - @$(NORMAL_INSTALL) - @list1=''; \ - list2='$(dist_man_MANS)'; \ - test -n "$(man1dir)" \ - && test -n "`echo $$list1$$list2`" \ - || exit 0; \ - echo " $(MKDIR_P) '$(DESTDIR)$(man1dir)'"; \ - $(MKDIR_P) "$(DESTDIR)$(man1dir)" || exit 1; \ - { for i in $$list1; do echo "$$i"; done; \ - if test -n "$$list2"; then \ - for i in $$list2; do echo "$$i"; done \ - | sed -n '/\.1[a-z]*$$/p'; \ - fi; \ - } | while read p; do \ - if test -f $$p; then d=; else d="$(srcdir)/"; fi; \ - echo "$$d$$p"; echo "$$p"; \ - done | \ - sed -e 'n;s,.*/,,;p;h;s,.*\.,,;s,^[^1][0-9a-z]*$$,1,;x' \ - -e 's,\.[0-9a-z]*$$,,;$(transform);G;s,\n,.,' | \ - sed 'N;N;s,\n, ,g' | { \ - list=; while read file base inst; do \ - if test "$$base" = "$$inst"; then list="$$list $$file"; else \ - echo " $(INSTALL_DATA) '$$file' '$(DESTDIR)$(man1dir)/$$inst'"; \ - $(INSTALL_DATA) "$$file" "$(DESTDIR)$(man1dir)/$$inst" || exit $$?; \ - fi; \ - done; \ - for i in $$list; do echo "$$i"; done | $(am__base_list) | \ - while read files; do \ - test -z "$$files" || { \ - echo " $(INSTALL_DATA) $$files '$(DESTDIR)$(man1dir)'"; \ - $(INSTALL_DATA) $$files "$(DESTDIR)$(man1dir)" || exit $$?; }; \ - done; } - -uninstall-man1: - @$(NORMAL_UNINSTALL) - @list=''; test -n "$(man1dir)" || exit 0; \ - files=`{ for i in $$list; do echo "$$i"; done; \ - l2='$(dist_man_MANS)'; for i in $$l2; do echo "$$i"; done | \ - sed -n '/\.1[a-z]*$$/p'; \ - } | sed -e 's,.*/,,;h;s,.*\.,,;s,^[^1][0-9a-z]*$$,1,;x' \ - -e 's,\.[0-9a-z]*$$,,;$(transform);G;s,\n,.,'`; \ - dir='$(DESTDIR)$(man1dir)'; $(am__uninstall_files_from_dir) - -ID: $(am__tagged_files) - $(am__define_uniq_tagged_files); mkid -fID $$unique -tags: tags-am -TAGS: tags - -tags-am: $(TAGS_DEPENDENCIES) $(am__tagged_files) - set x; \ - here=`pwd`; \ - $(am__define_uniq_tagged_files); \ - shift; \ - if test -z "$(ETAGS_ARGS)$$*$$unique"; then :; else \ - test -n "$$unique" || unique=$$empty_fix; \ - if test $$# -gt 0; then \ - $(ETAGS) $(ETAGSFLAGS) $(AM_ETAGSFLAGS) $(ETAGS_ARGS) \ - "$$@" $$unique; \ - else \ - $(ETAGS) $(ETAGSFLAGS) $(AM_ETAGSFLAGS) $(ETAGS_ARGS) \ - $$unique; \ - fi; \ - fi -ctags: ctags-am - -CTAGS: ctags -ctags-am: $(TAGS_DEPENDENCIES) $(am__tagged_files) - $(am__define_uniq_tagged_files); \ - test -z "$(CTAGS_ARGS)$$unique" \ - || $(CTAGS) $(CTAGSFLAGS) $(AM_CTAGSFLAGS) $(CTAGS_ARGS) \ - $$unique - -GTAGS: - here=`$(am__cd) $(top_builddir) && pwd` \ - && $(am__cd) $(top_srcdir) \ - && gtags -i $(GTAGS_ARGS) "$$here" -cscopelist: cscopelist-am - -cscopelist-am: $(am__tagged_files) - list='$(am__tagged_files)'; \ - case "$(srcdir)" in \ - [\\/]* | ?:[\\/]*) sdir="$(srcdir)" ;; \ - *) sdir=$(subdir)/$(srcdir) ;; \ - esac; \ - for i in $$list; do \ - if test -f "$$i"; then \ - echo "$(subdir)/$$i"; \ - else \ - echo "$$sdir/$$i"; \ - fi; \ - done >> $(top_builddir)/cscope.files - -distclean-tags: - -rm -f TAGS ID GTAGS GRTAGS GSYMS GPATH tags - -distdir: $(DISTFILES) - @srcdirstrip=`echo "$(srcdir)" | sed 's/[].[^$$\\*]/\\\\&/g'`; \ - topsrcdirstrip=`echo "$(top_srcdir)" | sed 's/[].[^$$\\*]/\\\\&/g'`; \ - list='$(DISTFILES)'; \ - dist_files=`for file in $$list; do echo $$file; done | \ - sed -e "s|^$$srcdirstrip/||;t" \ - -e "s|^$$topsrcdirstrip/|$(top_builddir)/|;t"`; \ - case $$dist_files in \ - */*) $(MKDIR_P) `echo "$$dist_files" | \ - sed '/\//!d;s|^|$(distdir)/|;s,/[^/]*$$,,' | \ - sort -u` ;; \ - esac; \ - for file in $$dist_files; do \ - if test -f $$file || test -d $$file; then d=.; else d=$(srcdir); fi; \ - if test -d $$d/$$file; then \ - dir=`echo "/$$file" | sed -e 's,/[^/]*$$,,'`; \ - if test -d "$(distdir)/$$file"; then \ - find "$(distdir)/$$file" -type d ! -perm -700 -exec chmod u+rwx {} \;; \ - fi; \ - if test -d $(srcdir)/$$file && test $$d != $(srcdir); then \ - cp -fpR $(srcdir)/$$file "$(distdir)$$dir" || exit 1; \ - find "$(distdir)/$$file" -type d ! -perm -700 -exec chmod u+rwx {} \;; \ - fi; \ - cp -fpR $$d/$$file "$(distdir)$$dir" || exit 1; \ - else \ - test -f "$(distdir)/$$file" \ - || cp -p $$d/$$file "$(distdir)/$$file" \ - || exit 1; \ - fi; \ - done -check-am: all-am -check: $(BUILT_SOURCES) - $(MAKE) $(AM_MAKEFLAGS) check-am -all-am: Makefile $(PROGRAMS) $(MANS) -installdirs: - for dir in "$(DESTDIR)$(bindir)" "$(DESTDIR)$(man1dir)"; do \ - test -z "$$dir" || $(MKDIR_P) "$$dir"; \ - done -install: $(BUILT_SOURCES) - $(MAKE) $(AM_MAKEFLAGS) install-am -install-exec: install-exec-am -install-data: install-data-am -uninstall: uninstall-am - -install-am: all-am - @$(MAKE) $(AM_MAKEFLAGS) install-exec-am install-data-am - -installcheck: installcheck-am -install-strip: - if test -z '$(STRIP)'; then \ - $(MAKE) $(AM_MAKEFLAGS) INSTALL_PROGRAM="$(INSTALL_STRIP_PROGRAM)" \ - install_sh_PROGRAM="$(INSTALL_STRIP_PROGRAM)" INSTALL_STRIP_FLAG=-s \ - install; \ - else \ - $(MAKE) $(AM_MAKEFLAGS) INSTALL_PROGRAM="$(INSTALL_STRIP_PROGRAM)" \ - install_sh_PROGRAM="$(INSTALL_STRIP_PROGRAM)" INSTALL_STRIP_FLAG=-s \ - "INSTALL_PROGRAM_ENV=STRIPPROG='$(STRIP)'" install; \ - fi -mostlyclean-generic: - -clean-generic: - -test -z "$(CLEANFILES)" || rm -f $(CLEANFILES) - -distclean-generic: - -test -z "$(CONFIG_CLEAN_FILES)" || rm -f $(CONFIG_CLEAN_FILES) - -test . = "$(srcdir)" || test -z "$(CONFIG_CLEAN_VPATH_FILES)" || rm -f $(CONFIG_CLEAN_VPATH_FILES) - -maintainer-clean-generic: - @echo "This command is intended for maintainers to use" - @echo "it deletes files that may require special tools to rebuild." - -rm -f parser.c - -rm -f ppparse.c - -test -z "$(BUILT_SOURCES)" || rm -f $(BUILT_SOURCES) - -test -z "$(MAINTAINERCLEANFILES)" || rm -f $(MAINTAINERCLEANFILES) -clean: clean-am - -clean-am: clean-binPROGRAMS clean-generic clean-libtool mostlyclean-am - -distclean: distclean-am - -rm -rf ./$(DEPDIR) - -rm -f Makefile -distclean-am: clean-am distclean-compile distclean-generic \ - distclean-tags - -dvi: dvi-am - -dvi-am: - -html: html-am - -html-am: - -info: info-am - -info-am: - -install-data-am: install-man - -install-dvi: install-dvi-am - -install-dvi-am: - -install-exec-am: install-binPROGRAMS - -install-html: install-html-am - -install-html-am: - -install-info: install-info-am - -install-info-am: - -install-man: install-man1 - -install-pdf: install-pdf-am - -install-pdf-am: - -install-ps: install-ps-am - -install-ps-am: - -installcheck-am: - -maintainer-clean: maintainer-clean-am - -rm -rf ./$(DEPDIR) - -rm -f Makefile -maintainer-clean-am: distclean-am maintainer-clean-generic - -mostlyclean: mostlyclean-am - -mostlyclean-am: mostlyclean-compile mostlyclean-generic \ - mostlyclean-libtool - -pdf: pdf-am - -pdf-am: - -ps: ps-am - -ps-am: - -uninstall-am: uninstall-binPROGRAMS uninstall-man - -uninstall-man: uninstall-man1 - -.MAKE: all check install install-am install-strip - -.PHONY: CTAGS GTAGS TAGS all all-am check check-am clean \ - clean-binPROGRAMS clean-generic clean-libtool cscopelist-am \ - ctags ctags-am distclean distclean-compile distclean-generic \ - distclean-libtool distclean-tags distdir dvi dvi-am html \ - html-am info info-am install install-am install-binPROGRAMS \ - install-data install-data-am install-dvi install-dvi-am \ - install-exec install-exec-am install-html install-html-am \ - install-info install-info-am install-man install-man1 \ - install-pdf install-pdf-am install-ps install-ps-am \ - install-strip installcheck installcheck-am installdirs \ - maintainer-clean maintainer-clean-generic mostlyclean \ - mostlyclean-compile mostlyclean-generic mostlyclean-libtool \ - pdf pdf-am ps ps-am tags tags-am uninstall uninstall-am \ - uninstall-binPROGRAMS uninstall-man uninstall-man1 - -.PRECIOUS: Makefile - - -# Add rules for code-coverage testing, as provided by AX_CODE_COVERAGE -@CODE_COVERAGE_RULES@ - -@MAKE_HAS_PREREQ_ONLY_TRUE@cobc.1: $(HELPSOURCES) | $(COBC) -@MAKE_HAS_PREREQ_ONLY_TRUE@ "$(top_builddir)/pre-inst-env" $(HELP2MAN) --output=$@ $(HELP2MAN_OPTS) $(COBC) -@MAKE_HAS_PREREQ_ONLY_FALSE@cobc.1: $(HELPSOURCES) -@MAKE_HAS_PREREQ_ONLY_FALSE@ "$(top_builddir)/pre-inst-env" $(HELP2MAN) --output=$@ $(HELP2MAN_OPTS) $(COBC) - -.l.c: - LC_CTYPE=C $(LEX) -o$@ $< - -# Tell versions [3.59,3.63) of GNU make to not export all variables. -# Otherwise a system limit (for SysV at least) may be exceeded. -.NOEXPORT: diff -Nru gnucobol-4.0~early~20200606/cobc/parser.c gnucobol-5/cobc/parser.c --- gnucobol-4.0~early~20200606/cobc/parser.c 2020-06-06 20:52:39.000000000 +0000 +++ gnucobol-5/cobc/parser.c 1970-01-01 00:00:00.000000000 +0000 @@ -1,29312 +0,0 @@ -/* A Bison parser, made by GNU Bison 3.0.4. */ - -/* Bison implementation for Yacc-like parsers in C - - Copyright (C) 1984, 1989-1990, 2000-2015 Free Software Foundation, Inc. - - This program is free software: you can redistribute it and/or modify - it under the terms of the GNU General Public License as published by - the Free Software Foundation, either version 3 of the License, or - (at your option) any later version. - - This program is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with this program. If not, see . */ - -/* As a special exception, you may create a larger work that contains - part or all of the Bison parser skeleton and distribute that work - under terms of your choice, so long as that work isn't itself a - parser generator using the skeleton or a modified version thereof - as a parser skeleton. Alternatively, if you modify or redistribute - the parser skeleton itself, you may (at your option) remove this - special exception, which will cause the skeleton and the resulting - Bison output files to be licensed under the GNU General Public - License without this special exception. - - This special exception was added by the Free Software Foundation in - version 2.2 of Bison. */ - -/* C LALR(1) parser skeleton written by Richard Stallman, by - simplifying the original so-called "semantic" parser. */ - -/* All symbols defined below should begin with yy or YY, to avoid - infringing on user name space. This should be done even for local - variables, as they might otherwise be expanded by user macros. - There are some unavoidable exceptions within include files to - define necessary library symbols; they are noted "INFRINGES ON - USER NAME SPACE" below. */ - -/* Identify Bison output. */ -#define YYBISON 1 - -/* Bison version. */ -#define YYBISON_VERSION "3.0.4" - -/* Skeleton name. */ -#define YYSKELETON_NAME "yacc.c" - -/* Pure parsers. */ -#define YYPURE 0 - -/* Push parsers. */ -#define YYPUSH 0 - -/* Pull parsers. */ -#define YYPULL 1 - - - - -/* Copy the first part of user declarations. */ -#line 28 "parser.y" /* yacc.c:339 */ - -#include "config.h" - -#include -#include - -#define COB_IN_PARSER 1 -#include "cobc.h" -#include "tree.h" - -#ifndef _STDLIB_H -#define _STDLIB_H 1 -#endif - -#define YYSTYPE cb_tree -#define yyerror(x) cb_error_always ("%s", x) - -#define emit_statement(x) \ -do { \ - if (!skip_statements) { \ - CB_ADD_TO_CHAIN (x, current_program->exec_list); \ - } \ -} ONCE_COB - -#define push_expr(type, node) \ - current_expr = cb_build_list (cb_int (type), node, current_expr) - -/* Statement terminator definitions */ -#define TERM_NONE 0 -#define TERM_ACCEPT 1U -#define TERM_ADD 2U -#define TERM_CALL 3U -#define TERM_COMPUTE 4U -#define TERM_DELETE 5U -#define TERM_DISPLAY 6U -#define TERM_DIVIDE 7U -#define TERM_EVALUATE 8U -#define TERM_IF 9U -#define TERM_JSON 10U -#define TERM_MODIFY 11U -#define TERM_MULTIPLY 12U -#define TERM_PERFORM 13U -#define TERM_READ 14U -#define TERM_RECEIVE 15U -#define TERM_RETURN 16U -#define TERM_REWRITE 17U -#define TERM_SEARCH 18U -#define TERM_START 19U -#define TERM_STRING 20U -#define TERM_SUBTRACT 21U -#define TERM_UNSTRING 22U -#define TERM_WRITE 23U -#define TERM_XML 24U -#define TERM_MAX 25U /* Always last entry, used for array size */ - -#define TERMINATOR_WARNING(x,z) terminator_warning (x, TERM_##z, #z) -#define TERMINATOR_ERROR(x,z) terminator_error (x, TERM_##z, #z) -#define TERMINATOR_CLEAR(x,z) terminator_clear (x, TERM_##z) - -/* Defines for duplicate checks */ -/* Note - We use <= 16 for common item definitions and */ -/* > 16 for non-common item definitions e.g. REPORT and SCREEN */ -#define SYN_CLAUSE_1 (1U << 0) -#define SYN_CLAUSE_2 (1U << 1) -#define SYN_CLAUSE_3 (1U << 2) -#define SYN_CLAUSE_4 (1U << 3) -#define SYN_CLAUSE_5 (1U << 4) -#define SYN_CLAUSE_6 (1U << 5) -#define SYN_CLAUSE_7 (1U << 6) -#define SYN_CLAUSE_8 (1U << 7) -#define SYN_CLAUSE_9 (1U << 8) -#define SYN_CLAUSE_10 (1U << 9) -#define SYN_CLAUSE_11 (1U << 10) -#define SYN_CLAUSE_12 (1U << 11) -#define SYN_CLAUSE_13 (1U << 12) -#define SYN_CLAUSE_14 (1U << 13) -#define SYN_CLAUSE_15 (1U << 14) -#define SYN_CLAUSE_16 (1U << 15) -#define SYN_CLAUSE_17 (1U << 16) -#define SYN_CLAUSE_18 (1U << 17) -#define SYN_CLAUSE_19 (1U << 18) -#define SYN_CLAUSE_20 (1U << 19) -#define SYN_CLAUSE_21 (1U << 20) -#define SYN_CLAUSE_22 (1U << 21) -#define SYN_CLAUSE_23 (1U << 22) -#define SYN_CLAUSE_24 (1U << 23) -#define SYN_CLAUSE_25 (1U << 24) -#define SYN_CLAUSE_26 (1U << 25) -#define SYN_CLAUSE_27 (1U << 26) -#define SYN_CLAUSE_28 (1U << 27) -#define SYN_CLAUSE_29 (1U << 28) -#define SYN_CLAUSE_30 (1U << 29) -#define SYN_CLAUSE_31 (1U << 30) -#define SYN_CLAUSE_32 (1U << 31) - -#define EVAL_DEPTH 32 -#define PROG_DEPTH 16 - -/* Global variables */ - -struct cb_program *current_program = NULL; -struct cb_statement *current_statement = NULL; -struct cb_label *current_section = NULL; -struct cb_label *current_paragraph = NULL; -struct cb_field *external_defined_fields_ws; -struct cb_field *external_defined_fields_global; -cb_tree defined_prog_list = NULL; -int cb_exp_line = 0; - -cb_tree cobc_printer_node = NULL; -int functions_are_all = 0; -int non_const_word = 0; -int suppress_data_exceptions = 0; -unsigned int cobc_repeat_last_token = 0; -unsigned int cobc_in_id = 0; -unsigned int cobc_in_procedure = 0; -unsigned int cobc_in_repository = 0; -unsigned int cobc_force_literal = 0; -unsigned int cobc_cs_check = 0; -unsigned int cobc_allow_program_name = 0; -unsigned int cobc_in_xml_generate_body = 0; -unsigned int cobc_in_json_generate_body = 0; - -/* Local variables */ - -enum tallying_phrase { - NO_PHRASE, - FOR_PHRASE, - CHARACTERS_PHRASE, - ALL_LEADING_TRAILING_PHRASES, - VALUE_REGION_PHRASE -}; - -enum key_clause_type { - NO_KEY, - RECORD_KEY, - RELATIVE_KEY -}; - -static struct cb_statement *main_statement; - -static cb_tree current_expr; -static struct cb_field *current_field; -static struct cb_field *control_field; -static struct cb_field *description_field; -static struct cb_file *current_file; -static struct cb_cd *current_cd; -static struct cb_report *current_report; -static struct cb_report *report_instance; -static struct cb_key_component *key_component_list; - -static struct cb_file *linage_file; -static cb_tree next_label_list; - -static const char *stack_progid[PROG_DEPTH]; - -static enum cb_storage current_storage; - -static cb_tree perform_stack; -static cb_tree qualifier; -static cb_tree keys_list; - -static cb_tree save_tree; -static cb_tree start_tree; - -static unsigned int check_unreached; -static unsigned int in_declaratives; -static unsigned int in_debugging; -static unsigned int current_linage; -static unsigned int report_count; -static unsigned int first_prog; -static unsigned int setup_from_identification; -static unsigned int use_global_ind; -static unsigned int same_area; -static unsigned int inspect_keyword; -static unsigned int main_flag_set; -static int next_label_id; -static int eval_level; -static int eval_inc; -static int eval_inc2; -static int depth; -static int first_nested_program; -static int call_mode; -static int size_mode; -static cob_flags_t set_attr_val_on; -static cob_flags_t set_attr_val_off; -static cob_flags_t check_duplicate; -static cob_flags_t check_on_off_duplicate; -static cob_flags_t check_pic_duplicate; -static cob_flags_t check_line_col_duplicate; -static unsigned int skip_statements; -static unsigned int start_debug; -static unsigned int save_debug; -static unsigned int needs_field_debug; -static unsigned int needs_debug_item; -static unsigned int env_div_seen; -static cob_flags_t header_check; -static unsigned int call_nothing; -static enum tallying_phrase previous_tallying_phrase; -static cb_tree default_rounded_mode; -static enum key_clause_type key_type; - -static int ext_dyn_specified; -static enum cb_assign_device assign_device; - -static enum cb_display_type display_type; -static int is_first_display_item; -static cb_tree advancing_value; -static cb_tree upon_value; -static cb_tree line_column; - -static cb_tree ml_suppress_list; -static cb_tree xml_encoding; -static int with_xml_dec; -static int with_attrs; - -static cb_tree alphanumeric_collation; -static cb_tree national_collation; - -static enum cb_ml_suppress_category ml_suppress_category; - -static int term_array[TERM_MAX]; -static cb_tree eval_check[EVAL_DEPTH][EVAL_DEPTH]; - -static const char *backup_source_file = NULL; -static int backup_source_line = 0; - -/* Defines for header presence */ - -#define COBC_HD_ENVIRONMENT_DIVISION (1U << 0) -#define COBC_HD_CONFIGURATION_SECTION (1U << 1) -#define COBC_HD_SPECIAL_NAMES (1U << 2) -#define COBC_HD_INPUT_OUTPUT_SECTION (1U << 3) -#define COBC_HD_FILE_CONTROL (1U << 4) -#define COBC_HD_I_O_CONTROL (1U << 5) -#define COBC_HD_DATA_DIVISION (1U << 6) -#define COBC_HD_FILE_SECTION (1U << 7) -#define COBC_HD_WORKING_STORAGE_SECTION (1U << 8) -#define COBC_HD_LOCAL_STORAGE_SECTION (1U << 9) -#define COBC_HD_LINKAGE_SECTION (1U << 10) -#define COBC_HD_COMMUNICATION_SECTION (1U << 11) -#define COBC_HD_REPORT_SECTION (1U << 12) -#define COBC_HD_SCREEN_SECTION (1U << 13) -#define COBC_HD_PROCEDURE_DIVISION (1U << 14) -#define COBC_HD_PROGRAM_ID (1U << 15) -#define COBC_HD_SOURCE_COMPUTER (1U << 16) -#define COBC_HD_OBJECT_COMPUTER (1U << 17) -#define COBC_HD_REPOSITORY (1U << 18) - -/* Static functions */ - -static void -begin_statement (const char *name, const unsigned int term) -{ - if (check_unreached) { - cb_warning (cb_warn_unreachable, _("unreachable statement '%s'"), name); - } - current_paragraph->flag_statement = 1; - current_statement = cb_build_statement (name); - CB_TREE (current_statement)->source_file = cb_source_file; - CB_TREE (current_statement)->source_line = cb_source_line; - current_statement->flag_in_debug = in_debugging; - emit_statement (CB_TREE (current_statement)); - if (term) { - term_array[term]++; - } - main_statement = current_statement; -} - -static void -restore_backup_pos (cb_tree item) -{ - item->source_file = backup_source_file; - item->source_line = backup_source_line; -} - -static void -begin_statement_from_backup_pos (const char *name, const unsigned int term) -{ - current_paragraph->flag_statement = 1; - current_statement = cb_build_statement (name); - restore_backup_pos (CB_TREE (current_statement)); - current_statement->flag_in_debug = in_debugging; - emit_statement (CB_TREE (current_statement)); - if (term) { - term_array[term]++; - } - main_statement = current_statement; - if (check_unreached) { - cb_warning_x (cb_warn_unreachable, CB_TREE (current_statement), _("unreachable statement '%s'"), name); - } -} - -/* create a new statement with base attributes of current_statement - and set this as new current_statement */ -static void -begin_implicit_statement (void) -{ - struct cb_statement *new_statement; - new_statement = cb_build_statement (NULL); - new_statement->common = current_statement->common; - new_statement->name = current_statement->name; - new_statement->flag_in_debug = !!in_debugging; - new_statement->flag_implicit = 1; - current_statement = new_statement; - main_statement->body = cb_list_add (main_statement->body, - CB_TREE (current_statement)); -} - -# if 0 /* activate only for debugging purposes for attribs - FIXME: Replace by DEBUG_LOG function */ -static -void print_bits (cob_flags_t num) -{ - unsigned int size = sizeof (cob_flags_t); - unsigned int max_pow = 1 << (size * 8 - 1); - int i = 0; - - for(; i < size * 8; ++i){ - /* Print last bit and shift left. */ - fprintf (stderr, "%u ", num & max_pow ? 1 : 0); - num = num << 1; - } - fprintf (stderr, "\n"); -} -#endif - -/* functions for storing current position and - assigning it to a cb_tree after its parsing is finished */ -static COB_INLINE -void backup_current_pos (void) -{ - backup_source_file = cb_source_file; - backup_source_line = cb_source_line; -} - -#if 0 /* currently not used */ -static COB_INLINE -void set_pos_from_backup (cb_tree x) -{ - x->source_file = backup_source_file; - x->source_line = backup_source_line; -} -#endif - -static void -emit_entry (const char *name, const int encode, cb_tree using_list, cb_tree convention) -{ - cb_tree l; - cb_tree label; - cb_tree x; - cb_tree entry_conv; - struct cb_field *f, *ret_f; - int param_num; - char buff[COB_MINI_BUFF]; - - snprintf (buff, (size_t)COB_MINI_MAX, "E$%s", name); - label = cb_build_label (cb_build_reference (buff), NULL); - if (encode) { - CB_LABEL (label)->name = cb_encode_program_id (name, 0, cb_fold_call); - CB_LABEL (label)->orig_name = name; - } else { - CB_LABEL (label)->name = name; - CB_LABEL (label)->orig_name = current_program->orig_program_id; - } - CB_LABEL (label)->flag_begin = 1; - CB_LABEL (label)->flag_entry = 1; - label->source_line = backup_source_line; - emit_statement (label); - - if (current_program->flag_debugging) { - emit_statement (cb_build_debug (cb_debug_contents, - "START PROGRAM", NULL)); - } - - param_num = 1; - for (l = using_list; l; l = CB_CHAIN (l)) { - x = CB_VALUE (l); - if (CB_VALID_TREE (x) && cb_ref (x) != cb_error_node) { - f = CB_FIELD (cb_ref (x)); - if (!current_program->flag_chained) { - if (f->storage != CB_STORAGE_LINKAGE) { - cb_error_x (x, _("'%s' is not in LINKAGE SECTION"), f->name); - } - if (f->flag_item_based || f->flag_external) { - cb_error_x (x, _("'%s' cannot be BASED/EXTERNAL"), f->name); - } - f->flag_is_pdiv_parm = 1; - } else { - if (f->storage != CB_STORAGE_WORKING) { - cb_error_x (x, _("'%s' is not in WORKING-STORAGE SECTION"), f->name); - } - f->flag_chained = 1; - f->param_num = param_num; - param_num++; - } - if (f->level != 01 && f->level != 77) { - cb_error_x (x, _("'%s' not level 01 or 77"), f->name); - } - if (f->redefines) { - cb_error_x (x, _("'%s' REDEFINES field not allowed here"), f->name); - } - /* add a "receiving" entry for the USING parameter */ - if (cb_listing_xref) { - cobc_xref_link (&f->xref, CB_REFERENCE (x)->common.source_line, 1); - } - } - } - - - if (current_program->returning && - cb_ref (current_program->returning) != cb_error_node) { - ret_f = CB_FIELD (cb_ref (current_program->returning)); - if (ret_f->redefines) { - cb_error_x (current_program->returning, - _("'%s' REDEFINES field not allowed here"), ret_f->name); - } - } else { - ret_f = NULL; - } - - /* Check returning item against using items when FUNCTION */ - if (current_program->prog_type == COB_MODULE_TYPE_FUNCTION && ret_f) { - for (l = using_list; l; l = CB_CHAIN (l)) { - x = CB_VALUE (l); - if (CB_VALID_TREE (x) && cb_ref (x) != cb_error_node) { - f = CB_FIELD (cb_ref (x)); - if (ret_f == f) { - cb_error_x (x, _("'%s' USING item duplicates RETURNING item"), f->name); - } - } - } - } - - for (l = current_program->entry_list; l; l = CB_CHAIN (l)) { - struct cb_label *check = CB_LABEL (CB_PURPOSE (l)); - if (strcmp (name, check->name) == 0) { - cb_error_x (CB_TREE (current_statement), - _("ENTRY '%s' duplicated"), name); - } - } - - if (convention) { - entry_conv = convention; - } else { - entry_conv = current_program->entry_convention; - } - - current_program->entry_list = - cb_list_append (current_program->entry_list, - CB_BUILD_PAIR (label, CB_BUILD_PAIR(entry_conv, using_list))); -} - -static void -emit_entry_goto (const char *name) -{ - cb_tree l; - cb_tree label; - char buff[COB_MINI_BUFF]; - - snprintf (buff, (size_t)COB_MINI_MAX, "E$%s", name); - label = cb_build_label (cb_build_reference (buff), NULL); - CB_LABEL (label)->name = name; - CB_LABEL (label)->orig_name = name; - CB_LABEL (label)->flag_begin = 1; - CB_LABEL (label)->flag_entry = 1; - CB_LABEL (label)->flag_entry_for_goto = 1; - label->source_line = backup_source_line; - emit_statement (label); - - for (l = current_program->entry_list_goto; l; l = CB_CHAIN (l)) { - struct cb_label *real_label = CB_LABEL (CB_VALUE (l)); - if (strcmp (name, real_label->name) == 0) { - cb_error_x (CB_TREE (current_statement), - _("ENTRY FOR GO TO '%s' duplicated"), name); - } - } - - if (current_program->entry_list_goto) { - current_program->entry_list_goto = - cb_list_add (current_program->entry_list_goto, label); - } else { - current_program->entry_list_goto = CB_LIST_INIT (label); - } -} - -static size_t -increment_depth (void) -{ - if (++depth >= PROG_DEPTH) { - cb_error (_("maximum nested program depth exceeded (%d)"), - PROG_DEPTH); - return 1; - } - return 0; -} - -static void -terminator_warning (cb_tree stmt, const unsigned int termid, - const char *name) -{ - char terminator[32]; - - check_unreached = 0; - if (term_array[termid]) { - term_array[termid]--; - /* LCOV_EXCL_START */ - } else { - cobc_err_msg ("call to '%s' without any open term for %s", - "terminator_warning", name); - COBC_ABORT (); - } - /* LCOV_EXCL_STOP */ - snprintf (terminator, 32, "END-%s", name); - if (is_reserved_word (terminator)) { - cb_warning_x (cb_warn_terminator, CB_TREE (current_statement), - _("%s statement not terminated by %s"), name, terminator); - } - - /* Free tree associated with terminator */ - if (stmt) { - cobc_parse_free (stmt); - } -} - -static void -terminator_error (cb_tree stmt, const unsigned int termid, const char *name) -{ - char terminator[32]; - - check_unreached = 0; - if (term_array[termid]) { - term_array[termid]--; - /* LCOV_EXCL_START */ - } else { - cobc_err_msg ("call to '%s' without any open term for %s", - "terminator_error", name); - COBC_ABORT (); - } - /* LCOV_EXCL_STOP */ - snprintf (terminator, 32, "END-%s", name); - if (is_reserved_word (terminator)) { - cb_error_x (CB_TREE (current_statement), - _("%s statement not terminated by %s"), name, terminator); - } else { - cb_error_x (CB_TREE (current_statement), - _("%s statement not terminated"), name); - } - - /* Free tree associated with terminator */ - if (stmt) { - cobc_parse_free (stmt); - } -} - -static void -terminator_clear (cb_tree stmt, const unsigned int termid) -{ - struct cb_perform *p; - check_unreached = 0; - if (term_array[termid]) { - term_array[termid]--; - /* LCOV_EXCL_START */ - } else { - cobc_err_msg ("call to '%s' without any open term for %s", - "terminator_warning", current_statement->name); - COBC_ABORT (); - } - /* LCOV_EXCL_STOP */ - if (termid == TERM_PERFORM - && perform_stack) { - p = CB_PERFORM (CB_VALUE (perform_stack)); - if (p->perform_type == CB_PERFORM_UNTIL) { - cb_terminate_cond (); - } - } - /* Free tree associated with terminator */ - if (stmt) { - cobc_parse_free (stmt); - } -} - -static int -literal_value (cb_tree x) -{ - if (x == cb_space) { - return ' '; - } else if (x == cb_zero) { - return '0'; - } else if (x == cb_quote) { - return cb_flag_apostrophe ? '\'' : '"'; - } else if (x == cb_null) { - return 0; - } else if (x == cb_low) { - return 0; - } else if (x == cb_high) { - return 255; - } else if (CB_TREE_CLASS (x) == CB_CLASS_NUMERIC) { - return cb_get_int (x); - } else { - return CB_LITERAL (x)->data[0]; - } -} - -static void -setup_use_file (struct cb_file *fileptr) -{ - struct cb_file *newptr; - - if (fileptr->organization == COB_ORG_SORT) { - cb_error (_("USE statement invalid for SORT file")); - } - if (fileptr->flag_global) { - newptr = cobc_parse_malloc (sizeof(struct cb_file)); - *newptr = *fileptr; - newptr->handler = current_section; - newptr->handler_prog = current_program; - if (!use_global_ind) { - current_program->local_file_list = - cb_list_add (current_program->local_file_list, - CB_TREE (newptr)); - } else { - current_program->global_file_list = - cb_list_add (current_program->global_file_list, - CB_TREE (newptr)); - } - } else { - fileptr->handler = current_section; - } -} - -static void -emit_duplicate_clause_message (const char *clause) -{ - /* FIXME: replace by a new warning level that is set - to warn/error depending on cb_relaxed_syntax_checks */ - if (cb_relaxed_syntax_checks) { - cb_warning (COBC_WARN_FILLER, _("duplicate %s clause"), clause); - } else { - cb_error (_("duplicate %s clause"), clause); - } -} - -static void -check_repeated (const char *clause, const cob_flags_t bitval, cob_flags_t *already_seen) -{ - if (*already_seen & bitval) { - emit_duplicate_clause_message (clause); - } else { - *already_seen |= bitval; - } -} - -static void -error_if_no_page_lines_limit (const char *phrase) -{ - if (!current_report->lines && !current_report->t_lines) { - cb_error (_("Cannot specify %s without number of lines on page"), - phrase); - } -} - -static void -setup_occurs (void) -{ - check_repeated ("OCCURS", SYN_CLAUSE_7, &check_pic_duplicate); - if (current_field->indexes == COB_MAX_SUBSCRIPTS) { - cb_error (_("maximum OCCURS depth exceeded (%d)"), - COB_MAX_SUBSCRIPTS); - } else { - current_field->indexes++; - } - - if (current_field->flag_unbounded) { - if (current_field->storage != CB_STORAGE_LINKAGE) { - cb_error_x (CB_TREE(current_field), _("'%s' is not in LINKAGE SECTION"), - cb_name (CB_TREE(current_field))); - } - } - - if (current_field->flag_item_based) { - cb_error (_("%s and %s are mutually exclusive"), "BASED", "OCCURS"); - } else if (current_field->flag_external) { - cb_error (_("%s and %s are mutually exclusive"), "EXTERNAL", "OCCURS"); - } - current_field->flag_occurs = 1; -} - -static void -setup_occurs_min_max (cb_tree occurs_min, cb_tree occurs_max) -{ - if (occurs_max) { - current_field->occurs_min = cb_get_int (occurs_min); - if (occurs_max != cb_int0) { - current_field->occurs_max = cb_get_int (occurs_max); - if (!current_field->depending) { - if (cb_relaxed_syntax_checks) { - cb_warning (COBC_WARN_FILLER, _("TO phrase without DEPENDING phrase")); - cb_warning (COBC_WARN_FILLER, _("maximum number of occurrences assumed to be exact number")); - current_field->occurs_min = 1; /* CHECKME: why using 1 ? */ - } else { - cb_error (_("TO phrase without DEPENDING phrase")); - } - } - if (current_field->occurs_max <= current_field->occurs_min) { - cb_error (_("OCCURS TO must be greater than OCCURS FROM")); - } - } else { - current_field->occurs_max = 0; - } - } else { - current_field->occurs_min = 1; /* CHECKME: why using 1 ? */ - current_field->occurs_max = cb_get_int (occurs_min); - if (current_field->depending) { - cb_verify (cb_odo_without_to, _("OCCURS DEPENDING ON without TO phrase")); - } - } -} - -static void -check_relaxed_syntax (const cob_flags_t lev) -{ - const char *s; - - switch (lev) { - case COBC_HD_ENVIRONMENT_DIVISION: - s = "ENVIRONMENT DIVISION"; - break; - case COBC_HD_CONFIGURATION_SECTION: - s = "CONFIGURATION SECTION"; - break; - case COBC_HD_SPECIAL_NAMES: - s = "SPECIAL-NAMES"; - break; - case COBC_HD_INPUT_OUTPUT_SECTION: - s = "INPUT-OUTPUT SECTION"; - break; - case COBC_HD_FILE_CONTROL: - s = "FILE-CONTROL"; - break; - case COBC_HD_I_O_CONTROL: - s = "I-O-CONTROL"; - break; - case COBC_HD_DATA_DIVISION: - s = "DATA DIVISION"; - break; - case COBC_HD_FILE_SECTION: - s = "FILE SECTION"; - break; - case COBC_HD_WORKING_STORAGE_SECTION: - s = "WORKING-STORAGE SECTION"; - break; - case COBC_HD_LOCAL_STORAGE_SECTION: - s = "LOCAL-STORAGE SECTION"; - break; - case COBC_HD_LINKAGE_SECTION: - s = "LINKAGE SECTION"; - break; - case COBC_HD_COMMUNICATION_SECTION: - s = "COMMUNICATION SECTION"; - break; - case COBC_HD_REPORT_SECTION: - s = "REPORT SECTION"; - break; - case COBC_HD_SCREEN_SECTION: - s = "SCREEN SECTION"; - break; - case COBC_HD_PROCEDURE_DIVISION: - s = "PROCEDURE DIVISION"; - break; - case COBC_HD_PROGRAM_ID: - s = "PROGRAM-ID"; - break; - /* LCOV_EXCL_START */ - default: - s = _("unknown"); - break; - /* LCOV_EXCL_STOP */ - } - if (cb_relaxed_syntax_checks) { - cb_warning (COBC_WARN_FILLER, _("%s header missing - assumed"), s); - } else { - cb_error (_("%s header missing"), s); - } -} - -static void -program_init_without_program_id (void) -{ - cb_tree l; - - current_section = NULL; - current_paragraph = NULL; - l = cb_build_alphanumeric_literal (demangle_name, - strlen (demangle_name)); - current_program->program_name = (char *)CB_LITERAL (l)->data; - current_program->program_id - = cb_build_program_id (current_program->program_name, 0); - current_program->prog_type = COB_MODULE_TYPE_PROGRAM; - if (!main_flag_set) { - main_flag_set = 1; - current_program->flag_main = cobc_flag_main; - } - check_relaxed_syntax (COBC_HD_PROGRAM_ID); -} - -/* check if headers are present - return 0 if fine, 1 if missing - Lev1 must always be present and is checked - Lev2/3/4, if non-zero (forced) may be present -*/ -static int -check_headers_present (const cob_flags_t lev1, const cob_flags_t lev2, - const cob_flags_t lev3, const cob_flags_t lev4) -{ - int ret = 0; - if (!(header_check & lev1)) { - header_check |= lev1; - check_relaxed_syntax (lev1); - ret = 1; - } - if (lev2) { - if (!(header_check & lev2)) { - header_check |= lev2; - check_relaxed_syntax (lev2); - ret = 1; - } - } - if (lev3) { - if (!(header_check & lev3)) { - header_check |= lev3; - check_relaxed_syntax (lev3); - ret = 1; - } - } - if (lev4) { - if (!(header_check & lev4)) { - header_check |= lev4; - check_relaxed_syntax (lev4); - ret = 1; - } - } - return ret; -} - -/* - TO-DO: Refactor header checks - have several header_checks: division_header, - section_header, paragraph_header, sentence_type -*/ -static void -set_conf_section_part (const cob_flags_t part) -{ - header_check &= ~COBC_HD_SOURCE_COMPUTER; - header_check &= ~COBC_HD_OBJECT_COMPUTER; - header_check &= ~COBC_HD_SPECIAL_NAMES; - header_check &= ~COBC_HD_REPOSITORY; - header_check |= part; -} - -static const char * -get_conf_section_part_name (const cob_flags_t part) -{ - if (part == COBC_HD_SOURCE_COMPUTER) { - return "SOURCE-COMPUTER"; - } else if (part == COBC_HD_OBJECT_COMPUTER) { - return "OBJECT-COMPUTER"; - } else if (part == COBC_HD_SPECIAL_NAMES) { - return "SPECIAL-NAMES"; - } else if (part == COBC_HD_REPOSITORY) { - return "REPOSITORY"; - /* LCOV_EXCL_START */ - } else { - /* This should never happen (and therefore doesn't get a translation) */ - cb_error ("unexpected configuration section part " CB_FMT_LLU, part); - COBC_ABORT (); - /* LCOV_EXCL_STOP */ - } -} - -static int -get_conf_section_part_order (const cob_flags_t part) -{ - if (part == COBC_HD_SOURCE_COMPUTER) { - return 1; - } else if (part == COBC_HD_OBJECT_COMPUTER) { - return 2; - } else if (part == COBC_HD_SPECIAL_NAMES) { - return 3; - } else if (part == COBC_HD_REPOSITORY) { - return 4; - /* LCOV_EXCL_START */ - } else { - /* This should never happen (and therefore doesn't get a translation) */ - cb_error ("unexpected configuration section part " CB_FMT_LLU, part); - COBC_ABORT (); - /* LCOV_EXCL_STOP */ - } -} - -static void -check_conf_section_order (const cob_flags_t part) -{ - const cob_flags_t prev_part - = header_check & (COBC_HD_SOURCE_COMPUTER - | COBC_HD_OBJECT_COMPUTER - | COBC_HD_SPECIAL_NAMES - | COBC_HD_REPOSITORY); -#define MESSAGE_LEN 100 - char message[MESSAGE_LEN] = { '\0' }; - - if (prev_part == 0) { - return; - } - - if (prev_part == part) { - cb_error (_("duplicate %s"), get_conf_section_part_name (part)); - } else if (get_conf_section_part_order (part) < get_conf_section_part_order (prev_part)) { - snprintf (message, MESSAGE_LEN, _("%s incorrectly after %s"), - get_conf_section_part_name (part), - get_conf_section_part_name (prev_part)); - cb_verify (cb_incorrect_conf_sec_order, message); - } -} - -#undef MESSAGE_LEN - -static void -build_words_for_nested_programs (void) -{ - cb_tree x; - cb_tree y; - - /* Inherit special name mnemonics from parent */ - for (x = current_program->mnemonic_spec_list; x; x = CB_CHAIN (x)) { - y = cb_build_reference (cb_name(CB_PURPOSE(x))); - if (CB_SYSTEM_NAME_P (CB_VALUE(x))) { - cb_define (y, CB_VALUE(x)); - } else { - cb_build_constant (y, CB_VALUE(x)); - } - } - - /* Inherit class names from parent */ - for (x = current_program->class_name_list; x; x = CB_CHAIN(x)) { - y = cb_build_reference (cb_name(CB_VALUE(x))); - cb_define (y, CB_VALUE(x)); - } -} - -static void -clear_initial_values (void) -{ - perform_stack = NULL; - current_statement = NULL; - main_statement = NULL; - qualifier = NULL; - in_declaratives = 0; - in_debugging = 0; - use_global_ind = 0; - check_duplicate = 0; - check_pic_duplicate = 0; - skip_statements = 0; - start_debug = 0; - save_debug = 0; - needs_field_debug = 0; - needs_debug_item = 0; - env_div_seen = 0; - header_check = 0; - next_label_id = 0; - current_linage = 0; - set_attr_val_on = 0; - set_attr_val_off = 0; - report_count = 0; - current_storage = CB_STORAGE_WORKING; - eval_level = 0; - eval_inc = 0; - eval_inc2 = 0; - inspect_keyword = 0; - check_unreached = 0; - cobc_in_id = 0; - cobc_in_procedure = 0; - cobc_in_repository = 0; - cobc_force_literal = 0; - cobc_in_xml_generate_body = 0; - cobc_in_json_generate_body = 0; - non_const_word = 0; - suppress_data_exceptions = 0; - same_area = 1; - memset ((void *)eval_check, 0, sizeof(eval_check)); - memset ((void *)term_array, 0, sizeof(term_array)); - linage_file = NULL; - current_file = NULL; - current_cd = NULL; - current_report = NULL; - report_instance = NULL; - next_label_list = NULL; - default_rounded_mode = cb_int (COB_STORE_ROUND); -} - -/* - We must check for redefinitions of program-names and external program names - outside of the usual reference/word_list methods as it may have to be done in - a case-sensitive way. -*/ -static void -begin_scope_of_program_name (struct cb_program *program) -{ - const char *prog_name = program->program_name; - const char *prog_id = program->orig_program_id; - const char *elt_name; - const char *elt_id; - cb_tree l; - - /* Error if a program with the same name has been defined. */ - for (l = defined_prog_list; l; l = CB_CHAIN (l)) { - elt_name = ((struct cb_program *) CB_VALUE (l))->program_name; - elt_id = ((struct cb_program *) CB_VALUE (l))->orig_program_id; - if (cb_fold_call && strcasecmp (prog_name, elt_name) == 0) { - cb_error_x ((cb_tree) program, - _("redefinition of program name '%s'"), - elt_name); - } else if (strcmp (prog_id, elt_id) == 0) { - cb_error_x ((cb_tree) program, - _("redefinition of program ID '%s'"), - elt_id); - return; - } - } - - /* Otherwise, add the program to the list. */ - defined_prog_list = cb_list_add (defined_prog_list, - (cb_tree) program); -} - -static void -remove_program_name (struct cb_list *l, struct cb_list *prev) -{ - if (prev == NULL) { - defined_prog_list = l->chain; - } else { - prev->chain = l->chain; - } - cobc_parse_free (l); -} - -/* Remove the program from defined_prog_list, if necessary. */ -static void -end_scope_of_program_name (struct cb_program *program, const unsigned char type) -{ - struct cb_list *prev = NULL; - struct cb_list *l = (struct cb_list *) defined_prog_list; - - /* create empty entry if the program has no PROCEDURE DIVISION, error for UDF */ - if (!program->entry_list) { - if (type == COB_MODULE_TYPE_FUNCTION) { - cb_error (_("FUNCTION '%s' has no PROCEDURE DIVISION"), program->program_name); - } else { - emit_entry (program->program_id, 0, NULL, NULL); - } - } - program->last_source_line = backup_source_line; - - if (program->nested_level == 0) { - return; - } - - /* Remove any subprograms */ - l = CB_LIST (defined_prog_list); - while (l) { - if (CB_PROGRAM (l->value)->nested_level > program->nested_level) { - remove_program_name (l, prev); - } else { - prev = l; - } - if (prev && prev->chain != NULL) { - l = CB_LIST (prev->chain); - } else { - l = NULL; - } - } - - /* Remove the specified program, if it is not COMMON */ - if (!program->flag_common) { - l = (struct cb_list *) defined_prog_list; - while (l) { - /* The nested_level check is for the pathological case - where two nested programs have the same name */ - if (0 == strcmp (program->orig_program_id, - CB_PROGRAM (l->value)->orig_program_id) - && program->nested_level == CB_PROGRAM (l->value)->nested_level) { - remove_program_name (l, prev); - if (prev && prev->chain != NULL) { - l = CB_LIST (prev->chain); - } else { - l = NULL; - } - break; - } else { - prev = l; - if (l->chain != NULL) { - l = CB_LIST (l->chain); - } else { - l = NULL; - } - } - } - } -} - -static void -setup_program_start (void) -{ - if (setup_from_identification) { - setup_from_identification = 0; - return; - } - current_section = NULL; - current_paragraph = NULL; - - if (depth != 0 && first_nested_program) { - check_headers_present (COBC_HD_PROCEDURE_DIVISION, 0, 0, 0); - } - first_nested_program = 1; -} - -static int -setup_program (cb_tree id, cb_tree as_literal, const unsigned char type) -{ - const char *external_name = NULL; - - setup_program_start (); - - /* finish last program/function */ - if (!first_prog) { - if (!current_program->flag_validated) { - current_program->flag_validated = 1; - cb_validate_program_body (current_program); - } - - clear_initial_values (); - current_program = cb_build_program (current_program, depth); - if (depth) { - build_words_for_nested_programs(); - } - cb_set_intr_when_compiled (); - cb_build_registers (); - cb_add_external_defined_registers (); - } else { - first_prog = 0; - } - - /* set internal name */ - if (CB_LITERAL_P (id)) { - current_program->program_name = (char *)CB_LITERAL (id)->data; - } else { - current_program->program_name = CB_NAME (id); - } - stack_progid[depth] = current_program->program_name; - current_program->prog_type = type; - - if (depth != 0 && type == COB_MODULE_TYPE_FUNCTION) { - cb_error (_("functions may not be defined within a program/function")); - } - - if (increment_depth ()) { - return 1; - } - - /* set external name if specified */ - if (as_literal) { - external_name = (const char *)CB_LITERAL (as_literal)->data; - } else { - external_name = current_program->program_name; - } - - /* build encoded external PROGRAM-ID */ - current_program->program_id - = cb_build_program_id (external_name, type == COB_MODULE_TYPE_FUNCTION); - - if (type == COB_MODULE_TYPE_PROGRAM) { - if (!main_flag_set) { - main_flag_set = 1; - current_program->flag_main = !!cobc_flag_main; - } - } else { /* COB_MODULE_TYPE_FUNCTION */ - current_program->flag_recursive = 1; - } - - if (CB_REFERENCE_P (id)) { - cb_define (id, CB_TREE (current_program)); - } - - begin_scope_of_program_name (current_program); - - return 0; -} - -static void -decrement_depth (const char *name, const unsigned char type) -{ - int d; - - if (depth) { - depth--; - } - - if (!strcmp (stack_progid[depth], name)) { - return; - } - - if (type == COB_MODULE_TYPE_FUNCTION) { - cb_error (_("END FUNCTION '%s' is different from FUNCTION-ID '%s'"), - name, stack_progid[depth]); - return; - } - - /* Set depth to that of whatever program we just ended, if it exists. */ - for (d = depth; d >= 0; --d) { - if (!strcmp (stack_progid[d], name)) { - depth = d; - return; - } - } - - if (depth != d) { - cb_error (_("END PROGRAM '%s' is different from PROGRAM-ID '%s'"), - name, stack_progid[depth]); - } -} - -static void -clean_up_program (cb_tree name, const unsigned char type) -{ - char *s; - - end_scope_of_program_name (current_program, type); - - if (name) { - if (CB_LITERAL_P (name)) { - s = (char *)(CB_LITERAL (name)->data); - } else { - s = (char *)(CB_NAME (name)); - } - - decrement_depth (s, type); - } - - current_section = NULL; - current_paragraph = NULL; - if (!current_program->flag_validated) { - current_program->flag_validated = 1; - cb_validate_program_body (current_program); - } -} - -static const char * -get_literal_or_word_name (const cb_tree x) -{ - if (CB_LITERAL_P (x)) { - return (const char *) CB_LITERAL (x)->data; - } else { /* CB_REFERENCE_P (x) */ - return (const char *) CB_NAME (x); - } -} - -/* verify and set currency symbol used in picture (compile time) and - if no currency - string is explicitly set (which is currently not implemented) - as currency string - (run time for display and [de-]editing)*/ -static void -set_currency_picture_symbol (const cb_tree x) -{ - unsigned char *s = CB_LITERAL (x)->data; - - if (CB_LITERAL (x)->size != 1) { - cb_error_x (x, _("currency symbol must be one character long")); - return; - } - switch (*s) { - case '0': - case '1': - case '2': - case '3': - case '4': - case '5': - case '6': - case '7': - case '8': - case '9': - case 'A': - case 'B': - case 'C': - case 'D': - case 'E': - case 'N': - case 'P': - case 'R': - case 'S': - case 'V': - case 'X': - case 'Z': - case 'a': - case 'b': - case 'c': - case 'd': - case 'e': - case 'n': - case 'p': - case 'r': - case 's': - case 'v': - case 'x': - case 'z': - case '+': - case '-': - case ',': - case '.': - case '*': - case '/': - case ';': - case '(': - case ')': - case '=': - case '\'': - case '"': - case ' ': -#if 0 /* note: MicroFocus also dissalows L (VAX) and G (OSVS) */ - case 'L': - case 'G': - case 'l': - case 'g': -#endif - cb_error_x (x, _("invalid character '%c' in currency symbol"), s[0]); - return; - default: - break; - } - current_program->currency_symbol = s[0]; -} - -/* Return 1 if the prototype name is the same as the current function's. */ -static int -check_prototype_redefines_current_element (const cb_tree prototype_name) -{ - const char *name = get_literal_or_word_name (prototype_name); - - if (strcasecmp (name, current_program->program_name) == 0) { - cb_warning_x (COBC_WARN_FILLER, prototype_name, - _("prototype has same name as current function and will be ignored")); - return 1; - } - - return 0; -} - -/* Returns 1 if the prototype has been duplicated. */ -static int -check_for_duplicate_prototype (const cb_tree prototype_name, - const cb_tree prototype) -{ - cb_tree dup; - - if (CB_WORD_COUNT (prototype_name) > 0) { - /* Make sure the duplicate is a prototype */ - dup = cb_ref (prototype_name); - if (!CB_PROTOTYPE_P (dup)) { - redefinition_error (prototype_name); - return 1; - } - - /* Check the duplicate prototypes match */ - if (strcmp (CB_PROTOTYPE (prototype)->ext_name, - CB_PROTOTYPE (dup)->ext_name) - || CB_PROTOTYPE (prototype)->type != CB_PROTOTYPE (dup)->type) { - cb_error_x (prototype_name, - _("duplicate REPOSITORY entries for '%s' do not match"), - get_literal_or_word_name (prototype_name)); - } else { - cb_warning_x (COBC_WARN_FILLER, prototype_name, - _("duplicate REPOSITORY entry for '%s'"), - get_literal_or_word_name (prototype_name)); - } - return 1; - } - - return 0; -} - -static void -setup_prototype (cb_tree prototype_name, cb_tree ext_name, - const int type, const int is_current_element) -{ - cb_tree prototype; - int name_redefinition_allowed; - - if (!is_current_element - && check_prototype_redefines_current_element (prototype_name)) { - return; - } - - prototype = cb_build_prototype (prototype_name, ext_name, type); - - if (!is_current_element - && check_for_duplicate_prototype (prototype_name, prototype)) { - return; - } - - name_redefinition_allowed = type == COB_MODULE_TYPE_PROGRAM - && is_current_element && cb_program_name_redefinition; - if (!name_redefinition_allowed) { - if (CB_LITERAL_P (prototype_name)) { - cb_define (cb_build_reference ((const char *)CB_LITERAL (prototype_name)->data), prototype); - } else { - cb_define (prototype_name, prototype); - } - - if (type == COB_MODULE_TYPE_PROGRAM) { - current_program->program_spec_list = - cb_list_add (current_program->program_spec_list, prototype); - } else { /* COB_MODULE_TYPE_FUNCTION */ - current_program->user_spec_list = - cb_list_add (current_program->user_spec_list, prototype); - } - } -} - -static void -error_if_record_delimiter_incompatible (const int organization, - const char *organization_name) -{ - int is_compatible; - - if (!current_file->flag_delimiter) { - return; - } - - if (organization == COB_ORG_LINE_SEQUENTIAL) { - is_compatible = current_file->organization == COB_ORG_SEQUENTIAL - || current_file->organization == COB_ORG_LINE_SEQUENTIAL; - } else { - is_compatible = current_file->organization == organization; - } - - if (!is_compatible) { - cb_error (_("ORGANIZATION %s is incompatible with RECORD DELIMITER"), - organization_name); - } -} - -static int -set_current_field (cb_tree level, cb_tree name) -{ - cb_tree x = cb_build_field_tree (level, name, current_field, - current_storage, current_file, 0); - /* Free tree associated with level number */ - cobc_parse_free (level); - - if (CB_INVALID_TREE (x)) { - return 1; - } else { - current_field = CB_FIELD (x); - check_pic_duplicate = 0; - } - - return 0; -} - -/* verifies that no conflicting clauses are used and inherits the definition of the original field */ -static void -inherit_same_as () -{ - /* note: REDEFINES (clause 1) is allowed with RM/COBOL but not COBOL 2002+ */ - static const cob_flags_t allowed_clauses = - SYN_CLAUSE_1 | SYN_CLAUSE_2 | SYN_CLAUSE_3 | SYN_CLAUSE_7; - cob_flags_t tested = check_pic_duplicate & ~(allowed_clauses); - if (tested != SYN_CLAUSE_30) { - cb_error_x (CB_TREE(current_field), _("illegal combination of %s with other clauses"), "SAME AS"); - current_field->flag_is_verified = 1; - current_field->flag_invalid = 1; - } else { - struct cb_field* fld = CB_FIELD (current_field->same_as); - current_field = copy_into_field (fld, current_field, 1); - } -} - -static void -check_not_both (const cob_flags_t flag1, const cob_flags_t flag2, - const char *flag1_name, const char *flag2_name, - const cob_flags_t flags, const cob_flags_t flag_to_set) -{ - if (flag_to_set == flag1 && (flags & flag2)) { - cb_error (_("cannot specify both %s and %s"), - flag1_name, flag2_name); - } else if (flag_to_set == flag2 && (flags & flag1)) { - cb_error (_("cannot specify both %s and %s"), - flag1_name, flag2_name); - - } -} - -static COB_INLINE COB_A_INLINE void -check_not_highlight_and_lowlight (const cob_flags_t flags, - const cob_flags_t flag_to_set) -{ - check_not_both (COB_SCREEN_HIGHLIGHT, COB_SCREEN_LOWLIGHT, - "HIGHLIGHT", "LOWLIGHT", flags, flag_to_set); -} - -static void -set_screen_attr (const char *clause, const cob_flags_t bitval) -{ - if (current_field->screen_flag & bitval) { - emit_duplicate_clause_message (clause); - } else { - current_field->screen_flag |= bitval; - } -} - -static void -emit_conflicting_clause_message (const char *clause, const char *conflicting) -{ - if (cb_relaxed_syntax_checks) { - cb_warning (COBC_WARN_FILLER, _("cannot specify both %s and %s; %s is ignored"), - clause, conflicting, clause); - } else { - cb_error (_("cannot specify both %s and %s"), - clause, conflicting); - } - -} - -static void -set_attr_with_conflict (const char *clause, const cob_flags_t bitval, - const char *confl_clause, const cob_flags_t confl_bit, - const int local_check_duplicate, cob_flags_t *flags) -{ - if (local_check_duplicate && (*flags & bitval)) { - emit_duplicate_clause_message (clause); - } else if (*flags & confl_bit) { - emit_conflicting_clause_message (clause, confl_clause); - } else { - *flags |= bitval; - } -} - -static COB_INLINE COB_A_INLINE void -set_screen_attr_with_conflict (const char *clause, const cob_flags_t bitval, - const char *confl_clause, - const cob_flags_t confl_bit) -{ - set_attr_with_conflict (clause, bitval, confl_clause, confl_bit, 1, - ¤t_field->screen_flag); -} - -static COB_INLINE COB_A_INLINE int -has_dispattr (const cob_flags_t attrib) -{ - return current_statement->attr_ptr - && current_statement->attr_ptr->dispattrs & attrib; -} - -static void -attach_attrib_to_cur_stmt (void) -{ - if (!current_statement->attr_ptr) { - current_statement->attr_ptr = - cobc_parse_malloc (sizeof(struct cb_attr_struct)); - } -} - -static COB_INLINE COB_A_INLINE void -set_dispattr (const cob_flags_t attrib) -{ - attach_attrib_to_cur_stmt (); - current_statement->attr_ptr->dispattrs |= attrib; -} - -static COB_INLINE COB_A_INLINE void -set_dispattr_with_conflict (const char *attrib_name, const cob_flags_t attrib, - const char *confl_name, - const cob_flags_t confl_attrib) -{ - attach_attrib_to_cur_stmt (); - set_attr_with_conflict (attrib_name, attrib, confl_name, confl_attrib, 0, - ¤t_statement->attr_ptr->dispattrs); -} - -static void -bit_set_attr (const cb_tree on_off, const cob_flags_t attr_val) -{ - if (on_off == cb_int1) { - set_attr_val_on |= attr_val; - } else { - set_attr_val_off |= attr_val; - } -} - -static void -set_field_attribs (cb_tree fgc, cb_tree bgc, cb_tree scroll, - cb_tree timeout, cb_tree prompt, cb_tree size_is) -{ - /* [WITH] FOREGROUND-COLOR [IS] */ - if (fgc) { - current_statement->attr_ptr->fgc = fgc; - } - /* [WITH] BACKGROUND-COLOR [IS] */ - if (bgc) { - current_statement->attr_ptr->bgc = bgc; - } - /* [WITH] SCROLL UP | DOWN */ - if (scroll) { - current_statement->attr_ptr->scroll = scroll; - } - /* [WITH] TIME-OUT [AFTER] */ - if (timeout) { - current_statement->attr_ptr->timeout = timeout; - } - /* [WITH] PROMPT CHARACTER [IS] */ - if (prompt) { - current_statement->attr_ptr->prompt = prompt; - } - /* [WITH] SIZE [IS] */ - if (size_is) { - current_statement->attr_ptr->size_is = size_is; - } -} - -static void -set_attribs (cb_tree fgc, cb_tree bgc, cb_tree scroll, - cb_tree timeout, cb_tree prompt, cb_tree size_is, - const cob_flags_t attrib) -{ - attach_attrib_to_cur_stmt (); - set_field_attribs (fgc, bgc, scroll, timeout, prompt, size_is); - - current_statement->attr_ptr->dispattrs |= attrib; -} - -static void -set_attribs_with_conflict (cb_tree fgc, cb_tree bgc, cb_tree scroll, - cb_tree timeout, cb_tree prompt, cb_tree size_is, - const char *clause_name, const cob_flags_t attrib, - const char *confl_name, const cob_flags_t confl_attrib) -{ - attach_attrib_to_cur_stmt (); - set_field_attribs (fgc, bgc, scroll, timeout, prompt, size_is); - - set_dispattr_with_conflict (clause_name, attrib, confl_name, - confl_attrib); -} - -static cob_flags_t -zero_conflicting_flag (const cob_flags_t screen_flag, cob_flags_t parent_flag, - const cob_flags_t flag1, const cob_flags_t flag2) -{ - if (screen_flag & flag1) { - parent_flag &= ~flag2; - } else if (screen_flag & flag2) { - parent_flag &= ~flag1; - } - - return parent_flag; -} - -static cob_flags_t -zero_conflicting_flags (const cob_flags_t screen_flag, cob_flags_t parent_flag) -{ - parent_flag = zero_conflicting_flag (screen_flag, parent_flag, - COB_SCREEN_BLANK_LINE, - COB_SCREEN_BLANK_SCREEN); - parent_flag = zero_conflicting_flag (screen_flag, parent_flag, - COB_SCREEN_ERASE_EOL, - COB_SCREEN_ERASE_EOS); - parent_flag = zero_conflicting_flag (screen_flag, parent_flag, - COB_SCREEN_HIGHLIGHT, - COB_SCREEN_LOWLIGHT); - - return parent_flag; -} - -static void -check_and_set_usage (const enum cb_usage usage) -{ - check_repeated ("USAGE", SYN_CLAUSE_5, &check_pic_duplicate); - current_field->usage = usage; - current_field->flag_usage_defined = 1; -} - -static void -check_preceding_tallying_phrases (const enum tallying_phrase phrase) -{ - switch (phrase) { - case FOR_PHRASE: - if (previous_tallying_phrase == ALL_LEADING_TRAILING_PHRASES) { - cb_error (_("FOR phrase cannot immediately follow ALL/LEADING/TRAILING")); - } else if (previous_tallying_phrase == FOR_PHRASE) { - cb_error (_("missing CHARACTERS/ALL/LEADING/TRAILING phrase after FOR phrase")); - } - break; - - case ALL_LEADING_TRAILING_PHRASES: - if (previous_tallying_phrase == CHARACTERS_PHRASE - || previous_tallying_phrase == ALL_LEADING_TRAILING_PHRASES) { - cb_error (_("missing value between ALL/LEADING/TRAILING words")); - } - /* fall through */ - case CHARACTERS_PHRASE: - if (previous_tallying_phrase == NO_PHRASE) { - cb_error (_("missing FOR phrase before CHARACTERS/ALL/LEADING/TRAILING phrase")); - } - break; - - case VALUE_REGION_PHRASE: - if (!(previous_tallying_phrase == ALL_LEADING_TRAILING_PHRASES - || previous_tallying_phrase == VALUE_REGION_PHRASE)) { - cb_error (_("missing ALL/LEADING/TRAILING before value")); - } - break; - - /* LCOV_EXCL_START */ - default: - /* This should never happen (and therefore doesn't get a translation) */ - cb_error ("unexpected tallying phrase"); - COBC_ABORT(); - /* LCOV_EXCL_STOP */ - } - - previous_tallying_phrase = phrase; -} - -static int -has_relative_pos (struct cb_field const *field) -{ - return !!(field->screen_flag - & (COB_SCREEN_LINE_PLUS | COB_SCREEN_LINE_MINUS - | COB_SCREEN_COLUMN_PLUS | COB_SCREEN_COLUMN_MINUS)); -} - -static int -is_recursive_call (cb_tree target) -{ - const char *target_name = ""; - - if (CB_LITERAL_P (target)) { - target_name = (const char *)(CB_LITERAL(target)->data); - } else if (CB_REFERENCE_P (target) - && CB_PROTOTYPE_P (cb_ref (target))) { - target_name = CB_PROTOTYPE (cb_ref (target))->ext_name; - } - - return !strcmp (target_name, current_program->orig_program_id); -} - -static cb_tree -check_not_88_level (cb_tree x) -{ - struct cb_field *f; - - if (x == cb_error_node) { - return cb_error_node; - } - if (!CB_REF_OR_FIELD_P(x)) { - return x; - } - - f = CB_FIELD_PTR (x); - - if (f->level == 88) { -#if 0 /* note: we may consider to support the extension (if existing) to - reference a condition-name target by the condition-name */ - if (cb_verify (cb_condition_references_data, _("use of condition-name in place of data-name"))) { - return CB_TREE (f->parent); - } -#else - cb_error (_("condition-name not allowed here: '%s'"), cb_name (x)); - /* invalidate field to prevent same error in typeck.c (validate_one) */ - /* FIXME: If we really need the additional check here then we missed - a call to cb_validate_one() somewhere */ - return cb_error_node; -#endif - } else { - return x; - } -} - -static int -is_screen_field (cb_tree x) -{ - if (CB_FIELD_P (x)) { - return (CB_FIELD (x))->storage == CB_STORAGE_SCREEN; - } else if (CB_REFERENCE_P (x)) { - return is_screen_field (cb_ref (x)); - } else { - return 0; - } -} - -static void -error_if_no_advancing_in_screen_display (cb_tree advancing) -{ - if (advancing != cb_int1) { - cb_error (_("cannot specify NO ADVANCING in screen DISPLAY")); - } -} - -static cb_tree -get_default_display_device (void) -{ - if (current_program->flag_console_is_crt - || cb_console_is_crt) { - return cb_null; - } else { - return cb_int0; - } -} - -static COB_INLINE COB_A_INLINE int -contains_one_screen_field (struct cb_list *x_list) -{ - return (cb_tree) x_list != cb_null - && cb_list_length ((cb_tree) x_list) == 1 - && is_screen_field (x_list->value); -} - -static int -contains_only_screen_fields (struct cb_list *x_list) -{ - if ((cb_tree) x_list == cb_null) { - return 0; - } - - for (; x_list; x_list = (struct cb_list *) x_list->chain) { - if (!is_screen_field (x_list->value)) { - return 0; - } - } - - return 1; -} - -static int -contains_fields_and_screens (struct cb_list *x_list) -{ - int field_seen = 0; - int screen_seen = 0; - - if ((cb_tree) x_list == cb_null) { - return 0; - } - - for (; x_list; x_list = (struct cb_list *) x_list->chain) { - if (is_screen_field (x_list->value)) { - screen_seen = 1; - } else { - field_seen = 1; - } - } - - return screen_seen && field_seen; -} - -static enum cb_display_type -deduce_display_type (cb_tree x_list, cb_tree local_upon_value, cb_tree local_line_column, - struct cb_attr_struct * const attr_ptr) -{ - int using_default_device_which_is_crt = - local_upon_value == NULL && get_default_display_device () == cb_null; - - /* TODO: Separate CGI DISPLAYs here */ - if (contains_only_screen_fields ((struct cb_list *) x_list)) { - if (!contains_one_screen_field ((struct cb_list *) x_list) - || attr_ptr) { - cb_verify_x (x_list, cb_accept_display_extensions, - _("non-standard DISPLAY")); - } - - if (local_upon_value != NULL && local_upon_value != cb_null) { - cb_error_x (x_list, _("screens may only be displayed on CRT")); - } - - return SCREEN_DISPLAY; - } else if (contains_fields_and_screens ((struct cb_list *) x_list)) { - cb_error_x (x_list, _("cannot mix screens and fields in the same DISPLAY statement")); - return MIXED_DISPLAY; - } else if (local_line_column || attr_ptr) { - if (local_upon_value != NULL && local_upon_value != cb_null) { - cb_error_x (x_list, _("screen clauses may only be used for DISPLAY on CRT")); - } - - cb_verify_x (x_list, cb_accept_display_extensions, - _("non-standard DISPLAY")); - - return FIELD_ON_SCREEN_DISPLAY; - } else if (local_upon_value == cb_null || using_default_device_which_is_crt) { - /* This is the only format permitted by the standard */ - return FIELD_ON_SCREEN_DISPLAY; - } else if (display_type == FIELD_ON_SCREEN_DISPLAY && local_upon_value == NULL) { - /* This is for when fields without clauses follow fields with screen clauses */ - return FIELD_ON_SCREEN_DISPLAY; - } else { - return DEVICE_DISPLAY; - } -} - -static void -set_display_type (cb_tree x_list, cb_tree local_upon_value, - cb_tree local_line_column, struct cb_attr_struct * const attr_ptr) -{ - display_type = deduce_display_type (x_list, local_upon_value, local_line_column, attr_ptr); -} - -static void -error_if_different_display_type (cb_tree x_list, cb_tree local_upon_value, - cb_tree local_line_column, struct cb_attr_struct * const attr_ptr) -{ - const enum cb_display_type type = - deduce_display_type (x_list, local_upon_value, local_line_column, attr_ptr); - - /* Avoid re-displaying the same error for mixed DISPLAYs */ - if (type == display_type || display_type == MIXED_DISPLAY) { - return; - } - - if (type != MIXED_DISPLAY) { - if (type == SCREEN_DISPLAY || display_type == SCREEN_DISPLAY) { - cb_error_x (x_list, _("cannot mix screens and fields in the same DISPLAY statement")); - } else { - /* - The only other option is that there is a mix of - FIELD_ON_SCREEN_DISPLAY and DEVICE_DISPLAY. - */ - cb_error_x (x_list, _("ambiguous DISPLAY; put items to display on device in separate DISPLAY")); - } - } - - display_type = MIXED_DISPLAY; -} - -static void -error_if_not_usage_display_or_nonnumeric_lit (cb_tree x) -{ - const int is_numeric_literal = CB_NUMERIC_LITERAL_P (x); - const int is_field_with_usage_not_display = - CB_REFERENCE_P (x) && CB_FIELD (cb_ref (x)) - && CB_FIELD (cb_ref (x))->usage != CB_USAGE_DISPLAY; - - if (is_numeric_literal) { - cb_error_x (x, _("%s is not an alphanumeric literal"), CB_LITERAL (x)->data); - } else if (is_field_with_usage_not_display) { - cb_error_x (x, _("'%s' is not USAGE DISPLAY"), cb_name (x)); - } -} - -static void -check_validate_item (cb_tree x) -{ - struct cb_field *f; - enum cb_class tree_class; - - if (CB_INVALID_TREE(x) || x->tag != CB_TAG_REFERENCE) { - return; - } - x = cb_ref (x); - if (CB_INVALID_TREE (x) || !CB_FIELD_P (x)) { - cb_error (_("invalid target for %s"), "VALIDATE"); - return; - } - - f = CB_FIELD (x); - tree_class = CB_TREE_CLASS(f); - if (is_screen_field(x)) { - cb_error (_("SCREEN item cannot be used here")); - } else if (f->level == 66) { - cb_error (_("RENAMES item may not be used here")); - } else if (f->flag_any_length) { - cb_error (_("ANY LENGTH item not allowed here")); - } else if (tree_class == CB_CLASS_INDEX - || tree_class == CB_CLASS_OBJECT - || tree_class == CB_CLASS_POINTER) { - cb_error (_("item '%s' has wrong class for VALIDATE"), cb_name (x)); - } -} - -static void -error_if_following_every_clause (void) -{ - if (ml_suppress_list - && CB_ML_SUPPRESS (CB_VALUE (ml_suppress_list))->target == CB_ML_SUPPRESS_TYPE) { - cb_error (_("WHEN clause must follow EVERY clause")); - } -} - -static void -prepend_to_ml_suppress_list (cb_tree suppress_entry) -{ - cb_tree new_list_head = CB_LIST_INIT (suppress_entry); - cb_list_append (new_list_head, ml_suppress_list); - ml_suppress_list = new_list_head; -} - -static void -add_identifier_to_ml_suppress_conds (cb_tree identifier) -{ - cb_tree suppress_id = cb_build_ml_suppress_clause (); - CB_ML_SUPPRESS (suppress_id)->target = CB_ML_SUPPRESS_IDENTIFIER; - CB_ML_SUPPRESS (suppress_id)->identifier = identifier; - prepend_to_ml_suppress_list (suppress_id); -} - -static void -add_when_to_ml_suppress_conds (cb_tree when_list) -{ - struct cb_ml_suppress_clause *last_suppress_clause; - cb_tree suppress_all; - - /* - If the preceding clause in SUPPRESS was an identifier, the WHEN - belongs to the identifier. If EVERY was preceding, the WHEN belongs to - the EVERY. Otherwise, the WHEN acts on the entire record. - */ - if (ml_suppress_list) { - last_suppress_clause = CB_ML_SUPPRESS (CB_VALUE (ml_suppress_list)); - if ((last_suppress_clause->target == CB_ML_SUPPRESS_IDENTIFIER - || last_suppress_clause->target == CB_ML_SUPPRESS_TYPE) - && !last_suppress_clause->when_list) { - last_suppress_clause->when_list = when_list; - return; - } - } - - suppress_all = cb_build_ml_suppress_clause (); - CB_ML_SUPPRESS (suppress_all)->when_list = when_list; - prepend_to_ml_suppress_list (suppress_all); -} - -static void -add_type_to_ml_suppress_conds (enum cb_ml_suppress_category category, - enum cb_ml_type ml_type) -{ - cb_tree suppress_type = cb_build_ml_suppress_clause (); - CB_ML_SUPPRESS (suppress_type)->target = CB_ML_SUPPRESS_TYPE; - CB_ML_SUPPRESS (suppress_type)->category = category; - CB_ML_SUPPRESS (suppress_type)->ml_type = ml_type; - prepend_to_ml_suppress_list (suppress_type); -} - -static void -set_record_size (cb_tree min, cb_tree max) -{ - int record_min, record_max; - - if (min) { - record_min = cb_get_int (min); - if (record_min < 0) { - /* already handled by integer check */ - } else { - current_file->record_min = record_min; - } - } else { - record_min = 0; - } - if (!max) return; - record_max = cb_get_int (max); - if (record_max < 0) { - /* already handled by integer check */ - return; - } else if (record_max == 0) { - /* Note: standard COBOL does not allow zero at all, use the related - configuration option */ - if (cb_records_mismatch_record_clause >= CB_ERROR) { - cb_error (_("non-zero value expected")); - } - return; - } - if (current_file->organization == COB_ORG_INDEXED - && record_max > MAX_FD_RECORD_IDX) { - cb_error (_("RECORD size (IDX) exceeds maximum allowed (%d)"), - MAX_FD_RECORD_IDX); - current_file->record_max = MAX_FD_RECORD_IDX; - } else if (record_max > MAX_FD_RECORD) { - cb_error (_("RECORD size exceeds maximum allowed (%d)"), - MAX_FD_RECORD); - current_file->record_max = MAX_FD_RECORD; - } else { - if (record_max <= record_min) { - cb_error (_("RECORD clause invalid")); - } - current_file->record_max = record_max; - } -} - - -#line 2157 "parser.c" /* yacc.c:339 */ - -# ifndef YY_NULLPTR -# if defined __cplusplus && 201103L <= __cplusplus -# define YY_NULLPTR nullptr -# else -# define YY_NULLPTR 0 -# endif -# endif - -/* Enabling verbose error messages. */ -#ifdef YYERROR_VERBOSE -# undef YYERROR_VERBOSE -# define YYERROR_VERBOSE 1 -#else -# define YYERROR_VERBOSE 1 -#endif - -/* In a future release of Bison, this section will be replaced - by #include "y.tab.h". */ -#ifndef YY_YY_PARSER_H_INCLUDED -# define YY_YY_PARSER_H_INCLUDED -/* Debug traces. */ -#ifndef YYDEBUG -# define YYDEBUG 0 -#endif -#if YYDEBUG -extern int yydebug; -#endif - -/* Token type. */ -#ifndef YYTOKENTYPE -# define YYTOKENTYPE - enum yytokentype - { - TOKEN_EOF = 0, - THREEDIMENSIONAL = 258, - ABSENT = 259, - ACCEPT = 260, - ACCESS = 261, - ACTIVEX = 262, - ACTION = 263, - ACTUAL = 264, - ADD = 265, - ADDRESS = 266, - ADJUSTABLE_COLUMNS = 267, - ADVANCING = 268, - AFTER = 269, - ALIGNMENT = 270, - ALL = 271, - ALLOCATE = 272, - ALLOWING = 273, - ALPHABET = 274, - ALPHABETIC = 275, - ALPHABETIC_LOWER = 276, - ALPHABETIC_UPPER = 277, - ALPHANUMERIC = 278, - ALPHANUMERIC_EDITED = 279, - ALSO = 280, - ALTER = 281, - ALTERNATE = 282, - AND = 283, - ANY = 284, - APPLY = 285, - ARE = 286, - AREA = 287, - AREAS = 288, - ARGUMENT_NUMBER = 289, - ARGUMENT_VALUE = 290, - ARITHMETIC = 291, - AS = 292, - ASCENDING = 293, - ASCII = 294, - ASSIGN = 295, - AT = 296, - ATTRIBUTE = 297, - ATTRIBUTES = 298, - AUTO = 299, - AUTO_DECIMAL = 300, - AUTO_SPIN = 301, - AUTOMATIC = 302, - AWAY_FROM_ZERO = 303, - BACKGROUND_COLOR = 304, - BACKGROUND_HIGH = 305, - BACKGROUND_LOW = 306, - BACKGROUND_STANDARD = 307, - BAR = 308, - BASED = 309, - BEFORE = 310, - BELL = 311, - BINARY = 312, - BINARY_C_LONG = 313, - BINARY_CHAR = 314, - BINARY_DOUBLE = 315, - BINARY_LONG = 316, - BINARY_SEQUENTIAL = 317, - BINARY_SHORT = 318, - BIT = 319, - BITMAP = 320, - BITMAP_END = 321, - BITMAP_HANDLE = 322, - BITMAP_NUMBER = 323, - BITMAP_START = 324, - BITMAP_TIMER = 325, - BITMAP_TRAILING = 326, - BITMAP_TRANSPARENT_COLOR = 327, - BITMAP_WIDTH = 328, - BLANK = 329, - BLINK = 330, - BLOCK = 331, - BOTTOM = 332, - BOX = 333, - BOXED = 334, - BULK_ADDITION = 335, - BUSY = 336, - BUTTONS = 337, - BY = 338, - BYTE_LENGTH = 339, - C = 340, - CALENDAR_FONT = 341, - CALL = 342, - CANCEL = 343, - CANCEL_BUTTON = 344, - CAPACITY = 345, - CARD_PUNCH = 346, - CARD_READER = 347, - CASSETTE = 348, - CCOL = 349, - CD = 350, - CELL = 351, - CELL_COLOR = 352, - CELL_DATA = 353, - CELL_FONT = 354, - CELL_PROTECTION = 355, - CENTER = 356, - CENTERED = 357, - CENTERED_HEADINGS = 358, - CENTURY_DATE = 359, - CF = 360, - CH = 361, - CHAINING = 362, - CHARACTER = 363, - CHARACTERS = 364, - CHECK_BOX = 365, - CLASS = 366, - CLASSIFICATION = 367, - CLASS_NAME = 368, - CLEAR_SELECTION = 369, - CLINE = 370, - CLINES = 371, - CLOSE = 372, - COBOL = 373, - CODE = 374, - CODE_SET = 375, - COLLATING = 376, - COL = 377, - COLOR = 378, - COLORS = 379, - COLS = 380, - COLUMN = 381, - COLUMN_COLOR = 382, - COLUMN_DIVIDERS = 383, - COLUMN_FONT = 384, - COLUMN_HEADINGS = 385, - COLUMN_PROTECTION = 386, - COLUMNS = 387, - COMBO_BOX = 388, - COMMA = 389, - COMMAND_LINE = 390, - COMMA_DELIM = 391, - COMMIT = 392, - COMMON = 393, - COMMUNICATION = 394, - COMP = 395, - COMPUTE = 396, - COMP_0 = 397, - COMP_1 = 398, - COMP_2 = 399, - COMP_3 = 400, - COMP_4 = 401, - COMP_5 = 402, - COMP_6 = 403, - COMP_N = 404, - COMP_X = 405, - CONCATENATE_FUNC = 406, - CONDITION = 407, - CONFIGURATION = 408, - CONSTANT = 409, - CONTAINS = 410, - CONTENT = 411, - CONTENT_LENGTH_FUNC = 412, - CONTENT_OF_FUNC = 413, - CONTINUE = 414, - CONTROL = 415, - CONTROLS = 416, - CONVERSION = 417, - CONVERTING = 418, - COPY = 419, - COPY_SELECTION = 420, - CORE_INDEX = 421, - CORRESPONDING = 422, - COUNT = 423, - CRT = 424, - CRT_UNDER = 425, - CSIZE = 426, - CURRENCY = 427, - CURRENT_DATE_FUNC = 428, - CURSOR = 429, - CURSOR_COL = 430, - CURSOR_COLOR = 431, - CURSOR_FRAME_WIDTH = 432, - CURSOR_ROW = 433, - CURSOR_X = 434, - CURSOR_Y = 435, - CUSTOM_PRINT_TEMPLATE = 436, - CYCLE = 437, - CYL_INDEX = 438, - CYL_OVERFLOW = 439, - DASHED = 440, - DATA = 441, - DATA_COLUMNS = 442, - DATA_TYPES = 443, - DATE = 444, - DATE_ENTRY = 445, - DAY = 446, - DAY_OF_WEEK = 447, - DE = 448, - DEBUGGING = 449, - DECIMAL_POINT = 450, - DECLARATIVES = 451, - DEFAULT = 452, - DEFAULT_BUTTON = 453, - DEFAULT_FONT = 454, - DELETE = 455, - DELIMITED = 456, - DELIMITER = 457, - DEPENDING = 458, - DESCENDING = 459, - DESTINATION = 460, - DESTROY = 461, - DETAIL = 462, - DISABLE = 463, - DISC = 464, - DISK = 465, - DISP = 466, - DISPLAY = 467, - DISPLAY_COLUMNS = 468, - DISPLAY_FORMAT = 469, - DISPLAY_OF_FUNC = 470, - DIVIDE = 471, - DIVIDERS = 472, - DIVIDER_COLOR = 473, - DIVISION = 474, - DOTDASH = 475, - DOTTED = 476, - DRAG_COLOR = 477, - DROP_DOWN = 478, - DROP_LIST = 479, - DOWN = 480, - DUPLICATES = 481, - DYNAMIC = 482, - EBCDIC = 483, - EC = 484, - ECHO = 485, - EGI = 486, - EIGHTY_EIGHT = 487, - ENABLE = 488, - ENABLED = 489, - ELEMENT = 490, - ELSE = 491, - EMI = 492, - ENCRYPTION = 493, - ENCODING = 494, - END = 495, - END_ACCEPT = 496, - END_ADD = 497, - END_CALL = 498, - END_COMPUTE = 499, - END_COLOR = 500, - END_DELETE = 501, - END_DISPLAY = 502, - END_DIVIDE = 503, - END_EVALUATE = 504, - END_FUNCTION = 505, - END_IF = 506, - END_JSON = 507, - END_MODIFY = 508, - END_MULTIPLY = 509, - END_PERFORM = 510, - END_PROGRAM = 511, - END_READ = 512, - END_RECEIVE = 513, - END_RETURN = 514, - END_REWRITE = 515, - END_SEARCH = 516, - END_START = 517, - END_STRING = 518, - END_SUBTRACT = 519, - END_UNSTRING = 520, - END_WRITE = 521, - END_XML = 522, - ENGRAVED = 523, - ENSURE_VISIBLE = 524, - ENTRY = 525, - ENTRY_CONVENTION = 526, - ENTRY_FIELD = 527, - ENTRY_REASON = 528, - ENVIRONMENT = 529, - ENVIRONMENT_NAME = 530, - ENVIRONMENT_VALUE = 531, - EOL = 532, - EOP = 533, - EOS = 534, - EQUAL = 535, - ERASE = 536, - ERROR = 537, - ESCAPE = 538, - ESCAPE_BUTTON = 539, - ESI = 540, - EVALUATE = 541, - EVENT = 542, - EVENT_LIST = 543, - EVENT_STATUS = 544, - EVERY = 545, - EXCEPTION = 546, - EXCEPTION_CONDITION = 547, - EXCEPTION_VALUE = 548, - EXPAND = 549, - EXCLUSIVE = 550, - EXIT = 551, - EXPONENTIATION = 552, - EXTEND = 553, - EXTENDED_SEARCH = 554, - EXTERNAL = 555, - EXTERNAL_FORM = 556, - F = 557, - FD = 558, - FH__FCD = 559, - FH__KEYDEF = 560, - FILE_CONTROL = 561, - FILE_ID = 562, - FILE_LIMIT = 563, - FILE_LIMITS = 564, - FILE_NAME = 565, - FILE_POS = 566, - FILL_COLOR = 567, - FILL_COLOR2 = 568, - FILL_PERCENT = 569, - FILLER = 570, - FINAL = 571, - FINISH_REASON = 572, - FIRST = 573, - FIXED = 574, - FIXED_FONT = 575, - FIXED_WIDTH = 576, - FLAT = 577, - FLAT_BUTTONS = 578, - FLOAT_BINARY_128 = 579, - FLOAT_BINARY_32 = 580, - FLOAT_BINARY_64 = 581, - FLOAT_DECIMAL_16 = 582, - FLOAT_DECIMAL_34 = 583, - FLOAT_DECIMAL_7 = 584, - FLOAT_EXTENDED = 585, - FLOAT_LONG = 586, - FLOAT_SHORT = 587, - FLOATING = 588, - FONT = 589, - FOOTING = 590, - FOR = 591, - FOREGROUND_COLOR = 592, - FOREVER = 593, - FORMATTED_DATE_FUNC = 594, - FORMATTED_DATETIME_FUNC = 595, - FORMATTED_TIME_FUNC = 596, - FRAME = 597, - FRAMED = 598, - FREE = 599, - FROM = 600, - FROM_CRT = 601, - FULL = 602, - FULL_HEIGHT = 603, - FUNCTION = 604, - FUNCTION_ID = 605, - FUNCTION_NAME = 606, - GENERATE = 607, - GIVING = 608, - GLOBAL = 609, - GO = 610, - GO_BACK = 611, - GO_FORWARD = 612, - GO_HOME = 613, - GO_SEARCH = 614, - GOBACK = 615, - GRAPHICAL = 616, - GREATER = 617, - GREATER_OR_EQUAL = 618, - GRID = 619, - GROUP = 620, - GROUP_VALUE = 621, - HANDLE = 622, - HAS_CHILDREN = 623, - HEADING = 624, - HEADING_COLOR = 625, - HEADING_DIVIDER_COLOR = 626, - HEADING_FONT = 627, - HEAVY = 628, - HEIGHT_IN_CELLS = 629, - HELP_ID = 630, - HIDDEN_DATA = 631, - HIGHLIGHT = 632, - HIGH_COLOR = 633, - HIGH_VALUE = 634, - HOT_TRACK = 635, - HSCROLL = 636, - HSCROLL_POS = 637, - ICON = 638, - ID = 639, - IDENTIFIED = 640, - IDENTIFICATION = 641, - IF = 642, - IGNORE = 643, - IGNORING = 644, - IN = 645, - INDEPENDENT = 646, - INDEX = 647, - INDEXED = 648, - INDICATE = 649, - INITIALIZE = 650, - INITIALIZED = 651, - INITIATE = 652, - INPUT = 653, - INPUT_OUTPUT = 654, - INQUIRE = 655, - INSERTION_INDEX = 656, - INSERT_ROWS = 657, - INSPECT = 658, - INTERMEDIATE = 659, - INTO = 660, - INTRINSIC = 661, - INVALID = 662, - INVALID_KEY = 663, - IS = 664, - ITEM = 665, - ITEM_TEXT = 666, - ITEM_TO_ADD = 667, - ITEM_TO_DELETE = 668, - ITEM_TO_EMPTY = 669, - ITEM_VALUE = 670, - I_O = 671, - I_O_CONTROL = 672, - JSON = 673, - JUSTIFIED = 674, - KEPT = 675, - KEY = 676, - KEYBOARD = 677, - LABEL = 678, - LABEL_OFFSET = 679, - LARGE_FONT = 680, - LARGE_OFFSET = 681, - LAST = 682, - LAST_ROW = 683, - LAYOUT_DATA = 684, - LAYOUT_MANAGER = 685, - LEADING = 686, - LEADING_SHIFT = 687, - LEAVE = 688, - LEFT = 689, - LEFTLINE = 690, - LEFT_TEXT = 691, - LENGTH = 692, - LENGTH_OF = 693, - LENGTH_FUNC = 694, - LESS = 695, - LESS_OR_EQUAL = 696, - LEVEL_NUMBER = 697, - LIMIT = 698, - LIMITS = 699, - LINAGE = 700, - LINAGE_COUNTER = 701, - LINE = 702, - LINE_COUNTER = 703, - LINE_LIMIT = 704, - LINE_SEQUENTIAL = 705, - LINES = 706, - LINES_AT_ROOT = 707, - LINKAGE = 708, - LIST_BOX = 709, - LITERAL = 710, - LM_RESIZE = 711, - LOC = 712, - LOCALE = 713, - LOCALE_DATE_FUNC = 714, - LOCALE_TIME_FUNC = 715, - LOCALE_TIME_FROM_FUNC = 716, - LOCAL_STORAGE = 717, - LOCK = 718, - LOCK_HOLDING = 719, - LONG_DATE = 720, - LOWER = 721, - LOWERED = 722, - LOWER_CASE_FUNC = 723, - LOWLIGHT = 724, - LOW_COLOR = 725, - LOW_VALUE = 726, - MAGNETIC_TAPE = 727, - MANUAL = 728, - MASS_UPDATE = 729, - MASTER_INDEX = 730, - MAX_LINES = 731, - MAX_PROGRESS = 732, - MAX_TEXT = 733, - MAX_VAL = 734, - MEMORY = 735, - MEDIUM_FONT = 736, - MENU = 737, - MERGE = 738, - MESSAGE = 739, - MINUS = 740, - MIN_VAL = 741, - MNEMONIC_NAME = 742, - MODE = 743, - MODIFY = 744, - MODULES = 745, - MOVE = 746, - MULTILINE = 747, - MULTIPLE = 748, - MULTIPLY = 749, - NAME = 750, - NAMESPACE = 751, - NAMESPACE_PREFIX = 752, - NATIONAL = 753, - NATIONAL_EDITED = 754, - NATIONAL_OF_FUNC = 755, - NATIVE = 756, - NAVIGATE_URL = 757, - NEAREST_AWAY_FROM_ZERO = 758, - NEAREST_EVEN = 759, - NEAREST_TOWARD_ZERO = 760, - NEGATIVE = 761, - NESTED = 762, - NEW = 763, - NEXT = 764, - NEXT_ITEM = 765, - NEXT_GROUP = 766, - NEXT_PAGE = 767, - NO = 768, - NO_ADVANCING = 769, - NO_AUTOSEL = 770, - NO_AUTO_DEFAULT = 771, - NO_BOX = 772, - NO_DATA = 773, - NO_DIVIDERS = 774, - NO_ECHO = 775, - NO_F4 = 776, - NO_FOCUS = 777, - NO_GROUP_TAB = 778, - NO_KEY_LETTER = 779, - NOMINAL = 780, - NO_SEARCH = 781, - NO_UPDOWN = 782, - NONNUMERIC = 783, - NORMAL = 784, - NOT = 785, - NOTAB = 786, - NOTHING = 787, - NOTIFY = 788, - NOTIFY_CHANGE = 789, - NOTIFY_DBLCLICK = 790, - NOTIFY_SELCHANGE = 791, - NOT_END = 792, - NOT_EOP = 793, - NOT_ESCAPE = 794, - NOT_EQUAL = 795, - NOT_EXCEPTION = 796, - NOT_INVALID_KEY = 797, - NOT_OVERFLOW = 798, - NOT_SIZE_ERROR = 799, - NUM_COL_HEADINGS = 800, - NUM_ROWS = 801, - NUMBER = 802, - NUMBERS = 803, - NUMERIC = 804, - NUMERIC_EDITED = 805, - NUMVALC_FUNC = 806, - OBJECT = 807, - OBJECT_COMPUTER = 808, - OCCURS = 809, - OF = 810, - OFF = 811, - OK_BUTTON = 812, - OMITTED = 813, - ON = 814, - ONLY = 815, - OPEN = 816, - OPTIONAL = 817, - OPTIONS = 818, - OR = 819, - ORDER = 820, - ORGANIZATION = 821, - OTHER = 822, - OTHERS = 823, - OUTPUT = 824, - OVERLAP_LEFT = 825, - OVERLAP_TOP = 826, - OVERLINE = 827, - PACKED_DECIMAL = 828, - PADDING = 829, - PASCAL = 830, - PAGE = 831, - PAGE_COUNTER = 832, - PAGE_SETUP = 833, - PAGED = 834, - PARAGRAPH = 835, - PARENT = 836, - PARSE = 837, - PASSWORD = 838, - PERFORM = 839, - PERMANENT = 840, - PH = 841, - PF = 842, - PHYSICAL = 843, - PICTURE = 844, - PICTURE_SYMBOL = 845, - PIXEL = 846, - PLACEMENT = 847, - PLUS = 848, - POINTER = 849, - POP_UP = 850, - POS = 851, - POSITION = 852, - POSITION_SHIFT = 853, - POSITIVE = 854, - PRESENT = 855, - PREVIOUS = 856, - PRINT = 857, - PRINT_CONTROL = 858, - PRINT_NO_PROMPT = 859, - PRINT_PREVIEW = 860, - PRINTER = 861, - PRINTER_1 = 862, - PRINTING = 863, - PRIORITY = 864, - PROCEDURE = 865, - PROCEDURES = 866, - PROCEED = 867, - PROCESSING = 868, - PROGRAM = 869, - PROGRAM_ID = 870, - PROGRAM_NAME = 871, - PROGRAM_POINTER = 872, - PROGRESS = 873, - PROHIBITED = 874, - PROMPT = 875, - PROPERTIES = 876, - PROPERTY = 877, - PROTECTED = 878, - PROTOTYPE = 879, - PURGE = 880, - PUSH_BUTTON = 881, - QUERY_INDEX = 882, - QUEUE = 883, - QUOTE = 884, - RADIO_BUTTON = 885, - RAISE = 886, - RAISED = 887, - RANDOM = 888, - RD = 889, - READ = 890, - READERS = 891, - READ_ONLY = 892, - READY_TRACE = 893, - RECEIVE = 894, - RECORD = 895, - RECORD_DATA = 896, - RECORD_OVERFLOW = 897, - RECORD_TO_ADD = 898, - RECORD_TO_DELETE = 899, - RECORDING = 900, - RECORDS = 901, - RECURSIVE = 902, - REDEFINES = 903, - REEL = 904, - REFERENCE = 905, - REFERENCES = 906, - REFRESH = 907, - REGION_COLOR = 908, - RELATIVE = 909, - RELEASE = 910, - REMAINDER = 911, - REMOVAL = 912, - RENAMES = 913, - REORG_CRITERIA = 914, - REPLACE = 915, - REPLACING = 916, - REPORT = 917, - REPORTING = 918, - REPORTS = 919, - REPOSITORY = 920, - REQUIRED = 921, - REREAD = 922, - RERUN = 923, - RESERVE = 924, - RESET = 925, - RESET_TRACE = 926, - RESET_GRID = 927, - RESET_LIST = 928, - RESET_TABS = 929, - RESIDENT = 930, - RETRY = 931, - RETURN = 932, - RETURNING = 933, - REVERSE = 934, - REVERSE_FUNC = 935, - REVERSE_VIDEO = 936, - REVERSED = 937, - REWIND = 938, - REWRITE = 939, - RF = 940, - RH = 941, - RIGHT = 942, - RIGHT_ALIGN = 943, - RIMMED = 944, - ROLLBACK = 945, - ROUNDED = 946, - ROUNDING = 947, - ROW_COLOR = 948, - ROW_COLOR_PATTERN = 949, - ROW_DIVIDERS = 950, - ROW_FONT = 951, - ROW_HEADINGS = 952, - ROW_PROTECTION = 953, - RUN = 954, - S = 955, - SAME = 956, - SAVE_AS = 957, - SAVE_AS_NO_PROMPT = 958, - SCREEN = 959, - SCREEN_CONTROL = 960, - SCROLL = 961, - SCROLL_BAR = 962, - SD = 963, - SEARCH = 964, - SEARCH_OPTIONS = 965, - SEARCH_TEXT = 966, - SECONDS = 967, - SECTION = 968, - SECURE = 969, - SEGMENT = 970, - SEGMENT_LIMIT = 971, - SELECT = 972, - SELECTION_INDEX = 973, - SELECTION_TEXT = 974, - SELECT_ALL = 975, - SELF_ACT = 976, - SEMI_COLON = 977, - SEND = 978, - SENTENCE = 979, - SEPARATE = 980, - SEPARATION = 981, - SEQUENCE = 982, - SEQUENTIAL = 983, - SET = 984, - SEVENTY_EIGHT = 985, - SHADING = 986, - SHADOW = 987, - SHARING = 988, - SHORT_DATE = 989, - SHOW_LINES = 990, - SHOW_NONE = 991, - SHOW_SEL_ALWAYS = 992, - SIGN = 993, - SIGNED = 994, - SIGNED_INT = 995, - SIGNED_LONG = 996, - SIGNED_SHORT = 997, - SIXTY_SIX = 998, - SIZE = 999, - SIZE_ERROR = 1000, - SMALL_FONT = 1001, - SORT = 1002, - SORT_MERGE = 1003, - SORT_ORDER = 1004, - SOURCE = 1005, - SOURCE_COMPUTER = 1006, - SPACE = 1007, - SPECIAL_NAMES = 1008, - SPINNER = 1009, - SQUARE = 1010, - STANDARD = 1011, - STANDARD_1 = 1012, - STANDARD_2 = 1013, - STANDARD_BINARY = 1014, - STANDARD_DECIMAL = 1015, - START = 1016, - START_X = 1017, - START_Y = 1018, - STATIC = 1019, - STATIC_LIST = 1020, - STATUS = 1021, - STATUS_BAR = 1022, - STATUS_TEXT = 1023, - STDCALL = 1024, - STEP = 1025, - STOP = 1026, - STRING = 1027, - STYLE = 1028, - SUB_QUEUE_1 = 1029, - SUB_QUEUE_2 = 1030, - SUB_QUEUE_3 = 1031, - SUBSTITUTE_FUNC = 1032, - SUBSTITUTE_CASE_FUNC = 1033, - SUBTRACT = 1034, - SUBWINDOW = 1035, - SUM = 1036, - SUPPRESS = 1037, - SUPPRESS_XML = 1038, - SYMBOLIC = 1039, - SYNCHRONIZED = 1040, - SYSTEM_DEFAULT = 1041, - SYSTEM_INFO = 1042, - SYSTEM_OFFSET = 1043, - TAB = 1044, - TAB_TO_ADD = 1045, - TAB_TO_DELETE = 1046, - TABLE = 1047, - TALLYING = 1048, - TEMPORARY = 1049, - TAPE = 1050, - TERMINAL = 1051, - TERMINATE = 1052, - TERMINAL_INFO = 1053, - TERMINATION_VALUE = 1054, - TEST = 1055, - TEXT = 1056, - THAN = 1057, - THEN = 1058, - THREAD = 1059, - THREADS = 1060, - THRU = 1061, - THUMB_POSITION = 1062, - TILED_HEADINGS = 1063, - TIME = 1064, - TIME_OUT = 1065, - TIMES = 1066, - TITLE = 1067, - TITLE_POSITION = 1068, - TO = 1069, - TOK_AMPER = 1070, - TOK_CLOSE_PAREN = 1071, - TOK_COLON = 1072, - TOK_DIV = 1073, - TOK_DOT = 1074, - TOK_EQUAL = 1075, - TOK_EXTERN = 1076, - TOK_FALSE = 1077, - TOK_FILE = 1078, - TOK_GREATER = 1079, - TOK_INITIAL = 1080, - TOK_LESS = 1081, - TOK_MINUS = 1082, - TOK_MUL = 1083, - TOK_NULL = 1084, - TOK_OVERFLOW = 1085, - TOK_OPEN_PAREN = 1086, - TOK_PLUS = 1087, - TOK_TRUE = 1088, - TOP = 1089, - TOWARD_GREATER = 1090, - TOWARD_LESSER = 1091, - TRACK = 1092, - TRACKS = 1093, - TRACK_AREA = 1094, - TRACK_LIMIT = 1095, - TRADITIONAL_FONT = 1096, - TRAILING = 1097, - TRAILING_SHIFT = 1098, - TRANSACTION = 1099, - TRANSFORM = 1100, - TRANSPARENT = 1101, - TREE_VIEW = 1102, - TRIM_FUNC = 1103, - TRUNCATION = 1104, - TYPE = 1105, - U = 1106, - UCS_4 = 1107, - UNBOUNDED = 1108, - UNDERLINE = 1109, - UNFRAMED = 1110, - UNIT = 1111, - UNLOCK = 1112, - UNSIGNED = 1113, - UNSIGNED_INT = 1114, - UNSIGNED_LONG = 1115, - UNSIGNED_SHORT = 1116, - UNSORTED = 1117, - UNSTRING = 1118, - UNTIL = 1119, - UP = 1120, - UPDATE = 1121, - UPDATERS = 1122, - UPON = 1123, - UPON_ARGUMENT_NUMBER = 1124, - UPON_COMMAND_LINE = 1125, - UPON_ENVIRONMENT_NAME = 1126, - UPON_ENVIRONMENT_VALUE = 1127, - UPPER = 1128, - UPPER_CASE_FUNC = 1129, - USAGE = 1130, - USE = 1131, - USE_ALT = 1132, - USE_RETURN = 1133, - USE_TAB = 1134, - USER = 1135, - USER_DEFAULT = 1136, - USER_FUNCTION_NAME = 1137, - USING = 1138, - UTF_8 = 1139, - UTF_16 = 1140, - V = 1141, - VALIDATE = 1142, - VALIDATING = 1143, - VALUE = 1144, - VALUE_FORMAT = 1145, - VARIABLE = 1146, - VARIANT = 1147, - VARYING = 1148, - VERTICAL = 1149, - VERY_HEAVY = 1150, - VIRTUAL_WIDTH = 1151, - VISIBLE = 1152, - VOLATILE = 1153, - VPADDING = 1154, - VSCROLL = 1155, - VSCROLL_BAR = 1156, - VSCROLL_POS = 1157, - VTOP = 1158, - WAIT = 1159, - WEB_BROWSER = 1160, - WHEN = 1161, - WHEN_COMPILED_FUNC = 1162, - WHEN_XML = 1163, - WIDTH = 1164, - WIDTH_IN_CELLS = 1165, - WINDOW = 1166, - WITH = 1167, - WORD = 1168, - WORDS = 1169, - WORKING_STORAGE = 1170, - WRAP = 1171, - WRITE = 1172, - WRITE_ONLY = 1173, - WRITE_VERIFY = 1174, - WRITERS = 1175, - X = 1176, - XML = 1177, - XML_DECLARATION = 1178, - Y = 1179, - YYYYDDD = 1180, - YYYYMMDD = 1181, - ZERO = 1182, - SHIFT_PREFER = 1183 - }; -#endif -/* Tokens. */ -#define TOKEN_EOF 0 -#define THREEDIMENSIONAL 258 -#define ABSENT 259 -#define ACCEPT 260 -#define ACCESS 261 -#define ACTIVEX 262 -#define ACTION 263 -#define ACTUAL 264 -#define ADD 265 -#define ADDRESS 266 -#define ADJUSTABLE_COLUMNS 267 -#define ADVANCING 268 -#define AFTER 269 -#define ALIGNMENT 270 -#define ALL 271 -#define ALLOCATE 272 -#define ALLOWING 273 -#define ALPHABET 274 -#define ALPHABETIC 275 -#define ALPHABETIC_LOWER 276 -#define ALPHABETIC_UPPER 277 -#define ALPHANUMERIC 278 -#define ALPHANUMERIC_EDITED 279 -#define ALSO 280 -#define ALTER 281 -#define ALTERNATE 282 -#define AND 283 -#define ANY 284 -#define APPLY 285 -#define ARE 286 -#define AREA 287 -#define AREAS 288 -#define ARGUMENT_NUMBER 289 -#define ARGUMENT_VALUE 290 -#define ARITHMETIC 291 -#define AS 292 -#define ASCENDING 293 -#define ASCII 294 -#define ASSIGN 295 -#define AT 296 -#define ATTRIBUTE 297 -#define ATTRIBUTES 298 -#define AUTO 299 -#define AUTO_DECIMAL 300 -#define AUTO_SPIN 301 -#define AUTOMATIC 302 -#define AWAY_FROM_ZERO 303 -#define BACKGROUND_COLOR 304 -#define BACKGROUND_HIGH 305 -#define BACKGROUND_LOW 306 -#define BACKGROUND_STANDARD 307 -#define BAR 308 -#define BASED 309 -#define BEFORE 310 -#define BELL 311 -#define BINARY 312 -#define BINARY_C_LONG 313 -#define BINARY_CHAR 314 -#define BINARY_DOUBLE 315 -#define BINARY_LONG 316 -#define BINARY_SEQUENTIAL 317 -#define BINARY_SHORT 318 -#define BIT 319 -#define BITMAP 320 -#define BITMAP_END 321 -#define BITMAP_HANDLE 322 -#define BITMAP_NUMBER 323 -#define BITMAP_START 324 -#define BITMAP_TIMER 325 -#define BITMAP_TRAILING 326 -#define BITMAP_TRANSPARENT_COLOR 327 -#define BITMAP_WIDTH 328 -#define BLANK 329 -#define BLINK 330 -#define BLOCK 331 -#define BOTTOM 332 -#define BOX 333 -#define BOXED 334 -#define BULK_ADDITION 335 -#define BUSY 336 -#define BUTTONS 337 -#define BY 338 -#define BYTE_LENGTH 339 -#define C 340 -#define CALENDAR_FONT 341 -#define CALL 342 -#define CANCEL 343 -#define CANCEL_BUTTON 344 -#define CAPACITY 345 -#define CARD_PUNCH 346 -#define CARD_READER 347 -#define CASSETTE 348 -#define CCOL 349 -#define CD 350 -#define CELL 351 -#define CELL_COLOR 352 -#define CELL_DATA 353 -#define CELL_FONT 354 -#define CELL_PROTECTION 355 -#define CENTER 356 -#define CENTERED 357 -#define CENTERED_HEADINGS 358 -#define CENTURY_DATE 359 -#define CF 360 -#define CH 361 -#define CHAINING 362 -#define CHARACTER 363 -#define CHARACTERS 364 -#define CHECK_BOX 365 -#define CLASS 366 -#define CLASSIFICATION 367 -#define CLASS_NAME 368 -#define CLEAR_SELECTION 369 -#define CLINE 370 -#define CLINES 371 -#define CLOSE 372 -#define COBOL 373 -#define CODE 374 -#define CODE_SET 375 -#define COLLATING 376 -#define COL 377 -#define COLOR 378 -#define COLORS 379 -#define COLS 380 -#define COLUMN 381 -#define COLUMN_COLOR 382 -#define COLUMN_DIVIDERS 383 -#define COLUMN_FONT 384 -#define COLUMN_HEADINGS 385 -#define COLUMN_PROTECTION 386 -#define COLUMNS 387 -#define COMBO_BOX 388 -#define COMMA 389 -#define COMMAND_LINE 390 -#define COMMA_DELIM 391 -#define COMMIT 392 -#define COMMON 393 -#define COMMUNICATION 394 -#define COMP 395 -#define COMPUTE 396 -#define COMP_0 397 -#define COMP_1 398 -#define COMP_2 399 -#define COMP_3 400 -#define COMP_4 401 -#define COMP_5 402 -#define COMP_6 403 -#define COMP_N 404 -#define COMP_X 405 -#define CONCATENATE_FUNC 406 -#define CONDITION 407 -#define CONFIGURATION 408 -#define CONSTANT 409 -#define CONTAINS 410 -#define CONTENT 411 -#define CONTENT_LENGTH_FUNC 412 -#define CONTENT_OF_FUNC 413 -#define CONTINUE 414 -#define CONTROL 415 -#define CONTROLS 416 -#define CONVERSION 417 -#define CONVERTING 418 -#define COPY 419 -#define COPY_SELECTION 420 -#define CORE_INDEX 421 -#define CORRESPONDING 422 -#define COUNT 423 -#define CRT 424 -#define CRT_UNDER 425 -#define CSIZE 426 -#define CURRENCY 427 -#define CURRENT_DATE_FUNC 428 -#define CURSOR 429 -#define CURSOR_COL 430 -#define CURSOR_COLOR 431 -#define CURSOR_FRAME_WIDTH 432 -#define CURSOR_ROW 433 -#define CURSOR_X 434 -#define CURSOR_Y 435 -#define CUSTOM_PRINT_TEMPLATE 436 -#define CYCLE 437 -#define CYL_INDEX 438 -#define CYL_OVERFLOW 439 -#define DASHED 440 -#define DATA 441 -#define DATA_COLUMNS 442 -#define DATA_TYPES 443 -#define DATE 444 -#define DATE_ENTRY 445 -#define DAY 446 -#define DAY_OF_WEEK 447 -#define DE 448 -#define DEBUGGING 449 -#define DECIMAL_POINT 450 -#define DECLARATIVES 451 -#define DEFAULT 452 -#define DEFAULT_BUTTON 453 -#define DEFAULT_FONT 454 -#define DELETE 455 -#define DELIMITED 456 -#define DELIMITER 457 -#define DEPENDING 458 -#define DESCENDING 459 -#define DESTINATION 460 -#define DESTROY 461 -#define DETAIL 462 -#define DISABLE 463 -#define DISC 464 -#define DISK 465 -#define DISP 466 -#define DISPLAY 467 -#define DISPLAY_COLUMNS 468 -#define DISPLAY_FORMAT 469 -#define DISPLAY_OF_FUNC 470 -#define DIVIDE 471 -#define DIVIDERS 472 -#define DIVIDER_COLOR 473 -#define DIVISION 474 -#define DOTDASH 475 -#define DOTTED 476 -#define DRAG_COLOR 477 -#define DROP_DOWN 478 -#define DROP_LIST 479 -#define DOWN 480 -#define DUPLICATES 481 -#define DYNAMIC 482 -#define EBCDIC 483 -#define EC 484 -#define ECHO 485 -#define EGI 486 -#define EIGHTY_EIGHT 487 -#define ENABLE 488 -#define ENABLED 489 -#define ELEMENT 490 -#define ELSE 491 -#define EMI 492 -#define ENCRYPTION 493 -#define ENCODING 494 -#define END 495 -#define END_ACCEPT 496 -#define END_ADD 497 -#define END_CALL 498 -#define END_COMPUTE 499 -#define END_COLOR 500 -#define END_DELETE 501 -#define END_DISPLAY 502 -#define END_DIVIDE 503 -#define END_EVALUATE 504 -#define END_FUNCTION 505 -#define END_IF 506 -#define END_JSON 507 -#define END_MODIFY 508 -#define END_MULTIPLY 509 -#define END_PERFORM 510 -#define END_PROGRAM 511 -#define END_READ 512 -#define END_RECEIVE 513 -#define END_RETURN 514 -#define END_REWRITE 515 -#define END_SEARCH 516 -#define END_START 517 -#define END_STRING 518 -#define END_SUBTRACT 519 -#define END_UNSTRING 520 -#define END_WRITE 521 -#define END_XML 522 -#define ENGRAVED 523 -#define ENSURE_VISIBLE 524 -#define ENTRY 525 -#define ENTRY_CONVENTION 526 -#define ENTRY_FIELD 527 -#define ENTRY_REASON 528 -#define ENVIRONMENT 529 -#define ENVIRONMENT_NAME 530 -#define ENVIRONMENT_VALUE 531 -#define EOL 532 -#define EOP 533 -#define EOS 534 -#define EQUAL 535 -#define ERASE 536 -#define ERROR 537 -#define ESCAPE 538 -#define ESCAPE_BUTTON 539 -#define ESI 540 -#define EVALUATE 541 -#define EVENT 542 -#define EVENT_LIST 543 -#define EVENT_STATUS 544 -#define EVERY 545 -#define EXCEPTION 546 -#define EXCEPTION_CONDITION 547 -#define EXCEPTION_VALUE 548 -#define EXPAND 549 -#define EXCLUSIVE 550 -#define EXIT 551 -#define EXPONENTIATION 552 -#define EXTEND 553 -#define EXTENDED_SEARCH 554 -#define EXTERNAL 555 -#define EXTERNAL_FORM 556 -#define F 557 -#define FD 558 -#define FH__FCD 559 -#define FH__KEYDEF 560 -#define FILE_CONTROL 561 -#define FILE_ID 562 -#define FILE_LIMIT 563 -#define FILE_LIMITS 564 -#define FILE_NAME 565 -#define FILE_POS 566 -#define FILL_COLOR 567 -#define FILL_COLOR2 568 -#define FILL_PERCENT 569 -#define FILLER 570 -#define FINAL 571 -#define FINISH_REASON 572 -#define FIRST 573 -#define FIXED 574 -#define FIXED_FONT 575 -#define FIXED_WIDTH 576 -#define FLAT 577 -#define FLAT_BUTTONS 578 -#define FLOAT_BINARY_128 579 -#define FLOAT_BINARY_32 580 -#define FLOAT_BINARY_64 581 -#define FLOAT_DECIMAL_16 582 -#define FLOAT_DECIMAL_34 583 -#define FLOAT_DECIMAL_7 584 -#define FLOAT_EXTENDED 585 -#define FLOAT_LONG 586 -#define FLOAT_SHORT 587 -#define FLOATING 588 -#define FONT 589 -#define FOOTING 590 -#define FOR 591 -#define FOREGROUND_COLOR 592 -#define FOREVER 593 -#define FORMATTED_DATE_FUNC 594 -#define FORMATTED_DATETIME_FUNC 595 -#define FORMATTED_TIME_FUNC 596 -#define FRAME 597 -#define FRAMED 598 -#define FREE 599 -#define FROM 600 -#define FROM_CRT 601 -#define FULL 602 -#define FULL_HEIGHT 603 -#define FUNCTION 604 -#define FUNCTION_ID 605 -#define FUNCTION_NAME 606 -#define GENERATE 607 -#define GIVING 608 -#define GLOBAL 609 -#define GO 610 -#define GO_BACK 611 -#define GO_FORWARD 612 -#define GO_HOME 613 -#define GO_SEARCH 614 -#define GOBACK 615 -#define GRAPHICAL 616 -#define GREATER 617 -#define GREATER_OR_EQUAL 618 -#define GRID 619 -#define GROUP 620 -#define GROUP_VALUE 621 -#define HANDLE 622 -#define HAS_CHILDREN 623 -#define HEADING 624 -#define HEADING_COLOR 625 -#define HEADING_DIVIDER_COLOR 626 -#define HEADING_FONT 627 -#define HEAVY 628 -#define HEIGHT_IN_CELLS 629 -#define HELP_ID 630 -#define HIDDEN_DATA 631 -#define HIGHLIGHT 632 -#define HIGH_COLOR 633 -#define HIGH_VALUE 634 -#define HOT_TRACK 635 -#define HSCROLL 636 -#define HSCROLL_POS 637 -#define ICON 638 -#define ID 639 -#define IDENTIFIED 640 -#define IDENTIFICATION 641 -#define IF 642 -#define IGNORE 643 -#define IGNORING 644 -#define IN 645 -#define INDEPENDENT 646 -#define INDEX 647 -#define INDEXED 648 -#define INDICATE 649 -#define INITIALIZE 650 -#define INITIALIZED 651 -#define INITIATE 652 -#define INPUT 653 -#define INPUT_OUTPUT 654 -#define INQUIRE 655 -#define INSERTION_INDEX 656 -#define INSERT_ROWS 657 -#define INSPECT 658 -#define INTERMEDIATE 659 -#define INTO 660 -#define INTRINSIC 661 -#define INVALID 662 -#define INVALID_KEY 663 -#define IS 664 -#define ITEM 665 -#define ITEM_TEXT 666 -#define ITEM_TO_ADD 667 -#define ITEM_TO_DELETE 668 -#define ITEM_TO_EMPTY 669 -#define ITEM_VALUE 670 -#define I_O 671 -#define I_O_CONTROL 672 -#define JSON 673 -#define JUSTIFIED 674 -#define KEPT 675 -#define KEY 676 -#define KEYBOARD 677 -#define LABEL 678 -#define LABEL_OFFSET 679 -#define LARGE_FONT 680 -#define LARGE_OFFSET 681 -#define LAST 682 -#define LAST_ROW 683 -#define LAYOUT_DATA 684 -#define LAYOUT_MANAGER 685 -#define LEADING 686 -#define LEADING_SHIFT 687 -#define LEAVE 688 -#define LEFT 689 -#define LEFTLINE 690 -#define LEFT_TEXT 691 -#define LENGTH 692 -#define LENGTH_OF 693 -#define LENGTH_FUNC 694 -#define LESS 695 -#define LESS_OR_EQUAL 696 -#define LEVEL_NUMBER 697 -#define LIMIT 698 -#define LIMITS 699 -#define LINAGE 700 -#define LINAGE_COUNTER 701 -#define LINE 702 -#define LINE_COUNTER 703 -#define LINE_LIMIT 704 -#define LINE_SEQUENTIAL 705 -#define LINES 706 -#define LINES_AT_ROOT 707 -#define LINKAGE 708 -#define LIST_BOX 709 -#define LITERAL 710 -#define LM_RESIZE 711 -#define LOC 712 -#define LOCALE 713 -#define LOCALE_DATE_FUNC 714 -#define LOCALE_TIME_FUNC 715 -#define LOCALE_TIME_FROM_FUNC 716 -#define LOCAL_STORAGE 717 -#define LOCK 718 -#define LOCK_HOLDING 719 -#define LONG_DATE 720 -#define LOWER 721 -#define LOWERED 722 -#define LOWER_CASE_FUNC 723 -#define LOWLIGHT 724 -#define LOW_COLOR 725 -#define LOW_VALUE 726 -#define MAGNETIC_TAPE 727 -#define MANUAL 728 -#define MASS_UPDATE 729 -#define MASTER_INDEX 730 -#define MAX_LINES 731 -#define MAX_PROGRESS 732 -#define MAX_TEXT 733 -#define MAX_VAL 734 -#define MEMORY 735 -#define MEDIUM_FONT 736 -#define MENU 737 -#define MERGE 738 -#define MESSAGE 739 -#define MINUS 740 -#define MIN_VAL 741 -#define MNEMONIC_NAME 742 -#define MODE 743 -#define MODIFY 744 -#define MODULES 745 -#define MOVE 746 -#define MULTILINE 747 -#define MULTIPLE 748 -#define MULTIPLY 749 -#define NAME 750 -#define NAMESPACE 751 -#define NAMESPACE_PREFIX 752 -#define NATIONAL 753 -#define NATIONAL_EDITED 754 -#define NATIONAL_OF_FUNC 755 -#define NATIVE 756 -#define NAVIGATE_URL 757 -#define NEAREST_AWAY_FROM_ZERO 758 -#define NEAREST_EVEN 759 -#define NEAREST_TOWARD_ZERO 760 -#define NEGATIVE 761 -#define NESTED 762 -#define NEW 763 -#define NEXT 764 -#define NEXT_ITEM 765 -#define NEXT_GROUP 766 -#define NEXT_PAGE 767 -#define NO 768 -#define NO_ADVANCING 769 -#define NO_AUTOSEL 770 -#define NO_AUTO_DEFAULT 771 -#define NO_BOX 772 -#define NO_DATA 773 -#define NO_DIVIDERS 774 -#define NO_ECHO 775 -#define NO_F4 776 -#define NO_FOCUS 777 -#define NO_GROUP_TAB 778 -#define NO_KEY_LETTER 779 -#define NOMINAL 780 -#define NO_SEARCH 781 -#define NO_UPDOWN 782 -#define NONNUMERIC 783 -#define NORMAL 784 -#define NOT 785 -#define NOTAB 786 -#define NOTHING 787 -#define NOTIFY 788 -#define NOTIFY_CHANGE 789 -#define NOTIFY_DBLCLICK 790 -#define NOTIFY_SELCHANGE 791 -#define NOT_END 792 -#define NOT_EOP 793 -#define NOT_ESCAPE 794 -#define NOT_EQUAL 795 -#define NOT_EXCEPTION 796 -#define NOT_INVALID_KEY 797 -#define NOT_OVERFLOW 798 -#define NOT_SIZE_ERROR 799 -#define NUM_COL_HEADINGS 800 -#define NUM_ROWS 801 -#define NUMBER 802 -#define NUMBERS 803 -#define NUMERIC 804 -#define NUMERIC_EDITED 805 -#define NUMVALC_FUNC 806 -#define OBJECT 807 -#define OBJECT_COMPUTER 808 -#define OCCURS 809 -#define OF 810 -#define OFF 811 -#define OK_BUTTON 812 -#define OMITTED 813 -#define ON 814 -#define ONLY 815 -#define OPEN 816 -#define OPTIONAL 817 -#define OPTIONS 818 -#define OR 819 -#define ORDER 820 -#define ORGANIZATION 821 -#define OTHER 822 -#define OTHERS 823 -#define OUTPUT 824 -#define OVERLAP_LEFT 825 -#define OVERLAP_TOP 826 -#define OVERLINE 827 -#define PACKED_DECIMAL 828 -#define PADDING 829 -#define PASCAL 830 -#define PAGE 831 -#define PAGE_COUNTER 832 -#define PAGE_SETUP 833 -#define PAGED 834 -#define PARAGRAPH 835 -#define PARENT 836 -#define PARSE 837 -#define PASSWORD 838 -#define PERFORM 839 -#define PERMANENT 840 -#define PH 841 -#define PF 842 -#define PHYSICAL 843 -#define PICTURE 844 -#define PICTURE_SYMBOL 845 -#define PIXEL 846 -#define PLACEMENT 847 -#define PLUS 848 -#define POINTER 849 -#define POP_UP 850 -#define POS 851 -#define POSITION 852 -#define POSITION_SHIFT 853 -#define POSITIVE 854 -#define PRESENT 855 -#define PREVIOUS 856 -#define PRINT 857 -#define PRINT_CONTROL 858 -#define PRINT_NO_PROMPT 859 -#define PRINT_PREVIEW 860 -#define PRINTER 861 -#define PRINTER_1 862 -#define PRINTING 863 -#define PRIORITY 864 -#define PROCEDURE 865 -#define PROCEDURES 866 -#define PROCEED 867 -#define PROCESSING 868 -#define PROGRAM 869 -#define PROGRAM_ID 870 -#define PROGRAM_NAME 871 -#define PROGRAM_POINTER 872 -#define PROGRESS 873 -#define PROHIBITED 874 -#define PROMPT 875 -#define PROPERTIES 876 -#define PROPERTY 877 -#define PROTECTED 878 -#define PROTOTYPE 879 -#define PURGE 880 -#define PUSH_BUTTON 881 -#define QUERY_INDEX 882 -#define QUEUE 883 -#define QUOTE 884 -#define RADIO_BUTTON 885 -#define RAISE 886 -#define RAISED 887 -#define RANDOM 888 -#define RD 889 -#define READ 890 -#define READERS 891 -#define READ_ONLY 892 -#define READY_TRACE 893 -#define RECEIVE 894 -#define RECORD 895 -#define RECORD_DATA 896 -#define RECORD_OVERFLOW 897 -#define RECORD_TO_ADD 898 -#define RECORD_TO_DELETE 899 -#define RECORDING 900 -#define RECORDS 901 -#define RECURSIVE 902 -#define REDEFINES 903 -#define REEL 904 -#define REFERENCE 905 -#define REFERENCES 906 -#define REFRESH 907 -#define REGION_COLOR 908 -#define RELATIVE 909 -#define RELEASE 910 -#define REMAINDER 911 -#define REMOVAL 912 -#define RENAMES 913 -#define REORG_CRITERIA 914 -#define REPLACE 915 -#define REPLACING 916 -#define REPORT 917 -#define REPORTING 918 -#define REPORTS 919 -#define REPOSITORY 920 -#define REQUIRED 921 -#define REREAD 922 -#define RERUN 923 -#define RESERVE 924 -#define RESET 925 -#define RESET_TRACE 926 -#define RESET_GRID 927 -#define RESET_LIST 928 -#define RESET_TABS 929 -#define RESIDENT 930 -#define RETRY 931 -#define RETURN 932 -#define RETURNING 933 -#define REVERSE 934 -#define REVERSE_FUNC 935 -#define REVERSE_VIDEO 936 -#define REVERSED 937 -#define REWIND 938 -#define REWRITE 939 -#define RF 940 -#define RH 941 -#define RIGHT 942 -#define RIGHT_ALIGN 943 -#define RIMMED 944 -#define ROLLBACK 945 -#define ROUNDED 946 -#define ROUNDING 947 -#define ROW_COLOR 948 -#define ROW_COLOR_PATTERN 949 -#define ROW_DIVIDERS 950 -#define ROW_FONT 951 -#define ROW_HEADINGS 952 -#define ROW_PROTECTION 953 -#define RUN 954 -#define S 955 -#define SAME 956 -#define SAVE_AS 957 -#define SAVE_AS_NO_PROMPT 958 -#define SCREEN 959 -#define SCREEN_CONTROL 960 -#define SCROLL 961 -#define SCROLL_BAR 962 -#define SD 963 -#define SEARCH 964 -#define SEARCH_OPTIONS 965 -#define SEARCH_TEXT 966 -#define SECONDS 967 -#define SECTION 968 -#define SECURE 969 -#define SEGMENT 970 -#define SEGMENT_LIMIT 971 -#define SELECT 972 -#define SELECTION_INDEX 973 -#define SELECTION_TEXT 974 -#define SELECT_ALL 975 -#define SELF_ACT 976 -#define SEMI_COLON 977 -#define SEND 978 -#define SENTENCE 979 -#define SEPARATE 980 -#define SEPARATION 981 -#define SEQUENCE 982 -#define SEQUENTIAL 983 -#define SET 984 -#define SEVENTY_EIGHT 985 -#define SHADING 986 -#define SHADOW 987 -#define SHARING 988 -#define SHORT_DATE 989 -#define SHOW_LINES 990 -#define SHOW_NONE 991 -#define SHOW_SEL_ALWAYS 992 -#define SIGN 993 -#define SIGNED 994 -#define SIGNED_INT 995 -#define SIGNED_LONG 996 -#define SIGNED_SHORT 997 -#define SIXTY_SIX 998 -#define SIZE 999 -#define SIZE_ERROR 1000 -#define SMALL_FONT 1001 -#define SORT 1002 -#define SORT_MERGE 1003 -#define SORT_ORDER 1004 -#define SOURCE 1005 -#define SOURCE_COMPUTER 1006 -#define SPACE 1007 -#define SPECIAL_NAMES 1008 -#define SPINNER 1009 -#define SQUARE 1010 -#define STANDARD 1011 -#define STANDARD_1 1012 -#define STANDARD_2 1013 -#define STANDARD_BINARY 1014 -#define STANDARD_DECIMAL 1015 -#define START 1016 -#define START_X 1017 -#define START_Y 1018 -#define STATIC 1019 -#define STATIC_LIST 1020 -#define STATUS 1021 -#define STATUS_BAR 1022 -#define STATUS_TEXT 1023 -#define STDCALL 1024 -#define STEP 1025 -#define STOP 1026 -#define STRING 1027 -#define STYLE 1028 -#define SUB_QUEUE_1 1029 -#define SUB_QUEUE_2 1030 -#define SUB_QUEUE_3 1031 -#define SUBSTITUTE_FUNC 1032 -#define SUBSTITUTE_CASE_FUNC 1033 -#define SUBTRACT 1034 -#define SUBWINDOW 1035 -#define SUM 1036 -#define SUPPRESS 1037 -#define SUPPRESS_XML 1038 -#define SYMBOLIC 1039 -#define SYNCHRONIZED 1040 -#define SYSTEM_DEFAULT 1041 -#define SYSTEM_INFO 1042 -#define SYSTEM_OFFSET 1043 -#define TAB 1044 -#define TAB_TO_ADD 1045 -#define TAB_TO_DELETE 1046 -#define TABLE 1047 -#define TALLYING 1048 -#define TEMPORARY 1049 -#define TAPE 1050 -#define TERMINAL 1051 -#define TERMINATE 1052 -#define TERMINAL_INFO 1053 -#define TERMINATION_VALUE 1054 -#define TEST 1055 -#define TEXT 1056 -#define THAN 1057 -#define THEN 1058 -#define THREAD 1059 -#define THREADS 1060 -#define THRU 1061 -#define THUMB_POSITION 1062 -#define TILED_HEADINGS 1063 -#define TIME 1064 -#define TIME_OUT 1065 -#define TIMES 1066 -#define TITLE 1067 -#define TITLE_POSITION 1068 -#define TO 1069 -#define TOK_AMPER 1070 -#define TOK_CLOSE_PAREN 1071 -#define TOK_COLON 1072 -#define TOK_DIV 1073 -#define TOK_DOT 1074 -#define TOK_EQUAL 1075 -#define TOK_EXTERN 1076 -#define TOK_FALSE 1077 -#define TOK_FILE 1078 -#define TOK_GREATER 1079 -#define TOK_INITIAL 1080 -#define TOK_LESS 1081 -#define TOK_MINUS 1082 -#define TOK_MUL 1083 -#define TOK_NULL 1084 -#define TOK_OVERFLOW 1085 -#define TOK_OPEN_PAREN 1086 -#define TOK_PLUS 1087 -#define TOK_TRUE 1088 -#define TOP 1089 -#define TOWARD_GREATER 1090 -#define TOWARD_LESSER 1091 -#define TRACK 1092 -#define TRACKS 1093 -#define TRACK_AREA 1094 -#define TRACK_LIMIT 1095 -#define TRADITIONAL_FONT 1096 -#define TRAILING 1097 -#define TRAILING_SHIFT 1098 -#define TRANSACTION 1099 -#define TRANSFORM 1100 -#define TRANSPARENT 1101 -#define TREE_VIEW 1102 -#define TRIM_FUNC 1103 -#define TRUNCATION 1104 -#define TYPE 1105 -#define U 1106 -#define UCS_4 1107 -#define UNBOUNDED 1108 -#define UNDERLINE 1109 -#define UNFRAMED 1110 -#define UNIT 1111 -#define UNLOCK 1112 -#define UNSIGNED 1113 -#define UNSIGNED_INT 1114 -#define UNSIGNED_LONG 1115 -#define UNSIGNED_SHORT 1116 -#define UNSORTED 1117 -#define UNSTRING 1118 -#define UNTIL 1119 -#define UP 1120 -#define UPDATE 1121 -#define UPDATERS 1122 -#define UPON 1123 -#define UPON_ARGUMENT_NUMBER 1124 -#define UPON_COMMAND_LINE 1125 -#define UPON_ENVIRONMENT_NAME 1126 -#define UPON_ENVIRONMENT_VALUE 1127 -#define UPPER 1128 -#define UPPER_CASE_FUNC 1129 -#define USAGE 1130 -#define USE 1131 -#define USE_ALT 1132 -#define USE_RETURN 1133 -#define USE_TAB 1134 -#define USER 1135 -#define USER_DEFAULT 1136 -#define USER_FUNCTION_NAME 1137 -#define USING 1138 -#define UTF_8 1139 -#define UTF_16 1140 -#define V 1141 -#define VALIDATE 1142 -#define VALIDATING 1143 -#define VALUE 1144 -#define VALUE_FORMAT 1145 -#define VARIABLE 1146 -#define VARIANT 1147 -#define VARYING 1148 -#define VERTICAL 1149 -#define VERY_HEAVY 1150 -#define VIRTUAL_WIDTH 1151 -#define VISIBLE 1152 -#define VOLATILE 1153 -#define VPADDING 1154 -#define VSCROLL 1155 -#define VSCROLL_BAR 1156 -#define VSCROLL_POS 1157 -#define VTOP 1158 -#define WAIT 1159 -#define WEB_BROWSER 1160 -#define WHEN 1161 -#define WHEN_COMPILED_FUNC 1162 -#define WHEN_XML 1163 -#define WIDTH 1164 -#define WIDTH_IN_CELLS 1165 -#define WINDOW 1166 -#define WITH 1167 -#define WORD 1168 -#define WORDS 1169 -#define WORKING_STORAGE 1170 -#define WRAP 1171 -#define WRITE 1172 -#define WRITE_ONLY 1173 -#define WRITE_VERIFY 1174 -#define WRITERS 1175 -#define X 1176 -#define XML 1177 -#define XML_DECLARATION 1178 -#define Y 1179 -#define YYYYDDD 1180 -#define YYYYMMDD 1181 -#define ZERO 1182 -#define SHIFT_PREFER 1183 - -/* Value type. */ -#if ! defined YYSTYPE && ! defined YYSTYPE_IS_DECLARED -typedef int YYSTYPE; -# define YYSTYPE_IS_TRIVIAL 1 -# define YYSTYPE_IS_DECLARED 1 -#endif - - -extern YYSTYPE yylval; - -int yyparse (void); - -#endif /* !YY_YY_PARSER_H_INCLUDED */ - -/* Copy the second part of user declarations. */ - -#line 4066 "parser.c" /* yacc.c:358 */ - -#ifdef short -# undef short -#endif - -#ifdef YYTYPE_UINT8 -typedef YYTYPE_UINT8 yytype_uint8; -#else -typedef unsigned char yytype_uint8; -#endif - -#ifdef YYTYPE_INT8 -typedef YYTYPE_INT8 yytype_int8; -#else -typedef signed char yytype_int8; -#endif - -#ifdef YYTYPE_UINT16 -typedef YYTYPE_UINT16 yytype_uint16; -#else -typedef unsigned short int yytype_uint16; -#endif - -#ifdef YYTYPE_INT16 -typedef YYTYPE_INT16 yytype_int16; -#else -typedef short int yytype_int16; -#endif - -#ifndef YYSIZE_T -# ifdef __SIZE_TYPE__ -# define YYSIZE_T __SIZE_TYPE__ -# elif defined size_t -# define YYSIZE_T size_t -# elif ! defined YYSIZE_T -# include /* INFRINGES ON USER NAME SPACE */ -# define YYSIZE_T size_t -# else -# define YYSIZE_T unsigned int -# endif -#endif - -#define YYSIZE_MAXIMUM ((YYSIZE_T) -1) - -#ifndef YY_ -# if defined YYENABLE_NLS && YYENABLE_NLS -# if ENABLE_NLS -# include /* INFRINGES ON USER NAME SPACE */ -# define YY_(Msgid) dgettext ("bison-runtime", Msgid) -# endif -# endif -# ifndef YY_ -# define YY_(Msgid) Msgid -# endif -#endif - -#ifndef YY_ATTRIBUTE -# if (defined __GNUC__ \ - && (2 < __GNUC__ || (__GNUC__ == 2 && 96 <= __GNUC_MINOR__))) \ - || defined __SUNPRO_C && 0x5110 <= __SUNPRO_C -# define YY_ATTRIBUTE(Spec) __attribute__(Spec) -# else -# define YY_ATTRIBUTE(Spec) /* empty */ -# endif -#endif - -#ifndef YY_ATTRIBUTE_PURE -# define YY_ATTRIBUTE_PURE YY_ATTRIBUTE ((__pure__)) -#endif - -#ifndef YY_ATTRIBUTE_UNUSED -# define YY_ATTRIBUTE_UNUSED YY_ATTRIBUTE ((__unused__)) -#endif - -#if !defined _Noreturn \ - && (!defined __STDC_VERSION__ || __STDC_VERSION__ < 201112) -# if defined _MSC_VER && 1200 <= _MSC_VER -# define _Noreturn __declspec (noreturn) -# else -# define _Noreturn YY_ATTRIBUTE ((__noreturn__)) -# endif -#endif - -/* Suppress unused-variable warnings by "using" E. */ -#if ! defined lint || defined __GNUC__ -# define YYUSE(E) ((void) (E)) -#else -# define YYUSE(E) /* empty */ -#endif - -#if defined __GNUC__ && 407 <= __GNUC__ * 100 + __GNUC_MINOR__ -/* Suppress an incorrect diagnostic about yylval being uninitialized. */ -# define YY_IGNORE_MAYBE_UNINITIALIZED_BEGIN \ - _Pragma ("GCC diagnostic push") \ - _Pragma ("GCC diagnostic ignored \"-Wuninitialized\"")\ - _Pragma ("GCC diagnostic ignored \"-Wmaybe-uninitialized\"") -# define YY_IGNORE_MAYBE_UNINITIALIZED_END \ - _Pragma ("GCC diagnostic pop") -#else -# define YY_INITIAL_VALUE(Value) Value -#endif -#ifndef YY_IGNORE_MAYBE_UNINITIALIZED_BEGIN -# define YY_IGNORE_MAYBE_UNINITIALIZED_BEGIN -# define YY_IGNORE_MAYBE_UNINITIALIZED_END -#endif -#ifndef YY_INITIAL_VALUE -# define YY_INITIAL_VALUE(Value) /* Nothing. */ -#endif - - -#if ! defined yyoverflow || YYERROR_VERBOSE - -/* The parser invokes alloca or malloc; define the necessary symbols. */ - -# ifdef YYSTACK_USE_ALLOCA -# if YYSTACK_USE_ALLOCA -# ifdef __GNUC__ -# define YYSTACK_ALLOC __builtin_alloca -# elif defined __BUILTIN_VA_ARG_INCR -# include /* INFRINGES ON USER NAME SPACE */ -# elif defined _AIX -# define YYSTACK_ALLOC __alloca -# elif defined _MSC_VER -# include /* INFRINGES ON USER NAME SPACE */ -# define alloca _alloca -# else -# define YYSTACK_ALLOC alloca -# if ! defined _ALLOCA_H && ! defined EXIT_SUCCESS -# include /* INFRINGES ON USER NAME SPACE */ - /* Use EXIT_SUCCESS as a witness for stdlib.h. */ -# ifndef EXIT_SUCCESS -# define EXIT_SUCCESS 0 -# endif -# endif -# endif -# endif -# endif - -# ifdef YYSTACK_ALLOC - /* Pacify GCC's 'empty if-body' warning. */ -# define YYSTACK_FREE(Ptr) do { /* empty */; } while (0) -# ifndef YYSTACK_ALLOC_MAXIMUM - /* The OS might guarantee only one guard page at the bottom of the stack, - and a page size can be as small as 4096 bytes. So we cannot safely - invoke alloca (N) if N exceeds 4096. Use a slightly smaller number - to allow for a few compiler-allocated temporary stack slots. */ -# define YYSTACK_ALLOC_MAXIMUM 4032 /* reasonable circa 2006 */ -# endif -# else -# define YYSTACK_ALLOC YYMALLOC -# define YYSTACK_FREE YYFREE -# ifndef YYSTACK_ALLOC_MAXIMUM -# define YYSTACK_ALLOC_MAXIMUM YYSIZE_MAXIMUM -# endif -# if (defined __cplusplus && ! defined EXIT_SUCCESS \ - && ! ((defined YYMALLOC || defined malloc) \ - && (defined YYFREE || defined free))) -# include /* INFRINGES ON USER NAME SPACE */ -# ifndef EXIT_SUCCESS -# define EXIT_SUCCESS 0 -# endif -# endif -# ifndef YYMALLOC -# define YYMALLOC malloc -# if ! defined malloc && ! defined EXIT_SUCCESS -void *malloc (YYSIZE_T); /* INFRINGES ON USER NAME SPACE */ -# endif -# endif -# ifndef YYFREE -# define YYFREE free -# if ! defined free && ! defined EXIT_SUCCESS -void free (void *); /* INFRINGES ON USER NAME SPACE */ -# endif -# endif -# endif -#endif /* ! defined yyoverflow || YYERROR_VERBOSE */ - - -#if (! defined yyoverflow \ - && (! defined __cplusplus \ - || (defined YYSTYPE_IS_TRIVIAL && YYSTYPE_IS_TRIVIAL))) - -/* A type that is properly aligned for any stack member. */ -union yyalloc -{ - yytype_int16 yyss_alloc; - YYSTYPE yyvs_alloc; -}; - -/* The size of the maximum gap between one aligned stack and the next. */ -# define YYSTACK_GAP_MAXIMUM (sizeof (union yyalloc) - 1) - -/* The size of an array large to enough to hold all stacks, each with - N elements. */ -# define YYSTACK_BYTES(N) \ - ((N) * (sizeof (yytype_int16) + sizeof (YYSTYPE)) \ - + YYSTACK_GAP_MAXIMUM) - -# define YYCOPY_NEEDED 1 - -/* Relocate STACK from its old location to the new one. The - local variables YYSIZE and YYSTACKSIZE give the old and new number of - elements in the stack, and YYPTR gives the new location of the - stack. Advance YYPTR to a properly aligned location for the next - stack. */ -# define YYSTACK_RELOCATE(Stack_alloc, Stack) \ - do \ - { \ - YYSIZE_T yynewbytes; \ - YYCOPY (&yyptr->Stack_alloc, Stack, yysize); \ - Stack = &yyptr->Stack_alloc; \ - yynewbytes = yystacksize * sizeof (*Stack) + YYSTACK_GAP_MAXIMUM; \ - yyptr += yynewbytes / sizeof (*yyptr); \ - } \ - while (0) - -#endif - -#if defined YYCOPY_NEEDED && YYCOPY_NEEDED -/* Copy COUNT objects from SRC to DST. The source and destination do - not overlap. */ -# ifndef YYCOPY -# if defined __GNUC__ && 1 < __GNUC__ -# define YYCOPY(Dst, Src, Count) \ - __builtin_memcpy (Dst, Src, (Count) * sizeof (*(Src))) -# else -# define YYCOPY(Dst, Src, Count) \ - do \ - { \ - YYSIZE_T yyi; \ - for (yyi = 0; yyi < (Count); yyi++) \ - (Dst)[yyi] = (Src)[yyi]; \ - } \ - while (0) -# endif -# endif -#endif /* !YYCOPY_NEEDED */ - -/* YYFINAL -- State number of the termination state. */ -#define YYFINAL 3 -/* YYLAST -- Last index in YYTABLE. */ -#define YYLAST 19098 - -/* YYNTOKENS -- Number of terminals. */ -#define YYNTOKENS 929 -/* YYNNTS -- Number of nonterminals. */ -#define YYNNTS 1305 -/* YYNRULES -- Number of rules. */ -#define YYNRULES 3166 -/* YYNSTATES -- Number of states. */ -#define YYNSTATES 4481 - -/* YYTRANSLATE[YYX] -- Symbol number corresponding to YYX as returned - by yylex, with out-of-bounds checking. */ -#define YYUNDEFTOK 2 -#define YYMAXUTOK 1183 - -#define YYTRANSLATE(YYX) \ - ((unsigned int) (YYX) <= YYMAXUTOK ? yytranslate[YYX] : YYUNDEFTOK) - -/* YYTRANSLATE[TOKEN-NUM] -- Symbol number corresponding to TOKEN-NUM - as returned by yylex, without out-of-bounds checking. */ -static const yytype_uint16 yytranslate[] = -{ - 0, 2, 2, 2, 2, 2, 2, 2, 2, 2, - 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, - 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, - 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, - 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, - 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, - 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, - 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, - 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, - 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, - 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, - 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, - 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, - 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, - 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, - 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, - 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, - 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, - 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, - 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, - 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, - 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, - 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, - 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, - 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, - 2, 2, 2, 2, 2, 2, 1, 2, 3, 4, - 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, - 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, - 25, 26, 27, 28, 29, 30, 31, 32, 33, 34, - 35, 36, 37, 38, 39, 40, 41, 42, 43, 44, - 45, 46, 47, 48, 49, 50, 51, 52, 53, 54, - 55, 56, 57, 58, 59, 60, 61, 62, 63, 64, - 65, 66, 67, 68, 69, 70, 71, 72, 73, 74, - 75, 76, 77, 78, 79, 80, 81, 82, 83, 84, - 85, 86, 87, 88, 89, 90, 91, 92, 93, 94, - 95, 96, 97, 98, 99, 100, 101, 102, 103, 104, - 105, 106, 107, 108, 109, 110, 111, 112, 113, 114, - 115, 116, 117, 118, 119, 120, 121, 122, 123, 124, - 125, 126, 127, 128, 129, 130, 131, 132, 133, 134, - 135, 136, 137, 138, 139, 140, 141, 142, 143, 144, - 145, 146, 147, 148, 149, 150, 151, 152, 153, 154, - 155, 156, 157, 158, 159, 160, 161, 162, 163, 164, - 165, 166, 167, 168, 169, 170, 171, 172, 173, 174, - 175, 176, 177, 178, 179, 180, 181, 182, 183, 184, - 185, 186, 187, 188, 189, 190, 191, 192, 193, 194, - 195, 196, 197, 198, 199, 200, 201, 202, 203, 204, - 205, 206, 207, 208, 209, 210, 211, 212, 213, 214, - 215, 216, 217, 218, 219, 220, 221, 222, 223, 224, - 225, 226, 227, 228, 229, 230, 231, 232, 233, 234, - 235, 236, 237, 238, 239, 240, 241, 242, 243, 244, - 245, 246, 247, 248, 249, 250, 251, 252, 253, 254, - 255, 256, 257, 258, 259, 260, 261, 262, 263, 264, - 265, 266, 267, 268, 269, 270, 271, 272, 273, 274, - 275, 276, 277, 278, 279, 280, 281, 282, 283, 284, - 285, 286, 287, 288, 289, 290, 291, 292, 293, 294, - 295, 296, 297, 298, 299, 300, 301, 302, 303, 304, - 305, 306, 307, 308, 309, 310, 311, 312, 313, 314, - 315, 316, 317, 318, 319, 320, 321, 322, 323, 324, - 325, 326, 327, 328, 329, 330, 331, 332, 333, 334, - 335, 336, 337, 338, 339, 340, 341, 342, 343, 344, - 345, 346, 347, 348, 349, 350, 351, 352, 353, 354, - 355, 356, 357, 358, 359, 360, 361, 362, 363, 364, - 365, 366, 367, 368, 369, 370, 371, 372, 373, 374, - 375, 376, 377, 378, 379, 380, 381, 382, 383, 384, - 385, 386, 387, 388, 389, 390, 391, 392, 393, 394, - 395, 396, 397, 398, 399, 400, 401, 402, 403, 404, - 405, 406, 407, 408, 409, 410, 411, 412, 413, 414, - 415, 416, 417, 418, 419, 420, 421, 422, 423, 424, - 425, 426, 427, 428, 429, 430, 431, 432, 433, 434, - 435, 436, 437, 438, 439, 440, 441, 442, 443, 444, - 445, 446, 447, 448, 449, 450, 451, 452, 453, 454, - 455, 456, 457, 458, 459, 460, 461, 462, 463, 464, - 465, 466, 467, 468, 469, 470, 471, 472, 473, 474, - 475, 476, 477, 478, 479, 480, 481, 482, 483, 484, - 485, 486, 487, 488, 489, 490, 491, 492, 493, 494, - 495, 496, 497, 498, 499, 500, 501, 502, 503, 504, - 505, 506, 507, 508, 509, 510, 511, 512, 513, 514, - 515, 516, 517, 518, 519, 520, 521, 522, 523, 524, - 525, 526, 527, 528, 529, 530, 531, 532, 533, 534, - 535, 536, 537, 538, 539, 540, 541, 542, 543, 544, - 545, 546, 547, 548, 549, 550, 551, 552, 553, 554, - 555, 556, 557, 558, 559, 560, 561, 562, 563, 564, - 565, 566, 567, 568, 569, 570, 571, 572, 573, 574, - 575, 576, 577, 578, 579, 580, 581, 582, 583, 584, - 585, 586, 587, 588, 589, 590, 591, 592, 593, 594, - 595, 596, 597, 598, 599, 600, 601, 602, 603, 604, - 605, 606, 607, 608, 609, 610, 611, 612, 613, 614, - 615, 616, 617, 618, 619, 620, 621, 622, 623, 624, - 625, 626, 627, 628, 629, 630, 631, 632, 633, 634, - 635, 636, 637, 638, 639, 640, 641, 642, 643, 644, - 645, 646, 647, 648, 649, 650, 651, 652, 653, 654, - 655, 656, 657, 658, 659, 660, 661, 662, 663, 664, - 665, 666, 667, 668, 669, 670, 671, 672, 673, 674, - 675, 676, 677, 678, 679, 680, 681, 682, 683, 684, - 685, 686, 687, 688, 689, 690, 691, 692, 693, 694, - 695, 696, 697, 698, 699, 700, 701, 702, 703, 704, - 705, 706, 707, 708, 709, 710, 711, 712, 713, 714, - 715, 716, 717, 718, 719, 720, 721, 722, 723, 724, - 725, 726, 727, 728, 729, 730, 731, 732, 733, 734, - 735, 736, 737, 738, 739, 740, 741, 742, 743, 744, - 745, 746, 747, 748, 749, 750, 751, 752, 753, 754, - 755, 756, 757, 758, 759, 760, 761, 762, 763, 764, - 765, 766, 767, 768, 769, 770, 771, 772, 773, 774, - 775, 776, 777, 778, 779, 780, 781, 782, 783, 784, - 785, 786, 787, 788, 789, 790, 791, 792, 793, 794, - 795, 796, 797, 798, 799, 800, 801, 802, 803, 804, - 805, 806, 807, 808, 809, 810, 811, 812, 813, 814, - 815, 816, 817, 818, 819, 820, 821, 822, 823, 824, - 825, 826, 827, 828, 829, 830, 831, 832, 833, 834, - 835, 836, 837, 838, 839, 840, 841, 842, 843, 844, - 845, 846, 847, 848, 849, 850, 851, 852, 853, 854, - 855, 856, 857, 858, 859, 860, 861, 862, 863, 864, - 865, 866, 867, 868, 869, 870, 871, 872, 873, 874, - 875, 876, 877, 878, 879, 880, 881, 882, 883, 884, - 885, 886, 887, 888, 889, 890, 891, 892, 893, 894, - 895, 896, 897, 898, 899, 900, 901, 902, 903, 904, - 905, 906, 907, 908, 909, 910, 911, 912, 913, 914, - 915, 916, 917, 918, 919, 920, 921, 922, 923, 924, - 925, 926, 927, 928 -}; - -#if YYDEBUG - /* YYRLINE[YYN] -- Source line where rule number YYN was defined. */ -static const yytype_uint16 yyrline[] = -{ - 0, 3170, 3170, 3170, 3204, 3205, 3209, 3209, 3218, 3219, - 3223, 3224, 3228, 3228, 3240, 3251, 3259, 3263, 3267, 3268, - 3273, 3272, 3285, 3284, 3299, 3303, 3297, 3314, 3315, 3319, - 3328, 3328, 3333, 3337, 3332, 3353, 3352, 3368, 3379, 3386, - 3387, 3394, 3395, 3398, 3400, 3401, 3405, 3414, 3423, 3424, - 3431, 3432, 3436, 3440, 3444, 3450, 3452, 3456, 3462, 3464, - 3472, 3479, 3481, 3485, 3492, 3496, 3500, 3516, 3519, 3529, - 3531, 3538, 3542, 3546, 3552, 3554, 3561, 3565, 3569, 3573, - 3582, 3587, 3588, 3597, 3601, 3602, 3612, 3614, 3618, 3619, - 3623, 3624, 3625, 3626, 3627, 3634, 3633, 3644, 3645, 3648, - 3649, 3662, 3661, 3675, 3676, 3677, 3678, 3682, 3683, 3687, - 3688, 3689, 3690, 3694, 3702, 3711, 3710, 3718, 3722, 3728, - 3732, 3737, 3744, 3754, 3770, 3781, 3785, 3789, 3793, 3800, - 3801, 3808, 3807, 3820, 3822, 3823, 3830, 3831, 3835, 3839, - 3845, 3846, 3853, 3860, 3865, 3876, 3890, 3893, 3894, 3897, - 3901, 3902, 3903, 3904, 3905, 3906, 3907, 3908, 3909, 3910, - 3911, 3912, 3913, 3914, 3922, 3921, 3940, 3951, 3972, 3980, - 3983, 3984, 3988, 3995, 4010, 4031, 4030, 4055, 4054, 4063, - 4062, 4072, 4074, 4078, 4082, 4083, 4089, 4095, 4101, 4110, - 4111, 4118, 4125, 4135, 4141, 4149, 4159, 4163, 4170, 4174, - 4179, 4178, 4189, 4193, 4200, 4201, 4202, 4203, 4204, 4205, - 4209, 4210, 4217, 4232, 4235, 4242, 4250, 4254, 4265, 4285, - 4293, 4304, 4305, 4312, 4326, 4327, 4331, 4352, 4373, 4374, - 4378, 4382, 4400, 4402, 4406, 4413, 4415, 4425, 4446, 4513, - 4516, 4525, 4544, 4560, 4578, 4596, 4613, 4631, 4630, 4658, - 4664, 4665, 4674, 4675, 4683, 4684, 4689, 4688, 4728, 4729, - 4735, 4736, 4745, 4746, 4747, 4748, 4749, 4750, 4751, 4752, - 4753, 4754, 4755, 4756, 4757, 4758, 4759, 4760, 4761, 4762, - 4763, 4789, 4799, 4809, 4820, 4831, 4862, 4865, 4869, 4873, - 4877, 4882, 4886, 4894, 4898, 4902, 4910, 4911, 4912, 4913, - 4917, 4918, 4919, 4920, 4921, 4922, 4923, 4927, 4935, 4939, - 4947, 4951, 4958, 4959, 4965, 4972, 4973, 4974, 4981, 5041, - 5044, 5049, 5048, 5074, 5077, 5081, 5085, 5095, 5106, 5105, - 5113, 5117, 5123, 5127, 5132, 5139, 5149, 5160, 5175, 5192, - 5194, 5195, 5201, 5201, 5208, 5212, 5216, 5223, 5224, 5225, - 5229, 5235, 5236, 5240, 5246, 5247, 5263, 5264, 5268, 5274, - 5280, 5286, 5299, 5310, 5309, 5318, 5328, 5341, 5353, 5368, - 5407, 5410, 5417, 5418, 5422, 5422, 5426, 5431, 5449, 5460, - 5467, 5468, 5474, 5482, 5483, 5484, 5490, 5498, 5499, 5505, - 5515, 5525, 5535, 5545, 5546, 5553, 5561, 5562, 5563, 5570, - 5571, 5575, 5576, 5577, 5578, 5584, 5612, 5613, 5614, 5615, - 5621, 5626, 5630, 5634, 5635, 5642, 5643, 5644, 5645, 5646, - 5647, 5648, 5649, 5656, 5655, 5671, 5672, 5676, 5679, 5680, - 5686, 5690, 5694, 5695, 5704, 5701, 5715, 5716, 5720, 5728, - 5729, 5737, 5738, 5742, 5762, 5761, 5784, 5791, 5795, 5801, - 5802, 5806, 5816, 5831, 5832, 5833, 5834, 5835, 5836, 5837, - 5838, 5839, 5846, 5853, 5853, 5853, 5859, 5868, 5877, 5887, - 5888, 5895, 5896, 5900, 5901, 5908, 5919, 5924, 5935, 5936, - 5940, 5941, 5947, 5958, 5976, 5977, 5981, 5982, 5983, 5987, - 5994, 6001, 6010, 6019, 6020, 6021, 6022, 6023, 6032, 6033, - 6039, 6076, 6077, 6087, 6102, 6103, 6107, 6121, 6139, 6141, - 6140, 6158, 6159, 6163, 6180, 6179, 6200, 6201, 6205, 6206, - 6207, 6210, 6212, 6213, 6217, 6218, 6222, 6223, 6224, 6225, - 6226, 6227, 6228, 6229, 6230, 6231, 6232, 6236, 6240, 6242, - 6246, 6247, 6251, 6252, 6253, 6254, 6255, 6256, 6257, 6260, - 6262, 6263, 6267, 6268, 6272, 6273, 6274, 6275, 6276, 6277, - 6281, 6286, 6288, 6287, 6303, 6307, 6307, 6329, 6330, 6334, - 6335, 6336, 6338, 6337, 6357, 6374, 6380, 6382, 6386, 6393, - 6397, 6408, 6411, 6423, 6424, 6426, 6430, 6434, 6440, 6444, - 6448, 6452, 6456, 6460, 6464, 6472, 6476, 6480, 6484, 6488, - 6492, 6503, 6504, 6508, 6509, 6513, 6514, 6515, 6519, 6520, - 6524, 6568, 6571, 6579, 6578, 6591, 6619, 6618, 6633, 6637, - 6644, 6650, 6654, 6661, 6662, 6666, 6667, 6668, 6669, 6670, - 6671, 6672, 6673, 6674, 6675, 6678, 6680, 6684, 6688, 6692, - 6693, 6694, 6695, 6696, 6697, 6698, 6699, 6700, 6701, 6702, - 6703, 6704, 6705, 6706, 6707, 6708, 6709, 6716, 6737, 6797, - 6825, 6828, 6836, 6837, 6841, 6866, 6865, 6877, 6885, 6902, - 6914, 6931, 6948, 6969, 6970, 6977, 6979, 6987, 7002, 7003, - 7004, 7017, 7024, 7028, 7033, 7037, 7042, 7052, 7056, 7060, - 7064, 7068, 7072, 7076, 7080, 7084, 7088, 7092, 7096, 7101, - 7106, 7110, 7114, 7118, 7123, 7127, 7132, 7136, 7141, 7146, - 7151, 7156, 7161, 7170, 7175, 7180, 7189, 7193, 7197, 7201, - 7205, 7209, 7213, 7217, 7221, 7230, 7239, 7243, 7247, 7251, - 7255, 7259, 7267, 7268, 7271, 7273, 7274, 7275, 7276, 7277, - 7278, 7281, 7283, 7289, 7296, 7309, 7318, 7319, 7328, 7335, - 7347, 7365, 7366, 7370, 7371, 7375, 7376, 7379, 7380, 7385, - 7386, 7393, 7394, 7400, 7402, 7404, 7403, 7412, 7413, 7417, - 7441, 7442, 7446, 7479, 7480, 7483, 7485, 7488, 7495, 7496, - 7501, 7512, 7523, 7543, 7544, 7545, 7552, 7563, 7590, 7589, - 7598, 7599, 7603, 7604, 7607, 7609, 7621, 7630, 7645, 7668, - 7687, 7689, 7688, 7708, 7710, 7709, 7725, 7727, 7726, 7737, - 7738, 7745, 7744, 7774, 7775, 7776, 7783, 7789, 7794, 7795, - 7801, 7808, 7809, 7810, 7814, 7821, 7822, 7826, 7836, 7875, - 7886, 7887, 7901, 7914, 7915, 7918, 7919, 7924, 7925, 7926, - 7927, 7928, 7929, 7941, 7955, 7969, 7983, 7997, 8010, 8011, - 8016, 8015, 8025, 8037, 8038, 8042, 8043, 8044, 8045, 8046, - 8047, 8048, 8049, 8050, 8051, 8052, 8053, 8054, 8055, 8056, - 8057, 8061, 8068, 8072, 8076, 8077, 8078, 8085, 8089, 8097, - 8100, 8108, 8118, 8119, 8124, 8127, 8132, 8136, 8144, 8151, - 8160, 8165, 8172, 8173, 8174, 8178, 8186, 8187, 8188, 8195, - 8199, 8206, 8211, 8217, 8224, 8230, 8240, 8244, 8251, 8253, - 8257, 8261, 8265, 8269, 8276, 8284, 8285, 8288, 8290, 8294, - 8298, 8315, 8330, 8333, 8335, 8339, 8343, 8347, 8354, 8374, - 8378, 8379, 8383, 8412, 8420, 8429, 8431, 8430, 8453, 8454, - 8458, 8459, 8463, 8466, 8465, 8516, 8528, 8515, 8572, 8592, - 8594, 8598, 8603, 8608, 8612, 8616, 8621, 8626, 8631, 8636, - 8645, 8649, 8653, 8657, 8661, 8667, 8671, 8676, 8682, 8686, - 8691, 8696, 8701, 8706, 8711, 8716, 8725, 8729, 8733, 8738, - 8742, 8746, 8750, 8754, 8758, 8762, 8766, 8777, 8782, 8787, - 8788, 8789, 8790, 8791, 8792, 8793, 8794, 8795, 8804, 8809, - 8820, 8821, 8828, 8829, 8830, 8831, 8832, 8833, 8834, 8835, - 8836, 8839, 8842, 8843, 8844, 8845, 8846, 8847, 8854, 8855, - 8860, 8861, 8864, 8866, 8867, 8871, 8872, 8876, 8877, 8881, - 8882, 8886, 8887, 8891, 8892, 8893, 8894, 8895, 8898, 8899, - 8900, 8901, 8902, 8904, 8905, 8907, 8908, 8912, 8913, 8914, - 8915, 8917, 8919, 8921, 8922, 8923, 8924, 8925, 8926, 8927, - 8928, 8929, 8935, 8936, 8937, 8938, 8939, 8940, 8941, 8942, - 8943, 8944, 8948, 8949, 8951, 8952, 8953, 8954, 8959, 8961, - 8962, 8963, 8967, 8975, 8976, 8977, 8978, 8979, 8980, 8981, - 8982, 8983, 8984, 8985, 8987, 8989, 8990, 8991, 8995, 8996, - 8997, 8998, 8999, 9000, 9001, 9002, 9003, 9004, 9009, 9010, - 9011, 9012, 9013, 9015, 9016, 9017, 9018, 9023, 9024, 9035, - 9036, 9060, 9061, 9078, 9081, 9082, 9083, 9086, 9090, 9091, - 9092, 9093, 9094, 9095, 9096, 9097, 9098, 9099, 9100, 9101, - 9102, 9103, 9104, 9105, 9111, 9112, 9113, 9133, 9134, 9135, - 9136, 9137, 9138, 9139, 9140, 9144, 9145, 9146, 9147, 9148, - 9149, 9155, 9156, 9157, 9158, 9159, 9160, 9161, 9162, 9167, - 9169, 9170, 9171, 9176, 9177, 9178, 9182, 9183, 9184, 9185, - 9186, 9187, 9198, 9199, 9200, 9201, 9206, 9209, 9210, 9211, - 9212, 9213, 9215, 9220, 9221, 9222, 9228, 9229, 9230, 9231, - 9232, 9233, 9234, 9235, 9236, 9237, 9241, 9242, 9243, 9244, - 9245, 9246, 9247, 9248, 9249, 9250, 9251, 9252, 9253, 9254, - 9256, 9257, 9258, 9259, 9260, 9261, 9262, 9263, 9264, 9265, - 9266, 9267, 9268, 9269, 9270, 9271, 9272, 9275, 9276, 9277, - 9285, 9286, 9287, 9291, 9292, 9293, 9297, 9298, 9301, 9302, - 9303, 9306, 9315, 9316, 9317, 9318, 9319, 9320, 9321, 9322, - 9323, 9324, 9325, 9326, 9327, 9329, 9330, 9331, 9332, 9333, - 9334, 9335, 9336, 9337, 9338, 9345, 9349, 9353, 9354, 9355, - 9356, 9357, 9358, 9359, 9360, 9366, 9367, 9368, 9373, 9374, - 9379, 9384, 9385, 9389, 9394, 9395, 9399, 9400, 9401, 9406, - 9407, 9411, 9412, 9416, 9417, 9421, 9425, 9425, 9429, 9433, - 9433, 9437, 9441, 9442, 9446, 9447, 9451, 9459, 9461, 9465, - 9472, 9482, 9485, 9489, 9496, 9508, 9518, 9527, 9532, 9542, - 9563, 9531, 9591, 9591, 9625, 9629, 9628, 9642, 9641, 9661, - 9662, 9667, 9683, 9685, 9689, 9699, 9701, 9709, 9717, 9725, - 9731, 9735, 9771, 9773, 9781, 9784, 9797, 9802, 9812, 9840, - 9842, 9841, 9878, 9879, 9883, 9884, 9885, 9903, 9904, 9916, - 9915, 9961, 9962, 9966, 10011, 10031, 10034, 10064, 10069, 10063, - 10082, 10082, 10119, 10126, 10127, 10128, 10129, 10130, 10131, 10132, - 10133, 10134, 10135, 10136, 10137, 10138, 10139, 10140, 10141, 10142, - 10143, 10144, 10145, 10146, 10147, 10148, 10149, 10150, 10151, 10152, - 10153, 10155, 10156, 10157, 10158, 10159, 10160, 10161, 10162, 10163, - 10164, 10165, 10166, 10167, 10168, 10169, 10171, 10172, 10173, 10174, - 10175, 10176, 10177, 10178, 10179, 10180, 10181, 10182, 10183, 10184, - 10185, 10186, 10187, 10188, 10189, 10190, 10191, 10192, 10207, 10219, - 10218, 10229, 10228, 10263, 10262, 10273, 10277, 10281, 10287, 10293, - 10298, 10303, 10308, 10313, 10319, 10325, 10329, 10335, 10339, 10344, - 10348, 10352, 10356, 10360, 10364, 10368, 10372, 10386, 10393, 10394, - 10401, 10401, 10413, 10417, 10421, 10428, 10432, 10436, 10443, 10444, - 10448, 10450, 10454, 10455, 10459, 10460, 10464, 10468, 10469, 10478, - 10479, 10484, 10485, 10489, 10490, 10494, 10510, 10526, 10539, 10547, - 10555, 10562, 10568, 10574, 10579, 10585, 10590, 10595, 10608, 10613, - 10618, 10624, 10630, 10636, 10643, 10647, 10651, 10655, 10659, 10670, - 10675, 10680, 10685, 10690, 10695, 10701, 10707, 10712, 10718, 10724, - 10730, 10737, 10742, 10747, 10754, 10761, 10767, 10770, 10770, 10774, - 10785, 10786, 10787, 10791, 10792, 10793, 10797, 10798, 10802, 10806, - 10825, 10824, 10833, 10837, 10844, 10848, 10856, 10857, 10861, 10865, - 10876, 10875, 10885, 10889, 10900, 10902, 10915, 10916, 10924, 10923, - 10932, 10933, 10937, 10943, 10943, 10950, 10949, 10966, 10965, 11034, - 11038, 11037, 11053, 11057, 11061, 11069, 11072, 11080, 11088, 11092, - 11096, 11100, 11104, 11123, 11129, 11149, 11153, 11163, 11167, 11172, - 11176, 11175, 11192, 11193, 11198, 11206, 11251, 11253, 11257, 11266, - 11279, 11282, 11286, 11290, 11295, 11318, 11319, 11323, 11324, 11328, - 11332, 11336, 11347, 11351, 11358, 11362, 11370, 11374, 11381, 11388, - 11392, 11403, 11402, 11414, 11418, 11425, 11426, 11436, 11435, 11443, - 11444, 11448, 11453, 11461, 11462, 11463, 11464, 11465, 11470, 11469, - 11481, 11482, 11490, 11489, 11498, 11505, 11509, 11519, 11531, 11530, - 11551, 11552, 11552, 11567, 11566, 11575, 11582, 11593, 11592, 11601, - 11605, 11609, 11614, 11622, 11626, 11637, 11636, 11645, 11648, 11650, - 11656, 11658, 11659, 11660, 11661, 11669, 11668, 11680, 11684, 11688, - 11692, 11696, 11697, 11698, 11699, 11700, 11701, 11702, 11706, 11714, - 11723, 11724, 11729, 11728, 11772, 11776, 11782, 11784, 11788, 11789, - 11793, 11794, 11798, 11802, 11807, 11811, 11812, 11816, 11820, 11824, - 11828, 11835, 11836, 11841, 11840, 11857, 11864, 11864, 11876, 11880, - 11888, 11889, 11890, 11901, 11900, 11918, 11920, 11924, 11925, 11929, - 11933, 11934, 11935, 11936, 11941, 11946, 11940, 11960, 11961, 11966, - 11971, 11965, 11990, 11989, 12011, 12012, 12013, 12017, 12018, 12023, - 12026, 12033, 12046, 12058, 12065, 12066, 12072, 12073, 12077, 12078, - 12079, 12080, 12081, 12082, 12086, 12089, 12093, 12094, 12095, 12099, - 12100, 12101, 12102, 12106, 12107, 12112, 12113, 12117, 12127, 12143, - 12148, 12154, 12160, 12165, 12170, 12176, 12182, 12188, 12194, 12201, - 12205, 12209, 12213, 12217, 12222, 12227, 12232, 12237, 12243, 12248, - 12253, 12260, 12270, 12274, 12285, 12284, 12293, 12297, 12301, 12305, - 12309, 12316, 12320, 12331, 12330, 12342, 12341, 12349, 12348, 12358, - 12382, 12395, 12394, 12421, 12429, 12430, 12435, 12446, 12457, 12471, - 12479, 12487, 12488, 12493, 12499, 12509, 12521, 12527, 12537, 12550, - 12549, 12561, 12559, 12573, 12574, 12579, 12654, 12655, 12656, 12657, - 12661, 12662, 12666, 12670, 12681, 12680, 12692, 12696, 12721, 12735, - 12758, 12781, 12802, 12826, 12829, 12837, 12836, 12845, 12856, 12855, - 12864, 12877, 12876, 12889, 12894, 12905, 12909, 12920, 12940, 12939, - 12948, 12952, 12958, 12965, 12968, 12975, 12981, 12987, 12992, 13004, - 13003, 13011, 13019, 13020, 13024, 13025, 13026, 13031, 13034, 13041, - 13045, 13053, 13060, 13061, 13062, 13063, 13064, 13065, 13066, 13078, - 13081, 13091, 13090, 13098, 13105, 13118, 13117, 13129, 13130, 13137, - 13136, 13145, 13149, 13150, 13151, 13155, 13156, 13157, 13158, 13165, - 13164, 13185, 13195, 13203, 13207, 13214, 13219, 13224, 13229, 13234, - 13239, 13247, 13248, 13252, 13257, 13263, 13265, 13266, 13267, 13268, - 13272, 13300, 13303, 13307, 13311, 13315, 13322, 13329, 13339, 13338, - 13351, 13356, 13349, 13368, 13371, 13378, 13379, 13383, 13391, 13395, - 13405, 13404, 13414, 13421, 13423, 13430, 13429, 13442, 13441, 13454, - 13455, 13459, 13463, 13474, 13473, 13481, 13485, 13496, 13495, 13504, - 13508, 13515, 13519, 13530, 13529, 13538, 13539, 13543, 13581, 13582, - 13586, 13587, 13588, 13589, 13593, 13594, 13598, 13599, 13600, 13604, - 13605, 13613, 13614, 13618, 13619, 13625, 13634, 13635, 13636, 13641, - 13642, 13643, 13647, 13654, 13670, 13671, 13672, 13678, 13677, 13689, - 13701, 13698, 13715, 13712, 13728, 13736, 13743, 13747, 13760, 13767, - 13779, 13782, 13787, 13791, 13804, 13811, 13812, 13816, 13817, 13820, - 13821, 13826, 13869, 13873, 13883, 13882, 13895, 13894, 13902, 13907, - 13917, 13932, 13931, 13941, 13970, 13971, 13975, 13979, 13983, 13987, - 13994, 13998, 14005, 14009, 14012, 14014, 14018, 14026, 14031, 14036, - 14043, 14045, 14049, 14053, 14057, 14064, 14065, 14069, 14070, 14074, - 14078, 14088, 14099, 14098, 14107, 14112, 14113, 14117, 14118, 14119, - 14123, 14124, 14128, 14132, 14133, 14137, 14141, 14145, 14155, 14154, - 14162, 14172, 14183, 14182, 14191, 14198, 14202, 14213, 14212, 14224, - 14233, 14236, 14240, 14244, 14251, 14255, 14265, 14277, 14276, 14285, - 14289, 14298, 14299, 14304, 14307, 14315, 14319, 14326, 14334, 14338, - 14349, 14348, 14356, 14359, 14364, 14366, 14370, 14376, 14377, 14378, - 14379, 14382, 14384, 14391, 14390, 14404, 14405, 14406, 14407, 14408, - 14409, 14410, 14411, 14415, 14416, 14420, 14421, 14427, 14436, 14443, - 14444, 14448, 14452, 14456, 14462, 14468, 14472, 14476, 14480, 14489, - 14493, 14497, 14501, 14505, 14514, 14523, 14524, 14528, 14537, 14538, - 14542, 14546, 14555, 14564, 14576, 14575, 14584, 14583, 14635, 14636, - 14653, 14654, 14657, 14658, 14667, 14670, 14675, 14680, 14690, 14707, - 14712, 14722, 14740, 14739, 14749, 14762, 14765, 14773, 14776, 14781, - 14786, 14794, 14795, 14796, 14797, 14798, 14799, 14803, 14811, 14812, - 14816, 14820, 14830, 14833, 14834, 14838, 14849, 14848, 14859, 14867, - 14878, 14885, 14889, 14893, 14901, 14913, 14916, 14923, 14927, 14934, - 14935, 14936, 14937, 14944, 14943, 14952, 14959, 14959, 14969, 14970, - 14974, 14988, 14989, 14994, 14995, 14999, 15000, 15004, 15008, 15019, - 15018, 15027, 15031, 15035, 15039, 15047, 15051, 15061, 15072, 15073, - 15080, 15079, 15087, 15094, 15107, 15106, 15114, 15128, 15127, 15135, - 15152, 15151, 15161, 15169, 15170, 15175, 15176, 15181, 15188, 15189, - 15194, 15201, 15202, 15206, 15207, 15211, 15215, 15225, 15224, 15239, - 15244, 15256, 15255, 15264, 15265, 15266, 15267, 15268, 15272, 15299, - 15302, 15314, 15324, 15329, 15334, 15339, 15347, 15387, 15388, 15392, - 15452, 15462, 15485, 15486, 15487, 15488, 15492, 15501, 15508, 15519, - 15552, 15553, 15557, 15563, 15579, 15580, 15587, 15586, 15598, 15608, - 15609, 15614, 15617, 15621, 15625, 15632, 15633, 15637, 15638, 15639, - 15643, 15647, 15657, 15656, 15669, 15680, 15667, 15691, 15693, 15697, - 15698, 15702, 15706, 15718, 15727, 15737, 15740, 15750, 15753, 15761, - 15764, 15773, 15777, 15784, 15792, 15795, 15804, 15808, 15815, 15823, - 15826, 15830, 15831, 15832, 15835, 15837, 15845, 15846, 15850, 15855, - 15860, 15867, 15872, 15877, 15885, 15889, 15896, 15900, 15911, 15910, - 15927, 15922, 15933, 15935, 15938, 15940, 15943, 15945, 15949, 15950, - 15966, 15967, 15968, 15978, 15982, 15989, 15997, 15998, 16002, 16003, - 16007, 16015, 16016, 16021, 16022, 16023, 16033, 16037, 16044, 16052, - 16053, 16057, 16065, 16066, 16067, 16077, 16081, 16088, 16096, 16097, - 16101, 16109, 16110, 16111, 16121, 16125, 16132, 16140, 16141, 16145, - 16155, 16156, 16157, 16167, 16171, 16178, 16186, 16187, 16191, 16201, - 16202, 16203, 16213, 16217, 16224, 16232, 16233, 16237, 16248, 16249, - 16256, 16258, 16267, 16271, 16278, 16286, 16287, 16291, 16301, 16302, - 16312, 16316, 16323, 16331, 16332, 16336, 16346, 16347, 16351, 16352, - 16362, 16366, 16373, 16381, 16382, 16386, 16397, 16400, 16409, 16412, - 16420, 16424, 16433, 16437, 16444, 16445, 16451, 16456, 16464, 16471, - 16471, 16482, 16483, 16487, 16488, 16490, 16492, 16494, 16495, 16497, - 16498, 16499, 16500, 16501, 16503, 16504, 16505, 16508, 16510, 16514, - 16517, 16519, 16520, 16521, 16522, 16523, 16524, 16526, 16527, 16528, - 16529, 16530, 16533, 16534, 16538, 16539, 16543, 16544, 16548, 16549, - 16553, 16557, 16563, 16567, 16573, 16575, 16576, 16580, 16581, 16582, - 16586, 16587, 16588, 16592, 16596, 16600, 16601, 16602, 16605, 16606, - 16616, 16628, 16637, 16653, 16662, 16678, 16693, 16694, 16699, 16708, - 16714, 16724, 16738, 16760, 16764, 16785, 16789, 16810, 16822, 16836, - 16850, 16851, 16856, 16862, 16863, 16868, 16877, 16879, 16884, 16898, - 16899, 16900, 16907, 16918, 16919, 16923, 16931, 16932, 16936, 16937, - 16941, 16951, 16955, 16962, 16971, 16972, 16978, 16987, 16998, 17015, - 17019, 17026, 17027, 17028, 17035, 17036, 17040, 17044, 17051, 17052, - 17056, 17057, 17061, 17062, 17063, 17064, 17068, 17072, 17076, 17080, - 17084, 17105, 17115, 17119, 17126, 17127, 17128, 17132, 17133, 17134, - 17135, 17136, 17140, 17144, 17151, 17152, 17153, 17154, 17158, 17162, - 17169, 17181, 17193, 17207, 17208, 17212, 17213, 17217, 17224, 17231, - 17232, 17239, 17240, 17247, 17248, 17249, 17253, 17254, 17258, 17262, - 17266, 17270, 17271, 17275, 17279, 17280, 17284, 17288, 17289, 17298, - 17302, 17307, 17308, 17314, 17318, 17322, 17326, 17327, 17333, 17337, - 17341, 17342, 17346, 17353, 17363, 17382, 17401, 17419, 17426, 17433, - 17440, 17450, 17454, 17461, 17465, 17472, 17482, 17492, 17502, 17515, - 17541, 17545, 17553, 17553, 17566, 17571, 17579, 17587, 17591, 17601, - 17618, 17640, 17660, 17664, 17671, 17685, 17686, 17687, 17688, 17689, - 17690, 17694, 17698, 17715, 17719, 17726, 17727, 17728, 17729, 17730, - 17731, 17732, 17736, 17737, 17738, 17739, 17745, 17749, 17753, 17757, - 17761, 17765, 17770, 17774, 17778, 17782, 17786, 17790, 17794, 17798, - 17805, 17806, 17810, 17811, 17812, 17813, 17817, 17818, 17819, 17820, - 17821, 17825, 17829, 17833, 17840, 17844, 17848, 17855, 17862, 17869, - 17879, 17879, 17895, 17902, 17912, 17919, 17929, 17933, 17946, 17950, - 17965, 17973, 17974, 17978, 17979, 17980, 17984, 17985, 17990, 17993, - 18001, 18004, 18011, 18013, 18014, 18018, 18019, 18023, 18024, 18025, - 18030, 18033, 18046, 18050, 18058, 18062, 18066, 18070, 18074, 18078, - 18082, 18086, 18093, 18094, 18098, 18099, 18109, 18110, 18119, 18123, - 18127, 18131, 18138, 18139, 18140, 18141, 18142, 18143, 18144, 18145, - 18146, 18147, 18148, 18149, 18150, 18151, 18152, 18153, 18154, 18155, - 18156, 18157, 18158, 18159, 18160, 18161, 18162, 18163, 18164, 18165, - 18166, 18167, 18168, 18169, 18170, 18171, 18172, 18173, 18174, 18175, - 18176, 18177, 18178, 18179, 18180, 18181, 18182, 18183, 18184, 18185, - 18186, 18187, 18188, 18192, 18193, 18194, 18195, 18196, 18197, 18198, - 18199, 18200, 18201, 18202, 18203, 18204, 18205, 18206, 18207, 18208, - 18209, 18210, 18211, 18212, 18213, 18214, 18221, 18221, 18222, 18222, - 18223, 18223, 18224, 18224, 18225, 18225, 18225, 18226, 18226, 18227, - 18227, 18228, 18228, 18229, 18229, 18230, 18230, 18231, 18231, 18232, - 18232, 18233, 18233, 18234, 18234, 18235, 18235, 18236, 18236, 18237, - 18237, 18238, 18238, 18239, 18239, 18240, 18240, 18241, 18241, 18242, - 18242, 18243, 18243, 18244, 18244, 18245, 18245, 18245, 18246, 18246, - 18246, 18247, 18247, 18248, 18248, 18249, 18249, 18250, 18250, 18251, - 18251, 18252, 18252, 18252, 18253, 18253, 18253, 18254, 18254, 18254, - 18254, 18255, 18255, 18255, 18256, 18256, 18257, 18257, 18258, 18258, - 18258, 18259, 18259, 18259, 18260, 18260, 18261, 18261, 18262, 18262, - 18263, 18263, 18264, 18264, 18265, 18265, 18266, 18266, 18267, 18267, - 18268, 18268, 18269, 18269, 18269, 18270, 18270, 18270, 18270, 18271, - 18271, 18272, 18272, 18273, 18273, 18274, 18274, 18275, 18275, 18276, - 18276, 18277, 18277, 18277, 18278, 18278, 18279, 18279, 18280, 18280, - 18281, 18281, 18281, 18282, 18282, 18283, 18283, 18284, 18284, 18285, - 18285, 18286, 18286, 18287, 18287, 18288, 18288, 18289, 18289, 18290, - 18290, 18291, 18291, 18292, 18292, 18293, 18293, 18294, 18294, 18295, - 18295, 18295, 18299, 18299, 18300, 18300, 18301, 18301, 18302, 18302, - 18302, 18302, 18303, 18303, 18304, 18304, 18305, 18305, 18306, 18306, - 18307, 18307, 18308, 18308, 18309, 18309, 18310, 18310, 18310, 18311, - 18311, 18312, 18312, 18313, 18313, 18314, 18314, 18315, 18315, 18316, - 18316, 18319, 18319, 18320, 18320, 18321, 18321, 18322, 18322, 18323, - 18323, 18324, 18324, 18325, 18325, 18326, 18326 -}; -#endif - -#if YYDEBUG || YYERROR_VERBOSE || 1 -/* YYTNAME[SYMBOL-NUM] -- String name of the symbol SYMBOL-NUM. - First, the terminals, then, starting at YYNTOKENS, nonterminals. */ -static const char *const yytname[] = -{ - "\"end of file\"", "error", "$undefined", "\"3D\"", "ABSENT", "ACCEPT", - "ACCESS", "\"ACTIVE-X\"", "ACTION", "ACTUAL", "ADD", "ADDRESS", - "\"ADJUSTABLE-COLUMNS\"", "ADVANCING", "AFTER", "ALIGNMENT", "ALL", - "ALLOCATE", "ALLOWING", "ALPHABET", "ALPHABETIC", "\"ALPHABETIC-LOWER\"", - "\"ALPHABETIC-UPPER\"", "ALPHANUMERIC", "\"ALPHANUMERIC-EDITED\"", - "ALSO", "ALTER", "ALTERNATE", "AND", "ANY", "APPLY", "ARE", "AREA", - "AREAS", "\"ARGUMENT-NUMBER\"", "\"ARGUMENT-VALUE\"", "ARITHMETIC", "AS", - "ASCENDING", "ASCII", "ASSIGN", "AT", "ATTRIBUTE", "ATTRIBUTES", "AUTO", - "\"AUTO-DECIMAL\"", "\"AUTO-SPIN\"", "AUTOMATIC", "\"AWAY-FROM-ZERO\"", - "\"BACKGROUND-COLOR\"", "\"BACKGROUND-HIGH\"", "\"BACKGROUND-LOW\"", - "\"BACKGROUND-STANDARD\"", "BAR", "BASED", "BEFORE", "BELL", "BINARY", - "\"BINARY-C-LONG\"", "\"BINARY-CHAR\"", "\"BINARY-DOUBLE\"", - "\"BINARY-LONG\"", "\"BINARY-SEQUENTIAL\"", "\"BINARY-SHORT\"", "BIT", - "BITMAP", "\"BITMAP-END\"", "\"BITMAP-HANDLE\"", "\"BITMAP-NUMBER\"", - "\"BITMAP-START\"", "\"BITMAP-TIMER\"", "\"BITMAP-TRAILING\"", - "\"BITMAP-TRANSPARENT-COLOR\"", "\"BITMAP-WIDTH\"", "BLANK", "BLINK", - "BLOCK", "BOTTOM", "BOX", "BOXED", "\"BULK-ADDITION\"", "BUSY", - "BUTTONS", "BY", "\"BYTE-LENGTH\"", "C", "\"CALENDAR-FONT\"", "CALL", - "CANCEL", "\"CANCEL-BUTTON\"", "CAPACITY", "\"CARD-PUNCH\"", - "\"CARD-READER\"", "CASSETTE", "CCOL", "CD", "CELL", "\"CELL-COLOR\"", - "\"CELL-DATA\"", "\"CELL-FONT\"", "\"CELL-PROTECTION\"", "CENTER", - "CENTERED", "\"CENTERED-HEADINGS\"", "\"CENTURY-DATE\"", "CF", "CH", - "CHAINING", "CHARACTER", "CHARACTERS", "\"CHECK-BOX\"", "CLASS", - "CLASSIFICATION", "\"class-name\"", "\"CLEAR-SELECTION\"", "CLINE", - "CLINES", "CLOSE", "COBOL", "CODE", "\"CODE-SET\"", "COLLATING", "COL", - "COLOR", "COLORS", "COLS", "COLUMN", "\"COLUMN-COLOR\"", - "\"COLUMN-DIVIDERS\"", "\"COLUMN-FONT\"", "\"COLUMN-HEADINGS\"", - "\"COLUMN-PROTECTION\"", "COLUMNS", "\"COMBO-BOX\"", "COMMA", - "\"COMMAND-LINE\"", "\"comma delimiter\"", "COMMIT", "COMMON", - "COMMUNICATION", "COMP", "COMPUTE", "\"COMP-0\"", "\"COMP-1\"", - "\"COMP-2\"", "\"COMP-3\"", "\"COMP-4\"", "\"COMP-5\"", "\"COMP-6\"", - "\"COMP-N\"", "\"COMP-X\"", "\"FUNCTION CONCATENATE\"", "CONDITION", - "CONFIGURATION", "CONSTANT", "CONTAINS", "CONTENT", - "\"FUNCTION CONTENT-LENGTH\"", "\"FUNCTION CONTENT-OF\"", "CONTINUE", - "CONTROL", "CONTROLS", "CONVERSION", "CONVERTING", "COPY", - "\"COPY-SELECTION\"", "\"CORE-INDEX\"", "CORRESPONDING", "COUNT", "CRT", - "\"CRT-UNDER\"", "CSIZE", "CURRENCY", "\"FUNCTION CURRENT-DATE\"", - "CURSOR", "\"CURSOR-COL\"", "\"CURSOR-COLOR\"", "\"CURSOR-FRAME-WIDTH\"", - "\"CURSOR-ROW\"", "\"CURSOR-X\"", "\"CURSOR-Y\"", - "\"CUSTOM-PRINT-TEMPLATE\"", "CYCLE", "\"CYL-INDEX\"", - "\"CYL-OVERFLOW\"", "DASHED", "DATA", "\"DATA-COLUMNS\"", - "\"DATA-TYPES\"", "DATE", "\"DATE-ENTRY\"", "DAY", "\"DAY-OF-WEEK\"", - "DE", "DEBUGGING", "\"DECIMAL-POINT\"", "DECLARATIVES", "DEFAULT", - "\"DEFAULT-BUTTON\"", "\"DEFAULT-FONT\"", "DELETE", "DELIMITED", - "DELIMITER", "DEPENDING", "DESCENDING", "DESTINATION", "DESTROY", - "DETAIL", "DISABLE", "DISC", "DISK", "DISP", "DISPLAY", - "\"DISPLAY-COLUMNS\"", "\"DISPLAY-FORMAT\"", "\"FUNCTION DISPLAY-OF\"", - "DIVIDE", "DIVIDERS", "\"DIVIDER-COLOR\"", "DIVISION", "DOTDASH", - "DOTTED", "\"DRAG-COLOR\"", "\"DROP-DOWN\"", "\"DROP-LIST\"", "DOWN", - "DUPLICATES", "DYNAMIC", "EBCDIC", "EC", "ECHO", "EGI", - "\"level-number 88\"", "ENABLE", "ENABLED", "ELEMENT", "ELSE", "EMI", - "ENCRYPTION", "ENCODING", "END", "\"END-ACCEPT\"", "\"END-ADD\"", - "\"END-CALL\"", "\"END-COMPUTE\"", "\"END-COLOR\"", "\"END-DELETE\"", - "\"END-DISPLAY\"", "\"END-DIVIDE\"", "\"END-EVALUATE\"", - "\"END FUNCTION\"", "\"END-IF\"", "\"END-JSON\"", "\"END-MODIFY\"", - "\"END-MULTIPLY\"", "\"END-PERFORM\"", "\"END PROGRAM\"", "\"END-READ\"", - "\"END-RECEIVE\"", "\"END-RETURN\"", "\"END-REWRITE\"", "\"END-SEARCH\"", - "\"END-START\"", "\"END-STRING\"", "\"END-SUBTRACT\"", - "\"END-UNSTRING\"", "\"END-WRITE\"", "\"END-XML\"", "ENGRAVED", - "\"ENSURE-VISIBLE\"", "ENTRY", "\"ENTRY-CONVENTION\"", "\"ENTRY-FIELD\"", - "\"ENTRY-REASON\"", "ENVIRONMENT", "\"ENVIRONMENT-NAME\"", - "\"ENVIRONMENT-VALUE\"", "EOL", "EOP", "EOS", "EQUAL", "ERASE", "ERROR", - "ESCAPE", "\"ESCAPE-BUTTON\"", "ESI", "EVALUATE", "EVENT", - "\"EVENT-LIST\"", "\"EVENT STATUS\"", "EVERY", "EXCEPTION", - "\"EXCEPTION CONDITION\"", "\"EXCEPTION-VALUE\"", "EXPAND", "EXCLUSIVE", - "EXIT", "\"exponentiation operator\"", "EXTEND", "\"EXTENDED-SEARCH\"", - "EXTERNAL", "\"EXTERNAL-FORM\"", "F", "FD", "\"FH--FCD\"", - "\"FH--KEYDEF\"", "\"FILE-CONTROL\"", "\"FILE-ID\"", "\"FILE-LIMIT\"", - "\"FILE-LIMITS\"", "\"FILE-NAME\"", "\"FILE-POS\"", "\"FILL-COLOR\"", - "\"FILL-COLOR2\"", "\"FILL-PERCENT\"", "FILLER", "FINAL", - "\"FINISH-REASON\"", "FIRST", "FIXED", "\"FIXED-FONT\"", - "\"FIXED-WIDTH\"", "FLAT", "\"FLAT-BUTTONS\"", "\"FLOAT-BINARY-128\"", - "\"FLOAT-BINARY-32\"", "\"FLOAT-BINARY-64\"", "\"FLOAT-DECIMAL-16\"", - "\"FLOAT-DECIMAL-34\"", "\"FLOAT-DECIMAL-7\"", "\"FLOAT-EXTENDED\"", - "\"FLOAT-LONG\"", "\"FLOAT-SHORT\"", "FLOATING", "FONT", "FOOTING", - "FOR", "\"FOREGROUND-COLOR\"", "FOREVER", "\"FUNCTION FORMATTED-DATE\"", - "\"FUNCTION FORMATTED-DATETIME\"", "\"FUNCTION FORMATTED-TIME\"", - "FRAME", "FRAMED", "FREE", "FROM", "\"FROM CRT\"", "FULL", - "\"FULL-HEIGHT\"", "FUNCTION", "\"FUNCTION-ID\"", - "\"intrinsic function name\"", "GENERATE", "GIVING", "GLOBAL", "GO", - "\"GO-BACK\"", "\"GO-FORWARD\"", "\"GO-HOME\"", "\"GO-SEARCH\"", - "GOBACK", "GRAPHICAL", "GREATER", "\"GREATER OR EQUAL\"", "GRID", - "GROUP", "\"GROUP-VALUE\"", "HANDLE", "\"HAS-CHILDREN\"", "HEADING", - "\"HEADING-COLOR\"", "\"HEADING-DIVIDER-COLOR\"", "\"HEADING-FONT\"", - "HEAVY", "\"HEIGHT-IN-CELLS\"", "\"HELP-ID\"", "\"HIDDEN-DATA\"", - "HIGHLIGHT", "\"HIGH-COLOR\"", "\"HIGH-VALUE\"", "\"HOT-TRACK\"", - "HSCROLL", "\"HSCROLL-POS\"", "ICON", "ID", "IDENTIFIED", - "IDENTIFICATION", "IF", "IGNORE", "IGNORING", "IN", "INDEPENDENT", - "INDEX", "INDEXED", "INDICATE", "INITIALIZE", "INITIALIZED", "INITIATE", - "INPUT", "\"INPUT-OUTPUT\"", "INQUIRE", "\"INSERTION-INDEX\"", - "\"INSERT-ROWS\"", "INSPECT", "INTERMEDIATE", "INTO", "INTRINSIC", - "INVALID", "\"INVALID KEY\"", "IS", "ITEM", "\"ITEM-TEXT\"", - "\"ITEM-TO_ADD\"", "\"ITEM-TO_DELETE\"", "\"ITEM-TO_EMPTY\"", - "\"ITEM-VALUE\"", "\"I-O\"", "\"I-O-CONTROL\"", "JSON", "JUSTIFIED", - "KEPT", "KEY", "KEYBOARD", "LABEL", "\"LABEL-OFFSET\"", "\"LARGE-FONT\"", - "\"LARGE-OFFSET\"", "LAST", "\"LAST-ROW\"", "\"LAYOUT-DATA\"", - "\"LAYOUT-MANAGER\"", "LEADING", "\"LEADING-SHIFT\"", "LEAVE", "LEFT", - "LEFTLINE", "\"LEFT-TEXT\"", "LENGTH", "\"LENGTH OF\"", - "\"FUNCTION LENGTH/BYTE-LENGTH\"", "LESS", "\"LESS OR EQUAL\"", - "\"level-number\"", "LIMIT", "LIMITS", "LINAGE", "\"LINAGE-COUNTER\"", - "LINE", "\"LINE-COUNTER\"", "\"LINE LIMIT\"", "\"LINE-SEQUENTIAL\"", - "LINES", "\"LINES-AT-ROOT\"", "LINKAGE", "\"LIST-BOX\"", "\"Literal\"", - "\"LM-RESIZE\"", "LOC", "LOCALE", "\"FUNCTION LOCALE-DATE\"", - "\"FUNCTION LOCALE-TIME\"", "\"FUNCTION LOCALE-TIME-FROM-SECONDS\"", - "\"LOCAL-STORAGE\"", "LOCK", "\"LOCK-HOLDING\"", "\"LONG-DATE\"", - "LOWER", "LOWERED", "\"FUNCTION LOWER-CASE\"", "LOWLIGHT", - "\"LOW-COLOR\"", "\"LOW-VALUE\"", "\"MAGNETIC-TAPE\"", "MANUAL", - "\"MASS-UPDATE\"", "\"MASTER-INDEX\"", "\"MAX-LINES\"", - "\"MAX-PROGRESS\"", "\"MAX-TEXT\"", "\"MAX-VAL\"", "MEMORY", - "\"MEDIUM-FONT\"", "MENU", "MERGE", "MESSAGE", "MINUS", "\"MIN-VAL\"", - "\"Mnemonic name\"", "MODE", "MODIFY", "MODULES", "MOVE", "MULTILINE", - "MULTIPLE", "MULTIPLY", "NAME", "NAMESPACE", "\"NAMESPACE-PREFIX\"", - "NATIONAL", "\"NATIONAL-EDITED\"", "\"FUNCTION NATIONAL-OF\"", "NATIVE", - "\"NAVIGATE-URL\"", "\"NEAREST-AWAY-FROM-ZERO\"", "\"NEAREST-EVEN\"", - "\"NEAREST-TOWARD-ZERO\"", "NEGATIVE", "NESTED", "NEW", "NEXT", - "\"NEXT-ITEM\"", "\"NEXT GROUP\"", "\"NEXT PAGE\"", "NO", - "\"NO ADVANCING\"", "\"NO-AUTOSEL\"", "\"NO-AUTO-DEFAULT\"", - "\"NO-BOX\"", "\"NO DATA\"", "\"NO-DIVIDERS\"", "\"NO-ECHO\"", - "\"NO-F4\"", "\"NO-FOCUS\"", "\"NO-GROUP-TAB\"", "\"NO-KEY-LETTER\"", - "NOMINAL", "\"NO-SEARCH\"", "\"NO-UPDOWN\"", "NONNUMERIC", "NORMAL", - "NOT", "NOTAB", "NOTHING", "NOTIFY", "\"NOTIFY-CHANGE\"", - "\"NOTIFY-DBLCLICK\"", "\"NOTIFY-SELCHANGE\"", "\"NOT END\"", - "\"NOT EOP\"", "\"NOT ESCAPE\"", "\"NOT EQUAL\"", "\"NOT EXCEPTION\"", - "\"NOT INVALID KEY\"", "\"NOT OVERFLOW\"", "\"NOT SIZE ERROR\"", - "\"NUM-COL-HEADINGS\"", "\"NUM-ROWS\"", "NUMBER", "NUMBERS", "NUMERIC", - "\"NUMERIC-EDITED\"", "\"FUNCTION NUMVAL-C\"", "OBJECT", - "\"OBJECT-COMPUTER\"", "OCCURS", "OF", "OFF", "\"OK-BUTTON\"", "OMITTED", - "ON", "ONLY", "OPEN", "OPTIONAL", "OPTIONS", "OR", "ORDER", - "ORGANIZATION", "OTHER", "OTHERS", "OUTPUT", "\"OVERLAP-LEFT\"", - "\"OVERLAP-TOP\"", "OVERLINE", "\"PACKED-DECIMAL\"", "PADDING", "PASCAL", - "PAGE", "\"PAGE-COUNTER\"", "\"PAGE-SETUP\"", "PAGED", "PARAGRAPH", - "PARENT", "PARSE", "PASSWORD", "PERFORM", "PERMANENT", "PH", "PF", - "PHYSICAL", "PICTURE", "\"PICTURE SYMBOL\"", "PIXEL", "PLACEMENT", - "PLUS", "POINTER", "\"POP-UP\"", "POS", "POSITION", "\"POSITION-SHIFT\"", - "POSITIVE", "PRESENT", "PREVIOUS", "PRINT", "\"PRINT-CONTROL\"", - "\"PRINT-NO-PROMPT\"", "\"PRINT-PREVIEW\"", "PRINTER", "\"PRINTER-1\"", - "PRINTING", "PRIORITY", "PROCEDURE", "PROCEDURES", "PROCEED", - "PROCESSING", "PROGRAM", "\"PROGRAM-ID\"", "\"program name\"", - "\"PROGRAM-POINTER\"", "PROGRESS", "PROHIBITED", "PROMPT", "PROPERTIES", - "PROPERTY", "PROTECTED", "PROTOTYPE", "PURGE", "\"PUSH-BUTTON\"", - "\"QUERY-INDEX\"", "QUEUE", "QUOTE", "\"RADIO-BUTTON\"", "RAISE", - "RAISED", "RANDOM", "RD", "READ", "READERS", "\"READ-ONLY\"", - "\"READY TRACE\"", "RECEIVE", "RECORD", "\"RECORD-DATA\"", - "\"RECORD-OVERFLOW\"", "\"RECORD-TO-ADD\"", "\"RECORD-TO-DELETE\"", - "RECORDING", "RECORDS", "RECURSIVE", "REDEFINES", "REEL", "REFERENCE", - "REFERENCES", "REFRESH", "\"REGION-COLOR\"", "RELATIVE", "RELEASE", - "REMAINDER", "REMOVAL", "RENAMES", "\"REORG-CRITERIA\"", "REPLACE", - "REPLACING", "REPORT", "REPORTING", "REPORTS", "REPOSITORY", "REQUIRED", - "REREAD", "RERUN", "RESERVE", "RESET", "\"RESET TRACE\"", - "\"RESET-GRID\"", "\"RESET-LIST\"", "\"RESET-TABS\"", "RESIDENT", - "RETRY", "RETURN", "RETURNING", "REVERSE", "\"FUNCTION REVERSE\"", - "\"REVERSE-VIDEO\"", "REVERSED", "REWIND", "REWRITE", "RF", "RH", - "RIGHT", "\"RIGHT-ALIGN\"", "RIMMED", "ROLLBACK", "ROUNDED", "ROUNDING", - "\"ROW-COLOR\"", "\"ROW-COLOR-PATTERN\"", "\"ROW-DIVIDERS\"", - "\"ROW-FONT\"", "\"ROW-HEADINGS\"", "\"ROW-PROTECTION\"", "RUN", "S", - "SAME", "\"SAVE-AS\"", "\"SAVE-AS-NO-PROMPT\"", "SCREEN", - "\"SCREEN CONTROL\"", "SCROLL", "\"SCROLL-BAR\"", "SD", "SEARCH", - "\"SEARCH-OPTIONS\"", "\"SEARCH-TEXT\"", "SECONDS", "SECTION", "SECURE", - "SEGMENT", "\"SEGMENT-LIMIT\"", "SELECT", "\"SELECTION-INDEX\"", - "\"SELECTION-TEXT\"", "\"SELECTION-ALL\"", "\"SELF-ACT\"", - "\"semi-colon\"", "SEND", "SENTENCE", "SEPARATE", "SEPARATION", - "SEQUENCE", "SEQUENTIAL", "SET", "\"level-number 78\"", "SHADING", - "SHADOW", "SHARING", "\"SHORT-DATE\"", "\"SHOW-LINES\"", "\"SHOW-NONE\"", - "\"SHOW-SEL-ALWAYS\"", "SIGN", "SIGNED", "\"SIGNED-INT\"", - "\"SIGNED-LONG\"", "\"SIGNED-SHORT\"", "\"level-number 66\"", "SIZE", - "\"SIZE ERROR\"", "\"SMALL-FONT\"", "SORT", "\"SORT-MERGE\"", - "\"SORT-ORDER\"", "SOURCE", "\"SOURCE-COMPUTER\"", "SPACE", - "\"SPECIAL-NAMES\"", "SPINNER", "SQUARE", "STANDARD", "\"STANDARD-1\"", - "\"STANDARD-2\"", "\"STANDARD-BINARY\"", "\"STANDARD-DECIMAL\"", "START", - "\"START-X\"", "\"START-Y\"", "STATIC", "\"STATIC-LIST\"", "STATUS", - "\"STATUS-BAR\"", "\"STATUS-TEXT\"", "STDCALL", "STEP", "STOP", "STRING", - "STYLE", "\"SUB-QUEUE-1\"", "\"SUB-QUEUE-2\"", "\"SUB-QUEUE-3\"", - "\"FUNCTION SUBSTITUTE\"", "\"FUNCTION SUBSTITUTE-CASE\"", "SUBTRACT", - "SUBWINDOW", "SUM", "SUPPRESS", "\"SUPPRESS\"", "SYMBOLIC", - "SYNCHRONIZED", "\"SYSTEM-DEFAULT\"", "\"SYSTEM-INFO\"", - "\"SYSTEM-OFFSET\"", "TAB", "\"TAB-TO-ADD\"", "\"TAB-TO-DELETE\"", - "TABLE", "TALLYING", "TEMPORARY", "TAPE", "TERMINAL", "TERMINATE", - "\"TERMINAL-INFO\"", "\"TERMINATION-VALUE\"", "TEST", "TEXT", "THAN", - "THEN", "THREAD", "THREADS", "THRU", "\"THUMB-POSITION\"", - "\"TILED-HEADINGS\"", "TIME", "\"TIME-OUT\"", "TIMES", "TITLE", - "\"TITLE-POSITION\"", "TO", "\"&\"", "\")\"", "\":\"", "\"/\"", "\".\"", - "\"=\"", "\"EXTERN\"", "\"FALSE\"", "\"FILE\"", "\">\"", "\"INITIAL\"", - "\"<\"", "\"-\"", "\"*\"", "\"NULL\"", "\"OVERFLOW\"", "\"(\"", "\"+\"", - "\"TRUE\"", "TOP", "\"TOWARD-GREATER\"", "\"TOWARD-LESSER\"", "TRACK", - "TRACKS", "\"TRACK-AREA\"", "\"TRACK-LIMIT\"", "\"TRADITIONAL-FONT\"", - "TRAILING", "\"TRAILING-SHIFT\"", "TRANSACTION", "TRANSFORM", - "TRANSPARENT", "\"TREE-VIEW\"", "\"FUNCTION TRIM\"", "TRUNCATION", - "TYPE", "U", "\"UCS-4\"", "UNBOUNDED", "UNDERLINE", "UNFRAMED", "UNIT", - "UNLOCK", "UNSIGNED", "\"UNSIGNED-INT\"", "\"UNSIGNED-LONG\"", - "\"UNSIGNED-SHORT\"", "UNSORTED", "UNSTRING", "UNTIL", "UP", "UPDATE", - "UPDATERS", "UPON", "\"UPON ARGUMENT-NUMBER\"", "\"UPON COMMAND-LINE\"", - "\"UPON ENVIRONMENT-NAME\"", "\"UPON ENVIRONMENT-VALUE\"", "UPPER", - "\"FUNCTION UPPER-CASE\"", "USAGE", "USE", "\"USE-ALT\"", - "\"USE-RETURN\"", "\"USE-TAB\"", "USER", "\"USER-DEFAULT\"", - "\"user function name\"", "USING", "\"UTF-8\"", "\"UTF-16\"", "V", - "VALIDATE", "VALIDATING", "VALUE", "\"VALUE-FORMAT\"", "VARIABLE", - "VARIANT", "VARYING", "VERTICAL", "\"VERY-HEAVY\"", "\"VIRTUAL-WIDTH\"", - "VISIBLE", "VOLATILE", "VPADDING", "VSCROLL", "\"VSCROLL-BAR\"", - "\"VSCROLL-POS\"", "VTOP", "WAIT", "\"WEB-BROWSER\"", "WHEN", - "\"FUNCTION WHEN-COMPILED\"", "\"WHEN\"", "WIDTH", "\"WIDTH-IN-CELLS\"", - "WINDOW", "WITH", "\"Identifier\"", "WORDS", "\"WORKING-STORAGE\"", - "WRAP", "WRITE", "\"WRITE-ONLY\"", "\"WRITE-VERIFY\"", "WRITERS", "X", - "XML", "\"XML-DECLARATION\"", "Y", "YYYYDDD", "YYYYMMDD", "ZERO", - "SHIFT_PREFER", "$accept", "start", "$@1", "compilation_group", - "nested_list", "$@2", "source_element_list", "source_element", - "simple_prog", "$@3", "program_definition", "function_definition", - "_end_program_list", "end_program_list", "end_program", "$@4", - "end_function", "$@5", "_program_body", "$@6", "$@7", - "_identification_header", "identification_header", - "identification_or_id", "program_id_paragraph", "$@8", "$@9", - "function_id_paragraph", "$@10", "program_id_name", "end_program_name", - "_as_literal", "_program_type", "program_type_clause", - "init_or_recurse_or_resident_and_common", "init_or_recurse_or_resident", - "_is_prototype", "is_prototype", "_options_paragraph", - "_options_clauses", "_arithmetic_clause", "arithmetic_choice", - "_default_rounded_clause", "_entry_convention_clause", "convention_type", - "_intermediate_rounding_clause", "intermediate_rounding_choice", - "_environment_division", "_environment_header", "_configuration_section", - "_configuration_header", "_configuration_paragraphs", - "configuration_paragraphs", "configuration_paragraph", - "source_computer_paragraph", "$@11", "_source_computer_entry", - "_with_debugging_mode", "object_computer_paragraph", "$@12", - "_object_computer_entry", "object_clauses_list", "object_clauses", - "object_computer_memory", "object_computer_sequence", - "program_collating_sequence", "$@13", "program_coll_sequence_values", - "object_computer_segment", "object_computer_class", "locale_class", - "computer_words", "repository_paragraph", "$@14", "_repository_entry", - "repository_list", "repository_name", "repository_name_list", - "special_names_header", "special_names_sentence", "special_name_list", - "special_name", "mnemonic_name_clause", "$@15", "mnemonic_choices", - "_special_name_mnemonic_on_off", "on_off_clauses", "on_off_clauses_1", - "alphabet_name_clause", "@16", "alphabet_definition", "@17", "@18", - "alphabet_target_alphanumeric", "alphabet_target_national", - "alphabet_type_alphanumeric", "alphabet_type_national", - "alphabet_type_common", "alphabet_literal_list", "alphabet_literal", - "@19", "alphabet_also_sequence", "alphabet_lits", "space_or_zero", - "symbolic_characters_clause", "_sym_in_word", "symbolic_collection", - "symbolic_chars_list", "symbolic_chars_phrase", "char_list", - "integer_list", "symbolic_constant_clause", "symbolic_constant_list", - "symbolic_constant", "class_name_clause", "class_item_list", - "class_item", "_class_type", "_in_alphabet", "locale_clause", - "currency_sign_clause", "_with_pic_symbol", "decimal_point_clause", - "numeric_sign_clause", "cursor_clause", "crt_status_clause", - "screen_control", "event_status", "top_clause", "$@20", - "_input_output_section", "_input_output_header", "_file_control_header", - "_file_control_sequence", "file_control_entry", "$@21", - "_select_clauses_or_error", "_select_clause_sequence", "select_clause", - "assign_clause", "_assign_device_or_line_adv_file", "assign_device", - "general_device_name", "line_seq_device_name", "line_adv_file", - "_ext_clause", "ext_clause", "assignment_name", "access_mode_clause", - "access_mode", "alternative_record_key_clause", "_password_clause", - "password_clause", "$@22", "_suppress_clause", - "collating_sequence_clause", "collating_sequence", "$@23", - "coll_sequence_values", "collating_sequence_clause_key", "alphabet_name", - "file_status_clause", "_file_or_sort", "lock_mode_clause", "$@24", - "lock_mode", "_lock_with", "_with_rollback", "with_rollback", - "_with_mass_update", "organization_clause", "organization", - "padding_character_clause", "record_delimiter_clause", "$@25", - "record_delimiter_option", "record_key_clause", "_split_keys", - "source_is", "split_key_list", "$@26", "split_key", - "relative_key_clause", "reserve_clause", "no_or_integer", - "sharing_clause", "sharing_option", "file_limit_clause", "thru_list", - "actual_key_clause", "nominal_key_clause", "track_area_clause", - "track_limit_clause", "_i_o_control", "i_o_control_header", - "_i_o_control_entries", "i_o_control_list", "i_o_control_clause", - "same_clause", "_same_option", "apply_clause", - "obsolete_dos_vs_apply_phrase", "multiple_file_tape_clause", "$@27", - "multiple_file_list", "multiple_file", "_multiple_file_position", - "rerun_clause", "_on_assignment", "rerun_event", "_data_division", - "$@28", "_data_division_header", "data_division_header", - "_file_section_header", "_file_description_sequence", "file_description", - "file_description_entry", "$@29", "file_type", - "_file_description_clause_sequence", "file_description_clause", - "block_contains_clause", "_records_or_characters", "record_clause", - "_record_depending", "_from_integer", "_to_integer", - "label_records_clause", "value_of_clause", "file_id", "valueof_name", - "data_records_clause", "linage_clause", "_linage_sequence", - "linage_lines", "linage_footing", "linage_top", "linage_bottom", - "recording_mode_clause", "recording_mode", "u_or_s", "code_set_clause", - "_for_sub_records_clause", "report_clause", "report_keyword", - "rep_name_list", "_communication_section", "$@30", - "_communication_description_sequence", "communication_description", - "communication_description_entry", "$@31", - "_communication_description_clause_sequence", - "communication_description_clause", "_input_cd_clauses", - "named_input_cd_clauses", "named_input_cd_clause", - "unnamed_input_cd_clauses", "_output_cd_clauses", "output_cd_clauses", - "output_cd_clause", "_i_o_cd_clauses", "named_i_o_cd_clauses", - "named_i_o_cd_clause", "unnamed_i_o_cd_clauses", - "_working_storage_section", "$@32", "_record_description_list", "$@33", - "record_description_list", "data_description", "$@34", "level_number", - "_filler", "_entry_name", "user_entry_name", "_const_global", - "lit_or_length", "con_source", "fp32_usage", "fp64_usage", "fp128_usage", - "pointer_len", "renames_entry", "_renames_thru", "condition_name_entry", - "$@35", "constant_entry", "$@36", "constant_source", - "constant_78_source", "constant_expression_list", "constant_expression", - "_data_description_clause_sequence", "data_description_clause_sequence", - "data_description_clause", "redefines_clause", "same_as_clause", - "external_clause", "_as_extname", "_global_clause", "global_clause", - "special_names_clause", "$@37", "special_names_target", - "volatile_clause", "picture_clause", "_pic_locale_format", - "_is_locale_name", "locale_name", "usage_clause", "usage", - "double_usage", "_font_name", "_layout_name", "sign_clause", - "report_occurs_clause", "_occurs_step", "occurs_clause", - "_occurs_to_integer", "_occurs_from_integer", "_occurs_integer_to", - "_occurs_depending", "_capacity_in", "_occurs_initialized", - "_occurs_keys_and_indexed", "$@38", "occurs_keys", "occurs_key_list", - "occurs_key_field", "ascending_or_descending", "_occurs_indexed", - "occurs_indexed", "occurs_index_list", "occurs_index", - "justified_clause", "synchronized_clause", "_left_or_right", - "blank_clause", "based_clause", "value_clause", "$@39", - "value_item_list", "value_item", "_false_is", "any_length_clause", - "external_form_clause", "identified_by_clause", "_local_storage_section", - "$@40", "_linkage_section", "$@41", "_report_section", "$@42", - "_report_description_sequence", "report_description", "$@43", - "_report_description_options", "report_description_option", - "control_clause", "control_field_list", "control_final_tag", - "control_identifier_list", "control_identifier", "page_limit_clause", - "page_line_column", "page_limit_cols", "integer_or_zero_or_ident", - "_page_heading_list", "page_detail", "heading_clause", "first_detail", - "last_heading", "last_detail", "footing_clause", - "_report_group_description_list", "report_group_description_entry", - "$@44", "_report_group_options", "report_group_option", "type_clause", - "type_option", "_control_heading_final", "_or_page", - "_control_footing_final", "next_group_clause", "next_group_plus", - "next_page", "sum_clause_list", "_reset_clause", "data_or_final", - "present_when_condition", "present_absent", "_page_or_id", "page_or_ids", - "report_varying_clause", "line_clause", "line_keyword_clause", - "_line_clause_options", "line_clause_option", "column_clause", - "col_keyword_clause", "_orientation", "_left_right_center", - "col_or_plus", "column_integer_list", "column_integer", "source_clause", - "group_indicate_clause", "_screen_section", "$@45", - "_screen_description_list", "screen_description_list", - "screen_description", "$@46", "$@47", "$@48", "_screen_options", - "screen_option", "control_definition", "control_type_name", - "control_type", "control_item", "_control_attributes_and_screen_options", - "control_attributes", "control_attribute", "control_style", - "control_property", "control_style_name", "control_property_name", - "control_style_name_generic", "control_property_name_generic", - "control_style_name_label", "control_property_name_label", - "control_style_name_entry_field", "control_property_name_entry_field", - "control_style_name_push_button", "control_property_name_push_button", - "control_style_name_check_box", "control_property_name_radio_button", - "control_style_name_list_box", "control_property_name_list_box", - "control_style_name_combo_box", "control_style_name_frame", - "control_property_name_frame", "control_style_name_tab_control", - "control_property_name_tab_control", "control_style_name_bar", - "control_property_name_bar", "control_property_name_bitmap", - "control_style_name_grid", "control_property_name_grid", - "control_style_name_tree_view", "control_property_name_tree_view", - "control_property_name_web_browser", "control_style_name_activex", - "control_property_name_activex", "control_style_name_date_entry", - "control_property_name_date_entry", "control_style_type", - "control_property_type", "changeable_control_properties", - "changeable_control_property", "changeable_window_properties", - "changeable_window_property", "eol", "eos", "_plus", "plus", - "plus_tokens", "minus", "minus_tokens", "control_size", - "control_size_unit", "_cell", "screen_line_number", - "_screen_line_plus_minus", "screen_col_number", "_screen_col_plus_minus", - "screen_occurs_clause", "screen_global_clause", "_procedure_division", - "procedure_division", "$@49", "$@50", "$@51", "$@52", - "_procedure_using_chaining", "$@53", "$@54", "procedure_param_list", - "procedure_param", "_procedure_type", "_size_optional", - "size_is_integer", "_acu_size", "_procedure_optional", - "_procedure_returning", "_procedure_declaratives", "$@55", - "_procedure_list", "procedure", "section_header", "$@56", - "_use_statement", "paragraph_header", "invalid_statement", "_segment", - "statement_list", "@57", "@58", "statements", "$@59", "statement", - "accept_statement", "$@60", "accept_body", "$@61", "$@62", - "accp_identifier", "field_with_pos_specifier", "$@63", "pos_specifier", - "pos_specifier_value", "identifier_or_numeric_literal", - "_accept_clauses", "accept_clauses", "accept_clause", - "accept_from_screen_clauses", "accept_from_screen_clause", - "lines_or_number", "at_line_column", "line_number", "column_number", - "mode_is_block", "accp_attr", "_key_dest", "key_dest", "no_echo", - "reverse_video", "update_default", "_end_accept", "add_statement", - "$@64", "add_body", "_add_to", "_end_add", "allocate_statement", "$@65", - "allocate_body", "_loc", "allocate_returning", "alter_statement", "$@66", - "alter_body", "alter_entry", "_proceed_to", "call_statement", "$@67", - "call_body", "$@68", "_conv_linkage", "$@69", "conv_linkage_option", - "_mnemonic_conv", "mnemonic_conv", "program_or_prototype", - "_id_or_lit_or_func_as", "nested_or_prototype", "call_using", "$@70", - "call_param_list", "call_param", "_call_type", "call_returning", - "return_give", "null_or_omitted", "call_exception_phrases", - "_call_on_exception", "call_on_exception", "_call_not_on_exception", - "call_not_on_exception", "_end_call", "cancel_statement", "$@71", - "cancel_body", "id_or_lit_or_program_name", "close_statement", "$@72", - "close_body", "close_files", "_close_option", "close_window", "$@73", - "_close_display_option", "compute_statement", "$@74", "compute_body", - "_end_compute", "commit_statement", "continue_statement", "$@75", - "_continue_after_phrase", "$@76", "destroy_statement", "$@77", - "destroy_body", "delete_statement", "$@78", "delete_body", - "delete_file_list", "_end_delete", "disable_statement", "$@79", - "enable_disable_handling", "_enable_disable_key", "communication_mode", - "display_statement", "$@80", "display_body", "screen_or_device_display", - "display_list", "display_atom", "$@81", "disp_list", - "_with_display_attr", "display_attrs", "display_clauses", - "display_clause", "display_upon", "crt_under", "display_erase", "$@82", - "display_pos_specifier", "field_or_literal_or_erase_with_pos_specifier", - "$@83", "field_or_literal_or_erase_list", "field_or_literal_or_erase", - "display_message_box", "$@84", "_display_message_clauses", - "display_message_clauses", "display_message_clause", "display_window", - "$@85", "$@86", "sub_or_window", "display_floating_window", "$@87", - "$@88", "display_initial_window", "$@89", "initial_type", "_graphical", - "_upon_window_handle", "window_handle", "display_window_clauses", - "display_window_clause", "shadow", "boxed", "_top_or_bottom", - "_left_or_centered_or_right", "no_scroll_wrap", "pop_up_or_handle", - "pop_up_area", "handle_is_in", "disp_attr", "_end_display", - "divide_statement", "$@90", "divide_body", "_end_divide", - "enable_statement", "$@91", "entry_statement", "$@92", "$@93", - "entry_body", "entry_goto_body", "evaluate_statement", "$@94", - "evaluate_body", "evaluate_subject_list", "evaluate_subject", - "evaluate_condition_list", "evaluate_case_list", "evaluate_case", - "evaluate_other", "evaluate_when_list", "$@95", "$@96", - "evaluate_object_list", "evaluate_object", "_evaluate_thru_expr", - "_end_evaluate", "exit_statement", "$@97", "exit_body", - "exit_program_returning", "free_statement", "$@98", "free_body", - "generate_statement", "$@99", "generate_body", "goto_statement", "$@100", - "go_body", "goto_depending", "goback_statement", "if_statement", "$@101", - "if_else_statements", "_if_then", "if_true", "if_false", "_end_if", - "initialize_statement", "$@102", "initialize_body", "_initialize_filler", - "_initialize_value", "_initialize_replacing", - "initialize_replacing_list", "initialize_replacing_item", - "initialize_category", "_initialize_default", "initiate_statement", - "$@103", "initiate_body", "inquire_statement", "$@104", "inquire_body", - "inspect_statement", "$@105", "inspect_body", "send_identifier", - "inspect_list", "inspect_tallying", "$@106", "inspect_replacing", - "inspect_converting", "tallying_list", "tallying_item", "replacing_list", - "replacing_item", "rep_keyword", "replacing_region", "inspect_region", - "inspect_before", "inspect_after", "json_generate_statement", "$@107", - "json_generate_body", "$@108", "$@109", "_json_suppress", - "json_suppress_list", "json_suppress_entry", "_end_json", - "json_parse_statement", "$@110", "json_parse_body", "_with_detail", - "merge_statement", "$@111", "modify_statement", "$@112", "modify_body", - "_end_modify", "move_statement", "$@113", "move_body", - "multiply_statement", "$@114", "multiply_body", "_end_multiply", - "open_statement", "$@115", "open_body", "open_file_entry", - "_open_exclusive", "open_mode", "_open_sharing", "_open_option", - "lock_allowing", "open_lock_option", "allowing_option", "allowing_all", - "open_option_sequential", "osvs_input_mode", "perform_statement", - "$@116", "perform_body", "$@117", "$@118", "_end_perform", - "end_perform_or_dot", "perform_procedure", "_perform_option", - "perform_test", "cond_or_exit", "perform_varying_list", - "perform_varying", "_by_phrase", "purge_statement", "$@119", - "raise_statement", "$@120", "raise_body", "exception_name", - "read_statement", "$@121", "read_body", "_read_into", "_lock_phrases", - "ignoring_lock", "advancing_lock_or_retry", "_retry_phrase", - "retry_phrase", "retry_options", "_extended_with_lock", - "extended_with_lock", "_read_key", "read_handler", "_end_read", - "ready_statement", "receive_statement", "$@122", "receive_body", - "message_or_segment", "_data_sentence_phrases", "_no_data_sentence", - "no_data_sentence", "_with_data_sentence", "with_data_sentence", - "_end_receive", "release_statement", "$@123", "release_body", - "reset_statement", "return_statement", "$@124", "return_body", - "_end_return", "rewrite_statement", "$@125", "rewrite_body", - "_with_lock", "with_lock", "_end_rewrite", "rollback_statement", - "search_statement", "$@126", "search_body", "search_varying", - "search_at_end", "search_whens", "search_when", "_end_search", - "send_statement", "$@127", "send_body", "_from_identifier", - "from_identifier", "with_indicator", "_replacing_line", "set_statement", - "$@128", "set_body", "on_or_off", "up_or_down", "set_environment", - "set_attr", "set_attr_clause", "set_attr_one", "set_to", "set_up_down", - "set_to_on_off_sequence", "set_to_on_off", "set_to_true_false_sequence", - "set_to_true_false", "set_last_exception_to_off", "set_thread_priority", - "sort_statement", "$@129", "sort_body", "@130", "_sort_key_list", - "_key_sort_list", "_sort_duplicates", "_sort_collating", "sort_input", - "sort_output", "start_statement", "$@131", "start_body", - "_sizelen_clause", "_start_key", "start_op", "disallowed_op", - "not_equal_op", "_end_start", "start_transaction_statement", - "_transaction", "transaction", "stop_statement", "$@132", - "stop_returning", "_status_x", "stop_argument", "stop_literal", - "string_statement", "$@133", "string_body", "string_items", "$@134", - "string_item_list", "string_item", "_string_delimited", - "string_delimiter", "_with_pointer", "_end_string", "subtract_statement", - "$@135", "subtract_body", "_end_subtract", "suppress_statement", - "_printing", "terminate_statement", "$@136", "terminate_body", - "transform_statement", "$@137", "transform_body", "unlock_statement", - "$@138", "unlock_body", "unstring_statement", "$@139", "unstring_body", - "_unstring_delimited", "unstring_delimited_list", - "unstring_delimited_item", "unstring_into", "unstring_into_item", - "_unstring_into_delimiter", "_unstring_tallying", "_end_unstring", - "validate_statement", "$@140", "validate_fields", "use_statement", - "$@141", "use_phrase", "use_file_exception", "use_global", - "use_file_exception_target", "use_debugging", "debugging_list", - "debugging_target", "_all_refs", "use_start_end", "program_start_end", - "use_reporting", "use_exception_list", "use_exception", "use_ex_keyw", - "write_statement", "$@142", "write_body", "from_option", "write_option", - "before_or_after", "write_handler", "_end_write", - "xml_generate_statement", "$@143", "xml_generate_body", "$@144", "$@145", - "_with_encoding_xml_dec_and_attrs", "with_encoding_xml_dec_and_attrs", - "with_encoding_xml_dec_and_attr", "encoding_xml_dec_and_attr", - "_xml_gen_namespace", "_xml_gen_namespace_prefix", "_name_of", - "identifier_name_list", "identifier_is_name", "_type_of", - "identifier_type_list", "identifier_is_type", "_xml_type", "ml_type", - "_xml_gen_suppress", "xml_suppress_list", "xml_suppress_entry", - "xml_suppress_generic_opt", "xml_suppress_when_list", "_end_xml", - "xml_parse_statement", "$@146", "xml_parse_body", "$@147", - "_with_encoding", "_returning_national", "_validating_with", - "schema_file_or_record_name", "_accept_exception_phrases", - "_accp_on_exception", "accp_on_exception", "escape_or_exception", - "_accp_not_on_exception", "accp_not_on_exception", - "not_escape_or_not_exception", "_display_exception_phrases", - "_disp_on_exception", "disp_on_exception", "_disp_not_on_exception", - "disp_not_on_exception", "_xml_exception_phrases", "_xml_on_exception", - "xml_on_exception", "_xml_not_on_exception", "xml_not_on_exception", - "_json_exception_phrases", "_json_on_exception", "json_on_exception", - "_json_not_on_exception", "json_not_on_exception", - "on_size_error_phrases", "_on_size_error", "on_size_error", - "_not_on_size_error", "not_on_size_error", "_on_overflow_phrases", - "_on_overflow", "on_overflow", "_not_on_overflow", "not_on_overflow", - "return_at_end", "at_end", "_at_end_clause", "at_end_clause", - "_not_at_end_clause", "not_at_end_clause", "at_eop_clauses", - "_at_eop_clause", "at_eop_clause", "_not_at_eop_clause", - "not_at_eop_clause", "_invalid_key_phrases", "invalid_key_phrases", - "_invalid_key_sentence", "invalid_key_sentence", - "_not_invalid_key_sentence", "not_invalid_key_sentence", "_thread_start", - "_thread_handle", "thread_reference_optional", "_scroll_lines", - "_count_in", "condition", "expr", "partial_expr", "$@148", "expr_tokens", - "expr_token", "_not_expr", "not_expr", "condition_or_class", "eq", "gt", - "lt", "ge", "le", "exp_list", "_e_sep", "exp", "exp_term", "exp_factor", - "exp_unary", "exp_atom", "line_linage_page_counter", "arithmetic_x_list", - "arithmetic_x", "record_name", "file_or_record_name", "table_name", - "file_name_list", "file_file_name_list", "file_name", "cd_name", - "report_name", "mnemonic_name_list", "mnemonic_name", "entry_name_list", - "entry_name", "procedure_name_list", "procedure_name", "label", - "integer_label", "reference_list", "reference", "_reference", - "single_reference_list", "single_reference", "optional_reference_list", - "optional_reference", "reference_or_literal", "undefined_word", - "unique_word", "target_x_list", "target_x", "_x_list", "x_list", "x", - "call_x", "x_common", "length_of_register", "report_x_list", "expr_x", - "arith_x", "arith_nonzero_x", "numeric_literal", "non_numeric_literal", - "nonzero_numeric_literal", "prog_or_entry", "alnum_or_id", - "simple_display_value", "simple_display_all_value", "inspect_from", - "inspect_to", "simple_value", "simple_all_value", "id_or_lit", - "id_or_lit_or_func", "id_or_lit_or_length_or_func", "num_id_or_lit", - "positive_id_or_lit", "pos_num_id_or_lit_or_zero", "pos_num_id_or_lit", - "from_parameter", "sub_identifier", "table_identifier", - "sub_identifier_1", "display_identifier", "numeric_identifier", - "identifier_or_file_name", "identifier_field", "identifier", - "identifier_1", "identifier_list", "target_identifier", - "target_identifier_1", "display_identifier_or_alphabet_name", - "qualified_word", "unqualified_word", "$@149", "unqualified_word_check", - "subref", "refmod", "integer", "symbolic_integer", - "unsigned_pos_integer", "integer_or_zero", "class_value", "literal", - "basic_literal", "basic_value", "zero_spaces_high_low_values", - "function", "func_no_parm", "func_one_parm", "func_multi_parm", - "func_refmod", "func_args", "trim_args", "length_arg", "$@150", - "numvalc_args", "locale_dt_args", "formatted_datetime_args", - "formatted_time_args", "not_const_word", "flag_all", "flag_duplicates", - "flag_initialized", "flag_initialized_to", "to_init_val", "_flag_next", - "_flag_not", "flag_optional", "flag_rounded", "round_mode", - "round_choice", "flag_separate", "_from_idx_to_idx", "_dest_index", - "error_stmt_recover", "verb", "scope_terminator", "_advancing", "_after", - "_are", "_area", "_areas", "_as", "_at", "_before", "_binary", "_box", - "_by", "_character", "_characters", "_collating", "_contains", - "_controls", "_control", "_data", "_end_of", "_every", "_file", "_for", - "_from", "_in", "_in_equal", "_in_order", "_index", "_indicate", - "_initial", "_into", "_is", "_is_equal", "_is_are", "_is_are_equal", - "_is_in", "_key", "_line", "_line_or_lines", "_limits", "_lines", - "_lock", "_message", "_mode", "_new", "_number", "_number_or_numbers", - "_of", "_on", "_on_for", "_onoff_status", "_other", "_others", - "_procedure", "_program", "_protected", "_record", "_records", "_right", - "_sign", "_signed", "_sign_is", "_size", "_standard", "_status", - "_symbolic", "_tape", "_terminal", "_then", "_times", "_to", "_up", - "_when", "_when_set_to", "_with", "_with_for", "column_or_col", - "columns_or_cols", "column_or_cols", "column_or_col_or_position_or_pos", - "comp_equal", "exception_or_error", "file_limit_or_limits", "in_of", - "label_option", "line_or_lines", "lock_records", - "object_char_or_word_or_modules", "records", "reel_or_unit", - "size_or_length", "length_of", "track_or_tracks", "using_or_varying", - "detail_keyword", "ch_keyword", "cf_keyword", "ph_keyword", "pf_keyword", - "rh_keyword", "rf_keyword", "control_keyword", YY_NULLPTR -}; -#endif - -# ifdef YYPRINT -/* YYTOKNUM[NUM] -- (External) token number corresponding to the - (internal) symbol number NUM (which must be that of a token). */ -static const yytype_uint16 yytoknum[] = -{ - 0, 256, 257, 258, 259, 260, 261, 262, 263, 264, - 265, 266, 267, 268, 269, 270, 271, 272, 273, 274, - 275, 276, 277, 278, 279, 280, 281, 282, 283, 284, - 285, 286, 287, 288, 289, 290, 291, 292, 293, 294, - 295, 296, 297, 298, 299, 300, 301, 302, 303, 304, - 305, 306, 307, 308, 309, 310, 311, 312, 313, 314, - 315, 316, 317, 318, 319, 320, 321, 322, 323, 324, - 325, 326, 327, 328, 329, 330, 331, 332, 333, 334, - 335, 336, 337, 338, 339, 340, 341, 342, 343, 344, - 345, 346, 347, 348, 349, 350, 351, 352, 353, 354, - 355, 356, 357, 358, 359, 360, 361, 362, 363, 364, - 365, 366, 367, 368, 369, 370, 371, 372, 373, 374, - 375, 376, 377, 378, 379, 380, 381, 382, 383, 384, - 385, 386, 387, 388, 389, 390, 391, 392, 393, 394, - 395, 396, 397, 398, 399, 400, 401, 402, 403, 404, - 405, 406, 407, 408, 409, 410, 411, 412, 413, 414, - 415, 416, 417, 418, 419, 420, 421, 422, 423, 424, - 425, 426, 427, 428, 429, 430, 431, 432, 433, 434, - 435, 436, 437, 438, 439, 440, 441, 442, 443, 444, - 445, 446, 447, 448, 449, 450, 451, 452, 453, 454, - 455, 456, 457, 458, 459, 460, 461, 462, 463, 464, - 465, 466, 467, 468, 469, 470, 471, 472, 473, 474, - 475, 476, 477, 478, 479, 480, 481, 482, 483, 484, - 485, 486, 487, 488, 489, 490, 491, 492, 493, 494, - 495, 496, 497, 498, 499, 500, 501, 502, 503, 504, - 505, 506, 507, 508, 509, 510, 511, 512, 513, 514, - 515, 516, 517, 518, 519, 520, 521, 522, 523, 524, - 525, 526, 527, 528, 529, 530, 531, 532, 533, 534, - 535, 536, 537, 538, 539, 540, 541, 542, 543, 544, - 545, 546, 547, 548, 549, 550, 551, 552, 553, 554, - 555, 556, 557, 558, 559, 560, 561, 562, 563, 564, - 565, 566, 567, 568, 569, 570, 571, 572, 573, 574, - 575, 576, 577, 578, 579, 580, 581, 582, 583, 584, - 585, 586, 587, 588, 589, 590, 591, 592, 593, 594, - 595, 596, 597, 598, 599, 600, 601, 602, 603, 604, - 605, 606, 607, 608, 609, 610, 611, 612, 613, 614, - 615, 616, 617, 618, 619, 620, 621, 622, 623, 624, - 625, 626, 627, 628, 629, 630, 631, 632, 633, 634, - 635, 636, 637, 638, 639, 640, 641, 642, 643, 644, - 645, 646, 647, 648, 649, 650, 651, 652, 653, 654, - 655, 656, 657, 658, 659, 660, 661, 662, 663, 664, - 665, 666, 667, 668, 669, 670, 671, 672, 673, 674, - 675, 676, 677, 678, 679, 680, 681, 682, 683, 684, - 685, 686, 687, 688, 689, 690, 691, 692, 693, 694, - 695, 696, 697, 698, 699, 700, 701, 702, 703, 704, - 705, 706, 707, 708, 709, 710, 711, 712, 713, 714, - 715, 716, 717, 718, 719, 720, 721, 722, 723, 724, - 725, 726, 727, 728, 729, 730, 731, 732, 733, 734, - 735, 736, 737, 738, 739, 740, 741, 742, 743, 744, - 745, 746, 747, 748, 749, 750, 751, 752, 753, 754, - 755, 756, 757, 758, 759, 760, 761, 762, 763, 764, - 765, 766, 767, 768, 769, 770, 771, 772, 773, 774, - 775, 776, 777, 778, 779, 780, 781, 782, 783, 784, - 785, 786, 787, 788, 789, 790, 791, 792, 793, 794, - 795, 796, 797, 798, 799, 800, 801, 802, 803, 804, - 805, 806, 807, 808, 809, 810, 811, 812, 813, 814, - 815, 816, 817, 818, 819, 820, 821, 822, 823, 824, - 825, 826, 827, 828, 829, 830, 831, 832, 833, 834, - 835, 836, 837, 838, 839, 840, 841, 842, 843, 844, - 845, 846, 847, 848, 849, 850, 851, 852, 853, 854, - 855, 856, 857, 858, 859, 860, 861, 862, 863, 864, - 865, 866, 867, 868, 869, 870, 871, 872, 873, 874, - 875, 876, 877, 878, 879, 880, 881, 882, 883, 884, - 885, 886, 887, 888, 889, 890, 891, 892, 893, 894, - 895, 896, 897, 898, 899, 900, 901, 902, 903, 904, - 905, 906, 907, 908, 909, 910, 911, 912, 913, 914, - 915, 916, 917, 918, 919, 920, 921, 922, 923, 924, - 925, 926, 927, 928, 929, 930, 931, 932, 933, 934, - 935, 936, 937, 938, 939, 940, 941, 942, 943, 944, - 945, 946, 947, 948, 949, 950, 951, 952, 953, 954, - 955, 956, 957, 958, 959, 960, 961, 962, 963, 964, - 965, 966, 967, 968, 969, 970, 971, 972, 973, 974, - 975, 976, 977, 978, 979, 980, 981, 982, 983, 984, - 985, 986, 987, 988, 989, 990, 991, 992, 993, 994, - 995, 996, 997, 998, 999, 1000, 1001, 1002, 1003, 1004, - 1005, 1006, 1007, 1008, 1009, 1010, 1011, 1012, 1013, 1014, - 1015, 1016, 1017, 1018, 1019, 1020, 1021, 1022, 1023, 1024, - 1025, 1026, 1027, 1028, 1029, 1030, 1031, 1032, 1033, 1034, - 1035, 1036, 1037, 1038, 1039, 1040, 1041, 1042, 1043, 1044, - 1045, 1046, 1047, 1048, 1049, 1050, 1051, 1052, 1053, 1054, - 1055, 1056, 1057, 1058, 1059, 1060, 1061, 1062, 1063, 1064, - 1065, 1066, 1067, 1068, 1069, 1070, 1071, 1072, 1073, 1074, - 1075, 1076, 1077, 1078, 1079, 1080, 1081, 1082, 1083, 1084, - 1085, 1086, 1087, 1088, 1089, 1090, 1091, 1092, 1093, 1094, - 1095, 1096, 1097, 1098, 1099, 1100, 1101, 1102, 1103, 1104, - 1105, 1106, 1107, 1108, 1109, 1110, 1111, 1112, 1113, 1114, - 1115, 1116, 1117, 1118, 1119, 1120, 1121, 1122, 1123, 1124, - 1125, 1126, 1127, 1128, 1129, 1130, 1131, 1132, 1133, 1134, - 1135, 1136, 1137, 1138, 1139, 1140, 1141, 1142, 1143, 1144, - 1145, 1146, 1147, 1148, 1149, 1150, 1151, 1152, 1153, 1154, - 1155, 1156, 1157, 1158, 1159, 1160, 1161, 1162, 1163, 1164, - 1165, 1166, 1167, 1168, 1169, 1170, 1171, 1172, 1173, 1174, - 1175, 1176, 1177, 1178, 1179, 1180, 1181, 1182, 1183 -}; -# endif - -#define YYPACT_NINF -3857 - -#define yypact_value_is_default(Yystate) \ - (!!((Yystate) == (-3857))) - -#define YYTABLE_NINF -3134 - -#define yytable_value_is_error(Yytable_value) \ - 0 - - /* YYPACT[STATE-NUM] -- Index in YYTABLE of the portion describing - STATE-NUM. */ -static const yytype_int16 yypact[] = -{ - -3857, 1286, 1588, -3857, -3857, -3857, 1816, -3857, 739, -3857, - -3857, 1326, -3857, -3857, -3857, -7, -3857, 1153, 724, -3857, - 1331, -3857, -3857, -3857, 739, 739, 975, 1728, 1711, -3857, - 1283, 1083, 1135, 1783, 1749, -3857, 1658, -3857, 1854, 1319, - 1896, 1394, 1697, 1302, -77, -77, -3857, -3857, 1783, -3857, - -3857, -3857, -3857, 1228, 1430, 1877, -3857, 1941, -3857, 1348, - -3857, 1360, 1484, -3857, 1930, 121, 121, 1473, 1527, 1658, - 1658, 1658, 121, 1530, 1452, 1460, 1658, 1466, 1479, 330, - -3857, -3857, -3857, 1302, -3857, -3857, -3857, -3857, -3857, -3857, - 1400, -3857, -3857, -3857, -3857, 1924, -3857, -3857, -3857, -3857, - -3857, -3857, -3857, -3857, -3857, -3857, -3857, -3857, -3857, 2280, - 2280, -68, -3857, -68, -3857, -3857, -3857, -3857, -3857, 1834, - 1658, 1932, 1519, 1576, 1640, -3857, -3857, 1538, 1544, -3857, - -3857, -3857, -3857, 1136, 1658, -3857, 1658, 1442, 2237, 1442, - 1658, 1658, -3857, -3857, 1442, -3857, -3857, -3857, 1461, 1470, - 1658, 1571, -3857, -3857, -3857, -3857, 1475, -3857, 1940, 1162, - -3857, -3857, -3857, 1580, 1581, -3857, 1658, 96, 1680, 1583, - -3857, 2185, -3857, -3857, -3857, 1586, -3, -3857, -3857, -96, - 1136, -3857, 1658, 617, 1442, 1952, 937, -3857, -3857, -3857, - -3857, 1956, 1570, 648, -20, -3857, 1500, -3857, 1461, -3857, - 1658, -3857, 1470, -3857, 153, -3857, 121, -3857, -3857, -3857, - -3857, -3857, 1277, -74, 1658, 113, -3857, -3857, 1597, -3857, - 1799, -102, -3857, -3857, 806, -3857, -3857, -3857, -3857, 1658, - -3857, -3857, 8137, 8825, -3857, -3857, -3857, 1518, -3857, 882, - 128, 1616, -70, -3857, -3857, 631, -3857, -3857, -3857, 624, - 1474, -3857, -3857, -3857, -239, -3857, -3857, 1442, -3857, 1718, - -3857, 1700, -3857, 1658, -3857, -3857, 461, -3857, -3857, -3857, - -3857, -3857, 257, 2336, 2328, 130, 1537, -3857, 169, -3857, - -3857, -33, -3857, 276, -3857, -3857, -3857, -3857, 1997, -3857, - -74, -3857, 2044, 121, 121, -3857, 1277, -3857, -3857, 1637, - -3857, 1036, -3857, -3857, -3857, -3857, -3857, -3857, -3857, -3857, - -3857, 1265, 725, 9394, -3857, -3857, -3857, -3857, -3857, -3857, - -3857, 1614, -3857, -3857, -3857, -3857, -3857, -3857, -3857, -3857, - 2123, -3857, -3857, -3857, -3857, -3857, -40, -3857, -3857, -3857, - -3857, -3857, 942, -3857, -3857, -3857, -3857, 1736, -3857, -3857, - -3857, -3857, -3857, -3857, -3857, -3857, -3857, -3857, -3857, 1614, - -3857, -3857, -3857, -3857, 1614, 1357, -3857, -3857, 1863, -3857, - -3857, -3857, -3857, -3857, -3857, -3857, 1234, -3857, -3857, -3857, - -3857, -3857, -3857, -3857, -3857, -3857, -3857, -3857, -3857, -3857, - -3857, -3857, -3857, -3857, -3857, -3857, -3857, -3857, -3857, -3857, - -3857, -3857, -3857, -3857, -3857, -3857, -3857, -3857, -3857, -3857, - -3857, -3857, -3857, -3857, -3857, -3857, -3857, -3857, -3857, -3857, - -3857, -3857, -3857, -3857, -3857, -3857, -3857, -3857, -3857, -3857, - -3857, -3857, -3857, -3857, -3857, -3857, -3857, -3857, -3857, -3857, - -3857, -3857, -3857, 1760, 2335, -3857, 397, 1657, -3857, -3857, - -3857, 1913, -3857, 121, 1478, -3857, 1920, 1288, -3857, 174, - -3857, -3857, -3857, -3857, -3857, -3857, 1658, 1658, -3857, -3857, - -3857, -3857, -3857, -3857, -3857, -3857, -3857, 1317, -3857, 1674, - -3857, -3857, 1891, -3857, -3857, -3857, 1658, 2027, -3857, -3857, - -3857, -3857, 745, 1658, -3857, -3857, 1756, 2078, -3857, 2280, - 1190, 2280, 1666, -3857, -3857, 1668, 2297, 1569, -3857, -3857, - -3857, -3857, -3857, -3857, -3857, -3857, 1679, -3857, -3857, 1997, - -3857, 121, -3857, -3857, -3857, -3857, -3857, -3857, 756, -3857, - -3857, -3857, -3857, 1875, -3857, 2357, -3857, -3857, -3857, -3857, - -3857, -3857, -3857, -3857, -3857, -3857, -3857, 1585, -3857, -3857, - -3857, -3857, -3857, -3857, -3857, -3857, -3857, -3857, -3857, -3857, - -3857, -3857, -3857, -3857, -3857, -3857, -3857, -3857, -3857, -3857, - -3857, -3857, -3857, -3857, -3857, -3857, -3857, -3857, -3857, -3857, - -3857, -3857, -3857, -3857, -3857, -3857, -3857, -3857, -3857, -3857, - -3857, -3857, -3857, -3857, -3857, -3857, -3857, -3857, -3857, -3857, - -3857, -3857, -3857, -3857, -3857, -3857, -3857, -3857, -3857, -3857, - -3857, -3857, -3857, -3857, -3857, -3857, -3857, -3857, -3857, -3857, - -3857, -3857, -3857, -3857, -3857, -3857, -3857, -3857, 698, 13467, - 17992, -184, 725, 618, 830, -3857, -3857, -3857, 458, 2484, - -408, 139, 1014, 12820, 14319, 1014, 2144, 725, 1180, 1257, - 458, 1442, 1686, -3857, -3857, 14319, -3857, 6124, 458, 1589, - 78, 5117, -3857, -3857, 1442, 78, 6381, 14319, -3857, 2208, - -104, 1592, -80, 1593, 1592, 1442, 1593, -400, -3857, 140, - 1592, 216, 1442, 1593, -3857, -3857, -3857, -3857, -3857, 1442, - -3857, -3857, -3857, -3857, -3857, -3857, 1676, -3857, 13591, -3857, - -3857, 1589, 111, 1442, 1593, 5171, 1442, -400, -3857, -3857, - 1689, 1796, 2049, 1461, 1461, 1461, 926, 1693, 15608, -3857, - -3857, -3857, 2071, -3857, -3857, -3857, -3857, 1920, 1686, 1686, - 1959, 1920, 1920, 1686, 1920, 1920, 1686, 1920, 1920, 1692, - -3857, 2226, -181, -3857, -3857, -3857, 2485, 1699, -3857, -3857, - 110, 1694, 1609, -3857, -3857, 1474, 2068, 2027, -3857, -3857, - -169, -3857, -3857, -3857, -3857, -3857, -3857, -3857, -3857, -3857, - 2036, -3857, 1569, -3857, -3857, -3857, -3857, -3857, -3857, 76, - -3857, 1117, 2291, -3857, 16580, 1703, 2052, 2192, 1959, -3857, - -3857, -3857, 1442, -3857, -3857, 1710, 1712, 1714, -3857, -3857, - 1716, 937, 937, 1719, 1721, 1723, -3857, -3857, 1725, 937, - -3857, -3857, -3857, 1442, 1726, -3857, 1714, -3857, 2311, -3857, - 13666, -3857, -3857, 9674, -3857, -3857, -3857, 1729, 1731, 1732, - -3857, 18027, 17992, 18027, -3857, 88, 497, -3857, 2262, -3857, - -3857, 9674, -3857, 427, 1679, -3857, -3857, -184, -3857, 1750, - -3857, 937, -3857, 2322, -104, -3857, -3857, 618, -3857, -3857, - -3857, -3857, -3857, 1593, -3857, 971, 1959, 2323, -3857, 198, - -3857, 1879, -3857, -3857, 1676, 1679, -3857, -3857, 1593, 2320, - 1931, 2412, -3857, -3857, 1442, 1778, 1779, -3857, -3857, -3857, - 1592, -3857, 2215, -3857, 1549, 2499, -3857, -3857, -3857, -3857, - -3857, 2333, 1059, 13842, -3857, -3857, -3857, -3857, 1669, 1703, - -3857, -3857, -3857, -3857, -3857, 2215, 12269, 1555, 1559, 2337, - 277, -3857, 1769, 2129, -3857, -3857, -3857, 2338, 102, -3857, - -3857, -3857, 8987, -3857, -3857, 2406, -40, -3857, -3857, -3857, - 458, -3857, -3857, -3857, -3857, -3857, 2319, -3857, -3857, 1793, - -3857, -3857, 392, -3857, 1589, -3857, -3857, 1442, 11781, -142, - -3857, 807, -3857, 98, -3857, -3857, -3857, 1442, 1442, -3857, - -3857, -3857, 1767, 10995, -142, 2346, 14319, -3857, 1787, 2348, - 2517, -3857, 1459, -3857, 1507, -3857, -3857, 4319, 1800, -3857, - -3857, 1690, -3857, -3857, 2349, 1224, 2347, -143, -3857, 2263, - -3857, 2350, 1931, 1698, 2352, -3857, 2263, 1442, 2355, 1717, - -3857, -3857, 2268, 9674, 2316, -3857, -3857, -3857, -3857, -3857, - -3857, 2130, -3857, 458, -3857, -3857, -3857, 2011, -178, -3857, - 331, 2583, -3857, 150, -3857, 2364, 1554, 13114, -3857, 17992, - 1798, -3857, 2367, 2222, 14319, 1442, 1442, 2368, 13966, 1589, - -3857, -3857, 689, -3857, -3857, -3857, -3857, 8458, -3857, 2286, - -3857, -3857, 1477, -3857, 2369, 2434, -3857, -3857, 1442, -3857, - 2370, 2263, 1442, 1442, -3857, 1818, 1925, 2186, -3857, -3857, - 1982, 1822, -3857, 1827, -3857, -3857, -3857, 2494, -3857, 1440, - 8959, 1442, 1442, 2027, -3857, 2027, 1593, 1593, 2027, 1593, - 1593, 1442, 1593, 1593, -3857, 1855, -3857, 1222, -3857, -3857, - -3857, -3857, 2313, -3857, -3857, -3857, -3857, -3857, -3857, -3857, - -3857, -3857, -3857, -3857, -3857, -3857, -3857, -3857, 797, -3857, - 151, -3857, -3857, -3857, -3857, -3857, -3857, -3857, -3857, -3857, - 60, -3857, -3857, -3857, -3857, -3857, -3857, 1738, -43, -3857, - -3857, 223, -3857, -3857, 1974, -3857, -3857, 16580, 665, -3857, - -3857, 1658, -3857, 16580, -3857, -3857, -3857, 1217, 1844, 7915, - 41, 1442, -3857, 2486, 3575, -67, 1842, 17992, 17992, 11293, - -3857, -3857, 1744, 1746, 17992, 17992, 17992, 9674, 1753, 1848, - 9674, -3857, -3857, -3857, 14362, 2314, -3857, -3857, 1679, -3857, - 17992, -3857, 9674, 17992, -3857, -3857, 1252, -3857, 2273, 17992, - 17992, 17992, 17992, 17992, -3857, 1679, -3857, -3857, 2216, -3857, - 2060, 2219, -3857, -3857, 5171, -3857, 1442, 971, -3857, -3857, - -3857, -25, 858, 1442, -3857, -3857, -3857, -3857, -3857, 17992, - 2187, -3857, 1798, -3857, 17992, 1593, -3857, -3857, -3857, -3857, - 2000, -3857, -3857, -3857, -3857, -3857, -3857, -131, 1669, -3857, - 1766, -3857, 14319, -3857, -3857, -3857, -3857, -3857, 2138, 2389, - -3857, -3857, 12269, 341, 5066, -3857, 1188, 1817, 1775, 1059, - 1059, 1059, 1059, -3857, -3857, 14319, 14362, -3857, 1585, -3857, - -3857, 1180, -3857, -3857, 1781, -3857, 255, -3857, -3857, 670, - -3857, -3857, -3857, -3857, -3857, -3857, -3857, -3857, 12563, -3857, - -3857, -3857, 3124, -3857, -3857, -3857, 2234, -37, -3857, 2455, - 1888, 2377, -3857, -3857, -3857, -3857, -3857, -3857, -3857, -3857, - -3857, -3857, -3857, -3857, -3857, -3857, -3857, -3857, -3857, -3857, - -3857, -3857, -3857, -3857, -3857, -3857, -3857, -3857, -3857, -3857, - -3857, -3857, -3857, -3857, -3857, -3857, -3857, -3857, -3857, -3857, - -3857, -3857, -3857, -3857, -3857, -3857, -3857, -3857, -3857, -3857, - -3857, -3857, -3857, -3857, -3857, -3857, -3857, -3857, -3857, -3857, - -3857, -3857, -3857, -3857, -3857, -3857, -3857, -3857, -3857, -3857, - -3857, -3857, -3857, -3857, -3857, -3857, -3857, -3857, -3857, -3857, - -3857, -3857, -3857, -3857, -3857, -3857, -3857, -3857, -3857, -3857, - -3857, -3857, -3857, -3857, -3857, -3857, -3857, -3857, -3857, -3857, - -3857, -3857, 2027, -3857, -3857, -3857, -3857, -3857, -3857, -3857, - -3857, -3857, -3857, -3857, -3857, -3857, -3857, -3857, -3857, -3857, - -3857, -3857, -3857, -3857, -3857, -3857, -3857, -3857, -3857, -3857, - -3857, -3857, -3857, -3857, -3857, -3857, -3857, -3857, -3857, -3857, - -3857, -3857, -3857, -3857, -3857, -95, -3857, -3857, -3857, -3857, - -3857, -3857, -3857, -3857, -3857, -3857, -3857, -3857, -3857, -3857, - -3857, -3857, 11781, -3857, -95, -95, -95, -142, -3857, 1147, - 189, -3857, -3857, 2032, -3857, -3857, 2442, 2351, 2442, 2293, - 155, 17992, -3857, -3857, -118, 6999, -3857, -3857, 143, 15955, - -142, -3857, -3857, 1892, 458, -3857, -3857, 14362, -3857, -3857, - -3857, -3857, -3857, 1972, 1959, -3857, 1370, -3857, 2340, 2340, - -422, 1902, 1391, 1898, -3857, 1185, -3857, -3857, 1911, -3857, - -3857, -3857, -3857, -3857, -3857, -3857, 1931, -3857, -3857, -3857, - -3857, 2307, 5117, -3857, -3857, -3857, 2308, -3857, -3857, -3857, - 2000, 2474, -3857, -3857, 1442, 2474, 1442, 1803, 94, 1903, - -3857, -3857, 1679, -3857, 1904, -3857, -3857, 403, 1908, 1277, - -3857, -3857, 13322, -3857, 2633, 264, 159, -3857, -3857, -3857, - 1658, -3857, 253, 14319, -3857, -3857, 1013, 82, 1261, 17992, - -3857, -3857, -3857, 1442, 14319, -3857, 2522, 2379, 2380, -3857, - -3857, 14362, -3857, -3857, -3857, -3857, 9674, -3857, -3857, -3857, - -3857, -3857, 2644, 2324, -3857, -3857, -3857, 432, 2463, 2386, - 2463, 0, 882, -3857, 1914, 2022, 2075, 1849, 953, -3857, - -3857, -3857, 16832, 953, 2584, 1658, 1510, 1510, 1658, 25, - 1834, 1658, 2709, -3857, 2188, -3857, -3857, -3857, -3857, -3857, - -3857, -3857, -3857, -3857, -3857, 121, 145, 1923, -3857, 5874, - 1442, -3857, 1920, 1920, 1438, 1593, -3857, 1593, 1920, 1593, - 1593, 1920, 1593, 1593, -3857, 2584, 1959, 1959, 2098, 1593, - -3857, -3857, -3857, 797, -3857, -3857, -3857, -3857, 937, -3857, - -3857, 636, -3857, -3857, -3857, -3857, 2292, 90, 90, 733, - 1927, 1672, -3857, -3857, -3857, -3857, 2671, -3857, -3857, -3857, - 2201, -3857, -3857, -3857, -3857, 2201, -175, -3857, 1658, -3857, - -3857, -3857, -3857, -3857, 1658, -3857, -3857, 1658, -3857, 1658, - -3857, -3857, -3857, -3857, -3857, 87, -3857, -3857, -3857, 2641, - -3857, -3857, -3857, -3857, -3857, -3857, -15, -3857, -3857, -3857, - 2736, -3857, -3857, -3857, -3857, -3857, -3857, -3857, 2330, 2009, - 173, -3857, 2618, -362, -3857, -3857, -3857, -3857, -3857, 1672, - -3857, -3857, -3857, 1829, 1833, -3857, 9674, 1672, 2343, 1993, - 1995, 2218, -3857, -3857, -3857, -3857, -3857, 2275, -3857, -3857, - -3857, -3857, -3857, -3857, 256, -3857, 1442, 379, 1171, 1955, - 395, 1964, -3857, 410, -258, 9674, -3857, -3857, 366, 1965, - 1966, 1968, 424, -3857, 1679, -3857, 1970, -3857, 1442, 430, - 1975, 1959, 2419, 210, -3857, 265, 67, 458, 1361, 1976, - 435, -3857, 1979, 2216, 497, 497, -3857, -3857, -3857, 2027, - 2112, 1980, -184, -3857, -3857, 1278, 2759, 641, -3857, -3857, - 2115, 2146, -3857, 1182, 1658, -3857, -3857, 1165, -3857, 1878, - 957, -3857, -3857, -3857, 2383, -3857, -3857, 14319, -3857, -3857, - -3857, -3857, -3857, -3857, -3857, 62, -3857, -3857, 6294, -3857, - -3857, 2784, -118, -3857, -3857, -3857, -3857, -99, -3857, 1658, - -3857, 2, -118, -3857, -3857, -3857, -3857, -1, 1658, -3857, - -3857, -3857, 5066, -3857, -3857, 1188, -3857, -3857, 1679, 1442, - -3857, -3857, -3857, -3857, -3857, -3857, 2452, 210, 2453, 2354, - 1928, -3857, 4596, 2243, -3857, -3857, -3857, -3857, -3857, -3857, - 1885, 3124, -3857, -3857, -3857, -3857, -3857, 1686, -3857, -3857, - -3857, -3857, -3857, -3857, -3857, -3857, -3857, -3857, -3857, -3857, - -3857, -3857, -3857, -3857, -3857, -3857, -3857, 141, -3857, 1920, - -3857, -3857, -3857, 2562, -3857, 1686, -3857, -3857, -3857, -3857, - -3857, -3857, -3857, 2153, 1686, -3857, -3857, -3857, -3857, -3857, - 1442, -3857, 1442, 1442, 1442, -3857, 2001, -3857, -3857, 1679, - -3857, 2733, -3857, -3857, -3857, 428, -3857, 1147, 5030, -3857, - -3857, -3857, 1442, -3857, 1442, 104, 338, 2591, -3857, -3857, - 564, -3857, -3857, -3857, -3857, 14319, -3857, -3857, -3857, -3857, - -3857, -3857, -3857, -3857, -3857, -3857, -3857, -3857, -3857, -3857, - -3857, -3857, -3857, -3857, -3857, -3857, -3857, -3857, -3857, -3857, - -3857, -3857, -3857, -3857, -3857, -3857, -3857, -3857, -3857, -3857, - -3857, -3857, -3857, -3857, -3857, -3857, -3857, -3857, -3857, -3857, - -3857, -3857, -3857, -3857, -3857, -3857, -3857, -3857, -3857, -3857, - -3857, -3857, -3857, -3857, -3857, -3857, -3857, -3857, -3857, -3857, - -3857, -3857, -3857, -3857, -3857, -3857, -3857, -3857, -3857, -3857, - -3857, -3857, -3857, -3857, -3857, -3857, -3857, -3857, -3857, -3857, - -3857, -3857, -3857, -3857, -3857, -3857, -3857, -3857, -3857, -3857, - -3857, -3857, -3857, -3857, -3857, -3857, -3857, 458, 458, 210, - 2466, 1803, 2000, 1391, 2430, 9033, -8, 5154, 1442, -184, - 2002, -3857, -3857, -3857, -3857, -3857, -3857, -3857, -3857, -3857, - -3857, -3857, -3857, -3857, -3857, -3857, -3857, -3857, -3857, -3857, - -3857, -3857, -3857, -3857, -3857, -3857, -3857, -3857, -3857, 432, - 2308, 1442, -3857, -3857, -3857, -3857, 1442, 1021, 947, -3857, - 1916, -3857, 1919, -3857, 432, 65, 9674, 2267, 1242, 696, - -3857, 1959, 256, 2272, -3857, -3857, -3857, 14319, 1277, 1277, - 1277, 1277, 1277, 1277, 1277, 1277, 264, -3857, 868, 957, - -113, -3857, 2062, 2062, -3857, -3857, -3857, 17992, 17386, 1261, - -278, -3857, 2644, -3857, 1442, 1442, 210, 2477, 2027, 2017, - -3857, 2816, 1442, 861, -3857, -3857, 2000, 2828, -3857, -3857, - 1442, -3857, 2164, 2606, -3857, -3857, -3857, 2028, 2133, 2145, - 288, -3857, 1961, -3857, 2498, 1442, 1086, -3857, -3857, -344, - -331, -326, 579, 1067, -3857, 1954, -3857, -3857, -3857, -3857, - -3857, -3857, -3857, -3857, -3857, -3857, -3857, -3857, -3857, -3857, - -3857, -3857, 3809, -3857, 2175, -3857, 1074, -3857, 2405, -3857, - -3857, 1442, 2827, 2457, -3857, -3857, -3857, 883, -3857, -3857, - -3857, 1658, -3857, -3857, 17068, -3857, -3857, -3857, -3857, -3857, - -3857, -3857, -3857, -3857, -3857, -3857, -3857, -3857, -3857, -3857, - -3857, -3857, -3857, -3857, -3857, -3857, 1094, -127, 1244, 2516, - -3857, 2027, 1609, 288, 288, 1962, -186, 681, 2027, 1981, - 1658, -3857, -3857, -3857, -78, 1556, -3857, -3857, -3857, -3857, - 1834, 2343, 1931, 1686, -3857, -3857, -3857, 2148, 2343, 1658, - 2764, 405, -122, 945, 1803, -3857, -3857, -3857, 1658, 1658, - -3857, -3857, -3857, -3857, -3857, -3857, -3857, -3857, 2111, -3857, - 2417, -3857, -3857, -3857, -3857, -3857, -3857, -3857, -3857, -3857, - -3857, -3857, -3857, -3857, 2161, 2832, 288, -3857, 1593, 1593, - -3857, -3857, 1920, -3857, 1593, 1593, 1593, 988, 1593, -3857, - 1593, 797, -3857, 1738, 1658, 1658, 1977, -3857, 112, -3857, - -347, -303, 250, -3857, -3857, -3857, -3857, -3857, -3857, -3857, - -3857, 1684, 1442, 1806, -3857, -3857, -3857, 665, 665, -3857, - -3857, -3857, -3857, 665, 665, -175, 665, -3857, -3857, -3857, - 1658, 564, -3857, 564, -3857, -175, 2430, 1658, 2076, 817, - 2436, 2436, -3857, -3857, -3857, 1672, -3857, -3857, -3857, -3857, - -3857, -3857, 144, -3857, -3857, -3857, -3857, 1879, 14704, 1729, - 17610, 1729, -3857, 2077, -3857, -3857, 1442, 1729, 1729, 1729, - 9674, -3857, 1879, -120, 1729, -67, -3857, -3857, -3857, 2353, - 2149, 310, 2542, 210, 17850, 1729, 1729, 477, -3857, 2112, - -3857, 458, -3857, -3857, -3857, 2340, -3857, -3857, -3857, -3857, - -3857, 2385, -3857, -3857, -3857, 806, -3857, -3857, 17992, -3857, - -3857, -3857, -3857, 2358, 2488, 814, 1817, 1016, -3857, -3857, - -3857, -3857, -3857, -3857, -3857, -3857, -3857, -3857, 665, -3857, - -3857, 665, -3857, -3857, -3857, -3857, -92, 2663, 665, 564, - 564, 665, -3857, -3857, -3857, 3268, 3268, 458, -3857, 458, - -3857, -3857, -3857, -3857, -3857, -3857, -3857, -3857, 2880, -3857, - 2100, 11, 4596, -3857, -3857, -3857, -3857, -3857, 1442, -3857, - -3857, -3857, 2672, 2020, 1655, 199, 2021, -3857, -3857, -3857, - -3857, 477, 9674, -3857, -3857, 2829, -3857, 436, -3857, -3857, - 5030, -3857, 436, 2575, 2578, 2747, -19, -3857, -3857, 2189, - -3857, -3857, 2343, 1300, -3857, -3857, -3857, 14319, 458, -3857, - 458, 368, 1593, -3857, 1442, -3857, -3857, 3, -3857, -3857, - -3857, 2903, -3857, 2573, -3857, -3857, -3857, 260, 985, -3857, - -3857, -3857, -3857, 2382, 2680, 957, -3857, 1444, -3857, -3857, - 6124, -3857, 1919, 2261, -3857, -3857, -3857, -3857, -3857, -3857, - -3857, -3857, -3857, -3857, -3857, 70, -3857, 14319, -3857, -3857, - -3857, -3857, -3857, -3857, -3857, -3857, -3857, -3857, -12, -3857, - 1442, -3857, -3857, -3857, 1024, -3857, -3857, -3857, 17992, -3857, - 14319, 14319, 1171, -3857, 1445, -221, 2327, 14090, 1879, 1879, - -3857, 458, 2104, -3857, 477, -3857, 2362, -3857, 9674, -3857, - 2725, 2135, -3857, 947, -3857, 894, 2747, 2432, 2043, 9674, - 2837, 882, -3857, 2114, 2221, -3857, 2055, 1658, -3857, 2131, - -3857, -3857, -3857, -3857, -3857, -3857, -3857, -3857, -3857, -3857, - -3857, -3857, -3857, -3857, 2008, 3968, -3857, -3857, 2846, 2085, - 2127, -145, -3857, -3857, -3857, 1442, -3857, -3857, -3857, -3857, - 3988, -3857, 2905, -3857, 2644, -3857, 2223, 2223, 2030, -3857, - 2055, -3857, 2139, 2608, -3857, -3857, -3857, 1962, -3857, -3857, - -3857, -3857, -3857, -3857, 2504, 97, 2430, 447, 1658, -3857, - -3857, 1658, -3857, 1658, 1658, 2343, 1205, -3857, 1658, 1200, - 1658, 1658, 1658, 1658, -3857, 2260, -3857, 368, 681, 2027, - 1658, 1834, 2394, -3857, 2228, 681, 1593, 1593, 1593, 1593, - 1593, 1593, -3857, 2360, -3857, -3857, 2933, -3857, -3857, -3857, - -3857, -3857, -3857, 1658, 2217, 2397, -3857, -3857, -3857, 2767, - -3857, -3857, -3857, -3857, -3857, -3857, -3857, -3857, -3857, -3857, - -3857, -3857, -3857, -3857, -3857, 814, -3857, 1743, -3857, -3857, - 1442, 696, -3857, -3857, 2151, -3857, -3857, -3857, 1658, 1053, - -3857, -3857, -188, -3857, -3857, -3857, -3857, -3857, -3857, -3857, - -3857, -3857, -3857, 2615, -3857, -3857, -3857, 2611, -3857, -3857, - -3857, -3857, -3857, -3857, 2612, -3857, -3857, 1451, -3857, -3857, - -3857, -3857, -3857, -3857, -3857, 1585, 2754, -3857, -311, -3857, - -3857, -3857, -3857, -3857, -3857, -3857, -3857, -118, -118, -118, - -118, 14319, -3857, 1016, -3857, 7770, -3857, -3857, -3857, -3857, - 1959, -3857, -3857, -3857, -3857, -3857, -3857, 1095, 665, 2485, - -3857, -3857, -3857, 11195, -3857, -3857, -3857, 596, -3857, -3857, - -3857, -3857, 3836, 11195, 210, 2312, 210, 2315, 95, 4596, - -3857, -3857, -3857, -3857, -3857, 2880, -3857, -3857, -3857, -3857, - 1655, -3857, 2786, -3857, -3857, 1686, -3857, 436, -3857, -3857, - 436, 477, 2154, 2154, -3857, 2956, 2918, -3857, -3857, -3857, - 2430, -3857, 2479, 2769, 68, -3857, -3857, 2415, -3857, -3857, - 210, 2414, 2414, 2423, -3857, 675, -3857, 2729, -3857, -3857, - -3857, 1442, 14319, 1920, 2523, 2564, -3857, 753, -3857, -3857, - -3857, 301, -3857, -3857, -3857, 2801, 2471, -3857, -3857, -3857, - -3857, -3857, -3857, -3857, 2528, -3857, -3857, -3857, 2545, -3857, - 1959, 1959, -3857, -3857, -3857, -3857, -3857, -3857, -3857, 1171, - -3857, -3857, -3857, -3857, -3857, -3857, -3857, 2451, 2166, 1658, - -3857, -3857, -3857, -188, 2615, 210, 2121, -3857, -3857, 2816, - -3857, 2430, 2747, 2430, -221, 1344, -3857, -3857, 1786, -3857, - -3857, 1803, 2387, -3857, 121, -3857, 882, -3857, 882, -3857, - 2182, -3857, -3857, -3857, -3857, -3857, -3857, -3857, -3857, -3857, - 2197, -3857, 2055, -3857, 1872, 1442, -3857, -3857, -3857, -3857, - -3857, -3857, -3857, -3857, -3857, 1002, -3857, -3857, 2546, -3857, - -3857, -3857, -3857, -3857, -3857, -3857, -3857, -3857, -3857, -3857, - -3857, -3857, -3857, 2430, 2659, 2194, 2027, 2194, 2264, 2094, - -3857, -3857, -3857, -3857, -3857, 2554, -3857, 814, 390, 2764, - -3857, -3857, -3857, 2055, 2027, 188, 1442, -3857, -3857, -3857, - -3857, 2027, -3857, 1700, -3857, -3857, -3857, -3857, -3857, -3857, - -3857, -3857, 824, 824, 39, 1442, 1658, -3857, -3857, 2150, - -3857, 1442, -3857, -3857, 681, -3857, 1442, 1442, -3857, -3857, - -3857, -3857, 2901, 1438, 1442, 1658, 1442, -43, -3857, 681, - 2205, 1593, -3857, 2027, -3857, 797, 35, 1216, 1143, 1658, - -3857, -3857, 2099, 2195, -3857, -3857, -3857, -3857, -3857, -3857, - -3857, -3857, -3857, 696, -3857, -3857, 2623, 2811, -3857, 1928, - -3857, -3857, -3857, 3268, 14319, 14319, 14319, 14319, -3857, -3857, - -3857, -3857, -3857, 1442, -3857, -118, -3857, -3857, -3857, -3857, - 2207, 997, -3857, -3857, 458, -3857, 458, 13059, -3857, 1124, - 51, -3857, -3857, -3857, -3857, -3857, 2934, 2824, -3857, -3857, - 436, -3857, 14319, 14319, -3857, -3857, 1442, 2479, 1959, 2239, - -3857, 2413, 1593, 5, 1442, -3857, -3857, -3857, -3857, -3857, - -3857, 138, -3857, -3857, -3857, -3857, -3857, 2511, -3857, -203, - -3857, -3857, 2512, 1105, -3857, -3857, -3857, 2948, 2569, -3857, - 1658, 1553, -3857, -3857, -86, 2570, 2572, -3857, -3857, -3857, - -3857, -3857, -3857, -3857, -3857, -3857, -3857, -3857, -3857, 1593, - 1593, -3857, -3857, -3857, -3857, -3857, -3857, 1442, -3857, 2811, - -3857, -3857, -3857, 2224, -3857, 1442, -3857, 1442, -3857, -3857, - -3857, -3857, -3857, 2500, 2758, -3857, -3857, -3857, -3857, 177, - -387, 2427, -3857, -3857, -3857, -3857, -3857, 357, -366, -3857, - -3857, 1959, -3857, -3857, 2055, -3857, -3857, -3857, -3857, -3857, - -3857, -3857, -3857, -3857, -3857, -3857, 2132, 2027, 2230, -3857, - 2839, -3857, 2843, 1658, -3857, -3857, -3857, -3857, 2281, -3857, - -3857, -3857, -3857, -3857, -3857, -3857, -3857, -3857, 1442, 58, - 2901, 1383, -3857, -3857, -3857, -3857, -3857, -3857, -3857, -3857, - -3857, 1442, -3857, -3857, -3857, -3857, 2703, -3857, -3857, -3857, - -3857, 3036, -3857, -3857, -3857, -3857, -3857, -3857, -3857, 585, - 918, -3857, -3857, -3857, -3857, -3857, 164, -317, -3857, -3857, - -3857, 1442, 268, 1658, -3857, 655, 1609, 2246, 681, -3857, - -3857, 2556, 3033, -3857, -3857, -3857, 1058, -208, -3857, -3857, - -3857, -3857, 696, 2623, -188, -40, 11195, -3857, -3857, -3857, - -3857, -3857, 1442, -118, -3857, -3857, -188, -188, -3857, -3857, - 14319, -3857, -3857, -3857, -3857, 14319, -3857, -3857, -3857, -3857, - -3857, 2239, 1442, 1442, 1226, 1658, 1593, 1593, 2447, -3857, - -3857, -3857, 2490, -3857, -3857, -3857, -3857, -3857, -3857, 2376, - -3857, -3857, -3857, -3857, 6378, 2199, -3857, 1442, -3857, -3857, - 2382, 2680, -3857, -3857, -3857, -3857, -3857, -3857, -188, 1137, - -3857, -3857, -3857, -3857, -3857, -3857, -3857, -3857, -3857, 2565, - 177, -3857, 125, 2155, -3857, -3857, 1658, -3857, 2439, 776, - -3857, 2341, -3857, 2242, 1442, -3857, -3857, -3857, 2027, 2678, - 1920, 1920, 290, 2027, -3857, 681, 681, -3857, -3857, -3857, - -3857, 2740, -3857, -3857, 2139, 2027, -317, 1442, 1692, -3857, - -3857, -3857, -3857, 1442, -3857, -3857, -3857, -3857, -3857, 1658, - -3857, 2493, -3857, -3857, -3857, 820, 244, 820, -3857, 1609, - 1658, 1658, 1609, 681, -3857, 1658, 1658, -3857, -3857, 2597, - -3857, 133, 2269, 696, -3857, -29, 283, -3857, 14319, -3857, - -3857, -3857, -3857, -3857, -3857, -3857, -3857, 1442, -3857, 1658, - 1442, -3857, -3857, -3857, -3857, -3857, 2543, 2796, -184, 1593, - 1658, -3857, -3857, -3857, -3857, 9674, -3857, -3857, -3857, -3857, - 6124, -3857, -3857, -3857, -3857, -3857, -3857, -3857, -3857, -3857, - -3857, -3857, 1784, -3857, -3857, -3857, 1595, -3857, 1690, 2475, - 2897, 1658, 2479, -3857, -3857, 9674, -3857, -3857, -3857, -184, - 50, 1589, -3857, 14976, -3857, -3857, 776, 2276, 2278, 1658, - -3857, -3857, 290, 1442, 1442, 2644, -3857, 2705, -3857, 338, - 2343, 1359, -3857, -3857, -3857, 3055, 2901, -3857, -39, -3857, - -3857, -3857, -3857, -3857, -39, -3857, 1442, 1442, -111, -3857, - -3857, 2411, -3857, 2628, -3857, -3857, 1609, 1609, -3857, -3857, - -3857, -3857, 2366, -6, 696, -3857, -3857, -3857, -3857, -3857, - 2574, -21, 1959, -3857, -3857, -3857, -3857, -3857, 1442, -3857, - 1226, -3857, 276, -3857, -3857, -3857, -3857, -3857, -3857, -3857, - -3857, -184, -3857, 1679, -3857, -3857, 2443, 2361, -3857, 2288, - 15, 1920, 9674, 2266, -3857, -3857, -3857, -3857, -237, -3857, - 2294, 2034, 2300, -3857, -3857, 357, -3857, 290, -3857, -3857, - -3857, -3857, 1658, 338, 681, 2911, 2493, 996, 1658, -3857, - -3857, -3857, -3857, -3857, 2561, -3857, -3857, 35, 1216, -3857, - -3857, 1658, 2926, -3857, -3857, -3857, -3857, -3857, -3857, -3857, - -3857, 1442, -3857, -3857, -3857, -3857, 1442, -3857, 1642, 1593, - 2301, -3857, -3857, -3857, 147, 2626, 1959, 2344, 1294, 481, - 56, 166, -3857, -3857, 2425, -3857, -3857, -3857, 1977, -3857, - -3857, -3857, -3857, -3857, 1920, -3857, 2356, -3857, 2900, 1442, - 1297, 2630, 3106, -175, 2321, -3857, -3857, -3857, -3857, 2520, - -3857, 1593, 1263, 147, -3857, -3857, 1658, -3857, 1442, 208, - -3857, -3857, -3857, -3857, 2593, 2848, 195, 2720, 2721, 2942, - 2711, -3857, 481, -3857, 1350, 870, 2331, 230, 17466, 564, - -3857, -3857, -3857, 1977, -3857, 1442, 2248, -3857, -3857, -3857, - 1536, -3857, -3857, 849, 1658, 1658, -3857, -3857, -3857, 1920, - -3857, -3857, -3857, 2594, 1442, -3857, 9674, 1442, -3857, 1658, - 1028, 852, 208, -3857, -3857, 1294, -3857, -3857, -3857, -3857, - -3857, -3857, 1658, 2598, 1442, 1658, 1658, 1658, 1658, -3857, - 2734, 52, 2735, -3857, 2722, -3857, 1754, -3857, -3857, 1442, - 2989, 1287, 2737, 63, 2739, 2728, -3857, 979, -3857, -3857, - 1442, 2372, -3857, 288, 288, 1864, -3857, -3857, -3857, -3857, - 2808, 3047, -94, -3857, 1658, -3857, -3857, -3857, -3857, 791, - -3857, 2201, 2201, 1658, -118, 2, 1658, 5117, -3857, -3857, - -3857, -3857, 2201, -118, -3857, 2941, 2027, -3857, 3065, -3857, - -3857, -118, -3857, -3857, 1442, -3857, -3857, 1442, -3857, -3857, - -3857, -3857, -3857, -3857, -3857, -3857, -3857, -3857, -3857, 2820, - 2201, -3857, -3857, -3857, -3857, -3857, -3857, 132, 849, -3857, - -3857, 1609, 1609, 14, -3857, -3857, -3857, -3857, 320, -3857, - -3857, -3857, 320, 320, -3857, -3857, -3857, -3857, -3857, -3857, - 2616, -3857, -3857, -3857, 1442, 2027, -3857, 1442, 1442, 1442, - 1442, 1658, 1658, 1658, 1658, 1658, -3857, 1442, 1658, 1658, - 1658, 1658, 1658, 1658, 1658, 1658, 1658, 1658, 1658, -3857, - 1442, 1658, -3857, -3857, 288, 288, 711, 2743, -3857, 1658, - -3857, -3857, 1442, 1442, -3857, -3857, 665, -3857, -3857, -3857, - 1658, -3857, 1658, 665, 564, -3857, -3857, 665, -3857, -3857, - 665, 2194, 1658, 564, -3857, -3857, -3857, -3857, 10148, 1569, - -3857, -3857, -3857, -3857, -3857, -3857, -3857, -3857, -3857, -3857, - -3857, -3857, 1593, -3857, -3857, -3857, -3857, 852, -3857, 2194, - -3857, -3857, -3857, -3857, 1442, 1442, 1442, 1442, 1442, 1442, - 1442, 1442, 1442, 1442, 1442, 1442, 1442, 1442, 1442, 1442, - 1442, 1442, 1442, -3857, -3857, -3857, -3857, -3857, 1542, -3857, - -3857, -3857, 15377, -3857, 814, 1442, -3857, -3857, 1035, 1035, - -3857, -3857, -3857, -3857, -3857, 160, -3857, 814, -3857, -3857, - -3857, -3857, -3857, -3857, 2705, -3857, -3857, -3857, -3857, -3857, - 1442, -3857, -3857, -3857, -3857, -3857, -3857, -3857, -3857, -3857, - -3857, -3857, 1442, -3857, 1917, 760, 778, -3857, -3857, 711, - 2374, -3857, -3857, -3857, -3857, -3857, -3857, -3857, -3857, -3857, - -3857, -3857, 665, -3857, -3857, 665, -3857, -3857, -3857, -3857, - -3857, -3857, -3857, 1442, 1442, 266, 1658, 1658, 1905, 1658, - -3857, -3857, -3857, -3857, -3857, -3857, -3857, 1895, -3857, -3857, - -3857, -3857, 1442, -3857, -3857, -3857, 1658, 711, 711, -3857, - 2806, 1658, 1658, 711, 16456, 1442, 711, -3857, -3857, -3857, - 711, 711, -3857, -3857, -3857, -3857, 2785, 1764, 2709, 1658, - 2027, -3857, 1658, 1959, -3857, 1658, 1442, -3857, -3857, -3857, - -3857, -3857, -3857, -3857, -3857, -3857, -3857, -3857, -3857, 109, - -3857, -3857, 893, -3857, 903, -3857, -3857, -3857, -3857, 1764, - 1442, -3857, -3857, -3857, -3857, -3857, -3857, -3857, 288, -3857, - 1397, 2230, 18171, 18171, 1546, 2836, 2679, 2679, 1922, 6124, - -3857, -3857, 893, -49, -3857, -3857, -3857, 2027, -49, -3857, - 309, 1442, -3857, -3857, -3857, -3857, -3857, -3857, 2027, -3857, - 2194, 1879, 16392, -3857, -3857, 1656, 1683, -3857, -3857, 1722, - -3857, -3857, -3857, -3857, 17, 17, -3857, -3857, -3857, -3857, - 18171, -3857, 869, 869, 2679, 2679, -3857, -3857, -3857, -3857, - -3857, -3857, -3857, -3857, 288, -3857, 1442, -3857, 2843, -3857, - 1920, 1442, -3857, -3857, -3857, -3857, -3857, -3857, -3857, -3857, - -3857, -93, 137, 3103, -3857, -3857, -3857, 869, -3857, -3857, - 2613, 2619, -3857, -3857, 2418, -81, -3857, 2627, -3857, 2627, - -3857, 2627, -3857, 2627, 18171, -3857, -3857, -3857, 2027, -3857, - -3857, -3857, -3857, 2620, -3857, -3857, -3857, -3857, -3857, -3857, - -3857 -}; - - /* YYDEFACT[STATE-NUM] -- Default reduction number in state STATE-NUM. - Performed when YYTABLE does not specify something else to do. Zero - means the default is an error. */ -static const yytype_uint16 yydefact[] = -{ - 2, 0, 12, 1, 3, 5, 27, 4, 58, 31, - 30, 27, 8, 10, 11, 0, 28, 0, 0, 13, - 81, 9, 35, 32, 58, 58, 0, 61, 0, 24, - 84, 0, 0, 16, 0, 29, 3009, 59, 67, 0, - 436, 0, 250, 86, 0, 0, 20, 14, 17, 18, - 22, 15, 3010, 0, 0, 69, 82, 0, 25, 439, - 437, 0, 0, 80, 252, 0, 0, 0, 3076, 3009, - 3009, 3009, 0, 0, 0, 0, 3009, 0, 0, 2971, - 247, 164, 83, 87, 88, 90, 91, 94, 92, 93, - 0, 147, 150, 151, 152, 213, 153, 155, 154, 156, - 157, 158, 159, 160, 161, 162, 163, 38, 37, 41, - 41, 0, 19, 0, 63, 64, 65, 66, 62, 3040, - 3009, 74, 0, 1332, 0, 441, 85, 0, 0, 254, - 2647, 2646, 175, 232, 3009, 3077, 3009, 0, 0, 0, - 3009, 3009, 101, 131, 0, 95, 145, 2972, 0, 0, - 3009, 3009, 89, 149, 146, 148, 0, 212, 0, 55, - 33, 40, 39, 0, 0, 3041, 3009, 0, 0, 0, - 438, 0, 26, 1327, 1380, 0, 434, 251, 253, 393, - 181, 2990, 3009, 0, 0, 0, 2750, 243, 2635, 241, - 246, 0, 0, 103, 133, 245, 97, 580, 223, 224, - 3009, 2648, 215, 216, 3014, 219, 0, 2759, 2184, 2183, - 165, 169, 172, 3055, 3009, 0, 214, 42, 0, 56, - 0, 3009, 21, 23, 0, 71, 73, 72, 70, 3009, - 60, 1328, 0, 0, 440, 447, 448, 561, 442, 564, - 0, 0, 2847, 255, 249, 396, 176, 177, 179, 0, - 0, 233, 234, 244, 239, 3128, 3129, 0, 237, 0, - 2970, 3083, 3066, 3009, 129, 102, 3065, 107, 109, 110, - 111, 112, 3065, 0, 2973, 0, 0, 132, 0, 136, - 96, 99, 225, 0, 217, 3016, 3015, 220, 0, 248, - 3055, 3058, 3057, 0, 0, 166, 170, 36, 57, 0, - 45, 0, 2854, 2855, 2856, 2857, 2858, 2859, 2860, 2861, - 68, 0, 1595, 0, 1449, 1560, 1570, 1578, 1585, 1641, - 1647, 2253, 1662, 1668, 1677, 1673, 1685, 1695, 1824, 1833, - 1835, 1841, 1874, 1885, 1888, 1891, 1883, 1898, 1909, 1931, - 1935, 1939, 0, 1995, 1997, 2003, 2007, 0, 2013, 2047, - 2074, 2076, 2081, 2111, 2112, 2128, 2131, 2132, 2137, 2253, - 2147, 2160, 2173, 2214, 2232, 0, 2273, 2289, 2298, 2300, - 1362, 2304, 2307, 2310, 2327, 2366, 0, 1382, 1383, 1384, - 1385, 1386, 1387, 1388, 1389, 1391, 1390, 1392, 1394, 1393, - 1395, 1396, 1397, 1398, 1399, 1400, 1401, 1402, 1403, 1404, - 1405, 1406, 1407, 1408, 1409, 1410, 1411, 1412, 1413, 1414, - 1415, 1416, 1417, 1418, 1419, 1420, 1421, 1422, 1423, 1424, - 1425, 1426, 1427, 1428, 1429, 1430, 1431, 1432, 1433, 1434, - 1435, 1436, 1437, 1438, 1439, 1440, 1441, 1442, 1443, 1444, - 1445, 1446, 1381, 0, 508, 443, 2830, 0, 2617, 444, - 395, 0, 2848, 0, 0, 423, 3050, 406, 394, 0, - 399, 401, 402, 414, 403, 404, 3009, 3009, 182, 183, - 2768, 2764, 2769, 2767, 2765, 2770, 2766, 235, 228, 230, - 3108, 238, 0, 2751, 242, 3084, 3009, 0, 106, 108, - 104, 130, 3065, 3009, 2974, 114, 0, 0, 143, 41, - 0, 41, 0, 134, 137, 0, 0, 0, 2779, 2775, - 2780, 2778, 2776, 2781, 2777, 226, 2771, 2773, 2760, 218, - 221, 0, 3056, 173, 167, 168, 171, 34, 46, 49, - 53, 54, 52, 3065, 47, 48, 76, 77, 78, 79, - 75, 1599, 1602, 1601, 1597, 1598, 1600, 1589, 1596, 2872, - 2873, 2874, 2875, 2876, 2877, 2878, 2879, 2880, 2881, 2882, - 2883, 2884, 2870, 2923, 2924, 2925, 2926, 2927, 2928, 2929, - 2930, 2931, 2932, 2933, 2934, 2935, 2936, 2937, 2938, 2939, - 2940, 2941, 2942, 2943, 2944, 2945, 2885, 2886, 2887, 2888, - 2889, 2890, 2891, 2892, 2893, 2894, 2896, 2895, 2897, 2898, - 2899, 2900, 2901, 2902, 2903, 2904, 2905, 2906, 2907, 2908, - 2909, 2910, 2911, 2912, 2913, 2914, 2915, 2916, 2917, 2868, - 2918, 2919, 2920, 2921, 2922, 1448, 2869, 2871, 1480, 0, - 0, 0, 1595, 0, 0, 2255, 1667, 2254, 0, 1670, - 0, 0, 1690, 1736, 0, 1690, 0, 1595, 2539, 1876, - 0, 0, 3099, 1626, 1625, 0, 1897, 0, 0, 0, - 0, 0, 1978, 1990, 0, 0, 0, 0, 1447, 2018, - 2526, 0, 0, 0, 0, 0, 0, 0, 2146, 0, - 0, 0, 0, 0, 2252, 2269, 2272, 2256, 2270, 2531, - 2271, 2258, 2267, 2259, 2268, 2736, 2740, 2276, 0, 2299, - 2297, 0, 1380, 0, 0, 0, 0, 0, 2382, 2428, - 0, 0, 800, 0, 0, 0, 566, 0, 0, 570, - 571, 569, 0, 446, 449, 2849, 256, 3050, 3099, 3099, - 3048, 3050, 3050, 3099, 3050, 3050, 3099, 3050, 3050, 2987, - 3051, 2985, 0, 407, 408, 409, 2952, 0, 397, 400, - 0, 0, 0, 229, 227, 0, 0, 0, 123, 105, - 2752, 115, 138, 139, 142, 144, 140, 141, 135, 98, - 0, 2772, 0, 222, 174, 51, 44, 50, 1590, 1334, - 1479, 2750, 1558, 1451, 1490, 0, 3038, 1478, 3048, 2806, - 2804, 2807, 0, 2800, 2808, 0, 0, 2814, 3145, 3146, - 0, 2600, 2602, 0, 0, 0, 2803, 2670, 0, 2604, - 2805, 2809, 2810, 0, 0, 2802, 2814, 2801, 1568, 2664, - 1566, 2656, 2659, 0, 2658, 2662, 2663, 2811, 0, 0, - 2671, 0, 0, 0, 1571, 0, 2589, 2592, 2594, 2597, - 2680, 0, 2599, 2836, 2678, 2679, 2632, 1579, 1580, 0, - 2628, 2630, 2629, 1639, 2526, 2709, 1646, 1642, 1643, 1645, - 2708, 1658, 1648, 1649, 1650, 1653, 3048, 1665, 2744, 0, - 2606, 2850, 2651, 2743, 2748, 2652, 1671, 1669, 0, 1683, - 3069, 2977, 1674, 2741, 1676, 3093, 0, 1692, 1694, 1686, - 0, 1733, 1767, 1766, 2775, 2965, 1715, 1765, 1758, 1764, - 1757, 1822, 2453, 2654, 1710, 1712, 1702, 1703, 1716, 0, - 1704, 1705, 1754, 1706, 1707, 1767, 1709, 0, 2658, 1831, - 0, 1834, 0, 0, 1836, 1848, 1847, 1872, 0, 1844, - 1846, 2538, 3009, 1878, 1882, 1880, 1883, 1881, 1875, 1886, - 1887, 2649, 1889, 1890, 3100, 1892, 2626, 1884, 2537, 1903, - 2536, 1910, 1912, 2619, 1932, 1933, 1021, 1773, 0, 0, - 1936, 1020, 1940, 0, 1942, 1943, 1944, 0, 0, 1996, - 2218, 2729, 2730, 2845, 0, 2001, 0, 2004, 0, 2011, - 0, 2019, 2014, 2015, 0, 2994, 2048, 2060, 0, 2618, - 2075, 0, 2077, 2079, 2109, 2842, 2126, 0, 2129, 2369, - 2609, 2135, 3069, 0, 2144, 2610, 2369, 0, 2158, 2151, - 2612, 2161, 2164, 0, 0, 2622, 2174, 2175, 2176, 2177, - 2178, 2179, 2205, 2180, 2208, 2181, 2182, 0, 0, 2620, - 0, 0, 2728, 2748, 2215, 2250, 2237, 2260, 2530, 0, - 2738, 2739, 2287, 0, 0, 0, 0, 2295, 0, 2301, - 2302, 1368, 1374, 1363, 1364, 1365, 1367, 0, 2305, 0, - 2732, 2308, 3071, 2711, 2325, 2313, 2710, 2712, 2328, 2329, - 2380, 2369, 0, 0, 562, 0, 0, 803, 613, 616, - 0, 0, 567, 0, 577, 578, 572, 579, 575, 3009, - 0, 0, 0, 0, 3049, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 2988, 3091, 2986, 0, 312, 431, - 313, 2953, 2989, 398, 188, 187, 208, 204, 2752, 209, - 193, 207, 205, 185, 186, 206, 178, 184, 195, 196, - 198, 190, 191, 192, 180, 189, 337, 236, 231, 240, - 0, 126, 128, 127, 124, 125, 2640, 0, 2989, 100, - 2774, 0, 1337, 1335, 1356, 1559, 1450, 1490, 2960, 2962, - 1495, 3009, 1476, 1491, 1492, 1494, 1496, 0, 0, 2979, - 0, 0, 3039, 0, 0, 0, 0, 0, 0, 0, - 2798, 2820, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 2799, 1569, 1561, 0, 0, 2657, 2665, 2666, 2667, - 0, 2786, 0, 0, 2596, 2677, 0, 2595, 2838, 0, - 0, 0, 0, 0, 2681, 2682, 2683, 2837, 1574, 1581, - 1583, 0, 1640, 1586, 1605, 1644, 0, 1653, 3141, 3142, - 1651, 0, 1654, 0, 1666, 1663, 3123, 3122, 2607, 0, - 2852, 2608, 2746, 2747, 0, 1680, 1681, 1684, 1678, 3070, - 2094, 2978, 1675, 2742, 3094, 1691, 1693, 1688, 1716, 1768, - 0, 2966, 0, 1823, 1696, 1377, 1377, 1701, 2459, 2456, - 1711, 1708, 2655, 3107, 0, 1735, 0, 1769, 0, 2453, - 2453, 2453, 2453, 1832, 1825, 0, 0, 1837, 1589, 1873, - 1842, 2539, 1859, 1843, 1850, 1851, 1377, 2555, 2553, 3010, - 2559, 2556, 2548, 2552, 2550, 2551, 2547, 2549, 2540, 2541, - 2554, 2543, 0, 1879, 1877, 2650, 0, 1895, 1904, 1905, - 1914, 0, 1934, 1772, 1105, 1133, 1102, 1183, 1118, 1117, - 1182, 1184, 1206, 1185, 1169, 1252, 1286, 1202, 1231, 1205, - 1228, 1274, 1177, 1200, 1196, 1203, 1226, 1272, 1104, 1107, - 1213, 1210, 1103, 1209, 1208, 1258, 1130, 1212, 1131, 1287, - 1135, 1195, 1224, 1075, 1221, 1248, 1239, 1276, 1073, 1249, - 1259, 1222, 1157, 1159, 1158, 1225, 1260, 1261, 1262, 1263, - 1121, 1122, 1251, 1214, 1216, 1215, 1077, 1220, 1155, 1236, - 1129, 1238, 1245, 1246, 1137, 1139, 1250, 1142, 1082, 1234, - 1074, 1180, 1156, 1128, 1099, 1257, 1098, 1101, 1100, 1255, - 1247, 1223, 1207, 1268, 1243, 1244, 1179, 1265, 1266, 1267, - 1256, 1271, 0, 1132, 1233, 1229, 1232, 1264, 1219, 1230, - 1138, 1171, 1201, 1197, 1193, 1204, 1227, 1269, 1270, 1237, - 1140, 1141, 1106, 1273, 1134, 1178, 1136, 1217, 1218, 1254, - 1170, 1172, 1072, 1143, 1160, 1181, 1253, 1285, 1211, 1076, - 1194, 1235, 1176, 1199, 1198, 2995, 1032, 1047, 1048, 1049, - 1050, 1051, 1052, 1053, 1054, 1055, 1056, 1057, 1058, 1059, - 1060, 1061, 1937, 1291, 2995, 2995, 2995, 1938, 1294, 0, - 1965, 1949, 1941, 1946, 1947, 1948, 1988, 0, 1988, 0, - 2222, 0, 2731, 2846, 3011, 1999, 1025, 1027, 3017, 0, - 2000, 2002, 1998, 0, 0, 2012, 2008, 0, 2016, 2023, - 2020, 2022, 2021, 2024, 3048, 2062, 2632, 2714, 2528, 2528, - 0, 2058, 0, 0, 2713, 2629, 583, 2715, 0, 2527, - 2080, 2078, 2110, 2082, 2843, 2844, 3069, 2127, 2113, 2115, - 2116, 0, 0, 2130, 2136, 2133, 2084, 2611, 2145, 2138, - 2094, 2153, 2159, 2148, 0, 2153, 0, 3107, 2162, 0, - 2697, 2703, 2704, 2705, 0, 2206, 2209, 0, 0, 0, - 2621, 2186, 0, 2185, 0, 0, 2746, 2251, 2233, 2239, - 3009, 2240, 2235, 0, 2257, 2262, 0, 2584, 2582, 0, - 2737, 2288, 2274, 0, 2277, 2278, 2281, 0, 0, 2296, - 2290, 0, 2303, 1369, 1373, 1366, 0, 3072, 3073, 2309, - 2326, 2311, 2967, 0, 2330, 2381, 2367, 2371, 2426, 0, - 2426, 2432, 564, 509, 0, 0, 806, 0, 662, 2830, - 568, 574, 3009, 581, 2975, 3009, 0, 0, 3009, 2975, - 3040, 3009, 2950, 445, 0, 450, 453, 454, 455, 456, - 457, 458, 459, 460, 461, 0, 0, 0, 257, 3069, - 410, 2633, 3050, 3050, 0, 418, 2613, 411, 3050, 412, - 420, 3050, 413, 422, 3092, 2975, 3048, 3048, 0, 0, - 194, 197, 200, 0, 3136, 3138, 3137, 113, 2754, 2753, - 116, 0, 2752, 1593, 1594, 1592, 0, 1342, 1342, 0, - 0, 2440, 2718, 1507, 2716, 2717, 0, 1493, 3119, 3118, - 3044, 3121, 3120, 1505, 1506, 3044, 0, 1511, 3009, 1525, - 1526, 1527, 1513, 1515, 3009, 2980, 1516, 3009, 1557, 3009, - 1518, 1521, 1519, 1520, 1522, 0, 1551, 1552, 1529, 1531, - 3068, 1532, 1555, 1553, 1554, 1523, 3101, 1534, 1524, 1512, - 2948, 1536, 1556, 1539, 1497, 1528, 1533, 1538, 0, 0, - 0, 2690, 0, 1485, 1489, 1488, 1481, 1477, 1472, 2440, - 3115, 3114, 1469, 1460, 1462, 1463, 0, 2440, 3024, 0, - 0, 0, 1503, 1453, 1458, 1457, 1467, 0, 1475, 1455, - 1474, 1456, 2694, 2693, 0, 2669, 0, 2584, 2582, 0, - 2584, 0, 2816, 2584, 0, 0, 2601, 2603, 2584, 0, - 0, 0, 2584, 2674, 2675, 2676, 0, 2605, 0, 2584, - 0, 3048, 2744, 2480, 1567, 2748, 2652, 0, 0, 0, - 2584, 2598, 2840, 1574, 2588, 2587, 2591, 2590, 2593, 0, - 1576, 0, 0, 2631, 1587, 0, 1603, 1660, 1652, 1657, - 0, 0, 2653, 2480, 3009, 2851, 2745, 0, 1682, 2989, - 2516, 2095, 2096, 1687, 0, 1734, 1759, 1743, 2458, 1378, - 2461, 2454, 2460, 2455, 2457, 0, 1725, 1724, 1713, 1720, - 1722, 0, 3011, 1810, 1811, 1812, 1799, 0, 1802, 3009, - 1803, 2983, 3011, 1806, 1807, 1813, 1808, 3101, 3009, 1809, - 1816, 1814, 1717, 1718, 1742, 1737, 1738, 1740, 1741, 0, - 1755, 1762, 1699, 1700, 1697, 1698, 0, 2480, 0, 0, - 1609, 1845, 0, 1859, 1852, 1849, 1854, 1855, 1861, 1853, - 0, 2558, 2542, 2569, 2570, 2571, 2560, 3099, 2577, 2580, - 2579, 2581, 2573, 2566, 2568, 2567, 2572, 2574, 2576, 2578, - 2544, 2561, 2562, 2563, 2564, 2565, 2625, 1895, 2623, 3050, - 1893, 2627, 1906, 1907, 1377, 3099, 1922, 1923, 1925, 1927, - 1928, 1924, 1926, 1917, 3099, 1913, 1031, 1290, 2996, 2997, - 0, 1292, 0, 0, 0, 1295, 0, 2749, 2699, 2700, - 1966, 0, 1968, 1967, 1969, 1951, 1961, 0, 0, 1945, - 1989, 1979, 0, 1991, 0, 2224, 0, 0, 3012, 3013, - 0, 1026, 3019, 3018, 3020, 0, 1067, 1192, 1153, 1097, - 1163, 1083, 1186, 1161, 1111, 1079, 1191, 1278, 1188, 1174, - 1108, 1175, 1173, 1144, 1146, 1149, 1109, 1162, 1116, 1165, - 1114, 1154, 1151, 1065, 1166, 1187, 1078, 1120, 1241, 1279, - 1091, 1148, 1085, 1092, 1112, 1084, 1167, 1281, 1168, 1080, - 1127, 1282, 1064, 1071, 1094, 1124, 1125, 1095, 1110, 1068, - 1069, 1126, 1062, 1147, 1093, 1283, 1150, 1189, 1070, 1277, - 1240, 1284, 1242, 1096, 1113, 1145, 1063, 1190, 1280, 1081, - 1115, 1123, 1090, 1275, 1088, 1089, 1164, 1152, 1086, 1087, - 1119, 1066, 1030, 1033, 1034, 1035, 1036, 1037, 1038, 1039, - 1040, 1041, 1042, 1043, 1044, 1045, 1046, 0, 2005, 2480, - 0, 3107, 2094, 0, 2993, 2060, 2050, 0, 0, 0, - 0, 592, 588, 591, 590, 589, 594, 732, 605, 601, - 603, 604, 606, 602, 607, 733, 595, 2691, 608, 609, - 584, 597, 598, 599, 593, 596, 587, 586, 2061, 0, - 2084, 0, 2370, 2725, 2726, 2727, 0, 0, 2140, 1377, - 0, 2152, 0, 2166, 2371, 0, 0, 0, 0, 0, - 2207, 3048, 0, 0, 2211, 2210, 2202, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 2188, 2189, 2845, 2516, - 0, 2261, 3087, 3087, 2585, 2586, 2756, 0, 0, 0, - 2285, 2279, 2967, 2280, 0, 0, 2480, 0, 1375, 0, - 2968, 2831, 0, 2285, 2376, 2375, 2094, 2946, 2427, 2383, - 0, 2429, 2434, 0, 563, 511, 801, 0, 0, 935, - 3014, 614, 0, 663, 0, 0, 0, 787, 682, 3078, - 3078, 3078, 3078, 3078, 683, 3103, 684, 685, 686, 688, - 689, 690, 691, 693, 692, 695, 728, 726, 727, 729, - 730, 694, 700, 696, 3074, 731, 755, 697, 673, 698, - 699, 0, 2957, 3081, 711, 712, 710, 783, 714, 715, - 713, 3009, 671, 573, 3009, 637, 639, 640, 641, 643, - 642, 656, 644, 645, 678, 687, 646, 647, 648, 649, - 650, 651, 652, 653, 654, 655, 0, 0, 2957, 0, - 2976, 0, 0, 3014, 3014, 0, 0, 0, 0, 0, - 3009, 504, 2951, 505, 0, 0, 506, 451, 452, 259, - 3040, 3024, 3069, 3099, 3126, 3127, 358, 0, 3024, 3009, - 2969, 3024, 360, 0, 3107, 341, 258, 340, 3009, 3009, - 261, 262, 267, 272, 269, 327, 270, 273, 0, 274, - 0, 264, 357, 265, 266, 271, 268, 263, 275, 276, - 277, 278, 279, 280, 0, 2963, 3014, 2634, 0, 0, - 3147, 3148, 3050, 2614, 0, 0, 0, 0, 0, 432, - 405, 0, 199, 0, 3009, 3009, 117, 1591, 1342, 1339, - 1345, 0, 1342, 1357, 1358, 1329, 2446, 2447, 2451, 2452, - 1452, 2448, 1547, 2443, 1377, 1510, 3045, 0, 0, 2761, - 1498, 2719, 2720, 0, 0, 0, 0, 1514, 1550, 1537, - 3009, 2532, 3102, 2532, 2949, 0, 2993, 3009, 0, 0, - 0, 0, 1473, 1459, 1461, 2440, 1470, 3025, 1464, 1465, - 1466, 1504, 2959, 1468, 2696, 2668, 2695, 2850, 0, 2811, - 0, 2811, 2815, 0, 2790, 2821, 0, 2811, 2811, 2811, - 0, 2792, 2850, 0, 2811, 0, 1377, 1377, 1562, 2486, - 2483, 2746, 2747, 2480, 0, 2811, 2811, 0, 2839, 1576, - 1575, 0, 1572, 1584, 1582, 2528, 1607, 1608, 1604, 1606, - 1659, 0, 1656, 1655, 1664, 0, 1672, 2099, 0, 1377, - 1377, 1679, 2517, 2523, 2520, 0, 1769, 1745, 1380, 1731, - 1732, 1729, 1728, 1730, 1727, 1721, 1723, 1726, 0, 1800, - 1801, 0, 1299, 1301, 1804, 1805, 0, 0, 0, 2532, - 2532, 0, 1719, 1739, 1770, 3107, 3107, 0, 1826, 0, - 1840, 1838, 1610, 1839, 1869, 1866, 1868, 1867, 1860, 1863, - 1870, 1377, 0, 2546, 2545, 2575, 1894, 2624, 0, 1377, - 1908, 1899, 1902, 0, 0, 1929, 0, 1293, 1298, 1297, - 1296, 0, 0, 1962, 1964, 0, 1957, 1971, 1958, 1959, - 1950, 1953, 1971, 0, 2703, 2534, 1993, 2225, 2216, 0, - 773, 774, 3024, 2998, 1029, 1289, 1288, 1028, 2006, 2009, - 0, 0, 0, 585, 0, 2049, 1377, 0, 2067, 2063, - 2068, 2064, 2069, 0, 2059, 600, 2066, 2086, 2117, 2085, - 1377, 1377, 2134, 2505, 0, 2516, 2141, 0, 2154, 2539, - 0, 2149, 2155, 2171, 2170, 2169, 2168, 2167, 2187, 2212, - 2722, 2213, 2721, 2723, 2724, 0, 2199, 0, 2204, 2191, - 2192, 2193, 2197, 2194, 2198, 2195, 2196, 2190, 2846, 2249, - 0, 2246, 2247, 2241, 0, 2234, 3144, 3143, 0, 3088, - 2265, 2265, 2583, 2757, 0, 2489, 0, 0, 2850, 2850, - 2291, 0, 0, 1376, 0, 2832, 2314, 2315, 0, 2318, - 2321, 2323, 2319, 2140, 2947, 0, 2534, 0, 2436, 0, - 510, 564, 804, 0, 0, 435, 0, 3009, 664, 611, - 796, 797, 3079, 725, 724, 717, 716, 723, 722, 721, - 720, 719, 718, 3104, 0, 0, 3075, 781, 759, 0, - 751, 675, 672, 657, 2958, 0, 3082, 784, 785, 782, - 0, 638, 660, 798, 2967, 665, 2862, 2862, 0, 615, - 0, 582, 473, 501, 3139, 3140, 2643, 482, 2641, 3131, - 3130, 475, 2645, 2644, 3034, 2971, 2993, 0, 3009, 479, - 478, 3009, 507, 3009, 3009, 3024, 308, 361, 3009, 3069, - 3009, 3009, 3009, 3009, 380, 2954, 381, 0, 0, 0, - 3009, 3040, 328, 2964, 0, 0, 415, 416, 0, 419, - 421, 424, 425, 428, 433, 430, 201, 202, 2755, 2752, - 2752, 118, 1340, 3009, 0, 1354, 1350, 1343, 1344, 1359, - 2441, 2449, 1377, 1548, 1549, 2733, 2442, 2444, 2450, 1508, - 1509, 1542, 1540, 1517, 1541, 0, 1544, 0, 1543, 1545, - 0, 0, 1484, 1483, 0, 1487, 1486, 1471, 3009, 1454, - 1499, 1501, 2480, 2827, 2796, 2829, 2797, 2791, 2825, 2793, - 2794, 2795, 2823, 2864, 2818, 2819, 2789, 2653, 2488, 2485, - 2481, 2487, 2482, 2484, 2745, 1563, 2812, 0, 2787, 2788, - 2841, 2706, 2707, 1573, 1577, 1589, 0, 2853, 0, 2522, - 2525, 2518, 2524, 2519, 2521, 1689, 1760, 3011, 3011, 3011, - 3011, 0, 1744, 1746, 1747, 0, 1819, 1817, 1300, 1302, - 3048, 1818, 1821, 1820, 1815, 1788, 1785, 3021, 0, 2952, - 1784, 1787, 1778, 1756, 1774, 1780, 1781, 1791, 1782, 1776, - 1795, 1796, 0, 1763, 2480, 2606, 2480, 2606, 1616, 0, - 2539, 1865, 1857, 1858, 1856, 1862, 1896, 1901, 1906, 1915, - 1918, 1919, 2981, 3096, 1911, 3099, 1916, 1971, 2701, 2702, - 1971, 0, 3005, 3005, 1956, 1972, 1973, 1954, 1960, 1955, - 2993, 1980, 2399, 0, 2226, 328, 2220, 0, 2999, 2223, - 2480, 3059, 3059, 0, 2025, 2026, 2529, 2054, 2056, 2057, - 2053, 0, 0, 3050, 0, 2105, 2087, 2100, 2093, 2089, - 2102, 0, 1377, 1377, 2114, 2123, 2120, 2504, 2507, 2498, - 2506, 2499, 2139, 2142, 0, 1377, 1377, 2156, 3026, 2163, - 3048, 3048, 2203, 2248, 2238, 2242, 2243, 2244, 2245, 2236, - 2263, 2266, 2264, 2758, 1377, 1377, 2275, 2495, 2492, 3009, - 2283, 2282, 2284, 2480, 2864, 2480, 1371, 2306, 2698, 2831, - 2317, 2993, 2534, 2993, 2489, 2377, 2374, 2373, 3028, 2384, - 2435, 3107, 0, 2433, 0, 512, 564, 802, 564, 807, - 0, 632, 634, 633, 627, 631, 629, 630, 626, 628, - 625, 793, 788, 790, 0, 0, 610, 786, 1015, 1011, - 1012, 1005, 1009, 1017, 1003, 734, 1010, 1002, 741, 1008, - 705, 1004, 1006, 1007, 1016, 702, 704, 1013, 706, 1014, - 701, 709, 708, 2993, 753, 3097, 756, 3097, 0, 0, - 658, 2735, 681, 680, 679, 0, 659, 0, 0, 2969, - 743, 744, 619, 618, 0, 463, 0, 500, 2642, 3035, - 484, 0, 466, 3083, 493, 495, 499, 498, 494, 496, - 492, 497, 0, 0, 0, 0, 3009, 311, 310, 286, - 309, 0, 360, 356, 0, 363, 0, 0, 2955, 2956, - 379, 382, 2971, 0, 0, 3009, 0, 2989, 359, 386, - 0, 417, 426, 0, 427, 0, 119, 120, 0, 3009, - 1349, 1355, 0, 0, 1330, 2445, 1530, 3132, 3133, 2533, - 1546, 1535, 1482, 0, 1500, 1564, 3001, 2866, 2813, 1609, - 1661, 2098, 2097, 3107, 0, 0, 0, 0, 1753, 1748, - 2984, 3023, 3022, 0, 1777, 3011, 1775, 1790, 1789, 1792, - 0, 0, 1783, 1828, 0, 1827, 0, 1611, 1612, 1345, - 0, 1864, 1871, 1377, 1920, 2982, 0, 0, 1952, 1963, - 1971, 3006, 0, 0, 1974, 1975, 0, 2399, 3048, 1983, - 1994, 0, 0, 2229, 2219, 3000, 2010, 3060, 383, 384, - 385, 0, 2046, 3111, 2044, 2045, 2043, 3110, 2017, 2027, - 2028, 2030, 0, 0, 2055, 2051, 2070, 2072, 0, 2090, - 3009, 2516, 2088, 2101, 0, 0, 0, 2104, 2125, 2122, - 2118, 2124, 2119, 2121, 2143, 2150, 2157, 3027, 2172, 0, - 0, 2497, 2494, 2490, 2496, 2491, 2493, 0, 2293, 2866, - 2292, 2331, 1370, 0, 2316, 0, 2320, 0, 2312, 1377, - 1377, 2368, 2379, 2513, 2510, 2378, 3029, 3030, 2372, 2387, - 0, 0, 514, 513, 805, 809, 936, 0, 794, 791, - 622, 3048, 625, 617, 620, 623, 612, 735, 736, 740, - 739, 738, 737, 703, 742, 707, 0, 0, 751, 3098, - 0, 752, 757, 3009, 677, 676, 661, 799, 0, 667, - 670, 669, 666, 2863, 474, 465, 464, 462, 502, 483, - 2971, 471, 480, 477, 481, 476, 316, 317, 315, 314, - 389, 0, 300, 301, 302, 296, 297, 291, 303, 304, - 292, 0, 305, 306, 295, 293, 294, 299, 298, 0, - 285, 289, 290, 287, 390, 362, 0, 370, 378, 391, - 392, 2636, 0, 3009, 329, 0, 0, 0, 0, 429, - 203, 0, 0, 1346, 1347, 1351, 0, 1352, 1360, 1362, - 1502, 3002, 0, 3001, 2480, 1620, 1761, 1752, 1751, 1749, - 1750, 1798, 0, 3011, 1793, 1794, 2480, 2480, 1613, 1614, - 0, 1618, 1617, 1619, 1900, 0, 1930, 1970, 1977, 1976, - 2535, 1983, 0, 0, 2471, 3009, 2227, 0, 0, 2217, - 2221, 2041, 3061, 2038, 2040, 2039, 2032, 2037, 2029, 0, - 2035, 2033, 2034, 2031, 0, 0, 2092, 0, 2083, 2108, - 2505, 2502, 2107, 2091, 2103, 2200, 2201, 2286, 2480, 2339, - 1372, 2322, 2324, 2512, 2515, 2508, 2514, 2509, 2511, 2395, - 2388, 2389, 0, 0, 2437, 2438, 3009, 516, 808, 938, - 792, 0, 789, 0, 0, 624, 760, 754, 0, 761, - 3050, 3050, 763, 0, 668, 0, 0, 485, 486, 487, - 488, 0, 467, 2992, 473, 0, 370, 0, 2987, 3149, - 3150, 282, 281, 0, 367, 366, 365, 368, 364, 3009, - 372, 319, 374, 2637, 338, 347, 354, 347, 343, 0, - 3009, 3009, 330, 0, 387, 3009, 3009, 1348, 1341, 0, - 1362, 1380, 0, 0, 1565, 1629, 3007, 1797, 0, 1830, - 1829, 1615, 2661, 2660, 2734, 1921, 1981, 2400, 2401, 3009, - 1984, 1985, 1987, 1377, 1377, 1992, 2477, 2474, 0, 2230, - 3009, 3062, 2036, 2042, 2692, 0, 2073, 2685, 2684, 2686, - 0, 2106, 2500, 2501, 2503, 2294, 2960, 2365, 2364, 2340, - 2332, 2333, 2948, 2334, 2335, 2336, 2337, 2360, 0, 0, - 0, 3009, 2399, 2390, 2394, 0, 2393, 2391, 2439, 0, - 2989, 0, 810, 0, 942, 937, 939, 0, 0, 3009, - 621, 762, 763, 0, 0, 2967, 748, 768, 769, 770, - 3024, 767, 674, 491, 490, 2959, 2971, 472, 2833, 284, - 307, 283, 373, 321, 2833, 320, 371, 0, 3036, 345, - 350, 0, 346, 0, 344, 336, 0, 0, 331, 388, - 2752, 2752, 0, 1380, 0, 2867, 1377, 1377, 1377, 1588, - 1636, 1632, 3048, 3008, 1623, 1628, 1627, 1622, 0, 1779, - 2471, 2402, 0, 1986, 2476, 2479, 2472, 2478, 2473, 2475, - 2228, 0, 2687, 2688, 2689, 2071, 0, 3085, 2361, 2362, - 0, 3050, 0, 2404, 2392, 2430, 515, 517, 3005, 811, - 0, 943, 0, 940, 3106, 0, 750, 763, 758, 2752, - 764, 771, 3009, 0, 0, 469, 319, 0, 3009, 369, - 376, 377, 375, 3037, 0, 353, 355, 332, 333, 121, - 122, 3009, 0, 2865, 1634, 1638, 1635, 1630, 1637, 1631, - 1633, 0, 1621, 1982, 2403, 2231, 0, 3086, 0, 0, - 2363, 2358, 2357, 2356, 0, 2397, 3048, 2414, 2462, 538, - 0, 0, 948, 949, 0, 941, 795, 749, 777, 778, - 780, 2752, 766, 489, 3050, 468, 323, 2835, 0, 0, - 0, 0, 0, 0, 0, 1624, 2359, 3125, 3124, 3063, - 2615, 0, 2352, 2346, 2347, 2349, 3009, 2396, 0, 0, - 2385, 1377, 1377, 2431, 2468, 2465, 3009, 0, 0, 0, - 0, 519, 539, 540, 521, 549, 0, 3009, 3080, 0, - 946, 1000, 779, 772, 2638, 0, 0, 318, 2834, 322, - 0, 3134, 3135, 351, 3009, 3009, 1353, 1361, 3064, 3050, - 2616, 2355, 2350, 2353, 0, 2348, 0, 2405, 2406, 3009, - 0, 0, 2415, 2416, 2418, 2462, 2467, 2470, 2463, 2469, - 2464, 2466, 3009, 0, 0, 3009, 3009, 3009, 3009, 541, - 0, 3039, 0, 3090, 0, 518, 522, 524, 523, 0, - 0, 0, 0, 0, 0, 0, 520, 550, 552, 551, - 0, 0, 815, 3014, 3014, 3031, 848, 814, 818, 819, - 0, 0, 0, 972, 3009, 960, 961, 962, 953, 3103, - 954, 3044, 3044, 3009, 3011, 2983, 3009, 0, 977, 970, - 957, 971, 3044, 3011, 958, 0, 0, 969, 979, 976, - 974, 3011, 959, 973, 0, 980, 968, 0, 995, 989, - 993, 992, 990, 994, 950, 996, 991, 975, 963, 0, - 3044, 1001, 1019, 1018, 1022, 2639, 470, 0, 351, 348, - 352, 0, 0, 0, 2354, 2351, 2398, 2407, 0, 2411, - 2413, 2412, 2409, 2409, 2423, 2419, 2784, 2785, 2782, 2783, - 2420, 2424, 2417, 2386, 0, 0, 547, 0, 0, 0, - 0, 3009, 3009, 3009, 3009, 3009, 525, 0, 3009, 3009, - 3009, 3009, 3009, 3009, 3009, 3009, 3009, 3009, 3009, 553, - 0, 3009, 3165, 3166, 3014, 3014, 0, 812, 816, 3009, - 824, 820, 822, 823, 825, 827, 0, 951, 952, 985, - 3009, 983, 3009, 0, 0, 955, 956, 0, 998, 981, - 0, 3097, 3009, 0, 999, 997, 1325, 984, 2845, 0, - 326, 210, 211, 325, 349, 334, 335, 2345, 2342, 2344, - 2343, 2338, 2341, 2408, 2422, 2410, 2421, 0, 542, 3097, - 546, 544, 548, 543, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 3032, 3033, 2763, 835, 830, 3028, 834, - 2762, 833, 0, 849, 0, 821, 826, 988, 1321, 1317, - 986, 966, 967, 987, 982, 1314, 1324, 0, 965, 964, - 1024, 1023, 324, 2425, 775, 534, 530, 531, 535, 533, - 0, 536, 526, 532, 527, 528, 529, 558, 554, 555, - 559, 557, 0, 556, 828, 3029, 3030, 829, 832, 0, - 0, 850, 579, 817, 1309, 1306, 1310, 1307, 1322, 1305, - 1323, 1308, 0, 1318, 1319, 0, 1315, 1313, 1311, 1312, - 978, 545, 776, 0, 0, 0, 3009, 3009, 0, 3009, - 836, 837, 838, 839, 840, 841, 831, 0, 852, 853, - 1320, 1316, 0, 560, 3152, 3151, 3009, 0, 0, 3154, - 0, 3009, 3009, 0, 3080, 0, 0, 847, 843, 3153, - 0, 0, 842, 907, 3113, 3112, 3003, 3044, 2950, 3009, - 0, 906, 3009, 3048, 851, 3009, 0, 858, 859, 860, - 869, 861, 863, 866, 854, 855, 856, 865, 867, 0, - 870, 857, 917, 862, 0, 864, 868, 3116, 3117, 3044, - 0, 844, 846, 845, 3004, 934, 3047, 3046, 3014, 916, - 0, 751, 0, 0, 0, 0, 3042, 3042, 0, 0, - 919, 914, 917, 0, 1304, 921, 929, 930, 0, 932, - 923, 0, 915, 894, 892, 893, 888, 891, 0, 889, - 3097, 2850, 896, 2672, 3156, 0, 0, 3158, 3160, 0, - 3164, 3162, 871, 876, 3052, 3052, 873, 877, 872, 878, - 0, 3043, 908, 908, 3042, 3042, 901, 918, 920, 931, - 928, 927, 925, 926, 3014, 924, 0, 890, 757, 933, - 3050, 0, 895, 2673, 3155, 3159, 3157, 3163, 3161, 3054, - 3053, 879, 884, 0, 912, 910, 902, 908, 911, 904, - 0, 0, 922, 537, 746, 0, 898, 882, 874, 882, - 887, 882, 875, 882, 0, 909, 903, 905, 0, 745, - 900, 897, 899, 0, 881, 880, 886, 885, 913, 747, - 883 -}; - - /* YYPGOTO[NTERM-NUM]. */ -static const yytype_int16 yypgoto[] = -{ - -3857, -3857, -3857, -3857, -3857, -3857, -3857, 3183, -3857, -3857, - -3857, -3857, -3857, -3857, 3150, -3857, -3857, -3857, 2295, -3857, - -3857, -3857, -3857, -3857, -3857, -3857, -3857, -3857, -3857, 3154, - 3087, 1380, -3857, -3857, -3857, 2674, -3857, 2982, -3857, -3857, - -3857, -3857, -3857, -3857, -3857, -3857, -3857, -3857, -3857, -3857, - -3857, -3857, -3857, 3121, -3857, -3857, -3857, -3857, -3857, -3857, - -3857, 2935, 1125, -3857, -3857, -3857, -3857, -3857, -3857, -3857, - -3857, 3010, -3857, -3857, -3857, -3857, 2930, -3857, -3857, -3857, - -3857, 3120, -3857, -3857, -3857, -3857, 2915, -3857, -3857, -3857, - -3857, -3857, -3857, -3857, -3857, -3857, -3857, 2461, -3857, 2086, - -3857, -3857, -1631, -3857, -3857, -3857, -3857, -3857, 3011, -3857, - -3857, -3857, -3857, 3017, -3857, -3857, 2744, -3857, -3857, -3857, - -3857, -3857, -3857, -3857, -3857, -3857, -3857, -3857, -3857, -3857, - -3857, -3857, -3857, -3857, -3857, -3857, -3857, -3857, -3857, -3857, - -3857, -3857, -3857, -3857, -3857, -3857, -3857, -3857, -3857, -3857, - -3857, -600, -3857, -3857, -3857, -3857, 1207, -3857, -3857, -3857, - -2259, -3857, -3857, -3857, -3857, -3857, -397, -835, -3534, -3857, - -3857, 415, -3857, -3857, -3857, -3857, -3857, -371, -3857, -3857, - -3857, -511, -3857, -3857, -3857, -3857, 411, -3857, -3857, -3857, - -3857, -3857, -3857, -3857, -3857, -3857, -3857, 2770, -3857, -3857, - -3857, -3857, -3857, -3857, -3857, 400, -3857, -3857, -3857, -3857, - -3857, -3857, -3857, -3857, -3857, -3857, -3857, -3857, -3857, -3857, - -3857, -3857, -3857, -3857, -3857, -3857, -3857, -364, -3857, -3857, - -3857, 49, -3857, -3857, -3857, -3857, -3857, -3857, -3857, -3857, - -3857, -3857, -3857, -3857, -3857, -3857, -3857, -3857, -3857, -3857, - -3857, -3857, -3857, -3857, -3857, -3857, -3857, -742, -3857, -3857, - -3857, -676, -3857, -3857, -749, -3857, -3857, -3857, -1568, -3857, - -3857, 2524, -3857, -3321, -3857, -3450, -705, -3857, -967, 1106, - -3857, -3857, -3857, -3857, -3857, -3857, -3857, -3857, -3177, -3857, - -3857, -3857, -3857, -1891, -3857, -3857, 939, -3857, -3857, -3857, - -3857, -3857, 1607, -3857, -3857, -3857, -3857, -2604, -3857, -3857, - -3857, -2509, 478, -1267, -3857, -3857, -2500, -3857, -3857, -3857, - -3289, -3857, -3857, -1181, -3857, -3857, -3301, -3857, -563, -470, - -3857, 1235, -3857, -3454, -3857, -616, -2495, -3857, -3857, -2462, - -3857, -1621, -3857, 474, -2688, -3857, -3857, -3857, -3857, -3857, - -3857, -3857, -3857, -3857, -3857, -3857, -3857, -3857, -3857, -3857, - -3857, -3857, -3857, -867, -2327, -3857, -3857, -993, -1933, -3857, - -3857, -3857, -3857, -3857, -3857, -3857, -3857, -3857, -3857, -3857, - -3857, -3857, -3857, -3857, -2124, -3857, -3857, -3857, -3857, -3857, - -3857, -3857, -3857, -3857, -2341, -3857, -3857, -3857, -3857, -1115, - -3857, -3857, -3857, -3857, -3857, -3857, -1119, -3857, -3857, -3857, - -3857, -3857, -3857, -3857, -447, -3857, -3857, -3857, -3857, -888, - -3857, -602, -3857, 2600, -3857, -3857, -1487, -3857, -683, -3857, - -3857, -3857, -3857, -3857, -3857, -3857, -3857, -3857, -3857, -3857, - -3857, -3857, -3857, -3857, -3857, -3857, -3857, -3857, -3857, -3857, - -3857, -3857, -3857, -3857, -3857, -3857, -3857, -3857, -3857, -3857, - -3857, -3857, -3857, 1785, 2289, -1030, -745, -744, -3857, -2187, - -3857, -943, -3857, -3857, -3857, -3857, -748, -3857, -775, -3857, - -3857, -3857, -3857, -3857, -3857, -3857, -3857, -3857, -3857, -3857, - -3857, 1568, -168, -3857, 8, 434, -3857, -3857, -3857, -3857, - -3857, -3085, -3857, -3857, -3857, -3857, -3857, -3857, -3857, -1114, - -3857, -3857, -135, -3857, 3046, -3857, -3857, -3857, -3857, -3857, - -3857, -3857, -3857, 2373, -1574, -3857, 2124, -3857, 2125, -3857, - 407, -3857, -738, -3857, -3857, -1036, -3857, -3857, 414, 2118, - -1158, 1545, -3857, -3857, -3857, -3857, -3857, -3857, -3857, -3857, - -3857, 1446, 782, -3857, -3857, -3857, 2445, -3857, -3857, -3857, - -3857, -3857, -1230, -3857, -3857, 810, -3857, -3857, -3857, -3857, - 55, -3857, -3857, 28, -3857, -3857, -999, -3857, -3857, -3857, - -465, -3857, -463, -3857, -3857, -3857, -3857, 2444, -3857, -3857, - -3857, -3857, 2072, -3857, -3857, -3857, -3857, -3857, -3857, -3857, - -3857, -3857, -3857, -3857, -3857, -3857, -3857, -3857, -3857, -3857, - -3857, -3857, -3857, -3857, -3857, 2655, -3857, -3857, -3857, -3857, - -3857, -3857, -3857, 2399, -3857, -3857, 2045, -3857, -3857, 1417, - -3857, -3857, -3857, -3857, -3857, -3857, -3857, -3857, 1392, -3857, - -3857, -3857, -3857, 375, -3857, -3857, -3857, -3857, -3857, -3857, - -3857, -3857, -3857, -3857, 2395, 775, 2647, -2349, -2583, -3857, - -3857, -3857, -3857, -3857, -3857, -3857, -3857, -1795, -3857, -3857, - -3857, -3857, -3857, -3857, -3857, -3857, -3857, -3857, -3857, -3857, - -3857, -3857, -3857, -3857, 2023, -3857, -3857, 2019, -3857, -3857, - -3857, -3857, 734, 346, -3857, -3857, -3857, -3857, -3857, 2381, - -3857, -3857, -3857, -3857, -3857, -3857, -3857, -3857, -3857, 1351, - -3857, -3857, -3857, -3857, -3857, -3857, 342, -3857, -3857, -3857, - -3857, -3857, -3857, -3857, -3857, 339, 2003, -3857, -3857, -3857, - -3857, -3857, -3857, -3857, -3857, -3857, -3857, -3857, -3857, -3857, - -3857, 1831, -3857, -3857, 716, -3857, 1322, -3857, -3857, -2355, - 332, 337, -3857, -3857, -3857, -3857, -3857, -176, -3857, -313, - 1840, -3857, -3857, -3857, -3857, -3857, -3857, -3857, -3857, -3857, - -3857, -3857, -3857, -3857, -3857, -3857, -3857, -3857, -3857, -3857, - -3857, 2359, -3857, -3857, -3857, -3857, -3857, -3857, -3857, -3857, - 30, -3857, -3857, -3857, -3857, -3857, -3857, -3857, -3857, -1798, - 1208, -3857, -3857, -3857, 319, -3857, -3857, -3857, -3857, -3857, - -3857, -346, -3857, -3857, -3857, 1174, -3857, -3857, -3857, -1347, - 699, -3857, -3857, 321, -3857, -3857, -3857, -3857, -3857, -3857, - -3857, -3857, -3857, -3857, 313, -3857, 315, -3857, -3857, -3857, - -3857, -3857, -3857, -3857, -3857, -3857, -3857, -3857, -3857, 628, - -1369, -3857, -3857, -3857, -3857, -3857, -3857, 1788, 693, -3857, - -3857, -3857, -3857, -3857, -3857, -3857, -3857, -3857, -3857, -3857, - -3857, -155, -3857, -3857, -3857, -3857, 1151, -3857, -3857, -3857, - 2339, -3857, 2342, -3857, -3857, -3857, -3857, 2676, -3857, -3857, - -3857, -3857, -3857, -3857, -3857, -3857, -3857, -3857, -3857, -3857, - -3857, -3857, -3857, -3857, -3857, 3002, 2998, -3857, -3857, -3857, - 662, -3857, -3857, -3857, -3857, -3857, -3857, -3857, -3857, 1765, - -3857, -3857, 1144, -3857, -3857, -3857, -3857, -3857, -3857, -3857, - -3857, -3857, -3857, -3857, -3857, -3857, -3857, -3857, -3857, -3857, - -3857, -3857, -3857, -3857, 297, -3857, 1145, -3857, -3857, -3857, - -3857, -3857, -3857, -3857, -3857, -3857, -3857, -3857, -3857, -3857, - -3857, -514, -3857, -3857, -3857, -3857, -3857, -302, -3857, -3857, - -3857, -3857, 864, 1203, 1219, -3857, -3857, -3857, -3857, -3857, - -3857, -3857, -3857, -3857, -171, -3857, -3857, -3857, -2986, -3857, - -256, -3857, -3857, -555, -680, -3545, -3857, -3857, -557, -3857, - -3857, 1770, -3857, -3857, -3857, -3857, -3857, -3857, -3857, -3857, - -1588, -3857, 964, -3857, -3857, 970, -3857, 1160, -3857, 2134, - -3857, 2142, -553, -3857, -494, -3857, -491, -356, -3857, -242, - -3857, -240, -1783, -3857, 917, -3857, 919, 335, -3857, 353, - -3857, 358, -3857, -3857, -3857, -2518, -116, -2086, -3857, -3857, - 72, -3857, 66, -2117, 349, -3857, 892, -3857, 904, 2585, - -1431, 2757, -501, -2408, -2116, -625, -1838, -3857, -3857, 2137, - -3857, 2143, 1502, -1930, 752, 755, 757, 758, 1112, 399, - -509, 1116, 1119, -3857, 1427, 167, -1129, -601, -660, 2746, - 2440, -1070, -3857, -236, 1218, -695, -3857, -976, -3857, 1483, - -3857, -564, -3857, 2233, 289, -125, -3857, -3857, -1069, -3857, - 669, -2684, -44, 3253, -568, -595, -3857, -566, 2285, -3857, - -42, 64, -3857, -1102, -2200, -3857, -110, -3857, -3857, -3857, - 1267, -962, -3857, 1453, 470, -2657, 748, -638, 2240, -3857, - -2318, -2362, -2690, -441, -550, -664, -743, -598, -3857, -2384, - -3857, -476, 2196, -711, -3857, -3857, -3857, -2296, -97, -1929, - -3857, 1056, -764, -821, -151, 2951, -3857, -2233, 2716, -259, - 3721, -505, -694, -587, -3857, -3857, -3857, -232, 2658, -3857, - -3857, -3857, -3857, 1183, -3857, -3857, 1836, -3857, -257, -3857, - -3857, -3857, -3857, 1268, -3857, -2432, -3857, 956, 701, 409, - 135, -3857, -3857, -3857, -3857, -191, -826, 544, -3857, 1166, - -2175, -3857, -3857, -3857, -1572, -2201, -2693, -1355, -1200, -3857, - -3857, -3857, -3857, -3857, -100, -177, -3857, -2039, 906, -3857, - 13, -3857, -2821, -3857, -35, -1848, -2194, -3857, -3857, -2254, - -3857, -699, -3857, -3857, -3857, 2715, -1561, -2409, -1694, -847, - -763, -656, -902, 3214, 493, -3857, -3857, 2974, -3857, -812, - -3857, -3857, -3857, 205, -3857, 336, -3857, 1295, -3486, -3857, - -3857, -3857, -3078, -591, 1603, -3857, -3857, -65, -3857, -3857, - -1167, -3857, 2345, -3857, -3857, -3857, -651, -3857, -687, -416, - -3857, 1868, 1109, -3857, -3857, 314, -3857, -3856, -846, -3857, - -3857, -3857, -3857, -3857, -3857 -}; - - /* YYDEFGOTO[NTERM-NUM]. */ -static const yytype_int16 yydefgoto[] = -{ - -1, 1, 2, 4, 5, 6, 11, 12, 7, 8, - 13, 14, 47, 48, 49, 111, 51, 113, 19, 40, - 123, 15, 16, 17, 24, 32, 221, 25, 31, 109, - 163, 159, 299, 533, 534, 535, 218, 219, 20, 37, - 38, 118, 55, 121, 228, 169, 540, 29, 30, 42, - 43, 82, 83, 84, 85, 196, 280, 505, 86, 193, - 265, 266, 267, 268, 269, 495, 1148, 1700, 270, 271, - 1144, 272, 87, 194, 277, 278, 279, 500, 88, 89, - 90, 91, 92, 151, 210, 525, 211, 212, 93, 180, - 246, 466, 467, 247, 248, 1126, 1134, 1127, 1128, 1129, - 2411, 2836, 1130, 4153, 94, 157, 95, 202, 203, 204, - 519, 96, 198, 199, 97, 477, 478, 182, 754, 98, - 99, 481, 100, 101, 102, 103, 104, 105, 106, 150, - 63, 64, 129, 179, 243, 1090, 1668, 1669, 2370, 2371, - 3449, 3450, 3451, 3452, 3453, 3189, 3190, 1109, 2372, 3429, - 2373, 3734, 3735, 3818, 3927, 2374, 2375, 3207, 3464, 2376, - 1137, 2377, 2378, 2379, 2380, 3618, 3739, 4059, 3740, 3742, - 2381, 2382, 2383, 2384, 3456, 3608, 2385, 3611, 3612, 3736, - 3737, 3820, 2386, 2387, 2815, 2388, 3014, 2389, 3209, 2390, - 2391, 2392, 2393, 244, 245, 458, 459, 460, 461, 746, - 462, 463, 464, 739, 2831, 2832, 3214, 465, 741, 1687, - 58, 237, 59, 60, 125, 176, 238, 239, 724, 240, - 1089, 1655, 1656, 3417, 1657, 3875, 3594, 3165, 1658, 1659, - 2801, 3423, 1660, 1661, 3419, 3587, 3588, 3589, 3590, 1662, - 3180, 3181, 1663, 3167, 1664, 1665, 2345, 712, 2245, 2730, - 3095, 3096, 3567, 3700, 3797, 3975, 3976, 3977, 3978, 3911, - 3912, 3913, 3986, 3987, 3988, 3989, 444, 1632, 445, 446, - 716, 717, 1642, 718, 1085, 1086, 200, 2328, 3110, 2160, - 2161, 2162, 2163, 2164, 719, 3116, 720, 1637, 721, 1638, - 2779, 3383, 3384, 3111, 2303, 2304, 2305, 2306, 2307, 2308, - 3156, 2252, 2309, 2310, 3158, 3412, 2311, 2312, 2762, 3148, - 3405, 2313, 2314, 2315, 3393, 3395, 2316, 4330, 4469, 2317, - 3147, 3398, 2759, 3582, 3144, 3712, 3716, 3813, 3717, 3718, - 3719, 3720, 4271, 3721, 3868, 3869, 2318, 2319, 2769, 2320, - 2321, 2322, 3378, 3112, 3113, 3572, 2323, 2324, 2325, 1077, - 2731, 1636, 3098, 2249, 3375, 3568, 3702, 3861, 3917, 3997, - 3998, 4121, 4122, 4123, 4124, 3999, 4196, 4197, 4198, 4244, - 4280, 4281, 4282, 4283, 4284, 4285, 4117, 4203, 4289, 4304, - 4334, 4335, 4402, 4458, 4474, 4462, 4336, 4386, 4387, 4337, - 4432, 4471, 4338, 4339, 4446, 4447, 4340, 4341, 4342, 4371, - 4372, 4343, 4344, 4424, 4425, 4375, 4376, 4377, 4345, 4346, - 2735, 3569, 3705, 3706, 3707, 3863, 3864, 4054, 3918, 4044, - 3920, 3142, 4051, 958, 4148, 1505, 1506, 1507, 1508, 2112, - 1466, 2113, 1467, 2114, 1468, 2115, 1469, 2116, 1470, 2117, - 1471, 2118, 1472, 2119, 2120, 1473, 2121, 1474, 2122, 1475, - 1476, 2123, 1477, 2124, 1478, 1479, 2125, 1480, 2126, 1481, - 2624, 1986, 1482, 1483, 1487, 1488, 2554, 2555, 4373, 4374, - 4259, 4260, 4261, 4214, 4268, 4269, 4131, 4265, 4129, 4262, - 4045, 4046, 172, 173, 312, 2849, 3479, 174, 1154, 1708, - 1707, 2418, 2419, 2420, 2845, 2846, 3628, 3222, 1710, 3224, - 3630, 702, 1053, 1054, 2228, 3352, 1055, 1056, 2712, 1878, - 1879, 2538, 1057, 233, 377, 378, 628, 782, 1157, 2472, - 783, 784, 785, 1171, 1772, 1773, 1162, 1163, 1164, 2879, - 2880, 1799, 2952, 1723, 1724, 1166, 1764, 2852, 2853, 4047, - 1911, 1767, 1156, 379, 629, 818, 1195, 1193, 380, 630, - 834, 1850, 2512, 381, 631, 847, 848, 1852, 382, 632, - 853, 2515, 779, 1151, 1706, 547, 548, 1854, 1855, 2518, - 2573, 2968, 3267, 3268, 3269, 3635, 655, 3767, 3759, 3839, - 3760, 3837, 3761, 1223, 383, 633, 857, 858, 384, 634, - 862, 863, 1230, 864, 1226, 2520, 385, 638, 867, 1235, - 386, 387, 639, 877, 1244, 388, 641, 882, 389, 640, - 879, 1245, 1248, 390, 642, 889, 1873, 890, 391, 643, - 901, 902, 903, 904, 1273, 905, 1275, 1912, 1888, 1889, - 1890, 2543, 906, 1258, 907, 908, 909, 1915, 1916, 910, - 2537, 2932, 2933, 2934, 911, 1277, 2565, 912, 913, 2536, - 3243, 914, 2566, 915, 1260, 1920, 959, 2953, 2954, 2955, - 2956, 2957, 3260, 2958, 2959, 2960, 2961, 1913, 1264, 392, - 644, 919, 1284, 393, 645, 394, 647, 1929, 924, 2571, - 395, 648, 927, 928, 929, 1293, 1294, 1295, 1935, 1296, - 1932, 2582, 2578, 2579, 2971, 1290, 396, 649, 938, 656, - 397, 650, 939, 398, 651, 942, 399, 652, 945, 1970, - 400, 401, 657, 1973, 1319, 1974, 2589, 2591, 402, 658, - 951, 1320, 1983, 2595, 2980, 2981, 2982, 2984, 403, 659, - 954, 404, 660, 960, 405, 661, 962, 963, 1492, 1493, - 2008, 1494, 1495, 2610, 2611, 2005, 2006, 2007, 2604, 2994, - 2995, 2996, 406, 967, 1496, 3287, 3770, 3514, 3650, 3651, - 2011, 407, 968, 1498, 3002, 408, 664, 409, 665, 975, - 1512, 410, 666, 977, 411, 667, 979, 1516, 412, 669, - 982, 983, 984, 1523, 2132, 3308, 3309, 3533, 3526, 3527, - 3310, 3311, 413, 670, 986, 2636, 2637, 3315, 3020, 1528, - 1529, 1530, 2639, 2641, 2642, 3535, 414, 671, 415, 672, - 992, 1541, 416, 673, 994, 2177, 3025, 3026, 3027, 1870, - 1871, 1872, 3322, 3029, 3321, 3538, 1543, 417, 418, 674, - 996, 1551, 3034, 3332, 3035, 3330, 3036, 1548, 419, 675, - 998, 420, 421, 676, 1001, 1555, 422, 677, 1004, 2655, - 2656, 1559, 423, 424, 679, 1008, 1565, 2180, 2661, 2662, - 1563, 425, 680, 1011, 1567, 1568, 2184, 3049, 426, 681, - 1016, 213, 1584, 1017, 1018, 2206, 2207, 1019, 1020, 1021, - 1022, 1023, 1024, 1025, 1026, 427, 682, 969, 3004, 1500, - 3294, 2015, 2618, 3293, 3519, 428, 683, 1035, 2209, 1592, - 2690, 2691, 2692, 1588, 429, 636, 637, 430, 1037, 1594, - 3060, 691, 692, 431, 697, 1042, 1043, 1044, 1604, 1605, - 2223, 3071, 2705, 1602, 432, 698, 1047, 1610, 433, 700, - 434, 701, 1049, 435, 703, 1058, 436, 704, 1061, 437, - 705, 1064, 1623, 2716, 2717, 2233, 2719, 3082, 3084, 1621, - 438, 706, 1068, 3353, 3549, 3680, 3681, 3682, 4161, 3683, - 3893, 3894, 3944, 3684, 3853, 3685, 3686, 3687, 3688, 439, - 707, 1070, 1553, 2236, 2237, 3361, 1626, 440, 1072, 1628, - 3369, 3955, 3559, 3560, 3561, 3697, 3692, 3897, 3289, 3647, - 3648, 3857, 3947, 3948, 4164, 4165, 3900, 3952, 3953, 4075, - 4080, 2239, 441, 1073, 1630, 3858, 2242, 2728, 3092, 3564, - 2430, 2856, 2431, 2432, 2850, 2433, 2434, 1267, 1883, 1268, - 1881, 1269, 3903, 3960, 3904, 3958, 3905, 3655, 3778, 3656, - 3776, 3657, 2498, 2902, 2499, 2900, 2500, 3066, 3345, 3067, - 3343, 3068, 2652, 3539, 3673, 2653, 3039, 3040, 3362, 3557, - 3363, 3555, 3364, 2531, 2532, 2923, 2533, 2921, 2534, 987, - 2135, 693, 2866, 3001, 949, 950, 931, 932, 1308, 1309, - 1940, 1310, 1960, 1961, 1962, 1963, 1964, 1965, 1597, 2217, - 1808, 836, 837, 838, 839, 819, 869, 1238, 1005, 1006, - 1009, 1675, 3850, 1676, 786, 955, 1028, 1029, 1967, 1968, - 1317, 1531, 850, 851, 1670, 2793, 3614, 3923, 1145, 2787, - 2788, 2794, 132, 205, 940, 871, 1271, 820, 821, 3641, - 822, 823, 4392, 1822, 842, 3666, 1774, 2166, 3667, 1804, - 2475, 2612, 3077, 1996, 2987, 1570, 2910, 859, 1065, 1533, - 1713, 2440, 2671, 2672, 2172, 1714, 970, 1032, 1059, 2613, - 3643, 3150, 824, 695, 884, 872, 873, 1998, 696, 1146, - 1147, 1699, 1040, 1041, 1715, 520, 2442, 4201, 479, 825, - 516, 517, 4081, 826, 827, 828, 829, 1201, 1180, 1830, - 1814, 1815, 1826, 1819, 1809, 1811, 722, 2718, 3816, 1218, - 1843, 2508, 1546, 1509, 453, 1241, 1865, 310, 3160, 3237, - 3484, 625, 626, 627, 2725, 2455, 2343, 1112, 3200, 2765, - 1167, 1168, 2824, 1262, 2421, 273, 149, 496, 2331, 1252, - 1768, 3276, 2556, 1107, 1105, 183, 3595, 988, 1990, 3009, - 3482, 4355, 3282, 3768, 1312, 2020, 288, 2025, 3253, 2468, - 3338, 3368, 4116, 3170, 3824, 3980, 166, 4412, 4130, 4358, - 1095, 742, 4441, 293, 3298, 3662, 3939, 274, 1769, 2395, - 1619, 2757, 136, 2744, 2327, 486, 3848, 2700, 3981, 1685, - 1255, 2985, 3400, 2557, 2453, 2754, 3573, 2962, 3313, 4347, - 4248, 4349, 4050, 1239, 3889, 2396, 257, 2791, 3229, 3933, - 1697, 2335, 1232, 2698, 830, 2402, 3603, 4296, 4302, 4405, - 4406, 4407, 4408, 4409, 4002 -}; - - /* YYTABLE[YYPACT[STATE-NUM]] -- What to do in state STATE-NUM. If - positive, shift that token. If negative, reduce the rule whose - number is the opposite. If YYTABLE_NINF, syntax error. */ -static const yytype_int16 yytable[] = -{ - 214, 53, 771, 249, 449, 917, 1050, 1801, 1078, 1079, - 1080, 1766, 187, 1087, 190, 999, 2251, 1031, 2021, 195, - 1527, 2640, 133, 930, 515, 1175, 2437, 1677, 140, 1679, - 1680, 2438, 1682, 1683, 137, 138, 139, 870, 1593, 232, - 188, 144, 188, 845, 2548, 2882, 1165, 188, 2854, 1690, - 2231, 1569, 1580, 1243, 2558, 941, 2736, 290, 1930, 253, - 2893, 946, 2412, 941, 2244, 1833, 971, 849, 1250, 3402, - 1189, 1091, 3093, 2783, 966, 1096, 1097, 916, 1099, 1100, - 2524, 1102, 1103, 2863, 971, 167, 941, 188, 1829, 2340, - 952, 2654, 2695, 2869, 2580, 2634, 2547, 2804, 2136, 184, - 1839, 185, 3172, 1233, 2808, 191, 192, 2812, 2813, 3579, - 1242, -1333, 1197, 1030, 130, 206, 215, 2562, 1067, 2859, - 2860, 835, 130, 4366, 220, 2861, 2862, 1291, 2864, 447, - 1214, 224, 1048, -1331, 3202, 3585, 3041, 1092, 1093, 2784, - 2785, 3210, 1098, 2447, 2568, 1101, 497, 250, 4149, 1114, - 1182, 1183, 1880, 4460, 3521, 881, 1007, 1927, 1188, 2810, - 483, -3107, 289, 3892, 4367, 283, 1969, 3916, 3694, 1694, - 502, 296, 3283, 2230, 2022, 747, 1692, 1770, 2230, 294, - 2330, 3231, 1939, 1152, 285, 1158, 301, -3107, -3107, 482, - 1556, 2462, -2730, -3050, 311, 2230, 2458, 1208, 1800, 2466, - 1221, -2731, 2825, 1802, 454, 2000, 147, 3501, 1502, 866, - 2451, 991, 1243, 2178, 225, 971, 506, 2963, 2214, 1600, - -3107, 866, 4120, 4457, 2559, 494, 3604, 866, 487, 2798, - 2936, 2539, 2540, 2937, 3832, 4470, 1199, 1887, 956, -3107, - 2941, 4092, -3099, 2944, 845, 845, 845, -2052, 3703, 523, - 524, -2967, 4105, 3801, 1216, 3851, 4266, 2998, 3018, 1322, - 2972, 1489, 3756, 3810, 52, 2165, 3426, 1150, 1947, 1586, - 3756, 846, -3107, 3023, 1108, 1465, 3073, 3074, 2693, 2552, - 2439, 2553, 295, 849, 1738, -813, 985, -3024, 1484, 1141, - -3107, 2018, 507, 181, 3762, 1988, 2664, 3415, 2001, 2467, - 235, 3511, 2665, 1608, 2776, 2988, 2799, 52, 1703, 1015, - -3107, 2894, 4157, 653, 2394, 3615, -3107, 2448, 3089, 285, - 2198, 241, 3064, 1206, 2696, -2165, -813, -813, 2620, 275, - 2483, -2165, 3859, 2230, 3326, 291, 758, 1272, 1115, 2199, - 1802, 1549, 866, 22, 1969, 1315, 2629, 2847, 2549, -3107, - 2666, -3107, 3823, 4439, 1612, 2938, 2496, 1315, 3517, -3050, - 1285, -1333, 4069, 3962, 3695, 260, 52, -1333, 3006, -2969, - 3256, 181, 2789, 507, 3050, 3051, 2620, 3043, 107, -2165, - 3256, -3107, 1158, -1331, 3011, 3703, 181, 161, 2129, -1331, - 3993, 3994, 3704, -3107, 3631, 2742, -3095, 2843, 865, 4060, - 1537, 3241, 965, 866, 880, 4074, 207, 3088, 2742, 726, - 4421, 3806, 4158, 2742, 866, 878, -3107, 2870, 846, 1165, - -2771, 1866, 4301, 1003, 3379, 1165, 1573, 3044, 941, 3991, - 4159, 750, 751, 3609, 52, 1315, 3563, 995, 1859, 147, - 1002, 1524, 2137, 2710, 2000, 2347, 2234, 1036, 971, 2338, - 2992, 757, 845, 4461, 3914, 1577, -3105, 1995, 760, 4294, - 451, -1333, -3070, -2959, 1805, 2460, 3291, -2959, 1062, 866, - 2461, 2138, 3915, 4295, -3107, 3379, 4070, 774, 1236, 3306, - 1995, 498, 2226, -1331, 148, 2406, 2854, 2235, 1860, 1116, - 1013, 2993, 452, 507, 2621, -1333, 1771, -1333, 3950, 2348, - 3242, 3991, 2214, 3610, 1936, 448, 3867, 2002, 4403, 3459, - 3455, 2844, 3757, 186, 2743, 2214, 1209, -1331, 275, -1331, - -813, 1210, 1862, 4163, 4060, 3467, 186, 2745, 4368, 3704, - 1598, 2214, 2747, -2989, 852, 1886, -2677, 2001, 3042, 108, - 3571, 874, 2621, 3480, 3046, 3753, 2214, 1803, 162, 1015, - 1695, 3186, 2023, 874, 943, 4071, 1581, 2497, 2484, 3408, - 2214, 874, 286, 3616, 3409, 1117, 2214, 972, 1118, 260, - 2790, 2214, 1550, -2969, 3518, -813, 4440, 508, 1000, -3108, - 1000, 1119, 1010, 4160, 1033, 972, 2848, 4150, 3281, 508, - 845, 845, 845, 870, 276, 508, 1966, 845, 845, 845, - 1825, 507, 1485, 1825, 52, 2550, 1140, 2811, 23, 3065, - 1000, 1120, 2939, 845, 3605, 1825, 845, 1142, -2740, 2410, - 2003, 242, 845, 845, 845, 845, 845, 1227, 1771, 713, - 3254, 2697, 3278, 2416, 480, 3279, 1579, 1067, 654, 52, - 251, 2200, 1246, 1014, 801, 1110, 802, 468, -3107, 3024, - 2707, 3522, 845, 509, 2229, 508, 801, 845, 802, 2414, - 2619, 454, 801, -2738, 802, 509, 930, 455, 2541, 510, - 1486, 509, 3427, 480, 3356, 1818, 1818, 1818, 3620, 3410, - -3107, 510, 1286, 3715, 1803, 870, 3906, 510, 3763, 3325, - -3107, 1838, 292, 3301, 841, 2988, 1877, 286, 3257, 2201, - -2993, 3502, 2019, 1015, 480, 236, 3793, -3107, 2503, 480, - 508, 2474, 1143, 2485, 740, 2777, 972, -43, -3107, 1169, - 2905, 3326, 2895, -3107, -2677, 1989, -1333, 3592, 1536, 186, - 1863, 509, 186, 2202, 2170, 1867, 508, 261, 186, 1121, - -2967, 3617, -813, 4422, 2580, -2967, 2002, 510, -1331, 3174, - 852, 4267, 4251, 1971, 2496, -3109, 260, 3173, 3053, 1490, - -2969, 2133, -2967, 3907, 3043, 1866, 3175, 3428, -3009, -3065, - 4272, 508, 874, -3107, 3523, 809, 3852, 801, 1997, 802, - 2837, 480, 508, 276, 3624, 2632, 509, 809, -2959, 2803, - -1338, -3024, 3632, 809, 798, 799, 4202, 840, 1704, 1465, - 1231, 3758, 510, 3540, 2215, 868, 3995, -1965, 1957, 3758, - 541, -2052, 509, 1051, 3044, 3764, 944, 868, 3327, 186, - 186, 2167, 3019, 1217, 2465, 868, 2467, 511, 510, 1161, - 2973, -2973, 186, 186, 3416, 2800, 2203, 508, 801, 511, - 802, 3765, 456, 874, 2016, 511, 186, 509, 868, 801, - 2452, 802, 1887, 260, 302, 874, 508, -2969, 509, 2003, - 2592, 4093, 1122, 510, 2452, 226, 2165, 1123, 1124, 3796, - -3009, 262, 4106, 480, 510, 457, 186, 2877, 4195, 480, - 491, 3012, 772, -1965, 4151, 2874, 3302, 1321, 2878, 2723, - 1535, 1491, 3586, 480, 3486, 841, 841, 841, 2216, -1965, - -2967, 3723, 3724, 3256, 801, 511, 802, 1052, 809, 2544, - 1010, 3171, 480, 509, 845, 1209, 870, 227, -3009, 941, - 1210, 3606, 1538, 2407, 2408, 3507, 874, 448, -1336, 510, - 1051, -1338, 509, 874, -288, 1689, 1869, -2959, -2959, 3749, - 3503, 261, 1673, 3755, 1674, 2204, 2128, 1678, 510, 972, - 512, 3292, 1051, 1762, 186, 2497, 1688, 1693, 3413, 1153, - 511, 3286, 512, 2024, 508, 2175, 1671, 1672, 512, 809, - 480, 1701, 1596, 263, 1696, 2542, 1681, 3860, 186, -2967, - 809, 1039, 1315, 186, -2967, -813, 511, 3963, 503, 957, - 1599, 186, 1705, 748, 188, 188, 4423, -3107, 840, 840, - 840, -2967, 2983, 3013, 188, 3524, -2165, -2165, 1292, 1868, - 870, 3303, 845, -3095, 2502, 4369, 2398, 2399, 1237, 207, - 689, 511, 2404, 3674, 1052, 2405, 131, 513, 512, 1573, - 3258, 2004, 511, 3815, 131, 809, 868, 1125, 3794, 513, - 509, 448, 3355, 499, 3357, 513, 1052, 2413, 3696, 3996, - 186, 1532, 186, 186, 1666, 1861, 510, -1965, 3525, 4152, - 186, 972, 2441, 4216, 3833, 2658, 201, 480, 2495, -1336, - 4069, 2501, 4390, 855, 1937, 262, 490, 3607, -813, 3244, - 3245, 3246, 3247, 512, 2915, 2492, 186, 511, 2215, 480, - 2219, 4224, 1169, 2476, 1158, 3411, 1039, 1835, 1169, 3235, - -3107, 2215, 3627, 841, 3396, 513, 511, 868, 3304, 512, - 3982, 186, 3766, 1702, -565, 252, 3951, 2215, 2205, 868, - 207, 186, 469, 186, 455, 514, 1716, 714, 261, 186, - 3873, 2580, 2215, -3070, 2415, 3855, 2792, 514, -3109, -2967, - 715, 1599, 480, 514, 512, 1582, 2215, 3176, 1947, -3109, - 1886, 207, 2215, 3621, -3107, 512, 480, 2215, 713, -2989, - 513, 1938, 1231, 3097, -3107, 480, 207, 3262, 1527, 186, - 491, 3032, 480, -3107, 528, -2959, 1116, 263, 3676, -2959, - -1965, 3263, -2824, 3265, 4070, 3530, 513, 3473, -3107, 1835, - 868, 764, 1874, 1209, 181, -2826, 1583, 868, 1210, 1573, - 1300, 3387, 3157, 514, 3542, 3327, 840, 3622, 1891, 1885, - 512, -2828, 542, 2927, 511, -3132, -3107, 2188, -2830, 3982, - 852, 513, 3877, 3385, 2668, 261, 2482, 3296, 1825, 512, - 971, 4076, 513, -3133, 856, 3541, 870, -1771, 4127, -2989, - -2822, 841, 841, 841, 186, -2677, -2817, 3908, 841, 841, - 841, 2506, 1117, 480, -2677, -2677, 780, -1965, 514, -2677, - 3205, 2650, 262, 4071, 841, 3909, -3107, 841, 1119, 855, - 2004, 1987, 1771, 841, 841, 841, 841, 841, 3030, 3422, - 488, 2764, 3910, 3259, 514, -2618, 3, 513, 2514, 4066, - 3348, 2423, 3350, 2174, 662, 2212, 1997, -288, 3177, 456, - 543, 2758, 18, 841, 480, 186, 513, -3009, 841, 303, - 304, 305, 4428, 2588, 4038, 1211, 186, 2767, 2742, 514, - 2858, 65, 3388, 4077, -565, 1212, -7, 255, 2826, 2827, - 514, -2989, 457, 3178, 2829, 2830, 529, 512, 3179, 1718, - 3474, -1965, 3305, 1719, 840, 840, 840, 2841, -1303, 207, - 1265, 840, 840, 840, 3983, -1965, 2585, 3306, 207, 262, - 3745, 1832, 52, 3748, 263, 2529, 3677, 840, -2830, 653, - 840, 186, 26, -288, 3689, -3065, 840, 840, 840, 840, - 840, 1015, 2898, 2899, 2593, 514, 1948, 1949, 2892, -288, - 186, 489, 2140, 2596, 2772, 2773, 3270, -765, 2688, 2928, - 207, 153, 1613, 530, 514, 4370, 840, 3492, 2689, 4039, - -3107, 840, 885, 66, 513, 2919, 2920, 874, 4040, 65, - 1835, 1573, 2167, 4041, 2190, 306, 1121, 3389, 2675, 3678, - 886, 531, 3187, 4444, -3107, 2017, 41, 2749, 2964, 2403, - 2966, 2403, 854, 2403, 2403, 4445, 2403, 2403, 2738, 2141, - 2142, 2143, 2144, 1832, 2145, -3107, 4042, 923, 2814, 2627, - -3107, 263, 1686, 3983, 1950, 1951, 3812, 2974, 3599, 1914, - 3086, 67, 181, 181, 68, 2977, 69, 186, 3600, 2774, - 874, 2476, 2709, 3390, -3107, 3251, 4255, 3827, 3828, 544, - 160, 3679, 256, 3575, 545, 4128, 4255, 70, 186, 2530, - -2959, 3010, 2185, 3033, 3252, 3188, 714, 255, 1614, 3878, - -3107, 66, 514, 207, 1835, -2989, 1644, 3653, -3038, 2755, - 4254, 3936, 3017, 2740, 663, 2673, 508, 2210, 3373, 207, - 3374, 186, 941, 1315, 2146, 2147, 3037, 3038, 2931, -3107, - 2805, 765, 2213, 27, 4038, 2397, 546, -288, 1537, 1122, - 3814, -1771, 181, 480, 3785, 2208, 4072, 130, 2651, 2628, - 1645, 264, 3015, -765, 759, 841, 2243, 508, 3531, 67, - 2768, 52, 68, 188, 69, 2644, -1326, 4073, 186, 3532, - 2763, 532, 3075, 887, 3470, 3901, 708, 3307, 448, 2778, - 3970, 71, 1712, 2356, 186, 70, 766, -2557, 207, 1573, - 1266, -2618, 509, 2254, 4078, 28, 933, 2326, 2329, 186, - 2332, 781, -565, 2337, 2339, 727, 2341, 489, 510, -1771, - 1228, 2346, 3359, 2670, 186, -565, 1646, 971, 4255, 972, - 845, 845, -503, 2873, -2989, 2741, 3984, 1228, 4195, 4039, - 2990, 307, 308, 509, 728, 3638, 2424, 2357, 4040, -2959, - -2959, 4394, 4299, 4041, 3973, 309, 714, -3107, 3030, 510, - 298, 729, 730, 841, 1720, 480, -3089, 1780, 840, 715, - -288, 3985, 256, -3132, 1781, 1976, -503, 207, 1977, 1978, - 2904, 868, 3499, 530, 1832, 3239, 4042, -3132, 1957, 71, - 3007, -3133, 2528, 2443, 654, 3270, 470, 2753, 2510, 2444, - 4327, 3634, 2445, 3494, 2446, -3133, 4395, 752, 2702, 2704, - 9, 531, 10, 3639, 3640, 2148, 2149, 2150, 2151, 2152, - 2153, 2154, 2155, 2156, 1125, 4257, 2496, 186, 3593, 114, - 186, 972, 3738, 1544, 2881, 4257, 874, 186, 3225, 4294, - 874, 861, -503, 448, 868, 3984, 2828, -288, 3391, 3087, - 4211, -2959, 2529, 4295, 981, 852, 3080, -2018, 3211, 4218, - 72, 480, 2806, 3973, 36, 3675, 840, 3654, 536, 537, - 3216, 3217, 471, 480, 186, -3089, 511, 731, 1832, 4079, - 3985, 2441, 186, 186, 2897, 2516, -3009, 2673, 472, 2673, - 3930, 2441, 2521, 2650, 35, 4328, 4206, 2878, 2454, 4112, - 4113, -288, 4155, 4156, 4329, 1519, 2742, 186, 4207, 4331, - 888, -288, 685, 1721, 1722, 4210, 709, 511, 3941, 4213, - -1303, 1712, 4215, 1891, 3677, 1545, -1326, 1229, 2929, 2525, - 874, -288, -1326, 208, 3971, 3902, 209, 934, -2991, 3786, - 1249, 935, 4332, 3392, 1229, -288, 2157, 2775, 1958, 52, - 1959, 73, 207, 470, 3192, 74, -503, -2018, 72, 480, - 3780, 532, 4256, 1647, 2551, 3008, 2930, 4257, 2843, 2626, - 1560, 936, 1589, 2561, 3942, -2018, 1536, 2526, 4206, 763, - 3870, 767, 3360, 480, 538, 1648, 2530, 3678, 507, 990, - 1997, 845, 997, 845, 2517, 2673, 2673, 2925, 1012, 512, - 3101, 3795, 44, 1825, 1975, 1520, 4383, 3043, 1976, 4384, - -503, 1977, 1978, 3495, 3943, 4099, 2914, 845, 3328, 3329, - 4193, 4194, -3038, 1521, 3887, 2751, -1326, 2497, 743, 471, - 39, 3335, 3336, 3888, 2931, 1627, 4414, 3931, -6, 3870, - 512, 845, 732, 3932, 4290, 472, 473, 4291, 508, 73, - 3341, 3342, 2868, 733, 45, 2426, 1524, 3044, 4413, 4429, - -1326, 2529, -1326, 2427, 1805, -503, 2965, 75, 2967, 2702, - 937, 2702, -6, 4385, -6, 1590, 513, 4415, -3089, -503, - 52, 1591, 2844, 3845, 115, 2158, 686, 116, 117, 4245, - 4255, 4434, 1209, 4246, 3970, 2907, -2740, 1210, 1209, 50, - 868, -503, 925, 1210, 868, 4450, 4451, 76, 2159, 1209, - 2867, 4299, 2867, 926, 1210, 1573, 1039, 513, 4435, 2918, - 1780, 4258, 4263, 1573, 509, 4309, 207, 1781, -2018, 870, - 874, 874, 874, 1315, 3045, 744, 745, 4100, 2674, 46, - 510, -945, 852, 2679, 2680, 2681, 2682, 2683, 2684, 2685, - 2686, 54, 4436, 77, 3151, 78, 687, 4437, 2942, 2943, - 186, 4101, 4102, 4103, 2194, 4300, 2631, 52, 1841, 474, - 1538, 507, 4449, 1116, 514, 2195, 1522, 2713, 2218, 1209, - 1649, 734, 57, 3101, 1210, 1650, 79, -945, 1209, 2426, - 2651, 4438, 972, 1210, 868, 2530, 62, 2427, 4294, -945, - -3089, 186, 1651, 473, 1652, 76, 4465, 61, 1257, 688, - 870, 845, 4295, 2657, 539, 514, 3972, 1617, 2867, 2867, - 735, 119, 4396, 1618, -3089, -3089, -3089, 208, 972, 874, - 209, 1573, 4397, 4398, 3973, 2760, 80, 736, 56, 1524, - 4418, 2881, 1573, 3809, -945, 4420, 475, 3382, 120, 1117, - 2333, 3974, 1118, 1979, 1980, 2706, 2334, 4378, 2739, 3504, - 122, 689, 4391, 4393, 4382, 1119, 4134, -945, 2706, 3102, - 2833, 124, 2835, 4388, 2403, 4140, 3931, 3250, 2504, 126, - 2782, -2775, 3932, 4143, 79, -2775, 171, 2795, 1209, 3059, - 3227, -1326, 4433, 1210, 3228, 1120, -503, 127, 511, 1532, - 9, -503, 10, -6, 1981, 1982, 2478, 2673, 4399, 2480, - 4443, 2428, 2816, 2429, 181, 81, 2527, 2486, -503, 154, - -503, 2490, 3516, 2428, -945, 2429, 474, 3226, 2493, 4257, - 4452, 4400, 4401, 3366, 80, 4275, 128, 3367, 3971, 134, - 188, 3432, 3433, 3434, 476, 3553, 3554, 2884, 2912, 2886, - 2842, 508, 4276, 4416, 2842, 2889, 2890, 2891, 1204, 1653, - 1207, 3063, 2896, 186, 4478, 135, 2770, 3238, 141, 2326, - 186, 142, 1209, 2908, 2909, 2400, 2401, 1210, 1209, 143, - 1997, 841, 841, 1210, 690, 145, 4277, 3339, 3340, 1807, - 1810, 1813, 3198, 3199, 868, 868, 868, 4043, 146, 2817, - 2674, 2802, 2674, 475, 186, 2797, -945, 4114, 4115, 798, - 799, 2436, 4356, 81, 156, 1840, 4287, 158, 4132, 33, - 34, 512, 165, 1121, 2809, 1844, 1845, 509, 4132, 1654, - 1846, 1847, 1848, 2818, 2819, 4475, 168, 4476, 170, 4477, - 972, 972, 2989, 510, 4278, 3272, 972, 972, 972, 972, - 2875, 2876, 3102, 175, 972, 186, 972, 177, 972, 3435, - 3436, 2888, 3437, 178, 4307, 4308, 4279, 3318, 1820, 1821, - 4312, 189, 229, 4351, 197, -503, -945, 4352, 4353, 2839, - 2840, 3380, -3089, 201, 840, 840, 1979, 1980, 216, 188, - 1992, 1993, 1994, 868, 3277, 217, 737, 738, 513, 222, - 223, 476, 230, 2935, 231, 234, 874, 254, 2674, 2674, - 3570, 258, 259, 264, 874, 2865, 297, 3382, -2709, -2709, - -2709, -2709, 2871, 298, 1279, 1280, 1281, 1282, -2708, -2708, - -2708, -2708, 3118, 443, 508, 450, 3103, 1981, 1982, 1922, - 1923, 1924, 1925, 484, 485, -503, 1122, 3659, 493, 494, - 501, 972, 518, 522, 972, 2912, 527, -945, 635, 646, - 668, 972, 972, 972, 972, 2746, 2748, 2750, 2752, 131, - 874, 699, 874, 710, 711, 725, 723, 1536, 3119, 740, - 755, 756, 207, 761, 762, 768, 3636, 769, -945, 262, - 3120, 770, 798, 799, 772, 777, 514, 778, 876, 922, - 944, 511, 953, 981, -3089, 989, 448, 1039, 1074, 1075, - 509, 1076, 1082, 1088, 1094, 1104, 1106, 1111, 1113, 3407, - 3972, 1536, 1136, 1139, 1149, 3512, 510, 4043, -3089, -3089, - -3089, 874, 1155, 874, 1170, 3121, 1172, 1174, 3973, 3774, - 3775, 1177, 841, 1178, 841, 1179, 1131, 1181, 3438, 3439, - 1184, 3003, 1185, 1192, 1186, 3974, 1187, 1190, 3122, 1213, - 1200, 694, 1202, 1203, 1220, 1222, 1247, 1234, 841, 2673, - 1240, 1249, 3440, 1251, 1254, 1256, 1259, 1261, 1132, 1133, - 1263, 1274, 3031, 1287, 1288, 1283, -945, 1289, 1313, 1316, - 2403, 2403, 841, 2403, 2403, 2833, 1318, 3441, 1501, 1511, - 1517, 1514, 1515, 1540, 1539, 1547, 1542, 1574, 1552, 1554, - 1564, 1557, 1558, 1566, 874, 3123, 1562, 1015, 3574, 3103, - 1578, 1125, 3442, 4357, 512, 1585, 1587, 1603, 972, 1599, - 1601, 1616, 1609, 3381, 1620, 1622, 1625, 1633, 1634, 1635, - 1639, 1640, 3834, 3835, 3836, 840, 1641, 840, 1643, 181, - 1684, 1698, 1709, 1726, 1777, 4357, 1806, 1816, 2657, 1817, - -945, 4221, 1828, 3496, -945, 3497, 1827, 1837, 3203, 1842, - 868, 840, 1851, 1849, 846, 1864, 1869, 1876, 868, 1266, - 1265, 3829, 3830, 4333, 511, 1919, 1921, 1933, 3104, 1966, - 3105, 1972, 1985, 1490, 2010, 840, 2012, 3124, 2014, 3106, - 3107, 513, 3114, 3108, 3109, 2131, 2127, 2134, 2139, 2168, - 3565, 2169, 2171, 2176, 2179, 480, 2197, 2186, 2187, 3443, - 2674, 188, 2189, 2222, 2224, 2225, 3149, 2230, 188, 2232, - 2238, 2240, 2989, 2246, 868, 2247, 868, 2248, 2250, 2330, - 2342, -945, 2349, 2344, 2409, 2417, 2425, 2435, 2436, 2450, - 2454, 2456, 3444, 2457, 2459, 2463, 3445, 3446, 2464, 2469, - 4048, 2470, 841, 3182, 2467, 2471, 3183, 3126, 3184, 3185, - 2473, 2479, -2664, 3191, 972, 3194, 3195, 3196, 3197, 2403, - 2481, 2487, 2488, 3447, 2489, 3204, 2491, 3956, 3957, 3644, - 2511, 2494, 2505, 2507, 2513, 868, 2519, 868, 2522, 514, - 1532, -945, 3924, 2523, 2535, 2567, 2569, 512, 3218, 2570, - 2581, 2572, 2583, 2590, 2594, 2601, 2602, 2623, 2673, 2630, - 985, 2645, 2659, 2669, 787, 2660, 843, 2677, 2699, 860, - 2711, 2714, 2715, 1892, 1893, 1894, 1895, 883, 3866, 918, - 1896, 2724, 2727, 3233, 1532, 2729, 2733, 2732, 3127, 2734, - 2737, 972, 2738, 1536, 4055, 1536, 961, 964, 1897, 1898, - 2753, 961, 2756, 2761, 2764, 840, 2766, 874, 993, 874, - 2781, 3104, 260, 3105, 2796, 2786, 2807, 2820, 868, 3129, - 2821, -945, 3106, 3107, 513, 1038, 3108, 3109, 2822, 2823, - -2752, 1771, 2872, 2887, 2497, -2739, 2529, 2496, 2916, 1060, - 2530, 1066, 1069, 2940, 1536, 2969, 2970, 1899, 2978, 2979, - 2986, 2999, 2991, 874, -2733, 3000, 3005, 3021, 3022, 2651, - 2650, 3069, 3048, 3076, 3713, 3714, 3079, 3081, 3083, 920, - 3090, 3091, 3094, 3099, 3100, 3117, 3143, 3115, 3145, -945, - 947, 3146, 3155, 3162, 3166, 3448, 1900, 3669, 3159, 3206, - 3312, 978, 980, 3164, 3782, 3169, 3208, 3213, 3215, 3221, - 3236, 3219, 3324, 3223, -2669, -2737, 3240, 3232, 3264, 2673, - 2992, 3266, 3275, 2993, 3288, 2403, 3290, 3919, 874, 3281, - 3295, 3297, 514, 3300, 3314, 3320, 3319, 3032, 1176, 3033, - 4048, 3334, 3337, 4162, 3064, 3401, 3065, 3351, 1087, 3841, - 3371, 3376, 3394, 3377, 3397, 3399, 3799, 3404, 3403, 3406, - 147, 3468, 3477, 3414, 3478, 3481, 3483, 3505, 3386, 3493, - 3420, 3506, 3513, 3515, -3108, 3529, 3370, 1205, 1205, 1205, - 3465, 3534, 3536, 3543, 3347, 3544, 3359, 3566, 3360, 3471, - 3472, 1671, 3580, 3550, 3578, 3576, 3581, 3584, 3597, 3598, - 3372, 3131, 3623, 860, 3625, 3132, 3626, 3660, 3661, 3663, - 3430, 3691, 3469, 3670, 3709, 1901, 3454, 3475, 3698, 188, - 3708, 3457, 3458, 3701, 3711, 3725, 3733, 3752, 3784, 3461, - 1253, 3463, 2674, 3754, 3654, 3424, 3424, 3653, 188, 3790, - 2673, 3791, 3804, 3898, 188, 3803, 3676, 188, 3715, 188, - 188, 3825, 3826, 3545, 3546, 1196, 3846, 188, 1573, 188, - 3831, 3849, 188, 3862, 3874, 3757, 3856, 3847, 1536, 3865, - 3880, 1902, 3884, 3896, 3891, 1536, 3928, 3899, 3934, 3935, - 3938, 868, 3133, 868, 3902, 3854, 972, 4348, 3926, 3901, - 3937, 3965, 3966, 3895, 1943, 1944, 1945, 3967, 3968, 4064, - 3992, 3431, 4085, 1323, 4057, 4091, 4094, 4098, 4104, 4095, - 4107, 1903, 4118, 1497, 1499, 4108, 4119, 874, 4111, 874, - 3462, 2448, 3466, 4142, 4146, 4309, 1532, 868, 1532, 4354, - 4167, 4410, 3895, 1534, 3476, -2830, 4464, 4411, 4468, 4466, - 3602, 4473, 3134, 4288, 21, 4467, 4480, 3520, 112, 110, - 164, 1196, 775, 300, 152, 1573, 281, 492, 504, 1571, - 155, 526, 1135, 284, 1691, 282, 3876, 1311, 3925, 2441, - 3744, 753, 2617, 4154, 3193, 3728, 3822, 1532, 3201, 749, - 3726, 3212, 3425, 3151, 4096, 1205, 3969, 1946, 4109, 2633, - 1081, 1607, 868, 2771, 3312, 2253, 3577, 4454, 3154, 3811, - 3872, 2622, 3922, 1904, 3163, 4205, 4286, 4417, 4419, 3802, - 4220, 1513, 3921, 1510, 1624, 973, 4264, 1991, 1629, 1631, - 4135, 4136, 3137, 1000, 4139, 4147, 2422, 3500, 3220, 442, - 2403, 1711, 1276, 4063, 3230, 3537, 3234, 1765, 1717, 2509, - 2449, 2913, 1219, 2397, 3485, 3498, 3840, 3838, 2546, 1858, - 921, 1225, 1270, 1875, 3562, 2545, 3596, 2563, 3249, 1158, - 1278, 2926, 974, 1934, 1931, 3271, 2975, 1314, 2586, 3274, - 3273, 188, 1595, 1984, 2009, 3475, 2997, 2603, 3285, 1606, - 3139, 2674, 3284, 1196, 188, 3646, 3613, 3773, 2013, 3528, - 3316, 1518, 3789, 2635, 2647, 2945, 3028, 2946, 3323, 3333, - 3331, 3085, 3601, 2182, 3591, 3047, 1905, 2687, 1034, 1573, - 1575, 678, 684, 3062, 188, 1576, 1775, 1776, 3583, 2221, - -1786, 188, 3690, 1205, 1205, 1205, 3354, 2721, 2722, 3945, - 1205, 1205, 1205, 1823, 3788, 972, 1823, 2663, 2646, 3693, - -2959, 3771, 4067, 4166, -2959, 4082, 1205, 2857, 1823, 1205, - 2241, 2851, 4083, 1884, 1947, 1205, 1205, 1205, 1205, 1205, - 1882, 3961, 3629, 3959, 3843, 3779, 3777, 2903, 2901, 3358, - 1066, 3346, 1857, 2403, 3672, 3344, 2924, 3401, 3619, 3556, - 2175, 868, 3722, 868, 3365, 1205, 3558, 2922, 1027, 1224, - 1205, 1532, 1941, 2584, 3727, 1942, 3055, 1561, 1532, 3056, - 2587, 3057, 3058, 1071, 1853, 3418, 3168, 287, 3642, 2676, - 2605, 3280, 3078, 1752, 1856, 1753, 1754, 4138, 4065, 2838, - 773, 1138, 1917, 4223, 1191, 2255, 2694, 3819, 3161, 1834, - 3658, 2917, 2674, 3349, 3548, 1906, 1948, 1949, 188, 188, - 1907, 3787, 4359, 3255, 2780, 3562, 3633, 4252, 3730, 4247, - 3729, 1173, 4380, 4442, 521, 3299, 3731, 776, 2701, 3421, - 2560, 4249, 1725, 3844, 4058, 2336, 2834, 3460, 4404, 0, - 0, 0, 0, 3798, 0, 0, 188, 0, 1908, 0, - 0, 3699, 0, 0, 0, 0, 972, 0, 0, 0, - 1909, 0, 0, 0, 0, 0, 1536, 0, 0, 0, - 3741, 3743, 3741, 0, 0, 0, 0, 1196, 0, 0, - 4363, 852, 0, 0, 1950, 1951, 4253, 0, 0, 0, - 1926, 1928, 0, 0, 3732, 0, 0, 0, 0, 4270, - 0, 0, 0, 0, 0, 3746, 3747, 0, 3807, 3808, - 3750, 3751, 0, 1311, 0, 0, 0, 0, 3665, 0, - 0, 0, 852, 2674, 0, 0, 0, 0, 0, 1778, - 1779, 3821, 3821, 3890, 3772, 0, 188, 188, 0, 0, - 0, 0, 0, 0, 0, 3781, 0, 0, 0, 0, - 1952, 0, 0, 0, 0, 2947, 0, 0, 1910, 188, - 188, 0, 0, 0, 4222, 0, 0, 0, 0, 0, - 3881, 3882, 0, 0, 0, 3940, 3792, 972, 0, 0, - 0, 0, 0, 3817, 1953, 0, 0, 0, 0, 3817, - 0, 0, 0, 1954, 3805, 0, 0, 0, 0, 0, - 0, 0, 1955, 0, 852, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 1205, 0, 0, - 1780, 0, -1786, 0, 0, 0, 0, 1781, 0, 0, - 1782, 0, 0, 0, 0, -2959, 0, 188, 0, 2948, - 0, 0, 0, 1956, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 2173, 0, - 0, 0, 0, 0, 3929, 0, 0, 0, 2174, 0, - 2181, 0, 2183, 0, 1783, 0, 1784, 1785, 4053, 0, - 0, 0, 0, 0, 4455, 845, 845, 3871, 0, 0, - 0, 0, 188, 3879, 0, 0, 972, 0, 0, 0, - 0, 0, 0, 0, 0, 1205, 3883, 0, 0, 2220, - 4056, 0, 2130, 0, 0, 845, 0, 0, 0, 0, - 0, 0, 1571, 0, 0, 0, -3048, 0, 0, 0, - 0, 0, 0, 845, 0, 0, 0, 0, 188, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 1786, - 0, 1787, 4001, 0, 0, 0, 0, 0, 1788, 0, - 0, 3946, -3048, 2949, -2959, -2959, 1789, 2196, 3741, 1532, - 0, 3964, 0, 0, -3048, 4141, 0, 845, 2211, 0, - 0, 0, 4000, 4049, 0, 1892, 1893, 1894, 1895, 1606, - 0, 0, 1896, 0, 0, 0, 2227, 0, 0, 4061, - 4062, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 1897, 1898, 0, 0, 4068, 0, 0, 0, 0, -3048, - 0, 0, 0, 0, 0, 0, 2403, 4084, 0, 0, - 4087, 4088, 4089, 4090, 4169, 0, 0, 0, 0, 0, - 0, 0, -3048, 0, 1957, 0, 0, 0, 1958, 0, - 1959, 0, 0, 0, 0, -1786, 0, 0, 0, 1899, - 0, 0, 0, 0, 0, 4200, 1775, 0, 0, 4126, - 0, 0, 0, 1790, 0, 3118, 0, 0, 4133, 0, - 0, 4137, 1571, 4212, 0, 0, 0, 0, 0, 3152, - 0, 0, 4219, 3741, 0, 0, 0, 0, 1900, -3048, - 2950, 0, 2477, 0, 0, 0, 0, 0, 0, 0, - 0, 1823, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 3119, 1791, 0, 0, 0, 1792, 0, 0, 972, - 0, 0, 0, 3120, 0, 0, 972, 0, 0, 0, - 972, 0, 0, 972, 0, 2258, 2259, 2260, 2261, 2262, - 0, 2263, 2264, 0, 0, 0, 4174, 4175, 4176, 4177, - 4178, 0, 1015, 4180, 4181, 4182, 4183, 4184, 4185, 4186, - 4187, 4188, 4189, 4190, 0, 0, 4192, 0, 3121, 0, - -1786, -3048, 0, 0, 4204, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 4208, 0, 4209, 4200, 0, - 0, 3122, 2951, 0, 0, 0, 0, 4217, 0, 0, - 0, 1917, 0, 4049, 0, 2564, 0, 1901, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 2266, 0, - 2267, 2268, 2147, 2269, 2270, 2271, 2272, 2273, 2274, 0, - 0, 0, 0, -3048, 0, 0, 4200, 4200, 0, 0, - 0, -3048, 4200, 0, 0, 4200, 0, 0, 3123, 4200, - 4200, 0, 1196, 0, 0, 972, 0, 0, 972, 4361, - 0, 0, 0, 1902, 0, 0, 0, 0, 0, 0, - 480, 0, 0, 0, 0, 0, 2597, 0, 2598, 2599, - 2600, 0, 0, 4379, 0, 0, 0, 0, 0, 0, - 2275, 0, 0, 0, 2614, 0, 0, 0, 2615, 4389, - 2616, 0, 0, 1903, 0, 0, 2625, 0, 0, 0, - 0, 0, 4200, 0, 0, 0, 4379, 4200, 0, 0, - 0, 0, -3048, 0, 0, 0, 0, 4427, 0, -3048, - 3124, 4297, 4298, 0, 4303, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 4306, 0, -3048, 0, 0, 4310, 4311, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 1793, - 0, 0, 0, 0, 4360, 0, 0, 4362, 0, 0, - 4364, -3048, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 3125, 0, 0, 1904, 0, 0, 0, 0, - 3126, 0, 2276, 2277, 2278, 2279, 2280, 4479, 0, 2155, - 2281, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 1534, 0, 0, 2643, 507, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 3261, - 0, 844, 0, 0, 0, 2282, 0, 0, 0, 875, - 0, 0, 1794, 0, 1094, 0, 0, 2648, 0, 0, - 0, 875, 2649, 1795, 0, 0, 0, 0, 0, 875, - 2283, 2667, 1571, 0, 1796, 0, 0, 0, 0, 0, - 0, 3127, 0, 0, 0, 0, 0, 0, 3128, 0, - 0, 0, 875, 1524, 0, 0, 0, 0, 1905, 0, - 0, 0, 0, 1205, 1205, 0, 0, 0, 0, 0, - 2708, 0, 3129, 0, 0, 0, 841, 841, 2720, 2720, - 0, 0, 0, 0, 0, -3048, 2726, 0, 0, -3048, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 3130, 0, 0, 0, 0, 1797, 841, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 789, 0, 0, 0, 841, 0, 790, 791, 0, 0, - 0, 0, 2678, 0, 0, 0, 2285, 0, 1798, 0, - 0, 0, 793, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 1752, -3048, 1753, 1754, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 841, 840, - 840, 0, 0, 0, 0, 0, 0, 1906, 0, 0, - 0, 0, 1907, 0, 1198, 0, 0, 0, 0, 0, - 0, 0, 844, 844, 844, 0, 0, 0, 0, 840, - 0, 2287, 1215, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, -3048, 840, 0, 0, - 1908, 0, 2289, 0, 0, 0, 0, 0, 0, -3048, - 875, 0, 1909, 0, 3131, 0, 0, 2574, 3132, 0, - 0, 0, 0, 0, 0, 2290, 0, -2539, 0, 0, - 0, 0, -2539, -3048, 0, 0, -2539, -2539, -2539, 0, - 0, 0, 0, 0, -2539, 2575, 0, 0, 2855, 0, - 0, 840, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 1775, -3048, 1525, 794, 795, - 796, 875, 0, 0, 0, 0, 0, 0, 0, 0, - 797, 0, 0, 875, 1205, 3133, 1205, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 1823, 0, 0, 0, - 1910, 0, 0, 0, 0, 0, 0, 0, 508, 0, - 1205, -3048, 0, 2911, 0, 0, 0, 0, 0, -2539, - 0, 0, 0, 0, -3048, 0, 0, 0, 0, 0, - -3048, 0, -3048, 0, 1205, 0, 0, 0, 2294, 2295, - 2296, 860, 0, 0, 1572, 3134, 0, 0, 0, 0, - 0, 0, 0, 0, 875, 0, 0, -2539, 3135, 0, - 0, 875, 0, -2539, -2539, 0, 798, 799, 800, 0, - 844, 0, 0, 0, 0, 0, 0, 0, 0, -2539, - 0, 0, 3136, 0, 1526, 0, 0, 0, 803, 804, - 805, 0, 0, 0, 2976, 0, 0, 806, 0, 0, - 510, 0, 0, 0, 0, 0, 0, 0, 1571, 0, - 0, 0, 0, 0, 0, 0, 2614, 0, 0, 0, - 0, 0, 0, 0, 0, 3137, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 3016, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 2298, 2299, 2300, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 3138, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 808, 0, 0, 3139, 0, 0, -2539, 0, 0, 3140, - 0, 3141, 0, 0, 0, 0, 3054, 0, 0, 0, - 0, 0, 0, -2539, 1205, 0, 0, 0, 844, 844, - 844, 3153, 0, 0, 0, 844, 844, 844, 1824, 0, - 2911, 1824, 1196, 0, 1571, 1836, 0, 0, 0, 0, - 0, 844, 0, 1824, 844, 1571, 0, 0, 0, 0, - 844, 844, 844, 844, 844, -2539, -2539, -2539, 0, 0, - 0, 0, 0, 0, 0, 0, 0, -2539, 511, 0, - 0, 0, 0, 0, 0, 0, 0, 0, -2539, -2539, - 844, 0, 3052, 0, 0, 844, 0, 0, 0, 0, - 0, 0, 0, 0, 0, -2539, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 3061, 3061, 0, 0, 0, - 0, 0, 3072, 0, 0, 0, 0, 1918, 0, 810, - 0, 0, 0, 0, 0, -2539, 0, 1836, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, -2539, -2539, -2539, -2539, -2539, 0, 0, - 0, 0, -2539, 0, -2539, 0, 2606, 0, 0, 0, - 0, -2539, 0, 0, 0, -2539, -2539, -2539, 0, 0, - 0, 860, 0, 0, -2539, 0, 2855, -2539, 0, 0, - 0, 512, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, -2539, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 811, 812, 0, 0, - 0, 0, -2539, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 1892, 1893, 1894, 1895, -3107, - 0, 0, 1896, 0, 0, 0, -2539, 0, 0, 0, - 0, 0, 0, 507, 0, 0, -2539, 0, 0, 2607, - 1897, 1898, 0, 0, 0, -2539, 0, -2539, 513, 0, - 0, 0, 0, 0, -2539, 948, 0, 0, 0, 0, - -2539, 0, 0, 0, 0, -2539, 0, 814, 0, 0, - -2539, 0, 0, -2539, -2539, -2539, -2539, 0, 0, 0, - 0, 789, -2539, -2065, 0, 0, 0, 790, 791, 1899, - 0, 0, 0, 815, 0, -2539, 0, 0, 0, 0, - 0, 816, 0, 793, 0, 0, 0, 0, 0, 0, - 1999, 0, -2065, 0, 0, 0, 3248, 2643, 0, 0, - 0, 0, 844, 0, 0, -2539, 817, 0, 1900, 0, - 0, 480, 186, 0, 0, 875, 0, 0, 1836, 0, - 0, 0, 0, 0, 0, 0, 514, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, -2539, 789, 0, - 0, 0, 0, 0, 790, 791, -2539, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 793, 0, 0, 0, 0, 0, 0, 0, 875, 0, - 0, 0, 0, 0, 0, -2539, 0, 3317, 0, 0, - 0, -2539, -2539, 0, 0, 0, 0, 0, 0, 0, - 844, 0, 789, 0, 0, 0, 0, -2539, 790, 791, - 0, 0, 1836, 0, 0, 0, 0, 1572, 0, 0, - 0, 0, 0, 0, 793, 0, 0, 1901, -2539, 0, - 0, 0, 0, 860, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 794, - 795, 796, 0, -2539, -2539, 0, 0, 0, 0, 0, - 0, 797, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 1902, 0, 0, 0, 0, 0, 508, - 0, 0, -2539, 0, -2539, 0, -2539, 0, 2576, 0, - -2539, 0, -2539, -2539, -2539, -2539, 0, -2539, -2539, 2577, - 0, 0, 0, 0, -2539, 0, 0, 0, 0, 0, - 0, 0, 0, 1903, -2539, 0, 0, 0, 0, 3491, - 2638, -2539, 0, 0, 0, 0, 794, 795, 796, 0, - 0, 2608, 0, 0, 0, 0, 0, 0, 797, 800, - -2539, 0, 0, 0, 0, 0, 0, 0, -2539, 0, - 0, 0, 3510, 0, 0, 509, 0, 0, 0, 803, - 804, 805, 0, -2539, -2539, -2539, 508, 0, 806, 0, - 0, 510, 0, -2539, 0, -2539, 0, 1572, 0, -2539, - 794, 795, 796, 0, 0, 0, -2539, -2539, 0, 0, - 0, 0, 797, -2539, 0, 0, 0, 0, 0, 3487, - 3488, 3489, 3490, -2539, 0, 1904, 1824, 0, 0, 0, - 0, 0, 0, 3547, 0, 0, 0, 0, 0, 0, - 0, 3551, 0, 3552, 875, 0, 800, 0, 875, 0, - 0, 0, 0, -2539, 0, 0, 0, 3508, 3509, 0, - 0, 0, 509, 0, 0, 0, 803, 804, 805, 0, - 0, 808, 0, 0, 0, 806, 0, 0, 510, 0, - 0, -2539, -2539, -2539, -2539, -2539, 0, 0, 0, 0, - -2539, 0, -2539, 0, 0, 0, 0, 0, 0, -2539, - 800, 0, 0, -2539, -2539, -2539, 0, 0, 0, 0, - 0, 0, -2539, 0, 0, -2539, 1063, 0, 0, 0, - 803, 804, 805, 0, 0, 0, 1918, 0, 1905, 806, - 0, -2539, 0, 0, 0, 0, 0, 0, 875, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 511, - -2539, 0, 0, 0, 0, 0, 0, 0, 808, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, -2539, 0, 0, 0, 3637, 0, - 0, 0, 0, 0, -2539, 0, 0, 0, 0, 0, - 0, 0, 0, -2539, 0, -2539, 0, 0, 3649, 3652, - 810, 0, -2539, 0, 0, 0, 0, 0, -2539, 0, - 0, 0, 808, 0, 0, 0, 0, 0, 1999, 1572, - 3668, -2539, 0, 3671, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 1752, 511, 1753, 1754, 0, - 0, 0, 0, -2539, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 1906, 0, 0, - 3710, 0, 1907, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 512, -2539, 0, 0, 0, 0, 0, 0, - 3645, 0, 0, 0, 0, 0, 0, 810, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 811, 812, 0, - 1908, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 1909, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, -2539, 0, 0, 0, 0, 0, - 0, 0, 0, 3649, 0, 0, 3652, 0, 875, 875, - 875, 810, 0, 0, 0, 0, 0, 0, 0, 513, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 512, - 0, 0, 2609, 0, 0, 0, 0, 0, 814, 0, - 2350, 0, 0, 2351, 0, 0, 0, 0, 0, 0, - 0, 1571, 0, 0, 811, 812, 0, 0, 0, 0, - 0, 2352, 0, 0, 815, 0, -2539, 1572, 0, 0, - 0, 0, 816, 0, 2353, 0, 0, 0, 0, 0, - 1910, 0, 0, 3769, 0, 0, 0, 0, 0, 0, - 0, -2539, -2539, 0, 0, 0, 0, 817, 844, 844, - 0, 0, 0, 186, 0, 0, 513, 875, 811, 812, - 0, 0, 0, 0, 0, 0, 0, 514, 0, 0, - 0, 0, 0, 0, 3842, 814, 0, 0, 0, 0, - -2539, 0, -2539, 0, -2539, 0, 0, 0, -2539, 0, - -2539, -2539, -2539, -2539, 0, -2539, -2539, 0, 1571, 0, - 0, 815, 0, 0, 0, 494, 0, 0, 0, 816, - 0, 0, -2539, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 814, - 0, 0, 0, 0, 817, 0, 0, 0, -2539, 0, - 186, 0, 0, 0, 0, 0, -2539, 3885, 0, 0, - 0, 0, 3886, 0, 514, 815, 0, 0, 0, 0, - 0, 0, 0, 816, 0, 0, 0, 0, 0, 0, - 0, -2539, 0, 0, 0, 0, 0, -2539, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 817, 0, - 0, -2539, 0, 0, 186, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 3949, 3954, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 3979, 3990, 0, 0, 0, 4052, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 948, 0, 0, 0, 0, - 0, 0, 0, 0, 0, -2539, 0, 0, 0, 0, - -2539, 0, 1571, 3949, -2539, -2539, -2539, 0, 3954, 0, - 0, 0, -2539, 0, 0, 0, 0, 0, 0, 0, - 4086, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 4097, 0, 0, 0, 0, - 0, 0, 2354, 2355, 0, 0, 4110, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 4125, 844, - 0, 844, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 1824, 0, 2173, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 875, 844, 0, 0, 0, 0, - 4144, 0, 875, 4145, 0, 0, 0, -2539, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 844, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 2356, 0, 0, - 0, 0, 0, 0, 0, -2539, 0, 0, 0, 0, - 4168, -2539, -2539, 4170, 4171, 4172, 4173, 0, 875, 0, - 875, 0, 0, 4179, 0, 0, 0, -2539, 0, 0, - 0, 0, 0, 0, 0, 0, 4191, 0, 0, 0, - 0, 0, 4199, 0, 0, 0, 0, 0, 4125, 4125, - 0, 2357, 0, 1572, 0, 0, 0, 0, 0, 0, - 2855, 1572, 0, 0, 0, 1158, 0, -342, 0, 2855, - 0, 0, 0, -3107, -3107, -3107, -3107, 0, 0, 875, - -3107, 875, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, -3107, -3107, - 4225, 4226, 4227, 4228, 4229, 4230, 4231, 4232, 4233, 4234, - 4235, 4236, 4237, 4238, 4239, 4240, 4241, 4242, 4243, 0, - 0, 0, 788, 0, 0, 0, 0, 507, 0, 2358, - 860, 4125, 0, 0, -2539, 0, 0, 0, 0, 0, - 0, 0, 0, 860, 0, 0, -2959, -3107, 0, 844, - -2959, -2539, 0, 0, 0, 0, 4273, 0, 0, 0, - 0, 0, 875, 0, 0, 0, 0, 0, 4274, 1572, - 2359, 0, 0, 0, 0, 4199, 0, 0, 2360, 0, - 1572, 0, 0, 0, 0, 0, -3107, 0, 0, 0, - 0, 0, 0, -2539, -2539, -2539, 0, 0, 0, 4292, - 4293, 0, 0, 0, 0, -2539, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, -2539, -2539, 4305, 0, - 0, 0, 0, 4199, 4199, 0, 0, 0, 0, 4199, - 0, 4350, 4199, -2539, 0, 0, 4199, 4199, 0, 0, - 0, 0, 0, 0, 2361, 0, 0, 0, 0, 0, - 0, 0, 4365, 0, 0, 0, 0, 0, 2362, 789, - 0, 0, 789, -2539, 0, 790, 791, 0, 790, 791, - 0, 0, 0, 2363, 0, 0, 4381, 0, 976, 0, - 0, 793, 0, 0, 793, 0, 0, 0, 1205, 1205, - 0, -2539, -2539, -2539, -2539, -2539, 0, 0, 0, 0, - -2539, 0, -2539, 0, 0, -3107, 0, 4426, 0, -2539, - 0, 0, 0, -2539, -2539, -2539, 0, 0, 1205, 0, - 0, 0, -2539, 0, 0, -2539, 0, 0, 0, 0, - 0, -2973, 0, 0, 0, 0, 1205, 2364, 4448, 4448, - 0, -2539, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 2365, 4453, 0, 0, 0, 0, 4456, 0, 0, - -2539, -3107, 0, 0, 0, 0, 0, 4459, 4463, 0, - -339, 0, 0, 4448, 0, 0, 0, 0, 0, 0, - 0, 4472, 0, 0, -2539, 0, 0, 0, 0, 0, - 1205, 0, 0, 0, -2539, 0, 0, 0, 0, 0, - 0, -3107, 0, -2539, 0, -2539, 0, 0, 0, 0, - 0, 0, -2539, 0, 0, 875, 0, 875, -2539, 0, - 0, 0, 0, 2366, 0, 0, 0, 2367, 0, 0, - 0, -2539, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 2368, 2369, 0, 0, 794, 795, 796, - 794, 795, 796, -2539, 0, 0, 0, 0, 0, 797, - 0, 875, 797, 0, 0, 0, 0, 0, 0, 0, - 0, -2959, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, -2539, 0, 0, 0, 0, 0, 0, - 508, 0, 0, -3107, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 1161, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 875, 0, 0, 0, - 0, 0, 0, 0, -2539, 0, 0, 0, -3107, 0, - 0, 0, 0, 0, 0, 798, 799, 800, 798, 799, - 800, 0, 0, 0, 0, 0, 0, 801, 0, 802, - 0, 0, 0, 3664, 0, 0, 509, 803, 804, 805, - 803, 804, 805, 0, 0, 0, 806, 0, 0, 806, - 0, 0, 510, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, -3107, 0, 807, 0, - 0, 0, 0, 0, 0, 0, -2539, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - -2959, -2959, 0, 0, 0, 0, 0, 0, 0, 0, - 0, -2539, -2539, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 808, - 0, 0, 808, 0, 0, 0, 0, 0, 0, 0, - -2539, 0, -2539, 0, -2539, 0, 0, 0, -2539, 0, - -2539, -2539, -2539, -2539, 0, -2539, -2539, 0, 809, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, -2539, -3107, 0, -3107, -3107, 0, 0, 0, - 0, 0, 0, 0, 0, 875, 0, 875, 0, 0, - 0, 0, 0, 0, 0, -3107, 0, 0, -2539, 0, - -3107, 0, -2845, 0, 0, 0, -2539, 1324, 0, 0, - 511, -2845, 0, 0, 1325, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, -2845, 0, 0, 0, - 0, -2539, 0, 0, 0, 0, 0, -2539, -3107, 0, - 0, 0, 0, 0, 1326, -2845, 0, 0, 0, 0, - -3107, -2539, 0, 0, 0, 0, 0, 0, 810, 0, - 0, 810, 0, 0, 0, 1327, 1328, 1329, 1330, 1331, - 1332, 1333, 1334, 0, 0, 0, -2845, -2845, -2845, 0, - 1335, -2845, 0, 0, 0, 1336, 0, 0, -2845, 0, - 0, 0, 0, 0, 0, 0, 1337, 1338, 1339, 1340, - -2845, 0, -2845, -2845, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 1341, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 1342, 0, 0, 1343, 1344, 1345, -2845, - 1346, 0, 0, 512, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, -3107, 0, - 0, 0, 0, 0, 0, 811, 812, 0, 811, 812, - 0, 0, 1885, 0, 1347, 0, 0, 0, 0, 0, - 0, 0, 0, 1348, 1349, 1350, 1351, 1352, 1353, 1354, - 1355, 0, 0, 0, -2845, 0, 1356, 1357, 0, 0, - 0, 0, 0, 0, 0, 0, 0, -2845, 0, 0, - 0, 0, 0, 0, 0, 0, 480, 0, 0, 0, - 513, 0, 1358, 1359, 0, 0, 1360, 1361, 0, -2845, - -2845, 1362, -2845, -2845, 0, 0, 814, 0, 0, 814, - 0, 0, 0, 1363, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 1364, 0, 0, 0, 0, 0, - 0, 0, 815, 0, 0, 815, 0, 0, 0, 0, - 816, 0, 0, 816, 0, 0, 0, -2845, 1365, 0, - 0, 0, 1366, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, -2845, 0, 817, 0, 1367, 817, 0, - 0, 186, 1368, 1369, 186, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 514, 1370, - 1371, 1372, 1373, 1374, 0, 0, 1375, 0, 0, 0, - -2845, -2845, -2845, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, -2845, 0, 0, 0, 0, -2845, 0, 0, - 0, 0, 0, 0, 0, 1376, 1377, 1378, 1379, 0, - 0, 0, 0, 0, 1380, 1381, 0, 1382, 0, 1383, - 1384, 1385, -2845, -2845, 1386, 1387, 0, 1388, 0, -2845, - -2845, 1389, 0, 0, 0, 0, 3783, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 1390, 1391, 0, 0, 0, 0, 0, 0, 0, 1392, - 1393, 1394, 1395, 1396, 1397, 0, 1572, 0, 0, 0, - 0, 0, 0, 1398, 0, 0, 0, 1399, 1400, 0, - 0, 1401, 0, -2845, 0, -2845, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, -2845, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, -2845, -2845, -2845, 0, 0, 1402, - 0, 0, 0, 1403, 0, 1404, 1405, 1406, 1407, 0, - 0, 0, 0, 0, 0, 1408, 0, 0, 0, 0, - 0, -2845, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 1409, 0, 0, 0, 0, 0, 0, 0, 1410, - 0, 0, 0, 1572, -2845, -2845, -2845, 0, -2845, 0, - -2845, -2845, 0, -2845, 0, -2845, -2845, 0, 0, 1503, - -2845, 0, -2845, -2845, -2845, -2845, 0, 0, 0, 0, - 0, 0, 0, 0, 1411, 1412, 0, 0, -2845, 0, - 0, 0, 0, 0, 0, 0, -2845, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, -2845, - -2845, 0, 0, 0, 0, 0, 0, 1413, -2845, 0, - 1414, 0, 0, 0, -2845, 0, 0, 0, 0, 0, - 0, 1415, 0, 0, 0, 0, 0, 1416, 0, 0, - 0, 1417, 0, 1418, 1419, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 1420, 0, 0, - 1421, 1422, 0, 0, 0, 0, 1423, 0, 0, 0, - 0, -2845, 0, 0, 0, 0, -2845, 0, 0, 0, - 1424, 0, 1425, 1426, 0, 0, 0, 0, 0, 0, - 0, 1427, 1428, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 1572, 0, 0, - 0, 1429, 1430, 1431, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, -2845, -2845, 0, - 0, 0, 1432, 1433, 1434, 1435, -2845, 1436, 0, 0, - 0, 1437, 1438, 0, 0, 0, 0, 0, 0, 1439, - 1440, 0, 0, 0, 0, 0, 0, 1441, 1442, 1443, - -2845, 0, 0, 0, 0, 1444, 0, 0, 0, 0, - 1445, 0, 0, -2845, -2845, -2845, -2845, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 1446, 0, - 0, 0, 0, -2845, -2845, 0, 0, 0, 0, 0, - 0, 1447, 1448, 0, -2845, 0, 0, 1449, 0, 0, - 0, 313, 1504, 0, 0, 314, 0, 0, 0, 0, - 315, 0, 0, 0, 0, 0, 0, 316, 0, 1450, - 1451, 0, 0, -2845, 0, 0, 317, 0, 1452, 0, - 0, 0, 0, 0, 0, 0, 1453, -2845, -2845, 0, - 0, 0, 1454, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 1455, 0, 0, -2845, 0, 0, 0, 1456, - 0, 0, 0, 0, -2845, 0, 0, 318, 319, 0, - 0, -2845, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, -2845, 0, 0, 0, -2845, -2845, -2845, 0, - 0, 0, 0, 0, 0, 0, 0, 320, 0, 1457, - 0, 0, 0, -2845, -2845, 1458, 1459, 0, 1460, -2845, - -2845, 1461, -2845, 0, 0, 0, 0, 321, 1462, -2845, - 0, 322, 0, 0, 0, 0, 0, 0, 0, 0, - 1463, 0, 0, 1464, 0, 0, 0, 0, 0, 323, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, -1379, 0, 0, 1727, - 0, 0, 0, 0, 1728, 1729, 1730, 1731, 0, 0, - 324, 1732, 0, 0, 0, 0, 325, 0, 326, 0, - 0, 0, 327, 0, 0, 0, 328, 0, 0, 0, - 1733, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 329, 0, 0, -1379, 0, 0, 0, - -1379, -1379, -1379, -1379, -1379, 0, -1379, -1379, -1379, -1379, - 0, -1379, -1379, 0, -1379, -1379, 0, -1379, -1379, -1379, - -1379, -1379, -1379, -1379, -1379, -1379, -1379, -1379, 1734, 0, - 330, 0, 0, 0, 0, 0, 0, 0, -1379, 0, - 0, 0, 0, -1379, 0, 0, 331, 0, 0, 0, - 0, -1379, 0, 0, 0, 0, 332, 0, 0, 0, - 0, 0, 0, 0, 0, 1735, 0, 1736, 0, 0, - 0, 0, 0, 844, 844, 0, 0, 0, 0, 1737, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 1738, 844, 333, 0, 0, 0, 0, 0, - 0, 0, 334, 0, 0, 335, 0, 0, 0, 0, - 336, 844, 0, 0, 0, 0, 0, 0, 313, 0, - 0, 0, 314, 0, 0, 0, 0, 315, 0, 0, - 0, 0, 0, 0, 316, 0, 0, 337, 0, 0, - 0, 0, 0, 317, 0, 338, 0, 339, 0, 0, - 340, 0, 0, 341, 0, 0, 0, 0, -1379, 0, - 0, 0, 0, 0, 0, 844, 0, 0, 342, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 318, 319, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 1739, 343, 320, 0, 0, 0, 0, 344, - 0, 345, 1740, 0, 346, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 321, 0, 0, 0, 322, 347, - 0, 0, 0, 0, 0, 0, 0, 0, -1379, 0, - 0, 0, 1741, 0, 0, 0, 323, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, -1379, -1379, -1379, - 0, -1379, -1379, -1379, -1379, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 348, 0, 0, 0, 0, 0, 324, 0, 0, - 0, 0, 0, 325, 0, 326, 0, 0, 0, 327, - 1742, 0, 0, 328, 349, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 329, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 1743, 0, 0, 1744, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 350, 0, 0, 0, 0, - 0, 351, 0, 0, 0, 352, 0, 330, 353, 354, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 331, 0, 355, 0, 0, 1745, 0, - 0, 0, 0, 332, 0, 1746, 0, 0, 0, 0, - 0, 356, 0, 0, 0, 0, 0, 357, 0, 0, - 0, 0, 0, 0, 358, 0, 0, 0, 0, 313, - 359, 0, 0, 314, 0, 0, 0, 0, 315, 0, - 0, 1747, 0, 0, 0, 316, 0, 0, 0, 360, - 0, 333, 0, 0, 317, 0, 0, 1748, 0, 334, - 0, 0, 335, 361, 0, 0, 0, 336, 0, 362, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, -1379, 0, 363, 0, 0, - 0, 0, 0, 0, 337, 0, 0, 0, 0, 0, - 0, 364, 338, 0, 339, 1749, 0, 340, 1750, 0, - 341, 365, 366, 0, 0, 318, 319, 0, 0, 367, - 0, 0, 368, 0, 0, 342, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 369, 0, 0, - 0, 0, 0, 0, 0, 320, 0, 0, 0, 0, - 0, 1751, 0, 0, 0, 0, 0, 0, 0, -1379, - 0, 0, 0, 0, 1752, 321, 1753, 1754, 0, 322, - -1379, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 371, 1755, 323, 0, 0, - 343, 1756, 0, 0, 0, 0, 344, 372, 345, 1757, - 0, 346, 0, 373, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 347, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 374, 324, -3067, - 0, 0, 0, 0, 325, 0, 326, 0, 0, 0, - 327, 1758, 0, 0, 328, 0, -1379, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 375, 0, 0, - 0, 329, 376, 0, 0, 0, 0, 0, 348, 0, - 0, 0, 0, 0, 1759, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 349, 0, 0, 0, 1760, 0, 0, 330, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 331, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 332, 0, 0, 0, 0, 0, - 0, 0, 350, 0, 0, 0, 0, 0, 351, 1761, - 0, 0, 352, 0, 0, 353, 354, 0, 0, 0, - 0, 1762, 0, 0, 0, 0, 0, 0, 1763, 0, - 0, 0, 355, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 333, 0, 0, 0, 0, 0, 356, 0, - 334, 0, 0, 335, 357, 0, 0, 0, 336, 0, - 0, 358, 0, 0, 0, 0, 313, 359, 0, 0, - 314, 0, 0, 0, 0, 315, 0, 0, 0, 0, - 0, 0, 316, 0, 0, 337, 360, 0, 0, 0, - 0, 317, 0, 338, 0, 339, 0, 0, 340, 0, - 361, 341, 0, 0, 0, 0, 362, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 342, 0, 0, 0, - 0, 0, 0, 0, 363, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 364, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 365, 366, - 0, 0, 318, 319, 0, 0, 367, 0, 0, 368, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 369, 0, 0, 0, 0, 0, - 0, 343, 320, 0, 0, 0, 0, 344, 0, 345, - 0, 0, 346, 0, 0, 0, 370, 0, 0, 0, - 1667, 0, 321, 0, 0, -260, 322, 347, -260, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 371, 0, 323, 0, -260, 0, 0, 0, - 0, 0, 0, 0, 372, 0, 0, 0, 788, -260, - 373, 0, 0, 507, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 1297, -260, 0, 0, 348, - 0, 0, 0, 0, 374, 324, 0, 0, 0, 0, - 0, 325, 0, 326, 0, 0, 0, 327, 0, 0, - 0, 328, 349, 0, 0, 0, 0, 0, 0, 507, - 0, 0, 0, 0, 375, 0, 0, 0, 329, 376, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - -260, 0, 0, 350, 0, 0, 0, 0, 0, 351, - 0, 0, 0, 352, 0, 330, 353, 354, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 331, 0, 355, 0, 0, 0, 1524, 0, 0, - 0, 332, 0, 0, 0, 0, 0, 0, 0, 356, - 0, 0, 0, 0, 0, 357, 0, 0, 789, 0, - 0, 0, 358, 0, 790, 791, 0, 0, 359, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 793, 0, 0, 0, 0, 0, 0, 360, 0, 333, - 0, 0, 0, 0, 0, 0, 0, 334, 0, 0, - 335, 361, 0, 0, 789, 336, 0, 362, 0, 0, - 790, 791, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 363, 793, 0, 0, 0, - 0, 0, 337, 0, 0, 0, 0, 0, 0, 364, - 338, 0, 339, 0, 0, 340, 0, 0, 341, 365, - 366, 0, 0, 0, 0, 0, 0, 367, 0, 0, - 368, 0, 0, 342, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 369, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, -260, -260, 0, - 0, 0, 0, 0, 0, 0, 0, 1615, 0, 0, - 0, 0, 0, 0, 1298, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 371, 0, 0, 0, 0, 343, 0, - 0, 0, 0, 0, 344, 372, 345, 0, 0, 346, - 0, 373, 0, 0, 0, 0, 794, 795, 796, 0, - 0, 0, 0, 0, 347, 0, 0, 0, 797, 0, - 0, 0, 0, 0, 0, 374, 0, 0, 0, 0, - 0, 0, -260, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 508, 0, 0, 0, - 0, 1525, 794, 795, 796, 375, 0, 0, 0, 0, - 376, 0, 0, 0, 797, 0, 348, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 1299, 0, 0, 549, - 0, 0, 0, 0, 550, 0, -260, 0, 0, 349, - 0, 551, 508, 0, 0, 0, 0, 0, 0, 0, - 552, 0, -260, 0, 798, 799, 800, 0, 0, 0, - 0, 0, 0, 801, 0, 802, 0, 0, 0, 0, - 0, 0, 509, 0, 0, 0, 803, 804, 805, 0, - 350, 0, 0, 0, 0, 806, 351, 0, 510, 0, - 352, 0, 0, 353, 354, 0, 0, 0, 0, 0, - 798, 799, 800, 0, 807, 0, 0, 0, 0, 0, - 355, 553, 554, 0, -260, 0, 0, 0, 509, 0, - 0, 0, 803, 804, 805, 0, 356, 0, 0, 0, - 0, 806, 357, 0, 510, 0, 0, 0, 0, 358, - 0, 555, 0, 0, 0, 359, 0, 1300, 0, 0, - 0, 0, 0, 0, 0, -260, 0, 0, 0, 0, - 0, 556, 0, -260, 360, 557, 0, 0, 808, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 361, 0, - 0, 1301, 0, 558, 362, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 809, 0, 0, 0, 0, 0, - 0, 0, 363, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 808, 0, 364, 0, 0, 0, - 0, 0, 0, 0, 559, 0, 365, 366, 0, -260, - 0, 0, 0, 0, 367, 0, 560, 368, 0, 0, - 561, 0, 0, -260, 0, 0, 511, 0, 0, 0, - 0, 0, 369, 0, 0, 0, 0, 0, -260, 0, - 562, 0, 0, 0, 0, 563, 564, 565, 566, 0, - 567, 568, 569, 570, 0, 571, 0, 572, 573, 574, - 0, 575, 576, 577, 578, 579, 580, 581, 582, 583, - 584, 585, 511, 0, 586, 0, 0, 810, 0, 0, - 371, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 587, 0, 372, 0, 0, 0, -260, -260, 373, 0, - 588, 0, -260, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, -260, 0, 0, 0, - 0, 0, 374, 810, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, -260, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 589, 512, - 0, 0, 375, 0, 0, 0, 590, 376, 0, 591, - 0, 0, 0, 0, 592, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 811, 812, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, -260, 0, - 0, 593, -260, 0, 0, 512, 0, 0, 0, 594, - 0, 595, 0, 0, 596, 0, 0, 597, -260, -260, - 0, 0, 0, 1302, 0, 1303, 0, 0, 0, 0, - 811, 812, 0, 0, 1304, 1305, 513, 0, 1306, 1307, - 0, 0, 0, 0, 0, 789, 0, 0, 0, 0, - 0, 790, 791, -3107, 0, 814, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 793, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 815, 513, 0, 0, 0, 0, 0, 0, 816, - 0, 0, 0, 0, 0, 0, 0, 598, 0, 0, - 0, 814, 0, 599, 0, 600, 0, 0, 601, 0, - 0, 0, 0, 0, 817, 0, 0, -2065, 0, 0, - 186, 0, 0, 602, 0, 0, 0, 815, 0, 0, - 0, 0, 0, 0, 514, 816, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, -2065, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 817, 0, 0, 0, 0, 480, 186, 0, 0, 0, - 0, 0, 0, 0, 0, 603, 0, 0, 0, 0, - 514, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 604, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 794, 795, 796, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 797, 0, 0, 0, 605, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 606, - 0, 0, 0, 508, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 607, 0, 0, 0, 0, 0, 0, 608, 0, - 0, 0, 0, 0, 609, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 610, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 800, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 611, 0, 0, 0, 0, 0, 509, - 0, 0, 0, 803, 804, 805, 0, 0, 0, 0, - 0, 612, 806, 0, 0, 510, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 613, 1324, 0, 0, 0, - 0, 0, 0, 1325, 0, 614, 615, 0, 0, 0, - 0, 0, 0, 616, 0, 0, 617, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 618, 4003, 1326, 0, 0, 0, 4004, 4005, 4006, - 4007, 0, 0, 0, 4008, 2258, 2259, 2260, 2261, 2262, - 0, 2263, 2264, 619, 1327, 1328, 1329, 1330, 1331, 1332, - 1333, 1334, 4009, 4010, 0, 808, 0, 0, 0, 1335, - 0, 0, 0, 0, 1336, 0, 0, 0, 0, 620, - 0, 0, 4011, 0, 0, 1337, 1338, 1339, 1340, 0, - 0, 621, 0, 0, 0, 0, 0, 622, 0, 0, - 0, 0, 1341, 4012, 0, 0, 0, 0, 0, 0, - 1718, 4013, 1342, 0, 1719, 1343, 1344, 1345, 0, 1346, - 0, 0, 0, 0, 0, 0, 0, 0, 2266, 0, - 2267, 2268, 2147, 2269, 2270, 2271, 2272, 2273, 2274, 0, - 0, 0, 0, 511, 0, 0, 0, 0, 0, 0, - 0, 623, 0, 1347, 0, 0, 624, 0, 0, 4014, - 0, 0, 1348, 1349, 1350, 1351, 1352, 1353, 1354, 1355, - 0, 0, 0, 0, 0, 1356, 1357, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 810, 0, 0, 0, 0, 0, - 2275, 1358, 1359, 0, 0, 1360, 1361, 0, 0, 0, - 1362, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 1363, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 1364, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 1365, 0, 0, - 0, 1366, 0, 0, 0, 0, 512, 0, 0, 4015, - 0, 0, 0, 0, 0, 0, 1367, 0, 0, 0, - 0, 1368, 1369, 0, 0, 0, 0, 0, 0, 0, - 0, 811, 812, 0, 0, 0, 0, 0, 1370, 1371, - 1372, 1373, 1374, 0, 0, 1375, 0, 0, 0, 0, - 0, 0, 2276, 2277, 2278, 2279, 2280, 0, 0, 2155, - 2281, 0, 0, 0, 0, 4016, 0, 0, 0, 0, - 0, 0, 0, 4017, 0, 4018, 0, 0, 0, 0, - 0, 0, -3009, 513, 1376, 1377, 1378, 1379, 0, 0, - 0, 0, 4019, 1380, 1381, 2282, 1382, 0, 1383, 1384, - 1385, 0, 814, 1386, 1387, 4020, 1388, 0, 0, 0, - 1389, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 2283, 0, 0, 0, 0, 0, 0, 0, 815, 1390, - 1391, 0, 0, 0, 0, 0, 816, 52, 1392, 1393, - 1394, 1395, 1396, 1397, 0, 0, 0, 2284, 0, 0, - 0, 0, 1398, 0, 0, 0, 1399, 1400, 0, -3080, - 1401, 817, 0, 4021, 0, 0, 0, 186, 0, 0, - 0, 0, 0, 0, 0, 4022, 0, 0, 0, 4023, - 0, 514, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 4024, 1402, 0, - 0, 0, 1403, 0, 1404, 1405, 1406, 1407, 0, 0, - 0, 0, 0, 0, 1408, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 2285, 0, 0, 0, - 1409, 0, 0, 0, 0, 0, 0, 0, 1410, 0, - 0, 4025, 0, 0, 0, 0, 0, 0, 1746, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 1503, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 1411, 1412, 0, 0, 0, 0, 0, - 0, 0, 4026, 0, 1747, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 4027, 2287, 0, 0, 0, 0, 1413, 0, 0, 1414, - 0, 0, 0, 0, 0, 0, 0, 2288, 0, 0, - 1415, 0, 2289, 0, 1721, 1722, 1416, 0, 0, 0, - 1417, 0, 1418, 1419, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 2290, 1420, 0, 4028, 1421, - 1422, 0, 0, 0, 0, 1423, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 1424, - 0, 1425, 1426, 0, 0, 0, 0, 0, 0, 0, - 1427, 1428, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 4029, 0, 0, 0, 0, 0, - 1429, 1430, 1431, 0, 0, 0, 0, 1752, 0, 1753, - 1754, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 1432, 1433, 1434, 1435, 0, 1436, 0, 0, 0, - 1437, 1438, 0, 0, 0, 0, 0, 0, 1439, 1440, - 0, 0, 4030, 0, 0, 0, 1441, 1442, 1443, 0, - 0, 0, 0, 0, 1444, 0, 0, 0, 0, 1445, - 0, 0, 0, 0, 0, 0, 2293, 0, 2294, 2295, - 2296, 0, 4031, 0, 0, 0, 0, 1446, 0, 0, - 0, 0, 0, 0, 4032, 0, 0, 0, 0, 0, - 1447, 1448, 0, 0, 0, 0, 1449, 0, 0, 0, - 0, 1504, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 4033, 1450, 1451, - 0, 0, 0, 0, 0, 0, 0, 1452, 0, 0, - 0, 0, 0, 0, 0, 1453, 0, 0, 0, 0, - 0, 1454, 4034, 0, 0, 0, 0, -947, 0, 0, - 0, 0, 0, 4035, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - -3080, 1455, 0, 0, 0, 0, 0, 0, 1456, 0, - 0, 0, 4036, 1324, 0, 0, 0, 2298, 2299, 2300, - 1325, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 2301, 0, 0, 0, 0, 0, 0, - 0, 4037, 0, 0, 0, 0, 0, 2250, 1457, 0, - 1326, 0, 0, 0, 1458, 1459, 0, 1460, 0, 0, - 1461, 0, 0, 0, 0, 0, 0, 1462, 0, 0, - 0, 1327, 1328, 1329, 1330, 1331, 1332, 1333, 1334, 1463, - 0, 0, 1464, 0, 0, 0, 1335, 0, 0, 0, - 0, 1336, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 1337, 1338, 1339, 1340, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 1341, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 1342, - 0, 0, 1343, 1344, 1345, 0, 1346, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 1347, 0, 0, 0, 0, 0, 0, 0, 0, 1348, - 1349, 1350, 1351, 1352, 1353, 1354, 1355, 0, 0, 0, - 0, 0, 1356, 1357, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 1358, 1359, - 0, 0, 1360, 1361, 0, 0, 0, 1362, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 1363, - 0, 0, 0, 0, 0, 0, 1158, 0, 0, 0, - 1364, 0, 0, 0, -3107, -3107, -3107, -3107, 0, 0, - 0, -3107, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 1365, 0, 0, 0, 1366, -3107, - -3107, 0, 2945, 0, 2946, 0, 0, 0, 0, 0, - 0, 0, 0, 1367, 0, 0, 0, 0, 1368, 1369, - 0, 0, 0, 0, 0, 0, 0, -1786, 0, 0, - 0, 0, 0, 0, 0, 1370, 1371, 1372, 1373, 1374, - 0, 0, 1375, 0, 0, 0, 0, -2959, -3107, 0, - 0, -2959, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 1376, 1377, 1378, 1379, 0, 0, -3107, 0, 0, - 1380, 1381, 0, 1382, 0, 1383, 1384, 1385, 0, 0, - 1386, 1387, 0, 1388, 0, 0, 0, 1389, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 1390, 1391, 0, 0, - 0, 0, 0, 0, 0, 1392, 1393, 1394, 1395, 1396, - 1397, 0, 0, 0, 0, 0, 0, 0, 0, 1398, - 0, 0, 0, 1399, 1400, 0, 0, 1401, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 789, 0, 0, 0, 0, 0, - 790, 791, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 1402, 793, 0, 0, 1403, - 0, 1404, 1405, 1406, 1407, 0, -3107, 0, 0, 0, - 0, 1408, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 1409, 0, 0, - 0, 0, 0, 0, 0, 1410, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 1503, 0, 0, 0, 0, - 0, 0, -3107, 0, 0, 0, 0, 0, 0, 0, - 1411, 1412, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 2947, 0, 0, 0, 0, 0, 0, 0, - 0, 0, -3107, 1413, 0, 0, 1414, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 1415, 0, 0, - 0, 0, 0, 1416, 0, 0, 0, 1417, 0, 1418, - 1419, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 1420, 0, 0, 1421, 1422, 0, 0, - 0, 0, 1423, 0, 0, 0, 0, 0, 0, -1786, - 0, 0, 794, 795, 796, 0, 1424, 0, 1425, 1426, - 0, 0, -2959, 0, 797, 0, 2948, 1427, 1428, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, -3107, 0, 0, 1429, 1430, 1431, - 0, 0, 508, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 1432, 1433, - 1434, 1435, 0, 1436, 0, 0, 0, 1437, 1438, 0, - 0, 0, 0, 0, 0, 1439, 1440, 0, -3107, 0, - 0, 0, 0, 1441, 1442, 1443, 0, 0, 0, 0, - 0, 1444, 0, 0, 0, 0, 1445, 0, 0, 0, - 798, 799, 800, 0, 0, 0, 0, 0, 0, 801, - 0, 802, 0, 0, 1446, 0, 0, 0, 509, 0, - 0, 0, 803, 804, 805, 0, 0, 1447, 1448, 0, - 0, 806, 0, 1449, 510, 0, 0, -3107, 1504, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 1450, 1451, 0, 0, 1324, - 2949, -2959, -2959, 0, 1452, 0, 1325, 0, 0, 0, - 0, 0, 1453, 0, 0, 0, 0, 0, 1454, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 1326, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 1455, 0, - 0, 0, 0, 0, 808, 1456, 0, 1327, 1328, 1329, - 1330, 1331, 1332, 1333, 1334, 0, 0, 0, 0, 0, - 0, 0, 1335, 0, 0, 0, 0, 1336, 0, 0, - 809, 0, 0, 0, -3107, 0, -3107, -3107, 1337, 1338, - 1339, 1340, -1786, 0, 0, 1457, 0, 0, 0, 0, - 0, 1458, 1459, 0, 1460, 1341, -3107, 1461, 0, 0, - 0, -3107, 0, 0, 1462, 1342, 0, 0, 1343, 1344, - 1345, 0, 1346, 0, 0, 0, 1463, 0, 0, 1464, - 0, 0, 511, 0, 0, 0, 0, 2950, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, -3107, - 0, 0, 0, 0, 0, 0, 1347, 0, 0, 0, - 0, -3107, 0, 0, 0, 1348, 1349, 1350, 1351, 1352, - 1353, 1354, 1355, 0, 0, 0, 0, 0, 1356, 1357, - 0, 0, 0, 810, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 1358, 1359, 0, 0, 1360, 1361, - 0, 0, 0, 1362, 0, 0, 0, -1786, 0, 0, - 0, 0, 0, 0, 0, 1363, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 1364, 0, 0, 2951, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 512, 0, 0, 0, -3107, - 1365, 0, 0, 0, 1366, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 1367, - 811, 812, 0, 0, 1368, 1369, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 1370, 1371, 1372, 1373, 1374, 0, 0, 1375, 0, - 0, 0, 0, 0, 0, 0, 0, 480, 0, 1812, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 831, 0, 513, 0, 832, 833, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 1376, 1377, 1378, - 1379, 814, 0, 0, 0, 0, 1380, 1381, 0, 1382, - 0, 1383, 1384, 1385, 0, 0, 1386, 1387, 0, 1388, - 0, 0, 0, 1389, 0, 0, 0, 815, 0, 0, - 0, 0, 0, 0, 0, 816, 0, 0, 0, 0, - 0, 0, 1390, 1391, 0, 0, 0, 0, 0, 0, - 0, 1392, 1393, 1394, 1395, 1396, 1397, 0, 0, 0, - 817, 0, 0, 0, 0, 1398, 186, 0, 0, 1399, - 1400, 0, 0, 1401, 0, 0, 0, 0, 0, 0, - 514, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 1402, 0, 0, 0, 1403, 0, 1404, 1405, 1406, - 1407, 0, 0, 0, 0, 0, 0, 1408, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 788, 0, 0, 1409, 0, 507, 0, 0, 0, 0, - 0, 1410, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - -1714, 0, 0, 0, 0, 0, 0, 0, -1714, -1714, - -1714, -1714, 0, 0, 0, -1714, 1411, 1412, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, -1714, -1714, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 1413, - 0, 0, 1414, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 1415, 0, 0, 0, 0, 0, 1416, - 0, 0, 0, 1417, 0, 1418, 1419, 0, 0, 0, - 0, -1714, -1714, 0, 0, -1714, 0, 0, 0, 1420, - 0, 0, 1421, 1422, 0, 0, 0, 0, 1423, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 789, 0, 1424, 0, 1425, 1426, 790, 791, 0, 0, - 0, -1714, 0, 1427, 1428, 0, 0, 0, 0, 0, - 0, 0, 793, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 1429, 1430, 1431, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 1432, 1433, 1434, 1435, 0, 1436, - 0, 0, 0, 1437, 1438, 0, 0, 0, 0, 0, - 0, 1439, 1440, 0, 0, 0, 0, 0, 0, 1441, - 1442, 1443, 0, 0, 0, 0, 0, 1444, 0, 0, - 0, 0, 1445, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 1446, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 1447, 1448, 0, 0, 0, 0, 1449, - -1714, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 1450, 1451, 0, 788, 0, 0, 0, 0, 507, - 1452, 0, 0, -3009, -3009, -3009, 0, 0, 1453, 0, - 0, 1297, 0, 0, 1454, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, -1714, 0, 794, 795, - 796, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 797, 0, 0, 0, 1455, 0, 0, 0, 0, 0, - 0, 1456, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, -1714, 0, 508, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 1457, 0, 0, 0, 0, -3009, 1458, 1459, 0, - 1460, 0, 0, 1461, 0, 0, 0, 0, 0, 0, - 1462, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 1463, 0, 0, 1464, 798, 799, 800, 0, - 0, 0, 0, 0, 789, 801, -1714, 802, 0, 0, - 790, 791, 0, 0, 509, 0, 0, 0, 803, 804, - 805, 0, 0, 0, 0, 0, 793, 806, -1714, 0, - 510, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 807, -1714, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, -1714, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 808, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 788, 0, 0, 0, 0, 507, 0, 0, 0, - 0, -1714, 0, -3009, 0, 0, 809, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 1298, 0, 0, 0, 0, -1714, -1714, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 511, 0, - 0, 0, 794, 795, 796, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 797, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, -3009, -3009, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 508, 0, 0, 0, 0, 0, -1714, 810, - -1714, -1714, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - -1714, 789, 1299, 0, 0, -1714, 0, 790, 791, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 793, 0, 0, 0, 0, 0, 0, - 798, 799, 800, -3009, -3009, 0, 0, 0, 0, 801, - 0, 802, 0, -1714, 0, 0, 0, 0, 509, 0, - 0, 512, 803, 804, 805, -1714, 0, 0, 0, 0, - 0, 806, 0, 0, 510, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 811, 812, 0, 0, - 807, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, -3009, - -1616, 0, 0, 0, 0, -1616, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 1300, 0, 0, 0, 0, 513, 0, - 0, 891, 0, -3009, 0, 0, 0, 0, 0, 0, - 0, 0, -3009, 0, 808, 0, 0, 814, 0, 0, - 0, -3009, 0, -1714, 0, 788, 0, 1301, 0, 0, - 507, 0, 0, 0, 0, 0, 0, -1714, 0, 0, - 809, 0, 2230, 815, 0, 0, 0, 0, 0, 0, - 0, 816, 0, 892, 0, 0, 0, 0, 0, 794, - 795, 796, -3009, 0, 0, 0, 0, 0, 0, 0, - 0, 797, 0, 0, 0, 0, 817, 0, 0, 0, - 0, -1714, 186, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 511, 0, 0, 0, 514, 0, 0, 508, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - -1616, 893, 0, 0, 0, -2967, -1616, -1616, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, -1616, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 810, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 798, 799, 800, - 0, 0, 0, 0, 0, 789, 801, 0, 802, 0, - 0, 790, 791, 0, 0, 894, 0, 0, 0, 803, - 804, 805, 0, 0, 0, 0, 0, 793, 806, 0, - 0, 510, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 895, 0, 0, 807, 0, 0, - 0, 0, 0, 0, 0, 512, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 2191, 0, 0, 0, 0, 507, 0, - 811, 812, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 808, 0, 0, 0, 0, 0, 0, 896, 1302, - 0, 1303, 0, -3009, 0, 0, 0, -3009, 0, -3009, - 1304, 1305, 513, 0, 1306, 1307, -3107, 809, -1616, -1616, - -1616, 0, 0, 0, 0, 0, 0, 0, 0, 0, - -1616, 814, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 815, -1616, 0, - 0, 0, 0, 0, 0, 816, 0, 0, 0, 511, - 0, 0, 0, 794, 795, 796, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 797, 0, 653, 0, 0, - 817, 0, 0, 789, 0, 0, 186, 0, 788, 790, - 791, 0, 0, 507, 0, 0, 0, 0, 0, 0, - 514, 0, 0, 508, 0, 793, -1616, -1616, -1616, 0, - 810, 0, 0, 0, 0, -1616, 0, -1616, 0, 0, - 0, 0, 0, 0, -1616, 0, 0, 0, -1616, -1616, - -1616, 0, 0, 0, 0, 0, 0, -1616, 0, 0, - -1616, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, -1616, 0, 0, 0, - 0, 798, 799, 800, 0, 0, 0, 0, 0, 0, - 801, 0, 802, 0, 0, 0, 0, 0, 0, 509, - 0, 0, 512, 803, 804, 805, 897, 0, 0, 0, - 0, 0, 806, 0, 0, 510, 0, 0, 0, 0, - 0, 0, 2192, 0, 0, 0, 0, 811, 812, 0, - 898, 807, 788, 0, 0, 0, 0, 507, 0, 0, - -1616, 0, 0, 0, 0, 0, 0, -1616, 789, 0, - 0, 0, 0, 0, 790, 791, 0, 0, 0, 0, - 0, 0, 0, 0, 792, 0, -1616, 0, 0, 0, - 793, 0, 0, -3107, 0, 899, 0, 0, 0, 513, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 794, 795, 796, 0, 808, 0, 0, 814, 0, - 0, 0, 0, 797, 0, 0, 0, 788, 0, 0, - 0, 0, 507, 0, 0, 0, 0, 0, -1616, 0, - 0, 809, 0, 0, 815, 0, 0, 0, 0, 0, - 0, 508, 816, 0, 0, 0, 0, 0, 0, -2967, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 817, 0, 0, - 0, 900, 0, 186, 0, 0, 0, 0, 0, -1616, - 0, 0, 789, 511, 0, 0, 0, 514, 790, 791, - 0, 0, 0, 0, 0, 0, 0, 0, 1045, 798, - 799, 800, 0, 0, 793, 0, 0, 0, 801, 0, - 802, 0, 0, 0, 0, 0, 0, 509, 0, 0, - 0, 803, 804, 805, 0, 0, 0, 0, 0, 0, - 806, 0, 654, 510, 810, 0, 0, 0, 0, 0, - 0, 0, 0, -1616, 0, 0, 794, 795, 796, 807, - 0, -1616, 0, 0, 0, 0, 0, 789, 797, 0, - 0, 0, 0, 790, 791, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, -1616, -1616, 0, 793, - 0, 0, 0, 0, 0, 0, 508, 0, 0, 0, - 0, 0, 0, 788, 0, 0, 0, 0, 507, 0, - 0, 0, 0, 0, 0, 0, 512, 0, 0, 0, - 0, 0, 0, 808, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, -1616, 0, - 0, 811, 812, 0, 0, 0, 0, 0, 0, 809, - 0, 0, 0, 0, 798, 799, 800, -1616, 0, 0, - 0, 0, 0, 801, 0, 802, 0, -1616, 0, 0, - 0, 0, 509, 0, 0, 0, 803, 804, 805, 0, - 794, 795, 796, -1616, 0, 806, 0, 0, 510, 0, - 0, -1616, 797, 513, 0, 0, 0, 0, -2967, 0, - 0, 511, 0, 0, 807, 0, 0, 0, 0, 0, - 0, 0, 814, 0, 0, 0, -1616, 0, 0, 0, - 508, 0, -1616, 0, 0, 0, 0, 788, 0, 0, - 0, 0, 507, 0, 0, 0, -1616, 0, 815, 0, - 0, 0, 0, 789, 0, 0, 816, 0, 0, 790, - 791, 0, 810, 0, 0, 794, 795, 796, 0, 0, - 0, 0, 0, 0, 0, 793, 0, 797, 808, 0, - 0, 817, 0, 0, 0, 0, 480, 186, 798, 799, - 800, 0, 0, 0, 0, 0, 0, 801, 0, 802, - 0, 514, 0, 0, 809, 508, 509, 0, 0, 0, - 803, 804, 805, 0, 0, 0, 0, 0, 0, 806, - 0, 0, 510, 0, 0, 0, 2193, 0, 0, 0, - 0, 0, 0, 0, 512, 0, 0, 0, 807, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 511, 0, 0, 811, - 812, 788, 0, 798, 799, 800, 507, 0, 0, 0, - 0, 0, 801, 0, 802, 0, 0, 789, 0, 0, - 0, 509, 0, 790, 791, 803, 804, 805, 0, 0, - 0, 0, 0, 0, 806, 0, 0, 510, 0, 793, - 0, 0, 808, 0, 2194, 0, 0, 810, 0, 0, - 0, 513, 0, 807, 0, 2195, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 809, 0, - 814, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 794, 795, 796, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 797, 0, 0, 815, 0, 0, 0, - 0, 0, 0, 0, 816, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 808, 0, 512, - 511, 508, 0, 0, 0, 0, 0, 0, 0, 817, - 0, 0, 0, 0, 0, 186, 0, 0, 0, 0, - 0, 789, 0, 809, 811, 812, 0, 790, 791, 514, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 813, - 0, 0, 0, 793, 0, 0, 0, 0, 0, 0, - 0, 810, 0, 0, 0, 0, 0, 0, 0, 798, - 799, 800, 0, 0, 0, 0, 0, 0, 801, 0, - 802, 0, 0, 0, 0, 511, 513, 509, 0, 0, - 0, 803, 804, 805, 0, 794, 795, 796, 0, 0, - 806, 1611, 0, 510, 0, 814, 0, 797, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 807, - 788, 0, 0, 0, 0, 507, 0, 0, 0, 0, - 0, 815, 0, 512, 0, 508, 810, 0, 0, 816, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 811, 812, - 0, 0, 0, 1831, 817, 0, 0, 0, 507, 0, - 186, 0, 0, 1046, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 808, 514, 0, 0, 0, 0, 0, - 896, 0, 0, 798, 799, 800, 0, 0, 0, 0, - 0, 0, 801, 0, 802, 0, 0, 0, 512, 809, - 513, 509, 0, 0, 0, 803, 804, 805, 0, 794, - 795, 796, 0, 0, 806, 0, 0, 510, 0, 814, - 0, 797, 0, 811, 812, 0, 0, 0, 0, 0, - 0, 0, 0, 807, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 815, 0, 0, 0, 508, - 789, 511, 0, 816, 0, 0, 790, 791, 0, 0, - 1194, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 793, 0, 0, 513, 0, 0, 817, 0, - 0, 0, 0, 0, 186, 0, 0, 0, 0, 0, - 0, 0, 0, 789, 814, 0, 0, 808, 514, 790, - 791, 0, 810, 0, 0, 0, 0, 798, 799, 800, - 0, 0, 0, 0, 0, 793, 801, 0, 802, 0, - 815, 0, 0, 809, 0, 509, 0, 0, 816, 803, - 804, 805, 0, 0, 0, 0, 0, 0, 806, 0, - 0, 510, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 817, 0, 0, 0, 807, 0, 186, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 514, 512, 511, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 811, - 812, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 808, 0, 0, 0, 0, 810, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 794, 795, - 796, 0, 0, 0, 0, 0, 0, 809, 0, 0, - 797, 513, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 814, 0, 0, 0, 0, 0, 0, 0, 508, 0, - 0, 794, 795, 796, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 797, 0, 0, 815, 0, 512, 511, - 0, 0, 0, 0, 816, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 508, 0, 811, 812, 0, 0, 0, 0, 817, - 0, 0, 0, 0, 0, 186, 798, 799, 800, 0, - 0, 0, 0, 0, 0, 801, 0, 802, 0, 514, - 810, 0, 0, 0, 509, 0, 0, 0, 803, 804, - 805, 0, 0, 0, 0, 0, 0, 806, 0, 0, - 510, 0, 0, 0, 0, 513, 0, 0, 0, 798, - 799, 800, 0, 0, 0, 0, 807, 0, 801, 0, - 802, 0, 0, 0, 814, 0, 0, 509, 0, 0, - 0, 803, 804, 805, 0, 0, 0, 0, 0, 0, - 806, 0, 0, 510, 3070, 0, 0, 0, 0, 0, - 815, 0, 512, 0, 0, 0, 0, 0, 816, 807, - 0, 0, 0, 0, 0, 789, 0, 0, 0, 0, - 0, 790, 791, 0, 0, 0, 0, 811, 812, 0, - 808, 0, 0, 817, 0, 0, 0, 793, 0, 186, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 514, 0, 0, 809, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 808, 0, 0, 0, 0, 0, 513, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 814, 809, - 0, 0, 0, 0, 0, 0, 0, 0, 511, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 815, 0, 0, 0, 0, 0, - 0, 0, 816, 0, 0, 0, 0, 3800, 0, 0, - 0, 0, 0, -576, 0, 0, 0, 0, 0, 0, - 0, 511, 0, 0, 0, 0, 0, 817, 0, 810, - 0, 0, 0, 186, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 514, 0, 0, - -576, 0, 0, 0, 0, -576, -576, -576, -576, -576, - 0, 0, -576, -576, -576, -576, -576, -576, 0, -576, - -576, -576, 810, 794, 795, 796, 0, 0, 0, 0, - -576, -576, 0, 0, 0, 797, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - -576, 512, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 508, 0, 0, -576, 0, 0, 0, - 0, -576, 0, 0, 0, 0, 811, 812, -576, -576, - 0, 0, -576, 0, 0, 0, 0, 0, 0, -576, - 0, 0, 0, 0, 512, 0, -576, 0, -576, -576, - -576, -576, -576, -576, -576, -576, -576, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 811, - 812, 798, 799, 800, 0, 0, 0, -576, 513, 0, - 801, 0, 802, 0, 0, 0, 0, 0, 0, 509, - 0, 0, 0, 803, 804, 805, -576, 814, 0, 0, - 0, 0, 806, 0, 0, 510, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, -576, 0, - 0, 513, 0, 815, 0, 0, 0, 0, 0, 0, - 0, 816, 0, 0, 0, 0, 0, 0, 0, 0, - 814, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 817, 0, 0, 0, - 0, 0, 186, 0, 0, 0, 815, 0, 0, 0, - 0, 0, 0, 0, 816, 0, 514, 0, -576, 0, - 0, 0, 0, 0, 0, 808, 0, -576, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 817, - 0, 0, 0, 0, 0, 186, 0, 0, 0, 0, - 0, 809, 0, 0, 0, 0, 0, 0, 0, 514, - 0, 1084, 0, 0, 0, 0, 0, 0, 0, 0, - -576, -576, -576, -576, -576, 0, 0, -576, -576, 0, - 0, 0, 0, -576, 0, 0, 0, 0, -576, 0, - 0, -576, 0, -576, 0, 0, 0, 0, 0, 0, - -576, 0, 0, 511, 0, 0, 0, 0, 0, 0, - -576, 0, 0, -576, 0, 0, 0, 0, 0, 0, - 0, 0, 0, -576, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, -576, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 4250, 0, - 0, -576, 0, 0, 810, -576, 0, 0, 0, 0, - 0, 0, 0, 0, 0, -576, 0, 0, 0, -576, - 0, 0, 0, 0, 0, 0, 0, -576, 0, 0, - 0, -576, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, -576, 0, 0, 0, -576, 0, 0, - -576, 0, 0, 0, -576, -576, -576, -576, -576, 0, - -576, -576, 0, 0, 0, -576, 0, 0, 0, 0, - 0, -576, 0, 0, 0, 0, 512, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, -576, 0, 0, 0, 0, 0, - 0, 811, 812, 0, 0, 0, 0, 0, 0, -576, - 0, 0, 2883, 0, 0, 0, -576, 0, 0, -576, - 0, 0, -576, -576, 0, 0, 0, 0, 0, -576, - 0, 0, 0, 0, 0, 0, 0, -576, 0, -576, - -576, -576, -576, -576, -576, -576, -576, -576, -576, 0, - -576, 831, -576, 513, 0, 832, 833, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, -576, -576, - 0, 0, 814, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, -576, 0, 0, 0, 0, - -576, 0, -576, -576, 0, 0, 0, 0, 815, 0, - 0, 0, 0, 0, 0, 0, 816, 0, 0, -576, - 0, 0, 0, -576, 0, 0, -576, 0, 0, 0, - 0, 0, -576, 0, 0, 0, -576, 0, 0, 1083, - 0, 817, 0, 0, 0, 0, 0, 186, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 514, 0, 0, 0, 0, 0, -576, 0, 0, - 0, 0, -576, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, -576, 0, -576, -576, 0, - 0, 0, -576, 0, 0, -576, -576, -576, -576, -576, - 0, -576, -576, 0, 0, 0, 0, 0, 0, 0, - 0, 0, -576, -576, 0, 0, 0, 0, 0, 0, - -576, 0, 1084, 0, 0, 0, 0, 0, 0, 0, - 0, -576, -576, -576, -576, -576, 0, 0, -576, -576, - 0, 0, 0, 0, -576, 0, -576, -576, -576, 0, - -576, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, -576, 0, 0, 0, 0, 0, 0, 0, - 0, 0, -576, -576, -576, 0, 0, 0, -576, 0, - -576, -576, -576, -576, -576, -576, -576, -576, -576, 0, - 0, 0, 0, 0, 0, -576, 0, 0, 0, -576, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - -576, 0, 0, 0, 0, -576, -576, 0, 0, 0, - 0, -576, 0, 0, 0, 0, 0, 0, -576, 0, - 0, 0, 0, 0, 0, 0, 0, 0, -576, 0, - -576, 0, 0, -576, -576, 0, 0, 0, -576, 0, - -576, 0, 0, 0, 0, -576, -576, -576, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, -576, 0, 0, 0, 0, 0, 0, 0, -576, - 0, 0, 0, 0, 0, -576, 0, 0, 0, 0, - 0, 0, 0, 0, 0, -576, 0, 0, 0, 0, - 0, -576, 0, 0, 0, 0, 0, 0, -576, 197, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, -576, -576, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 1084, 0, 0, 0, 0, 0, 0, - 0, -576, -576, -576, -576, -576, -576, 0, 0, -576, - -576, 0, 0, 0, 0, 0, 0, 0, 0, 0, - -576, 0, 0, 0, 0, 0, 0, 0, 2026, 0, - 0, 0, -576, 0, 0, 0, -576, 2027, 0, 0, - 0, -576, 0, 0, 0, -576, 0, -576, 0, 0, - 0, 0, 2028, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, -576, -576, 0, 0, 0, 0, 0, - -576, 2029, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, -576, 0, 0, - 0, 0, 0, 0, 0, 0, 0, -576, 0, 0, - 0, 0, 2030, 2031, 2032, 0, 0, 2033, 0, -576, - 0, 0, 0, 0, 2034, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 2035, 0, 2036, 2037, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 2038, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, -576, 0, 0, 0, - 0, 0, 0, 0, 0, -576, 0, -576, -576, -576, - 0, 0, 0, 0, 0, 0, 0, -576, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 2039, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 2040, 0, 0, 0, 0, -576, 0, - 0, 0, -576, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 2041, 2042, 0, 2043, 2044, - 0, -576, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, -576, -576, 0, 0, - 0, 0, -576, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, -576, - 0, 0, 0, 2045, 0, -576, 0, -576, 0, 0, - 0, 0, 0, 0, 0, 0, -576, -576, -576, 2046, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, -576, 0, 0, 0, -576, 0, 0, 0, - 0, 0, 0, 0, 0, 0, -576, 0, 0, 0, - -576, 0, 0, 0, 0, 0, 2047, 2048, 2049, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 197, 0, 0, 0, 0, 0, 0, 0, 2050, 0, - 0, 0, 0, 2051, 0, 0, 0, 0, 0, -576, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 2052, 2053, - 0, 0, 0, 0, 0, 2054, 2055, 0, 0, 0, - 0, 0, 0, 0, 0, 0, -576, 0, -576, -576, - -576, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, -576, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 2056, - 0, 2057, 0, -576, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 2058, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 2059, 2060, 2061, 0, 0, 0, 0, -576, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 2062, 0, 0, - -576, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 4313, 0, 0, 0, 0, 0, 0, -576, -576, -576, - 2063, 2064, 2065, 0, 2066, 0, 2067, 2068, 0, 2069, - 0, 2070, 2071, -576, 0, 0, 2072, 0, 2073, 2074, - 2075, 2076, 0, 0, 0, 0, 0, -576, 0, 0, - 0, 0, 0, 0, 2077, 0, -576, 0, 0, 0, - 0, 0, 2078, 2258, 2259, 2260, 2261, 2262, 0, 2263, - 2264, 197, 0, 0, 0, 2079, 2080, 0, 0, 0, - 2265, 0, 0, 0, 2081, 0, 0, 0, 0, 0, - 2082, 0, 0, 789, 0, 0, 0, 0, 0, 790, - 791, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 793, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 4314, 0, - 0, 1780, 4315, 0, 0, 0, 0, 2083, 1781, 0, - 0, 0, 2084, 0, 0, 0, 2266, 0, 2267, 2268, - 2147, 2269, 2270, 2271, 2272, 2273, 2274, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 1158, 0, 0, -3107, 0, 0, 0, 0, -3107, - -3107, -3107, -3107, 0, 0, 1159, -3107, 0, 0, 0, - 0, 0, 0, 2085, 2086, 0, 0, 0, 0, 0, - 0, 0, 2087, 0, 0, -3107, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 2275, 0, - 0, 0, 0, 0, 0, 0, 2088, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 2089, - 2090, 2091, 2092, 0, 0, 0, 0, 0, 0, 0, - 0, 0, -2959, -3107, 0, 0, -2959, 0, 0, 2093, - 2094, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 2095, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 794, 795, 796, 0, 0, 0, 0, 0, 0, - -3107, 0, -3107, 797, 0, 0, 0, 0, 0, 2096, - 0, 0, 0, 0, -3107, 0, 0, 0, 0, 0, - 0, 0, 0, 2097, 2098, 0, 0, 0, 0, 0, - 0, 508, 0, 0, 0, 0, 0, -3107, 0, 0, - 2276, 2277, 2278, 2279, 2280, 0, 0, 2155, 2281, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 2099, 0, 0, 0, 0, 0, 0, 0, 0, - 2100, 0, 0, 0, 0, 0, 0, 2101, 0, 0, - 0, 4316, 0, 2282, 0, 0, 0, 0, 2102, 798, - 799, 800, 2103, 2104, 2105, 0, 0, 0, 801, 0, - 802, 0, 0, 0, 0, 0, 0, 509, 2283, 2106, - 2107, 803, 804, 805, 0, 2108, 2109, 0, 2110, 0, - 806, 2256, 0, 510, 0, 2111, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 2284, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 2257, 0, 0, 2258, - 2259, 2260, 2261, 2262, 0, 2263, 2264, 0, 0, 0, - 0, 0, 0, 4317, 0, 0, 2265, 4318, 0, 0, - 0, 0, 0, 0, 0, 0, 0, -3107, 0, 0, - 0, 0, 0, 0, 0, 0, 1160, -3107, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 808, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 2285, 0, 0, -3107, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 4319, 0, 809, - 0, 0, 2266, 0, 2267, 2268, 2147, 2269, 2270, 2271, - 2272, 2273, 2274, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, -3107, 0, 0, 0, 0, 0, 0, 0, 0, - 4320, 0, 0, 0, 0, -3107, 0, 0, 0, 0, - 0, 511, 0, 0, 0, 0, 0, -2959, 0, 2287, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 2275, 2288, -3107, 0, 0, -3107, - 2289, 0, 0, 0, 0, 0, 4321, 0, 0, 0, - 0, 0, 4430, 0, 0, 0, 0, 0, 1161, 0, - 0, 0, 810, 2290, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, -3107, 0, 0, 0, 2256, 0, 0, - -3107, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 2257, 0, 0, 2258, 2259, 2260, 2261, 2262, - 0, 2263, 2264, 0, 0, 0, -3107, 0, 0, 0, - 0, 0, 2265, 0, 512, 0, 0, 0, 0, 0, - 0, 0, -3107, 0, 0, 0, 2276, 2277, 2278, 2279, - 2280, 0, 0, 2155, 2281, 0, 0, 0, 0, 811, - 812, 0, 0, 0, 0, 0, -2959, -2959, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 2293, 0, 2294, 2295, 2296, 2282, - -3107, 0, 0, -3107, 0, 0, 4322, 0, 2266, 0, - 2267, 2268, 2147, 2269, 2270, 2271, 2272, 2273, 2274, 0, - 0, 513, 0, 0, 2283, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 4323, 0, 0, - 814, 52, 0, 0, 0, 0, -3107, 0, 0, 0, - 0, 2284, 0, 0, 0, 0, 0, 0, 0, -3107, - 4431, -3107, -3107, -3080, 0, 0, 815, 0, 0, 0, - 0, 0, 0, 0, 816, 4324, 0, 0, 0, 0, - 2275, -3107, 0, 0, 0, 0, -3107, 0, 0, 0, - 0, 0, 0, 0, -3107, 0, 0, 0, 0, 817, - 0, 0, 0, 0, 0, 186, 4325, 0, 0, 0, - 0, 0, 0, 0, 0, 2298, 2299, 2300, 0, 514, - 0, 0, 0, 0, -3107, 0, 0, 0, 0, 0, - 2285, 2301, 0, 0, 0, 0, -3107, 0, 0, 0, - 0, 0, 0, 0, 0, 2250, 0, 0, 0, 4326, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, -3107, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 2286, 0, 0, -2961, - -3107, 0, 2276, 2277, 2278, 2279, 2280, 0, 0, 2155, - 2281, 0, 0, 0, 0, 2287, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 2288, 0, 0, 0, 0, 2289, 0, 0, 0, - 0, 0, 0, 0, -3107, 2282, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, -3107, 0, 0, 2290, - 0, 0, 0, -3107, 0, 0, 0, 0, 0, 0, - 2283, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 52, 0, 0, - 2291, 0, 0, 0, 0, 0, 0, 2284, 0, 0, - 0, 0, 480, 0, 0, 0, 0, 0, 0, -3080, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 4003, 0, 0, 0, 0, 4004, 4005, 4006, 4007, 0, - 0, 0, 4008, 2258, 2259, 2260, 2261, 2262, 0, 2263, - 2264, 0, 0, 2292, 0, 0, 0, 789, 0, 0, - 4009, 4010, 0, 790, 791, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 793, - 4011, 0, 0, 0, 0, 0, 2285, 0, 0, 0, - 2293, 0, 2294, 2295, 2296, 0, 0, 0, 0, 0, - 0, 4012, 0, 0, 0, 0, 0, 0, 1718, 4013, - 0, 0, 1719, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 2266, 0, 2267, 2268, - 2147, 2269, 2270, 2271, 2272, 2273, 2274, 2297, 0, 0, - 0, 0, 2286, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 4014, 0, 0, - 0, 2287, 0, 0, 0, 0, 0, 0, 0, 0, - 0, -635, 0, 0, 0, 0, 0, 2288, 0, 0, - 0, 0, 2289, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, -3080, 0, 0, 0, 2275, 0, - 0, 0, 0, 0, 0, 2290, 0, 0, 0, 0, - 0, 2298, 2299, 2300, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 2301, 0, 0, - 0, 0, 0, 0, 0, 0, 2291, 0, 0, 0, - 0, 2250, 0, 0, 0, 794, 795, 796, 0, 0, - 2302, 0, 0, 0, 0, 0, 0, 797, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 4015, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 789, 0, 0, 0, 508, 0, 790, 791, 2292, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 793, 0, 0, 0, 0, 0, 0, - 2276, 2277, 2278, 2279, 2280, 0, 0, 2155, 2281, 0, - 0, 0, 0, 4016, 0, 0, 2293, 0, 2294, 2295, - 2296, 4017, 0, 4018, 0, 0, 0, 0, 0, 0, - -3009, 0, 0, 798, 799, 800, 0, 0, 0, 0, - 4019, 0, 801, 2282, 802, 0, 0, 0, 0, 0, - 0, 509, 0, 4020, 0, 803, 804, 805, 0, 0, - 0, 0, 0, 2297, 806, 0, 0, 510, 2283, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 52, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 2284, 0, -636, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 4021, 0, 0, 0, 0, 0, 0, 0, 0, - -3080, 0, 0, 4022, 0, 0, 0, 4023, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 2298, 2299, 2300, - 0, 0, 0, 0, 0, 4024, 0, 808, 0, 0, - 0, 0, 0, 2301, 0, 0, 0, 0, 0, 794, - 795, 796, 0, 0, 0, 0, 0, 2250, 0, 0, - 0, 797, 0, 809, 2285, 0, 2302, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 4025, - 0, 0, 0, 0, 0, 0, 1746, 0, 0, 508, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 789, 0, 0, 0, 0, 0, 790, 791, 0, - 0, 0, 0, 0, 0, 511, 0, 0, 0, 0, - 4026, 0, 1747, 793, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 4027, 2287, - 0, 0, 0, 0, 0, 0, 0, 798, 799, 800, - 0, 0, 0, 0, 0, 2288, 801, 0, 802, 0, - 2289, 0, 1721, 1722, 0, 509, 810, 0, 0, 803, - 804, 805, 0, 0, 0, 0, 0, 0, 806, 0, - 0, 510, 0, 2290, 0, 0, 4028, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 4029, 0, 0, 0, 0, 0, 512, 0, - 0, 0, 0, 789, 0, 1752, 0, 1753, 1754, 790, - 791, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 808, 0, 811, 812, 793, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 789, 0, - 4030, 0, 0, 0, 790, 791, 0, 809, 0, 794, - 795, 796, 0, 0, 0, 0, 0, 0, 0, 0, - 793, 797, 2703, 0, 2293, 0, 2294, 2295, 2296, 0, - 4031, 0, 0, 831, 0, 513, 0, 832, 833, 0, - 0, 0, 4032, 0, 0, 0, 0, 0, 0, 508, - 0, 0, 0, 0, 814, 0, 0, 0, 0, 511, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 4033, 0, 0, 0, 0, - 815, 0, 0, 0, 0, 0, 0, 0, 816, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 4034, 0, 0, 0, 0, -944, 0, 798, 799, 800, - 810, 4035, 0, 817, 0, 0, 801, 0, 802, 186, - 0, 0, 0, 0, 0, 509, 0, 0, 0, 803, - 804, 805, 0, 514, 0, 0, 0, 0, 806, 0, - 4036, 510, 789, 0, 0, 2298, 2299, 2300, 790, 791, - 0, 794, 795, 796, 0, 0, 0, 0, 0, 0, - 0, 2301, 0, 797, 793, 0, 0, 0, 0, 4037, - 0, 0, 0, 0, 0, 2250, 0, 0, 0, 0, - 0, 0, 512, 0, 0, 0, 794, 795, 796, 0, - 0, 508, 0, 0, 0, 0, 0, 0, 797, 0, - 0, 0, 0, 0, 0, 0, 0, 811, 812, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 2885, 0, - 0, 808, 0, 0, 0, 0, 508, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 809, 0, 798, - 799, 800, 0, 0, 0, 0, 0, 831, 801, 513, - 802, 832, 833, 0, 0, 0, 0, 509, 0, 0, - 0, 803, 804, 805, 0, 0, 0, 0, 814, 0, - 806, 0, 0, 510, 798, 799, 800, 0, 0, 0, - 0, 0, 0, 801, 0, 802, 0, 0, 0, 511, - 0, 0, 509, 0, 815, 0, 803, 804, 805, 0, - 0, 0, 816, 0, 0, 806, 0, 0, 510, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 794, 795, 796, 0, 0, 0, 0, 817, 0, 0, - 0, 0, 797, 186, 0, 0, 0, 0, 0, 0, - 810, 0, 0, 0, 0, 0, 0, 514, 0, 0, - 0, 0, 0, 808, 0, 0, 0, 0, 0, 0, - 508, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 809, - 0, 0, 0, 0, 0, 0, 0, 0, 808, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 512, 0, 809, 0, 0, 0, 798, 799, - 800, 0, 0, 0, 0, 0, 0, 801, 0, 802, - 0, 511, 0, 0, 0, 0, 509, 811, 812, 0, - 803, 804, 805, 0, 0, 0, 0, 0, 0, 806, - 0, 0, 510, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 511, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 2906, 0, 0, 0, - 0, 0, 810, 0, 0, 0, 0, 831, 0, 513, - 0, 832, 833, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 814, 0, - 0, 0, 0, 0, 0, 0, 0, 810, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 808, 0, 815, 0, 0, 0, 0, 0, - 0, 0, 816, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 512, 0, 0, 0, 809, 0, - 0, 0, 0, 0, 0, 0, 0, 817, 0, 0, - 0, 0, 0, 186, 0, 0, 0, 0, 0, 811, - 812, 0, 0, 0, 0, 0, 0, 514, 0, 512, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 511, 0, 0, 0, 811, 812, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 831, - 0, 513, 0, 832, 833, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 814, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 810, 0, 0, 0, 0, 513, 0, 832, 0, - 0, 0, 0, 0, 0, 0, 815, 0, 0, 0, - 0, 0, 0, 0, 816, 814, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 817, - 0, 815, 0, 0, 0, 186, 0, 0, 0, 816, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 514, - 0, 0, 0, 512, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 817, 0, 0, 0, 0, 0, - 186, 0, 0, 0, 0, 0, 0, 0, 811, 812, - 0, 0, 0, 0, 514, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 513, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 814, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 815, 0, 0, 0, 0, - 0, 0, 0, 816, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 817, 0, - 0, 0, 0, 0, 186, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 514 -}; - -static const yytype_int16 yycheck[] = -{ - 151, 36, 507, 180, 240, 643, 701, 1174, 713, 714, - 715, 1169, 137, 718, 139, 675, 1637, 681, 1505, 144, - 987, 2137, 66, 648, 283, 788, 1720, 1097, 72, 1099, - 1100, 1725, 1102, 1103, 69, 70, 71, 638, 1037, 174, - 137, 76, 139, 630, 1892, 2477, 784, 144, 2432, 1118, - 1622, 1013, 1028, 874, 1902, 650, 2250, 212, 1288, 184, - 2492, 652, 1693, 658, 1632, 1194, 664, 631, 880, 3147, - 813, 727, 2729, 2332, 661, 731, 732, 643, 734, 735, - 1863, 737, 738, 2445, 682, 120, 681, 184, 1190, 1650, - 658, 2177, 2209, 2455, 1932, 2134, 1891, 2351, 1529, 134, - 1202, 136, 2795, 866, 2358, 140, 141, 2361, 2362, 3398, - 874, 0, 823, 681, 1, 150, 151, 1912, 705, 2437, - 2438, 630, 1, 14, 159, 2443, 2444, 25, 2446, 1, - 841, 166, 698, 0, 2818, 77, 2654, 728, 729, 2333, - 2334, 2825, 733, 56, 1927, 736, 16, 182, 16, 39, - 801, 802, 1266, 16, 16, 16, 16, 1286, 809, 2360, - 257, 194, 206, 16, 55, 200, 203, 1, 43, 109, - 1, 215, 2993, 83, 31, 1, 25, 136, 83, 214, - 155, 2871, 1296, 107, 31, 41, 221, 226, 207, 254, - 1002, 1779, 42, 38, 229, 83, 1770, 109, 1174, 1787, - 851, 42, 2396, 270, 30, 16, 109, 156, 972, 11, - 225, 291, 1033, 1560, 118, 813, 281, 2566, 136, 1040, - 43, 11, 316, 316, 225, 121, 62, 11, 263, 307, - 2548, 169, 170, 2551, 240, 316, 823, 1273, 160, 239, - 2558, 189, 240, 2561, 831, 832, 833, 255, 3569, 293, - 294, 156, 189, 3703, 841, 240, 96, 2612, 255, 954, - 249, 163, 291, 3717, 409, 1532, 227, 772, 280, 1033, - 291, 455, 480, 13, 455, 958, 2708, 2709, 2208, 277, - 455, 279, 169, 847, 197, 119, 390, 409, 430, 458, - 421, 409, 16, 336, 11, 390, 231, 109, 109, 421, - 303, 3287, 237, 1046, 431, 2601, 384, 409, 85, 487, - 513, 431, 298, 353, 1669, 47, 594, 230, 2726, 31, - 56, 417, 543, 832, 437, 231, 160, 161, 38, 349, - 588, 237, 569, 83, 420, 409, 487, 903, 228, 75, - 270, 484, 11, 350, 203, 940, 2129, 650, 447, 119, - 285, 590, 463, 336, 1049, 447, 544, 952, 353, 204, - 83, 250, 42, 168, 239, 108, 409, 256, 2622, 112, - 2953, 336, 558, 16, 304, 305, 38, 463, 455, 285, - 2963, 226, 41, 250, 16, 3706, 336, 455, 1517, 256, - 160, 161, 3569, 335, 3479, 739, 197, 744, 634, 3933, - 987, 712, 661, 11, 640, 3950, 455, 2725, 739, 453, - 101, 3712, 398, 739, 11, 823, 239, 2456, 455, 1157, - 353, 1242, 4278, 823, 3112, 1163, 1013, 513, 1023, 3915, - 416, 466, 467, 750, 409, 1030, 823, 673, 463, 109, - 676, 84, 864, 2226, 16, 300, 14, 683, 1046, 1649, - 14, 486, 1039, 316, 398, 1023, 822, 1487, 493, 193, - 530, 350, 57, 122, 1175, 827, 398, 126, 704, 11, - 832, 893, 416, 207, 513, 3163, 156, 521, 280, 682, - 1510, 351, 1611, 350, 154, 1685, 2870, 55, 513, 379, - 274, 55, 562, 16, 204, 384, 455, 386, 290, 354, - 811, 3987, 136, 820, 249, 913, 3807, 318, 4364, 3202, - 3194, 858, 541, 913, 858, 136, 827, 384, 349, 386, - 354, 832, 1233, 4068, 4058, 3209, 913, 858, 419, 3706, - 1039, 136, 858, 498, 631, 1273, 109, 109, 2655, 616, - 906, 638, 204, 3233, 2660, 3630, 136, 614, 616, 487, - 490, 2805, 409, 650, 651, 235, 225, 745, 816, 169, - 136, 658, 409, 295, 174, 455, 136, 664, 458, 108, - 756, 136, 715, 112, 569, 409, 559, 379, 675, 690, - 677, 471, 679, 569, 681, 682, 889, 455, 825, 379, - 1177, 1178, 1179, 1194, 614, 379, 455, 1184, 1185, 1186, - 1187, 16, 744, 1190, 409, 704, 757, 202, 615, 830, - 707, 501, 704, 1200, 450, 1202, 1203, 786, 353, 1689, - 431, 717, 1209, 1210, 1211, 1212, 1213, 863, 455, 232, - 2948, 744, 2987, 1702, 912, 2990, 814, 1224, 678, 409, - 23, 377, 878, 427, 446, 742, 448, 23, 388, 389, - 2222, 513, 1239, 455, 1616, 379, 446, 1244, 448, 23, - 2015, 30, 446, 353, 448, 455, 1291, 493, 606, 471, - 812, 455, 633, 912, 3082, 1184, 1185, 1186, 23, 289, - 420, 471, 405, 393, 614, 1286, 205, 471, 405, 388, - 437, 1200, 766, 18, 630, 2991, 1262, 409, 102, 435, - 804, 650, 820, 487, 912, 708, 3692, 315, 1837, 912, - 379, 455, 881, 1815, 559, 842, 813, 819, 474, 784, - 2503, 420, 842, 463, 297, 820, 615, 3420, 987, 913, - 1239, 455, 913, 469, 1546, 1244, 379, 480, 913, 629, - 650, 473, 576, 434, 2582, 650, 318, 471, 615, 302, - 847, 591, 4202, 1317, 544, 80, 108, 2796, 2688, 661, - 112, 1524, 650, 282, 463, 1586, 319, 728, 913, 121, - 4224, 379, 869, 513, 636, 577, 761, 446, 1489, 448, - 2411, 912, 379, 614, 3468, 2132, 455, 577, 447, 2350, - 678, 913, 3482, 577, 437, 438, 4117, 630, 575, 1482, - 865, 830, 471, 3321, 722, 638, 576, 379, 820, 830, - 85, 819, 455, 819, 513, 532, 814, 650, 904, 913, - 913, 1532, 819, 396, 1786, 658, 421, 629, 471, 488, - 819, 727, 913, 913, 646, 913, 572, 379, 446, 629, - 448, 558, 668, 940, 1500, 629, 913, 455, 681, 446, - 865, 448, 1888, 108, 48, 952, 379, 112, 455, 431, - 1974, 809, 752, 471, 865, 769, 2133, 757, 758, 819, - 913, 614, 809, 912, 471, 701, 913, 2465, 927, 912, - 913, 513, 815, 455, 752, 2459, 211, 952, 744, 2236, - 987, 793, 834, 912, 3243, 831, 832, 833, 816, 471, - 650, 3585, 3586, 3486, 446, 629, 448, 913, 577, 1885, - 1007, 814, 912, 455, 1501, 827, 1517, 821, 893, 1514, - 832, 757, 987, 1686, 1687, 3280, 1023, 913, 678, 471, - 819, 819, 455, 1030, 16, 1112, 676, 596, 597, 3623, - 889, 480, 1093, 3633, 1095, 681, 1514, 1098, 471, 1046, - 752, 883, 819, 866, 913, 745, 1107, 806, 3159, 883, - 629, 3000, 752, 820, 379, 1552, 1091, 1092, 752, 577, - 912, 1148, 1037, 716, 914, 913, 1101, 3798, 913, 889, - 577, 831, 1577, 913, 889, 819, 629, 792, 819, 911, - 831, 913, 769, 819, 1091, 1092, 687, 744, 831, 832, - 833, 889, 803, 635, 1101, 867, 912, 913, 906, 1245, - 1611, 336, 1599, 814, 1835, 906, 1672, 1673, 820, 455, - 804, 629, 1678, 3541, 913, 1681, 913, 829, 752, 1616, - 434, 842, 629, 3726, 913, 577, 869, 927, 3695, 829, - 455, 913, 3081, 913, 3083, 829, 913, 1698, 923, 819, - 913, 987, 913, 913, 1089, 1232, 471, 629, 920, 927, - 913, 1158, 1726, 4141, 3754, 2179, 913, 912, 1831, 819, - 42, 1835, 4361, 455, 819, 614, 819, 913, 912, 2927, - 2928, 2929, 2930, 752, 2515, 1828, 913, 629, 722, 912, - 1599, 4169, 1157, 1804, 41, 705, 831, 1194, 1163, 2882, - 923, 722, 44, 1039, 3143, 829, 629, 940, 433, 752, - 240, 913, 829, 1148, 232, 498, 908, 722, 854, 952, - 455, 913, 498, 913, 493, 927, 1161, 730, 480, 913, - 3814, 2969, 722, 728, 498, 3792, 455, 927, 463, 889, - 743, 831, 912, 927, 752, 814, 722, 700, 280, 474, - 1888, 455, 722, 498, 513, 752, 912, 722, 232, 23, - 829, 906, 1227, 2731, 904, 912, 455, 2962, 2135, 913, - 913, 186, 912, 420, 138, 122, 379, 716, 41, 126, - 752, 2964, 816, 2966, 156, 80, 829, 44, 513, 1286, - 1023, 1, 1257, 827, 336, 816, 865, 1030, 832, 1786, - 530, 199, 2774, 927, 3321, 904, 1039, 3466, 1273, 868, - 752, 816, 487, 197, 629, 455, 463, 814, 442, 240, - 1317, 829, 226, 3114, 2186, 480, 816, 3010, 1815, 752, - 1828, 379, 829, 455, 616, 3321, 1837, 430, 447, 23, - 816, 1177, 1178, 1179, 913, 818, 816, 766, 1184, 1185, - 1186, 816, 455, 912, 827, 828, 558, 829, 927, 832, - 2821, 240, 614, 235, 1200, 784, 513, 1203, 471, 455, - 842, 1422, 455, 1209, 1210, 1211, 1212, 1213, 2647, 455, - 819, 37, 801, 687, 927, 168, 0, 829, 1852, 3946, - 3073, 558, 3075, 1552, 352, 282, 2007, 379, 851, 668, - 575, 227, 563, 1239, 912, 913, 829, 354, 1244, 503, - 504, 505, 4390, 1969, 3918, 818, 913, 434, 739, 927, - 2434, 19, 320, 471, 442, 828, 0, 390, 2398, 2399, - 927, 194, 701, 886, 2404, 2405, 300, 752, 891, 122, - 197, 913, 667, 126, 1177, 1178, 1179, 2416, 455, 455, - 291, 1184, 1185, 1186, 484, 927, 1947, 682, 455, 614, - 3619, 1194, 409, 3622, 716, 408, 229, 1200, 442, 353, - 1203, 913, 219, 455, 3549, 727, 1209, 1210, 1211, 1212, - 1213, 487, 2496, 2497, 1975, 927, 362, 363, 2490, 471, - 913, 266, 1, 1984, 300, 301, 2968, 38, 530, 383, - 455, 1, 713, 647, 927, 512, 1239, 3255, 540, 3918, - 463, 1244, 398, 111, 829, 2529, 2530, 1514, 3918, 19, - 1517, 2008, 2133, 3918, 1579, 619, 629, 425, 2191, 292, - 416, 675, 227, 564, 463, 1500, 153, 858, 2567, 1675, - 2569, 1677, 632, 1679, 1680, 576, 1682, 1683, 354, 58, - 59, 60, 61, 1286, 63, 594, 3918, 647, 513, 2025, - 513, 716, 240, 484, 440, 441, 3720, 2581, 883, 281, - 576, 169, 336, 336, 172, 2589, 174, 913, 893, 385, - 1577, 2192, 2225, 481, 513, 390, 593, 3746, 3747, 764, - 110, 354, 555, 3384, 769, 704, 593, 195, 913, 542, - 447, 2630, 1567, 518, 409, 300, 730, 390, 819, 513, - 690, 111, 927, 455, 1611, 657, 76, 291, 168, 2282, - 485, 3883, 2636, 437, 582, 2189, 379, 1592, 3096, 455, - 3098, 913, 2127, 2128, 143, 144, 2650, 2651, 2537, 690, - 2352, 351, 529, 819, 4148, 1670, 821, 629, 2135, 752, - 3725, 744, 336, 912, 3670, 1590, 528, 1, 537, 2127, - 120, 913, 2632, 204, 819, 1501, 1631, 379, 463, 169, - 687, 409, 172, 1670, 174, 2139, 0, 549, 913, 474, - 2291, 825, 2711, 569, 3215, 291, 352, 912, 913, 345, - 240, 289, 927, 393, 913, 195, 406, 927, 455, 2186, - 541, 484, 455, 1638, 752, 274, 349, 1642, 1643, 913, - 1645, 913, 730, 1648, 1649, 137, 1651, 492, 471, 812, - 649, 1665, 278, 927, 913, 743, 186, 2225, 593, 1726, - 2217, 2218, 76, 816, 498, 549, 766, 649, 927, 4148, - 2602, 835, 836, 455, 166, 3493, 913, 447, 4148, 596, - 597, 105, 106, 4148, 784, 849, 730, 904, 3027, 471, - 624, 183, 184, 1599, 447, 912, 796, 125, 1501, 743, - 752, 801, 555, 913, 132, 20, 120, 455, 23, 24, - 2501, 1514, 558, 647, 1517, 2915, 4148, 927, 820, 289, - 390, 913, 1869, 1728, 678, 3267, 379, 906, 1849, 1734, - 4304, 3484, 1737, 706, 1739, 927, 160, 390, 2217, 2218, - 384, 675, 386, 3496, 3497, 324, 325, 326, 327, 328, - 329, 330, 331, 332, 927, 832, 544, 913, 345, 501, - 913, 1828, 912, 509, 2472, 832, 1833, 913, 2852, 193, - 1837, 911, 186, 913, 1577, 766, 2402, 829, 746, 2725, - 4134, 614, 408, 207, 295, 1852, 2718, 298, 2828, 4143, - 458, 912, 2353, 784, 36, 3548, 1599, 541, 503, 504, - 2839, 2840, 455, 912, 913, 796, 629, 299, 1611, 927, - 801, 2445, 913, 913, 2495, 507, 624, 2451, 471, 2453, - 493, 2455, 1857, 240, 819, 4304, 4123, 744, 14, 3993, - 3994, 883, 4061, 4062, 4304, 298, 739, 913, 4126, 4304, - 796, 893, 455, 596, 597, 4133, 582, 629, 555, 4137, - 927, 927, 4140, 1888, 229, 601, 250, 856, 812, 1864, - 1927, 913, 256, 556, 484, 541, 559, 580, 455, 55, - 640, 584, 4304, 841, 856, 927, 455, 753, 824, 409, - 826, 549, 455, 379, 654, 553, 300, 398, 458, 912, - 3658, 825, 827, 423, 1899, 565, 850, 832, 744, 2020, - 1006, 614, 318, 1908, 611, 416, 2135, 712, 4205, 499, - 3809, 501, 538, 912, 619, 445, 542, 292, 16, 671, - 2601, 2478, 674, 2480, 616, 2559, 2560, 2535, 680, 752, - 28, 3699, 819, 2490, 16, 398, 509, 463, 20, 512, - 354, 23, 24, 916, 651, 628, 2511, 2504, 3032, 3033, - 4114, 4115, 168, 416, 282, 858, 350, 745, 640, 455, - 219, 3045, 3046, 291, 2933, 1071, 14, 640, 350, 3868, - 752, 2528, 464, 646, 4262, 471, 629, 4265, 379, 549, - 3064, 3065, 2453, 475, 819, 283, 84, 513, 4367, 4391, - 384, 408, 386, 291, 2675, 409, 2567, 665, 2569, 2478, - 713, 2480, 384, 576, 386, 421, 829, 55, 628, 423, - 409, 427, 858, 3781, 756, 594, 629, 759, 760, 447, - 593, 335, 827, 451, 240, 2504, 811, 832, 827, 250, - 1833, 445, 822, 832, 1837, 4414, 4415, 705, 617, 827, - 2451, 106, 2453, 833, 832, 2602, 831, 829, 335, 2528, - 125, 4208, 4209, 2610, 455, 369, 455, 132, 569, 2630, - 2127, 2128, 2129, 2628, 2659, 747, 748, 750, 2189, 256, - 471, 7, 2139, 2198, 2199, 2200, 2201, 2202, 2203, 2204, - 2205, 197, 369, 751, 2765, 753, 699, 335, 2559, 2560, - 913, 774, 775, 776, 822, 160, 2131, 409, 816, 752, - 2135, 16, 4413, 379, 927, 833, 569, 2228, 817, 827, - 640, 603, 186, 28, 832, 645, 784, 53, 827, 283, - 537, 369, 2189, 832, 1927, 542, 399, 291, 193, 65, - 750, 913, 662, 629, 664, 705, 4447, 713, 890, 752, - 2711, 2698, 207, 2178, 849, 927, 766, 640, 2559, 2560, - 642, 691, 576, 646, 774, 775, 776, 556, 2225, 2226, - 559, 2718, 586, 587, 784, 2286, 834, 659, 819, 84, - 4373, 2879, 2729, 3715, 110, 4378, 829, 3114, 271, 455, - 640, 801, 458, 498, 499, 2220, 646, 4344, 2255, 3273, - 219, 804, 4362, 4363, 4358, 471, 4014, 133, 2233, 297, - 2406, 823, 2408, 4360, 2410, 4023, 640, 2940, 817, 819, - 2331, 811, 646, 4031, 784, 815, 610, 2338, 827, 2698, - 447, 615, 4392, 832, 451, 501, 640, 713, 629, 2135, - 384, 645, 386, 615, 549, 550, 1807, 2871, 662, 1810, - 4410, 539, 2363, 541, 336, 913, 338, 1818, 662, 819, - 664, 1822, 3292, 539, 190, 541, 752, 2865, 1829, 832, - 4424, 685, 686, 447, 834, 318, 306, 451, 484, 766, - 2337, 91, 92, 93, 927, 3359, 3360, 2479, 2507, 2481, - 2418, 379, 335, 4369, 2422, 2487, 2488, 2489, 831, 819, - 833, 816, 2494, 913, 4464, 738, 2301, 816, 738, 2304, - 913, 819, 827, 2505, 2506, 837, 838, 832, 827, 819, - 2991, 2217, 2218, 832, 927, 819, 369, 3050, 3051, 1177, - 1178, 1179, 32, 33, 2127, 2128, 2129, 3918, 819, 2364, - 2451, 2345, 2453, 829, 913, 2340, 272, 443, 444, 437, - 438, 547, 548, 913, 390, 1203, 4249, 37, 4012, 24, - 25, 752, 488, 629, 2359, 1209, 1210, 455, 4022, 889, - 1211, 1212, 1213, 2368, 2369, 4459, 404, 4461, 819, 4463, - 2437, 2438, 2601, 471, 427, 2970, 2443, 2444, 2445, 2446, - 2460, 2461, 297, 713, 2451, 913, 2453, 819, 2455, 209, - 210, 2486, 212, 819, 4297, 4298, 449, 3023, 1185, 1186, - 4303, 134, 692, 4306, 913, 819, 342, 4310, 4311, 2414, - 2415, 509, 628, 913, 2217, 2218, 498, 499, 913, 2486, - 1484, 1485, 1486, 2226, 2985, 455, 918, 919, 829, 819, - 819, 927, 819, 2538, 219, 819, 2503, 455, 2559, 2560, - 3377, 455, 842, 913, 2511, 2450, 819, 3384, 869, 870, - 871, 872, 2457, 624, 869, 870, 871, 872, 869, 870, - 871, 872, 7, 915, 379, 819, 564, 549, 550, 1279, - 1280, 1281, 1282, 725, 744, 889, 752, 3517, 112, 121, - 913, 2548, 455, 409, 2551, 2714, 819, 423, 844, 336, - 724, 2558, 2559, 2560, 2561, 2260, 2261, 2262, 2263, 913, - 2567, 608, 2569, 713, 139, 562, 819, 2736, 53, 559, - 806, 590, 455, 727, 406, 819, 3485, 819, 454, 614, - 65, 194, 437, 438, 815, 138, 927, 912, 14, 355, - 814, 629, 913, 295, 750, 913, 913, 831, 819, 713, - 455, 462, 819, 442, 555, 823, 290, 32, 819, 3157, - 766, 2780, 913, 455, 488, 3288, 471, 4148, 774, 775, - 776, 2628, 241, 2630, 831, 110, 484, 345, 784, 3653, - 3654, 831, 2478, 831, 2480, 831, 852, 831, 398, 399, - 831, 2616, 831, 242, 831, 801, 831, 831, 133, 297, - 831, 365, 831, 831, 814, 243, 246, 244, 2504, 3233, - 691, 640, 422, 161, 796, 796, 361, 78, 884, 885, - 247, 912, 2647, 814, 455, 248, 552, 249, 182, 270, - 2826, 2827, 2528, 2829, 2830, 2831, 803, 447, 831, 253, - 83, 814, 254, 913, 804, 258, 257, 291, 345, 259, - 893, 913, 260, 345, 2711, 190, 261, 487, 3381, 564, - 609, 927, 472, 4317, 752, 42, 262, 405, 2725, 831, - 263, 345, 264, 761, 265, 201, 266, 819, 713, 453, - 658, 819, 3756, 3757, 3758, 2478, 819, 2480, 154, 336, - 795, 913, 678, 809, 168, 4349, 814, 913, 2723, 913, - 626, 4148, 814, 3264, 630, 3266, 913, 353, 2819, 396, - 2503, 2504, 612, 457, 455, 488, 676, 911, 2511, 541, - 291, 3750, 3751, 4304, 629, 868, 911, 906, 816, 455, - 818, 236, 315, 661, 252, 2528, 345, 272, 405, 827, - 828, 829, 2737, 831, 832, 733, 814, 367, 806, 811, - 3370, 800, 405, 405, 240, 912, 83, 814, 814, 569, - 2871, 2818, 814, 201, 345, 345, 2761, 83, 2825, 405, - 267, 345, 2991, 819, 2567, 713, 2569, 662, 889, 155, - 31, 707, 819, 555, 646, 453, 819, 76, 547, 108, - 14, 421, 602, 744, 136, 926, 606, 607, 925, 766, - 3918, 766, 2698, 2798, 421, 547, 2801, 342, 2803, 2804, - 495, 816, 353, 2808, 2871, 2810, 2811, 2812, 2813, 3015, - 816, 816, 816, 633, 816, 2820, 816, 3901, 3902, 3500, - 678, 816, 816, 814, 814, 2628, 37, 2630, 683, 927, - 2736, 767, 3871, 657, 421, 353, 353, 752, 2843, 455, - 567, 883, 927, 251, 661, 814, 83, 226, 3482, 353, - 390, 819, 906, 556, 628, 906, 630, 555, 766, 633, - 353, 814, 16, 49, 50, 51, 52, 641, 3805, 643, - 56, 13, 678, 2878, 2780, 239, 713, 819, 423, 704, - 889, 2948, 354, 3112, 3923, 3114, 660, 661, 74, 75, - 906, 665, 687, 458, 37, 2698, 409, 2964, 672, 2966, - 354, 816, 108, 818, 893, 913, 728, 766, 2711, 454, - 463, 847, 827, 828, 829, 689, 831, 832, 727, 57, - 913, 455, 816, 816, 745, 353, 408, 544, 513, 703, - 542, 705, 706, 240, 3163, 25, 806, 123, 236, 889, - 889, 336, 83, 3010, 336, 168, 727, 14, 345, 537, - 240, 594, 661, 819, 3580, 3581, 564, 202, 793, 644, - 498, 888, 95, 819, 713, 927, 90, 806, 853, 905, - 655, 814, 37, 913, 336, 795, 162, 3534, 725, 555, - 3015, 666, 667, 814, 3665, 451, 728, 597, 25, 562, - 345, 744, 3027, 196, 353, 353, 212, 816, 656, 3633, - 14, 656, 186, 55, 495, 3211, 207, 552, 3075, 825, - 565, 567, 927, 560, 255, 421, 463, 186, 792, 518, - 4148, 463, 447, 4063, 543, 3146, 830, 876, 3703, 3762, - 613, 819, 456, 806, 345, 811, 3701, 913, 744, 455, - 109, 806, 913, 3164, 819, 392, 205, 83, 3115, 812, - 3171, 197, 783, 610, 513, 513, 3091, 831, 832, 833, - 3207, 83, 463, 463, 3069, 463, 278, 610, 538, 3216, - 3217, 3166, 203, 819, 814, 913, 203, 766, 345, 13, - 3094, 626, 806, 857, 498, 630, 23, 610, 568, 683, - 3185, 496, 3213, 864, 822, 281, 3191, 3218, 913, 3166, - 729, 3196, 3197, 634, 396, 335, 583, 480, 3665, 3204, - 884, 3206, 3233, 814, 541, 3182, 3183, 291, 3185, 614, - 3754, 194, 814, 3856, 3191, 819, 41, 3194, 393, 3196, - 3197, 690, 474, 3339, 3340, 820, 663, 3204, 3695, 3206, - 744, 823, 3209, 819, 203, 541, 850, 756, 3377, 819, - 559, 337, 196, 497, 823, 3384, 226, 783, 498, 23, - 610, 2964, 707, 2966, 541, 3791, 3233, 4304, 782, 291, - 819, 421, 421, 3854, 20, 21, 22, 205, 437, 555, - 819, 3186, 554, 957, 906, 421, 421, 168, 421, 437, - 421, 377, 354, 967, 968, 437, 119, 3264, 796, 3266, - 3205, 230, 3207, 108, 354, 369, 3112, 3010, 3114, 394, - 564, 345, 3893, 987, 3219, 442, 83, 508, 770, 576, - 3449, 564, 767, 819, 11, 576, 576, 3294, 48, 45, - 113, 916, 528, 221, 83, 3792, 196, 272, 278, 1013, - 90, 296, 751, 202, 1128, 198, 3816, 932, 3874, 3883, - 3617, 477, 2015, 4058, 2809, 3596, 3737, 3163, 2817, 459, - 3594, 2831, 3183, 3944, 3976, 1039, 3912, 113, 3987, 2133, - 716, 1045, 3075, 2304, 3309, 1638, 3397, 4428, 2770, 3719, - 3813, 2016, 3868, 469, 2780, 4122, 4249, 4372, 4377, 3706, - 4148, 976, 3864, 974, 1068, 665, 4209, 1482, 1072, 1073, - 4015, 4015, 847, 3370, 4022, 4050, 1708, 3269, 2844, 233, - 3516, 1157, 909, 3939, 2870, 3320, 2879, 1169, 1163, 1843, - 1745, 2509, 847, 3418, 3239, 3267, 3761, 3760, 514, 1227, - 645, 857, 903, 1258, 3369, 1888, 3431, 1915, 2933, 41, - 915, 2536, 665, 1294, 1291, 2969, 2582, 936, 1967, 2980, - 2978, 3418, 1037, 1320, 1493, 3476, 2610, 2005, 2996, 1044, - 905, 3482, 2995, 1048, 3431, 3511, 3461, 3650, 1498, 3309, - 3021, 982, 3688, 2135, 2170, 77, 2647, 79, 3027, 3036, - 3035, 2723, 3449, 1565, 3419, 2662, 572, 2206, 682, 3946, - 1021, 359, 364, 2701, 3461, 1023, 1170, 1171, 3403, 1604, - 102, 3468, 3549, 1177, 1178, 1179, 3079, 2233, 2233, 3893, - 1184, 1185, 1186, 1187, 3686, 3482, 1190, 2184, 2169, 3560, - 122, 3647, 3947, 4073, 126, 3952, 1200, 2433, 1202, 1203, - 1630, 2431, 3955, 1269, 280, 1209, 1210, 1211, 1212, 1213, - 1268, 3905, 3477, 3904, 3770, 3657, 3656, 2500, 2499, 3084, - 1224, 3068, 1226, 3659, 3540, 3067, 2534, 3578, 3463, 3363, - 4017, 3264, 3583, 3266, 3085, 1239, 3364, 2533, 681, 854, - 1244, 3377, 1299, 1941, 3595, 1308, 2694, 1007, 3384, 2694, - 1967, 2694, 2694, 707, 1221, 3166, 2787, 204, 3500, 2192, - 2007, 2991, 2714, 679, 1224, 681, 682, 4017, 3944, 2413, - 519, 755, 1276, 4167, 816, 1639, 2208, 3734, 2777, 1194, - 3515, 2525, 3633, 3074, 3349, 701, 362, 363, 3585, 3586, - 706, 3682, 4318, 2949, 2328, 3560, 3483, 4202, 3598, 4198, - 3597, 786, 4349, 4405, 290, 3012, 3603, 533, 2213, 3173, - 1907, 4198, 1167, 3772, 3930, 1647, 2407, 3203, 4364, -1, - -1, -1, -1, 3700, -1, -1, 3623, -1, 744, -1, - -1, 3566, -1, -1, -1, -1, 3633, -1, -1, -1, - 756, -1, -1, -1, -1, -1, 3805, -1, -1, -1, - 3615, 3616, 3617, -1, -1, -1, -1, 1272, -1, -1, - 4323, 3658, -1, -1, 440, 441, 4204, -1, -1, -1, - 1285, 1286, -1, -1, 3609, -1, -1, -1, -1, 4217, - -1, -1, -1, -1, -1, 3620, 3621, -1, 3713, 3714, - 3625, 3626, -1, 1308, -1, -1, -1, -1, 3534, -1, - -1, -1, 3699, 3754, -1, -1, -1, -1, -1, 34, - 35, 3736, 3737, 3849, 3649, -1, 3713, 3714, -1, -1, - -1, -1, -1, -1, -1, 3660, -1, -1, -1, -1, - 506, -1, -1, -1, -1, 367, -1, -1, 854, 3736, - 3737, -1, -1, -1, 4149, -1, -1, -1, -1, -1, - 3827, 3828, -1, -1, -1, 3891, 3691, 3754, -1, -1, - -1, -1, -1, 3728, 540, -1, -1, -1, -1, 3734, - -1, -1, -1, 549, 3709, -1, -1, -1, -1, -1, - -1, -1, 558, -1, 3781, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, 1501, -1, -1, - 125, -1, 434, -1, -1, -1, -1, 132, -1, -1, - 135, -1, -1, -1, -1, 447, -1, 3814, -1, 451, - -1, -1, -1, 599, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, -1, 1552, -1, - -1, -1, -1, -1, 3879, -1, -1, -1, 4017, -1, - 1564, -1, 1566, -1, 189, -1, 191, 192, 3919, -1, - -1, -1, -1, -1, 4430, 4362, 4363, 3812, -1, -1, - -1, -1, 3879, 3818, -1, -1, 3883, -1, -1, -1, - -1, -1, -1, -1, -1, 1599, 3831, -1, -1, 1603, - 3925, -1, 1517, -1, -1, 4392, -1, -1, -1, -1, - -1, -1, 1616, -1, -1, -1, 7, -1, -1, -1, - -1, -1, -1, 4410, -1, -1, -1, -1, 3925, -1, - -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, -1, -1, 274, - -1, 276, 3917, -1, -1, -1, -1, -1, 283, -1, - -1, 3896, 53, 595, 596, 597, 291, 1582, 3933, 3805, - -1, 3906, -1, -1, 65, 4026, -1, 4464, 1593, -1, - -1, -1, 3917, 3918, -1, 49, 50, 51, 52, 1604, - -1, -1, 56, -1, -1, -1, 1611, -1, -1, 3934, - 3935, -1, -1, -1, -1, -1, -1, -1, -1, -1, - 74, 75, -1, -1, 3949, -1, -1, -1, -1, 110, - -1, -1, -1, -1, -1, -1, 4162, 3962, -1, -1, - 3965, 3966, 3967, 3968, 4085, -1, -1, -1, -1, -1, - -1, -1, 133, -1, 820, -1, -1, -1, 824, -1, - 826, -1, -1, -1, -1, 687, -1, -1, -1, 123, - -1, -1, -1, -1, -1, 4116, 1770, -1, -1, 4004, - -1, -1, -1, 398, -1, 7, -1, -1, 4013, -1, - -1, 4016, 1786, 4134, -1, -1, -1, -1, -1, 1, - -1, -1, 4143, 4058, -1, -1, -1, -1, 162, 190, - 732, -1, 1806, -1, -1, -1, -1, -1, -1, -1, - -1, 1815, -1, -1, -1, -1, -1, -1, -1, -1, - -1, 53, 447, -1, -1, -1, 451, -1, -1, 4126, - -1, -1, -1, 65, -1, -1, 4133, -1, -1, -1, - 4137, -1, -1, 4140, -1, 57, 58, 59, 60, 61, - -1, 63, 64, -1, -1, -1, 4091, 4092, 4093, 4094, - 4095, -1, 487, 4098, 4099, 4100, 4101, 4102, 4103, 4104, - 4105, 4106, 4107, 4108, -1, -1, 4111, -1, 110, -1, - 812, 272, -1, -1, 4119, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, 4130, -1, 4132, 4249, -1, - -1, 133, 834, -1, -1, -1, -1, 4142, -1, -1, - -1, 1915, -1, 4148, -1, 1919, -1, 281, -1, -1, - -1, -1, -1, -1, -1, -1, -1, -1, 140, -1, - 142, 143, 144, 145, 146, 147, 148, 149, 150, -1, - -1, -1, -1, 334, -1, -1, 4297, 4298, -1, -1, - -1, 342, 4303, -1, -1, 4306, -1, -1, 190, 4310, - 4311, -1, 1877, -1, -1, 4262, -1, -1, 4265, 4320, - -1, -1, -1, 337, -1, -1, -1, -1, -1, -1, - 912, -1, -1, -1, -1, -1, 1990, -1, 1992, 1993, - 1994, -1, -1, 4344, -1, -1, -1, -1, -1, -1, - 212, -1, -1, -1, 2008, -1, -1, -1, 2012, 4360, - 2014, -1, -1, 377, -1, -1, 2020, -1, -1, -1, - -1, -1, 4373, -1, -1, -1, 4377, 4378, -1, -1, - -1, -1, 423, -1, -1, -1, -1, 4388, -1, 430, - 272, 4276, 4277, -1, 4279, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, 4296, -1, 454, -1, -1, 4301, 4302, -1, -1, - -1, -1, -1, -1, -1, -1, -1, -1, -1, 704, - -1, -1, -1, -1, 4319, -1, -1, 4322, -1, -1, - 4325, 482, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, 334, -1, -1, 469, -1, -1, -1, -1, - 342, -1, 324, 325, 326, 327, 328, 4468, -1, 331, - 332, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, 2135, -1, -1, 2138, 16, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, -1, -1, 513, - -1, 630, -1, -1, -1, 367, -1, -1, -1, 638, - -1, -1, 787, -1, 555, -1, -1, 2171, -1, -1, - -1, 650, 2176, 798, -1, -1, -1, -1, -1, 658, - 392, 2185, 2186, -1, 809, -1, -1, -1, -1, -1, - -1, 423, -1, -1, -1, -1, -1, -1, 430, -1, - -1, -1, 681, 84, -1, -1, -1, -1, 572, -1, - -1, -1, -1, 2217, 2218, -1, -1, -1, -1, -1, - 2224, -1, 454, -1, -1, -1, 4362, 4363, 2232, 2233, - -1, -1, -1, -1, -1, 626, 2240, -1, -1, 630, - -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - 482, -1, -1, -1, -1, 880, 4392, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - 151, -1, -1, -1, 4410, -1, 157, 158, -1, -1, - -1, -1, 2197, -1, -1, -1, 498, -1, 913, -1, - -1, -1, 173, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, 679, 707, 681, 682, -1, - -1, -1, -1, -1, -1, -1, -1, -1, 4464, 4362, - 4363, -1, -1, -1, -1, -1, -1, 701, -1, -1, - -1, -1, 706, -1, 823, -1, -1, -1, -1, -1, - -1, -1, 831, 832, 833, -1, -1, -1, -1, 4392, - -1, 573, 841, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, 767, 4410, -1, -1, - 744, -1, 594, -1, -1, -1, -1, -1, -1, 780, - 869, -1, 756, -1, 626, -1, -1, 1, 630, -1, - -1, -1, -1, -1, -1, 617, -1, 11, -1, -1, - -1, -1, 16, 804, -1, -1, 20, 21, 22, -1, - -1, -1, -1, -1, 28, 29, -1, -1, 2432, -1, - -1, 4464, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, 2459, 847, 338, 339, 340, - 341, 940, -1, -1, -1, -1, -1, -1, -1, -1, - 351, -1, -1, 952, 2478, 707, 2480, -1, -1, -1, - -1, -1, -1, -1, -1, -1, 2490, -1, -1, -1, - 854, -1, -1, -1, -1, -1, -1, -1, 379, -1, - 2504, 892, -1, 2507, -1, -1, -1, -1, -1, 113, - -1, -1, -1, -1, 905, -1, -1, -1, -1, -1, - 911, -1, 913, -1, 2528, -1, -1, -1, 740, 741, - 742, 2535, -1, -1, 1013, 767, -1, -1, -1, -1, - -1, -1, -1, -1, 1023, -1, -1, 151, 780, -1, - -1, 1030, -1, 157, 158, -1, 437, 438, 439, -1, - 1039, -1, -1, -1, -1, -1, -1, -1, -1, 173, - -1, -1, 804, -1, 455, -1, -1, -1, 459, 460, - 461, -1, -1, -1, 2588, -1, -1, 468, -1, -1, - 471, -1, -1, -1, -1, -1, -1, -1, 2602, -1, - -1, -1, -1, -1, -1, -1, 2610, -1, -1, -1, - -1, -1, -1, -1, -1, 847, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - 2634, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, 859, 860, 861, - -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - 892, -1, -1, -1, -1, -1, -1, -1, -1, -1, - 551, -1, -1, 905, -1, -1, 280, -1, -1, 911, - -1, 913, -1, -1, -1, -1, 2690, -1, -1, -1, - -1, -1, -1, 297, 2698, -1, -1, -1, 1177, 1178, - 1179, 913, -1, -1, -1, 1184, 1185, 1186, 1187, -1, - 2714, 1190, 2627, -1, 2718, 1194, -1, -1, -1, -1, - -1, 1200, -1, 1202, 1203, 2729, -1, -1, -1, -1, - 1209, 1210, 1211, 1212, 1213, 339, 340, 341, -1, -1, - -1, -1, -1, -1, -1, -1, -1, 351, 629, -1, - -1, -1, -1, -1, -1, -1, -1, -1, 362, 363, - 1239, -1, 2677, -1, -1, 1244, -1, -1, -1, -1, - -1, -1, -1, -1, -1, 379, -1, -1, -1, -1, - -1, -1, -1, -1, -1, 2700, 2701, -1, -1, -1, - -1, -1, 2707, -1, -1, -1, -1, 1276, -1, 680, - -1, -1, -1, -1, -1, 409, -1, 1286, -1, -1, - -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, 437, 438, 439, 440, 441, -1, -1, - -1, -1, 446, -1, 448, -1, 16, -1, -1, -1, - -1, 455, -1, -1, -1, 459, 460, 461, -1, -1, - -1, 2865, -1, -1, 468, -1, 2870, 471, -1, -1, - -1, 752, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, 487, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, 777, 778, -1, -1, - -1, -1, 506, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, 49, 50, 51, 52, 800, - -1, -1, 56, -1, -1, -1, 530, -1, -1, -1, - -1, -1, -1, 16, -1, -1, 540, -1, -1, 109, - 74, 75, -1, -1, -1, 549, -1, 551, 829, -1, - -1, -1, -1, -1, 558, 1, -1, -1, -1, -1, - 564, -1, -1, -1, -1, 11, -1, 848, -1, -1, - 16, -1, -1, 577, 20, 21, 22, -1, -1, -1, - -1, 151, 28, 864, -1, -1, -1, 157, 158, 123, - -1, -1, -1, 874, -1, 599, -1, -1, -1, -1, - -1, 882, -1, 173, -1, -1, -1, -1, -1, -1, - 1489, -1, 893, -1, -1, -1, 2931, 3021, -1, -1, - -1, -1, 1501, -1, -1, 629, 907, -1, 162, -1, - -1, 912, 913, -1, -1, 1514, -1, -1, 1517, -1, - -1, -1, -1, -1, -1, -1, 927, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, 113, 151, -1, - -1, -1, -1, -1, 157, 158, 680, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - 173, -1, -1, -1, -1, -1, -1, -1, 1577, -1, - -1, -1, -1, -1, -1, 151, -1, 3022, -1, -1, - -1, 157, 158, -1, -1, -1, -1, -1, -1, -1, - 1599, -1, 151, -1, -1, -1, -1, 173, 157, 158, - -1, -1, 1611, -1, -1, -1, -1, 1616, -1, -1, - -1, -1, -1, -1, 173, -1, -1, 281, 752, -1, - -1, -1, -1, 3157, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, -1, -1, 339, - 340, 341, -1, 777, 778, -1, -1, -1, -1, -1, - -1, 351, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, 337, -1, -1, -1, -1, -1, 379, - -1, -1, 816, -1, 818, -1, 820, -1, 822, -1, - 824, -1, 826, 827, 828, 829, -1, 831, 832, 833, - -1, -1, -1, -1, 280, -1, -1, -1, -1, -1, - -1, -1, -1, 377, 848, -1, -1, -1, -1, 3253, - 296, 297, -1, -1, -1, -1, 339, 340, 341, -1, - -1, 431, -1, -1, -1, -1, -1, -1, 351, 439, - 874, -1, -1, -1, -1, -1, -1, -1, 882, -1, - -1, -1, 3286, -1, -1, 455, -1, -1, -1, 459, - 460, 461, -1, 339, 340, 341, 379, -1, 468, -1, - -1, 471, -1, 907, -1, 351, -1, 1786, -1, 913, - 339, 340, 341, -1, -1, -1, 362, 363, -1, -1, - -1, -1, 351, 927, -1, -1, -1, -1, -1, 3244, - 3245, 3246, 3247, 379, -1, 469, 1815, -1, -1, -1, - -1, -1, -1, 3347, -1, -1, -1, -1, -1, -1, - -1, 3355, -1, 3357, 1833, -1, 439, -1, 1837, -1, - -1, -1, -1, 409, -1, -1, -1, 3282, 3283, -1, - -1, -1, 455, -1, -1, -1, 459, 460, 461, -1, - -1, 551, -1, -1, -1, 468, -1, -1, 471, -1, - -1, 437, 438, 439, 440, 441, -1, -1, -1, -1, - 446, -1, 448, -1, -1, -1, -1, -1, -1, 455, - 439, -1, -1, 459, 460, 461, -1, -1, -1, -1, - -1, -1, 468, -1, -1, 471, 455, -1, -1, -1, - 459, 460, 461, -1, -1, -1, 1915, -1, 572, 468, - -1, 487, -1, -1, -1, -1, -1, -1, 1927, -1, - -1, -1, -1, -1, -1, -1, -1, -1, -1, 629, - 506, -1, -1, -1, -1, -1, -1, -1, 551, -1, - -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, 530, -1, -1, -1, 3492, -1, - -1, -1, -1, -1, 540, -1, -1, -1, -1, -1, - -1, -1, -1, 549, -1, 551, -1, -1, 3512, 3513, - 680, -1, 558, -1, -1, -1, -1, -1, 564, -1, - -1, -1, 551, -1, -1, -1, -1, -1, 2007, 2008, - 3534, 577, -1, 3537, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, 679, 629, 681, 682, -1, - -1, -1, -1, 599, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, 701, -1, -1, - 3574, -1, 706, -1, -1, -1, -1, -1, -1, -1, - -1, -1, 752, 629, -1, -1, -1, -1, -1, -1, - 3505, -1, -1, -1, -1, -1, -1, 680, -1, -1, - -1, -1, -1, -1, -1, -1, -1, 777, 778, -1, - 744, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, 756, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, 680, -1, -1, -1, -1, -1, - -1, -1, -1, 3647, -1, -1, 3650, -1, 2127, 2128, - 2129, 680, -1, -1, -1, -1, -1, -1, -1, 829, - -1, -1, -1, -1, -1, -1, -1, -1, -1, 752, - -1, -1, 842, -1, -1, -1, -1, -1, 848, -1, - 6, -1, -1, 9, -1, -1, -1, -1, -1, -1, - -1, 3695, -1, -1, 777, 778, -1, -1, -1, -1, - -1, 27, -1, -1, 874, -1, 752, 2186, -1, -1, - -1, -1, 882, -1, 40, -1, -1, -1, -1, -1, - 854, -1, -1, 3638, -1, -1, -1, -1, -1, -1, - -1, 777, 778, -1, -1, -1, -1, 907, 2217, 2218, - -1, -1, -1, 913, -1, -1, 829, 2226, 777, 778, - -1, -1, -1, -1, -1, -1, -1, 927, -1, -1, - -1, -1, -1, -1, 3768, 848, -1, -1, -1, -1, - 816, -1, 818, -1, 820, -1, -1, -1, 824, -1, - 826, 827, 828, 829, -1, 831, 832, -1, 3792, -1, - -1, 874, -1, -1, -1, 121, -1, -1, -1, 882, - -1, -1, 848, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, -1, -1, 848, - -1, -1, -1, -1, 907, -1, -1, -1, 874, -1, - 913, -1, -1, -1, -1, -1, 882, 3841, -1, -1, - -1, -1, 3846, -1, 927, 874, -1, -1, -1, -1, - -1, -1, -1, 882, -1, -1, -1, -1, -1, -1, - -1, 907, -1, -1, -1, -1, -1, 913, -1, -1, - -1, -1, -1, -1, -1, -1, -1, -1, 907, -1, - -1, 927, -1, -1, 913, -1, -1, -1, -1, -1, - -1, -1, -1, -1, 3898, 3899, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - 3914, 3915, -1, -1, -1, 3919, -1, -1, -1, -1, - -1, -1, -1, -1, -1, 1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, 11, -1, -1, -1, -1, - 16, -1, 3946, 3947, 20, 21, 22, -1, 3952, -1, - -1, -1, 28, -1, -1, -1, -1, -1, -1, -1, - 3964, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, 3979, -1, -1, -1, -1, - -1, -1, 308, 309, -1, -1, 3990, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, -1, 4002, 2478, - -1, 2480, -1, -1, -1, -1, -1, -1, -1, -1, - -1, 2490, -1, 4017, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, 2503, 2504, -1, -1, -1, -1, - 4034, -1, 2511, 4037, -1, -1, -1, 113, -1, -1, - -1, -1, -1, -1, -1, -1, -1, -1, -1, 2528, - -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, 393, -1, -1, - -1, -1, -1, -1, -1, 151, -1, -1, -1, -1, - 4084, 157, 158, 4087, 4088, 4089, 4090, -1, 2567, -1, - 2569, -1, -1, 4097, -1, -1, -1, 173, -1, -1, - -1, -1, -1, -1, -1, -1, 4110, -1, -1, -1, - -1, -1, 4116, -1, -1, -1, -1, -1, 4122, 4123, - -1, 447, -1, 2602, -1, -1, -1, -1, -1, -1, - 4134, 2610, -1, -1, -1, 41, -1, 463, -1, 4143, - -1, -1, -1, 49, 50, 51, 52, -1, -1, 2628, - 56, 2630, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, -1, 74, 75, - 4174, 4175, 4176, 4177, 4178, 4179, 4180, 4181, 4182, 4183, - 4184, 4185, 4186, 4187, 4188, 4189, 4190, 4191, 4192, -1, - -1, -1, 11, -1, -1, -1, -1, 16, -1, 525, - 4204, 4205, -1, -1, 280, -1, -1, -1, -1, -1, - -1, -1, -1, 4217, -1, -1, 122, 123, -1, 2698, - 126, 297, -1, -1, -1, -1, 4230, -1, -1, -1, - -1, -1, 2711, -1, -1, -1, -1, -1, 4242, 2718, - 566, -1, -1, -1, -1, 4249, -1, -1, 574, -1, - 2729, -1, -1, -1, -1, -1, 162, -1, -1, -1, - -1, -1, -1, 339, 340, 341, -1, -1, -1, 4273, - 4274, -1, -1, -1, -1, 351, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, 362, 363, 4292, -1, - -1, -1, -1, 4297, 4298, -1, -1, -1, -1, 4303, - -1, 4305, 4306, 379, -1, -1, 4310, 4311, -1, -1, - -1, -1, -1, -1, 640, -1, -1, -1, -1, -1, - -1, -1, 4326, -1, -1, -1, -1, -1, 654, 151, - -1, -1, 151, 409, -1, 157, 158, -1, 157, 158, - -1, -1, -1, 669, -1, -1, 4350, -1, 167, -1, - -1, 173, -1, -1, 173, -1, -1, -1, 4362, 4363, - -1, 437, 438, 439, 440, 441, -1, -1, -1, -1, - 446, -1, 448, -1, -1, 281, -1, 4381, -1, 455, - -1, -1, -1, 459, 460, 461, -1, -1, 4392, -1, - -1, -1, 468, -1, -1, 471, -1, -1, -1, -1, - -1, 727, -1, -1, -1, -1, 4410, 733, 4412, 4413, - -1, 487, -1, -1, -1, -1, -1, -1, -1, -1, - -1, 747, 4426, -1, -1, -1, -1, 4431, -1, -1, - 506, 337, -1, -1, -1, -1, -1, 4441, 4442, -1, - 766, -1, -1, 4447, -1, -1, -1, -1, -1, -1, - -1, 4455, -1, -1, 530, -1, -1, -1, -1, -1, - 4464, -1, -1, -1, 540, -1, -1, -1, -1, -1, - -1, 377, -1, 549, -1, 551, -1, -1, -1, -1, - -1, -1, 558, -1, -1, 2964, -1, 2966, 564, -1, - -1, -1, -1, 819, -1, -1, -1, 823, -1, -1, - -1, 577, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, 839, 840, -1, -1, 339, 340, 341, - 339, 340, 341, 599, -1, -1, -1, -1, -1, 351, - -1, 3010, 351, -1, -1, -1, -1, -1, -1, -1, - -1, 447, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, 629, -1, -1, -1, -1, -1, -1, - 379, -1, -1, 469, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, 488, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, 3075, -1, -1, -1, - -1, -1, -1, -1, 680, -1, -1, -1, 514, -1, - -1, -1, -1, -1, -1, 437, 438, 439, 437, 438, - 439, -1, -1, -1, -1, -1, -1, 446, -1, 448, - -1, -1, -1, 455, -1, -1, 455, 459, 460, 461, - 459, 460, 461, -1, -1, -1, 468, -1, -1, 468, - -1, -1, 471, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, 572, -1, 487, -1, - -1, -1, -1, -1, -1, -1, 752, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - 596, 597, -1, -1, -1, -1, -1, -1, -1, -1, - -1, 777, 778, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, -1, -1, 551, - -1, -1, 551, -1, -1, -1, -1, -1, -1, -1, - 816, -1, 818, -1, 820, -1, -1, -1, 824, -1, - 826, 827, 828, 829, -1, 831, 832, -1, 577, -1, - -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, 848, 679, -1, 681, 682, -1, -1, -1, - -1, -1, -1, -1, -1, 3264, -1, 3266, -1, -1, - -1, -1, -1, -1, -1, 701, -1, -1, 874, -1, - 706, -1, 3, -1, -1, -1, 882, 8, -1, -1, - 629, 12, -1, -1, 15, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, 27, -1, -1, -1, - -1, 907, -1, -1, -1, -1, -1, 913, 744, -1, - -1, -1, -1, -1, 45, 46, -1, -1, -1, -1, - 756, 927, -1, -1, -1, -1, -1, -1, 680, -1, - -1, 680, -1, -1, -1, 66, 67, 68, 69, 70, - 71, 72, 73, -1, -1, -1, 77, 78, 79, -1, - 81, 82, -1, -1, -1, 86, -1, -1, 89, -1, - -1, -1, -1, -1, -1, -1, 97, 98, 99, 100, - 101, -1, 103, 104, -1, -1, -1, -1, -1, -1, - -1, -1, -1, 114, -1, -1, -1, -1, -1, -1, - -1, -1, -1, 124, -1, -1, 127, 128, 129, 130, - 131, -1, -1, 752, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, -1, 854, -1, - -1, -1, -1, -1, -1, 777, 778, -1, 777, 778, - -1, -1, 868, -1, 165, -1, -1, -1, -1, -1, - -1, -1, -1, 174, 175, 176, 177, 178, 179, 180, - 181, -1, -1, -1, 185, -1, 187, 188, -1, -1, - -1, -1, -1, -1, -1, -1, -1, 198, -1, -1, - -1, -1, -1, -1, -1, -1, 912, -1, -1, -1, - 829, -1, 213, 214, -1, -1, 217, 218, -1, 220, - 221, 222, 223, 224, -1, -1, 848, -1, -1, 848, - -1, -1, -1, 234, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, 245, -1, -1, -1, -1, -1, - -1, -1, 874, -1, -1, 874, -1, -1, -1, -1, - 882, -1, -1, 882, -1, -1, -1, 268, 269, -1, - -1, -1, 273, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, 284, -1, 907, -1, 288, 907, -1, - -1, 913, 293, 294, 913, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, -1, 927, 310, - 311, 312, 313, 314, -1, -1, 317, -1, -1, -1, - 321, 322, 323, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, 343, -1, -1, -1, -1, 348, -1, -1, - -1, -1, -1, -1, -1, 356, 357, 358, 359, -1, - -1, -1, -1, -1, 365, 366, -1, 368, -1, 370, - 371, 372, 373, 374, 375, 376, -1, 378, -1, 380, - 381, 382, -1, -1, -1, -1, 3665, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - 401, 402, -1, -1, -1, -1, -1, -1, -1, 410, - 411, 412, 413, 414, 415, -1, 3695, -1, -1, -1, - -1, -1, -1, 424, -1, -1, -1, 428, 429, -1, - -1, 432, -1, 434, -1, 436, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, 452, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, 465, 466, 467, -1, -1, 470, - -1, -1, -1, 474, -1, 476, 477, 478, 479, -1, - -1, -1, -1, -1, -1, 486, -1, -1, -1, -1, - -1, 492, -1, -1, -1, -1, -1, -1, -1, -1, - -1, 502, -1, -1, -1, -1, -1, -1, -1, 510, - -1, -1, -1, 3792, 515, 516, 517, -1, 519, -1, - 521, 522, -1, 524, -1, 526, 527, -1, -1, 530, - 531, -1, 533, 534, 535, 536, -1, -1, -1, -1, - -1, -1, -1, -1, 545, 546, -1, -1, 549, -1, - -1, -1, -1, -1, -1, -1, 557, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, -1, -1, 570, - 571, -1, -1, -1, -1, -1, -1, 578, 579, -1, - 581, -1, -1, -1, 585, -1, -1, -1, -1, -1, - -1, 592, -1, -1, -1, -1, -1, 598, -1, -1, - -1, 602, -1, 604, 605, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, 618, -1, -1, - 621, 622, -1, -1, -1, -1, 627, -1, -1, -1, - -1, 632, -1, -1, -1, -1, 637, -1, -1, -1, - 641, -1, 643, 644, -1, -1, -1, -1, -1, -1, - -1, 652, 653, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, 3946, -1, -1, - -1, 672, 673, 674, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, 688, 689, -1, - -1, -1, 693, 694, 695, 696, 697, 698, -1, -1, - -1, 702, 703, -1, -1, -1, -1, -1, -1, 710, - 711, -1, -1, -1, -1, -1, -1, 718, 719, 720, - 721, -1, -1, -1, -1, 726, -1, -1, -1, -1, - 731, -1, -1, 734, 735, 736, 737, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, -1, 749, -1, - -1, -1, -1, 754, 755, -1, -1, -1, -1, -1, - -1, 762, 763, -1, 765, -1, -1, 768, -1, -1, - -1, 1, 773, -1, -1, 5, -1, -1, -1, -1, - 10, -1, -1, -1, -1, -1, -1, 17, -1, 790, - 791, -1, -1, 794, -1, -1, 26, -1, 799, -1, - -1, -1, -1, -1, -1, -1, 807, 808, 809, -1, - -1, -1, 813, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, 843, -1, -1, 846, -1, -1, -1, 850, - -1, -1, -1, -1, 855, -1, -1, 87, 88, -1, - -1, 862, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, 873, -1, -1, -1, 877, 878, 879, -1, - -1, -1, -1, -1, -1, -1, -1, 117, -1, 890, - -1, -1, -1, 894, 895, 896, 897, -1, 899, 900, - 901, 902, 903, -1, -1, -1, -1, 137, 909, 910, - -1, 141, -1, -1, -1, -1, -1, -1, -1, -1, - 921, -1, -1, 924, -1, -1, -1, -1, -1, 159, - -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, 186, -1, -1, 44, - -1, -1, -1, -1, 49, 50, 51, 52, -1, -1, - 200, 56, -1, -1, -1, -1, 206, -1, 208, -1, - -1, -1, 212, -1, -1, -1, 216, -1, -1, -1, - 75, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, 233, -1, -1, 236, -1, -1, -1, - 240, 241, 242, 243, 244, -1, 246, 247, 248, 249, - -1, 251, 252, -1, 254, 255, -1, 257, 258, 259, - 260, 261, 262, 263, 264, 265, 266, 267, 123, -1, - 270, -1, -1, -1, -1, -1, -1, -1, 278, -1, - -1, -1, -1, 283, -1, -1, 286, -1, -1, -1, - -1, 291, -1, -1, -1, -1, 296, -1, -1, -1, - -1, -1, -1, -1, -1, 160, -1, 162, -1, -1, - -1, -1, -1, 4362, 4363, -1, -1, -1, -1, 174, - -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, 197, 4392, 344, -1, -1, -1, -1, -1, - -1, -1, 352, -1, -1, 355, -1, -1, -1, -1, - 360, 4410, -1, -1, -1, -1, -1, -1, 1, -1, - -1, -1, 5, -1, -1, -1, -1, 10, -1, -1, - -1, -1, -1, -1, 17, -1, -1, 387, -1, -1, - -1, -1, -1, 26, -1, 395, -1, 397, -1, -1, - 400, -1, -1, 403, -1, -1, -1, -1, 408, -1, - -1, -1, -1, -1, -1, 4464, -1, -1, 418, -1, - -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, 87, 88, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, 337, 483, 117, -1, -1, -1, -1, 489, - -1, 491, 347, -1, 494, -1, -1, -1, -1, -1, - -1, -1, -1, -1, 137, -1, -1, -1, 141, 509, - -1, -1, -1, -1, -1, -1, -1, -1, 518, -1, - -1, -1, 377, -1, -1, -1, 159, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, 537, 538, 539, - -1, 541, 542, 543, 544, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, 561, -1, -1, -1, -1, -1, 200, -1, -1, - -1, -1, -1, 206, -1, 208, -1, -1, -1, 212, - 435, -1, -1, 216, 584, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - 233, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, 466, -1, -1, 469, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, 625, -1, -1, -1, -1, - -1, 631, -1, -1, -1, 635, -1, 270, 638, 639, - -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, 286, -1, 655, -1, -1, 513, -1, - -1, -1, -1, 296, -1, 520, -1, -1, -1, -1, - -1, 671, -1, -1, -1, -1, -1, 677, -1, -1, - -1, -1, -1, -1, 684, -1, -1, -1, -1, 1, - 690, -1, -1, 5, -1, -1, -1, -1, 10, -1, - -1, 556, -1, -1, -1, 17, -1, -1, -1, 709, - -1, 344, -1, -1, 26, -1, -1, 572, -1, 352, - -1, -1, 355, 723, -1, -1, -1, 360, -1, 729, - -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, 745, -1, 747, -1, -1, - -1, -1, -1, -1, 387, -1, -1, -1, -1, -1, - -1, 761, 395, -1, 397, 620, -1, 400, 623, -1, - 403, 771, 772, -1, -1, 87, 88, -1, -1, 779, - -1, -1, 782, -1, -1, 418, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, 797, -1, -1, - -1, -1, -1, -1, -1, 117, -1, -1, -1, -1, - -1, 666, -1, -1, -1, -1, -1, -1, -1, 819, - -1, -1, -1, -1, 679, 137, 681, 682, -1, 141, - 830, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, 845, 701, 159, -1, -1, - 483, 706, -1, -1, -1, -1, 489, 857, 491, 714, - -1, 494, -1, 863, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, 509, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, 887, 200, 744, - -1, -1, -1, -1, 206, -1, 208, -1, -1, -1, - 212, 756, -1, -1, 216, -1, 906, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, 917, -1, -1, - -1, 233, 922, -1, -1, -1, -1, -1, 561, -1, - -1, -1, -1, -1, 789, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, 584, -1, -1, -1, 810, -1, -1, 270, -1, - -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, 286, -1, -1, -1, -1, -1, - -1, -1, -1, -1, 296, -1, -1, -1, -1, -1, - -1, -1, 625, -1, -1, -1, -1, -1, 631, 854, - -1, -1, 635, -1, -1, 638, 639, -1, -1, -1, - -1, 866, -1, -1, -1, -1, -1, -1, 873, -1, - -1, -1, 655, -1, -1, -1, -1, -1, -1, -1, - -1, -1, 344, -1, -1, -1, -1, -1, 671, -1, - 352, -1, -1, 355, 677, -1, -1, -1, 360, -1, - -1, 684, -1, -1, -1, -1, 1, 690, -1, -1, - 5, -1, -1, -1, -1, 10, -1, -1, -1, -1, - -1, -1, 17, -1, -1, 387, 709, -1, -1, -1, - -1, 26, -1, 395, -1, 397, -1, -1, 400, -1, - 723, 403, -1, -1, -1, -1, 729, -1, -1, -1, - -1, -1, -1, -1, -1, -1, 418, -1, -1, -1, - -1, -1, -1, -1, 747, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, -1, 761, -1, - -1, -1, -1, -1, -1, -1, -1, -1, 771, 772, - -1, -1, 87, 88, -1, -1, 779, -1, -1, 782, - -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, 797, -1, -1, -1, -1, -1, - -1, 483, 117, -1, -1, -1, -1, 489, -1, 491, - -1, -1, 494, -1, -1, -1, 819, -1, -1, -1, - 1, -1, 137, -1, -1, 6, 141, 509, 9, -1, - -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, 845, -1, 159, -1, 27, -1, -1, -1, - -1, -1, -1, -1, 857, -1, -1, -1, 11, 40, - 863, -1, -1, 16, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, 28, 57, -1, -1, 561, - -1, -1, -1, -1, 887, 200, -1, -1, -1, -1, - -1, 206, -1, 208, -1, -1, -1, 212, -1, -1, - -1, 216, 584, -1, -1, -1, -1, -1, -1, 16, - -1, -1, -1, -1, 917, -1, -1, -1, 233, 922, - -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - 121, -1, -1, 625, -1, -1, -1, -1, -1, 631, - -1, -1, -1, 635, -1, 270, 638, 639, -1, -1, - -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, 286, -1, 655, -1, -1, -1, 84, -1, -1, - -1, 296, -1, -1, -1, -1, -1, -1, -1, 671, - -1, -1, -1, -1, -1, 677, -1, -1, 151, -1, - -1, -1, 684, -1, 157, 158, -1, -1, 690, -1, - -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - 173, -1, -1, -1, -1, -1, -1, 709, -1, 344, - -1, -1, -1, -1, -1, -1, -1, 352, -1, -1, - 355, 723, -1, -1, 151, 360, -1, 729, -1, -1, - 157, 158, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, 747, 173, -1, -1, -1, - -1, -1, 387, -1, -1, -1, -1, -1, -1, 761, - 395, -1, 397, -1, -1, 400, -1, -1, 403, 771, - 772, -1, -1, -1, -1, -1, -1, 779, -1, -1, - 782, -1, -1, 418, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, 797, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, 308, 309, -1, - -1, -1, -1, -1, -1, -1, -1, 819, -1, -1, - -1, -1, -1, -1, 297, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, 845, -1, -1, -1, -1, 483, -1, - -1, -1, -1, -1, 489, 857, 491, -1, -1, 494, - -1, 863, -1, -1, -1, -1, 339, 340, 341, -1, - -1, -1, -1, -1, 509, -1, -1, -1, 351, -1, - -1, -1, -1, -1, -1, 887, -1, -1, -1, -1, - -1, -1, 393, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, 379, -1, -1, -1, - -1, 338, 339, 340, 341, 917, -1, -1, -1, -1, - 922, -1, -1, -1, 351, -1, 561, -1, -1, -1, - -1, -1, -1, -1, -1, -1, 409, -1, -1, 5, - -1, -1, -1, -1, 10, -1, 447, -1, -1, 584, - -1, 17, 379, -1, -1, -1, -1, -1, -1, -1, - 26, -1, 463, -1, 437, 438, 439, -1, -1, -1, - -1, -1, -1, 446, -1, 448, -1, -1, -1, -1, - -1, -1, 455, -1, -1, -1, 459, 460, 461, -1, - 625, -1, -1, -1, -1, 468, 631, -1, 471, -1, - 635, -1, -1, 638, 639, -1, -1, -1, -1, -1, - 437, 438, 439, -1, 487, -1, -1, -1, -1, -1, - 655, 87, 88, -1, 525, -1, -1, -1, 455, -1, - -1, -1, 459, 460, 461, -1, 671, -1, -1, -1, - -1, 468, 677, -1, 471, -1, -1, -1, -1, 684, - -1, 117, -1, -1, -1, 690, -1, 530, -1, -1, - -1, -1, -1, -1, -1, 566, -1, -1, -1, -1, - -1, 137, -1, 574, 709, 141, -1, -1, 551, -1, - -1, -1, -1, -1, -1, -1, -1, -1, 723, -1, - -1, 564, -1, 159, 729, -1, -1, -1, -1, -1, - -1, -1, -1, -1, 577, -1, -1, -1, -1, -1, - -1, -1, 747, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, 551, -1, 761, -1, -1, -1, - -1, -1, -1, -1, 200, -1, 771, 772, -1, 640, - -1, -1, -1, -1, 779, -1, 212, 782, -1, -1, - 216, -1, -1, 654, -1, -1, 629, -1, -1, -1, - -1, -1, 797, -1, -1, -1, -1, -1, 669, -1, - 236, -1, -1, -1, -1, 241, 242, 243, 244, -1, - 246, 247, 248, 249, -1, 251, -1, 253, 254, 255, - -1, 257, 258, 259, 260, 261, 262, 263, 264, 265, - 266, 267, 629, -1, 270, -1, -1, 680, -1, -1, - 845, -1, -1, -1, -1, -1, -1, -1, -1, -1, - 286, -1, 857, -1, -1, -1, 727, 728, 863, -1, - 296, -1, 733, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, 747, -1, -1, -1, - -1, -1, 887, 680, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, 766, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, -1, 344, 752, - -1, -1, 917, -1, -1, -1, 352, 922, -1, 355, - -1, -1, -1, -1, 360, -1, -1, -1, -1, -1, - -1, -1, -1, -1, 777, 778, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, -1, 819, -1, - -1, 387, 823, -1, -1, 752, -1, -1, -1, 395, - -1, 397, -1, -1, 400, -1, -1, 403, 839, 840, - -1, -1, -1, 816, -1, 818, -1, -1, -1, -1, - 777, 778, -1, -1, 827, 828, 829, -1, 831, 832, - -1, -1, -1, -1, -1, 151, -1, -1, -1, -1, - -1, 157, 158, 800, -1, 848, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, 173, -1, -1, - -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, 874, 829, -1, -1, -1, -1, -1, -1, 882, - -1, -1, -1, -1, -1, -1, -1, 483, -1, -1, - -1, 848, -1, 489, -1, 491, -1, -1, 494, -1, - -1, -1, -1, -1, 907, -1, -1, 864, -1, -1, - 913, -1, -1, 509, -1, -1, -1, 874, -1, -1, - -1, -1, -1, -1, 927, 882, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, 893, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - 907, -1, -1, -1, -1, 912, 913, -1, -1, -1, - -1, -1, -1, -1, -1, 561, -1, -1, -1, -1, - 927, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, -1, 584, -1, - -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, 339, 340, 341, -1, -1, -1, -1, - -1, -1, -1, -1, -1, 351, -1, -1, -1, 635, - -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, -1, -1, 655, - -1, -1, -1, 379, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, 677, -1, -1, -1, -1, -1, -1, 684, -1, - -1, -1, -1, -1, 690, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, 709, -1, -1, -1, -1, -1, -1, - -1, -1, -1, 439, -1, -1, -1, -1, -1, -1, - -1, -1, -1, 729, -1, -1, -1, -1, -1, 455, - -1, -1, -1, 459, 460, 461, -1, -1, -1, -1, - -1, 747, 468, -1, -1, 471, -1, -1, -1, -1, - -1, -1, -1, -1, -1, 761, 8, -1, -1, -1, - -1, -1, -1, 15, -1, 771, 772, -1, -1, -1, - -1, -1, -1, 779, -1, -1, 782, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, 797, 44, 45, -1, -1, -1, 49, 50, 51, - 52, -1, -1, -1, 56, 57, 58, 59, 60, 61, - -1, 63, 64, 819, 66, 67, 68, 69, 70, 71, - 72, 73, 74, 75, -1, 551, -1, -1, -1, 81, - -1, -1, -1, -1, 86, -1, -1, -1, -1, 845, - -1, -1, 94, -1, -1, 97, 98, 99, 100, -1, - -1, 857, -1, -1, -1, -1, -1, 863, -1, -1, - -1, -1, 114, 115, -1, -1, -1, -1, -1, -1, - 122, 123, 124, -1, 126, 127, 128, 129, -1, 131, - -1, -1, -1, -1, -1, -1, -1, -1, 140, -1, - 142, 143, 144, 145, 146, 147, 148, 149, 150, -1, - -1, -1, -1, 629, -1, -1, -1, -1, -1, -1, - -1, 917, -1, 165, -1, -1, 922, -1, -1, 171, - -1, -1, 174, 175, 176, 177, 178, 179, 180, 181, - -1, -1, -1, -1, -1, 187, 188, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, 680, -1, -1, -1, -1, -1, - 212, 213, 214, -1, -1, 217, 218, -1, -1, -1, - 222, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, 234, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, 245, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, 269, -1, -1, - -1, 273, -1, -1, -1, -1, 752, -1, -1, 281, - -1, -1, -1, -1, -1, -1, 288, -1, -1, -1, - -1, 293, 294, -1, -1, -1, -1, -1, -1, -1, - -1, 777, 778, -1, -1, -1, -1, -1, 310, 311, - 312, 313, 314, -1, -1, 317, -1, -1, -1, -1, - -1, -1, 324, 325, 326, 327, 328, -1, -1, 331, - 332, -1, -1, -1, -1, 337, -1, -1, -1, -1, - -1, -1, -1, 345, -1, 347, -1, -1, -1, -1, - -1, -1, 354, 829, 356, 357, 358, 359, -1, -1, - -1, -1, 364, 365, 366, 367, 368, -1, 370, 371, - 372, -1, 848, 375, 376, 377, 378, -1, -1, -1, - 382, -1, -1, -1, -1, -1, -1, -1, -1, -1, - 392, -1, -1, -1, -1, -1, -1, -1, 874, 401, - 402, -1, -1, -1, -1, -1, 882, 409, 410, 411, - 412, 413, 414, 415, -1, -1, -1, 419, -1, -1, - -1, -1, 424, -1, -1, -1, 428, 429, -1, 431, - 432, 907, -1, 435, -1, -1, -1, 913, -1, -1, - -1, -1, -1, -1, -1, 447, -1, -1, -1, 451, - -1, 927, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, 469, 470, -1, - -1, -1, 474, -1, 476, 477, 478, 479, -1, -1, - -1, -1, -1, -1, 486, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, 498, -1, -1, -1, - 502, -1, -1, -1, -1, -1, -1, -1, 510, -1, - -1, 513, -1, -1, -1, -1, -1, -1, 520, -1, - -1, -1, -1, -1, -1, -1, -1, -1, 530, -1, - -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, 545, 546, -1, -1, -1, -1, -1, - -1, -1, 554, -1, 556, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - 572, 573, -1, -1, -1, -1, 578, -1, -1, 581, - -1, -1, -1, -1, -1, -1, -1, 589, -1, -1, - 592, -1, 594, -1, 596, 597, 598, -1, -1, -1, - 602, -1, 604, 605, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, 617, 618, -1, 620, 621, - 622, -1, -1, -1, -1, 627, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, -1, -1, 641, - -1, 643, 644, -1, -1, -1, -1, -1, -1, -1, - 652, 653, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, 666, -1, -1, -1, -1, -1, - 672, 673, 674, -1, -1, -1, -1, 679, -1, 681, - 682, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, 693, 694, 695, 696, -1, 698, -1, -1, -1, - 702, 703, -1, -1, -1, -1, -1, -1, 710, 711, - -1, -1, 714, -1, -1, -1, 718, 719, 720, -1, - -1, -1, -1, -1, 726, -1, -1, -1, -1, 731, - -1, -1, -1, -1, -1, -1, 738, -1, 740, 741, - 742, -1, 744, -1, -1, -1, -1, 749, -1, -1, - -1, -1, -1, -1, 756, -1, -1, -1, -1, -1, - 762, 763, -1, -1, -1, -1, 768, -1, -1, -1, - -1, 773, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, 789, 790, 791, - -1, -1, -1, -1, -1, -1, -1, 799, -1, -1, - -1, -1, -1, -1, -1, 807, -1, -1, -1, -1, - -1, 813, 814, -1, -1, -1, -1, 819, -1, -1, - -1, -1, -1, 825, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - 842, 843, -1, -1, -1, -1, -1, -1, 850, -1, - -1, -1, 854, 8, -1, -1, -1, 859, 860, 861, - 15, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, 875, -1, -1, -1, -1, -1, -1, - -1, 883, -1, -1, -1, -1, -1, 889, 890, -1, - 45, -1, -1, -1, 896, 897, -1, 899, -1, -1, - 902, -1, -1, -1, -1, -1, -1, 909, -1, -1, - -1, 66, 67, 68, 69, 70, 71, 72, 73, 921, - -1, -1, 924, -1, -1, -1, 81, -1, -1, -1, - -1, 86, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, 97, 98, 99, 100, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, -1, -1, 114, - -1, -1, -1, -1, -1, -1, -1, -1, -1, 124, - -1, -1, 127, 128, 129, -1, 131, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - 165, -1, -1, -1, -1, -1, -1, -1, -1, 174, - 175, 176, 177, 178, 179, 180, 181, -1, -1, -1, - -1, -1, 187, 188, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, -1, 213, 214, - -1, -1, 217, 218, -1, -1, -1, 222, -1, -1, - -1, -1, -1, -1, -1, -1, -1, -1, -1, 234, - -1, -1, -1, -1, -1, -1, 41, -1, -1, -1, - 245, -1, -1, -1, 49, 50, 51, 52, -1, -1, - -1, 56, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, 269, -1, -1, -1, 273, 74, - 75, -1, 77, -1, 79, -1, -1, -1, -1, -1, - -1, -1, -1, 288, -1, -1, -1, -1, 293, 294, - -1, -1, -1, -1, -1, -1, -1, 102, -1, -1, - -1, -1, -1, -1, -1, 310, 311, 312, 313, 314, - -1, -1, 317, -1, -1, -1, -1, 122, 123, -1, - -1, 126, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, 356, 357, 358, 359, -1, -1, 162, -1, -1, - 365, 366, -1, 368, -1, 370, 371, 372, -1, -1, - 375, 376, -1, 378, -1, -1, -1, 382, -1, -1, - -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, 401, 402, -1, -1, - -1, -1, -1, -1, -1, 410, 411, 412, 413, 414, - 415, -1, -1, -1, -1, -1, -1, -1, -1, 424, - -1, -1, -1, 428, 429, -1, -1, 432, -1, -1, - -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, 151, -1, -1, -1, -1, -1, - 157, 158, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, 470, 173, -1, -1, 474, - -1, 476, 477, 478, 479, -1, 281, -1, -1, -1, - -1, 486, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, 502, -1, -1, - -1, -1, -1, -1, -1, 510, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, 530, -1, -1, -1, -1, - -1, -1, 337, -1, -1, -1, -1, -1, -1, -1, - 545, 546, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, 367, -1, -1, -1, -1, -1, -1, -1, - -1, -1, 377, 578, -1, -1, 581, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, 592, -1, -1, - -1, -1, -1, 598, -1, -1, -1, 602, -1, 604, - 605, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, 618, -1, -1, 621, 622, -1, -1, - -1, -1, 627, -1, -1, -1, -1, -1, -1, 434, - -1, -1, 339, 340, 341, -1, 641, -1, 643, 644, - -1, -1, 447, -1, 351, -1, 451, 652, 653, -1, - -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, 469, -1, -1, 672, 673, 674, - -1, -1, 379, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, -1, 693, 694, - 695, 696, -1, 698, -1, -1, -1, 702, 703, -1, - -1, -1, -1, -1, -1, 710, 711, -1, 513, -1, - -1, -1, -1, 718, 719, 720, -1, -1, -1, -1, - -1, 726, -1, -1, -1, -1, 731, -1, -1, -1, - 437, 438, 439, -1, -1, -1, -1, -1, -1, 446, - -1, 448, -1, -1, 749, -1, -1, -1, 455, -1, - -1, -1, 459, 460, 461, -1, -1, 762, 763, -1, - -1, 468, -1, 768, 471, -1, -1, 572, 773, -1, - -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, 790, 791, -1, -1, 8, - 595, 596, 597, -1, 799, -1, 15, -1, -1, -1, - -1, -1, 807, -1, -1, -1, -1, -1, 813, -1, - -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, 45, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, -1, 843, -1, - -1, -1, -1, -1, 551, 850, -1, 66, 67, 68, - 69, 70, 71, 72, 73, -1, -1, -1, -1, -1, - -1, -1, 81, -1, -1, -1, -1, 86, -1, -1, - 577, -1, -1, -1, 679, -1, 681, 682, 97, 98, - 99, 100, 687, -1, -1, 890, -1, -1, -1, -1, - -1, 896, 897, -1, 899, 114, 701, 902, -1, -1, - -1, 706, -1, -1, 909, 124, -1, -1, 127, 128, - 129, -1, 131, -1, -1, -1, 921, -1, -1, 924, - -1, -1, 629, -1, -1, -1, -1, 732, -1, -1, - -1, -1, -1, -1, -1, -1, -1, -1, -1, 744, - -1, -1, -1, -1, -1, -1, 165, -1, -1, -1, - -1, 756, -1, -1, -1, 174, 175, 176, 177, 178, - 179, 180, 181, -1, -1, -1, -1, -1, 187, 188, - -1, -1, -1, 680, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, 213, 214, -1, -1, 217, 218, - -1, -1, -1, 222, -1, -1, -1, 812, -1, -1, - -1, -1, -1, -1, -1, 234, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, 245, -1, -1, 834, - -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, 752, -1, -1, -1, 854, - 269, -1, -1, -1, 273, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, -1, -1, 288, - 777, 778, -1, -1, 293, 294, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, 310, 311, 312, 313, 314, -1, -1, 317, -1, - -1, -1, -1, -1, -1, -1, -1, 912, -1, 816, - -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - 827, -1, 829, -1, 831, 832, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, 356, 357, 358, - 359, 848, -1, -1, -1, -1, 365, 366, -1, 368, - -1, 370, 371, 372, -1, -1, 375, 376, -1, 378, - -1, -1, -1, 382, -1, -1, -1, 874, -1, -1, - -1, -1, -1, -1, -1, 882, -1, -1, -1, -1, - -1, -1, 401, 402, -1, -1, -1, -1, -1, -1, - -1, 410, 411, 412, 413, 414, 415, -1, -1, -1, - 907, -1, -1, -1, -1, 424, 913, -1, -1, 428, - 429, -1, -1, 432, -1, -1, -1, -1, -1, -1, - 927, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, 470, -1, -1, -1, 474, -1, 476, 477, 478, - 479, -1, -1, -1, -1, -1, -1, 486, -1, -1, - -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - 11, -1, -1, 502, -1, 16, -1, -1, -1, -1, - -1, 510, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - 41, -1, -1, -1, -1, -1, -1, -1, 49, 50, - 51, 52, -1, -1, -1, 56, 545, 546, -1, -1, - -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, 74, 75, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, -1, -1, 578, - -1, -1, 581, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, 592, -1, -1, -1, -1, -1, 598, - -1, -1, -1, 602, -1, 604, 605, -1, -1, -1, - -1, 122, 123, -1, -1, 126, -1, -1, -1, 618, - -1, -1, 621, 622, -1, -1, -1, -1, 627, -1, - -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - 151, -1, 641, -1, 643, 644, 157, 158, -1, -1, - -1, 162, -1, 652, 653, -1, -1, -1, -1, -1, - -1, -1, 173, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, 672, 673, 674, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, 693, 694, 695, 696, -1, 698, - -1, -1, -1, 702, 703, -1, -1, -1, -1, -1, - -1, 710, 711, -1, -1, -1, -1, -1, -1, 718, - 719, 720, -1, -1, -1, -1, -1, 726, -1, -1, - -1, -1, 731, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - 749, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, 762, 763, -1, -1, -1, -1, 768, - 281, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, 790, 791, -1, 11, -1, -1, -1, -1, 16, - 799, -1, -1, 20, 21, 22, -1, -1, 807, -1, - -1, 28, -1, -1, 813, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, 337, -1, 339, 340, - 341, -1, -1, -1, -1, -1, -1, -1, -1, -1, - 351, -1, -1, -1, 843, -1, -1, -1, -1, -1, - -1, 850, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, 377, -1, 379, -1, - -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, 890, -1, -1, -1, -1, 113, 896, 897, -1, - 899, -1, -1, 902, -1, -1, -1, -1, -1, -1, - 909, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, 921, -1, -1, 924, 437, 438, 439, -1, - -1, -1, -1, -1, 151, 446, 447, 448, -1, -1, - 157, 158, -1, -1, 455, -1, -1, -1, 459, 460, - 461, -1, -1, -1, -1, -1, 173, 468, 469, -1, - 471, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, 487, 488, -1, -1, - -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, 514, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - 551, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, 11, -1, -1, -1, -1, 16, -1, -1, -1, - -1, 572, -1, 280, -1, -1, 577, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - 297, -1, -1, -1, -1, 596, 597, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, -1, 629, -1, - -1, -1, 339, 340, 341, -1, -1, -1, -1, -1, - -1, -1, -1, -1, 351, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, 362, 363, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, 379, -1, -1, -1, -1, -1, 679, 680, - 681, 682, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - 701, 151, 409, -1, -1, 706, -1, 157, 158, -1, - -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, 173, -1, -1, -1, -1, -1, -1, - 437, 438, 439, 440, 441, -1, -1, -1, -1, 446, - -1, 448, -1, 744, -1, -1, -1, -1, 455, -1, - -1, 752, 459, 460, 461, 756, -1, -1, -1, -1, - -1, 468, -1, -1, 471, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, 777, 778, -1, -1, - 487, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, -1, -1, 506, - 11, -1, -1, -1, -1, 16, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, 530, -1, -1, -1, -1, 829, -1, - -1, 281, -1, 540, -1, -1, -1, -1, -1, -1, - -1, -1, 549, -1, 551, -1, -1, 848, -1, -1, - -1, 558, -1, 854, -1, 11, -1, 564, -1, -1, - 16, -1, -1, -1, -1, -1, -1, 868, -1, -1, - 577, -1, 83, 874, -1, -1, -1, -1, -1, -1, - -1, 882, -1, 333, -1, -1, -1, -1, -1, 339, - 340, 341, 599, -1, -1, -1, -1, -1, -1, -1, - -1, 351, -1, -1, -1, -1, 907, -1, -1, -1, - -1, 912, 913, -1, -1, -1, -1, -1, -1, -1, - -1, -1, 629, -1, -1, -1, 927, -1, -1, 379, - -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - 151, 391, -1, -1, -1, 156, 157, 158, -1, -1, - -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, 173, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, 680, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, 437, 438, 439, - -1, -1, -1, -1, -1, 151, 446, -1, 448, -1, - -1, 157, 158, -1, -1, 455, -1, -1, -1, 459, - 460, 461, -1, -1, -1, -1, -1, 173, 468, -1, - -1, 471, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, 484, -1, -1, 487, -1, -1, - -1, -1, -1, -1, -1, 752, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, 11, -1, -1, -1, -1, 16, -1, - 777, 778, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, 551, -1, -1, -1, -1, -1, -1, 558, 816, - -1, 818, -1, 820, -1, -1, -1, 824, -1, 826, - 827, 828, 829, -1, 831, 832, 282, 577, 339, 340, - 341, -1, -1, -1, -1, -1, -1, -1, -1, -1, - 351, 848, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, 874, 379, -1, - -1, -1, -1, -1, -1, 882, -1, -1, -1, 629, - -1, -1, -1, 339, 340, 341, -1, -1, -1, -1, - -1, -1, -1, -1, -1, 351, -1, 353, -1, -1, - 907, -1, -1, 151, -1, -1, 913, -1, 11, 157, - 158, -1, -1, 16, -1, -1, -1, -1, -1, -1, - 927, -1, -1, 379, -1, 173, 437, 438, 439, -1, - 680, -1, -1, -1, -1, 446, -1, 448, -1, -1, - -1, -1, -1, -1, 455, -1, -1, -1, 459, 460, - 461, -1, -1, -1, -1, -1, -1, 468, -1, -1, - 471, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, 487, -1, -1, -1, - -1, 437, 438, 439, -1, -1, -1, -1, -1, -1, - 446, -1, 448, -1, -1, -1, -1, -1, -1, 455, - -1, -1, 752, 459, 460, 461, 756, -1, -1, -1, - -1, -1, 468, -1, -1, 471, -1, -1, -1, -1, - -1, -1, 270, -1, -1, -1, -1, 777, 778, -1, - 780, 487, 11, -1, -1, -1, -1, 16, -1, -1, - 551, -1, -1, -1, -1, -1, -1, 558, 151, -1, - -1, -1, -1, -1, 157, 158, -1, -1, -1, -1, - -1, -1, -1, -1, 167, -1, 577, -1, -1, -1, - 173, -1, -1, 529, -1, 825, -1, -1, -1, 829, - -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, 339, 340, 341, -1, 551, -1, -1, 848, -1, - -1, -1, -1, 351, -1, -1, -1, 11, -1, -1, - -1, -1, 16, -1, -1, -1, -1, -1, 629, -1, - -1, 577, -1, -1, 874, -1, -1, -1, -1, -1, - -1, 379, 882, -1, -1, -1, -1, -1, -1, 650, - -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, 907, -1, -1, - -1, 911, -1, 913, -1, -1, -1, -1, -1, 680, - -1, -1, 151, 629, -1, -1, -1, 927, 157, 158, - -1, -1, -1, -1, -1, -1, -1, -1, 167, 437, - 438, 439, -1, -1, 173, -1, -1, -1, 446, -1, - 448, -1, -1, -1, -1, -1, -1, 455, -1, -1, - -1, 459, 460, 461, -1, -1, -1, -1, -1, -1, - 468, -1, 678, 471, 680, -1, -1, -1, -1, -1, - -1, -1, -1, 744, -1, -1, 339, 340, 341, 487, - -1, 752, -1, -1, -1, -1, -1, 151, 351, -1, - -1, -1, -1, 157, 158, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, 777, 778, -1, 173, - -1, -1, -1, -1, -1, -1, 379, -1, -1, -1, - -1, -1, -1, 11, -1, -1, -1, -1, 16, -1, - -1, -1, -1, -1, -1, -1, 752, -1, -1, -1, - -1, -1, -1, 551, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, -1, 829, -1, - -1, 777, 778, -1, -1, -1, -1, -1, -1, 577, - -1, -1, -1, -1, 437, 438, 439, 848, -1, -1, - -1, -1, -1, 446, -1, 448, -1, 858, -1, -1, - -1, -1, 455, -1, -1, -1, 459, 460, 461, -1, - 339, 340, 341, 874, -1, 468, -1, -1, 471, -1, - -1, 882, 351, 829, -1, -1, -1, -1, 889, -1, - -1, 629, -1, -1, 487, -1, -1, -1, -1, -1, - -1, -1, 848, -1, -1, -1, 907, -1, -1, -1, - 379, -1, 913, -1, -1, -1, -1, 11, -1, -1, - -1, -1, 16, -1, -1, -1, 927, -1, 874, -1, - -1, -1, -1, 151, -1, -1, 882, -1, -1, 157, - 158, -1, 680, -1, -1, 339, 340, 341, -1, -1, - -1, -1, -1, -1, -1, 173, -1, 351, 551, -1, - -1, 907, -1, -1, -1, -1, 912, 913, 437, 438, - 439, -1, -1, -1, -1, -1, -1, 446, -1, 448, - -1, 927, -1, -1, 577, 379, 455, -1, -1, -1, - 459, 460, 461, -1, -1, -1, -1, -1, -1, 468, - -1, -1, 471, -1, -1, -1, 744, -1, -1, -1, - -1, -1, -1, -1, 752, -1, -1, -1, 487, -1, - -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, 629, -1, -1, 777, - 778, 11, -1, 437, 438, 439, 16, -1, -1, -1, - -1, -1, 446, -1, 448, -1, -1, 151, -1, -1, - -1, 455, -1, 157, 158, 459, 460, 461, -1, -1, - -1, -1, -1, -1, 468, -1, -1, 471, -1, 173, - -1, -1, 551, -1, 822, -1, -1, 680, -1, -1, - -1, 829, -1, 487, -1, 833, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, -1, 577, -1, - 848, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, 339, 340, 341, -1, -1, -1, -1, -1, -1, - -1, -1, -1, 351, -1, -1, 874, -1, -1, -1, - -1, -1, -1, -1, 882, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, 551, -1, 752, - 629, 379, -1, -1, -1, -1, -1, -1, -1, 907, - -1, -1, -1, -1, -1, 913, -1, -1, -1, -1, - -1, 151, -1, 577, 777, 778, -1, 157, 158, 927, - -1, -1, -1, -1, -1, -1, -1, -1, -1, 792, - -1, -1, -1, 173, -1, -1, -1, -1, -1, -1, - -1, 680, -1, -1, -1, -1, -1, -1, -1, 437, - 438, 439, -1, -1, -1, -1, -1, -1, 446, -1, - 448, -1, -1, -1, -1, 629, 829, 455, -1, -1, - -1, 459, 460, 461, -1, 339, 340, 341, -1, -1, - 468, 345, -1, 471, -1, 848, -1, 351, -1, -1, - -1, -1, -1, -1, -1, -1, -1, -1, -1, 487, - 11, -1, -1, -1, -1, 16, -1, -1, -1, -1, - -1, 874, -1, 752, -1, 379, 680, -1, -1, 882, - -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, -1, 777, 778, - -1, -1, -1, 11, 907, -1, -1, -1, 16, -1, - 913, -1, -1, 792, -1, -1, -1, -1, -1, -1, - -1, -1, -1, 551, 927, -1, -1, -1, -1, -1, - 558, -1, -1, 437, 438, 439, -1, -1, -1, -1, - -1, -1, 446, -1, 448, -1, -1, -1, 752, 577, - 829, 455, -1, -1, -1, 459, 460, 461, -1, 339, - 340, 341, -1, -1, 468, -1, -1, 471, -1, 848, - -1, 351, -1, 777, 778, -1, -1, -1, -1, -1, - -1, -1, -1, 487, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, 874, -1, -1, -1, 379, - 151, 629, -1, 882, -1, -1, 157, 158, -1, -1, - 814, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, 173, -1, -1, 829, -1, -1, 907, -1, - -1, -1, -1, -1, 913, -1, -1, -1, -1, -1, - -1, -1, -1, 151, 848, -1, -1, 551, 927, 157, - 158, -1, 680, -1, -1, -1, -1, 437, 438, 439, - -1, -1, -1, -1, -1, 173, 446, -1, 448, -1, - 874, -1, -1, 577, -1, 455, -1, -1, 882, 459, - 460, 461, -1, -1, -1, -1, -1, -1, 468, -1, - -1, 471, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, 907, -1, -1, -1, 487, -1, 913, - -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, 927, 752, 629, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, -1, -1, 777, - 778, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, 551, -1, -1, -1, -1, 680, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, -1, 339, 340, - 341, -1, -1, -1, -1, -1, -1, 577, -1, -1, - 351, 829, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - 848, -1, -1, -1, -1, -1, -1, -1, 379, -1, - -1, 339, 340, 341, -1, -1, -1, -1, -1, -1, - -1, -1, -1, 351, -1, -1, 874, -1, 752, 629, - -1, -1, -1, -1, 882, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, 379, -1, 777, 778, -1, -1, -1, -1, 907, - -1, -1, -1, -1, -1, 913, 437, 438, 439, -1, - -1, -1, -1, -1, -1, 446, -1, 448, -1, 927, - 680, -1, -1, -1, 455, -1, -1, -1, 459, 460, - 461, -1, -1, -1, -1, -1, -1, 468, -1, -1, - 471, -1, -1, -1, -1, 829, -1, -1, -1, 437, - 438, 439, -1, -1, -1, -1, 487, -1, 446, -1, - 448, -1, -1, -1, 848, -1, -1, 455, -1, -1, - -1, 459, 460, 461, -1, -1, -1, -1, -1, -1, - 468, -1, -1, 471, 744, -1, -1, -1, -1, -1, - 874, -1, 752, -1, -1, -1, -1, -1, 882, 487, - -1, -1, -1, -1, -1, 151, -1, -1, -1, -1, - -1, 157, 158, -1, -1, -1, -1, 777, 778, -1, - 551, -1, -1, 907, -1, -1, -1, 173, -1, 913, - -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, 927, -1, -1, 577, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, 551, -1, -1, -1, -1, -1, 829, - -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, -1, 848, 577, - -1, -1, -1, -1, -1, -1, -1, -1, 629, -1, - -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, 874, -1, -1, -1, -1, -1, - -1, -1, 882, -1, -1, -1, -1, 1, -1, -1, - -1, -1, -1, 7, -1, -1, -1, -1, -1, -1, - -1, 629, -1, -1, -1, -1, -1, 907, -1, 680, - -1, -1, -1, 913, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, 927, -1, -1, - 44, -1, -1, -1, -1, 49, 50, 51, 52, 53, - -1, -1, 56, 57, 58, 59, 60, 61, -1, 63, - 64, 65, 680, 339, 340, 341, -1, -1, -1, -1, - 74, 75, -1, -1, -1, 351, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - 94, 752, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, 379, -1, -1, 110, -1, -1, -1, - -1, 115, -1, -1, -1, -1, 777, 778, 122, 123, - -1, -1, 126, -1, -1, -1, -1, -1, -1, 133, - -1, -1, -1, -1, 752, -1, 140, -1, 142, 143, - 144, 145, 146, 147, 148, 149, 150, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, -1, -1, 777, - 778, 437, 438, 439, -1, -1, -1, 171, 829, -1, - 446, -1, 448, -1, -1, -1, -1, -1, -1, 455, - -1, -1, -1, 459, 460, 461, 190, 848, -1, -1, - -1, -1, 468, -1, -1, 471, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, -1, 212, -1, - -1, 829, -1, 874, -1, -1, -1, -1, -1, -1, - -1, 882, -1, -1, -1, -1, -1, -1, -1, -1, - 848, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, 907, -1, -1, -1, - -1, -1, 913, -1, -1, -1, 874, -1, -1, -1, - -1, -1, -1, -1, 882, -1, 927, -1, 272, -1, - -1, -1, -1, -1, -1, 551, -1, 281, -1, -1, - -1, -1, -1, -1, -1, -1, -1, -1, -1, 907, - -1, -1, -1, -1, -1, 913, -1, -1, -1, -1, - -1, 577, -1, -1, -1, -1, -1, -1, -1, 927, - -1, 315, -1, -1, -1, -1, -1, -1, -1, -1, - 324, 325, 326, 327, 328, -1, -1, 331, 332, -1, - -1, -1, -1, 337, -1, -1, -1, -1, 342, -1, - -1, 345, -1, 347, -1, -1, -1, -1, -1, -1, - 354, -1, -1, 629, -1, -1, -1, -1, -1, -1, - 364, -1, -1, 367, -1, -1, -1, -1, -1, -1, - -1, -1, -1, 377, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, -1, 392, -1, - -1, -1, -1, -1, -1, -1, -1, -1, 1, -1, - -1, 4, -1, -1, 680, 409, -1, -1, -1, -1, - -1, -1, -1, -1, -1, 419, -1, -1, -1, 423, - -1, -1, -1, -1, -1, -1, -1, 431, -1, -1, - -1, 435, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, 447, -1, -1, -1, 451, -1, -1, - 454, -1, -1, -1, 57, 58, 59, 60, 61, -1, - 63, 64, -1, -1, -1, 469, -1, -1, -1, -1, - -1, 74, -1, -1, -1, -1, 752, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, 498, -1, -1, -1, -1, -1, - -1, 777, 778, -1, -1, -1, -1, -1, -1, 513, - -1, -1, 788, -1, -1, -1, 520, -1, -1, 122, - -1, -1, 125, 126, -1, -1, -1, -1, -1, 132, - -1, -1, -1, -1, -1, -1, -1, 140, -1, 142, - 143, 144, 145, 146, 147, 148, 149, 150, 552, -1, - 554, 827, 556, 829, -1, 831, 832, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, -1, 572, 573, - -1, -1, 848, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, 589, -1, -1, -1, -1, - 594, -1, 596, 597, -1, -1, -1, -1, 874, -1, - -1, -1, -1, -1, -1, -1, 882, -1, -1, 212, - -1, -1, -1, 617, -1, -1, 620, -1, -1, -1, - -1, -1, 626, -1, -1, -1, 630, -1, -1, 1, - -1, 907, -1, -1, -1, -1, -1, 913, -1, -1, - -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, 927, -1, -1, -1, -1, -1, 29, -1, -1, - -1, -1, 666, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, 679, -1, 681, 682, -1, - -1, -1, 54, -1, -1, 57, 58, 59, 60, 61, - -1, 63, 64, -1, -1, -1, -1, -1, -1, -1, - -1, -1, 74, 707, -1, -1, -1, -1, -1, -1, - 714, -1, 315, -1, -1, -1, -1, -1, -1, -1, - -1, 324, 325, 326, 327, 328, -1, -1, 331, 332, - -1, -1, -1, -1, 738, -1, 740, 741, 742, -1, - 744, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, 756, -1, -1, -1, -1, -1, -1, -1, - -1, -1, 365, 767, 367, -1, -1, -1, 140, -1, - 142, 143, 144, 145, 146, 147, 148, 149, 150, -1, - -1, -1, -1, -1, -1, 789, -1, -1, -1, 392, - -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - 814, -1, -1, -1, -1, 819, 419, -1, -1, -1, - -1, 825, -1, -1, -1, -1, -1, -1, 431, -1, - -1, -1, -1, -1, -1, -1, -1, -1, 842, -1, - 212, -1, -1, 847, 447, -1, -1, -1, 451, -1, - 854, -1, -1, -1, -1, 859, 860, 861, -1, -1, - -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, 875, -1, -1, -1, -1, -1, -1, -1, 883, - -1, -1, -1, -1, -1, 889, -1, -1, -1, -1, - -1, -1, -1, -1, -1, 498, -1, -1, -1, -1, - -1, 905, -1, -1, -1, -1, -1, -1, 511, 913, - -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, -1, 300, 301, - -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, 315, -1, -1, -1, -1, -1, -1, - -1, 554, 324, 325, 326, 327, 328, -1, -1, 331, - 332, -1, -1, -1, -1, -1, -1, -1, -1, -1, - 573, -1, -1, -1, -1, -1, -1, -1, 3, -1, - -1, -1, 354, -1, -1, -1, 589, 12, -1, -1, - -1, 594, -1, -1, -1, 367, -1, 600, -1, -1, - -1, -1, 27, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, 385, 617, -1, -1, -1, -1, -1, - 392, 46, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, 409, -1, -1, - -1, -1, -1, -1, -1, -1, -1, 419, -1, -1, - -1, -1, 77, 78, 79, -1, -1, 82, -1, 431, - -1, -1, -1, -1, 89, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, 101, -1, 103, 104, - -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, 130, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, 498, -1, -1, -1, - -1, -1, -1, -1, -1, 738, -1, 740, 741, 742, - -1, -1, -1, -1, -1, -1, -1, 750, -1, -1, - -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - 185, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, 198, -1, -1, -1, -1, 781, -1, - -1, -1, 554, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, 220, 221, -1, 223, 224, - -1, 573, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, 819, 589, -1, -1, - -1, -1, 594, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, -1, -1, 842, - -1, -1, -1, 268, -1, 617, -1, 850, -1, -1, - -1, -1, -1, -1, -1, -1, 859, 860, 861, 284, - -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, 875, -1, -1, -1, 648, -1, -1, -1, - -1, -1, -1, -1, -1, -1, 889, -1, -1, -1, - 893, -1, -1, -1, -1, -1, 321, 322, 323, -1, - -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - 913, -1, -1, -1, -1, -1, -1, -1, 343, -1, - -1, -1, -1, 348, -1, -1, -1, -1, -1, 701, - -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, -1, 373, 374, - -1, -1, -1, -1, -1, 380, 381, -1, -1, -1, - -1, -1, -1, -1, -1, -1, 738, -1, 740, 741, - 742, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, 753, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, -1, -1, 434, - -1, 436, -1, 785, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, 452, -1, -1, - -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - 465, 466, 467, -1, -1, -1, -1, 819, -1, -1, - -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, 492, -1, -1, - 842, -1, -1, -1, -1, -1, -1, -1, -1, -1, - 4, -1, -1, -1, -1, -1, -1, 859, 860, 861, - 515, 516, 517, -1, 519, -1, 521, 522, -1, 524, - -1, 526, 527, 875, -1, -1, 531, -1, 533, 534, - 535, 536, -1, -1, -1, -1, -1, 889, -1, -1, - -1, -1, -1, -1, 549, -1, 898, -1, -1, -1, - -1, -1, 557, 57, 58, 59, 60, 61, -1, 63, - 64, 913, -1, -1, -1, 570, 571, -1, -1, -1, - 74, -1, -1, -1, 579, -1, -1, -1, -1, -1, - 585, -1, -1, 151, -1, -1, -1, -1, -1, 157, - 158, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, 173, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, -1, 122, -1, - -1, 125, 126, -1, -1, -1, -1, 632, 132, -1, - -1, -1, 637, -1, -1, -1, 140, -1, 142, 143, - 144, 145, 146, 147, 148, 149, 150, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, 41, -1, -1, 44, -1, -1, -1, -1, 49, - 50, 51, 52, -1, -1, 55, 56, -1, -1, -1, - -1, -1, -1, 688, 689, -1, -1, -1, -1, -1, - -1, -1, 697, -1, -1, 75, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, -1, 212, -1, - -1, -1, -1, -1, -1, -1, 721, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, -1, -1, 734, - 735, 736, 737, -1, -1, -1, -1, -1, -1, -1, - -1, -1, 122, 123, -1, -1, 126, -1, -1, 754, - 755, -1, -1, -1, -1, -1, -1, -1, -1, -1, - 765, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, 339, 340, 341, -1, -1, -1, -1, -1, -1, - 160, -1, 162, 351, -1, -1, -1, -1, -1, 794, - -1, -1, -1, -1, 174, -1, -1, -1, -1, -1, - -1, -1, -1, 808, 809, -1, -1, -1, -1, -1, - -1, 379, -1, -1, -1, -1, -1, 197, -1, -1, - 324, 325, 326, 327, 328, -1, -1, 331, 332, -1, - -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, 846, -1, -1, -1, -1, -1, -1, -1, -1, - 855, -1, -1, -1, -1, -1, -1, 862, -1, -1, - -1, 365, -1, 367, -1, -1, -1, -1, 873, 437, - 438, 439, 877, 878, 879, -1, -1, -1, 446, -1, - 448, -1, -1, -1, -1, -1, -1, 455, 392, 894, - 895, 459, 460, 461, -1, 900, 901, -1, 903, -1, - 468, 29, -1, 471, -1, 910, -1, -1, -1, -1, - -1, -1, -1, -1, -1, 419, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, 54, -1, -1, 57, - 58, 59, 60, 61, -1, 63, 64, -1, -1, -1, - -1, -1, -1, 447, -1, -1, 74, 451, -1, -1, - -1, -1, -1, -1, -1, -1, -1, 337, -1, -1, - -1, -1, -1, -1, -1, -1, 346, 347, -1, -1, - -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, 551, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, 498, -1, -1, 377, -1, -1, - -1, -1, -1, -1, -1, -1, -1, 511, -1, 577, - -1, -1, 140, -1, 142, 143, 144, 145, 146, 147, - 148, 149, 150, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, 421, -1, -1, -1, -1, -1, -1, -1, -1, - 554, -1, -1, -1, -1, 435, -1, -1, -1, -1, - -1, 629, -1, -1, -1, -1, -1, 447, -1, 573, - -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, 212, 589, 466, -1, -1, 469, - 594, -1, -1, -1, -1, -1, 600, -1, -1, -1, - -1, -1, 670, -1, -1, -1, -1, -1, 488, -1, - -1, -1, 680, 617, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, 513, -1, -1, -1, 29, -1, -1, - 520, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, 54, -1, -1, 57, 58, 59, 60, 61, - -1, 63, 64, -1, -1, -1, 556, -1, -1, -1, - -1, -1, 74, -1, 752, -1, -1, -1, -1, -1, - -1, -1, 572, -1, -1, -1, 324, 325, 326, 327, - 328, -1, -1, 331, 332, -1, -1, -1, -1, 777, - 778, -1, -1, -1, -1, -1, 596, 597, -1, -1, - -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, 738, -1, 740, 741, 742, 367, - 620, -1, -1, 623, -1, -1, 750, -1, 140, -1, - 142, 143, 144, 145, 146, 147, 148, 149, 150, -1, - -1, 829, -1, -1, 392, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, 781, -1, -1, - 848, 409, -1, -1, -1, -1, 666, -1, -1, -1, - -1, 419, -1, -1, -1, -1, -1, -1, -1, 679, - 868, 681, 682, 431, -1, -1, 874, -1, -1, -1, - -1, -1, -1, -1, 882, 819, -1, -1, -1, -1, - 212, 701, -1, -1, -1, -1, 706, -1, -1, -1, - -1, -1, -1, -1, 714, -1, -1, -1, -1, 907, - -1, -1, -1, -1, -1, 913, 850, -1, -1, -1, - -1, -1, -1, -1, -1, 859, 860, 861, -1, 927, - -1, -1, -1, -1, 744, -1, -1, -1, -1, -1, - 498, 875, -1, -1, -1, -1, 756, -1, -1, -1, - -1, -1, -1, -1, -1, 889, -1, -1, -1, 893, - -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, -1, -1, 789, - -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, 554, -1, -1, 809, - 810, -1, 324, 325, 326, 327, 328, -1, -1, 331, - 332, -1, -1, -1, -1, 573, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, 589, -1, -1, -1, -1, 594, -1, -1, -1, - -1, -1, -1, -1, 854, 367, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, 866, -1, -1, 617, - -1, -1, -1, 873, -1, -1, -1, -1, -1, -1, - 392, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, 409, -1, -1, - 648, -1, -1, -1, -1, -1, -1, 419, -1, -1, - -1, -1, 912, -1, -1, -1, -1, -1, -1, 431, - -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - 44, -1, -1, -1, -1, 49, 50, 51, 52, -1, - -1, -1, 56, 57, 58, 59, 60, 61, -1, 63, - 64, -1, -1, 701, -1, -1, -1, 151, -1, -1, - 74, 75, -1, 157, 158, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, -1, -1, 173, - 94, -1, -1, -1, -1, -1, 498, -1, -1, -1, - 738, -1, 740, 741, 742, -1, -1, -1, -1, -1, - -1, 115, -1, -1, -1, -1, -1, -1, 122, 123, - -1, -1, 126, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, 140, -1, 142, 143, - 144, 145, 146, 147, 148, 149, 150, 785, -1, -1, - -1, -1, 554, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, 171, -1, -1, - -1, 573, -1, -1, -1, -1, -1, -1, -1, -1, - -1, 819, -1, -1, -1, -1, -1, 589, -1, -1, - -1, -1, 594, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, 842, -1, -1, -1, 212, -1, - -1, -1, -1, -1, -1, 617, -1, -1, -1, -1, - -1, 859, 860, 861, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, 875, -1, -1, - -1, -1, -1, -1, -1, -1, 648, -1, -1, -1, - -1, 889, -1, -1, -1, 339, 340, 341, -1, -1, - 898, -1, -1, -1, -1, -1, -1, 351, -1, -1, - -1, -1, -1, -1, -1, -1, -1, 281, -1, -1, - -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, 151, -1, -1, -1, 379, -1, 157, 158, 701, - -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, 173, -1, -1, -1, -1, -1, -1, - 324, 325, 326, 327, 328, -1, -1, 331, 332, -1, - -1, -1, -1, 337, -1, -1, 738, -1, 740, 741, - 742, 345, -1, 347, -1, -1, -1, -1, -1, -1, - 354, -1, -1, 437, 438, 439, -1, -1, -1, -1, - 364, -1, 446, 367, 448, -1, -1, -1, -1, -1, - -1, 455, -1, 377, -1, 459, 460, 461, -1, -1, - -1, -1, -1, 785, 468, -1, -1, 471, 392, -1, - -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, 409, -1, -1, -1, -1, - -1, -1, -1, -1, -1, 419, -1, 819, -1, -1, - -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, 435, -1, -1, -1, -1, -1, -1, -1, -1, - 842, -1, -1, 447, -1, -1, -1, 451, -1, -1, - -1, -1, -1, -1, -1, -1, -1, 859, 860, 861, - -1, -1, -1, -1, -1, 469, -1, 551, -1, -1, - -1, -1, -1, 875, -1, -1, -1, -1, -1, 339, - 340, 341, -1, -1, -1, -1, -1, 889, -1, -1, - -1, 351, -1, 577, 498, -1, 898, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, -1, -1, 513, - -1, -1, -1, -1, -1, -1, 520, -1, -1, 379, - -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, 151, -1, -1, -1, -1, -1, 157, 158, -1, - -1, -1, -1, -1, -1, 629, -1, -1, -1, -1, - 554, -1, 556, 173, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, -1, 572, 573, - -1, -1, -1, -1, -1, -1, -1, 437, 438, 439, - -1, -1, -1, -1, -1, 589, 446, -1, 448, -1, - 594, -1, 596, 597, -1, 455, 680, -1, -1, 459, - 460, 461, -1, -1, -1, -1, -1, -1, 468, -1, - -1, 471, -1, 617, -1, -1, 620, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, 666, -1, -1, -1, -1, -1, 752, -1, - -1, -1, -1, 151, -1, 679, -1, 681, 682, 157, - 158, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, 551, -1, 777, 778, 173, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, -1, 151, -1, - 714, -1, -1, -1, 157, 158, -1, 577, -1, 339, - 340, 341, -1, -1, -1, -1, -1, -1, -1, -1, - 173, 351, 816, -1, 738, -1, 740, 741, 742, -1, - 744, -1, -1, 827, -1, 829, -1, 831, 832, -1, - -1, -1, 756, -1, -1, -1, -1, -1, -1, 379, - -1, -1, -1, -1, 848, -1, -1, -1, -1, 629, - -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, 789, -1, -1, -1, -1, - 874, -1, -1, -1, -1, -1, -1, -1, 882, -1, - -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - 814, -1, -1, -1, -1, 819, -1, 437, 438, 439, - 680, 825, -1, 907, -1, -1, 446, -1, 448, 913, - -1, -1, -1, -1, -1, 455, -1, -1, -1, 459, - 460, 461, -1, 927, -1, -1, -1, -1, 468, -1, - 854, 471, 151, -1, -1, 859, 860, 861, 157, 158, - -1, 339, 340, 341, -1, -1, -1, -1, -1, -1, - -1, 875, -1, 351, 173, -1, -1, -1, -1, 883, - -1, -1, -1, -1, -1, 889, -1, -1, -1, -1, - -1, -1, 752, -1, -1, -1, 339, 340, 341, -1, - -1, 379, -1, -1, -1, -1, -1, -1, 351, -1, - -1, -1, -1, -1, -1, -1, -1, 777, 778, -1, - -1, -1, -1, -1, -1, -1, -1, -1, 788, -1, - -1, 551, -1, -1, -1, -1, 379, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, 577, -1, 437, - 438, 439, -1, -1, -1, -1, -1, 827, 446, 829, - 448, 831, 832, -1, -1, -1, -1, 455, -1, -1, - -1, 459, 460, 461, -1, -1, -1, -1, 848, -1, - 468, -1, -1, 471, 437, 438, 439, -1, -1, -1, - -1, -1, -1, 446, -1, 448, -1, -1, -1, 629, - -1, -1, 455, -1, 874, -1, 459, 460, 461, -1, - -1, -1, 882, -1, -1, 468, -1, -1, 471, -1, - -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - 339, 340, 341, -1, -1, -1, -1, 907, -1, -1, - -1, -1, 351, 913, -1, -1, -1, -1, -1, -1, - 680, -1, -1, -1, -1, -1, -1, 927, -1, -1, - -1, -1, -1, 551, -1, -1, -1, -1, -1, -1, - 379, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, -1, -1, 577, - -1, -1, -1, -1, -1, -1, -1, -1, 551, -1, - -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, 752, -1, 577, -1, -1, -1, 437, 438, - 439, -1, -1, -1, -1, -1, -1, 446, -1, 448, - -1, 629, -1, -1, -1, -1, 455, 777, 778, -1, - 459, 460, 461, -1, -1, -1, -1, -1, -1, 468, - -1, -1, 471, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, 629, -1, -1, -1, - -1, -1, -1, -1, -1, -1, 816, -1, -1, -1, - -1, -1, 680, -1, -1, -1, -1, 827, -1, 829, - -1, 831, 832, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, -1, 848, -1, - -1, -1, -1, -1, -1, -1, -1, 680, -1, -1, - -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, 551, -1, 874, -1, -1, -1, -1, -1, - -1, -1, 882, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, 752, -1, -1, -1, 577, -1, - -1, -1, -1, -1, -1, -1, -1, 907, -1, -1, - -1, -1, -1, 913, -1, -1, -1, -1, -1, 777, - 778, -1, -1, -1, -1, -1, -1, 927, -1, 752, - -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - 629, -1, -1, -1, 777, 778, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, -1, -1, 827, - -1, 829, -1, 831, 832, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - 848, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, 680, -1, -1, -1, -1, 829, -1, 831, -1, - -1, -1, -1, -1, -1, -1, 874, -1, -1, -1, - -1, -1, -1, -1, 882, 848, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, -1, -1, 907, - -1, 874, -1, -1, -1, 913, -1, -1, -1, 882, - -1, -1, -1, -1, -1, -1, -1, -1, -1, 927, - -1, -1, -1, 752, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, 907, -1, -1, -1, -1, -1, - 913, -1, -1, -1, -1, -1, -1, -1, 777, 778, - -1, -1, -1, -1, 927, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - 829, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, -1, -1, 848, - -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, 874, -1, -1, -1, -1, - -1, -1, -1, 882, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, -1, 907, -1, - -1, -1, -1, -1, 913, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, -1, 927 -}; - - /* YYSTOS[STATE-NUM] -- The (internal number of the) accessing - symbol of state STATE-NUM. */ -static const yytype_uint16 yystos[] = -{ - 0, 930, 931, 0, 932, 933, 934, 937, 938, 384, - 386, 935, 936, 939, 940, 950, 951, 952, 563, 947, - 967, 936, 350, 615, 953, 956, 219, 819, 274, 976, - 977, 957, 954, 947, 947, 819, 36, 968, 969, 219, - 948, 153, 978, 979, 819, 819, 256, 941, 942, 943, - 250, 945, 409, 2163, 197, 971, 819, 186, 1139, 1141, - 1142, 713, 399, 1059, 1060, 19, 111, 169, 172, 174, - 195, 289, 458, 549, 553, 665, 705, 751, 753, 784, - 834, 913, 980, 981, 982, 983, 987, 1001, 1007, 1008, - 1009, 1010, 1011, 1017, 1033, 1035, 1040, 1043, 1048, 1049, - 1051, 1052, 1053, 1054, 1055, 1056, 1057, 455, 616, 958, - 958, 944, 943, 946, 501, 756, 759, 760, 970, 691, - 271, 972, 219, 949, 823, 1143, 819, 713, 306, 1061, - 1, 913, 2041, 2041, 766, 738, 2191, 2163, 2163, 2163, - 2041, 738, 819, 819, 2163, 819, 819, 109, 154, 2145, - 1058, 1012, 982, 1, 819, 1010, 390, 1034, 37, 960, - 960, 455, 616, 959, 959, 488, 2175, 2163, 404, 974, - 819, 610, 1411, 1412, 1416, 713, 1144, 819, 819, 1062, - 1018, 336, 1046, 2154, 2163, 2163, 913, 2034, 2087, 134, - 2034, 2163, 2163, 988, 1002, 2034, 984, 913, 1041, 1042, - 1205, 913, 1036, 1037, 1038, 2042, 2163, 455, 556, 559, - 1013, 1015, 1016, 1800, 2093, 2163, 913, 455, 965, 966, - 2163, 955, 819, 819, 2163, 118, 769, 821, 973, 692, - 819, 219, 1441, 1442, 819, 303, 708, 1140, 1145, 1146, - 1148, 417, 717, 1063, 1122, 1123, 1019, 1022, 1023, 2154, - 2163, 23, 498, 2034, 455, 390, 555, 2215, 455, 842, - 108, 480, 614, 716, 913, 989, 990, 991, 992, 993, - 997, 998, 1000, 2144, 2186, 349, 614, 1003, 1004, 1005, - 985, 1000, 1042, 2163, 1037, 31, 409, 2042, 2165, 2041, - 1800, 409, 766, 2182, 2163, 169, 2041, 819, 624, 961, - 966, 2163, 48, 503, 504, 505, 619, 835, 836, 849, - 2126, 2163, 1413, 1, 5, 10, 17, 26, 87, 88, - 117, 137, 141, 159, 200, 206, 208, 212, 216, 233, - 270, 286, 296, 344, 352, 355, 360, 387, 395, 397, - 400, 403, 418, 483, 489, 491, 494, 509, 561, 584, - 625, 631, 635, 638, 639, 655, 671, 677, 684, 690, - 709, 723, 729, 747, 761, 771, 772, 779, 782, 797, - 819, 845, 857, 863, 887, 917, 922, 1443, 1444, 1472, - 1477, 1482, 1487, 1513, 1517, 1525, 1529, 1530, 1534, 1537, - 1542, 1547, 1598, 1602, 1604, 1609, 1625, 1629, 1632, 1635, - 1639, 1640, 1647, 1657, 1660, 1663, 1681, 1690, 1694, 1696, - 1700, 1703, 1707, 1721, 1735, 1737, 1741, 1756, 1757, 1767, - 1770, 1771, 1775, 1781, 1782, 1790, 1797, 1814, 1824, 1833, - 1836, 1842, 1853, 1857, 1859, 1862, 1865, 1868, 1879, 1898, - 1906, 1931, 1443, 915, 1195, 1197, 1198, 1, 913, 2022, - 819, 530, 562, 2123, 30, 493, 668, 701, 1124, 1125, - 1126, 1127, 1129, 1130, 1131, 1136, 1020, 1021, 23, 498, - 379, 455, 471, 629, 752, 829, 927, 1044, 1045, 2097, - 912, 1050, 2206, 2087, 725, 744, 2194, 2163, 819, 991, - 819, 913, 990, 112, 121, 994, 2146, 16, 351, 913, - 1006, 913, 1, 819, 1005, 986, 2206, 16, 379, 455, - 471, 629, 752, 829, 927, 2098, 2099, 2100, 455, 1039, - 2094, 2182, 409, 2041, 2041, 1014, 1015, 819, 138, 300, - 647, 675, 825, 962, 963, 964, 503, 504, 619, 849, - 975, 85, 487, 575, 764, 769, 821, 1494, 1495, 5, - 10, 17, 26, 87, 88, 117, 137, 141, 159, 200, - 212, 216, 236, 241, 242, 243, 244, 246, 247, 248, - 249, 251, 253, 254, 255, 257, 258, 259, 260, 261, - 262, 263, 264, 265, 266, 267, 270, 286, 296, 344, - 352, 355, 360, 387, 395, 397, 400, 403, 483, 489, - 491, 494, 509, 561, 584, 635, 655, 677, 684, 690, - 709, 729, 747, 761, 771, 772, 779, 782, 797, 819, - 845, 857, 863, 917, 922, 2130, 2131, 2132, 1445, 1473, - 1478, 1483, 1488, 1514, 1518, 844, 1834, 1835, 1526, 1531, - 1538, 1535, 1543, 1548, 1599, 1603, 336, 1605, 1610, 1626, - 1630, 1633, 1636, 353, 678, 1505, 1628, 1641, 1648, 1658, - 1661, 1664, 352, 582, 1695, 1697, 1701, 1704, 724, 1708, - 1722, 1736, 1738, 1742, 1758, 1768, 1772, 1776, 1834, 1783, - 1791, 1798, 1815, 1825, 1835, 455, 629, 699, 752, 804, - 927, 1840, 1841, 1990, 2081, 2082, 2087, 1843, 1854, 608, - 1858, 1860, 1430, 1863, 1866, 1869, 1880, 1899, 352, 582, - 713, 139, 1176, 232, 730, 743, 1199, 1200, 1202, 1213, - 1215, 1217, 2115, 819, 1147, 562, 2041, 137, 166, 183, - 184, 299, 464, 475, 603, 642, 659, 918, 919, 1132, - 559, 1137, 2180, 640, 747, 748, 1128, 1, 819, 1126, - 2163, 2163, 390, 1045, 1047, 806, 590, 2163, 2093, 819, - 2163, 727, 406, 960, 1, 351, 406, 960, 819, 819, - 194, 2100, 815, 2094, 2041, 964, 2186, 138, 912, 1491, - 558, 913, 1446, 1449, 1450, 1451, 2023, 2081, 11, 151, - 157, 158, 167, 173, 339, 340, 341, 351, 437, 438, - 439, 446, 448, 459, 460, 461, 468, 487, 551, 577, - 680, 777, 778, 792, 848, 874, 882, 907, 1474, 2014, - 2046, 2047, 2049, 2050, 2081, 2098, 2102, 2103, 2104, 2105, - 2223, 827, 831, 832, 1479, 2009, 2010, 2011, 2012, 2013, - 2014, 2050, 2053, 2081, 2099, 2102, 455, 1484, 1485, 2030, - 2031, 2032, 2087, 1489, 1494, 455, 616, 1515, 1516, 2066, - 2081, 911, 1519, 1520, 1522, 2022, 11, 1527, 2014, 2015, - 2016, 2044, 2084, 2085, 2087, 2099, 14, 1532, 823, 1539, - 2022, 16, 1536, 2081, 2083, 398, 416, 569, 796, 1544, - 1546, 281, 333, 391, 455, 484, 558, 756, 780, 825, - 911, 1549, 1550, 1551, 1552, 1554, 1561, 1563, 1564, 1565, - 1568, 1573, 1576, 1577, 1580, 1582, 2046, 2066, 2081, 1600, - 2047, 1544, 355, 1494, 1607, 822, 833, 1611, 1612, 1613, - 1994, 1995, 1996, 349, 580, 584, 614, 713, 1627, 1631, - 2043, 2044, 1634, 2087, 814, 1637, 2202, 2047, 1, 1993, - 1994, 1649, 2043, 913, 1659, 2024, 160, 911, 1352, 1585, - 1662, 2081, 1665, 1666, 2081, 2098, 2102, 1682, 1691, 1816, - 2075, 2076, 2087, 1352, 1585, 1698, 167, 1702, 2047, 1705, - 2047, 295, 1709, 1710, 1711, 390, 1723, 1988, 2156, 913, - 2023, 291, 1739, 2081, 1743, 2022, 1759, 2023, 1769, 2017, - 2087, 1773, 2022, 823, 1777, 2017, 2018, 16, 1784, 2019, - 2087, 1792, 2023, 274, 427, 487, 1799, 1802, 1803, 1806, - 1807, 1808, 1809, 1810, 1811, 1812, 1813, 1990, 2025, 2026, - 2043, 2074, 2076, 2087, 1816, 1826, 2022, 1837, 2081, 831, - 2091, 2092, 1844, 1845, 1846, 167, 792, 1855, 2046, 1861, - 2024, 819, 913, 1431, 1432, 1435, 1436, 1441, 1864, 2077, - 2081, 1867, 2022, 455, 1870, 2067, 2081, 2102, 1881, 2081, - 1900, 2018, 1907, 1932, 819, 713, 462, 1278, 1205, 1205, - 1205, 1200, 819, 1, 315, 1203, 1204, 1205, 442, 1149, - 1064, 2180, 2202, 2202, 555, 2179, 2180, 2180, 2202, 2180, - 2180, 2202, 2180, 2180, 823, 2153, 290, 2152, 455, 1076, - 2087, 32, 2136, 819, 39, 228, 379, 455, 458, 471, - 501, 629, 752, 757, 758, 927, 1024, 1026, 1027, 1028, - 1031, 852, 884, 885, 1025, 1026, 913, 1089, 2097, 455, - 2093, 458, 786, 881, 999, 2037, 2088, 2089, 995, 488, - 2100, 1492, 107, 883, 1417, 241, 1471, 1447, 41, 55, - 346, 488, 1455, 1456, 1457, 1461, 1464, 2139, 2140, 2206, - 831, 1452, 484, 2174, 345, 2179, 2081, 831, 831, 831, - 2107, 831, 2215, 2215, 831, 831, 831, 831, 2215, 2075, - 831, 2107, 242, 1476, 814, 1475, 2047, 2082, 2099, 2102, - 831, 2106, 831, 831, 2013, 2081, 2009, 2013, 109, 827, - 832, 818, 828, 297, 2082, 2099, 2102, 396, 2118, 1485, - 814, 2215, 243, 1512, 1988, 1516, 1523, 2022, 649, 856, - 1521, 2206, 2221, 2179, 244, 1528, 280, 820, 2016, 2212, - 691, 2124, 2091, 2092, 1533, 1540, 2022, 246, 1541, 640, - 2188, 161, 2148, 2081, 796, 2199, 796, 2023, 1562, 361, - 1583, 78, 2142, 247, 1597, 291, 541, 1946, 1948, 1950, - 1552, 2045, 2046, 1553, 912, 1555, 1452, 1574, 1583, 869, - 870, 871, 872, 248, 1601, 83, 405, 814, 455, 249, - 1624, 25, 906, 1614, 1615, 1616, 1618, 28, 297, 409, - 530, 564, 816, 818, 827, 828, 831, 832, 1997, 1998, - 2000, 2047, 2163, 182, 1628, 2044, 270, 2029, 803, 1643, - 1650, 2206, 2024, 2081, 8, 15, 45, 66, 67, 68, - 69, 70, 71, 72, 73, 81, 86, 97, 98, 99, - 100, 114, 124, 127, 128, 129, 131, 165, 174, 175, - 176, 177, 178, 179, 180, 181, 187, 188, 213, 214, - 217, 218, 222, 234, 245, 269, 273, 288, 293, 294, - 310, 311, 312, 313, 314, 317, 356, 357, 358, 359, - 365, 366, 368, 370, 371, 372, 375, 376, 378, 382, - 401, 402, 410, 411, 412, 413, 414, 415, 424, 428, - 429, 432, 470, 474, 476, 477, 478, 479, 486, 502, - 510, 545, 546, 578, 581, 592, 598, 602, 604, 605, - 618, 621, 622, 627, 641, 643, 644, 652, 653, 672, - 673, 674, 693, 694, 695, 696, 698, 702, 703, 710, - 711, 718, 719, 720, 726, 731, 749, 762, 763, 768, - 790, 791, 799, 807, 813, 843, 850, 890, 896, 897, - 899, 902, 909, 921, 924, 1357, 1359, 1361, 1363, 1365, - 1367, 1369, 1371, 1374, 1376, 1378, 1379, 1381, 1383, 1384, - 1386, 1388, 1391, 1392, 430, 744, 812, 1393, 1394, 163, - 661, 793, 1667, 1668, 1670, 1671, 1683, 2081, 1692, 2081, - 1818, 831, 2091, 530, 773, 1354, 1355, 1356, 1357, 2122, - 1393, 253, 1699, 2047, 814, 254, 1706, 83, 1710, 298, - 398, 416, 569, 1712, 84, 338, 455, 1207, 1728, 1729, - 1730, 2030, 2050, 2068, 2081, 2087, 2098, 2102, 2206, 804, - 913, 1740, 257, 1755, 509, 601, 2121, 258, 1766, 484, - 715, 1760, 345, 1901, 259, 1774, 2188, 913, 260, 1780, - 1901, 2019, 261, 1789, 893, 1785, 345, 1793, 1794, 2060, - 2064, 2081, 2099, 2102, 291, 1809, 1811, 2043, 609, 814, - 2026, 225, 814, 865, 1801, 42, 2091, 262, 1832, 318, - 421, 427, 1828, 1505, 1838, 2047, 2206, 2007, 2009, 831, - 2092, 263, 1852, 405, 1847, 1848, 2047, 2081, 2075, 264, - 1856, 345, 2024, 713, 819, 819, 345, 640, 646, 2189, - 265, 1878, 201, 1871, 2081, 266, 1905, 1901, 1908, 2081, - 1933, 2081, 1196, 819, 713, 453, 1280, 1216, 1218, 658, - 819, 819, 1201, 154, 76, 120, 186, 423, 445, 640, - 645, 662, 664, 819, 889, 1150, 1151, 1153, 1157, 1158, - 1161, 1162, 1168, 1171, 1173, 1174, 2163, 1, 1065, 1066, - 2033, 2034, 2034, 2093, 2093, 2020, 2022, 2020, 2093, 2020, - 2020, 2034, 2020, 2020, 795, 2198, 240, 1138, 2093, 2154, - 2037, 1028, 25, 806, 109, 490, 914, 2219, 913, 2090, - 996, 2154, 2163, 85, 575, 769, 1493, 1419, 1418, 678, - 1427, 1455, 927, 2069, 2074, 2093, 2163, 1457, 122, 126, - 447, 596, 597, 1462, 1463, 2211, 809, 44, 49, 50, - 51, 52, 56, 75, 123, 160, 162, 174, 197, 337, - 347, 377, 435, 466, 469, 513, 520, 556, 572, 620, - 623, 666, 679, 681, 682, 701, 706, 714, 756, 789, - 810, 854, 866, 873, 1465, 1468, 1469, 1470, 2149, 2187, - 136, 455, 1453, 1454, 2055, 2081, 2081, 168, 34, 35, - 125, 132, 135, 189, 191, 192, 274, 276, 283, 291, - 398, 447, 451, 704, 787, 798, 809, 880, 913, 1460, - 2026, 2209, 270, 614, 2058, 2082, 814, 2007, 2009, 2113, - 2007, 2114, 816, 2007, 2109, 2110, 913, 913, 2009, 2112, - 2112, 2112, 2052, 2081, 2099, 2102, 2111, 913, 814, 2052, - 2108, 11, 2014, 2015, 2047, 2087, 2099, 353, 2009, 2052, - 2007, 816, 396, 2119, 2010, 2010, 2011, 2011, 2011, 457, - 1480, 612, 1486, 2032, 1496, 1497, 2067, 2081, 1521, 463, - 513, 2154, 2082, 2009, 488, 2125, 2092, 2009, 2022, 676, - 1748, 1749, 1750, 1545, 2206, 1555, 911, 2046, 1438, 1439, - 1438, 1949, 1950, 1947, 1948, 868, 1461, 1464, 1557, 1558, - 1559, 2206, 49, 50, 51, 52, 56, 74, 75, 123, - 162, 281, 337, 377, 469, 572, 701, 706, 744, 756, - 854, 1469, 1556, 1596, 281, 1566, 1567, 2081, 2099, 868, - 1584, 911, 1946, 1946, 1946, 1946, 2047, 2015, 2047, 1606, - 1491, 1613, 1619, 906, 1616, 1617, 249, 819, 906, 1438, - 1999, 2000, 1998, 20, 21, 22, 113, 280, 362, 363, - 440, 441, 506, 540, 549, 558, 599, 820, 824, 826, - 2001, 2002, 2003, 2004, 2005, 2006, 455, 2027, 2028, 203, - 1638, 2030, 236, 1642, 1644, 16, 20, 23, 24, 498, - 499, 549, 550, 1651, 1655, 315, 1390, 2093, 390, 820, - 2157, 1392, 2157, 2157, 2157, 1394, 2062, 2082, 2086, 2099, - 16, 109, 318, 431, 842, 1674, 1675, 1676, 1669, 1670, - 252, 1689, 345, 1689, 405, 1820, 2180, 2206, 409, 820, - 2164, 1355, 31, 409, 820, 2166, 3, 12, 27, 46, - 77, 78, 79, 82, 89, 101, 103, 104, 130, 185, - 198, 220, 221, 223, 224, 268, 284, 321, 322, 323, - 343, 348, 373, 374, 380, 381, 434, 436, 452, 465, - 466, 467, 492, 515, 516, 517, 519, 521, 522, 524, - 526, 527, 531, 533, 534, 535, 536, 549, 557, 570, - 571, 579, 585, 632, 637, 688, 689, 697, 721, 734, - 735, 736, 737, 754, 755, 765, 794, 808, 809, 846, - 855, 862, 873, 877, 878, 879, 894, 895, 900, 901, - 903, 910, 1358, 1360, 1362, 1364, 1366, 1368, 1370, 1372, - 1373, 1375, 1377, 1380, 1382, 1385, 1387, 814, 2043, 2015, - 2047, 733, 1713, 2179, 367, 1989, 1989, 864, 893, 806, - 1, 58, 59, 60, 61, 63, 143, 144, 324, 325, - 326, 327, 328, 329, 330, 331, 332, 455, 594, 617, - 1208, 1209, 1210, 1211, 1212, 1242, 2056, 2082, 811, 800, - 2188, 405, 2073, 2081, 2098, 2102, 405, 1744, 1748, 240, - 1786, 2081, 1786, 2081, 1795, 2206, 814, 814, 814, 814, - 1800, 11, 270, 744, 822, 833, 2047, 83, 56, 75, - 377, 435, 469, 572, 681, 854, 1804, 1805, 2163, 1827, - 2206, 2047, 282, 529, 136, 722, 816, 2008, 817, 2009, - 2081, 1848, 201, 1849, 345, 345, 2015, 2047, 1433, 2060, - 83, 2143, 405, 1874, 14, 55, 1902, 1903, 267, 1930, - 345, 1930, 1935, 2206, 1197, 1177, 819, 713, 662, 1282, - 889, 1270, 1230, 1231, 2163, 2115, 29, 54, 57, 58, - 59, 60, 61, 63, 64, 74, 140, 142, 143, 145, - 146, 147, 148, 149, 150, 212, 324, 325, 326, 327, - 328, 332, 367, 392, 419, 498, 554, 573, 589, 594, - 617, 648, 701, 738, 740, 741, 742, 785, 859, 860, - 861, 875, 898, 1223, 1224, 1225, 1226, 1227, 1228, 1231, - 1232, 1235, 1236, 1240, 1241, 1242, 1245, 1248, 1265, 1266, - 1268, 1269, 1270, 1275, 1276, 1277, 2163, 2193, 1206, 2163, - 155, 2147, 2163, 640, 646, 2220, 2220, 2163, 2147, 2163, - 2175, 2163, 31, 2135, 555, 1175, 2041, 300, 354, 819, - 6, 9, 27, 40, 308, 309, 393, 447, 525, 566, - 574, 640, 654, 669, 733, 747, 819, 823, 839, 840, - 1067, 1068, 1077, 1079, 1084, 1085, 1088, 1090, 1091, 1092, - 1093, 1099, 1100, 1101, 1102, 1105, 1111, 1112, 1114, 1116, - 1118, 1119, 1120, 1121, 2146, 2188, 2214, 2034, 2180, 2180, - 837, 838, 2224, 2022, 2180, 2180, 2147, 2179, 2179, 646, - 2020, 1029, 1031, 2215, 23, 498, 2037, 453, 1420, 1421, - 1422, 2143, 1420, 558, 913, 819, 283, 291, 539, 541, - 1939, 1941, 1942, 1944, 1945, 76, 547, 2177, 2177, 455, - 2070, 2074, 2095, 2163, 2163, 2163, 2163, 56, 230, 1470, - 108, 225, 865, 2203, 14, 2134, 421, 744, 1453, 136, - 827, 832, 1939, 926, 925, 2060, 1939, 421, 2168, 766, - 766, 547, 1448, 495, 455, 2059, 2082, 2081, 2008, 816, - 2008, 816, 816, 588, 816, 2052, 2008, 816, 816, 816, - 2008, 816, 2075, 2008, 816, 2179, 544, 745, 1961, 1963, - 1965, 2091, 2092, 2015, 817, 816, 816, 814, 2120, 1480, - 2093, 678, 1481, 814, 2030, 1490, 507, 616, 1498, 37, - 1524, 2206, 683, 657, 1961, 2163, 712, 338, 2154, 408, - 542, 1982, 1983, 1985, 1987, 421, 1578, 1569, 1440, 169, - 170, 606, 913, 1560, 2026, 1558, 514, 1596, 2164, 447, - 704, 2163, 277, 279, 1395, 1396, 2151, 2202, 2164, 225, - 2203, 2163, 1596, 1567, 2081, 1575, 1581, 353, 1961, 353, - 455, 1608, 883, 1499, 1, 29, 822, 833, 1621, 1622, - 1995, 567, 1620, 927, 2001, 2202, 1638, 2028, 2180, 1645, - 251, 1646, 1438, 2202, 661, 1652, 2202, 2081, 2081, 2081, - 2081, 814, 83, 1675, 1677, 2062, 16, 109, 431, 842, - 1672, 1673, 2060, 2078, 2081, 2081, 2081, 1085, 1821, 2146, - 38, 204, 1260, 226, 1389, 2081, 2093, 2046, 2043, 1961, - 353, 2206, 1748, 1208, 2156, 1729, 1724, 1725, 296, 1731, - 1993, 1732, 1733, 2081, 2030, 819, 1903, 1744, 2081, 2081, - 240, 537, 1971, 1974, 1976, 1778, 1779, 2206, 1438, 906, - 906, 1787, 1788, 1902, 231, 237, 285, 2081, 2060, 556, - 927, 2071, 2072, 2074, 2093, 2179, 2059, 555, 2047, 1800, - 1800, 1800, 1800, 1800, 1800, 1800, 1800, 1805, 530, 540, - 1829, 1830, 1831, 2002, 2122, 1982, 437, 744, 2222, 766, - 2196, 2196, 2009, 816, 2009, 1851, 2206, 2143, 2081, 2075, - 1961, 353, 1437, 2093, 814, 16, 1872, 1873, 2116, 1875, - 2081, 1851, 1875, 1748, 13, 2133, 2081, 678, 1936, 239, - 1178, 1279, 819, 713, 704, 1339, 2165, 889, 354, 2087, - 437, 549, 739, 858, 2192, 858, 2192, 858, 2192, 858, - 2192, 858, 2192, 906, 2204, 2179, 687, 2190, 227, 1251, - 2093, 458, 1237, 2082, 37, 2138, 409, 434, 687, 1267, - 2163, 1225, 300, 301, 385, 753, 431, 842, 345, 1219, - 2138, 354, 2093, 1089, 2165, 2165, 913, 2038, 2039, 558, - 756, 2216, 455, 2034, 2040, 2093, 893, 2163, 307, 384, - 913, 1159, 2041, 2175, 2168, 2188, 2202, 728, 2168, 2163, - 2144, 202, 2168, 2168, 513, 1113, 2093, 2206, 2163, 2163, - 766, 463, 727, 57, 2141, 2165, 2020, 2020, 2180, 2020, - 2020, 1133, 1134, 2022, 2221, 2022, 1030, 1031, 2090, 2163, - 2163, 2037, 1421, 744, 858, 1423, 1424, 650, 889, 1414, - 1943, 1944, 1466, 1467, 2078, 2081, 1940, 1941, 1438, 2069, - 2069, 2069, 2069, 2070, 2069, 2163, 1991, 2072, 1991, 2070, - 2156, 2163, 816, 816, 1453, 2055, 2055, 1939, 744, 1458, - 1459, 1461, 2124, 788, 2106, 788, 2106, 816, 2034, 2106, - 2106, 2106, 2052, 2124, 431, 842, 2106, 2082, 1438, 1438, - 1964, 1965, 1962, 1963, 2092, 1961, 816, 2009, 2106, 2106, - 2065, 2081, 2098, 1481, 2044, 1989, 513, 2126, 2009, 1438, - 1438, 1986, 1987, 1984, 1985, 2066, 1584, 197, 383, 812, - 850, 1505, 1570, 1571, 1572, 1441, 2069, 2069, 447, 704, - 240, 2069, 1991, 1991, 2069, 77, 79, 367, 451, 595, - 732, 834, 1461, 1586, 1587, 1588, 1589, 1590, 1592, 1593, - 1594, 1595, 2206, 1586, 2015, 2016, 2015, 2016, 1500, 25, - 806, 1623, 249, 819, 1438, 1621, 2081, 1438, 236, 889, - 1653, 1654, 1655, 803, 1656, 2200, 889, 2063, 2086, 2098, - 2060, 83, 14, 55, 1678, 1679, 1680, 1673, 1678, 336, - 168, 1992, 1693, 2206, 1817, 727, 2168, 390, 565, 2158, - 2015, 16, 513, 635, 1115, 2020, 2081, 1438, 255, 819, - 1727, 14, 345, 13, 389, 1745, 1746, 1747, 1749, 1752, - 1779, 2206, 186, 518, 1761, 1763, 1765, 1438, 1438, 1975, - 1976, 1974, 1982, 463, 513, 1994, 1993, 1787, 661, 1796, - 304, 305, 2047, 2002, 2081, 2003, 2004, 2005, 2006, 2009, - 1839, 2047, 1839, 816, 543, 830, 1966, 1968, 1970, 594, - 744, 1850, 2047, 2124, 2124, 2015, 819, 2061, 2065, 564, - 2060, 202, 1876, 793, 1877, 1778, 576, 2026, 2069, 1992, - 498, 888, 1937, 2064, 95, 1179, 1180, 1197, 1281, 819, - 713, 28, 297, 564, 816, 818, 827, 828, 831, 832, - 1207, 1222, 1272, 1273, 2163, 806, 1214, 927, 7, 53, - 65, 110, 133, 190, 272, 334, 342, 423, 430, 454, - 482, 626, 630, 707, 767, 780, 804, 847, 892, 905, - 911, 913, 1350, 90, 1253, 853, 814, 1249, 1238, 2163, - 2080, 2082, 1, 913, 1241, 37, 1229, 2143, 1233, 725, - 2127, 2127, 913, 1272, 814, 1156, 336, 1172, 2039, 451, - 2172, 814, 2145, 2156, 302, 319, 700, 851, 886, 891, - 1169, 1170, 2163, 2163, 2163, 2163, 2168, 227, 300, 1074, - 1075, 2163, 654, 1100, 2163, 2163, 2163, 2163, 32, 33, - 2137, 1115, 2040, 2093, 2163, 2175, 555, 1086, 728, 1117, - 2040, 2020, 1134, 597, 1135, 25, 2037, 2037, 2163, 744, - 1424, 562, 1426, 196, 1428, 1438, 2066, 447, 451, 2217, - 1467, 2071, 816, 2163, 1459, 1961, 345, 2128, 816, 1491, - 212, 712, 811, 1579, 2164, 2164, 2164, 2164, 2047, 1572, - 2179, 390, 409, 2167, 2069, 2136, 1587, 102, 434, 687, - 1591, 513, 1596, 1961, 656, 1961, 656, 1501, 1502, 1503, - 2143, 1622, 1994, 1645, 1654, 186, 2150, 2202, 1678, 1678, - 2063, 825, 2161, 2161, 1680, 1679, 2156, 1684, 495, 1917, - 207, 398, 883, 1822, 1819, 565, 1961, 567, 2183, 2183, - 560, 18, 211, 336, 433, 667, 682, 912, 1714, 1715, - 1719, 1720, 2206, 2207, 255, 1726, 1733, 2047, 2180, 463, - 421, 1753, 1751, 1752, 2206, 388, 420, 904, 1438, 1438, - 1764, 1765, 1762, 1763, 463, 1438, 1438, 447, 2169, 2179, - 2179, 1438, 1438, 1969, 1970, 1967, 1968, 2163, 1961, 2128, - 1961, 876, 1434, 1882, 1873, 2156, 1992, 2156, 1966, 278, - 538, 1904, 1977, 1979, 1981, 1983, 447, 451, 2170, 1909, - 2206, 613, 2041, 1197, 1197, 1283, 819, 806, 1271, 1273, - 509, 761, 1207, 1220, 1221, 1222, 2087, 199, 320, 425, - 481, 746, 841, 1243, 456, 1244, 2156, 345, 1250, 811, - 2201, 2093, 2201, 744, 913, 1239, 455, 2066, 169, 174, - 289, 705, 1234, 2144, 2093, 109, 646, 1152, 2033, 1163, - 2093, 2194, 455, 1160, 2087, 1160, 227, 633, 728, 1078, - 2034, 2163, 91, 92, 93, 209, 210, 212, 398, 399, - 422, 447, 472, 569, 602, 606, 607, 633, 795, 1069, - 1070, 1071, 1072, 1073, 2034, 2040, 1103, 2034, 2034, 2145, - 2224, 2034, 2163, 2034, 1087, 2154, 2163, 2040, 806, 2093, - 1031, 2154, 2154, 44, 197, 2093, 2163, 913, 819, 1415, - 2071, 392, 2159, 205, 2129, 1499, 1586, 2047, 2047, 2047, - 2047, 2081, 2164, 812, 706, 916, 2016, 2016, 1502, 558, - 1423, 156, 650, 889, 1438, 83, 197, 1678, 2047, 2047, - 2081, 1917, 2179, 783, 1686, 610, 2020, 353, 569, 1823, - 2087, 16, 513, 636, 867, 920, 1717, 1718, 1719, 513, - 80, 463, 474, 1716, 83, 1734, 463, 2163, 1754, 1972, - 1974, 1976, 1982, 463, 463, 2022, 2022, 2081, 2129, 1883, - 819, 2081, 2081, 1438, 1438, 1980, 1981, 1978, 1979, 1911, - 1912, 1913, 2206, 823, 1938, 2017, 610, 1181, 1284, 1340, - 1207, 906, 1274, 2205, 2179, 1222, 913, 2093, 814, 1249, - 203, 203, 1252, 2163, 766, 77, 834, 1164, 1165, 1166, - 1167, 2206, 2145, 345, 1155, 2155, 2034, 345, 13, 883, - 893, 2087, 2098, 2225, 62, 450, 757, 913, 1104, 750, - 820, 1106, 1107, 2034, 2035, 47, 295, 473, 1094, 2163, - 23, 498, 1089, 806, 2040, 498, 23, 44, 1425, 2206, - 1429, 1430, 2071, 2159, 1961, 1504, 1505, 2081, 2164, 1961, - 1961, 2048, 2049, 2079, 2082, 2047, 1686, 1918, 1919, 2081, - 1687, 1688, 2081, 291, 541, 1956, 1958, 1960, 2163, 2020, - 610, 568, 2184, 683, 455, 2050, 2054, 2057, 2081, 2102, - 864, 2081, 1975, 1973, 1974, 1961, 41, 229, 292, 354, - 1884, 1885, 1886, 1888, 1892, 1894, 1895, 1896, 1897, 2139, - 2154, 496, 1915, 1913, 43, 239, 923, 1914, 913, 2163, - 1182, 634, 1285, 1202, 1217, 1341, 1342, 1343, 729, 822, - 2081, 396, 1254, 2180, 2180, 393, 1255, 1257, 1258, 1259, - 1260, 1262, 2093, 2040, 2040, 335, 1156, 2093, 1106, 2087, - 2153, 2087, 2163, 583, 1080, 1081, 1108, 1109, 912, 1095, - 1097, 2206, 1098, 2206, 1095, 1089, 2163, 2163, 1089, 2040, - 2163, 2163, 480, 1430, 814, 2071, 291, 541, 830, 1507, - 1509, 1511, 11, 405, 532, 558, 829, 1506, 2162, 2047, - 1685, 1919, 2163, 1688, 1438, 1438, 1959, 1960, 1957, 1958, - 1728, 2163, 2082, 2099, 2102, 1993, 55, 2134, 1896, 1740, - 614, 194, 2163, 1917, 2064, 1728, 819, 1183, 2154, 2024, - 1, 1204, 1343, 819, 814, 2163, 1255, 2034, 2034, 2143, - 1262, 1258, 2168, 1256, 2139, 2145, 2117, 2206, 1082, 2117, - 1110, 2034, 1110, 463, 2173, 690, 474, 1089, 1089, 2037, - 2037, 744, 240, 2071, 1438, 1438, 1438, 1510, 1511, 1508, - 1509, 2179, 2081, 1956, 2098, 1728, 663, 756, 2195, 823, - 2021, 240, 761, 1893, 2180, 2064, 850, 1920, 1934, 569, - 2161, 1286, 819, 1344, 1345, 819, 1207, 1255, 1263, 1264, - 2088, 2163, 1257, 2040, 203, 1154, 1080, 226, 513, 2163, - 559, 2154, 2154, 2163, 196, 2081, 2081, 282, 291, 2213, - 2022, 823, 16, 1889, 1890, 2082, 497, 1916, 2179, 783, - 1925, 291, 541, 1951, 1953, 1955, 205, 282, 766, 784, - 801, 1188, 1189, 1190, 398, 416, 1, 1287, 1347, 552, - 1349, 1350, 1264, 2036, 2037, 2180, 782, 1083, 226, 2034, - 493, 640, 646, 2218, 498, 23, 2070, 819, 610, 2185, - 2022, 555, 611, 651, 1891, 1890, 2163, 1921, 1922, 2081, - 290, 908, 1926, 1927, 2081, 1910, 1438, 1438, 1954, 1955, - 1952, 1953, 168, 792, 2163, 421, 421, 205, 437, 1190, - 240, 484, 766, 784, 801, 1184, 1185, 1186, 1187, 2081, - 2174, 2197, 240, 484, 766, 801, 1191, 1192, 1193, 1194, - 2081, 2197, 819, 160, 161, 576, 819, 1288, 1289, 1294, - 2163, 2206, 2233, 44, 49, 50, 51, 52, 56, 74, - 75, 94, 115, 123, 171, 281, 337, 345, 347, 364, - 377, 435, 447, 451, 469, 513, 554, 572, 620, 666, - 714, 744, 756, 789, 814, 825, 854, 883, 1236, 1240, - 1245, 1265, 1268, 1270, 1348, 1409, 1410, 1468, 1469, 2163, - 2211, 1351, 2081, 2093, 1346, 2037, 2034, 906, 2218, 1096, - 1097, 2163, 2163, 2180, 555, 2080, 2064, 1922, 2163, 42, - 156, 235, 528, 549, 1924, 1928, 379, 471, 752, 927, - 1929, 2101, 1927, 1951, 2163, 554, 2081, 2163, 2163, 2163, - 2163, 421, 189, 809, 421, 437, 1186, 2081, 168, 628, - 750, 774, 775, 776, 421, 189, 809, 421, 437, 1193, - 2081, 796, 2165, 2165, 443, 444, 2171, 1305, 354, 119, - 316, 1290, 1291, 1292, 1293, 2081, 2163, 447, 704, 1407, - 2177, 1405, 2177, 2163, 2164, 1395, 1396, 2163, 2073, 1405, - 2164, 2093, 108, 2164, 2081, 2081, 354, 1407, 1353, 16, - 455, 752, 927, 1032, 1096, 1089, 1089, 298, 398, 416, - 569, 1887, 2020, 1924, 1923, 1924, 1923, 564, 2081, 2093, - 2081, 2081, 2081, 2081, 2163, 2163, 2163, 2163, 2163, 2081, - 2163, 2163, 2163, 2163, 2163, 2163, 2163, 2163, 2163, 2163, - 2163, 2081, 2163, 2165, 2165, 927, 1295, 1296, 1297, 2081, - 2093, 2096, 1202, 1306, 2163, 1292, 1293, 2069, 2163, 2163, - 2069, 2078, 2093, 2069, 1402, 2069, 2201, 2163, 2078, 2093, - 1348, 1355, 2100, 2101, 2201, 2081, 2081, 2081, 2081, 2081, - 2081, 2081, 2081, 2081, 2081, 2081, 2081, 2081, 2081, 2081, - 2081, 2081, 2081, 2081, 1298, 447, 451, 2170, 2209, 2217, - 1, 1204, 1205, 2066, 485, 593, 827, 832, 1398, 1399, - 1400, 1401, 1408, 1398, 1400, 1406, 96, 591, 1403, 1404, - 2066, 1261, 1262, 2081, 2081, 318, 335, 369, 427, 449, - 1299, 1300, 1301, 1302, 1303, 1304, 1296, 1297, 819, 1307, - 2069, 2069, 2081, 2081, 193, 207, 2226, 2163, 2163, 106, - 160, 2226, 2227, 2163, 1308, 2081, 2163, 1297, 1297, 369, - 2163, 2163, 1297, 4, 122, 126, 365, 447, 451, 511, - 554, 600, 750, 781, 819, 850, 893, 1236, 1240, 1245, - 1246, 1265, 1268, 1270, 1309, 1310, 1315, 1318, 1321, 1322, - 1325, 1326, 1327, 1330, 1331, 1337, 1338, 2208, 2209, 2210, - 2081, 1297, 1297, 1297, 394, 2160, 548, 2177, 2178, 2135, - 2163, 2093, 2163, 2179, 2163, 2081, 14, 55, 419, 906, - 512, 1328, 1329, 1397, 1398, 1334, 1335, 1336, 1398, 2093, - 2178, 2081, 2165, 509, 512, 576, 1316, 1317, 1398, 2093, - 1249, 2053, 2051, 2053, 105, 160, 576, 586, 587, 662, - 685, 686, 1311, 2226, 2227, 2228, 2229, 2230, 2231, 2232, - 345, 508, 2176, 2176, 14, 55, 1993, 1328, 2096, 1335, - 2096, 101, 434, 687, 1332, 1333, 2081, 2093, 2201, 2124, - 670, 868, 1319, 2053, 335, 335, 369, 335, 369, 336, - 559, 2181, 2181, 2053, 564, 576, 1323, 1324, 2081, 1323, - 2176, 2176, 2165, 2081, 1252, 2180, 2081, 316, 1312, 2081, - 16, 316, 1314, 2081, 83, 1323, 576, 576, 770, 1247, - 316, 1320, 2081, 564, 1313, 1313, 1313, 1313, 2053, 2093, - 576 -}; - - /* YYR1[YYN] -- Symbol number of symbol that rule YYN derives. */ -static const yytype_uint16 yyr1[] = -{ - 0, 929, 931, 930, 932, 932, 934, 933, 935, 935, - 936, 936, 938, 937, 939, 940, 941, 941, 942, 942, - 944, 943, 946, 945, 948, 949, 947, 950, 950, 951, - 952, 952, 954, 955, 953, 957, 956, 958, 958, 959, - 959, 960, 960, 961, 961, 961, 962, 962, 962, 962, - 963, 963, 964, 964, 964, 965, 965, 966, 967, 967, - 968, 969, 969, 970, 970, 970, 970, 971, 971, 972, - 972, 973, 973, 973, 974, 974, 975, 975, 975, 975, - 976, 977, 977, 978, 979, 979, 980, 980, 981, 981, - 982, 982, 982, 982, 982, 984, 983, 985, 985, 986, - 986, 988, 987, 989, 989, 989, 989, 990, 990, 991, - 991, 991, 991, 992, 993, 995, 994, 996, 996, 996, - 996, 996, 996, 997, 998, 999, 999, 999, 999, 1000, - 1000, 1002, 1001, 1003, 1003, 1003, 1004, 1004, 1005, 1005, - 1005, 1005, 1005, 1006, 1006, 1007, 1008, 1009, 1009, 1009, - 1010, 1010, 1010, 1010, 1010, 1010, 1010, 1010, 1010, 1010, - 1010, 1010, 1010, 1010, 1012, 1011, 1013, 1013, 1013, 1013, - 1014, 1014, 1015, 1016, 1016, 1018, 1017, 1020, 1019, 1021, - 1019, 1022, 1022, 1023, 1024, 1024, 1024, 1024, 1024, 1025, - 1025, 1025, 1025, 1026, 1026, 1026, 1027, 1027, 1028, 1028, - 1029, 1028, 1030, 1030, 1031, 1031, 1031, 1031, 1031, 1031, - 1032, 1032, 1033, 1034, 1034, 1035, 1036, 1036, 1037, 1038, - 1038, 1039, 1039, 1040, 1041, 1041, 1042, 1043, 1044, 1044, - 1045, 1045, 1046, 1046, 1046, 1047, 1047, 1048, 1049, 1050, - 1050, 1051, 1052, 1053, 1054, 1055, 1056, 1058, 1057, 1059, - 1060, 1060, 1061, 1061, 1062, 1062, 1064, 1063, 1065, 1065, - 1066, 1066, 1067, 1067, 1067, 1067, 1067, 1067, 1067, 1067, - 1067, 1067, 1067, 1067, 1067, 1067, 1067, 1067, 1067, 1067, - 1067, 1068, 1068, 1068, 1068, 1068, 1069, 1069, 1069, 1070, - 1070, 1070, 1070, 1070, 1070, 1070, 1071, 1071, 1071, 1071, - 1072, 1072, 1072, 1072, 1072, 1072, 1072, 1073, 1074, 1074, - 1075, 1075, 1076, 1076, 1077, 1078, 1078, 1078, 1079, 1080, - 1080, 1082, 1081, 1083, 1083, 1083, 1083, 1084, 1086, 1085, - 1087, 1087, 1087, 1087, 1087, 1087, 1088, 1089, 1090, 1091, - 1091, 1091, 1093, 1092, 1094, 1094, 1094, 1095, 1095, 1095, - 1095, 1096, 1096, 1097, 1098, 1098, 1099, 1099, 1100, 1100, - 1100, 1100, 1101, 1103, 1102, 1104, 1104, 1104, 1104, 1105, - 1106, 1106, 1107, 1107, 1109, 1108, 1108, 1110, 1111, 1112, - 1113, 1113, 1114, 1115, 1115, 1115, 1116, 1117, 1117, 1118, - 1119, 1120, 1121, 1122, 1122, 1123, 1124, 1124, 1124, 1125, - 1125, 1126, 1126, 1126, 1126, 1127, 1128, 1128, 1128, 1128, - 1129, 1129, 1129, 1129, 1129, 1130, 1130, 1130, 1130, 1130, - 1130, 1130, 1130, 1132, 1131, 1133, 1133, 1134, 1135, 1135, - 1136, 1137, 1138, 1138, 1140, 1139, 1141, 1141, 1142, 1143, - 1143, 1144, 1144, 1145, 1147, 1146, 1146, 1148, 1148, 1149, - 1149, 1150, 1150, 1150, 1150, 1150, 1150, 1150, 1150, 1150, - 1150, 1150, 1151, 1152, 1152, 1152, 1153, 1153, 1153, 1154, - 1154, 1155, 1155, 1156, 1156, 1157, 1158, 1158, 1159, 1159, - 1160, 1160, 1161, 1162, 1163, 1163, 1164, 1164, 1164, 1165, - 1166, 1167, 1168, 1169, 1169, 1169, 1169, 1169, 1170, 1170, - 1171, 1172, 1172, 1173, 1174, 1174, 1175, 1175, 1176, 1177, - 1176, 1178, 1178, 1179, 1181, 1180, 1182, 1182, 1183, 1183, - 1183, 1184, 1184, 1184, 1185, 1185, 1186, 1186, 1186, 1186, - 1186, 1186, 1186, 1186, 1186, 1186, 1186, 1187, 1188, 1188, - 1189, 1189, 1190, 1190, 1190, 1190, 1190, 1190, 1190, 1191, - 1191, 1191, 1192, 1192, 1193, 1193, 1193, 1193, 1193, 1193, - 1194, 1195, 1196, 1195, 1197, 1198, 1197, 1199, 1199, 1200, - 1200, 1200, 1201, 1200, 1200, 1202, 1203, 1203, 1204, 1204, - 1205, 1206, 1206, 1207, 1207, 1207, 1208, 1208, 1208, 1208, - 1208, 1208, 1208, 1208, 1208, 1208, 1208, 1208, 1208, 1208, - 1208, 1209, 1209, 1210, 1210, 1211, 1211, 1211, 1212, 1212, - 1213, 1214, 1214, 1216, 1215, 1217, 1218, 1217, 1219, 1219, - 1220, 1220, 1220, 1221, 1221, 1222, 1222, 1222, 1222, 1222, - 1222, 1222, 1222, 1222, 1222, 1223, 1223, 1224, 1224, 1225, - 1225, 1225, 1225, 1225, 1225, 1225, 1225, 1225, 1225, 1225, - 1225, 1225, 1225, 1225, 1225, 1225, 1225, 1226, 1227, 1228, - 1229, 1229, 1230, 1230, 1231, 1233, 1232, 1234, 1234, 1234, - 1234, 1235, 1236, 1237, 1237, 1238, 1238, 1239, 1240, 1240, - 1240, 1240, 1241, 1241, 1241, 1241, 1241, 1241, 1241, 1241, - 1241, 1241, 1241, 1241, 1241, 1241, 1241, 1241, 1241, 1241, - 1241, 1241, 1241, 1241, 1241, 1241, 1241, 1241, 1241, 1241, - 1241, 1241, 1241, 1241, 1241, 1241, 1241, 1241, 1241, 1241, - 1241, 1241, 1241, 1241, 1241, 1241, 1241, 1241, 1241, 1241, - 1241, 1241, 1242, 1242, 1243, 1243, 1243, 1243, 1243, 1243, - 1243, 1244, 1244, 1245, 1245, 1246, 1247, 1247, 1248, 1248, - 1248, 1249, 1249, 1250, 1250, 1251, 1251, 1252, 1252, 1253, - 1253, 1254, 1254, 1255, 1255, 1256, 1255, 1255, 1255, 1257, - 1258, 1258, 1259, 1260, 1260, 1261, 1261, 1262, 1263, 1263, - 1264, 1265, 1266, 1267, 1267, 1267, 1268, 1269, 1271, 1270, - 1272, 1272, 1273, 1273, 1274, 1274, 1275, 1275, 1276, 1277, - 1278, 1279, 1278, 1280, 1281, 1280, 1282, 1283, 1282, 1284, - 1284, 1286, 1285, 1287, 1287, 1287, 1288, 1288, 1288, 1288, - 1289, 1290, 1290, 1290, 1291, 1292, 1292, 1293, 1294, 1295, - 1295, 1295, 1296, 1297, 1297, 1298, 1298, 1299, 1299, 1299, - 1299, 1299, 1299, 1300, 1301, 1302, 1303, 1304, 1305, 1305, - 1307, 1306, 1306, 1308, 1308, 1309, 1309, 1309, 1309, 1309, - 1309, 1309, 1309, 1309, 1309, 1309, 1309, 1309, 1309, 1309, - 1309, 1310, 1311, 1311, 1311, 1311, 1311, 1311, 1311, 1312, - 1312, 1312, 1313, 1313, 1314, 1314, 1314, 1314, 1315, 1316, - 1316, 1316, 1317, 1317, 1317, 1318, 1319, 1319, 1319, 1320, - 1320, 1321, 1321, 1321, 1321, 1321, 1322, 1322, 1323, 1323, - 1324, 1324, 1324, 1325, 1326, 1327, 1327, 1328, 1328, 1329, - 1329, 1330, 1331, 1332, 1332, 1333, 1333, 1333, 1334, 1334, - 1335, 1335, 1336, 1337, 1338, 1339, 1340, 1339, 1341, 1341, - 1342, 1342, 1343, 1344, 1343, 1345, 1346, 1343, 1343, 1347, - 1347, 1348, 1348, 1348, 1348, 1348, 1348, 1348, 1348, 1348, - 1348, 1348, 1348, 1348, 1348, 1348, 1348, 1348, 1348, 1348, - 1348, 1348, 1348, 1348, 1348, 1348, 1348, 1348, 1348, 1348, - 1348, 1348, 1348, 1348, 1348, 1348, 1348, 1348, 1348, 1348, - 1348, 1348, 1348, 1348, 1348, 1348, 1348, 1348, 1348, 1348, - 1349, 1349, 1350, 1350, 1350, 1350, 1350, 1350, 1350, 1350, - 1350, 1350, 1350, 1350, 1350, 1350, 1350, 1350, 1351, 1351, - 1352, 1352, 1353, 1353, 1353, 1354, 1354, 1355, 1355, 1356, - 1356, 1357, 1357, 1358, 1358, 1358, 1358, 1358, 1358, 1358, - 1358, 1358, 1358, 1358, 1358, 1358, 1358, 1359, 1359, 1359, - 1359, 1359, 1359, 1359, 1359, 1359, 1359, 1359, 1359, 1359, - 1359, 1359, 1360, 1360, 1360, 1360, 1360, 1360, 1360, 1360, - 1360, 1360, 1361, 1361, 1361, 1361, 1361, 1361, 1362, 1362, - 1362, 1362, 1363, 1364, 1364, 1364, 1364, 1364, 1364, 1364, - 1364, 1364, 1364, 1364, 1364, 1364, 1364, 1364, 1365, 1365, - 1365, 1365, 1365, 1365, 1365, 1365, 1365, 1365, 1366, 1366, - 1366, 1366, 1366, 1366, 1366, 1366, 1366, 1367, 1367, 1368, - 1368, 1369, 1369, 1370, 1370, 1370, 1370, 1370, 1371, 1371, - 1371, 1371, 1371, 1371, 1371, 1371, 1371, 1371, 1371, 1371, - 1371, 1371, 1371, 1371, 1372, 1372, 1372, 1373, 1373, 1373, - 1373, 1373, 1373, 1373, 1373, 1374, 1374, 1374, 1374, 1374, - 1374, 1375, 1375, 1375, 1375, 1375, 1375, 1375, 1375, 1376, - 1376, 1376, 1376, 1377, 1377, 1377, 1378, 1378, 1378, 1378, - 1378, 1378, 1379, 1379, 1379, 1379, 1380, 1380, 1380, 1380, - 1380, 1380, 1380, 1381, 1381, 1381, 1381, 1381, 1381, 1381, - 1381, 1381, 1381, 1381, 1381, 1381, 1381, 1381, 1381, 1381, - 1381, 1381, 1381, 1381, 1381, 1381, 1381, 1381, 1381, 1381, - 1381, 1381, 1381, 1381, 1381, 1381, 1381, 1381, 1381, 1381, - 1381, 1381, 1381, 1381, 1381, 1381, 1381, 1381, 1381, 1381, - 1382, 1382, 1382, 1383, 1383, 1383, 1383, 1383, 1383, 1383, - 1383, 1383, 1384, 1384, 1384, 1384, 1384, 1384, 1384, 1384, - 1384, 1384, 1384, 1384, 1384, 1384, 1384, 1384, 1384, 1384, - 1384, 1384, 1384, 1384, 1384, 1385, 1386, 1387, 1387, 1387, - 1387, 1387, 1387, 1387, 1387, 1388, 1388, 1388, 1389, 1389, - 1390, 1391, 1391, 1392, 1393, 1393, 1394, 1394, 1394, 1395, - 1395, 1396, 1396, 1397, 1397, 1398, 1399, 1399, 1400, 1401, - 1401, 1402, 1403, 1403, 1404, 1404, 1405, 1406, 1406, 1406, - 1407, 1408, 1408, 1408, 1409, 1410, 1411, 1411, 1413, 1414, - 1415, 1412, 1416, 1412, 1417, 1418, 1417, 1419, 1417, 1420, - 1420, 1421, 1422, 1422, 1422, 1423, 1423, 1423, 1423, 1423, - 1423, 1424, 1425, 1425, 1426, 1426, 1427, 1427, 1427, 1428, - 1429, 1428, 1430, 1430, 1431, 1431, 1431, 1431, 1431, 1433, - 1432, 1434, 1434, 1435, 1436, 1437, 1437, 1439, 1440, 1438, - 1442, 1441, 1441, 1443, 1443, 1443, 1443, 1443, 1443, 1443, - 1443, 1443, 1443, 1443, 1443, 1443, 1443, 1443, 1443, 1443, - 1443, 1443, 1443, 1443, 1443, 1443, 1443, 1443, 1443, 1443, - 1443, 1443, 1443, 1443, 1443, 1443, 1443, 1443, 1443, 1443, - 1443, 1443, 1443, 1443, 1443, 1443, 1443, 1443, 1443, 1443, - 1443, 1443, 1443, 1443, 1443, 1443, 1443, 1443, 1443, 1443, - 1443, 1443, 1443, 1443, 1443, 1443, 1443, 1443, 1443, 1445, - 1444, 1447, 1446, 1448, 1446, 1446, 1446, 1446, 1446, 1446, - 1446, 1446, 1446, 1446, 1446, 1446, 1446, 1446, 1446, 1446, - 1446, 1446, 1446, 1446, 1446, 1446, 1446, 1446, 1449, 1449, - 1451, 1450, 1452, 1452, 1452, 1453, 1453, 1453, 1454, 1454, - 1455, 1455, 1456, 1456, 1457, 1457, 1457, 1457, 1457, 1458, - 1458, 1459, 1459, 1460, 1460, 1461, 1461, 1461, 1462, 1463, - 1464, 1465, 1465, 1465, 1465, 1465, 1465, 1465, 1465, 1465, - 1465, 1465, 1465, 1465, 1465, 1465, 1465, 1465, 1465, 1465, - 1465, 1465, 1465, 1465, 1465, 1465, 1465, 1465, 1465, 1465, - 1465, 1465, 1465, 1465, 1465, 1465, 1465, 1466, 1466, 1467, - 1468, 1468, 1468, 1469, 1469, 1469, 1470, 1470, 1471, 1471, - 1473, 1472, 1474, 1474, 1474, 1474, 1475, 1475, 1476, 1476, - 1478, 1477, 1479, 1479, 1480, 1480, 1481, 1481, 1483, 1482, - 1484, 1484, 1485, 1486, 1486, 1488, 1487, 1490, 1489, 1491, - 1492, 1491, 1493, 1493, 1493, 1494, 1494, 1495, 1495, 1495, - 1495, 1495, 1495, 1496, 1496, 1497, 1497, 1498, 1498, 1499, - 1500, 1499, 1501, 1501, 1502, 1502, 1503, 1503, 1503, 1503, - 1504, 1504, 1504, 1504, 1504, 1505, 1505, 1506, 1506, 1507, - 1507, 1507, 1508, 1508, 1509, 1509, 1510, 1510, 1511, 1512, - 1512, 1514, 1513, 1515, 1515, 1516, 1516, 1518, 1517, 1519, - 1519, 1520, 1520, 1521, 1521, 1521, 1521, 1521, 1523, 1522, - 1524, 1524, 1526, 1525, 1527, 1528, 1528, 1529, 1531, 1530, - 1532, 1533, 1532, 1535, 1534, 1536, 1536, 1538, 1537, 1539, - 1539, 1540, 1540, 1541, 1541, 1543, 1542, 1544, 1545, 1545, - 1546, 1546, 1546, 1546, 1546, 1548, 1547, 1549, 1549, 1549, - 1549, 1549, 1549, 1549, 1549, 1549, 1549, 1549, 1550, 1550, - 1551, 1551, 1553, 1552, 1554, 1554, 1555, 1555, 1556, 1556, - 1557, 1557, 1558, 1558, 1558, 1558, 1558, 1559, 1559, 1559, - 1559, 1560, 1560, 1562, 1561, 1563, 1565, 1564, 1566, 1566, - 1567, 1567, 1567, 1569, 1568, 1570, 1570, 1571, 1571, 1572, - 1572, 1572, 1572, 1572, 1574, 1575, 1573, 1576, 1576, 1578, - 1579, 1577, 1581, 1580, 1582, 1582, 1582, 1583, 1583, 1584, - 1584, 1585, 1585, 1585, 1586, 1586, 1587, 1587, 1587, 1587, - 1587, 1587, 1587, 1587, 1588, 1589, 1590, 1590, 1590, 1591, - 1591, 1591, 1591, 1592, 1592, 1593, 1593, 1594, 1595, 1596, - 1596, 1596, 1596, 1596, 1596, 1596, 1596, 1596, 1596, 1596, - 1596, 1596, 1596, 1596, 1596, 1596, 1596, 1596, 1596, 1596, - 1596, 1596, 1597, 1597, 1599, 1598, 1600, 1600, 1600, 1600, - 1600, 1601, 1601, 1603, 1602, 1605, 1604, 1606, 1604, 1607, - 1608, 1610, 1609, 1611, 1612, 1612, 1613, 1613, 1613, 1614, - 1614, 1615, 1615, 1616, 1616, 1616, 1617, 1617, 1617, 1619, - 1618, 1620, 1618, 1621, 1621, 1622, 1622, 1622, 1622, 1622, - 1623, 1623, 1624, 1624, 1626, 1625, 1627, 1627, 1627, 1627, - 1627, 1627, 1627, 1628, 1628, 1630, 1629, 1631, 1633, 1632, - 1634, 1636, 1635, 1637, 1637, 1638, 1638, 1639, 1641, 1640, - 1642, 1642, 1642, 1643, 1643, 1644, 1645, 1646, 1646, 1648, - 1647, 1649, 1650, 1650, 1651, 1651, 1651, 1652, 1652, 1653, - 1653, 1654, 1655, 1655, 1655, 1655, 1655, 1655, 1655, 1656, - 1656, 1658, 1657, 1659, 1659, 1661, 1660, 1662, 1662, 1664, - 1663, 1665, 1666, 1666, 1666, 1667, 1667, 1667, 1667, 1669, - 1668, 1670, 1671, 1672, 1672, 1673, 1673, 1673, 1673, 1673, - 1673, 1674, 1674, 1675, 1675, 1676, 1676, 1676, 1676, 1676, - 1677, 1678, 1678, 1678, 1678, 1678, 1679, 1680, 1682, 1681, - 1684, 1685, 1683, 1686, 1686, 1687, 1687, 1688, 1689, 1689, - 1691, 1690, 1692, 1693, 1693, 1695, 1694, 1697, 1696, 1698, - 1698, 1699, 1699, 1701, 1700, 1702, 1702, 1704, 1703, 1705, - 1705, 1706, 1706, 1708, 1707, 1709, 1709, 1710, 1711, 1711, - 1712, 1712, 1712, 1712, 1713, 1713, 1714, 1714, 1714, 1714, - 1714, 1715, 1715, 1716, 1716, 1716, 1717, 1717, 1717, 1718, - 1718, 1718, 1719, 1719, 1720, 1720, 1720, 1722, 1721, 1723, - 1724, 1723, 1725, 1723, 1726, 1726, 1727, 1727, 1728, 1728, - 1729, 1729, 1729, 1729, 1729, 1730, 1730, 1731, 1731, 1732, - 1732, 1733, 1734, 1734, 1736, 1735, 1738, 1737, 1739, 1739, - 1740, 1742, 1741, 1743, 1744, 1744, 1745, 1745, 1745, 1745, - 1746, 1746, 1747, 1747, 1748, 1748, 1749, 1750, 1750, 1750, - 1751, 1751, 1752, 1752, 1752, 1753, 1753, 1754, 1754, 1755, - 1755, 1756, 1758, 1757, 1759, 1760, 1760, 1761, 1761, 1761, - 1762, 1762, 1763, 1764, 1764, 1765, 1766, 1766, 1768, 1767, - 1769, 1770, 1772, 1771, 1773, 1774, 1774, 1776, 1775, 1777, - 1778, 1778, 1779, 1779, 1780, 1780, 1781, 1783, 1782, 1784, - 1784, 1785, 1785, 1786, 1786, 1787, 1787, 1788, 1789, 1789, - 1791, 1790, 1792, 1792, 1793, 1793, 1794, 1795, 1795, 1795, - 1795, 1796, 1796, 1798, 1797, 1799, 1799, 1799, 1799, 1799, - 1799, 1799, 1799, 1800, 1800, 1801, 1801, 1802, 1803, 1804, - 1804, 1805, 1805, 1805, 1805, 1805, 1805, 1805, 1805, 1806, - 1806, 1806, 1806, 1806, 1807, 1808, 1808, 1809, 1810, 1810, - 1811, 1811, 1812, 1813, 1815, 1814, 1817, 1816, 1818, 1818, - 1819, 1819, 1820, 1820, 1821, 1821, 1822, 1822, 1822, 1823, - 1823, 1823, 1825, 1824, 1826, 1827, 1827, 1828, 1828, 1828, - 1828, 1829, 1829, 1829, 1829, 1829, 1829, 1830, 1831, 1831, - 1832, 1832, 1833, 1834, 1834, 1835, 1837, 1836, 1836, 1836, - 1838, 1838, 1838, 1838, 1838, 1839, 1839, 1840, 1840, 1841, - 1841, 1841, 1841, 1843, 1842, 1844, 1846, 1845, 1847, 1847, - 1848, 1849, 1849, 1850, 1850, 1851, 1851, 1852, 1852, 1854, - 1853, 1855, 1855, 1855, 1855, 1856, 1856, 1857, 1858, 1858, - 1860, 1859, 1861, 1861, 1863, 1862, 1864, 1866, 1865, 1867, - 1869, 1868, 1870, 1871, 1871, 1872, 1872, 1873, 1874, 1874, - 1875, 1876, 1876, 1877, 1877, 1878, 1878, 1880, 1879, 1881, - 1881, 1883, 1882, 1884, 1884, 1884, 1884, 1884, 1885, 1886, - 1886, 1887, 1887, 1887, 1887, 1887, 1888, 1889, 1889, 1890, - 1890, 1890, 1891, 1891, 1891, 1891, 1892, 1893, 1893, 1894, - 1895, 1895, 1896, 1896, 1897, 1897, 1899, 1898, 1900, 1901, - 1901, 1902, 1902, 1902, 1902, 1903, 1903, 1904, 1904, 1904, - 1905, 1905, 1907, 1906, 1909, 1910, 1908, 1911, 1911, 1912, - 1912, 1913, 1914, 1914, 1914, 1915, 1915, 1916, 1916, 1917, - 1917, 1918, 1918, 1919, 1920, 1920, 1921, 1921, 1922, 1923, - 1923, 1924, 1924, 1924, 1925, 1925, 1926, 1926, 1927, 1927, - 1927, 1928, 1928, 1928, 1929, 1929, 1930, 1930, 1932, 1931, - 1934, 1933, 1935, 1935, 1936, 1936, 1937, 1937, 1938, 1938, - 1939, 1939, 1939, 1940, 1940, 1941, 1942, 1942, 1943, 1943, - 1944, 1945, 1945, 1946, 1946, 1946, 1947, 1947, 1948, 1949, - 1949, 1950, 1951, 1951, 1951, 1952, 1952, 1953, 1954, 1954, - 1955, 1956, 1956, 1956, 1957, 1957, 1958, 1959, 1959, 1960, - 1961, 1961, 1961, 1962, 1962, 1963, 1964, 1964, 1965, 1966, - 1966, 1966, 1967, 1967, 1968, 1969, 1969, 1970, 1971, 1971, - 1972, 1972, 1973, 1973, 1974, 1975, 1975, 1976, 1977, 1977, - 1978, 1978, 1979, 1980, 1980, 1981, 1982, 1982, 1983, 1983, - 1984, 1984, 1985, 1986, 1986, 1987, 1988, 1988, 1989, 1989, - 1990, 1990, 1991, 1991, 1992, 1992, 1993, 1993, 1994, 1996, - 1995, 1997, 1997, 1998, 1998, 1998, 1998, 1998, 1998, 1998, - 1998, 1998, 1998, 1998, 1998, 1998, 1998, 1999, 1999, 2000, - 2001, 2001, 2001, 2001, 2001, 2001, 2001, 2001, 2001, 2001, - 2001, 2001, 2001, 2001, 2002, 2002, 2003, 2003, 2004, 2004, - 2005, 2006, 2007, 2007, 2008, 2008, 2008, 2009, 2009, 2009, - 2010, 2010, 2010, 2011, 2011, 2012, 2012, 2012, 2013, 2013, - 2014, 2014, 2014, 2014, 2014, 2014, 2015, 2015, 2016, 2017, - 2018, 2018, 2019, 2020, 2020, 2021, 2021, 2022, 2023, 2024, - 2025, 2025, 2026, 2027, 2027, 2028, 2029, 2029, 2030, 2031, - 2031, 2031, 2032, 2033, 2033, 2034, 2035, 2035, 2036, 2036, - 2037, 2038, 2038, 2039, 2040, 2040, 2041, 2041, 2042, 2043, - 2043, 2044, 2044, 2044, 2045, 2045, 2046, 2046, 2047, 2047, - 2048, 2048, 2049, 2049, 2049, 2049, 2049, 2049, 2049, 2049, - 2049, 2050, 2051, 2051, 2052, 2052, 2052, 2053, 2053, 2053, - 2053, 2053, 2053, 2053, 2054, 2054, 2054, 2054, 2054, 2054, - 2055, 2056, 2057, 2058, 2058, 2059, 2059, 2060, 2061, 2062, - 2062, 2063, 2063, 2064, 2064, 2064, 2065, 2065, 2066, 2066, - 2067, 2067, 2067, 2068, 2068, 2068, 2069, 2069, 2069, 2070, - 2070, 2071, 2071, 2072, 2072, 2073, 2073, 2073, 2074, 2075, - 2076, 2076, 2077, 2078, 2079, 2080, 2081, 2082, 2082, 2082, - 2082, 2083, 2083, 2084, 2084, 2085, 2085, 2085, 2085, 2086, - 2087, 2087, 2089, 2088, 2090, 2090, 2091, 2092, 2092, 2093, - 2094, 2095, 2096, 2096, 2097, 2097, 2097, 2097, 2097, 2097, - 2097, 2098, 2098, 2099, 2099, 2100, 2100, 2100, 2100, 2100, - 2100, 2100, 2101, 2101, 2101, 2101, 2102, 2102, 2102, 2102, - 2102, 2102, 2102, 2102, 2102, 2102, 2102, 2102, 2102, 2102, - 2103, 2103, 2104, 2104, 2104, 2104, 2105, 2105, 2105, 2105, - 2105, 2106, 2106, 2106, 2107, 2107, 2107, 2108, 2108, 2108, - 2110, 2109, 2111, 2111, 2112, 2112, 2113, 2113, 2114, 2114, - 2115, 2116, 2116, 2117, 2117, 2117, 2118, 2118, 2119, 2119, - 2120, 2120, 2121, 2121, 2121, 2122, 2122, 2123, 2123, 2123, - 2124, 2124, 2125, 2125, 2126, 2126, 2126, 2126, 2126, 2126, - 2126, 2126, 2127, 2127, 2128, 2128, 2129, 2129, 2130, 2130, - 2130, 2130, 2131, 2131, 2131, 2131, 2131, 2131, 2131, 2131, - 2131, 2131, 2131, 2131, 2131, 2131, 2131, 2131, 2131, 2131, - 2131, 2131, 2131, 2131, 2131, 2131, 2131, 2131, 2131, 2131, - 2131, 2131, 2131, 2131, 2131, 2131, 2131, 2131, 2131, 2131, - 2131, 2131, 2131, 2131, 2131, 2131, 2131, 2131, 2131, 2131, - 2131, 2131, 2131, 2132, 2132, 2132, 2132, 2132, 2132, 2132, - 2132, 2132, 2132, 2132, 2132, 2132, 2132, 2132, 2132, 2132, - 2132, 2132, 2132, 2132, 2132, 2132, 2133, 2133, 2134, 2134, - 2135, 2135, 2136, 2136, 2137, 2137, 2137, 2138, 2138, 2139, - 2139, 2140, 2140, 2141, 2141, 2142, 2142, 2143, 2143, 2144, - 2144, 2145, 2145, 2146, 2146, 2147, 2147, 2148, 2148, 2149, - 2149, 2150, 2150, 2151, 2151, 2152, 2152, 2153, 2153, 2154, - 2154, 2155, 2155, 2156, 2156, 2157, 2157, 2157, 2158, 2158, - 2158, 2159, 2159, 2160, 2160, 2161, 2161, 2162, 2162, 2163, - 2163, 2164, 2164, 2164, 2165, 2165, 2165, 2166, 2166, 2166, - 2166, 2167, 2167, 2167, 2168, 2168, 2169, 2169, 2170, 2170, - 2170, 2171, 2171, 2171, 2172, 2172, 2173, 2173, 2174, 2174, - 2175, 2175, 2176, 2176, 2177, 2177, 2178, 2178, 2179, 2179, - 2180, 2180, 2181, 2181, 2181, 2182, 2182, 2182, 2182, 2183, - 2183, 2184, 2184, 2185, 2185, 2186, 2186, 2187, 2187, 2188, - 2188, 2189, 2189, 2189, 2190, 2190, 2191, 2191, 2192, 2192, - 2193, 2193, 2193, 2194, 2194, 2195, 2195, 2196, 2196, 2197, - 2197, 2198, 2198, 2199, 2199, 2200, 2200, 2201, 2201, 2202, - 2202, 2203, 2203, 2204, 2204, 2205, 2205, 2206, 2206, 2207, - 2207, 2207, 2208, 2208, 2209, 2209, 2210, 2210, 2211, 2211, - 2211, 2211, 2212, 2212, 2213, 2213, 2214, 2214, 2215, 2215, - 2216, 2216, 2217, 2217, 2218, 2218, 2219, 2219, 2219, 2220, - 2220, 2221, 2221, 2222, 2222, 2223, 2223, 2224, 2224, 2225, - 2225, 2226, 2226, 2227, 2227, 2228, 2228, 2229, 2229, 2230, - 2230, 2231, 2231, 2232, 2232, 2233, 2233 -}; - - /* YYR2[YYN] -- Number of symbols on the right hand side of rule YYN. */ -static const yytype_uint8 yyr2[] = -{ - 0, 2, 0, 2, 1, 1, 0, 2, 1, 2, - 1, 1, 0, 2, 4, 4, 0, 1, 1, 2, - 0, 4, 0, 4, 0, 0, 6, 0, 1, 3, - 1, 1, 0, 0, 8, 0, 7, 1, 1, 1, - 1, 0, 2, 0, 3, 1, 1, 1, 1, 1, - 2, 2, 1, 1, 1, 0, 1, 2, 0, 3, - 5, 0, 3, 1, 1, 1, 1, 0, 5, 0, - 3, 1, 1, 1, 0, 4, 1, 1, 1, 1, - 3, 0, 3, 2, 0, 3, 0, 1, 1, 2, - 1, 1, 1, 1, 1, 0, 4, 0, 3, 0, - 3, 0, 4, 0, 2, 3, 2, 1, 2, 1, - 1, 1, 1, 5, 2, 0, 4, 2, 3, 4, - 4, 8, 8, 3, 4, 1, 1, 1, 1, 1, - 2, 0, 4, 0, 2, 3, 1, 2, 3, 3, - 3, 3, 3, 1, 2, 2, 2, 1, 2, 2, - 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, - 1, 1, 1, 1, 0, 3, 2, 3, 3, 1, - 0, 1, 1, 3, 4, 0, 4, 0, 4, 0, - 4, 0, 2, 2, 1, 1, 1, 1, 1, 1, - 1, 1, 1, 1, 2, 1, 1, 2, 1, 3, - 0, 4, 1, 3, 1, 1, 1, 1, 1, 1, - 1, 1, 2, 0, 2, 3, 1, 2, 3, 1, - 2, 1, 2, 3, 1, 2, 3, 6, 1, 2, - 1, 3, 0, 2, 2, 0, 2, 4, 5, 0, - 3, 3, 5, 3, 4, 3, 3, 0, 4, 4, - 0, 3, 0, 2, 0, 2, 0, 5, 2, 2, - 0, 2, 1, 1, 1, 1, 1, 1, 1, 1, - 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, - 1, 5, 5, 6, 6, 4, 0, 1, 1, 1, - 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, - 1, 1, 1, 1, 1, 1, 1, 3, 0, 1, - 1, 1, 1, 1, 4, 1, 1, 1, 9, 0, - 1, 0, 4, 0, 4, 3, 3, 1, 0, 4, - 2, 3, 4, 4, 8, 8, 6, 1, 5, 0, - 1, 1, 0, 5, 2, 2, 2, 0, 5, 6, - 1, 0, 1, 2, 0, 2, 3, 1, 1, 3, - 1, 2, 4, 0, 5, 1, 1, 1, 1, 7, - 0, 2, 1, 2, 0, 2, 2, 1, 4, 3, - 1, 1, 3, 2, 2, 2, 3, 3, 4, 4, - 4, 4, 4, 0, 2, 2, 0, 2, 3, 1, - 2, 1, 1, 1, 1, 5, 0, 1, 1, 1, - 4, 4, 4, 4, 1, 6, 6, 7, 4, 6, - 4, 6, 4, 0, 6, 1, 2, 2, 0, 2, - 6, 2, 2, 3, 0, 10, 0, 1, 3, 0, - 3, 0, 2, 2, 0, 5, 3, 1, 1, 0, - 2, 2, 2, 1, 1, 1, 1, 1, 1, 1, - 1, 1, 5, 0, 1, 1, 4, 6, 9, 0, - 3, 0, 2, 0, 2, 3, 5, 5, 1, 1, - 1, 1, 3, 5, 0, 2, 1, 1, 1, 4, - 2, 2, 4, 1, 1, 1, 1, 1, 1, 1, - 4, 0, 2, 2, 2, 2, 1, 2, 0, 0, - 5, 0, 2, 2, 0, 5, 0, 2, 4, 3, - 4, 0, 1, 1, 1, 2, 4, 4, 4, 4, - 4, 4, 4, 4, 4, 4, 4, 11, 0, 1, - 1, 2, 4, 4, 4, 6, 4, 3, 4, 0, - 1, 1, 1, 2, 4, 4, 4, 4, 4, 4, - 6, 0, 0, 5, 0, 0, 2, 2, 3, 1, - 1, 1, 0, 4, 3, 2, 0, 1, 1, 1, - 1, 0, 2, 1, 2, 3, 1, 1, 1, 1, - 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, - 2, 1, 1, 1, 1, 1, 1, 1, 1, 1, - 6, 0, 2, 0, 4, 5, 0, 7, 2, 2, - 1, 3, 1, 1, 2, 1, 1, 1, 1, 1, - 1, 1, 1, 1, 1, 0, 1, 1, 2, 1, - 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, - 1, 1, 1, 1, 1, 1, 1, 2, 3, 3, - 0, 2, 0, 1, 2, 0, 4, 1, 2, 1, - 1, 1, 2, 0, 5, 0, 2, 1, 1, 3, - 3, 3, 1, 1, 1, 1, 1, 1, 1, 1, - 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, - 1, 3, 3, 4, 3, 3, 3, 4, 3, 3, - 1, 1, 1, 1, 1, 1, 2, 2, 2, 2, - 2, 2, 2, 2, 2, 2, 1, 1, 1, 1, - 1, 1, 1, 1, 0, 1, 1, 1, 1, 1, - 1, 0, 1, 3, 3, 6, 0, 2, 6, 8, - 7, 0, 2, 0, 2, 0, 2, 0, 3, 0, - 3, 0, 1, 0, 2, 0, 3, 1, 1, 1, - 1, 2, 4, 1, 1, 0, 1, 3, 1, 2, - 1, 2, 2, 0, 1, 1, 3, 1, 0, 5, - 1, 2, 3, 1, 0, 4, 2, 2, 2, 4, - 0, 0, 5, 0, 0, 5, 0, 0, 5, 0, - 2, 0, 6, 0, 2, 2, 2, 4, 1, 1, - 2, 2, 1, 1, 1, 1, 2, 1, 4, 2, - 1, 3, 2, 1, 1, 0, 2, 1, 1, 1, - 1, 1, 3, 3, 4, 4, 4, 3, 0, 2, - 0, 5, 3, 0, 2, 1, 1, 1, 1, 1, - 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, - 1, 3, 1, 1, 3, 3, 1, 1, 1, 0, - 2, 2, 0, 2, 0, 2, 2, 1, 3, 1, - 2, 1, 1, 1, 1, 4, 0, 3, 2, 1, - 1, 3, 4, 5, 4, 5, 1, 1, 0, 2, - 1, 1, 1, 6, 2, 3, 2, 0, 2, 1, - 2, 2, 4, 0, 1, 1, 1, 1, 2, 1, - 1, 2, 1, 4, 2, 0, 0, 5, 0, 1, - 2, 3, 1, 0, 4, 0, 0, 6, 3, 0, - 2, 2, 2, 1, 1, 2, 2, 1, 1, 1, - 1, 1, 1, 1, 3, 3, 3, 3, 1, 1, - 1, 1, 1, 1, 1, 1, 1, 1, 4, 1, - 1, 2, 3, 2, 2, 2, 3, 3, 3, 1, - 1, 1, 1, 1, 1, 1, 1, 2, 2, 2, - 1, 2, 1, 1, 1, 1, 1, 1, 1, 1, - 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, - 1, 1, 0, 2, 2, 1, 2, 1, 3, 3, - 2, 2, 1, 1, 1, 1, 1, 1, 1, 1, - 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, - 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, - 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, - 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, - 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, - 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, - 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, - 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, - 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, - 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, - 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, - 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, - 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, - 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, - 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, - 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, - 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, - 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, - 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, - 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, - 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, - 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, - 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, - 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, - 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, - 1, 1, 2, 3, 1, 2, 3, 3, 3, 1, - 2, 1, 2, 0, 1, 1, 1, 1, 1, 1, - 1, 2, 1, 1, 0, 1, 4, 0, 1, 1, - 4, 0, 1, 1, 3, 2, 0, 1, 0, 0, - 0, 12, 0, 4, 0, 0, 3, 0, 3, 1, - 2, 5, 0, 2, 2, 0, 3, 3, 4, 2, - 1, 3, 0, 5, 0, 1, 0, 2, 2, 0, - 0, 7, 0, 2, 1, 1, 2, 1, 1, 0, - 6, 0, 2, 2, 1, 0, 1, 0, 0, 3, - 0, 2, 2, 1, 1, 1, 1, 1, 1, 1, - 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, - 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, - 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, - 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, - 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, - 1, 1, 1, 1, 1, 1, 1, 2, 2, 0, - 4, 0, 4, 0, 5, 3, 3, 3, 3, 4, - 3, 4, 3, 3, 4, 4, 4, 3, 4, 3, - 4, 5, 3, 4, 3, 3, 2, 3, 1, 1, - 0, 3, 5, 4, 4, 1, 3, 3, 1, 1, - 0, 1, 1, 2, 1, 1, 1, 2, 3, 1, - 2, 1, 3, 1, 2, 2, 2, 2, 3, 3, - 3, 1, 1, 1, 2, 1, 1, 3, 1, 1, - 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, - 4, 1, 1, 1, 1, 4, 1, 2, 1, 1, - 3, 3, 3, 3, 3, 3, 4, 0, 1, 1, - 2, 1, 1, 1, 1, 1, 1, 1, 0, 1, - 0, 4, 4, 5, 6, 8, 0, 2, 0, 1, - 0, 3, 4, 5, 0, 2, 0, 2, 0, 3, - 1, 2, 4, 0, 2, 0, 4, 0, 9, 0, - 0, 4, 1, 1, 1, 0, 1, 1, 1, 1, - 1, 1, 1, 1, 2, 0, 2, 1, 1, 0, - 0, 3, 1, 2, 2, 3, 0, 2, 2, 2, - 0, 3, 2, 2, 4, 1, 1, 1, 1, 0, - 2, 2, 0, 1, 2, 2, 0, 1, 2, 0, - 1, 0, 3, 1, 2, 1, 1, 0, 3, 1, - 1, 2, 3, 0, 1, 3, 3, 2, 0, 4, - 0, 3, 0, 4, 4, 0, 1, 2, 0, 3, - 0, 0, 4, 0, 3, 2, 1, 0, 4, 4, - 2, 1, 2, 0, 1, 0, 3, 3, 0, 3, - 0, 2, 1, 2, 1, 0, 4, 3, 3, 3, - 3, 2, 1, 1, 1, 1, 1, 1, 2, 1, - 1, 2, 0, 3, 1, 1, 0, 2, 1, 2, - 1, 2, 1, 2, 1, 1, 2, 2, 2, 2, - 2, 1, 1, 0, 3, 2, 0, 3, 1, 2, - 1, 1, 1, 0, 5, 0, 1, 1, 2, 3, - 3, 3, 3, 2, 0, 0, 5, 1, 1, 0, - 0, 7, 0, 5, 1, 1, 1, 0, 1, 0, - 2, 1, 2, 1, 1, 2, 1, 2, 1, 5, - 1, 1, 1, 2, 1, 1, 0, 1, 1, 1, - 1, 0, 1, 3, 3, 1, 1, 4, 3, 1, - 2, 2, 1, 1, 2, 2, 1, 1, 1, 1, - 1, 1, 1, 1, 1, 3, 1, 3, 3, 3, - 3, 3, 0, 1, 0, 4, 4, 6, 6, 8, - 8, 0, 1, 0, 3, 0, 3, 0, 6, 4, - 1, 0, 4, 2, 1, 3, 1, 1, 1, 2, - 1, 1, 2, 2, 2, 2, 3, 3, 3, 0, - 3, 0, 4, 1, 3, 2, 1, 1, 1, 1, - 0, 2, 0, 1, 0, 3, 0, 2, 1, 2, - 1, 1, 1, 0, 2, 0, 3, 1, 0, 3, - 1, 0, 3, 3, 4, 0, 3, 2, 0, 6, - 5, 3, 2, 0, 1, 0, 0, 0, 1, 0, - 3, 5, 0, 2, 0, 3, 3, 0, 2, 1, - 2, 4, 1, 1, 1, 1, 1, 1, 1, 0, - 3, 0, 3, 1, 2, 0, 3, 2, 2, 0, - 3, 2, 1, 1, 1, 2, 1, 1, 1, 0, - 3, 2, 5, 1, 2, 2, 2, 1, 1, 1, - 2, 1, 2, 4, 2, 0, 1, 1, 1, 1, - 4, 0, 1, 1, 2, 2, 3, 3, 0, 5, - 0, 0, 9, 0, 2, 1, 2, 1, 0, 1, - 0, 5, 7, 0, 2, 0, 3, 0, 4, 2, - 2, 0, 1, 0, 3, 3, 4, 0, 4, 4, - 6, 0, 1, 0, 3, 1, 2, 6, 0, 1, - 1, 1, 1, 1, 0, 3, 0, 1, 1, 2, - 1, 2, 2, 1, 1, 1, 2, 1, 1, 1, - 1, 1, 3, 1, 1, 1, 1, 0, 3, 4, - 0, 6, 0, 5, 0, 1, 1, 1, 1, 3, - 0, 2, 1, 3, 3, 0, 3, 1, 1, 1, - 3, 6, 0, 2, 0, 3, 0, 3, 2, 1, - 1, 0, 4, 7, 0, 2, 0, 1, 2, 1, - 2, 3, 3, 1, 0, 1, 1, 4, 4, 2, - 0, 1, 1, 3, 2, 0, 3, 1, 1, 0, - 1, 1, 0, 4, 5, 1, 1, 0, 2, 2, - 0, 1, 2, 0, 1, 2, 0, 1, 0, 3, - 2, 1, 0, 4, 4, 0, 1, 0, 4, 5, - 0, 1, 2, 3, 0, 1, 2, 0, 4, 4, - 6, 0, 2, 0, 2, 1, 2, 3, 0, 1, - 0, 3, 2, 5, 0, 1, 2, 2, 2, 2, - 2, 0, 2, 0, 3, 1, 1, 1, 1, 1, - 1, 1, 1, 1, 1, 1, 1, 4, 3, 1, - 2, 2, 2, 2, 2, 2, 2, 2, 2, 4, - 7, 7, 3, 5, 4, 1, 2, 3, 1, 2, - 3, 3, 4, 4, 0, 3, 0, 7, 0, 5, - 0, 2, 0, 3, 0, 1, 0, 2, 4, 0, - 2, 4, 0, 4, 4, 0, 3, 0, 4, 1, - 1, 1, 2, 2, 2, 2, 1, 1, 2, 1, - 0, 1, 2, 0, 1, 1, 0, 4, 2, 2, - 0, 2, 1, 4, 4, 0, 1, 1, 1, 1, - 1, 1, 1, 0, 4, 5, 0, 2, 1, 2, - 2, 0, 3, 1, 1, 0, 4, 0, 1, 0, - 4, 4, 6, 6, 8, 0, 1, 2, 0, 1, - 0, 3, 1, 2, 0, 3, 5, 0, 3, 2, - 0, 4, 6, 0, 3, 1, 3, 2, 2, 2, - 3, 0, 3, 0, 3, 0, 1, 0, 3, 1, - 2, 0, 3, 1, 1, 1, 1, 1, 7, 0, - 1, 1, 1, 1, 1, 1, 4, 1, 2, 1, - 2, 3, 0, 1, 2, 1, 3, 1, 1, 4, - 1, 2, 2, 3, 1, 1, 0, 4, 6, 0, - 2, 0, 4, 3, 3, 1, 1, 0, 1, 1, - 0, 1, 0, 5, 0, 0, 12, 0, 1, 1, - 2, 2, 2, 1, 1, 0, 4, 0, 3, 0, - 3, 1, 2, 3, 0, 3, 1, 2, 3, 0, - 1, 1, 1, 1, 0, 2, 1, 2, 1, 2, - 2, 2, 2, 1, 1, 3, 0, 1, 0, 5, - 0, 10, 0, 3, 0, 2, 0, 3, 1, 2, - 0, 2, 2, 0, 1, 3, 1, 1, 0, 1, - 2, 1, 1, 0, 2, 2, 0, 1, 2, 0, - 1, 2, 0, 2, 2, 0, 1, 2, 0, 1, - 2, 0, 2, 2, 0, 1, 2, 0, 1, 2, - 0, 2, 2, 0, 1, 2, 0, 1, 2, 0, - 2, 2, 0, 1, 2, 0, 1, 2, 2, 2, - 2, 2, 0, 1, 2, 0, 1, 2, 2, 2, - 0, 1, 2, 0, 1, 2, 0, 1, 2, 2, - 0, 1, 2, 0, 1, 2, 0, 2, 0, 3, - 2, 1, 0, 2, 0, 3, 1, 1, 1, 0, - 2, 1, 2, 1, 2, 3, 3, 1, 1, 1, - 1, 1, 1, 1, 1, 1, 1, 0, 1, 1, - 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, - 1, 1, 1, 1, 1, 2, 1, 1, 1, 1, - 1, 1, 1, 3, 0, 1, 1, 3, 3, 1, - 3, 3, 1, 3, 1, 2, 2, 1, 3, 1, - 1, 3, 1, 3, 1, 3, 1, 2, 2, 1, - 1, 2, 1, 1, 2, 2, 3, 1, 1, 1, - 1, 2, 1, 1, 2, 1, 0, 2, 1, 1, - 1, 3, 1, 1, 2, 1, 0, 1, 1, 2, - 1, 1, 2, 1, 1, 1, 1, 1, 1, 1, - 2, 1, 1, 3, 0, 1, 1, 2, 1, 1, - 1, 1, 1, 1, 1, 2, 2, 2, 4, 3, - 1, 1, 1, 2, 1, 1, 1, 1, 1, 1, - 1, 2, 2, 2, 1, 1, 1, 2, 2, 2, - 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, - 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, - 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, - 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, - 1, 2, 1, 1, 1, 1, 1, 3, 2, 2, - 1, 1, 2, 1, 1, 3, 2, 2, 1, 1, - 1, 3, 0, 2, 1, 3, 3, 4, 5, 1, - 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, - 1, 1, 2, 1, 3, 1, 1, 1, 1, 1, - 1, 1, 1, 1, 1, 1, 2, 5, 5, 5, - 4, 5, 4, 5, 5, 5, 5, 5, 2, 2, - 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, - 1, 0, 4, 5, 0, 3, 2, 1, 3, 3, - 0, 2, 1, 3, 1, 3, 1, 3, 1, 3, - 0, 0, 1, 0, 3, 2, 0, 1, 0, 2, - 0, 2, 0, 1, 1, 0, 1, 0, 1, 2, - 0, 2, 0, 3, 1, 1, 1, 1, 1, 1, - 1, 1, 0, 2, 0, 5, 0, 3, 1, 1, - 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, - 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, - 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, - 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, - 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, - 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, - 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, - 1, 1, 1, 1, 1, 1, 0, 1, 0, 1, - 0, 1, 0, 1, 0, 1, 1, 0, 1, 0, - 1, 0, 1, 0, 1, 0, 1, 0, 1, 0, - 1, 0, 1, 0, 1, 0, 1, 0, 1, 0, - 1, 0, 1, 0, 3, 0, 1, 0, 1, 0, - 1, 0, 1, 0, 1, 0, 1, 1, 0, 1, - 2, 0, 1, 0, 1, 0, 1, 0, 1, 0, - 1, 0, 1, 1, 0, 1, 1, 0, 1, 1, - 1, 0, 1, 1, 0, 1, 0, 1, 0, 1, - 1, 0, 2, 2, 0, 1, 0, 1, 0, 1, - 0, 1, 0, 1, 0, 1, 1, 1, 0, 1, - 0, 1, 0, 1, 1, 0, 2, 1, 1, 0, - 1, 0, 1, 0, 1, 0, 1, 0, 1, 0, - 1, 0, 1, 1, 0, 1, 0, 1, 0, 1, - 0, 1, 2, 0, 1, 0, 1, 0, 1, 0, - 1, 0, 1, 0, 1, 0, 1, 0, 1, 0, - 1, 0, 1, 0, 1, 0, 3, 0, 1, 0, - 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, - 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, - 1, 1, 1, 1, 1, 1, 1, 1, 1, 2, - 2, 1, 1, 1, 1, 1, 1, 1, 1, 1, - 1, 1, 1, 2, 1, 2, 1, 2, 1, 2, - 1, 2, 1, 2, 1, 2, 2 -}; - - -#define yyerrok (yyerrstatus = 0) -#define yyclearin (yychar = YYEMPTY) -#define YYEMPTY (-2) -#define YYEOF 0 - -#define YYACCEPT goto yyacceptlab -#define YYABORT goto yyabortlab -#define YYERROR goto yyerrorlab - - -#define YYRECOVERING() (!!yyerrstatus) - -#define YYBACKUP(Token, Value) \ -do \ - if (yychar == YYEMPTY) \ - { \ - yychar = (Token); \ - yylval = (Value); \ - YYPOPSTACK (yylen); \ - yystate = *yyssp; \ - goto yybackup; \ - } \ - else \ - { \ - yyerror (YY_("syntax error: cannot back up")); \ - YYERROR; \ - } \ -while (0) - -/* Error token number */ -#define YYTERROR 1 -#define YYERRCODE 256 - - - -/* Enable debugging if requested. */ -#if YYDEBUG - -# ifndef YYFPRINTF -# include /* INFRINGES ON USER NAME SPACE */ -# define YYFPRINTF fprintf -# endif - -# define YYDPRINTF(Args) \ -do { \ - if (yydebug) \ - YYFPRINTF Args; \ -} while (0) - -/* This macro is provided for backward compatibility. */ -#ifndef YY_LOCATION_PRINT -# define YY_LOCATION_PRINT(File, Loc) ((void) 0) -#endif - - -# define YY_SYMBOL_PRINT(Title, Type, Value, Location) \ -do { \ - if (yydebug) \ - { \ - YYFPRINTF (stderr, "%s ", Title); \ - yy_symbol_print (stderr, \ - Type, Value); \ - YYFPRINTF (stderr, "\n"); \ - } \ -} while (0) - - -/*----------------------------------------. -| Print this symbol's value on YYOUTPUT. | -`----------------------------------------*/ - -static void -yy_symbol_value_print (FILE *yyoutput, int yytype, YYSTYPE const * const yyvaluep) -{ - FILE *yyo = yyoutput; - YYUSE (yyo); - if (!yyvaluep) - return; -# ifdef YYPRINT - if (yytype < YYNTOKENS) - YYPRINT (yyoutput, yytoknum[yytype], *yyvaluep); -# endif - YYUSE (yytype); -} - - -/*--------------------------------. -| Print this symbol on YYOUTPUT. | -`--------------------------------*/ - -static void -yy_symbol_print (FILE *yyoutput, int yytype, YYSTYPE const * const yyvaluep) -{ - YYFPRINTF (yyoutput, "%s %s (", - yytype < YYNTOKENS ? "token" : "nterm", yytname[yytype]); - - yy_symbol_value_print (yyoutput, yytype, yyvaluep); - YYFPRINTF (yyoutput, ")"); -} - -/*------------------------------------------------------------------. -| yy_stack_print -- Print the state stack from its BOTTOM up to its | -| TOP (included). | -`------------------------------------------------------------------*/ - -static void -yy_stack_print (yytype_int16 *yybottom, yytype_int16 *yytop) -{ - YYFPRINTF (stderr, "Stack now"); - for (; yybottom <= yytop; yybottom++) - { - int yybot = *yybottom; - YYFPRINTF (stderr, " %d", yybot); - } - YYFPRINTF (stderr, "\n"); -} - -# define YY_STACK_PRINT(Bottom, Top) \ -do { \ - if (yydebug) \ - yy_stack_print ((Bottom), (Top)); \ -} while (0) - - -/*------------------------------------------------. -| Report that the YYRULE is going to be reduced. | -`------------------------------------------------*/ - -static void -yy_reduce_print (yytype_int16 *yyssp, YYSTYPE *yyvsp, int yyrule) -{ - unsigned long int yylno = yyrline[yyrule]; - int yynrhs = yyr2[yyrule]; - int yyi; - YYFPRINTF (stderr, "Reducing stack by rule %d (line %lu):\n", - yyrule - 1, yylno); - /* The symbols being reduced. */ - for (yyi = 0; yyi < yynrhs; yyi++) - { - YYFPRINTF (stderr, " $%d = ", yyi + 1); - yy_symbol_print (stderr, - yystos[yyssp[yyi + 1 - yynrhs]], - &(yyvsp[(yyi + 1) - (yynrhs)]) - ); - YYFPRINTF (stderr, "\n"); - } -} - -# define YY_REDUCE_PRINT(Rule) \ -do { \ - if (yydebug) \ - yy_reduce_print (yyssp, yyvsp, Rule); \ -} while (0) - -/* Nonzero means print parse trace. It is left uninitialized so that - multiple parsers can coexist. */ -int yydebug; -#else /* !YYDEBUG */ -# define YYDPRINTF(Args) -# define YY_SYMBOL_PRINT(Title, Type, Value, Location) -# define YY_STACK_PRINT(Bottom, Top) -# define YY_REDUCE_PRINT(Rule) -#endif /* !YYDEBUG */ - - -/* YYINITDEPTH -- initial size of the parser's stacks. */ -#ifndef YYINITDEPTH -# define YYINITDEPTH 200 -#endif - -/* YYMAXDEPTH -- maximum size the stacks can grow to (effective only - if the built-in stack extension method is used). - - Do not make this value too large; the results are undefined if - YYSTACK_ALLOC_MAXIMUM < YYSTACK_BYTES (YYMAXDEPTH) - evaluated with infinite-precision integer arithmetic. */ - -#ifndef YYMAXDEPTH -# define YYMAXDEPTH 10000 -#endif - - -#if YYERROR_VERBOSE - -# ifndef yystrlen -# if defined __GLIBC__ && defined _STRING_H -# define yystrlen strlen -# else -/* Return the length of YYSTR. */ -static YYSIZE_T -yystrlen (const char *yystr) -{ - YYSIZE_T yylen; - for (yylen = 0; yystr[yylen]; yylen++) - continue; - return yylen; -} -# endif -# endif - -# ifndef yystpcpy -# if defined __GLIBC__ && defined _STRING_H && defined _GNU_SOURCE -# define yystpcpy stpcpy -# else -/* Copy YYSRC to YYDEST, returning the address of the terminating '\0' in - YYDEST. */ -static char * -yystpcpy (char *yydest, const char *yysrc) -{ - char *yyd = yydest; - const char *yys = yysrc; - - while ((*yyd++ = *yys++) != '\0') - continue; - - return yyd - 1; -} -# endif -# endif - -# ifndef yytnamerr -/* Copy to YYRES the contents of YYSTR after stripping away unnecessary - quotes and backslashes, so that it's suitable for yyerror. The - heuristic is that double-quoting is unnecessary unless the string - contains an apostrophe, a comma, or backslash (other than - backslash-backslash). YYSTR is taken from yytname. If YYRES is - null, do not copy; instead, return the length of what the result - would have been. */ -static YYSIZE_T -yytnamerr (char *yyres, const char *yystr) -{ - if (*yystr == '"') - { - YYSIZE_T yyn = 0; - char const *yyp = yystr; - - for (;;) - switch (*++yyp) - { - case '\'': - case ',': - goto do_not_strip_quotes; - - case '\\': - if (*++yyp != '\\') - goto do_not_strip_quotes; - /* Fall through. */ - default: - if (yyres) - yyres[yyn] = *yyp; - yyn++; - break; - - case '"': - if (yyres) - yyres[yyn] = '\0'; - return yyn; - } - do_not_strip_quotes: ; - } - - if (! yyres) - return yystrlen (yystr); - - return yystpcpy (yyres, yystr) - yyres; -} -# endif - -/* Copy into *YYMSG, which is of size *YYMSG_ALLOC, an error message - about the unexpected token YYTOKEN for the state stack whose top is - YYSSP. - - Return 0 if *YYMSG was successfully written. Return 1 if *YYMSG is - not large enough to hold the message. In that case, also set - *YYMSG_ALLOC to the required number of bytes. Return 2 if the - required number of bytes is too large to store. */ -static int -yysyntax_error (YYSIZE_T *yymsg_alloc, char **yymsg, - yytype_int16 *yyssp, int yytoken) -{ - YYSIZE_T yysize0 = yytnamerr (YY_NULLPTR, yytname[yytoken]); - YYSIZE_T yysize = yysize0; - enum { YYERROR_VERBOSE_ARGS_MAXIMUM = 5 }; - /* Internationalized format string. */ - const char *yyformat = YY_NULLPTR; - /* Arguments of yyformat. */ - char const *yyarg[YYERROR_VERBOSE_ARGS_MAXIMUM]; - /* Number of reported tokens (one for the "unexpected", one per - "expected"). */ - int yycount = 0; - - /* There are many possibilities here to consider: - - If this state is a consistent state with a default action, then - the only way this function was invoked is if the default action - is an error action. In that case, don't check for expected - tokens because there are none. - - The only way there can be no lookahead present (in yychar) is if - this state is a consistent state with a default action. Thus, - detecting the absence of a lookahead is sufficient to determine - that there is no unexpected or expected token to report. In that - case, just report a simple "syntax error". - - Don't assume there isn't a lookahead just because this state is a - consistent state with a default action. There might have been a - previous inconsistent state, consistent state with a non-default - action, or user semantic action that manipulated yychar. - - Of course, the expected token list depends on states to have - correct lookahead information, and it depends on the parser not - to perform extra reductions after fetching a lookahead from the - scanner and before detecting a syntax error. Thus, state merging - (from LALR or IELR) and default reductions corrupt the expected - token list. However, the list is correct for canonical LR with - one exception: it will still contain any token that will not be - accepted due to an error action in a later state. - */ - if (yytoken != YYEMPTY) - { - int yyn = yypact[*yyssp]; - yyarg[yycount++] = yytname[yytoken]; - if (!yypact_value_is_default (yyn)) - { - /* Start YYX at -YYN if negative to avoid negative indexes in - YYCHECK. In other words, skip the first -YYN actions for - this state because they are default actions. */ - int yyxbegin = yyn < 0 ? -yyn : 0; - /* Stay within bounds of both yycheck and yytname. */ - int yychecklim = YYLAST - yyn + 1; - int yyxend = yychecklim < YYNTOKENS ? yychecklim : YYNTOKENS; - int yyx; - - for (yyx = yyxbegin; yyx < yyxend; ++yyx) - if (yycheck[yyx + yyn] == yyx && yyx != YYTERROR - && !yytable_value_is_error (yytable[yyx + yyn])) - { - if (yycount == YYERROR_VERBOSE_ARGS_MAXIMUM) - { - yycount = 1; - yysize = yysize0; - break; - } - yyarg[yycount++] = yytname[yyx]; - { - YYSIZE_T yysize1 = yysize + yytnamerr (YY_NULLPTR, yytname[yyx]); - if (! (yysize <= yysize1 - && yysize1 <= YYSTACK_ALLOC_MAXIMUM)) - return 2; - yysize = yysize1; - } - } - } - } - - switch (yycount) - { -# define YYCASE_(N, S) \ - case N: \ - yyformat = S; \ - break - YYCASE_(0, YY_("syntax error")); - YYCASE_(1, YY_("syntax error, unexpected %s")); - YYCASE_(2, YY_("syntax error, unexpected %s, expecting %s")); - YYCASE_(3, YY_("syntax error, unexpected %s, expecting %s or %s")); - YYCASE_(4, YY_("syntax error, unexpected %s, expecting %s or %s or %s")); - YYCASE_(5, YY_("syntax error, unexpected %s, expecting %s or %s or %s or %s")); -# undef YYCASE_ - } - - { - YYSIZE_T yysize1 = yysize + yystrlen (yyformat); - if (! (yysize <= yysize1 && yysize1 <= YYSTACK_ALLOC_MAXIMUM)) - return 2; - yysize = yysize1; - } - - if (*yymsg_alloc < yysize) - { - *yymsg_alloc = 2 * yysize; - if (! (yysize <= *yymsg_alloc - && *yymsg_alloc <= YYSTACK_ALLOC_MAXIMUM)) - *yymsg_alloc = YYSTACK_ALLOC_MAXIMUM; - return 1; - } - - /* Avoid sprintf, as that infringes on the user's name space. - Don't have undefined behavior even if the translation - produced a string with the wrong number of "%s"s. */ - { - char *yyp = *yymsg; - int yyi = 0; - while ((*yyp = *yyformat) != '\0') - if (*yyp == '%' && yyformat[1] == 's' && yyi < yycount) - { - yyp += yytnamerr (yyp, yyarg[yyi++]); - yyformat += 2; - } - else - { - yyp++; - yyformat++; - } - } - return 0; -} -#endif /* YYERROR_VERBOSE */ - -/*-----------------------------------------------. -| Release the memory associated to this symbol. | -`-----------------------------------------------*/ - -static void -yydestruct (const char *yymsg, int yytype, YYSTYPE *yyvaluep) -{ - YYUSE (yyvaluep); - if (!yymsg) - yymsg = "Deleting"; - YY_SYMBOL_PRINT (yymsg, yytype, yyvaluep, yylocationp); - - YY_IGNORE_MAYBE_UNINITIALIZED_BEGIN - YYUSE (yytype); - YY_IGNORE_MAYBE_UNINITIALIZED_END -} - - - - -/* The lookahead symbol. */ -int yychar; - -/* The semantic value of the lookahead symbol. */ -YYSTYPE yylval; -/* Number of syntax errors so far. */ -int yynerrs; - - -/*----------. -| yyparse. | -`----------*/ - -int -yyparse (void) -{ - int yystate; - /* Number of tokens to shift before error messages enabled. */ - int yyerrstatus; - - /* The stacks and their tools: - 'yyss': related to states. - 'yyvs': related to semantic values. - - Refer to the stacks through separate pointers, to allow yyoverflow - to reallocate them elsewhere. */ - - /* The state stack. */ - yytype_int16 yyssa[YYINITDEPTH]; - yytype_int16 *yyss; - yytype_int16 *yyssp; - - /* The semantic value stack. */ - YYSTYPE yyvsa[YYINITDEPTH]; - YYSTYPE *yyvs; - YYSTYPE *yyvsp; - - YYSIZE_T yystacksize; - - int yyn; - int yyresult; - /* Lookahead token as an internal (translated) token number. */ - int yytoken = 0; - /* The variables used to return semantic value and location from the - action routines. */ - YYSTYPE yyval; - -#if YYERROR_VERBOSE - /* Buffer for error messages, and its allocated size. */ - char yymsgbuf[128]; - char *yymsg = yymsgbuf; - YYSIZE_T yymsg_alloc = sizeof yymsgbuf; -#endif - -#define YYPOPSTACK(N) (yyvsp -= (N), yyssp -= (N)) - - /* The number of symbols on the RHS of the reduced rule. - Keep to zero when no symbol should be popped. */ - int yylen = 0; - - yyssp = yyss = yyssa; - yyvsp = yyvs = yyvsa; - yystacksize = YYINITDEPTH; - - YYDPRINTF ((stderr, "Starting parse\n")); - - yystate = 0; - yyerrstatus = 0; - yynerrs = 0; - yychar = YYEMPTY; /* Cause a token to be read. */ - goto yysetstate; - -/*------------------------------------------------------------. -| yynewstate -- Push a new state, which is found in yystate. | -`------------------------------------------------------------*/ - yynewstate: - /* In all cases, when you get here, the value and location stacks - have just been pushed. So pushing a state here evens the stacks. */ - yyssp++; - - yysetstate: - *yyssp = yystate; - - if (yyss + yystacksize - 1 <= yyssp) - { - /* Get the current used size of the three stacks, in elements. */ - YYSIZE_T yysize = yyssp - yyss + 1; - -#ifdef yyoverflow - { - /* Give user a chance to reallocate the stack. Use copies of - these so that the &'s don't force the real ones into - memory. */ - YYSTYPE *yyvs1 = yyvs; - yytype_int16 *yyss1 = yyss; - - /* Each stack pointer address is followed by the size of the - data in use in that stack, in bytes. This used to be a - conditional around just the two extra args, but that might - be undefined if yyoverflow is a macro. */ - yyoverflow (YY_("memory exhausted"), - &yyss1, yysize * sizeof (*yyssp), - &yyvs1, yysize * sizeof (*yyvsp), - &yystacksize); - - yyss = yyss1; - yyvs = yyvs1; - } -#else /* no yyoverflow */ -# ifndef YYSTACK_RELOCATE - goto yyexhaustedlab; -# else - /* Extend the stack our own way. */ - if (YYMAXDEPTH <= yystacksize) - goto yyexhaustedlab; - yystacksize *= 2; - if (YYMAXDEPTH < yystacksize) - yystacksize = YYMAXDEPTH; - - { - yytype_int16 *yyss1 = yyss; - union yyalloc *yyptr = - (union yyalloc *) YYSTACK_ALLOC (YYSTACK_BYTES (yystacksize)); - if (! yyptr) - goto yyexhaustedlab; - YYSTACK_RELOCATE (yyss_alloc, yyss); - YYSTACK_RELOCATE (yyvs_alloc, yyvs); -# undef YYSTACK_RELOCATE - if (yyss1 != yyssa) - YYSTACK_FREE (yyss1); - } -# endif -#endif /* no yyoverflow */ - - yyssp = yyss + yysize - 1; - yyvsp = yyvs + yysize - 1; - - YYDPRINTF ((stderr, "Stack size increased to %lu\n", - (unsigned long int) yystacksize)); - - if (yyss + yystacksize - 1 <= yyssp) - YYABORT; - } - - YYDPRINTF ((stderr, "Entering state %d\n", yystate)); - - if (yystate == YYFINAL) - YYACCEPT; - - goto yybackup; - -/*-----------. -| yybackup. | -`-----------*/ -yybackup: - - /* Do appropriate processing given the current state. Read a - lookahead token if we need one and don't already have one. */ - - /* First try to decide what to do without reference to lookahead token. */ - yyn = yypact[yystate]; - if (yypact_value_is_default (yyn)) - goto yydefault; - - /* Not known => get a lookahead token if don't already have one. */ - - /* YYCHAR is either YYEMPTY or YYEOF or a valid lookahead symbol. */ - if (yychar == YYEMPTY) - { - YYDPRINTF ((stderr, "Reading a token: ")); - yychar = yylex (); - } - - if (yychar <= YYEOF) - { - yychar = yytoken = YYEOF; - YYDPRINTF ((stderr, "Now at end of input.\n")); - } - else - { - yytoken = YYTRANSLATE (yychar); - YY_SYMBOL_PRINT ("Next token is", yytoken, &yylval, &yylloc); - } - - /* If the proper action on seeing token YYTOKEN is to reduce or to - detect an error, take that action. */ - yyn += yytoken; - if (yyn < 0 || YYLAST < yyn || yycheck[yyn] != yytoken) - goto yydefault; - yyn = yytable[yyn]; - if (yyn <= 0) - { - if (yytable_value_is_error (yyn)) - goto yyerrlab; - yyn = -yyn; - goto yyreduce; - } - - /* Count tokens shifted since error; after three, turn off error - status. */ - if (yyerrstatus) - yyerrstatus--; - - /* Shift the lookahead token. */ - YY_SYMBOL_PRINT ("Shifting", yytoken, &yylval, &yylloc); - - /* Discard the shifted token. */ - yychar = YYEMPTY; - - yystate = yyn; - YY_IGNORE_MAYBE_UNINITIALIZED_BEGIN - *++yyvsp = yylval; - YY_IGNORE_MAYBE_UNINITIALIZED_END - - goto yynewstate; - - -/*-----------------------------------------------------------. -| yydefault -- do the default action for the current state. | -`-----------------------------------------------------------*/ -yydefault: - yyn = yydefact[yystate]; - if (yyn == 0) - goto yyerrlab; - goto yyreduce; - - -/*-----------------------------. -| yyreduce -- Do a reduction. | -`-----------------------------*/ -yyreduce: - /* yyn is the number of a rule to reduce with. */ - yylen = yyr2[yyn]; - - /* If YYLEN is nonzero, implement the default value of the action: - '$$ = $1'. - - Otherwise, the following line sets YYVAL to garbage. - This behavior is undocumented and Bison - users should not rely upon it. Assigning to YYVAL - unconditionally makes the parser a bit smaller, and it avoids a - GCC warning that YYVAL may be used uninitialized. */ - yyval = yyvsp[1-yylen]; - - - YY_REDUCE_PRINT (yyn); - switch (yyn) - { - case 2: -#line 3170 "parser.y" /* yacc.c:1646 */ - { - clear_initial_values (); - current_program = NULL; - defined_prog_list = NULL; - cobc_cs_check = 0; - main_flag_set = 0; - current_program = cb_build_program (NULL, 0); - cb_set_intr_when_compiled (); - cb_build_registers (); - cb_add_external_defined_registers (); - } -#line 12266 "parser.c" /* yacc.c:1646 */ - break; - - case 3: -#line 3182 "parser.y" /* yacc.c:1646 */ - { - if (!current_program->flag_validated) { - current_program->flag_validated = 1; - cb_validate_program_body (current_program); - } - if (depth > 1) { - cb_error (_("multiple PROGRAM-ID's without matching END PROGRAM")); - } - if (cobc_flag_main && !main_flag_set) { - cb_error (_("executable requested but no program found")); - } - if (errorcount > 0) { - YYABORT; - } - if (!current_program->entry_list) { - backup_current_pos (); - emit_entry (current_program->program_id, 0, NULL, NULL); - } - } -#line 12290 "parser.c" /* yacc.c:1646 */ - break; - - case 6: -#line 3209 "parser.y" /* yacc.c:1646 */ - { - first_prog = 1; - depth = 0; - setup_from_identification = 0; - } -#line 12300 "parser.c" /* yacc.c:1646 */ - break; - - case 12: -#line 3228 "parser.y" /* yacc.c:1646 */ - { - program_init_without_program_id (); - } -#line 12308 "parser.c" /* yacc.c:1646 */ - break; - - case 13: -#line 3233 "parser.y" /* yacc.c:1646 */ - { - backup_current_pos (); - clean_up_program (NULL, COB_MODULE_TYPE_PROGRAM); - } -#line 12317 "parser.c" /* yacc.c:1646 */ - break; - - case 16: -#line 3259 "parser.y" /* yacc.c:1646 */ - { - backup_current_pos (); - clean_up_program (NULL, COB_MODULE_TYPE_PROGRAM); - } -#line 12326 "parser.c" /* yacc.c:1646 */ - break; - - case 20: -#line 3273 "parser.y" /* yacc.c:1646 */ - { - backup_current_pos (); - } -#line 12334 "parser.c" /* yacc.c:1646 */ - break; - - case 21: -#line 3277 "parser.y" /* yacc.c:1646 */ - { - first_nested_program = 0; - clean_up_program ((yyvsp[-1]), COB_MODULE_TYPE_PROGRAM); - } -#line 12343 "parser.c" /* yacc.c:1646 */ - break; - - case 22: -#line 3285 "parser.y" /* yacc.c:1646 */ - { - backup_current_pos (); - } -#line 12351 "parser.c" /* yacc.c:1646 */ - break; - - case 23: -#line 3289 "parser.y" /* yacc.c:1646 */ - { - clean_up_program ((yyvsp[-1]), COB_MODULE_TYPE_FUNCTION); - } -#line 12359 "parser.c" /* yacc.c:1646 */ - break; - - case 24: -#line 3299 "parser.y" /* yacc.c:1646 */ - { - cb_validate_program_environment (current_program); - } -#line 12367 "parser.c" /* yacc.c:1646 */ - break; - - case 25: -#line 3303 "parser.y" /* yacc.c:1646 */ - { - /* note: - we also validate all references we found so far here */ - cb_validate_program_data (current_program); - } -#line 12377 "parser.c" /* yacc.c:1646 */ - break; - - case 29: -#line 3320 "parser.y" /* yacc.c:1646 */ - { - setup_program_start (); - setup_from_identification = 1; - } -#line 12386 "parser.c" /* yacc.c:1646 */ - break; - - case 32: -#line 3333 "parser.y" /* yacc.c:1646 */ - { - cobc_in_id = 1; - } -#line 12394 "parser.c" /* yacc.c:1646 */ - break; - - case 33: -#line 3337 "parser.y" /* yacc.c:1646 */ - { - if (setup_program ((yyvsp[-1]), (yyvsp[0]), COB_MODULE_TYPE_PROGRAM)) { - YYABORT; - } - - setup_prototype ((yyvsp[-1]), (yyvsp[0]), COB_MODULE_TYPE_PROGRAM, 1); - } -#line 12406 "parser.c" /* yacc.c:1646 */ - break; - - case 34: -#line 3345 "parser.y" /* yacc.c:1646 */ - { - cobc_cs_check = 0; - cobc_in_id = 0; - } -#line 12415 "parser.c" /* yacc.c:1646 */ - break; - - case 35: -#line 3353 "parser.y" /* yacc.c:1646 */ - { - cobc_in_id = 1; - } -#line 12423 "parser.c" /* yacc.c:1646 */ - break; - - case 36: -#line 3357 "parser.y" /* yacc.c:1646 */ - { - if (setup_program ((yyvsp[-3]), (yyvsp[-2]), COB_MODULE_TYPE_FUNCTION)) { - YYABORT; - } - setup_prototype ((yyvsp[-3]), (yyvsp[-2]), COB_MODULE_TYPE_FUNCTION, 1); - cobc_cs_check = 0; - cobc_in_id = 0; - } -#line 12436 "parser.c" /* yacc.c:1646 */ - break; - - case 37: -#line 3369 "parser.y" /* yacc.c:1646 */ - { - if (CB_REFERENCE_P ((yyvsp[0])) && CB_WORD_COUNT ((yyvsp[0])) > 0) { - redefinition_error ((yyvsp[0])); - } - /* - The program name is a key part of defining the current_program, so we - mustn't lose it (unlike in undefined_word). - */ - (yyval) = (yyvsp[0]); - } -#line 12451 "parser.c" /* yacc.c:1646 */ - break; - - case 38: -#line 3380 "parser.y" /* yacc.c:1646 */ - { - cb_trim_program_id ((yyvsp[0])); - } -#line 12459 "parser.c" /* yacc.c:1646 */ - break; - - case 40: -#line 3388 "parser.y" /* yacc.c:1646 */ - { - cb_trim_program_id ((yyvsp[0])); - } -#line 12467 "parser.c" /* yacc.c:1646 */ - break; - - case 41: -#line 3394 "parser.y" /* yacc.c:1646 */ - { (yyval) = NULL; } -#line 12473 "parser.c" /* yacc.c:1646 */ - break; - - case 42: -#line 3395 "parser.y" /* yacc.c:1646 */ - { (yyval) = (yyvsp[0]); } -#line 12479 "parser.c" /* yacc.c:1646 */ - break; - - case 46: -#line 3406 "parser.y" /* yacc.c:1646 */ - { - if (!current_program->nested_level) { - cb_error (_("COMMON may only be used in a contained program")); - } else { - current_program->flag_common = 1; - cb_add_common_prog (current_program); - } - } -#line 12492 "parser.c" /* yacc.c:1646 */ - break; - - case 47: -#line 3415 "parser.y" /* yacc.c:1646 */ - { - if (!current_program->nested_level) { - cb_error (_("COMMON may only be used in a contained program")); - } else { - current_program->flag_common = 1; - cb_add_common_prog (current_program); - } - } -#line 12505 "parser.c" /* yacc.c:1646 */ - break; - - case 49: -#line 3425 "parser.y" /* yacc.c:1646 */ - { - CB_PENDING (_("CALL prototypes")); - } -#line 12513 "parser.c" /* yacc.c:1646 */ - break; - - case 52: -#line 3437 "parser.y" /* yacc.c:1646 */ - { - current_program->flag_initial = 1; - } -#line 12521 "parser.c" /* yacc.c:1646 */ - break; - - case 53: -#line 3441 "parser.y" /* yacc.c:1646 */ - { - current_program->flag_recursive = 1; - } -#line 12529 "parser.c" /* yacc.c:1646 */ - break; - - case 54: -#line 3445 "parser.y" /* yacc.c:1646 */ - { - current_program->flag_resident = 1; - } -#line 12537 "parser.c" /* yacc.c:1646 */ - break; - - case 57: -#line 3457 "parser.y" /* yacc.c:1646 */ - { - CB_PENDING (_("CALL prototypes")); - } -#line 12545 "parser.c" /* yacc.c:1646 */ - break; - - case 59: -#line 3466 "parser.y" /* yacc.c:1646 */ - { - cobc_cs_check = 0; - } -#line 12553 "parser.c" /* yacc.c:1646 */ - break; - - case 63: -#line 3486 "parser.y" /* yacc.c:1646 */ - { -/* FIXME: the IBM-compatible ARITHMETIC should only be disabled - for the specified program (and its nested programs) - note: ibm-strict.conf has no OPTIONS paragraph, but ibm.conf does */ - cb_arithmetic_osvs = 0; - } -#line 12564 "parser.c" /* yacc.c:1646 */ - break; - - case 64: -#line 3493 "parser.y" /* yacc.c:1646 */ - { - CB_PENDING ("STANDARD ARITHMETIC"); - } -#line 12572 "parser.c" /* yacc.c:1646 */ - break; - - case 65: -#line 3497 "parser.y" /* yacc.c:1646 */ - { - CB_PENDING ("STANDARD-BINARY ARITHMETIC"); - } -#line 12580 "parser.c" /* yacc.c:1646 */ - break; - - case 66: -#line 3501 "parser.y" /* yacc.c:1646 */ - { - CB_PENDING ("STANDARD-DECIMAL ARITHMETIC"); - } -#line 12588 "parser.c" /* yacc.c:1646 */ - break; - - case 67: -#line 3516 "parser.y" /* yacc.c:1646 */ - { - default_rounded_mode = cb_int (COB_STORE_ROUND); - } -#line 12596 "parser.c" /* yacc.c:1646 */ - break; - - case 68: -#line 3520 "parser.y" /* yacc.c:1646 */ - { - if ((yyvsp[0])) { - default_rounded_mode = (yyvsp[0]); - } else { - default_rounded_mode = cb_int (COB_STORE_ROUND); - } - } -#line 12608 "parser.c" /* yacc.c:1646 */ - break; - - case 70: -#line 3532 "parser.y" /* yacc.c:1646 */ - { - current_program->entry_convention = (yyvsp[0]); - } -#line 12616 "parser.c" /* yacc.c:1646 */ - break; - - case 71: -#line 3539 "parser.y" /* yacc.c:1646 */ - { - (yyval) = cb_int (CB_CONV_COBOL); - } -#line 12624 "parser.c" /* yacc.c:1646 */ - break; - - case 72: -#line 3543 "parser.y" /* yacc.c:1646 */ - { - (yyval) = cb_int0; - } -#line 12632 "parser.c" /* yacc.c:1646 */ - break; - - case 73: -#line 3547 "parser.y" /* yacc.c:1646 */ - { - (yyval) = cb_int (CB_CONV_STDCALL); - } -#line 12640 "parser.c" /* yacc.c:1646 */ - break; - - case 75: -#line 3555 "parser.y" /* yacc.c:1646 */ - { - CB_PENDING ("INTERMEDIATE ROUNDING"); - } -#line 12648 "parser.c" /* yacc.c:1646 */ - break; - - case 76: -#line 3562 "parser.y" /* yacc.c:1646 */ - { - (yyval) = cb_int (COB_STORE_ROUND | COB_STORE_NEAR_AWAY_FROM_ZERO); - } -#line 12656 "parser.c" /* yacc.c:1646 */ - break; - - case 77: -#line 3566 "parser.y" /* yacc.c:1646 */ - { - (yyval) = cb_int (COB_STORE_ROUND | COB_STORE_NEAR_EVEN); - } -#line 12664 "parser.c" /* yacc.c:1646 */ - break; - - case 78: -#line 3570 "parser.y" /* yacc.c:1646 */ - { - (yyval) = cb_int (COB_STORE_ROUND | COB_STORE_PROHIBITED); - } -#line 12672 "parser.c" /* yacc.c:1646 */ - break; - - case 79: -#line 3574 "parser.y" /* yacc.c:1646 */ - { - (yyval) = cb_int (COB_STORE_ROUND | COB_STORE_TRUNCATION); - } -#line 12680 "parser.c" /* yacc.c:1646 */ - break; - - case 82: -#line 3589 "parser.y" /* yacc.c:1646 */ - { - header_check |= COBC_HD_ENVIRONMENT_DIVISION; - } -#line 12688 "parser.c" /* yacc.c:1646 */ - break; - - case 85: -#line 3603 "parser.y" /* yacc.c:1646 */ - { - check_headers_present (COBC_HD_ENVIRONMENT_DIVISION, 0, 0, 0); - header_check |= COBC_HD_CONFIGURATION_SECTION; - if (current_program->nested_level) { - cb_error (_("%s not allowed in nested programs"), "CONFIGURATION SECTION"); - } - } -#line 12700 "parser.c" /* yacc.c:1646 */ - break; - - case 95: -#line 3634 "parser.y" /* yacc.c:1646 */ - { - check_headers_present (COBC_HD_ENVIRONMENT_DIVISION, - COBC_HD_CONFIGURATION_SECTION, 0, 0); - check_conf_section_order (COBC_HD_SOURCE_COMPUTER); - set_conf_section_part (COBC_HD_SOURCE_COMPUTER); - } -#line 12711 "parser.c" /* yacc.c:1646 */ - break; - - case 100: -#line 3650 "parser.y" /* yacc.c:1646 */ - { - current_program->flag_debugging = 1; - needs_debug_item = 1; - cobc_cs_check = 0; - cb_build_debug_item (); - } -#line 12722 "parser.c" /* yacc.c:1646 */ - break; - - case 101: -#line 3662 "parser.y" /* yacc.c:1646 */ - { - check_headers_present (COBC_HD_ENVIRONMENT_DIVISION, - COBC_HD_CONFIGURATION_SECTION, 0, 0); - check_conf_section_order (COBC_HD_OBJECT_COMPUTER); - set_conf_section_part (COBC_HD_OBJECT_COMPUTER); - } -#line 12733 "parser.c" /* yacc.c:1646 */ - break; - - case 102: -#line 3669 "parser.y" /* yacc.c:1646 */ - { - cobc_cs_check = 0; - } -#line 12741 "parser.c" /* yacc.c:1646 */ - break; - - case 113: -#line 3695 "parser.y" /* yacc.c:1646 */ - { - cb_verify (cb_memory_size_clause, "MEMORY SIZE"); - } -#line 12749 "parser.c" /* yacc.c:1646 */ - break; - - case 114: -#line 3703 "parser.y" /* yacc.c:1646 */ - { - current_program->collating_sequence = alphanumeric_collation; - current_program->collating_sequence_n = national_collation; - } -#line 12758 "parser.c" /* yacc.c:1646 */ - break; - - case 115: -#line 3711 "parser.y" /* yacc.c:1646 */ - { - alphanumeric_collation = national_collation = NULL; - } -#line 12766 "parser.c" /* yacc.c:1646 */ - break; - - case 117: -#line 3719 "parser.y" /* yacc.c:1646 */ - { - alphanumeric_collation = (yyvsp[0]); - } -#line 12774 "parser.c" /* yacc.c:1646 */ - break; - - case 118: -#line 3723 "parser.y" /* yacc.c:1646 */ - { - alphanumeric_collation = (yyvsp[-1]); - CB_PENDING_X ((yyvsp[0]), "NATIONAL COLLATING SEQUENCE"); - national_collation = (yyvsp[0]); - } -#line 12784 "parser.c" /* yacc.c:1646 */ - break; - - case 119: -#line 3729 "parser.y" /* yacc.c:1646 */ - { - alphanumeric_collation = (yyvsp[0]); - } -#line 12792 "parser.c" /* yacc.c:1646 */ - break; - - case 120: -#line 3733 "parser.y" /* yacc.c:1646 */ - { - CB_PENDING_X ((yyvsp[0]), "NATIONAL COLLATING SEQUENCE"); - national_collation = (yyvsp[0]); - } -#line 12801 "parser.c" /* yacc.c:1646 */ - break; - - case 121: -#line 3739 "parser.y" /* yacc.c:1646 */ - { - alphanumeric_collation = (yyvsp[-4]); - CB_PENDING_X ((yyvsp[0]), "NATIONAL COLLATING SEQUENCE"); - national_collation = (yyvsp[0]); - } -#line 12811 "parser.c" /* yacc.c:1646 */ - break; - - case 122: -#line 3746 "parser.y" /* yacc.c:1646 */ - { - CB_PENDING_X ((yyvsp[-4]), "NATIONAL COLLATING SEQUENCE"); - national_collation = (yyvsp[-4]); - alphanumeric_collation = (yyvsp[0]); - } -#line 12821 "parser.c" /* yacc.c:1646 */ - break; - - case 123: -#line 3755 "parser.y" /* yacc.c:1646 */ - { - int segnum; - - if (cb_verify (cb_section_segments, "SEGMENT LIMIT")) { - segnum = cb_get_int ((yyvsp[0])); - if (segnum == 0 || segnum > 49) { - cb_error (_("segment-number must be in range of values 1 to 49")); - (yyval) = NULL; - } - } - /* Ignore */ - } -#line 12838 "parser.c" /* yacc.c:1646 */ - break; - - case 124: -#line 3771 "parser.y" /* yacc.c:1646 */ - { - if (current_program->classification) { - cb_error (_("duplicate CLASSIFICATION clause")); - } else { - current_program->classification = (yyvsp[0]); - } - } -#line 12850 "parser.c" /* yacc.c:1646 */ - break; - - case 125: -#line 3782 "parser.y" /* yacc.c:1646 */ - { - (yyval) = (yyvsp[0]); - } -#line 12858 "parser.c" /* yacc.c:1646 */ - break; - - case 126: -#line 3786 "parser.y" /* yacc.c:1646 */ - { - (yyval) = NULL; - } -#line 12866 "parser.c" /* yacc.c:1646 */ - break; - - case 127: -#line 3790 "parser.y" /* yacc.c:1646 */ - { - (yyval) = cb_int1; - } -#line 12874 "parser.c" /* yacc.c:1646 */ - break; - - case 128: -#line 3794 "parser.y" /* yacc.c:1646 */ - { - (yyval) = cb_int1; - } -#line 12882 "parser.c" /* yacc.c:1646 */ - break; - - case 131: -#line 3808 "parser.y" /* yacc.c:1646 */ - { - check_headers_present (COBC_HD_ENVIRONMENT_DIVISION, - COBC_HD_CONFIGURATION_SECTION, 0, 0); - check_conf_section_order (COBC_HD_REPOSITORY); - set_conf_section_part (COBC_HD_REPOSITORY); - } -#line 12893 "parser.c" /* yacc.c:1646 */ - break; - - case 132: -#line 3815 "parser.y" /* yacc.c:1646 */ - { - cobc_in_repository = 0; - } -#line 12901 "parser.c" /* yacc.c:1646 */ - break; - - case 135: -#line 3824 "parser.y" /* yacc.c:1646 */ - { - yyerrok; - } -#line 12909 "parser.c" /* yacc.c:1646 */ - break; - - case 138: -#line 3836 "parser.y" /* yacc.c:1646 */ - { - functions_are_all = 1; - } -#line 12917 "parser.c" /* yacc.c:1646 */ - break; - - case 139: -#line 3840 "parser.y" /* yacc.c:1646 */ - { - if ((yyvsp[-1]) != cb_error_node) { - setup_prototype ((yyvsp[-1]), (yyvsp[0]), COB_MODULE_TYPE_FUNCTION, 0); - } - } -#line 12927 "parser.c" /* yacc.c:1646 */ - break; - - case 141: -#line 3847 "parser.y" /* yacc.c:1646 */ - { - if ((yyvsp[-1]) != cb_error_node - && cb_verify (cb_program_prototypes, _("PROGRAM phrase"))) { - setup_prototype ((yyvsp[-1]), (yyvsp[0]), COB_MODULE_TYPE_PROGRAM, 0); - } - } -#line 12938 "parser.c" /* yacc.c:1646 */ - break; - - case 142: -#line 3854 "parser.y" /* yacc.c:1646 */ - { - yyerrok; - } -#line 12946 "parser.c" /* yacc.c:1646 */ - break; - - case 143: -#line 3861 "parser.y" /* yacc.c:1646 */ - { - current_program->function_spec_list = - cb_list_add (current_program->function_spec_list, (yyvsp[0])); - } -#line 12955 "parser.c" /* yacc.c:1646 */ - break; - - case 144: -#line 3866 "parser.y" /* yacc.c:1646 */ - { - current_program->function_spec_list = - cb_list_add (current_program->function_spec_list, (yyvsp[0])); - } -#line 12964 "parser.c" /* yacc.c:1646 */ - break; - - case 145: -#line 3877 "parser.y" /* yacc.c:1646 */ - { - check_duplicate = 0; - check_headers_present (COBC_HD_ENVIRONMENT_DIVISION, - COBC_HD_CONFIGURATION_SECTION, 0, 0); - check_conf_section_order (COBC_HD_SPECIAL_NAMES); - set_conf_section_part (COBC_HD_SPECIAL_NAMES); - if (current_program->nested_level) { - cb_error (_("%s not allowed in nested programs"), "SPECIAL-NAMES"); - } - } -#line 12979 "parser.c" /* yacc.c:1646 */ - break; - - case 164: -#line 3922 "parser.y" /* yacc.c:1646 */ - { - check_headers_present (COBC_HD_ENVIRONMENT_DIVISION, - COBC_HD_CONFIGURATION_SECTION, - COBC_HD_SPECIAL_NAMES, 0); - check_duplicate = 0; - if (current_program->nested_level) { - cb_error (_("%s not allowed in nested programs"), "SPECIAL-NAMES"); - save_tree = NULL; - } else { - /* lookup system name with special translation - note: result in NULL + raised error if not found */ - save_tree = get_system_name_translated ((yyvsp[0])); - } - } -#line 12998 "parser.c" /* yacc.c:1646 */ - break; - - case 166: -#line 3941 "parser.y" /* yacc.c:1646 */ - { - if (save_tree) { - if (CB_SYSTEM_NAME(save_tree)->token != CB_DEVICE_CONSOLE) { - cb_error_x (save_tree, _("invalid %s clause"), ""); - } else { - current_program->flag_console_is_crt = 1; - } - } - } -#line 13012 "parser.c" /* yacc.c:1646 */ - break; - - case 167: -#line 3952 "parser.y" /* yacc.c:1646 */ - { - if (save_tree) { - if (CB_SYSTEM_NAME(save_tree)->token != CB_FEATURE_CONVENTION) { - cb_error_x (save_tree, _("invalid %s clause"), "SPECIAL NAMES"); - } else if (CB_VALID_TREE ((yyvsp[0]))) { - CB_SYSTEM_NAME(save_tree)->value = (yyvsp[-2]); - cb_define ((yyvsp[0]), save_tree); - CB_CHAIN_PAIR (current_program->mnemonic_spec_list, - (yyvsp[0]), save_tree); - /* remove non-standard context-sensitive words when identical to mnemonic */ - if (strcasecmp (CB_NAME((yyvsp[0])), "EXTERN" ) == 0 || - strcasecmp (CB_NAME((yyvsp[0])), "STDCALL") == 0 || - strcasecmp (CB_NAME((yyvsp[0])), "STATIC" ) == 0 || - strcasecmp (CB_NAME((yyvsp[0])), "C" ) == 0 || - strcasecmp (CB_NAME((yyvsp[0])), "PASCAL" ) == 0) { - remove_context_sensitivity (CB_NAME((yyvsp[0])), CB_CS_CALL); - } - } - } - } -#line 13037 "parser.c" /* yacc.c:1646 */ - break; - - case 168: -#line 3973 "parser.y" /* yacc.c:1646 */ - { - if (save_tree && CB_VALID_TREE ((yyvsp[-1]))) { - cb_define ((yyvsp[-1]), save_tree); - CB_CHAIN_PAIR (current_program->mnemonic_spec_list, - (yyvsp[-1]), save_tree); - } - } -#line 13049 "parser.c" /* yacc.c:1646 */ - break; - - case 172: -#line 3989 "parser.y" /* yacc.c:1646 */ - { - check_on_off_duplicate = 0; - } -#line 13057 "parser.c" /* yacc.c:1646 */ - break; - - case 173: -#line 3996 "parser.y" /* yacc.c:1646 */ - { - cb_tree x; - - /* cb_define_switch_name checks param validity */ - x = cb_define_switch_name ((yyvsp[0]), save_tree, (yyvsp[-2]) == cb_int1); - if (x) { - if ((yyvsp[-2]) == cb_int1) { - check_repeated ("ON", SYN_CLAUSE_1, &check_on_off_duplicate); - } else { - check_repeated ("OFF", SYN_CLAUSE_2, &check_on_off_duplicate); - } - CB_CHAIN_PAIR (current_program->mnemonic_spec_list, (yyvsp[0]), x); - } - } -#line 13076 "parser.c" /* yacc.c:1646 */ - break; - - case 174: -#line 4011 "parser.y" /* yacc.c:1646 */ - { - cb_tree x; - - /* cb_define_switch_name checks param validity */ - x = cb_define_switch_name ((yyvsp[0]), save_tree, (yyvsp[-2]) == cb_int1); - if (x) { - if ((yyvsp[-2]) == cb_int1) { - check_repeated ("ON", SYN_CLAUSE_1, &check_on_off_duplicate); - } else { - check_repeated ("OFF", SYN_CLAUSE_2, &check_on_off_duplicate); - } - CB_CHAIN_PAIR (current_program->mnemonic_spec_list, (yyvsp[0]), x); - } - } -#line 13095 "parser.c" /* yacc.c:1646 */ - break; - - case 175: -#line 4031 "parser.y" /* yacc.c:1646 */ - { - check_headers_present (COBC_HD_ENVIRONMENT_DIVISION, - COBC_HD_CONFIGURATION_SECTION, - COBC_HD_SPECIAL_NAMES, 0); - if (current_program->nested_level) { - cb_error (_("%s not allowed in nested programs"), "SPECIAL-NAMES"); - (yyval) = NULL; - } else { - /* Returns null on error */ - (yyval) = cb_build_alphabet_name ((yyvsp[0])); - } - } -#line 13112 "parser.c" /* yacc.c:1646 */ - break; - - case 176: -#line 4044 "parser.y" /* yacc.c:1646 */ - { - if ((yyvsp[-1])) { - current_program->alphabet_name_list = - cb_list_add (current_program->alphabet_name_list, (yyvsp[-1])); - } - cobc_cs_check = 0; - } -#line 13124 "parser.c" /* yacc.c:1646 */ - break; - - case 177: -#line 4055 "parser.y" /* yacc.c:1646 */ - { - (yyval) = (yyvsp[-1]); - if ((yyvsp[-1])) { - CB_ALPHABET_NAME ((yyvsp[-1]))->alphabet_target = CB_ALPHABET_ALPHANUMERIC; - } - } -#line 13135 "parser.c" /* yacc.c:1646 */ - break; - - case 179: -#line 4063 "parser.y" /* yacc.c:1646 */ - { - (yyval) = (yyvsp[-1]); - if ((yyvsp[-1])) { - CB_ALPHABET_NAME((yyvsp[-1]))->alphabet_target = CB_ALPHABET_NATIONAL; - } - } -#line 13146 "parser.c" /* yacc.c:1646 */ - break; - - case 185: -#line 4084 "parser.y" /* yacc.c:1646 */ - { - if ((yyvsp[(-1) - (1)])) { - CB_ALPHABET_NAME ((yyvsp[(-1) - (1)]))->alphabet_type = CB_ALPHABET_ASCII; - } - } -#line 13156 "parser.c" /* yacc.c:1646 */ - break; - - case 186: -#line 4090 "parser.y" /* yacc.c:1646 */ - { - if ((yyvsp[(-1) - (1)])) { - CB_ALPHABET_NAME ((yyvsp[(-1) - (1)]))->alphabet_type = CB_ALPHABET_ASCII; - } - } -#line 13166 "parser.c" /* yacc.c:1646 */ - break; - - case 187: -#line 4096 "parser.y" /* yacc.c:1646 */ - { - if ((yyvsp[(-1) - (1)])) { - CB_ALPHABET_NAME ((yyvsp[(-1) - (1)]))->alphabet_type = CB_ALPHABET_EBCDIC; - } - } -#line 13176 "parser.c" /* yacc.c:1646 */ - break; - - case 188: -#line 4102 "parser.y" /* yacc.c:1646 */ - { - if ((yyvsp[(-1) - (1)])) { - CB_ALPHABET_NAME ((yyvsp[(-1) - (1)]))->alphabet_type = CB_ALPHABET_ASCII; - } - } -#line 13186 "parser.c" /* yacc.c:1646 */ - break; - - case 190: -#line 4112 "parser.y" /* yacc.c:1646 */ - { - if ((yyvsp[(-1) - (1)])) { - CB_PENDING_X ((yyvsp[(-1) - (1)]), "ALPHABET UCS-4"); - CB_ALPHABET_NAME ((yyvsp[(-1) - (1)]))->alphabet_type = CB_ALPHABET_UCS_4; - } - } -#line 13197 "parser.c" /* yacc.c:1646 */ - break; - - case 191: -#line 4119 "parser.y" /* yacc.c:1646 */ - { - if ((yyvsp[(-1) - (1)])) { - CB_PENDING_X ((yyvsp[(-1) - (1)]), "ALPHABET UTF-8"); - CB_ALPHABET_NAME ((yyvsp[(-1) - (1)]))->alphabet_type = CB_ALPHABET_UTF_8; - } - } -#line 13208 "parser.c" /* yacc.c:1646 */ - break; - - case 192: -#line 4126 "parser.y" /* yacc.c:1646 */ - { - if ((yyvsp[(-1) - (1)])) { - CB_PENDING_X ((yyvsp[(-1) - (1)]), "ALPHABET UTF-16"); - CB_ALPHABET_NAME ((yyvsp[(-1) - (1)]))->alphabet_type = CB_ALPHABET_UTF_16; - } - } -#line 13219 "parser.c" /* yacc.c:1646 */ - break; - - case 193: -#line 4136 "parser.y" /* yacc.c:1646 */ - { - if ((yyvsp[(-1) - (1)])) { - CB_ALPHABET_NAME ((yyvsp[(-1) - (1)]))->alphabet_type = CB_ALPHABET_NATIVE; - } - } -#line 13229 "parser.c" /* yacc.c:1646 */ - break; - - case 194: -#line 4142 "parser.y" /* yacc.c:1646 */ - { - if ((yyvsp[(-1) - (2)])) { - CB_ALPHABET_NAME ((yyvsp[(-1) - (2)]))->alphabet_type = CB_ALPHABET_LOCALE; - CB_ALPHABET_NAME ((yyvsp[(-1) - (2)]))->custom_list = (yyvsp[0]); - CB_PENDING_X ((yyvsp[(-1) - (2)]), "LOCALE ALPHABET"); - } - } -#line 13241 "parser.c" /* yacc.c:1646 */ - break; - - case 195: -#line 4150 "parser.y" /* yacc.c:1646 */ - { - if ((yyvsp[(-1) - (1)])) { - CB_ALPHABET_NAME ((yyvsp[(-1) - (1)]))->alphabet_type = CB_ALPHABET_CUSTOM; - CB_ALPHABET_NAME ((yyvsp[(-1) - (1)]))->custom_list = (yyvsp[0]); - } - } -#line 13252 "parser.c" /* yacc.c:1646 */ - break; - - case 196: -#line 4160 "parser.y" /* yacc.c:1646 */ - { - (yyval) = CB_LIST_INIT ((yyvsp[0])); - } -#line 13260 "parser.c" /* yacc.c:1646 */ - break; - - case 197: -#line 4164 "parser.y" /* yacc.c:1646 */ - { - (yyval) = cb_list_add ((yyvsp[-1]), (yyvsp[0])); - } -#line 13268 "parser.c" /* yacc.c:1646 */ - break; - - case 198: -#line 4171 "parser.y" /* yacc.c:1646 */ - { - (yyval) = (yyvsp[0]); - } -#line 13276 "parser.c" /* yacc.c:1646 */ - break; - - case 199: -#line 4175 "parser.y" /* yacc.c:1646 */ - { - (yyval) = CB_BUILD_PAIR ((yyvsp[-2]), (yyvsp[0])); - } -#line 13284 "parser.c" /* yacc.c:1646 */ - break; - - case 200: -#line 4179 "parser.y" /* yacc.c:1646 */ - { - (yyval) = CB_LIST_INIT ((yyvsp[-1])); - } -#line 13292 "parser.c" /* yacc.c:1646 */ - break; - - case 201: -#line 4183 "parser.y" /* yacc.c:1646 */ - { - (yyval) = (yyvsp[-1]); - } -#line 13300 "parser.c" /* yacc.c:1646 */ - break; - - case 202: -#line 4190 "parser.y" /* yacc.c:1646 */ - { - cb_list_add ((yyvsp[-1]), (yyvsp[0])); - } -#line 13308 "parser.c" /* yacc.c:1646 */ - break; - - case 203: -#line 4194 "parser.y" /* yacc.c:1646 */ - { - cb_list_add ((yyvsp[-3]), (yyvsp[0])); - } -#line 13316 "parser.c" /* yacc.c:1646 */ - break; - - case 204: -#line 4200 "parser.y" /* yacc.c:1646 */ - { (yyval) = (yyvsp[0]); } -#line 13322 "parser.c" /* yacc.c:1646 */ - break; - - case 205: -#line 4201 "parser.y" /* yacc.c:1646 */ - { (yyval) = cb_space; } -#line 13328 "parser.c" /* yacc.c:1646 */ - break; - - case 206: -#line 4202 "parser.y" /* yacc.c:1646 */ - { (yyval) = cb_zero; } -#line 13334 "parser.c" /* yacc.c:1646 */ - break; - - case 207: -#line 4203 "parser.y" /* yacc.c:1646 */ - { (yyval) = cb_quote; } -#line 13340 "parser.c" /* yacc.c:1646 */ - break; - - case 208: -#line 4204 "parser.y" /* yacc.c:1646 */ - { (yyval) = cb_norm_high; } -#line 13346 "parser.c" /* yacc.c:1646 */ - break; - - case 209: -#line 4205 "parser.y" /* yacc.c:1646 */ - { (yyval) = cb_norm_low; } -#line 13352 "parser.c" /* yacc.c:1646 */ - break; - - case 210: -#line 4209 "parser.y" /* yacc.c:1646 */ - { (yyval) = cb_space; } -#line 13358 "parser.c" /* yacc.c:1646 */ - break; - - case 211: -#line 4210 "parser.y" /* yacc.c:1646 */ - { (yyval) = cb_zero; } -#line 13364 "parser.c" /* yacc.c:1646 */ - break; - - case 212: -#line 4218 "parser.y" /* yacc.c:1646 */ - { - check_headers_present (COBC_HD_ENVIRONMENT_DIVISION, - COBC_HD_CONFIGURATION_SECTION, - COBC_HD_SPECIAL_NAMES, 0); - if (current_program->nested_level) { - cb_error (_("%s not allowed in nested programs"), "SPECIAL-NAMES"); - } else if ((yyvsp[-1])) { - CB_CHAIN_PAIR (current_program->symbolic_char_list, (yyvsp[-1]), (yyvsp[0])); - } - } -#line 13379 "parser.c" /* yacc.c:1646 */ - break; - - case 213: -#line 4232 "parser.y" /* yacc.c:1646 */ - { - (yyval) = NULL; - } -#line 13387 "parser.c" /* yacc.c:1646 */ - break; - - case 214: -#line 4236 "parser.y" /* yacc.c:1646 */ - { - (yyval) = (yyvsp[0]); - } -#line 13395 "parser.c" /* yacc.c:1646 */ - break; - - case 215: -#line 4244 "parser.y" /* yacc.c:1646 */ - { - (yyval) = (yyvsp[0]); - } -#line 13403 "parser.c" /* yacc.c:1646 */ - break; - - case 216: -#line 4251 "parser.y" /* yacc.c:1646 */ - { - (yyval) = (yyvsp[0]); - } -#line 13411 "parser.c" /* yacc.c:1646 */ - break; - - case 217: -#line 4255 "parser.y" /* yacc.c:1646 */ - { - if ((yyvsp[0])) { - (yyval) = cb_list_append ((yyvsp[-1]), (yyvsp[0])); - } else { - (yyval) = (yyvsp[-1]); - } - } -#line 13423 "parser.c" /* yacc.c:1646 */ - break; - - case 218: -#line 4266 "parser.y" /* yacc.c:1646 */ - { - cb_tree l1; - cb_tree l2; - - if (cb_list_length ((yyvsp[-2])) != cb_list_length ((yyvsp[0]))) { - cb_error (_("invalid %s clause"), "SYMBOLIC"); - (yyval) = NULL; - } else { - l1 = (yyvsp[-2]); - l2 = (yyvsp[0]); - for (; l1; l1 = CB_CHAIN (l1), l2 = CB_CHAIN (l2)) { - CB_PURPOSE (l1) = CB_VALUE (l2); - } - (yyval) = (yyvsp[-2]); - } - } -#line 13444 "parser.c" /* yacc.c:1646 */ - break; - - case 219: -#line 4286 "parser.y" /* yacc.c:1646 */ - { - if ((yyvsp[0]) == NULL) { - (yyval) = NULL; - } else { - (yyval) = CB_LIST_INIT ((yyvsp[0])); - } - } -#line 13456 "parser.c" /* yacc.c:1646 */ - break; - - case 220: -#line 4294 "parser.y" /* yacc.c:1646 */ - { - if ((yyvsp[0]) == NULL) { - (yyval) = (yyvsp[-1]); - } else { - (yyval) = cb_list_add ((yyvsp[-1]), (yyvsp[0])); - } - } -#line 13468 "parser.c" /* yacc.c:1646 */ - break; - - case 221: -#line 4304 "parser.y" /* yacc.c:1646 */ - { (yyval) = CB_LIST_INIT ((yyvsp[0])); } -#line 13474 "parser.c" /* yacc.c:1646 */ - break; - - case 222: -#line 4305 "parser.y" /* yacc.c:1646 */ - { (yyval) = cb_list_add ((yyvsp[-1]), (yyvsp[0])); } -#line 13480 "parser.c" /* yacc.c:1646 */ - break; - - case 223: -#line 4314 "parser.y" /* yacc.c:1646 */ - { - check_headers_present (COBC_HD_ENVIRONMENT_DIVISION, - COBC_HD_CONFIGURATION_SECTION, - COBC_HD_SPECIAL_NAMES, 0); - if (current_program->nested_level) { - cb_error (_("%s not allowed in nested programs"), "SPECIAL-NAMES"); - } - (void)cb_verify (cb_symbolic_constant, "SYMBOLIC CONSTANT"); - } -#line 13494 "parser.c" /* yacc.c:1646 */ - break; - - case 226: -#line 4332 "parser.y" /* yacc.c:1646 */ - { - struct cb_field *f; - cb_tree v; - - v = CB_LIST_INIT ((yyvsp[0])); - f = CB_FIELD (cb_build_constant ((yyvsp[-2]), v)); - f->flag_item_78 = 1; - f->flag_constant = 1; - f->flag_is_global = 1; - f->level = 1; - f->values = v; - cb_needs_01 = 1; - /* Ignore return value */ - (void)cb_validate_78_item (f, 0); - } -#line 13514 "parser.c" /* yacc.c:1646 */ - break; - - case 227: -#line 4353 "parser.y" /* yacc.c:1646 */ - { - cb_tree x; - - check_headers_present (COBC_HD_ENVIRONMENT_DIVISION, - COBC_HD_CONFIGURATION_SECTION, - COBC_HD_SPECIAL_NAMES, 0); - if (current_program->nested_level) { - cb_error (_("%s not allowed in nested programs"), "SPECIAL-NAMES"); - } else { - /* Returns null on error */ - x = cb_build_class_name ((yyvsp[-4]), (yyvsp[-1])); - if (x) { - current_program->class_name_list = - cb_list_add (current_program->class_name_list, x); - } - } - } -#line 13536 "parser.c" /* yacc.c:1646 */ - break; - - case 228: -#line 4373 "parser.y" /* yacc.c:1646 */ - { (yyval) = CB_LIST_INIT ((yyvsp[0])); } -#line 13542 "parser.c" /* yacc.c:1646 */ - break; - - case 229: -#line 4374 "parser.y" /* yacc.c:1646 */ - { (yyval) = cb_list_add ((yyvsp[-1]), (yyvsp[0])); } -#line 13548 "parser.c" /* yacc.c:1646 */ - break; - - case 230: -#line 4379 "parser.y" /* yacc.c:1646 */ - { - (yyval) = (yyvsp[0]); - } -#line 13556 "parser.c" /* yacc.c:1646 */ - break; - - case 231: -#line 4383 "parser.y" /* yacc.c:1646 */ - { - if (CB_TREE_CLASS ((yyvsp[-2])) != CB_CLASS_NUMERIC && - CB_LITERAL_P ((yyvsp[-2])) && CB_LITERAL ((yyvsp[-2]))->size != 1) { - cb_error (_("CLASS literal with THRU must have size 1")); - } - if (CB_TREE_CLASS ((yyvsp[0])) != CB_CLASS_NUMERIC && - CB_LITERAL_P ((yyvsp[0])) && CB_LITERAL ((yyvsp[0]))->size != 1) { - cb_error (_("CLASS literal with THRU must have size 1")); - } - if (literal_value ((yyvsp[-2])) <= literal_value ((yyvsp[0]))) { - (yyval) = CB_BUILD_PAIR ((yyvsp[-2]), (yyvsp[0])); - } else { - (yyval) = CB_BUILD_PAIR ((yyvsp[0]), (yyvsp[-2])); - } - } -#line 13576 "parser.c" /* yacc.c:1646 */ - break; - - case 233: -#line 4403 "parser.y" /* yacc.c:1646 */ - { - (yyval) = NULL; - } -#line 13584 "parser.c" /* yacc.c:1646 */ - break; - - case 234: -#line 4407 "parser.y" /* yacc.c:1646 */ - { - CB_PENDING_X ((yyvsp[0]), "NATIONAL CLASS"); - (yyval) = cb_int0; - } -#line 13593 "parser.c" /* yacc.c:1646 */ - break; - - case 236: -#line 4416 "parser.y" /* yacc.c:1646 */ - { - CB_PENDING_X ((yyvsp[0]), _("CLASS IS integer IN alphabet-name")); - (yyval) = (yyvsp[0]); - } -#line 13602 "parser.c" /* yacc.c:1646 */ - break; - - case 237: -#line 4426 "parser.y" /* yacc.c:1646 */ - { - check_headers_present (COBC_HD_ENVIRONMENT_DIVISION, - COBC_HD_CONFIGURATION_SECTION, - COBC_HD_SPECIAL_NAMES, 0); - if (current_program->nested_level) { - cb_error (_("%s not allowed in nested programs"), "SPECIAL-NAMES"); - } else { - /* Returns null on error */ - cb_tree l = cb_build_locale_name ((yyvsp[-2]), (yyvsp[0])); - if (l) { - current_program->locale_list = - cb_list_add (current_program->locale_list, l); - } - } - } -#line 13622 "parser.c" /* yacc.c:1646 */ - break; - - case 238: -#line 4447 "parser.y" /* yacc.c:1646 */ - { - check_headers_present (COBC_HD_ENVIRONMENT_DIVISION, - COBC_HD_CONFIGURATION_SECTION, - COBC_HD_SPECIAL_NAMES, 0); - if (current_program->nested_level) { - cb_error (_("%s not allowed in nested programs"), "SPECIAL-NAMES"); - } else { - unsigned int error_ind = 0; - - /* FIXME: actual allowed (depending on dialect), see FR #246 */ - check_repeated ("CURRENCY", SYN_CLAUSE_1, &check_duplicate); - - /* checks of CURRENCY SIGN (being currency string) when separate */ - if ((yyvsp[0])) { - unsigned int char_seen = 0; - unsigned char *s = CB_LITERAL ((yyvsp[-1]))->data; - - CB_PENDING_X ((yyvsp[-1]), _("separate currency symbol and currency string")); - while (*s) { - switch (*s) { - case '0': - case '1': - case '2': - case '3': - case '4': - case '5': - case '6': - case '7': - case '8': - case '9': - case '+': - case '-': - case ',': - case '.': - case '*': - error_ind = 1; - break; - case ' ': - break; - default: - char_seen = 1; - break; - } - s++; - } - if (!char_seen) { - error_ind = 1; - } - } - if (error_ind) { - cb_error_x ((yyvsp[-1]), _("invalid CURRENCY SIGN '%s'"), (char*)CB_LITERAL ((yyvsp[-1]))->data); - } - if ((yyvsp[0])) { - set_currency_picture_symbol ((yyvsp[0])); - } else { - if (!error_ind) { - set_currency_picture_symbol ((yyvsp[-1])); - } - } - } - } -#line 13688 "parser.c" /* yacc.c:1646 */ - break; - - case 239: -#line 4513 "parser.y" /* yacc.c:1646 */ - { - (yyval) = NULL; - } -#line 13696 "parser.c" /* yacc.c:1646 */ - break; - - case 240: -#line 4517 "parser.y" /* yacc.c:1646 */ - { - (yyval) = (yyvsp[0]); - } -#line 13704 "parser.c" /* yacc.c:1646 */ - break; - - case 241: -#line 4526 "parser.y" /* yacc.c:1646 */ - { - check_headers_present (COBC_HD_ENVIRONMENT_DIVISION, - COBC_HD_CONFIGURATION_SECTION, - COBC_HD_SPECIAL_NAMES, 0); - if (current_program->nested_level) { - cb_error (_("%s not allowed in nested programs"), "SPECIAL-NAMES"); - } else { - check_repeated ("DECIMAL-POINT", SYN_CLAUSE_2, &check_duplicate); - current_program->decimal_point = ','; - current_program->numeric_separator = '.'; - } - } -#line 13721 "parser.c" /* yacc.c:1646 */ - break; - - case 242: -#line 4545 "parser.y" /* yacc.c:1646 */ - { - check_headers_present (COBC_HD_ENVIRONMENT_DIVISION, - COBC_HD_CONFIGURATION_SECTION, - COBC_HD_SPECIAL_NAMES, 0); - if (current_program->nested_level) { - cb_error (_("%s not allowed in nested programs"), "SPECIAL-NAMES"); - } else { - current_program->flag_trailing_separate = 1; - } - } -#line 13736 "parser.c" /* yacc.c:1646 */ - break; - - case 243: -#line 4561 "parser.y" /* yacc.c:1646 */ - { - check_headers_present (COBC_HD_ENVIRONMENT_DIVISION, - COBC_HD_CONFIGURATION_SECTION, - COBC_HD_SPECIAL_NAMES, 0); - if (current_program->nested_level) { - cb_error (_("%s not allowed in nested programs"), "SPECIAL-NAMES"); - } else { - check_repeated ("CURSOR", SYN_CLAUSE_3, &check_duplicate); - current_program->cursor_pos = (yyvsp[0]); - } - } -#line 13752 "parser.c" /* yacc.c:1646 */ - break; - - case 244: -#line 4579 "parser.y" /* yacc.c:1646 */ - { - check_headers_present (COBC_HD_ENVIRONMENT_DIVISION, - COBC_HD_CONFIGURATION_SECTION, - COBC_HD_SPECIAL_NAMES, 0); - if (current_program->nested_level) { - cb_error (_("%s not allowed in nested programs"), "SPECIAL-NAMES"); - } else { - check_repeated ("CRT STATUS", SYN_CLAUSE_4, &check_duplicate); - current_program->crt_status = (yyvsp[0]); - } - } -#line 13768 "parser.c" /* yacc.c:1646 */ - break; - - case 245: -#line 4597 "parser.y" /* yacc.c:1646 */ - { - check_headers_present (COBC_HD_ENVIRONMENT_DIVISION, - COBC_HD_CONFIGURATION_SECTION, - COBC_HD_SPECIAL_NAMES, 0); - if (current_program->nested_level) { - cb_error (_("%s not allowed in nested programs"), "SPECIAL-NAMES"); - } else { - check_repeated ("SCREEN CONTROL", SYN_CLAUSE_5, &check_duplicate); - CB_PENDING ("SCREEN CONTROL"); - } - } -#line 13784 "parser.c" /* yacc.c:1646 */ - break; - - case 246: -#line 4614 "parser.y" /* yacc.c:1646 */ - { - check_headers_present (COBC_HD_ENVIRONMENT_DIVISION, - COBC_HD_CONFIGURATION_SECTION, - COBC_HD_SPECIAL_NAMES, 0); - if (current_program->nested_level) { - cb_error (_("%s not allowed in nested programs"), "SPECIAL-NAMES"); - } else { - check_repeated ("EVENT STATUS", SYN_CLAUSE_6, &check_duplicate); - CB_PENDING ("EVENT STATUS"); - } - } -#line 13800 "parser.c" /* yacc.c:1646 */ - break; - - case 247: -#line 4631 "parser.y" /* yacc.c:1646 */ - { - check_headers_present (COBC_HD_ENVIRONMENT_DIVISION, - COBC_HD_CONFIGURATION_SECTION, - COBC_HD_SPECIAL_NAMES, 0); - check_duplicate = 0; - if (current_program->nested_level) { - cb_error (_("%s not allowed in nested programs"), "SPECIAL-NAMES"); - save_tree = NULL; - } else { - /* lookup system name - note: result in NULL + raised error if not found */ - save_tree = get_system_name ("TOP"); - } - } -#line 13819 "parser.c" /* yacc.c:1646 */ - break; - - case 248: -#line 4646 "parser.y" /* yacc.c:1646 */ - { - if (save_tree && CB_VALID_TREE ((yyvsp[0]))) { - cb_define ((yyvsp[0]), save_tree); - CB_CHAIN_PAIR (current_program->mnemonic_spec_list, - (yyvsp[0]), save_tree); - } - } -#line 13831 "parser.c" /* yacc.c:1646 */ - break; - - case 251: -#line 4666 "parser.y" /* yacc.c:1646 */ - { - check_headers_present (COBC_HD_ENVIRONMENT_DIVISION, 0, 0, 0); - header_check |= COBC_HD_INPUT_OUTPUT_SECTION; - } -#line 13840 "parser.c" /* yacc.c:1646 */ - break; - - case 253: -#line 4676 "parser.y" /* yacc.c:1646 */ - { - check_headers_present (COBC_HD_ENVIRONMENT_DIVISION, - COBC_HD_INPUT_OUTPUT_SECTION, 0, 0); - header_check |= COBC_HD_FILE_CONTROL; - } -#line 13850 "parser.c" /* yacc.c:1646 */ - break; - - case 256: -#line 4689 "parser.y" /* yacc.c:1646 */ - { - check_headers_present (COBC_HD_ENVIRONMENT_DIVISION, - COBC_HD_INPUT_OUTPUT_SECTION, - COBC_HD_FILE_CONTROL, 0); - check_duplicate = 0; - if (CB_VALID_TREE ((yyvsp[0]))) { - /* Build new file */ - current_file = build_file ((yyvsp[0])); - current_file->optional = CB_INTEGER ((yyvsp[-1]))->val; - - /* Add file to current program list */ - CB_ADD_TO_CHAIN (CB_TREE (current_file), - current_program->file_list); - } else if (current_program->file_list) { - current_program->file_list - = CB_CHAIN (current_program->file_list); - } - key_type = NO_KEY; - } -#line 13874 "parser.c" /* yacc.c:1646 */ - break; - - case 257: -#line 4709 "parser.y" /* yacc.c:1646 */ - { - cobc_cs_check = 0; - if (CB_VALID_TREE ((yyvsp[-2]))) { - if (current_file->organization == COB_ORG_INDEXED - && key_type == RELATIVE_KEY) { - cb_error_x (current_file->key, - _("cannot use RELATIVE KEY clause on INDEXED files")); - } else if (current_file->organization == COB_ORG_RELATIVE - && key_type == RECORD_KEY) { - cb_error_x (current_file->key, - _("cannot use RECORD KEY clause on RELATIVE files")); - } - - validate_file (current_file, (yyvsp[-2])); - } - } -#line 13895 "parser.c" /* yacc.c:1646 */ - break; - - case 259: -#line 4730 "parser.y" /* yacc.c:1646 */ - { - yyerrok; - } -#line 13903 "parser.c" /* yacc.c:1646 */ - break; - - case 261: -#line 4737 "parser.y" /* yacc.c:1646 */ - { - /* reset context-sensitive words for next clauses */ - cobc_cs_check = CB_CS_SELECT; - } -#line 13912 "parser.c" /* yacc.c:1646 */ - break; - - case 281: -#line 4790 "parser.y" /* yacc.c:1646 */ - { - check_repeated ("ASSIGN", SYN_CLAUSE_1, &check_duplicate); - if (ext_dyn_specified) { - cb_error (_("EXTERNAL/DYNAMIC cannot be used with literals")); - } - - current_file->assign_type = CB_ASSIGN_EXT_FILE_NAME_REQUIRED; - current_file->assign = cb_build_assignment_name (current_file, (yyvsp[0])); - } -#line 13926 "parser.c" /* yacc.c:1646 */ - break; - - case 282: -#line 4800 "parser.y" /* yacc.c:1646 */ - { - check_repeated ("ASSIGN", SYN_CLAUSE_1, &check_duplicate); - - /* current_file->assign_type is set by _ext_clause */ - if (!ext_dyn_specified) { - current_file->flag_assign_no_keyword = 1; - } - current_file->assign = cb_build_assignment_name (current_file, (yyvsp[0])); - } -#line 13940 "parser.c" /* yacc.c:1646 */ - break; - - case 283: -#line 4810 "parser.y" /* yacc.c:1646 */ - { - check_repeated ("ASSIGN", SYN_CLAUSE_1, &check_duplicate); - if (ext_dyn_specified) { - cb_error (_("EXTERNAL/DYNAMIC cannot be used with USING/VARYING")); - } - cb_verify (cb_assign_using_variable, "ASSIGN USING/VARYING variable"); - - current_file->assign_type = CB_ASSIGN_VARIABLE_REQUIRED; - current_file->assign = cb_build_assignment_name (current_file, (yyvsp[0])); - } -#line 13955 "parser.c" /* yacc.c:1646 */ - break; - - case 284: -#line 4821 "parser.y" /* yacc.c:1646 */ - { - check_repeated ("ASSIGN", SYN_CLAUSE_1, &check_duplicate); - if (ext_dyn_specified) { - cb_error (_("EXTERNAL/DYNAMIC cannot be used with DISK FROM")); - } - cb_verify (cb_assign_disk_from, _("ASSIGN DISK FROM")); - - current_file->assign_type = CB_ASSIGN_VARIABLE_REQUIRED; - current_file->assign = cb_build_assignment_name (current_file, (yyvsp[0])); - } -#line 13970 "parser.c" /* yacc.c:1646 */ - break; - - case 285: -#line 4832 "parser.y" /* yacc.c:1646 */ - { - if (assign_device == CB_ASSIGN_DISPLAY_DEVICE) { - current_file->assign = - cb_build_alphanumeric_literal ("stdout", (size_t)6); - current_file->special = COB_SELECT_STDOUT; - } else if (assign_device == CB_ASSIGN_KEYBOARD_DEVICE) { - current_file->assign = - cb_build_alphanumeric_literal ("stdin", (size_t)5); - current_file->special = COB_SELECT_STDIN; - } else if (assign_device == CB_ASSIGN_PRINTER_DEVICE) { - current_file->organization = COB_ORG_LINE_SEQUENTIAL; - current_file->assign = - cb_build_alphanumeric_literal ("PRINTER", (size_t)7); - } else if (assign_device == CB_ASSIGN_PRINTER_1_DEVICE) { - current_file->organization = COB_ORG_LINE_SEQUENTIAL; - current_file->assign = - cb_build_alphanumeric_literal ("PRINTER-1", (size_t)9); - } else if (assign_device == CB_ASSIGN_PRINT_DEVICE) { - current_file->organization = COB_ORG_LINE_SEQUENTIAL; - current_file->assign = - cb_build_alphanumeric_literal ("LPT1", (size_t)4); - } else if (assign_device == CB_ASSIGN_LINE_SEQ_DEVICE - || assign_device == CB_ASSIGN_GENERAL_DEVICE) { - current_file->flag_fileid = 1; - } - } -#line 14001 "parser.c" /* yacc.c:1646 */ - break; - - case 286: -#line 4862 "parser.y" /* yacc.c:1646 */ - { - assign_device = CB_ASSIGN_NO_DEVICE; - } -#line 14009 "parser.c" /* yacc.c:1646 */ - break; - - case 287: -#line 4866 "parser.y" /* yacc.c:1646 */ - { - assign_device = CB_ASSIGN_NO_DEVICE; - } -#line 14017 "parser.c" /* yacc.c:1646 */ - break; - - case 289: -#line 4874 "parser.y" /* yacc.c:1646 */ - { - assign_device = CB_ASSIGN_GENERAL_DEVICE; - } -#line 14025 "parser.c" /* yacc.c:1646 */ - break; - - case 290: -#line 4878 "parser.y" /* yacc.c:1646 */ - { - current_file->organization = COB_ORG_LINE_SEQUENTIAL; - assign_device = CB_ASSIGN_LINE_SEQ_DEVICE; - } -#line 14034 "parser.c" /* yacc.c:1646 */ - break; - - case 291: -#line 4883 "parser.y" /* yacc.c:1646 */ - { - assign_device = CB_ASSIGN_DISPLAY_DEVICE; - } -#line 14042 "parser.c" /* yacc.c:1646 */ - break; - - case 292: -#line 4887 "parser.y" /* yacc.c:1646 */ - { - assign_device = CB_ASSIGN_KEYBOARD_DEVICE; - } -#line 14050 "parser.c" /* yacc.c:1646 */ - break; - - case 293: -#line 4895 "parser.y" /* yacc.c:1646 */ - { - assign_device = CB_ASSIGN_PRINTER_DEVICE; - } -#line 14058 "parser.c" /* yacc.c:1646 */ - break; - - case 294: -#line 4899 "parser.y" /* yacc.c:1646 */ - { - assign_device = CB_ASSIGN_PRINTER_1_DEVICE; - } -#line 14066 "parser.c" /* yacc.c:1646 */ - break; - - case 295: -#line 4903 "parser.y" /* yacc.c:1646 */ - { - assign_device = CB_ASSIGN_PRINT_DEVICE; - } -#line 14074 "parser.c" /* yacc.c:1646 */ - break; - - case 307: -#line 4928 "parser.y" /* yacc.c:1646 */ - { - current_file->flag_line_adv = 1; - } -#line 14082 "parser.c" /* yacc.c:1646 */ - break; - - case 308: -#line 4935 "parser.y" /* yacc.c:1646 */ - { - ext_dyn_specified = 0; - current_file->assign_type = cb_assign_type_default; - } -#line 14091 "parser.c" /* yacc.c:1646 */ - break; - - case 309: -#line 4940 "parser.y" /* yacc.c:1646 */ - { - ext_dyn_specified = 1; - cb_verify (cb_assign_ext_dyn, _("ASSIGN EXTERNAL/DYNAMIC")); - } -#line 14100 "parser.c" /* yacc.c:1646 */ - break; - - case 310: -#line 4948 "parser.y" /* yacc.c:1646 */ - { - current_file->assign_type = CB_ASSIGN_EXT_FILE_NAME_REQUIRED; - } -#line 14108 "parser.c" /* yacc.c:1646 */ - break; - - case 311: -#line 4952 "parser.y" /* yacc.c:1646 */ - { - current_file->assign_type = CB_ASSIGN_VARIABLE_REQUIRED; - } -#line 14116 "parser.c" /* yacc.c:1646 */ - break; - - case 314: -#line 4966 "parser.y" /* yacc.c:1646 */ - { - check_repeated ("ACCESS", SYN_CLAUSE_2, &check_duplicate); - } -#line 14124 "parser.c" /* yacc.c:1646 */ - break; - - case 315: -#line 4972 "parser.y" /* yacc.c:1646 */ - { current_file->access_mode = COB_ACCESS_SEQUENTIAL; } -#line 14130 "parser.c" /* yacc.c:1646 */ - break; - - case 316: -#line 4973 "parser.y" /* yacc.c:1646 */ - { current_file->access_mode = COB_ACCESS_DYNAMIC; } -#line 14136 "parser.c" /* yacc.c:1646 */ - break; - - case 317: -#line 4974 "parser.y" /* yacc.c:1646 */ - { current_file->access_mode = COB_ACCESS_RANDOM; } -#line 14142 "parser.c" /* yacc.c:1646 */ - break; - - case 318: -#line 4982 "parser.y" /* yacc.c:1646 */ - { - struct cb_alt_key *p; - struct cb_alt_key *l; - - cb_tree composite_key; - - p = cobc_parse_malloc (sizeof (struct cb_alt_key)); - p->key = (yyvsp[-4]); - p->component_list = NULL; - if ((yyvsp[-2])) { - p->duplicates = CB_INTEGER ((yyvsp[-2]))->val; - } else { - /* note: we may add a compiler configuration here, - as at least ICOBOL defaults to WITH DUPLICATES - for ALTERNATE keys if not explicit deactivated - */ - p->duplicates = 0; - } - p->password = (yyvsp[-1]); - if ((yyvsp[0]) - && CB_LITERAL_P ((yyvsp[0])) - && !CB_NUMERIC_LITERAL_P((yyvsp[0]))) { - p->suppress = (yyvsp[0]); - } else - if ((yyvsp[0])) { - p->tf_suppress = 1; - p->char_suppress = CB_INTEGER ((yyvsp[0]))->val; - } else { - p->tf_suppress = 0; - } - p->next = NULL; - - /* handle split keys */ - if ((yyvsp[-3])) { - /* generate field (in w-s) for composite-key */ - composite_key = cb_build_field((yyvsp[-4])); - if (composite_key == cb_error_node) { - YYERROR; - } else { - composite_key->category = CB_CATEGORY_ALPHANUMERIC; - ((struct cb_field *)composite_key)->count = 1; - p->key = cb_build_field_reference((struct cb_field *)composite_key, NULL); - p->component_list = key_component_list; - } - } - - /* Add to the end of list */ - if (current_file->alt_key_list == NULL) { - current_file->alt_key_list = p; - } else { - l = current_file->alt_key_list; - for (; l->next; l = l->next) { ; } - l->next = p; - } - } -#line 14202 "parser.c" /* yacc.c:1646 */ - break; - - case 319: -#line 5041 "parser.y" /* yacc.c:1646 */ - { - (yyval) = NULL; - } -#line 14210 "parser.c" /* yacc.c:1646 */ - break; - - case 321: -#line 5049 "parser.y" /* yacc.c:1646 */ - { - CB_PENDING ("PASSWORD clause"); - } -#line 14218 "parser.c" /* yacc.c:1646 */ - break; - - case 322: -#line 5053 "parser.y" /* yacc.c:1646 */ - { - (yyval) = (yyvsp[0]); - } -#line 14226 "parser.c" /* yacc.c:1646 */ - break; - - case 323: -#line 5074 "parser.y" /* yacc.c:1646 */ - { - (yyval) = NULL; - } -#line 14234 "parser.c" /* yacc.c:1646 */ - break; - - case 324: -#line 5078 "parser.y" /* yacc.c:1646 */ - { - (yyval) = cb_int (literal_value ((yyvsp[0]))); - } -#line 14242 "parser.c" /* yacc.c:1646 */ - break; - - case 325: -#line 5082 "parser.y" /* yacc.c:1646 */ - { - (yyval) = cb_int (literal_value ((yyvsp[0]))); - } -#line 14250 "parser.c" /* yacc.c:1646 */ - break; - - case 326: -#line 5086 "parser.y" /* yacc.c:1646 */ - { - (yyval) = (yyvsp[0]); - } -#line 14258 "parser.c" /* yacc.c:1646 */ - break; - - case 327: -#line 5096 "parser.y" /* yacc.c:1646 */ - { - check_repeated ("COLLATING", SYN_CLAUSE_3, &check_duplicate); - current_file->collating_sequence = alphanumeric_collation; - current_file->collating_sequence_n = national_collation; - CB_PENDING ("FILE COLLATING SEQUENCE"); - } -#line 14269 "parser.c" /* yacc.c:1646 */ - break; - - case 328: -#line 5106 "parser.y" /* yacc.c:1646 */ - { - alphanumeric_collation = national_collation = NULL; - } -#line 14277 "parser.c" /* yacc.c:1646 */ - break; - - case 330: -#line 5114 "parser.y" /* yacc.c:1646 */ - { - alphanumeric_collation = (yyvsp[0]); - } -#line 14285 "parser.c" /* yacc.c:1646 */ - break; - - case 331: -#line 5118 "parser.y" /* yacc.c:1646 */ - { - alphanumeric_collation = (yyvsp[-1]); - CB_PENDING_X ((yyvsp[0]), "NATIONAL COLLATING SEQUENCE"); - national_collation = (yyvsp[0]); - } -#line 14295 "parser.c" /* yacc.c:1646 */ - break; - - case 332: -#line 5124 "parser.y" /* yacc.c:1646 */ - { - alphanumeric_collation = (yyvsp[0]); - } -#line 14303 "parser.c" /* yacc.c:1646 */ - break; - - case 333: -#line 5128 "parser.y" /* yacc.c:1646 */ - { - CB_PENDING_X ((yyvsp[0]), "NATIONAL COLLATING SEQUENCE"); - national_collation = (yyvsp[0]); - } -#line 14312 "parser.c" /* yacc.c:1646 */ - break; - - case 334: -#line 5134 "parser.y" /* yacc.c:1646 */ - { - alphanumeric_collation = (yyvsp[-4]); - CB_PENDING_X ((yyvsp[0]), "NATIONAL COLLATING SEQUENCE"); - national_collation = (yyvsp[0]); - } -#line 14322 "parser.c" /* yacc.c:1646 */ - break; - - case 335: -#line 5141 "parser.y" /* yacc.c:1646 */ - { - CB_PENDING_X ((yyvsp[-4]), "NATIONAL COLLATING SEQUENCE"); - national_collation = (yyvsp[-4]); - alphanumeric_collation = (yyvsp[0]); - } -#line 14332 "parser.c" /* yacc.c:1646 */ - break; - - case 336: -#line 5150 "parser.y" /* yacc.c:1646 */ - { - /* note: both entries must be resolved later on - and also attached to the correct key later, so just store in a list here: */ - current_file->collating_sequence_keys = - cb_list_add(current_file->collating_sequence_keys, CB_BUILD_PAIR ((yyvsp[0]), (yyvsp[-2]))); - CB_PENDING ("KEY COLLATING SEQUENCE"); - } -#line 14344 "parser.c" /* yacc.c:1646 */ - break; - - case 337: -#line 5161 "parser.y" /* yacc.c:1646 */ - { - if (CB_ALPHABET_NAME_P (cb_ref ((yyvsp[0])))) { - (yyval) = (yyvsp[0]); - } else { - cb_error_x ((yyvsp[0]), _("'%s' is not an alphabet-name"), - cb_name ((yyvsp[0]))); - (yyval) = cb_error_node; - } - } -#line 14358 "parser.c" /* yacc.c:1646 */ - break; - - case 338: -#line 5176 "parser.y" /* yacc.c:1646 */ - { - check_repeated ("STATUS", SYN_CLAUSE_4, &check_duplicate); - current_file->file_status = (yyvsp[-1]); - if ((yyvsp[0])) { - /* add a compiler configuration if either */ - if (cb_std_define != CB_STD_IBM - && cb_std_define != CB_STD_MVS - && !cb_relaxed_syntax_checks) { - cb_verify (CB_UNCONFORMABLE, "VSAM STATUS"); - } else { - cb_warning (cb_warn_extra, _("%s ignored"), "VSAM STATUS"); - } - } - } -#line 14377 "parser.c" /* yacc.c:1646 */ - break; - - case 342: -#line 5201 "parser.y" /* yacc.c:1646 */ - { - check_repeated ("LOCK", SYN_CLAUSE_5, &check_duplicate); - } -#line 14385 "parser.c" /* yacc.c:1646 */ - break; - - case 344: -#line 5209 "parser.y" /* yacc.c:1646 */ - { - current_file->lock_mode |= COB_LOCK_MANUAL; - } -#line 14393 "parser.c" /* yacc.c:1646 */ - break; - - case 345: -#line 5213 "parser.y" /* yacc.c:1646 */ - { - current_file->lock_mode |= COB_LOCK_AUTOMATIC; - } -#line 14401 "parser.c" /* yacc.c:1646 */ - break; - - case 346: -#line 5217 "parser.y" /* yacc.c:1646 */ - { - current_file->lock_mode |= COB_LOCK_EXCLUSIVE; - } -#line 14409 "parser.c" /* yacc.c:1646 */ - break; - - case 349: -#line 5226 "parser.y" /* yacc.c:1646 */ - { - current_file->lock_mode |= COB_LOCK_MULTIPLE; - } -#line 14417 "parser.c" /* yacc.c:1646 */ - break; - - case 350: -#line 5230 "parser.y" /* yacc.c:1646 */ - { - current_file->lock_mode |= (COB_LOCK_ROLLBACK|COB_LOCK_MULTIPLE); - } -#line 14425 "parser.c" /* yacc.c:1646 */ - break; - - case 353: -#line 5241 "parser.y" /* yacc.c:1646 */ - { - CB_PENDING ("WITH ROLLBACK"); - } -#line 14433 "parser.c" /* yacc.c:1646 */ - break; - - case 355: -#line 5248 "parser.y" /* yacc.c:1646 */ - { - if (current_file->organization == COB_ORG_INDEXED) { - current_file->lock_mode |= COB_LOCK_EXCLUSIVE; - /* TODO: pass extra flag to fileio */ - CB_PENDING ("WITH MASS-UPDATE"); - } else { - cb_error (_("%s only valid with ORGANIZATION %s"), "MASS-UPDATE", "INDEXED"); - } - } -#line 14447 "parser.c" /* yacc.c:1646 */ - break; - - case 358: -#line 5269 "parser.y" /* yacc.c:1646 */ - { - check_repeated ("ORGANIZATION", SYN_CLAUSE_6, &check_duplicate); - error_if_record_delimiter_incompatible (COB_ORG_INDEXED, "INDEXED"); - current_file->organization = COB_ORG_INDEXED; - } -#line 14457 "parser.c" /* yacc.c:1646 */ - break; - - case 359: -#line 5275 "parser.y" /* yacc.c:1646 */ - { - check_repeated ("ORGANIZATION", SYN_CLAUSE_6, &check_duplicate); - error_if_record_delimiter_incompatible (COB_ORG_SEQUENTIAL, "SEQUENTIAL"); - current_file->organization = COB_ORG_SEQUENTIAL; - } -#line 14467 "parser.c" /* yacc.c:1646 */ - break; - - case 360: -#line 5281 "parser.y" /* yacc.c:1646 */ - { - check_repeated ("ORGANIZATION", SYN_CLAUSE_6, &check_duplicate); - error_if_record_delimiter_incompatible (COB_ORG_RELATIVE, "RELATIVE"); - current_file->organization = COB_ORG_RELATIVE; - } -#line 14477 "parser.c" /* yacc.c:1646 */ - break; - - case 361: -#line 5287 "parser.y" /* yacc.c:1646 */ - { - check_repeated ("ORGANIZATION", SYN_CLAUSE_6, &check_duplicate); - error_if_record_delimiter_incompatible (COB_ORG_LINE_SEQUENTIAL, - "LINE SEQUENTIAL"); - current_file->organization = COB_ORG_LINE_SEQUENTIAL; - } -#line 14488 "parser.c" /* yacc.c:1646 */ - break; - - case 362: -#line 5300 "parser.y" /* yacc.c:1646 */ - { - check_repeated ("PADDING", SYN_CLAUSE_7, &check_duplicate); - cb_verify (cb_padding_character_clause, "PADDING CHARACTER"); - } -#line 14497 "parser.c" /* yacc.c:1646 */ - break; - - case 363: -#line 5310 "parser.y" /* yacc.c:1646 */ - { - check_repeated ("RECORD DELIMITER", SYN_CLAUSE_8, &check_duplicate); - current_file->flag_delimiter = 1; - } -#line 14506 "parser.c" /* yacc.c:1646 */ - break; - - case 365: -#line 5319 "parser.y" /* yacc.c:1646 */ - { - if (current_file->organization != COB_ORG_SEQUENTIAL) { - cb_error (_("RECORD DELIMITER %s only allowed with SEQUENTIAL files"), - "STANDARD-1"); - } else if (cb_verify (cb_record_delimiter, _("RECORD DELIMITER clause"))) { - cb_warning (cb_warn_extra, - _("%s ignored"), "RECORD DELIMITER STANDARD-1"); - } - } -#line 14520 "parser.c" /* yacc.c:1646 */ - break; - - case 366: -#line 5329 "parser.y" /* yacc.c:1646 */ - { - if (current_file->organization != COB_ORG_SEQUENTIAL - && current_file->organization != COB_ORG_LINE_SEQUENTIAL) { - cb_error (_("RECORD DELIMITER %s only allowed with (LINE) SEQUENTIAL files"), - "LINE-SEQUENTIAL"); - } - - if (cb_verify (cb_record_delimiter, _("RECORD DELIMITER clause")) - && cb_verify (cb_sequential_delimiters, _("LINE-SEQUENTIAL phrase"))) { - current_file->organization = COB_ORG_LINE_SEQUENTIAL; - } - } -#line 14537 "parser.c" /* yacc.c:1646 */ - break; - - case 367: -#line 5342 "parser.y" /* yacc.c:1646 */ - { - if (current_file->organization != COB_ORG_SEQUENTIAL) { - cb_error (_("RECORD DELIMITER %s only allowed with SEQUENTIAL files"), - "BINARY-SEQUENTIAL"); - } - - if (cb_verify (cb_record_delimiter, _("RECORD DELIMITER clause")) - && cb_verify (cb_sequential_delimiters, _("BINARY-SEQUENTIAL phrase"))) { - current_file->organization = COB_ORG_SEQUENTIAL; - } - } -#line 14553 "parser.c" /* yacc.c:1646 */ - break; - - case 368: -#line 5354 "parser.y" /* yacc.c:1646 */ - { - if (current_file->organization != COB_ORG_SEQUENTIAL - && current_file->organization != COB_ORG_LINE_SEQUENTIAL) { - cb_error (_("RECORD DELIMITER clause only allowed with (LINE) SEQUENTIAL files")); - } else if (cb_verify (cb_record_delimiter, _("RECORD DELIMITER clause"))) { - cb_warning (cb_warn_extra, - _("RECORD DELIMITER %s not recognized; will be ignored"), cb_name ((yyvsp[0]))); - } - } -#line 14567 "parser.c" /* yacc.c:1646 */ - break; - - case 369: -#line 5369 "parser.y" /* yacc.c:1646 */ - { - cb_tree composite_key; - - check_repeated ("RECORD KEY", SYN_CLAUSE_9, &check_duplicate); - current_file->key = (yyvsp[-3]); - key_type = RECORD_KEY; - - /* handle split keys */ - if ((yyvsp[-2])) { - /* generate field (in w-s) for composite-key */ - composite_key = cb_build_field ((yyvsp[-3])); - if (composite_key == cb_error_node) { - YYERROR; - } else { - composite_key->category = CB_CATEGORY_ALPHANUMERIC; - ((struct cb_field *)composite_key)->count = 1; - current_file->key = cb_build_field_reference ((struct cb_field *)composite_key, NULL); - current_file->component_list = key_component_list; - } - } - current_file->password = (yyvsp[-1]); - if ((yyvsp[0])) { - /* note: we *may* add a compiler configuration here, - as most dialects do not allow this clause - on primary keys */ - if (CB_INTEGER ((yyvsp[0]))->val) { - /* note: see ACUCOBOL docs for implementation notes, including [RE]WRITE rules - and "if the underlying (file) system does not support them OPEN - result in (sucessfull) io-status 0M" */ - CB_PENDING (_("DUPLICATES for primary keys")); - }; - - } - } -#line 14606 "parser.c" /* yacc.c:1646 */ - break; - - case 370: -#line 5407 "parser.y" /* yacc.c:1646 */ - { - (yyval) = NULL; - } -#line 14614 "parser.c" /* yacc.c:1646 */ - break; - - case 371: -#line 5411 "parser.y" /* yacc.c:1646 */ - { - (yyval) = cb_int0; - } -#line 14622 "parser.c" /* yacc.c:1646 */ - break; - - case 374: -#line 5422 "parser.y" /* yacc.c:1646 */ - { - key_component_list = NULL; - } -#line 14630 "parser.c" /* yacc.c:1646 */ - break; - - case 377: -#line 5432 "parser.y" /* yacc.c:1646 */ - { - struct cb_key_component *c; - struct cb_key_component *comp = cobc_main_malloc (sizeof(struct cb_key_component)); - comp->next = NULL; - comp->component = (yyvsp[0]); - if (key_component_list == NULL) { - key_component_list = comp; - } else { - for (c = key_component_list; c->next != NULL; c = c->next); - c->next = comp; - } - } -#line 14647 "parser.c" /* yacc.c:1646 */ - break; - - case 378: -#line 5450 "parser.y" /* yacc.c:1646 */ - { - check_repeated ("RELATIVE KEY", SYN_CLAUSE_10, &check_duplicate); - current_file->key = (yyvsp[0]); - key_type = RELATIVE_KEY; - } -#line 14657 "parser.c" /* yacc.c:1646 */ - break; - - case 379: -#line 5461 "parser.y" /* yacc.c:1646 */ - { - check_repeated ("RESERVE", SYN_CLAUSE_11, &check_duplicate); - } -#line 14665 "parser.c" /* yacc.c:1646 */ - break; - - case 382: -#line 5475 "parser.y" /* yacc.c:1646 */ - { - check_repeated ("SHARING", SYN_CLAUSE_12, &check_duplicate); - current_file->sharing = (yyvsp[0]); - } -#line 14674 "parser.c" /* yacc.c:1646 */ - break; - - case 383: -#line 5482 "parser.y" /* yacc.c:1646 */ - { (yyval) = cb_int (COB_SHARE_ALL_OTHER); } -#line 14680 "parser.c" /* yacc.c:1646 */ - break; - - case 384: -#line 5483 "parser.y" /* yacc.c:1646 */ - { (yyval) = cb_int (COB_SHARE_NO_OTHER); } -#line 14686 "parser.c" /* yacc.c:1646 */ - break; - - case 385: -#line 5484 "parser.y" /* yacc.c:1646 */ - { (yyval) = cb_int (COB_SHARE_READ_ONLY); } -#line 14692 "parser.c" /* yacc.c:1646 */ - break; - - case 386: -#line 5491 "parser.y" /* yacc.c:1646 */ - { - (void)cb_verify (CB_OBSOLETE, "FILE-LIMIT"); - check_repeated ("FILE-LIMIT", SYN_CLAUSE_13, &check_duplicate); - } -#line 14701 "parser.c" /* yacc.c:1646 */ - break; - - case 389: -#line 5506 "parser.y" /* yacc.c:1646 */ - { - (void)cb_verify (CB_OBSOLETE, "ACTUAL KEY"); - check_repeated ("ACTUAL KEY", SYN_CLAUSE_14, &check_duplicate); - } -#line 14710 "parser.c" /* yacc.c:1646 */ - break; - - case 390: -#line 5516 "parser.y" /* yacc.c:1646 */ - { - (void)cb_verify (CB_OBSOLETE, "NOMINAL KEY"); - check_repeated ("NOMINAL KEY", SYN_CLAUSE_15, &check_duplicate); - } -#line 14719 "parser.c" /* yacc.c:1646 */ - break; - - case 391: -#line 5526 "parser.y" /* yacc.c:1646 */ - { - (void)cb_verify (CB_OBSOLETE, "TRACK-AREA"); - check_repeated ("TRACK-AREA", SYN_CLAUSE_16, &check_duplicate); - } -#line 14728 "parser.c" /* yacc.c:1646 */ - break; - - case 392: -#line 5536 "parser.y" /* yacc.c:1646 */ - { - (void)cb_verify (CB_OBSOLETE, "TRACK-LIMIT"); - check_repeated ("TRACK-LIMIT", SYN_CLAUSE_17, &check_duplicate); - } -#line 14737 "parser.c" /* yacc.c:1646 */ - break; - - case 394: -#line 5547 "parser.y" /* yacc.c:1646 */ - { - cobc_cs_check = 0; - } -#line 14745 "parser.c" /* yacc.c:1646 */ - break; - - case 395: -#line 5554 "parser.y" /* yacc.c:1646 */ - { - check_headers_present(COBC_HD_ENVIRONMENT_DIVISION, - COBC_HD_INPUT_OUTPUT_SECTION, 0, 0); - header_check |= COBC_HD_I_O_CONTROL; -} -#line 14755 "parser.c" /* yacc.c:1646 */ - break; - - case 398: -#line 5564 "parser.y" /* yacc.c:1646 */ - { - yyerrok; - } -#line 14763 "parser.c" /* yacc.c:1646 */ - break; - - case 405: -#line 5585 "parser.y" /* yacc.c:1646 */ - { - cb_tree l; - - check_headers_present (COBC_HD_ENVIRONMENT_DIVISION, - COBC_HD_INPUT_OUTPUT_SECTION, - COBC_HD_I_O_CONTROL, 0); - switch (CB_INTEGER ((yyvsp[-3]))->val) { - case 0: - /* SAME AREA */ - break; - case 1: - /* SAME RECORD */ - for (l = (yyvsp[0]); l; l = CB_CHAIN (l)) { - if (CB_VALID_TREE (CB_VALUE (l))) { - CB_FILE (cb_ref (CB_VALUE (l)))->same_clause = same_area; - } - } - same_area++; - break; - case 2: - /* SAME SORT-MERGE */ - break; - } - } -#line 14792 "parser.c" /* yacc.c:1646 */ - break; - - case 406: -#line 5612 "parser.y" /* yacc.c:1646 */ - { (yyval) = cb_int0; } -#line 14798 "parser.c" /* yacc.c:1646 */ - break; - - case 407: -#line 5613 "parser.y" /* yacc.c:1646 */ - { (yyval) = cb_int1; } -#line 14804 "parser.c" /* yacc.c:1646 */ - break; - - case 408: -#line 5614 "parser.y" /* yacc.c:1646 */ - { (yyval) = cb_int2; } -#line 14810 "parser.c" /* yacc.c:1646 */ - break; - - case 409: -#line 5615 "parser.y" /* yacc.c:1646 */ - { (yyval) = cb_int2; } -#line 14816 "parser.c" /* yacc.c:1646 */ - break; - - case 410: -#line 5622 "parser.y" /* yacc.c:1646 */ - { - current_program->apply_commit = (yyvsp[0]); - CB_PENDING("APPLY COMMIT"); - } -#line 14825 "parser.c" /* yacc.c:1646 */ - break; - - case 411: -#line 5627 "parser.y" /* yacc.c:1646 */ - { - CB_PENDING ("APPLY LOCK-HOLDING"); - } -#line 14833 "parser.c" /* yacc.c:1646 */ - break; - - case 412: -#line 5631 "parser.y" /* yacc.c:1646 */ - { - CB_PENDING ("APPLY PRINT-CONTROL"); - } -#line 14841 "parser.c" /* yacc.c:1646 */ - break; - - case 414: -#line 5636 "parser.y" /* yacc.c:1646 */ - { - cb_verify (CB_OBSOLETE, _("DOS/VS APPLY phrase")); - } -#line 14849 "parser.c" /* yacc.c:1646 */ - break; - - case 423: -#line 5656 "parser.y" /* yacc.c:1646 */ - { - /* Fake for TAPE */ - cobc_cs_check = CB_CS_ASSIGN; - } -#line 14858 "parser.c" /* yacc.c:1646 */ - break; - - case 424: -#line 5661 "parser.y" /* yacc.c:1646 */ - { - check_headers_present (COBC_HD_ENVIRONMENT_DIVISION, - COBC_HD_INPUT_OUTPUT_SECTION, - COBC_HD_I_O_CONTROL, 0); - cb_verify (cb_multiple_file_tape_clause, "MULTIPLE FILE TAPE"); - cobc_cs_check = 0; - } -#line 14870 "parser.c" /* yacc.c:1646 */ - break; - - case 434: -#line 5704 "parser.y" /* yacc.c:1646 */ - { - current_storage = CB_STORAGE_WORKING; - } -#line 14878 "parser.c" /* yacc.c:1646 */ - break; - - case 438: -#line 5721 "parser.y" /* yacc.c:1646 */ - { - header_check |= COBC_HD_DATA_DIVISION; - } -#line 14886 "parser.c" /* yacc.c:1646 */ - break; - - case 440: -#line 5730 "parser.y" /* yacc.c:1646 */ - { - current_storage = CB_STORAGE_FILE; - check_headers_present (COBC_HD_DATA_DIVISION, 0, 0, 0); - header_check |= COBC_HD_FILE_SECTION; - } -#line 14896 "parser.c" /* yacc.c:1646 */ - break; - - case 443: -#line 5744 "parser.y" /* yacc.c:1646 */ - { - if (CB_VALID_TREE (current_file)) { - if (CB_VALID_TREE ((yyvsp[0]))) { - /* Do not keep Record if this is really a report */ - if (!current_file->reports) { - finalize_file (current_file, CB_FIELD ((yyvsp[0]))); - } - } else if (!current_file->reports) { - cb_error (_("RECORD description missing or invalid")); - } - } - } -#line 14913 "parser.c" /* yacc.c:1646 */ - break; - - case 444: -#line 5762 "parser.y" /* yacc.c:1646 */ - { - current_storage = CB_STORAGE_FILE; - check_headers_present (COBC_HD_DATA_DIVISION, - COBC_HD_FILE_SECTION, 0, 0); - check_duplicate = 0; - if (CB_INVALID_TREE ((yyvsp[0]))) { - current_file = NULL; - YYERROR; - } - current_file = CB_FILE (cb_ref ((yyvsp[0]))); - if (CB_VALID_TREE (current_file)) { - if ((yyvsp[-1]) == cb_int1) { - current_file->organization = COB_ORG_SORT; - } - /* note: this is a HACK and should be moved */ - if (current_file->flag_finalized) { - cb_error_x ((yyvsp[0]), _("duplicate file description for %s"), - cb_name (CB_TREE (current_file))); - } - } - } -#line 14939 "parser.c" /* yacc.c:1646 */ - break; - - case 446: -#line 5785 "parser.y" /* yacc.c:1646 */ - { - yyerrok; - } -#line 14947 "parser.c" /* yacc.c:1646 */ - break; - - case 447: -#line 5792 "parser.y" /* yacc.c:1646 */ - { - (yyval) = cb_int0; - } -#line 14955 "parser.c" /* yacc.c:1646 */ - break; - - case 448: -#line 5796 "parser.y" /* yacc.c:1646 */ - { - (yyval) = cb_int1; - } -#line 14963 "parser.c" /* yacc.c:1646 */ - break; - - case 451: -#line 5807 "parser.y" /* yacc.c:1646 */ - { - check_repeated ("EXTERNAL", SYN_CLAUSE_1, &check_duplicate); -#if 0 /* RXWRXW - Global/External */ - if (current_file->flag_global) { - cb_error (_("file cannot have both EXTERNAL and GLOBAL clauses")); - } -#endif - current_file->flag_external = 1; - } -#line 14977 "parser.c" /* yacc.c:1646 */ - break; - - case 452: -#line 5817 "parser.y" /* yacc.c:1646 */ - { - check_repeated ("GLOBAL", SYN_CLAUSE_2, &check_duplicate); -#if 0 /* RXWRXW - Global/External */ - if (current_file->flag_external) { - cb_error (_("file cannot have both EXTERNAL and GLOBAL clauses")); - } -#endif - if (current_program->prog_type == COB_MODULE_TYPE_FUNCTION) { - cb_error (_("%s is invalid in a user FUNCTION"), "GLOBAL"); - } else { - current_file->flag_global = 1; - current_program->flag_file_global = 1; - } - } -#line 14996 "parser.c" /* yacc.c:1646 */ - break; - - case 462: -#line 5847 "parser.y" /* yacc.c:1646 */ - { - check_repeated ("BLOCK", SYN_CLAUSE_3, &check_duplicate); - /* ignore */ - } -#line 15005 "parser.c" /* yacc.c:1646 */ - break; - - case 466: -#line 5860 "parser.y" /* yacc.c:1646 */ - { - check_repeated ("RECORD", SYN_CLAUSE_4, &check_duplicate); - if (current_file->organization == COB_ORG_LINE_SEQUENTIAL) { - cb_warning (cb_warn_extra, _("RECORD clause ignored for LINE SEQUENTIAL")); - } else { - set_record_size (NULL, (yyvsp[-1])); - } - } -#line 15018 "parser.c" /* yacc.c:1646 */ - break; - - case 467: -#line 5869 "parser.y" /* yacc.c:1646 */ - { - check_repeated ("RECORD", SYN_CLAUSE_4, &check_duplicate); - if (current_file->organization == COB_ORG_LINE_SEQUENTIAL) { - cb_warning (cb_warn_extra, _("RECORD clause ignored for LINE SEQUENTIAL")); - } else { - set_record_size ((yyvsp[-3]), (yyvsp[-1])); - } - } -#line 15031 "parser.c" /* yacc.c:1646 */ - break; - - case 468: -#line 5879 "parser.y" /* yacc.c:1646 */ - { - check_repeated ("RECORD", SYN_CLAUSE_4, &check_duplicate); - set_record_size ((yyvsp[-3]), (yyvsp[-2])); - current_file->flag_check_record_varying_limits = - current_file->record_min == 0 || current_file->record_max == 0; - } -#line 15042 "parser.c" /* yacc.c:1646 */ - break; - - case 470: -#line 5889 "parser.y" /* yacc.c:1646 */ - { - current_file->record_depending = (yyvsp[0]); - } -#line 15050 "parser.c" /* yacc.c:1646 */ - break; - - case 471: -#line 5895 "parser.y" /* yacc.c:1646 */ - { (yyval) = NULL; } -#line 15056 "parser.c" /* yacc.c:1646 */ - break; - - case 472: -#line 5896 "parser.y" /* yacc.c:1646 */ - { (yyval) = (yyvsp[0]); } -#line 15062 "parser.c" /* yacc.c:1646 */ - break; - - case 473: -#line 5900 "parser.y" /* yacc.c:1646 */ - { (yyval) = NULL; } -#line 15068 "parser.c" /* yacc.c:1646 */ - break; - - case 474: -#line 5901 "parser.y" /* yacc.c:1646 */ - { (yyval) = (yyvsp[0]); } -#line 15074 "parser.c" /* yacc.c:1646 */ - break; - - case 475: -#line 5909 "parser.y" /* yacc.c:1646 */ - { - check_repeated ("LABEL", SYN_CLAUSE_5, &check_duplicate); - cb_verify (cb_label_records_clause, "LABEL RECORDS"); - } -#line 15083 "parser.c" /* yacc.c:1646 */ - break; - - case 476: -#line 5920 "parser.y" /* yacc.c:1646 */ - { - check_repeated ("VALUE OF", SYN_CLAUSE_6, &check_duplicate); - cb_verify (cb_value_of_clause, "VALUE OF"); - } -#line 15092 "parser.c" /* yacc.c:1646 */ - break; - - case 477: -#line 5925 "parser.y" /* yacc.c:1646 */ - { - check_repeated ("VALUE OF", SYN_CLAUSE_6, &check_duplicate); - cb_verify (cb_value_of_clause, "VALUE OF"); - if (!current_file->assign) { - current_file->assign = cb_build_assignment_name (current_file, (yyvsp[0])); - } - } -#line 15104 "parser.c" /* yacc.c:1646 */ - break; - - case 482: -#line 5948 "parser.y" /* yacc.c:1646 */ - { - check_repeated ("DATA", SYN_CLAUSE_7, &check_duplicate); - cb_verify (cb_data_records_clause, "DATA RECORDS"); - } -#line 15113 "parser.c" /* yacc.c:1646 */ - break; - - case 483: -#line 5960 "parser.y" /* yacc.c:1646 */ - { - check_repeated ("LINAGE", SYN_CLAUSE_8, &check_duplicate); - if (current_file->organization != COB_ORG_LINE_SEQUENTIAL && - current_file->organization != COB_ORG_SEQUENTIAL) { - cb_error (_("LINAGE clause with wrong file type")); - } else { - current_file->linage = (yyvsp[-2]); - current_file->organization = COB_ORG_LINE_SEQUENTIAL; - if (current_linage == 0) { - linage_file = current_file; - } - current_linage++; - } - } -#line 15132 "parser.c" /* yacc.c:1646 */ - break; - - case 489: -#line 5988 "parser.y" /* yacc.c:1646 */ - { - current_file->latfoot = (yyvsp[0]); - } -#line 15140 "parser.c" /* yacc.c:1646 */ - break; - - case 490: -#line 5995 "parser.y" /* yacc.c:1646 */ - { - current_file->lattop = (yyvsp[0]); - } -#line 15148 "parser.c" /* yacc.c:1646 */ - break; - - case 491: -#line 6002 "parser.y" /* yacc.c:1646 */ - { - current_file->latbot = (yyvsp[0]); - } -#line 15156 "parser.c" /* yacc.c:1646 */ - break; - - case 492: -#line 6011 "parser.y" /* yacc.c:1646 */ - { - cobc_cs_check ^= CB_CS_RECORDING; - check_repeated ("RECORDING", SYN_CLAUSE_9, &check_duplicate); - /* ignore */ - } -#line 15166 "parser.c" /* yacc.c:1646 */ - break; - - case 497: -#line 6024 "parser.y" /* yacc.c:1646 */ - { - if (current_file->organization != COB_ORG_SEQUENTIAL) { - cb_error (_("RECORDING MODE U or S can only be used with RECORD SEQUENTIAL files")); - } - } -#line 15176 "parser.c" /* yacc.c:1646 */ - break; - - case 500: -#line 6040 "parser.y" /* yacc.c:1646 */ - { - struct cb_alphabet_name *al; - - check_repeated ("CODE SET", SYN_CLAUSE_10, &check_duplicate); - - if (CB_VALID_TREE ((yyvsp[-1]))) { - al = CB_ALPHABET_NAME (cb_ref ((yyvsp[-1]))); - switch (al->alphabet_type) { -#ifdef COB_EBCDIC_MACHINE - case CB_ALPHABET_ASCII: -#else - case CB_ALPHABET_EBCDIC: -#endif - case CB_ALPHABET_CUSTOM: - current_file->code_set = al; - CB_PENDING ("CODE-SET"); - break; - default: - if (cb_warn_extra) { - cb_warning_x (cb_warn_extra, (yyvsp[-1]), _("ignoring CODE-SET '%s'"), - cb_name ((yyvsp[-1]))); - } else { - CB_PENDING ("CODE-SET"); - } - break; - } - } - - if (current_file->organization != COB_ORG_LINE_SEQUENTIAL && - current_file->organization != COB_ORG_SEQUENTIAL) { - cb_error (_("CODE-SET clause invalid for file type")); - } - - } -#line 15215 "parser.c" /* yacc.c:1646 */ - break; - - case 502: -#line 6078 "parser.y" /* yacc.c:1646 */ - { - CB_PENDING ("FOR sub-records"); - current_file->code_set_items = CB_LIST ((yyvsp[0])); - } -#line 15224 "parser.c" /* yacc.c:1646 */ - break; - - case 503: -#line 6088 "parser.y" /* yacc.c:1646 */ - { - check_repeated ("REPORT", SYN_CLAUSE_11, &check_duplicate); - if (current_file->organization != COB_ORG_LINE_SEQUENTIAL && - current_file->organization != COB_ORG_SEQUENTIAL) { - cb_error (_("REPORT clause with wrong file type")); - } else { - current_file->reports = (yyvsp[0]); - current_file->organization = COB_ORG_LINE_SEQUENTIAL; - current_file->flag_line_adv = 1; - } - } -#line 15240 "parser.c" /* yacc.c:1646 */ - break; - - case 506: -#line 6108 "parser.y" /* yacc.c:1646 */ - { - if (CB_VALID_TREE ((yyvsp[0]))) { - current_report = build_report ((yyvsp[0])); - current_report->file = current_file; - current_program->report_list = - cb_list_add (current_program->report_list, - CB_TREE (current_report)); - if (report_count == 0) { - report_instance = current_report; - } - report_count++; - } - } -#line 15258 "parser.c" /* yacc.c:1646 */ - break; - - case 507: -#line 6122 "parser.y" /* yacc.c:1646 */ - { - if (CB_VALID_TREE ((yyvsp[0]))) { - current_report = build_report ((yyvsp[0])); - current_report->file = current_file; - current_program->report_list = - cb_list_add (current_program->report_list, - CB_TREE (current_report)); - if (report_count == 0) { - report_instance = current_report; - } - report_count++; - } - } -#line 15276 "parser.c" /* yacc.c:1646 */ - break; - - case 509: -#line 6141 "parser.y" /* yacc.c:1646 */ - { - current_storage = CB_STORAGE_COMMUNICATION; - check_headers_present (COBC_HD_DATA_DIVISION, 0, 0, 0); - header_check |= COBC_HD_COMMUNICATION_SECTION; - /* add a compiler configuration if either */ - if (cb_std_define != CB_STD_85 - && cb_std_define != CB_STD_RM - && cb_std_define != CB_STD_GC - && !cb_relaxed_syntax_checks) { - cb_verify (CB_UNCONFORMABLE, "COMMUNICATION SECTION"); - } else if (cb_verify (CB_OBSOLETE, "COMMUNICATION SECTION")) { - CB_PENDING ("COMMUNICATION SECTION"); - } - } -#line 15295 "parser.c" /* yacc.c:1646 */ - break; - - case 513: -#line 6165 "parser.y" /* yacc.c:1646 */ - { - if (CB_VALID_TREE (current_cd)) { - if (CB_VALID_TREE ((yyvsp[0]))) { - cb_finalize_cd (current_cd, CB_FIELD ((yyvsp[0]))); - } else if (!current_cd->record) { - cb_error (_("CD record missing")); - } - } - } -#line 15309 "parser.c" /* yacc.c:1646 */ - break; - - case 514: -#line 6180 "parser.y" /* yacc.c:1646 */ - { - /* CD internally defines a new file */ - if (CB_VALID_TREE ((yyvsp[0]))) { - current_cd = cb_build_cd ((yyvsp[0])); - - CB_ADD_TO_CHAIN (CB_TREE (current_cd), - current_program->cd_list); - } else { - current_cd = NULL; - /* TO-DO: Is this necessary? */ - if (current_program->cd_list) { - current_program->cd_list - = CB_CHAIN (current_program->cd_list); - } - } - check_duplicate = 0; - } -#line 15331 "parser.c" /* yacc.c:1646 */ - break; - - case 562: -#line 6288 "parser.y" /* yacc.c:1646 */ - { - check_headers_present (COBC_HD_DATA_DIVISION, 0, 0, 0); - header_check |= COBC_HD_WORKING_STORAGE_SECTION; - current_storage = CB_STORAGE_WORKING; - } -#line 15341 "parser.c" /* yacc.c:1646 */ - break; - - case 563: -#line 6294 "parser.y" /* yacc.c:1646 */ - { - if ((yyvsp[0])) { - CB_FIELD_ADD (current_program->working_storage, CB_FIELD ((yyvsp[0]))); - } - } -#line 15351 "parser.c" /* yacc.c:1646 */ - break; - - case 564: -#line 6303 "parser.y" /* yacc.c:1646 */ - { - (yyval) = NULL; - } -#line 15359 "parser.c" /* yacc.c:1646 */ - break; - - case 565: -#line 6307 "parser.y" /* yacc.c:1646 */ - { - current_field = NULL; - control_field = NULL; - description_field = NULL; - cb_clear_real_field (); - } -#line 15370 "parser.c" /* yacc.c:1646 */ - break; - - case 566: -#line 6314 "parser.y" /* yacc.c:1646 */ - { - struct cb_field *p; - /* finalize last field if target of SAME AS */ - if (current_field && !CB_INVALID_TREE (current_field->same_as)) { - inherit_same_as (); - } - - for (p = description_field; p; p = p->sister) { - cb_validate_field (p); - } - (yyval) = CB_TREE (description_field); - } -#line 15387 "parser.c" /* yacc.c:1646 */ - break; - - case 572: -#line 6338 "parser.y" /* yacc.c:1646 */ - { - if (current_field && !CB_INVALID_TREE (current_field->same_as)) { - /* finalize last field if target of SAME AS */ - inherit_same_as (); - } - if (set_current_field ((yyvsp[-1]), (yyvsp[0]))) { - YYERROR; - } - save_tree = NULL; - } -#line 15402 "parser.c" /* yacc.c:1646 */ - break; - - case 573: -#line 6349 "parser.y" /* yacc.c:1646 */ - { - if (!qualifier) { - current_field->flag_filler = 1; - } - if (!description_field) { - description_field = current_field; - } - } -#line 15415 "parser.c" /* yacc.c:1646 */ - break; - - case 574: -#line 6358 "parser.y" /* yacc.c:1646 */ - { -#if 0 /* works fine without, leads to invalid free otherwise [COB_TREE_DEBUG] */ - /* Free tree associated with level number */ - cobc_parse_free ((yyvsp[-2])); -#endif - yyerrok; - cb_unput_dot (); - check_pic_duplicate = 0; - check_duplicate = 0; -#if 0 /* CHECKME - *Why* would we want to change the field here? */ - current_field = cb_get_real_field (); -#endif - } -#line 15433 "parser.c" /* yacc.c:1646 */ - break; - - case 575: -#line 6375 "parser.y" /* yacc.c:1646 */ - { - (yyval) = (yyvsp[0]); - } -#line 15441 "parser.c" /* yacc.c:1646 */ - break; - - case 578: -#line 6387 "parser.y" /* yacc.c:1646 */ - { - (yyval) = cb_build_filler (); - qualifier = NULL; - keys_list = NULL; - non_const_word = 0; - } -#line 15452 "parser.c" /* yacc.c:1646 */ - break; - - case 580: -#line 6398 "parser.y" /* yacc.c:1646 */ - { - (yyval) = (yyvsp[0]); - qualifier = (yyvsp[0]); - keys_list = NULL; - non_const_word = 0; - } -#line 15463 "parser.c" /* yacc.c:1646 */ - break; - - case 581: -#line 6408 "parser.y" /* yacc.c:1646 */ - { - (yyval) = NULL; - } -#line 15471 "parser.c" /* yacc.c:1646 */ - break; - - case 582: -#line 6412 "parser.y" /* yacc.c:1646 */ - { - if (current_program->prog_type == COB_MODULE_TYPE_FUNCTION) { - cb_error (_("%s is invalid in a user FUNCTION"), "GLOBAL"); - (yyval) = NULL; - } else { - (yyval) = cb_null; - } - } -#line 15484 "parser.c" /* yacc.c:1646 */ - break; - - case 583: -#line 6423 "parser.y" /* yacc.c:1646 */ - { (yyval) = (yyvsp[0]); } -#line 15490 "parser.c" /* yacc.c:1646 */ - break; - - case 584: -#line 6424 "parser.y" /* yacc.c:1646 */ - { (yyval) = cb_build_const_length ((yyvsp[0])); } -#line 15496 "parser.c" /* yacc.c:1646 */ - break; - - case 585: -#line 6426 "parser.y" /* yacc.c:1646 */ - { (yyval) = cb_build_const_length ((yyvsp[0])); } -#line 15502 "parser.c" /* yacc.c:1646 */ - break; - - case 586: -#line 6431 "parser.y" /* yacc.c:1646 */ - { - (yyval) = (yyvsp[0]); - } -#line 15510 "parser.c" /* yacc.c:1646 */ - break; - - case 587: -#line 6435 "parser.y" /* yacc.c:1646 */ - { - (yyval) = (yyvsp[0]); - } -#line 15518 "parser.c" /* yacc.c:1646 */ - break; - - case 588: -#line 6441 "parser.y" /* yacc.c:1646 */ - { - (yyval) = cb_int1; - } -#line 15526 "parser.c" /* yacc.c:1646 */ - break; - - case 589: -#line 6445 "parser.y" /* yacc.c:1646 */ - { - (yyval) = cb_int2; - } -#line 15534 "parser.c" /* yacc.c:1646 */ - break; - - case 590: -#line 6449 "parser.y" /* yacc.c:1646 */ - { - (yyval) = cb_int4; - } -#line 15542 "parser.c" /* yacc.c:1646 */ - break; - - case 591: -#line 6453 "parser.y" /* yacc.c:1646 */ - { - (yyval) = cb_int8; - } -#line 15550 "parser.c" /* yacc.c:1646 */ - break; - - case 592: -#line 6457 "parser.y" /* yacc.c:1646 */ - { - (yyval) = cb_int ((int)sizeof(long)); - } -#line 15558 "parser.c" /* yacc.c:1646 */ - break; - - case 593: -#line 6461 "parser.y" /* yacc.c:1646 */ - { - (yyval) = cb_int ((int)sizeof(void *)); - } -#line 15566 "parser.c" /* yacc.c:1646 */ - break; - - case 594: -#line 6465 "parser.y" /* yacc.c:1646 */ - { - if (cb_binary_comp_1) { - (yyval) = cb_int2; - } else { - (yyval) = cb_int ((int)sizeof(float)); - } - } -#line 15578 "parser.c" /* yacc.c:1646 */ - break; - - case 595: -#line 6473 "parser.y" /* yacc.c:1646 */ - { - (yyval) = cb_int ((int)sizeof(float)); - } -#line 15586 "parser.c" /* yacc.c:1646 */ - break; - - case 596: -#line 6477 "parser.y" /* yacc.c:1646 */ - { - (yyval) = cb_int ((int)sizeof(double)); - } -#line 15594 "parser.c" /* yacc.c:1646 */ - break; - - case 597: -#line 6481 "parser.y" /* yacc.c:1646 */ - { - (yyval) = cb_int4; - } -#line 15602 "parser.c" /* yacc.c:1646 */ - break; - - case 598: -#line 6485 "parser.y" /* yacc.c:1646 */ - { - (yyval) = cb_int8; - } -#line 15610 "parser.c" /* yacc.c:1646 */ - break; - - case 599: -#line 6489 "parser.y" /* yacc.c:1646 */ - { - (yyval) = cb_int16; - } -#line 15618 "parser.c" /* yacc.c:1646 */ - break; - - case 600: -#line 6493 "parser.y" /* yacc.c:1646 */ - { - yyerrok; - cb_unput_dot (); - check_pic_duplicate = 0; - check_duplicate = 0; - current_field = cb_get_real_field (); - } -#line 15630 "parser.c" /* yacc.c:1646 */ - break; - - case 610: -#line 6525 "parser.y" /* yacc.c:1646 */ - { - cb_tree renames_target = cb_ref ((yyvsp[-1])); - - size_t sav = cb_needs_01; - cb_needs_01 = 0; - - non_const_word = 0; - - if (set_current_field ((yyvsp[-5]), (yyvsp[-4]))) { - /* error in the definition, no further checks possible */ - } else if (renames_target == cb_error_node) { - /* error in the target, skip further checks */ - current_field->flag_invalid = 1; - } else { - cb_tree renames_thru = (yyvsp[0]); - - current_field->redefines = CB_FIELD (renames_target); - if (renames_thru) { - renames_thru = cb_ref (renames_thru); - } - if (CB_VALID_TREE (renames_thru)) { - current_field->rename_thru = CB_FIELD (renames_thru); - } else { - /* If there is no THRU clause, RENAMES acts like REDEFINES. */ - current_field->pic = current_field->redefines->pic; - } - - if (cb_validate_renames_item (current_field, (yyvsp[-1]), (yyvsp[0]))) { - current_field->flag_invalid = 1; - } else { - /* ensure the reference was validated as this - also calculates the reference' picture and size */ - if (!current_field->redefines->flag_is_verified) { - cb_validate_field (current_field->redefines); - } - } - } - cb_needs_01 = sav; - } -#line 15674 "parser.c" /* yacc.c:1646 */ - break; - - case 611: -#line 6568 "parser.y" /* yacc.c:1646 */ - { - (yyval) = NULL; - } -#line 15682 "parser.c" /* yacc.c:1646 */ - break; - - case 612: -#line 6572 "parser.y" /* yacc.c:1646 */ - { - (yyval) = (yyvsp[0]) == cb_error_node ? NULL : (yyvsp[0]); - } -#line 15690 "parser.c" /* yacc.c:1646 */ - break; - - case 613: -#line 6579 "parser.y" /* yacc.c:1646 */ - { - if (set_current_field ((yyvsp[-1]), (yyvsp[0]))) { - YYERROR; - } - } -#line 15700 "parser.c" /* yacc.c:1646 */ - break; - - case 614: -#line 6585 "parser.y" /* yacc.c:1646 */ - { - cb_validate_88_item (current_field); - } -#line 15708 "parser.c" /* yacc.c:1646 */ - break; - - case 615: -#line 6592 "parser.y" /* yacc.c:1646 */ - { - cb_tree x; - int level; - - cobc_cs_check = 0; - level = cb_get_level ((yyvsp[-4])); - /* Free tree associated with level number */ - cobc_parse_free ((yyvsp[-4])); - if (level != 1) { - cb_error (_("CONSTANT item not at 01 level")); - } else if ((yyvsp[0])) { - if (cb_verify(cb_constant_01, "01 CONSTANT")) { - x = cb_build_constant ((yyvsp[-3]), (yyvsp[0])); - CB_FIELD (x)->flag_item_78 = 1; - CB_FIELD (x)->flag_constant = 1; - CB_FIELD (x)->level = 1; - CB_FIELD (x)->values = (yyvsp[0]); - cb_needs_01 = 1; - if ((yyvsp[-1])) { - CB_FIELD (x)->flag_is_global = 1; - } - /* Ignore return value */ - (void)cb_validate_78_item (CB_FIELD (x), 0); - } - } - } -#line 15739 "parser.c" /* yacc.c:1646 */ - break; - - case 616: -#line 6619 "parser.y" /* yacc.c:1646 */ - { - if (set_current_field ((yyvsp[-1]), (yyvsp[0]))) { - YYERROR; - } - } -#line 15749 "parser.c" /* yacc.c:1646 */ - break; - - case 617: -#line 6626 "parser.y" /* yacc.c:1646 */ - { - /* Reset to last non-78 item */ - current_field = cb_validate_78_item (current_field, 0); - } -#line 15758 "parser.c" /* yacc.c:1646 */ - break; - - case 618: -#line 6634 "parser.y" /* yacc.c:1646 */ - { - (yyval) = (yyvsp[0]); - } -#line 15766 "parser.c" /* yacc.c:1646 */ - break; - - case 619: -#line 6638 "parser.y" /* yacc.c:1646 */ - { - (yyval) = CB_LIST_INIT(cb_build_const_from ((yyvsp[0]))); - } -#line 15774 "parser.c" /* yacc.c:1646 */ - break; - - case 620: -#line 6645 "parser.y" /* yacc.c:1646 */ - { - if (CB_VALID_TREE (current_field)) { - current_field->values = (yyvsp[0]); - } - } -#line 15784 "parser.c" /* yacc.c:1646 */ - break; - - case 621: -#line 6651 "parser.y" /* yacc.c:1646 */ - { - current_field->values = CB_LIST_INIT (cb_build_const_start (current_field, (yyvsp[0]))); - } -#line 15792 "parser.c" /* yacc.c:1646 */ - break; - - case 622: -#line 6655 "parser.y" /* yacc.c:1646 */ - { - current_field->values = CB_LIST_INIT (cb_build_const_next (current_field)); - } -#line 15800 "parser.c" /* yacc.c:1646 */ - break; - - case 623: -#line 6661 "parser.y" /* yacc.c:1646 */ - { (yyval) = CB_LIST_INIT ((yyvsp[0])); } -#line 15806 "parser.c" /* yacc.c:1646 */ - break; - - case 624: -#line 6662 "parser.y" /* yacc.c:1646 */ - { (yyval) = cb_list_add ((yyvsp[-1]), (yyvsp[0])); } -#line 15812 "parser.c" /* yacc.c:1646 */ - break; - - case 625: -#line 6666 "parser.y" /* yacc.c:1646 */ - { (yyval) = (yyvsp[0]); } -#line 15818 "parser.c" /* yacc.c:1646 */ - break; - - case 626: -#line 6667 "parser.y" /* yacc.c:1646 */ - { (yyval) = cb_build_alphanumeric_literal ("(", 1); } -#line 15824 "parser.c" /* yacc.c:1646 */ - break; - - case 627: -#line 6668 "parser.y" /* yacc.c:1646 */ - { (yyval) = cb_build_alphanumeric_literal (")", 1); } -#line 15830 "parser.c" /* yacc.c:1646 */ - break; - - case 628: -#line 6669 "parser.y" /* yacc.c:1646 */ - { (yyval) = cb_build_alphanumeric_literal ("+", 1); } -#line 15836 "parser.c" /* yacc.c:1646 */ - break; - - case 629: -#line 6670 "parser.y" /* yacc.c:1646 */ - { (yyval) = cb_build_alphanumeric_literal ("-", 1); } -#line 15842 "parser.c" /* yacc.c:1646 */ - break; - - case 630: -#line 6671 "parser.y" /* yacc.c:1646 */ - { (yyval) = cb_build_alphanumeric_literal ("*", 1); } -#line 15848 "parser.c" /* yacc.c:1646 */ - break; - - case 631: -#line 6672 "parser.y" /* yacc.c:1646 */ - { (yyval) = cb_build_alphanumeric_literal ("/", 1); } -#line 15854 "parser.c" /* yacc.c:1646 */ - break; - - case 632: -#line 6673 "parser.y" /* yacc.c:1646 */ - { (yyval) = cb_build_alphanumeric_literal ("&", 1); } -#line 15860 "parser.c" /* yacc.c:1646 */ - break; - - case 633: -#line 6674 "parser.y" /* yacc.c:1646 */ - { (yyval) = cb_build_alphanumeric_literal ("|", 1); } -#line 15866 "parser.c" /* yacc.c:1646 */ - break; - - case 634: -#line 6675 "parser.y" /* yacc.c:1646 */ - { (yyval) = cb_build_alphanumeric_literal ("^", 1); } -#line 15872 "parser.c" /* yacc.c:1646 */ - break; - - case 637: -#line 6685 "parser.y" /* yacc.c:1646 */ - { - save_tree = cb_int0; - } -#line 15880 "parser.c" /* yacc.c:1646 */ - break; - - case 657: -#line 6717 "parser.y" /* yacc.c:1646 */ - { - check_repeated ("REDEFINES", SYN_CLAUSE_1, &check_pic_duplicate); - if (save_tree != NULL) { - cb_verify_x ((yyvsp[0]), cb_free_redefines_position, - _("REDEFINES clause not following entry-name")); - } - - current_field->redefines = cb_resolve_redefines (current_field, (yyvsp[0])); - if (current_field->redefines == NULL) { - current_field->flag_is_verified = 1; - current_field->flag_invalid = 1; - YYERROR; - } - } -#line 15899 "parser.c" /* yacc.c:1646 */ - break; - - case 658: -#line 6738 "parser.y" /* yacc.c:1646 */ - { - cb_tree x = (yyvsp[0]); - check_repeated ("SAME AS", SYN_CLAUSE_30, &check_pic_duplicate); - - /* note: syntax checks for conflicting clauses done in inherit_same_as */ - if (cb_verify (cb_same_as_clause, _("SAME AS clause")) - && x != cb_error_node) { - struct cb_field *f = CB_FIELD (cb_ref (x)); - if (f->storage == CB_STORAGE_SCREEN) { - cb_error (_("SCREEN item cannot be used here")); - x = cb_error_node; - } else if (f->storage == CB_STORAGE_REPORT) { - cb_error (_("REPORT item cannot be used here")); - x = cb_error_node; - } else if (f->level == 88) { - cb_error (_("condition-name not allowed here: '%s'"), cb_name (x)); - x = cb_error_node; - } else if (current_field->level == 77) { - if (f->children) { - cb_error (_("elementary item expected")); - x = cb_error_node; - } - } else { - struct cb_field *p; - for (p = current_field; p; p = p->parent) { - if (p == f) { - cb_error (_ ("SAME AS item may not reference itself")); - x = cb_error_node; - break; - } - } - for (p = f->parent; p; p = p->parent) { - if (p->usage != CB_USAGE_DISPLAY) { - cb_error (_("SAME AS item may not be subordinate to any item with USAGE clause")); - } else if (p->flag_sign_clause) { - cb_error (_("SAME AS item may not be subordinate to any item with SIGN clause")); - } else { - continue; - } - x = cb_error_node; - break; - } - } - } - - if (x == cb_error_node) { - current_field->flag_is_verified = 1; - current_field->flag_invalid = 1; - current_field->same_as = x; - } else { - current_field->same_as = cb_ref (x); - } - } -#line 15957 "parser.c" /* yacc.c:1646 */ - break; - - case 659: -#line 6798 "parser.y" /* yacc.c:1646 */ - { - check_repeated ("EXTERNAL", SYN_CLAUSE_2, &check_pic_duplicate); - if (current_storage != CB_STORAGE_WORKING) { - cb_error (_("%s not allowed here"), "EXTERNAL"); - } else if (current_field->level != 1 && current_field->level != 77) { - cb_error (_("%s only allowed at 01/77 level"), "EXTERNAL"); - } else if (!qualifier) { - cb_error (_("%s requires a data name"), "EXTERNAL"); -#if 0 /* RXWRXW - Global/External */ - } else if (current_field->flag_is_global) { - cb_error (_("%s and %s are mutually exclusive"), "GLOBAL", "EXTERNAL"); -#endif - } else if (current_field->flag_item_based) { - cb_error (_("%s and %s are mutually exclusive"), "BASED", "EXTERNAL"); - } else if (current_field->redefines) { - cb_error (_("%s and %s are mutually exclusive"), "EXTERNAL", "REDEFINES"); - } else if (current_field->flag_occurs) { - cb_error (_("%s and %s are mutually exclusive"), "EXTERNAL", "OCCURS"); - } else { - current_field->flag_external = 1; - current_program->flag_has_external = 1; - } - } -#line 15985 "parser.c" /* yacc.c:1646 */ - break; - - case 660: -#line 6825 "parser.y" /* yacc.c:1646 */ - { - current_field->ename = cb_to_cname (current_field->name); - } -#line 15993 "parser.c" /* yacc.c:1646 */ - break; - - case 661: -#line 6829 "parser.y" /* yacc.c:1646 */ - { - current_field->ename = cb_to_cname ((const char *)CB_LITERAL ((yyvsp[0]))->data); - } -#line 16001 "parser.c" /* yacc.c:1646 */ - break; - - case 664: -#line 6842 "parser.y" /* yacc.c:1646 */ - { - check_repeated ("GLOBAL", SYN_CLAUSE_3, &check_pic_duplicate); - if (current_field->level != 1 && current_field->level != 77) { - cb_error (_("%s only allowed at 01/77 level"), "GLOBAL"); - } else if (!qualifier) { - cb_error (_("%s requires a data name"), "GLOBAL"); -#if 0 /* RXWRXW - Global/External */ - } else if (current_field->flag_external) { - cb_error (_("%s and %s are mutually exclusive"), "GLOBAL", "EXTERNAL"); -#endif - } else if (current_program->prog_type == COB_MODULE_TYPE_FUNCTION) { - cb_error (_("%s is invalid in a user FUNCTION"), "GLOBAL"); - } else if (current_storage == CB_STORAGE_LOCAL) { - cb_error (_("%s not allowed here"), "GLOBAL"); - } else { - current_field->flag_is_global = 1; - } - } -#line 16024 "parser.c" /* yacc.c:1646 */ - break; - - case 665: -#line 6866 "parser.y" /* yacc.c:1646 */ - { - if (current_program->nested_level) { - cb_error (_("%s not allowed in nested programs"), "SPECIAL-NAMES"); - } else { - cb_verify (cb_special_names_clause, "SPECIAL-NAMES clause"); - } - } -#line 16036 "parser.c" /* yacc.c:1646 */ - break; - - case 667: -#line 6878 "parser.y" /* yacc.c:1646 */ - { - if (current_program->cursor_pos) { - emit_duplicate_clause_message ("CURSOR"); - } else { - current_program->cursor_pos = cb_build_reference (current_field->name); - } - } -#line 16048 "parser.c" /* yacc.c:1646 */ - break; - - case 668: -#line 6886 "parser.y" /* yacc.c:1646 */ - { - if (current_program->crt_status) { - emit_duplicate_clause_message ("CRT STATUS"); - } else { - current_program->crt_status = cb_build_reference (current_field->name); - } - } -#line 16060 "parser.c" /* yacc.c:1646 */ - break; - - case 669: -#line 6903 "parser.y" /* yacc.c:1646 */ - { -#if 0 /* not yet implemented */ - if (current_program->screen_control) { - emit_duplicate_clause_message ("SCREEN CONTROL"); - } else { - CB_PENDING ("SCREEN CONTROL"); - } -#else - CB_PENDING ("SCREEN CONTROL"); -#endif - } -#line 16076 "parser.c" /* yacc.c:1646 */ - break; - - case 670: -#line 6915 "parser.y" /* yacc.c:1646 */ - { -#if 0 /* not yet implemented */ - if (current_program->event_status) { - emit_duplicate_clause_message ("EVENT STATUS"); - } else { - CB_PENDING ("EVENT STATUS"); - } -#else - CB_PENDING ("EVENT STATUS"); -#endif - } -#line 16092 "parser.c" /* yacc.c:1646 */ - break; - - case 671: -#line 6932 "parser.y" /* yacc.c:1646 */ - { - check_repeated ("VOLATILE", SYN_CLAUSE_24, &check_pic_duplicate); - /* note: there is no reason to check current_storage as we only parse - volatile_clause and its parent tokens where applicable, - same is true for level 66,78,88 */ - /* missing part: always generate and initialize storage */ - CB_UNFINISHED ("VOLATILE"); - current_field->flag_volatile = 1; - /* TODO: set VOLATILE flag for all parent fields */ - } -#line 16107 "parser.c" /* yacc.c:1646 */ - break; - - case 672: -#line 6950 "parser.y" /* yacc.c:1646 */ - { - check_repeated ("PICTURE", SYN_CLAUSE_4, &check_pic_duplicate); - current_field->pic = CB_PICTURE ((yyvsp[-1])); - - if ((yyvsp[0]) && (yyvsp[0]) != cb_error_node) { - if ( (current_field->pic->category != CB_CATEGORY_NUMERIC - && current_field->pic->category != CB_CATEGORY_NUMERIC_EDITED) - || strpbrk (current_field->pic->orig, " CRDB-*") /* the standard seems to forbid also ',' */) { - cb_error_x ((yyvsp[-1]), _("a locale-format PICTURE string must only consist of '9', '.', '+', 'Z' and the currency-sign")); - } else { - /* TODO: check that not in or part of CONSTANT RECORD */ - CB_PENDING_X ((yyvsp[-1]), "locale-format PICTURE"); - } - } - } -#line 16127 "parser.c" /* yacc.c:1646 */ - break; - - case 673: -#line 6969 "parser.y" /* yacc.c:1646 */ - { (yyval) = NULL; } -#line 16133 "parser.c" /* yacc.c:1646 */ - break; - - case 674: -#line 6971 "parser.y" /* yacc.c:1646 */ - { - /* $2 -> optional locale-name to be used */ - (yyval) = (yyvsp[0]); - } -#line 16142 "parser.c" /* yacc.c:1646 */ - break; - - case 676: -#line 6980 "parser.y" /* yacc.c:1646 */ - { - (yyval) = (yyvsp[0]); - } -#line 16150 "parser.c" /* yacc.c:1646 */ - break; - - case 677: -#line 6988 "parser.y" /* yacc.c:1646 */ - { - if (CB_LOCALE_NAME_P (cb_ref ((yyvsp[0])))) { - (yyval) = (yyvsp[0]); - } else { - cb_error_x ((yyvsp[0]), _("'%s' is not a locale-name"), cb_name ((yyvsp[0]))); - (yyval) = cb_error_node; - } - } -#line 16163 "parser.c" /* yacc.c:1646 */ - break; - - case 680: -#line 7005 "parser.y" /* yacc.c:1646 */ - { - if (is_reserved_word (CB_NAME ((yyvsp[0])))) { - cb_error_x ((yyvsp[0]), _("'%s' is not a valid USAGE"), CB_NAME ((yyvsp[0]))); - } else if (is_default_reserved_word (CB_NAME ((yyvsp[0])))) { - cb_error_x ((yyvsp[0]), _("'%s' is not defined, but is a reserved word in another dialect"), - CB_NAME ((yyvsp[0]))); - } else { - cb_error_x ((yyvsp[0]), _("unknown USAGE: %s"), CB_NAME ((yyvsp[0]))); - } - check_and_set_usage (CB_USAGE_ERROR); - YYERROR; - } -#line 16180 "parser.c" /* yacc.c:1646 */ - break; - - case 681: -#line 7018 "parser.y" /* yacc.c:1646 */ - { - check_and_set_usage (CB_USAGE_ERROR); - } -#line 16188 "parser.c" /* yacc.c:1646 */ - break; - - case 682: -#line 7025 "parser.y" /* yacc.c:1646 */ - { - check_and_set_usage (CB_USAGE_BINARY); - } -#line 16196 "parser.c" /* yacc.c:1646 */ - break; - - case 683: -#line 7029 "parser.y" /* yacc.c:1646 */ - { - check_and_set_usage (CB_USAGE_BIT); - CB_PENDING ("USAGE BIT"); - } -#line 16205 "parser.c" /* yacc.c:1646 */ - break; - - case 684: -#line 7034 "parser.y" /* yacc.c:1646 */ - { - check_and_set_usage (CB_USAGE_BINARY); - } -#line 16213 "parser.c" /* yacc.c:1646 */ - break; - - case 685: -#line 7038 "parser.y" /* yacc.c:1646 */ - { - /* see FR #310 */ - CB_PENDING ("USAGE COMP-0"); - } -#line 16222 "parser.c" /* yacc.c:1646 */ - break; - - case 686: -#line 7043 "parser.y" /* yacc.c:1646 */ - { - current_field->flag_comp_1 = 1; - if (cb_binary_comp_1) { - check_and_set_usage (CB_USAGE_SIGNED_SHORT); - current_field->flag_synchronized = 1; - } else { - check_and_set_usage (CB_USAGE_FLOAT); - } - } -#line 16236 "parser.c" /* yacc.c:1646 */ - break; - - case 687: -#line 7053 "parser.y" /* yacc.c:1646 */ - { - check_and_set_usage (CB_USAGE_DOUBLE); - } -#line 16244 "parser.c" /* yacc.c:1646 */ - break; - - case 688: -#line 7057 "parser.y" /* yacc.c:1646 */ - { - check_and_set_usage (CB_USAGE_PACKED); - } -#line 16252 "parser.c" /* yacc.c:1646 */ - break; - - case 689: -#line 7061 "parser.y" /* yacc.c:1646 */ - { - check_and_set_usage (CB_USAGE_BINARY); - } -#line 16260 "parser.c" /* yacc.c:1646 */ - break; - - case 690: -#line 7065 "parser.y" /* yacc.c:1646 */ - { - check_and_set_usage (CB_USAGE_COMP_5); - } -#line 16268 "parser.c" /* yacc.c:1646 */ - break; - - case 691: -#line 7069 "parser.y" /* yacc.c:1646 */ - { - check_and_set_usage (CB_USAGE_COMP_6); - } -#line 16276 "parser.c" /* yacc.c:1646 */ - break; - - case 692: -#line 7073 "parser.y" /* yacc.c:1646 */ - { - check_and_set_usage (CB_USAGE_COMP_X); - } -#line 16284 "parser.c" /* yacc.c:1646 */ - break; - - case 693: -#line 7077 "parser.y" /* yacc.c:1646 */ - { - check_and_set_usage (CB_USAGE_COMP_N); - } -#line 16292 "parser.c" /* yacc.c:1646 */ - break; - - case 694: -#line 7081 "parser.y" /* yacc.c:1646 */ - { - check_and_set_usage (CB_USAGE_FLOAT); - } -#line 16300 "parser.c" /* yacc.c:1646 */ - break; - - case 695: -#line 7085 "parser.y" /* yacc.c:1646 */ - { - check_and_set_usage (CB_USAGE_DISPLAY); - } -#line 16308 "parser.c" /* yacc.c:1646 */ - break; - - case 696: -#line 7089 "parser.y" /* yacc.c:1646 */ - { - check_and_set_usage (CB_USAGE_INDEX); - } -#line 16316 "parser.c" /* yacc.c:1646 */ - break; - - case 697: -#line 7093 "parser.y" /* yacc.c:1646 */ - { - check_and_set_usage (CB_USAGE_PACKED); - } -#line 16324 "parser.c" /* yacc.c:1646 */ - break; - - case 698: -#line 7097 "parser.y" /* yacc.c:1646 */ - { - check_and_set_usage (CB_USAGE_POINTER); - current_field->flag_is_pointer = 1; - } -#line 16333 "parser.c" /* yacc.c:1646 */ - break; - - case 699: -#line 7102 "parser.y" /* yacc.c:1646 */ - { - check_and_set_usage (CB_USAGE_PROGRAM_POINTER); - current_field->flag_is_pointer = 1; - } -#line 16342 "parser.c" /* yacc.c:1646 */ - break; - - case 700: -#line 7107 "parser.y" /* yacc.c:1646 */ - { - check_and_set_usage (CB_USAGE_HNDL); - } -#line 16350 "parser.c" /* yacc.c:1646 */ - break; - - case 701: -#line 7111 "parser.y" /* yacc.c:1646 */ - { - check_and_set_usage (CB_USAGE_HNDL_WINDOW); - } -#line 16358 "parser.c" /* yacc.c:1646 */ - break; - - case 702: -#line 7115 "parser.y" /* yacc.c:1646 */ - { - check_and_set_usage (CB_USAGE_HNDL_SUBWINDOW); - } -#line 16366 "parser.c" /* yacc.c:1646 */ - break; - - case 703: -#line 7119 "parser.y" /* yacc.c:1646 */ - { - check_and_set_usage (CB_USAGE_HNDL_FONT); - CB_PENDING ("HANDLE OF FONT"); - } -#line 16375 "parser.c" /* yacc.c:1646 */ - break; - - case 704: -#line 7124 "parser.y" /* yacc.c:1646 */ - { - check_and_set_usage (CB_USAGE_HNDL_THREAD); - } -#line 16383 "parser.c" /* yacc.c:1646 */ - break; - - case 705: -#line 7128 "parser.y" /* yacc.c:1646 */ - { - check_and_set_usage (CB_USAGE_HNDL_MENU); - CB_PENDING ("HANDLE OF MENU"); - } -#line 16392 "parser.c" /* yacc.c:1646 */ - break; - - case 706: -#line 7133 "parser.y" /* yacc.c:1646 */ - { - check_and_set_usage (CB_USAGE_HNDL_VARIANT); - } -#line 16400 "parser.c" /* yacc.c:1646 */ - break; - - case 707: -#line 7137 "parser.y" /* yacc.c:1646 */ - { - check_and_set_usage (CB_USAGE_HNDL_LM); - CB_PENDING ("HANDLE OF LAYOUT-MANAGER"); - } -#line 16409 "parser.c" /* yacc.c:1646 */ - break; - - case 708: -#line 7142 "parser.y" /* yacc.c:1646 */ - { - check_and_set_usage (CB_USAGE_HNDL); - CB_PENDING ("HANDLE OF control-type"); - } -#line 16418 "parser.c" /* yacc.c:1646 */ - break; - - case 709: -#line 7147 "parser.y" /* yacc.c:1646 */ - { - check_and_set_usage (CB_USAGE_HNDL); - cb_error_x ((yyvsp[0]), _("unknown HANDLE type: %s"), CB_NAME ((yyvsp[0]))); - } -#line 16427 "parser.c" /* yacc.c:1646 */ - break; - - case 710: -#line 7152 "parser.y" /* yacc.c:1646 */ - { - check_and_set_usage (CB_USAGE_SIGNED_SHORT); - current_field->flag_synchronized = 1; - } -#line 16436 "parser.c" /* yacc.c:1646 */ - break; - - case 711: -#line 7157 "parser.y" /* yacc.c:1646 */ - { - check_and_set_usage (CB_USAGE_SIGNED_INT); - current_field->flag_synchronized = 1; - } -#line 16445 "parser.c" /* yacc.c:1646 */ - break; - - case 712: -#line 7162 "parser.y" /* yacc.c:1646 */ - { -#ifdef COB_32_BIT_LONG - check_and_set_usage (CB_USAGE_SIGNED_INT); -#else - check_and_set_usage (CB_USAGE_SIGNED_LONG); -#endif - current_field->flag_synchronized = 1; - } -#line 16458 "parser.c" /* yacc.c:1646 */ - break; - - case 713: -#line 7171 "parser.y" /* yacc.c:1646 */ - { - check_and_set_usage (CB_USAGE_UNSIGNED_SHORT); - current_field->flag_synchronized = 1; - } -#line 16467 "parser.c" /* yacc.c:1646 */ - break; - - case 714: -#line 7176 "parser.y" /* yacc.c:1646 */ - { - check_and_set_usage (CB_USAGE_UNSIGNED_INT); - current_field->flag_synchronized = 1; - } -#line 16476 "parser.c" /* yacc.c:1646 */ - break; - - case 715: -#line 7181 "parser.y" /* yacc.c:1646 */ - { -#ifdef COB_32_BIT_LONG - check_and_set_usage (CB_USAGE_UNSIGNED_INT); -#else - check_and_set_usage (CB_USAGE_UNSIGNED_LONG); -#endif - current_field->flag_synchronized = 1; - } -#line 16489 "parser.c" /* yacc.c:1646 */ - break; - - case 716: -#line 7190 "parser.y" /* yacc.c:1646 */ - { - check_and_set_usage (CB_USAGE_SIGNED_CHAR); - } -#line 16497 "parser.c" /* yacc.c:1646 */ - break; - - case 717: -#line 7194 "parser.y" /* yacc.c:1646 */ - { - check_and_set_usage (CB_USAGE_UNSIGNED_CHAR); - } -#line 16505 "parser.c" /* yacc.c:1646 */ - break; - - case 718: -#line 7198 "parser.y" /* yacc.c:1646 */ - { - check_and_set_usage (CB_USAGE_SIGNED_SHORT); - } -#line 16513 "parser.c" /* yacc.c:1646 */ - break; - - case 719: -#line 7202 "parser.y" /* yacc.c:1646 */ - { - check_and_set_usage (CB_USAGE_UNSIGNED_SHORT); - } -#line 16521 "parser.c" /* yacc.c:1646 */ - break; - - case 720: -#line 7206 "parser.y" /* yacc.c:1646 */ - { - check_and_set_usage (CB_USAGE_SIGNED_INT); - } -#line 16529 "parser.c" /* yacc.c:1646 */ - break; - - case 721: -#line 7210 "parser.y" /* yacc.c:1646 */ - { - check_and_set_usage (CB_USAGE_UNSIGNED_INT); - } -#line 16537 "parser.c" /* yacc.c:1646 */ - break; - - case 722: -#line 7214 "parser.y" /* yacc.c:1646 */ - { - check_and_set_usage (CB_USAGE_SIGNED_LONG); - } -#line 16545 "parser.c" /* yacc.c:1646 */ - break; - - case 723: -#line 7218 "parser.y" /* yacc.c:1646 */ - { - check_and_set_usage (CB_USAGE_UNSIGNED_LONG); - } -#line 16553 "parser.c" /* yacc.c:1646 */ - break; - - case 724: -#line 7222 "parser.y" /* yacc.c:1646 */ - { -#ifdef COB_32_BIT_LONG - check_and_set_usage (CB_USAGE_SIGNED_INT); -#else - check_and_set_usage (CB_USAGE_SIGNED_LONG); -#endif - current_field->flag_synchronized = 1; - } -#line 16566 "parser.c" /* yacc.c:1646 */ - break; - - case 725: -#line 7231 "parser.y" /* yacc.c:1646 */ - { -#ifdef COB_32_BIT_LONG - check_and_set_usage (CB_USAGE_UNSIGNED_INT); -#else - check_and_set_usage (CB_USAGE_UNSIGNED_LONG); -#endif - current_field->flag_synchronized = 1; - } -#line 16579 "parser.c" /* yacc.c:1646 */ - break; - - case 726: -#line 7240 "parser.y" /* yacc.c:1646 */ - { - check_and_set_usage (CB_USAGE_FP_BIN32); - } -#line 16587 "parser.c" /* yacc.c:1646 */ - break; - - case 727: -#line 7244 "parser.y" /* yacc.c:1646 */ - { - check_and_set_usage (CB_USAGE_FP_BIN64); - } -#line 16595 "parser.c" /* yacc.c:1646 */ - break; - - case 728: -#line 7248 "parser.y" /* yacc.c:1646 */ - { - check_and_set_usage (CB_USAGE_FP_BIN128); - } -#line 16603 "parser.c" /* yacc.c:1646 */ - break; - - case 729: -#line 7252 "parser.y" /* yacc.c:1646 */ - { - check_and_set_usage (CB_USAGE_FP_DEC64); - } -#line 16611 "parser.c" /* yacc.c:1646 */ - break; - - case 730: -#line 7256 "parser.y" /* yacc.c:1646 */ - { - check_and_set_usage (CB_USAGE_FP_DEC128); - } -#line 16619 "parser.c" /* yacc.c:1646 */ - break; - - case 731: -#line 7260 "parser.y" /* yacc.c:1646 */ - { - check_repeated ("USAGE", SYN_CLAUSE_5, &check_pic_duplicate); - CB_UNFINISHED ("USAGE NATIONAL"); - } -#line 16628 "parser.c" /* yacc.c:1646 */ - break; - - case 743: -#line 7290 "parser.y" /* yacc.c:1646 */ - { - check_repeated ("SIGN", SYN_CLAUSE_6, &check_pic_duplicate); - current_field->flag_sign_clause = 1; - current_field->flag_sign_separate = ((yyvsp[0]) ? 1 : 0); - current_field->flag_sign_leading = 1; - } -#line 16639 "parser.c" /* yacc.c:1646 */ - break; - - case 744: -#line 7297 "parser.y" /* yacc.c:1646 */ - { - check_repeated ("SIGN", SYN_CLAUSE_6, &check_pic_duplicate); - current_field->flag_sign_clause = 1; - current_field->flag_sign_separate = ((yyvsp[0]) ? 1 : 0); - current_field->flag_sign_leading = 0; - } -#line 16650 "parser.c" /* yacc.c:1646 */ - break; - - case 745: -#line 7311 "parser.y" /* yacc.c:1646 */ - { - /* most of the field attributes are set when parsing the phrases */; - setup_occurs (); - setup_occurs_min_max ((yyvsp[-4]), (yyvsp[-3])); - } -#line 16660 "parser.c" /* yacc.c:1646 */ - break; - - case 747: -#line 7320 "parser.y" /* yacc.c:1646 */ - { - current_field->step_count = cb_get_int ((yyvsp[0])); - } -#line 16668 "parser.c" /* yacc.c:1646 */ - break; - - case 748: -#line 7330 "parser.y" /* yacc.c:1646 */ - { - /* most of the field attributes are set when parsing the phrases */; - setup_occurs (); - setup_occurs_min_max ((yyvsp[-4]), (yyvsp[-3])); - } -#line 16678 "parser.c" /* yacc.c:1646 */ - break; - - case 749: -#line 7337 "parser.y" /* yacc.c:1646 */ - { - current_field->flag_unbounded = 1; - if (current_field->parent) { - current_field->parent->flag_unbounded = 1; - } - current_field->depending = (yyvsp[-1]); - /* most of the field attributes are set when parsing the phrases */; - setup_occurs (); - setup_occurs_min_max ((yyvsp[-6]), cb_int0); - } -#line 16693 "parser.c" /* yacc.c:1646 */ - break; - - case 750: -#line 7349 "parser.y" /* yacc.c:1646 */ - { - setup_occurs (); - current_field->occurs_min = (yyvsp[-3]) ? cb_get_int ((yyvsp[-3])) : 0; - if ((yyvsp[-2])) { - current_field->occurs_max = cb_get_int ((yyvsp[-2])); - if (current_field->occurs_max <= current_field->occurs_min) { - cb_error (_("OCCURS TO must be greater than OCCURS FROM")); - } - } else { - current_field->occurs_max = 0; - } - CB_PENDING ("OCCURS DYNAMIC"); - } -#line 16711 "parser.c" /* yacc.c:1646 */ - break; - - case 751: -#line 7365 "parser.y" /* yacc.c:1646 */ - { (yyval) = NULL; } -#line 16717 "parser.c" /* yacc.c:1646 */ - break; - - case 752: -#line 7366 "parser.y" /* yacc.c:1646 */ - { (yyval) = (yyvsp[0]); } -#line 16723 "parser.c" /* yacc.c:1646 */ - break; - - case 753: -#line 7370 "parser.y" /* yacc.c:1646 */ - { (yyval) = NULL; } -#line 16729 "parser.c" /* yacc.c:1646 */ - break; - - case 754: -#line 7371 "parser.y" /* yacc.c:1646 */ - { (yyval) = (yyvsp[0]); } -#line 16735 "parser.c" /* yacc.c:1646 */ - break; - - case 755: -#line 7375 "parser.y" /* yacc.c:1646 */ - { (yyval) = NULL; } -#line 16741 "parser.c" /* yacc.c:1646 */ - break; - - case 756: -#line 7376 "parser.y" /* yacc.c:1646 */ - { (yyval) = (yyvsp[-1]); } -#line 16747 "parser.c" /* yacc.c:1646 */ - break; - - case 758: -#line 7381 "parser.y" /* yacc.c:1646 */ - { - current_field->depending = (yyvsp[0]); - } -#line 16755 "parser.c" /* yacc.c:1646 */ - break; - - case 760: -#line 7387 "parser.y" /* yacc.c:1646 */ - { - (yyval) = cb_build_index ((yyvsp[0]), cb_zero, 0, current_field); - CB_FIELD_PTR ((yyval))->index_type = CB_STATIC_INT_INDEX; - } -#line 16764 "parser.c" /* yacc.c:1646 */ - break; - - case 762: -#line 7395 "parser.y" /* yacc.c:1646 */ - { - /* current_field->initialized = 1; */ - } -#line 16772 "parser.c" /* yacc.c:1646 */ - break; - - case 765: -#line 7404 "parser.y" /* yacc.c:1646 */ - { - if (!cb_relaxed_syntax_checks) { - cb_error (_("INDEXED should follow ASCENDING/DESCENDING")); - } else { - cb_warning (cb_warn_extra, _("INDEXED should follow ASCENDING/DESCENDING")); - } - } -#line 16784 "parser.c" /* yacc.c:1646 */ - break; - - case 769: -#line 7418 "parser.y" /* yacc.c:1646 */ - { - if ((yyvsp[0])) { - cb_tree l; - struct cb_key *keys; - int i; - int nkeys; - - l = (yyvsp[0]); - nkeys = cb_list_length ((yyvsp[0])); - keys = cobc_parse_malloc (sizeof (struct cb_key) * nkeys); - - for (i = 0; i < nkeys; i++) { - keys[i].dir = CB_PURPOSE_INT (l); - keys[i].key = CB_VALUE (l); - l = CB_CHAIN (l); - } - current_field->keys = keys; - current_field->nkeys = nkeys; - } - } -#line 16809 "parser.c" /* yacc.c:1646 */ - break; - - case 772: -#line 7447 "parser.y" /* yacc.c:1646 */ - { - cb_tree l, item; - struct cb_field *field; - - for (l = (yyvsp[0]); l; l = CB_CHAIN (l)) { - CB_PURPOSE (l) = (yyvsp[-3]); - item = CB_VALUE (l); - if (item == cb_error_node) { - continue; - } - /* internally reference-modify each of the given keys */ - if (qualifier -#if 0 /* Simon: those are never reference-modified ... */ - && !CB_REFERENCE(item)->chain -#endif /* the following is perfectly fine and would raise a syntax error - if we add the self-reference */ - && strcasecmp (CB_NAME(item), CB_NAME(qualifier))) { - /* reference by the OCCURS item */ - CB_REFERENCE(item)->chain = qualifier; - } - /* reference all the way up as later fields may have same name */ - for (field = CB_FIELD(cb_ref(qualifier))->parent; field; field = field->parent) { - if (field->flag_filler) continue; - CB_REFERENCE(item)->chain = cb_build_reference(field->name); - } - } - keys_list = cb_list_append (keys_list, (yyvsp[0])); - (yyval) = keys_list; - } -#line 16843 "parser.c" /* yacc.c:1646 */ - break; - - case 773: -#line 7479 "parser.y" /* yacc.c:1646 */ - { (yyval) = cb_int (COB_ASCENDING); } -#line 16849 "parser.c" /* yacc.c:1646 */ - break; - - case 774: -#line 7480 "parser.y" /* yacc.c:1646 */ - { (yyval) = cb_int (COB_DESCENDING); } -#line 16855 "parser.c" /* yacc.c:1646 */ - break; - - case 777: -#line 7489 "parser.y" /* yacc.c:1646 */ - { - current_field->index_list = (yyvsp[0]); - } -#line 16863 "parser.c" /* yacc.c:1646 */ - break; - - case 778: -#line 7495 "parser.y" /* yacc.c:1646 */ - { (yyval) = CB_LIST_INIT ((yyvsp[0])); } -#line 16869 "parser.c" /* yacc.c:1646 */ - break; - - case 779: -#line 7497 "parser.y" /* yacc.c:1646 */ - { (yyval) = cb_list_add ((yyvsp[-1]), (yyvsp[0])); } -#line 16875 "parser.c" /* yacc.c:1646 */ - break; - - case 780: -#line 7502 "parser.y" /* yacc.c:1646 */ - { - (yyval) = cb_build_index ((yyvsp[0]), cb_int1, 1U, current_field); - CB_FIELD_PTR ((yyval))->index_type = CB_STATIC_INT_INDEX; - } -#line 16884 "parser.c" /* yacc.c:1646 */ - break; - - case 781: -#line 7513 "parser.y" /* yacc.c:1646 */ - { - check_repeated ("JUSTIFIED", SYN_CLAUSE_8, &check_pic_duplicate); - current_field->flag_justified = 1; - } -#line 16893 "parser.c" /* yacc.c:1646 */ - break; - - case 782: -#line 7524 "parser.y" /* yacc.c:1646 */ - { - check_repeated ("SYNCHRONIZED", SYN_CLAUSE_9, &check_pic_duplicate); - if (cb_verify (cb_synchronized_clause, _("SYNCHRONIZED clause"))) { - current_field->flag_synchronized = 1; - } - if (with_attrs && cb_verify (cb_sync_left_right, _("LEFT/RIGHT phrases in SYNCHRONIZED clause"))) { - if (current_field->flag_synchronized) { - if (with_attrs == 1) { - current_field->flag_sync_left = 1; - } else { - current_field->flag_sync_right = 1; - } - } - CB_PENDING ("SYNCHRONIZED LEFT/RIGHT"); - } - } -#line 16914 "parser.c" /* yacc.c:1646 */ - break; - - case 783: -#line 7543 "parser.y" /* yacc.c:1646 */ - { with_attrs = 0; } -#line 16920 "parser.c" /* yacc.c:1646 */ - break; - - case 784: -#line 7544 "parser.y" /* yacc.c:1646 */ - { with_attrs = 1; } -#line 16926 "parser.c" /* yacc.c:1646 */ - break; - - case 785: -#line 7545 "parser.y" /* yacc.c:1646 */ - { with_attrs = -1; } -#line 16932 "parser.c" /* yacc.c:1646 */ - break; - - case 786: -#line 7553 "parser.y" /* yacc.c:1646 */ - { - check_repeated ("BLANK", SYN_CLAUSE_10, &check_pic_duplicate); - current_field->flag_blank_zero = 1; - } -#line 16941 "parser.c" /* yacc.c:1646 */ - break; - - case 787: -#line 7564 "parser.y" /* yacc.c:1646 */ - { - check_repeated ("BASED", SYN_CLAUSE_11, &check_pic_duplicate); - if (current_storage == CB_STORAGE_FILE) { - cb_error (_("%s not allowed here"), "BASED"); - } else if (current_field->level != 1 && current_field->level != 77) { - cb_error (_("%s only allowed at 01/77 level"), "BASED"); - } else if (!qualifier) { - cb_error (_("%s requires a data name"), "BASED"); - } else if (current_field->flag_external) { - cb_error (_("%s and %s are mutually exclusive"), "BASED", "EXTERNAL"); - } else if (current_field->redefines) { - cb_error (_("%s and %s are mutually exclusive"), "BASED", "REDEFINES"); - } else if (current_field->flag_any_length) { - cb_error (_("%s and %s are mutually exclusive"), "BASED", "ANY LENGTH"); - } else if (current_field->flag_occurs) { - cb_error (_("%s and %s are mutually exclusive"), "BASED", "OCCURS"); - } else { - current_field->flag_item_based = 1; - } - } -#line 16966 "parser.c" /* yacc.c:1646 */ - break; - - case 788: -#line 7590 "parser.y" /* yacc.c:1646 */ - { - check_repeated ("VALUE", SYN_CLAUSE_12, &check_pic_duplicate); - current_field->values = (yyvsp[0]); - } -#line 16975 "parser.c" /* yacc.c:1646 */ - break; - - case 790: -#line 7598 "parser.y" /* yacc.c:1646 */ - { (yyval) = CB_LIST_INIT ((yyvsp[0])); } -#line 16981 "parser.c" /* yacc.c:1646 */ - break; - - case 791: -#line 7599 "parser.y" /* yacc.c:1646 */ - { (yyval) = cb_list_add ((yyvsp[-1]), (yyvsp[0])); } -#line 16987 "parser.c" /* yacc.c:1646 */ - break; - - case 792: -#line 7603 "parser.y" /* yacc.c:1646 */ - { (yyval) = CB_BUILD_PAIR ((yyvsp[-2]), (yyvsp[0])); } -#line 16993 "parser.c" /* yacc.c:1646 */ - break; - - case 795: -#line 7610 "parser.y" /* yacc.c:1646 */ - { - if (current_field->level != 88) { - cb_error (_("FALSE clause only allowed for 88 level")); - } - current_field->false_88 = CB_LIST_INIT ((yyvsp[0])); - } -#line 17004 "parser.c" /* yacc.c:1646 */ - break; - - case 796: -#line 7622 "parser.y" /* yacc.c:1646 */ - { - check_repeated ("ANY", SYN_CLAUSE_14, &check_pic_duplicate); - if (current_field->flag_item_based) { - cb_error (_("%s and %s are mutually exclusive"), "BASED", "ANY LENGTH"); - } else { - current_field->flag_any_length = 1; - } - } -#line 17017 "parser.c" /* yacc.c:1646 */ - break; - - case 797: -#line 7631 "parser.y" /* yacc.c:1646 */ - { - check_repeated ("ANY", SYN_CLAUSE_14, &check_pic_duplicate); - if (current_field->flag_item_based) { - cb_error (_("%s and %s are mutually exclusive"), "BASED", "ANY NUMERIC"); - } else { - current_field->flag_any_length = 1; - current_field->flag_any_numeric = 1; - } - } -#line 17031 "parser.c" /* yacc.c:1646 */ - break; - - case 798: -#line 7646 "parser.y" /* yacc.c:1646 */ - { - check_repeated ("EXTERNAL-FORM", SYN_CLAUSE_2, &check_pic_duplicate); - CB_PENDING ("EXTERNAL-FORM"); - if (current_storage != CB_STORAGE_WORKING) { - cb_error (_("%s not allowed here"), "EXTERNAL-FORM"); - } else if (current_field->level != 1) { /* docs say: at group level */ - cb_error (_("%s only allowed at 01 level"), "EXTERNAL-FORM"); - } else if (!qualifier) { - cb_error (_("%s requires a data name"), "EXTERNAL-FORM"); - } else if (current_field->redefines) { - cb_error (_("%s and %s combination not allowed"), "EXTERNAL-FORM", "REDEFINES"); - } else { - current_field->flag_is_external_form = 1; - } - } -#line 17051 "parser.c" /* yacc.c:1646 */ - break; - - case 799: -#line 7669 "parser.y" /* yacc.c:1646 */ - { - check_repeated ("IDENTIFIED BY", SYN_CLAUSE_3, &check_pic_duplicate); - if (!current_field->flag_is_external_form) { - CB_PENDING ("EXTERNAL-FORM (IDENTIFIED BY)"); - if (current_storage != CB_STORAGE_WORKING) { - cb_error (_("%s not allowed here"), "IDENTIFIED BY"); - } else if (!qualifier) { - cb_error (_("%s requires a data name"), "IDENTIFIED BY"); - } else if (current_field->redefines) { - cb_error (_("%s and %s combination not allowed"), "IDENTIFIED BY", "REDEFINES"); - } - } - current_field->external_form_identifier = (yyvsp[0]); - } -#line 17070 "parser.c" /* yacc.c:1646 */ - break; - - case 801: -#line 7689 "parser.y" /* yacc.c:1646 */ - { - check_headers_present (COBC_HD_DATA_DIVISION, 0, 0, 0); - header_check |= COBC_HD_LOCAL_STORAGE_SECTION; - current_storage = CB_STORAGE_LOCAL; - if (current_program->nested_level) { - cb_error (_("%s not allowed in nested programs"), "LOCAL-STORAGE"); - } - } -#line 17083 "parser.c" /* yacc.c:1646 */ - break; - - case 802: -#line 7698 "parser.y" /* yacc.c:1646 */ - { - if ((yyvsp[0])) { - current_program->local_storage = CB_FIELD ((yyvsp[0])); - } - } -#line 17093 "parser.c" /* yacc.c:1646 */ - break; - - case 804: -#line 7710 "parser.y" /* yacc.c:1646 */ - { - check_headers_present (COBC_HD_DATA_DIVISION, 0, 0, 0); - header_check |= COBC_HD_LINKAGE_SECTION; - current_storage = CB_STORAGE_LINKAGE; - } -#line 17103 "parser.c" /* yacc.c:1646 */ - break; - - case 805: -#line 7716 "parser.y" /* yacc.c:1646 */ - { - if ((yyvsp[0])) { - current_program->linkage_storage = CB_FIELD ((yyvsp[0])); - } - } -#line 17113 "parser.c" /* yacc.c:1646 */ - break; - - case 807: -#line 7727 "parser.y" /* yacc.c:1646 */ - { - header_check |= COBC_HD_REPORT_SECTION; - current_storage = CB_STORAGE_REPORT; - description_field = NULL; - current_program->flag_report = 1; - cb_clear_real_field (); - } -#line 17125 "parser.c" /* yacc.c:1646 */ - break; - - case 811: -#line 7745 "parser.y" /* yacc.c:1646 */ - { - if (CB_INVALID_TREE ((yyvsp[0]))) { - YYERROR; - } else { - current_field = NULL; - control_field = NULL; - description_field = NULL; - current_report = CB_REPORT_PTR ((yyvsp[0])); - } - check_duplicate = 0; - } -#line 17141 "parser.c" /* yacc.c:1646 */ - break; - - case 812: -#line 7758 "parser.y" /* yacc.c:1646 */ - { - struct cb_field *p; - - for (p = description_field; p; p = p->sister) { - cb_validate_field (p); - } - current_program->report_storage = description_field; - current_program->flag_report = 1; - if (current_report->records == NULL) { - current_report->records = description_field; - } - finalize_report (current_report, description_field); - (yyval) = CB_TREE (description_field); - } -#line 17160 "parser.c" /* yacc.c:1646 */ - break; - - case 815: -#line 7777 "parser.y" /* yacc.c:1646 */ - { - yyerrok; - } -#line 17168 "parser.c" /* yacc.c:1646 */ - break; - - case 816: -#line 7784 "parser.y" /* yacc.c:1646 */ - { - check_repeated ("GLOBAL", SYN_CLAUSE_1, &check_duplicate); - current_report->global = 1; - cb_error (_("GLOBAL is not allowed with RD")); - } -#line 17178 "parser.c" /* yacc.c:1646 */ - break; - - case 817: -#line 7790 "parser.y" /* yacc.c:1646 */ - { - check_repeated ("CODE", SYN_CLAUSE_2, &check_duplicate); - current_report->code_clause = (yyvsp[0]); - } -#line 17187 "parser.c" /* yacc.c:1646 */ - break; - - case 820: -#line 7802 "parser.y" /* yacc.c:1646 */ - { - check_repeated ("CONTROL", SYN_CLAUSE_3, &check_duplicate); - } -#line 17195 "parser.c" /* yacc.c:1646 */ - break; - - case 824: -#line 7815 "parser.y" /* yacc.c:1646 */ - { - current_report->control_final = 1; - } -#line 17203 "parser.c" /* yacc.c:1646 */ - break; - - case 827: -#line 7827 "parser.y" /* yacc.c:1646 */ - { - /* Add field to current control list */ - CB_ADD_TO_CHAIN ((yyvsp[0]), current_report->controls); - } -#line 17212 "parser.c" /* yacc.c:1646 */ - break; - - case 828: -#line 7838 "parser.y" /* yacc.c:1646 */ - { - check_repeated ("PAGE", SYN_CLAUSE_4, &check_duplicate); - if (!current_report->heading) { - current_report->heading = 1; - } - if (!current_report->first_detail) { - current_report->first_detail = current_report->heading; - } - if (!current_report->last_control) { - if (current_report->last_detail) { - current_report->last_control = current_report->last_detail; - } else if (current_report->footing) { - current_report->last_control = current_report->footing; - } else { - current_report->last_control = current_report->lines; - } - if (current_report->t_last_detail) { - current_report->t_last_control = current_report->t_last_detail; - } else if (current_report->t_footing) { - current_report->t_last_control = current_report->t_footing; - } else if(current_report->t_lines) { - current_report->t_last_control = current_report->t_lines; - } - } - if (!current_report->last_detail && !current_report->footing) { - current_report->last_detail = current_report->lines; - current_report->footing = current_report->lines; - } else if (!current_report->last_detail) { - current_report->last_detail = current_report->footing; - } else if (!current_report->footing) { - current_report->footing = current_report->last_detail; - } - /* PAGE LIMIT values checked in finalize_report in typeck.c */ - } -#line 17251 "parser.c" /* yacc.c:1646 */ - break; - - case 829: -#line 7876 "parser.y" /* yacc.c:1646 */ - { - if (CB_LITERAL_P ((yyvsp[-1]))) { - current_report->lines = cb_get_int ((yyvsp[-1])); - if (current_report->lines > 999) { - cb_error ("PAGE LIMIT lines > 999"); - } - } else { - current_report->t_lines = (yyvsp[-1]); - } - } -#line 17266 "parser.c" /* yacc.c:1646 */ - break; - - case 831: -#line 7888 "parser.y" /* yacc.c:1646 */ - { - if (CB_LITERAL_P ((yyvsp[-2]))) { - current_report->lines = cb_get_int ((yyvsp[-2])); - if (current_report->lines > 999) { - cb_error ("PAGE LIMIT lines > 999"); - } - } else { - current_report->t_lines = (yyvsp[-2]); - } - } -#line 17281 "parser.c" /* yacc.c:1646 */ - break; - - case 832: -#line 7902 "parser.y" /* yacc.c:1646 */ - { - /* may be repeated later by page detail */ - check_repeated ("LINE LIMIT", SYN_CLAUSE_5, &check_duplicate); - if (CB_LITERAL_P ((yyvsp[-1]))) { - current_report->columns = cb_get_int ((yyvsp[-1])); - } else { - current_report->t_columns = (yyvsp[-1]); - } - } -#line 17295 "parser.c" /* yacc.c:1646 */ - break; - - case 842: -#line 7930 "parser.y" /* yacc.c:1646 */ - { - check_repeated ("LINE LIMIT", SYN_CLAUSE_5, &check_duplicate); - if (CB_LITERAL_P ((yyvsp[0]))) { - current_report->columns = cb_get_int ((yyvsp[0])); - } else { - current_report->t_columns = (yyvsp[0]); - } - } -#line 17308 "parser.c" /* yacc.c:1646 */ - break; - - case 843: -#line 7942 "parser.y" /* yacc.c:1646 */ - { - check_repeated ("HEADING", SYN_CLAUSE_6, &check_duplicate); - error_if_no_page_lines_limit ("HEADING"); - - if (CB_LITERAL_P ((yyvsp[0]))) { - current_report->heading = cb_get_int ((yyvsp[0])); - } else { - current_report->t_heading = (yyvsp[0]); - } - } -#line 17323 "parser.c" /* yacc.c:1646 */ - break; - - case 844: -#line 7956 "parser.y" /* yacc.c:1646 */ - { - check_repeated ("FIRST DETAIL", SYN_CLAUSE_7, &check_duplicate); - error_if_no_page_lines_limit ("FIRST DETAIL"); - - if (CB_LITERAL_P ((yyvsp[0]))) { - current_report->first_detail = cb_get_int ((yyvsp[0])); - } else { - current_report->t_first_detail = (yyvsp[0]); - } - } -#line 17338 "parser.c" /* yacc.c:1646 */ - break; - - case 845: -#line 7970 "parser.y" /* yacc.c:1646 */ - { - check_repeated ("LAST CONTROL HEADING", SYN_CLAUSE_8, &check_duplicate); - error_if_no_page_lines_limit ("LAST CONTROL HEADING"); - - if (CB_LITERAL_P ((yyvsp[0]))) { - current_report->last_control = cb_get_int ((yyvsp[0])); - } else { - current_report->t_last_control = (yyvsp[0]); - } - } -#line 17353 "parser.c" /* yacc.c:1646 */ - break; - - case 846: -#line 7984 "parser.y" /* yacc.c:1646 */ - { - check_repeated ("LAST DETAIL", SYN_CLAUSE_9, &check_duplicate); - error_if_no_page_lines_limit ("LAST DETAIL"); - - if (CB_LITERAL_P ((yyvsp[0]))) { - current_report->last_detail = cb_get_int ((yyvsp[0])); - } else { - current_report->t_last_detail = (yyvsp[0]); - } - } -#line 17368 "parser.c" /* yacc.c:1646 */ - break; - - case 847: -#line 7998 "parser.y" /* yacc.c:1646 */ - { - check_repeated ("FOOTING", SYN_CLAUSE_10, &check_duplicate); - error_if_no_page_lines_limit ("FOOTING"); - - if (CB_LITERAL_P ((yyvsp[0]))) { - current_report->footing = cb_get_int ((yyvsp[0])); - } else { - current_report->t_footing = (yyvsp[0]); - } - } -#line 17383 "parser.c" /* yacc.c:1646 */ - break; - - case 850: -#line 8016 "parser.y" /* yacc.c:1646 */ - { - if (set_current_field((yyvsp[-1]), (yyvsp[0]))) { - YYERROR; - } - if (!description_field) { - description_field = current_field; - } - } -#line 17396 "parser.c" /* yacc.c:1646 */ - break; - - case 852: -#line 8026 "parser.y" /* yacc.c:1646 */ - { - /* Free tree associated with level number */ - cobc_parse_free ((yyvsp[-2])); - cb_unput_dot (); - yyerrok; - check_pic_duplicate = 0; - check_duplicate = 0; - current_field = cb_get_real_field (); - } -#line 17410 "parser.c" /* yacc.c:1646 */ - break; - - case 871: -#line 8062 "parser.y" /* yacc.c:1646 */ - { - check_repeated ("TYPE", SYN_CLAUSE_16, &check_pic_duplicate); - } -#line 17418 "parser.c" /* yacc.c:1646 */ - break; - - case 872: -#line 8069 "parser.y" /* yacc.c:1646 */ - { - current_field->report_flag |= COB_REPORT_HEADING; - } -#line 17426 "parser.c" /* yacc.c:1646 */ - break; - - case 873: -#line 8073 "parser.y" /* yacc.c:1646 */ - { - current_field->report_flag |= COB_REPORT_PAGE_HEADING; - } -#line 17434 "parser.c" /* yacc.c:1646 */ - break; - - case 876: -#line 8079 "parser.y" /* yacc.c:1646 */ - { - if (current_report != NULL) { - current_report->has_detail = 1; - } - current_field->report_flag |= COB_REPORT_DETAIL; - } -#line 17445 "parser.c" /* yacc.c:1646 */ - break; - - case 877: -#line 8086 "parser.y" /* yacc.c:1646 */ - { - current_field->report_flag |= COB_REPORT_PAGE_FOOTING; - } -#line 17453 "parser.c" /* yacc.c:1646 */ - break; - - case 878: -#line 8090 "parser.y" /* yacc.c:1646 */ - { - current_field->report_flag |= COB_REPORT_FOOTING; - } -#line 17461 "parser.c" /* yacc.c:1646 */ - break; - - case 879: -#line 8097 "parser.y" /* yacc.c:1646 */ - { - current_field->report_flag |= COB_REPORT_CONTROL_HEADING; - } -#line 17469 "parser.c" /* yacc.c:1646 */ - break; - - case 880: -#line 8101 "parser.y" /* yacc.c:1646 */ - { - current_field->report_flag |= COB_REPORT_CONTROL_HEADING; - current_field->report_control = (yyvsp[-1]); - if ((yyvsp[0])) { - current_field->report_flag |= COB_REPORT_PAGE; - } - } -#line 17481 "parser.c" /* yacc.c:1646 */ - break; - - case 881: -#line 8109 "parser.y" /* yacc.c:1646 */ - { - current_field->report_flag |= COB_REPORT_CONTROL_HEADING_FINAL; - } -#line 17489 "parser.c" /* yacc.c:1646 */ - break; - - case 882: -#line 8118 "parser.y" /* yacc.c:1646 */ - {(yyval) = NULL;} -#line 17495 "parser.c" /* yacc.c:1646 */ - break; - - case 883: -#line 8119 "parser.y" /* yacc.c:1646 */ - {(yyval) = cb_int0;} -#line 17501 "parser.c" /* yacc.c:1646 */ - break; - - case 884: -#line 8124 "parser.y" /* yacc.c:1646 */ - { - current_field->report_flag |= COB_REPORT_CONTROL_FOOTING; - } -#line 17509 "parser.c" /* yacc.c:1646 */ - break; - - case 885: -#line 8128 "parser.y" /* yacc.c:1646 */ - { - current_field->report_flag |= COB_REPORT_CONTROL_FOOTING; - current_field->report_control = (yyvsp[-1]); - } -#line 17518 "parser.c" /* yacc.c:1646 */ - break; - - case 886: -#line 8133 "parser.y" /* yacc.c:1646 */ - { - current_field->report_flag |= COB_REPORT_CONTROL_FOOTING_FINAL; - } -#line 17526 "parser.c" /* yacc.c:1646 */ - break; - - case 887: -#line 8137 "parser.y" /* yacc.c:1646 */ - { - current_field->report_flag |= COB_REPORT_CONTROL_FOOTING; - current_field->report_flag |= COB_REPORT_ALL; - } -#line 17535 "parser.c" /* yacc.c:1646 */ - break; - - case 888: -#line 8145 "parser.y" /* yacc.c:1646 */ - { - check_repeated ("NEXT GROUP", SYN_CLAUSE_17, &check_pic_duplicate); - } -#line 17543 "parser.c" /* yacc.c:1646 */ - break; - - case 889: -#line 8152 "parser.y" /* yacc.c:1646 */ - { - if (CB_LITERAL_P((yyvsp[0])) && CB_LITERAL ((yyvsp[0]))->sign > 0) { - current_field->report_flag |= COB_REPORT_NEXT_GROUP_PLUS; - } else { - current_field->report_flag |= COB_REPORT_NEXT_GROUP_LINE; - } - current_field->next_group_line = cb_get_int ((yyvsp[0])); - } -#line 17556 "parser.c" /* yacc.c:1646 */ - break; - - case 890: -#line 8161 "parser.y" /* yacc.c:1646 */ - { - current_field->report_flag |= COB_REPORT_NEXT_GROUP_PLUS; - current_field->next_group_line = cb_get_int((yyvsp[0])); - } -#line 17565 "parser.c" /* yacc.c:1646 */ - break; - - case 891: -#line 8166 "parser.y" /* yacc.c:1646 */ - { - current_field->report_flag |= COB_REPORT_NEXT_GROUP_PAGE; - } -#line 17573 "parser.c" /* yacc.c:1646 */ - break; - - case 895: -#line 8179 "parser.y" /* yacc.c:1646 */ - { - check_repeated ("SUM", SYN_CLAUSE_19, &check_pic_duplicate); - current_field->report_sum_list = (yyvsp[-1]); - build_sum_counter (current_report, current_field); - } -#line 17583 "parser.c" /* yacc.c:1646 */ - break; - - case 898: -#line 8189 "parser.y" /* yacc.c:1646 */ - { - current_field->report_sum_upon = (yyvsp[0]); - } -#line 17591 "parser.c" /* yacc.c:1646 */ - break; - - case 899: -#line 8196 "parser.y" /* yacc.c:1646 */ - { - current_field->report_reset = (yyvsp[0]); - } -#line 17599 "parser.c" /* yacc.c:1646 */ - break; - - case 900: -#line 8200 "parser.y" /* yacc.c:1646 */ - { - current_field->report_flag |= COB_REPORT_RESET_FINAL; - } -#line 17607 "parser.c" /* yacc.c:1646 */ - break; - - case 901: -#line 8207 "parser.y" /* yacc.c:1646 */ - { - check_repeated ("PRESENT", SYN_CLAUSE_20, &check_pic_duplicate); - current_field->report_when = (yyvsp[0]); - } -#line 17616 "parser.c" /* yacc.c:1646 */ - break; - - case 902: -#line 8212 "parser.y" /* yacc.c:1646 */ - { - check_repeated ("PRESENT", SYN_CLAUSE_20, &check_pic_duplicate); - current_field->report_flag |= COB_REPORT_PRESENT; - current_field->report_flag &= ~COB_REPORT_BEFORE; - } -#line 17626 "parser.c" /* yacc.c:1646 */ - break; - - case 903: -#line 8218 "parser.y" /* yacc.c:1646 */ - { - check_repeated ("PRESENT", SYN_CLAUSE_20, &check_pic_duplicate); - current_field->report_flag |= COB_REPORT_PRESENT; - current_field->report_flag &= ~COB_REPORT_BEFORE; - current_field->report_flag |= COB_REPORT_PAGE; - } -#line 17637 "parser.c" /* yacc.c:1646 */ - break; - - case 904: -#line 8225 "parser.y" /* yacc.c:1646 */ - { - check_repeated ("PRESENT", SYN_CLAUSE_20, &check_pic_duplicate); - current_field->report_flag |= COB_REPORT_PRESENT; - current_field->report_flag |= COB_REPORT_BEFORE; - } -#line 17647 "parser.c" /* yacc.c:1646 */ - break; - - case 905: -#line 8231 "parser.y" /* yacc.c:1646 */ - { - check_repeated ("PRESENT", SYN_CLAUSE_20, &check_pic_duplicate); - current_field->report_flag |= COB_REPORT_PRESENT; - current_field->report_flag |= COB_REPORT_BEFORE; - current_field->report_flag |= COB_REPORT_PAGE; - } -#line 17658 "parser.c" /* yacc.c:1646 */ - break; - - case 906: -#line 8241 "parser.y" /* yacc.c:1646 */ - { - current_field->report_flag |= COB_REPORT_PRESENT; - } -#line 17666 "parser.c" /* yacc.c:1646 */ - break; - - case 907: -#line 8245 "parser.y" /* yacc.c:1646 */ - { - current_field->report_flag |= COB_REPORT_PRESENT; - current_field->report_flag |= COB_REPORT_NEGATE; - } -#line 17675 "parser.c" /* yacc.c:1646 */ - break; - - case 910: -#line 8258 "parser.y" /* yacc.c:1646 */ - { - current_field->report_flag |= COB_REPORT_PAGE; - } -#line 17683 "parser.c" /* yacc.c:1646 */ - break; - - case 911: -#line 8262 "parser.y" /* yacc.c:1646 */ - { - current_field->report_control = (yyvsp[0]); - } -#line 17691 "parser.c" /* yacc.c:1646 */ - break; - - case 913: -#line 8270 "parser.y" /* yacc.c:1646 */ - { - CB_PENDING ("RW VARYING clause"); - } -#line 17699 "parser.c" /* yacc.c:1646 */ - break; - - case 914: -#line 8277 "parser.y" /* yacc.c:1646 */ - { - check_repeated ("LINE", SYN_CLAUSE_21, &check_pic_duplicate); - current_field->report_flag |= COB_REPORT_LINE; - } -#line 17708 "parser.c" /* yacc.c:1646 */ - break; - - case 919: -#line 8295 "parser.y" /* yacc.c:1646 */ - { - current_field->report_flag |= COB_REPORT_LINE_NEXT_PAGE; - } -#line 17716 "parser.c" /* yacc.c:1646 */ - break; - - case 920: -#line 8299 "parser.y" /* yacc.c:1646 */ - { - current_field->report_line = cb_get_int ((yyvsp[0])); - if ((CB_LITERAL_P((yyvsp[0])) && CB_LITERAL ((yyvsp[0]))->sign > 0)) { - current_field->report_flag |= COB_REPORT_LINE_PLUS; - } - if ((yyvsp[-1])) { - current_field->report_flag |= COB_REPORT_LINE_PLUS; - if (current_field->report_line == 0) { - CB_PENDING ("LINE PLUS 0"); - } - } - } -#line 17733 "parser.c" /* yacc.c:1646 */ - break; - - case 921: -#line 8316 "parser.y" /* yacc.c:1646 */ - { - check_repeated ("COLUMN", SYN_CLAUSE_18, &check_pic_duplicate); - if((current_field->report_flag & (COB_REPORT_COLUMN_LEFT|COB_REPORT_COLUMN_RIGHT|COB_REPORT_COLUMN_CENTER)) - && (current_field->report_flag & COB_REPORT_COLUMN_PLUS)) { - if (cb_relaxed_syntax_checks) { - cb_warning (COBC_WARN_FILLER, _("PLUS is not recommended with LEFT, RIGHT or CENTER")); - } else { - cb_error (_("PLUS is not allowed with LEFT, RIGHT or CENTER")); - } - } - } -#line 17749 "parser.c" /* yacc.c:1646 */ - break; - - case 925: -#line 8340 "parser.y" /* yacc.c:1646 */ - { - current_field->report_flag |= COB_REPORT_COLUMN_LEFT; - } -#line 17757 "parser.c" /* yacc.c:1646 */ - break; - - case 926: -#line 8344 "parser.y" /* yacc.c:1646 */ - { - current_field->report_flag |= COB_REPORT_COLUMN_RIGHT; - } -#line 17765 "parser.c" /* yacc.c:1646 */ - break; - - case 927: -#line 8348 "parser.y" /* yacc.c:1646 */ - { - current_field->report_flag |= COB_REPORT_COLUMN_CENTER; - } -#line 17773 "parser.c" /* yacc.c:1646 */ - break; - - case 928: -#line 8355 "parser.y" /* yacc.c:1646 */ - { - int colnum = cb_get_int ((yyvsp[0])); - if (colnum != 0) { - if (current_field->parent - && current_field->parent->children == current_field) { - cb_warning (COBC_WARN_FILLER, _("PLUS is ignored on first field of line")); - if (current_field->step_count == 0) - current_field->step_count = colnum; - } else { - current_field->report_flag |= COB_REPORT_COLUMN_PLUS; - } - } else { - colnum = 0; - } - if (current_field->report_column == 0) { - current_field->report_column = colnum; - } - current_field->report_num_col++; - } -#line 17797 "parser.c" /* yacc.c:1646 */ - break; - - case 932: -#line 8384 "parser.y" /* yacc.c:1646 */ - { - int colnum; - colnum = cb_get_int ((yyvsp[0])); - if (CB_LITERAL_P((yyvsp[0])) && CB_LITERAL ((yyvsp[0]))->sign > 0) { - if(current_field->parent - && current_field->parent->children == current_field) { - cb_warning (COBC_WARN_FILLER,_("PLUS is ignored on first field of line")); - } else { - current_field->report_flag |= COB_REPORT_COLUMN_PLUS; - } - } - if (colnum < 0) { - /* already handled by integer check */ - } else if (colnum == 0) { - cb_error (_("invalid COLUMN integer; must be > 0")); - } else if (colnum <= current_field->report_column) { - cb_warning (COBC_WARN_FILLER, _("COLUMN numbers should increase")); - } - current_field->report_column_list = - cb_list_append (current_field->report_column_list, CB_LIST_INIT ((yyvsp[0]))); - if (current_field->report_column == 0) { - current_field->report_column = colnum; - } - current_field->report_num_col++; - } -#line 17827 "parser.c" /* yacc.c:1646 */ - break; - - case 933: -#line 8413 "parser.y" /* yacc.c:1646 */ - { - check_repeated ("SOURCE", SYN_CLAUSE_22, &check_pic_duplicate); - current_field->report_source = (yyvsp[-1]); - } -#line 17836 "parser.c" /* yacc.c:1646 */ - break; - - case 934: -#line 8421 "parser.y" /* yacc.c:1646 */ - { - check_repeated ("GROUP", SYN_CLAUSE_23, &check_pic_duplicate); - current_field->report_flag |= COB_REPORT_GROUP_INDICATE; - } -#line 17845 "parser.c" /* yacc.c:1646 */ - break; - - case 936: -#line 8431 "parser.y" /* yacc.c:1646 */ - { - cobc_cs_check = CB_CS_SCREEN; - current_storage = CB_STORAGE_SCREEN; - current_field = NULL; - description_field = NULL; - cb_clear_real_field (); - } -#line 17857 "parser.c" /* yacc.c:1646 */ - break; - - case 937: -#line 8439 "parser.y" /* yacc.c:1646 */ - { - struct cb_field *p; - - if (description_field) { - for (p = description_field; p; p = p->sister) { - cb_validate_field (p); - } - current_program->screen_storage = description_field; - current_program->flag_screen = 1; - } - cobc_cs_check = 0; - } -#line 17874 "parser.c" /* yacc.c:1646 */ - break; - - case 943: -#line 8466 "parser.y" /* yacc.c:1646 */ - { - if (set_current_field ((yyvsp[-1]), (yyvsp[0]))) { - YYERROR; - } - if (current_field->parent) { - current_field->screen_foreg = current_field->parent->screen_foreg; - current_field->screen_backg = current_field->parent->screen_backg; - current_field->screen_prompt = current_field->parent->screen_prompt; - } - } -#line 17889 "parser.c" /* yacc.c:1646 */ - break; - - case 944: -#line 8477 "parser.y" /* yacc.c:1646 */ - { - cob_flags_t flags; - - if (current_field->parent) { - flags = current_field->parent->screen_flag; - flags &= ~COB_SCREEN_BLANK_LINE; - flags &= ~COB_SCREEN_BLANK_SCREEN; - flags &= ~COB_SCREEN_ERASE_EOL; - flags &= ~COB_SCREEN_ERASE_EOS; - flags &= ~COB_SCREEN_LINE_PLUS; - flags &= ~COB_SCREEN_LINE_MINUS; - flags &= ~COB_SCREEN_COLUMN_PLUS; - flags &= ~COB_SCREEN_COLUMN_MINUS; - - flags = zero_conflicting_flags (current_field->screen_flag, - flags); - - current_field->screen_flag |= flags; - } - - if (current_field->screen_flag & COB_SCREEN_INITIAL) { - if (!(current_field->screen_flag & COB_SCREEN_INPUT)) { - cb_error (_("INITIAL specified on non-input field")); - } - } - if (!qualifier) { - current_field->flag_filler = 1; - } - - if (!description_field) { - description_field = current_field; - } - if (current_field->flag_occurs - && !has_relative_pos (current_field)) { - cb_error (_("relative LINE/COLUMN clause required with OCCURS")); - } - } -#line 17931 "parser.c" /* yacc.c:1646 */ - break; - - case 945: -#line 8516 "parser.y" /* yacc.c:1646 */ - { - if (set_current_field ((yyvsp[-1]), (yyvsp[0]))) { - YYERROR; - } - - if (current_field->parent) { - current_field->screen_foreg = current_field->parent->screen_foreg; - current_field->screen_backg = current_field->parent->screen_backg; - current_field->screen_prompt = current_field->parent->screen_prompt; - } - } -#line 17947 "parser.c" /* yacc.c:1646 */ - break; - - case 946: -#line 8528 "parser.y" /* yacc.c:1646 */ - { - CB_PENDING ("GRAPHICAL CONTROL"); - current_field->usage = CB_USAGE_CONTROL; - } -#line 17956 "parser.c" /* yacc.c:1646 */ - break; - - case 947: -#line 8533 "parser.y" /* yacc.c:1646 */ - { - cob_flags_t flags; - - if (current_field->parent) { - flags = current_field->parent->screen_flag; - flags &= ~COB_SCREEN_BLANK_LINE; - flags &= ~COB_SCREEN_BLANK_SCREEN; - flags &= ~COB_SCREEN_ERASE_EOL; - flags &= ~COB_SCREEN_ERASE_EOS; - flags &= ~COB_SCREEN_LINE_PLUS; - flags &= ~COB_SCREEN_LINE_MINUS; - flags &= ~COB_SCREEN_COLUMN_PLUS; - flags &= ~COB_SCREEN_COLUMN_MINUS; - - flags = zero_conflicting_flags (current_field->screen_flag, - flags); - - current_field->screen_flag |= flags; - } - - if (current_field->screen_flag & COB_SCREEN_INITIAL) { - if (!(current_field->screen_flag & COB_SCREEN_INPUT)) { - cb_error (_("INITIAL specified on non-input field")); - } - } - if (!qualifier) { - current_field->flag_filler = 1; - } - - if (!description_field) { - description_field = current_field; - } - if (current_field->flag_occurs - && !has_relative_pos (current_field)) { - cb_error (_("relative LINE/COLUMN clause required with OCCURS")); - } - cobc_cs_check = CB_CS_SCREEN; - } -#line 17999 "parser.c" /* yacc.c:1646 */ - break; - - case 948: -#line 8573 "parser.y" /* yacc.c:1646 */ - { - /* - Tree associated with level number has already been freed; we don't - need to do anything here. - */ - yyerrok; - cb_unput_dot (); - check_pic_duplicate = 0; - check_duplicate = 0; -#if 1 /* RXWRXW Screen field */ - if (current_field) { - current_field->flag_is_verified = 1; - current_field->flag_invalid = 1; - } -#endif - current_field = cb_get_real_field (); - } -#line 18021 "parser.c" /* yacc.c:1646 */ - break; - - case 951: -#line 8599 "parser.y" /* yacc.c:1646 */ - { - set_screen_attr_with_conflict ("BLANK LINE", COB_SCREEN_BLANK_LINE, - "BLANK SCREEN", COB_SCREEN_BLANK_SCREEN); - } -#line 18030 "parser.c" /* yacc.c:1646 */ - break; - - case 952: -#line 8604 "parser.y" /* yacc.c:1646 */ - { - set_screen_attr_with_conflict ("BLANK SCREEN", COB_SCREEN_BLANK_SCREEN, - "BLANK LINE", COB_SCREEN_BLANK_LINE); - } -#line 18039 "parser.c" /* yacc.c:1646 */ - break; - - case 953: -#line 8609 "parser.y" /* yacc.c:1646 */ - { - set_screen_attr ("BELL", COB_SCREEN_BELL); - } -#line 18047 "parser.c" /* yacc.c:1646 */ - break; - - case 954: -#line 8613 "parser.y" /* yacc.c:1646 */ - { - set_screen_attr ("BLINK", COB_SCREEN_BLINK); - } -#line 18055 "parser.c" /* yacc.c:1646 */ - break; - - case 955: -#line 8617 "parser.y" /* yacc.c:1646 */ - { - set_screen_attr_with_conflict ("ERASE EOL", COB_SCREEN_ERASE_EOL, - "ERASE EOS", COB_SCREEN_ERASE_EOS); - } -#line 18064 "parser.c" /* yacc.c:1646 */ - break; - - case 956: -#line 8622 "parser.y" /* yacc.c:1646 */ - { - set_screen_attr_with_conflict ("ERASE EOS", COB_SCREEN_ERASE_EOS, - "ERASE EOL", COB_SCREEN_ERASE_EOL); - } -#line 18073 "parser.c" /* yacc.c:1646 */ - break; - - case 957: -#line 8627 "parser.y" /* yacc.c:1646 */ - { - set_screen_attr_with_conflict ("HIGHLIGHT", COB_SCREEN_HIGHLIGHT, - "LOWLIGHT", COB_SCREEN_LOWLIGHT); - } -#line 18082 "parser.c" /* yacc.c:1646 */ - break; - - case 958: -#line 8632 "parser.y" /* yacc.c:1646 */ - { - set_screen_attr_with_conflict ("LOWLIGHT", COB_SCREEN_LOWLIGHT, - "HIGHLIGHT", COB_SCREEN_HIGHLIGHT); - } -#line 18091 "parser.c" /* yacc.c:1646 */ - break; - - case 959: -#line 8637 "parser.y" /* yacc.c:1646 */ - { - CB_PENDING ("STANDARD intensity"); -#if 0 /* in general we could simply remove high/low, but for syntax checks - we still need a flag */ - set_screen_attr_with_conflict ("LOWLIGHT", COB_SCREEN_LOWLIGHT, - "HIGHLIGHT", COB_SCREEN_HIGHLIGHT); -#endif - } -#line 18104 "parser.c" /* yacc.c:1646 */ - break; - - case 960: -#line 8646 "parser.y" /* yacc.c:1646 */ - { - CB_PENDING ("BACKGROUND intensity"); - } -#line 18112 "parser.c" /* yacc.c:1646 */ - break; - - case 961: -#line 8650 "parser.y" /* yacc.c:1646 */ - { - CB_PENDING ("BACKGROUND intensity"); - } -#line 18120 "parser.c" /* yacc.c:1646 */ - break; - - case 962: -#line 8654 "parser.y" /* yacc.c:1646 */ - { - CB_PENDING ("BACKGROUND intensity"); - } -#line 18128 "parser.c" /* yacc.c:1646 */ - break; - - case 963: -#line 8658 "parser.y" /* yacc.c:1646 */ - { - set_screen_attr ("REVERSE-VIDEO", COB_SCREEN_REVERSE); - } -#line 18136 "parser.c" /* yacc.c:1646 */ - break; - - case 964: -#line 8662 "parser.y" /* yacc.c:1646 */ - { - /* set_screen_attr ("SIZE", COB_SCREEN_SIZE); */ - CB_PENDING ("SIZE clause"); - current_field->size = cb_get_int ((yyvsp[0])); - } -#line 18146 "parser.c" /* yacc.c:1646 */ - break; - - case 965: -#line 8668 "parser.y" /* yacc.c:1646 */ - { - CB_PENDING (_("screen positions from data-item")); - } -#line 18154 "parser.c" /* yacc.c:1646 */ - break; - - case 966: -#line 8672 "parser.y" /* yacc.c:1646 */ - { - CB_PENDING (_("screen positions from data-item")); - CB_PENDING ("SIZE clause"); - } -#line 18163 "parser.c" /* yacc.c:1646 */ - break; - - case 967: -#line 8677 "parser.y" /* yacc.c:1646 */ - { - /* set_screen_attr ("SIZE", COB_SCREEN_SIZE); */ - CB_PENDING ("SIZE clause"); - current_field->size = cb_get_int ((yyvsp[0])); - } -#line 18173 "parser.c" /* yacc.c:1646 */ - break; - - case 968: -#line 8683 "parser.y" /* yacc.c:1646 */ - { - set_screen_attr ("UNDERLINE", COB_SCREEN_UNDERLINE); - } -#line 18181 "parser.c" /* yacc.c:1646 */ - break; - - case 969: -#line 8687 "parser.y" /* yacc.c:1646 */ - { - set_screen_attr ("OVERLINE", COB_SCREEN_OVERLINE); - CB_PENDING ("OVERLINE"); - } -#line 18190 "parser.c" /* yacc.c:1646 */ - break; - - case 970: -#line 8692 "parser.y" /* yacc.c:1646 */ - { - set_screen_attr ("GRID", COB_SCREEN_GRID); - CB_PENDING ("GRID"); - } -#line 18199 "parser.c" /* yacc.c:1646 */ - break; - - case 971: -#line 8697 "parser.y" /* yacc.c:1646 */ - { - set_screen_attr ("LEFTLINE", COB_SCREEN_LEFTLINE); - CB_PENDING ("LEFTLINE"); - } -#line 18208 "parser.c" /* yacc.c:1646 */ - break; - - case 972: -#line 8702 "parser.y" /* yacc.c:1646 */ - { - set_screen_attr_with_conflict ("AUTO", COB_SCREEN_AUTO, - "TAB", COB_SCREEN_TAB); - } -#line 18217 "parser.c" /* yacc.c:1646 */ - break; - - case 973: -#line 8707 "parser.y" /* yacc.c:1646 */ - { - set_screen_attr_with_conflict ("TAB", COB_SCREEN_TAB, - "AUTO", COB_SCREEN_AUTO); - } -#line 18226 "parser.c" /* yacc.c:1646 */ - break; - - case 974: -#line 8712 "parser.y" /* yacc.c:1646 */ - { - set_screen_attr_with_conflict ("SECURE", COB_SCREEN_SECURE, - "NO-ECHO", COB_SCREEN_NO_ECHO); - } -#line 18235 "parser.c" /* yacc.c:1646 */ - break; - - case 975: -#line 8717 "parser.y" /* yacc.c:1646 */ - { - if (cb_no_echo_means_secure) { - set_screen_attr ("SECURE", COB_SCREEN_SECURE); - } else { - set_screen_attr_with_conflict ("NO-ECHO", COB_SCREEN_NO_ECHO, - "SECURE", COB_SCREEN_SECURE); - } - } -#line 18248 "parser.c" /* yacc.c:1646 */ - break; - - case 976: -#line 8726 "parser.y" /* yacc.c:1646 */ - { - set_screen_attr ("REQUIRED", COB_SCREEN_REQUIRED); - } -#line 18256 "parser.c" /* yacc.c:1646 */ - break; - - case 977: -#line 8730 "parser.y" /* yacc.c:1646 */ - { - set_screen_attr ("FULL", COB_SCREEN_FULL); - } -#line 18264 "parser.c" /* yacc.c:1646 */ - break; - - case 978: -#line 8734 "parser.y" /* yacc.c:1646 */ - { - set_screen_attr ("PROMPT", COB_SCREEN_PROMPT); - current_field->screen_prompt = (yyvsp[0]); - } -#line 18273 "parser.c" /* yacc.c:1646 */ - break; - - case 979: -#line 8739 "parser.y" /* yacc.c:1646 */ - { - set_screen_attr ("PROMPT", COB_SCREEN_PROMPT); - } -#line 18281 "parser.c" /* yacc.c:1646 */ - break; - - case 980: -#line 8743 "parser.y" /* yacc.c:1646 */ - { - set_screen_attr ("INITIAL", COB_SCREEN_INITIAL); - } -#line 18289 "parser.c" /* yacc.c:1646 */ - break; - - case 981: -#line 8747 "parser.y" /* yacc.c:1646 */ - { - check_repeated ("LINE", SYN_CLAUSE_16, &check_pic_duplicate); - } -#line 18297 "parser.c" /* yacc.c:1646 */ - break; - - case 982: -#line 8751 "parser.y" /* yacc.c:1646 */ - { - CB_PENDING ("LINES clause"); /* note: should only occur with controls */ - } -#line 18305 "parser.c" /* yacc.c:1646 */ - break; - - case 983: -#line 8755 "parser.y" /* yacc.c:1646 */ - { - /*check_repeated ("CLINE", SYN_CLAUSE_5000, &check_pic_duplicate);*/ - } -#line 18313 "parser.c" /* yacc.c:1646 */ - break; - - case 984: -#line 8759 "parser.y" /* yacc.c:1646 */ - { - check_repeated ("COLUMN", SYN_CLAUSE_17, &check_pic_duplicate); - } -#line 18321 "parser.c" /* yacc.c:1646 */ - break; - - case 985: -#line 8763 "parser.y" /* yacc.c:1646 */ - { - /*check_repeated ("CCOL", SYN_CLAUSE_5001, &check_pic_duplicate);*/ - } -#line 18329 "parser.c" /* yacc.c:1646 */ - break; - - case 986: -#line 8767 "parser.y" /* yacc.c:1646 */ - { -#if 0 /* TODO: implement, and add reverse to BACKGROUND/FOREGROUND-COLOR */ - check_repeated ("COLOR", SYN_CLAUSE_19, &check_pic_duplicate); - set_screen_attr_with_conflict ("COLOR", COB_SCREEN_COLOR, - "BACKGROUND-COLOR", COB_SCREEN_BACKGROUND_COLOR); - set_screen_attr_with_conflict ("COLOR", COB_SCREEN_COLOR, - "FOREGROUND-COLOR", FOREGROUND_COLOR); -#endif - CB_PENDING ("COLOR clause"); - } -#line 18344 "parser.c" /* yacc.c:1646 */ - break; - - case 987: -#line 8778 "parser.y" /* yacc.c:1646 */ - { - check_repeated ("FOREGROUND-COLOR", SYN_CLAUSE_18, &check_pic_duplicate); - current_field->screen_foreg = (yyvsp[0]); - } -#line 18353 "parser.c" /* yacc.c:1646 */ - break; - - case 988: -#line 8783 "parser.y" /* yacc.c:1646 */ - { - check_repeated ("BACKGROUND-COLOR", SYN_CLAUSE_19, &check_pic_duplicate); - current_field->screen_backg = (yyvsp[0]); - } -#line 18362 "parser.c" /* yacc.c:1646 */ - break; - - case 997: -#line 8796 "parser.y" /* yacc.c:1646 */ - { - (yyval) = check_not_88_level ((yyvsp[0])); - - check_repeated ("USING", SYN_CLAUSE_20, &check_pic_duplicate); - current_field->screen_from = (yyval); - current_field->screen_to = (yyval); - current_field->screen_flag |= COB_SCREEN_INPUT; - } -#line 18375 "parser.c" /* yacc.c:1646 */ - break; - - case 998: -#line 8805 "parser.y" /* yacc.c:1646 */ - { - check_repeated ("FROM", SYN_CLAUSE_21, &check_pic_duplicate); - current_field->screen_from = (yyvsp[0]); - } -#line 18384 "parser.c" /* yacc.c:1646 */ - break; - - case 999: -#line 8810 "parser.y" /* yacc.c:1646 */ - { - (yyval) = check_not_88_level ((yyvsp[0])); - - check_repeated ("TO", SYN_CLAUSE_22, &check_pic_duplicate); - current_field->screen_to = (yyval); - current_field->screen_flag |= COB_SCREEN_INPUT; - } -#line 18396 "parser.c" /* yacc.c:1646 */ - break; - - case 1001: -#line 8822 "parser.y" /* yacc.c:1646 */ - { - cobc_cs_check |= CB_CS_GRAPHICAL_CONTROL; - } -#line 18404 "parser.c" /* yacc.c:1646 */ - break; - - case 1303: -#line 9416 "parser.y" /* yacc.c:1646 */ - { (yyval) = NULL; } -#line 18410 "parser.c" /* yacc.c:1646 */ - break; - - case 1304: -#line 9417 "parser.y" /* yacc.c:1646 */ - { (yyval) = (yyvsp[0]); } -#line 18416 "parser.c" /* yacc.c:1646 */ - break; - - case 1305: -#line 9421 "parser.y" /* yacc.c:1646 */ - { (yyval) = cb_int0; } -#line 18422 "parser.c" /* yacc.c:1646 */ - break; - - case 1308: -#line 9429 "parser.y" /* yacc.c:1646 */ - { (yyval) = cb_int1; } -#line 18428 "parser.c" /* yacc.c:1646 */ - break; - - case 1312: -#line 9441 "parser.y" /* yacc.c:1646 */ - { (yyval) = (yyvsp[-1]); } -#line 18434 "parser.c" /* yacc.c:1646 */ - break; - - case 1313: -#line 9442 "parser.y" /* yacc.c:1646 */ - { (yyval) = cb_int1; } -#line 18440 "parser.c" /* yacc.c:1646 */ - break; - - case 1314: -#line 9446 "parser.y" /* yacc.c:1646 */ - { (yyval) = NULL; } -#line 18446 "parser.c" /* yacc.c:1646 */ - break; - - case 1315: -#line 9447 "parser.y" /* yacc.c:1646 */ - { (yyval) = cb_int0; } -#line 18452 "parser.c" /* yacc.c:1646 */ - break; - - case 1316: -#line 9452 "parser.y" /* yacc.c:1646 */ - { - if ((yyvsp[0])) { - current_field->screen_line = (yyvsp[0]); - } - } -#line 18462 "parser.c" /* yacc.c:1646 */ - break; - - case 1318: -#line 9462 "parser.y" /* yacc.c:1646 */ - { - current_field->screen_flag |= COB_SCREEN_LINE_PLUS; - } -#line 18470 "parser.c" /* yacc.c:1646 */ - break; - - case 1319: -#line 9466 "parser.y" /* yacc.c:1646 */ - { - current_field->screen_flag |= COB_SCREEN_LINE_MINUS; - } -#line 18478 "parser.c" /* yacc.c:1646 */ - break; - - case 1320: -#line 9473 "parser.y" /* yacc.c:1646 */ - { - if ((yyvsp[0])) { - current_field->screen_column = (yyvsp[0]); - } - } -#line 18488 "parser.c" /* yacc.c:1646 */ - break; - - case 1321: -#line 9482 "parser.y" /* yacc.c:1646 */ - { - /* Nothing */ - } -#line 18496 "parser.c" /* yacc.c:1646 */ - break; - - case 1322: -#line 9486 "parser.y" /* yacc.c:1646 */ - { - current_field->screen_flag |= COB_SCREEN_COLUMN_PLUS; - } -#line 18504 "parser.c" /* yacc.c:1646 */ - break; - - case 1323: -#line 9490 "parser.y" /* yacc.c:1646 */ - { - current_field->screen_flag |= COB_SCREEN_COLUMN_MINUS; - } -#line 18512 "parser.c" /* yacc.c:1646 */ - break; - - case 1324: -#line 9497 "parser.y" /* yacc.c:1646 */ - { - CB_PENDING (_("OCCURS screen items")); - check_repeated ("OCCURS", SYN_CLAUSE_23, &check_pic_duplicate); - current_field->occurs_max = cb_get_int ((yyvsp[-1])); - current_field->occurs_min = current_field->occurs_max; - current_field->indexes++; - current_field->flag_occurs = 1; - } -#line 18525 "parser.c" /* yacc.c:1646 */ - break; - - case 1325: -#line 9509 "parser.y" /* yacc.c:1646 */ - { - CB_PENDING (_("GLOBAL screen items")); - } -#line 18533 "parser.c" /* yacc.c:1646 */ - break; - - case 1326: -#line 9518 "parser.y" /* yacc.c:1646 */ - { - current_section = NULL; - current_paragraph = NULL; - check_pic_duplicate = 0; - check_duplicate = 0; - if (!current_program->entry_convention) { - current_program->entry_convention = cb_int (CB_CONV_COBOL); - } - } -#line 18547 "parser.c" /* yacc.c:1646 */ - break; - - case 1328: -#line 9532 "parser.y" /* yacc.c:1646 */ - { - current_section = NULL; - current_paragraph = NULL; - check_pic_duplicate = 0; - check_duplicate = 0; - cobc_in_procedure = 1U; - cb_set_system_names (); - backup_current_pos (); - } -#line 18561 "parser.c" /* yacc.c:1646 */ - break; - - case 1329: -#line 9542 "parser.y" /* yacc.c:1646 */ - { - cb_tree call_conv = (yyvsp[-4]); - if ((yyvsp[-3])) { - call_conv = (yyvsp[-3]); - if ((yyvsp[-4])) { - /* note: $4 is likely to be a reference to SPECIAL-NAMES */ - cb_error_x ((yyvsp[-3]), _("%s and %s are mutually exclusive"), - "CALL-CONVENTION", "WITH LINKAGE"); - } - } - if (call_conv) { - if (current_program->entry_convention) { - cb_warning (COBC_WARN_FILLER, _("overriding convention specified in ENTRY-CONVENTION")); - } - current_program->entry_convention = call_conv; - } else if (!current_program->entry_convention) { - current_program->entry_convention = cb_int (CB_CONV_COBOL); - } - header_check |= COBC_HD_PROCEDURE_DIVISION; - } -#line 18586 "parser.c" /* yacc.c:1646 */ - break; - - case 1330: -#line 9563 "parser.y" /* yacc.c:1646 */ - { - if (current_program->flag_main - && !current_program->flag_chained && (yyvsp[-4])) { - cb_error (_("executable program requested but PROCEDURE/ENTRY has USING clause")); - } - /* Main entry point */ - emit_entry (current_program->program_id, 0, (yyvsp[-4]), NULL); - current_program->num_proc_params = cb_list_length ((yyvsp[-4])); - if (current_program->source_name) { - emit_entry (current_program->source_name, 1, (yyvsp[-4]), NULL); - } - } -#line 18603 "parser.c" /* yacc.c:1646 */ - break; - - case 1331: -#line 9576 "parser.y" /* yacc.c:1646 */ - { - if (current_paragraph) { - if (current_paragraph->exit_label) { - emit_statement (current_paragraph->exit_label); - } - emit_statement (cb_build_perform_exit (current_paragraph)); - } - if (current_section) { - if (current_section->exit_label) { - emit_statement (current_section->exit_label); - } - emit_statement (cb_build_perform_exit (current_section)); - } - } -#line 18622 "parser.c" /* yacc.c:1646 */ - break; - - case 1332: -#line 9591 "parser.y" /* yacc.c:1646 */ - { - cb_tree label; - - /* No PROCEDURE DIVISION header here */ - /* Only a statement is allowed as first element */ - /* Thereafter, sections/paragraphs may be used */ - check_pic_duplicate = 0; - check_duplicate = 0; - if (!current_program->entry_convention) { - current_program->entry_convention = cb_int (CB_CONV_COBOL); - } - cobc_in_procedure = 1U; - label = cb_build_reference ("MAIN SECTION"); - current_section = CB_LABEL (cb_build_label (label, NULL)); - current_section->flag_section = 1; - current_section->flag_dummy_section = 1; - current_section->flag_skip_label = !!skip_statements; - current_section->flag_declaratives = !!in_declaratives; - current_section->xref.skip = 1; - emit_statement (CB_TREE (current_section)); - label = cb_build_reference ("MAIN PARAGRAPH"); - current_paragraph = CB_LABEL (cb_build_label (label, NULL)); - current_paragraph->flag_declaratives = !!in_declaratives; - current_paragraph->flag_skip_label = !!skip_statements; - current_paragraph->flag_dummy_paragraph = 1; - current_paragraph->xref.skip = 1; - emit_statement (CB_TREE (current_paragraph)); - cb_set_system_names (); - } -#line 18656 "parser.c" /* yacc.c:1646 */ - break; - - case 1334: -#line 9625 "parser.y" /* yacc.c:1646 */ - { - (yyval) = NULL; - } -#line 18664 "parser.c" /* yacc.c:1646 */ - break; - - case 1335: -#line 9629 "parser.y" /* yacc.c:1646 */ - { - call_mode = CB_CALL_BY_REFERENCE; - size_mode = CB_SIZE_4; - } -#line 18673 "parser.c" /* yacc.c:1646 */ - break; - - case 1336: -#line 9634 "parser.y" /* yacc.c:1646 */ - { - if (cb_list_length ((yyvsp[0])) > MAX_CALL_FIELD_PARAMS) { - cb_error (_("number of arguments exceeds maximum %d"), - MAX_CALL_FIELD_PARAMS); - } - (yyval) = (yyvsp[0]); - } -#line 18685 "parser.c" /* yacc.c:1646 */ - break; - - case 1337: -#line 9642 "parser.y" /* yacc.c:1646 */ - { - call_mode = CB_CALL_BY_REFERENCE; - if (current_program->prog_type == COB_MODULE_TYPE_FUNCTION) { - cb_error (_("CHAINING invalid in user FUNCTION")); - } else { - current_program->flag_chained = 1; - } - } -#line 18698 "parser.c" /* yacc.c:1646 */ - break; - - case 1338: -#line 9651 "parser.y" /* yacc.c:1646 */ - { - if (cb_list_length ((yyvsp[0])) > MAX_CALL_FIELD_PARAMS) { - cb_error (_("number of arguments exceeds maximum %d"), - MAX_CALL_FIELD_PARAMS); - } - (yyval) = (yyvsp[0]); - } -#line 18710 "parser.c" /* yacc.c:1646 */ - break; - - case 1339: -#line 9661 "parser.y" /* yacc.c:1646 */ - { (yyval) = (yyvsp[0]); } -#line 18716 "parser.c" /* yacc.c:1646 */ - break; - - case 1340: -#line 9663 "parser.y" /* yacc.c:1646 */ - { (yyval) = cb_list_append ((yyvsp[-1]), (yyvsp[0])); } -#line 18722 "parser.c" /* yacc.c:1646 */ - break; - - case 1341: -#line 9668 "parser.y" /* yacc.c:1646 */ - { - cb_tree x; - struct cb_field *f; - - x = cb_build_identifier ((yyvsp[-1]), 0); - if ((yyvsp[-2]) == cb_int1 && CB_VALID_TREE (x) && cb_ref (x) != cb_error_node) { - f = CB_FIELD (cb_ref (x)); - f->flag_is_pdiv_opt = 1; - } - - (yyval) = CB_BUILD_PAIR (cb_int (call_mode), x); - CB_SIZES ((yyval)) = size_mode; - } -#line 18740 "parser.c" /* yacc.c:1646 */ - break; - - case 1343: -#line 9686 "parser.y" /* yacc.c:1646 */ - { - call_mode = CB_CALL_BY_REFERENCE; - } -#line 18748 "parser.c" /* yacc.c:1646 */ - break; - - case 1344: -#line 9690 "parser.y" /* yacc.c:1646 */ - { - if (current_program->flag_chained) { - cb_error (_("%s not allowed in CHAINED programs"), "BY VALUE"); - } else { - call_mode = CB_CALL_BY_VALUE; - } - } -#line 18760 "parser.c" /* yacc.c:1646 */ - break; - - case 1346: -#line 9702 "parser.y" /* yacc.c:1646 */ - { - if (call_mode != CB_CALL_BY_VALUE) { - cb_error (_("SIZE only allowed for BY VALUE items")); - } else { - size_mode = CB_SIZE_AUTO; - } - } -#line 18772 "parser.c" /* yacc.c:1646 */ - break; - - case 1347: -#line 9710 "parser.y" /* yacc.c:1646 */ - { - if (call_mode != CB_CALL_BY_VALUE) { - cb_error (_("SIZE only allowed for BY VALUE items")); - } else { - size_mode = CB_SIZE_4; - } - } -#line 18784 "parser.c" /* yacc.c:1646 */ - break; - - case 1348: -#line 9718 "parser.y" /* yacc.c:1646 */ - { - if (call_mode != CB_CALL_BY_VALUE) { - cb_error (_("SIZE only allowed for BY VALUE items")); - } else { - size_mode = CB_SIZE_AUTO | CB_SIZE_UNSIGNED; - } - } -#line 18796 "parser.c" /* yacc.c:1646 */ - break; - - case 1349: -#line 9726 "parser.y" /* yacc.c:1646 */ - { - if (size_mode) { - size_mode |= CB_SIZE_UNSIGNED; - } - } -#line 18806 "parser.c" /* yacc.c:1646 */ - break; - - case 1351: -#line 9736 "parser.y" /* yacc.c:1646 */ - { - unsigned char *s = CB_LITERAL ((yyvsp[0]))->data; - size_mode = 0; - - if (call_mode != CB_CALL_BY_VALUE) { - cb_error (_("SIZE only allowed for BY VALUE items")); - } else if (CB_LITERAL ((yyvsp[0]))->size != 1) { - cb_error_x ((yyvsp[0]), _("invalid value for SIZE")); - } else { - size_mode = 0; - switch (*s) { - case '1': - size_mode = CB_SIZE_1; - break; - case '2': - size_mode = CB_SIZE_2; - break; - case '4': - size_mode = CB_SIZE_4; - break; - case '8': - size_mode = CB_SIZE_8; - break; - default: - cb_error_x ((yyvsp[0]), _("invalid value for SIZE")); - break; - } - } - } -#line 18840 "parser.c" /* yacc.c:1646 */ - break; - - case 1353: -#line 9774 "parser.y" /* yacc.c:1646 */ - { - CB_PENDING_X ((yyvsp[-1]), _("MEMORY SIZE phrase in CALL statement")); - } -#line 18848 "parser.c" /* yacc.c:1646 */ - break; - - case 1354: -#line 9781 "parser.y" /* yacc.c:1646 */ - { - (yyval) = cb_int0; - } -#line 18856 "parser.c" /* yacc.c:1646 */ - break; - - case 1355: -#line 9785 "parser.y" /* yacc.c:1646 */ - { - if (call_mode != CB_CALL_BY_REFERENCE) { - cb_error (_("OPTIONAL only allowed for BY REFERENCE items")); - (yyval) = cb_int0; - } else { - (yyval) = cb_int1; - } - } -#line 18869 "parser.c" /* yacc.c:1646 */ - break; - - case 1356: -#line 9797 "parser.y" /* yacc.c:1646 */ - { - if (current_program->prog_type == COB_MODULE_TYPE_FUNCTION) { - cb_error (_("RETURNING clause is required for a FUNCTION")); - } - } -#line 18879 "parser.c" /* yacc.c:1646 */ - break; - - case 1357: -#line 9803 "parser.y" /* yacc.c:1646 */ - { - if (current_program->flag_main) { - cb_error (_("RETURNING clause cannot be OMITTED for main program")); - } - if (current_program->prog_type == COB_MODULE_TYPE_FUNCTION) { - cb_error (_("RETURNING clause cannot be OMITTED for a FUNCTION")); - } - current_program->flag_void = 1; - } -#line 18893 "parser.c" /* yacc.c:1646 */ - break; - - case 1358: -#line 9813 "parser.y" /* yacc.c:1646 */ - { - struct cb_field *f; - - if (cb_ref ((yyvsp[0])) != cb_error_node) { - f = CB_FIELD_PTR ((yyvsp[0])); - /* standard rule: returning item is allocated in the - activating runtime element */ - if (f->storage != CB_STORAGE_LINKAGE) { - cb_error (_("RETURNING item is not defined in LINKAGE SECTION")); - } else if (f->level != 1 && f->level != 77) { - cb_error (_("RETURNING item must have level 01")); - } else if (f->flag_occurs) { - cb_error (_("RETURNING item should not have OCCURS")); - } else { - if (current_program->prog_type == COB_MODULE_TYPE_FUNCTION) { - if (f->flag_any_length) { - cb_error (_("function RETURNING item may not be ANY LENGTH")); - } - - f->flag_is_returning = 1; - } - current_program->returning = (yyvsp[0]); - } - } - } -#line 18923 "parser.c" /* yacc.c:1646 */ - break; - - case 1360: -#line 9842 "parser.y" /* yacc.c:1646 */ - { - in_declaratives = 1; - emit_statement (cb_build_comment ("DECLARATIVES")); - } -#line 18932 "parser.c" /* yacc.c:1646 */ - break; - - case 1361: -#line 9848 "parser.y" /* yacc.c:1646 */ - { - if (needs_field_debug) { - start_debug = 1; - } - in_declaratives = 0; - in_debugging = 0; - if (current_paragraph) { - if (current_paragraph->exit_label) { - emit_statement (current_paragraph->exit_label); - } - emit_statement (cb_build_perform_exit (current_paragraph)); - current_paragraph = NULL; - } - if (current_section) { - if (current_section->exit_label) { - emit_statement (current_section->exit_label); - } - current_section->flag_fatal_check = 1; - emit_statement (cb_build_perform_exit (current_section)); - current_section = NULL; - } - skip_statements = 0; - emit_statement (cb_build_comment ("END DECLARATIVES")); - check_unreached = 0; - } -#line 18962 "parser.c" /* yacc.c:1646 */ - break; - - case 1366: -#line 9886 "parser.y" /* yacc.c:1646 */ - { - if (next_label_list) { - cb_tree plabel; - char name[32]; - - snprintf (name, sizeof(name), "L$%d", next_label_id); - plabel = cb_build_label (cb_build_reference (name), NULL); - CB_LABEL (plabel)->flag_next_sentence = 1; - emit_statement (plabel); - current_program->label_list = - cb_list_append (current_program->label_list, next_label_list); - next_label_list = NULL; - next_label_id++; - } - /* check_unreached = 0; */ - cb_end_statement(); - } -#line 18984 "parser.c" /* yacc.c:1646 */ - break; - - case 1368: -#line 9905 "parser.y" /* yacc.c:1646 */ - { - /* check_unreached = 0; */ - cb_end_statement(); - } -#line 18993 "parser.c" /* yacc.c:1646 */ - break; - - case 1369: -#line 9916 "parser.y" /* yacc.c:1646 */ - { - non_const_word = 0; - check_unreached = 0; - if (cb_build_section_name ((yyvsp[-1]), 0) == cb_error_node) { - YYERROR; - } - - /* Exit the last paragraph/section */ - if (current_paragraph) { - if (current_paragraph->exit_label) { - emit_statement (current_paragraph->exit_label); - } - emit_statement (cb_build_perform_exit (current_paragraph)); - } - if (current_section) { - if (current_section->exit_label) { - emit_statement (current_section->exit_label); - } - emit_statement (cb_build_perform_exit (current_section)); - } - if (current_program->flag_debugging && !in_debugging) { - if (current_paragraph || current_section) { - emit_statement (cb_build_comment ( - "DEBUGGING - Fall through")); - emit_statement (cb_build_debug (cb_debug_contents, - "FALL THROUGH", NULL)); - } - } - - /* Begin a new section */ - current_section = CB_LABEL (cb_build_label ((yyvsp[-1]), NULL)); - current_section->flag_section = 1; - /* Careful here, one negation */ - current_section->flag_real_label = !in_debugging; - current_section->flag_declaratives = !!in_declaratives; - current_section->flag_skip_label = !!skip_statements; - current_paragraph = NULL; - } -#line 19036 "parser.c" /* yacc.c:1646 */ - break; - - case 1370: -#line 9956 "parser.y" /* yacc.c:1646 */ - { - emit_statement (CB_TREE (current_section)); - } -#line 19044 "parser.c" /* yacc.c:1646 */ - break; - - case 1373: -#line 9967 "parser.y" /* yacc.c:1646 */ - { - cb_tree label; - - non_const_word = 0; - check_unreached = 0; - if (cb_build_section_name ((yyvsp[-1]), 1) == cb_error_node) { - YYERROR; - } - - /* Exit the last paragraph */ - if (current_paragraph) { - if (current_paragraph->exit_label) { - emit_statement (current_paragraph->exit_label); - } - emit_statement (cb_build_perform_exit (current_paragraph)); - if (current_program->flag_debugging && !in_debugging) { - emit_statement (cb_build_comment ( - "DEBUGGING - Fall through")); - emit_statement (cb_build_debug (cb_debug_contents, - "FALL THROUGH", NULL)); - } - } - - /* Begin a new paragraph */ - if (!current_section) { - label = cb_build_reference ("MAIN SECTION"); - current_section = CB_LABEL (cb_build_label (label, NULL)); - current_section->flag_section = 1; - current_section->flag_dummy_section = 1; - current_section->flag_declaratives = !!in_declaratives; - current_section->flag_skip_label = !!skip_statements; - current_section->xref.skip = 1; - emit_statement (CB_TREE (current_section)); - } - current_paragraph = CB_LABEL (cb_build_label ((yyvsp[-1]), current_section)); - current_paragraph->flag_declaratives = !!in_declaratives; - current_paragraph->flag_skip_label = !!skip_statements; - current_paragraph->flag_real_label = !in_debugging; - current_paragraph->segment = current_section->segment; - emit_statement (CB_TREE (current_paragraph)); - } -#line 19090 "parser.c" /* yacc.c:1646 */ - break; - - case 1374: -#line 10012 "parser.y" /* yacc.c:1646 */ - { - non_const_word = 0; - check_unreached = 0; - if (cb_build_section_name ((yyvsp[0]), 0) != cb_error_node) { - if (is_reserved_word (CB_NAME ((yyvsp[0])))) { - cb_error_x ((yyvsp[0]), _("'%s' is not a statement"), CB_NAME ((yyvsp[0]))); - } else if (is_default_reserved_word (CB_NAME ((yyvsp[0])))) { - cb_error_x ((yyvsp[0]), _("unknown statement '%s'; it may exist in another dialect"), - CB_NAME ((yyvsp[0]))); - } else { - cb_error_x ((yyvsp[0]), _("unknown statement '%s'"), CB_NAME ((yyvsp[0]))); - } - } - YYERROR; - } -#line 19110 "parser.c" /* yacc.c:1646 */ - break; - - case 1375: -#line 10031 "parser.y" /* yacc.c:1646 */ - { - (yyval) = NULL; - } -#line 19118 "parser.c" /* yacc.c:1646 */ - break; - - case 1376: -#line 10035 "parser.y" /* yacc.c:1646 */ - { - int segnum = cb_get_int ((yyvsp[0])); - - (yyval) = NULL; - if (cb_verify (cb_section_segments, _("section segments"))) { - if (segnum > 99) { - cb_error (_("SECTION segment-number must be less than or equal to 99")); - } else { - if (in_declaratives && segnum > 49) { - cb_error (_("SECTION segment-number in DECLARATIVES must be less than 50")); - } - if (!in_declaratives) { - current_program->flag_segments = 1; - current_section->segment = segnum; - } else { - /* Simon: old version did not allow segments in declaratives at all - ToDo: check codegen for possible missing parts */ - CB_PENDING (_("SECTION segment within DECLARATIVES")); - } - } - } - } -#line 19145 "parser.c" /* yacc.c:1646 */ - break; - - case 1377: -#line 10064 "parser.y" /* yacc.c:1646 */ - { - (yyval) = current_program->exec_list; - current_program->exec_list = NULL; - check_unreached = 0; - } -#line 19155 "parser.c" /* yacc.c:1646 */ - break; - - case 1378: -#line 10069 "parser.y" /* yacc.c:1646 */ - { - (yyval) = CB_TREE (current_statement); - current_statement = NULL; - } -#line 19164 "parser.c" /* yacc.c:1646 */ - break; - - case 1379: -#line 10074 "parser.y" /* yacc.c:1646 */ - { - (yyval) = cb_list_reverse (current_program->exec_list); - current_program->exec_list = (yyvsp[-2]); - current_statement = CB_STATEMENT ((yyvsp[-1])); - } -#line 19174 "parser.c" /* yacc.c:1646 */ - break; - - case 1380: -#line 10082 "parser.y" /* yacc.c:1646 */ - { - cb_tree label; - - if (!current_section) { - label = cb_build_reference ("MAIN SECTION"); - current_section = CB_LABEL (cb_build_label (label, NULL)); - current_section->flag_section = 1; - current_section->flag_dummy_section = 1; - current_section->flag_skip_label = !!skip_statements; - current_section->flag_declaratives = !!in_declaratives; - current_section->xref.skip = 1; - emit_statement (CB_TREE (current_section)); - } - if (!current_paragraph) { - label = cb_build_reference ("MAIN PARAGRAPH"); - current_paragraph = CB_LABEL (cb_build_label (label, NULL)); - CB_TREE (current_paragraph)->source_file - = CB_TREE (current_section)->source_file; - CB_TREE (current_paragraph)->source_line - = CB_TREE (current_section)->source_line; - current_paragraph->flag_declaratives = !!in_declaratives; - current_paragraph->flag_skip_label = !!skip_statements; - current_paragraph->flag_dummy_paragraph = 1; - current_paragraph->xref.skip = 1; - emit_statement (CB_TREE (current_paragraph)); - } - if (check_headers_present (COBC_HD_PROCEDURE_DIVISION, 0, 0, 0) == 1) { - if (current_program->prog_type == COB_MODULE_TYPE_PROGRAM) { - backup_current_pos (); - emit_entry (current_program->program_id, 0, NULL, NULL); - } - } - } -#line 19212 "parser.c" /* yacc.c:1646 */ - break; - - case 1381: -#line 10116 "parser.y" /* yacc.c:1646 */ - { - cobc_cs_check = 0; - } -#line 19220 "parser.c" /* yacc.c:1646 */ - break; - - case 1382: -#line 10120 "parser.y" /* yacc.c:1646 */ - { - cobc_cs_check = 0; - } -#line 19228 "parser.c" /* yacc.c:1646 */ - break; - - case 1447: -#line 10194 "parser.y" /* yacc.c:1646 */ - { - if (cb_verify (cb_next_sentence_phrase, "NEXT SENTENCE")) { - cb_tree label; - char name[32]; - - begin_statement ("NEXT SENTENCE", 0); - sprintf (name, "L$%d", next_label_id); - label = cb_build_reference (name); - next_label_list = cb_list_add (next_label_list, label); - emit_statement (cb_build_goto (label, NULL)); - } - check_unreached = 0; - } -#line 19246 "parser.c" /* yacc.c:1646 */ - break; - - case 1448: -#line 10208 "parser.y" /* yacc.c:1646 */ - { - yyerrok; - cobc_cs_check = 0; - } -#line 19255 "parser.c" /* yacc.c:1646 */ - break; - - case 1449: -#line 10219 "parser.y" /* yacc.c:1646 */ - { - begin_statement ("ACCEPT", TERM_ACCEPT); - cobc_cs_check = CB_CS_ACCEPT; - } -#line 19264 "parser.c" /* yacc.c:1646 */ - break; - - case 1451: -#line 10229 "parser.y" /* yacc.c:1646 */ - { - check_duplicate = 0; - check_line_col_duplicate = 0; - line_column = NULL; - } -#line 19274 "parser.c" /* yacc.c:1646 */ - break; - - case 1452: -#line 10235 "parser.y" /* yacc.c:1646 */ - { - /* Check for invalid use of screen clauses */ - if (current_statement->attr_ptr - || (!is_screen_field ((yyvsp[-3])) && line_column)) { - cb_verify_x ((yyvsp[-3]), cb_accept_display_extensions, - _("non-standard ACCEPT")); - } - - if (cb_accept_update && !has_dispattr (COB_SCREEN_NO_UPDATE)) { - set_dispattr (COB_SCREEN_UPDATE); - } - if (cb_accept_auto && !has_dispattr (COB_SCREEN_TAB)) { - set_dispattr (COB_SCREEN_AUTO); - } - if ((yyvsp[-3]) == cb_null && current_statement->attr_ptr) { - if (current_statement->attr_ptr->prompt) { - emit_conflicting_clause_message ("ACCEPT OMITTED", - _("PROMPT clause")); - } - if (current_statement->attr_ptr->size_is) { - emit_conflicting_clause_message ("ACCEPT OMITTED", - _("SIZE IS clause")); - } - } - cobc_cs_check = 0; - cb_emit_accept ((yyvsp[-3]), line_column, current_statement->attr_ptr); - } -#line 19306 "parser.c" /* yacc.c:1646 */ - break; - - case 1453: -#line 10263 "parser.y" /* yacc.c:1646 */ - { - check_duplicate = 0; - check_line_col_duplicate = 0; - line_column = NULL; - } -#line 19316 "parser.c" /* yacc.c:1646 */ - break; - - case 1454: -#line 10269 "parser.y" /* yacc.c:1646 */ - { - cobc_cs_check = 0; - CB_PENDING ("ACCEPT FROM SCREEN"); - } -#line 19325 "parser.c" /* yacc.c:1646 */ - break; - - case 1455: -#line 10274 "parser.y" /* yacc.c:1646 */ - { - cb_emit_accept_line_or_col ((yyvsp[-2]), 0); - } -#line 19333 "parser.c" /* yacc.c:1646 */ - break; - - case 1456: -#line 10278 "parser.y" /* yacc.c:1646 */ - { - cb_emit_accept_line_or_col ((yyvsp[-2]), 1); - } -#line 19341 "parser.c" /* yacc.c:1646 */ - break; - - case 1457: -#line 10282 "parser.y" /* yacc.c:1646 */ - { - /* information about terminal and its capabilities - cb_emit_accept_terminal_info ($1); */ - CB_PENDING ("ACCEPT FROM TERMINAL INFO"); - } -#line 19351 "parser.c" /* yacc.c:1646 */ - break; - - case 1458: -#line 10288 "parser.y" /* yacc.c:1646 */ - { - /* information about OS and runtime features - cb_emit_accept_system_info ($1); */ - CB_PENDING ("ACCEPT FROM SYSTEM INFO"); - } -#line 19361 "parser.c" /* yacc.c:1646 */ - break; - - case 1459: -#line 10294 "parser.y" /* yacc.c:1646 */ - { - cobc_cs_check = 0; - cb_emit_accept_date_yyyymmdd ((yyvsp[-3])); - } -#line 19370 "parser.c" /* yacc.c:1646 */ - break; - - case 1460: -#line 10299 "parser.y" /* yacc.c:1646 */ - { - cobc_cs_check = 0; - cb_emit_accept_date ((yyvsp[-2])); - } -#line 19379 "parser.c" /* yacc.c:1646 */ - break; - - case 1461: -#line 10304 "parser.y" /* yacc.c:1646 */ - { - cobc_cs_check = 0; - cb_emit_accept_day_yyyyddd ((yyvsp[-3])); - } -#line 19388 "parser.c" /* yacc.c:1646 */ - break; - - case 1462: -#line 10309 "parser.y" /* yacc.c:1646 */ - { - cobc_cs_check = 0; - cb_emit_accept_day ((yyvsp[-2])); - } -#line 19397 "parser.c" /* yacc.c:1646 */ - break; - - case 1463: -#line 10314 "parser.y" /* yacc.c:1646 */ - { - cb_emit_accept_day_of_week ((yyvsp[-2])); - } -#line 19405 "parser.c" /* yacc.c:1646 */ - break; - - case 1464: -#line 10320 "parser.y" /* yacc.c:1646 */ - { - cb_emit_accept_escape_key ((yyvsp[-3])); - } -#line 19413 "parser.c" /* yacc.c:1646 */ - break; - - case 1465: -#line 10326 "parser.y" /* yacc.c:1646 */ - { - cb_emit_accept_exception_status ((yyvsp[-3])); - } -#line 19421 "parser.c" /* yacc.c:1646 */ - break; - - case 1466: -#line 10330 "parser.y" /* yacc.c:1646 */ - { - /* check is data from keyboard available? "1", else "0" - cb_emit_accept_input_status ($1); */ - CB_PENDING ("ACCEPT FROM INPUT STATUS"); - } -#line 19431 "parser.c" /* yacc.c:1646 */ - break; - - case 1467: -#line 10336 "parser.y" /* yacc.c:1646 */ - { - cb_emit_accept_time ((yyvsp[-2])); - } -#line 19439 "parser.c" /* yacc.c:1646 */ - break; - - case 1468: -#line 10340 "parser.y" /* yacc.c:1646 */ - { - cobc_cs_check = 0; - cb_emit_accept_user_name ((yyvsp[-3])); - } -#line 19448 "parser.c" /* yacc.c:1646 */ - break; - - case 1469: -#line 10345 "parser.y" /* yacc.c:1646 */ - { - cb_emit_accept_command_line ((yyvsp[-2])); - } -#line 19456 "parser.c" /* yacc.c:1646 */ - break; - - case 1470: -#line 10349 "parser.y" /* yacc.c:1646 */ - { - cb_emit_accept_environment ((yyvsp[-3])); - } -#line 19464 "parser.c" /* yacc.c:1646 */ - break; - - case 1471: -#line 10353 "parser.y" /* yacc.c:1646 */ - { - cb_emit_get_environment ((yyvsp[-1]), (yyvsp[-4])); - } -#line 19472 "parser.c" /* yacc.c:1646 */ - break; - - case 1472: -#line 10357 "parser.y" /* yacc.c:1646 */ - { - cb_emit_accept_arg_number ((yyvsp[-2])); - } -#line 19480 "parser.c" /* yacc.c:1646 */ - break; - - case 1473: -#line 10361 "parser.y" /* yacc.c:1646 */ - { - cb_emit_accept_arg_value ((yyvsp[-3])); - } -#line 19488 "parser.c" /* yacc.c:1646 */ - break; - - case 1474: -#line 10365 "parser.y" /* yacc.c:1646 */ - { - cb_emit_accept_mnemonic ((yyvsp[-2]), (yyvsp[0])); - } -#line 19496 "parser.c" /* yacc.c:1646 */ - break; - - case 1475: -#line 10369 "parser.y" /* yacc.c:1646 */ - { - cb_emit_accept_name ((yyvsp[-2]), (yyvsp[0])); - } -#line 19504 "parser.c" /* yacc.c:1646 */ - break; - - case 1476: -#line 10373 "parser.y" /* yacc.c:1646 */ - { - cb_verify_x ((yyvsp[-1]), cb_accept_display_extensions, - _("non-standard ACCEPT")); - - if (cb_accept_update && !has_dispattr (COB_SCREEN_NO_UPDATE)) { - set_dispattr (COB_SCREEN_UPDATE); - } - if (cb_accept_auto && !has_dispattr (COB_SCREEN_TAB)) { - set_dispattr (COB_SCREEN_AUTO); - } - cobc_cs_check = 0; - cb_emit_accept ((yyvsp[-1]), line_column, current_statement->attr_ptr); - } -#line 19522 "parser.c" /* yacc.c:1646 */ - break; - - case 1477: -#line 10387 "parser.y" /* yacc.c:1646 */ - { - CB_PENDING ("ACCEPT MESSAGE COUNT"); - } -#line 19530 "parser.c" /* yacc.c:1646 */ - break; - - case 1479: -#line 10395 "parser.y" /* yacc.c:1646 */ - { - (yyval) = cb_null; - } -#line 19538 "parser.c" /* yacc.c:1646 */ - break; - - case 1480: -#line 10401 "parser.y" /* yacc.c:1646 */ - { - check_duplicate = 0; - check_line_col_duplicate = 0; - line_column = NULL; - } -#line 19548 "parser.c" /* yacc.c:1646 */ - break; - - case 1481: -#line 10407 "parser.y" /* yacc.c:1646 */ - { - (yyval) = (yyvsp[0]); - } -#line 19556 "parser.c" /* yacc.c:1646 */ - break; - - case 1482: -#line 10414 "parser.y" /* yacc.c:1646 */ - { - line_column = CB_BUILD_PAIR ((yyvsp[-3]), (yyvsp[-1])); - } -#line 19564 "parser.c" /* yacc.c:1646 */ - break; - - case 1483: -#line 10418 "parser.y" /* yacc.c:1646 */ - { - line_column = CB_BUILD_PAIR ((yyvsp[-2]), cb_int0); - } -#line 19572 "parser.c" /* yacc.c:1646 */ - break; - - case 1484: -#line 10422 "parser.y" /* yacc.c:1646 */ - { - line_column = CB_BUILD_PAIR (cb_int0, (yyvsp[-1])); - } -#line 19580 "parser.c" /* yacc.c:1646 */ - break; - - case 1485: -#line 10429 "parser.y" /* yacc.c:1646 */ - { - (yyval) = (yyvsp[0]); - } -#line 19588 "parser.c" /* yacc.c:1646 */ - break; - - case 1486: -#line 10433 "parser.y" /* yacc.c:1646 */ - { - (yyval) = cb_build_binary_op ((yyvsp[-2]), '+', (yyvsp[0])); - } -#line 19596 "parser.c" /* yacc.c:1646 */ - break; - - case 1487: -#line 10437 "parser.y" /* yacc.c:1646 */ - { - (yyval) = cb_build_binary_op ((yyvsp[-2]), '-', (yyvsp[0])); - } -#line 19604 "parser.c" /* yacc.c:1646 */ - break; - - case 1495: -#line 10461 "parser.y" /* yacc.c:1646 */ - { - check_repeated ("FROM CRT", SYN_CLAUSE_2, &check_duplicate); - } -#line 19612 "parser.c" /* yacc.c:1646 */ - break; - - case 1496: -#line 10465 "parser.y" /* yacc.c:1646 */ - { - check_repeated ("MODE IS BLOCK", SYN_CLAUSE_3, &check_duplicate); - } -#line 19620 "parser.c" /* yacc.c:1646 */ - break; - - case 1498: -#line 10470 "parser.y" /* yacc.c:1646 */ - { - check_repeated (_("TIME-OUT or BEFORE TIME clauses"), SYN_CLAUSE_4, - &check_duplicate); - set_attribs (NULL, NULL, NULL, (yyvsp[0]), NULL, NULL, 0); - } -#line 19630 "parser.c" /* yacc.c:1646 */ - break; - - case 1505: -#line 10495 "parser.y" /* yacc.c:1646 */ - { - set_attr_with_conflict ("LINE", SYN_CLAUSE_1, - _("AT screen-location"), SYN_CLAUSE_3, 1, - &check_line_col_duplicate); - - if ((CB_LITERAL_P ((yyvsp[0])) && cb_get_int ((yyvsp[0])) == 0) || (yyvsp[0]) == cb_zero) { - cb_verify (cb_accept_display_extensions, "LINE 0"); - } - - if (!line_column) { - line_column = CB_BUILD_PAIR ((yyvsp[0]), cb_int0); - } else { - CB_PAIR_X (line_column) = (yyvsp[0]); - } - } -#line 19650 "parser.c" /* yacc.c:1646 */ - break; - - case 1506: -#line 10511 "parser.y" /* yacc.c:1646 */ - { - set_attr_with_conflict ("COLUMN", SYN_CLAUSE_2, - _("AT screen-location"), SYN_CLAUSE_3, 1, - &check_line_col_duplicate); - - if ((CB_LITERAL_P ((yyvsp[0])) && cb_get_int ((yyvsp[0])) == 0) || (yyvsp[0]) == cb_zero) { - cb_verify (cb_accept_display_extensions, "COLUMN 0"); - } - - if (!line_column) { - line_column = CB_BUILD_PAIR (cb_int0, (yyvsp[0])); - } else { - CB_PAIR_Y (line_column) = (yyvsp[0]); - } - } -#line 19670 "parser.c" /* yacc.c:1646 */ - break; - - case 1507: -#line 10527 "parser.y" /* yacc.c:1646 */ - { - set_attr_with_conflict (_("AT screen-location"), SYN_CLAUSE_3, - _("LINE or COLUMN"), SYN_CLAUSE_1 | SYN_CLAUSE_2, - 1, &check_line_col_duplicate); - - cb_verify (cb_accept_display_extensions, "AT clause"); - - line_column = (yyvsp[0]); - } -#line 19684 "parser.c" /* yacc.c:1646 */ - break; - - case 1508: -#line 10540 "parser.y" /* yacc.c:1646 */ - { - /* FIXME: arithmetic expression should be possible, too, only numeric literals! */ - (yyval) = (yyvsp[0]); - } -#line 19693 "parser.c" /* yacc.c:1646 */ - break; - - case 1509: -#line 10548 "parser.y" /* yacc.c:1646 */ - { - /* FIXME: arithmetic expression should be possible, too, only numeric literals! */ - (yyval) = (yyvsp[0]); - } -#line 19702 "parser.c" /* yacc.c:1646 */ - break; - - case 1510: -#line 10556 "parser.y" /* yacc.c:1646 */ - { - cobc_cs_check = 0; - } -#line 19710 "parser.c" /* yacc.c:1646 */ - break; - - case 1511: -#line 10563 "parser.y" /* yacc.c:1646 */ - { - check_repeated ("AUTO", SYN_CLAUSE_5, &check_duplicate); - set_dispattr_with_conflict ("AUTO", COB_SCREEN_AUTO, - "TAB", COB_SCREEN_TAB); - } -#line 19720 "parser.c" /* yacc.c:1646 */ - break; - - case 1512: -#line 10569 "parser.y" /* yacc.c:1646 */ - { - check_repeated ("TAB", SYN_CLAUSE_6, &check_duplicate); - set_dispattr_with_conflict ("TAB", COB_SCREEN_TAB, - "AUTO", COB_SCREEN_AUTO); - } -#line 19730 "parser.c" /* yacc.c:1646 */ - break; - - case 1513: -#line 10575 "parser.y" /* yacc.c:1646 */ - { - check_repeated ("BELL", SYN_CLAUSE_7, &check_duplicate); - set_dispattr (COB_SCREEN_BELL); - } -#line 19739 "parser.c" /* yacc.c:1646 */ - break; - - case 1514: -#line 10580 "parser.y" /* yacc.c:1646 */ - { - check_repeated ("BELL", SYN_CLAUSE_7, &check_duplicate); - /* FIXME: do we need a COB_NO_SCREEN_BELL here? - set_dispattr (COB_SCREEN_BELL); */ - } -#line 19749 "parser.c" /* yacc.c:1646 */ - break; - - case 1515: -#line 10586 "parser.y" /* yacc.c:1646 */ - { - check_repeated ("BLINK", SYN_CLAUSE_8, &check_duplicate); - set_dispattr (COB_SCREEN_BLINK); - } -#line 19758 "parser.c" /* yacc.c:1646 */ - break; - - case 1516: -#line 10591 "parser.y" /* yacc.c:1646 */ - { - check_repeated ("CONVERSION", SYN_CLAUSE_9, &check_duplicate); - CB_PENDING ("ACCEPT CONVERSION"); - } -#line 19767 "parser.c" /* yacc.c:1646 */ - break; - - case 1517: -#line 10596 "parser.y" /* yacc.c:1646 */ - { - /* FIXME: arithmetic expression should be possible, too! */ - if (current_program->cursor_pos) { - emit_duplicate_clause_message ("CURSOR"); - } else { - /* TODO: actually reasonable and easy extension: an - *offset within the field* [auto-correct to 1/max] - (when variable also stored back on return) - */ - CB_PENDING ("ACCEPT ... WITH CURSOR"); - } - } -#line 19784 "parser.c" /* yacc.c:1646 */ - break; - - case 1518: -#line 10609 "parser.y" /* yacc.c:1646 */ - { - check_repeated ("FULL", SYN_CLAUSE_10, &check_duplicate); - set_dispattr (COB_SCREEN_FULL); - } -#line 19793 "parser.c" /* yacc.c:1646 */ - break; - - case 1519: -#line 10614 "parser.y" /* yacc.c:1646 */ - { - check_repeated ("LEFTLINE", SYN_CLAUSE_12, &check_duplicate); - set_dispattr (COB_SCREEN_LEFTLINE); - } -#line 19802 "parser.c" /* yacc.c:1646 */ - break; - - case 1520: -#line 10619 "parser.y" /* yacc.c:1646 */ - { - check_repeated ("LOWER", SYN_CLAUSE_13, &check_duplicate); - set_dispattr_with_conflict ("LOWER", COB_SCREEN_LOWER, - "UPPER", COB_SCREEN_UPPER); - } -#line 19812 "parser.c" /* yacc.c:1646 */ - break; - - case 1521: -#line 10625 "parser.y" /* yacc.c:1646 */ - { - check_repeated ("HIGHLIGHT", SYN_CLAUSE_11, &check_duplicate); - set_dispattr_with_conflict ("HIGHLIGHT", COB_SCREEN_HIGHLIGHT, - "LOWLIGHT", COB_SCREEN_LOWLIGHT); - } -#line 19822 "parser.c" /* yacc.c:1646 */ - break; - - case 1522: -#line 10631 "parser.y" /* yacc.c:1646 */ - { - check_repeated ("LOWLIGHT", SYN_CLAUSE_14, &check_duplicate); - set_dispattr_with_conflict ("LOWLIGHT", COB_SCREEN_LOWLIGHT, - "HIGHLIGHT", COB_SCREEN_HIGHLIGHT); - } -#line 19832 "parser.c" /* yacc.c:1646 */ - break; - - case 1523: -#line 10638 "parser.y" /* yacc.c:1646 */ - { - CB_PENDING ("SAME phrase"); - /* may not be specified along with the UNDERLINED, BLINK, REVERSED, - HIGH, LOW, STANDARD, COLOR, FOREGROUND-COLOR, or BACKGROUND-COLOR phrases */ - } -#line 19842 "parser.c" /* yacc.c:1646 */ - break; - - case 1524: -#line 10644 "parser.y" /* yacc.c:1646 */ - { - CB_PENDING ("STANDARD intensity"); - } -#line 19850 "parser.c" /* yacc.c:1646 */ - break; - - case 1525: -#line 10648 "parser.y" /* yacc.c:1646 */ - { - CB_PENDING ("BACKGROUND intensity"); - } -#line 19858 "parser.c" /* yacc.c:1646 */ - break; - - case 1526: -#line 10652 "parser.y" /* yacc.c:1646 */ - { - CB_PENDING ("BACKGROUND intensity"); - } -#line 19866 "parser.c" /* yacc.c:1646 */ - break; - - case 1527: -#line 10656 "parser.y" /* yacc.c:1646 */ - { - CB_PENDING ("BACKGROUND intensity"); - } -#line 19874 "parser.c" /* yacc.c:1646 */ - break; - - case 1528: -#line 10660 "parser.y" /* yacc.c:1646 */ - { - if (cb_no_echo_means_secure) { - check_repeated ("SECURE", SYN_CLAUSE_20, &check_duplicate); - set_dispattr (COB_SCREEN_SECURE); - } else { - check_repeated ("NO-ECHO", SYN_CLAUSE_15, &check_duplicate); - set_dispattr_with_conflict ("NO-ECHO", COB_SCREEN_NO_ECHO, - "SECURE", COB_SCREEN_SECURE); - } - } -#line 19889 "parser.c" /* yacc.c:1646 */ - break; - - case 1529: -#line 10671 "parser.y" /* yacc.c:1646 */ - { - check_repeated ("OVERLINE", SYN_CLAUSE_16, &check_duplicate); - set_dispattr (COB_SCREEN_OVERLINE); - } -#line 19898 "parser.c" /* yacc.c:1646 */ - break; - - case 1530: -#line 10676 "parser.y" /* yacc.c:1646 */ - { - check_repeated ("PROMPT", SYN_CLAUSE_17, &check_duplicate); - set_attribs (NULL, NULL, NULL, NULL, (yyvsp[0]), NULL, COB_SCREEN_PROMPT); - } -#line 19907 "parser.c" /* yacc.c:1646 */ - break; - - case 1531: -#line 10681 "parser.y" /* yacc.c:1646 */ - { - check_repeated ("PROMPT", SYN_CLAUSE_17, &check_duplicate); - set_dispattr (COB_SCREEN_PROMPT); - } -#line 19916 "parser.c" /* yacc.c:1646 */ - break; - - case 1532: -#line 10686 "parser.y" /* yacc.c:1646 */ - { - check_repeated ("REQUIRED", SYN_CLAUSE_18, &check_duplicate); - set_dispattr (COB_SCREEN_REQUIRED); - } -#line 19925 "parser.c" /* yacc.c:1646 */ - break; - - case 1533: -#line 10691 "parser.y" /* yacc.c:1646 */ - { - check_repeated ("REVERSE-VIDEO", SYN_CLAUSE_19, &check_duplicate); - set_dispattr (COB_SCREEN_REVERSE); - } -#line 19934 "parser.c" /* yacc.c:1646 */ - break; - - case 1534: -#line 10696 "parser.y" /* yacc.c:1646 */ - { - check_repeated ("SECURE", SYN_CLAUSE_20, &check_duplicate); - set_dispattr_with_conflict ("SECURE", COB_SCREEN_SECURE, - "NO-ECHO", COB_SCREEN_NO_ECHO); - } -#line 19944 "parser.c" /* yacc.c:1646 */ - break; - - case 1535: -#line 10702 "parser.y" /* yacc.c:1646 */ - { - /* FIXME: arithmetic expression should be possible, too! */ - check_repeated ("SIZE", SYN_CLAUSE_21, &check_duplicate); - set_attribs (NULL, NULL, NULL, NULL, NULL, (yyvsp[0]), 0); - } -#line 19954 "parser.c" /* yacc.c:1646 */ - break; - - case 1536: -#line 10708 "parser.y" /* yacc.c:1646 */ - { - check_repeated ("UNDERLINE", SYN_CLAUSE_22, &check_duplicate); - set_dispattr (COB_SCREEN_UNDERLINE); - } -#line 19963 "parser.c" /* yacc.c:1646 */ - break; - - case 1537: -#line 10713 "parser.y" /* yacc.c:1646 */ - { - check_repeated ("NO UPDATE", SYN_CLAUSE_23, &check_duplicate); - set_dispattr_with_conflict ("NO UPDATE", COB_SCREEN_NO_UPDATE, - "UPDATE", COB_SCREEN_UPDATE); - } -#line 19973 "parser.c" /* yacc.c:1646 */ - break; - - case 1538: -#line 10719 "parser.y" /* yacc.c:1646 */ - { - check_repeated ("UPDATE", SYN_CLAUSE_24, &check_duplicate); - set_dispattr_with_conflict ("UPDATE", COB_SCREEN_UPDATE, - "NO UPDATE", COB_SCREEN_NO_UPDATE); - } -#line 19983 "parser.c" /* yacc.c:1646 */ - break; - - case 1539: -#line 10725 "parser.y" /* yacc.c:1646 */ - { - check_repeated ("UPPER", SYN_CLAUSE_25, &check_duplicate); - set_dispattr_with_conflict ("UPPER", COB_SCREEN_UPPER, - "LOWER", COB_SCREEN_LOWER); - } -#line 19993 "parser.c" /* yacc.c:1646 */ - break; - - case 1540: -#line 10731 "parser.y" /* yacc.c:1646 */ - { - /* FIXME: arithmetic expression should be possible, too! */ - check_repeated ("FOREGROUND-COLOR", SYN_CLAUSE_26, &check_duplicate); - check_repeated ("BACKGROUND-COLOR", SYN_CLAUSE_27, &check_duplicate); - CB_PENDING ("COLOR"); - } -#line 20004 "parser.c" /* yacc.c:1646 */ - break; - - case 1541: -#line 10738 "parser.y" /* yacc.c:1646 */ - { - check_repeated ("FOREGROUND-COLOR", SYN_CLAUSE_26, &check_duplicate); - set_attribs ((yyvsp[0]), NULL, NULL, NULL, NULL, NULL, 0); - } -#line 20013 "parser.c" /* yacc.c:1646 */ - break; - - case 1542: -#line 10743 "parser.y" /* yacc.c:1646 */ - { - check_repeated ("BACKGROUND-COLOR", SYN_CLAUSE_27, &check_duplicate); - set_attribs (NULL, (yyvsp[0]), NULL, NULL, NULL, NULL, 0); - } -#line 20022 "parser.c" /* yacc.c:1646 */ - break; - - case 1543: -#line 10748 "parser.y" /* yacc.c:1646 */ - { - check_repeated ("SCROLL UP", SYN_CLAUSE_28, &check_duplicate); - set_attribs_with_conflict (NULL, NULL, (yyvsp[0]), NULL, NULL, NULL, - "SCROLL UP", COB_SCREEN_SCROLL_UP, - "SCROLL DOWN", COB_SCREEN_SCROLL_DOWN); - } -#line 20033 "parser.c" /* yacc.c:1646 */ - break; - - case 1544: -#line 10755 "parser.y" /* yacc.c:1646 */ - { - check_repeated ("SCROLL DOWN", SYN_CLAUSE_19, &check_duplicate); - set_attribs_with_conflict (NULL, NULL, (yyvsp[0]), NULL, NULL, NULL, - "SCROLL DOWN", COB_SCREEN_SCROLL_DOWN, - "SCROLL UP", COB_SCREEN_SCROLL_UP); - } -#line 20044 "parser.c" /* yacc.c:1646 */ - break; - - case 1545: -#line 10762 "parser.y" /* yacc.c:1646 */ - { - check_repeated (_("TIME-OUT or BEFORE TIME clauses"), SYN_CLAUSE_4, - &check_duplicate); - set_attribs (NULL, NULL, NULL, (yyvsp[0]), NULL, NULL, 0); - } -#line 20054 "parser.c" /* yacc.c:1646 */ - break; - - case 1549: -#line 10775 "parser.y" /* yacc.c:1646 */ - { - check_repeated ("CONTROL KEY", SYN_CLAUSE_29, &check_duplicate); - CB_PENDING ("CONTROL KEY"); -#if 0 /* should generate the following *after* the ACCEPT is finished */ - cb_emit_accept_escape_key ((yyvsp[0])); -#endif - } -#line 20066 "parser.c" /* yacc.c:1646 */ - break; - - case 1558: -#line 10803 "parser.y" /* yacc.c:1646 */ - { - TERMINATOR_WARNING ((yyvsp[(-2) - (0)]), ACCEPT); - } -#line 20074 "parser.c" /* yacc.c:1646 */ - break; - - case 1559: -#line 10807 "parser.y" /* yacc.c:1646 */ - { - TERMINATOR_CLEAR ((yyvsp[(-2) - (1)]), ACCEPT); -# if 0 /* activate only for debugging purposes for attribs - FIXME: Replace by DEBUG_LOG function */ - if (current_statement->attr_ptr) { - print_bits (current_statement->attr_ptr->dispattrs); - } else { - fputs("No Attribs", stderr); - } -#endif - } -#line 20090 "parser.c" /* yacc.c:1646 */ - break; - - case 1560: -#line 10825 "parser.y" /* yacc.c:1646 */ - { - begin_statement ("ADD", TERM_ADD); - } -#line 20098 "parser.c" /* yacc.c:1646 */ - break; - - case 1562: -#line 10834 "parser.y" /* yacc.c:1646 */ - { - cb_emit_arithmetic ((yyvsp[-1]), '+', cb_build_binary_list ((yyvsp[-3]), '+')); - } -#line 20106 "parser.c" /* yacc.c:1646 */ - break; - - case 1563: -#line 10838 "parser.y" /* yacc.c:1646 */ - { - if ((yyvsp[-3])) { - cb_list_add ((yyvsp[-4]), (yyvsp[-3])); - } - cb_emit_arithmetic ((yyvsp[-1]), 0, cb_build_binary_list ((yyvsp[-4]), '+')); - } -#line 20117 "parser.c" /* yacc.c:1646 */ - break; - - case 1564: -#line 10845 "parser.y" /* yacc.c:1646 */ - { - cb_emit_corresponding (cb_build_add, (yyvsp[-2]), (yyvsp[-4]), (yyvsp[-1])); - } -#line 20125 "parser.c" /* yacc.c:1646 */ - break; - - case 1565: -#line 10849 "parser.y" /* yacc.c:1646 */ - { - CB_PENDING ("ADD TABLE"); - cb_emit_tab_arithmetic (cb_build_add, (yyvsp[-4]), (yyvsp[-6]), (yyvsp[-3]), (yyvsp[-2]), (yyvsp[-1])); - } -#line 20134 "parser.c" /* yacc.c:1646 */ - break; - - case 1566: -#line 10856 "parser.y" /* yacc.c:1646 */ - { (yyval) = NULL; } -#line 20140 "parser.c" /* yacc.c:1646 */ - break; - - case 1567: -#line 10857 "parser.y" /* yacc.c:1646 */ - { (yyval) = (yyvsp[0]); } -#line 20146 "parser.c" /* yacc.c:1646 */ - break; - - case 1568: -#line 10862 "parser.y" /* yacc.c:1646 */ - { - TERMINATOR_WARNING ((yyvsp[(-2) - (0)]), ADD); - } -#line 20154 "parser.c" /* yacc.c:1646 */ - break; - - case 1569: -#line 10866 "parser.y" /* yacc.c:1646 */ - { - TERMINATOR_CLEAR ((yyvsp[(-2) - (1)]), ADD); - } -#line 20162 "parser.c" /* yacc.c:1646 */ - break; - - case 1570: -#line 10876 "parser.y" /* yacc.c:1646 */ - { - begin_statement ("ALLOCATE", 0); - cobc_cs_check = CB_CS_ALLOCATE; - current_statement->flag_no_based = 1; - } -#line 20172 "parser.c" /* yacc.c:1646 */ - break; - - case 1572: -#line 10886 "parser.y" /* yacc.c:1646 */ - { - cb_emit_allocate ((yyvsp[-3]), (yyvsp[0]), NULL, (yyvsp[-2])); - } -#line 20180 "parser.c" /* yacc.c:1646 */ - break; - - case 1573: -#line 10890 "parser.y" /* yacc.c:1646 */ - { - if ((yyvsp[0]) == NULL) { - cb_error_x (CB_TREE (current_statement), - _("ALLOCATE CHARACTERS requires RETURNING clause")); - } else { - cb_emit_allocate (NULL, (yyvsp[0]), (yyvsp[-4]), (yyvsp[-2])); - } - } -#line 20193 "parser.c" /* yacc.c:1646 */ - break; - - case 1575: -#line 10903 "parser.y" /* yacc.c:1646 */ - { - int adressing = cb_get_int ((yyvsp[0])); - - if (adressing == 24 - || adressing == 31) { - cb_warning (COBC_WARN_FILLER, _("ignoring %s phrase"), "LOC"); - } else { - cb_error (_("addressing mode should be either 24 or 31 bit")); - } - } -#line 20208 "parser.c" /* yacc.c:1646 */ - break; - - case 1576: -#line 10915 "parser.y" /* yacc.c:1646 */ - { (yyval) = NULL; } -#line 20214 "parser.c" /* yacc.c:1646 */ - break; - - case 1577: -#line 10916 "parser.y" /* yacc.c:1646 */ - { (yyval) = (yyvsp[0]); } -#line 20220 "parser.c" /* yacc.c:1646 */ - break; - - case 1578: -#line 10924 "parser.y" /* yacc.c:1646 */ - { - begin_statement ("ALTER", 0); - cb_verify (cb_alter_statement, "ALTER"); - } -#line 20229 "parser.c" /* yacc.c:1646 */ - break; - - case 1582: -#line 10938 "parser.y" /* yacc.c:1646 */ - { - cb_emit_alter ((yyvsp[-3]), (yyvsp[0])); - } -#line 20237 "parser.c" /* yacc.c:1646 */ - break; - - case 1585: -#line 10950 "parser.y" /* yacc.c:1646 */ - { - begin_statement ("CALL", TERM_CALL); - cobc_cs_check = CB_CS_CALL; - call_nothing = 0; - cobc_allow_program_name = 1; - backup_current_pos (); - } -#line 20249 "parser.c" /* yacc.c:1646 */ - break; - - case 1586: -#line 10959 "parser.y" /* yacc.c:1646 */ - { - cobc_cs_check = 0; - } -#line 20257 "parser.c" /* yacc.c:1646 */ - break; - - case 1587: -#line 10966 "parser.y" /* yacc.c:1646 */ - { - cobc_allow_program_name = 0; - } -#line 20265 "parser.c" /* yacc.c:1646 */ - break; - - case 1588: -#line 10974 "parser.y" /* yacc.c:1646 */ - { - int call_conv = 0; - int call_conv_local = 0; - - if (current_program->prog_type == COB_MODULE_TYPE_PROGRAM - && !current_program->flag_recursive - && is_recursive_call ((yyvsp[-6]))) { - cb_warning_x (COBC_WARN_FILLER, (yyvsp[-6]), - _("recursive program call - assuming RECURSIVE attribute")); - current_program->flag_recursive = 1; - } - call_conv = current_call_convention; - if ((yyvsp[-3])) { - if (current_call_convention & CB_CONV_STATIC_LINK) { - call_conv = CB_INTEGER ((yyvsp[-3]))->val | CB_CONV_STATIC_LINK; - } else { - call_conv = CB_INTEGER ((yyvsp[-3]))->val; - } - if ((yyvsp[-8])) { - /* note: $1 is likely to be a reference to SPECIAL-NAMES */ - cb_error_x ((yyvsp[-3]), _("%s and %s are mutually exclusive"), - "CALL-CONVENTION", "WITH LINKAGE"); - } - } - if ((CB_PAIR_X ((yyvsp[0])) != NULL) - && (call_conv & CB_CONV_STATIC_LINK)) { - cb_warning_x (COBC_WARN_FILLER, (yyvsp[-6]), - _("STATIC CALL convention ignored because of ON EXCEPTION")); - call_conv &= ~CB_CONV_STATIC_LINK; - } - if ((yyvsp[-8])) { - if (CB_INTEGER_P ((yyvsp[-8]))) { - call_conv_local = CB_INTEGER ((yyvsp[-8]))->val; - if ((CB_PAIR_X ((yyvsp[0])) != NULL) - && (call_conv_local & CB_CONV_STATIC_LINK)) { - cb_warning_x (COBC_WARN_FILLER, (yyvsp[-8]), - _("ON EXCEPTION ignored because of STATIC CALL")); - CB_PAIR_X ((yyvsp[0])) = NULL; - } - call_conv |= call_conv_local; - if (CB_INTEGER ((yyvsp[-8]))->val & CB_CONV_COBOL) { - call_conv &= ~CB_CONV_STDCALL; - } else { - call_conv &= ~CB_CONV_COBOL; - } - } else { - call_conv = cb_get_int((yyvsp[-8])); - } - } - /* For CALL ... RETURNING NOTHING, set the call convention bit */ - if (call_nothing) { - call_conv |= CB_CONV_NO_RET_UPD; - } - cb_emit_call ((yyvsp[-6]), (yyvsp[-2]), (yyvsp[-1]), CB_PAIR_X ((yyvsp[0])), CB_PAIR_Y ((yyvsp[0])), - cb_int (call_conv), (yyvsp[-7]), (yyvsp[-4]), backup_source_line); - } -#line 20326 "parser.c" /* yacc.c:1646 */ - break; - - case 1589: -#line 11034 "parser.y" /* yacc.c:1646 */ - { - (yyval) = NULL; - } -#line 20334 "parser.c" /* yacc.c:1646 */ - break; - - case 1590: -#line 11038 "parser.y" /* yacc.c:1646 */ - { - /* FIXME: hack - fake cs for context-sensitive WITH ... LINKAGE */ - cobc_cs_check |= CB_CS_OPTIONS; - backup_current_pos (); - } -#line 20344 "parser.c" /* yacc.c:1646 */ - break; - - case 1591: -#line 11044 "parser.y" /* yacc.c:1646 */ - { - (yyval) = (yyvsp[-1]); - restore_backup_pos ((yyval)); - cobc_cs_check ^= CB_CS_OPTIONS; - cb_verify_x ((yyval), cb_call_convention_linkage, "WITH ... LINKAGE"); - } -#line 20355 "parser.c" /* yacc.c:1646 */ - break; - - case 1592: -#line 11054 "parser.y" /* yacc.c:1646 */ - { - (yyval) = cb_int (CB_CONV_STDCALL); - } -#line 20363 "parser.c" /* yacc.c:1646 */ - break; - - case 1593: -#line 11058 "parser.y" /* yacc.c:1646 */ - { - (yyval) = cb_int (CB_CONV_C); - } -#line 20371 "parser.c" /* yacc.c:1646 */ - break; - - case 1594: -#line 11062 "parser.y" /* yacc.c:1646 */ - { - (yyval) = cb_int (CB_CONV_PASCAL); - } -#line 20379 "parser.c" /* yacc.c:1646 */ - break; - - case 1595: -#line 11069 "parser.y" /* yacc.c:1646 */ - { - (yyval) = NULL; - } -#line 20387 "parser.c" /* yacc.c:1646 */ - break; - - case 1596: -#line 11073 "parser.y" /* yacc.c:1646 */ - { - cb_verify (cb_call_convention_mnemonic, "CALL-/ENTRY-CONVENTION"); - (yyval) = (yyvsp[0]); - } -#line 20396 "parser.c" /* yacc.c:1646 */ - break; - - case 1597: -#line 11081 "parser.y" /* yacc.c:1646 */ - { - if (current_call_convention & CB_CONV_COBOL) { - (yyval) = cb_int (CB_CONV_STATIC_LINK | CB_CONV_COBOL); - } else { - (yyval) = cb_int (CB_CONV_STATIC_LINK); - } - } -#line 20408 "parser.c" /* yacc.c:1646 */ - break; - - case 1598: -#line 11089 "parser.y" /* yacc.c:1646 */ - { - (yyval) = cb_int (CB_CONV_STDCALL); - } -#line 20416 "parser.c" /* yacc.c:1646 */ - break; - - case 1599: -#line 11093 "parser.y" /* yacc.c:1646 */ - { - (yyval) = cb_int (CB_CONV_C); - } -#line 20424 "parser.c" /* yacc.c:1646 */ - break; - - case 1600: -#line 11097 "parser.y" /* yacc.c:1646 */ - { - (yyval) = cb_int (CB_CONV_C); - } -#line 20432 "parser.c" /* yacc.c:1646 */ - break; - - case 1601: -#line 11101 "parser.y" /* yacc.c:1646 */ - { - (yyval) = cb_int (CB_CONV_PASCAL); - } -#line 20440 "parser.c" /* yacc.c:1646 */ - break; - - case 1602: -#line 11105 "parser.y" /* yacc.c:1646 */ - { - cb_tree x; - - x = cb_ref ((yyvsp[0])); - if (CB_VALID_TREE (x)) { - if (CB_SYSTEM_NAME(x)->token != CB_FEATURE_CONVENTION) { - cb_error_x ((yyvsp[0]), _("invalid mnemonic name")); - (yyval) = NULL; - } else { - (yyval) = CB_SYSTEM_NAME(x)->value; - } - } else { - (yyval) = NULL; - } - } -#line 20460 "parser.c" /* yacc.c:1646 */ - break; - - case 1603: -#line 11124 "parser.y" /* yacc.c:1646 */ - { - if (CB_LITERAL_P ((yyvsp[0]))) { - cb_trim_program_id ((yyvsp[0])); - } - } -#line 20470 "parser.c" /* yacc.c:1646 */ - break; - - case 1604: -#line 11130 "parser.y" /* yacc.c:1646 */ - { - cb_verify (cb_program_prototypes, _("CALL/CANCEL with program-prototype-name")); - /* hack to push the prototype name */ - if ((yyvsp[0]) && CB_REFERENCE_P ((yyvsp[0]))) { - if ((yyvsp[-1])) { - cb_warning_x (COBC_WARN_FILLER, (yyvsp[-1]), _("id/literal ignored, using prototype name")); - } - (yyval) = (yyvsp[0]); - } else if ((yyvsp[-1]) && CB_LITERAL_P ((yyvsp[-1]))) { - (yyval) = (yyvsp[-1]); - } else { - cb_error (_("NESTED phrase is only valid with literal")); - (yyval) = cb_error_node; - } - } -#line 20490 "parser.c" /* yacc.c:1646 */ - break; - - case 1605: -#line 11149 "parser.y" /* yacc.c:1646 */ - { - (yyval) = NULL; - } -#line 20498 "parser.c" /* yacc.c:1646 */ - break; - - case 1606: -#line 11154 "parser.y" /* yacc.c:1646 */ - { - if (CB_LITERAL_P ((yyvsp[-1]))) { - cb_trim_program_id ((yyvsp[-1])); - } - (yyval) = (yyvsp[-1]); - } -#line 20509 "parser.c" /* yacc.c:1646 */ - break; - - case 1607: -#line 11164 "parser.y" /* yacc.c:1646 */ - { - CB_PENDING ("NESTED phrase for CALL statement"); - } -#line 20517 "parser.c" /* yacc.c:1646 */ - break; - - case 1609: -#line 11172 "parser.y" /* yacc.c:1646 */ - { - (yyval) = NULL; - } -#line 20525 "parser.c" /* yacc.c:1646 */ - break; - - case 1610: -#line 11176 "parser.y" /* yacc.c:1646 */ - { - call_mode = CB_CALL_BY_REFERENCE; - size_mode = CB_SIZE_4; - } -#line 20534 "parser.c" /* yacc.c:1646 */ - break; - - case 1611: -#line 11181 "parser.y" /* yacc.c:1646 */ - { - if (cb_list_length ((yyvsp[0])) > MAX_CALL_FIELD_PARAMS) { - cb_error_x (CB_TREE (current_statement), - _("number of arguments exceeds maximum %d"), - MAX_CALL_FIELD_PARAMS); - } - (yyval) = (yyvsp[0]); - } -#line 20547 "parser.c" /* yacc.c:1646 */ - break; - - case 1612: -#line 11192 "parser.y" /* yacc.c:1646 */ - { (yyval) = (yyvsp[0]); } -#line 20553 "parser.c" /* yacc.c:1646 */ - break; - - case 1613: -#line 11194 "parser.y" /* yacc.c:1646 */ - { (yyval) = cb_list_append ((yyvsp[-1]), (yyvsp[0])); } -#line 20559 "parser.c" /* yacc.c:1646 */ - break; - - case 1614: -#line 11199 "parser.y" /* yacc.c:1646 */ - { - if (call_mode != CB_CALL_BY_REFERENCE) { - cb_error_x (CB_TREE (current_statement), - _("OMITTED only allowed when arguments are passed BY REFERENCE")); - } - (yyval) = CB_BUILD_PAIR (cb_int (call_mode), cb_null); - } -#line 20571 "parser.c" /* yacc.c:1646 */ - break; - - case 1615: -#line 11207 "parser.y" /* yacc.c:1646 */ - { - int save_mode; /* internal single parameter only mode */ - - save_mode = call_mode; - if (CB_LITERAL_P((yyvsp[0]))) { - /* literals become BY CONTENT */ - if (CB_NUMERIC_LITERAL_P ((yyvsp[0]))) { - /* If not BY VALUE numeric-literals become BY CONTENT */ - if (call_mode != CB_CALL_BY_VALUE) { - call_mode = CB_CALL_BY_CONTENT; - } - } else { - call_mode = CB_CALL_BY_CONTENT; - } - } - if (call_mode != CB_CALL_BY_REFERENCE) { - if (CB_FILE_P ((yyvsp[0])) || (CB_REFERENCE_P ((yyvsp[0])) && - CB_FILE_P (CB_REFERENCE ((yyvsp[0]))->value))) { - cb_error_x (CB_TREE (current_statement), - _("invalid file name reference")); - } else if (call_mode == CB_CALL_BY_VALUE) { - /* FIXME: compiler configuration needed, IBM allows one-byte - alphanumeric items [--> a `char`], too, while - COBOL 2002/2014 allow only numeric literals - --> revise after rw-merge */ - if (cb_category_is_alpha ((yyvsp[0]))) { - cb_warning_x (COBC_WARN_FILLER, (yyvsp[0]), - _("BY CONTENT assumed for alphanumeric item '%s'"), - cb_name ((yyvsp[0]))); - call_mode = CB_CALL_BY_CONTENT; - } else if (cb_category_is_national ((yyvsp[0]))) { - cb_warning_x (COBC_WARN_FILLER, (yyvsp[0]), - _("BY CONTENT assumed for national item '%s'"), - cb_name ((yyvsp[0]))); - call_mode = CB_CALL_BY_CONTENT; - } - } - } - (yyval) = CB_BUILD_PAIR (cb_int (call_mode), (yyvsp[0])); - CB_SIZES ((yyval)) = size_mode; - call_mode = save_mode; - } -#line 20618 "parser.c" /* yacc.c:1646 */ - break; - - case 1617: -#line 11254 "parser.y" /* yacc.c:1646 */ - { - call_mode = CB_CALL_BY_REFERENCE; - } -#line 20626 "parser.c" /* yacc.c:1646 */ - break; - - case 1618: -#line 11258 "parser.y" /* yacc.c:1646 */ - { - if (current_program->flag_chained) { - cb_error_x (CB_TREE (current_statement), - _("%s not allowed in CHAINED programs"), "BY CONTENT"); - } else { - call_mode = CB_CALL_BY_CONTENT; - } - } -#line 20639 "parser.c" /* yacc.c:1646 */ - break; - - case 1619: -#line 11267 "parser.y" /* yacc.c:1646 */ - { - if (current_program->flag_chained) { - cb_error_x (CB_TREE (current_statement), - _("%s not allowed in CHAINED programs"), "BY VALUE"); - } else { - call_mode = CB_CALL_BY_VALUE; - } - } -#line 20652 "parser.c" /* yacc.c:1646 */ - break; - - case 1620: -#line 11279 "parser.y" /* yacc.c:1646 */ - { - (yyval) = NULL; - } -#line 20660 "parser.c" /* yacc.c:1646 */ - break; - - case 1621: -#line 11283 "parser.y" /* yacc.c:1646 */ - { - (yyval) = (yyvsp[0]); - } -#line 20668 "parser.c" /* yacc.c:1646 */ - break; - - case 1622: -#line 11287 "parser.y" /* yacc.c:1646 */ - { - (yyval) = cb_null; - } -#line 20676 "parser.c" /* yacc.c:1646 */ - break; - - case 1623: -#line 11291 "parser.y" /* yacc.c:1646 */ - { - call_nothing = CB_CONV_NO_RET_UPD; - (yyval) = cb_null; - } -#line 20685 "parser.c" /* yacc.c:1646 */ - break; - - case 1624: -#line 11296 "parser.y" /* yacc.c:1646 */ - { - struct cb_field *f; - - if (cb_ref ((yyvsp[0])) != cb_error_node) { - f = CB_FIELD_PTR ((yyvsp[0])); - if (f->level != 1 && f->level != 77) { - cb_error (_("RETURNING item must have level 01 or 77")); - (yyval) = NULL; - } else if (f->storage != CB_STORAGE_LINKAGE && - !f->flag_item_based) { - cb_error (_("RETURNING item must be a LINKAGE SECTION item or have BASED clause")); - (yyval) = NULL; - } else { - (yyval) = cb_build_address ((yyvsp[0])); - } - } else { - (yyval) = NULL; - } - } -#line 20709 "parser.c" /* yacc.c:1646 */ - break; - - case 1629: -#line 11329 "parser.y" /* yacc.c:1646 */ - { - (yyval) = CB_BUILD_PAIR (NULL, NULL); - } -#line 20717 "parser.c" /* yacc.c:1646 */ - break; - - case 1630: -#line 11333 "parser.y" /* yacc.c:1646 */ - { - (yyval) = CB_BUILD_PAIR ((yyvsp[-1]), (yyvsp[0])); - } -#line 20725 "parser.c" /* yacc.c:1646 */ - break; - - case 1631: -#line 11337 "parser.y" /* yacc.c:1646 */ - { - if ((yyvsp[0])) { - cb_verify (cb_not_exception_before_exception, - _("NOT EXCEPTION before EXCEPTION")); - } - (yyval) = CB_BUILD_PAIR ((yyvsp[0]), (yyvsp[-1])); - } -#line 20737 "parser.c" /* yacc.c:1646 */ - break; - - case 1632: -#line 11348 "parser.y" /* yacc.c:1646 */ - { - (yyval) = NULL; - } -#line 20745 "parser.c" /* yacc.c:1646 */ - break; - - case 1633: -#line 11352 "parser.y" /* yacc.c:1646 */ - { - (yyval) = (yyvsp[0]); - } -#line 20753 "parser.c" /* yacc.c:1646 */ - break; - - case 1634: -#line 11359 "parser.y" /* yacc.c:1646 */ - { - (yyval) = (yyvsp[0]); - } -#line 20761 "parser.c" /* yacc.c:1646 */ - break; - - case 1635: -#line 11363 "parser.y" /* yacc.c:1646 */ - { - cb_verify (cb_call_overflow, "ON OVERFLOW"); - (yyval) = (yyvsp[0]); - } -#line 20770 "parser.c" /* yacc.c:1646 */ - break; - - case 1636: -#line 11371 "parser.y" /* yacc.c:1646 */ - { - (yyval) = NULL; - } -#line 20778 "parser.c" /* yacc.c:1646 */ - break; - - case 1637: -#line 11375 "parser.y" /* yacc.c:1646 */ - { - (yyval) = (yyvsp[0]); - } -#line 20786 "parser.c" /* yacc.c:1646 */ - break; - - case 1638: -#line 11382 "parser.y" /* yacc.c:1646 */ - { - (yyval) = (yyvsp[0]); - } -#line 20794 "parser.c" /* yacc.c:1646 */ - break; - - case 1639: -#line 11389 "parser.y" /* yacc.c:1646 */ - { - TERMINATOR_WARNING ((yyvsp[(-2) - (0)]), CALL); - } -#line 20802 "parser.c" /* yacc.c:1646 */ - break; - - case 1640: -#line 11393 "parser.y" /* yacc.c:1646 */ - { - TERMINATOR_CLEAR ((yyvsp[(-2) - (1)]), CALL); - } -#line 20810 "parser.c" /* yacc.c:1646 */ - break; - - case 1641: -#line 11403 "parser.y" /* yacc.c:1646 */ - { - begin_statement ("CANCEL", 0); - cobc_allow_program_name = 1; - } -#line 20819 "parser.c" /* yacc.c:1646 */ - break; - - case 1642: -#line 11408 "parser.y" /* yacc.c:1646 */ - { - cobc_allow_program_name = 0; - } -#line 20827 "parser.c" /* yacc.c:1646 */ - break; - - case 1643: -#line 11415 "parser.y" /* yacc.c:1646 */ - { - cb_emit_cancel ((yyvsp[0])); - } -#line 20835 "parser.c" /* yacc.c:1646 */ - break; - - case 1644: -#line 11419 "parser.y" /* yacc.c:1646 */ - { - cb_emit_cancel ((yyvsp[0])); - } -#line 20843 "parser.c" /* yacc.c:1646 */ - break; - - case 1646: -#line 11427 "parser.y" /* yacc.c:1646 */ - { - cb_verify (cb_program_prototypes, _("CALL/CANCEL with program-prototype-name")); - } -#line 20851 "parser.c" /* yacc.c:1646 */ - break; - - case 1647: -#line 11436 "parser.y" /* yacc.c:1646 */ - { - begin_statement ("CLOSE", 0); - } -#line 20859 "parser.c" /* yacc.c:1646 */ - break; - - case 1651: -#line 11449 "parser.y" /* yacc.c:1646 */ - { - begin_implicit_statement (); - cb_emit_close ((yyvsp[-1]), (yyvsp[0])); - } -#line 20868 "parser.c" /* yacc.c:1646 */ - break; - - case 1652: -#line 11454 "parser.y" /* yacc.c:1646 */ - { - begin_implicit_statement (); - cb_emit_close ((yyvsp[-1]), (yyvsp[0])); - } -#line 20877 "parser.c" /* yacc.c:1646 */ - break; - - case 1653: -#line 11461 "parser.y" /* yacc.c:1646 */ - { (yyval) = cb_int (COB_CLOSE_NORMAL); } -#line 20883 "parser.c" /* yacc.c:1646 */ - break; - - case 1654: -#line 11462 "parser.y" /* yacc.c:1646 */ - { (yyval) = cb_int (COB_CLOSE_UNIT); } -#line 20889 "parser.c" /* yacc.c:1646 */ - break; - - case 1655: -#line 11463 "parser.y" /* yacc.c:1646 */ - { (yyval) = cb_int (COB_CLOSE_UNIT_REMOVAL); } -#line 20895 "parser.c" /* yacc.c:1646 */ - break; - - case 1656: -#line 11464 "parser.y" /* yacc.c:1646 */ - { (yyval) = cb_int (COB_CLOSE_NO_REWIND); } -#line 20901 "parser.c" /* yacc.c:1646 */ - break; - - case 1657: -#line 11465 "parser.y" /* yacc.c:1646 */ - { (yyval) = cb_int (COB_CLOSE_LOCK); } -#line 20907 "parser.c" /* yacc.c:1646 */ - break; - - case 1658: -#line 11470 "parser.y" /* yacc.c:1646 */ - { - CB_PENDING ("GRAPHICAL WINDOW"); - current_statement->name = "CLOSE WINDOW"; - } -#line 20916 "parser.c" /* yacc.c:1646 */ - break; - - case 1659: -#line 11475 "parser.y" /* yacc.c:1646 */ - { - cb_emit_close_window ((yyvsp[-1]), (yyvsp[0])); - } -#line 20924 "parser.c" /* yacc.c:1646 */ - break; - - case 1660: -#line 11481 "parser.y" /* yacc.c:1646 */ - { (yyval) = NULL; } -#line 20930 "parser.c" /* yacc.c:1646 */ - break; - - case 1661: -#line 11482 "parser.y" /* yacc.c:1646 */ - { (yyval) = cb_int0; } -#line 20936 "parser.c" /* yacc.c:1646 */ - break; - - case 1662: -#line 11490 "parser.y" /* yacc.c:1646 */ - { - begin_statement ("COMPUTE", TERM_COMPUTE); - } -#line 20944 "parser.c" /* yacc.c:1646 */ - break; - - case 1664: -#line 11499 "parser.y" /* yacc.c:1646 */ - { - cb_emit_arithmetic ((yyvsp[-3]), 0, (yyvsp[-1])); - } -#line 20952 "parser.c" /* yacc.c:1646 */ - break; - - case 1665: -#line 11506 "parser.y" /* yacc.c:1646 */ - { - TERMINATOR_WARNING ((yyvsp[(-2) - (0)]), COMPUTE); - } -#line 20960 "parser.c" /* yacc.c:1646 */ - break; - - case 1666: -#line 11510 "parser.y" /* yacc.c:1646 */ - { - TERMINATOR_CLEAR ((yyvsp[(-2) - (1)]), COMPUTE); - } -#line 20968 "parser.c" /* yacc.c:1646 */ - break; - - case 1667: -#line 11520 "parser.y" /* yacc.c:1646 */ - { - begin_statement ("COMMIT", 0); - cb_emit_commit (); - } -#line 20977 "parser.c" /* yacc.c:1646 */ - break; - - case 1668: -#line 11531 "parser.y" /* yacc.c:1646 */ - { - backup_current_pos (); - } -#line 20985 "parser.c" /* yacc.c:1646 */ - break; - - case 1669: -#line 11535 "parser.y" /* yacc.c:1646 */ - { - if (!(yyvsp[0])) { - /* Do not check unreached for CONTINUE without after phrase */ - unsigned int save_unreached = check_unreached; - check_unreached = 0; - begin_statement_from_backup_pos ("CONTINUE", 0); - cb_emit_continue (NULL); - check_unreached = save_unreached; - } else { - begin_statement_from_backup_pos ("CONTINUE AFTER", 0); - cb_emit_continue ((yyvsp[0])); - } - } -#line 21003 "parser.c" /* yacc.c:1646 */ - break; - - case 1670: -#line 11551 "parser.y" /* yacc.c:1646 */ - { (yyval) = NULL;} -#line 21009 "parser.c" /* yacc.c:1646 */ - break; - - case 1671: -#line 11552 "parser.y" /* yacc.c:1646 */ - { - /* FIXME: hack - fake cs for context-sensitive SECONDS */ - cobc_cs_check = CB_CS_RETRY; - } -#line 21018 "parser.c" /* yacc.c:1646 */ - break; - - case 1672: -#line 11557 "parser.y" /* yacc.c:1646 */ - { - (yyval) = (yyvsp[-1]); - } -#line 21026 "parser.c" /* yacc.c:1646 */ - break; - - case 1673: -#line 11567 "parser.y" /* yacc.c:1646 */ - { - begin_statement ("DESTROY", 0); - CB_PENDING ("GRAPHICAL CONTROL"); - } -#line 21035 "parser.c" /* yacc.c:1646 */ - break; - - case 1675: -#line 11576 "parser.y" /* yacc.c:1646 */ - { - cb_emit_destroy (NULL); - } -#line 21043 "parser.c" /* yacc.c:1646 */ - break; - - case 1676: -#line 11583 "parser.y" /* yacc.c:1646 */ - { - cb_emit_destroy ((yyvsp[0])); - } -#line 21051 "parser.c" /* yacc.c:1646 */ - break; - - case 1677: -#line 11593 "parser.y" /* yacc.c:1646 */ - { - begin_statement ("DELETE", TERM_DELETE); - } -#line 21059 "parser.c" /* yacc.c:1646 */ - break; - - case 1679: -#line 11602 "parser.y" /* yacc.c:1646 */ - { - cb_emit_delete ((yyvsp[-3])); - } -#line 21067 "parser.c" /* yacc.c:1646 */ - break; - - case 1681: -#line 11610 "parser.y" /* yacc.c:1646 */ - { - begin_implicit_statement (); - cb_emit_delete_file ((yyvsp[0])); - } -#line 21076 "parser.c" /* yacc.c:1646 */ - break; - - case 1682: -#line 11615 "parser.y" /* yacc.c:1646 */ - { - begin_implicit_statement (); - cb_emit_delete_file ((yyvsp[0])); - } -#line 21085 "parser.c" /* yacc.c:1646 */ - break; - - case 1683: -#line 11623 "parser.y" /* yacc.c:1646 */ - { - TERMINATOR_WARNING ((yyvsp[(-2) - (0)]), DELETE); - } -#line 21093 "parser.c" /* yacc.c:1646 */ - break; - - case 1684: -#line 11627 "parser.y" /* yacc.c:1646 */ - { - TERMINATOR_CLEAR ((yyvsp[(-2) - (1)]), DELETE); - } -#line 21101 "parser.c" /* yacc.c:1646 */ - break; - - case 1685: -#line 11637 "parser.y" /* yacc.c:1646 */ - { - begin_statement ("DISABLE", 0); - } -#line 21109 "parser.c" /* yacc.c:1646 */ - break; - - case 1689: -#line 11651 "parser.y" /* yacc.c:1646 */ - { - /* Add cb_verify for <= COBOL-85 */ - } -#line 21117 "parser.c" /* yacc.c:1646 */ - break; - - case 1695: -#line 11669 "parser.y" /* yacc.c:1646 */ - { - begin_statement ("DISPLAY", TERM_DISPLAY); - cobc_cs_check = CB_CS_DISPLAY; - display_type = UNKNOWN_DISPLAY; - is_first_display_item = 1; - } -#line 21128 "parser.c" /* yacc.c:1646 */ - break; - - case 1697: -#line 11681 "parser.y" /* yacc.c:1646 */ - { - cb_emit_env_name ((yyvsp[-2])); - } -#line 21136 "parser.c" /* yacc.c:1646 */ - break; - - case 1698: -#line 11685 "parser.y" /* yacc.c:1646 */ - { - cb_emit_env_value ((yyvsp[-2])); - } -#line 21144 "parser.c" /* yacc.c:1646 */ - break; - - case 1699: -#line 11689 "parser.y" /* yacc.c:1646 */ - { - cb_emit_arg_number ((yyvsp[-2])); - } -#line 21152 "parser.c" /* yacc.c:1646 */ - break; - - case 1700: -#line 11693 "parser.y" /* yacc.c:1646 */ - { - cb_emit_command_line ((yyvsp[-2])); - } -#line 21160 "parser.c" /* yacc.c:1646 */ - break; - - case 1708: -#line 11707 "parser.y" /* yacc.c:1646 */ - { - if ((yyvsp[0]) != NULL) { - error_if_different_display_type ((yyvsp[0]), NULL, NULL, NULL); - cb_emit_display ((yyvsp[0]), NULL, cb_int1, NULL, NULL, 0, - display_type); - } - } -#line 21172 "parser.c" /* yacc.c:1646 */ - break; - - case 1709: -#line 11715 "parser.y" /* yacc.c:1646 */ - { - set_display_type ((yyvsp[0]), NULL, NULL, NULL); - cb_emit_display ((yyvsp[0]), NULL, cb_int1, NULL, NULL, 1, - display_type); - } -#line 21182 "parser.c" /* yacc.c:1646 */ - break; - - case 1712: -#line 11729 "parser.y" /* yacc.c:1646 */ - { - check_duplicate = 0; - check_line_col_duplicate = 0; - advancing_value = cb_int1; - upon_value = NULL; - line_column = NULL; - } -#line 21194 "parser.c" /* yacc.c:1646 */ - break; - - case 1713: -#line 11737 "parser.y" /* yacc.c:1646 */ - { - if ((yyvsp[-2]) == cb_null) { - /* Emit DISPLAY OMITTED. */ - CB_UNFINISHED_X (CB_TREE(current_statement), "DISPLAY OMITTED"); - error_if_no_advancing_in_screen_display (advancing_value); - } - - /* Emit device or screen DISPLAY. */ - - /* - Check that disp_list does not contain an invalid mix of fields. - */ - if (display_type == UNKNOWN_DISPLAY) { - set_display_type ((yyvsp[-2]), upon_value, line_column, - current_statement->attr_ptr); - } else { - error_if_different_display_type ((yyvsp[-2]), upon_value, - line_column, - current_statement->attr_ptr); - } - - if (display_type == SCREEN_DISPLAY - || display_type == FIELD_ON_SCREEN_DISPLAY) { - error_if_no_advancing_in_screen_display (advancing_value); - } - - cb_emit_display ((yyvsp[-2]), upon_value, advancing_value, line_column, - current_statement->attr_ptr, - is_first_display_item, display_type); - - is_first_display_item = 0; - } -#line 21231 "parser.c" /* yacc.c:1646 */ - break; - - case 1714: -#line 11773 "parser.y" /* yacc.c:1646 */ - { - (yyval) = (yyvsp[0]); - } -#line 21239 "parser.c" /* yacc.c:1646 */ - break; - - case 1715: -#line 11777 "parser.y" /* yacc.c:1646 */ - { - (yyval) = cb_null; - } -#line 21247 "parser.c" /* yacc.c:1646 */ - break; - - case 1722: -#line 11799 "parser.y" /* yacc.c:1646 */ - { - check_repeated ("UPON", SYN_CLAUSE_1, &check_duplicate); - } -#line 21255 "parser.c" /* yacc.c:1646 */ - break; - - case 1723: -#line 11803 "parser.y" /* yacc.c:1646 */ - { - check_repeated ("NO ADVANCING", SYN_CLAUSE_2, &check_duplicate); - advancing_value = cb_int0; - } -#line 21264 "parser.c" /* yacc.c:1646 */ - break; - - case 1724: -#line 11808 "parser.y" /* yacc.c:1646 */ - { - check_repeated ("MODE IS BLOCK", SYN_CLAUSE_3, &check_duplicate); - } -#line 21272 "parser.c" /* yacc.c:1646 */ - break; - - case 1727: -#line 11817 "parser.y" /* yacc.c:1646 */ - { - upon_value = cb_build_display_mnemonic ((yyvsp[0])); - } -#line 21280 "parser.c" /* yacc.c:1646 */ - break; - - case 1728: -#line 11821 "parser.y" /* yacc.c:1646 */ - { - upon_value = cb_build_display_name ((yyvsp[0])); - } -#line 21288 "parser.c" /* yacc.c:1646 */ - break; - - case 1729: -#line 11825 "parser.y" /* yacc.c:1646 */ - { - upon_value = cb_int2; - } -#line 21296 "parser.c" /* yacc.c:1646 */ - break; - - case 1730: -#line 11829 "parser.y" /* yacc.c:1646 */ - { - upon_value = cb_null; - } -#line 21304 "parser.c" /* yacc.c:1646 */ - break; - - case 1733: -#line 11841 "parser.y" /* yacc.c:1646 */ - { - check_duplicate = SYN_CLAUSE_10; - check_line_col_duplicate = 0; - line_column = NULL; - set_dispattr_with_conflict ("ERASE EOS", COB_SCREEN_ERASE_EOS, - "ERASE EOL", COB_SCREEN_ERASE_EOL); - } -#line 21316 "parser.c" /* yacc.c:1646 */ - break; - - case 1734: -#line 11849 "parser.y" /* yacc.c:1646 */ - { - cb_emit_display (CB_LIST_INIT (cb_space), cb_null, cb_int1, line_column, NULL, 1, FIELD_ON_SCREEN_DISPLAY); - } -#line 21324 "parser.c" /* yacc.c:1646 */ - break; - - case 1735: -#line 11858 "parser.y" /* yacc.c:1646 */ - { - cb_emit_display ((yyvsp[-1]), cb_null, cb_int1, line_column, NULL, 1, FIELD_ON_SCREEN_DISPLAY); - } -#line 21332 "parser.c" /* yacc.c:1646 */ - break; - - case 1736: -#line 11864 "parser.y" /* yacc.c:1646 */ - { - check_duplicate = 0; - check_line_col_duplicate = 0; - line_column = NULL; - } -#line 21342 "parser.c" /* yacc.c:1646 */ - break; - - case 1737: -#line 11870 "parser.y" /* yacc.c:1646 */ - { - (yyval) = (yyvsp[0]); - } -#line 21350 "parser.c" /* yacc.c:1646 */ - break; - - case 1738: -#line 11877 "parser.y" /* yacc.c:1646 */ - { - (yyval) = CB_LIST_INIT ((yyvsp[0])); - } -#line 21358 "parser.c" /* yacc.c:1646 */ - break; - - case 1739: -#line 11881 "parser.y" /* yacc.c:1646 */ - { - (yyval) = cb_list_add ((yyvsp[-1]), (yyvsp[0])); - } -#line 21366 "parser.c" /* yacc.c:1646 */ - break; - - case 1742: -#line 11891 "parser.y" /* yacc.c:1646 */ - { - set_dispattr_with_conflict ("ERASE EOS", COB_SCREEN_ERASE_EOS, - "ERASE EOL", COB_SCREEN_ERASE_EOL); - (yyval) = cb_space; - } -#line 21376 "parser.c" /* yacc.c:1646 */ - break; - - case 1743: -#line 11901 "parser.y" /* yacc.c:1646 */ - { - CB_UNFINISHED_X (CB_TREE(current_statement), "DISPLAY MESSAGE"); - upon_value = NULL; - } -#line 21385 "parser.c" /* yacc.c:1646 */ - break; - - case 1744: -#line 11906 "parser.y" /* yacc.c:1646 */ - { - /* for now: minimal support for display and prompt only */ - if (upon_value) { - cb_emit_display (CB_LIST_INIT (upon_value), NULL, NULL, NULL, - NULL, 1, FIELD_ON_SCREEN_DISPLAY); - } - cb_emit_display ((yyvsp[-2]), NULL, NULL, NULL, - NULL, 1, FIELD_ON_SCREEN_DISPLAY); - cb_emit_accept (cb_null, NULL, NULL); - } -#line 21400 "parser.c" /* yacc.c:1646 */ - break; - - case 1749: -#line 11930 "parser.y" /* yacc.c:1646 */ - { - upon_value = (yyvsp[0]); - } -#line 21408 "parser.c" /* yacc.c:1646 */ - break; - - case 1754: -#line 11941 "parser.y" /* yacc.c:1646 */ - { - CB_PENDING ("GRAPHICAL WINDOW"); - current_statement->name = "DISPLAY WINDOW"; - } -#line 21417 "parser.c" /* yacc.c:1646 */ - break; - - case 1755: -#line 11946 "parser.y" /* yacc.c:1646 */ - { - check_duplicate = 0; - check_line_col_duplicate = 0; - line_column = NULL; - upon_value = NULL; /* Hack: stores the POP-UP AREA */ - } -#line 21428 "parser.c" /* yacc.c:1646 */ - break; - - case 1756: -#line 11953 "parser.y" /* yacc.c:1646 */ - { - cb_emit_display_window (NULL, upon_value, (yyvsp[-2]), line_column, - current_statement->attr_ptr); - } -#line 21437 "parser.c" /* yacc.c:1646 */ - break; - - case 1759: -#line 11966 "parser.y" /* yacc.c:1646 */ - { - CB_PENDING ("GRAPHICAL WINDOW"); - current_statement->name = "DISPLAY FLOATING WINDOW"; - } -#line 21446 "parser.c" /* yacc.c:1646 */ - break; - - case 1760: -#line 11971 "parser.y" /* yacc.c:1646 */ - { - check_duplicate = 0; - check_line_col_duplicate = 0; - line_column = NULL; - upon_value = NULL; /* Hack: stores the POP-UP AREA */ - } -#line 21457 "parser.c" /* yacc.c:1646 */ - break; - - case 1761: -#line 11978 "parser.y" /* yacc.c:1646 */ - { - if ((yyvsp[-5])) { - /* TODO: set "CELL WIDTH" and "CELL HEIGHT" to "LABEL FONT" */ - /* if not set already */ - } - cb_emit_display_window (cb_int0, upon_value, (yyvsp[-2]), line_column, - current_statement->attr_ptr); - } -#line 21470 "parser.c" /* yacc.c:1646 */ - break; - - case 1762: -#line 11990 "parser.y" /* yacc.c:1646 */ - { - CB_PENDING ("GRAPHICAL WINDOW"); - current_statement->name = "DISPLAY INITIAL WINDOW"; - check_duplicate = 0; - check_line_col_duplicate = 0; - line_column = NULL; - upon_value = NULL; /* Hack: stores the POP-UP AREA */ - /* TODO: initialize attributes for SHADOW, BOTTOM */ - } -#line 21484 "parser.c" /* yacc.c:1646 */ - break; - - case 1763: -#line 12000 "parser.y" /* yacc.c:1646 */ - { - if ((yyvsp[-3])) { - /* TODO: set "CELL WIDTH" and "CELL HEIGHT" to "LABEL FONT" */ - /* if not set already */ - } - cb_emit_display_window ((yyvsp[-4]), upon_value, NULL, line_column, - current_statement->attr_ptr); - } -#line 21497 "parser.c" /* yacc.c:1646 */ - break; - - case 1764: -#line 12011 "parser.y" /* yacc.c:1646 */ - {(yyval) = cb_int1;} -#line 21503 "parser.c" /* yacc.c:1646 */ - break; - - case 1765: -#line 12012 "parser.y" /* yacc.c:1646 */ - {(yyval) = cb_int2;} -#line 21509 "parser.c" /* yacc.c:1646 */ - break; - - case 1766: -#line 12013 "parser.y" /* yacc.c:1646 */ - {(yyval) = cb_int3;} -#line 21515 "parser.c" /* yacc.c:1646 */ - break; - - case 1767: -#line 12017 "parser.y" /* yacc.c:1646 */ - {(yyval) = NULL;} -#line 21521 "parser.c" /* yacc.c:1646 */ - break; - - case 1768: -#line 12018 "parser.y" /* yacc.c:1646 */ - {(yyval) = cb_int1;} -#line 21527 "parser.c" /* yacc.c:1646 */ - break; - - case 1769: -#line 12023 "parser.y" /* yacc.c:1646 */ - { - (yyval) = NULL; - } -#line 21535 "parser.c" /* yacc.c:1646 */ - break; - - case 1770: -#line 12027 "parser.y" /* yacc.c:1646 */ - { - (yyval) = (yyvsp[0]); - } -#line 21543 "parser.c" /* yacc.c:1646 */ - break; - - case 1771: -#line 12034 "parser.y" /* yacc.c:1646 */ - { - struct cb_field *f; - - if (cb_ref ((yyvsp[0])) != cb_error_node) { - f = CB_FIELD_PTR ((yyvsp[0])); - if (f->usage != CB_USAGE_HNDL_WINDOW - && f->usage != CB_USAGE_HNDL_SUBWINDOW) { - cb_error_x ((yyvsp[0]), _("HANDLE must be a %s HANDLE"), "WINDOW"); - } - } - (yyval) = (yyvsp[0]); - } -#line 21560 "parser.c" /* yacc.c:1646 */ - break; - - case 1772: -#line 12047 "parser.y" /* yacc.c:1646 */ - { - struct cb_field *f; - - if (cb_ref ((yyvsp[0])) != cb_error_node) { - f = CB_FIELD_PTR ((yyvsp[0])); - if (f->usage != CB_USAGE_HNDL) { - cb_error_x ((yyvsp[0]), _("HANDLE must be a generic HANDLE")); - } - } - (yyval) = (yyvsp[0]); - } -#line 21576 "parser.c" /* yacc.c:1646 */ - break; - - case 1773: -#line 12059 "parser.y" /* yacc.c:1646 */ - { - (yyval) = cb_null; - } -#line 21584 "parser.c" /* yacc.c:1646 */ - break; - - case 1777: -#line 12074 "parser.y" /* yacc.c:1646 */ - { - /* TODO: store */ - } -#line 21592 "parser.c" /* yacc.c:1646 */ - break; - - case 1784: -#line 12086 "parser.y" /* yacc.c:1646 */ - { /* TODO: set attribute */ } -#line 21598 "parser.c" /* yacc.c:1646 */ - break; - - case 1785: -#line 12089 "parser.y" /* yacc.c:1646 */ - { /* TODO: set attribute */ } -#line 21604 "parser.c" /* yacc.c:1646 */ - break; - - case 1786: -#line 12093 "parser.y" /* yacc.c:1646 */ - { (yyval) = cb_int0; } -#line 21610 "parser.c" /* yacc.c:1646 */ - break; - - case 1787: -#line 12094 "parser.y" /* yacc.c:1646 */ - { (yyval) = cb_int0; } -#line 21616 "parser.c" /* yacc.c:1646 */ - break; - - case 1788: -#line 12095 "parser.y" /* yacc.c:1646 */ - { (yyval) = cb_int1; } -#line 21622 "parser.c" /* yacc.c:1646 */ - break; - - case 1789: -#line 12099 "parser.y" /* yacc.c:1646 */ - { (yyval) = cb_int0; } -#line 21628 "parser.c" /* yacc.c:1646 */ - break; - - case 1790: -#line 12100 "parser.y" /* yacc.c:1646 */ - { (yyval) = cb_int1; } -#line 21634 "parser.c" /* yacc.c:1646 */ - break; - - case 1791: -#line 12101 "parser.y" /* yacc.c:1646 */ - { (yyval) = cb_int1; } -#line 21640 "parser.c" /* yacc.c:1646 */ - break; - - case 1792: -#line 12102 "parser.y" /* yacc.c:1646 */ - { (yyval) = cb_int2; } -#line 21646 "parser.c" /* yacc.c:1646 */ - break; - - case 1797: -#line 12118 "parser.y" /* yacc.c:1646 */ - { - if (upon_value) { - emit_duplicate_clause_message("POP-UP AREA"); - } - upon_value = (yyvsp[0]); - } -#line 21657 "parser.c" /* yacc.c:1646 */ - break; - - case 1798: -#line 12128 "parser.y" /* yacc.c:1646 */ - { - if (!strcmp (current_statement->name, "DISPLAY WINDOW")) { - cb_error_x ((yyvsp[0]), _("HANDLE clause invalid for %s"), - current_statement->name); - upon_value = cb_error_node; - } else{ - if (upon_value) { - emit_duplicate_clause_message("POP-UP AREA / HANDLE IN"); - } - upon_value = (yyvsp[0]); - } - } -#line 21674 "parser.c" /* yacc.c:1646 */ - break; - - case 1799: -#line 12144 "parser.y" /* yacc.c:1646 */ - { - check_repeated ("BELL", SYN_CLAUSE_4, &check_duplicate); - set_dispattr (COB_SCREEN_BELL); - } -#line 21683 "parser.c" /* yacc.c:1646 */ - break; - - case 1800: -#line 12149 "parser.y" /* yacc.c:1646 */ - { - check_repeated ("BLANK LINE", SYN_CLAUSE_5, &check_duplicate); - set_dispattr_with_conflict ("BLANK LINE", COB_SCREEN_BLANK_LINE, - "BLANK SCREEN", COB_SCREEN_BLANK_SCREEN); - } -#line 21693 "parser.c" /* yacc.c:1646 */ - break; - - case 1801: -#line 12155 "parser.y" /* yacc.c:1646 */ - { - check_repeated ("BLANK SCREEN", SYN_CLAUSE_6, &check_duplicate); - set_dispattr_with_conflict ("BLANK SCREEN", COB_SCREEN_BLANK_SCREEN, - "BLANK LINE", COB_SCREEN_BLANK_LINE); - } -#line 21703 "parser.c" /* yacc.c:1646 */ - break; - - case 1802: -#line 12161 "parser.y" /* yacc.c:1646 */ - { - check_repeated ("BLINK", SYN_CLAUSE_7, &check_duplicate); - set_dispattr (COB_SCREEN_BLINK); - } -#line 21712 "parser.c" /* yacc.c:1646 */ - break; - - case 1803: -#line 12166 "parser.y" /* yacc.c:1646 */ - { - check_repeated ("CONVERSION", SYN_CLAUSE_8, &check_duplicate); - cb_warning (COBC_WARN_FILLER, _("ignoring %s phrase"), "CONVERSION"); - } -#line 21721 "parser.c" /* yacc.c:1646 */ - break; - - case 1804: -#line 12171 "parser.y" /* yacc.c:1646 */ - { - check_repeated ("ERASE EOL", SYN_CLAUSE_9, &check_duplicate); - set_dispattr_with_conflict ("ERASE EOL", COB_SCREEN_ERASE_EOL, - "ERASE EOS", COB_SCREEN_ERASE_EOS); - } -#line 21731 "parser.c" /* yacc.c:1646 */ - break; - - case 1805: -#line 12177 "parser.y" /* yacc.c:1646 */ - { - check_repeated ("ERASE EOS", SYN_CLAUSE_10, &check_duplicate); - set_dispattr_with_conflict ("ERASE EOS", COB_SCREEN_ERASE_EOS, - "ERASE EOL", COB_SCREEN_ERASE_EOL); - } -#line 21741 "parser.c" /* yacc.c:1646 */ - break; - - case 1806: -#line 12183 "parser.y" /* yacc.c:1646 */ - { - check_repeated ("HIGHLIGHT", SYN_CLAUSE_11, &check_duplicate); - set_dispattr_with_conflict ("HIGHLIGHT", COB_SCREEN_HIGHLIGHT, - "LOWLIGHT", COB_SCREEN_LOWLIGHT); - } -#line 21751 "parser.c" /* yacc.c:1646 */ - break; - - case 1807: -#line 12189 "parser.y" /* yacc.c:1646 */ - { - check_repeated ("LOWLIGHT", SYN_CLAUSE_12, &check_duplicate); - set_dispattr_with_conflict ("LOWLIGHT", COB_SCREEN_LOWLIGHT, - "HIGHLIGHT", COB_SCREEN_HIGHLIGHT); - } -#line 21761 "parser.c" /* yacc.c:1646 */ - break; - - case 1808: -#line 12196 "parser.y" /* yacc.c:1646 */ - { - CB_PENDING ("SAME phrase"); - /* may not be specified along with the UNDERLINED, BLINK, REVERSED, - HIGH, LOW, STANDARD, COLOR, FOREGROUND-COLOR, or BACKGROUND-COLOR phrases */ - } -#line 21771 "parser.c" /* yacc.c:1646 */ - break; - - case 1809: -#line 12202 "parser.y" /* yacc.c:1646 */ - { - CB_PENDING ("STANDARD intensity"); - } -#line 21779 "parser.c" /* yacc.c:1646 */ - break; - - case 1810: -#line 12206 "parser.y" /* yacc.c:1646 */ - { - CB_PENDING ("BACKGROUND intensity"); - } -#line 21787 "parser.c" /* yacc.c:1646 */ - break; - - case 1811: -#line 12210 "parser.y" /* yacc.c:1646 */ - { - CB_PENDING ("BACKGROUND intensity"); - } -#line 21795 "parser.c" /* yacc.c:1646 */ - break; - - case 1812: -#line 12214 "parser.y" /* yacc.c:1646 */ - { - CB_PENDING ("BACKGROUND intensity"); - } -#line 21803 "parser.c" /* yacc.c:1646 */ - break; - - case 1813: -#line 12218 "parser.y" /* yacc.c:1646 */ - { - check_repeated ("OVERLINE", SYN_CLAUSE_13, &check_duplicate); - set_dispattr (COB_SCREEN_OVERLINE); - } -#line 21812 "parser.c" /* yacc.c:1646 */ - break; - - case 1814: -#line 12223 "parser.y" /* yacc.c:1646 */ - { - check_repeated ("REVERSE-VIDEO", SYN_CLAUSE_14, &check_duplicate); - set_dispattr (COB_SCREEN_REVERSE); - } -#line 21821 "parser.c" /* yacc.c:1646 */ - break; - - case 1815: -#line 12228 "parser.y" /* yacc.c:1646 */ - { - check_repeated ("SIZE", SYN_CLAUSE_15, &check_duplicate); - set_attribs (NULL, NULL, NULL, NULL, NULL, (yyvsp[0]), 0); - } -#line 21830 "parser.c" /* yacc.c:1646 */ - break; - - case 1816: -#line 12233 "parser.y" /* yacc.c:1646 */ - { - check_repeated ("UNDERLINE", SYN_CLAUSE_16, &check_duplicate); - set_dispattr (COB_SCREEN_UNDERLINE); - } -#line 21839 "parser.c" /* yacc.c:1646 */ - break; - - case 1817: -#line 12238 "parser.y" /* yacc.c:1646 */ - { - check_repeated ("FOREGROUND-COLOR", SYN_CLAUSE_17, &check_duplicate); - check_repeated ("BACKGROUND-COLOR", SYN_CLAUSE_18, &check_duplicate); - CB_PENDING ("COLOR"); - } -#line 21849 "parser.c" /* yacc.c:1646 */ - break; - - case 1818: -#line 12244 "parser.y" /* yacc.c:1646 */ - { - check_repeated ("FOREGROUND-COLOR", SYN_CLAUSE_17, &check_duplicate); - set_attribs ((yyvsp[0]), NULL, NULL, NULL, NULL, NULL, 0); - } -#line 21858 "parser.c" /* yacc.c:1646 */ - break; - - case 1819: -#line 12249 "parser.y" /* yacc.c:1646 */ - { - check_repeated ("BACKGROUND-COLOR", SYN_CLAUSE_18, &check_duplicate); - set_attribs (NULL, (yyvsp[0]), NULL, NULL, NULL, NULL, 0); - } -#line 21867 "parser.c" /* yacc.c:1646 */ - break; - - case 1820: -#line 12254 "parser.y" /* yacc.c:1646 */ - { - check_repeated ("SCROLL UP", SYN_CLAUSE_19, &check_duplicate); - set_attribs_with_conflict (NULL, NULL, (yyvsp[0]), NULL, NULL, NULL, - "SCROLL UP", COB_SCREEN_SCROLL_UP, - "SCROLL DOWN", COB_SCREEN_SCROLL_DOWN); - } -#line 21878 "parser.c" /* yacc.c:1646 */ - break; - - case 1821: -#line 12261 "parser.y" /* yacc.c:1646 */ - { - check_repeated ("SCROLL DOWN", SYN_CLAUSE_20, &check_duplicate); - set_attribs_with_conflict (NULL, NULL, (yyvsp[0]), NULL, NULL, NULL, - "SCROLL DOWN", COB_SCREEN_SCROLL_DOWN, - "SCROLL UP", COB_SCREEN_SCROLL_UP); - } -#line 21889 "parser.c" /* yacc.c:1646 */ - break; - - case 1822: -#line 12271 "parser.y" /* yacc.c:1646 */ - { - TERMINATOR_WARNING ((yyvsp[(-2) - (0)]), DISPLAY); - } -#line 21897 "parser.c" /* yacc.c:1646 */ - break; - - case 1823: -#line 12275 "parser.y" /* yacc.c:1646 */ - { - TERMINATOR_CLEAR ((yyvsp[(-2) - (1)]), DISPLAY); - } -#line 21905 "parser.c" /* yacc.c:1646 */ - break; - - case 1824: -#line 12285 "parser.y" /* yacc.c:1646 */ - { - begin_statement ("DIVIDE", TERM_DIVIDE); - } -#line 21913 "parser.c" /* yacc.c:1646 */ - break; - - case 1826: -#line 12294 "parser.y" /* yacc.c:1646 */ - { - cb_emit_arithmetic ((yyvsp[-1]), '/', (yyvsp[-3])); - } -#line 21921 "parser.c" /* yacc.c:1646 */ - break; - - case 1827: -#line 12298 "parser.y" /* yacc.c:1646 */ - { - cb_emit_arithmetic ((yyvsp[-1]), 0, cb_build_binary_op ((yyvsp[-3]), '/', (yyvsp[-5]))); - } -#line 21929 "parser.c" /* yacc.c:1646 */ - break; - - case 1828: -#line 12302 "parser.y" /* yacc.c:1646 */ - { - cb_emit_arithmetic ((yyvsp[-1]), 0, cb_build_binary_op ((yyvsp[-5]), '/', (yyvsp[-3]))); - } -#line 21937 "parser.c" /* yacc.c:1646 */ - break; - - case 1829: -#line 12306 "parser.y" /* yacc.c:1646 */ - { - cb_emit_divide ((yyvsp[-5]), (yyvsp[-7]), (yyvsp[-3]), (yyvsp[-1])); - } -#line 21945 "parser.c" /* yacc.c:1646 */ - break; - - case 1830: -#line 12310 "parser.y" /* yacc.c:1646 */ - { - cb_emit_divide ((yyvsp[-7]), (yyvsp[-5]), (yyvsp[-3]), (yyvsp[-1])); - } -#line 21953 "parser.c" /* yacc.c:1646 */ - break; - - case 1831: -#line 12317 "parser.y" /* yacc.c:1646 */ - { - TERMINATOR_WARNING ((yyvsp[(-2) - (0)]), DIVIDE); - } -#line 21961 "parser.c" /* yacc.c:1646 */ - break; - - case 1832: -#line 12321 "parser.y" /* yacc.c:1646 */ - { - TERMINATOR_CLEAR ((yyvsp[(-2) - (1)]), DIVIDE); - } -#line 21969 "parser.c" /* yacc.c:1646 */ - break; - - case 1833: -#line 12331 "parser.y" /* yacc.c:1646 */ - { - begin_statement ("ENABLE", 0); - } -#line 21977 "parser.c" /* yacc.c:1646 */ - break; - - case 1835: -#line 12342 "parser.y" /* yacc.c:1646 */ - { - check_unreached = 0; - begin_statement ("ENTRY", 0); - backup_current_pos (); - } -#line 21987 "parser.c" /* yacc.c:1646 */ - break; - - case 1837: -#line 12349 "parser.y" /* yacc.c:1646 */ - { - check_unreached = 0; - begin_statement ("ENTRY FOR GO TO", 0); - backup_current_pos (); - } -#line 21997 "parser.c" /* yacc.c:1646 */ - break; - - case 1839: -#line 12359 "parser.y" /* yacc.c:1646 */ - { - if (current_program->nested_level) { - cb_error (_("%s is invalid in nested program"), "ENTRY"); - } else if (current_program->prog_type == COB_MODULE_TYPE_FUNCTION) { - cb_error (_("%s is invalid in a user FUNCTION"), "ENTRY"); - } else if (cb_verify (cb_entry_statement, "ENTRY")) { - cb_tree call_conv = (yyvsp[-3]); - if ((yyvsp[-1])) { - call_conv = (yyvsp[-1]); - if ((yyvsp[-3])) { - /* note: $1 is likely to be a reference to SPECIAL-NAMES */ - cb_error_x ((yyvsp[-1]), _("%s and %s are mutually exclusive"), - "CALL-CONVENTION", "WITH LINKAGE"); - } - } - if (!cobc_check_valid_name ((char *)(CB_LITERAL ((yyvsp[-2]))->data), ENTRY_NAME)) { - emit_entry ((char *)(CB_LITERAL ((yyvsp[-2]))->data), 1, (yyvsp[0]), call_conv); - } - } - } -#line 22022 "parser.c" /* yacc.c:1646 */ - break; - - case 1840: -#line 12383 "parser.y" /* yacc.c:1646 */ - { - if (cb_verify (cb_goto_entry, "ENTRY FOR GO TO")) { - emit_entry_goto ((char *)(CB_LITERAL ((yyvsp[0]))->data)); - } - } -#line 22032 "parser.c" /* yacc.c:1646 */ - break; - - case 1841: -#line 12395 "parser.y" /* yacc.c:1646 */ - { - begin_statement ("EVALUATE", TERM_EVALUATE); - eval_level++; - if (eval_level >= EVAL_DEPTH) { - cb_error (_("maximum evaluate depth exceeded (%d)"), - EVAL_DEPTH); - eval_level = 0; - eval_inc = 0; - eval_inc2 = 0; - YYERROR; - } else { - for (eval_inc = 0; eval_inc < EVAL_DEPTH; ++eval_inc) { - eval_check[eval_level][eval_inc] = NULL; - } - eval_inc = 0; - eval_inc2 = 0; - } - cb_end_cond (cb_any); - cb_save_cond (); - cb_true_side (); - } -#line 22058 "parser.c" /* yacc.c:1646 */ - break; - - case 1843: -#line 12422 "parser.y" /* yacc.c:1646 */ - { - cb_emit_evaluate ((yyvsp[-1]), (yyvsp[0])); - eval_level--; - } -#line 22067 "parser.c" /* yacc.c:1646 */ - break; - - case 1844: -#line 12429 "parser.y" /* yacc.c:1646 */ - { (yyval) = CB_LIST_INIT ((yyvsp[0])); } -#line 22073 "parser.c" /* yacc.c:1646 */ - break; - - case 1845: -#line 12431 "parser.y" /* yacc.c:1646 */ - { (yyval) = cb_list_add ((yyvsp[-2]), (yyvsp[0])); } -#line 22079 "parser.c" /* yacc.c:1646 */ - break; - - case 1846: -#line 12436 "parser.y" /* yacc.c:1646 */ - { - (yyval) = (yyvsp[0]); - eval_check[eval_level][eval_inc++] = (yyvsp[0]); - if (eval_inc >= EVAL_DEPTH) { - cb_error (_("maximum evaluate depth exceeded (%d)"), - EVAL_DEPTH); - eval_inc = 0; - YYERROR; - } - } -#line 22094 "parser.c" /* yacc.c:1646 */ - break; - - case 1847: -#line 12447 "parser.y" /* yacc.c:1646 */ - { - (yyval) = cb_true; - eval_check[eval_level][eval_inc++] = NULL; - if (eval_inc >= EVAL_DEPTH) { - cb_error (_("maximum evaluate depth exceeded (%d)"), - EVAL_DEPTH); - eval_inc = 0; - YYERROR; - } - } -#line 22109 "parser.c" /* yacc.c:1646 */ - break; - - case 1848: -#line 12458 "parser.y" /* yacc.c:1646 */ - { - (yyval) = cb_false; - eval_check[eval_level][eval_inc++] = cb_false; - if (eval_inc >= EVAL_DEPTH) { - cb_error (_("maximum evaluate depth exceeded (%d)"), - EVAL_DEPTH); - eval_inc = 0; - YYERROR; - } - } -#line 22124 "parser.c" /* yacc.c:1646 */ - break; - - case 1849: -#line 12472 "parser.y" /* yacc.c:1646 */ - { - if ((yyvsp[0])) { - (yyval) = cb_list_add ((yyvsp[-1]), (yyvsp[0])); - } else { - (yyval) = (yyvsp[-1]); - } - } -#line 22136 "parser.c" /* yacc.c:1646 */ - break; - - case 1850: -#line 12481 "parser.y" /* yacc.c:1646 */ - { - (yyval) = (yyvsp[0]); - } -#line 22144 "parser.c" /* yacc.c:1646 */ - break; - - case 1851: -#line 12487 "parser.y" /* yacc.c:1646 */ - { (yyval) = CB_LIST_INIT ((yyvsp[0])); } -#line 22150 "parser.c" /* yacc.c:1646 */ - break; - - case 1852: -#line 12489 "parser.y" /* yacc.c:1646 */ - { (yyval) = cb_list_add ((yyvsp[-1]), (yyvsp[0])); } -#line 22156 "parser.c" /* yacc.c:1646 */ - break; - - case 1853: -#line 12495 "parser.y" /* yacc.c:1646 */ - { - (yyval) = CB_BUILD_CHAIN ((yyvsp[0]), (yyvsp[-1])); - eval_inc2 = 0; - } -#line 22165 "parser.c" /* yacc.c:1646 */ - break; - - case 1854: -#line 12500 "parser.y" /* yacc.c:1646 */ - { - eval_inc2 = 0; - cb_verify (cb_missing_statement, - _("WHEN without imperative statement")); - /* Note: we don't clear the EVALUATE terminator here - as we'd have to skip this later - [side effect: possible warning about missing terminator] */ - (yyval) = CB_BUILD_CHAIN (CB_LIST_INIT (cb_build_continue ()), (yyvsp[-1])); - } -#line 22179 "parser.c" /* yacc.c:1646 */ - break; - - case 1855: -#line 12510 "parser.y" /* yacc.c:1646 */ - { - eval_inc2 = 0; - cb_verify (cb_missing_statement, - _("WHEN without imperative statement")); - /* Put the dot token back into the stack for reparse */ - cb_unput_dot (); - (yyval) = CB_BUILD_CHAIN (CB_LIST_INIT (cb_build_continue ()), (yyvsp[-1])); - } -#line 22192 "parser.c" /* yacc.c:1646 */ - break; - - case 1856: -#line 12523 "parser.y" /* yacc.c:1646 */ - { - (yyval) = CB_BUILD_CHAIN ((yyvsp[0]), NULL); - eval_inc2 = 0; - } -#line 22201 "parser.c" /* yacc.c:1646 */ - break; - - case 1857: -#line 12528 "parser.y" /* yacc.c:1646 */ - { - eval_inc2 = 0; - cb_verify (cb_missing_statement, - _("WHEN OTHER without imperative statement")); - /* Note: we don't clear the EVALUATE terminator here - as we'd have to skip this later - [side effect: possible warning about missing terminator] */ - (yyval) = NULL; - } -#line 22215 "parser.c" /* yacc.c:1646 */ - break; - - case 1858: -#line 12538 "parser.y" /* yacc.c:1646 */ - { - eval_inc2 = 0; - cb_verify (cb_missing_statement, - _("WHEN OTHER without imperative statement")); - /* Put the dot token back into the stack for reparse */ - cb_unput_dot (); - (yyval) = NULL; - } -#line 22228 "parser.c" /* yacc.c:1646 */ - break; - - case 1859: -#line 12550 "parser.y" /* yacc.c:1646 */ - { - backup_current_pos (); - } -#line 22236 "parser.c" /* yacc.c:1646 */ - break; - - case 1860: -#line 12554 "parser.y" /* yacc.c:1646 */ - { - (yyval) = CB_LIST_INIT ((yyvsp[0])); - restore_backup_pos ((yyval)); - eval_inc2 = 0; - } -#line 22246 "parser.c" /* yacc.c:1646 */ - break; - - case 1861: -#line 12561 "parser.y" /* yacc.c:1646 */ - { - backup_current_pos (); - } -#line 22254 "parser.c" /* yacc.c:1646 */ - break; - - case 1862: -#line 12565 "parser.y" /* yacc.c:1646 */ - { - (yyval) = cb_list_add ((yyvsp[-3]), (yyvsp[0])); - restore_backup_pos ((yyval)); - eval_inc2 = 0; - } -#line 22264 "parser.c" /* yacc.c:1646 */ - break; - - case 1863: -#line 12573 "parser.y" /* yacc.c:1646 */ - { (yyval) = CB_LIST_INIT ((yyvsp[0])); } -#line 22270 "parser.c" /* yacc.c:1646 */ - break; - - case 1864: -#line 12575 "parser.y" /* yacc.c:1646 */ - { (yyval) = cb_list_add ((yyvsp[-2]), (yyvsp[0])); } -#line 22276 "parser.c" /* yacc.c:1646 */ - break; - - case 1865: -#line 12580 "parser.y" /* yacc.c:1646 */ - { - cb_tree not0; - cb_tree e1; - cb_tree e2; - cb_tree x; - cb_tree parm1; - - not0 = cb_int0; - e2 = (yyvsp[0]); - x = NULL; - parm1 = (yyvsp[-1]); - if (eval_check[eval_level][eval_inc2] - && eval_check[eval_level][eval_inc2] != cb_false) { - /* Check if the first token is NOT */ - /* It may belong to the EVALUATE, however see */ - /* below when it may be part of a partial expression */ - if (CB_PURPOSE_INT (parm1) == '!') { - /* Pop stack if subject not TRUE / FALSE */ - not0 = cb_int1; - x = parm1; - parm1 = CB_CHAIN (parm1); - } - /* Partial expression handling */ - switch (CB_PURPOSE_INT (parm1)) { - /* Relational conditions */ - case '<': - case '>': - case '[': - case ']': - case '~': - case '=': - /* Class conditions */ - case '9': - case 'A': - case 'L': - case 'U': - case 'P': - case 'N': - case 'O': - case 'C': - if (e2) { - cb_error_x (e2, _("invalid THROUGH usage")); - e2 = NULL; - } - not0 = CB_PURPOSE (parm1); - if (x) { - /* Rebind the NOT to the partial expression */ - parm1 = cb_build_list (cb_int ('!'), NULL, parm1); - } - /* Insert subject at head of list */ - parm1 = cb_build_list (cb_int ('x'), - eval_check[eval_level][eval_inc2], parm1); - break; - } - } - - /* Build expr now */ - e1 = cb_build_expr (parm1); - - eval_inc2++; - (yyval) = CB_BUILD_PAIR (not0, CB_BUILD_PAIR (e1, e2)); - - if (eval_check[eval_level][eval_inc2-1] == cb_false) { - /* It was EVALUATE FALSE; So flip condition */ - if (e1 == cb_true) - e1 = cb_false; - else if (e1 == cb_false) - e1 = cb_true; - } - cb_terminate_cond (); - cb_end_cond (e1); - cb_save_cond (); - cb_true_side (); - } -#line 22355 "parser.c" /* yacc.c:1646 */ - break; - - case 1866: -#line 12654 "parser.y" /* yacc.c:1646 */ - { (yyval) = cb_any; eval_inc2++; } -#line 22361 "parser.c" /* yacc.c:1646 */ - break; - - case 1867: -#line 12655 "parser.y" /* yacc.c:1646 */ - { (yyval) = cb_true; eval_inc2++; } -#line 22367 "parser.c" /* yacc.c:1646 */ - break; - - case 1868: -#line 12656 "parser.y" /* yacc.c:1646 */ - { (yyval) = cb_false; eval_inc2++; } -#line 22373 "parser.c" /* yacc.c:1646 */ - break; - - case 1869: -#line 12657 "parser.y" /* yacc.c:1646 */ - { (yyval) = cb_error_node; eval_inc2++; } -#line 22379 "parser.c" /* yacc.c:1646 */ - break; - - case 1870: -#line 12661 "parser.y" /* yacc.c:1646 */ - { (yyval) = NULL; } -#line 22385 "parser.c" /* yacc.c:1646 */ - break; - - case 1871: -#line 12662 "parser.y" /* yacc.c:1646 */ - { (yyval) = (yyvsp[0]); } -#line 22391 "parser.c" /* yacc.c:1646 */ - break; - - case 1872: -#line 12667 "parser.y" /* yacc.c:1646 */ - { - TERMINATOR_WARNING ((yyvsp[(-2) - (0)]), EVALUATE); - } -#line 22399 "parser.c" /* yacc.c:1646 */ - break; - - case 1873: -#line 12671 "parser.y" /* yacc.c:1646 */ - { - TERMINATOR_CLEAR ((yyvsp[(-2) - (1)]), EVALUATE); - } -#line 22407 "parser.c" /* yacc.c:1646 */ - break; - - case 1874: -#line 12681 "parser.y" /* yacc.c:1646 */ - { - begin_statement ("EXIT", 0); - cobc_cs_check = CB_CS_EXIT; - } -#line 22416 "parser.c" /* yacc.c:1646 */ - break; - - case 1875: -#line 12686 "parser.y" /* yacc.c:1646 */ - { - cobc_cs_check = 0; - } -#line 22424 "parser.c" /* yacc.c:1646 */ - break; - - case 1876: -#line 12693 "parser.y" /* yacc.c:1646 */ - { - /* TODO: add warning/error if there's another statement in the paragraph */ - } -#line 22432 "parser.c" /* yacc.c:1646 */ - break; - - case 1877: -#line 12697 "parser.y" /* yacc.c:1646 */ - { - if (in_declaratives && use_global_ind) { - cb_error_x (CB_TREE (current_statement), - _("EXIT PROGRAM is not allowed within a USE GLOBAL procedure")); - } - if (current_program->prog_type != COB_MODULE_TYPE_PROGRAM) { - cb_error_x (CB_TREE (current_statement), - _("EXIT PROGRAM not allowed within a FUNCTION")); - } - if (current_program->flag_main) { - check_unreached = 0; - } else { - check_unreached = 1; - } - if ((yyvsp[0])) { - if (!current_program->cb_return_code) { - cb_error_x ((yyvsp[0]), _("RETURNING/GIVING not allowed for non-returning runtime elements")); - } else { - cb_emit_move ((yyvsp[0]), CB_LIST_INIT (current_program->cb_return_code)); - } - } - current_statement->name = (const char *)"EXIT PROGRAM"; - cb_emit_exit (0); - } -#line 22461 "parser.c" /* yacc.c:1646 */ - break; - - case 1878: -#line 12722 "parser.y" /* yacc.c:1646 */ - { - if (in_declaratives && use_global_ind) { - cb_error_x (CB_TREE (current_statement), - _("EXIT FUNCTION is not allowed within a USE GLOBAL procedure")); - } - if (current_program->prog_type != COB_MODULE_TYPE_FUNCTION) { - cb_error_x (CB_TREE (current_statement), - _("EXIT FUNCTION only allowed within a FUNCTION")); - } - check_unreached = 1; - current_statement->name = (const char *)"EXIT FUNCTION"; - cb_emit_exit (0); - } -#line 22479 "parser.c" /* yacc.c:1646 */ - break; - - case 1879: -#line 12736 "parser.y" /* yacc.c:1646 */ - { - struct cb_perform *p; - cb_tree plabel; - char name[64]; - - if (!perform_stack) { - cb_error_x (CB_TREE (current_statement), - _("EXIT PERFORM is only valid with inline PERFORM")); - } else if (CB_VALUE (perform_stack) != cb_error_node) { - p = CB_PERFORM (CB_VALUE (perform_stack)); - if (!p->cycle_label) { - sprintf (name, "EXIT PERFORM CYCLE %d", cb_id); - p->cycle_label = cb_build_reference (name); - plabel = cb_build_label (p->cycle_label, NULL); - CB_LABEL (plabel)->flag_begin = 1; - CB_LABEL (plabel)->flag_dummy_exit = 1; - } - current_statement->name = (const char *)"EXIT PERFORM CYCLE"; - cb_emit_goto (CB_LIST_INIT (p->cycle_label), NULL); - check_unreached = 1; - } - } -#line 22506 "parser.c" /* yacc.c:1646 */ - break; - - case 1880: -#line 12759 "parser.y" /* yacc.c:1646 */ - { - struct cb_perform *p; - cb_tree plabel; - char name[64]; - - if (!perform_stack) { - cb_error_x (CB_TREE (current_statement), - _("EXIT PERFORM is only valid with inline PERFORM")); - } else if (CB_VALUE (perform_stack) != cb_error_node) { - p = CB_PERFORM (CB_VALUE (perform_stack)); - if (!p->exit_label) { - sprintf (name, "EXIT PERFORM %d", cb_id); - p->exit_label = cb_build_reference (name); - plabel = cb_build_label (p->exit_label, NULL); - CB_LABEL (plabel)->flag_begin = 1; - CB_LABEL (plabel)->flag_dummy_exit = 1; - } - current_statement->name = (const char *)"EXIT PERFORM"; - cb_emit_goto (CB_LIST_INIT (p->exit_label), NULL); - check_unreached = 1; - } - } -#line 22533 "parser.c" /* yacc.c:1646 */ - break; - - case 1881: -#line 12782 "parser.y" /* yacc.c:1646 */ - { - cb_tree plabel; - char name[64]; - - if (!current_section) { - cb_error_x (CB_TREE (current_statement), - _("EXIT SECTION is only valid with an active SECTION")); - } else { - if (!current_section->exit_label) { - sprintf (name, "EXIT SECTION %d", cb_id); - current_section->exit_label = cb_build_reference (name); - plabel = cb_build_label (current_section->exit_label, NULL); - CB_LABEL (plabel)->flag_begin = 1; - CB_LABEL (plabel)->flag_dummy_exit = 1; - } - current_statement->name = (const char *)"EXIT SECTION"; - cb_emit_goto (CB_LIST_INIT (current_section->exit_label), NULL); - check_unreached = 1; - } - } -#line 22558 "parser.c" /* yacc.c:1646 */ - break; - - case 1882: -#line 12803 "parser.y" /* yacc.c:1646 */ - { - cb_tree plabel; - char name[64]; - - if (!current_paragraph) { - cb_error_x (CB_TREE (current_statement), - _("EXIT PARAGRAPH is only valid with an active PARAGRAPH")); - } else { - if (!current_paragraph->exit_label) { - sprintf (name, "EXIT PARAGRAPH %d", cb_id); - current_paragraph->exit_label = cb_build_reference (name); - plabel = cb_build_label (current_paragraph->exit_label, NULL); - CB_LABEL (plabel)->flag_begin = 1; - CB_LABEL (plabel)->flag_dummy_exit = 1; - } - current_statement->name = (const char *)"EXIT PARAGRAPH"; - cb_emit_goto (CB_LIST_INIT (current_paragraph->exit_label), NULL); - check_unreached = 1; - } - } -#line 22583 "parser.c" /* yacc.c:1646 */ - break; - - case 1883: -#line 12826 "parser.y" /* yacc.c:1646 */ - { (yyval) = NULL; } -#line 22589 "parser.c" /* yacc.c:1646 */ - break; - - case 1884: -#line 12829 "parser.y" /* yacc.c:1646 */ - { (yyval) = (yyvsp[0]); } -#line 22595 "parser.c" /* yacc.c:1646 */ - break; - - case 1885: -#line 12837 "parser.y" /* yacc.c:1646 */ - { - begin_statement ("FREE", 0); - current_statement->flag_no_based = 1; - } -#line 22604 "parser.c" /* yacc.c:1646 */ - break; - - case 1887: -#line 12846 "parser.y" /* yacc.c:1646 */ - { - cb_emit_free ((yyvsp[0])); - } -#line 22612 "parser.c" /* yacc.c:1646 */ - break; - - case 1888: -#line 12856 "parser.y" /* yacc.c:1646 */ - { - begin_statement ("GENERATE", 0); - } -#line 22620 "parser.c" /* yacc.c:1646 */ - break; - - case 1890: -#line 12865 "parser.y" /* yacc.c:1646 */ - { - begin_implicit_statement (); - if ((yyvsp[0]) != cb_error_node) { - cb_emit_generate ((yyvsp[0])); - } - } -#line 22631 "parser.c" /* yacc.c:1646 */ - break; - - case 1891: -#line 12877 "parser.y" /* yacc.c:1646 */ - { - if (!current_paragraph->flag_statement) { - current_paragraph->flag_first_is_goto = 1; - } - begin_statement ("GO TO", 0); - save_debug = start_debug; - start_debug = 0; - } -#line 22644 "parser.c" /* yacc.c:1646 */ - break; - - case 1893: -#line 12890 "parser.y" /* yacc.c:1646 */ - { - cb_emit_goto ((yyvsp[-1]), (yyvsp[0])); - start_debug = save_debug; - } -#line 22653 "parser.c" /* yacc.c:1646 */ - break; - - case 1894: -#line 12895 "parser.y" /* yacc.c:1646 */ - { - if (cb_verify (cb_goto_entry, "ENTRY FOR GO TO")) { - cb_emit_goto_entry ((yyvsp[-1]), (yyvsp[0])); - } - start_debug = save_debug; - } -#line 22664 "parser.c" /* yacc.c:1646 */ - break; - - case 1895: -#line 12905 "parser.y" /* yacc.c:1646 */ - { - check_unreached = 1; - (yyval) = NULL; - } -#line 22673 "parser.c" /* yacc.c:1646 */ - break; - - case 1896: -#line 12910 "parser.y" /* yacc.c:1646 */ - { - check_unreached = 0; - (yyval) = (yyvsp[0]); - } -#line 22682 "parser.c" /* yacc.c:1646 */ - break; - - case 1897: -#line 12921 "parser.y" /* yacc.c:1646 */ - { - begin_statement ("GOBACK", 0); - check_unreached = 1; - if ((yyvsp[0])) { - if (!current_program->cb_return_code) { - cb_error_x ((yyvsp[0]), _("RETURNING/GIVING not allowed for non-returning runtime elements")); - } else { - cb_emit_move ((yyvsp[0]), CB_LIST_INIT (current_program->cb_return_code)); - } - } - cb_emit_exit (1U); - } -#line 22699 "parser.c" /* yacc.c:1646 */ - break; - - case 1898: -#line 12940 "parser.y" /* yacc.c:1646 */ - { - begin_statement ("IF", TERM_IF); - } -#line 22707 "parser.c" /* yacc.c:1646 */ - break; - - case 1900: -#line 12949 "parser.y" /* yacc.c:1646 */ - { - cb_emit_if ((yyvsp[(-1) - (5)]), (yyvsp[-3]), (yyvsp[0])); - } -#line 22715 "parser.c" /* yacc.c:1646 */ - break; - - case 1901: -#line 12953 "parser.y" /* yacc.c:1646 */ - { - cb_emit_if ((yyvsp[(-1) - (3)]), NULL, (yyvsp[0])); - cb_verify (cb_missing_statement, - _("IF without imperative statement")); - } -#line 22725 "parser.c" /* yacc.c:1646 */ - break; - - case 1902: -#line 12959 "parser.y" /* yacc.c:1646 */ - { - cb_emit_if ((yyvsp[(-1) - (2)]), (yyvsp[0]), NULL); - } -#line 22733 "parser.c" /* yacc.c:1646 */ - break; - - case 1903: -#line 12965 "parser.y" /* yacc.c:1646 */ - { - cb_save_cond (); - } -#line 22741 "parser.c" /* yacc.c:1646 */ - break; - - case 1904: -#line 12969 "parser.y" /* yacc.c:1646 */ - { - cb_save_cond (); - } -#line 22749 "parser.c" /* yacc.c:1646 */ - break; - - case 1905: -#line 12975 "parser.y" /* yacc.c:1646 */ - { - cb_true_side (); - } -#line 22757 "parser.c" /* yacc.c:1646 */ - break; - - case 1906: -#line 12981 "parser.y" /* yacc.c:1646 */ - { - cb_false_side (); - } -#line 22765 "parser.c" /* yacc.c:1646 */ - break; - - case 1907: -#line 12988 "parser.y" /* yacc.c:1646 */ - { - TERMINATOR_WARNING ((yyvsp[(-4) - (0)]), IF); - cb_terminate_cond (); - } -#line 22774 "parser.c" /* yacc.c:1646 */ - break; - - case 1908: -#line 12993 "parser.y" /* yacc.c:1646 */ - { - TERMINATOR_CLEAR ((yyvsp[(-4) - (1)]), IF); - cb_terminate_cond (); - } -#line 22783 "parser.c" /* yacc.c:1646 */ - break; - - case 1909: -#line 13004 "parser.y" /* yacc.c:1646 */ - { - begin_statement ("INITIALIZE", 0); - } -#line 22791 "parser.c" /* yacc.c:1646 */ - break; - - case 1911: -#line 13013 "parser.y" /* yacc.c:1646 */ - { - cb_emit_initialize ((yyvsp[-4]), (yyvsp[-3]), (yyvsp[-2]), (yyvsp[-1]), (yyvsp[0])); - } -#line 22799 "parser.c" /* yacc.c:1646 */ - break; - - case 1912: -#line 13019 "parser.y" /* yacc.c:1646 */ - { (yyval) = NULL; } -#line 22805 "parser.c" /* yacc.c:1646 */ - break; - - case 1913: -#line 13020 "parser.y" /* yacc.c:1646 */ - { (yyval) = cb_true; } -#line 22811 "parser.c" /* yacc.c:1646 */ - break; - - case 1914: -#line 13024 "parser.y" /* yacc.c:1646 */ - { (yyval) = NULL; } -#line 22817 "parser.c" /* yacc.c:1646 */ - break; - - case 1915: -#line 13025 "parser.y" /* yacc.c:1646 */ - { (yyval) = cb_true; } -#line 22823 "parser.c" /* yacc.c:1646 */ - break; - - case 1916: -#line 13026 "parser.y" /* yacc.c:1646 */ - { (yyval) = (yyvsp[-2]); } -#line 22829 "parser.c" /* yacc.c:1646 */ - break; - - case 1917: -#line 13031 "parser.y" /* yacc.c:1646 */ - { - (yyval) = NULL; - } -#line 22837 "parser.c" /* yacc.c:1646 */ - break; - - case 1918: -#line 13035 "parser.y" /* yacc.c:1646 */ - { - (yyval) = (yyvsp[0]); - } -#line 22845 "parser.c" /* yacc.c:1646 */ - break; - - case 1919: -#line 13042 "parser.y" /* yacc.c:1646 */ - { - (yyval) = (yyvsp[0]); - } -#line 22853 "parser.c" /* yacc.c:1646 */ - break; - - case 1920: -#line 13047 "parser.y" /* yacc.c:1646 */ - { - (yyval) = cb_list_append ((yyvsp[-1]), (yyvsp[0])); - } -#line 22861 "parser.c" /* yacc.c:1646 */ - break; - - case 1921: -#line 13054 "parser.y" /* yacc.c:1646 */ - { - (yyval) = CB_BUILD_PAIR ((yyvsp[-3]), (yyvsp[0])); - } -#line 22869 "parser.c" /* yacc.c:1646 */ - break; - - case 1922: -#line 13060 "parser.y" /* yacc.c:1646 */ - { (yyval) = cb_int (CB_CATEGORY_ALPHABETIC); } -#line 22875 "parser.c" /* yacc.c:1646 */ - break; - - case 1923: -#line 13061 "parser.y" /* yacc.c:1646 */ - { (yyval) = cb_int (CB_CATEGORY_ALPHANUMERIC); } -#line 22881 "parser.c" /* yacc.c:1646 */ - break; - - case 1924: -#line 13062 "parser.y" /* yacc.c:1646 */ - { (yyval) = cb_int (CB_CATEGORY_NUMERIC); } -#line 22887 "parser.c" /* yacc.c:1646 */ - break; - - case 1925: -#line 13063 "parser.y" /* yacc.c:1646 */ - { (yyval) = cb_int (CB_CATEGORY_ALPHANUMERIC_EDITED); } -#line 22893 "parser.c" /* yacc.c:1646 */ - break; - - case 1926: -#line 13064 "parser.y" /* yacc.c:1646 */ - { (yyval) = cb_int (CB_CATEGORY_NUMERIC_EDITED); } -#line 22899 "parser.c" /* yacc.c:1646 */ - break; - - case 1927: -#line 13065 "parser.y" /* yacc.c:1646 */ - { (yyval) = cb_int (CB_CATEGORY_NATIONAL); } -#line 22905 "parser.c" /* yacc.c:1646 */ - break; - - case 1928: -#line 13066 "parser.y" /* yacc.c:1646 */ - { (yyval) = cb_int (CB_CATEGORY_NATIONAL_EDITED); } -#line 22911 "parser.c" /* yacc.c:1646 */ - break; - - case 1929: -#line 13078 "parser.y" /* yacc.c:1646 */ - { - (yyval) = NULL; - } -#line 22919 "parser.c" /* yacc.c:1646 */ - break; - - case 1930: -#line 13082 "parser.y" /* yacc.c:1646 */ - { - (yyval) = cb_true; - } -#line 22927 "parser.c" /* yacc.c:1646 */ - break; - - case 1931: -#line 13091 "parser.y" /* yacc.c:1646 */ - { - begin_statement ("INITIATE", 0); - } -#line 22935 "parser.c" /* yacc.c:1646 */ - break; - - case 1933: -#line 13099 "parser.y" /* yacc.c:1646 */ - { - begin_implicit_statement (); - if ((yyvsp[0]) != cb_error_node) { - cb_emit_initiate ((yyvsp[0])); - } - } -#line 22946 "parser.c" /* yacc.c:1646 */ - break; - - case 1934: -#line 13106 "parser.y" /* yacc.c:1646 */ - { - begin_implicit_statement (); - if ((yyvsp[0]) != cb_error_node) { - cb_emit_initiate ((yyvsp[0])); - } - } -#line 22957 "parser.c" /* yacc.c:1646 */ - break; - - case 1935: -#line 13118 "parser.y" /* yacc.c:1646 */ - { - begin_statement ("INQUIRE", 0); - cobc_cs_check = CB_CS_INQUIRE_MODIFY; - } -#line 22966 "parser.c" /* yacc.c:1646 */ - break; - - case 1936: -#line 13123 "parser.y" /* yacc.c:1646 */ - { - cobc_cs_check = 0; - } -#line 22974 "parser.c" /* yacc.c:1646 */ - break; - - case 1939: -#line 13137 "parser.y" /* yacc.c:1646 */ - { - begin_statement ("INSPECT", 0); - inspect_keyword = 0; - } -#line 22983 "parser.c" /* yacc.c:1646 */ - break; - - case 1949: -#line 13165 "parser.y" /* yacc.c:1646 */ - { - previous_tallying_phrase = NO_PHRASE; - cb_init_tallying (); - } -#line 22992 "parser.c" /* yacc.c:1646 */ - break; - - case 1950: -#line 13170 "parser.y" /* yacc.c:1646 */ - { - if (!(previous_tallying_phrase == CHARACTERS_PHRASE - || previous_tallying_phrase == VALUE_REGION_PHRASE)) { - cb_error (_("TALLYING clause is incomplete")); - } else { - cb_emit_inspect ((yyvsp[-3]), (yyvsp[0]), TALLYING_CLAUSE); - } - - (yyval) = (yyvsp[-3]); - } -#line 23007 "parser.c" /* yacc.c:1646 */ - break; - - case 1951: -#line 13186 "parser.y" /* yacc.c:1646 */ - { - cb_emit_inspect ((yyvsp[-2]), (yyvsp[0]), REPLACING_CLAUSE); - inspect_keyword = 0; - } -#line 23016 "parser.c" /* yacc.c:1646 */ - break; - - case 1952: -#line 13196 "parser.y" /* yacc.c:1646 */ - { - cb_tree x = cb_build_converting ((yyvsp[-3]), (yyvsp[-1]), (yyvsp[0])); - cb_emit_inspect ((yyvsp[-5]), x, CONVERTING_CLAUSE); - } -#line 23025 "parser.c" /* yacc.c:1646 */ - break; - - case 1953: -#line 13204 "parser.y" /* yacc.c:1646 */ - { - (yyval) = (yyvsp[0]); - } -#line 23033 "parser.c" /* yacc.c:1646 */ - break; - - case 1954: -#line 13208 "parser.y" /* yacc.c:1646 */ - { - (yyval) = cb_list_append ((yyvsp[-1]), (yyvsp[0])); - } -#line 23041 "parser.c" /* yacc.c:1646 */ - break; - - case 1955: -#line 13215 "parser.y" /* yacc.c:1646 */ - { - check_preceding_tallying_phrases (FOR_PHRASE); - (yyval) = cb_build_tallying_data ((yyvsp[-1])); - } -#line 23050 "parser.c" /* yacc.c:1646 */ - break; - - case 1956: -#line 13220 "parser.y" /* yacc.c:1646 */ - { - check_preceding_tallying_phrases (CHARACTERS_PHRASE); - (yyval) = cb_build_tallying_characters ((yyvsp[0])); - } -#line 23059 "parser.c" /* yacc.c:1646 */ - break; - - case 1957: -#line 13225 "parser.y" /* yacc.c:1646 */ - { - check_preceding_tallying_phrases (ALL_LEADING_TRAILING_PHRASES); - (yyval) = cb_build_tallying_all (); - } -#line 23068 "parser.c" /* yacc.c:1646 */ - break; - - case 1958: -#line 13230 "parser.y" /* yacc.c:1646 */ - { - check_preceding_tallying_phrases (ALL_LEADING_TRAILING_PHRASES); - (yyval) = cb_build_tallying_leading (); - } -#line 23077 "parser.c" /* yacc.c:1646 */ - break; - - case 1959: -#line 13235 "parser.y" /* yacc.c:1646 */ - { - check_preceding_tallying_phrases (ALL_LEADING_TRAILING_PHRASES); - (yyval) = cb_build_tallying_trailing (); - } -#line 23086 "parser.c" /* yacc.c:1646 */ - break; - - case 1960: -#line 13240 "parser.y" /* yacc.c:1646 */ - { - check_preceding_tallying_phrases (VALUE_REGION_PHRASE); - (yyval) = cb_build_tallying_value ((yyvsp[-1]), (yyvsp[0])); - } -#line 23095 "parser.c" /* yacc.c:1646 */ - break; - - case 1961: -#line 13247 "parser.y" /* yacc.c:1646 */ - { (yyval) = (yyvsp[0]); } -#line 23101 "parser.c" /* yacc.c:1646 */ - break; - - case 1962: -#line 13248 "parser.y" /* yacc.c:1646 */ - { (yyval) = cb_list_append ((yyvsp[-1]), (yyvsp[0])); } -#line 23107 "parser.c" /* yacc.c:1646 */ - break; - - case 1963: -#line 13253 "parser.y" /* yacc.c:1646 */ - { - (yyval) = cb_build_replacing_characters ((yyvsp[-1]), (yyvsp[0])); - inspect_keyword = 0; - } -#line 23116 "parser.c" /* yacc.c:1646 */ - break; - - case 1964: -#line 13258 "parser.y" /* yacc.c:1646 */ - { - (yyval) = (yyvsp[0]); - } -#line 23124 "parser.c" /* yacc.c:1646 */ - break; - - case 1966: -#line 13265 "parser.y" /* yacc.c:1646 */ - { inspect_keyword = 1; } -#line 23130 "parser.c" /* yacc.c:1646 */ - break; - - case 1967: -#line 13266 "parser.y" /* yacc.c:1646 */ - { inspect_keyword = 2; } -#line 23136 "parser.c" /* yacc.c:1646 */ - break; - - case 1968: -#line 13267 "parser.y" /* yacc.c:1646 */ - { inspect_keyword = 3; } -#line 23142 "parser.c" /* yacc.c:1646 */ - break; - - case 1969: -#line 13268 "parser.y" /* yacc.c:1646 */ - { inspect_keyword = 4; } -#line 23148 "parser.c" /* yacc.c:1646 */ - break; - - case 1970: -#line 13273 "parser.y" /* yacc.c:1646 */ - { - switch (inspect_keyword) { - case 1: - (yyval) = cb_build_replacing_all ((yyvsp[-3]), (yyvsp[-1]), (yyvsp[0])); - break; - case 2: - (yyval) = cb_build_replacing_leading ((yyvsp[-3]), (yyvsp[-1]), (yyvsp[0])); - break; - case 3: - (yyval) = cb_build_replacing_first ((yyvsp[-3]), (yyvsp[-1]), (yyvsp[0])); - break; - case 4: - (yyval) = cb_build_replacing_trailing ((yyvsp[-3]), (yyvsp[-1]), (yyvsp[0])); - break; - default: - cb_error_x (CB_TREE (current_statement), - _("INSPECT missing ALL/FIRST/LEADING/TRAILING")); - (yyval) = cb_build_replacing_all ((yyvsp[-3]), (yyvsp[-1]), (yyvsp[0])); - break; - } - } -#line 23174 "parser.c" /* yacc.c:1646 */ - break; - - case 1971: -#line 13300 "parser.y" /* yacc.c:1646 */ - { - (yyval) = cb_build_inspect_region_start (); - } -#line 23182 "parser.c" /* yacc.c:1646 */ - break; - - case 1972: -#line 13304 "parser.y" /* yacc.c:1646 */ - { - (yyval) = cb_list_add (cb_build_inspect_region_start (), (yyvsp[0])); - } -#line 23190 "parser.c" /* yacc.c:1646 */ - break; - - case 1973: -#line 13308 "parser.y" /* yacc.c:1646 */ - { - (yyval) = cb_list_add (cb_build_inspect_region_start (), (yyvsp[0])); - } -#line 23198 "parser.c" /* yacc.c:1646 */ - break; - - case 1974: -#line 13312 "parser.y" /* yacc.c:1646 */ - { - (yyval) = cb_list_add (cb_list_add (cb_build_inspect_region_start (), (yyvsp[-1])), (yyvsp[0])); - } -#line 23206 "parser.c" /* yacc.c:1646 */ - break; - - case 1975: -#line 13316 "parser.y" /* yacc.c:1646 */ - { - (yyval) = cb_list_add (cb_list_add (cb_build_inspect_region_start (), (yyvsp[-1])), (yyvsp[0])); - } -#line 23214 "parser.c" /* yacc.c:1646 */ - break; - - case 1976: -#line 13323 "parser.y" /* yacc.c:1646 */ - { - (yyval) = CB_BUILD_FUNCALL_1 ("cob_inspect_before", (yyvsp[0])); - } -#line 23222 "parser.c" /* yacc.c:1646 */ - break; - - case 1977: -#line 13330 "parser.y" /* yacc.c:1646 */ - { - (yyval) = CB_BUILD_FUNCALL_1 ("cob_inspect_after", (yyvsp[0])); - } -#line 23230 "parser.c" /* yacc.c:1646 */ - break; - - case 1978: -#line 13339 "parser.y" /* yacc.c:1646 */ - { - begin_statement ("JSON GENERATE", TERM_JSON); - cobc_in_json_generate_body = 1; - cobc_cs_check = CB_CS_JSON_GENERATE; - } -#line 23240 "parser.c" /* yacc.c:1646 */ - break; - - case 1980: -#line 13351 "parser.y" /* yacc.c:1646 */ - { - ml_suppress_list = NULL; - } -#line 23248 "parser.c" /* yacc.c:1646 */ - break; - - case 1981: -#line 13356 "parser.y" /* yacc.c:1646 */ - { - cobc_in_json_generate_body = 0; - cobc_cs_check = 0; - } -#line 23257 "parser.c" /* yacc.c:1646 */ - break; - - case 1982: -#line 13361 "parser.y" /* yacc.c:1646 */ - { - cb_emit_json_generate ((yyvsp[-8]), (yyvsp[-6]), (yyvsp[-5]), (yyvsp[-3]), ml_suppress_list); - } -#line 23265 "parser.c" /* yacc.c:1646 */ - break; - - case 1983: -#line 13368 "parser.y" /* yacc.c:1646 */ - { - (yyval) = NULL; - } -#line 23273 "parser.c" /* yacc.c:1646 */ - break; - - case 1984: -#line 13372 "parser.y" /* yacc.c:1646 */ - { - (yyval) = (yyvsp[0]); - } -#line 23281 "parser.c" /* yacc.c:1646 */ - break; - - case 1987: -#line 13384 "parser.y" /* yacc.c:1646 */ - { - error_if_following_every_clause (); - add_identifier_to_ml_suppress_conds ((yyvsp[0])); - } -#line 23290 "parser.c" /* yacc.c:1646 */ - break; - - case 1988: -#line 13392 "parser.y" /* yacc.c:1646 */ - { - TERMINATOR_WARNING ((yyvsp[(-2) - (0)]), JSON); - } -#line 23298 "parser.c" /* yacc.c:1646 */ - break; - - case 1989: -#line 13396 "parser.y" /* yacc.c:1646 */ - { - TERMINATOR_CLEAR ((yyvsp[(-2) - (1)]), JSON); - } -#line 23306 "parser.c" /* yacc.c:1646 */ - break; - - case 1990: -#line 13405 "parser.y" /* yacc.c:1646 */ - { - begin_statement ("JSON PARSE", TERM_JSON); - CB_PENDING (_("JSON PARSE")); - } -#line 23315 "parser.c" /* yacc.c:1646 */ - break; - - case 1995: -#line 13430 "parser.y" /* yacc.c:1646 */ - { - begin_statement ("MERGE", 0); - current_statement->flag_merge = 1; - } -#line 23324 "parser.c" /* yacc.c:1646 */ - break; - - case 1997: -#line 13442 "parser.y" /* yacc.c:1646 */ - { - begin_statement ("MODIFY", TERM_MODIFY); - cobc_cs_check = CB_CS_INQUIRE_MODIFY; - } -#line 23333 "parser.c" /* yacc.c:1646 */ - break; - - case 1998: -#line 13448 "parser.y" /* yacc.c:1646 */ - { - cobc_cs_check = 0; - } -#line 23341 "parser.c" /* yacc.c:1646 */ - break; - - case 2001: -#line 13460 "parser.y" /* yacc.c:1646 */ - { - TERMINATOR_WARNING ((yyvsp[(-2) - (0)]), MODIFY); - } -#line 23349 "parser.c" /* yacc.c:1646 */ - break; - - case 2002: -#line 13464 "parser.y" /* yacc.c:1646 */ - { - TERMINATOR_CLEAR ((yyvsp[(-2) - (1)]), MODIFY); - } -#line 23357 "parser.c" /* yacc.c:1646 */ - break; - - case 2003: -#line 13474 "parser.y" /* yacc.c:1646 */ - { - begin_statement ("MOVE", 0); - } -#line 23365 "parser.c" /* yacc.c:1646 */ - break; - - case 2005: -#line 13482 "parser.y" /* yacc.c:1646 */ - { - cb_emit_move ((yyvsp[-2]), (yyvsp[0])); - } -#line 23373 "parser.c" /* yacc.c:1646 */ - break; - - case 2006: -#line 13486 "parser.y" /* yacc.c:1646 */ - { - cb_emit_move_corresponding ((yyvsp[-2]), (yyvsp[0])); - } -#line 23381 "parser.c" /* yacc.c:1646 */ - break; - - case 2007: -#line 13496 "parser.y" /* yacc.c:1646 */ - { - begin_statement ("MULTIPLY", TERM_MULTIPLY); - } -#line 23389 "parser.c" /* yacc.c:1646 */ - break; - - case 2009: -#line 13505 "parser.y" /* yacc.c:1646 */ - { - cb_emit_arithmetic ((yyvsp[-1]), '*', (yyvsp[-3])); - } -#line 23397 "parser.c" /* yacc.c:1646 */ - break; - - case 2010: -#line 13509 "parser.y" /* yacc.c:1646 */ - { - cb_emit_arithmetic ((yyvsp[-1]), 0, cb_build_binary_op ((yyvsp[-5]), '*', (yyvsp[-3]))); - } -#line 23405 "parser.c" /* yacc.c:1646 */ - break; - - case 2011: -#line 13516 "parser.y" /* yacc.c:1646 */ - { - TERMINATOR_WARNING ((yyvsp[(-2) - (0)]), MULTIPLY); - } -#line 23413 "parser.c" /* yacc.c:1646 */ - break; - - case 2012: -#line 13520 "parser.y" /* yacc.c:1646 */ - { - TERMINATOR_CLEAR ((yyvsp[(-2) - (1)]), MULTIPLY); - } -#line 23421 "parser.c" /* yacc.c:1646 */ - break; - - case 2013: -#line 13530 "parser.y" /* yacc.c:1646 */ - { - begin_statement ("OPEN", 0); - cobc_cs_check = CB_CS_OPEN; - } -#line 23430 "parser.c" /* yacc.c:1646 */ - break; - - case 2017: -#line 13544 "parser.y" /* yacc.c:1646 */ - { - cb_tree l; - cb_tree x; - cb_tree retry; - int retry_times, retry_seconds, retry_forever; - - if (((yyvsp[-5]) && (yyvsp[-3])) || ((yyvsp[-5]) && (yyvsp[0])) || ((yyvsp[-3]) && (yyvsp[0]))) { - cb_error_x (CB_TREE (current_statement), - _("%s and %s are mutually exclusive"), "SHARING", _("LOCK clauses")); - } - if ((yyvsp[0])) { - x = (yyvsp[0]); - } else if ((yyvsp[-3])) { - x = (yyvsp[-3]); - } else { - x = (yyvsp[-5]); - } - retry = current_statement->retry; - retry_times = current_statement->flag_retry_times; - retry_seconds = current_statement->flag_retry_seconds; - retry_forever = current_statement->flag_retry_forever; - - for (l = (yyvsp[-1]); l; l = CB_CHAIN (l)) { - if (CB_VALID_TREE (CB_VALUE (l))) { - begin_implicit_statement (); - current_statement->retry = retry; - current_statement->flag_retry_times = retry_times; - current_statement->flag_retry_seconds = retry_seconds; - current_statement->flag_retry_forever = retry_forever; - cb_emit_open (CB_VALUE (l), (yyvsp[-4]), x); - } - } - } -#line 23468 "parser.c" /* yacc.c:1646 */ - break; - - case 2018: -#line 13581 "parser.y" /* yacc.c:1646 */ - { (yyval) = NULL; } -#line 23474 "parser.c" /* yacc.c:1646 */ - break; - - case 2019: -#line 13582 "parser.y" /* yacc.c:1646 */ - { (yyval) = cb_int (COB_LOCK_OPEN_EXCLUSIVE); } -#line 23480 "parser.c" /* yacc.c:1646 */ - break; - - case 2020: -#line 13586 "parser.y" /* yacc.c:1646 */ - { (yyval) = cb_int (COB_OPEN_INPUT); } -#line 23486 "parser.c" /* yacc.c:1646 */ - break; - - case 2021: -#line 13587 "parser.y" /* yacc.c:1646 */ - { (yyval) = cb_int (COB_OPEN_OUTPUT); } -#line 23492 "parser.c" /* yacc.c:1646 */ - break; - - case 2022: -#line 13588 "parser.y" /* yacc.c:1646 */ - { (yyval) = cb_int (COB_OPEN_I_O); } -#line 23498 "parser.c" /* yacc.c:1646 */ - break; - - case 2023: -#line 13589 "parser.y" /* yacc.c:1646 */ - { (yyval) = cb_int (COB_OPEN_EXTEND); } -#line 23504 "parser.c" /* yacc.c:1646 */ - break; - - case 2024: -#line 13593 "parser.y" /* yacc.c:1646 */ - { (yyval) = NULL; } -#line 23510 "parser.c" /* yacc.c:1646 */ - break; - - case 2025: -#line 13594 "parser.y" /* yacc.c:1646 */ - { (yyval) = (yyvsp[0]); } -#line 23516 "parser.c" /* yacc.c:1646 */ - break; - - case 2026: -#line 13598 "parser.y" /* yacc.c:1646 */ - { (yyval) = NULL; } -#line 23522 "parser.c" /* yacc.c:1646 */ - break; - - case 2027: -#line 13599 "parser.y" /* yacc.c:1646 */ - { (yyval) = (yyvsp[0]); } -#line 23528 "parser.c" /* yacc.c:1646 */ - break; - - case 2028: -#line 13600 "parser.y" /* yacc.c:1646 */ - { (yyval) = NULL; } -#line 23534 "parser.c" /* yacc.c:1646 */ - break; - - case 2029: -#line 13604 "parser.y" /* yacc.c:1646 */ - { (yyval) = (yyvsp[-1]); } -#line 23540 "parser.c" /* yacc.c:1646 */ - break; - - case 2030: -#line 13606 "parser.y" /* yacc.c:1646 */ - { - (void)cb_verify (CB_OBSOLETE, "OPEN LEAVE/REREAD/DISP"); - (yyval) = NULL; - } -#line 23549 "parser.c" /* yacc.c:1646 */ - break; - - case 2031: -#line 13613 "parser.y" /* yacc.c:1646 */ - { (yyval) = (yyvsp[0]); } -#line 23555 "parser.c" /* yacc.c:1646 */ - break; - - case 2032: -#line 13614 "parser.y" /* yacc.c:1646 */ - { (yyval) = (yyvsp[0]); } -#line 23561 "parser.c" /* yacc.c:1646 */ - break; - - case 2033: -#line 13618 "parser.y" /* yacc.c:1646 */ - { (yyval) = cb_int (COB_LOCK_OPEN_EXCLUSIVE); } -#line 23567 "parser.c" /* yacc.c:1646 */ - break; - - case 2034: -#line 13620 "parser.y" /* yacc.c:1646 */ - { - (yyval) = cb_int (COB_LOCK_OPEN_EXCLUSIVE); - /* TODO: check for indexed; pass extra flag to fileio */ - CB_PENDING ("WITH MASS-UPDATE"); - } -#line 23577 "parser.c" /* yacc.c:1646 */ - break; - - case 2035: -#line 13626 "parser.y" /* yacc.c:1646 */ - { - (yyval) = cb_int (COB_LOCK_OPEN_EXCLUSIVE); - /* TODO: check for indexed; pass extra flag to fileio */ - CB_PENDING ("WITH BULK-ADDITION"); - } -#line 23587 "parser.c" /* yacc.c:1646 */ - break; - - case 2036: -#line 13634 "parser.y" /* yacc.c:1646 */ - { (yyval) = cb_int (COB_LOCK_OPEN_EXCLUSIVE); } -#line 23593 "parser.c" /* yacc.c:1646 */ - break; - - case 2037: -#line 13635 "parser.y" /* yacc.c:1646 */ - { (yyval) = NULL; } -#line 23599 "parser.c" /* yacc.c:1646 */ - break; - - case 2038: -#line 13636 "parser.y" /* yacc.c:1646 */ - { (yyval) = NULL; } -#line 23605 "parser.c" /* yacc.c:1646 */ - break; - - case 2042: -#line 13648 "parser.y" /* yacc.c:1646 */ - { - /* FIXME: only allow for sequential files */ - /* FIXME: only allow with INPUT or OUTPUT */ - CB_PENDING ("OPEN WITH NO REWIND"); - (yyval) = NULL; - } -#line 23616 "parser.c" /* yacc.c:1646 */ - break; - - case 2043: -#line 13655 "parser.y" /* yacc.c:1646 */ - { - /* FIXME: only allow for sequential / line-sequential files */ - /* FIXME: only allow with INPUT */ - /* FIXME: add actual compiler configuration */ - if (cb_warn_obsolete == COBC_WARN_AS_ERROR) { - (void)cb_verify (CB_OBSOLETE, "OPEN REVERSED"); - } else { - /* FIXME: set file attribute */ - CB_PENDING ("OPEN REVERSED"); - }; - (yyval) = NULL; - } -#line 23633 "parser.c" /* yacc.c:1646 */ - break; - - case 2047: -#line 13678 "parser.y" /* yacc.c:1646 */ - { - begin_statement ("PERFORM", TERM_PERFORM); - /* Turn off field debug - PERFORM is special */ - save_debug = start_debug; - start_debug = 0; - cobc_cs_check = CB_CS_PERFORM; - } -#line 23645 "parser.c" /* yacc.c:1646 */ - break; - - case 2049: -#line 13693 "parser.y" /* yacc.c:1646 */ - { - cb_emit_perform ((yyvsp[0]), (yyvsp[-2]), (yyvsp[-3]), (yyvsp[-1])); - start_debug = save_debug; - cobc_cs_check = 0; - } -#line 23655 "parser.c" /* yacc.c:1646 */ - break; - - case 2050: -#line 13701 "parser.y" /* yacc.c:1646 */ - { - CB_ADD_TO_CHAIN ((yyvsp[-1]), perform_stack); - /* Restore field debug before inline statements */ - start_debug = save_debug; - cobc_cs_check = 0; - } -#line 23666 "parser.c" /* yacc.c:1646 */ - break; - - case 2051: -#line 13708 "parser.y" /* yacc.c:1646 */ - { - perform_stack = CB_CHAIN (perform_stack); - cb_emit_perform ((yyvsp[-4]), (yyvsp[-1]), (yyvsp[-5]), (yyvsp[-3])); - } -#line 23675 "parser.c" /* yacc.c:1646 */ - break; - - case 2052: -#line 13715 "parser.y" /* yacc.c:1646 */ - { - cb_verify (cb_missing_statement, - _("inline PERFORM without imperative statement")); - } -#line 23684 "parser.c" /* yacc.c:1646 */ - break; - - case 2053: -#line 13720 "parser.y" /* yacc.c:1646 */ - { - cb_emit_perform ((yyvsp[-3]), NULL, (yyvsp[-4]), (yyvsp[-2])); - start_debug = save_debug; - cobc_cs_check = 0; - } -#line 23694 "parser.c" /* yacc.c:1646 */ - break; - - case 2054: -#line 13729 "parser.y" /* yacc.c:1646 */ - { - if (cb_relaxed_syntax_checks) { - TERMINATOR_WARNING ((yyvsp[(-6) - (0)]), PERFORM); - } else { - TERMINATOR_ERROR ((yyvsp[(-6) - (0)]), PERFORM); - } - } -#line 23706 "parser.c" /* yacc.c:1646 */ - break; - - case 2055: -#line 13737 "parser.y" /* yacc.c:1646 */ - { - TERMINATOR_CLEAR ((yyvsp[(-6) - (1)]), PERFORM); - } -#line 23714 "parser.c" /* yacc.c:1646 */ - break; - - case 2056: -#line 13744 "parser.y" /* yacc.c:1646 */ - { - TERMINATOR_CLEAR ((yyvsp[(-3) - (1)]), PERFORM); - } -#line 23722 "parser.c" /* yacc.c:1646 */ - break; - - case 2057: -#line 13748 "parser.y" /* yacc.c:1646 */ - { - if (cb_relaxed_syntax_checks) { - TERMINATOR_WARNING ((yyvsp[(-3) - (1)]), PERFORM); - } else { - TERMINATOR_ERROR ((yyvsp[(-3) - (1)]), PERFORM); - } - /* Put the dot token back into the stack for reparse */ - cb_unput_dot (); - } -#line 23736 "parser.c" /* yacc.c:1646 */ - break; - - case 2058: -#line 13761 "parser.y" /* yacc.c:1646 */ - { - /* Return from $1 */ - CB_REFERENCE ((yyvsp[0]))->length = cb_true; - CB_REFERENCE ((yyvsp[0]))->flag_decl_ok = 1; - (yyval) = CB_BUILD_PAIR ((yyvsp[0]), (yyvsp[0])); - } -#line 23747 "parser.c" /* yacc.c:1646 */ - break; - - case 2059: -#line 13768 "parser.y" /* yacc.c:1646 */ - { - /* Return from $3 */ - CB_REFERENCE ((yyvsp[0]))->length = cb_true; - CB_REFERENCE ((yyvsp[-2]))->flag_decl_ok = 1; - CB_REFERENCE ((yyvsp[0]))->flag_decl_ok = 1; - (yyval) = CB_BUILD_PAIR ((yyvsp[-2]), (yyvsp[0])); - } -#line 23759 "parser.c" /* yacc.c:1646 */ - break; - - case 2060: -#line 13779 "parser.y" /* yacc.c:1646 */ - { - (yyval) = cb_build_perform_once (NULL); - } -#line 23767 "parser.c" /* yacc.c:1646 */ - break; - - case 2061: -#line 13783 "parser.y" /* yacc.c:1646 */ - { - (yyval) = cb_build_perform_times ((yyvsp[-1])); - current_program->loop_counter++; - } -#line 23776 "parser.c" /* yacc.c:1646 */ - break; - - case 2062: -#line 13788 "parser.y" /* yacc.c:1646 */ - { - (yyval) = cb_build_perform_forever (NULL); - } -#line 23784 "parser.c" /* yacc.c:1646 */ - break; - - case 2063: -#line 13792 "parser.y" /* yacc.c:1646 */ - { - cb_tree varying; - - if (!(yyvsp[0])) { - (yyval) = cb_build_perform_forever (NULL); - } else { - if ((yyvsp[-2]) == CB_AFTER) - cb_build_perform_after_until(); - varying = CB_LIST_INIT (cb_build_perform_varying (NULL, NULL, NULL, (yyvsp[0]))); - (yyval) = cb_build_perform_until ((yyvsp[-2]), varying); - } - } -#line 23801 "parser.c" /* yacc.c:1646 */ - break; - - case 2064: -#line 13805 "parser.y" /* yacc.c:1646 */ - { - (yyval) = cb_build_perform_until ((yyvsp[-2]), (yyvsp[0])); - } -#line 23809 "parser.c" /* yacc.c:1646 */ - break; - - case 2065: -#line 13811 "parser.y" /* yacc.c:1646 */ - { (yyval) = CB_BEFORE; } -#line 23815 "parser.c" /* yacc.c:1646 */ - break; - - case 2066: -#line 13812 "parser.y" /* yacc.c:1646 */ - { (yyval) = (yyvsp[0]); } -#line 23821 "parser.c" /* yacc.c:1646 */ - break; - - case 2067: -#line 13816 "parser.y" /* yacc.c:1646 */ - { (yyval) = NULL; } -#line 23827 "parser.c" /* yacc.c:1646 */ - break; - - case 2068: -#line 13817 "parser.y" /* yacc.c:1646 */ - { (yyval) = (yyvsp[0]); } -#line 23833 "parser.c" /* yacc.c:1646 */ - break; - - case 2069: -#line 13820 "parser.y" /* yacc.c:1646 */ - { (yyval) = CB_LIST_INIT ((yyvsp[0])); } -#line 23839 "parser.c" /* yacc.c:1646 */ - break; - - case 2070: -#line 13822 "parser.y" /* yacc.c:1646 */ - { (yyval) = cb_list_add ((yyvsp[-2]), (yyvsp[0])); } -#line 23845 "parser.c" /* yacc.c:1646 */ - break; - - case 2071: -#line 13827 "parser.y" /* yacc.c:1646 */ - { - cb_tree x; - int data_type_ok = 1; - - if ((yyvsp[-5]) != cb_error_node - && (yyvsp[-3]) != cb_error_node - && (yyvsp[-2]) != cb_error_node) { - - if (cb_tree_category ((yyvsp[-5])) != CB_CATEGORY_NUMERIC) { - x = cb_ref ((yyvsp[-5])); - cb_error_x (CB_TREE (current_statement), - _("PERFORM VARYING '%s' (line %d of %s) is not a numeric field"), - cb_name (x),x->source_line, x->source_file); - (yyval) = cb_int1; - data_type_ok = 0; - } - if (cb_tree_category ((yyvsp[-3])) != CB_CATEGORY_NUMERIC) { - x = cb_ref ((yyvsp[-3])); - cb_error_x (CB_TREE (current_statement), - _("PERFORM VARYING '%s' (line %d of %s) is not a numeric field"), - cb_name (x),x->source_line, x->source_file); - (yyval) = cb_int1; - data_type_ok = 0; - } - if (cb_tree_category ((yyvsp[-2])) != CB_CATEGORY_NUMERIC) { - x = cb_ref ((yyvsp[-2])); - cb_error_x (CB_TREE (current_statement), - _("PERFORM VARYING '%s' (line %d of %s) is not a numeric field"), - cb_name (x),x->source_line, x->source_file); - (yyval) = cb_int1; - data_type_ok = 0; - } - - if (data_type_ok) { - (yyval) = cb_build_perform_varying ((yyvsp[-5]), (yyvsp[-3]), (yyvsp[-2]), (yyvsp[0])); - } - } - } -#line 23888 "parser.c" /* yacc.c:1646 */ - break; - - case 2072: -#line 13869 "parser.y" /* yacc.c:1646 */ - { - cb_verify (cb_perform_varying_without_by, _("PERFORM VARYING without BY phrase")); - (yyval) = cb_build_numeric_literal (0, "1", 0); - } -#line 23897 "parser.c" /* yacc.c:1646 */ - break; - - case 2073: -#line 13874 "parser.y" /* yacc.c:1646 */ - { - (yyval) = (yyvsp[0]); - } -#line 23905 "parser.c" /* yacc.c:1646 */ - break; - - case 2074: -#line 13883 "parser.y" /* yacc.c:1646 */ - { - begin_statement ("PURGE", 0); - } -#line 23913 "parser.c" /* yacc.c:1646 */ - break; - - case 2075: -#line 13887 "parser.y" /* yacc.c:1646 */ - { - } -#line 23920 "parser.c" /* yacc.c:1646 */ - break; - - case 2076: -#line 13895 "parser.y" /* yacc.c:1646 */ - { - begin_statement ("RAISE", 0); - } -#line 23928 "parser.c" /* yacc.c:1646 */ - break; - - case 2078: -#line 13903 "parser.y" /* yacc.c:1646 */ - { - CB_PENDING ("RAISE statement"); - /* TODO: check for level 3 error here */ - } -#line 23937 "parser.c" /* yacc.c:1646 */ - break; - - case 2079: -#line 13908 "parser.y" /* yacc.c:1646 */ - { - /* easy cheating here as we don't have any OO in */ - cb_error(_("'%s' is not an object-reference"), cb_name ((yyvsp[0]))); - } -#line 23946 "parser.c" /* yacc.c:1646 */ - break; - - case 2080: -#line 13918 "parser.y" /* yacc.c:1646 */ - { - /* TODO: - cb_tree exception = get_exception (CB_NAME($1)); - if (!exception) { - cb_error (_("'%s' is not an exception-name"), CB_NAME ($1)); - } - */ - } -#line 23959 "parser.c" /* yacc.c:1646 */ - break; - - case 2081: -#line 13932 "parser.y" /* yacc.c:1646 */ - { - begin_statement ("READ", TERM_READ); - cobc_cs_check = CB_CS_READ; - } -#line 23968 "parser.c" /* yacc.c:1646 */ - break; - - case 2083: -#line 13942 "parser.y" /* yacc.c:1646 */ - { - cobc_cs_check = 0; - - if (CB_VALID_TREE ((yyvsp[-6]))) { - struct cb_file *cf; - - cf = CB_FILE(cb_ref ((yyvsp[-6]))); - if ((yyvsp[-2]) && (cf->lock_mode & COB_LOCK_AUTOMATIC)) { - cb_error_x (CB_TREE (current_statement), - _("LOCK clause invalid with file LOCK AUTOMATIC")); - } else if ((yyvsp[-1]) && - (cf->organization != COB_ORG_RELATIVE && - cf->organization != COB_ORG_INDEXED)) { - cb_error_x (CB_TREE (current_statement), - _("KEY clause invalid with this file type")); - } else if (current_statement->handler_type == INVALID_KEY_HANDLER && - (cf->organization != COB_ORG_RELATIVE && - cf->organization != COB_ORG_INDEXED)) { - cb_error_x (CB_TREE (current_statement), - _("INVALID KEY clause invalid with this file type")); - } else { - cb_emit_read ((yyvsp[-6]), (yyvsp[-5]), (yyvsp[-3]), (yyvsp[-1]), (yyvsp[-2])); - } - } - } -#line 23998 "parser.c" /* yacc.c:1646 */ - break; - - case 2084: -#line 13970 "parser.y" /* yacc.c:1646 */ - { (yyval) = NULL; } -#line 24004 "parser.c" /* yacc.c:1646 */ - break; - - case 2085: -#line 13971 "parser.y" /* yacc.c:1646 */ - { (yyval) = (yyvsp[0]); } -#line 24010 "parser.c" /* yacc.c:1646 */ - break; - - case 2086: -#line 13976 "parser.y" /* yacc.c:1646 */ - { - (yyval) = NULL; - } -#line 24018 "parser.c" /* yacc.c:1646 */ - break; - - case 2087: -#line 13980 "parser.y" /* yacc.c:1646 */ - { - (yyval) = cb_int3; - } -#line 24026 "parser.c" /* yacc.c:1646 */ - break; - - case 2088: -#line 13984 "parser.y" /* yacc.c:1646 */ - { - (yyval) = (yyvsp[0]); - } -#line 24034 "parser.c" /* yacc.c:1646 */ - break; - - case 2089: -#line 13988 "parser.y" /* yacc.c:1646 */ - { - (yyval) = (yyvsp[0]); - } -#line 24042 "parser.c" /* yacc.c:1646 */ - break; - - case 2090: -#line 13995 "parser.y" /* yacc.c:1646 */ - { - current_statement->flag_ignore_lock = 1; - } -#line 24050 "parser.c" /* yacc.c:1646 */ - break; - - case 2091: -#line 13999 "parser.y" /* yacc.c:1646 */ - { - current_statement->flag_ignore_lock = 1; - } -#line 24058 "parser.c" /* yacc.c:1646 */ - break; - - case 2092: -#line 14006 "parser.y" /* yacc.c:1646 */ - { - current_statement->flag_advancing_lock = 1; - } -#line 24066 "parser.c" /* yacc.c:1646 */ - break; - - case 2096: -#line 14019 "parser.y" /* yacc.c:1646 */ - { - cobc_cs_check = 0; - } -#line 24074 "parser.c" /* yacc.c:1646 */ - break; - - case 2097: -#line 14027 "parser.y" /* yacc.c:1646 */ - { - current_statement->retry = (yyvsp[-1]); - current_statement->flag_retry_times = 1; - } -#line 24083 "parser.c" /* yacc.c:1646 */ - break; - - case 2098: -#line 14032 "parser.y" /* yacc.c:1646 */ - { - current_statement->retry = (yyvsp[-1]); - current_statement->flag_retry_seconds = 1; - } -#line 24092 "parser.c" /* yacc.c:1646 */ - break; - - case 2099: -#line 14037 "parser.y" /* yacc.c:1646 */ - { - current_statement->retry = NULL; - current_statement->flag_retry_forever = 1; - } -#line 24101 "parser.c" /* yacc.c:1646 */ - break; - - case 2102: -#line 14050 "parser.y" /* yacc.c:1646 */ - { - (yyval) = (yyvsp[0]); - } -#line 24109 "parser.c" /* yacc.c:1646 */ - break; - - case 2103: -#line 14054 "parser.y" /* yacc.c:1646 */ - { - (yyval) = cb_int5; - } -#line 24117 "parser.c" /* yacc.c:1646 */ - break; - - case 2104: -#line 14058 "parser.y" /* yacc.c:1646 */ - { - (yyval) = cb_int4; - } -#line 24125 "parser.c" /* yacc.c:1646 */ - break; - - case 2105: -#line 14064 "parser.y" /* yacc.c:1646 */ - { (yyval) = NULL; } -#line 24131 "parser.c" /* yacc.c:1646 */ - break; - - case 2106: -#line 14065 "parser.y" /* yacc.c:1646 */ - { (yyval) = (yyvsp[0]); } -#line 24137 "parser.c" /* yacc.c:1646 */ - break; - - case 2109: -#line 14075 "parser.y" /* yacc.c:1646 */ - { - TERMINATOR_WARNING ((yyvsp[(-2) - (0)]), READ); - } -#line 24145 "parser.c" /* yacc.c:1646 */ - break; - - case 2110: -#line 14079 "parser.y" /* yacc.c:1646 */ - { - TERMINATOR_CLEAR ((yyvsp[(-2) - (1)]), READ); - } -#line 24153 "parser.c" /* yacc.c:1646 */ - break; - - case 2111: -#line 14089 "parser.y" /* yacc.c:1646 */ - { - begin_statement ("READY TRACE", 0); - cb_emit_ready_trace (); - } -#line 24162 "parser.c" /* yacc.c:1646 */ - break; - - case 2112: -#line 14099 "parser.y" /* yacc.c:1646 */ - { - begin_statement ("RECEIVE", TERM_RECEIVE); - } -#line 24170 "parser.c" /* yacc.c:1646 */ - break; - - case 2126: -#line 14142 "parser.y" /* yacc.c:1646 */ - { - TERMINATOR_WARNING ((yyvsp[(-2) - (0)]), RECEIVE); - } -#line 24178 "parser.c" /* yacc.c:1646 */ - break; - - case 2127: -#line 14146 "parser.y" /* yacc.c:1646 */ - { - TERMINATOR_CLEAR ((yyvsp[(-2) - (1)]), RECEIVE); - } -#line 24186 "parser.c" /* yacc.c:1646 */ - break; - - case 2128: -#line 14155 "parser.y" /* yacc.c:1646 */ - { - begin_statement ("RELEASE", 0); - } -#line 24194 "parser.c" /* yacc.c:1646 */ - break; - - case 2130: -#line 14163 "parser.y" /* yacc.c:1646 */ - { - cb_emit_release ((yyvsp[-1]), (yyvsp[0])); - } -#line 24202 "parser.c" /* yacc.c:1646 */ - break; - - case 2131: -#line 14173 "parser.y" /* yacc.c:1646 */ - { - begin_statement ("RESET TRACE", 0); - cb_emit_reset_trace (); - } -#line 24211 "parser.c" /* yacc.c:1646 */ - break; - - case 2132: -#line 14183 "parser.y" /* yacc.c:1646 */ - { - begin_statement ("RETURN", TERM_RETURN); - } -#line 24219 "parser.c" /* yacc.c:1646 */ - break; - - case 2134: -#line 14192 "parser.y" /* yacc.c:1646 */ - { - cb_emit_return ((yyvsp[-3]), (yyvsp[-1])); - } -#line 24227 "parser.c" /* yacc.c:1646 */ - break; - - case 2135: -#line 14199 "parser.y" /* yacc.c:1646 */ - { - TERMINATOR_WARNING ((yyvsp[(-2) - (0)]), RETURN); - } -#line 24235 "parser.c" /* yacc.c:1646 */ - break; - - case 2136: -#line 14203 "parser.y" /* yacc.c:1646 */ - { - TERMINATOR_CLEAR ((yyvsp[(-2) - (1)]), RETURN); - } -#line 24243 "parser.c" /* yacc.c:1646 */ - break; - - case 2137: -#line 14213 "parser.y" /* yacc.c:1646 */ - { - begin_statement ("REWRITE", TERM_REWRITE); - /* Special in debugging mode */ - save_debug = start_debug; - start_debug = 0; - } -#line 24254 "parser.c" /* yacc.c:1646 */ - break; - - case 2139: -#line 14225 "parser.y" /* yacc.c:1646 */ - { - cb_emit_rewrite ((yyvsp[-4]), (yyvsp[-3]), (yyvsp[-1])); - start_debug = save_debug; - } -#line 24263 "parser.c" /* yacc.c:1646 */ - break; - - case 2140: -#line 14233 "parser.y" /* yacc.c:1646 */ - { - (yyval) = NULL; - } -#line 24271 "parser.c" /* yacc.c:1646 */ - break; - - case 2142: -#line 14241 "parser.y" /* yacc.c:1646 */ - { - (yyval) = cb_int1; - } -#line 24279 "parser.c" /* yacc.c:1646 */ - break; - - case 2143: -#line 14245 "parser.y" /* yacc.c:1646 */ - { - (yyval) = cb_int2; - } -#line 24287 "parser.c" /* yacc.c:1646 */ - break; - - case 2144: -#line 14252 "parser.y" /* yacc.c:1646 */ - { - TERMINATOR_WARNING ((yyvsp[(-2) - (0)]), REWRITE); - } -#line 24295 "parser.c" /* yacc.c:1646 */ - break; - - case 2145: -#line 14256 "parser.y" /* yacc.c:1646 */ - { - TERMINATOR_CLEAR ((yyvsp[(-2) - (1)]), REWRITE); - } -#line 24303 "parser.c" /* yacc.c:1646 */ - break; - - case 2146: -#line 14266 "parser.y" /* yacc.c:1646 */ - { - begin_statement ("ROLLBACK", 0); - cb_emit_rollback (); - } -#line 24312 "parser.c" /* yacc.c:1646 */ - break; - - case 2147: -#line 14277 "parser.y" /* yacc.c:1646 */ - { - begin_statement ("SEARCH", TERM_SEARCH); - } -#line 24320 "parser.c" /* yacc.c:1646 */ - break; - - case 2149: -#line 14286 "parser.y" /* yacc.c:1646 */ - { - cb_emit_search ((yyvsp[-3]), (yyvsp[-2]), (yyvsp[-1]), (yyvsp[0])); - } -#line 24328 "parser.c" /* yacc.c:1646 */ - break; - - case 2150: -#line 14291 "parser.y" /* yacc.c:1646 */ - { - current_statement->name = (const char *)"SEARCH ALL"; - cb_emit_search_all ((yyvsp[-4]), (yyvsp[-3]), (yyvsp[-1]), (yyvsp[0])); - } -#line 24337 "parser.c" /* yacc.c:1646 */ - break; - - case 2151: -#line 14298 "parser.y" /* yacc.c:1646 */ - { (yyval) = NULL; } -#line 24343 "parser.c" /* yacc.c:1646 */ - break; - - case 2152: -#line 14299 "parser.y" /* yacc.c:1646 */ - { (yyval) = (yyvsp[0]); } -#line 24349 "parser.c" /* yacc.c:1646 */ - break; - - case 2153: -#line 14304 "parser.y" /* yacc.c:1646 */ - { - (yyval) = NULL; - } -#line 24357 "parser.c" /* yacc.c:1646 */ - break; - - case 2154: -#line 14309 "parser.y" /* yacc.c:1646 */ - { - (yyval) = (yyvsp[0]); - } -#line 24365 "parser.c" /* yacc.c:1646 */ - break; - - case 2155: -#line 14316 "parser.y" /* yacc.c:1646 */ - { - (yyval) = CB_LIST_INIT ((yyvsp[0])); - } -#line 24373 "parser.c" /* yacc.c:1646 */ - break; - - case 2156: -#line 14320 "parser.y" /* yacc.c:1646 */ - { - (yyval) = cb_list_add ((yyvsp[0]), (yyvsp[-1])); - } -#line 24381 "parser.c" /* yacc.c:1646 */ - break; - - case 2157: -#line 14328 "parser.y" /* yacc.c:1646 */ - { - (yyval) = cb_build_if_check_break ((yyvsp[-1]), (yyvsp[0])); - } -#line 24389 "parser.c" /* yacc.c:1646 */ - break; - - case 2158: -#line 14335 "parser.y" /* yacc.c:1646 */ - { - TERMINATOR_WARNING ((yyvsp[(-2) - (0)]), SEARCH); - } -#line 24397 "parser.c" /* yacc.c:1646 */ - break; - - case 2159: -#line 14339 "parser.y" /* yacc.c:1646 */ - { - TERMINATOR_CLEAR ((yyvsp[(-2) - (1)]), SEARCH); - } -#line 24405 "parser.c" /* yacc.c:1646 */ - break; - - case 2160: -#line 14349 "parser.y" /* yacc.c:1646 */ - { - begin_statement ("SEND", 0); - } -#line 24413 "parser.c" /* yacc.c:1646 */ - break; - - case 2162: -#line 14357 "parser.y" /* yacc.c:1646 */ - { - } -#line 24420 "parser.c" /* yacc.c:1646 */ - break; - - case 2163: -#line 14360 "parser.y" /* yacc.c:1646 */ - { - } -#line 24427 "parser.c" /* yacc.c:1646 */ - break; - - case 2166: -#line 14371 "parser.y" /* yacc.c:1646 */ - { - } -#line 24434 "parser.c" /* yacc.c:1646 */ - break; - - case 2173: -#line 14391 "parser.y" /* yacc.c:1646 */ - { - begin_statement ("SET", 0); - set_attr_val_on = 0; - set_attr_val_off = 0; - cobc_cs_check = CB_CS_SET; - } -#line 24445 "parser.c" /* yacc.c:1646 */ - break; - - case 2174: -#line 14398 "parser.y" /* yacc.c:1646 */ - { - cobc_cs_check = 0; - } -#line 24453 "parser.c" /* yacc.c:1646 */ - break; - - case 2183: -#line 14415 "parser.y" /* yacc.c:1646 */ - { (yyval) = cb_int1; } -#line 24459 "parser.c" /* yacc.c:1646 */ - break; - - case 2184: -#line 14416 "parser.y" /* yacc.c:1646 */ - { (yyval) = cb_int0; } -#line 24465 "parser.c" /* yacc.c:1646 */ - break; - - case 2185: -#line 14420 "parser.y" /* yacc.c:1646 */ - { (yyval) = cb_int0; } -#line 24471 "parser.c" /* yacc.c:1646 */ - break; - - case 2186: -#line 14421 "parser.y" /* yacc.c:1646 */ - { (yyval) = cb_int1; } -#line 24477 "parser.c" /* yacc.c:1646 */ - break; - - case 2187: -#line 14428 "parser.y" /* yacc.c:1646 */ - { - cb_emit_setenv ((yyvsp[-2]), (yyvsp[0])); - } -#line 24485 "parser.c" /* yacc.c:1646 */ - break; - - case 2188: -#line 14437 "parser.y" /* yacc.c:1646 */ - { - cb_emit_set_attribute ((yyvsp[-2]), set_attr_val_on, set_attr_val_off); - } -#line 24493 "parser.c" /* yacc.c:1646 */ - break; - - case 2191: -#line 14449 "parser.y" /* yacc.c:1646 */ - { - bit_set_attr ((yyvsp[0]), COB_SCREEN_BELL); - } -#line 24501 "parser.c" /* yacc.c:1646 */ - break; - - case 2192: -#line 14453 "parser.y" /* yacc.c:1646 */ - { - bit_set_attr ((yyvsp[0]), COB_SCREEN_BLINK); - } -#line 24509 "parser.c" /* yacc.c:1646 */ - break; - - case 2193: -#line 14457 "parser.y" /* yacc.c:1646 */ - { - bit_set_attr ((yyvsp[0]), COB_SCREEN_HIGHLIGHT); - check_not_highlight_and_lowlight (set_attr_val_on | set_attr_val_off, - COB_SCREEN_HIGHLIGHT); - } -#line 24519 "parser.c" /* yacc.c:1646 */ - break; - - case 2194: -#line 14463 "parser.y" /* yacc.c:1646 */ - { - bit_set_attr ((yyvsp[0]), COB_SCREEN_LOWLIGHT); - check_not_highlight_and_lowlight (set_attr_val_on | set_attr_val_off, - COB_SCREEN_LOWLIGHT); - } -#line 24529 "parser.c" /* yacc.c:1646 */ - break; - - case 2195: -#line 14469 "parser.y" /* yacc.c:1646 */ - { - bit_set_attr ((yyvsp[0]), COB_SCREEN_REVERSE); - } -#line 24537 "parser.c" /* yacc.c:1646 */ - break; - - case 2196: -#line 14473 "parser.y" /* yacc.c:1646 */ - { - bit_set_attr ((yyvsp[0]), COB_SCREEN_UNDERLINE); - } -#line 24545 "parser.c" /* yacc.c:1646 */ - break; - - case 2197: -#line 14477 "parser.y" /* yacc.c:1646 */ - { - bit_set_attr ((yyvsp[0]), COB_SCREEN_LEFTLINE); - } -#line 24553 "parser.c" /* yacc.c:1646 */ - break; - - case 2198: -#line 14481 "parser.y" /* yacc.c:1646 */ - { - bit_set_attr ((yyvsp[0]), COB_SCREEN_OVERLINE); - } -#line 24561 "parser.c" /* yacc.c:1646 */ - break; - - case 2199: -#line 14490 "parser.y" /* yacc.c:1646 */ - { - cb_emit_set_to ((yyvsp[-3]), cb_build_ppointer ((yyvsp[0]))); - } -#line 24569 "parser.c" /* yacc.c:1646 */ - break; - - case 2200: -#line 14494 "parser.y" /* yacc.c:1646 */ - { - cb_emit_set_to_fcd ((yyvsp[-6]), (yyvsp[0])); - } -#line 24577 "parser.c" /* yacc.c:1646 */ - break; - - case 2201: -#line 14498 "parser.y" /* yacc.c:1646 */ - { - cb_emit_set_to_fcdkey ((yyvsp[-6]), (yyvsp[0])); - } -#line 24585 "parser.c" /* yacc.c:1646 */ - break; - - case 2202: -#line 14502 "parser.y" /* yacc.c:1646 */ - { - cb_emit_set_to ((yyvsp[-2]), (yyvsp[0])); - } -#line 24593 "parser.c" /* yacc.c:1646 */ - break; - - case 2203: -#line 14506 "parser.y" /* yacc.c:1646 */ - { - cb_emit_move (cb_build_length ((yyvsp[0])), (yyvsp[-4])); - } -#line 24601 "parser.c" /* yacc.c:1646 */ - break; - - case 2204: -#line 14515 "parser.y" /* yacc.c:1646 */ - { - cb_emit_set_up_down ((yyvsp[-3]), (yyvsp[-2]), (yyvsp[0])); - } -#line 24609 "parser.c" /* yacc.c:1646 */ - break; - - case 2207: -#line 14529 "parser.y" /* yacc.c:1646 */ - { - cb_emit_set_on_off ((yyvsp[-2]), (yyvsp[0])); - } -#line 24617 "parser.c" /* yacc.c:1646 */ - break; - - case 2210: -#line 14543 "parser.y" /* yacc.c:1646 */ - { - cb_emit_set_true ((yyvsp[-2])); - } -#line 24625 "parser.c" /* yacc.c:1646 */ - break; - - case 2211: -#line 14547 "parser.y" /* yacc.c:1646 */ - { - cb_emit_set_false ((yyvsp[-2])); - } -#line 24633 "parser.c" /* yacc.c:1646 */ - break; - - case 2212: -#line 14556 "parser.y" /* yacc.c:1646 */ - { - cb_emit_set_last_exception_to_off (); - } -#line 24641 "parser.c" /* yacc.c:1646 */ - break; - - case 2213: -#line 14565 "parser.y" /* yacc.c:1646 */ - { - cb_emit_set_thread_priority ((yyvsp[-3]), (yyvsp[0])); - CB_PENDING ("THREAD"); - } -#line 24650 "parser.c" /* yacc.c:1646 */ - break; - - case 2214: -#line 14576 "parser.y" /* yacc.c:1646 */ - { - begin_statement ("SORT", 0); - } -#line 24658 "parser.c" /* yacc.c:1646 */ - break; - - case 2216: -#line 14584 "parser.y" /* yacc.c:1646 */ - { - cb_tree x = cb_ref ((yyvsp[-3])); - - (yyval) = NULL; - if (CB_VALID_TREE (x)) { - if ((yyvsp[-2]) == NULL || CB_VALUE((yyvsp[-2])) == NULL) { - if (CB_FILE_P (x)) { - cb_error (_("file sort requires KEY phrase")); - (yyvsp[-2]) = cb_error_node; - } else { - struct cb_field *f = CB_FIELD_PTR (x); -/* TODO: add compiler configuration cb_sort_without_keys - if (f->nkeys - && cb_verify (cb_sort_without_keys, _("table SORT without keys"))) { -*/ - if ((yyvsp[-2]) != NULL || f->nkeys) { - cb_tree lparm; - if ((yyvsp[-2]) == NULL) { - /* create reference to first key */ - x = cb_ref (f->keys[0].key); - } - /* use the OCCURS field / its defined KEY as single sort key */ - lparm = cb_list_add (NULL, x); - /* search order is either specified, otherwise derived from definition */ - if ((yyvsp[-2]) != NULL) { - CB_PURPOSE (lparm) = CB_PURPOSE ((yyvsp[-2])); - } else { - CB_PURPOSE (lparm) = cb_int (f->keys[0].dir); - } - (yyvsp[-2]) = cb_list_append (NULL, lparm); - } else { - cb_error (_("table SORT requires KEY phrase")); - (yyvsp[-2]) = cb_error_node; - } - } - } - if (CB_VALID_TREE ((yyvsp[-2]))) { - cb_emit_sort_init ((yyvsp[-3]), (yyvsp[-2]), alphanumeric_collation, national_collation); - (yyval) = (yyvsp[-3]); - } - } - } -#line 24705 "parser.c" /* yacc.c:1646 */ - break; - - case 2217: -#line 14627 "parser.y" /* yacc.c:1646 */ - { - if ((yyvsp[-2]) && CB_VALID_TREE ((yyvsp[-6]))) { - cb_emit_sort_finish ((yyvsp[-6])); - } - } -#line 24715 "parser.c" /* yacc.c:1646 */ - break; - - case 2218: -#line 14635 "parser.y" /* yacc.c:1646 */ - { (yyval) = NULL; } -#line 24721 "parser.c" /* yacc.c:1646 */ - break; - - case 2219: -#line 14638 "parser.y" /* yacc.c:1646 */ - { - cb_tree lparm = (yyvsp[0]); - cb_tree l; - - if (lparm == NULL) { - lparm = CB_LIST_INIT (NULL); - } - for (l = lparm; l; l = CB_CHAIN (l)) { - CB_PURPOSE (l) = (yyvsp[-2]); - } - (yyval) = cb_list_append ((yyvsp[-4]), lparm); - } -#line 24738 "parser.c" /* yacc.c:1646 */ - break; - - case 2220: -#line 14653 "parser.y" /* yacc.c:1646 */ - { (yyval) = NULL; } -#line 24744 "parser.c" /* yacc.c:1646 */ - break; - - case 2221: -#line 14654 "parser.y" /* yacc.c:1646 */ - { (yyval) = cb_list_add ((yyvsp[-1]), (yyvsp[0])); } -#line 24750 "parser.c" /* yacc.c:1646 */ - break; - - case 2223: -#line 14659 "parser.y" /* yacc.c:1646 */ - { - /* The GnuCOBOL sort is a stable sort. ie. dups are per default in order */ - /* Therefore nothing to do here */ - } -#line 24759 "parser.c" /* yacc.c:1646 */ - break; - - case 2224: -#line 14667 "parser.y" /* yacc.c:1646 */ - { - alphanumeric_collation = national_collation = NULL; - } -#line 24767 "parser.c" /* yacc.c:1646 */ - break; - - case 2226: -#line 14675 "parser.y" /* yacc.c:1646 */ - { - if ((yyvsp[0]) && CB_FILE_P (cb_ref ((yyvsp[0])))) { - cb_error (_("file sort requires USING or INPUT PROCEDURE")); - } - } -#line 24777 "parser.c" /* yacc.c:1646 */ - break; - - case 2227: -#line 14681 "parser.y" /* yacc.c:1646 */ - { - if ((yyvsp[-2])) { - if (!CB_FILE_P (cb_ref ((yyvsp[-2])))) { - cb_error (_("USING invalid with table SORT")); - } else { - cb_emit_sort_using ((yyvsp[-2]), (yyvsp[0])); - } - } - } -#line 24791 "parser.c" /* yacc.c:1646 */ - break; - - case 2228: -#line 14691 "parser.y" /* yacc.c:1646 */ - { - if ((yyvsp[-4])) { - if (!CB_FILE_P (cb_ref ((yyvsp[-4])))) { - cb_error (_("INPUT PROCEDURE invalid with table SORT")); - } else if (current_statement->flag_merge) { - cb_error (_("INPUT PROCEDURE invalid with MERGE")); - } else { - cb_emit_sort_input ((yyvsp[0])); - } - } - cobc_cs_check = 0; - } -#line 24808 "parser.c" /* yacc.c:1646 */ - break; - - case 2229: -#line 14707 "parser.y" /* yacc.c:1646 */ - { - if ((yyvsp[(-1) - (0)]) && CB_FILE_P (cb_ref ((yyvsp[(-1) - (0)])))) { - cb_error (_("file sort requires GIVING or OUTPUT PROCEDURE")); - } - } -#line 24818 "parser.c" /* yacc.c:1646 */ - break; - - case 2230: -#line 14713 "parser.y" /* yacc.c:1646 */ - { - if ((yyvsp[(-1) - (2)])) { - if (!CB_FILE_P (cb_ref ((yyvsp[(-1) - (2)])))) { - cb_error (_("GIVING invalid with table SORT")); - } else { - cb_emit_sort_giving ((yyvsp[(-1) - (2)]), (yyvsp[0])); - } - } - } -#line 24832 "parser.c" /* yacc.c:1646 */ - break; - - case 2231: -#line 14723 "parser.y" /* yacc.c:1646 */ - { - if ((yyvsp[(-1) - (4)])) { - if (!CB_FILE_P (cb_ref ((yyvsp[(-1) - (4)])))) { - cb_error (_("OUTPUT PROCEDURE invalid with table SORT")); - } else { - cb_emit_sort_output ((yyvsp[0])); - } - } - cobc_cs_check = 0; - } -#line 24847 "parser.c" /* yacc.c:1646 */ - break; - - case 2232: -#line 14740 "parser.y" /* yacc.c:1646 */ - { - begin_statement ("START", TERM_START); - start_tree = cb_int (COB_EQ); - } -#line 24856 "parser.c" /* yacc.c:1646 */ - break; - - case 2234: -#line 14750 "parser.y" /* yacc.c:1646 */ - { - if ((yyvsp[-1]) && !(yyvsp[-2])) { - cb_error_x (CB_TREE (current_statement), - _("SIZE/LENGTH invalid here")); - } else { - cb_emit_start ((yyvsp[-3]), start_tree, (yyvsp[-2]), (yyvsp[-1])); - } - } -#line 24869 "parser.c" /* yacc.c:1646 */ - break; - - case 2235: -#line 14762 "parser.y" /* yacc.c:1646 */ - { - (yyval) = NULL; - } -#line 24877 "parser.c" /* yacc.c:1646 */ - break; - - case 2236: -#line 14766 "parser.y" /* yacc.c:1646 */ - { - (yyval) = (yyvsp[0]); - } -#line 24885 "parser.c" /* yacc.c:1646 */ - break; - - case 2237: -#line 14773 "parser.y" /* yacc.c:1646 */ - { - (yyval) = NULL; - } -#line 24893 "parser.c" /* yacc.c:1646 */ - break; - - case 2238: -#line 14777 "parser.y" /* yacc.c:1646 */ - { - start_tree = (yyvsp[-1]); - (yyval) = (yyvsp[0]); - } -#line 24902 "parser.c" /* yacc.c:1646 */ - break; - - case 2239: -#line 14782 "parser.y" /* yacc.c:1646 */ - { - start_tree = cb_int (COB_FI); - (yyval) = NULL; - } -#line 24911 "parser.c" /* yacc.c:1646 */ - break; - - case 2240: -#line 14787 "parser.y" /* yacc.c:1646 */ - { - start_tree = cb_int (COB_LA); - (yyval) = NULL; - } -#line 24920 "parser.c" /* yacc.c:1646 */ - break; - - case 2241: -#line 14794 "parser.y" /* yacc.c:1646 */ - { (yyval) = cb_int (COB_EQ); } -#line 24926 "parser.c" /* yacc.c:1646 */ - break; - - case 2242: -#line 14795 "parser.y" /* yacc.c:1646 */ - { (yyval) = cb_int ((yyvsp[-1]) ? COB_LE : COB_GT); } -#line 24932 "parser.c" /* yacc.c:1646 */ - break; - - case 2243: -#line 14796 "parser.y" /* yacc.c:1646 */ - { (yyval) = cb_int ((yyvsp[-1]) ? COB_GE : COB_LT); } -#line 24938 "parser.c" /* yacc.c:1646 */ - break; - - case 2244: -#line 14797 "parser.y" /* yacc.c:1646 */ - { (yyval) = cb_int ((yyvsp[-1]) ? COB_LT : COB_GE); } -#line 24944 "parser.c" /* yacc.c:1646 */ - break; - - case 2245: -#line 14798 "parser.y" /* yacc.c:1646 */ - { (yyval) = cb_int ((yyvsp[-1]) ? COB_GT : COB_LE); } -#line 24950 "parser.c" /* yacc.c:1646 */ - break; - - case 2246: -#line 14799 "parser.y" /* yacc.c:1646 */ - { (yyval) = cb_int (COB_NE); } -#line 24956 "parser.c" /* yacc.c:1646 */ - break; - - case 2247: -#line 14804 "parser.y" /* yacc.c:1646 */ - { - cb_error_x (CB_TREE (current_statement), - _("NOT EQUAL condition not allowed on START statement")); - } -#line 24965 "parser.c" /* yacc.c:1646 */ - break; - - case 2250: -#line 14817 "parser.y" /* yacc.c:1646 */ - { - TERMINATOR_WARNING ((yyvsp[(-2) - (0)]), START); - } -#line 24973 "parser.c" /* yacc.c:1646 */ - break; - - case 2251: -#line 14821 "parser.y" /* yacc.c:1646 */ - { - TERMINATOR_CLEAR ((yyvsp[(-2) - (1)]), START); - } -#line 24981 "parser.c" /* yacc.c:1646 */ - break; - - case 2255: -#line 14839 "parser.y" /* yacc.c:1646 */ - { - CB_PENDING ("TRANSACTION"); - } -#line 24989 "parser.c" /* yacc.c:1646 */ - break; - - case 2256: -#line 14849 "parser.y" /* yacc.c:1646 */ - { - begin_statement ("STOP RUN", 0); - cobc_cs_check = CB_CS_STOP; - } -#line 24998 "parser.c" /* yacc.c:1646 */ - break; - - case 2257: -#line 14854 "parser.y" /* yacc.c:1646 */ - { - cb_emit_stop_run ((yyvsp[0])); - check_unreached = 1; - cobc_cs_check = 0; - } -#line 25008 "parser.c" /* yacc.c:1646 */ - break; - - case 2258: -#line 14860 "parser.y" /* yacc.c:1646 */ - { - begin_statement ("STOP", 0); - cb_emit_display (CB_LIST_INIT ((yyvsp[0])), cb_int0, cb_int1, NULL, - NULL, 1, DEVICE_DISPLAY); - cb_emit_accept (cb_null, NULL, NULL); - cobc_cs_check = 0; - } -#line 25020 "parser.c" /* yacc.c:1646 */ - break; - - case 2259: -#line 14868 "parser.y" /* yacc.c:1646 */ - { - begin_statement ("STOP THREAD", 0); - cb_emit_stop_thread ((yyvsp[0])); - cobc_cs_check = 0; - cb_warning_x (COBC_WARN_FILLER, (yyvsp[0]), _("%s is replaced by %s"), "STOP THREAD", "STOP RUN"); - } -#line 25031 "parser.c" /* yacc.c:1646 */ - break; - - case 2260: -#line 14878 "parser.y" /* yacc.c:1646 */ - { - if (current_program->cb_return_code) { - (yyval) = current_program->cb_return_code; - } else { - (yyval) = cb_int0; - } - } -#line 25043 "parser.c" /* yacc.c:1646 */ - break; - - case 2261: -#line 14886 "parser.y" /* yacc.c:1646 */ - { - (yyval) = (yyvsp[0]); - } -#line 25051 "parser.c" /* yacc.c:1646 */ - break; - - case 2262: -#line 14890 "parser.y" /* yacc.c:1646 */ - { - (yyval) = (yyvsp[0]); - } -#line 25059 "parser.c" /* yacc.c:1646 */ - break; - - case 2263: -#line 14894 "parser.y" /* yacc.c:1646 */ - { - if ((yyvsp[0])) { - (yyval) = (yyvsp[0]); - } else { - (yyval) = cb_int1; - } - } -#line 25071 "parser.c" /* yacc.c:1646 */ - break; - - case 2264: -#line 14902 "parser.y" /* yacc.c:1646 */ - { - if ((yyvsp[0])) { - (yyval) = (yyvsp[0]); - } else { - (yyval) = cb_int0; - } - } -#line 25083 "parser.c" /* yacc.c:1646 */ - break; - - case 2265: -#line 14913 "parser.y" /* yacc.c:1646 */ - { - (yyval) = NULL; - } -#line 25091 "parser.c" /* yacc.c:1646 */ - break; - - case 2266: -#line 14917 "parser.y" /* yacc.c:1646 */ - { - (yyval) = (yyvsp[0]); - } -#line 25099 "parser.c" /* yacc.c:1646 */ - break; - - case 2267: -#line 14924 "parser.y" /* yacc.c:1646 */ - { - cb_verify (cb_stop_literal_statement, _("STOP literal")); - } -#line 25107 "parser.c" /* yacc.c:1646 */ - break; - - case 2268: -#line 14928 "parser.y" /* yacc.c:1646 */ - { - cb_verify (cb_stop_identifier_statement, _("STOP identifier")); - } -#line 25115 "parser.c" /* yacc.c:1646 */ - break; - - case 2269: -#line 14934 "parser.y" /* yacc.c:1646 */ - { (yyval) = (yyvsp[0]); } -#line 25121 "parser.c" /* yacc.c:1646 */ - break; - - case 2270: -#line 14935 "parser.y" /* yacc.c:1646 */ - { (yyval) = cb_space; } -#line 25127 "parser.c" /* yacc.c:1646 */ - break; - - case 2271: -#line 14936 "parser.y" /* yacc.c:1646 */ - { (yyval) = cb_zero; } -#line 25133 "parser.c" /* yacc.c:1646 */ - break; - - case 2272: -#line 14937 "parser.y" /* yacc.c:1646 */ - { (yyval) = cb_quote; } -#line 25139 "parser.c" /* yacc.c:1646 */ - break; - - case 2273: -#line 14944 "parser.y" /* yacc.c:1646 */ - { - begin_statement ("STRING", TERM_STRING); - } -#line 25147 "parser.c" /* yacc.c:1646 */ - break; - - case 2275: -#line 14953 "parser.y" /* yacc.c:1646 */ - { - cb_emit_string ((yyvsp[-4]), (yyvsp[-2]), (yyvsp[-1])); - } -#line 25155 "parser.c" /* yacc.c:1646 */ - break; - - case 2276: -#line 14959 "parser.y" /* yacc.c:1646 */ - { - save_tree = NULL; - } -#line 25163 "parser.c" /* yacc.c:1646 */ - break; - - case 2277: -#line 14963 "parser.y" /* yacc.c:1646 */ - { - (yyval) = save_tree; - } -#line 25171 "parser.c" /* yacc.c:1646 */ - break; - - case 2280: -#line 14975 "parser.y" /* yacc.c:1646 */ - { - if (!save_tree) { - save_tree = CB_LIST_INIT ((yyvsp[-1])); - } else { - save_tree = cb_list_add (save_tree, (yyvsp[-1])); - } - if ((yyvsp[0])) { - save_tree = cb_list_add (save_tree, (yyvsp[0])); - } - } -#line 25186 "parser.c" /* yacc.c:1646 */ - break; - - case 2281: -#line 14988 "parser.y" /* yacc.c:1646 */ - { (yyval) = NULL; } -#line 25192 "parser.c" /* yacc.c:1646 */ - break; - - case 2282: -#line 14990 "parser.y" /* yacc.c:1646 */ - { (yyval) = (yyvsp[0]); } -#line 25198 "parser.c" /* yacc.c:1646 */ - break; - - case 2283: -#line 14994 "parser.y" /* yacc.c:1646 */ - { (yyval) = CB_BUILD_PAIR (cb_int0, NULL); } -#line 25204 "parser.c" /* yacc.c:1646 */ - break; - - case 2284: -#line 14995 "parser.y" /* yacc.c:1646 */ - { (yyval) = CB_BUILD_PAIR ((yyvsp[0]), NULL); } -#line 25210 "parser.c" /* yacc.c:1646 */ - break; - - case 2285: -#line 14999 "parser.y" /* yacc.c:1646 */ - { (yyval) = NULL; } -#line 25216 "parser.c" /* yacc.c:1646 */ - break; - - case 2286: -#line 15000 "parser.y" /* yacc.c:1646 */ - { (yyval) = (yyvsp[0]); } -#line 25222 "parser.c" /* yacc.c:1646 */ - break; - - case 2287: -#line 15005 "parser.y" /* yacc.c:1646 */ - { - TERMINATOR_WARNING ((yyvsp[(-2) - (0)]), STRING); - } -#line 25230 "parser.c" /* yacc.c:1646 */ - break; - - case 2288: -#line 15009 "parser.y" /* yacc.c:1646 */ - { - TERMINATOR_CLEAR ((yyvsp[(-2) - (1)]), STRING); - } -#line 25238 "parser.c" /* yacc.c:1646 */ - break; - - case 2289: -#line 15019 "parser.y" /* yacc.c:1646 */ - { - begin_statement ("SUBTRACT", TERM_SUBTRACT); - } -#line 25246 "parser.c" /* yacc.c:1646 */ - break; - - case 2291: -#line 15028 "parser.y" /* yacc.c:1646 */ - { - cb_emit_arithmetic ((yyvsp[-1]), '-', cb_build_binary_list ((yyvsp[-3]), '+')); - } -#line 25254 "parser.c" /* yacc.c:1646 */ - break; - - case 2292: -#line 15032 "parser.y" /* yacc.c:1646 */ - { - cb_emit_arithmetic ((yyvsp[-1]), 0, cb_build_binary_list (CB_BUILD_CHAIN ((yyvsp[-3]), (yyvsp[-5])), '-')); - } -#line 25262 "parser.c" /* yacc.c:1646 */ - break; - - case 2293: -#line 15036 "parser.y" /* yacc.c:1646 */ - { - cb_emit_corresponding (cb_build_sub, (yyvsp[-2]), (yyvsp[-4]), (yyvsp[-1])); - } -#line 25270 "parser.c" /* yacc.c:1646 */ - break; - - case 2294: -#line 15040 "parser.y" /* yacc.c:1646 */ - { - CB_PENDING ("SUBTRACT TABLE"); - cb_emit_tab_arithmetic (cb_build_sub, (yyvsp[-4]), (yyvsp[-6]), (yyvsp[-3]), (yyvsp[-2]), (yyvsp[-1])); - } -#line 25279 "parser.c" /* yacc.c:1646 */ - break; - - case 2295: -#line 15048 "parser.y" /* yacc.c:1646 */ - { - TERMINATOR_WARNING ((yyvsp[(-2) - (0)]), SUBTRACT); - } -#line 25287 "parser.c" /* yacc.c:1646 */ - break; - - case 2296: -#line 15052 "parser.y" /* yacc.c:1646 */ - { - TERMINATOR_CLEAR ((yyvsp[(-2) - (1)]), SUBTRACT); - } -#line 25295 "parser.c" /* yacc.c:1646 */ - break; - - case 2297: -#line 15062 "parser.y" /* yacc.c:1646 */ - { - begin_statement ("SUPPRESS", 0); - if (!in_declaratives) { - cb_error_x (CB_TREE (current_statement), - _("SUPPRESS statement must be within DECLARATIVES")); - } - cb_emit_suppress (control_field); - } -#line 25308 "parser.c" /* yacc.c:1646 */ - break; - - case 2300: -#line 15080 "parser.y" /* yacc.c:1646 */ - { - begin_statement ("TERMINATE", 0); - } -#line 25316 "parser.c" /* yacc.c:1646 */ - break; - - case 2302: -#line 15088 "parser.y" /* yacc.c:1646 */ - { - begin_implicit_statement (); - if ((yyvsp[0]) != cb_error_node) { - cb_emit_terminate ((yyvsp[0])); - } - } -#line 25327 "parser.c" /* yacc.c:1646 */ - break; - - case 2303: -#line 15095 "parser.y" /* yacc.c:1646 */ - { - begin_implicit_statement (); - if ((yyvsp[0]) != cb_error_node) { - cb_emit_terminate ((yyvsp[0])); - } - } -#line 25338 "parser.c" /* yacc.c:1646 */ - break; - - case 2304: -#line 15107 "parser.y" /* yacc.c:1646 */ - { - begin_statement ("TRANSFORM", 0); - } -#line 25346 "parser.c" /* yacc.c:1646 */ - break; - - case 2306: -#line 15115 "parser.y" /* yacc.c:1646 */ - { - cb_tree x; - - x = cb_build_converting ((yyvsp[-2]), (yyvsp[0]), cb_build_inspect_region_start ()); - cb_emit_inspect ((yyvsp[-4]), x, TRANSFORM_STATEMENT); - } -#line 25357 "parser.c" /* yacc.c:1646 */ - break; - - case 2307: -#line 15128 "parser.y" /* yacc.c:1646 */ - { - begin_statement ("UNLOCK", 0); - } -#line 25365 "parser.c" /* yacc.c:1646 */ - break; - - case 2309: -#line 15136 "parser.y" /* yacc.c:1646 */ - { - if (CB_VALID_TREE ((yyvsp[-1]))) { - if (CB_FILE (cb_ref ((yyvsp[-1])))->organization == COB_ORG_SORT) { - cb_error_x (CB_TREE (current_statement), - _("UNLOCK invalid for SORT files")); - } else { - cb_emit_unlock ((yyvsp[-1])); - } - } - } -#line 25380 "parser.c" /* yacc.c:1646 */ - break; - - case 2310: -#line 15152 "parser.y" /* yacc.c:1646 */ - { - begin_statement ("UNSTRING", TERM_UNSTRING); - } -#line 25388 "parser.c" /* yacc.c:1646 */ - break; - - case 2312: -#line 15163 "parser.y" /* yacc.c:1646 */ - { - cb_emit_unstring ((yyvsp[-5]), (yyvsp[-4]), (yyvsp[-3]), (yyvsp[-2]), (yyvsp[-1])); - } -#line 25396 "parser.c" /* yacc.c:1646 */ - break; - - case 2313: -#line 15169 "parser.y" /* yacc.c:1646 */ - { (yyval) = NULL; } -#line 25402 "parser.c" /* yacc.c:1646 */ - break; - - case 2314: -#line 15171 "parser.y" /* yacc.c:1646 */ - { (yyval) = (yyvsp[0]); } -#line 25408 "parser.c" /* yacc.c:1646 */ - break; - - case 2315: -#line 15175 "parser.y" /* yacc.c:1646 */ - { (yyval) = CB_LIST_INIT ((yyvsp[0])); } -#line 25414 "parser.c" /* yacc.c:1646 */ - break; - - case 2316: -#line 15177 "parser.y" /* yacc.c:1646 */ - { (yyval) = cb_list_add ((yyvsp[-2]), (yyvsp[0])); } -#line 25420 "parser.c" /* yacc.c:1646 */ - break; - - case 2317: -#line 15182 "parser.y" /* yacc.c:1646 */ - { - (yyval) = cb_build_unstring_delimited ((yyvsp[-1]), (yyvsp[0])); - } -#line 25428 "parser.c" /* yacc.c:1646 */ - break; - - case 2318: -#line 15188 "parser.y" /* yacc.c:1646 */ - { (yyval) = CB_LIST_INIT ((yyvsp[0])); } -#line 25434 "parser.c" /* yacc.c:1646 */ - break; - - case 2319: -#line 15190 "parser.y" /* yacc.c:1646 */ - { (yyval) = cb_list_add ((yyvsp[-1]), (yyvsp[0])); } -#line 25440 "parser.c" /* yacc.c:1646 */ - break; - - case 2320: -#line 15195 "parser.y" /* yacc.c:1646 */ - { - (yyval) = cb_build_unstring_into ((yyvsp[-2]), (yyvsp[-1]), (yyvsp[0])); - } -#line 25448 "parser.c" /* yacc.c:1646 */ - break; - - case 2321: -#line 15201 "parser.y" /* yacc.c:1646 */ - { (yyval) = NULL; } -#line 25454 "parser.c" /* yacc.c:1646 */ - break; - - case 2322: -#line 15202 "parser.y" /* yacc.c:1646 */ - { (yyval) = (yyvsp[0]); } -#line 25460 "parser.c" /* yacc.c:1646 */ - break; - - case 2323: -#line 15206 "parser.y" /* yacc.c:1646 */ - { (yyval) = NULL; } -#line 25466 "parser.c" /* yacc.c:1646 */ - break; - - case 2324: -#line 15207 "parser.y" /* yacc.c:1646 */ - { (yyval) = (yyvsp[0]); } -#line 25472 "parser.c" /* yacc.c:1646 */ - break; - - case 2325: -#line 15212 "parser.y" /* yacc.c:1646 */ - { - TERMINATOR_WARNING ((yyvsp[(-2) - (0)]), UNSTRING); - } -#line 25480 "parser.c" /* yacc.c:1646 */ - break; - - case 2326: -#line 15216 "parser.y" /* yacc.c:1646 */ - { - TERMINATOR_CLEAR ((yyvsp[(-2) - (1)]), UNSTRING); - } -#line 25488 "parser.c" /* yacc.c:1646 */ - break; - - case 2327: -#line 15225 "parser.y" /* yacc.c:1646 */ - { - begin_statement ("VALIDATE", 0); - } -#line 25496 "parser.c" /* yacc.c:1646 */ - break; - - case 2328: -#line 15229 "parser.y" /* yacc.c:1646 */ - { -#if 0 /* FIXME: at least add syntax checks here */ - cb_emit_validate ((yyvsp[0])); -#else - CB_PENDING ("VALIDATE"); -#endif - } -#line 25508 "parser.c" /* yacc.c:1646 */ - break; - - case 2329: -#line 15240 "parser.y" /* yacc.c:1646 */ - { - check_validate_item ((yyvsp[0])); - (yyval) = CB_LIST_INIT ((yyvsp[0])); - } -#line 25517 "parser.c" /* yacc.c:1646 */ - break; - - case 2330: -#line 15245 "parser.y" /* yacc.c:1646 */ - { - check_validate_item ((yyvsp[0])); - (yyval) = cb_list_add ((yyvsp[-1]), (yyvsp[0])); - } -#line 25526 "parser.c" /* yacc.c:1646 */ - break; - - case 2331: -#line 15256 "parser.y" /* yacc.c:1646 */ - { - skip_statements = 0; - in_debugging = 0; - } -#line 25535 "parser.c" /* yacc.c:1646 */ - break; - - case 2338: -#line 15274 "parser.y" /* yacc.c:1646 */ - { - if (!in_declaratives) { - cb_error (_("USE statement must be within DECLARATIVES")); - } else if (!current_section) { - cb_error (_("SECTION header missing before USE statement")); - } else { - current_section->flag_begin = 1; - current_section->flag_return = 1; - current_section->flag_declarative_exit = 1; - current_section->flag_real_label = 1; - current_section->flag_skip_label = 0; - CB_EXCEPTION_ENABLE (COB_EC_I_O) = 1; - if (use_global_ind) { - current_section->flag_global = 1; - current_program->global_list = - cb_list_add (current_program->global_list, - CB_TREE (current_section)); - } - emit_statement (cb_build_comment ("USE AFTER ERROR")); - } - } -#line 25561 "parser.c" /* yacc.c:1646 */ - break; - - case 2339: -#line 15299 "parser.y" /* yacc.c:1646 */ - { - use_global_ind = 0; - } -#line 25569 "parser.c" /* yacc.c:1646 */ - break; - - case 2340: -#line 15303 "parser.y" /* yacc.c:1646 */ - { - if (current_program->prog_type == COB_MODULE_TYPE_FUNCTION) { - cb_error (_("%s is invalid in a user FUNCTION"), "GLOBAL"); - } else { - use_global_ind = 1; - current_program->flag_global_use = 1; - } - } -#line 25582 "parser.c" /* yacc.c:1646 */ - break; - - case 2341: -#line 15315 "parser.y" /* yacc.c:1646 */ - { - cb_tree l; - - for (l = (yyvsp[0]); l; l = CB_CHAIN (l)) { - if (CB_VALID_TREE (CB_VALUE (l))) { - setup_use_file (CB_FILE (cb_ref (CB_VALUE (l)))); - } - } - } -#line 25596 "parser.c" /* yacc.c:1646 */ - break; - - case 2342: -#line 15325 "parser.y" /* yacc.c:1646 */ - { - current_program->global_handler[COB_OPEN_INPUT].handler_label = current_section; - current_program->global_handler[COB_OPEN_INPUT].handler_prog = current_program; - } -#line 25605 "parser.c" /* yacc.c:1646 */ - break; - - case 2343: -#line 15330 "parser.y" /* yacc.c:1646 */ - { - current_program->global_handler[COB_OPEN_OUTPUT].handler_label = current_section; - current_program->global_handler[COB_OPEN_OUTPUT].handler_prog = current_program; - } -#line 25614 "parser.c" /* yacc.c:1646 */ - break; - - case 2344: -#line 15335 "parser.y" /* yacc.c:1646 */ - { - current_program->global_handler[COB_OPEN_I_O].handler_label = current_section; - current_program->global_handler[COB_OPEN_I_O].handler_prog = current_program; - } -#line 25623 "parser.c" /* yacc.c:1646 */ - break; - - case 2345: -#line 15340 "parser.y" /* yacc.c:1646 */ - { - current_program->global_handler[COB_OPEN_EXTEND].handler_label = current_section; - current_program->global_handler[COB_OPEN_EXTEND].handler_prog = current_program; - } -#line 25632 "parser.c" /* yacc.c:1646 */ - break; - - case 2346: -#line 15348 "parser.y" /* yacc.c:1646 */ - { - cb_tree plabel; - char name[64]; - - cb_verify (cb_use_for_debugging, "USE FOR DEBUGGING"); - - if (!in_declaratives) { - cb_error (_("USE statement must be within DECLARATIVES")); - } else if (current_program->nested_level) { - cb_error (_("USE DEBUGGING not supported in contained program")); - } else { - in_debugging = 1; - current_section->flag_begin = 1; - current_section->flag_return = 1; - current_section->flag_declarative_exit = 1; - current_section->flag_real_label = 0; - current_section->flag_is_debug_sect = 1; - if (!needs_debug_item) { - needs_debug_item = 1; - cb_build_debug_item (); - } - if (!current_program->flag_debugging) { - skip_statements = 1; - current_section->flag_skip_label = 1; - } else { - current_program->flag_gen_debug = 1; - sprintf (name, "EXIT SECTION %d", cb_id); - plabel = cb_build_reference (name); - plabel = cb_build_label (plabel, NULL); - CB_LABEL (plabel)->flag_begin = 1; - CB_LABEL (plabel)->flag_dummy_exit = 1; - current_section->exit_label = plabel; - emit_statement (cb_build_comment ("USE FOR DEBUGGING")); - } - } - } -#line 25673 "parser.c" /* yacc.c:1646 */ - break; - - case 2349: -#line 15393 "parser.y" /* yacc.c:1646 */ - { - if (current_program->flag_debugging) { - - cb_tree z = CB_LIST_INIT ((yyvsp[0])); - current_program->debug_list = - cb_list_append (current_program->debug_list, z); - /* Check backward refs to file/data names */ - if (CB_WORD_COUNT ((yyvsp[0])) > 0) { - cb_tree l = CB_VALUE (CB_WORD_ITEMS ((yyvsp[0]))); - switch (CB_TREE_TAG (l)) { - case CB_TAG_CD: - if (CB_CD (l)->flag_field_debug) { - cb_error_x ((yyvsp[0]), _("duplicate DEBUGGING target: '%s'"), - cb_name (l)); - } else { - CB_CD (l)->debug_section = current_section; - CB_CD (l)->flag_field_debug = 1; - } - break; - case CB_TAG_FILE: - if (CB_FILE (l)->flag_fl_debug) { - cb_error_x ((yyvsp[0]), _("duplicate DEBUGGING target: '%s'"), - cb_name (l)); - } else { - CB_FILE (l)->debug_section = current_section; - CB_FILE (l)->flag_fl_debug = 1; - } - break; - case CB_TAG_FIELD: - { - struct cb_field* fld; - cb_tree x = cb_ref ((yyvsp[0])); - if (!x || !CB_FIELD_P (x)) { - break; - } - fld = CB_FIELD (x); - if (fld->flag_item_78) { - cb_error_x ((yyvsp[0]), _("constant item cannot be used here")); - } else if (fld->flag_field_debug) { - cb_error_x ((yyvsp[0]), _("duplicate DEBUGGING target: '%s'"), - cb_name (x)); - } else { - needs_field_debug = 1; - fld->debug_section = current_section; - fld->flag_field_debug = 1; - CB_PURPOSE (z) = x; - } - } - break; - default: - /* Label refs will be checked later (forward/backward ref) */ - break; - } - } - CB_REFERENCE ((yyvsp[0]))->debug_section = current_section; - CB_REFERENCE ((yyvsp[0]))->flag_debug_code = 1; - CB_REFERENCE ((yyvsp[0]))->flag_all_debug = 0; - } - } -#line 25737 "parser.c" /* yacc.c:1646 */ - break; - - case 2350: -#line 15453 "parser.y" /* yacc.c:1646 */ - { - if (current_program->flag_debugging) { - if (current_program->all_procedure) { - cb_error (_("duplicate USE DEBUGGING ON ALL PROCEDURES")); - } else { - current_program->all_procedure = current_section; - } - } - } -#line 25751 "parser.c" /* yacc.c:1646 */ - break; - - case 2351: -#line 15463 "parser.y" /* yacc.c:1646 */ - { - if (current_program->flag_debugging && (yyvsp[0]) != cb_error_node) { - cb_tree x = cb_ref ((yyvsp[0])); - struct cb_field *fld = CB_FIELD (x); - if (fld->flag_field_debug) { - cb_error_x ((yyvsp[0]), _("duplicate DEBUGGING target: '%s'"), - cb_name (x)); - } else { - struct cb_reference *r = CB_REFERENCE ((yyvsp[0])); - needs_field_debug = 1; - fld->debug_section = current_section; - fld->flag_field_debug = 1; - fld->flag_all_debug = 1; - r->debug_section = current_section; - r->flag_debug_code = 1; - r->flag_all_debug = 1; - CB_CHAIN_PAIR (current_program->debug_list, x, (yyvsp[0])); - } - } - } -#line 25776 "parser.c" /* yacc.c:1646 */ - break; - - case 2356: -#line 15493 "parser.y" /* yacc.c:1646 */ - { - if (current_program->nested_level) { - cb_error (_("%s is invalid in nested program"), "USE AT"); - } - } -#line 25786 "parser.c" /* yacc.c:1646 */ - break; - - case 2357: -#line 15502 "parser.y" /* yacc.c:1646 */ - { - emit_statement (cb_build_comment ("USE AT PROGRAM START")); - backup_current_pos (); - CB_PENDING ("USE AT PROGRAM START"); - /* emit_entry ("_AT_START", 0, NULL, NULL); */ - } -#line 25797 "parser.c" /* yacc.c:1646 */ - break; - - case 2358: -#line 15509 "parser.y" /* yacc.c:1646 */ - { - emit_statement (cb_build_comment ("USE AT PROGRAM END")); - backup_current_pos (); - CB_PENDING ("USE AT PROGRAM END"); - /* emit_entry ("_AT_END", 0, NULL, NULL); */ - } -#line 25808 "parser.c" /* yacc.c:1646 */ - break; - - case 2359: -#line 15520 "parser.y" /* yacc.c:1646 */ - { - char *wrk; - cb_tree x; - struct cb_field *f; - struct cb_report *r; - - x = cb_ref ((yyvsp[0])); - if (!CB_FIELD_P (x)) { - cb_error_x ((yyvsp[0]), _("'%s' is not a report group"), CB_NAME ((yyvsp[0]))); - (yyval) = cb_error_node; - } else { - control_field = f = CB_FIELD (x); - f->report_decl_id = current_section->id; - if ((r = f->report) != NULL) { - r->has_declarative = 1; - } - } - wrk = cobc_main_malloc (COB_MINI_BUFF); - snprintf (wrk, COB_MINI_MAX, "USE BEFORE REPORTING %s is %s%d", - cb_name ((yyvsp[0])), CB_PREFIX_LABEL, current_section->id); - current_section->flag_real_label = 1; - current_section->flag_declaratives = 1; - current_section->flag_begin = 1; - current_section->flag_return = 1; - current_section->flag_declarative_exit = 1; - current_section->flag_real_label = 1; - current_section->flag_skip_label = 0; - emit_statement (cb_build_comment (wrk)); - } -#line 25842 "parser.c" /* yacc.c:1646 */ - break; - - case 2362: -#line 15558 "parser.y" /* yacc.c:1646 */ - { - current_section->flag_real_label = 1; - emit_statement (cb_build_comment ("USE AFTER EXCEPTION CONDITION")); - CB_PENDING ("USE AFTER EXCEPTION CONDITION"); - } -#line 25852 "parser.c" /* yacc.c:1646 */ - break; - - case 2363: -#line 15564 "parser.y" /* yacc.c:1646 */ - { - cb_tree l; - - for (l = (yyvsp[0]); l; l = CB_CHAIN (l)) { - if (CB_VALID_TREE (CB_VALUE (l))) { - setup_use_file (CB_FILE (cb_ref (CB_VALUE (l)))); - } - } - current_section->flag_real_label = 1; - emit_statement(cb_build_comment("USE AFTER EXCEPTION CONDITION")); - CB_PENDING("USE AFTER EXCEPTION CONDITION"); - } -#line 25869 "parser.c" /* yacc.c:1646 */ - break; - - case 2366: -#line 15587 "parser.y" /* yacc.c:1646 */ - { - begin_statement ("WRITE", TERM_WRITE); - /* Special in debugging mode */ - save_debug = start_debug; - start_debug = 0; - } -#line 25880 "parser.c" /* yacc.c:1646 */ - break; - - case 2368: -#line 15599 "parser.y" /* yacc.c:1646 */ - { - if (CB_VALID_TREE ((yyvsp[-5]))) { - cb_emit_write ((yyvsp[-5]), (yyvsp[-4]), (yyvsp[-3]), (yyvsp[-1])); - } - start_debug = save_debug; - } -#line 25891 "parser.c" /* yacc.c:1646 */ - break; - - case 2369: -#line 15608 "parser.y" /* yacc.c:1646 */ - { (yyval) = NULL; } -#line 25897 "parser.c" /* yacc.c:1646 */ - break; - - case 2370: -#line 15609 "parser.y" /* yacc.c:1646 */ - { (yyval) = (yyvsp[0]); } -#line 25903 "parser.c" /* yacc.c:1646 */ - break; - - case 2371: -#line 15614 "parser.y" /* yacc.c:1646 */ - { - (yyval) = cb_int0; - } -#line 25911 "parser.c" /* yacc.c:1646 */ - break; - - case 2372: -#line 15618 "parser.y" /* yacc.c:1646 */ - { - (yyval) = cb_build_write_advancing_lines ((yyvsp[-3]), (yyvsp[-1])); - } -#line 25919 "parser.c" /* yacc.c:1646 */ - break; - - case 2373: -#line 15622 "parser.y" /* yacc.c:1646 */ - { - (yyval) = cb_build_write_advancing_mnemonic ((yyvsp[-2]), (yyvsp[0])); - } -#line 25927 "parser.c" /* yacc.c:1646 */ - break; - - case 2374: -#line 15626 "parser.y" /* yacc.c:1646 */ - { - (yyval) = cb_build_write_advancing_page ((yyvsp[-2])); - } -#line 25935 "parser.c" /* yacc.c:1646 */ - break; - - case 2375: -#line 15632 "parser.y" /* yacc.c:1646 */ - { (yyval) = CB_BEFORE; } -#line 25941 "parser.c" /* yacc.c:1646 */ - break; - - case 2376: -#line 15633 "parser.y" /* yacc.c:1646 */ - { (yyval) = CB_AFTER; } -#line 25947 "parser.c" /* yacc.c:1646 */ - break; - - case 2380: -#line 15644 "parser.y" /* yacc.c:1646 */ - { - TERMINATOR_WARNING ((yyvsp[(-2) - (0)]), WRITE); - } -#line 25955 "parser.c" /* yacc.c:1646 */ - break; - - case 2381: -#line 15648 "parser.y" /* yacc.c:1646 */ - { - TERMINATOR_CLEAR ((yyvsp[(-2) - (1)]), WRITE); - } -#line 25963 "parser.c" /* yacc.c:1646 */ - break; - - case 2382: -#line 15657 "parser.y" /* yacc.c:1646 */ - { - begin_statement ("XML GENERATE", TERM_XML); - cobc_in_xml_generate_body = 1; - cobc_cs_check = CB_CS_XML_GENERATE; - } -#line 25973 "parser.c" /* yacc.c:1646 */ - break; - - case 2384: -#line 15669 "parser.y" /* yacc.c:1646 */ - { - xml_encoding = NULL; - with_xml_dec = 0; - with_attrs = 0; - ml_suppress_list = NULL; - } -#line 25984 "parser.c" /* yacc.c:1646 */ - break; - - case 2385: -#line 15680 "parser.y" /* yacc.c:1646 */ - { - cobc_in_xml_generate_body = 0; - cobc_cs_check = 0; - } -#line 25993 "parser.c" /* yacc.c:1646 */ - break; - - case 2386: -#line 15685 "parser.y" /* yacc.c:1646 */ - { - cb_emit_xml_generate ((yyvsp[-11]), (yyvsp[-9]), (yyvsp[-8]), xml_encoding, with_xml_dec, - with_attrs, (yyvsp[-5]), (yyvsp[-4]), (yyvsp[-3]), ml_suppress_list); - } -#line 26002 "parser.c" /* yacc.c:1646 */ - break; - - case 2392: -#line 15707 "parser.y" /* yacc.c:1646 */ - { - xml_encoding = (yyvsp[0]); - if (with_xml_dec) { - cb_error (_("ENCODING clause must come before XML-DECLARATION")); - } else if (with_attrs) { - cb_error (_("ENCODING clause must come before ATTRIBUTES")); - } - cb_verify (cb_xml_generate_extra_phrases, - _("XML GENERATE ENCODING clause")); - CB_PENDING ("XML GENERATE ENCODING"); - } -#line 26018 "parser.c" /* yacc.c:1646 */ - break; - - case 2393: -#line 15719 "parser.y" /* yacc.c:1646 */ - { - with_xml_dec = 1; - if (with_attrs) { - cb_error (_("XML-DECLARATION clause must come before ATTRIBUTES")); - } - cb_verify (cb_xml_generate_extra_phrases, - _("XML GENERATE XML-DECLARATION clause")); - } -#line 26031 "parser.c" /* yacc.c:1646 */ - break; - - case 2394: -#line 15728 "parser.y" /* yacc.c:1646 */ - { - with_attrs = 1; - cb_verify (cb_xml_generate_extra_phrases, - _("XML GENERATE WITH ATTRIBUTES clause")); - } -#line 26041 "parser.c" /* yacc.c:1646 */ - break; - - case 2395: -#line 15737 "parser.y" /* yacc.c:1646 */ - { - (yyval) = NULL; - } -#line 26049 "parser.c" /* yacc.c:1646 */ - break; - - case 2396: -#line 15741 "parser.y" /* yacc.c:1646 */ - { - (yyval) = CB_BUILD_PAIR ((yyvsp[-1]), (yyvsp[0])); - cb_verify (cb_xml_generate_extra_phrases, - _("XML GENERATE NAMESPACE clause")); - } -#line 26059 "parser.c" /* yacc.c:1646 */ - break; - - case 2397: -#line 15750 "parser.y" /* yacc.c:1646 */ - { - (yyval) = cb_null; - } -#line 26067 "parser.c" /* yacc.c:1646 */ - break; - - case 2398: -#line 15754 "parser.y" /* yacc.c:1646 */ - { - (yyval) = (yyvsp[0]); - } -#line 26075 "parser.c" /* yacc.c:1646 */ - break; - - case 2399: -#line 15761 "parser.y" /* yacc.c:1646 */ - { - (yyval) = NULL; - } -#line 26083 "parser.c" /* yacc.c:1646 */ - break; - - case 2400: -#line 15765 "parser.y" /* yacc.c:1646 */ - { - (yyval) = (yyvsp[0]); - cb_verify (cb_xml_generate_extra_phrases, - _("XML GENERATE NAME OF clause")); - } -#line 26093 "parser.c" /* yacc.c:1646 */ - break; - - case 2401: -#line 15774 "parser.y" /* yacc.c:1646 */ - { - (yyval) = CB_LIST_INIT ((yyvsp[0])); - } -#line 26101 "parser.c" /* yacc.c:1646 */ - break; - - case 2402: -#line 15778 "parser.y" /* yacc.c:1646 */ - { - (yyval) = cb_list_add ((yyvsp[-1]), (yyvsp[0])); - } -#line 26109 "parser.c" /* yacc.c:1646 */ - break; - - case 2403: -#line 15785 "parser.y" /* yacc.c:1646 */ - { - (yyval) = CB_BUILD_PAIR ((yyvsp[-2]), (yyvsp[0])); - } -#line 26117 "parser.c" /* yacc.c:1646 */ - break; - - case 2404: -#line 15792 "parser.y" /* yacc.c:1646 */ - { - (yyval) = NULL; - } -#line 26125 "parser.c" /* yacc.c:1646 */ - break; - - case 2405: -#line 15796 "parser.y" /* yacc.c:1646 */ - { - (yyval) = (yyvsp[0]); - cb_verify (cb_xml_generate_extra_phrases, - _("XML GENERATE TYPE OF clause")); - } -#line 26135 "parser.c" /* yacc.c:1646 */ - break; - - case 2406: -#line 15805 "parser.y" /* yacc.c:1646 */ - { - (yyval) = CB_LIST_INIT ((yyvsp[0])); - } -#line 26143 "parser.c" /* yacc.c:1646 */ - break; - - case 2407: -#line 15809 "parser.y" /* yacc.c:1646 */ - { - (yyval) = cb_list_add ((yyvsp[-1]), (yyvsp[0])); - } -#line 26151 "parser.c" /* yacc.c:1646 */ - break; - - case 2408: -#line 15816 "parser.y" /* yacc.c:1646 */ - { - (yyval) = CB_BUILD_PAIR ((yyvsp[-2]), (yyvsp[0])); - } -#line 26159 "parser.c" /* yacc.c:1646 */ - break; - - case 2409: -#line 15823 "parser.y" /* yacc.c:1646 */ - { - (yyval) = cb_int ((int) CB_ML_ANY_TYPE); - } -#line 26167 "parser.c" /* yacc.c:1646 */ - break; - - case 2411: -#line 15830 "parser.y" /* yacc.c:1646 */ - { (yyval) = cb_int ((int) CB_ML_ATTRIBUTE); } -#line 26173 "parser.c" /* yacc.c:1646 */ - break; - - case 2412: -#line 15831 "parser.y" /* yacc.c:1646 */ - { (yyval) = cb_int ((int) CB_ML_ELEMENT); } -#line 26179 "parser.c" /* yacc.c:1646 */ - break; - - case 2413: -#line 15832 "parser.y" /* yacc.c:1646 */ - { (yyval) = cb_int ((int) CB_ML_CONTENT); } -#line 26185 "parser.c" /* yacc.c:1646 */ - break; - - case 2415: -#line 15838 "parser.y" /* yacc.c:1646 */ - { - cb_verify (cb_xml_generate_extra_phrases, - _("XML GENERATE SUPPRESS clause")); - } -#line 26194 "parser.c" /* yacc.c:1646 */ - break; - - case 2418: -#line 15851 "parser.y" /* yacc.c:1646 */ - { - error_if_following_every_clause (); - add_identifier_to_ml_suppress_conds ((yyvsp[0])); - } -#line 26203 "parser.c" /* yacc.c:1646 */ - break; - - case 2419: -#line 15856 "parser.y" /* yacc.c:1646 */ - { - error_if_following_every_clause (); - add_type_to_ml_suppress_conds (ml_suppress_category, (enum cb_ml_type) CB_INTEGER ((yyvsp[0]))->val); - } -#line 26212 "parser.c" /* yacc.c:1646 */ - break; - - case 2420: -#line 15861 "parser.y" /* yacc.c:1646 */ - { - add_when_to_ml_suppress_conds ((yyvsp[0])); - } -#line 26220 "parser.c" /* yacc.c:1646 */ - break; - - case 2421: -#line 15868 "parser.y" /* yacc.c:1646 */ - { - ml_suppress_category = CB_ML_SUPPRESS_CAT_NUMERIC; - (yyval) = (yyvsp[0]); - } -#line 26229 "parser.c" /* yacc.c:1646 */ - break; - - case 2422: -#line 15873 "parser.y" /* yacc.c:1646 */ - { - ml_suppress_category = CB_ML_SUPPRESS_CAT_NONNUMERIC; - (yyval) = (yyvsp[0]); - } -#line 26238 "parser.c" /* yacc.c:1646 */ - break; - - case 2423: -#line 15878 "parser.y" /* yacc.c:1646 */ - { - ml_suppress_category = CB_ML_SUPPRESS_CAT_ANY; - (yyval) = (yyvsp[0]); - } -#line 26247 "parser.c" /* yacc.c:1646 */ - break; - - case 2424: -#line 15886 "parser.y" /* yacc.c:1646 */ - { - (yyval) = CB_LIST_INIT ((yyvsp[0])); - } -#line 26255 "parser.c" /* yacc.c:1646 */ - break; - - case 2425: -#line 15890 "parser.y" /* yacc.c:1646 */ - { - (yyval) = cb_list_add ((yyvsp[-2]), (yyvsp[0])); - } -#line 26263 "parser.c" /* yacc.c:1646 */ - break; - - case 2426: -#line 15897 "parser.y" /* yacc.c:1646 */ - { - TERMINATOR_WARNING ((yyvsp[(-2) - (0)]), XML); - } -#line 26271 "parser.c" /* yacc.c:1646 */ - break; - - case 2427: -#line 15901 "parser.y" /* yacc.c:1646 */ - { - TERMINATOR_CLEAR ((yyvsp[(-2) - (1)]), XML); - } -#line 26279 "parser.c" /* yacc.c:1646 */ - break; - - case 2428: -#line 15911 "parser.y" /* yacc.c:1646 */ - { - begin_statement ("XML PARSE", TERM_XML); - /* TO-DO: Add xml-parse and xml-parse-extra-phrases config options. */ - CB_PENDING (_("XML PARSE")); - cobc_cs_check = CB_CS_XML_PARSE; - } -#line 26290 "parser.c" /* yacc.c:1646 */ - break; - - case 2430: -#line 15927 "parser.y" /* yacc.c:1646 */ - { - cobc_cs_check = 0; - } -#line 26298 "parser.c" /* yacc.c:1646 */ - break; - - case 2439: -#line 15951 "parser.y" /* yacc.c:1646 */ - { - if (CB_FILE_P (cb_ref ((yyvsp[0])))) { - (yyval) = (yyvsp[0]); - } else { - cb_error_x ((yyvsp[0]), _("'%s' is not a file name"), CB_NAME ((yyvsp[0]))); - (yyval) = cb_error_node; - } - } -#line 26311 "parser.c" /* yacc.c:1646 */ - break; - - case 2442: -#line 15969 "parser.y" /* yacc.c:1646 */ - { - if ((yyvsp[0])) { - cb_verify (cb_not_exception_before_exception, - _("NOT EXCEPTION before EXCEPTION")); - } - } -#line 26322 "parser.c" /* yacc.c:1646 */ - break; - - case 2443: -#line 15979 "parser.y" /* yacc.c:1646 */ - { - (yyval) = NULL; - } -#line 26330 "parser.c" /* yacc.c:1646 */ - break; - - case 2444: -#line 15983 "parser.y" /* yacc.c:1646 */ - { - (yyval) = cb_int1; - } -#line 26338 "parser.c" /* yacc.c:1646 */ - break; - - case 2445: -#line 15990 "parser.y" /* yacc.c:1646 */ - { - current_statement->handler_type = ACCEPT_HANDLER; - current_statement->ex_handler = (yyvsp[0]); - } -#line 26347 "parser.c" /* yacc.c:1646 */ - break; - - case 2450: -#line 16008 "parser.y" /* yacc.c:1646 */ - { - current_statement->handler_type = ACCEPT_HANDLER; - current_statement->not_ex_handler = (yyvsp[0]); - } -#line 26356 "parser.c" /* yacc.c:1646 */ - break; - - case 2455: -#line 16024 "parser.y" /* yacc.c:1646 */ - { - if ((yyvsp[0])) { - cb_verify (cb_not_exception_before_exception, - _("NOT EXCEPTION before EXCEPTION")); - } - } -#line 26367 "parser.c" /* yacc.c:1646 */ - break; - - case 2456: -#line 16034 "parser.y" /* yacc.c:1646 */ - { - (yyval) = NULL; - } -#line 26375 "parser.c" /* yacc.c:1646 */ - break; - - case 2457: -#line 16038 "parser.y" /* yacc.c:1646 */ - { - (yyval) = cb_int1; - } -#line 26383 "parser.c" /* yacc.c:1646 */ - break; - - case 2458: -#line 16045 "parser.y" /* yacc.c:1646 */ - { - current_statement->handler_type = DISPLAY_HANDLER; - current_statement->ex_handler = (yyvsp[0]); - } -#line 26392 "parser.c" /* yacc.c:1646 */ - break; - - case 2461: -#line 16058 "parser.y" /* yacc.c:1646 */ - { - current_statement->handler_type = DISPLAY_HANDLER; - current_statement->not_ex_handler = (yyvsp[0]); - } -#line 26401 "parser.c" /* yacc.c:1646 */ - break; - - case 2464: -#line 16068 "parser.y" /* yacc.c:1646 */ - { - if ((yyvsp[0])) { - cb_verify (cb_not_exception_before_exception, - _("NOT EXCEPTION before EXCEPTION")); - } - } -#line 26412 "parser.c" /* yacc.c:1646 */ - break; - - case 2465: -#line 16078 "parser.y" /* yacc.c:1646 */ - { - (yyval) = NULL; - } -#line 26420 "parser.c" /* yacc.c:1646 */ - break; - - case 2466: -#line 16082 "parser.y" /* yacc.c:1646 */ - { - (yyval) = cb_int1; - } -#line 26428 "parser.c" /* yacc.c:1646 */ - break; - - case 2467: -#line 16089 "parser.y" /* yacc.c:1646 */ - { - current_statement->handler_type = XML_HANDLER; - current_statement->ex_handler = (yyvsp[0]); - } -#line 26437 "parser.c" /* yacc.c:1646 */ - break; - - case 2470: -#line 16102 "parser.y" /* yacc.c:1646 */ - { - current_statement->handler_type = XML_HANDLER; - current_statement->not_ex_handler = (yyvsp[0]); - } -#line 26446 "parser.c" /* yacc.c:1646 */ - break; - - case 2473: -#line 16112 "parser.y" /* yacc.c:1646 */ - { - if ((yyvsp[0])) { - cb_verify (cb_not_exception_before_exception, - _("NOT EXCEPTION before EXCEPTION")); - } - } -#line 26457 "parser.c" /* yacc.c:1646 */ - break; - - case 2474: -#line 16122 "parser.y" /* yacc.c:1646 */ - { - (yyval) = NULL; - } -#line 26465 "parser.c" /* yacc.c:1646 */ - break; - - case 2475: -#line 16126 "parser.y" /* yacc.c:1646 */ - { - (yyval) = cb_int1; - } -#line 26473 "parser.c" /* yacc.c:1646 */ - break; - - case 2476: -#line 16133 "parser.y" /* yacc.c:1646 */ - { - current_statement->handler_type = JSON_HANDLER; - current_statement->ex_handler = (yyvsp[0]); - } -#line 26482 "parser.c" /* yacc.c:1646 */ - break; - - case 2479: -#line 16146 "parser.y" /* yacc.c:1646 */ - { - current_statement->handler_type = JSON_HANDLER; - current_statement->not_ex_handler = (yyvsp[0]); - } -#line 26491 "parser.c" /* yacc.c:1646 */ - break; - - case 2482: -#line 16158 "parser.y" /* yacc.c:1646 */ - { - if ((yyvsp[0])) { - cb_verify (cb_not_exception_before_exception, - _("NOT SIZE ERROR before SIZE ERROR")); - } - } -#line 26502 "parser.c" /* yacc.c:1646 */ - break; - - case 2483: -#line 16168 "parser.y" /* yacc.c:1646 */ - { - (yyval) = NULL; - } -#line 26510 "parser.c" /* yacc.c:1646 */ - break; - - case 2484: -#line 16172 "parser.y" /* yacc.c:1646 */ - { - (yyval) = cb_int1; - } -#line 26518 "parser.c" /* yacc.c:1646 */ - break; - - case 2485: -#line 16179 "parser.y" /* yacc.c:1646 */ - { - current_statement->handler_type = SIZE_ERROR_HANDLER; - current_statement->ex_handler = (yyvsp[0]); - } -#line 26527 "parser.c" /* yacc.c:1646 */ - break; - - case 2488: -#line 16192 "parser.y" /* yacc.c:1646 */ - { - current_statement->handler_type = SIZE_ERROR_HANDLER; - current_statement->not_ex_handler = (yyvsp[0]); - } -#line 26536 "parser.c" /* yacc.c:1646 */ - break; - - case 2491: -#line 16204 "parser.y" /* yacc.c:1646 */ - { - if ((yyvsp[0])) { - cb_verify (cb_not_exception_before_exception, - _("NOT OVERFLOW before OVERFLOW")); - } - } -#line 26547 "parser.c" /* yacc.c:1646 */ - break; - - case 2492: -#line 16214 "parser.y" /* yacc.c:1646 */ - { - (yyval) = NULL; - } -#line 26555 "parser.c" /* yacc.c:1646 */ - break; - - case 2493: -#line 16218 "parser.y" /* yacc.c:1646 */ - { - (yyval) = cb_int1; - } -#line 26563 "parser.c" /* yacc.c:1646 */ - break; - - case 2494: -#line 16225 "parser.y" /* yacc.c:1646 */ - { - current_statement->handler_type = OVERFLOW_HANDLER; - current_statement->ex_handler = (yyvsp[0]); - } -#line 26572 "parser.c" /* yacc.c:1646 */ - break; - - case 2497: -#line 16238 "parser.y" /* yacc.c:1646 */ - { - current_statement->handler_type = OVERFLOW_HANDLER; - current_statement->not_ex_handler = (yyvsp[0]); - } -#line 26581 "parser.c" /* yacc.c:1646 */ - break; - - case 2499: -#line 16250 "parser.y" /* yacc.c:1646 */ - { - cb_verify (cb_not_exception_before_exception, "NOT AT END before AT END"); - } -#line 26589 "parser.c" /* yacc.c:1646 */ - break; - - case 2501: -#line 16259 "parser.y" /* yacc.c:1646 */ - { - if ((yyvsp[0])) { - cb_verify (cb_not_exception_before_exception, "NOT AT END before AT END"); - } - } -#line 26599 "parser.c" /* yacc.c:1646 */ - break; - - case 2502: -#line 16268 "parser.y" /* yacc.c:1646 */ - { - (yyval) = NULL; - } -#line 26607 "parser.c" /* yacc.c:1646 */ - break; - - case 2503: -#line 16272 "parser.y" /* yacc.c:1646 */ - { - (yyval) = cb_int1; - } -#line 26615 "parser.c" /* yacc.c:1646 */ - break; - - case 2504: -#line 16279 "parser.y" /* yacc.c:1646 */ - { - current_statement->handler_type = AT_END_HANDLER; - current_statement->ex_handler = (yyvsp[0]); - } -#line 26624 "parser.c" /* yacc.c:1646 */ - break; - - case 2507: -#line 16292 "parser.y" /* yacc.c:1646 */ - { - current_statement->handler_type = AT_END_HANDLER; - current_statement->not_ex_handler = (yyvsp[0]); - } -#line 26633 "parser.c" /* yacc.c:1646 */ - break; - - case 2509: -#line 16303 "parser.y" /* yacc.c:1646 */ - { - if ((yyvsp[0])) { - cb_verify (cb_not_exception_before_exception, - _("NOT AT END-OF-PAGE before AT END-OF-PAGE")); - } - } -#line 26644 "parser.c" /* yacc.c:1646 */ - break; - - case 2510: -#line 16313 "parser.y" /* yacc.c:1646 */ - { - (yyval) = NULL; - } -#line 26652 "parser.c" /* yacc.c:1646 */ - break; - - case 2511: -#line 16317 "parser.y" /* yacc.c:1646 */ - { - (yyval) = cb_int1; - } -#line 26660 "parser.c" /* yacc.c:1646 */ - break; - - case 2512: -#line 16324 "parser.y" /* yacc.c:1646 */ - { - current_statement->handler_type = EOP_HANDLER; - current_statement->ex_handler = (yyvsp[0]); - } -#line 26669 "parser.c" /* yacc.c:1646 */ - break; - - case 2515: -#line 16337 "parser.y" /* yacc.c:1646 */ - { - current_statement->handler_type = EOP_HANDLER; - current_statement->not_ex_handler = (yyvsp[0]); - } -#line 26678 "parser.c" /* yacc.c:1646 */ - break; - - case 2519: -#line 16353 "parser.y" /* yacc.c:1646 */ - { - if ((yyvsp[0])) { - cb_verify (cb_not_exception_before_exception, - _("NOT INVALID KEY before INVALID KEY")); - } - } -#line 26689 "parser.c" /* yacc.c:1646 */ - break; - - case 2520: -#line 16363 "parser.y" /* yacc.c:1646 */ - { - (yyval) = NULL; - } -#line 26697 "parser.c" /* yacc.c:1646 */ - break; - - case 2521: -#line 16367 "parser.y" /* yacc.c:1646 */ - { - (yyval) = cb_int1; - } -#line 26705 "parser.c" /* yacc.c:1646 */ - break; - - case 2522: -#line 16374 "parser.y" /* yacc.c:1646 */ - { - current_statement->handler_type = INVALID_KEY_HANDLER; - current_statement->ex_handler = (yyvsp[0]); - } -#line 26714 "parser.c" /* yacc.c:1646 */ - break; - - case 2525: -#line 16387 "parser.y" /* yacc.c:1646 */ - { - current_statement->handler_type = INVALID_KEY_HANDLER; - current_statement->not_ex_handler = (yyvsp[0]); - } -#line 26723 "parser.c" /* yacc.c:1646 */ - break; - - case 2526: -#line 16397 "parser.y" /* yacc.c:1646 */ - { - (yyval) = NULL; - } -#line 26731 "parser.c" /* yacc.c:1646 */ - break; - - case 2527: -#line 16401 "parser.y" /* yacc.c:1646 */ - { - (yyval) = cb_int1; - CB_PENDING ("THREAD"); - } -#line 26740 "parser.c" /* yacc.c:1646 */ - break; - - case 2528: -#line 16409 "parser.y" /* yacc.c:1646 */ - { - (yyval) = NULL; - } -#line 26748 "parser.c" /* yacc.c:1646 */ - break; - - case 2529: -#line 16413 "parser.y" /* yacc.c:1646 */ - { - (yyval) = (yyvsp[0]); - CB_PENDING ("THREAD"); - } -#line 26757 "parser.c" /* yacc.c:1646 */ - break; - - case 2530: -#line 16421 "parser.y" /* yacc.c:1646 */ - { - (yyval) = (yyvsp[0]); - } -#line 26765 "parser.c" /* yacc.c:1646 */ - break; - - case 2531: -#line 16425 "parser.y" /* yacc.c:1646 */ - { - (yyval) = NULL; - } -#line 26773 "parser.c" /* yacc.c:1646 */ - break; - - case 2532: -#line 16434 "parser.y" /* yacc.c:1646 */ - { - (yyval) = cb_one; - } -#line 26781 "parser.c" /* yacc.c:1646 */ - break; - - case 2533: -#line 16438 "parser.y" /* yacc.c:1646 */ - { - (yyval) = (yyvsp[-1]); - } -#line 26789 "parser.c" /* yacc.c:1646 */ - break; - - case 2534: -#line 16444 "parser.y" /* yacc.c:1646 */ - { (yyval) = NULL; } -#line 26795 "parser.c" /* yacc.c:1646 */ - break; - - case 2535: -#line 16445 "parser.y" /* yacc.c:1646 */ - { (yyval) = (yyvsp[0]); } -#line 26801 "parser.c" /* yacc.c:1646 */ - break; - - case 2536: -#line 16452 "parser.y" /* yacc.c:1646 */ - { - (yyval) = cb_build_cond ((yyvsp[0])); - cb_end_cond ((yyval)); - } -#line 26810 "parser.c" /* yacc.c:1646 */ - break; - - case 2537: -#line 16457 "parser.y" /* yacc.c:1646 */ - { - (yyval) = cb_error_node; - cb_end_cond ((yyval)); - } -#line 26819 "parser.c" /* yacc.c:1646 */ - break; - - case 2538: -#line 16465 "parser.y" /* yacc.c:1646 */ - { - (yyval) = cb_build_expr ((yyvsp[0])); - } -#line 26827 "parser.c" /* yacc.c:1646 */ - break; - - case 2539: -#line 16471 "parser.y" /* yacc.c:1646 */ - { - current_expr = NULL; - cb_exp_line = cb_source_line; - } -#line 26836 "parser.c" /* yacc.c:1646 */ - break; - - case 2540: -#line 16476 "parser.y" /* yacc.c:1646 */ - { - (yyval) = cb_list_reverse (current_expr); - } -#line 26844 "parser.c" /* yacc.c:1646 */ - break; - - case 2543: -#line 16487 "parser.y" /* yacc.c:1646 */ - { push_expr ('x', (yyvsp[0])); } -#line 26850 "parser.c" /* yacc.c:1646 */ - break; - - case 2546: -#line 16492 "parser.y" /* yacc.c:1646 */ - { push_expr ('x', cb_zero); } -#line 26856 "parser.c" /* yacc.c:1646 */ - break; - - case 2547: -#line 16494 "parser.y" /* yacc.c:1646 */ - { push_expr ('(', NULL); } -#line 26862 "parser.c" /* yacc.c:1646 */ - break; - - case 2548: -#line 16495 "parser.y" /* yacc.c:1646 */ - { push_expr (')', NULL); } -#line 26868 "parser.c" /* yacc.c:1646 */ - break; - - case 2549: -#line 16497 "parser.y" /* yacc.c:1646 */ - { push_expr ('+', NULL); } -#line 26874 "parser.c" /* yacc.c:1646 */ - break; - - case 2550: -#line 16498 "parser.y" /* yacc.c:1646 */ - { push_expr ('-', NULL); } -#line 26880 "parser.c" /* yacc.c:1646 */ - break; - - case 2551: -#line 16499 "parser.y" /* yacc.c:1646 */ - { push_expr ('*', NULL); } -#line 26886 "parser.c" /* yacc.c:1646 */ - break; - - case 2552: -#line 16500 "parser.y" /* yacc.c:1646 */ - { push_expr ('/', NULL); } -#line 26892 "parser.c" /* yacc.c:1646 */ - break; - - case 2553: -#line 16501 "parser.y" /* yacc.c:1646 */ - { push_expr ('^', NULL); } -#line 26898 "parser.c" /* yacc.c:1646 */ - break; - - case 2555: -#line 16504 "parser.y" /* yacc.c:1646 */ - { push_expr ('&', NULL); } -#line 26904 "parser.c" /* yacc.c:1646 */ - break; - - case 2556: -#line 16505 "parser.y" /* yacc.c:1646 */ - { push_expr ('|', NULL); } -#line 26910 "parser.c" /* yacc.c:1646 */ - break; - - case 2559: -#line 16514 "parser.y" /* yacc.c:1646 */ - { push_expr ('!', NULL); } -#line 26916 "parser.c" /* yacc.c:1646 */ - break; - - case 2560: -#line 16517 "parser.y" /* yacc.c:1646 */ - { push_expr ('C', (yyvsp[0])); } -#line 26922 "parser.c" /* yacc.c:1646 */ - break; - - case 2561: -#line 16519 "parser.y" /* yacc.c:1646 */ - { push_expr ('=', NULL); } -#line 26928 "parser.c" /* yacc.c:1646 */ - break; - - case 2562: -#line 16520 "parser.y" /* yacc.c:1646 */ - { push_expr ('>', NULL); } -#line 26934 "parser.c" /* yacc.c:1646 */ - break; - - case 2563: -#line 16521 "parser.y" /* yacc.c:1646 */ - { push_expr ('<', NULL); } -#line 26940 "parser.c" /* yacc.c:1646 */ - break; - - case 2564: -#line 16522 "parser.y" /* yacc.c:1646 */ - { push_expr (']', NULL); } -#line 26946 "parser.c" /* yacc.c:1646 */ - break; - - case 2565: -#line 16523 "parser.y" /* yacc.c:1646 */ - { push_expr ('[', NULL); } -#line 26952 "parser.c" /* yacc.c:1646 */ - break; - - case 2566: -#line 16524 "parser.y" /* yacc.c:1646 */ - { push_expr ('~', NULL); } -#line 26958 "parser.c" /* yacc.c:1646 */ - break; - - case 2567: -#line 16526 "parser.y" /* yacc.c:1646 */ - { push_expr ('O', NULL); } -#line 26964 "parser.c" /* yacc.c:1646 */ - break; - - case 2568: -#line 16527 "parser.y" /* yacc.c:1646 */ - { push_expr ('9', NULL); } -#line 26970 "parser.c" /* yacc.c:1646 */ - break; - - case 2569: -#line 16528 "parser.y" /* yacc.c:1646 */ - { push_expr ('A', NULL); } -#line 26976 "parser.c" /* yacc.c:1646 */ - break; - - case 2570: -#line 16529 "parser.y" /* yacc.c:1646 */ - { push_expr ('L', NULL); } -#line 26982 "parser.c" /* yacc.c:1646 */ - break; - - case 2571: -#line 16530 "parser.y" /* yacc.c:1646 */ - { push_expr ('U', NULL); } -#line 26988 "parser.c" /* yacc.c:1646 */ - break; - - case 2572: -#line 16533 "parser.y" /* yacc.c:1646 */ - { push_expr ('P', NULL); } -#line 26994 "parser.c" /* yacc.c:1646 */ - break; - - case 2573: -#line 16534 "parser.y" /* yacc.c:1646 */ - { push_expr ('N', NULL); } -#line 27000 "parser.c" /* yacc.c:1646 */ - break; - - case 2582: -#line 16564 "parser.y" /* yacc.c:1646 */ - { - (yyval) = CB_LIST_INIT ((yyvsp[0])); - } -#line 27008 "parser.c" /* yacc.c:1646 */ - break; - - case 2583: -#line 16568 "parser.y" /* yacc.c:1646 */ - { - (yyval) = cb_list_add ((yyvsp[-2]), (yyvsp[0])); - } -#line 27016 "parser.c" /* yacc.c:1646 */ - break; - - case 2587: -#line 16580 "parser.y" /* yacc.c:1646 */ - { (yyval) = cb_build_binary_op ((yyvsp[-2]), '+', (yyvsp[0])); } -#line 27022 "parser.c" /* yacc.c:1646 */ - break; - - case 2588: -#line 16581 "parser.y" /* yacc.c:1646 */ - { (yyval) = cb_build_binary_op ((yyvsp[-2]), '-', (yyvsp[0])); } -#line 27028 "parser.c" /* yacc.c:1646 */ - break; - - case 2589: -#line 16582 "parser.y" /* yacc.c:1646 */ - { (yyval) = (yyvsp[0]); } -#line 27034 "parser.c" /* yacc.c:1646 */ - break; - - case 2590: -#line 16586 "parser.y" /* yacc.c:1646 */ - { (yyval) = cb_build_binary_op ((yyvsp[-2]), '*', (yyvsp[0])); } -#line 27040 "parser.c" /* yacc.c:1646 */ - break; - - case 2591: -#line 16587 "parser.y" /* yacc.c:1646 */ - { (yyval) = cb_build_binary_op ((yyvsp[-2]), '/', (yyvsp[0])); } -#line 27046 "parser.c" /* yacc.c:1646 */ - break; - - case 2592: -#line 16588 "parser.y" /* yacc.c:1646 */ - { (yyval) = (yyvsp[0]); } -#line 27052 "parser.c" /* yacc.c:1646 */ - break; - - case 2593: -#line 16593 "parser.y" /* yacc.c:1646 */ - { - (yyval) = cb_build_binary_op ((yyvsp[-2]), '^', (yyvsp[0])); - } -#line 27060 "parser.c" /* yacc.c:1646 */ - break; - - case 2594: -#line 16596 "parser.y" /* yacc.c:1646 */ - { (yyval) = (yyvsp[0]); } -#line 27066 "parser.c" /* yacc.c:1646 */ - break; - - case 2595: -#line 16600 "parser.y" /* yacc.c:1646 */ - { (yyval) = (yyvsp[0]); } -#line 27072 "parser.c" /* yacc.c:1646 */ - break; - - case 2596: -#line 16601 "parser.y" /* yacc.c:1646 */ - { (yyval) = cb_build_binary_op (cb_zero, '-', (yyvsp[0])); } -#line 27078 "parser.c" /* yacc.c:1646 */ - break; - - case 2597: -#line 16602 "parser.y" /* yacc.c:1646 */ - { (yyval) = (yyvsp[0]); } -#line 27084 "parser.c" /* yacc.c:1646 */ - break; - - case 2598: -#line 16605 "parser.y" /* yacc.c:1646 */ - { (yyval) = (yyvsp[-1]); } -#line 27090 "parser.c" /* yacc.c:1646 */ - break; - - case 2599: -#line 16606 "parser.y" /* yacc.c:1646 */ - { (yyval) = (yyvsp[0]); } -#line 27096 "parser.c" /* yacc.c:1646 */ - break; - - case 2600: -#line 16617 "parser.y" /* yacc.c:1646 */ - { - if (current_linage > 1) { - cb_error (_("LINAGE-COUNTER must be qualified here")); - (yyval) = cb_error_node; - } else if (current_linage == 0) { - cb_error (_("invalid LINAGE-COUNTER usage")); - (yyval) = cb_error_node; - } else { - (yyval) = linage_file->linage_ctr; - } - } -#line 27112 "parser.c" /* yacc.c:1646 */ - break; - - case 2601: -#line 16629 "parser.y" /* yacc.c:1646 */ - { - if (CB_FILE_P (cb_ref ((yyvsp[0])))) { - (yyval) = CB_FILE (cb_ref ((yyvsp[0])))->linage_ctr; - } else { - cb_error_x ((yyvsp[0]), _("'%s' is not a file name"), CB_NAME ((yyvsp[0]))); - (yyval) = cb_error_node; - } - } -#line 27125 "parser.c" /* yacc.c:1646 */ - break; - - case 2602: -#line 16638 "parser.y" /* yacc.c:1646 */ - { - if (report_count > 1) { - if (current_report != NULL) { - (yyval) = current_report->line_counter; - } else { - cb_error (_("LINE-COUNTER must be qualified here")); - (yyval) = cb_error_node; - } - } else if (report_count == 0) { - cb_error (_("invalid LINE-COUNTER usage")); - (yyval) = cb_error_node; - } else { - (yyval) = report_instance->line_counter; - } - } -#line 27145 "parser.c" /* yacc.c:1646 */ - break; - - case 2603: -#line 16654 "parser.y" /* yacc.c:1646 */ - { - if (CB_REF_OR_REPORT_P ((yyvsp[0]))) { - (yyval) = CB_REPORT_PTR ((yyvsp[0]))->line_counter; - } else { - cb_error_x ((yyvsp[0]), _("'%s' is not a report name"), CB_NAME ((yyvsp[0]))); - (yyval) = cb_error_node; - } - } -#line 27158 "parser.c" /* yacc.c:1646 */ - break; - - case 2604: -#line 16663 "parser.y" /* yacc.c:1646 */ - { - if (report_count > 1) { - if (current_report != NULL) { - (yyval) = current_report->page_counter; - } else { - cb_error (_("PAGE-COUNTER must be qualified here")); - (yyval) = cb_error_node; - } - } else if (report_count == 0) { - cb_error (_("invalid PAGE-COUNTER usage")); - (yyval) = cb_error_node; - } else { - (yyval) = report_instance->page_counter; - } - } -#line 27178 "parser.c" /* yacc.c:1646 */ - break; - - case 2605: -#line 16679 "parser.y" /* yacc.c:1646 */ - { - if (CB_REF_OR_REPORT_P ((yyvsp[0]))) { - (yyval) = CB_REPORT_PTR ((yyvsp[0]))->page_counter; - } else { - cb_error_x ((yyvsp[0]), _("'%s' is not a report name"), CB_NAME ((yyvsp[0]))); - (yyval) = cb_error_node; - } - } -#line 27191 "parser.c" /* yacc.c:1646 */ - break; - - case 2606: -#line 16693 "parser.y" /* yacc.c:1646 */ - { (yyval) = (yyvsp[0]); } -#line 27197 "parser.c" /* yacc.c:1646 */ - break; - - case 2607: -#line 16695 "parser.y" /* yacc.c:1646 */ - { (yyval) = cb_list_append ((yyvsp[-1]), (yyvsp[0])); } -#line 27203 "parser.c" /* yacc.c:1646 */ - break; - - case 2608: -#line 16700 "parser.y" /* yacc.c:1646 */ - { - (yyval) = CB_BUILD_PAIR ((yyvsp[0]), (yyvsp[-1])); - } -#line 27211 "parser.c" /* yacc.c:1646 */ - break; - - case 2609: -#line 16708 "parser.y" /* yacc.c:1646 */ - { cb_build_identifier ((yyvsp[0]), 0); } -#line 27217 "parser.c" /* yacc.c:1646 */ - break; - - case 2610: -#line 16715 "parser.y" /* yacc.c:1646 */ - { - if (!CB_FILE_P (cb_ref ((yyvsp[0])))) { - (yyval) = (yyvsp[0]); - } else { - cb_error_x ((yyvsp[0]), _("%s requires a record name as subject"), - current_statement->name); - (yyval) = cb_error_node; - } - } -#line 27231 "parser.c" /* yacc.c:1646 */ - break; - - case 2611: -#line 16725 "parser.y" /* yacc.c:1646 */ - { - if (CB_FILE_P (cb_ref ((yyvsp[0])))) { - (yyval) = (yyvsp[0]); - } else { - cb_error_x ((yyvsp[0]), _("'%s' is not a file name"), CB_NAME ((yyvsp[0]))); - (yyval) = cb_error_node; - } - } -#line 27244 "parser.c" /* yacc.c:1646 */ - break; - - case 2612: -#line 16739 "parser.y" /* yacc.c:1646 */ - { - cb_tree x; - - x = cb_ref ((yyvsp[0])); - if (!CB_FIELD_P (x)) { - (yyval) = cb_error_node; - } else if (!CB_FIELD (x)->index_list) { - cb_error_x ((yyvsp[0]), _("'%s' not indexed"), cb_name ((yyvsp[0]))); - listprint_suppress (); - cb_error_x (x, _("'%s' defined here"), cb_name (x)); - listprint_restore (); - (yyval) = cb_error_node; - } else { - (yyval) = (yyvsp[0]); - } - } -#line 27265 "parser.c" /* yacc.c:1646 */ - break; - - case 2613: -#line 16761 "parser.y" /* yacc.c:1646 */ - { - (yyval) = CB_LIST_INIT ((yyvsp[0])); - } -#line 27273 "parser.c" /* yacc.c:1646 */ - break; - - case 2614: -#line 16765 "parser.y" /* yacc.c:1646 */ - { - cb_tree l; - - if (CB_VALID_TREE ((yyvsp[0]))) { - for (l = (yyvsp[-1]); l; l = CB_CHAIN (l)) { - if (CB_VALID_TREE (CB_VALUE (l)) && - !strcasecmp (CB_NAME ((yyvsp[0])), CB_NAME (CB_VALUE (l)))) { - cb_error_x ((yyvsp[0]), _("multiple reference to '%s' "), - CB_NAME ((yyvsp[0]))); - break; - } - } - if (!l) { - (yyval) = cb_list_add ((yyvsp[-1]), (yyvsp[0])); - } - } - } -#line 27295 "parser.c" /* yacc.c:1646 */ - break; - - case 2615: -#line 16786 "parser.y" /* yacc.c:1646 */ - { - (yyval) = CB_LIST_INIT ((yyvsp[0])); - } -#line 27303 "parser.c" /* yacc.c:1646 */ - break; - - case 2616: -#line 16790 "parser.y" /* yacc.c:1646 */ - { - cb_tree l; - - if (CB_VALID_TREE ((yyvsp[0]))) { - for (l = (yyvsp[-2]); l; l = CB_CHAIN (l)) { - if (CB_VALID_TREE (CB_VALUE (l)) && - !strcasecmp (CB_NAME ((yyvsp[0])), CB_NAME (CB_VALUE (l)))) { - cb_error_x ((yyvsp[0]), _("multiple reference to '%s' "), - CB_NAME ((yyvsp[-1]))); - break; - } - } - if (!l) { - (yyval) = cb_list_add ((yyvsp[-2]), (yyvsp[0])); - } - } - } -#line 27325 "parser.c" /* yacc.c:1646 */ - break; - - case 2617: -#line 16811 "parser.y" /* yacc.c:1646 */ - { - if (CB_FILE_P (cb_ref ((yyvsp[0])))) { - (yyval) = (yyvsp[0]); - } else { - cb_error_x ((yyvsp[0]), _("'%s' is not a file name"), CB_NAME ((yyvsp[0]))); - (yyval) = cb_error_node; - } - } -#line 27338 "parser.c" /* yacc.c:1646 */ - break; - - case 2618: -#line 16823 "parser.y" /* yacc.c:1646 */ - { - if (CB_CD_P (cb_ref ((yyvsp[0])))) { - (yyval) = (yyvsp[0]); - } else { - cb_error_x ((yyvsp[0]), _("'%s' is not a CD name"), CB_NAME ((yyvsp[0]))); - (yyval) = cb_error_node; - } - } -#line 27351 "parser.c" /* yacc.c:1646 */ - break; - - case 2619: -#line 16837 "parser.y" /* yacc.c:1646 */ - { - if (CB_REF_OR_REPORT_P ((yyvsp[0]))) { - (yyval) = (yyvsp[0]); - } else { - cb_error (_("'%s' is not a valid report name"), CB_NAME ((yyvsp[0]))); - (yyval) = cb_error_node; - } - } -#line 27364 "parser.c" /* yacc.c:1646 */ - break; - - case 2620: -#line 16850 "parser.y" /* yacc.c:1646 */ - { (yyval) = CB_LIST_INIT ((yyvsp[0])); } -#line 27370 "parser.c" /* yacc.c:1646 */ - break; - - case 2621: -#line 16852 "parser.y" /* yacc.c:1646 */ - { (yyval) = cb_list_add ((yyvsp[-1]), (yyvsp[0])); } -#line 27376 "parser.c" /* yacc.c:1646 */ - break; - - case 2622: -#line 16856 "parser.y" /* yacc.c:1646 */ - { (yyval) = (yyvsp[0]); } -#line 27382 "parser.c" /* yacc.c:1646 */ - break; - - case 2623: -#line 16862 "parser.y" /* yacc.c:1646 */ - { (yyval) = CB_LIST_INIT ((yyvsp[0])); } -#line 27388 "parser.c" /* yacc.c:1646 */ - break; - - case 2624: -#line 16864 "parser.y" /* yacc.c:1646 */ - { (yyval) = cb_list_add ((yyvsp[-1]), (yyvsp[0])); } -#line 27394 "parser.c" /* yacc.c:1646 */ - break; - - case 2625: -#line 16869 "parser.y" /* yacc.c:1646 */ - { - (yyval) = cb_build_reference ((char *)(CB_LITERAL ((yyvsp[0]))->data)); - } -#line 27402 "parser.c" /* yacc.c:1646 */ - break; - - case 2626: -#line 16878 "parser.y" /* yacc.c:1646 */ - { (yyval) = NULL; } -#line 27408 "parser.c" /* yacc.c:1646 */ - break; - - case 2627: -#line 16880 "parser.y" /* yacc.c:1646 */ - { (yyval) = cb_list_add ((yyvsp[-1]), (yyvsp[0])); } -#line 27414 "parser.c" /* yacc.c:1646 */ - break; - - case 2628: -#line 16885 "parser.y" /* yacc.c:1646 */ - { - struct cb_reference *r = CB_REFERENCE ((yyvsp[0])); - - r->offset = CB_TREE (current_section); - r->flag_in_decl = !!in_declaratives; - r->flag_ignored = cb_set_ignore_error (-1); - - (yyval) = (yyvsp[0]); - CB_ADD_TO_CHAIN ((yyvsp[0]), current_program->label_list); - } -#line 27429 "parser.c" /* yacc.c:1646 */ - break; - - case 2631: -#line 16901 "parser.y" /* yacc.c:1646 */ - { - CB_REFERENCE ((yyvsp[-2]))->chain = (yyvsp[0]); - } -#line 27437 "parser.c" /* yacc.c:1646 */ - break; - - case 2632: -#line 16908 "parser.y" /* yacc.c:1646 */ - { - (yyval) = cb_build_reference ((char *)(CB_LITERAL ((yyvsp[0]))->data)); - (yyval)->source_file = (yyvsp[0])->source_file; - (yyval)->source_line = (yyvsp[0])->source_line; - } -#line 27447 "parser.c" /* yacc.c:1646 */ - break; - - case 2633: -#line 16918 "parser.y" /* yacc.c:1646 */ - { (yyval) = CB_LIST_INIT ((yyvsp[0])); } -#line 27453 "parser.c" /* yacc.c:1646 */ - break; - - case 2634: -#line 16919 "parser.y" /* yacc.c:1646 */ - { (yyval) = cb_list_add ((yyvsp[-1]), (yyvsp[0])); } -#line 27459 "parser.c" /* yacc.c:1646 */ - break; - - case 2635: -#line 16924 "parser.y" /* yacc.c:1646 */ - { - (yyval) = (yyvsp[0]); - CB_ADD_TO_CHAIN ((yyval), current_program->reference_list); - } -#line 27468 "parser.c" /* yacc.c:1646 */ - break; - - case 2636: -#line 16931 "parser.y" /* yacc.c:1646 */ - {(yyval) = NULL;} -#line 27474 "parser.c" /* yacc.c:1646 */ - break; - - case 2637: -#line 16932 "parser.y" /* yacc.c:1646 */ - {(yyval) = (yyvsp[0]);} -#line 27480 "parser.c" /* yacc.c:1646 */ - break; - - case 2638: -#line 16936 "parser.y" /* yacc.c:1646 */ - { (yyval) = CB_LIST_INIT ((yyvsp[0])); } -#line 27486 "parser.c" /* yacc.c:1646 */ - break; - - case 2639: -#line 16937 "parser.y" /* yacc.c:1646 */ - { (yyval) = cb_list_add ((yyvsp[-1]), (yyvsp[0])); } -#line 27492 "parser.c" /* yacc.c:1646 */ - break; - - case 2640: -#line 16942 "parser.y" /* yacc.c:1646 */ - { - CB_ADD_TO_CHAIN ((yyvsp[0]), current_program->reference_list); - } -#line 27500 "parser.c" /* yacc.c:1646 */ - break; - - case 2641: -#line 16952 "parser.y" /* yacc.c:1646 */ - { - (yyval) = CB_LIST_INIT ((yyvsp[0])); - } -#line 27508 "parser.c" /* yacc.c:1646 */ - break; - - case 2642: -#line 16956 "parser.y" /* yacc.c:1646 */ - { - (yyval) = cb_list_add ((yyvsp[-1]), (yyvsp[0])); - } -#line 27516 "parser.c" /* yacc.c:1646 */ - break; - - case 2643: -#line 16963 "parser.y" /* yacc.c:1646 */ - { - (yyval) = (yyvsp[0]); - CB_REFERENCE((yyval))->flag_optional = 1; - CB_ADD_TO_CHAIN ((yyval), current_program->reference_list); - } -#line 27526 "parser.c" /* yacc.c:1646 */ - break; - - case 2646: -#line 16979 "parser.y" /* yacc.c:1646 */ - { - if (CB_WORD_COUNT ((yyvsp[0])) > 0) { - redefinition_error ((yyvsp[0])); - (yyval) = cb_error_node; - } else { - (yyval) = (yyvsp[0]); - } - } -#line 27539 "parser.c" /* yacc.c:1646 */ - break; - - case 2647: -#line 16988 "parser.y" /* yacc.c:1646 */ - { - yyclearin; - yyerrok; - (yyval) = cb_error_node; - } -#line 27549 "parser.c" /* yacc.c:1646 */ - break; - - case 2648: -#line 16999 "parser.y" /* yacc.c:1646 */ - { - if (CB_REFERENCE ((yyvsp[0]))->flag_duped || CB_WORD_COUNT ((yyvsp[0])) > 0) { - redefinition_error ((yyvsp[0])); - (yyval) = NULL; - } else { - CB_WORD_COUNT ((yyvsp[0]))++; - (yyval) = (yyvsp[0]); - } - } -#line 27563 "parser.c" /* yacc.c:1646 */ - break; - - case 2649: -#line 17016 "parser.y" /* yacc.c:1646 */ - { - (yyval) = CB_LIST_INIT ((yyvsp[0])); - } -#line 27571 "parser.c" /* yacc.c:1646 */ - break; - - case 2650: -#line 17020 "parser.y" /* yacc.c:1646 */ - { - (yyval) = cb_list_add ((yyvsp[-1]), (yyvsp[0])); - } -#line 27579 "parser.c" /* yacc.c:1646 */ - break; - - case 2653: -#line 17029 "parser.y" /* yacc.c:1646 */ - { - (yyval) = cb_build_address ((yyvsp[0])); - } -#line 27587 "parser.c" /* yacc.c:1646 */ - break; - - case 2654: -#line 17035 "parser.y" /* yacc.c:1646 */ - { (yyval) = NULL; } -#line 27593 "parser.c" /* yacc.c:1646 */ - break; - - case 2655: -#line 17036 "parser.y" /* yacc.c:1646 */ - { (yyval) = (yyvsp[0]); } -#line 27599 "parser.c" /* yacc.c:1646 */ - break; - - case 2656: -#line 17041 "parser.y" /* yacc.c:1646 */ - { - (yyval) = CB_LIST_INIT ((yyvsp[0])); - } -#line 27607 "parser.c" /* yacc.c:1646 */ - break; - - case 2657: -#line 17045 "parser.y" /* yacc.c:1646 */ - { - (yyval) = cb_list_add ((yyvsp[-1]), (yyvsp[0])); - } -#line 27615 "parser.c" /* yacc.c:1646 */ - break; - - case 2665: -#line 17065 "parser.y" /* yacc.c:1646 */ - { - (yyval) = cb_build_length ((yyvsp[0])); - } -#line 27623 "parser.c" /* yacc.c:1646 */ - break; - - case 2666: -#line 17069 "parser.y" /* yacc.c:1646 */ - { - (yyval) = cb_build_length ((yyvsp[0])); - } -#line 27631 "parser.c" /* yacc.c:1646 */ - break; - - case 2667: -#line 17073 "parser.y" /* yacc.c:1646 */ - { - (yyval) = cb_build_length ((yyvsp[0])); - } -#line 27639 "parser.c" /* yacc.c:1646 */ - break; - - case 2668: -#line 17077 "parser.y" /* yacc.c:1646 */ - { - (yyval) = cb_build_ppointer ((yyvsp[0])); - } -#line 27647 "parser.c" /* yacc.c:1646 */ - break; - - case 2669: -#line 17081 "parser.y" /* yacc.c:1646 */ - { - (yyval) = cb_build_address (check_not_88_level ((yyvsp[0]))); - } -#line 27655 "parser.c" /* yacc.c:1646 */ - break; - - case 2670: -#line 17085 "parser.y" /* yacc.c:1646 */ - { - cb_tree x; - cb_tree switch_id; - - x = cb_ref ((yyvsp[0])); - if (CB_VALID_TREE (x)) { - if (CB_SYSTEM_NAME (x)->category != CB_SWITCH_NAME) { - cb_error_x ((yyvsp[0]), _("invalid mnemonic identifier")); - (yyval) = cb_error_node; - } else { - switch_id = cb_int (CB_SYSTEM_NAME (x)->token); - (yyval) = CB_BUILD_FUNCALL_1 ("cob_switch_value", switch_id); - } - } else { - (yyval) = cb_error_node; - } - } -#line 27677 "parser.c" /* yacc.c:1646 */ - break; - - case 2671: -#line 17106 "parser.y" /* yacc.c:1646 */ - { - /* FIXME: check with "lookup_register ("LENGTH OF") != NULL" - if we actually want to do this, - otherwise raise an error "not defined in this dialect" - */ - } -#line 27688 "parser.c" /* yacc.c:1646 */ - break; - - case 2672: -#line 17116 "parser.y" /* yacc.c:1646 */ - { - (yyval) = CB_LIST_INIT ((yyvsp[0])); - } -#line 27696 "parser.c" /* yacc.c:1646 */ - break; - - case 2673: -#line 17120 "parser.y" /* yacc.c:1646 */ - { - (yyval) = cb_list_add ((yyvsp[-1]), (yyvsp[0])); - } -#line 27704 "parser.c" /* yacc.c:1646 */ - break; - - case 2681: -#line 17137 "parser.y" /* yacc.c:1646 */ - { - (yyval) = cb_build_length ((yyvsp[0])); - } -#line 27712 "parser.c" /* yacc.c:1646 */ - break; - - case 2682: -#line 17141 "parser.y" /* yacc.c:1646 */ - { - (yyval) = cb_build_length ((yyvsp[0])); - } -#line 27720 "parser.c" /* yacc.c:1646 */ - break; - - case 2683: -#line 17145 "parser.y" /* yacc.c:1646 */ - { - (yyval) = cb_build_length ((yyvsp[0])); - } -#line 27728 "parser.c" /* yacc.c:1646 */ - break; - - case 2687: -#line 17155 "parser.y" /* yacc.c:1646 */ - { - (yyval) = cb_build_length ((yyvsp[0])); - } -#line 27736 "parser.c" /* yacc.c:1646 */ - break; - - case 2688: -#line 17159 "parser.y" /* yacc.c:1646 */ - { - (yyval) = cb_build_length ((yyvsp[0])); - } -#line 27744 "parser.c" /* yacc.c:1646 */ - break; - - case 2689: -#line 17163 "parser.y" /* yacc.c:1646 */ - { - (yyval) = cb_build_length ((yyvsp[0])); - } -#line 27752 "parser.c" /* yacc.c:1646 */ - break; - - case 2690: -#line 17170 "parser.y" /* yacc.c:1646 */ - { - if (CB_TREE_CATEGORY ((yyvsp[0])) != CB_CATEGORY_NUMERIC) { - cb_error_x ((yyvsp[0]), _("a numeric literal is expected here")); - (yyval) = cb_error_node; - } else { - (yyval) = (yyvsp[0]); - } - } -#line 27765 "parser.c" /* yacc.c:1646 */ - break; - - case 2691: -#line 17182 "parser.y" /* yacc.c:1646 */ - { - if (CB_TREE_CATEGORY ((yyvsp[0])) == CB_CATEGORY_NUMERIC) { - cb_error_x ((yyvsp[0]), _("a non-numeric literal is expected here")); - (yyval) = cb_error_node; - } else { - (yyval) = (yyvsp[0]); - } - } -#line 27778 "parser.c" /* yacc.c:1646 */ - break; - - case 2692: -#line 17194 "parser.y" /* yacc.c:1646 */ - { - if (cb_tree_category ((yyvsp[0])) != CB_CATEGORY_NUMERIC - || cb_get_int ((yyvsp[0])) == 0) { - cb_error (_("non-zero value expected")); - (yyval) = cb_int1; - } else { - (yyval) = (yyvsp[0]); - } - } -#line 27792 "parser.c" /* yacc.c:1646 */ - break; - - case 2697: -#line 17218 "parser.y" /* yacc.c:1646 */ - { - error_if_not_usage_display_or_nonnumeric_lit ((yyvsp[0])); - } -#line 27800 "parser.c" /* yacc.c:1646 */ - break; - - case 2698: -#line 17225 "parser.y" /* yacc.c:1646 */ - { - error_if_not_usage_display_or_nonnumeric_lit ((yyvsp[0])); - } -#line 27808 "parser.c" /* yacc.c:1646 */ - break; - - case 2700: -#line 17233 "parser.y" /* yacc.c:1646 */ - { - error_if_not_usage_display_or_nonnumeric_lit ((yyvsp[0])); - } -#line 27816 "parser.c" /* yacc.c:1646 */ - break; - - case 2702: -#line 17241 "parser.y" /* yacc.c:1646 */ - { - error_if_not_usage_display_or_nonnumeric_lit ((yyvsp[0])); - } -#line 27824 "parser.c" /* yacc.c:1646 */ - break; - - case 2708: -#line 17259 "parser.y" /* yacc.c:1646 */ - { - (yyval) = check_not_88_level ((yyvsp[0])); - } -#line 27832 "parser.c" /* yacc.c:1646 */ - break; - - case 2710: -#line 17267 "parser.y" /* yacc.c:1646 */ - { - (yyval) = check_not_88_level ((yyvsp[0])); - } -#line 27840 "parser.c" /* yacc.c:1646 */ - break; - - case 2713: -#line 17276 "parser.y" /* yacc.c:1646 */ - { - (yyval) = check_not_88_level ((yyvsp[0])); - } -#line 27848 "parser.c" /* yacc.c:1646 */ - break; - - case 2716: -#line 17285 "parser.y" /* yacc.c:1646 */ - { - (yyval) = check_not_88_level ((yyvsp[0])); - } -#line 27856 "parser.c" /* yacc.c:1646 */ - break; - - case 2718: -#line 17290 "parser.y" /* yacc.c:1646 */ - { - (yyval) = cb_zero; - } -#line 27864 "parser.c" /* yacc.c:1646 */ - break; - - case 2719: -#line 17299 "parser.y" /* yacc.c:1646 */ - { - (yyval) = check_not_88_level ((yyvsp[0])); - } -#line 27872 "parser.c" /* yacc.c:1646 */ - break; - - case 2723: -#line 17315 "parser.y" /* yacc.c:1646 */ - { - (yyval) = check_not_88_level ((yyvsp[0])); - } -#line 27880 "parser.c" /* yacc.c:1646 */ - break; - - case 2725: -#line 17323 "parser.y" /* yacc.c:1646 */ - { - (yyval) = check_not_88_level ((yyvsp[0])); - } -#line 27888 "parser.c" /* yacc.c:1646 */ - break; - - case 2728: -#line 17333 "parser.y" /* yacc.c:1646 */ - { (yyval) = cb_build_identifier ((yyvsp[0]), 0); } -#line 27894 "parser.c" /* yacc.c:1646 */ - break; - - case 2729: -#line 17337 "parser.y" /* yacc.c:1646 */ - { (yyval) = cb_build_identifier ((yyvsp[0]), 1); } -#line 27900 "parser.c" /* yacc.c:1646 */ - break; - - case 2730: -#line 17341 "parser.y" /* yacc.c:1646 */ - { (yyval) = (yyvsp[0]); } -#line 27906 "parser.c" /* yacc.c:1646 */ - break; - - case 2731: -#line 17342 "parser.y" /* yacc.c:1646 */ - { (yyval) = (yyvsp[-1]); } -#line 27912 "parser.c" /* yacc.c:1646 */ - break; - - case 2732: -#line 17347 "parser.y" /* yacc.c:1646 */ - { - error_if_not_usage_display_or_nonnumeric_lit ((yyvsp[0])); - } -#line 27920 "parser.c" /* yacc.c:1646 */ - break; - - case 2733: -#line 17354 "parser.y" /* yacc.c:1646 */ - { - if ((yyvsp[0]) != cb_error_node - && cb_tree_category ((yyvsp[0])) != CB_CATEGORY_NUMERIC) { - cb_error_x ((yyvsp[0]), _("'%s' is not numeric"), cb_name ((yyvsp[0]))); - } - } -#line 27931 "parser.c" /* yacc.c:1646 */ - break; - - case 2734: -#line 17364 "parser.y" /* yacc.c:1646 */ - { - cb_tree x = NULL; - if (CB_REFERENCE_P ((yyvsp[0]))) { - x = cb_ref ((yyvsp[0])); - } - if (x && (CB_FIELD_P (x) || CB_FILE_P (x))) { - (yyval) = cb_build_identifier ((yyvsp[0]), 0); - } else { - if (x != cb_error_node) { - cb_error_x ((yyvsp[0]), _("'%s' is not a field or file"), cb_name ((yyvsp[0]))); - } - (yyval) = cb_error_node; - } - } -#line 27950 "parser.c" /* yacc.c:1646 */ - break; - - case 2735: -#line 17383 "parser.y" /* yacc.c:1646 */ - { - cb_tree x = NULL; - if (CB_REFERENCE_P ((yyvsp[0]))) { - x = cb_ref ((yyvsp[0])); - } - - if (x && CB_FIELD_P (x)) { - (yyval) = (yyvsp[0]); - } else { - if (x != cb_error_node) { - cb_error_x ((yyvsp[0]), _("'%s' is not a field"), cb_name ((yyvsp[0]))); - } - (yyval) = cb_error_node; - } - } -#line 27970 "parser.c" /* yacc.c:1646 */ - break; - - case 2736: -#line 17402 "parser.y" /* yacc.c:1646 */ - { - cb_tree x = NULL; - if (CB_REFERENCE_P ((yyvsp[0]))) { - x = cb_ref ((yyvsp[0])); - } - if (x && CB_FIELD_P (x)) { - (yyval) = cb_build_identifier ((yyvsp[0]), 0); - } else { - if (x != cb_error_node) { - cb_error_x ((yyvsp[0]), _("'%s' is not a field"), cb_name ((yyvsp[0]))); - } - (yyval) = cb_error_node; - } - } -#line 27989 "parser.c" /* yacc.c:1646 */ - break; - - case 2737: -#line 17420 "parser.y" /* yacc.c:1646 */ - { - (yyval) = (yyvsp[-2]); - if (start_debug) { - cb_check_field_debug ((yyvsp[-2])); - } - } -#line 28000 "parser.c" /* yacc.c:1646 */ - break; - - case 2738: -#line 17427 "parser.y" /* yacc.c:1646 */ - { - (yyval) = (yyvsp[-1]); - if (start_debug) { - cb_check_field_debug ((yyvsp[-1])); - } - } -#line 28011 "parser.c" /* yacc.c:1646 */ - break; - - case 2739: -#line 17434 "parser.y" /* yacc.c:1646 */ - { - (yyval) = (yyvsp[-1]); - if (start_debug) { - cb_check_field_debug ((yyvsp[-1])); - } - } -#line 28022 "parser.c" /* yacc.c:1646 */ - break; - - case 2740: -#line 17441 "parser.y" /* yacc.c:1646 */ - { - (yyval) = (yyvsp[0]); - if (start_debug) { - cb_check_field_debug ((yyvsp[0])); - } - } -#line 28033 "parser.c" /* yacc.c:1646 */ - break; - - case 2741: -#line 17451 "parser.y" /* yacc.c:1646 */ - { - (yyval) = CB_LIST_INIT ((yyvsp[0])); - } -#line 28041 "parser.c" /* yacc.c:1646 */ - break; - - case 2742: -#line 17455 "parser.y" /* yacc.c:1646 */ - { - (yyval) = cb_list_add ((yyvsp[-1]), (yyvsp[0])); - } -#line 28049 "parser.c" /* yacc.c:1646 */ - break; - - case 2743: -#line 17462 "parser.y" /* yacc.c:1646 */ - { - (yyval) = cb_build_identifier ((yyvsp[0]), 0); - } -#line 28057 "parser.c" /* yacc.c:1646 */ - break; - - case 2744: -#line 17466 "parser.y" /* yacc.c:1646 */ - { - (yyval) = cb_build_identifier ((yyvsp[0]), 0); - } -#line 28065 "parser.c" /* yacc.c:1646 */ - break; - - case 2745: -#line 17473 "parser.y" /* yacc.c:1646 */ - { - (yyval) = (yyvsp[-2]); - if (CB_REFERENCE_P ((yyvsp[-2]))) { - CB_REFERENCE ((yyvsp[-2]))->flag_target = 1; - } - if (start_debug) { - cb_check_field_debug ((yyvsp[-2])); - } - } -#line 28079 "parser.c" /* yacc.c:1646 */ - break; - - case 2746: -#line 17483 "parser.y" /* yacc.c:1646 */ - { - (yyval) = (yyvsp[-1]); - if (CB_REFERENCE_P ((yyvsp[-1]))) { - CB_REFERENCE ((yyvsp[-1]))->flag_target = 1; - } - if (start_debug) { - cb_check_field_debug ((yyvsp[-1])); - } - } -#line 28093 "parser.c" /* yacc.c:1646 */ - break; - - case 2747: -#line 17493 "parser.y" /* yacc.c:1646 */ - { - (yyval) = (yyvsp[-1]); - if (CB_REFERENCE_P ((yyvsp[-1]))) { - CB_REFERENCE ((yyvsp[-1]))->flag_target = 1; - } - if (start_debug) { - cb_check_field_debug ((yyvsp[-1])); - } - } -#line 28107 "parser.c" /* yacc.c:1646 */ - break; - - case 2748: -#line 17503 "parser.y" /* yacc.c:1646 */ - { - (yyval) = (yyvsp[0]); - if (CB_REFERENCE_P ((yyvsp[0]))) { - CB_REFERENCE ((yyvsp[0]))->flag_target = 1; - } - if (start_debug) { - cb_check_field_debug ((yyvsp[0])); - } - } -#line 28121 "parser.c" /* yacc.c:1646 */ - break; - - case 2749: -#line 17516 "parser.y" /* yacc.c:1646 */ - { - cb_tree x = NULL; - (yyval) = (yyvsp[0]); - if (start_debug) { - cb_check_field_debug ((yyvsp[0])); - } - if (CB_REFERENCE_P ((yyvsp[0]))) { - x = cb_ref ((yyvsp[0])); - } - if (x && CB_FIELD_P (x)) { - (yyval) = cb_build_identifier ((yyvsp[0]), 0); - error_if_not_usage_display_or_nonnumeric_lit ((yyvsp[0])); - } else if (x && CB_ALPHABET_NAME_P (x)) { - /* TODO: add check for subscript/ ref-mod here [not allowed] */ - (yyval) = cb_build_identifier ((yyvsp[0]), 0); - } else { - if (x != cb_error_node) { - cb_error_x ((yyvsp[0]), _("'%s' is not a field or alphabet"), cb_name ((yyvsp[0]))); - } - (yyval) = cb_error_node; - } - } -#line 28148 "parser.c" /* yacc.c:1646 */ - break; - - case 2750: -#line 17542 "parser.y" /* yacc.c:1646 */ - { - (yyval) = (yyvsp[0]); - } -#line 28156 "parser.c" /* yacc.c:1646 */ - break; - - case 2751: -#line 17546 "parser.y" /* yacc.c:1646 */ - { - (yyval) = (yyvsp[-2]); - CB_REFERENCE ((yyvsp[-2]))->chain = (yyvsp[0]); - } -#line 28165 "parser.c" /* yacc.c:1646 */ - break; - - case 2752: -#line 17553 "parser.y" /* yacc.c:1646 */ - { - start_tree = NULL; /* actually not needed - initialized for clarity only */ - } -#line 28173 "parser.c" /* yacc.c:1646 */ - break; - - case 2753: -#line 17557 "parser.y" /* yacc.c:1646 */ - { - if ((yyvsp[0]) == cb_error_node) { - cb_error_x (start_tree, _("a subscripted data-item cannot be used here")); - } - (yyval) = start_tree; - } -#line 28184 "parser.c" /* yacc.c:1646 */ - break; - - case 2754: -#line 17567 "parser.y" /* yacc.c:1646 */ - { - start_tree = (yyvsp[0]); - (yyval) = (yyvsp[0]); - } -#line 28193 "parser.c" /* yacc.c:1646 */ - break; - - case 2755: -#line 17572 "parser.y" /* yacc.c:1646 */ - { - start_tree = (yyvsp[-2]); - (yyval) = cb_error_node; - } -#line 28202 "parser.c" /* yacc.c:1646 */ - break; - - case 2756: -#line 17580 "parser.y" /* yacc.c:1646 */ - { - (yyval) = (yyvsp[-3]); - CB_REFERENCE ((yyvsp[-3]))->subs = cb_list_reverse ((yyvsp[-1])); - } -#line 28211 "parser.c" /* yacc.c:1646 */ - break; - - case 2757: -#line 17588 "parser.y" /* yacc.c:1646 */ - { - CB_REFERENCE ((yyvsp[-4]))->offset = (yyvsp[-2]); - } -#line 28219 "parser.c" /* yacc.c:1646 */ - break; - - case 2758: -#line 17592 "parser.y" /* yacc.c:1646 */ - { - CB_REFERENCE ((yyvsp[-5]))->offset = (yyvsp[-3]); - CB_REFERENCE ((yyvsp[-5]))->length = (yyvsp[-1]); - } -#line 28228 "parser.c" /* yacc.c:1646 */ - break; - - case 2759: -#line 17602 "parser.y" /* yacc.c:1646 */ - { - if (cb_tree_category ((yyvsp[0])) != CB_CATEGORY_NUMERIC - || !CB_LITERAL_P((yyvsp[0])) - || CB_LITERAL ((yyvsp[0]))->scale - || CB_LITERAL ((yyvsp[0]))->sign < 0 - || (CB_LITERAL ((yyvsp[0]))->sign && current_report && !cb_report_column_plus) - || (CB_LITERAL ((yyvsp[0]))->sign && current_report == NULL)) { - cb_error (_("unsigned integer value expected")); - (yyval) = cb_build_numeric_literal (-1, "1", 0); - } else { - (yyval) = (yyvsp[0]); - } - } -#line 28246 "parser.c" /* yacc.c:1646 */ - break; - - case 2760: -#line 17619 "parser.y" /* yacc.c:1646 */ - { - if (cb_tree_category ((yyvsp[0])) != CB_CATEGORY_NUMERIC) { - cb_error (_("integer value expected")); - (yyval) = cb_int1; - } else if (CB_LITERAL_P ((yyvsp[0])) - && (CB_LITERAL ((yyvsp[0]))->sign || CB_LITERAL ((yyvsp[0]))->scale)) { - cb_error (_("integer value expected")); - (yyval) = cb_int1; - } else { - int n = cb_get_int ((yyvsp[0])); - if (n < 1 || n > 256) { - cb_error (_("invalid symbolic integer")); - (yyval) = cb_int1; - } else { - (yyval) = (yyvsp[0]); - } - } - } -#line 28269 "parser.c" /* yacc.c:1646 */ - break; - - case 2761: -#line 17641 "parser.y" /* yacc.c:1646 */ - { - if (cb_tree_category ((yyvsp[0])) != CB_CATEGORY_NUMERIC - || !CB_LITERAL_P((yyvsp[0])) - || CB_LITERAL ((yyvsp[0]))->sign - || CB_LITERAL ((yyvsp[0]))->scale) { - cb_error (_("unsigned positive integer value expected")); - (yyval) = cb_int1; - } else { - if (cb_get_int ((yyvsp[0])) < 1) { - cb_error (_("unsigned positive integer value expected")); - (yyval) = cb_int1; - } else { - (yyval) = (yyvsp[0]); - } - } - } -#line 28290 "parser.c" /* yacc.c:1646 */ - break; - - case 2762: -#line 17661 "parser.y" /* yacc.c:1646 */ - { - (yyval) = (yyvsp[0]); - } -#line 28298 "parser.c" /* yacc.c:1646 */ - break; - - case 2763: -#line 17665 "parser.y" /* yacc.c:1646 */ - { - (yyval) = cb_int0; - } -#line 28306 "parser.c" /* yacc.c:1646 */ - break; - - case 2764: -#line 17672 "parser.y" /* yacc.c:1646 */ - { - if (cb_tree_category ((yyvsp[0])) == CB_CATEGORY_NUMERIC) { - if (CB_LITERAL ((yyvsp[0]))->sign || CB_LITERAL ((yyvsp[0]))->scale) { - cb_error (_("integer value expected")); - } else { - int n = cb_get_int ((yyvsp[0])); - if (n < 1 || n > 256) { - cb_error (_("invalid CLASS value")); - } - } - } - (yyval) = (yyvsp[0]); - } -#line 28324 "parser.c" /* yacc.c:1646 */ - break; - - case 2765: -#line 17685 "parser.y" /* yacc.c:1646 */ - { (yyval) = cb_space; } -#line 28330 "parser.c" /* yacc.c:1646 */ - break; - - case 2766: -#line 17686 "parser.y" /* yacc.c:1646 */ - { (yyval) = cb_zero; } -#line 28336 "parser.c" /* yacc.c:1646 */ - break; - - case 2767: -#line 17687 "parser.y" /* yacc.c:1646 */ - { (yyval) = cb_quote; } -#line 28342 "parser.c" /* yacc.c:1646 */ - break; - - case 2768: -#line 17688 "parser.y" /* yacc.c:1646 */ - { (yyval) = cb_high; } -#line 28348 "parser.c" /* yacc.c:1646 */ - break; - - case 2769: -#line 17689 "parser.y" /* yacc.c:1646 */ - { (yyval) = cb_low; } -#line 28354 "parser.c" /* yacc.c:1646 */ - break; - - case 2770: -#line 17690 "parser.y" /* yacc.c:1646 */ - { (yyval) = cb_null; } -#line 28360 "parser.c" /* yacc.c:1646 */ - break; - - case 2771: -#line 17695 "parser.y" /* yacc.c:1646 */ - { - (yyval) = (yyvsp[0]); - } -#line 28368 "parser.c" /* yacc.c:1646 */ - break; - - case 2772: -#line 17699 "parser.y" /* yacc.c:1646 */ - { - struct cb_literal *l; - - if (CB_LITERAL_P ((yyvsp[0]))) { - /* We must not alter the original definition */ - l = cobc_parse_malloc (sizeof(struct cb_literal)); - *l = *(CB_LITERAL((yyvsp[0]))); - l->all = 1; - (yyval) = CB_TREE (l); - } else { - (yyval) = (yyvsp[0]); - } - } -#line 28386 "parser.c" /* yacc.c:1646 */ - break; - - case 2773: -#line 17716 "parser.y" /* yacc.c:1646 */ - { - (yyval) = (yyvsp[0]); - } -#line 28394 "parser.c" /* yacc.c:1646 */ - break; - - case 2774: -#line 17720 "parser.y" /* yacc.c:1646 */ - { - (yyval) = cb_concat_literals ((yyvsp[-2]), (yyvsp[0])); - } -#line 28402 "parser.c" /* yacc.c:1646 */ - break; - - case 2775: -#line 17726 "parser.y" /* yacc.c:1646 */ - { (yyval) = (yyvsp[0]); } -#line 28408 "parser.c" /* yacc.c:1646 */ - break; - - case 2776: -#line 17727 "parser.y" /* yacc.c:1646 */ - { (yyval) = cb_space; } -#line 28414 "parser.c" /* yacc.c:1646 */ - break; - - case 2777: -#line 17728 "parser.y" /* yacc.c:1646 */ - { (yyval) = cb_zero; } -#line 28420 "parser.c" /* yacc.c:1646 */ - break; - - case 2778: -#line 17729 "parser.y" /* yacc.c:1646 */ - { (yyval) = cb_quote; } -#line 28426 "parser.c" /* yacc.c:1646 */ - break; - - case 2779: -#line 17730 "parser.y" /* yacc.c:1646 */ - { (yyval) = cb_high; } -#line 28432 "parser.c" /* yacc.c:1646 */ - break; - - case 2780: -#line 17731 "parser.y" /* yacc.c:1646 */ - { (yyval) = cb_low; } -#line 28438 "parser.c" /* yacc.c:1646 */ - break; - - case 2781: -#line 17732 "parser.y" /* yacc.c:1646 */ - { (yyval) = cb_null; } -#line 28444 "parser.c" /* yacc.c:1646 */ - break; - - case 2782: -#line 17736 "parser.y" /* yacc.c:1646 */ - { (yyval) = cb_space; } -#line 28450 "parser.c" /* yacc.c:1646 */ - break; - - case 2783: -#line 17737 "parser.y" /* yacc.c:1646 */ - { (yyval) = cb_zero; } -#line 28456 "parser.c" /* yacc.c:1646 */ - break; - - case 2784: -#line 17738 "parser.y" /* yacc.c:1646 */ - { (yyval) = cb_high; } -#line 28462 "parser.c" /* yacc.c:1646 */ - break; - - case 2785: -#line 17739 "parser.y" /* yacc.c:1646 */ - { (yyval) = cb_low; } -#line 28468 "parser.c" /* yacc.c:1646 */ - break; - - case 2786: -#line 17746 "parser.y" /* yacc.c:1646 */ - { - (yyval) = cb_build_intrinsic ((yyvsp[-1]), NULL, (yyvsp[0]), 0); - } -#line 28476 "parser.c" /* yacc.c:1646 */ - break; - - case 2787: -#line 17750 "parser.y" /* yacc.c:1646 */ - { - (yyval) = cb_build_intrinsic ((yyvsp[-4]), CB_LIST_INIT ((yyvsp[-2])), (yyvsp[0]), 0); - } -#line 28484 "parser.c" /* yacc.c:1646 */ - break; - - case 2788: -#line 17754 "parser.y" /* yacc.c:1646 */ - { - (yyval) = cb_build_intrinsic ((yyvsp[-4]), (yyvsp[-2]), (yyvsp[0]), 0); - } -#line 28492 "parser.c" /* yacc.c:1646 */ - break; - - case 2789: -#line 17758 "parser.y" /* yacc.c:1646 */ - { - (yyval) = cb_build_intrinsic ((yyvsp[-4]), (yyvsp[-2]), (yyvsp[0]), 0); - } -#line 28500 "parser.c" /* yacc.c:1646 */ - break; - - case 2790: -#line 17762 "parser.y" /* yacc.c:1646 */ - { - (yyval) = cb_build_intrinsic ((yyvsp[-3]), (yyvsp[-1]), NULL, 0); - } -#line 28508 "parser.c" /* yacc.c:1646 */ - break; - - case 2791: -#line 17766 "parser.y" /* yacc.c:1646 */ - { - CB_PENDING (_("PHYSICAL argument for LENGTH functions")); - (yyval) = cb_build_intrinsic ((yyvsp[-4]), (yyvsp[-2]), NULL, 0); - } -#line 28517 "parser.c" /* yacc.c:1646 */ - break; - - case 2792: -#line 17771 "parser.y" /* yacc.c:1646 */ - { - (yyval) = cb_build_intrinsic ((yyvsp[-3]), (yyvsp[-1]), NULL, 0); - } -#line 28525 "parser.c" /* yacc.c:1646 */ - break; - - case 2793: -#line 17775 "parser.y" /* yacc.c:1646 */ - { - (yyval) = cb_build_intrinsic ((yyvsp[-4]), (yyvsp[-2]), (yyvsp[0]), 0); - } -#line 28533 "parser.c" /* yacc.c:1646 */ - break; - - case 2794: -#line 17779 "parser.y" /* yacc.c:1646 */ - { - (yyval) = cb_build_intrinsic ((yyvsp[-4]), (yyvsp[-2]), (yyvsp[0]), 0); - } -#line 28541 "parser.c" /* yacc.c:1646 */ - break; - - case 2795: -#line 17783 "parser.y" /* yacc.c:1646 */ - { - (yyval) = cb_build_intrinsic ((yyvsp[-4]), (yyvsp[-2]), (yyvsp[0]), 0); - } -#line 28549 "parser.c" /* yacc.c:1646 */ - break; - - case 2796: -#line 17787 "parser.y" /* yacc.c:1646 */ - { - (yyval) = cb_build_intrinsic ((yyvsp[-4]), (yyvsp[-2]), (yyvsp[0]), 0); - } -#line 28557 "parser.c" /* yacc.c:1646 */ - break; - - case 2797: -#line 17791 "parser.y" /* yacc.c:1646 */ - { - (yyval) = cb_build_intrinsic ((yyvsp[-4]), (yyvsp[-2]), (yyvsp[0]), 0); - } -#line 28565 "parser.c" /* yacc.c:1646 */ - break; - - case 2798: -#line 17795 "parser.y" /* yacc.c:1646 */ - { - (yyval) = cb_build_intrinsic ((yyvsp[-1]), (yyvsp[0]), NULL, 0); - } -#line 28573 "parser.c" /* yacc.c:1646 */ - break; - - case 2799: -#line 17799 "parser.y" /* yacc.c:1646 */ - { - (yyval) = cb_build_intrinsic ((yyvsp[-1]), (yyvsp[0]), NULL, 1); - } -#line 28581 "parser.c" /* yacc.c:1646 */ - break; - - case 2811: -#line 17826 "parser.y" /* yacc.c:1646 */ - { - (yyval) = NULL; - } -#line 28589 "parser.c" /* yacc.c:1646 */ - break; - - case 2812: -#line 17830 "parser.y" /* yacc.c:1646 */ - { - (yyval) = CB_BUILD_PAIR ((yyvsp[-2]), NULL); - } -#line 28597 "parser.c" /* yacc.c:1646 */ - break; - - case 2813: -#line 17834 "parser.y" /* yacc.c:1646 */ - { - (yyval) = CB_BUILD_PAIR ((yyvsp[-3]), (yyvsp[-1])); - } -#line 28605 "parser.c" /* yacc.c:1646 */ - break; - - case 2814: -#line 17841 "parser.y" /* yacc.c:1646 */ - { - (yyval) = NULL; - } -#line 28613 "parser.c" /* yacc.c:1646 */ - break; - - case 2815: -#line 17845 "parser.y" /* yacc.c:1646 */ - { - (yyval) = (yyvsp[-1]); - } -#line 28621 "parser.c" /* yacc.c:1646 */ - break; - - case 2816: -#line 17849 "parser.y" /* yacc.c:1646 */ - { - (yyval) = NULL; - } -#line 28629 "parser.c" /* yacc.c:1646 */ - break; - - case 2817: -#line 17856 "parser.y" /* yacc.c:1646 */ - { - cb_tree x; - - x = CB_LIST_INIT ((yyvsp[0])); - (yyval) = cb_list_add (x, cb_int0); - } -#line 28640 "parser.c" /* yacc.c:1646 */ - break; - - case 2818: -#line 17863 "parser.y" /* yacc.c:1646 */ - { - cb_tree x; - - x = CB_LIST_INIT ((yyvsp[-2])); - (yyval) = cb_list_add (x, cb_int1); - } -#line 28651 "parser.c" /* yacc.c:1646 */ - break; - - case 2819: -#line 17870 "parser.y" /* yacc.c:1646 */ - { - cb_tree x; - - x = CB_LIST_INIT ((yyvsp[-2])); - (yyval) = cb_list_add (x, cb_int2); - } -#line 28662 "parser.c" /* yacc.c:1646 */ - break; - - case 2820: -#line 17879 "parser.y" /* yacc.c:1646 */ - { - suppress_data_exceptions = 1; - } -#line 28670 "parser.c" /* yacc.c:1646 */ - break; - - case 2821: -#line 17883 "parser.y" /* yacc.c:1646 */ - { - suppress_data_exceptions = 0; - if (CB_NUMERIC_LITERAL_P((yyvsp[0]))) { - cb_error_x ((yyvsp[0]), _("a non-numeric literal is expected here")); - (yyval) = CB_LIST_INIT (cb_error_node); - } else { - (yyval) = CB_LIST_INIT ((yyvsp[0])); - } - } -#line 28684 "parser.c" /* yacc.c:1646 */ - break; - - case 2822: -#line 17896 "parser.y" /* yacc.c:1646 */ - { - cb_tree x; - - x = CB_LIST_INIT ((yyvsp[0])); - (yyval) = cb_list_add (x, cb_null); - } -#line 28695 "parser.c" /* yacc.c:1646 */ - break; - - case 2823: -#line 17903 "parser.y" /* yacc.c:1646 */ - { - cb_tree x; - - x = CB_LIST_INIT ((yyvsp[-2])); - (yyval) = cb_list_add (x, (yyvsp[0])); - } -#line 28706 "parser.c" /* yacc.c:1646 */ - break; - - case 2824: -#line 17913 "parser.y" /* yacc.c:1646 */ - { - cb_tree x; - - x = CB_LIST_INIT ((yyvsp[0])); - (yyval) = cb_list_add (x, cb_null); - } -#line 28717 "parser.c" /* yacc.c:1646 */ - break; - - case 2825: -#line 17920 "parser.y" /* yacc.c:1646 */ - { - cb_tree x; - - x = CB_LIST_INIT ((yyvsp[-2])); - (yyval) = cb_list_add (x, cb_ref ((yyvsp[0]))); - } -#line 28728 "parser.c" /* yacc.c:1646 */ - break; - - case 2826: -#line 17930 "parser.y" /* yacc.c:1646 */ - { - (yyval) = cb_list_add ((yyvsp[0]), cb_int0); - } -#line 28736 "parser.c" /* yacc.c:1646 */ - break; - - case 2827: -#line 17934 "parser.y" /* yacc.c:1646 */ - { - const int num_args = cb_list_length ((yyvsp[-2])); - - if (num_args == 4) { - cb_error_x ((yyvsp[-2]), _("cannot specify offset and SYSTEM-OFFSET at the same time")); - } - - (yyval) = cb_list_add ((yyvsp[-2]), cb_int1); - } -#line 28750 "parser.c" /* yacc.c:1646 */ - break; - - case 2828: -#line 17947 "parser.y" /* yacc.c:1646 */ - { - (yyval) = cb_list_add ((yyvsp[0]), cb_int0); - } -#line 28758 "parser.c" /* yacc.c:1646 */ - break; - - case 2829: -#line 17951 "parser.y" /* yacc.c:1646 */ - { - const int num_args = cb_list_length ((yyvsp[-2])); - - if (num_args == 3) { - cb_error_x ((yyvsp[-2]), _("cannot specify offset and SYSTEM-OFFSET at the same time")); - } - - (yyval) = cb_list_add ((yyvsp[-2]), cb_int1); - } -#line 28772 "parser.c" /* yacc.c:1646 */ - break; - - case 2830: -#line 17965 "parser.y" /* yacc.c:1646 */ - { - non_const_word = 1; - } -#line 28780 "parser.c" /* yacc.c:1646 */ - break; - - case 2831: -#line 17973 "parser.y" /* yacc.c:1646 */ - { (yyval) = cb_int0; } -#line 28786 "parser.c" /* yacc.c:1646 */ - break; - - case 2832: -#line 17974 "parser.y" /* yacc.c:1646 */ - { (yyval) = cb_int1; } -#line 28792 "parser.c" /* yacc.c:1646 */ - break; - - case 2833: -#line 17978 "parser.y" /* yacc.c:1646 */ - { (yyval) = NULL; } -#line 28798 "parser.c" /* yacc.c:1646 */ - break; - - case 2834: -#line 17979 "parser.y" /* yacc.c:1646 */ - { (yyval) = cb_int0; } -#line 28804 "parser.c" /* yacc.c:1646 */ - break; - - case 2835: -#line 17980 "parser.y" /* yacc.c:1646 */ - { (yyval) = cb_int1; } -#line 28810 "parser.c" /* yacc.c:1646 */ - break; - - case 2836: -#line 17984 "parser.y" /* yacc.c:1646 */ - { (yyval) = NULL; } -#line 28816 "parser.c" /* yacc.c:1646 */ - break; - - case 2837: -#line 17985 "parser.y" /* yacc.c:1646 */ - { (yyval) = cb_int1; } -#line 28822 "parser.c" /* yacc.c:1646 */ - break; - - case 2838: -#line 17990 "parser.y" /* yacc.c:1646 */ - { - (yyval) = NULL; - } -#line 28830 "parser.c" /* yacc.c:1646 */ - break; - - case 2839: -#line 17994 "parser.y" /* yacc.c:1646 */ - { - (yyval) = (yyvsp[0]); - } -#line 28838 "parser.c" /* yacc.c:1646 */ - break; - - case 2840: -#line 18001 "parser.y" /* yacc.c:1646 */ - { - (yyval) = NULL; - } -#line 28846 "parser.c" /* yacc.c:1646 */ - break; - - case 2841: -#line 18005 "parser.y" /* yacc.c:1646 */ - { - (yyval) = (yyvsp[0]); - } -#line 28854 "parser.c" /* yacc.c:1646 */ - break; - - case 2842: -#line 18012 "parser.y" /* yacc.c:1646 */ - { (yyval) = cb_int0; } -#line 28860 "parser.c" /* yacc.c:1646 */ - break; - - case 2843: -#line 18013 "parser.y" /* yacc.c:1646 */ - { (yyval) = cb_int1; } -#line 28866 "parser.c" /* yacc.c:1646 */ - break; - - case 2844: -#line 18014 "parser.y" /* yacc.c:1646 */ - { (yyval) = cb_int2; } -#line 28872 "parser.c" /* yacc.c:1646 */ - break; - - case 2845: -#line 18018 "parser.y" /* yacc.c:1646 */ - { (yyval) = NULL; } -#line 28878 "parser.c" /* yacc.c:1646 */ - break; - - case 2846: -#line 18019 "parser.y" /* yacc.c:1646 */ - { (yyval) = cb_true; } -#line 28884 "parser.c" /* yacc.c:1646 */ - break; - - case 2847: -#line 18023 "parser.y" /* yacc.c:1646 */ - { (yyval) = cb_int (cb_flag_optional_file); } -#line 28890 "parser.c" /* yacc.c:1646 */ - break; - - case 2848: -#line 18024 "parser.y" /* yacc.c:1646 */ - { (yyval) = cb_int1; } -#line 28896 "parser.c" /* yacc.c:1646 */ - break; - - case 2849: -#line 18025 "parser.y" /* yacc.c:1646 */ - { (yyval) = cb_int0; } -#line 28902 "parser.c" /* yacc.c:1646 */ - break; - - case 2850: -#line 18030 "parser.y" /* yacc.c:1646 */ - { - (yyval) = cb_int0; - } -#line 28910 "parser.c" /* yacc.c:1646 */ - break; - - case 2851: -#line 18034 "parser.y" /* yacc.c:1646 */ - { - if ((yyvsp[0])) { - (yyval) = (yyvsp[0]); - } else { - (yyval) = default_rounded_mode; - } - cobc_cs_check = 0; - } -#line 28923 "parser.c" /* yacc.c:1646 */ - break; - - case 2852: -#line 18046 "parser.y" /* yacc.c:1646 */ - { - (yyval) = NULL; - cobc_cs_check = 0; - } -#line 28932 "parser.c" /* yacc.c:1646 */ - break; - - case 2853: -#line 18051 "parser.y" /* yacc.c:1646 */ - { - (yyval) = (yyvsp[0]); - cobc_cs_check = 0; - } -#line 28941 "parser.c" /* yacc.c:1646 */ - break; - - case 2854: -#line 18059 "parser.y" /* yacc.c:1646 */ - { - (yyval) = cb_int (COB_STORE_ROUND | COB_STORE_AWAY_FROM_ZERO); - } -#line 28949 "parser.c" /* yacc.c:1646 */ - break; - - case 2855: -#line 18063 "parser.y" /* yacc.c:1646 */ - { - (yyval) = cb_int (COB_STORE_ROUND | COB_STORE_NEAR_AWAY_FROM_ZERO); - } -#line 28957 "parser.c" /* yacc.c:1646 */ - break; - - case 2856: -#line 18067 "parser.y" /* yacc.c:1646 */ - { - (yyval) = cb_int (COB_STORE_ROUND | COB_STORE_NEAR_EVEN); - } -#line 28965 "parser.c" /* yacc.c:1646 */ - break; - - case 2857: -#line 18071 "parser.y" /* yacc.c:1646 */ - { - (yyval) = cb_int (COB_STORE_ROUND | COB_STORE_NEAR_TOWARD_ZERO); - } -#line 28973 "parser.c" /* yacc.c:1646 */ - break; - - case 2858: -#line 18075 "parser.y" /* yacc.c:1646 */ - { - (yyval) = cb_int (COB_STORE_ROUND | COB_STORE_PROHIBITED); - } -#line 28981 "parser.c" /* yacc.c:1646 */ - break; - - case 2859: -#line 18079 "parser.y" /* yacc.c:1646 */ - { - (yyval) = cb_int (COB_STORE_ROUND | COB_STORE_TOWARD_GREATER); - } -#line 28989 "parser.c" /* yacc.c:1646 */ - break; - - case 2860: -#line 18083 "parser.y" /* yacc.c:1646 */ - { - (yyval) = cb_int (COB_STORE_ROUND | COB_STORE_TOWARD_LESSER); - } -#line 28997 "parser.c" /* yacc.c:1646 */ - break; - - case 2861: -#line 18087 "parser.y" /* yacc.c:1646 */ - { - (yyval) = cb_int (COB_STORE_ROUND | COB_STORE_TRUNCATION); - } -#line 29005 "parser.c" /* yacc.c:1646 */ - break; - - case 2862: -#line 18093 "parser.y" /* yacc.c:1646 */ - { (yyval) = NULL; } -#line 29011 "parser.c" /* yacc.c:1646 */ - break; - - case 2863: -#line 18094 "parser.y" /* yacc.c:1646 */ - { (yyval) = cb_int1; } -#line 29017 "parser.c" /* yacc.c:1646 */ - break; - - case 2864: -#line 18098 "parser.y" /* yacc.c:1646 */ - { (yyval) = NULL; } -#line 29023 "parser.c" /* yacc.c:1646 */ - break; - - case 2865: -#line 18100 "parser.y" /* yacc.c:1646 */ - { - cb_tree x; - - x = CB_LIST_INIT ((yyvsp[-3])); - (yyval) = cb_list_add (x, (yyvsp[-1])); - } -#line 29034 "parser.c" /* yacc.c:1646 */ - break; - - case 2866: -#line 18109 "parser.y" /* yacc.c:1646 */ - { (yyval) = NULL; } -#line 29040 "parser.c" /* yacc.c:1646 */ - break; - - case 2867: -#line 18111 "parser.y" /* yacc.c:1646 */ - { - (yyval) = (yyvsp[0]); - } -#line 29048 "parser.c" /* yacc.c:1646 */ - break; - - case 2868: -#line 18120 "parser.y" /* yacc.c:1646 */ - { - cobc_repeat_last_token = 1; - } -#line 29056 "parser.c" /* yacc.c:1646 */ - break; - - case 2869: -#line 18124 "parser.y" /* yacc.c:1646 */ - { - cobc_repeat_last_token = 1; - } -#line 29064 "parser.c" /* yacc.c:1646 */ - break; - - case 2870: -#line 18128 "parser.y" /* yacc.c:1646 */ - { - cobc_repeat_last_token = 0; - } -#line 29072 "parser.c" /* yacc.c:1646 */ - break; - - case 2871: -#line 18132 "parser.y" /* yacc.c:1646 */ - { - cobc_repeat_last_token = 0; - } -#line 29080 "parser.c" /* yacc.c:1646 */ - break; - - -#line 29084 "parser.c" /* yacc.c:1646 */ - default: break; - } - /* User semantic actions sometimes alter yychar, and that requires - that yytoken be updated with the new translation. We take the - approach of translating immediately before every use of yytoken. - One alternative is translating here after every semantic action, - but that translation would be missed if the semantic action invokes - YYABORT, YYACCEPT, or YYERROR immediately after altering yychar or - if it invokes YYBACKUP. In the case of YYABORT or YYACCEPT, an - incorrect destructor might then be invoked immediately. In the - case of YYERROR or YYBACKUP, subsequent parser actions might lead - to an incorrect destructor call or verbose syntax error message - before the lookahead is translated. */ - YY_SYMBOL_PRINT ("-> $$ =", yyr1[yyn], &yyval, &yyloc); - - YYPOPSTACK (yylen); - yylen = 0; - YY_STACK_PRINT (yyss, yyssp); - - *++yyvsp = yyval; - - /* Now 'shift' the result of the reduction. Determine what state - that goes to, based on the state we popped back to and the rule - number reduced by. */ - - yyn = yyr1[yyn]; - - yystate = yypgoto[yyn - YYNTOKENS] + *yyssp; - if (0 <= yystate && yystate <= YYLAST && yycheck[yystate] == *yyssp) - yystate = yytable[yystate]; - else - yystate = yydefgoto[yyn - YYNTOKENS]; - - goto yynewstate; - - -/*--------------------------------------. -| yyerrlab -- here on detecting error. | -`--------------------------------------*/ -yyerrlab: - /* Make sure we have latest lookahead translation. See comments at - user semantic actions for why this is necessary. */ - yytoken = yychar == YYEMPTY ? YYEMPTY : YYTRANSLATE (yychar); - - /* If not already recovering from an error, report this error. */ - if (!yyerrstatus) - { - ++yynerrs; -#if ! YYERROR_VERBOSE - yyerror (YY_("syntax error")); -#else -# define YYSYNTAX_ERROR yysyntax_error (&yymsg_alloc, &yymsg, \ - yyssp, yytoken) - { - char const *yymsgp = YY_("syntax error"); - int yysyntax_error_status; - yysyntax_error_status = YYSYNTAX_ERROR; - if (yysyntax_error_status == 0) - yymsgp = yymsg; - else if (yysyntax_error_status == 1) - { - if (yymsg != yymsgbuf) - YYSTACK_FREE (yymsg); - yymsg = (char *) YYSTACK_ALLOC (yymsg_alloc); - if (!yymsg) - { - yymsg = yymsgbuf; - yymsg_alloc = sizeof yymsgbuf; - yysyntax_error_status = 2; - } - else - { - yysyntax_error_status = YYSYNTAX_ERROR; - yymsgp = yymsg; - } - } - yyerror (yymsgp); - if (yysyntax_error_status == 2) - goto yyexhaustedlab; - } -# undef YYSYNTAX_ERROR -#endif - } - - - - if (yyerrstatus == 3) - { - /* If just tried and failed to reuse lookahead token after an - error, discard it. */ - - if (yychar <= YYEOF) - { - /* Return failure if at end of input. */ - if (yychar == YYEOF) - YYABORT; - } - else - { - yydestruct ("Error: discarding", - yytoken, &yylval); - yychar = YYEMPTY; - } - } - - /* Else will try to reuse lookahead token after shifting the error - token. */ - goto yyerrlab1; - - -/*---------------------------------------------------. -| yyerrorlab -- error raised explicitly by YYERROR. | -`---------------------------------------------------*/ -yyerrorlab: - - /* Pacify compilers like GCC when the user code never invokes - YYERROR and the label yyerrorlab therefore never appears in user - code. */ - if (/*CONSTCOND*/ 0) - goto yyerrorlab; - - /* Do not reclaim the symbols of the rule whose action triggered - this YYERROR. */ - YYPOPSTACK (yylen); - yylen = 0; - YY_STACK_PRINT (yyss, yyssp); - yystate = *yyssp; - goto yyerrlab1; - - -/*-------------------------------------------------------------. -| yyerrlab1 -- common code for both syntax error and YYERROR. | -`-------------------------------------------------------------*/ -yyerrlab1: - yyerrstatus = 3; /* Each real token shifted decrements this. */ - - for (;;) - { - yyn = yypact[yystate]; - if (!yypact_value_is_default (yyn)) - { - yyn += YYTERROR; - if (0 <= yyn && yyn <= YYLAST && yycheck[yyn] == YYTERROR) - { - yyn = yytable[yyn]; - if (0 < yyn) - break; - } - } - - /* Pop the current state because it cannot handle the error token. */ - if (yyssp == yyss) - YYABORT; - - - yydestruct ("Error: popping", - yystos[yystate], yyvsp); - YYPOPSTACK (1); - yystate = *yyssp; - YY_STACK_PRINT (yyss, yyssp); - } - - YY_IGNORE_MAYBE_UNINITIALIZED_BEGIN - *++yyvsp = yylval; - YY_IGNORE_MAYBE_UNINITIALIZED_END - - - /* Shift the error token. */ - YY_SYMBOL_PRINT ("Shifting", yystos[yyn], yyvsp, yylsp); - - yystate = yyn; - goto yynewstate; - - -/*-------------------------------------. -| yyacceptlab -- YYACCEPT comes here. | -`-------------------------------------*/ -yyacceptlab: - yyresult = 0; - goto yyreturn; - -/*-----------------------------------. -| yyabortlab -- YYABORT comes here. | -`-----------------------------------*/ -yyabortlab: - yyresult = 1; - goto yyreturn; - -#if !defined yyoverflow || YYERROR_VERBOSE -/*-------------------------------------------------. -| yyexhaustedlab -- memory exhaustion comes here. | -`-------------------------------------------------*/ -yyexhaustedlab: - yyerror (YY_("memory exhausted")); - yyresult = 2; - /* Fall through. */ -#endif - -yyreturn: - if (yychar != YYEMPTY) - { - /* Make sure we have latest lookahead translation. See comments at - user semantic actions for why this is necessary. */ - yytoken = YYTRANSLATE (yychar); - yydestruct ("Cleanup: discarding lookahead", - yytoken, &yylval); - } - /* Do not reclaim the symbols of the rule whose action triggered - this YYABORT or YYACCEPT. */ - YYPOPSTACK (yylen); - YY_STACK_PRINT (yyss, yyssp); - while (yyssp != yyss) - { - yydestruct ("Cleanup: popping", - yystos[*yyssp], yyvsp); - YYPOPSTACK (1); - } -#ifndef yyoverflow - if (yyss != yyssa) - YYSTACK_FREE (yyss); -#endif -#if YYERROR_VERBOSE - if (yymsg != yymsgbuf) - YYSTACK_FREE (yymsg); -#endif - return yyresult; -} -#line 18328 "parser.y" /* yacc.c:1906 */ - diff -Nru gnucobol-4.0~early~20200606/cobc/parser.h gnucobol-5/cobc/parser.h --- gnucobol-4.0~early~20200606/cobc/parser.h 2020-06-06 20:52:39.000000000 +0000 +++ gnucobol-5/cobc/parser.h 1970-01-01 00:00:00.000000000 +0000 @@ -1,1918 +0,0 @@ -/* A Bison parser, made by GNU Bison 3.0.4. */ - -/* Bison interface for Yacc-like parsers in C - - Copyright (C) 1984, 1989-1990, 2000-2015 Free Software Foundation, Inc. - - This program is free software: you can redistribute it and/or modify - it under the terms of the GNU General Public License as published by - the Free Software Foundation, either version 3 of the License, or - (at your option) any later version. - - This program is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with this program. If not, see . */ - -/* As a special exception, you may create a larger work that contains - part or all of the Bison parser skeleton and distribute that work - under terms of your choice, so long as that work isn't itself a - parser generator using the skeleton or a modified version thereof - as a parser skeleton. Alternatively, if you modify or redistribute - the parser skeleton itself, you may (at your option) remove this - special exception, which will cause the skeleton and the resulting - Bison output files to be licensed under the GNU General Public - License without this special exception. - - This special exception was added by the Free Software Foundation in - version 2.2 of Bison. */ - -#ifndef YY_YY_PARSER_H_INCLUDED -# define YY_YY_PARSER_H_INCLUDED -/* Debug traces. */ -#ifndef YYDEBUG -# define YYDEBUG 0 -#endif -#if YYDEBUG -extern int yydebug; -#endif - -/* Token type. */ -#ifndef YYTOKENTYPE -# define YYTOKENTYPE - enum yytokentype - { - TOKEN_EOF = 0, - THREEDIMENSIONAL = 258, - ABSENT = 259, - ACCEPT = 260, - ACCESS = 261, - ACTIVEX = 262, - ACTION = 263, - ACTUAL = 264, - ADD = 265, - ADDRESS = 266, - ADJUSTABLE_COLUMNS = 267, - ADVANCING = 268, - AFTER = 269, - ALIGNMENT = 270, - ALL = 271, - ALLOCATE = 272, - ALLOWING = 273, - ALPHABET = 274, - ALPHABETIC = 275, - ALPHABETIC_LOWER = 276, - ALPHABETIC_UPPER = 277, - ALPHANUMERIC = 278, - ALPHANUMERIC_EDITED = 279, - ALSO = 280, - ALTER = 281, - ALTERNATE = 282, - AND = 283, - ANY = 284, - APPLY = 285, - ARE = 286, - AREA = 287, - AREAS = 288, - ARGUMENT_NUMBER = 289, - ARGUMENT_VALUE = 290, - ARITHMETIC = 291, - AS = 292, - ASCENDING = 293, - ASCII = 294, - ASSIGN = 295, - AT = 296, - ATTRIBUTE = 297, - ATTRIBUTES = 298, - AUTO = 299, - AUTO_DECIMAL = 300, - AUTO_SPIN = 301, - AUTOMATIC = 302, - AWAY_FROM_ZERO = 303, - BACKGROUND_COLOR = 304, - BACKGROUND_HIGH = 305, - BACKGROUND_LOW = 306, - BACKGROUND_STANDARD = 307, - BAR = 308, - BASED = 309, - BEFORE = 310, - BELL = 311, - BINARY = 312, - BINARY_C_LONG = 313, - BINARY_CHAR = 314, - BINARY_DOUBLE = 315, - BINARY_LONG = 316, - BINARY_SEQUENTIAL = 317, - BINARY_SHORT = 318, - BIT = 319, - BITMAP = 320, - BITMAP_END = 321, - BITMAP_HANDLE = 322, - BITMAP_NUMBER = 323, - BITMAP_START = 324, - BITMAP_TIMER = 325, - BITMAP_TRAILING = 326, - BITMAP_TRANSPARENT_COLOR = 327, - BITMAP_WIDTH = 328, - BLANK = 329, - BLINK = 330, - BLOCK = 331, - BOTTOM = 332, - BOX = 333, - BOXED = 334, - BULK_ADDITION = 335, - BUSY = 336, - BUTTONS = 337, - BY = 338, - BYTE_LENGTH = 339, - C = 340, - CALENDAR_FONT = 341, - CALL = 342, - CANCEL = 343, - CANCEL_BUTTON = 344, - CAPACITY = 345, - CARD_PUNCH = 346, - CARD_READER = 347, - CASSETTE = 348, - CCOL = 349, - CD = 350, - CELL = 351, - CELL_COLOR = 352, - CELL_DATA = 353, - CELL_FONT = 354, - CELL_PROTECTION = 355, - CENTER = 356, - CENTERED = 357, - CENTERED_HEADINGS = 358, - CENTURY_DATE = 359, - CF = 360, - CH = 361, - CHAINING = 362, - CHARACTER = 363, - CHARACTERS = 364, - CHECK_BOX = 365, - CLASS = 366, - CLASSIFICATION = 367, - CLASS_NAME = 368, - CLEAR_SELECTION = 369, - CLINE = 370, - CLINES = 371, - CLOSE = 372, - COBOL = 373, - CODE = 374, - CODE_SET = 375, - COLLATING = 376, - COL = 377, - COLOR = 378, - COLORS = 379, - COLS = 380, - COLUMN = 381, - COLUMN_COLOR = 382, - COLUMN_DIVIDERS = 383, - COLUMN_FONT = 384, - COLUMN_HEADINGS = 385, - COLUMN_PROTECTION = 386, - COLUMNS = 387, - COMBO_BOX = 388, - COMMA = 389, - COMMAND_LINE = 390, - COMMA_DELIM = 391, - COMMIT = 392, - COMMON = 393, - COMMUNICATION = 394, - COMP = 395, - COMPUTE = 396, - COMP_0 = 397, - COMP_1 = 398, - COMP_2 = 399, - COMP_3 = 400, - COMP_4 = 401, - COMP_5 = 402, - COMP_6 = 403, - COMP_N = 404, - COMP_X = 405, - CONCATENATE_FUNC = 406, - CONDITION = 407, - CONFIGURATION = 408, - CONSTANT = 409, - CONTAINS = 410, - CONTENT = 411, - CONTENT_LENGTH_FUNC = 412, - CONTENT_OF_FUNC = 413, - CONTINUE = 414, - CONTROL = 415, - CONTROLS = 416, - CONVERSION = 417, - CONVERTING = 418, - COPY = 419, - COPY_SELECTION = 420, - CORE_INDEX = 421, - CORRESPONDING = 422, - COUNT = 423, - CRT = 424, - CRT_UNDER = 425, - CSIZE = 426, - CURRENCY = 427, - CURRENT_DATE_FUNC = 428, - CURSOR = 429, - CURSOR_COL = 430, - CURSOR_COLOR = 431, - CURSOR_FRAME_WIDTH = 432, - CURSOR_ROW = 433, - CURSOR_X = 434, - CURSOR_Y = 435, - CUSTOM_PRINT_TEMPLATE = 436, - CYCLE = 437, - CYL_INDEX = 438, - CYL_OVERFLOW = 439, - DASHED = 440, - DATA = 441, - DATA_COLUMNS = 442, - DATA_TYPES = 443, - DATE = 444, - DATE_ENTRY = 445, - DAY = 446, - DAY_OF_WEEK = 447, - DE = 448, - DEBUGGING = 449, - DECIMAL_POINT = 450, - DECLARATIVES = 451, - DEFAULT = 452, - DEFAULT_BUTTON = 453, - DEFAULT_FONT = 454, - DELETE = 455, - DELIMITED = 456, - DELIMITER = 457, - DEPENDING = 458, - DESCENDING = 459, - DESTINATION = 460, - DESTROY = 461, - DETAIL = 462, - DISABLE = 463, - DISC = 464, - DISK = 465, - DISP = 466, - DISPLAY = 467, - DISPLAY_COLUMNS = 468, - DISPLAY_FORMAT = 469, - DISPLAY_OF_FUNC = 470, - DIVIDE = 471, - DIVIDERS = 472, - DIVIDER_COLOR = 473, - DIVISION = 474, - DOTDASH = 475, - DOTTED = 476, - DRAG_COLOR = 477, - DROP_DOWN = 478, - DROP_LIST = 479, - DOWN = 480, - DUPLICATES = 481, - DYNAMIC = 482, - EBCDIC = 483, - EC = 484, - ECHO = 485, - EGI = 486, - EIGHTY_EIGHT = 487, - ENABLE = 488, - ENABLED = 489, - ELEMENT = 490, - ELSE = 491, - EMI = 492, - ENCRYPTION = 493, - ENCODING = 494, - END = 495, - END_ACCEPT = 496, - END_ADD = 497, - END_CALL = 498, - END_COMPUTE = 499, - END_COLOR = 500, - END_DELETE = 501, - END_DISPLAY = 502, - END_DIVIDE = 503, - END_EVALUATE = 504, - END_FUNCTION = 505, - END_IF = 506, - END_JSON = 507, - END_MODIFY = 508, - END_MULTIPLY = 509, - END_PERFORM = 510, - END_PROGRAM = 511, - END_READ = 512, - END_RECEIVE = 513, - END_RETURN = 514, - END_REWRITE = 515, - END_SEARCH = 516, - END_START = 517, - END_STRING = 518, - END_SUBTRACT = 519, - END_UNSTRING = 520, - END_WRITE = 521, - END_XML = 522, - ENGRAVED = 523, - ENSURE_VISIBLE = 524, - ENTRY = 525, - ENTRY_CONVENTION = 526, - ENTRY_FIELD = 527, - ENTRY_REASON = 528, - ENVIRONMENT = 529, - ENVIRONMENT_NAME = 530, - ENVIRONMENT_VALUE = 531, - EOL = 532, - EOP = 533, - EOS = 534, - EQUAL = 535, - ERASE = 536, - ERROR = 537, - ESCAPE = 538, - ESCAPE_BUTTON = 539, - ESI = 540, - EVALUATE = 541, - EVENT = 542, - EVENT_LIST = 543, - EVENT_STATUS = 544, - EVERY = 545, - EXCEPTION = 546, - EXCEPTION_CONDITION = 547, - EXCEPTION_VALUE = 548, - EXPAND = 549, - EXCLUSIVE = 550, - EXIT = 551, - EXPONENTIATION = 552, - EXTEND = 553, - EXTENDED_SEARCH = 554, - EXTERNAL = 555, - EXTERNAL_FORM = 556, - F = 557, - FD = 558, - FH__FCD = 559, - FH__KEYDEF = 560, - FILE_CONTROL = 561, - FILE_ID = 562, - FILE_LIMIT = 563, - FILE_LIMITS = 564, - FILE_NAME = 565, - FILE_POS = 566, - FILL_COLOR = 567, - FILL_COLOR2 = 568, - FILL_PERCENT = 569, - FILLER = 570, - FINAL = 571, - FINISH_REASON = 572, - FIRST = 573, - FIXED = 574, - FIXED_FONT = 575, - FIXED_WIDTH = 576, - FLAT = 577, - FLAT_BUTTONS = 578, - FLOAT_BINARY_128 = 579, - FLOAT_BINARY_32 = 580, - FLOAT_BINARY_64 = 581, - FLOAT_DECIMAL_16 = 582, - FLOAT_DECIMAL_34 = 583, - FLOAT_DECIMAL_7 = 584, - FLOAT_EXTENDED = 585, - FLOAT_LONG = 586, - FLOAT_SHORT = 587, - FLOATING = 588, - FONT = 589, - FOOTING = 590, - FOR = 591, - FOREGROUND_COLOR = 592, - FOREVER = 593, - FORMATTED_DATE_FUNC = 594, - FORMATTED_DATETIME_FUNC = 595, - FORMATTED_TIME_FUNC = 596, - FRAME = 597, - FRAMED = 598, - FREE = 599, - FROM = 600, - FROM_CRT = 601, - FULL = 602, - FULL_HEIGHT = 603, - FUNCTION = 604, - FUNCTION_ID = 605, - FUNCTION_NAME = 606, - GENERATE = 607, - GIVING = 608, - GLOBAL = 609, - GO = 610, - GO_BACK = 611, - GO_FORWARD = 612, - GO_HOME = 613, - GO_SEARCH = 614, - GOBACK = 615, - GRAPHICAL = 616, - GREATER = 617, - GREATER_OR_EQUAL = 618, - GRID = 619, - GROUP = 620, - GROUP_VALUE = 621, - HANDLE = 622, - HAS_CHILDREN = 623, - HEADING = 624, - HEADING_COLOR = 625, - HEADING_DIVIDER_COLOR = 626, - HEADING_FONT = 627, - HEAVY = 628, - HEIGHT_IN_CELLS = 629, - HELP_ID = 630, - HIDDEN_DATA = 631, - HIGHLIGHT = 632, - HIGH_COLOR = 633, - HIGH_VALUE = 634, - HOT_TRACK = 635, - HSCROLL = 636, - HSCROLL_POS = 637, - ICON = 638, - ID = 639, - IDENTIFIED = 640, - IDENTIFICATION = 641, - IF = 642, - IGNORE = 643, - IGNORING = 644, - IN = 645, - INDEPENDENT = 646, - INDEX = 647, - INDEXED = 648, - INDICATE = 649, - INITIALIZE = 650, - INITIALIZED = 651, - INITIATE = 652, - INPUT = 653, - INPUT_OUTPUT = 654, - INQUIRE = 655, - INSERTION_INDEX = 656, - INSERT_ROWS = 657, - INSPECT = 658, - INTERMEDIATE = 659, - INTO = 660, - INTRINSIC = 661, - INVALID = 662, - INVALID_KEY = 663, - IS = 664, - ITEM = 665, - ITEM_TEXT = 666, - ITEM_TO_ADD = 667, - ITEM_TO_DELETE = 668, - ITEM_TO_EMPTY = 669, - ITEM_VALUE = 670, - I_O = 671, - I_O_CONTROL = 672, - JSON = 673, - JUSTIFIED = 674, - KEPT = 675, - KEY = 676, - KEYBOARD = 677, - LABEL = 678, - LABEL_OFFSET = 679, - LARGE_FONT = 680, - LARGE_OFFSET = 681, - LAST = 682, - LAST_ROW = 683, - LAYOUT_DATA = 684, - LAYOUT_MANAGER = 685, - LEADING = 686, - LEADING_SHIFT = 687, - LEAVE = 688, - LEFT = 689, - LEFTLINE = 690, - LEFT_TEXT = 691, - LENGTH = 692, - LENGTH_OF = 693, - LENGTH_FUNC = 694, - LESS = 695, - LESS_OR_EQUAL = 696, - LEVEL_NUMBER = 697, - LIMIT = 698, - LIMITS = 699, - LINAGE = 700, - LINAGE_COUNTER = 701, - LINE = 702, - LINE_COUNTER = 703, - LINE_LIMIT = 704, - LINE_SEQUENTIAL = 705, - LINES = 706, - LINES_AT_ROOT = 707, - LINKAGE = 708, - LIST_BOX = 709, - LITERAL = 710, - LM_RESIZE = 711, - LOC = 712, - LOCALE = 713, - LOCALE_DATE_FUNC = 714, - LOCALE_TIME_FUNC = 715, - LOCALE_TIME_FROM_FUNC = 716, - LOCAL_STORAGE = 717, - LOCK = 718, - LOCK_HOLDING = 719, - LONG_DATE = 720, - LOWER = 721, - LOWERED = 722, - LOWER_CASE_FUNC = 723, - LOWLIGHT = 724, - LOW_COLOR = 725, - LOW_VALUE = 726, - MAGNETIC_TAPE = 727, - MANUAL = 728, - MASS_UPDATE = 729, - MASTER_INDEX = 730, - MAX_LINES = 731, - MAX_PROGRESS = 732, - MAX_TEXT = 733, - MAX_VAL = 734, - MEMORY = 735, - MEDIUM_FONT = 736, - MENU = 737, - MERGE = 738, - MESSAGE = 739, - MINUS = 740, - MIN_VAL = 741, - MNEMONIC_NAME = 742, - MODE = 743, - MODIFY = 744, - MODULES = 745, - MOVE = 746, - MULTILINE = 747, - MULTIPLE = 748, - MULTIPLY = 749, - NAME = 750, - NAMESPACE = 751, - NAMESPACE_PREFIX = 752, - NATIONAL = 753, - NATIONAL_EDITED = 754, - NATIONAL_OF_FUNC = 755, - NATIVE = 756, - NAVIGATE_URL = 757, - NEAREST_AWAY_FROM_ZERO = 758, - NEAREST_EVEN = 759, - NEAREST_TOWARD_ZERO = 760, - NEGATIVE = 761, - NESTED = 762, - NEW = 763, - NEXT = 764, - NEXT_ITEM = 765, - NEXT_GROUP = 766, - NEXT_PAGE = 767, - NO = 768, - NO_ADVANCING = 769, - NO_AUTOSEL = 770, - NO_AUTO_DEFAULT = 771, - NO_BOX = 772, - NO_DATA = 773, - NO_DIVIDERS = 774, - NO_ECHO = 775, - NO_F4 = 776, - NO_FOCUS = 777, - NO_GROUP_TAB = 778, - NO_KEY_LETTER = 779, - NOMINAL = 780, - NO_SEARCH = 781, - NO_UPDOWN = 782, - NONNUMERIC = 783, - NORMAL = 784, - NOT = 785, - NOTAB = 786, - NOTHING = 787, - NOTIFY = 788, - NOTIFY_CHANGE = 789, - NOTIFY_DBLCLICK = 790, - NOTIFY_SELCHANGE = 791, - NOT_END = 792, - NOT_EOP = 793, - NOT_ESCAPE = 794, - NOT_EQUAL = 795, - NOT_EXCEPTION = 796, - NOT_INVALID_KEY = 797, - NOT_OVERFLOW = 798, - NOT_SIZE_ERROR = 799, - NUM_COL_HEADINGS = 800, - NUM_ROWS = 801, - NUMBER = 802, - NUMBERS = 803, - NUMERIC = 804, - NUMERIC_EDITED = 805, - NUMVALC_FUNC = 806, - OBJECT = 807, - OBJECT_COMPUTER = 808, - OCCURS = 809, - OF = 810, - OFF = 811, - OK_BUTTON = 812, - OMITTED = 813, - ON = 814, - ONLY = 815, - OPEN = 816, - OPTIONAL = 817, - OPTIONS = 818, - OR = 819, - ORDER = 820, - ORGANIZATION = 821, - OTHER = 822, - OTHERS = 823, - OUTPUT = 824, - OVERLAP_LEFT = 825, - OVERLAP_TOP = 826, - OVERLINE = 827, - PACKED_DECIMAL = 828, - PADDING = 829, - PASCAL = 830, - PAGE = 831, - PAGE_COUNTER = 832, - PAGE_SETUP = 833, - PAGED = 834, - PARAGRAPH = 835, - PARENT = 836, - PARSE = 837, - PASSWORD = 838, - PERFORM = 839, - PERMANENT = 840, - PH = 841, - PF = 842, - PHYSICAL = 843, - PICTURE = 844, - PICTURE_SYMBOL = 845, - PIXEL = 846, - PLACEMENT = 847, - PLUS = 848, - POINTER = 849, - POP_UP = 850, - POS = 851, - POSITION = 852, - POSITION_SHIFT = 853, - POSITIVE = 854, - PRESENT = 855, - PREVIOUS = 856, - PRINT = 857, - PRINT_CONTROL = 858, - PRINT_NO_PROMPT = 859, - PRINT_PREVIEW = 860, - PRINTER = 861, - PRINTER_1 = 862, - PRINTING = 863, - PRIORITY = 864, - PROCEDURE = 865, - PROCEDURES = 866, - PROCEED = 867, - PROCESSING = 868, - PROGRAM = 869, - PROGRAM_ID = 870, - PROGRAM_NAME = 871, - PROGRAM_POINTER = 872, - PROGRESS = 873, - PROHIBITED = 874, - PROMPT = 875, - PROPERTIES = 876, - PROPERTY = 877, - PROTECTED = 878, - PROTOTYPE = 879, - PURGE = 880, - PUSH_BUTTON = 881, - QUERY_INDEX = 882, - QUEUE = 883, - QUOTE = 884, - RADIO_BUTTON = 885, - RAISE = 886, - RAISED = 887, - RANDOM = 888, - RD = 889, - READ = 890, - READERS = 891, - READ_ONLY = 892, - READY_TRACE = 893, - RECEIVE = 894, - RECORD = 895, - RECORD_DATA = 896, - RECORD_OVERFLOW = 897, - RECORD_TO_ADD = 898, - RECORD_TO_DELETE = 899, - RECORDING = 900, - RECORDS = 901, - RECURSIVE = 902, - REDEFINES = 903, - REEL = 904, - REFERENCE = 905, - REFERENCES = 906, - REFRESH = 907, - REGION_COLOR = 908, - RELATIVE = 909, - RELEASE = 910, - REMAINDER = 911, - REMOVAL = 912, - RENAMES = 913, - REORG_CRITERIA = 914, - REPLACE = 915, - REPLACING = 916, - REPORT = 917, - REPORTING = 918, - REPORTS = 919, - REPOSITORY = 920, - REQUIRED = 921, - REREAD = 922, - RERUN = 923, - RESERVE = 924, - RESET = 925, - RESET_TRACE = 926, - RESET_GRID = 927, - RESET_LIST = 928, - RESET_TABS = 929, - RESIDENT = 930, - RETRY = 931, - RETURN = 932, - RETURNING = 933, - REVERSE = 934, - REVERSE_FUNC = 935, - REVERSE_VIDEO = 936, - REVERSED = 937, - REWIND = 938, - REWRITE = 939, - RF = 940, - RH = 941, - RIGHT = 942, - RIGHT_ALIGN = 943, - RIMMED = 944, - ROLLBACK = 945, - ROUNDED = 946, - ROUNDING = 947, - ROW_COLOR = 948, - ROW_COLOR_PATTERN = 949, - ROW_DIVIDERS = 950, - ROW_FONT = 951, - ROW_HEADINGS = 952, - ROW_PROTECTION = 953, - RUN = 954, - S = 955, - SAME = 956, - SAVE_AS = 957, - SAVE_AS_NO_PROMPT = 958, - SCREEN = 959, - SCREEN_CONTROL = 960, - SCROLL = 961, - SCROLL_BAR = 962, - SD = 963, - SEARCH = 964, - SEARCH_OPTIONS = 965, - SEARCH_TEXT = 966, - SECONDS = 967, - SECTION = 968, - SECURE = 969, - SEGMENT = 970, - SEGMENT_LIMIT = 971, - SELECT = 972, - SELECTION_INDEX = 973, - SELECTION_TEXT = 974, - SELECT_ALL = 975, - SELF_ACT = 976, - SEMI_COLON = 977, - SEND = 978, - SENTENCE = 979, - SEPARATE = 980, - SEPARATION = 981, - SEQUENCE = 982, - SEQUENTIAL = 983, - SET = 984, - SEVENTY_EIGHT = 985, - SHADING = 986, - SHADOW = 987, - SHARING = 988, - SHORT_DATE = 989, - SHOW_LINES = 990, - SHOW_NONE = 991, - SHOW_SEL_ALWAYS = 992, - SIGN = 993, - SIGNED = 994, - SIGNED_INT = 995, - SIGNED_LONG = 996, - SIGNED_SHORT = 997, - SIXTY_SIX = 998, - SIZE = 999, - SIZE_ERROR = 1000, - SMALL_FONT = 1001, - SORT = 1002, - SORT_MERGE = 1003, - SORT_ORDER = 1004, - SOURCE = 1005, - SOURCE_COMPUTER = 1006, - SPACE = 1007, - SPECIAL_NAMES = 1008, - SPINNER = 1009, - SQUARE = 1010, - STANDARD = 1011, - STANDARD_1 = 1012, - STANDARD_2 = 1013, - STANDARD_BINARY = 1014, - STANDARD_DECIMAL = 1015, - START = 1016, - START_X = 1017, - START_Y = 1018, - STATIC = 1019, - STATIC_LIST = 1020, - STATUS = 1021, - STATUS_BAR = 1022, - STATUS_TEXT = 1023, - STDCALL = 1024, - STEP = 1025, - STOP = 1026, - STRING = 1027, - STYLE = 1028, - SUB_QUEUE_1 = 1029, - SUB_QUEUE_2 = 1030, - SUB_QUEUE_3 = 1031, - SUBSTITUTE_FUNC = 1032, - SUBSTITUTE_CASE_FUNC = 1033, - SUBTRACT = 1034, - SUBWINDOW = 1035, - SUM = 1036, - SUPPRESS = 1037, - SUPPRESS_XML = 1038, - SYMBOLIC = 1039, - SYNCHRONIZED = 1040, - SYSTEM_DEFAULT = 1041, - SYSTEM_INFO = 1042, - SYSTEM_OFFSET = 1043, - TAB = 1044, - TAB_TO_ADD = 1045, - TAB_TO_DELETE = 1046, - TABLE = 1047, - TALLYING = 1048, - TEMPORARY = 1049, - TAPE = 1050, - TERMINAL = 1051, - TERMINATE = 1052, - TERMINAL_INFO = 1053, - TERMINATION_VALUE = 1054, - TEST = 1055, - TEXT = 1056, - THAN = 1057, - THEN = 1058, - THREAD = 1059, - THREADS = 1060, - THRU = 1061, - THUMB_POSITION = 1062, - TILED_HEADINGS = 1063, - TIME = 1064, - TIME_OUT = 1065, - TIMES = 1066, - TITLE = 1067, - TITLE_POSITION = 1068, - TO = 1069, - TOK_AMPER = 1070, - TOK_CLOSE_PAREN = 1071, - TOK_COLON = 1072, - TOK_DIV = 1073, - TOK_DOT = 1074, - TOK_EQUAL = 1075, - TOK_EXTERN = 1076, - TOK_FALSE = 1077, - TOK_FILE = 1078, - TOK_GREATER = 1079, - TOK_INITIAL = 1080, - TOK_LESS = 1081, - TOK_MINUS = 1082, - TOK_MUL = 1083, - TOK_NULL = 1084, - TOK_OVERFLOW = 1085, - TOK_OPEN_PAREN = 1086, - TOK_PLUS = 1087, - TOK_TRUE = 1088, - TOP = 1089, - TOWARD_GREATER = 1090, - TOWARD_LESSER = 1091, - TRACK = 1092, - TRACKS = 1093, - TRACK_AREA = 1094, - TRACK_LIMIT = 1095, - TRADITIONAL_FONT = 1096, - TRAILING = 1097, - TRAILING_SHIFT = 1098, - TRANSACTION = 1099, - TRANSFORM = 1100, - TRANSPARENT = 1101, - TREE_VIEW = 1102, - TRIM_FUNC = 1103, - TRUNCATION = 1104, - TYPE = 1105, - U = 1106, - UCS_4 = 1107, - UNBOUNDED = 1108, - UNDERLINE = 1109, - UNFRAMED = 1110, - UNIT = 1111, - UNLOCK = 1112, - UNSIGNED = 1113, - UNSIGNED_INT = 1114, - UNSIGNED_LONG = 1115, - UNSIGNED_SHORT = 1116, - UNSORTED = 1117, - UNSTRING = 1118, - UNTIL = 1119, - UP = 1120, - UPDATE = 1121, - UPDATERS = 1122, - UPON = 1123, - UPON_ARGUMENT_NUMBER = 1124, - UPON_COMMAND_LINE = 1125, - UPON_ENVIRONMENT_NAME = 1126, - UPON_ENVIRONMENT_VALUE = 1127, - UPPER = 1128, - UPPER_CASE_FUNC = 1129, - USAGE = 1130, - USE = 1131, - USE_ALT = 1132, - USE_RETURN = 1133, - USE_TAB = 1134, - USER = 1135, - USER_DEFAULT = 1136, - USER_FUNCTION_NAME = 1137, - USING = 1138, - UTF_8 = 1139, - UTF_16 = 1140, - V = 1141, - VALIDATE = 1142, - VALIDATING = 1143, - VALUE = 1144, - VALUE_FORMAT = 1145, - VARIABLE = 1146, - VARIANT = 1147, - VARYING = 1148, - VERTICAL = 1149, - VERY_HEAVY = 1150, - VIRTUAL_WIDTH = 1151, - VISIBLE = 1152, - VOLATILE = 1153, - VPADDING = 1154, - VSCROLL = 1155, - VSCROLL_BAR = 1156, - VSCROLL_POS = 1157, - VTOP = 1158, - WAIT = 1159, - WEB_BROWSER = 1160, - WHEN = 1161, - WHEN_COMPILED_FUNC = 1162, - WHEN_XML = 1163, - WIDTH = 1164, - WIDTH_IN_CELLS = 1165, - WINDOW = 1166, - WITH = 1167, - WORD = 1168, - WORDS = 1169, - WORKING_STORAGE = 1170, - WRAP = 1171, - WRITE = 1172, - WRITE_ONLY = 1173, - WRITE_VERIFY = 1174, - WRITERS = 1175, - X = 1176, - XML = 1177, - XML_DECLARATION = 1178, - Y = 1179, - YYYYDDD = 1180, - YYYYMMDD = 1181, - ZERO = 1182, - SHIFT_PREFER = 1183 - }; -#endif -/* Tokens. */ -#define TOKEN_EOF 0 -#define THREEDIMENSIONAL 258 -#define ABSENT 259 -#define ACCEPT 260 -#define ACCESS 261 -#define ACTIVEX 262 -#define ACTION 263 -#define ACTUAL 264 -#define ADD 265 -#define ADDRESS 266 -#define ADJUSTABLE_COLUMNS 267 -#define ADVANCING 268 -#define AFTER 269 -#define ALIGNMENT 270 -#define ALL 271 -#define ALLOCATE 272 -#define ALLOWING 273 -#define ALPHABET 274 -#define ALPHABETIC 275 -#define ALPHABETIC_LOWER 276 -#define ALPHABETIC_UPPER 277 -#define ALPHANUMERIC 278 -#define ALPHANUMERIC_EDITED 279 -#define ALSO 280 -#define ALTER 281 -#define ALTERNATE 282 -#define AND 283 -#define ANY 284 -#define APPLY 285 -#define ARE 286 -#define AREA 287 -#define AREAS 288 -#define ARGUMENT_NUMBER 289 -#define ARGUMENT_VALUE 290 -#define ARITHMETIC 291 -#define AS 292 -#define ASCENDING 293 -#define ASCII 294 -#define ASSIGN 295 -#define AT 296 -#define ATTRIBUTE 297 -#define ATTRIBUTES 298 -#define AUTO 299 -#define AUTO_DECIMAL 300 -#define AUTO_SPIN 301 -#define AUTOMATIC 302 -#define AWAY_FROM_ZERO 303 -#define BACKGROUND_COLOR 304 -#define BACKGROUND_HIGH 305 -#define BACKGROUND_LOW 306 -#define BACKGROUND_STANDARD 307 -#define BAR 308 -#define BASED 309 -#define BEFORE 310 -#define BELL 311 -#define BINARY 312 -#define BINARY_C_LONG 313 -#define BINARY_CHAR 314 -#define BINARY_DOUBLE 315 -#define BINARY_LONG 316 -#define BINARY_SEQUENTIAL 317 -#define BINARY_SHORT 318 -#define BIT 319 -#define BITMAP 320 -#define BITMAP_END 321 -#define BITMAP_HANDLE 322 -#define BITMAP_NUMBER 323 -#define BITMAP_START 324 -#define BITMAP_TIMER 325 -#define BITMAP_TRAILING 326 -#define BITMAP_TRANSPARENT_COLOR 327 -#define BITMAP_WIDTH 328 -#define BLANK 329 -#define BLINK 330 -#define BLOCK 331 -#define BOTTOM 332 -#define BOX 333 -#define BOXED 334 -#define BULK_ADDITION 335 -#define BUSY 336 -#define BUTTONS 337 -#define BY 338 -#define BYTE_LENGTH 339 -#define C 340 -#define CALENDAR_FONT 341 -#define CALL 342 -#define CANCEL 343 -#define CANCEL_BUTTON 344 -#define CAPACITY 345 -#define CARD_PUNCH 346 -#define CARD_READER 347 -#define CASSETTE 348 -#define CCOL 349 -#define CD 350 -#define CELL 351 -#define CELL_COLOR 352 -#define CELL_DATA 353 -#define CELL_FONT 354 -#define CELL_PROTECTION 355 -#define CENTER 356 -#define CENTERED 357 -#define CENTERED_HEADINGS 358 -#define CENTURY_DATE 359 -#define CF 360 -#define CH 361 -#define CHAINING 362 -#define CHARACTER 363 -#define CHARACTERS 364 -#define CHECK_BOX 365 -#define CLASS 366 -#define CLASSIFICATION 367 -#define CLASS_NAME 368 -#define CLEAR_SELECTION 369 -#define CLINE 370 -#define CLINES 371 -#define CLOSE 372 -#define COBOL 373 -#define CODE 374 -#define CODE_SET 375 -#define COLLATING 376 -#define COL 377 -#define COLOR 378 -#define COLORS 379 -#define COLS 380 -#define COLUMN 381 -#define COLUMN_COLOR 382 -#define COLUMN_DIVIDERS 383 -#define COLUMN_FONT 384 -#define COLUMN_HEADINGS 385 -#define COLUMN_PROTECTION 386 -#define COLUMNS 387 -#define COMBO_BOX 388 -#define COMMA 389 -#define COMMAND_LINE 390 -#define COMMA_DELIM 391 -#define COMMIT 392 -#define COMMON 393 -#define COMMUNICATION 394 -#define COMP 395 -#define COMPUTE 396 -#define COMP_0 397 -#define COMP_1 398 -#define COMP_2 399 -#define COMP_3 400 -#define COMP_4 401 -#define COMP_5 402 -#define COMP_6 403 -#define COMP_N 404 -#define COMP_X 405 -#define CONCATENATE_FUNC 406 -#define CONDITION 407 -#define CONFIGURATION 408 -#define CONSTANT 409 -#define CONTAINS 410 -#define CONTENT 411 -#define CONTENT_LENGTH_FUNC 412 -#define CONTENT_OF_FUNC 413 -#define CONTINUE 414 -#define CONTROL 415 -#define CONTROLS 416 -#define CONVERSION 417 -#define CONVERTING 418 -#define COPY 419 -#define COPY_SELECTION 420 -#define CORE_INDEX 421 -#define CORRESPONDING 422 -#define COUNT 423 -#define CRT 424 -#define CRT_UNDER 425 -#define CSIZE 426 -#define CURRENCY 427 -#define CURRENT_DATE_FUNC 428 -#define CURSOR 429 -#define CURSOR_COL 430 -#define CURSOR_COLOR 431 -#define CURSOR_FRAME_WIDTH 432 -#define CURSOR_ROW 433 -#define CURSOR_X 434 -#define CURSOR_Y 435 -#define CUSTOM_PRINT_TEMPLATE 436 -#define CYCLE 437 -#define CYL_INDEX 438 -#define CYL_OVERFLOW 439 -#define DASHED 440 -#define DATA 441 -#define DATA_COLUMNS 442 -#define DATA_TYPES 443 -#define DATE 444 -#define DATE_ENTRY 445 -#define DAY 446 -#define DAY_OF_WEEK 447 -#define DE 448 -#define DEBUGGING 449 -#define DECIMAL_POINT 450 -#define DECLARATIVES 451 -#define DEFAULT 452 -#define DEFAULT_BUTTON 453 -#define DEFAULT_FONT 454 -#define DELETE 455 -#define DELIMITED 456 -#define DELIMITER 457 -#define DEPENDING 458 -#define DESCENDING 459 -#define DESTINATION 460 -#define DESTROY 461 -#define DETAIL 462 -#define DISABLE 463 -#define DISC 464 -#define DISK 465 -#define DISP 466 -#define DISPLAY 467 -#define DISPLAY_COLUMNS 468 -#define DISPLAY_FORMAT 469 -#define DISPLAY_OF_FUNC 470 -#define DIVIDE 471 -#define DIVIDERS 472 -#define DIVIDER_COLOR 473 -#define DIVISION 474 -#define DOTDASH 475 -#define DOTTED 476 -#define DRAG_COLOR 477 -#define DROP_DOWN 478 -#define DROP_LIST 479 -#define DOWN 480 -#define DUPLICATES 481 -#define DYNAMIC 482 -#define EBCDIC 483 -#define EC 484 -#define ECHO 485 -#define EGI 486 -#define EIGHTY_EIGHT 487 -#define ENABLE 488 -#define ENABLED 489 -#define ELEMENT 490 -#define ELSE 491 -#define EMI 492 -#define ENCRYPTION 493 -#define ENCODING 494 -#define END 495 -#define END_ACCEPT 496 -#define END_ADD 497 -#define END_CALL 498 -#define END_COMPUTE 499 -#define END_COLOR 500 -#define END_DELETE 501 -#define END_DISPLAY 502 -#define END_DIVIDE 503 -#define END_EVALUATE 504 -#define END_FUNCTION 505 -#define END_IF 506 -#define END_JSON 507 -#define END_MODIFY 508 -#define END_MULTIPLY 509 -#define END_PERFORM 510 -#define END_PROGRAM 511 -#define END_READ 512 -#define END_RECEIVE 513 -#define END_RETURN 514 -#define END_REWRITE 515 -#define END_SEARCH 516 -#define END_START 517 -#define END_STRING 518 -#define END_SUBTRACT 519 -#define END_UNSTRING 520 -#define END_WRITE 521 -#define END_XML 522 -#define ENGRAVED 523 -#define ENSURE_VISIBLE 524 -#define ENTRY 525 -#define ENTRY_CONVENTION 526 -#define ENTRY_FIELD 527 -#define ENTRY_REASON 528 -#define ENVIRONMENT 529 -#define ENVIRONMENT_NAME 530 -#define ENVIRONMENT_VALUE 531 -#define EOL 532 -#define EOP 533 -#define EOS 534 -#define EQUAL 535 -#define ERASE 536 -#define ERROR 537 -#define ESCAPE 538 -#define ESCAPE_BUTTON 539 -#define ESI 540 -#define EVALUATE 541 -#define EVENT 542 -#define EVENT_LIST 543 -#define EVENT_STATUS 544 -#define EVERY 545 -#define EXCEPTION 546 -#define EXCEPTION_CONDITION 547 -#define EXCEPTION_VALUE 548 -#define EXPAND 549 -#define EXCLUSIVE 550 -#define EXIT 551 -#define EXPONENTIATION 552 -#define EXTEND 553 -#define EXTENDED_SEARCH 554 -#define EXTERNAL 555 -#define EXTERNAL_FORM 556 -#define F 557 -#define FD 558 -#define FH__FCD 559 -#define FH__KEYDEF 560 -#define FILE_CONTROL 561 -#define FILE_ID 562 -#define FILE_LIMIT 563 -#define FILE_LIMITS 564 -#define FILE_NAME 565 -#define FILE_POS 566 -#define FILL_COLOR 567 -#define FILL_COLOR2 568 -#define FILL_PERCENT 569 -#define FILLER 570 -#define FINAL 571 -#define FINISH_REASON 572 -#define FIRST 573 -#define FIXED 574 -#define FIXED_FONT 575 -#define FIXED_WIDTH 576 -#define FLAT 577 -#define FLAT_BUTTONS 578 -#define FLOAT_BINARY_128 579 -#define FLOAT_BINARY_32 580 -#define FLOAT_BINARY_64 581 -#define FLOAT_DECIMAL_16 582 -#define FLOAT_DECIMAL_34 583 -#define FLOAT_DECIMAL_7 584 -#define FLOAT_EXTENDED 585 -#define FLOAT_LONG 586 -#define FLOAT_SHORT 587 -#define FLOATING 588 -#define FONT 589 -#define FOOTING 590 -#define FOR 591 -#define FOREGROUND_COLOR 592 -#define FOREVER 593 -#define FORMATTED_DATE_FUNC 594 -#define FORMATTED_DATETIME_FUNC 595 -#define FORMATTED_TIME_FUNC 596 -#define FRAME 597 -#define FRAMED 598 -#define FREE 599 -#define FROM 600 -#define FROM_CRT 601 -#define FULL 602 -#define FULL_HEIGHT 603 -#define FUNCTION 604 -#define FUNCTION_ID 605 -#define FUNCTION_NAME 606 -#define GENERATE 607 -#define GIVING 608 -#define GLOBAL 609 -#define GO 610 -#define GO_BACK 611 -#define GO_FORWARD 612 -#define GO_HOME 613 -#define GO_SEARCH 614 -#define GOBACK 615 -#define GRAPHICAL 616 -#define GREATER 617 -#define GREATER_OR_EQUAL 618 -#define GRID 619 -#define GROUP 620 -#define GROUP_VALUE 621 -#define HANDLE 622 -#define HAS_CHILDREN 623 -#define HEADING 624 -#define HEADING_COLOR 625 -#define HEADING_DIVIDER_COLOR 626 -#define HEADING_FONT 627 -#define HEAVY 628 -#define HEIGHT_IN_CELLS 629 -#define HELP_ID 630 -#define HIDDEN_DATA 631 -#define HIGHLIGHT 632 -#define HIGH_COLOR 633 -#define HIGH_VALUE 634 -#define HOT_TRACK 635 -#define HSCROLL 636 -#define HSCROLL_POS 637 -#define ICON 638 -#define ID 639 -#define IDENTIFIED 640 -#define IDENTIFICATION 641 -#define IF 642 -#define IGNORE 643 -#define IGNORING 644 -#define IN 645 -#define INDEPENDENT 646 -#define INDEX 647 -#define INDEXED 648 -#define INDICATE 649 -#define INITIALIZE 650 -#define INITIALIZED 651 -#define INITIATE 652 -#define INPUT 653 -#define INPUT_OUTPUT 654 -#define INQUIRE 655 -#define INSERTION_INDEX 656 -#define INSERT_ROWS 657 -#define INSPECT 658 -#define INTERMEDIATE 659 -#define INTO 660 -#define INTRINSIC 661 -#define INVALID 662 -#define INVALID_KEY 663 -#define IS 664 -#define ITEM 665 -#define ITEM_TEXT 666 -#define ITEM_TO_ADD 667 -#define ITEM_TO_DELETE 668 -#define ITEM_TO_EMPTY 669 -#define ITEM_VALUE 670 -#define I_O 671 -#define I_O_CONTROL 672 -#define JSON 673 -#define JUSTIFIED 674 -#define KEPT 675 -#define KEY 676 -#define KEYBOARD 677 -#define LABEL 678 -#define LABEL_OFFSET 679 -#define LARGE_FONT 680 -#define LARGE_OFFSET 681 -#define LAST 682 -#define LAST_ROW 683 -#define LAYOUT_DATA 684 -#define LAYOUT_MANAGER 685 -#define LEADING 686 -#define LEADING_SHIFT 687 -#define LEAVE 688 -#define LEFT 689 -#define LEFTLINE 690 -#define LEFT_TEXT 691 -#define LENGTH 692 -#define LENGTH_OF 693 -#define LENGTH_FUNC 694 -#define LESS 695 -#define LESS_OR_EQUAL 696 -#define LEVEL_NUMBER 697 -#define LIMIT 698 -#define LIMITS 699 -#define LINAGE 700 -#define LINAGE_COUNTER 701 -#define LINE 702 -#define LINE_COUNTER 703 -#define LINE_LIMIT 704 -#define LINE_SEQUENTIAL 705 -#define LINES 706 -#define LINES_AT_ROOT 707 -#define LINKAGE 708 -#define LIST_BOX 709 -#define LITERAL 710 -#define LM_RESIZE 711 -#define LOC 712 -#define LOCALE 713 -#define LOCALE_DATE_FUNC 714 -#define LOCALE_TIME_FUNC 715 -#define LOCALE_TIME_FROM_FUNC 716 -#define LOCAL_STORAGE 717 -#define LOCK 718 -#define LOCK_HOLDING 719 -#define LONG_DATE 720 -#define LOWER 721 -#define LOWERED 722 -#define LOWER_CASE_FUNC 723 -#define LOWLIGHT 724 -#define LOW_COLOR 725 -#define LOW_VALUE 726 -#define MAGNETIC_TAPE 727 -#define MANUAL 728 -#define MASS_UPDATE 729 -#define MASTER_INDEX 730 -#define MAX_LINES 731 -#define MAX_PROGRESS 732 -#define MAX_TEXT 733 -#define MAX_VAL 734 -#define MEMORY 735 -#define MEDIUM_FONT 736 -#define MENU 737 -#define MERGE 738 -#define MESSAGE 739 -#define MINUS 740 -#define MIN_VAL 741 -#define MNEMONIC_NAME 742 -#define MODE 743 -#define MODIFY 744 -#define MODULES 745 -#define MOVE 746 -#define MULTILINE 747 -#define MULTIPLE 748 -#define MULTIPLY 749 -#define NAME 750 -#define NAMESPACE 751 -#define NAMESPACE_PREFIX 752 -#define NATIONAL 753 -#define NATIONAL_EDITED 754 -#define NATIONAL_OF_FUNC 755 -#define NATIVE 756 -#define NAVIGATE_URL 757 -#define NEAREST_AWAY_FROM_ZERO 758 -#define NEAREST_EVEN 759 -#define NEAREST_TOWARD_ZERO 760 -#define NEGATIVE 761 -#define NESTED 762 -#define NEW 763 -#define NEXT 764 -#define NEXT_ITEM 765 -#define NEXT_GROUP 766 -#define NEXT_PAGE 767 -#define NO 768 -#define NO_ADVANCING 769 -#define NO_AUTOSEL 770 -#define NO_AUTO_DEFAULT 771 -#define NO_BOX 772 -#define NO_DATA 773 -#define NO_DIVIDERS 774 -#define NO_ECHO 775 -#define NO_F4 776 -#define NO_FOCUS 777 -#define NO_GROUP_TAB 778 -#define NO_KEY_LETTER 779 -#define NOMINAL 780 -#define NO_SEARCH 781 -#define NO_UPDOWN 782 -#define NONNUMERIC 783 -#define NORMAL 784 -#define NOT 785 -#define NOTAB 786 -#define NOTHING 787 -#define NOTIFY 788 -#define NOTIFY_CHANGE 789 -#define NOTIFY_DBLCLICK 790 -#define NOTIFY_SELCHANGE 791 -#define NOT_END 792 -#define NOT_EOP 793 -#define NOT_ESCAPE 794 -#define NOT_EQUAL 795 -#define NOT_EXCEPTION 796 -#define NOT_INVALID_KEY 797 -#define NOT_OVERFLOW 798 -#define NOT_SIZE_ERROR 799 -#define NUM_COL_HEADINGS 800 -#define NUM_ROWS 801 -#define NUMBER 802 -#define NUMBERS 803 -#define NUMERIC 804 -#define NUMERIC_EDITED 805 -#define NUMVALC_FUNC 806 -#define OBJECT 807 -#define OBJECT_COMPUTER 808 -#define OCCURS 809 -#define OF 810 -#define OFF 811 -#define OK_BUTTON 812 -#define OMITTED 813 -#define ON 814 -#define ONLY 815 -#define OPEN 816 -#define OPTIONAL 817 -#define OPTIONS 818 -#define OR 819 -#define ORDER 820 -#define ORGANIZATION 821 -#define OTHER 822 -#define OTHERS 823 -#define OUTPUT 824 -#define OVERLAP_LEFT 825 -#define OVERLAP_TOP 826 -#define OVERLINE 827 -#define PACKED_DECIMAL 828 -#define PADDING 829 -#define PASCAL 830 -#define PAGE 831 -#define PAGE_COUNTER 832 -#define PAGE_SETUP 833 -#define PAGED 834 -#define PARAGRAPH 835 -#define PARENT 836 -#define PARSE 837 -#define PASSWORD 838 -#define PERFORM 839 -#define PERMANENT 840 -#define PH 841 -#define PF 842 -#define PHYSICAL 843 -#define PICTURE 844 -#define PICTURE_SYMBOL 845 -#define PIXEL 846 -#define PLACEMENT 847 -#define PLUS 848 -#define POINTER 849 -#define POP_UP 850 -#define POS 851 -#define POSITION 852 -#define POSITION_SHIFT 853 -#define POSITIVE 854 -#define PRESENT 855 -#define PREVIOUS 856 -#define PRINT 857 -#define PRINT_CONTROL 858 -#define PRINT_NO_PROMPT 859 -#define PRINT_PREVIEW 860 -#define PRINTER 861 -#define PRINTER_1 862 -#define PRINTING 863 -#define PRIORITY 864 -#define PROCEDURE 865 -#define PROCEDURES 866 -#define PROCEED 867 -#define PROCESSING 868 -#define PROGRAM 869 -#define PROGRAM_ID 870 -#define PROGRAM_NAME 871 -#define PROGRAM_POINTER 872 -#define PROGRESS 873 -#define PROHIBITED 874 -#define PROMPT 875 -#define PROPERTIES 876 -#define PROPERTY 877 -#define PROTECTED 878 -#define PROTOTYPE 879 -#define PURGE 880 -#define PUSH_BUTTON 881 -#define QUERY_INDEX 882 -#define QUEUE 883 -#define QUOTE 884 -#define RADIO_BUTTON 885 -#define RAISE 886 -#define RAISED 887 -#define RANDOM 888 -#define RD 889 -#define READ 890 -#define READERS 891 -#define READ_ONLY 892 -#define READY_TRACE 893 -#define RECEIVE 894 -#define RECORD 895 -#define RECORD_DATA 896 -#define RECORD_OVERFLOW 897 -#define RECORD_TO_ADD 898 -#define RECORD_TO_DELETE 899 -#define RECORDING 900 -#define RECORDS 901 -#define RECURSIVE 902 -#define REDEFINES 903 -#define REEL 904 -#define REFERENCE 905 -#define REFERENCES 906 -#define REFRESH 907 -#define REGION_COLOR 908 -#define RELATIVE 909 -#define RELEASE 910 -#define REMAINDER 911 -#define REMOVAL 912 -#define RENAMES 913 -#define REORG_CRITERIA 914 -#define REPLACE 915 -#define REPLACING 916 -#define REPORT 917 -#define REPORTING 918 -#define REPORTS 919 -#define REPOSITORY 920 -#define REQUIRED 921 -#define REREAD 922 -#define RERUN 923 -#define RESERVE 924 -#define RESET 925 -#define RESET_TRACE 926 -#define RESET_GRID 927 -#define RESET_LIST 928 -#define RESET_TABS 929 -#define RESIDENT 930 -#define RETRY 931 -#define RETURN 932 -#define RETURNING 933 -#define REVERSE 934 -#define REVERSE_FUNC 935 -#define REVERSE_VIDEO 936 -#define REVERSED 937 -#define REWIND 938 -#define REWRITE 939 -#define RF 940 -#define RH 941 -#define RIGHT 942 -#define RIGHT_ALIGN 943 -#define RIMMED 944 -#define ROLLBACK 945 -#define ROUNDED 946 -#define ROUNDING 947 -#define ROW_COLOR 948 -#define ROW_COLOR_PATTERN 949 -#define ROW_DIVIDERS 950 -#define ROW_FONT 951 -#define ROW_HEADINGS 952 -#define ROW_PROTECTION 953 -#define RUN 954 -#define S 955 -#define SAME 956 -#define SAVE_AS 957 -#define SAVE_AS_NO_PROMPT 958 -#define SCREEN 959 -#define SCREEN_CONTROL 960 -#define SCROLL 961 -#define SCROLL_BAR 962 -#define SD 963 -#define SEARCH 964 -#define SEARCH_OPTIONS 965 -#define SEARCH_TEXT 966 -#define SECONDS 967 -#define SECTION 968 -#define SECURE 969 -#define SEGMENT 970 -#define SEGMENT_LIMIT 971 -#define SELECT 972 -#define SELECTION_INDEX 973 -#define SELECTION_TEXT 974 -#define SELECT_ALL 975 -#define SELF_ACT 976 -#define SEMI_COLON 977 -#define SEND 978 -#define SENTENCE 979 -#define SEPARATE 980 -#define SEPARATION 981 -#define SEQUENCE 982 -#define SEQUENTIAL 983 -#define SET 984 -#define SEVENTY_EIGHT 985 -#define SHADING 986 -#define SHADOW 987 -#define SHARING 988 -#define SHORT_DATE 989 -#define SHOW_LINES 990 -#define SHOW_NONE 991 -#define SHOW_SEL_ALWAYS 992 -#define SIGN 993 -#define SIGNED 994 -#define SIGNED_INT 995 -#define SIGNED_LONG 996 -#define SIGNED_SHORT 997 -#define SIXTY_SIX 998 -#define SIZE 999 -#define SIZE_ERROR 1000 -#define SMALL_FONT 1001 -#define SORT 1002 -#define SORT_MERGE 1003 -#define SORT_ORDER 1004 -#define SOURCE 1005 -#define SOURCE_COMPUTER 1006 -#define SPACE 1007 -#define SPECIAL_NAMES 1008 -#define SPINNER 1009 -#define SQUARE 1010 -#define STANDARD 1011 -#define STANDARD_1 1012 -#define STANDARD_2 1013 -#define STANDARD_BINARY 1014 -#define STANDARD_DECIMAL 1015 -#define START 1016 -#define START_X 1017 -#define START_Y 1018 -#define STATIC 1019 -#define STATIC_LIST 1020 -#define STATUS 1021 -#define STATUS_BAR 1022 -#define STATUS_TEXT 1023 -#define STDCALL 1024 -#define STEP 1025 -#define STOP 1026 -#define STRING 1027 -#define STYLE 1028 -#define SUB_QUEUE_1 1029 -#define SUB_QUEUE_2 1030 -#define SUB_QUEUE_3 1031 -#define SUBSTITUTE_FUNC 1032 -#define SUBSTITUTE_CASE_FUNC 1033 -#define SUBTRACT 1034 -#define SUBWINDOW 1035 -#define SUM 1036 -#define SUPPRESS 1037 -#define SUPPRESS_XML 1038 -#define SYMBOLIC 1039 -#define SYNCHRONIZED 1040 -#define SYSTEM_DEFAULT 1041 -#define SYSTEM_INFO 1042 -#define SYSTEM_OFFSET 1043 -#define TAB 1044 -#define TAB_TO_ADD 1045 -#define TAB_TO_DELETE 1046 -#define TABLE 1047 -#define TALLYING 1048 -#define TEMPORARY 1049 -#define TAPE 1050 -#define TERMINAL 1051 -#define TERMINATE 1052 -#define TERMINAL_INFO 1053 -#define TERMINATION_VALUE 1054 -#define TEST 1055 -#define TEXT 1056 -#define THAN 1057 -#define THEN 1058 -#define THREAD 1059 -#define THREADS 1060 -#define THRU 1061 -#define THUMB_POSITION 1062 -#define TILED_HEADINGS 1063 -#define TIME 1064 -#define TIME_OUT 1065 -#define TIMES 1066 -#define TITLE 1067 -#define TITLE_POSITION 1068 -#define TO 1069 -#define TOK_AMPER 1070 -#define TOK_CLOSE_PAREN 1071 -#define TOK_COLON 1072 -#define TOK_DIV 1073 -#define TOK_DOT 1074 -#define TOK_EQUAL 1075 -#define TOK_EXTERN 1076 -#define TOK_FALSE 1077 -#define TOK_FILE 1078 -#define TOK_GREATER 1079 -#define TOK_INITIAL 1080 -#define TOK_LESS 1081 -#define TOK_MINUS 1082 -#define TOK_MUL 1083 -#define TOK_NULL 1084 -#define TOK_OVERFLOW 1085 -#define TOK_OPEN_PAREN 1086 -#define TOK_PLUS 1087 -#define TOK_TRUE 1088 -#define TOP 1089 -#define TOWARD_GREATER 1090 -#define TOWARD_LESSER 1091 -#define TRACK 1092 -#define TRACKS 1093 -#define TRACK_AREA 1094 -#define TRACK_LIMIT 1095 -#define TRADITIONAL_FONT 1096 -#define TRAILING 1097 -#define TRAILING_SHIFT 1098 -#define TRANSACTION 1099 -#define TRANSFORM 1100 -#define TRANSPARENT 1101 -#define TREE_VIEW 1102 -#define TRIM_FUNC 1103 -#define TRUNCATION 1104 -#define TYPE 1105 -#define U 1106 -#define UCS_4 1107 -#define UNBOUNDED 1108 -#define UNDERLINE 1109 -#define UNFRAMED 1110 -#define UNIT 1111 -#define UNLOCK 1112 -#define UNSIGNED 1113 -#define UNSIGNED_INT 1114 -#define UNSIGNED_LONG 1115 -#define UNSIGNED_SHORT 1116 -#define UNSORTED 1117 -#define UNSTRING 1118 -#define UNTIL 1119 -#define UP 1120 -#define UPDATE 1121 -#define UPDATERS 1122 -#define UPON 1123 -#define UPON_ARGUMENT_NUMBER 1124 -#define UPON_COMMAND_LINE 1125 -#define UPON_ENVIRONMENT_NAME 1126 -#define UPON_ENVIRONMENT_VALUE 1127 -#define UPPER 1128 -#define UPPER_CASE_FUNC 1129 -#define USAGE 1130 -#define USE 1131 -#define USE_ALT 1132 -#define USE_RETURN 1133 -#define USE_TAB 1134 -#define USER 1135 -#define USER_DEFAULT 1136 -#define USER_FUNCTION_NAME 1137 -#define USING 1138 -#define UTF_8 1139 -#define UTF_16 1140 -#define V 1141 -#define VALIDATE 1142 -#define VALIDATING 1143 -#define VALUE 1144 -#define VALUE_FORMAT 1145 -#define VARIABLE 1146 -#define VARIANT 1147 -#define VARYING 1148 -#define VERTICAL 1149 -#define VERY_HEAVY 1150 -#define VIRTUAL_WIDTH 1151 -#define VISIBLE 1152 -#define VOLATILE 1153 -#define VPADDING 1154 -#define VSCROLL 1155 -#define VSCROLL_BAR 1156 -#define VSCROLL_POS 1157 -#define VTOP 1158 -#define WAIT 1159 -#define WEB_BROWSER 1160 -#define WHEN 1161 -#define WHEN_COMPILED_FUNC 1162 -#define WHEN_XML 1163 -#define WIDTH 1164 -#define WIDTH_IN_CELLS 1165 -#define WINDOW 1166 -#define WITH 1167 -#define WORD 1168 -#define WORDS 1169 -#define WORKING_STORAGE 1170 -#define WRAP 1171 -#define WRITE 1172 -#define WRITE_ONLY 1173 -#define WRITE_VERIFY 1174 -#define WRITERS 1175 -#define X 1176 -#define XML 1177 -#define XML_DECLARATION 1178 -#define Y 1179 -#define YYYYDDD 1180 -#define YYYYMMDD 1181 -#define ZERO 1182 -#define SHIFT_PREFER 1183 - -/* Value type. */ -#if ! defined YYSTYPE && ! defined YYSTYPE_IS_DECLARED -typedef int YYSTYPE; -# define YYSTYPE_IS_TRIVIAL 1 -# define YYSTYPE_IS_DECLARED 1 -#endif - - -extern YYSTYPE yylval; - -int yyparse (void); - -#endif /* !YY_YY_PARSER_H_INCLUDED */ diff -Nru gnucobol-4.0~early~20200606/cobc/parser.y gnucobol-5/cobc/parser.y --- gnucobol-4.0~early~20200606/cobc/parser.y 2020-06-06 20:51:59.000000000 +0000 +++ gnucobol-5/cobc/parser.y 1970-01-01 00:00:00.000000000 +0000 @@ -1,18328 +0,0 @@ -/* - Copyright (C) 2001-2012, 2014-2020 Free Software Foundation, Inc. - Written by Keisuke Nishida, Roger While, Ron Norman, Simon Sobisch, - Edward Hart - - This file is part of GnuCOBOL. - - The GnuCOBOL compiler is free software: you can redistribute it - and/or modify it under the terms of the GNU General Public License - as published by the Free Software Foundation, either version 3 of the - License, or (at your option) any later version. - - GnuCOBOL is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with GnuCOBOL. If not, see . -*/ - -%expect 0 - -%defines -%verbose -%define parse.error verbose - -%{ -#include "config.h" - -#include -#include - -#define COB_IN_PARSER 1 -#include "cobc.h" -#include "tree.h" - -#ifndef _STDLIB_H -#define _STDLIB_H 1 -#endif - -#define YYSTYPE cb_tree -#define yyerror(x) cb_error_always ("%s", x) - -#define emit_statement(x) \ -do { \ - if (!skip_statements) { \ - CB_ADD_TO_CHAIN (x, current_program->exec_list); \ - } \ -} ONCE_COB - -#define push_expr(type, node) \ - current_expr = cb_build_list (cb_int (type), node, current_expr) - -/* Statement terminator definitions */ -#define TERM_NONE 0 -#define TERM_ACCEPT 1U -#define TERM_ADD 2U -#define TERM_CALL 3U -#define TERM_COMPUTE 4U -#define TERM_DELETE 5U -#define TERM_DISPLAY 6U -#define TERM_DIVIDE 7U -#define TERM_EVALUATE 8U -#define TERM_IF 9U -#define TERM_JSON 10U -#define TERM_MODIFY 11U -#define TERM_MULTIPLY 12U -#define TERM_PERFORM 13U -#define TERM_READ 14U -#define TERM_RECEIVE 15U -#define TERM_RETURN 16U -#define TERM_REWRITE 17U -#define TERM_SEARCH 18U -#define TERM_START 19U -#define TERM_STRING 20U -#define TERM_SUBTRACT 21U -#define TERM_UNSTRING 22U -#define TERM_WRITE 23U -#define TERM_XML 24U -#define TERM_MAX 25U /* Always last entry, used for array size */ - -#define TERMINATOR_WARNING(x,z) terminator_warning (x, TERM_##z, #z) -#define TERMINATOR_ERROR(x,z) terminator_error (x, TERM_##z, #z) -#define TERMINATOR_CLEAR(x,z) terminator_clear (x, TERM_##z) - -/* Defines for duplicate checks */ -/* Note - We use <= 16 for common item definitions and */ -/* > 16 for non-common item definitions e.g. REPORT and SCREEN */ -#define SYN_CLAUSE_1 (1U << 0) -#define SYN_CLAUSE_2 (1U << 1) -#define SYN_CLAUSE_3 (1U << 2) -#define SYN_CLAUSE_4 (1U << 3) -#define SYN_CLAUSE_5 (1U << 4) -#define SYN_CLAUSE_6 (1U << 5) -#define SYN_CLAUSE_7 (1U << 6) -#define SYN_CLAUSE_8 (1U << 7) -#define SYN_CLAUSE_9 (1U << 8) -#define SYN_CLAUSE_10 (1U << 9) -#define SYN_CLAUSE_11 (1U << 10) -#define SYN_CLAUSE_12 (1U << 11) -#define SYN_CLAUSE_13 (1U << 12) -#define SYN_CLAUSE_14 (1U << 13) -#define SYN_CLAUSE_15 (1U << 14) -#define SYN_CLAUSE_16 (1U << 15) -#define SYN_CLAUSE_17 (1U << 16) -#define SYN_CLAUSE_18 (1U << 17) -#define SYN_CLAUSE_19 (1U << 18) -#define SYN_CLAUSE_20 (1U << 19) -#define SYN_CLAUSE_21 (1U << 20) -#define SYN_CLAUSE_22 (1U << 21) -#define SYN_CLAUSE_23 (1U << 22) -#define SYN_CLAUSE_24 (1U << 23) -#define SYN_CLAUSE_25 (1U << 24) -#define SYN_CLAUSE_26 (1U << 25) -#define SYN_CLAUSE_27 (1U << 26) -#define SYN_CLAUSE_28 (1U << 27) -#define SYN_CLAUSE_29 (1U << 28) -#define SYN_CLAUSE_30 (1U << 29) -#define SYN_CLAUSE_31 (1U << 30) -#define SYN_CLAUSE_32 (1U << 31) - -#define EVAL_DEPTH 32 -#define PROG_DEPTH 16 - -/* Global variables */ - -struct cb_program *current_program = NULL; -struct cb_statement *current_statement = NULL; -struct cb_label *current_section = NULL; -struct cb_label *current_paragraph = NULL; -struct cb_field *external_defined_fields_ws; -struct cb_field *external_defined_fields_global; -cb_tree defined_prog_list = NULL; -int cb_exp_line = 0; - -cb_tree cobc_printer_node = NULL; -int functions_are_all = 0; -int non_const_word = 0; -int suppress_data_exceptions = 0; -unsigned int cobc_repeat_last_token = 0; -unsigned int cobc_in_id = 0; -unsigned int cobc_in_procedure = 0; -unsigned int cobc_in_repository = 0; -unsigned int cobc_force_literal = 0; -unsigned int cobc_cs_check = 0; -unsigned int cobc_allow_program_name = 0; -unsigned int cobc_in_xml_generate_body = 0; -unsigned int cobc_in_json_generate_body = 0; - -/* Local variables */ - -enum tallying_phrase { - NO_PHRASE, - FOR_PHRASE, - CHARACTERS_PHRASE, - ALL_LEADING_TRAILING_PHRASES, - VALUE_REGION_PHRASE -}; - -enum key_clause_type { - NO_KEY, - RECORD_KEY, - RELATIVE_KEY -}; - -static struct cb_statement *main_statement; - -static cb_tree current_expr; -static struct cb_field *current_field; -static struct cb_field *control_field; -static struct cb_field *description_field; -static struct cb_file *current_file; -static struct cb_cd *current_cd; -static struct cb_report *current_report; -static struct cb_report *report_instance; -static struct cb_key_component *key_component_list; - -static struct cb_file *linage_file; -static cb_tree next_label_list; - -static const char *stack_progid[PROG_DEPTH]; - -static enum cb_storage current_storage; - -static cb_tree perform_stack; -static cb_tree qualifier; -static cb_tree keys_list; - -static cb_tree save_tree; -static cb_tree start_tree; - -static unsigned int check_unreached; -static unsigned int in_declaratives; -static unsigned int in_debugging; -static unsigned int current_linage; -static unsigned int report_count; -static unsigned int first_prog; -static unsigned int setup_from_identification; -static unsigned int use_global_ind; -static unsigned int same_area; -static unsigned int inspect_keyword; -static unsigned int main_flag_set; -static int next_label_id; -static int eval_level; -static int eval_inc; -static int eval_inc2; -static int depth; -static int first_nested_program; -static int call_mode; -static int size_mode; -static cob_flags_t set_attr_val_on; -static cob_flags_t set_attr_val_off; -static cob_flags_t check_duplicate; -static cob_flags_t check_on_off_duplicate; -static cob_flags_t check_pic_duplicate; -static cob_flags_t check_line_col_duplicate; -static unsigned int skip_statements; -static unsigned int start_debug; -static unsigned int save_debug; -static unsigned int needs_field_debug; -static unsigned int needs_debug_item; -static unsigned int env_div_seen; -static cob_flags_t header_check; -static unsigned int call_nothing; -static enum tallying_phrase previous_tallying_phrase; -static cb_tree default_rounded_mode; -static enum key_clause_type key_type; - -static int ext_dyn_specified; -static enum cb_assign_device assign_device; - -static enum cb_display_type display_type; -static int is_first_display_item; -static cb_tree advancing_value; -static cb_tree upon_value; -static cb_tree line_column; - -static cb_tree ml_suppress_list; -static cb_tree xml_encoding; -static int with_xml_dec; -static int with_attrs; - -static cb_tree alphanumeric_collation; -static cb_tree national_collation; - -static enum cb_ml_suppress_category ml_suppress_category; - -static int term_array[TERM_MAX]; -static cb_tree eval_check[EVAL_DEPTH][EVAL_DEPTH]; - -static const char *backup_source_file = NULL; -static int backup_source_line = 0; - -/* Defines for header presence */ - -#define COBC_HD_ENVIRONMENT_DIVISION (1U << 0) -#define COBC_HD_CONFIGURATION_SECTION (1U << 1) -#define COBC_HD_SPECIAL_NAMES (1U << 2) -#define COBC_HD_INPUT_OUTPUT_SECTION (1U << 3) -#define COBC_HD_FILE_CONTROL (1U << 4) -#define COBC_HD_I_O_CONTROL (1U << 5) -#define COBC_HD_DATA_DIVISION (1U << 6) -#define COBC_HD_FILE_SECTION (1U << 7) -#define COBC_HD_WORKING_STORAGE_SECTION (1U << 8) -#define COBC_HD_LOCAL_STORAGE_SECTION (1U << 9) -#define COBC_HD_LINKAGE_SECTION (1U << 10) -#define COBC_HD_COMMUNICATION_SECTION (1U << 11) -#define COBC_HD_REPORT_SECTION (1U << 12) -#define COBC_HD_SCREEN_SECTION (1U << 13) -#define COBC_HD_PROCEDURE_DIVISION (1U << 14) -#define COBC_HD_PROGRAM_ID (1U << 15) -#define COBC_HD_SOURCE_COMPUTER (1U << 16) -#define COBC_HD_OBJECT_COMPUTER (1U << 17) -#define COBC_HD_REPOSITORY (1U << 18) - -/* Static functions */ - -static void -begin_statement (const char *name, const unsigned int term) -{ - if (check_unreached) { - cb_warning (cb_warn_unreachable, _("unreachable statement '%s'"), name); - } - current_paragraph->flag_statement = 1; - current_statement = cb_build_statement (name); - CB_TREE (current_statement)->source_file = cb_source_file; - CB_TREE (current_statement)->source_line = cb_source_line; - current_statement->flag_in_debug = in_debugging; - emit_statement (CB_TREE (current_statement)); - if (term) { - term_array[term]++; - } - main_statement = current_statement; -} - -static void -restore_backup_pos (cb_tree item) -{ - item->source_file = backup_source_file; - item->source_line = backup_source_line; -} - -static void -begin_statement_from_backup_pos (const char *name, const unsigned int term) -{ - current_paragraph->flag_statement = 1; - current_statement = cb_build_statement (name); - restore_backup_pos (CB_TREE (current_statement)); - current_statement->flag_in_debug = in_debugging; - emit_statement (CB_TREE (current_statement)); - if (term) { - term_array[term]++; - } - main_statement = current_statement; - if (check_unreached) { - cb_warning_x (cb_warn_unreachable, CB_TREE (current_statement), _("unreachable statement '%s'"), name); - } -} - -/* create a new statement with base attributes of current_statement - and set this as new current_statement */ -static void -begin_implicit_statement (void) -{ - struct cb_statement *new_statement; - new_statement = cb_build_statement (NULL); - new_statement->common = current_statement->common; - new_statement->name = current_statement->name; - new_statement->flag_in_debug = !!in_debugging; - new_statement->flag_implicit = 1; - current_statement = new_statement; - main_statement->body = cb_list_add (main_statement->body, - CB_TREE (current_statement)); -} - -# if 0 /* activate only for debugging purposes for attribs - FIXME: Replace by DEBUG_LOG function */ -static -void print_bits (cob_flags_t num) -{ - unsigned int size = sizeof (cob_flags_t); - unsigned int max_pow = 1 << (size * 8 - 1); - int i = 0; - - for(; i < size * 8; ++i){ - /* Print last bit and shift left. */ - fprintf (stderr, "%u ", num & max_pow ? 1 : 0); - num = num << 1; - } - fprintf (stderr, "\n"); -} -#endif - -/* functions for storing current position and - assigning it to a cb_tree after its parsing is finished */ -static COB_INLINE -void backup_current_pos (void) -{ - backup_source_file = cb_source_file; - backup_source_line = cb_source_line; -} - -#if 0 /* currently not used */ -static COB_INLINE -void set_pos_from_backup (cb_tree x) -{ - x->source_file = backup_source_file; - x->source_line = backup_source_line; -} -#endif - -static void -emit_entry (const char *name, const int encode, cb_tree using_list, cb_tree convention) -{ - cb_tree l; - cb_tree label; - cb_tree x; - cb_tree entry_conv; - struct cb_field *f, *ret_f; - int param_num; - char buff[COB_MINI_BUFF]; - - snprintf (buff, (size_t)COB_MINI_MAX, "E$%s", name); - label = cb_build_label (cb_build_reference (buff), NULL); - if (encode) { - CB_LABEL (label)->name = cb_encode_program_id (name, 0, cb_fold_call); - CB_LABEL (label)->orig_name = name; - } else { - CB_LABEL (label)->name = name; - CB_LABEL (label)->orig_name = current_program->orig_program_id; - } - CB_LABEL (label)->flag_begin = 1; - CB_LABEL (label)->flag_entry = 1; - label->source_line = backup_source_line; - emit_statement (label); - - if (current_program->flag_debugging) { - emit_statement (cb_build_debug (cb_debug_contents, - "START PROGRAM", NULL)); - } - - param_num = 1; - for (l = using_list; l; l = CB_CHAIN (l)) { - x = CB_VALUE (l); - if (CB_VALID_TREE (x) && cb_ref (x) != cb_error_node) { - f = CB_FIELD (cb_ref (x)); - if (!current_program->flag_chained) { - if (f->storage != CB_STORAGE_LINKAGE) { - cb_error_x (x, _("'%s' is not in LINKAGE SECTION"), f->name); - } - if (f->flag_item_based || f->flag_external) { - cb_error_x (x, _("'%s' cannot be BASED/EXTERNAL"), f->name); - } - f->flag_is_pdiv_parm = 1; - } else { - if (f->storage != CB_STORAGE_WORKING) { - cb_error_x (x, _("'%s' is not in WORKING-STORAGE SECTION"), f->name); - } - f->flag_chained = 1; - f->param_num = param_num; - param_num++; - } - if (f->level != 01 && f->level != 77) { - cb_error_x (x, _("'%s' not level 01 or 77"), f->name); - } - if (f->redefines) { - cb_error_x (x, _("'%s' REDEFINES field not allowed here"), f->name); - } - /* add a "receiving" entry for the USING parameter */ - if (cb_listing_xref) { - cobc_xref_link (&f->xref, CB_REFERENCE (x)->common.source_line, 1); - } - } - } - - - if (current_program->returning && - cb_ref (current_program->returning) != cb_error_node) { - ret_f = CB_FIELD (cb_ref (current_program->returning)); - if (ret_f->redefines) { - cb_error_x (current_program->returning, - _("'%s' REDEFINES field not allowed here"), ret_f->name); - } - } else { - ret_f = NULL; - } - - /* Check returning item against using items when FUNCTION */ - if (current_program->prog_type == COB_MODULE_TYPE_FUNCTION && ret_f) { - for (l = using_list; l; l = CB_CHAIN (l)) { - x = CB_VALUE (l); - if (CB_VALID_TREE (x) && cb_ref (x) != cb_error_node) { - f = CB_FIELD (cb_ref (x)); - if (ret_f == f) { - cb_error_x (x, _("'%s' USING item duplicates RETURNING item"), f->name); - } - } - } - } - - for (l = current_program->entry_list; l; l = CB_CHAIN (l)) { - struct cb_label *check = CB_LABEL (CB_PURPOSE (l)); - if (strcmp (name, check->name) == 0) { - cb_error_x (CB_TREE (current_statement), - _("ENTRY '%s' duplicated"), name); - } - } - - if (convention) { - entry_conv = convention; - } else { - entry_conv = current_program->entry_convention; - } - - current_program->entry_list = - cb_list_append (current_program->entry_list, - CB_BUILD_PAIR (label, CB_BUILD_PAIR(entry_conv, using_list))); -} - -static void -emit_entry_goto (const char *name) -{ - cb_tree l; - cb_tree label; - char buff[COB_MINI_BUFF]; - - snprintf (buff, (size_t)COB_MINI_MAX, "E$%s", name); - label = cb_build_label (cb_build_reference (buff), NULL); - CB_LABEL (label)->name = name; - CB_LABEL (label)->orig_name = name; - CB_LABEL (label)->flag_begin = 1; - CB_LABEL (label)->flag_entry = 1; - CB_LABEL (label)->flag_entry_for_goto = 1; - label->source_line = backup_source_line; - emit_statement (label); - - for (l = current_program->entry_list_goto; l; l = CB_CHAIN (l)) { - struct cb_label *real_label = CB_LABEL (CB_VALUE (l)); - if (strcmp (name, real_label->name) == 0) { - cb_error_x (CB_TREE (current_statement), - _("ENTRY FOR GO TO '%s' duplicated"), name); - } - } - - if (current_program->entry_list_goto) { - current_program->entry_list_goto = - cb_list_add (current_program->entry_list_goto, label); - } else { - current_program->entry_list_goto = CB_LIST_INIT (label); - } -} - -static size_t -increment_depth (void) -{ - if (++depth >= PROG_DEPTH) { - cb_error (_("maximum nested program depth exceeded (%d)"), - PROG_DEPTH); - return 1; - } - return 0; -} - -static void -terminator_warning (cb_tree stmt, const unsigned int termid, - const char *name) -{ - char terminator[32]; - - check_unreached = 0; - if (term_array[termid]) { - term_array[termid]--; - /* LCOV_EXCL_START */ - } else { - cobc_err_msg ("call to '%s' without any open term for %s", - "terminator_warning", name); - COBC_ABORT (); - } - /* LCOV_EXCL_STOP */ - snprintf (terminator, 32, "END-%s", name); - if (is_reserved_word (terminator)) { - cb_warning_x (cb_warn_terminator, CB_TREE (current_statement), - _("%s statement not terminated by %s"), name, terminator); - } - - /* Free tree associated with terminator */ - if (stmt) { - cobc_parse_free (stmt); - } -} - -static void -terminator_error (cb_tree stmt, const unsigned int termid, const char *name) -{ - char terminator[32]; - - check_unreached = 0; - if (term_array[termid]) { - term_array[termid]--; - /* LCOV_EXCL_START */ - } else { - cobc_err_msg ("call to '%s' without any open term for %s", - "terminator_error", name); - COBC_ABORT (); - } - /* LCOV_EXCL_STOP */ - snprintf (terminator, 32, "END-%s", name); - if (is_reserved_word (terminator)) { - cb_error_x (CB_TREE (current_statement), - _("%s statement not terminated by %s"), name, terminator); - } else { - cb_error_x (CB_TREE (current_statement), - _("%s statement not terminated"), name); - } - - /* Free tree associated with terminator */ - if (stmt) { - cobc_parse_free (stmt); - } -} - -static void -terminator_clear (cb_tree stmt, const unsigned int termid) -{ - struct cb_perform *p; - check_unreached = 0; - if (term_array[termid]) { - term_array[termid]--; - /* LCOV_EXCL_START */ - } else { - cobc_err_msg ("call to '%s' without any open term for %s", - "terminator_warning", current_statement->name); - COBC_ABORT (); - } - /* LCOV_EXCL_STOP */ - if (termid == TERM_PERFORM - && perform_stack) { - p = CB_PERFORM (CB_VALUE (perform_stack)); - if (p->perform_type == CB_PERFORM_UNTIL) { - cb_terminate_cond (); - } - } - /* Free tree associated with terminator */ - if (stmt) { - cobc_parse_free (stmt); - } -} - -static int -literal_value (cb_tree x) -{ - if (x == cb_space) { - return ' '; - } else if (x == cb_zero) { - return '0'; - } else if (x == cb_quote) { - return cb_flag_apostrophe ? '\'' : '"'; - } else if (x == cb_null) { - return 0; - } else if (x == cb_low) { - return 0; - } else if (x == cb_high) { - return 255; - } else if (CB_TREE_CLASS (x) == CB_CLASS_NUMERIC) { - return cb_get_int (x); - } else { - return CB_LITERAL (x)->data[0]; - } -} - -static void -setup_use_file (struct cb_file *fileptr) -{ - struct cb_file *newptr; - - if (fileptr->organization == COB_ORG_SORT) { - cb_error (_("USE statement invalid for SORT file")); - } - if (fileptr->flag_global) { - newptr = cobc_parse_malloc (sizeof(struct cb_file)); - *newptr = *fileptr; - newptr->handler = current_section; - newptr->handler_prog = current_program; - if (!use_global_ind) { - current_program->local_file_list = - cb_list_add (current_program->local_file_list, - CB_TREE (newptr)); - } else { - current_program->global_file_list = - cb_list_add (current_program->global_file_list, - CB_TREE (newptr)); - } - } else { - fileptr->handler = current_section; - } -} - -static void -emit_duplicate_clause_message (const char *clause) -{ - /* FIXME: replace by a new warning level that is set - to warn/error depending on cb_relaxed_syntax_checks */ - if (cb_relaxed_syntax_checks) { - cb_warning (COBC_WARN_FILLER, _("duplicate %s clause"), clause); - } else { - cb_error (_("duplicate %s clause"), clause); - } -} - -static void -check_repeated (const char *clause, const cob_flags_t bitval, cob_flags_t *already_seen) -{ - if (*already_seen & bitval) { - emit_duplicate_clause_message (clause); - } else { - *already_seen |= bitval; - } -} - -static void -error_if_no_page_lines_limit (const char *phrase) -{ - if (!current_report->lines && !current_report->t_lines) { - cb_error (_("Cannot specify %s without number of lines on page"), - phrase); - } -} - -static void -setup_occurs (void) -{ - check_repeated ("OCCURS", SYN_CLAUSE_7, &check_pic_duplicate); - if (current_field->indexes == COB_MAX_SUBSCRIPTS) { - cb_error (_("maximum OCCURS depth exceeded (%d)"), - COB_MAX_SUBSCRIPTS); - } else { - current_field->indexes++; - } - - if (current_field->flag_unbounded) { - if (current_field->storage != CB_STORAGE_LINKAGE) { - cb_error_x (CB_TREE(current_field), _("'%s' is not in LINKAGE SECTION"), - cb_name (CB_TREE(current_field))); - } - } - - if (current_field->flag_item_based) { - cb_error (_("%s and %s are mutually exclusive"), "BASED", "OCCURS"); - } else if (current_field->flag_external) { - cb_error (_("%s and %s are mutually exclusive"), "EXTERNAL", "OCCURS"); - } - current_field->flag_occurs = 1; -} - -static void -setup_occurs_min_max (cb_tree occurs_min, cb_tree occurs_max) -{ - if (occurs_max) { - current_field->occurs_min = cb_get_int (occurs_min); - if (occurs_max != cb_int0) { - current_field->occurs_max = cb_get_int (occurs_max); - if (!current_field->depending) { - if (cb_relaxed_syntax_checks) { - cb_warning (COBC_WARN_FILLER, _("TO phrase without DEPENDING phrase")); - cb_warning (COBC_WARN_FILLER, _("maximum number of occurrences assumed to be exact number")); - current_field->occurs_min = 1; /* CHECKME: why using 1 ? */ - } else { - cb_error (_("TO phrase without DEPENDING phrase")); - } - } - if (current_field->occurs_max <= current_field->occurs_min) { - cb_error (_("OCCURS TO must be greater than OCCURS FROM")); - } - } else { - current_field->occurs_max = 0; - } - } else { - current_field->occurs_min = 1; /* CHECKME: why using 1 ? */ - current_field->occurs_max = cb_get_int (occurs_min); - if (current_field->depending) { - cb_verify (cb_odo_without_to, _("OCCURS DEPENDING ON without TO phrase")); - } - } -} - -static void -check_relaxed_syntax (const cob_flags_t lev) -{ - const char *s; - - switch (lev) { - case COBC_HD_ENVIRONMENT_DIVISION: - s = "ENVIRONMENT DIVISION"; - break; - case COBC_HD_CONFIGURATION_SECTION: - s = "CONFIGURATION SECTION"; - break; - case COBC_HD_SPECIAL_NAMES: - s = "SPECIAL-NAMES"; - break; - case COBC_HD_INPUT_OUTPUT_SECTION: - s = "INPUT-OUTPUT SECTION"; - break; - case COBC_HD_FILE_CONTROL: - s = "FILE-CONTROL"; - break; - case COBC_HD_I_O_CONTROL: - s = "I-O-CONTROL"; - break; - case COBC_HD_DATA_DIVISION: - s = "DATA DIVISION"; - break; - case COBC_HD_FILE_SECTION: - s = "FILE SECTION"; - break; - case COBC_HD_WORKING_STORAGE_SECTION: - s = "WORKING-STORAGE SECTION"; - break; - case COBC_HD_LOCAL_STORAGE_SECTION: - s = "LOCAL-STORAGE SECTION"; - break; - case COBC_HD_LINKAGE_SECTION: - s = "LINKAGE SECTION"; - break; - case COBC_HD_COMMUNICATION_SECTION: - s = "COMMUNICATION SECTION"; - break; - case COBC_HD_REPORT_SECTION: - s = "REPORT SECTION"; - break; - case COBC_HD_SCREEN_SECTION: - s = "SCREEN SECTION"; - break; - case COBC_HD_PROCEDURE_DIVISION: - s = "PROCEDURE DIVISION"; - break; - case COBC_HD_PROGRAM_ID: - s = "PROGRAM-ID"; - break; - /* LCOV_EXCL_START */ - default: - s = _("unknown"); - break; - /* LCOV_EXCL_STOP */ - } - if (cb_relaxed_syntax_checks) { - cb_warning (COBC_WARN_FILLER, _("%s header missing - assumed"), s); - } else { - cb_error (_("%s header missing"), s); - } -} - -static void -program_init_without_program_id (void) -{ - cb_tree l; - - current_section = NULL; - current_paragraph = NULL; - l = cb_build_alphanumeric_literal (demangle_name, - strlen (demangle_name)); - current_program->program_name = (char *)CB_LITERAL (l)->data; - current_program->program_id - = cb_build_program_id (current_program->program_name, 0); - current_program->prog_type = COB_MODULE_TYPE_PROGRAM; - if (!main_flag_set) { - main_flag_set = 1; - current_program->flag_main = cobc_flag_main; - } - check_relaxed_syntax (COBC_HD_PROGRAM_ID); -} - -/* check if headers are present - return 0 if fine, 1 if missing - Lev1 must always be present and is checked - Lev2/3/4, if non-zero (forced) may be present -*/ -static int -check_headers_present (const cob_flags_t lev1, const cob_flags_t lev2, - const cob_flags_t lev3, const cob_flags_t lev4) -{ - int ret = 0; - if (!(header_check & lev1)) { - header_check |= lev1; - check_relaxed_syntax (lev1); - ret = 1; - } - if (lev2) { - if (!(header_check & lev2)) { - header_check |= lev2; - check_relaxed_syntax (lev2); - ret = 1; - } - } - if (lev3) { - if (!(header_check & lev3)) { - header_check |= lev3; - check_relaxed_syntax (lev3); - ret = 1; - } - } - if (lev4) { - if (!(header_check & lev4)) { - header_check |= lev4; - check_relaxed_syntax (lev4); - ret = 1; - } - } - return ret; -} - -/* - TO-DO: Refactor header checks - have several header_checks: division_header, - section_header, paragraph_header, sentence_type -*/ -static void -set_conf_section_part (const cob_flags_t part) -{ - header_check &= ~COBC_HD_SOURCE_COMPUTER; - header_check &= ~COBC_HD_OBJECT_COMPUTER; - header_check &= ~COBC_HD_SPECIAL_NAMES; - header_check &= ~COBC_HD_REPOSITORY; - header_check |= part; -} - -static const char * -get_conf_section_part_name (const cob_flags_t part) -{ - if (part == COBC_HD_SOURCE_COMPUTER) { - return "SOURCE-COMPUTER"; - } else if (part == COBC_HD_OBJECT_COMPUTER) { - return "OBJECT-COMPUTER"; - } else if (part == COBC_HD_SPECIAL_NAMES) { - return "SPECIAL-NAMES"; - } else if (part == COBC_HD_REPOSITORY) { - return "REPOSITORY"; - /* LCOV_EXCL_START */ - } else { - /* This should never happen (and therefore doesn't get a translation) */ - cb_error ("unexpected configuration section part " CB_FMT_LLU, part); - COBC_ABORT (); - /* LCOV_EXCL_STOP */ - } -} - -static int -get_conf_section_part_order (const cob_flags_t part) -{ - if (part == COBC_HD_SOURCE_COMPUTER) { - return 1; - } else if (part == COBC_HD_OBJECT_COMPUTER) { - return 2; - } else if (part == COBC_HD_SPECIAL_NAMES) { - return 3; - } else if (part == COBC_HD_REPOSITORY) { - return 4; - /* LCOV_EXCL_START */ - } else { - /* This should never happen (and therefore doesn't get a translation) */ - cb_error ("unexpected configuration section part " CB_FMT_LLU, part); - COBC_ABORT (); - /* LCOV_EXCL_STOP */ - } -} - -static void -check_conf_section_order (const cob_flags_t part) -{ - const cob_flags_t prev_part - = header_check & (COBC_HD_SOURCE_COMPUTER - | COBC_HD_OBJECT_COMPUTER - | COBC_HD_SPECIAL_NAMES - | COBC_HD_REPOSITORY); -#define MESSAGE_LEN 100 - char message[MESSAGE_LEN] = { '\0' }; - - if (prev_part == 0) { - return; - } - - if (prev_part == part) { - cb_error (_("duplicate %s"), get_conf_section_part_name (part)); - } else if (get_conf_section_part_order (part) < get_conf_section_part_order (prev_part)) { - snprintf (message, MESSAGE_LEN, _("%s incorrectly after %s"), - get_conf_section_part_name (part), - get_conf_section_part_name (prev_part)); - cb_verify (cb_incorrect_conf_sec_order, message); - } -} - -#undef MESSAGE_LEN - -static void -build_words_for_nested_programs (void) -{ - cb_tree x; - cb_tree y; - - /* Inherit special name mnemonics from parent */ - for (x = current_program->mnemonic_spec_list; x; x = CB_CHAIN (x)) { - y = cb_build_reference (cb_name(CB_PURPOSE(x))); - if (CB_SYSTEM_NAME_P (CB_VALUE(x))) { - cb_define (y, CB_VALUE(x)); - } else { - cb_build_constant (y, CB_VALUE(x)); - } - } - - /* Inherit class names from parent */ - for (x = current_program->class_name_list; x; x = CB_CHAIN(x)) { - y = cb_build_reference (cb_name(CB_VALUE(x))); - cb_define (y, CB_VALUE(x)); - } -} - -static void -clear_initial_values (void) -{ - perform_stack = NULL; - current_statement = NULL; - main_statement = NULL; - qualifier = NULL; - in_declaratives = 0; - in_debugging = 0; - use_global_ind = 0; - check_duplicate = 0; - check_pic_duplicate = 0; - skip_statements = 0; - start_debug = 0; - save_debug = 0; - needs_field_debug = 0; - needs_debug_item = 0; - env_div_seen = 0; - header_check = 0; - next_label_id = 0; - current_linage = 0; - set_attr_val_on = 0; - set_attr_val_off = 0; - report_count = 0; - current_storage = CB_STORAGE_WORKING; - eval_level = 0; - eval_inc = 0; - eval_inc2 = 0; - inspect_keyword = 0; - check_unreached = 0; - cobc_in_id = 0; - cobc_in_procedure = 0; - cobc_in_repository = 0; - cobc_force_literal = 0; - cobc_in_xml_generate_body = 0; - cobc_in_json_generate_body = 0; - non_const_word = 0; - suppress_data_exceptions = 0; - same_area = 1; - memset ((void *)eval_check, 0, sizeof(eval_check)); - memset ((void *)term_array, 0, sizeof(term_array)); - linage_file = NULL; - current_file = NULL; - current_cd = NULL; - current_report = NULL; - report_instance = NULL; - next_label_list = NULL; - default_rounded_mode = cb_int (COB_STORE_ROUND); -} - -/* - We must check for redefinitions of program-names and external program names - outside of the usual reference/word_list methods as it may have to be done in - a case-sensitive way. -*/ -static void -begin_scope_of_program_name (struct cb_program *program) -{ - const char *prog_name = program->program_name; - const char *prog_id = program->orig_program_id; - const char *elt_name; - const char *elt_id; - cb_tree l; - - /* Error if a program with the same name has been defined. */ - for (l = defined_prog_list; l; l = CB_CHAIN (l)) { - elt_name = ((struct cb_program *) CB_VALUE (l))->program_name; - elt_id = ((struct cb_program *) CB_VALUE (l))->orig_program_id; - if (cb_fold_call && strcasecmp (prog_name, elt_name) == 0) { - cb_error_x ((cb_tree) program, - _("redefinition of program name '%s'"), - elt_name); - } else if (strcmp (prog_id, elt_id) == 0) { - cb_error_x ((cb_tree) program, - _("redefinition of program ID '%s'"), - elt_id); - return; - } - } - - /* Otherwise, add the program to the list. */ - defined_prog_list = cb_list_add (defined_prog_list, - (cb_tree) program); -} - -static void -remove_program_name (struct cb_list *l, struct cb_list *prev) -{ - if (prev == NULL) { - defined_prog_list = l->chain; - } else { - prev->chain = l->chain; - } - cobc_parse_free (l); -} - -/* Remove the program from defined_prog_list, if necessary. */ -static void -end_scope_of_program_name (struct cb_program *program, const unsigned char type) -{ - struct cb_list *prev = NULL; - struct cb_list *l = (struct cb_list *) defined_prog_list; - - /* create empty entry if the program has no PROCEDURE DIVISION, error for UDF */ - if (!program->entry_list) { - if (type == COB_MODULE_TYPE_FUNCTION) { - cb_error (_("FUNCTION '%s' has no PROCEDURE DIVISION"), program->program_name); - } else { - emit_entry (program->program_id, 0, NULL, NULL); - } - } - program->last_source_line = backup_source_line; - - if (program->nested_level == 0) { - return; - } - - /* Remove any subprograms */ - l = CB_LIST (defined_prog_list); - while (l) { - if (CB_PROGRAM (l->value)->nested_level > program->nested_level) { - remove_program_name (l, prev); - } else { - prev = l; - } - if (prev && prev->chain != NULL) { - l = CB_LIST (prev->chain); - } else { - l = NULL; - } - } - - /* Remove the specified program, if it is not COMMON */ - if (!program->flag_common) { - l = (struct cb_list *) defined_prog_list; - while (l) { - /* The nested_level check is for the pathological case - where two nested programs have the same name */ - if (0 == strcmp (program->orig_program_id, - CB_PROGRAM (l->value)->orig_program_id) - && program->nested_level == CB_PROGRAM (l->value)->nested_level) { - remove_program_name (l, prev); - if (prev && prev->chain != NULL) { - l = CB_LIST (prev->chain); - } else { - l = NULL; - } - break; - } else { - prev = l; - if (l->chain != NULL) { - l = CB_LIST (l->chain); - } else { - l = NULL; - } - } - } - } -} - -static void -setup_program_start (void) -{ - if (setup_from_identification) { - setup_from_identification = 0; - return; - } - current_section = NULL; - current_paragraph = NULL; - - if (depth != 0 && first_nested_program) { - check_headers_present (COBC_HD_PROCEDURE_DIVISION, 0, 0, 0); - } - first_nested_program = 1; -} - -static int -setup_program (cb_tree id, cb_tree as_literal, const unsigned char type) -{ - const char *external_name = NULL; - - setup_program_start (); - - /* finish last program/function */ - if (!first_prog) { - if (!current_program->flag_validated) { - current_program->flag_validated = 1; - cb_validate_program_body (current_program); - } - - clear_initial_values (); - current_program = cb_build_program (current_program, depth); - if (depth) { - build_words_for_nested_programs(); - } - cb_set_intr_when_compiled (); - cb_build_registers (); - cb_add_external_defined_registers (); - } else { - first_prog = 0; - } - - /* set internal name */ - if (CB_LITERAL_P (id)) { - current_program->program_name = (char *)CB_LITERAL (id)->data; - } else { - current_program->program_name = CB_NAME (id); - } - stack_progid[depth] = current_program->program_name; - current_program->prog_type = type; - - if (depth != 0 && type == COB_MODULE_TYPE_FUNCTION) { - cb_error (_("functions may not be defined within a program/function")); - } - - if (increment_depth ()) { - return 1; - } - - /* set external name if specified */ - if (as_literal) { - external_name = (const char *)CB_LITERAL (as_literal)->data; - } else { - external_name = current_program->program_name; - } - - /* build encoded external PROGRAM-ID */ - current_program->program_id - = cb_build_program_id (external_name, type == COB_MODULE_TYPE_FUNCTION); - - if (type == COB_MODULE_TYPE_PROGRAM) { - if (!main_flag_set) { - main_flag_set = 1; - current_program->flag_main = !!cobc_flag_main; - } - } else { /* COB_MODULE_TYPE_FUNCTION */ - current_program->flag_recursive = 1; - } - - if (CB_REFERENCE_P (id)) { - cb_define (id, CB_TREE (current_program)); - } - - begin_scope_of_program_name (current_program); - - return 0; -} - -static void -decrement_depth (const char *name, const unsigned char type) -{ - int d; - - if (depth) { - depth--; - } - - if (!strcmp (stack_progid[depth], name)) { - return; - } - - if (type == COB_MODULE_TYPE_FUNCTION) { - cb_error (_("END FUNCTION '%s' is different from FUNCTION-ID '%s'"), - name, stack_progid[depth]); - return; - } - - /* Set depth to that of whatever program we just ended, if it exists. */ - for (d = depth; d >= 0; --d) { - if (!strcmp (stack_progid[d], name)) { - depth = d; - return; - } - } - - if (depth != d) { - cb_error (_("END PROGRAM '%s' is different from PROGRAM-ID '%s'"), - name, stack_progid[depth]); - } -} - -static void -clean_up_program (cb_tree name, const unsigned char type) -{ - char *s; - - end_scope_of_program_name (current_program, type); - - if (name) { - if (CB_LITERAL_P (name)) { - s = (char *)(CB_LITERAL (name)->data); - } else { - s = (char *)(CB_NAME (name)); - } - - decrement_depth (s, type); - } - - current_section = NULL; - current_paragraph = NULL; - if (!current_program->flag_validated) { - current_program->flag_validated = 1; - cb_validate_program_body (current_program); - } -} - -static const char * -get_literal_or_word_name (const cb_tree x) -{ - if (CB_LITERAL_P (x)) { - return (const char *) CB_LITERAL (x)->data; - } else { /* CB_REFERENCE_P (x) */ - return (const char *) CB_NAME (x); - } -} - -/* verify and set currency symbol used in picture (compile time) and - if no currency - string is explicitly set (which is currently not implemented) - as currency string - (run time for display and [de-]editing)*/ -static void -set_currency_picture_symbol (const cb_tree x) -{ - unsigned char *s = CB_LITERAL (x)->data; - - if (CB_LITERAL (x)->size != 1) { - cb_error_x (x, _("currency symbol must be one character long")); - return; - } - switch (*s) { - case '0': - case '1': - case '2': - case '3': - case '4': - case '5': - case '6': - case '7': - case '8': - case '9': - case 'A': - case 'B': - case 'C': - case 'D': - case 'E': - case 'N': - case 'P': - case 'R': - case 'S': - case 'V': - case 'X': - case 'Z': - case 'a': - case 'b': - case 'c': - case 'd': - case 'e': - case 'n': - case 'p': - case 'r': - case 's': - case 'v': - case 'x': - case 'z': - case '+': - case '-': - case ',': - case '.': - case '*': - case '/': - case ';': - case '(': - case ')': - case '=': - case '\'': - case '"': - case ' ': -#if 0 /* note: MicroFocus also dissalows L (VAX) and G (OSVS) */ - case 'L': - case 'G': - case 'l': - case 'g': -#endif - cb_error_x (x, _("invalid character '%c' in currency symbol"), s[0]); - return; - default: - break; - } - current_program->currency_symbol = s[0]; -} - -/* Return 1 if the prototype name is the same as the current function's. */ -static int -check_prototype_redefines_current_element (const cb_tree prototype_name) -{ - const char *name = get_literal_or_word_name (prototype_name); - - if (strcasecmp (name, current_program->program_name) == 0) { - cb_warning_x (COBC_WARN_FILLER, prototype_name, - _("prototype has same name as current function and will be ignored")); - return 1; - } - - return 0; -} - -/* Returns 1 if the prototype has been duplicated. */ -static int -check_for_duplicate_prototype (const cb_tree prototype_name, - const cb_tree prototype) -{ - cb_tree dup; - - if (CB_WORD_COUNT (prototype_name) > 0) { - /* Make sure the duplicate is a prototype */ - dup = cb_ref (prototype_name); - if (!CB_PROTOTYPE_P (dup)) { - redefinition_error (prototype_name); - return 1; - } - - /* Check the duplicate prototypes match */ - if (strcmp (CB_PROTOTYPE (prototype)->ext_name, - CB_PROTOTYPE (dup)->ext_name) - || CB_PROTOTYPE (prototype)->type != CB_PROTOTYPE (dup)->type) { - cb_error_x (prototype_name, - _("duplicate REPOSITORY entries for '%s' do not match"), - get_literal_or_word_name (prototype_name)); - } else { - cb_warning_x (COBC_WARN_FILLER, prototype_name, - _("duplicate REPOSITORY entry for '%s'"), - get_literal_or_word_name (prototype_name)); - } - return 1; - } - - return 0; -} - -static void -setup_prototype (cb_tree prototype_name, cb_tree ext_name, - const int type, const int is_current_element) -{ - cb_tree prototype; - int name_redefinition_allowed; - - if (!is_current_element - && check_prototype_redefines_current_element (prototype_name)) { - return; - } - - prototype = cb_build_prototype (prototype_name, ext_name, type); - - if (!is_current_element - && check_for_duplicate_prototype (prototype_name, prototype)) { - return; - } - - name_redefinition_allowed = type == COB_MODULE_TYPE_PROGRAM - && is_current_element && cb_program_name_redefinition; - if (!name_redefinition_allowed) { - if (CB_LITERAL_P (prototype_name)) { - cb_define (cb_build_reference ((const char *)CB_LITERAL (prototype_name)->data), prototype); - } else { - cb_define (prototype_name, prototype); - } - - if (type == COB_MODULE_TYPE_PROGRAM) { - current_program->program_spec_list = - cb_list_add (current_program->program_spec_list, prototype); - } else { /* COB_MODULE_TYPE_FUNCTION */ - current_program->user_spec_list = - cb_list_add (current_program->user_spec_list, prototype); - } - } -} - -static void -error_if_record_delimiter_incompatible (const int organization, - const char *organization_name) -{ - int is_compatible; - - if (!current_file->flag_delimiter) { - return; - } - - if (organization == COB_ORG_LINE_SEQUENTIAL) { - is_compatible = current_file->organization == COB_ORG_SEQUENTIAL - || current_file->organization == COB_ORG_LINE_SEQUENTIAL; - } else { - is_compatible = current_file->organization == organization; - } - - if (!is_compatible) { - cb_error (_("ORGANIZATION %s is incompatible with RECORD DELIMITER"), - organization_name); - } -} - -static int -set_current_field (cb_tree level, cb_tree name) -{ - cb_tree x = cb_build_field_tree (level, name, current_field, - current_storage, current_file, 0); - /* Free tree associated with level number */ - cobc_parse_free (level); - - if (CB_INVALID_TREE (x)) { - return 1; - } else { - current_field = CB_FIELD (x); - check_pic_duplicate = 0; - } - - return 0; -} - -/* verifies that no conflicting clauses are used and inherits the definition of the original field */ -static void -inherit_same_as () -{ - /* note: REDEFINES (clause 1) is allowed with RM/COBOL but not COBOL 2002+ */ - static const cob_flags_t allowed_clauses = - SYN_CLAUSE_1 | SYN_CLAUSE_2 | SYN_CLAUSE_3 | SYN_CLAUSE_7; - cob_flags_t tested = check_pic_duplicate & ~(allowed_clauses); - if (tested != SYN_CLAUSE_30) { - cb_error_x (CB_TREE(current_field), _("illegal combination of %s with other clauses"), "SAME AS"); - current_field->flag_is_verified = 1; - current_field->flag_invalid = 1; - } else { - struct cb_field* fld = CB_FIELD (current_field->same_as); - current_field = copy_into_field (fld, current_field, 1); - } -} - -static void -check_not_both (const cob_flags_t flag1, const cob_flags_t flag2, - const char *flag1_name, const char *flag2_name, - const cob_flags_t flags, const cob_flags_t flag_to_set) -{ - if (flag_to_set == flag1 && (flags & flag2)) { - cb_error (_("cannot specify both %s and %s"), - flag1_name, flag2_name); - } else if (flag_to_set == flag2 && (flags & flag1)) { - cb_error (_("cannot specify both %s and %s"), - flag1_name, flag2_name); - - } -} - -static COB_INLINE COB_A_INLINE void -check_not_highlight_and_lowlight (const cob_flags_t flags, - const cob_flags_t flag_to_set) -{ - check_not_both (COB_SCREEN_HIGHLIGHT, COB_SCREEN_LOWLIGHT, - "HIGHLIGHT", "LOWLIGHT", flags, flag_to_set); -} - -static void -set_screen_attr (const char *clause, const cob_flags_t bitval) -{ - if (current_field->screen_flag & bitval) { - emit_duplicate_clause_message (clause); - } else { - current_field->screen_flag |= bitval; - } -} - -static void -emit_conflicting_clause_message (const char *clause, const char *conflicting) -{ - if (cb_relaxed_syntax_checks) { - cb_warning (COBC_WARN_FILLER, _("cannot specify both %s and %s; %s is ignored"), - clause, conflicting, clause); - } else { - cb_error (_("cannot specify both %s and %s"), - clause, conflicting); - } - -} - -static void -set_attr_with_conflict (const char *clause, const cob_flags_t bitval, - const char *confl_clause, const cob_flags_t confl_bit, - const int local_check_duplicate, cob_flags_t *flags) -{ - if (local_check_duplicate && (*flags & bitval)) { - emit_duplicate_clause_message (clause); - } else if (*flags & confl_bit) { - emit_conflicting_clause_message (clause, confl_clause); - } else { - *flags |= bitval; - } -} - -static COB_INLINE COB_A_INLINE void -set_screen_attr_with_conflict (const char *clause, const cob_flags_t bitval, - const char *confl_clause, - const cob_flags_t confl_bit) -{ - set_attr_with_conflict (clause, bitval, confl_clause, confl_bit, 1, - ¤t_field->screen_flag); -} - -static COB_INLINE COB_A_INLINE int -has_dispattr (const cob_flags_t attrib) -{ - return current_statement->attr_ptr - && current_statement->attr_ptr->dispattrs & attrib; -} - -static void -attach_attrib_to_cur_stmt (void) -{ - if (!current_statement->attr_ptr) { - current_statement->attr_ptr = - cobc_parse_malloc (sizeof(struct cb_attr_struct)); - } -} - -static COB_INLINE COB_A_INLINE void -set_dispattr (const cob_flags_t attrib) -{ - attach_attrib_to_cur_stmt (); - current_statement->attr_ptr->dispattrs |= attrib; -} - -static COB_INLINE COB_A_INLINE void -set_dispattr_with_conflict (const char *attrib_name, const cob_flags_t attrib, - const char *confl_name, - const cob_flags_t confl_attrib) -{ - attach_attrib_to_cur_stmt (); - set_attr_with_conflict (attrib_name, attrib, confl_name, confl_attrib, 0, - ¤t_statement->attr_ptr->dispattrs); -} - -static void -bit_set_attr (const cb_tree on_off, const cob_flags_t attr_val) -{ - if (on_off == cb_int1) { - set_attr_val_on |= attr_val; - } else { - set_attr_val_off |= attr_val; - } -} - -static void -set_field_attribs (cb_tree fgc, cb_tree bgc, cb_tree scroll, - cb_tree timeout, cb_tree prompt, cb_tree size_is) -{ - /* [WITH] FOREGROUND-COLOR [IS] */ - if (fgc) { - current_statement->attr_ptr->fgc = fgc; - } - /* [WITH] BACKGROUND-COLOR [IS] */ - if (bgc) { - current_statement->attr_ptr->bgc = bgc; - } - /* [WITH] SCROLL UP | DOWN */ - if (scroll) { - current_statement->attr_ptr->scroll = scroll; - } - /* [WITH] TIME-OUT [AFTER] */ - if (timeout) { - current_statement->attr_ptr->timeout = timeout; - } - /* [WITH] PROMPT CHARACTER [IS] */ - if (prompt) { - current_statement->attr_ptr->prompt = prompt; - } - /* [WITH] SIZE [IS] */ - if (size_is) { - current_statement->attr_ptr->size_is = size_is; - } -} - -static void -set_attribs (cb_tree fgc, cb_tree bgc, cb_tree scroll, - cb_tree timeout, cb_tree prompt, cb_tree size_is, - const cob_flags_t attrib) -{ - attach_attrib_to_cur_stmt (); - set_field_attribs (fgc, bgc, scroll, timeout, prompt, size_is); - - current_statement->attr_ptr->dispattrs |= attrib; -} - -static void -set_attribs_with_conflict (cb_tree fgc, cb_tree bgc, cb_tree scroll, - cb_tree timeout, cb_tree prompt, cb_tree size_is, - const char *clause_name, const cob_flags_t attrib, - const char *confl_name, const cob_flags_t confl_attrib) -{ - attach_attrib_to_cur_stmt (); - set_field_attribs (fgc, bgc, scroll, timeout, prompt, size_is); - - set_dispattr_with_conflict (clause_name, attrib, confl_name, - confl_attrib); -} - -static cob_flags_t -zero_conflicting_flag (const cob_flags_t screen_flag, cob_flags_t parent_flag, - const cob_flags_t flag1, const cob_flags_t flag2) -{ - if (screen_flag & flag1) { - parent_flag &= ~flag2; - } else if (screen_flag & flag2) { - parent_flag &= ~flag1; - } - - return parent_flag; -} - -static cob_flags_t -zero_conflicting_flags (const cob_flags_t screen_flag, cob_flags_t parent_flag) -{ - parent_flag = zero_conflicting_flag (screen_flag, parent_flag, - COB_SCREEN_BLANK_LINE, - COB_SCREEN_BLANK_SCREEN); - parent_flag = zero_conflicting_flag (screen_flag, parent_flag, - COB_SCREEN_ERASE_EOL, - COB_SCREEN_ERASE_EOS); - parent_flag = zero_conflicting_flag (screen_flag, parent_flag, - COB_SCREEN_HIGHLIGHT, - COB_SCREEN_LOWLIGHT); - - return parent_flag; -} - -static void -check_and_set_usage (const enum cb_usage usage) -{ - check_repeated ("USAGE", SYN_CLAUSE_5, &check_pic_duplicate); - current_field->usage = usage; - current_field->flag_usage_defined = 1; -} - -static void -check_preceding_tallying_phrases (const enum tallying_phrase phrase) -{ - switch (phrase) { - case FOR_PHRASE: - if (previous_tallying_phrase == ALL_LEADING_TRAILING_PHRASES) { - cb_error (_("FOR phrase cannot immediately follow ALL/LEADING/TRAILING")); - } else if (previous_tallying_phrase == FOR_PHRASE) { - cb_error (_("missing CHARACTERS/ALL/LEADING/TRAILING phrase after FOR phrase")); - } - break; - - case ALL_LEADING_TRAILING_PHRASES: - if (previous_tallying_phrase == CHARACTERS_PHRASE - || previous_tallying_phrase == ALL_LEADING_TRAILING_PHRASES) { - cb_error (_("missing value between ALL/LEADING/TRAILING words")); - } - /* fall through */ - case CHARACTERS_PHRASE: - if (previous_tallying_phrase == NO_PHRASE) { - cb_error (_("missing FOR phrase before CHARACTERS/ALL/LEADING/TRAILING phrase")); - } - break; - - case VALUE_REGION_PHRASE: - if (!(previous_tallying_phrase == ALL_LEADING_TRAILING_PHRASES - || previous_tallying_phrase == VALUE_REGION_PHRASE)) { - cb_error (_("missing ALL/LEADING/TRAILING before value")); - } - break; - - /* LCOV_EXCL_START */ - default: - /* This should never happen (and therefore doesn't get a translation) */ - cb_error ("unexpected tallying phrase"); - COBC_ABORT(); - /* LCOV_EXCL_STOP */ - } - - previous_tallying_phrase = phrase; -} - -static int -has_relative_pos (struct cb_field const *field) -{ - return !!(field->screen_flag - & (COB_SCREEN_LINE_PLUS | COB_SCREEN_LINE_MINUS - | COB_SCREEN_COLUMN_PLUS | COB_SCREEN_COLUMN_MINUS)); -} - -static int -is_recursive_call (cb_tree target) -{ - const char *target_name = ""; - - if (CB_LITERAL_P (target)) { - target_name = (const char *)(CB_LITERAL(target)->data); - } else if (CB_REFERENCE_P (target) - && CB_PROTOTYPE_P (cb_ref (target))) { - target_name = CB_PROTOTYPE (cb_ref (target))->ext_name; - } - - return !strcmp (target_name, current_program->orig_program_id); -} - -static cb_tree -check_not_88_level (cb_tree x) -{ - struct cb_field *f; - - if (x == cb_error_node) { - return cb_error_node; - } - if (!CB_REF_OR_FIELD_P(x)) { - return x; - } - - f = CB_FIELD_PTR (x); - - if (f->level == 88) { -#if 0 /* note: we may consider to support the extension (if existing) to - reference a condition-name target by the condition-name */ - if (cb_verify (cb_condition_references_data, _("use of condition-name in place of data-name"))) { - return CB_TREE (f->parent); - } -#else - cb_error (_("condition-name not allowed here: '%s'"), cb_name (x)); - /* invalidate field to prevent same error in typeck.c (validate_one) */ - /* FIXME: If we really need the additional check here then we missed - a call to cb_validate_one() somewhere */ - return cb_error_node; -#endif - } else { - return x; - } -} - -static int -is_screen_field (cb_tree x) -{ - if (CB_FIELD_P (x)) { - return (CB_FIELD (x))->storage == CB_STORAGE_SCREEN; - } else if (CB_REFERENCE_P (x)) { - return is_screen_field (cb_ref (x)); - } else { - return 0; - } -} - -static void -error_if_no_advancing_in_screen_display (cb_tree advancing) -{ - if (advancing != cb_int1) { - cb_error (_("cannot specify NO ADVANCING in screen DISPLAY")); - } -} - -static cb_tree -get_default_display_device (void) -{ - if (current_program->flag_console_is_crt - || cb_console_is_crt) { - return cb_null; - } else { - return cb_int0; - } -} - -static COB_INLINE COB_A_INLINE int -contains_one_screen_field (struct cb_list *x_list) -{ - return (cb_tree) x_list != cb_null - && cb_list_length ((cb_tree) x_list) == 1 - && is_screen_field (x_list->value); -} - -static int -contains_only_screen_fields (struct cb_list *x_list) -{ - if ((cb_tree) x_list == cb_null) { - return 0; - } - - for (; x_list; x_list = (struct cb_list *) x_list->chain) { - if (!is_screen_field (x_list->value)) { - return 0; - } - } - - return 1; -} - -static int -contains_fields_and_screens (struct cb_list *x_list) -{ - int field_seen = 0; - int screen_seen = 0; - - if ((cb_tree) x_list == cb_null) { - return 0; - } - - for (; x_list; x_list = (struct cb_list *) x_list->chain) { - if (is_screen_field (x_list->value)) { - screen_seen = 1; - } else { - field_seen = 1; - } - } - - return screen_seen && field_seen; -} - -static enum cb_display_type -deduce_display_type (cb_tree x_list, cb_tree local_upon_value, cb_tree local_line_column, - struct cb_attr_struct * const attr_ptr) -{ - int using_default_device_which_is_crt = - local_upon_value == NULL && get_default_display_device () == cb_null; - - /* TODO: Separate CGI DISPLAYs here */ - if (contains_only_screen_fields ((struct cb_list *) x_list)) { - if (!contains_one_screen_field ((struct cb_list *) x_list) - || attr_ptr) { - cb_verify_x (x_list, cb_accept_display_extensions, - _("non-standard DISPLAY")); - } - - if (local_upon_value != NULL && local_upon_value != cb_null) { - cb_error_x (x_list, _("screens may only be displayed on CRT")); - } - - return SCREEN_DISPLAY; - } else if (contains_fields_and_screens ((struct cb_list *) x_list)) { - cb_error_x (x_list, _("cannot mix screens and fields in the same DISPLAY statement")); - return MIXED_DISPLAY; - } else if (local_line_column || attr_ptr) { - if (local_upon_value != NULL && local_upon_value != cb_null) { - cb_error_x (x_list, _("screen clauses may only be used for DISPLAY on CRT")); - } - - cb_verify_x (x_list, cb_accept_display_extensions, - _("non-standard DISPLAY")); - - return FIELD_ON_SCREEN_DISPLAY; - } else if (local_upon_value == cb_null || using_default_device_which_is_crt) { - /* This is the only format permitted by the standard */ - return FIELD_ON_SCREEN_DISPLAY; - } else if (display_type == FIELD_ON_SCREEN_DISPLAY && local_upon_value == NULL) { - /* This is for when fields without clauses follow fields with screen clauses */ - return FIELD_ON_SCREEN_DISPLAY; - } else { - return DEVICE_DISPLAY; - } -} - -static void -set_display_type (cb_tree x_list, cb_tree local_upon_value, - cb_tree local_line_column, struct cb_attr_struct * const attr_ptr) -{ - display_type = deduce_display_type (x_list, local_upon_value, local_line_column, attr_ptr); -} - -static void -error_if_different_display_type (cb_tree x_list, cb_tree local_upon_value, - cb_tree local_line_column, struct cb_attr_struct * const attr_ptr) -{ - const enum cb_display_type type = - deduce_display_type (x_list, local_upon_value, local_line_column, attr_ptr); - - /* Avoid re-displaying the same error for mixed DISPLAYs */ - if (type == display_type || display_type == MIXED_DISPLAY) { - return; - } - - if (type != MIXED_DISPLAY) { - if (type == SCREEN_DISPLAY || display_type == SCREEN_DISPLAY) { - cb_error_x (x_list, _("cannot mix screens and fields in the same DISPLAY statement")); - } else { - /* - The only other option is that there is a mix of - FIELD_ON_SCREEN_DISPLAY and DEVICE_DISPLAY. - */ - cb_error_x (x_list, _("ambiguous DISPLAY; put items to display on device in separate DISPLAY")); - } - } - - display_type = MIXED_DISPLAY; -} - -static void -error_if_not_usage_display_or_nonnumeric_lit (cb_tree x) -{ - const int is_numeric_literal = CB_NUMERIC_LITERAL_P (x); - const int is_field_with_usage_not_display = - CB_REFERENCE_P (x) && CB_FIELD (cb_ref (x)) - && CB_FIELD (cb_ref (x))->usage != CB_USAGE_DISPLAY; - - if (is_numeric_literal) { - cb_error_x (x, _("%s is not an alphanumeric literal"), CB_LITERAL (x)->data); - } else if (is_field_with_usage_not_display) { - cb_error_x (x, _("'%s' is not USAGE DISPLAY"), cb_name (x)); - } -} - -static void -check_validate_item (cb_tree x) -{ - struct cb_field *f; - enum cb_class tree_class; - - if (CB_INVALID_TREE(x) || x->tag != CB_TAG_REFERENCE) { - return; - } - x = cb_ref (x); - if (CB_INVALID_TREE (x) || !CB_FIELD_P (x)) { - cb_error (_("invalid target for %s"), "VALIDATE"); - return; - } - - f = CB_FIELD (x); - tree_class = CB_TREE_CLASS(f); - if (is_screen_field(x)) { - cb_error (_("SCREEN item cannot be used here")); - } else if (f->level == 66) { - cb_error (_("RENAMES item may not be used here")); - } else if (f->flag_any_length) { - cb_error (_("ANY LENGTH item not allowed here")); - } else if (tree_class == CB_CLASS_INDEX - || tree_class == CB_CLASS_OBJECT - || tree_class == CB_CLASS_POINTER) { - cb_error (_("item '%s' has wrong class for VALIDATE"), cb_name (x)); - } -} - -static void -error_if_following_every_clause (void) -{ - if (ml_suppress_list - && CB_ML_SUPPRESS (CB_VALUE (ml_suppress_list))->target == CB_ML_SUPPRESS_TYPE) { - cb_error (_("WHEN clause must follow EVERY clause")); - } -} - -static void -prepend_to_ml_suppress_list (cb_tree suppress_entry) -{ - cb_tree new_list_head = CB_LIST_INIT (suppress_entry); - cb_list_append (new_list_head, ml_suppress_list); - ml_suppress_list = new_list_head; -} - -static void -add_identifier_to_ml_suppress_conds (cb_tree identifier) -{ - cb_tree suppress_id = cb_build_ml_suppress_clause (); - CB_ML_SUPPRESS (suppress_id)->target = CB_ML_SUPPRESS_IDENTIFIER; - CB_ML_SUPPRESS (suppress_id)->identifier = identifier; - prepend_to_ml_suppress_list (suppress_id); -} - -static void -add_when_to_ml_suppress_conds (cb_tree when_list) -{ - struct cb_ml_suppress_clause *last_suppress_clause; - cb_tree suppress_all; - - /* - If the preceding clause in SUPPRESS was an identifier, the WHEN - belongs to the identifier. If EVERY was preceding, the WHEN belongs to - the EVERY. Otherwise, the WHEN acts on the entire record. - */ - if (ml_suppress_list) { - last_suppress_clause = CB_ML_SUPPRESS (CB_VALUE (ml_suppress_list)); - if ((last_suppress_clause->target == CB_ML_SUPPRESS_IDENTIFIER - || last_suppress_clause->target == CB_ML_SUPPRESS_TYPE) - && !last_suppress_clause->when_list) { - last_suppress_clause->when_list = when_list; - return; - } - } - - suppress_all = cb_build_ml_suppress_clause (); - CB_ML_SUPPRESS (suppress_all)->when_list = when_list; - prepend_to_ml_suppress_list (suppress_all); -} - -static void -add_type_to_ml_suppress_conds (enum cb_ml_suppress_category category, - enum cb_ml_type ml_type) -{ - cb_tree suppress_type = cb_build_ml_suppress_clause (); - CB_ML_SUPPRESS (suppress_type)->target = CB_ML_SUPPRESS_TYPE; - CB_ML_SUPPRESS (suppress_type)->category = category; - CB_ML_SUPPRESS (suppress_type)->ml_type = ml_type; - prepend_to_ml_suppress_list (suppress_type); -} - -static void -set_record_size (cb_tree min, cb_tree max) -{ - int record_min, record_max; - - if (min) { - record_min = cb_get_int (min); - if (record_min < 0) { - /* already handled by integer check */ - } else { - current_file->record_min = record_min; - } - } else { - record_min = 0; - } - if (!max) return; - record_max = cb_get_int (max); - if (record_max < 0) { - /* already handled by integer check */ - return; - } else if (record_max == 0) { - /* Note: standard COBOL does not allow zero at all, use the related - configuration option */ - if (cb_records_mismatch_record_clause >= CB_ERROR) { - cb_error (_("non-zero value expected")); - } - return; - } - if (current_file->organization == COB_ORG_INDEXED - && record_max > MAX_FD_RECORD_IDX) { - cb_error (_("RECORD size (IDX) exceeds maximum allowed (%d)"), - MAX_FD_RECORD_IDX); - current_file->record_max = MAX_FD_RECORD_IDX; - } else if (record_max > MAX_FD_RECORD) { - cb_error (_("RECORD size exceeds maximum allowed (%d)"), - MAX_FD_RECORD); - current_file->record_max = MAX_FD_RECORD; - } else { - if (record_max <= record_min) { - cb_error (_("RECORD clause invalid")); - } - current_file->record_max = record_max; - } -} - -%} - -%token TOKEN_EOF 0 "end of file" - -%token THREEDIMENSIONAL "3D" -%token ABSENT -%token ACCEPT -%token ACCESS -%token ACTIVEX "ACTIVE-X" -%token ACTION -%token ACTUAL -%token ADD -%token ADDRESS -%token ADJUSTABLE_COLUMNS "ADJUSTABLE-COLUMNS" -%token ADVANCING -%token AFTER -%token ALIGNMENT -%token ALL -%token ALLOCATE -%token ALLOWING -%token ALPHABET -%token ALPHABETIC -%token ALPHABETIC_LOWER "ALPHABETIC-LOWER" -%token ALPHABETIC_UPPER "ALPHABETIC-UPPER" -%token ALPHANUMERIC -%token ALPHANUMERIC_EDITED "ALPHANUMERIC-EDITED" -%token ALSO -%token ALTER -%token ALTERNATE -%token AND -%token ANY -%token APPLY -%token ARE -%token AREA -%token AREAS -%token ARGUMENT_NUMBER "ARGUMENT-NUMBER" -%token ARGUMENT_VALUE "ARGUMENT-VALUE" -%token ARITHMETIC -%token AS -%token ASCENDING -%token ASCII -%token ASSIGN -%token AT -%token ATTRIBUTE -%token ATTRIBUTES -%token AUTO -%token AUTO_DECIMAL "AUTO-DECIMAL" -%token AUTO_SPIN "AUTO-SPIN" -%token AUTOMATIC -%token AWAY_FROM_ZERO "AWAY-FROM-ZERO" -%token BACKGROUND_COLOR "BACKGROUND-COLOR" -%token BACKGROUND_HIGH "BACKGROUND-HIGH" -%token BACKGROUND_LOW "BACKGROUND-LOW" -%token BACKGROUND_STANDARD "BACKGROUND-STANDARD" -%token BAR -%token BASED -%token BEFORE -%token BELL -%token BINARY -%token BINARY_C_LONG "BINARY-C-LONG" -%token BINARY_CHAR "BINARY-CHAR" -%token BINARY_DOUBLE "BINARY-DOUBLE" -%token BINARY_LONG "BINARY-LONG" -%token BINARY_SEQUENTIAL "BINARY-SEQUENTIAL" -%token BINARY_SHORT "BINARY-SHORT" -%token BIT -%token BITMAP -%token BITMAP_END "BITMAP-END" -%token BITMAP_HANDLE "BITMAP-HANDLE" -%token BITMAP_NUMBER "BITMAP-NUMBER" -%token BITMAP_START "BITMAP-START" -%token BITMAP_TIMER "BITMAP-TIMER" -%token BITMAP_TRAILING "BITMAP-TRAILING" -%token BITMAP_TRANSPARENT_COLOR "BITMAP-TRANSPARENT-COLOR" -%token BITMAP_WIDTH "BITMAP-WIDTH" -%token BLANK -%token BLINK -%token BLOCK -%token BOTTOM -%token BOX -%token BOXED -%token BULK_ADDITION "BULK-ADDITION" -%token BUSY -%token BUTTONS -%token BY -%token BYTE_LENGTH "BYTE-LENGTH" -%token C -%token CALENDAR_FONT "CALENDAR-FONT" -%token CALL -%token CANCEL -%token CANCEL_BUTTON "CANCEL-BUTTON" -%token CAPACITY -%token CARD_PUNCH "CARD-PUNCH" -%token CARD_READER "CARD-READER" -%token CASSETTE -%token CCOL -%token CD -%token CELL -%token CELL_COLOR "CELL-COLOR" -%token CELL_DATA "CELL-DATA" -%token CELL_FONT "CELL-FONT" -%token CELL_PROTECTION "CELL-PROTECTION" -%token CENTER -%token CENTERED -%token CENTERED_HEADINGS "CENTERED-HEADINGS" -%token CENTURY_DATE "CENTURY-DATE" -%token CF -%token CH -%token CHAINING -%token CHARACTER -%token CHARACTERS -%token CHECK_BOX "CHECK-BOX" -%token CLASS -%token CLASSIFICATION -%token CLASS_NAME "class-name" -%token CLEAR_SELECTION "CLEAR-SELECTION" -%token CLINE -%token CLINES -%token CLOSE -%token COBOL -%token CODE -%token CODE_SET "CODE-SET" -%token COLLATING -%token COL -%token COLOR -%token COLORS -%token COLS -%token COLUMN -%token COLUMN_COLOR "COLUMN-COLOR" -%token COLUMN_DIVIDERS "COLUMN-DIVIDERS" -%token COLUMN_FONT "COLUMN-FONT" -%token COLUMN_HEADINGS "COLUMN-HEADINGS" -%token COLUMN_PROTECTION "COLUMN-PROTECTION" -%token COLUMNS -%token COMBO_BOX "COMBO-BOX" -%token COMMA -%token COMMAND_LINE "COMMAND-LINE" -%token COMMA_DELIM "comma delimiter" -%token COMMIT -%token COMMON -%token COMMUNICATION -%token COMP -%token COMPUTE -%token COMP_0 "COMP-0" -%token COMP_1 "COMP-1" -%token COMP_2 "COMP-2" -%token COMP_3 "COMP-3" -%token COMP_4 "COMP-4" -%token COMP_5 "COMP-5" -%token COMP_6 "COMP-6" -%token COMP_N "COMP-N" -%token COMP_X "COMP-X" -%token CONCATENATE_FUNC "FUNCTION CONCATENATE" -%token CONDITION -%token CONFIGURATION -%token CONSTANT -%token CONTAINS -%token CONTENT -%token CONTENT_LENGTH_FUNC "FUNCTION CONTENT-LENGTH" -%token CONTENT_OF_FUNC "FUNCTION CONTENT-OF" -%token CONTINUE -%token CONTROL -%token CONTROLS -%token CONVERSION -%token CONVERTING -%token COPY -%token COPY_SELECTION "COPY-SELECTION" -%token CORE_INDEX "CORE-INDEX" -%token CORRESPONDING -%token COUNT -%token CRT -%token CRT_UNDER "CRT-UNDER" -%token CSIZE -%token CURRENCY -%token CURRENT_DATE_FUNC "FUNCTION CURRENT-DATE" -%token CURSOR -%token CURSOR_COL "CURSOR-COL" -%token CURSOR_COLOR "CURSOR-COLOR" -%token CURSOR_FRAME_WIDTH "CURSOR-FRAME-WIDTH" -%token CURSOR_ROW "CURSOR-ROW" -%token CURSOR_X "CURSOR-X" -%token CURSOR_Y "CURSOR-Y" -%token CUSTOM_PRINT_TEMPLATE "CUSTOM-PRINT-TEMPLATE" -%token CYCLE -%token CYL_INDEX "CYL-INDEX" -%token CYL_OVERFLOW "CYL-OVERFLOW" -%token DASHED -%token DATA -%token DATA_COLUMNS "DATA-COLUMNS" -%token DATA_TYPES "DATA-TYPES" -%token DATE -%token DATE_ENTRY "DATE-ENTRY" -%token DAY -%token DAY_OF_WEEK "DAY-OF-WEEK" -%token DE -%token DEBUGGING -%token DECIMAL_POINT "DECIMAL-POINT" -%token DECLARATIVES -%token DEFAULT -%token DEFAULT_BUTTON "DEFAULT-BUTTON" -%token DEFAULT_FONT "DEFAULT-FONT" -%token DELETE -%token DELIMITED -%token DELIMITER -%token DEPENDING -%token DESCENDING -%token DESTINATION -%token DESTROY -%token DETAIL -%token DISABLE -%token DISC -%token DISK -%token DISP -%token DISPLAY -%token DISPLAY_COLUMNS "DISPLAY-COLUMNS" -%token DISPLAY_FORMAT "DISPLAY-FORMAT" -%token DISPLAY_OF_FUNC "FUNCTION DISPLAY-OF" -%token DIVIDE -%token DIVIDERS -%token DIVIDER_COLOR "DIVIDER-COLOR" -%token DIVISION -%token DOTDASH -%token DOTTED -%token DRAG_COLOR "DRAG-COLOR" -%token DROP_DOWN "DROP-DOWN" -%token DROP_LIST "DROP-LIST" -%token DOWN -%token DUPLICATES -%token DYNAMIC -%token EBCDIC -%token EC -%token ECHO -%token EGI -%token EIGHTY_EIGHT "level-number 88" -%token ENABLE -%token ENABLED -%token ELEMENT -%token ELSE -%token EMI -%token ENCRYPTION -%token ENCODING -%token END -%token END_ACCEPT "END-ACCEPT" -%token END_ADD "END-ADD" -%token END_CALL "END-CALL" -%token END_COMPUTE "END-COMPUTE" -%token END_COLOR "END-COLOR" -%token END_DELETE "END-DELETE" -%token END_DISPLAY "END-DISPLAY" -%token END_DIVIDE "END-DIVIDE" -%token END_EVALUATE "END-EVALUATE" -%token END_FUNCTION "END FUNCTION" -%token END_IF "END-IF" -%token END_JSON "END-JSON" -%token END_MODIFY "END-MODIFY" -%token END_MULTIPLY "END-MULTIPLY" -%token END_PERFORM "END-PERFORM" -%token END_PROGRAM "END PROGRAM" -%token END_READ "END-READ" -%token END_RECEIVE "END-RECEIVE" -%token END_RETURN "END-RETURN" -%token END_REWRITE "END-REWRITE" -%token END_SEARCH "END-SEARCH" -%token END_START "END-START" -%token END_STRING "END-STRING" -%token END_SUBTRACT "END-SUBTRACT" -%token END_UNSTRING "END-UNSTRING" -%token END_WRITE "END-WRITE" -%token END_XML "END-XML" -%token ENGRAVED -%token ENSURE_VISIBLE "ENSURE-VISIBLE" -%token ENTRY -%token ENTRY_CONVENTION "ENTRY-CONVENTION" -%token ENTRY_FIELD "ENTRY-FIELD" -%token ENTRY_REASON "ENTRY-REASON" -%token ENVIRONMENT -%token ENVIRONMENT_NAME "ENVIRONMENT-NAME" -%token ENVIRONMENT_VALUE "ENVIRONMENT-VALUE" -%token EOL -%token EOP -%token EOS -%token EQUAL -%token ERASE -%token ERROR -%token ESCAPE -%token ESCAPE_BUTTON "ESCAPE-BUTTON" -%token ESI -%token EVALUATE -%token EVENT -%token EVENT_LIST "EVENT-LIST" -%token EVENT_STATUS "EVENT STATUS" -%token EVERY -%token EXCEPTION -%token EXCEPTION_CONDITION "EXCEPTION CONDITION" -%token EXCEPTION_VALUE "EXCEPTION-VALUE" -%token EXPAND -%token EXCLUSIVE -%token EXIT -%token EXPONENTIATION "exponentiation operator" -%token EXTEND -%token EXTENDED_SEARCH "EXTENDED-SEARCH" -%token EXTERNAL -%token EXTERNAL_FORM "EXTERNAL-FORM" -%token F -%token FD -%token FH__FCD "FH--FCD" -%token FH__KEYDEF "FH--KEYDEF" -%token FILE_CONTROL "FILE-CONTROL" -%token FILE_ID "FILE-ID" -%token FILE_LIMIT "FILE-LIMIT" -%token FILE_LIMITS "FILE-LIMITS" -%token FILE_NAME "FILE-NAME" -%token FILE_POS "FILE-POS" -%token FILL_COLOR "FILL-COLOR" -%token FILL_COLOR2 "FILL-COLOR2" -%token FILL_PERCENT "FILL-PERCENT" -%token FILLER -%token FINAL -%token FINISH_REASON "FINISH-REASON" -%token FIRST -%token FIXED -%token FIXED_FONT "FIXED-FONT" -%token FIXED_WIDTH "FIXED-WIDTH" -%token FLAT -%token FLAT_BUTTONS "FLAT-BUTTONS" -%token FLOAT_BINARY_128 "FLOAT-BINARY-128" -%token FLOAT_BINARY_32 "FLOAT-BINARY-32" -%token FLOAT_BINARY_64 "FLOAT-BINARY-64" -%token FLOAT_DECIMAL_16 "FLOAT-DECIMAL-16" -%token FLOAT_DECIMAL_34 "FLOAT-DECIMAL-34" -%token FLOAT_DECIMAL_7 "FLOAT-DECIMAL-7" -%token FLOAT_EXTENDED "FLOAT-EXTENDED" -%token FLOAT_LONG "FLOAT-LONG" -%token FLOAT_SHORT "FLOAT-SHORT" -%token FLOATING -%token FONT -%token FOOTING -%token FOR -%token FOREGROUND_COLOR "FOREGROUND-COLOR" -%token FOREVER -%token FORMATTED_DATE_FUNC "FUNCTION FORMATTED-DATE" -%token FORMATTED_DATETIME_FUNC "FUNCTION FORMATTED-DATETIME" -%token FORMATTED_TIME_FUNC "FUNCTION FORMATTED-TIME" -%token FRAME -%token FRAMED -%token FREE -%token FROM -%token FROM_CRT "FROM CRT" -%token FULL -%token FULL_HEIGHT "FULL-HEIGHT" -%token FUNCTION -%token FUNCTION_ID "FUNCTION-ID" -%token FUNCTION_NAME "intrinsic function name" -%token GENERATE -%token GIVING -%token GLOBAL -%token GO -%token GO_BACK "GO-BACK" -%token GO_FORWARD "GO-FORWARD" -%token GO_HOME "GO-HOME" -%token GO_SEARCH "GO-SEARCH" -%token GOBACK -%token GRAPHICAL -%token GREATER -%token GREATER_OR_EQUAL "GREATER OR EQUAL" -%token GRID -%token GROUP -%token GROUP_VALUE "GROUP-VALUE" -%token HANDLE -%token HAS_CHILDREN "HAS-CHILDREN" -%token HEADING -%token HEADING_COLOR "HEADING-COLOR" -%token HEADING_DIVIDER_COLOR "HEADING-DIVIDER-COLOR" -%token HEADING_FONT "HEADING-FONT" -%token HEAVY -%token HEIGHT_IN_CELLS "HEIGHT-IN-CELLS" -%token HELP_ID "HELP-ID" -%token HIDDEN_DATA "HIDDEN-DATA" -%token HIGHLIGHT -%token HIGH_COLOR "HIGH-COLOR" -%token HIGH_VALUE "HIGH-VALUE" -%token HOT_TRACK "HOT-TRACK" -%token HSCROLL -%token HSCROLL_POS "HSCROLL-POS" -%token ICON -%token ID -%token IDENTIFIED -%token IDENTIFICATION -%token IF -%token IGNORE -%token IGNORING -%token IN -%token INDEPENDENT -%token INDEX -%token INDEXED -%token INDICATE -%token INITIALIZE -%token INITIALIZED -%token INITIATE -%token INPUT -%token INPUT_OUTPUT "INPUT-OUTPUT" -%token INQUIRE -%token INSERTION_INDEX "INSERTION-INDEX" -%token INSERT_ROWS "INSERT-ROWS" -%token INSPECT -%token INTERMEDIATE -%token INTO -%token INTRINSIC -%token INVALID -%token INVALID_KEY "INVALID KEY" -%token IS -%token ITEM -%token ITEM_TEXT "ITEM-TEXT" -%token ITEM_TO_ADD "ITEM-TO_ADD" -%token ITEM_TO_DELETE "ITEM-TO_DELETE" -%token ITEM_TO_EMPTY "ITEM-TO_EMPTY" -%token ITEM_VALUE "ITEM-VALUE" -%token I_O "I-O" -%token I_O_CONTROL "I-O-CONTROL" -%token JSON -%token JUSTIFIED -%token KEPT -%token KEY -%token KEYBOARD -%token LABEL -%token LABEL_OFFSET "LABEL-OFFSET" -%token LARGE_FONT "LARGE-FONT" -%token LARGE_OFFSET "LARGE-OFFSET" -%token LAST -%token LAST_ROW "LAST-ROW" -%token LAYOUT_DATA "LAYOUT-DATA" -%token LAYOUT_MANAGER "LAYOUT-MANAGER" -%token LEADING -%token LEADING_SHIFT "LEADING-SHIFT" -%token LEAVE -%token LEFT -%token LEFTLINE -%token LEFT_TEXT "LEFT-TEXT" -%token LENGTH -%token LENGTH_OF "LENGTH OF" -%token LENGTH_FUNC "FUNCTION LENGTH/BYTE-LENGTH" -%token LESS -%token LESS_OR_EQUAL "LESS OR EQUAL" -%token LEVEL_NUMBER "level-number" /* 01 thru 49, 77 */ -%token LIMIT -%token LIMITS -%token LINAGE -%token LINAGE_COUNTER "LINAGE-COUNTER" -%token LINE -%token LINE_COUNTER "LINE-COUNTER" -%token LINE_LIMIT "LINE LIMIT" -%token LINE_SEQUENTIAL "LINE-SEQUENTIAL" -%token LINES -%token LINES_AT_ROOT "LINES-AT-ROOT" -%token LINKAGE -%token LIST_BOX "LIST-BOX" -%token LITERAL "Literal" -%token LM_RESIZE "LM-RESIZE" -%token LOC -%token LOCALE -%token LOCALE_DATE_FUNC "FUNCTION LOCALE-DATE" -%token LOCALE_TIME_FUNC "FUNCTION LOCALE-TIME" -%token LOCALE_TIME_FROM_FUNC "FUNCTION LOCALE-TIME-FROM-SECONDS" -%token LOCAL_STORAGE "LOCAL-STORAGE" -%token LOCK -%token LOCK_HOLDING "LOCK-HOLDING" -%token LONG_DATE "LONG-DATE" -%token LOWER -%token LOWERED -%token LOWER_CASE_FUNC "FUNCTION LOWER-CASE" -%token LOWLIGHT -%token LOW_COLOR "LOW-COLOR" -%token LOW_VALUE "LOW-VALUE" -%token MAGNETIC_TAPE "MAGNETIC-TAPE" -%token MANUAL -%token MASS_UPDATE "MASS-UPDATE" -%token MASTER_INDEX "MASTER-INDEX" -%token MAX_LINES "MAX-LINES" -%token MAX_PROGRESS "MAX-PROGRESS" -%token MAX_TEXT "MAX-TEXT" -%token MAX_VAL "MAX-VAL" -%token MEMORY -%token MEDIUM_FONT "MEDIUM-FONT" -%token MENU -%token MERGE -%token MESSAGE -%token MINUS -%token MIN_VAL "MIN-VAL" -%token MNEMONIC_NAME "Mnemonic name" -%token MODE -%token MODIFY -%token MODULES -%token MOVE -%token MULTILINE -%token MULTIPLE -%token MULTIPLY -%token NAME -%token NAMESPACE -%token NAMESPACE_PREFIX "NAMESPACE-PREFIX" -%token NATIONAL -%token NATIONAL_EDITED "NATIONAL-EDITED" -%token NATIONAL_OF_FUNC "FUNCTION NATIONAL-OF" -%token NATIVE -%token NAVIGATE_URL "NAVIGATE-URL" -%token NEAREST_AWAY_FROM_ZERO "NEAREST-AWAY-FROM-ZERO" -%token NEAREST_EVEN "NEAREST-EVEN" -%token NEAREST_TOWARD_ZERO "NEAREST-TOWARD-ZERO" -%token NEGATIVE -%token NESTED -%token NEW -%token NEXT -%token NEXT_ITEM "NEXT-ITEM" -%token NEXT_GROUP "NEXT GROUP" -%token NEXT_PAGE "NEXT PAGE" -%token NO -%token NO_ADVANCING "NO ADVANCING" -%token NO_AUTOSEL "NO-AUTOSEL" -%token NO_AUTO_DEFAULT "NO-AUTO-DEFAULT" -%token NO_BOX "NO-BOX" -%token NO_DATA "NO DATA" -%token NO_DIVIDERS "NO-DIVIDERS" -%token NO_ECHO "NO-ECHO" -%token NO_F4 "NO-F4" -%token NO_FOCUS "NO-FOCUS" -%token NO_GROUP_TAB "NO-GROUP-TAB" -%token NO_KEY_LETTER "NO-KEY-LETTER" -%token NOMINAL -%token NO_SEARCH "NO-SEARCH" -%token NO_UPDOWN "NO-UPDOWN" -%token NONNUMERIC -%token NORMAL -%token NOT -%token NOTAB -%token NOTHING -%token NOTIFY -%token NOTIFY_CHANGE "NOTIFY-CHANGE" -%token NOTIFY_DBLCLICK "NOTIFY-DBLCLICK" -%token NOTIFY_SELCHANGE "NOTIFY-SELCHANGE" -%token NOT_END "NOT END" -%token NOT_EOP "NOT EOP" -%token NOT_ESCAPE "NOT ESCAPE" -%token NOT_EQUAL "NOT EQUAL" -%token NOT_EXCEPTION "NOT EXCEPTION" -%token NOT_INVALID_KEY "NOT INVALID KEY" -%token NOT_OVERFLOW "NOT OVERFLOW" -%token NOT_SIZE_ERROR "NOT SIZE ERROR" -%token NUM_COL_HEADINGS "NUM-COL-HEADINGS" -%token NUM_ROWS "NUM-ROWS" -%token NUMBER -%token NUMBERS -%token NUMERIC -%token NUMERIC_EDITED "NUMERIC-EDITED" -%token NUMVALC_FUNC "FUNCTION NUMVAL-C" -%token OBJECT -%token OBJECT_COMPUTER "OBJECT-COMPUTER" -%token OCCURS -%token OF -%token OFF -%token OK_BUTTON "OK-BUTTON" -%token OMITTED -%token ON -%token ONLY -%token OPEN -%token OPTIONAL -%token OPTIONS -%token OR -%token ORDER -%token ORGANIZATION -%token OTHER -%token OTHERS -%token OUTPUT -%token OVERLAP_LEFT "OVERLAP-LEFT" -%token OVERLAP_TOP "OVERLAP-TOP" -%token OVERLINE -%token PACKED_DECIMAL "PACKED-DECIMAL" -%token PADDING -%token PASCAL -%token PAGE -%token PAGE_COUNTER "PAGE-COUNTER" -%token PAGE_SETUP "PAGE-SETUP" -%token PAGED -%token PARAGRAPH -%token PARENT -%token PARSE -%token PASSWORD -%token PERFORM -%token PERMANENT -%token PH -%token PF -%token PHYSICAL -%token PICTURE -%token PICTURE_SYMBOL "PICTURE SYMBOL" -%token PIXEL -%token PLACEMENT -%token PLUS -%token POINTER -%token POP_UP "POP-UP" -%token POS -%token POSITION -%token POSITION_SHIFT "POSITION-SHIFT" -%token POSITIVE -%token PRESENT -%token PREVIOUS -%token PRINT -%token PRINT_CONTROL "PRINT-CONTROL" -%token PRINT_NO_PROMPT "PRINT-NO-PROMPT" -%token PRINT_PREVIEW "PRINT-PREVIEW" -%token PRINTER -%token PRINTER_1 "PRINTER-1" -%token PRINTING -%token PRIORITY -%token PROCEDURE -%token PROCEDURES -%token PROCEED -%token PROCESSING -%token PROGRAM -%token PROGRAM_ID "PROGRAM-ID" -%token PROGRAM_NAME "program name" -%token PROGRAM_POINTER "PROGRAM-POINTER" -%token PROGRESS -%token PROHIBITED -%token PROMPT -%token PROPERTIES -%token PROPERTY -%token PROTECTED -%token PROTOTYPE -%token PURGE -%token PUSH_BUTTON "PUSH-BUTTON" -%token QUERY_INDEX "QUERY-INDEX" -%token QUEUE -%token QUOTE -%token RADIO_BUTTON "RADIO-BUTTON" -%token RAISE -%token RAISED -%token RANDOM -%token RD -%token READ -%token READERS -%token READ_ONLY "READ-ONLY" -%token READY_TRACE "READY TRACE" -%token RECEIVE -%token RECORD -%token RECORD_DATA "RECORD-DATA" -%token RECORD_OVERFLOW "RECORD-OVERFLOW" -%token RECORD_TO_ADD "RECORD-TO-ADD" -%token RECORD_TO_DELETE "RECORD-TO-DELETE" -%token RECORDING -%token RECORDS -%token RECURSIVE -%token REDEFINES -%token REEL -%token REFERENCE -%token REFERENCES -%token REFRESH -%token REGION_COLOR "REGION-COLOR" -%token RELATIVE -%token RELEASE -%token REMAINDER -%token REMOVAL -%token RENAMES -%token REORG_CRITERIA "REORG-CRITERIA" -%token REPLACE -%token REPLACING -%token REPORT -%token REPORTING -%token REPORTS -%token REPOSITORY -%token REQUIRED -%token REREAD -%token RERUN -%token RESERVE -%token RESET -%token RESET_TRACE "RESET TRACE" -%token RESET_GRID "RESET-GRID" -%token RESET_LIST "RESET-LIST" -%token RESET_TABS "RESET-TABS" -%token RESIDENT -%token RETRY -%token RETURN -%token RETURNING -%token REVERSE -%token REVERSE_FUNC "FUNCTION REVERSE" -%token REVERSE_VIDEO "REVERSE-VIDEO" -%token REVERSED -%token REWIND -%token REWRITE -%token RF -%token RH -%token RIGHT -%token RIGHT_ALIGN "RIGHT-ALIGN" -%token RIMMED -%token ROLLBACK -%token ROUNDED -%token ROUNDING -%token ROW_COLOR "ROW-COLOR" -%token ROW_COLOR_PATTERN "ROW-COLOR-PATTERN" -%token ROW_DIVIDERS "ROW-DIVIDERS" -%token ROW_FONT "ROW-FONT" -%token ROW_HEADINGS "ROW-HEADINGS" -%token ROW_PROTECTION "ROW-PROTECTION" -%token RUN -%token S -%token SAME -%token SAVE_AS "SAVE-AS" -%token SAVE_AS_NO_PROMPT "SAVE-AS-NO-PROMPT" -%token SCREEN -%token SCREEN_CONTROL "SCREEN CONTROL" -%token SCROLL -%token SCROLL_BAR "SCROLL-BAR" -%token SD -%token SEARCH -%token SEARCH_OPTIONS "SEARCH-OPTIONS" -%token SEARCH_TEXT "SEARCH-TEXT" -%token SECONDS -%token SECTION -%token SECURE -%token SEGMENT -%token SEGMENT_LIMIT "SEGMENT-LIMIT" -%token SELECT -%token SELECTION_INDEX "SELECTION-INDEX" -%token SELECTION_TEXT "SELECTION-TEXT" -%token SELECT_ALL "SELECTION-ALL" -%token SELF_ACT "SELF-ACT" -%token SEMI_COLON "semi-colon" -%token SEND -%token SENTENCE -%token SEPARATE -%token SEPARATION -%token SEQUENCE -%token SEQUENTIAL -%token SET -%token SEVENTY_EIGHT "level-number 78" -%token SHADING -%token SHADOW -%token SHARING -%token SHORT_DATE "SHORT-DATE" -%token SHOW_LINES "SHOW-LINES" -%token SHOW_NONE "SHOW-NONE" -%token SHOW_SEL_ALWAYS "SHOW-SEL-ALWAYS" -%token SIGN -%token SIGNED -%token SIGNED_INT "SIGNED-INT" -%token SIGNED_LONG "SIGNED-LONG" -%token SIGNED_SHORT "SIGNED-SHORT" -%token SIXTY_SIX "level-number 66" -%token SIZE -%token SIZE_ERROR "SIZE ERROR" -%token SMALL_FONT "SMALL-FONT" -%token SORT -%token SORT_MERGE "SORT-MERGE" -%token SORT_ORDER "SORT-ORDER" -%token SOURCE -%token SOURCE_COMPUTER "SOURCE-COMPUTER" -%token SPACE -%token SPECIAL_NAMES "SPECIAL-NAMES" -%token SPINNER -%token SQUARE -%token STANDARD -%token STANDARD_1 "STANDARD-1" -%token STANDARD_2 "STANDARD-2" -%token STANDARD_BINARY "STANDARD-BINARY" -%token STANDARD_DECIMAL "STANDARD-DECIMAL" -%token START -%token START_X "START-X" -%token START_Y "START-Y" -%token STATIC -%token STATIC_LIST "STATIC-LIST" -%token STATUS -%token STATUS_BAR "STATUS-BAR" -%token STATUS_TEXT "STATUS-TEXT" -%token STDCALL -%token STEP -%token STOP -%token STRING -%token STYLE -%token SUB_QUEUE_1 "SUB-QUEUE-1" -%token SUB_QUEUE_2 "SUB-QUEUE-2" -%token SUB_QUEUE_3 "SUB-QUEUE-3" -%token SUBSTITUTE_FUNC "FUNCTION SUBSTITUTE" -%token SUBSTITUTE_CASE_FUNC "FUNCTION SUBSTITUTE-CASE" -%token SUBTRACT -%token SUBWINDOW -%token SUM -%token SUPPRESS -%token SUPPRESS_XML "SUPPRESS" -%token SYMBOLIC -%token SYNCHRONIZED -%token SYSTEM_DEFAULT "SYSTEM-DEFAULT" -%token SYSTEM_INFO "SYSTEM-INFO" -%token SYSTEM_OFFSET "SYSTEM-OFFSET" -%token TAB -%token TAB_TO_ADD "TAB-TO-ADD" -%token TAB_TO_DELETE "TAB-TO-DELETE" -%token TABLE -%token TALLYING -%token TEMPORARY -%token TAPE -%token TERMINAL -%token TERMINATE -%token TERMINAL_INFO "TERMINAL-INFO" -%token TERMINATION_VALUE "TERMINATION-VALUE" -%token TEST -%token TEXT -%token THAN -%token THEN -%token THREAD -%token THREADS -%token THRU -%token THUMB_POSITION "THUMB-POSITION" -%token TILED_HEADINGS "TILED-HEADINGS" -%token TIME -%token TIME_OUT "TIME-OUT" -%token TIMES -%token TITLE -%token TITLE_POSITION "TITLE-POSITION" -%token TO -%token TOK_AMPER "&" -%token TOK_CLOSE_PAREN ")" -%token TOK_COLON ":" -%token TOK_DIV "/" -%token TOK_DOT "." -%token TOK_EQUAL "=" -%token TOK_EXTERN "EXTERN" -%token TOK_FALSE "FALSE" -%token TOK_FILE "FILE" -%token TOK_GREATER ">" -%token TOK_INITIAL "INITIAL" -%token TOK_LESS "<" -%token TOK_MINUS "-" -%token TOK_MUL "*" -%token TOK_NULL "NULL" -%token TOK_OVERFLOW "OVERFLOW" -%token TOK_OPEN_PAREN "(" -%token TOK_PLUS "+" -%token TOK_TRUE "TRUE" -%token TOP -%token TOWARD_GREATER "TOWARD-GREATER" -%token TOWARD_LESSER "TOWARD-LESSER" -%token TRACK -%token TRACKS -%token TRACK_AREA "TRACK-AREA" -%token TRACK_LIMIT "TRACK-LIMIT" -%token TRADITIONAL_FONT "TRADITIONAL-FONT" -%token TRAILING -%token TRAILING_SHIFT "TRAILING-SHIFT" -%token TRANSACTION -%token TRANSFORM -%token TRANSPARENT -%token TREE_VIEW "TREE-VIEW" -%token TRIM_FUNC "FUNCTION TRIM" -%token TRUNCATION -%token TYPE -%token U -%token UCS_4 "UCS-4" -%token UNBOUNDED -%token UNDERLINE -%token UNFRAMED -%token UNIT -%token UNLOCK -%token UNSIGNED -%token UNSIGNED_INT "UNSIGNED-INT" -%token UNSIGNED_LONG "UNSIGNED-LONG" -%token UNSIGNED_SHORT "UNSIGNED-SHORT" -%token UNSORTED -%token UNSTRING -%token UNTIL -%token UP -%token UPDATE -%token UPDATERS -%token UPON -%token UPON_ARGUMENT_NUMBER "UPON ARGUMENT-NUMBER" -%token UPON_COMMAND_LINE "UPON COMMAND-LINE" -%token UPON_ENVIRONMENT_NAME "UPON ENVIRONMENT-NAME" -%token UPON_ENVIRONMENT_VALUE "UPON ENVIRONMENT-VALUE" -%token UPPER -%token UPPER_CASE_FUNC "FUNCTION UPPER-CASE" -%token USAGE -%token USE -%token USE_ALT "USE-ALT" -%token USE_RETURN "USE-RETURN" -%token USE_TAB "USE-TAB" -%token USER -%token USER_DEFAULT "USER-DEFAULT" -%token USER_FUNCTION_NAME "user function name" -%token USING -%token UTF_8 "UTF-8" -%token UTF_16 "UTF-16" -%token V -%token VALIDATE -%token VALIDATING -%token VALUE -%token VALUE_FORMAT "VALUE-FORMAT" -%token VARIABLE -%token VARIANT -%token VARYING -%token VERTICAL -%token VERY_HEAVY "VERY-HEAVY" -%token VIRTUAL_WIDTH "VIRTUAL-WIDTH" -%token VISIBLE -%token VOLATILE -%token VPADDING -%token VSCROLL -%token VSCROLL_BAR "VSCROLL-BAR" -%token VSCROLL_POS "VSCROLL-POS" -%token VTOP -%token WAIT -%token WEB_BROWSER "WEB-BROWSER" -%token WHEN -%token WHEN_COMPILED_FUNC "FUNCTION WHEN-COMPILED" -%token WHEN_XML "WHEN" -%token WIDTH -%token WIDTH_IN_CELLS "WIDTH-IN-CELLS" -%token WINDOW -%token WITH -%token WORD "Identifier" -%token WORDS -%token WORKING_STORAGE "WORKING-STORAGE" -%token WRAP -%token WRITE -%token WRITE_ONLY "WRITE-ONLY" -%token WRITE_VERIFY "WRITE-VERIFY" -%token WRITERS -%token X -%token XML -%token XML_DECLARATION "XML-DECLARATION" -%token Y -%token YYYYDDD -%token YYYYMMDD -%token ZERO - -/* Set up precedence operators to force shift */ - -%nonassoc SHIFT_PREFER - -%nonassoc ELSE - -%nonassoc ACCEPT -%nonassoc ADD -%nonassoc ALLOCATE -%nonassoc ALTER -%nonassoc CALL -%nonassoc CANCEL -%nonassoc CLOSE -%nonassoc COMMIT -%nonassoc COMPUTE -%nonassoc CONTINUE -%nonassoc DELETE -%nonassoc DESTROY -%nonassoc DISABLE -%nonassoc DISPLAY -%nonassoc DIVIDE -%nonassoc ENABLE -%nonassoc ENTRY -%nonassoc EVALUATE -%nonassoc EXIT -%nonassoc FREE -%nonassoc GENERATE -%nonassoc GO -%nonassoc GOBACK -%nonassoc IF -%nonassoc INITIALIZE -%nonassoc INITIATE -%nonassoc INQUIRE -%nonassoc INSPECT -%nonassoc JSON -%nonassoc MERGE -%nonassoc MODIFY -%nonassoc MOVE -%nonassoc MULTIPLY -%nonassoc NEXT -%nonassoc OPEN -%nonassoc PERFORM -%nonassoc PURGE -%nonassoc RAISE -%nonassoc READ -%nonassoc READY_TRACE -%nonassoc RECEIVE -%nonassoc RELEASE -%nonassoc RESET_TRACE -%nonassoc RETURN -%nonassoc REWRITE -%nonassoc ROLLBACK -%nonassoc SEARCH -%nonassoc SEND -%nonassoc SET -%nonassoc SORT -%nonassoc START -%nonassoc STOP -%nonassoc STRING -%nonassoc SUBTRACT -%nonassoc SUPPRESS -%nonassoc TERMINATE -%nonassoc TRANSFORM -%nonassoc UNLOCK -%nonassoc UNSTRING -%nonassoc VALIDATE -%nonassoc WRITE -%nonassoc XML - -%nonassoc NOT_END END -%nonassoc NOT_EOP EOP -%nonassoc NOT_INVALID_KEY INVALID_KEY -%nonassoc NOT_OVERFLOW TOK_OVERFLOW -%nonassoc NOT_SIZE_ERROR SIZE_ERROR -%nonassoc NOT_EXCEPTION EXCEPTION NOT_ESCAPE ESCAPE -%nonassoc NO_DATA DATA - -%nonassoc END_ACCEPT -%nonassoc END_ADD -%nonassoc END_CALL -%nonassoc END_COMPUTE -%nonassoc END_DELETE -%nonassoc END_DISPLAY -%nonassoc END_DIVIDE -%nonassoc END_EVALUATE -%nonassoc END_FUNCTION -%nonassoc END_IF -%nonassoc END_JSON -%nonassoc END_MODIFY -%nonassoc END_MULTIPLY -%nonassoc END_PERFORM -%nonassoc END_PROGRAM -%nonassoc END_READ -%nonassoc END_RECEIVE -%nonassoc END_RETURN -%nonassoc END_REWRITE -%nonassoc END_SEARCH -%nonassoc END_START -%nonassoc END_STRING -%nonassoc END_SUBTRACT -%nonassoc END_UNSTRING -%nonassoc END_WRITE -%nonassoc END_XML - -%nonassoc PROGRAM_ID -%nonassoc WHEN -%nonassoc IN - -%nonassoc WORD -%nonassoc LITERAL - -%nonassoc TOK_OPEN_PAREN -%nonassoc TOK_PLUS -%nonassoc TOK_MINUS -%nonassoc TOK_DOT - -%nonassoc error - -%% - -/* COBOL Compilation Unit */ - -start: - { - clear_initial_values (); - current_program = NULL; - defined_prog_list = NULL; - cobc_cs_check = 0; - main_flag_set = 0; - current_program = cb_build_program (NULL, 0); - cb_set_intr_when_compiled (); - cb_build_registers (); - cb_add_external_defined_registers (); - } - compilation_group - { - if (!current_program->flag_validated) { - current_program->flag_validated = 1; - cb_validate_program_body (current_program); - } - if (depth > 1) { - cb_error (_("multiple PROGRAM-ID's without matching END PROGRAM")); - } - if (cobc_flag_main && !main_flag_set) { - cb_error (_("executable requested but no program found")); - } - if (errorcount > 0) { - YYABORT; - } - if (!current_program->entry_list) { - backup_current_pos (); - emit_entry (current_program->program_id, 0, NULL, NULL); - } - } -; - -compilation_group: - simple_prog /* extension: single program without PROCEDURE DIVISION */ -| nested_list -; - -nested_list: - { - first_prog = 1; - depth = 0; - setup_from_identification = 0; - } - source_element_list -; - -source_element_list: - source_element -| source_element_list source_element -; - -source_element: - program_definition -| function_definition -; - -simple_prog: - { - program_init_without_program_id (); - } - _program_body - /* do cleanup */ - { - backup_current_pos (); - clean_up_program (NULL, COB_MODULE_TYPE_PROGRAM); - } -; - -program_definition: - _identification_header - program_id_paragraph - _program_body - _end_program_list - /* - The _end_program_list above is used for allowing an end marker - in a program which contains a nested program. - */ -; - -function_definition: - _identification_header - function_id_paragraph - _program_body - end_function -; - -_end_program_list: - /* empty (still do cleanup) */ - { - backup_current_pos (); - clean_up_program (NULL, COB_MODULE_TYPE_PROGRAM); - } -| end_program_list -; - -end_program_list: - end_program -| end_program_list end_program -; - -end_program: - END_PROGRAM - { - backup_current_pos (); - } - end_program_name TOK_DOT - { - first_nested_program = 0; - clean_up_program ($3, COB_MODULE_TYPE_PROGRAM); - } -; - -end_function: - END_FUNCTION - { - backup_current_pos (); - } - end_program_name TOK_DOT - { - clean_up_program ($3, COB_MODULE_TYPE_FUNCTION); - } -; - -/* PROGRAM body */ - -_program_body: - _options_paragraph - _environment_division - { - cb_validate_program_environment (current_program); - } - _data_division - { - /* note: - we also validate all references we found so far here */ - cb_validate_program_data (current_program); - } - _procedure_division -; - -/* IDENTIFICATION DIVISION */ - -_identification_header: - %prec SHIFT_PREFER -| identification_header -; - -identification_header: - identification_or_id DIVISION TOK_DOT - { - setup_program_start (); - setup_from_identification = 1; - } -; - - -identification_or_id: - IDENTIFICATION | ID -; - -program_id_paragraph: - PROGRAM_ID - { - cobc_in_id = 1; - } - TOK_DOT program_id_name _as_literal - { - if (setup_program ($4, $5, COB_MODULE_TYPE_PROGRAM)) { - YYABORT; - } - - setup_prototype ($4, $5, COB_MODULE_TYPE_PROGRAM, 1); - } - _program_type TOK_DOT - { - cobc_cs_check = 0; - cobc_in_id = 0; - } -; - -function_id_paragraph: - FUNCTION_ID - { - cobc_in_id = 1; - } - TOK_DOT program_id_name _as_literal _is_prototype TOK_DOT - { - if (setup_program ($4, $5, COB_MODULE_TYPE_FUNCTION)) { - YYABORT; - } - setup_prototype ($4, $5, COB_MODULE_TYPE_FUNCTION, 1); - cobc_cs_check = 0; - cobc_in_id = 0; - } -; - -program_id_name: - PROGRAM_NAME - { - if (CB_REFERENCE_P ($1) && CB_WORD_COUNT ($1) > 0) { - redefinition_error ($1); - } - /* - The program name is a key part of defining the current_program, so we - mustn't lose it (unlike in undefined_word). - */ - $$ = $1; - } -| LITERAL - { - cb_trim_program_id ($1); - } -; - -end_program_name: - PROGRAM_NAME -| LITERAL - { - cb_trim_program_id ($1); - } -; - -_as_literal: - /* empty */ { $$ = NULL; } -| AS LITERAL { $$ = $2; } -; - -_program_type: - /* empty */ -| _is program_type_clause _program -| is_prototype -; - -program_type_clause: - COMMON - { - if (!current_program->nested_level) { - cb_error (_("COMMON may only be used in a contained program")); - } else { - current_program->flag_common = 1; - cb_add_common_prog (current_program); - } - } -| init_or_recurse_or_resident_and_common - { - if (!current_program->nested_level) { - cb_error (_("COMMON may only be used in a contained program")); - } else { - current_program->flag_common = 1; - cb_add_common_prog (current_program); - } - } -| init_or_recurse_or_resident -| EXTERNAL - { - CB_PENDING (_("CALL prototypes")); - } -; - -init_or_recurse_or_resident_and_common: - init_or_recurse_or_resident COMMON -| COMMON init_or_recurse_or_resident -; - -init_or_recurse_or_resident: - TOK_INITIAL - { - current_program->flag_initial = 1; - } -| RECURSIVE - { - current_program->flag_recursive = 1; - } -| RESIDENT - { - current_program->flag_resident = 1; - } -; - -_is_prototype: - /* empty */ -| is_prototype -; - -is_prototype: -_is PROTOTYPE - { - CB_PENDING (_("CALL prototypes")); - } -; - -_options_paragraph: - /* empty */ -| OPTIONS TOK_DOT - _options_clauses - { - cobc_cs_check = 0; - } -; - -_options_clauses: - _arithmetic_clause - _default_rounded_clause - _entry_convention_clause - _intermediate_rounding_clause - TOK_DOT -; - -_arithmetic_clause: - /* empty */ -| ARITHMETIC _is arithmetic_choice -; - -arithmetic_choice: - NATIVE - { -/* FIXME: the IBM-compatible ARITHMETIC should only be disabled - for the specified program (and its nested programs) - note: ibm-strict.conf has no OPTIONS paragraph, but ibm.conf does */ - cb_arithmetic_osvs = 0; - } -| STANDARD - { - CB_PENDING ("STANDARD ARITHMETIC"); - } -| STANDARD_BINARY - { - CB_PENDING ("STANDARD-BINARY ARITHMETIC"); - } -| STANDARD_DECIMAL - { - CB_PENDING ("STANDARD-DECIMAL ARITHMETIC"); - } -/* note: the IBM-compatible ARITHMETIC should likely get in here as an extension - but only for the specified program (and its nested programs) - decide for a good token name (with CB_CS_OPTIONS), once published it will be fixed -| OSVS - { - cb_arithmetic_osvs = 1; - } - */ -; - -_default_rounded_clause: - /* empty */ - { - default_rounded_mode = cb_int (COB_STORE_ROUND); - } -| DEFAULT ROUNDED _mode _is round_choice - { - if ($5) { - default_rounded_mode = $5; - } else { - default_rounded_mode = cb_int (COB_STORE_ROUND); - } - } -; - -_entry_convention_clause: - /* empty */ -| ENTRY_CONVENTION _is convention_type - { - current_program->entry_convention = $3; - } -; - -convention_type: - COBOL - { - $$ = cb_int (CB_CONV_COBOL); - } -| TOK_EXTERN - { - $$ = cb_int0; - } -| STDCALL - { - $$ = cb_int (CB_CONV_STDCALL); - } -; - -_intermediate_rounding_clause: - /* empty */ -| INTERMEDIATE ROUNDING _is intermediate_rounding_choice - { - CB_PENDING ("INTERMEDIATE ROUNDING"); - } -; - -intermediate_rounding_choice: - NEAREST_AWAY_FROM_ZERO - { - $$ = cb_int (COB_STORE_ROUND | COB_STORE_NEAR_AWAY_FROM_ZERO); - } -| NEAREST_EVEN - { - $$ = cb_int (COB_STORE_ROUND | COB_STORE_NEAR_EVEN); - } -| PROHIBITED - { - $$ = cb_int (COB_STORE_ROUND | COB_STORE_PROHIBITED); - } -| TRUNCATION - { - $$ = cb_int (COB_STORE_ROUND | COB_STORE_TRUNCATION); - } -; - -/* ENVIRONMENT DIVISION */ - -_environment_division: - _environment_header - _configuration_section - _input_output_section -; - -_environment_header: -| ENVIRONMENT DIVISION TOK_DOT - { - header_check |= COBC_HD_ENVIRONMENT_DIVISION; - } -; - -/* CONFIGURATION SECTION */ - -_configuration_section: - _configuration_header - _configuration_paragraphs -; - -_configuration_header: -| CONFIGURATION SECTION TOK_DOT - { - check_headers_present (COBC_HD_ENVIRONMENT_DIVISION, 0, 0, 0); - header_check |= COBC_HD_CONFIGURATION_SECTION; - if (current_program->nested_level) { - cb_error (_("%s not allowed in nested programs"), "CONFIGURATION SECTION"); - } - } -; - -_configuration_paragraphs: - /* empty */ -| configuration_paragraphs -; - -configuration_paragraphs: - configuration_paragraph -| configuration_paragraphs configuration_paragraph -; - -configuration_paragraph: - source_computer_paragraph -| object_computer_paragraph -| special_names_header -| special_names_sentence -| repository_paragraph -; - -/* SOURCE-COMPUTER paragraph */ - -source_computer_paragraph: - SOURCE_COMPUTER TOK_DOT - { - check_headers_present (COBC_HD_ENVIRONMENT_DIVISION, - COBC_HD_CONFIGURATION_SECTION, 0, 0); - check_conf_section_order (COBC_HD_SOURCE_COMPUTER); - set_conf_section_part (COBC_HD_SOURCE_COMPUTER); - } - _source_computer_entry -; - -_source_computer_entry: - %prec SHIFT_PREFER -| computer_words _with_debugging_mode TOK_DOT -; - -_with_debugging_mode: -| _with DEBUGGING MODE - { - current_program->flag_debugging = 1; - needs_debug_item = 1; - cobc_cs_check = 0; - cb_build_debug_item (); - } -; - -/* OBJECT-COMPUTER paragraph */ - -object_computer_paragraph: - OBJECT_COMPUTER TOK_DOT - { - check_headers_present (COBC_HD_ENVIRONMENT_DIVISION, - COBC_HD_CONFIGURATION_SECTION, 0, 0); - check_conf_section_order (COBC_HD_OBJECT_COMPUTER); - set_conf_section_part (COBC_HD_OBJECT_COMPUTER); - } - _object_computer_entry - { - cobc_cs_check = 0; - } -; - -_object_computer_entry: - %prec SHIFT_PREFER -| computer_words TOK_DOT -| computer_words object_clauses_list TOK_DOT -| object_clauses_list TOK_DOT -; - -object_clauses_list: - object_clauses -| object_clauses_list object_clauses -; - -object_clauses: - object_computer_memory -| object_computer_sequence -| object_computer_segment -| object_computer_class -; - -object_computer_memory: - MEMORY _size _is integer object_char_or_word_or_modules - { - cb_verify (cb_memory_size_clause, "MEMORY SIZE"); - } - /* Ignore */ -; - -object_computer_sequence: - _program program_collating_sequence - { - current_program->collating_sequence = alphanumeric_collation; - current_program->collating_sequence_n = national_collation; - } -; - -program_collating_sequence: - _collating SEQUENCE - { - alphanumeric_collation = national_collation = NULL; - } - program_coll_sequence_values -; - -program_coll_sequence_values: - _is single_reference - { - alphanumeric_collation = $2; - } -| _is single_reference single_reference - { - alphanumeric_collation = $2; - CB_PENDING_X ($3, "NATIONAL COLLATING SEQUENCE"); - national_collation = $3; - } -| _for ALPHANUMERIC _is single_reference - { - alphanumeric_collation = $4; - } -| _for NATIONAL _is single_reference - { - CB_PENDING_X ($4, "NATIONAL COLLATING SEQUENCE"); - national_collation = $4; - } -| _for ALPHANUMERIC _is single_reference - _for NATIONAL _is single_reference - { - alphanumeric_collation = $4; - CB_PENDING_X ($8, "NATIONAL COLLATING SEQUENCE"); - national_collation = $8; - } -| _for NATIONAL _is single_reference - _for ALPHANUMERIC _is single_reference - { - CB_PENDING_X ($4, "NATIONAL COLLATING SEQUENCE"); - national_collation = $4; - alphanumeric_collation = $8; - } -; - -object_computer_segment: - SEGMENT_LIMIT _is integer - { - int segnum; - - if (cb_verify (cb_section_segments, "SEGMENT LIMIT")) { - segnum = cb_get_int ($3); - if (segnum == 0 || segnum > 49) { - cb_error (_("segment-number must be in range of values 1 to 49")); - $$ = NULL; - } - } - /* Ignore */ - } -; - -object_computer_class: - _character CLASSIFICATION _is locale_class - { - if (current_program->classification) { - cb_error (_("duplicate CLASSIFICATION clause")); - } else { - current_program->classification = $4; - } - } -; - -locale_class: - single_reference - { - $$ = $1; - } -| LOCALE - { - $$ = NULL; - } -| USER_DEFAULT - { - $$ = cb_int1; - } -| SYSTEM_DEFAULT - { - $$ = cb_int1; - } -; - -computer_words: - WORD -| computer_words WORD -; - -/* REPOSITORY paragraph */ - -repository_paragraph: - REPOSITORY TOK_DOT - { - check_headers_present (COBC_HD_ENVIRONMENT_DIVISION, - COBC_HD_CONFIGURATION_SECTION, 0, 0); - check_conf_section_order (COBC_HD_REPOSITORY); - set_conf_section_part (COBC_HD_REPOSITORY); - } - _repository_entry - { - cobc_in_repository = 0; - } -; - -_repository_entry: - /* empty */ -| repository_list TOK_DOT -| repository_list error TOK_DOT - { - yyerrok; - } -; - -repository_list: - repository_name -| repository_list repository_name -; - -repository_name: - FUNCTION ALL INTRINSIC - { - functions_are_all = 1; - } -| FUNCTION WORD _as_literal - { - if ($2 != cb_error_node) { - setup_prototype ($2, $3, COB_MODULE_TYPE_FUNCTION, 0); - } - } -| FUNCTION repository_name_list INTRINSIC -| PROGRAM WORD _as_literal - { - if ($2 != cb_error_node - && cb_verify (cb_program_prototypes, _("PROGRAM phrase"))) { - setup_prototype ($2, $3, COB_MODULE_TYPE_PROGRAM, 0); - } - } -| FUNCTION repository_name_list error - { - yyerrok; - } -; - -repository_name_list: - FUNCTION_NAME - { - current_program->function_spec_list = - cb_list_add (current_program->function_spec_list, $1); - } -| repository_name_list FUNCTION_NAME - { - current_program->function_spec_list = - cb_list_add (current_program->function_spec_list, $2); - } -; - - -/* SPECIAL-NAMES paragraph */ - -special_names_header: - SPECIAL_NAMES TOK_DOT - { - check_duplicate = 0; - check_headers_present (COBC_HD_ENVIRONMENT_DIVISION, - COBC_HD_CONFIGURATION_SECTION, 0, 0); - check_conf_section_order (COBC_HD_SPECIAL_NAMES); - set_conf_section_part (COBC_HD_SPECIAL_NAMES); - if (current_program->nested_level) { - cb_error (_("%s not allowed in nested programs"), "SPECIAL-NAMES"); - } - } -; - -special_names_sentence: - special_name_list TOK_DOT - -special_name_list: - special_name -| special_name_list special_name -| /* FIXME: the error recovery is broken here, error token - should be moved to "special_name" instead */ - special_name_list error -; - -special_name: - mnemonic_name_clause -| alphabet_name_clause -| symbolic_characters_clause -| symbolic_constant_clause -| locale_clause -| class_name_clause -| currency_sign_clause -| decimal_point_clause -| numeric_sign_clause -| cursor_clause -| crt_status_clause -| screen_control -| event_status -| top_clause -; - - -/* Mnemonic name clause */ - -mnemonic_name_clause: - WORD - { - check_headers_present (COBC_HD_ENVIRONMENT_DIVISION, - COBC_HD_CONFIGURATION_SECTION, - COBC_HD_SPECIAL_NAMES, 0); - check_duplicate = 0; - if (current_program->nested_level) { - cb_error (_("%s not allowed in nested programs"), "SPECIAL-NAMES"); - save_tree = NULL; - } else { - /* lookup system name with special translation - note: result in NULL + raised error if not found */ - save_tree = get_system_name_translated ($1); - } - } - mnemonic_choices -; - -mnemonic_choices: - _is CRT - { - if (save_tree) { - if (CB_SYSTEM_NAME(save_tree)->token != CB_DEVICE_CONSOLE) { - cb_error_x (save_tree, _("invalid %s clause"), ""); - } else { - current_program->flag_console_is_crt = 1; - } - } - } -/* CALL-CONVENTION n is ... */ -| integer _is undefined_word - { - if (save_tree) { - if (CB_SYSTEM_NAME(save_tree)->token != CB_FEATURE_CONVENTION) { - cb_error_x (save_tree, _("invalid %s clause"), "SPECIAL NAMES"); - } else if (CB_VALID_TREE ($3)) { - CB_SYSTEM_NAME(save_tree)->value = $1; - cb_define ($3, save_tree); - CB_CHAIN_PAIR (current_program->mnemonic_spec_list, - $3, save_tree); - /* remove non-standard context-sensitive words when identical to mnemonic */ - if (strcasecmp (CB_NAME($3), "EXTERN" ) == 0 || - strcasecmp (CB_NAME($3), "STDCALL") == 0 || - strcasecmp (CB_NAME($3), "STATIC" ) == 0 || - strcasecmp (CB_NAME($3), "C" ) == 0 || - strcasecmp (CB_NAME($3), "PASCAL" ) == 0) { - remove_context_sensitivity (CB_NAME($3), CB_CS_CALL); - } - } - } - } -| _is undefined_word _special_name_mnemonic_on_off - { - if (save_tree && CB_VALID_TREE ($2)) { - cb_define ($2, save_tree); - CB_CHAIN_PAIR (current_program->mnemonic_spec_list, - $2, save_tree); - } - } -| on_off_clauses -; - -_special_name_mnemonic_on_off: -| on_off_clauses -; - -on_off_clauses: - on_off_clauses_1 - { - check_on_off_duplicate = 0; - } -; - -on_off_clauses_1: - on_or_off _onoff_status undefined_word - { - cb_tree x; - - /* cb_define_switch_name checks param validity */ - x = cb_define_switch_name ($3, save_tree, $1 == cb_int1); - if (x) { - if ($1 == cb_int1) { - check_repeated ("ON", SYN_CLAUSE_1, &check_on_off_duplicate); - } else { - check_repeated ("OFF", SYN_CLAUSE_2, &check_on_off_duplicate); - } - CB_CHAIN_PAIR (current_program->mnemonic_spec_list, $3, x); - } - } -| on_off_clauses_1 on_or_off _onoff_status undefined_word - { - cb_tree x; - - /* cb_define_switch_name checks param validity */ - x = cb_define_switch_name ($4, save_tree, $2 == cb_int1); - if (x) { - if ($2 == cb_int1) { - check_repeated ("ON", SYN_CLAUSE_1, &check_on_off_duplicate); - } else { - check_repeated ("OFF", SYN_CLAUSE_2, &check_on_off_duplicate); - } - CB_CHAIN_PAIR (current_program->mnemonic_spec_list, $4, x); - } - } -; - -/* ALPHABET clause */ - -alphabet_name_clause: - ALPHABET undefined_word - { - check_headers_present (COBC_HD_ENVIRONMENT_DIVISION, - COBC_HD_CONFIGURATION_SECTION, - COBC_HD_SPECIAL_NAMES, 0); - if (current_program->nested_level) { - cb_error (_("%s not allowed in nested programs"), "SPECIAL-NAMES"); - $$ = NULL; - } else { - /* Returns null on error */ - $$ = cb_build_alphabet_name ($2); - } - } - alphabet_definition - { - if ($3) { - current_program->alphabet_name_list = - cb_list_add (current_program->alphabet_name_list, $3); - } - cobc_cs_check = 0; - } -; - -alphabet_definition: - alphabet_target_alphanumeric - { - $$ = $0; - if ($0) { - CB_ALPHABET_NAME ($0)->alphabet_target = CB_ALPHABET_ALPHANUMERIC; - } - } - _is alphabet_type_alphanumeric -| alphabet_target_national - { - $$ = $0; - if ($0) { - CB_ALPHABET_NAME($0)->alphabet_target = CB_ALPHABET_NATIONAL; - } - } - _is alphabet_type_national -; - -alphabet_target_alphanumeric: - /* empty */ -| _for ALPHANUMERIC -; - -alphabet_target_national: - _for NATIONAL -; - -alphabet_type_alphanumeric: - alphabet_type_common -| STANDARD_1 - { - if ($-1) { - CB_ALPHABET_NAME ($-1)->alphabet_type = CB_ALPHABET_ASCII; - } - } -| STANDARD_2 - { - if ($-1) { - CB_ALPHABET_NAME ($-1)->alphabet_type = CB_ALPHABET_ASCII; - } - } -| EBCDIC /* concerning the standard: a code-name */ - { - if ($-1) { - CB_ALPHABET_NAME ($-1)->alphabet_type = CB_ALPHABET_EBCDIC; - } - } -| ASCII /* concerning the standard: a code-name */ - { - if ($-1) { - CB_ALPHABET_NAME ($-1)->alphabet_type = CB_ALPHABET_ASCII; - } - } -; - -alphabet_type_national: - alphabet_type_common -| UCS_4 - { - if ($-1) { - CB_PENDING_X ($-1, "ALPHABET UCS-4"); - CB_ALPHABET_NAME ($-1)->alphabet_type = CB_ALPHABET_UCS_4; - } - } -| UTF_8 - { - if ($-1) { - CB_PENDING_X ($-1, "ALPHABET UTF-8"); - CB_ALPHABET_NAME ($-1)->alphabet_type = CB_ALPHABET_UTF_8; - } - } -| UTF_16 - { - if ($-1) { - CB_PENDING_X ($-1, "ALPHABET UTF-16"); - CB_ALPHABET_NAME ($-1)->alphabet_type = CB_ALPHABET_UTF_16; - } - } -; - -alphabet_type_common: - NATIVE - { - if ($-1) { - CB_ALPHABET_NAME ($-1)->alphabet_type = CB_ALPHABET_NATIVE; - } - } -| LOCALE single_reference - { - if ($-1) { - CB_ALPHABET_NAME ($-1)->alphabet_type = CB_ALPHABET_LOCALE; - CB_ALPHABET_NAME ($-1)->custom_list = $2; - CB_PENDING_X ($-1, "LOCALE ALPHABET"); - } - } -| alphabet_literal_list - { - if ($-1) { - CB_ALPHABET_NAME ($-1)->alphabet_type = CB_ALPHABET_CUSTOM; - CB_ALPHABET_NAME ($-1)->custom_list = $1; - } - } -; - -alphabet_literal_list: - alphabet_literal - { - $$ = CB_LIST_INIT ($1); - } -| alphabet_literal_list alphabet_literal - { - $$ = cb_list_add ($1, $2); - } -; - -alphabet_literal: - alphabet_lits - { - $$ = $1; - } -| alphabet_lits THRU alphabet_lits - { - $$ = CB_BUILD_PAIR ($1, $3); - } -| alphabet_lits ALSO - { - $$ = CB_LIST_INIT ($1); - } - alphabet_also_sequence - { - $$ = $3; - } -; - -alphabet_also_sequence: - alphabet_lits - { - cb_list_add ($0, $1); - } -| alphabet_also_sequence ALSO alphabet_lits - { - cb_list_add ($0, $3); - } -; - -alphabet_lits: - LITERAL { $$ = $1; } -| SPACE { $$ = cb_space; } -| ZERO { $$ = cb_zero; } -| QUOTE { $$ = cb_quote; } -| HIGH_VALUE { $$ = cb_norm_high; } -| LOW_VALUE { $$ = cb_norm_low; } -; - -space_or_zero: - SPACE { $$ = cb_space; } -| ZERO { $$ = cb_zero; } -; - - -/* SYMBOLIC characters clause */ - -symbolic_characters_clause: - symbolic_collection _sym_in_word - { - check_headers_present (COBC_HD_ENVIRONMENT_DIVISION, - COBC_HD_CONFIGURATION_SECTION, - COBC_HD_SPECIAL_NAMES, 0); - if (current_program->nested_level) { - cb_error (_("%s not allowed in nested programs"), "SPECIAL-NAMES"); - } else if ($1) { - CB_CHAIN_PAIR (current_program->symbolic_char_list, $1, $2); - } - } -; - -_sym_in_word: - /* empty */ - { - $$ = NULL; - } -| IN WORD - { - $$ = $2; - } -; - -symbolic_collection: - %prec SHIFT_PREFER - SYMBOLIC _characters symbolic_chars_list - { - $$ = $3; - } -; - -symbolic_chars_list: - symbolic_chars_phrase - { - $$ = $1; - } -| symbolic_chars_list symbolic_chars_phrase - { - if ($2) { - $$ = cb_list_append ($1, $2); - } else { - $$ = $1; - } - } -; - -symbolic_chars_phrase: - char_list _is_are integer_list - { - cb_tree l1; - cb_tree l2; - - if (cb_list_length ($1) != cb_list_length ($3)) { - cb_error (_("invalid %s clause"), "SYMBOLIC"); - $$ = NULL; - } else { - l1 = $1; - l2 = $3; - for (; l1; l1 = CB_CHAIN (l1), l2 = CB_CHAIN (l2)) { - CB_PURPOSE (l1) = CB_VALUE (l2); - } - $$ = $1; - } - } -; - -char_list: - unique_word - { - if ($1 == NULL) { - $$ = NULL; - } else { - $$ = CB_LIST_INIT ($1); - } - } -| char_list unique_word - { - if ($2 == NULL) { - $$ = $1; - } else { - $$ = cb_list_add ($1, $2); - } - } -; - -integer_list: - symbolic_integer { $$ = CB_LIST_INIT ($1); } -| integer_list symbolic_integer { $$ = cb_list_add ($1, $2); } -; - - -/* SYMBOLIC constant clause */ - -symbolic_constant_clause: - %prec SHIFT_PREFER - SYMBOLIC CONSTANT symbolic_constant_list - { - check_headers_present (COBC_HD_ENVIRONMENT_DIVISION, - COBC_HD_CONFIGURATION_SECTION, - COBC_HD_SPECIAL_NAMES, 0); - if (current_program->nested_level) { - cb_error (_("%s not allowed in nested programs"), "SPECIAL-NAMES"); - } - (void)cb_verify (cb_symbolic_constant, "SYMBOLIC CONSTANT"); - } -; - -symbolic_constant_list: - symbolic_constant -| symbolic_constant_list symbolic_constant -; - -symbolic_constant: - user_entry_name _is literal - { - struct cb_field *f; - cb_tree v; - - v = CB_LIST_INIT ($3); - f = CB_FIELD (cb_build_constant ($1, v)); - f->flag_item_78 = 1; - f->flag_constant = 1; - f->flag_is_global = 1; - f->level = 1; - f->values = v; - cb_needs_01 = 1; - /* Ignore return value */ - (void)cb_validate_78_item (f, 0); - } -; - -/* CLASS clause */ - -class_name_clause: - CLASS undefined_word _class_type _is class_item_list _in_alphabet - { - cb_tree x; - - check_headers_present (COBC_HD_ENVIRONMENT_DIVISION, - COBC_HD_CONFIGURATION_SECTION, - COBC_HD_SPECIAL_NAMES, 0); - if (current_program->nested_level) { - cb_error (_("%s not allowed in nested programs"), "SPECIAL-NAMES"); - } else { - /* Returns null on error */ - x = cb_build_class_name ($2, $5); - if (x) { - current_program->class_name_list = - cb_list_add (current_program->class_name_list, x); - } - } - } -; - -class_item_list: - class_item { $$ = CB_LIST_INIT ($1); } -| class_item_list class_item { $$ = cb_list_add ($1, $2); } -; - -class_item: - class_value - { - $$ = $1; - } -| class_value THRU class_value - { - if (CB_TREE_CLASS ($1) != CB_CLASS_NUMERIC && - CB_LITERAL_P ($1) && CB_LITERAL ($1)->size != 1) { - cb_error (_("CLASS literal with THRU must have size 1")); - } - if (CB_TREE_CLASS ($3) != CB_CLASS_NUMERIC && - CB_LITERAL_P ($3) && CB_LITERAL ($3)->size != 1) { - cb_error (_("CLASS literal with THRU must have size 1")); - } - if (literal_value ($1) <= literal_value ($3)) { - $$ = CB_BUILD_PAIR ($1, $3); - } else { - $$ = CB_BUILD_PAIR ($3, $1); - } - } -; - -_class_type: - /* empty */ -| _for ALPHANUMERIC - { - $$ = NULL; - } -| _for NATIONAL - { - CB_PENDING_X ($2, "NATIONAL CLASS"); - $$ = cb_int0; - } -; - -_in_alphabet: - /* empty */ -| IN alphabet_name - { - CB_PENDING_X ($2, _("CLASS IS integer IN alphabet-name")); - $$ = $2; - } -; - -/* LOCALE clause */ - -locale_clause: - LOCALE undefined_word _is LITERAL - { - check_headers_present (COBC_HD_ENVIRONMENT_DIVISION, - COBC_HD_CONFIGURATION_SECTION, - COBC_HD_SPECIAL_NAMES, 0); - if (current_program->nested_level) { - cb_error (_("%s not allowed in nested programs"), "SPECIAL-NAMES"); - } else { - /* Returns null on error */ - cb_tree l = cb_build_locale_name ($2, $4); - if (l) { - current_program->locale_list = - cb_list_add (current_program->locale_list, l); - } - } - } -; - -/* CURRENCY SIGN clause */ - -currency_sign_clause: - CURRENCY _sign _is LITERAL _with_pic_symbol - { - check_headers_present (COBC_HD_ENVIRONMENT_DIVISION, - COBC_HD_CONFIGURATION_SECTION, - COBC_HD_SPECIAL_NAMES, 0); - if (current_program->nested_level) { - cb_error (_("%s not allowed in nested programs"), "SPECIAL-NAMES"); - } else { - unsigned int error_ind = 0; - - /* FIXME: actual allowed (depending on dialect), see FR #246 */ - check_repeated ("CURRENCY", SYN_CLAUSE_1, &check_duplicate); - - /* checks of CURRENCY SIGN (being currency string) when separate */ - if ($5) { - unsigned int char_seen = 0; - unsigned char *s = CB_LITERAL ($4)->data; - - CB_PENDING_X ($4, _("separate currency symbol and currency string")); - while (*s) { - switch (*s) { - case '0': - case '1': - case '2': - case '3': - case '4': - case '5': - case '6': - case '7': - case '8': - case '9': - case '+': - case '-': - case ',': - case '.': - case '*': - error_ind = 1; - break; - case ' ': - break; - default: - char_seen = 1; - break; - } - s++; - } - if (!char_seen) { - error_ind = 1; - } - } - if (error_ind) { - cb_error_x ($4, _("invalid CURRENCY SIGN '%s'"), (char*)CB_LITERAL ($4)->data); - } - if ($5) { - set_currency_picture_symbol ($5); - } else { - if (!error_ind) { - set_currency_picture_symbol ($4); - } - } - } - } -; - - -_with_pic_symbol: - /* empty */ - { - $$ = NULL; - } -| _with PICTURE_SYMBOL LITERAL - { - $$ = $3; - } -; - -/* DECIMAL-POINT clause */ - -decimal_point_clause: - DECIMAL_POINT _is COMMA - { - check_headers_present (COBC_HD_ENVIRONMENT_DIVISION, - COBC_HD_CONFIGURATION_SECTION, - COBC_HD_SPECIAL_NAMES, 0); - if (current_program->nested_level) { - cb_error (_("%s not allowed in nested programs"), "SPECIAL-NAMES"); - } else { - check_repeated ("DECIMAL-POINT", SYN_CLAUSE_2, &check_duplicate); - current_program->decimal_point = ','; - current_program->numeric_separator = '.'; - } - } -; - - -/* NUMERIC SIGN clause */ - -numeric_sign_clause: - NUMERIC SIGN _is TRAILING SEPARATE - { - check_headers_present (COBC_HD_ENVIRONMENT_DIVISION, - COBC_HD_CONFIGURATION_SECTION, - COBC_HD_SPECIAL_NAMES, 0); - if (current_program->nested_level) { - cb_error (_("%s not allowed in nested programs"), "SPECIAL-NAMES"); - } else { - current_program->flag_trailing_separate = 1; - } - } -; - -/* CURSOR clause */ - -cursor_clause: - CURSOR _is reference - { - check_headers_present (COBC_HD_ENVIRONMENT_DIVISION, - COBC_HD_CONFIGURATION_SECTION, - COBC_HD_SPECIAL_NAMES, 0); - if (current_program->nested_level) { - cb_error (_("%s not allowed in nested programs"), "SPECIAL-NAMES"); - } else { - check_repeated ("CURSOR", SYN_CLAUSE_3, &check_duplicate); - current_program->cursor_pos = $3; - } - } -; - - -/* CRT STATUS clause */ - -crt_status_clause: - CRT STATUS _is reference - { - check_headers_present (COBC_HD_ENVIRONMENT_DIVISION, - COBC_HD_CONFIGURATION_SECTION, - COBC_HD_SPECIAL_NAMES, 0); - if (current_program->nested_level) { - cb_error (_("%s not allowed in nested programs"), "SPECIAL-NAMES"); - } else { - check_repeated ("CRT STATUS", SYN_CLAUSE_4, &check_duplicate); - current_program->crt_status = $4; - } - } -; - - -/* SCREEN CONTROL */ - -screen_control: - SCREEN_CONTROL _is reference - { - check_headers_present (COBC_HD_ENVIRONMENT_DIVISION, - COBC_HD_CONFIGURATION_SECTION, - COBC_HD_SPECIAL_NAMES, 0); - if (current_program->nested_level) { - cb_error (_("%s not allowed in nested programs"), "SPECIAL-NAMES"); - } else { - check_repeated ("SCREEN CONTROL", SYN_CLAUSE_5, &check_duplicate); - CB_PENDING ("SCREEN CONTROL"); - } - } -; - -/* EVENT STATUS */ - -event_status: - EVENT_STATUS _is reference - { - check_headers_present (COBC_HD_ENVIRONMENT_DIVISION, - COBC_HD_CONFIGURATION_SECTION, - COBC_HD_SPECIAL_NAMES, 0); - if (current_program->nested_level) { - cb_error (_("%s not allowed in nested programs"), "SPECIAL-NAMES"); - } else { - check_repeated ("EVENT STATUS", SYN_CLAUSE_6, &check_duplicate); - CB_PENDING ("EVENT STATUS"); - } - } -; - -/* TOP clause */ - -top_clause: - TOP - { - check_headers_present (COBC_HD_ENVIRONMENT_DIVISION, - COBC_HD_CONFIGURATION_SECTION, - COBC_HD_SPECIAL_NAMES, 0); - check_duplicate = 0; - if (current_program->nested_level) { - cb_error (_("%s not allowed in nested programs"), "SPECIAL-NAMES"); - save_tree = NULL; - } else { - /* lookup system name - note: result in NULL + raised error if not found */ - save_tree = get_system_name ("TOP"); - } - } - _is undefined_word - { - if (save_tree && CB_VALID_TREE ($4)) { - cb_define ($4, save_tree); - CB_CHAIN_PAIR (current_program->mnemonic_spec_list, - $4, save_tree); - } - } -; - -/* INPUT-OUTPUT SECTION */ - -_input_output_section: - _input_output_header - _file_control_header - _file_control_sequence - _i_o_control -; - -_input_output_header: -| INPUT_OUTPUT SECTION TOK_DOT - { - check_headers_present (COBC_HD_ENVIRONMENT_DIVISION, 0, 0, 0); - header_check |= COBC_HD_INPUT_OUTPUT_SECTION; - } -; - -/* FILE-CONTROL paragraph */ - -_file_control_header: -| FILE_CONTROL TOK_DOT - { - check_headers_present (COBC_HD_ENVIRONMENT_DIVISION, - COBC_HD_INPUT_OUTPUT_SECTION, 0, 0); - header_check |= COBC_HD_FILE_CONTROL; - } -; - -_file_control_sequence: -| _file_control_sequence file_control_entry -; - -file_control_entry: - SELECT flag_optional undefined_word - { - check_headers_present (COBC_HD_ENVIRONMENT_DIVISION, - COBC_HD_INPUT_OUTPUT_SECTION, - COBC_HD_FILE_CONTROL, 0); - check_duplicate = 0; - if (CB_VALID_TREE ($3)) { - /* Build new file */ - current_file = build_file ($3); - current_file->optional = CB_INTEGER ($2)->val; - - /* Add file to current program list */ - CB_ADD_TO_CHAIN (CB_TREE (current_file), - current_program->file_list); - } else if (current_program->file_list) { - current_program->file_list - = CB_CHAIN (current_program->file_list); - } - key_type = NO_KEY; - } - _select_clauses_or_error - { - cobc_cs_check = 0; - if (CB_VALID_TREE ($3)) { - if (current_file->organization == COB_ORG_INDEXED - && key_type == RELATIVE_KEY) { - cb_error_x (current_file->key, - _("cannot use RELATIVE KEY clause on INDEXED files")); - } else if (current_file->organization == COB_ORG_RELATIVE - && key_type == RECORD_KEY) { - cb_error_x (current_file->key, - _("cannot use RECORD KEY clause on RELATIVE files")); - } - - validate_file (current_file, $3); - } - } -; - -_select_clauses_or_error: - _select_clause_sequence TOK_DOT -| error TOK_DOT - { - yyerrok; - } -; - -_select_clause_sequence: -| _select_clause_sequence select_clause - { - /* reset context-sensitive words for next clauses */ - cobc_cs_check = CB_CS_SELECT; - } -; - -/* duplicates are checked - but not the order... */ -select_clause: - assign_clause -| reserve_clause -| organization_clause -| padding_character_clause -| record_delimiter_clause -| access_mode_clause -| relative_key_clause -| collating_sequence_clause -| collating_sequence_clause_key -| record_key_clause -| alternative_record_key_clause -| file_status_clause -| lock_mode_clause -| sharing_clause -| file_limit_clause -| actual_key_clause -| nominal_key_clause -| track_area_clause -| track_limit_clause -/* FXIME: disabled because of shift/reduce conflict -| encryption_clause -*/ -/* FXIME: disabled because of shift/reduce conflict - (optional in [alternate] record key, could be moved here - if the suppress_clause goes here too and both entries verify that - they directly are invoked after an [alternate] record key) -| password_clause - { - if (current_file->organization == COB_ORG_INDEXED) { - cb_error (_("for indexed files, the PASSWORD phrase must follow KEY")); - } else { - current_file->password = $1; - } - } -*/ -; - - -/* ASSIGN clause */ - -/* - Most cases include a pointless _ext_clause to prevent a shift/reduce error -*/ -assign_clause: - ASSIGN _to _ext_clause _assign_device_or_line_adv_file literal - { - check_repeated ("ASSIGN", SYN_CLAUSE_1, &check_duplicate); - if (ext_dyn_specified) { - cb_error (_("EXTERNAL/DYNAMIC cannot be used with literals")); - } - - current_file->assign_type = CB_ASSIGN_EXT_FILE_NAME_REQUIRED; - current_file->assign = cb_build_assignment_name (current_file, $5); - } -| ASSIGN _to _ext_clause _assign_device_or_line_adv_file qualified_word - { - check_repeated ("ASSIGN", SYN_CLAUSE_1, &check_duplicate); - - /* current_file->assign_type is set by _ext_clause */ - if (!ext_dyn_specified) { - current_file->flag_assign_no_keyword = 1; - } - current_file->assign = cb_build_assignment_name (current_file, $5); - } -| ASSIGN _to _ext_clause _assign_device_or_line_adv_file using_or_varying qualified_word - { - check_repeated ("ASSIGN", SYN_CLAUSE_1, &check_duplicate); - if (ext_dyn_specified) { - cb_error (_("EXTERNAL/DYNAMIC cannot be used with USING/VARYING")); - } - cb_verify (cb_assign_using_variable, "ASSIGN USING/VARYING variable"); - - current_file->assign_type = CB_ASSIGN_VARIABLE_REQUIRED; - current_file->assign = cb_build_assignment_name (current_file, $6); - } -| ASSIGN _to _ext_clause DISK FROM qualified_word - { - check_repeated ("ASSIGN", SYN_CLAUSE_1, &check_duplicate); - if (ext_dyn_specified) { - cb_error (_("EXTERNAL/DYNAMIC cannot be used with DISK FROM")); - } - cb_verify (cb_assign_disk_from, _("ASSIGN DISK FROM")); - - current_file->assign_type = CB_ASSIGN_VARIABLE_REQUIRED; - current_file->assign = cb_build_assignment_name (current_file, $6); - } -| ASSIGN _to _ext_clause assign_device - { - if (assign_device == CB_ASSIGN_DISPLAY_DEVICE) { - current_file->assign = - cb_build_alphanumeric_literal ("stdout", (size_t)6); - current_file->special = COB_SELECT_STDOUT; - } else if (assign_device == CB_ASSIGN_KEYBOARD_DEVICE) { - current_file->assign = - cb_build_alphanumeric_literal ("stdin", (size_t)5); - current_file->special = COB_SELECT_STDIN; - } else if (assign_device == CB_ASSIGN_PRINTER_DEVICE) { - current_file->organization = COB_ORG_LINE_SEQUENTIAL; - current_file->assign = - cb_build_alphanumeric_literal ("PRINTER", (size_t)7); - } else if (assign_device == CB_ASSIGN_PRINTER_1_DEVICE) { - current_file->organization = COB_ORG_LINE_SEQUENTIAL; - current_file->assign = - cb_build_alphanumeric_literal ("PRINTER-1", (size_t)9); - } else if (assign_device == CB_ASSIGN_PRINT_DEVICE) { - current_file->organization = COB_ORG_LINE_SEQUENTIAL; - current_file->assign = - cb_build_alphanumeric_literal ("LPT1", (size_t)4); - } else if (assign_device == CB_ASSIGN_LINE_SEQ_DEVICE - || assign_device == CB_ASSIGN_GENERAL_DEVICE) { - current_file->flag_fileid = 1; - } - } -; - -_assign_device_or_line_adv_file: - /* empty */ - { - assign_device = CB_ASSIGN_NO_DEVICE; - } -| line_adv_file - { - assign_device = CB_ASSIGN_NO_DEVICE; - } -| assign_device -; - -assign_device: - general_device_name - { - assign_device = CB_ASSIGN_GENERAL_DEVICE; - } -| line_seq_device_name - { - current_file->organization = COB_ORG_LINE_SEQUENTIAL; - assign_device = CB_ASSIGN_LINE_SEQ_DEVICE; - } -| DISPLAY - { - assign_device = CB_ASSIGN_DISPLAY_DEVICE; - } -| KEYBOARD - { - assign_device = CB_ASSIGN_KEYBOARD_DEVICE; - } -/* Hint: R/M-COBOL has PRINTER01 thru PRINTER99 ! - MF-COBOL handles these identical to PRINTER-1, - with an optional file name PRINTER01 thru PRINTER99 -*/ -| PRINTER - { - assign_device = CB_ASSIGN_PRINTER_DEVICE; - } -| PRINTER_1 - { - assign_device = CB_ASSIGN_PRINTER_1_DEVICE; - } -| PRINT - { - assign_device = CB_ASSIGN_PRINT_DEVICE; - } -; - -/* Indicates no special processing */ -general_device_name: - DISC -| DISK -| TAPE -| RANDOM -; - -line_seq_device_name: - CARD_PUNCH -| CARD_READER -| CASSETTE -| INPUT -| INPUT_OUTPUT -| MAGNETIC_TAPE -| OUTPUT -; - -line_adv_file: - LINE ADVANCING _file - { - current_file->flag_line_adv = 1; - } -; - -_ext_clause: - /* empty */ - { - ext_dyn_specified = 0; - current_file->assign_type = cb_assign_type_default; - } -| ext_clause - { - ext_dyn_specified = 1; - cb_verify (cb_assign_ext_dyn, _("ASSIGN EXTERNAL/DYNAMIC")); - } -; - -ext_clause: - EXTERNAL - { - current_file->assign_type = CB_ASSIGN_EXT_FILE_NAME_REQUIRED; - } -| DYNAMIC - { - current_file->assign_type = CB_ASSIGN_VARIABLE_REQUIRED; - } -; - -assignment_name: - LITERAL -| qualified_word -; - -/* ACCESS MODE clause */ - -access_mode_clause: - ACCESS _mode _is access_mode - { - check_repeated ("ACCESS", SYN_CLAUSE_2, &check_duplicate); - } -; - -access_mode: - SEQUENTIAL { current_file->access_mode = COB_ACCESS_SEQUENTIAL; } -| DYNAMIC { current_file->access_mode = COB_ACCESS_DYNAMIC; } -| RANDOM { current_file->access_mode = COB_ACCESS_RANDOM; } -; - - -/* ALTERNATIVE RECORD KEY clause */ - -alternative_record_key_clause: - ALTERNATE _record _key _is reference _split_keys flag_duplicates _password_clause _suppress_clause - { - struct cb_alt_key *p; - struct cb_alt_key *l; - - cb_tree composite_key; - - p = cobc_parse_malloc (sizeof (struct cb_alt_key)); - p->key = $5; - p->component_list = NULL; - if ($7) { - p->duplicates = CB_INTEGER ($7)->val; - } else { - /* note: we may add a compiler configuration here, - as at least ICOBOL defaults to WITH DUPLICATES - for ALTERNATE keys if not explicit deactivated - */ - p->duplicates = 0; - } - p->password = $8; - if ($9 - && CB_LITERAL_P ($9) - && !CB_NUMERIC_LITERAL_P($9)) { - p->suppress = $9; - } else - if ($9) { - p->tf_suppress = 1; - p->char_suppress = CB_INTEGER ($9)->val; - } else { - p->tf_suppress = 0; - } - p->next = NULL; - - /* handle split keys */ - if ($6) { - /* generate field (in w-s) for composite-key */ - composite_key = cb_build_field($5); - if (composite_key == cb_error_node) { - YYERROR; - } else { - composite_key->category = CB_CATEGORY_ALPHANUMERIC; - ((struct cb_field *)composite_key)->count = 1; - p->key = cb_build_field_reference((struct cb_field *)composite_key, NULL); - p->component_list = key_component_list; - } - } - - /* Add to the end of list */ - if (current_file->alt_key_list == NULL) { - current_file->alt_key_list = p; - } else { - l = current_file->alt_key_list; - for (; l->next; l = l->next) { ; } - l->next = p; - } - } -; - -_password_clause: - /* empty */ - { - $$ = NULL; - } -| password_clause -; - -password_clause: - PASSWORD - { - CB_PENDING ("PASSWORD clause"); - } - _is reference - { - $$ = $4; - } -; - -/* FXIME: disabled because of shift/reduce conflict -encryption_clause: - _with ENCRYPTION - { - if (current_file->organization == COB_ORG_INDEXED) { - cb_error (_("%s only valid with ORGANIZATION %s"), "WITH ENCRYPTION", "INDEXED"); - } else { - CB_PENDING ("WITH ENCRYPTION"); - current_file->password = cb_int0; - } - } -; -*/ - -_suppress_clause: - /* empty */ - { - $$ = NULL; - } -| SUPPRESS WHEN ALL basic_value - { - $$ = cb_int (literal_value ($4)); - } -| SUPPRESS WHEN space_or_zero - { - $$ = cb_int (literal_value ($3)); - } -| SUPPRESS WHEN LITERAL - { - $$ = $3; - } -; - - -/* COLLATING SEQUENCE clause */ - -collating_sequence_clause: - collating_sequence - { - check_repeated ("COLLATING", SYN_CLAUSE_3, &check_duplicate); - current_file->collating_sequence = alphanumeric_collation; - current_file->collating_sequence_n = national_collation; - CB_PENDING ("FILE COLLATING SEQUENCE"); - } -; - -collating_sequence: - _collating SEQUENCE - { - alphanumeric_collation = national_collation = NULL; - } - coll_sequence_values -; - -coll_sequence_values: - _is alphabet_name - { - alphanumeric_collation = $2; - } -| _is alphabet_name alphabet_name - { - alphanumeric_collation = $2; - CB_PENDING_X ($3, "NATIONAL COLLATING SEQUENCE"); - national_collation = $3; - } -| _for ALPHANUMERIC _is alphabet_name - { - alphanumeric_collation = $4; - } -| _for NATIONAL _is alphabet_name - { - CB_PENDING_X ($4, "NATIONAL COLLATING SEQUENCE"); - national_collation = $4; - } -| _for ALPHANUMERIC _is alphabet_name - _for NATIONAL _is alphabet_name - { - alphanumeric_collation = $4; - CB_PENDING_X ($8, "NATIONAL COLLATING SEQUENCE"); - national_collation = $8; - } -| _for NATIONAL _is alphabet_name - _for ALPHANUMERIC _is alphabet_name - { - CB_PENDING_X ($4, "NATIONAL COLLATING SEQUENCE"); - national_collation = $4; - alphanumeric_collation = $8; - } -; - -collating_sequence_clause_key: - _collating SEQUENCE OF reference _is alphabet_name - { - /* note: both entries must be resolved later on - and also attached to the correct key later, so just store in a list here: */ - current_file->collating_sequence_keys = - cb_list_add(current_file->collating_sequence_keys, CB_BUILD_PAIR ($6, $4)); - CB_PENDING ("KEY COLLATING SEQUENCE"); - } -; - -alphabet_name: - WORD - { - if (CB_ALPHABET_NAME_P (cb_ref ($1))) { - $$ = $1; - } else { - cb_error_x ($1, _("'%s' is not an alphabet-name"), - cb_name ($1)); - $$ = cb_error_node; - } - } -; - -/* FILE STATUS clause */ - -file_status_clause: - _file_or_sort STATUS _is reference _reference - { - check_repeated ("STATUS", SYN_CLAUSE_4, &check_duplicate); - current_file->file_status = $4; - if ($5) { - /* add a compiler configuration if either */ - if (cb_std_define != CB_STD_IBM - && cb_std_define != CB_STD_MVS - && !cb_relaxed_syntax_checks) { - cb_verify (CB_UNCONFORMABLE, "VSAM STATUS"); - } else { - cb_warning (cb_warn_extra, _("%s ignored"), "VSAM STATUS"); - } - } - } -; - -_file_or_sort: - /* empty */ -| TOK_FILE -| SORT -; - -/* LOCK MODE clause */ - -lock_mode_clause: - { - check_repeated ("LOCK", SYN_CLAUSE_5, &check_duplicate); - } - LOCK _mode _is lock_mode -; - -lock_mode: - MANUAL _lock_with - { - current_file->lock_mode |= COB_LOCK_MANUAL; - } -| AUTOMATIC _lock_with - { - current_file->lock_mode |= COB_LOCK_AUTOMATIC; - } -| EXCLUSIVE _with_mass_update - { - current_file->lock_mode |= COB_LOCK_EXCLUSIVE; - } -; - -/* FIXME: the following WITH is optional (shift/reduce conflict) */ -_lock_with: -| WITH _lock ON lock_records _with_rollback -| WITH _lock ON MULTIPLE lock_records _with_rollback - { - current_file->lock_mode |= COB_LOCK_MULTIPLE; - } -| with_rollback - { - current_file->lock_mode |= (COB_LOCK_ROLLBACK|COB_LOCK_MULTIPLE); - } -; - -_with_rollback: -| with_rollback -; - -with_rollback: -_with ROLLBACK - { - CB_PENDING ("WITH ROLLBACK"); - } -; - -_with_mass_update: -| _with MASS_UPDATE - { - if (current_file->organization == COB_ORG_INDEXED) { - current_file->lock_mode |= COB_LOCK_EXCLUSIVE; - /* TODO: pass extra flag to fileio */ - CB_PENDING ("WITH MASS-UPDATE"); - } else { - cb_error (_("%s only valid with ORGANIZATION %s"), "MASS-UPDATE", "INDEXED"); - } - } -; - - -/* ORGANIZATION clause */ - -organization_clause: - ORGANIZATION _is organization -| organization -; - -organization: - INDEXED - { - check_repeated ("ORGANIZATION", SYN_CLAUSE_6, &check_duplicate); - error_if_record_delimiter_incompatible (COB_ORG_INDEXED, "INDEXED"); - current_file->organization = COB_ORG_INDEXED; - } -| _record _binary SEQUENTIAL - { - check_repeated ("ORGANIZATION", SYN_CLAUSE_6, &check_duplicate); - error_if_record_delimiter_incompatible (COB_ORG_SEQUENTIAL, "SEQUENTIAL"); - current_file->organization = COB_ORG_SEQUENTIAL; - } -| RELATIVE - { - check_repeated ("ORGANIZATION", SYN_CLAUSE_6, &check_duplicate); - error_if_record_delimiter_incompatible (COB_ORG_RELATIVE, "RELATIVE"); - current_file->organization = COB_ORG_RELATIVE; - } -| LINE SEQUENTIAL - { - check_repeated ("ORGANIZATION", SYN_CLAUSE_6, &check_duplicate); - error_if_record_delimiter_incompatible (COB_ORG_LINE_SEQUENTIAL, - "LINE SEQUENTIAL"); - current_file->organization = COB_ORG_LINE_SEQUENTIAL; - } -; - - -/* PADDING CHARACTER clause */ - -padding_character_clause: - PADDING _character _is reference_or_literal - { - check_repeated ("PADDING", SYN_CLAUSE_7, &check_duplicate); - cb_verify (cb_padding_character_clause, "PADDING CHARACTER"); - } -; - -/* RECORD DELIMITER clause */ - -record_delimiter_clause: - RECORD DELIMITER _is - { - check_repeated ("RECORD DELIMITER", SYN_CLAUSE_8, &check_duplicate); - current_file->flag_delimiter = 1; - } - record_delimiter_option -; - -record_delimiter_option: - STANDARD_1 - { - if (current_file->organization != COB_ORG_SEQUENTIAL) { - cb_error (_("RECORD DELIMITER %s only allowed with SEQUENTIAL files"), - "STANDARD-1"); - } else if (cb_verify (cb_record_delimiter, _("RECORD DELIMITER clause"))) { - cb_warning (cb_warn_extra, - _("%s ignored"), "RECORD DELIMITER STANDARD-1"); - } - } -| LINE_SEQUENTIAL - { - if (current_file->organization != COB_ORG_SEQUENTIAL - && current_file->organization != COB_ORG_LINE_SEQUENTIAL) { - cb_error (_("RECORD DELIMITER %s only allowed with (LINE) SEQUENTIAL files"), - "LINE-SEQUENTIAL"); - } - - if (cb_verify (cb_record_delimiter, _("RECORD DELIMITER clause")) - && cb_verify (cb_sequential_delimiters, _("LINE-SEQUENTIAL phrase"))) { - current_file->organization = COB_ORG_LINE_SEQUENTIAL; - } - } -| BINARY_SEQUENTIAL - { - if (current_file->organization != COB_ORG_SEQUENTIAL) { - cb_error (_("RECORD DELIMITER %s only allowed with SEQUENTIAL files"), - "BINARY-SEQUENTIAL"); - } - - if (cb_verify (cb_record_delimiter, _("RECORD DELIMITER clause")) - && cb_verify (cb_sequential_delimiters, _("BINARY-SEQUENTIAL phrase"))) { - current_file->organization = COB_ORG_SEQUENTIAL; - } - } -| WORD - { - if (current_file->organization != COB_ORG_SEQUENTIAL - && current_file->organization != COB_ORG_LINE_SEQUENTIAL) { - cb_error (_("RECORD DELIMITER clause only allowed with (LINE) SEQUENTIAL files")); - } else if (cb_verify (cb_record_delimiter, _("RECORD DELIMITER clause"))) { - cb_warning (cb_warn_extra, - _("RECORD DELIMITER %s not recognized; will be ignored"), cb_name ($1)); - } - } -; - -/* RECORD KEY clause */ - -record_key_clause: - RECORD _key _is reference _split_keys _password_clause flag_duplicates - { - cb_tree composite_key; - - check_repeated ("RECORD KEY", SYN_CLAUSE_9, &check_duplicate); - current_file->key = $4; - key_type = RECORD_KEY; - - /* handle split keys */ - if ($5) { - /* generate field (in w-s) for composite-key */ - composite_key = cb_build_field ($4); - if (composite_key == cb_error_node) { - YYERROR; - } else { - composite_key->category = CB_CATEGORY_ALPHANUMERIC; - ((struct cb_field *)composite_key)->count = 1; - current_file->key = cb_build_field_reference ((struct cb_field *)composite_key, NULL); - current_file->component_list = key_component_list; - } - } - current_file->password = $6; - if ($7) { - /* note: we *may* add a compiler configuration here, - as most dialects do not allow this clause - on primary keys */ - if (CB_INTEGER ($7)->val) { - /* note: see ACUCOBOL docs for implementation notes, including [RE]WRITE rules - and "if the underlying (file) system does not support them OPEN - result in (sucessfull) io-status 0M" */ - CB_PENDING (_("DUPLICATES for primary keys")); - }; - - } - } -; - -_split_keys: - /* empty*/ - { - $$ = NULL; - } -| source_is split_key_list - { - $$ = cb_int0; - } -; - -source_is: - TOK_EQUAL -| SOURCE _is -; - -split_key_list: - { - key_component_list = NULL; - } - split_key -| split_key_list split_key -; - - -split_key: - reference - { - struct cb_key_component *c; - struct cb_key_component *comp = cobc_main_malloc (sizeof(struct cb_key_component)); - comp->next = NULL; - comp->component = $1; - if (key_component_list == NULL) { - key_component_list = comp; - } else { - for (c = key_component_list; c->next != NULL; c = c->next); - c->next = comp; - } - } -; - -/* RELATIVE KEY clause */ - -relative_key_clause: - RELATIVE _key _is reference - { - check_repeated ("RELATIVE KEY", SYN_CLAUSE_10, &check_duplicate); - current_file->key = $4; - key_type = RELATIVE_KEY; - } -; - -/* RESERVE clause */ - -reserve_clause: - RESERVE no_or_integer _areas - { - check_repeated ("RESERVE", SYN_CLAUSE_11, &check_duplicate); - } -; - -no_or_integer: - NO -| integer -; - -/* SHARING clause */ - -sharing_clause: - SHARING _with sharing_option - { - check_repeated ("SHARING", SYN_CLAUSE_12, &check_duplicate); - current_file->sharing = $3; - } -; - -sharing_option: - ALL _other { $$ = cb_int (COB_SHARE_ALL_OTHER); } -| NO _other { $$ = cb_int (COB_SHARE_NO_OTHER); } -| READ ONLY { $$ = cb_int (COB_SHARE_READ_ONLY); } -; - -/* FILE-LIMIT clause */ - -file_limit_clause: - file_limit_or_limits _is_are thru_list - { - (void)cb_verify (CB_OBSOLETE, "FILE-LIMIT"); - check_repeated ("FILE-LIMIT", SYN_CLAUSE_13, &check_duplicate); - } -; - -thru_list: - reference_or_literal THRU reference_or_literal -| thru_list reference_or_literal THRU reference_or_literal -; - -/* ACTUAL KEY clause */ - -actual_key_clause: - ACTUAL _key _is reference - { - (void)cb_verify (CB_OBSOLETE, "ACTUAL KEY"); - check_repeated ("ACTUAL KEY", SYN_CLAUSE_14, &check_duplicate); - } -; - -/* NOMINAL KEY clause */ - -nominal_key_clause: - NOMINAL _key _is reference - { - (void)cb_verify (CB_OBSOLETE, "NOMINAL KEY"); - check_repeated ("NOMINAL KEY", SYN_CLAUSE_15, &check_duplicate); - } -; - -/* TRACK-AREA clause */ - -track_area_clause: - TRACK_AREA _is reference_or_literal _characters - { - (void)cb_verify (CB_OBSOLETE, "TRACK-AREA"); - check_repeated ("TRACK-AREA", SYN_CLAUSE_16, &check_duplicate); - } -; - -/* TRACK-LIMIT clause */ - -track_limit_clause: - TRACK_LIMIT _is integer track_or_tracks - { - (void)cb_verify (CB_OBSOLETE, "TRACK-LIMIT"); - check_repeated ("TRACK-LIMIT", SYN_CLAUSE_17, &check_duplicate); - } - -; - -/* I-O-CONTROL paragraph */ - -_i_o_control: -| i_o_control_header _i_o_control_entries - { - cobc_cs_check = 0; - } -; - -i_o_control_header: - I_O_CONTROL TOK_DOT -{ - check_headers_present(COBC_HD_ENVIRONMENT_DIVISION, - COBC_HD_INPUT_OUTPUT_SECTION, 0, 0); - header_check |= COBC_HD_I_O_CONTROL; -} -; - -_i_o_control_entries: -| i_o_control_list TOK_DOT -| i_o_control_list error TOK_DOT - { - yyerrok; - } -; - -i_o_control_list: - i_o_control_clause -| i_o_control_list i_o_control_clause -; - -i_o_control_clause: - same_clause -| apply_clause -| multiple_file_tape_clause -| rerun_clause -; - -/* SAME clause */ - -same_clause: - SAME _same_option _area _for file_name_list - { - cb_tree l; - - check_headers_present (COBC_HD_ENVIRONMENT_DIVISION, - COBC_HD_INPUT_OUTPUT_SECTION, - COBC_HD_I_O_CONTROL, 0); - switch (CB_INTEGER ($2)->val) { - case 0: - /* SAME AREA */ - break; - case 1: - /* SAME RECORD */ - for (l = $5; l; l = CB_CHAIN (l)) { - if (CB_VALID_TREE (CB_VALUE (l))) { - CB_FILE (cb_ref (CB_VALUE (l)))->same_clause = same_area; - } - } - same_area++; - break; - case 2: - /* SAME SORT-MERGE */ - break; - } - } -; - -_same_option: - /* empty */ { $$ = cb_int0; } -| RECORD { $$ = cb_int1; } -| SORT { $$ = cb_int2; } -| SORT_MERGE { $$ = cb_int2; } -; - -/* APPLY clause */ - -apply_clause: - APPLY COMMIT _on reference_list - { - current_program->apply_commit = $4; - CB_PENDING("APPLY COMMIT"); - } -| APPLY LOCK_HOLDING _on file_name_list - { - CB_PENDING ("APPLY LOCK-HOLDING"); - } -| APPLY PRINT_CONTROL _on file_name_list - { - CB_PENDING ("APPLY PRINT-CONTROL"); - } -| APPLY WRITE_ONLY _on file_name_list -| obsolete_dos_vs_apply_phrase - { - cb_verify (CB_OBSOLETE, _("DOS/VS APPLY phrase")); - } -; - -obsolete_dos_vs_apply_phrase: - APPLY CORE_INDEX _to reference _on file_name_list -| APPLY CYL_INDEX _to integer _on file_name_list -| APPLY CYL_OVERFLOW _of integer track_or_tracks _on file_name_list -| APPLY EXTENDED_SEARCH _on file_name_list -| APPLY MASTER_INDEX _to integer _on file_name_list -| APPLY RECORD_OVERFLOW _on file_name_list -| APPLY REORG_CRITERIA _to reference _on file_name_list -| APPLY WRITE_VERIFY _on file_name_list -; - -/* MULTIPLE FILE TAPE clause */ - -multiple_file_tape_clause: - MULTIPLE - { - /* Fake for TAPE */ - cobc_cs_check = CB_CS_ASSIGN; - } - _file _tape _contains multiple_file_list - { - check_headers_present (COBC_HD_ENVIRONMENT_DIVISION, - COBC_HD_INPUT_OUTPUT_SECTION, - COBC_HD_I_O_CONTROL, 0); - cb_verify (cb_multiple_file_tape_clause, "MULTIPLE FILE TAPE"); - cobc_cs_check = 0; - } -; - -multiple_file_list: - multiple_file -| multiple_file_list multiple_file -; - -multiple_file: - file_name _multiple_file_position -; - -_multiple_file_position: -| POSITION integer -; - -/* RERUN clause */ - -rerun_clause: - RERUN _on_assignment _every rerun_event _of file_name -; - -_on_assignment: - _on assignment_name -; - -rerun_event: - integer RECORDS -| END _of reel_or_unit -; - -/* DATA DIVISION */ - -_data_division: - _data_division_header - _file_section_header - _file_description_sequence - { - current_storage = CB_STORAGE_WORKING; - } - _working_storage_section - _communication_section - _local_storage_section - _linkage_section - _report_section - _screen_section -; - -_data_division_header: -| data_division_header -; - -data_division_header: - DATA DIVISION TOK_DOT - { - header_check |= COBC_HD_DATA_DIVISION; - } -; - -/* FILE SECTION */ - -_file_section_header: -| TOK_FILE SECTION TOK_DOT - { - current_storage = CB_STORAGE_FILE; - check_headers_present (COBC_HD_DATA_DIVISION, 0, 0, 0); - header_check |= COBC_HD_FILE_SECTION; - } -; - -_file_description_sequence: -| _file_description_sequence file_description -; - -file_description: - file_description_entry - _record_description_list - { - if (CB_VALID_TREE (current_file)) { - if (CB_VALID_TREE ($2)) { - /* Do not keep Record if this is really a report */ - if (!current_file->reports) { - finalize_file (current_file, CB_FIELD ($2)); - } - } else if (!current_file->reports) { - cb_error (_("RECORD description missing or invalid")); - } - } - } -; - -/* File description entry */ - -file_description_entry: - file_type file_name - { - current_storage = CB_STORAGE_FILE; - check_headers_present (COBC_HD_DATA_DIVISION, - COBC_HD_FILE_SECTION, 0, 0); - check_duplicate = 0; - if (CB_INVALID_TREE ($2)) { - current_file = NULL; - YYERROR; - } - current_file = CB_FILE (cb_ref ($2)); - if (CB_VALID_TREE (current_file)) { - if ($1 == cb_int1) { - current_file->organization = COB_ORG_SORT; - } - /* note: this is a HACK and should be moved */ - if (current_file->flag_finalized) { - cb_error_x ($2, _("duplicate file description for %s"), - cb_name (CB_TREE (current_file))); - } - } - } - _file_description_clause_sequence TOK_DOT -| file_type error TOK_DOT - { - yyerrok; - } -; - -file_type: - FD - { - $$ = cb_int0; - } -| SD - { - $$ = cb_int1; - } -; - -_file_description_clause_sequence: -| _file_description_clause_sequence file_description_clause -; - -file_description_clause: - _is EXTERNAL - { - check_repeated ("EXTERNAL", SYN_CLAUSE_1, &check_duplicate); -#if 0 /* RXWRXW - Global/External */ - if (current_file->flag_global) { - cb_error (_("file cannot have both EXTERNAL and GLOBAL clauses")); - } -#endif - current_file->flag_external = 1; - } -| _is GLOBAL - { - check_repeated ("GLOBAL", SYN_CLAUSE_2, &check_duplicate); -#if 0 /* RXWRXW - Global/External */ - if (current_file->flag_external) { - cb_error (_("file cannot have both EXTERNAL and GLOBAL clauses")); - } -#endif - if (current_program->prog_type == COB_MODULE_TYPE_FUNCTION) { - cb_error (_("%s is invalid in a user FUNCTION"), "GLOBAL"); - } else { - current_file->flag_global = 1; - current_program->flag_file_global = 1; - } - } -| block_contains_clause -| record_clause -| label_records_clause -| value_of_clause -| data_records_clause -| linage_clause -| recording_mode_clause -| code_set_clause -| report_clause -; - - -/* BLOCK CONTAINS clause */ - -block_contains_clause: - BLOCK _contains integer _to_integer _records_or_characters - { - check_repeated ("BLOCK", SYN_CLAUSE_3, &check_duplicate); - /* ignore */ - } -; - -_records_or_characters: | RECORDS | CHARACTERS ; - - -/* RECORD clause */ - -record_clause: - RECORD _contains integer _characters - { - check_repeated ("RECORD", SYN_CLAUSE_4, &check_duplicate); - if (current_file->organization == COB_ORG_LINE_SEQUENTIAL) { - cb_warning (cb_warn_extra, _("RECORD clause ignored for LINE SEQUENTIAL")); - } else { - set_record_size (NULL, $3); - } - } -| RECORD _contains integer TO integer _characters - { - check_repeated ("RECORD", SYN_CLAUSE_4, &check_duplicate); - if (current_file->organization == COB_ORG_LINE_SEQUENTIAL) { - cb_warning (cb_warn_extra, _("RECORD clause ignored for LINE SEQUENTIAL")); - } else { - set_record_size ($3, $5); - } - } -| RECORD _is VARYING _in _size _from_integer _to_integer _characters - _record_depending - { - check_repeated ("RECORD", SYN_CLAUSE_4, &check_duplicate); - set_record_size ($6, $7); - current_file->flag_check_record_varying_limits = - current_file->record_min == 0 || current_file->record_max == 0; - } -; - -_record_depending: -| DEPENDING _on reference - { - current_file->record_depending = $3; - } -; - -_from_integer: - /* empty */ { $$ = NULL; } -| _from integer { $$ = $2; } -; - -_to_integer: - /* empty */ { $$ = NULL; } -| TO integer { $$ = $2; } -; - - -/* LABEL RECORDS clause */ - -label_records_clause: - LABEL records label_option - { - check_repeated ("LABEL", SYN_CLAUSE_5, &check_duplicate); - cb_verify (cb_label_records_clause, "LABEL RECORDS"); - } -; - - -/* VALUE OF clause */ - -value_of_clause: - VALUE OF file_id _is valueof_name - { - check_repeated ("VALUE OF", SYN_CLAUSE_6, &check_duplicate); - cb_verify (cb_value_of_clause, "VALUE OF"); - } -| VALUE OF FILE_ID _is valueof_name - { - check_repeated ("VALUE OF", SYN_CLAUSE_6, &check_duplicate); - cb_verify (cb_value_of_clause, "VALUE OF"); - if (!current_file->assign) { - current_file->assign = cb_build_assignment_name (current_file, $5); - } - } -; - -file_id: - WORD -| ID -; - -valueof_name: - LITERAL -| qualified_word -; - -/* DATA RECORDS clause */ - -data_records_clause: - DATA records optional_reference_list - { - check_repeated ("DATA", SYN_CLAUSE_7, &check_duplicate); - cb_verify (cb_data_records_clause, "DATA RECORDS"); - } -; - - -/* LINAGE clause */ - -linage_clause: - LINAGE _is reference_or_literal _lines - _linage_sequence - { - check_repeated ("LINAGE", SYN_CLAUSE_8, &check_duplicate); - if (current_file->organization != COB_ORG_LINE_SEQUENTIAL && - current_file->organization != COB_ORG_SEQUENTIAL) { - cb_error (_("LINAGE clause with wrong file type")); - } else { - current_file->linage = $3; - current_file->organization = COB_ORG_LINE_SEQUENTIAL; - if (current_linage == 0) { - linage_file = current_file; - } - current_linage++; - } - } -; - -_linage_sequence: -| _linage_sequence linage_lines -; - -linage_lines: - linage_footing -| linage_top -| linage_bottom -; - -linage_footing: - _with FOOTING _at reference_or_literal - { - current_file->latfoot = $4; - } -; - -linage_top: - TOP reference_or_literal - { - current_file->lattop = $2; - } -; - -linage_bottom: - BOTTOM reference_or_literal - { - current_file->latbot = $2; - } -; - -/* RECORDING MODE clause */ - -recording_mode_clause: - RECORDING _mode _is recording_mode - { - cobc_cs_check ^= CB_CS_RECORDING; - check_repeated ("RECORDING", SYN_CLAUSE_9, &check_duplicate); - /* ignore */ - } -; - -recording_mode: - F -| V -| FIXED -| VARIABLE -| u_or_s - { - if (current_file->organization != COB_ORG_SEQUENTIAL) { - cb_error (_("RECORDING MODE U or S can only be used with RECORD SEQUENTIAL files")); - } - } -; - -u_or_s: - U -| S -; - -/* CODE-SET clause */ - -code_set_clause: - CODE_SET _is alphabet_name _for_sub_records_clause - { - struct cb_alphabet_name *al; - - check_repeated ("CODE SET", SYN_CLAUSE_10, &check_duplicate); - - if (CB_VALID_TREE ($3)) { - al = CB_ALPHABET_NAME (cb_ref ($3)); - switch (al->alphabet_type) { -#ifdef COB_EBCDIC_MACHINE - case CB_ALPHABET_ASCII: -#else - case CB_ALPHABET_EBCDIC: -#endif - case CB_ALPHABET_CUSTOM: - current_file->code_set = al; - CB_PENDING ("CODE-SET"); - break; - default: - if (cb_warn_extra) { - cb_warning_x (cb_warn_extra, $3, _("ignoring CODE-SET '%s'"), - cb_name ($3)); - } else { - CB_PENDING ("CODE-SET"); - } - break; - } - } - - if (current_file->organization != COB_ORG_LINE_SEQUENTIAL && - current_file->organization != COB_ORG_SEQUENTIAL) { - cb_error (_("CODE-SET clause invalid for file type")); - } - - } -; - -_for_sub_records_clause: -| FOR reference_list - { - CB_PENDING ("FOR sub-records"); - current_file->code_set_items = CB_LIST ($2); - } -; - -/* REPORT clause */ - -report_clause: - report_keyword rep_name_list - { - check_repeated ("REPORT", SYN_CLAUSE_11, &check_duplicate); - if (current_file->organization != COB_ORG_LINE_SEQUENTIAL && - current_file->organization != COB_ORG_SEQUENTIAL) { - cb_error (_("REPORT clause with wrong file type")); - } else { - current_file->reports = $2; - current_file->organization = COB_ORG_LINE_SEQUENTIAL; - current_file->flag_line_adv = 1; - } - } -; - -report_keyword: - REPORT _is -| REPORTS _are -; - -rep_name_list: - undefined_word - { - if (CB_VALID_TREE ($1)) { - current_report = build_report ($1); - current_report->file = current_file; - current_program->report_list = - cb_list_add (current_program->report_list, - CB_TREE (current_report)); - if (report_count == 0) { - report_instance = current_report; - } - report_count++; - } - } -| rep_name_list undefined_word - { - if (CB_VALID_TREE ($2)) { - current_report = build_report ($2); - current_report->file = current_file; - current_program->report_list = - cb_list_add (current_program->report_list, - CB_TREE (current_report)); - if (report_count == 0) { - report_instance = current_report; - } - report_count++; - } - } -; - -/* COMMUNICATION SECTION */ - -_communication_section: -| COMMUNICATION SECTION TOK_DOT - { - current_storage = CB_STORAGE_COMMUNICATION; - check_headers_present (COBC_HD_DATA_DIVISION, 0, 0, 0); - header_check |= COBC_HD_COMMUNICATION_SECTION; - /* add a compiler configuration if either */ - if (cb_std_define != CB_STD_85 - && cb_std_define != CB_STD_RM - && cb_std_define != CB_STD_GC - && !cb_relaxed_syntax_checks) { - cb_verify (CB_UNCONFORMABLE, "COMMUNICATION SECTION"); - } else if (cb_verify (CB_OBSOLETE, "COMMUNICATION SECTION")) { - CB_PENDING ("COMMUNICATION SECTION"); - } - } - _communication_description_sequence -; - -_communication_description_sequence: -| _communication_description_sequence communication_description -; - -communication_description: - communication_description_entry - _record_description_list - { - if (CB_VALID_TREE (current_cd)) { - if (CB_VALID_TREE ($2)) { - cb_finalize_cd (current_cd, CB_FIELD ($2)); - } else if (!current_cd->record) { - cb_error (_("CD record missing")); - } - } - } -; - -/* File description entry */ - -communication_description_entry: - CD undefined_word - { - /* CD internally defines a new file */ - if (CB_VALID_TREE ($2)) { - current_cd = cb_build_cd ($2); - - CB_ADD_TO_CHAIN (CB_TREE (current_cd), - current_program->cd_list); - } else { - current_cd = NULL; - /* TO-DO: Is this necessary? */ - if (current_program->cd_list) { - current_program->cd_list - = CB_CHAIN (current_program->cd_list); - } - } - check_duplicate = 0; - } - _communication_description_clause_sequence TOK_DOT -; - -_communication_description_clause_sequence: -| _communication_description_clause_sequence communication_description_clause -; - -communication_description_clause: - _for _initial INPUT _input_cd_clauses -| _for OUTPUT _output_cd_clauses -| _for _initial I_O _i_o_cd_clauses -; - -_input_cd_clauses: - /* empty */ -| named_input_cd_clauses -| unnamed_input_cd_clauses -; - -named_input_cd_clauses: - named_input_cd_clause -| named_input_cd_clauses named_input_cd_clause -; - -named_input_cd_clause: - _symbolic QUEUE _is identifier -| _symbolic SUB_QUEUE_1 _is identifier -| _symbolic SUB_QUEUE_2 _is identifier -| _symbolic SUB_QUEUE_3 _is identifier -| MESSAGE DATE _is identifier -| MESSAGE TIME _is identifier -| _symbolic SOURCE _is identifier -| TEXT LENGTH _is identifier -| END KEY _is identifier -| STATUS KEY _is identifier -| _message COUNT _is identifier -; - -unnamed_input_cd_clauses: - identifier identifier identifier identifier identifier identifier identifier - identifier identifier identifier identifier -; - -_output_cd_clauses: - /* empty */ -| output_cd_clauses -; - -output_cd_clauses: - output_cd_clause -| output_cd_clauses output_cd_clause -; - -output_cd_clause: - DESTINATION COUNT _is identifier -| TEXT LENGTH _is identifier -| STATUS KEY _is identifier -| DESTINATION TABLE OCCURS integer _times _occurs_indexed -| ERROR KEY _is identifier -| DESTINATION _is identifier -| SYMBOLIC DESTINATION _is identifier -; - -_i_o_cd_clauses: - /* empty */ -| named_i_o_cd_clauses -| unnamed_i_o_cd_clauses -; - -named_i_o_cd_clauses: - named_i_o_cd_clause -| named_i_o_cd_clauses named_i_o_cd_clause -; - -named_i_o_cd_clause: - MESSAGE DATE _is identifier -| MESSAGE TIME _is identifier -| _symbolic TERMINAL _is identifier -| TEXT LENGTH _is identifier -| END KEY _is identifier -| STATUS KEY _is identifier -; - -unnamed_i_o_cd_clauses: - identifier identifier identifier identifier identifier identifier -; - -/* WORKING-STORAGE SECTION */ - -_working_storage_section: -| WORKING_STORAGE SECTION TOK_DOT - { - check_headers_present (COBC_HD_DATA_DIVISION, 0, 0, 0); - header_check |= COBC_HD_WORKING_STORAGE_SECTION; - current_storage = CB_STORAGE_WORKING; - } - _record_description_list - { - if ($5) { - CB_FIELD_ADD (current_program->working_storage, CB_FIELD ($5)); - } - } -; - -_record_description_list: - /* empty */ - { - $$ = NULL; - } -| - { - current_field = NULL; - control_field = NULL; - description_field = NULL; - cb_clear_real_field (); - } - record_description_list - { - struct cb_field *p; - /* finalize last field if target of SAME AS */ - if (current_field && !CB_INVALID_TREE (current_field->same_as)) { - inherit_same_as (); - } - - for (p = description_field; p; p = p->sister) { - cb_validate_field (p); - } - $$ = CB_TREE (description_field); - } -; - -record_description_list: - data_description TOK_DOT -| record_description_list data_description TOK_DOT -; - -data_description: - constant_entry -| renames_entry -| condition_name_entry -| level_number _entry_name - { - if (current_field && !CB_INVALID_TREE (current_field->same_as)) { - /* finalize last field if target of SAME AS */ - inherit_same_as (); - } - if (set_current_field ($1, $2)) { - YYERROR; - } - save_tree = NULL; - } - _data_description_clause_sequence - { - if (!qualifier) { - current_field->flag_filler = 1; - } - if (!description_field) { - description_field = current_field; - } - } -| level_number error TOK_DOT - { -#if 0 /* works fine without, leads to invalid free otherwise [COB_TREE_DEBUG] */ - /* Free tree associated with level number */ - cobc_parse_free ($1); -#endif - yyerrok; - cb_unput_dot (); - check_pic_duplicate = 0; - check_duplicate = 0; -#if 0 /* CHECKME - *Why* would we want to change the field here? */ - current_field = cb_get_real_field (); -#endif - } -; - -level_number: - not_const_word LEVEL_NUMBER - { - $$ = $2; - } -; - -_filler: - /* empty */ -| FILLER -; - -_entry_name: - _filler - { - $$ = cb_build_filler (); - qualifier = NULL; - keys_list = NULL; - non_const_word = 0; - } -| user_entry_name -; - -user_entry_name: - WORD - { - $$ = $1; - qualifier = $1; - keys_list = NULL; - non_const_word = 0; - } -; - -_const_global: - /* Nothing */ - { - $$ = NULL; - } -| _is GLOBAL - { - if (current_program->prog_type == COB_MODULE_TYPE_FUNCTION) { - cb_error (_("%s is invalid in a user FUNCTION"), "GLOBAL"); - $$ = NULL; - } else { - $$ = cb_null; - } - } -; - -lit_or_length: - literal { $$ = $1; } -| length_of_register con_source { $$ = cb_build_const_length ($2); } -/* note: only reserved in context of CB_CS_CONSTANT: */ -| BYTE_LENGTH _of con_source { $$ = cb_build_const_length ($3); } -; - -con_source: - identifier_1 - { - $$ = $1; - } -| non_numeric_literal - { - $$ = $1; - } -/* note: all entries below are non-standard GnuCOBOL only extensions - (and miss the newer fixed-length USAGE types) */ -| BINARY_CHAR - { - $$ = cb_int1; - } -| BINARY_SHORT - { - $$ = cb_int2; - } -| BINARY_LONG - { - $$ = cb_int4; - } -| BINARY_DOUBLE - { - $$ = cb_int8; - } -| BINARY_C_LONG - { - $$ = cb_int ((int)sizeof(long)); - } -| pointer_len - { - $$ = cb_int ((int)sizeof(void *)); - } -| COMP_1 - { - if (cb_binary_comp_1) { - $$ = cb_int2; - } else { - $$ = cb_int ((int)sizeof(float)); - } - } -| FLOAT_SHORT /* alias from FLOAT (ACU) in reserved.c */ - { - $$ = cb_int ((int)sizeof(float)); - } -| double_usage - { - $$ = cb_int ((int)sizeof(double)); - } -| fp32_usage - { - $$ = cb_int4; - } -| fp64_usage - { - $$ = cb_int8; - } -| fp128_usage - { - $$ = cb_int16; - } -| error TOK_DOT - { - yyerrok; - cb_unput_dot (); - check_pic_duplicate = 0; - check_duplicate = 0; - current_field = cb_get_real_field (); - } -; - -fp32_usage: - FLOAT_BINARY_32 -| FLOAT_DECIMAL_7 -; - -fp64_usage: - FLOAT_BINARY_64 -| FLOAT_DECIMAL_16 -; - -fp128_usage: - FLOAT_BINARY_128 -| FLOAT_DECIMAL_34 -| FLOAT_EXTENDED -; - -pointer_len: - POINTER -| PROGRAM_POINTER -; - -renames_entry: - SIXTY_SIX user_entry_name RENAMES not_const_word qualified_word _renames_thru - { - cb_tree renames_target = cb_ref ($5); - - size_t sav = cb_needs_01; - cb_needs_01 = 0; - - non_const_word = 0; - - if (set_current_field ($1, $2)) { - /* error in the definition, no further checks possible */ - } else if (renames_target == cb_error_node) { - /* error in the target, skip further checks */ - current_field->flag_invalid = 1; - } else { - cb_tree renames_thru = $6; - - current_field->redefines = CB_FIELD (renames_target); - if (renames_thru) { - renames_thru = cb_ref (renames_thru); - } - if (CB_VALID_TREE (renames_thru)) { - current_field->rename_thru = CB_FIELD (renames_thru); - } else { - /* If there is no THRU clause, RENAMES acts like REDEFINES. */ - current_field->pic = current_field->redefines->pic; - } - - if (cb_validate_renames_item (current_field, $5, $6)) { - current_field->flag_invalid = 1; - } else { - /* ensure the reference was validated as this - also calculates the reference' picture and size */ - if (!current_field->redefines->flag_is_verified) { - cb_validate_field (current_field->redefines); - } - } - } - cb_needs_01 = sav; - } -; - -_renames_thru: - /* empty */ - { - $$ = NULL; - } -| THRU qualified_word - { - $$ = $2 == cb_error_node ? NULL : $2; - } -; - -condition_name_entry: - EIGHTY_EIGHT user_entry_name - { - if (set_current_field ($1, $2)) { - YYERROR; - } - } - value_clause - { - cb_validate_88_item (current_field); - } -; - -constant_entry: - level_number user_entry_name CONSTANT _const_global constant_source - { - cb_tree x; - int level; - - cobc_cs_check = 0; - level = cb_get_level ($1); - /* Free tree associated with level number */ - cobc_parse_free ($1); - if (level != 1) { - cb_error (_("CONSTANT item not at 01 level")); - } else if ($5) { - if (cb_verify(cb_constant_01, "01 CONSTANT")) { - x = cb_build_constant ($2, $5); - CB_FIELD (x)->flag_item_78 = 1; - CB_FIELD (x)->flag_constant = 1; - CB_FIELD (x)->level = 1; - CB_FIELD (x)->values = $5; - cb_needs_01 = 1; - if ($4) { - CB_FIELD (x)->flag_is_global = 1; - } - /* Ignore return value */ - (void)cb_validate_78_item (CB_FIELD (x), 0); - } - } - } -| SEVENTY_EIGHT user_entry_name - { - if (set_current_field ($1, $2)) { - YYERROR; - } - } - _global_clause - VALUE _is constant_78_source - { - /* Reset to last non-78 item */ - current_field = cb_validate_78_item (current_field, 0); - } -; - -constant_source: - _as value_item_list - { - $$ = $2; - } -| FROM WORD - { - $$ = CB_LIST_INIT(cb_build_const_from ($2)); - } -; - -constant_78_source: - constant_expression_list - { - if (CB_VALID_TREE (current_field)) { - current_field->values = $1; - } - } -| START _of identifier - { - current_field->values = CB_LIST_INIT (cb_build_const_start (current_field, $3)); - } -| NEXT - { - current_field->values = CB_LIST_INIT (cb_build_const_next (current_field)); - } -; - -constant_expression_list: - constant_expression { $$ = CB_LIST_INIT ($1); } -| constant_expression_list constant_expression { $$ = cb_list_add ($1, $2); } -; - -constant_expression: - lit_or_length { $$ = $1; } -| TOK_OPEN_PAREN { $$ = cb_build_alphanumeric_literal ("(", 1); } -| TOK_CLOSE_PAREN { $$ = cb_build_alphanumeric_literal (")", 1); } -| TOK_PLUS { $$ = cb_build_alphanumeric_literal ("+", 1); } -| TOK_MINUS { $$ = cb_build_alphanumeric_literal ("-", 1); } -| TOK_MUL { $$ = cb_build_alphanumeric_literal ("*", 1); } -| TOK_DIV { $$ = cb_build_alphanumeric_literal ("/", 1); } -| AND { $$ = cb_build_alphanumeric_literal ("&", 1); } -| OR { $$ = cb_build_alphanumeric_literal ("|", 1); } -| EXPONENTIATION { $$ = cb_build_alphanumeric_literal ("^", 1); } -; - -_data_description_clause_sequence: - /* empty */ -| data_description_clause_sequence -; - -data_description_clause_sequence: - data_description_clause - { - save_tree = cb_int0; - } -| data_description_clause_sequence data_description_clause -; - -data_description_clause: - redefines_clause -| same_as_clause -| external_clause -| special_names_clause -| global_clause -| picture_clause -| usage_clause -| sign_clause -| occurs_clause -| justified_clause -| synchronized_clause -| blank_clause -| based_clause -| value_clause -| any_length_clause -| external_form_clause -| identified_by_clause -| volatile_clause -; - - -/* REDEFINES clause */ - -redefines_clause: - REDEFINES identifier_1 - { - check_repeated ("REDEFINES", SYN_CLAUSE_1, &check_pic_duplicate); - if (save_tree != NULL) { - cb_verify_x ($2, cb_free_redefines_position, - _("REDEFINES clause not following entry-name")); - } - - current_field->redefines = cb_resolve_redefines (current_field, $2); - if (current_field->redefines == NULL) { - current_field->flag_is_verified = 1; - current_field->flag_invalid = 1; - YYERROR; - } - } -; - - -/* SAME AS clause ("AS" optional with RM-COBOL, not with COBOL2002+) */ - -same_as_clause: - SAME _as identifier_field - { - cb_tree x = $3; - check_repeated ("SAME AS", SYN_CLAUSE_30, &check_pic_duplicate); - - /* note: syntax checks for conflicting clauses done in inherit_same_as */ - if (cb_verify (cb_same_as_clause, _("SAME AS clause")) - && x != cb_error_node) { - struct cb_field *f = CB_FIELD (cb_ref (x)); - if (f->storage == CB_STORAGE_SCREEN) { - cb_error (_("SCREEN item cannot be used here")); - x = cb_error_node; - } else if (f->storage == CB_STORAGE_REPORT) { - cb_error (_("REPORT item cannot be used here")); - x = cb_error_node; - } else if (f->level == 88) { - cb_error (_("condition-name not allowed here: '%s'"), cb_name (x)); - x = cb_error_node; - } else if (current_field->level == 77) { - if (f->children) { - cb_error (_("elementary item expected")); - x = cb_error_node; - } - } else { - struct cb_field *p; - for (p = current_field; p; p = p->parent) { - if (p == f) { - cb_error (_ ("SAME AS item may not reference itself")); - x = cb_error_node; - break; - } - } - for (p = f->parent; p; p = p->parent) { - if (p->usage != CB_USAGE_DISPLAY) { - cb_error (_("SAME AS item may not be subordinate to any item with USAGE clause")); - } else if (p->flag_sign_clause) { - cb_error (_("SAME AS item may not be subordinate to any item with SIGN clause")); - } else { - continue; - } - x = cb_error_node; - break; - } - } - } - - if (x == cb_error_node) { - current_field->flag_is_verified = 1; - current_field->flag_invalid = 1; - current_field->same_as = x; - } else { - current_field->same_as = cb_ref (x); - } - } -; - - -/* EXTERNAL clause */ - -external_clause: - _is EXTERNAL _as_extname - { - check_repeated ("EXTERNAL", SYN_CLAUSE_2, &check_pic_duplicate); - if (current_storage != CB_STORAGE_WORKING) { - cb_error (_("%s not allowed here"), "EXTERNAL"); - } else if (current_field->level != 1 && current_field->level != 77) { - cb_error (_("%s only allowed at 01/77 level"), "EXTERNAL"); - } else if (!qualifier) { - cb_error (_("%s requires a data name"), "EXTERNAL"); -#if 0 /* RXWRXW - Global/External */ - } else if (current_field->flag_is_global) { - cb_error (_("%s and %s are mutually exclusive"), "GLOBAL", "EXTERNAL"); -#endif - } else if (current_field->flag_item_based) { - cb_error (_("%s and %s are mutually exclusive"), "BASED", "EXTERNAL"); - } else if (current_field->redefines) { - cb_error (_("%s and %s are mutually exclusive"), "EXTERNAL", "REDEFINES"); - } else if (current_field->flag_occurs) { - cb_error (_("%s and %s are mutually exclusive"), "EXTERNAL", "OCCURS"); - } else { - current_field->flag_external = 1; - current_program->flag_has_external = 1; - } - } -; - -_as_extname: - /* empty */ - { - current_field->ename = cb_to_cname (current_field->name); - } -| AS LITERAL - { - current_field->ename = cb_to_cname ((const char *)CB_LITERAL ($2)->data); - } -; - -/* GLOBAL clause */ - -_global_clause: -| global_clause -; - -global_clause: - _is GLOBAL - { - check_repeated ("GLOBAL", SYN_CLAUSE_3, &check_pic_duplicate); - if (current_field->level != 1 && current_field->level != 77) { - cb_error (_("%s only allowed at 01/77 level"), "GLOBAL"); - } else if (!qualifier) { - cb_error (_("%s requires a data name"), "GLOBAL"); -#if 0 /* RXWRXW - Global/External */ - } else if (current_field->flag_external) { - cb_error (_("%s and %s are mutually exclusive"), "GLOBAL", "EXTERNAL"); -#endif - } else if (current_program->prog_type == COB_MODULE_TYPE_FUNCTION) { - cb_error (_("%s is invalid in a user FUNCTION"), "GLOBAL"); - } else if (current_storage == CB_STORAGE_LOCAL) { - cb_error (_("%s not allowed here"), "GLOBAL"); - } else { - current_field->flag_is_global = 1; - } - } -; - -/* SPECIAL-NAMES clause */ - -special_names_clause: - _is SPECIAL_NAMES - { - if (current_program->nested_level) { - cb_error (_("%s not allowed in nested programs"), "SPECIAL-NAMES"); - } else { - cb_verify (cb_special_names_clause, "SPECIAL-NAMES clause"); - } - } - special_names_target -; - -special_names_target: - CURSOR - { - if (current_program->cursor_pos) { - emit_duplicate_clause_message ("CURSOR"); - } else { - current_program->cursor_pos = cb_build_reference (current_field->name); - } - } -| CRT STATUS - { - if (current_program->crt_status) { - emit_duplicate_clause_message ("CRT STATUS"); - } else { - current_program->crt_status = cb_build_reference (current_field->name); - } - } -/* not included, possibly never will -| CHART STATUS - { - if (current_program->chart_status) { - emit_duplicate_clause_message ("CHART STATUS"); - } else { - current_program->chart_status = cb_build_reference (current_field->name); - } - } */ -| SCREEN_CONTROL - { -#if 0 /* not yet implemented */ - if (current_program->screen_control) { - emit_duplicate_clause_message ("SCREEN CONTROL"); - } else { - CB_PENDING ("SCREEN CONTROL"); - } -#else - CB_PENDING ("SCREEN CONTROL"); -#endif - } -| EVENT_STATUS - { -#if 0 /* not yet implemented */ - if (current_program->event_status) { - emit_duplicate_clause_message ("EVENT STATUS"); - } else { - CB_PENDING ("EVENT STATUS"); - } -#else - CB_PENDING ("EVENT STATUS"); -#endif - } -; - -/* VOLATILE clause */ - -volatile_clause: - VOLATILE - { - check_repeated ("VOLATILE", SYN_CLAUSE_24, &check_pic_duplicate); - /* note: there is no reason to check current_storage as we only parse - volatile_clause and its parent tokens where applicable, - same is true for level 66,78,88 */ - /* missing part: always generate and initialize storage */ - CB_UNFINISHED ("VOLATILE"); - current_field->flag_volatile = 1; - /* TODO: set VOLATILE flag for all parent fields */ - } -; - - -/* PICTURE clause */ - -picture_clause: - PICTURE /* token from scanner, includes full picture definition */ - _pic_locale_format - { - check_repeated ("PICTURE", SYN_CLAUSE_4, &check_pic_duplicate); - current_field->pic = CB_PICTURE ($1); - - if ($2 && $2 != cb_error_node) { - if ( (current_field->pic->category != CB_CATEGORY_NUMERIC - && current_field->pic->category != CB_CATEGORY_NUMERIC_EDITED) - || strpbrk (current_field->pic->orig, " CRDB-*") /* the standard seems to forbid also ',' */) { - cb_error_x ($1, _("a locale-format PICTURE string must only consist of '9', '.', '+', 'Z' and the currency-sign")); - } else { - /* TODO: check that not in or part of CONSTANT RECORD */ - CB_PENDING_X ($1, "locale-format PICTURE"); - } - } - } -; - -_pic_locale_format: - /* empty */ - { $$ = NULL; } -| LOCALE _is_locale_name SIZE _is integer - { - /* $2 -> optional locale-name to be used */ - $$ = $5; - } -; - -_is_locale_name: - /* empty */ -| _is locale_name - { - $$ = $2; - } -; - - -locale_name: - WORD - { - if (CB_LOCALE_NAME_P (cb_ref ($1))) { - $$ = $1; - } else { - cb_error_x ($1, _("'%s' is not a locale-name"), cb_name ($1)); - $$ = cb_error_node; - } - } -; - - -/* USAGE clause */ - -usage_clause: - usage -| USAGE _is usage -| USAGE _is WORD - { - if (is_reserved_word (CB_NAME ($3))) { - cb_error_x ($3, _("'%s' is not a valid USAGE"), CB_NAME ($3)); - } else if (is_default_reserved_word (CB_NAME ($3))) { - cb_error_x ($3, _("'%s' is not defined, but is a reserved word in another dialect"), - CB_NAME ($3)); - } else { - cb_error_x ($3, _("unknown USAGE: %s"), CB_NAME ($3)); - } - check_and_set_usage (CB_USAGE_ERROR); - YYERROR; - } -| USAGE _is error - { - check_and_set_usage (CB_USAGE_ERROR); - } -; - -usage: - BINARY - { - check_and_set_usage (CB_USAGE_BINARY); - } -| BIT - { - check_and_set_usage (CB_USAGE_BIT); - CB_PENDING ("USAGE BIT"); - } -| COMP - { - check_and_set_usage (CB_USAGE_BINARY); - } -| COMP_0 - { - /* see FR #310 */ - CB_PENDING ("USAGE COMP-0"); - } -| COMP_1 - { - current_field->flag_comp_1 = 1; - if (cb_binary_comp_1) { - check_and_set_usage (CB_USAGE_SIGNED_SHORT); - current_field->flag_synchronized = 1; - } else { - check_and_set_usage (CB_USAGE_FLOAT); - } - } -| double_usage - { - check_and_set_usage (CB_USAGE_DOUBLE); - } -| COMP_3 - { - check_and_set_usage (CB_USAGE_PACKED); - } -| COMP_4 - { - check_and_set_usage (CB_USAGE_BINARY); - } -| COMP_5 - { - check_and_set_usage (CB_USAGE_COMP_5); - } -| COMP_6 - { - check_and_set_usage (CB_USAGE_COMP_6); - } -| COMP_X - { - check_and_set_usage (CB_USAGE_COMP_X); - } -| COMP_N - { - check_and_set_usage (CB_USAGE_COMP_N); - } -| FLOAT_SHORT - { - check_and_set_usage (CB_USAGE_FLOAT); - } -| DISPLAY - { - check_and_set_usage (CB_USAGE_DISPLAY); - } -| INDEX - { - check_and_set_usage (CB_USAGE_INDEX); - } -| PACKED_DECIMAL - { - check_and_set_usage (CB_USAGE_PACKED); - } -| POINTER - { - check_and_set_usage (CB_USAGE_POINTER); - current_field->flag_is_pointer = 1; - } -| PROGRAM_POINTER - { - check_and_set_usage (CB_USAGE_PROGRAM_POINTER); - current_field->flag_is_pointer = 1; - } -| HANDLE - { - check_and_set_usage (CB_USAGE_HNDL); - } -| HANDLE _of WINDOW - { - check_and_set_usage (CB_USAGE_HNDL_WINDOW); - } -| HANDLE _of SUBWINDOW - { - check_and_set_usage (CB_USAGE_HNDL_SUBWINDOW); - } -| HANDLE _of FONT _font_name - { - check_and_set_usage (CB_USAGE_HNDL_FONT); - CB_PENDING ("HANDLE OF FONT"); - } -| HANDLE _of THREAD - { - check_and_set_usage (CB_USAGE_HNDL_THREAD); - } -| HANDLE _of MENU - { - check_and_set_usage (CB_USAGE_HNDL_MENU); - CB_PENDING ("HANDLE OF MENU"); - } -| HANDLE _of VARIANT - { - check_and_set_usage (CB_USAGE_HNDL_VARIANT); - } -| HANDLE _of LAYOUT_MANAGER _layout_name - { - check_and_set_usage (CB_USAGE_HNDL_LM); - CB_PENDING ("HANDLE OF LAYOUT-MANAGER"); - } -| HANDLE _of control_type_name - { - check_and_set_usage (CB_USAGE_HNDL); - CB_PENDING ("HANDLE OF control-type"); - } -| HANDLE _of WORD - { - check_and_set_usage (CB_USAGE_HNDL); - cb_error_x ($3, _("unknown HANDLE type: %s"), CB_NAME ($3)); - } -| SIGNED_SHORT - { - check_and_set_usage (CB_USAGE_SIGNED_SHORT); - current_field->flag_synchronized = 1; - } -| SIGNED_INT - { - check_and_set_usage (CB_USAGE_SIGNED_INT); - current_field->flag_synchronized = 1; - } -| SIGNED_LONG - { -#ifdef COB_32_BIT_LONG - check_and_set_usage (CB_USAGE_SIGNED_INT); -#else - check_and_set_usage (CB_USAGE_SIGNED_LONG); -#endif - current_field->flag_synchronized = 1; - } -| UNSIGNED_SHORT - { - check_and_set_usage (CB_USAGE_UNSIGNED_SHORT); - current_field->flag_synchronized = 1; - } -| UNSIGNED_INT - { - check_and_set_usage (CB_USAGE_UNSIGNED_INT); - current_field->flag_synchronized = 1; - } -| UNSIGNED_LONG - { -#ifdef COB_32_BIT_LONG - check_and_set_usage (CB_USAGE_UNSIGNED_INT); -#else - check_and_set_usage (CB_USAGE_UNSIGNED_LONG); -#endif - current_field->flag_synchronized = 1; - } -| BINARY_CHAR _signed - { - check_and_set_usage (CB_USAGE_SIGNED_CHAR); - } -| BINARY_CHAR UNSIGNED - { - check_and_set_usage (CB_USAGE_UNSIGNED_CHAR); - } -| BINARY_SHORT _signed - { - check_and_set_usage (CB_USAGE_SIGNED_SHORT); - } -| BINARY_SHORT UNSIGNED - { - check_and_set_usage (CB_USAGE_UNSIGNED_SHORT); - } -| BINARY_LONG _signed - { - check_and_set_usage (CB_USAGE_SIGNED_INT); - } -| BINARY_LONG UNSIGNED - { - check_and_set_usage (CB_USAGE_UNSIGNED_INT); - } -| BINARY_DOUBLE _signed - { - check_and_set_usage (CB_USAGE_SIGNED_LONG); - } -| BINARY_DOUBLE UNSIGNED - { - check_and_set_usage (CB_USAGE_UNSIGNED_LONG); - } -| BINARY_C_LONG _signed - { -#ifdef COB_32_BIT_LONG - check_and_set_usage (CB_USAGE_SIGNED_INT); -#else - check_and_set_usage (CB_USAGE_SIGNED_LONG); -#endif - current_field->flag_synchronized = 1; - } -| BINARY_C_LONG UNSIGNED - { -#ifdef COB_32_BIT_LONG - check_and_set_usage (CB_USAGE_UNSIGNED_INT); -#else - check_and_set_usage (CB_USAGE_UNSIGNED_LONG); -#endif - current_field->flag_synchronized = 1; - } -| FLOAT_BINARY_32 - { - check_and_set_usage (CB_USAGE_FP_BIN32); - } -| FLOAT_BINARY_64 - { - check_and_set_usage (CB_USAGE_FP_BIN64); - } -| FLOAT_BINARY_128 - { - check_and_set_usage (CB_USAGE_FP_BIN128); - } -| FLOAT_DECIMAL_16 - { - check_and_set_usage (CB_USAGE_FP_DEC64); - } -| FLOAT_DECIMAL_34 - { - check_and_set_usage (CB_USAGE_FP_DEC128); - } -| NATIONAL - { - check_repeated ("USAGE", SYN_CLAUSE_5, &check_pic_duplicate); - CB_UNFINISHED ("USAGE NATIONAL"); - } -; - -double_usage: - COMP_2 -| FLOAT_LONG /* alias from DOUBLE (ACU) in reserved.c */ -; - -_font_name: - /* empty */ -| DEFAULT_FONT -| FIXED_FONT -| TRADITIONAL_FONT -| SMALL_FONT -| MEDIUM_FONT -| LARGE_FONT -; - -_layout_name: - /* empty */ -| LM_RESIZE -; - -/* SIGN clause */ - -sign_clause: - _sign_is LEADING flag_separate - { - check_repeated ("SIGN", SYN_CLAUSE_6, &check_pic_duplicate); - current_field->flag_sign_clause = 1; - current_field->flag_sign_separate = ($3 ? 1 : 0); - current_field->flag_sign_leading = 1; - } -| _sign_is TRAILING flag_separate - { - check_repeated ("SIGN", SYN_CLAUSE_6, &check_pic_duplicate); - current_field->flag_sign_clause = 1; - current_field->flag_sign_separate = ($3 ? 1 : 0); - current_field->flag_sign_leading = 0; - } -; - - -/* REPORT (RD) OCCURS clause */ - -report_occurs_clause: - OCCURS integer _occurs_to_integer _times - _occurs_depending _occurs_step - { - /* most of the field attributes are set when parsing the phrases */; - setup_occurs (); - setup_occurs_min_max ($2, $3); - } -; - -_occurs_step: -| STEP integer - { - current_field->step_count = cb_get_int ($2); - } -; - -/* OCCURS clause */ - -occurs_clause: - OCCURS integer _occurs_to_integer _times - _occurs_depending _occurs_keys_and_indexed - { - /* most of the field attributes are set when parsing the phrases */; - setup_occurs (); - setup_occurs_min_max ($2, $3); - } -| OCCURS _occurs_integer_to UNBOUNDED _times - DEPENDING _on reference _occurs_keys_and_indexed - { - current_field->flag_unbounded = 1; - if (current_field->parent) { - current_field->parent->flag_unbounded = 1; - } - current_field->depending = $7; - /* most of the field attributes are set when parsing the phrases */; - setup_occurs (); - setup_occurs_min_max ($2, cb_int0); - } -| OCCURS DYNAMIC _capacity_in _occurs_from_integer - _occurs_to_integer _occurs_initialized _occurs_keys_and_indexed - { - setup_occurs (); - current_field->occurs_min = $4 ? cb_get_int ($4) : 0; - if ($5) { - current_field->occurs_max = cb_get_int ($5); - if (current_field->occurs_max <= current_field->occurs_min) { - cb_error (_("OCCURS TO must be greater than OCCURS FROM")); - } - } else { - current_field->occurs_max = 0; - } - CB_PENDING ("OCCURS DYNAMIC"); - } -; - -_occurs_to_integer: - /* empty */ { $$ = NULL; } -| TO integer { $$ = $2; } -; - -_occurs_from_integer: - /* empty */ { $$ = NULL; } -| FROM integer { $$ = $2; } -; - -_occurs_integer_to: - /* empty */ { $$ = NULL; } -| integer TO { $$ = $1; } -; - -_occurs_depending: -| DEPENDING _on reference - { - current_field->depending = $3; - } -; -_capacity_in: -| CAPACITY _in WORD - { - $$ = cb_build_index ($3, cb_zero, 0, current_field); - CB_FIELD_PTR ($$)->index_type = CB_STATIC_INT_INDEX; - } -; - -_occurs_initialized: -| INITIALIZED - { - /* current_field->initialized = 1; */ - } -; - -_occurs_keys_and_indexed: - /* empty */ -| occurs_keys occurs_indexed -| occurs_indexed - { - if (!cb_relaxed_syntax_checks) { - cb_error (_("INDEXED should follow ASCENDING/DESCENDING")); - } else { - cb_warning (cb_warn_extra, _("INDEXED should follow ASCENDING/DESCENDING")); - } - } - occurs_keys -| occurs_indexed -| occurs_keys -; - -occurs_keys: - occurs_key_list - { - if ($1) { - cb_tree l; - struct cb_key *keys; - int i; - int nkeys; - - l = $1; - nkeys = cb_list_length ($1); - keys = cobc_parse_malloc (sizeof (struct cb_key) * nkeys); - - for (i = 0; i < nkeys; i++) { - keys[i].dir = CB_PURPOSE_INT (l); - keys[i].key = CB_VALUE (l); - l = CB_CHAIN (l); - } - current_field->keys = keys; - current_field->nkeys = nkeys; - } - } -; - -occurs_key_list: - occurs_key_field -| occurs_key_field occurs_key_list -; - -occurs_key_field: - ascending_or_descending _key _is single_reference_list - { - cb_tree l, item; - struct cb_field *field; - - for (l = $4; l; l = CB_CHAIN (l)) { - CB_PURPOSE (l) = $1; - item = CB_VALUE (l); - if (item == cb_error_node) { - continue; - } - /* internally reference-modify each of the given keys */ - if (qualifier -#if 0 /* Simon: those are never reference-modified ... */ - && !CB_REFERENCE(item)->chain -#endif /* the following is perfectly fine and would raise a syntax error - if we add the self-reference */ - && strcasecmp (CB_NAME(item), CB_NAME(qualifier))) { - /* reference by the OCCURS item */ - CB_REFERENCE(item)->chain = qualifier; - } - /* reference all the way up as later fields may have same name */ - for (field = CB_FIELD(cb_ref(qualifier))->parent; field; field = field->parent) { - if (field->flag_filler) continue; - CB_REFERENCE(item)->chain = cb_build_reference(field->name); - } - } - keys_list = cb_list_append (keys_list, $4); - $$ = keys_list; - } -; - -ascending_or_descending: - ASCENDING { $$ = cb_int (COB_ASCENDING); } -| DESCENDING { $$ = cb_int (COB_DESCENDING); } -; - -_occurs_indexed: - /* empty */ -| occurs_indexed -; -occurs_indexed: - INDEXED _by occurs_index_list - { - current_field->index_list = $3; - } -; - -occurs_index_list: - occurs_index { $$ = CB_LIST_INIT ($1); } -| occurs_index_list - occurs_index { $$ = cb_list_add ($1, $2); } -; - -occurs_index: - unqualified_word - { - $$ = cb_build_index ($1, cb_int1, 1U, current_field); - CB_FIELD_PTR ($$)->index_type = CB_STATIC_INT_INDEX; - } -; - - -/* JUSTIFIED clause */ - -justified_clause: - JUSTIFIED _right - { - check_repeated ("JUSTIFIED", SYN_CLAUSE_8, &check_pic_duplicate); - current_field->flag_justified = 1; - } -; - - -/* SYNCHRONIZED clause */ - -synchronized_clause: - SYNCHRONIZED _left_or_right - { - check_repeated ("SYNCHRONIZED", SYN_CLAUSE_9, &check_pic_duplicate); - if (cb_verify (cb_synchronized_clause, _("SYNCHRONIZED clause"))) { - current_field->flag_synchronized = 1; - } - if (with_attrs && cb_verify (cb_sync_left_right, _("LEFT/RIGHT phrases in SYNCHRONIZED clause"))) { - if (current_field->flag_synchronized) { - if (with_attrs == 1) { - current_field->flag_sync_left = 1; - } else { - current_field->flag_sync_right = 1; - } - } - CB_PENDING ("SYNCHRONIZED LEFT/RIGHT"); - } - } -; - -_left_or_right: - /* empty */ { with_attrs = 0; } -| LEFT { with_attrs = 1; } -| RIGHT { with_attrs = -1; } -; - - -/* BLANK clause */ - -blank_clause: - BLANK _when ZERO - { - check_repeated ("BLANK", SYN_CLAUSE_10, &check_pic_duplicate); - current_field->flag_blank_zero = 1; - } -; - - -/* BASED clause */ - -based_clause: - BASED - { - check_repeated ("BASED", SYN_CLAUSE_11, &check_pic_duplicate); - if (current_storage == CB_STORAGE_FILE) { - cb_error (_("%s not allowed here"), "BASED"); - } else if (current_field->level != 1 && current_field->level != 77) { - cb_error (_("%s only allowed at 01/77 level"), "BASED"); - } else if (!qualifier) { - cb_error (_("%s requires a data name"), "BASED"); - } else if (current_field->flag_external) { - cb_error (_("%s and %s are mutually exclusive"), "BASED", "EXTERNAL"); - } else if (current_field->redefines) { - cb_error (_("%s and %s are mutually exclusive"), "BASED", "REDEFINES"); - } else if (current_field->flag_any_length) { - cb_error (_("%s and %s are mutually exclusive"), "BASED", "ANY LENGTH"); - } else if (current_field->flag_occurs) { - cb_error (_("%s and %s are mutually exclusive"), "BASED", "OCCURS"); - } else { - current_field->flag_item_based = 1; - } - } -; - -/* VALUE clause */ - -value_clause: - VALUE _is_are value_item_list - { - check_repeated ("VALUE", SYN_CLAUSE_12, &check_pic_duplicate); - current_field->values = $3; - } - _false_is -; - -value_item_list: - value_item { $$ = CB_LIST_INIT ($1); } -| value_item_list value_item { $$ = cb_list_add ($1, $2); } -; - -value_item: - lit_or_length THRU lit_or_length { $$ = CB_BUILD_PAIR ($1, $3); } -| constant_expression -; - -_false_is: - /* empty */ -| _when_set_to TOK_FALSE _is lit_or_length - { - if (current_field->level != 88) { - cb_error (_("FALSE clause only allowed for 88 level")); - } - current_field->false_88 = CB_LIST_INIT ($4); - } -; - -/* ANY LENGTH clause */ - -any_length_clause: - ANY LENGTH - { - check_repeated ("ANY", SYN_CLAUSE_14, &check_pic_duplicate); - if (current_field->flag_item_based) { - cb_error (_("%s and %s are mutually exclusive"), "BASED", "ANY LENGTH"); - } else { - current_field->flag_any_length = 1; - } - } -| ANY NUMERIC - { - check_repeated ("ANY", SYN_CLAUSE_14, &check_pic_duplicate); - if (current_field->flag_item_based) { - cb_error (_("%s and %s are mutually exclusive"), "BASED", "ANY NUMERIC"); - } else { - current_field->flag_any_length = 1; - current_field->flag_any_numeric = 1; - } - } -; - -/* EXTERNAL-FORM clause */ - -external_form_clause: - _is EXTERNAL_FORM - { - check_repeated ("EXTERNAL-FORM", SYN_CLAUSE_2, &check_pic_duplicate); - CB_PENDING ("EXTERNAL-FORM"); - if (current_storage != CB_STORAGE_WORKING) { - cb_error (_("%s not allowed here"), "EXTERNAL-FORM"); - } else if (current_field->level != 1) { /* docs say: at group level */ - cb_error (_("%s only allowed at 01 level"), "EXTERNAL-FORM"); - } else if (!qualifier) { - cb_error (_("%s requires a data name"), "EXTERNAL-FORM"); - } else if (current_field->redefines) { - cb_error (_("%s and %s combination not allowed"), "EXTERNAL-FORM", "REDEFINES"); - } else { - current_field->flag_is_external_form = 1; - } - } -; - -/* IDENTIFIED BY clause */ - -identified_by_clause: - /* minimal glitch: IS should only be usable if EXTERNAL-FORM comes directly before */ - /* glitch: EXTERNAL-FORM clause can come after IDENTIFIED BY clause */ - _is IDENTIFIED _by id_or_lit - { - check_repeated ("IDENTIFIED BY", SYN_CLAUSE_3, &check_pic_duplicate); - if (!current_field->flag_is_external_form) { - CB_PENDING ("EXTERNAL-FORM (IDENTIFIED BY)"); - if (current_storage != CB_STORAGE_WORKING) { - cb_error (_("%s not allowed here"), "IDENTIFIED BY"); - } else if (!qualifier) { - cb_error (_("%s requires a data name"), "IDENTIFIED BY"); - } else if (current_field->redefines) { - cb_error (_("%s and %s combination not allowed"), "IDENTIFIED BY", "REDEFINES"); - } - } - current_field->external_form_identifier = $4; - } -; - -/* LOCAL-STORAGE SECTION */ - -_local_storage_section: -| LOCAL_STORAGE SECTION TOK_DOT - { - check_headers_present (COBC_HD_DATA_DIVISION, 0, 0, 0); - header_check |= COBC_HD_LOCAL_STORAGE_SECTION; - current_storage = CB_STORAGE_LOCAL; - if (current_program->nested_level) { - cb_error (_("%s not allowed in nested programs"), "LOCAL-STORAGE"); - } - } - _record_description_list - { - if ($5) { - current_program->local_storage = CB_FIELD ($5); - } - } -; - - -/* LINKAGE SECTION */ - -_linkage_section: -| LINKAGE SECTION TOK_DOT - { - check_headers_present (COBC_HD_DATA_DIVISION, 0, 0, 0); - header_check |= COBC_HD_LINKAGE_SECTION; - current_storage = CB_STORAGE_LINKAGE; - } - _record_description_list - { - if ($5) { - current_program->linkage_storage = CB_FIELD ($5); - } - } -; - -/* REPORT SECTION */ - -_report_section: -| REPORT SECTION TOK_DOT - { - header_check |= COBC_HD_REPORT_SECTION; - current_storage = CB_STORAGE_REPORT; - description_field = NULL; - current_program->flag_report = 1; - cb_clear_real_field (); - } - _report_description_sequence -; - -_report_description_sequence: -| _report_description_sequence report_description -; - -/* RD report description */ - -report_description: - RD report_name - { - if (CB_INVALID_TREE ($2)) { - YYERROR; - } else { - current_field = NULL; - control_field = NULL; - description_field = NULL; - current_report = CB_REPORT_PTR ($2); - } - check_duplicate = 0; - } - _report_description_options TOK_DOT - _report_group_description_list - { - struct cb_field *p; - - for (p = description_field; p; p = p->sister) { - cb_validate_field (p); - } - current_program->report_storage = description_field; - current_program->flag_report = 1; - if (current_report->records == NULL) { - current_report->records = description_field; - } - finalize_report (current_report, description_field); - $$ = CB_TREE (description_field); - } -; - -_report_description_options: -| _report_description_options report_description_option -| error TOK_DOT - { - yyerrok; - } -; - -report_description_option: - _is GLOBAL - { - check_repeated ("GLOBAL", SYN_CLAUSE_1, &check_duplicate); - current_report->global = 1; - cb_error (_("GLOBAL is not allowed with RD")); - } -| _with CODE _is id_or_lit - { - check_repeated ("CODE", SYN_CLAUSE_2, &check_duplicate); - current_report->code_clause = $4; - } -| control_clause -| page_limit_clause -; - -/* REPORT control breaks */ - -control_clause: - control_keyword control_field_list - { - check_repeated ("CONTROL", SYN_CLAUSE_3, &check_duplicate); - } -; - -control_field_list: - control_final_tag control_identifier_list -| control_final_tag -| control_identifier_list -; - -control_final_tag: - FINAL - { - current_report->control_final = 1; - } -; - -control_identifier_list: - control_identifier -| control_identifier_list control_identifier -; - -control_identifier: - identifier - { - /* Add field to current control list */ - CB_ADD_TO_CHAIN ($1, current_report->controls); - } -; - -/* PAGE LIMIT clause */ - -page_limit_clause: - PAGE _limits page_line_column - _page_heading_list - { - check_repeated ("PAGE", SYN_CLAUSE_4, &check_duplicate); - if (!current_report->heading) { - current_report->heading = 1; - } - if (!current_report->first_detail) { - current_report->first_detail = current_report->heading; - } - if (!current_report->last_control) { - if (current_report->last_detail) { - current_report->last_control = current_report->last_detail; - } else if (current_report->footing) { - current_report->last_control = current_report->footing; - } else { - current_report->last_control = current_report->lines; - } - if (current_report->t_last_detail) { - current_report->t_last_control = current_report->t_last_detail; - } else if (current_report->t_footing) { - current_report->t_last_control = current_report->t_footing; - } else if(current_report->t_lines) { - current_report->t_last_control = current_report->t_lines; - } - } - if (!current_report->last_detail && !current_report->footing) { - current_report->last_detail = current_report->lines; - current_report->footing = current_report->lines; - } else if (!current_report->last_detail) { - current_report->last_detail = current_report->footing; - } else if (!current_report->footing) { - current_report->footing = current_report->last_detail; - } - /* PAGE LIMIT values checked in finalize_report in typeck.c */ - } -; - -page_line_column: - integer_or_zero_or_ident _line_or_lines - { - if (CB_LITERAL_P ($1)) { - current_report->lines = cb_get_int ($1); - if (current_report->lines > 999) { - cb_error ("PAGE LIMIT lines > 999"); - } - } else { - current_report->t_lines = $1; - } - } -| page_limit_cols -| integer_or_zero_or_ident line_or_lines page_limit_cols - { - if (CB_LITERAL_P ($1)) { - current_report->lines = cb_get_int ($1); - if (current_report->lines > 999) { - cb_error ("PAGE LIMIT lines > 999"); - } - } else { - current_report->t_lines = $1; - } - } -; - -page_limit_cols: - integer_or_zero_or_ident columns_or_cols - { - /* may be repeated later by page detail */ - check_repeated ("LINE LIMIT", SYN_CLAUSE_5, &check_duplicate); - if (CB_LITERAL_P ($1)) { - current_report->columns = cb_get_int ($1); - } else { - current_report->t_columns = $1; - } - } -; - -integer_or_zero_or_ident: - integer_or_zero -| identifier -; - -_page_heading_list: -| _page_heading_list page_detail -; - - -page_detail: - heading_clause -| first_detail -| last_heading -| last_detail -| footing_clause -| LINE_LIMIT _is integer_or_zero_or_ident - { - check_repeated ("LINE LIMIT", SYN_CLAUSE_5, &check_duplicate); - if (CB_LITERAL_P ($3)) { - current_report->columns = cb_get_int ($3); - } else { - current_report->t_columns = $3; - } - } -; - -heading_clause: - HEADING _is integer_or_zero_or_ident - { - check_repeated ("HEADING", SYN_CLAUSE_6, &check_duplicate); - error_if_no_page_lines_limit ("HEADING"); - - if (CB_LITERAL_P ($3)) { - current_report->heading = cb_get_int ($3); - } else { - current_report->t_heading = $3; - } - } -; - -first_detail: - FIRST detail_keyword _is integer_or_zero_or_ident - { - check_repeated ("FIRST DETAIL", SYN_CLAUSE_7, &check_duplicate); - error_if_no_page_lines_limit ("FIRST DETAIL"); - - if (CB_LITERAL_P ($4)) { - current_report->first_detail = cb_get_int ($4); - } else { - current_report->t_first_detail = $4; - } - } -; - -last_heading: - LAST ch_keyword _is integer_or_zero_or_ident - { - check_repeated ("LAST CONTROL HEADING", SYN_CLAUSE_8, &check_duplicate); - error_if_no_page_lines_limit ("LAST CONTROL HEADING"); - - if (CB_LITERAL_P ($4)) { - current_report->last_control = cb_get_int ($4); - } else { - current_report->t_last_control = $4; - } - } -; - -last_detail: - LAST detail_keyword _is integer_or_zero_or_ident - { - check_repeated ("LAST DETAIL", SYN_CLAUSE_9, &check_duplicate); - error_if_no_page_lines_limit ("LAST DETAIL"); - - if (CB_LITERAL_P ($4)) { - current_report->last_detail = cb_get_int ($4); - } else { - current_report->t_last_detail = $4; - } - } -; - -footing_clause: - FOOTING _is integer_or_zero_or_ident - { - check_repeated ("FOOTING", SYN_CLAUSE_10, &check_duplicate); - error_if_no_page_lines_limit ("FOOTING"); - - if (CB_LITERAL_P ($3)) { - current_report->footing = cb_get_int ($3); - } else { - current_report->t_footing = $3; - } - } -; - -_report_group_description_list: -| _report_group_description_list report_group_description_entry -; - -report_group_description_entry: - level_number _entry_name - { - if (set_current_field($1, $2)) { - YYERROR; - } - if (!description_field) { - description_field = current_field; - } - } - _report_group_options TOK_DOT -| level_number error TOK_DOT - { - /* Free tree associated with level number */ - cobc_parse_free ($1); - cb_unput_dot (); - yyerrok; - check_pic_duplicate = 0; - check_duplicate = 0; - current_field = cb_get_real_field (); - } -; - -_report_group_options: -| _report_group_options report_group_option -; - -report_group_option: - type_clause -| next_group_clause -| line_clause -| picture_clause -| usage_clause -| sign_clause -| justified_clause -| column_clause -| blank_clause -| source_clause -| sum_clause_list -| value_clause -| present_when_condition -| group_indicate_clause -| report_occurs_clause -| report_varying_clause -; - -type_clause: - TYPE _is type_option - { - check_repeated ("TYPE", SYN_CLAUSE_16, &check_pic_duplicate); - } -; - -type_option: - rh_keyword - { - current_field->report_flag |= COB_REPORT_HEADING; - } -| ph_keyword - { - current_field->report_flag |= COB_REPORT_PAGE_HEADING; - } -| ch_keyword _on_for _control_heading_final -| cf_keyword _on_for _control_footing_final -| detail_keyword - { - if (current_report != NULL) { - current_report->has_detail = 1; - } - current_field->report_flag |= COB_REPORT_DETAIL; - } -| pf_keyword - { - current_field->report_flag |= COB_REPORT_PAGE_FOOTING; - } -| rf_keyword - { - current_field->report_flag |= COB_REPORT_FOOTING; - } -; - -_control_heading_final: - /* empty */ - { - current_field->report_flag |= COB_REPORT_CONTROL_HEADING; - } -| identifier _or_page - { - current_field->report_flag |= COB_REPORT_CONTROL_HEADING; - current_field->report_control = $1; - if ($2) { - current_field->report_flag |= COB_REPORT_PAGE; - } - } -| FINAL _or_page - { - current_field->report_flag |= COB_REPORT_CONTROL_HEADING_FINAL; - } -; - -/* TODO: check where this should be allowed - and what results are expected */ - -_or_page: - /* empty */ {$$ = NULL;} -| OR PAGE {$$ = cb_int0;} -; - -_control_footing_final: - /* empty */ - { - current_field->report_flag |= COB_REPORT_CONTROL_FOOTING; - } -| identifier _or_page - { - current_field->report_flag |= COB_REPORT_CONTROL_FOOTING; - current_field->report_control = $1; - } -| FINAL _or_page - { - current_field->report_flag |= COB_REPORT_CONTROL_FOOTING_FINAL; - } -| ALL - { - current_field->report_flag |= COB_REPORT_CONTROL_FOOTING; - current_field->report_flag |= COB_REPORT_ALL; - } -; - -next_group_clause: - NEXT_GROUP _is next_group_plus - { - check_repeated ("NEXT GROUP", SYN_CLAUSE_17, &check_pic_duplicate); - } -; - -next_group_plus: - integer - { - if (CB_LITERAL_P($1) && CB_LITERAL ($1)->sign > 0) { - current_field->report_flag |= COB_REPORT_NEXT_GROUP_PLUS; - } else { - current_field->report_flag |= COB_REPORT_NEXT_GROUP_LINE; - } - current_field->next_group_line = cb_get_int ($1); - } -| plus integer - { - current_field->report_flag |= COB_REPORT_NEXT_GROUP_PLUS; - current_field->next_group_line = cb_get_int($2); - } -| next_page - { - current_field->report_flag |= COB_REPORT_NEXT_GROUP_PAGE; - } -; - -next_page: - NEXT_PAGE -| PAGE -| NEXT -; - -sum_clause_list: - SUM _of report_x_list _reset_clause - { - check_repeated ("SUM", SYN_CLAUSE_19, &check_pic_duplicate); - current_field->report_sum_list = $3; - build_sum_counter (current_report, current_field); - } -; - -_reset_clause: -| RESET _on data_or_final -| UPON identifier - { - current_field->report_sum_upon = $2; - } -; - -data_or_final: - identifier - { - current_field->report_reset = $1; - } -| FINAL - { - current_field->report_flag |= COB_REPORT_RESET_FINAL; - } -; - -present_when_condition: - present_absent WHEN condition - { - check_repeated ("PRESENT", SYN_CLAUSE_20, &check_pic_duplicate); - current_field->report_when = $3; - } -| present_absent AFTER _new _page_or_id - { - check_repeated ("PRESENT", SYN_CLAUSE_20, &check_pic_duplicate); - current_field->report_flag |= COB_REPORT_PRESENT; - current_field->report_flag &= ~COB_REPORT_BEFORE; - } -| present_absent JUSTIFIED AFTER _new PAGE - { - check_repeated ("PRESENT", SYN_CLAUSE_20, &check_pic_duplicate); - current_field->report_flag |= COB_REPORT_PRESENT; - current_field->report_flag &= ~COB_REPORT_BEFORE; - current_field->report_flag |= COB_REPORT_PAGE; - } -| present_absent BEFORE _new _page_or_id - { - check_repeated ("PRESENT", SYN_CLAUSE_20, &check_pic_duplicate); - current_field->report_flag |= COB_REPORT_PRESENT; - current_field->report_flag |= COB_REPORT_BEFORE; - } -| present_absent JUSTIFIED BEFORE _new PAGE - { - check_repeated ("PRESENT", SYN_CLAUSE_20, &check_pic_duplicate); - current_field->report_flag |= COB_REPORT_PRESENT; - current_field->report_flag |= COB_REPORT_BEFORE; - current_field->report_flag |= COB_REPORT_PAGE; - } -; - -present_absent: - PRESENT - { - current_field->report_flag |= COB_REPORT_PRESENT; - } -| ABSENT - { - current_field->report_flag |= COB_REPORT_PRESENT; - current_field->report_flag |= COB_REPORT_NEGATE; - } -; - -_page_or_id: - /* empty */ -| page_or_ids _page_or_id -; - -page_or_ids: - PAGE - { - current_field->report_flag |= COB_REPORT_PAGE; - } -| identifier - { - current_field->report_control = $1; - } -| OR -; - -report_varying_clause: - VARYING identifier FROM arith_x BY arith_x - { - CB_PENDING ("RW VARYING clause"); - } -; - -line_clause: - line_keyword_clause _line_clause_options - { - check_repeated ("LINE", SYN_CLAUSE_21, &check_pic_duplicate); - current_field->report_flag |= COB_REPORT_LINE; - } -; - -line_keyword_clause: - LINE _number_or_numbers _is_are -| LINES _are -; - -_line_clause_options: - /* empty */ -| line_clause_option _line_clause_options -; - -line_clause_option: - NEXT_PAGE /* token contains optional ON */ - { - current_field->report_flag |= COB_REPORT_LINE_NEXT_PAGE; - } -| _plus integer_or_zero - { - current_field->report_line = cb_get_int ($2); - if ((CB_LITERAL_P($2) && CB_LITERAL ($2)->sign > 0)) { - current_field->report_flag |= COB_REPORT_LINE_PLUS; - } - if ($1) { - current_field->report_flag |= COB_REPORT_LINE_PLUS; - if (current_field->report_line == 0) { - CB_PENDING ("LINE PLUS 0"); - } - } - } -; - - -column_clause: - col_keyword_clause col_or_plus - { - check_repeated ("COLUMN", SYN_CLAUSE_18, &check_pic_duplicate); - if((current_field->report_flag & (COB_REPORT_COLUMN_LEFT|COB_REPORT_COLUMN_RIGHT|COB_REPORT_COLUMN_CENTER)) - && (current_field->report_flag & COB_REPORT_COLUMN_PLUS)) { - if (cb_relaxed_syntax_checks) { - cb_warning (COBC_WARN_FILLER, _("PLUS is not recommended with LEFT, RIGHT or CENTER")); - } else { - cb_error (_("PLUS is not allowed with LEFT, RIGHT or CENTER")); - } - } - } -; - -col_keyword_clause: - column_or_cols _number_or_numbers _orientation _is_are -; - -_orientation: - /* empty */ -| _left_right_center -; - -_left_right_center: - LEFT - { - current_field->report_flag |= COB_REPORT_COLUMN_LEFT; - } -| RIGHT - { - current_field->report_flag |= COB_REPORT_COLUMN_RIGHT; - } -| CENTER - { - current_field->report_flag |= COB_REPORT_COLUMN_CENTER; - } -; - -col_or_plus: - plus integer_or_zero - { - int colnum = cb_get_int ($2); - if (colnum != 0) { - if (current_field->parent - && current_field->parent->children == current_field) { - cb_warning (COBC_WARN_FILLER, _("PLUS is ignored on first field of line")); - if (current_field->step_count == 0) - current_field->step_count = colnum; - } else { - current_field->report_flag |= COB_REPORT_COLUMN_PLUS; - } - } else { - colnum = 0; - } - if (current_field->report_column == 0) { - current_field->report_column = colnum; - } - current_field->report_num_col++; - } -| column_integer_list -; - -column_integer_list: - column_integer -| column_integer column_integer_list -; - -column_integer: - integer - { - int colnum; - colnum = cb_get_int ($1); - if (CB_LITERAL_P($1) && CB_LITERAL ($1)->sign > 0) { - if(current_field->parent - && current_field->parent->children == current_field) { - cb_warning (COBC_WARN_FILLER,_("PLUS is ignored on first field of line")); - } else { - current_field->report_flag |= COB_REPORT_COLUMN_PLUS; - } - } - if (colnum < 0) { - /* already handled by integer check */ - } else if (colnum == 0) { - cb_error (_("invalid COLUMN integer; must be > 0")); - } else if (colnum <= current_field->report_column) { - cb_warning (COBC_WARN_FILLER, _("COLUMN numbers should increase")); - } - current_field->report_column_list = - cb_list_append (current_field->report_column_list, CB_LIST_INIT ($1)); - if (current_field->report_column == 0) { - current_field->report_column = colnum; - } - current_field->report_num_col++; - } -; - -source_clause: - SOURCE _is arith_x flag_rounded - { - check_repeated ("SOURCE", SYN_CLAUSE_22, &check_pic_duplicate); - current_field->report_source = $3; - } -; - -group_indicate_clause: - GROUP _indicate - { - check_repeated ("GROUP", SYN_CLAUSE_23, &check_pic_duplicate); - current_field->report_flag |= COB_REPORT_GROUP_INDICATE; - } -; - -/* SCREEN SECTION */ - -_screen_section: -| SCREEN SECTION TOK_DOT - { - cobc_cs_check = CB_CS_SCREEN; - current_storage = CB_STORAGE_SCREEN; - current_field = NULL; - description_field = NULL; - cb_clear_real_field (); - } - _screen_description_list - { - struct cb_field *p; - - if (description_field) { - for (p = description_field; p; p = p->sister) { - cb_validate_field (p); - } - current_program->screen_storage = description_field; - current_program->flag_screen = 1; - } - cobc_cs_check = 0; - } -; - -_screen_description_list: -| screen_description_list -; - -screen_description_list: - screen_description TOK_DOT -| screen_description_list screen_description TOK_DOT -; - -screen_description: - constant_entry - /* normal screen definition */ -| level_number _entry_name - { - if (set_current_field ($1, $2)) { - YYERROR; - } - if (current_field->parent) { - current_field->screen_foreg = current_field->parent->screen_foreg; - current_field->screen_backg = current_field->parent->screen_backg; - current_field->screen_prompt = current_field->parent->screen_prompt; - } - } - _screen_options - { - cob_flags_t flags; - - if (current_field->parent) { - flags = current_field->parent->screen_flag; - flags &= ~COB_SCREEN_BLANK_LINE; - flags &= ~COB_SCREEN_BLANK_SCREEN; - flags &= ~COB_SCREEN_ERASE_EOL; - flags &= ~COB_SCREEN_ERASE_EOS; - flags &= ~COB_SCREEN_LINE_PLUS; - flags &= ~COB_SCREEN_LINE_MINUS; - flags &= ~COB_SCREEN_COLUMN_PLUS; - flags &= ~COB_SCREEN_COLUMN_MINUS; - - flags = zero_conflicting_flags (current_field->screen_flag, - flags); - - current_field->screen_flag |= flags; - } - - if (current_field->screen_flag & COB_SCREEN_INITIAL) { - if (!(current_field->screen_flag & COB_SCREEN_INPUT)) { - cb_error (_("INITIAL specified on non-input field")); - } - } - if (!qualifier) { - current_field->flag_filler = 1; - } - - if (!description_field) { - description_field = current_field; - } - if (current_field->flag_occurs - && !has_relative_pos (current_field)) { - cb_error (_("relative LINE/COLUMN clause required with OCCURS")); - } - } - /* ACUCOBOL-GT control definition */ -| level_number _entry_name - { - if (set_current_field ($1, $2)) { - YYERROR; - } - - if (current_field->parent) { - current_field->screen_foreg = current_field->parent->screen_foreg; - current_field->screen_backg = current_field->parent->screen_backg; - current_field->screen_prompt = current_field->parent->screen_prompt; - } - } - control_definition - { - CB_PENDING ("GRAPHICAL CONTROL"); - current_field->usage = CB_USAGE_CONTROL; - } - _control_attributes_and_screen_options - { - cob_flags_t flags; - - if (current_field->parent) { - flags = current_field->parent->screen_flag; - flags &= ~COB_SCREEN_BLANK_LINE; - flags &= ~COB_SCREEN_BLANK_SCREEN; - flags &= ~COB_SCREEN_ERASE_EOL; - flags &= ~COB_SCREEN_ERASE_EOS; - flags &= ~COB_SCREEN_LINE_PLUS; - flags &= ~COB_SCREEN_LINE_MINUS; - flags &= ~COB_SCREEN_COLUMN_PLUS; - flags &= ~COB_SCREEN_COLUMN_MINUS; - - flags = zero_conflicting_flags (current_field->screen_flag, - flags); - - current_field->screen_flag |= flags; - } - - if (current_field->screen_flag & COB_SCREEN_INITIAL) { - if (!(current_field->screen_flag & COB_SCREEN_INPUT)) { - cb_error (_("INITIAL specified on non-input field")); - } - } - if (!qualifier) { - current_field->flag_filler = 1; - } - - if (!description_field) { - description_field = current_field; - } - if (current_field->flag_occurs - && !has_relative_pos (current_field)) { - cb_error (_("relative LINE/COLUMN clause required with OCCURS")); - } - cobc_cs_check = CB_CS_SCREEN; - } - /* entry for error recovery */ -| level_number error TOK_DOT - { - /* - Tree associated with level number has already been freed; we don't - need to do anything here. - */ - yyerrok; - cb_unput_dot (); - check_pic_duplicate = 0; - check_duplicate = 0; -#if 1 /* RXWRXW Screen field */ - if (current_field) { - current_field->flag_is_verified = 1; - current_field->flag_invalid = 1; - } -#endif - current_field = cb_get_real_field (); - } -; - -_screen_options: - /* empty */ -| _screen_options screen_option -; - -screen_option: - BLANK LINE - { - set_screen_attr_with_conflict ("BLANK LINE", COB_SCREEN_BLANK_LINE, - "BLANK SCREEN", COB_SCREEN_BLANK_SCREEN); - } -| BLANK SCREEN /* FIXME: this SCREEN is optional! */ - { - set_screen_attr_with_conflict ("BLANK SCREEN", COB_SCREEN_BLANK_SCREEN, - "BLANK LINE", COB_SCREEN_BLANK_LINE); - } -| BELL - { - set_screen_attr ("BELL", COB_SCREEN_BELL); - } -| BLINK - { - set_screen_attr ("BLINK", COB_SCREEN_BLINK); - } -| ERASE eol - { - set_screen_attr_with_conflict ("ERASE EOL", COB_SCREEN_ERASE_EOL, - "ERASE EOS", COB_SCREEN_ERASE_EOS); - } -| ERASE eos - { - set_screen_attr_with_conflict ("ERASE EOS", COB_SCREEN_ERASE_EOS, - "ERASE EOL", COB_SCREEN_ERASE_EOL); - } -| HIGHLIGHT - { - set_screen_attr_with_conflict ("HIGHLIGHT", COB_SCREEN_HIGHLIGHT, - "LOWLIGHT", COB_SCREEN_LOWLIGHT); - } -| LOWLIGHT - { - set_screen_attr_with_conflict ("LOWLIGHT", COB_SCREEN_LOWLIGHT, - "HIGHLIGHT", COB_SCREEN_HIGHLIGHT); - } -| STANDARD /* ACU extension to reset a group HIGH/LOW */ - { - CB_PENDING ("STANDARD intensity"); -#if 0 /* in general we could simply remove high/low, but for syntax checks - we still need a flag */ - set_screen_attr_with_conflict ("LOWLIGHT", COB_SCREEN_LOWLIGHT, - "HIGHLIGHT", COB_SCREEN_HIGHLIGHT); -#endif - } -| BACKGROUND_HIGH - { - CB_PENDING ("BACKGROUND intensity"); - } -| BACKGROUND_LOW - { - CB_PENDING ("BACKGROUND intensity"); - } -| BACKGROUND_STANDARD - { - CB_PENDING ("BACKGROUND intensity"); - } -| reverse_video - { - set_screen_attr ("REVERSE-VIDEO", COB_SCREEN_REVERSE); - } -| SIZE _is_equal integer - { - /* set_screen_attr ("SIZE", COB_SCREEN_SIZE); */ - CB_PENDING ("SIZE clause"); - current_field->size = cb_get_int ($3); - } -| SIZE _is_equal numeric_identifier - { - CB_PENDING (_("screen positions from data-item")); - } -| CSIZE _is_equal numeric_identifier - { - CB_PENDING (_("screen positions from data-item")); - CB_PENDING ("SIZE clause"); - } -| CSIZE _is_equal integer - { - /* set_screen_attr ("SIZE", COB_SCREEN_SIZE); */ - CB_PENDING ("SIZE clause"); - current_field->size = cb_get_int ($3); - } -| UNDERLINE - { - set_screen_attr ("UNDERLINE", COB_SCREEN_UNDERLINE); - } -| OVERLINE - { - set_screen_attr ("OVERLINE", COB_SCREEN_OVERLINE); - CB_PENDING ("OVERLINE"); - } -| GRID - { - set_screen_attr ("GRID", COB_SCREEN_GRID); - CB_PENDING ("GRID"); - } -| LEFTLINE - { - set_screen_attr ("LEFTLINE", COB_SCREEN_LEFTLINE); - CB_PENDING ("LEFTLINE"); - } -| AUTO - { - set_screen_attr_with_conflict ("AUTO", COB_SCREEN_AUTO, - "TAB", COB_SCREEN_TAB); - } -| TAB - { - set_screen_attr_with_conflict ("TAB", COB_SCREEN_TAB, - "AUTO", COB_SCREEN_AUTO); - } -| SECURE - { - set_screen_attr_with_conflict ("SECURE", COB_SCREEN_SECURE, - "NO-ECHO", COB_SCREEN_NO_ECHO); - } -| no_echo - { - if (cb_no_echo_means_secure) { - set_screen_attr ("SECURE", COB_SCREEN_SECURE); - } else { - set_screen_attr_with_conflict ("NO-ECHO", COB_SCREEN_NO_ECHO, - "SECURE", COB_SCREEN_SECURE); - } - } -| REQUIRED - { - set_screen_attr ("REQUIRED", COB_SCREEN_REQUIRED); - } -| FULL - { - set_screen_attr ("FULL", COB_SCREEN_FULL); - } -| PROMPT CHARACTER _is id_or_lit - { - set_screen_attr ("PROMPT", COB_SCREEN_PROMPT); - current_field->screen_prompt = $4; - } -| PROMPT - { - set_screen_attr ("PROMPT", COB_SCREEN_PROMPT); - } -| TOK_INITIAL - { - set_screen_attr ("INITIAL", COB_SCREEN_INITIAL); - } -| LINE screen_line_number - { - check_repeated ("LINE", SYN_CLAUSE_16, &check_pic_duplicate); - } -| LINES _is_equal control_size - { - CB_PENDING ("LINES clause"); /* note: should only occur with controls */ - } -| CLINE screen_line_number - { - /*check_repeated ("CLINE", SYN_CLAUSE_5000, &check_pic_duplicate);*/ - } -| column_or_col_or_position_or_pos screen_col_number - { - check_repeated ("COLUMN", SYN_CLAUSE_17, &check_pic_duplicate); - } -| CCOL screen_col_number - { - /*check_repeated ("CCOL", SYN_CLAUSE_5001, &check_pic_duplicate);*/ - } -| COLOR _is num_id_or_lit - { -#if 0 /* TODO: implement, and add reverse to BACKGROUND/FOREGROUND-COLOR */ - check_repeated ("COLOR", SYN_CLAUSE_19, &check_pic_duplicate); - set_screen_attr_with_conflict ("COLOR", COB_SCREEN_COLOR, - "BACKGROUND-COLOR", COB_SCREEN_BACKGROUND_COLOR); - set_screen_attr_with_conflict ("COLOR", COB_SCREEN_COLOR, - "FOREGROUND-COLOR", FOREGROUND_COLOR); -#endif - CB_PENDING ("COLOR clause"); - } -| FOREGROUND_COLOR _is num_id_or_lit - { - check_repeated ("FOREGROUND-COLOR", SYN_CLAUSE_18, &check_pic_duplicate); - current_field->screen_foreg = $3; - } -| BACKGROUND_COLOR _is num_id_or_lit - { - check_repeated ("BACKGROUND-COLOR", SYN_CLAUSE_19, &check_pic_duplicate); - current_field->screen_backg = $3; - } -| usage_clause -| blank_clause -| screen_global_clause -| justified_clause -| sign_clause -| value_clause -| picture_clause -| screen_occurs_clause -| USING identifier - { - $$ = check_not_88_level ($2); - - check_repeated ("USING", SYN_CLAUSE_20, &check_pic_duplicate); - current_field->screen_from = $$; - current_field->screen_to = $$; - current_field->screen_flag |= COB_SCREEN_INPUT; - } -| FROM from_parameter - { - check_repeated ("FROM", SYN_CLAUSE_21, &check_pic_duplicate); - current_field->screen_from = $2; - } -| TO identifier - { - $$ = check_not_88_level ($2); - - check_repeated ("TO", SYN_CLAUSE_22, &check_pic_duplicate); - current_field->screen_to = $$; - current_field->screen_flag |= COB_SCREEN_INPUT; - } -; - -control_definition: - control_type_name -| OBJECT control_type - { - cobc_cs_check |= CB_CS_GRAPHICAL_CONTROL; - } -; - -control_type_name: - LABEL /* CTL-LABEL -> 01 */ -| ENTRY_FIELD /* CTL-ENTRY-FIELD -> 02 */ -| PUSH_BUTTON /* CTL-PUSH-BUTTON -> 03 */ -| CHECK_BOX /* CTL-CHECK-BOX -> 04 */ -| RADIO_BUTTON /* CTL-RADIO-BUTTON -> 05 */ -| SCROLL_BAR /* CTL-SCROLL-BAR -> 06 */ -| LIST_BOX /* CTL-LIST-BOX -> 07 */ -| COMBO_BOX /* CTL-COMBO-BOX -> 08 */ -| FRAME /* CTL-FRAME -> 09 */ -/* disabled for now, conflicts with display attribute -| TAB /* CTL-TAB -> 10 */ -| BAR /* CTL-BAR -> 11 */ -/* disabled for now, conflicts with display attribute -| GRID /* CTL-GRID -> 12 */ -| BITMAP /* CTL-BITMAP -> 13 */ -| TREE_VIEW /* CTL-TREE-VIEW -> 14 */ -| WEB_BROWSER /* CTL-WEB-BROWSER -> 15 */ -| ACTIVEX /* CTL-ACTIVE-X -> 16 */ -| STATUS_BAR /* CTL-STATUS-BAR -> 17 */ -| DATE_ENTRY /* CTL-DATE-ENTRY -> 18 */ -/* | _NET /* check recent controls.def, - define styles and properties, too */ -; - -/* note: these match to the control_type_names, see comments there */ -control_type: - integer -| identifier -; - -/* items that are assigned to a control */ -control_item: - identifier /* may be defined in SCREEN SECTION or a handle */ -| CONTROL /* the actual control is defined by AT, LINE, COLUMN, CLINE, and CCOL */ -; - -_control_attributes_and_screen_options: - /* empty */ -| _control_attributes_and_screen_options control_attribute -| _control_attributes_and_screen_options screen_option -; - -control_attributes: - control_attribute -| control_attributes control_attribute -; - -control_attribute: - control_style -| control_property _is_are_equal x_list -; - -control_style: - STYLE _is_equal control_style_type -| _flag_not control_style_name -; - -control_property: - PROPERTY control_property_type -| control_property_name -; - -control_style_name: - control_style_name_generic -| control_style_name_label -| control_style_name_entry_field -| control_style_name_push_button -| control_style_name_check_box -/*| control_style_name_radio_button */ -/*| control_style_name_scroll_bar */ -| control_style_name_list_box -| control_style_name_combo_box -| control_style_name_frame -| control_style_name_tab_control -| control_style_name_bar -/*| control_style_name_bitmap */ -| control_style_name_grid -| control_style_name_tree_view -/*| control_style_name_web_browser */ -| control_style_name_activex -| control_style_name_date_entry -; - -control_property_name: - control_property_name_generic -| control_property_name_label -| control_property_name_entry_field -| control_property_name_push_button -/*| control_property_name_check_box <- duplicated from push_button */ -| control_property_name_radio_button -/*| control_property_name_scroll_bar <- duplicated from radio_button */ -| control_property_name_list_box -/*| control_property_name_combo_box <- duplicated from list_box */ -| control_property_name_frame -| control_property_name_tab_control -| control_property_name_bar -| control_property_name_bitmap -| control_property_name_grid -| control_property_name_tree_view -| control_property_name_web_browser -| control_property_name_activex -| control_property_name_date_entry -; - - -/* Generic style and property names that apply to several types of controls */ -control_style_name_generic: - PERMANENT /* S-PERMANENT --> 1073741824 */ -| TEMPORARY /* S-TEMPORARY --> 536870912 */ -| NOTAB /* S-NOTAB --> 268435456 */ -| HEIGHT_IN_CELLS /* S-HEIGHT-IN-CELLS --> 134217728 */ -| WIDTH_IN_CELLS /* S-WIDTH-IN-CELLS --> 67108864 */ -| THREEDIMENSIONAL /* S-3D --> 33554432 */ -| OVERLAP_LEFT /* S-OVERLAP-LEFT --> 16777216 */ -| OVERLAP_TOP /* S-OVERLAP-TOP --> 8388608 */ -| SELF_ACT /* S-SELF-ACT --> 4194304 */ -| NOTIFY /* S-NOTIFY --> 2097152 */ -; - -control_property_name_generic: - TERMINATION_VALUE /* P-TERMINATION-VALUE --> 1 */ -| EXCEPTION_VALUE /* P-EXCEPTION-VALUE --> 2 */ -/* | TITLE */ -| LAYOUT_DATA -| ENABLED -| VISIBLE -| HELP_ID -; - -/* LABEL style and property names */ -control_style_name_label: - LEFT /* LS-LEFT --> 1 */ -/* | RIGHT /* LS-RIGHT --> 2 */ -| CENTER /* LS-CENTER --> 4 */ -| NO_KEY_LETTER /* LS-NO-KEY-LETTER --> 8 */ -| TRANSPARENT /* LS-TRANSPARENT --> 16 */ -; - -control_property_name_label: - LABEL_OFFSET /* LP-LABEL-OFFSET --> 1 */ -; - -/* ENTRY-FIELD style and property names */ -control_style_name_entry_field: -/* LEFT /* EFS-LEFT --> 1 */ -/*| RIGHT /* EFS-RIGHT --> 2 */ -/*| CENTER /* EFS-CENTER --> 4 */ -/*|*/ BOX /* EFS-BOX --> 8 */ -| NO_BOX /* EFS-NO-BOX --> 16 */ -| MULTILINE /* EFS-MULTILINE --> 32 */ -| VSCROLL /* EFS-VSCROLL --> 96 */ -| VSCROLL_BAR /* EFS-VSCROLL-BAR --> 224 */ -| USE_RETURN /* EFS-USE-RETURN --> 256 */ -| USE_TAB /* EFS-USE-TAB --> 512 */ -| UPPER /* EFS-UPPER --> 1024 */ -| LOWER /* EFS-LOWER --> 2048 */ -| NO_AUTOSEL /* EFS-NO-AUTOSEL --> 4096 */ -| READ_ONLY /* EFS-READ-ONLY --> 8192 */ -/*| AUTO /* EFS-AUTOTERMINATE --> 16384 */ -| NOTIFY_CHANGE /* EFS-NOTIFY-CHANGE --> 32768 */ -/*| SECURE /* EFS-SECURE --> 65536 */ -| NUMERIC /* EFS-NUMERIC --> 131072 */ -| SPINNER /* EFS-SPINNER --> 262144 */ -| AUTO_SPIN /* EFS-AUTO-SPIN --> 262208 */ -; - -control_property_name_entry_field: - MAX_TEXT /* EFP-MAX-TEXT --> 3 */ -| MAX_LINES /* EFP-MAX-LINES --> 4 */ -| MIN_VAL /* EFP-MIN-VAL --> 5 */ -| MAX_VAL /* EFP-MAX-VAL --> 6 */ -| AUTO_DECIMAL /* EFP-AUTO-DECIMAL --> 7 */ -| CURSOR_ROW /* EFP-CURSOR-ROW --> 8 */ -| CURSOR /* EFP-CURSOR --> 4097 */ -| ACTION /* EFP-ACTION --> 4098 */ -| SELECTION_TEXT /* EFP-SELECTION-TEXT --> 4099 */ -| CURSOR_COL /* EFP-CURSOR-COL --> 4100 */ -; - -/* PUSH-BUTTON style and property names */ -control_style_name_push_button: - DEFAULT_BUTTON /* PBS-DEFAULT-BUTTON --> 1 */ -| ESCAPE_BUTTON /* PBS-ESCAPE-BUTTON --> 2 */ -| OK_BUTTON /* PBS-OK-BUTTON --> 4 */ -| CANCEL_BUTTON /* PBS-CANCEL-BUTTON --> 8 */ -| NO_AUTO_DEFAULT /* PBS-NO-AUTO-DEFAULT --> 16 */ -/* | BITMAP /* PBS-BITMAP --> 32768 */ -| SQUARE /* PBS-SQUARE --> 16384 */ -| FRAMED /* PBS-FRAMED --> 8192 */ -| UNFRAMED /* PBS-UNFRAMED --> 4096 */ -| FLAT /* PBS-FLAT --> 2048 */ -/*| MULTILINE /* PBS-MULTILINE --> 1024 */ -; - -control_property_name_push_button: - BITMAP_NUMBER /* PBP-BITMAP-NUMBER --> 3 */ -| BITMAP_HANDLE /* PBP-BITMAP-HANDLE --> 4 */ -; - -/* CHECK-BOX style and property names */ -control_style_name_check_box: -/* BITMAP /* CBS-BITMAP --> 32768 */ -/*| SQUARE /* CBS-SQUARE --> 16384 */ -/*| FRAMED /* CBS-FRAMED --> 8192 */ -/*| UNFRAMED /* CBS-UNFRAMED --> 4096 */ -/*| FLAT /* CBS-FLAT --> 2048 */ -/*| MULTILINE /* CBS-MULTILINE --> 1024 */ - VTOP /* CBS-VTOP --> 512 */ -| LEFT_TEXT /* CBS-LEFT-TEXT --> 2 */ -; - -/*control_property_name_check_box: -/* BITMAP_NUMBER /* CBP-BITMAP-NUMBER --> 3 */ -/*| BITMAP_HANDLE /* CBP-BITMAP-HANDLE --> 4 */ -/*; - -/* RADIO-BUTTON style and property names */ -/*control_style_name_radio_button: -/* NO_GROUP_TAB /* RBS-NO-GROUP-TAB --> 1 */ -/*| LEFT_TEXT /* RBS-LEFT-TEXT --> 2 */ -/*| BITMAP /* RBS-BITMAP --> 32768 */ -/*| SQUARE /* RBS-SQUARE --> 16384 */ -/*| FRAMED /* RBS-FRAMED --> 8192 */ -/*| UNFRAMED /* RBS-UNFRAMED --> 4096 */ -/*| FLAT /* RBS-FLAT --> 2048 */ -/*| MULTILINE /* RBS-MULTILINE --> 1024 */ -/*| VTOP /* RBS-VTOP --> 512 */ -/*;*/ - -control_property_name_radio_button: -/* BITMAP_NUMBER /* RBP-BITMAP-NUMBER --> 3 */ -/*| BITMAP_HANDLE /* RBP-BITMAP-HANDLE --> 4 */ - GROUP /* RBP-GROUP --> 5 */ -| GROUP_VALUE /* RBP-GROUP-VALUE --> 6 */ -; - -/* SCROLL-BAR style and property names */ -/*control_style_name_scroll_bar: -/* NO_GROUP_TAB /* SBS-HORIZONTAL --> 1 */ -/*| LEFT_TEXT /* SBS-TRACK-THUMB --> 2 */ -/*; */ - -/*control_property_name_scroll_bar: -/* BITMAP_NUMBER /* SBP-MIN-VAL --> 1 */ -/*| BITMAP_HANDLE /* SBP-MAX-VAL --> 2 */ -/*| GROUP /* SBP-PAGE-SIZE --> 3 */ -/*;*/ - -/* LIST-BOX style and property names */ -control_style_name_list_box: - UNSORTED /* LBS-UNSORTED --> 1 */ -/*| NO_BOX /* LBS-NO-BOX --> 2 */ -/*| BOX /* LBS-BOX --> 4 */ -| NOTIFY_DBLCLICK /* LBS-NOTIFY-DBLCLICK --> 256 */ -| NOTIFY_SELCHANGE /* LBS-NOTIFY-SELCHANGE --> 512 */ -| PAGED /* LBS-PAGED --> 1024 */ -/*| UPPER /* LBS-UPPER --> 2048 */ -/*| LOWER /* LBS-LOWER --> 4096 */ -| NO_SEARCH /* LBS-NO-SEARCH --> 8192 */ -; - -control_property_name_list_box: - MASS_UPDATE /* LBP-MASS-UPDATE --> 3 */ -| INSERTION_INDEX /* LBP-INSERTION-INDEX --> 4 */ -| DATA_COLUMNS /* LBP-DATA-COLUMNS --> 5 */ -| DISPLAY_COLUMNS /* LBP-DISPLAY-COLUMNS --> 6 */ -| QUERY_INDEX /* LBP-QUERY-INDEX --> 7 */ -| ALIGNMENT /* LBP-ALIGNMENT --> 8 */ -| SEPARATION /* LBP-SEPARATION --> 9 */ -| DIVIDERS /* LBP-DIVIDERS --> 10 */ -| SORT_ORDER /* LBP-SORT-ORDER --> 11 */ -| ITEM_TO_ADD /* LBP-ITEM-TO-ADD --> 4097 */ -| RESET_LIST /* LBP-RESET-LIST --> 4098 */ -| ITEM_TO_DELETE /* LBP-ITEM-TO-DELETE --> 4099 */ -| SEARCH_TEXT /* LBP-SEARCH-TEXT --> 4100 */ -| SELECTION_INDEX /* LBP-SELECTION-INDEX --> 4103 */ -| ITEM_VALUE /* LBP-ITEM-VALUE --> 4104 */ -| THUMB_POSITION /* LBP-THUMB-POSITION --> 4105 */ -; - -/* COMBO-BOX style and property names */ -control_style_name_combo_box: -/* UNSORTED /* CMS-UNSORTED --> 1 */ - DROP_DOWN /* CMS-DROP-DOWN --> 0 */ -| STATIC_LIST /* CMS-STATIC-LIST --> 2 */ -| DROP_LIST /* CMS-DROP-LIST --> 4 */ -/*| BOX /* CMS-BOX --> 8 */ -/*| NO_BOX /* CMS-NO-BOX --> 16 */ -/*| NOTIFY_DBLCLICK /* CMS-NOTIFY-DBLCLICK --> 256 */ -/*| NOTIFY_SELCHANGE /* CMS-NOTIFY-SELCHANGE --> 512 */ -/*| UPPER /* CMS-UPPER --> 2048 */ -/*| LOWER /* CMS-LOWER --> 4096 */ -; - -/*control_property_name_combo_box: -/* MASS_UPDATE /* CMP-MASS-UPDATE --> 3 */ -/*| MAX_TEXT /* CMP-MAX-TEXT --> 4 */ -/*| INSERTION_INDEX /* CMP-INSERTION-INDEX --> 5 */ -/*| ITEM_TO_ADD /* CMP-ITEM-TO-ADD --> 4097 */ -/*| RESET_LIST /* CMP-RESET-LIST --> 4098 */ -/*| ITEM_TO_DELETE /* CMP-ITEM-TO-DELETE --> 4099 */ -/*;*/ - -/* FRAME style and property names */ -control_style_name_frame: - RAISED /* FS-RAISED --> 1 */ -| LOWERED /* FS-LOWERED --> 2 */ -| ENGRAVED /* FS-ENGRAVED --> 4 */ -| RIMMED /* FS-RIMMED --> 8 */ -| HEAVY /* FS-HEAVY --> 16 */ -| VERY_HEAVY /* FS-VERY-HEAVY --> 32 */ -| ALTERNATE /* FS-ALTERNATE --> 64 */ -| FULL_HEIGHT /* FS-FULL-HEIGHT --> 128 */ -; - -control_property_name_frame: - HIGH_COLOR /* FP-HIGH-COLOR --> 1 */ -| LOW_COLOR /* FP-LOW-COLOR --> 2 */ -| FILL_COLOR /* FP-FILL-COLOR --> 3 */ -| FILL_PERCENT /* FP-FILL-PERCENT --> 4 */ -| FILL_COLOR2 /* FP-FILL-COLOR2 --> 5 */ -| TITLE_POSITION /* FP-TITLE-POSITION --> 6 */ -; - -/* TAB-CONTROL style and property names */ -control_style_name_tab_control: -/* MULTILINE /* TS-MULTILINE --> 1 */ - BUTTONS /* TS-BUTTONS --> 2 */ -| FIXED_WIDTH /* TS-FIXED-WIDTH --> 4 */ -| BOTTOM /* TS-BOTTOM --> 8 */ -| VERTICAL /* TS-VERTICAL --> 17 */ -| FLAT_BUTTONS /* TS-FLAT-BUTTONS --> 32 */ -| HOT_TRACK /* TS-HOT-TRACK --> 64 */ -| NO_DIVIDERS /* TS-NO-DIVIDERS --> 128 */ -| NO_FOCUS /* TS-NO-FOCUS --> 256 */ -; - -control_property_name_tab_control: -/* BITMAP_HANDLE /* TP-BITMAP-HANDLE --> 1 */ - BITMAP_WIDTH /* TP-BITMAP-WIDTH --> 2 */ -/*| BITMAP_NUMBER /* TP-BITMAP-NUMBER --> 3 */ -| TAB_TO_ADD /* TP-TAB-TO-ADD --> 4097 */ -| RESET_TABS /* TP-RESET-TABS --> 4098 */ -| TAB_TO_DELETE /* TP-TAB-TO-DELETE --> 4099 */ -; - -/* BAR style and property names */ -control_style_name_bar: - DOTTED /* BRS-DOTTED --> 1 */ -| DASHED /* BRS-DASHED --> 2 */ -| DOTDASH /* BRS-DOTDASH --> 3 */ -; - -control_property_name_bar: - WIDTH /* BRP-WIDTH --> 1 */ -| COLORS /* BRP-COLORS --> 2 */ -| SHADING /* BRP-SHADING --> 3 */ -| POSITION_SHIFT /* BRP-POSITION-SHIFT --> 4 */ -| LEADING_SHIFT /* BRP-LEADING-SHIFT --> 5 */ -| TRAILING_SHIFT /* BRP-TRAILING-SHIFT --> 6 */ -; - -/* BITMAP style and property names */ -/*control_style_name_bitmap: -/* COBOL /* just use as place holder, no styles here */ -/*;*/ - -control_property_name_bitmap: -/* BITMAP_NUMBER /* BTP-BITMAP-NUMBER --> 1 */ -/*| BITMAP_HANDLE /* BTP-BITMAP-HANDLE --> 2 */ - BITMAP_START /* BTP-BITMAP-START --> 3 */ -| BITMAP_END /* BTP-BITMAP-END --> 4 */ -| BITMAP_TIMER /* BTP-BITMAP-TIMER --> 5 */ -| BITMAP_TRANSPARENT_COLOR /* BTP-BITMAP-TRANSPARENT-COLOR --> 6 */ -; - -/* GRID style and property names */ -control_style_name_grid: - BOXED /* TGRS-BOXED --> 1 */ -/*| NO_BOX /* TGRS-NO-BOX --> 2 */ -/*| VSCROLL /* TGRS-VSCROLL --> 4 */ -| HSCROLL /* TGRS-HSCROLL --> 8 */ -| COLUMN_HEADINGS /* TGRS-COLUMN-HEADINGS --> 16 */ -| ROW_HEADINGS /* TGRS-ROW-HEADINGS --> 32 */ -| TILED_HEADINGS /* TGRS-TILED-HEADINGS --> 64 */ -| CENTERED_HEADINGS /* TGRS-CENTERED-HEADINGS --> 128 */ -/*| USE_TAB /* TGRS-USE-TAB --> 256 */ -| ADJUSTABLE_COLUMNS /* TGRS-ADJUSTABLE-COLUMNS --> 512 */ -/*| PAGED /* TGRS-PAGED --> 1024 */ -; - -control_property_name_grid: - ROW_DIVIDERS /* GRP-ROW-DIVIDERS --> 1 */ -| VPADDING /* GRP-VPADDING --> 2 */ -| DIVIDER_COLOR /* GRP-DIVIDER-COLOR --> 3 */ -/*| INSERTION_INDEX /* GRP-INSERTION-INDEX --> 4 */ -/*| DATA_COLUMNS /* GRP-DATA-COLUMNS --> 5 */ -/*| DISPLAY_COLUMNS /* GRP-DISPLAY-COLUMNS --> 6 */ -/*| ALIGNMENT /* GRP-ALIGNMENT --> 7 */ -/*| SEPARATION /* GRP-SEPARATION --> 8 */ -| COLUMN_DIVIDERS /* GRP-COLUMN-DIVIDERS --> 9 */ -| ROW_COLOR_PATTERN /* GRP-ROW-COLOR-PATTERN --> 10 */ -| Y /* GRP-Y --> 11 */ -| X /* GRP-X --> 12 */ -| COLUMN_COLOR /* GRP-COLUMN-COLOR --> 13 */ -| ROW_COLOR /* GRP-ROW-COLOR --> 14 */ -| CELL_COLOR /* GRP-CELL-COLOR --> 15 */ -| COLUMN_FONT /* GRP-COLUMN-FONT --> 16 */ -| ROW_FONT /* GRP-ROW-FONT --> 17 */ -| CELL_FONT /* GRP-CELL-FONT --> 18 */ -/*| BITMAP /* GRP-BITMAP --> 19 */ -/*| BITMAP_NUMBER /* GRP-BITMAP-NUMBER --> 20 */ -/*| BITMAP_WIDTH /* GRP-BITMAP-WIDTH --> 21 */ -| BITMAP_TRAILING /* GRP-BITMAP-TRAILING --> 22 */ -| NUM_ROWS /* GRP-NUM-ROWS --> 23 */ -| CURSOR_Y /* GRP-CURSOR-Y --> 24 */ -| CURSOR_X /* GRP-CURSOR-X --> 25 */ -| CURSOR_FRAME_WIDTH /* GRP-CURSOR-FRAME-WIDTH --> 26 */ -| VIRTUAL_WIDTH /* GRP-VIRTUAL-WIDTH --> 27 */ -| DATA_TYPES /* GRP-DATA-TYPES --> 28 */ -| CURSOR_COLOR /* GRP-CURSOR-COLOR --> 29 */ -| HEADING_COLOR /* GRP-HEADING-COLOR --> 30 */ -| HEADING_FONT /* GRP-HEADING-FONT --> 31 */ -| HEADING_DIVIDER_COLOR /* GRP-HEADING-DIVIDER-COLOR --> 32 */ -| START_X /* GRP-START-X --> 33 */ -| START_Y /* GRP-START-Y --> 34 */ -| REGION_COLOR /* GRP-REGION-COLOR --> 35 */ -/*| MASS_UPDATE /* GRP-MASS-UPDATE --> 36 */ -| HIDDEN_DATA /* GRP-HIDDEN-DATA --> 37 */ -| END_COLOR /* GRP-END-COLOR --> 38 */ -| FILE_POS /* GRP-FILE-POS --> 39 */ -| NUM_COL_HEADINGS /* GRP-NUM-COL-HEADINGS --> 40 */ -| DRAG_COLOR /* GRP-DRAG-COLOR --> 41 */ -| FINISH_REASON /* GRP-FINISH-REASON --> 42 */ -| COLUMN_PROTECTION /* GRP-COLUMN-PROTECTION --> 43 */ -| ROW_PROTECTION /* GRP-ROW-PROTECTION --> 44 */ -| CELL_PROTECTION /* GRP-CELL-PROTECTION --> 45 */ -| RECORD_TO_ADD /* GRP-RECORD-TO-ADD --> 4097 */ -| RESET_GRID /* GRP-RESET-GRID --> 4098 */ -| CELL_DATA /* GRP-CELL-DATA --> 4099 */ -| RECORD_TO_DELETE /* GRP-RECORD-TO-DELETE --> 4100 */ -| RECORD_DATA /* GRP-RECORD-DATA --> 4101 */ -| LAST_ROW /* GRP-LAST-ROW --> 4102 */ -| VSCROLL_POS /* GRP-VSCROLL-POS --> 4103 */ -| HSCROLL_POS /* GRP-HSCROLL-POS --> 4104 */ -/*| ACTION /* GRP-ACTION --> 4105 */ -/*| SEARCH_TEXT /* GRP-SEARCH-TEXT --> 4106 */ -| SEARCH_OPTIONS /* GRP-SEARCH-OPTIONS --> 4107 */ -| INSERT_ROWS /* GRP-INSERT-ROWS --> 4108 */ -| ENTRY_REASON /* GRP-ENTRY-REASON --> 4109 */ -; - -/* TREE-VIEW style and property names */ -control_style_name_tree_view: -/* BOXED /* TVS-BOXED --> 1 */ -/*| NO_BOX /* TVS-NO-BOX --> 2 */ -/*| BUTTONS /* TVS-BUTTONS --> 4 */ - SHOW_LINES /* TVS-SHOW-LINES --> 8 */ -| LINES_AT_ROOT /* TVS-LINES-AT-ROOT --> 16 */ -| SHOW_SEL_ALWAYS /* TVS-SHOW-SEL-ALWAYS --> 32 */ -; - -control_property_name_tree_view: - PARENT /* TVP-PARENT --> 1 */ -| PLACEMENT /* TVP-PLACEMENT --> 2 */ -| ITEM /* TVP-ITEM --> 3 */ -/*| BITMAP_HANDLE /* TVP-BITMAP-HANDLE --> 4 */ -/*| BITMAP_WIDTH /* TVP-BITMAP-WIDTH --> 5 */ -/*| ITEM_TO_ADD /* TVP-ITEM-TO-ADD --> 4097 */ -| ITEM_TEXT /* TVP-ITEM-TEXT --> 4098 */ -| NEXT_ITEM /* TVP-NEXT-ITEM --> 4099 */ -/*| ITEM_TO_DELETE /* TVP-ITEM-TO-DELETE --> 4100 */ -/*| RESET_LIST /* TVP-RESET-LIST --> 4101 */ -| ENSURE_VISIBLE /* TVP-ENSURE-VISIBLE --> 4102 */ -| EXPAND /* TVP-EXPAND --> 4103 */ -| ITEM_TO_EMPTY /* TVP-ITEM-TO-EMPTY --> 4104 */ -/*| BITMAP_NUMBER /* TVP-BITMAP-NUMBER --> 4105 */ -/*| HIDDEN_DATA /* TVP-HIDDEN-DATA --> 4106 */ -| HAS_CHILDREN /* TVP-HAS-CHILDREN --> 4107 */ -; - -/* WEB-BROWSER style and property names */ -/*control_style_name_web_browser: -/* NOTIFY_CHANGE /* WBS-NOTIFY-CHANGE --> 1 */ -/*;*/ - -control_property_name_web_browser: - BUSY /* WBP-BUSY --> 1 */ -| TYPE /* WBP-TYPE --> 2 */ -| STATUS_TEXT /* WBP-STATUS-TEXT --> 3 */ -| NAVIGATE_URL /* WBP-NAVIGATE-URL --> 4 */ -| PROGRESS /* WBP-PROGRESS --> 5 */ -| MAX_PROGRESS /* WBP-MAX-PROGRESS --> 6 */ -| CUSTOM_PRINT_TEMPLATE /* WBP-CUSTOM-PRINT-TEMPLATE --> 7 */ -| FILE_NAME /* WBP-FILE-NAME --> 8 */ -| GO_BACK /* WBP-GO-BACK --> 4097 */ -| GO_FORWARD /* WBP-GO-FORWARD --> 4098 */ -| GO_HOME /* WBP-GO-HOME --> 4099 */ -| GO_SEARCH /* WBP-GO-SEARCH --> 4100 */ -| REFRESH /* WBP-REFRESH --> 4101 */ -/*| STOP WBP-STOP --> 4102 */ -| PRINT /* WBP-PRINT --> 4103 */ -| PRINT_NO_PROMPT /* WBP-PRINT-NO-PROMPT --> 4104 */ -| PRINT_PREVIEW /* WBP-PRINT-PREVIEW --> 4105 */ -| PAGE_SETUP /* WBP-PAGE-SETUP --> 4106 */ -| SAVE_AS /* WBP-SAVE-AS --> 4107 */ -| SAVE_AS_NO_PROMPT /* WBP-SAVE-AS-NO-PROMPT --> 4108 */ -| PROPERTIES /* WBP-PROPERTIES --> 4109 */ -| COPY_SELECTION /* WBP-COPY-SELECTION --> 4110 */ -| SELECT_ALL /* WBP-SELECT-ALL --> 4111 */ -| CLEAR_SELECTION /* WBP-CLEAR-SELECTION --> 4112 */ -; - -/* ACTIVE-X style and property names */ -control_style_name_activex: -/* USE_RETURN /* AXS-USE-RETURN --> 256 */ -/*| USE_TAB /* AXS-USE-TAB --> 512 */ - USE_ALT /* AXS-USE-ALT --> 1024 */ -; - -control_property_name_activex: - EVENT_LIST /* AXP-EVENT-LIST --> 1 */ - -/* DATE-ENTRY style and property names */ -control_style_name_date_entry: - SHORT_DATE /* DAS-SHORT-DATE --> 0 */ -| CENTURY_DATE /* DAS-CENTURY-DATE --> 1 */ -| LONG_DATE /* DAS-LONG-DATE --> 2 */ -| TIME /* DAS-TIME --> 3 */ -| NO_F4 /* DAS-NO-F4 --> 4 */ -| NO_UPDOWN /* DAS-NO-UPDOWN --> 8 */ -| RIGHT_ALIGN /* DAS-RIGHT-ALIGN --> 16 */ -| SHOW_NONE /* DAS-SHOW-NONE --> 32 */ -/*| NOTIFY_CHANGE /* DAS-NOTIFY-CHANGE --> 32768 */ -/*| SPINNER /* DAS-SPINNER --> 262144 */ -; - -control_property_name_date_entry: - VALUE_FORMAT /* DAP-VALUE-FORMAT --> 1 */ -| CALENDAR_FONT /* DAP-CALENDAR-FONT --> 2 */ -| DISPLAY_FORMAT /* DAP-DISPLAY-FORMAT --> 4097 */ -; - -/* note: these match to the style_type_names, see comments there */ -control_style_type: - integer -| identifier -; - -/* note: these match to the property_type_names, see comments there */ -control_property_type: - integer -/*| identifier /+ logic conflict because of _in_equal control_property_type */ -; - -changeable_control_properties: - changeable_control_property -| changeable_control_properties changeable_control_property -; - -changeable_control_property: - control_property _in_equal identifier -/* more to add here ... */ -; - -changeable_window_properties: - changeable_window_property -| changeable_window_properties changeable_window_property -; - -changeable_window_property: - TITLE _in_equal identifier -| SIZE _in_equal identifier -| LAYOUT_MANAGER _in_equal identifier -/* more to add here ... */ -; - -eol: - EOL -| _end_of LINE -; - -eos: - EOS -| _end_of SCREEN /* FIXME: this SCREEN is optional! */ -; - -_plus: - /* empty */ { $$ = NULL; } -| plus { $$ = $1; } -; - -plus: - plus_tokens { $$ = cb_int0; } -; - -plus_tokens: - PLUS | TOK_PLUS -; - -minus: - minus_tokens { $$ = cb_int1; } -; - -minus_tokens: - MINUS | TOK_MINUS -; - -control_size: - num_id_or_lit control_size_unit -; - -control_size_unit: - _cell { $$ = $0; } -| PIXEL { $$ = cb_int1; } -; - -_cell: - /* empty */ { $$ = NULL; } -| CELL { $$ = cb_int0; } -; - -screen_line_number: - _number _is _screen_line_plus_minus num_id_or_lit - { - if ($4) { - current_field->screen_line = $4; - } - } -; - -_screen_line_plus_minus: - /* empty */ -| plus - { - current_field->screen_flag |= COB_SCREEN_LINE_PLUS; - } -| minus - { - current_field->screen_flag |= COB_SCREEN_LINE_MINUS; - } -; - -screen_col_number: - _number _is _screen_col_plus_minus num_id_or_lit - { - if ($4) { - current_field->screen_column = $4; - } - } -; - -_screen_col_plus_minus: - /* empty */ - { - /* Nothing */ - } -| plus - { - current_field->screen_flag |= COB_SCREEN_COLUMN_PLUS; - } -| minus - { - current_field->screen_flag |= COB_SCREEN_COLUMN_MINUS; - } -; - -screen_occurs_clause: - OCCURS integer _times - { - CB_PENDING (_("OCCURS screen items")); - check_repeated ("OCCURS", SYN_CLAUSE_23, &check_pic_duplicate); - current_field->occurs_max = cb_get_int ($2); - current_field->occurs_min = current_field->occurs_max; - current_field->indexes++; - current_field->flag_occurs = 1; - } -; - -screen_global_clause: - _is GLOBAL - { - CB_PENDING (_("GLOBAL screen items")); - } -; - -/* PROCEDURE DIVISION */ - -_procedure_division: - /* empty */ - { - current_section = NULL; - current_paragraph = NULL; - check_pic_duplicate = 0; - check_duplicate = 0; - if (!current_program->entry_convention) { - current_program->entry_convention = cb_int (CB_CONV_COBOL); - } - } -| procedure_division -; - -procedure_division: - PROCEDURE DIVISION - { - current_section = NULL; - current_paragraph = NULL; - check_pic_duplicate = 0; - check_duplicate = 0; - cobc_in_procedure = 1U; - cb_set_system_names (); - backup_current_pos (); - } - _mnemonic_conv _conv_linkage _procedure_using_chaining _procedure_returning TOK_DOT - { - cb_tree call_conv = $4; - if ($5) { - call_conv = $5; - if ($4) { - /* note: $4 is likely to be a reference to SPECIAL-NAMES */ - cb_error_x ($5, _("%s and %s are mutually exclusive"), - "CALL-CONVENTION", "WITH LINKAGE"); - } - } - if (call_conv) { - if (current_program->entry_convention) { - cb_warning (COBC_WARN_FILLER, _("overriding convention specified in ENTRY-CONVENTION")); - } - current_program->entry_convention = call_conv; - } else if (!current_program->entry_convention) { - current_program->entry_convention = cb_int (CB_CONV_COBOL); - } - header_check |= COBC_HD_PROCEDURE_DIVISION; - } - _procedure_declaratives - { - if (current_program->flag_main - && !current_program->flag_chained && $6) { - cb_error (_("executable program requested but PROCEDURE/ENTRY has USING clause")); - } - /* Main entry point */ - emit_entry (current_program->program_id, 0, $6, NULL); - current_program->num_proc_params = cb_list_length ($6); - if (current_program->source_name) { - emit_entry (current_program->source_name, 1, $6, NULL); - } - } - _procedure_list - { - if (current_paragraph) { - if (current_paragraph->exit_label) { - emit_statement (current_paragraph->exit_label); - } - emit_statement (cb_build_perform_exit (current_paragraph)); - } - if (current_section) { - if (current_section->exit_label) { - emit_statement (current_section->exit_label); - } - emit_statement (cb_build_perform_exit (current_section)); - } - } -| - { - cb_tree label; - - /* No PROCEDURE DIVISION header here */ - /* Only a statement is allowed as first element */ - /* Thereafter, sections/paragraphs may be used */ - check_pic_duplicate = 0; - check_duplicate = 0; - if (!current_program->entry_convention) { - current_program->entry_convention = cb_int (CB_CONV_COBOL); - } - cobc_in_procedure = 1U; - label = cb_build_reference ("MAIN SECTION"); - current_section = CB_LABEL (cb_build_label (label, NULL)); - current_section->flag_section = 1; - current_section->flag_dummy_section = 1; - current_section->flag_skip_label = !!skip_statements; - current_section->flag_declaratives = !!in_declaratives; - current_section->xref.skip = 1; - emit_statement (CB_TREE (current_section)); - label = cb_build_reference ("MAIN PARAGRAPH"); - current_paragraph = CB_LABEL (cb_build_label (label, NULL)); - current_paragraph->flag_declaratives = !!in_declaratives; - current_paragraph->flag_skip_label = !!skip_statements; - current_paragraph->flag_dummy_paragraph = 1; - current_paragraph->xref.skip = 1; - emit_statement (CB_TREE (current_paragraph)); - cb_set_system_names (); - } - statements TOK_DOT _procedure_list -; - -_procedure_using_chaining: - /* empty */ - { - $$ = NULL; - } -| USING - { - call_mode = CB_CALL_BY_REFERENCE; - size_mode = CB_SIZE_4; - } - procedure_param_list - { - if (cb_list_length ($3) > MAX_CALL_FIELD_PARAMS) { - cb_error (_("number of arguments exceeds maximum %d"), - MAX_CALL_FIELD_PARAMS); - } - $$ = $3; - } -| CHAINING - { - call_mode = CB_CALL_BY_REFERENCE; - if (current_program->prog_type == COB_MODULE_TYPE_FUNCTION) { - cb_error (_("CHAINING invalid in user FUNCTION")); - } else { - current_program->flag_chained = 1; - } - } - procedure_param_list - { - if (cb_list_length ($3) > MAX_CALL_FIELD_PARAMS) { - cb_error (_("number of arguments exceeds maximum %d"), - MAX_CALL_FIELD_PARAMS); - } - $$ = $3; - } -; - -procedure_param_list: - procedure_param { $$ = $1; } -| procedure_param_list - procedure_param { $$ = cb_list_append ($1, $2); } -; - -procedure_param: - _procedure_type _size_optional _procedure_optional WORD _acu_size - { - cb_tree x; - struct cb_field *f; - - x = cb_build_identifier ($4, 0); - if ($3 == cb_int1 && CB_VALID_TREE (x) && cb_ref (x) != cb_error_node) { - f = CB_FIELD (cb_ref (x)); - f->flag_is_pdiv_opt = 1; - } - - $$ = CB_BUILD_PAIR (cb_int (call_mode), x); - CB_SIZES ($$) = size_mode; - } -; - -_procedure_type: - /* empty */ -| _by REFERENCE - { - call_mode = CB_CALL_BY_REFERENCE; - } -| _by VALUE - { - if (current_program->flag_chained) { - cb_error (_("%s not allowed in CHAINED programs"), "BY VALUE"); - } else { - call_mode = CB_CALL_BY_VALUE; - } - } -; - -_size_optional: - /* empty */ -| SIZE _is AUTO - { - if (call_mode != CB_CALL_BY_VALUE) { - cb_error (_("SIZE only allowed for BY VALUE items")); - } else { - size_mode = CB_SIZE_AUTO; - } - } -| SIZE _is DEFAULT - { - if (call_mode != CB_CALL_BY_VALUE) { - cb_error (_("SIZE only allowed for BY VALUE items")); - } else { - size_mode = CB_SIZE_4; - } - } -| UNSIGNED SIZE _is AUTO - { - if (call_mode != CB_CALL_BY_VALUE) { - cb_error (_("SIZE only allowed for BY VALUE items")); - } else { - size_mode = CB_SIZE_AUTO | CB_SIZE_UNSIGNED; - } - } -| UNSIGNED size_is_integer - { - if (size_mode) { - size_mode |= CB_SIZE_UNSIGNED; - } - } -| size_is_integer -; - -size_is_integer: - SIZE _is integer - { - unsigned char *s = CB_LITERAL ($3)->data; - size_mode = 0; - - if (call_mode != CB_CALL_BY_VALUE) { - cb_error (_("SIZE only allowed for BY VALUE items")); - } else if (CB_LITERAL ($3)->size != 1) { - cb_error_x ($3, _("invalid value for SIZE")); - } else { - size_mode = 0; - switch (*s) { - case '1': - size_mode = CB_SIZE_1; - break; - case '2': - size_mode = CB_SIZE_2; - break; - case '4': - size_mode = CB_SIZE_4; - break; - case '8': - size_mode = CB_SIZE_8; - break; - default: - cb_error_x ($3, _("invalid value for SIZE")); - break; - } - } - } -; - -/* The [MEMORY] SIZE phrase is used when the parameter in the - USING phrase is a memory address (pointer to memory) - and you need to specify the size of the piece of memory - that is located at that address. */ -_acu_size: - /* empty */ -| _with MEMORY SIZE _is positive_id_or_lit - { - CB_PENDING_X ($4, _("MEMORY SIZE phrase in CALL statement")); - } -; - -_procedure_optional: - /* empty */ - { - $$ = cb_int0; - } -| OPTIONAL - { - if (call_mode != CB_CALL_BY_REFERENCE) { - cb_error (_("OPTIONAL only allowed for BY REFERENCE items")); - $$ = cb_int0; - } else { - $$ = cb_int1; - } - } -; - -_procedure_returning: - /* empty */ - { - if (current_program->prog_type == COB_MODULE_TYPE_FUNCTION) { - cb_error (_("RETURNING clause is required for a FUNCTION")); - } - } -| RETURNING OMITTED - { - if (current_program->flag_main) { - cb_error (_("RETURNING clause cannot be OMITTED for main program")); - } - if (current_program->prog_type == COB_MODULE_TYPE_FUNCTION) { - cb_error (_("RETURNING clause cannot be OMITTED for a FUNCTION")); - } - current_program->flag_void = 1; - } -| RETURNING WORD - { - struct cb_field *f; - - if (cb_ref ($2) != cb_error_node) { - f = CB_FIELD_PTR ($2); - /* standard rule: returning item is allocated in the - activating runtime element */ - if (f->storage != CB_STORAGE_LINKAGE) { - cb_error (_("RETURNING item is not defined in LINKAGE SECTION")); - } else if (f->level != 1 && f->level != 77) { - cb_error (_("RETURNING item must have level 01")); - } else if (f->flag_occurs) { - cb_error (_("RETURNING item should not have OCCURS")); - } else { - if (current_program->prog_type == COB_MODULE_TYPE_FUNCTION) { - if (f->flag_any_length) { - cb_error (_("function RETURNING item may not be ANY LENGTH")); - } - - f->flag_is_returning = 1; - } - current_program->returning = $2; - } - } - } -; - -_procedure_declaratives: -| DECLARATIVES TOK_DOT - { - in_declaratives = 1; - emit_statement (cb_build_comment ("DECLARATIVES")); - } - _procedure_list - END DECLARATIVES TOK_DOT - { - if (needs_field_debug) { - start_debug = 1; - } - in_declaratives = 0; - in_debugging = 0; - if (current_paragraph) { - if (current_paragraph->exit_label) { - emit_statement (current_paragraph->exit_label); - } - emit_statement (cb_build_perform_exit (current_paragraph)); - current_paragraph = NULL; - } - if (current_section) { - if (current_section->exit_label) { - emit_statement (current_section->exit_label); - } - current_section->flag_fatal_check = 1; - emit_statement (cb_build_perform_exit (current_section)); - current_section = NULL; - } - skip_statements = 0; - emit_statement (cb_build_comment ("END DECLARATIVES")); - check_unreached = 0; - } -; - - -/* Procedure list */ - -_procedure_list: -| _procedure_list procedure -; - -procedure: - section_header -| paragraph_header -| statements TOK_DOT - { - if (next_label_list) { - cb_tree plabel; - char name[32]; - - snprintf (name, sizeof(name), "L$%d", next_label_id); - plabel = cb_build_label (cb_build_reference (name), NULL); - CB_LABEL (plabel)->flag_next_sentence = 1; - emit_statement (plabel); - current_program->label_list = - cb_list_append (current_program->label_list, next_label_list); - next_label_list = NULL; - next_label_id++; - } - /* check_unreached = 0; */ - cb_end_statement(); - } -| invalid_statement %prec SHIFT_PREFER -| TOK_DOT - { - /* check_unreached = 0; */ - cb_end_statement(); - } -; - - -/* Section/Paragraph */ - -section_header: - WORD SECTION - { - non_const_word = 0; - check_unreached = 0; - if (cb_build_section_name ($1, 0) == cb_error_node) { - YYERROR; - } - - /* Exit the last paragraph/section */ - if (current_paragraph) { - if (current_paragraph->exit_label) { - emit_statement (current_paragraph->exit_label); - } - emit_statement (cb_build_perform_exit (current_paragraph)); - } - if (current_section) { - if (current_section->exit_label) { - emit_statement (current_section->exit_label); - } - emit_statement (cb_build_perform_exit (current_section)); - } - if (current_program->flag_debugging && !in_debugging) { - if (current_paragraph || current_section) { - emit_statement (cb_build_comment ( - "DEBUGGING - Fall through")); - emit_statement (cb_build_debug (cb_debug_contents, - "FALL THROUGH", NULL)); - } - } - - /* Begin a new section */ - current_section = CB_LABEL (cb_build_label ($1, NULL)); - current_section->flag_section = 1; - /* Careful here, one negation */ - current_section->flag_real_label = !in_debugging; - current_section->flag_declaratives = !!in_declaratives; - current_section->flag_skip_label = !!skip_statements; - current_paragraph = NULL; - } - _segment TOK_DOT - _use_statement - { - emit_statement (CB_TREE (current_section)); - } -; - -_use_statement: -| use_statement TOK_DOT -; - -paragraph_header: - WORD TOK_DOT - { - cb_tree label; - - non_const_word = 0; - check_unreached = 0; - if (cb_build_section_name ($1, 1) == cb_error_node) { - YYERROR; - } - - /* Exit the last paragraph */ - if (current_paragraph) { - if (current_paragraph->exit_label) { - emit_statement (current_paragraph->exit_label); - } - emit_statement (cb_build_perform_exit (current_paragraph)); - if (current_program->flag_debugging && !in_debugging) { - emit_statement (cb_build_comment ( - "DEBUGGING - Fall through")); - emit_statement (cb_build_debug (cb_debug_contents, - "FALL THROUGH", NULL)); - } - } - - /* Begin a new paragraph */ - if (!current_section) { - label = cb_build_reference ("MAIN SECTION"); - current_section = CB_LABEL (cb_build_label (label, NULL)); - current_section->flag_section = 1; - current_section->flag_dummy_section = 1; - current_section->flag_declaratives = !!in_declaratives; - current_section->flag_skip_label = !!skip_statements; - current_section->xref.skip = 1; - emit_statement (CB_TREE (current_section)); - } - current_paragraph = CB_LABEL (cb_build_label ($1, current_section)); - current_paragraph->flag_declaratives = !!in_declaratives; - current_paragraph->flag_skip_label = !!skip_statements; - current_paragraph->flag_real_label = !in_debugging; - current_paragraph->segment = current_section->segment; - emit_statement (CB_TREE (current_paragraph)); - } -; - -invalid_statement: - WORD - { - non_const_word = 0; - check_unreached = 0; - if (cb_build_section_name ($1, 0) != cb_error_node) { - if (is_reserved_word (CB_NAME ($1))) { - cb_error_x ($1, _("'%s' is not a statement"), CB_NAME ($1)); - } else if (is_default_reserved_word (CB_NAME ($1))) { - cb_error_x ($1, _("unknown statement '%s'; it may exist in another dialect"), - CB_NAME ($1)); - } else { - cb_error_x ($1, _("unknown statement '%s'"), CB_NAME ($1)); - } - } - YYERROR; - } -; - -_segment: - /* empty */ - { - $$ = NULL; - } -| integer - { - int segnum = cb_get_int ($1); - - $$ = NULL; - if (cb_verify (cb_section_segments, _("section segments"))) { - if (segnum > 99) { - cb_error (_("SECTION segment-number must be less than or equal to 99")); - } else { - if (in_declaratives && segnum > 49) { - cb_error (_("SECTION segment-number in DECLARATIVES must be less than 50")); - } - if (!in_declaratives) { - current_program->flag_segments = 1; - current_section->segment = segnum; - } else { - /* Simon: old version did not allow segments in declaratives at all - ToDo: check codegen for possible missing parts */ - CB_PENDING (_("SECTION segment within DECLARATIVES")); - } - } - } - } -; - - -/* Statements */ - -statement_list: - %prec SHIFT_PREFER - { - $$ = current_program->exec_list; - current_program->exec_list = NULL; - check_unreached = 0; - } - { - $$ = CB_TREE (current_statement); - current_statement = NULL; - } - statements - { - $$ = cb_list_reverse (current_program->exec_list); - current_program->exec_list = $1; - current_statement = CB_STATEMENT ($2); - } -; - -statements: - { - cb_tree label; - - if (!current_section) { - label = cb_build_reference ("MAIN SECTION"); - current_section = CB_LABEL (cb_build_label (label, NULL)); - current_section->flag_section = 1; - current_section->flag_dummy_section = 1; - current_section->flag_skip_label = !!skip_statements; - current_section->flag_declaratives = !!in_declaratives; - current_section->xref.skip = 1; - emit_statement (CB_TREE (current_section)); - } - if (!current_paragraph) { - label = cb_build_reference ("MAIN PARAGRAPH"); - current_paragraph = CB_LABEL (cb_build_label (label, NULL)); - CB_TREE (current_paragraph)->source_file - = CB_TREE (current_section)->source_file; - CB_TREE (current_paragraph)->source_line - = CB_TREE (current_section)->source_line; - current_paragraph->flag_declaratives = !!in_declaratives; - current_paragraph->flag_skip_label = !!skip_statements; - current_paragraph->flag_dummy_paragraph = 1; - current_paragraph->xref.skip = 1; - emit_statement (CB_TREE (current_paragraph)); - } - if (check_headers_present (COBC_HD_PROCEDURE_DIVISION, 0, 0, 0) == 1) { - if (current_program->prog_type == COB_MODULE_TYPE_PROGRAM) { - backup_current_pos (); - emit_entry (current_program->program_id, 0, NULL, NULL); - } - } - } - statement - { - cobc_cs_check = 0; - } -| statements statement - { - cobc_cs_check = 0; - } -; - -statement: - accept_statement -| add_statement -| allocate_statement -| alter_statement -| call_statement -| cancel_statement -| close_statement -| commit_statement -| compute_statement -| continue_statement -| delete_statement -| destroy_statement -| disable_statement -| display_statement -| divide_statement -| enable_statement -| entry_statement -| evaluate_statement -| exit_statement -| free_statement -| generate_statement -| goto_statement -| goback_statement -| if_statement -| initialize_statement -| initiate_statement -| inquire_statement -| inspect_statement -/* | TODO: invoke_statement */ -| json_generate_statement -| json_parse_statement -| merge_statement -| modify_statement -| move_statement -| multiply_statement -| open_statement -| perform_statement -| purge_statement -| raise_statement -| read_statement -| ready_statement -| receive_statement -| release_statement -| reset_statement -/* | TODO: resume_statement */ -| return_statement -| rewrite_statement -| rollback_statement -| search_statement -| send_statement -| set_statement -| sort_statement -| start_statement -| start_transaction_statement -| stop_statement -| string_statement -| subtract_statement -| suppress_statement -| terminate_statement -| transform_statement -| unlock_statement -| unstring_statement -| validate_statement -| write_statement -| xml_generate_statement -| xml_parse_statement -| %prec SHIFT_PREFER - NEXT SENTENCE - { - if (cb_verify (cb_next_sentence_phrase, "NEXT SENTENCE")) { - cb_tree label; - char name[32]; - - begin_statement ("NEXT SENTENCE", 0); - sprintf (name, "L$%d", next_label_id); - label = cb_build_reference (name); - next_label_list = cb_list_add (next_label_list, label); - emit_statement (cb_build_goto (label, NULL)); - } - check_unreached = 0; - } -| error error_stmt_recover - { - yyerrok; - cobc_cs_check = 0; - } -; - - -/* ACCEPT statement */ - -accept_statement: - ACCEPT - { - begin_statement ("ACCEPT", TERM_ACCEPT); - cobc_cs_check = CB_CS_ACCEPT; - } - accept_body - _end_accept -; - -accept_body: - accp_identifier - { - check_duplicate = 0; - check_line_col_duplicate = 0; - line_column = NULL; - } - _accept_clauses _accept_exception_phrases - { - /* Check for invalid use of screen clauses */ - if (current_statement->attr_ptr - || (!is_screen_field ($1) && line_column)) { - cb_verify_x ($1, cb_accept_display_extensions, - _("non-standard ACCEPT")); - } - - if (cb_accept_update && !has_dispattr (COB_SCREEN_NO_UPDATE)) { - set_dispattr (COB_SCREEN_UPDATE); - } - if (cb_accept_auto && !has_dispattr (COB_SCREEN_TAB)) { - set_dispattr (COB_SCREEN_AUTO); - } - if ($1 == cb_null && current_statement->attr_ptr) { - if (current_statement->attr_ptr->prompt) { - emit_conflicting_clause_message ("ACCEPT OMITTED", - _("PROMPT clause")); - } - if (current_statement->attr_ptr->size_is) { - emit_conflicting_clause_message ("ACCEPT OMITTED", - _("SIZE IS clause")); - } - } - cobc_cs_check = 0; - cb_emit_accept ($1, line_column, current_statement->attr_ptr); - } -| identifier FROM SCREEN - { - check_duplicate = 0; - check_line_col_duplicate = 0; - line_column = NULL; - } - accept_from_screen_clauses - { - cobc_cs_check = 0; - CB_PENDING ("ACCEPT FROM SCREEN"); - } -| identifier FROM lines_or_number - { - cb_emit_accept_line_or_col ($1, 0); - } -| identifier FROM columns_or_cols - { - cb_emit_accept_line_or_col ($1, 1); - } -| identifier FROM TERMINAL_INFO - { - /* information about terminal and its capabilities - cb_emit_accept_terminal_info ($1); */ - CB_PENDING ("ACCEPT FROM TERMINAL INFO"); - } -| identifier FROM SYSTEM_INFO - { - /* information about OS and runtime features - cb_emit_accept_system_info ($1); */ - CB_PENDING ("ACCEPT FROM SYSTEM INFO"); - } -| identifier FROM DATE YYYYMMDD - { - cobc_cs_check = 0; - cb_emit_accept_date_yyyymmdd ($1); - } -| identifier FROM DATE - { - cobc_cs_check = 0; - cb_emit_accept_date ($1); - } -| identifier FROM DAY YYYYDDD - { - cobc_cs_check = 0; - cb_emit_accept_day_yyyyddd ($1); - } -| identifier FROM DAY - { - cobc_cs_check = 0; - cb_emit_accept_day ($1); - } -| identifier FROM DAY_OF_WEEK - { - cb_emit_accept_day_of_week ($1); - } - /* note: GnuCOBOL uses screenio.cpy 9(4) identifier, - MicroFocus/ACUCOBOL 99 */ -| identifier FROM ESCAPE _key - { - cb_emit_accept_escape_key ($1); - } - /* note: GnuCOBOL uses ISO X(4) identifier, - MicroFocus 9(3) */ -| identifier FROM EXCEPTION STATUS - { - cb_emit_accept_exception_status ($1); - } -| identifier FROM INPUT STATUS - { - /* check is data from keyboard available? "1", else "0" - cb_emit_accept_input_status ($1); */ - CB_PENDING ("ACCEPT FROM INPUT STATUS"); - } -| identifier FROM TIME - { - cb_emit_accept_time ($1); - } -| identifier FROM USER NAME - { - cobc_cs_check = 0; - cb_emit_accept_user_name ($1); - } -| identifier FROM COMMAND_LINE - { - cb_emit_accept_command_line ($1); - } -| identifier FROM ENVIRONMENT_VALUE _accept_exception_phrases - { - cb_emit_accept_environment ($1); - } -| identifier FROM ENVIRONMENT simple_display_value _accept_exception_phrases - { - cb_emit_get_environment ($4, $1); - } -| identifier FROM ARGUMENT_NUMBER - { - cb_emit_accept_arg_number ($1); - } -| identifier FROM ARGUMENT_VALUE _accept_exception_phrases - { - cb_emit_accept_arg_value ($1); - } -| identifier FROM mnemonic_name - { - cb_emit_accept_mnemonic ($1, $3); - } -| identifier FROM WORD - { - cb_emit_accept_name ($1, $3); - } -| field_with_pos_specifier _accept_clauses - { - cb_verify_x ($1, cb_accept_display_extensions, - _("non-standard ACCEPT")); - - if (cb_accept_update && !has_dispattr (COB_SCREEN_NO_UPDATE)) { - set_dispattr (COB_SCREEN_UPDATE); - } - if (cb_accept_auto && !has_dispattr (COB_SCREEN_TAB)) { - set_dispattr (COB_SCREEN_AUTO); - } - cobc_cs_check = 0; - cb_emit_accept ($1, line_column, current_statement->attr_ptr); - } -| cd_name _message COUNT - { - CB_PENDING ("ACCEPT MESSAGE COUNT"); - } -; - -accp_identifier: - identifier -| OMITTED - { - $$ = cb_null; - } -; - -field_with_pos_specifier: - { - check_duplicate = 0; - check_line_col_duplicate = 0; - line_column = NULL; - } - pos_specifier identifier - { - $$ = $3; - } -; - -pos_specifier: - TOK_OPEN_PAREN pos_specifier_value COMMA_DELIM pos_specifier_value TOK_CLOSE_PAREN - { - line_column = CB_BUILD_PAIR ($2, $4); - } -| TOK_OPEN_PAREN pos_specifier_value COMMA_DELIM TOK_CLOSE_PAREN - { - line_column = CB_BUILD_PAIR ($2, cb_int0); - } -| TOK_OPEN_PAREN COMMA_DELIM pos_specifier_value TOK_CLOSE_PAREN - { - line_column = CB_BUILD_PAIR (cb_int0, $3); - } -; - -pos_specifier_value: - identifier_or_numeric_literal /* note: handles special register LIN/COL, too */ - { - $$ = $1; - } -| identifier_or_numeric_literal TOK_PLUS numeric_literal - { - $$ = cb_build_binary_op ($1, '+', $3); - } -| identifier_or_numeric_literal TOK_MINUS numeric_literal - { - $$ = cb_build_binary_op ($1, '-', $3); - } -; - -identifier_or_numeric_literal: - identifier -| numeric_literal -; - - -_accept_clauses: - /* empty */ -| accept_clauses -; - -accept_clauses: - accept_clause -| accept_clauses accept_clause -; - -accept_clause: - at_line_column -| FROM_CRT - { - check_repeated ("FROM CRT", SYN_CLAUSE_2, &check_duplicate); - } -| mode_is_block - { - check_repeated ("MODE IS BLOCK", SYN_CLAUSE_3, &check_duplicate); - } -| _with accp_attr -| _before TIME positive_id_or_lit - { - check_repeated (_("TIME-OUT or BEFORE TIME clauses"), SYN_CLAUSE_4, - &check_duplicate); - set_attribs (NULL, NULL, NULL, $3, NULL, NULL, 0); - } -; - -accept_from_screen_clauses: - accept_from_screen_clause -| accept_from_screen_clauses accept_from_screen_clause -; - -accept_from_screen_clause: - /* FIXME: could be optional FROM instead of optional AT */ - at_line_column -| SIZE _is pos_num_id_or_lit_or_zero /* ignored, as ACCEPT FROM is pending */ -; - -lines_or_number: - LINES -| LINE NUMBER -; - -at_line_column: - _at line_number - { - set_attr_with_conflict ("LINE", SYN_CLAUSE_1, - _("AT screen-location"), SYN_CLAUSE_3, 1, - &check_line_col_duplicate); - - if ((CB_LITERAL_P ($2) && cb_get_int ($2) == 0) || $2 == cb_zero) { - cb_verify (cb_accept_display_extensions, "LINE 0"); - } - - if (!line_column) { - line_column = CB_BUILD_PAIR ($2, cb_int0); - } else { - CB_PAIR_X (line_column) = $2; - } - } -| _at column_number - { - set_attr_with_conflict ("COLUMN", SYN_CLAUSE_2, - _("AT screen-location"), SYN_CLAUSE_3, 1, - &check_line_col_duplicate); - - if ((CB_LITERAL_P ($2) && cb_get_int ($2) == 0) || $2 == cb_zero) { - cb_verify (cb_accept_display_extensions, "COLUMN 0"); - } - - if (!line_column) { - line_column = CB_BUILD_PAIR (cb_int0, $2); - } else { - CB_PAIR_Y (line_column) = $2; - } - } -| AT num_id_or_lit - { - set_attr_with_conflict (_("AT screen-location"), SYN_CLAUSE_3, - _("LINE or COLUMN"), SYN_CLAUSE_1 | SYN_CLAUSE_2, - 1, &check_line_col_duplicate); - - cb_verify (cb_accept_display_extensions, "AT clause"); - - line_column = $2; - } -; - -line_number: - LINE _number num_id_or_lit - { - /* FIXME: arithmetic expression should be possible, too, only numeric literals! */ - $$ = $3; - } -; - -column_number: - column_or_col_or_position_or_pos _number num_id_or_lit - { - /* FIXME: arithmetic expression should be possible, too, only numeric literals! */ - $$ = $3; - } -; - -mode_is_block: - MODE _is BLOCK - { - cobc_cs_check = 0; - } -; - -accp_attr: - AUTO - { - check_repeated ("AUTO", SYN_CLAUSE_5, &check_duplicate); - set_dispattr_with_conflict ("AUTO", COB_SCREEN_AUTO, - "TAB", COB_SCREEN_TAB); - } -| TAB - { - check_repeated ("TAB", SYN_CLAUSE_6, &check_duplicate); - set_dispattr_with_conflict ("TAB", COB_SCREEN_TAB, - "AUTO", COB_SCREEN_AUTO); - } -| BELL - { - check_repeated ("BELL", SYN_CLAUSE_7, &check_duplicate); - set_dispattr (COB_SCREEN_BELL); - } -| NO BELL - { - check_repeated ("BELL", SYN_CLAUSE_7, &check_duplicate); - /* FIXME: do we need a COB_NO_SCREEN_BELL here? - set_dispattr (COB_SCREEN_BELL); */ - } -| BLINK - { - check_repeated ("BLINK", SYN_CLAUSE_8, &check_duplicate); - set_dispattr (COB_SCREEN_BLINK); - } -| CONVERSION - { - check_repeated ("CONVERSION", SYN_CLAUSE_9, &check_duplicate); - CB_PENDING ("ACCEPT CONVERSION"); - } -| CURSOR _is positive_id_or_lit - { - /* FIXME: arithmetic expression should be possible, too! */ - if (current_program->cursor_pos) { - emit_duplicate_clause_message ("CURSOR"); - } else { - /* TODO: actually reasonable and easy extension: an - *offset within the field* [auto-correct to 1/max] - (when variable also stored back on return) - */ - CB_PENDING ("ACCEPT ... WITH CURSOR"); - } - } -| FULL - { - check_repeated ("FULL", SYN_CLAUSE_10, &check_duplicate); - set_dispattr (COB_SCREEN_FULL); - } -| LEFTLINE - { - check_repeated ("LEFTLINE", SYN_CLAUSE_12, &check_duplicate); - set_dispattr (COB_SCREEN_LEFTLINE); - } -| LOWER - { - check_repeated ("LOWER", SYN_CLAUSE_13, &check_duplicate); - set_dispattr_with_conflict ("LOWER", COB_SCREEN_LOWER, - "UPPER", COB_SCREEN_UPPER); - } -| HIGHLIGHT - { - check_repeated ("HIGHLIGHT", SYN_CLAUSE_11, &check_duplicate); - set_dispattr_with_conflict ("HIGHLIGHT", COB_SCREEN_HIGHLIGHT, - "LOWLIGHT", COB_SCREEN_LOWLIGHT); - } -| LOWLIGHT - { - check_repeated ("LOWLIGHT", SYN_CLAUSE_14, &check_duplicate); - set_dispattr_with_conflict ("LOWLIGHT", COB_SCREEN_LOWLIGHT, - "HIGHLIGHT", COB_SCREEN_HIGHLIGHT); - } -| SAME /* ACU (?) extension to use the video attributes - currently present at the field's screen location. */ - { - CB_PENDING ("SAME phrase"); - /* may not be specified along with the UNDERLINED, BLINK, REVERSED, - HIGH, LOW, STANDARD, COLOR, FOREGROUND-COLOR, or BACKGROUND-COLOR phrases */ - } -| STANDARD /* ACU extension to reset a group HIGH/LOW */ - { - CB_PENDING ("STANDARD intensity"); - } -| BACKGROUND_HIGH - { - CB_PENDING ("BACKGROUND intensity"); - } -| BACKGROUND_LOW - { - CB_PENDING ("BACKGROUND intensity"); - } -| BACKGROUND_STANDARD - { - CB_PENDING ("BACKGROUND intensity"); - } -| no_echo - { - if (cb_no_echo_means_secure) { - check_repeated ("SECURE", SYN_CLAUSE_20, &check_duplicate); - set_dispattr (COB_SCREEN_SECURE); - } else { - check_repeated ("NO-ECHO", SYN_CLAUSE_15, &check_duplicate); - set_dispattr_with_conflict ("NO-ECHO", COB_SCREEN_NO_ECHO, - "SECURE", COB_SCREEN_SECURE); - } - } -| OVERLINE - { - check_repeated ("OVERLINE", SYN_CLAUSE_16, &check_duplicate); - set_dispattr (COB_SCREEN_OVERLINE); - } -| PROMPT CHARACTER _is id_or_lit - { - check_repeated ("PROMPT", SYN_CLAUSE_17, &check_duplicate); - set_attribs (NULL, NULL, NULL, NULL, $4, NULL, COB_SCREEN_PROMPT); - } -| PROMPT - { - check_repeated ("PROMPT", SYN_CLAUSE_17, &check_duplicate); - set_dispattr (COB_SCREEN_PROMPT); - } -| REQUIRED - { - check_repeated ("REQUIRED", SYN_CLAUSE_18, &check_duplicate); - set_dispattr (COB_SCREEN_REQUIRED); - } -| reverse_video - { - check_repeated ("REVERSE-VIDEO", SYN_CLAUSE_19, &check_duplicate); - set_dispattr (COB_SCREEN_REVERSE); - } -| SECURE - { - check_repeated ("SECURE", SYN_CLAUSE_20, &check_duplicate); - set_dispattr_with_conflict ("SECURE", COB_SCREEN_SECURE, - "NO-ECHO", COB_SCREEN_NO_ECHO); - } -| _protected SIZE _is pos_num_id_or_lit_or_zero - { - /* FIXME: arithmetic expression should be possible, too! */ - check_repeated ("SIZE", SYN_CLAUSE_21, &check_duplicate); - set_attribs (NULL, NULL, NULL, NULL, NULL, $4, 0); - } -| UNDERLINE - { - check_repeated ("UNDERLINE", SYN_CLAUSE_22, &check_duplicate); - set_dispattr (COB_SCREEN_UNDERLINE); - } -| NO update_default - { - check_repeated ("NO UPDATE", SYN_CLAUSE_23, &check_duplicate); - set_dispattr_with_conflict ("NO UPDATE", COB_SCREEN_NO_UPDATE, - "UPDATE", COB_SCREEN_UPDATE); - } -| update_default - { - check_repeated ("UPDATE", SYN_CLAUSE_24, &check_duplicate); - set_dispattr_with_conflict ("UPDATE", COB_SCREEN_UPDATE, - "NO UPDATE", COB_SCREEN_NO_UPDATE); - } -| UPPER - { - check_repeated ("UPPER", SYN_CLAUSE_25, &check_duplicate); - set_dispattr_with_conflict ("UPPER", COB_SCREEN_UPPER, - "LOWER", COB_SCREEN_LOWER); - } -| COLOR _is num_id_or_lit - { - /* FIXME: arithmetic expression should be possible, too! */ - check_repeated ("FOREGROUND-COLOR", SYN_CLAUSE_26, &check_duplicate); - check_repeated ("BACKGROUND-COLOR", SYN_CLAUSE_27, &check_duplicate); - CB_PENDING ("COLOR"); - } -| FOREGROUND_COLOR _is num_id_or_lit - { - check_repeated ("FOREGROUND-COLOR", SYN_CLAUSE_26, &check_duplicate); - set_attribs ($3, NULL, NULL, NULL, NULL, NULL, 0); - } -| BACKGROUND_COLOR _is num_id_or_lit - { - check_repeated ("BACKGROUND-COLOR", SYN_CLAUSE_27, &check_duplicate); - set_attribs (NULL, $3, NULL, NULL, NULL, NULL, 0); - } -| SCROLL _up _scroll_lines - { - check_repeated ("SCROLL UP", SYN_CLAUSE_28, &check_duplicate); - set_attribs_with_conflict (NULL, NULL, $3, NULL, NULL, NULL, - "SCROLL UP", COB_SCREEN_SCROLL_UP, - "SCROLL DOWN", COB_SCREEN_SCROLL_DOWN); - } -| SCROLL DOWN _scroll_lines - { - check_repeated ("SCROLL DOWN", SYN_CLAUSE_19, &check_duplicate); - set_attribs_with_conflict (NULL, NULL, $3, NULL, NULL, NULL, - "SCROLL DOWN", COB_SCREEN_SCROLL_DOWN, - "SCROLL UP", COB_SCREEN_SCROLL_UP); - } -| TIME_OUT _after positive_id_or_lit - { - check_repeated (_("TIME-OUT or BEFORE TIME clauses"), SYN_CLAUSE_4, - &check_duplicate); - set_attribs (NULL, NULL, NULL, $3, NULL, NULL, 0); - } -| _control KEY _in key_dest -; - -_key_dest: /* empty */ | key_dest; - -key_dest: - /* note: GnuCOBOL uses screenio.cpy 9(4) identifier, ACUCOBOL 99 */ - numeric_identifier - { - check_repeated ("CONTROL KEY", SYN_CLAUSE_29, &check_duplicate); - CB_PENDING ("CONTROL KEY"); -#if 0 /* should generate the following *after* the ACCEPT is finished */ - cb_emit_accept_escape_key ($1); -#endif - } -; - -no_echo: - NO ECHO -| NO_ECHO -| OFF -; - -reverse_video: - REVERSE_VIDEO -| REVERSED -| REVERSE -; - -update_default: - UPDATE -| DEFAULT -; - -_end_accept: - /* empty */ %prec SHIFT_PREFER - { - TERMINATOR_WARNING ($-2, ACCEPT); - } -| END_ACCEPT - { - TERMINATOR_CLEAR ($-2, ACCEPT); -# if 0 /* activate only for debugging purposes for attribs - FIXME: Replace by DEBUG_LOG function */ - if (current_statement->attr_ptr) { - print_bits (current_statement->attr_ptr->dispattrs); - } else { - fputs("No Attribs", stderr); - } -#endif - } -; - - -/* ADD statement */ - -add_statement: - ADD - { - begin_statement ("ADD", TERM_ADD); - } - add_body - _end_add -; - -add_body: - x_list TO arithmetic_x_list on_size_error_phrases - { - cb_emit_arithmetic ($3, '+', cb_build_binary_list ($1, '+')); - } -| x_list _add_to GIVING arithmetic_x_list on_size_error_phrases - { - if ($2) { - cb_list_add ($1, $2); - } - cb_emit_arithmetic ($4, 0, cb_build_binary_list ($1, '+')); - } -| CORRESPONDING identifier TO identifier flag_rounded on_size_error_phrases - { - cb_emit_corresponding (cb_build_add, $4, $2, $5); - } -| TABLE table_identifier TO table_identifier flag_rounded _from_idx_to_idx _dest_index on_size_error_phrases - { - CB_PENDING ("ADD TABLE"); - cb_emit_tab_arithmetic (cb_build_add, $4, $2, $5, $6, $7); - } -; - -_add_to: - /* empty */ { $$ = NULL; } -| TO x { $$ = $2; } -; - -_end_add: - /* empty */ %prec SHIFT_PREFER - { - TERMINATOR_WARNING ($-2, ADD); - } -| END_ADD - { - TERMINATOR_CLEAR ($-2, ADD); - } -; - - -/* ALLOCATE statement */ - -allocate_statement: - ALLOCATE - { - begin_statement ("ALLOCATE", 0); - cobc_cs_check = CB_CS_ALLOCATE; - current_statement->flag_no_based = 1; - } - allocate_body -; - -allocate_body: - identifier flag_initialized _loc allocate_returning - { - cb_emit_allocate ($1, $4, NULL, $2); - } -| exp CHARACTERS flag_initialized_to _loc allocate_returning - { - if ($5 == NULL) { - cb_error_x (CB_TREE (current_statement), - _("ALLOCATE CHARACTERS requires RETURNING clause")); - } else { - cb_emit_allocate (NULL, $5, $1, $3); - } - } -; - -_loc: - /* empty */ -| LOC integer - { - int adressing = cb_get_int ($2); - - if (adressing == 24 - || adressing == 31) { - cb_warning (COBC_WARN_FILLER, _("ignoring %s phrase"), "LOC"); - } else { - cb_error (_("addressing mode should be either 24 or 31 bit")); - } - } - -allocate_returning: - /* empty */ { $$ = NULL; } -| RETURNING target_x { $$ = $2; } -; - - -/* ALTER statement */ - -alter_statement: - ALTER - { - begin_statement ("ALTER", 0); - cb_verify (cb_alter_statement, "ALTER"); - } - alter_body -; - -alter_body: - alter_entry -| alter_body alter_entry -; - -alter_entry: - procedure_name TO _proceed_to procedure_name - { - cb_emit_alter ($1, $4); - } -; - -_proceed_to: | PROCEED TO ; - - -/* CALL statement */ - -call_statement: - CALL - { - begin_statement ("CALL", TERM_CALL); - cobc_cs_check = CB_CS_CALL; - call_nothing = 0; - cobc_allow_program_name = 1; - backup_current_pos (); - } - call_body - _end_call - { - cobc_cs_check = 0; - } -; - -call_body: - _mnemonic_conv _thread_start program_or_prototype - { - cobc_allow_program_name = 0; - } - _thread_handle - _conv_linkage - call_using - call_returning - call_exception_phrases - { - int call_conv = 0; - int call_conv_local = 0; - - if (current_program->prog_type == COB_MODULE_TYPE_PROGRAM - && !current_program->flag_recursive - && is_recursive_call ($3)) { - cb_warning_x (COBC_WARN_FILLER, $3, - _("recursive program call - assuming RECURSIVE attribute")); - current_program->flag_recursive = 1; - } - call_conv = current_call_convention; - if ($6) { - if (current_call_convention & CB_CONV_STATIC_LINK) { - call_conv = CB_INTEGER ($6)->val | CB_CONV_STATIC_LINK; - } else { - call_conv = CB_INTEGER ($6)->val; - } - if ($1) { - /* note: $1 is likely to be a reference to SPECIAL-NAMES */ - cb_error_x ($6, _("%s and %s are mutually exclusive"), - "CALL-CONVENTION", "WITH LINKAGE"); - } - } - if ((CB_PAIR_X ($9) != NULL) - && (call_conv & CB_CONV_STATIC_LINK)) { - cb_warning_x (COBC_WARN_FILLER, $3, - _("STATIC CALL convention ignored because of ON EXCEPTION")); - call_conv &= ~CB_CONV_STATIC_LINK; - } - if ($1) { - if (CB_INTEGER_P ($1)) { - call_conv_local = CB_INTEGER ($1)->val; - if ((CB_PAIR_X ($9) != NULL) - && (call_conv_local & CB_CONV_STATIC_LINK)) { - cb_warning_x (COBC_WARN_FILLER, $1, - _("ON EXCEPTION ignored because of STATIC CALL")); - CB_PAIR_X ($9) = NULL; - } - call_conv |= call_conv_local; - if (CB_INTEGER ($1)->val & CB_CONV_COBOL) { - call_conv &= ~CB_CONV_STDCALL; - } else { - call_conv &= ~CB_CONV_COBOL; - } - } else { - call_conv = cb_get_int($1); - } - } - /* For CALL ... RETURNING NOTHING, set the call convention bit */ - if (call_nothing) { - call_conv |= CB_CONV_NO_RET_UPD; - } - cb_emit_call ($3, $7, $8, CB_PAIR_X ($9), CB_PAIR_Y ($9), - cb_int (call_conv), $2, $5, backup_source_line); - } -; - -_conv_linkage: - /* empty */ - { - $$ = NULL; - } -| WITH - { - /* FIXME: hack - fake cs for context-sensitive WITH ... LINKAGE */ - cobc_cs_check |= CB_CS_OPTIONS; - backup_current_pos (); - } - conv_linkage_option LINKAGE - { - $$ = $3; - restore_backup_pos ($$); - cobc_cs_check ^= CB_CS_OPTIONS; - cb_verify_x ($$, cb_call_convention_linkage, "WITH ... LINKAGE"); - } -; - -conv_linkage_option: - STDCALL - { - $$ = cb_int (CB_CONV_STDCALL); - } -| C - { - $$ = cb_int (CB_CONV_C); - } -| PASCAL - { - $$ = cb_int (CB_CONV_PASCAL); - } -; - -_mnemonic_conv: - /* empty */ - { - $$ = NULL; - } -| mnemonic_conv - { - cb_verify (cb_call_convention_mnemonic, "CALL-/ENTRY-CONVENTION"); - $$ = $1; - } -; - -mnemonic_conv: - STATIC /* not active for ENTRY-CONVENTION via PROCEDURE DIVISION */ - { - if (current_call_convention & CB_CONV_COBOL) { - $$ = cb_int (CB_CONV_STATIC_LINK | CB_CONV_COBOL); - } else { - $$ = cb_int (CB_CONV_STATIC_LINK); - } - } -| STDCALL /* not active for ENTRY-CONVENTION via PROCEDURE DIVISION */ - { - $$ = cb_int (CB_CONV_STDCALL); - } -| C /* not active for ENTRY-CONVENTION via PROCEDURE DIVISION */ - { - $$ = cb_int (CB_CONV_C); - } -| TOK_EXTERN /* not active for ENTRY-CONVENTION via PROCEDURE DIVISION */ - { - $$ = cb_int (CB_CONV_C); - } -| PASCAL /* not active for ENTRY-CONVENTION via PROCEDURE DIVISION */ - { - $$ = cb_int (CB_CONV_PASCAL); - } -| MNEMONIC_NAME - { - cb_tree x; - - x = cb_ref ($1); - if (CB_VALID_TREE (x)) { - if (CB_SYSTEM_NAME(x)->token != CB_FEATURE_CONVENTION) { - cb_error_x ($1, _("invalid mnemonic name")); - $$ = NULL; - } else { - $$ = CB_SYSTEM_NAME(x)->value; - } - } else { - $$ = NULL; - } - } -; - -program_or_prototype: - id_or_lit_or_func - { - if (CB_LITERAL_P ($1)) { - cb_trim_program_id ($1); - } - } -| _id_or_lit_or_func_as nested_or_prototype - { - cb_verify (cb_program_prototypes, _("CALL/CANCEL with program-prototype-name")); - /* hack to push the prototype name */ - if ($2 && CB_REFERENCE_P ($2)) { - if ($1) { - cb_warning_x (COBC_WARN_FILLER, $1, _("id/literal ignored, using prototype name")); - } - $$ = $2; - } else if ($1 && CB_LITERAL_P ($1)) { - $$ = $1; - } else { - cb_error (_("NESTED phrase is only valid with literal")); - $$ = cb_error_node; - } - } -; - -_id_or_lit_or_func_as: - /* empty */ - { - $$ = NULL; - } -| - id_or_lit_or_func AS - { - if (CB_LITERAL_P ($1)) { - cb_trim_program_id ($1); - } - $$ = $1; - } -; - -nested_or_prototype: - NESTED - { - CB_PENDING ("NESTED phrase for CALL statement"); - } -| PROGRAM_NAME -; - -call_using: - /* empty */ - { - $$ = NULL; - } -| USING - { - call_mode = CB_CALL_BY_REFERENCE; - size_mode = CB_SIZE_4; - } - call_param_list - { - if (cb_list_length ($3) > MAX_CALL_FIELD_PARAMS) { - cb_error_x (CB_TREE (current_statement), - _("number of arguments exceeds maximum %d"), - MAX_CALL_FIELD_PARAMS); - } - $$ = $3; - } -; - -call_param_list: - call_param { $$ = $1; } -| call_param_list - call_param { $$ = cb_list_append ($1, $2); } -; - -call_param: - _call_type OMITTED - { - if (call_mode != CB_CALL_BY_REFERENCE) { - cb_error_x (CB_TREE (current_statement), - _("OMITTED only allowed when arguments are passed BY REFERENCE")); - } - $$ = CB_BUILD_PAIR (cb_int (call_mode), cb_null); - } -| _call_type _size_optional call_x - { - int save_mode; /* internal single parameter only mode */ - - save_mode = call_mode; - if (CB_LITERAL_P($3)) { - /* literals become BY CONTENT */ - if (CB_NUMERIC_LITERAL_P ($3)) { - /* If not BY VALUE numeric-literals become BY CONTENT */ - if (call_mode != CB_CALL_BY_VALUE) { - call_mode = CB_CALL_BY_CONTENT; - } - } else { - call_mode = CB_CALL_BY_CONTENT; - } - } - if (call_mode != CB_CALL_BY_REFERENCE) { - if (CB_FILE_P ($3) || (CB_REFERENCE_P ($3) && - CB_FILE_P (CB_REFERENCE ($3)->value))) { - cb_error_x (CB_TREE (current_statement), - _("invalid file name reference")); - } else if (call_mode == CB_CALL_BY_VALUE) { - /* FIXME: compiler configuration needed, IBM allows one-byte - alphanumeric items [--> a `char`], too, while - COBOL 2002/2014 allow only numeric literals - --> revise after rw-merge */ - if (cb_category_is_alpha ($3)) { - cb_warning_x (COBC_WARN_FILLER, $3, - _("BY CONTENT assumed for alphanumeric item '%s'"), - cb_name ($3)); - call_mode = CB_CALL_BY_CONTENT; - } else if (cb_category_is_national ($3)) { - cb_warning_x (COBC_WARN_FILLER, $3, - _("BY CONTENT assumed for national item '%s'"), - cb_name ($3)); - call_mode = CB_CALL_BY_CONTENT; - } - } - } - $$ = CB_BUILD_PAIR (cb_int (call_mode), $3); - CB_SIZES ($$) = size_mode; - call_mode = save_mode; - } -; - -_call_type: - /* empty */ -| _by REFERENCE - { - call_mode = CB_CALL_BY_REFERENCE; - } -| _by CONTENT - { - if (current_program->flag_chained) { - cb_error_x (CB_TREE (current_statement), - _("%s not allowed in CHAINED programs"), "BY CONTENT"); - } else { - call_mode = CB_CALL_BY_CONTENT; - } - } -| _by VALUE - { - if (current_program->flag_chained) { - cb_error_x (CB_TREE (current_statement), - _("%s not allowed in CHAINED programs"), "BY VALUE"); - } else { - call_mode = CB_CALL_BY_VALUE; - } - } -; - -call_returning: - /* empty */ - { - $$ = NULL; - } -| return_give _into identifier - { - $$ = $3; - } -| return_give null_or_omitted - { - $$ = cb_null; - } -| return_give NOTHING - { - call_nothing = CB_CONV_NO_RET_UPD; - $$ = cb_null; - } -| return_give ADDRESS _of identifier - { - struct cb_field *f; - - if (cb_ref ($4) != cb_error_node) { - f = CB_FIELD_PTR ($4); - if (f->level != 1 && f->level != 77) { - cb_error (_("RETURNING item must have level 01 or 77")); - $$ = NULL; - } else if (f->storage != CB_STORAGE_LINKAGE && - !f->flag_item_based) { - cb_error (_("RETURNING item must be a LINKAGE SECTION item or have BASED clause")); - $$ = NULL; - } else { - $$ = cb_build_address ($4); - } - } else { - $$ = NULL; - } - } -; - -return_give: - RETURNING -| GIVING -; - -null_or_omitted: - TOK_NULL -| OMITTED -; - -call_exception_phrases: - %prec SHIFT_PREFER - { - $$ = CB_BUILD_PAIR (NULL, NULL); - } -| call_on_exception _call_not_on_exception - { - $$ = CB_BUILD_PAIR ($1, $2); - } -| call_not_on_exception _call_on_exception - { - if ($2) { - cb_verify (cb_not_exception_before_exception, - _("NOT EXCEPTION before EXCEPTION")); - } - $$ = CB_BUILD_PAIR ($2, $1); - } -; - -_call_on_exception: - %prec SHIFT_PREFER - { - $$ = NULL; - } -| call_on_exception - { - $$ = $1; - } -; - -call_on_exception: - EXCEPTION statement_list - { - $$ = $2; - } -| TOK_OVERFLOW statement_list - { - cb_verify (cb_call_overflow, "ON OVERFLOW"); - $$ = $2; - } -; - -_call_not_on_exception: - %prec SHIFT_PREFER - { - $$ = NULL; - } -| call_not_on_exception - { - $$ = $1; - } -; - -call_not_on_exception: - NOT_EXCEPTION statement_list - { - $$ = $2; - } -; - -_end_call: - /* empty */ %prec SHIFT_PREFER - { - TERMINATOR_WARNING ($-2, CALL); - } -| END_CALL - { - TERMINATOR_CLEAR ($-2, CALL); - } -; - - -/* CANCEL statement */ - -cancel_statement: - CANCEL - { - begin_statement ("CANCEL", 0); - cobc_allow_program_name = 1; - } - cancel_body - { - cobc_allow_program_name = 0; - } -; - -cancel_body: - id_or_lit_or_program_name - { - cb_emit_cancel ($1); - } -| cancel_body id_or_lit_or_program_name - { - cb_emit_cancel ($2); - } -; - -id_or_lit_or_program_name: - id_or_lit -| PROGRAM_NAME - { - cb_verify (cb_program_prototypes, _("CALL/CANCEL with program-prototype-name")); - } -; - -/* CLOSE statement */ - -close_statement: - CLOSE - { - begin_statement ("CLOSE", 0); - } - close_body -; - -close_body: - close_files -| close_window -; - -close_files: - file_name _close_option - { - begin_implicit_statement (); - cb_emit_close ($1, $2); - } -| close_files file_name _close_option - { - begin_implicit_statement (); - cb_emit_close ($2, $3); - } -; - -_close_option: - /* empty */ { $$ = cb_int (COB_CLOSE_NORMAL); } -| reel_or_unit { $$ = cb_int (COB_CLOSE_UNIT); } -| reel_or_unit _for REMOVAL { $$ = cb_int (COB_CLOSE_UNIT_REMOVAL); } -| _with NO REWIND { $$ = cb_int (COB_CLOSE_NO_REWIND); } -| _with LOCK { $$ = cb_int (COB_CLOSE_LOCK); } -; - -close_window: - WINDOW - { - CB_PENDING ("GRAPHICAL WINDOW"); - current_statement->name = "CLOSE WINDOW"; - } - identifier _close_display_option - { - cb_emit_close_window ($3, $4); - } -; - -_close_display_option: - /* empty */ { $$ = NULL; } -| _with NO DISPLAY { $$ = cb_int0; } -; - - -/* COMPUTE statement */ - -compute_statement: - COMPUTE - { - begin_statement ("COMPUTE", TERM_COMPUTE); - } - compute_body - _end_compute -; - -compute_body: - arithmetic_x_list comp_equal exp on_size_error_phrases - { - cb_emit_arithmetic ($1, 0, $3); - } -; - -_end_compute: - /* empty */ %prec SHIFT_PREFER - { - TERMINATOR_WARNING ($-2, COMPUTE); - } -| END_COMPUTE - { - TERMINATOR_CLEAR ($-2, COMPUTE); - } -; - - -/* COMMIT statement */ - -commit_statement: - COMMIT _transaction - { - begin_statement ("COMMIT", 0); - cb_emit_commit (); - } -; - - -/* CONTINUE statement */ - -continue_statement: - CONTINUE - { - backup_current_pos (); - } - _continue_after_phrase - { - if (!$3) { - /* Do not check unreached for CONTINUE without after phrase */ - unsigned int save_unreached = check_unreached; - check_unreached = 0; - begin_statement_from_backup_pos ("CONTINUE", 0); - cb_emit_continue (NULL); - check_unreached = save_unreached; - } else { - begin_statement_from_backup_pos ("CONTINUE AFTER", 0); - cb_emit_continue ($3); - } - } -; - -_continue_after_phrase: - /* empty */ { $$ = NULL;} -| AFTER { - /* FIXME: hack - fake cs for context-sensitive SECONDS */ - cobc_cs_check = CB_CS_RETRY; - } - exp SECONDS - { - $$ = $3; - } -; - - -/* DESTROY statement */ - -destroy_statement: - DESTROY - { - begin_statement ("DESTROY", 0); - CB_PENDING ("GRAPHICAL CONTROL"); - } - destroy_body -; - -destroy_body: - ALL _controls - { - cb_emit_destroy (NULL); - } -/* TODO for later: add Format 3, mixing identifier_list - with positions like in DISPLAY - (and error on this, destroy on position is bad...) */ -| identifier_list - { - cb_emit_destroy ($1); - } -; - - -/* DELETE statement */ - -delete_statement: - DELETE - { - begin_statement ("DELETE", TERM_DELETE); - } - delete_body - _end_delete -; - -delete_body: - file_name _record _retry_phrase _invalid_key_phrases - { - cb_emit_delete ($1); - } -| TOK_FILE delete_file_list -; - -delete_file_list: - file_name - { - begin_implicit_statement (); - cb_emit_delete_file ($1); - } -| delete_file_list file_name - { - begin_implicit_statement (); - cb_emit_delete_file ($2); - } -; - -_end_delete: - /* empty */ %prec SHIFT_PREFER - { - TERMINATOR_WARNING ($-2, DELETE); - } -| END_DELETE - { - TERMINATOR_CLEAR ($-2, DELETE); - } -; - - -/* DISABLE statement (COMMUNICATION) */ - -disable_statement: - DISABLE - { - begin_statement ("DISABLE", 0); - } - enable_disable_handling -; - - -enable_disable_handling: - communication_mode cd_name _enable_disable_key -; - -_enable_disable_key: - /* empty */ -| _with KEY id_or_lit - { - /* Add cb_verify for <= COBOL-85 */ - } -; - -communication_mode: - /* empty */ /* RM-COBOL extension */ -| INPUT _terminal -| OUTPUT -| I_O TERMINAL -| TERMINAL /* RM-COBOL extension */ -; - - -/* DISPLAY statement */ - -display_statement: - DISPLAY - { - begin_statement ("DISPLAY", TERM_DISPLAY); - cobc_cs_check = CB_CS_DISPLAY; - display_type = UNKNOWN_DISPLAY; - is_first_display_item = 1; - } - display_body - _end_display -; - -display_body: - id_or_lit UPON_ENVIRONMENT_NAME _display_exception_phrases - { - cb_emit_env_name ($1); - } -| id_or_lit UPON_ENVIRONMENT_VALUE _display_exception_phrases - { - cb_emit_env_value ($1); - } -| id_or_lit UPON_ARGUMENT_NUMBER _display_exception_phrases - { - cb_emit_arg_number ($1); - } -| id_or_lit UPON_COMMAND_LINE _display_exception_phrases - { - cb_emit_command_line ($1); - } -| screen_or_device_display _display_exception_phrases -| display_erase /* note: may also be part of display_pos_specifier */ -| display_pos_specifier -| display_message_box -| display_window -| display_floating_window -| display_initial_window -; - -screen_or_device_display: - display_list _x_list - { - if ($2 != NULL) { - error_if_different_display_type ($2, NULL, NULL, NULL); - cb_emit_display ($2, NULL, cb_int1, NULL, NULL, 0, - display_type); - } - } -| x_list - { - set_display_type ($1, NULL, NULL, NULL); - cb_emit_display ($1, NULL, cb_int1, NULL, NULL, 1, - display_type); - } -; - -display_list: - display_atom -| display_list display_atom -; - -display_atom: - disp_list - { - check_duplicate = 0; - check_line_col_duplicate = 0; - advancing_value = cb_int1; - upon_value = NULL; - line_column = NULL; - } - display_clauses - { - if ($1 == cb_null) { - /* Emit DISPLAY OMITTED. */ - CB_UNFINISHED_X (CB_TREE(current_statement), "DISPLAY OMITTED"); - error_if_no_advancing_in_screen_display (advancing_value); - } - - /* Emit device or screen DISPLAY. */ - - /* - Check that disp_list does not contain an invalid mix of fields. - */ - if (display_type == UNKNOWN_DISPLAY) { - set_display_type ($1, upon_value, line_column, - current_statement->attr_ptr); - } else { - error_if_different_display_type ($1, upon_value, - line_column, - current_statement->attr_ptr); - } - - if (display_type == SCREEN_DISPLAY - || display_type == FIELD_ON_SCREEN_DISPLAY) { - error_if_no_advancing_in_screen_display (advancing_value); - } - - cb_emit_display ($1, upon_value, advancing_value, line_column, - current_statement->attr_ptr, - is_first_display_item, display_type); - - is_first_display_item = 0; - } -; - -disp_list: - x_list - { - $$ = $1; - } -| OMITTED - { - $$ = cb_null; - } -; - -_with_display_attr: - /* empty */ -| WITH display_attrs -; - -display_attrs: - disp_attr -| display_attrs disp_attr -; - -display_clauses: - display_clause -| display_clauses display_clause -; - -display_clause: - display_upon - { - check_repeated ("UPON", SYN_CLAUSE_1, &check_duplicate); - } -| _with NO_ADVANCING - { - check_repeated ("NO ADVANCING", SYN_CLAUSE_2, &check_duplicate); - advancing_value = cb_int0; - } -| mode_is_block - { - check_repeated ("MODE IS BLOCK", SYN_CLAUSE_3, &check_duplicate); - } -| at_line_column -| _with disp_attr -; - -display_upon: - UPON mnemonic_name - { - upon_value = cb_build_display_mnemonic ($2); - } -| UPON WORD - { - upon_value = cb_build_display_name ($2); - } -| UPON PRINTER - { - upon_value = cb_int2; - } -| UPON crt_under - { - upon_value = cb_null; - } -; - -crt_under: - CRT -| CRT_UNDER -; - -display_erase: - ERASE - { - check_duplicate = SYN_CLAUSE_10; - check_line_col_duplicate = 0; - line_column = NULL; - set_dispattr_with_conflict ("ERASE EOS", COB_SCREEN_ERASE_EOS, - "ERASE EOL", COB_SCREEN_ERASE_EOL); - } - _with_display_attr - { - cb_emit_display (CB_LIST_INIT (cb_space), cb_null, cb_int1, line_column, NULL, 1, FIELD_ON_SCREEN_DISPLAY); - } -; - -display_pos_specifier: - /* FIXME: the actual correct version (according to MicroFocus "MS compiler" option) - would allow combination of multiple formats ...*/ - field_or_literal_or_erase_with_pos_specifier _with_display_attr - { - cb_emit_display ($1, cb_null, cb_int1, line_column, NULL, 1, FIELD_ON_SCREEN_DISPLAY); - } -; - -field_or_literal_or_erase_with_pos_specifier: - { - check_duplicate = 0; - check_line_col_duplicate = 0; - line_column = NULL; - } - pos_specifier field_or_literal_or_erase_list - { - $$ = $3; - } -; - -field_or_literal_or_erase_list: - field_or_literal_or_erase - { - $$ = CB_LIST_INIT ($1); - } -| field_or_literal_or_erase_list field_or_literal_or_erase - { - $$ = cb_list_add ($1, $2); - } -; - - -field_or_literal_or_erase: - identifier -| basic_literal -| ERASE - { - set_dispattr_with_conflict ("ERASE EOS", COB_SCREEN_ERASE_EOS, - "ERASE EOL", COB_SCREEN_ERASE_EOL); - $$ = cb_space; - } -; - - -display_message_box: - MESSAGE _box x_list - { - CB_UNFINISHED_X (CB_TREE(current_statement), "DISPLAY MESSAGE"); - upon_value = NULL; - } - _display_message_clauses - { - /* for now: minimal support for display and prompt only */ - if (upon_value) { - cb_emit_display (CB_LIST_INIT (upon_value), NULL, NULL, NULL, - NULL, 1, FIELD_ON_SCREEN_DISPLAY); - } - cb_emit_display ($3, NULL, NULL, NULL, - NULL, 1, FIELD_ON_SCREEN_DISPLAY); - cb_emit_accept (cb_null, NULL, NULL); - } -; - -_display_message_clauses: - /* empty */ -| display_message_clauses -; - -display_message_clauses: - display_message_clause -| display_message_clauses display_message_clause -; - -display_message_clause: - TITLE _is_equal x - { - upon_value = $3; - } -| TYPE _is_equal x -| ICON _is_equal x -| DEFAULT _is_equal x -| return_give x -; - -display_window: - sub_or_window - { - CB_PENDING ("GRAPHICAL WINDOW"); - current_statement->name = "DISPLAY WINDOW"; - } - _upon_window_handle - { - check_duplicate = 0; - check_line_col_duplicate = 0; - line_column = NULL; - upon_value = NULL; /* Hack: stores the POP-UP AREA */ - } - display_window_clauses - { - cb_emit_display_window (NULL, upon_value, $3, line_column, - current_statement->attr_ptr); - } -; - -sub_or_window: - WINDOW -| SUBWINDOW -; - -display_floating_window: - FLOATING _graphical WINDOW - { - CB_PENDING ("GRAPHICAL WINDOW"); - current_statement->name = "DISPLAY FLOATING WINDOW"; - } - _upon_window_handle - { - check_duplicate = 0; - check_line_col_duplicate = 0; - line_column = NULL; - upon_value = NULL; /* Hack: stores the POP-UP AREA */ - } - display_window_clauses - { - if ($2) { - /* TODO: set "CELL WIDTH" and "CELL HEIGHT" to "LABEL FONT" */ - /* if not set already */ - } - cb_emit_display_window (cb_int0, upon_value, $5, line_column, - current_statement->attr_ptr); - } -; - -display_initial_window: - initial_type _graphical WINDOW - { - CB_PENDING ("GRAPHICAL WINDOW"); - current_statement->name = "DISPLAY INITIAL WINDOW"; - check_duplicate = 0; - check_line_col_duplicate = 0; - line_column = NULL; - upon_value = NULL; /* Hack: stores the POP-UP AREA */ - /* TODO: initialize attributes for SHADOW, BOTTOM */ - } - display_window_clauses - { - if ($2) { - /* TODO: set "CELL WIDTH" and "CELL HEIGHT" to "LABEL FONT" */ - /* if not set already */ - } - cb_emit_display_window ($1, upon_value, NULL, line_column, - current_statement->attr_ptr); - } -; - -initial_type: - TOK_INITIAL {$$ = cb_int1;} -| STANDARD {$$ = cb_int2;} -| INDEPENDENT {$$ = cb_int3;} -; - -_graphical: - /* empty */ {$$ = NULL;} -| GRAPHICAL {$$ = cb_int1;} -; - -_upon_window_handle: - /* empty */ - { - $$ = NULL; - } -| UPON identifier - { - $$ = $2; - } -; - -window_handle: - identifier - { - struct cb_field *f; - - if (cb_ref ($1) != cb_error_node) { - f = CB_FIELD_PTR ($1); - if (f->usage != CB_USAGE_HNDL_WINDOW - && f->usage != CB_USAGE_HNDL_SUBWINDOW) { - cb_error_x ($1, _("HANDLE must be a %s HANDLE"), "WINDOW"); - } - } - $$ = $1; - } -| WINDOW identifier - { - struct cb_field *f; - - if (cb_ref ($2) != cb_error_node) { - f = CB_FIELD_PTR ($2); - if (f->usage != CB_USAGE_HNDL) { - cb_error_x ($2, _("HANDLE must be a generic HANDLE")); - } - } - $$ = $2; - } -| WINDOW /* current window */ - { - $$ = cb_null; - } -; - -display_window_clauses: - display_window_clause -| display_window_clauses display_window_clause -; - -/* FIXME: has different clauses (some additional while some aren't in) - SCREEN is optional(=implied) for ERASE here */ -display_window_clause: - pop_up_or_handle /* DISPLAY WINDOW actually only takes POP-UP */ -| LINES num_id_or_lit - { - /* TODO: store */ - } -| at_line_column -| _top_or_bottom _left_or_centered_or_right TITLE _is_equal x -| shadow -| boxed -| no_scroll_wrap -| _with disp_attr -; - -shadow: - SHADOW { /* TODO: set attribute */ } -; -boxed: - BOXED { /* TODO: set attribute */ } -; - -_top_or_bottom: - /* empty */ { $$ = cb_int0; } -| TOP { $$ = cb_int0; } -| BOTTOM { $$ = cb_int1; } -; - -_left_or_centered_or_right: - LEFT { $$ = cb_int0; } -| CENTERED { $$ = cb_int1; } -| /* empty */ { $$ = cb_int1; } -| RIGHT { $$ = cb_int2; } -; - -no_scroll_wrap: - _with NO SCROLL -| _with NO WRAP -; - - -pop_up_or_handle: - pop_up_area -| handle_is_in -; - -pop_up_area: - POP_UP _area _is_equal identifier - { - if (upon_value) { - emit_duplicate_clause_message("POP-UP AREA"); - } - upon_value = $4; - } -; - -handle_is_in: - HANDLE _is_in identifier - { - if (!strcmp (current_statement->name, "DISPLAY WINDOW")) { - cb_error_x ($3, _("HANDLE clause invalid for %s"), - current_statement->name); - upon_value = cb_error_node; - } else{ - if (upon_value) { - emit_duplicate_clause_message("POP-UP AREA / HANDLE IN"); - } - upon_value = $3; - } - } -; - -disp_attr: - BELL - { - check_repeated ("BELL", SYN_CLAUSE_4, &check_duplicate); - set_dispattr (COB_SCREEN_BELL); - } -| BLANK LINE - { - check_repeated ("BLANK LINE", SYN_CLAUSE_5, &check_duplicate); - set_dispattr_with_conflict ("BLANK LINE", COB_SCREEN_BLANK_LINE, - "BLANK SCREEN", COB_SCREEN_BLANK_SCREEN); - } -| BLANK SCREEN - { - check_repeated ("BLANK SCREEN", SYN_CLAUSE_6, &check_duplicate); - set_dispattr_with_conflict ("BLANK SCREEN", COB_SCREEN_BLANK_SCREEN, - "BLANK LINE", COB_SCREEN_BLANK_LINE); - } -| BLINK - { - check_repeated ("BLINK", SYN_CLAUSE_7, &check_duplicate); - set_dispattr (COB_SCREEN_BLINK); - } -| CONVERSION - { - check_repeated ("CONVERSION", SYN_CLAUSE_8, &check_duplicate); - cb_warning (COBC_WARN_FILLER, _("ignoring %s phrase"), "CONVERSION"); - } -| ERASE eol - { - check_repeated ("ERASE EOL", SYN_CLAUSE_9, &check_duplicate); - set_dispattr_with_conflict ("ERASE EOL", COB_SCREEN_ERASE_EOL, - "ERASE EOS", COB_SCREEN_ERASE_EOS); - } -| ERASE eos - { - check_repeated ("ERASE EOS", SYN_CLAUSE_10, &check_duplicate); - set_dispattr_with_conflict ("ERASE EOS", COB_SCREEN_ERASE_EOS, - "ERASE EOL", COB_SCREEN_ERASE_EOL); - } -| HIGHLIGHT - { - check_repeated ("HIGHLIGHT", SYN_CLAUSE_11, &check_duplicate); - set_dispattr_with_conflict ("HIGHLIGHT", COB_SCREEN_HIGHLIGHT, - "LOWLIGHT", COB_SCREEN_LOWLIGHT); - } -| LOWLIGHT - { - check_repeated ("LOWLIGHT", SYN_CLAUSE_12, &check_duplicate); - set_dispattr_with_conflict ("LOWLIGHT", COB_SCREEN_LOWLIGHT, - "HIGHLIGHT", COB_SCREEN_HIGHLIGHT); - } -| SAME /* ACU (?) extension to use the video attributes - currently present at the field's screen location. */ - { - CB_PENDING ("SAME phrase"); - /* may not be specified along with the UNDERLINED, BLINK, REVERSED, - HIGH, LOW, STANDARD, COLOR, FOREGROUND-COLOR, or BACKGROUND-COLOR phrases */ - } -| STANDARD /* ACU extension to reset a group HIGH/LOW */ - { - CB_PENDING ("STANDARD intensity"); - } -| BACKGROUND_HIGH - { - CB_PENDING ("BACKGROUND intensity"); - } -| BACKGROUND_LOW - { - CB_PENDING ("BACKGROUND intensity"); - } -| BACKGROUND_STANDARD - { - CB_PENDING ("BACKGROUND intensity"); - } -| OVERLINE - { - check_repeated ("OVERLINE", SYN_CLAUSE_13, &check_duplicate); - set_dispattr (COB_SCREEN_OVERLINE); - } -| reverse_video - { - check_repeated ("REVERSE-VIDEO", SYN_CLAUSE_14, &check_duplicate); - set_dispattr (COB_SCREEN_REVERSE); - } -| SIZE _is num_id_or_lit - { - check_repeated ("SIZE", SYN_CLAUSE_15, &check_duplicate); - set_attribs (NULL, NULL, NULL, NULL, NULL, $3, 0); - } -| UNDERLINE - { - check_repeated ("UNDERLINE", SYN_CLAUSE_16, &check_duplicate); - set_dispattr (COB_SCREEN_UNDERLINE); - } -| COLOR _is num_id_or_lit - { - check_repeated ("FOREGROUND-COLOR", SYN_CLAUSE_17, &check_duplicate); - check_repeated ("BACKGROUND-COLOR", SYN_CLAUSE_18, &check_duplicate); - CB_PENDING ("COLOR"); - } -| FOREGROUND_COLOR _is_equal num_id_or_lit - { - check_repeated ("FOREGROUND-COLOR", SYN_CLAUSE_17, &check_duplicate); - set_attribs ($3, NULL, NULL, NULL, NULL, NULL, 0); - } -| BACKGROUND_COLOR _is_equal num_id_or_lit - { - check_repeated ("BACKGROUND-COLOR", SYN_CLAUSE_18, &check_duplicate); - set_attribs (NULL, $3, NULL, NULL, NULL, NULL, 0); - } -| SCROLL _up _scroll_lines - { - check_repeated ("SCROLL UP", SYN_CLAUSE_19, &check_duplicate); - set_attribs_with_conflict (NULL, NULL, $3, NULL, NULL, NULL, - "SCROLL UP", COB_SCREEN_SCROLL_UP, - "SCROLL DOWN", COB_SCREEN_SCROLL_DOWN); - } -| SCROLL DOWN _scroll_lines - { - check_repeated ("SCROLL DOWN", SYN_CLAUSE_20, &check_duplicate); - set_attribs_with_conflict (NULL, NULL, $3, NULL, NULL, NULL, - "SCROLL DOWN", COB_SCREEN_SCROLL_DOWN, - "SCROLL UP", COB_SCREEN_SCROLL_UP); - } -; - -_end_display: - /* empty */ %prec SHIFT_PREFER - { - TERMINATOR_WARNING ($-2, DISPLAY); - } -| END_DISPLAY - { - TERMINATOR_CLEAR ($-2, DISPLAY); - } -; - - -/* DIVIDE statement */ - -divide_statement: - DIVIDE - { - begin_statement ("DIVIDE", TERM_DIVIDE); - } - divide_body - _end_divide -; - -divide_body: - x INTO arithmetic_x_list on_size_error_phrases - { - cb_emit_arithmetic ($3, '/', $1); - } -| x INTO x GIVING arithmetic_x_list on_size_error_phrases - { - cb_emit_arithmetic ($5, 0, cb_build_binary_op ($3, '/', $1)); - } -| x BY x GIVING arithmetic_x_list on_size_error_phrases - { - cb_emit_arithmetic ($5, 0, cb_build_binary_op ($1, '/', $3)); - } -| x INTO x GIVING arithmetic_x REMAINDER arithmetic_x on_size_error_phrases - { - cb_emit_divide ($3, $1, $5, $7); - } -| x BY x GIVING arithmetic_x REMAINDER arithmetic_x on_size_error_phrases - { - cb_emit_divide ($1, $3, $5, $7); - } -; - -_end_divide: - /* empty */ %prec SHIFT_PREFER - { - TERMINATOR_WARNING ($-2, DIVIDE); - } -| END_DIVIDE - { - TERMINATOR_CLEAR ($-2, DIVIDE); - } -; - - -/* ENABLE statement (COMMUNICATION) */ - -enable_statement: - ENABLE - { - begin_statement ("ENABLE", 0); - } - enable_disable_handling -; - - -/* ENTRY statement */ - -entry_statement: - ENTRY - { - check_unreached = 0; - begin_statement ("ENTRY", 0); - backup_current_pos (); - } - entry_body -| ENTRY FOR GO TO - { - check_unreached = 0; - begin_statement ("ENTRY FOR GO TO", 0); - backup_current_pos (); - } - entry_goto_body -; - -entry_body: - _mnemonic_conv LITERAL _conv_linkage call_using - { - if (current_program->nested_level) { - cb_error (_("%s is invalid in nested program"), "ENTRY"); - } else if (current_program->prog_type == COB_MODULE_TYPE_FUNCTION) { - cb_error (_("%s is invalid in a user FUNCTION"), "ENTRY"); - } else if (cb_verify (cb_entry_statement, "ENTRY")) { - cb_tree call_conv = $1; - if ($3) { - call_conv = $3; - if ($1) { - /* note: $1 is likely to be a reference to SPECIAL-NAMES */ - cb_error_x ($3, _("%s and %s are mutually exclusive"), - "CALL-CONVENTION", "WITH LINKAGE"); - } - } - if (!cobc_check_valid_name ((char *)(CB_LITERAL ($2)->data), ENTRY_NAME)) { - emit_entry ((char *)(CB_LITERAL ($2)->data), 1, $4, call_conv); - } - } - } -; - -entry_goto_body: - LITERAL - { - if (cb_verify (cb_goto_entry, "ENTRY FOR GO TO")) { - emit_entry_goto ((char *)(CB_LITERAL ($1)->data)); - } - } -; - - -/* EVALUATE statement */ - -evaluate_statement: - EVALUATE - { - begin_statement ("EVALUATE", TERM_EVALUATE); - eval_level++; - if (eval_level >= EVAL_DEPTH) { - cb_error (_("maximum evaluate depth exceeded (%d)"), - EVAL_DEPTH); - eval_level = 0; - eval_inc = 0; - eval_inc2 = 0; - YYERROR; - } else { - for (eval_inc = 0; eval_inc < EVAL_DEPTH; ++eval_inc) { - eval_check[eval_level][eval_inc] = NULL; - } - eval_inc = 0; - eval_inc2 = 0; - } - cb_end_cond (cb_any); - cb_save_cond (); - cb_true_side (); - } - evaluate_body - _end_evaluate -; - -evaluate_body: - evaluate_subject_list evaluate_condition_list - { - cb_emit_evaluate ($1, $2); - eval_level--; - } -; - -evaluate_subject_list: - evaluate_subject { $$ = CB_LIST_INIT ($1); } -| evaluate_subject_list ALSO - evaluate_subject { $$ = cb_list_add ($1, $3); } -; - -evaluate_subject: - expr - { - $$ = $1; - eval_check[eval_level][eval_inc++] = $1; - if (eval_inc >= EVAL_DEPTH) { - cb_error (_("maximum evaluate depth exceeded (%d)"), - EVAL_DEPTH); - eval_inc = 0; - YYERROR; - } - } -| TOK_TRUE - { - $$ = cb_true; - eval_check[eval_level][eval_inc++] = NULL; - if (eval_inc >= EVAL_DEPTH) { - cb_error (_("maximum evaluate depth exceeded (%d)"), - EVAL_DEPTH); - eval_inc = 0; - YYERROR; - } - } -| TOK_FALSE - { - $$ = cb_false; - eval_check[eval_level][eval_inc++] = cb_false; - if (eval_inc >= EVAL_DEPTH) { - cb_error (_("maximum evaluate depth exceeded (%d)"), - EVAL_DEPTH); - eval_inc = 0; - YYERROR; - } - } -; - -evaluate_condition_list: - evaluate_case_list evaluate_other - { - if ($2) { - $$ = cb_list_add ($1, $2); - } else { - $$ = $1; - } - } -| evaluate_case_list - %prec SHIFT_PREFER - { - $$ = $1; - } -; - -evaluate_case_list: - evaluate_case { $$ = CB_LIST_INIT ($1); } -| evaluate_case_list - evaluate_case { $$ = cb_list_add ($1, $2); } -; - -evaluate_case: - evaluate_when_list - statement_list - { - $$ = CB_BUILD_CHAIN ($2, $1); - eval_inc2 = 0; - } -| evaluate_when_list END_EVALUATE - { - eval_inc2 = 0; - cb_verify (cb_missing_statement, - _("WHEN without imperative statement")); - /* Note: we don't clear the EVALUATE terminator here - as we'd have to skip this later - [side effect: possible warning about missing terminator] */ - $$ = CB_BUILD_CHAIN (CB_LIST_INIT (cb_build_continue ()), $1); - } -| evaluate_when_list TOK_DOT - { - eval_inc2 = 0; - cb_verify (cb_missing_statement, - _("WHEN without imperative statement")); - /* Put the dot token back into the stack for reparse */ - cb_unput_dot (); - $$ = CB_BUILD_CHAIN (CB_LIST_INIT (cb_build_continue ()), $1); - } -; - -evaluate_other: - WHEN OTHER - statement_list - { - $$ = CB_BUILD_CHAIN ($3, NULL); - eval_inc2 = 0; - } -| WHEN OTHER END_EVALUATE - { - eval_inc2 = 0; - cb_verify (cb_missing_statement, - _("WHEN OTHER without imperative statement")); - /* Note: we don't clear the EVALUATE terminator here - as we'd have to skip this later - [side effect: possible warning about missing terminator] */ - $$ = NULL; - } -| WHEN OTHER TOK_DOT - { - eval_inc2 = 0; - cb_verify (cb_missing_statement, - _("WHEN OTHER without imperative statement")); - /* Put the dot token back into the stack for reparse */ - cb_unput_dot (); - $$ = NULL; - } -; - -evaluate_when_list: - WHEN - { - backup_current_pos (); - } - evaluate_object_list - { - $$ = CB_LIST_INIT ($3); - restore_backup_pos ($$); - eval_inc2 = 0; - } -| evaluate_when_list - WHEN - { - backup_current_pos (); - } - evaluate_object_list - { - $$ = cb_list_add ($1, $4); - restore_backup_pos ($$); - eval_inc2 = 0; - } -; - -evaluate_object_list: - evaluate_object { $$ = CB_LIST_INIT ($1); } -| evaluate_object_list ALSO - evaluate_object { $$ = cb_list_add ($1, $3); } -; - -evaluate_object: - partial_expr _evaluate_thru_expr - { - cb_tree not0; - cb_tree e1; - cb_tree e2; - cb_tree x; - cb_tree parm1; - - not0 = cb_int0; - e2 = $2; - x = NULL; - parm1 = $1; - if (eval_check[eval_level][eval_inc2] - && eval_check[eval_level][eval_inc2] != cb_false) { - /* Check if the first token is NOT */ - /* It may belong to the EVALUATE, however see */ - /* below when it may be part of a partial expression */ - if (CB_PURPOSE_INT (parm1) == '!') { - /* Pop stack if subject not TRUE / FALSE */ - not0 = cb_int1; - x = parm1; - parm1 = CB_CHAIN (parm1); - } - /* Partial expression handling */ - switch (CB_PURPOSE_INT (parm1)) { - /* Relational conditions */ - case '<': - case '>': - case '[': - case ']': - case '~': - case '=': - /* Class conditions */ - case '9': - case 'A': - case 'L': - case 'U': - case 'P': - case 'N': - case 'O': - case 'C': - if (e2) { - cb_error_x (e2, _("invalid THROUGH usage")); - e2 = NULL; - } - not0 = CB_PURPOSE (parm1); - if (x) { - /* Rebind the NOT to the partial expression */ - parm1 = cb_build_list (cb_int ('!'), NULL, parm1); - } - /* Insert subject at head of list */ - parm1 = cb_build_list (cb_int ('x'), - eval_check[eval_level][eval_inc2], parm1); - break; - } - } - - /* Build expr now */ - e1 = cb_build_expr (parm1); - - eval_inc2++; - $$ = CB_BUILD_PAIR (not0, CB_BUILD_PAIR (e1, e2)); - - if (eval_check[eval_level][eval_inc2-1] == cb_false) { - /* It was EVALUATE FALSE; So flip condition */ - if (e1 == cb_true) - e1 = cb_false; - else if (e1 == cb_false) - e1 = cb_true; - } - cb_terminate_cond (); - cb_end_cond (e1); - cb_save_cond (); - cb_true_side (); - } -| ANY { $$ = cb_any; eval_inc2++; } -| TOK_TRUE { $$ = cb_true; eval_inc2++; } -| TOK_FALSE { $$ = cb_false; eval_inc2++; } -| error { $$ = cb_error_node; eval_inc2++; } -; - -_evaluate_thru_expr: - /* empty */ { $$ = NULL; } -| THRU expr { $$ = $2; } -; - -_end_evaluate: - /* empty */ %prec SHIFT_PREFER - { - TERMINATOR_WARNING ($-2, EVALUATE); - } -| END_EVALUATE - { - TERMINATOR_CLEAR ($-2, EVALUATE); - } -; - - -/* EXIT statement */ - -exit_statement: - EXIT - { - begin_statement ("EXIT", 0); - cobc_cs_check = CB_CS_EXIT; - } - exit_body - { - cobc_cs_check = 0; - } -; - -exit_body: - /* empty */ %prec SHIFT_PREFER - { - /* TODO: add warning/error if there's another statement in the paragraph */ - } -| PROGRAM exit_program_returning - { - if (in_declaratives && use_global_ind) { - cb_error_x (CB_TREE (current_statement), - _("EXIT PROGRAM is not allowed within a USE GLOBAL procedure")); - } - if (current_program->prog_type != COB_MODULE_TYPE_PROGRAM) { - cb_error_x (CB_TREE (current_statement), - _("EXIT PROGRAM not allowed within a FUNCTION")); - } - if (current_program->flag_main) { - check_unreached = 0; - } else { - check_unreached = 1; - } - if ($2) { - if (!current_program->cb_return_code) { - cb_error_x ($2, _("RETURNING/GIVING not allowed for non-returning runtime elements")); - } else { - cb_emit_move ($2, CB_LIST_INIT (current_program->cb_return_code)); - } - } - current_statement->name = (const char *)"EXIT PROGRAM"; - cb_emit_exit (0); - } -| FUNCTION - { - if (in_declaratives && use_global_ind) { - cb_error_x (CB_TREE (current_statement), - _("EXIT FUNCTION is not allowed within a USE GLOBAL procedure")); - } - if (current_program->prog_type != COB_MODULE_TYPE_FUNCTION) { - cb_error_x (CB_TREE (current_statement), - _("EXIT FUNCTION only allowed within a FUNCTION")); - } - check_unreached = 1; - current_statement->name = (const char *)"EXIT FUNCTION"; - cb_emit_exit (0); - } -| PERFORM CYCLE - { - struct cb_perform *p; - cb_tree plabel; - char name[64]; - - if (!perform_stack) { - cb_error_x (CB_TREE (current_statement), - _("EXIT PERFORM is only valid with inline PERFORM")); - } else if (CB_VALUE (perform_stack) != cb_error_node) { - p = CB_PERFORM (CB_VALUE (perform_stack)); - if (!p->cycle_label) { - sprintf (name, "EXIT PERFORM CYCLE %d", cb_id); - p->cycle_label = cb_build_reference (name); - plabel = cb_build_label (p->cycle_label, NULL); - CB_LABEL (plabel)->flag_begin = 1; - CB_LABEL (plabel)->flag_dummy_exit = 1; - } - current_statement->name = (const char *)"EXIT PERFORM CYCLE"; - cb_emit_goto (CB_LIST_INIT (p->cycle_label), NULL); - check_unreached = 1; - } - } -| PERFORM - { - struct cb_perform *p; - cb_tree plabel; - char name[64]; - - if (!perform_stack) { - cb_error_x (CB_TREE (current_statement), - _("EXIT PERFORM is only valid with inline PERFORM")); - } else if (CB_VALUE (perform_stack) != cb_error_node) { - p = CB_PERFORM (CB_VALUE (perform_stack)); - if (!p->exit_label) { - sprintf (name, "EXIT PERFORM %d", cb_id); - p->exit_label = cb_build_reference (name); - plabel = cb_build_label (p->exit_label, NULL); - CB_LABEL (plabel)->flag_begin = 1; - CB_LABEL (plabel)->flag_dummy_exit = 1; - } - current_statement->name = (const char *)"EXIT PERFORM"; - cb_emit_goto (CB_LIST_INIT (p->exit_label), NULL); - check_unreached = 1; - } - } -| SECTION - { - cb_tree plabel; - char name[64]; - - if (!current_section) { - cb_error_x (CB_TREE (current_statement), - _("EXIT SECTION is only valid with an active SECTION")); - } else { - if (!current_section->exit_label) { - sprintf (name, "EXIT SECTION %d", cb_id); - current_section->exit_label = cb_build_reference (name); - plabel = cb_build_label (current_section->exit_label, NULL); - CB_LABEL (plabel)->flag_begin = 1; - CB_LABEL (plabel)->flag_dummy_exit = 1; - } - current_statement->name = (const char *)"EXIT SECTION"; - cb_emit_goto (CB_LIST_INIT (current_section->exit_label), NULL); - check_unreached = 1; - } - } -| PARAGRAPH - { - cb_tree plabel; - char name[64]; - - if (!current_paragraph) { - cb_error_x (CB_TREE (current_statement), - _("EXIT PARAGRAPH is only valid with an active PARAGRAPH")); - } else { - if (!current_paragraph->exit_label) { - sprintf (name, "EXIT PARAGRAPH %d", cb_id); - current_paragraph->exit_label = cb_build_reference (name); - plabel = cb_build_label (current_paragraph->exit_label, NULL); - CB_LABEL (plabel)->flag_begin = 1; - CB_LABEL (plabel)->flag_dummy_exit = 1; - } - current_statement->name = (const char *)"EXIT PARAGRAPH"; - cb_emit_goto (CB_LIST_INIT (current_paragraph->exit_label), NULL); - check_unreached = 1; - } - } -; - -exit_program_returning: - /* empty */ { $$ = NULL; } - /* extension supported by MF and ACU - (note: ACU supports this with x only, too) */ -| return_give x { $$ = $2; } -; - - -/* FREE statement */ - -free_statement: - FREE - { - begin_statement ("FREE", 0); - current_statement->flag_no_based = 1; - } - free_body -; - -free_body: - target_x_list - { - cb_emit_free ($1); - } -; - - -/* GENERATE statement */ - -generate_statement: - GENERATE - { - begin_statement ("GENERATE", 0); - } - generate_body -; - - -generate_body: - qualified_word - { - begin_implicit_statement (); - if ($1 != cb_error_node) { - cb_emit_generate ($1); - } - } -; - -/* GO TO statement */ - -goto_statement: - GO - { - if (!current_paragraph->flag_statement) { - current_paragraph->flag_first_is_goto = 1; - } - begin_statement ("GO TO", 0); - save_debug = start_debug; - start_debug = 0; - } - go_body -; - -go_body: - _to procedure_name_list goto_depending - { - cb_emit_goto ($2, $3); - start_debug = save_debug; - } -| _to ENTRY entry_name_list goto_depending - { - if (cb_verify (cb_goto_entry, "ENTRY FOR GO TO")) { - cb_emit_goto_entry ($3, $4); - } - start_debug = save_debug; - } -; - -goto_depending: - /* empty */ - { - check_unreached = 1; - $$ = NULL; - } -| DEPENDING _on identifier - { - check_unreached = 0; - $$ = $3; - } -; - - -/* GOBACK statement */ - -goback_statement: - GOBACK exit_program_returning - { - begin_statement ("GOBACK", 0); - check_unreached = 1; - if ($2) { - if (!current_program->cb_return_code) { - cb_error_x ($2, _("RETURNING/GIVING not allowed for non-returning runtime elements")); - } else { - cb_emit_move ($2, CB_LIST_INIT (current_program->cb_return_code)); - } - } - cb_emit_exit (1U); - } -; - - -/* IF statement */ - -if_statement: - IF - { - begin_statement ("IF", TERM_IF); - } - condition _if_then if_else_statements - _end_if -; - -if_else_statements: - if_true statement_list ELSE if_false statement_list - { - cb_emit_if ($-1, $2, $5); - } -| ELSE if_false statement_list - { - cb_emit_if ($-1, NULL, $3); - cb_verify (cb_missing_statement, - _("IF without imperative statement")); - } -| if_true statement_list %prec SHIFT_PREFER - { - cb_emit_if ($-1, $2, NULL); - } -; - -_if_then: - { - cb_save_cond (); - } -| THEN - { - cb_save_cond (); - } -; - -if_true: - { - cb_true_side (); - } -; - -if_false: - { - cb_false_side (); - } -; - -_end_if: - /* empty */ %prec SHIFT_PREFER - { - TERMINATOR_WARNING ($-4, IF); - cb_terminate_cond (); - } -| END_IF - { - TERMINATOR_CLEAR ($-4, IF); - cb_terminate_cond (); - } -; - - -/* INITIALIZE statement */ - -initialize_statement: - INITIALIZE - { - begin_statement ("INITIALIZE", 0); - } - initialize_body -; - -initialize_body: - target_x_list _initialize_filler _initialize_value - _initialize_replacing _initialize_default - { - cb_emit_initialize ($1, $2, $3, $4, $5); - } -; - -_initialize_filler: - /* empty */ { $$ = NULL; } -| _with FILLER { $$ = cb_true; } -; - -_initialize_value: - /* empty */ { $$ = NULL; } -| ALL _to VALUE { $$ = cb_true; } -| initialize_category _to VALUE { $$ = $1; } -; - -_initialize_replacing: - /* empty */ - { - $$ = NULL; - } -| REPLACING initialize_replacing_list - { - $$ = $2; - } -; - -initialize_replacing_list: - initialize_replacing_item - { - $$ = $1; - } -| initialize_replacing_list - initialize_replacing_item - { - $$ = cb_list_append ($1, $2); - } -; - -initialize_replacing_item: - initialize_category _data BY x - { - $$ = CB_BUILD_PAIR ($1, $4); - } -; - -initialize_category: - ALPHABETIC { $$ = cb_int (CB_CATEGORY_ALPHABETIC); } -| ALPHANUMERIC { $$ = cb_int (CB_CATEGORY_ALPHANUMERIC); } -| NUMERIC { $$ = cb_int (CB_CATEGORY_NUMERIC); } -| ALPHANUMERIC_EDITED { $$ = cb_int (CB_CATEGORY_ALPHANUMERIC_EDITED); } -| NUMERIC_EDITED { $$ = cb_int (CB_CATEGORY_NUMERIC_EDITED); } -| NATIONAL { $$ = cb_int (CB_CATEGORY_NATIONAL); } -| NATIONAL_EDITED { $$ = cb_int (CB_CATEGORY_NATIONAL_EDITED); } -/* missing, needs test when added: -| BOOLEAN { $$ = cb_int (CB_CATEGORY_BOOLEAN); } -| DATA_POINTER { $$ = cb_int (CB_CATEGORY_DATA_POINTER); } -| FUNCTION_POINTER { $$ = cb_int (CB_CATEGORY_FUNCTION_POINTER); } -| PROGRAM_POINTER { $$ = cb_int (CB_CATEGORY_PROGRAM_POINTER); } -| OBJECT_REFERENCE { $$ = cb_int (CB_CATEGORY_OBJECT_REFERENCE); } -*/ -; - -_initialize_default: - /* empty */ - { - $$ = NULL; - } -| _then _to DEFAULT - { - $$ = cb_true; - } -; - -/* INITIATE statement */ - -initiate_statement: - INITIATE - { - begin_statement ("INITIATE", 0); - } - initiate_body -; - -initiate_body: - report_name - { - begin_implicit_statement (); - if ($1 != cb_error_node) { - cb_emit_initiate ($1); - } - } -| initiate_body report_name - { - begin_implicit_statement (); - if ($2 != cb_error_node) { - cb_emit_initiate ($2); - } - } -; - -/* INQUIRE statement */ - -inquire_statement: - INQUIRE - { - begin_statement ("INQUIRE", 0); - cobc_cs_check = CB_CS_INQUIRE_MODIFY; - } - inquire_body - { - cobc_cs_check = 0; - } -; - -inquire_body: - control_item changeable_control_properties -| window_handle changeable_window_properties -; - -/* INSPECT statement */ - -inspect_statement: - INSPECT - { - begin_statement ("INSPECT", 0); - inspect_keyword = 0; - } - inspect_body -; - -inspect_body: - send_identifier inspect_list -; - -send_identifier: - identifier -| literal -| function -; - -inspect_list: - inspect_tallying inspect_replacing -| inspect_tallying -| inspect_replacing -| inspect_converting -; - -/* INSPECT TALLYING */ - -inspect_tallying: - TALLYING - { - previous_tallying_phrase = NO_PHRASE; - cb_init_tallying (); - } - tallying_list - { - if (!(previous_tallying_phrase == CHARACTERS_PHRASE - || previous_tallying_phrase == VALUE_REGION_PHRASE)) { - cb_error (_("TALLYING clause is incomplete")); - } else { - cb_emit_inspect ($0, $3, TALLYING_CLAUSE); - } - - $$ = $0; - } -; - -/* INSPECT REPLACING */ - -inspect_replacing: - REPLACING replacing_list - { - cb_emit_inspect ($0, $2, REPLACING_CLAUSE); - inspect_keyword = 0; - } -; - -/* INSPECT CONVERTING */ - -inspect_converting: - CONVERTING inspect_from TO inspect_to inspect_region - { - cb_tree x = cb_build_converting ($2, $4, $5); - cb_emit_inspect ($0, x, CONVERTING_CLAUSE); - } -; - -tallying_list: - tallying_item - { - $$ = $1; - } -| tallying_list tallying_item - { - $$ = cb_list_append ($1, $2); - } -; - -tallying_item: - numeric_identifier FOR - { - check_preceding_tallying_phrases (FOR_PHRASE); - $$ = cb_build_tallying_data ($1); - } -| CHARACTERS inspect_region - { - check_preceding_tallying_phrases (CHARACTERS_PHRASE); - $$ = cb_build_tallying_characters ($2); - } -| ALL - { - check_preceding_tallying_phrases (ALL_LEADING_TRAILING_PHRASES); - $$ = cb_build_tallying_all (); - } -| LEADING - { - check_preceding_tallying_phrases (ALL_LEADING_TRAILING_PHRASES); - $$ = cb_build_tallying_leading (); - } -| TRAILING - { - check_preceding_tallying_phrases (ALL_LEADING_TRAILING_PHRASES); - $$ = cb_build_tallying_trailing (); - } -| simple_display_value inspect_region - { - check_preceding_tallying_phrases (VALUE_REGION_PHRASE); - $$ = cb_build_tallying_value ($1, $2); - } -; - -replacing_list: - replacing_item { $$ = $1; } -| replacing_list replacing_item { $$ = cb_list_append ($1, $2); } -; - -replacing_item: - CHARACTERS BY simple_display_value inspect_region - { - $$ = cb_build_replacing_characters ($3, $4); - inspect_keyword = 0; - } -| rep_keyword replacing_region - { - $$ = $2; - } -; - -rep_keyword: - /* empty */ -| ALL { inspect_keyword = 1; } -| LEADING { inspect_keyword = 2; } -| FIRST { inspect_keyword = 3; } -| TRAILING { inspect_keyword = 4; } -; - -replacing_region: - inspect_from BY inspect_to inspect_region - { - switch (inspect_keyword) { - case 1: - $$ = cb_build_replacing_all ($1, $3, $4); - break; - case 2: - $$ = cb_build_replacing_leading ($1, $3, $4); - break; - case 3: - $$ = cb_build_replacing_first ($1, $3, $4); - break; - case 4: - $$ = cb_build_replacing_trailing ($1, $3, $4); - break; - default: - cb_error_x (CB_TREE (current_statement), - _("INSPECT missing ALL/FIRST/LEADING/TRAILING")); - $$ = cb_build_replacing_all ($1, $3, $4); - break; - } - } -; - -/* INSPECT BEFORE/AFTER */ - -inspect_region: - /* empty */ - { - $$ = cb_build_inspect_region_start (); - } -| inspect_before - { - $$ = cb_list_add (cb_build_inspect_region_start (), $1); - } -| inspect_after - { - $$ = cb_list_add (cb_build_inspect_region_start (), $1); - } -| inspect_before inspect_after - { - $$ = cb_list_add (cb_list_add (cb_build_inspect_region_start (), $1), $2); - } -| inspect_after inspect_before - { - $$ = cb_list_add (cb_list_add (cb_build_inspect_region_start (), $1), $2); - } -; - -inspect_before: - BEFORE _initial x - { - $$ = CB_BUILD_FUNCALL_1 ("cob_inspect_before", $3); - } -; - -inspect_after: - AFTER _initial x - { - $$ = CB_BUILD_FUNCALL_1 ("cob_inspect_after", $3); - } -; - -/* JSON GENERATE statement */ - -json_generate_statement: - JSON GENERATE - { - begin_statement ("JSON GENERATE", TERM_JSON); - cobc_in_json_generate_body = 1; - cobc_cs_check = CB_CS_JSON_GENERATE; - } - json_generate_body - _end_json -; - -json_generate_body: - identifier FROM identifier - _count_in - { - ml_suppress_list = NULL; - } - _name_of - _json_suppress - { - cobc_in_json_generate_body = 0; - cobc_cs_check = 0; - } - _json_exception_phrases - { - cb_emit_json_generate ($1, $3, $4, $6, ml_suppress_list); - } -; - -_json_suppress: - /* empty */ - { - $$ = NULL; - } -| SUPPRESS_XML json_suppress_list - { - $$ = $2; - } -; - -json_suppress_list: - json_suppress_entry -| json_suppress_list json_suppress_entry -; - -json_suppress_entry: - identifier - { - error_if_following_every_clause (); - add_identifier_to_ml_suppress_conds ($1); - } -; - -_end_json: - /* empty */ %prec SHIFT_PREFER - { - TERMINATOR_WARNING ($-2, JSON); - } -| END_JSON - { - TERMINATOR_CLEAR ($-2, JSON); - } -; - -/* JSON PARSE statement */ - -json_parse_statement: - JSON PARSE - { - begin_statement ("JSON PARSE", TERM_JSON); - CB_PENDING (_("JSON PARSE")); - } - json_parse_body - _end_json -; - -json_parse_body: - identifier INTO identifier - _with_detail - _name_of - _json_suppress - _json_exception_phrases -; - -_with_detail: - /* empty */ -| _with DETAIL -; - -/* MERGE statement */ - -merge_statement: - MERGE - { - begin_statement ("MERGE", 0); - current_statement->flag_merge = 1; - } - sort_body -; - - -/* MODIFY statement */ - -modify_statement: - MODIFY - { - begin_statement ("MODIFY", TERM_MODIFY); - cobc_cs_check = CB_CS_INQUIRE_MODIFY; - } - modify_body - _end_modify - { - cobc_cs_check = 0; - } -; - -modify_body: - control_item control_attributes -| window_handle changeable_window_properties -; - -_end_modify: - /* empty */ %prec SHIFT_PREFER - { - TERMINATOR_WARNING ($-2, MODIFY); - } -| END_MODIFY - { - TERMINATOR_CLEAR ($-2, MODIFY); - } -; - - -/* MOVE statement */ - -move_statement: - MOVE - { - begin_statement ("MOVE", 0); - } - move_body -; - -move_body: - x TO target_x_list - { - cb_emit_move ($1, $3); - } -| CORRESPONDING x TO target_x_list - { - cb_emit_move_corresponding ($2, $4); - } -; - - -/* MULTIPLY statement */ - -multiply_statement: - MULTIPLY - { - begin_statement ("MULTIPLY", TERM_MULTIPLY); - } - multiply_body - _end_multiply -; - -multiply_body: - x BY arithmetic_x_list on_size_error_phrases - { - cb_emit_arithmetic ($3, '*', $1); - } -| x BY x GIVING arithmetic_x_list on_size_error_phrases - { - cb_emit_arithmetic ($5, 0, cb_build_binary_op ($1, '*', $3)); - } -; - -_end_multiply: - /* empty */ %prec SHIFT_PREFER - { - TERMINATOR_WARNING ($-2, MULTIPLY); - } -| END_MULTIPLY - { - TERMINATOR_CLEAR ($-2, MULTIPLY); - } -; - - -/* OPEN statement */ - -open_statement: - OPEN - { - begin_statement ("OPEN", 0); - cobc_cs_check = CB_CS_OPEN; - } - open_body -; - -open_body: - open_file_entry -| open_body open_file_entry -; - -open_file_entry: - _open_exclusive open_mode _open_sharing _retry_phrase file_name_list _open_option - { - cb_tree l; - cb_tree x; - cb_tree retry; - int retry_times, retry_seconds, retry_forever; - - if (($1 && $3) || ($1 && $6) || ($3 && $6)) { - cb_error_x (CB_TREE (current_statement), - _("%s and %s are mutually exclusive"), "SHARING", _("LOCK clauses")); - } - if ($6) { - x = $6; - } else if ($3) { - x = $3; - } else { - x = $1; - } - retry = current_statement->retry; - retry_times = current_statement->flag_retry_times; - retry_seconds = current_statement->flag_retry_seconds; - retry_forever = current_statement->flag_retry_forever; - - for (l = $5; l; l = CB_CHAIN (l)) { - if (CB_VALID_TREE (CB_VALUE (l))) { - begin_implicit_statement (); - current_statement->retry = retry; - current_statement->flag_retry_times = retry_times; - current_statement->flag_retry_seconds = retry_seconds; - current_statement->flag_retry_forever = retry_forever; - cb_emit_open (CB_VALUE (l), $2, x); - } - } - } -; - -/* RM/COBOL extension */ -_open_exclusive: - /* empty */ { $$ = NULL; } -| EXCLUSIVE { $$ = cb_int (COB_LOCK_OPEN_EXCLUSIVE); } -; - -open_mode: - INPUT { $$ = cb_int (COB_OPEN_INPUT); } -| OUTPUT { $$ = cb_int (COB_OPEN_OUTPUT); } -| I_O { $$ = cb_int (COB_OPEN_I_O); } -| EXTEND { $$ = cb_int (COB_OPEN_EXTEND); } -; - -_open_sharing: - /* empty */ { $$ = NULL; } -| SHARING _with sharing_option { $$ = $3; } -; - -_open_option: - /* empty */ { $$ = NULL; } -| lock_allowing { $$ = $1; } -| open_option_sequential { $$ = NULL; } -/* note: RM/COBOL allow lock together with the other options, - most (all?) other dialects allow only one of them - extra rule to possibly cater for this later */ -| lock_allowing open_option_sequential { $$ = $1; } -| osvs_input_mode - { - (void)cb_verify (CB_OBSOLETE, "OPEN LEAVE/REREAD/DISP"); - $$ = NULL; - } -; - -lock_allowing: - _with_for open_lock_option { $$ = $2; } -| ALLOWING allowing_option { $$ = $2; } -; - -open_lock_option: - LOCK { $$ = cb_int (COB_LOCK_OPEN_EXCLUSIVE); } -| MASS_UPDATE - { - $$ = cb_int (COB_LOCK_OPEN_EXCLUSIVE); - /* TODO: check for indexed; pass extra flag to fileio */ - CB_PENDING ("WITH MASS-UPDATE"); - } -| BULK_ADDITION - { - $$ = cb_int (COB_LOCK_OPEN_EXCLUSIVE); - /* TODO: check for indexed; pass extra flag to fileio */ - CB_PENDING ("WITH BULK-ADDITION"); - } -; - -allowing_option: - NO _others { $$ = cb_int (COB_LOCK_OPEN_EXCLUSIVE); } -| allowing_all { $$ = NULL; } -| READERS { $$ = NULL; } /* docs say: identical to EXCLUSIVE + OPEN INPUT, CHECKME */ -; - -/* strange, but according to ACUCOBOL docs they are all identical */ -allowing_all: - WRITERS -| UPDATERS -| ALL -; - -open_option_sequential: - _with NO REWIND - { - /* FIXME: only allow for sequential files */ - /* FIXME: only allow with INPUT or OUTPUT */ - CB_PENDING ("OPEN WITH NO REWIND"); - $$ = NULL; - } -| REVERSED - { - /* FIXME: only allow for sequential / line-sequential files */ - /* FIXME: only allow with INPUT */ - /* FIXME: add actual compiler configuration */ - if (cb_warn_obsolete == COBC_WARN_AS_ERROR) { - (void)cb_verify (CB_OBSOLETE, "OPEN REVERSED"); - } else { - /* FIXME: set file attribute */ - CB_PENDING ("OPEN REVERSED"); - }; - $$ = NULL; - } -; - -osvs_input_mode: - LEAVE -| REREAD -| DISP; - -/* PERFORM statement */ - -perform_statement: - PERFORM - { - begin_statement ("PERFORM", TERM_PERFORM); - /* Turn off field debug - PERFORM is special */ - save_debug = start_debug; - start_debug = 0; - cobc_cs_check = CB_CS_PERFORM; - } - perform_body -; - -perform_body: - _thread_start - perform_procedure - _thread_handle - _perform_option - { - cb_emit_perform ($4, $2, $1, $3); - start_debug = save_debug; - cobc_cs_check = 0; - } -| _thread_start - _perform_option - _thread_handle - { - CB_ADD_TO_CHAIN ($2, perform_stack); - /* Restore field debug before inline statements */ - start_debug = save_debug; - cobc_cs_check = 0; - } - statement_list _end_perform - { - perform_stack = CB_CHAIN (perform_stack); - cb_emit_perform ($2, $5, $1, $3); - } -| _thread_start - _perform_option - _thread_handle - { - cb_verify (cb_missing_statement, - _("inline PERFORM without imperative statement")); - } - end_perform_or_dot - { - cb_emit_perform ($2, NULL, $1, $3); - start_debug = save_debug; - cobc_cs_check = 0; - } -; - -_end_perform: - /* empty */ %prec SHIFT_PREFER - { - if (cb_relaxed_syntax_checks) { - TERMINATOR_WARNING ($-6, PERFORM); - } else { - TERMINATOR_ERROR ($-6, PERFORM); - } - } -| END_PERFORM - { - TERMINATOR_CLEAR ($-6, PERFORM); - } -; - -end_perform_or_dot: - END_PERFORM - { - TERMINATOR_CLEAR ($-3, PERFORM); - } -| TOK_DOT - { - if (cb_relaxed_syntax_checks) { - TERMINATOR_WARNING ($-3, PERFORM); - } else { - TERMINATOR_ERROR ($-3, PERFORM); - } - /* Put the dot token back into the stack for reparse */ - cb_unput_dot (); - } -; - -perform_procedure: - procedure_name - { - /* Return from $1 */ - CB_REFERENCE ($1)->length = cb_true; - CB_REFERENCE ($1)->flag_decl_ok = 1; - $$ = CB_BUILD_PAIR ($1, $1); - } -| procedure_name THRU procedure_name - { - /* Return from $3 */ - CB_REFERENCE ($3)->length = cb_true; - CB_REFERENCE ($1)->flag_decl_ok = 1; - CB_REFERENCE ($3)->flag_decl_ok = 1; - $$ = CB_BUILD_PAIR ($1, $3); - } -; - -_perform_option: - /* empty */ - { - $$ = cb_build_perform_once (NULL); - } -| id_or_lit_or_length_or_func TIMES - { - $$ = cb_build_perform_times ($1); - current_program->loop_counter++; - } -| FOREVER - { - $$ = cb_build_perform_forever (NULL); - } -| perform_test UNTIL cond_or_exit - { - cb_tree varying; - - if (!$3) { - $$ = cb_build_perform_forever (NULL); - } else { - if ($1 == CB_AFTER) - cb_build_perform_after_until(); - varying = CB_LIST_INIT (cb_build_perform_varying (NULL, NULL, NULL, $3)); - $$ = cb_build_perform_until ($1, varying); - } - } -| perform_test VARYING perform_varying_list - { - $$ = cb_build_perform_until ($1, $3); - } -; - -perform_test: - /* empty */ { $$ = CB_BEFORE; } -| _with TEST before_or_after { $$ = $3; } -; - -cond_or_exit: - EXIT { $$ = NULL; } -| condition { $$ = $1; } - -perform_varying_list: - perform_varying { $$ = CB_LIST_INIT ($1); } -| perform_varying_list AFTER - perform_varying { $$ = cb_list_add ($1, $3); } -; - -perform_varying: - identifier FROM x _by_phrase UNTIL condition - { - cb_tree x; - int data_type_ok = 1; - - if ($1 != cb_error_node - && $3 != cb_error_node - && $4 != cb_error_node) { - - if (cb_tree_category ($1) != CB_CATEGORY_NUMERIC) { - x = cb_ref ($1); - cb_error_x (CB_TREE (current_statement), - _("PERFORM VARYING '%s' (line %d of %s) is not a numeric field"), - cb_name (x),x->source_line, x->source_file); - $$ = cb_int1; - data_type_ok = 0; - } - if (cb_tree_category ($3) != CB_CATEGORY_NUMERIC) { - x = cb_ref ($3); - cb_error_x (CB_TREE (current_statement), - _("PERFORM VARYING '%s' (line %d of %s) is not a numeric field"), - cb_name (x),x->source_line, x->source_file); - $$ = cb_int1; - data_type_ok = 0; - } - if (cb_tree_category ($4) != CB_CATEGORY_NUMERIC) { - x = cb_ref ($4); - cb_error_x (CB_TREE (current_statement), - _("PERFORM VARYING '%s' (line %d of %s) is not a numeric field"), - cb_name (x),x->source_line, x->source_file); - $$ = cb_int1; - data_type_ok = 0; - } - - if (data_type_ok) { - $$ = cb_build_perform_varying ($1, $3, $4, $6); - } - } - } -; - -_by_phrase: - /*empty */ - { - cb_verify (cb_perform_varying_without_by, _("PERFORM VARYING without BY phrase")); - $$ = cb_build_numeric_literal (0, "1", 0); - } -| BY arith_nonzero_x - { - $$ = $2; - } -; - -/* PURGE statement (COMMUNICATION SECTION) */ - -purge_statement: - PURGE - { - begin_statement ("PURGE", 0); - } - cd_name - { - } -; - -/* RAISE statement */ - -raise_statement: - RAISE - { - begin_statement ("RAISE", 0); - } - raise_body -; - -raise_body: - EXCEPTION exception_name - { - CB_PENDING ("RAISE statement"); - /* TODO: check for level 3 error here */ - } -| identifier - { - /* easy cheating here as we don't have any OO in */ - cb_error(_("'%s' is not an object-reference"), cb_name ($1)); - } -; - - - -exception_name: - WORD - { - /* TODO: - cb_tree exception = get_exception (CB_NAME($1)); - if (!exception) { - cb_error (_("'%s' is not an exception-name"), CB_NAME ($1)); - } - */ - } -; - -/* READ statement */ - -read_statement: - READ - { - begin_statement ("READ", TERM_READ); - cobc_cs_check = CB_CS_READ; - } - read_body - _end_read -; - -read_body: - file_name _flag_next _record _read_into _lock_phrases _read_key read_handler - { - cobc_cs_check = 0; - - if (CB_VALID_TREE ($1)) { - struct cb_file *cf; - - cf = CB_FILE(cb_ref ($1)); - if ($5 && (cf->lock_mode & COB_LOCK_AUTOMATIC)) { - cb_error_x (CB_TREE (current_statement), - _("LOCK clause invalid with file LOCK AUTOMATIC")); - } else if ($6 && - (cf->organization != COB_ORG_RELATIVE && - cf->organization != COB_ORG_INDEXED)) { - cb_error_x (CB_TREE (current_statement), - _("KEY clause invalid with this file type")); - } else if (current_statement->handler_type == INVALID_KEY_HANDLER && - (cf->organization != COB_ORG_RELATIVE && - cf->organization != COB_ORG_INDEXED)) { - cb_error_x (CB_TREE (current_statement), - _("INVALID KEY clause invalid with this file type")); - } else { - cb_emit_read ($1, $2, $4, $6, $5); - } - } - } -; - -_read_into: - /* empty */ { $$ = NULL; } -| INTO identifier { $$ = $2; } -; - -_lock_phrases: - /* empty */ %prec SHIFT_PREFER - { - $$ = NULL; - } -| ignoring_lock - { - $$ = cb_int3; - } -| advancing_lock_or_retry _extended_with_lock - { - $$ = $2; - } -| extended_with_lock - { - $$ = $1; - } -; - -ignoring_lock: - IGNORING LOCK - { - current_statement->flag_ignore_lock = 1; - } -| _with IGNORE LOCK - { - current_statement->flag_ignore_lock = 1; - } -; - -advancing_lock_or_retry: - ADVANCING _on LOCK - { - current_statement->flag_advancing_lock = 1; - } -| retry_phrase -; - -_retry_phrase: - /* empty */ -| retry_phrase -; - -retry_phrase: - retry_options - { - cobc_cs_check = 0; - } -; - -retry_options: - /* HACK: added _for to fix shift/reduce conflict. */ - RETRY _for exp TIMES - { - current_statement->retry = $3; - current_statement->flag_retry_times = 1; - } -| RETRY _for exp SECONDS - { - current_statement->retry = $3; - current_statement->flag_retry_seconds = 1; - } -| RETRY FOREVER - { - current_statement->retry = NULL; - current_statement->flag_retry_forever = 1; - } -; - -_extended_with_lock: - /* empty */ -| extended_with_lock -; - -extended_with_lock: - with_lock - { - $$ = $1; - } -| _with KEPT LOCK - { - $$ = cb_int5; - } -| _with WAIT - { - $$ = cb_int4; - } -; - -_read_key: - /* empty */ { $$ = NULL; } -| KEY _is identifier { $$ = $3; } -; - -read_handler: - _invalid_key_phrases -| at_end -; - -_end_read: - /* empty */ %prec SHIFT_PREFER - { - TERMINATOR_WARNING ($-2, READ); - } -| END_READ - { - TERMINATOR_CLEAR ($-2, READ); - } -; - - -/* READY TRACE statement */ - -ready_statement: - READY_TRACE - { - begin_statement ("READY TRACE", 0); - cb_emit_ready_trace (); - } -; - -/* RECEIVE statement (COMMUNICATION) */ - -receive_statement: - RECEIVE - { - begin_statement ("RECEIVE", TERM_RECEIVE); - } - receive_body - _end_receive -; - -receive_body: - cd_name message_or_segment INTO identifier - _data_sentence_phrases -; - -message_or_segment: - MESSAGE -| SEGMENT -; - -_data_sentence_phrases: - /* empty */ %prec SHIFT_PREFER -| no_data_sentence _with_data_sentence -| with_data_sentence _no_data_sentence -; - -_no_data_sentence: - /* empty */ %prec SHIFT_PREFER -| no_data_sentence -; - -no_data_sentence: - NO_DATA statement_list -; - -_with_data_sentence: - /* empty */ %prec SHIFT_PREFER -| with_data_sentence -; - -with_data_sentence: - DATA statement_list /* Optional WITH matched in scanner.l */ -; - -_end_receive: - /* empty */ %prec SHIFT_PREFER - { - TERMINATOR_WARNING ($-2, RECEIVE); - } -| END_RECEIVE - { - TERMINATOR_CLEAR ($-2, RECEIVE); - } -; - -/* RELEASE statement */ - -release_statement: - RELEASE - { - begin_statement ("RELEASE", 0); - } - release_body -; - -release_body: - record_name from_option - { - cb_emit_release ($1, $2); - } -; - - -/* RESET TRACE statement */ - -reset_statement: - RESET_TRACE - { - begin_statement ("RESET TRACE", 0); - cb_emit_reset_trace (); - } -; - -/* RETURN statement */ - -return_statement: - RETURN - { - begin_statement ("RETURN", TERM_RETURN); - } - return_body - _end_return -; - -return_body: - file_name _record _read_into return_at_end - { - cb_emit_return ($1, $3); - } -; - -_end_return: - /* empty */ %prec SHIFT_PREFER - { - TERMINATOR_WARNING ($-2, RETURN); - } -| END_RETURN - { - TERMINATOR_CLEAR ($-2, RETURN); - } -; - - -/* REWRITE statement */ - -rewrite_statement: - REWRITE - { - begin_statement ("REWRITE", TERM_REWRITE); - /* Special in debugging mode */ - save_debug = start_debug; - start_debug = 0; - } - rewrite_body - _end_rewrite -; - -rewrite_body: - file_or_record_name from_option _retry_phrase _with_lock _invalid_key_phrases - { - cb_emit_rewrite ($1, $2, $4); - start_debug = save_debug; - } -; - -_with_lock: - /* empty */ - { - $$ = NULL; - } -| with_lock -; - -with_lock: - _with LOCK - { - $$ = cb_int1; - } -| _with NO LOCK - { - $$ = cb_int2; - } -; - -_end_rewrite: - /* empty */ %prec SHIFT_PREFER - { - TERMINATOR_WARNING ($-2, REWRITE); - } -| END_REWRITE - { - TERMINATOR_CLEAR ($-2, REWRITE); - } -; - - -/* ROLLBACK statement */ - -rollback_statement: - ROLLBACK _transaction - { - begin_statement ("ROLLBACK", 0); - cb_emit_rollback (); - } -; - - -/* SEARCH statement */ - -search_statement: - SEARCH - { - begin_statement ("SEARCH", TERM_SEARCH); - } - search_body - _end_search -; - -search_body: - table_name search_varying search_at_end search_whens - { - cb_emit_search ($1, $2, $3, $4); - } -| ALL table_name search_at_end WHEN expr - statement_list - { - current_statement->name = (const char *)"SEARCH ALL"; - cb_emit_search_all ($2, $3, $5, $6); - } -; - -search_varying: - /* empty */ { $$ = NULL; } -| VARYING identifier { $$ = $2; } -; - -search_at_end: - /* empty */ - { - $$ = NULL; - } -| END - statement_list - { - $$ = $2; - } -; - -search_whens: - search_when %prec SHIFT_PREFER - { - $$ = CB_LIST_INIT ($1); - } -| search_when search_whens - { - $$ = cb_list_add ($2, $1); - } -; - -search_when: - WHEN condition - statement_list - { - $$ = cb_build_if_check_break ($2, $3); - } -; - -_end_search: - /* empty */ %prec SHIFT_PREFER - { - TERMINATOR_WARNING ($-2, SEARCH); - } -| END_SEARCH - { - TERMINATOR_CLEAR ($-2, SEARCH); - } -; - - -/* SEND statement (COMMUNICATION SECTION) */ - -send_statement: - SEND - { - begin_statement ("SEND", 0); - } - send_body -; - -send_body: - cd_name from_identifier - { - } -| cd_name _from_identifier with_indicator write_option _replacing_line - { - } -; - -_from_identifier: - /* empty */ -| from_identifier -; - -from_identifier: - FROM identifier - { - } -; - -with_indicator: - _with identifier -| _with ESI -| _with EMI -| _with EGI -; - -_replacing_line: - /* empty */ -| REPLACING _line -; - -/* SET statement */ - -set_statement: - SET - { - begin_statement ("SET", 0); - set_attr_val_on = 0; - set_attr_val_off = 0; - cobc_cs_check = CB_CS_SET; - } - set_body - { - cobc_cs_check = 0; - } -; - -set_body: - set_environment -| set_attr -| set_to -| set_up_down -| set_to_on_off_sequence -| set_to_true_false_sequence -| set_last_exception_to_off -| set_thread_priority -; - -on_or_off: - ON { $$ = cb_int1; } -| OFF { $$ = cb_int0; } -; - -up_or_down: - UP { $$ = cb_int0; } -| DOWN { $$ = cb_int1; } -; - -/* SET ENVIRONMENT ... TO ... */ - -set_environment: - ENVIRONMENT simple_display_value TO simple_display_value - { - cb_emit_setenv ($2, $4); - } -; - -/* SET name ATTRIBUTE ... */ - -set_attr: - sub_identifier ATTRIBUTE set_attr_clause - { - cb_emit_set_attribute ($1, set_attr_val_on, set_attr_val_off); - } -; - -set_attr_clause: - set_attr_one -| set_attr_clause set_attr_one -; - -set_attr_one: - BELL on_or_off - { - bit_set_attr ($2, COB_SCREEN_BELL); - } -| BLINK on_or_off - { - bit_set_attr ($2, COB_SCREEN_BLINK); - } -| HIGHLIGHT on_or_off - { - bit_set_attr ($2, COB_SCREEN_HIGHLIGHT); - check_not_highlight_and_lowlight (set_attr_val_on | set_attr_val_off, - COB_SCREEN_HIGHLIGHT); - } -| LOWLIGHT on_or_off - { - bit_set_attr ($2, COB_SCREEN_LOWLIGHT); - check_not_highlight_and_lowlight (set_attr_val_on | set_attr_val_off, - COB_SCREEN_LOWLIGHT); - } -| REVERSE_VIDEO on_or_off - { - bit_set_attr ($2, COB_SCREEN_REVERSE); - } -| UNDERLINE on_or_off - { - bit_set_attr ($2, COB_SCREEN_UNDERLINE); - } -| LEFTLINE on_or_off - { - bit_set_attr ($2, COB_SCREEN_LEFTLINE); - } -| OVERLINE on_or_off - { - bit_set_attr ($2, COB_SCREEN_OVERLINE); - } -; - -/* SET name ... TO expr */ - -set_to: - target_x_list TO ENTRY alnum_or_id - { - cb_emit_set_to ($1, cb_build_ppointer ($4)); - } -| target_x_list TO ADDRESS _of FH__FCD _of file_name - { - cb_emit_set_to_fcd ($1, $7); - } -| target_x_list TO ADDRESS _of FH__KEYDEF _of file_name - { - cb_emit_set_to_fcdkey ($1, $7); - } -| target_x_list TO x - { - cb_emit_set_to ($1, $3); - } -| target_x_list TO SIZE OF x /* ACUCOBOL extension, cater for dialect setting later */ - { - cb_emit_move (cb_build_length ($5), $1); - } -; - -/* SET name ... UP/DOWN BY expr */ - -set_up_down: - target_x_list up_or_down BY x - { - cb_emit_set_up_down ($1, $2, $4); - } -; - -/* SET mnemonic-name-1 ... TO ON/OFF */ - -set_to_on_off_sequence: - set_to_on_off -| set_to_on_off_sequence set_to_on_off -; - -set_to_on_off: - mnemonic_name_list TO on_or_off - { - cb_emit_set_on_off ($1, $3); - } -; - -/* SET condition-name-1 ... TO TRUE/FALSE */ - -set_to_true_false_sequence: - set_to_true_false -| set_to_true_false_sequence set_to_true_false -; - -set_to_true_false: - target_x_list TO TOK_TRUE - { - cb_emit_set_true ($1); - } -| target_x_list TO TOK_FALSE - { - cb_emit_set_false ($1); - } -; - -/* SET LAST EXCEPTION TO OFF */ - -set_last_exception_to_off: - LAST EXCEPTION TO OFF - { - cb_emit_set_last_exception_to_off (); - } -; - -/* SET THREAD thread-handle PRIORITY TO priority */ - -set_thread_priority: - thread_reference_optional PRIORITY TO pos_num_id_or_lit_or_zero - { - cb_emit_set_thread_priority ($1, $4); - CB_PENDING ("THREAD"); - } -; - - -/* SORT statement */ - -sort_statement: - SORT - { - begin_statement ("SORT", 0); - } - sort_body -; - -sort_body: - table_identifier _sort_key_list _sort_duplicates _sort_collating - { - cb_tree x = cb_ref ($1); - - $$ = NULL; - if (CB_VALID_TREE (x)) { - if ($2 == NULL || CB_VALUE($2) == NULL) { - if (CB_FILE_P (x)) { - cb_error (_("file sort requires KEY phrase")); - $2 = cb_error_node; - } else { - struct cb_field *f = CB_FIELD_PTR (x); -/* TODO: add compiler configuration cb_sort_without_keys - if (f->nkeys - && cb_verify (cb_sort_without_keys, _("table SORT without keys"))) { -*/ - if ($2 != NULL || f->nkeys) { - cb_tree lparm; - if ($2 == NULL) { - /* create reference to first key */ - x = cb_ref (f->keys[0].key); - } - /* use the OCCURS field / its defined KEY as single sort key */ - lparm = cb_list_add (NULL, x); - /* search order is either specified, otherwise derived from definition */ - if ($2 != NULL) { - CB_PURPOSE (lparm) = CB_PURPOSE ($2); - } else { - CB_PURPOSE (lparm) = cb_int (f->keys[0].dir); - } - $2 = cb_list_append (NULL, lparm); - } else { - cb_error (_("table SORT requires KEY phrase")); - $2 = cb_error_node; - } - } - } - if (CB_VALID_TREE ($2)) { - cb_emit_sort_init ($1, $2, alphanumeric_collation, national_collation); - $$ = $1; - } - } - } - sort_input sort_output - { - if ($5 && CB_VALID_TREE ($1)) { - cb_emit_sort_finish ($1); - } - } -; - -_sort_key_list: - /* empty */ { $$ = NULL; } -| _sort_key_list - _on ascending_or_descending _key _key_sort_list - { - cb_tree lparm = $5; - cb_tree l; - - if (lparm == NULL) { - lparm = CB_LIST_INIT (NULL); - } - for (l = lparm; l; l = CB_CHAIN (l)) { - CB_PURPOSE (l) = $3; - } - $$ = cb_list_append ($1, lparm); - } -; - -_key_sort_list: - /* empty */ { $$ = NULL; } -| _key_sort_list qualified_word { $$ = cb_list_add ($1, $2); } -; - -_sort_duplicates: -| _with DUPLICATES _in_order - { - /* The GnuCOBOL sort is a stable sort. ie. dups are per default in order */ - /* Therefore nothing to do here */ - } -; - -_sort_collating: - /* empty */ - { - alphanumeric_collation = national_collation = NULL; - } -| collating_sequence -; - -sort_input: - /* empty */ - { - if ($0 && CB_FILE_P (cb_ref ($0))) { - cb_error (_("file sort requires USING or INPUT PROCEDURE")); - } - } -| USING file_name_list - { - if ($0) { - if (!CB_FILE_P (cb_ref ($0))) { - cb_error (_("USING invalid with table SORT")); - } else { - cb_emit_sort_using ($0, $2); - } - } - } -| INPUT PROCEDURE _is perform_procedure - { - if ($0) { - if (!CB_FILE_P (cb_ref ($0))) { - cb_error (_("INPUT PROCEDURE invalid with table SORT")); - } else if (current_statement->flag_merge) { - cb_error (_("INPUT PROCEDURE invalid with MERGE")); - } else { - cb_emit_sort_input ($4); - } - } - cobc_cs_check = 0; - } -; - -sort_output: - /* empty */ - { - if ($-1 && CB_FILE_P (cb_ref ($-1))) { - cb_error (_("file sort requires GIVING or OUTPUT PROCEDURE")); - } - } -| GIVING file_name_list - { - if ($-1) { - if (!CB_FILE_P (cb_ref ($-1))) { - cb_error (_("GIVING invalid with table SORT")); - } else { - cb_emit_sort_giving ($-1, $2); - } - } - } -| OUTPUT PROCEDURE _is perform_procedure - { - if ($-1) { - if (!CB_FILE_P (cb_ref ($-1))) { - cb_error (_("OUTPUT PROCEDURE invalid with table SORT")); - } else { - cb_emit_sort_output ($4); - } - } - cobc_cs_check = 0; - } -; - - -/* START statement */ - -start_statement: - START - { - begin_statement ("START", TERM_START); - start_tree = cb_int (COB_EQ); - } - start_body - _end_start -; - -start_body: - file_name _start_key _sizelen_clause _invalid_key_phrases - { - if ($3 && !$2) { - cb_error_x (CB_TREE (current_statement), - _("SIZE/LENGTH invalid here")); - } else { - cb_emit_start ($1, start_tree, $2, $3); - } - } -; - -_sizelen_clause: - /* empty */ - { - $$ = NULL; - } -| _with size_or_length exp - { - $$ = $3; - } -; - -_start_key: - /* empty */ - { - $$ = NULL; - } -| KEY _is start_op identifier - { - start_tree = $3; - $$ = $4; - } -| FIRST - { - start_tree = cb_int (COB_FI); - $$ = NULL; - } -| LAST - { - start_tree = cb_int (COB_LA); - $$ = NULL; - } -; - -start_op: - eq { $$ = cb_int (COB_EQ); } -| _flag_not gt { $$ = cb_int ($1 ? COB_LE : COB_GT); } -| _flag_not lt { $$ = cb_int ($1 ? COB_GE : COB_LT); } -| _flag_not ge { $$ = cb_int ($1 ? COB_LT : COB_GE); } -| _flag_not le { $$ = cb_int ($1 ? COB_GT : COB_LE); } -| disallowed_op { $$ = cb_int (COB_NE); } -; - -disallowed_op: - not_equal_op - { - cb_error_x (CB_TREE (current_statement), - _("NOT EQUAL condition not allowed on START statement")); - } -; - -not_equal_op: - NOT eq -| NOT_EQUAL -; - -_end_start: - /* empty */ %prec SHIFT_PREFER - { - TERMINATOR_WARNING ($-2, START); - } -| END_START - { - TERMINATOR_CLEAR ($-2, START); - } -; - -/* START TRANSACTION statement (activates transaction logging - for all files with lock_mode & COB_LOCK_ROLLBACK) */ - -start_transaction_statement: - START transaction -; - -_transaction: -| transaction -; - -transaction: - TRANSACTION - { - CB_PENDING ("TRANSACTION"); - } -; - - -/* STOP statement */ - -stop_statement: - STOP RUN - { - begin_statement ("STOP RUN", 0); - cobc_cs_check = CB_CS_STOP; - } - stop_returning - { - cb_emit_stop_run ($4); - check_unreached = 1; - cobc_cs_check = 0; - } -| STOP stop_argument - { - begin_statement ("STOP", 0); - cb_emit_display (CB_LIST_INIT ($2), cb_int0, cb_int1, NULL, - NULL, 1, DEVICE_DISPLAY); - cb_emit_accept (cb_null, NULL, NULL); - cobc_cs_check = 0; - } -| STOP thread_reference_optional - { - begin_statement ("STOP THREAD", 0); - cb_emit_stop_thread ($2); - cobc_cs_check = 0; - cb_warning_x (COBC_WARN_FILLER, $2, _("%s is replaced by %s"), "STOP THREAD", "STOP RUN"); - } -; - -stop_returning: - /* empty */ - { - if (current_program->cb_return_code) { - $$ = current_program->cb_return_code; - } else { - $$ = cb_int0; - } - } -| return_give x /* common extension, should error with -std=cobolX */ - { - $$ = $2; - } -| x /* RM/COBOL extension, should error with most -std */ - { - $$ = $1; - } -| _with ERROR _status _status_x - { - if ($4) { - $$ = $4; - } else { - $$ = cb_int1; - } - } -| _with NORMAL _status _status_x - { - if ($4) { - $$ = $4; - } else { - $$ = cb_int0; - } - } -; - -_status_x: - /* empty */ - { - $$ = NULL; - } -| x - { - $$ = $1; - } -; - -stop_argument: - stop_literal - { - cb_verify (cb_stop_literal_statement, _("STOP literal")); - } -| identifier - { - cb_verify (cb_stop_identifier_statement, _("STOP identifier")); - } -; - -stop_literal: - LITERAL { $$ = $1; } -| SPACE { $$ = cb_space; } -| ZERO { $$ = cb_zero; } -| QUOTE { $$ = cb_quote; } -; - -/* STRING statement */ - -string_statement: - STRING - { - begin_statement ("STRING", TERM_STRING); - } - string_body - _end_string -; - -string_body: - string_items INTO identifier _with_pointer _on_overflow_phrases - { - cb_emit_string ($1, $3, $4); - } -; - -string_items: - { - save_tree = NULL; - } - string_item_list - { - $$ = save_tree; - } -; - -string_item_list: - string_item -| string_item_list string_item -; - -string_item: - x _string_delimited - { - if (!save_tree) { - save_tree = CB_LIST_INIT ($1); - } else { - save_tree = cb_list_add (save_tree, $1); - } - if ($2) { - save_tree = cb_list_add (save_tree, $2); - } - } -; - -_string_delimited: - /* empty */ { $$ = NULL; } -| DELIMITED _by - string_delimiter { $$ = $3; } -; - -string_delimiter: - SIZE { $$ = CB_BUILD_PAIR (cb_int0, NULL); } -| x { $$ = CB_BUILD_PAIR ($1, NULL); } -; - -_with_pointer: - /* empty */ { $$ = NULL; } -| _with POINTER _is identifier { $$ = $4; } -; - -_end_string: - /* empty */ %prec SHIFT_PREFER - { - TERMINATOR_WARNING ($-2, STRING); - } -| END_STRING - { - TERMINATOR_CLEAR ($-2, STRING); - } -; - - -/* SUBTRACT statement */ - -subtract_statement: - SUBTRACT - { - begin_statement ("SUBTRACT", TERM_SUBTRACT); - } - subtract_body - _end_subtract -; - -subtract_body: - x_list FROM arithmetic_x_list on_size_error_phrases - { - cb_emit_arithmetic ($3, '-', cb_build_binary_list ($1, '+')); - } -| x_list FROM x GIVING arithmetic_x_list on_size_error_phrases - { - cb_emit_arithmetic ($5, 0, cb_build_binary_list (CB_BUILD_CHAIN ($3, $1), '-')); - } -| CORRESPONDING identifier FROM identifier flag_rounded on_size_error_phrases - { - cb_emit_corresponding (cb_build_sub, $4, $2, $5); - } -| TABLE table_identifier FROM table_identifier flag_rounded _from_idx_to_idx _dest_index on_size_error_phrases - { - CB_PENDING ("SUBTRACT TABLE"); - cb_emit_tab_arithmetic (cb_build_sub, $4, $2, $5, $6, $7); - } -; - -_end_subtract: - /* empty */ %prec SHIFT_PREFER - { - TERMINATOR_WARNING ($-2, SUBTRACT); - } -| END_SUBTRACT - { - TERMINATOR_CLEAR ($-2, SUBTRACT); - } -; - - -/* SUPPRESS statement */ - -suppress_statement: - SUPPRESS _printing - { - begin_statement ("SUPPRESS", 0); - if (!in_declaratives) { - cb_error_x (CB_TREE (current_statement), - _("SUPPRESS statement must be within DECLARATIVES")); - } - cb_emit_suppress (control_field); - } -; - -_printing: -| PRINTING -; - -/* TERMINATE statement */ - -terminate_statement: - TERMINATE - { - begin_statement ("TERMINATE", 0); - } - terminate_body -; - -terminate_body: - report_name - { - begin_implicit_statement (); - if ($1 != cb_error_node) { - cb_emit_terminate ($1); - } - } -| terminate_body report_name - { - begin_implicit_statement (); - if ($2 != cb_error_node) { - cb_emit_terminate ($2); - } - } -; - -/* TRANSFORM statement */ - -transform_statement: - TRANSFORM - { - begin_statement ("TRANSFORM", 0); - } - transform_body -; - -transform_body: - display_identifier FROM simple_display_value TO simple_display_all_value - { - cb_tree x; - - x = cb_build_converting ($3, $5, cb_build_inspect_region_start ()); - cb_emit_inspect ($1, x, TRANSFORM_STATEMENT); - } -; - - -/* UNLOCK statement */ - -unlock_statement: - UNLOCK - { - begin_statement ("UNLOCK", 0); - } - unlock_body -; - -unlock_body: - file_name _records - { - if (CB_VALID_TREE ($1)) { - if (CB_FILE (cb_ref ($1))->organization == COB_ORG_SORT) { - cb_error_x (CB_TREE (current_statement), - _("UNLOCK invalid for SORT files")); - } else { - cb_emit_unlock ($1); - } - } - } -; - -/* UNSTRING statement */ - -unstring_statement: - UNSTRING - { - begin_statement ("UNSTRING", TERM_UNSTRING); - } - unstring_body - _end_unstring -; - -unstring_body: - /* Note: using an literal here is an extension */ - id_or_lit_or_func _unstring_delimited unstring_into - _with_pointer _unstring_tallying _on_overflow_phrases - { - cb_emit_unstring ($1, $2, $3, $4, $5); - } -; - -_unstring_delimited: - /* empty */ { $$ = NULL; } -| DELIMITED _by - unstring_delimited_list { $$ = $3; } -; - -unstring_delimited_list: - unstring_delimited_item { $$ = CB_LIST_INIT ($1); } -| unstring_delimited_list OR - unstring_delimited_item { $$ = cb_list_add ($1, $3); } -; - -unstring_delimited_item: - flag_all simple_display_value - { - $$ = cb_build_unstring_delimited ($1, $2); - } -; - -unstring_into: - INTO unstring_into_item { $$ = CB_LIST_INIT ($2); } -| unstring_into - unstring_into_item { $$ = cb_list_add ($1, $2); } -; - -unstring_into_item: - identifier _unstring_into_delimiter _count_in - { - $$ = cb_build_unstring_into ($1, $2, $3); - } -; - -_unstring_into_delimiter: - /* empty */ { $$ = NULL; } -| DELIMITER _in identifier { $$ = $3; } -; - -_unstring_tallying: - /* empty */ { $$ = NULL; } -| TALLYING _in identifier { $$ = $3; } -; - -_end_unstring: - /* empty */ %prec SHIFT_PREFER - { - TERMINATOR_WARNING ($-2, UNSTRING); - } -| END_UNSTRING - { - TERMINATOR_CLEAR ($-2, UNSTRING); - } -; - -/* VALIDATE statement */ - -validate_statement: - VALIDATE - { - begin_statement ("VALIDATE", 0); - } - validate_fields - { -#if 0 /* FIXME: at least add syntax checks here */ - cb_emit_validate ($3); -#else - CB_PENDING ("VALIDATE"); -#endif - } -; - -validate_fields: - identifier - { - check_validate_item ($1); - $$ = CB_LIST_INIT ($1); - } -| validate_fields identifier - { - check_validate_item ($2); - $$ = cb_list_add ($1, $2); - } -; - - -/* USE statement */ - -use_statement: - USE - { - skip_statements = 0; - in_debugging = 0; - } - use_phrase -; - -use_phrase: - use_file_exception -| use_debugging -| use_start_end -| use_reporting -| use_exception_list -; - -use_file_exception: - use_global _after _standard exception_or_error _procedure - _on use_file_exception_target - { - if (!in_declaratives) { - cb_error (_("USE statement must be within DECLARATIVES")); - } else if (!current_section) { - cb_error (_("SECTION header missing before USE statement")); - } else { - current_section->flag_begin = 1; - current_section->flag_return = 1; - current_section->flag_declarative_exit = 1; - current_section->flag_real_label = 1; - current_section->flag_skip_label = 0; - CB_EXCEPTION_ENABLE (COB_EC_I_O) = 1; - if (use_global_ind) { - current_section->flag_global = 1; - current_program->global_list = - cb_list_add (current_program->global_list, - CB_TREE (current_section)); - } - emit_statement (cb_build_comment ("USE AFTER ERROR")); - } - } -; - -use_global: - /* empty */ - { - use_global_ind = 0; - } -| GLOBAL - { - if (current_program->prog_type == COB_MODULE_TYPE_FUNCTION) { - cb_error (_("%s is invalid in a user FUNCTION"), "GLOBAL"); - } else { - use_global_ind = 1; - current_program->flag_global_use = 1; - } - } -; - -use_file_exception_target: - file_name_list - { - cb_tree l; - - for (l = $1; l; l = CB_CHAIN (l)) { - if (CB_VALID_TREE (CB_VALUE (l))) { - setup_use_file (CB_FILE (cb_ref (CB_VALUE (l)))); - } - } - } -| INPUT - { - current_program->global_handler[COB_OPEN_INPUT].handler_label = current_section; - current_program->global_handler[COB_OPEN_INPUT].handler_prog = current_program; - } -| OUTPUT - { - current_program->global_handler[COB_OPEN_OUTPUT].handler_label = current_section; - current_program->global_handler[COB_OPEN_OUTPUT].handler_prog = current_program; - } -| I_O - { - current_program->global_handler[COB_OPEN_I_O].handler_label = current_section; - current_program->global_handler[COB_OPEN_I_O].handler_prog = current_program; - } -| EXTEND - { - current_program->global_handler[COB_OPEN_EXTEND].handler_label = current_section; - current_program->global_handler[COB_OPEN_EXTEND].handler_prog = current_program; - } -; - -use_debugging: - _for DEBUGGING _on debugging_list - { - cb_tree plabel; - char name[64]; - - cb_verify (cb_use_for_debugging, "USE FOR DEBUGGING"); - - if (!in_declaratives) { - cb_error (_("USE statement must be within DECLARATIVES")); - } else if (current_program->nested_level) { - cb_error (_("USE DEBUGGING not supported in contained program")); - } else { - in_debugging = 1; - current_section->flag_begin = 1; - current_section->flag_return = 1; - current_section->flag_declarative_exit = 1; - current_section->flag_real_label = 0; - current_section->flag_is_debug_sect = 1; - if (!needs_debug_item) { - needs_debug_item = 1; - cb_build_debug_item (); - } - if (!current_program->flag_debugging) { - skip_statements = 1; - current_section->flag_skip_label = 1; - } else { - current_program->flag_gen_debug = 1; - sprintf (name, "EXIT SECTION %d", cb_id); - plabel = cb_build_reference (name); - plabel = cb_build_label (plabel, NULL); - CB_LABEL (plabel)->flag_begin = 1; - CB_LABEL (plabel)->flag_dummy_exit = 1; - current_section->exit_label = plabel; - emit_statement (cb_build_comment ("USE FOR DEBUGGING")); - } - } - } -; - -debugging_list: - debugging_target -| debugging_list debugging_target -; - -debugging_target: - identifier_1 /* note: check for subscript/refmod in typeck.c */ - { - if (current_program->flag_debugging) { - - cb_tree z = CB_LIST_INIT ($1); - current_program->debug_list = - cb_list_append (current_program->debug_list, z); - /* Check backward refs to file/data names */ - if (CB_WORD_COUNT ($1) > 0) { - cb_tree l = CB_VALUE (CB_WORD_ITEMS ($1)); - switch (CB_TREE_TAG (l)) { - case CB_TAG_CD: - if (CB_CD (l)->flag_field_debug) { - cb_error_x ($1, _("duplicate DEBUGGING target: '%s'"), - cb_name (l)); - } else { - CB_CD (l)->debug_section = current_section; - CB_CD (l)->flag_field_debug = 1; - } - break; - case CB_TAG_FILE: - if (CB_FILE (l)->flag_fl_debug) { - cb_error_x ($1, _("duplicate DEBUGGING target: '%s'"), - cb_name (l)); - } else { - CB_FILE (l)->debug_section = current_section; - CB_FILE (l)->flag_fl_debug = 1; - } - break; - case CB_TAG_FIELD: - { - struct cb_field* fld; - cb_tree x = cb_ref ($1); - if (!x || !CB_FIELD_P (x)) { - break; - } - fld = CB_FIELD (x); - if (fld->flag_item_78) { - cb_error_x ($1, _("constant item cannot be used here")); - } else if (fld->flag_field_debug) { - cb_error_x ($1, _("duplicate DEBUGGING target: '%s'"), - cb_name (x)); - } else { - needs_field_debug = 1; - fld->debug_section = current_section; - fld->flag_field_debug = 1; - CB_PURPOSE (z) = x; - } - } - break; - default: - /* Label refs will be checked later (forward/backward ref) */ - break; - } - } - CB_REFERENCE ($1)->debug_section = current_section; - CB_REFERENCE ($1)->flag_debug_code = 1; - CB_REFERENCE ($1)->flag_all_debug = 0; - } - } -| ALL PROCEDURES - { - if (current_program->flag_debugging) { - if (current_program->all_procedure) { - cb_error (_("duplicate USE DEBUGGING ON ALL PROCEDURES")); - } else { - current_program->all_procedure = current_section; - } - } - } -| ALL _all_refs identifier_field /* note: check for subscript/refmod in typeck.c */ - { - if (current_program->flag_debugging && $3 != cb_error_node) { - cb_tree x = cb_ref ($3); - struct cb_field *fld = CB_FIELD (x); - if (fld->flag_field_debug) { - cb_error_x ($3, _("duplicate DEBUGGING target: '%s'"), - cb_name (x)); - } else { - struct cb_reference *r = CB_REFERENCE ($3); - needs_field_debug = 1; - fld->debug_section = current_section; - fld->flag_field_debug = 1; - fld->flag_all_debug = 1; - r->debug_section = current_section; - r->flag_debug_code = 1; - r->flag_all_debug = 1; - CB_CHAIN_PAIR (current_program->debug_list, x, $3); - } - } - } -; - -_all_refs: -| REFERENCES -| REFERENCES OF -| OF -; - -use_start_end: - _at PROGRAM program_start_end - { - if (current_program->nested_level) { - cb_error (_("%s is invalid in nested program"), "USE AT"); - } - } -; - -program_start_end: - START - { - emit_statement (cb_build_comment ("USE AT PROGRAM START")); - backup_current_pos (); - CB_PENDING ("USE AT PROGRAM START"); - /* emit_entry ("_AT_START", 0, NULL, NULL); */ - } -| END - { - emit_statement (cb_build_comment ("USE AT PROGRAM END")); - backup_current_pos (); - CB_PENDING ("USE AT PROGRAM END"); - /* emit_entry ("_AT_END", 0, NULL, NULL); */ - } -; - - -use_reporting: - use_global BEFORE REPORTING identifier - { - char *wrk; - cb_tree x; - struct cb_field *f; - struct cb_report *r; - - x = cb_ref ($4); - if (!CB_FIELD_P (x)) { - cb_error_x ($4, _("'%s' is not a report group"), CB_NAME ($4)); - $$ = cb_error_node; - } else { - control_field = f = CB_FIELD (x); - f->report_decl_id = current_section->id; - if ((r = f->report) != NULL) { - r->has_declarative = 1; - } - } - wrk = cobc_main_malloc (COB_MINI_BUFF); - snprintf (wrk, COB_MINI_MAX, "USE BEFORE REPORTING %s is %s%d", - cb_name ($4), CB_PREFIX_LABEL, current_section->id); - current_section->flag_real_label = 1; - current_section->flag_declaratives = 1; - current_section->flag_begin = 1; - current_section->flag_return = 1; - current_section->flag_declarative_exit = 1; - current_section->flag_real_label = 1; - current_section->flag_skip_label = 0; - emit_statement (cb_build_comment (wrk)); - } -; - -use_exception_list: - use_exception -| use_exception_list use_exception -; - -use_exception: - use_ex_keyw exception_name - { - current_section->flag_real_label = 1; - emit_statement (cb_build_comment ("USE AFTER EXCEPTION CONDITION")); - CB_PENDING ("USE AFTER EXCEPTION CONDITION"); - } -| use_ex_keyw exception_name file_file_name_list - { - cb_tree l; - - for (l = $3; l; l = CB_CHAIN (l)) { - if (CB_VALID_TREE (CB_VALUE (l))) { - setup_use_file (CB_FILE (cb_ref (CB_VALUE (l)))); - } - } - current_section->flag_real_label = 1; - emit_statement(cb_build_comment("USE AFTER EXCEPTION CONDITION")); - CB_PENDING("USE AFTER EXCEPTION CONDITION"); - } -; - -use_ex_keyw: - EXCEPTION_CONDITION -| EC -; - -/* WRITE statement */ - -write_statement: - WRITE - { - begin_statement ("WRITE", TERM_WRITE); - /* Special in debugging mode */ - save_debug = start_debug; - start_debug = 0; - } - write_body - _end_write -; - -write_body: - file_or_record_name from_option write_option _retry_phrase _with_lock write_handler - { - if (CB_VALID_TREE ($1)) { - cb_emit_write ($1, $2, $3, $5); - } - start_debug = save_debug; - } -; - -from_option: - /* empty */ { $$ = NULL; } -| FROM from_parameter { $$ = $2; } -; - -write_option: - /* empty */ - { - $$ = cb_int0; - } -| before_or_after _advancing num_id_or_lit _line_or_lines - { - $$ = cb_build_write_advancing_lines ($1, $3); - } -| before_or_after _advancing mnemonic_name - { - $$ = cb_build_write_advancing_mnemonic ($1, $3); - } -| before_or_after _advancing PAGE - { - $$ = cb_build_write_advancing_page ($1); - } -; - -before_or_after: - BEFORE { $$ = CB_BEFORE; } -| AFTER { $$ = CB_AFTER; } -; - -write_handler: - %prec SHIFT_PREFER -| invalid_key_phrases -| at_eop_clauses -; - -_end_write: - /* empty */ %prec SHIFT_PREFER - { - TERMINATOR_WARNING ($-2, WRITE); - } -| END_WRITE - { - TERMINATOR_CLEAR ($-2, WRITE); - } -; - -/* XML GENERATE statement */ - -xml_generate_statement: - XML GENERATE - { - begin_statement ("XML GENERATE", TERM_XML); - cobc_in_xml_generate_body = 1; - cobc_cs_check = CB_CS_XML_GENERATE; - } - xml_generate_body - _end_xml -; - -xml_generate_body: - identifier FROM identifier - _count_in - { - xml_encoding = NULL; - with_xml_dec = 0; - with_attrs = 0; - ml_suppress_list = NULL; - } - _with_encoding_xml_dec_and_attrs - _xml_gen_namespace - _name_of - _type_of - _xml_gen_suppress - { - cobc_in_xml_generate_body = 0; - cobc_cs_check = 0; - } - _xml_exception_phrases - { - cb_emit_xml_generate ($1, $3, $4, xml_encoding, with_xml_dec, - with_attrs, $7, $8, $9, ml_suppress_list); - } -; - -_with_encoding_xml_dec_and_attrs: - /* empty */ -| with_encoding_xml_dec_and_attrs -; - -with_encoding_xml_dec_and_attrs: - with_encoding_xml_dec_and_attr -| with_encoding_xml_dec_and_attrs with_encoding_xml_dec_and_attr -; - -with_encoding_xml_dec_and_attr: - _with encoding_xml_dec_and_attr -; - -encoding_xml_dec_and_attr: - ENCODING simple_value - { - xml_encoding = $2; - if (with_xml_dec) { - cb_error (_("ENCODING clause must come before XML-DECLARATION")); - } else if (with_attrs) { - cb_error (_("ENCODING clause must come before ATTRIBUTES")); - } - cb_verify (cb_xml_generate_extra_phrases, - _("XML GENERATE ENCODING clause")); - CB_PENDING ("XML GENERATE ENCODING"); - } -| XML_DECLARATION - { - with_xml_dec = 1; - if (with_attrs) { - cb_error (_("XML-DECLARATION clause must come before ATTRIBUTES")); - } - cb_verify (cb_xml_generate_extra_phrases, - _("XML GENERATE XML-DECLARATION clause")); - } -| ATTRIBUTES - { - with_attrs = 1; - cb_verify (cb_xml_generate_extra_phrases, - _("XML GENERATE WITH ATTRIBUTES clause")); - } -; - -_xml_gen_namespace: - /* empty */ - { - $$ = NULL; - } -| NAMESPACE _is simple_value _xml_gen_namespace_prefix - { - $$ = CB_BUILD_PAIR ($3, $4); - cb_verify (cb_xml_generate_extra_phrases, - _("XML GENERATE NAMESPACE clause")); - } -; - -_xml_gen_namespace_prefix: - /* empty */ - { - $$ = cb_null; - } -| NAMESPACE_PREFIX _is simple_value - { - $$ = $3; - } -; - -_name_of: - /* empty */ - { - $$ = NULL; - } -| NAME _of identifier_name_list - { - $$ = $3; - cb_verify (cb_xml_generate_extra_phrases, - _("XML GENERATE NAME OF clause")); - } -; - -identifier_name_list: - identifier_is_name - { - $$ = CB_LIST_INIT ($1); - } -| identifier_name_list identifier_is_name - { - $$ = cb_list_add ($1, $2); - } -; - -identifier_is_name: - identifier _is literal - { - $$ = CB_BUILD_PAIR ($1, $3); - } -; - -_type_of: - /* empty */ - { - $$ = NULL; - } -| TYPE _of identifier_type_list - { - $$ = $3; - cb_verify (cb_xml_generate_extra_phrases, - _("XML GENERATE TYPE OF clause")); - } -; - -identifier_type_list: - identifier_is_type - { - $$ = CB_LIST_INIT ($1); - } -| identifier_type_list identifier_is_type - { - $$ = cb_list_add ($1, $2); - } -; - -identifier_is_type: - identifier _is ml_type - { - $$ = CB_BUILD_PAIR ($1, $3); - } -; - -_xml_type: - /* empty */ - { - $$ = cb_int ((int) CB_ML_ANY_TYPE); - } -| ml_type -; - -ml_type: - ATTRIBUTE { $$ = cb_int ((int) CB_ML_ATTRIBUTE); } -| ELEMENT { $$ = cb_int ((int) CB_ML_ELEMENT); } -| CONTENT { $$ = cb_int ((int) CB_ML_CONTENT); } -; - -_xml_gen_suppress: - /* empty */ -| SUPPRESS_XML xml_suppress_list - { - cb_verify (cb_xml_generate_extra_phrases, - _("XML GENERATE SUPPRESS clause")); - } -; - -xml_suppress_list: - xml_suppress_entry -| xml_suppress_list xml_suppress_entry -; - -xml_suppress_entry: - identifier - { - error_if_following_every_clause (); - add_identifier_to_ml_suppress_conds ($1); - } -| EVERY xml_suppress_generic_opt - { - error_if_following_every_clause (); - add_type_to_ml_suppress_conds (ml_suppress_category, (enum cb_ml_type) CB_INTEGER ($2)->val); - } -| WHEN_XML xml_suppress_when_list - { - add_when_to_ml_suppress_conds ($2); - } -; - -xml_suppress_generic_opt: - NUMERIC _xml_type - { - ml_suppress_category = CB_ML_SUPPRESS_CAT_NUMERIC; - $$ = $2; - } -| NONNUMERIC _xml_type - { - ml_suppress_category = CB_ML_SUPPRESS_CAT_NONNUMERIC; - $$ = $2; - } -| ml_type - { - ml_suppress_category = CB_ML_SUPPRESS_CAT_ANY; - $$ = $1; - } -; - -xml_suppress_when_list: - zero_spaces_high_low_values - { - $$ = CB_LIST_INIT ($1); - } -| xml_suppress_when_list OR zero_spaces_high_low_values - { - $$ = cb_list_add ($1, $3); - } -; - -_end_xml: - /* empty */ %prec SHIFT_PREFER - { - TERMINATOR_WARNING ($-2, XML); - } -| END_XML - { - TERMINATOR_CLEAR ($-2, XML); - } -; - - -/* XML PARSE statement */ - -xml_parse_statement: - XML PARSE - { - begin_statement ("XML PARSE", TERM_XML); - /* TO-DO: Add xml-parse and xml-parse-extra-phrases config options. */ - CB_PENDING (_("XML PARSE")); - cobc_cs_check = CB_CS_XML_PARSE; - } - xml_parse_body - _end_xml -; - -xml_parse_body: - identifier - _with_encoding - _returning_national - _validating_with - PROCESSING PROCEDURE _is perform_procedure - { - cobc_cs_check = 0; - } - _xml_exception_phrases -; - -_with_encoding: -/* empty */ -| _with ENCODING simple_value -; - -_returning_national: -/* empty */ -| RETURNING NATIONAL -; - -_validating_with: -/* empty */ -| VALIDATING _with schema_file_or_record_name -; - -schema_file_or_record_name: - record_name -| TOK_FILE WORD - { - if (CB_FILE_P (cb_ref ($2))) { - $$ = $2; - } else { - cb_error_x ($2, _("'%s' is not a file name"), CB_NAME ($2)); - $$ = cb_error_node; - } - } -; - -/* Status handlers */ - -/* ON EXCEPTION */ - -_accept_exception_phrases: - %prec SHIFT_PREFER -| accp_on_exception _accp_not_on_exception -| accp_not_on_exception _accp_on_exception - { - if ($2) { - cb_verify (cb_not_exception_before_exception, - _("NOT EXCEPTION before EXCEPTION")); - } - } -; - -_accp_on_exception: - %prec SHIFT_PREFER - { - $$ = NULL; - } -| accp_on_exception - { - $$ = cb_int1; - } -; - -accp_on_exception: - escape_or_exception _key_dest statement_list - { - current_statement->handler_type = ACCEPT_HANDLER; - current_statement->ex_handler = $3; - } -; - -escape_or_exception: - ESCAPE -| EXCEPTION -; - -_accp_not_on_exception: - %prec SHIFT_PREFER -| accp_not_on_exception -; - -accp_not_on_exception: - not_escape_or_not_exception statement_list - { - current_statement->handler_type = ACCEPT_HANDLER; - current_statement->not_ex_handler = $2; - } -; - -not_escape_or_not_exception: - NOT_ESCAPE -| NOT_EXCEPTION -; - - -_display_exception_phrases: - %prec SHIFT_PREFER -| disp_on_exception _disp_not_on_exception -| disp_not_on_exception _disp_on_exception - { - if ($2) { - cb_verify (cb_not_exception_before_exception, - _("NOT EXCEPTION before EXCEPTION")); - } - } -; - -_disp_on_exception: - %prec SHIFT_PREFER - { - $$ = NULL; - } -| disp_on_exception - { - $$ = cb_int1; - } -; - -disp_on_exception: - EXCEPTION statement_list - { - current_statement->handler_type = DISPLAY_HANDLER; - current_statement->ex_handler = $2; - } -; - -_disp_not_on_exception: - %prec SHIFT_PREFER -| disp_not_on_exception -; - -disp_not_on_exception: - NOT_EXCEPTION statement_list - { - current_statement->handler_type = DISPLAY_HANDLER; - current_statement->not_ex_handler = $2; - } -; - -_xml_exception_phrases: - %prec SHIFT_PREFER -| xml_on_exception _xml_not_on_exception -| xml_not_on_exception _xml_on_exception - { - if ($2) { - cb_verify (cb_not_exception_before_exception, - _("NOT EXCEPTION before EXCEPTION")); - } - } -; - -_xml_on_exception: - %prec SHIFT_PREFER - { - $$ = NULL; - } -| xml_on_exception - { - $$ = cb_int1; - } -; - -xml_on_exception: - EXCEPTION statement_list - { - current_statement->handler_type = XML_HANDLER; - current_statement->ex_handler = $2; - } -; - -_xml_not_on_exception: - %prec SHIFT_PREFER -| xml_not_on_exception -; - -xml_not_on_exception: - NOT_EXCEPTION statement_list - { - current_statement->handler_type = XML_HANDLER; - current_statement->not_ex_handler = $2; - } -; - -_json_exception_phrases: - %prec SHIFT_PREFER -| json_on_exception _json_not_on_exception -| json_not_on_exception _json_on_exception - { - if ($2) { - cb_verify (cb_not_exception_before_exception, - _("NOT EXCEPTION before EXCEPTION")); - } - } -; - -_json_on_exception: - %prec SHIFT_PREFER - { - $$ = NULL; - } -| json_on_exception - { - $$ = cb_int1; - } -; - -json_on_exception: - EXCEPTION statement_list - { - current_statement->handler_type = JSON_HANDLER; - current_statement->ex_handler = $2; - } -; - -_json_not_on_exception: - %prec SHIFT_PREFER -| json_not_on_exception -; - -json_not_on_exception: - NOT_EXCEPTION statement_list - { - current_statement->handler_type = JSON_HANDLER; - current_statement->not_ex_handler = $2; - } -; - -/* ON SIZE ERROR */ - -on_size_error_phrases: - %prec SHIFT_PREFER -| on_size_error _not_on_size_error -| not_on_size_error _on_size_error - { - if ($2) { - cb_verify (cb_not_exception_before_exception, - _("NOT SIZE ERROR before SIZE ERROR")); - } - } -; - -_on_size_error: - %prec SHIFT_PREFER - { - $$ = NULL; - } -| on_size_error - { - $$ = cb_int1; - } -; - -on_size_error: - SIZE_ERROR statement_list - { - current_statement->handler_type = SIZE_ERROR_HANDLER; - current_statement->ex_handler = $2; - } -; - -_not_on_size_error: - %prec SHIFT_PREFER -| not_on_size_error -; - -not_on_size_error: - NOT_SIZE_ERROR statement_list - { - current_statement->handler_type = SIZE_ERROR_HANDLER; - current_statement->not_ex_handler = $2; - } -; - -/* ON OVERFLOW */ - -_on_overflow_phrases: - %prec SHIFT_PREFER -| on_overflow _not_on_overflow -| not_on_overflow _on_overflow - { - if ($2) { - cb_verify (cb_not_exception_before_exception, - _("NOT OVERFLOW before OVERFLOW")); - } - } -; - -_on_overflow: - %prec SHIFT_PREFER - { - $$ = NULL; - } -| on_overflow - { - $$ = cb_int1; - } -; - -on_overflow: - TOK_OVERFLOW statement_list - { - current_statement->handler_type = OVERFLOW_HANDLER; - current_statement->ex_handler = $2; - } -; - -_not_on_overflow: - %prec SHIFT_PREFER -| not_on_overflow -; - -not_on_overflow: - NOT_OVERFLOW statement_list - { - current_statement->handler_type = OVERFLOW_HANDLER; - current_statement->not_ex_handler = $2; - } -; - - -/* AT END */ - -return_at_end: - at_end_clause _not_at_end_clause -| not_at_end_clause at_end_clause - { - cb_verify (cb_not_exception_before_exception, "NOT AT END before AT END"); - } -; - -at_end: - %prec SHIFT_PREFER - at_end_clause _not_at_end_clause -| not_at_end_clause _at_end_clause - { - if ($2) { - cb_verify (cb_not_exception_before_exception, "NOT AT END before AT END"); - } - } -; - -_at_end_clause: - %prec SHIFT_PREFER - { - $$ = NULL; - } -| at_end_clause - { - $$ = cb_int1; - } -; - -at_end_clause: - END statement_list - { - current_statement->handler_type = AT_END_HANDLER; - current_statement->ex_handler = $2; - } -; - -_not_at_end_clause: - %prec SHIFT_PREFER -| not_at_end_clause -; - -not_at_end_clause: - NOT_END statement_list - { - current_statement->handler_type = AT_END_HANDLER; - current_statement->not_ex_handler = $2; - } -; - -/* AT EOP */ - -at_eop_clauses: - at_eop_clause _not_at_eop_clause -| not_at_eop_clause _at_eop_clause - { - if ($2) { - cb_verify (cb_not_exception_before_exception, - _("NOT AT END-OF-PAGE before AT END-OF-PAGE")); - } - } -; - -_at_eop_clause: - %prec SHIFT_PREFER - { - $$ = NULL; - } -| at_eop_clause - { - $$ = cb_int1; - } -; - -at_eop_clause: - EOP statement_list - { - current_statement->handler_type = EOP_HANDLER; - current_statement->ex_handler = $2; - } -; - -_not_at_eop_clause: - %prec SHIFT_PREFER -| not_at_eop_clause -; - -not_at_eop_clause: - NOT_EOP statement_list - { - current_statement->handler_type = EOP_HANDLER; - current_statement->not_ex_handler = $2; - } -; - -/* INVALID KEY */ - -_invalid_key_phrases: - %prec SHIFT_PREFER -| invalid_key_phrases -; - -invalid_key_phrases: - invalid_key_sentence _not_invalid_key_sentence -| not_invalid_key_sentence _invalid_key_sentence - { - if ($2) { - cb_verify (cb_not_exception_before_exception, - _("NOT INVALID KEY before INVALID KEY")); - } - } -; - -_invalid_key_sentence: - %prec SHIFT_PREFER - { - $$ = NULL; - } -| invalid_key_sentence - { - $$ = cb_int1; - } -; - -invalid_key_sentence: - INVALID_KEY statement_list - { - current_statement->handler_type = INVALID_KEY_HANDLER; - current_statement->ex_handler = $2; - } -; - -_not_invalid_key_sentence: - %prec SHIFT_PREFER -| not_invalid_key_sentence -; - -not_invalid_key_sentence: - NOT_INVALID_KEY statement_list - { - current_statement->handler_type = INVALID_KEY_HANDLER; - current_statement->not_ex_handler = $2; - } -; - -/* THREAD constructs */ - -_thread_start: - /* empty */ - { - $$ = NULL; - } -| _in THREAD - { - $$ = cb_int1; - CB_PENDING ("THREAD"); - } -; - -_thread_handle: - /* empty */ - { - $$ = NULL; - } -| HANDLE _in identifier - { - $$ = $3; - CB_PENDING ("THREAD"); - } -; - -thread_reference_optional: - THREAD identifier - { - $$ = $2; - } -| THREAD - { - $$ = NULL; - } -; - -/* Common Constructs */ - -_scroll_lines: - /* empty */ %prec SHIFT_PREFER - { - $$ = cb_one; - } -| pos_num_id_or_lit line_or_lines - { - $$ = $1; - } -; - -_count_in: - /* empty */ { $$ = NULL; } -| COUNT _in identifier { $$ = $3; } -; - -/* Expressions */ - -condition: - expr - { - $$ = cb_build_cond ($1); - cb_end_cond ($$); - } -| error - { - $$ = cb_error_node; - cb_end_cond ($$); - } -; - -expr: - partial_expr - { - $$ = cb_build_expr ($1); - } -; - -partial_expr: - { - current_expr = NULL; - cb_exp_line = cb_source_line; - } - expr_tokens - { - $$ = cb_list_reverse (current_expr); - } -; - -expr_tokens: - expr_token -| expr_tokens expr_token -; - -expr_token: - x { push_expr ('x', $1); } -| _is condition_or_class - /* This case is separate because _is _not_expr causes a shift/reduce error. */ -| IS not_expr condition_or_class - /* This case is not in condition_or_class as x contains ZERO. */ -| IS _not_expr ZERO { push_expr ('x', cb_zero); } -/* Parentheses */ -| TOK_OPEN_PAREN { push_expr ('(', NULL); } -| TOK_CLOSE_PAREN { push_expr (')', NULL); } -/* Arithmetic operators */ -| TOK_PLUS { push_expr ('+', NULL); } -| TOK_MINUS { push_expr ('-', NULL); } -| TOK_MUL { push_expr ('*', NULL); } -| TOK_DIV { push_expr ('/', NULL); } -| EXPONENTIATION { push_expr ('^', NULL); } -/* Logical operators */ -| not_expr -| AND { push_expr ('&', NULL); } -| OR { push_expr ('|', NULL); } -; - -_not_expr: - /* empty */ -| not_expr -; - -not_expr: - NOT { push_expr ('!', NULL); } - -condition_or_class: - CLASS_NAME { push_expr ('C', $1); } -/* Conditional operators */ -| eq { push_expr ('=', NULL); } -| gt { push_expr ('>', NULL); } -| lt { push_expr ('<', NULL); } -| ge { push_expr (']', NULL); } -| le { push_expr ('[', NULL); } -| NOT_EQUAL { push_expr ('~', NULL); } -/* Class condition */ -| OMITTED { push_expr ('O', NULL); } -| NUMERIC { push_expr ('9', NULL); } -| ALPHABETIC { push_expr ('A', NULL); } -| ALPHABETIC_LOWER { push_expr ('L', NULL); } -| ALPHABETIC_UPPER { push_expr ('U', NULL); } -/* Sign condition */ -/* ZERO is defined in 'x' */ -| POSITIVE { push_expr ('P', NULL); } -| NEGATIVE { push_expr ('N', NULL); } -; - -eq: - TOK_EQUAL -| EQUAL _to -; - -gt: - TOK_GREATER -| GREATER -; - -lt: - TOK_LESS -| LESS -; - -ge: - GREATER_OR_EQUAL -; - -le: - LESS_OR_EQUAL -; - -/* Arithmetic expression */ - -exp_list: - exp %prec SHIFT_PREFER - { - $$ = CB_LIST_INIT ($1); - } -| exp_list _e_sep exp %prec SHIFT_PREFER - { - $$ = cb_list_add ($1, $3); - } -; - -_e_sep: - /* empty */ -| COMMA_DELIM -| SEMI_COLON -; - -exp: - exp TOK_PLUS exp_term { $$ = cb_build_binary_op ($1, '+', $3); } -| exp TOK_MINUS exp_term { $$ = cb_build_binary_op ($1, '-', $3); } -| exp_term { $$ = $1; } -; - -exp_term: - exp_term TOK_MUL exp_factor { $$ = cb_build_binary_op ($1, '*', $3); } -| exp_term TOK_DIV exp_factor { $$ = cb_build_binary_op ($1, '/', $3); } -| exp_factor { $$ = $1; } -; - -exp_factor: - exp_unary EXPONENTIATION exp_factor - { - $$ = cb_build_binary_op ($1, '^', $3); - } -| exp_unary { $$ = $1; } -; - -exp_unary: - TOK_PLUS exp_atom { $$ = $2; } -| TOK_MINUS exp_atom { $$ = cb_build_binary_op (cb_zero, '-', $2); } -| exp_atom { $$ = $1; } - -exp_atom: - TOK_OPEN_PAREN exp TOK_CLOSE_PAREN { $$ = $2; } -| arith_x { $$ = $1; } -; - - - -/* Names */ - -/* LINAGE-COUNTER LINE-COUNTER PAGE-COUNTER */ - -line_linage_page_counter: - LINAGE_COUNTER - { - if (current_linage > 1) { - cb_error (_("LINAGE-COUNTER must be qualified here")); - $$ = cb_error_node; - } else if (current_linage == 0) { - cb_error (_("invalid LINAGE-COUNTER usage")); - $$ = cb_error_node; - } else { - $$ = linage_file->linage_ctr; - } - } -| LINAGE_COUNTER in_of WORD - { - if (CB_FILE_P (cb_ref ($3))) { - $$ = CB_FILE (cb_ref ($3))->linage_ctr; - } else { - cb_error_x ($3, _("'%s' is not a file name"), CB_NAME ($3)); - $$ = cb_error_node; - } - } -| LINE_COUNTER - { - if (report_count > 1) { - if (current_report != NULL) { - $$ = current_report->line_counter; - } else { - cb_error (_("LINE-COUNTER must be qualified here")); - $$ = cb_error_node; - } - } else if (report_count == 0) { - cb_error (_("invalid LINE-COUNTER usage")); - $$ = cb_error_node; - } else { - $$ = report_instance->line_counter; - } - } -| LINE_COUNTER in_of WORD - { - if (CB_REF_OR_REPORT_P ($3)) { - $$ = CB_REPORT_PTR ($3)->line_counter; - } else { - cb_error_x ($3, _("'%s' is not a report name"), CB_NAME ($3)); - $$ = cb_error_node; - } - } -| PAGE_COUNTER - { - if (report_count > 1) { - if (current_report != NULL) { - $$ = current_report->page_counter; - } else { - cb_error (_("PAGE-COUNTER must be qualified here")); - $$ = cb_error_node; - } - } else if (report_count == 0) { - cb_error (_("invalid PAGE-COUNTER usage")); - $$ = cb_error_node; - } else { - $$ = report_instance->page_counter; - } - } -| PAGE_COUNTER in_of WORD - { - if (CB_REF_OR_REPORT_P ($3)) { - $$ = CB_REPORT_PTR ($3)->page_counter; - } else { - cb_error_x ($3, _("'%s' is not a report name"), CB_NAME ($3)); - $$ = cb_error_node; - } - } -; - - -/* Data name */ - -arithmetic_x_list: - arithmetic_x { $$ = $1; } -| arithmetic_x_list - arithmetic_x { $$ = cb_list_append ($1, $2); } -; - -arithmetic_x: - target_x flag_rounded - { - $$ = CB_BUILD_PAIR ($2, $1); - } -; - -/* Record name */ - -record_name: - qualified_word { cb_build_identifier ($1, 0); } -; - -/* FILE name -or- Record-name */ - -file_or_record_name: - record_name - { - if (!CB_FILE_P (cb_ref ($1))) { - $$ = $1; - } else { - cb_error_x ($1, _("%s requires a record name as subject"), - current_statement->name); - $$ = cb_error_node; - } - } -| TOK_FILE WORD - { - if (CB_FILE_P (cb_ref ($2))) { - $$ = $2; - } else { - cb_error_x ($2, _("'%s' is not a file name"), CB_NAME ($2)); - $$ = cb_error_node; - } - } -; - -/* Table name */ - -table_name: - qualified_word - { - cb_tree x; - - x = cb_ref ($1); - if (!CB_FIELD_P (x)) { - $$ = cb_error_node; - } else if (!CB_FIELD (x)->index_list) { - cb_error_x ($1, _("'%s' not indexed"), cb_name ($1)); - listprint_suppress (); - cb_error_x (x, _("'%s' defined here"), cb_name (x)); - listprint_restore (); - $$ = cb_error_node; - } else { - $$ = $1; - } - } -; - -/* File name */ - -file_name_list: - file_name - { - $$ = CB_LIST_INIT ($1); - } -| file_name_list file_name - { - cb_tree l; - - if (CB_VALID_TREE ($2)) { - for (l = $1; l; l = CB_CHAIN (l)) { - if (CB_VALID_TREE (CB_VALUE (l)) && - !strcasecmp (CB_NAME ($2), CB_NAME (CB_VALUE (l)))) { - cb_error_x ($2, _("multiple reference to '%s' "), - CB_NAME ($2)); - break; - } - } - if (!l) { - $$ = cb_list_add ($1, $2); - } - } - } -; - -file_file_name_list: - TOK_FILE file_name - { - $$ = CB_LIST_INIT ($2); - } -| file_file_name_list TOK_FILE file_name - { - cb_tree l; - - if (CB_VALID_TREE ($3)) { - for (l = $1; l; l = CB_CHAIN (l)) { - if (CB_VALID_TREE (CB_VALUE (l)) && - !strcasecmp (CB_NAME ($3), CB_NAME (CB_VALUE (l)))) { - cb_error_x ($3, _("multiple reference to '%s' "), - CB_NAME ($2)); - break; - } - } - if (!l) { - $$ = cb_list_add ($1, $3); - } - } - } -; - -file_name: - WORD - { - if (CB_FILE_P (cb_ref ($1))) { - $$ = $1; - } else { - cb_error_x ($1, _("'%s' is not a file name"), CB_NAME ($1)); - $$ = cb_error_node; - } - } -; - -cd_name: - WORD - { - if (CB_CD_P (cb_ref ($1))) { - $$ = $1; - } else { - cb_error_x ($1, _("'%s' is not a CD name"), CB_NAME ($1)); - $$ = cb_error_node; - } - } -; - -/* Report name */ - -report_name: - WORD - { - if (CB_REF_OR_REPORT_P ($1)) { - $$ = $1; - } else { - cb_error (_("'%s' is not a valid report name"), CB_NAME ($1)); - $$ = cb_error_node; - } - } -; - -/* Mnemonic name */ - -mnemonic_name_list: - mnemonic_name { $$ = CB_LIST_INIT ($1); } -| mnemonic_name_list - mnemonic_name { $$ = cb_list_add ($1, $2); } -; - -mnemonic_name: - MNEMONIC_NAME { $$ = $1; } -; - -/* Entry name */ - -entry_name_list: - entry_name { $$ = CB_LIST_INIT ($1); } -| entry_name_list - entry_name { $$ = cb_list_add ($1, $2); } -; - -entry_name: - LITERAL - { - $$ = cb_build_reference ((char *)(CB_LITERAL ($1)->data)); - } -; - -/* Procedure name */ - -procedure_name_list: - %prec SHIFT_PREFER - /* empty */ { $$ = NULL; } -| procedure_name_list - procedure_name { $$ = cb_list_add ($1, $2); } -; - -procedure_name: - label - { - struct cb_reference *r = CB_REFERENCE ($1); - - r->offset = CB_TREE (current_section); - r->flag_in_decl = !!in_declaratives; - r->flag_ignored = cb_set_ignore_error (-1); - - $$ = $1; - CB_ADD_TO_CHAIN ($1, current_program->label_list); - } -; - -label: - qualified_word -| integer_label -| integer_label in_of integer_label - { - CB_REFERENCE ($1)->chain = $3; - } -; - -integer_label: - LITERAL - { - $$ = cb_build_reference ((char *)(CB_LITERAL ($1)->data)); - $$->source_file = $1->source_file; - $$->source_line = $1->source_line; - } -; - -/* Reference */ - -reference_list: - reference { $$ = CB_LIST_INIT ($1); } -| reference_list reference { $$ = cb_list_add ($1, $2); } -; - -reference: - qualified_word - { - $$ = $1; - CB_ADD_TO_CHAIN ($$, current_program->reference_list); - } -; - -_reference: - /* empty */ {$$ = NULL;} -| reference {$$ = $1;} -; - -single_reference_list: - single_reference { $$ = CB_LIST_INIT ($1); } -| single_reference_list single_reference{ $$ = cb_list_add ($1, $2); } -; - -single_reference: - unqualified_word - { - CB_ADD_TO_CHAIN ($1, current_program->reference_list); - } -; - - -/* FIXME: either this is "optional" then _ prefix should be used, - otherwise a more specific name */ -optional_reference_list: - optional_reference - { - $$ = CB_LIST_INIT ($1); - } -| optional_reference_list optional_reference - { - $$ = cb_list_add ($1, $2); - } -; - -optional_reference: - WORD - { - $$ = $1; - CB_REFERENCE($$)->flag_optional = 1; - CB_ADD_TO_CHAIN ($$, current_program->reference_list); - } -; - -reference_or_literal: - reference -| LITERAL -; - -/* Undefined word */ - -undefined_word: - WORD - { - if (CB_WORD_COUNT ($1) > 0) { - redefinition_error ($1); - $$ = cb_error_node; - } else { - $$ = $1; - } - } -| error - { - yyclearin; - yyerrok; - $$ = cb_error_node; - } -; - -/* Unique word */ - -unique_word: - WORD - { - if (CB_REFERENCE ($1)->flag_duped || CB_WORD_COUNT ($1) > 0) { - redefinition_error ($1); - $$ = NULL; - } else { - CB_WORD_COUNT ($1)++; - $$ = $1; - } - } -; - -/* Primitive elements */ - -/* Primitive value */ - -target_x_list: - target_x - { - $$ = CB_LIST_INIT ($1); - } -| target_x_list target_x - { - $$ = cb_list_add ($1, $2); - } -; - -target_x: - target_identifier -| basic_literal -| ADDRESS _of identifier_1 - { - $$ = cb_build_address ($3); - } -; - -_x_list: - /* empty */ { $$ = NULL; } -| x_list { $$ = $1; } -; - -x_list: - x - { - $$ = CB_LIST_INIT ($1); - } -| x_list x - { - $$ = cb_list_add ($1, $2); - } -; - -x: - identifier -| x_common -; - -call_x: - identifier_or_file_name -| x_common -; - -x_common: - literal -| function -| line_linage_page_counter -| length_of_register identifier_1 - { - $$ = cb_build_length ($2); - } -| length_of_register basic_literal - { - $$ = cb_build_length ($2); - } -| length_of_register function - { - $$ = cb_build_length ($2); - } -| ADDRESS _of prog_or_entry alnum_or_id - { - $$ = cb_build_ppointer ($4); - } -| ADDRESS _of identifier_1 - { - $$ = cb_build_address (check_not_88_level ($3)); - } -| MNEMONIC_NAME - { - cb_tree x; - cb_tree switch_id; - - x = cb_ref ($1); - if (CB_VALID_TREE (x)) { - if (CB_SYSTEM_NAME (x)->category != CB_SWITCH_NAME) { - cb_error_x ($1, _("invalid mnemonic identifier")); - $$ = cb_error_node; - } else { - switch_id = cb_int (CB_SYSTEM_NAME (x)->token); - $$ = CB_BUILD_FUNCALL_1 ("cob_switch_value", switch_id); - } - } else { - $$ = cb_error_node; - } - } -; - -length_of_register: - length_of - { - /* FIXME: check with "lookup_register ("LENGTH OF") != NULL" - if we actually want to do this, - otherwise raise an error "not defined in this dialect" - */ - } -; - -report_x_list: - arith_x - { - $$ = CB_LIST_INIT ($1); - } -| report_x_list arith_x - { - $$ = cb_list_add ($1, $2); - } -; - -expr_x: - identifier -| basic_literal -| function -; - -arith_x: - identifier -| basic_literal -| function -| line_linage_page_counter -| length_of_register identifier_1 - { - $$ = cb_build_length ($2); - } -| length_of_register basic_literal - { - $$ = cb_build_length ($2); - } -| length_of_register function - { - $$ = cb_build_length ($2); - } -; - -arith_nonzero_x: - identifier -| nonzero_numeric_literal -| function -| length_of_register identifier_1 - { - $$ = cb_build_length ($2); - } -| length_of_register basic_literal - { - $$ = cb_build_length ($2); - } -| length_of_register function - { - $$ = cb_build_length ($2); - } -; - -numeric_literal: - LITERAL - { - if (CB_TREE_CATEGORY ($1) != CB_CATEGORY_NUMERIC) { - cb_error_x ($1, _("a numeric literal is expected here")); - $$ = cb_error_node; - } else { - $$ = $1; - } - } -; - -non_numeric_literal: - LITERAL - { - if (CB_TREE_CATEGORY ($1) == CB_CATEGORY_NUMERIC) { - cb_error_x ($1, _("a non-numeric literal is expected here")); - $$ = cb_error_node; - } else { - $$ = $1; - } - } -; - -nonzero_numeric_literal: - LITERAL - { - if (cb_tree_category ($1) != CB_CATEGORY_NUMERIC - || cb_get_int ($1) == 0) { - cb_error (_("non-zero value expected")); - $$ = cb_int1; - } else { - $$ = $1; - } - } -; - - -prog_or_entry: - PROGRAM -| ENTRY -; - -alnum_or_id: - identifier_1 -| LITERAL -; - -simple_display_value: - simple_value - { - error_if_not_usage_display_or_nonnumeric_lit ($1); - } -; - -simple_display_all_value: - simple_all_value - { - error_if_not_usage_display_or_nonnumeric_lit ($1); - } -; - -inspect_from: - display_identifier_or_alphabet_name -| basic_literal - { - error_if_not_usage_display_or_nonnumeric_lit ($1); - } -; - -inspect_to: - display_identifier_or_alphabet_name -| literal - { - error_if_not_usage_display_or_nonnumeric_lit ($1); - } -; - -simple_value: - identifier -| basic_literal -| function -; - -simple_all_value: - identifier -| literal -; - -id_or_lit: - identifier - { - $$ = check_not_88_level ($1); - } -| LITERAL -; - -id_or_lit_or_func: - identifier - { - $$ = check_not_88_level ($1); - } -| LITERAL -| function -; - -id_or_lit_or_length_or_func: - identifier - { - $$ = check_not_88_level ($1); - } -| lit_or_length -| function -; - -num_id_or_lit: - sub_identifier - { - $$ = check_not_88_level ($1); - } -| integer -| ZERO - { - $$ = cb_zero; - } -; - -/* literal not allowing zero */ -/* FIXME: expressions would be allowed in most cases, too */ -positive_id_or_lit: - sub_identifier - { - $$ = check_not_88_level ($1); - } -| unsigned_pos_integer -; - -/* literal allowing zero and figurative constant ZERO */ -pos_num_id_or_lit_or_zero: - pos_num_id_or_lit -| ZERO -; - -/* literal allowing zero */ -/* FIXME: expressions would be allowed in most cases, too */ -pos_num_id_or_lit: - sub_identifier - { - $$ = check_not_88_level ($1); - } -| integer -; - -from_parameter: - identifier - { - $$ = check_not_88_level ($1); - } -| literal -| function -; - -/* Identifier */ - -sub_identifier: - sub_identifier_1 { $$ = cb_build_identifier ($1, 0); } -; - -table_identifier: - sub_identifier_1 { $$ = cb_build_identifier ($1, 1); } -; - -sub_identifier_1: - qualified_word { $$ = $1; } -| qualified_word subref { $$ = $1; } -; - -display_identifier: - identifier - { - error_if_not_usage_display_or_nonnumeric_lit ($1); - } -; - -numeric_identifier: - identifier - { - if ($1 != cb_error_node - && cb_tree_category ($1) != CB_CATEGORY_NUMERIC) { - cb_error_x ($1, _("'%s' is not numeric"), cb_name ($1)); - } - } -; - -identifier_or_file_name: - identifier_1 - { - cb_tree x = NULL; - if (CB_REFERENCE_P ($1)) { - x = cb_ref ($1); - } - if (x && (CB_FIELD_P (x) || CB_FILE_P (x))) { - $$ = cb_build_identifier ($1, 0); - } else { - if (x != cb_error_node) { - cb_error_x ($1, _("'%s' is not a field or file"), cb_name ($1)); - } - $$ = cb_error_node; - } - } -; - -/* guarantees a reference to a validated field-reference (or cb_error_node) */ -identifier_field: - identifier_1 - { - cb_tree x = NULL; - if (CB_REFERENCE_P ($1)) { - x = cb_ref ($1); - } - - if (x && CB_FIELD_P (x)) { - $$ = $1; - } else { - if (x != cb_error_node) { - cb_error_x ($1, _("'%s' is not a field"), cb_name ($1)); - } - $$ = cb_error_node; - } - } -; - -identifier: - identifier_1 - { - cb_tree x = NULL; - if (CB_REFERENCE_P ($1)) { - x = cb_ref ($1); - } - if (x && CB_FIELD_P (x)) { - $$ = cb_build_identifier ($1, 0); - } else { - if (x != cb_error_node) { - cb_error_x ($1, _("'%s' is not a field"), cb_name ($1)); - } - $$ = cb_error_node; - } - } -; - -identifier_1: - qualified_word subref refmod - { - $$ = $1; - if (start_debug) { - cb_check_field_debug ($1); - } - } -| qualified_word subref %prec SHIFT_PREFER - { - $$ = $1; - if (start_debug) { - cb_check_field_debug ($1); - } - } -| qualified_word refmod - { - $$ = $1; - if (start_debug) { - cb_check_field_debug ($1); - } - } -| qualified_word %prec SHIFT_PREFER - { - $$ = $1; - if (start_debug) { - cb_check_field_debug ($1); - } - } -; - -identifier_list: - identifier - { - $$ = CB_LIST_INIT ($1); - } -| identifier_list identifier - { - $$ = cb_list_add ($1, $2); - } -; - -target_identifier: - target_identifier_1 - { - $$ = cb_build_identifier ($1, 0); - } -| line_linage_page_counter - { - $$ = cb_build_identifier ($1, 0); - } -; - -target_identifier_1: - qualified_word subref refmod - { - $$ = $1; - if (CB_REFERENCE_P ($1)) { - CB_REFERENCE ($1)->flag_target = 1; - } - if (start_debug) { - cb_check_field_debug ($1); - } - } -| qualified_word subref %prec SHIFT_PREFER - { - $$ = $1; - if (CB_REFERENCE_P ($1)) { - CB_REFERENCE ($1)->flag_target = 1; - } - if (start_debug) { - cb_check_field_debug ($1); - } - } -| qualified_word refmod - { - $$ = $1; - if (CB_REFERENCE_P ($1)) { - CB_REFERENCE ($1)->flag_target = 1; - } - if (start_debug) { - cb_check_field_debug ($1); - } - } -| qualified_word %prec SHIFT_PREFER - { - $$ = $1; - if (CB_REFERENCE_P ($1)) { - CB_REFERENCE ($1)->flag_target = 1; - } - if (start_debug) { - cb_check_field_debug ($1); - } - } -; - -display_identifier_or_alphabet_name: - identifier_1 - { - cb_tree x = NULL; - $$ = $1; - if (start_debug) { - cb_check_field_debug ($1); - } - if (CB_REFERENCE_P ($1)) { - x = cb_ref ($1); - } - if (x && CB_FIELD_P (x)) { - $$ = cb_build_identifier ($1, 0); - error_if_not_usage_display_or_nonnumeric_lit ($1); - } else if (x && CB_ALPHABET_NAME_P (x)) { - /* TODO: add check for subscript/ ref-mod here [not allowed] */ - $$ = cb_build_identifier ($1, 0); - } else { - if (x != cb_error_node) { - cb_error_x ($1, _("'%s' is not a field or alphabet"), cb_name ($1)); - } - $$ = cb_error_node; - } - } -; - -qualified_word: - WORD - { - $$ = $1; - } -| WORD in_of qualified_word - { - $$ = $1; - CB_REFERENCE ($1)->chain = $3; - } -; - -unqualified_word: - { - start_tree = NULL; /* actually not needed - initialized for clarity only */ - } - unqualified_word_check - { - if ($2 == cb_error_node) { - cb_error_x (start_tree, _("a subscripted data-item cannot be used here")); - } - $$ = start_tree; - } -; - -unqualified_word_check: - WORD - { - start_tree = $1; - $$ = $1; - } -| WORD in_of unqualified_word_check - { - start_tree = $1; - $$ = cb_error_node; - } -; - -subref: - TOK_OPEN_PAREN exp_list TOK_CLOSE_PAREN - { - $$ = $0; - CB_REFERENCE ($0)->subs = cb_list_reverse ($2); - } -; - -refmod: - TOK_OPEN_PAREN exp TOK_COLON TOK_CLOSE_PAREN - { - CB_REFERENCE ($0)->offset = $2; - } -| TOK_OPEN_PAREN exp TOK_COLON exp TOK_CLOSE_PAREN - { - CB_REFERENCE ($0)->offset = $2; - CB_REFERENCE ($0)->length = $4; - } -; - -/* Literal */ - -integer: - LITERAL %prec SHIFT_PREFER - { - if (cb_tree_category ($1) != CB_CATEGORY_NUMERIC - || !CB_LITERAL_P($1) - || CB_LITERAL ($1)->scale - || CB_LITERAL ($1)->sign < 0 - || (CB_LITERAL ($1)->sign && current_report && !cb_report_column_plus) - || (CB_LITERAL ($1)->sign && current_report == NULL)) { - cb_error (_("unsigned integer value expected")); - $$ = cb_build_numeric_literal (-1, "1", 0); - } else { - $$ = $1; - } - } -; - -symbolic_integer: - LITERAL - { - if (cb_tree_category ($1) != CB_CATEGORY_NUMERIC) { - cb_error (_("integer value expected")); - $$ = cb_int1; - } else if (CB_LITERAL_P ($1) - && (CB_LITERAL ($1)->sign || CB_LITERAL ($1)->scale)) { - cb_error (_("integer value expected")); - $$ = cb_int1; - } else { - int n = cb_get_int ($1); - if (n < 1 || n > 256) { - cb_error (_("invalid symbolic integer")); - $$ = cb_int1; - } else { - $$ = $1; - } - } - } -; - -unsigned_pos_integer: - LITERAL - { - if (cb_tree_category ($1) != CB_CATEGORY_NUMERIC - || !CB_LITERAL_P($1) - || CB_LITERAL ($1)->sign - || CB_LITERAL ($1)->scale) { - cb_error (_("unsigned positive integer value expected")); - $$ = cb_int1; - } else { - if (cb_get_int ($1) < 1) { - cb_error (_("unsigned positive integer value expected")); - $$ = cb_int1; - } else { - $$ = $1; - } - } - } -; - -integer_or_zero: - integer - { - $$ = $1; - } -| ZERO - { - $$ = cb_int0; - } -; - -class_value: - LITERAL - { - if (cb_tree_category ($1) == CB_CATEGORY_NUMERIC) { - if (CB_LITERAL ($1)->sign || CB_LITERAL ($1)->scale) { - cb_error (_("integer value expected")); - } else { - int n = cb_get_int ($1); - if (n < 1 || n > 256) { - cb_error (_("invalid CLASS value")); - } - } - } - $$ = $1; - } -| SPACE { $$ = cb_space; } -| ZERO { $$ = cb_zero; } -| QUOTE { $$ = cb_quote; } -| HIGH_VALUE { $$ = cb_high; } -| LOW_VALUE { $$ = cb_low; } -| TOK_NULL { $$ = cb_null; } -; - -literal: - basic_literal - { - $$ = $1; - } -| ALL basic_value - { - struct cb_literal *l; - - if (CB_LITERAL_P ($2)) { - /* We must not alter the original definition */ - l = cobc_parse_malloc (sizeof(struct cb_literal)); - *l = *(CB_LITERAL($2)); - l->all = 1; - $$ = CB_TREE (l); - } else { - $$ = $2; - } - } -; - -basic_literal: - basic_value - { - $$ = $1; - } -| basic_literal TOK_AMPER basic_value - { - $$ = cb_concat_literals ($1, $3); - } -; - -basic_value: - LITERAL { $$ = $1; } -| SPACE { $$ = cb_space; } -| ZERO { $$ = cb_zero; } -| QUOTE { $$ = cb_quote; } -| HIGH_VALUE { $$ = cb_high; } -| LOW_VALUE { $$ = cb_low; } -| TOK_NULL { $$ = cb_null; } -; - -zero_spaces_high_low_values: - SPACE { $$ = cb_space; } -| ZERO { $$ = cb_zero; } -| HIGH_VALUE { $$ = cb_high; } -| LOW_VALUE { $$ = cb_low; } -; - -/* Function */ - -function: - func_no_parm func_refmod - { - $$ = cb_build_intrinsic ($1, NULL, $2, 0); - } -| func_one_parm TOK_OPEN_PAREN expr_x TOK_CLOSE_PAREN func_refmod - { - $$ = cb_build_intrinsic ($1, CB_LIST_INIT ($3), $5, 0); - } -| func_multi_parm TOK_OPEN_PAREN exp_list TOK_CLOSE_PAREN func_refmod - { - $$ = cb_build_intrinsic ($1, $3, $5, 0); - } -| TRIM_FUNC TOK_OPEN_PAREN trim_args TOK_CLOSE_PAREN func_refmod - { - $$ = cb_build_intrinsic ($1, $3, $5, 0); - } -| LENGTH_FUNC TOK_OPEN_PAREN length_arg TOK_CLOSE_PAREN - { - $$ = cb_build_intrinsic ($1, $3, NULL, 0); - } -| LENGTH_FUNC TOK_OPEN_PAREN length_arg PHYSICAL TOK_CLOSE_PAREN - { - CB_PENDING (_("PHYSICAL argument for LENGTH functions")); - $$ = cb_build_intrinsic ($1, $3, NULL, 0); - } -| NUMVALC_FUNC TOK_OPEN_PAREN numvalc_args TOK_CLOSE_PAREN - { - $$ = cb_build_intrinsic ($1, $3, NULL, 0); - } -| LOCALE_DATE_FUNC TOK_OPEN_PAREN locale_dt_args TOK_CLOSE_PAREN func_refmod - { - $$ = cb_build_intrinsic ($1, $3, $5, 0); - } -| LOCALE_TIME_FUNC TOK_OPEN_PAREN locale_dt_args TOK_CLOSE_PAREN func_refmod - { - $$ = cb_build_intrinsic ($1, $3, $5, 0); - } -| LOCALE_TIME_FROM_FUNC TOK_OPEN_PAREN locale_dt_args TOK_CLOSE_PAREN func_refmod - { - $$ = cb_build_intrinsic ($1, $3, $5, 0); - } -| FORMATTED_DATETIME_FUNC TOK_OPEN_PAREN formatted_datetime_args TOK_CLOSE_PAREN func_refmod - { - $$ = cb_build_intrinsic ($1, $3, $5, 0); - } -| FORMATTED_TIME_FUNC TOK_OPEN_PAREN formatted_time_args TOK_CLOSE_PAREN func_refmod - { - $$ = cb_build_intrinsic ($1, $3, $5, 0); - } -| FUNCTION_NAME func_args - { - $$ = cb_build_intrinsic ($1, $2, NULL, 0); - } -| USER_FUNCTION_NAME func_args - { - $$ = cb_build_intrinsic ($1, $2, NULL, 1); - } -; - -func_no_parm: - CURRENT_DATE_FUNC -| WHEN_COMPILED_FUNC -; - -func_one_parm: - UPPER_CASE_FUNC -| LOWER_CASE_FUNC -| CONTENT_LENGTH_FUNC -| REVERSE_FUNC -; - -func_multi_parm: - CONCATENATE_FUNC -| CONTENT_OF_FUNC -| FORMATTED_DATE_FUNC -| SUBSTITUTE_FUNC -| SUBSTITUTE_CASE_FUNC -; - -func_refmod: - /* empty */ %prec SHIFT_PREFER - { - $$ = NULL; - } -| TOK_OPEN_PAREN exp TOK_COLON TOK_CLOSE_PAREN - { - $$ = CB_BUILD_PAIR ($2, NULL); - } -| TOK_OPEN_PAREN exp TOK_COLON exp TOK_CLOSE_PAREN - { - $$ = CB_BUILD_PAIR ($2, $4); - } -; - -func_args: - /* empty */ %prec SHIFT_PREFER - { - $$ = NULL; - } -| TOK_OPEN_PAREN exp_list TOK_CLOSE_PAREN - { - $$ = $2; - } -| TOK_OPEN_PAREN TOK_CLOSE_PAREN - { - $$ = NULL; - } -; - -trim_args: - expr_x - { - cb_tree x; - - x = CB_LIST_INIT ($1); - $$ = cb_list_add (x, cb_int0); - } -| expr_x _e_sep LEADING - { - cb_tree x; - - x = CB_LIST_INIT ($1); - $$ = cb_list_add (x, cb_int1); - } -| expr_x _e_sep TRAILING - { - cb_tree x; - - x = CB_LIST_INIT ($1); - $$ = cb_list_add (x, cb_int2); - } -; - -length_arg: - { - suppress_data_exceptions = 1; - } - expr_x - { - suppress_data_exceptions = 0; - if (CB_NUMERIC_LITERAL_P($2)) { - cb_error_x ($2, _("a non-numeric literal is expected here")); - $$ = CB_LIST_INIT (cb_error_node); - } else { - $$ = CB_LIST_INIT ($2); - } - } -; - -numvalc_args: - expr_x - { - cb_tree x; - - x = CB_LIST_INIT ($1); - $$ = cb_list_add (x, cb_null); - } -| expr_x _e_sep expr_x - { - cb_tree x; - - x = CB_LIST_INIT ($1); - $$ = cb_list_add (x, $3); - } -; - -locale_dt_args: - exp - { - cb_tree x; - - x = CB_LIST_INIT ($1); - $$ = cb_list_add (x, cb_null); - } -| exp _e_sep reference - { - cb_tree x; - - x = CB_LIST_INIT ($1); - $$ = cb_list_add (x, cb_ref ($3)); - } -; - -formatted_datetime_args: - exp_list - { - $$ = cb_list_add ($1, cb_int0); - } -| exp_list _e_sep SYSTEM_OFFSET - { - const int num_args = cb_list_length ($1); - - if (num_args == 4) { - cb_error_x ($1, _("cannot specify offset and SYSTEM-OFFSET at the same time")); - } - - $$ = cb_list_add ($1, cb_int1); - } -; - -formatted_time_args: - exp_list - { - $$ = cb_list_add ($1, cb_int0); - } -| exp_list _e_sep SYSTEM_OFFSET - { - const int num_args = cb_list_length ($1); - - if (num_args == 3) { - cb_error_x ($1, _("cannot specify offset and SYSTEM-OFFSET at the same time")); - } - - $$ = cb_list_add ($1, cb_int1); - } -; - -/* Common rules */ - -not_const_word: - { - non_const_word = 1; - } -; - -/* Common flags */ - -flag_all: - /* empty */ { $$ = cb_int0; } -| ALL { $$ = cb_int1; } -; - -flag_duplicates: - /* empty */ { $$ = NULL; } -| _with NO DUPLICATES { $$ = cb_int0; } -| _with DUPLICATES { $$ = cb_int1; } -; - -flag_initialized: - /* empty */ { $$ = NULL; } -| INITIALIZED { $$ = cb_int1; } -; - -flag_initialized_to: - /* empty */ - { - $$ = NULL; - } -| INITIALIZED to_init_val - { - $$ = $2; - } -; - -to_init_val: - /* empty */ - { - $$ = NULL; - } -| TO simple_all_value - { - $$ = $2; - } -; - -_flag_next: - %prec SHIFT_PREFER - /* empty */ { $$ = cb_int0; } -| NEXT { $$ = cb_int1; } -| PREVIOUS { $$ = cb_int2; } -; - -_flag_not: - /* empty */ { $$ = NULL; } -| NOT { $$ = cb_true; } -; - -flag_optional: - /* empty */ { $$ = cb_int (cb_flag_optional_file); } -| OPTIONAL { $$ = cb_int1; } -| NOT OPTIONAL { $$ = cb_int0; } -; - -flag_rounded: - /* empty */ - { - $$ = cb_int0; - } -| ROUNDED round_mode - { - if ($2) { - $$ = $2; - } else { - $$ = default_rounded_mode; - } - cobc_cs_check = 0; - } -; - -round_mode: - /* empty */ - { - $$ = NULL; - cobc_cs_check = 0; - } -| MODE _is round_choice - { - $$ = $3; - cobc_cs_check = 0; - } -; - -round_choice: - AWAY_FROM_ZERO - { - $$ = cb_int (COB_STORE_ROUND | COB_STORE_AWAY_FROM_ZERO); - } -| NEAREST_AWAY_FROM_ZERO - { - $$ = cb_int (COB_STORE_ROUND | COB_STORE_NEAR_AWAY_FROM_ZERO); - } -| NEAREST_EVEN - { - $$ = cb_int (COB_STORE_ROUND | COB_STORE_NEAR_EVEN); - } -| NEAREST_TOWARD_ZERO - { - $$ = cb_int (COB_STORE_ROUND | COB_STORE_NEAR_TOWARD_ZERO); - } -| PROHIBITED - { - $$ = cb_int (COB_STORE_ROUND | COB_STORE_PROHIBITED); - } -| TOWARD_GREATER - { - $$ = cb_int (COB_STORE_ROUND | COB_STORE_TOWARD_GREATER); - } -| TOWARD_LESSER - { - $$ = cb_int (COB_STORE_ROUND | COB_STORE_TOWARD_LESSER); - } -| TRUNCATION - { - $$ = cb_int (COB_STORE_ROUND | COB_STORE_TRUNCATION); - } -; - -flag_separate: - /* empty */ { $$ = NULL; } -| SEPARATE _character { $$ = cb_int1; } -; - -_from_idx_to_idx: -/* empty */ { $$ = NULL; } -| FROM _index pos_num_id_or_lit_or_zero TO pos_num_id_or_lit_or_zero - { - cb_tree x; - - x = CB_LIST_INIT ($2); - $$ = cb_list_add (x, $4); - } -; - -_dest_index: -/* empty */ { $$ = NULL; } -| DESTINATION _index pos_num_id_or_lit_or_zero - { - $$ = $3; - } -; - -/* Error recovery */ - -error_stmt_recover: - TOK_DOT - { - cobc_repeat_last_token = 1; - } -| verb - { - cobc_repeat_last_token = 1; - } -| ELSE - { - cobc_repeat_last_token = 0; - } -| scope_terminator - { - cobc_repeat_last_token = 0; - } -; - -verb: - ACCEPT -| ADD -| ALLOCATE -| ALTER -| CALL -| CANCEL -| CLOSE -| COMMIT -| COMPUTE -| CONTINUE -| DELETE -| DISPLAY -| DIVIDE -| ENTRY -| EVALUATE -| EXIT -| FREE -| GENERATE -| GO -| GOBACK -| IF -| INITIALIZE -| INITIATE -| INSPECT -| INQUIRE -| MERGE -| MODIFY -| MOVE -| MULTIPLY -| NEXT -| OPEN -| PERFORM -| READ -| RELEASE -| RETURN -| REWRITE -| ROLLBACK -| SEARCH -| SET -| SORT -| START -| STOP -| STRING -| SUBTRACT -| SUPPRESS -| TERMINATE -| TRANSFORM -| UNLOCK -| UNSTRING -| WRITE -| XML -; - -scope_terminator: - END_ACCEPT -| END_ADD -| END_CALL -| END_COMPUTE -| END_DELETE -| END_DISPLAY -| END_DIVIDE -| END_EVALUATE -| END_IF -| END_MODIFY -| END_MULTIPLY -| END_PERFORM -| END_READ -| END_RECEIVE -| END_RETURN -| END_REWRITE -| END_SEARCH -| END_START -| END_STRING -| END_SUBTRACT -| END_UNSTRING -| END_WRITE -| END_XML -; - -/* Mandatory/Optional keyword selection without actions */ - -/* Optional selection */ - -_advancing: | ADVANCING ; -_after: | AFTER ; -_are: | ARE ; -_area: | AREA ; -_areas: | AREA | AREAS ; -_as: | AS ; -_at: | AT ; -_before: | BEFORE ; -_binary: | BINARY ; -_box: | BOX ; -_by: | BY ; -_character: | CHARACTER ; -_characters: | CHARACTERS ; -_collating: | COLLATING ; -_contains: | CONTAINS ; -_controls: | CONTROLS ; -_control: | CONTROL ; -_data: | DATA ; -_end_of: | _to END _of ; -_every: | EVERY ; -_file: | TOK_FILE ; -_for: | FOR ; -_from: | FROM ; -_in: | IN ; -_in_equal: | IN | TOK_EQUAL; -_in_order: | ORDER | IN ORDER ; -_index: | INDEX ; -_indicate: | INDICATE ; -_initial: | TOK_INITIAL ; -_into: | INTO ; -_is: | IS ; -_is_equal: | IS | TOK_EQUAL; -_is_are: | IS | ARE ; -_is_are_equal: | IS | ARE | TOK_EQUAL; -_is_in: | IS | IN ; -_key: | KEY ; -_line: | LINE ; -_line_or_lines: | LINE | LINES ; -_limits: | LIMIT _is_are | LIMITS _is_are ; -_lines: | LINES ; -_lock: | LOCK ; -_message: | MESSAGE ; -_mode: | MODE ; -_new: | NEW ; -_number: | NUMBER ; -_number_or_numbers: _number | NUMBERS ; -_of: | OF ; -_on: | ON ; -_on_for: | ON | FOR ; -_onoff_status: | STATUS IS | STATUS | IS ; -_other: | OTHER ; -_others: | OTHERS ; -_procedure: | PROCEDURE ; -_program: | PROGRAM ; -_protected: | PROTECTED ; -_record: | RECORD ; -_records: | RECORD | RECORDS; -_right: | RIGHT ; -_sign: | SIGN ; -_signed: | SIGNED ; -_sign_is: | SIGN | SIGN IS ; -_size: | SIZE ; -_standard: | STANDARD ; -_status: | STATUS ; -_symbolic: | SYMBOLIC ; -_tape: | TAPE ; -_terminal: | TERMINAL ; -_then: | THEN ; -_times: | TIMES ; -_to: | TO ; -_up: | UP ; -_when: | WHEN ; -_when_set_to: | WHEN SET TO ; -_with: | WITH ; -_with_for: | WITH | FOR ; - -/* Mandatory selection */ - -column_or_col: COLUMN | COL ; -columns_or_cols: COLUMNS | COLS ; -column_or_cols: column_or_col | columns_or_cols ; -column_or_col_or_position_or_pos: COLUMN | COL | POSITION | POS ; -comp_equal: TOK_EQUAL | EQUAL ; -exception_or_error: EXCEPTION | ERROR ; -file_limit_or_limits: FILE_LIMIT | FILE_LIMITS ; -in_of: IN | OF ; -label_option: STANDARD | OMITTED ; -line_or_lines: LINE | LINES ; -lock_records: RECORD | RECORDS ; -object_char_or_word_or_modules: CHARACTERS | WORDS | MODULES; -records: RECORD _is_are | RECORDS _is_are ; -reel_or_unit: REEL | UNIT ; -size_or_length: SIZE | LENGTH ; -length_of: LENGTH | LENGTH_OF; -track_or_tracks: TRACK | TRACKS ; -using_or_varying: USING | VARYING ; - -/* Mandatory R/W keywords */ -detail_keyword: DETAIL | DE ; -ch_keyword: CONTROL HEADING | CH ; -cf_keyword: CONTROL FOOTING | CF ; -ph_keyword: PAGE HEADING | PH ; -pf_keyword: PAGE FOOTING | PF ; -rh_keyword: REPORT HEADING | RH ; -rf_keyword: REPORT FOOTING | RF ; -control_keyword: CONTROL _is_are | CONTROLS _is_are ; - -%% diff -Nru gnucobol-4.0~early~20200606/cobc/pplex.c gnucobol-5/cobc/pplex.c --- gnucobol-4.0~early~20200606/cobc/pplex.c 2020-06-06 20:52:39.000000000 +0000 +++ gnucobol-5/cobc/pplex.c 1970-01-01 00:00:00.000000000 +0000 @@ -1,6668 +0,0 @@ -#line 2 "pplex.c" - -#line 4 "pplex.c" - -#define YY_INT_ALIGNED short int - -/* A lexical scanner generated by flex */ - -#define yy_create_buffer pp_create_buffer -#define yy_delete_buffer pp_delete_buffer -#define yy_scan_buffer pp_scan_buffer -#define yy_scan_string pp_scan_string -#define yy_scan_bytes pp_scan_bytes -#define yy_init_buffer pp_init_buffer -#define yy_flush_buffer pp_flush_buffer -#define yy_load_buffer_state pp_load_buffer_state -#define yy_switch_to_buffer pp_switch_to_buffer -#define yypush_buffer_state pppush_buffer_state -#define yypop_buffer_state pppop_buffer_state -#define yyensure_buffer_stack ppensure_buffer_stack -#define yy_flex_debug pp_flex_debug -#define yyin ppin -#define yyleng ppleng -#define yylex pplex -#define yylineno pplineno -#define yyout ppout -#define yyrestart pprestart -#define yytext pptext -#define yywrap ppwrap -#define yyalloc ppalloc -#define yyrealloc pprealloc -#define yyfree ppfree - -#define FLEX_SCANNER -#define YY_FLEX_MAJOR_VERSION 2 -#define YY_FLEX_MINOR_VERSION 6 -#define YY_FLEX_SUBMINOR_VERSION 4 -#if YY_FLEX_SUBMINOR_VERSION > 0 -#define FLEX_BETA -#endif - -#ifdef yy_create_buffer -#define pp_create_buffer_ALREADY_DEFINED -#else -#define yy_create_buffer pp_create_buffer -#endif - -#ifdef yy_delete_buffer -#define pp_delete_buffer_ALREADY_DEFINED -#else -#define yy_delete_buffer pp_delete_buffer -#endif - -#ifdef yy_scan_buffer -#define pp_scan_buffer_ALREADY_DEFINED -#else -#define yy_scan_buffer pp_scan_buffer -#endif - -#ifdef yy_scan_string -#define pp_scan_string_ALREADY_DEFINED -#else -#define yy_scan_string pp_scan_string -#endif - -#ifdef yy_scan_bytes -#define pp_scan_bytes_ALREADY_DEFINED -#else -#define yy_scan_bytes pp_scan_bytes -#endif - -#ifdef yy_init_buffer -#define pp_init_buffer_ALREADY_DEFINED -#else -#define yy_init_buffer pp_init_buffer -#endif - -#ifdef yy_flush_buffer -#define pp_flush_buffer_ALREADY_DEFINED -#else -#define yy_flush_buffer pp_flush_buffer -#endif - -#ifdef yy_load_buffer_state -#define pp_load_buffer_state_ALREADY_DEFINED -#else -#define yy_load_buffer_state pp_load_buffer_state -#endif - -#ifdef yy_switch_to_buffer -#define pp_switch_to_buffer_ALREADY_DEFINED -#else -#define yy_switch_to_buffer pp_switch_to_buffer -#endif - -#ifdef yypush_buffer_state -#define pppush_buffer_state_ALREADY_DEFINED -#else -#define yypush_buffer_state pppush_buffer_state -#endif - -#ifdef yypop_buffer_state -#define pppop_buffer_state_ALREADY_DEFINED -#else -#define yypop_buffer_state pppop_buffer_state -#endif - -#ifdef yyensure_buffer_stack -#define ppensure_buffer_stack_ALREADY_DEFINED -#else -#define yyensure_buffer_stack ppensure_buffer_stack -#endif - -#ifdef yylex -#define pplex_ALREADY_DEFINED -#else -#define yylex pplex -#endif - -#ifdef yyrestart -#define pprestart_ALREADY_DEFINED -#else -#define yyrestart pprestart -#endif - -#ifdef yylex_init -#define pplex_init_ALREADY_DEFINED -#else -#define yylex_init pplex_init -#endif - -#ifdef yylex_init_extra -#define pplex_init_extra_ALREADY_DEFINED -#else -#define yylex_init_extra pplex_init_extra -#endif - -#ifdef yylex_destroy -#define pplex_destroy_ALREADY_DEFINED -#else -#define yylex_destroy pplex_destroy -#endif - -#ifdef yyget_debug -#define ppget_debug_ALREADY_DEFINED -#else -#define yyget_debug ppget_debug -#endif - -#ifdef yyset_debug -#define ppset_debug_ALREADY_DEFINED -#else -#define yyset_debug ppset_debug -#endif - -#ifdef yyget_extra -#define ppget_extra_ALREADY_DEFINED -#else -#define yyget_extra ppget_extra -#endif - -#ifdef yyset_extra -#define ppset_extra_ALREADY_DEFINED -#else -#define yyset_extra ppset_extra -#endif - -#ifdef yyget_in -#define ppget_in_ALREADY_DEFINED -#else -#define yyget_in ppget_in -#endif - -#ifdef yyset_in -#define ppset_in_ALREADY_DEFINED -#else -#define yyset_in ppset_in -#endif - -#ifdef yyget_out -#define ppget_out_ALREADY_DEFINED -#else -#define yyget_out ppget_out -#endif - -#ifdef yyset_out -#define ppset_out_ALREADY_DEFINED -#else -#define yyset_out ppset_out -#endif - -#ifdef yyget_leng -#define ppget_leng_ALREADY_DEFINED -#else -#define yyget_leng ppget_leng -#endif - -#ifdef yyget_text -#define ppget_text_ALREADY_DEFINED -#else -#define yyget_text ppget_text -#endif - -#ifdef yyget_lineno -#define ppget_lineno_ALREADY_DEFINED -#else -#define yyget_lineno ppget_lineno -#endif - -#ifdef yyset_lineno -#define ppset_lineno_ALREADY_DEFINED -#else -#define yyset_lineno ppset_lineno -#endif - -#ifdef yywrap -#define ppwrap_ALREADY_DEFINED -#else -#define yywrap ppwrap -#endif - -#ifdef yyalloc -#define ppalloc_ALREADY_DEFINED -#else -#define yyalloc ppalloc -#endif - -#ifdef yyrealloc -#define pprealloc_ALREADY_DEFINED -#else -#define yyrealloc pprealloc -#endif - -#ifdef yyfree -#define ppfree_ALREADY_DEFINED -#else -#define yyfree ppfree -#endif - -#ifdef yytext -#define pptext_ALREADY_DEFINED -#else -#define yytext pptext -#endif - -#ifdef yyleng -#define ppleng_ALREADY_DEFINED -#else -#define yyleng ppleng -#endif - -#ifdef yyin -#define ppin_ALREADY_DEFINED -#else -#define yyin ppin -#endif - -#ifdef yyout -#define ppout_ALREADY_DEFINED -#else -#define yyout ppout -#endif - -#ifdef yy_flex_debug -#define pp_flex_debug_ALREADY_DEFINED -#else -#define yy_flex_debug pp_flex_debug -#endif - -#ifdef yylineno -#define pplineno_ALREADY_DEFINED -#else -#define yylineno pplineno -#endif - -/* First, we deal with platform-specific or compiler-specific issues. */ - -/* begin standard C headers. */ -#include -#include -#include -#include - -/* end standard C headers. */ - -/* flex integer type definitions */ - -#ifndef FLEXINT_H -#define FLEXINT_H - -/* C99 systems have . Non-C99 systems may or may not. */ - -#if defined (__STDC_VERSION__) && __STDC_VERSION__ >= 199901L - -/* C99 says to define __STDC_LIMIT_MACROS before including stdint.h, - * if you want the limit (max/min) macros for int types. - */ -#ifndef __STDC_LIMIT_MACROS -#define __STDC_LIMIT_MACROS 1 -#endif - -#include -typedef int8_t flex_int8_t; -typedef uint8_t flex_uint8_t; -typedef int16_t flex_int16_t; -typedef uint16_t flex_uint16_t; -typedef int32_t flex_int32_t; -typedef uint32_t flex_uint32_t; -#else -typedef signed char flex_int8_t; -typedef short int flex_int16_t; -typedef int flex_int32_t; -typedef unsigned char flex_uint8_t; -typedef unsigned short int flex_uint16_t; -typedef unsigned int flex_uint32_t; - -/* Limits of integral types. */ -#ifndef INT8_MIN -#define INT8_MIN (-128) -#endif -#ifndef INT16_MIN -#define INT16_MIN (-32767-1) -#endif -#ifndef INT32_MIN -#define INT32_MIN (-2147483647-1) -#endif -#ifndef INT8_MAX -#define INT8_MAX (127) -#endif -#ifndef INT16_MAX -#define INT16_MAX (32767) -#endif -#ifndef INT32_MAX -#define INT32_MAX (2147483647) -#endif -#ifndef UINT8_MAX -#define UINT8_MAX (255U) -#endif -#ifndef UINT16_MAX -#define UINT16_MAX (65535U) -#endif -#ifndef UINT32_MAX -#define UINT32_MAX (4294967295U) -#endif - -#ifndef SIZE_MAX -#define SIZE_MAX (~(size_t)0) -#endif - -#endif /* ! C99 */ - -#endif /* ! FLEXINT_H */ - -/* begin standard C++ headers. */ - -/* TODO: this is always defined, so inline it */ -#define yyconst const - -#if defined(__GNUC__) && __GNUC__ >= 3 -#define yynoreturn __attribute__((__noreturn__)) -#else -#define yynoreturn -#endif - -/* Returned upon end-of-file. */ -#define YY_NULL 0 - -/* Promotes a possibly negative, possibly signed char to an - * integer in range [0..255] for use as an array index. - */ -#define YY_SC_TO_UI(c) ((YY_CHAR) (c)) - -/* Enter a start condition. This macro really ought to take a parameter, - * but we do it the disgusting crufty way forced on us by the ()-less - * definition of BEGIN. - */ -#define BEGIN (yy_start) = 1 + 2 * -/* Translate the current start state into a value that can be later handed - * to BEGIN to return to the state. The YYSTATE alias is for lex - * compatibility. - */ -#define YY_START (((yy_start) - 1) / 2) -#define YYSTATE YY_START -/* Action number for EOF rule of a given start state. */ -#define YY_STATE_EOF(state) (YY_END_OF_BUFFER + state + 1) -/* Special action meaning "start processing a new file". */ -#define YY_NEW_FILE yyrestart( yyin ) -#define YY_END_OF_BUFFER_CHAR 0 - -/* Size of default input buffer. */ -#ifndef YY_BUF_SIZE -#ifdef __ia64__ -/* On IA-64, the buffer size is 16k, not 8k. - * Moreover, YY_BUF_SIZE is 2*YY_READ_BUF_SIZE in the general case. - * Ditto for the __ia64__ case accordingly. - */ -#define YY_BUF_SIZE 32768 -#else -#define YY_BUF_SIZE 16384 -#endif /* __ia64__ */ -#endif - -/* The state buf must be large enough to hold one state per character in the main buffer. - */ -#define YY_STATE_BUF_SIZE ((YY_BUF_SIZE + 2) * sizeof(yy_state_type)) - -#ifndef YY_TYPEDEF_YY_BUFFER_STATE -#define YY_TYPEDEF_YY_BUFFER_STATE -typedef struct yy_buffer_state *YY_BUFFER_STATE; -#endif - -#ifndef YY_TYPEDEF_YY_SIZE_T -#define YY_TYPEDEF_YY_SIZE_T -typedef size_t yy_size_t; -#endif - -extern int yyleng; - -extern FILE *yyin, *yyout; - -#define EOB_ACT_CONTINUE_SCAN 0 -#define EOB_ACT_END_OF_FILE 1 -#define EOB_ACT_LAST_MATCH 2 - - #define YY_LESS_LINENO(n) - #define YY_LINENO_REWIND_TO(ptr) - -/* Return all but the first "n" matched characters back to the input stream. */ -#define yyless(n) \ - do \ - { \ - /* Undo effects of setting up yytext. */ \ - int yyless_macro_arg = (n); \ - YY_LESS_LINENO(yyless_macro_arg);\ - *yy_cp = (yy_hold_char); \ - YY_RESTORE_YY_MORE_OFFSET \ - (yy_c_buf_p) = yy_cp = yy_bp + yyless_macro_arg - YY_MORE_ADJ; \ - YY_DO_BEFORE_ACTION; /* set up yytext again */ \ - } \ - while ( 0 ) -#define unput(c) yyunput( c, (yytext_ptr) ) - -#ifndef YY_STRUCT_YY_BUFFER_STATE -#define YY_STRUCT_YY_BUFFER_STATE -struct yy_buffer_state - { - FILE *yy_input_file; - - char *yy_ch_buf; /* input buffer */ - char *yy_buf_pos; /* current position in input buffer */ - - /* Size of input buffer in bytes, not including room for EOB - * characters. - */ - int yy_buf_size; - - /* Number of characters read into yy_ch_buf, not including EOB - * characters. - */ - int yy_n_chars; - - /* Whether we "own" the buffer - i.e., we know we created it, - * and can realloc() it to grow it, and should free() it to - * delete it. - */ - int yy_is_our_buffer; - - /* Whether this is an "interactive" input source; if so, and - * if we're using stdio for input, then we want to use getc() - * instead of fread(), to make sure we stop fetching input after - * each newline. - */ - int yy_is_interactive; - - /* Whether we're considered to be at the beginning of a line. - * If so, '^' rules will be active on the next match, otherwise - * not. - */ - int yy_at_bol; - - int yy_bs_lineno; /**< The line count. */ - int yy_bs_column; /**< The column count. */ - - /* Whether to try to fill the input buffer when we reach the - * end of it. - */ - int yy_fill_buffer; - - int yy_buffer_status; - -#define YY_BUFFER_NEW 0 -#define YY_BUFFER_NORMAL 1 - /* When an EOF's been seen but there's still some text to process - * then we mark the buffer as YY_EOF_PENDING, to indicate that we - * shouldn't try reading from the input source any more. We might - * still have a bunch of tokens to match, though, because of - * possible backing-up. - * - * When we actually see the EOF, we change the status to "new" - * (via yyrestart()), so that the user can continue scanning by - * just pointing yyin at a new input file. - */ -#define YY_BUFFER_EOF_PENDING 2 - - }; -#endif /* !YY_STRUCT_YY_BUFFER_STATE */ - -/* Stack of input buffers. */ -static size_t yy_buffer_stack_top = 0; /**< index of top of stack. */ -static size_t yy_buffer_stack_max = 0; /**< capacity of stack. */ -static YY_BUFFER_STATE * yy_buffer_stack = NULL; /**< Stack as an array. */ - -/* We provide macros for accessing buffer states in case in the - * future we want to put the buffer states in a more general - * "scanner state". - * - * Returns the top of the stack, or NULL. - */ -#define YY_CURRENT_BUFFER ( (yy_buffer_stack) \ - ? (yy_buffer_stack)[(yy_buffer_stack_top)] \ - : NULL) -/* Same as previous macro, but useful when we know that the buffer stack is not - * NULL or when we need an lvalue. For internal use only. - */ -#define YY_CURRENT_BUFFER_LVALUE (yy_buffer_stack)[(yy_buffer_stack_top)] - -/* yy_hold_char holds the character lost when yytext is formed. */ -static char yy_hold_char; -static int yy_n_chars; /* number of characters read into yy_ch_buf */ -int yyleng; - -/* Points to current character in buffer. */ -static char *yy_c_buf_p = NULL; -static int yy_init = 0; /* whether we need to initialize */ -static int yy_start = 0; /* start state number */ - -/* Flag which is used to allow yywrap()'s to do buffer switches - * instead of setting up a fresh yyin. A bit of a hack ... - */ -static int yy_did_buffer_switch_on_eof; - -void yyrestart ( FILE *input_file ); -void yy_switch_to_buffer ( YY_BUFFER_STATE new_buffer ); -YY_BUFFER_STATE yy_create_buffer ( FILE *file, int size ); -void yy_delete_buffer ( YY_BUFFER_STATE b ); -void yy_flush_buffer ( YY_BUFFER_STATE b ); -void yypush_buffer_state ( YY_BUFFER_STATE new_buffer ); -void yypop_buffer_state ( void ); - -static void yyensure_buffer_stack ( void ); -static void yy_load_buffer_state ( void ); -static void yy_init_buffer ( YY_BUFFER_STATE b, FILE *file ); -#define YY_FLUSH_BUFFER yy_flush_buffer( YY_CURRENT_BUFFER ) - -YY_BUFFER_STATE yy_scan_buffer ( char *base, yy_size_t size ); -YY_BUFFER_STATE yy_scan_string ( const char *yy_str ); -YY_BUFFER_STATE yy_scan_bytes ( const char *bytes, int len ); - -void *yyalloc ( yy_size_t ); -void *yyrealloc ( void *, yy_size_t ); -void yyfree ( void * ); - -#define yy_new_buffer yy_create_buffer -#define yy_set_interactive(is_interactive) \ - { \ - if ( ! YY_CURRENT_BUFFER ){ \ - yyensure_buffer_stack (); \ - YY_CURRENT_BUFFER_LVALUE = \ - yy_create_buffer( yyin, YY_BUF_SIZE ); \ - } \ - YY_CURRENT_BUFFER_LVALUE->yy_is_interactive = is_interactive; \ - } -#define yy_set_bol(at_bol) \ - { \ - if ( ! YY_CURRENT_BUFFER ){\ - yyensure_buffer_stack (); \ - YY_CURRENT_BUFFER_LVALUE = \ - yy_create_buffer( yyin, YY_BUF_SIZE ); \ - } \ - YY_CURRENT_BUFFER_LVALUE->yy_at_bol = at_bol; \ - } -#define YY_AT_BOL() (YY_CURRENT_BUFFER_LVALUE->yy_at_bol) - -/* Begin user sect3 */ -typedef flex_uint8_t YY_CHAR; - -FILE *yyin = NULL, *yyout = NULL; - -typedef int yy_state_type; - -extern int yylineno; -int yylineno = 1; - -extern char *yytext; -#ifdef yytext_ptr -#undef yytext_ptr -#endif -#define yytext_ptr yytext - -static yy_state_type yy_get_previous_state ( void ); -static yy_state_type yy_try_NUL_trans ( yy_state_type current_state ); -static int yy_get_next_buffer ( void ); -static void yynoreturn yy_fatal_error ( const char* msg ); - -/* Done after the current pattern has been matched and before the - * corresponding action - sets up yytext. - */ -#define YY_DO_BEFORE_ACTION \ - (yytext_ptr) = yy_bp; \ - yyleng = (int) (yy_cp - yy_bp); \ - (yy_hold_char) = *yy_cp; \ - *yy_cp = '\0'; \ - (yy_c_buf_p) = yy_cp; -#define YY_NUM_RULES 176 -#define YY_END_OF_BUFFER 177 -/* This struct is not used in this scanner, - but its presence is necessary. */ -struct yy_trans_info - { - flex_int32_t yy_verify; - flex_int32_t yy_nxt; - }; -static const flex_int16_t yy_accept[1463] = - { 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 177, 56, 48, 49, 56, 56, 51, 52, 56, 56, - 56, 53, 56, 53, 56, 53, 53, 53, 53, 53, - 53, 53, 53, 56, 49, 56, 31, 56, 51, 52, - 56, 56, 56, 53, 56, 53, 56, 56, 53, 53, - 53, 53, 53, 53, 53, 53, 53, 53, 176, 57, - 58, 176, 176, 176, 176, 58, 126, 59, 124, 126, - 126, 126, 126, 168, 147, 148, 168, 168, 152, 153, - - 168, 168, 168, 165, 150, 165, 168, 168, 165, 165, - 165, 165, 165, 165, 165, 165, 165, 165, 175, 169, - 170, 175, 175, 175, 175, 175, 172, 175, 172, 175, - 175, 172, 126, 126, 126, 176, 176, 176, 58, 88, - 59, 86, 88, 88, 88, 88, 88, 126, 176, 176, - 176, 176, 113, 59, 110, 114, 113, 113, 113, 113, - 113, 113, 113, 113, 113, 113, 176, 176, 176, 176, - 123, 59, 120, 123, 123, 123, 123, 123, 176, 176, - 176, 58, 145, 59, 143, 141, 142, 138, 145, 145, - 145, 145, 145, 145, 145, 145, 145, 145, 176, 176, - - 59, 176, 176, 176, 176, 60, 63, 176, 176, 62, - 62, 49, 0, 55, 0, 1, 0, 54, 48, 50, - 53, 53, 49, 53, 53, 53, 53, 53, 53, 53, - 53, 53, 0, 49, 31, 0, 0, 0, 0, 0, - 0, 55, 28, 28, 28, 28, 28, 0, 1, 0, - 0, 54, 50, 53, 53, 49, 19, 53, 53, 53, - 53, 53, 53, 53, 53, 53, 53, 53, 53, 58, - 0, 125, 0, 0, 124, 58, 126, 124, 126, 126, - 126, 148, 0, 167, 0, 0, 166, 147, 165, 0, - 165, 151, 0, 165, 154, 155, 165, 165, 156, 165, - - 165, 165, 165, 170, 0, 174, 0, 0, 173, 169, - 172, 172, 171, 126, 126, 126, 67, 126, 0, 87, - 0, 0, 86, 58, 88, 86, 82, 88, 88, 88, - 88, 126, 64, 0, 111, 0, 0, 112, 0, 110, - 113, 110, 110, 113, 113, 113, 113, 113, 113, 113, - 113, 113, 113, 113, 0, 121, 0, 0, 122, 0, - 120, 123, 120, 120, 123, 123, 123, 115, 123, 0, - 144, 0, 0, 143, 58, 145, 143, 139, 140, 137, - 145, 145, 145, 127, 145, 145, 131, 145, 145, 130, - 0, 146, 0, 0, 0, 0, 0, 63, 0, 61, - - 0, 1, 53, 53, 53, 0, 53, 53, 53, 53, - 53, 53, 0, 49, 31, 0, 0, 0, 0, 0, - 28, 28, 28, 28, 28, 0, 19, 0, 0, 0, - 0, 55, 28, 28, 28, 23, 28, 0, 1, 0, - 0, 0, 54, 50, 53, 53, 49, 17, 0, 18, - 18, 4, 18, 18, 18, 18, 18, 18, 53, 53, - 53, 53, 0, 53, 53, 53, 53, 53, 53, 53, - 53, 126, 126, 126, 126, 149, 149, 165, 165, 165, - 157, 165, 165, 165, 165, 126, 126, 126, 126, 88, - 83, 88, 88, 65, 113, 113, 113, 113, 113, 113, - - 113, 113, 113, 113, 113, 113, 109, 123, 123, 116, - 123, 145, 145, 145, 145, 128, 136, 145, 0, 79, - 0, 0, 0, 0, 33, 53, 53, 0, 53, 53, - 53, 53, 53, 53, 53, 0, 49, 31, 0, 0, - 0, 0, 0, 28, 28, 28, 28, 28, 0, 19, - 0, 0, 0, 28, 28, 28, 23, 28, 0, 0, - 0, 18, 18, 4, 18, 18, 18, 18, 18, 18, - 0, 0, 0, 0, 55, 28, 28, 28, 27, 22, - 0, 1, 37, 0, 0, 54, 50, 53, 53, 49, - 0, 18, 18, 18, 18, 18, 18, 10, 18, 18, - - 18, 18, 18, 18, 33, 53, 53, 53, 0, 0, - 53, 53, 53, 53, 53, 53, 53, 53, 53, 126, - 126, 126, 126, 163, 164, 165, 165, 165, 165, 165, - 126, 126, 69, 126, 88, 88, 88, 113, 113, 113, - 113, 113, 113, 113, 113, 113, 113, 113, 113, 113, - 113, 123, 123, 117, 145, 145, 145, 133, 134, 77, - 0, 0, 0, 0, 53, 53, 0, 53, 53, 53, - 53, 53, 53, 0, 0, 49, 31, 0, 0, 0, - 0, 0, 28, 28, 28, 28, 28, 0, 19, 0, - 0, 0, 28, 28, 28, 23, 28, 0, 0, 0, - - 18, 18, 4, 18, 18, 18, 18, 18, 18, 0, - 0, 0, 28, 28, 28, 27, 22, 37, 0, 0, - 18, 18, 18, 18, 18, 18, 10, 18, 18, 18, - 18, 18, 18, 0, 0, 0, 0, 55, 28, 24, - 26, 0, 1, 0, 0, 54, 50, 53, 53, 49, - 18, 18, 18, 18, 18, 18, 18, 18, 18, 8, - 18, 18, 53, 53, 42, 0, 0, 0, 53, 53, - 53, 53, 53, 53, 43, 44, 45, 53, 0, 71, - 126, 126, 126, 165, 165, 165, 165, 165, 68, 126, - 126, 88, 88, 88, 113, 113, 113, 113, 113, 113, - - 113, 95, 113, 113, 113, 113, 113, 113, 113, 113, - 113, 113, 123, 123, 145, 129, 145, 0, 80, 0, - 0, 53, 53, 0, 53, 53, 53, 53, 53, 53, - 0, 0, 49, 31, 0, 0, 0, 0, 0, 28, - 28, 28, 28, 28, 0, 19, 0, 0, 0, 28, - 28, 28, 23, 28, 0, 0, 0, 18, 18, 4, - 18, 18, 18, 18, 18, 18, 0, 0, 0, 28, - 28, 28, 27, 22, 37, 0, 0, 18, 18, 18, - 18, 18, 18, 10, 18, 18, 18, 18, 18, 18, - 0, 0, 0, 28, 24, 26, 0, 18, 18, 18, - - 18, 18, 18, 18, 18, 18, 8, 18, 18, 42, - 43, 44, 45, 0, 0, 55, 28, 28, 0, 1, - 0, 0, 54, 50, 53, 53, 49, 18, 18, 18, - 11, 13, 18, 18, 18, 5, 18, 9, 53, 53, - 0, 42, 0, 0, 0, 0, 53, 53, 53, 53, - 53, 53, 0, 43, 0, 44, 0, 45, 46, 46, - 0, 0, 72, 74, 126, 165, 165, 165, 165, 165, - 66, 126, 88, 88, 88, 113, 113, 89, 91, 93, - 94, 96, 113, 113, 113, 113, 113, 113, 113, 113, - 106, 113, 123, 123, 145, 145, 78, 0, 75, 53, - - 53, 0, 53, 34, 32, 53, 35, 41, 0, 0, - 29, 49, 29, 0, 0, 0, 0, 0, 28, 28, - 28, 28, 28, 0, 19, 0, 0, 0, 28, 28, - 28, 23, 28, 0, 0, 0, 18, 18, 4, 18, - 18, 18, 18, 18, 18, 0, 0, 0, 28, 28, - 28, 27, 22, 37, 0, 0, 18, 18, 18, 18, - 18, 18, 10, 18, 18, 18, 18, 18, 18, 0, - 0, 0, 28, 24, 26, 0, 18, 18, 18, 18, - 18, 18, 18, 18, 18, 8, 18, 18, 42, 43, - 44, 45, 0, 28, 28, 0, 18, 18, 18, 11, - - 13, 18, 18, 18, 5, 18, 9, 0, 42, 0, - 43, 0, 44, 0, 45, 46, 0, 55, 29, 28, - 28, 0, 29, 1, 1, 0, 0, 54, 50, 53, - 53, 49, 18, 18, 18, 18, 18, 18, 18, 18, - 53, 53, 0, 0, 0, 0, 0, 53, 34, 32, - 53, 35, 41, 0, 0, 0, 73, 161, 165, 165, - 165, 165, 126, 88, 88, 88, 90, 92, 113, 113, - 113, 113, 100, 113, 113, 113, 113, 113, 113, 123, - 123, 135, 132, 0, 53, 40, 0, 53, 53, 0, - 0, 49, 31, 0, 0, 0, 0, 0, 28, 28, - - 28, 28, 28, 0, 19, 0, 0, 0, 28, 28, - 28, 23, 28, 0, 0, 0, 18, 18, 4, 18, - 18, 18, 18, 18, 18, 0, 0, 0, 28, 28, - 28, 27, 22, 37, 0, 0, 18, 18, 18, 18, - 18, 18, 10, 18, 18, 18, 18, 18, 18, 0, - 0, 0, 28, 24, 26, 0, 18, 18, 18, 18, - 18, 18, 18, 18, 18, 8, 18, 18, 42, 43, - 44, 45, 0, 28, 28, 0, 18, 18, 18, 11, - 13, 18, 18, 18, 5, 18, 9, 0, 42, 0, - 43, 0, 44, 0, 45, 28, 28, 0, 18, 18, - - 18, 18, 18, 18, 18, 18, 0, 28, 25, 0, - 1, 36, 18, 2, 18, 18, 14, 18, 18, 7, - 159, 165, 158, 162, 70, 81, 84, 88, 97, 113, - 113, 101, 113, 113, 113, 105, 113, 113, 119, 118, - 76, 53, 0, 53, 53, 0, 0, 0, 21, 0, - 1, 18, 18, 12, 18, 6, 160, 85, 113, 113, - 113, 113, 113, 113, 113, 0, 0, 53, 39, 0, - 0, 0, 0, 0, 1, 18, 3, 18, 113, 113, - 113, 113, 113, 113, 113, 0, 38, 53, 0, 0, - 0, 0, 0, 1, 18, 18, 113, 113, 113, 113, - - 113, 113, 113, 0, 53, 0, 0, 0, 0, 0, - 1, 18, 18, 113, 98, 113, 113, 113, 113, 107, - 0, 53, 0, 0, 0, 0, 0, 1, 18, 15, - 113, 113, 113, 113, 108, 47, 53, 0, 0, 0, - 0, 0, 1, 18, 99, 113, 113, 102, 30, 30, - 20, 30, 1, 18, 113, 113, 18, 113, 103, 16, - 104, 0 - } ; - -static const YY_CHAR yy_ec[256] = - { 0, - 1, 1, 1, 1, 1, 1, 1, 1, 1, 2, - 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, - 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, - 1, 3, 1, 4, 5, 6, 1, 1, 7, 8, - 9, 10, 11, 12, 13, 14, 1, 15, 16, 17, - 18, 19, 19, 19, 19, 19, 19, 20, 21, 22, - 23, 24, 20, 25, 26, 27, 28, 29, 30, 31, - 32, 33, 34, 35, 36, 37, 38, 39, 40, 41, - 42, 43, 44, 45, 46, 47, 48, 49, 50, 51, - 20, 20, 20, 20, 52, 20, 53, 54, 55, 56, - - 57, 58, 59, 60, 61, 62, 63, 64, 65, 66, - 67, 68, 69, 70, 71, 72, 73, 74, 75, 76, - 77, 51, 20, 20, 20, 20, 20, 78, 78, 78, - 78, 78, 78, 78, 78, 78, 78, 78, 78, 78, - 78, 78, 78, 78, 78, 78, 78, 78, 78, 78, - 78, 78, 78, 78, 78, 78, 78, 78, 78, 78, - 78, 78, 78, 78, 78, 78, 78, 78, 78, 78, - 78, 78, 78, 78, 78, 78, 78, 78, 78, 78, - 78, 78, 78, 78, 78, 78, 78, 78, 78, 78, - 78, 78, 78, 78, 78, 78, 78, 78, 78, 78, - - 78, 78, 78, 78, 78, 78, 78, 78, 78, 78, - 78, 78, 78, 78, 78, 78, 78, 78, 78, 78, - 78, 78, 78, 78, 78, 78, 78, 78, 78, 78, - 78, 78, 78, 78, 78, 78, 78, 78, 78, 78, - 78, 78, 78, 78, 78, 78, 78, 78, 78, 78, - 78, 78, 78, 78, 78 - } ; - -static const YY_CHAR yy_meta[79] = - { 0, - 1, 2, 3, 1, 4, 1, 1, 5, 1, 1, - 1, 6, 7, 8, 9, 9, 9, 9, 9, 1, - 1, 1, 1, 1, 10, 9, 9, 9, 9, 9, - 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, - 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, - 9, 7, 9, 9, 9, 9, 9, 9, 9, 9, - 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, - 9, 9, 9, 9, 9, 9, 9, 11 - } ; - -static const flex_int16_t yy_base[1579] = - { 0, - 0, 78, 156, 227, 298, 0, 376, 401, 399, 446, - 520, 0, 155, 226, 598, 0, 676, 0, 754, 0, - 404, 407, 408, 411, 194, 265, 831, 901, 972, 1024, - 3704, 7274, 7274, 3697, 3639, 3615, 7274, 7274, 3597, 175, - 469, 202, 246, 273, 200, 193, 823, 824, 828, 835, - 832, 836, 433, 0, 876, 3568, 1076, 3561, 0, 0, - 832, 494, 939, 1154, 911, 1179, 221, 3543, 986, 1000, - 1193, 1040, 1201, 1097, 1217, 1246, 1254, 1277, 7274, 7274, - 428, 3562, 3558, 3540, 1054, 1127, 1107, 1227, 1302, 262, - 895, 887, 847, 7274, 7274, 3554, 3545, 3540, 7274, 7274, - - 3491, 1310, 1328, 1336, 1344, 1352, 292, 3459, 900, 841, - 266, 430, 1360, 1077, 1008, 1327, 977, 1210, 7274, 7274, - 3404, 3386, 3343, 3318, 1361, 1379, 1387, 1404, 1412, 489, - 3305, 483, 1398, 1237, 1081, 3304, 3281, 1428, 1436, 1455, - 1463, 1471, 1263, 486, 1395, 1479, 1480, 1483, 3280, 3276, - 3268, 992, 1046, 1283, 1484, 7274, 1490, 3254, 1491, 894, - 857, 903, 1178, 902, 1089, 1482, 3263, 3257, 3244, 1548, - 1554, 1560, 1566, 3235, 1223, 1245, 1493, 910, 3136, 3118, - 1574, 1584, 1592, 1600, 1608, 491, 7274, 3099, 504, 1497, - 1323, 1616, 1617, 1583, 1620, 1621, 1624, 1625, 3115, 3097, - - 7274, 148, 1078, 1181, 1188, 7274, 0, 3054, 3030, 0, - 7274, 3033, 2983, 7274, 2976, 0, 1629, 1654, 7274, 2978, - 0, 1681, 2976, 1237, 1252, 1239, 1699, 1359, 1348, 1392, - 1406, 1391, 0, 1700, 1772, 1409, 2944, 1414, 1472, 1478, - 2960, 0, 1850, 1481, 1479, 1489, 1491, 2955, 0, 1622, - 1700, 1719, 2928, 1928, 1953, 2927, 1978, 1746, 1793, 1820, - 1865, 2055, 1886, 2047, 2063, 2074, 1807, 1873, 2082, 1115, - 2829, 7274, 2819, 1734, 1894, 2103, 0, 2118, 1496, 1480, - 1624, 2812, 2809, 7274, 2786, 2126, 2134, 7274, 2771, 2143, - 2151, 7274, 860, 1607, 2763, 2657, 1638, 1641, 1708, 1693, - - 1691, 1699, 1774, 2667, 2665, 7274, 2658, 2159, 2167, 7274, - 0, 2175, 7274, 1479, 1486, 1500, 0, 1613, 2563, 7274, - 2552, 2183, 2191, 2201, 0, 2209, 0, 1618, 1632, 1698, - 1698, 1711, 0, 2546, 7274, 2491, 2481, 7274, 2215, 2221, - 0, 2227, 1134, 1714, 1703, 1753, 1765, 1754, 1777, 1835, - 1785, 1811, 1823, 1868, 2484, 7274, 2477, 2469, 7274, 2233, - 2239, 0, 2245, 2092, 1869, 1888, 1886, 0, 1874, 2465, - 7274, 2461, 2253, 2261, 2271, 0, 2279, 7274, 7274, 7274, - 1889, 2022, 2251, 0, 2238, 2239, 0, 2254, 2274, 0, - 2431, 7274, 2413, 2257, 2261, 2266, 2259, 0, 2412, 7274, - - 2408, 0, 2256, 2261, 2278, 2333, 2274, 2277, 2287, 2279, - 2272, 2287, 0, 2346, 2418, 2293, 2390, 2288, 2288, 2304, - 2496, 2319, 2318, 2327, 2329, 2333, 2574, 2331, 2332, 2322, - 2409, 0, 2324, 2335, 2342, 0, 2327, 2390, 0, 2337, - 2336, 2393, 2439, 2380, 2652, 2677, 2374, 7274, 2375, 2701, - 2407, 2415, 2397, 2406, 2416, 2418, 2455, 2413, 2693, 2701, - 2511, 2709, 2512, 2736, 2764, 2772, 2780, 2791, 2804, 2823, - 2834, 2425, 2436, 2422, 2454, 2350, 2520, 2473, 2497, 2517, - 2349, 2640, 2797, 2700, 2798, 2513, 2506, 2692, 2698, 2689, - 0, 2691, 2710, 0, 2811, 2705, 2703, 2703, 2785, 2801, - - 2813, 2816, 2818, 2819, 2824, 2822, 0, 2838, 2842, 0, - 2836, 2837, 2847, 2849, 2832, 0, 0, 2838, 2833, 7274, - 2845, 2854, 2843, 2841, 0, 2854, 2844, 2856, 2852, 2853, - 2871, 2865, 2883, 2878, 2545, 0, 2913, 2985, 2886, 2301, - 2883, 2884, 2887, 3063, 2888, 2888, 2898, 2902, 2906, 3141, - 2904, 2904, 2895, 2898, 2967, 2915, 0, 2905, 2914, 2914, - 2969, 3218, 2929, 2970, 2979, 2944, 2983, 2950, 2982, 2974, - 2993, 2982, 2987, 2318, 0, 2985, 2999, 3002, 0, 0, - 2311, 0, 0, 2988, 2537, 2546, 2263, 3290, 3315, 2211, - 862, 3046, 2997, 3004, 3008, 3021, 3025, 0, 3052, 3045, - - 3058, 3046, 3047, 3051, 3083, 3210, 3221, 3329, 3229, 3062, - 3337, 3345, 3353, 3361, 3380, 3405, 3094, 3426, 3112, 3193, - 3191, 3209, 3218, 2198, 2197, 3242, 3209, 3252, 3237, 3344, - 3216, 3234, 0, 3340, 3339, 3342, 3348, 3344, 3345, 3350, - 3370, 3372, 437, 3360, 3421, 3413, 3385, 3391, 3392, 3389, - 3409, 3410, 3402, 0, 3409, 3413, 3406, 0, 0, 7274, - 3409, 3413, 3412, 3431, 3428, 3427, 3418, 3433, 3439, 3425, - 3444, 3443, 3432, 3488, 0, 3498, 3570, 3451, 2172, 3454, - 3457, 3468, 3648, 3469, 3468, 3479, 3481, 3485, 3726, 3483, - 3480, 3473, 3475, 3487, 3494, 0, 3479, 3489, 3488, 3530, - - 3803, 3509, 3526, 3559, 3505, 3555, 3535, 3567, 3555, 3574, - 3562, 3568, 3565, 3577, 3579, 0, 0, 0, 3565, 874, - 3581, 3576, 3586, 3574, 3630, 3590, 0, 3594, 3595, 3618, - 3616, 3617, 3622, 3622, 1025, 3645, 2184, 0, 3639, 0, - 2167, 2165, 0, 3635, 3120, 3667, 2161, 3875, 3900, 2153, - 3643, 3653, 3648, 3662, 3665, 2134, 3655, 3652, 3668, 0, - 3764, 3769, 3797, 3805, 3923, 3931, 3784, 3778, 3932, 3953, - 3961, 3980, 3996, 4004, 4022, 4040, 4050, 4058, 4078, 0, - 3787, 3799, 3791, 3822, 3796, 3835, 3899, 3940, 0, 3793, - 3814, 3816, 3809, 3816, 3806, 3878, 3883, 3892, 3893, 3903, - - 2110, 0, 3935, 3934, 3924, 3946, 3950, 3965, 3974, 3970, - 4048, 4052, 4049, 4050, 4055, 0, 4056, 4042, 7274, 4045, - 4059, 4057, 4052, 4059, 4063, 4065, 4052, 4059, 4068, 4061, - 4071, 2117, 4123, 4195, 4102, 874, 4096, 4100, 4098, 4273, - 4083, 4098, 4107, 4109, 4143, 4351, 4154, 4179, 4097, 4101, - 4117, 4117, 0, 4103, 4144, 4148, 4209, 4428, 4126, 4192, - 4184, 4124, 4197, 4202, 4202, 4184, 4235, 4231, 4227, 4193, - 4204, 4213, 0, 0, 2107, 4230, 947, 4258, 4207, 4255, - 4245, 4266, 4272, 0, 4277, 4260, 4273, 4261, 4261, 4265, - 4426, 3693, 4429, 4272, 0, 2071, 4427, 4274, 4278, 4273, - - 4286, 4288, 2070, 4279, 4276, 4292, 0, 4280, 4395, 2477, - 2960, 3303, 3888, 4434, 984, 2054, 4413, 4407, 962, 1924, - 4436, 4495, 4509, 496, 4528, 4553, 1281, 1912, 4408, 4411, - 0, 1910, 4416, 1908, 4417, 0, 4424, 0, 4567, 4575, - 4488, 1901, 4593, 4447, 4443, 4461, 4592, 4615, 4639, 4647, - 4659, 4676, 4541, 1880, 4610, 1872, 4632, 1859, 7274, 1793, - 4696, 4582, 0, 0, 4423, 4566, 4479, 4583, 4626, 4665, - 0, 4479, 4480, 4591, 4576, 4594, 4621, 0, 0, 0, - 0, 0, 4630, 4640, 4641, 4634, 4647, 4671, 4690, 4672, - 0, 4692, 4667, 4674, 4690, 4677, 7274, 4693, 7274, 4683, - - 4685, 4682, 4695, 0, 0, 1785, 0, 0, 4703, 1764, - 1760, 4734, 4736, 4707, 1308, 4738, 4718, 4735, 1700, 4742, - 4746, 4743, 4747, 4759, 4825, 4757, 4764, 4730, 4765, 4786, - 4790, 1698, 4763, 4792, 4798, 4896, 2665, 4819, 4849, 4836, - 4846, 4882, 4865, 4892, 4917, 4880, 4835, 4886, 4888, 4903, - 4940, 1696, 1679, 1654, 4902, 3982, 4952, 4969, 4973, 4976, - 4978, 4982, 4243, 4989, 4985, 4993, 5021, 5025, 5032, 4921, - 4815, 4975, 5016, 1650, 826, 4919, 5042, 5034, 5058, 5060, - 5052, 5071, 5062, 5067, 5086, 4840, 5098, 5111, 1386, 5005, - 5083, 5107, 5117, 4862, 5056, 5082, 5102, 5122, 5132, 5142, - - 5149, 5151, 5153, 5156, 5161, 5169, 5177, 5170, 1649, 5179, - 1617, 5184, 1569, 5186, 1511, 1433, 927, 1431, 1049, 5001, - 5174, 1459, 1701, 1400, 1383, 5166, 5204, 5219, 996, 1360, - 5231, 1535, 5237, 5239, 5249, 5251, 5255, 5257, 5264, 5268, - 4977, 5189, 5285, 5238, 4884, 5243, 5121, 5256, 1358, 1324, - 1201, 1311, 1298, 5306, 5103, 5280, 0, 1296, 5297, 5277, - 5280, 5301, 4991, 5103, 5153, 5243, 0, 0, 5250, 5278, - 5270, 5282, 0, 1291, 5295, 5286, 5302, 5305, 5297, 5306, - 5300, 0, 0, 5310, 5310, 0, 5310, 5317, 5315, 5306, - 5314, 5367, 5358, 5327, 1266, 5322, 5322, 5334, 1213, 5355, - - 5361, 5365, 5369, 5366, 5405, 5344, 5344, 5359, 5378, 5384, - 5388, 1181, 5396, 5373, 5393, 1156, 5433, 5440, 5444, 5448, - 5450, 5454, 5469, 5488, 5461, 5412, 5421, 5433, 5435, 5452, - 5474, 1113, 1069, 7274, 5437, 5514, 5517, 5521, 5523, 5527, - 5535, 5538, 5541, 5547, 5559, 5580, 5562, 5574, 5586, 5455, - 1828, 5476, 5531, 1067, 1902, 5489, 5588, 5590, 5607, 5615, - 5619, 5625, 5633, 5639, 5652, 5658, 5660, 5663, 1114, 1849, - 1952, 2102, 4442, 5642, 5644, 5513, 5668, 5687, 5694, 5689, - 5697, 5713, 5715, 5718, 5721, 5731, 5739, 2125, 7274, 2378, - 7274, 2467, 7274, 2811, 7274, 5576, 5655, 5533, 5742, 5746, - - 5752, 5748, 5758, 5760, 5763, 5766, 5639, 2100, 988, 5732, - 5535, 7274, 5790, 5792, 5808, 5810, 5817, 5819, 5822, 5825, - 946, 5572, 932, 874, 0, 0, 0, 5602, 0, 5648, - 5669, 0, 5729, 5740, 5740, 0, 5747, 5775, 0, 0, - 7274, 5834, 5786, 5806, 5805, 5806, 5798, 5802, 5837, 5841, - 5810, 5861, 5869, 5871, 5877, 5885, 859, 0, 506, 5830, - 5822, 5836, 5840, 5848, 5854, 5895, 5854, 5850, 0, 5867, - 5856, 5863, 5875, 5868, 5867, 5912, 502, 5921, 5882, 5887, - 5888, 5881, 5897, 5900, 5915, 5902, 7274, 5909, 5910, 5911, - 5930, 5903, 5942, 5916, 5964, 5976, 5927, 5924, 5905, 476, - - 5931, 5947, 5930, 5954, 5945, 5948, 5950, 5958, 455, 5986, - 5952, 5993, 6002, 5959, 0, 415, 5967, 5969, 5963, 0, - 5979, 5972, 5981, 5977, 6016, 250, 6015, 5984, 6026, 6042, - 6000, 5998, 6013, 6011, 0, 7274, 6044, 6058, 6004, 6045, - 293, 6055, 6019, 6070, 0, 6043, 6036, 0, 7274, 255, - 222, 181, 0, 6075, 6038, 6050, 6081, 6055, 0, 6084, - 0, 7274, 6147, 6158, 6169, 6180, 6191, 6202, 6208, 6219, - 6230, 6241, 6252, 6263, 6274, 6285, 6291, 6302, 6313, 6319, - 6330, 6341, 6347, 6358, 6369, 6375, 6386, 6397, 6408, 6413, - 6424, 6435, 6446, 6451, 6462, 6473, 6479, 6490, 6501, 6510, - - 6521, 6532, 6543, 6554, 6565, 6570, 6581, 6592, 6603, 6614, - 6625, 6636, 6647, 6658, 6663, 6674, 6685, 6690, 6696, 6707, - 6718, 6723, 6734, 6745, 6750, 6761, 6772, 6783, 6788, 6799, - 6810, 6821, 6826, 6837, 6848, 6853, 6864, 6875, 6884, 6895, - 6906, 6917, 6922, 6933, 6944, 6955, 6966, 6977, 6988, 6993, - 6998, 7003, 7008, 7013, 7018, 7029, 7040, 7051, 7062, 7073, - 7084, 7095, 7106, 7117, 7128, 7139, 7150, 7161, 7172, 7183, - 7194, 7205, 7216, 7221, 7230, 7240, 7251, 7262 - } ; - -static const flex_int16_t yy_def[1579] = - { 0, - 1462, 1462, 1463, 1463, 1462, 5, 1464, 1464, 4, 4, - 1462, 11, 4, 4, 1462, 15, 1462, 17, 1462, 19, - 4, 4, 4, 4, 1465, 1465, 1465, 1465, 1466, 1466, - 1462, 1462, 1462, 1462, 1467, 1468, 1462, 1462, 1462, 1462, - 1462, 1469, 1462, 1469, 1462, 1469, 1469, 1469, 1469, 1469, - 1469, 1469, 1469, 1470, 1470, 1471, 1472, 1473, 1470, 1470, - 1470, 1470, 1470, 1474, 1470, 1474, 1470, 1470, 66, 66, - 66, 66, 66, 66, 66, 66, 66, 66, 1462, 1462, - 1462, 1475, 1476, 1462, 1462, 1462, 1477, 1462, 1477, 1477, - 1477, 1477, 1477, 1462, 1462, 1462, 1478, 1479, 1462, 1462, - - 1462, 1462, 1462, 1480, 1462, 1480, 1462, 1462, 1480, 1480, - 1480, 1480, 1480, 1480, 1480, 1480, 1480, 1480, 1462, 1462, - 1462, 1481, 1482, 1462, 1462, 1462, 1483, 1462, 1483, 1462, - 1462, 1483, 1477, 1477, 1477, 1484, 1485, 1462, 1462, 1486, - 1462, 1486, 1486, 1486, 1486, 1486, 1486, 1477, 1487, 1488, - 1489, 1462, 1490, 1462, 1490, 1462, 1490, 1490, 1490, 1490, - 1490, 1490, 1490, 1490, 1490, 1490, 1491, 1492, 1493, 1462, - 1494, 1462, 1494, 1494, 1494, 1494, 1494, 1494, 1495, 1496, - 1462, 1462, 1497, 1462, 1497, 1462, 1462, 1462, 1497, 1497, - 1497, 1497, 1497, 1497, 1497, 1497, 1497, 1497, 1498, 1499, - - 1462, 1462, 1462, 1462, 1462, 1462, 1500, 1501, 1502, 1500, - 1462, 1462, 1503, 1462, 1504, 1505, 1462, 1462, 1462, 1462, - 1506, 1506, 1462, 1506, 1506, 1506, 1506, 1506, 1506, 1506, - 1506, 1506, 1507, 1507, 1508, 1507, 1507, 1507, 1507, 1507, - 1509, 1507, 1508, 243, 243, 243, 243, 1510, 1511, 1507, - 1507, 1507, 1507, 1512, 1512, 1507, 1462, 255, 255, 255, - 255, 255, 255, 255, 255, 255, 255, 255, 255, 1462, - 1513, 1462, 1514, 1462, 1462, 1462, 1515, 1515, 1515, 1515, - 1515, 1462, 1516, 1462, 1517, 1462, 1462, 1462, 1518, 1519, - 1518, 1462, 1519, 1518, 1518, 1518, 1518, 1518, 1518, 1518, - - 1518, 1518, 1518, 1462, 1520, 1462, 1521, 1462, 1462, 1462, - 1522, 1522, 1462, 1515, 1515, 1515, 1515, 1515, 1523, 1462, - 1524, 1462, 1462, 1462, 1525, 1525, 1525, 1525, 1525, 1525, - 1525, 1515, 1515, 1526, 1462, 1527, 1528, 1462, 1462, 1462, - 1529, 1529, 1462, 1529, 1529, 1529, 1529, 1529, 1529, 1529, - 1529, 1529, 1529, 1529, 1530, 1462, 1531, 1532, 1462, 1462, - 1462, 1533, 1533, 1462, 1533, 1533, 1533, 1533, 1533, 1534, - 1462, 1535, 1462, 1462, 1462, 1536, 1536, 1462, 1462, 1462, - 1536, 1536, 1536, 1536, 1536, 1536, 1536, 1536, 1536, 1536, - 1537, 1462, 1538, 1462, 1462, 1462, 1462, 1539, 1540, 1462, - - 1541, 1542, 1543, 1543, 1543, 1462, 1543, 1543, 1543, 1543, - 1543, 1543, 1544, 1544, 1545, 1544, 1544, 1544, 1544, 1544, - 1545, 421, 421, 421, 421, 1544, 1462, 1544, 1544, 1544, - 1546, 1544, 421, 421, 421, 421, 421, 1547, 1548, 1544, - 1544, 1544, 1544, 1544, 1549, 1549, 1544, 1462, 427, 427, - 450, 450, 450, 450, 450, 450, 450, 450, 446, 446, - 446, 446, 1544, 446, 446, 446, 446, 446, 446, 446, - 446, 1550, 1550, 1550, 1550, 1551, 1551, 1552, 1552, 1552, - 1552, 1552, 1552, 1552, 1552, 1550, 1550, 1550, 1550, 1553, - 1553, 1553, 1553, 1550, 1554, 1554, 1554, 1554, 1554, 1554, - - 1554, 1554, 1554, 1554, 1554, 1554, 1554, 1555, 1555, 1555, - 1555, 1536, 1536, 1536, 1536, 1536, 1536, 1536, 1462, 1462, - 1462, 1462, 1462, 1462, 1543, 1543, 1543, 1462, 1543, 1543, - 1543, 1543, 1543, 1543, 1543, 1556, 1556, 1557, 1556, 1556, - 1556, 1556, 1556, 1557, 544, 544, 544, 544, 1556, 1462, - 1556, 1556, 1556, 544, 544, 544, 544, 544, 1556, 1556, - 550, 550, 562, 562, 562, 562, 562, 562, 562, 562, - 1556, 1556, 1556, 1558, 1556, 544, 544, 544, 544, 544, - 1559, 1560, 1556, 1556, 1556, 1556, 1556, 1561, 1561, 1556, - 562, 562, 562, 562, 562, 562, 562, 562, 562, 562, - - 562, 562, 562, 562, 589, 589, 589, 589, 1556, 1556, - 589, 589, 589, 589, 589, 589, 589, 589, 589, 1550, - 1550, 1550, 1550, 1552, 1552, 1552, 1552, 1552, 1552, 1552, - 1550, 1550, 1550, 1550, 1553, 1553, 1553, 1554, 1554, 1554, - 1554, 1554, 1554, 1554, 1554, 1554, 1554, 1554, 1554, 1554, - 1554, 1555, 1555, 1555, 1536, 1536, 1536, 1536, 1536, 1462, - 1462, 1462, 1462, 1462, 1543, 1543, 1462, 1543, 1543, 1543, - 1543, 1543, 1543, 1462, 1562, 1562, 1563, 1562, 1562, 1562, - 1562, 1562, 1563, 683, 683, 683, 683, 1562, 1462, 1562, - 1562, 1562, 683, 683, 683, 683, 683, 1562, 1562, 689, - - 689, 701, 701, 701, 701, 701, 701, 701, 701, 1562, - 1562, 1562, 683, 683, 683, 683, 683, 1562, 1562, 701, - 701, 701, 701, 701, 701, 701, 701, 701, 701, 701, - 701, 701, 701, 1562, 1562, 1562, 1564, 1562, 683, 683, - 683, 1565, 1566, 1562, 1562, 1562, 1562, 1567, 1567, 1562, - 701, 701, 701, 701, 701, 701, 701, 701, 701, 701, - 701, 701, 749, 749, 749, 1562, 1562, 1562, 749, 749, - 749, 749, 749, 749, 749, 749, 749, 749, 1562, 1550, - 1550, 1550, 1550, 1552, 1552, 1552, 1552, 1552, 1550, 1550, - 1550, 1553, 1553, 1553, 1554, 1554, 1554, 1554, 1554, 1554, - - 1554, 1554, 1554, 1554, 1554, 1554, 1554, 1554, 1554, 1554, - 1554, 1554, 1555, 1555, 1536, 1536, 1536, 1462, 1462, 1462, - 1462, 1543, 1543, 1462, 1543, 1543, 1543, 1543, 1543, 1543, - 1462, 1568, 1568, 1569, 1568, 1568, 1568, 1568, 1568, 1569, - 840, 840, 840, 840, 1568, 1462, 1568, 1568, 1568, 840, - 840, 840, 840, 840, 1568, 1568, 846, 846, 858, 858, - 858, 858, 858, 858, 858, 858, 1568, 1568, 1568, 840, - 840, 840, 840, 840, 1568, 1568, 858, 858, 858, 858, - 858, 858, 858, 858, 858, 858, 858, 858, 858, 858, - 1568, 1568, 1568, 840, 840, 840, 1568, 858, 858, 858, - - 858, 858, 858, 858, 858, 858, 858, 858, 858, 1568, - 1568, 1568, 1568, 1568, 1570, 1568, 840, 840, 1571, 1572, - 1568, 1568, 1568, 1568, 1573, 1573, 1568, 858, 858, 858, - 858, 858, 858, 858, 858, 858, 858, 858, 926, 926, - 1568, 1568, 1568, 1568, 1568, 1568, 926, 926, 926, 926, - 926, 926, 1568, 1568, 1568, 1568, 1568, 1568, 1462, 1568, - 1568, 1568, 1550, 1550, 1550, 1552, 1552, 1552, 1552, 1552, - 1550, 1550, 1553, 1553, 1553, 1554, 1554, 1554, 1554, 1554, - 1554, 1554, 1554, 1554, 1554, 1554, 1554, 1554, 1554, 1554, - 1554, 1554, 1555, 1555, 1536, 1536, 1462, 1462, 1462, 1543, - - 1543, 1462, 1543, 1543, 1543, 1543, 1543, 1543, 1462, 1462, - 1462, 1462, 1574, 1462, 1462, 1462, 1462, 1462, 1574, 1574, - 1574, 1574, 1574, 1462, 1575, 1462, 1462, 1462, 1574, 1574, - 1574, 1574, 1574, 1462, 1462, 1575, 1575, 1575, 1575, 1575, - 1575, 1575, 1575, 1575, 1575, 1462, 1462, 1462, 1574, 1574, - 1574, 1574, 1574, 1462, 1462, 1575, 1575, 1575, 1575, 1575, - 1575, 1575, 1575, 1575, 1575, 1575, 1575, 1575, 1575, 1462, - 1462, 1462, 1574, 1574, 1574, 1462, 1575, 1575, 1575, 1575, - 1575, 1575, 1575, 1575, 1575, 1575, 1575, 1575, 1462, 1462, - 1462, 1462, 1462, 1574, 1574, 1462, 1575, 1575, 1575, 1575, - - 1575, 1575, 1575, 1575, 1575, 1575, 1575, 1462, 1462, 1462, - 1462, 1462, 1462, 1462, 1462, 1462, 1576, 1462, 1576, 1574, - 1574, 1577, 1577, 1578, 1578, 1462, 1462, 1462, 1462, 1543, - 1543, 1462, 1575, 1575, 1575, 1575, 1575, 1575, 1575, 1575, - 1543, 1543, 1462, 1462, 1462, 1462, 1462, 1543, 1543, 1543, - 1543, 1543, 1543, 1462, 1462, 1462, 1550, 1552, 1552, 1552, - 1552, 1552, 1550, 1553, 1553, 1553, 1554, 1554, 1554, 1554, - 1554, 1554, 1554, 1554, 1554, 1554, 1554, 1554, 1554, 1555, - 1555, 1536, 1536, 1462, 1543, 1543, 1462, 1543, 1543, 1462, - 1462, 1462, 1574, 1462, 1462, 1462, 1462, 1462, 1574, 1574, - - 1574, 1574, 1574, 1462, 1036, 1462, 1462, 1462, 1574, 1574, - 1574, 1574, 1574, 1462, 1462, 1036, 1575, 1575, 1575, 1575, - 1575, 1575, 1575, 1575, 1575, 1462, 1462, 1462, 1574, 1574, - 1574, 1574, 1574, 1462, 1462, 1575, 1575, 1575, 1575, 1575, - 1575, 1575, 1575, 1575, 1575, 1575, 1575, 1575, 1575, 1462, - 1462, 1462, 1574, 1574, 1574, 1462, 1575, 1575, 1575, 1575, - 1575, 1575, 1575, 1575, 1575, 1575, 1575, 1575, 1462, 1462, - 1462, 1462, 1462, 1574, 1574, 1462, 1575, 1575, 1575, 1575, - 1575, 1575, 1575, 1575, 1575, 1575, 1575, 1462, 1462, 1462, - 1462, 1462, 1462, 1462, 1462, 1574, 1574, 1462, 1575, 1575, - - 1575, 1575, 1575, 1575, 1575, 1575, 1576, 1574, 1574, 1577, - 1578, 1462, 1575, 1575, 1575, 1575, 1575, 1575, 1575, 1575, - 1552, 1552, 1552, 1552, 1550, 1553, 1553, 1553, 1554, 1554, - 1554, 1554, 1554, 1554, 1554, 1554, 1554, 1554, 1555, 1555, - 1462, 1543, 1462, 1543, 1543, 1462, 1462, 1576, 1462, 1577, - 1578, 1575, 1575, 1575, 1575, 1575, 1552, 1553, 1554, 1554, - 1554, 1554, 1554, 1554, 1554, 1462, 1462, 1543, 1543, 1462, - 1462, 1576, 1462, 1577, 1578, 1575, 1462, 1575, 1554, 1554, - 1554, 1554, 1554, 1554, 1554, 1462, 1462, 1543, 1462, 1462, - 1576, 1462, 1577, 1578, 1575, 1575, 1554, 1554, 1554, 1554, - - 1554, 1554, 1554, 1462, 1543, 1462, 1462, 1576, 1462, 1577, - 1578, 1575, 1575, 1554, 1554, 1554, 1554, 1554, 1554, 1554, - 1462, 1543, 1462, 1462, 1576, 1462, 1577, 1578, 1575, 1575, - 1554, 1554, 1554, 1554, 1554, 1462, 1543, 1462, 1462, 1576, - 1462, 1577, 1578, 1575, 1554, 1554, 1554, 1554, 1462, 1576, - 1462, 1577, 1578, 1575, 1554, 1554, 1575, 1554, 1554, 1575, - 1554, 0, 1462, 1462, 1462, 1462, 1462, 1462, 1462, 1462, - 1462, 1462, 1462, 1462, 1462, 1462, 1462, 1462, 1462, 1462, - 1462, 1462, 1462, 1462, 1462, 1462, 1462, 1462, 1462, 1462, - 1462, 1462, 1462, 1462, 1462, 1462, 1462, 1462, 1462, 1462, - - 1462, 1462, 1462, 1462, 1462, 1462, 1462, 1462, 1462, 1462, - 1462, 1462, 1462, 1462, 1462, 1462, 1462, 1462, 1462, 1462, - 1462, 1462, 1462, 1462, 1462, 1462, 1462, 1462, 1462, 1462, - 1462, 1462, 1462, 1462, 1462, 1462, 1462, 1462, 1462, 1462, - 1462, 1462, 1462, 1462, 1462, 1462, 1462, 1462, 1462, 1462, - 1462, 1462, 1462, 1462, 1462, 1462, 1462, 1462, 1462, 1462, - 1462, 1462, 1462, 1462, 1462, 1462, 1462, 1462, 1462, 1462, - 1462, 1462, 1462, 1462, 1462, 1462, 1462, 1462 - } ; - -static const flex_int16_t yy_nxt[7353] = - { 0, - 32, 33, 34, 35, 32, 32, 36, 37, 38, 39, - 40, 41, 42, 43, 44, 44, 44, 44, 44, 32, - 45, 32, 32, 32, 32, 46, 46, 47, 48, 46, - 46, 46, 46, 49, 46, 46, 46, 46, 46, 46, - 50, 46, 51, 52, 46, 46, 46, 53, 46, 46, - 46, 46, 46, 46, 47, 48, 46, 46, 46, 46, - 49, 46, 46, 46, 46, 46, 46, 50, 46, 51, - 52, 46, 46, 46, 53, 46, 46, 46, 54, 33, - 55, 56, 54, 57, 58, 59, 60, 61, 62, 63, - 64, 65, 66, 66, 66, 66, 66, 54, 67, 54, - - 54, 68, 54, 69, 69, 70, 71, 72, 69, 69, - 69, 73, 69, 69, 69, 69, 69, 69, 74, 69, - 75, 76, 77, 69, 69, 78, 69, 69, 69, 69, - 69, 69, 70, 71, 72, 69, 69, 69, 73, 69, - 69, 69, 69, 69, 69, 74, 69, 75, 76, 77, - 69, 69, 78, 69, 69, 69, 79, 80, 81, 82, - 79, 79, 83, 79, 79, 84, 85, 86, 87, 88, - 89, 89, 89, 89, 89, 79, 81, 79, 79, 79, - 79, 394, 90, 91, 90, 92, 217, 214, 217, 218, - 218, 218, 218, 218, 148, 80, 81, 199, 90, 93, - - 200, 219, 223, 84, 1462, 81, 1462, 201, 394, 90, - 91, 90, 92, 217, 81, 217, 222, 222, 222, 222, - 222, 148, 219, 256, 1451, 90, 93, 79, 80, 81, - 82, 79, 79, 83, 79, 79, 84, 85, 86, 87, - 88, 89, 89, 89, 89, 89, 79, 81, 79, 79, - 79, 79, 1426, 90, 91, 90, 92, 217, 214, 217, - 218, 218, 218, 218, 218, 148, 80, 81, 199, 90, - 93, 200, 1441, 1462, 84, 1462, 81, 1462, 201, 293, - 90, 91, 90, 92, 217, 81, 217, 222, 222, 222, - 222, 222, 148, 288, 282, 1451, 90, 93, 94, 95, - - 96, 97, 94, 94, 98, 99, 100, 101, 102, 103, - 104, 105, 106, 106, 106, 106, 106, 94, 107, 94, - 108, 94, 94, 109, 110, 111, 111, 111, 111, 111, - 111, 112, 111, 111, 113, 111, 111, 114, 115, 111, - 116, 117, 118, 111, 111, 111, 111, 111, 111, 111, - 109, 110, 111, 111, 111, 111, 111, 111, 112, 111, - 111, 113, 111, 111, 114, 115, 111, 116, 117, 118, - 111, 111, 111, 111, 111, 111, 119, 120, 121, 122, - 119, 119, 123, 119, 119, 124, 125, 126, 127, 128, - 129, 129, 129, 129, 129, 119, 130, 119, 131, 119, - - 119, 119, 120, 121, 122, 119, 119, 123, 119, 119, - 124, 125, 126, 127, 128, 129, 129, 129, 129, 129, - 119, 130, 119, 131, 119, 119, 90, 1432, 90, 133, - 270, 90, 134, 90, 90, 90, 90, 90, 90, 270, - 90, 1462, 90, 293, 1462, 135, 1462, 90, 270, 801, - 90, 90, 802, 90, 90, 90, 133, 1426, 90, 134, - 90, 90, 90, 90, 90, 90, 232, 90, 296, 90, - 219, 220, 135, 90, 90, 90, 133, 90, 90, 134, - 217, 90, 217, 218, 218, 218, 218, 218, 1417, 90, - 310, 304, 135, 232, 1462, 296, 1462, 1462, 1129, 1462, - - 90, 1011, 90, 133, 1377, 251, 134, 251, 252, 252, - 252, 252, 252, 378, 379, 1462, 90, 1462, 1379, 135, - 79, 80, 81, 136, 79, 79, 137, 79, 79, 84, - 138, 139, 140, 141, 142, 142, 142, 142, 142, 79, - 81, 79, 79, 79, 79, 143, 144, 145, 144, 144, - 144, 144, 144, 144, 144, 144, 144, 144, 144, 146, - 147, 144, 144, 144, 144, 144, 144, 144, 144, 144, - 144, 144, 143, 144, 145, 144, 144, 144, 144, 144, - 144, 144, 144, 144, 144, 144, 146, 147, 144, 144, - 144, 144, 144, 144, 144, 144, 144, 144, 79, 80, - - 81, 149, 79, 79, 150, 151, 79, 84, 152, 81, - 153, 154, 155, 155, 155, 155, 155, 79, 81, 79, - 156, 79, 79, 157, 158, 159, 158, 158, 160, 158, - 158, 158, 158, 158, 158, 161, 162, 163, 158, 158, - 164, 165, 158, 158, 158, 158, 166, 158, 158, 158, - 157, 158, 159, 158, 158, 160, 158, 158, 158, 158, - 158, 158, 161, 162, 163, 158, 158, 164, 165, 158, - 158, 158, 158, 166, 158, 158, 79, 80, 81, 167, - 79, 79, 168, 169, 79, 84, 170, 81, 171, 172, - 173, 173, 173, 173, 173, 79, 81, 79, 79, 79, - - 79, 174, 174, 175, 174, 174, 174, 174, 174, 174, - 174, 174, 176, 174, 174, 177, 174, 174, 174, 174, - 174, 174, 174, 178, 174, 174, 174, 174, 174, 174, - 175, 174, 174, 174, 174, 174, 174, 174, 174, 176, - 174, 174, 177, 174, 174, 174, 174, 174, 174, 174, - 178, 174, 174, 174, 79, 80, 81, 179, 79, 79, - 180, 79, 79, 84, 181, 182, 183, 184, 185, 185, - 185, 185, 185, 79, 81, 186, 187, 188, 79, 189, - 189, 189, 190, 191, 189, 192, 189, 193, 189, 189, - 194, 189, 195, 196, 189, 189, 189, 197, 198, 189, - - 189, 189, 189, 189, 189, 189, 189, 189, 189, 190, - 191, 189, 192, 189, 193, 189, 189, 194, 189, 195, - 196, 189, 189, 189, 197, 198, 189, 189, 189, 189, - 189, 189, 80, 81, 1462, 1462, 1462, 1462, 1275, 1462, - 84, 1462, 81, 1462, 201, 1462, 1462, 1462, 1462, 1462, - 1191, 81, 1462, 225, 293, 249, 227, 226, 1462, 250, - 1462, 230, 224, 448, 720, 231, 228, 202, 203, 204, - 1462, 1462, 293, 1462, 205, 448, 877, 229, 234, 1011, - 225, 235, 349, 227, 226, 236, 250, 293, 230, 224, - 295, 281, 231, 228, 202, 203, 204, 1025, 1462, 237, - - 1462, 205, 80, 81, 229, 238, 1462, 1462, 1462, 349, - 84, 1462, 81, 293, 201, 1462, 1462, 295, 281, 239, - 240, 81, 251, 1462, 251, 252, 252, 252, 252, 252, - 214, 352, 238, 348, 279, 280, 294, 202, 203, 204, - 219, 253, 350, 369, 205, 293, 239, 240, 448, 1056, - 251, 1307, 251, 252, 252, 252, 252, 252, 352, 293, - 348, 279, 280, 294, 202, 203, 204, 1123, 1118, 350, - 369, 205, 79, 206, 207, 208, 207, 79, 209, 79, - 79, 84, 79, 79, 79, 79, 207, 1118, 1462, 1119, - 293, 211, 211, 211, 211, 211, 211, 233, 220, 233, - - 254, 254, 254, 254, 254, 339, 340, 340, 340, 340, - 340, 233, 1462, 233, 254, 254, 254, 254, 254, 1462, - 1191, 293, 302, 211, 79, 206, 207, 208, 207, 79, - 209, 79, 79, 84, 79, 79, 79, 79, 207, 258, - 911, 912, 913, 211, 211, 211, 211, 211, 211, 302, - 300, 233, 214, 233, 254, 254, 254, 254, 254, 339, - 342, 342, 342, 342, 342, 274, 258, 274, 275, 275, - 275, 275, 275, 1307, 261, 211, 233, 300, 233, 233, - 233, 233, 233, 233, 233, 233, 233, 233, 1462, 233, - 293, 1462, 1462, 1462, 1462, 233, 233, 233, 233, 233, - - 233, 261, 1462, 395, 244, 245, 318, 299, 233, 246, - 233, 254, 254, 254, 254, 254, 1288, 270, 274, 247, - 274, 278, 278, 278, 278, 278, 270, 1289, 353, 270, - 395, 244, 245, 318, 299, 270, 246, 1462, 276, 264, - 274, 275, 275, 275, 275, 275, 247, 270, 343, 343, - 343, 343, 343, 233, 233, 353, 233, 233, 233, 233, - 233, 233, 233, 233, 233, 251, 264, 251, 255, 255, - 255, 255, 255, 233, 233, 233, 233, 233, 233, 233, - 1462, 233, 233, 233, 233, 233, 233, 233, 233, 233, - 251, 1462, 251, 255, 255, 255, 255, 255, 233, 233, - - 233, 233, 233, 233, 233, 1462, 233, 254, 254, 254, - 254, 254, 233, 1189, 233, 254, 254, 254, 254, 254, - 396, 1462, 259, 293, 351, 1191, 260, 397, 233, 262, - 233, 254, 254, 254, 254, 254, 1462, 1462, 274, 263, - 274, 275, 275, 275, 275, 275, 265, 396, 1462, 259, - 1462, 351, 303, 260, 397, 365, 262, 233, 1462, 233, - 254, 254, 254, 254, 254, 233, 263, 233, 254, 254, - 254, 254, 254, 265, 1462, 266, 1462, 403, 404, 303, - 317, 267, 365, 1132, 366, 405, 1011, 268, 233, 1205, - 233, 254, 254, 254, 254, 254, 339, 343, 343, 343, - - 343, 343, 266, 1333, 403, 404, 327, 317, 267, 293, - 269, 366, 405, 274, 268, 274, 278, 278, 278, 278, - 278, 286, 1191, 286, 287, 287, 287, 287, 287, 288, - 282, 1205, 1191, 327, 1462, 1191, 1462, 269, 1462, 286, - 293, 286, 287, 287, 287, 287, 287, 286, 1191, 290, - 291, 291, 291, 291, 291, 286, 301, 286, 287, 287, - 287, 287, 287, 286, 382, 290, 291, 291, 291, 291, - 291, 1462, 308, 293, 308, 309, 309, 309, 309, 309, - 310, 304, 1191, 301, 1191, 297, 408, 409, 1288, 298, - 308, 382, 308, 309, 309, 309, 309, 309, 308, 1289, - - 308, 312, 312, 312, 312, 312, 1462, 1311, 1462, 1462, - 1191, 1462, 297, 408, 409, 308, 298, 308, 309, 309, - 309, 309, 309, 308, 1311, 308, 312, 312, 312, 312, - 312, 314, 410, 411, 328, 412, 426, 315, 270, 322, - 316, 322, 323, 323, 323, 323, 323, 324, 428, 322, - 323, 323, 323, 323, 323, 1191, 270, 1191, 314, 410, - 411, 328, 412, 426, 315, 214, 322, 316, 322, 326, - 326, 326, 326, 326, 322, 428, 322, 323, 323, 323, - 323, 323, 322, 1310, 322, 326, 326, 326, 326, 326, - 1462, 1462, 1462, 1462, 1462, 1462, 1462, 339, 342, 342, - - 342, 342, 342, 1462, 1462, 331, 1462, 429, 1462, 329, - 1462, 430, 354, 332, 433, 434, 346, 435, 344, 436, - 437, 333, 472, 367, 473, 330, 381, 486, 487, 488, - 347, 368, 331, 345, 429, 1191, 329, 223, 430, 354, - 332, 433, 434, 346, 435, 344, 436, 437, 333, 472, - 367, 473, 330, 381, 486, 487, 488, 347, 368, 1191, - 345, 360, 361, 361, 361, 361, 361, 360, 363, 363, - 363, 363, 363, 360, 364, 364, 364, 364, 364, 360, - 363, 363, 363, 363, 363, 373, 270, 373, 374, 374, - 374, 374, 374, 1191, 1462, 375, 1462, 373, 374, 374, - - 374, 374, 374, 373, 270, 373, 377, 377, 377, 377, - 377, 373, 385, 373, 374, 374, 374, 374, 374, 373, - 293, 373, 377, 377, 377, 377, 377, 1462, 1462, 1462, - 1462, 1462, 1462, 1462, 1462, 1462, 1462, 1462, 1462, 385, - 217, 1191, 217, 218, 218, 218, 218, 218, 440, 474, - 478, 293, 475, 388, 293, 489, 490, 389, 383, 386, - 384, 441, 491, 387, 390, 217, 480, 217, 218, 218, - 218, 218, 218, 1191, 1191, 440, 474, 478, 1191, 475, - 388, 479, 489, 490, 389, 383, 386, 384, 441, 491, - 387, 390, 217, 480, 217, 222, 222, 222, 222, 222, - - 406, 406, 414, 1191, 293, 415, 293, 214, 479, 416, - 406, 442, 293, 442, 443, 443, 443, 443, 443, 406, - 1191, 293, 1191, 417, 1191, 1310, 482, 492, 407, 418, - 442, 483, 442, 443, 443, 443, 443, 443, 481, 484, - 493, 494, 495, 419, 420, 274, 496, 274, 275, 275, - 275, 275, 275, 482, 492, 407, 418, 413, 483, 413, - 445, 445, 445, 445, 445, 481, 484, 493, 494, 495, - 419, 420, 413, 496, 413, 413, 413, 413, 413, 413, - 413, 413, 413, 413, 1191, 413, 459, 293, 1191, 497, - 500, 413, 413, 413, 413, 413, 413, 1189, 1011, 485, - - 422, 423, 498, 499, 413, 424, 413, 445, 445, 445, - 445, 445, 501, 459, 504, 425, 497, 500, 413, 460, - 413, 445, 445, 445, 445, 445, 485, 422, 423, 498, - 499, 413, 424, 413, 445, 445, 445, 445, 445, 501, - 469, 504, 425, 1270, 1271, 1272, 460, 502, 505, 413, - 413, 1290, 413, 413, 413, 413, 413, 413, 413, 413, - 413, 413, 1291, 413, 1011, 503, 461, 469, 506, 413, - 413, 413, 413, 413, 413, 505, 413, 1011, 413, 445, - 445, 445, 445, 445, 413, 1011, 413, 445, 445, 445, - 445, 445, 503, 461, 462, 506, 507, 413, 508, 413, - - 445, 445, 445, 445, 445, 274, 1011, 274, 275, 275, - 275, 275, 275, 465, 1275, 509, 510, 470, 511, 512, - 1138, 462, 1136, 507, 1133, 508, 1462, 413, 413, 1125, - 413, 413, 413, 413, 413, 413, 413, 413, 413, 413, - 465, 413, 509, 510, 470, 511, 512, 413, 413, 413, - 413, 413, 413, 413, 1292, 413, 413, 413, 413, 413, - 413, 413, 413, 413, 442, 1293, 442, 446, 446, 446, - 446, 446, 413, 413, 413, 413, 413, 413, 413, 448, - 449, 413, 413, 413, 413, 413, 413, 413, 413, 413, - 450, 413, 450, 450, 450, 450, 450, 413, 413, 413, - - 413, 413, 413, 450, 450, 451, 452, 453, 450, 450, - 450, 454, 450, 450, 455, 450, 450, 450, 456, 450, - 450, 457, 458, 450, 450, 450, 450, 450, 450, 450, - 450, 450, 451, 452, 453, 450, 450, 450, 454, 450, - 450, 455, 450, 450, 450, 456, 450, 450, 457, 458, - 450, 450, 450, 450, 450, 413, 406, 463, 413, 1011, - 413, 445, 445, 445, 445, 445, 463, 513, 413, 445, - 445, 445, 445, 445, 413, 463, 413, 445, 445, 445, - 445, 445, 1102, 1095, 464, 413, 466, 413, 445, 445, - 445, 445, 445, 413, 513, 413, 445, 445, 445, 445, - - 445, 468, 1349, 467, 1294, 270, 364, 364, 364, 364, - 364, 464, 1011, 466, 276, 1295, 274, 275, 275, 275, - 275, 275, 1011, 270, 1462, 982, 471, 1288, 468, 274, - 467, 274, 278, 278, 278, 278, 278, 286, 1289, 286, - 287, 287, 287, 287, 287, 286, 933, 286, 287, 287, - 287, 287, 287, 471, 286, 927, 286, 477, 477, 477, - 477, 477, 286, 924, 290, 291, 291, 291, 291, 291, - 308, 916, 308, 309, 309, 309, 309, 309, 308, 918, - 308, 309, 309, 309, 309, 309, 308, 916, 308, 312, - 312, 312, 312, 312, 322, 846, 322, 323, 323, 323, - - 323, 323, 322, 270, 322, 323, 323, 323, 323, 323, - 293, 293, 324, 750, 322, 323, 323, 323, 323, 323, - 322, 270, 322, 326, 326, 326, 326, 326, 339, 343, - 343, 343, 343, 343, 339, 340, 340, 340, 340, 340, - 339, 342, 342, 342, 342, 342, 360, 364, 364, 364, - 364, 364, 360, 361, 361, 361, 361, 361, 360, 363, - 363, 363, 363, 363, 373, 747, 373, 374, 374, 374, - 374, 374, 373, 270, 373, 374, 374, 374, 374, 374, - 514, 515, 375, 516, 373, 374, 374, 374, 374, 374, - 373, 270, 373, 377, 377, 377, 377, 377, 517, 518, - - 519, 520, 521, 522, 524, 525, 526, 514, 515, 523, - 516, 527, 529, 530, 531, 533, 534, 738, 532, 535, - 549, 738, 551, 552, 689, 517, 518, 519, 520, 521, - 522, 524, 525, 526, 406, 406, 523, 553, 527, 529, - 530, 531, 533, 534, 406, 532, 535, 549, 537, 551, - 552, 538, 554, 406, 555, 539, 556, 557, 558, 559, - 571, 528, 293, 293, 553, 572, 573, 576, 577, 540, - 579, 580, 560, 583, 584, 541, 590, 591, 578, 554, - 1290, 555, 587, 556, 557, 558, 559, 571, 528, 542, - 543, 1291, 572, 573, 576, 577, 575, 579, 580, 560, - - 583, 584, 541, 592, 585, 578, 585, 586, 586, 586, - 586, 586, 575, 550, 400, 400, 542, 543, 536, 392, - 536, 536, 536, 536, 536, 536, 536, 536, 536, 536, - 592, 536, 593, 596, 392, 597, 598, 536, 536, 536, - 536, 536, 536, 601, 594, 599, 545, 546, 595, 600, - 585, 547, 585, 586, 586, 586, 586, 586, 604, 593, - 596, 548, 597, 598, 620, 621, 622, 371, 371, 1292, - 601, 594, 599, 545, 546, 595, 600, 359, 547, 1108, - 1293, 623, 1011, 356, 602, 604, 293, 356, 548, 338, - 1109, 620, 621, 622, 603, 536, 536, 335, 536, 536, - - 536, 536, 536, 536, 536, 536, 536, 536, 623, 536, - 293, 602, 624, 406, 609, 536, 536, 536, 536, 536, - 536, 603, 536, 609, 536, 588, 588, 588, 588, 588, - 293, 286, 609, 290, 477, 477, 477, 477, 477, 624, - 610, 625, 631, 632, 607, 626, 674, 674, 745, 335, - 745, 746, 746, 746, 746, 746, 674, 745, 320, 745, - 746, 746, 746, 746, 746, 674, 320, 610, 625, 631, - 632, 607, 626, 536, 536, 448, 561, 536, 536, 536, - 536, 536, 536, 536, 536, 536, 562, 536, 562, 562, - 562, 562, 562, 536, 536, 536, 536, 536, 536, 562, - - 562, 563, 564, 565, 562, 562, 562, 566, 562, 562, - 567, 562, 562, 562, 568, 562, 562, 569, 570, 562, - 562, 562, 562, 562, 562, 562, 562, 562, 563, 564, - 565, 562, 562, 562, 566, 562, 562, 567, 562, 562, - 562, 568, 562, 562, 569, 570, 562, 562, 562, 562, - 562, 536, 536, 293, 536, 536, 536, 536, 536, 536, - 536, 536, 536, 536, 306, 536, 1462, 1462, 306, 304, - 293, 536, 536, 536, 536, 536, 536, 536, 627, 536, - 536, 536, 536, 536, 536, 536, 536, 536, 585, 1191, - 585, 589, 589, 589, 589, 589, 536, 536, 536, 536, - - 536, 536, 1462, 536, 536, 627, 536, 588, 588, 588, - 588, 588, 536, 293, 536, 588, 588, 588, 588, 588, - 536, 633, 536, 588, 588, 588, 588, 588, 562, 562, - 562, 634, 635, 636, 562, 637, 608, 562, 641, 642, - 629, 562, 605, 643, 562, 562, 606, 536, 633, 536, - 588, 588, 588, 588, 588, 562, 562, 562, 634, 635, - 636, 562, 637, 608, 562, 641, 642, 629, 562, 605, - 643, 562, 562, 606, 611, 536, 293, 536, 588, 588, - 588, 588, 588, 536, 293, 536, 588, 588, 588, 588, - 588, 536, 284, 536, 588, 588, 588, 588, 588, 613, - - 612, 611, 536, 614, 536, 588, 588, 588, 588, 588, - 293, 293, 284, 1294, 282, 536, 615, 536, 588, 588, - 588, 588, 588, 638, 1295, 272, 613, 612, 644, 645, - 614, 630, 272, 628, 536, 616, 536, 588, 588, 588, - 588, 588, 646, 615, 617, 536, 647, 536, 588, 588, - 588, 588, 588, 639, 640, 644, 645, 648, 630, 618, - 628, 649, 616, 650, 651, 652, 619, 653, 654, 646, - 655, 617, 656, 647, 657, 658, 659, 660, 661, 662, - 639, 640, 663, 664, 648, 665, 618, 666, 649, 667, - 650, 651, 652, 619, 653, 654, 668, 655, 669, 656, - - 670, 657, 658, 659, 660, 661, 662, 671, 672, 663, - 664, 673, 665, 688, 666, 676, 667, 690, 677, 691, - 692, 693, 678, 668, 694, 669, 695, 670, 696, 447, - 444, 697, 698, 710, 671, 672, 679, 711, 673, 712, - 688, 713, 680, 716, 690, 699, 691, 692, 693, 717, - 718, 694, 719, 695, 722, 696, 681, 682, 697, 698, - 710, 432, 1110, 432, 711, 1011, 712, 427, 713, 680, - 716, 720, 699, 1111, 727, 730, 717, 718, 223, 719, - 220, 722, 214, 681, 682, 675, 214, 675, 675, 675, - 675, 675, 675, 675, 675, 675, 675, 721, 675, 723, - - 714, 727, 730, 724, 675, 675, 675, 675, 675, 675, - 715, 731, 728, 684, 685, 725, 729, 726, 686, 733, - 734, 732, 735, 736, 721, 739, 723, 714, 687, 740, - 724, 741, 744, 751, 752, 212, 400, 715, 731, 728, - 684, 685, 725, 729, 726, 686, 733, 734, 732, 735, - 736, 753, 739, 756, 754, 687, 740, 400, 741, 744, - 751, 752, 675, 675, 755, 675, 675, 675, 675, 675, - 675, 675, 675, 675, 675, 723, 675, 757, 753, 724, - 756, 754, 675, 675, 675, 675, 675, 675, 758, 759, - 760, 755, 761, 762, 675, 768, 675, 748, 748, 748, - - 748, 748, 723, 392, 757, 675, 724, 675, 748, 775, - 776, 777, 748, 674, 779, 758, 759, 760, 392, 761, - 762, 380, 768, 779, 371, 675, 748, 748, 748, 748, - 748, 922, 779, 922, 923, 923, 923, 923, 923, 371, - 675, 675, 448, 700, 675, 675, 675, 675, 675, 675, - 675, 675, 675, 701, 675, 701, 701, 701, 701, 701, - 675, 675, 675, 675, 675, 675, 701, 701, 702, 703, - 704, 701, 701, 701, 705, 701, 701, 706, 701, 701, - 701, 707, 701, 701, 708, 709, 701, 701, 701, 701, - 701, 701, 701, 701, 701, 702, 703, 704, 701, 701, - - 701, 705, 701, 701, 706, 701, 701, 701, 707, 701, - 701, 708, 709, 701, 701, 701, 701, 701, 675, 1462, - 675, 675, 293, 675, 748, 748, 748, 748, 748, 780, - 406, 766, 675, 781, 675, 748, 748, 748, 748, 748, - 766, 763, 782, 783, 789, 701, 701, 701, 1462, 766, - 293, 701, 359, 785, 701, 293, 780, 767, 701, 790, - 781, 701, 701, 356, 764, 293, 356, 1462, 763, 782, - 783, 789, 701, 701, 701, 784, 338, 786, 701, 787, - 785, 701, 335, 335, 767, 701, 790, 320, 701, 701, - 675, 764, 675, 675, 675, 675, 675, 675, 675, 675, - - 675, 675, 784, 675, 786, 1112, 787, 320, 1011, 675, - 675, 675, 675, 675, 675, 675, 1113, 675, 675, 675, - 675, 675, 675, 675, 675, 675, 745, 313, 745, 749, - 749, 749, 749, 749, 675, 675, 675, 675, 675, 675, - 675, 216, 675, 748, 748, 748, 748, 748, 675, 306, - 675, 748, 748, 748, 748, 748, 675, 293, 675, 748, - 748, 748, 748, 748, 675, 791, 675, 748, 748, 748, - 748, 748, 675, 765, 675, 748, 748, 748, 748, 748, - 788, 769, 771, 792, 793, 794, 795, 796, 797, 306, - 770, 675, 791, 675, 748, 748, 748, 748, 748, 798, - - 765, 799, 800, 772, 803, 773, 304, 788, 769, 771, - 792, 793, 794, 795, 796, 797, 675, 770, 675, 748, - 748, 748, 748, 748, 808, 806, 798, 809, 799, 800, - 772, 803, 773, 804, 810, 811, 812, 675, 774, 675, - 748, 748, 748, 748, 748, 813, 814, 815, 805, 816, - 817, 808, 818, 819, 809, 778, 807, 820, 821, 822, - 823, 810, 811, 812, 824, 774, 825, 826, 827, 828, - 829, 830, 813, 814, 815, 805, 816, 817, 845, 818, - 819, 292, 778, 807, 820, 821, 822, 823, 847, 674, - 674, 824, 848, 825, 826, 827, 828, 829, 830, 674, - - 833, 849, 850, 834, 851, 845, 852, 835, 674, 853, - 854, 855, 867, 868, 216, 847, 831, 869, 870, 848, - 871, 836, 873, 874, 856, 875, 876, 837, 849, 850, - 872, 851, 877, 852, 879, 884, 853, 854, 855, 867, - 868, 838, 839, 831, 869, 870, 284, 871, 284, 873, - 874, 856, 875, 876, 837, 880, 282, 872, 878, 881, - 887, 879, 884, 216, 272, 272, 257, 242, 838, 839, - 832, 242, 832, 832, 832, 832, 832, 832, 832, 832, - 832, 832, 880, 832, 885, 878, 881, 887, 886, 832, - 832, 832, 832, 832, 832, 882, 888, 883, 841, 842, - - 890, 891, 892, 843, 893, 894, 889, 895, 896, 897, - 880, 885, 898, 844, 881, 886, 899, 900, 903, 904, - 216, 214, 882, 888, 883, 841, 842, 890, 891, 892, - 843, 893, 894, 889, 895, 896, 897, 880, 905, 898, - 844, 881, 214, 899, 900, 903, 904, 832, 832, 906, - 832, 832, 832, 832, 832, 832, 832, 832, 832, 832, - 907, 832, 908, 901, 909, 905, 910, 832, 832, 832, - 832, 832, 832, 902, 914, 917, 906, 921, 922, 928, - 922, 923, 923, 923, 923, 923, 929, 907, 930, 908, - 901, 909, 931, 910, 932, 934, 935, 936, 1011, 212, - - 902, 914, 917, 1462, 921, 1462, 928, 1462, 1090, 1091, - 1092, 1462, 1462, 929, 1462, 930, 1462, 1462, 1462, 931, - 1462, 932, 934, 935, 936, 832, 832, 448, 857, 832, - 832, 832, 832, 832, 832, 832, 832, 832, 858, 832, - 858, 858, 858, 858, 858, 832, 832, 832, 832, 832, - 832, 858, 858, 859, 860, 861, 858, 858, 858, 862, - 858, 858, 863, 858, 858, 858, 864, 858, 858, 865, - 866, 858, 858, 858, 858, 858, 858, 858, 858, 858, - 859, 860, 861, 858, 858, 858, 862, 858, 858, 863, - 858, 858, 858, 864, 858, 858, 865, 866, 858, 858, - - 858, 858, 858, 832, 1462, 832, 937, 938, 832, 293, - 832, 925, 925, 925, 925, 925, 832, 945, 832, 925, - 925, 925, 925, 925, 946, 963, 964, 965, 939, 967, - 858, 858, 858, 937, 938, 293, 858, 971, 940, 858, - 972, 973, 974, 858, 945, 975, 858, 858, 293, 976, - 1462, 946, 963, 964, 965, 939, 967, 858, 858, 858, - 966, 1462, 968, 858, 971, 940, 858, 972, 973, 974, - 858, 1462, 975, 858, 858, 832, 976, 832, 832, 832, - 832, 832, 832, 832, 832, 832, 832, 966, 832, 968, - 1114, 1462, 1462, 1011, 832, 832, 832, 832, 832, 832, - - 832, 1115, 832, 832, 832, 832, 832, 832, 832, 832, - 832, 922, 293, 922, 926, 926, 926, 926, 926, 832, - 832, 832, 832, 832, 832, 941, 1462, 977, 969, 978, - 979, 980, 406, 943, 832, 981, 942, 925, 925, 925, - 925, 925, 943, 832, 1462, 832, 925, 925, 925, 925, - 925, 943, 1462, 293, 977, 969, 978, 979, 980, 944, - 983, 984, 981, 985, 832, 947, 832, 925, 925, 925, - 925, 925, 832, 970, 832, 925, 925, 925, 925, 925, - 1462, 948, 1462, 448, 1236, 1462, 944, 983, 984, 986, - 985, 832, 947, 832, 925, 925, 925, 925, 925, 987, - - 970, 988, 989, 990, 949, 950, 1191, 832, 948, 832, - 925, 925, 925, 925, 925, 832, 986, 832, 925, 925, - 925, 925, 925, 951, 953, 1462, 987, 1462, 988, 989, - 990, 949, 950, 832, 1462, 954, 925, 925, 925, 925, - 925, 1462, 955, 952, 1462, 1462, 1462, 1462, 1462, 1462, - 951, 832, 957, 956, 925, 925, 925, 925, 925, 959, - 960, 832, 1462, 958, 925, 925, 925, 925, 925, 960, - 952, 832, 925, 925, 925, 925, 925, 991, 960, 674, - 961, 992, 993, 994, 995, 996, 997, 998, 999, 961, - 1000, 1001, 1002, 1003, 1004, 1005, 1006, 1007, 961, 1008, - - 1009, 1011, 1011, 1011, 991, 1011, 962, 1011, 992, 993, - 994, 995, 996, 997, 998, 999, 1029, 1000, 1001, 1002, - 1003, 1004, 1005, 1006, 1007, 1012, 1008, 1009, 1013, 1024, - 1026, 1028, 1014, 962, 1030, 1027, 1031, 1032, 1033, 1462, - 1462, 1048, 1462, 1029, 1049, 1052, 1015, 1053, 1011, 1011, - 1050, 1058, 1016, 1011, 1063, 1462, 1024, 1026, 1028, 1011, - 1051, 1030, 1027, 1031, 1032, 1033, 1017, 1018, 1048, 1034, - 1462, 1049, 1052, 1462, 1053, 1462, 1462, 1050, 1058, 1016, - 1054, 1063, 1035, 1046, 1011, 1462, 1055, 1051, 1462, 1462, - 1462, 1462, 1462, 1017, 1018, 1010, 1034, 1010, 1010, 1010, - - 1011, 1010, 1010, 1010, 1010, 1010, 1010, 1054, 1010, 1035, - 1046, 1056, 1047, 1055, 1010, 1010, 1010, 1010, 1010, 1010, - 1061, 1059, 1062, 1020, 1021, 1060, 1064, 1066, 1022, 1069, - 1065, 1067, 1011, 1073, 1074, 1011, 1011, 1057, 1023, 1047, - 1011, 1068, 1075, 1077, 1462, 1462, 1462, 1061, 1059, 1062, - 1020, 1021, 1060, 1064, 1066, 1022, 1069, 1065, 1067, 1462, - 1073, 1074, 1070, 1072, 1057, 1023, 1462, 1191, 1068, 1075, - 1077, 1071, 1010, 1010, 1076, 1010, 1010, 1010, 1011, 1010, - 1010, 1010, 1010, 1010, 1010, 1078, 1010, 1059, 1079, 1070, - 1072, 1060, 1010, 1010, 1010, 1010, 1010, 1010, 1071, 1080, - - 1082, 1076, 1083, 1084, 1085, 1086, 1087, 1088, 1094, 1081, - 1097, 1098, 1078, 1099, 1059, 1079, 1100, 1101, 1060, 1103, - 1104, 1105, 1106, 1462, 1462, 1462, 1080, 1082, 1462, 1083, - 1084, 1085, 1086, 1087, 1088, 1094, 1081, 1097, 1098, 1462, - 1099, 1462, 1462, 1100, 1101, 1462, 1103, 1104, 1105, 1106, - 1010, 1010, 448, 1036, 1010, 1010, 1011, 1010, 1010, 1010, - 1010, 1010, 1010, 1037, 1010, 1037, 1037, 1037, 1037, 1037, - 1010, 1010, 1010, 1010, 1010, 1010, 1037, 1037, 1038, 1039, - 1040, 1037, 1037, 1037, 1041, 1037, 1037, 1042, 1037, 1037, - 1037, 1043, 1037, 1037, 1044, 1045, 1037, 1037, 1037, 1037, - - 1037, 1037, 1037, 1037, 1037, 1038, 1039, 1040, 1037, 1037, - 1037, 1041, 1037, 1037, 1042, 1037, 1037, 1037, 1043, 1037, - 1037, 1044, 1045, 1037, 1037, 1037, 1037, 1037, 1010, 1462, - 1010, 1011, 1011, 1107, 1011, 959, 1116, 1462, 1120, 1011, - 1121, 1011, 1462, 959, 959, 1116, 1134, 1135, 1011, 1137, - 1139, 1140, 1011, 959, 1116, 1037, 1037, 1037, 1093, 1157, - 1107, 1037, 959, 1462, 1037, 1120, 1011, 1121, 1037, 1096, - 1089, 1037, 1037, 1134, 1135, 1126, 1137, 1139, 1140, 1462, - 1145, 1462, 1037, 1037, 1037, 1093, 1157, 1462, 1037, 1146, - 1108, 1037, 293, 1011, 1147, 1037, 1096, 1089, 1037, 1037, - - 1011, 1109, 1126, 1462, 1462, 1462, 1127, 1145, 1127, 1128, - 1128, 1128, 1128, 1128, 1011, 1163, 1146, 1159, 1164, 1462, - 1127, 1147, 1127, 1128, 1128, 1128, 1128, 1128, 1010, 1462, - 1010, 1010, 1010, 1011, 1010, 1010, 1010, 1010, 1010, 1010, - 1462, 1010, 1163, 1110, 1159, 1164, 1011, 1010, 1010, 1010, - 1010, 1010, 1010, 1010, 1111, 1010, 1010, 1010, 1011, 1010, - 1010, 1010, 1010, 1010, 1127, 1462, 1127, 1131, 1131, 1131, - 1131, 1131, 1010, 1010, 1010, 1010, 1010, 1010, 1010, 293, - 1010, 1130, 1130, 1130, 1130, 1130, 1010, 1011, 1010, 1130, - 1130, 1130, 1130, 1130, 406, 1143, 293, 1158, 1011, 1462, - - 1141, 1462, 1462, 1010, 1143, 1010, 1130, 1130, 1130, 1130, - 1130, 1156, 1112, 1143, 1142, 1011, 1160, 1462, 1462, 1165, - 1166, 1144, 1148, 1113, 1158, 1462, 1010, 1141, 1010, 1130, - 1130, 1130, 1130, 1130, 1114, 1462, 1462, 1011, 1156, 293, - 1167, 1142, 1462, 1160, 1149, 1115, 1165, 1166, 1144, 1148, - 1010, 1462, 1010, 1130, 1130, 1130, 1130, 1130, 1010, 1168, - 1010, 1130, 1130, 1130, 1130, 1130, 1462, 1167, 1169, 1161, - 1010, 1149, 1010, 1130, 1130, 1130, 1130, 1130, 293, 1170, - 1462, 1171, 1150, 1172, 1151, 1173, 1168, 1010, 1152, 1010, - 1130, 1130, 1130, 1130, 1130, 1169, 1161, 674, 1154, 1174, - - 1177, 1011, 1175, 1162, 1178, 1180, 1170, 1154, 1171, 1150, - 1172, 1151, 1173, 1181, 1153, 1152, 1154, 1176, 1182, 1183, - 1184, 1185, 1179, 1186, 1155, 1187, 1174, 1177, 1188, 1190, - 1162, 1191, 1180, 1462, 1204, 1462, 1192, 1462, 1462, 1193, - 1181, 1153, 1191, 1194, 1176, 1182, 1183, 1184, 1185, 1179, - 1186, 1155, 1187, 1207, 1191, 1188, 1190, 1195, 1191, 1191, - 1191, 1204, 1191, 1196, 1200, 1201, 1191, 1191, 1208, 1202, - 1191, 1191, 1206, 1212, 1228, 1209, 1213, 1197, 1198, 1203, - 1207, 1191, 1210, 1191, 1211, 1214, 1226, 1191, 1191, 1191, - 1196, 1200, 1201, 1462, 1462, 1208, 1202, 1227, 1215, 1206, - - 1212, 1228, 1209, 1213, 1197, 1198, 1203, 1233, 1229, 1210, - 1191, 1211, 1214, 1226, 1191, 1462, 1191, 1462, 1232, 1230, - 1462, 1462, 1191, 1462, 1227, 1215, 448, 1216, 1234, 1231, - 1270, 1271, 1272, 1462, 1233, 1229, 1235, 1462, 1462, 1191, - 1462, 1462, 1462, 1191, 1238, 1232, 1230, 1462, 1462, 1191, - 1462, 1462, 1218, 1219, 1220, 1234, 1231, 1462, 1221, 1191, - 1191, 1222, 1462, 1235, 1191, 1223, 1462, 1462, 1224, 1225, - 1191, 1238, 1241, 1191, 1242, 1251, 1243, 1462, 1239, 1218, - 1219, 1220, 1240, 1462, 1462, 1221, 1191, 1296, 1222, 1191, - 1246, 1462, 1223, 1462, 1462, 1224, 1225, 448, 1236, 1241, - - 1462, 1242, 1251, 1243, 1191, 1239, 1191, 1250, 1191, 1240, - 1191, 1244, 1191, 1462, 1296, 1245, 1191, 1246, 1462, 1462, - 1191, 1247, 1252, 1218, 1237, 1220, 1191, 1191, 1253, 1221, - 824, 1248, 1222, 1254, 1250, 1462, 1223, 1462, 1244, 1224, - 1225, 1191, 1245, 1191, 1462, 1191, 1256, 1462, 1247, 1252, - 1218, 1237, 1220, 1462, 1462, 1253, 1221, 824, 1248, 1222, - 1254, 1276, 1249, 1223, 1191, 1269, 1224, 1225, 1462, 1255, - 1462, 1462, 1462, 1256, 1462, 1462, 1191, 1462, 1462, 1462, - 1462, 1239, 1462, 1462, 1462, 1240, 1462, 1462, 1276, 1249, - 1462, 1462, 1269, 1191, 1462, 1462, 1255, 1191, 1462, 1191, - - 1191, 1191, 1191, 1258, 1273, 1257, 1191, 1290, 1239, 1191, - 1262, 1260, 1240, 1191, 1263, 1185, 1462, 1191, 1291, 1259, - 1325, 1261, 1462, 1462, 1265, 1191, 1462, 1462, 1264, 1191, - 1258, 1273, 1257, 1462, 1462, 1462, 1462, 1262, 1260, 1462, - 1191, 1263, 1185, 1462, 1462, 1191, 1259, 1325, 1261, 1191, - 1308, 1265, 1274, 1462, 1462, 1264, 1191, 1462, 1191, 1462, - 1462, 1462, 1462, 1462, 1462, 1266, 1191, 1278, 1462, 1462, - 1267, 1462, 1462, 1462, 1268, 1462, 1191, 1308, 1277, 1274, - 1191, 1281, 1191, 1282, 1191, 1292, 1191, 1462, 1462, 1297, - 1280, 1191, 1266, 1462, 1278, 1191, 1293, 1267, 1279, 1462, - - 1462, 1268, 1283, 1462, 1462, 1277, 1191, 1191, 1281, 1294, - 1191, 1284, 1462, 1462, 1299, 1285, 1297, 1280, 959, 959, - 1295, 1298, 1191, 1462, 1462, 1279, 1191, 1191, 959, 1283, - 1462, 1191, 1009, 1462, 1462, 1191, 1462, 959, 1284, 1462, - 1286, 1191, 1285, 1462, 1462, 1191, 1191, 1326, 1298, 1287, - 1462, 1462, 1462, 1462, 1462, 1462, 1191, 1462, 1462, 1009, - 1300, 1302, 1462, 1462, 1187, 1304, 1191, 1286, 1301, 1462, - 1462, 1462, 1288, 1191, 1326, 1191, 1287, 1191, 1462, 1462, - 1191, 1290, 1327, 1289, 1303, 1191, 1292, 1300, 1294, 1305, - 1191, 1187, 1291, 1191, 1191, 1301, 1306, 1293, 1191, 1295, - - 1462, 1191, 1312, 1191, 1309, 1462, 1462, 1462, 1191, 1327, - 1191, 1303, 1462, 1191, 1462, 217, 1305, 217, 218, 218, - 218, 218, 218, 1306, 1462, 1462, 1462, 1186, 1191, 1312, - 217, 1309, 217, 218, 218, 218, 218, 218, 1462, 1462, - 1462, 1462, 217, 1191, 217, 222, 222, 222, 222, 222, - 1462, 1462, 1462, 1462, 1186, 1191, 1462, 1462, 1462, 1462, - 1462, 1191, 1191, 1191, 1313, 1462, 1462, 1191, 1314, 1462, - 1462, 667, 1328, 1191, 1315, 1191, 1002, 1462, 1462, 1191, - 1191, 1191, 1462, 1462, 1316, 1317, 406, 406, 1191, 1188, - 293, 1313, 1191, 293, 1329, 1314, 406, 1320, 667, 1328, - - 1318, 1315, 1319, 1002, 1191, 406, 1190, 674, 674, 1191, - 293, 1316, 1317, 528, 293, 1322, 1188, 674, 1330, 1331, - 1332, 1329, 1334, 1323, 1320, 1335, 674, 1318, 1321, 1319, - 1191, 1336, 1324, 1190, 831, 1337, 1338, 1339, 1340, 1341, - 528, 1342, 1322, 1343, 1344, 1330, 1331, 1332, 1345, 1334, - 1323, 1346, 1335, 1347, 1204, 1321, 1206, 1207, 1336, 1324, - 1462, 831, 1337, 1338, 1339, 1340, 1341, 1208, 1342, 1192, - 1343, 1344, 1193, 1226, 1462, 1345, 1194, 1227, 1346, 1462, - 1347, 1204, 1462, 1206, 1207, 1462, 1200, 1201, 1209, 1462, - 1195, 1202, 1214, 1462, 1208, 1212, 1196, 1210, 1213, 1211, - - 1226, 1203, 1462, 1228, 1227, 1215, 1462, 1216, 1462, 1234, - 1197, 1198, 1462, 1200, 1201, 1209, 1232, 1230, 1202, 1214, - 1462, 1229, 1212, 1196, 1210, 1213, 1211, 1231, 1203, 1462, - 1228, 1235, 1215, 1219, 1462, 1462, 1234, 1197, 1198, 1250, - 1233, 1462, 1462, 1232, 1230, 1462, 1462, 1462, 1229, 1462, - 1462, 1462, 1462, 1462, 1231, 1462, 1462, 1462, 1235, 1462, - 1219, 1251, 1462, 1462, 1462, 1238, 1250, 1233, 1462, 1252, - 1462, 1462, 1462, 1239, 1462, 1253, 1462, 1240, 1462, 1462, - 1243, 1256, 1254, 1244, 1241, 1462, 1242, 1245, 1251, 1462, - 1462, 1462, 1238, 1462, 1246, 1462, 1252, 1462, 1462, 1269, - - 1239, 1462, 1253, 1255, 1240, 1273, 1249, 1243, 1256, 1254, - 1244, 1241, 1462, 1242, 1245, 448, 1236, 1247, 1462, 1462, - 1462, 1246, 1462, 1462, 1462, 1462, 1269, 1248, 1462, 1462, - 1255, 1276, 1273, 1249, 1462, 1462, 1462, 1462, 1462, 1462, - 1462, 1462, 1462, 1462, 1247, 1462, 1239, 1462, 1462, 1462, - 1240, 1462, 1298, 1258, 1248, 1462, 1462, 1257, 1276, 1462, - 1462, 1462, 1462, 1462, 1462, 1462, 1262, 1274, 1260, 1312, - 1259, 1462, 1263, 1239, 1351, 1462, 1462, 1240, 1261, 1298, - 1258, 1462, 1462, 1462, 1257, 293, 1462, 1462, 1462, 1462, - 1462, 1462, 1462, 1262, 1274, 1260, 1312, 1259, 1462, 1263, - - 1462, 1351, 1264, 1357, 1462, 1261, 1266, 1462, 1462, 1462, - 1462, 1265, 1462, 1462, 1462, 1462, 1462, 1462, 1462, 1267, - 1462, 1462, 1462, 1278, 1277, 1308, 1462, 1462, 1268, 1264, - 1357, 1462, 1462, 1266, 1462, 1462, 1462, 1282, 1265, 1462, - 1462, 1462, 214, 1462, 1358, 1280, 1267, 1279, 1281, 1462, - 1278, 1277, 1308, 1462, 1462, 1268, 1462, 1462, 1462, 1462, - 1462, 1462, 1462, 1462, 1462, 1462, 1462, 1296, 1462, 1462, - 1462, 1358, 1280, 1283, 1279, 1281, 1462, 1297, 1348, 1462, - 1299, 1285, 1462, 1284, 1462, 1309, 1462, 1462, 1462, 1462, - 1462, 1462, 1462, 1462, 1296, 1462, 1462, 1359, 1462, 1462, - - 1283, 1287, 1286, 1462, 1297, 1348, 1462, 1360, 1285, 1302, - 1284, 1462, 1309, 1462, 1462, 1462, 1462, 1462, 1462, 1462, - 1462, 1462, 1462, 1462, 1359, 1300, 1462, 1304, 1287, 1286, - 1301, 1462, 1462, 1462, 1360, 1462, 1462, 1462, 214, 1462, - 1462, 1462, 1462, 1462, 1462, 1462, 1303, 1462, 1462, 1462, - 1462, 1305, 1300, 1462, 1462, 1462, 1361, 1301, 1306, 1462, - 1462, 1462, 1462, 1462, 1462, 1462, 1462, 1462, 1462, 1313, - 1462, 1350, 1462, 1303, 1462, 1314, 1462, 1315, 1305, 1362, - 1363, 1316, 1462, 1361, 1462, 1306, 1364, 1462, 1317, 1462, - 1462, 1462, 1462, 1462, 1462, 1320, 1313, 1462, 1350, 1462, - - 1462, 1319, 1314, 1318, 1315, 214, 1362, 1363, 1316, 1462, - 1462, 1462, 1462, 1364, 1462, 1317, 1462, 1365, 1462, 1462, - 1462, 1462, 1320, 1462, 1462, 1367, 1462, 1462, 1319, 1352, - 1318, 1368, 1462, 1369, 1462, 1366, 1366, 1370, 1371, 1349, - 1354, 1462, 1372, 1462, 1365, 1366, 1462, 214, 1355, 1462, - 1375, 1462, 1367, 1356, 1366, 1380, 1352, 1353, 1368, 1462, - 1369, 1381, 1462, 1462, 1370, 1371, 214, 1354, 1462, 1372, - 1462, 1377, 1462, 1462, 214, 1355, 1382, 1375, 1462, 1462, - 1356, 1374, 1380, 1373, 1353, 1462, 1462, 1462, 1381, 1383, - 1384, 1385, 1387, 1462, 1388, 1462, 1366, 1366, 1389, 1376, - - 1390, 1462, 1392, 1382, 1378, 1462, 1366, 1391, 1374, 1462, - 1373, 1394, 1393, 1462, 1462, 1366, 1383, 1384, 1385, 1387, - 1397, 1388, 1462, 1462, 1398, 1389, 1376, 1390, 1399, 1392, - 1400, 1378, 1386, 214, 1391, 1401, 1462, 1402, 1394, 1393, - 1403, 1404, 1405, 1406, 1407, 1462, 1409, 1397, 214, 1411, - 1462, 1398, 1414, 1415, 1416, 1399, 1418, 1400, 1395, 1386, - 1396, 214, 1401, 1408, 1402, 1462, 1462, 1403, 1404, 1405, - 1406, 1407, 1419, 1409, 1420, 1410, 1411, 1462, 1462, 1414, - 1415, 1416, 1421, 1418, 1422, 1395, 1423, 1396, 1462, 1424, - 1408, 1428, 214, 1412, 1462, 1462, 1431, 1425, 1462, 1419, - - 1462, 1420, 1410, 1462, 1462, 1433, 1434, 1435, 1436, 1421, - 1437, 1422, 1438, 1423, 1413, 1439, 1424, 1462, 1428, 214, - 1412, 214, 1443, 1431, 1425, 1427, 1462, 1462, 1462, 1445, - 1430, 1429, 1433, 1434, 1435, 1436, 1446, 1437, 1447, 1438, - 1448, 1413, 1439, 1462, 1462, 406, 406, 1449, 214, 1443, - 1462, 1462, 1427, 1442, 1440, 406, 1445, 1430, 1429, 1366, - 1366, 214, 1453, 1446, 406, 1447, 1462, 1448, 1455, 1366, - 1444, 1462, 1462, 1456, 1449, 1458, 1462, 1462, 1366, 1459, - 1442, 1440, 1462, 1462, 1461, 1462, 1462, 1462, 1450, 1453, - 1462, 1462, 1462, 1462, 1462, 1455, 1462, 1444, 1452, 1462, - - 1456, 1462, 1458, 1454, 1462, 1462, 1459, 1462, 1462, 1462, - 1462, 1461, 1462, 1462, 1457, 1450, 1462, 1462, 1462, 1460, - 1462, 1462, 1462, 1462, 1462, 1452, 1462, 1462, 1462, 1462, - 1454, 1462, 1462, 1462, 1462, 1462, 1462, 1462, 1462, 1462, - 1462, 1457, 1462, 1462, 1462, 1462, 1460, 90, 90, 90, - 90, 90, 90, 90, 90, 90, 90, 90, 132, 132, - 132, 132, 132, 132, 132, 132, 132, 132, 132, 79, - 79, 79, 79, 79, 79, 79, 79, 79, 79, 79, - 210, 210, 210, 210, 210, 210, 210, 210, 210, 210, - 210, 213, 1462, 213, 213, 213, 213, 213, 213, 213, - - 213, 213, 215, 1462, 215, 215, 215, 215, 215, 215, - 215, 215, 215, 221, 221, 221, 221, 1462, 221, 233, - 1462, 233, 233, 233, 233, 233, 233, 233, 233, 233, - 241, 1462, 241, 241, 241, 241, 241, 241, 241, 241, - 241, 243, 1462, 243, 243, 243, 243, 243, 243, 243, - 243, 243, 248, 1462, 248, 248, 248, 248, 248, 248, - 248, 248, 248, 254, 1462, 254, 254, 254, 254, 254, - 254, 254, 254, 254, 271, 1462, 271, 271, 271, 271, - 271, 271, 271, 271, 271, 273, 1462, 273, 273, 273, - 273, 273, 273, 273, 273, 273, 277, 277, 277, 277, - - 1462, 277, 283, 1462, 283, 283, 283, 283, 283, 283, - 283, 283, 283, 285, 1462, 285, 285, 285, 285, 285, - 285, 285, 285, 285, 289, 289, 289, 289, 1462, 289, - 305, 1462, 305, 305, 305, 305, 305, 305, 305, 305, - 305, 307, 1462, 307, 307, 307, 307, 307, 307, 307, - 307, 307, 311, 311, 311, 311, 1462, 311, 319, 1462, - 319, 319, 319, 319, 319, 319, 319, 319, 319, 321, - 1462, 321, 321, 321, 321, 321, 321, 321, 321, 321, - 325, 325, 325, 325, 1462, 325, 334, 1462, 334, 334, - 334, 334, 334, 334, 334, 334, 334, 336, 1462, 336, - - 336, 336, 336, 336, 336, 336, 336, 336, 337, 1462, - 337, 337, 1462, 337, 337, 337, 337, 337, 337, 341, - 341, 341, 1462, 341, 355, 1462, 355, 355, 355, 355, - 355, 355, 355, 355, 355, 357, 1462, 357, 357, 357, - 357, 357, 357, 357, 357, 357, 358, 1462, 358, 358, - 1462, 358, 358, 358, 358, 358, 358, 362, 362, 362, - 1462, 362, 370, 1462, 370, 370, 370, 370, 370, 370, - 370, 370, 370, 372, 1462, 372, 372, 372, 372, 372, - 372, 372, 372, 372, 376, 376, 376, 376, 1462, 376, - 391, 1462, 391, 391, 391, 391, 391, 391, 391, 391, - - 391, 393, 1462, 393, 393, 393, 393, 393, 393, 393, - 393, 393, 398, 398, 1462, 1462, 1462, 1462, 398, 1462, - 398, 399, 1462, 399, 399, 399, 399, 399, 399, 399, - 399, 399, 401, 1462, 401, 401, 401, 401, 401, 401, - 401, 401, 401, 213, 1462, 213, 213, 213, 213, 213, - 213, 213, 213, 213, 215, 1462, 215, 215, 215, 215, - 215, 215, 215, 215, 215, 402, 1462, 402, 402, 402, - 402, 402, 402, 402, 402, 402, 221, 1462, 221, 1462, - 221, 413, 1462, 413, 413, 413, 413, 413, 413, 413, - 413, 413, 421, 1462, 421, 421, 421, 421, 421, 421, - - 421, 421, 421, 431, 1462, 431, 431, 431, 431, 431, - 431, 431, 431, 431, 438, 1462, 438, 438, 438, 438, - 438, 438, 438, 438, 438, 439, 1462, 439, 439, 439, - 439, 439, 439, 439, 439, 439, 445, 1462, 445, 445, - 445, 445, 445, 445, 445, 445, 445, 271, 1462, 271, - 271, 271, 271, 271, 271, 271, 271, 271, 273, 1462, - 273, 273, 273, 273, 273, 273, 273, 273, 273, 277, - 1462, 277, 1462, 277, 283, 1462, 283, 283, 283, 283, - 283, 283, 283, 283, 283, 285, 1462, 285, 285, 285, - 285, 285, 285, 285, 285, 285, 289, 289, 289, 1462, - - 289, 476, 476, 476, 476, 1462, 476, 305, 1462, 305, - 305, 305, 305, 305, 305, 305, 305, 305, 307, 1462, - 307, 307, 307, 307, 307, 307, 307, 307, 307, 311, - 1462, 311, 1462, 311, 319, 1462, 319, 319, 319, 319, - 319, 319, 319, 319, 319, 321, 1462, 321, 321, 321, - 321, 321, 321, 321, 321, 321, 325, 1462, 325, 1462, - 325, 334, 1462, 334, 334, 334, 334, 334, 334, 334, - 334, 334, 336, 1462, 336, 336, 336, 336, 336, 336, - 336, 336, 336, 337, 1462, 337, 337, 1462, 337, 337, - 337, 337, 337, 337, 341, 1462, 341, 1462, 341, 355, - - 1462, 355, 355, 355, 355, 355, 355, 355, 355, 355, - 357, 1462, 357, 357, 357, 357, 357, 357, 357, 357, - 357, 358, 1462, 358, 358, 1462, 358, 358, 358, 358, - 358, 358, 362, 1462, 362, 1462, 362, 370, 1462, 370, - 370, 370, 370, 370, 370, 370, 370, 370, 372, 1462, - 372, 372, 372, 372, 372, 372, 372, 372, 372, 376, - 1462, 376, 1462, 376, 391, 1462, 391, 391, 391, 391, - 391, 391, 391, 391, 391, 393, 1462, 393, 393, 393, - 393, 393, 393, 393, 393, 393, 398, 398, 1462, 1462, - 1462, 1462, 398, 1462, 398, 399, 1462, 399, 399, 399, - - 399, 399, 399, 399, 399, 399, 401, 1462, 401, 401, - 401, 401, 401, 401, 401, 401, 401, 402, 1462, 402, - 402, 402, 402, 402, 402, 402, 402, 402, 221, 1462, - 221, 1462, 221, 536, 1462, 536, 536, 536, 536, 536, - 536, 536, 536, 536, 544, 1462, 544, 544, 544, 544, - 544, 544, 544, 544, 544, 574, 1462, 574, 574, 574, - 574, 574, 574, 574, 574, 574, 581, 1462, 581, 581, - 581, 581, 581, 581, 581, 581, 581, 582, 1462, 582, - 582, 582, 582, 582, 582, 582, 582, 582, 588, 1462, - 588, 588, 588, 588, 588, 588, 588, 588, 588, 277, - - 1462, 277, 1462, 277, 476, 476, 476, 1462, 476, 289, - 289, 289, 1462, 289, 325, 1462, 325, 1462, 325, 341, - 1462, 341, 1462, 341, 362, 1462, 362, 1462, 362, 675, - 1462, 675, 675, 675, 675, 675, 675, 675, 675, 675, - 683, 1462, 683, 683, 683, 683, 683, 683, 683, 683, - 683, 737, 1462, 737, 737, 737, 737, 737, 737, 737, - 737, 737, 742, 1462, 742, 742, 742, 742, 742, 742, - 742, 742, 742, 743, 1462, 743, 743, 743, 743, 743, - 743, 743, 743, 743, 748, 1462, 748, 748, 748, 748, - 748, 748, 748, 748, 748, 832, 1462, 832, 832, 832, - - 832, 832, 832, 832, 832, 832, 840, 1462, 840, 840, - 840, 840, 840, 840, 840, 840, 840, 915, 1462, 915, - 915, 915, 915, 915, 915, 915, 915, 915, 919, 1462, - 919, 919, 919, 919, 919, 919, 919, 919, 919, 920, - 1462, 920, 920, 920, 920, 920, 920, 920, 920, 920, - 925, 1462, 925, 925, 925, 925, 925, 925, 925, 925, - 925, 1010, 1462, 1010, 1010, 1010, 1010, 1010, 1010, 1010, - 1010, 1010, 1019, 1462, 1019, 1019, 1019, 1019, 1019, 1019, - 1019, 1019, 1019, 1117, 1462, 1117, 1117, 1117, 1117, 1117, - 1117, 1117, 1117, 1117, 1122, 1462, 1122, 1122, 1122, 1122, - - 1122, 1122, 1122, 1122, 1122, 1124, 1462, 1124, 1124, 1124, - 1124, 1124, 1124, 1124, 1124, 1124, 1130, 1462, 1130, 1130, - 1130, 1130, 1130, 1130, 1130, 1130, 1130, 1199, 1462, 1199, - 1199, 1217, 1217, 1462, 1462, 1462, 1217, 1462, 1217, 1217, - 213, 1462, 213, 213, 213, 213, 213, 213, 213, 213, - 213, 215, 1462, 215, 215, 215, 215, 215, 215, 215, - 215, 215, 402, 1462, 402, 402, 402, 402, 402, 402, - 402, 402, 402, 31, 1462, 1462, 1462, 1462, 1462, 1462, - 1462, 1462, 1462, 1462, 1462, 1462, 1462, 1462, 1462, 1462, - 1462, 1462, 1462, 1462, 1462, 1462, 1462, 1462, 1462, 1462, - - 1462, 1462, 1462, 1462, 1462, 1462, 1462, 1462, 1462, 1462, - 1462, 1462, 1462, 1462, 1462, 1462, 1462, 1462, 1462, 1462, - 1462, 1462, 1462, 1462, 1462, 1462, 1462, 1462, 1462, 1462, - 1462, 1462, 1462, 1462, 1462, 1462, 1462, 1462, 1462, 1462, - 1462, 1462, 1462, 1462, 1462, 1462, 1462, 1462, 1462, 1462, - 1462, 1462 - } ; - -static const flex_int16_t yy_chk[7353] = - { 0, - 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, - 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, - 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, - 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, - 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, - 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, - 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, - 1, 1, 1, 1, 1, 1, 1, 1, 2, 2, - 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, - 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, - - 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, - 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, - 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, - 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, - 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, - 2, 2, 2, 2, 2, 2, 3, 3, 3, 3, - 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, - 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, - 3, 202, 13, 3, 13, 3, 40, 1452, 40, 40, - 40, 40, 40, 40, 13, 25, 25, 25, 13, 3, - - 25, 45, 45, 25, 46, 25, 46, 25, 202, 13, - 3, 13, 3, 42, 25, 42, 42, 42, 42, 42, - 42, 13, 67, 67, 1451, 13, 3, 4, 4, 4, - 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, - 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, - 4, 4, 1426, 14, 4, 14, 4, 43, 1450, 43, - 43, 43, 43, 43, 43, 14, 26, 26, 26, 14, - 4, 26, 1426, 90, 26, 90, 26, 111, 26, 111, - 14, 4, 14, 4, 44, 26, 44, 44, 44, 44, - 44, 44, 14, 107, 107, 1441, 14, 4, 5, 5, - - 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, - 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, - 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, - 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, - 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, - 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, - 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, - 5, 5, 5, 5, 5, 5, 7, 7, 7, 7, - 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, - 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, - - 7, 8, 8, 8, 8, 8, 8, 8, 8, 8, - 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, - 8, 8, 8, 8, 8, 8, 9, 1416, 9, 9, - 81, 21, 9, 21, 22, 23, 22, 23, 24, 81, - 24, 112, 9, 112, 53, 9, 53, 21, 81, 643, - 22, 23, 643, 9, 24, 9, 9, 1409, 21, 9, - 21, 22, 23, 22, 23, 24, 53, 24, 112, 9, - 41, 41, 9, 10, 21, 10, 10, 22, 23, 10, - 41, 24, 41, 41, 41, 41, 41, 41, 1400, 10, - 130, 130, 10, 53, 132, 112, 132, 144, 924, 144, - - 10, 924, 10, 10, 1377, 62, 10, 62, 62, 62, - 62, 62, 62, 186, 186, 189, 10, 189, 1359, 10, - 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, - 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, - 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, - 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, - 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, - 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, - 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, - 11, 11, 11, 11, 11, 11, 11, 11, 15, 15, - - 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, - 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, - 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, - 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, - 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, - 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, - 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, - 15, 15, 15, 15, 15, 15, 17, 17, 17, 17, - 17, 17, 17, 17, 17, 17, 17, 17, 17, 17, - 17, 17, 17, 17, 17, 17, 17, 17, 17, 17, - - 17, 17, 17, 17, 17, 17, 17, 17, 17, 17, - 17, 17, 17, 17, 17, 17, 17, 17, 17, 17, - 17, 17, 17, 17, 17, 17, 17, 17, 17, 17, - 17, 17, 17, 17, 17, 17, 17, 17, 17, 17, - 17, 17, 17, 17, 17, 17, 17, 17, 17, 17, - 17, 17, 17, 17, 19, 19, 19, 19, 19, 19, - 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, - 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, - 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, - 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, - - 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, - 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, - 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, - 19, 19, 27, 27, 47, 48, 47, 48, 1075, 49, - 27, 49, 27, 51, 27, 51, 50, 52, 50, 52, - 1075, 27, 110, 48, 110, 61, 49, 48, 93, 61, - 93, 51, 47, 591, 591, 52, 49, 27, 27, 27, - 161, 293, 1357, 293, 27, 720, 720, 50, 55, 836, - 48, 55, 161, 49, 48, 55, 61, 1324, 51, 47, - 110, 93, 52, 49, 27, 27, 27, 836, 92, 55, - - 92, 27, 28, 28, 50, 55, 91, 160, 91, 161, - 28, 109, 28, 109, 28, 164, 162, 110, 93, 55, - 55, 28, 65, 178, 65, 65, 65, 65, 65, 65, - 1117, 164, 55, 160, 91, 92, 109, 28, 28, 28, - 63, 63, 162, 178, 28, 1323, 55, 55, 877, 877, - 63, 1117, 63, 63, 63, 63, 63, 63, 164, 1321, - 160, 91, 92, 109, 28, 28, 28, 919, 919, 162, - 178, 28, 29, 29, 29, 29, 29, 29, 29, 29, - 29, 29, 29, 29, 29, 29, 29, 915, 117, 915, - 117, 29, 29, 29, 29, 29, 29, 69, 1129, 69, - - 69, 69, 69, 69, 69, 152, 152, 152, 152, 152, - 152, 70, 1309, 70, 70, 70, 70, 70, 70, 115, - 1129, 115, 117, 29, 30, 30, 30, 30, 30, 30, - 30, 30, 30, 30, 30, 30, 30, 30, 30, 70, - 735, 735, 735, 30, 30, 30, 30, 30, 30, 117, - 115, 72, 1119, 72, 72, 72, 72, 72, 72, 153, - 153, 153, 153, 153, 153, 85, 70, 85, 85, 85, - 85, 85, 85, 1119, 72, 30, 57, 115, 57, 57, - 57, 57, 57, 57, 57, 57, 57, 57, 114, 57, - 114, 1254, 135, 1233, 135, 57, 57, 57, 57, 57, - - 57, 72, 165, 203, 57, 57, 135, 114, 74, 57, - 74, 74, 74, 74, 74, 74, 1269, 270, 87, 57, - 87, 87, 87, 87, 87, 87, 270, 1269, 165, 86, - 203, 57, 57, 135, 114, 270, 57, 1232, 86, 74, - 86, 86, 86, 86, 86, 86, 57, 86, 343, 343, - 343, 343, 343, 57, 64, 165, 64, 64, 64, 64, - 64, 64, 64, 64, 64, 64, 74, 64, 64, 64, - 64, 64, 64, 64, 64, 64, 64, 64, 64, 66, - 1216, 66, 66, 66, 66, 66, 66, 66, 66, 66, - 66, 163, 66, 66, 66, 66, 66, 66, 66, 66, - - 66, 66, 66, 66, 71, 1212, 71, 71, 71, 71, - 71, 71, 73, 1151, 73, 73, 73, 73, 73, 73, - 204, 118, 71, 118, 163, 1151, 71, 205, 75, 73, - 75, 75, 75, 75, 75, 75, 175, 1199, 88, 73, - 88, 88, 88, 88, 88, 88, 75, 204, 134, 71, - 134, 163, 118, 71, 205, 175, 73, 76, 176, 76, - 76, 76, 76, 76, 76, 77, 73, 77, 77, 77, - 77, 77, 77, 75, 143, 76, 143, 224, 225, 118, - 134, 76, 175, 927, 176, 226, 927, 77, 78, 1195, - 78, 78, 78, 78, 78, 78, 154, 154, 154, 154, - - 154, 154, 76, 1174, 224, 225, 143, 134, 76, 1158, - 78, 176, 226, 89, 77, 89, 89, 89, 89, 89, - 89, 102, 1153, 102, 102, 102, 102, 102, 102, 103, - 103, 1015, 1015, 143, 191, 1152, 191, 78, 116, 103, - 116, 103, 103, 103, 103, 103, 103, 104, 1150, 104, - 104, 104, 104, 104, 104, 105, 116, 105, 105, 105, - 105, 105, 105, 106, 191, 106, 106, 106, 106, 106, - 106, 113, 125, 113, 125, 125, 125, 125, 125, 125, - 126, 126, 1149, 116, 1130, 113, 228, 229, 1089, 113, - 126, 191, 126, 126, 126, 126, 126, 126, 127, 1089, - - 127, 127, 127, 127, 127, 127, 145, 1125, 145, 133, - 1089, 133, 113, 228, 229, 128, 113, 128, 128, 128, - 128, 128, 128, 129, 1124, 129, 129, 129, 129, 129, - 129, 133, 230, 231, 145, 232, 236, 133, 139, 138, - 133, 138, 138, 138, 138, 138, 138, 139, 238, 139, - 139, 139, 139, 139, 139, 1118, 139, 1116, 133, 230, - 231, 145, 232, 236, 133, 1122, 140, 133, 140, 140, - 140, 140, 140, 140, 141, 238, 141, 141, 141, 141, - 141, 141, 142, 1122, 142, 142, 142, 142, 142, 142, - 146, 147, 146, 147, 148, 166, 148, 155, 155, 155, - - 155, 155, 155, 157, 159, 147, 177, 239, 190, 146, - 190, 240, 166, 148, 244, 245, 159, 245, 157, 246, - 247, 148, 279, 177, 280, 146, 190, 314, 315, 316, - 159, 177, 147, 157, 239, 1115, 146, 1132, 240, 166, - 148, 244, 245, 159, 245, 157, 246, 247, 148, 279, - 177, 280, 146, 190, 314, 315, 316, 159, 177, 1132, - 157, 170, 170, 170, 170, 170, 170, 171, 171, 171, - 171, 171, 171, 172, 172, 172, 172, 172, 172, 173, - 173, 173, 173, 173, 173, 181, 182, 181, 181, 181, - 181, 181, 181, 1113, 194, 182, 194, 182, 182, 182, - - 182, 182, 182, 183, 182, 183, 183, 183, 183, 183, - 183, 184, 194, 184, 184, 184, 184, 184, 184, 185, - 294, 185, 185, 185, 185, 185, 185, 192, 193, 192, - 193, 195, 196, 195, 196, 197, 198, 197, 198, 194, - 217, 1111, 217, 217, 217, 217, 217, 217, 250, 281, - 294, 297, 281, 197, 298, 318, 328, 198, 192, 195, - 193, 250, 329, 196, 198, 218, 298, 218, 218, 218, - 218, 218, 218, 1109, 1074, 250, 281, 294, 1054, 281, - 197, 297, 318, 328, 198, 192, 195, 193, 250, 329, - 196, 198, 222, 298, 222, 222, 222, 222, 222, 222, - - 227, 227, 234, 1053, 301, 234, 300, 1123, 297, 234, - 227, 251, 302, 251, 251, 251, 251, 251, 251, 227, - 1052, 299, 1032, 234, 1019, 1123, 300, 330, 227, 234, - 252, 301, 252, 252, 252, 252, 252, 252, 299, 302, - 331, 332, 344, 234, 234, 274, 345, 274, 274, 274, - 274, 274, 274, 300, 330, 227, 234, 258, 301, 258, - 258, 258, 258, 258, 258, 299, 302, 331, 332, 344, - 234, 234, 235, 345, 235, 235, 235, 235, 235, 235, - 235, 235, 235, 235, 1011, 235, 258, 303, 1010, 346, - 348, 235, 235, 235, 235, 235, 235, 1006, 960, 303, - - 235, 235, 347, 347, 259, 235, 259, 259, 259, 259, - 259, 259, 349, 258, 351, 235, 346, 348, 267, 259, - 267, 267, 267, 267, 267, 267, 303, 235, 235, 347, - 347, 260, 235, 260, 260, 260, 260, 260, 260, 349, - 267, 351, 235, 1251, 1251, 1251, 259, 350, 352, 235, - 243, 1270, 243, 243, 243, 243, 243, 243, 243, 243, - 243, 243, 1270, 243, 958, 350, 260, 267, 353, 243, - 243, 243, 243, 243, 243, 352, 261, 956, 261, 261, - 261, 261, 261, 261, 268, 954, 268, 268, 268, 268, - 268, 268, 350, 260, 261, 353, 354, 263, 365, 263, - - 263, 263, 263, 263, 263, 275, 942, 275, 275, 275, - 275, 275, 275, 263, 1255, 366, 367, 268, 369, 381, - 934, 261, 932, 354, 928, 365, 1255, 243, 254, 920, - 254, 254, 254, 254, 254, 254, 254, 254, 254, 254, - 263, 254, 366, 367, 268, 369, 381, 254, 254, 254, - 254, 254, 254, 255, 1271, 255, 255, 255, 255, 255, - 255, 255, 255, 255, 255, 1271, 255, 255, 255, 255, - 255, 255, 255, 255, 255, 255, 255, 255, 257, 257, - 257, 257, 257, 257, 257, 257, 257, 257, 257, 257, - 257, 257, 257, 257, 257, 257, 257, 257, 257, 257, - - 257, 257, 257, 257, 257, 257, 257, 257, 257, 257, - 257, 257, 257, 257, 257, 257, 257, 257, 257, 257, - 257, 257, 257, 257, 257, 257, 257, 257, 257, 257, - 257, 257, 257, 257, 257, 257, 257, 257, 257, 257, - 257, 257, 257, 257, 257, 257, 257, 257, 257, 257, - 257, 257, 257, 257, 257, 257, 262, 262, 264, 916, - 264, 264, 264, 264, 264, 264, 262, 382, 262, 262, - 262, 262, 262, 262, 265, 262, 265, 265, 265, 265, - 265, 265, 903, 896, 262, 266, 264, 266, 266, 266, - 266, 266, 266, 269, 382, 269, 269, 269, 269, 269, - - 269, 266, 1308, 265, 1272, 276, 364, 364, 364, 364, - 364, 262, 875, 264, 276, 1272, 276, 276, 276, 276, - 276, 276, 832, 276, 1308, 801, 269, 1288, 266, 278, - 265, 278, 278, 278, 278, 278, 278, 286, 1288, 286, - 286, 286, 286, 286, 286, 287, 756, 287, 287, 287, - 287, 287, 287, 269, 290, 750, 290, 290, 290, 290, - 290, 290, 291, 747, 291, 291, 291, 291, 291, 291, - 308, 742, 308, 308, 308, 308, 308, 308, 309, 741, - 309, 309, 309, 309, 309, 309, 312, 737, 312, 312, - 312, 312, 312, 312, 322, 679, 322, 322, 322, 322, - - 322, 322, 323, 324, 323, 323, 323, 323, 323, 323, - 625, 624, 324, 590, 324, 324, 324, 324, 324, 324, - 326, 324, 326, 326, 326, 326, 326, 326, 339, 339, - 339, 339, 339, 339, 340, 340, 340, 340, 340, 340, - 342, 342, 342, 342, 342, 342, 360, 360, 360, 360, - 360, 360, 361, 361, 361, 361, 361, 361, 363, 363, - 363, 363, 363, 363, 373, 587, 373, 373, 373, 373, - 373, 373, 374, 375, 374, 374, 374, 374, 374, 374, - 383, 385, 375, 386, 375, 375, 375, 375, 375, 375, - 377, 375, 377, 377, 377, 377, 377, 377, 388, 389, - - 394, 395, 396, 396, 397, 403, 404, 383, 385, 396, - 386, 405, 407, 408, 409, 410, 411, 581, 409, 412, - 416, 574, 418, 419, 540, 388, 389, 394, 395, 396, - 396, 397, 403, 404, 406, 406, 396, 420, 405, 407, - 408, 409, 410, 411, 406, 409, 412, 416, 414, 418, - 419, 414, 422, 406, 423, 414, 423, 424, 425, 426, - 428, 406, 481, 476, 420, 429, 430, 433, 434, 414, - 435, 437, 426, 440, 441, 414, 447, 449, 434, 422, - 1290, 423, 444, 423, 424, 425, 426, 428, 406, 414, - 414, 1290, 429, 430, 433, 434, 438, 435, 437, 426, - - 440, 441, 414, 449, 442, 434, 442, 442, 442, 442, - 442, 442, 431, 417, 401, 399, 414, 414, 415, 393, - 415, 415, 415, 415, 415, 415, 415, 415, 415, 415, - 449, 415, 451, 453, 391, 453, 454, 415, 415, 415, - 415, 415, 415, 456, 452, 455, 415, 415, 452, 455, - 443, 415, 443, 443, 443, 443, 443, 443, 458, 451, - 453, 415, 453, 454, 472, 473, 474, 372, 370, 1292, - 456, 452, 455, 415, 415, 452, 455, 358, 415, 910, - 1292, 475, 910, 357, 457, 458, 478, 355, 415, 337, - 910, 472, 473, 474, 457, 415, 421, 336, 421, 421, - - 421, 421, 421, 421, 421, 421, 421, 421, 475, 421, - 479, 457, 478, 463, 463, 421, 421, 421, 421, 421, - 421, 457, 461, 463, 461, 461, 461, 461, 461, 461, - 480, 477, 463, 477, 477, 477, 477, 477, 477, 478, - 463, 479, 486, 487, 461, 480, 535, 535, 585, 334, - 585, 585, 585, 585, 585, 585, 535, 586, 321, 586, - 586, 586, 586, 586, 586, 535, 319, 463, 479, 486, - 487, 461, 480, 421, 427, 427, 427, 427, 427, 427, - 427, 427, 427, 427, 427, 427, 427, 427, 427, 427, - 427, 427, 427, 427, 427, 427, 427, 427, 427, 427, - - 427, 427, 427, 427, 427, 427, 427, 427, 427, 427, - 427, 427, 427, 427, 427, 427, 427, 427, 427, 427, - 427, 427, 427, 427, 427, 427, 427, 427, 427, 427, - 427, 427, 427, 427, 427, 427, 427, 427, 427, 427, - 427, 427, 427, 427, 427, 427, 427, 427, 427, 427, - 427, 427, 445, 482, 445, 445, 445, 445, 445, 445, - 445, 445, 445, 445, 307, 445, 1037, 1037, 305, 304, - 296, 445, 445, 445, 445, 445, 445, 446, 482, 446, - 446, 446, 446, 446, 446, 446, 446, 446, 446, 1037, - 446, 446, 446, 446, 446, 446, 446, 446, 446, 446, - - 446, 446, 450, 450, 459, 482, 459, 459, 459, 459, - 459, 459, 460, 484, 460, 460, 460, 460, 460, 460, - 462, 488, 462, 462, 462, 462, 462, 462, 450, 450, - 450, 489, 490, 492, 450, 493, 462, 450, 496, 497, - 484, 450, 459, 498, 450, 450, 460, 464, 488, 464, - 464, 464, 464, 464, 464, 450, 450, 450, 489, 490, - 492, 450, 493, 462, 450, 496, 497, 484, 450, 459, - 498, 450, 450, 460, 464, 465, 295, 465, 465, 465, - 465, 465, 465, 466, 289, 466, 466, 466, 466, 466, - 466, 467, 285, 467, 467, 467, 467, 467, 467, 466, - - 465, 464, 468, 466, 468, 468, 468, 468, 468, 468, - 483, 485, 283, 1294, 282, 469, 467, 469, 469, 469, - 469, 469, 469, 495, 1294, 273, 466, 465, 499, 500, - 466, 485, 271, 483, 470, 468, 470, 470, 470, 470, - 470, 470, 501, 467, 469, 471, 502, 471, 471, 471, - 471, 471, 471, 495, 495, 499, 500, 503, 485, 470, - 483, 504, 468, 505, 506, 508, 471, 509, 511, 501, - 512, 469, 513, 502, 514, 515, 518, 519, 521, 522, - 495, 495, 523, 524, 503, 526, 470, 527, 504, 528, - 505, 506, 508, 471, 509, 511, 529, 512, 530, 513, - - 531, 514, 515, 518, 519, 521, 522, 532, 533, 523, - 524, 534, 526, 539, 527, 537, 528, 541, 537, 542, - 543, 545, 537, 529, 546, 530, 546, 531, 547, 256, - 253, 548, 549, 551, 532, 533, 537, 552, 534, 553, - 539, 554, 537, 556, 541, 549, 542, 543, 545, 558, - 559, 546, 560, 546, 563, 547, 537, 537, 548, 549, - 551, 248, 911, 241, 552, 911, 553, 237, 554, 537, - 556, 561, 549, 911, 566, 568, 558, 559, 223, 560, - 220, 563, 215, 537, 537, 538, 213, 538, 538, 538, - 538, 538, 538, 538, 538, 538, 538, 561, 538, 564, - - 555, 566, 568, 564, 538, 538, 538, 538, 538, 538, - 555, 569, 567, 538, 538, 565, 567, 565, 538, 570, - 571, 569, 572, 573, 561, 576, 564, 555, 538, 577, - 564, 578, 584, 593, 594, 212, 209, 555, 569, 567, - 538, 538, 565, 567, 565, 538, 570, 571, 569, 572, - 573, 595, 576, 597, 596, 538, 577, 208, 578, 584, - 593, 594, 538, 544, 596, 544, 544, 544, 544, 544, - 544, 544, 544, 544, 544, 592, 544, 599, 595, 592, - 597, 596, 544, 544, 544, 544, 544, 544, 600, 601, - 602, 596, 603, 604, 605, 610, 605, 605, 605, 605, - - 605, 605, 592, 200, 599, 617, 592, 617, 617, 617, - 617, 617, 617, 619, 619, 600, 601, 602, 199, 603, - 604, 188, 610, 619, 180, 619, 619, 619, 619, 619, - 619, 745, 619, 745, 745, 745, 745, 745, 745, 179, - 544, 550, 550, 550, 550, 550, 550, 550, 550, 550, - 550, 550, 550, 550, 550, 550, 550, 550, 550, 550, - 550, 550, 550, 550, 550, 550, 550, 550, 550, 550, - 550, 550, 550, 550, 550, 550, 550, 550, 550, 550, - 550, 550, 550, 550, 550, 550, 550, 550, 550, 550, - 550, 550, 550, 550, 550, 550, 550, 550, 550, 550, - - 550, 550, 550, 550, 550, 550, 550, 550, 550, 550, - 550, 550, 550, 550, 550, 550, 550, 550, 550, 562, - 562, 606, 627, 606, 606, 606, 606, 606, 606, 620, - 609, 609, 607, 621, 607, 607, 607, 607, 607, 607, - 609, 606, 622, 623, 631, 562, 562, 562, 174, 609, - 629, 562, 169, 627, 562, 626, 620, 609, 562, 632, - 621, 562, 562, 168, 607, 628, 167, 158, 606, 622, - 623, 631, 562, 562, 562, 626, 151, 628, 562, 629, - 627, 562, 150, 149, 609, 562, 632, 137, 562, 562, - 588, 607, 588, 588, 588, 588, 588, 588, 588, 588, - - 588, 588, 626, 588, 628, 912, 629, 136, 912, 588, - 588, 588, 588, 588, 588, 589, 912, 589, 589, 589, - 589, 589, 589, 589, 589, 589, 589, 131, 589, 589, - 589, 589, 589, 589, 589, 589, 589, 589, 589, 589, - 608, 124, 608, 608, 608, 608, 608, 608, 611, 123, - 611, 611, 611, 611, 611, 611, 612, 630, 612, 612, - 612, 612, 612, 612, 613, 634, 613, 613, 613, 613, - 613, 613, 614, 608, 614, 614, 614, 614, 614, 614, - 630, 611, 613, 635, 636, 637, 638, 638, 639, 122, - 612, 615, 634, 615, 615, 615, 615, 615, 615, 640, - - 608, 641, 642, 614, 644, 615, 121, 630, 611, 613, - 635, 636, 637, 638, 638, 639, 616, 612, 616, 616, - 616, 616, 616, 616, 647, 646, 640, 648, 641, 642, - 614, 644, 615, 645, 649, 650, 651, 618, 616, 618, - 618, 618, 618, 618, 618, 652, 653, 655, 645, 656, - 657, 647, 661, 662, 648, 618, 646, 663, 664, 665, - 666, 649, 650, 651, 667, 616, 668, 669, 670, 671, - 672, 673, 652, 653, 655, 645, 656, 657, 678, 661, - 662, 108, 618, 646, 663, 664, 665, 666, 680, 674, - 674, 667, 681, 668, 669, 670, 671, 672, 673, 674, - - 676, 682, 684, 676, 685, 678, 685, 676, 674, 686, - 687, 688, 690, 691, 101, 680, 674, 692, 693, 681, - 694, 676, 695, 697, 688, 698, 699, 676, 682, 684, - 694, 685, 700, 685, 702, 705, 686, 687, 688, 690, - 691, 676, 676, 674, 692, 693, 98, 694, 97, 695, - 697, 688, 698, 699, 676, 703, 96, 694, 700, 703, - 707, 702, 705, 84, 83, 82, 68, 58, 676, 676, - 677, 56, 677, 677, 677, 677, 677, 677, 677, 677, - 677, 677, 703, 677, 706, 700, 703, 707, 706, 677, - 677, 677, 677, 677, 677, 704, 708, 704, 677, 677, - - 709, 710, 711, 677, 712, 713, 708, 714, 715, 719, - 721, 706, 722, 677, 721, 706, 723, 724, 726, 728, - 39, 36, 704, 708, 704, 677, 677, 709, 710, 711, - 677, 712, 713, 708, 714, 715, 719, 721, 729, 722, - 677, 721, 35, 723, 724, 726, 728, 677, 683, 730, - 683, 683, 683, 683, 683, 683, 683, 683, 683, 683, - 731, 683, 732, 725, 733, 729, 734, 683, 683, 683, - 683, 683, 683, 725, 736, 739, 730, 744, 746, 751, - 746, 746, 746, 746, 746, 746, 752, 731, 753, 732, - 725, 733, 754, 734, 755, 757, 758, 759, 892, 34, - - 725, 736, 739, 31, 744, 0, 751, 0, 892, 892, - 892, 0, 0, 752, 0, 753, 0, 0, 0, 754, - 0, 755, 757, 758, 759, 683, 689, 689, 689, 689, - 689, 689, 689, 689, 689, 689, 689, 689, 689, 689, - 689, 689, 689, 689, 689, 689, 689, 689, 689, 689, - 689, 689, 689, 689, 689, 689, 689, 689, 689, 689, - 689, 689, 689, 689, 689, 689, 689, 689, 689, 689, - 689, 689, 689, 689, 689, 689, 689, 689, 689, 689, - 689, 689, 689, 689, 689, 689, 689, 689, 689, 689, - 689, 689, 689, 689, 689, 689, 689, 689, 689, 689, - - 689, 689, 689, 689, 701, 701, 761, 762, 763, 785, - 763, 763, 763, 763, 763, 763, 764, 767, 764, 764, - 764, 764, 764, 764, 768, 781, 782, 783, 763, 785, - 701, 701, 701, 761, 762, 784, 701, 790, 764, 701, - 791, 792, 793, 701, 767, 794, 701, 701, 786, 795, - 0, 768, 781, 782, 783, 763, 785, 701, 701, 701, - 784, 0, 786, 701, 790, 764, 701, 791, 792, 793, - 701, 0, 794, 701, 701, 748, 795, 748, 748, 748, - 748, 748, 748, 748, 748, 748, 748, 784, 748, 786, - 913, 0, 0, 913, 748, 748, 748, 748, 748, 748, - - 749, 913, 749, 749, 749, 749, 749, 749, 749, 749, - 749, 749, 787, 749, 749, 749, 749, 749, 749, 749, - 749, 749, 749, 749, 749, 765, 0, 796, 787, 797, - 798, 799, 766, 766, 765, 800, 765, 765, 765, 765, - 765, 765, 766, 769, 0, 769, 769, 769, 769, 769, - 769, 766, 0, 788, 796, 787, 797, 798, 799, 766, - 803, 804, 800, 805, 770, 769, 770, 770, 770, 770, - 770, 770, 771, 788, 771, 771, 771, 771, 771, 771, - 0, 770, 0, 1056, 1056, 0, 766, 803, 804, 806, - 805, 772, 769, 772, 772, 772, 772, 772, 772, 807, - - 788, 808, 809, 810, 771, 772, 1056, 773, 770, 773, - 773, 773, 773, 773, 773, 774, 806, 774, 774, 774, - 774, 774, 774, 773, 775, 0, 807, 0, 808, 809, - 810, 771, 772, 775, 0, 775, 775, 775, 775, 775, - 775, 0, 776, 774, 0, 0, 0, 0, 0, 0, - 773, 776, 777, 776, 776, 776, 776, 776, 776, 778, - 778, 777, 0, 777, 777, 777, 777, 777, 777, 778, - 774, 778, 778, 778, 778, 778, 778, 811, 778, 779, - 779, 812, 813, 814, 815, 817, 818, 820, 821, 779, - 822, 823, 824, 825, 826, 827, 828, 829, 779, 830, - - 831, 837, 849, 839, 811, 838, 779, 835, 812, 813, - 814, 815, 817, 818, 820, 821, 841, 822, 823, 824, - 825, 826, 827, 828, 829, 833, 830, 831, 833, 835, - 837, 839, 833, 779, 842, 838, 842, 843, 844, 0, - 0, 849, 0, 841, 850, 852, 833, 854, 845, 855, - 851, 859, 833, 856, 862, 0, 835, 837, 839, 847, - 851, 842, 838, 842, 843, 844, 833, 833, 849, 845, - 0, 850, 852, 0, 854, 0, 0, 851, 859, 833, - 855, 862, 845, 847, 848, 0, 856, 851, 0, 0, - 0, 0, 0, 833, 833, 834, 845, 834, 834, 834, - - 834, 834, 834, 834, 834, 834, 834, 855, 834, 845, - 847, 857, 848, 856, 834, 834, 834, 834, 834, 834, - 861, 860, 861, 834, 834, 860, 863, 864, 834, 866, - 863, 865, 869, 870, 871, 876, 868, 857, 834, 848, - 867, 865, 872, 879, 1063, 1063, 0, 861, 860, 861, - 834, 834, 860, 863, 864, 834, 866, 863, 865, 0, - 870, 871, 867, 869, 857, 834, 0, 1063, 865, 872, - 879, 868, 834, 840, 876, 840, 840, 840, 840, 840, - 840, 840, 840, 840, 840, 880, 840, 878, 881, 867, - 869, 878, 840, 840, 840, 840, 840, 840, 868, 882, - - 883, 876, 885, 886, 887, 888, 889, 890, 894, 882, - 898, 899, 880, 900, 878, 881, 901, 902, 878, 904, - 905, 906, 908, 0, 0, 0, 882, 883, 0, 885, - 886, 887, 888, 889, 890, 894, 882, 898, 899, 0, - 900, 0, 0, 901, 902, 0, 904, 905, 906, 908, - 840, 846, 846, 846, 846, 846, 846, 846, 846, 846, - 846, 846, 846, 846, 846, 846, 846, 846, 846, 846, - 846, 846, 846, 846, 846, 846, 846, 846, 846, 846, - 846, 846, 846, 846, 846, 846, 846, 846, 846, 846, - 846, 846, 846, 846, 846, 846, 846, 846, 846, 846, - - 846, 846, 846, 846, 846, 846, 846, 846, 846, 846, - 846, 846, 846, 846, 846, 846, 846, 846, 846, 846, - 846, 846, 846, 846, 846, 846, 846, 846, 846, 858, - 858, 891, 897, 909, 893, 914, 914, 0, 917, 914, - 918, 921, 0, 1273, 1273, 914, 929, 930, 945, 933, - 935, 937, 944, 1273, 914, 858, 858, 858, 893, 965, - 909, 858, 1273, 0, 858, 917, 946, 918, 858, 897, - 891, 858, 858, 929, 930, 921, 933, 935, 937, 0, - 944, 0, 858, 858, 858, 893, 965, 0, 858, 945, - 941, 858, 967, 941, 946, 858, 897, 891, 858, 858, - - 922, 941, 921, 0, 0, 0, 922, 944, 922, 922, - 922, 922, 922, 922, 923, 972, 945, 967, 973, 0, - 923, 946, 923, 923, 923, 923, 923, 923, 925, 0, - 925, 925, 925, 925, 925, 925, 925, 925, 925, 925, - 0, 925, 972, 953, 967, 973, 953, 925, 925, 925, - 925, 925, 925, 926, 953, 926, 926, 926, 926, 926, - 926, 926, 926, 926, 926, 0, 926, 926, 926, 926, - 926, 926, 926, 926, 926, 926, 926, 926, 939, 966, - 939, 939, 939, 939, 939, 939, 940, 962, 940, 940, - 940, 940, 940, 940, 943, 943, 968, 966, 943, 0, - - 939, 0, 0, 947, 943, 947, 947, 947, 947, 947, - 947, 962, 955, 943, 940, 955, 968, 0, 0, 974, - 975, 943, 947, 955, 966, 0, 948, 939, 948, 948, - 948, 948, 948, 948, 957, 0, 0, 957, 962, 969, - 976, 940, 0, 968, 948, 957, 974, 975, 943, 947, - 949, 0, 949, 949, 949, 949, 949, 949, 950, 977, - 950, 950, 950, 950, 950, 950, 0, 976, 983, 969, - 951, 948, 951, 951, 951, 951, 951, 951, 970, 984, - 0, 985, 949, 986, 950, 987, 977, 952, 951, 952, - 952, 952, 952, 952, 952, 983, 969, 961, 961, 988, - - 990, 961, 989, 970, 992, 993, 984, 961, 985, 949, - 986, 950, 987, 994, 952, 951, 961, 989, 995, 996, - 998, 1000, 992, 1001, 961, 1002, 988, 990, 1003, 1009, - 970, 1014, 993, 0, 1014, 0, 1012, 0, 0, 1012, - 994, 952, 1017, 1012, 989, 995, 996, 998, 1000, 992, - 1001, 961, 1002, 1017, 1028, 1003, 1009, 1012, 1012, 1018, - 1013, 1014, 1016, 1012, 1013, 1013, 1020, 1022, 1018, 1013, - 1021, 1023, 1016, 1022, 1028, 1020, 1023, 1012, 1012, 1013, - 1017, 1026, 1021, 1024, 1021, 1024, 1026, 1033, 1027, 1029, - 1012, 1013, 1013, 0, 0, 1018, 1013, 1027, 1024, 1016, - - 1022, 1028, 1020, 1023, 1012, 1012, 1013, 1033, 1029, 1021, - 1030, 1021, 1024, 1026, 1031, 0, 1034, 0, 1031, 1030, - 1038, 1038, 1035, 0, 1027, 1024, 1025, 1025, 1034, 1030, - 1071, 1071, 1071, 0, 1033, 1029, 1035, 1040, 1040, 1071, - 0, 1086, 1086, 1038, 1038, 1031, 1030, 1041, 1041, 1025, - 1039, 1039, 1025, 1025, 1025, 1034, 1030, 0, 1025, 1047, - 1040, 1025, 0, 1035, 1086, 1025, 1043, 1043, 1025, 1025, - 1041, 1038, 1040, 1039, 1040, 1047, 1041, 0, 1039, 1025, - 1025, 1025, 1039, 1042, 1042, 1025, 1094, 1094, 1025, 1043, - 1043, 0, 1025, 1044, 1044, 1025, 1025, 1036, 1036, 1040, - - 0, 1040, 1047, 1041, 1046, 1039, 1042, 1046, 1145, 1039, - 1048, 1042, 1049, 0, 1094, 1042, 1044, 1043, 1045, 1045, - 1036, 1044, 1048, 1036, 1036, 1036, 1055, 1050, 1049, 1036, - 1145, 1044, 1036, 1050, 1046, 0, 1036, 0, 1042, 1036, - 1036, 1045, 1042, 1076, 0, 1070, 1055, 0, 1044, 1048, - 1036, 1036, 1036, 1057, 1057, 1049, 1036, 1145, 1044, 1036, - 1050, 1076, 1045, 1036, 1051, 1070, 1036, 1036, 0, 1051, - 1058, 1058, 0, 1055, 1059, 1059, 1057, 1060, 1060, 1061, - 1061, 1057, 0, 1062, 1062, 1057, 1065, 1065, 1076, 1045, - 1064, 1064, 1070, 1058, 1066, 1066, 1051, 1059, 0, 1072, - - 1060, 1141, 1061, 1059, 1072, 1058, 1062, 1090, 1057, 1065, - 1062, 1061, 1057, 1064, 1064, 1141, 0, 1066, 1090, 1060, - 1163, 1061, 1067, 1067, 1066, 1120, 1068, 1068, 1065, 1090, - 1059, 1072, 1058, 1069, 1069, 1078, 1078, 1062, 1061, 0, - 1073, 1064, 1141, 1077, 1077, 1067, 1060, 1163, 1061, 1068, - 1120, 1066, 1073, 1081, 1081, 1065, 1069, 0, 1078, 1079, - 1079, 1080, 1080, 1083, 1083, 1067, 1077, 1078, 1084, 1084, - 1068, 0, 1082, 1082, 1069, 0, 1081, 1120, 1077, 1073, - 1095, 1081, 1079, 1082, 1080, 1091, 1083, 1085, 1085, 1095, - 1080, 1084, 1067, 0, 1078, 1082, 1091, 1068, 1079, 1087, - - 1087, 1069, 1083, 1097, 1097, 1077, 1096, 1091, 1081, 1092, - 1085, 1084, 1088, 1088, 1097, 1085, 1095, 1080, 1093, 1093, - 1092, 1096, 1087, 1098, 1098, 1079, 1097, 1155, 1093, 1083, - 0, 1092, 1155, 1099, 1099, 1088, 0, 1093, 1084, 0, - 1087, 1093, 1085, 1100, 1100, 1147, 1098, 1164, 1096, 1088, - 1101, 1101, 1102, 1102, 1103, 1103, 1099, 1104, 1104, 1155, - 1098, 1101, 1105, 1105, 1147, 1103, 1100, 1087, 1099, 0, - 1106, 1106, 1108, 1101, 1164, 1102, 1088, 1103, 1107, 1107, - 1104, 1110, 1165, 1108, 1102, 1105, 1112, 1098, 1114, 1104, - 1126, 1147, 1110, 1106, 1108, 1099, 1106, 1112, 1121, 1114, - - 0, 1107, 1126, 1110, 1121, 0, 0, 0, 1112, 1165, - 1114, 1102, 0, 1142, 0, 1127, 1104, 1127, 1127, 1127, - 1127, 1127, 1127, 1106, 0, 0, 0, 1142, 1127, 1126, - 1128, 1121, 1128, 1128, 1128, 1128, 1128, 1128, 1133, 1133, - 1134, 1134, 1131, 1128, 1131, 1131, 1131, 1131, 1131, 1131, - 1135, 1135, 1136, 1136, 1142, 1131, 1137, 1137, 1138, 1138, - 0, 1133, 1144, 1134, 1133, 1139, 1139, 1146, 1134, 1140, - 1140, 1144, 1166, 1135, 1135, 1136, 1146, 0, 0, 1137, - 1148, 1138, 0, 0, 1136, 1137, 1143, 1143, 1139, 1148, - 1160, 1133, 1140, 1161, 1169, 1134, 1143, 1140, 1144, 1166, - - 1138, 1135, 1139, 1146, 1156, 1143, 1156, 1154, 1154, 1143, - 1159, 1136, 1137, 1143, 1162, 1160, 1148, 1154, 1170, 1171, - 1172, 1169, 1175, 1161, 1140, 1176, 1154, 1138, 1159, 1139, - 1154, 1177, 1162, 1156, 1154, 1178, 1179, 1180, 1181, 1184, - 1143, 1185, 1160, 1187, 1188, 1170, 1171, 1172, 1189, 1175, - 1161, 1190, 1176, 1191, 1194, 1159, 1196, 1197, 1177, 1162, - 0, 1154, 1178, 1179, 1180, 1181, 1184, 1198, 1185, 1192, - 1187, 1188, 1192, 1206, 0, 1189, 1192, 1207, 1190, 1200, - 1191, 1194, 1193, 1196, 1197, 1201, 1193, 1193, 1200, 1202, - 1192, 1193, 1204, 1203, 1198, 1202, 1192, 1201, 1203, 1201, - - 1206, 1193, 1209, 1208, 1207, 1204, 0, 1205, 1210, 1214, - 1192, 1192, 1211, 1193, 1193, 1200, 1211, 1210, 1193, 1204, - 1213, 1209, 1202, 1192, 1201, 1203, 1201, 1210, 1193, 1205, - 1208, 1215, 1204, 1205, 1217, 1217, 1214, 1192, 1192, 1226, - 1213, 1218, 1218, 1211, 1210, 1219, 1219, 0, 1209, 1220, - 1220, 1221, 1221, 0, 1210, 1222, 1222, 1217, 1215, 1229, - 1205, 1227, 1225, 1225, 1218, 1218, 1226, 1213, 1219, 1228, - 1223, 1223, 1220, 1219, 1221, 1229, 1230, 1219, 1222, 0, - 1221, 1235, 1230, 1222, 1220, 1225, 1220, 1222, 1227, 1224, - 1224, 0, 1218, 1223, 1223, 0, 1228, 0, 1231, 1250, - - 1219, 0, 1229, 1231, 1219, 1252, 1225, 1221, 1235, 1230, - 1222, 1220, 1224, 1220, 1222, 1236, 1236, 1224, 1237, 1237, - 0, 1223, 1238, 1238, 1239, 1239, 1250, 1224, 1240, 1240, - 1231, 1256, 1252, 1225, 0, 0, 1241, 1241, 1236, 1242, - 1242, 1237, 1243, 1243, 1224, 1238, 1237, 1239, 1244, 1244, - 1237, 1240, 1276, 1239, 1224, 1253, 0, 1238, 1256, 1241, - 1245, 1245, 1242, 1247, 1247, 1243, 1242, 1253, 1241, 1298, - 1240, 1244, 1244, 1237, 1311, 1248, 1248, 1237, 1241, 1276, - 1239, 1246, 1246, 1245, 1238, 1322, 1247, 1249, 1249, 1257, - 1257, 1258, 1258, 1242, 1253, 1241, 1298, 1240, 1248, 1244, - - 1296, 1311, 1245, 1322, 1246, 1241, 1247, 0, 1259, 1259, - 1249, 1246, 1257, 0, 1258, 0, 1260, 1260, 0, 1248, - 1261, 1261, 0, 1258, 1257, 1296, 1262, 1262, 1249, 1245, - 1322, 1259, 0, 1247, 1263, 1263, 0, 1262, 1246, 1260, - 1264, 1264, 1307, 1261, 1328, 1260, 1248, 1259, 1261, 1262, - 1258, 1257, 1296, 1265, 1265, 1249, 0, 1263, 0, 1266, - 1266, 1267, 1267, 1264, 1268, 1268, 1274, 1274, 1275, 1277, - 1277, 1328, 1260, 1263, 1259, 1261, 1265, 1275, 1307, 1297, - 1277, 1265, 1266, 1264, 1267, 1297, 0, 1268, 1278, 1278, - 1280, 1280, 1277, 0, 1274, 1279, 1279, 1330, 1281, 1281, - - 1263, 1268, 1267, 0, 1275, 1307, 0, 1331, 1265, 1281, - 1264, 1278, 1297, 1280, 1282, 1282, 1283, 1283, 1279, 1284, - 1284, 1281, 1285, 1285, 1330, 1278, 0, 1283, 1268, 1267, - 1279, 0, 1286, 1286, 1331, 0, 0, 1282, 1310, 1283, - 1287, 1287, 1284, 1299, 1299, 1285, 1282, 1300, 1300, 1302, - 1302, 1284, 1278, 1301, 1301, 1286, 1333, 1279, 1286, 1303, - 1303, 1304, 1304, 1287, 1305, 1305, 1299, 1306, 1306, 1299, - 1300, 1310, 1302, 1282, 0, 1300, 1301, 1301, 1284, 1334, - 1335, 1302, 1303, 1333, 1304, 1286, 1337, 1305, 1303, 0, - 1306, 1313, 1313, 1314, 1314, 1306, 1299, 0, 1310, 0, - - 0, 1305, 1300, 1304, 1301, 1348, 1334, 1335, 1302, 1315, - 1315, 1316, 1316, 1337, 1313, 1303, 1314, 1338, 1317, 1317, - 1318, 1318, 1306, 1319, 1319, 1343, 1320, 1320, 1305, 1313, - 1304, 1344, 1315, 1345, 1316, 1342, 1342, 1346, 1347, 1349, - 1316, 1317, 1348, 1318, 1338, 1342, 1319, 1350, 1318, 1320, - 1351, 0, 1343, 1319, 1342, 1360, 1313, 1315, 1344, 0, - 1345, 1361, 1352, 1352, 1346, 1347, 1372, 1316, 0, 1348, - 1353, 1353, 1354, 1354, 1374, 1318, 1362, 1351, 1355, 1355, - 1319, 1350, 1360, 1349, 1315, 1352, 1356, 1356, 1361, 1363, - 1364, 1365, 1367, 1353, 1368, 1354, 1366, 1366, 1370, 1352, - - 1371, 1355, 1373, 1362, 1355, 0, 1366, 1372, 1350, 1356, - 1349, 1375, 1374, 1376, 1376, 1366, 1363, 1364, 1365, 1367, - 1379, 1368, 1378, 1378, 1380, 1370, 1352, 1371, 1381, 1373, - 1382, 1355, 1366, 1391, 1372, 1383, 1376, 1384, 1375, 1374, - 1385, 1386, 1388, 1389, 1390, 1378, 1392, 1379, 1393, 1394, - 0, 1380, 1397, 1398, 1399, 1381, 1401, 1382, 1376, 1366, - 1378, 1408, 1383, 1391, 1384, 1395, 1395, 1385, 1386, 1388, - 1389, 1390, 1402, 1392, 1403, 1393, 1394, 1396, 1396, 1397, - 1398, 1399, 1404, 1401, 1405, 1376, 1406, 1378, 1395, 1407, - 1391, 1411, 1410, 1395, 1412, 1412, 1414, 1408, 0, 1402, - - 1396, 1403, 1393, 1413, 1413, 1417, 1418, 1419, 1421, 1404, - 1422, 1405, 1423, 1406, 1396, 1424, 1407, 1412, 1411, 1425, - 1395, 1427, 1428, 1414, 1408, 1410, 1413, 1429, 1429, 1431, - 1413, 1412, 1417, 1418, 1419, 1421, 1432, 1422, 1433, 1423, - 1434, 1396, 1424, 1430, 1430, 1437, 1437, 1439, 1440, 1428, - 1429, 0, 1410, 1427, 1425, 1437, 1431, 1413, 1412, 1438, - 1438, 1442, 1443, 1432, 1437, 1433, 1430, 1434, 1446, 1438, - 1429, 1444, 1444, 1447, 1439, 1455, 1454, 1454, 1438, 1456, - 1427, 1425, 1457, 1457, 1458, 1460, 1460, 0, 1440, 1443, - 0, 0, 0, 0, 1444, 1446, 0, 1429, 1442, 1454, - - 1447, 0, 1455, 1444, 0, 1457, 1456, 0, 1460, 0, - 0, 1458, 0, 0, 1454, 1440, 0, 0, 0, 1457, - 0, 0, 0, 0, 0, 1442, 0, 0, 0, 0, - 1444, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 1454, 0, 0, 0, 0, 1457, 1463, 1463, 1463, - 1463, 1463, 1463, 1463, 1463, 1463, 1463, 1463, 1464, 1464, - 1464, 1464, 1464, 1464, 1464, 1464, 1464, 1464, 1464, 1465, - 1465, 1465, 1465, 1465, 1465, 1465, 1465, 1465, 1465, 1465, - 1466, 1466, 1466, 1466, 1466, 1466, 1466, 1466, 1466, 1466, - 1466, 1467, 0, 1467, 1467, 1467, 1467, 1467, 1467, 1467, - - 1467, 1467, 1468, 0, 1468, 1468, 1468, 1468, 1468, 1468, - 1468, 1468, 1468, 1469, 1469, 1469, 1469, 0, 1469, 1470, - 0, 1470, 1470, 1470, 1470, 1470, 1470, 1470, 1470, 1470, - 1471, 0, 1471, 1471, 1471, 1471, 1471, 1471, 1471, 1471, - 1471, 1472, 0, 1472, 1472, 1472, 1472, 1472, 1472, 1472, - 1472, 1472, 1473, 0, 1473, 1473, 1473, 1473, 1473, 1473, - 1473, 1473, 1473, 1474, 0, 1474, 1474, 1474, 1474, 1474, - 1474, 1474, 1474, 1474, 1475, 0, 1475, 1475, 1475, 1475, - 1475, 1475, 1475, 1475, 1475, 1476, 0, 1476, 1476, 1476, - 1476, 1476, 1476, 1476, 1476, 1476, 1477, 1477, 1477, 1477, - - 0, 1477, 1478, 0, 1478, 1478, 1478, 1478, 1478, 1478, - 1478, 1478, 1478, 1479, 0, 1479, 1479, 1479, 1479, 1479, - 1479, 1479, 1479, 1479, 1480, 1480, 1480, 1480, 0, 1480, - 1481, 0, 1481, 1481, 1481, 1481, 1481, 1481, 1481, 1481, - 1481, 1482, 0, 1482, 1482, 1482, 1482, 1482, 1482, 1482, - 1482, 1482, 1483, 1483, 1483, 1483, 0, 1483, 1484, 0, - 1484, 1484, 1484, 1484, 1484, 1484, 1484, 1484, 1484, 1485, - 0, 1485, 1485, 1485, 1485, 1485, 1485, 1485, 1485, 1485, - 1486, 1486, 1486, 1486, 0, 1486, 1487, 0, 1487, 1487, - 1487, 1487, 1487, 1487, 1487, 1487, 1487, 1488, 0, 1488, - - 1488, 1488, 1488, 1488, 1488, 1488, 1488, 1488, 1489, 0, - 1489, 1489, 0, 1489, 1489, 1489, 1489, 1489, 1489, 1490, - 1490, 1490, 0, 1490, 1491, 0, 1491, 1491, 1491, 1491, - 1491, 1491, 1491, 1491, 1491, 1492, 0, 1492, 1492, 1492, - 1492, 1492, 1492, 1492, 1492, 1492, 1493, 0, 1493, 1493, - 0, 1493, 1493, 1493, 1493, 1493, 1493, 1494, 1494, 1494, - 0, 1494, 1495, 0, 1495, 1495, 1495, 1495, 1495, 1495, - 1495, 1495, 1495, 1496, 0, 1496, 1496, 1496, 1496, 1496, - 1496, 1496, 1496, 1496, 1497, 1497, 1497, 1497, 0, 1497, - 1498, 0, 1498, 1498, 1498, 1498, 1498, 1498, 1498, 1498, - - 1498, 1499, 0, 1499, 1499, 1499, 1499, 1499, 1499, 1499, - 1499, 1499, 1500, 1500, 0, 0, 0, 0, 1500, 0, - 1500, 1501, 0, 1501, 1501, 1501, 1501, 1501, 1501, 1501, - 1501, 1501, 1502, 0, 1502, 1502, 1502, 1502, 1502, 1502, - 1502, 1502, 1502, 1503, 0, 1503, 1503, 1503, 1503, 1503, - 1503, 1503, 1503, 1503, 1504, 0, 1504, 1504, 1504, 1504, - 1504, 1504, 1504, 1504, 1504, 1505, 0, 1505, 1505, 1505, - 1505, 1505, 1505, 1505, 1505, 1505, 1506, 0, 1506, 0, - 1506, 1507, 0, 1507, 1507, 1507, 1507, 1507, 1507, 1507, - 1507, 1507, 1508, 0, 1508, 1508, 1508, 1508, 1508, 1508, - - 1508, 1508, 1508, 1509, 0, 1509, 1509, 1509, 1509, 1509, - 1509, 1509, 1509, 1509, 1510, 0, 1510, 1510, 1510, 1510, - 1510, 1510, 1510, 1510, 1510, 1511, 0, 1511, 1511, 1511, - 1511, 1511, 1511, 1511, 1511, 1511, 1512, 0, 1512, 1512, - 1512, 1512, 1512, 1512, 1512, 1512, 1512, 1513, 0, 1513, - 1513, 1513, 1513, 1513, 1513, 1513, 1513, 1513, 1514, 0, - 1514, 1514, 1514, 1514, 1514, 1514, 1514, 1514, 1514, 1515, - 0, 1515, 0, 1515, 1516, 0, 1516, 1516, 1516, 1516, - 1516, 1516, 1516, 1516, 1516, 1517, 0, 1517, 1517, 1517, - 1517, 1517, 1517, 1517, 1517, 1517, 1518, 1518, 1518, 0, - - 1518, 1519, 1519, 1519, 1519, 0, 1519, 1520, 0, 1520, - 1520, 1520, 1520, 1520, 1520, 1520, 1520, 1520, 1521, 0, - 1521, 1521, 1521, 1521, 1521, 1521, 1521, 1521, 1521, 1522, - 0, 1522, 0, 1522, 1523, 0, 1523, 1523, 1523, 1523, - 1523, 1523, 1523, 1523, 1523, 1524, 0, 1524, 1524, 1524, - 1524, 1524, 1524, 1524, 1524, 1524, 1525, 0, 1525, 0, - 1525, 1526, 0, 1526, 1526, 1526, 1526, 1526, 1526, 1526, - 1526, 1526, 1527, 0, 1527, 1527, 1527, 1527, 1527, 1527, - 1527, 1527, 1527, 1528, 0, 1528, 1528, 0, 1528, 1528, - 1528, 1528, 1528, 1528, 1529, 0, 1529, 0, 1529, 1530, - - 0, 1530, 1530, 1530, 1530, 1530, 1530, 1530, 1530, 1530, - 1531, 0, 1531, 1531, 1531, 1531, 1531, 1531, 1531, 1531, - 1531, 1532, 0, 1532, 1532, 0, 1532, 1532, 1532, 1532, - 1532, 1532, 1533, 0, 1533, 0, 1533, 1534, 0, 1534, - 1534, 1534, 1534, 1534, 1534, 1534, 1534, 1534, 1535, 0, - 1535, 1535, 1535, 1535, 1535, 1535, 1535, 1535, 1535, 1536, - 0, 1536, 0, 1536, 1537, 0, 1537, 1537, 1537, 1537, - 1537, 1537, 1537, 1537, 1537, 1538, 0, 1538, 1538, 1538, - 1538, 1538, 1538, 1538, 1538, 1538, 1539, 1539, 0, 0, - 0, 0, 1539, 0, 1539, 1540, 0, 1540, 1540, 1540, - - 1540, 1540, 1540, 1540, 1540, 1540, 1541, 0, 1541, 1541, - 1541, 1541, 1541, 1541, 1541, 1541, 1541, 1542, 0, 1542, - 1542, 1542, 1542, 1542, 1542, 1542, 1542, 1542, 1543, 0, - 1543, 0, 1543, 1544, 0, 1544, 1544, 1544, 1544, 1544, - 1544, 1544, 1544, 1544, 1545, 0, 1545, 1545, 1545, 1545, - 1545, 1545, 1545, 1545, 1545, 1546, 0, 1546, 1546, 1546, - 1546, 1546, 1546, 1546, 1546, 1546, 1547, 0, 1547, 1547, - 1547, 1547, 1547, 1547, 1547, 1547, 1547, 1548, 0, 1548, - 1548, 1548, 1548, 1548, 1548, 1548, 1548, 1548, 1549, 0, - 1549, 1549, 1549, 1549, 1549, 1549, 1549, 1549, 1549, 1550, - - 0, 1550, 0, 1550, 1551, 1551, 1551, 0, 1551, 1552, - 1552, 1552, 0, 1552, 1553, 0, 1553, 0, 1553, 1554, - 0, 1554, 0, 1554, 1555, 0, 1555, 0, 1555, 1556, - 0, 1556, 1556, 1556, 1556, 1556, 1556, 1556, 1556, 1556, - 1557, 0, 1557, 1557, 1557, 1557, 1557, 1557, 1557, 1557, - 1557, 1558, 0, 1558, 1558, 1558, 1558, 1558, 1558, 1558, - 1558, 1558, 1559, 0, 1559, 1559, 1559, 1559, 1559, 1559, - 1559, 1559, 1559, 1560, 0, 1560, 1560, 1560, 1560, 1560, - 1560, 1560, 1560, 1560, 1561, 0, 1561, 1561, 1561, 1561, - 1561, 1561, 1561, 1561, 1561, 1562, 0, 1562, 1562, 1562, - - 1562, 1562, 1562, 1562, 1562, 1562, 1563, 0, 1563, 1563, - 1563, 1563, 1563, 1563, 1563, 1563, 1563, 1564, 0, 1564, - 1564, 1564, 1564, 1564, 1564, 1564, 1564, 1564, 1565, 0, - 1565, 1565, 1565, 1565, 1565, 1565, 1565, 1565, 1565, 1566, - 0, 1566, 1566, 1566, 1566, 1566, 1566, 1566, 1566, 1566, - 1567, 0, 1567, 1567, 1567, 1567, 1567, 1567, 1567, 1567, - 1567, 1568, 0, 1568, 1568, 1568, 1568, 1568, 1568, 1568, - 1568, 1568, 1569, 0, 1569, 1569, 1569, 1569, 1569, 1569, - 1569, 1569, 1569, 1570, 0, 1570, 1570, 1570, 1570, 1570, - 1570, 1570, 1570, 1570, 1571, 0, 1571, 1571, 1571, 1571, - - 1571, 1571, 1571, 1571, 1571, 1572, 0, 1572, 1572, 1572, - 1572, 1572, 1572, 1572, 1572, 1572, 1573, 0, 1573, 1573, - 1573, 1573, 1573, 1573, 1573, 1573, 1573, 1574, 0, 1574, - 1574, 1575, 1575, 0, 0, 0, 1575, 0, 1575, 1575, - 1576, 0, 1576, 1576, 1576, 1576, 1576, 1576, 1576, 1576, - 1576, 1577, 0, 1577, 1577, 1577, 1577, 1577, 1577, 1577, - 1577, 1577, 1578, 0, 1578, 1578, 1578, 1578, 1578, 1578, - 1578, 1578, 1578, 1462, 1462, 1462, 1462, 1462, 1462, 1462, - 1462, 1462, 1462, 1462, 1462, 1462, 1462, 1462, 1462, 1462, - 1462, 1462, 1462, 1462, 1462, 1462, 1462, 1462, 1462, 1462, - - 1462, 1462, 1462, 1462, 1462, 1462, 1462, 1462, 1462, 1462, - 1462, 1462, 1462, 1462, 1462, 1462, 1462, 1462, 1462, 1462, - 1462, 1462, 1462, 1462, 1462, 1462, 1462, 1462, 1462, 1462, - 1462, 1462, 1462, 1462, 1462, 1462, 1462, 1462, 1462, 1462, - 1462, 1462, 1462, 1462, 1462, 1462, 1462, 1462, 1462, 1462, - 1462, 1462 - } ; - -static yy_state_type yy_last_accepting_state; -static char *yy_last_accepting_cpos; - -extern int yy_flex_debug; -int yy_flex_debug = 0; - -/* The intent behind this definition is that it'll catch - * any uses of REJECT which flex missed. - */ -#define REJECT reject_used_but_not_detected -#define yymore() yymore_used_but_not_detected -#define YY_MORE_ADJ 0 -#define YY_RESTORE_YY_MORE_OFFSET -char *yytext; -#line 1 "pplex.l" -/* - Copyright (C) 2001-2012, 2014-2019 Free Software Foundation, Inc. - Written by Keisuke Nishida, Roger While, Simon Sobisch, Dave Pitts - - This file is part of GnuCOBOL. - - The GnuCOBOL compiler is free software: you can redistribute it - and/or modify it under the terms of the GNU General Public License - as published by the Free Software Foundation, either version 3 of the - License, or (at your option) any later version. - - GnuCOBOL is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with GnuCOBOL. If not, see . -*/ -#line 52 "pplex.l" -#undef YY_READ_BUF_SIZE -#define YY_READ_BUF_SIZE 32768 -#undef YY_BUF_SIZE -#define YY_BUF_SIZE 32768 - -#define YY_SKIP_YYWRAP -static int ppwrap (void) { - return 1; -} - -#define PPLEX_BUFF_LEN 512 -#define YY_INPUT(buf,result,max_size) result = ppinput (buf, max_size); -#define ECHO fputs (yytext, yyout) - -#define YY_USER_INIT \ - if (!plexbuff1) { \ - plexbuff1 = cobc_malloc ((size_t)COB_SMALL_BUFF); \ - } \ - if (!plexbuff2) { \ - plexbuff2 = cobc_malloc ((size_t)COB_SMALL_BUFF); \ - } \ - requires_listing_line = 1; \ - comment_allowed = 1; - -#include - -#ifdef HAVE_STRING_H -#include -#endif -#ifdef HAVE_UNISTD_H -#include -#else -#define YY_NO_UNISTD_H 1 -#endif -#include -#include -#include - -#define COB_IN_PPLEX 1 -#include "cobc.h" -#include "tree.h" -#include - -/* ignore unused functions here as flex generates unused ones */ -#ifdef __GNUC__ -#if defined (__clang__) || __GNUC__ > 4 || (__GNUC__ == 4 && __GNUC_MINOR__ >= 4) -#pragma GCC diagnostic ignored "-Wunused-function" -#endif -#endif - -#define PLEX_COND_DEPTH 16 - -struct copy_info { - struct copy_info *next; - struct list_files *containing_files; - const char *file; - char *dname; - struct cb_replace_list *replacing; - YY_BUFFER_STATE buffer; - int line; - int quotation_mark; - int source_format; -}; - -struct plex_stack { - unsigned int cmd; - unsigned int skip; - unsigned int cond; - int line; -}; - -/* Global variables */ - - -/* Local variables */ -static char *plexbuff1 = NULL; -static char *plexbuff2 = NULL; -static struct list_files *old_list_file = NULL; -static size_t newline_count = 0; -static size_t within_comment = 0; -static size_t inside_bracket = 0; -static size_t consecutive_quotation = 0; -static size_t need_continuation = 0; -static size_t buffer_overflow = 0; -static size_t comment_allowed; -static unsigned int plex_skip_input = 0; -static unsigned int plex_nest_depth = 0; -static int quotation_mark = 0; -static int listing_line = 0; -static int requires_listing_line; -static int requires_new_line = 0; - -static char display_msg[PPLEX_BUFF_LEN]; - -static struct cb_replace_list *current_replace_list = NULL; -static struct cb_replace_list *save_current_replace = NULL; -static struct cb_replace_list *base_replace_list = NULL; - -static struct cb_text_list *text_queue = NULL; - -static struct copy_info *copy_stack = NULL; - -static struct plex_stack plex_cond_stack[PLEX_COND_DEPTH]; - -/* Function declarations */ -static int ppinput (char *, const size_t); -static void ppecho (const char *, const cob_u32_t, - const int); -static void ppecho_direct (const char *); -static void switch_to_buffer (const int, const char *, - const YY_BUFFER_STATE); -static void check_listing (const char *, const unsigned int); -static void skip_to_eol (void); -static void display_finish (void); -static void set_print_replace_list (struct cb_replace_list *list); -static void get_new_listing_file (void); - -#line 2965 "pplex.c" - -#line 2967 "pplex.c" - -#define INITIAL 0 -#define CALL_DIRECTIVE_STATE 1 -#define COPY_STATE 2 -#define PSEUDO_STATE 3 -#define SOURCE_DIRECTIVE_STATE 4 -#define DEFINE_DIRECTIVE_STATE 5 -#define ON_OFF_DIRECTIVE_STATE 6 -#define SET_DIRECTIVE_STATE 7 -#define TURN_DIRECTIVE_STATE 8 -#define IF_DIRECTIVE_STATE 9 -#define ELSE_DIRECTIVE_STATE 10 -#define ENDIF_DIRECTIVE_STATE 11 -#define ALNUM_LITERAL_STATE 12 -#define CONTROL_STATEMENT_STATE 13 -#define DISPLAY_DIRECTIVE_STATE 14 - -#ifndef YY_NO_UNISTD_H -/* Special case for "unistd.h", since it is non-ANSI. We include it way - * down here because we want the user's section 1 to have been scanned first. - * The user has a chance to override it with an option. - */ -#include -#endif - -#ifndef YY_EXTRA_TYPE -#define YY_EXTRA_TYPE void * -#endif - -static int yy_init_globals ( void ); - -/* Accessor methods to globals. - These are made visible to non-reentrant scanners for convenience. */ - -int yylex_destroy ( void ); - -/* Macros after this point can all be overridden by user definitions in - * section 1. - */ - -#ifndef YY_SKIP_YYWRAP -#ifdef __cplusplus -extern "C" int yywrap ( void ); -#else -extern int yywrap ( void ); -#endif -#endif - -#ifndef YY_NO_UNPUT - - static void yyunput ( int c, char *buf_ptr ); - -#endif - -#ifndef yytext_ptr -static void yy_flex_strncpy ( char *, const char *, int ); -#endif - -#ifdef YY_NEED_STRLEN -static int yy_flex_strlen ( const char * ); -#endif - -#ifndef YY_NO_INPUT -#ifdef __cplusplus -static int yyinput ( void ); -#else -static int input ( void ); -#endif - -#endif - - static int yy_start_stack_ptr = 0; - static int yy_start_stack_depth = 0; - static int *yy_start_stack = NULL; - - static void yy_push_state ( int _new_state ); - - static void yy_pop_state ( void ); - -/* Amount of stuff to slurp up with each read. */ -#ifndef YY_READ_BUF_SIZE -#ifdef __ia64__ -/* On IA-64, the buffer size is 16k, not 8k */ -#define YY_READ_BUF_SIZE 16384 -#else -#define YY_READ_BUF_SIZE 8192 -#endif /* __ia64__ */ -#endif - -/* Copy whatever the last rule matched to the standard output. */ -#ifndef ECHO -/* This used to be an fputs(), but since the string might contain NUL's, - * we now use fwrite(). - */ -#define ECHO do { if (fwrite( yytext, (size_t) yyleng, 1, yyout )) {} } while (0) -#endif - -/* Gets input and stuffs it into "buf". number of characters read, or YY_NULL, - * is returned in "result". - */ -#ifndef YY_INPUT -#define YY_INPUT(buf,result,max_size) \ - if ( YY_CURRENT_BUFFER_LVALUE->yy_is_interactive ) \ - { \ - int c = '*'; \ - int n; \ - for ( n = 0; n < max_size && \ - (c = getc( yyin )) != EOF && c != '\n'; ++n ) \ - buf[n] = (char) c; \ - if ( c == '\n' ) \ - buf[n++] = (char) c; \ - if ( c == EOF && ferror( yyin ) ) \ - YY_FATAL_ERROR( "input in flex scanner failed" ); \ - result = n; \ - } \ - else \ - { \ - errno=0; \ - while ( (result = (int) fread(buf, 1, (yy_size_t) max_size, yyin)) == 0 && ferror(yyin)) \ - { \ - if( errno != EINTR) \ - { \ - YY_FATAL_ERROR( "input in flex scanner failed" ); \ - break; \ - } \ - errno=0; \ - clearerr(yyin); \ - } \ - }\ -\ - -#endif - -/* No semi-colon after return; correct usage is to write "yyterminate();" - - * we don't want an extra ';' after the "return" because that will cause - * some compilers to complain about unreachable statements. - */ -#ifndef yyterminate -#define yyterminate() return YY_NULL -#endif - -/* Number of entries by which start-condition stack grows. */ -#ifndef YY_START_STACK_INCR -#define YY_START_STACK_INCR 25 -#endif - -/* Report a fatal error. */ -#ifndef YY_FATAL_ERROR -#define YY_FATAL_ERROR(msg) yy_fatal_error( msg ) -#endif - -/* end tables serialization structures and prototypes */ - -/* Default declaration of generated scanner - a define so the user can - * easily add parameters. - */ -#ifndef YY_DECL -#define YY_DECL_IS_OURS 1 - -extern int yylex (void); - -#define YY_DECL int yylex (void) -#endif /* !YY_DECL */ - -/* Code executed at the beginning of each rule, after yytext and yyleng - * have been set up. - */ -#ifndef YY_USER_ACTION -#define YY_USER_ACTION -#endif - -/* Code executed at the end of each rule. */ -#ifndef YY_BREAK -#define YY_BREAK /*LINTED*/break; -#endif - -#define YY_RULE_SETUP \ - if ( yyleng > 0 ) \ - YY_CURRENT_BUFFER_LVALUE->yy_at_bol = \ - (yytext[yyleng - 1] == '\n'); \ - YY_USER_ACTION - -/** The main scanner function which does all the work. - */ -YY_DECL -{ - yy_state_type yy_current_state; - char *yy_cp, *yy_bp; - int yy_act; - - if ( !(yy_init) ) - { - (yy_init) = 1; - -#ifdef YY_USER_INIT - YY_USER_INIT; -#endif - - if ( ! (yy_start) ) - (yy_start) = 1; /* first start state */ - - if ( ! yyin ) - yyin = stdin; - - if ( ! yyout ) - yyout = stdout; - - if ( ! YY_CURRENT_BUFFER ) { - yyensure_buffer_stack (); - YY_CURRENT_BUFFER_LVALUE = - yy_create_buffer( yyin, YY_BUF_SIZE ); - } - - yy_load_buffer_state( ); - } - - { -#line 192 "pplex.l" - - - - - -#line 3191 "pplex.c" - - while ( /*CONSTCOND*/1 ) /* loops until end-of-file is reached */ - { - yy_cp = (yy_c_buf_p); - - /* Support of yytext. */ - *yy_cp = (yy_hold_char); - - /* yy_bp points to the position in yy_ch_buf of the start of - * the current run. - */ - yy_bp = yy_cp; - - yy_current_state = (yy_start); - yy_current_state += YY_AT_BOL(); -yy_match: - do - { - YY_CHAR yy_c = yy_ec[YY_SC_TO_UI(*yy_cp)] ; - if ( yy_accept[yy_current_state] ) - { - (yy_last_accepting_state) = yy_current_state; - (yy_last_accepting_cpos) = yy_cp; - } - while ( yy_chk[yy_base[yy_current_state] + yy_c] != yy_current_state ) - { - yy_current_state = (int) yy_def[yy_current_state]; - if ( yy_current_state >= 1463 ) - yy_c = yy_meta[yy_c]; - } - yy_current_state = yy_nxt[yy_base[yy_current_state] + yy_c]; - ++yy_cp; - } - while ( yy_current_state != 1462 ); - yy_cp = (yy_last_accepting_cpos); - yy_current_state = (yy_last_accepting_state); - -yy_find_action: - yy_act = yy_accept[yy_current_state]; - - YY_DO_BEFORE_ACTION; - -do_action: /* This label is used only to access EOF actions. */ - - switch ( yy_act ) - { /* beginning of action switch */ - case 0: /* must back up */ - /* undo the effects of YY_DO_BEFORE_ACTION */ - *yy_cp = (yy_hold_char); - yy_cp = (yy_last_accepting_cpos); - yy_current_state = (yy_last_accepting_state); - goto yy_find_action; - -case 1: -YY_RULE_SETUP -#line 197 "pplex.l" -{ - /* 2002+: inline comment */ - #if 0 /* RXWRXW - Directive state */ - if (YY_START != DIRECTIVE_STATE && YY_START != SET_DIRECTIVE_STATE) { - ppecho (" ", 0, 1); - } - #endif -} - YY_BREAK -case 2: -YY_RULE_SETUP -#line 206 "pplex.l" -{ - /* 2002+: definition of compiler constants display message during compilation */ - /* Define here to preempt next debug rule below */ - BEGIN DEFINE_DIRECTIVE_STATE; - return DEFINE_DIRECTIVE; -} - YY_BREAK -case 3: -YY_RULE_SETUP -#line 213 "pplex.l" -{ - /* OpenCOBOL/GnuCOBOL 2.x extension: display message during compilation */ - display_msg[0] = 0; - BEGIN DISPLAY_DIRECTIVE_STATE; -} - YY_BREAK -case 4: -YY_RULE_SETUP -#line 219 "pplex.l" -{ - /* 2002 (only) floating debug line */ - /* Remove line if debugging lines not activated */ - /* Otherwise ignore the directive part of the line */ - (void) cb_verify (cb_debugging_mode, _("debugging indicator")); - if (!cb_flag_debugging_line) { - skip_to_eol (); - } -} - YY_BREAK -case 5: -YY_RULE_SETUP -#line 229 "pplex.l" -{ - /* 2002+: listing directive for page eject with optional comment - Note: processed in cobc.c */ - skip_to_eol (); -} - YY_BREAK -case 6: -YY_RULE_SETUP -#line 235 "pplex.l" -{ - /* 2002+: listing directive for (de-)activating the listing, - ON implied for empty value - Note: further checks in ppparse.y, processed in cobc.c */ - BEGIN ON_OFF_DIRECTIVE_STATE; - return LISTING_DIRECTIVE; -} - YY_BREAK -case 7: -YY_RULE_SETUP -#line 243 "pplex.l" -{ - /* 2002+: directive for setting source format */ - BEGIN SOURCE_DIRECTIVE_STATE; - return SOURCE_DIRECTIVE; -} - YY_BREAK -case 8: -YY_RULE_SETUP -#line 249 "pplex.l" -{ - /* OpenCOBOL/GnuCOBOL 2.0 extension: MF SET directive in 2002+ style format */ - BEGIN SET_DIRECTIVE_STATE; - return SET_DIRECTIVE; -} - YY_BREAK -case 9: -YY_RULE_SETUP -#line 255 "pplex.l" -{ - /* 2002+: directive for (de-)activating exception checks */ - BEGIN TURN_DIRECTIVE_STATE; - return TURN_DIRECTIVE; -} - YY_BREAK -case 10: -YY_RULE_SETUP -#line 261 "pplex.l" -{ - /* 2002+: conditional compilation */ - BEGIN IF_DIRECTIVE_STATE; - return IF_DIRECTIVE; -} - YY_BREAK -case 11: -#line 267 "pplex.l" -case 12: -YY_RULE_SETUP -#line 267 "pplex.l" -{ - /* OpenCOBOL extension: conditional compilation combined ELSE IF, - 2002+ style format */ - BEGIN IF_DIRECTIVE_STATE; - return ELIF_DIRECTIVE; -} - YY_BREAK -case 13: -YY_RULE_SETUP -#line 273 "pplex.l" -{ - /* 2002+: conditional compilation */ - BEGIN ELSE_DIRECTIVE_STATE; - return ELSE_DIRECTIVE; -} - YY_BREAK -case 14: -YY_RULE_SETUP -#line 278 "pplex.l" -{ - /* 2002+: conditional compilation */ - BEGIN ENDIF_DIRECTIVE_STATE; - return ENDIF_DIRECTIVE; -} - YY_BREAK -case 15: -YY_RULE_SETUP -#line 284 "pplex.l" -{ - /* 2002+: more then 60 seconds per minute (currently always set to off), - OFF implied for empty value */ - BEGIN ON_OFF_DIRECTIVE_STATE; - return LEAP_SECOND_DIRECTIVE; -} - YY_BREAK -case 16: -YY_RULE_SETUP -#line 291 "pplex.l" -{ - /* 2002+: convention for CALL/CANCEL */ - BEGIN CALL_DIRECTIVE_STATE; - return CALL_DIRECTIVE; -} - YY_BREAK -case 17: -/* rule 17 can match eol */ -YY_RULE_SETUP -#line 297 "pplex.l" -{ - /* empty 2002+ style directive */ - cb_plex_warning (COBC_WARN_FILLER, newline_count, - _("ignoring empty directive")); - unput ('\n'); -} - YY_BREAK -case 18: -YY_RULE_SETUP -#line 304 "pplex.l" -{ - /* unknown 2002+ style directive */ - char *s; - - s = strchr (yytext, '>'); - cb_plex_warning (COBC_WARN_FILLER, newline_count, - _("ignoring invalid directive: '%s'"), s); - skip_to_eol (); -} - YY_BREAK -case 19: -YY_RULE_SETUP -#line 314 "pplex.l" -{ - /* unknown 2002+ style directive */ - cb_plex_warning (COBC_WARN_FILLER, newline_count, - _("ignoring invalid directive")); - skip_to_eol (); -} - YY_BREAK -case 20: -YY_RULE_SETUP -#line 321 "pplex.l" -{ - /* MF extension: include @(#)text\0 in the object file */ - /* we just add a warning for now, maybe implement it later */ - CB_PENDING (_("VCS directive")); - skip_to_eol (); -} - YY_BREAK -case 21: -YY_RULE_SETUP -#line 328 "pplex.l" -{ - /* MF extension: display message during compilation */ - display_msg[0] = 0; - BEGIN DISPLAY_DIRECTIVE_STATE; -} - YY_BREAK -case 22: -YY_RULE_SETUP -#line 334 "pplex.l" -{ - /* MF extension: SET directive */ - BEGIN SET_DIRECTIVE_STATE; - return SET_DIRECTIVE; -} - YY_BREAK -case 23: -YY_RULE_SETUP -#line 340 "pplex.l" -{ - /* MF extension: conditional compilation */ - BEGIN IF_DIRECTIVE_STATE; - return IF_DIRECTIVE; -} - YY_BREAK -case 24: -#line 346 "pplex.l" -case 25: -YY_RULE_SETUP -#line 346 "pplex.l" -{ - /* OpenCOBOL/GnuCOBOL 2.0 extension: conditional compilation combined ELSE IF, - MF style format */ - BEGIN IF_DIRECTIVE_STATE; - return ELIF_DIRECTIVE; -} - YY_BREAK -case 26: -YY_RULE_SETUP -#line 352 "pplex.l" -{ - /* MF extension: conditional compilation */ - BEGIN ELSE_DIRECTIVE_STATE; - return ELSE_DIRECTIVE; -} - YY_BREAK -case 27: -YY_RULE_SETUP -#line 357 "pplex.l" -{ - /* MF extension: conditional compilation */ - BEGIN ENDIF_DIRECTIVE_STATE; - return ENDIF_DIRECTIVE; -} - YY_BREAK -case 28: -YY_RULE_SETUP -#line 363 "pplex.l" -{ - /* unknown MF style directive */ - char *s; - - s = strchr (yytext, '$'); - cb_plex_warning (COBC_WARN_FILLER, newline_count, - _("ignoring invalid directive: '%s'"), s); - skip_to_eol (); -} - YY_BREAK -case 29: -YY_RULE_SETUP -#line 373 "pplex.l" -{ - /* Allow $ in column 7 for acucomment in fixed format */ - if (cb_source_format == CB_FORMAT_FREE) { - cb_plex_warning (COBC_WARN_FILLER, newline_count, - _("spurious '$' detected - ignored")); - skip_to_eol (); - } -} - YY_BREAK -case 30: -YY_RULE_SETUP -#line 382 "pplex.l" -{ - /* Fujitsu COBOL extension for specifying command line options */ - char * s = strchr (yytext, '@'); - cb_plex_warning (COBC_WARN_FILLER, newline_count, - _("ignoring unknown directive: '%s'"), s); - skip_to_eol (); -} - YY_BREAK -case 31: -YY_RULE_SETUP -#line 390 "pplex.l" -{ - cb_plex_warning (COBC_WARN_FILLER, newline_count, - _("spurious '$' detected - ignored")); - skip_to_eol (); -} - YY_BREAK -case 32: -YY_RULE_SETUP -#line 396 "pplex.l" -{ - cb_plex_warning (COBC_WARN_FILLER, newline_count, - _("PROCESS statement ignored")); - skip_to_eol (); -} - YY_BREAK -case 33: -YY_RULE_SETUP -#line 402 "pplex.l" -{ - yy_push_state (COPY_STATE); - if (cb_src_list_file) { - get_new_listing_file (); - } - return COPY; -} - YY_BREAK -case 34: -YY_RULE_SETUP -#line 410 "pplex.l" -{ - /* Note: ++INCLUDE/-INC (include only the data records, - must be specified in column 8/1) and are not implemented yet */ - yy_push_state (COPY_STATE); - if (cb_src_list_file) { - get_new_listing_file (); - } - return COPY; -} - YY_BREAK -case 35: -YY_RULE_SETUP -#line 420 "pplex.l" -{ - yy_push_state (COPY_STATE); - return REPLACE; -} - YY_BREAK -case 36: -#line 426 "pplex.l" -case 37: -YY_RULE_SETUP -#line 426 "pplex.l" -{ - BEGIN CONTROL_STATEMENT_STATE; - return CONTROL_STATEMENT; -} - YY_BREAK -case 38: -/* rule 38 can match eol */ -YY_RULE_SETUP -#line 431 "pplex.l" -{ - /* Allow comment sentences/paragraphs */ - comment_allowed = 1; - ppecho (yytext, 0, (int)yyleng); -} - YY_BREAK -case 39: -YY_RULE_SETUP -#line 437 "pplex.l" -{ - /* Allow comment sentences/paragraphs */ - comment_allowed = 1; - ppecho (yytext, 0, (int)yyleng); -} - YY_BREAK -case 40: -YY_RULE_SETUP -#line 443 "pplex.l" -{ - /* Disallow comment sentences/paragraphs */ - comment_allowed = 0; - ppecho (yytext, 0, (int)yyleng); -} - YY_BREAK -case 41: -YY_RULE_SETUP -#line 449 "pplex.l" -{ - /* Disallow comment sentences/paragraphs */ - comment_allowed = 0; - ppecho (yytext, 0, (int)yyleng); -} - YY_BREAK -case 42: -#line 456 "pplex.l" -case 43: -#line 457 "pplex.l" -case 44: -#line 458 "pplex.l" -case 45: -YY_RULE_SETUP -#line 458 "pplex.l" -{ - /* These words can either be a listing-directive statement, - a reserved word, or a user-defined word... - some implementations (dis-)allow the (optional) "." - some start column 8+ some column 12+ - We ignore the detailed rules and just do the parsing. */ - if (cb_verify (cb_listing_statements, yytext)) { - /* handle as listing-directive statement */ - skip_to_eol(); - return LISTING_STATEMENT; - } else if (cb_listing_statements == CB_SKIP) { - /* handle later (normal reserved / user defined word) */ - ECHO; - check_listing (yytext, 0); - } else { - /* Ignore */ - } -} - YY_BREAK -case 46: -/* rule 46 can match eol */ -YY_RULE_SETUP -#line 477 "pplex.l" -{ - /* This word can either be a listing-directive statement, - a reserved word, or a user-defined word... - some implementations (dis-)allow the (optional) "." - some start column 8+ some column 12+, - most limit the literal length (we cut in cobc.c) - We ignore the detailed rules and just do the parsing. */ - if (cb_verify (cb_title_statement, yytext)) { - /* handle as listing-directive statement */ - BEGIN ALNUM_LITERAL_STATE; - return TITLE_STATEMENT; - } else if (cb_title_statement == CB_SKIP) { - /* handle later (normal reserved / user defined word) */ - ECHO; - check_listing (yytext, 0); - } else { - /* Ignore */ - } -} - YY_BREAK -case 47: -/* rule 47 can match eol */ -YY_RULE_SETUP -#line 497 "pplex.l" -{ - /* Pick up early - Also activates debugging lines */ - cb_verify (cb_debugging_mode, "DEBUGGING MODE"); - cb_flag_debugging_line = 1; - ppecho (yytext, 0, (int)yyleng); -} - YY_BREAK -case 48: -/* rule 48 can match eol */ -YY_RULE_SETUP -#line 504 "pplex.l" -{ - ppecho ("\n", 0, 1); - cb_source_line++; -} - YY_BREAK -case 49: -YY_RULE_SETUP -#line 509 "pplex.l" -{ - ppecho (" ", 1U, 1); -} - YY_BREAK -case 50: -YY_RULE_SETUP -#line 513 "pplex.l" -{ - if (inside_bracket) { - ppecho (", ", 0, 2); - } else { - ppecho (" ", 1U, 1); - } -} - YY_BREAK -case 51: -YY_RULE_SETUP -#line 521 "pplex.l" -{ - inside_bracket++; - ppecho ("(", 0, 1); -} - YY_BREAK -case 52: -YY_RULE_SETUP -#line 526 "pplex.l" -{ - if (inside_bracket) { - inside_bracket--; - } - ppecho (")", 0, 1); -} - YY_BREAK -case 53: -#line 534 "pplex.l" -case 54: -#line 535 "pplex.l" -case 55: -#line 536 "pplex.l" -case 56: -YY_RULE_SETUP -#line 536 "pplex.l" -{ - ppecho (yytext, 0, (int)yyleng); -} - YY_BREAK - -case 57: -/* rule 57 can match eol */ -YY_RULE_SETUP -#line 551 "pplex.l" -{ - BEGIN INITIAL; - unput ('\n'); - return TERMINATOR; - } - YY_BREAK -case 58: -YY_RULE_SETUP -#line 556 "pplex.l" -{ /* ignore */ } - YY_BREAK -case 59: -YY_RULE_SETUP -#line 557 "pplex.l" -{ - return DOT; - } - YY_BREAK - - -case 60: -/* rule 60 can match eol */ -YY_RULE_SETUP -#line 563 "pplex.l" -{ - BEGIN INITIAL; - display_finish(); - } - YY_BREAK -case 61: -YY_RULE_SETUP -#line 568 "pplex.l" -{ - yytext[yyleng - 1] = 0; - strncat (display_msg, yytext + 1, (size_t)(PPLEX_BUFF_LEN - 1)); - } - YY_BREAK -case 62: -#line 574 "pplex.l" -case 63: -YY_RULE_SETUP -#line 574 "pplex.l" -{ - strncat (display_msg, yytext, (size_t)(PPLEX_BUFF_LEN - 1)); - } - YY_BREAK - - -case 64: -YY_RULE_SETUP -#line 580 "pplex.l" -{ return ON; } - YY_BREAK -case 65: -YY_RULE_SETUP -#line 581 "pplex.l" -{ return OFF; } - YY_BREAK - - -case 66: -YY_RULE_SETUP -#line 585 "pplex.l" -{ return FORMAT; } - YY_BREAK -case 67: -YY_RULE_SETUP -#line 586 "pplex.l" -{ return IS; } - YY_BREAK -case 68: -YY_RULE_SETUP -#line 587 "pplex.l" -{ return FIXED; } - YY_BREAK -case 69: -YY_RULE_SETUP -#line 588 "pplex.l" -{ return FREE; } - YY_BREAK -case 70: -YY_RULE_SETUP -#line 589 "pplex.l" -{ return VARIABLE; } - YY_BREAK - - -case 71: -YY_RULE_SETUP -#line 593 "pplex.l" -{ return COBOL; } - YY_BREAK -case 72: -YY_RULE_SETUP -#line 594 "pplex.l" -{ return TOK_EXTERN; } - YY_BREAK -case 73: -YY_RULE_SETUP -#line 595 "pplex.l" -{ return STDCALL; } - YY_BREAK -case 74: -YY_RULE_SETUP -#line 596 "pplex.l" -{ return STATIC; } - YY_BREAK - - -case 75: -YY_RULE_SETUP -#line 600 "pplex.l" -{ return SOURCE; } - YY_BREAK -case 76: -YY_RULE_SETUP -#line 601 "pplex.l" -{ return NOSOURCE; } - YY_BREAK -case 77: -YY_RULE_SETUP -#line 602 "pplex.l" -{ return LIST; } - YY_BREAK -case 78: -YY_RULE_SETUP -#line 603 "pplex.l" -{ return NOLIST; } - YY_BREAK -case 79: -YY_RULE_SETUP -#line 604 "pplex.l" -{ return MAP; } - YY_BREAK -case 80: -YY_RULE_SETUP -#line 605 "pplex.l" -{ return NOMAP; } - YY_BREAK - - -/* OpenCOBOL/GnuCOBOL 2.0 extension: MF $SET CONSTANT in 2002+ style as - >> DEFINE CONSTANT var [AS] literal archaic extension: - use plain >> DEFINE var [AS] literal for conditional compilation and - use 01 CONSTANT with/without FROM clause for constant definitions */ -case 81: -YY_RULE_SETUP -#line 613 "pplex.l" -{ - return CONSTANT; - } - YY_BREAK -case 82: -YY_RULE_SETUP -#line 616 "pplex.l" -{ - return AS; - } - YY_BREAK -case 83: -YY_RULE_SETUP -#line 619 "pplex.l" -{ - return OFF; - } - YY_BREAK -case 84: -YY_RULE_SETUP -#line 622 "pplex.l" -{ - return OVERRIDE; - } - YY_BREAK -case 85: -YY_RULE_SETUP -#line 625 "pplex.l" -{ - return PARAMETER; - } - YY_BREAK -case 86: -#line 629 "pplex.l" -case 87: -YY_RULE_SETUP -#line 629 "pplex.l" -{ - pplval.s = cobc_plex_strdup (yytext); - return LITERAL; - } - YY_BREAK -case 88: -YY_RULE_SETUP -#line 633 "pplex.l" -{ - pplval.s = cobc_plex_strdup (yytext); - return VARIABLE_NAME; - } - YY_BREAK - - -case 89: -#line 641 "pplex.l" -case 90: -YY_RULE_SETUP -#line 641 "pplex.l" -{ - return ADDRSV; - } - YY_BREAK -case 91: -#line 645 "pplex.l" -case 92: -YY_RULE_SETUP -#line 645 "pplex.l" -{ - return ADDSYN; - } - YY_BREAK -case 93: -YY_RULE_SETUP -#line 648 "pplex.l" -{ - return ASSIGN; - } - YY_BREAK -case 94: -YY_RULE_SETUP -#line 651 "pplex.l" -{ - return CALLFH; - } - YY_BREAK -case 95: -#line 655 "pplex.l" -case 96: -YY_RULE_SETUP -#line 655 "pplex.l" -{ - return COMP1; - } - YY_BREAK -case 97: -YY_RULE_SETUP -#line 658 "pplex.l" -{ - return CONSTANT; - } - YY_BREAK -case 98: -#line 662 "pplex.l" -case 99: -YY_RULE_SETUP -#line 662 "pplex.l" -{ - return FOLDCOPYNAME; - } - YY_BREAK -case 100: -#line 666 "pplex.l" -case 101: -YY_RULE_SETUP -#line 666 "pplex.l" -{ - return MAKESYN; - } - YY_BREAK -case 102: -#line 670 "pplex.l" -case 103: -#line 671 "pplex.l" -case 104: -YY_RULE_SETUP -#line 671 "pplex.l" -{ - return NOFOLDCOPYNAME; - } - YY_BREAK -case 105: -YY_RULE_SETUP -#line 674 "pplex.l" -{ - return OVERRIDE; - } - YY_BREAK -case 106: -YY_RULE_SETUP -#line 677 "pplex.l" -{ - return REMOVE; - } - YY_BREAK -case 107: -#line 681 "pplex.l" -case 108: -YY_RULE_SETUP -#line 681 "pplex.l" -{ - return SOURCEFORMAT; - } - YY_BREAK -/*"AS" { - not available with MF compilers - - return AS; - }*/ -case 109: -YY_RULE_SETUP -#line 687 "pplex.l" -{ - return XFD; - } - YY_BREAK -case 110: -#line 691 "pplex.l" -case 111: -#line 692 "pplex.l" -case 112: -YY_RULE_SETUP -#line 692 "pplex.l" -{ - - pplval.s = cobc_plex_strdup (yytext); - return LITERAL; - } - YY_BREAK -case 113: -YY_RULE_SETUP -#line 697 "pplex.l" -{ - pplval.s = cobc_plex_strdup (yytext); - return VARIABLE_NAME; - } - YY_BREAK -case 114: -YY_RULE_SETUP -#line 701 "pplex.l" -{ - return EQ; - } - YY_BREAK - - -case 115: -YY_RULE_SETUP -#line 707 "pplex.l" -{ - return ON; - } - YY_BREAK -case 116: -YY_RULE_SETUP -#line 710 "pplex.l" -{ - return OFF; - } - YY_BREAK -case 117: -YY_RULE_SETUP -#line 713 "pplex.l" -{ - return WITH; - } - YY_BREAK -case 118: -YY_RULE_SETUP -#line 716 "pplex.l" -{ - return LOCATION; - } - YY_BREAK -case 119: -YY_RULE_SETUP -#line 719 "pplex.l" -{ - return CHECKING; - } - YY_BREAK -case 120: -#line 723 "pplex.l" -case 121: -YY_RULE_SETUP -#line 723 "pplex.l" -{ - pplval.s = cobc_plex_strdup (yytext); - return LITERAL; - } - YY_BREAK -case 122: -YY_RULE_SETUP -#line 727 "pplex.l" -{ - yytext[yyleng - 1] = 0; - pplval.s = cobc_plex_strdup (yytext + 1); - return LITERAL; - } - YY_BREAK -case 123: -YY_RULE_SETUP -#line 732 "pplex.l" -{ - pplval.s = cobc_plex_strdup (yytext); - return VARIABLE_NAME; - } - YY_BREAK - - -case 124: -#line 744 "pplex.l" -case 125: -YY_RULE_SETUP -#line 744 "pplex.l" -{ - return LITERAL; - } - YY_BREAK -case 126: -YY_RULE_SETUP -#line 747 "pplex.l" -{ - return GARBAGE; - } - YY_BREAK - - -case 127: -YY_RULE_SETUP -#line 753 "pplex.l" -{ return IS; } - YY_BREAK -case 128: -YY_RULE_SETUP -#line 754 "pplex.l" -{ return NOT; } - YY_BREAK -case 129: -YY_RULE_SETUP -#line 755 "pplex.l" -{ return EQUAL; } - YY_BREAK -case 130: -YY_RULE_SETUP -#line 756 "pplex.l" -{ return TO; } - YY_BREAK -case 131: -YY_RULE_SETUP -#line 757 "pplex.l" -{ return OR; } - YY_BREAK -case 132: -YY_RULE_SETUP -#line 758 "pplex.l" -{ return GREATER; } - YY_BREAK -case 133: -YY_RULE_SETUP -#line 759 "pplex.l" -{ return LESS; } - YY_BREAK -case 134: -YY_RULE_SETUP -#line 760 "pplex.l" -{ return THAN; } - YY_BREAK -case 135: -YY_RULE_SETUP -#line 761 "pplex.l" -{ return DEFINED; } - YY_BREAK -case 136: -YY_RULE_SETUP -#line 762 "pplex.l" -{ return SET; } - YY_BREAK -case 137: -YY_RULE_SETUP -#line 763 "pplex.l" -{ return GE; } - YY_BREAK -case 138: -YY_RULE_SETUP -#line 764 "pplex.l" -{ return GT; } - YY_BREAK -case 139: -YY_RULE_SETUP -#line 765 "pplex.l" -{ return LE; } - YY_BREAK -case 140: -YY_RULE_SETUP -#line 766 "pplex.l" -{ return NE; } - YY_BREAK -case 141: -YY_RULE_SETUP -#line 767 "pplex.l" -{ return LT; } - YY_BREAK -case 142: -YY_RULE_SETUP -#line 768 "pplex.l" -{ return EQ; } - YY_BREAK -case 143: -#line 770 "pplex.l" -case 144: -YY_RULE_SETUP -#line 770 "pplex.l" -{ - pplval.s = cobc_plex_strdup (yytext); - return LITERAL; - } - YY_BREAK -case 145: -YY_RULE_SETUP -#line 774 "pplex.l" -{ - pplval.s = cobc_plex_strdup (yytext); - return VARIABLE_NAME; - } - YY_BREAK - - -case 146: -YY_RULE_SETUP -#line 781 "pplex.l" -{ - return LITERAL; - } - YY_BREAK - - -case 147: -/* rule 147 can match eol */ -YY_RULE_SETUP -#line 787 "pplex.l" -{ - ECHO; - check_listing (yytext, 0); - cb_source_line++; - } - YY_BREAK -case 148: -YY_RULE_SETUP -#line 792 "pplex.l" -{ /* ignore */ } - YY_BREAK -case 149: -YY_RULE_SETUP -#line 793 "pplex.l" -{ - /* special case to allow copybook names with periods - without a literal - given the rule: not starting, not ending, not doubled - *unlikely* to need a configuration option */ - pplval.s = cobc_plex_strdup (yytext); - return TEXT_NAME; - } - YY_BREAK -case 150: -YY_RULE_SETUP -#line 801 "pplex.l" -{ - yy_pop_state (); - return DOT; - } - YY_BREAK -case 151: -YY_RULE_SETUP -#line 805 "pplex.l" -{ yy_push_state (PSEUDO_STATE); return EQEQ; } - YY_BREAK -case 152: -YY_RULE_SETUP -#line 806 "pplex.l" -{ return '('; } - YY_BREAK -case 153: -YY_RULE_SETUP -#line 807 "pplex.l" -{ return ')'; } - YY_BREAK -case 154: -YY_RULE_SETUP -#line 808 "pplex.l" -{ return BY; } - YY_BREAK -case 155: -YY_RULE_SETUP -#line 809 "pplex.l" -{ return IN; } - YY_BREAK -case 156: -YY_RULE_SETUP -#line 810 "pplex.l" -{ return OF; } - YY_BREAK -case 157: -YY_RULE_SETUP -#line 811 "pplex.l" -{ return OFF; } - YY_BREAK -case 158: -YY_RULE_SETUP -#line 812 "pplex.l" -{ return SUPPRESS; } - YY_BREAK -case 159: -YY_RULE_SETUP -#line 813 "pplex.l" -{ return PRINTING; } - YY_BREAK -case 160: -YY_RULE_SETUP -#line 814 "pplex.l" -{ return REPLACING; } - YY_BREAK -case 161: -YY_RULE_SETUP -#line 815 "pplex.l" -{ return LEADING; } - YY_BREAK -case 162: -YY_RULE_SETUP -#line 816 "pplex.l" -{ return TRAILING; } - YY_BREAK -case 163: -YY_RULE_SETUP -#line 817 "pplex.l" -{ return ALSO; } - YY_BREAK -case 164: -YY_RULE_SETUP -#line 818 "pplex.l" -{ return LAST; } - YY_BREAK -case 165: -#line 820 "pplex.l" -case 166: -#line 821 "pplex.l" -case 167: -#line 822 "pplex.l" -case 168: -YY_RULE_SETUP -#line 822 "pplex.l" -{ - pplval.s = cobc_plex_strdup (yytext); - return TOKEN; - } - YY_BREAK - - -case 169: -/* rule 169 can match eol */ -YY_RULE_SETUP -#line 829 "pplex.l" -{ - ECHO; - check_listing (yytext, 0); - cb_source_line++; - } - YY_BREAK -case 170: -YY_RULE_SETUP -#line 835 "pplex.l" -{ - pplval.s = cobc_plex_strdup (" "); - return TOKEN; - } - YY_BREAK -case 171: -YY_RULE_SETUP -#line 840 "pplex.l" -{ - yy_pop_state (); - return EQEQ; - } - YY_BREAK -case 172: -#line 846 "pplex.l" -case 173: -#line 847 "pplex.l" -case 174: -#line 848 "pplex.l" -case 175: -YY_RULE_SETUP -#line 848 "pplex.l" -{ - pplval.s = cobc_plex_strdup (yytext); - return TOKEN; - } - YY_BREAK - -case YY_STATE_EOF(INITIAL): -case YY_STATE_EOF(CALL_DIRECTIVE_STATE): -case YY_STATE_EOF(COPY_STATE): -case YY_STATE_EOF(PSEUDO_STATE): -case YY_STATE_EOF(SOURCE_DIRECTIVE_STATE): -case YY_STATE_EOF(DEFINE_DIRECTIVE_STATE): -case YY_STATE_EOF(ON_OFF_DIRECTIVE_STATE): -case YY_STATE_EOF(SET_DIRECTIVE_STATE): -case YY_STATE_EOF(TURN_DIRECTIVE_STATE): -case YY_STATE_EOF(IF_DIRECTIVE_STATE): -case YY_STATE_EOF(ELSE_DIRECTIVE_STATE): -case YY_STATE_EOF(ENDIF_DIRECTIVE_STATE): -case YY_STATE_EOF(ALNUM_LITERAL_STATE): -case YY_STATE_EOF(CONTROL_STATEMENT_STATE): -case YY_STATE_EOF(DISPLAY_DIRECTIVE_STATE): -#line 854 "pplex.l" -{ - struct copy_info *current_copy_info = copy_stack; - - yy_delete_buffer (YY_CURRENT_BUFFER); - - /* Terminate at the end of all input */ - if (current_copy_info->next == NULL) { - /* Check dangling IF/ELSE */ - for (; plex_nest_depth > 0; --plex_nest_depth) { - cb_source_line = plex_cond_stack[plex_nest_depth].line; - cb_error (_("IF/ELIF/ELSE directive without matching END-IF")); - } - plex_nest_depth = 0; - cobc_free (current_copy_info->dname); - cobc_free (current_copy_info); - listing_line = 0; - requires_listing_line = 1; - requires_new_line = 0; - need_continuation = 0; - buffer_overflow = 0; - within_comment = 0; - newline_count = 0; - inside_bracket = 0; - comment_allowed = 1; - current_replace_list = NULL; - base_replace_list = NULL; - save_current_replace = NULL; - text_queue = NULL; - copy_stack = NULL; - quotation_mark = 0; - consecutive_quotation = 0; - yyterminate (); - } - - /* Close the current file (can be NULL if open failed) */ - if (ppin) { - fclose (ppin); - ppin = NULL; - } - - if (current_copy_info->containing_files) { - cb_current_file = current_copy_info->containing_files; - } - - /* Switch to previous buffer */ - switch_to_buffer (current_copy_info->line, current_copy_info->file, - current_copy_info->buffer); - - /* Restore variables */ - current_replace_list = current_copy_info->replacing; - quotation_mark = current_copy_info->quotation_mark; - cb_source_format = current_copy_info->source_format; - - copy_stack = current_copy_info->next; - cobc_free (current_copy_info->dname); - cobc_free (current_copy_info); -} - YY_BREAK -case 176: -YY_RULE_SETUP -#line 912 "pplex.l" -ECHO; - YY_BREAK -#line 4526 "pplex.c" - - case YY_END_OF_BUFFER: - { - /* Amount of text matched not including the EOB char. */ - int yy_amount_of_matched_text = (int) (yy_cp - (yytext_ptr)) - 1; - - /* Undo the effects of YY_DO_BEFORE_ACTION. */ - *yy_cp = (yy_hold_char); - YY_RESTORE_YY_MORE_OFFSET - - if ( YY_CURRENT_BUFFER_LVALUE->yy_buffer_status == YY_BUFFER_NEW ) - { - /* We're scanning a new file or input source. It's - * possible that this happened because the user - * just pointed yyin at a new source and called - * yylex(). If so, then we have to assure - * consistency between YY_CURRENT_BUFFER and our - * globals. Here is the right place to do so, because - * this is the first action (other than possibly a - * back-up) that will match for the new input source. - */ - (yy_n_chars) = YY_CURRENT_BUFFER_LVALUE->yy_n_chars; - YY_CURRENT_BUFFER_LVALUE->yy_input_file = yyin; - YY_CURRENT_BUFFER_LVALUE->yy_buffer_status = YY_BUFFER_NORMAL; - } - - /* Note that here we test for yy_c_buf_p "<=" to the position - * of the first EOB in the buffer, since yy_c_buf_p will - * already have been incremented past the NUL character - * (since all states make transitions on EOB to the - * end-of-buffer state). Contrast this with the test - * in input(). - */ - if ( (yy_c_buf_p) <= &YY_CURRENT_BUFFER_LVALUE->yy_ch_buf[(yy_n_chars)] ) - { /* This was really a NUL. */ - yy_state_type yy_next_state; - - (yy_c_buf_p) = (yytext_ptr) + yy_amount_of_matched_text; - - yy_current_state = yy_get_previous_state( ); - - /* Okay, we're now positioned to make the NUL - * transition. We couldn't have - * yy_get_previous_state() go ahead and do it - * for us because it doesn't know how to deal - * with the possibility of jamming (and we don't - * want to build jamming into it because then it - * will run more slowly). - */ - - yy_next_state = yy_try_NUL_trans( yy_current_state ); - - yy_bp = (yytext_ptr) + YY_MORE_ADJ; - - if ( yy_next_state ) - { - /* Consume the NUL. */ - yy_cp = ++(yy_c_buf_p); - yy_current_state = yy_next_state; - goto yy_match; - } - - else - { - yy_cp = (yy_last_accepting_cpos); - yy_current_state = (yy_last_accepting_state); - goto yy_find_action; - } - } - - else switch ( yy_get_next_buffer( ) ) - { - case EOB_ACT_END_OF_FILE: - { - (yy_did_buffer_switch_on_eof) = 0; - - if ( yywrap( ) ) - { - /* Note: because we've taken care in - * yy_get_next_buffer() to have set up - * yytext, we can now set up - * yy_c_buf_p so that if some total - * hoser (like flex itself) wants to - * call the scanner after we return the - * YY_NULL, it'll still work - another - * YY_NULL will get returned. - */ - (yy_c_buf_p) = (yytext_ptr) + YY_MORE_ADJ; - - yy_act = YY_STATE_EOF(YY_START); - goto do_action; - } - - else - { - if ( ! (yy_did_buffer_switch_on_eof) ) - YY_NEW_FILE; - } - break; - } - - case EOB_ACT_CONTINUE_SCAN: - (yy_c_buf_p) = - (yytext_ptr) + yy_amount_of_matched_text; - - yy_current_state = yy_get_previous_state( ); - - yy_cp = (yy_c_buf_p); - yy_bp = (yytext_ptr) + YY_MORE_ADJ; - goto yy_match; - - case EOB_ACT_LAST_MATCH: - (yy_c_buf_p) = - &YY_CURRENT_BUFFER_LVALUE->yy_ch_buf[(yy_n_chars)]; - - yy_current_state = yy_get_previous_state( ); - - yy_cp = (yy_c_buf_p); - yy_bp = (yytext_ptr) + YY_MORE_ADJ; - goto yy_find_action; - } - break; - } - - default: - YY_FATAL_ERROR( - "fatal flex scanner internal error--no action found" ); - } /* end of action switch */ - } /* end of scanning one token */ - } /* end of user's declarations */ -} /* end of yylex */ - -/* yy_get_next_buffer - try to read in a new buffer - * - * Returns a code representing an action: - * EOB_ACT_LAST_MATCH - - * EOB_ACT_CONTINUE_SCAN - continue scanning from current position - * EOB_ACT_END_OF_FILE - end of file - */ -static int yy_get_next_buffer (void) -{ - char *dest = YY_CURRENT_BUFFER_LVALUE->yy_ch_buf; - char *source = (yytext_ptr); - int number_to_move, i; - int ret_val; - - if ( (yy_c_buf_p) > &YY_CURRENT_BUFFER_LVALUE->yy_ch_buf[(yy_n_chars) + 1] ) - YY_FATAL_ERROR( - "fatal flex scanner internal error--end of buffer missed" ); - - if ( YY_CURRENT_BUFFER_LVALUE->yy_fill_buffer == 0 ) - { /* Don't try to fill the buffer, so this is an EOF. */ - if ( (yy_c_buf_p) - (yytext_ptr) - YY_MORE_ADJ == 1 ) - { - /* We matched a single character, the EOB, so - * treat this as a final EOF. - */ - return EOB_ACT_END_OF_FILE; - } - - else - { - /* We matched some text prior to the EOB, first - * process it. - */ - return EOB_ACT_LAST_MATCH; - } - } - - /* Try to read more data. */ - - /* First move last chars to start of buffer. */ - number_to_move = (int) ((yy_c_buf_p) - (yytext_ptr) - 1); - - for ( i = 0; i < number_to_move; ++i ) - *(dest++) = *(source++); - - if ( YY_CURRENT_BUFFER_LVALUE->yy_buffer_status == YY_BUFFER_EOF_PENDING ) - /* don't do the read, it's not guaranteed to return an EOF, - * just force an EOF - */ - YY_CURRENT_BUFFER_LVALUE->yy_n_chars = (yy_n_chars) = 0; - - else - { - int num_to_read = - YY_CURRENT_BUFFER_LVALUE->yy_buf_size - number_to_move - 1; - - while ( num_to_read <= 0 ) - { /* Not enough room in the buffer - grow it. */ - - /* just a shorter name for the current buffer */ - YY_BUFFER_STATE b = YY_CURRENT_BUFFER_LVALUE; - - int yy_c_buf_p_offset = - (int) ((yy_c_buf_p) - b->yy_ch_buf); - - if ( b->yy_is_our_buffer ) - { - int new_size = b->yy_buf_size * 2; - - if ( new_size <= 0 ) - b->yy_buf_size += b->yy_buf_size / 8; - else - b->yy_buf_size *= 2; - - b->yy_ch_buf = (char *) - /* Include room in for 2 EOB chars. */ - yyrealloc( (void *) b->yy_ch_buf, - (yy_size_t) (b->yy_buf_size + 2) ); - } - else - /* Can't grow it, we don't own it. */ - b->yy_ch_buf = NULL; - - if ( ! b->yy_ch_buf ) - YY_FATAL_ERROR( - "fatal error - scanner input buffer overflow" ); - - (yy_c_buf_p) = &b->yy_ch_buf[yy_c_buf_p_offset]; - - num_to_read = YY_CURRENT_BUFFER_LVALUE->yy_buf_size - - number_to_move - 1; - - } - - if ( num_to_read > YY_READ_BUF_SIZE ) - num_to_read = YY_READ_BUF_SIZE; - - /* Read in more data. */ - YY_INPUT( (&YY_CURRENT_BUFFER_LVALUE->yy_ch_buf[number_to_move]), - (yy_n_chars), num_to_read ); - - YY_CURRENT_BUFFER_LVALUE->yy_n_chars = (yy_n_chars); - } - - if ( (yy_n_chars) == 0 ) - { - if ( number_to_move == YY_MORE_ADJ ) - { - ret_val = EOB_ACT_END_OF_FILE; - yyrestart( yyin ); - } - - else - { - ret_val = EOB_ACT_LAST_MATCH; - YY_CURRENT_BUFFER_LVALUE->yy_buffer_status = - YY_BUFFER_EOF_PENDING; - } - } - - else - ret_val = EOB_ACT_CONTINUE_SCAN; - - if (((yy_n_chars) + number_to_move) > YY_CURRENT_BUFFER_LVALUE->yy_buf_size) { - /* Extend the array by 50%, plus the number we really need. */ - int new_size = (yy_n_chars) + number_to_move + ((yy_n_chars) >> 1); - YY_CURRENT_BUFFER_LVALUE->yy_ch_buf = (char *) yyrealloc( - (void *) YY_CURRENT_BUFFER_LVALUE->yy_ch_buf, (yy_size_t) new_size ); - if ( ! YY_CURRENT_BUFFER_LVALUE->yy_ch_buf ) - YY_FATAL_ERROR( "out of dynamic memory in yy_get_next_buffer()" ); - /* "- 2" to take care of EOB's */ - YY_CURRENT_BUFFER_LVALUE->yy_buf_size = (int) (new_size - 2); - } - - (yy_n_chars) += number_to_move; - YY_CURRENT_BUFFER_LVALUE->yy_ch_buf[(yy_n_chars)] = YY_END_OF_BUFFER_CHAR; - YY_CURRENT_BUFFER_LVALUE->yy_ch_buf[(yy_n_chars) + 1] = YY_END_OF_BUFFER_CHAR; - - (yytext_ptr) = &YY_CURRENT_BUFFER_LVALUE->yy_ch_buf[0]; - - return ret_val; -} - -/* yy_get_previous_state - get the state just before the EOB char was reached */ - - static yy_state_type yy_get_previous_state (void) -{ - yy_state_type yy_current_state; - char *yy_cp; - - yy_current_state = (yy_start); - yy_current_state += YY_AT_BOL(); - - for ( yy_cp = (yytext_ptr) + YY_MORE_ADJ; yy_cp < (yy_c_buf_p); ++yy_cp ) - { - YY_CHAR yy_c = (*yy_cp ? yy_ec[YY_SC_TO_UI(*yy_cp)] : 1); - if ( yy_accept[yy_current_state] ) - { - (yy_last_accepting_state) = yy_current_state; - (yy_last_accepting_cpos) = yy_cp; - } - while ( yy_chk[yy_base[yy_current_state] + yy_c] != yy_current_state ) - { - yy_current_state = (int) yy_def[yy_current_state]; - if ( yy_current_state >= 1463 ) - yy_c = yy_meta[yy_c]; - } - yy_current_state = yy_nxt[yy_base[yy_current_state] + yy_c]; - } - - return yy_current_state; -} - -/* yy_try_NUL_trans - try to make a transition on the NUL character - * - * synopsis - * next_state = yy_try_NUL_trans( current_state ); - */ - static yy_state_type yy_try_NUL_trans (yy_state_type yy_current_state ) -{ - int yy_is_jam; - char *yy_cp = (yy_c_buf_p); - - YY_CHAR yy_c = 1; - if ( yy_accept[yy_current_state] ) - { - (yy_last_accepting_state) = yy_current_state; - (yy_last_accepting_cpos) = yy_cp; - } - while ( yy_chk[yy_base[yy_current_state] + yy_c] != yy_current_state ) - { - yy_current_state = (int) yy_def[yy_current_state]; - if ( yy_current_state >= 1463 ) - yy_c = yy_meta[yy_c]; - } - yy_current_state = yy_nxt[yy_base[yy_current_state] + yy_c]; - yy_is_jam = (yy_current_state == 1462); - - return yy_is_jam ? 0 : yy_current_state; -} - -#ifndef YY_NO_UNPUT - - static void yyunput (int c, char * yy_bp ) -{ - char *yy_cp; - - yy_cp = (yy_c_buf_p); - - /* undo effects of setting up yytext */ - *yy_cp = (yy_hold_char); - - if ( yy_cp < YY_CURRENT_BUFFER_LVALUE->yy_ch_buf + 2 ) - { /* need to shift things up to make room */ - /* +2 for EOB chars. */ - int number_to_move = (yy_n_chars) + 2; - char *dest = &YY_CURRENT_BUFFER_LVALUE->yy_ch_buf[ - YY_CURRENT_BUFFER_LVALUE->yy_buf_size + 2]; - char *source = - &YY_CURRENT_BUFFER_LVALUE->yy_ch_buf[number_to_move]; - - while ( source > YY_CURRENT_BUFFER_LVALUE->yy_ch_buf ) - *--dest = *--source; - - yy_cp += (int) (dest - source); - yy_bp += (int) (dest - source); - YY_CURRENT_BUFFER_LVALUE->yy_n_chars = - (yy_n_chars) = (int) YY_CURRENT_BUFFER_LVALUE->yy_buf_size; - - if ( yy_cp < YY_CURRENT_BUFFER_LVALUE->yy_ch_buf + 2 ) - YY_FATAL_ERROR( "flex scanner push-back overflow" ); - } - - *--yy_cp = (char) c; - - (yytext_ptr) = yy_bp; - (yy_hold_char) = *yy_cp; - (yy_c_buf_p) = yy_cp; -} - -#endif - -#ifndef YY_NO_INPUT -#ifdef __cplusplus - static int yyinput (void) -#else - static int input (void) -#endif - -{ - int c; - - *(yy_c_buf_p) = (yy_hold_char); - - if ( *(yy_c_buf_p) == YY_END_OF_BUFFER_CHAR ) - { - /* yy_c_buf_p now points to the character we want to return. - * If this occurs *before* the EOB characters, then it's a - * valid NUL; if not, then we've hit the end of the buffer. - */ - if ( (yy_c_buf_p) < &YY_CURRENT_BUFFER_LVALUE->yy_ch_buf[(yy_n_chars)] ) - /* This was really a NUL. */ - *(yy_c_buf_p) = '\0'; - - else - { /* need more input */ - int offset = (int) ((yy_c_buf_p) - (yytext_ptr)); - ++(yy_c_buf_p); - - switch ( yy_get_next_buffer( ) ) - { - case EOB_ACT_LAST_MATCH: - /* This happens because yy_g_n_b() - * sees that we've accumulated a - * token and flags that we need to - * try matching the token before - * proceeding. But for input(), - * there's no matching to consider. - * So convert the EOB_ACT_LAST_MATCH - * to EOB_ACT_END_OF_FILE. - */ - - /* Reset buffer status. */ - yyrestart( yyin ); - - /*FALLTHROUGH*/ - - case EOB_ACT_END_OF_FILE: - { - if ( yywrap( ) ) - return 0; - - if ( ! (yy_did_buffer_switch_on_eof) ) - YY_NEW_FILE; -#ifdef __cplusplus - return yyinput(); -#else - return input(); -#endif - } - - case EOB_ACT_CONTINUE_SCAN: - (yy_c_buf_p) = (yytext_ptr) + offset; - break; - } - } - } - - c = *(unsigned char *) (yy_c_buf_p); /* cast for 8-bit char's */ - *(yy_c_buf_p) = '\0'; /* preserve yytext */ - (yy_hold_char) = *++(yy_c_buf_p); - - YY_CURRENT_BUFFER_LVALUE->yy_at_bol = (c == '\n'); - - return c; -} -#endif /* ifndef YY_NO_INPUT */ - -/** Immediately switch to a different input stream. - * @param input_file A readable stream. - * - * @note This function does not reset the start condition to @c INITIAL . - */ - void yyrestart (FILE * input_file ) -{ - - if ( ! YY_CURRENT_BUFFER ){ - yyensure_buffer_stack (); - YY_CURRENT_BUFFER_LVALUE = - yy_create_buffer( yyin, YY_BUF_SIZE ); - } - - yy_init_buffer( YY_CURRENT_BUFFER, input_file ); - yy_load_buffer_state( ); -} - -/** Switch to a different input buffer. - * @param new_buffer The new input buffer. - * - */ - void yy_switch_to_buffer (YY_BUFFER_STATE new_buffer ) -{ - - /* TODO. We should be able to replace this entire function body - * with - * yypop_buffer_state(); - * yypush_buffer_state(new_buffer); - */ - yyensure_buffer_stack (); - if ( YY_CURRENT_BUFFER == new_buffer ) - return; - - if ( YY_CURRENT_BUFFER ) - { - /* Flush out information for old buffer. */ - *(yy_c_buf_p) = (yy_hold_char); - YY_CURRENT_BUFFER_LVALUE->yy_buf_pos = (yy_c_buf_p); - YY_CURRENT_BUFFER_LVALUE->yy_n_chars = (yy_n_chars); - } - - YY_CURRENT_BUFFER_LVALUE = new_buffer; - yy_load_buffer_state( ); - - /* We don't actually know whether we did this switch during - * EOF (yywrap()) processing, but the only time this flag - * is looked at is after yywrap() is called, so it's safe - * to go ahead and always set it. - */ - (yy_did_buffer_switch_on_eof) = 1; -} - -static void yy_load_buffer_state (void) -{ - (yy_n_chars) = YY_CURRENT_BUFFER_LVALUE->yy_n_chars; - (yytext_ptr) = (yy_c_buf_p) = YY_CURRENT_BUFFER_LVALUE->yy_buf_pos; - yyin = YY_CURRENT_BUFFER_LVALUE->yy_input_file; - (yy_hold_char) = *(yy_c_buf_p); -} - -/** Allocate and initialize an input buffer state. - * @param file A readable stream. - * @param size The character buffer size in bytes. When in doubt, use @c YY_BUF_SIZE. - * - * @return the allocated buffer state. - */ - YY_BUFFER_STATE yy_create_buffer (FILE * file, int size ) -{ - YY_BUFFER_STATE b; - - b = (YY_BUFFER_STATE) yyalloc( sizeof( struct yy_buffer_state ) ); - if ( ! b ) - YY_FATAL_ERROR( "out of dynamic memory in yy_create_buffer()" ); - - b->yy_buf_size = size; - - /* yy_ch_buf has to be 2 characters longer than the size given because - * we need to put in 2 end-of-buffer characters. - */ - b->yy_ch_buf = (char *) yyalloc( (yy_size_t) (b->yy_buf_size + 2) ); - if ( ! b->yy_ch_buf ) - YY_FATAL_ERROR( "out of dynamic memory in yy_create_buffer()" ); - - b->yy_is_our_buffer = 1; - - yy_init_buffer( b, file ); - - return b; -} - -/** Destroy the buffer. - * @param b a buffer created with yy_create_buffer() - * - */ - void yy_delete_buffer (YY_BUFFER_STATE b ) -{ - - if ( ! b ) - return; - - if ( b == YY_CURRENT_BUFFER ) /* Not sure if we should pop here. */ - YY_CURRENT_BUFFER_LVALUE = (YY_BUFFER_STATE) 0; - - if ( b->yy_is_our_buffer ) - yyfree( (void *) b->yy_ch_buf ); - - yyfree( (void *) b ); -} - -/* Initializes or reinitializes a buffer. - * This function is sometimes called more than once on the same buffer, - * such as during a yyrestart() or at EOF. - */ - static void yy_init_buffer (YY_BUFFER_STATE b, FILE * file ) - -{ - int oerrno = errno; - - yy_flush_buffer( b ); - - b->yy_input_file = file; - b->yy_fill_buffer = 1; - - /* If b is the current buffer, then yy_init_buffer was _probably_ - * called from yyrestart() or through yy_get_next_buffer. - * In that case, we don't want to reset the lineno or column. - */ - if (b != YY_CURRENT_BUFFER){ - b->yy_bs_lineno = 1; - b->yy_bs_column = 0; - } - - b->yy_is_interactive = 0; - - errno = oerrno; -} - -/** Discard all buffered characters. On the next scan, YY_INPUT will be called. - * @param b the buffer state to be flushed, usually @c YY_CURRENT_BUFFER. - * - */ - void yy_flush_buffer (YY_BUFFER_STATE b ) -{ - if ( ! b ) - return; - - b->yy_n_chars = 0; - - /* We always need two end-of-buffer characters. The first causes - * a transition to the end-of-buffer state. The second causes - * a jam in that state. - */ - b->yy_ch_buf[0] = YY_END_OF_BUFFER_CHAR; - b->yy_ch_buf[1] = YY_END_OF_BUFFER_CHAR; - - b->yy_buf_pos = &b->yy_ch_buf[0]; - - b->yy_at_bol = 1; - b->yy_buffer_status = YY_BUFFER_NEW; - - if ( b == YY_CURRENT_BUFFER ) - yy_load_buffer_state( ); -} - -/** Pushes the new state onto the stack. The new state becomes - * the current state. This function will allocate the stack - * if necessary. - * @param new_buffer The new state. - * - */ -void yypush_buffer_state (YY_BUFFER_STATE new_buffer ) -{ - if (new_buffer == NULL) - return; - - yyensure_buffer_stack(); - - /* This block is copied from yy_switch_to_buffer. */ - if ( YY_CURRENT_BUFFER ) - { - /* Flush out information for old buffer. */ - *(yy_c_buf_p) = (yy_hold_char); - YY_CURRENT_BUFFER_LVALUE->yy_buf_pos = (yy_c_buf_p); - YY_CURRENT_BUFFER_LVALUE->yy_n_chars = (yy_n_chars); - } - - /* Only push if top exists. Otherwise, replace top. */ - if (YY_CURRENT_BUFFER) - (yy_buffer_stack_top)++; - YY_CURRENT_BUFFER_LVALUE = new_buffer; - - /* copied from yy_switch_to_buffer. */ - yy_load_buffer_state( ); - (yy_did_buffer_switch_on_eof) = 1; -} - -/** Removes and deletes the top of the stack, if present. - * The next element becomes the new top. - * - */ -void yypop_buffer_state (void) -{ - if (!YY_CURRENT_BUFFER) - return; - - yy_delete_buffer(YY_CURRENT_BUFFER ); - YY_CURRENT_BUFFER_LVALUE = NULL; - if ((yy_buffer_stack_top) > 0) - --(yy_buffer_stack_top); - - if (YY_CURRENT_BUFFER) { - yy_load_buffer_state( ); - (yy_did_buffer_switch_on_eof) = 1; - } -} - -/* Allocates the stack if it does not exist. - * Guarantees space for at least one push. - */ -static void yyensure_buffer_stack (void) -{ - yy_size_t num_to_alloc; - - if (!(yy_buffer_stack)) { - - /* First allocation is just for 2 elements, since we don't know if this - * scanner will even need a stack. We use 2 instead of 1 to avoid an - * immediate realloc on the next call. - */ - num_to_alloc = 1; /* After all that talk, this was set to 1 anyways... */ - (yy_buffer_stack) = (struct yy_buffer_state**)yyalloc - (num_to_alloc * sizeof(struct yy_buffer_state*) - ); - if ( ! (yy_buffer_stack) ) - YY_FATAL_ERROR( "out of dynamic memory in yyensure_buffer_stack()" ); - - memset((yy_buffer_stack), 0, num_to_alloc * sizeof(struct yy_buffer_state*)); - - (yy_buffer_stack_max) = num_to_alloc; - (yy_buffer_stack_top) = 0; - return; - } - - if ((yy_buffer_stack_top) >= ((yy_buffer_stack_max)) - 1){ - - /* Increase the buffer to prepare for a possible push. */ - yy_size_t grow_size = 8 /* arbitrary grow size */; - - num_to_alloc = (yy_buffer_stack_max) + grow_size; - (yy_buffer_stack) = (struct yy_buffer_state**)yyrealloc - ((yy_buffer_stack), - num_to_alloc * sizeof(struct yy_buffer_state*) - ); - if ( ! (yy_buffer_stack) ) - YY_FATAL_ERROR( "out of dynamic memory in yyensure_buffer_stack()" ); - - /* zero only the new slots.*/ - memset((yy_buffer_stack) + (yy_buffer_stack_max), 0, grow_size * sizeof(struct yy_buffer_state*)); - (yy_buffer_stack_max) = num_to_alloc; - } -} - - static void yy_push_state (int _new_state ) -{ - if ( (yy_start_stack_ptr) >= (yy_start_stack_depth) ) - { - yy_size_t new_size; - - (yy_start_stack_depth) += YY_START_STACK_INCR; - new_size = (yy_size_t) (yy_start_stack_depth) * sizeof( int ); - - if ( ! (yy_start_stack) ) - (yy_start_stack) = (int *) yyalloc( new_size ); - - else - (yy_start_stack) = (int *) yyrealloc( - (void *) (yy_start_stack), new_size ); - - if ( ! (yy_start_stack) ) - YY_FATAL_ERROR( "out of memory expanding start-condition stack" ); - } - - (yy_start_stack)[(yy_start_stack_ptr)++] = YY_START; - - BEGIN(_new_state); -} - - static void yy_pop_state (void) -{ - if ( --(yy_start_stack_ptr) < 0 ) - YY_FATAL_ERROR( "start-condition stack underflow" ); - - BEGIN((yy_start_stack)[(yy_start_stack_ptr)]); -} - -#ifndef YY_EXIT_FAILURE -#define YY_EXIT_FAILURE 2 -#endif - -static void yynoreturn yy_fatal_error (const char* msg ) -{ - fprintf( stderr, "%s\n", msg ); - exit( YY_EXIT_FAILURE ); -} - -/* Redefine yyless() so it works in section 3 code. */ - -#undef yyless -#define yyless(n) \ - do \ - { \ - /* Undo effects of setting up yytext. */ \ - int yyless_macro_arg = (n); \ - YY_LESS_LINENO(yyless_macro_arg);\ - yytext[yyleng] = (yy_hold_char); \ - (yy_c_buf_p) = yytext + yyless_macro_arg; \ - (yy_hold_char) = *(yy_c_buf_p); \ - *(yy_c_buf_p) = '\0'; \ - yyleng = yyless_macro_arg; \ - } \ - while ( 0 ) - -/* Accessor methods (get/set functions) to struct members. */ - -/** Get the current token. - * - */ - -static int yy_init_globals (void) -{ - /* Initialization is the same as for the non-reentrant scanner. - * This function is called from yylex_destroy(), so don't allocate here. - */ - - (yy_buffer_stack) = NULL; - (yy_buffer_stack_top) = 0; - (yy_buffer_stack_max) = 0; - (yy_c_buf_p) = NULL; - (yy_init) = 0; - (yy_start) = 0; - - (yy_start_stack_ptr) = 0; - (yy_start_stack_depth) = 0; - (yy_start_stack) = NULL; - -/* Defined in main.c */ -#ifdef YY_STDINIT - yyin = stdin; - yyout = stdout; -#else - yyin = NULL; - yyout = NULL; -#endif - - /* For future reference: Set errno on error, since we are called by - * yylex_init() - */ - return 0; -} - -/* yylex_destroy is for both reentrant and non-reentrant scanners. */ -int yylex_destroy (void) -{ - - /* Pop the buffer stack, destroying each element. */ - while(YY_CURRENT_BUFFER){ - yy_delete_buffer( YY_CURRENT_BUFFER ); - YY_CURRENT_BUFFER_LVALUE = NULL; - yypop_buffer_state(); - } - - /* Destroy the stack itself. */ - yyfree((yy_buffer_stack) ); - (yy_buffer_stack) = NULL; - - /* Destroy the start condition stack. */ - yyfree( (yy_start_stack) ); - (yy_start_stack) = NULL; - - /* Reset the globals. This is important in a non-reentrant scanner so the next time - * yylex() is called, initialization will occur. */ - yy_init_globals( ); - - return 0; -} - -/* - * Internal utility routines. - */ - -#ifndef yytext_ptr -static void yy_flex_strncpy (char* s1, const char * s2, int n ) -{ - - int i; - for ( i = 0; i < n; ++i ) - s1[i] = s2[i]; -} -#endif - -#ifdef YY_NEED_STRLEN -static int yy_flex_strlen (const char * s ) -{ - int n; - for ( n = 0; s[n]; ++n ) - ; - - return n; -} -#endif - -void *yyalloc (yy_size_t size ) -{ - return malloc(size); -} - -void *yyrealloc (void * ptr, yy_size_t size ) -{ - - /* The cast to (char *) in the following accommodates both - * implementations that use char* generic pointers, and those - * that use void* generic pointers. It works with the latter - * because both ANSI C and C++ allow castless assignment from - * any pointer type to void*, and deal with argument conversions - * as though doing an assignment. - */ - return realloc(ptr, size); -} - -void yyfree (void * ptr ) -{ - free( (char *) ptr ); /* see yyrealloc() for (char *) cast */ -} - -#define YYTABLES_NAME "yytables" - -#line 912 "pplex.l" - - -/* Global functions */ - -void -pp_set_replace_list (struct cb_replace_list *list, const cob_u32_t is_pushpop) -{ - /* Handle REPLACE verb */ - if (!list) { - /* REPLACE [LAST] OFF */ - if (!is_pushpop) { - base_replace_list = NULL; - return; - } - if (!base_replace_list) { - return; - } - base_replace_list = base_replace_list->prev; - return; - } - /* REPLACE [ALSO] ... */ - if (base_replace_list && is_pushpop) { - list->last->next = base_replace_list; - list->prev = base_replace_list; - } else { - list->prev = NULL; - } - base_replace_list = list; - if (cb_src_list_file) { - set_print_replace_list (list); - } -} - -/* open file (source or coypbook) for further processing */ -int -ppopen (const char *name, struct cb_replace_list *replacing_list) -{ - struct copy_info *current_copy_info; -#if 0 - char *s; -#endif - char *dname; - cb_tree x = NULL; - - unsigned char bom[4]; - - if (ppin) { - for (; newline_count > 0; newline_count--) { - ungetc ('\n', ppin); - } - } - - /* Open copy/source file, or use stdin */ - if (strcmp (name, COB_DASH) == 0) { - ppin = stdin; - } else { - for (current_copy_info = copy_stack; current_copy_info; current_copy_info = current_copy_info->next) { - // FIXME: for WIN32 compare with cleaning / and \ (COPY "lib/file" vs COPY "lib\file"), - // ideally open first, then check if we have thy physical same file - // (could also fix symlinked files) - if (!strcmp (name, current_copy_info->dname)) { - x = cobc_malloc (sizeof (struct cb_tree_common)); - x->source_file = name; - x->source_line = -1; - /* TODO: add an explain_error option instead of the forced warnings */ - cb_error_x (x, _("recursive inclusion")); - x->source_line = 0; - for (current_copy_info = copy_stack; current_copy_info; current_copy_info = current_copy_info->next) { - x->source_file = current_copy_info->dname; - cb_warning_x (COBC_WARN_ENABLED, x, _("file was included here")); - x->source_line = current_copy_info->line; - } - cobc_free (x); - break; - } - - } - if (!x) { -#ifdef __OS400__ - ppin = fopen (name, "r"); -#else - ppin = fopen (name, "rb"); -#endif - } else { - ppin = 0; - } - } - - if (!ppin && !x) { - cb_error ("%s: %s", name, cb_get_strerror ()); - /* Note: postpone error exit as we need the saved buffers later on */ - } - - /* Check for BOM - *not* for input from stdin as rewind() clears the input - buffer if used on stdin and output in console has normally no BOM at all */ - if (ppin && strcmp (name, COB_DASH) != 0) { - if (fread (bom, 3, 1, ppin) == 1) { - if (bom[0] != 0xEF || bom[1] != 0xBB || bom[2] != 0xBF) { - rewind (ppin); - } - } else { - rewind (ppin); - } - } - - /* Save name for listing */ - if (cb_current_file && !cb_current_file->name) { - cb_current_file->name = cobc_strdup (name); - } - - /* Preserve the current buffer */ - current_copy_info = cobc_malloc (sizeof (struct copy_info)); - current_copy_info->file = cb_source_file; - current_copy_info->buffer = YY_CURRENT_BUFFER; - - /* Save variables */ - current_copy_info->replacing = current_replace_list; - current_copy_info->line = cb_source_line; - current_copy_info->quotation_mark = quotation_mark; - current_copy_info->source_format = cb_source_format; - - current_copy_info->next = copy_stack; - current_copy_info->containing_files = old_list_file; - copy_stack = current_copy_info; - - if (cb_current_file) { - cb_current_file->copy_line = cb_source_line; - } - - /* Set replacing list */ - if (replacing_list) { - if (current_replace_list) { - replacing_list->last->next = current_replace_list; - replacing_list->last = current_replace_list->last; - } - current_replace_list = replacing_list; - if (cb_src_list_file) { - set_print_replace_list (replacing_list); - } - } - - dname = cobc_strdup (name); - current_copy_info->dname = dname; -#if 0 /* Simon: better adjust the output where needed */ - for (s = dname; *s; ++s) { - if (*s == '\\') { - *s = '/'; - } - } -#endif - - /* Switch to new buffer */ - switch_to_buffer (1, dname, yy_create_buffer (ppin, YY_BUF_SIZE)); - - /* postponed errror handling */ - if (!ppin) return -1; - return 0; -} - -int -ppcopy (const char *name, const char *lib, struct cb_replace_list *replace_list) -{ - struct cb_text_list *il; - struct cb_text_list *el; - int ret; - const char *s; - - if (cb_current_file) { - cb_current_file->copy_line = cb_source_line; - } - - /* Locate and open COPY file */ - if (lib) { - snprintf (plexbuff1, (size_t)COB_SMALL_MAX, "%s%c%s", lib, SLASH_CHAR, name); - plexbuff1[COB_SMALL_MAX] = 0; - s = plexbuff1; - } else { - s = name; - } - - /* Find the file */ - if (access (s, R_OK) == 0) { - ret = ppopen (s, replace_list); - if (ret == 0) return 0; /* LCOV_EXCL_BR_LINE */ - goto err_handling; /* LCOV_EXCL_LINE */ - } - - for (el = cb_extension_list; el; el = el->next) { - snprintf (plexbuff2, (size_t)COB_SMALL_MAX, "%s%s", s, el->text); - plexbuff2[COB_SMALL_MAX] = 0; - if (access (plexbuff2, R_OK) == 0) { - ret = ppopen (plexbuff2, replace_list); - if (ret == 0) return 0; /* LCOV_EXCL_BR_LINE */ - goto err_handling; /* LCOV_EXCL_LINE */ - } - } -#if defined (_WIN32) || defined (__DJGPP__) - if (*s != SLASH_CHAR && *s != '/' && *(s + 1) != ':') { -#else - if (*s != SLASH_CHAR) { -#endif - for (il = cb_include_list; il; il = il->next) { - for (el = cb_extension_list; el; el = el->next) { - snprintf (plexbuff2, (size_t)COB_SMALL_MAX, - "%s%c%s%s", il->text, SLASH_CHAR, name, el->text); - plexbuff2[COB_SMALL_MAX] = 0; - if (access (plexbuff2, R_OK) == 0) { - ret = ppopen (plexbuff2, replace_list); - if (ret == 0) return 0; /* LCOV_EXCL_BR_LINE */ - goto err_handling; /* LCOV_EXCL_LINE */ - } - } - } - } - - /* ensure to have original errno, not the one from another file */ - (void)access (s, R_OK); - /* pass file error as we have no more places to check */ - cb_error ("%s: %s", s, cb_get_strerror ()); - -err_handling: - /* On COPY, open error restore old file */ - cb_current_file = old_list_file; - fprintf (yyout, "#line %d \"%s\"\n", cb_source_line, cb_source_file); - return -1; -} - -void -ppparse_error (const char *err_msg) -{ - cb_plex_error (newline_count, "%s", err_msg); -} - -void -plex_clear_vars (void) -{ - /* Reset variables */ - plex_skip_input = 0; - plex_nest_depth = 0; - memset (plex_cond_stack, 0, sizeof(plex_cond_stack)); - requires_listing_line = 1; - comment_allowed = 1; -} - -void -plex_clear_all (void) -{ - if (plexbuff1) { - cobc_free (plexbuff1); - plexbuff1 = NULL; - } - if (plexbuff2) { - cobc_free (plexbuff2); - plexbuff2 = NULL; - } -} - -void -plex_call_destroy (void) -{ - (void)pplex_destroy (); -} - -void -plex_action_directive (const unsigned int cmdtype, const unsigned int is_true) -{ - unsigned int n; - - /* Action IF/ELSE/END-IF/ELIF */ - switch (cmdtype) { - case PLEX_ACT_IF: - /* Push stack - First occurrence is dummy */ - if (++plex_nest_depth >= PLEX_COND_DEPTH) { - /* LCOV_EXCL_START */ - cobc_err_msg (_("directive nest depth exceeded: %d"), - PLEX_COND_DEPTH); - COBC_ABORT (); - /* LCOV_EXCL_STOP */ - } - plex_cond_stack[plex_nest_depth].cmd = 1U; - /* Intersection with previous - first is always 0 */ - n = plex_cond_stack[plex_nest_depth - 1].skip | !is_true; - plex_cond_stack[plex_nest_depth].skip = n; - plex_cond_stack[plex_nest_depth].cond = is_true; - plex_cond_stack[plex_nest_depth].line = cb_source_line; - plex_skip_input = n; - return; - case PLEX_ACT_ELSE: - /* Must have an associated IF/ELIF */ - if (!plex_nest_depth || - plex_cond_stack[plex_nest_depth].cmd != 1) { - cb_plex_error (newline_count, - _("ELSE directive without matching IF/ELIF")); - return; - } - plex_cond_stack[plex_nest_depth].cmd = 2U; - /* Reverse any IF/ELIF condition */ - n = plex_cond_stack[plex_nest_depth].cond; - plex_cond_stack[plex_nest_depth].skip = n; - plex_cond_stack[plex_nest_depth].line = cb_source_line; - /* Intersection with previous */ - plex_skip_input = plex_cond_stack[plex_nest_depth - 1].skip | n; - return; - case PLEX_ACT_END: - /* Must have an associated IF/ELIF/ELSE */ - if (!plex_nest_depth || - !plex_cond_stack[plex_nest_depth].cmd) { - cb_plex_error (newline_count, - _("END-IF directive without matching IF/ELIF/ELSE")); - return; - } - plex_cond_stack[plex_nest_depth].cmd = 0; - plex_cond_stack[plex_nest_depth].skip = 0; - plex_cond_stack[plex_nest_depth].cond = 0; - plex_cond_stack[plex_nest_depth].line = 0; - /* Pop stack - set skip to previous */ - plex_nest_depth--; - plex_skip_input = plex_cond_stack[plex_nest_depth].skip; - return; - case PLEX_ACT_ELIF: - /* Must have an associated IF/ELIF */ - if (!plex_nest_depth || - plex_cond_stack[plex_nest_depth].cmd != 1) { - cb_plex_error (newline_count, - _("ELIF directive without matching IF/ELIF")); - return; - } - plex_cond_stack[plex_nest_depth].line = cb_source_line; - if (plex_cond_stack[plex_nest_depth].cond) { - /* Previous IF or one of previous ELIF was true */ - /* Set to skip */ - n = 1U; - } else if (is_true) { - /* Condition is true */ - plex_cond_stack[plex_nest_depth].cond = 1U; - n = 0; - } else { - /* Set to skip */ - n = 1U; - } - plex_cond_stack[plex_nest_depth].skip = n; - /* Intersection with previous */ - plex_skip_input = plex_cond_stack[plex_nest_depth - 1].skip | n; - return; - default: - /* LCOV_EXCL_START */ - cobc_err_msg (_("invalid internal case: %u"), - cmdtype); - COBC_ABORT (); - /* LCOV_EXCL_STOP */ - } -} - -/* Local functions */ - -static void -get_new_listing_file (void) -{ - struct list_files *newfile = cobc_malloc (sizeof (struct list_files)); - - if (!cb_current_file->copy_head) { - cb_current_file->copy_head = newfile; - } - if (cb_current_file->copy_tail) { - cb_current_file->copy_tail->next = newfile; - } - cb_current_file->copy_tail = newfile; - - newfile->copy_line = cb_source_line; - newfile->source_format = cb_source_format; - old_list_file = cb_current_file; - cb_current_file = newfile; -} - -static void -set_print_replace_list (struct cb_replace_list *list) -{ - struct cb_replace_list *r; - const struct cb_text_list *l; - struct list_replace *repl; - size_t length; - - for (r = list; r; r = r->next) { - repl = cobc_malloc (sizeof (struct list_replace)); - repl->firstline = r->line_num; - repl->lead_trail = r->lead_trail; - repl->lastline = cb_source_line; - - for (l = r->old_text, length = 0; l; l = l->next) { - length += strlen (l->text); - } - repl->from = cobc_malloc (length + 2); - for (l = r->old_text; l; l = l->next) { - strcat (repl->from, l->text); - } - - for (l = r->new_text, length = 0; l; l = l->next) { - length += strlen (l->text); - } - repl->to = cobc_malloc (length + 2); - for (l = r->new_text; l; l = l->next) { - strcat (repl->to, l->text); - } - - if (cb_current_file->replace_tail) { - cb_current_file->replace_tail->next = repl; - } - if (!cb_current_file->replace_head) { - cb_current_file->replace_head = repl; - } - cb_current_file->replace_tail = repl; - } -} - -static void -switch_to_buffer (const int line, const char *file, const YY_BUFFER_STATE buffer) -{ - /* Reset file/line */ - cb_source_line = line; - cb_source_file = cobc_plex_strdup (file); - fprintf (yyout, "#line %d \"%s\"\n", line, file); - /* Switch buffer */ - yy_switch_to_buffer (buffer); -} - -static int -is_condition_directive_clause (const char *buff) -{ - while (buff && !isalpha (*buff)) { - ++buff; - } - - return buff && (strncasecmp (buff, "END", 3) == 0 - || strncasecmp (buff, "IF", 2) == 0 - || strncasecmp (buff, "ELSE", 4) == 0 - || strncasecmp (buff, "ELIF", 4) == 0 - || strncasecmp (buff, "EVALUATE", 8) == 0 - || strncasecmp (buff, "WHEN", 4) == 0); -} - -static int -is_cobol_word_char (const char c) -{ - return c == '-' || c == '_' || isalnum (c); -} - - -/* FIXME: try to optimize as this function used 25-10% (according to callgrind) - of the complete time spent in a sample run with - -fsyntax-only on 880 production code files (2,500,000 LOC) - --> too much [Note: 10% are spent in getc and therefore could only - be optimized by using a buffered read instead] -*/ -static int -ppinput (char *buff, const size_t max_size) -{ - char *bp, qt, wrk[256]; - size_t gotcr; - size_t line_overflow; - size_t continuation; - int ipchar; - int i,k; - int n; - int coln; - struct list_skip *skip; - const char *paragraph_name; - - /* check that we actually have input to process - (isn't the case if something went wrong beforehand) */ - /* LCOV_EXCL_START */ - if (unlikely (ppin == NULL)) { - return YY_NULL; /* fake eof (no further processing of the not available file) */ - } - /* LCOV_EXCL_STOP */ - - /* Read line(s) */ - - continuation = 0; -start: - if (unlikely (buffer_overflow || - (newline_count + PPLEX_BUFF_LEN) >= max_size)) { - if (need_continuation || continuation) { - cb_plex_error (newline_count, - _("buffer overrun - too many continuation lines")); -#if 0 /* CHECKME: does anything breaks if we don't fake EOF here? */ - return YY_NULL; /* fake eof (no further processing) */ -#endif - } - if (newline_count < max_size) { - memset (buff, '\n', newline_count); - buff[newline_count] = 0; - ipchar = (int)newline_count; - newline_count = 0; - buffer_overflow = 0; - return ipchar; - } - buffer_overflow = 1; - ipchar = max_size - 1; - memset (buff, '\n', (size_t)ipchar); - buff[ipchar] = 0; - newline_count -= ipchar; - return ipchar; - } - gotcr = 0; - line_overflow = 0; - ipchar = 0; - for (n = 0; ipchar != '\n';) { - if (unlikely (n == PPLEX_BUFF_LEN)) { - if (line_overflow != 2) { - line_overflow = 1; - } - } - ipchar = getc (ppin); - if (unlikely (ipchar == EOF)) { - if (n > 0) { - /* No end of line at end of file */ - break; - } - if (newline_count == 0) { - return YY_NULL; - } - memset (buff, '\n', newline_count); - buff[newline_count] = 0; - ipchar = (int)newline_count; - newline_count = 0; - return ipchar; - } -#ifndef COB_EBCDIC_MACHINE - if (unlikely (ipchar == 0x1A && !n)) { - continue; - } -#endif - if (unlikely (gotcr)) { - gotcr = 0; - if (ipchar != '\n') { - if (likely (line_overflow == 0)) { - buff[n++] = '\r'; - } else { - line_overflow = 2; - } - } - } - if (unlikely (ipchar == '\r')) { - gotcr = 1; - continue; - } - if (unlikely (ipchar == '\t')) { - if (likely (line_overflow == 0)) { - buff[n++] = ' '; - while (n % cb_tab_width != 0) { - buff[n++] = ' '; - } - if (unlikely (n > PPLEX_BUFF_LEN)) { - n = PPLEX_BUFF_LEN; - } - } - continue; - } - if (likely (line_overflow == 0)) { - buff[n++] = (char)ipchar; - } else if ((char)ipchar != ' ' && (char)ipchar != '\n') { - line_overflow = 2; - } - } - - if (buff[n - 1] != '\n') { - /* FIXME: cb_source_line is one too low when CB_FORMAT_FREE is used - [but only during ppinput() in pplex.l ?] - Workaround for now: - Temporary newline_count + 1 - */ - if (cb_source_format == CB_FORMAT_FREE) { - if (line_overflow == 0) { - cb_plex_warning (COBC_WARN_FILLER, newline_count + 1, - _("line not terminated by a newline")); - } else if (line_overflow == 2) { - cb_plex_warning (COBC_WARN_FILLER, newline_count + 1, - _("source text exceeds %d bytes, will be truncated"), - PPLEX_BUFF_LEN); - } - } else { - if (line_overflow == 0) { - cb_plex_warning (COBC_WARN_FILLER, newline_count, - _("line not terminated by a newline")); - } else if (line_overflow == 2) { - cb_plex_warning (COBC_WARN_FILLER, newline_count, - _("source text exceeds %d bytes, will be truncated"), - PPLEX_BUFF_LEN); - } - } - buff[n++] = '\n'; - } - buff[n] = 0; - - /* check for vcs conflict marker */ - if (n == 8 || (n > 8 && isspace(buff[7]))) { - if (memcmp("<<<<<<<", buff, 7) == 0 - || memcmp("=======", buff, 7) == 0 - || memcmp(">>>>>>>", buff, 7) == 0) { - /* FIXME: the different line numbers (see test "conflict markers" - are definitely a bug to solve in short time */ - if (cb_source_format == CB_FORMAT_FREE) { - ++newline_count; - } - cb_plex_error (newline_count, - _("version control conflict marker in file")); - if (cb_source_format != CB_FORMAT_FREE) { - ++newline_count; - } - goto start; - } - } - - if (cb_source_format == CB_FORMAT_FREE) { - bp = buff; - } else { - if (n < 8) { - /* Line too short */ - newline_count++; - goto start; - } - - if (cb_flag_mfcomment) { - if (buff[0] == '*' || buff[0] == '/') { - newline_count++; - goto start; - } - } - - /* Check if text is longer than cb_text_column */ - if (cb_source_format == CB_FORMAT_FIXED - && n > cb_text_column + 1) { - /* Show warning if it is not whitespace - (postponed after checking for comments by setting - line_overflow to first column that leads to - "source text too long") - */ - if (cb_warn_column_overflow && line_overflow == 0) { - for (coln = cb_text_column; coln < n; ++coln) { - if (buff[coln] != ' ' && buff[coln] != '\n') { - line_overflow = coln; - break; - } - } - } else { - line_overflow = 0; - } - /* Remove it */ - buff[cb_text_column] = '\n'; - buff[cb_text_column + 1] = 0; - n = cb_text_column + 1; - } else { - line_overflow = 0; - } - - memset (buff, ' ', (size_t)6); - /* Note we allow directive lines to start at column 7 */ - bp = &buff[6]; - - /* Special case: acucomment must be checked here as we'd pass comments - as directives otherwise */ - if (cb_flag_acucomment && buff[6] == '$') { - buff[6] = '*'; - } - } - /* - * Convert the two forms of XFD into $SET XFD - * for internal processing - */ - if (buff[6] == '$') { - for(k=7; buff[k] == ' '; k++); - if (strncasecmp(&buff[k],"XFD ",4) == 0) { - for(k=k+3; buff[k] == ' '; k++); - k = sprintf(wrk,"%s",&buff[k]); - while(wrk[k-1] == '\n' || wrk[k-1] == '\r') - wrk[--k] = 0; - qt = strchr(wrk,'"') ? '\'' : '"'; - for (k=0; wrk[k] != 0; k++) { /* Remove any 'QT' chars from string */ - if (wrk[k] == qt) - wrk[k] = (qt == '"' ? '\'' : '"'); - } - n = sprintf(buff," $SET XFD %c%s%c\n",qt,wrk,qt); - } - } else - if (buff[6] == '*') { - for(k=7; isspace(buff[k]); k++); - if(memcmp(&buff[k],"((",2) == 0) { - k = k + 2; - while(isspace(buff[k])) k++; - if (strncasecmp(&buff[k],"XFD ",4) == 0) { - for(k=k+4; isspace(buff[k]); k++); - k = sprintf(wrk,"%s",&buff[k]); - while (wrk[k-1] == '\r' - || wrk[k-1] == '\n' - || isspace(wrk[k-1])) - wrk[--k] = 0; - if(memcmp(&wrk[k-2],"))",2) == 0) { - k = k - 2; - while (isspace(wrk[k-1])) wrk[--k] = 0; - wrk[k] = 0; - qt = strchr(wrk,'"') ? '\'' : '"'; - for (k=0; wrk[k] != 0; k++) { /* Remove any 'QT' chars from string */ - if (wrk[k] == qt) - wrk[k] = (qt == '"' ? '\'' : '"'); - } - n = sprintf(buff," $SET XFD %c%s%c\n",qt,wrk,qt); - } - } - } - } - - /* Check for directives/floating comment at first non-space of line */ - ipchar = 0; - for (; *bp; bp++) { - if (*bp != ' ') { - if ((*bp == '$' && bp[1] != ' ') || (*bp == '>' && bp[1] == '>')) { - /* Directive */ - ipchar = 1; - } else if (*bp == '*' && bp[1] == '>') { - /* Float comment */ - newline_count++; - goto start; - } else if (cb_flag_acucomment && *bp == '|') { - /* ACU Float comment */ - newline_count++; - goto start; - } - break; - } - } - if (ipchar && (!plex_skip_input - || is_condition_directive_clause (bp))) { - /* Directive - pass complete line with NL to ppparse */ - if (newline_count) { - /* Move including NL and NULL byte */ - memmove (buff + newline_count, buff, (size_t)n + 1); - memset (buff, '\n', newline_count); - n += newline_count; - newline_count = 0; - } - return n; - } - - if (plex_skip_input) { - /* Skipping input */ - newline_count++; - if (cb_src_list_file) { - skip = cobc_malloc (sizeof (struct list_skip)); - skip->skipline = cb_source_line + (int)newline_count; - - if (cb_current_file->skip_tail) { - cb_current_file->skip_tail->next = skip; - } - cb_current_file->skip_tail = skip; - - if (!cb_current_file->skip_head) { - cb_current_file->skip_head = skip; - } - } - goto start; - } - - /* - Check that line isn't start of ID DIVISION comment paragraph. - */ - if (comment_allowed) { - if (!strncasecmp (bp, "AUTHOR", 6)) { - paragraph_name = "AUTHOR"; - } else if (!strncasecmp (bp, "DATE-WRITTEN", 12)) { - paragraph_name = "DATE-WRITTEN"; - } else if (!strncasecmp (bp, "DATE-MODIFIED", 13)) { - paragraph_name = "DATE-MODIFIED"; - } else if (!strncasecmp (bp, "DATE-COMPILED", 13)) { - paragraph_name = "DATE-COMPILED"; - } else if (!strncasecmp (bp, "INSTALLATION", 12)) { - paragraph_name = "INSTALLATION"; - } else if (!strncasecmp (bp, "REMARKS", 7)) { - paragraph_name = "REMARKS"; - } else if (!strncasecmp (bp, "SECURITY", 8)) { - paragraph_name = "SECURITY"; - } else { - paragraph_name = NULL; - } - - if (paragraph_name - && !is_cobol_word_char (bp[strlen (paragraph_name)])) { - cb_plex_verify (newline_count, cb_comment_paragraphs, - paragraph_name); - /* Skip comments until the end of line. */ - within_comment = 1; - ++newline_count; - goto start; - } - } - - /* Return when free format (no floating comments removed!) */ - if (cb_source_format == CB_FORMAT_FREE) { - within_comment = 0; - if (newline_count) { - memmove (buff + newline_count, buff, (size_t)n + 1); - memset (buff, '\n', newline_count); - n += newline_count; - newline_count = 0; - } - return n; - } - - /* Fixed format */ - - /* Check the indicator (column 7) */ - switch (buff[6]) { - case ' ': - break; - case '-': - if (unlikely (within_comment)) { - cb_plex_error (newline_count, - _("invalid continuation in comment entry")); - newline_count++; - goto start; - } else if (!need_continuation) { - cb_plex_verify (newline_count, cb_word_continuation, - _("continuation of COBOL words")); - } - continuation = 1; - break; - case 'd': - case 'D': - /* Debugging line */ - (void) cb_verify (cb_debugging_mode, _("debugging indicator")); - if (cb_flag_debugging_line) { - break; - } - newline_count++; - goto start; - case '*': /* Comment line */ - case '/': /* Comment line requested page-break in listing */ - newline_count++; - goto start; - default: - /* Invalid indicator */ - cb_plex_error (newline_count, - _("invalid indicator '%c' at column 7"), buff[6]); - /* Note: Treat as comment line to allow further parsing - instead of aborting compilation */ - newline_count++; - goto start; - } - - /* Skip comments that follow after AUTHORS, etc. */ - if (unlikely (within_comment)) { - /* Check all of "Area A" */ - for (ipchar = 7; ipchar < (n - 1) && ipchar < 11; ++ipchar) { - if (buff[ipchar] != ' ') { - ipchar = 0; - break; - } - } - if (ipchar) { - newline_count++; - goto start; - } - within_comment = 0; - } - - /* Skip blank lines */ - for (i = 7; buff[i] == ' '; ++i) { - ; - } - - if (buff[i] == '\n') { - newline_count++; - goto start; - } - - buff[6] = ' '; - bp = buff + 7; - - if (unlikely (continuation)) { - /* Line continuation */ - need_continuation = 0; - for (; *bp == ' '; ++bp) { - ; - } - /* Validate concatenation */ - if (consecutive_quotation) { - if (bp[0] == quotation_mark && bp[1] == quotation_mark) { - bp++; - } else { - cb_plex_error (newline_count, - _("invalid line continuation")); - return YY_NULL; - } - quotation_mark = 0; - consecutive_quotation = 0; - } else if (quotation_mark) { - /* Literal concatenation */ - if (*bp == quotation_mark) { - bp++; - } else { - cb_plex_error (newline_count, - _("invalid line continuation")); - return YY_NULL; - } - } - } else { - /* Normal line */ - if (need_continuation) { - cb_plex_error (newline_count, - _("continuation character expected")); - need_continuation = 0; - } - quotation_mark = 0; - consecutive_quotation = 0; - } - - /* Check if string literal is to be continued */ - for (i = bp - buff; buff[i] != '\n'; ++i) { - /* Pick up floating comment and force loop exit */ - if (!quotation_mark && ((buff[i] == '*' && buff[i + 1] == '>') || - (cb_flag_acucomment && buff[i] == '|'))) { - /* remove indicator "source text too long" if the column - leading to the indicator comes after the floating comment - */ - if (i < cb_text_column) { - line_overflow = 0; - } - /* Set to null, 'i' is predecremented further below */ - buff[i] = 0; - break; - } else if (buff[i] == '\'' || buff[i] == '"') { - if (quotation_mark == 0) { - /* Literal start */ - quotation_mark = buff[i]; - } else if (quotation_mark == buff[i]) { - if (i == cb_text_column - 1) { - /* Consecutive quotation */ - consecutive_quotation = 1; - } else { - /* Literal end */ - quotation_mark = 0; - } - } - } - } - - if (unlikely (quotation_mark)) { - /* Expecting continuation */ - if (!consecutive_quotation) { - need_continuation = 1; - } - for (; i < cb_text_column;) { - buff[i++] = ' '; - } - buff[i] = 0; - } else { - /* Truncate trailing spaces, including the newline */ - for (i--; i >= 0 && buff[i] == ' '; i--) { - ; - } - if (i < 0) { - /* Empty line after removing floating comment */ - newline_count++; - goto start; - } - if (buff[i] == '\'' || buff[i] == '\"') { - buff[++i] = ' '; - } - buff[i + 1] = 0; - } - - /* Show warning if text is longer than cb_text_column - and not whitespace (postponed here) */ - if (line_overflow != 0) { - cb_plex_warning (COBC_WARN_FILLER, newline_count, - _("source text after program-text area (column %d)"), - cb_text_column); - } - - if (unlikely (continuation)) { - gotcr = strlen (bp); - memmove (buff, bp, gotcr + 1); - newline_count++; - } else { - /* Insert newlines at the start of the buffer */ - gotcr = strlen (buff); - if (newline_count != 0) { - memmove (buff + newline_count, buff, gotcr + 1); - memset (buff, '\n', newline_count); - gotcr += newline_count; - } - newline_count = 1; - } - return (int)gotcr; -} - -static struct cb_text_list * -pp_text_list_add (struct cb_text_list *list, const char *text, - const size_t size) -{ - struct cb_text_list *p; - void *tp; - - p = cobc_plex_malloc (sizeof (struct cb_text_list)); - tp = cobc_plex_malloc (size + 1); - memcpy (tp, text, size); - p->text = tp; - if (!list) { - p->last = p; - return p; - } - list->last->next = p; - list->last = p; - return list; -} - -static void -ppecho (const char *text, const cob_u32_t alt_space, const int textlen) -{ - /* performance note: while this function used 5% (according to callgrind) - of the complete time spent in a sample run with - -fsyntax-only on 880 production code files (2,500,000 LOC) - 3.8% of this time is spent in fwrite, therefore not much potential - for optimization - */ - struct cb_replace_list *r; - struct cb_replace_list *save_ptr; - const struct cb_text_list *lno; - struct cb_text_list *queue; - struct cb_text_list *save_queue; - const char *s; - char *temp_ptr; - size_t size; - size_t size2; - - /* ensure nothing is in the stream buffer */ - fflush (ppout); - - /* Check for replacement text before outputting */ - if (alt_space) { - s = yytext; - } else { - s = text; - } - - if (text_queue == NULL && (text[0] == ' ' || text[0] == '\n')) { - /* No replacement */ - fwrite (text, (size_t)textlen, (size_t)1, ppout); - if (cb_listing_file) { - check_listing (s, 0); - } - return; - } - if (!current_replace_list && !base_replace_list) { - /* Output queue */ - for (; text_queue; text_queue = text_queue->next) { - fputs (text_queue->text, ppout); - } - fwrite (text, (size_t)textlen, (size_t)1, ppout); - if (cb_listing_file) { - check_listing (s, 0); - } - return; - } - if (!current_replace_list) { - current_replace_list = base_replace_list; - save_ptr = NULL; - } else { - current_replace_list->last->next = base_replace_list; - save_ptr = current_replace_list->last; - } - - /* Do replacement */ - text_queue = pp_text_list_add (text_queue, text, (size_t)textlen); - - save_queue = NULL; - size = 0; - size2 = 0; - for (r = current_replace_list; r; r = r->next) { - queue = text_queue; - /* The LEADING/TRAILING code looks peculiar as we use */ - /* variables after breaking out of the loop BUT */ - /* ppparse.y guarantees that we have only one token */ - /* and therefore only one iteration of this loop */ - for (lno = r->old_text; lno; lno = lno->next) { - if (lno->text[0] == ' ' || lno->text[0] == '\n') { - continue; - } - while (queue && (queue->text[0] == ' ' || - queue->text[0] == '\n')) { - queue = queue->next; - } - if (queue == NULL) { - /* Partial match */ - if (!save_ptr) { - current_replace_list = NULL; - } else { - save_ptr->next = NULL; - } - return; - } - if (r->lead_trail == CB_REPLACE_LEADING) { - /* Check leading text */ - size = strlen (lno->text); - if (strncasecmp (lno->text, queue->text, size)) { - /* No match */ - break; - } - save_queue = queue; - } else if (r->lead_trail == CB_REPLACE_TRAILING) { - /* Check trailing text */ - size = strlen (lno->text); - size2 = strlen (queue->text); - if (size2 < size) { - /* No match */ - break; - } - size2 -= size; - if (strncasecmp (lno->text, queue->text + size2, size)) { - /* No match */ - break; - } - save_queue = queue; - } else if (strcasecmp (lno->text, queue->text)) { - /* No match */ - break; - } - queue = queue->next; - } - if (lno == NULL) { - /* Match */ - if (r->lead_trail == CB_REPLACE_TRAILING - && save_queue /* <- silence warnings */) { - /* Non-matched part of original text */ - fprintf (ppout, "%*.*s", (int)size2, (int)size2, - save_queue->text); - if (cb_listing_file) { - temp_ptr = cobc_strdup (save_queue->text); - *(temp_ptr + size2) = 0; - check_listing (temp_ptr, 0); - cobc_free (temp_ptr); - } - } - for (lno = r->new_text; lno; lno = lno->next) { - ppecho_direct (lno->text); - } - if (r->lead_trail == CB_REPLACE_LEADING - && save_queue /* <- silence warnings */) { - /* Non-matched part of original text */ - ppecho_direct (save_queue->text + size); - } - text_queue = queue; - continue; - } - } - - /* No match */ - for (; text_queue; text_queue = text_queue->next) { - ppecho_direct (text_queue->text); - } - if (!save_ptr) { - current_replace_list = NULL; - } else { - save_ptr->next = NULL; - } -} - -static void -skip_to_eol (void) -{ - int c; - - /* Skip bytes to end of line */ - while ((c = input ()) != EOF) { - if (c == '\n') { - break; - } - } - if (c != EOF) { - unput (c); - } -} - -static void -display_finish (void) -{ - int msg_len; - - if (!plex_skip_input) { - msg_len = strlen (display_msg) - 1; - while (msg_len != 0 && display_msg[msg_len] == ' ') { - display_msg[msg_len--] = 0; - } - puts (display_msg); - display_msg[0] = 0; - } - unput ('\n'); -} - -static void -ppecho_direct (const char *text) -{ - fputs (text, ppout); - if (cb_listing_file) { - check_listing (text, 0); - } -} - -static void -check_listing (const char *text, const unsigned int comment) -{ - const char *s; - char c; - - /* Check for listing */ - if (!cb_listing_file) { - /* Nothing to do */ - return; - } - if (!text) { - return; - } -#ifndef COB_INTERNAL_XREF - if (cobc_gen_listing == 2) { - /* Passed to cobxref */ - fputs (text, cb_listing_file); - return; - } -#endif - if (comment) { - c = '*'; - } else { - c = ' '; - } - - if (requires_listing_line) { - if (requires_new_line) { - requires_new_line = 0; - putc ('\n', cb_listing_file); - } - fprintf (cb_listing_file, "%6d%c", ++listing_line, c); - } - - if (requires_listing_line && cb_source_format != CB_FORMAT_FREE && - strlen (text) > 6) { - s = &text[6]; - } else { - s = text; - } - fputs (s, cb_listing_file); - if (strchr (text, '\n')) { - requires_listing_line = 1; - } else { - requires_listing_line = 0; - } -} - diff -Nru gnucobol-4.0~early~20200606/cobc/pplex.l gnucobol-5/cobc/pplex.l --- gnucobol-4.0~early~20200606/cobc/pplex.l 2020-06-06 20:51:59.000000000 +0000 +++ gnucobol-5/cobc/pplex.l 1970-01-01 00:00:00.000000000 +0000 @@ -1,2165 +0,0 @@ -/* - Copyright (C) 2001-2012, 2014-2019 Free Software Foundation, Inc. - Written by Keisuke Nishida, Roger While, Simon Sobisch, Dave Pitts - - This file is part of GnuCOBOL. - - The GnuCOBOL compiler is free software: you can redistribute it - and/or modify it under the terms of the GNU General Public License - as published by the Free Software Foundation, either version 3 of the - License, or (at your option) any later version. - - GnuCOBOL is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with GnuCOBOL. If not, see . -*/ - - -%option 8bit -%option case-insensitive -%option never-interactive -%option prefix="pp" - -%option stack - -%option noyy_top_state -%option noyy_scan_buffer -%option noyy_scan_bytes -%option noyy_scan_string - -%option noyyget_extra -%option noyyset_extra -%option noyyget_leng -%option noyyget_text -%option noyyget_lineno -%option noyyset_lineno -%option noyyget_in -%option noyyset_in -%option noyyget_out -%option noyyset_out -%option noyyget_lval -%option noyyset_lval -%option noyyget_lloc -%option noyyset_lloc -%option noyyget_debug -%option noyyset_debug - -%{ -#undef YY_READ_BUF_SIZE -#define YY_READ_BUF_SIZE 32768 -#undef YY_BUF_SIZE -#define YY_BUF_SIZE 32768 - -#define YY_SKIP_YYWRAP -static int ppwrap (void) { - return 1; -} - -#define PPLEX_BUFF_LEN 512 -#define YY_INPUT(buf,result,max_size) result = ppinput (buf, max_size); -#define ECHO fputs (yytext, yyout) - -#define YY_USER_INIT \ - if (!plexbuff1) { \ - plexbuff1 = cobc_malloc ((size_t)COB_SMALL_BUFF); \ - } \ - if (!plexbuff2) { \ - plexbuff2 = cobc_malloc ((size_t)COB_SMALL_BUFF); \ - } \ - requires_listing_line = 1; \ - comment_allowed = 1; - -#include - -#ifdef HAVE_STRING_H -#include -#endif -#ifdef HAVE_UNISTD_H -#include -#else -#define YY_NO_UNISTD_H 1 -#endif -#include -#include -#include - -#define COB_IN_PPLEX 1 -#include "cobc.h" -#include "tree.h" -#include - -/* ignore unused functions here as flex generates unused ones */ -#ifdef __GNUC__ -#if defined (__clang__) || __GNUC__ > 4 || (__GNUC__ == 4 && __GNUC_MINOR__ >= 4) -#pragma GCC diagnostic ignored "-Wunused-function" -#endif -#endif - -#define PLEX_COND_DEPTH 16 - -struct copy_info { - struct copy_info *next; - struct list_files *containing_files; - const char *file; - char *dname; - struct cb_replace_list *replacing; - YY_BUFFER_STATE buffer; - int line; - int quotation_mark; - int source_format; -}; - -struct plex_stack { - unsigned int cmd; - unsigned int skip; - unsigned int cond; - int line; -}; - -/* Global variables */ - - -/* Local variables */ -static char *plexbuff1 = NULL; -static char *plexbuff2 = NULL; -static struct list_files *old_list_file = NULL; -static size_t newline_count = 0; -static size_t within_comment = 0; -static size_t inside_bracket = 0; -static size_t consecutive_quotation = 0; -static size_t need_continuation = 0; -static size_t buffer_overflow = 0; -static size_t comment_allowed; -static unsigned int plex_skip_input = 0; -static unsigned int plex_nest_depth = 0; -static int quotation_mark = 0; -static int listing_line = 0; -static int requires_listing_line; -static int requires_new_line = 0; - -static char display_msg[PPLEX_BUFF_LEN]; - -static struct cb_replace_list *current_replace_list = NULL; -static struct cb_replace_list *save_current_replace = NULL; -static struct cb_replace_list *base_replace_list = NULL; - -static struct cb_text_list *text_queue = NULL; - -static struct copy_info *copy_stack = NULL; - -static struct plex_stack plex_cond_stack[PLEX_COND_DEPTH]; - -/* Function declarations */ -static int ppinput (char *, const size_t); -static void ppecho (const char *, const cob_u32_t, - const int); -static void ppecho_direct (const char *); -static void switch_to_buffer (const int, const char *, - const YY_BUFFER_STATE); -static void check_listing (const char *, const unsigned int); -static void skip_to_eol (void); -static void display_finish (void); -static void set_print_replace_list (struct cb_replace_list *list); -static void get_new_listing_file (void); - -%} - -WORD [_0-9A-Z\x80-\xFF-]+ -NUMRIC_LITERAL [+-]?[0-9,.]*[0-9] -ALNUM_LITERAL "\""[^""\n]*"\""|"\'"[^''\n]*"\'" -SET_PAREN_LIT \([^()\n]*\) -DEFNUM_LITERAL [+-]?[0-9]*[\.]*[0-9]+ - -%x CALL_DIRECTIVE_STATE -%x COPY_STATE -%x PSEUDO_STATE -%x SOURCE_DIRECTIVE_STATE -%x DEFINE_DIRECTIVE_STATE -%x ON_OFF_DIRECTIVE_STATE -%x SET_DIRECTIVE_STATE -%x TURN_DIRECTIVE_STATE -%x IF_DIRECTIVE_STATE -%x ELSE_DIRECTIVE_STATE -%x ENDIF_DIRECTIVE_STATE -%x ALNUM_LITERAL_STATE -%x CONTROL_STATEMENT_STATE -%x DISPLAY_DIRECTIVE_STATE - -%% - -%{ -%} - -<*>"*>".* { - /* 2002+: inline comment */ - #if 0 /* RXWRXW - Directive state */ - if (YY_START != DIRECTIVE_STATE && YY_START != SET_DIRECTIVE_STATE) { - ppecho (" ", 0, 1); - } - #endif -} - -^[ ]*">>"[ ]?"DEFINE" { - /* 2002+: definition of compiler constants display message during compilation */ - /* Define here to preempt next debug rule below */ - BEGIN DEFINE_DIRECTIVE_STATE; - return DEFINE_DIRECTIVE; -} - -^[ ]*">>"[ ]?"DISPLAY"[ ]+ { - /* OpenCOBOL/GnuCOBOL 2.x extension: display message during compilation */ - display_msg[0] = 0; - BEGIN DISPLAY_DIRECTIVE_STATE; -} - -^[ ]*">>D" { - /* 2002 (only) floating debug line */ - /* Remove line if debugging lines not activated */ - /* Otherwise ignore the directive part of the line */ - (void) cb_verify (cb_debugging_mode, _("debugging indicator")); - if (!cb_flag_debugging_line) { - skip_to_eol (); - } -} - -^[ ]*">>"[ ]?"PAGE" { - /* 2002+: listing directive for page eject with optional comment - Note: processed in cobc.c */ - skip_to_eol (); -} - -^[ ]*">>"[ ]?"LISTING" { - /* 2002+: listing directive for (de-)activating the listing, - ON implied for empty value - Note: further checks in ppparse.y, processed in cobc.c */ - BEGIN ON_OFF_DIRECTIVE_STATE; - return LISTING_DIRECTIVE; -} - -^[ ]*">>"[ ]?"SOURCE" { - /* 2002+: directive for setting source format */ - BEGIN SOURCE_DIRECTIVE_STATE; - return SOURCE_DIRECTIVE; -} - -^[ ]*">>"[ ]?"SET" { - /* OpenCOBOL/GnuCOBOL 2.0 extension: MF SET directive in 2002+ style format */ - BEGIN SET_DIRECTIVE_STATE; - return SET_DIRECTIVE; -} - -^[ ]*">>"[ ]?"TURN" { - /* 2002+: directive for (de-)activating exception checks */ - BEGIN TURN_DIRECTIVE_STATE; - return TURN_DIRECTIVE; -} - -^[ ]*">>"[ ]?"IF" { - /* 2002+: conditional compilation */ - BEGIN IF_DIRECTIVE_STATE; - return IF_DIRECTIVE; -} -^[ ]*">>"[ ]?"ELIF" | -^[ ]*">>"[ ]?"ELSE-IF" { - /* OpenCOBOL extension: conditional compilation combined ELSE IF, - 2002+ style format */ - BEGIN IF_DIRECTIVE_STATE; - return ELIF_DIRECTIVE; -} -^[ ]*">>"[ ]?"ELSE" { - /* 2002+: conditional compilation */ - BEGIN ELSE_DIRECTIVE_STATE; - return ELSE_DIRECTIVE; -} -^[ ]*">>"[ ]?"END-IF" { - /* 2002+: conditional compilation */ - BEGIN ENDIF_DIRECTIVE_STATE; - return ENDIF_DIRECTIVE; -} - -^[ ]*">>"[ ]?"LEAP-SECOND" { - /* 2002+: more then 60 seconds per minute (currently always set to off), - OFF implied for empty value */ - BEGIN ON_OFF_DIRECTIVE_STATE; - return LEAP_SECOND_DIRECTIVE; -} - -^[ ]*">>"[ ]?"CALL-CONVENTION" { - /* 2002+: convention for CALL/CANCEL */ - BEGIN CALL_DIRECTIVE_STATE; - return CALL_DIRECTIVE; -} - -^[ ]*">>"[ ]*\n { - /* empty 2002+ style directive */ - cb_plex_warning (COBC_WARN_FILLER, newline_count, - _("ignoring empty directive")); - unput ('\n'); -} - -^[ ]*">>"[ ]*[_0-9A-Z-]+ { - /* unknown 2002+ style directive */ - char *s; - - s = strchr (yytext, '>'); - cb_plex_warning (COBC_WARN_FILLER, newline_count, - _("ignoring invalid directive: '%s'"), s); - skip_to_eol (); -} - -^[ ]*">>" { - /* unknown 2002+ style directive */ - cb_plex_warning (COBC_WARN_FILLER, newline_count, - _("ignoring invalid directive")); - skip_to_eol (); -} - -^[ ]*"$DISPLAY"[ ]+"VCS"[ ]+"="[ ]+ { - /* MF extension: include @(#)text\0 in the object file */ - /* we just add a warning for now, maybe implement it later */ - CB_PENDING (_("VCS directive")); - skip_to_eol (); -} - -^[ ]*"$DISPLAY"[ ]+ { - /* MF extension: display message during compilation */ - display_msg[0] = 0; - BEGIN DISPLAY_DIRECTIVE_STATE; -} - -^[ ]*"$SET" { - /* MF extension: SET directive */ - BEGIN SET_DIRECTIVE_STATE; - return SET_DIRECTIVE; -} - -^[ ]*"$IF" { - /* MF extension: conditional compilation */ - BEGIN IF_DIRECTIVE_STATE; - return IF_DIRECTIVE; -} -^[ ]*"$ELIF" | -^[ ]*"$ELSE-IF" { - /* OpenCOBOL/GnuCOBOL 2.0 extension: conditional compilation combined ELSE IF, - MF style format */ - BEGIN IF_DIRECTIVE_STATE; - return ELIF_DIRECTIVE; -} -^[ ]*"$ELSE" { - /* MF extension: conditional compilation */ - BEGIN ELSE_DIRECTIVE_STATE; - return ELSE_DIRECTIVE; -} -^[ ]*"$END" { - /* MF extension: conditional compilation */ - BEGIN ENDIF_DIRECTIVE_STATE; - return ENDIF_DIRECTIVE; -} - -^[ ]*"$"[_0-9A-Z-]+ { - /* unknown MF style directive */ - char *s; - - s = strchr (yytext, '$'); - cb_plex_warning (COBC_WARN_FILLER, newline_count, - _("ignoring invalid directive: '%s'"), s); - skip_to_eol (); -} - -^......"$" { - /* Allow $ in column 7 for acucomment in fixed format */ - if (cb_source_format == CB_FORMAT_FREE) { - cb_plex_warning (COBC_WARN_FILLER, newline_count, - _("spurious '$' detected - ignored")); - skip_to_eol (); - } -} - -^......."@OPTIONS" { - /* Fujitsu COBOL extension for specifying command line options */ - char * s = strchr (yytext, '@'); - cb_plex_warning (COBC_WARN_FILLER, newline_count, - _("ignoring unknown directive: '%s'"), s); - skip_to_eol (); -} - -^[ ]*"$" { - cb_plex_warning (COBC_WARN_FILLER, newline_count, - _("spurious '$' detected - ignored")); - skip_to_eol (); -} - -"PROCESS" { - cb_plex_warning (COBC_WARN_FILLER, newline_count, - _("PROCESS statement ignored")); - skip_to_eol (); -} - -"COPY" { - yy_push_state (COPY_STATE); - if (cb_src_list_file) { - get_new_listing_file (); - } - return COPY; -} - -"INCLUDE" { - /* Note: ++INCLUDE/-INC (include only the data records, - must be specified in column 8/1) and are not implemented yet */ - yy_push_state (COPY_STATE); - if (cb_src_list_file) { - get_new_listing_file (); - } - return COPY; -} - -"REPLACE" { - yy_push_state (COPY_STATE); - return REPLACE; -} - -^[ ]*"*CONTROL" | -^[ ]*"*CBL" { - BEGIN CONTROL_STATEMENT_STATE; - return CONTROL_STATEMENT; -} - -("ID"|"IDENTIFICATION")[ ,;\n]+"DIVISION" { - /* Allow comment sentences/paragraphs */ - comment_allowed = 1; - ppecho (yytext, 0, (int)yyleng); -} - -"PROGRAM-ID" { - /* Allow comment sentences/paragraphs */ - comment_allowed = 1; - ppecho (yytext, 0, (int)yyleng); -} - -"DIVISION" { - /* Disallow comment sentences/paragraphs */ - comment_allowed = 0; - ppecho (yytext, 0, (int)yyleng); -} - -"SECTION" { - /* Disallow comment sentences/paragraphs */ - comment_allowed = 0; - ppecho (yytext, 0, (int)yyleng); -} - -^[ ]*"EJECT"([ ]*\.)? | -^[ ]*"SKIP1"([ ]*\.)? | -^[ ]*"SKIP2"([ ]*\.)? | -^[ ]*"SKIP3"([ ]*\.)? { - /* These words can either be a listing-directive statement, - a reserved word, or a user-defined word... - some implementations (dis-)allow the (optional) "." - some start column 8+ some column 12+ - We ignore the detailed rules and just do the parsing. */ - if (cb_verify (cb_listing_statements, yytext)) { - /* handle as listing-directive statement */ - skip_to_eol(); - return LISTING_STATEMENT; - } else if (cb_listing_statements == CB_SKIP) { - /* handle later (normal reserved / user defined word) */ - ECHO; - check_listing (yytext, 0); - } else { - /* Ignore */ - } -} - -^[ ]*"TITLE"[ ,;\n] { - /* This word can either be a listing-directive statement, - a reserved word, or a user-defined word... - some implementations (dis-)allow the (optional) "." - some start column 8+ some column 12+, - most limit the literal length (we cut in cobc.c) - We ignore the detailed rules and just do the parsing. */ - if (cb_verify (cb_title_statement, yytext)) { - /* handle as listing-directive statement */ - BEGIN ALNUM_LITERAL_STATE; - return TITLE_STATEMENT; - } else if (cb_title_statement == CB_SKIP) { - /* handle later (normal reserved / user defined word) */ - ECHO; - check_listing (yytext, 0); - } else { - /* Ignore */ - } -} - -("WITH"[ ,;\n]+)?"DEBUGGING"[ ,;\n]+"MODE" { - /* Pick up early - Also activates debugging lines */ - cb_verify (cb_debugging_mode, "DEBUGGING MODE"); - cb_flag_debugging_line = 1; - ppecho (yytext, 0, (int)yyleng); -} - -[,;]?\n { - ppecho ("\n", 0, 1); - cb_source_line++; -} - -[;]?[ ]+ { - ppecho (" ", 1U, 1); -} - -[,]?[ ]+ { - if (inside_bracket) { - ppecho (", ", 0, 2); - } else { - ppecho (" ", 1U, 1); - } -} - -"(" { - inside_bracket++; - ppecho ("(", 0, 1); -} - -")" { - if (inside_bracket) { - inside_bracket--; - } - ppecho (")", 0, 1); -} - -{WORD} | -{NUMRIC_LITERAL} | -{ALNUM_LITERAL} | -. { - ppecho (yytext, 0, (int)yyleng); -} - -{ - \n { - BEGIN INITIAL; - unput ('\n'); - return TERMINATOR; - } - [ ,;]+ { /* ignore */ } - "." { - return DOT; - } -} - -{ - \n { - BEGIN INITIAL; - display_finish(); - } - - {ALNUM_LITERAL} { - yytext[yyleng - 1] = 0; - strncat (display_msg, yytext + 1, (size_t)(PPLEX_BUFF_LEN - 1)); - } - - [x21-\xFF] | - [ #A-Z0-9\x80-\xFF]+ { - strncat (display_msg, yytext, (size_t)(PPLEX_BUFF_LEN - 1)); - } -} - -{ - "ON" { return ON; } - "OFF" { return OFF; } -} - -{ - "FORMAT" { return FORMAT; } - "IS" { return IS; } - "FIXED" { return FIXED; } - "FREE" { return FREE; } - "VARIABLE" { return VARIABLE; } -} - -{ - "COBOL" { return COBOL; } - "EXTERN" { return TOK_EXTERN; } - "STDCALL" { return STDCALL; } - "STATIC" { return STATIC; } -} - -{ - "SOURCE" { return SOURCE; } - "NOSOURCE" { return NOSOURCE; } - "LIST" { return LIST; } - "NOLIST" { return NOLIST; } - "MAP" { return MAP; } - "NOMAP" { return NOMAP; } -} - -{ - /* OpenCOBOL/GnuCOBOL 2.0 extension: MF $SET CONSTANT in 2002+ style as - >> DEFINE CONSTANT var [AS] literal archaic extension: - use plain >> DEFINE var [AS] literal for conditional compilation and - use 01 CONSTANT with/without FROM clause for constant definitions */ - "CONSTANT" { - return CONSTANT; - } - "AS" { - return AS; - } - "OFF" { - return OFF; - } - "OVERRIDE" { - return OVERRIDE; - } - "PARAMETER" { - return PARAMETER; - } - {NUMRIC_LITERAL} | - {ALNUM_LITERAL} { - pplval.s = cobc_plex_strdup (yytext); - return LITERAL; - } - {WORD} { - pplval.s = cobc_plex_strdup (yytext); - return VARIABLE_NAME; - } -} - -{ - "ADDRSV" | - "ADD-RSV" { - return ADDRSV; - } - "ADDSYN" | - "ADD-SYN" { - return ADDSYN; - } - "ASSIGN" { - return ASSIGN; - } - "CALLFH" { - return CALLFH; - } - "COMP1" | - "COMP-1" { - return COMP1; - } - "CONSTANT" { - return CONSTANT; - } - "FOLDCOPYNAME" | - "FOLD-COPY-NAME" { - return FOLDCOPYNAME; - } - "MAKESYN" | - "MAKE-SYN" { - return MAKESYN; - } - "NOFOLDCOPYNAME" | - "NOFOLD-COPY-NAME" | - "NO-FOLD-COPY-NAME" { - return NOFOLDCOPYNAME; - } - "OVERRIDE" { - return OVERRIDE; - } - "REMOVE" { - return REMOVE; - } - "SOURCEFORMAT" | - "SOURCE-FORMAT" { - return SOURCEFORMAT; - } - /*"AS" { - not available with MF compilers - - return AS; - }*/ - "XFD" { - return XFD; - } - {DEFNUM_LITERAL} | - {ALNUM_LITERAL} | - {SET_PAREN_LIT} { - - pplval.s = cobc_plex_strdup (yytext); - return LITERAL; - } - {WORD} { - pplval.s = cobc_plex_strdup (yytext); - return VARIABLE_NAME; - } - "=" { - return EQ; - } -} - -{ - "ON" { - return ON; - } - "OFF" { - return OFF; - } - "WITH" { - return WITH; - } - "LOCATION" { - return LOCATION; - } - "CHECKING" { - return CHECKING; - } - {DEFNUM_LITERAL} | - {ALNUM_LITERAL} { - pplval.s = cobc_plex_strdup (yytext); - return LITERAL; - } - {SET_PAREN_LIT} { - yytext[yyleng - 1] = 0; - pplval.s = cobc_plex_strdup (yytext + 1); - return LITERAL; - } - {WORD} { - pplval.s = cobc_plex_strdup (yytext); - return VARIABLE_NAME; - } -} - -{ - {NUMRIC_LITERAL} | - {ALNUM_LITERAL} { - return LITERAL; - } - {WORD} { - return GARBAGE; - } -} - -{ - "IS" { return IS; } - "NOT" { return NOT; } - "EQUAL" { return EQUAL; } - "TO" { return TO; } - "OR" { return OR; } - "GREATER" { return GREATER; } - "LESS" { return LESS; } - "THAN" { return THAN; } - "DEFINED" { return DEFINED; } - "SET" { return SET; } - ">=" { return GE; } - ">" { return GT; } - "<=" { return LE; } - "<>" { return NE; } - "<" { return LT; } - "=" { return EQ; } - {NUMRIC_LITERAL} | - {ALNUM_LITERAL} { - pplval.s = cobc_plex_strdup (yytext); - return LITERAL; - } - {WORD} { - pplval.s = cobc_plex_strdup (yytext); - return VARIABLE_NAME; - } -} - -{ - {ALNUM_LITERAL} { - return LITERAL; - } -} - -{ - [,;]?\n { - ECHO; - check_listing (yytext, 0); - cb_source_line++; - } - [,;]?[ ]+ { /* ignore */ } - [_0-9A-Z\x80-\xFF-]+(\.[_0-9A-Z\x80-\xFF-]+)+ { - /* special case to allow copybook names with periods - without a literal - given the rule: not starting, not ending, not doubled - *unlikely* to need a configuration option */ - pplval.s = cobc_plex_strdup (yytext); - return TEXT_NAME; - } - \. { - yy_pop_state (); - return DOT; - } - "==" { yy_push_state (PSEUDO_STATE); return EQEQ; } - "(" { return '('; } - ")" { return ')'; } - "BY" { return BY; } - "IN" { return IN; } - "OF" { return OF; } - "OFF" { return OFF; } - "SUPPRESS" { return SUPPRESS; } - "PRINTING" { return PRINTING; } - "REPLACING" { return REPLACING; } - "LEADING" { return LEADING; } - "TRAILING" { return TRAILING; } - "ALSO" { return ALSO; } - "LAST" { return LAST; } - {WORD} | - {NUMRIC_LITERAL} | - {ALNUM_LITERAL} | - . { - pplval.s = cobc_plex_strdup (yytext); - return TOKEN; - } -} - -{ - [,;]?\n { - ECHO; - check_listing (yytext, 0); - cb_source_line++; - } - - [,;]?[ ]+ { - pplval.s = cobc_plex_strdup (" "); - return TOKEN; - } - - "==" { - yy_pop_state (); - return EQEQ; - } - - {WORD} | - {NUMRIC_LITERAL} | - {ALNUM_LITERAL} | - . { - pplval.s = cobc_plex_strdup (yytext); - return TOKEN; - } -} - -<> { - struct copy_info *current_copy_info = copy_stack; - - yy_delete_buffer (YY_CURRENT_BUFFER); - - /* Terminate at the end of all input */ - if (current_copy_info->next == NULL) { - /* Check dangling IF/ELSE */ - for (; plex_nest_depth > 0; --plex_nest_depth) { - cb_source_line = plex_cond_stack[plex_nest_depth].line; - cb_error (_("IF/ELIF/ELSE directive without matching END-IF")); - } - plex_nest_depth = 0; - cobc_free (current_copy_info->dname); - cobc_free (current_copy_info); - listing_line = 0; - requires_listing_line = 1; - requires_new_line = 0; - need_continuation = 0; - buffer_overflow = 0; - within_comment = 0; - newline_count = 0; - inside_bracket = 0; - comment_allowed = 1; - current_replace_list = NULL; - base_replace_list = NULL; - save_current_replace = NULL; - text_queue = NULL; - copy_stack = NULL; - quotation_mark = 0; - consecutive_quotation = 0; - yyterminate (); - } - - /* Close the current file (can be NULL if open failed) */ - if (ppin) { - fclose (ppin); - ppin = NULL; - } - - if (current_copy_info->containing_files) { - cb_current_file = current_copy_info->containing_files; - } - - /* Switch to previous buffer */ - switch_to_buffer (current_copy_info->line, current_copy_info->file, - current_copy_info->buffer); - - /* Restore variables */ - current_replace_list = current_copy_info->replacing; - quotation_mark = current_copy_info->quotation_mark; - cb_source_format = current_copy_info->source_format; - - copy_stack = current_copy_info->next; - cobc_free (current_copy_info->dname); - cobc_free (current_copy_info); -} - -%% - -/* Global functions */ - -void -pp_set_replace_list (struct cb_replace_list *list, const cob_u32_t is_pushpop) -{ - /* Handle REPLACE verb */ - if (!list) { - /* REPLACE [LAST] OFF */ - if (!is_pushpop) { - base_replace_list = NULL; - return; - } - if (!base_replace_list) { - return; - } - base_replace_list = base_replace_list->prev; - return; - } - /* REPLACE [ALSO] ... */ - if (base_replace_list && is_pushpop) { - list->last->next = base_replace_list; - list->prev = base_replace_list; - } else { - list->prev = NULL; - } - base_replace_list = list; - if (cb_src_list_file) { - set_print_replace_list (list); - } -} - -/* open file (source or coypbook) for further processing */ -int -ppopen (const char *name, struct cb_replace_list *replacing_list) -{ - struct copy_info *current_copy_info; -#if 0 - char *s; -#endif - char *dname; - cb_tree x = NULL; - - unsigned char bom[4]; - - if (ppin) { - for (; newline_count > 0; newline_count--) { - ungetc ('\n', ppin); - } - } - - /* Open copy/source file, or use stdin */ - if (strcmp (name, COB_DASH) == 0) { - ppin = stdin; - } else { - for (current_copy_info = copy_stack; current_copy_info; current_copy_info = current_copy_info->next) { - // FIXME: for WIN32 compare with cleaning / and \ (COPY "lib/file" vs COPY "lib\file"), - // ideally open first, then check if we have thy physical same file - // (could also fix symlinked files) - if (!strcmp (name, current_copy_info->dname)) { - x = cobc_malloc (sizeof (struct cb_tree_common)); - x->source_file = name; - x->source_line = -1; - /* TODO: add an explain_error option instead of the forced warnings */ - cb_error_x (x, _("recursive inclusion")); - x->source_line = 0; - for (current_copy_info = copy_stack; current_copy_info; current_copy_info = current_copy_info->next) { - x->source_file = current_copy_info->dname; - cb_warning_x (COBC_WARN_ENABLED, x, _("file was included here")); - x->source_line = current_copy_info->line; - } - cobc_free (x); - break; - } - - } - if (!x) { -#ifdef __OS400__ - ppin = fopen (name, "r"); -#else - ppin = fopen (name, "rb"); -#endif - } else { - ppin = 0; - } - } - - if (!ppin && !x) { - cb_error ("%s: %s", name, cb_get_strerror ()); - /* Note: postpone error exit as we need the saved buffers later on */ - } - - /* Check for BOM - *not* for input from stdin as rewind() clears the input - buffer if used on stdin and output in console has normally no BOM at all */ - if (ppin && strcmp (name, COB_DASH) != 0) { - if (fread (bom, 3, 1, ppin) == 1) { - if (bom[0] != 0xEF || bom[1] != 0xBB || bom[2] != 0xBF) { - rewind (ppin); - } - } else { - rewind (ppin); - } - } - - /* Save name for listing */ - if (cb_current_file && !cb_current_file->name) { - cb_current_file->name = cobc_strdup (name); - } - - /* Preserve the current buffer */ - current_copy_info = cobc_malloc (sizeof (struct copy_info)); - current_copy_info->file = cb_source_file; - current_copy_info->buffer = YY_CURRENT_BUFFER; - - /* Save variables */ - current_copy_info->replacing = current_replace_list; - current_copy_info->line = cb_source_line; - current_copy_info->quotation_mark = quotation_mark; - current_copy_info->source_format = cb_source_format; - - current_copy_info->next = copy_stack; - current_copy_info->containing_files = old_list_file; - copy_stack = current_copy_info; - - if (cb_current_file) { - cb_current_file->copy_line = cb_source_line; - } - - /* Set replacing list */ - if (replacing_list) { - if (current_replace_list) { - replacing_list->last->next = current_replace_list; - replacing_list->last = current_replace_list->last; - } - current_replace_list = replacing_list; - if (cb_src_list_file) { - set_print_replace_list (replacing_list); - } - } - - dname = cobc_strdup (name); - current_copy_info->dname = dname; -#if 0 /* Simon: better adjust the output where needed */ - for (s = dname; *s; ++s) { - if (*s == '\\') { - *s = '/'; - } - } -#endif - - /* Switch to new buffer */ - switch_to_buffer (1, dname, yy_create_buffer (ppin, YY_BUF_SIZE)); - - /* postponed errror handling */ - if (!ppin) return -1; - return 0; -} - -int -ppcopy (const char *name, const char *lib, struct cb_replace_list *replace_list) -{ - struct cb_text_list *il; - struct cb_text_list *el; - int ret; - const char *s; - - if (cb_current_file) { - cb_current_file->copy_line = cb_source_line; - } - - /* Locate and open COPY file */ - if (lib) { - snprintf (plexbuff1, (size_t)COB_SMALL_MAX, "%s%c%s", lib, SLASH_CHAR, name); - plexbuff1[COB_SMALL_MAX] = 0; - s = plexbuff1; - } else { - s = name; - } - - /* Find the file */ - if (access (s, R_OK) == 0) { - ret = ppopen (s, replace_list); - if (ret == 0) return 0; /* LCOV_EXCL_BR_LINE */ - goto err_handling; /* LCOV_EXCL_LINE */ - } - - for (el = cb_extension_list; el; el = el->next) { - snprintf (plexbuff2, (size_t)COB_SMALL_MAX, "%s%s", s, el->text); - plexbuff2[COB_SMALL_MAX] = 0; - if (access (plexbuff2, R_OK) == 0) { - ret = ppopen (plexbuff2, replace_list); - if (ret == 0) return 0; /* LCOV_EXCL_BR_LINE */ - goto err_handling; /* LCOV_EXCL_LINE */ - } - } -#if defined (_WIN32) || defined (__DJGPP__) - if (*s != SLASH_CHAR && *s != '/' && *(s + 1) != ':') { -#else - if (*s != SLASH_CHAR) { -#endif - for (il = cb_include_list; il; il = il->next) { - for (el = cb_extension_list; el; el = el->next) { - snprintf (plexbuff2, (size_t)COB_SMALL_MAX, - "%s%c%s%s", il->text, SLASH_CHAR, name, el->text); - plexbuff2[COB_SMALL_MAX] = 0; - if (access (plexbuff2, R_OK) == 0) { - ret = ppopen (plexbuff2, replace_list); - if (ret == 0) return 0; /* LCOV_EXCL_BR_LINE */ - goto err_handling; /* LCOV_EXCL_LINE */ - } - } - } - } - - /* ensure to have original errno, not the one from another file */ - (void)access (s, R_OK); - /* pass file error as we have no more places to check */ - cb_error ("%s: %s", s, cb_get_strerror ()); - -err_handling: - /* On COPY, open error restore old file */ - cb_current_file = old_list_file; - fprintf (yyout, "#line %d \"%s\"\n", cb_source_line, cb_source_file); - return -1; -} - -void -ppparse_error (const char *err_msg) -{ - cb_plex_error (newline_count, "%s", err_msg); -} - -void -plex_clear_vars (void) -{ - /* Reset variables */ - plex_skip_input = 0; - plex_nest_depth = 0; - memset (plex_cond_stack, 0, sizeof(plex_cond_stack)); - requires_listing_line = 1; - comment_allowed = 1; -} - -void -plex_clear_all (void) -{ - if (plexbuff1) { - cobc_free (plexbuff1); - plexbuff1 = NULL; - } - if (plexbuff2) { - cobc_free (plexbuff2); - plexbuff2 = NULL; - } -} - -void -plex_call_destroy (void) -{ - (void)pplex_destroy (); -} - -void -plex_action_directive (const unsigned int cmdtype, const unsigned int is_true) -{ - unsigned int n; - - /* Action IF/ELSE/END-IF/ELIF */ - switch (cmdtype) { - case PLEX_ACT_IF: - /* Push stack - First occurrence is dummy */ - if (++plex_nest_depth >= PLEX_COND_DEPTH) { - /* LCOV_EXCL_START */ - cobc_err_msg (_("directive nest depth exceeded: %d"), - PLEX_COND_DEPTH); - COBC_ABORT (); - /* LCOV_EXCL_STOP */ - } - plex_cond_stack[plex_nest_depth].cmd = 1U; - /* Intersection with previous - first is always 0 */ - n = plex_cond_stack[plex_nest_depth - 1].skip | !is_true; - plex_cond_stack[plex_nest_depth].skip = n; - plex_cond_stack[plex_nest_depth].cond = is_true; - plex_cond_stack[plex_nest_depth].line = cb_source_line; - plex_skip_input = n; - return; - case PLEX_ACT_ELSE: - /* Must have an associated IF/ELIF */ - if (!plex_nest_depth || - plex_cond_stack[plex_nest_depth].cmd != 1) { - cb_plex_error (newline_count, - _("ELSE directive without matching IF/ELIF")); - return; - } - plex_cond_stack[plex_nest_depth].cmd = 2U; - /* Reverse any IF/ELIF condition */ - n = plex_cond_stack[plex_nest_depth].cond; - plex_cond_stack[plex_nest_depth].skip = n; - plex_cond_stack[plex_nest_depth].line = cb_source_line; - /* Intersection with previous */ - plex_skip_input = plex_cond_stack[plex_nest_depth - 1].skip | n; - return; - case PLEX_ACT_END: - /* Must have an associated IF/ELIF/ELSE */ - if (!plex_nest_depth || - !plex_cond_stack[plex_nest_depth].cmd) { - cb_plex_error (newline_count, - _("END-IF directive without matching IF/ELIF/ELSE")); - return; - } - plex_cond_stack[plex_nest_depth].cmd = 0; - plex_cond_stack[plex_nest_depth].skip = 0; - plex_cond_stack[plex_nest_depth].cond = 0; - plex_cond_stack[plex_nest_depth].line = 0; - /* Pop stack - set skip to previous */ - plex_nest_depth--; - plex_skip_input = plex_cond_stack[plex_nest_depth].skip; - return; - case PLEX_ACT_ELIF: - /* Must have an associated IF/ELIF */ - if (!plex_nest_depth || - plex_cond_stack[plex_nest_depth].cmd != 1) { - cb_plex_error (newline_count, - _("ELIF directive without matching IF/ELIF")); - return; - } - plex_cond_stack[plex_nest_depth].line = cb_source_line; - if (plex_cond_stack[plex_nest_depth].cond) { - /* Previous IF or one of previous ELIF was true */ - /* Set to skip */ - n = 1U; - } else if (is_true) { - /* Condition is true */ - plex_cond_stack[plex_nest_depth].cond = 1U; - n = 0; - } else { - /* Set to skip */ - n = 1U; - } - plex_cond_stack[plex_nest_depth].skip = n; - /* Intersection with previous */ - plex_skip_input = plex_cond_stack[plex_nest_depth - 1].skip | n; - return; - default: - /* LCOV_EXCL_START */ - cobc_err_msg (_("invalid internal case: %u"), - cmdtype); - COBC_ABORT (); - /* LCOV_EXCL_STOP */ - } -} - -/* Local functions */ - -static void -get_new_listing_file (void) -{ - struct list_files *newfile = cobc_malloc (sizeof (struct list_files)); - - if (!cb_current_file->copy_head) { - cb_current_file->copy_head = newfile; - } - if (cb_current_file->copy_tail) { - cb_current_file->copy_tail->next = newfile; - } - cb_current_file->copy_tail = newfile; - - newfile->copy_line = cb_source_line; - newfile->source_format = cb_source_format; - old_list_file = cb_current_file; - cb_current_file = newfile; -} - -static void -set_print_replace_list (struct cb_replace_list *list) -{ - struct cb_replace_list *r; - const struct cb_text_list *l; - struct list_replace *repl; - size_t length; - - for (r = list; r; r = r->next) { - repl = cobc_malloc (sizeof (struct list_replace)); - repl->firstline = r->line_num; - repl->lead_trail = r->lead_trail; - repl->lastline = cb_source_line; - - for (l = r->old_text, length = 0; l; l = l->next) { - length += strlen (l->text); - } - repl->from = cobc_malloc (length + 2); - for (l = r->old_text; l; l = l->next) { - strcat (repl->from, l->text); - } - - for (l = r->new_text, length = 0; l; l = l->next) { - length += strlen (l->text); - } - repl->to = cobc_malloc (length + 2); - for (l = r->new_text; l; l = l->next) { - strcat (repl->to, l->text); - } - - if (cb_current_file->replace_tail) { - cb_current_file->replace_tail->next = repl; - } - if (!cb_current_file->replace_head) { - cb_current_file->replace_head = repl; - } - cb_current_file->replace_tail = repl; - } -} - -static void -switch_to_buffer (const int line, const char *file, const YY_BUFFER_STATE buffer) -{ - /* Reset file/line */ - cb_source_line = line; - cb_source_file = cobc_plex_strdup (file); - fprintf (yyout, "#line %d \"%s\"\n", line, file); - /* Switch buffer */ - yy_switch_to_buffer (buffer); -} - -static int -is_condition_directive_clause (const char *buff) -{ - while (buff && !isalpha (*buff)) { - ++buff; - } - - return buff && (strncasecmp (buff, "END", 3) == 0 - || strncasecmp (buff, "IF", 2) == 0 - || strncasecmp (buff, "ELSE", 4) == 0 - || strncasecmp (buff, "ELIF", 4) == 0 - || strncasecmp (buff, "EVALUATE", 8) == 0 - || strncasecmp (buff, "WHEN", 4) == 0); -} - -static int -is_cobol_word_char (const char c) -{ - return c == '-' || c == '_' || isalnum (c); -} - - -/* FIXME: try to optimize as this function used 25-10% (according to callgrind) - of the complete time spent in a sample run with - -fsyntax-only on 880 production code files (2,500,000 LOC) - --> too much [Note: 10% are spent in getc and therefore could only - be optimized by using a buffered read instead] -*/ -static int -ppinput (char *buff, const size_t max_size) -{ - char *bp, qt, wrk[256]; - size_t gotcr; - size_t line_overflow; - size_t continuation; - int ipchar; - int i,k; - int n; - int coln; - struct list_skip *skip; - const char *paragraph_name; - - /* check that we actually have input to process - (isn't the case if something went wrong beforehand) */ - /* LCOV_EXCL_START */ - if (unlikely (ppin == NULL)) { - return YY_NULL; /* fake eof (no further processing of the not available file) */ - } - /* LCOV_EXCL_STOP */ - - /* Read line(s) */ - - continuation = 0; -start: - if (unlikely (buffer_overflow || - (newline_count + PPLEX_BUFF_LEN) >= max_size)) { - if (need_continuation || continuation) { - cb_plex_error (newline_count, - _("buffer overrun - too many continuation lines")); -#if 0 /* CHECKME: does anything breaks if we don't fake EOF here? */ - return YY_NULL; /* fake eof (no further processing) */ -#endif - } - if (newline_count < max_size) { - memset (buff, '\n', newline_count); - buff[newline_count] = 0; - ipchar = (int)newline_count; - newline_count = 0; - buffer_overflow = 0; - return ipchar; - } - buffer_overflow = 1; - ipchar = max_size - 1; - memset (buff, '\n', (size_t)ipchar); - buff[ipchar] = 0; - newline_count -= ipchar; - return ipchar; - } - gotcr = 0; - line_overflow = 0; - ipchar = 0; - for (n = 0; ipchar != '\n';) { - if (unlikely (n == PPLEX_BUFF_LEN)) { - if (line_overflow != 2) { - line_overflow = 1; - } - } - ipchar = getc (ppin); - if (unlikely (ipchar == EOF)) { - if (n > 0) { - /* No end of line at end of file */ - break; - } - if (newline_count == 0) { - return YY_NULL; - } - memset (buff, '\n', newline_count); - buff[newline_count] = 0; - ipchar = (int)newline_count; - newline_count = 0; - return ipchar; - } -#ifndef COB_EBCDIC_MACHINE - if (unlikely (ipchar == 0x1A && !n)) { - continue; - } -#endif - if (unlikely (gotcr)) { - gotcr = 0; - if (ipchar != '\n') { - if (likely (line_overflow == 0)) { - buff[n++] = '\r'; - } else { - line_overflow = 2; - } - } - } - if (unlikely (ipchar == '\r')) { - gotcr = 1; - continue; - } - if (unlikely (ipchar == '\t')) { - if (likely (line_overflow == 0)) { - buff[n++] = ' '; - while (n % cb_tab_width != 0) { - buff[n++] = ' '; - } - if (unlikely (n > PPLEX_BUFF_LEN)) { - n = PPLEX_BUFF_LEN; - } - } - continue; - } - if (likely (line_overflow == 0)) { - buff[n++] = (char)ipchar; - } else if ((char)ipchar != ' ' && (char)ipchar != '\n') { - line_overflow = 2; - } - } - - if (buff[n - 1] != '\n') { - /* FIXME: cb_source_line is one too low when CB_FORMAT_FREE is used - [but only during ppinput() in pplex.l ?] - Workaround for now: - Temporary newline_count + 1 - */ - if (cb_source_format == CB_FORMAT_FREE) { - if (line_overflow == 0) { - cb_plex_warning (COBC_WARN_FILLER, newline_count + 1, - _("line not terminated by a newline")); - } else if (line_overflow == 2) { - cb_plex_warning (COBC_WARN_FILLER, newline_count + 1, - _("source text exceeds %d bytes, will be truncated"), - PPLEX_BUFF_LEN); - } - } else { - if (line_overflow == 0) { - cb_plex_warning (COBC_WARN_FILLER, newline_count, - _("line not terminated by a newline")); - } else if (line_overflow == 2) { - cb_plex_warning (COBC_WARN_FILLER, newline_count, - _("source text exceeds %d bytes, will be truncated"), - PPLEX_BUFF_LEN); - } - } - buff[n++] = '\n'; - } - buff[n] = 0; - - /* check for vcs conflict marker */ - if (n == 8 || (n > 8 && isspace(buff[7]))) { - if (memcmp("<<<<<<<", buff, 7) == 0 - || memcmp("=======", buff, 7) == 0 - || memcmp(">>>>>>>", buff, 7) == 0) { - /* FIXME: the different line numbers (see test "conflict markers" - are definitely a bug to solve in short time */ - if (cb_source_format == CB_FORMAT_FREE) { - ++newline_count; - } - cb_plex_error (newline_count, - _("version control conflict marker in file")); - if (cb_source_format != CB_FORMAT_FREE) { - ++newline_count; - } - goto start; - } - } - - if (cb_source_format == CB_FORMAT_FREE) { - bp = buff; - } else { - if (n < 8) { - /* Line too short */ - newline_count++; - goto start; - } - - if (cb_flag_mfcomment) { - if (buff[0] == '*' || buff[0] == '/') { - newline_count++; - goto start; - } - } - - /* Check if text is longer than cb_text_column */ - if (cb_source_format == CB_FORMAT_FIXED - && n > cb_text_column + 1) { - /* Show warning if it is not whitespace - (postponed after checking for comments by setting - line_overflow to first column that leads to - "source text too long") - */ - if (cb_warn_column_overflow && line_overflow == 0) { - for (coln = cb_text_column; coln < n; ++coln) { - if (buff[coln] != ' ' && buff[coln] != '\n') { - line_overflow = coln; - break; - } - } - } else { - line_overflow = 0; - } - /* Remove it */ - buff[cb_text_column] = '\n'; - buff[cb_text_column + 1] = 0; - n = cb_text_column + 1; - } else { - line_overflow = 0; - } - - memset (buff, ' ', (size_t)6); - /* Note we allow directive lines to start at column 7 */ - bp = &buff[6]; - - /* Special case: acucomment must be checked here as we'd pass comments - as directives otherwise */ - if (cb_flag_acucomment && buff[6] == '$') { - buff[6] = '*'; - } - } - /* - * Convert the two forms of XFD into $SET XFD - * for internal processing - */ - if (buff[6] == '$') { - for(k=7; buff[k] == ' '; k++); - if (strncasecmp(&buff[k],"XFD ",4) == 0) { - for(k=k+3; buff[k] == ' '; k++); - k = sprintf(wrk,"%s",&buff[k]); - while(wrk[k-1] == '\n' || wrk[k-1] == '\r') - wrk[--k] = 0; - qt = strchr(wrk,'"') ? '\'' : '"'; - for (k=0; wrk[k] != 0; k++) { /* Remove any 'QT' chars from string */ - if (wrk[k] == qt) - wrk[k] = (qt == '"' ? '\'' : '"'); - } - n = sprintf(buff," $SET XFD %c%s%c\n",qt,wrk,qt); - } - } else - if (buff[6] == '*') { - for(k=7; isspace(buff[k]); k++); - if(memcmp(&buff[k],"((",2) == 0) { - k = k + 2; - while(isspace(buff[k])) k++; - if (strncasecmp(&buff[k],"XFD ",4) == 0) { - for(k=k+4; isspace(buff[k]); k++); - k = sprintf(wrk,"%s",&buff[k]); - while (wrk[k-1] == '\r' - || wrk[k-1] == '\n' - || isspace(wrk[k-1])) - wrk[--k] = 0; - if(memcmp(&wrk[k-2],"))",2) == 0) { - k = k - 2; - while (isspace(wrk[k-1])) wrk[--k] = 0; - wrk[k] = 0; - qt = strchr(wrk,'"') ? '\'' : '"'; - for (k=0; wrk[k] != 0; k++) { /* Remove any 'QT' chars from string */ - if (wrk[k] == qt) - wrk[k] = (qt == '"' ? '\'' : '"'); - } - n = sprintf(buff," $SET XFD %c%s%c\n",qt,wrk,qt); - } - } - } - } - - /* Check for directives/floating comment at first non-space of line */ - ipchar = 0; - for (; *bp; bp++) { - if (*bp != ' ') { - if ((*bp == '$' && bp[1] != ' ') || (*bp == '>' && bp[1] == '>')) { - /* Directive */ - ipchar = 1; - } else if (*bp == '*' && bp[1] == '>') { - /* Float comment */ - newline_count++; - goto start; - } else if (cb_flag_acucomment && *bp == '|') { - /* ACU Float comment */ - newline_count++; - goto start; - } - break; - } - } - if (ipchar && (!plex_skip_input - || is_condition_directive_clause (bp))) { - /* Directive - pass complete line with NL to ppparse */ - if (newline_count) { - /* Move including NL and NULL byte */ - memmove (buff + newline_count, buff, (size_t)n + 1); - memset (buff, '\n', newline_count); - n += newline_count; - newline_count = 0; - } - return n; - } - - if (plex_skip_input) { - /* Skipping input */ - newline_count++; - if (cb_src_list_file) { - skip = cobc_malloc (sizeof (struct list_skip)); - skip->skipline = cb_source_line + (int)newline_count; - - if (cb_current_file->skip_tail) { - cb_current_file->skip_tail->next = skip; - } - cb_current_file->skip_tail = skip; - - if (!cb_current_file->skip_head) { - cb_current_file->skip_head = skip; - } - } - goto start; - } - - /* - Check that line isn't start of ID DIVISION comment paragraph. - */ - if (comment_allowed) { - if (!strncasecmp (bp, "AUTHOR", 6)) { - paragraph_name = "AUTHOR"; - } else if (!strncasecmp (bp, "DATE-WRITTEN", 12)) { - paragraph_name = "DATE-WRITTEN"; - } else if (!strncasecmp (bp, "DATE-MODIFIED", 13)) { - paragraph_name = "DATE-MODIFIED"; - } else if (!strncasecmp (bp, "DATE-COMPILED", 13)) { - paragraph_name = "DATE-COMPILED"; - } else if (!strncasecmp (bp, "INSTALLATION", 12)) { - paragraph_name = "INSTALLATION"; - } else if (!strncasecmp (bp, "REMARKS", 7)) { - paragraph_name = "REMARKS"; - } else if (!strncasecmp (bp, "SECURITY", 8)) { - paragraph_name = "SECURITY"; - } else { - paragraph_name = NULL; - } - - if (paragraph_name - && !is_cobol_word_char (bp[strlen (paragraph_name)])) { - cb_plex_verify (newline_count, cb_comment_paragraphs, - paragraph_name); - /* Skip comments until the end of line. */ - within_comment = 1; - ++newline_count; - goto start; - } - } - - /* Return when free format (no floating comments removed!) */ - if (cb_source_format == CB_FORMAT_FREE) { - within_comment = 0; - if (newline_count) { - memmove (buff + newline_count, buff, (size_t)n + 1); - memset (buff, '\n', newline_count); - n += newline_count; - newline_count = 0; - } - return n; - } - - /* Fixed format */ - - /* Check the indicator (column 7) */ - switch (buff[6]) { - case ' ': - break; - case '-': - if (unlikely (within_comment)) { - cb_plex_error (newline_count, - _("invalid continuation in comment entry")); - newline_count++; - goto start; - } else if (!need_continuation) { - cb_plex_verify (newline_count, cb_word_continuation, - _("continuation of COBOL words")); - } - continuation = 1; - break; - case 'd': - case 'D': - /* Debugging line */ - (void) cb_verify (cb_debugging_mode, _("debugging indicator")); - if (cb_flag_debugging_line) { - break; - } - newline_count++; - goto start; - case '*': /* Comment line */ - case '/': /* Comment line requested page-break in listing */ - newline_count++; - goto start; - default: - /* Invalid indicator */ - cb_plex_error (newline_count, - _("invalid indicator '%c' at column 7"), buff[6]); - /* Note: Treat as comment line to allow further parsing - instead of aborting compilation */ - newline_count++; - goto start; - } - - /* Skip comments that follow after AUTHORS, etc. */ - if (unlikely (within_comment)) { - /* Check all of "Area A" */ - for (ipchar = 7; ipchar < (n - 1) && ipchar < 11; ++ipchar) { - if (buff[ipchar] != ' ') { - ipchar = 0; - break; - } - } - if (ipchar) { - newline_count++; - goto start; - } - within_comment = 0; - } - - /* Skip blank lines */ - for (i = 7; buff[i] == ' '; ++i) { - ; - } - - if (buff[i] == '\n') { - newline_count++; - goto start; - } - - buff[6] = ' '; - bp = buff + 7; - - if (unlikely (continuation)) { - /* Line continuation */ - need_continuation = 0; - for (; *bp == ' '; ++bp) { - ; - } - /* Validate concatenation */ - if (consecutive_quotation) { - if (bp[0] == quotation_mark && bp[1] == quotation_mark) { - bp++; - } else { - cb_plex_error (newline_count, - _("invalid line continuation")); - return YY_NULL; - } - quotation_mark = 0; - consecutive_quotation = 0; - } else if (quotation_mark) { - /* Literal concatenation */ - if (*bp == quotation_mark) { - bp++; - } else { - cb_plex_error (newline_count, - _("invalid line continuation")); - return YY_NULL; - } - } - } else { - /* Normal line */ - if (need_continuation) { - cb_plex_error (newline_count, - _("continuation character expected")); - need_continuation = 0; - } - quotation_mark = 0; - consecutive_quotation = 0; - } - - /* Check if string literal is to be continued */ - for (i = bp - buff; buff[i] != '\n'; ++i) { - /* Pick up floating comment and force loop exit */ - if (!quotation_mark && ((buff[i] == '*' && buff[i + 1] == '>') || - (cb_flag_acucomment && buff[i] == '|'))) { - /* remove indicator "source text too long" if the column - leading to the indicator comes after the floating comment - */ - if (i < cb_text_column) { - line_overflow = 0; - } - /* Set to null, 'i' is predecremented further below */ - buff[i] = 0; - break; - } else if (buff[i] == '\'' || buff[i] == '"') { - if (quotation_mark == 0) { - /* Literal start */ - quotation_mark = buff[i]; - } else if (quotation_mark == buff[i]) { - if (i == cb_text_column - 1) { - /* Consecutive quotation */ - consecutive_quotation = 1; - } else { - /* Literal end */ - quotation_mark = 0; - } - } - } - } - - if (unlikely (quotation_mark)) { - /* Expecting continuation */ - if (!consecutive_quotation) { - need_continuation = 1; - } - for (; i < cb_text_column;) { - buff[i++] = ' '; - } - buff[i] = 0; - } else { - /* Truncate trailing spaces, including the newline */ - for (i--; i >= 0 && buff[i] == ' '; i--) { - ; - } - if (i < 0) { - /* Empty line after removing floating comment */ - newline_count++; - goto start; - } - if (buff[i] == '\'' || buff[i] == '\"') { - buff[++i] = ' '; - } - buff[i + 1] = 0; - } - - /* Show warning if text is longer than cb_text_column - and not whitespace (postponed here) */ - if (line_overflow != 0) { - cb_plex_warning (COBC_WARN_FILLER, newline_count, - _("source text after program-text area (column %d)"), - cb_text_column); - } - - if (unlikely (continuation)) { - gotcr = strlen (bp); - memmove (buff, bp, gotcr + 1); - newline_count++; - } else { - /* Insert newlines at the start of the buffer */ - gotcr = strlen (buff); - if (newline_count != 0) { - memmove (buff + newline_count, buff, gotcr + 1); - memset (buff, '\n', newline_count); - gotcr += newline_count; - } - newline_count = 1; - } - return (int)gotcr; -} - -static struct cb_text_list * -pp_text_list_add (struct cb_text_list *list, const char *text, - const size_t size) -{ - struct cb_text_list *p; - void *tp; - - p = cobc_plex_malloc (sizeof (struct cb_text_list)); - tp = cobc_plex_malloc (size + 1); - memcpy (tp, text, size); - p->text = tp; - if (!list) { - p->last = p; - return p; - } - list->last->next = p; - list->last = p; - return list; -} - -static void -ppecho (const char *text, const cob_u32_t alt_space, const int textlen) -{ - /* performance note: while this function used 5% (according to callgrind) - of the complete time spent in a sample run with - -fsyntax-only on 880 production code files (2,500,000 LOC) - 3.8% of this time is spent in fwrite, therefore not much potential - for optimization - */ - struct cb_replace_list *r; - struct cb_replace_list *save_ptr; - const struct cb_text_list *lno; - struct cb_text_list *queue; - struct cb_text_list *save_queue; - const char *s; - char *temp_ptr; - size_t size; - size_t size2; - - /* ensure nothing is in the stream buffer */ - fflush (ppout); - - /* Check for replacement text before outputting */ - if (alt_space) { - s = yytext; - } else { - s = text; - } - - if (text_queue == NULL && (text[0] == ' ' || text[0] == '\n')) { - /* No replacement */ - fwrite (text, (size_t)textlen, (size_t)1, ppout); - if (cb_listing_file) { - check_listing (s, 0); - } - return; - } - if (!current_replace_list && !base_replace_list) { - /* Output queue */ - for (; text_queue; text_queue = text_queue->next) { - fputs (text_queue->text, ppout); - } - fwrite (text, (size_t)textlen, (size_t)1, ppout); - if (cb_listing_file) { - check_listing (s, 0); - } - return; - } - if (!current_replace_list) { - current_replace_list = base_replace_list; - save_ptr = NULL; - } else { - current_replace_list->last->next = base_replace_list; - save_ptr = current_replace_list->last; - } - - /* Do replacement */ - text_queue = pp_text_list_add (text_queue, text, (size_t)textlen); - - save_queue = NULL; - size = 0; - size2 = 0; - for (r = current_replace_list; r; r = r->next) { - queue = text_queue; - /* The LEADING/TRAILING code looks peculiar as we use */ - /* variables after breaking out of the loop BUT */ - /* ppparse.y guarantees that we have only one token */ - /* and therefore only one iteration of this loop */ - for (lno = r->old_text; lno; lno = lno->next) { - if (lno->text[0] == ' ' || lno->text[0] == '\n') { - continue; - } - while (queue && (queue->text[0] == ' ' || - queue->text[0] == '\n')) { - queue = queue->next; - } - if (queue == NULL) { - /* Partial match */ - if (!save_ptr) { - current_replace_list = NULL; - } else { - save_ptr->next = NULL; - } - return; - } - if (r->lead_trail == CB_REPLACE_LEADING) { - /* Check leading text */ - size = strlen (lno->text); - if (strncasecmp (lno->text, queue->text, size)) { - /* No match */ - break; - } - save_queue = queue; - } else if (r->lead_trail == CB_REPLACE_TRAILING) { - /* Check trailing text */ - size = strlen (lno->text); - size2 = strlen (queue->text); - if (size2 < size) { - /* No match */ - break; - } - size2 -= size; - if (strncasecmp (lno->text, queue->text + size2, size)) { - /* No match */ - break; - } - save_queue = queue; - } else if (strcasecmp (lno->text, queue->text)) { - /* No match */ - break; - } - queue = queue->next; - } - if (lno == NULL) { - /* Match */ - if (r->lead_trail == CB_REPLACE_TRAILING - && save_queue /* <- silence warnings */) { - /* Non-matched part of original text */ - fprintf (ppout, "%*.*s", (int)size2, (int)size2, - save_queue->text); - if (cb_listing_file) { - temp_ptr = cobc_strdup (save_queue->text); - *(temp_ptr + size2) = 0; - check_listing (temp_ptr, 0); - cobc_free (temp_ptr); - } - } - for (lno = r->new_text; lno; lno = lno->next) { - ppecho_direct (lno->text); - } - if (r->lead_trail == CB_REPLACE_LEADING - && save_queue /* <- silence warnings */) { - /* Non-matched part of original text */ - ppecho_direct (save_queue->text + size); - } - text_queue = queue; - continue; - } - } - - /* No match */ - for (; text_queue; text_queue = text_queue->next) { - ppecho_direct (text_queue->text); - } - if (!save_ptr) { - current_replace_list = NULL; - } else { - save_ptr->next = NULL; - } -} - -static void -skip_to_eol (void) -{ - int c; - - /* Skip bytes to end of line */ - while ((c = input ()) != EOF) { - if (c == '\n') { - break; - } - } - if (c != EOF) { - unput (c); - } -} - -static void -display_finish (void) -{ - int msg_len; - - if (!plex_skip_input) { - msg_len = strlen (display_msg) - 1; - while (msg_len != 0 && display_msg[msg_len] == ' ') { - display_msg[msg_len--] = 0; - } - puts (display_msg); - display_msg[0] = 0; - } - unput ('\n'); -} - -static void -ppecho_direct (const char *text) -{ - fputs (text, ppout); - if (cb_listing_file) { - check_listing (text, 0); - } -} - -static void -check_listing (const char *text, const unsigned int comment) -{ - const char *s; - char c; - - /* Check for listing */ - if (!cb_listing_file) { - /* Nothing to do */ - return; - } - if (!text) { - return; - } -#ifndef COB_INTERNAL_XREF - if (cobc_gen_listing == 2) { - /* Passed to cobxref */ - fputs (text, cb_listing_file); - return; - } -#endif - if (comment) { - c = '*'; - } else { - c = ' '; - } - - if (requires_listing_line) { - if (requires_new_line) { - requires_new_line = 0; - putc ('\n', cb_listing_file); - } - fprintf (cb_listing_file, "%6d%c", ++listing_line, c); - } - - if (requires_listing_line && cb_source_format != CB_FORMAT_FREE && - strlen (text) > 6) { - s = &text[6]; - } else { - s = text; - } - fputs (s, cb_listing_file); - if (strchr (text, '\n')) { - requires_listing_line = 1; - } else { - requires_listing_line = 0; - } -} diff -Nru gnucobol-4.0~early~20200606/cobc/ppparse.c gnucobol-5/cobc/ppparse.c --- gnucobol-4.0~early~20200606/cobc/ppparse.c 2020-06-06 20:52:36.000000000 +0000 +++ gnucobol-5/cobc/ppparse.c 1970-01-01 00:00:00.000000000 +0000 @@ -1,3337 +0,0 @@ -/* A Bison parser, made by GNU Bison 3.0.4. */ - -/* Bison implementation for Yacc-like parsers in C - - Copyright (C) 1984, 1989-1990, 2000-2015 Free Software Foundation, Inc. - - This program is free software: you can redistribute it and/or modify - it under the terms of the GNU General Public License as published by - the Free Software Foundation, either version 3 of the License, or - (at your option) any later version. - - This program is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with this program. If not, see . */ - -/* As a special exception, you may create a larger work that contains - part or all of the Bison parser skeleton and distribute that work - under terms of your choice, so long as that work isn't itself a - parser generator using the skeleton or a modified version thereof - as a parser skeleton. Alternatively, if you modify or redistribute - the parser skeleton itself, you may (at your option) remove this - special exception, which will cause the skeleton and the resulting - Bison output files to be licensed under the GNU General Public - License without this special exception. - - This special exception was added by the Free Software Foundation in - version 2.2 of Bison. */ - -/* C LALR(1) parser skeleton written by Richard Stallman, by - simplifying the original so-called "semantic" parser. */ - -/* All symbols defined below should begin with yy or YY, to avoid - infringing on user name space. This should be done even for local - variables, as they might otherwise be expanded by user macros. - There are some unavoidable exceptions within include files to - define necessary library symbols; they are noted "INFRINGES ON - USER NAME SPACE" below. */ - -/* Identify Bison output. */ -#define YYBISON 1 - -/* Bison version. */ -#define YYBISON_VERSION "3.0.4" - -/* Skeleton name. */ -#define YYSKELETON_NAME "yacc.c" - -/* Pure parsers. */ -#define YYPURE 0 - -/* Push parsers. */ -#define YYPUSH 0 - -/* Pull parsers. */ -#define YYPULL 1 - -/* Substitute the type names. */ -#define YYSTYPE PPSTYPE -/* Substitute the variable and function names. */ -#define yyparse ppparse -#define yylex pplex -#define yyerror pperror -#define yydebug ppdebug -#define yynerrs ppnerrs - -#define yylval pplval -#define yychar ppchar - -/* Copy the first part of user declarations. */ -#line 29 "ppparse.y" /* yacc.c:339 */ - -#include - -#include -#include -#include -#include -#include - -#define COB_IN_PPPARSE 1 -#include "cobc.h" -#include "tree.h" - -#ifndef _STDLIB_H -#define _STDLIB_H 1 -#endif - -#define pperror(x) cb_error_always ("%s", x) - -#define COND_EQ 0 -#define COND_LT 1U -#define COND_GT 2U -#define COND_LE 3U -#define COND_GE 4U -#define COND_NE 5U - -/* Global variables */ - -int current_call_convention; - -/* Local variables */ - -static struct cb_define_struct *ppp_setvar_list = NULL; -static unsigned int current_cmd = 0; - -/* Local functions */ - -static char * -fix_filename (char *name) -{ - /* remove quotation from alphanumeric literals */ - if (name[0] == '\'' || name[0] == '\"') { - name++; - name[strlen (name) - 1] = 0; - } - return name; -} - -static char * -fold_lower (char *name) -{ - unsigned char *p; - - for (p = (unsigned char *)name; *p; p++) { - if (isupper (*p)) { - *p = (cob_u8_t)tolower (*p); - } - } - return name; -} - -static char * -fold_upper (char *name) -{ - unsigned char *p; - - for (p = (unsigned char *)name; *p; p++) { - if (islower (*p)) { - *p = (cob_u8_t)toupper (*p); - } - } - return name; -} - -static struct cb_replace_list * -ppp_replace_list_add (struct cb_replace_list *list, - const struct cb_text_list *old_text, - const struct cb_text_list *new_text, - const unsigned int lead_or_trail) -{ - struct cb_replace_list *p; - - p = cobc_plex_malloc (sizeof (struct cb_replace_list)); - p->line_num = cb_source_line; - p->old_text = old_text; - p->new_text = new_text; - p->lead_trail = lead_or_trail; - if (!list) { - p->last = p; - return p; - } - list->last->next = p; - list->last = p; - return list; -} - -static unsigned int -ppp_set_value (struct cb_define_struct *p, const char *value) -{ - const char *s; - size_t size; - unsigned int dotseen; - int sign; - int int_part; - int dec_part; - - if (!value) { - p->deftype = PLEX_DEF_NONE; - p->value = NULL; - p->sign = 0; - p->int_part = 0; - p->dec_part = 0; - return 0; - } - - if (*value == '"' || *value == '\'') { - sign = *value; - p->value = cobc_plex_strdup (value + 1); - size = strlen (p->value) - 1; - if (sign != p->value[size]) { - p->value = NULL; - p->deftype = PLEX_DEF_NONE; - return 1; - } - p->value[size] = 0; - p->deftype = PLEX_DEF_LIT; - p->sign = 0; - p->int_part = 0; - p->dec_part = 0; - return 0; - } - - p->value = cobc_plex_strdup (value); - p->deftype = PLEX_DEF_NUM; - p->sign = 0; - p->int_part = 0; - p->dec_part = 0; - - sign = 0; - if (*value == '+') { - value++; - } else if (*value == '-') { - value++; - sign = 1; - } - int_part = 0; - dec_part = 0; - size = 0; - dotseen = 0; - s = value; - for ( ; *s; ++s, ++size) { - if (*s == '.') { - if (dotseen) { - p->deftype = PLEX_DEF_NONE; - return 1; - } - dotseen = 1; - continue; - } - if (*s > '9' || *s < '0') { - p->deftype = PLEX_DEF_NONE; - return 1; - } - if (!dotseen) { - int_part = (int_part * 10) + (*s - '0'); - } else { - dec_part = (dec_part * 10) + (*s - '0'); - } - } - - if (!int_part && !dec_part) { - sign = 0; - } - p->sign = sign; - p->int_part = int_part; - p->dec_part = dec_part; - return 0; -} - -static unsigned int -ppp_compare_vals (const struct cb_define_struct *p1, - const struct cb_define_struct *p2, - const unsigned int cond) -{ - int result; - - if (!p1 || !p2) { - return 0; - } - if (p1->deftype != PLEX_DEF_LIT && p1->deftype != PLEX_DEF_NUM) { - return 0; - } - if (p2->deftype != PLEX_DEF_LIT && p2->deftype != PLEX_DEF_NUM) { - return 0; - } - if (p1->deftype != p2->deftype) { - cb_warning (COBC_WARN_FILLER, _("directive comparison on different types")); - return 0; - } - if (p1->deftype == PLEX_DEF_LIT) { - result = strcmp (p1->value, p2->value); - } else { - if (p1->sign && !p2->sign) { - result = -1; - } else if (!p1->sign && p2->sign) { - result = 1; - } else if (p1->int_part < p2->int_part) { - if (p1->sign) { - result = 1; - } else { - result = -1; - } - } else if (p1->int_part > p2->int_part) { - if (p1->sign) { - result = -1; - } else { - result = 1; - } - } else if (p1->dec_part < p2->dec_part) { - if (p1->sign) { - result = 1; - } else { - result = -1; - } - } else if (p1->dec_part > p2->dec_part) { - if (p1->sign) { - result = -1; - } else { - result = 1; - } - } else { - result = 0; - } - } - switch (cond) { - case COND_EQ: - return (result == 0); - case COND_LT: - return (result < 0); - case COND_GT: - return (result > 0); - case COND_LE: - return (result <= 0); - case COND_GE: - return (result >= 0); - case COND_NE: - return (result != 0); - default: - break; - } - return 0; -} - -static struct cb_define_struct * -ppp_define_add (struct cb_define_struct *list, const char *name, - const char *text, const unsigned int override) -{ - struct cb_define_struct *p; - struct cb_define_struct *l; - - /* Check duplicate */ - for (l = list; l; l = l->next) { - if (!strcasecmp (name, l->name)) { - if (!override && l->deftype != PLEX_DEF_DEL) { - cb_error (_("duplicate DEFINE directive '%s'"), name); - return NULL; - } - if (l->value) { - l->value = NULL; - } - if (ppp_set_value (l, text)) { - cb_error (_("invalid constant in DEFINE directive")); - return NULL; - } - return list; - } - } - - p = cobc_plex_malloc (sizeof (struct cb_define_struct)); - p->name = cobc_plex_strdup (name); - if (ppp_set_value (p, text)) { - cb_error (_("invalid constant in DEFINE directive")); - return NULL; - } - - if (!list) { - p->last = p; - return p; - } - list->last->next = p; - list->last = p; - return list; -} - -static void -ppp_define_del (const char *name) -{ - struct cb_define_struct *l; - - for (l = ppp_setvar_list; l; l = l->next) { - if (!strcmp (name, l->name)) { - l->deftype = PLEX_DEF_DEL; - if (l->value) { - l->value = NULL; - } - l->sign = 0; - l->int_part = 0; - l->dec_part = 0; - break; - } - } -} - -void -ppp_clear_lists (void) -{ - ppp_setvar_list = NULL; -} - -struct cb_define_struct * -ppp_search_lists (const char *name) -{ - struct cb_define_struct *p; - - for (p = ppp_setvar_list; p; p = p->next) { - if (p->name == NULL) { - continue; - } - if (!strcasecmp (name, p->name)) { - if (p->deftype != PLEX_DEF_DEL) { - return p; - } - break; - } - } - return NULL; -} - -static struct cb_text_list * -ppp_list_add (struct cb_text_list *list, const char *text) -{ - struct cb_text_list *p; - - p = cobc_plex_malloc (sizeof (struct cb_text_list)); - p->text = cobc_plex_strdup (text); - if (!list) { - p->last = p; - return p; - } - list->last->next = p; - list->last = p; - return list; -} - -static struct cb_text_list * -ppp_list_append (struct cb_text_list *list_1, struct cb_text_list *list_2) -{ - struct cb_text_list *list_1_end; - - if (!list_1) { - return list_2; - } - - for (list_1_end = list_1; - list_1_end->next; - list_1_end = list_1_end->next); - list_1_end->next = list_2; - list_2->last = list_1_end; - - return list_1; -} - -static unsigned int -ppp_search_comp_vars (const char *name) -{ -#undef CB_PARSE_DEF -#define CB_PARSE_DEF(x,z) if (!strcasecmp (name, x)) return (z); -#include "ppparse.def" -#undef CB_PARSE_DEF - cb_warning (COBC_WARN_FILLER, _("compiler flag '%s' unknown"), name); - return 0; -} - -static unsigned int -ppp_check_needs_quote (const char *envval) -{ - const char *s; - size_t size; - unsigned int dot_seen; - unsigned int sign_seen; - - /* Non-quoted value - Check if possible numeric */ - dot_seen = 0; - sign_seen = 0; - size = 0; - s = envval; - if (*s == '+' || *s == '-') { - sign_seen = 1; - size++; - s++; - } - for (; *s; ++s) { - if (*s == '.') { - if (dot_seen) { - break; - } - dot_seen = 1; - size++; - continue; - } - if (*s > '9' || *s < '0') { - break; - } - size++; - } - - if (*s || size <= ((size_t)dot_seen + sign_seen)) { - return 1; - } - return 0; -} - -static void -ppp_error_invalid_option (const char *directive, const char *option) -{ - cb_error (_("invalid %s directive option '%s'"), directive, option); -} - -/* Global functions */ - -void -ppparse_clear_vars (const struct cb_define_struct *p) -{ - const struct cb_define_struct *q; - - ppp_setvar_list = NULL; - /* Set standard DEFINE's */ - if (cb_perform_osvs) { - ppp_setvar_list = ppp_define_add (ppp_setvar_list, - "PERFORM-TYPE", - "'OSVS'", 0); - } else { - ppp_setvar_list = ppp_define_add (ppp_setvar_list, - "PERFORM-TYPE", - "'MF'", 0); - } - if (cb_ebcdic_sign) { - ppp_setvar_list = ppp_define_add (ppp_setvar_list, - "SIGN", - "'EBCDIC'", 0); - } else { - ppp_setvar_list = ppp_define_add (ppp_setvar_list, - "SIGN", - "'ASCII'", 0); - } -#ifdef WORDS_BIGENDIAN - ppp_setvar_list = ppp_define_add (ppp_setvar_list, - "ENDIAN", - "'BIG'", 0); -#else - ppp_setvar_list = ppp_define_add (ppp_setvar_list, - "ENDIAN", - "'LITTLE'", 0); -#endif -#if ' ' == 0x20 - ppp_setvar_list = ppp_define_add (ppp_setvar_list, - "CHARSET", - "'ASCII'", 0); -#elif ' ' == 0x40 - ppp_setvar_list = ppp_define_add (ppp_setvar_list, - "CHARSET", - "'EBCDIC'", 0); -#else - ppp_setvar_list = ppp_define_add (ppp_setvar_list, - "CHARSET", - "'UNKNOWN'", 0); -#endif - /* Set DEFINE's from '-D' option(s) */ - for (q = p; q; q = q->next) { - ppp_setvar_list = ppp_define_add (ppp_setvar_list, - q->name, - q->value, 0); - } - /* reset CALL CONVENTION */ - current_call_convention = CB_CONV_COBOL; -} - - -#line 564 "ppparse.c" /* yacc.c:339 */ - -# ifndef YY_NULLPTR -# if defined __cplusplus && 201103L <= __cplusplus -# define YY_NULLPTR nullptr -# else -# define YY_NULLPTR 0 -# endif -# endif - -/* Enabling verbose error messages. */ -#ifdef YYERROR_VERBOSE -# undef YYERROR_VERBOSE -# define YYERROR_VERBOSE 1 -#else -# define YYERROR_VERBOSE 1 -#endif - -/* In a future release of Bison, this section will be replaced - by #include "y.tab.h". */ -#ifndef YY_PP_PPPARSE_H_INCLUDED -# define YY_PP_PPPARSE_H_INCLUDED -/* Debug traces. */ -#ifndef PPDEBUG -# if defined YYDEBUG -#if YYDEBUG -# define PPDEBUG 1 -# else -# define PPDEBUG 0 -# endif -# else /* ! defined YYDEBUG */ -# define PPDEBUG 0 -# endif /* ! defined YYDEBUG */ -#endif /* ! defined PPDEBUG */ -#if PPDEBUG -extern int ppdebug; -#endif - -/* Token type. */ -#ifndef PPTOKENTYPE -# define PPTOKENTYPE - enum pptokentype - { - TOKEN_EOF = 0, - ALSO = 258, - BY = 259, - COPY = 260, - EQEQ = 261, - IN = 262, - LAST = 263, - LEADING = 264, - OF = 265, - OFF = 266, - PRINTING = 267, - REPLACE = 268, - REPLACING = 269, - SUPPRESS = 270, - TRAILING = 271, - DOT = 272, - GARBAGE = 273, - LISTING_DIRECTIVE = 274, - LISTING_STATEMENT = 275, - TITLE_STATEMENT = 276, - CONTROL_STATEMENT = 277, - SOURCE = 278, - NOSOURCE = 279, - LIST = 280, - NOLIST = 281, - MAP = 282, - NOMAP = 283, - LEAP_SECOND_DIRECTIVE = 284, - SOURCE_DIRECTIVE = 285, - FORMAT = 286, - IS = 287, - FIXED = 288, - FREE = 289, - VARIABLE = 290, - CALL_DIRECTIVE = 291, - COBOL = 292, - TOK_EXTERN = 293, - STDCALL = 294, - STATIC = 295, - DEFINE_DIRECTIVE = 296, - AS = 297, - PARAMETER = 298, - OVERRIDE = 299, - SET_DIRECTIVE = 300, - ADDRSV = 301, - ADDSYN = 302, - ASSIGN = 303, - CALLFH = 304, - XFD = 305, - COMP1 = 306, - CONSTANT = 307, - FOLDCOPYNAME = 308, - MAKESYN = 309, - NOFOLDCOPYNAME = 310, - REMOVE = 311, - SOURCEFORMAT = 312, - IF_DIRECTIVE = 313, - ELSE_DIRECTIVE = 314, - ENDIF_DIRECTIVE = 315, - ELIF_DIRECTIVE = 316, - GE = 317, - LE = 318, - LT = 319, - GT = 320, - EQ = 321, - NE = 322, - NOT = 323, - THAN = 324, - TO = 325, - OR = 326, - EQUAL = 327, - GREATER = 328, - LESS = 329, - SET = 330, - DEFINED = 331, - TURN_DIRECTIVE = 332, - ON = 333, - CHECKING = 334, - WITH = 335, - LOCATION = 336, - TERMINATOR = 337, - TOKEN = 338, - TEXT_NAME = 339, - VARIABLE_NAME = 340, - LITERAL = 341 - }; -#endif -/* Tokens. */ -#define TOKEN_EOF 0 -#define ALSO 258 -#define BY 259 -#define COPY 260 -#define EQEQ 261 -#define IN 262 -#define LAST 263 -#define LEADING 264 -#define OF 265 -#define OFF 266 -#define PRINTING 267 -#define REPLACE 268 -#define REPLACING 269 -#define SUPPRESS 270 -#define TRAILING 271 -#define DOT 272 -#define GARBAGE 273 -#define LISTING_DIRECTIVE 274 -#define LISTING_STATEMENT 275 -#define TITLE_STATEMENT 276 -#define CONTROL_STATEMENT 277 -#define SOURCE 278 -#define NOSOURCE 279 -#define LIST 280 -#define NOLIST 281 -#define MAP 282 -#define NOMAP 283 -#define LEAP_SECOND_DIRECTIVE 284 -#define SOURCE_DIRECTIVE 285 -#define FORMAT 286 -#define IS 287 -#define FIXED 288 -#define FREE 289 -#define VARIABLE 290 -#define CALL_DIRECTIVE 291 -#define COBOL 292 -#define TOK_EXTERN 293 -#define STDCALL 294 -#define STATIC 295 -#define DEFINE_DIRECTIVE 296 -#define AS 297 -#define PARAMETER 298 -#define OVERRIDE 299 -#define SET_DIRECTIVE 300 -#define ADDRSV 301 -#define ADDSYN 302 -#define ASSIGN 303 -#define CALLFH 304 -#define XFD 305 -#define COMP1 306 -#define CONSTANT 307 -#define FOLDCOPYNAME 308 -#define MAKESYN 309 -#define NOFOLDCOPYNAME 310 -#define REMOVE 311 -#define SOURCEFORMAT 312 -#define IF_DIRECTIVE 313 -#define ELSE_DIRECTIVE 314 -#define ENDIF_DIRECTIVE 315 -#define ELIF_DIRECTIVE 316 -#define GE 317 -#define LE 318 -#define LT 319 -#define GT 320 -#define EQ 321 -#define NE 322 -#define NOT 323 -#define THAN 324 -#define TO 325 -#define OR 326 -#define EQUAL 327 -#define GREATER 328 -#define LESS 329 -#define SET 330 -#define DEFINED 331 -#define TURN_DIRECTIVE 332 -#define ON 333 -#define CHECKING 334 -#define WITH 335 -#define LOCATION 336 -#define TERMINATOR 337 -#define TOKEN 338 -#define TEXT_NAME 339 -#define VARIABLE_NAME 340 -#define LITERAL 341 - -/* Value type. */ -#if ! defined PPSTYPE && ! defined PPSTYPE_IS_DECLARED - -union PPSTYPE -{ -#line 518 "ppparse.y" /* yacc.c:355 */ - - char *s; - struct cb_text_list *l; - struct cb_replace_list *r; - struct cb_define_struct *ds; - unsigned int ui; - int si; - -#line 795 "ppparse.c" /* yacc.c:355 */ -}; - -typedef union PPSTYPE PPSTYPE; -# define PPSTYPE_IS_TRIVIAL 1 -# define PPSTYPE_IS_DECLARED 1 -#endif - - -extern PPSTYPE pplval; - -int ppparse (void); - -#endif /* !YY_PP_PPPARSE_H_INCLUDED */ - -/* Copy the second part of user declarations. */ - -#line 812 "ppparse.c" /* yacc.c:358 */ - -#ifdef short -# undef short -#endif - -#ifdef YYTYPE_UINT8 -typedef YYTYPE_UINT8 yytype_uint8; -#else -typedef unsigned char yytype_uint8; -#endif - -#ifdef YYTYPE_INT8 -typedef YYTYPE_INT8 yytype_int8; -#else -typedef signed char yytype_int8; -#endif - -#ifdef YYTYPE_UINT16 -typedef YYTYPE_UINT16 yytype_uint16; -#else -typedef unsigned short int yytype_uint16; -#endif - -#ifdef YYTYPE_INT16 -typedef YYTYPE_INT16 yytype_int16; -#else -typedef short int yytype_int16; -#endif - -#ifndef YYSIZE_T -# ifdef __SIZE_TYPE__ -# define YYSIZE_T __SIZE_TYPE__ -# elif defined size_t -# define YYSIZE_T size_t -# elif ! defined YYSIZE_T -# include /* INFRINGES ON USER NAME SPACE */ -# define YYSIZE_T size_t -# else -# define YYSIZE_T unsigned int -# endif -#endif - -#define YYSIZE_MAXIMUM ((YYSIZE_T) -1) - -#ifndef YY_ -# if defined YYENABLE_NLS && YYENABLE_NLS -# if ENABLE_NLS -# include /* INFRINGES ON USER NAME SPACE */ -# define YY_(Msgid) dgettext ("bison-runtime", Msgid) -# endif -# endif -# ifndef YY_ -# define YY_(Msgid) Msgid -# endif -#endif - -#ifndef YY_ATTRIBUTE -# if (defined __GNUC__ \ - && (2 < __GNUC__ || (__GNUC__ == 2 && 96 <= __GNUC_MINOR__))) \ - || defined __SUNPRO_C && 0x5110 <= __SUNPRO_C -# define YY_ATTRIBUTE(Spec) __attribute__(Spec) -# else -# define YY_ATTRIBUTE(Spec) /* empty */ -# endif -#endif - -#ifndef YY_ATTRIBUTE_PURE -# define YY_ATTRIBUTE_PURE YY_ATTRIBUTE ((__pure__)) -#endif - -#ifndef YY_ATTRIBUTE_UNUSED -# define YY_ATTRIBUTE_UNUSED YY_ATTRIBUTE ((__unused__)) -#endif - -#if !defined _Noreturn \ - && (!defined __STDC_VERSION__ || __STDC_VERSION__ < 201112) -# if defined _MSC_VER && 1200 <= _MSC_VER -# define _Noreturn __declspec (noreturn) -# else -# define _Noreturn YY_ATTRIBUTE ((__noreturn__)) -# endif -#endif - -/* Suppress unused-variable warnings by "using" E. */ -#if ! defined lint || defined __GNUC__ -# define YYUSE(E) ((void) (E)) -#else -# define YYUSE(E) /* empty */ -#endif - -#if defined __GNUC__ && 407 <= __GNUC__ * 100 + __GNUC_MINOR__ -/* Suppress an incorrect diagnostic about yylval being uninitialized. */ -# define YY_IGNORE_MAYBE_UNINITIALIZED_BEGIN \ - _Pragma ("GCC diagnostic push") \ - _Pragma ("GCC diagnostic ignored \"-Wuninitialized\"")\ - _Pragma ("GCC diagnostic ignored \"-Wmaybe-uninitialized\"") -# define YY_IGNORE_MAYBE_UNINITIALIZED_END \ - _Pragma ("GCC diagnostic pop") -#else -# define YY_INITIAL_VALUE(Value) Value -#endif -#ifndef YY_IGNORE_MAYBE_UNINITIALIZED_BEGIN -# define YY_IGNORE_MAYBE_UNINITIALIZED_BEGIN -# define YY_IGNORE_MAYBE_UNINITIALIZED_END -#endif -#ifndef YY_INITIAL_VALUE -# define YY_INITIAL_VALUE(Value) /* Nothing. */ -#endif - - -#if ! defined yyoverflow || YYERROR_VERBOSE - -/* The parser invokes alloca or malloc; define the necessary symbols. */ - -# ifdef YYSTACK_USE_ALLOCA -# if YYSTACK_USE_ALLOCA -# ifdef __GNUC__ -# define YYSTACK_ALLOC __builtin_alloca -# elif defined __BUILTIN_VA_ARG_INCR -# include /* INFRINGES ON USER NAME SPACE */ -# elif defined _AIX -# define YYSTACK_ALLOC __alloca -# elif defined _MSC_VER -# include /* INFRINGES ON USER NAME SPACE */ -# define alloca _alloca -# else -# define YYSTACK_ALLOC alloca -# if ! defined _ALLOCA_H && ! defined EXIT_SUCCESS -# include /* INFRINGES ON USER NAME SPACE */ - /* Use EXIT_SUCCESS as a witness for stdlib.h. */ -# ifndef EXIT_SUCCESS -# define EXIT_SUCCESS 0 -# endif -# endif -# endif -# endif -# endif - -# ifdef YYSTACK_ALLOC - /* Pacify GCC's 'empty if-body' warning. */ -# define YYSTACK_FREE(Ptr) do { /* empty */; } while (0) -# ifndef YYSTACK_ALLOC_MAXIMUM - /* The OS might guarantee only one guard page at the bottom of the stack, - and a page size can be as small as 4096 bytes. So we cannot safely - invoke alloca (N) if N exceeds 4096. Use a slightly smaller number - to allow for a few compiler-allocated temporary stack slots. */ -# define YYSTACK_ALLOC_MAXIMUM 4032 /* reasonable circa 2006 */ -# endif -# else -# define YYSTACK_ALLOC YYMALLOC -# define YYSTACK_FREE YYFREE -# ifndef YYSTACK_ALLOC_MAXIMUM -# define YYSTACK_ALLOC_MAXIMUM YYSIZE_MAXIMUM -# endif -# if (defined __cplusplus && ! defined EXIT_SUCCESS \ - && ! ((defined YYMALLOC || defined malloc) \ - && (defined YYFREE || defined free))) -# include /* INFRINGES ON USER NAME SPACE */ -# ifndef EXIT_SUCCESS -# define EXIT_SUCCESS 0 -# endif -# endif -# ifndef YYMALLOC -# define YYMALLOC malloc -# if ! defined malloc && ! defined EXIT_SUCCESS -void *malloc (YYSIZE_T); /* INFRINGES ON USER NAME SPACE */ -# endif -# endif -# ifndef YYFREE -# define YYFREE free -# if ! defined free && ! defined EXIT_SUCCESS -void free (void *); /* INFRINGES ON USER NAME SPACE */ -# endif -# endif -# endif -#endif /* ! defined yyoverflow || YYERROR_VERBOSE */ - - -#if (! defined yyoverflow \ - && (! defined __cplusplus \ - || (defined PPSTYPE_IS_TRIVIAL && PPSTYPE_IS_TRIVIAL))) - -/* A type that is properly aligned for any stack member. */ -union yyalloc -{ - yytype_int16 yyss_alloc; - YYSTYPE yyvs_alloc; -}; - -/* The size of the maximum gap between one aligned stack and the next. */ -# define YYSTACK_GAP_MAXIMUM (sizeof (union yyalloc) - 1) - -/* The size of an array large to enough to hold all stacks, each with - N elements. */ -# define YYSTACK_BYTES(N) \ - ((N) * (sizeof (yytype_int16) + sizeof (YYSTYPE)) \ - + YYSTACK_GAP_MAXIMUM) - -# define YYCOPY_NEEDED 1 - -/* Relocate STACK from its old location to the new one. The - local variables YYSIZE and YYSTACKSIZE give the old and new number of - elements in the stack, and YYPTR gives the new location of the - stack. Advance YYPTR to a properly aligned location for the next - stack. */ -# define YYSTACK_RELOCATE(Stack_alloc, Stack) \ - do \ - { \ - YYSIZE_T yynewbytes; \ - YYCOPY (&yyptr->Stack_alloc, Stack, yysize); \ - Stack = &yyptr->Stack_alloc; \ - yynewbytes = yystacksize * sizeof (*Stack) + YYSTACK_GAP_MAXIMUM; \ - yyptr += yynewbytes / sizeof (*yyptr); \ - } \ - while (0) - -#endif - -#if defined YYCOPY_NEEDED && YYCOPY_NEEDED -/* Copy COUNT objects from SRC to DST. The source and destination do - not overlap. */ -# ifndef YYCOPY -# if defined __GNUC__ && 1 < __GNUC__ -# define YYCOPY(Dst, Src, Count) \ - __builtin_memcpy (Dst, Src, (Count) * sizeof (*(Src))) -# else -# define YYCOPY(Dst, Src, Count) \ - do \ - { \ - YYSIZE_T yyi; \ - for (yyi = 0; yyi < (Count); yyi++) \ - (Dst)[yyi] = (Src)[yyi]; \ - } \ - while (0) -# endif -# endif -#endif /* !YYCOPY_NEEDED */ - -/* YYFINAL -- State number of the termination state. */ -#define YYFINAL 2 -/* YYLAST -- Last index in YYTABLE. */ -#define YYLAST 217 - -/* YYNTOKENS -- Number of terminals. */ -#define YYNTOKENS 89 -/* YYNNTS -- Number of nonterminals. */ -#define YYNNTS 58 -/* YYNRULES -- Number of rules. */ -#define YYNRULES 164 -/* YYNSTATES -- Number of states. */ -#define YYNSTATES 243 - -/* YYTRANSLATE[YYX] -- Symbol number corresponding to YYX as returned - by yylex, with out-of-bounds checking. */ -#define YYUNDEFTOK 2 -#define YYMAXUTOK 341 - -#define YYTRANSLATE(YYX) \ - ((unsigned int) (YYX) <= YYMAXUTOK ? yytranslate[YYX] : YYUNDEFTOK) - -/* YYTRANSLATE[TOKEN-NUM] -- Symbol number corresponding to TOKEN-NUM - as returned by yylex, without out-of-bounds checking. */ -static const yytype_uint8 yytranslate[] = -{ - 0, 2, 2, 2, 2, 2, 2, 2, 2, 2, - 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, - 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, - 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, - 87, 88, 2, 2, 2, 2, 2, 2, 2, 2, - 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, - 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, - 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, - 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, - 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, - 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, - 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, - 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, - 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, - 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, - 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, - 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, - 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, - 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, - 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, - 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, - 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, - 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, - 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, - 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, - 2, 2, 2, 2, 2, 2, 1, 2, 3, 4, - 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, - 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, - 25, 26, 27, 28, 29, 30, 31, 32, 33, 34, - 35, 36, 37, 38, 39, 40, 41, 42, 43, 44, - 45, 46, 47, 48, 49, 50, 51, 52, 53, 54, - 55, 56, 57, 58, 59, 60, 61, 62, 63, 64, - 65, 66, 67, 68, 69, 70, 71, 72, 73, 74, - 75, 76, 77, 78, 79, 80, 81, 82, 83, 84, - 85, 86 -}; - -#if PPDEBUG - /* YYRLINE[YYN] -- Source line where rule number YYN was defined. */ -static const yytype_uint16 yyrline[] = -{ - 0, 656, 656, 657, 661, 662, 663, 664, 665, 672, - 673, 674, 675, 676, 677, 679, 678, 684, 683, 688, - 692, 697, 696, 709, 710, 714, 725, 726, 734, 742, - 760, 770, 774, 781, 799, 817, 821, 825, 833, 841, - 870, 874, 881, 882, 889, 898, 901, 908, 917, 922, - 926, 931, 939, 948, 982, 986, 1002, 1009, 1012, 1013, - 1017, 1018, 1022, 1023, 1027, 1028, 1029, 1030, 1031, 1032, - 1035, 1036, 1039, 1041, 1045, 1049, 1056, 1057, 1060, 1062, - 1063, 1064, 1068, 1069, 1073, 1074, 1078, 1083, 1088, 1093, - 1100, 1107, 1114, 1124, 1139, 1146, 1147, 1151, 1164, 1178, - 1182, 1186, 1190, 1194, 1198, 1202, 1206, 1210, 1214, 1218, - 1225, 1233, 1242, 1255, 1258, 1265, 1266, 1269, 1270, 1275, - 1278, 1285, 1289, 1296, 1300, 1304, 1308, 1315, 1319, 1326, - 1330, 1334, 1341, 1348, 1352, 1359, 1363, 1370, 1374, 1381, - 1388, 1403, 1407, 1415, 1419, 1429, 1432, 1440, 1443, 1451, - 1454, 1462, 1465, 1471, 1471, 1472, 1472, 1473, 1473, 1474, - 1474, 1475, 1475, 1476, 1476 -}; -#endif - -#if PPDEBUG || YYERROR_VERBOSE || 1 -/* YYTNAME[SYMBOL-NUM] -- String name of the symbol SYMBOL-NUM. - First, the terminals, then, starting at YYNTOKENS, nonterminals. */ -static const char *const yytname[] = -{ - "\"end of file\"", "error", "$undefined", "ALSO", "BY", "COPY", - "\"==\"", "IN", "LAST", "LEADING", "OF", "OFF", "PRINTING", "REPLACE", - "REPLACING", "SUPPRESS", "TRAILING", "\".\"", "\"word\"", - "LISTING_DIRECTIVE", "LISTING_STATEMENT", "TITLE_STATEMENT", - "CONTROL_STATEMENT", "SOURCE", "NOSOURCE", "LIST", "NOLIST", "MAP", - "NOMAP", "LEAP_SECOND_DIRECTIVE", "SOURCE_DIRECTIVE", "FORMAT", "IS", - "FIXED", "FREE", "VARIABLE", "CALL_DIRECTIVE", "COBOL", "\"EXTERN\"", - "STDCALL", "STATIC", "DEFINE_DIRECTIVE", "AS", "PARAMETER", "OVERRIDE", - "SET_DIRECTIVE", "ADDRSV", "ADDSYN", "ASSIGN", "CALLFH", "XFD", "COMP1", - "CONSTANT", "FOLDCOPYNAME", "MAKESYN", "NOFOLDCOPYNAME", "REMOVE", - "SOURCEFORMAT", "IF_DIRECTIVE", "ELSE_DIRECTIVE", "ENDIF_DIRECTIVE", - "ELIF_DIRECTIVE", "\">=\"", "\"<=\"", "\"<\"", "\">\"", "\"=\"", - "\"<>\"", "NOT", "THAN", "TO", "OR", "EQUAL", "GREATER", "LESS", "SET", - "DEFINED", "TURN_DIRECTIVE", "ON", "CHECKING", "WITH", "LOCATION", - "\"end of line\"", "\"Identifier or Literal\"", "\"Text-Name\"", - "\"Variable\"", "\"Literal\"", "'('", "')'", "$accept", "statement_list", - "statement", "directive", "$@1", "$@2", "$@3", "set_directive", - "set_choice", "alnum_list", "alnum_equality_list", "alnum_equality", - "set_options", "source_directive", "format_type", "define_directive", - "listing_directive", "listing_statement", "control_options", - "control_option", "_dot", "leap_second_directive", "turn_directive", - "ec_list", "on_or_off", "with_loc", "call_directive", "call_choice", - "if_directive", "variable_or_literal", "object_id", "condition_clause", - "copy_statement", "copy_source", "copy_in", "in_or_of", "copy_suppress", - "copy_replacing", "replace_statement", "replacing_list", "text_src", - "text_dst", "text_partial_src", "text_partial_dst", "token_list", - "identifier", "subscripts", "lead_trail", "_override", "_not", "_also", - "_last", "_as", "_format", "_is", "_printing", "_than", "_to", YY_NULLPTR -}; -#endif - -# ifdef YYPRINT -/* YYTOKNUM[NUM] -- (External) token number corresponding to the - (internal) symbol number NUM (which must be that of a token). */ -static const yytype_uint16 yytoknum[] = -{ - 0, 256, 257, 258, 259, 260, 261, 262, 263, 264, - 265, 266, 267, 268, 269, 270, 271, 272, 273, 274, - 275, 276, 277, 278, 279, 280, 281, 282, 283, 284, - 285, 286, 287, 288, 289, 290, 291, 292, 293, 294, - 295, 296, 297, 298, 299, 300, 301, 302, 303, 304, - 305, 306, 307, 308, 309, 310, 311, 312, 313, 314, - 315, 316, 317, 318, 319, 320, 321, 322, 323, 324, - 325, 326, 327, 328, 329, 330, 331, 332, 333, 334, - 335, 336, 337, 338, 339, 340, 341, 40, 41 -}; -# endif - -#define YYPACT_NINF -120 - -#define yypact_value_is_default(Yystate) \ - (!!((Yystate) == (-120))) - -#define YYTABLE_NINF -154 - -#define yytable_value_is_error(Yytable_value) \ - 0 - - /* YYPACT[STATE-NUM] -- Index in YYTABLE of the portion describing - STATE-NUM. */ -static const yytype_int16 yypact[] = -{ - -120, 3, -120, 1, 35, 19, -120, -68, 126, 20, - 14, -120, -18, 70, -120, -120, -120, -120, -35, -120, - -16, -120, 52, 59, -120, -120, 42, -120, -120, -2, - 75, -120, -120, -120, 88, -120, -120, -120, -120, -120, - -120, 120, -120, -120, -120, -120, -120, -120, 76, 16, - 30, -25, -120, -120, -120, 50, 72, 50, 73, 74, - 77, 78, 80, 119, 50, -120, 72, 119, -14, 70, - -120, -7, -7, -120, -120, -50, -120, -120, -120, -120, - -120, 147, 1, 83, -120, -120, -120, -2, 163, -5, - 162, -120, -120, 87, -120, 89, -120, 40, -120, -120, - -120, -120, 16, -120, 119, -120, 8, 104, 50, -120, - -120, 86, -120, -120, -120, -120, -120, 90, 91, -120, - 86, 92, -120, 93, -120, -23, -17, -120, -120, -120, - 15, -120, 161, 160, -120, -120, 0, 171, 162, 4, - 97, 98, 99, 100, 180, -120, -120, -120, -120, -120, - -120, -120, -120, 101, -120, 141, 141, 102, -120, -120, - -120, -120, -120, -120, 118, 118, -120, 11, 108, -120, - -120, -120, -120, -120, -2, -120, -120, -120, 4, 186, - 5, -120, -5, -120, -120, -120, -41, 185, 187, 141, - -120, -120, -120, -120, -120, 66, 37, -120, -120, -2, - -120, 187, -120, 6, -120, -120, -120, 7, -120, -120, - -120, -120, -120, -120, -120, -120, 122, 125, 125, -120, - -120, 21, 21, -120, -120, -120, 189, -120, -120, -120, - 127, 128, -120, -120, -120, -120, -120, 124, 129, 122, - 122, -120, -120 -}; - - /* YYDEFACT[STATE-NUM] -- Default reduction number in state STATE-NUM. - Performed when YYTABLE does not specify something else to do. Zero - means the default is an error. */ -static const yytype_uint8 yydefact[] = -{ - 2, 0, 1, 0, 149, 57, 60, 0, 0, 72, - 155, 21, 0, 0, 15, 19, 20, 17, 0, 3, - 0, 7, 0, 0, 111, 112, 113, 150, 152, 0, - 0, 59, 58, 13, 70, 64, 65, 66, 67, 68, - 69, 70, 62, 74, 73, 14, 156, 9, 157, 0, - 0, 153, 96, 10, 56, 0, 0, 0, 0, 31, - 0, 0, 0, 153, 0, 36, 0, 153, 45, 11, - 23, 0, 0, 76, 12, 0, 6, 4, 5, 115, - 116, 117, 0, 0, 143, 144, 137, 121, 0, 128, - 0, 122, 71, 0, 63, 0, 158, 0, 86, 87, - 88, 89, 22, 84, 153, 154, 0, 0, 37, 42, - 40, 27, 28, 29, 30, 32, 33, 0, 0, 35, - 38, 0, 26, 0, 24, 157, 157, 16, 94, 18, - 78, 77, 159, 119, 114, 135, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 61, 8, 51, 48, 49, - 50, 47, 85, 0, 54, 145, 145, 0, 43, 41, - 25, 34, 39, 46, 147, 147, 79, 0, 0, 83, - 75, 81, 160, 118, 0, 110, 127, 136, 0, 0, - 0, 123, 131, 138, 139, 141, 0, 0, 0, 145, - 146, 53, 52, 44, 148, 0, 0, 80, 82, 120, - 125, 0, 129, 0, 142, 140, 132, 0, 124, 55, - 104, 106, 107, 105, 108, 109, 163, 161, 161, 91, - 90, 0, 0, 126, 130, 133, 0, 164, 103, 162, - 100, 102, 98, 97, 92, 93, 134, 0, 0, 163, - 163, 99, 101 -}; - - /* YYPGOTO[NTERM-NUM]. */ -static const yytype_int16 yypgoto[] = -{ - -120, -120, -120, -120, -120, -120, -120, -120, 131, 136, - -120, -37, -120, -120, -120, -120, -120, -120, -120, 156, - 164, -120, -120, -120, -120, 36, -120, 105, 132, 194, - -13, 12, -120, 130, -120, -120, -120, -120, -120, 39, - -87, 32, 79, 10, 34, -118, -120, -86, -119, 51, - -120, -120, -27, -120, 9, -120, -3, -83 -}; - - /* YYDEFGOTO[NTERM-NUM]. */ -static const yytype_int16 yydefgoto[] = -{ - -1, 1, 19, 20, 71, 72, 49, 69, 70, 111, - 108, 109, 122, 47, 151, 53, 33, 21, 41, 42, - 93, 45, 74, 75, 170, 171, 102, 103, 127, 128, - 234, 221, 22, 26, 81, 82, 133, 175, 23, 87, - 88, 181, 144, 208, 136, 89, 186, 90, 191, 195, - 29, 30, 106, 48, 97, 173, 230, 228 -}; - - /* YYTABLE[YYPACT[STATE-NUM]] -- What to do in state STATE-NUM. If - positive, shift that token. If negative, reduce the rule whose - number is the opposite. If YYTABLE_NINF, syntax error. */ -static const yytype_int16 yytable[] = -{ - 137, 138, 140, 2, 83, 141, 176, 84, 3, 96, - 180, 202, 224, 225, 85, 96, 4, 105, 34, 154, - 112, 182, 5, 6, 7, 8, 166, 119, 105, 130, - 31, 43, 9, 10, 50, 131, 118, 192, 27, 11, - 121, 123, 204, 28, 12, 46, -151, 205, 13, 79, - 73, 155, 80, 98, 99, 100, 101, -95, 147, -95, - 182, 14, 15, 16, 17, -96, 76, 51, 52, 77, - 209, 158, -153, 148, 149, 150, 78, 153, 125, 126, - 18, 86, 142, 177, 24, 25, 91, 86, 135, 177, - 226, 168, 169, 167, 156, 168, 169, 32, 44, 210, - 211, 212, 213, 214, 215, 92, 232, 233, 96, 216, - 217, 218, 137, 138, 55, 104, 56, 57, 58, 59, - 60, 61, 62, 63, 64, 65, 66, 67, 210, 211, - 212, 213, 214, 215, 164, 165, 107, 92, 216, 217, - 218, 219, 220, 35, 36, 37, 38, 39, 40, 35, - 36, 37, 38, 39, 40, 68, 241, 242, 110, 113, - 114, 105, 132, 115, 116, 117, 135, 139, 143, 145, - 157, 146, 159, 172, 174, 178, 160, 161, 162, 163, - 183, 184, 185, 187, 188, 190, 194, 189, 193, 198, - 201, 206, 227, 207, 229, 236, 239, 94, 237, 238, - 124, 240, 120, 197, 129, 95, 54, 152, 222, 235, - 200, 223, 134, 199, 203, 231, 196, 179 -}; - -static const yytype_uint8 yycheck[] = -{ - 87, 87, 7, 0, 6, 10, 6, 9, 5, 32, - 6, 6, 6, 6, 16, 32, 13, 42, 86, 11, - 57, 139, 19, 20, 21, 22, 11, 64, 42, 79, - 11, 11, 29, 30, 52, 85, 63, 156, 3, 36, - 67, 68, 83, 8, 41, 31, 11, 88, 45, 7, - 85, 43, 10, 37, 38, 39, 40, 82, 18, 82, - 178, 58, 59, 60, 61, 82, 82, 85, 86, 17, - 189, 108, 86, 33, 34, 35, 17, 104, 85, 86, - 77, 83, 87, 83, 83, 84, 11, 83, 83, 83, - 83, 80, 81, 78, 86, 80, 81, 78, 78, 62, - 63, 64, 65, 66, 67, 17, 85, 86, 32, 72, - 73, 74, 199, 199, 44, 85, 46, 47, 48, 49, - 50, 51, 52, 53, 54, 55, 56, 57, 62, 63, - 64, 65, 66, 67, 125, 126, 86, 17, 72, 73, - 74, 75, 76, 23, 24, 25, 26, 27, 28, 23, - 24, 25, 26, 27, 28, 85, 239, 240, 86, 86, - 86, 42, 15, 86, 86, 85, 83, 4, 6, 82, - 66, 82, 86, 12, 14, 4, 86, 86, 86, 86, - 83, 83, 83, 83, 4, 44, 68, 86, 86, 81, - 4, 6, 70, 6, 69, 6, 72, 41, 71, 71, - 69, 72, 66, 167, 72, 41, 12, 102, 196, 222, - 178, 201, 82, 174, 180, 218, 165, 138 -}; - - /* YYSTOS[STATE-NUM] -- The (internal number of the) accessing - symbol of state STATE-NUM. */ -static const yytype_uint8 yystos[] = -{ - 0, 90, 0, 5, 13, 19, 20, 21, 22, 29, - 30, 36, 41, 45, 58, 59, 60, 61, 77, 91, - 92, 106, 121, 127, 83, 84, 122, 3, 8, 139, - 140, 11, 78, 105, 86, 23, 24, 25, 26, 27, - 28, 107, 108, 11, 78, 110, 31, 102, 142, 95, - 52, 85, 86, 104, 118, 44, 46, 47, 48, 49, - 50, 51, 52, 53, 54, 55, 56, 57, 85, 96, - 97, 93, 94, 85, 111, 112, 82, 17, 17, 7, - 10, 123, 124, 6, 9, 16, 83, 128, 129, 134, - 136, 11, 17, 109, 108, 109, 32, 143, 37, 38, - 39, 40, 115, 116, 85, 42, 141, 86, 99, 100, - 86, 98, 100, 86, 86, 86, 86, 85, 141, 100, - 98, 141, 101, 141, 97, 85, 86, 117, 118, 117, - 79, 85, 15, 125, 122, 83, 133, 129, 136, 4, - 7, 10, 87, 6, 131, 82, 82, 18, 33, 34, - 35, 103, 116, 141, 11, 43, 86, 66, 100, 86, - 86, 86, 86, 86, 143, 143, 11, 78, 80, 81, - 113, 114, 12, 144, 14, 126, 6, 83, 4, 131, - 6, 130, 134, 83, 83, 83, 135, 83, 4, 86, - 44, 137, 137, 86, 68, 138, 138, 114, 81, 128, - 130, 4, 6, 133, 83, 88, 6, 6, 132, 137, - 62, 63, 64, 65, 66, 67, 72, 73, 74, 75, - 76, 120, 120, 132, 6, 6, 83, 70, 146, 69, - 145, 145, 85, 86, 119, 119, 6, 71, 71, 72, - 72, 146, 146 -}; - - /* YYR1[YYN] -- Symbol number of symbol that rule YYN derives. */ -static const yytype_uint8 yyr1[] = -{ - 0, 89, 90, 90, 91, 91, 91, 91, 91, 92, - 92, 92, 92, 92, 92, 93, 92, 94, 92, 92, - 92, 95, 92, 96, 96, 97, 97, 97, 97, 97, - 97, 97, 97, 97, 97, 97, 97, 97, 97, 97, - 98, 98, 99, 99, 100, 101, 101, 102, 103, 103, - 103, 103, 104, 104, 104, 104, 104, 105, 105, 105, - 106, 106, 107, 107, 108, 108, 108, 108, 108, 108, - 109, 109, 110, 110, 110, 111, 112, 112, 113, 113, - 113, 113, 114, 114, 115, 115, 116, 116, 116, 116, - 117, 117, 117, 117, 117, 118, 118, 119, 119, 120, - 120, 120, 120, 120, 120, 120, 120, 120, 120, 120, - 121, 122, 122, 123, 123, 124, 124, 125, 125, 126, - 126, 127, 127, 128, 128, 128, 128, 129, 129, 130, - 130, 130, 131, 132, 132, 133, 133, 134, 134, 134, - 134, 135, 135, 136, 136, 137, 137, 138, 138, 139, - 139, 140, 140, 141, 141, 142, 142, 143, 143, 144, - 144, 145, 145, 146, 146 -}; - - /* YYR2[YYN] -- Number of symbols on the right hand side of rule YYN. */ -static const yytype_uint8 yyr2[] = -{ - 0, 2, 0, 2, 2, 2, 2, 1, 4, 2, - 2, 2, 2, 2, 2, 0, 3, 0, 3, 1, - 1, 0, 3, 1, 2, 3, 2, 2, 2, 2, - 2, 1, 2, 2, 3, 2, 1, 2, 2, 3, - 1, 2, 1, 2, 3, 0, 2, 3, 1, 1, - 1, 1, 4, 4, 3, 5, 1, 0, 1, 1, - 1, 4, 1, 2, 1, 1, 1, 1, 1, 1, - 0, 1, 0, 1, 1, 3, 1, 2, 0, 1, - 2, 1, 2, 1, 1, 2, 1, 1, 1, 1, - 4, 4, 5, 5, 1, 1, 1, 1, 1, 5, - 2, 5, 2, 2, 1, 1, 1, 1, 1, 1, - 5, 1, 1, 0, 2, 1, 1, 0, 2, 0, - 2, 3, 3, 3, 4, 4, 5, 3, 1, 2, - 3, 1, 3, 2, 3, 1, 2, 1, 3, 3, - 4, 1, 2, 1, 1, 0, 1, 0, 1, 0, - 1, 0, 1, 0, 1, 0, 1, 0, 1, 0, - 1, 0, 1, 0, 1 -}; - - -#define yyerrok (yyerrstatus = 0) -#define yyclearin (yychar = YYEMPTY) -#define YYEMPTY (-2) -#define YYEOF 0 - -#define YYACCEPT goto yyacceptlab -#define YYABORT goto yyabortlab -#define YYERROR goto yyerrorlab - - -#define YYRECOVERING() (!!yyerrstatus) - -#define YYBACKUP(Token, Value) \ -do \ - if (yychar == YYEMPTY) \ - { \ - yychar = (Token); \ - yylval = (Value); \ - YYPOPSTACK (yylen); \ - yystate = *yyssp; \ - goto yybackup; \ - } \ - else \ - { \ - yyerror (YY_("syntax error: cannot back up")); \ - YYERROR; \ - } \ -while (0) - -/* Error token number */ -#define YYTERROR 1 -#define YYERRCODE 256 - - - -/* Enable debugging if requested. */ -#if PPDEBUG - -# ifndef YYFPRINTF -# include /* INFRINGES ON USER NAME SPACE */ -# define YYFPRINTF fprintf -# endif - -# define YYDPRINTF(Args) \ -do { \ - if (yydebug) \ - YYFPRINTF Args; \ -} while (0) - -/* This macro is provided for backward compatibility. */ -#ifndef YY_LOCATION_PRINT -# define YY_LOCATION_PRINT(File, Loc) ((void) 0) -#endif - - -# define YY_SYMBOL_PRINT(Title, Type, Value, Location) \ -do { \ - if (yydebug) \ - { \ - YYFPRINTF (stderr, "%s ", Title); \ - yy_symbol_print (stderr, \ - Type, Value); \ - YYFPRINTF (stderr, "\n"); \ - } \ -} while (0) - - -/*----------------------------------------. -| Print this symbol's value on YYOUTPUT. | -`----------------------------------------*/ - -static void -yy_symbol_value_print (FILE *yyoutput, int yytype, YYSTYPE const * const yyvaluep) -{ - FILE *yyo = yyoutput; - YYUSE (yyo); - if (!yyvaluep) - return; -# ifdef YYPRINT - if (yytype < YYNTOKENS) - YYPRINT (yyoutput, yytoknum[yytype], *yyvaluep); -# endif - YYUSE (yytype); -} - - -/*--------------------------------. -| Print this symbol on YYOUTPUT. | -`--------------------------------*/ - -static void -yy_symbol_print (FILE *yyoutput, int yytype, YYSTYPE const * const yyvaluep) -{ - YYFPRINTF (yyoutput, "%s %s (", - yytype < YYNTOKENS ? "token" : "nterm", yytname[yytype]); - - yy_symbol_value_print (yyoutput, yytype, yyvaluep); - YYFPRINTF (yyoutput, ")"); -} - -/*------------------------------------------------------------------. -| yy_stack_print -- Print the state stack from its BOTTOM up to its | -| TOP (included). | -`------------------------------------------------------------------*/ - -static void -yy_stack_print (yytype_int16 *yybottom, yytype_int16 *yytop) -{ - YYFPRINTF (stderr, "Stack now"); - for (; yybottom <= yytop; yybottom++) - { - int yybot = *yybottom; - YYFPRINTF (stderr, " %d", yybot); - } - YYFPRINTF (stderr, "\n"); -} - -# define YY_STACK_PRINT(Bottom, Top) \ -do { \ - if (yydebug) \ - yy_stack_print ((Bottom), (Top)); \ -} while (0) - - -/*------------------------------------------------. -| Report that the YYRULE is going to be reduced. | -`------------------------------------------------*/ - -static void -yy_reduce_print (yytype_int16 *yyssp, YYSTYPE *yyvsp, int yyrule) -{ - unsigned long int yylno = yyrline[yyrule]; - int yynrhs = yyr2[yyrule]; - int yyi; - YYFPRINTF (stderr, "Reducing stack by rule %d (line %lu):\n", - yyrule - 1, yylno); - /* The symbols being reduced. */ - for (yyi = 0; yyi < yynrhs; yyi++) - { - YYFPRINTF (stderr, " $%d = ", yyi + 1); - yy_symbol_print (stderr, - yystos[yyssp[yyi + 1 - yynrhs]], - &(yyvsp[(yyi + 1) - (yynrhs)]) - ); - YYFPRINTF (stderr, "\n"); - } -} - -# define YY_REDUCE_PRINT(Rule) \ -do { \ - if (yydebug) \ - yy_reduce_print (yyssp, yyvsp, Rule); \ -} while (0) - -/* Nonzero means print parse trace. It is left uninitialized so that - multiple parsers can coexist. */ -int yydebug; -#else /* !PPDEBUG */ -# define YYDPRINTF(Args) -# define YY_SYMBOL_PRINT(Title, Type, Value, Location) -# define YY_STACK_PRINT(Bottom, Top) -# define YY_REDUCE_PRINT(Rule) -#endif /* !PPDEBUG */ - - -/* YYINITDEPTH -- initial size of the parser's stacks. */ -#ifndef YYINITDEPTH -# define YYINITDEPTH 200 -#endif - -/* YYMAXDEPTH -- maximum size the stacks can grow to (effective only - if the built-in stack extension method is used). - - Do not make this value too large; the results are undefined if - YYSTACK_ALLOC_MAXIMUM < YYSTACK_BYTES (YYMAXDEPTH) - evaluated with infinite-precision integer arithmetic. */ - -#ifndef YYMAXDEPTH -# define YYMAXDEPTH 10000 -#endif - - -#if YYERROR_VERBOSE - -# ifndef yystrlen -# if defined __GLIBC__ && defined _STRING_H -# define yystrlen strlen -# else -/* Return the length of YYSTR. */ -static YYSIZE_T -yystrlen (const char *yystr) -{ - YYSIZE_T yylen; - for (yylen = 0; yystr[yylen]; yylen++) - continue; - return yylen; -} -# endif -# endif - -# ifndef yystpcpy -# if defined __GLIBC__ && defined _STRING_H && defined _GNU_SOURCE -# define yystpcpy stpcpy -# else -/* Copy YYSRC to YYDEST, returning the address of the terminating '\0' in - YYDEST. */ -static char * -yystpcpy (char *yydest, const char *yysrc) -{ - char *yyd = yydest; - const char *yys = yysrc; - - while ((*yyd++ = *yys++) != '\0') - continue; - - return yyd - 1; -} -# endif -# endif - -# ifndef yytnamerr -/* Copy to YYRES the contents of YYSTR after stripping away unnecessary - quotes and backslashes, so that it's suitable for yyerror. The - heuristic is that double-quoting is unnecessary unless the string - contains an apostrophe, a comma, or backslash (other than - backslash-backslash). YYSTR is taken from yytname. If YYRES is - null, do not copy; instead, return the length of what the result - would have been. */ -static YYSIZE_T -yytnamerr (char *yyres, const char *yystr) -{ - if (*yystr == '"') - { - YYSIZE_T yyn = 0; - char const *yyp = yystr; - - for (;;) - switch (*++yyp) - { - case '\'': - case ',': - goto do_not_strip_quotes; - - case '\\': - if (*++yyp != '\\') - goto do_not_strip_quotes; - /* Fall through. */ - default: - if (yyres) - yyres[yyn] = *yyp; - yyn++; - break; - - case '"': - if (yyres) - yyres[yyn] = '\0'; - return yyn; - } - do_not_strip_quotes: ; - } - - if (! yyres) - return yystrlen (yystr); - - return yystpcpy (yyres, yystr) - yyres; -} -# endif - -/* Copy into *YYMSG, which is of size *YYMSG_ALLOC, an error message - about the unexpected token YYTOKEN for the state stack whose top is - YYSSP. - - Return 0 if *YYMSG was successfully written. Return 1 if *YYMSG is - not large enough to hold the message. In that case, also set - *YYMSG_ALLOC to the required number of bytes. Return 2 if the - required number of bytes is too large to store. */ -static int -yysyntax_error (YYSIZE_T *yymsg_alloc, char **yymsg, - yytype_int16 *yyssp, int yytoken) -{ - YYSIZE_T yysize0 = yytnamerr (YY_NULLPTR, yytname[yytoken]); - YYSIZE_T yysize = yysize0; - enum { YYERROR_VERBOSE_ARGS_MAXIMUM = 5 }; - /* Internationalized format string. */ - const char *yyformat = YY_NULLPTR; - /* Arguments of yyformat. */ - char const *yyarg[YYERROR_VERBOSE_ARGS_MAXIMUM]; - /* Number of reported tokens (one for the "unexpected", one per - "expected"). */ - int yycount = 0; - - /* There are many possibilities here to consider: - - If this state is a consistent state with a default action, then - the only way this function was invoked is if the default action - is an error action. In that case, don't check for expected - tokens because there are none. - - The only way there can be no lookahead present (in yychar) is if - this state is a consistent state with a default action. Thus, - detecting the absence of a lookahead is sufficient to determine - that there is no unexpected or expected token to report. In that - case, just report a simple "syntax error". - - Don't assume there isn't a lookahead just because this state is a - consistent state with a default action. There might have been a - previous inconsistent state, consistent state with a non-default - action, or user semantic action that manipulated yychar. - - Of course, the expected token list depends on states to have - correct lookahead information, and it depends on the parser not - to perform extra reductions after fetching a lookahead from the - scanner and before detecting a syntax error. Thus, state merging - (from LALR or IELR) and default reductions corrupt the expected - token list. However, the list is correct for canonical LR with - one exception: it will still contain any token that will not be - accepted due to an error action in a later state. - */ - if (yytoken != YYEMPTY) - { - int yyn = yypact[*yyssp]; - yyarg[yycount++] = yytname[yytoken]; - if (!yypact_value_is_default (yyn)) - { - /* Start YYX at -YYN if negative to avoid negative indexes in - YYCHECK. In other words, skip the first -YYN actions for - this state because they are default actions. */ - int yyxbegin = yyn < 0 ? -yyn : 0; - /* Stay within bounds of both yycheck and yytname. */ - int yychecklim = YYLAST - yyn + 1; - int yyxend = yychecklim < YYNTOKENS ? yychecklim : YYNTOKENS; - int yyx; - - for (yyx = yyxbegin; yyx < yyxend; ++yyx) - if (yycheck[yyx + yyn] == yyx && yyx != YYTERROR - && !yytable_value_is_error (yytable[yyx + yyn])) - { - if (yycount == YYERROR_VERBOSE_ARGS_MAXIMUM) - { - yycount = 1; - yysize = yysize0; - break; - } - yyarg[yycount++] = yytname[yyx]; - { - YYSIZE_T yysize1 = yysize + yytnamerr (YY_NULLPTR, yytname[yyx]); - if (! (yysize <= yysize1 - && yysize1 <= YYSTACK_ALLOC_MAXIMUM)) - return 2; - yysize = yysize1; - } - } - } - } - - switch (yycount) - { -# define YYCASE_(N, S) \ - case N: \ - yyformat = S; \ - break - YYCASE_(0, YY_("syntax error")); - YYCASE_(1, YY_("syntax error, unexpected %s")); - YYCASE_(2, YY_("syntax error, unexpected %s, expecting %s")); - YYCASE_(3, YY_("syntax error, unexpected %s, expecting %s or %s")); - YYCASE_(4, YY_("syntax error, unexpected %s, expecting %s or %s or %s")); - YYCASE_(5, YY_("syntax error, unexpected %s, expecting %s or %s or %s or %s")); -# undef YYCASE_ - } - - { - YYSIZE_T yysize1 = yysize + yystrlen (yyformat); - if (! (yysize <= yysize1 && yysize1 <= YYSTACK_ALLOC_MAXIMUM)) - return 2; - yysize = yysize1; - } - - if (*yymsg_alloc < yysize) - { - *yymsg_alloc = 2 * yysize; - if (! (yysize <= *yymsg_alloc - && *yymsg_alloc <= YYSTACK_ALLOC_MAXIMUM)) - *yymsg_alloc = YYSTACK_ALLOC_MAXIMUM; - return 1; - } - - /* Avoid sprintf, as that infringes on the user's name space. - Don't have undefined behavior even if the translation - produced a string with the wrong number of "%s"s. */ - { - char *yyp = *yymsg; - int yyi = 0; - while ((*yyp = *yyformat) != '\0') - if (*yyp == '%' && yyformat[1] == 's' && yyi < yycount) - { - yyp += yytnamerr (yyp, yyarg[yyi++]); - yyformat += 2; - } - else - { - yyp++; - yyformat++; - } - } - return 0; -} -#endif /* YYERROR_VERBOSE */ - -/*-----------------------------------------------. -| Release the memory associated to this symbol. | -`-----------------------------------------------*/ - -static void -yydestruct (const char *yymsg, int yytype, YYSTYPE *yyvaluep) -{ - YYUSE (yyvaluep); - if (!yymsg) - yymsg = "Deleting"; - YY_SYMBOL_PRINT (yymsg, yytype, yyvaluep, yylocationp); - - YY_IGNORE_MAYBE_UNINITIALIZED_BEGIN - YYUSE (yytype); - YY_IGNORE_MAYBE_UNINITIALIZED_END -} - - - - -/* The lookahead symbol. */ -int yychar; - -/* The semantic value of the lookahead symbol. */ -YYSTYPE yylval; -/* Number of syntax errors so far. */ -int yynerrs; - - -/*----------. -| yyparse. | -`----------*/ - -int -yyparse (void) -{ - int yystate; - /* Number of tokens to shift before error messages enabled. */ - int yyerrstatus; - - /* The stacks and their tools: - 'yyss': related to states. - 'yyvs': related to semantic values. - - Refer to the stacks through separate pointers, to allow yyoverflow - to reallocate them elsewhere. */ - - /* The state stack. */ - yytype_int16 yyssa[YYINITDEPTH]; - yytype_int16 *yyss; - yytype_int16 *yyssp; - - /* The semantic value stack. */ - YYSTYPE yyvsa[YYINITDEPTH]; - YYSTYPE *yyvs; - YYSTYPE *yyvsp; - - YYSIZE_T yystacksize; - - int yyn; - int yyresult; - /* Lookahead token as an internal (translated) token number. */ - int yytoken = 0; - /* The variables used to return semantic value and location from the - action routines. */ - YYSTYPE yyval; - -#if YYERROR_VERBOSE - /* Buffer for error messages, and its allocated size. */ - char yymsgbuf[128]; - char *yymsg = yymsgbuf; - YYSIZE_T yymsg_alloc = sizeof yymsgbuf; -#endif - -#define YYPOPSTACK(N) (yyvsp -= (N), yyssp -= (N)) - - /* The number of symbols on the RHS of the reduced rule. - Keep to zero when no symbol should be popped. */ - int yylen = 0; - - yyssp = yyss = yyssa; - yyvsp = yyvs = yyvsa; - yystacksize = YYINITDEPTH; - - YYDPRINTF ((stderr, "Starting parse\n")); - - yystate = 0; - yyerrstatus = 0; - yynerrs = 0; - yychar = YYEMPTY; /* Cause a token to be read. */ - goto yysetstate; - -/*------------------------------------------------------------. -| yynewstate -- Push a new state, which is found in yystate. | -`------------------------------------------------------------*/ - yynewstate: - /* In all cases, when you get here, the value and location stacks - have just been pushed. So pushing a state here evens the stacks. */ - yyssp++; - - yysetstate: - *yyssp = yystate; - - if (yyss + yystacksize - 1 <= yyssp) - { - /* Get the current used size of the three stacks, in elements. */ - YYSIZE_T yysize = yyssp - yyss + 1; - -#ifdef yyoverflow - { - /* Give user a chance to reallocate the stack. Use copies of - these so that the &'s don't force the real ones into - memory. */ - YYSTYPE *yyvs1 = yyvs; - yytype_int16 *yyss1 = yyss; - - /* Each stack pointer address is followed by the size of the - data in use in that stack, in bytes. This used to be a - conditional around just the two extra args, but that might - be undefined if yyoverflow is a macro. */ - yyoverflow (YY_("memory exhausted"), - &yyss1, yysize * sizeof (*yyssp), - &yyvs1, yysize * sizeof (*yyvsp), - &yystacksize); - - yyss = yyss1; - yyvs = yyvs1; - } -#else /* no yyoverflow */ -# ifndef YYSTACK_RELOCATE - goto yyexhaustedlab; -# else - /* Extend the stack our own way. */ - if (YYMAXDEPTH <= yystacksize) - goto yyexhaustedlab; - yystacksize *= 2; - if (YYMAXDEPTH < yystacksize) - yystacksize = YYMAXDEPTH; - - { - yytype_int16 *yyss1 = yyss; - union yyalloc *yyptr = - (union yyalloc *) YYSTACK_ALLOC (YYSTACK_BYTES (yystacksize)); - if (! yyptr) - goto yyexhaustedlab; - YYSTACK_RELOCATE (yyss_alloc, yyss); - YYSTACK_RELOCATE (yyvs_alloc, yyvs); -# undef YYSTACK_RELOCATE - if (yyss1 != yyssa) - YYSTACK_FREE (yyss1); - } -# endif -#endif /* no yyoverflow */ - - yyssp = yyss + yysize - 1; - yyvsp = yyvs + yysize - 1; - - YYDPRINTF ((stderr, "Stack size increased to %lu\n", - (unsigned long int) yystacksize)); - - if (yyss + yystacksize - 1 <= yyssp) - YYABORT; - } - - YYDPRINTF ((stderr, "Entering state %d\n", yystate)); - - if (yystate == YYFINAL) - YYACCEPT; - - goto yybackup; - -/*-----------. -| yybackup. | -`-----------*/ -yybackup: - - /* Do appropriate processing given the current state. Read a - lookahead token if we need one and don't already have one. */ - - /* First try to decide what to do without reference to lookahead token. */ - yyn = yypact[yystate]; - if (yypact_value_is_default (yyn)) - goto yydefault; - - /* Not known => get a lookahead token if don't already have one. */ - - /* YYCHAR is either YYEMPTY or YYEOF or a valid lookahead symbol. */ - if (yychar == YYEMPTY) - { - YYDPRINTF ((stderr, "Reading a token: ")); - yychar = yylex (); - } - - if (yychar <= YYEOF) - { - yychar = yytoken = YYEOF; - YYDPRINTF ((stderr, "Now at end of input.\n")); - } - else - { - yytoken = YYTRANSLATE (yychar); - YY_SYMBOL_PRINT ("Next token is", yytoken, &yylval, &yylloc); - } - - /* If the proper action on seeing token YYTOKEN is to reduce or to - detect an error, take that action. */ - yyn += yytoken; - if (yyn < 0 || YYLAST < yyn || yycheck[yyn] != yytoken) - goto yydefault; - yyn = yytable[yyn]; - if (yyn <= 0) - { - if (yytable_value_is_error (yyn)) - goto yyerrlab; - yyn = -yyn; - goto yyreduce; - } - - /* Count tokens shifted since error; after three, turn off error - status. */ - if (yyerrstatus) - yyerrstatus--; - - /* Shift the lookahead token. */ - YY_SYMBOL_PRINT ("Shifting", yytoken, &yylval, &yylloc); - - /* Discard the shifted token. */ - yychar = YYEMPTY; - - yystate = yyn; - YY_IGNORE_MAYBE_UNINITIALIZED_BEGIN - *++yyvsp = yylval; - YY_IGNORE_MAYBE_UNINITIALIZED_END - - goto yynewstate; - - -/*-----------------------------------------------------------. -| yydefault -- do the default action for the current state. | -`-----------------------------------------------------------*/ -yydefault: - yyn = yydefact[yystate]; - if (yyn == 0) - goto yyerrlab; - goto yyreduce; - - -/*-----------------------------. -| yyreduce -- Do a reduction. | -`-----------------------------*/ -yyreduce: - /* yyn is the number of a rule to reduce with. */ - yylen = yyr2[yyn]; - - /* If YYLEN is nonzero, implement the default value of the action: - '$$ = $1'. - - Otherwise, the following line sets YYVAL to garbage. - This behavior is undocumented and Bison - users should not rely upon it. Assigning to YYVAL - unconditionally makes the parser a bit smaller, and it avoids a - GCC warning that YYVAL may be used uninitialized. */ - yyval = yyvsp[1-yylen]; - - - YY_REDUCE_PRINT (yyn); - switch (yyn) - { - case 8: -#line 666 "ppparse.y" /* yacc.c:1646 */ - { - CB_PENDING (_("*CONTROL statement")); - } -#line 2094 "ppparse.c" /* yacc.c:1646 */ - break; - - case 15: -#line 679 "ppparse.y" /* yacc.c:1646 */ - { - current_cmd = PLEX_ACT_IF; - } -#line 2102 "ppparse.c" /* yacc.c:1646 */ - break; - - case 17: -#line 684 "ppparse.y" /* yacc.c:1646 */ - { - current_cmd = PLEX_ACT_ELIF; - } -#line 2110 "ppparse.c" /* yacc.c:1646 */ - break; - - case 19: -#line 689 "ppparse.y" /* yacc.c:1646 */ - { - plex_action_directive (PLEX_ACT_ELSE, 0); - } -#line 2118 "ppparse.c" /* yacc.c:1646 */ - break; - - case 20: -#line 693 "ppparse.y" /* yacc.c:1646 */ - { - plex_action_directive (PLEX_ACT_END, 0); - } -#line 2126 "ppparse.c" /* yacc.c:1646 */ - break; - - case 21: -#line 697 "ppparse.y" /* yacc.c:1646 */ - { - current_call_convention = 0; - } -#line 2134 "ppparse.c" /* yacc.c:1646 */ - break; - - case 22: -#line 701 "ppparse.y" /* yacc.c:1646 */ - { - if (current_call_convention == CB_CONV_STATIC_LINK) { - current_call_convention |= CB_CONV_COBOL; - }; - } -#line 2144 "ppparse.c" /* yacc.c:1646 */ - break; - - case 25: -#line 715 "ppparse.y" /* yacc.c:1646 */ - { - /* note: the old version was _as LITERAL but MF doesn't support this */ - struct cb_define_struct *p; - - p = ppp_define_add (ppp_setvar_list, (yyvsp[-1].s), (yyvsp[0].s), 1); - if (p) { - ppp_setvar_list = p; - fprintf (ppout, "#DEFLIT %s %s\n", (yyvsp[-1].s), (yyvsp[0].s)); - } - } -#line 2159 "ppparse.c" /* yacc.c:1646 */ - break; - - case 27: -#line 727 "ppparse.y" /* yacc.c:1646 */ - { - struct cb_text_list *l; - - for (l = (yyvsp[0].l); l; l = l->next) { - fprintf (ppout, "#ADDRSV %s\n", l->text); - } - } -#line 2171 "ppparse.c" /* yacc.c:1646 */ - break; - - case 28: -#line 735 "ppparse.y" /* yacc.c:1646 */ - { - struct cb_text_list *l; - - for (l = (yyvsp[0].l); l; l = l->next->next) { - fprintf (ppout, "#ADDSYN %s %s\n", l->text, l->next->text); - } - } -#line 2183 "ppparse.c" /* yacc.c:1646 */ - break; - - case 29: -#line 743 "ppparse.y" /* yacc.c:1646 */ - { - char *p = (yyvsp[0].s); - size_t size; - - /* Remove surrounding quotes/brackets */ - ++p; - size = strlen (p) - 1; - p[size] = '\0'; - - if (!strcasecmp (p, "EXTERNAL")) { - fprintf (ppout, "#ASSIGN %d\n", (int)CB_ASSIGN_EXT_FILE_NAME_REQUIRED); - } else if (!strcasecmp (p, "DYNAMIC")) { - fprintf (ppout, "#ASSIGN %d\n", (int)CB_ASSIGN_VARIABLE_DEFAULT); - } else { - ppp_error_invalid_option ("ASSIGN", p); - } - } -#line 2205 "ppparse.c" /* yacc.c:1646 */ - break; - - case 30: -#line 761 "ppparse.y" /* yacc.c:1646 */ - { - char *p = (yyvsp[0].s); - /* Remove surrounding quotes/brackets */ - size_t size; - ++p; - size = strlen (p) - 1; - p[size] = '\0'; - fprintf (ppout, "#CALLFH \"%s\"\n", p); - } -#line 2219 "ppparse.c" /* yacc.c:1646 */ - break; - - case 31: -#line 771 "ppparse.y" /* yacc.c:1646 */ - { - fprintf (ppout, "#CALLFH \"EXTFH\"\n"); - } -#line 2227 "ppparse.c" /* yacc.c:1646 */ - break; - - case 32: -#line 775 "ppparse.y" /* yacc.c:1646 */ - { - char *p = (yyvsp[0].s); - ++p; - p[strlen (p) - 1] = '\0'; - fprintf (ppout, "#XFD \"%s\"\n", p); - } -#line 2238 "ppparse.c" /* yacc.c:1646 */ - break; - - case 33: -#line 782 "ppparse.y" /* yacc.c:1646 */ - { - char *p = (yyvsp[0].s); - size_t size; - - /* Remove surrounding quotes/brackets */ - ++p; - size = strlen (p) - 1; - p[size] = '\0'; - - if (!strcasecmp (p, "BINARY")) { - cb_binary_comp_1 = 1; - } else if (!strcasecmp (p, "FLOAT")) { - cb_binary_comp_1 = 0; - } else { - ppp_error_invalid_option ("COMP1", p); - } - } -#line 2260 "ppparse.c" /* yacc.c:1646 */ - break; - - case 34: -#line 800 "ppparse.y" /* yacc.c:1646 */ - { - char *p = (yyvsp[0].s); - size_t size; - - /* Remove surrounding quotes/brackets */ - ++p; - size = strlen (p) - 1; - p[size] = '\0'; - - if (!strcasecmp (p, "UPPER")) { - cb_fold_copy = COB_FOLD_UPPER; - } else if (!strcasecmp (p, "LOWER")) { - cb_fold_copy = COB_FOLD_LOWER; - } else { - ppp_error_invalid_option ("FOLD-COPY-NAME", p); - } - } -#line 2282 "ppparse.c" /* yacc.c:1646 */ - break; - - case 35: -#line 818 "ppparse.y" /* yacc.c:1646 */ - { - fprintf (ppout, "#MAKESYN %s %s\n", (yyvsp[0].l)->text, (yyvsp[0].l)->next->text); - } -#line 2290 "ppparse.c" /* yacc.c:1646 */ - break; - - case 36: -#line 822 "ppparse.y" /* yacc.c:1646 */ - { - cb_fold_copy = 0; - } -#line 2298 "ppparse.c" /* yacc.c:1646 */ - break; - - case 37: -#line 826 "ppparse.y" /* yacc.c:1646 */ - { - struct cb_text_list *l; - - for (l = (yyvsp[0].l); l; l = l->next->next) { - fprintf (ppout, "#OVERRIDE %s %s\n", l->text, l->next->text); - } - } -#line 2310 "ppparse.c" /* yacc.c:1646 */ - break; - - case 38: -#line 834 "ppparse.y" /* yacc.c:1646 */ - { - struct cb_text_list *l; - - for (l = (yyvsp[0].l); l; l = l->next) { - fprintf (ppout, "#REMOVE %s\n", l->text); - } - } -#line 2322 "ppparse.c" /* yacc.c:1646 */ - break; - - case 39: -#line 842 "ppparse.y" /* yacc.c:1646 */ - { - char *p = (yyvsp[0].s); - size_t size; - - /* Remove surrounding quotes/brackets */ - ++p; - size = strlen (p) - 1; - p[size] = '\0'; - - if (!strcasecmp (p, "FIXED")) { - cb_source_format = CB_FORMAT_FIXED; - cb_text_column = cb_config_text_column; - } else if (!strcasecmp (p, "FREE")) { - cb_source_format = CB_FORMAT_FREE; - } else if (!strcasecmp (p, "VARIABLE")) { - cb_source_format = CB_FORMAT_FIXED; - /* This value matches most MF Visual COBOL 4.0 version. */ - cb_text_column = 250; - } else { - ppp_error_invalid_option ("SOURCEFORMAT", p); - } - if (cb_src_list_file) { - cb_current_file->source_format = cb_source_format; - } - } -#line 2352 "ppparse.c" /* yacc.c:1646 */ - break; - - case 40: -#line 871 "ppparse.y" /* yacc.c:1646 */ - { - (yyval.l) = ppp_list_add (NULL, (yyvsp[0].s)); - } -#line 2360 "ppparse.c" /* yacc.c:1646 */ - break; - - case 41: -#line 875 "ppparse.y" /* yacc.c:1646 */ - { - (yyval.l) = ppp_list_add ((yyvsp[-1].l), (yyvsp[0].s)); - } -#line 2368 "ppparse.c" /* yacc.c:1646 */ - break; - - case 43: -#line 883 "ppparse.y" /* yacc.c:1646 */ - { - (yyval.l) = ppp_list_append ((yyvsp[-1].l), (yyvsp[0].l)); - } -#line 2376 "ppparse.c" /* yacc.c:1646 */ - break; - - case 44: -#line 890 "ppparse.y" /* yacc.c:1646 */ - { - (yyval.l) = ppp_list_add (NULL, (yyvsp[-2].s)); - (yyval.l) = ppp_list_add ((yyval.l), (yyvsp[0].s)); - } -#line 2385 "ppparse.c" /* yacc.c:1646 */ - break; - - case 45: -#line 898 "ppparse.y" /* yacc.c:1646 */ - { - fprintf (ppout, "#OPTION %s\n", (yyvsp[0].s)); - } -#line 2393 "ppparse.c" /* yacc.c:1646 */ - break; - - case 46: -#line 902 "ppparse.y" /* yacc.c:1646 */ - { - fprintf (ppout, "#OPTION %s %s\n", (yyvsp[-2].s), (yyvsp[0].s)); - } -#line 2401 "ppparse.c" /* yacc.c:1646 */ - break; - - case 47: -#line 909 "ppparse.y" /* yacc.c:1646 */ - { - if (cb_src_list_file) { - cb_current_file->source_format = cb_source_format; - } - } -#line 2411 "ppparse.c" /* yacc.c:1646 */ - break; - - case 48: -#line 918 "ppparse.y" /* yacc.c:1646 */ - { - cb_source_format = CB_FORMAT_FIXED; - cb_text_column = cb_config_text_column; - } -#line 2420 "ppparse.c" /* yacc.c:1646 */ - break; - - case 49: -#line 923 "ppparse.y" /* yacc.c:1646 */ - { - cb_source_format = CB_FORMAT_FREE; - } -#line 2428 "ppparse.c" /* yacc.c:1646 */ - break; - - case 50: -#line 927 "ppparse.y" /* yacc.c:1646 */ - { - cb_source_format = CB_FORMAT_FIXED; - cb_text_column = 500; - } -#line 2437 "ppparse.c" /* yacc.c:1646 */ - break; - - case 51: -#line 932 "ppparse.y" /* yacc.c:1646 */ - { - cb_error (_("invalid %s directive"), "SOURCE"); - YYERROR; - } -#line 2446 "ppparse.c" /* yacc.c:1646 */ - break; - - case 52: -#line 940 "ppparse.y" /* yacc.c:1646 */ - { - struct cb_define_struct *p; - - p = ppp_define_add (ppp_setvar_list, (yyvsp[-3].s), (yyvsp[-1].s), (yyvsp[0].ui)); - if (p) { - ppp_setvar_list = p; - } - } -#line 2459 "ppparse.c" /* yacc.c:1646 */ - break; - - case 53: -#line 949 "ppparse.y" /* yacc.c:1646 */ - { - char *s; - char *q; - struct cb_define_struct *p; - size_t size; - - s = getenv ((yyvsp[-3].s)); - q = NULL; - if (s && *s && *s != ' ') { - if (*s == '"' || *s == '\'') { - size = strlen (s) - 1U; - /* Ignore if improperly quoted */ - if (s[0] == s[size]) { - q = s; - } - } else { - if (ppp_check_needs_quote (s)) { - /* Alphanumeric literal */ - q = cobc_plex_malloc (strlen (s) + 4U); - sprintf (q, "'%s'", s); - } else { - /* Numeric literal */ - q = s; - } - } - } - if (q) { - p = ppp_define_add (ppp_setvar_list, (yyvsp[-3].s), q, (yyvsp[0].ui)); - if (p) { - ppp_setvar_list = p; - } - } - } -#line 2497 "ppparse.c" /* yacc.c:1646 */ - break; - - case 54: -#line 983 "ppparse.y" /* yacc.c:1646 */ - { - ppp_define_del ((yyvsp[-2].s)); - } -#line 2505 "ppparse.c" /* yacc.c:1646 */ - break; - - case 55: -#line 987 "ppparse.y" /* yacc.c:1646 */ - { - /* OpenCOBOL/GnuCOBOL 2.0 extension: MF $SET CONSTANT in 2002+ style as - >> DEFINE CONSTANT var [AS] literal archaic extension: - use plain >> DEFINE var [AS] literal for conditional compilation and - use 01 CONSTANT with/without FROM clause for constant definitions */ - struct cb_define_struct *p; - - if (cb_verify (cb_define_constant_directive, ">> DEFINE CONSTANT var")) { - p = ppp_define_add (ppp_setvar_list, (yyvsp[-3].s), (yyvsp[-1].s), (yyvsp[0].ui)); - if (p) { - ppp_setvar_list = p; - fprintf (ppout, "#DEFLIT %s %s%s\n", (yyvsp[-3].s), (yyvsp[-1].s), (yyvsp[0].ui) ? " OVERRIDE" : ""); - } - } - } -#line 2525 "ppparse.c" /* yacc.c:1646 */ - break; - - case 56: -#line 1003 "ppparse.y" /* yacc.c:1646 */ - { - cb_error (_("invalid %s directive"), "DEFINE/SET"); - } -#line 2533 "ppparse.c" /* yacc.c:1646 */ - break; - - case 73: -#line 1042 "ppparse.y" /* yacc.c:1646 */ - { - CB_PENDING (_("LEAP-SECOND ON directive")); - } -#line 2541 "ppparse.c" /* yacc.c:1646 */ - break; - - case 75: -#line 1050 "ppparse.y" /* yacc.c:1646 */ - { - CB_PENDING (_("TURN directive")); - } -#line 2549 "ppparse.c" /* yacc.c:1646 */ - break; - - case 86: -#line 1079 "ppparse.y" /* yacc.c:1646 */ - { - current_call_convention |= CB_CONV_COBOL; - current_call_convention &= ~CB_CONV_STDCALL; - } -#line 2558 "ppparse.c" /* yacc.c:1646 */ - break; - - case 87: -#line 1084 "ppparse.y" /* yacc.c:1646 */ - { - current_call_convention &= ~CB_CONV_STDCALL; - current_call_convention &= ~CB_CONV_COBOL; - } -#line 2567 "ppparse.c" /* yacc.c:1646 */ - break; - - case 88: -#line 1089 "ppparse.y" /* yacc.c:1646 */ - { - current_call_convention |= CB_CONV_STDCALL; - current_call_convention &= ~CB_CONV_COBOL; - } -#line 2576 "ppparse.c" /* yacc.c:1646 */ - break; - - case 89: -#line 1094 "ppparse.y" /* yacc.c:1646 */ - { - current_call_convention |= CB_CONV_STATIC_LINK; - } -#line 2584 "ppparse.c" /* yacc.c:1646 */ - break; - - case 90: -#line 1101 "ppparse.y" /* yacc.c:1646 */ - { - unsigned int found; - - found = (ppp_search_lists ((yyvsp[-3].s)) != NULL); - plex_action_directive (current_cmd, found ^ (yyvsp[-1].ui)); - } -#line 2595 "ppparse.c" /* yacc.c:1646 */ - break; - - case 91: -#line 1108 "ppparse.y" /* yacc.c:1646 */ - { - unsigned int found; - - found = ppp_search_comp_vars ((yyvsp[-3].s)); - plex_action_directive (current_cmd, found ^ (yyvsp[-1].ui)); - } -#line 2606 "ppparse.c" /* yacc.c:1646 */ - break; - - case 92: -#line 1115 "ppparse.y" /* yacc.c:1646 */ - { - struct cb_define_struct *p; - unsigned int found; - - found = 0; - p = ppp_search_lists ((yyvsp[-4].s)); - found = ppp_compare_vals (p, (yyvsp[0].ds), (yyvsp[-1].ui)); - plex_action_directive (current_cmd, found ^ (yyvsp[-2].ui)); - } -#line 2620 "ppparse.c" /* yacc.c:1646 */ - break; - - case 93: -#line 1125 "ppparse.y" /* yacc.c:1646 */ - { - struct cb_define_struct *p; - unsigned int found; - - found = 0; - p = cobc_plex_malloc (sizeof (struct cb_define_struct)); - p->next = NULL; - if (ppp_set_value (p, (yyvsp[-4].s))) { - cb_error (_("invalid constant")); - } else { - found = ppp_compare_vals (p, (yyvsp[0].ds), (yyvsp[-1].ui)); - } - plex_action_directive (current_cmd, found ^ (yyvsp[-2].ui)); - } -#line 2639 "ppparse.c" /* yacc.c:1646 */ - break; - - case 94: -#line 1140 "ppparse.y" /* yacc.c:1646 */ - { - cb_error (_("invalid %s directive"), "IF/ELIF"); - } -#line 2647 "ppparse.c" /* yacc.c:1646 */ - break; - - case 97: -#line 1152 "ppparse.y" /* yacc.c:1646 */ - { - struct cb_define_struct *p; - - p = cobc_plex_malloc (sizeof (struct cb_define_struct)); - p->next = NULL; - if (ppp_set_value (p, (yyvsp[0].s))) { - cb_error (_("invalid constant")); - (yyval.ds) = NULL; - } else { - (yyval.ds) = p; - } - } -#line 2664 "ppparse.c" /* yacc.c:1646 */ - break; - - case 98: -#line 1165 "ppparse.y" /* yacc.c:1646 */ - { - struct cb_define_struct *p; - - p = ppp_search_lists ((yyvsp[0].s)); - if (p != NULL && p->deftype != PLEX_DEF_NONE) { - (yyval.ds) = p; - } else { - (yyval.ds) = NULL; - } - } -#line 2679 "ppparse.c" /* yacc.c:1646 */ - break; - - case 99: -#line 1179 "ppparse.y" /* yacc.c:1646 */ - { - (yyval.ui) = COND_GE; - } -#line 2687 "ppparse.c" /* yacc.c:1646 */ - break; - - case 100: -#line 1183 "ppparse.y" /* yacc.c:1646 */ - { - (yyval.ui) = COND_GT; - } -#line 2695 "ppparse.c" /* yacc.c:1646 */ - break; - - case 101: -#line 1187 "ppparse.y" /* yacc.c:1646 */ - { - (yyval.ui) = COND_LE; - } -#line 2703 "ppparse.c" /* yacc.c:1646 */ - break; - - case 102: -#line 1191 "ppparse.y" /* yacc.c:1646 */ - { - (yyval.ui) = COND_LT; - } -#line 2711 "ppparse.c" /* yacc.c:1646 */ - break; - - case 103: -#line 1195 "ppparse.y" /* yacc.c:1646 */ - { - (yyval.ui) = COND_EQ; - } -#line 2719 "ppparse.c" /* yacc.c:1646 */ - break; - - case 104: -#line 1199 "ppparse.y" /* yacc.c:1646 */ - { - (yyval.ui) = COND_GE; - } -#line 2727 "ppparse.c" /* yacc.c:1646 */ - break; - - case 105: -#line 1203 "ppparse.y" /* yacc.c:1646 */ - { - (yyval.ui) = COND_GT; - } -#line 2735 "ppparse.c" /* yacc.c:1646 */ - break; - - case 106: -#line 1207 "ppparse.y" /* yacc.c:1646 */ - { - (yyval.ui) = COND_LE; - } -#line 2743 "ppparse.c" /* yacc.c:1646 */ - break; - - case 107: -#line 1211 "ppparse.y" /* yacc.c:1646 */ - { - (yyval.ui) = COND_LT; - } -#line 2751 "ppparse.c" /* yacc.c:1646 */ - break; - - case 108: -#line 1215 "ppparse.y" /* yacc.c:1646 */ - { - (yyval.ui) = COND_EQ; - } -#line 2759 "ppparse.c" /* yacc.c:1646 */ - break; - - case 109: -#line 1219 "ppparse.y" /* yacc.c:1646 */ - { - (yyval.ui) = COND_NE; - } -#line 2767 "ppparse.c" /* yacc.c:1646 */ - break; - - case 110: -#line 1226 "ppparse.y" /* yacc.c:1646 */ - { - fputc ('\n', ppout); - ppcopy ((yyvsp[-3].s), (yyvsp[-2].s), (yyvsp[0].r)); - } -#line 2776 "ppparse.c" /* yacc.c:1646 */ - break; - - case 111: -#line 1234 "ppparse.y" /* yacc.c:1646 */ - { - (yyval.s) = fix_filename ((yyvsp[0].s)); - if (cb_fold_copy == COB_FOLD_LOWER) { - (yyval.s) = fold_lower ((yyval.s)); - } else if (cb_fold_copy == COB_FOLD_UPPER) { - (yyval.s) = fold_upper ((yyval.s)); - } - } -#line 2789 "ppparse.c" /* yacc.c:1646 */ - break; - - case 112: -#line 1243 "ppparse.y" /* yacc.c:1646 */ - { - (yyval.s) = (yyvsp[0].s); - if (cb_fold_copy == COB_FOLD_LOWER) { - (yyval.s) = fold_lower ((yyval.s)); - } else { - (yyval.s) = fold_upper ((yyval.s)); - } - } -#line 2802 "ppparse.c" /* yacc.c:1646 */ - break; - - case 113: -#line 1255 "ppparse.y" /* yacc.c:1646 */ - { - (yyval.s) = NULL; - } -#line 2810 "ppparse.c" /* yacc.c:1646 */ - break; - - case 114: -#line 1259 "ppparse.y" /* yacc.c:1646 */ - { - (yyval.s) = (yyvsp[0].s); - } -#line 2818 "ppparse.c" /* yacc.c:1646 */ - break; - - case 119: -#line 1275 "ppparse.y" /* yacc.c:1646 */ - { - (yyval.r) = NULL; - } -#line 2826 "ppparse.c" /* yacc.c:1646 */ - break; - - case 120: -#line 1279 "ppparse.y" /* yacc.c:1646 */ - { - (yyval.r) = (yyvsp[0].r); - } -#line 2834 "ppparse.c" /* yacc.c:1646 */ - break; - - case 121: -#line 1286 "ppparse.y" /* yacc.c:1646 */ - { - pp_set_replace_list ((yyvsp[0].r), (yyvsp[-1].ui)); - } -#line 2842 "ppparse.c" /* yacc.c:1646 */ - break; - - case 122: -#line 1290 "ppparse.y" /* yacc.c:1646 */ - { - pp_set_replace_list (NULL, (yyvsp[-1].ui)); - } -#line 2850 "ppparse.c" /* yacc.c:1646 */ - break; - - case 123: -#line 1297 "ppparse.y" /* yacc.c:1646 */ - { - (yyval.r) = ppp_replace_list_add (NULL, (yyvsp[-2].l), (yyvsp[0].l), 0); - } -#line 2858 "ppparse.c" /* yacc.c:1646 */ - break; - - case 124: -#line 1301 "ppparse.y" /* yacc.c:1646 */ - { - (yyval.r) = ppp_replace_list_add (NULL, (yyvsp[-2].l), (yyvsp[0].l), (yyvsp[-3].ui)); - } -#line 2866 "ppparse.c" /* yacc.c:1646 */ - break; - - case 125: -#line 1305 "ppparse.y" /* yacc.c:1646 */ - { - (yyval.r) = ppp_replace_list_add ((yyvsp[-3].r), (yyvsp[-2].l), (yyvsp[0].l), 0); - } -#line 2874 "ppparse.c" /* yacc.c:1646 */ - break; - - case 126: -#line 1309 "ppparse.y" /* yacc.c:1646 */ - { - (yyval.r) = ppp_replace_list_add ((yyvsp[-4].r), (yyvsp[-2].l), (yyvsp[0].l), (yyvsp[-3].ui)); - } -#line 2882 "ppparse.c" /* yacc.c:1646 */ - break; - - case 127: -#line 1316 "ppparse.y" /* yacc.c:1646 */ - { - (yyval.l) = (yyvsp[-1].l); - } -#line 2890 "ppparse.c" /* yacc.c:1646 */ - break; - - case 128: -#line 1320 "ppparse.y" /* yacc.c:1646 */ - { - (yyval.l) = (yyvsp[0].l); - } -#line 2898 "ppparse.c" /* yacc.c:1646 */ - break; - - case 129: -#line 1327 "ppparse.y" /* yacc.c:1646 */ - { - (yyval.l) = NULL; - } -#line 2906 "ppparse.c" /* yacc.c:1646 */ - break; - - case 130: -#line 1331 "ppparse.y" /* yacc.c:1646 */ - { - (yyval.l) = (yyvsp[-1].l); - } -#line 2914 "ppparse.c" /* yacc.c:1646 */ - break; - - case 131: -#line 1335 "ppparse.y" /* yacc.c:1646 */ - { - (yyval.l) = (yyvsp[0].l); - } -#line 2922 "ppparse.c" /* yacc.c:1646 */ - break; - - case 132: -#line 1342 "ppparse.y" /* yacc.c:1646 */ - { - (yyval.l) = ppp_list_add (NULL, (yyvsp[-1].s)); - } -#line 2930 "ppparse.c" /* yacc.c:1646 */ - break; - - case 133: -#line 1349 "ppparse.y" /* yacc.c:1646 */ - { - (yyval.l) = NULL; - } -#line 2938 "ppparse.c" /* yacc.c:1646 */ - break; - - case 134: -#line 1353 "ppparse.y" /* yacc.c:1646 */ - { - (yyval.l) = ppp_list_add (NULL, (yyvsp[-1].s)); - } -#line 2946 "ppparse.c" /* yacc.c:1646 */ - break; - - case 135: -#line 1360 "ppparse.y" /* yacc.c:1646 */ - { - (yyval.l) = ppp_list_add (NULL, (yyvsp[0].s)); - } -#line 2954 "ppparse.c" /* yacc.c:1646 */ - break; - - case 136: -#line 1364 "ppparse.y" /* yacc.c:1646 */ - { - (yyval.l) = ppp_list_add ((yyvsp[-1].l), (yyvsp[0].s)); - } -#line 2962 "ppparse.c" /* yacc.c:1646 */ - break; - - case 137: -#line 1371 "ppparse.y" /* yacc.c:1646 */ - { - (yyval.l) = ppp_list_add (NULL, (yyvsp[0].s)); - } -#line 2970 "ppparse.c" /* yacc.c:1646 */ - break; - - case 138: -#line 1375 "ppparse.y" /* yacc.c:1646 */ - { - (yyval.l) = ppp_list_add ((yyvsp[-2].l), " "); - (yyval.l) = ppp_list_add ((yyval.l), "IN"); - (yyval.l) = ppp_list_add ((yyval.l), " "); - (yyval.l) = ppp_list_add ((yyval.l), (yyvsp[0].s)); - } -#line 2981 "ppparse.c" /* yacc.c:1646 */ - break; - - case 139: -#line 1382 "ppparse.y" /* yacc.c:1646 */ - { - (yyval.l) = ppp_list_add ((yyvsp[-2].l), " "); - (yyval.l) = ppp_list_add ((yyval.l), "OF"); - (yyval.l) = ppp_list_add ((yyval.l), " "); - (yyval.l) = ppp_list_add ((yyval.l), (yyvsp[0].s)); - } -#line 2992 "ppparse.c" /* yacc.c:1646 */ - break; - - case 140: -#line 1389 "ppparse.y" /* yacc.c:1646 */ - { - struct cb_text_list *l; - - (yyval.l) = ppp_list_add ((yyvsp[-3].l), " "); - (yyval.l) = ppp_list_add ((yyval.l), "("); - (yyvsp[-1].l) = ppp_list_add ((yyvsp[-1].l), ")"); - for (l = (yyval.l); l->next; l = l->next) { - ; - } - l->next = (yyvsp[-1].l); - } -#line 3008 "ppparse.c" /* yacc.c:1646 */ - break; - - case 141: -#line 1404 "ppparse.y" /* yacc.c:1646 */ - { - (yyval.l) = ppp_list_add (NULL, (yyvsp[0].s)); - } -#line 3016 "ppparse.c" /* yacc.c:1646 */ - break; - - case 142: -#line 1408 "ppparse.y" /* yacc.c:1646 */ - { - (yyval.l) = ppp_list_add ((yyvsp[-1].l), " "); - (yyval.l) = ppp_list_add ((yyval.l), (yyvsp[0].s)); - } -#line 3025 "ppparse.c" /* yacc.c:1646 */ - break; - - case 143: -#line 1416 "ppparse.y" /* yacc.c:1646 */ - { - (yyval.ui) = CB_REPLACE_LEADING; - } -#line 3033 "ppparse.c" /* yacc.c:1646 */ - break; - - case 144: -#line 1420 "ppparse.y" /* yacc.c:1646 */ - { - (yyval.ui) = CB_REPLACE_TRAILING; - } -#line 3041 "ppparse.c" /* yacc.c:1646 */ - break; - - case 145: -#line 1429 "ppparse.y" /* yacc.c:1646 */ - { - (yyval.ui) = 0; - } -#line 3049 "ppparse.c" /* yacc.c:1646 */ - break; - - case 146: -#line 1433 "ppparse.y" /* yacc.c:1646 */ - { - (yyval.ui) = 1U; - } -#line 3057 "ppparse.c" /* yacc.c:1646 */ - break; - - case 147: -#line 1440 "ppparse.y" /* yacc.c:1646 */ - { - (yyval.ui) = 0; - } -#line 3065 "ppparse.c" /* yacc.c:1646 */ - break; - - case 148: -#line 1444 "ppparse.y" /* yacc.c:1646 */ - { - (yyval.ui) = 1U; - } -#line 3073 "ppparse.c" /* yacc.c:1646 */ - break; - - case 149: -#line 1451 "ppparse.y" /* yacc.c:1646 */ - { - (yyval.ui) = 0; - } -#line 3081 "ppparse.c" /* yacc.c:1646 */ - break; - - case 150: -#line 1455 "ppparse.y" /* yacc.c:1646 */ - { - (yyval.ui) = 1U; - } -#line 3089 "ppparse.c" /* yacc.c:1646 */ - break; - - case 151: -#line 1462 "ppparse.y" /* yacc.c:1646 */ - { - (yyval.ui) = 0; - } -#line 3097 "ppparse.c" /* yacc.c:1646 */ - break; - - case 152: -#line 1466 "ppparse.y" /* yacc.c:1646 */ - { - (yyval.ui) = 1U; - } -#line 3105 "ppparse.c" /* yacc.c:1646 */ - break; - - -#line 3109 "ppparse.c" /* yacc.c:1646 */ - default: break; - } - /* User semantic actions sometimes alter yychar, and that requires - that yytoken be updated with the new translation. We take the - approach of translating immediately before every use of yytoken. - One alternative is translating here after every semantic action, - but that translation would be missed if the semantic action invokes - YYABORT, YYACCEPT, or YYERROR immediately after altering yychar or - if it invokes YYBACKUP. In the case of YYABORT or YYACCEPT, an - incorrect destructor might then be invoked immediately. In the - case of YYERROR or YYBACKUP, subsequent parser actions might lead - to an incorrect destructor call or verbose syntax error message - before the lookahead is translated. */ - YY_SYMBOL_PRINT ("-> $$ =", yyr1[yyn], &yyval, &yyloc); - - YYPOPSTACK (yylen); - yylen = 0; - YY_STACK_PRINT (yyss, yyssp); - - *++yyvsp = yyval; - - /* Now 'shift' the result of the reduction. Determine what state - that goes to, based on the state we popped back to and the rule - number reduced by. */ - - yyn = yyr1[yyn]; - - yystate = yypgoto[yyn - YYNTOKENS] + *yyssp; - if (0 <= yystate && yystate <= YYLAST && yycheck[yystate] == *yyssp) - yystate = yytable[yystate]; - else - yystate = yydefgoto[yyn - YYNTOKENS]; - - goto yynewstate; - - -/*--------------------------------------. -| yyerrlab -- here on detecting error. | -`--------------------------------------*/ -yyerrlab: - /* Make sure we have latest lookahead translation. See comments at - user semantic actions for why this is necessary. */ - yytoken = yychar == YYEMPTY ? YYEMPTY : YYTRANSLATE (yychar); - - /* If not already recovering from an error, report this error. */ - if (!yyerrstatus) - { - ++yynerrs; -#if ! YYERROR_VERBOSE - yyerror (YY_("syntax error")); -#else -# define YYSYNTAX_ERROR yysyntax_error (&yymsg_alloc, &yymsg, \ - yyssp, yytoken) - { - char const *yymsgp = YY_("syntax error"); - int yysyntax_error_status; - yysyntax_error_status = YYSYNTAX_ERROR; - if (yysyntax_error_status == 0) - yymsgp = yymsg; - else if (yysyntax_error_status == 1) - { - if (yymsg != yymsgbuf) - YYSTACK_FREE (yymsg); - yymsg = (char *) YYSTACK_ALLOC (yymsg_alloc); - if (!yymsg) - { - yymsg = yymsgbuf; - yymsg_alloc = sizeof yymsgbuf; - yysyntax_error_status = 2; - } - else - { - yysyntax_error_status = YYSYNTAX_ERROR; - yymsgp = yymsg; - } - } - yyerror (yymsgp); - if (yysyntax_error_status == 2) - goto yyexhaustedlab; - } -# undef YYSYNTAX_ERROR -#endif - } - - - - if (yyerrstatus == 3) - { - /* If just tried and failed to reuse lookahead token after an - error, discard it. */ - - if (yychar <= YYEOF) - { - /* Return failure if at end of input. */ - if (yychar == YYEOF) - YYABORT; - } - else - { - yydestruct ("Error: discarding", - yytoken, &yylval); - yychar = YYEMPTY; - } - } - - /* Else will try to reuse lookahead token after shifting the error - token. */ - goto yyerrlab1; - - -/*---------------------------------------------------. -| yyerrorlab -- error raised explicitly by YYERROR. | -`---------------------------------------------------*/ -yyerrorlab: - - /* Pacify compilers like GCC when the user code never invokes - YYERROR and the label yyerrorlab therefore never appears in user - code. */ - if (/*CONSTCOND*/ 0) - goto yyerrorlab; - - /* Do not reclaim the symbols of the rule whose action triggered - this YYERROR. */ - YYPOPSTACK (yylen); - yylen = 0; - YY_STACK_PRINT (yyss, yyssp); - yystate = *yyssp; - goto yyerrlab1; - - -/*-------------------------------------------------------------. -| yyerrlab1 -- common code for both syntax error and YYERROR. | -`-------------------------------------------------------------*/ -yyerrlab1: - yyerrstatus = 3; /* Each real token shifted decrements this. */ - - for (;;) - { - yyn = yypact[yystate]; - if (!yypact_value_is_default (yyn)) - { - yyn += YYTERROR; - if (0 <= yyn && yyn <= YYLAST && yycheck[yyn] == YYTERROR) - { - yyn = yytable[yyn]; - if (0 < yyn) - break; - } - } - - /* Pop the current state because it cannot handle the error token. */ - if (yyssp == yyss) - YYABORT; - - - yydestruct ("Error: popping", - yystos[yystate], yyvsp); - YYPOPSTACK (1); - yystate = *yyssp; - YY_STACK_PRINT (yyss, yyssp); - } - - YY_IGNORE_MAYBE_UNINITIALIZED_BEGIN - *++yyvsp = yylval; - YY_IGNORE_MAYBE_UNINITIALIZED_END - - - /* Shift the error token. */ - YY_SYMBOL_PRINT ("Shifting", yystos[yyn], yyvsp, yylsp); - - yystate = yyn; - goto yynewstate; - - -/*-------------------------------------. -| yyacceptlab -- YYACCEPT comes here. | -`-------------------------------------*/ -yyacceptlab: - yyresult = 0; - goto yyreturn; - -/*-----------------------------------. -| yyabortlab -- YYABORT comes here. | -`-----------------------------------*/ -yyabortlab: - yyresult = 1; - goto yyreturn; - -#if !defined yyoverflow || YYERROR_VERBOSE -/*-------------------------------------------------. -| yyexhaustedlab -- memory exhaustion comes here. | -`-------------------------------------------------*/ -yyexhaustedlab: - yyerror (YY_("memory exhausted")); - yyresult = 2; - /* Fall through. */ -#endif - -yyreturn: - if (yychar != YYEMPTY) - { - /* Make sure we have latest lookahead translation. See comments at - user semantic actions for why this is necessary. */ - yytoken = YYTRANSLATE (yychar); - yydestruct ("Cleanup: discarding lookahead", - yytoken, &yylval); - } - /* Do not reclaim the symbols of the rule whose action triggered - this YYABORT or YYACCEPT. */ - YYPOPSTACK (yylen); - YY_STACK_PRINT (yyss, yyssp); - while (yyssp != yyss) - { - yydestruct ("Cleanup: popping", - yystos[*yyssp], yyvsp); - YYPOPSTACK (1); - } -#ifndef yyoverflow - if (yyss != yyssa) - YYSTACK_FREE (yyss); -#endif -#if YYERROR_VERBOSE - if (yymsg != yymsgbuf) - YYSTACK_FREE (yymsg); -#endif - return yyresult; -} -#line 1478 "ppparse.y" /* yacc.c:1906 */ - diff -Nru gnucobol-4.0~early~20200606/cobc/ppparse.def gnucobol-5/cobc/ppparse.def --- gnucobol-4.0~early~20200606/cobc/ppparse.def 2020-06-06 20:51:59.000000000 +0000 +++ gnucobol-5/cobc/ppparse.def 1970-01-01 00:00:00.000000000 +0000 @@ -1,43 +0,0 @@ -/* - Copyright (C) 2010-2012, 2016 Free Software Foundation, Inc. - Written by Roger While - - This file is part of GnuCOBOL. - - The GnuCOBOL compiler is free software: you can redistribute it - and/or modify it under the terms of the GNU General Public License - as published by the Free Software Foundation, either version 3 of the - License, or (at your option) any later version. - - GnuCOBOL is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with GnuCOBOL. If not, see . -*/ - - -/* CB_PARSE_DEF (name, return value if true) */ - -CB_PARSE_DEF ("OPENCOBOL", 1U) -CB_PARSE_DEF ("GNUCOBOL", 1U) -#ifdef COB_64_BIT_POINTER -CB_PARSE_DEF ("P64", 1U) -#else -CB_PARSE_DEF ("P64", 0U) -#endif -CB_PARSE_DEF ("EXECUTABLE", cb_flag_main != 0) -CB_PARSE_DEF ("MODULE", cb_flag_main == 0) -CB_PARSE_DEF ("TRUNC", cb_binary_truncate != 0) -CB_PARSE_DEF ("NOTRUNC", cb_binary_truncate == 0) -CB_PARSE_DEF ("DEBUG", cobc_wants_debug != 0) -CB_PARSE_DEF ("STICKY-LINKAGE", cb_sticky_linkage != 0) -CB_PARSE_DEF ("NOSTICKY-LINKAGE", cb_sticky_linkage == 0) -CB_PARSE_DEF ("HOSTSIGNS", cb_host_sign != 0) -CB_PARSE_DEF ("NOHOSTSIGNS", cb_host_sign == 0) -CB_PARSE_DEF ("IBMCOMP", cb_binary_size == CB_BINARY_SIZE_2_4_8) -CB_PARSE_DEF ("OCCOMP", cb_binary_size == CB_BINARY_SIZE_1_2_4_8) -CB_PARSE_DEF ("GCCOMP", cb_binary_size == CB_BINARY_SIZE_1_2_4_8) -CB_PARSE_DEF ("NOIBMCOMP", cb_binary_size != CB_BINARY_SIZE_2_4_8) diff -Nru gnucobol-4.0~early~20200606/cobc/ppparse.h gnucobol-5/cobc/ppparse.h --- gnucobol-4.0~early~20200606/cobc/ppparse.h 2020-06-06 20:52:36.000000000 +0000 +++ gnucobol-5/cobc/ppparse.h 1970-01-01 00:00:00.000000000 +0000 @@ -1,257 +0,0 @@ -/* A Bison parser, made by GNU Bison 3.0.4. */ - -/* Bison interface for Yacc-like parsers in C - - Copyright (C) 1984, 1989-1990, 2000-2015 Free Software Foundation, Inc. - - This program is free software: you can redistribute it and/or modify - it under the terms of the GNU General Public License as published by - the Free Software Foundation, either version 3 of the License, or - (at your option) any later version. - - This program is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with this program. If not, see . */ - -/* As a special exception, you may create a larger work that contains - part or all of the Bison parser skeleton and distribute that work - under terms of your choice, so long as that work isn't itself a - parser generator using the skeleton or a modified version thereof - as a parser skeleton. Alternatively, if you modify or redistribute - the parser skeleton itself, you may (at your option) remove this - special exception, which will cause the skeleton and the resulting - Bison output files to be licensed under the GNU General Public - License without this special exception. - - This special exception was added by the Free Software Foundation in - version 2.2 of Bison. */ - -#ifndef YY_PP_PPPARSE_H_INCLUDED -# define YY_PP_PPPARSE_H_INCLUDED -/* Debug traces. */ -#ifndef PPDEBUG -# if defined YYDEBUG -#if YYDEBUG -# define PPDEBUG 1 -# else -# define PPDEBUG 0 -# endif -# else /* ! defined YYDEBUG */ -# define PPDEBUG 0 -# endif /* ! defined YYDEBUG */ -#endif /* ! defined PPDEBUG */ -#if PPDEBUG -extern int ppdebug; -#endif - -/* Token type. */ -#ifndef PPTOKENTYPE -# define PPTOKENTYPE - enum pptokentype - { - TOKEN_EOF = 0, - ALSO = 258, - BY = 259, - COPY = 260, - EQEQ = 261, - IN = 262, - LAST = 263, - LEADING = 264, - OF = 265, - OFF = 266, - PRINTING = 267, - REPLACE = 268, - REPLACING = 269, - SUPPRESS = 270, - TRAILING = 271, - DOT = 272, - GARBAGE = 273, - LISTING_DIRECTIVE = 274, - LISTING_STATEMENT = 275, - TITLE_STATEMENT = 276, - CONTROL_STATEMENT = 277, - SOURCE = 278, - NOSOURCE = 279, - LIST = 280, - NOLIST = 281, - MAP = 282, - NOMAP = 283, - LEAP_SECOND_DIRECTIVE = 284, - SOURCE_DIRECTIVE = 285, - FORMAT = 286, - IS = 287, - FIXED = 288, - FREE = 289, - VARIABLE = 290, - CALL_DIRECTIVE = 291, - COBOL = 292, - TOK_EXTERN = 293, - STDCALL = 294, - STATIC = 295, - DEFINE_DIRECTIVE = 296, - AS = 297, - PARAMETER = 298, - OVERRIDE = 299, - SET_DIRECTIVE = 300, - ADDRSV = 301, - ADDSYN = 302, - ASSIGN = 303, - CALLFH = 304, - XFD = 305, - COMP1 = 306, - CONSTANT = 307, - FOLDCOPYNAME = 308, - MAKESYN = 309, - NOFOLDCOPYNAME = 310, - REMOVE = 311, - SOURCEFORMAT = 312, - IF_DIRECTIVE = 313, - ELSE_DIRECTIVE = 314, - ENDIF_DIRECTIVE = 315, - ELIF_DIRECTIVE = 316, - GE = 317, - LE = 318, - LT = 319, - GT = 320, - EQ = 321, - NE = 322, - NOT = 323, - THAN = 324, - TO = 325, - OR = 326, - EQUAL = 327, - GREATER = 328, - LESS = 329, - SET = 330, - DEFINED = 331, - TURN_DIRECTIVE = 332, - ON = 333, - CHECKING = 334, - WITH = 335, - LOCATION = 336, - TERMINATOR = 337, - TOKEN = 338, - TEXT_NAME = 339, - VARIABLE_NAME = 340, - LITERAL = 341 - }; -#endif -/* Tokens. */ -#define TOKEN_EOF 0 -#define ALSO 258 -#define BY 259 -#define COPY 260 -#define EQEQ 261 -#define IN 262 -#define LAST 263 -#define LEADING 264 -#define OF 265 -#define OFF 266 -#define PRINTING 267 -#define REPLACE 268 -#define REPLACING 269 -#define SUPPRESS 270 -#define TRAILING 271 -#define DOT 272 -#define GARBAGE 273 -#define LISTING_DIRECTIVE 274 -#define LISTING_STATEMENT 275 -#define TITLE_STATEMENT 276 -#define CONTROL_STATEMENT 277 -#define SOURCE 278 -#define NOSOURCE 279 -#define LIST 280 -#define NOLIST 281 -#define MAP 282 -#define NOMAP 283 -#define LEAP_SECOND_DIRECTIVE 284 -#define SOURCE_DIRECTIVE 285 -#define FORMAT 286 -#define IS 287 -#define FIXED 288 -#define FREE 289 -#define VARIABLE 290 -#define CALL_DIRECTIVE 291 -#define COBOL 292 -#define TOK_EXTERN 293 -#define STDCALL 294 -#define STATIC 295 -#define DEFINE_DIRECTIVE 296 -#define AS 297 -#define PARAMETER 298 -#define OVERRIDE 299 -#define SET_DIRECTIVE 300 -#define ADDRSV 301 -#define ADDSYN 302 -#define ASSIGN 303 -#define CALLFH 304 -#define XFD 305 -#define COMP1 306 -#define CONSTANT 307 -#define FOLDCOPYNAME 308 -#define MAKESYN 309 -#define NOFOLDCOPYNAME 310 -#define REMOVE 311 -#define SOURCEFORMAT 312 -#define IF_DIRECTIVE 313 -#define ELSE_DIRECTIVE 314 -#define ENDIF_DIRECTIVE 315 -#define ELIF_DIRECTIVE 316 -#define GE 317 -#define LE 318 -#define LT 319 -#define GT 320 -#define EQ 321 -#define NE 322 -#define NOT 323 -#define THAN 324 -#define TO 325 -#define OR 326 -#define EQUAL 327 -#define GREATER 328 -#define LESS 329 -#define SET 330 -#define DEFINED 331 -#define TURN_DIRECTIVE 332 -#define ON 333 -#define CHECKING 334 -#define WITH 335 -#define LOCATION 336 -#define TERMINATOR 337 -#define TOKEN 338 -#define TEXT_NAME 339 -#define VARIABLE_NAME 340 -#define LITERAL 341 - -/* Value type. */ -#if ! defined PPSTYPE && ! defined PPSTYPE_IS_DECLARED - -union PPSTYPE -{ -#line 518 "ppparse.y" /* yacc.c:1909 */ - - char *s; - struct cb_text_list *l; - struct cb_replace_list *r; - struct cb_define_struct *ds; - unsigned int ui; - int si; - -#line 245 "ppparse.h" /* yacc.c:1909 */ -}; - -typedef union PPSTYPE PPSTYPE; -# define PPSTYPE_IS_TRIVIAL 1 -# define PPSTYPE_IS_DECLARED 1 -#endif - - -extern PPSTYPE pplval; - -int ppparse (void); - -#endif /* !YY_PP_PPPARSE_H_INCLUDED */ diff -Nru gnucobol-4.0~early~20200606/cobc/ppparse.y gnucobol-5/cobc/ppparse.y --- gnucobol-4.0~early~20200606/cobc/ppparse.y 2020-06-06 20:51:59.000000000 +0000 +++ gnucobol-5/cobc/ppparse.y 1970-01-01 00:00:00.000000000 +0000 @@ -1,1478 +0,0 @@ -/* - Copyright (C) 2001-2012, 2015-2020 Free Software Foundation, Inc. - Written by Keisuke Nishida, Roger While, Simon Sobisch - - This file is part of GnuCOBOL. - - The GnuCOBOL compiler is free software: you can redistribute it - and/or modify it under the terms of the GNU General Public License - as published by the Free Software Foundation, either version 3 of the - License, or (at your option) any later version. - - GnuCOBOL is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with GnuCOBOL. If not, see . -*/ - - -%expect 0 - -%defines -%define parse.error verbose -%verbose -%define api.prefix {pp} - -%{ -#include - -#include -#include -#include -#include -#include - -#define COB_IN_PPPARSE 1 -#include "cobc.h" -#include "tree.h" - -#ifndef _STDLIB_H -#define _STDLIB_H 1 -#endif - -#define pperror(x) cb_error_always ("%s", x) - -#define COND_EQ 0 -#define COND_LT 1U -#define COND_GT 2U -#define COND_LE 3U -#define COND_GE 4U -#define COND_NE 5U - -/* Global variables */ - -int current_call_convention; - -/* Local variables */ - -static struct cb_define_struct *ppp_setvar_list = NULL; -static unsigned int current_cmd = 0; - -/* Local functions */ - -static char * -fix_filename (char *name) -{ - /* remove quotation from alphanumeric literals */ - if (name[0] == '\'' || name[0] == '\"') { - name++; - name[strlen (name) - 1] = 0; - } - return name; -} - -static char * -fold_lower (char *name) -{ - unsigned char *p; - - for (p = (unsigned char *)name; *p; p++) { - if (isupper (*p)) { - *p = (cob_u8_t)tolower (*p); - } - } - return name; -} - -static char * -fold_upper (char *name) -{ - unsigned char *p; - - for (p = (unsigned char *)name; *p; p++) { - if (islower (*p)) { - *p = (cob_u8_t)toupper (*p); - } - } - return name; -} - -static struct cb_replace_list * -ppp_replace_list_add (struct cb_replace_list *list, - const struct cb_text_list *old_text, - const struct cb_text_list *new_text, - const unsigned int lead_or_trail) -{ - struct cb_replace_list *p; - - p = cobc_plex_malloc (sizeof (struct cb_replace_list)); - p->line_num = cb_source_line; - p->old_text = old_text; - p->new_text = new_text; - p->lead_trail = lead_or_trail; - if (!list) { - p->last = p; - return p; - } - list->last->next = p; - list->last = p; - return list; -} - -static unsigned int -ppp_set_value (struct cb_define_struct *p, const char *value) -{ - const char *s; - size_t size; - unsigned int dotseen; - int sign; - int int_part; - int dec_part; - - if (!value) { - p->deftype = PLEX_DEF_NONE; - p->value = NULL; - p->sign = 0; - p->int_part = 0; - p->dec_part = 0; - return 0; - } - - if (*value == '"' || *value == '\'') { - sign = *value; - p->value = cobc_plex_strdup (value + 1); - size = strlen (p->value) - 1; - if (sign != p->value[size]) { - p->value = NULL; - p->deftype = PLEX_DEF_NONE; - return 1; - } - p->value[size] = 0; - p->deftype = PLEX_DEF_LIT; - p->sign = 0; - p->int_part = 0; - p->dec_part = 0; - return 0; - } - - p->value = cobc_plex_strdup (value); - p->deftype = PLEX_DEF_NUM; - p->sign = 0; - p->int_part = 0; - p->dec_part = 0; - - sign = 0; - if (*value == '+') { - value++; - } else if (*value == '-') { - value++; - sign = 1; - } - int_part = 0; - dec_part = 0; - size = 0; - dotseen = 0; - s = value; - for ( ; *s; ++s, ++size) { - if (*s == '.') { - if (dotseen) { - p->deftype = PLEX_DEF_NONE; - return 1; - } - dotseen = 1; - continue; - } - if (*s > '9' || *s < '0') { - p->deftype = PLEX_DEF_NONE; - return 1; - } - if (!dotseen) { - int_part = (int_part * 10) + (*s - '0'); - } else { - dec_part = (dec_part * 10) + (*s - '0'); - } - } - - if (!int_part && !dec_part) { - sign = 0; - } - p->sign = sign; - p->int_part = int_part; - p->dec_part = dec_part; - return 0; -} - -static unsigned int -ppp_compare_vals (const struct cb_define_struct *p1, - const struct cb_define_struct *p2, - const unsigned int cond) -{ - int result; - - if (!p1 || !p2) { - return 0; - } - if (p1->deftype != PLEX_DEF_LIT && p1->deftype != PLEX_DEF_NUM) { - return 0; - } - if (p2->deftype != PLEX_DEF_LIT && p2->deftype != PLEX_DEF_NUM) { - return 0; - } - if (p1->deftype != p2->deftype) { - cb_warning (COBC_WARN_FILLER, _("directive comparison on different types")); - return 0; - } - if (p1->deftype == PLEX_DEF_LIT) { - result = strcmp (p1->value, p2->value); - } else { - if (p1->sign && !p2->sign) { - result = -1; - } else if (!p1->sign && p2->sign) { - result = 1; - } else if (p1->int_part < p2->int_part) { - if (p1->sign) { - result = 1; - } else { - result = -1; - } - } else if (p1->int_part > p2->int_part) { - if (p1->sign) { - result = -1; - } else { - result = 1; - } - } else if (p1->dec_part < p2->dec_part) { - if (p1->sign) { - result = 1; - } else { - result = -1; - } - } else if (p1->dec_part > p2->dec_part) { - if (p1->sign) { - result = -1; - } else { - result = 1; - } - } else { - result = 0; - } - } - switch (cond) { - case COND_EQ: - return (result == 0); - case COND_LT: - return (result < 0); - case COND_GT: - return (result > 0); - case COND_LE: - return (result <= 0); - case COND_GE: - return (result >= 0); - case COND_NE: - return (result != 0); - default: - break; - } - return 0; -} - -static struct cb_define_struct * -ppp_define_add (struct cb_define_struct *list, const char *name, - const char *text, const unsigned int override) -{ - struct cb_define_struct *p; - struct cb_define_struct *l; - - /* Check duplicate */ - for (l = list; l; l = l->next) { - if (!strcasecmp (name, l->name)) { - if (!override && l->deftype != PLEX_DEF_DEL) { - cb_error (_("duplicate DEFINE directive '%s'"), name); - return NULL; - } - if (l->value) { - l->value = NULL; - } - if (ppp_set_value (l, text)) { - cb_error (_("invalid constant in DEFINE directive")); - return NULL; - } - return list; - } - } - - p = cobc_plex_malloc (sizeof (struct cb_define_struct)); - p->name = cobc_plex_strdup (name); - if (ppp_set_value (p, text)) { - cb_error (_("invalid constant in DEFINE directive")); - return NULL; - } - - if (!list) { - p->last = p; - return p; - } - list->last->next = p; - list->last = p; - return list; -} - -static void -ppp_define_del (const char *name) -{ - struct cb_define_struct *l; - - for (l = ppp_setvar_list; l; l = l->next) { - if (!strcmp (name, l->name)) { - l->deftype = PLEX_DEF_DEL; - if (l->value) { - l->value = NULL; - } - l->sign = 0; - l->int_part = 0; - l->dec_part = 0; - break; - } - } -} - -void -ppp_clear_lists (void) -{ - ppp_setvar_list = NULL; -} - -struct cb_define_struct * -ppp_search_lists (const char *name) -{ - struct cb_define_struct *p; - - for (p = ppp_setvar_list; p; p = p->next) { - if (p->name == NULL) { - continue; - } - if (!strcasecmp (name, p->name)) { - if (p->deftype != PLEX_DEF_DEL) { - return p; - } - break; - } - } - return NULL; -} - -static struct cb_text_list * -ppp_list_add (struct cb_text_list *list, const char *text) -{ - struct cb_text_list *p; - - p = cobc_plex_malloc (sizeof (struct cb_text_list)); - p->text = cobc_plex_strdup (text); - if (!list) { - p->last = p; - return p; - } - list->last->next = p; - list->last = p; - return list; -} - -static struct cb_text_list * -ppp_list_append (struct cb_text_list *list_1, struct cb_text_list *list_2) -{ - struct cb_text_list *list_1_end; - - if (!list_1) { - return list_2; - } - - for (list_1_end = list_1; - list_1_end->next; - list_1_end = list_1_end->next); - list_1_end->next = list_2; - list_2->last = list_1_end; - - return list_1; -} - -static unsigned int -ppp_search_comp_vars (const char *name) -{ -#undef CB_PARSE_DEF -#define CB_PARSE_DEF(x,z) if (!strcasecmp (name, x)) return (z); -#include "ppparse.def" -#undef CB_PARSE_DEF - cb_warning (COBC_WARN_FILLER, _("compiler flag '%s' unknown"), name); - return 0; -} - -static unsigned int -ppp_check_needs_quote (const char *envval) -{ - const char *s; - size_t size; - unsigned int dot_seen; - unsigned int sign_seen; - - /* Non-quoted value - Check if possible numeric */ - dot_seen = 0; - sign_seen = 0; - size = 0; - s = envval; - if (*s == '+' || *s == '-') { - sign_seen = 1; - size++; - s++; - } - for (; *s; ++s) { - if (*s == '.') { - if (dot_seen) { - break; - } - dot_seen = 1; - size++; - continue; - } - if (*s > '9' || *s < '0') { - break; - } - size++; - } - - if (*s || size <= ((size_t)dot_seen + sign_seen)) { - return 1; - } - return 0; -} - -static void -ppp_error_invalid_option (const char *directive, const char *option) -{ - cb_error (_("invalid %s directive option '%s'"), directive, option); -} - -/* Global functions */ - -void -ppparse_clear_vars (const struct cb_define_struct *p) -{ - const struct cb_define_struct *q; - - ppp_setvar_list = NULL; - /* Set standard DEFINE's */ - if (cb_perform_osvs) { - ppp_setvar_list = ppp_define_add (ppp_setvar_list, - "PERFORM-TYPE", - "'OSVS'", 0); - } else { - ppp_setvar_list = ppp_define_add (ppp_setvar_list, - "PERFORM-TYPE", - "'MF'", 0); - } - if (cb_ebcdic_sign) { - ppp_setvar_list = ppp_define_add (ppp_setvar_list, - "SIGN", - "'EBCDIC'", 0); - } else { - ppp_setvar_list = ppp_define_add (ppp_setvar_list, - "SIGN", - "'ASCII'", 0); - } -#ifdef WORDS_BIGENDIAN - ppp_setvar_list = ppp_define_add (ppp_setvar_list, - "ENDIAN", - "'BIG'", 0); -#else - ppp_setvar_list = ppp_define_add (ppp_setvar_list, - "ENDIAN", - "'LITTLE'", 0); -#endif -#if ' ' == 0x20 - ppp_setvar_list = ppp_define_add (ppp_setvar_list, - "CHARSET", - "'ASCII'", 0); -#elif ' ' == 0x40 - ppp_setvar_list = ppp_define_add (ppp_setvar_list, - "CHARSET", - "'EBCDIC'", 0); -#else - ppp_setvar_list = ppp_define_add (ppp_setvar_list, - "CHARSET", - "'UNKNOWN'", 0); -#endif - /* Set DEFINE's from '-D' option(s) */ - for (q = p; q; q = q->next) { - ppp_setvar_list = ppp_define_add (ppp_setvar_list, - q->name, - q->value, 0); - } - /* reset CALL CONVENTION */ - current_call_convention = CB_CONV_COBOL; -} - -%} - -%union { - char *s; - struct cb_text_list *l; - struct cb_replace_list *r; - struct cb_define_struct *ds; - unsigned int ui; - int si; -}; - -%token TOKEN_EOF 0 "end of file" - -%token ALSO -%token BY -%token COPY -%token EQEQ "==" -%token IN -%token LAST -%token LEADING -%token OF -%token OFF -%token PRINTING -%token REPLACE -%token REPLACING -%token SUPPRESS -%token TRAILING -%token DOT "." - -%token GARBAGE "word" - -%token LISTING_DIRECTIVE -%token LISTING_STATEMENT -%token TITLE_STATEMENT - -%token CONTROL_STATEMENT -%token SOURCE -%token NOSOURCE -%token LIST -%token NOLIST -%token MAP -%token NOMAP - -%token LEAP_SECOND_DIRECTIVE - -%token SOURCE_DIRECTIVE -%token FORMAT -%token IS -%token FIXED -%token FREE -%token VARIABLE - -%token CALL_DIRECTIVE -%token COBOL -%token TOK_EXTERN "EXTERN" -%token STDCALL -%token STATIC - -%token DEFINE_DIRECTIVE -%token AS -%token PARAMETER -%token OVERRIDE - -%token SET_DIRECTIVE -%token ADDRSV -%token ADDSYN -%token ASSIGN -%token CALLFH -%token XFD -%token COMP1 -%token CONSTANT -%token FOLDCOPYNAME -%token MAKESYN -%token NOFOLDCOPYNAME -/* OVERRIDE token defined above. */ -%token REMOVE -%token SOURCEFORMAT - -%token IF_DIRECTIVE -%token ELSE_DIRECTIVE -%token ENDIF_DIRECTIVE -%token ELIF_DIRECTIVE - -%token GE ">=" -%token LE "<=" -%token LT "<" -%token GT ">" -%token EQ "=" -%token NE "<>" -%token NOT -%token THAN -%token TO -%token OR -%token EQUAL -%token GREATER -%token LESS -%token SET -%token DEFINED - -%token TURN_DIRECTIVE -%token ON -%token CHECKING -%token WITH -%token LOCATION - -%token TERMINATOR "end of line" - -%token TOKEN "Identifier or Literal" -%token TEXT_NAME "Text-Name" -%token VARIABLE_NAME "Variable" -%token LITERAL "Literal" - -%type copy_in -%type copy_source - -%type token_list -%type identifier -%type subscripts -%type text_src -%type text_dst -%type text_partial_src -%type text_partial_dst -%type alnum_list -%type alnum_equality -%type alnum_equality_list - -%type copy_replacing -%type replacing_list - -%type object_id - -%type _override -%type condition_clause -%type _not -%type _also -%type _last -%type lead_trail - -%% - -statement_list: -| statement_list statement -; - -statement: - copy_statement DOT -| replace_statement DOT -| directive TERMINATOR -| listing_statement -| CONTROL_STATEMENT control_options _dot TERMINATOR - { - CB_PENDING (_("*CONTROL statement")); - } -; - -directive: - SOURCE_DIRECTIVE source_directive -| DEFINE_DIRECTIVE define_directive -| SET_DIRECTIVE set_directive -| TURN_DIRECTIVE turn_directive -| LISTING_DIRECTIVE listing_directive -| LEAP_SECOND_DIRECTIVE leap_second_directive -| IF_DIRECTIVE - { - current_cmd = PLEX_ACT_IF; - } - if_directive -| ELIF_DIRECTIVE - { - current_cmd = PLEX_ACT_ELIF; - } - if_directive -| ELSE_DIRECTIVE - { - plex_action_directive (PLEX_ACT_ELSE, 0); - } -| ENDIF_DIRECTIVE - { - plex_action_directive (PLEX_ACT_END, 0); - } -| CALL_DIRECTIVE - { - current_call_convention = 0; - } - call_directive - { - if (current_call_convention == CB_CONV_STATIC_LINK) { - current_call_convention |= CB_CONV_COBOL; - }; - } -; - -set_directive: - set_choice -| set_directive set_choice -; - -set_choice: - CONSTANT VARIABLE_NAME LITERAL - { - /* note: the old version was _as LITERAL but MF doesn't support this */ - struct cb_define_struct *p; - - p = ppp_define_add (ppp_setvar_list, $2, $3, 1); - if (p) { - ppp_setvar_list = p; - fprintf (ppout, "#DEFLIT %s %s\n", $2, $3); - } - } -| VARIABLE_NAME set_options -| ADDRSV alnum_list - { - struct cb_text_list *l; - - for (l = $2; l; l = l->next) { - fprintf (ppout, "#ADDRSV %s\n", l->text); - } - } -| ADDSYN alnum_equality - { - struct cb_text_list *l; - - for (l = $2; l; l = l->next->next) { - fprintf (ppout, "#ADDSYN %s %s\n", l->text, l->next->text); - } - } -| ASSIGN LITERAL - { - char *p = $2; - size_t size; - - /* Remove surrounding quotes/brackets */ - ++p; - size = strlen (p) - 1; - p[size] = '\0'; - - if (!strcasecmp (p, "EXTERNAL")) { - fprintf (ppout, "#ASSIGN %d\n", (int)CB_ASSIGN_EXT_FILE_NAME_REQUIRED); - } else if (!strcasecmp (p, "DYNAMIC")) { - fprintf (ppout, "#ASSIGN %d\n", (int)CB_ASSIGN_VARIABLE_DEFAULT); - } else { - ppp_error_invalid_option ("ASSIGN", p); - } - } -| CALLFH LITERAL - { - char *p = $2; - /* Remove surrounding quotes/brackets */ - size_t size; - ++p; - size = strlen (p) - 1; - p[size] = '\0'; - fprintf (ppout, "#CALLFH \"%s\"\n", p); - } -| CALLFH - { - fprintf (ppout, "#CALLFH \"EXTFH\"\n"); - } -| XFD LITERAL - { - char *p = $2; - ++p; - p[strlen (p) - 1] = '\0'; - fprintf (ppout, "#XFD \"%s\"\n", p); - } -| COMP1 LITERAL - { - char *p = $2; - size_t size; - - /* Remove surrounding quotes/brackets */ - ++p; - size = strlen (p) - 1; - p[size] = '\0'; - - if (!strcasecmp (p, "BINARY")) { - cb_binary_comp_1 = 1; - } else if (!strcasecmp (p, "FLOAT")) { - cb_binary_comp_1 = 0; - } else { - ppp_error_invalid_option ("COMP1", p); - } - } -| FOLDCOPYNAME _as LITERAL - { - char *p = $3; - size_t size; - - /* Remove surrounding quotes/brackets */ - ++p; - size = strlen (p) - 1; - p[size] = '\0'; - - if (!strcasecmp (p, "UPPER")) { - cb_fold_copy = COB_FOLD_UPPER; - } else if (!strcasecmp (p, "LOWER")) { - cb_fold_copy = COB_FOLD_LOWER; - } else { - ppp_error_invalid_option ("FOLD-COPY-NAME", p); - } - } -| MAKESYN alnum_equality - { - fprintf (ppout, "#MAKESYN %s %s\n", $2->text, $2->next->text); - } -| NOFOLDCOPYNAME - { - cb_fold_copy = 0; - } -| OVERRIDE alnum_equality_list - { - struct cb_text_list *l; - - for (l = $2; l; l = l->next->next) { - fprintf (ppout, "#OVERRIDE %s %s\n", l->text, l->next->text); - } - } -| REMOVE alnum_list - { - struct cb_text_list *l; - - for (l = $2; l; l = l->next) { - fprintf (ppout, "#REMOVE %s\n", l->text); - } - } -| SOURCEFORMAT _as LITERAL - { - char *p = $3; - size_t size; - - /* Remove surrounding quotes/brackets */ - ++p; - size = strlen (p) - 1; - p[size] = '\0'; - - if (!strcasecmp (p, "FIXED")) { - cb_source_format = CB_FORMAT_FIXED; - cb_text_column = cb_config_text_column; - } else if (!strcasecmp (p, "FREE")) { - cb_source_format = CB_FORMAT_FREE; - } else if (!strcasecmp (p, "VARIABLE")) { - cb_source_format = CB_FORMAT_FIXED; - /* This value matches most MF Visual COBOL 4.0 version. */ - cb_text_column = 250; - } else { - ppp_error_invalid_option ("SOURCEFORMAT", p); - } - if (cb_src_list_file) { - cb_current_file->source_format = cb_source_format; - } - } -; - -alnum_list: - LITERAL - { - $$ = ppp_list_add (NULL, $1); - } -| alnum_list LITERAL - { - $$ = ppp_list_add ($1, $2); - } -; - -alnum_equality_list: - alnum_equality -| alnum_equality_list alnum_equality - { - $$ = ppp_list_append ($1, $2); - } -; - -alnum_equality: - LITERAL EQ LITERAL - { - $$ = ppp_list_add (NULL, $1); - $$ = ppp_list_add ($$, $3); - } -; - -set_options: - /* empty */ - { - fprintf (ppout, "#OPTION %s\n", $0); - } -| _as LITERAL - { - fprintf (ppout, "#OPTION %s %s\n", $0, $2); - } -; - -source_directive: - _format _is format_type - { - if (cb_src_list_file) { - cb_current_file->source_format = cb_source_format; - } - } -; - -format_type: - FIXED - { - cb_source_format = CB_FORMAT_FIXED; - cb_text_column = cb_config_text_column; - } -| FREE - { - cb_source_format = CB_FORMAT_FREE; - } -| VARIABLE - { - cb_source_format = CB_FORMAT_FIXED; - cb_text_column = 500; - } -| GARBAGE - { - cb_error (_("invalid %s directive"), "SOURCE"); - YYERROR; - } -; - -define_directive: - VARIABLE_NAME _as LITERAL _override - { - struct cb_define_struct *p; - - p = ppp_define_add (ppp_setvar_list, $1, $3, $4); - if (p) { - ppp_setvar_list = p; - } - } -| VARIABLE_NAME _as PARAMETER _override - { - char *s; - char *q; - struct cb_define_struct *p; - size_t size; - - s = getenv ($1); - q = NULL; - if (s && *s && *s != ' ') { - if (*s == '"' || *s == '\'') { - size = strlen (s) - 1U; - /* Ignore if improperly quoted */ - if (s[0] == s[size]) { - q = s; - } - } else { - if (ppp_check_needs_quote (s)) { - /* Alphanumeric literal */ - q = cobc_plex_malloc (strlen (s) + 4U); - sprintf (q, "'%s'", s); - } else { - /* Numeric literal */ - q = s; - } - } - } - if (q) { - p = ppp_define_add (ppp_setvar_list, $1, q, $4); - if (p) { - ppp_setvar_list = p; - } - } - } -| VARIABLE_NAME _as OFF - { - ppp_define_del ($1); - } -| CONSTANT VARIABLE_NAME _as LITERAL _override - { - /* OpenCOBOL/GnuCOBOL 2.0 extension: MF $SET CONSTANT in 2002+ style as - >> DEFINE CONSTANT var [AS] literal archaic extension: - use plain >> DEFINE var [AS] literal for conditional compilation and - use 01 CONSTANT with/without FROM clause for constant definitions */ - struct cb_define_struct *p; - - if (cb_verify (cb_define_constant_directive, ">> DEFINE CONSTANT var")) { - p = ppp_define_add (ppp_setvar_list, $2, $4, $5); - if (p) { - ppp_setvar_list = p; - fprintf (ppout, "#DEFLIT %s %s%s\n", $2, $4, $5 ? " OVERRIDE" : ""); - } - } - } -| variable_or_literal - { - cb_error (_("invalid %s directive"), "DEFINE/SET"); - } -; - - -listing_directive: - /* Note: processed in cobc.c */ - /* empty (ON implied) */ -| ON -| OFF -; - -listing_statement: - LISTING_STATEMENT -| TITLE_STATEMENT LITERAL _dot TERMINATOR -; - -control_options: - control_option -| control_options control_option -; - -control_option: - SOURCE -| NOSOURCE -| LIST -| NOLIST -| MAP -| NOMAP -; - -_dot: -| DOT -; - -leap_second_directive: -/* empty (OFF implied) */ -| ON - { - CB_PENDING (_("LEAP-SECOND ON directive")); - } -| OFF -; - -turn_directive: - ec_list CHECKING on_or_off - { - CB_PENDING (_("TURN directive")); - } -; - -ec_list: - VARIABLE_NAME -| ec_list VARIABLE_NAME -; - -on_or_off: - /* Empty */ -| OFF -| ON with_loc -| with_loc -; - -with_loc: - WITH LOCATION -| LOCATION -; - -call_directive: - call_choice -| call_directive call_choice -; - -call_choice: - COBOL - { - current_call_convention |= CB_CONV_COBOL; - current_call_convention &= ~CB_CONV_STDCALL; - } -| TOK_EXTERN - { - current_call_convention &= ~CB_CONV_STDCALL; - current_call_convention &= ~CB_CONV_COBOL; - } -| STDCALL - { - current_call_convention |= CB_CONV_STDCALL; - current_call_convention &= ~CB_CONV_COBOL; - } -| STATIC - { - current_call_convention |= CB_CONV_STATIC_LINK; - } -; - -if_directive: - VARIABLE_NAME _is _not DEFINED - { - unsigned int found; - - found = (ppp_search_lists ($1) != NULL); - plex_action_directive (current_cmd, found ^ $3); - } -| VARIABLE_NAME _is _not SET - { - unsigned int found; - - found = ppp_search_comp_vars ($1); - plex_action_directive (current_cmd, found ^ $3); - } -| VARIABLE_NAME _is _not condition_clause object_id - { - struct cb_define_struct *p; - unsigned int found; - - found = 0; - p = ppp_search_lists ($1); - found = ppp_compare_vals (p, $5, $4); - plex_action_directive (current_cmd, found ^ $3); - } -| LITERAL _is _not condition_clause object_id - { - struct cb_define_struct *p; - unsigned int found; - - found = 0; - p = cobc_plex_malloc (sizeof (struct cb_define_struct)); - p->next = NULL; - if (ppp_set_value (p, $1)) { - cb_error (_("invalid constant")); - } else { - found = ppp_compare_vals (p, $5, $4); - } - plex_action_directive (current_cmd, found ^ $3); - } -| variable_or_literal - { - cb_error (_("invalid %s directive"), "IF/ELIF"); - } -; - -variable_or_literal: - VARIABLE_NAME -| LITERAL -; - -object_id: - LITERAL - { - struct cb_define_struct *p; - - p = cobc_plex_malloc (sizeof (struct cb_define_struct)); - p->next = NULL; - if (ppp_set_value (p, $1)) { - cb_error (_("invalid constant")); - $$ = NULL; - } else { - $$ = p; - } - } -| VARIABLE_NAME - { - struct cb_define_struct *p; - - p = ppp_search_lists ($1); - if (p != NULL && p->deftype != PLEX_DEF_NONE) { - $$ = p; - } else { - $$ = NULL; - } - } -; - -condition_clause: - GREATER _than OR EQUAL _to - { - $$ = COND_GE; - } -| GREATER _than - { - $$ = COND_GT; - } -| LESS _than OR EQUAL _to - { - $$ = COND_LE; - } -| LESS _than - { - $$ = COND_LT; - } -| EQUAL _to - { - $$ = COND_EQ; - } -| GE - { - $$ = COND_GE; - } -| GT - { - $$ = COND_GT; - } -| LE - { - $$ = COND_LE; - } -| LT - { - $$ = COND_LT; - } -| EQ - { - $$ = COND_EQ; - } -| NE - { - $$ = COND_NE; - } -; - -copy_statement: - COPY copy_source copy_in copy_suppress copy_replacing - { - fputc ('\n', ppout); - ppcopy ($2, $3, $5); - } -; - -copy_source: - TOKEN - { - $$ = fix_filename ($1); - if (cb_fold_copy == COB_FOLD_LOWER) { - $$ = fold_lower ($$); - } else if (cb_fold_copy == COB_FOLD_UPPER) { - $$ = fold_upper ($$); - } - } -| TEXT_NAME - { - $$ = $1; - if (cb_fold_copy == COB_FOLD_LOWER) { - $$ = fold_lower ($$); - } else { - $$ = fold_upper ($$); - } - } -; - -copy_in: - /* nothing */ - { - $$ = NULL; - } -| in_or_of copy_source - { - $$ = $2; - } -; - -in_or_of: - IN -| OF -; - -copy_suppress: -| SUPPRESS _printing -; - -copy_replacing: - /* nothing */ - { - $$ = NULL; - } -| REPLACING replacing_list - { - $$ = $2; - } -; - -replace_statement: - REPLACE _also replacing_list - { - pp_set_replace_list ($3, $2); - } -| REPLACE _last OFF - { - pp_set_replace_list (NULL, $2); - } -; - -replacing_list: - text_src BY text_dst - { - $$ = ppp_replace_list_add (NULL, $1, $3, 0); - } -| lead_trail text_partial_src BY text_partial_dst - { - $$ = ppp_replace_list_add (NULL, $2, $4, $1); - } -| replacing_list text_src BY text_dst - { - $$ = ppp_replace_list_add ($1, $2, $4, 0); - } -| replacing_list lead_trail text_partial_src BY text_partial_dst - { - $$ = ppp_replace_list_add ($1, $3, $5, $2); - } -; - -text_src: - EQEQ token_list EQEQ - { - $$ = $2; - } -| identifier - { - $$ = $1; - } -; - -text_dst: - EQEQ EQEQ - { - $$ = NULL; - } -| EQEQ token_list EQEQ - { - $$ = $2; - } -| identifier - { - $$ = $1; - } -; - -text_partial_src: - EQEQ TOKEN EQEQ - { - $$ = ppp_list_add (NULL, $2); - } -; - -text_partial_dst: - EQEQ EQEQ - { - $$ = NULL; - } -| EQEQ TOKEN EQEQ - { - $$ = ppp_list_add (NULL, $2); - } -; - -token_list: - TOKEN - { - $$ = ppp_list_add (NULL, $1); - } -| token_list TOKEN - { - $$ = ppp_list_add ($1, $2); - } -; - -identifier: - TOKEN - { - $$ = ppp_list_add (NULL, $1); - } -| identifier IN TOKEN - { - $$ = ppp_list_add ($1, " "); - $$ = ppp_list_add ($$, "IN"); - $$ = ppp_list_add ($$, " "); - $$ = ppp_list_add ($$, $3); - } -| identifier OF TOKEN - { - $$ = ppp_list_add ($1, " "); - $$ = ppp_list_add ($$, "OF"); - $$ = ppp_list_add ($$, " "); - $$ = ppp_list_add ($$, $3); - } -| identifier '(' subscripts ')' - { - struct cb_text_list *l; - - $$ = ppp_list_add ($1, " "); - $$ = ppp_list_add ($$, "("); - $3 = ppp_list_add ($3, ")"); - for (l = $$; l->next; l = l->next) { - ; - } - l->next = $3; - } -; - -subscripts: - TOKEN - { - $$ = ppp_list_add (NULL, $1); - } -| subscripts TOKEN - { - $$ = ppp_list_add ($1, " "); - $$ = ppp_list_add ($$, $2); - } -; - -lead_trail: - LEADING - { - $$ = CB_REPLACE_LEADING; - } -| TRAILING - { - $$ = CB_REPLACE_TRAILING; - } -; - -/* Optional keywords */ - -_override: - /* empty */ - { - $$ = 0; - } -| OVERRIDE - { - $$ = 1U; - } -; - -_not: - /* empty */ - { - $$ = 0; - } -| NOT - { - $$ = 1U; - } -; - -_also: - /* empty */ - { - $$ = 0; - } -| ALSO - { - $$ = 1U; - } -; - -_last: - /* empty */ - { - $$ = 0; - } -| LAST - { - $$ = 1U; - } -; - -_as: | AS ; -_format: | FORMAT ; -_is: | IS ; -_printing: | PRINTING ; -_than: | THAN ; -_to: | TO ; - -%% diff -Nru gnucobol-4.0~early~20200606/cobc/reserved.c gnucobol-5/cobc/reserved.c --- gnucobol-4.0~early~20200606/cobc/reserved.c 2020-06-06 20:51:59.000000000 +0000 +++ gnucobol-5/cobc/reserved.c 1970-01-01 00:00:00.000000000 +0000 @@ -1,5108 +0,0 @@ -/* - Copyright (C) 2001-2012, 2014-2020 Free Software Foundation, Inc. - Written by Keisuke Nishida, Roger While, Simon Sobisch, Edward Hart - - This file is part of GnuCOBOL. - - The GnuCOBOL compiler is free software: you can redistribute it - and/or modify it under the terms of the GNU General Public License - as published by the Free Software Foundation, either version 3 of the - License, or (at your option) any later version. - - GnuCOBOL is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with GnuCOBOL. If not, see . -*/ - - -#include - -#include -#include -#include -#include -#include - -#include "cobc.h" -#include "tree.h" -#include - -/* Local variables */ - -struct system_name_struct { - const char *name; - const enum cb_system_name_category category; - const int token; - enum cb_feature_mode active; -}; - -/* TODO: allow these to not only be enabled/disabled but defined by compiler configuration - removing duplicates from this list (especially concerning the switches) */ -static struct system_name_struct system_name_table[] = { - {"SYSIN", CB_DEVICE_NAME, CB_DEVICE_SYSIN, CB_FEATURE_ACTIVE}, - {"SYSIPT", CB_DEVICE_NAME, CB_DEVICE_SYSIN, CB_FEATURE_ACTIVE}, - {"STDIN", CB_DEVICE_NAME, CB_DEVICE_SYSIN, CB_FEATURE_ACTIVE}, - {"SYSOUT", CB_DEVICE_NAME, CB_DEVICE_SYSOUT, CB_FEATURE_ACTIVE}, - {"SYSLIST", CB_DEVICE_NAME, CB_DEVICE_SYSOUT, CB_FEATURE_ACTIVE}, - {"SYSLST", CB_DEVICE_NAME, CB_DEVICE_SYSOUT, CB_FEATURE_ACTIVE}, - {"SYSPCH", CB_DEVICE_NAME, CB_DEVICE_SYSPCH, CB_FEATURE_ACTIVE}, - {"SYSPUNCH", CB_DEVICE_NAME, CB_DEVICE_SYSPCH, CB_FEATURE_ACTIVE}, - {"STDOUT", CB_DEVICE_NAME, CB_DEVICE_SYSOUT, CB_FEATURE_ACTIVE}, - {"PRINT", CB_DEVICE_NAME, CB_DEVICE_SYSOUT, CB_FEATURE_ACTIVE}, - {"PRINTER", CB_DEVICE_NAME, CB_DEVICE_PRINTER, CB_FEATURE_ACTIVE}, - {"PRINTER-1", CB_DEVICE_NAME, CB_DEVICE_PRINTER, CB_FEATURE_ACTIVE}, - {"SYSERR", CB_DEVICE_NAME, CB_DEVICE_SYSERR, CB_FEATURE_ACTIVE}, - {"STDERR", CB_DEVICE_NAME, CB_DEVICE_SYSERR, CB_FEATURE_ACTIVE}, - {"CONSOLE", CB_DEVICE_NAME, CB_DEVICE_CONSOLE, CB_FEATURE_ACTIVE}, - {"C01", CB_FEATURE_NAME, CB_FEATURE_C01, CB_FEATURE_ACTIVE}, - {"C02", CB_FEATURE_NAME, CB_FEATURE_C02, CB_FEATURE_ACTIVE}, - {"C03", CB_FEATURE_NAME, CB_FEATURE_C03, CB_FEATURE_ACTIVE}, - {"C04", CB_FEATURE_NAME, CB_FEATURE_C04, CB_FEATURE_ACTIVE}, - {"C05", CB_FEATURE_NAME, CB_FEATURE_C05, CB_FEATURE_ACTIVE}, - {"C06", CB_FEATURE_NAME, CB_FEATURE_C06, CB_FEATURE_ACTIVE}, - {"C07", CB_FEATURE_NAME, CB_FEATURE_C07, CB_FEATURE_ACTIVE}, - {"C08", CB_FEATURE_NAME, CB_FEATURE_C08, CB_FEATURE_ACTIVE}, - {"C09", CB_FEATURE_NAME, CB_FEATURE_C09, CB_FEATURE_ACTIVE}, - {"C10", CB_FEATURE_NAME, CB_FEATURE_C10, CB_FEATURE_ACTIVE}, - {"C11", CB_FEATURE_NAME, CB_FEATURE_C11, CB_FEATURE_ACTIVE}, - {"C12", CB_FEATURE_NAME, CB_FEATURE_C12, CB_FEATURE_ACTIVE}, - {"S01", CB_FEATURE_NAME, CB_FEATURE_FORMFEED, CB_FEATURE_ACTIVE}, - {"S02", CB_FEATURE_NAME, CB_FEATURE_FORMFEED, CB_FEATURE_ACTIVE}, - {"S03", CB_FEATURE_NAME, CB_FEATURE_FORMFEED, CB_FEATURE_ACTIVE}, - {"S04", CB_FEATURE_NAME, CB_FEATURE_FORMFEED, CB_FEATURE_ACTIVE}, - {"S05", CB_FEATURE_NAME, CB_FEATURE_FORMFEED, CB_FEATURE_ACTIVE}, - /*{"AFP-5A ", CB_FEATURE_NAME, CB_FEATURE_AFP_5A , CB_FEATURE_ACTIVE},*/ - {"CSP", CB_FEATURE_NAME, CB_FEATURE_FORMFEED, CB_FEATURE_ACTIVE}, - {"FORMFEED", CB_FEATURE_NAME, CB_FEATURE_FORMFEED, CB_FEATURE_ACTIVE}, - {"TOP", CB_FEATURE_NAME, CB_FEATURE_FORMFEED, CB_FEATURE_ACTIVE}, - {"CALL-CONVENTION", CB_FEATURE_NAME, CB_FEATURE_CONVENTION, CB_FEATURE_ACTIVE}, - {"SWITCH-0", CB_SWITCH_NAME, CB_SWITCH_0, CB_FEATURE_ACTIVE}, - {"SWITCH-1", CB_SWITCH_NAME, CB_SWITCH_1, CB_FEATURE_ACTIVE}, - {"SWITCH-2", CB_SWITCH_NAME, CB_SWITCH_2, CB_FEATURE_ACTIVE}, - {"SWITCH-3", CB_SWITCH_NAME, CB_SWITCH_3, CB_FEATURE_ACTIVE}, - {"SWITCH-4", CB_SWITCH_NAME, CB_SWITCH_4, CB_FEATURE_ACTIVE}, - {"SWITCH-5", CB_SWITCH_NAME, CB_SWITCH_5, CB_FEATURE_ACTIVE}, - {"SWITCH-6", CB_SWITCH_NAME, CB_SWITCH_6, CB_FEATURE_ACTIVE}, - {"SWITCH-7", CB_SWITCH_NAME, CB_SWITCH_7, CB_FEATURE_ACTIVE}, - {"SWITCH-8", CB_SWITCH_NAME, CB_SWITCH_8, CB_FEATURE_ACTIVE}, - {"SWITCH-9", CB_SWITCH_NAME, CB_SWITCH_9, CB_FEATURE_ACTIVE}, - {"SWITCH-10", CB_SWITCH_NAME, CB_SWITCH_10, CB_FEATURE_ACTIVE}, - {"SWITCH-11", CB_SWITCH_NAME, CB_SWITCH_11, CB_FEATURE_ACTIVE}, - {"SWITCH-12", CB_SWITCH_NAME, CB_SWITCH_12, CB_FEATURE_ACTIVE}, - {"SWITCH-13", CB_SWITCH_NAME, CB_SWITCH_13, CB_FEATURE_ACTIVE}, - {"SWITCH-14", CB_SWITCH_NAME, CB_SWITCH_14, CB_FEATURE_ACTIVE}, - {"SWITCH-15", CB_SWITCH_NAME, CB_SWITCH_15, CB_FEATURE_ACTIVE}, - {"SWITCH-16", CB_SWITCH_NAME, CB_SWITCH_16, CB_FEATURE_ACTIVE}, - {"SWITCH-17", CB_SWITCH_NAME, CB_SWITCH_17, CB_FEATURE_ACTIVE}, - {"SWITCH-18", CB_SWITCH_NAME, CB_SWITCH_18, CB_FEATURE_ACTIVE}, - {"SWITCH-19", CB_SWITCH_NAME, CB_SWITCH_19, CB_FEATURE_ACTIVE}, - {"SWITCH-20", CB_SWITCH_NAME, CB_SWITCH_20, CB_FEATURE_ACTIVE}, - {"SWITCH-21", CB_SWITCH_NAME, CB_SWITCH_21, CB_FEATURE_ACTIVE}, - {"SWITCH-22", CB_SWITCH_NAME, CB_SWITCH_22, CB_FEATURE_ACTIVE}, - {"SWITCH-23", CB_SWITCH_NAME, CB_SWITCH_23, CB_FEATURE_ACTIVE}, - {"SWITCH-24", CB_SWITCH_NAME, CB_SWITCH_24, CB_FEATURE_ACTIVE}, - {"SWITCH-25", CB_SWITCH_NAME, CB_SWITCH_25, CB_FEATURE_ACTIVE}, - {"SWITCH-26", CB_SWITCH_NAME, CB_SWITCH_26, CB_FEATURE_ACTIVE}, - {"SWITCH-27", CB_SWITCH_NAME, CB_SWITCH_27, CB_FEATURE_ACTIVE}, - {"SWITCH-28", CB_SWITCH_NAME, CB_SWITCH_28, CB_FEATURE_ACTIVE}, - {"SWITCH-29", CB_SWITCH_NAME, CB_SWITCH_29, CB_FEATURE_ACTIVE}, - {"SWITCH-30", CB_SWITCH_NAME, CB_SWITCH_30, CB_FEATURE_ACTIVE}, - {"SWITCH-31", CB_SWITCH_NAME, CB_SWITCH_31, CB_FEATURE_ACTIVE}, - {"SWITCH-32", CB_SWITCH_NAME, CB_SWITCH_32, CB_FEATURE_ACTIVE}, - {"SWITCH-33", CB_SWITCH_NAME, CB_SWITCH_33, CB_FEATURE_ACTIVE}, - {"SWITCH-34", CB_SWITCH_NAME, CB_SWITCH_34, CB_FEATURE_ACTIVE}, - {"SWITCH-35", CB_SWITCH_NAME, CB_SWITCH_35, CB_FEATURE_ACTIVE}, - {"SWITCH-36", CB_SWITCH_NAME, CB_SWITCH_36, CB_FEATURE_ACTIVE}, - {"SW0", CB_SWITCH_NAME, CB_SWITCH_0, CB_FEATURE_DISABLED}, - {"SW1", CB_SWITCH_NAME, CB_SWITCH_1, CB_FEATURE_DISABLED}, - {"SW2", CB_SWITCH_NAME, CB_SWITCH_2, CB_FEATURE_DISABLED}, - {"SW3", CB_SWITCH_NAME, CB_SWITCH_3, CB_FEATURE_DISABLED}, - {"SW4", CB_SWITCH_NAME, CB_SWITCH_4, CB_FEATURE_DISABLED}, - {"SW5", CB_SWITCH_NAME, CB_SWITCH_5, CB_FEATURE_DISABLED}, - {"SW6", CB_SWITCH_NAME, CB_SWITCH_6, CB_FEATURE_DISABLED}, - {"SW7", CB_SWITCH_NAME, CB_SWITCH_7, CB_FEATURE_DISABLED}, - {"SW8", CB_SWITCH_NAME, CB_SWITCH_8, CB_FEATURE_DISABLED}, - {"SW9", CB_SWITCH_NAME, CB_SWITCH_9, CB_FEATURE_DISABLED}, - {"SW10", CB_SWITCH_NAME, CB_SWITCH_10, CB_FEATURE_DISABLED}, - {"SW11", CB_SWITCH_NAME, CB_SWITCH_11, CB_FEATURE_DISABLED}, - {"SW12", CB_SWITCH_NAME, CB_SWITCH_12, CB_FEATURE_DISABLED}, - {"SW13", CB_SWITCH_NAME, CB_SWITCH_13, CB_FEATURE_DISABLED}, - {"SW14", CB_SWITCH_NAME, CB_SWITCH_14, CB_FEATURE_DISABLED}, - {"SW15", CB_SWITCH_NAME, CB_SWITCH_15, CB_FEATURE_DISABLED}, - {"SWITCH 0", CB_SWITCH_NAME, CB_SWITCH_0, CB_FEATURE_DISABLED}, - {"SWITCH 1", CB_SWITCH_NAME, CB_SWITCH_1, CB_FEATURE_DISABLED}, - {"SWITCH 2", CB_SWITCH_NAME, CB_SWITCH_2, CB_FEATURE_DISABLED}, - {"SWITCH 3", CB_SWITCH_NAME, CB_SWITCH_3, CB_FEATURE_DISABLED}, - {"SWITCH 4", CB_SWITCH_NAME, CB_SWITCH_4, CB_FEATURE_DISABLED}, - {"SWITCH 5", CB_SWITCH_NAME, CB_SWITCH_5, CB_FEATURE_DISABLED}, - {"SWITCH 6", CB_SWITCH_NAME, CB_SWITCH_6, CB_FEATURE_DISABLED}, - {"SWITCH 7", CB_SWITCH_NAME, CB_SWITCH_7, CB_FEATURE_DISABLED}, - {"SWITCH 8", CB_SWITCH_NAME, CB_SWITCH_8, CB_FEATURE_DISABLED}, - {"SWITCH 9", CB_SWITCH_NAME, CB_SWITCH_9, CB_FEATURE_DISABLED}, - {"SWITCH 10", CB_SWITCH_NAME, CB_SWITCH_10, CB_FEATURE_DISABLED}, - {"SWITCH 11", CB_SWITCH_NAME, CB_SWITCH_11, CB_FEATURE_DISABLED}, - {"SWITCH 12", CB_SWITCH_NAME, CB_SWITCH_12, CB_FEATURE_DISABLED}, - {"SWITCH 13", CB_SWITCH_NAME, CB_SWITCH_13, CB_FEATURE_DISABLED}, - {"SWITCH 14", CB_SWITCH_NAME, CB_SWITCH_14, CB_FEATURE_DISABLED}, - {"SWITCH 15", CB_SWITCH_NAME, CB_SWITCH_15, CB_FEATURE_DISABLED}, - {"SWITCH 16", CB_SWITCH_NAME, CB_SWITCH_16, CB_FEATURE_DISABLED}, - {"SWITCH 17", CB_SWITCH_NAME, CB_SWITCH_17, CB_FEATURE_DISABLED}, - {"SWITCH 18", CB_SWITCH_NAME, CB_SWITCH_18, CB_FEATURE_DISABLED}, - {"SWITCH 19", CB_SWITCH_NAME, CB_SWITCH_19, CB_FEATURE_DISABLED}, - {"SWITCH 20", CB_SWITCH_NAME, CB_SWITCH_20, CB_FEATURE_DISABLED}, - {"SWITCH 21", CB_SWITCH_NAME, CB_SWITCH_21, CB_FEATURE_DISABLED}, - {"SWITCH 22", CB_SWITCH_NAME, CB_SWITCH_22, CB_FEATURE_DISABLED}, - {"SWITCH 23", CB_SWITCH_NAME, CB_SWITCH_23, CB_FEATURE_DISABLED}, - {"SWITCH 24", CB_SWITCH_NAME, CB_SWITCH_24, CB_FEATURE_DISABLED}, - {"SWITCH 25", CB_SWITCH_NAME, CB_SWITCH_25, CB_FEATURE_DISABLED}, - {"SWITCH 26", CB_SWITCH_NAME, CB_SWITCH_26, CB_FEATURE_DISABLED}, - {"SWITCH A", CB_SWITCH_NAME, CB_SWITCH_1, CB_FEATURE_DISABLED}, - {"SWITCH B", CB_SWITCH_NAME, CB_SWITCH_2, CB_FEATURE_DISABLED}, - {"SWITCH C", CB_SWITCH_NAME, CB_SWITCH_3, CB_FEATURE_DISABLED}, - {"SWITCH D", CB_SWITCH_NAME, CB_SWITCH_4, CB_FEATURE_DISABLED}, - {"SWITCH E", CB_SWITCH_NAME, CB_SWITCH_5, CB_FEATURE_DISABLED}, - {"SWITCH F", CB_SWITCH_NAME, CB_SWITCH_6, CB_FEATURE_DISABLED}, - {"SWITCH G", CB_SWITCH_NAME, CB_SWITCH_7, CB_FEATURE_DISABLED}, - {"SWITCH H", CB_SWITCH_NAME, CB_SWITCH_8, CB_FEATURE_DISABLED}, - {"SWITCH I", CB_SWITCH_NAME, CB_SWITCH_9, CB_FEATURE_DISABLED}, - {"SWITCH J", CB_SWITCH_NAME, CB_SWITCH_10, CB_FEATURE_DISABLED}, - {"SWITCH K", CB_SWITCH_NAME, CB_SWITCH_11, CB_FEATURE_DISABLED}, - {"SWITCH L", CB_SWITCH_NAME, CB_SWITCH_12, CB_FEATURE_DISABLED}, - {"SWITCH M", CB_SWITCH_NAME, CB_SWITCH_13, CB_FEATURE_DISABLED}, - {"SWITCH N", CB_SWITCH_NAME, CB_SWITCH_14, CB_FEATURE_DISABLED}, - {"SWITCH O", CB_SWITCH_NAME, CB_SWITCH_15, CB_FEATURE_DISABLED}, - {"SWITCH P", CB_SWITCH_NAME, CB_SWITCH_16, CB_FEATURE_DISABLED}, - {"SWITCH Q", CB_SWITCH_NAME, CB_SWITCH_17, CB_FEATURE_DISABLED}, - {"SWITCH R", CB_SWITCH_NAME, CB_SWITCH_18, CB_FEATURE_DISABLED}, - {"SWITCH S", CB_SWITCH_NAME, CB_SWITCH_19, CB_FEATURE_DISABLED}, - {"SWITCH T", CB_SWITCH_NAME, CB_SWITCH_20, CB_FEATURE_DISABLED}, - {"SWITCH U", CB_SWITCH_NAME, CB_SWITCH_21, CB_FEATURE_DISABLED}, - {"SWITCH V", CB_SWITCH_NAME, CB_SWITCH_22, CB_FEATURE_DISABLED}, - {"SWITCH W", CB_SWITCH_NAME, CB_SWITCH_23, CB_FEATURE_DISABLED}, - {"SWITCH X", CB_SWITCH_NAME, CB_SWITCH_24, CB_FEATURE_DISABLED}, - {"SWITCH Y", CB_SWITCH_NAME, CB_SWITCH_25, CB_FEATURE_DISABLED}, - {"SWITCH Z", CB_SWITCH_NAME, CB_SWITCH_26, CB_FEATURE_DISABLED}, - {"UPSI-0", CB_SWITCH_NAME, CB_SWITCH_0, CB_FEATURE_DISABLED}, - {"UPSI-1", CB_SWITCH_NAME, CB_SWITCH_1, CB_FEATURE_DISABLED}, - {"UPSI-2", CB_SWITCH_NAME, CB_SWITCH_2, CB_FEATURE_DISABLED}, - {"UPSI-3", CB_SWITCH_NAME, CB_SWITCH_3, CB_FEATURE_DISABLED}, - {"UPSI-4", CB_SWITCH_NAME, CB_SWITCH_4, CB_FEATURE_DISABLED}, - {"UPSI-5", CB_SWITCH_NAME, CB_SWITCH_5, CB_FEATURE_DISABLED}, - {"UPSI-6", CB_SWITCH_NAME, CB_SWITCH_6, CB_FEATURE_DISABLED}, - {"UPSI-7", CB_SWITCH_NAME, CB_SWITCH_7, CB_FEATURE_DISABLED}, - {"UPSI-8", CB_SWITCH_NAME, CB_SWITCH_8, CB_FEATURE_DISABLED}, - /* TO-DO: Figure out how TSW switches differ from USW switches and add them. */ - {"USW-0", CB_SWITCH_NAME, CB_SWITCH_0, CB_FEATURE_DISABLED}, - {"USW-1", CB_SWITCH_NAME, CB_SWITCH_1, CB_FEATURE_DISABLED}, - {"USW-2", CB_SWITCH_NAME, CB_SWITCH_2, CB_FEATURE_DISABLED}, - {"USW-3", CB_SWITCH_NAME, CB_SWITCH_3, CB_FEATURE_DISABLED}, - {"USW-4", CB_SWITCH_NAME, CB_SWITCH_4, CB_FEATURE_DISABLED}, - {"USW-5", CB_SWITCH_NAME, CB_SWITCH_5, CB_FEATURE_DISABLED}, - {"USW-6", CB_SWITCH_NAME, CB_SWITCH_6, CB_FEATURE_DISABLED}, - {"USW-7", CB_SWITCH_NAME, CB_SWITCH_7, CB_FEATURE_DISABLED}, - {"USW-8", CB_SWITCH_NAME, CB_SWITCH_8, CB_FEATURE_DISABLED}, - {"USW-9", CB_SWITCH_NAME, CB_SWITCH_9, CB_FEATURE_DISABLED}, - {"USW-10", CB_SWITCH_NAME, CB_SWITCH_10, CB_FEATURE_DISABLED}, - {"USW-11", CB_SWITCH_NAME, CB_SWITCH_11, CB_FEATURE_DISABLED}, - {"USW-12", CB_SWITCH_NAME, CB_SWITCH_12, CB_FEATURE_DISABLED}, - {"USW-13", CB_SWITCH_NAME, CB_SWITCH_13, CB_FEATURE_DISABLED}, - {"USW-14", CB_SWITCH_NAME, CB_SWITCH_14, CB_FEATURE_DISABLED}, - {"USW-15", CB_SWITCH_NAME, CB_SWITCH_15, CB_FEATURE_DISABLED}, - {"USW-16", CB_SWITCH_NAME, CB_SWITCH_16, CB_FEATURE_DISABLED}, - {"USW-17", CB_SWITCH_NAME, CB_SWITCH_17, CB_FEATURE_DISABLED}, - {"USW-18", CB_SWITCH_NAME, CB_SWITCH_18, CB_FEATURE_DISABLED}, - {"USW-19", CB_SWITCH_NAME, CB_SWITCH_19, CB_FEATURE_DISABLED}, - {"USW-20", CB_SWITCH_NAME, CB_SWITCH_20, CB_FEATURE_DISABLED}, - {"USW-21", CB_SWITCH_NAME, CB_SWITCH_21, CB_FEATURE_DISABLED}, - {"USW-22", CB_SWITCH_NAME, CB_SWITCH_22, CB_FEATURE_DISABLED}, - {"USW-23", CB_SWITCH_NAME, CB_SWITCH_23, CB_FEATURE_DISABLED}, - {"USW-24", CB_SWITCH_NAME, CB_SWITCH_24, CB_FEATURE_DISABLED}, - {"USW-25", CB_SWITCH_NAME, CB_SWITCH_25, CB_FEATURE_DISABLED}, - {"USW-26", CB_SWITCH_NAME, CB_SWITCH_26, CB_FEATURE_DISABLED}, - {"USW-27", CB_SWITCH_NAME, CB_SWITCH_27, CB_FEATURE_DISABLED}, - {"USW-28", CB_SWITCH_NAME, CB_SWITCH_28, CB_FEATURE_DISABLED}, - {"USW-29", CB_SWITCH_NAME, CB_SWITCH_29, CB_FEATURE_DISABLED}, - {"USW-30", CB_SWITCH_NAME, CB_SWITCH_30, CB_FEATURE_DISABLED}, - {"USW-31", CB_SWITCH_NAME, CB_SWITCH_31, CB_FEATURE_DISABLED} -}; - -#define SYSTEM_TAB_SIZE sizeof(system_name_table) / sizeof(struct system_name_struct) - -static struct system_name_struct *lookup_system_name (const char *, const int); - -/* Reserved word table, note: this list is sorted on startup in - (initialize_reserved_words_if_needed), no need to care for EBCDIC */ -/* Description */ - -/* Word # Statement has terminator # Is context sensitive (only for printing) - # Token # Special context set # Special context test */ - -static struct cobc_reserved default_reserved_words[] = { - { "3-D", 0, 1, THREEDIMENSIONAL, /* ACU extension */ - 0, CB_CS_GRAPHICAL_CONTROL | CB_CS_INQUIRE_MODIFY - }, - { "ABSENT", 0, 0, ABSENT, /* IBM RW */ - 0, 0 - }, - { "ACCEPT", 1, 0, ACCEPT, /* 2002 */ - CB_CS_ACCEPT, 0 - }, - { "ACCESS", 0, 0, ACCESS, /* 2002 */ - 0, 0 - }, - { "ACTION", 0, 1, ACTION, /* ACU extension */ - 0, CB_CS_GRAPHICAL_CONTROL | CB_CS_INQUIRE_MODIFY - }, - { "ACTIVE-CLASS", 0, 0, -1, /* 2002 */ - 0, 0 - }, - { "ACTIVE-X", 1, 1, ACTIVEX, /* ACU extension, very unlikely to be implemented */ - CB_CS_GRAPHICAL_CONTROL, CB_CS_DISPLAY | CB_CS_SCREEN - }, - { "ACTUAL", 0, 1, ACTUAL, /* OS/VS extension */ - 0, CB_CS_SELECT - }, - { "ADD", 1, 0, ADD, /* 2002 */ - 0, 0 - }, - { "ADDRESS", 0, 0, ADDRESS, /* 2002 */ - 0, 0 - }, - { "ADJUSTABLE-COLUMNS", 0, 1, ADJUSTABLE_COLUMNS, /* ACU extension */ - 0, CB_CS_GRAPHICAL_CONTROL | CB_CS_INQUIRE_MODIFY - }, - { "ADVANCING", 0, 0, ADVANCING, /* 2002 */ - 0, 0 - }, - { "AFTER", 0, 0, AFTER, /* 2002 */ - 0, 0 - }, - { "ALIGNMENT", 0, 1, ALIGNMENT, /* ACU extension */ - 0, CB_CS_GRAPHICAL_CONTROL | CB_CS_INQUIRE_MODIFY - }, - { "ALIGNED", 0, 0, -1, /* 2002 */ - 0, 0 - }, - { "ALL", 0, 0, ALL, /* 2002 */ - 0, 0 - }, - { "ALLOCATE", 0, 0, ALLOCATE, /* 2002 */ - CB_CS_ALLOCATE, 0 - }, - { "ALLOWING", 0, 1, ALLOWING, /* ACU extension */ - 0, CB_CS_OPEN - }, - { "ALPHABET", 1, 0, ALPHABET, /* 2002 */ - CB_CS_ALPHABET, 0 - }, - { "ALPHABETIC", 0, 0, ALPHABETIC, /* 2002 */ - 0, 0 - }, - { "ALPHABETIC-LOWER", 0, 0, ALPHABETIC_LOWER, /* 2002 */ - 0, 0 - }, - { "ALPHABETIC-UPPER", 0, 0, ALPHABETIC_UPPER, /* 2002 */ - 0, 0 - }, - { "ALPHANUMERIC", 0, 0, ALPHANUMERIC, /* 2002 */ - 0, 0 - }, - { "ALPHANUMERIC-EDITED", 0, 0, ALPHANUMERIC_EDITED, /* 2002 */ - 0, 0 - }, - { "ALSO", 0, 0, ALSO, /* 2002 */ - 0, 0 - }, - { "ALTER", 0, 0, ALTER, /* 85 */ - 0, 0 - }, - { "ALTERNATE", 0, 0, ALTERNATE, /* 2002 */ - 0, 0 - }, - { "AND", 0, 0, AND, /* 2002 */ - 0, 0 - }, - { "ANY", 0, 0, ANY, /* 2002 */ - 0, 0 - }, - { "ANYCASE", 0, 0, -1, /* 2002 */ - 0, 0 - }, - { "APPLY", 0, 1, APPLY, /* 202x pending (C/S) */ - 0, CB_CS_I_O_CONTROL - }, - { "ARE", 0, 0, ARE, /* 2002 */ - 0, 0 - }, - { "AREA", 0, 0, AREA, /* 2002 */ - 0, 0 - }, - { "AREAS", 0, 0, AREA, /* 2002 */ - 0, 0 - }, - { "ARGUMENT-NUMBER", 0, 0, ARGUMENT_NUMBER, /* Extension */ - 0, 0 - }, - { "ARGUMENT-VALUE", 0, 0, ARGUMENT_VALUE, /* Extension */ - 0, 0 - }, - { "ARITHMETIC", 0, 1, ARITHMETIC, /* 2002 (C/S) */ - 0, CB_CS_OPTIONS - }, - { "AS", 0, 0, AS, /* 2002 */ - 0, 0 - }, - { "ASCENDING", 0, 0, ASCENDING, /* 2002 */ - 0, 0 - }, - { "ASCII", 0, 1, ASCII, /* Extension */ - 0, CB_CS_ALPHABET - }, - { "ASSIGN", 1, 0, ASSIGN, /* 2002 */ - CB_CS_ASSIGN, 0 - }, - { "AT", 0, 0, AT, /* 2002 */ - 0, 0 - }, - { "ATTRIBUTE", 0, 1, ATTRIBUTE, /* 2002 (C/S) */ - 0, CB_CS_SET | CB_CS_XML_GENERATE - }, - { "ATTRIBUTES", 0, 1, ATTRIBUTES, /* IBM extension */ - 0, CB_CS_XML_GENERATE - }, - { "AUTO", 0, 1, AUTO, /* 2002 (C/S), extension */ - 0, CB_CS_ACCEPT | CB_CS_SCREEN | CB_CS_CALL - }, - { "AUTO-DECIMAL", 0, 1, AUTO_DECIMAL, /* ACU extension */ - 0, CB_CS_GRAPHICAL_CONTROL | CB_CS_INQUIRE_MODIFY - }, - { "AUTO-SPIN", 0, 1, AUTO_SPIN, /* ACU extension */ - 0, CB_CS_GRAPHICAL_CONTROL | CB_CS_INQUIRE_MODIFY - }, - { "AUTOMATIC", 0, 0, AUTOMATIC, /* 2002 */ - 0, 0 - /* FIXME: 2014 Context-sensitive to LOCK MODE clause */ - }, - { "AWAY-FROM-ZERO", 0, 1, AWAY_FROM_ZERO, /* 2014 (C/S) */ - 0, CB_CS_ROUNDED - }, - { "B-AND", 0, 0, -1, /* 2002 */ - 0, 0 - }, - { "B-NOT", 0, 0, -1, /* 2002 */ - 0, 0 - }, - { "B-OR", 0, 0, -1, /* 2002 */ - 0, 0 - }, - { "B-XOR", 0, 0, -1, /* 2002 */ - 0, 0 - }, - { "BACKGROUND-COLOR", 0, 1, BACKGROUND_COLOR, /* 2002 (C/S) */ - 0, CB_CS_ACCEPT | CB_CS_DISPLAY | CB_CS_SCREEN - }, - { "BACKGROUND-HIGH", 0, 0, BACKGROUND_HIGH, /* ACU extension */ - 0, 0 - }, - { "BACKGROUND-LOW", 0, 0, BACKGROUND_LOW, /* ACU extension */ - 0, 0 - }, - { "BACKGROUND-STANDARD", 0, 0, BACKGROUND_STANDARD, /* ACU extension */ - 0, 0 - }, - { "BAR", 1, 1, BAR, /* ACU extension */ - CB_CS_GRAPHICAL_CONTROL, CB_CS_DISPLAY | CB_CS_SCREEN - }, - { "BASED", 0, 0, BASED, /* 2002 */ - 0, 0 - }, - { "BEFORE", 0, 0, BEFORE, /* 2002 */ - 0, 0 - }, - { "BELL", 0, 1, BELL, /* 2002 (C/S) */ - 0, CB_CS_ACCEPT | CB_CS_DISPLAY | CB_CS_SCREEN | CB_CS_SET - }, - { "BINARY", 0, 0, BINARY, /* 2002 */ - 0, 0 - }, - { "BINARY-C-LONG", 0, 0, BINARY_C_LONG, /* Extension */ - 0, 0 - }, - { "BINARY-CHAR", 0, 0, BINARY_CHAR, /* 2002 */ - 0, 0 - }, - { "BINARY-DOUBLE", 0, 0, BINARY_DOUBLE, /* 2002 */ - 0, 0 - }, - { "BINARY-LONG", 0, 0, BINARY_LONG, /* 2002 */ - 0, 0 - }, - { "BINARY-SEQUENTIAL", 0, 1, BINARY_SEQUENTIAL, /* Extension */ - 0, CB_CS_DELIMITER - }, - { "BINARY-SHORT", 0, 0, BINARY_SHORT, /* 2002 */ - 0, 0 - }, - { "BIT", 0, 0, BIT, /* 2002 */ - 0, 0 - }, - { "BITMAP", 1, 1, BITMAP, /* ACU extension */ - CB_CS_GRAPHICAL_CONTROL, CB_CS_DISPLAY | CB_CS_SCREEN - }, - { "BITMAP-END", 0, 1, BITMAP_END, /* ACU extension */ - 0, CB_CS_GRAPHICAL_CONTROL | CB_CS_INQUIRE_MODIFY - }, - { "BITMAP-HANDLE", 0, 1, BITMAP_HANDLE, /* ACU extension */ - 0, CB_CS_GRAPHICAL_CONTROL | CB_CS_INQUIRE_MODIFY - }, - { "BITMAP-NUMBER", 0, 1, BITMAP_NUMBER, /* ACU extension */ - 0, CB_CS_GRAPHICAL_CONTROL | CB_CS_INQUIRE_MODIFY - }, - { "BITMAP-START", 0, 1, BITMAP_START, /* ACU extension */ - 0, CB_CS_GRAPHICAL_CONTROL | CB_CS_INQUIRE_MODIFY - }, - { "BITMAP-TIMER", 0, 1, BITMAP_TIMER, /* ACU extension */ - 0, CB_CS_GRAPHICAL_CONTROL | CB_CS_INQUIRE_MODIFY - }, - { "BITMAP-TRAILING", 0, 1, BITMAP_TRAILING, /* ACU extension */ - 0, CB_CS_GRAPHICAL_CONTROL | CB_CS_INQUIRE_MODIFY - }, - { "BITMAP-TRANSPARENT-COLOR", 0, 1, BITMAP_TRANSPARENT_COLOR, /* ACU extension */ - 0, CB_CS_GRAPHICAL_CONTROL | CB_CS_INQUIRE_MODIFY - }, - { "BITMAP-WIDTH", 0, 1, BITMAP_WIDTH, /* ACU extension */ - 0, CB_CS_GRAPHICAL_CONTROL | CB_CS_INQUIRE_MODIFY - }, - { "BLANK", 0, 0, BLANK, /* 2002 */ - 0, 0 - }, - { "BLINK", 0, 1, BLINK, /* 2002 (C/S) */ - 0, CB_CS_ACCEPT | CB_CS_DISPLAY | CB_CS_SCREEN | CB_CS_SET - }, - { "BLOCK", 0, 0, BLOCK, /* 2002 */ - 0, 0 - }, - { "BOOLEAN", 0, 0, -1, /* 2002 */ - 0, 0 - }, - { "BOTTOM", 0, 0, BOTTOM, /* 2002 */ - 0, 0 - }, - { "BOX", 0, 1, BOX, /* ACU extension */ - 0, CB_CS_DISPLAY - }, - { "BOXED", 0, 1, BOXED, /* ACU extension */ - 0, CB_CS_DISPLAY - }, - { "BULK-ADDITION", 0, 1, BULK_ADDITION, /* ACU extension */ - 0, CB_CS_OPEN - }, - { "BUSY", 0, 1, BUSY, /* ACU extension */ - 0, CB_CS_GRAPHICAL_CONTROL | CB_CS_INQUIRE_MODIFY - }, - { "BUTTONS", 0, 1, BUTTONS, /* ACU extension */ - 0, CB_CS_GRAPHICAL_CONTROL | CB_CS_INQUIRE_MODIFY - }, - { "BY", 0, 0, BY, /* 2002 */ - 0, 0 - }, - { "BYTE-LENGTH", 0, 1, BYTE_LENGTH, /* 2002 (C/S) */ - 0, CB_CS_CONSTANT - }, - { "C", 0, 1, C, /* Extension: implicit defined CALL-CONVENTION */ - 0, CB_CS_CALL | CB_CS_OPTIONS - }, - { "CALENDAR-FONT", 0, 1, CALENDAR_FONT, /* ACU extension */ - 0, CB_CS_GRAPHICAL_CONTROL | CB_CS_INQUIRE_MODIFY - }, - { "CALL", 1, 0, CALL, /* 2002 */ - CB_CS_CALL, 0 - }, - { "CANCEL", 0, 0, CANCEL, /* 2002 */ - 0, 0 - }, - { "CANCEL-BUTTON", 0, 1, CANCEL_BUTTON, /* ACU extension */ - 0, CB_CS_GRAPHICAL_CONTROL | CB_CS_INQUIRE_MODIFY - }, - { "CAPACITY", 0, 1, CAPACITY, /* 2014 */ - 0, CB_CS_OCCURS - }, - { "CARD-PUNCH", 0, 1, CARD_PUNCH, /* Extension */ - 0, CB_CS_ASSIGN - }, - { "CARD-READER", 0, 1, CARD_READER, /* Extension */ - 0, CB_CS_ASSIGN - }, - { "CASSETTE", 0, 1, CASSETTE, /* Extension */ - 0, CB_CS_ASSIGN - }, - { "CCOL", 0, 1, CCOL, /* ACU extension */ - 0, CB_CS_GRAPHICAL_CONTROL | CB_CS_INQUIRE_MODIFY - }, - { "CD", 0, 0, CD, /* Communication Section */ - 0, 0 - }, - { "CELL", 0, 1, CELL, /* ACU extension */ - 0, CB_CS_GRAPHICAL_CONTROL | CB_CS_INQUIRE_MODIFY - }, - { "CELL-COLOR", 0, 1, CELL_COLOR, /* ACU extension */ - 0, CB_CS_GRAPHICAL_CONTROL | CB_CS_INQUIRE_MODIFY - }, - { "CELL-DATA", 0, 1, CELL_DATA, /* ACU extension */ - 0, CB_CS_GRAPHICAL_CONTROL | CB_CS_INQUIRE_MODIFY - }, - { "CELL-FONT", 0, 1, CELL_FONT, /* ACU extension */ - 0, CB_CS_GRAPHICAL_CONTROL | CB_CS_INQUIRE_MODIFY - }, - { "CELL-PROTECTION", 0, 1, CELL_PROTECTION, /* ACU extension */ - 0, CB_CS_GRAPHICAL_CONTROL | CB_CS_INQUIRE_MODIFY - }, - { "CENTER", 0, 1, CENTER, /* 2002 (C/S) */ - 0, 0 - /* FIXME + Check: 2014 Context-sensitive to COLUMN clause */ - }, - { "CENTERED", 0, 1, CENTERED, /* ACU extension */ - 0, CB_CS_DISPLAY - }, - { "CENTERED-HEADINGS", 0, 1, CENTERED_HEADINGS, /* ACU extension */ - 0, CB_CS_GRAPHICAL_CONTROL | CB_CS_INQUIRE_MODIFY - }, - { "CENTURY-DATE", 0, 1, CENTURY_DATE, /* ACU extension */ - 0, CB_CS_GRAPHICAL_CONTROL | CB_CS_INQUIRE_MODIFY - }, - { "CF", 0, 0, CF, /* 2002 */ - 0, 0 - }, - { "CH", 0, 0, CH, /* 2002 */ - 0, 0 - }, - { "CHAIN", 0, 0, -1, /* Extension */ - 0, 0 - }, - { "CHAINING", 0, 0, CHAINING, /* Extension */ - 0, 0 - }, - { "CHARACTER", 0, 0, CHARACTER, /* 2002 */ - 0, 0 - }, - { "CHARACTERS", 0, 0, CHARACTERS, /* 85 (OBJECT-COMPUTER) 2002 */ - 0, 0 - }, - { "CHECK-BOX", 1, 1, CHECK_BOX, /* ACU extension */ - CB_CS_GRAPHICAL_CONTROL, CB_CS_DISPLAY | CB_CS_SCREEN - }, - { "CLASS", 0, 0, CLASS, /* 2002 */ - 0, 0 - }, - { "CLASS-ID", 0, 0, -1, /* 2002 */ - 0, 0 - }, - { "CLASSIFICATION", 0, 1, CLASSIFICATION, /* 2002 (C/S) */ - 0, 0 - /* FIXME + Check: 2014 Context-sensitive to OBJECT-COMPUTER paragraph */ - }, - { "CLEAR-SELECTION", 0, 1, CLEAR_SELECTION, /* ACU extension */ - 0, CB_CS_GRAPHICAL_CONTROL | CB_CS_INQUIRE_MODIFY - }, - { "CLINE", 0, 1, CLINE, /* ACU extension */ - 0, CB_CS_GRAPHICAL_CONTROL | CB_CS_INQUIRE_MODIFY - }, - { "CLINES", 0, 1, CLINES, /* ACU extension */ - 0, CB_CS_GRAPHICAL_CONTROL | CB_CS_INQUIRE_MODIFY - }, - { "CLOSE", 0, 0, CLOSE, /* 2002 */ - 0, 0 - }, - { "COBOL", 0, 1, COBOL, /* 2002 - Extension: implicit defined CALL-CONVENTION */ - 0, CB_CS_CALL | CB_CS_OPTIONS - }, - { "CODE", 0, 0, CODE, /* 2002 */ - 0, 0 - }, - { "CODE-SET", 0, 0, CODE_SET, /* 2002 */ - 0, 0 - }, - { "COL", 0, 0, COL, /* 2002 */ - 0, 0 - }, - { "COLLATING", 0, 0, COLLATING, /* 2002 */ - 0, 0 - }, - { "COLOR", 0, 0, COLOR, /* Extension */ - 0, 0 - }, - { "COLORS", 0, 1, COLORS, /* ACU extension */ - 0, CB_CS_GRAPHICAL_CONTROL | CB_CS_INQUIRE_MODIFY - }, - { "COLS", 0, 0, COLS, /* 2002 */ - 0, 0 - }, - { "COLUMN", 0, 0, COLUMN, /* 2002 */ - 0, 0 - }, - { "COLUMN-COLOR", 0, 1, COLUMN_COLOR, /* ACU extension */ - 0, CB_CS_GRAPHICAL_CONTROL | CB_CS_INQUIRE_MODIFY - }, - { "COLUMN-DIVIDERS", 0, 1, COLUMN_DIVIDERS, /* ACU extension */ - 0, CB_CS_GRAPHICAL_CONTROL | CB_CS_INQUIRE_MODIFY - }, - { "COLUMN-FONT", 0, 1, COLUMN_FONT, /* ACU extension */ - 0, CB_CS_GRAPHICAL_CONTROL | CB_CS_INQUIRE_MODIFY - }, - { "COLUMN-HEADINGS", 0, 1, COLUMN_HEADINGS, /* ACU extension */ - 0, CB_CS_GRAPHICAL_CONTROL | CB_CS_INQUIRE_MODIFY - }, - { "COLUMN-PROTECTION", 0, 1, COLUMN_PROTECTION, /* ACU extension */ - 0, CB_CS_GRAPHICAL_CONTROL | CB_CS_INQUIRE_MODIFY - }, - { "COLUMNS", 0, 0, COLUMNS, /* 2002 */ - 0, 0 - }, - { "COMBO-BOX", 1, 1, COMBO_BOX, /* ACU extension */ - CB_CS_GRAPHICAL_CONTROL, CB_CS_DISPLAY | CB_CS_SCREEN - }, - { "COMMA", 0, 0, COMMA, /* 2002 */ - 0, 0 - }, - { "COMMAND-LINE", 0, 0, COMMAND_LINE, /* Extension */ - 0, 0 - }, - { "COMMIT", 0, 0, COMMIT, /* Extension */ - 0, 0 - }, - { "COMMON", 0, 0, COMMON, /* 2002 */ - 0, 0 - }, - { "COMMUNICATION", 0, 0, COMMUNICATION, /* Communication Section */ - 0, 0 - }, - { "COMP", 0, 0, COMP, /* 2002 */ - 0, 0 - }, - { "COMP-0", 0, 0, COMP_0, /* Extension */ - 0, 0 - }, - { "COMP-1", 0, 0, COMP_1, /* Extension */ - 0, 0 - }, - { "COMP-2", 0, 0, COMP_2, /* Extension */ - 0, 0 - }, - { "COMP-3", 0, 0, COMP_3, /* Extension */ - 0, 0 - }, - { "COMP-4", 0, 0, COMP_4, /* Extension */ - 0, 0 - }, - { "COMP-5", 0, 0, COMP_5, /* Extension */ - 0, 0 - }, - { "COMP-6", 0, 0, COMP_6, /* Extension */ - 0, 0 - }, - { "COMP-N", 0, 0, COMP_N, /* Extension */ - 0, 0 - }, - { "COMP-X", 0, 0, COMP_X, /* Extension */ - 0, 0 - }, - { "COMPUTATIONAL", 0, 0, COMP, /* 2002 */ - 0, 0 - }, - { "COMPUTATIONAL-0", 0, 0, COMP_0, /* Extension */ - 0, 0 - }, - { "COMPUTATIONAL-1", 0, 0, COMP_1, /* Extension */ - 0, 0 - }, - { "COMPUTATIONAL-2", 0, 0, COMP_2, /* Extension */ - 0, 0 - }, - { "COMPUTATIONAL-3", 0, 0, COMP_3, /* Extension */ - 0, 0 - }, - { "COMPUTATIONAL-4", 0, 0, COMP_4, /* Extension */ - 0, 0 - }, - { "COMPUTATIONAL-5", 0, 0, COMP_5, /* Extension */ - 0, 0 - }, - { "COMPUTATIONAL-6", 0, 0, COMP_6, /* Extension */ - 0, 0 - }, - { "COMPUTATIONAL-N", 0, 0, COMP_N, /* Extension */ - 0, 0 - }, - { "COMPUTATIONAL-X", 0, 0, COMP_X, /* Extension */ - 0, 0 - }, - { "COMPUTE", 1, 0, COMPUTE, /* 2002 */ - 0, 0 - }, - { "CONDITION", 0, 0, CONDITION, /* 2002 */ - 0, 0 - }, - { "CONFIGURATION", 0, 0, CONFIGURATION, /* 2002 */ - 0, 0 - }, - { "CONSTANT", 0, 0, CONSTANT, /* 2002 */ - CB_CS_CONSTANT, 0 - }, - { "CONTAINS", 0, 0, CONTAINS, /* 2002 */ - 0, 0 - }, - { "CONTENT", 0, 0, CONTENT, /* 2002 */ - 0, 0 - }, - { "CONTINUE", 0, 0, CONTINUE, /* 2002 */ - 0, 0 - }, - { "CONTROL", 0, 0, CONTROL, /* 2002 */ - 0, 0 - }, - { "CONTROLS", 0, 0, CONTROLS, /* 2002 */ - 0, 0 - }, - { "CONVERSION", 0, 1, CONVERSION, /* Extension */ - 0, CB_CS_ACCEPT - }, - { "CONVERTING", 0, 0, CONVERTING, /* 2002 */ - 0, 0 - }, - { "COPY", 0, 0, COPY, /* 2002 */ - 0, 0 - }, - { "COPY-SELECTION", 0, 1, COPY_SELECTION, /* ACU extension */ - 0, CB_CS_GRAPHICAL_CONTROL | CB_CS_INQUIRE_MODIFY - }, - { "CORE-INDEX", 0, 1, CORE_INDEX, /* OS/VS extension */ - 0, CB_CS_I_O_CONTROL - }, - { "CORR", 0, 0, CORRESPONDING, /* 2002 */ - 0, 0 - }, - { "CORRESPONDING", 0, 0, CORRESPONDING, /* 2002 */ - 0, 0 - }, - { "COUNT", 0, 0, COUNT, /* 2002 */ - 0, 0 - }, - { "CRT", 0, 0, CRT, /* 2002 */ - 0, 0 - }, - { "CRT-UNDER", 0, 0, CRT_UNDER, /* Extension */ - 0, 0 - }, - { "CSIZE", 0, 1, CSIZE, /* ACU extension */ - 0, CB_CS_GRAPHICAL_CONTROL | CB_CS_INQUIRE_MODIFY - }, - { "CURRENCY", 0, 0, CURRENCY, /* 2002 */ - 0, 0 - }, - { "CURSOR", 0, 0, CURSOR, /* 2002 */ - 0, 0 - }, - { "CURSOR-COL", 0, 1, CURSOR_COL, /* ACU extension */ - 0, CB_CS_GRAPHICAL_CONTROL | CB_CS_INQUIRE_MODIFY - }, - { "CURSOR-COLOR", 0, 1, CURSOR_COLOR, /* ACU extension */ - 0, CB_CS_GRAPHICAL_CONTROL | CB_CS_INQUIRE_MODIFY - }, - { "CURSOR-FRAME-WIDTH", 0, 1, CURSOR_FRAME_WIDTH, /* ACU extension */ - 0, CB_CS_GRAPHICAL_CONTROL | CB_CS_INQUIRE_MODIFY - }, - { "CURSOR-ROW", 0, 1, CURSOR_ROW, /* ACU extension */ - 0, CB_CS_GRAPHICAL_CONTROL | CB_CS_INQUIRE_MODIFY - }, - { "CURSOR-X", 0, 1, CURSOR_X, /* ACU extension */ - 0, CB_CS_GRAPHICAL_CONTROL | CB_CS_INQUIRE_MODIFY - }, - { "CURSOR-Y", 0, 1, CURSOR_Y, /* ACU extension */ - 0, CB_CS_GRAPHICAL_CONTROL | CB_CS_INQUIRE_MODIFY - }, - { "CUSTOM-PRINT-TEMPLATE", 0, 1, CUSTOM_PRINT_TEMPLATE, /* ACU extension */ - 0, CB_CS_GRAPHICAL_CONTROL | CB_CS_INQUIRE_MODIFY - }, - { "CYCLE", 0, 1, CYCLE, /* 2002 (C/S) */ - 0, CB_CS_EXIT - }, - { "CYL-INDEX", 0, 1, CYL_INDEX, /* OS/VS extension */ - 0, CB_CS_I_O_CONTROL - }, - { "CYL-OVERFLOW", 0, 1, CYL_OVERFLOW, /* OS/VS extension */ - 0, CB_CS_I_O_CONTROL - }, - { "DASHED", 0, 1, DASHED, /* ACU extension */ - 0, CB_CS_GRAPHICAL_CONTROL | CB_CS_INQUIRE_MODIFY - }, - { "DATA", 0, 0, DATA, /* 2002 */ - 0, 0 - }, - { "DATA-COLUMNS", 0, 1, DATA_COLUMNS, /* ACU extension */ - 0, CB_CS_GRAPHICAL_CONTROL | CB_CS_INQUIRE_MODIFY - }, - { "DATA-POINTER", 0, 0, -1, /* 2002 */ - 0, 0 - }, - { "DATA-TYPES", 0, 1, DATA_TYPES, /* ACU extension */ - 0, CB_CS_GRAPHICAL_CONTROL | CB_CS_INQUIRE_MODIFY - }, - { "DATE", 0, 0, DATE, /* 2002 */ - CB_CS_DATE, 0 - }, - { "DATE-ENTRY", 1, 1, DATE_ENTRY, /* ACU extension */ - CB_CS_GRAPHICAL_CONTROL, CB_CS_DISPLAY | CB_CS_SCREEN - }, - { "DAY", 0, 0, DAY, /* 2002 */ - CB_CS_DAY, 0 - }, - { "DAY-OF-WEEK", 0, 0, DAY_OF_WEEK, /* 2002 */ - 0, 0 - }, - { "DE", 0, 0, DE, /* 2002 */ - 0, 0 - }, - { "DEBUGGING", 0, 0, DEBUGGING, /* 2002 */ - 0, 0 - }, - { "DECIMAL-POINT", 0, 0, DECIMAL_POINT, /* 2002 */ - 0, 0 - }, - { "DECLARATIVES", 0, 0, DECLARATIVES, /* 2002 */ - 0, 0 - }, - { "DEFAULT", 0, 0, DEFAULT, /* 2002 */ - 0, 0 - }, - { "DEFAULT-BUTTON", 0, 1, DEFAULT_BUTTON, /* ACU extension */ - 0, CB_CS_GRAPHICAL_CONTROL | CB_CS_INQUIRE_MODIFY - }, - { "DEFAULT-FONT", 0, 0, DEFAULT_FONT, /* ACU extension */ - 0, 0 /* Checkme: likely context sensitive */ - }, - { "DELETE", 1, 0, DELETE, /* 2002 */ - 0, 0 - }, - { "DELIMITED", 0, 0, DELIMITED, /* 2002 */ - 0, 0 - }, - { "DELIMITER", 0, 0, DELIMITER, /* 2002 */ - CB_CS_DELIMITER, 0 - }, - { "DEPENDING", 0, 0, DEPENDING, /* 2002 */ - 0, 0 - }, - { "DESCENDING", 0, 0, DESCENDING, /* 2002 */ - 0, 0 - }, - { "DESTINATION", 0, 0, DESTINATION, /* 2002 */ - 0, 0 - }, - { "DESTROY", 0, 0, DESTROY, /* ACU extension */ - 0, 0 - }, - { "DETAIL", 0, 0, DETAIL, /* 2002 */ - 0, 0 - }, - { "DISABLE", 0, 0, DISABLE, /* Communication Section */ - 0, 0 - }, - { "DISC", 0, 1, DISC, /* Extension */ - 0, CB_CS_ASSIGN - }, - { "DISK", 0, 1, DISK, /* Extension */ - 0, CB_CS_ASSIGN - }, - { "DISP", 0, 1, DISP, /* OS/VS extension */ - 0, CB_CS_OPEN - }, - { "DISPLAY", 1, 0, DISPLAY, /* 2002 */ - 0, 0 - }, - { "DISPLAY-COLUMNS", 0, 1, DISPLAY_COLUMNS, /* ACU extension */ - 0, CB_CS_GRAPHICAL_CONTROL | CB_CS_INQUIRE_MODIFY - }, - { "DISPLAY-FORMAT", 0, 1, DISPLAY_FORMAT, /* ACU extension */ - 0, CB_CS_GRAPHICAL_CONTROL | CB_CS_INQUIRE_MODIFY - }, - { "DIVIDE", 1, 0, DIVIDE, /* 2002 */ - 0, 0 - }, - { "DIVIDER-COLOR", 0, 1, DIVIDER_COLOR, /* ACU extension */ - 0, CB_CS_GRAPHICAL_CONTROL | CB_CS_INQUIRE_MODIFY - }, - { "DIVIDERS", 0, 1, DIVIDERS, /* ACU extension */ - 0, CB_CS_GRAPHICAL_CONTROL | CB_CS_INQUIRE_MODIFY - }, - { "DIVISION", 0, 0, DIVISION, /* 2002 */ - 0, 0 - }, - { "DOTDASH", 0, 1, DOTDASH, /* ACU extension */ - 0, CB_CS_GRAPHICAL_CONTROL | CB_CS_INQUIRE_MODIFY - }, - { "DOTTED", 0, 1, DOTTED, /* ACU extension */ - 0, CB_CS_GRAPHICAL_CONTROL | CB_CS_INQUIRE_MODIFY - }, - { "DOUBLE", 0, 0, FLOAT_LONG, /* ACU extension */ - 0, 0 - }, - { "DOWN", 0, 0, DOWN, /* 2002 */ - 0, 0 - }, - { "DRAG-COLOR", 0, 1, DRAG_COLOR, /* ACU extension */ - 0, CB_CS_GRAPHICAL_CONTROL | CB_CS_INQUIRE_MODIFY - }, - { "DROP-DOWN", 0, 1, DROP_DOWN, /* ACU extension */ - 0, CB_CS_GRAPHICAL_CONTROL | CB_CS_INQUIRE_MODIFY - }, - { "DROP-LIST", 0, 1, DROP_LIST, /* ACU extension */ - 0, CB_CS_GRAPHICAL_CONTROL | CB_CS_INQUIRE_MODIFY - }, - { "DUPLICATES", 0, 0, DUPLICATES, /* 2002 */ - 0, 0 - }, - { "DYNAMIC", 0, 0, DYNAMIC, /* 2002 */ - 0, 0 - }, - { "EBCDIC", 0, 1, EBCDIC, /* Extension */ - 0, CB_CS_ALPHABET - }, - { "EC", 0, 0, EC, /* 2002 */ - 0, 0 - }, - { "ECHO", 0, 0, ECHO, /* Extension */ - 0, 0 - }, - { "EGI", 0, 0, EGI, /* Communication Section */ - 0, 0 - }, - { "ELEMENT", 0, 1, ELEMENT, /* IBM extension */ - 0, CB_CS_XML_GENERATE - }, - { "ELSE", 0, 0, ELSE, /* 2002 */ - 0, 0 - }, - { "EMI", 0, 0, EMI, /* Communication Section */ - 0, 0 - }, - { "ENABLE", 0, 0, ENABLE, /* Communication Section */ - 0, 0 - }, - { "ENABLED", 0, 1, ENABLED, /* ACU extension */ - 0, CB_CS_SCREEN - }, - { "ENCODING", 0, 1, ENCODING, /* IBM extension */ - 0, CB_CS_XML_GENERATE | CB_CS_XML_PARSE - }, - { "ENCRYPTION", 0, 1, ENCRYPTION, /* ACU extension */ - 0, CB_CS_SELECT - }, - { "END", 0, 0, END, /* 2002 */ - 0, 0 - }, - { "END-ACCEPT", 0, 0, END_ACCEPT, /* 2002 */ - 0, 0 - }, - { "END-ADD", 0, 0, END_ADD, /* 2002 */ - 0, 0 - }, - { "END-CALL", 0, 0, END_CALL, /* 2002 */ - 0, 0 - }, - { "END-CHAIN", 0, 0, -1, /* Extension */ - 0, 0 - }, - { "END-COLOR", 0, 1, END_COLOR, /* ACU extension */ - 0, CB_CS_GRAPHICAL_CONTROL | CB_CS_INQUIRE_MODIFY - }, - { "END-COMPUTE", 0, 0, END_COMPUTE, /* 2002 */ - 0, 0 - }, - { "END-DELETE", 0, 0, END_DELETE, /* 2002 */ - 0, 0 - }, - { "END-DISPLAY", 0, 0, END_DISPLAY, /* 2002 */ - 0, 0 - }, - { "END-DIVIDE", 0, 0, END_DIVIDE, /* 2002 */ - 0, 0 - }, - { "END-EVALUATE", 0, 0, END_EVALUATE, /* 2002 */ - 0, 0 - }, - { "END-IF", 0, 0, END_IF, /* 2002 */ - 0, 0 - }, - { "END-JSON", 0, 0, END_JSON, /* IBM extension */ - 0, 0 - }, - { "END-MODIFY", 0, 1, END_MODIFY, /* ACU extension */ - 0, CB_CS_INQUIRE_MODIFY - }, - { "END-MULTIPLY", 0, 0, END_MULTIPLY, /* 2002 */ - 0, 0 - }, - { "END-OF-PAGE", 0, 0, EOP, /* 2002 */ - 0, 0 - }, - { "END-PERFORM", 0, 0, END_PERFORM, /* 2002 */ - 0, 0 - }, - { "END-READ", 0, 0, END_READ, /* 2002 */ - 0, 0 - }, - { "END-RECEIVE", 0, 0, END_RECEIVE, /* Communication Section */ - 0, 0 - }, - { "END-RETURN", 0, 0, END_RETURN, /* 2002 */ - 0, 0 - }, - { "END-REWRITE", 0, 0, END_REWRITE, /* 2002 */ - 0, 0 - }, - { "END-SEARCH", 0, 0, END_SEARCH, /* 2002 */ - 0, 0 - }, - { "END-START", 0, 0, END_START, /* 2002 */ - 0, 0 - }, - { "END-STRING", 0, 0, END_STRING, /* 2002 */ - 0, 0 - }, - { "END-SUBTRACT", 0, 0, END_SUBTRACT, /* 2002 */ - 0, 0 - }, - { "END-UNSTRING", 0, 0, END_UNSTRING, /* 2002 */ - 0, 0 - }, - { "END-WRITE", 0, 0, END_WRITE, /* 2002 */ - 0, 0 - }, - { "END-XML", 0, 0, END_XML, /* IBM extension */ - 0, 0 - }, - { "ENGRAVED", 0, 1, ENGRAVED, /* ACU extension */ - 0, CB_CS_GRAPHICAL_CONTROL | CB_CS_INQUIRE_MODIFY - }, - { "ENSURE-VISIBLE", 0, 1, ENSURE_VISIBLE, /* ACU extension */ - 0, CB_CS_GRAPHICAL_CONTROL | CB_CS_INQUIRE_MODIFY - }, - { "ENTRY", 0, 0, ENTRY, /* Extension */ - 0, 0 - }, - { "ENTRY-CONVENTION", 0, 1, ENTRY_CONVENTION, /* 2002 (C/S) */ - 0, CB_CS_OPTIONS - }, - { "ENTRY-FIELD", 1, 1, ENTRY_FIELD, /* ACU extension */ - CB_CS_GRAPHICAL_CONTROL, CB_CS_DISPLAY | CB_CS_SCREEN - }, - { "ENTRY-REASON", 0, 1, ENTRY_REASON, /* ACU extension */ - 0, CB_CS_GRAPHICAL_CONTROL | CB_CS_INQUIRE_MODIFY - }, - { "ENVIRONMENT", 0, 0, ENVIRONMENT, /* 2002 */ - 0, 0 - }, - { "ENVIRONMENT-NAME", 0, 0, ENVIRONMENT_NAME, /* Extension */ - 0, 0 - }, - { "ENVIRONMENT-VALUE", 0, 0, ENVIRONMENT_VALUE, /* Extension */ - 0, 0 - }, - { "EO", 0, 0, -1, /* 2002 */ - 0, 0 - }, - { "EOL", 0, 1, EOL, /* 2002 (C/S) */ - 0, CB_CS_ERASE - }, - { "EOP", 0, 0, EOP, /* 2002 */ - 0, 0 - }, - { "EOS", 0, 1, EOS, /* 2002 (C/S) */ - 0, CB_CS_ERASE - }, - { "EQUAL", 0, 0, EQUAL, /* 2002 */ - 0, 0 - }, - { "ERASE", 0, 1, ERASE, /* 2002 (C/S) */ - CB_CS_ERASE, CB_CS_ACCEPT | CB_CS_DISPLAY | CB_CS_SCREEN - }, - { "ERROR", 0, 0, ERROR, /* 2002 */ - 0, 0 - }, - { "ESCAPE", 0, 0, ESCAPE, /* Extension */ - 0, 0 - }, - { "ESCAPE-BUTTON", 0, 1, ESCAPE_BUTTON, /* ACU extension */ - 0, CB_CS_GRAPHICAL_CONTROL | CB_CS_INQUIRE_MODIFY - }, - { "ESI", 0, 0, ESI, /* Communication Section */ - 0, 0 - }, - { "EVALUATE", 1, 0, EVALUATE, /* 2002 */ - 0, 0 - }, - { "EVENT", 1, 0, EVENT, /* ACU extension */ - 0, 0 - }, - { "EVENT-LIST", 0, 1, EVENT_LIST, /* ACU extension */ - 0, CB_CS_GRAPHICAL_CONTROL | CB_CS_INQUIRE_MODIFY - }, - { "EVERY", 0, 1, EVERY, /* IBM extension */ - 0, CB_CS_I_O_CONTROL | CB_CS_XML_GENERATE - }, - { "EXCEPTION", 0, 0, EXCEPTION, /* 2002 */ - 0, 0 - }, - { "EXCEPTION-OBJECT", 0, 0, -1, /* 2002 */ - 0, 0 - }, - { "EXCEPTION-VALUE", 0, 1, EXCEPTION_VALUE, /* ACU extension */ - 0, CB_CS_GRAPHICAL_CONTROL | CB_CS_INQUIRE_MODIFY - }, - { "EXCLUSIVE", 0, 0, EXCLUSIVE, /* 2002 */ - 0, 0 - }, - { "EXIT", 0, 0, EXIT, /* 2002 */ - CB_CS_EXIT, 0 - }, - { "EXPAND", 0, 1, EXPAND, /* ACU extension */ - 0, CB_CS_GRAPHICAL_CONTROL | CB_CS_INQUIRE_MODIFY - }, - { "EXPANDS", 0, 1, -1, /* 2002 (C/S) */ - 0, 0 - /* FIXME: 2014 Context-sensitive to class-specifier and - interface-specifier of REPOSITORY paragraph */ - }, - { "EXTEND", 0, 0, EXTEND, /* 2002 */ - 0, 0 - }, - { "EXTENDED-SEARCH", 0, 1, EXTENDED_SEARCH, /* OS/VS extension */ - 0, CB_CS_I_O_CONTROL - }, - { "EXTERN", 0, 1, TOK_EXTERN, /* 2002 Implementor specific ENTRY-CONVENTION, - Extension: implicit defined CALL-CONVENTION */ - 0, CB_CS_CALL | CB_CS_OPTIONS - }, - { "EXTERNAL", 0, 0, EXTERNAL, /* 2002 */ - 0, 0 - }, - { "EXTERNAL-FORM", 0, 0, EXTERNAL_FORM, /* ACU CGI extension */ - 0, 0 - }, - { "F", 0, 1, F, /* Extension */ - 0, CB_CS_RECORDING - }, - { "FACTORY", 0, 0, -1, /* 2002 */ - 0, 0 - }, - { "FALSE", 0, 0, TOK_FALSE, /* 2002 */ - 0, 0 - }, - { "FD", 0, 0, FD, /* 2002 */ - 0, 0 - }, - { "FH--FCD", 0, 1, FH__FCD, /* MF extension */ - 0, CB_CS_SET - }, - { "FH--KEYDEF", 0, 1, FH__KEYDEF, /* MF extension */ - 0, CB_CS_SET - }, - { "FILE", 0, 0, TOK_FILE, /* 2002 */ - 0, 0 - }, - { "FILE-CONTROL", 0, 0, FILE_CONTROL, /* 2002 */ - 0, 0 - }, - { "FILE-ID", 0, 0, FILE_ID, /* Extension */ - 0, 0 - }, - { "FILE-LIMIT", 0, 1, FILE_LIMIT, /* OS/VS extension */ - 0, CB_CS_SELECT - }, - { "FILE-LIMITS", 0, 1, FILE_LIMITS, /* OS/VS extension */ - 0, CB_CS_SELECT - }, - { "FILE-NAME", 0, 1, FILE_NAME, /* ACU extension */ - 0, CB_CS_GRAPHICAL_CONTROL | CB_CS_INQUIRE_MODIFY - }, - { "FILE-POS", 0, 1, FILE_POS, /* ACU extension */ - 0, CB_CS_GRAPHICAL_CONTROL | CB_CS_INQUIRE_MODIFY - }, - { "FILL-COLOR", 0, 1, FILL_COLOR, /* ACU extension */ - 0, CB_CS_GRAPHICAL_CONTROL | CB_CS_INQUIRE_MODIFY - }, - { "FILL-COLOR2", 0, 1, FILL_COLOR2, /* ACU extension */ - 0, CB_CS_GRAPHICAL_CONTROL | CB_CS_INQUIRE_MODIFY - }, - { "FILL-PERCENT", 0, 1, FILL_PERCENT, /* ACU extension */ - 0, CB_CS_GRAPHICAL_CONTROL | CB_CS_INQUIRE_MODIFY - }, - { "FILLER", 0, 0, FILLER, /* 2002 */ - 0, 0 - }, - { "FINAL", 0, 0, FINAL, /* 2002 */ - 0, 0 - }, - { "FINISH-REASON", 0, 1, FINISH_REASON, /* ACU extension */ - 0, CB_CS_GRAPHICAL_CONTROL | CB_CS_INQUIRE_MODIFY - }, - { "FIRST", 0, 0, FIRST, /* 2002 */ - 0, 0 - }, - { "FIXED", 0, 0, FIXED, /* Extension */ - 0, CB_CS_RECORDING - }, - { "FIXED-FONT", 0, 0, FIXED_FONT, /* ACU extension */ - 0, 0 /* Checkme: likely context sensitive */ - }, - { "FIXED-WIDTH", 0, 1, FIXED_WIDTH, /* ACU extension */ - 0, CB_CS_GRAPHICAL_CONTROL | CB_CS_INQUIRE_MODIFY - }, - { "FLAT", 0, 1, FLAT, /* ACU extension */ - 0, CB_CS_GRAPHICAL_CONTROL | CB_CS_INQUIRE_MODIFY - }, - { "FLAT-BUTTONS", 0, 1, FLAT_BUTTONS, /* ACU extension */ - 0, CB_CS_GRAPHICAL_CONTROL | CB_CS_INQUIRE_MODIFY - }, - { "FLOAT", 0, 0, FLOAT_SHORT, /* ACU extension */ - 0, 0 - }, - { "FLOAT-BINARY-128", 0, 0, -1, /* 2014 */ - 0, 0 - }, - { "FLOAT-BINARY-32", 0, 0, -1, /* 2014 */ - 0, 0 - }, - { "FLOAT-BINARY-64", 0, 0, -1, /* 2014 */ - 0, 0 - }, - { "FLOAT-DECIMAL-16", 0, 0, FLOAT_DECIMAL_16, /* 2014 */ - 0, 0 - }, - { "FLOAT-DECIMAL-34", 0, 0, FLOAT_DECIMAL_34, /* 2014 */ - 0, 0 - }, -#if 0 /* RXWRXW - FP Decimal */ - { "FLOAT-DECIMAL-7", 0, 0, -1, /* Extension */ - 0, 0 - }, -#endif - /* note: may be set as alias for FLOAT-LONG to enable compilation, - the actual precision seems to be compiler (version) specific */ - { "FLOAT-EXTENDED", 0, 0, -1, /* 2002 */ - 0, 0 - }, - { "FLOAT-INFINITY", 0, 0, -1, /* 2014 */ - 0, 0 - }, - { "FLOAT-LONG", 0, 0, FLOAT_LONG, /* 2002 */ - 0, 0 - }, - { "FLOAT-NOT-A-NUMBER", 0, 1, -1, /* 2014 */ - 0, 0 - }, - { "FLOAT-SHORT", 0, 0, FLOAT_SHORT, /* 2002 */ - 0, 0 - }, - { "FLOATING", 0, 0, FLOATING, /* ACU extension */ - 0, CB_CS_DISPLAY - }, - { "FONT", 0, 0, FONT, /* ACU extension */ - 0, 0 /* Checkme: likely context sensitive */ - }, - { "FOOTING", 0, 0, FOOTING, /* 2002 */ - 0, 0 - }, - { "FOR", 0, 0, FOR, /* 2002 */ - 0, 0 - }, - { "FOREGROUND-COLOR", 0, 1, FOREGROUND_COLOR, /* 2002 (C/S) */ - 0, CB_CS_ACCEPT | CB_CS_DISPLAY | CB_CS_SCREEN - }, - { "FOREVER", 0, 1, FOREVER, /* 2002 (C/S) */ - 0, CB_CS_PERFORM | CB_CS_RETRY - }, - { "FORMAT", 0, 0, -1, /* 2002 */ - 0, 0 - }, - { "FRAME", 1, 1, FRAME, /* ACU extension */ - CB_CS_GRAPHICAL_CONTROL, CB_CS_GRAPHICAL_CONTROL | CB_CS_INQUIRE_MODIFY - }, - { "FRAMED", 0, 1, FRAMED, /* ACU extension */ - 0, CB_CS_GRAPHICAL_CONTROL | CB_CS_INQUIRE_MODIFY - }, - { "FREE", 0, 0, FREE, /* 2002 */ - 0, 0 - }, - { "FROM", 0, 0, FROM, /* 2002 */ - CB_CS_FROM, 0 - }, - { "FULL", 0, 1, FULL, /* 2002 (C/S) */ - 0, CB_CS_ACCEPT | CB_CS_DISPLAY | CB_CS_SCREEN - }, - { "FULL-HEIGHT", 0, 1, FULL_HEIGHT, /* ACU extension */ - 0, CB_CS_GRAPHICAL_CONTROL | CB_CS_INQUIRE_MODIFY - }, - { "FUNCTION", 0, 0, FUNCTION, /* 2002 */ - 0, 0 - }, - { "FUNCTION-ID", 0, 0, FUNCTION_ID, /* 2002 */ - 0, 0 - }, - { "FUNCTION-POINTER", 0, 0, -1, /* 2014 */ - 0, 0 - }, - { "GENERATE", 0, 0, GENERATE, /* 2002 */ - 0, 0 - }, - { "GET", 0, 0, -1, /* 2002 */ - 0, 0 - }, - { "GIVING", 0, 0, GIVING, /* 2002 */ - 0, 0 - }, - { "GLOBAL", 0, 0, GLOBAL, /* 2002 */ - 0, 0 - }, - { "GO", 0, 0, GO, /* 2002 */ - 0, 0 - }, - { "GO-BACK", 0, 1, GO_BACK, /* ACU extension */ - 0, CB_CS_GRAPHICAL_CONTROL | CB_CS_INQUIRE_MODIFY - }, - { "GO-FORWARD", 0, 1, GO_FORWARD, /* ACU extension */ - 0, CB_CS_GRAPHICAL_CONTROL | CB_CS_INQUIRE_MODIFY - }, - { "GO-HOME", 0, 1, GO_HOME, /* ACU extension */ - 0, CB_CS_GRAPHICAL_CONTROL | CB_CS_INQUIRE_MODIFY - }, - { "GO-SEARCH", 0, 1, GO_SEARCH, /* ACU extension */ - 0, CB_CS_GRAPHICAL_CONTROL | CB_CS_INQUIRE_MODIFY - }, - { "GOBACK", 0, 0, GOBACK, /* 2002 */ - 0, 0 - }, - { "GRAPHICAL", 0, 1, GRAPHICAL, /* ACU extension */ - 0, CB_CS_DISPLAY - }, - { "GREATER", 0, 0, GREATER, /* 2002 */ - 0, 0 - }, - { "GRID", 1, 1, GRID, /* Extension (ACU control, MF) */ - CB_CS_GRAPHICAL_CONTROL, CB_CS_SCREEN - }, - { "GROUP", 0, 0, GROUP, /* 2002 */ - 0, 0 - }, - { "GROUP-USAGE", 0, 0, -1, /* 2002 */ - 0, 0 - }, - { "GROUP-VALUE", 0, 1, GROUP_VALUE, /* ACU extension */ - 0, CB_CS_GRAPHICAL_CONTROL | CB_CS_INQUIRE_MODIFY - }, - { "HANDLE", 0, 0, HANDLE, /* ACU extension */ - 0, 0 - }, - { "HAS-CHILDREN", 0, 1, HAS_CHILDREN, /* ACU extension */ - 0, CB_CS_GRAPHICAL_CONTROL | CB_CS_INQUIRE_MODIFY - }, - { "HEADING", 0, 0, HEADING, /* 2002 */ - 0, 0 - }, - { "HEADING-COLOR", 0, 1, HEADING_COLOR, /* ACU extension */ - 0, CB_CS_GRAPHICAL_CONTROL | CB_CS_INQUIRE_MODIFY - }, - { "HEADING-DIVIDER-COLOR", 0, 1, HEADING_DIVIDER_COLOR, /* ACU extension */ - 0, CB_CS_GRAPHICAL_CONTROL | CB_CS_INQUIRE_MODIFY - }, - { "HEADING-FONT", 0, 1, HEADING_FONT, /* ACU extension */ - 0, CB_CS_GRAPHICAL_CONTROL | CB_CS_INQUIRE_MODIFY - }, - { "HEAVY", 0, 1, HEAVY, /* ACU extension */ - 0, CB_CS_GRAPHICAL_CONTROL | CB_CS_INQUIRE_MODIFY - }, - { "HEIGHT-IN-CELLS", 0, 1, HEIGHT_IN_CELLS, /* ACU extension */ - 0, CB_CS_GRAPHICAL_CONTROL | CB_CS_INQUIRE_MODIFY - }, - { "HELP-ID", 0, 1, HELP_ID, /* ACU extension */ - 0, CB_CS_SCREEN - }, - { "HIDDEN-DATA", 0, 1, HIDDEN_DATA, /* ACU extension */ - 0, CB_CS_GRAPHICAL_CONTROL | CB_CS_INQUIRE_MODIFY - }, - { "HIGH-COLOR", 0, 1, HIGH_COLOR, /* ACU extension */ - 0, CB_CS_GRAPHICAL_CONTROL | CB_CS_INQUIRE_MODIFY - }, - { "HIGH-VALUE", 0, 0, HIGH_VALUE, /* 2002 */ - 0, 0 - }, - { "HIGHLIGHT", 0, 1, HIGHLIGHT, /* 2002 (C/S) */ - 0, CB_CS_ACCEPT | CB_CS_DISPLAY | CB_CS_SCREEN | CB_CS_SET - }, - { "HOT-TRACK", 0, 1, HOT_TRACK, /* ACU extension */ - 0, CB_CS_GRAPHICAL_CONTROL | CB_CS_INQUIRE_MODIFY - }, - { "HSCROLL", 0, 1, HSCROLL, /* ACU extension */ - 0, CB_CS_GRAPHICAL_CONTROL | CB_CS_INQUIRE_MODIFY - }, - { "HSCROLL-POS", 0, 1, HSCROLL_POS, /* ACU extension */ - 0, CB_CS_GRAPHICAL_CONTROL | CB_CS_INQUIRE_MODIFY - }, - { "I-O", 0, 0, I_O, /* 2002 */ - 0, 0 - }, - { "I-O-CONTROL", 1, 0, I_O_CONTROL, /* 2002 */ - CB_CS_I_O_CONTROL, 0 - }, - { "ICON", 0, 1, ICON, /* ACU extension */ - 0, CB_CS_DISPLAY - }, - { "ID", 0, 0, ID, /* Extension */ - 0, 0 - }, - { "IDENTIFICATION", 0, 0, IDENTIFICATION, /* 2002 */ - 0, 0 - }, - { "IDENTIFIED", 0, 0, IDENTIFIED, /* ACU CGI extension */ - 0, 0 - }, - { "IF", 1, 0, IF, /* 2002 */ - 0, 0 - }, - { "IGNORE", 0, 0, IGNORE, /* Extension */ - 0, 0 - }, - { "IGNORING", 0, 1, IGNORING, /* 2002 (C/S) */ - 0, CB_CS_READ - }, - { "IMPLEMENTS", 0, 1, -1, /* 2002 (C/S) */ - 0, 0 - /* FIXME: 2014 Context-sensitive to FACTORY and OBJECT paragraph */ - }, - { "IN", 0, 0, IN, /* 2002 */ - 0, 0 - }, - { "INDEPENDENT", 0, 1, INDEPENDENT, /* ACU extension */ - 0, CB_CS_DISPLAY - }, - { "INDEX", 0, 0, INDEX, /* 2002 */ - 0, 0 - }, - { "INDEXED", 0, 0, INDEXED, /* 2002 */ - 0, 0 - }, - { "INDICATE", 0, 0, INDICATE, /* 2002 */ - 0, 0 - }, - { "INHERITS", 0, 0, -1, /* 2002 */ - 0, 0 - }, - { "INITIAL", 0, 0, TOK_INITIAL, /* 2002 */ - 0, 0 - }, - { "INITIALIZE", 0, 0, INITIALIZE, /* 2002 */ - 0, 0 - }, - { "INITIALIZED", 0, 1, INITIALIZED, /* 2002 */ - 0, CB_CS_ALLOCATE | CB_CS_OCCURS - }, - { "INITIATE", 0, 0, INITIATE, /* 2002 */ - 0, 0 - }, - { "INPUT", 0, 0, INPUT, /* 2002 */ - 0, 0 - }, - { "INPUT-OUTPUT", 0, 0, INPUT_OUTPUT, /* 2002 */ - 0, 0 - }, - { "INQUIRE", 1, 0, INQUIRE, /* ACU extension */ - CB_CS_INQUIRE_MODIFY, 0 - }, - { "INSERTION-INDEX", 0, 1, INSERTION_INDEX, /* ACU extension */ - 0, CB_CS_GRAPHICAL_CONTROL | CB_CS_INQUIRE_MODIFY - }, - { "INSERT-ROWS", 0, 1, INSERT_ROWS, /* ACU extension */ - 0, CB_CS_GRAPHICAL_CONTROL | CB_CS_INQUIRE_MODIFY - }, - { "INSPECT", 0, 0, INSPECT, /* 2002 */ - 0, 0 - }, - { "INTERFACE", 0, 0, -1, /* 2002 */ - 0, 0 - }, - { "INTERFACE-ID", 0, 0, -1, /* 2002 */ - 0, 0 - }, - { "INTERMEDIATE", 0, 1, INTERMEDIATE, /* 2014 (C/S) */ - 0, CB_CS_OPTIONS - }, - { "INTO", 0, 0, INTO, /* 2002 */ - 0, 0 - }, - { "INTRINSIC", 0, 1, INTRINSIC, /* 2002 (C/S) */ - 0, 0 - /* FIXME: 2014 Context-sensitive to function-specifier of the REPOSITORY paragraph */ - }, - { "INVALID", 0, 0, INVALID, /* 2002 */ - 0, 0 - }, - { "INVOKE", 0, 0, -1, /* 2002 */ - 0, 0 - }, - { "IS", 0, 0, IS, /* 2002 */ - 0, 0 - }, - { "ITEM", 0, 1, ITEM, /* ACU extension */ - 0, CB_CS_GRAPHICAL_CONTROL | CB_CS_INQUIRE_MODIFY - }, - { "ITEM-TEXT", 0, 1, ITEM_TEXT, /* ACU extension */ - 0, CB_CS_GRAPHICAL_CONTROL | CB_CS_INQUIRE_MODIFY - }, - { "ITEM-TO-ADD", 0, 1, ITEM_TO_ADD, /* ACU extension */ - 0, CB_CS_GRAPHICAL_CONTROL | CB_CS_INQUIRE_MODIFY - }, - { "ITEM-TO-DELETE", 0, 1, ITEM_TO_DELETE, /* ACU extension */ - 0, CB_CS_GRAPHICAL_CONTROL | CB_CS_INQUIRE_MODIFY - }, - { "ITEM-TO-EMPTY", 0, 1, ITEM_TO_EMPTY, /* ACU extension */ - 0, CB_CS_GRAPHICAL_CONTROL | CB_CS_INQUIRE_MODIFY - }, - { "ITEM-VALUE", 0, 1, ITEM_VALUE, /* ACU extension */ - 0, CB_CS_GRAPHICAL_CONTROL | CB_CS_INQUIRE_MODIFY - }, - { "JSON", 1, 0, JSON, /* IBM extension */ - 0, 0 - }, - { "JUST", 0, 0, JUSTIFIED, /* 2002 */ - 0, 0 - }, - { "JUSTIFIED", 0, 0, JUSTIFIED, /* 2002 */ - 0, 0 - }, - { "KEPT", 0, 0, KEPT, /* Extension */ - 0, 0 - }, - { "KEY", 0, 0, KEY, /* 2002 */ - 0, 0 - }, - { "KEYBOARD", 0, 1, KEYBOARD, /* Extension */ - 0, CB_CS_ASSIGN - }, - { "LABEL", 0, 0, LABEL, /* 85, ACU extension */ - 0, 0 - }, - { "LABEL-OFFSET", 0, 1, LABEL_OFFSET, /* ACU extension */ - 0, CB_CS_GRAPHICAL_CONTROL | CB_CS_INQUIRE_MODIFY - }, - { "LARGE-FONT", 0, 0, LARGE_FONT, /* ACU extension */ - 0, 0 /* Checkme: likely context sensitive */ - }, - { "LARGE-OFFSET", 0, 1, LARGE_OFFSET, /* ACU extension */ - 0, CB_CS_GRAPHICAL_CONTROL | CB_CS_INQUIRE_MODIFY - }, - { "LAST", 0, 0, LAST, /* 2002 */ - 0, 0 - }, - { "LAST-ROW", 0, 1, LAST_ROW, /* ACU extension */ - 0, CB_CS_GRAPHICAL_CONTROL | CB_CS_INQUIRE_MODIFY - }, - { "LAYOUT-DATA", 0, 1, LAYOUT_DATA, /* ACU extension */ - 0, CB_CS_INQUIRE_MODIFY /* likely wrong context, fix later */ - }, - { "LAYOUT-MANAGER", 0, 0, LAYOUT_MANAGER, /* ACU extension */ - 0, 0 /* Check me: likely context sensitive */ - }, - { "LC_ALL", 0, 1, -1, /* 2002 (C/S) */ - 0, CB_CS_SET - }, - { "LC_COLLATE", 0, 1, -1, /* 2002 (C/S) */ - 0, CB_CS_SET - }, - { "LC_CTYPE", 0, 1, -1, /* 2002 (C/S) */ - 0, CB_CS_SET - }, - { "LC_MESSAGES", 0, 1, -1, /* 2002 (C/S) */ - 0, CB_CS_SET - }, - { "LC_MONETARY", 0, 1, -1, /* 2002 (C/S) */ - 0, CB_CS_SET - }, - { "LC_NUMERIC", 0, 1, -1, /* 2002 (C/S) */ - 0, CB_CS_SET - }, - { "LC_TIME", 0, 1, -1, /* 2002 (C/S) */ - 0, CB_CS_SET - }, - { "LEADING", 0, 0, LEADING, /* 2002 */ - 0, 0 - }, - { "LEADING-SHIFT", 0, 1, LEADING_SHIFT, /* ACU extension */ - 0, CB_CS_GRAPHICAL_CONTROL | CB_CS_INQUIRE_MODIFY - }, - { "LEAVE", 0, 1, LEAVE, /* OS/VS extension */ - 0, CB_CS_OPEN - }, - { "LEFT", 0, 0, LEFT, /* 2002 */ - 0, 0 - }, - { "LEFT-JUSTIFY", 0, 0, -1, /* Extension */ - 0, 0 - }, - { "LEFT-TEXT", 0, 1, LEFT_TEXT, /* ACU extension */ - 0, CB_CS_GRAPHICAL_CONTROL | CB_CS_INQUIRE_MODIFY - }, - { "LEFTLINE", 0, 0, LEFTLINE, /* Extension */ - 0, 0 - }, - { "LENGTH", 0, 0, LENGTH, /* 2002 */ - 0, 0 - }, - { "LESS", 0, 0, LESS, /* 2002 */ - 0, 0 - }, - { "LIMIT", 0, 0, LIMIT, /* 2002 */ - 0, 0 - }, - { "LIMITS", 0, 0, LIMITS, /* 2002 */ - 0, 0 - }, - { "LINAGE", 0, 0, LINAGE, /* 2002 */ - 0, 0 - }, - { "LINAGE-COUNTER", 0, 0, LINAGE_COUNTER, /* 2002 */ - 0, 0 - }, - { "LINE", 0, 0, LINE, /* 2002 */ - 0, 0 - }, - { "LINE-COUNTER", 0, 0, LINE_COUNTER, /* 2002 */ - 0, 0 - }, - { "LINE-SEQUENTIAL", 0, 1, LINE_SEQUENTIAL, /* Extension */ - 0, CB_CS_DELIMITER - }, - { "LINES", 0, 0, LINES, /* 2002 */ - 0, 0 - }, - { "LINES-AT-ROOT", 0, 1, LINES_AT_ROOT, /* ACU extension */ - 0, CB_CS_GRAPHICAL_CONTROL | CB_CS_INQUIRE_MODIFY - }, - { "LINKAGE", 0, 0, LINKAGE, /* 2002 */ - 0, 0 - }, - { "LIST-BOX", 1, 1, LIST_BOX, /* ACU extension */ - CB_CS_GRAPHICAL_CONTROL, CB_CS_DISPLAY | CB_CS_SCREEN - }, - { "LM-RESIZE", 0, 0, LM_RESIZE, /* ACU extension */ - 0, 0 /* Checkme: likely context sensitive */ - }, - { "LOC", 0, 1, LOC, /* IBM extension (ignored) */ - 0, CB_CS_ALLOCATE - }, - { "LOCAL-STORAGE", 0, 0, LOCAL_STORAGE, /* 2002 */ - 0, 0 - }, - { "LOCALE", 0, 0, LOCALE, /* 2002 */ - 0, 0 - }, - { "LOCK", 0, 0, LOCK, /* 2002 */ - 0, 0 - }, - { "LOCK-HOLDING", 0, 1, LOCK_HOLDING, /* ACU extension */ - 0, CB_CS_I_O_CONTROL - }, - { "LONG-DATE", 0, 1, LONG_DATE, /* ACU extension */ - 0, CB_CS_GRAPHICAL_CONTROL | CB_CS_INQUIRE_MODIFY - }, - { "LOW-COLOR", 0, 1, LOW_COLOR, /* ACU extension */ - 0, CB_CS_GRAPHICAL_CONTROL | CB_CS_INQUIRE_MODIFY - }, - { "LOW-VALUE", 0, 0, LOW_VALUE, /* 2002 */ - 0, 0 - }, - { "LOWER", 0, 1, LOWER, /* Extension */ - 0, CB_CS_ACCEPT - }, - { "LOWERED", 0, 1, LOWERED, /* ACU extension */ - 0, CB_CS_GRAPHICAL_CONTROL | CB_CS_INQUIRE_MODIFY - }, - { "LOWLIGHT", 0, 1, LOWLIGHT, /* 2002 (C/S) */ - 0, CB_CS_ACCEPT | CB_CS_DISPLAY | CB_CS_SCREEN | CB_CS_SET - }, - { "MAGNETIC-TAPE", 0, 1, MAGNETIC_TAPE, /* Extension */ - 0, CB_CS_ASSIGN - }, - { "MANUAL", 0, 0, MANUAL, /* 2002 */ - 0, 0 - /* FIXME: 2014 Context-sensitive to LOCK MODE clause */ - }, - { "MASS-UPDATE", 0, 1, MASS_UPDATE, /* ACU extension */ - 0, CB_CS_GRAPHICAL_CONTROL | CB_CS_INQUIRE_MODIFY | CB_CS_SELECT | CB_CS_OPEN - }, - { "MASTER-INDEX", 0, 1, MASTER_INDEX, /* OS/VS extension */ - 0, CB_CS_I_O_CONTROL - }, - { "MAX-LINES", 0, 1, MAX_LINES, /* ACU extension */ - 0, CB_CS_GRAPHICAL_CONTROL | CB_CS_INQUIRE_MODIFY - }, - { "MAX-PROGRESS", 0, 1, MAX_PROGRESS, /* ACU extension */ - 0, CB_CS_GRAPHICAL_CONTROL | CB_CS_INQUIRE_MODIFY - }, - { "MAX-TEXT", 0, 1, MAX_TEXT, /* ACU extension */ - 0, CB_CS_GRAPHICAL_CONTROL | CB_CS_INQUIRE_MODIFY - }, - { "MAX-VAL", 0, 1, MAX_VAL, /* ACU extension */ - 0, CB_CS_GRAPHICAL_CONTROL | CB_CS_INQUIRE_MODIFY - }, - { "MEDIUM-FONT", 0, 0, MEDIUM_FONT, /* ACU extension */ - 0, 0 /* Checkme: likely context sensitive */ - }, - { "MEMORY", 0, 1, MEMORY, /* 85 */ - 0, CB_CS_OBJECT_COMPUTER - }, - { "MENU", 0, 0, MENU, /* ACU extension */ - 0, 0 /* Checkme: likely context sensitive */ - }, - { "MERGE", 0, 0, MERGE, /* 2002 */ - 0, 0 - }, - { "MESSAGE", 0, 0, MESSAGE, /* Communication Section */ - 0, 0 - }, - { "METHOD", 0, 0, -1, /* 2002 */ - 0, 0 - }, - { "METHOD-ID", 0, 0, -1, /* 2002 */ - 0, 0 - }, - { "MIN-VAL", 0, 1, MIN_VAL, /* ACU extension */ - 0, CB_CS_GRAPHICAL_CONTROL | CB_CS_INQUIRE_MODIFY - }, - { "MINUS", 0, 0, MINUS, /* 2002 */ - 0, 0 - }, - { "MODE", 0, 0, MODE, /* 2002 */ - 0, 0 - }, - { "MODIFY", 1, 0, MODIFY, /* ACU extension */ - CB_CS_INQUIRE_MODIFY, 0 - }, - { "MODULES", 0, 1, MODULES, /* 85 */ - 0, CB_CS_OBJECT_COMPUTER - }, - { "MOVE", 0, 0, MOVE, /* 2002 */ - 0, 0 - }, - { "MULTILINE", 0, 1, MULTILINE, /* ACU extension */ - 0, CB_CS_GRAPHICAL_CONTROL | CB_CS_INQUIRE_MODIFY - }, - { "MULTIPLE", 0, 0, MULTIPLE, /* 2002 (C/S) */ - 0, 0 - /* FIXME: 2014 Context-sensitive to LOCK ON phrase */ - }, - { "MULTIPLY", 1, 0, MULTIPLY, /* 2002 */ - 0, 0 - }, - { "NAME", 0, 1, NAME, /* Extension */ - 0, CB_CS_FROM | CB_CS_XML_GENERATE | CB_CS_JSON_GENERATE - }, - { "NAMESPACE", 0, 1, NAMESPACE, /* IBM extension */ - 0, CB_CS_XML_GENERATE - }, - { "NAMESPACE-PREFIX", 0, 1, NAMESPACE_PREFIX, /* IBM extension */ - 0, CB_CS_XML_GENERATE - }, - { "NATIONAL", 0, 0, NATIONAL, /* 2002 */ - 0, 0 - }, - { "NATIONAL-EDITED", 0, 0, NATIONAL_EDITED, /* 2002 */ - 0, 0 - }, - { "NATIVE", 0, 0, NATIVE, /* 2002 */ - 0, 0 - }, - { "NAVIGATE-URL", 0, 1, NAVIGATE_URL, /* ACU extension */ - 0, CB_CS_GRAPHICAL_CONTROL | CB_CS_INQUIRE_MODIFY - }, - { "NEAREST-AWAY-FROM-ZERO", 0, 1, NEAREST_AWAY_FROM_ZERO, /* 2014 (C/S) */ - 0, CB_CS_ROUNDED - /* FIXME: 2014 ... and INTERMEDIATE ROUNDING clause */ - }, - { "NEAREST-EVEN", 0, 1, NEAREST_EVEN, /* 2014 (C/S) */ - 0, CB_CS_ROUNDED - /* FIXME: 2014 ... and INTERMEDIATE ROUNDING clause */ - }, - { "NEAREST-TOWARD-ZERO", 0, 1, NEAREST_TOWARD_ZERO, /* 2014 (C/S) */ - 0, CB_CS_ROUNDED - /* FIXME: 2014 ... and INTERMEDIATE ROUNDING clause */ - }, - { "NEGATIVE", 0, 0, NEGATIVE, /* 2002 */ - 0, 0 - }, - { "NESTED", 0, 0, NESTED, /* 2002 */ - 0, 0 - }, - { "NEW", 0, 0, NEW, /* 2002 */ - 0, 0 - }, - { "NEXT", 0, 0, NEXT, /* 2002 */ - 0, 0 - }, - { "NEXT-ITEM", 0, 1, NEXT_ITEM, /* ACU extension */ - 0, CB_CS_GRAPHICAL_CONTROL | CB_CS_INQUIRE_MODIFY - }, - { "NO", 0, 0, NO, /* 2002 */ - 0, 0 - }, - { "NO-AUTOSEL", 0, 1, NO_AUTOSEL, /* ACU extension */ - 0, CB_CS_GRAPHICAL_CONTROL | CB_CS_INQUIRE_MODIFY - }, - { "NO-AUTO-DEFAULT", 0, 1, NO_AUTO_DEFAULT, /* ACU extension */ - 0, CB_CS_GRAPHICAL_CONTROL | CB_CS_INQUIRE_MODIFY - }, - { "NO-BOX", 0, 1, NO_BOX, /* ACU extension */ - 0, CB_CS_GRAPHICAL_CONTROL | CB_CS_INQUIRE_MODIFY - }, - { "NO-DIVIDERS", 0, 1, NO_DIVIDERS, /* ACU extension */ - 0, CB_CS_GRAPHICAL_CONTROL | CB_CS_INQUIRE_MODIFY - }, - { "NO-ECHO", 0, 0, NO_ECHO, /* Extension */ - 0, 0 - }, - { "NO-F4", 0, 1, NO_F4, /* ACU extension */ - 0, CB_CS_GRAPHICAL_CONTROL | CB_CS_INQUIRE_MODIFY - }, - { "NO-FOCUS", 0, 1, NO_FOCUS, /* ACU extension */ - 0, CB_CS_GRAPHICAL_CONTROL | CB_CS_INQUIRE_MODIFY - }, - { "NO-GROUP-TAB", 0, 1, NO_GROUP_TAB, /* ACU extension */ - 0, CB_CS_GRAPHICAL_CONTROL | CB_CS_INQUIRE_MODIFY - }, - { "NO-KEY-LETTER", 0, 1, NO_KEY_LETTER, /* ACU extension */ - 0, CB_CS_GRAPHICAL_CONTROL | CB_CS_INQUIRE_MODIFY - }, - { "NOMINAL", 0, 1, NOMINAL, /* OS/VS extension */ - 0, CB_CS_SELECT - }, - { "NO-SEARCH", 0, 1, NO_SEARCH, /* ACU extension */ - 0, CB_CS_GRAPHICAL_CONTROL | CB_CS_INQUIRE_MODIFY - }, - { "NO-UPDOWN", 0, 1, NO_UPDOWN, /* ACU extension */ - 0, CB_CS_GRAPHICAL_CONTROL | CB_CS_INQUIRE_MODIFY - }, - { "NONE", 0, 1, -1, /* 2002 (C/S) */ - 0, 0 - }, - { "NONNUMERIC", 0, 1, NONNUMERIC, /* IBM extension */ - 0, CB_CS_XML_GENERATE - }, - { "NORMAL", 0, 1, NORMAL, /* 2002 (C/S) */ - 0, CB_CS_STOP - }, - { "NOT", 0, 0, NOT, /* 2002 */ - 0, 0 - }, - { "NOTAB", 0, 1, NOTAB, /* ACU extension */ - 0, CB_CS_GRAPHICAL_CONTROL | CB_CS_INQUIRE_MODIFY - }, - { "NOTHING", 0, 0, NOTHING, /* Extension */ - 0, 0 - }, - { "NOTIFY", 0, 1, NOTIFY, /* ACU extension */ - 0, CB_CS_GRAPHICAL_CONTROL | CB_CS_INQUIRE_MODIFY - }, - { "NOTIFY-CHANGE", 0, 1, NOTIFY_CHANGE, /* ACU extension */ - 0, CB_CS_GRAPHICAL_CONTROL | CB_CS_INQUIRE_MODIFY - }, - { "NOTIFY-DBLCLICK", 0, 1, NOTIFY_DBLCLICK, /* ACU extension */ - 0, CB_CS_GRAPHICAL_CONTROL | CB_CS_INQUIRE_MODIFY - }, - { "NOTIFY-SELCHANGE", 0, 1, NOTIFY_SELCHANGE, /* ACU extension */ - 0, CB_CS_GRAPHICAL_CONTROL | CB_CS_INQUIRE_MODIFY - }, - { "NULL", 0, 0, TOK_NULL, /* 2002 */ - 0, 0 - }, - { "NULLS", 0, 0, TOK_NULL, /* Extension */ - 0, 0 - }, - { "NUM-COL-HEADINGS", 0, 1, NUM_COL_HEADINGS, /* ACU extension */ - 0, CB_CS_GRAPHICAL_CONTROL | CB_CS_INQUIRE_MODIFY - }, - { "NUM-ROWS", 0, 1, NUM_ROWS, /* ACU extension */ - 0, CB_CS_GRAPHICAL_CONTROL | CB_CS_INQUIRE_MODIFY - }, - { "NUMBER", 0, 0, NUMBER, /* 2002 */ - 0, 0 - }, - { "NUMBERS", 0, 0, NUMBERS, /* 2002 (C/S) */ - 0, 0 - /* FIXME: 2014 Context-sensitive to LINE and COLUMN clause */ - }, - { "NUMERIC", 0, 0, NUMERIC, /* 2002 */ - 0, 0 - }, - { "NUMERIC-EDITED", 0, 0, NUMERIC_EDITED, /* 2002 */ - 0, 0 - }, - { "NUMERIC-FILL", 0, 1, -1, /* Extension */ - 0, CB_CS_SCREEN - }, - { "OBJECT", 0, 0, OBJECT, /* 2002, ACU extension */ - 0, 0 - }, - { "OBJECT-COMPUTER", 0, 0, OBJECT_COMPUTER, /* 2002 */ - CB_CS_OBJECT_COMPUTER, 0 - }, - { "OBJECT-REFERENCE", 0, 0, -1, /* 2002 */ - 0, 0 - }, - { "OCCURS", 0, 0, OCCURS, /* 2002 */ - CB_CS_OCCURS, 0 - }, - { "OF", 0, 0, OF, /* 2002 */ - 0, 0 - }, - { "OFF", 0, 0, OFF, /* 2002 */ - 0, 0 - }, - { "OK-BUTTON", 0, 1, OK_BUTTON, /* ACU extension */ - 0, CB_CS_GRAPHICAL_CONTROL | CB_CS_INQUIRE_MODIFY - }, - { "OMITTED", 0, 0, OMITTED, /* 2002 */ - 0, 0 - }, - { "ON", 0, 0, ON, /* 2002 */ - 0, 0 - }, - { "ONLY", 0, 0, ONLY, /* 2002 (C/S) */ - 0, 0 - /* FIXME: 2014 Context-sensitive to Object-view, SHARING clause, SHARING phrase, and USAGE clause */ - }, - { "OPEN", 1, 0, OPEN, /* 2002 */ - CB_CS_OPEN, 0 - }, - { "OPTIONAL", 0, 0, OPTIONAL, /* 2002 */ - 0, 0 - }, - { "OPTIONS", 0, 0, OPTIONS, /* 2002 */ - CB_CS_OPTIONS, 0 - }, - { "OR", 0, 0, OR, /* 2002 */ - 0, 0 - }, - { "ORDER", 0, 0, ORDER, /* 2002 */ - 0, 0 - }, - { "ORGANIZATION", 0, 0, ORGANIZATION, /* 2002 */ - 0, 0 - }, - { "OTHER", 0, 0, OTHER, /* 2002 */ - 0, 0 - }, - { "OTHERS", 0, 1, OTHERS, /* ACU extension */ - 0, CB_CS_OPEN - }, - { "OUTPUT", 0, 0, OUTPUT, /* 2002 */ - 0, 0 - }, - { "OVERFLOW", 0, 0, TOK_OVERFLOW, /* 2002 */ - 0, 0 - }, - { "OVERLAP-LEFT", 0, 1, OVERLAP_LEFT, /* ACU extension */ - 0, CB_CS_GRAPHICAL_CONTROL | CB_CS_INQUIRE_MODIFY - }, - { "OVERLAP-TOP", 0, 1, OVERLAP_LEFT, /* ACU extension */ - 0, CB_CS_GRAPHICAL_CONTROL | CB_CS_INQUIRE_MODIFY - }, - { "OVERLINE", 0, 0, OVERLINE, /* Extension */ - 0, 0 - }, - { "OVERRIDE", 0, 0, -1, /* 2002 */ - 0, 0 - }, - { "PACKED-DECIMAL", 0, 0, PACKED_DECIMAL, /* 2002 */ - 0, 0 - }, - { "PADDING", 0, 0, PADDING, /* 2002 */ - 0, 0 - }, - { "PAGE", 0, 0, PAGE, /* 2002 */ - 0, 0 - }, - { "PAGE-COUNTER", 0, 0, PAGE_COUNTER, /* 2002 */ - 0, 0 - }, - { "PAGE-SETUP", 0, 1, PAGE_SETUP, /* ACU extension */ - 0, CB_CS_GRAPHICAL_CONTROL | CB_CS_INQUIRE_MODIFY - }, - { "PAGED", 0, 1, PAGED, /* ACU extension */ - 0, CB_CS_GRAPHICAL_CONTROL | CB_CS_INQUIRE_MODIFY - }, - { "PARAGRAPH", 0, 1, PARAGRAPH, /* 2002 (C/S) */ - 0, CB_CS_EXIT - }, - { "PARENT", 0, 1, PARENT, /* ACU extension */ - 0, CB_CS_GRAPHICAL_CONTROL | CB_CS_INQUIRE_MODIFY - }, - { "PARSE", 0, 1, PARSE, /* IBM extension */ - 0, 0 - }, - {"PASCAL", 0, 1, PASCAL, /* Extension: implicit defined CALL-CONVENTION */ - 0, CB_CS_CALL | CB_CS_OPTIONS - }, - { "PASSWORD", 0, 1, PASSWORD, /* IBM extension */ - 0, CB_CS_SELECT - }, - { "PERFORM", 1, 0, PERFORM, /* 2002 */ - CB_CS_PERFORM, 0 - }, - { "PERMANENT", 0, 1, PERMANENT, /* ACU extension */ - 0, CB_CS_GRAPHICAL_CONTROL | CB_CS_INQUIRE_MODIFY - }, - { "PF", 0, 0, PF, /* 2002 */ - 0, 0 - }, - { "PH", 0, 0, PH, /* 2002 */ - 0, 0 - }, - { "PHYSICAL", 0, 0, PHYSICAL, /* 2014, note: - only listed as argument for LENGTH FUNCTIONS... */ - 0, 0 - }, - { "PIC", 0, 0, PICTURE, /* 2002 */ - 0, 0 - }, - { "PICTURE", 0, 0, PICTURE, /* 2002 */ - 0, 0 - }, - { "PIXEL", 0, 1, PIXEL, /* ACU extension */ - 0, CB_CS_GRAPHICAL_CONTROL | CB_CS_INQUIRE_MODIFY - }, - { "PLACEMENT", 0, 1, PLACEMENT, /* ACU extension */ - 0, CB_CS_GRAPHICAL_CONTROL | CB_CS_INQUIRE_MODIFY - }, - { "PLUS", 0, 0, PLUS, /* 2002 */ - 0, 0 - }, - { "POINTER", 0, 0, POINTER, /* 2002 */ - 0, 0 - }, - { "POP-UP", 0, 1, POP_UP, /* ACU extension */ - 0, CB_CS_DISPLAY - }, - { "POS", 0, 0, POS, /* ACU extension for AT POSITION */ - 0, 0 - }, - { "POSITION", 0, 0, POSITION, /* 85 */ - 0, 0 - }, - { "POSITION-SHIFT", 0, 1, POSITION_SHIFT, /* ACU extension */ - 0, CB_CS_GRAPHICAL_CONTROL | CB_CS_INQUIRE_MODIFY - }, - { "POSITIVE", 0, 0, POSITIVE, /* 2002 */ - 0, 0 - }, - { "PREFIXED", 0, 1, -1, /* 2014 (C/S) */ - 0, 0 - /* FIXME: 2014 Context-sensitive to ANY LENGTH STRUCTURE clause */ - }, - { "PRESENT", 0, 0, PRESENT, /* 2002 */ - 0, 0 - }, - { "PREVIOUS", 0, 1, PREVIOUS, /* 2002 (C/S) */ - 0, CB_CS_READ - }, - { "PRINT", 0, 1, PRINT, /* Extension */ - 0, CB_CS_ASSIGN - }, - { "PRINT-NO-PROMPT", 0, 1, PRINT_NO_PROMPT, /* ACU extension */ - 0, CB_CS_GRAPHICAL_CONTROL | CB_CS_INQUIRE_MODIFY - }, - { "PRINT-PREVIEW", 0, 1, PRINT_PREVIEW, /* ACU extension */ - 0, CB_CS_GRAPHICAL_CONTROL | CB_CS_INQUIRE_MODIFY - }, - { "PRINTER", 0, 1, PRINTER, /* Extension */ - 0, CB_CS_ASSIGN - }, - { "PRINTER-1", 0, 1, PRINTER_1, /* Extension */ - 0, CB_CS_ASSIGN - }, - { "PRINTING", 0, 0, PRINTING, /* 2002 */ - 0, 0 - }, - { "PRIORITY", 0, 0, PRIORITY, /* ACU extension */ - 0, 0 /* Checkme: likely context sensitive */ - }, - { "PROCEDURE", 0, 0, PROCEDURE, /* 2002 */ - 0, 0 - }, - { "PROCEDURE-POINTER", 0, 0, PROGRAM_POINTER, /* Extension */ - 0, 0 - }, - { "PROCEDURES", 0, 0, PROCEDURES, /* Extension */ - 0, 0 - }, - { "PROCEED", 0, 0, PROCEED, /* 85 */ - 0, 0 - }, - { "PROCESSING", 0, 1, PROCESSING, /* IBM extension */ - 0, CB_CS_XML_PARSE - }, - { "PROGRAM", 0, 0, PROGRAM, /* 2002 */ - 0, 0 - }, - { "PROGRAM-ID", 0, 0, PROGRAM_ID, /* 2002 */ - 0, 0 - }, - { "PROGRAM-POINTER", 0, 0, PROGRAM_POINTER, /* 2002 */ - 0, 0 - }, - { "PROGRESS", 0, 1, PROGRESS, /* ACU extension */ - 0, CB_CS_GRAPHICAL_CONTROL | CB_CS_INQUIRE_MODIFY - }, - { "PROHIBITED", 0, 1, PROHIBITED, /* 2014 (C/S) */ - 0, CB_CS_ROUNDED - /* FIXME: 2014 ... and INTERMEDIATE ROUNDING clause clause */ - }, - { "PROMPT", 0, 0, PROMPT, /* Extension */ - 0, 0 - }, - { "PROPERTIES", 0, 1, PROPERTIES, /* ACU extension */ - 0, CB_CS_GRAPHICAL_CONTROL | CB_CS_INQUIRE_MODIFY - }, - { "PROPERTY", 0, 0, PROPERTY, /* 2002, ACU extension */ - 0, 0 - }, - { "PROTECTED", 0, 1, PROTECTED, /* Extension PROTECTED SIZE */ - 0, CB_CS_ACCEPT - }, - { "PROTOTYPE", 0, 0, PROTOTYPE, /* 2002 */ - 0, 0 - }, - { "PURGE", 0, 0, PURGE, /* Communication Section */ - 0, 0 - }, - { "PUSH-BUTTON", 1, 1, PUSH_BUTTON, /* ACU extension */ - CB_CS_GRAPHICAL_CONTROL, CB_CS_DISPLAY | CB_CS_SCREEN - }, - { "QUERY-INDEX", 0, 1, QUERY_INDEX, /* ACU extension */ - 0, CB_CS_GRAPHICAL_CONTROL | CB_CS_INQUIRE_MODIFY - }, - { "QUEUE", 0, 0, QUEUE, /* Communication Section */ - 0, 0 - }, - { "QUOTE", 0, 0, QUOTE, /* 2002 */ - 0, 0 - }, - { "QUOTES", 0, 0, QUOTE, /* 2002 */ - 0, 0 - }, - { "RADIO-BUTTON", 1, 1, RADIO_BUTTON, /* ACU extension */ - CB_CS_GRAPHICAL_CONTROL, CB_CS_DISPLAY | CB_CS_SCREEN - }, - { "RAISE", 0, 0, RAISE, /* 2002 */ - 0, 0 - }, - { "RAISED", 0, 1, RAISED, /* ACU extension */ - 0, CB_CS_GRAPHICAL_CONTROL | CB_CS_INQUIRE_MODIFY - }, - { "RAISING", 0, 0, -1, /* 2002 */ - 0, 0 - }, - { "RANDOM", 0, 0, RANDOM, /* 2002 */ - 0, 0 - }, - { "RD", 0, 0, RD, /* 2002 */ - 0, 0 - }, - { "READ", 1, 0, READ, /* 2002 */ - CB_CS_READ, 0 - }, - { "READ-ONLY", 0, 1, READ_ONLY, /* ACU extension */ - 0, CB_CS_GRAPHICAL_CONTROL | CB_CS_INQUIRE_MODIFY - }, - { "READERS", 0, 1, READERS, /* ACU extension */ - 0, CB_CS_OPEN - }, - { "RECEIVE", 1, 0, RECEIVE, /* Communication Section */ - 0, 0 - }, - { "RECORD", 0, 0, RECORD, /* 2002 */ - 0, 0 - }, - { "RECORD-DATA", 0, 1, RECORD_DATA, /* ACU extension */ - 0, CB_CS_GRAPHICAL_CONTROL | CB_CS_INQUIRE_MODIFY - }, - { "RECORD-OVERFLOW", 0, 1, RECORD_OVERFLOW, /* OS/VS extension */ - 0, CB_CS_I_O_CONTROL - }, - { "RECORD-TO-ADD", 0, 1, RECORD_TO_ADD, /* ACU extension */ - 0, CB_CS_GRAPHICAL_CONTROL | CB_CS_INQUIRE_MODIFY - }, - { "RECORD-TO-DELETE", 0, 1, RECORD_TO_DELETE, /* ACU extension */ - 0, CB_CS_GRAPHICAL_CONTROL | CB_CS_INQUIRE_MODIFY - }, - { "RECORDING", 0, 0, RECORDING, /* Extension */ - CB_CS_RECORDING, 0 - }, - { "RECORDS", 0, 0, RECORDS, /* 2002 */ - 0, 0 - }, - { "RECURSIVE", 0, 1, RECURSIVE, /* 2002 (C/S) */ - 0, CB_CS_PROGRAM_ID - }, - { "REDEFINES", 0, 0, REDEFINES, /* 2002 */ - 0, 0 - }, - { "REEL", 0, 0, REEL, /* 2002 */ - 0, 0 - }, - { "REFERENCE", 0, 0, REFERENCE, /* 2002 */ - 0, 0 - }, - { "REFERENCES", 0, 0, REFERENCES, /* Obsolete */ - 0, 0 - }, - { "REFRESH", 0, 1, REFRESH, /* ACU extension */ - 0, CB_CS_GRAPHICAL_CONTROL | CB_CS_INQUIRE_MODIFY - }, - { "REGION-COLOR", 0, 1, REGION_COLOR, /* ACU extension */ - 0, CB_CS_GRAPHICAL_CONTROL | CB_CS_INQUIRE_MODIFY - }, - { "RELATION", 0, 1, -1, /* 2002 (C/S) */ - 0, 0 - /* FIXME: 2014 Context-sensitive to VALIDATE-STATUS clause */ - }, - { "RELATIVE", 0, 0, RELATIVE, /* 2002 */ - 0, 0 - }, - { "RELEASE", 0, 0, RELEASE, /* 2002 */ - 0, 0 - }, - { "REMAINDER", 0, 0, REMAINDER, /* 2002 */ - 0, 0 - }, - { "REMOVAL", 0, 0, REMOVAL, /* 2002 */ - 0, 0 - }, - { "RENAMES", 0, 0, RENAMES, /* 2002 */ - 0, 0 - }, - { "REORG-CRITERIA", 0, 1, REORG_CRITERIA, /* OS/VS extension */ - 0, CB_CS_I_O_CONTROL - }, - { "REPLACE", 0, 0, REPLACE, /* 2002 */ - 0, 0 - }, - { "REPLACING", 0, 0, REPLACING, /* 2002 */ - 0, 0 - }, - { "REPORT", 0, 0, REPORT, /* 2002 */ - 0, 0 - }, - { "REPORTING", 0, 0, REPORTING, /* 2002 */ - 0, 0 - }, - { "REPORTS", 0, 0, REPORTS, /* 2002 */ - 0, 0 - }, - { "REPOSITORY", 0, 0, REPOSITORY, /* 2002 */ - 0, 0 - }, - { "REQUIRED", 0, 1, REQUIRED, /* 2002 (C/S) */ - 0, CB_CS_ACCEPT | CB_CS_SCREEN - }, - { "REREAD", 0, 1, REREAD, /* OS/VS extension */ - 0, CB_CS_OPEN - }, - { "RERUN", 0, 1, RERUN, /* IBM extension */ - 0, CB_CS_I_O_CONTROL - }, - { "RESERVE", 0, 0, RESERVE, /* 2002 */ - 0, 0 - }, - { "RESET", 0, 0, RESET, /* 2002 */ - 0, 0 - }, - { "RESET-GRID", 0, 1, RESET_GRID, /* ACU extension */ - 0, CB_CS_GRAPHICAL_CONTROL | CB_CS_INQUIRE_MODIFY - }, - { "RESET-LIST", 0, 1, RESET_LIST, /* ACU extension */ - 0, CB_CS_GRAPHICAL_CONTROL | CB_CS_INQUIRE_MODIFY - }, - { "RESET-TABS", 0, 1, RESET_TABS, /* ACU extension */ - 0, CB_CS_GRAPHICAL_CONTROL | CB_CS_INQUIRE_MODIFY - }, - { "RESIDENT", 0, 1, RESIDENT, /* ACU extension */ - 0, CB_CS_PROGRAM_ID - }, - { "RESUME", 0, 0, -1, /* 2002 */ - 0, 0 - }, - { "RETRY", 0, 0, RETRY, /* 2002 */ - CB_CS_RETRY, 0 - }, - { "RETURN", 1, 0, RETURN, /* 2002 */ - 0, 0 - }, - { "RETURNING", 0, 0, RETURNING, /* 2002 */ - 0, 0 - }, - { "REVERSE", 0, 0, REVERSE, /* Extension */ - 0, 0 - }, - { "REVERSE-VIDEO", 0, 1, REVERSE_VIDEO, /* 2002 (C/S) */ - 0, CB_CS_ACCEPT | CB_CS_DISPLAY | CB_CS_SCREEN | CB_CS_SET - }, - { "REVERSED", 0, 0, REVERSED, /* Obsolete */ - 0, 0 - }, - { "REWIND", 0, 0, REWIND, /* 2002 */ - 0, 0 - }, - { "REWRITE", 1, 0, REWRITE, /* 2002 */ - 0, 0 - }, - { "RF", 0, 0, RF, /* 2002 */ - 0, 0 - }, - { "RH", 0, 0, RH, /* 2002 */ - 0, 0 - }, - { "RIGHT", 0, 0, RIGHT, /* 2002 */ - 0, 0 - }, - { "RIGHT-ALIGN", 0, 1, RIGHT_ALIGN, /* ACU extension */ - 0, CB_CS_GRAPHICAL_CONTROL | CB_CS_INQUIRE_MODIFY - }, - { "RIGHT-JUSTIFY", 0, 0, -1, /* Extension */ - 0, 0 - }, - { "RIMMED", 0, 1, RIMMED, /* ACU extension */ - 0, CB_CS_GRAPHICAL_CONTROL | CB_CS_INQUIRE_MODIFY - }, - { "ROLLBACK", 0, 0, ROLLBACK, /* Extension */ - 0, 0 - }, - { "ROUNDED", 0, 0, ROUNDED, /* 2002 */ - CB_CS_ROUNDED, 0 - }, - { "ROUNDING", 0, 1, ROUNDING, /* 2002 (C/S) */ - 0, CB_CS_OPTIONS - }, - { "ROW-COLOR", 0, 1, ROW_COLOR, /* ACU extension */ - 0, CB_CS_GRAPHICAL_CONTROL | CB_CS_INQUIRE_MODIFY - }, - { "ROW-COLOR-PATTERN", 0, 1, ROW_COLOR_PATTERN, /* ACU extension */ - 0, CB_CS_GRAPHICAL_CONTROL | CB_CS_INQUIRE_MODIFY - }, - { "ROW-DIVIDERS", 0, 1, ROW_DIVIDERS, /* ACU extension */ - 0, CB_CS_GRAPHICAL_CONTROL | CB_CS_INQUIRE_MODIFY - }, - { "ROW-FONT", 0, 1, ROW_FONT, /* ACU extension */ - 0, CB_CS_GRAPHICAL_CONTROL | CB_CS_INQUIRE_MODIFY - }, - { "ROW-HEADINGS", 0, 1, ROW_HEADINGS, /* ACU extension */ - 0, CB_CS_GRAPHICAL_CONTROL | CB_CS_INQUIRE_MODIFY - }, - { "ROW-PROTECTION", 0, 1, ROW_PROTECTION, /* ACU extension */ - 0, CB_CS_GRAPHICAL_CONTROL | CB_CS_INQUIRE_MODIFY - }, - { "RUN", 0, 0, RUN, /* 2002 */ - 0, 0 - }, - { "S", 0, 1, S, /* Extension */ - 0, CB_CS_RECORDING - }, - { "SAME", 0, 0, SAME, /* 2002 */ - 0, 0 - }, - { "SAVE-AS", 0, 1, SAVE_AS, /* ACU extension */ - 0, CB_CS_GRAPHICAL_CONTROL | CB_CS_INQUIRE_MODIFY - }, - { "SAVE-AS-NO-PROMPT", 0, 1, SAVE_AS_NO_PROMPT, /* ACU extension */ - 0, CB_CS_GRAPHICAL_CONTROL | CB_CS_INQUIRE_MODIFY - }, - { "SCREEN", 0, 0, SCREEN, /* 2002 */ - 0, 0 - }, - { "SCROLL", 0, 1, SCROLL, /* Extension */ - 0, CB_CS_ACCEPT | CB_CS_DISPLAY - }, - { "SCROLL-BAR", 1, 1, SCROLL_BAR, /* ACU extension */ - CB_CS_GRAPHICAL_CONTROL, CB_CS_DISPLAY | CB_CS_SCREEN - }, - { "SD", 0, 0, SD, /* 2002 */ - 0, 0 - }, - { "SEARCH", 1, 0, SEARCH, /* 2002 */ - 0, 0 - }, - { "SEARCH-OPTIONS", 0, 1, SEARCH_OPTIONS, /* ACU extension */ - 0, CB_CS_GRAPHICAL_CONTROL | CB_CS_INQUIRE_MODIFY - }, - { "SEARCH-TEXT", 0, 1, SEARCH_TEXT, /* ACU extension */ - 0, CB_CS_GRAPHICAL_CONTROL | CB_CS_INQUIRE_MODIFY - }, - { "SECONDS", 0, 1, SECONDS, /* 2002 (C/S) */ - 0, CB_CS_RETRY - }, - { "SECTION", 0, 0, SECTION, /* 2002 */ - 0, 0 - }, - { "SECURE", 0, 1, SECURE, /* 2002 (C/S) */ - 0, CB_CS_ACCEPT | CB_CS_DISPLAY | CB_CS_SCREEN - }, - { "SEGMENT", 0, 0, SEGMENT, /* Communication Section */ - 0, 0 - }, - { "SEGMENT-LIMIT", 0, 0, SEGMENT_LIMIT, /* 85 */ - 0, 0 - }, - { "SELECT", 1, 0, SELECT, /* 2002 */ - CB_CS_SELECT, 0 - }, - { "SELECT-ALL", 0, 1, SELECT_ALL, /* ACU extension */ - 0, CB_CS_GRAPHICAL_CONTROL | CB_CS_INQUIRE_MODIFY - }, - { "SELECTION-INDEX", 0, 1, SELECTION_INDEX, /* ACU extension */ - 0, CB_CS_GRAPHICAL_CONTROL | CB_CS_INQUIRE_MODIFY - }, - { "SELECTION-TEXT", 0, 1, SELECTION_TEXT, /* ACU extension */ - 0, CB_CS_GRAPHICAL_CONTROL | CB_CS_INQUIRE_MODIFY - }, - { "SELF", 0, 0, -1, /* 2002 */ - 0, 0 - }, - { "SELF-ACT", 0, 1, SELF_ACT, /* ACU extension */ - 0, CB_CS_GRAPHICAL_CONTROL | CB_CS_INQUIRE_MODIFY - }, - { "SEND", 0, 0, SEND, /* Communication Section */ - 0, 0 - }, - { "SENTENCE", 0, 0, SENTENCE, /* 2002 */ - 0, 0 - }, - { "SEPARATE", 0, 0, SEPARATE, /* 2002 */ - 0, 0 - }, - { "SEPARATION", 0, 1, SEPARATION, /* ACU extension */ - 0, CB_CS_GRAPHICAL_CONTROL | CB_CS_INQUIRE_MODIFY - }, - { "SEQUENCE", 0, 0, SEQUENCE, /* 2002 */ - 0, 0 - }, - { "SEQUENTIAL", 0, 0, SEQUENTIAL, /* 2002 */ - 0, 0 - }, - { "SET", 0, 0, SET, /* 2002 */ - 0, 0 - }, - { "SHADING", 0, 1, SHADING, /* ACU extension */ - 0, CB_CS_GRAPHICAL_CONTROL | CB_CS_INQUIRE_MODIFY - }, - { "SHADOW", 0, 1, SHADOW, /* ACU extension */ - 0, CB_CS_DISPLAY - }, - { "SHARING", 0, 0, SHARING, /* 2002 */ - 0, 0 - }, -#if 0 /* FIXME: 2014 Context-sensitive to ANY LENGTH STRUCTURE clause */ - { "SHORT", 0, 0, -1, /* 2014 */ - 0, 0 - }, -#endif - { "SHORT-DATE", 0, 1, SHORT_DATE, /* ACU extension */ - 0, CB_CS_GRAPHICAL_CONTROL | CB_CS_INQUIRE_MODIFY - }, - { "SHOW-LINES", 0, 1, SHOW_LINES, /* ACU extension */ - 0, CB_CS_GRAPHICAL_CONTROL | CB_CS_INQUIRE_MODIFY - }, - { "SHOW-NONE", 0, 1, SHOW_NONE, /* ACU extension */ - 0, CB_CS_GRAPHICAL_CONTROL | CB_CS_INQUIRE_MODIFY - }, - { "SHOW-SEL-ALWAYS", 0, 1, SHOW_SEL_ALWAYS, /* ACU extension */ - 0, CB_CS_GRAPHICAL_CONTROL | CB_CS_INQUIRE_MODIFY - }, - { "SIGN", 0, 0, SIGN, /* 2002 */ - 0, 0 - }, - { "SIGNED", 0, 0, SIGNED, /* 2002 (C/S) */ - 0, 0 - /* FIXME: 2014 Context-sensitive to ANY LENGTH STRUCTURE clause - and USAGE clause */ - }, - { "SIGNED-INT", 0, 0, SIGNED_INT, /* Extension */ - 0, 0 - }, - { "SIGNED-LONG", 0, 0, SIGNED_LONG, /* Extension */ - 0, 0 - }, - { "SIGNED-SHORT", 0, 0, SIGNED_SHORT, /* Extension */ - 0, 0 - }, - { "SIZE", 0, 0, SIZE, /* 2002 */ - 0, 0 - }, - { "SMALL-FONT", 0, 0, SMALL_FONT, /* ACU extension */ - 0, 0 /* Checkme: likely context sensitive */ - }, - { "SORT", 0, 0, SORT, /* 2002 */ - 0, 0 - }, - { "SORT-MERGE", 0, 0, SORT_MERGE, /* 2002 */ - 0, 0 - }, - { "SORT-ORDER", 0, 1, SORT_ORDER, /* ACU extension */ - 0, CB_CS_GRAPHICAL_CONTROL | CB_CS_INQUIRE_MODIFY - }, - { "SOURCE", 0, 0, SOURCE, /* 2002 */ - 0, 0 - }, - { "SOURCE-COMPUTER", 0, 0, SOURCE_COMPUTER, /* 2002 */ - 0, 0 - }, - { "SOURCES", 0, 0, -1, /* 2002 */ - 0, 0 - }, - { "SPACE", 0, 0, SPACE, /* 2002 */ - 0, 0 - }, - { "SPACE-FILL", 0, 0, -1, /* Extension */ - 0, 0 - }, - { "SPACES", 0, 0, SPACE, /* 2002 */ - 0, 0 - }, - { "SPECIAL-NAMES", 0, 0, SPECIAL_NAMES, /* 2002 */ - 0, 0 - }, - { "SPINNER", 0, 1, SPINNER, /* ACU extension */ - 0, CB_CS_GRAPHICAL_CONTROL | CB_CS_INQUIRE_MODIFY - }, - { "SQUARE", 0, 1, SQUARE, /* ACU extension */ - 0, CB_CS_GRAPHICAL_CONTROL | CB_CS_INQUIRE_MODIFY - }, - { "STANDARD", 0, 0, STANDARD, /* 2002 */ - 0, 0 - }, - { "STANDARD-1", 0, 0, STANDARD_1, /* 2002 */ - 0, 0 - }, - { "STANDARD-2", 0, 0, STANDARD_2, /* 2002 */ - 0, 0 - }, - { "STANDARD-BINARY", 0, 1, STANDARD_BINARY, /* 2014 (C/S) */ - 0, CB_CS_OPTIONS - }, - { "STANDARD-DECIMAL", 0, 1, STANDARD_DECIMAL, /* 2014 (C/S) */ - 0, CB_CS_OPTIONS - }, - { "START", 1, 0, START, /* 2002 */ - 0, 0 - }, - { "START-X", 0, 1, START_X, /* ACU extension */ - 0, CB_CS_GRAPHICAL_CONTROL | CB_CS_INQUIRE_MODIFY - }, - { "START-Y", 0, 1, START_Y, /* ACU extension */ - 0, CB_CS_GRAPHICAL_CONTROL | CB_CS_INQUIRE_MODIFY - }, - { "STATEMENT", 0, 1, -1, /* 2002 (C/S) */ - 0, 0 - /* FIXME: 2014 Context-sensitive to RESUME statement */ - }, - { "STATIC", 0, 1, STATIC, /* Extension: implicit defined CALL-CONVENTION */ - 0, CB_CS_CALL - }, - { "STATIC-LIST", 0, 1, STATIC_LIST, /* ACU extension */ - 0, CB_CS_GRAPHICAL_CONTROL | CB_CS_INQUIRE_MODIFY - }, - { "STATUS", 0, 0, STATUS, /* 2002 */ - 0, 0 - }, - { "STATUS-BAR", 1, 1, STATUS_BAR, /* ACU extension */ - CB_CS_GRAPHICAL_CONTROL, CB_CS_DISPLAY | CB_CS_SCREEN - }, - { "STATUS-TEXT", 0, 1, STATUS_TEXT, /* ACU extension */ - 0, CB_CS_GRAPHICAL_CONTROL | CB_CS_INQUIRE_MODIFY - }, - { "STDCALL", 0, 1, STDCALL, /* Extension: implicit defined CALL-CONVENTION */ - 0, CB_CS_CALL | CB_CS_OPTIONS - }, - { "STEP", 0, 1, STEP, /* 2002 (C/S) */ - 0, CB_CS_OCCURS - }, - { "STOP", 0, 0, STOP, /* 2002 */ - CB_CS_STOP, 0 - }, - { "STRING", 1, 0, STRING, /* 2002 */ - 0, 0 - }, - { "STRONG", 0, 1, -1, /* 2002 (C/S) */ - 0, 0 - /* FIXME: 2014 Context-sensitive to TYPEDEF clause */ - }, - { "STYLE", 0, 1, STYLE, /* ACU extension */ - 0, CB_CS_GRAPHICAL_CONTROL | CB_CS_INQUIRE_MODIFY - }, - { "SUB-QUEUE-1", 0, 0, SUB_QUEUE_1, /* Communication Section */ - 0, 0 - }, - { "SUB-QUEUE-2", 0, 0, SUB_QUEUE_2, /* Communication Section */ - 0, 0 - }, - { "SUB-QUEUE-3", 0, 0, SUB_QUEUE_3, /* Communication Section */ - 0, 0 - }, - { "SUBTRACT", 1, 0, SUBTRACT, /* 2002 */ - 0, 0 - }, - { "SUBWINDOW", 0, 0, SUBWINDOW, /* ACU extension */ - 0, 0 /* Checkme: likely context sensitive */ - }, - { "SUM", 0, 0, SUM, /* 2002 */ - 0, 0 - }, - { "SUPER", 0, 0, -1, /* 2002 */ - 0, 0 - }, - { "SUPPRESS", 0, 0, SUPPRESS, /* 2002 */ - 0, 0 - }, - { "SYMBOL", 0, 1, -1, /* 2002 (C/S) */ - 0, 0 - /* FIXME: 2014 Context-sensitive to CURRENCY clause */ - }, - { "SYMBOLIC", 0, 0, SYMBOLIC, /* 2002 */ - 0, 0 - }, - { "SYNC", 0, 0, SYNCHRONIZED, /* 2002 */ - 0, 0 - }, - { "SYNCHRONIZED", 0, 0, SYNCHRONIZED, /* 2002 */ - 0, 0 - }, - { "SYSTEM-DEFAULT", 0, 0, SYSTEM_DEFAULT, /* 2002 */ - 0, 0 - }, - { "SYSTEM-INFO", 0, 1, SYSTEM_INFO, /* ACU extension */ - 0, CB_CS_ACCEPT - }, - { "SYSTEM-OFFSET", 0, 0, SYSTEM_OFFSET, /* Extension */ - 0, 0 - }, - { "TAB", 1, 1, TAB, /* Extension */ - CB_CS_GRAPHICAL_CONTROL, CB_CS_ACCEPT | CB_CS_DISPLAY | CB_CS_SCREEN - }, - { "TAB-TO-ADD", 0, 1, TAB_TO_ADD, /* ACU extension */ - 0, CB_CS_GRAPHICAL_CONTROL | CB_CS_INQUIRE_MODIFY - }, - { "TAB-TO-DELETE", 0, 1, TAB_TO_DELETE, /* ACU extension */ - 0, CB_CS_GRAPHICAL_CONTROL | CB_CS_INQUIRE_MODIFY - }, - { "TABLE", 0, 0, TABLE, /* Communication Section */ - 0, 0 - }, - { "TALLYING", 0, 0, TALLYING, /* 2002 */ - 0, 0 - }, - { "TAPE", 0, 1, TAPE, /* 85 */ - 0, CB_CS_ASSIGN - }, - { "TEMPORARY", 0, 1, TEMPORARY, /* ACU extension */ - 0, CB_CS_GRAPHICAL_CONTROL | CB_CS_INQUIRE_MODIFY - }, - { "TERMINAL", 0, 0, TERMINAL, /* Communication Section */ - 0, 0 - }, - { "TERMINAL-INFO", 0, 1, TERMINAL_INFO, /* ACU extension */ - 0, CB_CS_ACCEPT - }, - { "TERMINATE", 0, 0, TERMINATE, /* 2002 */ - 0, 0 - }, - { "TERMINATION-VALUE", 0, 1, TERMINATION_VALUE, /* ACU extension */ - 0, CB_CS_GRAPHICAL_CONTROL | CB_CS_INQUIRE_MODIFY - }, - { "TEST", 0, 0, TEST, /* 2002 */ - 0, 0 - }, - { "TEXT", 0, 0, TEXT, /* Communication Section */ - 0, 0 - }, - { "THAN", 0, 0, THAN, /* 2002 */ - 0, 0 - }, - { "THEN", 0, 0, THEN, /* 2002 */ - 0, 0 - }, - { "THREAD", 0, 0, THREAD, /* ACU extension */ - 0, 0 - }, - { "THREADS", 0, 0, THREADS, /* ACU extension */ - 0, 0 - }, - { "THROUGH", 0, 0, THRU, /* 2002 */ - 0, 0 - }, - { "THRU", 0, 0, THRU, /* 2002 */ - 0, 0 - }, - { "THUMB-POSITION", 0, 1, THUMB_POSITION, /* ACU extension */ - 0, CB_CS_GRAPHICAL_CONTROL | CB_CS_INQUIRE_MODIFY - }, - { "TILED-HEADINGS", 0, 1, TILED_HEADINGS, /* ACU extension */ - 0, CB_CS_GRAPHICAL_CONTROL | CB_CS_INQUIRE_MODIFY - }, - { "TIME", 0, 0, TIME, /* 2002 */ - 0, 0 - }, - { "TIME-OUT", 0, 1, TIME_OUT, /* Ext (C/S) */ - 0, CB_CS_ACCEPT - }, - { "TIMES", 0, 0, TIMES, /* 2002 */ - 0, 0 - }, - { "TITLE", 0, 1, TITLE, /* ACU extension */ - 0, CB_CS_DISPLAY | CB_CS_INQUIRE_MODIFY - }, - { "TITLE-POSITION", 0, 1, TITLE_POSITION, /* ACU extension */ - 0, CB_CS_GRAPHICAL_CONTROL | CB_CS_INQUIRE_MODIFY - }, - { "TO", 0, 0, TO, /* 2002 */ - 0, 0 - }, - { "TOP", 0, 0, TOP, /* 2002 */ - 0, 0 - }, - { "TOWARD-GREATER", 0, 1, TOWARD_GREATER, /* 2014 (C/S) */ - 0, CB_CS_ROUNDED - }, - { "TOWARD-LESSER", 0, 1, TOWARD_LESSER, /* 2014 (C/S) */ - 0, CB_CS_ROUNDED - }, - { "TRACK", 0, 1, TRACK, /* OS/VS extension */ - 0, CB_CS_SELECT | CB_CS_I_O_CONTROL - }, - { "TRACKS", 0, 1, TRACKS, /* OS/VS extension */ - 0, CB_CS_SELECT | CB_CS_I_O_CONTROL - }, - { "TRACK-AREA", 0, 1, TRACK_AREA, /* OS/VS extension */ - 0, CB_CS_SELECT - }, - { "TRACK-LIMIT", 0, 1, TRACK_LIMIT, /* OS/VS extension */ - 0, CB_CS_SELECT - }, - { "TRADITIONAL-FONT", 0, 0, TRADITIONAL_FONT, /* ACU extension */ - 0, 0 /* Checkme: likely context sensitive */ - }, - { "TRAILING", 0, 0, TRAILING, /* 2002 */ - 0, 0 - }, - { "TRAILING-SHIFT", 0, 1, TRAILING_SHIFT, /* ACU extension */ - 0, CB_CS_GRAPHICAL_CONTROL | CB_CS_INQUIRE_MODIFY - }, - { "TRAILING-SIGN", 0, 0, -1, /* Extension */ - 0, 0 - }, - { "TRANSFORM", 0, 0, TRANSFORM, /* OSVS */ - 0, 0 - }, - { "TRANSACTION", 0, 0, TRANSACTION, /* ACU */ - 0, 0 - }, - { "TRANSPARENT", 0, 1, TRANSPARENT, /* ACU extension */ - 0, CB_CS_GRAPHICAL_CONTROL | CB_CS_INQUIRE_MODIFY - }, - { "TREE-VIEW", 1, 1, TREE_VIEW, /* ACU extension */ - CB_CS_GRAPHICAL_CONTROL, CB_CS_DISPLAY | CB_CS_SCREEN - }, - { "TRUE", 0, 0, TOK_TRUE, /* 2002 */ - 0, 0 - }, - { "TRUNCATION", 0, 1, TRUNCATION, /* 2014 (C/S) */ - 0, CB_CS_ROUNDED - /* FIXME: 2014 ... and INTERMEDIATE ROUNDING phrase */ - }, - { "TYPE", 0, 0, TYPE, /* 2002 */ - 0, 0 - }, - { "TYPEDEF", 0, 0, -1, /* 2002 */ - 0, 0 - }, - { "U", 0, 1, U, /* Extension */ - 0, CB_CS_RECORDING - }, - { "UCS-4", 0, 1, UCS_4, /* 2002 (C/S) */ - 0, CB_CS_ALPHABET - }, - { "UNBOUNDED", 0, 1, UNBOUNDED, /* IBM V5 */ - 0, CB_CS_OCCURS - }, - { "UNDERLINE", 0, 1, UNDERLINE, /* 2002 (C/S) */ - 0, CB_CS_ACCEPT | CB_CS_DISPLAY | CB_CS_SCREEN | CB_CS_SET - }, - { "UNFRAMED", 0, 1, UNFRAMED, /* ACU extension */ - 0, CB_CS_GRAPHICAL_CONTROL | CB_CS_INQUIRE_MODIFY - }, - { "UNIT", 0, 0, UNIT, /* 2002 */ - 0, 0 - }, - { "UNIVERSAL", 0, 0, -1, /* 2002 */ - 0, 0 - }, - { "UNLOCK", 0, 0, UNLOCK, /* 2002 */ - 0, 0 - }, - { "UNSIGNED", 0, 0, UNSIGNED, /* 2002 (C/S) */ - 0, 0 - }, - { "UNSIGNED-INT", 0, 0, UNSIGNED_INT, /* Extension */ - 0, 0 - }, - { "UNSIGNED-LONG", 0, 0, UNSIGNED_LONG, /* Extension */ - 0, 0 - }, - { "UNSIGNED-SHORT", 0, 0, UNSIGNED_SHORT, /* Extension */ - 0, 0 - }, - { "UNSORTED", 0, 1, UNSORTED, /* ACU extension */ - 0, CB_CS_GRAPHICAL_CONTROL | CB_CS_INQUIRE_MODIFY - }, - { "UNSTRING", 1, 0, UNSTRING, /* 2002 */ - 0, 0 - }, - { "UNTIL", 0, 0, UNTIL, /* 2002 */ - 0, 0 - }, - { "UP", 0, 0, UP, /* 2002 */ - 0, 0 - }, - { "UPDATE", 0, 0, UPDATE, /* Extension */ - 0, 0 - }, - { "UPDATERS", 0, 1, UPDATERS, /* ACU extension */ - 0, CB_CS_OPEN - }, - { "UPON", 0, 0, UPON, /* 2002 */ - 0, 0 - }, - { "UPPER", 0, 1, UPPER, /* Extension */ - 0, CB_CS_ACCEPT - }, - { "USAGE", 0, 0, USAGE, /* 2002 */ - 0, 0 - }, - { "USE", 0, 0, USE, /* 2002 */ - 0, 0 - }, - { "USE-ALT", 0, 1, USE_ALT, /* ACU extension */ - 0, CB_CS_GRAPHICAL_CONTROL | CB_CS_INQUIRE_MODIFY - }, - { "USE-RETURN", 0, 1, USE_RETURN, /* ACU extension */ - 0, CB_CS_GRAPHICAL_CONTROL | CB_CS_INQUIRE_MODIFY - }, - { "USE-TAB", 0, 1, USE_TAB, /* ACU extension */ - 0, CB_CS_GRAPHICAL_CONTROL | CB_CS_INQUIRE_MODIFY - }, - { "USER", 0, 1, USER, /* Extension */ - 0, CB_CS_FROM - }, - { "USER-DEFAULT", 0, 0, USER_DEFAULT, /* 2002 */ - 0, 0 - }, - { "USING", 0, 0, USING, /* 2002 */ - 0, 0 - }, - { "UTF-16", 0, 1, UTF_16, /* 2002 (C/S) */ - 0, CB_CS_ALPHABET - }, - { "UTF-8", 0, 1, UTF_8, /* 2002 (C/S) */ - 0, CB_CS_ALPHABET - }, - { "V", 0, 1, V, /* Extension */ - 0, CB_CS_RECORDING - }, - { "VAL-STATUS", 0, 0, -1, /* 2002 */ - 0, 0 - }, - { "VALID", 0, 0, -1, /* 2002 */ - 0, 0 - }, - { "VALIDATE", 0, 0, VALIDATE, /* 2002 */ - 0, 0 - }, - { "VALIDATE-STATUS", 0, 0, -1, /* 2002 */ - 0, 0 - }, - { "VALIDATING", 0, 1, VALIDATING, /* IBM extension */ - 0, CB_CS_XML_PARSE - }, - { "VALUE", 0, 0, VALUE, /* 2002 */ - 0, 0 - }, - { "VALUE-FORMAT", 0, 1, VALUE_FORMAT, /* ACU extension */ - 0, CB_CS_GRAPHICAL_CONTROL | CB_CS_INQUIRE_MODIFY - }, - { "VARIABLE", 0, 1, VARIABLE, /* Extension */ - 0, CB_CS_RECORDING - }, - { "VARIANT", 0, 0, VARIANT, /* ACU extension */ - 0, 0 - }, - { "VARYING", 0, 0, VARYING, /* 2002 */ - 0, 0 - }, - { "VERTICAL", 0, 1, VERTICAL, /* ACU extension */ - 0, CB_CS_GRAPHICAL_CONTROL | CB_CS_INQUIRE_MODIFY - }, - { "VERY-HEAVY", 0, 1, VERY_HEAVY, /* ACU extension */ - 0, CB_CS_GRAPHICAL_CONTROL | CB_CS_INQUIRE_MODIFY - }, - { "VIRTUAL-WIDTH", 0, 1, VIRTUAL_WIDTH, /* ACU extension */ - 0, CB_CS_GRAPHICAL_CONTROL | CB_CS_INQUIRE_MODIFY - }, - { "VISIBLE", 0, 1, VISIBLE, /* ACU extension */ - 0, CB_CS_SCREEN - }, - { "VOLATILE", 0, 0, VOLATILE, /* IBM Extension */ - 0, 0 - }, - { "VPADDING", 0, 1, VPADDING, /* ACU extension */ - 0, CB_CS_GRAPHICAL_CONTROL | CB_CS_INQUIRE_MODIFY - }, - { "VSCROLL", 0, 1, VSCROLL, /* ACU extension */ - 0, CB_CS_GRAPHICAL_CONTROL | CB_CS_INQUIRE_MODIFY - }, - { "VSCROLL-BAR", 0, 1, VSCROLL_BAR, /* ACU extension */ - 0, CB_CS_GRAPHICAL_CONTROL | CB_CS_INQUIRE_MODIFY - }, - { "VSCROLL-POS", 0, 1, VSCROLL_POS, /* ACU extension */ - 0, CB_CS_GRAPHICAL_CONTROL | CB_CS_INQUIRE_MODIFY - }, - { "VTOP", 0, 1, VTOP, /* ACU extension */ - 0, CB_CS_GRAPHICAL_CONTROL | CB_CS_INQUIRE_MODIFY - }, - { "WAIT", 0, 0, WAIT, /* Extension */ - 0, 0 - }, - { "WEB-BROWSER", 1, 1, WEB_BROWSER, /* ACU extension */ - CB_CS_GRAPHICAL_CONTROL, CB_CS_DISPLAY | CB_CS_SCREEN - }, - { "WHEN", 0, 0, WHEN, /* 2002 */ - 0, 0 - }, - { "WIDTH", 0, 1, WIDTH, /* ACU extension */ - 0, CB_CS_GRAPHICAL_CONTROL | CB_CS_INQUIRE_MODIFY - }, - { "WIDTH-IN-CELLS", 0, 1, WIDTH_IN_CELLS, /* ACU extension */ - 0, CB_CS_GRAPHICAL_CONTROL | CB_CS_INQUIRE_MODIFY - }, - { "WINDOW", 0, 0, WINDOW, /* ACU extension */ - 0, 0 - }, - { "WITH", 0, 0, WITH, /* 2002 */ - 0, 0 - }, - { "WORDS", 0, 0, WORDS, /* 85 */ - 0, 0 - }, - { "WORKING-STORAGE", 0, 0, WORKING_STORAGE, /* 2002 */ - 0, 0 - }, - { "WRAP", 0, 1, WRAP, /* Extension */ - 0, CB_CS_ACCEPT | CB_CS_DISPLAY - }, - { "WRITE", 1, 0, WRITE, /* 2002 */ - 0, 0 - }, - { "WRITE-ONLY", 0, 1, WRITE_ONLY, /* IBM extension */ - 0, CB_CS_I_O_CONTROL - }, - { "WRITE-VERIFY", 0, 1, WRITE_VERIFY, /* OS/VS extension */ - 0, CB_CS_I_O_CONTROL - }, - { "WRITERS", 0, 1, WRITERS, /* ACU extension */ - 0, CB_CS_OPEN - }, - { "X", 0, 1, X, /* ACU extension */ - 0, CB_CS_GRAPHICAL_CONTROL | CB_CS_INQUIRE_MODIFY - }, - { "XML", 1, 0, XML, /* IBM extension */ - 0, 0 - }, - { "XML-DECLARATION", 0, 1, XML_DECLARATION, /* IBM extension */ - 0, CB_CS_XML_GENERATE - }, - { "Y", 0, 1, Y, /* ACU extension */ - 0, CB_CS_GRAPHICAL_CONTROL | CB_CS_INQUIRE_MODIFY - }, - { "YYYYDDD", 0, 1, YYYYDDD, /* 2002 (C/S) */ - 0, CB_CS_DAY - }, - { "YYYYMMDD", 0, 1, YYYYMMDD, /* 2002 (C/S) */ - 0, CB_CS_DATE - }, - { "ZERO", 0, 0, ZERO, /* 2002 */ - 0, 0 - }, - { "ZERO-FILL", 0, 1, -1, /* Extension */ - 0, CB_CS_SCREEN - } -}; - -static unsigned int num_reserved_words; -#define NUM_DEFAULT_RESERVED_WORDS \ - sizeof (default_reserved_words) / sizeof (struct cobc_reserved) - -struct amendment_list { - struct amendment_list *next; /* next pointer */ - char *word; - char *alias_for; -#if 0 /* FIXME: store reference to origin */ - char *defined_by; -#endif - int is_context_sensitive; - int to_add; -}; - -struct register_struct { - const char *name; - const char *definition; - enum cb_feature_mode active; -}; - -static size_t current_register = 0; - -static struct register_struct register_list[] = { - {"ADDRESS OF", "USAGE POINTER", CB_FEATURE_ACTIVE}, /* FIXME: currently not handled the "normal" register way */ - {"COB-CRT-STATUS", "PICTURE 9(4) USAGE DISPLAY VALUE ZERO", CB_FEATURE_ACTIVE}, /* FIXME: currently not handled the "normal" register way */ - {"DEBUG-ITEM", "PICTURE X(n) USAGE DISPLAY", CB_FEATURE_ACTIVE}, /* FIXME: currently not handled the "normal" register way */ - {"LENGTH OF", "CONSTANT USAGE BINARY-LONG", CB_FEATURE_ACTIVE}, /* FIXME: currently not handled the "normal" register way */ - {"NUMBER-OF-CALL-PARAMETERS", "USAGE BINARY-LONG", CB_FEATURE_ACTIVE}, /* OpenCOBOL / GnuCOBOL extension, at least from 1.0+ */ - {"RETURN-CODE", "GLOBAL USAGE BINARY-LONG VALUE ZERO", CB_FEATURE_ACTIVE}, - {"SORT-RETURN", "GLOBAL USAGE BINARY-LONG VALUE ZERO", CB_FEATURE_ACTIVE}, - {"TALLY", "GLOBAL PICTURE 9(5) USAGE BINARY VALUE ZERO", CB_FEATURE_ACTIVE}, - {"COL", "PIC S9(4) USAGE COMP", CB_FEATURE_MUST_BE_ENABLED}, /* rare, normally conflicting --> must be explicit enabled */ - {"LIN", "PIC S9(4) USAGE COMP", CB_FEATURE_MUST_BE_ENABLED}, /* rare, only in combination with COL */ - {"WHEN-COMPILED", "CONSTANT PICTURE X(16) USAGE DISPLAY", CB_FEATURE_ACTIVE}, - {"XML-CODE", "GLOBAL PICTURE S9(9) USAGE BINARY VALUE 0", CB_FEATURE_ACTIVE}, - /* {"XML-EVENT", "USAGE DISPLAY PICTURE X(30) VALUE SPACE", CB_FEATURE_ACTIVE}, */ - /* {"XML-INFORMATION", "PICTURE S9(9) USAGE BINARY VALUE 0", CB_FEATURE_ACTIVE}, */ - /* {"XML-NAMESPACE", "PIC X ANY LENGTH", CB_FEATURE_ACTIVE}, /\* FIXME: currently not handled the "normal" register way *\/ */ - /* {"XML-NAMESPACE-PREFIX", "PIC X ANY LENGTH", CB_FEATURE_ACTIVE}, /\* FIXME: currently not handled the "normal" register way *\/ */ - /* {"XML-NNAMESPACE", "PIC N ANY LENGTH", CB_FEATURE_ACTIVE}, /\* FIXME: currently not handled the "normal" register way *\/ */ - /* {"XML-NNAMESPACE-PREFIX", "PIC N ANY LENGTH", CB_FEATURE_ACTIVE}, /\* FIXME: currently not handled the "normal" register way *\/ */ - /* {"XML-NTEXT", "PIC N ANY LENGTH", CB_FEATURE_ACTIVE}, /\* FIXME: currently not handled the "normal" register way *\/ */ - /* {"XML-TEXT", "PIC X ANY LENGTH", CB_FEATURE_ACTIVE} /\* FIXME: currently not handled the "normal" register way *\/ */ - {"JSON-CODE", "GLOBAL PICTURE S9(9) USAGE BINARY VALUE 0", CB_FEATURE_ACTIVE} - /* {"JSON-STATUS", "PIC X ANY LENGTH", CB_FEATURE_ACTIVE} /\* FIXME: currently not handled the "normal" register way *\/ */ -}; - -#define NUM_REGISTERS sizeof(register_list) / sizeof(struct register_struct) - -/* Intrinsic Function List */ -/* Must be ordered on name for binary search */ - -/* Name, Routine, */ -/* Token, Parser token, */ -/* Implemented, Number of arguments: Max [-1 = unlimited], Min, */ -/* Category, Can refmod */ - -static struct cb_intrinsic_table function_list[] = { - { "ABS", "cob_intr_abs", - CB_INTR_ABS, FUNCTION_NAME, - CB_FEATURE_ACTIVE, 1, 1, - CB_CATEGORY_NUMERIC, 0 - }, - /* ACUCOBOL-extension (synonym for ABS) */ - { "ABSOLUTE-VALUE", "cob_intr_abs", - CB_INTR_ABS, FUNCTION_NAME, - CB_FEATURE_DISABLED, 1, 1, - CB_CATEGORY_NUMERIC, 0 - }, - { "ACOS", "cob_intr_acos", - CB_INTR_ACOS, FUNCTION_NAME, - CB_FEATURE_ACTIVE, 1, 1, - CB_CATEGORY_NUMERIC, 0 - }, - { "ANNUITY", "cob_intr_annuity", - CB_INTR_ANNUITY, FUNCTION_NAME, - CB_FEATURE_ACTIVE, 2, 2, - CB_CATEGORY_NUMERIC, 0 - }, - { "ASIN", "cob_intr_asin", - CB_INTR_ASIN, FUNCTION_NAME, - CB_FEATURE_ACTIVE, 1, 1, - CB_CATEGORY_NUMERIC, 0 - }, - { "ATAN", "cob_intr_atan", - CB_INTR_ATAN, FUNCTION_NAME, - CB_FEATURE_ACTIVE, 1, 1, - CB_CATEGORY_NUMERIC, 0 - }, - { "BOOLEAN-OF-INTEGER", "cob_intr_boolean_of_integer", - CB_INTR_BOOLEAN_OF_INTEGER, FUNCTION_NAME, - CB_FEATURE_NOT_IMPLEMENTED, 2, 2, - CB_CATEGORY_NUMERIC, 0 - }, - { "BYTE-LENGTH", "cob_intr_byte_length", - CB_INTR_BYTE_LENGTH, LENGTH_FUNC, - CB_FEATURE_ACTIVE, 2, 1, - CB_CATEGORY_NUMERIC, 0 - }, - { "CHAR", "cob_intr_char", - CB_INTR_CHAR, FUNCTION_NAME, - CB_FEATURE_ACTIVE, 1, 1, - CB_CATEGORY_ALPHANUMERIC, 0 - }, - { "CHAR-NATIONAL", "cob_intr_char_national", - CB_INTR_CHAR_NATIONAL, FUNCTION_NAME, - CB_FEATURE_NOT_IMPLEMENTED, 1, 1, - CB_CATEGORY_NATIONAL, 0 - }, - { "COMBINED-DATETIME", "cob_intr_combined_datetime", - CB_INTR_COMBINED_DATETIME, FUNCTION_NAME, - CB_FEATURE_ACTIVE, 2, 2, - CB_CATEGORY_NUMERIC, 0 - }, - /* COBOL 202x */ - { "CONCAT", "cob_intr_concatenate", - CB_INTR_CONCATENATE, CONCATENATE_FUNC, - CB_FEATURE_ACTIVE, -1, 1, - CB_CATEGORY_ALPHANUMERIC, 1 - /* Note: category changed to alphabetic/national - depending on the content, see cb_build_intrinsic */ - }, - /* OpenCOBOL */ - { "CONCATENATE", "cob_intr_concatenate", - CB_INTR_CONCATENATE, CONCATENATE_FUNC, - CB_FEATURE_ACTIVE, -1, 1, - CB_CATEGORY_ALPHANUMERIC, 1 - /* Note: category changed to alphabetic/national - depending on the content, see cb_build_intrinsic */ - }, - { "CONTENT-LENGTH", "cob_intr_content_length", - CB_INTR_CONTENT_LENGTH, CONTENT_LENGTH_FUNC, - CB_FEATURE_ACTIVE, 1, 1, - CB_CATEGORY_NUMERIC, 0 - }, - /* GnuCOBOL */ - { "CONTENT-OF", "cob_intr_content_of", - CB_INTR_CONTENT_OF, CONTENT_OF_FUNC, - CB_FEATURE_ACTIVE, 2, 1, - CB_CATEGORY_ALPHANUMERIC, 1 - }, - { "COS", "cob_intr_cos", - CB_INTR_COS, FUNCTION_NAME, - CB_FEATURE_ACTIVE, 1, 1, - CB_CATEGORY_NUMERIC, 0 - }, - { "CURRENCY-SYMBOL", "cob_intr_currency_symbol", - CB_INTR_CURRENCY_SYMBOL, FUNCTION_NAME, - CB_FEATURE_ACTIVE, 0, 0, - CB_CATEGORY_ALPHANUMERIC, 0 - }, - { "CURRENT-DATE", "cob_intr_current_date", - CB_INTR_CURRENT_DATE, CURRENT_DATE_FUNC, - CB_FEATURE_ACTIVE, 0, 0, - CB_CATEGORY_ALPHANUMERIC, 1 - }, - { "DATE-OF-INTEGER", "cob_intr_date_of_integer", - CB_INTR_DATE_OF_INTEGER, FUNCTION_NAME, - CB_FEATURE_ACTIVE, 1, 1, - CB_CATEGORY_NUMERIC, 0 - }, - { "DATE-TO-YYYYMMDD", "cob_intr_date_to_yyyymmdd", - CB_INTR_DATE_TO_YYYYMMDD, FUNCTION_NAME, - CB_FEATURE_ACTIVE, 3, 1, - CB_CATEGORY_NUMERIC, 0 - }, - { "DAY-OF-INTEGER", "cob_intr_day_of_integer", - CB_INTR_DAY_OF_INTEGER, FUNCTION_NAME, - CB_FEATURE_ACTIVE, 1, 1, - CB_CATEGORY_NUMERIC, 0 - }, - { "DAY-TO-YYYYDDD", "cob_intr_day_to_yyyyddd", - CB_INTR_DAY_TO_YYYYDDD, FUNCTION_NAME, - CB_FEATURE_ACTIVE, 3, 1, - CB_CATEGORY_NUMERIC, 0 - }, - { "DISPLAY-OF", "cob_intr_display_of", - CB_INTR_DISPLAY_OF, DISPLAY_OF_FUNC, - CB_FEATURE_NOT_IMPLEMENTED, 2, 1, - CB_CATEGORY_ALPHANUMERIC, 1 - }, - { "E", "cob_intr_e", - CB_INTR_E, FUNCTION_NAME, - CB_FEATURE_ACTIVE, 0, 0, - CB_CATEGORY_NUMERIC, 0 - }, - { "EXCEPTION-FILE", "cob_intr_exception_file", - CB_INTR_EXCEPTION_FILE, FUNCTION_NAME, - CB_FEATURE_ACTIVE, 0, 0, - CB_CATEGORY_ALPHANUMERIC, 0 - }, - { "EXCEPTION-FILE-N", "cob_intr_exception_file_n", - CB_INTR_EXCEPTION_FILE_N, FUNCTION_NAME, - CB_FEATURE_NOT_IMPLEMENTED, 0, 0, - CB_CATEGORY_NATIONAL, 0 - }, - { "EXCEPTION-LOCATION", "cob_intr_exception_location", - CB_INTR_EXCEPTION_LOCATION, FUNCTION_NAME, - CB_FEATURE_ACTIVE, 0, 0, - CB_CATEGORY_ALPHANUMERIC, 0 - }, - { "EXCEPTION-LOCATION-N", "cob_intr_exception_location_n", - CB_INTR_EXCEPTION_LOCATION_N, FUNCTION_NAME, - CB_FEATURE_NOT_IMPLEMENTED, 0, 0, - CB_CATEGORY_NATIONAL, 0 - }, - { "EXCEPTION-STATEMENT", "cob_intr_exception_statement", - CB_INTR_EXCEPTION_STATEMENT, FUNCTION_NAME, - CB_FEATURE_ACTIVE, 0, 0, - CB_CATEGORY_ALPHANUMERIC, 0 - }, - { "EXCEPTION-STATUS", "cob_intr_exception_status", - CB_INTR_EXCEPTION_STATUS, FUNCTION_NAME, - CB_FEATURE_ACTIVE, 0, 0, - CB_CATEGORY_ALPHANUMERIC, 0 - }, - { "EXP", "cob_intr_exp", - CB_INTR_EXP, FUNCTION_NAME, - CB_FEATURE_ACTIVE, 1, 1, - CB_CATEGORY_NUMERIC, 0 - }, - { "EXP10", "cob_intr_exp10", - CB_INTR_EXP10, FUNCTION_NAME, - CB_FEATURE_ACTIVE, 1, 1, - CB_CATEGORY_NUMERIC, 0 - }, - { "FACTORIAL", "cob_intr_factorial", - CB_INTR_FACTORIAL, FUNCTION_NAME, - CB_FEATURE_ACTIVE, 1, 1, - CB_CATEGORY_NUMERIC, 0 - }, - { "FORMATTED-CURRENT-DATE", "cob_intr_formatted_current_date", - CB_INTR_FORMATTED_CURRENT_DATE, FUNCTION_NAME, - CB_FEATURE_ACTIVE, 1, 1, - CB_CATEGORY_ALPHANUMERIC, 1 - /* Note: category changed to national depending on the content, - see cb_build_intrinsic */ - }, - { "FORMATTED-DATE", "cob_intr_formatted_date", - CB_INTR_FORMATTED_DATE, FORMATTED_DATE_FUNC, - CB_FEATURE_ACTIVE, 2, 2, - CB_CATEGORY_ALPHANUMERIC, 1 - /* Note: category changed to national depending on the content, - see cb_build_intrinsic */ - }, - { "FORMATTED-DATETIME", "cob_intr_formatted_datetime", - CB_INTR_FORMATTED_DATETIME, FORMATTED_DATETIME_FUNC, - /* including implicit SYSTEM-OFFSET arg */ - CB_FEATURE_ACTIVE, 5, 4, - CB_CATEGORY_ALPHANUMERIC, 1 - /* Note: category changed to national depending on the content, - see cb_build_intrinsic */ - }, - { "FORMATTED-TIME", "cob_intr_formatted_time", - CB_INTR_FORMATTED_TIME, FORMATTED_TIME_FUNC, - /* including implicit SYSTEM-OFFSET arg */ - CB_FEATURE_ACTIVE, 4, 3, - CB_CATEGORY_ALPHANUMERIC, 1 - /* Note: category changed to national depending on the content, - see cb_build_intrinsic */ - }, - { "FRACTION-PART", "cob_intr_fraction_part", - CB_INTR_FRACTION_PART, FUNCTION_NAME, - CB_FEATURE_ACTIVE, 1, 1, - CB_CATEGORY_NUMERIC, 0 - }, - { "HIGHEST-ALGEBRAIC", "cob_intr_highest_algebraic", - CB_INTR_HIGHEST_ALGEBRAIC, FUNCTION_NAME, - CB_FEATURE_ACTIVE, 1, 1, - CB_CATEGORY_NUMERIC, 0 - }, - { "INTEGER", "cob_intr_integer", - CB_INTR_INTEGER, FUNCTION_NAME, - CB_FEATURE_ACTIVE, 1, 1, - CB_CATEGORY_NUMERIC, 0 - }, - { "INTEGER-OF-BOOLEAN", "cob_intr_integer_of_boolean", - CB_INTR_INTEGER_OF_BOOLEAN, FUNCTION_NAME, - CB_FEATURE_NOT_IMPLEMENTED, 1, 1, - CB_CATEGORY_NUMERIC, 0 - }, - { "INTEGER-OF-DATE", "cob_intr_integer_of_date", - CB_INTR_INTEGER_OF_DATE, FUNCTION_NAME, - CB_FEATURE_ACTIVE, 1, 1, - CB_CATEGORY_NUMERIC, 0 - }, - { "INTEGER-OF-DAY", "cob_intr_integer_of_day", - CB_INTR_INTEGER_OF_DAY, FUNCTION_NAME, - CB_FEATURE_ACTIVE, 1, 1, - CB_CATEGORY_NUMERIC, 0 - }, - { "INTEGER-OF-FORMATTED-DATE", "cob_intr_integer_of_formatted_date", - CB_INTR_INTEGER_OF_FORMATTED_DATE, FUNCTION_NAME, - CB_FEATURE_ACTIVE, 2, 2, - CB_CATEGORY_NUMERIC, 0 - }, - { "INTEGER-PART", "cob_intr_integer_part", - CB_INTR_INTEGER_PART, FUNCTION_NAME, - CB_FEATURE_ACTIVE, 1, 1, - CB_CATEGORY_NUMERIC, 0 - }, - { "LENGTH", "cob_intr_length", - CB_INTR_LENGTH, LENGTH_FUNC, - CB_FEATURE_ACTIVE, 2, 1, - CB_CATEGORY_NUMERIC, 0 - }, - { "LENGTH-AN", "cob_intr_byte_length", - CB_INTR_BYTE_LENGTH, LENGTH_FUNC, - CB_FEATURE_ACTIVE, 1, 1, - CB_CATEGORY_NUMERIC, 0 - }, - { "LOCALE-COMPARE", "cob_intr_locale_compare", - CB_INTR_LOCALE_COMPARE, FUNCTION_NAME, - CB_FEATURE_ACTIVE, 3, 2, - CB_CATEGORY_ALPHANUMERIC, 0 - }, - { "LOCALE-DATE", "cob_intr_locale_date", - CB_INTR_LOCALE_DATE, LOCALE_DATE_FUNC, - CB_FEATURE_ACTIVE, 2, 1, - CB_CATEGORY_ALPHANUMERIC, 1 - }, - { "LOCALE-TIME", "cob_intr_locale_time", - CB_INTR_LOCALE_TIME, LOCALE_TIME_FUNC, - CB_FEATURE_ACTIVE, 2, 1, - CB_CATEGORY_ALPHANUMERIC, 1 - }, - { "LOCALE-TIME-FROM-SECONDS", "cob_intr_lcl_time_from_secs", - CB_INTR_LOCALE_TIME_FROM_SECS, LOCALE_TIME_FROM_FUNC, - CB_FEATURE_ACTIVE, 2, 1, - CB_CATEGORY_ALPHANUMERIC, 1 - }, - { "LOG", "cob_intr_log", - CB_INTR_LOG, FUNCTION_NAME, - CB_FEATURE_ACTIVE, 1, 1, - CB_CATEGORY_NUMERIC, 0 - }, - { "LOG10", "cob_intr_log10", - CB_INTR_LOG10, FUNCTION_NAME, - CB_FEATURE_ACTIVE, 1, 1, - CB_CATEGORY_NUMERIC, 0 - }, - { "LOWER-CASE", "cob_intr_lower_case", - CB_INTR_LOWER_CASE, LOWER_CASE_FUNC, - CB_FEATURE_ACTIVE, 1, 1, - CB_CATEGORY_ALPHANUMERIC, 1 - /* Note: category changed to national depending on the content, - see cb_build_intrinsic */ - }, - { "LOWEST-ALGEBRAIC", "cob_intr_lowest_algebraic", - CB_INTR_LOWEST_ALGEBRAIC, FUNCTION_NAME, - CB_FEATURE_ACTIVE, 1, 1, - CB_CATEGORY_NUMERIC, 0 - }, - { "MAX", "cob_intr_max", - CB_INTR_MAX, FUNCTION_NAME, - CB_FEATURE_ACTIVE, -1, 1, - CB_CATEGORY_NUMERIC, 0 - /* Note: category changed to alphanumeric/index/national depending on the content, - see cb_build_intrinsic */ - }, - { "MEAN", "cob_intr_mean", - CB_INTR_MEAN, FUNCTION_NAME, - CB_FEATURE_ACTIVE, -1, 1, - CB_CATEGORY_NUMERIC, 0 - }, - { "MEDIAN", "cob_intr_median", - CB_INTR_MEDIAN, FUNCTION_NAME, - CB_FEATURE_ACTIVE, -1, 1, - CB_CATEGORY_NUMERIC, 0 - }, - { "MIDRANGE", "cob_intr_midrange", - CB_INTR_MIDRANGE, FUNCTION_NAME, - CB_FEATURE_ACTIVE, -1, 1, - CB_CATEGORY_NUMERIC, 0 - }, - { "MIN", "cob_intr_min", - CB_INTR_MIN, FUNCTION_NAME, - CB_FEATURE_ACTIVE, -1, 1, - CB_CATEGORY_NUMERIC, 0 - /* Note: category changed to alphanumeric/index/national depending on the content, - see cb_build_intrinsic */ - }, - { "MOD", "cob_intr_mod", - CB_INTR_MOD, FUNCTION_NAME, - CB_FEATURE_ACTIVE, 2, 2, - CB_CATEGORY_NUMERIC, 0 - }, - { "MODULE-CALLER-ID", "cob_intr_module_caller_id", - CB_INTR_MODULE_CALLER_ID, FUNCTION_NAME, - CB_FEATURE_ACTIVE, 0, 0, - CB_CATEGORY_ALPHANUMERIC, 0 - }, - { "MODULE-DATE", "cob_intr_module_date", - CB_INTR_MODULE_DATE, FUNCTION_NAME, - CB_FEATURE_ACTIVE, 0, 0, - CB_CATEGORY_NUMERIC, 0 - }, - { "MODULE-FORMATTED-DATE", "cob_intr_module_formatted_date", - CB_INTR_MODULE_FORMATTED_DATE, FUNCTION_NAME, - CB_FEATURE_ACTIVE, 0, 0, - CB_CATEGORY_ALPHANUMERIC, 0 - }, - { "MODULE-ID", "cob_intr_module_id", - CB_INTR_MODULE_ID, FUNCTION_NAME, - CB_FEATURE_ACTIVE, 0, 0, - CB_CATEGORY_ALPHANUMERIC, 0 - }, - { "MODULE-PATH", "cob_intr_module_path", - CB_INTR_MODULE_PATH, FUNCTION_NAME, - CB_FEATURE_ACTIVE, 0, 0, - CB_CATEGORY_ALPHANUMERIC, 0 - }, - { "MODULE-SOURCE", "cob_intr_module_source", - CB_INTR_MODULE_SOURCE, FUNCTION_NAME, - CB_FEATURE_ACTIVE, 0, 0, - CB_CATEGORY_ALPHANUMERIC, 0 - }, - { "MODULE-TIME", "cob_intr_module_time", - CB_INTR_MODULE_TIME, FUNCTION_NAME, - CB_FEATURE_ACTIVE, 0, 0, - CB_CATEGORY_NUMERIC, 0 - }, - { "MONETARY-DECIMAL-POINT", "cob_intr_mon_decimal_point", - CB_INTR_MON_DECIMAL_POINT, FUNCTION_NAME, - CB_FEATURE_ACTIVE, 0, 0, - CB_CATEGORY_ALPHANUMERIC, 0 - }, - { "MONETARY-THOUSANDS-SEPARATOR", "cob_intr_mon_thousands_sep", - CB_INTR_MON_THOUSANDS_SEP, FUNCTION_NAME, - CB_FEATURE_ACTIVE, 0, 0, - CB_CATEGORY_ALPHANUMERIC, 0 - }, - { "NATIONAL-OF", "cob_intr_national_of", - CB_INTR_NATIONAL_OF, NATIONAL_OF_FUNC, - CB_FEATURE_NOT_IMPLEMENTED, 2, 1, - CB_CATEGORY_NATIONAL, 1 - }, - { "NUMERIC-DECIMAL-POINT", "cob_intr_num_decimal_point", - CB_INTR_NUM_DECIMAL_POINT, FUNCTION_NAME, - CB_FEATURE_ACTIVE, 0, 0, - CB_CATEGORY_ALPHANUMERIC, 0 - }, - { "NUMERIC-THOUSANDS-SEPARATOR", "cob_intr_num_thousands_sep", - CB_INTR_NUM_THOUSANDS_SEP, FUNCTION_NAME, - CB_FEATURE_ACTIVE, 0, 0, - CB_CATEGORY_ALPHANUMERIC, 0 - }, - { "NUMVAL", "cob_intr_numval", - CB_INTR_NUMVAL, FUNCTION_NAME, - CB_FEATURE_ACTIVE, 1, 1, - CB_CATEGORY_NUMERIC, 0 - }, - { "NUMVAL-C", "cob_intr_numval_c", - CB_INTR_NUMVAL_C, NUMVALC_FUNC, - CB_FEATURE_ACTIVE, 2, 2, - CB_CATEGORY_NUMERIC, 0 - }, - { "NUMVAL-F", "cob_intr_numval_f", - CB_INTR_NUMVAL_F, FUNCTION_NAME, - CB_FEATURE_ACTIVE, 1, 1, - CB_CATEGORY_NUMERIC, 0 - }, - { "ORD", "cob_intr_ord", - CB_INTR_ORD, FUNCTION_NAME, - CB_FEATURE_ACTIVE, 1, 1, - CB_CATEGORY_NUMERIC, 0 - }, - { "ORD-MAX", "cob_intr_ord_max", - CB_INTR_ORD_MAX, FUNCTION_NAME, - CB_FEATURE_ACTIVE, -1, 1, - CB_CATEGORY_NUMERIC, 0 - }, - { "ORD-MIN", "cob_intr_ord_min", - CB_INTR_ORD_MIN, FUNCTION_NAME, - CB_FEATURE_ACTIVE, -1, 1, - CB_CATEGORY_NUMERIC, 0 - }, - { "PI", "cob_intr_pi", - CB_INTR_PI, FUNCTION_NAME, - CB_FEATURE_ACTIVE, 0, 0, - CB_CATEGORY_NUMERIC, 0 - }, - { "PRESENT-VALUE", "cob_intr_present_value", - CB_INTR_PRESENT_VALUE, FUNCTION_NAME, - CB_FEATURE_ACTIVE, -1, 2, - CB_CATEGORY_NUMERIC, 0 - }, - { "RANDOM", "cob_intr_random", - CB_INTR_RANDOM, FUNCTION_NAME, - CB_FEATURE_ACTIVE, 1, 0, - CB_CATEGORY_NUMERIC, 0 - }, - { "RANGE", "cob_intr_range", - CB_INTR_RANGE, FUNCTION_NAME, - CB_FEATURE_ACTIVE, -1, 1, - CB_CATEGORY_NUMERIC, 0 - }, - { "REM", "cob_intr_rem", - CB_INTR_REM, FUNCTION_NAME, - CB_FEATURE_ACTIVE, 2, 2, - CB_CATEGORY_NUMERIC, 0 - }, - { "REVERSE", "cob_intr_reverse", - CB_INTR_REVERSE, REVERSE_FUNC, - CB_FEATURE_ACTIVE, 1, 1, - CB_CATEGORY_ALPHANUMERIC, 1 - /* Note: category changed to national depending on the content, - see cb_build_intrinsic */ - }, - { "SECONDS-FROM-FORMATTED-TIME", "cob_intr_seconds_from_formatted_time", - CB_INTR_SECONDS_FROM_FORMATTED_TIME, FUNCTION_NAME, - CB_FEATURE_ACTIVE, 2, 2, - CB_CATEGORY_NUMERIC, 0 - }, - { "SECONDS-PAST-MIDNIGHT", "cob_intr_seconds_past_midnight", - CB_INTR_SECONDS_PAST_MIDNIGHT, FUNCTION_NAME, - CB_FEATURE_ACTIVE, 0, 0, - CB_CATEGORY_NUMERIC, 0 - }, - { "SIGN", "cob_intr_sign", - CB_INTR_SIGN, FUNCTION_NAME, - CB_FEATURE_ACTIVE, 1, 1, - CB_CATEGORY_NUMERIC, 0 - }, - { "SIN", "cob_intr_sin", - CB_INTR_SIN, FUNCTION_NAME, - CB_FEATURE_ACTIVE, 1, 1, - CB_CATEGORY_NUMERIC, 0 - }, - { "SQRT", "cob_intr_sqrt", - CB_INTR_SQRT, FUNCTION_NAME, - CB_FEATURE_ACTIVE, 1, 1, - CB_CATEGORY_NUMERIC, 0 - }, - { "STANDARD-COMPARE", "cob_intr_standard_compare", - CB_INTR_STANDARD_COMPARE, FUNCTION_NAME, - CB_FEATURE_NOT_IMPLEMENTED, 4, 2, - CB_CATEGORY_ALPHANUMERIC, 0 - }, - { "STANDARD-DEVIATION", "cob_intr_standard_deviation", - CB_INTR_STANDARD_DEVIATION, FUNCTION_NAME, - CB_FEATURE_ACTIVE, -1, 1, - CB_CATEGORY_NUMERIC, 0 - }, - { "STORED-CHAR-LENGTH", "cob_intr_stored_char_length", - CB_INTR_STORED_CHAR_LENGTH, FUNCTION_NAME, - CB_FEATURE_ACTIVE, 1, 1, - CB_CATEGORY_NUMERIC, 0 - }, - /* GnuCOBOL (added incompatible to COBOL 202x CCP 1.3) */ - { "SUBSTITUTE", "cob_intr_substitute", - CB_INTR_SUBSTITUTE, SUBSTITUTE_FUNC, - CB_FEATURE_ACTIVE, -1, 3, - CB_CATEGORY_ALPHANUMERIC, 1 - /* Note: category changed to alphabetic/national depending on the content, - see cb_build_intrinsic */ - }, - /* GnuCOBOL */ - { "SUBSTITUTE-CASE", "cob_intr_substitute_case", - CB_INTR_SUBSTITUTE_CASE, SUBSTITUTE_CASE_FUNC, - CB_FEATURE_ACTIVE, -1, 3, - CB_CATEGORY_ALPHANUMERIC, 1 - /* Note: category changed to alphabetic/national depending on the content, - see cb_build_intrinsic */ - }, - { "SUM", "cob_intr_sum", - CB_INTR_SUM, FUNCTION_NAME, - CB_FEATURE_ACTIVE, -1, 1, - CB_CATEGORY_NUMERIC, 0 - }, - { "TAN", "cob_intr_tan", - CB_INTR_TAN, FUNCTION_NAME, - CB_FEATURE_ACTIVE, 1, 1, - CB_CATEGORY_NUMERIC, 0 - }, - { "TEST-DATE-YYYYMMDD", "cob_intr_test_date_yyyymmdd", - CB_INTR_TEST_DATE_YYYYMMDD, FUNCTION_NAME, - CB_FEATURE_ACTIVE, 1, 1, - CB_CATEGORY_NUMERIC, 0 - }, - { "TEST-DAY-YYYYDDD", "cob_intr_test_day_yyyyddd", - CB_INTR_TEST_DAY_YYYYDDD, FUNCTION_NAME, - CB_FEATURE_ACTIVE, 1, 1, - CB_CATEGORY_NUMERIC, 0 - }, - { "TEST-FORMATTED-DATETIME", "cob_intr_test_formatted_datetime", - CB_INTR_TEST_FORMATTED_DATETIME, FUNCTION_NAME, - CB_FEATURE_ACTIVE, 2, 2, - CB_CATEGORY_NUMERIC, 0 - }, - { "TEST-NUMVAL", "cob_intr_test_numval", - CB_INTR_TEST_NUMVAL, FUNCTION_NAME, - CB_FEATURE_ACTIVE, 1, 1, - CB_CATEGORY_NUMERIC, 0 - }, - { "TEST-NUMVAL-C", "cob_intr_test_numval_c", - CB_INTR_TEST_NUMVAL_C, NUMVALC_FUNC, - CB_FEATURE_ACTIVE, 2, 2, - CB_CATEGORY_NUMERIC, 0 - }, - { "TEST-NUMVAL-F", "cob_intr_test_numval_f", - CB_INTR_TEST_NUMVAL_F, FUNCTION_NAME, - CB_FEATURE_ACTIVE, 1, 1, - CB_CATEGORY_NUMERIC, 0 - }, - { "TRIM", "cob_intr_trim", - CB_INTR_TRIM, TRIM_FUNC, - CB_FEATURE_ACTIVE, 2, 1, - CB_CATEGORY_ALPHANUMERIC, 1 - /* Note: category changed to national depending on the content, - see cb_build_intrinsic */ - }, - { "UPPER-CASE", "cob_intr_upper_case", - CB_INTR_UPPER_CASE, UPPER_CASE_FUNC, - CB_FEATURE_ACTIVE, 1, 1, - CB_CATEGORY_ALPHANUMERIC, 1 - /* Note: category changed to national depending on the content, - see cb_build_intrinsic */ - }, - { "VARIANCE", "cob_intr_variance", - CB_INTR_VARIANCE, FUNCTION_NAME, - CB_FEATURE_ACTIVE, -1, 1, - CB_CATEGORY_NUMERIC, 0 - }, - { "WHEN-COMPILED", "cob_intr_when_compiled", - CB_INTR_WHEN_COMPILED, WHEN_COMPILED_FUNC, - CB_FEATURE_ACTIVE, 0, 0, - CB_CATEGORY_ALPHANUMERIC, 1 - }, - { "YEAR-TO-YYYY", "cob_intr_year_to_yyyy", - CB_INTR_YEAR_TO_YYYY, FUNCTION_NAME, - CB_FEATURE_ACTIVE, 3, 1, - CB_CATEGORY_NUMERIC, 0 - } -}; - -#define NUM_INTRINSICS sizeof(function_list) / sizeof(struct cb_intrinsic_table) - -#ifdef HAVE_DESIGNATED_INITS -static const unsigned char cob_lower_tab[256] = { - ['a'] = 'A', - ['b'] = 'B', - ['c'] = 'C', - ['d'] = 'D', - ['e'] = 'E', - ['f'] = 'F', - ['g'] = 'G', - ['h'] = 'H', - ['i'] = 'I', - ['j'] = 'J', - ['k'] = 'K', - ['l'] = 'L', - ['m'] = 'M', - ['n'] = 'N', - ['o'] = 'O', - ['p'] = 'P', - ['q'] = 'Q', - ['r'] = 'R', - ['s'] = 'S', - ['t'] = 'T', - ['u'] = 'U', - ['v'] = 'V', - ['w'] = 'W', - ['x'] = 'X', - ['y'] = 'Y', - ['z'] = 'Z' -}; -#else -static unsigned char cob_lower_tab[256]; -static const unsigned char pcob_lower_tab[] = "abcdefghijklmnopqrstuvwxyz"; -static const unsigned char pcob_lower_val[] = "ABCDEFGHIJKLMNOPQRSTUVWXYZ"; -#endif - -struct list_reserved_line { - char *word_and_status; - char *aliases; -}; - -/* Local functions */ - -static int -cb_strcasecmp (const void *s1, const void *s2) -{ - const unsigned char *p1; - const unsigned char *p2; - unsigned char c1; - unsigned char c2; - - p1 = (const unsigned char *)s1; - p2 = (const unsigned char *)s2; - - for (;;) { - if (cob_lower_tab[*p1]) { - c1 = cob_lower_tab[*p1++]; - } else { - c1 = *p1++; - } - - if (cob_lower_tab[*p2]) { - c2 = cob_lower_tab[*p2++]; - } else { - c2 = *p2++; - } - - if (c1 != c2) { - return c1 < c2 ? -1 : 1; - } - if (!c1) { - break; - } - } - return 0; -} - -static int -reserve_comp (const void *p1, const void *p2) -{ - /* For efficiency, we use strcmp here instead of cb_strcasecmp. */ - return strcmp(((struct cobc_reserved *)p1)->name, - ((struct cobc_reserved *)p2)->name); -} - -static int -intrinsic_comp (const void *p1, const void *p2) -{ - /* For efficiency, we use strcmp here instead of cb_strcasecmp. */ - return strcmp (p1, ((struct cb_intrinsic_table *)p2)->name); -} - -static const char * -res_get_feature (const enum cb_system_name_category category) -{ - const char *s; - - switch (category) { - case CB_DEVICE_NAME: - s = _("device name"); - break; - case CB_SWITCH_NAME: - s = _("switch name"); - break; - case CB_FEATURE_NAME: - s = _("feature name"); - break; - /* LCOV_EXCL_START */ - default: - s = _("unknown"); - break; - /* LCOV_EXCL_STOP */ - } - return s; -} - -static struct cobc_reserved -create_dummy_reserved (const char *word) -{ - struct cobc_reserved ret; - - ret.name = word; - ret.nodegen = 0; - ret.context_sens = 0; - ret.token = -1; - ret.context_set = 0; - ret.context_test = 0; - - return ret; -} - -static void -free_amendment_content (struct amendment_list *to_free) -{ - cobc_main_free (to_free->word); - if (to_free->alias_for) { - cobc_main_free (to_free->alias_for); - } -} - -static void -free_amendment (struct amendment_list *to_free) -{ - free_amendment_content (to_free); - cobc_main_free (to_free); -} - -static COB_INLINE COB_A_INLINE int -has_context_sensitive_indicator (const char *word, const size_t size) -{ - return word[size - 1] == '*'; -} - -/* - Copy the first len characters of source, uppercased, to dest. We use - cob_lower_tab instead of toupper for efficiency. -*/ -static void -strncpy_upper (char *dest, const char * const source, const size_t len) -{ - size_t i; - - for (i = 0; i < len; ++i) { - if (cob_lower_tab[(int)source[i]]) { - dest[i] = cob_lower_tab[(int)source[i]]; - } else { - dest[i] = source[i]; - } - } -} - -static void -allocate_upper_case_str_removing_asterisk (const char *word, const size_t size, - char ** const out_str) -{ - size_t chars_to_copy; - - if (has_context_sensitive_indicator (word, size)) { - /* Don't copy the trailing asterisk */ - chars_to_copy = size - 1; - } else { - chars_to_copy = size; - } - - *out_str = cobc_main_malloc (chars_to_copy + 1U); - strncpy_upper (*out_str, word, chars_to_copy); - (*out_str)[chars_to_copy] = '\0'; -} - -static COB_INLINE COB_A_INLINE void -initialize_word (const char *word, const size_t size, - struct amendment_list * const reserved) -{ - allocate_upper_case_str_removing_asterisk (word, size, &reserved->word); -} - -static int -is_invalid_word (const char *word, const int size, - const char *fname, const int line) -{ - /* FIXME: Should use the current (dialect specific) maximum word length, - not the absolute maximum, check order of reading and add test case */ - if (size > COB_MAX_WORDLEN) { - configuration_error (fname, line, 1, - _("reserved word must have less than %d characters"), - COB_MAX_WORDLEN); - return 1; - } - /* TO-DO: add more checks here */ - COB_UNUSED(word); - return 0; -} - -static void -initialize_alias_for (const char *alias_for, - struct amendment_list * const reserved, - const char *fname, const int line) -{ - size_t size = strlen (alias_for); - - if (has_context_sensitive_indicator (alias_for, size)) { - size--; - configuration_warning (fname, line, - _("ignored asterisk at end of alias target")); - } - if (is_invalid_word (alias_for, size, fname, line)) { - reserved->alias_for = NULL; - } else { - allocate_upper_case_str_removing_asterisk (alias_for, size, &reserved->alias_for); - } -} - -static struct cobc_reserved * -search_reserved_list (const char * const word, const int needs_uppercasing, - const struct cobc_reserved * const list, size_t list_len) -{ - static char upper_word[43]; - size_t word_len; - const char *sought_word; - struct cobc_reserved to_find; - - if (needs_uppercasing) { - word_len = strlen (word); - if (word_len > sizeof(upper_word) - 1) { - return NULL; - } - - /* copy including terminating byte */ - strncpy_upper (upper_word, word, word_len + 1); - sought_word = upper_word; - } else { - sought_word = word; - } - - to_find = create_dummy_reserved (sought_word); - return bsearch (&to_find, list, list_len, sizeof (struct cobc_reserved), - reserve_comp); -} - -static struct cobc_reserved * -find_default_reserved_word (const char * const word, const int needs_uppercasing) -{ - return search_reserved_list (word, needs_uppercasing, - default_reserved_words, - NUM_DEFAULT_RESERVED_WORDS); -} - -static struct cobc_reserved -get_user_specified_reserved_word (struct amendment_list user_reserved) -{ - struct cobc_reserved cobc_reserved = create_dummy_reserved (NULL); - struct cobc_reserved *p; - - cobc_reserved.name = cobc_main_malloc (strlen (user_reserved.word) + 1); - strcpy ((char *) cobc_reserved.name, user_reserved.word); - - if (!user_reserved.alias_for) { - cobc_reserved.context_sens - = !!user_reserved.is_context_sensitive; - } else { - p = find_default_reserved_word (user_reserved.alias_for, 0); - if (p) { - cobc_reserved.token = p->token; - } else { - /* FIXME: can we point to the fname originally defining the word? */ - configuration_error (NULL, 0, 1, - _("alias target '%s' is not a default reserved word"), - user_reserved.alias_for); - } - } - - return cobc_reserved; -} - -static int -followed_by_addition_for_same_word (const struct amendment_list * const addition) -{ - struct amendment_list *l; - - /* Walk through the list after the first addition. */ - for (l = addition->next; l; l = l->next) { - /* Look for elements with the same word. */ - /* NB: We can use strcmp instead of cb_strcasecmp because - everything is already uppercase. */ - if (!strcmp (addition->word, l->word) - && l->to_add) { - return 1; - } - } - - return 0; -} - -/* - Returns 1 if a removal for the same word as addition is found (and removed). -*/ -static int -try_remove_removal (struct amendment_list * const addition) -{ - struct amendment_list *l = addition->next; - struct amendment_list *prev = addition; - - while (l) { - /* Look for elements with the same word. */ - if (strcmp (addition->word, l->word)) { - prev = l; - l = l->next; - continue; - } - - if (!l->to_add) { - prev->next = l->next; - free_amendment (l); - l = prev->next; - - return 1; - } - } - - return 0; -} - -/* - Reduce the amendment list to a list of additions. Any removals which are not - cancelled out are deleted. -*/ -static void -reduce_amendment_list (struct amendment_list **amendment_list) -{ - struct amendment_list *l = *amendment_list; - struct amendment_list *prev = NULL; - struct amendment_list *next; - int delete_current_elt = 0; - - while (l) { - if (l->to_add) { - /* - Later duplicate additions take overwrite previous ones - and a removal and the previous addition cancel each - other out. - */ - delete_current_elt = followed_by_addition_for_same_word (l) - || try_remove_removal (l); - } else { - delete_current_elt = 1; - } - - if (delete_current_elt) { - next = l->next; - if (prev) { - prev->next = next; - } - if (l == *amendment_list) { - *amendment_list = next; - } - free_amendment (l); - l = next; - - delete_current_elt = 0; - } else { - prev = l; - l = l->next; - } - } -} - -static int -hash_word (const cob_c8_t *word, const cob_u32_t mod) -{ - cob_u32_t result = 0x811c9dc5; - - /* Perform 32-bit FNV1a hash */ - for (; *word; ++word) { - result ^= toupper (*word); - result *= (cob_u32_t) 0x1677619; - } - - return result % mod; -} - -#define HASHMAP(type, type_struct, word_member) \ - static struct type_struct **type##_map; \ - static size_t type##_map_arr_size; \ - static unsigned int num_##type##s; \ - \ - static void \ - init_##type##_map (void) \ - { \ - type##_map_arr_size = 512; \ - num_##type##s = 0; \ - type##_map = cobc_main_malloc (type##_map_arr_size * sizeof (void *)); \ - } \ - \ - static COB_INLINE COB_A_INLINE int \ - type##_hash (const char *word) \ - { \ - return hash_word ((const cob_c8_t *) word, type##_map_arr_size); \ - } \ - \ - static COB_INLINE COB_A_INLINE int \ - next_##type##_key (const unsigned int key) \ - { \ - if (key < type##_map_arr_size - 1) { \ - return key + 1; \ - } else { \ - return 0; \ - } \ - } \ - \ - static unsigned int \ - find_key_for_##type (const char * const word) \ - { \ - unsigned int key; \ - \ - for (key = type##_hash (word); \ - type##_map[key] && cb_strcasecmp (type##_map[key]->word_member, word); \ - key = next_##type##_key (key)); \ - \ - return key; \ - } \ - \ - static void \ - realloc_##type##_map (const size_t new_size) \ - { \ - struct type_struct **new_map = cobc_main_malloc (new_size * sizeof(void *)); \ - struct type_struct **old_map = type##_map; \ - size_t old_size = type##_map_arr_size; \ - unsigned int i; \ - unsigned int key; \ - \ - type##_map_arr_size = new_size; \ - type##_map = new_map; \ - \ - for (i = 0; i < old_size; ++i) { \ - if (old_map[i]) { \ - key = find_key_for_##type (old_map[i]->word_member); \ - type##_map[key] = old_map[i]; \ - } \ - } \ - \ - cobc_main_free (old_map); \ - } \ - \ - static void \ - delete_##type##_with_key (const int key) \ - { \ - cobc_main_free (type##_map[key]); \ - type##_map[key] = NULL; \ - } \ - \ - static int \ - add_##type##_to_map (const struct type_struct val, const int overwrite) \ - { \ - unsigned int key; \ - int entry_already_there; \ - \ - if (!type##_map) { \ - init_##type##_map (); \ - } \ - /* \ - The "- 1" is there so there is always one NULL entry in the \ - array. If there is not one and the array is full, \ - find_##type will not terminate when given a word which \ - shares a hash with a different word. \ - */ \ - if (num_##type##s == type##_map_arr_size - 1) { \ - realloc_##type##_map (type##_map_arr_size * 2); \ - } \ - \ - key = find_key_for_##type (val.word_member); \ - entry_already_there = !!type##_map[key]; \ - if (entry_already_there) { \ - if (overwrite) { \ - delete_##type##_with_key (key); \ - } else { \ - return 1; \ - } \ - } else { \ - ++num_##type##s; \ - } \ - \ - type##_map[key] = cobc_main_malloc (sizeof (struct type_struct)); \ - *type##_map[key] = val; \ - return entry_already_there; \ - } - -/* These functions are separate to suppress "unused function" warnings. */ -#define HASHMAP_EXTRA(type, type_struct) \ - static void \ - remove_##type##_from_map (const char * const word) \ - { \ - int key = find_key_for_##type (word); \ - \ - if (type##_map[key]) { \ - delete_##type##_with_key (key); \ - } \ - } \ - static struct type_struct * \ - find_##type (const char * const word) \ - { \ - return type##_map[find_key_for_##type (word)]; \ - } \ - \ - - -HASHMAP(reserved_word, cobc_reserved, name) -HASHMAP_EXTRA(reserved_word, cobc_reserved) -HASHMAP(amendment, amendment_list, word) - -static void -get_reserved_words_with_amendments (void) -{ - unsigned int i; - struct amendment_list *amendment; - unsigned int key; - struct cobc_reserved reserved; - struct cobc_reserved *p; - - if (cb_reserved_words == NULL) { - /* - Prepend the default reserved words to the amendment list as - additions. - */ - for (i = 0; i < NUM_DEFAULT_RESERVED_WORDS; ++i) { - amendment = cobc_main_malloc (sizeof (struct amendment_list)); - amendment->word = cobc_main_malloc (strlen (default_reserved_words[i].name) + 1); - strcpy (amendment->word, default_reserved_words[i].name); - amendment->to_add = 1; - amendment->is_context_sensitive = default_reserved_words[i].context_sens; - - if (add_amendment_to_map (*amendment, 0)) { - key = find_key_for_amendment (amendment->word); - amendment->next = amendment_map[key]; - amendment_map[key] = amendment; - } - } - } - - /* - Populate reserved_word_map with data from default_reserved_words, - where possible. Free each word once processed. - */ - for (i = 0; i < amendment_map_arr_size; ++i) { - reduce_amendment_list (&amendment_map[i]); - - if (!amendment_map[i]) { - continue; - } - - p = find_default_reserved_word (amendment_map[i]->word, 0); - if (p && !amendment_map[i]->alias_for) { - reserved = *p; - if (!amendment_map[i]->is_context_sensitive) { - /* - We only preserve context-sensitivity if the - user specifically asks for it. - */ - reserved.context_sens = 0; - reserved.context_test = 0; - } - } else { - reserved = get_user_specified_reserved_word (*amendment_map[i]); - } - add_reserved_word_to_map (reserved, 0); - - free_amendment_content (amendment_map[i]); - delete_amendment_with_key (i); - } -} - -static void -get_reserved_words_from_default_list (void) -{ - int i; - - init_reserved_word_map (); - - for (i = 0; i < NUM_DEFAULT_RESERVED_WORDS; ++i) { - add_reserved_word_to_map (default_reserved_words[i], 0); - } -} - -static void -initialize_reserved_words_if_needed (void) -{ - if (!reserved_word_map) { - /* The default reserved words list should be sorted, but - assuming so causes abstruse errors when a word is put in the - wrong place (e.g. when dealing with EBCDIC or hyphens). */ - qsort (default_reserved_words, NUM_DEFAULT_RESERVED_WORDS, - sizeof (struct cobc_reserved), reserve_comp); - - if (num_amendments) { - get_reserved_words_with_amendments (); - } else { - get_reserved_words_from_default_list (); - } - } -} - -static int -list_line_cmp (const void *l, const void *r) -{ - return strcmp (((const struct list_reserved_line *)l)->word_and_status, - ((const struct list_reserved_line *)r)->word_and_status); -} - -static int -strcmp_for_qsort (const void *l, const void *r) -{ - return strcmp ((const char *)l, (const char *)r); -} - -static void -get_aliases (const unsigned int key, struct list_reserved_line *line) -{ - int given_token = reserved_word_map[key]->token; - unsigned int i; - unsigned int j; - unsigned int num_aliases = 0; - unsigned int aliases_str_len = 0; - char (*aliases)[COB_MAX_WORDLEN + 1]; - char *aliases_str; - - if (given_token <= 0) { - line->aliases = NULL; - return; - } - - /* Count number of aliases and their total length. */ - for (i = 0; i < reserved_word_map_arr_size; ++i) { - if (i != key - && reserved_word_map[i] - && reserved_word_map[i]->token == given_token) { - ++num_aliases; - aliases_str_len += strlen (reserved_word_map[i]->name); - } - } - - if (num_aliases == 0) { - return; - } - - /* Create array of aliases, then sort it. */ - aliases = cobc_malloc ((size_t)num_aliases * (COB_MAX_WORDLEN + 1) * sizeof (char)); - j = 0; - for (i = 0; i < reserved_word_map_arr_size; ++i) { - if (i != key - && reserved_word_map[i] - && reserved_word_map[i]->token == given_token) { - strncpy (aliases[j], reserved_word_map[i]->name, - COB_MAX_WORDLEN); - ++j; - } - } - qsort (aliases, num_aliases, COB_MAX_WORDLEN + 1, &strcmp_for_qsort); - - /* Build aliases string */ - aliases_str = cobc_malloc (strlen ("(aliased with ") - + aliases_str_len - + (num_aliases - 1) * strlen (", ") - + strlen (")") - + 1); - strcpy (aliases_str, "(aliased with "); - for (j = 0; j < num_aliases; ++j) { - if (j != 0) { - strcat (aliases_str, ", "); - } - strcat (aliases_str, aliases[j]); - } - strcat (aliases_str, ")"); - cobc_free (aliases); - line->aliases = aliases_str; -} - -/* Global functions */ - -/* TO-DO: Duplication with lookup_reserved_word */ -int -is_reserved_word (const char *word) -{ - return !!find_reserved_word (word); -} - -int -is_default_reserved_word (const char *word) -{ - return !!find_default_reserved_word (word, 1); -} - -void -remove_context_sensitivity (const char *word, const int context) -{ - struct cobc_reserved *reserved = - find_default_reserved_word (word, 1); - - if (reserved) { - reserved->context_test ^= context; - } -} - -cb_tree -get_system_name (const char *name) -{ - struct system_name_struct *system_name = lookup_system_name (name, 0); - - if (system_name != NULL) { - return cb_build_system_name (system_name->category, - system_name->token); - } - return NULL; -} - -/* get system name, revert word-combination of scanner.l, - if necessary (e.g. SWITCH A <--> SWITCH_A) */ -cb_tree -get_system_name_translated (cb_tree word) -{ - char system_name[COB_MAX_WORDLEN + 1]; - cb_tree res; - - system_name[COB_MAX_WORDLEN] = 0; - strncpy(system_name, CB_NAME (word), COB_MAX_WORDLEN); - if (system_name [6] == '_') { - system_name [6] = ' '; - } - - res = get_system_name(system_name); - if (!res) { - cb_error_x (word, _("invalid system-name '%s'"), system_name); - } - - return res; -} - -static void -append_amendment_at_word (struct amendment_list amendment) -{ - int key; - struct amendment_list *l; - - if (add_amendment_to_map (amendment, 0)) { - /* - If there is already an amendment for this word, append the - amendment to the word's amendment list. - */ - key = find_key_for_amendment (amendment.word); - for (l = amendment_map[key]; l->next; l = l->next); - l->next = cobc_main_malloc (sizeof (struct amendment_list)); - *(l->next) = amendment; - } -} - -/* - parameter *word has no white space, may include context sensitive indicator - and/or alias definition: a* a=b a*=b - - *word is a static char * when line < 0 ! -*/ -static void -add_amendment (const char *word, const char *fname, const int line, - const int to_add) -{ - struct amendment_list amendment; - size_t size; - char *equal_sign_pos; - int context_sensitive; - - /* Check for alias and context sensitive indicator, - get and check the length of the word */ - equal_sign_pos = strchr (word, '='); - if (equal_sign_pos) { - size = equal_sign_pos - word; - } else { - size = strlen (word); - } - context_sensitive = has_context_sensitive_indicator (word, size); - if (context_sensitive) { - size--; - } - - /* - Only verify entries that don't come from the default word list. Line 0 - means the entry came from the command line. Line -1 means it came from - the default word list. - */ - if (line >= 0 && is_invalid_word (word, size, fname, line)) { - return; - } - - amendment.is_context_sensitive = context_sensitive; - amendment.to_add = to_add; - amendment.next = NULL; - initialize_word (word, size, &amendment); - - /* If it is an alias, copy what it is an alias for */ - if (to_add && equal_sign_pos) { - initialize_alias_for (equal_sign_pos + 1, &amendment, fname, - line); - } else { - amendment.alias_for = NULL; - } - - append_amendment_at_word (amendment); -} - -void -add_reserved_word (const char *word, const char *fname, const int line) -{ - add_amendment (word, fname, line, 1); -} - -void -remove_reserved_word (const char *word, const char *fname, const int line) -{ - add_amendment (word, fname, line, 0); -} - -/* add reserved word to the current list, called as "target" of - reserved word directives */ -void -add_reserved_word_now (char * const word, char * const alias_for) -{ - struct amendment_list amendment; - - /* Nothing to do if the word is already reserved */ - if (is_reserved_word (word)) { - return; - } - - /* LCOV_EXCL_START */ - if (alias_for && !is_default_reserved_word (alias_for)) { - /* Should not happen */ - COBC_ABORT (); - } - /* LCOV_EXCL_STOP */ - - amendment.word = word; - amendment.alias_for = alias_for; - amendment.is_context_sensitive = 0; - amendment.to_add = 1; - add_reserved_word_to_map (get_user_specified_reserved_word (amendment), 0); -} - -void -remove_reserved_word_now (char * const word) -{ - remove_reserved_word_from_map (word); -} - -struct cobc_reserved * -lookup_reserved_word (const char *name) -{ - struct cobc_reserved *p; - - initialize_reserved_words_if_needed (); - - p = find_reserved_word (name); - if (!p) { - return NULL; - } - - /* Check word is implemented */ - if (unlikely(p->token <= 0)) { - /* Not implemented - If context sensitive, no error */ - if (!p->context_sens) { - cb_error (_("'%s' is a reserved word, but isn't supported"), name); - } - return NULL; - } - - /* Special actions / Context sensitive */ - if (p->context_set) { - if (unlikely(p->context_test)) { - /* Dependent words */ - if (!(cobc_cs_check & p->context_test)) { - return NULL; - } - } - cobc_cs_check |= p->context_set; - return p; - } - - if (p->context_test) { - if (!(cobc_cs_check & p->context_test)) { - return NULL; - } - /* - The only context-sensitive phrases outside the procedure division - we expect to manually reset cobc_cs_check are OPTIONS, SELECT, - I-O-CONTROL and SCREEN. - - Note: Everything in the environment and identification division can - (and does) reset cobc_cs_check. - */ - if (!cobc_in_procedure - && !(cobc_cs_check & CB_CS_OPTIONS) - && !(cobc_cs_check & CB_CS_SELECT) - && !(cobc_cs_check & CB_CS_I_O_CONTROL) - && !(cobc_cs_check & CB_CS_SCREEN)) { - cobc_cs_check = 0; - } - return p; - } - - if (p->token == FUNCTION_ID) { - cobc_cs_check = 0; - cobc_force_literal = 1; - } else if (p->token == INTRINSIC) { - if (!cobc_in_repository) { - return NULL; - } - } else if (p->token == PROGRAM_ID) { - cobc_cs_check = CB_CS_PROGRAM_ID; - cobc_force_literal = 1; - } else if (p->token == REPOSITORY) { - cobc_in_repository = 1; - } - - return p; -} - -struct cb_intrinsic_table * -lookup_intrinsic (const char *name, const int checkimpl) -{ - struct cb_intrinsic_table *cbp; - static char upper_name[43]; - size_t name_len = strlen (name); - - if (name_len > sizeof (upper_name) - 1) { - return NULL; - } - - /* copy including terminating byte */ - strncpy_upper (upper_name, name, name_len + 1); - - cbp = bsearch (upper_name, function_list, NUM_INTRINSICS, - sizeof (struct cb_intrinsic_table), intrinsic_comp); - if (cbp && (checkimpl || cbp->active == CB_FEATURE_ACTIVE)) { - return cbp; - } - return NULL; -} - -static void -set_intrinsic_mode (struct cb_intrinsic_table *cbp, enum cb_feature_mode mode) -{ - /* FIXME: doesn't cater for not implemented -> disabled -> active [should be not implemented again] */ - if (cbp->active == CB_FEATURE_NOT_IMPLEMENTED && mode == CB_FEATURE_ACTIVE) { - return; - } - cbp->active = mode; -} - -static void -change_intrinsic (const char *name, const char *fname, const int line, enum cb_feature_mode mode) -{ - struct cb_intrinsic_table *cbp; - size_t i; - - /* Group "ALL" intrinsics */ - if (cb_strcasecmp (name, "DIALECT-ALL") == 0) { - for (i = 0; i < NUM_INTRINSICS; ++i) { - set_intrinsic_mode (&function_list[i], mode); - } - return; - } - - cbp = lookup_intrinsic (name, 1); - if (!cbp) { - if (mode == CB_FEATURE_ACTIVE) { - configuration_error (fname, line, 1, _("intrinsic function %s is unknown"), name); - } - return; - } - set_intrinsic_mode (cbp, mode); -} - -void -activate_intrinsic (const char *name, const char *fname, const int line) -{ - change_intrinsic (name, fname, line, CB_FEATURE_ACTIVE); -} - -void -deactivate_intrinsic (const char *name, const char *fname, const int line) -{ - change_intrinsic (name, fname, line, CB_FEATURE_DISABLED); -} - -void -cb_list_intrinsics (void) -{ - const char *t; - char argnum [20]; - size_t i; - - putchar ('\n'); - printf ("%-32s%-16s%s\n", - _("Intrinsic Function"), _("Implemented"), _("Parameters")); - for (i = 0; i < NUM_INTRINSICS; ++i) { - switch (function_list[i].active) { - case CB_FEATURE_ACTIVE: - t = _("Yes"); - break; - case CB_FEATURE_NOT_IMPLEMENTED: - t = _("No"); - break; - default: /* CB_FEATURE_DISABLED */ - continue; - } - if (function_list[i].args == -1) { - snprintf (argnum, sizeof (argnum) - 1, "%s", _("Unlimited")); - } else if (function_list[i].args != function_list[i].min_args) { - snprintf (argnum, sizeof (argnum) - 1, "%d - %d", - (int)function_list[i].min_args, (int)function_list[i].args); - } else { - snprintf (argnum, sizeof (argnum) - 1, "%d", (int)function_list[i].args); - } - printf ("%-32s%-16s%s\n", function_list[i].name, t, argnum); - } -} - -static struct register_struct * -lookup_register (const char *name, const int checkimpl) -{ - size_t i; - static char upper_name[43]; - size_t name_len = strlen (name); - - if (name_len > sizeof (upper_name) - 1) { - return NULL; - } - - /* copy including terminating byte */ - strncpy_upper (upper_name, name, name_len + 1); - - for (i = 0; i < NUM_REGISTERS; ++i) { - /* For efficiency, we use strcmp instead of cb_strcasecmp. */ - if (strcmp (register_list[i].name, upper_name) == 0) { - if (checkimpl || register_list[i].active == CB_FEATURE_MUST_BE_ENABLED) { - return ®ister_list[i]; - } - break; - } - } - return NULL; -} - -/* add an entry to the register list, currently the definition is ignored, - TODO: check definition and add a new special register accordingly */ - -void -add_register (const char *name_and_definition, const char *fname, const int line) -{ - const char *name = name_and_definition; - int i; - char *definition; - struct register_struct *special_register; - - /* Enable all registers, if requested. */ - if (cb_strcasecmp (name, "DIALECT-ALL") == 0) { - for (i = 0; i < NUM_REGISTERS; ++i) { - if (register_list[i].active != CB_FEATURE_MUST_BE_ENABLED) { - /* TODO: add register here */ - register_list[i].active = CB_FEATURE_ACTIVE; - /* Disable reserved word with same name. */ - remove_reserved_word (register_list[i].name, fname, line); - } - } - return; - } - - /* Otherwise enable a named register. */ - - /* note: we don't break at space as this would kill "ADDRESS OF" - and "PIC 9(05) USAGE ..." */ - definition = strpbrk (name_and_definition, "\t:="); - if (definition) { - *definition++ = 0; - } - - special_register = lookup_register (name, 1); - if (!special_register) { - if (!definition || *definition == 0) { - configuration_error (fname, line, 1, - _("special register %s is unknown, needs a definition"), name); - return; - } -#if 0 /* must be extended and tested before use... */ - cb_build_generic_register (name, definition); -#else - configuration_error (fname, line, 1, _("special register %s is unknown"), name); -#endif - return; - } - special_register->active = CB_FEATURE_ACTIVE; - - /* Disable reserved word with same name. */ - remove_reserved_word (name, fname, line); -} - -void -remove_register (const char *name, const char *fname, const int line) -{ - struct register_struct *special_register; - int i; - - COB_UNUSED (fname); - COB_UNUSED (line); - - if (cb_strcasecmp (name, "DIALECT-ALL") == 0) { - for (i = 0; i < NUM_REGISTERS; ++i) { - if (register_list[i].active != CB_FEATURE_MUST_BE_ENABLED) { - /* TODO: when user-defined registers are possible: do - memory cleanup here */ - register_list[i].active = CB_FEATURE_DISABLED; - /* Disable reserved word with same name. */ - remove_reserved_word (register_list[i].name, fname, - line); - } - } - } else { - special_register = lookup_register (name, 1); - if (!special_register) { - return; - } - /* TODO: when user-defined registers are possible: do memory - cleanup here */ - special_register->active = CB_FEATURE_DISABLED; - /* Disable reserved word with same name. */ - remove_reserved_word (name, fname, line); - } -} - -const char * -cb_register_list_get_first (const char **definition) -{ - current_register = 0; - return cb_register_list_get_next (definition); -} - -const char * -cb_register_list_get_next (const char **definition) -{ - for (; current_register < NUM_REGISTERS; ++current_register) { - if (register_list[current_register].active == CB_FEATURE_ACTIVE) { - *definition = register_list[current_register].definition; - return register_list[current_register++].name; - } - } - return NULL; -} - -const char * -cb_get_register_definition (const char *name) -{ - struct register_struct *special_register = lookup_register (name, 0); - - if (!special_register) { - return NULL; - } - return special_register->definition; -} - -void -cb_list_registers (void) -{ - size_t i; - const char *name, *t; - char name_display[COB_MINI_BUFF]; - - /* TODO: implement creation from user-specified list (currently only enable/disable) - Note: will still be able to be referenced if not implemented, - but not set/read by libcob [still helps compilation but should raise a warning] - */ - - putchar ('\n'); - printf ("%-32s%-16s%s\n", - _("Internal registers"), _("Implemented"), _("Definition")); - for (i = 0; i < NUM_REGISTERS; ++i) { - switch (register_list[i].active) { - case CB_FEATURE_ACTIVE: - t = _("Yes"); - break; - case CB_FEATURE_NOT_IMPLEMENTED: - t = _("No"); - break; - default: /* CB_FEATURE_DISABLED */ - continue; - } - if (strcmp (register_list[i].name, "LENGTH OF") != 0 - && strcmp (register_list[i].name, "ADDRESS OF") != 0) { - name = register_list[i].name; - } else { - snprintf (name_display, COB_MINI_MAX, "'%s' phrase", register_list[i].name); - name = (const char *)&name_display; - } - printf ("%-32s%-16s%s\n", name, t, register_list[i].definition); - } -} - -static struct system_name_struct * -lookup_system_name (const char *name, const int checkimpl) -{ - size_t i; - - for (i = 0; i < SYSTEM_TAB_SIZE; ++i) { - if (cb_strcasecmp (system_name_table[i].name, name) == 0) { - if (checkimpl || system_name_table[i].active != CB_FEATURE_DISABLED) { - return &system_name_table[i]; - } - break; - } - } - return NULL; -} - -static void -set_system_name_mode (struct system_name_struct *system_name, enum cb_feature_mode mode) -{ - /* FIXME: doesn't cater for not implemented -> disabled -> active [should be not implemented again] */ - if (system_name->active == CB_FEATURE_NOT_IMPLEMENTED && mode == CB_FEATURE_ACTIVE) { - return; - } - system_name->active = mode; -} - -static void -change_system_name (const char *name, const char *fname, const int line, enum cb_feature_mode mode) -{ - struct system_name_struct *system_name; - size_t i; - - - /* some predefined groups first */ - if (cb_strcasecmp (name, "DIALECT-ALL") == 0) { - for (i = 0; i < SYSTEM_TAB_SIZE; ++i) { - set_system_name_mode (&system_name_table[i], mode); - } - return; - } else if (cb_strcasecmp (name, "DIALECT-ALL-DEVICES") == 0) { - for (i = 0; i < SYSTEM_TAB_SIZE; ++i) { - if (system_name_table[i].category == CB_DEVICE_NAME) { - set_system_name_mode (&system_name_table[i], mode); - } - } - return; - } else if (cb_strcasecmp (name, "DIALECT-ALL-SWITCHES") == 0) { - for (i = 0; i < SYSTEM_TAB_SIZE; ++i) { - if (system_name_table[i].category == CB_SWITCH_NAME) { - set_system_name_mode (&system_name_table[i], mode); - } - } - return; - } else if (cb_strcasecmp (name, "DIALECT-ALL-FEATURES") == 0) { - for (i = 0; i < SYSTEM_TAB_SIZE; ++i) { - if (system_name_table[i].category == CB_FEATURE_NAME) { - set_system_name_mode (&system_name_table[i], mode); - } - } - return; - } - - system_name = lookup_system_name (name, 1); - if (!system_name) { - if (mode == CB_FEATURE_ACTIVE) { - configuration_error (fname, line, 1, _("unknown system-name '%s'"), name); - } - return; - } - set_system_name_mode (system_name, mode); -} - -void -activate_system_name (const char *name, const char *fname, const int line) -{ - change_system_name (name, fname, line, CB_FEATURE_ACTIVE); -} - -void -deactivate_system_name (const char *name, const char *fname, const int line) -{ - change_system_name (name, fname, line, CB_FEATURE_DISABLED); -} - -void -cb_list_system_names (void) -{ - const char *feature; - size_t i; - - putchar ('\n'); - puts (_("System names")); - for (i = 0; i < SYSTEM_TAB_SIZE; ++i) { - if (system_name_table[i].active == CB_FEATURE_DISABLED) { - continue; - } - feature = res_get_feature (system_name_table[i].category); - printf ("%-32s%s\n", system_name_table[i].name, feature); - } -} - - -void -cb_list_reserved (void) -{ - struct list_reserved_line *word_descriptions; - const char *p; - size_t i; - size_t j; - - initialize_reserved_words_if_needed (); - - /* Output header */ - putchar ('\n'); - printf ("%-32s%s\n", _("Reserved Words"), _("Implemented")); - - /* Build list of reserved words */ - word_descriptions = cobc_malloc (num_reserved_words * sizeof (struct list_reserved_line)); - j = -1; - for (i = 0; i < num_reserved_words; ++i) { - do { - ++j; - } while (!reserved_word_map[j]); - - if (reserved_word_map[j]->token > 0) { - if (reserved_word_map[j]->context_sens) { - p = _("Yes (Context sensitive)"); - } else { - p = _("Yes"); - } - } else { - if (reserved_word_map[j]->context_sens) { - p = _("No (Context sensitive)"); - } else { - p = _("No"); - } - } - word_descriptions[i].word_and_status = cobc_malloc (COB_MAX_WORDLEN + 1); - snprintf (word_descriptions[i].word_and_status, COB_MAX_WORDLEN, - "%-32s%s", reserved_word_map[j]->name, p); - get_aliases (j, &word_descriptions[i]); - } - - /* Display sorted list with aliases. */ - qsort (word_descriptions, num_reserved_words, - sizeof (struct list_reserved_line), &list_line_cmp); - for (i = 0; i < num_reserved_words; ++i) { - printf ("%s", word_descriptions[i].word_and_status); - cobc_free (word_descriptions[i].word_and_status); - if (word_descriptions[i].aliases) { - printf (" %s", word_descriptions[i].aliases); - cobc_free (word_descriptions[i].aliases); - } - putchar ('\n'); - } - cobc_free (word_descriptions); - - /* Output other words and registers. */ - putchar ('\n'); - /* FIXME: handle these as normal context sensitive words by - checking in scanner.l if these are reserved */ - puts (_("Extra (obsolete) context sensitive words")); - puts ("AUTHOR"); - puts ("DATE-COMPILED"); - puts ("DATE-MODIFIED"); - puts ("DATE-WRITTEN"); - puts ("INSTALLATION"); - puts ("REMARKS"); - puts ("SECURITY"); - - /* note: starts with an empty line */ - cb_list_registers (); -} - -#ifndef HAVE_DESIGNATED_INITS -void -cobc_init_reserved (void) -{ - const unsigned char *p; - const unsigned char *v; - - memset (cob_lower_tab, 0, sizeof(cob_lower_tab)); - p = pcob_lower_tab; - v = pcob_lower_val; - for (; *p; ++p, ++v) { - cob_lower_tab[*p] = *v; - } -} -#endif diff -Nru gnucobol-4.0~early~20200606/cobc/scanner.c gnucobol-5/cobc/scanner.c --- gnucobol-4.0~early~20200606/cobc/scanner.c 2020-06-06 20:52:41.000000000 +0000 +++ gnucobol-5/cobc/scanner.c 1970-01-01 00:00:00.000000000 +0000 @@ -1,5589 +0,0 @@ -#line 2 "scanner.c" - -#line 4 "scanner.c" - -#define YY_INT_ALIGNED short int - -/* A lexical scanner generated by flex */ - -#define FLEX_SCANNER -#define YY_FLEX_MAJOR_VERSION 2 -#define YY_FLEX_MINOR_VERSION 6 -#define YY_FLEX_SUBMINOR_VERSION 4 -#if YY_FLEX_SUBMINOR_VERSION > 0 -#define FLEX_BETA -#endif - -/* First, we deal with platform-specific or compiler-specific issues. */ - -/* begin standard C headers. */ -#include -#include -#include -#include - -/* end standard C headers. */ - -/* flex integer type definitions */ - -#ifndef FLEXINT_H -#define FLEXINT_H - -/* C99 systems have . Non-C99 systems may or may not. */ - -#if defined (__STDC_VERSION__) && __STDC_VERSION__ >= 199901L - -/* C99 says to define __STDC_LIMIT_MACROS before including stdint.h, - * if you want the limit (max/min) macros for int types. - */ -#ifndef __STDC_LIMIT_MACROS -#define __STDC_LIMIT_MACROS 1 -#endif - -#include -typedef int8_t flex_int8_t; -typedef uint8_t flex_uint8_t; -typedef int16_t flex_int16_t; -typedef uint16_t flex_uint16_t; -typedef int32_t flex_int32_t; -typedef uint32_t flex_uint32_t; -#else -typedef signed char flex_int8_t; -typedef short int flex_int16_t; -typedef int flex_int32_t; -typedef unsigned char flex_uint8_t; -typedef unsigned short int flex_uint16_t; -typedef unsigned int flex_uint32_t; - -/* Limits of integral types. */ -#ifndef INT8_MIN -#define INT8_MIN (-128) -#endif -#ifndef INT16_MIN -#define INT16_MIN (-32767-1) -#endif -#ifndef INT32_MIN -#define INT32_MIN (-2147483647-1) -#endif -#ifndef INT8_MAX -#define INT8_MAX (127) -#endif -#ifndef INT16_MAX -#define INT16_MAX (32767) -#endif -#ifndef INT32_MAX -#define INT32_MAX (2147483647) -#endif -#ifndef UINT8_MAX -#define UINT8_MAX (255U) -#endif -#ifndef UINT16_MAX -#define UINT16_MAX (65535U) -#endif -#ifndef UINT32_MAX -#define UINT32_MAX (4294967295U) -#endif - -#ifndef SIZE_MAX -#define SIZE_MAX (~(size_t)0) -#endif - -#endif /* ! C99 */ - -#endif /* ! FLEXINT_H */ - -/* begin standard C++ headers. */ - -/* TODO: this is always defined, so inline it */ -#define yyconst const - -#if defined(__GNUC__) && __GNUC__ >= 3 -#define yynoreturn __attribute__((__noreturn__)) -#else -#define yynoreturn -#endif - -/* Returned upon end-of-file. */ -#define YY_NULL 0 - -/* Promotes a possibly negative, possibly signed char to an - * integer in range [0..255] for use as an array index. - */ -#define YY_SC_TO_UI(c) ((YY_CHAR) (c)) - -/* Enter a start condition. This macro really ought to take a parameter, - * but we do it the disgusting crufty way forced on us by the ()-less - * definition of BEGIN. - */ -#define BEGIN (yy_start) = 1 + 2 * -/* Translate the current start state into a value that can be later handed - * to BEGIN to return to the state. The YYSTATE alias is for lex - * compatibility. - */ -#define YY_START (((yy_start) - 1) / 2) -#define YYSTATE YY_START -/* Action number for EOF rule of a given start state. */ -#define YY_STATE_EOF(state) (YY_END_OF_BUFFER + state + 1) -/* Special action meaning "start processing a new file". */ -#define YY_NEW_FILE yyrestart( yyin ) -#define YY_END_OF_BUFFER_CHAR 0 - -/* Size of default input buffer. */ -#ifndef YY_BUF_SIZE -#ifdef __ia64__ -/* On IA-64, the buffer size is 16k, not 8k. - * Moreover, YY_BUF_SIZE is 2*YY_READ_BUF_SIZE in the general case. - * Ditto for the __ia64__ case accordingly. - */ -#define YY_BUF_SIZE 32768 -#else -#define YY_BUF_SIZE 16384 -#endif /* __ia64__ */ -#endif - -/* The state buf must be large enough to hold one state per character in the main buffer. - */ -#define YY_STATE_BUF_SIZE ((YY_BUF_SIZE + 2) * sizeof(yy_state_type)) - -#ifndef YY_TYPEDEF_YY_BUFFER_STATE -#define YY_TYPEDEF_YY_BUFFER_STATE -typedef struct yy_buffer_state *YY_BUFFER_STATE; -#endif - -#ifndef YY_TYPEDEF_YY_SIZE_T -#define YY_TYPEDEF_YY_SIZE_T -typedef size_t yy_size_t; -#endif - -extern int yyleng; - -extern FILE *yyin, *yyout; - -#define EOB_ACT_CONTINUE_SCAN 0 -#define EOB_ACT_END_OF_FILE 1 -#define EOB_ACT_LAST_MATCH 2 - - #define YY_LESS_LINENO(n) - #define YY_LINENO_REWIND_TO(ptr) - -/* Return all but the first "n" matched characters back to the input stream. */ -#define yyless(n) \ - do \ - { \ - /* Undo effects of setting up yytext. */ \ - int yyless_macro_arg = (n); \ - YY_LESS_LINENO(yyless_macro_arg);\ - *yy_cp = (yy_hold_char); \ - YY_RESTORE_YY_MORE_OFFSET \ - (yy_c_buf_p) = yy_cp = yy_bp + yyless_macro_arg - YY_MORE_ADJ; \ - YY_DO_BEFORE_ACTION; /* set up yytext again */ \ - } \ - while ( 0 ) -#define unput(c) yyunput( c, (yytext_ptr) ) - -#ifndef YY_STRUCT_YY_BUFFER_STATE -#define YY_STRUCT_YY_BUFFER_STATE -struct yy_buffer_state - { - FILE *yy_input_file; - - char *yy_ch_buf; /* input buffer */ - char *yy_buf_pos; /* current position in input buffer */ - - /* Size of input buffer in bytes, not including room for EOB - * characters. - */ - int yy_buf_size; - - /* Number of characters read into yy_ch_buf, not including EOB - * characters. - */ - int yy_n_chars; - - /* Whether we "own" the buffer - i.e., we know we created it, - * and can realloc() it to grow it, and should free() it to - * delete it. - */ - int yy_is_our_buffer; - - /* Whether this is an "interactive" input source; if so, and - * if we're using stdio for input, then we want to use getc() - * instead of fread(), to make sure we stop fetching input after - * each newline. - */ - int yy_is_interactive; - - /* Whether we're considered to be at the beginning of a line. - * If so, '^' rules will be active on the next match, otherwise - * not. - */ - int yy_at_bol; - - int yy_bs_lineno; /**< The line count. */ - int yy_bs_column; /**< The column count. */ - - /* Whether to try to fill the input buffer when we reach the - * end of it. - */ - int yy_fill_buffer; - - int yy_buffer_status; - -#define YY_BUFFER_NEW 0 -#define YY_BUFFER_NORMAL 1 - /* When an EOF's been seen but there's still some text to process - * then we mark the buffer as YY_EOF_PENDING, to indicate that we - * shouldn't try reading from the input source any more. We might - * still have a bunch of tokens to match, though, because of - * possible backing-up. - * - * When we actually see the EOF, we change the status to "new" - * (via yyrestart()), so that the user can continue scanning by - * just pointing yyin at a new input file. - */ -#define YY_BUFFER_EOF_PENDING 2 - - }; -#endif /* !YY_STRUCT_YY_BUFFER_STATE */ - -/* Stack of input buffers. */ -static size_t yy_buffer_stack_top = 0; /**< index of top of stack. */ -static size_t yy_buffer_stack_max = 0; /**< capacity of stack. */ -static YY_BUFFER_STATE * yy_buffer_stack = NULL; /**< Stack as an array. */ - -/* We provide macros for accessing buffer states in case in the - * future we want to put the buffer states in a more general - * "scanner state". - * - * Returns the top of the stack, or NULL. - */ -#define YY_CURRENT_BUFFER ( (yy_buffer_stack) \ - ? (yy_buffer_stack)[(yy_buffer_stack_top)] \ - : NULL) -/* Same as previous macro, but useful when we know that the buffer stack is not - * NULL or when we need an lvalue. For internal use only. - */ -#define YY_CURRENT_BUFFER_LVALUE (yy_buffer_stack)[(yy_buffer_stack_top)] - -/* yy_hold_char holds the character lost when yytext is formed. */ -static char yy_hold_char; -static int yy_n_chars; /* number of characters read into yy_ch_buf */ -int yyleng; - -/* Points to current character in buffer. */ -static char *yy_c_buf_p = NULL; -static int yy_init = 0; /* whether we need to initialize */ -static int yy_start = 0; /* start state number */ - -/* Flag which is used to allow yywrap()'s to do buffer switches - * instead of setting up a fresh yyin. A bit of a hack ... - */ -static int yy_did_buffer_switch_on_eof; - -void yyrestart ( FILE *input_file ); -void yy_switch_to_buffer ( YY_BUFFER_STATE new_buffer ); -YY_BUFFER_STATE yy_create_buffer ( FILE *file, int size ); -void yy_delete_buffer ( YY_BUFFER_STATE b ); -void yy_flush_buffer ( YY_BUFFER_STATE b ); -void yypush_buffer_state ( YY_BUFFER_STATE new_buffer ); -void yypop_buffer_state ( void ); - -static void yyensure_buffer_stack ( void ); -static void yy_load_buffer_state ( void ); -static void yy_init_buffer ( YY_BUFFER_STATE b, FILE *file ); -#define YY_FLUSH_BUFFER yy_flush_buffer( YY_CURRENT_BUFFER ) - -YY_BUFFER_STATE yy_scan_buffer ( char *base, yy_size_t size ); -YY_BUFFER_STATE yy_scan_string ( const char *yy_str ); -YY_BUFFER_STATE yy_scan_bytes ( const char *bytes, int len ); - -void *yyalloc ( yy_size_t ); -void *yyrealloc ( void *, yy_size_t ); -void yyfree ( void * ); - -#define yy_new_buffer yy_create_buffer -#define yy_set_interactive(is_interactive) \ - { \ - if ( ! YY_CURRENT_BUFFER ){ \ - yyensure_buffer_stack (); \ - YY_CURRENT_BUFFER_LVALUE = \ - yy_create_buffer( yyin, YY_BUF_SIZE ); \ - } \ - YY_CURRENT_BUFFER_LVALUE->yy_is_interactive = is_interactive; \ - } -#define yy_set_bol(at_bol) \ - { \ - if ( ! YY_CURRENT_BUFFER ){\ - yyensure_buffer_stack (); \ - YY_CURRENT_BUFFER_LVALUE = \ - yy_create_buffer( yyin, YY_BUF_SIZE ); \ - } \ - YY_CURRENT_BUFFER_LVALUE->yy_at_bol = at_bol; \ - } -#define YY_AT_BOL() (YY_CURRENT_BUFFER_LVALUE->yy_at_bol) - -/* Begin user sect3 */ -typedef flex_uint8_t YY_CHAR; - -FILE *yyin = NULL, *yyout = NULL; - -typedef int yy_state_type; - -extern int yylineno; -int yylineno = 1; - -extern char *yytext; -#ifdef yytext_ptr -#undef yytext_ptr -#endif -#define yytext_ptr yytext - -static yy_state_type yy_get_previous_state ( void ); -static yy_state_type yy_try_NUL_trans ( yy_state_type current_state ); -static int yy_get_next_buffer ( void ); -static void yynoreturn yy_fatal_error ( const char* msg ); - -/* Done after the current pattern has been matched and before the - * corresponding action - sets up yytext. - */ -#define YY_DO_BEFORE_ACTION \ - (yytext_ptr) = yy_bp; \ - yyleng = (int) (yy_cp - yy_bp); \ - (yy_hold_char) = *yy_cp; \ - *yy_cp = '\0'; \ - (yy_c_buf_p) = yy_cp; -#define YY_NUM_RULES 122 -#define YY_END_OF_BUFFER 123 -/* This struct is not used in this scanner, - but its presence is necessary. */ -struct yy_trans_info - { - flex_int32_t yy_verify; - flex_int32_t yy_nxt; - }; -static const flex_int16_t yy_accept[900] = - { 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 123, 117, 10, 43, 16, 117, 108, 38, 39, 112, - 113, 114, 107, 111, 40, 109, 44, 115, 110, 116, - 102, 102, 102, 102, 102, 102, 102, 102, 102, 102, - 102, 102, 102, 102, 102, 102, 102, 102, 102, 43, - 12, 113, 48, 114, 107, 40, 113, 53, 114, 40, - 119, 43, 44, 119, 43, 119, 121, 43, 120, 44, - 43, 121, 43, 35, 106, 42, 0, 107, 0, 40, - 102, 44, 103, 105, 104, 102, 102, 0, 0, 0, - 102, 102, 102, 102, 102, 102, 102, 102, 102, 0, - - 0, 0, 102, 0, 0, 102, 102, 19, 102, 102, - 102, 102, 0, 102, 102, 102, 102, 102, 102, 102, - 102, 102, 102, 102, 102, 0, 0, 0, 0, 0, - 0, 12, 12, 12, 12, 12, 12, 12, 12, 12, - 0, 42, 48, 47, 0, 40, 0, 42, 52, 51, - 0, 40, 119, 118, 119, 119, 119, 119, 119, 119, - 119, 120, 0, 0, 0, 0, 0, 0, 0, 41, - 102, 0, 0, 30, 33, 0, 29, 0, 0, 102, - 102, 102, 102, 102, 102, 102, 102, 0, 28, 37, - 0, 27, 102, 0, 26, 0, 25, 102, 102, 102, - - 20, 102, 0, 102, 0, 0, 34, 0, 102, 13, - 102, 102, 102, 102, 102, 102, 102, 102, 102, 102, - 0, 18, 36, 0, 17, 0, 24, 0, 23, 12, - 12, 12, 12, 12, 12, 12, 12, 12, 0, 0, - 45, 41, 52, 0, 0, 49, 41, 119, 119, 119, - 119, 119, 119, 119, 119, 0, 0, 0, 0, 0, - 0, 0, 0, 102, 0, 0, 0, 0, 32, 0, - 31, 0, 0, 87, 102, 102, 102, 102, 102, 102, - 102, 102, 102, 102, 102, 0, 0, 0, 0, 22, - 0, 21, 0, 0, 0, 0, 102, 102, 102, 102, - - 102, 102, 102, 102, 102, 102, 102, 102, 12, 12, - 12, 12, 12, 12, 12, 12, 12, 46, 50, 119, - 119, 119, 119, 119, 119, 119, 119, 0, 0, 0, - 0, 0, 0, 0, 0, 102, 0, 0, 0, 0, - 0, 0, 102, 102, 102, 102, 0, 102, 102, 102, - 102, 0, 0, 102, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 102, 102, 102, - 102, 102, 0, 102, 102, 0, 0, 99, 0, 12, - 12, 12, 12, 12, 12, 12, 12, 12, 12, 2, - 119, 119, 119, 119, 119, 119, 119, 119, 119, 0, - - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 102, 0, 0, 102, 0, - 102, 102, 102, 102, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 102, 102, 0, 0, - 102, 0, 102, 102, 0, 0, 0, 0, 0, 0, - 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, - 119, 119, 119, 119, 119, 119, 119, 119, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 84, 0, - 69, 0, 0, 0, 0, 0, 102, 0, 102, 102, - - 102, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 102, 14, 0, 0, - 0, 0, 102, 0, 0, 0, 0, 0, 0, 0, - 12, 12, 12, 12, 12, 11, 12, 12, 12, 119, - 119, 119, 119, 119, 119, 119, 119, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 102, 0, 0, 102, 0, 15, 0, 89, 89, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 90, 0, 83, 0, 86, 0, 0, 0, 0, 0, - - 0, 0, 0, 0, 0, 0, 102, 0, 0, 0, - 0, 0, 102, 0, 0, 0, 0, 0, 0, 0, - 0, 12, 4, 12, 5, 12, 9, 12, 1, 12, - 3, 11, 12, 12, 12, 8, 119, 0, 119, 0, - 119, 0, 119, 0, 119, 0, 119, 119, 119, 0, - 0, 0, 97, 0, 0, 0, 0, 0, 102, 66, - 0, 102, 57, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 85, 0, 0, 0, - 0, 0, 98, 100, 0, 0, 0, 0, 0, 12, - - 6, 12, 119, 0, 119, 0, 0, 71, 0, 0, - 0, 102, 0, 0, 0, 0, 0, 101, 0, 65, - 65, 0, 0, 68, 0, 74, 0, 0, 0, 0, - 0, 0, 0, 80, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 91, 12, 7, 119, 0, - 0, 0, 0, 0, 102, 0, 0, 0, 0, 0, - 0, 0, 72, 0, 75, 0, 0, 78, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 77, 0, - 0, 0, 0, 0, 0, 0, 54, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 88, 88, 0, 0, - - 0, 0, 60, 61, 0, 0, 0, 0, 0, 0, - 0, 55, 59, 0, 0, 63, 63, 0, 70, 73, - 0, 0, 0, 0, 82, 0, 81, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 64, 64, - 0, 79, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 76, 56, 58, - 67, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 62, 62, 0, 0, 0, 0, 0, 0, 0, - 95, 0, 0, 0, 0, 0, 0, 0, 96, 0, - 0, 0, 94, 0, 0, 92, 0, 93, 0 - - } ; - -static const YY_CHAR yy_ec[256] = - { 0, - 1, 1, 1, 1, 1, 1, 1, 1, 1, 2, - 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, - 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, - 1, 3, 1, 4, 5, 1, 6, 7, 8, 9, - 10, 11, 12, 13, 14, 15, 16, 17, 17, 17, - 17, 17, 17, 17, 17, 17, 17, 18, 19, 20, - 21, 22, 1, 1, 23, 24, 25, 26, 27, 28, - 29, 30, 31, 32, 33, 34, 35, 36, 37, 38, - 39, 40, 41, 42, 43, 44, 45, 46, 47, 48, - 1, 1, 1, 1, 49, 1, 50, 51, 52, 53, - - 54, 55, 56, 57, 58, 32, 59, 60, 61, 62, - 63, 64, 65, 66, 67, 68, 69, 70, 71, 72, - 73, 74, 1, 1, 1, 1, 1, 75, 75, 75, - 75, 75, 75, 75, 75, 75, 75, 75, 75, 75, - 75, 75, 75, 75, 75, 75, 75, 75, 75, 75, - 75, 75, 75, 75, 75, 75, 75, 75, 75, 75, - 75, 75, 75, 75, 75, 75, 75, 75, 75, 75, - 75, 75, 75, 75, 75, 75, 75, 75, 75, 75, - 75, 75, 75, 75, 75, 75, 75, 75, 75, 75, - 75, 75, 75, 75, 75, 75, 75, 75, 75, 75, - - 75, 75, 75, 75, 75, 75, 75, 75, 75, 75, - 75, 75, 75, 75, 75, 75, 75, 75, 75, 75, - 75, 75, 75, 75, 75, 75, 75, 75, 75, 75, - 75, 75, 75, 75, 75, 75, 75, 75, 75, 75, - 75, 75, 75, 75, 75, 75, 75, 75, 75, 75, - 75, 75, 75, 75, 75 - } ; - -static const YY_CHAR yy_meta[76] = - { 0, - 1, 2, 3, 1, 1, 1, 1, 1, 1, 1, - 1, 1, 1, 4, 1, 1, 5, 1, 6, 1, - 1, 1, 5, 5, 5, 5, 5, 5, 5, 5, - 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, - 5, 5, 5, 5, 5, 5, 5, 5, 7, 5, - 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, - 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, - 5, 5, 5, 5, 7 - } ; - -static const flex_int16_t yy_base[951] = - { 0, - 0, 73, 67, 80, 74, 93, 97, 99, 157, 232, - 1595, 2965, 2965, 1573, 2965, 1558, 2965, 2965, 2965, 1510, - 1486, 1472, 106, 2965, 97, 2965, 1447, 68, 2965, 1434, - 160, 135, 63, 294, 142, 105, 182, 89, 251, 363, - 213, 215, 99, 246, 244, 247, 288, 320, 272, 112, - 413, 105, 1401, 112, 324, 207, 118, 176, 119, 299, - 0, 1400, 1373, 83, 139, 463, 2965, 1388, 0, 1364, - 189, 513, 1338, 1321, 2965, 1320, 195, 197, 254, 273, - 265, 1317, 2965, 2965, 2965, 321, 372, 1330, 1314, 1318, - 280, 346, 309, 338, 365, 379, 347, 306, 391, 1321, - - 0, 1293, 362, 1257, 1252, 384, 380, 2965, 448, 388, - 488, 450, 1215, 468, 469, 443, 491, 479, 494, 506, - 463, 533, 520, 535, 550, 1217, 0, 1212, 1213, 1202, - 0, 0, 545, 247, 245, 322, 374, 222, 376, 394, - 534, 199, 1195, 550, 579, 558, 563, 120, 1102, 578, - 589, 596, 0, 0, 574, 461, 477, 483, 262, 498, - 499, 0, 582, 574, 584, 593, 266, 592, 592, 461, - 607, 649, 1100, 2965, 1075, 1082, 2965, 1083, 1078, 623, - 652, 608, 634, 626, 625, 663, 655, 1081, 2965, 0, - 1026, 2965, 670, 1011, 2965, 1005, 2965, 650, 649, 675, - - 2965, 645, 708, 723, 1007, 997, 986, 771, 683, 708, - 714, 681, 729, 732, 730, 733, 751, 755, 756, 766, - 991, 2965, 0, 950, 2965, 953, 2965, 946, 2965, 656, - 341, 367, 686, 405, 410, 691, 646, 707, 202, 936, - 208, 805, 937, 188, 932, 250, 797, 713, 697, 717, - 734, 738, 772, 760, 776, 777, 765, 775, 788, 791, - 801, 792, 805, 822, 800, 803, 804, 943, 2965, 901, - 2965, 857, 831, 2965, 830, 833, 834, 889, 847, 855, - 873, 864, 897, 915, 917, 831, 891, 981, 901, 2965, - 885, 2965, 896, 897, 807, 894, 912, 929, 913, 931, - - 921, 974, 925, 965, 1007, 1027, 1040, 1047, 961, 913, - 921, 925, 942, 962, 966, 970, 884, 864, 857, 996, - 961, 991, 1004, 970, 1005, 1010, 1055, 1027, 1021, 1031, - 1035, 1043, 1032, 1038, 871, 1097, 1035, 1052, 1042, 1043, - 1039, 1043, 1074, 1111, 1118, 1070, 1131, 1104, 1112, 1114, - 1122, 1138, 1171, 1145, 1174, 1073, 1100, 1113, 1161, 1129, - 1134, 1091, 1102, 1157, 1123, 1159, 1137, 1185, 1178, 1223, - 1237, 1186, 1244, 1227, 1235, 1256, 1264, 2965, 1291, 1147, - 1142, 1187, 1224, 1222, 611, 1188, 1222, 1220, 850, 2965, - 1232, 1227, 1239, 1242, 1247, 1241, 1245, 1258, 1304, 847, - - 1262, 1262, 1283, 1285, 1284, 1278, 1280, 1277, 1330, 1282, - 1349, 1352, 1357, 1294, 1311, 532, 1375, 1377, 1344, 1321, - 1352, 1355, 1359, 1397, 1341, 1352, 1355, 1417, 1357, 1375, - 1382, 1383, 1426, 1396, 1386, 1401, 1402, 1387, 1445, 1407, - 1389, 1412, 1411, 1409, 1412, 1415, 1442, 1446, 1468, 1473, - 1480, 1432, 1460, 1493, 1457, 1440, 1451, 1454, 1474, 1465, - 1460, 1472, 1476, 1483, 1475, 776, 627, 1471, 1488, 1493, - 1478, 1487, 1489, 1496, 1489, 1485, 1502, 1508, 1493, 1503, - 1509, 1520, 1510, 1507, 1524, 1529, 1539, 1524, 2965, 1529, - 2965, 1534, 1538, 1555, 1533, 1530, 1560, 1531, 1554, 1599, - - 1612, 1619, 1626, 1556, 1546, 1542, 1571, 1580, 1583, 1595, - 1597, 1634, 1639, 1660, 1652, 1607, 1623, 1637, 1667, 1624, - 1641, 1634, 1638, 1686, 1655, 1694, 1667, 1712, 1645, 1651, - 1716, 1661, 1695, 839, 1668, 1691, 1687, 1679, 1682, 1740, - 786, 783, 753, 752, 751, 0, 1692, 1707, 750, 1586, - 1737, 1755, 1761, 1763, 1709, 1720, 1767, 746, 690, 631, - 627, 576, 1715, 1726, 520, 1781, 1747, 1720, 1747, 1725, - 1738, 1762, 1788, 1764, 1774, 1803, 636, 1806, 1818, 2965, - 1769, 1825, 1753, 1782, 1843, 1787, 1794, 1790, 1799, 1805, - 2965, 1798, 2965, 1802, 2965, 1803, 1804, 1813, 1808, 1806, - - 1835, 1868, 1837, 1824, 1880, 1838, 1882, 1900, 1855, 1865, - 1849, 1857, 1908, 1923, 1930, 1870, 1865, 1874, 1858, 1901, - 1945, 478, 2965, 470, 2965, 459, 2965, 453, 2965, 442, - 2965, 0, 421, 1901, 411, 2965, 1950, 381, 1957, 363, - 1959, 360, 1963, 352, 1968, 348, 1970, 1902, 1972, 347, - 342, 1923, 2965, 1927, 1977, 255, 1952, 1961, 1971, 2965, - 1895, 1995, 2965, 1946, 1958, 2000, 1967, 2003, 1960, 2021, - 1962, 2026, 1975, 2039, 1993, 2059, 1995, 2009, 2011, 2005, - 2017, 2021, 2077, 2080, 2018, 2023, 2965, 2016, 2045, 2046, - 2030, 2044, 2965, 2965, 2062, 2052, 2065, 2051, 2103, 224, - - 2965, 218, 2100, 211, 2105, 202, 2062, 2965, 2063, 2072, - 2076, 2106, 2071, 2126, 2139, 2098, 2076, 2965, 2087, 2144, - 2965, 2151, 2099, 2965, 2169, 2965, 2107, 181, 2172, 2101, - 2108, 2113, 2127, 2965, 2131, 2128, 2142, 2111, 2152, 2141, - 2195, 2161, 2162, 2156, 2158, 2965, 181, 2965, 2198, 178, - 2154, 2179, 2168, 2221, 2224, 2164, 2178, 2242, 2184, 2245, - 2202, 2263, 2965, 2193, 2965, 2203, 2204, 2965, 2212, 2268, - 2206, 2213, 2226, 2282, 2239, 2289, 2296, 2227, 2965, 2247, - 2244, 2260, 2258, 2258, 2274, 2316, 2965, 2319, 2271, 2271, - 2337, 2283, 2342, 2345, 2291, 2287, 2360, 2965, 2363, 2288, - - 2368, 2290, 2965, 2965, 2291, 2306, 2304, 138, 2324, 2332, - 2340, 2965, 2965, 2348, 2334, 2386, 2965, 2389, 2965, 2965, - 2351, 2407, 2411, 2357, 2965, 2346, 2965, 2356, 2372, 2369, - 133, 2381, 2373, 2381, 2432, 2390, 2405, 2437, 2450, 2965, - 2404, 2965, 2386, 2458, 2463, 2478, 2483, 2400, 2406, 2406, - 2486, 2404, 2423, 2501, 2438, 2504, 2509, 2965, 2965, 2965, - 2965, 2441, 2451, 2448, 2436, 2523, 2531, 2460, 2481, 127, - 2478, 2545, 2965, 2503, 2553, 2495, 2501, 2557, 2508, 2513, - 2965, 2528, 2529, 2571, 2578, 2509, 2527, 2543, 2965, 2592, - 2555, 2546, 2965, 2599, 2556, 2965, 2614, 2965, 2965, 2633, - - 2640, 2644, 2651, 2658, 2662, 2667, 2674, 2681, 129, 2688, - 2695, 2702, 2709, 118, 2716, 2723, 2730, 2737, 2744, 2751, - 2758, 2765, 2772, 2779, 2784, 2789, 2796, 2803, 2810, 2817, - 2824, 2831, 2838, 2845, 2852, 2859, 2866, 2873, 2880, 2887, - 2894, 2901, 2908, 2915, 2922, 2929, 2936, 2943, 2950, 2957 - } ; - -static const flex_int16_t yy_def[951] = - { 0, - 899, 1, 1, 1, 1, 1, 900, 900, 901, 901, - 899, 899, 899, 899, 899, 899, 899, 899, 899, 899, - 899, 899, 899, 899, 902, 899, 899, 899, 899, 899, - 902, 902, 902, 902, 902, 902, 902, 902, 902, 902, - 902, 902, 902, 902, 902, 902, 902, 902, 902, 899, - 903, 899, 899, 899, 899, 902, 899, 899, 899, 902, - 904, 899, 899, 904, 899, 904, 899, 899, 905, 899, - 899, 899, 899, 899, 899, 899, 899, 899, 902, 902, - 902, 899, 899, 899, 899, 902, 902, 906, 899, 907, - 902, 902, 902, 902, 902, 902, 902, 902, 902, 908, - - 909, 910, 902, 911, 912, 902, 902, 899, 902, 902, - 902, 902, 899, 902, 902, 902, 902, 902, 902, 902, - 902, 902, 902, 902, 902, 913, 914, 915, 916, 917, - 72, 903, 903, 903, 903, 903, 903, 903, 903, 903, - 899, 899, 899, 899, 899, 902, 899, 899, 899, 899, - 899, 902, 904, 904, 904, 904, 904, 904, 904, 904, - 904, 905, 899, 899, 899, 899, 899, 899, 899, 902, - 902, 899, 906, 899, 899, 907, 899, 918, 919, 902, - 902, 902, 902, 902, 902, 902, 902, 908, 899, 909, - 910, 899, 902, 911, 899, 912, 899, 902, 902, 902, - - 899, 902, 899, 902, 920, 921, 899, 899, 902, 902, - 902, 902, 902, 902, 902, 902, 902, 902, 902, 902, - 913, 899, 914, 915, 899, 916, 899, 917, 899, 903, - 903, 903, 903, 903, 903, 903, 903, 903, 899, 899, - 899, 902, 899, 899, 899, 899, 902, 904, 904, 904, - 904, 904, 904, 904, 904, 899, 899, 899, 899, 899, - 899, 899, 899, 902, 899, 899, 899, 918, 899, 919, - 899, 899, 902, 899, 902, 902, 902, 902, 902, 902, - 902, 902, 902, 902, 902, 899, 899, 899, 920, 899, - 921, 899, 899, 899, 899, 899, 902, 902, 902, 902, - - 902, 902, 902, 902, 902, 902, 902, 902, 903, 903, - 903, 903, 903, 903, 903, 903, 922, 899, 899, 904, - 904, 904, 904, 904, 904, 904, 923, 899, 899, 899, - 899, 899, 899, 899, 924, 902, 899, 899, 899, 899, - 899, 899, 902, 902, 902, 902, 899, 902, 902, 902, - 902, 899, 899, 902, 899, 899, 899, 899, 899, 899, - 899, 899, 899, 899, 899, 899, 899, 902, 902, 902, - 902, 902, 899, 902, 902, 899, 899, 899, 899, 903, - 903, 903, 903, 903, 903, 903, 903, 903, 922, 899, - 904, 904, 904, 904, 904, 904, 904, 904, 923, 924, - - 899, 899, 899, 899, 899, 899, 899, 899, 899, 899, - 899, 899, 899, 899, 899, 902, 899, 899, 902, 899, - 902, 902, 902, 902, 899, 899, 899, 899, 899, 899, - 899, 899, 899, 899, 899, 899, 899, 899, 899, 899, - 899, 899, 899, 899, 899, 899, 902, 902, 899, 899, - 902, 899, 902, 902, 899, 899, 899, 899, 899, 899, - 903, 903, 903, 903, 903, 903, 903, 903, 903, 903, - 904, 904, 904, 904, 904, 904, 904, 904, 899, 899, - 899, 899, 899, 899, 899, 899, 899, 899, 899, 899, - 899, 899, 899, 902, 899, 899, 902, 899, 902, 902, - - 902, 899, 899, 899, 899, 899, 899, 899, 899, 899, - 899, 899, 899, 899, 899, 899, 899, 899, 899, 899, - 899, 899, 899, 899, 899, 899, 902, 902, 899, 899, - 899, 899, 902, 925, 899, 899, 899, 899, 899, 899, - 926, 927, 928, 929, 930, 931, 903, 903, 932, 933, - 934, 935, 936, 937, 904, 904, 938, 939, 940, 941, - 942, 943, 899, 899, 944, 899, 899, 899, 899, 899, - 899, 902, 899, 899, 902, 899, 902, 899, 899, 899, - 899, 899, 899, 899, 899, 899, 899, 899, 899, 899, - 899, 899, 899, 899, 899, 899, 899, 899, 899, 899, - - 899, 899, 899, 899, 899, 899, 902, 899, 899, 899, - 899, 899, 902, 899, 899, 899, 899, 899, 899, 899, - 899, 926, 899, 927, 899, 928, 899, 929, 899, 930, - 899, 931, 945, 903, 932, 899, 933, 939, 934, 940, - 935, 941, 936, 942, 937, 943, 946, 904, 938, 944, - 947, 899, 899, 899, 899, 899, 899, 899, 902, 899, - 899, 902, 899, 899, 899, 899, 899, 899, 899, 899, - 899, 899, 899, 899, 899, 899, 899, 899, 899, 899, - 899, 899, 899, 899, 899, 899, 899, 899, 899, 899, - 899, 899, 899, 899, 899, 899, 899, 899, 899, 945, - - 899, 948, 946, 947, 949, 950, 899, 899, 899, 899, - 899, 902, 899, 899, 899, 899, 899, 899, 899, 899, - 899, 899, 899, 899, 899, 899, 899, 899, 899, 899, - 899, 899, 899, 899, 899, 899, 899, 899, 899, 899, - 899, 899, 899, 899, 899, 899, 948, 899, 949, 950, - 899, 899, 899, 899, 902, 899, 899, 899, 899, 899, - 899, 899, 899, 899, 899, 899, 899, 899, 899, 899, - 899, 899, 899, 899, 899, 899, 899, 899, 899, 899, - 899, 899, 899, 899, 899, 899, 899, 899, 899, 899, - 899, 899, 899, 899, 899, 899, 899, 899, 899, 899, - - 899, 899, 899, 899, 899, 899, 899, 899, 899, 899, - 899, 899, 899, 899, 899, 899, 899, 899, 899, 899, - 899, 899, 899, 899, 899, 899, 899, 899, 899, 899, - 899, 899, 899, 899, 899, 899, 899, 899, 899, 899, - 899, 899, 899, 899, 899, 899, 899, 899, 899, 899, - 899, 899, 899, 899, 899, 899, 899, 899, 899, 899, - 899, 899, 899, 899, 899, 899, 899, 899, 899, 899, - 899, 899, 899, 899, 899, 899, 899, 899, 899, 899, - 899, 899, 899, 899, 899, 899, 899, 899, 899, 899, - 899, 899, 899, 899, 899, 899, 899, 899, 0, 899, - - 899, 899, 899, 899, 899, 899, 899, 899, 899, 899, - 899, 899, 899, 899, 899, 899, 899, 899, 899, 899, - 899, 899, 899, 899, 899, 899, 899, 899, 899, 899, - 899, 899, 899, 899, 899, 899, 899, 899, 899, 899, - 899, 899, 899, 899, 899, 899, 899, 899, 899, 899 - } ; - -static const flex_int16_t yy_nxt[3041] = - { 0, - 12, 13, 14, 15, 12, 16, 17, 15, 18, 19, - 20, 21, 12, 22, 23, 24, 25, 26, 27, 28, - 29, 30, 31, 32, 33, 33, 34, 35, 36, 37, - 38, 33, 33, 39, 33, 40, 41, 42, 33, 43, - 44, 45, 46, 33, 47, 48, 33, 49, 12, 31, - 32, 33, 33, 34, 35, 36, 37, 38, 33, 39, - 33, 40, 41, 42, 33, 43, 44, 45, 46, 33, - 47, 48, 33, 49, 33, 50, 79, 51, 52, 53, - 54, 55, 50, 56, 51, 57, 58, 59, 83, 84, - 60, 52, 53, 54, 55, 50, 56, 51, 13, 62, - - 13, 65, 79, 66, 57, 58, 59, 77, 77, 60, - 79, 79, 79, 80, 73, 63, 131, 63, 79, 141, - 78, 142, 223, 154, 103, 117, 141, 64, 142, 64, - 147, 147, 147, 190, 148, 148, 148, 79, 88, 89, - 876, 73, 90, 131, 99, 79, 848, 79, 79, 154, - 103, 832, 117, 79, 64, 79, 64, 67, 13, 68, - 67, 67, 67, 67, 67, 67, 67, 67, 67, 67, - 99, 67, 67, 79, 67, 70, 67, 67, 67, 748, - 91, 97, 748, 79, 98, 100, 101, 86, 149, 102, - 79, 73, 150, 131, 767, 79, 77, 77, 77, 77, - - 245, 87, 151, 748, 246, 67, 91, 97, 79, 78, - 98, 78, 701, 141, 86, 142, 240, 113, 241, 748, - 79, 141, 240, 146, 241, 701, 79, 87, 79, 151, - 79, 67, 67, 13, 71, 67, 72, 67, 67, 67, - 67, 67, 67, 67, 67, 116, 67, 67, 114, 67, - 70, 67, 67, 67, 104, 79, 115, 79, 105, 79, - 79, 79, 245, 79, 79, 236, 246, 79, 709, 232, - 118, 233, 116, 122, 114, 129, 119, 106, 79, 130, - 67, 107, 115, 178, 123, 79, 79, 179, 120, 170, - 121, 236, 79, 79, 79, 79, 232, 118, 233, 79, - - 122, 79, 79, 119, 106, 253, 67, 79, 107, 261, - 123, 147, 79, 79, 120, 152, 121, 124, 125, 79, - 79, 79, 79, 126, 127, 77, 77, 128, 79, 92, - 93, 253, 94, 79, 79, 261, 79, 95, 78, 96, - 144, 186, 79, 701, 124, 125, 181, 79, 636, 631, - 145, 79, 234, 629, 79, 92, 93, 79, 94, 79, - 79, 627, 171, 95, 625, 96, 108, 186, 79, 79, - 108, 180, 181, 172, 172, 79, 79, 145, 79, 234, - 182, 310, 623, 185, 172, 79, 79, 109, 171, 110, - 172, 183, 79, 79, 79, 79, 235, 79, 180, 111, - - 311, 79, 237, 184, 79, 193, 182, 310, 112, 185, - 79, 79, 636, 79, 109, 200, 110, 187, 183, 198, - 79, 238, 701, 235, 199, 111, 311, 79, 79, 237, - 184, 193, 79, 202, 112, 133, 79, 134, 135, 79, - 313, 200, 314, 631, 187, 198, 136, 137, 238, 138, - 199, 201, 139, 205, 629, 201, 79, 206, 140, 202, - 627, 79, 133, 79, 134, 135, 313, 210, 314, 208, - 208, 625, 136, 137, 79, 138, 79, 170, 139, 623, - 208, 79, 79, 250, 140, 155, 208, 156, 157, 203, - 203, 79, 79, 216, 210, 209, 79, 158, 79, 159, - - 203, 79, 160, 251, 79, 252, 203, 79, 161, 79, - 250, 79, 155, 211, 156, 157, 79, 79, 213, 79, - 216, 636, 209, 158, 254, 159, 255, 79, 160, 204, - 251, 212, 252, 79, 161, 163, 79, 164, 165, 79, - 211, 214, 79, 215, 213, 494, 79, 166, 79, 167, - 144, 254, 168, 255, 79, 204, 218, 212, 169, 217, - 145, 219, 163, 79, 164, 165, 144, 214, 79, 215, - 230, 79, 141, 166, 242, 167, 145, 631, 168, 150, - 79, 79, 218, 79, 169, 231, 217, 145, 219, 151, - 239, 220, 239, 240, 150, 241, 258, 230, 79, 248, - - 244, 245, 244, 145, 151, 246, 79, 256, 147, 79, - 259, 231, 247, 466, 249, 260, 151, 220, 262, 263, - 79, 79, 257, 258, 272, 272, 248, 467, 629, 546, - 275, 151, 627, 264, 256, 272, 273, 259, 79, 79, - 249, 272, 260, 467, 79, 262, 263, 79, 257, 79, - 172, 172, 277, 274, 274, 79, 79, 275, 79, 278, - 264, 172, 79, 79, 274, 79, 274, 172, 79, 276, - 274, 79, 265, 79, 79, 266, 79, 280, 282, 277, - 316, 309, 79, 79, 79, 278, 285, 279, 79, 283, - 267, 625, 281, 79, 79, 276, 79, 79, 79, 265, - - 79, 284, 266, 79, 280, 282, 316, 300, 309, 203, - 203, 79, 285, 312, 279, 283, 267, 315, 79, 281, - 203, 79, 297, 79, 288, 288, 203, 79, 284, 79, - 286, 79, 317, 287, 300, 288, 79, 321, 320, 299, - 312, 288, 79, 79, 315, 79, 79, 623, 297, 298, - 322, 636, 631, 629, 627, 301, 79, 286, 302, 317, - 287, 323, 79, 321, 79, 320, 299, 303, 79, 79, - 324, 79, 208, 208, 304, 298, 322, 79, 79, 79, - 79, 79, 301, 208, 625, 302, 305, 623, 323, 208, - 306, 307, 467, 303, 326, 308, 324, 293, 325, 79, - - 304, 327, 328, 79, 79, 329, 294, 295, 330, 147, - 79, 296, 305, 247, 79, 331, 306, 307, 79, 141, - 326, 242, 308, 332, 293, 325, 334, 333, 327, 328, - 335, 329, 294, 295, 330, 79, 337, 296, 338, 339, - 340, 534, 331, 79, 79, 79, 79, 79, 390, 332, - 366, 390, 334, 79, 333, 614, 356, 335, 272, 272, - 79, 336, 337, 344, 338, 339, 340, 343, 79, 272, - 79, 346, 390, 319, 345, 272, 366, 79, 79, 79, - 318, 79, 79, 356, 341, 390, 79, 336, 348, 344, - 347, 347, 292, 343, 342, 79, 349, 346, 352, 352, - - 345, 347, 79, 79, 290, 351, 350, 347, 271, 352, - 79, 341, 79, 357, 348, 352, 353, 353, 355, 355, - 342, 79, 349, 365, 367, 79, 79, 353, 79, 355, - 79, 351, 350, 353, 79, 355, 363, 79, 79, 368, - 357, 364, 79, 382, 79, 79, 269, 372, 319, 243, - 365, 367, 318, 229, 383, 354, 227, 225, 384, 370, - 79, 79, 363, 79, 374, 79, 368, 364, 385, 79, - 382, 369, 371, 79, 372, 373, 373, 79, 79, 79, - 383, 354, 288, 288, 384, 370, 373, 79, 386, 375, - 374, 393, 373, 288, 222, 385, 396, 369, 371, 288, - - 380, 381, 207, 358, 292, 387, 388, 359, 376, 376, - 290, 360, 197, 79, 195, 386, 375, 361, 393, 376, - 79, 362, 79, 396, 394, 376, 380, 381, 377, 377, - 358, 387, 388, 192, 359, 391, 392, 395, 360, 377, - 79, 378, 378, 361, 397, 377, 398, 362, 379, 379, - 394, 403, 378, 79, 378, 79, 390, 400, 378, 379, - 79, 391, 392, 395, 404, 379, 401, 402, 405, 406, - 397, 407, 398, 400, 408, 79, 410, 411, 403, 412, - 413, 414, 415, 79, 189, 271, 269, 79, 79, 177, - 404, 175, 401, 402, 405, 79, 406, 407, 409, 409, - - 408, 416, 410, 174, 411, 412, 413, 414, 415, 409, - 79, 419, 417, 417, 243, 409, 431, 79, 79, 418, - 418, 441, 79, 417, 79, 79, 442, 79, 416, 417, - 418, 79, 347, 347, 421, 79, 418, 419, 422, 352, - 352, 432, 431, 347, 423, 79, 428, 428, 441, 347, - 352, 424, 79, 442, 433, 420, 352, 428, 79, 79, - 79, 421, 79, 428, 438, 422, 79, 432, 444, 439, - 79, 423, 353, 353, 425, 355, 355, 440, 424, 426, - 433, 443, 420, 353, 446, 445, 355, 461, 462, 353, - 438, 79, 355, 79, 444, 439, 434, 435, 79, 79, - - 425, 436, 429, 440, 427, 426, 437, 143, 443, 229, - 446, 430, 445, 461, 462, 463, 227, 448, 447, 225, - 222, 451, 434, 435, 449, 449, 79, 436, 468, 429, - 427, 207, 437, 79, 79, 449, 79, 430, 450, 450, - 79, 449, 463, 448, 447, 373, 373, 451, 79, 450, - 79, 464, 465, 453, 468, 450, 373, 376, 376, 197, - 195, 469, 373, 470, 454, 377, 377, 473, 376, 474, - 452, 79, 471, 472, 376, 79, 377, 475, 464, 465, - 453, 476, 377, 79, 477, 79, 456, 469, 457, 470, - 458, 454, 379, 379, 473, 455, 474, 452, 471, 472, - - 192, 478, 479, 379, 475, 390, 400, 476, 480, 379, - 477, 481, 482, 456, 483, 457, 459, 458, 484, 485, - 486, 455, 400, 488, 189, 177, 460, 478, 479, 492, - 175, 409, 409, 174, 480, 82, 76, 74, 481, 482, - 73, 483, 409, 459, 484, 485, 486, 493, 409, 488, - 489, 489, 460, 274, 274, 492, 487, 79, 491, 491, - 498, 489, 490, 489, 274, 79, 274, 489, 79, 491, - 274, 491, 79, 493, 497, 491, 417, 417, 418, 418, - 503, 504, 82, 487, 501, 505, 498, 417, 499, 418, - 73, 82, 79, 417, 500, 418, 509, 510, 502, 502, - - 79, 497, 73, 79, 511, 512, 503, 79, 504, 502, - 79, 501, 505, 143, 499, 502, 495, 496, 428, 428, - 500, 514, 509, 515, 510, 516, 517, 513, 513, 428, - 518, 511, 512, 520, 522, 428, 521, 523, 513, 506, - 507, 526, 495, 496, 513, 79, 519, 519, 514, 515, - 524, 525, 516, 517, 85, 79, 518, 519, 508, 79, - 520, 522, 521, 519, 523, 82, 506, 507, 526, 449, - 449, 532, 528, 79, 450, 450, 524, 525, 527, 536, - 449, 531, 531, 535, 508, 450, 449, 537, 76, 538, - 79, 450, 531, 79, 79, 534, 539, 532, 531, 528, - - 533, 540, 76, 541, 527, 536, 79, 542, 79, 529, - 535, 543, 544, 537, 530, 538, 545, 547, 548, 549, - 75, 550, 551, 539, 552, 553, 533, 540, 79, 541, - 554, 555, 556, 542, 557, 529, 558, 543, 559, 544, - 530, 79, 545, 547, 560, 548, 549, 550, 551, 561, - 552, 562, 553, 563, 564, 565, 554, 555, 570, 556, - 568, 557, 558, 566, 559, 569, 571, 79, 79, 573, - 560, 574, 576, 79, 74, 73, 561, 562, 583, 563, - 584, 564, 565, 585, 567, 570, 568, 623, 638, 577, - 566, 569, 572, 571, 899, 573, 575, 574, 576, 899, - - 578, 578, 79, 79, 638, 583, 584, 586, 79, 585, - 567, 578, 79, 579, 579, 577, 587, 578, 572, 588, - 502, 502, 575, 589, 579, 79, 580, 582, 582, 596, - 579, 502, 590, 586, 899, 591, 591, 502, 582, 899, - 513, 513, 587, 899, 582, 588, 591, 79, 591, 597, - 589, 513, 591, 595, 595, 581, 596, 513, 590, 598, - 79, 593, 593, 601, 595, 592, 595, 602, 519, 519, - 595, 603, 593, 594, 593, 604, 597, 899, 593, 519, - 79, 581, 606, 899, 609, 519, 598, 605, 605, 601, - 610, 899, 592, 599, 602, 373, 373, 603, 605, 899, - - 612, 604, 899, 600, 605, 616, 373, 362, 79, 606, - 609, 607, 373, 608, 608, 79, 610, 531, 531, 617, - 599, 618, 619, 620, 608, 79, 612, 633, 531, 600, - 608, 616, 634, 362, 531, 613, 899, 607, 625, 640, - 611, 621, 621, 79, 647, 648, 617, 618, 619, 620, - 651, 652, 621, 633, 655, 640, 627, 642, 621, 634, - 79, 613, 629, 644, 631, 646, 657, 611, 636, 650, - 647, 654, 648, 642, 656, 79, 651, 658, 652, 644, - 655, 646, 653, 653, 659, 650, 661, 79, 670, 660, - 660, 899, 657, 653, 899, 653, 668, 899, 654, 653, - - 660, 656, 660, 658, 663, 663, 660, 578, 578, 662, - 79, 659, 671, 661, 670, 663, 899, 663, 578, 666, - 666, 663, 79, 668, 578, 676, 582, 582, 673, 677, - 666, 674, 675, 434, 435, 662, 666, 582, 678, 671, - 679, 680, 664, 582, 672, 672, 681, 665, 436, 440, - 667, 669, 676, 437, 673, 672, 677, 674, 675, 434, - 435, 672, 682, 684, 678, 685, 679, 680, 664, 683, - 683, 686, 681, 665, 436, 440, 667, 689, 669, 437, - 683, 605, 605, 687, 687, 691, 683, 690, 698, 682, - 684, 685, 605, 692, 687, 79, 687, 686, 605, 899, - - 687, 608, 608, 695, 689, 899, 899, 696, 697, 693, - 693, 691, 608, 899, 690, 698, 899, 430, 608, 692, - 693, 79, 693, 699, 694, 694, 693, 702, 705, 695, - 79, 694, 694, 696, 697, 694, 713, 694, 899, 615, - 688, 694, 694, 430, 694, 899, 621, 621, 694, 706, - 699, 623, 638, 707, 702, 705, 79, 621, 625, 640, - 627, 642, 713, 621, 629, 644, 688, 286, 638, 631, - 646, 701, 704, 636, 650, 640, 706, 642, 708, 708, - 707, 644, 710, 711, 79, 715, 646, 716, 704, 708, - 650, 708, 899, 717, 286, 708, 714, 714, 719, 712, - - 899, 666, 666, 722, 718, 718, 899, 714, 79, 710, - 711, 715, 666, 714, 716, 718, 723, 718, 666, 79, - 717, 718, 720, 720, 719, 727, 712, 672, 672, 722, - 725, 899, 667, 720, 899, 721, 728, 729, 672, 720, - 724, 724, 723, 79, 672, 899, 730, 731, 735, 507, - 899, 724, 727, 724, 732, 899, 725, 724, 667, 736, - 726, 726, 737, 728, 729, 740, 899, 508, 899, 738, - 739, 726, 730, 726, 731, 735, 507, 726, 683, 683, - 732, 734, 734, 741, 742, 736, 743, 744, 737, 683, - 745, 740, 734, 508, 734, 683, 738, 739, 734, 751, - - 752, 701, 704, 733, 746, 746, 748, 750, 753, 741, - 754, 742, 743, 756, 744, 746, 745, 746, 704, 79, - 759, 746, 760, 750, 899, 751, 752, 714, 714, 761, - 733, 769, 755, 770, 753, 764, 754, 776, 714, 756, - 758, 758, 766, 899, 714, 762, 762, 759, 760, 771, - 757, 758, 763, 763, 79, 761, 762, 758, 769, 755, - 770, 764, 762, 763, 776, 763, 772, 773, 766, 763, - 765, 765, 774, 768, 768, 771, 775, 757, 777, 899, - 425, 765, 778, 765, 768, 780, 768, 765, 781, 899, - 768, 782, 772, 773, 783, 784, 779, 779, 774, 748, - - 750, 785, 775, 786, 788, 777, 425, 779, 778, 779, - 899, 899, 780, 779, 789, 781, 750, 782, 899, 791, - 783, 784, 787, 787, 792, 274, 274, 793, 785, 786, - 788, 794, 899, 787, 899, 787, 274, 79, 274, 787, - 789, 795, 274, 758, 758, 791, 580, 580, 796, 899, - 799, 792, 800, 793, 758, 899, 899, 580, 794, 580, - 758, 801, 802, 580, 762, 762, 805, 795, 790, 797, - 797, 899, 79, 899, 796, 762, 799, 806, 800, 807, - 797, 762, 798, 687, 687, 808, 797, 801, 810, 802, - 803, 803, 805, 809, 687, 790, 687, 804, 804, 425, - - 687, 803, 811, 803, 806, 807, 814, 803, 804, 815, - 804, 899, 808, 821, 804, 810, 818, 812, 812, 809, - 813, 813, 822, 899, 826, 425, 828, 829, 812, 811, - 812, 813, 814, 813, 812, 815, 899, 813, 816, 816, - 821, 830, 818, 819, 819, 831, 820, 820, 822, 816, - 826, 817, 828, 829, 819, 816, 819, 820, 833, 820, - 819, 823, 823, 820, 825, 825, 835, 830, 834, 827, - 827, 831, 823, 836, 899, 825, 837, 825, 823, 841, - 827, 825, 827, 843, 833, 844, 827, 838, 838, 845, - 839, 839, 824, 835, 834, 899, 899, 847, 838, 850, - - 836, 839, 837, 840, 838, 846, 841, 839, 842, 842, - 843, 844, 823, 823, 849, 845, 851, 899, 824, 842, - 852, 842, 664, 823, 847, 842, 850, 853, 899, 823, - 856, 846, 857, 274, 274, 862, 863, 899, 838, 838, - 849, 864, 851, 824, 274, 865, 274, 852, 664, 838, - 274, 854, 854, 899, 853, 838, 866, 856, 857, 858, - 858, 862, 854, 863, 859, 859, 871, 864, 854, 824, - 858, 865, 858, 664, 867, 859, 858, 859, 899, 860, - 860, 859, 866, 868, 861, 861, 869, 714, 714, 870, - 860, 855, 860, 871, 874, 861, 860, 861, 714, 664, - - 867, 861, 854, 854, 714, 595, 595, 875, 899, 868, - 798, 798, 869, 854, 877, 870, 595, 855, 595, 854, - 874, 798, 595, 798, 872, 872, 880, 798, 899, 899, - 882, 899, 840, 840, 875, 872, 884, 873, 883, 886, - 877, 872, 855, 840, 885, 840, 878, 878, 890, 840, - 887, 888, 899, 880, 881, 881, 882, 878, 878, 878, - 899, 891, 884, 878, 883, 881, 886, 881, 855, 878, - 885, 881, 889, 889, 890, 878, 892, 887, 888, 873, - 873, 894, 897, 889, 899, 889, 879, 891, 895, 889, - 873, 899, 873, 893, 893, 899, 873, 899, 879, 899, - - 896, 896, 892, 899, 893, 899, 893, 899, 894, 897, - 893, 896, 879, 896, 895, 898, 898, 896, 899, 899, - 899, 899, 899, 899, 879, 899, 898, 899, 898, 899, - 899, 899, 898, 61, 61, 61, 61, 61, 61, 61, - 69, 69, 69, 69, 69, 69, 69, 81, 81, 899, - 81, 132, 899, 132, 132, 132, 132, 132, 153, 899, - 899, 153, 153, 899, 153, 162, 162, 173, 899, 173, - 173, 173, 173, 173, 176, 899, 176, 176, 176, 176, - 176, 188, 899, 188, 188, 188, 188, 188, 191, 899, - 191, 191, 191, 191, 191, 194, 899, 194, 194, 194, - - 194, 194, 196, 899, 196, 196, 196, 196, 196, 221, - 899, 221, 221, 221, 221, 221, 224, 899, 224, 224, - 224, 224, 224, 226, 899, 226, 226, 226, 226, 226, - 228, 899, 228, 228, 228, 228, 228, 268, 899, 268, - 268, 268, 268, 268, 270, 899, 270, 270, 270, 270, - 270, 289, 899, 289, 289, 289, 289, 289, 291, 899, - 291, 291, 291, 291, 291, 389, 389, 389, 389, 389, - 389, 389, 399, 399, 399, 399, 399, 399, 399, 400, - 400, 400, 400, 400, 400, 400, 615, 899, 615, 622, - 622, 622, 622, 622, 622, 622, 624, 624, 624, 624, - - 624, 624, 624, 626, 626, 626, 626, 626, 626, 626, - 628, 628, 628, 628, 628, 628, 628, 630, 630, 630, - 630, 630, 630, 630, 632, 899, 632, 632, 632, 632, - 632, 635, 635, 635, 635, 635, 635, 635, 637, 637, - 637, 637, 637, 637, 637, 639, 639, 639, 639, 639, - 639, 639, 641, 641, 641, 641, 641, 641, 641, 643, - 643, 643, 643, 643, 643, 643, 645, 645, 645, 645, - 645, 645, 645, 649, 649, 649, 649, 649, 649, 649, - 638, 638, 638, 638, 638, 638, 638, 640, 640, 640, - 640, 640, 640, 640, 642, 642, 642, 642, 642, 642, - - 642, 644, 644, 644, 644, 644, 644, 644, 646, 646, - 646, 646, 646, 646, 646, 650, 650, 650, 650, 650, - 650, 650, 700, 700, 700, 700, 700, 700, 700, 703, - 703, 703, 703, 703, 703, 703, 704, 704, 704, 704, - 704, 704, 704, 747, 747, 747, 747, 747, 747, 747, - 749, 749, 749, 749, 749, 749, 749, 750, 750, 750, - 750, 750, 750, 750, 11, 899, 899, 899, 899, 899, - 899, 899, 899, 899, 899, 899, 899, 899, 899, 899, - 899, 899, 899, 899, 899, 899, 899, 899, 899, 899, - 899, 899, 899, 899, 899, 899, 899, 899, 899, 899, - - 899, 899, 899, 899, 899, 899, 899, 899, 899, 899, - 899, 899, 899, 899, 899, 899, 899, 899, 899, 899, - 899, 899, 899, 899, 899, 899, 899, 899, 899, 899, - 899, 899, 899, 899, 899, 899, 899, 899, 899, 899 - } ; - -static const flex_int16_t yy_chk[3041] = - { 0, - 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, - 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, - 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, - 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, - 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, - 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, - 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, - 1, 1, 1, 1, 1, 2, 33, 2, 3, 3, - 3, 3, 4, 3, 4, 5, 5, 5, 28, 28, - 5, 4, 4, 4, 4, 6, 4, 6, 7, 7, - - 8, 8, 38, 8, 6, 6, 6, 23, 23, 6, - 25, 33, 43, 25, 50, 7, 50, 8, 36, 52, - 23, 52, 914, 64, 38, 43, 54, 7, 54, 8, - 57, 59, 148, 909, 57, 59, 148, 38, 32, 32, - 870, 65, 32, 65, 36, 25, 831, 43, 32, 64, - 38, 808, 43, 36, 7, 35, 8, 9, 9, 9, - 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, - 36, 9, 9, 31, 9, 9, 9, 9, 9, 750, - 32, 35, 747, 32, 35, 37, 37, 31, 58, 37, - 35, 71, 58, 71, 728, 37, 77, 77, 78, 78, - - 244, 31, 58, 706, 244, 9, 32, 35, 31, 77, - 35, 78, 704, 142, 31, 142, 239, 41, 239, 702, - 56, 56, 241, 56, 241, 700, 41, 31, 42, 58, - 37, 9, 10, 10, 10, 10, 10, 10, 10, 10, - 10, 10, 10, 10, 10, 42, 10, 10, 41, 10, - 10, 10, 10, 10, 39, 56, 41, 45, 39, 44, - 46, 41, 246, 42, 39, 138, 246, 79, 656, 134, - 44, 135, 42, 45, 41, 49, 44, 39, 81, 49, - 10, 39, 41, 91, 46, 49, 80, 91, 44, 80, - 44, 138, 45, 91, 44, 46, 134, 44, 135, 39, - - 45, 47, 79, 44, 39, 159, 10, 34, 39, 167, - 46, 60, 60, 81, 44, 60, 44, 47, 47, 98, - 49, 80, 93, 48, 48, 55, 55, 48, 91, 34, - 34, 159, 34, 48, 86, 167, 47, 34, 55, 34, - 55, 98, 34, 651, 47, 47, 93, 60, 650, 646, - 55, 94, 136, 644, 98, 34, 34, 93, 34, 92, - 97, 642, 86, 34, 640, 34, 40, 98, 48, 86, - 40, 92, 93, 87, 87, 103, 40, 55, 95, 136, - 94, 231, 638, 97, 87, 87, 94, 40, 86, 40, - 87, 95, 96, 107, 92, 97, 137, 106, 92, 40, - - 232, 110, 139, 96, 99, 103, 94, 231, 40, 97, - 103, 40, 635, 95, 40, 107, 40, 99, 95, 106, - 87, 140, 633, 137, 106, 40, 232, 96, 107, 139, - 96, 103, 106, 110, 40, 51, 110, 51, 51, 99, - 234, 107, 235, 630, 99, 106, 51, 51, 140, 51, - 106, 109, 51, 112, 628, 109, 116, 112, 51, 110, - 626, 109, 51, 112, 51, 51, 234, 116, 235, 114, - 114, 624, 51, 51, 170, 51, 121, 170, 51, 622, - 114, 114, 115, 156, 51, 66, 114, 66, 66, 111, - 111, 116, 118, 121, 116, 115, 109, 66, 112, 66, - - 111, 111, 66, 157, 117, 158, 111, 119, 66, 170, - 156, 121, 66, 117, 66, 66, 114, 115, 118, 120, - 121, 565, 115, 66, 160, 66, 161, 118, 66, 111, - 157, 117, 158, 123, 66, 72, 111, 72, 72, 117, - 117, 119, 119, 120, 118, 416, 122, 72, 124, 72, - 141, 160, 72, 161, 120, 111, 123, 117, 72, 122, - 141, 124, 72, 125, 72, 72, 144, 119, 123, 120, - 133, 146, 146, 72, 146, 72, 144, 562, 72, 147, - 416, 122, 123, 124, 72, 133, 122, 141, 124, 147, - 145, 125, 145, 145, 150, 145, 164, 133, 125, 155, - - 151, 151, 151, 144, 150, 151, 146, 163, 152, 152, - 165, 133, 152, 385, 155, 166, 147, 125, 168, 169, - 171, 182, 163, 164, 180, 180, 155, 385, 561, 467, - 182, 150, 560, 171, 163, 180, 180, 165, 185, 184, - 155, 180, 166, 467, 152, 168, 169, 183, 163, 577, - 172, 172, 184, 181, 181, 171, 182, 182, 202, 185, - 171, 172, 199, 198, 181, 181, 181, 172, 187, 183, - 181, 180, 172, 185, 184, 172, 186, 187, 198, 184, - 237, 230, 183, 193, 577, 185, 202, 186, 200, 199, - 172, 559, 193, 202, 212, 183, 209, 199, 198, 172, - - 181, 200, 172, 187, 187, 198, 237, 212, 230, 203, - 203, 186, 202, 233, 186, 199, 172, 236, 193, 193, - 203, 210, 209, 200, 204, 204, 203, 211, 200, 212, - 203, 209, 238, 203, 212, 204, 204, 249, 248, 211, - 233, 204, 213, 215, 236, 214, 216, 558, 209, 210, - 250, 549, 545, 544, 543, 213, 210, 203, 214, 238, - 203, 251, 211, 249, 217, 248, 211, 215, 218, 219, - 252, 204, 208, 208, 216, 210, 250, 213, 215, 220, - 214, 216, 213, 208, 542, 214, 217, 541, 251, 208, - 218, 219, 466, 215, 254, 220, 252, 208, 253, 217, - - 216, 255, 256, 218, 219, 257, 208, 208, 258, 247, - 247, 208, 217, 247, 220, 259, 218, 219, 242, 242, - 254, 242, 220, 260, 208, 253, 262, 261, 255, 256, - 263, 257, 208, 208, 258, 264, 265, 208, 266, 266, - 267, 534, 259, 275, 273, 247, 276, 277, 400, 260, - 295, 389, 262, 242, 261, 534, 286, 263, 272, 272, - 279, 264, 265, 275, 266, 266, 267, 273, 280, 272, - 264, 277, 335, 319, 276, 272, 295, 282, 275, 273, - 318, 276, 277, 286, 272, 317, 281, 264, 279, 275, - 278, 278, 291, 273, 272, 279, 280, 277, 283, 283, - - 276, 278, 278, 280, 289, 282, 281, 278, 270, 283, - 283, 272, 282, 287, 279, 283, 284, 284, 285, 285, - 272, 281, 280, 294, 296, 297, 299, 284, 284, 285, - 285, 282, 281, 284, 301, 285, 293, 278, 303, 297, - 287, 293, 298, 310, 300, 283, 268, 301, 245, 243, - 294, 296, 240, 228, 311, 284, 226, 224, 312, 299, - 297, 299, 293, 284, 303, 285, 297, 293, 313, 301, - 310, 298, 300, 303, 301, 302, 302, 298, 304, 300, - 311, 284, 288, 288, 312, 299, 302, 302, 314, 304, - 303, 321, 302, 288, 221, 313, 324, 298, 300, 288, - - 309, 309, 207, 288, 206, 315, 316, 288, 305, 305, - 205, 288, 196, 304, 194, 314, 304, 288, 321, 305, - 305, 288, 302, 324, 322, 305, 309, 309, 306, 306, - 288, 315, 316, 191, 288, 320, 320, 323, 288, 306, - 306, 307, 307, 288, 325, 306, 326, 288, 308, 308, - 322, 329, 307, 307, 307, 305, 327, 327, 307, 308, - 308, 320, 320, 323, 330, 308, 328, 328, 331, 332, - 325, 333, 326, 327, 334, 306, 337, 338, 329, 339, - 340, 341, 342, 346, 188, 179, 178, 343, 307, 176, - 330, 175, 328, 328, 331, 308, 332, 333, 336, 336, - - 334, 343, 337, 173, 338, 339, 340, 341, 342, 336, - 336, 346, 344, 344, 149, 336, 356, 348, 346, 345, - 345, 362, 343, 344, 344, 349, 363, 350, 343, 344, - 345, 345, 347, 347, 348, 351, 345, 346, 349, 352, - 352, 357, 356, 347, 350, 336, 354, 354, 362, 347, - 352, 351, 348, 363, 358, 347, 352, 354, 354, 344, - 349, 348, 350, 354, 360, 349, 345, 357, 365, 361, - 351, 350, 353, 353, 352, 355, 355, 361, 351, 352, - 358, 364, 347, 353, 367, 366, 355, 380, 381, 353, - 360, 369, 355, 354, 365, 361, 359, 359, 368, 372, - - 352, 359, 355, 361, 353, 352, 359, 143, 364, 130, - 367, 355, 366, 380, 381, 382, 129, 369, 368, 128, - 126, 372, 359, 359, 370, 370, 369, 359, 386, 355, - 353, 113, 359, 368, 372, 370, 370, 355, 371, 371, - 374, 370, 382, 369, 368, 373, 373, 372, 375, 371, - 371, 383, 384, 374, 386, 371, 373, 376, 376, 105, - 104, 387, 373, 388, 375, 377, 377, 393, 376, 394, - 373, 370, 391, 392, 376, 374, 377, 395, 383, 384, - 374, 396, 377, 375, 397, 371, 377, 387, 377, 388, - 377, 375, 379, 379, 393, 376, 394, 373, 391, 392, - - 102, 398, 401, 379, 395, 399, 399, 396, 402, 379, - 397, 403, 404, 377, 405, 377, 379, 377, 406, 407, - 408, 376, 399, 410, 100, 90, 379, 398, 401, 414, - 89, 409, 409, 88, 402, 82, 76, 74, 403, 404, - 73, 405, 409, 379, 406, 407, 408, 415, 409, 410, - 411, 411, 379, 412, 412, 414, 409, 419, 413, 413, - 420, 411, 411, 411, 412, 421, 412, 411, 422, 413, - 412, 413, 423, 415, 419, 413, 417, 417, 418, 418, - 425, 426, 70, 409, 423, 427, 420, 417, 421, 418, - 68, 63, 419, 417, 422, 418, 429, 430, 424, 424, - - 421, 419, 62, 422, 431, 432, 425, 423, 426, 424, - 424, 423, 427, 53, 421, 424, 417, 418, 428, 428, - 422, 434, 429, 435, 430, 436, 437, 433, 433, 428, - 438, 431, 432, 440, 442, 428, 441, 443, 433, 428, - 428, 446, 417, 418, 433, 424, 439, 439, 434, 435, - 444, 445, 436, 437, 30, 447, 438, 439, 428, 448, - 440, 442, 441, 439, 443, 27, 428, 428, 446, 449, - 449, 452, 448, 453, 450, 450, 444, 445, 447, 456, - 449, 451, 451, 455, 428, 450, 449, 457, 22, 458, - 447, 450, 451, 451, 448, 454, 459, 452, 451, 448, - - 453, 460, 21, 461, 447, 456, 454, 462, 453, 449, - 455, 463, 464, 457, 450, 458, 465, 468, 469, 470, - 20, 471, 472, 459, 473, 474, 453, 460, 451, 461, - 475, 476, 477, 462, 478, 449, 479, 463, 480, 464, - 450, 454, 465, 468, 481, 469, 470, 471, 472, 482, - 473, 483, 474, 484, 485, 486, 475, 476, 492, 477, - 488, 478, 479, 487, 480, 490, 493, 499, 494, 495, - 481, 496, 498, 497, 16, 14, 482, 483, 504, 484, - 505, 485, 486, 506, 487, 492, 488, 550, 550, 499, - 487, 490, 494, 493, 11, 495, 497, 496, 498, 0, - - 500, 500, 499, 494, 550, 504, 505, 507, 497, 506, - 487, 500, 500, 501, 501, 499, 508, 500, 494, 509, - 502, 502, 497, 510, 501, 501, 501, 503, 503, 516, - 501, 502, 511, 507, 0, 512, 512, 502, 503, 0, - 513, 513, 508, 0, 503, 509, 512, 500, 512, 517, - 510, 513, 512, 515, 515, 502, 516, 513, 511, 518, - 501, 514, 514, 520, 515, 513, 515, 521, 519, 519, - 515, 522, 514, 514, 514, 523, 517, 0, 514, 519, - 527, 502, 525, 0, 529, 519, 518, 524, 524, 520, - 530, 0, 513, 519, 521, 526, 526, 522, 524, 0, - - 532, 523, 0, 519, 524, 535, 526, 519, 533, 525, - 529, 527, 526, 528, 528, 527, 530, 531, 531, 536, - 519, 537, 538, 539, 528, 528, 532, 547, 531, 519, - 528, 535, 548, 519, 531, 533, 0, 527, 551, 551, - 531, 540, 540, 533, 555, 556, 536, 537, 538, 539, - 563, 564, 540, 547, 568, 551, 552, 552, 540, 548, - 528, 533, 553, 553, 554, 554, 570, 531, 557, 557, - 555, 567, 556, 552, 569, 572, 563, 571, 564, 553, - 568, 554, 566, 566, 572, 557, 574, 575, 583, 573, - 573, 0, 570, 566, 0, 566, 581, 0, 567, 566, - - 573, 569, 573, 571, 576, 576, 573, 578, 578, 575, - 572, 572, 584, 574, 583, 576, 0, 576, 578, 579, - 579, 576, 575, 581, 578, 589, 582, 582, 586, 590, - 579, 587, 588, 592, 592, 575, 579, 582, 594, 584, - 596, 597, 578, 582, 585, 585, 598, 578, 599, 600, - 579, 582, 589, 599, 586, 585, 590, 587, 588, 592, - 592, 585, 601, 603, 594, 604, 596, 597, 578, 602, - 602, 606, 598, 578, 599, 600, 579, 609, 582, 599, - 602, 605, 605, 607, 607, 611, 602, 610, 619, 601, - 603, 604, 605, 612, 607, 607, 607, 606, 605, 0, - - 607, 608, 608, 616, 609, 0, 0, 617, 618, 613, - 613, 611, 608, 0, 610, 619, 0, 605, 608, 612, - 613, 613, 613, 620, 614, 614, 613, 634, 648, 616, - 607, 615, 615, 617, 618, 614, 661, 614, 0, 614, - 608, 614, 615, 605, 615, 0, 621, 621, 615, 652, - 620, 637, 637, 654, 634, 648, 613, 621, 639, 639, - 641, 641, 661, 621, 643, 643, 608, 621, 637, 645, - 645, 647, 647, 649, 649, 639, 652, 641, 655, 655, - 654, 643, 657, 658, 659, 664, 645, 665, 647, 655, - 649, 655, 0, 667, 621, 655, 662, 662, 669, 659, - - 0, 666, 666, 671, 668, 668, 0, 662, 662, 657, - 658, 664, 666, 662, 665, 668, 673, 668, 666, 659, - 667, 668, 670, 670, 669, 677, 659, 672, 672, 671, - 675, 0, 666, 670, 0, 670, 678, 679, 672, 670, - 674, 674, 673, 662, 672, 0, 680, 681, 685, 672, - 0, 674, 677, 674, 682, 0, 675, 674, 666, 686, - 676, 676, 688, 678, 679, 691, 0, 672, 0, 689, - 690, 676, 680, 676, 681, 685, 672, 676, 683, 683, - 682, 684, 684, 692, 695, 686, 696, 697, 688, 683, - 698, 691, 684, 672, 684, 683, 689, 690, 684, 707, - - 709, 703, 703, 683, 699, 699, 705, 705, 710, 692, - 711, 695, 696, 713, 697, 699, 698, 699, 703, 712, - 716, 699, 717, 705, 0, 707, 709, 714, 714, 719, - 683, 730, 712, 731, 710, 723, 711, 738, 714, 713, - 715, 715, 727, 0, 714, 720, 720, 716, 717, 732, - 714, 715, 722, 722, 712, 719, 720, 715, 730, 712, - 731, 723, 720, 722, 738, 722, 733, 735, 727, 722, - 725, 725, 736, 729, 729, 732, 737, 714, 739, 0, - 720, 725, 740, 725, 729, 742, 729, 725, 743, 0, - 729, 744, 733, 735, 745, 751, 741, 741, 736, 749, - - 749, 752, 737, 753, 756, 739, 720, 741, 740, 741, - 0, 0, 742, 741, 757, 743, 749, 744, 0, 759, - 745, 751, 754, 754, 761, 755, 755, 764, 752, 753, - 756, 766, 0, 754, 0, 754, 755, 755, 755, 754, - 757, 767, 755, 758, 758, 759, 760, 760, 769, 0, - 771, 761, 772, 764, 758, 0, 0, 760, 766, 760, - 758, 773, 775, 760, 762, 762, 778, 767, 758, 770, - 770, 0, 755, 0, 769, 762, 771, 780, 772, 781, - 770, 762, 770, 774, 774, 782, 770, 773, 784, 775, - 776, 776, 778, 783, 774, 758, 774, 777, 777, 762, - - 774, 776, 785, 776, 780, 781, 789, 776, 777, 790, - 777, 0, 782, 795, 777, 784, 792, 786, 786, 783, - 788, 788, 796, 0, 800, 762, 802, 805, 786, 785, - 786, 788, 789, 788, 786, 790, 0, 788, 791, 791, - 795, 806, 792, 793, 793, 807, 794, 794, 796, 791, - 800, 791, 802, 805, 793, 791, 793, 794, 809, 794, - 793, 797, 797, 794, 799, 799, 811, 806, 810, 801, - 801, 807, 797, 814, 0, 799, 815, 799, 797, 821, - 801, 799, 801, 824, 809, 826, 801, 816, 816, 828, - 818, 818, 797, 811, 810, 0, 0, 830, 816, 833, - - 814, 818, 815, 818, 816, 829, 821, 818, 822, 822, - 824, 826, 823, 823, 832, 828, 834, 0, 797, 822, - 836, 822, 816, 823, 830, 822, 833, 837, 0, 823, - 841, 829, 843, 835, 835, 848, 849, 0, 838, 838, - 832, 850, 834, 823, 835, 852, 835, 836, 816, 838, - 835, 839, 839, 0, 837, 838, 853, 841, 843, 844, - 844, 848, 839, 849, 845, 845, 865, 850, 839, 823, - 844, 852, 844, 838, 855, 845, 844, 845, 0, 846, - 846, 845, 853, 862, 847, 847, 863, 851, 851, 864, - 846, 839, 846, 865, 868, 847, 846, 847, 851, 838, - - 855, 847, 854, 854, 851, 856, 856, 869, 0, 862, - 857, 857, 863, 854, 871, 864, 856, 839, 856, 854, - 868, 857, 856, 857, 866, 866, 874, 857, 0, 0, - 876, 0, 867, 867, 869, 866, 877, 866, 876, 880, - 871, 866, 854, 867, 879, 867, 872, 872, 886, 867, - 882, 883, 0, 874, 875, 875, 876, 872, 878, 878, - 0, 887, 877, 872, 876, 875, 880, 875, 854, 878, - 879, 875, 884, 884, 886, 878, 888, 882, 883, 885, - 885, 891, 895, 884, 0, 884, 872, 887, 892, 884, - 885, 0, 885, 890, 890, 0, 885, 0, 878, 0, - - 894, 894, 888, 0, 890, 0, 890, 0, 891, 895, - 890, 894, 872, 894, 892, 897, 897, 894, 0, 0, - 0, 0, 0, 0, 878, 0, 897, 0, 897, 0, - 0, 0, 897, 900, 900, 900, 900, 900, 900, 900, - 901, 901, 901, 901, 901, 901, 901, 902, 902, 0, - 902, 903, 0, 903, 903, 903, 903, 903, 904, 0, - 0, 904, 904, 0, 904, 905, 905, 906, 0, 906, - 906, 906, 906, 906, 907, 0, 907, 907, 907, 907, - 907, 908, 0, 908, 908, 908, 908, 908, 910, 0, - 910, 910, 910, 910, 910, 911, 0, 911, 911, 911, - - 911, 911, 912, 0, 912, 912, 912, 912, 912, 913, - 0, 913, 913, 913, 913, 913, 915, 0, 915, 915, - 915, 915, 915, 916, 0, 916, 916, 916, 916, 916, - 917, 0, 917, 917, 917, 917, 917, 918, 0, 918, - 918, 918, 918, 918, 919, 0, 919, 919, 919, 919, - 919, 920, 0, 920, 920, 920, 920, 920, 921, 0, - 921, 921, 921, 921, 921, 922, 922, 922, 922, 922, - 922, 922, 923, 923, 923, 923, 923, 923, 923, 924, - 924, 924, 924, 924, 924, 924, 925, 0, 925, 926, - 926, 926, 926, 926, 926, 926, 927, 927, 927, 927, - - 927, 927, 927, 928, 928, 928, 928, 928, 928, 928, - 929, 929, 929, 929, 929, 929, 929, 930, 930, 930, - 930, 930, 930, 930, 931, 0, 931, 931, 931, 931, - 931, 932, 932, 932, 932, 932, 932, 932, 933, 933, - 933, 933, 933, 933, 933, 934, 934, 934, 934, 934, - 934, 934, 935, 935, 935, 935, 935, 935, 935, 936, - 936, 936, 936, 936, 936, 936, 937, 937, 937, 937, - 937, 937, 937, 938, 938, 938, 938, 938, 938, 938, - 939, 939, 939, 939, 939, 939, 939, 940, 940, 940, - 940, 940, 940, 940, 941, 941, 941, 941, 941, 941, - - 941, 942, 942, 942, 942, 942, 942, 942, 943, 943, - 943, 943, 943, 943, 943, 944, 944, 944, 944, 944, - 944, 944, 945, 945, 945, 945, 945, 945, 945, 946, - 946, 946, 946, 946, 946, 946, 947, 947, 947, 947, - 947, 947, 947, 948, 948, 948, 948, 948, 948, 948, - 949, 949, 949, 949, 949, 949, 949, 950, 950, 950, - 950, 950, 950, 950, 899, 899, 899, 899, 899, 899, - 899, 899, 899, 899, 899, 899, 899, 899, 899, 899, - 899, 899, 899, 899, 899, 899, 899, 899, 899, 899, - 899, 899, 899, 899, 899, 899, 899, 899, 899, 899, - - 899, 899, 899, 899, 899, 899, 899, 899, 899, 899, - 899, 899, 899, 899, 899, 899, 899, 899, 899, 899, - 899, 899, 899, 899, 899, 899, 899, 899, 899, 899, - 899, 899, 899, 899, 899, 899, 899, 899, 899, 899 - } ; - -static yy_state_type yy_last_accepting_state; -static char *yy_last_accepting_cpos; - -extern int yy_flex_debug; -int yy_flex_debug = 0; - -/* The intent behind this definition is that it'll catch - * any uses of REJECT which flex missed. - */ -#define REJECT reject_used_but_not_detected -#define yymore() yymore_used_but_not_detected -#define YY_MORE_ADJ 0 -#define YY_RESTORE_YY_MORE_OFFSET -char *yytext; -#line 1 "scanner.l" -/* - Copyright (C) 2001-2012, 2014-2019 Free Software Foundation, Inc. - Written by Keisuke Nishida, Roger While, Simon Sobisch, Edwart Hart, - Ron Norman - - This file is part of GnuCOBOL. - - The GnuCOBOL compiler is free software: you can redistribute it - and/or modify it under the terms of the GNU General Public License - as published by the Free Software Foundation, either version 3 of the - License, or (at your option) any later version. - - GnuCOBOL is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with GnuCOBOL. If not, see . -*/ -#line 49 "scanner.l" - -#undef YY_READ_BUF_SIZE -#define YY_READ_BUF_SIZE 32768 -#undef YY_BUF_SIZE -#define YY_BUF_SIZE 32768 - -#define YY_SKIP_YYWRAP -static int yywrap (void) { - return 1; -} - -#define YY_INPUT(buf,result,max_size) \ - { \ - if (fgets (buf, (int)max_size, yyin) == NULL) { \ - result = YY_NULL; \ - } else { \ - result = strlen (buf); \ - } \ - } - -#define YY_USER_INIT \ - if (!plex_buff) { \ - plex_size = COB_MINI_BUFF; \ - plex_buff = cobc_malloc (plex_size); \ - } \ - if (!pic_buff1) { \ - pic1_size = COB_MINI_BUFF; \ - pic_buff1 = cobc_malloc (pic1_size); \ - } \ - if (!pic_buff2) { \ - pic2_size = COB_MINI_BUFF; \ - pic_buff2 = cobc_malloc (pic2_size); \ - } - -#include - -#include -#include - -#ifdef HAVE_UNISTD_H -#include -#else -#define YY_NO_UNISTD_H 1 -#endif - -#define COB_IN_SCANNER 1 -#include "cobc.h" -#include "tree.h" - -/* ignore unused functions here as flex generates unused ones */ -#ifdef __GNUC__ -#if defined (__clang__) || __GNUC__ > 4 || (__GNUC__ == 4 && __GNUC_MINOR__ >= 4) -#pragma GCC diagnostic ignored "-Wunused-function" -#endif -#endif - -#define YYSTYPE cb_tree -#include - -#define RETURN_TOK(expr) \ - do { \ - last_yylval = yylval; \ - last_token = (expr); \ - return last_token; \ - } ONCE_COB - -#define SET_LOCATION(x) \ - do { \ - (x)->source_file = cb_source_file; \ - (x)->source_line = cb_source_line; \ - } ONCE_COB - -/* CONSTANT (78 level) structure */ -struct cb_level_78 { - struct cb_level_78 *next; /* Next in chain */ - struct cb_level_78 *glob_next; /* Continued next in chain */ - struct cb_level_78 *last; /* Last in chain */ - struct cb_field *fld_78; /* Pointer to field */ - struct cb_program *prog; /* Program where defined */ - cob_u32_t name_len; /* Length of name */ - cob_u32_t not_const; /* Invalid usage check */ - cob_u32_t chk_const; /* Check global level use */ -}; - -struct cb_top_level_78 { - struct cb_top_level_78 *next; - struct cb_level_78 *lev_78_ptr; -}; - -/* Local variables */ -static cb_tree last_yylval; -static int last_token; -static struct cb_level_78 *top_78_ptr = NULL; -static struct cb_level_78 *const_78_ptr = NULL; -static struct cb_level_78 *lev_78_ptr = NULL; -static struct cb_level_78 *glob_lev_78_ptr = NULL; -static char *plex_buff = NULL; -static char *pic_buff1 = NULL; -static char *pic_buff2 = NULL; -static size_t plex_size; -static size_t pic1_size; -static size_t pic2_size; -static unsigned int last_token_is_dot = 0; -static unsigned int integer_is_label = 0; -static unsigned int inside_bracket = 0; -static unsigned int literal_error; -static char err_msg[COB_MINI_BUFF]; - -/* Function declarations */ -static void read_literal (const char, const char *); -static int scan_x (const char *, const char *); -static int scan_z (const char *, const char *); -static int scan_h (const char *, const char *); -static int scan_b (const char *, const char *); -static int scan_o (const char *, const char *); -static int scan_numeric (const char *); -static int scan_floating_numeric (const char *); -static void scan_picture (const char *); -static void count_lines (const char *); -static void scan_define_options (const char *); -static void copy_word_in_quotes (char ** const); -static void copy_two_words_in_quotes (char ** const, char ** const); -static void add_synonym (const int); -static void * copy_literal (cb_tree l); - -#line 1565 "scanner.c" - -#line 1567 "scanner.c" - -#define INITIAL 0 -#define DECIMAL_IS_PERIOD 1 -#define DECIMAL_IS_COMMA 2 -#define PICTURE_STATE 3 -#define FUNCTION_STATE 4 - -#ifndef YY_NO_UNISTD_H -/* Special case for "unistd.h", since it is non-ANSI. We include it way - * down here because we want the user's section 1 to have been scanned first. - * The user has a chance to override it with an option. - */ -#include -#endif - -#ifndef YY_EXTRA_TYPE -#define YY_EXTRA_TYPE void * -#endif - -static int yy_init_globals ( void ); - -/* Accessor methods to globals. - These are made visible to non-reentrant scanners for convenience. */ - -int yylex_destroy ( void ); - -/* Macros after this point can all be overridden by user definitions in - * section 1. - */ - -#ifndef YY_SKIP_YYWRAP -#ifdef __cplusplus -extern "C" int yywrap ( void ); -#else -extern int yywrap ( void ); -#endif -#endif - -#ifndef YY_NO_UNPUT - - static void yyunput ( int c, char *buf_ptr ); - -#endif - -#ifndef yytext_ptr -static void yy_flex_strncpy ( char *, const char *, int ); -#endif - -#ifdef YY_NEED_STRLEN -static int yy_flex_strlen ( const char * ); -#endif - -#ifndef YY_NO_INPUT -#ifdef __cplusplus -static int yyinput ( void ); -#else -static int input ( void ); -#endif - -#endif - -/* Amount of stuff to slurp up with each read. */ -#ifndef YY_READ_BUF_SIZE -#ifdef __ia64__ -/* On IA-64, the buffer size is 16k, not 8k */ -#define YY_READ_BUF_SIZE 16384 -#else -#define YY_READ_BUF_SIZE 8192 -#endif /* __ia64__ */ -#endif - -/* Copy whatever the last rule matched to the standard output. */ -#ifndef ECHO -/* This used to be an fputs(), but since the string might contain NUL's, - * we now use fwrite(). - */ -#define ECHO do { if (fwrite( yytext, (size_t) yyleng, 1, yyout )) {} } while (0) -#endif - -/* Gets input and stuffs it into "buf". number of characters read, or YY_NULL, - * is returned in "result". - */ -#ifndef YY_INPUT -#define YY_INPUT(buf,result,max_size) \ - if ( YY_CURRENT_BUFFER_LVALUE->yy_is_interactive ) \ - { \ - int c = '*'; \ - int n; \ - for ( n = 0; n < max_size && \ - (c = getc( yyin )) != EOF && c != '\n'; ++n ) \ - buf[n] = (char) c; \ - if ( c == '\n' ) \ - buf[n++] = (char) c; \ - if ( c == EOF && ferror( yyin ) ) \ - YY_FATAL_ERROR( "input in flex scanner failed" ); \ - result = n; \ - } \ - else \ - { \ - errno=0; \ - while ( (result = (int) fread(buf, 1, (yy_size_t) max_size, yyin)) == 0 && ferror(yyin)) \ - { \ - if( errno != EINTR) \ - { \ - YY_FATAL_ERROR( "input in flex scanner failed" ); \ - break; \ - } \ - errno=0; \ - clearerr(yyin); \ - } \ - }\ -\ - -#endif - -/* No semi-colon after return; correct usage is to write "yyterminate();" - - * we don't want an extra ';' after the "return" because that will cause - * some compilers to complain about unreachable statements. - */ -#ifndef yyterminate -#define yyterminate() return YY_NULL -#endif - -/* Number of entries by which start-condition stack grows. */ -#ifndef YY_START_STACK_INCR -#define YY_START_STACK_INCR 25 -#endif - -/* Report a fatal error. */ -#ifndef YY_FATAL_ERROR -#define YY_FATAL_ERROR(msg) yy_fatal_error( msg ) -#endif - -/* end tables serialization structures and prototypes */ - -/* Default declaration of generated scanner - a define so the user can - * easily add parameters. - */ -#ifndef YY_DECL -#define YY_DECL_IS_OURS 1 - -extern int yylex (void); - -#define YY_DECL int yylex (void) -#endif /* !YY_DECL */ - -/* Code executed at the beginning of each rule, after yytext and yyleng - * have been set up. - */ -#ifndef YY_USER_ACTION -#define YY_USER_ACTION -#endif - -/* Code executed at the end of each rule. */ -#ifndef YY_BREAK -#define YY_BREAK /*LINTED*/break; -#endif - -#define YY_RULE_SETUP \ - if ( yyleng > 0 ) \ - YY_CURRENT_BUFFER_LVALUE->yy_at_bol = \ - (yytext[yyleng - 1] == '\n'); \ - YY_USER_ACTION - -/** The main scanner function which does all the work. - */ -YY_DECL -{ - yy_state_type yy_current_state; - char *yy_cp, *yy_bp; - int yy_act; - - if ( !(yy_init) ) - { - (yy_init) = 1; - -#ifdef YY_USER_INIT - YY_USER_INIT; -#endif - - if ( ! (yy_start) ) - (yy_start) = 1; /* first start state */ - - if ( ! yyin ) - yyin = stdin; - - if ( ! yyout ) - yyout = stdout; - - if ( ! YY_CURRENT_BUFFER ) { - yyensure_buffer_stack (); - YY_CURRENT_BUFFER_LVALUE = - yy_create_buffer( yyin, YY_BUF_SIZE ); - } - - yy_load_buffer_state( ); - } - - { -#line 179 "scanner.l" - - - -#line 183 "scanner.l" - if (likely (current_program)) { - if (current_program->decimal_point == '.') { - BEGIN DECIMAL_IS_PERIOD; - } else { - BEGIN DECIMAL_IS_COMMA; - } - } - - if (cobc_repeat_last_token) { - cobc_repeat_last_token = 0; - yylval = last_yylval; - return last_token; - } - - /* We treat integer literals immediately after '.' as labels; - that is, they must be level numbers or section names. */ - if (last_token_is_dot) { - integer_is_label = 1; - last_token_is_dot = 0; - } else { - integer_is_label = 0; - } - - -#line 1796 "scanner.c" - - while ( /*CONSTCOND*/1 ) /* loops until end-of-file is reached */ - { - yy_cp = (yy_c_buf_p); - - /* Support of yytext. */ - *yy_cp = (yy_hold_char); - - /* yy_bp points to the position in yy_ch_buf of the start of - * the current run. - */ - yy_bp = yy_cp; - - yy_current_state = (yy_start); - yy_current_state += YY_AT_BOL(); -yy_match: - do - { - YY_CHAR yy_c = yy_ec[YY_SC_TO_UI(*yy_cp)] ; - if ( yy_accept[yy_current_state] ) - { - (yy_last_accepting_state) = yy_current_state; - (yy_last_accepting_cpos) = yy_cp; - } - while ( yy_chk[yy_base[yy_current_state] + yy_c] != yy_current_state ) - { - yy_current_state = (int) yy_def[yy_current_state]; - if ( yy_current_state >= 900 ) - yy_c = yy_meta[yy_c]; - } - yy_current_state = yy_nxt[yy_base[yy_current_state] + yy_c]; - ++yy_cp; - } - while ( yy_current_state != 899 ); - yy_cp = (yy_last_accepting_cpos); - yy_current_state = (yy_last_accepting_state); - -yy_find_action: - yy_act = yy_accept[yy_current_state]; - - YY_DO_BEFORE_ACTION; - -do_action: /* This label is used only to access EOF actions. */ - - switch ( yy_act ) - { /* beginning of action switch */ - case 0: /* must back up */ - /* undo the effects of YY_DO_BEFORE_ACTION */ - *yy_cp = (yy_hold_char); - yy_cp = (yy_last_accepting_cpos); - yy_current_state = (yy_last_accepting_state); - goto yy_find_action; - -case 1: -/* rule 1 can match eol */ -YY_RULE_SETUP -#line 207 "scanner.l" -{ - const char *p1; - char *p2; - if (current_program->extfh) { - cobc_parse_free ((void *)current_program->extfh); - current_program->extfh = NULL; - } - p1 = strchr (yytext, '"'); - if (p1) { - ++p1; - p2 = strrchr (p1, '"'); - if (p2) { - *p2 = 0; - if (strcmp (p1, "EXTFH")) { - current_program->extfh = cobc_parse_strdup (p1); - } - } - } -} - YY_BREAK -case 2: -/* rule 2 can match eol */ -YY_RULE_SETUP -#line 227 "scanner.l" -{ - char *p1; - char *p2; - p1 = strchr (yytext, '"'); - if (p1) { - ++p1; - p2 = strrchr (p1, '"'); - if (p2) { - *p2 = 0; - /* Quotes are removed and string passed - * for processing with the next field */ - cb_save_xfd (p1); - } - } -} - YY_BREAK -case 3: -/* rule 3 can match eol */ -YY_RULE_SETUP -#line 243 "scanner.l" -{ - scan_define_options (yytext); -} - YY_BREAK -case 4: -/* rule 4 can match eol */ -YY_RULE_SETUP -#line 247 "scanner.l" -{ - char *word; - - copy_word_in_quotes (&word); - add_reserved_word_now (word, NULL); - cobc_free (word); -} - YY_BREAK -case 5: -/* rule 5 can match eol */ -YY_RULE_SETUP -#line 255 "scanner.l" -{ - add_synonym (0); -} - YY_BREAK -case 6: -/* rule 6 can match eol */ -YY_RULE_SETUP -#line 259 "scanner.l" -{ - char *new_meaning; - char *word_to_change; - - copy_two_words_in_quotes (&new_meaning, &word_to_change); - - if (!is_default_reserved_word (new_meaning)) { - cb_error (_("'%s' is not a default reserved word, so cannot be aliased"), - new_meaning); - } else if (!is_reserved_word (word_to_change)) { - cb_error (_("'%s' is not a reserved word; you may want ADDSYN or OVERRIDE instead"), - word_to_change); - } else { - remove_reserved_word_now (word_to_change); - add_reserved_word_now (word_to_change, new_meaning); - } - - cobc_free (new_meaning); - cobc_free (word_to_change); - } - YY_BREAK -case 7: -/* rule 7 can match eol */ -YY_RULE_SETUP -#line 280 "scanner.l" -{ - add_synonym (1); -} - YY_BREAK -case 8: -/* rule 8 can match eol */ -YY_RULE_SETUP -#line 284 "scanner.l" -{ - char *word; - - copy_word_in_quotes (&word); - remove_reserved_word_now (word); - cobc_free (word); -} - YY_BREAK -case 9: -/* rule 9 can match eol */ -YY_RULE_SETUP -#line 292 "scanner.l" -{ - char *text = cobc_strdup (yytext); - cb_assign_type_default = (enum cb_assign_type)(text[1] - '0'); -} - YY_BREAK -case 10: -/* rule 10 can match eol */ -YY_RULE_SETUP -#line 297 "scanner.l" -{ - cb_source_line++; -} - YY_BREAK -case 11: -YY_RULE_SETUP -#line 301 "scanner.l" -{ - /* Line directive */ - char *p1; - char *p2; - - p1 = strchr (yytext, '"'); - if (p1) { - p2 = p1 + 1; - p1 = strrchr (p2, '"'); - if (p1) { - *p1 = 0; - cb_source_file = cobc_parse_strdup (p2); - /* FIXME: only place where strol is used, replace by cobc internal - function for base 10 (found in cobc.c already) and base 16, - remove from configure.ac */ - cb_source_line = (int)strtol (yytext + 5, NULL, 10) - 1; - } - } -} - YY_BREAK -case 12: -YY_RULE_SETUP -#line 321 "scanner.l" -{ - /* Ignore */ -} - YY_BREAK -case 13: -#line 326 "scanner.l" -case 14: -YY_RULE_SETUP -#line 326 "scanner.l" -{ - BEGIN PICTURE_STATE; -} - YY_BREAK -case 15: -YY_RULE_SETUP -#line 330 "scanner.l" -{ - if (cobc_in_repository || cobc_cs_check == CB_CS_EXIT) { - yylval = NULL; - RETURN_TOK (FUNCTION); - } - BEGIN FUNCTION_STATE; -} - YY_BREAK -case 16: -YY_RULE_SETUP -#line 338 "scanner.l" -{ - /* String literal */ - cobc_force_literal = 0; - read_literal (yytext[0], ""); - RETURN_TOK (LITERAL); -} - YY_BREAK -case 17: -#line 346 "scanner.l" -case 18: -YY_RULE_SETUP -#line 346 "scanner.l" -{ - /* X string literal */ - cobc_force_literal = 0; - RETURN_TOK (scan_x (yytext + 2, "X")); -} - YY_BREAK -case 19: -YY_RULE_SETUP -#line 352 "scanner.l" -{ - /* N national string literal */ - cobc_force_literal = 0; - /* TODO: national string - needs different handling */ - read_literal (yytext [1], "N"); - RETURN_TOK (LITERAL); -} - YY_BREAK -case 20: -YY_RULE_SETUP -#line 360 "scanner.l" -{ - /* NC national character string literal (extension, but - same handling as COBOL 2002 national string literal) */ - cobc_force_literal = 0; - /* TODO: national string - needs different handling */ - read_literal (yytext [2], "NC"); - RETURN_TOK (LITERAL); -} - YY_BREAK -case 21: -#line 370 "scanner.l" -case 22: -YY_RULE_SETUP -#line 370 "scanner.l" -{ - /* NX string literal */ - cobc_force_literal = 0; - RETURN_TOK (scan_x (yytext + 3, "NX")); -} - YY_BREAK -case 23: -#line 377 "scanner.l" -case 24: -YY_RULE_SETUP -#line 377 "scanner.l" -{ - /* Z string literal */ - cobc_force_literal = 0; - RETURN_TOK (scan_z (yytext + 2, "Z")); -} - YY_BREAK -case 25: -#line 384 "scanner.l" -case 26: -YY_RULE_SETUP -#line 384 "scanner.l" -{ - /* L string literal */ - cobc_force_literal = 0; - RETURN_TOK (scan_z (yytext + 2, "L")); -} - YY_BREAK -case 27: -#line 391 "scanner.l" -case 28: -YY_RULE_SETUP -#line 391 "scanner.l" -{ - /* H hexadecimal/numeric literal */ - cobc_force_literal = 0; - RETURN_TOK (scan_h (yytext + 2, "H")); -} - YY_BREAK -case 29: -#line 398 "scanner.l" -case 30: -YY_RULE_SETUP -#line 398 "scanner.l" -{ - /* B boolean/numeric literal */ - cobc_force_literal = 0; - RETURN_TOK (scan_b (yytext + 2, "B")); -} - YY_BREAK -case 31: -#line 405 "scanner.l" -case 32: -YY_RULE_SETUP -#line 405 "scanner.l" -{ - /* BX boolean hexadecimal string literal */ - cobc_force_literal = 0; - RETURN_TOK (scan_x (yytext + 3, "BX")); -} - YY_BREAK -case 33: -YY_RULE_SETUP -#line 411 "scanner.l" -{ - /* - To avoid subtle silent errors, such as B#021, this rule (and the ones - following) here admit some invalid literals which emit errors when - they are processed. - */ - /* ACUCOBOL binary numeric literal */ - cobc_force_literal = 0; - RETURN_TOK (scan_b (yytext + 2, "B#")); -} - YY_BREAK -case 34: -YY_RULE_SETUP -#line 422 "scanner.l" -{ - /* ACUCOBOL octal numeric literal */ - cobc_force_literal = 0; - RETURN_TOK (scan_o (yytext + 2, "O#")); -} - YY_BREAK -case 35: -YY_RULE_SETUP -#line 428 "scanner.l" -{ - /* HP-COBOL octal numeric literal */ - cobc_force_literal = 0; - RETURN_TOK (scan_o (yytext + 1, "%")); -} - YY_BREAK -case 36: -#line 435 "scanner.l" -case 37: -YY_RULE_SETUP -#line 435 "scanner.l" -{ - /* ACUCOBOL hexadecimal numeric literal */ - char type[3] = "x#"; - type[0] = yytext [0]; - cobc_force_literal = 0; - RETURN_TOK (scan_h (yytext + 2, type)); -} - YY_BREAK -case 38: -YY_RULE_SETUP -#line 443 "scanner.l" -{ - inside_bracket++; - RETURN_TOK (TOK_OPEN_PAREN); -} - YY_BREAK -case 39: -YY_RULE_SETUP -#line 448 "scanner.l" -{ - if (inside_bracket > 0) { - inside_bracket--; - } - RETURN_TOK (TOK_CLOSE_PAREN); -} - YY_BREAK -case 40: -YY_RULE_SETUP -#line 455 "scanner.l" -{ - int value; - - cobc_force_literal = 0; - if (integer_is_label) { - yylval = cb_build_reference (yytext); - - if (!cobc_in_procedure) { - value = atoi (yytext); - if (value == 66) { - /* level number 66 */ - RETURN_TOK (SIXTY_SIX); - } else if (value == 78) { - /* level number 78 */ - RETURN_TOK (SEVENTY_EIGHT); - } else if (value == 88) { - /* level number 88 */ - RETURN_TOK (EIGHTY_EIGHT); - } else if ((value >= 1 && value <= 49) || value == 77) { - /* level number (1 through 49, 77) */ - RETURN_TOK (LEVEL_NUMBER); - } - } - - /* Integer label */ - RETURN_TOK (WORD); - } - /* Numeric literal or referenced integer label - remark: all transformations/checks are postponed: - literals to tree.c, - integer label to typeck.c (cb_build_section_name) - */ - yylval = cb_build_numeric_literal (0, yytext, 0); - RETURN_TOK (LITERAL); -} - YY_BREAK -case 41: -YY_RULE_SETUP -#line 491 "scanner.l" -{ - - cobc_force_literal = 0; - if (integer_is_label) { - /* Integer label */ - yylval = cb_build_reference (yytext); - RETURN_TOK (WORD); - } - /* Numeric literal or referenced integer label - remark: all transformations/checks are postponed: - literals to tree.c, - integer label to typeck.c (cb_build_section_name) - */ - yylval = cb_build_numeric_literal (0, yytext, 0); - RETURN_TOK (LITERAL); -} - YY_BREAK -case 42: -YY_RULE_SETUP -#line 508 "scanner.l" -{ - /* Numeric literal (signed) */ - RETURN_TOK (scan_numeric (yytext)); -} - YY_BREAK -case 43: -YY_RULE_SETUP -#line 513 "scanner.l" -{ - /* Ignore */ -} - YY_BREAK -case 44: -YY_RULE_SETUP -#line 517 "scanner.l" -{ - if (inside_bracket) { - RETURN_TOK (SEMI_COLON); - } - /* Ignore */ -} - YY_BREAK -case 45: -YY_RULE_SETUP -#line 524 "scanner.l" -{ - /* Numeric floating point literal */ - RETURN_TOK (scan_floating_numeric (yytext)); -} - YY_BREAK -case 46: -YY_RULE_SETUP -#line 529 "scanner.l" -{ - /* Invalid numeric floating point literal */ - RETURN_TOK (scan_floating_numeric (yytext)); -} - YY_BREAK -case 47: -YY_RULE_SETUP -#line 534 "scanner.l" -{ - /* Numeric literal */ - RETURN_TOK (scan_numeric (yytext)); -} - YY_BREAK -case 48: -YY_RULE_SETUP -#line 539 "scanner.l" -{ - if (inside_bracket) { - RETURN_TOK (COMMA_DELIM); - } - /* Ignore */ -} - YY_BREAK -case 49: -YY_RULE_SETUP -#line 546 "scanner.l" -{ - /* Numeric floating point literal */ - RETURN_TOK (scan_floating_numeric (yytext)); -} - YY_BREAK -case 50: -YY_RULE_SETUP -#line 551 "scanner.l" -{ - /* Invalid numeric floating point literal */ - RETURN_TOK (scan_floating_numeric (yytext)); -} - YY_BREAK -case 51: -YY_RULE_SETUP -#line 556 "scanner.l" -{ - /* Numeric literal */ - RETURN_TOK (scan_numeric (yytext)); -} - YY_BREAK -case 52: -YY_RULE_SETUP -#line 561 "scanner.l" -{ - unput (','); -} - YY_BREAK -case 53: -YY_RULE_SETUP -#line 565 "scanner.l" -{ - if (inside_bracket) { - RETURN_TOK (COMMA_DELIM); - } - /* Ignore */ -} - YY_BREAK -case 54: -/* rule 54 can match eol */ -*yy_cp = (yy_hold_char); /* undo effects of setting up yytext */ -YY_LINENO_REWIND_TO(yy_cp - 1); -(yy_c_buf_p) = yy_cp -= 1; -YY_DO_BEFORE_ACTION; /* set up yytext again */ -YY_RULE_SETUP -#line 572 "scanner.l" -{ - cobc_force_literal = 1; - count_lines (yytext); - RETURN_TOK (END_PROGRAM); -} - YY_BREAK -case 55: -/* rule 55 can match eol */ -*yy_cp = (yy_hold_char); /* undo effects of setting up yytext */ -YY_LINENO_REWIND_TO(yy_cp - 1); -(yy_c_buf_p) = yy_cp -= 1; -YY_DO_BEFORE_ACTION; /* set up yytext again */ -YY_RULE_SETUP -#line 578 "scanner.l" -{ - cobc_force_literal = 1; - count_lines (yytext); - RETURN_TOK (END_FUNCTION); -} - YY_BREAK -case 56: -/* rule 56 can match eol */ -*yy_cp = (yy_hold_char); /* undo effects of setting up yytext */ -YY_LINENO_REWIND_TO(yy_cp - 1); -(yy_c_buf_p) = yy_cp -= 1; -YY_DO_BEFORE_ACTION; /* set up yytext again */ -YY_RULE_SETUP -#line 584 "scanner.l" -{ - count_lines (yytext); - RETURN_TOK (PICTURE_SYMBOL); -} - YY_BREAK -case 57: -/* rule 57 can match eol */ -*yy_cp = (yy_hold_char); /* undo effects of setting up yytext */ -YY_LINENO_REWIND_TO(yy_cp - 1); -(yy_c_buf_p) = yy_cp -= 1; -YY_DO_BEFORE_ACTION; /* set up yytext again */ -YY_RULE_SETUP -#line 589 "scanner.l" -{ - count_lines (yytext); - RETURN_TOK (FROM_CRT); -} - YY_BREAK -case 58: -/* rule 58 can match eol */ -*yy_cp = (yy_hold_char); /* undo effects of setting up yytext */ -YY_LINENO_REWIND_TO(yy_cp - 1); -(yy_c_buf_p) = yy_cp -= 1; -YY_DO_BEFORE_ACTION; /* set up yytext again */ -YY_RULE_SETUP -#line 594 "scanner.l" -{ - count_lines (yytext); - RETURN_TOK (SCREEN_CONTROL); -} - YY_BREAK -case 59: -/* rule 59 can match eol */ -*yy_cp = (yy_hold_char); /* undo effects of setting up yytext */ -YY_LINENO_REWIND_TO(yy_cp - 1); -(yy_c_buf_p) = yy_cp -= 1; -YY_DO_BEFORE_ACTION; /* set up yytext again */ -YY_RULE_SETUP -#line 599 "scanner.l" -{ - count_lines (yytext); - RETURN_TOK (EVENT_STATUS); -} - YY_BREAK -case 60: -/* rule 60 can match eol */ -*yy_cp = (yy_hold_char); /* undo effects of setting up yytext */ -YY_LINENO_REWIND_TO(yy_cp - 1); -(yy_c_buf_p) = yy_cp -= 1; -YY_DO_BEFORE_ACTION; /* set up yytext again */ -YY_RULE_SETUP -#line 604 "scanner.l" -{ - count_lines (yytext); - RETURN_TOK (READY_TRACE); -} - YY_BREAK -case 61: -/* rule 61 can match eol */ -*yy_cp = (yy_hold_char); /* undo effects of setting up yytext */ -YY_LINENO_REWIND_TO(yy_cp - 1); -(yy_c_buf_p) = yy_cp -= 1; -YY_DO_BEFORE_ACTION; /* set up yytext again */ -YY_RULE_SETUP -#line 609 "scanner.l" -{ - count_lines (yytext); - RETURN_TOK (RESET_TRACE); -} - YY_BREAK -case 62: -/* rule 62 can match eol */ -*yy_cp = (yy_hold_char); /* undo effects of setting up yytext */ -YY_LINENO_REWIND_TO(yy_cp - 1); -(yy_c_buf_p) = yy_cp -= 1; -YY_DO_BEFORE_ACTION; /* set up yytext again */ -YY_RULE_SETUP -#line 614 "scanner.l" -{ - count_lines (yytext); - RETURN_TOK (GREATER_OR_EQUAL); -} - YY_BREAK -case 63: -/* rule 63 can match eol */ -*yy_cp = (yy_hold_char); /* undo effects of setting up yytext */ -YY_LINENO_REWIND_TO(yy_cp - 1); -(yy_c_buf_p) = yy_cp -= 1; -YY_DO_BEFORE_ACTION; /* set up yytext again */ -YY_RULE_SETUP -#line 619 "scanner.l" -{ - count_lines (yytext); - RETURN_TOK (GREATER); -} - YY_BREAK -case 64: -/* rule 64 can match eol */ -*yy_cp = (yy_hold_char); /* undo effects of setting up yytext */ -YY_LINENO_REWIND_TO(yy_cp - 1); -(yy_c_buf_p) = yy_cp -= 1; -YY_DO_BEFORE_ACTION; /* set up yytext again */ -YY_RULE_SETUP -#line 624 "scanner.l" -{ - count_lines (yytext); - RETURN_TOK (LESS_OR_EQUAL); -} - YY_BREAK -case 65: -/* rule 65 can match eol */ -*yy_cp = (yy_hold_char); /* undo effects of setting up yytext */ -YY_LINENO_REWIND_TO(yy_cp - 1); -(yy_c_buf_p) = yy_cp -= 1; -YY_DO_BEFORE_ACTION; /* set up yytext again */ -YY_RULE_SETUP -#line 629 "scanner.l" -{ - count_lines (yytext); - RETURN_TOK (LESS); -} - YY_BREAK -case 66: -/* rule 66 can match eol */ -*yy_cp = (yy_hold_char); /* undo effects of setting up yytext */ -YY_LINENO_REWIND_TO(yy_cp - 1); -(yy_c_buf_p) = yy_cp -= 1; -YY_DO_BEFORE_ACTION; /* set up yytext again */ -YY_RULE_SETUP -#line 634 "scanner.l" -{ - count_lines (yytext); - RETURN_TOK (EQUAL); -} - YY_BREAK -case 67: -/* rule 67 can match eol */ -*yy_cp = (yy_hold_char); /* undo effects of setting up yytext */ -YY_LINENO_REWIND_TO(yy_cp - 1); -(yy_c_buf_p) = yy_cp -= 1; -YY_DO_BEFORE_ACTION; /* set up yytext again */ -YY_RULE_SETUP -#line 639 "scanner.l" -{ - count_lines (yytext); - RETURN_TOK (REPLACING); -} - YY_BREAK -case 68: -/* rule 68 can match eol */ -*yy_cp = (yy_hold_char); /* undo effects of setting up yytext */ -YY_LINENO_REWIND_TO(yy_cp - 1); -(yy_c_buf_p) = yy_cp -= 1; -YY_DO_BEFORE_ACTION; /* set up yytext again */ -YY_RULE_SETUP -#line 644 "scanner.l" -{ - count_lines (yytext); - RETURN_TOK (TOP); -} - YY_BREAK -case 69: -/* rule 69 can match eol */ -*yy_cp = (yy_hold_char); /* undo effects of setting up yytext */ -YY_LINENO_REWIND_TO(yy_cp - 1); -(yy_c_buf_p) = yy_cp -= 1; -YY_DO_BEFORE_ACTION; /* set up yytext again */ -YY_RULE_SETUP -#line 648 "scanner.l" -{ - count_lines (yytext); - RETURN_TOK (TOP); -} - YY_BREAK -case 70: -/* rule 70 can match eol */ -*yy_cp = (yy_hold_char); /* undo effects of setting up yytext */ -YY_LINENO_REWIND_TO(yy_cp - 1); -(yy_c_buf_p) = yy_cp -= 1; -YY_DO_BEFORE_ACTION; /* set up yytext again */ -YY_RULE_SETUP -#line 653 "scanner.l" -{ - count_lines (yytext); - RETURN_TOK (BOTTOM); -} - YY_BREAK -case 71: -/* rule 71 can match eol */ -*yy_cp = (yy_hold_char); /* undo effects of setting up yytext */ -YY_LINENO_REWIND_TO(yy_cp - 1); -(yy_c_buf_p) = yy_cp -= 1; -YY_DO_BEFORE_ACTION; /* set up yytext again */ -YY_RULE_SETUP -#line 657 "scanner.l" -{ - count_lines (yytext); - RETURN_TOK (BOTTOM); -} - YY_BREAK -case 72: -/* rule 72 can match eol */ -*yy_cp = (yy_hold_char); /* undo effects of setting up yytext */ -YY_LINENO_REWIND_TO(yy_cp - 1); -(yy_c_buf_p) = yy_cp -= 1; -YY_DO_BEFORE_ACTION; /* set up yytext again */ -YY_RULE_SETUP -#line 662 "scanner.l" -{ - count_lines (yytext); - return LINE_LIMIT; -} - YY_BREAK -case 73: -/* rule 73 can match eol */ -*yy_cp = (yy_hold_char); /* undo effects of setting up yytext */ -YY_LINENO_REWIND_TO(yy_cp - 1); -(yy_c_buf_p) = yy_cp -= 1; -YY_DO_BEFORE_ACTION; /* set up yytext again */ -YY_RULE_SETUP -#line 667 "scanner.l" -{ - count_lines (yytext); - RETURN_TOK (NO_ADVANCING); -} - YY_BREAK -case 74: -/* rule 74 can match eol */ -*yy_cp = (yy_hold_char); /* undo effects of setting up yytext */ -YY_LINENO_REWIND_TO(yy_cp - 1); -(yy_c_buf_p) = yy_cp -= 1; -YY_DO_BEFORE_ACTION; /* set up yytext again */ -YY_RULE_SETUP -#line 672 "scanner.l" -{ - count_lines (yytext); - RETURN_TOK (NEXT_PAGE); -} - YY_BREAK -case 75: -/* rule 75 can match eol */ -*yy_cp = (yy_hold_char); /* undo effects of setting up yytext */ -YY_LINENO_REWIND_TO(yy_cp - 1); -(yy_c_buf_p) = yy_cp -= 1; -YY_DO_BEFORE_ACTION; /* set up yytext again */ -YY_RULE_SETUP -#line 677 "scanner.l" -{ - count_lines (yytext); - return NEXT_GROUP; -} - YY_BREAK -case 76: -/* rule 76 can match eol */ -*yy_cp = (yy_hold_char); /* undo effects of setting up yytext */ -YY_LINENO_REWIND_TO(yy_cp - 1); -(yy_c_buf_p) = yy_cp -= 1; -YY_DO_BEFORE_ACTION; /* set up yytext again */ -YY_RULE_SETUP -#line 682 "scanner.l" -{ - count_lines (yytext); - RETURN_TOK (NOT_SIZE_ERROR); -} - YY_BREAK -case 77: -/* rule 77 can match eol */ -*yy_cp = (yy_hold_char); /* undo effects of setting up yytext */ -YY_LINENO_REWIND_TO(yy_cp - 1); -(yy_c_buf_p) = yy_cp -= 1; -YY_DO_BEFORE_ACTION; /* set up yytext again */ -YY_RULE_SETUP -#line 687 "scanner.l" -{ - count_lines (yytext); - RETURN_TOK (SIZE_ERROR); -} - YY_BREAK -case 78: -/* rule 78 can match eol */ -*yy_cp = (yy_hold_char); /* undo effects of setting up yytext */ -YY_LINENO_REWIND_TO(yy_cp - 1); -(yy_c_buf_p) = yy_cp -= 1; -YY_DO_BEFORE_ACTION; /* set up yytext again */ -YY_RULE_SETUP -#line 692 "scanner.l" -{ - count_lines (yytext); - RETURN_TOK (NOT_ESCAPE); -} - YY_BREAK -case 79: -/* rule 79 can match eol */ -*yy_cp = (yy_hold_char); /* undo effects of setting up yytext */ -YY_LINENO_REWIND_TO(yy_cp - 1); -(yy_c_buf_p) = yy_cp -= 1; -YY_DO_BEFORE_ACTION; /* set up yytext again */ -YY_RULE_SETUP -#line 697 "scanner.l" -{ - count_lines (yytext); - RETURN_TOK (NOT_EXCEPTION); -} - YY_BREAK -case 80: -/* rule 80 can match eol */ -*yy_cp = (yy_hold_char); /* undo effects of setting up yytext */ -YY_LINENO_REWIND_TO(yy_cp - 1); -(yy_c_buf_p) = yy_cp -= 1; -YY_DO_BEFORE_ACTION; /* set up yytext again */ -YY_RULE_SETUP -#line 702 "scanner.l" -{ - count_lines (yytext); - RETURN_TOK (ESCAPE); -} - YY_BREAK -case 81: -/* rule 81 can match eol */ -*yy_cp = (yy_hold_char); /* undo effects of setting up yytext */ -YY_LINENO_REWIND_TO(yy_cp - 1); -(yy_c_buf_p) = yy_cp -= 1; -YY_DO_BEFORE_ACTION; /* set up yytext again */ -YY_RULE_SETUP -#line 707 "scanner.l" -{ - count_lines (yytext); - RETURN_TOK (EXCEPTION); -} - YY_BREAK -case 82: -/* rule 82 can match eol */ -*yy_cp = (yy_hold_char); /* undo effects of setting up yytext */ -YY_LINENO_REWIND_TO(yy_cp - 1); -(yy_c_buf_p) = yy_cp -= 1; -YY_DO_BEFORE_ACTION; /* set up yytext again */ -YY_RULE_SETUP -#line 712 "scanner.l" -{ - count_lines (yytext); - RETURN_TOK (NOT_OVERFLOW); -} - YY_BREAK -case 83: -/* rule 83 can match eol */ -*yy_cp = (yy_hold_char); /* undo effects of setting up yytext */ -YY_LINENO_REWIND_TO(yy_cp - 1); -(yy_c_buf_p) = yy_cp -= 1; -YY_DO_BEFORE_ACTION; /* set up yytext again */ -YY_RULE_SETUP -#line 717 "scanner.l" -{ - count_lines (yytext); - RETURN_TOK (NOT_END); -} - YY_BREAK -case 84: -/* rule 84 can match eol */ -*yy_cp = (yy_hold_char); /* undo effects of setting up yytext */ -YY_LINENO_REWIND_TO(yy_cp - 1); -(yy_c_buf_p) = yy_cp -= 1; -YY_DO_BEFORE_ACTION; /* set up yytext again */ -YY_RULE_SETUP -#line 722 "scanner.l" -{ - count_lines (yytext); - RETURN_TOK (END); -} - YY_BREAK -case 85: -/* rule 85 can match eol */ -*yy_cp = (yy_hold_char); /* undo effects of setting up yytext */ -YY_LINENO_REWIND_TO(yy_cp - 1); -(yy_c_buf_p) = yy_cp -= 1; -YY_DO_BEFORE_ACTION; /* set up yytext again */ -YY_RULE_SETUP -#line 727 "scanner.l" -{ - count_lines (yytext); - RETURN_TOK (TOK_OVERFLOW); -} - YY_BREAK -case 86: -/* rule 86 can match eol */ -*yy_cp = (yy_hold_char); /* undo effects of setting up yytext */ -YY_LINENO_REWIND_TO(yy_cp - 1); -(yy_c_buf_p) = yy_cp -= 1; -YY_DO_BEFORE_ACTION; /* set up yytext again */ -YY_RULE_SETUP -#line 732 "scanner.l" -{ - count_lines (yytext); - RETURN_TOK (NOT_EOP); -} - YY_BREAK -case 87: -/* rule 87 can match eol */ -*yy_cp = (yy_hold_char); /* undo effects of setting up yytext */ -YY_LINENO_REWIND_TO(yy_cp - 1); -(yy_c_buf_p) = yy_cp -= 1; -YY_DO_BEFORE_ACTION; /* set up yytext again */ -YY_RULE_SETUP -#line 737 "scanner.l" -{ - count_lines (yytext); - RETURN_TOK (EOP); -} - YY_BREAK -case 88: -/* rule 88 can match eol */ -*yy_cp = (yy_hold_char); /* undo effects of setting up yytext */ -YY_LINENO_REWIND_TO(yy_cp - 1); -(yy_c_buf_p) = yy_cp -= 1; -YY_DO_BEFORE_ACTION; /* set up yytext again */ -YY_RULE_SETUP -#line 742 "scanner.l" -{ - count_lines (yytext); - RETURN_TOK (NOT_INVALID_KEY); -} - YY_BREAK -case 89: -/* rule 89 can match eol */ -*yy_cp = (yy_hold_char); /* undo effects of setting up yytext */ -YY_LINENO_REWIND_TO(yy_cp - 1); -(yy_c_buf_p) = yy_cp -= 1; -YY_DO_BEFORE_ACTION; /* set up yytext again */ -YY_RULE_SETUP -#line 747 "scanner.l" -{ - count_lines (yytext); - RETURN_TOK (INVALID_KEY); -} - YY_BREAK -case 90: -/* rule 90 can match eol */ -*yy_cp = (yy_hold_char); /* undo effects of setting up yytext */ -YY_LINENO_REWIND_TO(yy_cp - 1); -(yy_c_buf_p) = yy_cp -= 1; -YY_DO_BEFORE_ACTION; /* set up yytext again */ -YY_RULE_SETUP -#line 752 "scanner.l" -{ - count_lines (yytext); - RETURN_TOK (NO_DATA); -} - YY_BREAK -case 91: -/* rule 91 can match eol */ -*yy_cp = (yy_hold_char); /* undo effects of setting up yytext */ -YY_LINENO_REWIND_TO(yy_cp - 1); -(yy_c_buf_p) = yy_cp -= 1; -YY_DO_BEFORE_ACTION; /* set up yytext again */ -YY_RULE_SETUP -#line 757 "scanner.l" -{ - count_lines (yytext); - RETURN_TOK (DATA); -} - YY_BREAK -case 92: -/* rule 92 can match eol */ -*yy_cp = (yy_hold_char); /* undo effects of setting up yytext */ -YY_LINENO_REWIND_TO(yy_cp - 1); -(yy_c_buf_p) = yy_cp -= 1; -YY_DO_BEFORE_ACTION; /* set up yytext again */ -YY_RULE_SETUP -#line 762 "scanner.l" -{ - count_lines (yytext); - RETURN_TOK (UPON_ENVIRONMENT_NAME); -} - YY_BREAK -case 93: -/* rule 93 can match eol */ -*yy_cp = (yy_hold_char); /* undo effects of setting up yytext */ -YY_LINENO_REWIND_TO(yy_cp - 1); -(yy_c_buf_p) = yy_cp -= 1; -YY_DO_BEFORE_ACTION; /* set up yytext again */ -YY_RULE_SETUP -#line 767 "scanner.l" -{ - count_lines (yytext); - RETURN_TOK (UPON_ENVIRONMENT_VALUE); -} - YY_BREAK -case 94: -/* rule 94 can match eol */ -*yy_cp = (yy_hold_char); /* undo effects of setting up yytext */ -YY_LINENO_REWIND_TO(yy_cp - 1); -(yy_c_buf_p) = yy_cp -= 1; -YY_DO_BEFORE_ACTION; /* set up yytext again */ -YY_RULE_SETUP -#line 772 "scanner.l" -{ - count_lines (yytext); - RETURN_TOK (UPON_ARGUMENT_NUMBER); -} - YY_BREAK -case 95: -/* rule 95 can match eol */ -*yy_cp = (yy_hold_char); /* undo effects of setting up yytext */ -YY_LINENO_REWIND_TO(yy_cp - 1); -(yy_c_buf_p) = yy_cp -= 1; -YY_DO_BEFORE_ACTION; /* set up yytext again */ -YY_RULE_SETUP -#line 777 "scanner.l" -{ - count_lines (yytext); - RETURN_TOK (UPON_COMMAND_LINE); -} - YY_BREAK -case 96: -/* rule 96 can match eol */ -*yy_cp = (yy_hold_char); /* undo effects of setting up yytext */ -YY_LINENO_REWIND_TO(yy_cp - 1); -(yy_c_buf_p) = yy_cp -= 1; -YY_DO_BEFORE_ACTION; /* set up yytext again */ -YY_RULE_SETUP -#line 782 "scanner.l" -{ - count_lines (yytext); - RETURN_TOK (EXCEPTION_CONDITION); -} - YY_BREAK -case 97: -/* rule 97 can match eol */ -*yy_cp = (yy_hold_char); /* undo effects of setting up yytext */ -YY_LINENO_REWIND_TO(yy_cp - 1); -(yy_c_buf_p) = yy_cp -= 1; -YY_DO_BEFORE_ACTION; /* set up yytext again */ -YY_RULE_SETUP -#line 787 "scanner.l" -{ - count_lines (yytext); - RETURN_TOK (EC); -} - YY_BREAK -case 98: -/* rule 98 can match eol */ -*yy_cp = (yy_hold_char); /* undo effects of setting up yytext */ -YY_LINENO_REWIND_TO(yy_bp + 8); -(yy_c_buf_p) = yy_cp = yy_bp + 8; -YY_DO_BEFORE_ACTION; /* set up yytext again */ -YY_RULE_SETUP -#line 792 "scanner.l" -{ - count_lines (yytext); - if (cobc_in_xml_generate_body || cobc_in_json_generate_body) { - /* - Using the standard SUPPRESS token in JSON/XML GENERATE causes - a shift/reduce error - the SUPPRESS could be the start of the - SUPPRESS clause or the start of a SUPPRESS statement. While we - could alter shift precedence to get the result we implement - here (viz. assuming the SUPPRESS belongs to JSON/XML GENERATE), - our current style is for bison to run with no errors. - */ - RETURN_TOK (SUPPRESS_XML); - } else { - RETURN_TOK (SUPPRESS); - } -} - YY_BREAK -case 99: -/* rule 99 can match eol */ -*yy_cp = (yy_hold_char); /* undo effects of setting up yytext */ -YY_LINENO_REWIND_TO(yy_bp + 4); -(yy_c_buf_p) = yy_cp = yy_bp + 4; -YY_DO_BEFORE_ACTION; /* set up yytext again */ -YY_RULE_SETUP -#line 809 "scanner.l" -{ - count_lines (yytext); - if (cobc_in_xml_generate_body) { - /* - Using the standard WHEN token in XML GENERATE causes a - shift/reduce error - the WHEN could be the start of the - WHEN clause or the start of a WHEN statement. While we - could alter shift precedence to get the result we implement - here (viz. assuming the WHEN belongs to XML GENERATE), our - current style is for bison to run with no errors. - */ - RETURN_TOK (WHEN_XML); - } else { - RETURN_TOK (WHEN); - } -} - YY_BREAK -case 100: -/* rule 100 can match eol */ -*yy_cp = (yy_hold_char); /* undo effects of setting up yytext */ -YY_LINENO_REWIND_TO(yy_cp - 1); -(yy_c_buf_p) = yy_cp -= 1; -YY_DO_BEFORE_ACTION; /* set up yytext again */ -YY_RULE_SETUP -#line 827 "scanner.l" -{ - /* ACUCOBOL extension: switch-names with space and with letter */ - char suffix[3] = ""; - char name[10] = ""; - - /* FIXME: move the code for filling "name" here and first - check with "lookup_system_name (name) != NULL" - if we actually want to do this, - otherwise return 2 (!) WORD tokens (by adding a queue - of tokens to be returned) - */ - if (cobc_in_procedure) { - /* unput characters */ - yylval = cb_build_reference ("SWITCH"); - if (isdigit((unsigned char)yytext[yyleng-2])) { - unput (yytext[yyleng-1]); - unput (yytext[yyleng-2]); - } else { - unput (yytext[yyleng-1]); - } - } else { - /* we need to return a single word, reverted later in parser.y */ - if (yytext[yyleng-2] == ' ' && isdigit((unsigned char)yytext[yyleng-1])) { - /* SWITCH 0 to SWITCH 9 */ - suffix[0] = yytext[yyleng-1]; - } else if (isdigit((unsigned char)yytext[yyleng-2])) { - /* SWITCH 00 to SWITCH 99 */ - suffix[0] = yytext[yyleng-2]; - suffix[1] = yytext[yyleng-1]; - } else { - suffix[0] = yytext[yyleng-1]; - } - strncpy(name, yytext, 6); - strcat(name, "_"); - strcat(name, suffix); - yylval = cb_build_reference (name); - } - RETURN_TOK (WORD); -} - YY_BREAK -case 101: -/* rule 101 can match eol */ -*yy_cp = (yy_hold_char); /* undo effects of setting up yytext */ -YY_LINENO_REWIND_TO(yy_cp - 1); -(yy_c_buf_p) = yy_cp -= 1; -YY_DO_BEFORE_ACTION; /* set up yytext again */ -YY_RULE_SETUP -#line 867 "scanner.l" -{ - count_lines (yytext); - RETURN_TOK (LENGTH_OF); -} - YY_BREAK -case 102: -YY_RULE_SETUP -#line 872 "scanner.l" -{ - struct cb_level_78 *p78; - struct cb_intrinsic_table *cbp; - struct cobc_reserved *resptr; - struct cb_text_list *tlp; - cb_tree x; - cb_tree l; - struct cb_program *program; - - cb_check_word_length ((unsigned int)yyleng, yytext); - - /* Check Intrinsic FUNCTION name without keyword */ - if ((cobc_in_procedure && (functions_are_all || cb_intrinsic_list || - current_program->function_spec_list)) || cobc_in_repository) { - cbp = lookup_intrinsic (yytext, 0); - if (cbp) { - if (cobc_in_repository) { - yylval = cb_build_alphanumeric_literal (yytext, (size_t)yyleng); - RETURN_TOK (FUNCTION_NAME); - } - if (functions_are_all) { - yylval = cb_build_reference (yytext); - RETURN_TOK ((enum yytokentype)(cbp->token)); - } - for (tlp = cb_intrinsic_list; tlp; tlp = tlp->next) { - if (!strcasecmp (yytext, tlp->text)) { - yylval = cb_build_reference (yytext); - RETURN_TOK ((enum yytokentype)(cbp->token)); - } - } - l = current_program->function_spec_list; - for (; l; l = CB_CHAIN(l)) { - x = CB_VALUE (l); - if (!strcasecmp (yytext, - (char *)(CB_LITERAL(x)->data))) { - yylval = cb_build_reference (yytext); - RETURN_TOK ((enum yytokentype)(cbp->token)); - } - } - } - } - - /* Bail early for (END) PROGRAM-ID when not a literal */ - if (unlikely (cobc_force_literal)) { - /* Force PROGRAM-ID / END PROGRAM */ - cobc_force_literal = 0; - if (cb_fold_call) { - yylval = cb_build_reference (yytext); - RETURN_TOK (PROGRAM_NAME); - } else { - yylval = cb_build_alphanumeric_literal (yytext, (size_t)yyleng); - RETURN_TOK (LITERAL); - } - } - - /* Check reserved word */ - resptr = lookup_reserved_word (yytext); - if (resptr != NULL) { - if (resptr->nodegen) { - /* Save location for terminator checking */ - /* Misuse comment tree to mark statement */ - yylval = cb_build_comment (NULL); - } else { - yylval = NULL; - } - RETURN_TOK (resptr->token); - } - - /* New user-defined word in REPOSITORY entry */ - if (cobc_in_repository) { - yylval = cb_build_reference (yytext); - RETURN_TOK (WORD); - } - - /* Direct recursive reference in function */ - if (current_program->prog_type == COB_MODULE_TYPE_FUNCTION - && !functions_are_all - && !strcasecmp (yytext, current_program->orig_program_id)) { - yylval = cb_build_reference (yytext); - RETURN_TOK (USER_FUNCTION_NAME); - } - - /* Check prototype names */ - for (l = current_program->user_spec_list; l; l = CB_CHAIN (l)) { - x = CB_VALUE (l); - if (!strcasecmp (yytext, CB_PROTOTYPE (x)->name)) { - yylval = cb_build_reference (yytext); - RETURN_TOK (USER_FUNCTION_NAME); - } - } - if (cobc_allow_program_name) { - for (l = current_program->program_spec_list; l; l = CB_CHAIN (l)) { - x = CB_VALUE (l); - if (!strcasecmp (yytext, CB_PROTOTYPE (x)->name)) { - yylval = cb_build_reference (yytext); - RETURN_TOK (PROGRAM_NAME); - } - } - } - - /* Check user programs */ - if (cobc_in_id) { - program = cb_find_defined_program_by_name (yytext); - if (program) { - yylval = cb_build_reference (yytext); - RETURN_TOK (PROGRAM_NAME); - } - } - - /* User word */ - - /* Check local, global and source global CONSTANT (78) items */ - - for (p78 = top_78_ptr; p78; p78 = p78->glob_next) { - if (strcasecmp (yytext, p78->fld_78->name) == 0) { - if (unlikely (non_const_word)) { - if (p78->prog == current_program) { - cb_error (_("a constant may not be used here - '%s'"), yytext); - yylval = cb_error_node; - RETURN_TOK (WORD); - } - if (p78->chk_const) { - p78->not_const = 1; - } - break; - } - if (p78->chk_const && p78->not_const) { - break; - } - yylval = copy_literal (CB_VALUE (p78->fld_78->values)); - SET_LOCATION (yylval); - RETURN_TOK (LITERAL); - } - } - - yylval = cb_build_reference (yytext); - - /* Special name handling */ - if (CB_WORD_COUNT (yylval) > 0 && CB_WORD_ITEMS (yylval)) { - x = CB_VALUE (CB_WORD_ITEMS (yylval)); - if (CB_SYSTEM_NAME_P (x)) { - RETURN_TOK (MNEMONIC_NAME); - } else if (CB_CLASS_NAME_P (x)) { - RETURN_TOK (CLASS_NAME); - } - } - - RETURN_TOK (WORD); -} - YY_BREAK -case 103: -YY_RULE_SETUP -#line 1022 "scanner.l" -{ - yylval = NULL; - RETURN_TOK (LESS_OR_EQUAL); -} - YY_BREAK -case 104: -YY_RULE_SETUP -#line 1027 "scanner.l" -{ - yylval = NULL; - RETURN_TOK (GREATER_OR_EQUAL); -} - YY_BREAK -case 105: -YY_RULE_SETUP -#line 1032 "scanner.l" -{ - yylval = NULL; - RETURN_TOK (NOT_EQUAL); -} - YY_BREAK -case 106: -YY_RULE_SETUP -#line 1037 "scanner.l" -{ - yylval = NULL; - RETURN_TOK (EXPONENTIATION); -} - YY_BREAK -case 107: -/* rule 107 can match eol */ -YY_RULE_SETUP -#line 1042 "scanner.l" -{ - if (last_token_is_dot || strlen (yytext) > 1) { - cb_warning (COBC_WARN_FILLER, _("ignoring redundant .")); - } - - if (!last_token_is_dot) { - last_token_is_dot = 1; - yylval = NULL; - RETURN_TOK (TOK_DOT); - } -} - YY_BREAK -case 108: -YY_RULE_SETUP -#line 1054 "scanner.l" -{ - yylval = NULL; - RETURN_TOK (TOK_AMPER); -} - YY_BREAK -case 109: -YY_RULE_SETUP -#line 1059 "scanner.l" -{ - yylval = NULL; - RETURN_TOK (TOK_COLON); -} - YY_BREAK -case 110: -YY_RULE_SETUP -#line 1064 "scanner.l" -{ - yylval = NULL; - RETURN_TOK (TOK_EQUAL); -} - YY_BREAK -case 111: -YY_RULE_SETUP -#line 1069 "scanner.l" -{ - yylval = NULL; - RETURN_TOK (TOK_DIV); -} - YY_BREAK -case 112: -YY_RULE_SETUP -#line 1074 "scanner.l" -{ - yylval = NULL; - RETURN_TOK (TOK_MUL); -} - YY_BREAK -case 113: -YY_RULE_SETUP -#line 1079 "scanner.l" -{ - yylval = NULL; - RETURN_TOK (TOK_PLUS); -} - YY_BREAK -case 114: -YY_RULE_SETUP -#line 1084 "scanner.l" -{ - yylval = NULL; - RETURN_TOK (TOK_MINUS); -} - YY_BREAK -case 115: -YY_RULE_SETUP -#line 1089 "scanner.l" -{ - yylval = NULL; - RETURN_TOK (TOK_LESS); -} - YY_BREAK -case 116: -YY_RULE_SETUP -#line 1094 "scanner.l" -{ - yylval = NULL; - RETURN_TOK (TOK_GREATER); -} - YY_BREAK -case 117: -YY_RULE_SETUP -#line 1099 "scanner.l" -{ - int c; - - cb_error (_("invalid symbol '%s' - skipping word"), yytext); - while ((c = input ()) != EOF) { - if (c == '\n' || c == ' ') { - break; - } - } - if (c != EOF) { - unput (c); - } -} - YY_BREAK - -case 118: -YY_RULE_SETUP -#line 1115 "scanner.l" -{ - /* Ignore */ - } - YY_BREAK -case 119: -YY_RULE_SETUP -#line 1118 "scanner.l" -{ - BEGIN INITIAL; - scan_picture (yytext); - RETURN_TOK (PICTURE); - } - YY_BREAK - - -case 120: -YY_RULE_SETUP -#line 1126 "scanner.l" -{ - struct cb_intrinsic_table *cbp; - cb_tree l; - cb_tree x; - - BEGIN INITIAL; - yylval = cb_build_reference (yytext); - for (l = current_program->user_spec_list; l; l = CB_CHAIN(l)) { - x = CB_VALUE (l); - if (!strcasecmp (yytext, CB_PROTOTYPE (x)->name)) { - RETURN_TOK (USER_FUNCTION_NAME); - } - } - cbp = lookup_intrinsic (yytext, 0); - if (cbp) { - RETURN_TOK ((enum yytokentype)(cbp->token)); - } - RETURN_TOK (FUNCTION_NAME); - } - YY_BREAK -case 121: -YY_RULE_SETUP -#line 1145 "scanner.l" -{ - yylval = NULL; - RETURN_TOK (yytext[0]); - } - YY_BREAK - -case YY_STATE_EOF(INITIAL): -case YY_STATE_EOF(DECIMAL_IS_PERIOD): -case YY_STATE_EOF(DECIMAL_IS_COMMA): -case YY_STATE_EOF(PICTURE_STATE): -case YY_STATE_EOF(FUNCTION_STATE): -#line 1151 "scanner.l" -{ - struct cb_level_78 *p78; - struct cb_level_78 *p782; - - /* At EOF - Clear variables */ - for (p78 = lev_78_ptr; p78; ) { - p782 = p78->next; - cobc_free (p78); - p78 = p782; - } - for (p78 = glob_lev_78_ptr; p78; ) { - p782 = p78->next; - cobc_free (p78); - p78 = p782; - } - for (p78 = const_78_ptr; p78; ) { - p782 = p78->next; - cobc_free (p78); - p78 = p782; - } - top_78_ptr = NULL; - last_token_is_dot = 0; - integer_is_label = 0; - inside_bracket = 0; - lev_78_ptr = NULL; - glob_lev_78_ptr = NULL; - cobc_force_literal = 0; - yyterminate (); -} - YY_BREAK -case 122: -YY_RULE_SETUP -#line 1181 "scanner.l" -YY_FATAL_ERROR( "flex scanner jammed" ); - YY_BREAK -#line 3433 "scanner.c" - - case YY_END_OF_BUFFER: - { - /* Amount of text matched not including the EOB char. */ - int yy_amount_of_matched_text = (int) (yy_cp - (yytext_ptr)) - 1; - - /* Undo the effects of YY_DO_BEFORE_ACTION. */ - *yy_cp = (yy_hold_char); - YY_RESTORE_YY_MORE_OFFSET - - if ( YY_CURRENT_BUFFER_LVALUE->yy_buffer_status == YY_BUFFER_NEW ) - { - /* We're scanning a new file or input source. It's - * possible that this happened because the user - * just pointed yyin at a new source and called - * yylex(). If so, then we have to assure - * consistency between YY_CURRENT_BUFFER and our - * globals. Here is the right place to do so, because - * this is the first action (other than possibly a - * back-up) that will match for the new input source. - */ - (yy_n_chars) = YY_CURRENT_BUFFER_LVALUE->yy_n_chars; - YY_CURRENT_BUFFER_LVALUE->yy_input_file = yyin; - YY_CURRENT_BUFFER_LVALUE->yy_buffer_status = YY_BUFFER_NORMAL; - } - - /* Note that here we test for yy_c_buf_p "<=" to the position - * of the first EOB in the buffer, since yy_c_buf_p will - * already have been incremented past the NUL character - * (since all states make transitions on EOB to the - * end-of-buffer state). Contrast this with the test - * in input(). - */ - if ( (yy_c_buf_p) <= &YY_CURRENT_BUFFER_LVALUE->yy_ch_buf[(yy_n_chars)] ) - { /* This was really a NUL. */ - yy_state_type yy_next_state; - - (yy_c_buf_p) = (yytext_ptr) + yy_amount_of_matched_text; - - yy_current_state = yy_get_previous_state( ); - - /* Okay, we're now positioned to make the NUL - * transition. We couldn't have - * yy_get_previous_state() go ahead and do it - * for us because it doesn't know how to deal - * with the possibility of jamming (and we don't - * want to build jamming into it because then it - * will run more slowly). - */ - - yy_next_state = yy_try_NUL_trans( yy_current_state ); - - yy_bp = (yytext_ptr) + YY_MORE_ADJ; - - if ( yy_next_state ) - { - /* Consume the NUL. */ - yy_cp = ++(yy_c_buf_p); - yy_current_state = yy_next_state; - goto yy_match; - } - - else - { - yy_cp = (yy_last_accepting_cpos); - yy_current_state = (yy_last_accepting_state); - goto yy_find_action; - } - } - - else switch ( yy_get_next_buffer( ) ) - { - case EOB_ACT_END_OF_FILE: - { - (yy_did_buffer_switch_on_eof) = 0; - - if ( yywrap( ) ) - { - /* Note: because we've taken care in - * yy_get_next_buffer() to have set up - * yytext, we can now set up - * yy_c_buf_p so that if some total - * hoser (like flex itself) wants to - * call the scanner after we return the - * YY_NULL, it'll still work - another - * YY_NULL will get returned. - */ - (yy_c_buf_p) = (yytext_ptr) + YY_MORE_ADJ; - - yy_act = YY_STATE_EOF(YY_START); - goto do_action; - } - - else - { - if ( ! (yy_did_buffer_switch_on_eof) ) - YY_NEW_FILE; - } - break; - } - - case EOB_ACT_CONTINUE_SCAN: - (yy_c_buf_p) = - (yytext_ptr) + yy_amount_of_matched_text; - - yy_current_state = yy_get_previous_state( ); - - yy_cp = (yy_c_buf_p); - yy_bp = (yytext_ptr) + YY_MORE_ADJ; - goto yy_match; - - case EOB_ACT_LAST_MATCH: - (yy_c_buf_p) = - &YY_CURRENT_BUFFER_LVALUE->yy_ch_buf[(yy_n_chars)]; - - yy_current_state = yy_get_previous_state( ); - - yy_cp = (yy_c_buf_p); - yy_bp = (yytext_ptr) + YY_MORE_ADJ; - goto yy_find_action; - } - break; - } - - default: - YY_FATAL_ERROR( - "fatal flex scanner internal error--no action found" ); - } /* end of action switch */ - } /* end of scanning one token */ - } /* end of user's declarations */ -} /* end of yylex */ - -/* yy_get_next_buffer - try to read in a new buffer - * - * Returns a code representing an action: - * EOB_ACT_LAST_MATCH - - * EOB_ACT_CONTINUE_SCAN - continue scanning from current position - * EOB_ACT_END_OF_FILE - end of file - */ -static int yy_get_next_buffer (void) -{ - char *dest = YY_CURRENT_BUFFER_LVALUE->yy_ch_buf; - char *source = (yytext_ptr); - int number_to_move, i; - int ret_val; - - if ( (yy_c_buf_p) > &YY_CURRENT_BUFFER_LVALUE->yy_ch_buf[(yy_n_chars) + 1] ) - YY_FATAL_ERROR( - "fatal flex scanner internal error--end of buffer missed" ); - - if ( YY_CURRENT_BUFFER_LVALUE->yy_fill_buffer == 0 ) - { /* Don't try to fill the buffer, so this is an EOF. */ - if ( (yy_c_buf_p) - (yytext_ptr) - YY_MORE_ADJ == 1 ) - { - /* We matched a single character, the EOB, so - * treat this as a final EOF. - */ - return EOB_ACT_END_OF_FILE; - } - - else - { - /* We matched some text prior to the EOB, first - * process it. - */ - return EOB_ACT_LAST_MATCH; - } - } - - /* Try to read more data. */ - - /* First move last chars to start of buffer. */ - number_to_move = (int) ((yy_c_buf_p) - (yytext_ptr) - 1); - - for ( i = 0; i < number_to_move; ++i ) - *(dest++) = *(source++); - - if ( YY_CURRENT_BUFFER_LVALUE->yy_buffer_status == YY_BUFFER_EOF_PENDING ) - /* don't do the read, it's not guaranteed to return an EOF, - * just force an EOF - */ - YY_CURRENT_BUFFER_LVALUE->yy_n_chars = (yy_n_chars) = 0; - - else - { - int num_to_read = - YY_CURRENT_BUFFER_LVALUE->yy_buf_size - number_to_move - 1; - - while ( num_to_read <= 0 ) - { /* Not enough room in the buffer - grow it. */ - - /* just a shorter name for the current buffer */ - YY_BUFFER_STATE b = YY_CURRENT_BUFFER_LVALUE; - - int yy_c_buf_p_offset = - (int) ((yy_c_buf_p) - b->yy_ch_buf); - - if ( b->yy_is_our_buffer ) - { - int new_size = b->yy_buf_size * 2; - - if ( new_size <= 0 ) - b->yy_buf_size += b->yy_buf_size / 8; - else - b->yy_buf_size *= 2; - - b->yy_ch_buf = (char *) - /* Include room in for 2 EOB chars. */ - yyrealloc( (void *) b->yy_ch_buf, - (yy_size_t) (b->yy_buf_size + 2) ); - } - else - /* Can't grow it, we don't own it. */ - b->yy_ch_buf = NULL; - - if ( ! b->yy_ch_buf ) - YY_FATAL_ERROR( - "fatal error - scanner input buffer overflow" ); - - (yy_c_buf_p) = &b->yy_ch_buf[yy_c_buf_p_offset]; - - num_to_read = YY_CURRENT_BUFFER_LVALUE->yy_buf_size - - number_to_move - 1; - - } - - if ( num_to_read > YY_READ_BUF_SIZE ) - num_to_read = YY_READ_BUF_SIZE; - - /* Read in more data. */ - YY_INPUT( (&YY_CURRENT_BUFFER_LVALUE->yy_ch_buf[number_to_move]), - (yy_n_chars), num_to_read ); - - YY_CURRENT_BUFFER_LVALUE->yy_n_chars = (yy_n_chars); - } - - if ( (yy_n_chars) == 0 ) - { - if ( number_to_move == YY_MORE_ADJ ) - { - ret_val = EOB_ACT_END_OF_FILE; - yyrestart( yyin ); - } - - else - { - ret_val = EOB_ACT_LAST_MATCH; - YY_CURRENT_BUFFER_LVALUE->yy_buffer_status = - YY_BUFFER_EOF_PENDING; - } - } - - else - ret_val = EOB_ACT_CONTINUE_SCAN; - - if (((yy_n_chars) + number_to_move) > YY_CURRENT_BUFFER_LVALUE->yy_buf_size) { - /* Extend the array by 50%, plus the number we really need. */ - int new_size = (yy_n_chars) + number_to_move + ((yy_n_chars) >> 1); - YY_CURRENT_BUFFER_LVALUE->yy_ch_buf = (char *) yyrealloc( - (void *) YY_CURRENT_BUFFER_LVALUE->yy_ch_buf, (yy_size_t) new_size ); - if ( ! YY_CURRENT_BUFFER_LVALUE->yy_ch_buf ) - YY_FATAL_ERROR( "out of dynamic memory in yy_get_next_buffer()" ); - /* "- 2" to take care of EOB's */ - YY_CURRENT_BUFFER_LVALUE->yy_buf_size = (int) (new_size - 2); - } - - (yy_n_chars) += number_to_move; - YY_CURRENT_BUFFER_LVALUE->yy_ch_buf[(yy_n_chars)] = YY_END_OF_BUFFER_CHAR; - YY_CURRENT_BUFFER_LVALUE->yy_ch_buf[(yy_n_chars) + 1] = YY_END_OF_BUFFER_CHAR; - - (yytext_ptr) = &YY_CURRENT_BUFFER_LVALUE->yy_ch_buf[0]; - - return ret_val; -} - -/* yy_get_previous_state - get the state just before the EOB char was reached */ - - static yy_state_type yy_get_previous_state (void) -{ - yy_state_type yy_current_state; - char *yy_cp; - - yy_current_state = (yy_start); - yy_current_state += YY_AT_BOL(); - - for ( yy_cp = (yytext_ptr) + YY_MORE_ADJ; yy_cp < (yy_c_buf_p); ++yy_cp ) - { - YY_CHAR yy_c = (*yy_cp ? yy_ec[YY_SC_TO_UI(*yy_cp)] : 1); - if ( yy_accept[yy_current_state] ) - { - (yy_last_accepting_state) = yy_current_state; - (yy_last_accepting_cpos) = yy_cp; - } - while ( yy_chk[yy_base[yy_current_state] + yy_c] != yy_current_state ) - { - yy_current_state = (int) yy_def[yy_current_state]; - if ( yy_current_state >= 900 ) - yy_c = yy_meta[yy_c]; - } - yy_current_state = yy_nxt[yy_base[yy_current_state] + yy_c]; - } - - return yy_current_state; -} - -/* yy_try_NUL_trans - try to make a transition on the NUL character - * - * synopsis - * next_state = yy_try_NUL_trans( current_state ); - */ - static yy_state_type yy_try_NUL_trans (yy_state_type yy_current_state ) -{ - int yy_is_jam; - char *yy_cp = (yy_c_buf_p); - - YY_CHAR yy_c = 1; - if ( yy_accept[yy_current_state] ) - { - (yy_last_accepting_state) = yy_current_state; - (yy_last_accepting_cpos) = yy_cp; - } - while ( yy_chk[yy_base[yy_current_state] + yy_c] != yy_current_state ) - { - yy_current_state = (int) yy_def[yy_current_state]; - if ( yy_current_state >= 900 ) - yy_c = yy_meta[yy_c]; - } - yy_current_state = yy_nxt[yy_base[yy_current_state] + yy_c]; - yy_is_jam = (yy_current_state == 899); - - return yy_is_jam ? 0 : yy_current_state; -} - -#ifndef YY_NO_UNPUT - - static void yyunput (int c, char * yy_bp ) -{ - char *yy_cp; - - yy_cp = (yy_c_buf_p); - - /* undo effects of setting up yytext */ - *yy_cp = (yy_hold_char); - - if ( yy_cp < YY_CURRENT_BUFFER_LVALUE->yy_ch_buf + 2 ) - { /* need to shift things up to make room */ - /* +2 for EOB chars. */ - int number_to_move = (yy_n_chars) + 2; - char *dest = &YY_CURRENT_BUFFER_LVALUE->yy_ch_buf[ - YY_CURRENT_BUFFER_LVALUE->yy_buf_size + 2]; - char *source = - &YY_CURRENT_BUFFER_LVALUE->yy_ch_buf[number_to_move]; - - while ( source > YY_CURRENT_BUFFER_LVALUE->yy_ch_buf ) - *--dest = *--source; - - yy_cp += (int) (dest - source); - yy_bp += (int) (dest - source); - YY_CURRENT_BUFFER_LVALUE->yy_n_chars = - (yy_n_chars) = (int) YY_CURRENT_BUFFER_LVALUE->yy_buf_size; - - if ( yy_cp < YY_CURRENT_BUFFER_LVALUE->yy_ch_buf + 2 ) - YY_FATAL_ERROR( "flex scanner push-back overflow" ); - } - - *--yy_cp = (char) c; - - (yytext_ptr) = yy_bp; - (yy_hold_char) = *yy_cp; - (yy_c_buf_p) = yy_cp; -} - -#endif - -#ifndef YY_NO_INPUT -#ifdef __cplusplus - static int yyinput (void) -#else - static int input (void) -#endif - -{ - int c; - - *(yy_c_buf_p) = (yy_hold_char); - - if ( *(yy_c_buf_p) == YY_END_OF_BUFFER_CHAR ) - { - /* yy_c_buf_p now points to the character we want to return. - * If this occurs *before* the EOB characters, then it's a - * valid NUL; if not, then we've hit the end of the buffer. - */ - if ( (yy_c_buf_p) < &YY_CURRENT_BUFFER_LVALUE->yy_ch_buf[(yy_n_chars)] ) - /* This was really a NUL. */ - *(yy_c_buf_p) = '\0'; - - else - { /* need more input */ - int offset = (int) ((yy_c_buf_p) - (yytext_ptr)); - ++(yy_c_buf_p); - - switch ( yy_get_next_buffer( ) ) - { - case EOB_ACT_LAST_MATCH: - /* This happens because yy_g_n_b() - * sees that we've accumulated a - * token and flags that we need to - * try matching the token before - * proceeding. But for input(), - * there's no matching to consider. - * So convert the EOB_ACT_LAST_MATCH - * to EOB_ACT_END_OF_FILE. - */ - - /* Reset buffer status. */ - yyrestart( yyin ); - - /*FALLTHROUGH*/ - - case EOB_ACT_END_OF_FILE: - { - if ( yywrap( ) ) - return 0; - - if ( ! (yy_did_buffer_switch_on_eof) ) - YY_NEW_FILE; -#ifdef __cplusplus - return yyinput(); -#else - return input(); -#endif - } - - case EOB_ACT_CONTINUE_SCAN: - (yy_c_buf_p) = (yytext_ptr) + offset; - break; - } - } - } - - c = *(unsigned char *) (yy_c_buf_p); /* cast for 8-bit char's */ - *(yy_c_buf_p) = '\0'; /* preserve yytext */ - (yy_hold_char) = *++(yy_c_buf_p); - - YY_CURRENT_BUFFER_LVALUE->yy_at_bol = (c == '\n'); - - return c; -} -#endif /* ifndef YY_NO_INPUT */ - -/** Immediately switch to a different input stream. - * @param input_file A readable stream. - * - * @note This function does not reset the start condition to @c INITIAL . - */ - void yyrestart (FILE * input_file ) -{ - - if ( ! YY_CURRENT_BUFFER ){ - yyensure_buffer_stack (); - YY_CURRENT_BUFFER_LVALUE = - yy_create_buffer( yyin, YY_BUF_SIZE ); - } - - yy_init_buffer( YY_CURRENT_BUFFER, input_file ); - yy_load_buffer_state( ); -} - -/** Switch to a different input buffer. - * @param new_buffer The new input buffer. - * - */ - void yy_switch_to_buffer (YY_BUFFER_STATE new_buffer ) -{ - - /* TODO. We should be able to replace this entire function body - * with - * yypop_buffer_state(); - * yypush_buffer_state(new_buffer); - */ - yyensure_buffer_stack (); - if ( YY_CURRENT_BUFFER == new_buffer ) - return; - - if ( YY_CURRENT_BUFFER ) - { - /* Flush out information for old buffer. */ - *(yy_c_buf_p) = (yy_hold_char); - YY_CURRENT_BUFFER_LVALUE->yy_buf_pos = (yy_c_buf_p); - YY_CURRENT_BUFFER_LVALUE->yy_n_chars = (yy_n_chars); - } - - YY_CURRENT_BUFFER_LVALUE = new_buffer; - yy_load_buffer_state( ); - - /* We don't actually know whether we did this switch during - * EOF (yywrap()) processing, but the only time this flag - * is looked at is after yywrap() is called, so it's safe - * to go ahead and always set it. - */ - (yy_did_buffer_switch_on_eof) = 1; -} - -static void yy_load_buffer_state (void) -{ - (yy_n_chars) = YY_CURRENT_BUFFER_LVALUE->yy_n_chars; - (yytext_ptr) = (yy_c_buf_p) = YY_CURRENT_BUFFER_LVALUE->yy_buf_pos; - yyin = YY_CURRENT_BUFFER_LVALUE->yy_input_file; - (yy_hold_char) = *(yy_c_buf_p); -} - -/** Allocate and initialize an input buffer state. - * @param file A readable stream. - * @param size The character buffer size in bytes. When in doubt, use @c YY_BUF_SIZE. - * - * @return the allocated buffer state. - */ - YY_BUFFER_STATE yy_create_buffer (FILE * file, int size ) -{ - YY_BUFFER_STATE b; - - b = (YY_BUFFER_STATE) yyalloc( sizeof( struct yy_buffer_state ) ); - if ( ! b ) - YY_FATAL_ERROR( "out of dynamic memory in yy_create_buffer()" ); - - b->yy_buf_size = size; - - /* yy_ch_buf has to be 2 characters longer than the size given because - * we need to put in 2 end-of-buffer characters. - */ - b->yy_ch_buf = (char *) yyalloc( (yy_size_t) (b->yy_buf_size + 2) ); - if ( ! b->yy_ch_buf ) - YY_FATAL_ERROR( "out of dynamic memory in yy_create_buffer()" ); - - b->yy_is_our_buffer = 1; - - yy_init_buffer( b, file ); - - return b; -} - -/** Destroy the buffer. - * @param b a buffer created with yy_create_buffer() - * - */ - void yy_delete_buffer (YY_BUFFER_STATE b ) -{ - - if ( ! b ) - return; - - if ( b == YY_CURRENT_BUFFER ) /* Not sure if we should pop here. */ - YY_CURRENT_BUFFER_LVALUE = (YY_BUFFER_STATE) 0; - - if ( b->yy_is_our_buffer ) - yyfree( (void *) b->yy_ch_buf ); - - yyfree( (void *) b ); -} - -/* Initializes or reinitializes a buffer. - * This function is sometimes called more than once on the same buffer, - * such as during a yyrestart() or at EOF. - */ - static void yy_init_buffer (YY_BUFFER_STATE b, FILE * file ) - -{ - int oerrno = errno; - - yy_flush_buffer( b ); - - b->yy_input_file = file; - b->yy_fill_buffer = 1; - - /* If b is the current buffer, then yy_init_buffer was _probably_ - * called from yyrestart() or through yy_get_next_buffer. - * In that case, we don't want to reset the lineno or column. - */ - if (b != YY_CURRENT_BUFFER){ - b->yy_bs_lineno = 1; - b->yy_bs_column = 0; - } - - b->yy_is_interactive = 0; - - errno = oerrno; -} - -/** Discard all buffered characters. On the next scan, YY_INPUT will be called. - * @param b the buffer state to be flushed, usually @c YY_CURRENT_BUFFER. - * - */ - void yy_flush_buffer (YY_BUFFER_STATE b ) -{ - if ( ! b ) - return; - - b->yy_n_chars = 0; - - /* We always need two end-of-buffer characters. The first causes - * a transition to the end-of-buffer state. The second causes - * a jam in that state. - */ - b->yy_ch_buf[0] = YY_END_OF_BUFFER_CHAR; - b->yy_ch_buf[1] = YY_END_OF_BUFFER_CHAR; - - b->yy_buf_pos = &b->yy_ch_buf[0]; - - b->yy_at_bol = 1; - b->yy_buffer_status = YY_BUFFER_NEW; - - if ( b == YY_CURRENT_BUFFER ) - yy_load_buffer_state( ); -} - -/** Pushes the new state onto the stack. The new state becomes - * the current state. This function will allocate the stack - * if necessary. - * @param new_buffer The new state. - * - */ -void yypush_buffer_state (YY_BUFFER_STATE new_buffer ) -{ - if (new_buffer == NULL) - return; - - yyensure_buffer_stack(); - - /* This block is copied from yy_switch_to_buffer. */ - if ( YY_CURRENT_BUFFER ) - { - /* Flush out information for old buffer. */ - *(yy_c_buf_p) = (yy_hold_char); - YY_CURRENT_BUFFER_LVALUE->yy_buf_pos = (yy_c_buf_p); - YY_CURRENT_BUFFER_LVALUE->yy_n_chars = (yy_n_chars); - } - - /* Only push if top exists. Otherwise, replace top. */ - if (YY_CURRENT_BUFFER) - (yy_buffer_stack_top)++; - YY_CURRENT_BUFFER_LVALUE = new_buffer; - - /* copied from yy_switch_to_buffer. */ - yy_load_buffer_state( ); - (yy_did_buffer_switch_on_eof) = 1; -} - -/** Removes and deletes the top of the stack, if present. - * The next element becomes the new top. - * - */ -void yypop_buffer_state (void) -{ - if (!YY_CURRENT_BUFFER) - return; - - yy_delete_buffer(YY_CURRENT_BUFFER ); - YY_CURRENT_BUFFER_LVALUE = NULL; - if ((yy_buffer_stack_top) > 0) - --(yy_buffer_stack_top); - - if (YY_CURRENT_BUFFER) { - yy_load_buffer_state( ); - (yy_did_buffer_switch_on_eof) = 1; - } -} - -/* Allocates the stack if it does not exist. - * Guarantees space for at least one push. - */ -static void yyensure_buffer_stack (void) -{ - yy_size_t num_to_alloc; - - if (!(yy_buffer_stack)) { - - /* First allocation is just for 2 elements, since we don't know if this - * scanner will even need a stack. We use 2 instead of 1 to avoid an - * immediate realloc on the next call. - */ - num_to_alloc = 1; /* After all that talk, this was set to 1 anyways... */ - (yy_buffer_stack) = (struct yy_buffer_state**)yyalloc - (num_to_alloc * sizeof(struct yy_buffer_state*) - ); - if ( ! (yy_buffer_stack) ) - YY_FATAL_ERROR( "out of dynamic memory in yyensure_buffer_stack()" ); - - memset((yy_buffer_stack), 0, num_to_alloc * sizeof(struct yy_buffer_state*)); - - (yy_buffer_stack_max) = num_to_alloc; - (yy_buffer_stack_top) = 0; - return; - } - - if ((yy_buffer_stack_top) >= ((yy_buffer_stack_max)) - 1){ - - /* Increase the buffer to prepare for a possible push. */ - yy_size_t grow_size = 8 /* arbitrary grow size */; - - num_to_alloc = (yy_buffer_stack_max) + grow_size; - (yy_buffer_stack) = (struct yy_buffer_state**)yyrealloc - ((yy_buffer_stack), - num_to_alloc * sizeof(struct yy_buffer_state*) - ); - if ( ! (yy_buffer_stack) ) - YY_FATAL_ERROR( "out of dynamic memory in yyensure_buffer_stack()" ); - - /* zero only the new slots.*/ - memset((yy_buffer_stack) + (yy_buffer_stack_max), 0, grow_size * sizeof(struct yy_buffer_state*)); - (yy_buffer_stack_max) = num_to_alloc; - } -} - -#ifndef YY_EXIT_FAILURE -#define YY_EXIT_FAILURE 2 -#endif - -static void yynoreturn yy_fatal_error (const char* msg ) -{ - fprintf( stderr, "%s\n", msg ); - exit( YY_EXIT_FAILURE ); -} - -/* Redefine yyless() so it works in section 3 code. */ - -#undef yyless -#define yyless(n) \ - do \ - { \ - /* Undo effects of setting up yytext. */ \ - int yyless_macro_arg = (n); \ - YY_LESS_LINENO(yyless_macro_arg);\ - yytext[yyleng] = (yy_hold_char); \ - (yy_c_buf_p) = yytext + yyless_macro_arg; \ - (yy_hold_char) = *(yy_c_buf_p); \ - *(yy_c_buf_p) = '\0'; \ - yyleng = yyless_macro_arg; \ - } \ - while ( 0 ) - -/* Accessor methods (get/set functions) to struct members. */ - -/** Get the current token. - * - */ - -static int yy_init_globals (void) -{ - /* Initialization is the same as for the non-reentrant scanner. - * This function is called from yylex_destroy(), so don't allocate here. - */ - - (yy_buffer_stack) = NULL; - (yy_buffer_stack_top) = 0; - (yy_buffer_stack_max) = 0; - (yy_c_buf_p) = NULL; - (yy_init) = 0; - (yy_start) = 0; - -/* Defined in main.c */ -#ifdef YY_STDINIT - yyin = stdin; - yyout = stdout; -#else - yyin = NULL; - yyout = NULL; -#endif - - /* For future reference: Set errno on error, since we are called by - * yylex_init() - */ - return 0; -} - -/* yylex_destroy is for both reentrant and non-reentrant scanners. */ -int yylex_destroy (void) -{ - - /* Pop the buffer stack, destroying each element. */ - while(YY_CURRENT_BUFFER){ - yy_delete_buffer( YY_CURRENT_BUFFER ); - YY_CURRENT_BUFFER_LVALUE = NULL; - yypop_buffer_state(); - } - - /* Destroy the stack itself. */ - yyfree((yy_buffer_stack) ); - (yy_buffer_stack) = NULL; - - /* Reset the globals. This is important in a non-reentrant scanner so the next time - * yylex() is called, initialization will occur. */ - yy_init_globals( ); - - return 0; -} - -/* - * Internal utility routines. - */ - -#ifndef yytext_ptr -static void yy_flex_strncpy (char* s1, const char * s2, int n ) -{ - - int i; - for ( i = 0; i < n; ++i ) - s1[i] = s2[i]; -} -#endif - -#ifdef YY_NEED_STRLEN -static int yy_flex_strlen (const char * s ) -{ - int n; - for ( n = 0; s[n]; ++n ) - ; - - return n; -} -#endif - -void *yyalloc (yy_size_t size ) -{ - return malloc(size); -} - -void *yyrealloc (void * ptr, yy_size_t size ) -{ - - /* The cast to (char *) in the following accommodates both - * implementations that use char* generic pointers, and those - * that use void* generic pointers. It works with the latter - * because both ANSI C and C++ allow castless assignment from - * any pointer type to void*, and deal with argument conversions - * as though doing an assignment. - */ - return realloc(ptr, size); -} - -void yyfree (void * ptr ) -{ - free( (char *) ptr ); /* see yyrealloc() for (char *) cast */ -} - -#define YYTABLES_NAME "yytables" - -#line 1181 "scanner.l" - - -static void -error_literal (const char *type, const char *literal) -{ - char lit_out[39]; - - if (!literal_error) { -#if 0 /* national literal, check for different truncation and wcslen - or not show it at all */ - if (strcmp (type, "national") == 0) { - cb_error (_("invalid national literal"), lit_out); - } else { -#endif - /* snip literal for output, if too long */ - strncpy (lit_out, literal, 38); - if (strlen (literal) > 38) { - strcpy (lit_out + 35, "..."); - } else { - lit_out[38] = '\0'; - } - if (strcmp (type, "") == 0) { - cb_error (_("invalid literal: '%s'"), lit_out); - } else if (strcmp (type, "hex") == 0) { - cb_error (_("invalid hexadecimal literal: '%s'"), lit_out); - } else if (strcmp (type, "num") == 0) { - cb_error (_("invalid numeric literal: '%s'"), lit_out); - } else if (strcmp (type, "float") == 0) { - cb_error (_("invalid floating-point literal: '%s'"), lit_out); - } else { - cb_error (_("invalid %s literal: '%s'"), type, lit_out); - } -#if 0 /* national literal */ - } -#endif - } - literal_error++; - cb_error ("%s", err_msg); -} - -static void -read_literal (const char mark, const char *type) -{ - size_t i; - int c; - - literal_error = 0; - - i = 0; - /* read until a not-escaped mark is found (see break) - or (unlikely) we reach EOF */ - /* NO early exit possible as the literal has to be consumed */ - while ((c = input ()) != EOF) { -#if EOF != 0 - if (unlikely (c == 0)) break; /* fixes unexpected error case */ -#endif - if (!literal_error) { - if (unlikely (i + 1 == plex_size)) { - plex_size *= 2; - if (unlikely (plex_size > (cb_lit_length + 1))) { - plex_size = (size_t)cb_lit_length + 1; - } - plex_buff = cobc_realloc (plex_buff, plex_size); - } - plex_buff[i] = (cob_u8_t)c; - } - if (c == mark && (c = input ()) != (int)mark) { - if (c == '-') { - /* Free format continuation ("a"- 'b'- ) */ - /* Hack it as concatenation */ - unput ('&'); - } else { - if (c == EOF || c == 0) break; - unput (c); - } - break; - } - /* check literal size here as we have to adjust and check - for (escaped) mark before checking the max length */ - if (unlikely (i++ == cb_lit_length)) { - snprintf (err_msg, COB_MINI_MAX, - _("literal length exceeds %d characters"), - cb_lit_length); - plex_buff[cb_lit_length] = 0; /* ensure valid C-string for error message */ - error_literal ("", plex_buff); - } - } - - /* FIXME: Exact behavior should depend on level of support: - * "OK" => standard behavior, e.g. normal items filled with spaces/ - zeros, DYNAMIC LENGTH items made empty - * "warning" => current implementation, interpret '' as SPACE/ZERO - * "ignore" => assume a space without warning; make sure zero length - items work everywhere (should do as we support zero - lengths via ODO items already) - */ - if (!i) { - cb_verify (cb_zero_length_lit, _("zero-length literal")); - cb_warning (COBC_WARN_FILLER, - type[0] == 'N' ? - _("national literal has zero length; a SPACE will be assumed") : - _("alphanumeric literal has zero length; a SPACE will be assumed")); - plex_buff[i++] = ' '; - } else if (i > cb_lit_length) { - i = cb_lit_length; - } - - /* build literal with given size */ - plex_buff[i] = 0; - if (type[0] != 'N') { - yylval = cb_build_alphanumeric_literal (plex_buff, i); - } else { - if (type[1] != 'C') { - if (cb_verify (cb_national_literals, _("national literal"))) { - CB_UNFINISHED (_("national literal")); - } - } else { - if (cb_verify (cb_nationalc_literals, _("national-character literal"))) { - CB_UNFINISHED (_("national literal")); - } - } - yylval = cb_build_national_literal (plex_buff, i); - } -} - -static int -scan_x (const char *text, const char *type) -{ - char *p; - char *e; - char *dst; - size_t curr_len; - size_t result_len; - int c; - - literal_error = 0; - - /* Remark: - The standard allows for 8,191 (normal/national/boolean) character positions */ - - /* curr_len includes the terminating quote - and has to be adjusted according to type */ - - curr_len = strlen (text); - curr_len--; - if (curr_len == 0) { - cb_verify (cb_zero_length_lit, _("zero-length literal")); - plex_buff[0] = '\0'; - plex_buff[1] = '\0'; - cb_warning (COBC_WARN_FILLER, - _("hexadecimal literal has zero length; X'00' will be assumed")); - if (type[0] == 'B') { - yylval = cb_build_numeric_literal (0, "0", 0); - } else if (type[0] == 'N') { - yylval = cb_build_alphanumeric_literal (plex_buff, 1); - } else { - yylval = cb_build_national_literal (plex_buff, 1); - } - RETURN_TOK (LITERAL); - } - - if (unlikely (curr_len + 1 > plex_size)) { - plex_size = curr_len + 1; - plex_buff = cobc_realloc (plex_buff, plex_size); - } - memcpy (plex_buff, text, curr_len); - if (likely(type[0] == 'X')) { - result_len = curr_len / 2; /* characters, two half-bytes (hex) = 1 byte */ - } else if (type[0] == 'B') { - if (!cb_verify (cb_hexadecimal_boolean, _("hexadecimal-boolean literal"))) { - goto error; /* early exit possible as complete literal is consumed */ - } - result_len = curr_len * 4; /* boolean characters B -> 1110 */ - /* GnuCOBOL currently only support 64 bit booleans */ - if (unlikely (result_len > 64)) { - snprintf (err_msg, COB_MINI_MAX, - _("literal length %d exceeds %d characters"), - (int) result_len, 64); - error_literal (type, plex_buff); - goto error; - } - } else { - if (!cb_verify (cb_national_hex_literals, _("hexadecimal-national literal"))) { - goto error; /* early exit possible as complete literal is consumed */ - } - CB_UNFINISHED (_("national literal")); - result_len = curr_len / (2 * COB_NATIONAL_SIZE); /* national characters */ - } - if (unlikely (result_len > cb_lit_length)) { - snprintf (err_msg, COB_MINI_MAX, - _("literal length %d exceeds %d characters"), - (int) result_len, cb_lit_length); - error_literal (type, plex_buff); - goto error; - } - - p = (char *)text; - e = (char *)p + curr_len; - dst = plex_buff; - - if (unlikely(type[0] == 'B')) { - /* hexadecimal-boolean */ - cob_u64_t val = 0; - for (; *p != *e; p++) { - c = (int) *p; - if ('0' <= c && c <= '9') { - val = (val << 4) + ((cob_u64_t)c - '0'); - } else if ('A' <= c && c <= 'F') { - val = (val << 4) + ((cob_u64_t)c - 'A' + 10); - } else if ('a' <= c && c <= 'f') { - val = (val << 4) + ((cob_u64_t)c - 'a' + 10); - } else { - snprintf (err_msg, COB_MINI_MAX, - _("literal contains invalid character '%c'"), c); - if (likely (literal_error == 0)) { - memcpy (plex_buff, text, curr_len + 1); - plex_buff[curr_len] = 0; - } - error_literal (type, plex_buff); - /* By not breaking immediately, we detect any following - invalid chars - */ - continue; - } - } - if (unlikely (literal_error != 0)) { - goto error; - } - sprintf ((char *)plex_buff, CB_FMT_LLU, val); - yylval = cb_build_numeric_literal (0, (const void *)plex_buff, 0); - - } else { - - /* hexadecimal */ - int high = 1; - for (; *p != *e; p++) { - c = (int) *p; - if ('0' <= c && c <= '9') { - c = c - '0'; - } else if ('A' <= c && c <= 'F') { - c = c - 'A' + 10; - } else if ('a' <= c && c <= 'f') { - c = c - 'a' + 10; - } else { - snprintf (err_msg, COB_MINI_MAX, - _("literal contains invalid character '%c'"), c); - if (likely (literal_error == 0)) { - memcpy (plex_buff, text, curr_len + 1); - plex_buff[curr_len] = 0; - } - error_literal (type, plex_buff); - /* By not breaking immediately, we detect any following - invalid chars - */ - continue; - } - if (likely (literal_error == 0)) { - if (high) { - *dst = (cob_u8_t)(c << 4); - } else { - *dst++ += (cob_u8_t)c; - } - } - high = 1 - high; - } - - if (!high) { - /* This is non-standard behaviour */ - snprintf (err_msg, COB_MINI_MAX, - _("literal does not have an even number of digits")); - if (likely (literal_error == 0)) { - memcpy (plex_buff, text, curr_len + 1); - plex_buff[curr_len] = 0; - } - error_literal (type, plex_buff); - } - if (unlikely (literal_error != 0)) { - goto error; - } - if (type[0] != 'N') { - yylval = cb_build_alphanumeric_literal (plex_buff, (size_t)(dst - plex_buff)); - } else { - yylval = cb_build_national_literal (plex_buff, (size_t)(dst - plex_buff)); - } - } - - RETURN_TOK (LITERAL); - -error: - yylval = cb_error_node; - RETURN_TOK (LITERAL); -} - -static int -scan_z (const char *text, const char *type) -{ - size_t currlen; - - literal_error = 0; - - /* currlen includes the terminating quote */ - currlen = strlen (text); - if (unlikely ((currlen - 1) > cb_lit_length)) { - currlen--; - snprintf (err_msg, COB_MINI_MAX, - _("literal length %d exceeds %d characters"), - (int) currlen, cb_lit_length); - error_literal (type, text); - goto error; - } else if (unlikely (currlen == 1)) { - currlen--; - snprintf (err_msg, COB_MINI_MAX, - _("%s literals must contain at least one character"), - type); - error_literal (type, ""); - goto error; - } - if (unlikely (currlen > plex_size)) { - plex_size = currlen; - plex_buff = cobc_realloc (plex_buff, plex_size); - } - memcpy (plex_buff, text, currlen); - plex_buff[currlen - 1] = 0; - - /* Count is correct here as the trailing quote is now a null */ - yylval = cb_build_alphanumeric_literal (plex_buff, currlen); - if (type[0] == 'L') { - CB_LITERAL(yylval)->llit = 1; - } - RETURN_TOK (LITERAL); - - error: - yylval = cb_error_node; - RETURN_TOK (LITERAL); -} - -static int -scan_h (const char *text, const char *type) -{ - size_t currlen; - char *p; - cob_u64_t val = 0; - int c; - - literal_error = 0; - - if (type[1] == '#' && - !cb_verify (cb_acu_literals, _("ACUCOBOL numeric literal"))) { - goto error; /* early exit possible as complete literal is consumed */ - } - - /* currlen can include the terminating quote */ - currlen = strlen (text); - memcpy (plex_buff, text, currlen + 1); - if (type[1] != '#') { - currlen--; - if (currlen == 0) { - cb_error (_("H literals must contain at least one character")); - goto error; - } - plex_buff[currlen] = 0; - } - if (unlikely (currlen > 16)) { - snprintf (err_msg, COB_MINI_MAX, - _("literal length %d exceeds %d characters"), - (int) currlen, 16); - error_literal ("hex", plex_buff); - goto error; - } - - for (p = plex_buff; *p != 0; p++) { - c = (int) *p; - if ('0' <= c && c <= '9') { - c = c - '0'; - } else if ('A' <= c && c <= 'F') { - c = c - 'A' + 10; - } else if ('a' <= c && c <= 'f') { - c = c - 'a' + 10; - } else { - snprintf (err_msg, COB_MINI_MAX, - _("literal contains invalid character '%c'"), c); - error_literal (type, plex_buff); - /* By not breaking immediately, we detect any following - invalid chars - */ - continue; - } - - val = (val << 4) + c; - } - - if (type[1] == '#') { - /* limit for ACUCOBOL literals: UINT_MAX */ - if (val > UINT_MAX) { - snprintf (err_msg, COB_MINI_MAX, - _("literal exceeds limit %u"), UINT_MAX); - error_literal (type, plex_buff); - } - } - - if (literal_error) { - goto error; - } - - /* Duplication? */ - sprintf ((char *)plex_buff, CB_FMT_LLU, val); - yylval = cb_build_numeric_literal (0, (const void *)plex_buff, 0); - - RETURN_TOK (LITERAL); - -error: - yylval = cb_error_node; - RETURN_TOK (LITERAL); -} - -static int -scan_b (const char *text, const char *type) -{ - /* FIXME: COBOL 2014 allows up to 8,192 boolean characters - COBOL 2002 allows up to 160 boolean characters - --> both identical to "literal-length" maximum - GnuCOBOL currently only supports 64 boolean characters, - check if it works to concatenate after 64 characters, similar to read_literal() - */ - - size_t currlen; - char *p; - cob_u64_t val = 0; - int c; - - literal_error = 0; - - /* currlen can include the terminating quote */ - currlen = strlen (text); - - if (type[1] == 0) { - if (!cb_verify (cb_numeric_boolean, _("numeric boolean literal"))) { - goto error; /* early exit possible as complete literal is consumed */ - } - if (currlen == 1) { - cb_verify (cb_zero_length_lit, _("zero-length literal")); - cb_warning (COBC_WARN_FILLER, - _("Boolean literal has zero length; B'0' will be assumed")); - /* FIXME: we should really build a boolean literal... */ - yylval = cb_build_numeric_literal (0, "0", 0); - RETURN_TOK (LITERAL); - } - } else { - if (!cb_verify (cb_acu_literals, _("ACUCOBOL numeric literal"))) { - goto error; /* early exit possible as complete literal is consumed */ - } - }; - if (unlikely (currlen >= plex_size)) { - currlen = plex_size - 1; - } - memcpy (plex_buff, text, currlen + 1); - if (type[1] == 0) { - currlen--; - } - plex_buff[currlen] = 0; - if (unlikely (currlen > 64)) { - snprintf (err_msg, COB_MINI_MAX, - _("literal length %d exceeds %d characters"), - (int) currlen, 64); - error_literal (type, plex_buff); - goto error; - } - - for (p = plex_buff; *p != 0; p++) { - c = (int) *p; - if (c == '0') { - c = 0; - } else if (c == '1') { - c = 1; - } else { - snprintf (err_msg, COB_MINI_MAX, - _("literal contains invalid character '%c'"), c); - error_literal (type, plex_buff); - continue; - } - - val = (val << 1) + c; - } - if (type[1] == '#') { - /* limit for ACUCOBOL literals: UINT_MAX */ - if (val > UINT_MAX) { - snprintf (err_msg, COB_MINI_MAX, - _("literal exceeds limit %u"), UINT_MAX); - error_literal (type, plex_buff); - } - } - - if (literal_error) { - goto error; - } - - sprintf ((char *)plex_buff, CB_FMT_LLU, val); - /* FIXME: we should likely build a boolean literal ... */ - yylval = cb_build_numeric_literal (0, (const void *)plex_buff, 0); - - RETURN_TOK (LITERAL); - - error: - yylval = cb_error_node; - RETURN_TOK (LITERAL); -} - -static int -scan_o (const char *text, const char *type) -{ - size_t currlen; - char *p; - cob_u64_t val = 0; - int c; - - literal_error = 0; - - if (type[0] == '%') { - if (!cb_verify (cb_hp_octal_literals, _("HP COBOL octal literal"))) { - goto error; /* early exit possible as complete literal is consumed */ - } - } else { - if (!cb_verify (cb_acu_literals, _("ACUCOBOL numeric literal"))) { - goto error; /* early exit possible as complete literal is consumed */ - } - } - - currlen = strlen (text); - memcpy (plex_buff, text, currlen + 1); - if (unlikely (currlen > 22)) { - snprintf (err_msg, COB_MINI_MAX, - _("literal length %d exceeds %d characters"), - (int) currlen, 22); - error_literal (type, plex_buff); - goto error; - } - - for (p = plex_buff; *p != 0; p++) { - c = (int) *p; - if (!('0' <= c && c <= '7')) { - snprintf (err_msg, COB_MINI_MAX, - _("literal contains invalid character '%c'"), c); - error_literal (type, plex_buff); - continue; - } - - c = c - '0'; - val = (val << 3) + c; - } - /* limit for ACUCOBOL literals: UINT_MAX */ - if (val > UINT_MAX) { - snprintf (err_msg, COB_MINI_MAX, - _("literal exceeds limit %u"), UINT_MAX); - error_literal (type, plex_buff); - } - - if (literal_error) { - goto error; - } - - if (type[0] == '%') { - /* actually the rules specify that the literal type is context-sensitive - and for alphanumeric right-filled with NULL, therefore we'd need - a special type of literal here */ - CB_UNFINISHED ("HP COBOL octal literals"); -#if 0 /* activate to have all %literals to be alphanumeric */ - char xbuff[19]; - sprintf ((char *)&xbuff, "'%X'", (unsigned int)val); - cobc_force_literal = 0; - RETURN_TOK (scan_x ((const char *)&xbuff + 1, "X")); -#endif - } - - sprintf ((char *)plex_buff, CB_FMT_LLU, val); - yylval = cb_build_numeric_literal (0, (const void *)plex_buff, 0); - - RETURN_TOK (LITERAL); - - error: - yylval = cb_error_node; - RETURN_TOK (LITERAL); -} - -static int -get_sign (const char sign) -{ - if (sign == '+') { - return 1; - } else if (sign == '-') { - return -1; - } else { - return 0; - } -} - -#define INCREMENT_IF_SIGNED(text, sign) \ - do { \ - if (sign) { \ - (text)++; \ - } \ - } ONCE_COB - -static int -scan_numeric (const char *text) -{ - char *p = (char *)text; - char *s; - int sign; - int scale; - - /* Get sign */ - sign = get_sign (*p); - INCREMENT_IF_SIGNED (p, sign); - - /* Get decimal point */ - s = strchr (p, current_program->decimal_point); - if (s) { - scale = (int)strlen (s) - 1; - /* Remove decimal point */ - /* Moves trailing null */ - memmove (s, s + 1, (size_t)scale + 1); - } else { - scale = 0; - } - - /* Note that leading zeroes are not removed from the literal. */ - - if (unlikely (strlen (p) > COB_MAX_DIGITS)) { - /* Absolute limit */ - snprintf (err_msg, COB_MINI_MAX, - _("literal length %d exceeds maximum of %d digits"), - (int) strlen (p), COB_MAX_DIGITS); - error_literal ("num", text); - yylval = cb_error_node; - } else if (unlikely (strlen (p) > cb_numlit_length)) { - snprintf (err_msg, COB_MINI_MAX, - _("literal length %d exceeds %d digits"), - (int) strlen (p), cb_numlit_length); - error_literal ("num", text); - yylval = cb_error_node; - } else { - yylval = cb_build_numeric_literal (sign, p, scale); - } - RETURN_TOK (LITERAL); -} - -static int -all_zeroes (const char *str) -{ - int i; - - for (i = 0; str[i] != '\0'; ++i) { - if (str[i] != '0') { - return 0; - } - } - - return 1; -} - -static int -significand_is_zero (const char *int_part, const char *dec_part) -{ - return all_zeroes (int_part) - && all_zeroes (dec_part); -} - -/* Note: Exponent *digits* in literals according to COBOL 202x: 36 */ -/* Note: Exponent *digits* in literals according to COBOL 202x: 36 */ -#if COB_FLOAT_DIGITS_MAX != 36 -#error COB_FLOAT_DIGITS_MAX adjustment needed, common.h must match scanner.l -#endif -#define COB_FLOAT_DIGITS_CHCK_MAX 38 /* incl. sign and comma */ -#define COB_FLOAT_DIGITS_STR_WIDTH 39 -#define COB_FLOAT_DIGITS_STR_MAX 40 - -#define COB_FLOAT_DIGITS_WIDTH "%" CB_XSTRINGIFY(COB_FLOAT_DIGITS_STR_WIDTH) - -static int -scan_floating_numeric (const char *text) -{ - size_t sig_int_len; - size_t sig_dec_len; - int sig_sign; - int exp_sign; - int scale; - int exponent; - int n; - char significand_str[COB_FLOAT_DIGITS_STR_MAX] = { '\0' }; - char *significand_pos; - char significand_dec[COB_FLOAT_DIGITS_STR_MAX] = { '\0' }; - char significand_int[COB_FLOAT_DIGITS_STR_MAX] = { '\0' }; - char exponent_str[8] = { '\0' }; - char *exponent_pos; - - char result[128] = { '\0' }; - - literal_error = 0; - - /* Separate into significand and exponent */ - n = sscanf (text, COB_FLOAT_DIGITS_WIDTH "[0-9.,+-]%*1[Ee]%7[0-9.,+-]", - significand_str, exponent_str); - /* We check the return for silencing warnings, but - this should actually never happen as the flex rule ensures this */ - /* LCOV_EXCL_START */ - if (n == 0) { -#if 1 - /* This should never happen (and therefore doesn't get a translation) */ - cb_error ("flex rule for scan_floating_numeric is wrong"); - COBC_ABORT(); -#else - yylval = cb_error_node; - RETURN_TOK (LITERAL); -#endif - } - /* LCOV_EXCL_STOP */ - - /* Get signs and adjust string positions accordingly */ - significand_pos = &significand_str[0]; - sig_sign = get_sign (*significand_pos); - INCREMENT_IF_SIGNED (significand_pos, sig_sign); - - exponent_pos = &exponent_str[0]; - exp_sign = get_sign (*exponent_pos); - INCREMENT_IF_SIGNED (exponent_pos, exp_sign); - - /* Separate significand into integer and decimal */ - n = sscanf (significand_pos, - COB_FLOAT_DIGITS_WIDTH "[0-9]%*1[.,]" COB_FLOAT_DIGITS_WIDTH "[0-9]", - significand_int, significand_dec); - if (n == 0) { /* no integer part, copy after decimal-point */ - significand_int[0] = 0; - strncpy (significand_dec, significand_pos + 1, COB_FLOAT_DIGITS_STR_MAX); - significand_dec[COB_FLOAT_DIGITS_STR_MAX - 1] = 0; - } else { - /* silencing some warnings */ - significand_int[COB_FLOAT_DIGITS_STR_MAX - 1] = 0; - significand_dec[COB_FLOAT_DIGITS_STR_MAX - 1] = 0; - } - - /* Validation and exponent handling */ - sig_int_len = strlen (significand_int); - sig_dec_len = strlen (significand_dec); - exponent = 0; - - if (sig_int_len + sig_dec_len > COB_FLOAT_DIGITS_MAX) { - /* note: same message in tree.c for floating-point numeric-edited item */ - snprintf (err_msg, COB_MINI_MAX, - _("significand has more than %d digits"), COB_FLOAT_DIGITS_MAX); - error_literal ("float", text); - } else { - if (strchr (exponent_pos, current_program->decimal_point)) { - snprintf (err_msg, COB_MINI_MAX, - _("exponent has decimal point")); - error_literal ("float", text); - } else { - if (strlen (exponent_pos) > 4) { - /* note: same message in tree.c for floating-point numeric-edited item */ - snprintf (err_msg, COB_MINI_MAX, - _("exponent has more than 4 digits")); - error_literal ("float", text); - } else { - n = sscanf (exponent_pos, "%d", &exponent); - /* We check the return for silencing warnings, but - this should actually never happen as the flex rule ensures this */ - /* LCOV_EXCL_START */ - if (n == 0) { -#if 1 - /* This should never happen (and therefore doesn't get a translation) */ - cb_error ("flex rule for scan_floating_numeric is wrong"); - COBC_ABORT(); -#else - yylval = cb_error_node; - RETURN_TOK (LITERAL); -#endif - } - /* LCOV_EXCL_STOP */ - } - - if (exp_sign == -1) { - exponent = -exponent; - } - - /* "The maximum permitted value and minimum permitted value of - the exponent is implementor-defined" */ - /* Exponent range -383 thru +384 for FLOAT-DECIMAL-16 */ - /* Exponent range -6143 thru +6144 for FLOAT-DECIMAL-34 */ - if (!(-6143 <= exponent && exponent <= 6144)) { - snprintf (err_msg, COB_MINI_MAX, - _("exponent not between -6143 and 6144")); - error_literal ("float", text); - } - } - } - - if (significand_is_zero (significand_int, significand_dec)) { - if (sig_sign == -1) { - snprintf (err_msg, COB_MINI_MAX, - _("significand of 0 must be positive")); - error_literal ("float", text); - } - if (exponent != 0) { - snprintf (err_msg, COB_MINI_MAX, - _("exponent of 0 must be 0")); - error_literal ("float", text); - } - if (exp_sign == -1) { - snprintf (err_msg, COB_MINI_MAX, - _("exponent of 0 must be positive")); - error_literal ("float", text); - } - } - - if (literal_error) { - yylval = cb_error_node; - RETURN_TOK (LITERAL); - } - - /* Literal data */ - strcpy (result, significand_int); - strcat (result, significand_dec); - - /* Determine scale */ - /* Base scale is decimal part of the significant */ - scale = (int)sig_dec_len; - if (exponent < 0) { - /* Decimals; power down by scale difference */ - scale = - (exponent - scale); - } else if (exponent > 0) { - /* No decimals; power up by scale difference */ - if (exponent >= scale) { - scale = - (exponent - scale); - } else { - scale -= exponent; - } - } - - yylval = cb_build_numeric_literal (sig_sign, result, - scale); - RETURN_TOK (LITERAL); -} - -static void -scan_picture (const char *text) -{ - unsigned char *p; - - /* Scan a PICTURE clause */ - /* Normalize the input */ - for (p = (unsigned char *)text; *p; p++) { - /* unput trailing '.' or ',' */ - if (p[1] == 0 && (*p == '.' || *p == ',')) { - unput (*p); - *p = 0; - break; - } - *p = (unsigned char)toupper (*p); - } - - yylval = cb_build_picture (text); -} - -static void -count_lines (const char *text) -{ - const char *p; - - /* Count newlines in text */ - for (p = text; *p; p++) { - if (*p == '\n') { - cb_source_line++; - } - } -} - -static void -cb_add_const_var (const char *name, cb_tree value) -{ - cb_tree x; - struct cb_level_78 *p78; - struct cb_field *f; - - /* Add an inline constant */ - x = cb_build_constant (cb_build_reference (name), value); - f = CB_FIELD (x); - f->flag_item_78 = 1; - f->flag_is_global = 1; - f->flag_internal_constant = 1; - f->level = 1; - (void)cb_validate_78_item (f, 1); - - /* Add constant item */ - p78 = cobc_malloc (sizeof(struct cb_level_78)); - p78->fld_78 = f; - p78->prog = NULL; - p78->name_len = (cob_u32_t)strlen (f->name); - /* RXWRXW - Check this */ - p78->chk_const = 0; - if (!const_78_ptr) { - p78->last = p78; - } else { - p78->last = const_78_ptr->last; - } - p78->next = const_78_ptr; - p78->glob_next = const_78_ptr; - const_78_ptr = p78; - if (glob_lev_78_ptr) { - glob_lev_78_ptr->last->glob_next = const_78_ptr; - } else if (lev_78_ptr) { - lev_78_ptr->last->glob_next = const_78_ptr; - } else { - top_78_ptr = const_78_ptr; - } -} - - -/* duplicate the given literal to assign a different source location */ -static void * -copy_literal (cb_tree l) -{ - cb_tree x; - - /* LCOV_EXCL_START */ - if (!CB_LITERAL_P(l)) { - cobc_err_msg (_("unexpected tree tag: %d"), (int)CB_TREE_TAG (l)); - COBC_ABORT (); - } - /* LCOV_EXCL_STOP */ - - x = cobc_parse_malloc (sizeof (struct cb_literal)); - memcpy (x, l, sizeof (struct cb_literal)); - - return x; -} - -static void -scan_define_options (const char *text) -{ - char *p; - char *s; - char *var; - const struct cb_level_78 *p78; - char *q; - unsigned char *t; - cb_tree x; - size_t size; - int scale; - int sign, override; - - /* Scan a source inline define */ - p = cobc_strdup (text); - - q = &p[strlen(p)-1]; - while(q != p - && (isspace(*q) || *q == '\n' || *q == '\r')) - q--; - q = q - 7; - if (memcmp(q,"OVERRIDE",8) == 0) { - override = 1; - while (q[-1] == ' ') q--; - strcpy(q,"\n"); - } else { - override = 0; - } - - /* Ignore first part */ - s = strtok (p, " "); - - /* Variable name */ - s = strtok (NULL, " \n"); - if (!s) { - cobc_free (p); - return; - } - - /* Check for already defined constant */ - if (!override) { - for (p78 = top_78_ptr; p78; p78 = p78->glob_next) { - if (strcasecmp (s, p78->fld_78->name) == 0) { - cobc_free (p); - return; - } - } - } - - var = cobc_strdup (s); - - /* Value */ - s = strtok (NULL, "\n"); - if (!s) { - cb_error (_("invalid CONSTANT: %s"), var); - goto freevar; - } - - if (*s == '"' || *s == '\'') { - /* Alphanumeric literal */ - sign = *s; - size = strlen (s); - q = s + size - 1; - if (q == s || *q != sign) { - cb_error (_("invalid alphanumeric CONSTANT: %s"), s); - goto freevar; - } - if (size < 3) { - cb_error (_("empty alphanumeric CONSTANT: %s"), s); - goto freevar; - } - *q = 0; - size -= 2; - x = cb_build_alphanumeric_literal (s + 1, size); - } else { - /* Get sign */ - sign = get_sign (*s); - INCREMENT_IF_SIGNED (s, sign); - - /* Get decimal point */ - scale = 0; - q = strchr (s, '.'); - if (q) { - scale = (int)strlen (q) - 1; - if (scale < 1) { - cb_error (_("invalid numeric CONSTANT: %s"), s); - goto freevar; - } - /* Remove decimal point */ - memmove (q, q + 1, (size_t)scale + 1); - } - for (t = (unsigned char *)s; *t; ++t) { - if (*t < '0' || *t > '9') { - cb_error (_("invalid numeric CONSTANT: %s"), s); - goto freevar; - } - } - if (strlen (s) > COB_MAX_DIGITS) { - cb_error (_("invalid numeric CONSTANT: %s"), s); - goto freevar; - } - - x = cb_build_numeric_literal (sign, s, scale); - } - /* Add to constant list */ - cb_add_const_var (var, x); - -freevar: - cobc_free (p); - cobc_free (var); -} - -#undef INCREMENT_IF_SIGNED - -/* - For yytext of the form '#directive "a-word"' or '#directive - (a-word)', copy a-word into word. -*/ -static void -copy_word_in_quotes (char ** const word) -{ - char *text = cobc_strdup (yytext); - char *word_str; - - /* Skip directive */ - word_str = strtok (text, " "); - - /* Get word and remove quotes */ - word_str = strtok (NULL, "\n"); - *word = cobc_malloc (strlen (word_str) - 1); - strncpy (*word, word_str + 1, strlen (word_str) - 2); - - cobc_free (text); -} - -/* - For yytext of the form '#directive "first-word" "second-word"' or '#directive - (first-word) (second-word)', allocate copies of first-word for word1 and - second-word for word2. -*/ -static void -copy_two_words_in_quotes (char ** const word1, char ** const word2) -{ - char *text = cobc_strdup (yytext); - char *word1_str; - char *word2_str; - - /* Skip directive. */ - word1_str = strtok (text, " "); - - /* Get words and remove surrounding quotes. */ - - word1_str = strtok (NULL, " "); - *word1 = cobc_malloc (strlen (word1_str) - 1); - strncpy (*word1, word1_str + 1, strlen (word1_str) - 2); - - word2_str = strtok (NULL, "\n"); - *word2 = cobc_malloc (strlen (word2_str) - 1); - strncpy (*word2, word2_str + 1, strlen (word2_str) - 2); - - cobc_free (text); -} - -static void -add_synonym (const int synonym_replaces_original) -{ - char *word; - char *synonym; - - copy_two_words_in_quotes (&word, &synonym); - - if (!is_default_reserved_word (word)) { - cb_error (_("'%s' is not a default reserved word, so cannot be aliased"), - word); - } else if (is_reserved_word (synonym)) { - cb_error (_("'%s' is already reserved; you may want MAKESYN instead"), - synonym); - } else { - if (synonym_replaces_original) { - remove_reserved_word_now (word); - } - add_reserved_word_now (synonym, word); - } - - cobc_free (word); - cobc_free (synonym); -} - -/* Global functions */ - -void -ylex_clear_all (void) -{ - /* Clear buffers after parsing all source elements */ - if (pic_buff2) { - cobc_free (pic_buff2); - pic_buff2 = NULL; - } - if (pic_buff1) { - cobc_free (pic_buff1); - pic_buff1 = NULL; - } - if (plex_buff) { - cobc_free (plex_buff); - plex_buff = NULL; - } - plex_size = 0; - pic1_size = 0; - pic2_size = 0; - - cb_reset_78 (); - cb_reset_global_78 (); -} - -void -ylex_call_destroy (void) -{ - /* Release flex buffers */ - (void)yylex_destroy (); - const_78_ptr = NULL; -} - -void -cb_unput_dot (void) -{ - unput ('.'); -} - -void -cb_reset_78 (void) -{ - struct cb_level_78 *p78; - struct cb_level_78 *p782; - - /* Remove constant (78 level) items for current program */ - for (p78 = lev_78_ptr; p78; ) { - p782 = p78->next; - cobc_free (p78); - p78 = p782; - } - lev_78_ptr = NULL; - for (p78 = glob_lev_78_ptr; p78; p78 = p78->next) { - p78->not_const = 0; - } - if (glob_lev_78_ptr) { - top_78_ptr = glob_lev_78_ptr; - } else { - top_78_ptr = const_78_ptr; - } -} - -void -cb_reset_global_78 (void) -{ - struct cb_level_78 *p78; - struct cb_level_78 *p782; - - /* Remove constant (78 level) items for top program */ - for (p78 = glob_lev_78_ptr; p78; ) { - p782 = p78->next; - cobc_free (p78); - p78 = p782; - } - glob_lev_78_ptr = NULL; - top_78_ptr = const_78_ptr; -} - -void -cb_add_78 (struct cb_field *f) -{ - struct cb_level_78 *p78; - - /* Add a constant (78 level) item */ - p78 = cobc_malloc (sizeof(struct cb_level_78)); - p78->fld_78 = f; - p78->prog = current_program; - p78->name_len = (cob_u32_t)strlen (f->name); - if (f->flag_is_global) { - if (!glob_lev_78_ptr) { - p78->last = p78; - } else { - p78->last = glob_lev_78_ptr->last; - } - p78->last->glob_next = const_78_ptr; - p78->next = glob_lev_78_ptr; - p78->glob_next = glob_lev_78_ptr; - p78->chk_const = 1; - glob_lev_78_ptr = p78; - if (lev_78_ptr) { - lev_78_ptr->last->glob_next = glob_lev_78_ptr; - } else { - top_78_ptr = glob_lev_78_ptr; - } - } else { - if (!lev_78_ptr) { - p78->last = p78; - } else { - p78->last = lev_78_ptr->last; - } - if (glob_lev_78_ptr) { - p78->last->glob_next = glob_lev_78_ptr; - } else { - p78->last->glob_next = const_78_ptr; - } - p78->next = lev_78_ptr; - p78->glob_next = lev_78_ptr; - lev_78_ptr = p78; - top_78_ptr = lev_78_ptr; - } -} - -struct cb_field * -check_level_78 (const char *name) -{ - const struct cb_level_78 *p78; - - /* Check against a current constant (78 level) */ - for (p78 = lev_78_ptr; p78; p78 = p78->next) { - if (strcasecmp (name, p78->fld_78->name) == 0) { - return p78->fld_78; - } - } - /* Check against a global constant (78 level) */ - for (p78 = glob_lev_78_ptr; p78; p78 = p78->next) { - if (strcasecmp (name, p78->fld_78->name) == 0) { - return p78->fld_78; - } - } - return NULL; -} - -/* - Find program with the program-name name in defined_prog_list. If it is not - there, return NULL. -*/ -struct cb_program * -cb_find_defined_program_by_name (const char *name) -{ - int (*cmp_func)(const char *, const char *); - cb_tree l; - cb_tree x; - - if (cb_fold_call) { - cmp_func = &strcasecmp; - } else { - cmp_func = &strcmp; - } - - for (l = defined_prog_list; l; l = CB_CHAIN (l)) { - x = CB_VALUE (l); - if ((*cmp_func)(name, CB_PROGRAM (x)->program_name) == 0) { - return CB_PROGRAM (x); - } - } - - return NULL; -} - -struct cb_program * -cb_find_defined_program_by_id (const char *orig_id) -{ - cb_tree l; - cb_tree x; - - for (l = defined_prog_list; l; l = CB_CHAIN (l)) { - x = CB_VALUE (l); - if (strcmp (orig_id, CB_PROGRAM (x)->orig_program_id) == 0) { - return CB_PROGRAM (x); - } - } - - return NULL; -} - diff -Nru gnucobol-4.0~early~20200606/cobc/scanner.l gnucobol-5/cobc/scanner.l --- gnucobol-4.0~early~20200606/cobc/scanner.l 2020-06-06 20:51:59.000000000 +0000 +++ gnucobol-5/cobc/scanner.l 1970-01-01 00:00:00.000000000 +0000 @@ -1,2488 +0,0 @@ -/* - Copyright (C) 2001-2012, 2014-2019 Free Software Foundation, Inc. - Written by Keisuke Nishida, Roger While, Simon Sobisch, Edwart Hart, - Ron Norman - - This file is part of GnuCOBOL. - - The GnuCOBOL compiler is free software: you can redistribute it - and/or modify it under the terms of the GNU General Public License - as published by the Free Software Foundation, either version 3 of the - License, or (at your option) any later version. - - GnuCOBOL is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with GnuCOBOL. If not, see . -*/ - - -%option 8bit -%option case-insensitive -%option never-interactive -%option nodefault - -%option noyy_scan_buffer -%option noyy_scan_bytes -%option noyy_scan_string - -%option noyyget_extra -%option noyyset_extra -%option noyyget_leng -%option noyyget_text -%option noyyget_lineno -%option noyyset_lineno -%option noyyget_in -%option noyyset_in -%option noyyget_out -%option noyyset_out -%option noyyget_lval -%option noyyset_lval -%option noyyget_lloc -%option noyyset_lloc -%option noyyget_debug -%option noyyset_debug -%{ - -#undef YY_READ_BUF_SIZE -#define YY_READ_BUF_SIZE 32768 -#undef YY_BUF_SIZE -#define YY_BUF_SIZE 32768 - -#define YY_SKIP_YYWRAP -static int yywrap (void) { - return 1; -} - -#define YY_INPUT(buf,result,max_size) \ - { \ - if (fgets (buf, (int)max_size, yyin) == NULL) { \ - result = YY_NULL; \ - } else { \ - result = strlen (buf); \ - } \ - } - -#define YY_USER_INIT \ - if (!plex_buff) { \ - plex_size = COB_MINI_BUFF; \ - plex_buff = cobc_malloc (plex_size); \ - } \ - if (!pic_buff1) { \ - pic1_size = COB_MINI_BUFF; \ - pic_buff1 = cobc_malloc (pic1_size); \ - } \ - if (!pic_buff2) { \ - pic2_size = COB_MINI_BUFF; \ - pic_buff2 = cobc_malloc (pic2_size); \ - } - -#include - -#include -#include - -#ifdef HAVE_UNISTD_H -#include -#else -#define YY_NO_UNISTD_H 1 -#endif - -#define COB_IN_SCANNER 1 -#include "cobc.h" -#include "tree.h" - -/* ignore unused functions here as flex generates unused ones */ -#ifdef __GNUC__ -#if defined (__clang__) || __GNUC__ > 4 || (__GNUC__ == 4 && __GNUC_MINOR__ >= 4) -#pragma GCC diagnostic ignored "-Wunused-function" -#endif -#endif - -#define YYSTYPE cb_tree -#include - -#define RETURN_TOK(expr) \ - do { \ - last_yylval = yylval; \ - last_token = (expr); \ - return last_token; \ - } ONCE_COB - -#define SET_LOCATION(x) \ - do { \ - (x)->source_file = cb_source_file; \ - (x)->source_line = cb_source_line; \ - } ONCE_COB - -/* CONSTANT (78 level) structure */ -struct cb_level_78 { - struct cb_level_78 *next; /* Next in chain */ - struct cb_level_78 *glob_next; /* Continued next in chain */ - struct cb_level_78 *last; /* Last in chain */ - struct cb_field *fld_78; /* Pointer to field */ - struct cb_program *prog; /* Program where defined */ - cob_u32_t name_len; /* Length of name */ - cob_u32_t not_const; /* Invalid usage check */ - cob_u32_t chk_const; /* Check global level use */ -}; - -struct cb_top_level_78 { - struct cb_top_level_78 *next; - struct cb_level_78 *lev_78_ptr; -}; - -/* Local variables */ -static cb_tree last_yylval; -static int last_token; -static struct cb_level_78 *top_78_ptr = NULL; -static struct cb_level_78 *const_78_ptr = NULL; -static struct cb_level_78 *lev_78_ptr = NULL; -static struct cb_level_78 *glob_lev_78_ptr = NULL; -static char *plex_buff = NULL; -static char *pic_buff1 = NULL; -static char *pic_buff2 = NULL; -static size_t plex_size; -static size_t pic1_size; -static size_t pic2_size; -static unsigned int last_token_is_dot = 0; -static unsigned int integer_is_label = 0; -static unsigned int inside_bracket = 0; -static unsigned int literal_error; -static char err_msg[COB_MINI_BUFF]; - -/* Function declarations */ -static void read_literal (const char, const char *); -static int scan_x (const char *, const char *); -static int scan_z (const char *, const char *); -static int scan_h (const char *, const char *); -static int scan_b (const char *, const char *); -static int scan_o (const char *, const char *); -static int scan_numeric (const char *); -static int scan_floating_numeric (const char *); -static void scan_picture (const char *); -static void count_lines (const char *); -static void scan_define_options (const char *); -static void copy_word_in_quotes (char ** const); -static void copy_two_words_in_quotes (char ** const, char ** const); -static void add_synonym (const int); -static void * copy_literal (cb_tree l); - -%} - -%s DECIMAL_IS_PERIOD DECIMAL_IS_COMMA -%x PICTURE_STATE FUNCTION_STATE - -%% - -%{ - if (likely (current_program)) { - if (current_program->decimal_point == '.') { - BEGIN DECIMAL_IS_PERIOD; - } else { - BEGIN DECIMAL_IS_COMMA; - } - } - - if (cobc_repeat_last_token) { - cobc_repeat_last_token = 0; - yylval = last_yylval; - return last_token; - } - - /* We treat integer literals immediately after '.' as labels; - that is, they must be level numbers or section names. */ - if (last_token_is_dot) { - integer_is_label = 1; - last_token_is_dot = 0; - } else { - integer_is_label = 0; - } -%} - -<*>^[ ]?"#CALLFH".*\n { - const char *p1; - char *p2; - if (current_program->extfh) { - cobc_parse_free ((void *)current_program->extfh); - current_program->extfh = NULL; - } - p1 = strchr (yytext, '"'); - if (p1) { - ++p1; - p2 = strrchr (p1, '"'); - if (p2) { - *p2 = 0; - if (strcmp (p1, "EXTFH")) { - current_program->extfh = cobc_parse_strdup (p1); - } - } - } -} - -<*>^[ ]?"#XFD".*\n { - char *p1; - char *p2; - p1 = strchr (yytext, '"'); - if (p1) { - ++p1; - p2 = strrchr (p1, '"'); - if (p2) { - *p2 = 0; - /* Quotes are removed and string passed - * for processing with the next field */ - cb_save_xfd (p1); - } - } -} - -<*>^[ ]?"#DEFLIT".*\n { - scan_define_options (yytext); -} - -<*>^[ ]?"#ADDRSV".*\n { - char *word; - - copy_word_in_quotes (&word); - add_reserved_word_now (word, NULL); - cobc_free (word); -} - -<*>^[ ]?"#ADDSYN".*\n { - add_synonym (0); -} - -<*>^[ ]?"#MAKESYN".*\n { - char *new_meaning; - char *word_to_change; - - copy_two_words_in_quotes (&new_meaning, &word_to_change); - - if (!is_default_reserved_word (new_meaning)) { - cb_error (_("'%s' is not a default reserved word, so cannot be aliased"), - new_meaning); - } else if (!is_reserved_word (word_to_change)) { - cb_error (_("'%s' is not a reserved word; you may want ADDSYN or OVERRIDE instead"), - word_to_change); - } else { - remove_reserved_word_now (word_to_change); - add_reserved_word_now (word_to_change, new_meaning); - } - - cobc_free (new_meaning); - cobc_free (word_to_change); - } - -<*>^[ ]?"#OVERRIDE".*\n { - add_synonym (1); -} - -<*>^[ ]?"#REMOVE".*\n { - char *word; - - copy_word_in_quotes (&word); - remove_reserved_word_now (word); - cobc_free (word); -} - -<*>^[ ]?"#ASSIGN".*\n { - char *text = cobc_strdup (yytext); - cb_assign_type_default = (enum cb_assign_type)(text[1] - '0'); -} - -<*>\n { - cb_source_line++; -} - -^"#LINE"[ ]?[0-9]+" ".* { - /* Line directive */ - char *p1; - char *p2; - - p1 = strchr (yytext, '"'); - if (p1) { - p2 = p1 + 1; - p1 = strrchr (p2, '"'); - if (p1) { - *p1 = 0; - cb_source_file = cobc_parse_strdup (p2); - /* FIXME: only place where strol is used, replace by cobc internal - function for base 10 (found in cobc.c already) and base 16, - remove from configure.ac */ - cb_source_line = (int)strtol (yytext + 5, NULL, 10) - 1; - } - } -} - -^"#".* { - /* Ignore */ -} - -"PIC" | -"PICTURE" { - BEGIN PICTURE_STATE; -} - -"FUNCTION" { - if (cobc_in_repository || cobc_cs_check == CB_CS_EXIT) { - yylval = NULL; - RETURN_TOK (FUNCTION); - } - BEGIN FUNCTION_STATE; -} - -[''""] { - /* String literal */ - cobc_force_literal = 0; - read_literal (yytext[0], ""); - RETURN_TOK (LITERAL); -} - -X"\'"[^''\n]*"\'" | -X"\""[^""\n]*"\"" { - /* X string literal */ - cobc_force_literal = 0; - RETURN_TOK (scan_x (yytext + 2, "X")); -} - -N[''""] { - /* N national string literal */ - cobc_force_literal = 0; - /* TODO: national string - needs different handling */ - read_literal (yytext [1], "N"); - RETURN_TOK (LITERAL); -} - -NC[''""] { - /* NC national character string literal (extension, but - same handling as COBOL 2002 national string literal) */ - cobc_force_literal = 0; - /* TODO: national string - needs different handling */ - read_literal (yytext [2], "NC"); - RETURN_TOK (LITERAL); -} - -NX"\'"[^''\n]*"\'" | -NX"\""[^""\n]*"\"" { - /* NX string literal */ - cobc_force_literal = 0; - RETURN_TOK (scan_x (yytext + 3, "NX")); -} - -Z"\'"[^''\n]*"\'" | -Z"\""[^""\n]*"\"" { - /* Z string literal */ - cobc_force_literal = 0; - RETURN_TOK (scan_z (yytext + 2, "Z")); -} - -L"\'"[^''\n]*"\'" | -L"\""[^""\n]*"\"" { - /* L string literal */ - cobc_force_literal = 0; - RETURN_TOK (scan_z (yytext + 2, "L")); -} - -H"\'"[^''\n]*"\'" | -H"\""[^""\n]*"\"" { - /* H hexadecimal/numeric literal */ - cobc_force_literal = 0; - RETURN_TOK (scan_h (yytext + 2, "H")); -} - -B"\'"[^''\n]*"\'" | -B"\""[^""\n]*"\"" { - /* B boolean/numeric literal */ - cobc_force_literal = 0; - RETURN_TOK (scan_b (yytext + 2, "B")); -} - -BX"\'"[^''\n]*"\'" | -BX"\""[^""\n]*"\"" { - /* BX boolean hexadecimal string literal */ - cobc_force_literal = 0; - RETURN_TOK (scan_x (yytext + 3, "BX")); -} - -B#[0-9]+ { - /* - To avoid subtle silent errors, such as B#021, this rule (and the ones - following) here admit some invalid literals which emit errors when - they are processed. - */ - /* ACUCOBOL binary numeric literal */ - cobc_force_literal = 0; - RETURN_TOK (scan_b (yytext + 2, "B#")); -} - -O#[0-9]+ { - /* ACUCOBOL octal numeric literal */ - cobc_force_literal = 0; - RETURN_TOK (scan_o (yytext + 2, "O#")); -} - -%[0-9]+ { - /* HP-COBOL octal numeric literal */ - cobc_force_literal = 0; - RETURN_TOK (scan_o (yytext + 1, "%")); -} - -X#[0-9A-Za-z]+ | -H#[0-9A-Za-z]+ { - /* ACUCOBOL hexadecimal numeric literal */ - char type[3] = "x#"; - type[0] = yytext [0]; - cobc_force_literal = 0; - RETURN_TOK (scan_h (yytext + 2, type)); -} - -\( { - inside_bracket++; - RETURN_TOK (TOK_OPEN_PAREN); -} - -\) { - if (inside_bracket > 0) { - inside_bracket--; - } - RETURN_TOK (TOK_CLOSE_PAREN); -} - -[0-9][0-9]? { - int value; - - cobc_force_literal = 0; - if (integer_is_label) { - yylval = cb_build_reference (yytext); - - if (!cobc_in_procedure) { - value = atoi (yytext); - if (value == 66) { - /* level number 66 */ - RETURN_TOK (SIXTY_SIX); - } else if (value == 78) { - /* level number 78 */ - RETURN_TOK (SEVENTY_EIGHT); - } else if (value == 88) { - /* level number 88 */ - RETURN_TOK (EIGHTY_EIGHT); - } else if ((value >= 1 && value <= 49) || value == 77) { - /* level number (1 through 49, 77) */ - RETURN_TOK (LEVEL_NUMBER); - } - } - - /* Integer label */ - RETURN_TOK (WORD); - } - /* Numeric literal or referenced integer label - remark: all transformations/checks are postponed: - literals to tree.c, - integer label to typeck.c (cb_build_section_name) - */ - yylval = cb_build_numeric_literal (0, yytext, 0); - RETURN_TOK (LITERAL); -} - -[0-9]+ { - - cobc_force_literal = 0; - if (integer_is_label) { - /* Integer label */ - yylval = cb_build_reference (yytext); - RETURN_TOK (WORD); - } - /* Numeric literal or referenced integer label - remark: all transformations/checks are postponed: - literals to tree.c, - integer label to typeck.c (cb_build_section_name) - */ - yylval = cb_build_numeric_literal (0, yytext, 0); - RETURN_TOK (LITERAL); -} - -[+-][0-9]+ { - /* Numeric literal (signed) */ - RETURN_TOK (scan_numeric (yytext)); -} - -<*>[ ]+ { - /* Ignore */ -} - -<*>;+ { - if (inside_bracket) { - RETURN_TOK (SEMI_COLON); - } - /* Ignore */ -} - -[+-]?[0-9]*\.[0-9]*E[+-]?[0-9]+ { - /* Numeric floating point literal */ - RETURN_TOK (scan_floating_numeric (yytext)); -} - -[+-]?[0-9]*\.[0-9]*E[+-]?[0-9]*\.[0-9]+ { - /* Invalid numeric floating point literal */ - RETURN_TOK (scan_floating_numeric (yytext)); -} - -[+-]?[0-9]*\.[0-9]+ { - /* Numeric literal */ - RETURN_TOK (scan_numeric (yytext)); -} - -,+ { - if (inside_bracket) { - RETURN_TOK (COMMA_DELIM); - } - /* Ignore */ -} - -[+-]?[0-9]*,[0-9]*E[+-]?[0-9]+ { - /* Numeric floating point literal */ - RETURN_TOK (scan_floating_numeric (yytext)); -} - -[+-]?[0-9]*,[0-9]*E[+-]?[0-9]*,[0-9]+ { - /* Invalid numeric floating point literal */ - RETURN_TOK (scan_floating_numeric (yytext)); -} - -[+-]?[0-9]*,[0-9]+ { - /* Numeric literal */ - RETURN_TOK (scan_numeric (yytext)); -} - -,{2,} { - unput (','); -} - -, { - if (inside_bracket) { - RETURN_TOK (COMMA_DELIM); - } - /* Ignore */ -} - -"END"[ ,;\n]+"PROGRAM"/[ .,;\n] { - cobc_force_literal = 1; - count_lines (yytext); - RETURN_TOK (END_PROGRAM); -} - -"END"[ ,;\n]+"FUNCTION"/[ .,;\n] { - cobc_force_literal = 1; - count_lines (yytext); - RETURN_TOK (END_FUNCTION); -} - -"PICTURE"[ ,;\n]+"SYMBOL"/[ .,;\n] { - count_lines (yytext); - RETURN_TOK (PICTURE_SYMBOL); -} - -"FROM"[ ,;\n]+"CRT"/[ .,;\n] { - count_lines (yytext); - RETURN_TOK (FROM_CRT); -} - -"SCREEN"[ ,;\n]+"CONTROL"/[ .,;\n] { - count_lines (yytext); - RETURN_TOK (SCREEN_CONTROL); -} - -"EVENT"[ ,;\n]+"STATUS"/[ .,;\n] { - count_lines (yytext); - RETURN_TOK (EVENT_STATUS); -} - -"READY"[ ,;\n]+"TRACE"/[ .,;\n] { - count_lines (yytext); - RETURN_TOK (READY_TRACE); -} - -"RESET"[ ,;\n]+"TRACE"/[ .,;\n] { - count_lines (yytext); - RETURN_TOK (RESET_TRACE); -} - -"GREATER"[ ,;\n]+("THAN"[ ,;\n]+)?"OR"[ ,;\n]+"EQUAL"([ ,;\n]+"TO")?/[ .,;\n] { - count_lines (yytext); - RETURN_TOK (GREATER_OR_EQUAL); -} - -"GREATER"[ ,;\n]+"THAN"/[ .,;\n] { - count_lines (yytext); - RETURN_TOK (GREATER); -} - -"LESS"[ ,;\n]+("THAN"[ ,;\n]+)?"OR"[ ,;\n]+"EQUAL"([ ,;\n]+"TO")?/[ .,;\n] { - count_lines (yytext); - RETURN_TOK (LESS_OR_EQUAL); -} - -"LESS"[ ,;\n]+"THAN"/[ .,;\n] { - count_lines (yytext); - RETURN_TOK (LESS); -} - -"EQUAL"[ ,;\n]+"TO"/[ .,;\n] { - count_lines (yytext); - RETURN_TOK (EQUAL); -} - -"THEN"[ ,;\n]+"REPLACING"/[ .,;\n] { - count_lines (yytext); - RETURN_TOK (REPLACING); -} - -"LINES"([ ,;\n]+"AT")?[ ,;\n]+"TOP"/[ .,;\n] { - count_lines (yytext); - RETURN_TOK (TOP); -} -"AT"[ ,;\n]+"TOP"/[ .,;\n] { - count_lines (yytext); - RETURN_TOK (TOP); -} - -"LINES"([ ,;\n]+"AT")?[ ,;\n]+"BOTTOM"/[ .,;\n] { - count_lines (yytext); - RETURN_TOK (BOTTOM); -} -"AT"[ ,;\n]+"BOTTOM"/[ .,;\n] { - count_lines (yytext); - RETURN_TOK (BOTTOM); -} - -"LINE"[ ,;\n]+"LIMIT"/[ .,;\n] { - count_lines (yytext); - return LINE_LIMIT; -} - -("WITH"[ ,;\n]+)?"NO"[ ,;\n]+"ADVANCING"/[ .,;\n] { - count_lines (yytext); - RETURN_TOK (NO_ADVANCING); -} - -("ON"[ ,;\n]+)?"NEXT"[ ,;\n]+"PAGE"/[ .,;\n] { - count_lines (yytext); - RETURN_TOK (NEXT_PAGE); -} - -"NEXT"[ ,;\n]+"GROUP"/[ .,;\n] { - count_lines (yytext); - return NEXT_GROUP; -} - -"NOT"[ ,;\n]+("ON"[ ,;\n]+)?"SIZE"[ ,;\n]+"ERROR"/[ .,;\n] { - count_lines (yytext); - RETURN_TOK (NOT_SIZE_ERROR); -} - -("ON"[ ,;\n]+)?"SIZE"[ ,;\n]+"ERROR"/[ .,;\n] { - count_lines (yytext); - RETURN_TOK (SIZE_ERROR); -} - -"NOT"[ ,;\n]+("ON"[ ,;\n]+)?"ESCAPE"/[ .,;\n] { - count_lines (yytext); - RETURN_TOK (NOT_ESCAPE); -} - -"NOT"[ ,;\n]+("ON"[ ,;\n]+)?"EXCEPTION"/[ .,;\n] { - count_lines (yytext); - RETURN_TOK (NOT_EXCEPTION); -} - -"ON"[ ,;\n]+"ESCAPE"/[ .,;\n] { - count_lines (yytext); - RETURN_TOK (ESCAPE); -} - -"ON"[ ,;\n]+"EXCEPTION"/[ .,;\n] { - count_lines (yytext); - RETURN_TOK (EXCEPTION); -} - -"NOT"[ ,;\n]+("ON"[ ,;\n]+)?"OVERFLOW"/[ .,;\n] { - count_lines (yytext); - RETURN_TOK (NOT_OVERFLOW); -} - -"NOT"[ ,;\n]+("AT"[ ,;\n]+)?"END"/[ .,;\n] { - count_lines (yytext); - RETURN_TOK (NOT_END); -} - -"AT"[ ,;\n]+"END"/[ .,;\n] { - count_lines (yytext); - RETURN_TOK (END); -} - -("ON"[ ,;\n]+)?"OVERFLOW"/[ .,;\n] { - count_lines (yytext); - RETURN_TOK (TOK_OVERFLOW); -} - -"NOT"[ ,;\n]+("AT"[ ,;\n]+)?("END-OF-PAGE"|"EOP")/[ .,;\n] { - count_lines (yytext); - RETURN_TOK (NOT_EOP); -} - -("AT"[ ,;\n]+)?("END-OF-PAGE"|"EOP")/[ .,;\n] { - count_lines (yytext); - RETURN_TOK (EOP); -} - -"NOT"[ ,;\n]+"INVALID"([ ,;\n]+"KEY")?/[ .,;\n] { - count_lines (yytext); - RETURN_TOK (NOT_INVALID_KEY); -} - -"INVALID"([ ,;\n]+"KEY")?/[ .,;\n] { - count_lines (yytext); - RETURN_TOK (INVALID_KEY); -} - -"NO"[ ,;\n]+"DATA"/[ .,;\n] { - count_lines (yytext); - RETURN_TOK (NO_DATA); -} - -"WITH"[ ,;\n]+"DATA"/[ .,;\n] { - count_lines (yytext); - RETURN_TOK (DATA); -} - -"UPON"[ ,;\n]+"ENVIRONMENT-NAME"/[ .,;\n] { - count_lines (yytext); - RETURN_TOK (UPON_ENVIRONMENT_NAME); -} - -"UPON"[ ,;\n]+"ENVIRONMENT-VALUE"/[ .,;\n] { - count_lines (yytext); - RETURN_TOK (UPON_ENVIRONMENT_VALUE); -} - -"UPON"[ ,;\n]+"ARGUMENT-NUMBER"/[ .,;\n] { - count_lines (yytext); - RETURN_TOK (UPON_ARGUMENT_NUMBER); -} - -"UPON"[ ,;\n]+"COMMAND-LINE"/[ .,;\n] { - count_lines (yytext); - RETURN_TOK (UPON_COMMAND_LINE); -} - -("AFTER"[ ,;\n]+)?"EXCEPTION"[ ,;\n]+"CONDITION"/[ .,;\n] { - count_lines (yytext); - RETURN_TOK (EXCEPTION_CONDITION); -} - -"AFTER"[ ,;\n]+"EC"/[ .,;\n] { - count_lines (yytext); - RETURN_TOK (EC); -} - -"SUPPRESS"/[ .,;\n] { - count_lines (yytext); - if (cobc_in_xml_generate_body || cobc_in_json_generate_body) { - /* - Using the standard SUPPRESS token in JSON/XML GENERATE causes - a shift/reduce error - the SUPPRESS could be the start of the - SUPPRESS clause or the start of a SUPPRESS statement. While we - could alter shift precedence to get the result we implement - here (viz. assuming the SUPPRESS belongs to JSON/XML GENERATE), - our current style is for bison to run with no errors. - */ - RETURN_TOK (SUPPRESS_XML); - } else { - RETURN_TOK (SUPPRESS); - } -} - -"WHEN"/[ .,;\n] { - count_lines (yytext); - if (cobc_in_xml_generate_body) { - /* - Using the standard WHEN token in XML GENERATE causes a - shift/reduce error - the WHEN could be the start of the - WHEN clause or the start of a WHEN statement. While we - could alter shift precedence to get the result we implement - here (viz. assuming the WHEN belongs to XML GENERATE), our - current style is for bison to run with no errors. - */ - RETURN_TOK (WHEN_XML); - } else { - RETURN_TOK (WHEN); - } -} - - -"SWITCH"[ ]+([0-9][0-9]?|[A-Z])/[ .,;\n] { - /* ACUCOBOL extension: switch-names with space and with letter */ - char suffix[3] = ""; - char name[10] = ""; - - /* FIXME: move the code for filling "name" here and first - check with "lookup_system_name (name) != NULL" - if we actually want to do this, - otherwise return 2 (!) WORD tokens (by adding a queue - of tokens to be returned) - */ - if (cobc_in_procedure) { - /* unput characters */ - yylval = cb_build_reference ("SWITCH"); - if (isdigit((unsigned char)yytext[yyleng-2])) { - unput (yytext[yyleng-1]); - unput (yytext[yyleng-2]); - } else { - unput (yytext[yyleng-1]); - } - } else { - /* we need to return a single word, reverted later in parser.y */ - if (yytext[yyleng-2] == ' ' && isdigit((unsigned char)yytext[yyleng-1])) { - /* SWITCH 0 to SWITCH 9 */ - suffix[0] = yytext[yyleng-1]; - } else if (isdigit((unsigned char)yytext[yyleng-2])) { - /* SWITCH 00 to SWITCH 99 */ - suffix[0] = yytext[yyleng-2]; - suffix[1] = yytext[yyleng-1]; - } else { - suffix[0] = yytext[yyleng-1]; - } - strncpy(name, yytext, 6); - strcat(name, "_"); - strcat(name, suffix); - yylval = cb_build_reference (name); - } - RETURN_TOK (WORD); -} - -"LENGTH"[ ,;\n]+"OF"/[ .,;\n] { - count_lines (yytext); - RETURN_TOK (LENGTH_OF); -} - -[A-Z0-9\x80-\xFF]([_A-Z0-9\x80-\xFF-]*[A-Z0-9\x80-\xFF]+)? { - struct cb_level_78 *p78; - struct cb_intrinsic_table *cbp; - struct cobc_reserved *resptr; - struct cb_text_list *tlp; - cb_tree x; - cb_tree l; - struct cb_program *program; - - cb_check_word_length ((unsigned int)yyleng, yytext); - - /* Check Intrinsic FUNCTION name without keyword */ - if ((cobc_in_procedure && (functions_are_all || cb_intrinsic_list || - current_program->function_spec_list)) || cobc_in_repository) { - cbp = lookup_intrinsic (yytext, 0); - if (cbp) { - if (cobc_in_repository) { - yylval = cb_build_alphanumeric_literal (yytext, (size_t)yyleng); - RETURN_TOK (FUNCTION_NAME); - } - if (functions_are_all) { - yylval = cb_build_reference (yytext); - RETURN_TOK ((enum yytokentype)(cbp->token)); - } - for (tlp = cb_intrinsic_list; tlp; tlp = tlp->next) { - if (!strcasecmp (yytext, tlp->text)) { - yylval = cb_build_reference (yytext); - RETURN_TOK ((enum yytokentype)(cbp->token)); - } - } - l = current_program->function_spec_list; - for (; l; l = CB_CHAIN(l)) { - x = CB_VALUE (l); - if (!strcasecmp (yytext, - (char *)(CB_LITERAL(x)->data))) { - yylval = cb_build_reference (yytext); - RETURN_TOK ((enum yytokentype)(cbp->token)); - } - } - } - } - - /* Bail early for (END) PROGRAM-ID when not a literal */ - if (unlikely (cobc_force_literal)) { - /* Force PROGRAM-ID / END PROGRAM */ - cobc_force_literal = 0; - if (cb_fold_call) { - yylval = cb_build_reference (yytext); - RETURN_TOK (PROGRAM_NAME); - } else { - yylval = cb_build_alphanumeric_literal (yytext, (size_t)yyleng); - RETURN_TOK (LITERAL); - } - } - - /* Check reserved word */ - resptr = lookup_reserved_word (yytext); - if (resptr != NULL) { - if (resptr->nodegen) { - /* Save location for terminator checking */ - /* Misuse comment tree to mark statement */ - yylval = cb_build_comment (NULL); - } else { - yylval = NULL; - } - RETURN_TOK (resptr->token); - } - - /* New user-defined word in REPOSITORY entry */ - if (cobc_in_repository) { - yylval = cb_build_reference (yytext); - RETURN_TOK (WORD); - } - - /* Direct recursive reference in function */ - if (current_program->prog_type == COB_MODULE_TYPE_FUNCTION - && !functions_are_all - && !strcasecmp (yytext, current_program->orig_program_id)) { - yylval = cb_build_reference (yytext); - RETURN_TOK (USER_FUNCTION_NAME); - } - - /* Check prototype names */ - for (l = current_program->user_spec_list; l; l = CB_CHAIN (l)) { - x = CB_VALUE (l); - if (!strcasecmp (yytext, CB_PROTOTYPE (x)->name)) { - yylval = cb_build_reference (yytext); - RETURN_TOK (USER_FUNCTION_NAME); - } - } - if (cobc_allow_program_name) { - for (l = current_program->program_spec_list; l; l = CB_CHAIN (l)) { - x = CB_VALUE (l); - if (!strcasecmp (yytext, CB_PROTOTYPE (x)->name)) { - yylval = cb_build_reference (yytext); - RETURN_TOK (PROGRAM_NAME); - } - } - } - - /* Check user programs */ - if (cobc_in_id) { - program = cb_find_defined_program_by_name (yytext); - if (program) { - yylval = cb_build_reference (yytext); - RETURN_TOK (PROGRAM_NAME); - } - } - - /* User word */ - - /* Check local, global and source global CONSTANT (78) items */ - - for (p78 = top_78_ptr; p78; p78 = p78->glob_next) { - if (strcasecmp (yytext, p78->fld_78->name) == 0) { - if (unlikely (non_const_word)) { - if (p78->prog == current_program) { - cb_error (_("a constant may not be used here - '%s'"), yytext); - yylval = cb_error_node; - RETURN_TOK (WORD); - } - if (p78->chk_const) { - p78->not_const = 1; - } - break; - } - if (p78->chk_const && p78->not_const) { - break; - } - yylval = copy_literal (CB_VALUE (p78->fld_78->values)); - SET_LOCATION (yylval); - RETURN_TOK (LITERAL); - } - } - - yylval = cb_build_reference (yytext); - - /* Special name handling */ - if (CB_WORD_COUNT (yylval) > 0 && CB_WORD_ITEMS (yylval)) { - x = CB_VALUE (CB_WORD_ITEMS (yylval)); - if (CB_SYSTEM_NAME_P (x)) { - RETURN_TOK (MNEMONIC_NAME); - } else if (CB_CLASS_NAME_P (x)) { - RETURN_TOK (CLASS_NAME); - } - } - - RETURN_TOK (WORD); -} - -"<=" { - yylval = NULL; - RETURN_TOK (LESS_OR_EQUAL); -} - -">=" { - yylval = NULL; - RETURN_TOK (GREATER_OR_EQUAL); -} - -"<>" { - yylval = NULL; - RETURN_TOK (NOT_EQUAL); -} - -"**" { - yylval = NULL; - RETURN_TOK (EXPONENTIATION); -} - -"."([ \n]*".")* { - if (last_token_is_dot || strlen (yytext) > 1) { - cb_warning (COBC_WARN_FILLER, _("ignoring redundant .")); - } - - if (!last_token_is_dot) { - last_token_is_dot = 1; - yylval = NULL; - RETURN_TOK (TOK_DOT); - } -} - -"&" { - yylval = NULL; - RETURN_TOK (TOK_AMPER); -} - -":" { - yylval = NULL; - RETURN_TOK (TOK_COLON); -} - -"=" { - yylval = NULL; - RETURN_TOK (TOK_EQUAL); -} - -"/" { - yylval = NULL; - RETURN_TOK (TOK_DIV); -} - -"*" { - yylval = NULL; - RETURN_TOK (TOK_MUL); -} - -"+" { - yylval = NULL; - RETURN_TOK (TOK_PLUS); -} - -"-" { - yylval = NULL; - RETURN_TOK (TOK_MINUS); -} - -"<" { - yylval = NULL; - RETURN_TOK (TOK_LESS); -} - -">" { - yylval = NULL; - RETURN_TOK (TOK_GREATER); -} - -. { - int c; - - cb_error (_("invalid symbol '%s' - skipping word"), yytext); - while ((c = input ()) != EOF) { - if (c == '\n' || c == ' ') { - break; - } - } - if (c != EOF) { - unput (c); - } -} - - -{ - "IS" { - /* Ignore */ - } - [^ \n;]+ { - BEGIN INITIAL; - scan_picture (yytext); - RETURN_TOK (PICTURE); - } -} - -{ - [A-Z0-9-]+ { - struct cb_intrinsic_table *cbp; - cb_tree l; - cb_tree x; - - BEGIN INITIAL; - yylval = cb_build_reference (yytext); - for (l = current_program->user_spec_list; l; l = CB_CHAIN(l)) { - x = CB_VALUE (l); - if (!strcasecmp (yytext, CB_PROTOTYPE (x)->name)) { - RETURN_TOK (USER_FUNCTION_NAME); - } - } - cbp = lookup_intrinsic (yytext, 0); - if (cbp) { - RETURN_TOK ((enum yytokentype)(cbp->token)); - } - RETURN_TOK (FUNCTION_NAME); - } - . { - yylval = NULL; - RETURN_TOK (yytext[0]); - } -} - -<> { - struct cb_level_78 *p78; - struct cb_level_78 *p782; - - /* At EOF - Clear variables */ - for (p78 = lev_78_ptr; p78; ) { - p782 = p78->next; - cobc_free (p78); - p78 = p782; - } - for (p78 = glob_lev_78_ptr; p78; ) { - p782 = p78->next; - cobc_free (p78); - p78 = p782; - } - for (p78 = const_78_ptr; p78; ) { - p782 = p78->next; - cobc_free (p78); - p78 = p782; - } - top_78_ptr = NULL; - last_token_is_dot = 0; - integer_is_label = 0; - inside_bracket = 0; - lev_78_ptr = NULL; - glob_lev_78_ptr = NULL; - cobc_force_literal = 0; - yyterminate (); -} - -%% - -static void -error_literal (const char *type, const char *literal) -{ - char lit_out[39]; - - if (!literal_error) { -#if 0 /* national literal, check for different truncation and wcslen - or not show it at all */ - if (strcmp (type, "national") == 0) { - cb_error (_("invalid national literal"), lit_out); - } else { -#endif - /* snip literal for output, if too long */ - strncpy (lit_out, literal, 38); - if (strlen (literal) > 38) { - strcpy (lit_out + 35, "..."); - } else { - lit_out[38] = '\0'; - } - if (strcmp (type, "") == 0) { - cb_error (_("invalid literal: '%s'"), lit_out); - } else if (strcmp (type, "hex") == 0) { - cb_error (_("invalid hexadecimal literal: '%s'"), lit_out); - } else if (strcmp (type, "num") == 0) { - cb_error (_("invalid numeric literal: '%s'"), lit_out); - } else if (strcmp (type, "float") == 0) { - cb_error (_("invalid floating-point literal: '%s'"), lit_out); - } else { - cb_error (_("invalid %s literal: '%s'"), type, lit_out); - } -#if 0 /* national literal */ - } -#endif - } - literal_error++; - cb_error ("%s", err_msg); -} - -static void -read_literal (const char mark, const char *type) -{ - size_t i; - int c; - - literal_error = 0; - - i = 0; - /* read until a not-escaped mark is found (see break) - or (unlikely) we reach EOF */ - /* NO early exit possible as the literal has to be consumed */ - while ((c = input ()) != EOF) { -#if EOF != 0 - if (unlikely (c == 0)) break; /* fixes unexpected error case */ -#endif - if (!literal_error) { - if (unlikely (i + 1 == plex_size)) { - plex_size *= 2; - if (unlikely (plex_size > (cb_lit_length + 1))) { - plex_size = (size_t)cb_lit_length + 1; - } - plex_buff = cobc_realloc (plex_buff, plex_size); - } - plex_buff[i] = (cob_u8_t)c; - } - if (c == mark && (c = input ()) != (int)mark) { - if (c == '-') { - /* Free format continuation ("a"- 'b'- ) */ - /* Hack it as concatenation */ - unput ('&'); - } else { - if (c == EOF || c == 0) break; - unput (c); - } - break; - } - /* check literal size here as we have to adjust and check - for (escaped) mark before checking the max length */ - if (unlikely (i++ == cb_lit_length)) { - snprintf (err_msg, COB_MINI_MAX, - _("literal length exceeds %d characters"), - cb_lit_length); - plex_buff[cb_lit_length] = 0; /* ensure valid C-string for error message */ - error_literal ("", plex_buff); - } - } - - /* FIXME: Exact behavior should depend on level of support: - * "OK" => standard behavior, e.g. normal items filled with spaces/ - zeros, DYNAMIC LENGTH items made empty - * "warning" => current implementation, interpret '' as SPACE/ZERO - * "ignore" => assume a space without warning; make sure zero length - items work everywhere (should do as we support zero - lengths via ODO items already) - */ - if (!i) { - cb_verify (cb_zero_length_lit, _("zero-length literal")); - cb_warning (COBC_WARN_FILLER, - type[0] == 'N' ? - _("national literal has zero length; a SPACE will be assumed") : - _("alphanumeric literal has zero length; a SPACE will be assumed")); - plex_buff[i++] = ' '; - } else if (i > cb_lit_length) { - i = cb_lit_length; - } - - /* build literal with given size */ - plex_buff[i] = 0; - if (type[0] != 'N') { - yylval = cb_build_alphanumeric_literal (plex_buff, i); - } else { - if (type[1] != 'C') { - if (cb_verify (cb_national_literals, _("national literal"))) { - CB_UNFINISHED (_("national literal")); - } - } else { - if (cb_verify (cb_nationalc_literals, _("national-character literal"))) { - CB_UNFINISHED (_("national literal")); - } - } - yylval = cb_build_national_literal (plex_buff, i); - } -} - -static int -scan_x (const char *text, const char *type) -{ - char *p; - char *e; - char *dst; - size_t curr_len; - size_t result_len; - int c; - - literal_error = 0; - - /* Remark: - The standard allows for 8,191 (normal/national/boolean) character positions */ - - /* curr_len includes the terminating quote - and has to be adjusted according to type */ - - curr_len = strlen (text); - curr_len--; - if (curr_len == 0) { - cb_verify (cb_zero_length_lit, _("zero-length literal")); - plex_buff[0] = '\0'; - plex_buff[1] = '\0'; - cb_warning (COBC_WARN_FILLER, - _("hexadecimal literal has zero length; X'00' will be assumed")); - if (type[0] == 'B') { - yylval = cb_build_numeric_literal (0, "0", 0); - } else if (type[0] == 'N') { - yylval = cb_build_alphanumeric_literal (plex_buff, 1); - } else { - yylval = cb_build_national_literal (plex_buff, 1); - } - RETURN_TOK (LITERAL); - } - - if (unlikely (curr_len + 1 > plex_size)) { - plex_size = curr_len + 1; - plex_buff = cobc_realloc (plex_buff, plex_size); - } - memcpy (plex_buff, text, curr_len); - if (likely(type[0] == 'X')) { - result_len = curr_len / 2; /* characters, two half-bytes (hex) = 1 byte */ - } else if (type[0] == 'B') { - if (!cb_verify (cb_hexadecimal_boolean, _("hexadecimal-boolean literal"))) { - goto error; /* early exit possible as complete literal is consumed */ - } - result_len = curr_len * 4; /* boolean characters B -> 1110 */ - /* GnuCOBOL currently only support 64 bit booleans */ - if (unlikely (result_len > 64)) { - snprintf (err_msg, COB_MINI_MAX, - _("literal length %d exceeds %d characters"), - (int) result_len, 64); - error_literal (type, plex_buff); - goto error; - } - } else { - if (!cb_verify (cb_national_hex_literals, _("hexadecimal-national literal"))) { - goto error; /* early exit possible as complete literal is consumed */ - } - CB_UNFINISHED (_("national literal")); - result_len = curr_len / (2 * COB_NATIONAL_SIZE); /* national characters */ - } - if (unlikely (result_len > cb_lit_length)) { - snprintf (err_msg, COB_MINI_MAX, - _("literal length %d exceeds %d characters"), - (int) result_len, cb_lit_length); - error_literal (type, plex_buff); - goto error; - } - - p = (char *)text; - e = (char *)p + curr_len; - dst = plex_buff; - - if (unlikely(type[0] == 'B')) { - /* hexadecimal-boolean */ - cob_u64_t val = 0; - for (; *p != *e; p++) { - c = (int) *p; - if ('0' <= c && c <= '9') { - val = (val << 4) + ((cob_u64_t)c - '0'); - } else if ('A' <= c && c <= 'F') { - val = (val << 4) + ((cob_u64_t)c - 'A' + 10); - } else if ('a' <= c && c <= 'f') { - val = (val << 4) + ((cob_u64_t)c - 'a' + 10); - } else { - snprintf (err_msg, COB_MINI_MAX, - _("literal contains invalid character '%c'"), c); - if (likely (literal_error == 0)) { - memcpy (plex_buff, text, curr_len + 1); - plex_buff[curr_len] = 0; - } - error_literal (type, plex_buff); - /* By not breaking immediately, we detect any following - invalid chars - */ - continue; - } - } - if (unlikely (literal_error != 0)) { - goto error; - } - sprintf ((char *)plex_buff, CB_FMT_LLU, val); - yylval = cb_build_numeric_literal (0, (const void *)plex_buff, 0); - - } else { - - /* hexadecimal */ - int high = 1; - for (; *p != *e; p++) { - c = (int) *p; - if ('0' <= c && c <= '9') { - c = c - '0'; - } else if ('A' <= c && c <= 'F') { - c = c - 'A' + 10; - } else if ('a' <= c && c <= 'f') { - c = c - 'a' + 10; - } else { - snprintf (err_msg, COB_MINI_MAX, - _("literal contains invalid character '%c'"), c); - if (likely (literal_error == 0)) { - memcpy (plex_buff, text, curr_len + 1); - plex_buff[curr_len] = 0; - } - error_literal (type, plex_buff); - /* By not breaking immediately, we detect any following - invalid chars - */ - continue; - } - if (likely (literal_error == 0)) { - if (high) { - *dst = (cob_u8_t)(c << 4); - } else { - *dst++ += (cob_u8_t)c; - } - } - high = 1 - high; - } - - if (!high) { - /* This is non-standard behaviour */ - snprintf (err_msg, COB_MINI_MAX, - _("literal does not have an even number of digits")); - if (likely (literal_error == 0)) { - memcpy (plex_buff, text, curr_len + 1); - plex_buff[curr_len] = 0; - } - error_literal (type, plex_buff); - } - if (unlikely (literal_error != 0)) { - goto error; - } - if (type[0] != 'N') { - yylval = cb_build_alphanumeric_literal (plex_buff, (size_t)(dst - plex_buff)); - } else { - yylval = cb_build_national_literal (plex_buff, (size_t)(dst - plex_buff)); - } - } - - RETURN_TOK (LITERAL); - -error: - yylval = cb_error_node; - RETURN_TOK (LITERAL); -} - -static int -scan_z (const char *text, const char *type) -{ - size_t currlen; - - literal_error = 0; - - /* currlen includes the terminating quote */ - currlen = strlen (text); - if (unlikely ((currlen - 1) > cb_lit_length)) { - currlen--; - snprintf (err_msg, COB_MINI_MAX, - _("literal length %d exceeds %d characters"), - (int) currlen, cb_lit_length); - error_literal (type, text); - goto error; - } else if (unlikely (currlen == 1)) { - currlen--; - snprintf (err_msg, COB_MINI_MAX, - _("%s literals must contain at least one character"), - type); - error_literal (type, ""); - goto error; - } - if (unlikely (currlen > plex_size)) { - plex_size = currlen; - plex_buff = cobc_realloc (plex_buff, plex_size); - } - memcpy (plex_buff, text, currlen); - plex_buff[currlen - 1] = 0; - - /* Count is correct here as the trailing quote is now a null */ - yylval = cb_build_alphanumeric_literal (plex_buff, currlen); - if (type[0] == 'L') { - CB_LITERAL(yylval)->llit = 1; - } - RETURN_TOK (LITERAL); - - error: - yylval = cb_error_node; - RETURN_TOK (LITERAL); -} - -static int -scan_h (const char *text, const char *type) -{ - size_t currlen; - char *p; - cob_u64_t val = 0; - int c; - - literal_error = 0; - - if (type[1] == '#' && - !cb_verify (cb_acu_literals, _("ACUCOBOL numeric literal"))) { - goto error; /* early exit possible as complete literal is consumed */ - } - - /* currlen can include the terminating quote */ - currlen = strlen (text); - memcpy (plex_buff, text, currlen + 1); - if (type[1] != '#') { - currlen--; - if (currlen == 0) { - cb_error (_("H literals must contain at least one character")); - goto error; - } - plex_buff[currlen] = 0; - } - if (unlikely (currlen > 16)) { - snprintf (err_msg, COB_MINI_MAX, - _("literal length %d exceeds %d characters"), - (int) currlen, 16); - error_literal ("hex", plex_buff); - goto error; - } - - for (p = plex_buff; *p != 0; p++) { - c = (int) *p; - if ('0' <= c && c <= '9') { - c = c - '0'; - } else if ('A' <= c && c <= 'F') { - c = c - 'A' + 10; - } else if ('a' <= c && c <= 'f') { - c = c - 'a' + 10; - } else { - snprintf (err_msg, COB_MINI_MAX, - _("literal contains invalid character '%c'"), c); - error_literal (type, plex_buff); - /* By not breaking immediately, we detect any following - invalid chars - */ - continue; - } - - val = (val << 4) + c; - } - - if (type[1] == '#') { - /* limit for ACUCOBOL literals: UINT_MAX */ - if (val > UINT_MAX) { - snprintf (err_msg, COB_MINI_MAX, - _("literal exceeds limit %u"), UINT_MAX); - error_literal (type, plex_buff); - } - } - - if (literal_error) { - goto error; - } - - /* Duplication? */ - sprintf ((char *)plex_buff, CB_FMT_LLU, val); - yylval = cb_build_numeric_literal (0, (const void *)plex_buff, 0); - - RETURN_TOK (LITERAL); - -error: - yylval = cb_error_node; - RETURN_TOK (LITERAL); -} - -static int -scan_b (const char *text, const char *type) -{ - /* FIXME: COBOL 2014 allows up to 8,192 boolean characters - COBOL 2002 allows up to 160 boolean characters - --> both identical to "literal-length" maximum - GnuCOBOL currently only supports 64 boolean characters, - check if it works to concatenate after 64 characters, similar to read_literal() - */ - - size_t currlen; - char *p; - cob_u64_t val = 0; - int c; - - literal_error = 0; - - /* currlen can include the terminating quote */ - currlen = strlen (text); - - if (type[1] == 0) { - if (!cb_verify (cb_numeric_boolean, _("numeric boolean literal"))) { - goto error; /* early exit possible as complete literal is consumed */ - } - if (currlen == 1) { - cb_verify (cb_zero_length_lit, _("zero-length literal")); - cb_warning (COBC_WARN_FILLER, - _("Boolean literal has zero length; B'0' will be assumed")); - /* FIXME: we should really build a boolean literal... */ - yylval = cb_build_numeric_literal (0, "0", 0); - RETURN_TOK (LITERAL); - } - } else { - if (!cb_verify (cb_acu_literals, _("ACUCOBOL numeric literal"))) { - goto error; /* early exit possible as complete literal is consumed */ - } - }; - if (unlikely (currlen >= plex_size)) { - currlen = plex_size - 1; - } - memcpy (plex_buff, text, currlen + 1); - if (type[1] == 0) { - currlen--; - } - plex_buff[currlen] = 0; - if (unlikely (currlen > 64)) { - snprintf (err_msg, COB_MINI_MAX, - _("literal length %d exceeds %d characters"), - (int) currlen, 64); - error_literal (type, plex_buff); - goto error; - } - - for (p = plex_buff; *p != 0; p++) { - c = (int) *p; - if (c == '0') { - c = 0; - } else if (c == '1') { - c = 1; - } else { - snprintf (err_msg, COB_MINI_MAX, - _("literal contains invalid character '%c'"), c); - error_literal (type, plex_buff); - continue; - } - - val = (val << 1) + c; - } - if (type[1] == '#') { - /* limit for ACUCOBOL literals: UINT_MAX */ - if (val > UINT_MAX) { - snprintf (err_msg, COB_MINI_MAX, - _("literal exceeds limit %u"), UINT_MAX); - error_literal (type, plex_buff); - } - } - - if (literal_error) { - goto error; - } - - sprintf ((char *)plex_buff, CB_FMT_LLU, val); - /* FIXME: we should likely build a boolean literal ... */ - yylval = cb_build_numeric_literal (0, (const void *)plex_buff, 0); - - RETURN_TOK (LITERAL); - - error: - yylval = cb_error_node; - RETURN_TOK (LITERAL); -} - -static int -scan_o (const char *text, const char *type) -{ - size_t currlen; - char *p; - cob_u64_t val = 0; - int c; - - literal_error = 0; - - if (type[0] == '%') { - if (!cb_verify (cb_hp_octal_literals, _("HP COBOL octal literal"))) { - goto error; /* early exit possible as complete literal is consumed */ - } - } else { - if (!cb_verify (cb_acu_literals, _("ACUCOBOL numeric literal"))) { - goto error; /* early exit possible as complete literal is consumed */ - } - } - - currlen = strlen (text); - memcpy (plex_buff, text, currlen + 1); - if (unlikely (currlen > 22)) { - snprintf (err_msg, COB_MINI_MAX, - _("literal length %d exceeds %d characters"), - (int) currlen, 22); - error_literal (type, plex_buff); - goto error; - } - - for (p = plex_buff; *p != 0; p++) { - c = (int) *p; - if (!('0' <= c && c <= '7')) { - snprintf (err_msg, COB_MINI_MAX, - _("literal contains invalid character '%c'"), c); - error_literal (type, plex_buff); - continue; - } - - c = c - '0'; - val = (val << 3) + c; - } - /* limit for ACUCOBOL literals: UINT_MAX */ - if (val > UINT_MAX) { - snprintf (err_msg, COB_MINI_MAX, - _("literal exceeds limit %u"), UINT_MAX); - error_literal (type, plex_buff); - } - - if (literal_error) { - goto error; - } - - if (type[0] == '%') { - /* actually the rules specify that the literal type is context-sensitive - and for alphanumeric right-filled with NULL, therefore we'd need - a special type of literal here */ - CB_UNFINISHED ("HP COBOL octal literals"); -#if 0 /* activate to have all %literals to be alphanumeric */ - char xbuff[19]; - sprintf ((char *)&xbuff, "'%X'", (unsigned int)val); - cobc_force_literal = 0; - RETURN_TOK (scan_x ((const char *)&xbuff + 1, "X")); -#endif - } - - sprintf ((char *)plex_buff, CB_FMT_LLU, val); - yylval = cb_build_numeric_literal (0, (const void *)plex_buff, 0); - - RETURN_TOK (LITERAL); - - error: - yylval = cb_error_node; - RETURN_TOK (LITERAL); -} - -static int -get_sign (const char sign) -{ - if (sign == '+') { - return 1; - } else if (sign == '-') { - return -1; - } else { - return 0; - } -} - -#define INCREMENT_IF_SIGNED(text, sign) \ - do { \ - if (sign) { \ - (text)++; \ - } \ - } ONCE_COB - -static int -scan_numeric (const char *text) -{ - char *p = (char *)text; - char *s; - int sign; - int scale; - - /* Get sign */ - sign = get_sign (*p); - INCREMENT_IF_SIGNED (p, sign); - - /* Get decimal point */ - s = strchr (p, current_program->decimal_point); - if (s) { - scale = (int)strlen (s) - 1; - /* Remove decimal point */ - /* Moves trailing null */ - memmove (s, s + 1, (size_t)scale + 1); - } else { - scale = 0; - } - - /* Note that leading zeroes are not removed from the literal. */ - - if (unlikely (strlen (p) > COB_MAX_DIGITS)) { - /* Absolute limit */ - snprintf (err_msg, COB_MINI_MAX, - _("literal length %d exceeds maximum of %d digits"), - (int) strlen (p), COB_MAX_DIGITS); - error_literal ("num", text); - yylval = cb_error_node; - } else if (unlikely (strlen (p) > cb_numlit_length)) { - snprintf (err_msg, COB_MINI_MAX, - _("literal length %d exceeds %d digits"), - (int) strlen (p), cb_numlit_length); - error_literal ("num", text); - yylval = cb_error_node; - } else { - yylval = cb_build_numeric_literal (sign, p, scale); - } - RETURN_TOK (LITERAL); -} - -static int -all_zeroes (const char *str) -{ - int i; - - for (i = 0; str[i] != '\0'; ++i) { - if (str[i] != '0') { - return 0; - } - } - - return 1; -} - -static int -significand_is_zero (const char *int_part, const char *dec_part) -{ - return all_zeroes (int_part) - && all_zeroes (dec_part); -} - -/* Note: Exponent *digits* in literals according to COBOL 202x: 36 */ -/* Note: Exponent *digits* in literals according to COBOL 202x: 36 */ -#if COB_FLOAT_DIGITS_MAX != 36 -#error COB_FLOAT_DIGITS_MAX adjustment needed, common.h must match scanner.l -#endif -#define COB_FLOAT_DIGITS_CHCK_MAX 38 /* incl. sign and comma */ -#define COB_FLOAT_DIGITS_STR_WIDTH 39 -#define COB_FLOAT_DIGITS_STR_MAX 40 - -#define COB_FLOAT_DIGITS_WIDTH "%" CB_XSTRINGIFY(COB_FLOAT_DIGITS_STR_WIDTH) - -static int -scan_floating_numeric (const char *text) -{ - size_t sig_int_len; - size_t sig_dec_len; - int sig_sign; - int exp_sign; - int scale; - int exponent; - int n; - char significand_str[COB_FLOAT_DIGITS_STR_MAX] = { '\0' }; - char *significand_pos; - char significand_dec[COB_FLOAT_DIGITS_STR_MAX] = { '\0' }; - char significand_int[COB_FLOAT_DIGITS_STR_MAX] = { '\0' }; - char exponent_str[8] = { '\0' }; - char *exponent_pos; - - char result[128] = { '\0' }; - - literal_error = 0; - - /* Separate into significand and exponent */ - n = sscanf (text, COB_FLOAT_DIGITS_WIDTH "[0-9.,+-]%*1[Ee]%7[0-9.,+-]", - significand_str, exponent_str); - /* We check the return for silencing warnings, but - this should actually never happen as the flex rule ensures this */ - /* LCOV_EXCL_START */ - if (n == 0) { -#if 1 - /* This should never happen (and therefore doesn't get a translation) */ - cb_error ("flex rule for scan_floating_numeric is wrong"); - COBC_ABORT(); -#else - yylval = cb_error_node; - RETURN_TOK (LITERAL); -#endif - } - /* LCOV_EXCL_STOP */ - - /* Get signs and adjust string positions accordingly */ - significand_pos = &significand_str[0]; - sig_sign = get_sign (*significand_pos); - INCREMENT_IF_SIGNED (significand_pos, sig_sign); - - exponent_pos = &exponent_str[0]; - exp_sign = get_sign (*exponent_pos); - INCREMENT_IF_SIGNED (exponent_pos, exp_sign); - - /* Separate significand into integer and decimal */ - n = sscanf (significand_pos, - COB_FLOAT_DIGITS_WIDTH "[0-9]%*1[.,]" COB_FLOAT_DIGITS_WIDTH "[0-9]", - significand_int, significand_dec); - if (n == 0) { /* no integer part, copy after decimal-point */ - significand_int[0] = 0; - strncpy (significand_dec, significand_pos + 1, COB_FLOAT_DIGITS_STR_MAX); - significand_dec[COB_FLOAT_DIGITS_STR_MAX - 1] = 0; - } else { - /* silencing some warnings */ - significand_int[COB_FLOAT_DIGITS_STR_MAX - 1] = 0; - significand_dec[COB_FLOAT_DIGITS_STR_MAX - 1] = 0; - } - - /* Validation and exponent handling */ - sig_int_len = strlen (significand_int); - sig_dec_len = strlen (significand_dec); - exponent = 0; - - if (sig_int_len + sig_dec_len > COB_FLOAT_DIGITS_MAX) { - /* note: same message in tree.c for floating-point numeric-edited item */ - snprintf (err_msg, COB_MINI_MAX, - _("significand has more than %d digits"), COB_FLOAT_DIGITS_MAX); - error_literal ("float", text); - } else { - if (strchr (exponent_pos, current_program->decimal_point)) { - snprintf (err_msg, COB_MINI_MAX, - _("exponent has decimal point")); - error_literal ("float", text); - } else { - if (strlen (exponent_pos) > 4) { - /* note: same message in tree.c for floating-point numeric-edited item */ - snprintf (err_msg, COB_MINI_MAX, - _("exponent has more than 4 digits")); - error_literal ("float", text); - } else { - n = sscanf (exponent_pos, "%d", &exponent); - /* We check the return for silencing warnings, but - this should actually never happen as the flex rule ensures this */ - /* LCOV_EXCL_START */ - if (n == 0) { -#if 1 - /* This should never happen (and therefore doesn't get a translation) */ - cb_error ("flex rule for scan_floating_numeric is wrong"); - COBC_ABORT(); -#else - yylval = cb_error_node; - RETURN_TOK (LITERAL); -#endif - } - /* LCOV_EXCL_STOP */ - } - - if (exp_sign == -1) { - exponent = -exponent; - } - - /* "The maximum permitted value and minimum permitted value of - the exponent is implementor-defined" */ - /* Exponent range -383 thru +384 for FLOAT-DECIMAL-16 */ - /* Exponent range -6143 thru +6144 for FLOAT-DECIMAL-34 */ - if (!(-6143 <= exponent && exponent <= 6144)) { - snprintf (err_msg, COB_MINI_MAX, - _("exponent not between -6143 and 6144")); - error_literal ("float", text); - } - } - } - - if (significand_is_zero (significand_int, significand_dec)) { - if (sig_sign == -1) { - snprintf (err_msg, COB_MINI_MAX, - _("significand of 0 must be positive")); - error_literal ("float", text); - } - if (exponent != 0) { - snprintf (err_msg, COB_MINI_MAX, - _("exponent of 0 must be 0")); - error_literal ("float", text); - } - if (exp_sign == -1) { - snprintf (err_msg, COB_MINI_MAX, - _("exponent of 0 must be positive")); - error_literal ("float", text); - } - } - - if (literal_error) { - yylval = cb_error_node; - RETURN_TOK (LITERAL); - } - - /* Literal data */ - strcpy (result, significand_int); - strcat (result, significand_dec); - - /* Determine scale */ - /* Base scale is decimal part of the significant */ - scale = (int)sig_dec_len; - if (exponent < 0) { - /* Decimals; power down by scale difference */ - scale = - (exponent - scale); - } else if (exponent > 0) { - /* No decimals; power up by scale difference */ - if (exponent >= scale) { - scale = - (exponent - scale); - } else { - scale -= exponent; - } - } - - yylval = cb_build_numeric_literal (sig_sign, result, - scale); - RETURN_TOK (LITERAL); -} - -static void -scan_picture (const char *text) -{ - unsigned char *p; - - /* Scan a PICTURE clause */ - /* Normalize the input */ - for (p = (unsigned char *)text; *p; p++) { - /* unput trailing '.' or ',' */ - if (p[1] == 0 && (*p == '.' || *p == ',')) { - unput (*p); - *p = 0; - break; - } - *p = (unsigned char)toupper (*p); - } - - yylval = cb_build_picture (text); -} - -static void -count_lines (const char *text) -{ - const char *p; - - /* Count newlines in text */ - for (p = text; *p; p++) { - if (*p == '\n') { - cb_source_line++; - } - } -} - -static void -cb_add_const_var (const char *name, cb_tree value) -{ - cb_tree x; - struct cb_level_78 *p78; - struct cb_field *f; - - /* Add an inline constant */ - x = cb_build_constant (cb_build_reference (name), value); - f = CB_FIELD (x); - f->flag_item_78 = 1; - f->flag_is_global = 1; - f->flag_internal_constant = 1; - f->level = 1; - (void)cb_validate_78_item (f, 1); - - /* Add constant item */ - p78 = cobc_malloc (sizeof(struct cb_level_78)); - p78->fld_78 = f; - p78->prog = NULL; - p78->name_len = (cob_u32_t)strlen (f->name); - /* RXWRXW - Check this */ - p78->chk_const = 0; - if (!const_78_ptr) { - p78->last = p78; - } else { - p78->last = const_78_ptr->last; - } - p78->next = const_78_ptr; - p78->glob_next = const_78_ptr; - const_78_ptr = p78; - if (glob_lev_78_ptr) { - glob_lev_78_ptr->last->glob_next = const_78_ptr; - } else if (lev_78_ptr) { - lev_78_ptr->last->glob_next = const_78_ptr; - } else { - top_78_ptr = const_78_ptr; - } -} - - -/* duplicate the given literal to assign a different source location */ -static void * -copy_literal (cb_tree l) -{ - cb_tree x; - - /* LCOV_EXCL_START */ - if (!CB_LITERAL_P(l)) { - cobc_err_msg (_("unexpected tree tag: %d"), (int)CB_TREE_TAG (l)); - COBC_ABORT (); - } - /* LCOV_EXCL_STOP */ - - x = cobc_parse_malloc (sizeof (struct cb_literal)); - memcpy (x, l, sizeof (struct cb_literal)); - - return x; -} - -static void -scan_define_options (const char *text) -{ - char *p; - char *s; - char *var; - const struct cb_level_78 *p78; - char *q; - unsigned char *t; - cb_tree x; - size_t size; - int scale; - int sign, override; - - /* Scan a source inline define */ - p = cobc_strdup (text); - - q = &p[strlen(p)-1]; - while(q != p - && (isspace(*q) || *q == '\n' || *q == '\r')) - q--; - q = q - 7; - if (memcmp(q,"OVERRIDE",8) == 0) { - override = 1; - while (q[-1] == ' ') q--; - strcpy(q,"\n"); - } else { - override = 0; - } - - /* Ignore first part */ - s = strtok (p, " "); - - /* Variable name */ - s = strtok (NULL, " \n"); - if (!s) { - cobc_free (p); - return; - } - - /* Check for already defined constant */ - if (!override) { - for (p78 = top_78_ptr; p78; p78 = p78->glob_next) { - if (strcasecmp (s, p78->fld_78->name) == 0) { - cobc_free (p); - return; - } - } - } - - var = cobc_strdup (s); - - /* Value */ - s = strtok (NULL, "\n"); - if (!s) { - cb_error (_("invalid CONSTANT: %s"), var); - goto freevar; - } - - if (*s == '"' || *s == '\'') { - /* Alphanumeric literal */ - sign = *s; - size = strlen (s); - q = s + size - 1; - if (q == s || *q != sign) { - cb_error (_("invalid alphanumeric CONSTANT: %s"), s); - goto freevar; - } - if (size < 3) { - cb_error (_("empty alphanumeric CONSTANT: %s"), s); - goto freevar; - } - *q = 0; - size -= 2; - x = cb_build_alphanumeric_literal (s + 1, size); - } else { - /* Get sign */ - sign = get_sign (*s); - INCREMENT_IF_SIGNED (s, sign); - - /* Get decimal point */ - scale = 0; - q = strchr (s, '.'); - if (q) { - scale = (int)strlen (q) - 1; - if (scale < 1) { - cb_error (_("invalid numeric CONSTANT: %s"), s); - goto freevar; - } - /* Remove decimal point */ - memmove (q, q + 1, (size_t)scale + 1); - } - for (t = (unsigned char *)s; *t; ++t) { - if (*t < '0' || *t > '9') { - cb_error (_("invalid numeric CONSTANT: %s"), s); - goto freevar; - } - } - if (strlen (s) > COB_MAX_DIGITS) { - cb_error (_("invalid numeric CONSTANT: %s"), s); - goto freevar; - } - - x = cb_build_numeric_literal (sign, s, scale); - } - /* Add to constant list */ - cb_add_const_var (var, x); - -freevar: - cobc_free (p); - cobc_free (var); -} - -#undef INCREMENT_IF_SIGNED - -/* - For yytext of the form '#directive "a-word"' or '#directive - (a-word)', copy a-word into word. -*/ -static void -copy_word_in_quotes (char ** const word) -{ - char *text = cobc_strdup (yytext); - char *word_str; - - /* Skip directive */ - word_str = strtok (text, " "); - - /* Get word and remove quotes */ - word_str = strtok (NULL, "\n"); - *word = cobc_malloc (strlen (word_str) - 1); - strncpy (*word, word_str + 1, strlen (word_str) - 2); - - cobc_free (text); -} - -/* - For yytext of the form '#directive "first-word" "second-word"' or '#directive - (first-word) (second-word)', allocate copies of first-word for word1 and - second-word for word2. -*/ -static void -copy_two_words_in_quotes (char ** const word1, char ** const word2) -{ - char *text = cobc_strdup (yytext); - char *word1_str; - char *word2_str; - - /* Skip directive. */ - word1_str = strtok (text, " "); - - /* Get words and remove surrounding quotes. */ - - word1_str = strtok (NULL, " "); - *word1 = cobc_malloc (strlen (word1_str) - 1); - strncpy (*word1, word1_str + 1, strlen (word1_str) - 2); - - word2_str = strtok (NULL, "\n"); - *word2 = cobc_malloc (strlen (word2_str) - 1); - strncpy (*word2, word2_str + 1, strlen (word2_str) - 2); - - cobc_free (text); -} - -static void -add_synonym (const int synonym_replaces_original) -{ - char *word; - char *synonym; - - copy_two_words_in_quotes (&word, &synonym); - - if (!is_default_reserved_word (word)) { - cb_error (_("'%s' is not a default reserved word, so cannot be aliased"), - word); - } else if (is_reserved_word (synonym)) { - cb_error (_("'%s' is already reserved; you may want MAKESYN instead"), - synonym); - } else { - if (synonym_replaces_original) { - remove_reserved_word_now (word); - } - add_reserved_word_now (synonym, word); - } - - cobc_free (word); - cobc_free (synonym); -} - -/* Global functions */ - -void -ylex_clear_all (void) -{ - /* Clear buffers after parsing all source elements */ - if (pic_buff2) { - cobc_free (pic_buff2); - pic_buff2 = NULL; - } - if (pic_buff1) { - cobc_free (pic_buff1); - pic_buff1 = NULL; - } - if (plex_buff) { - cobc_free (plex_buff); - plex_buff = NULL; - } - plex_size = 0; - pic1_size = 0; - pic2_size = 0; - - cb_reset_78 (); - cb_reset_global_78 (); -} - -void -ylex_call_destroy (void) -{ - /* Release flex buffers */ - (void)yylex_destroy (); - const_78_ptr = NULL; -} - -void -cb_unput_dot (void) -{ - unput ('.'); -} - -void -cb_reset_78 (void) -{ - struct cb_level_78 *p78; - struct cb_level_78 *p782; - - /* Remove constant (78 level) items for current program */ - for (p78 = lev_78_ptr; p78; ) { - p782 = p78->next; - cobc_free (p78); - p78 = p782; - } - lev_78_ptr = NULL; - for (p78 = glob_lev_78_ptr; p78; p78 = p78->next) { - p78->not_const = 0; - } - if (glob_lev_78_ptr) { - top_78_ptr = glob_lev_78_ptr; - } else { - top_78_ptr = const_78_ptr; - } -} - -void -cb_reset_global_78 (void) -{ - struct cb_level_78 *p78; - struct cb_level_78 *p782; - - /* Remove constant (78 level) items for top program */ - for (p78 = glob_lev_78_ptr; p78; ) { - p782 = p78->next; - cobc_free (p78); - p78 = p782; - } - glob_lev_78_ptr = NULL; - top_78_ptr = const_78_ptr; -} - -void -cb_add_78 (struct cb_field *f) -{ - struct cb_level_78 *p78; - - /* Add a constant (78 level) item */ - p78 = cobc_malloc (sizeof(struct cb_level_78)); - p78->fld_78 = f; - p78->prog = current_program; - p78->name_len = (cob_u32_t)strlen (f->name); - if (f->flag_is_global) { - if (!glob_lev_78_ptr) { - p78->last = p78; - } else { - p78->last = glob_lev_78_ptr->last; - } - p78->last->glob_next = const_78_ptr; - p78->next = glob_lev_78_ptr; - p78->glob_next = glob_lev_78_ptr; - p78->chk_const = 1; - glob_lev_78_ptr = p78; - if (lev_78_ptr) { - lev_78_ptr->last->glob_next = glob_lev_78_ptr; - } else { - top_78_ptr = glob_lev_78_ptr; - } - } else { - if (!lev_78_ptr) { - p78->last = p78; - } else { - p78->last = lev_78_ptr->last; - } - if (glob_lev_78_ptr) { - p78->last->glob_next = glob_lev_78_ptr; - } else { - p78->last->glob_next = const_78_ptr; - } - p78->next = lev_78_ptr; - p78->glob_next = lev_78_ptr; - lev_78_ptr = p78; - top_78_ptr = lev_78_ptr; - } -} - -struct cb_field * -check_level_78 (const char *name) -{ - const struct cb_level_78 *p78; - - /* Check against a current constant (78 level) */ - for (p78 = lev_78_ptr; p78; p78 = p78->next) { - if (strcasecmp (name, p78->fld_78->name) == 0) { - return p78->fld_78; - } - } - /* Check against a global constant (78 level) */ - for (p78 = glob_lev_78_ptr; p78; p78 = p78->next) { - if (strcasecmp (name, p78->fld_78->name) == 0) { - return p78->fld_78; - } - } - return NULL; -} - -/* - Find program with the program-name name in defined_prog_list. If it is not - there, return NULL. -*/ -struct cb_program * -cb_find_defined_program_by_name (const char *name) -{ - int (*cmp_func)(const char *, const char *); - cb_tree l; - cb_tree x; - - if (cb_fold_call) { - cmp_func = &strcasecmp; - } else { - cmp_func = &strcmp; - } - - for (l = defined_prog_list; l; l = CB_CHAIN (l)) { - x = CB_VALUE (l); - if ((*cmp_func)(name, CB_PROGRAM (x)->program_name) == 0) { - return CB_PROGRAM (x); - } - } - - return NULL; -} - -struct cb_program * -cb_find_defined_program_by_id (const char *orig_id) -{ - cb_tree l; - cb_tree x; - - for (l = defined_prog_list; l; l = CB_CHAIN (l)) { - x = CB_VALUE (l); - if (strcmp (orig_id, CB_PROGRAM (x)->orig_program_id) == 0) { - return CB_PROGRAM (x); - } - } - - return NULL; -} diff -Nru gnucobol-4.0~early~20200606/cobc/sqlxfdgen.c gnucobol-5/cobc/sqlxfdgen.c --- gnucobol-4.0~early~20200606/cobc/sqlxfdgen.c 2020-06-06 20:51:59.000000000 +0000 +++ gnucobol-5/cobc/sqlxfdgen.c 1970-01-01 00:00:00.000000000 +0000 @@ -1,1439 +0,0 @@ -/* - Copyright (C) 2019-2020 Free Software Foundation, Inc. - Written by Ron Norman, Simon Sobisch - - This file is part of GnuCOBOL. - - The GnuCOBOL compiler is free software: you can redistribute it - and/or modify it under the terms of the GNU General Public License - as published by the Free Software Foundation, either version 3 of the - License, or (at your option) any later version. - - GnuCOBOL is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with GnuCOBOL. If not, see . -*/ - - -#include - -#include -#include -#include -#include -#include -#include -#include -#include - -#include "tarstamp.h" - -#include "cobc.h" -#include "tree.h" - -#define MAX_XFD 24 -static int hasxfd = 0; -static char xfd[MAX_XFD][80]; - -#define MAX_DATE 24 -static int ndate = 0; -static char dateformat[MAX_DATE][40]; - -#define MAX_OCC_NEST 16 -static char eol[6] = ""; -static char prefix[8] = ""; -static int prefixlen = 0; -static int next_lbl = 1; -static short COMPtoDig[10] = {3,8,11,13,16,18,21,23,27}; /* SQL storage size for Binary field */ - -void -cb_save_xfd (char *str) -{ - if (cb_sqldb_name == NULL) { - hasxfd = 0; - return; - } - if (hasxfd >= MAX_XFD) { - cb_error (_("XFD table overflow at: %s"), str); - return; - } - if (strcasecmp(str,"ALL") == 0) { /* ALL files are implied XFD */ - cb_all_files_xfd = 1; - return; - } - strcpy(xfd[hasxfd],str); - hasxfd++; -} - -/* Local functions */ - -static int -find_date (struct cb_field *f) -{ - int k; - for (k=0; k < ndate; k++) { - if (strcmp (dateformat[k], f->sql_date_format) == 0) - return k; - } - return -1; -} - -static void -save_date (struct cb_field *f) -{ - do { - if (f->level < 1 - || f->level >= 66) { - f = f->sister; - if (f == NULL) - return; - continue; - } - if (f->children) { - save_date (f->children); - } - if (f->sql_date_format && ndate < MAX_DATE) { - int k; - for (k=0; k < ndate; k++) { - if (strcmp (dateformat[k], f->sql_date_format) == 0) - break; - } - if (k == ndate) { - strcpy (dateformat[ndate++], f->sql_date_format); - } - } - f = f->sister; - } while (f); -} - -/* - * Parse the Date Format String - * Returns NULL if all good, else address of bad character in 'format' - */ -static char * -cb_date_str ( struct sql_date *sdf, char *format) -{ - int len, pos, extra; - char *dp; - struct sql_date lcl[1]; - - if (sdf == NULL) - sdf = lcl; - memset((void*)sdf,0,sizeof(struct sql_date)); - strcpy(sdf->format,format); - len = strlen(sdf->format); - if (sdf->format[0] == '\'') { - if (sdf->format[len-1] == '\'') - sdf->format[len-1] = 0; - memmove(sdf->format,sdf->format+1,len); - } else if (sdf->format[0] == '"') { - if (sdf->format[len-1] == '"') - sdf->format[len-1] = 0; - memmove(sdf->format,sdf->format+1,len); - } - sdf->hasTime = 0; - sdf->hasDate = 0; - sdf->yyRule = ' '; - dp = sdf->format; - len = pos = extra = 0; - while(*dp != 0) { - len = 0; - if(*dp == 'Y') { /* Year */ - sdf->hasDate = 1; - sdf->yyPos = (unsigned char)pos; - while(*dp == 'Y') { - len++; - dp++; - pos++; - } - sdf->yyLen = (unsigned char)len; - if(*dp == '+' /* '+' Add to YY to get full year */ - || *dp == '%') { /* '%' define pivot year to compute full year */ - sdf->yyRule = *dp; - dp++; - sdf->yyAdj = 0; - while(isdigit(*dp)) { - sdf->yyAdj = (sdf->yyAdj * 10) + (*dp - '0'); - dp++; - } - } - } else if(*dp == 'M') { - if(dp[1] == 'I') { /* MInutes */ - sdf->hasTime = 1; - sdf->miPos = (unsigned char)pos; - sdf->miLen = 2; - dp += 2; - pos += 2; - } else { - sdf->hasDate = 1; - sdf->mmPos = (unsigned char)pos; - while(*dp == 'M') { /* Month */ - len++; - dp++; - pos++; - } - sdf->mmLen = (unsigned char)len; - } - } else if(*dp == 'D') { /* Day of Month */ - sdf->hasDate = 1; - sdf->ddPos = (unsigned char)pos; - while(*dp == 'D') { - len++; - dp++; - pos++; - } - sdf->ddLen = len; - } else if(*dp == 'C') { /* Century */ - sdf->hasDate = 1; - sdf->ccPos = (unsigned char)pos; - while(*dp == 'C') { - len++; - dp++; - pos++; - } - sdf->ccLen = len; - } else if(*dp == 'H') { /* Hour */ - sdf->hasTime = 1; - sdf->hhPos = (unsigned char)pos; - while(*dp == 'H') { - len++; - dp++; - pos++; - } - sdf->hhLen = (unsigned char)len; - if(memcmp(dp,"24",2) == 0) - dp += 2; - else if(memcmp(dp,"12",2) == 0) - dp += 2; - } else if(*dp == 'S') { /* Seconds */ - sdf->hasTime = 1; - sdf->ssPos = pos; - while(*dp == 'S') { - len++; - dp++; - pos++; - } - sdf->ssLen = len; - } else if(*dp == 'U') { /* Hundredths of Second */ - sdf->hasTime = 1; - sdf->huPos = pos; - while(*dp == 'U') { - len++; - dp++; - pos++; - } - sdf->huLen = (unsigned char)len; - } else if (*dp == '/' - || *dp == '-' - || *dp == ' ' - || *dp == '.' - || *dp == ':') { /* Noise/editing characters */ - dp++; - pos++; - extra++; - } else { - return dp; - } - } - sdf->digits = (unsigned char)(sdf->ccLen + sdf->yyLen + sdf->mmLen + sdf->ddLen - + sdf->hhLen + sdf->miLen + sdf->ssLen + sdf->huLen - + extra); - return NULL; -} - -static char * -cb_get_param (char *p, char *prm, int skipeq) -{ - char eq = 0x01; - char qt = 0x00; - if (skipeq) - eq = '='; - while (isspace(*p) || *p == eq) p++; - if (*p == '"' || *p == '\'') { - qt = *p; - do { - *prm++ = *p++; - } while (*p != 0 && *p != qt); - if (*p == qt) - *prm++ = *p++; - } else { - while (*p != 0 && *p != ',' - && *p != eq && !isspace(*p)) { - *prm++ = *p++; - } - } - *prm = 0; - while (*p == ',' || isspace(*p)) p++; - return p; -} - -static void -cb_use_name (struct cb_field *f, char *n) -{ - if(*n > ' ') { - if (f->sql_name) { - cb_source_line--; - cb_warning (cb_warn_extra, _("XFD replaced %s with %s for %s"), - f->sql_name, n, f->name); - cb_source_line++; - } - f->sql_name = cobc_parse_strdup (n); - } -} - -static int -compstr(char *tst, const char *val) -{ - int k; - for (k=0; tst[k] != 0; k++) { - if (tst[k] == '-' || tst[k] == '_') { - if (val[k] != '-' && val[k] != '_') - return 1; - continue; - } - if (toupper (tst[k]) != toupper (val[k])) - return 1; - } - if (val[k] != 0) - return 1; - return 0; -} - -void -cb_parse_xfd (struct cb_file *fn, struct cb_field *f) -{ - int k, skipeq; - char *p, p1[64], p2[64], p3[64], p4[64], *pw, expr[COB_NORMAL_BUFF]; - if (hasxfd <= 0) - return; - if (!fn->flag_sql_xfd) { - fn->max_sql_name_len = 24; - fn->flag_sql_trim_prefix = 1; - fn->flag_sql_xfd = 1; - } - for(k=0; k < hasxfd; k++) { - pw = cb_get_param (xfd[k], p1, 1); - if (compstr(p1,"WHEN") == 0 - || compstr(p1,"DATE") == 0 - || compstr(p1,"AND") == 0 - || compstr(p1,"OR") == 0) - skipeq = 0; - else - skipeq = 1; - p = cb_get_param (pw, p2, skipeq); - p = cb_get_param (p, p3, skipeq); - p = cb_get_param (p, p4, skipeq); - if (compstr(p1,"USE") == 0) { - strcpy(p1,p2); - strcpy(p2,p3); - strcpy(p3,p4); - strcpy(p4,""); - } - if (compstr(p1,"NAME") == 0 - && p2[0] > ' ') { - if (f->level == 1 - && fn->sql_name == NULL) { - fn->sql_name = cobc_parse_strdup (p2); - } else { - cb_use_name (f, p2); - } - } else if (compstr(p1,"GROUP") == 0) { - f->flag_sql_group = 1; - if (compstr(p2,"BINARY") == 0) { - f->flag_sql_binary = 1; - cb_use_name (f, p3); - } else if (compstr(p2,"ALPHA") == 0) { - f->flag_sql_char = 1; - cb_use_name (f, p3); - } else if (compstr(p2,"CHAR") == 0) { - f->flag_sql_char = 1; - cb_use_name (f, p3); - } else if (compstr(p2,"VAR_LENGTH") == 0) { - f->flag_sql_varchar = 1; - cb_use_name (f, p3); - } else if (compstr(p2,"VARCHAR") == 0) { - f->flag_sql_varchar = 1; - cb_use_name (f, p3); - } else if (compstr(p2,"NUMERIC") == 0) { - f->flag_sql_numeric = 1; - cb_use_name (f, p3); - } else { - cb_use_name (f, p2); - } - } else if (compstr(p1,"BINARY") == 0) { - f->flag_sql_binary = 1; - f->flag_sql_group = 1; - cb_use_name (f, p2); - } else if (compstr(p1,"ALPHA") == 0) { - f->flag_sql_char = 1; - f->flag_sql_group = 1; - cb_use_name (f, p2); - } else if (compstr(p1,"CHAR") == 0) { - f->flag_sql_char = 1; - f->flag_sql_group = 1; - cb_use_name (f, p2); - } else if (compstr(p1,"VAR_LENGTH") == 0) { - f->flag_sql_varchar = 1; - f->flag_sql_group = 1; - cb_use_name (f, p2); - } else if (compstr(p1,"VARCHAR") == 0) { - f->flag_sql_varchar = 1; - f->flag_sql_group = 1; - cb_use_name (f, p2); - } else if (compstr(p1,"NUMERIC") == 0) { - f->flag_sql_numeric = 1; - cb_use_name (f, p2); - } else if (compstr(p1,"DATE") == 0) { - char *err; - int len; - if(p2[0] > ' ') { - len = strlen(p2); - if (p2[0] == '\'') { - if (p2[len-1] == '\'') - p2[len-1] = 0; - memmove(p2,p2+1,len); - } else if (p2[0] == '"') { - if (p2[len-1] == '"') - p2[len-1] = 0; - memmove(p2,p2+1,len); - } - f->sql_date_format = cobc_parse_strdup (p2); - } else { - f->sql_date_format = cobc_parse_strdup ("YYYYMMDD"); - } - if ((err = cb_date_str (NULL, f->sql_date_format)) != NULL) { - cb_source_line--; - cb_error (_("DATE %s incorrect at '%c'"), f->sql_date_format, *err); - cb_source_line++; - cobc_parse_free (f->sql_date_format); - f->sql_date_format = NULL; - } else { - f->flag_sql_date = 1; - } - cb_use_name (f, p3); - } else if (compstr(p1,"WHEN") == 0) { - if (f->sql_when == NULL) { - snprintf(expr,sizeof(expr),"%s",pw); - } else { - snprintf(expr,sizeof(expr),"(%s) OR (%s)",f->sql_when,pw); - cobc_parse_free (f->sql_when); - } - f->sql_when = cobc_parse_strdup (expr); - } else if (compstr(p1,"AND") == 0 - || compstr(p1,"OR") == 0) { - if (f->sql_when == NULL) { - snprintf(expr,sizeof(expr),"%s",pw); - } else { - snprintf(expr,sizeof(expr),"(%s) %s (%s)",f->sql_when,p1,pw); - cobc_parse_free (f->sql_when); - } - f->sql_when = cobc_parse_strdup (expr); - } else { - cb_source_line--; - cb_warning (cb_warn_extra, _("XFD unknown %s %s"), p1, p2); - cb_source_line++; - } - } - hasxfd = 0; -} - -static struct cb_field * -cb_code_field (cb_tree x) -{ - if (likely(CB_REFERENCE_P (x))) { - if (unlikely(!CB_REFERENCE (x)->value)) { - return CB_FIELD (cb_ref (x)); - } - return CB_FIELD (CB_REFERENCE (x)->value); - } - if (CB_LIST_P (x)) { - return cb_code_field (CB_VALUE (x)); - } - return CB_FIELD (x); -} - -static int -is_all_dispx (struct cb_field *f) -{ - if (f->children - && !is_all_dispx (f->children)) - return 0; - if (f->usage != CB_USAGE_DISPLAY) - return 0; - if (f->sister - && !is_all_dispx (f->sister)) - return 0; - return 1; -} - -/* Is this field all DISPLAY data */ -static int -is_all_display (struct cb_field *f) -{ - if (f->children) - return is_all_dispx (f->children); - if (f->usage != CB_USAGE_DISPLAY) - return 0; - return 1; -} - -static const char *sqlnames[] = { - "BIGINT", - "CHAR", - "CONSTRAINT", - "CREATE", - "DATE", - "DATETIME", - "DECIMAL", - "DOUBLE", - "FLOAT", - "IDENTITY", - "INDEX", - "INTEGER", - "KEY", - "NOT", - "NULL", - "NUMBER", - "PRIMARY", - "SEQUENCE", - "SMALLINT", - "TABLE", - "TIME", - "TIMESTAMP", - "UNIQUE", - "VARCHAR", - "VARCHAR2", - NULL}; - -/* Return the SQL column name */ -static char * -get_col_name (struct cb_file *fl, struct cb_field *f, int sub, int idx[]) -{ - static char name[85]; - int i,j; - if (f->sql_name) { - strcpy(name,f->sql_name); - } else { - i = 0; - if (prefixlen > 0 - && strncasecmp(f->name, prefix, prefixlen) == 0) - i = prefixlen; - for(j=0; f->name[i] != 0; i++) { - if(f->name[i] == '-') { - if (!fl->flag_sql_trim_dash) - name[j++] = '_'; - } else { - name[j++] = f->name[i]; - } - } - name[j] = 0; - } - j = strlen(name); - if (j > fl->max_sql_name_len - && fl->max_sql_name_len > 0) - name[j=fl->max_sql_name_len] = 0; - for(i=0; i < j; i++) { - if(isupper(name[i])) - name[i] = (char)tolower(name[i]); - } - if (sub > 0) { - for (i=0; i < sub; i++) { - j += sprintf(&name[j],"_%02d",idx[i]); - } - } else { - for (i=0; sqlnames[i] != NULL; i++) { - if (strcasecmp(sqlnames[i],name) == 0) { - strcat(name,"_x"); - break; - } - } - } - return name; -} - -/* Return the SQL column data type */ -static char * -get_col_type (struct cb_field *f) -{ - static char datatype[85]; - if (f->flag_sql_binary) { - sprintf(datatype,"BINARY(%d)",f->size); - } else - if (f->flag_sql_char) { - sprintf(datatype,"CHAR(%d)",f->size); - } else - if (f->flag_sql_varchar) { - sprintf(datatype,"VARCHAR(%d)",f->size); - } else - if (f->flag_sql_group) { - sprintf(datatype,"CHAR(%d)",f->size); - } else - if (f->flag_sql_numeric) { - sprintf(datatype,"DECIMAL(%d)",f->size); - } else - if (f->flag_sql_date) { - sprintf(datatype,"DATE"); - } else { - switch (f->usage) { - case CB_USAGE_BINARY: - case CB_USAGE_COMP_5: - case CB_USAGE_COMP_X: - case CB_USAGE_COMP_N: - case CB_USAGE_PACKED: - case CB_USAGE_COMP_6: - if (f->pic) { - if (f->pic->scale > 0) - sprintf(datatype,"DECIMAL(%d,%d)",f->pic->digits,f->pic->scale); - else - sprintf(datatype,"DECIMAL(%d)",f->pic->digits); - } else { - sprintf(datatype,"DECIMAL(%d)",f->size); - } - return datatype; - case CB_USAGE_DISPLAY: - if (f->pic - && f->pic->category == CB_CATEGORY_NUMERIC) { - if (f->pic->scale > 0) - sprintf(datatype,"DECIMAL(%d,%d)",f->pic->digits,f->pic->scale); - else - sprintf(datatype,"DECIMAL(%d)",f->pic->digits); - } else { - sprintf(datatype,"CHAR(%d)",f->size); - } - return datatype; - case CB_USAGE_FLOAT: - return (char*)"FLOAT(23)"; - case CB_USAGE_DOUBLE: - return (char*)"FLOAT(53)"; - case CB_USAGE_UNSIGNED_CHAR: - case CB_USAGE_SIGNED_CHAR: - case CB_USAGE_UNSIGNED_SHORT: - case CB_USAGE_SIGNED_SHORT: - case CB_USAGE_UNSIGNED_INT: - case CB_USAGE_SIGNED_INT: - case CB_USAGE_UNSIGNED_LONG: - case CB_USAGE_SIGNED_LONG: - return (char*)"INTEGER"; - default: - cb_error (_("%s unexpected USAGE: %d"), __FILE__, f->usage); - } - sprintf(datatype,"CHAR(%d)",f->size); - } - return datatype; -} - -/* Return the XFD data type value */ -static char * -get_xfd_type (struct cb_field *f) -{ - int sqlsz = f->size + 1; - int sqltype = COB_XFDT_PICX; - static char datatype[85]; - if (f->flag_sql_binary) { - sqltype = COB_XFDT_BIN; - } else - if (f->flag_sql_char) { - sqltype = COB_XFDT_PICX; - } else - if (f->flag_sql_varchar) { - sqltype = COB_XFDT_VARX; - } else - if (f->flag_sql_group) { - sqltype = COB_XFDT_PICX; - } else { - switch (f->usage) { - case CB_USAGE_BINARY: - case CB_USAGE_LENGTH: - if (f->pic - && f->pic->category == CB_CATEGORY_NUMERIC) { - sqlsz = f->pic->digits + 3; - if (sqlsz < COMPtoDig[f->size-1]) - sqlsz = COMPtoDig[f->size-1]; - if (f->pic->have_sign > 0) - sqltype = COB_XFDT_COMPS; - else - sqltype = COB_XFDT_COMPU; - } else { - sqlsz = COMPtoDig[f->size-1]; - sqltype = COB_XFDT_COMPU; - } - break; - case CB_USAGE_COMP_5: - if (f->pic - && f->pic->category == CB_CATEGORY_NUMERIC) { - sqlsz = f->pic->digits + 3; - if (sqlsz < COMPtoDig[f->size-1]) - sqlsz = COMPtoDig[f->size-1]; - if (f->pic->have_sign > 0) - sqltype = COB_XFDT_COMP5S; - else - sqltype = COB_XFDT_COMP5U; - } else { - sqlsz = COMPtoDig[f->size-1]; - sqltype = COB_XFDT_COMP5U; - } - break; - case CB_USAGE_COMP_X: - sqlsz = COMPtoDig[f->size-1]; - sqltype = COB_XFDT_COMPX; - break; - case CB_USAGE_PACKED: - if (f->pic) { - sqlsz = f->pic->digits + 3; - if (f->pic->have_sign > 0) - sqltype = COB_XFDT_PACKS; - else - sqltype = COB_XFDT_PACKU; - } else { - sqlsz = f->size * 2 + 2; - sqltype = COB_XFDT_PACKU; - } - break; - case CB_USAGE_COMP_6: - sqltype = COB_XFDT_COMP6; - break; - case CB_USAGE_DISPLAY: - if (f->pic - && f->pic->category == CB_CATEGORY_NUMERIC) { - sqlsz = f->size + 3; - if (f->pic->have_sign > 0) - sqltype = COB_XFDT_PIC9S; - else - sqltype = COB_XFDT_PIC9U; - } else { - sqltype = COB_XFDT_PICX; - } - break; - case CB_USAGE_FLOAT: - case CB_USAGE_DOUBLE: - sqlsz = 36; - sqltype = COB_XFDT_FLOAT; - break; - case CB_USAGE_UNSIGNED_CHAR: - case CB_USAGE_UNSIGNED_SHORT: - case CB_USAGE_UNSIGNED_INT: - case CB_USAGE_UNSIGNED_LONG: - sqlsz = COMPtoDig[f->size-1]; - sqltype = COB_XFDT_COMP5U; - break; - case CB_USAGE_SIGNED_CHAR: - case CB_USAGE_SIGNED_SHORT: - case CB_USAGE_SIGNED_INT: - case CB_USAGE_SIGNED_LONG: - sqlsz = COMPtoDig[f->size-1]; - sqltype = COB_XFDT_COMP5S; - break; - default: - cb_error (_("%s unexpected USAGE: %d for SQL/XFD"), __FILE__, f->usage); - sqltype = COB_XFDT_BIN; - } - } - if (f->sql_date_format - && sqlsz < 32) - sqlsz = 32; - sprintf(datatype,"%02d,%04d",sqltype,sqlsz); - return datatype; -} - -/* Is the field also used as a 'key' for the file */ -static int -is_key_field (struct cb_file *fl, struct cb_field *f) -{ - struct cb_alt_key *l; - struct cb_key_component *c; - - if (fl->component_list) { - for (c = fl->component_list; c; c = c->next) { - if (f == cb_code_field (c->component)) - return 1; - } - } else if(fl->key) { - if (f == cb_code_field (fl->key)) - return 1; - } - for (l = fl->alt_key_list; l; l = l->next) { - if (l->component_list) { - for (c = l->component_list; c; c = c->next) { - if (f == cb_code_field (c->component)) - return 1; - } - } else { - if (f == cb_code_field (l->key)) - return 1; - } - } - return 0; -} - -#define MAX_NEST 24 -static char * -out_part(char *exp) -{ - static char wrk[256]; - char lop[80],rop[80],opcd[32]; - int i,j; - for(j=0; exp[j] == ' '; j++); - for(i=0; exp[j] != 0 && exp[j] != ' '; j++) { - if (exp[j] == ' ' - && exp[j+1] == ' ') - continue; - lop[i++] = exp[j]; - } - lop[i] = 0; - while(exp[j] == ' ') j++; - for(i=0; exp[j] != 0 && exp[j] != ' '; j++) { - if (exp[j] == ' ' - && exp[j+1] == ' ') - continue; - opcd[i++] = exp[j]; - } - opcd[i] = 0; - while(exp[j] == ' ') j++; - for(i=0; exp[j] != 0; j++) { - if (exp[j] == ' ' - && exp[j+1] == ' ') - continue; - rop[i++] = exp[j]; - } - rop[i] = 0; - snprintf(wrk,sizeof(wrk)-1,"%s,%s,%s",opcd,lop,rop); - return wrk; -} - -static void -write_postfix(FILE *fx, int golbl, char *expr) -{ - int k,nexp,nopcd,gto; - int opcode[MAX_NEST]; - char partexp[MAX_NEST][68], *p; - - nexp = nopcd = gto = 0; - for(k=0; k < MAX_NEST; k++) { - opcode[k] = 0; - memset(partexp[k],0,68); - } - for (p = expr; *p != 0 && nexp < MAX_NEST; ) { - if (*p == '(') { - p++; - opcode[nexp++] = '('; - } if (*p == ')') { - p++; - while (nexp > 0 - && opcode[nexp-1] != '(') { - gto = 0; - if (nexp == 1 && *p == 0) { - gto = golbl; - golbl = 0; - } - if (nopcd > 1) { - fprintf(fx,"C,0,%.255s\n",out_part(partexp[nopcd-2])); - fprintf(fx,"C,0,%.255s\n",out_part(partexp[nopcd-1])); - nopcd -= 2; - } else if (nopcd > 0) { - fprintf(fx,"C,0,%.255s\n",out_part(partexp[--nopcd])); - } - if (opcode[nexp-1] == 'A') { - fprintf(fx,"C,%d,%s\n",gto,"&&"); - } else if (opcode[nexp-1] == 'O') { - fprintf(fx,"C,%d,%s\n",gto,"||"); - } else if (opcode[nexp-1] == '!') { - fprintf(fx,"C,%d,%s\n",gto,"!"); - } - nexp--; - } - if (nexp > 0 - && opcode[nexp-1] == '(') { - nexp--; - } else if(*p == 0) { - break; - } else { - cb_warning (cb_warn_extra, _("Incorrect XFD expression: %s"),expr); - break; - } - } else if (strncasecmp(p," AND ",5) == 0) { - p += 5; - opcode[nexp++] = 'A'; - } else if (strncasecmp(p," OR ",4) == 0) { - p += 4; - opcode[nexp++] = 'O'; - } else if (strncasecmp(p,"NOT ",4) == 0) { - p += 4; - opcode[nexp++] = '!'; - } else if (memcmp(p," && ",4) == 0) { - p += 4; - opcode[nexp++] = 'A'; - } else if (memcmp(p," || ",4) == 0) { - p += 4; - opcode[nexp++] = 'O'; - } else if (memcmp(p," || ",4) == 0) { - p += 4; - opcode[nexp++] = 'O'; - } else { - for(k=0; *p != 0 && k < 64; k++,p++) { - if (strncasecmp(p," AND ",5) == 0 - || strncasecmp(p," OR ",4) == 0 - || strncasecmp(p," && ",4) == 0 - || strncasecmp(p," || ",4) == 0 - || *p == '(' - || *p == ')') - break; - partexp[nopcd][k] = *p; - } - partexp[nopcd][k] = 0; - if (k > 0) - nopcd++; - } - } - while (nopcd > 0) { - if (nopcd > 1) { - fprintf(fx,"C,0,%.255s\n",out_part(partexp[nopcd-2])); - fprintf(fx,"C,0,%.255s\n",out_part(partexp[nopcd-1])); - nopcd -= 2; - } else if (nopcd > 0) { - gto = 0; - if (nexp == 0) { - gto = golbl; - golbl = 0; - } - fprintf(fx,"C,%d,%.255s\n",gto,out_part(partexp[--nopcd])); - } - } - while (nexp > 0) { - gto = 0; - if (nexp == 1) { - gto = golbl; - golbl = 0; - } - if (opcode[nexp-1] == 'A') { - fprintf(fx,"C,%d,%s\n",gto,"&&"); - } else if (opcode[nexp-1] == 'O') { - fprintf(fx,"C,%d,%s\n",gto,"||"); - } else if (opcode[nexp-1] == '!') { - fprintf(fx,"C,%d,%s\n",gto,"!"); - } - nexp--; - } - if(golbl > 0) - fprintf(fx,"C,%d\n",golbl); -} - -static struct cb_field * -find_field (struct cb_field *f, char *name) -{ - struct cb_field *s; - if (compstr((char*)f->name,(const char*)name) == 0) - return f; - if (f->children) { - if ((s = find_field (f->children, name)) != NULL) - return s; - } - for (f=f->sister; f; f = f->sister) { - if ((s = find_field (f, name)) != NULL) - return s; - } - return NULL; -} - -static struct cb_field * -check_redefines (FILE *fx, struct cb_file *fl, struct cb_field *f, int sub, int idx[]) -{ - int i, j, k; - int numrdf, numwhen, numother, numdisp, toother; - int dowhen = 1, savelbl; - char expr[COB_NORMAL_BUFF], name[80]; - struct cb_field *s, *l, *n, *oth, *x; - - if (f->flag_sql_binary - || f->flag_sql_char - || f->flag_sql_varchar) { - f->flag_sql_group = 1; - } - if (f->flag_sql_group) - return f; - n = f; - savelbl = next_lbl; - if (f->sister - && f->sister->redefines == f) { - numrdf = numwhen = numother = numdisp = 0; - s = f; - oth = NULL; - /* Check REDEFINES */ - do { - l = s; - numrdf++; - if (is_all_display (s)) - numdisp++; - if (s->sql_when) { - k = strlen(s->sql_when); - while (k > 0 - && s->sql_when[k-1] == ' ') - s->sql_when[--k] = 0; - if (compstr(s->sql_when,"OTHER") == 0) - numother++; - else - numwhen++; - } else { - oth = s; - } - if (fx) - s->step_count = next_lbl++; - if (s->sister == NULL) - break; - s = s->sister; - } while (s->redefines == f); - if (fx) - l->next_group_line = next_lbl++; - - if (numdisp == numrdf - && numwhen == 0) { /* Just PIC X REDEFINES PIC X */ - n = l; - dowhen = 0; - } else - if (numother == 0 - && numrdf - numwhen == 1) { - if (oth) - oth->sql_when = cobc_parse_strdup ("OTHER"); - } else - if ((numwhen+numother) != numrdf) { - if (!f->flag_sql_binary) { - if ((numwhen + numother) > 0) - cb_warning (cb_warn_extra, _("%s has incomplete WHEN rules"),f->name); - f->flag_sql_binary = 1; - f->flag_sql_group = 1; - dowhen = 0; - cb_warning (cb_warn_extra, _("Process %s as BINARY data"),f->name); - } - } - /* Emit When Conditions */ - if (!dowhen) { - next_lbl = savelbl; - s = f; - do { - s->step_count = 0; - s->next_group_line = 0; - if (s->sister == NULL) - break; - s = s->sister; - } while (s->redefines == f); - } else - if (fx) { - s = f; - toother = 0; - do { - if (s == NULL) - break; - if (s->sql_when) { - if (compstr(s->sql_when,"OTHER") == 0) { - toother = s->step_count; - } else { - expr[0] = 0; - for (i=j=0; s->sql_when[i] != 0; ) { - if (s->sql_when[i] == ' ' - && s->sql_when[i+1] == ' ') { - i++; - continue; - } - if (s->sql_when[i] == ' ') { - strcat(expr," "); - i++; - continue; - } - if (s->sql_when[i] == '\'' - || s->sql_when[i] == '"') { - char qt = s->sql_when[i]; - k = strlen(expr); - do { - expr[k++] = s->sql_when[i++]; - } while (s->sql_when[i] != qt - && s->sql_when[i] != 0); - if (s->sql_when[i] != 0) - expr[k++] = s->sql_when[i++]; - expr[k] = 0; - continue; - } - if (isalnum(s->sql_when[i])) { - j = 0; - while(isalnum(s->sql_when[i]) - || s->sql_when[i] == '-') - name[j++] = s->sql_when[i++]; - name[j] = 0; - x = find_field (fl->record, name); - if (x) { - strcat(expr,get_col_name(fl,x,sub,idx)); - } else { - strcat(expr,name); - } - continue; - } - k = strlen(expr); - expr[k] = s->sql_when[i++]; - expr[k+1] = 0; - } - write_postfix (fx, s->step_count, expr); - } - if (l == NULL) - break; - s->report_decl_id = l->next_group_line; - } - if (s->sister == NULL) - break; - s = s->sister; - } while (s->redefines == f); - if (toother > 0) { - if(f->step_count != toother) - fprintf(fx,"G,%d\n",toother); - else - f->step_count = 0; - } - } - } - return n; -} - -static void -write_xfd (FILE *fx, struct cb_file *fl, struct cb_field *f, int sub, int idx[]) -{ - fprintf(fx, "F,%04d,%04d,", (int)f->offset, (int)f->size); - fprintf(fx, "%s,", get_xfd_type (f)); - if (f->pic - && f->pic->category == CB_CATEGORY_NUMERIC) { - fprintf( fx, "%d,%d,", (int)f->pic->digits, (int)f->pic->scale); - } else { - fprintf (fx, "0,0,"); - } - if (f->sql_date_format) { - fprintf (fx, "%d", find_date (f) + 1); - } - fprintf(fx,",%02d,%s\n",f->level,get_col_name(fl,f,sub,idx)); -} - -static void -write_field (struct cb_file *fl, struct cb_field *f, FILE *fs, FILE *fx, int sub, int idx[]) -{ - struct cb_field *s; - do { - if (f->level < 1 - || f->level >= 66) { - f = f->sister; - if (f == NULL) - return; - continue; - } - if (f->redefines == NULL - && f->sister - && f->sister->redefines == f) - check_redefines (fx, fl, f, sub, idx); - - if (f->step_count > 0) { - fprintf(fx,"L,%d\n",f->step_count); - f->step_count = 0; - } - if (f->occurs_max > 1 - && f->flag_occurs) { - idx[sub] = 1; - f->flag_occurs = 0; - while (idx[sub] <= f->occurs_max) { - if (sub >= MAX_OCC_NEST) { - cb_error (_("%s nested occurs exceeds: %d"), __FILE__, MAX_OCC_NEST); - } - write_field (fl,f,fs,fx,sub+1,idx); - idx[sub]++; - } - f->flag_occurs = 1; - f = f->sister; - if (f == NULL) - return; - continue; - } - if (f->children - && is_key_field (fl,f) - && is_all_display (f)) { - f->flag_sql_group = 1; - } - if (f->flag_sql_group) { - fprintf(fs,"%s %-40s %s",eol,get_col_name(fl,f,sub,idx),get_col_type (f)); - write_xfd (fx,fl,f,sub,idx); - strcpy(eol,",\n"); - s = f; - while (s->sister - && s->sister->redefines == f) { /* Skip Group Redefines */ - s = s->sister; - } - f = s; - } else if (f->children) { - write_field (fl,f->children,fs,fx,sub,idx); - } else { - fprintf(fs,"%s %-40s %s",eol,get_col_name(fl,f,sub,idx),get_col_type (f)); - strcpy(eol,",\n"); - write_xfd (fx,fl,f,sub,idx); - } - if (is_key_field (fl,f)) - fprintf(fs," NOT NULL"); - if (f->occurs_max > 1 - && !f->flag_occurs) - return; - f = check_redefines (NULL, fl, f, sub, idx); - if (f->report_decl_id > 0) { - if (f->report_decl_id != f->next_group_line) - fprintf(fx,"G,%d\n",f->report_decl_id); - f->report_decl_id = 0; - } - if (f->next_group_line > 0) { - fprintf(fx,"L,%d\n",f->next_group_line); - f->next_group_line = 0; - } - f = f->sister; - } while (f); -} - -static void -check_prefix (struct cb_field *f) -{ - if (prefixlen <= 0) - return; - do { - if (f->children && f->sister == NULL) { - check_prefix (f->children); - } else if (!f->flag_filler) { - if (strncasecmp(f->name,prefix,prefixlen) != 0) { - prefixlen = 0; - return; - } - } - if (f->children) - check_prefix (f->children); - f = f->sister; - } while (f); -} - -/* Write out the DDL and XFD files */ -void -output_xfd_file (struct cb_file *fl) -{ - char outname[COB_FILE_BUFF], tblname[64], time_stamp[32]; - FILE *fx, *fs; - struct tm *loctime; - time_t sectime; - struct cb_field *f; - struct cb_alt_key *l; - struct cb_key_component *c; - struct sql_date sdf[1]; - int i,j,k,sub,idx[MAX_OCC_NEST]; - - if (fl->record_min != fl->record_max) { - cb_warning (COBC_WARN_ENABLED, - _("FD %s; SQL requires fixed size records"), fl->name); - return; - } - if (!fl->flag_sql_xfd) { - fl->max_sql_name_len = 24; - fl->flag_sql_trim_prefix = 1; - fl->flag_sql_xfd = 1; - cb_parse_xfd (fl, fl->record); - } - f = fl->record; - if(f->level < 1) - f = f->sister; - if(f->storage != CB_STORAGE_FILE) - return; - for (sub=0; sub < MAX_OCC_NEST; sub++) - idx[sub] = 0; - sub = 0; - next_lbl = 1; - sectime = time (NULL); - loctime = localtime (§ime); - if (loctime) { - strftime (time_stamp, (size_t)COB_MINI_MAX, - "%b %d %Y %H:%M:%S", loctime); - } else { - strcpy(time_stamp,"Time unknown"); - } - if (fl->sql_name) { - strcpy(tblname,fl->sql_name); - } else if(fl->assign - && CB_LITERAL_P(fl->assign)) { - struct cb_literal *lit = CB_LITERAL (fl->assign); - char * ps; - char * p = (char*)lit->data; - int ln = lit->size; - if (ln > sizeof(tblname)-1) { - p += ln - sizeof(tblname) + 1; - ln = sizeof(tblname)-1; - } - if ((ps = strrchr (p, SLASH_CHAR)) != NULL) { - ln -= p - (ps + 1); - p = ps + 1; - } - sprintf(tblname,"%.*s",ln,p); - } else { - strcpy(tblname,fl->cname); - } - k = strlen(tblname); - for(i=j=0; i < k; i++) { - if (tblname[i] == '-') - tblname[j++] = '_'; - else if(isalnum(tblname[i])) - tblname[j++] = (char)tolower(tblname[i]); - } - tblname[j] = 0; - strcpy(prefix,""); - prefixlen = 0; - if (fl->flag_sql_trim_prefix) { - f = fl->record; - while (f - && (f->level <= 1 || f->flag_filler)) { - if (f->children) - f = f->children; - else - f = f->sister; - } - while (f && f->children && f->sister == NULL) { - f = f->children; - } - while (f - && (f->level <= 1 || f->flag_filler)) { - if (f->children) - f = f->children; - else - f = f->sister; - } - if (f) { - for(k=0; k < 7; k++) { - prefix[k] = f->name[k]; - if (prefix[k] == 0) - break; - if (prefix[k] == '-') { - k++; - prefix[k] = 0; - break; - } - } - prefixlen = k; - } - if (prefixlen > 0) { - f = fl->record; - if(f->level < 1 && f->sister) - f = f->sister; - check_prefix (f); - } - } - - sprintf(outname,"%s%s%s.xd",cob_schema_dir,SLASH_STR,tblname); - if (cb_unix_lf) { - fx = fopen (outname, "wb"); - } else { - fx = fopen (outname, "w"); - } - if (fx == NULL) { - cb_warning (cb_warn_extra, _("Unable to open %s; '%s'"),outname,cb_get_strerror ()); - return; - } - sprintf(outname,"%s%s%s.ddl",cob_schema_dir,SLASH_STR,tblname); - if (cb_unix_lf) { - fs = fopen (outname, "wb"); - } else { - fs = fopen (outname, "w"); - } - if (fs == NULL) { - cb_warning (cb_warn_extra, _("Unable to open %s; '%s'"),outname,cb_get_strerror ()); - return; - } - ndate = 0; - for (f=fl->record->sister; f; f = f->sister) { - save_date (f); - } - fprintf(fx,"# Generated on %s from %s\n",time_stamp,cb_source_file); - fprintf(fx,"H,1,%s,%d,',','.',0,%d\n",tblname,ndate,fl->organization); - for (k=0; k < ndate; k++) { - cb_date_str (sdf, dateformat[k]); - fprintf(fx,"D,%d,'%s'",k+1,dateformat[k]); - fprintf(fx,",%d,%d,%d",sdf->digits,sdf->hasDate,sdf->hasTime); - if (sdf->yyRule > ' ') - fprintf(fx,",%c,%d",sdf->yyRule,sdf->yyAdj); - else - fprintf(fx,",,0"); - fprintf(fx,",%d:%d",sdf->yyPos,sdf->yyLen); - fprintf(fx,",%d:%d",sdf->mmPos,sdf->mmLen); - fprintf(fx,",%d:%d",sdf->ddPos,sdf->ddLen); - fprintf(fx,",%d:%d",sdf->hhPos,sdf->hhLen); - fprintf(fx,",%d:%d",sdf->miPos,sdf->miLen); - fprintf(fx,",%d:%d",sdf->ssPos,sdf->ssLen); - fprintf(fx,",%d:%d",sdf->ccPos,sdf->ccLen); - fprintf(fx,"\n"); - } - fprintf(fs,"DROP TABLE %s;\n",tblname); - fprintf(fs,"CREATE TABLE %s (\n",tblname); - sub = 0; - strcpy(eol,""); - for (f=fl->record->sister; f; f = f->sister) { - write_field (fl, f, fs, fx, sub, idx); - } - if (fl->organization == COB_ORG_RELATIVE) { - fprintf(fs,"%s rid_%-30s BIGINT PRIMARY KEY",eol,tblname); - fprintf(fx,"F,%04d,%04d,",(int)fl->record->size,4); - fprintf(fx,"%02d,0015,",COB_XFDT_COMP5U); - fprintf(fx,"12,0,,00,rid_%s\n",tblname); - fprintf(fx,"K,0,N,N,,rid_%s\n",tblname); - } - fprintf(fs,"\n);\n"); - if (fl->organization == COB_ORG_INDEXED) { - fprintf(fs,"CREATE UNIQUE INDEX pk_%s ON %s ",tblname,tblname); - fprintf(fx,"K,0,N,N,,"); - if (fl->component_list) { - fprintf(fs,"("); - strcpy(eol,""); - for (c = fl->component_list; c; c = c->next) { - f = cb_code_field (c->component); - fprintf(fs,"%s%s",eol,get_col_name(fl,f,0,idx)); - fprintf(fx,"%s%s",eol,get_col_name(fl,f,0,idx)); - strcpy(eol,","); - } - fprintf(fs,");\n"); - fprintf(fx,"\n"); - } else if(fl->key) { - f = cb_code_field (fl->key); - fprintf(fs,"(%s);\n",get_col_name(fl,f,0,idx)); - fprintf(fx,"%s\n",get_col_name(fl,f,0,idx)); - } - k = 1; - for (l = fl->alt_key_list; l; l = l->next) { - fprintf(fs,"CREATE %sINDEX k%d_%s ON %s ", - l->duplicates||l->tf_suppress?"":"UNIQUE ",k,tblname,tblname); - fprintf(fx,"K,%d,%s,",k,l->duplicates?"Y":"N"); - if (l->suppress - && CB_LITERAL_P(l->suppress)) { - struct cb_literal *lit = CB_LITERAL (l->suppress); - fprintf(fx,"Y,\"%.*s\",",lit->size,lit->data); - } else - if (l->tf_suppress) { - fprintf(fx,"Y,0x%02X,",l->char_suppress); - } else { - fprintf(fx,"N,,"); - } - if (l->component_list) { - fprintf(fs,"("); - strcpy(eol,""); - for (c = l->component_list; c; c = c->next) { - f = cb_code_field (c->component); - fprintf(fs,"%s%s",eol,get_col_name(fl,f,0,idx)); - fprintf(fx,"%s%s",eol,get_col_name(fl,f,0,idx)); - strcpy(eol,","); - } - fprintf(fs,");\n"); - fprintf(fx,"\n"); - } else { - f = cb_code_field (l->key); - fprintf(fs,"(%s);\n",get_col_name(fl,f,0,idx)); - fprintf(fx,"%s\n",get_col_name(fl,f,0,idx)); - } - k++; - } - } - fclose(fs); - fclose(fx); - ndate = 0; -} diff -Nru gnucobol-4.0~early~20200606/cobc/tree.c gnucobol-5/cobc/tree.c --- gnucobol-4.0~early~20200606/cobc/tree.c 2020-06-06 20:51:59.000000000 +0000 +++ gnucobol-5/cobc/tree.c 1970-01-01 00:00:00.000000000 +0000 @@ -1,6800 +0,0 @@ -/* - Copyright (C) 2001-2020 Free Software Foundation, Inc. - Written by Keisuke Nishida, Roger While, Simon Sobisch, Ron Norman, - Edward Hart - - This file is part of GnuCOBOL. - - The GnuCOBOL compiler is free software: you can redistribute it - and/or modify it under the terms of the GNU General Public License - as published by the Free Software Foundation, either version 3 of the - License, or (at your option) any later version. - - GnuCOBOL is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with GnuCOBOL. If not, see . -*/ - - -#include - -#include -#include -#include -#include -#include -#include -#ifndef LLONG_MAX -#ifdef LONG_LONG_MAX -#define LLONG_MAX LONG_LONG_MAX -#define ULLONG_MAX ULONG_LONG_MAX -#elif defined _I64_MAX -#define LLONG_MAX _I64_MAX -#define ULLONG_MAX _UI64_MAX -#else -#error compiler misses maximum for 64bit integer -#endif -#endif - -#include "cobc.h" -#include "tree.h" -#include - -#define PIC_ALPHABETIC 0x01 -#define PIC_NUMERIC 0x02 -#define PIC_NATIONAL 0x04 -#define PIC_EDITED 0x08 -#define PIC_NUMERIC_FLOATING 0x10 -#define PIC_ALPHANUMERIC (PIC_ALPHABETIC | PIC_NUMERIC) -#define PIC_ALPHABETIC_EDITED (PIC_ALPHABETIC | PIC_EDITED) -#define PIC_ALPHANUMERIC_EDITED (PIC_ALPHANUMERIC | PIC_EDITED) -#define PIC_NUMERIC_EDITED (PIC_NUMERIC | PIC_EDITED) -#define PIC_FLOATING_EDITED (PIC_NUMERIC | PIC_NUMERIC_FLOATING | PIC_EDITED) -#define PIC_NATIONAL_EDITED (PIC_NATIONAL | PIC_EDITED) - -/* Local variables */ - -static const enum cb_class category_to_class_table[] = { - CB_CLASS_UNKNOWN, /* CB_CATEGORY_UNKNOWN */ - CB_CLASS_ALPHABETIC, /* CB_CATEGORY_ALPHABETIC */ - CB_CLASS_ALPHANUMERIC, /* CB_CATEGORY_ALPHANUMERIC */ - CB_CLASS_ALPHANUMERIC, /* CB_CATEGORY_ALPHANUMERIC_EDITED */ - CB_CLASS_BOOLEAN, /* CB_CATEGORY_BOOLEAN */ - CB_CLASS_INDEX, /* CB_CATEGORY_INDEX */ - CB_CLASS_NATIONAL, /* CB_CATEGORY_NATIONAL */ - CB_CLASS_NATIONAL, /* CB_CATEGORY_NATIONAL_EDITED */ - CB_CLASS_NUMERIC, /* CB_CATEGORY_NUMERIC */ - CB_CLASS_ALPHANUMERIC, /* CB_CATEGORY_NUMERIC_EDITED */ - CB_CLASS_OBJECT, /* CB_CATEGORY_OBJECT_REFERENCE */ - CB_CLASS_POINTER, /* CB_CATEGORY_DATA_POINTER */ - CB_CLASS_POINTER /* CB_CATEGORY_PROGRAM_POINTER */ -}; - -static int category_is_alphanumeric[] = { - 0, /* CB_CATEGORY_UNKNOWN */ - 1, /* CB_CATEGORY_ALPHABETIC */ - 1, /* CB_CATEGORY_ALPHANUMERIC */ - 1, /* CB_CATEGORY_ALPHANUMERIC_EDITED */ - 0, /* CB_CATEGORY_BOOLEAN */ - 0, /* CB_CATEGORY_INDEX */ - 0, /* CB_CATEGORY_NATIONAL */ - 0, /* CB_CATEGORY_NATIONAL_EDITED */ - 0, /* CB_CATEGORY_NUMERIC */ - 1, /* CB_CATEGORY_NUMERIC_EDITED */ - 0, /* CB_CATEGORY_OBJECT_REFERENCE */ - 0, /* CB_CATEGORY_DATA_POINTER */ - 0 /* CB_CATEGORY_PROGRAM_POINTER */ -}; -static int category_is_national[] = { - 0, /* CB_CATEGORY_UNKNOWN */ - 0, /* CB_CATEGORY_ALPHABETIC */ - 0, /* CB_CATEGORY_ALPHANUMERIC */ - 0, /* CB_CATEGORY_ALPHANUMERIC_EDITED */ - 0, /* CB_CATEGORY_BOOLEAN */ - 0, /* CB_CATEGORY_INDEX */ - 1, /* CB_CATEGORY_NATIONAL */ - 1, /* CB_CATEGORY_NATIONAL_EDITED */ - 0, /* CB_CATEGORY_NUMERIC */ - 0, /* CB_CATEGORY_NUMERIC_EDITED */ - 0, /* CB_CATEGORY_OBJECT_REFERENCE */ - 0, /* CB_CATEGORY_DATA_POINTER */ - 0 /* CB_CATEGORY_PROGRAM_POINTER */ -}; - - -/* note: integrating cached integers help to decrease memory usage for - compilation of source with many similar integer values, - but leads to a slow-down of 2-40%, depending how many identical - integer values are cached/searched -*/ -#ifndef CACHED_INTEGERS -#define CACHED_INTEGERS 0 -#endif -#if CACHED_INTEGERS -struct int_node { - struct int_node *next; - struct cb_integer *node; -}; -static struct int_node *int_node_table = NULL; -#ifdef USE_INT_HEX /* Simon: using this increases the struct and we - *should* pass the flags as constants in any case... */ -static struct int_node *int_node_table_hex = NULL; -#endif -#endif - -static char *scratch_buff = NULL; -static int filler_id = 1; -static int class_id = 0; -static int toplev_count; -static int after_until = 0; -static char err_msg[COB_MINI_BUFF]; -static struct cb_program *container_progs[64]; -static const char * const cb_const_subs[] = { - "i0", - "i1", - "i2", - "i3", - "i4", - "i5", - "i6", - "i7", - "i8", - "i9", - "i10", - "i11", - "i12", - "i13", - "i14", - "i15", - NULL -}; - -static const struct cb_intrinsic_table userbp = - { "USER FUNCTION", "cob_user_function", - CB_INTR_USER_FUNCTION, USER_FUNCTION_NAME, 1, 0, 0, CB_CATEGORY_NUMERIC, - 0 }; - -/* Global variables */ - -/* Constants */ - -cb_tree cb_any; -cb_tree cb_true; -cb_tree cb_false; -cb_tree cb_null; -cb_tree cb_zero; -cb_tree cb_one; -cb_tree cb_space; -cb_tree cb_low; -cb_tree cb_high; -cb_tree cb_norm_low; -cb_tree cb_norm_high; -cb_tree cb_quote; -cb_tree cb_int0; -cb_tree cb_int1; -cb_tree cb_int2; -cb_tree cb_int3; -cb_tree cb_int4; -cb_tree cb_int5; -cb_tree cb_int6; -cb_tree cb_int7; -cb_tree cb_int8; -cb_tree cb_int16; -cb_tree cb_i[COB_MAX_SUBSCRIPTS]; -cb_tree cb_error_node; - -cb_tree cb_intr_whencomp = NULL; - -cb_tree cb_standard_error_handler = NULL; - -unsigned int gen_screen_ptr = 0; - -#if 0 /* TODO remove if not needed */ -static int save_expr_line = 0; -static char *save_expr_file = NULL; -#endif -static cb_tree cb_zero_lit; -static int prev_expr_line = 0; -static int prev_expr_pos = 0; -#define EXPR_WARN_PER_LINE 8 -static int prev_expr_warn[EXPR_WARN_PER_LINE] = {0,0,0,0,0,0,0,0}; -static int prev_expr_tf[EXPR_WARN_PER_LINE] = {0,0,0,0,0,0,0,0}; - -static struct cb_report *report_checked = NULL; - -/* Local functions */ - -static int -was_prev_warn (int linen, int tf) -{ - int i; - if (cb_exp_line != prev_expr_line) { - prev_expr_line = cb_exp_line; - for (i = 0; i < EXPR_WARN_PER_LINE; i++) { - prev_expr_warn[i] = 0; - prev_expr_tf[i] = -9999; - } - } - for (i=0; i < EXPR_WARN_PER_LINE; i++) { - if (prev_expr_warn[i] == linen) { - if (tf < 0 - && prev_expr_tf[i] == -tf) { - return 1; - } - if (prev_expr_tf[i] == tf) { - return 1; - } - prev_expr_tf [i] = tf; - return 0; - } - } - prev_expr_pos = (prev_expr_pos + 1) % EXPR_WARN_PER_LINE; - prev_expr_warn [prev_expr_pos] = linen; - prev_expr_tf [prev_expr_pos] = tf; - return 0; -} - -/* get best position (note: in the case of constants y/x point to DATA-DIVISION) */ -static void -copy_file_line (cb_tree e, cb_tree y, cb_tree x) -{ - if (y == cb_zero || x == cb_zero) { - prev_expr_line = cb_exp_line; - SET_SOURCE(e, cb_source_file, cb_exp_line); - } else if (y && x && y->source_line > x->source_line) { - SET_SOURCE(e, y->source_file, y->source_line); - e->source_column = y->source_column; -#if 0 /* TODO remove if not needed */ - save_expr_file = (char *)y->source_file; - save_expr_line = y->source_line; -#endif - } else if (!x && y && y->source_line) { - SET_SOURCE(e, y->source_file, y->source_line); - e->source_column = y->source_column; -#if 0 /* TODO remove if not needed */ - save_expr_file = (char *)e->source_file; - save_expr_line = e->source_line; -#endif - } else if (x && x->source_line) { - SET_SOURCE(e, x->source_file, x->source_line); - e->source_column = x->source_column; -#if 0 /* TODO remove if not needed */ - save_expr_file = (char *)e->source_file; - save_expr_line = e->source_line; - } else if (y || x) { - e->source_line = cb_exp_line; - e->source_file = cb_source_file; - } else if (save_expr_line) { - e->source_file = save_expr_file; - e->source_line = save_expr_line; -#endif - } else { - SET_SOURCE(e, cb_source_file, cb_exp_line); - } -} - -/* compute hash value of COBOL word (case insensitive) */ -static size_t -word_hash (const unsigned char *s) -{ - size_t val; - size_t pos; - - /* Hash a name */ - /* We multiply by position to get a better distribution */ - val = 0; - pos = 1; - for (; *s; s++, pos++) { - val += pos * toupper (*s); - } -#if 0 /* RXWRXW - Hash remainder */ - return val % CB_WORD_HASH_SIZE; -#endif - return val & CB_WORD_HASH_MASK; -} - -static void -lookup_word (struct cb_reference *p, const char *name) -{ - struct cb_word *w; - size_t val; - - val = word_hash ((const unsigned char *)name); - /* Find an existing word */ - if (likely(current_program)) { - for (w = current_program->word_table[val]; w; w = w->next) { - if (strcasecmp (w->name, name) == 0) { - p->word = w; - p->hashval = val; - p->flag_duped = 1; - return; - } - } - } - - /* Create new word */ - w = cobc_parse_malloc (sizeof (struct cb_word)); - w->name = cobc_parse_strdup (name); - - /* Insert it into the table */ - if (likely(current_program)) { - w->next = current_program->word_table[val]; - current_program->word_table[val] = w; - } - p->word = w; - p->hashval = val; -} - -#define CB_FILE_ERR_REQUIRED 1 -#define CB_FILE_ERR_INVALID_FT 2 -#define CB_FILE_ERR_INVALID 3 - -static void -file_error (cb_tree name, const char *clause, const char errtype) -{ - switch (errtype) { - case CB_FILE_ERR_REQUIRED: - cb_error_x (name, _("%s clause is required for file '%s'"), - clause, CB_NAME (name)); - break; - case CB_FILE_ERR_INVALID_FT: - cb_error_x (name, _("%s clause is invalid for file '%s' (file type)"), - clause, CB_NAME (name)); - break; - case CB_FILE_ERR_INVALID: - cb_error_x (name, _("%s clause is invalid for file '%s'"), - clause, CB_NAME (name)); - break; - } -} - - -static void -check_code_set_items_are_subitems_of_records (struct cb_file * const file) -{ - struct cb_list *l; - cb_tree r; - struct cb_field *f; - cb_tree first_ref = NULL; - struct cb_field *first_record = NULL; - struct cb_field *current_record; - - /* - Check each item belongs to this FD, is not a record and are all in the - same record. - */ - for (l = file->code_set_items; l; l = CB_LIST (l->chain)) { - - r = l->value; - f = CB_FIELD (cb_ref (r)); - - if (f->level == 1) { - cb_error_x (r, _("FOR item '%s' is a record"), - cb_name (r)); - } - - for (current_record = f; current_record->parent; - current_record = current_record->parent); - - if (first_ref) { - if (current_record != first_record) { - cb_error_x (r, _("FOR item '%s' is in different record to '%s'"), - cb_name (r), cb_name (first_ref)); - } - } else { - first_ref = r; - first_record = current_record; - } - - if (current_record->file != file) { - cb_error_x (r, _("FOR item '%s' is not in a record associated with '%s'"), - cb_name (r), cb_name (CB_TREE (file))); - } - - if (!l->chain) { - break; - } - } -} - -/* Tree */ - -static void * -make_tree (const enum cb_tag tag, const enum cb_category category, - const size_t size) -{ - cb_tree x; - - x = cobc_parse_malloc (size); - x->tag = tag; - x->category = category; - return x; -} - -static cb_tree -make_constant (const enum cb_category category, const char *val) -{ - struct cb_const *p; - - p = make_tree (CB_TAG_CONST, category, sizeof (struct cb_const)); - p->val = val; - return CB_TREE (p); -} - -static cb_tree -make_constant_label (const char *name) -{ - struct cb_label *p; - - p = CB_LABEL (cb_build_label (cb_build_reference (name), NULL)); - p->flag_begin = 1; - return CB_TREE (p); -} - -/* Recursively find/generate a name for the object x. */ -static size_t -cb_name_1 (char *s, cb_tree x, const int size) -{ - char *orig; - struct cb_funcall *cbip; - struct cb_binary_op *cbop; - struct cb_reference *p; - struct cb_field *f; - struct cb_intrinsic *cbit; - cb_tree l; - int i; - - orig = s; - if (!x) { - strncpy (s, "(void pointer)", size); - return strlen (orig); - } - switch (CB_TREE_TAG (x)) { - case CB_TAG_CONST: - if (x == cb_any) { - strncpy (s, "ANY", size); - } else if (x == cb_true) { - strncpy (s, "TRUE", size); - } else if (x == cb_false) { - strncpy (s, "FALSE", size); - } else if (x == cb_null) { - strncpy (s, "NULL", size); - } else if (x == cb_zero) { - strncpy (s, "ZERO", size); - } else if (x == cb_space) { - strncpy (s, "SPACE", size); - } else if (x == cb_low || x == cb_norm_low) { - strncpy (s, "LOW-VALUE", size); - } else if (x == cb_high || x == cb_norm_high) { - strncpy (s, "HIGH-VALUE", size); - } else if (x == cb_quote) { - strncpy (s, "QUOTE", size); - } else if (x == cb_error_node) { - strncpy (s, _("internal error node"), size); - } else { - strncpy (s, _("unknown constant"), size); - } - break; - - case CB_TAG_LITERAL: - if (CB_TREE_CLASS (x) == CB_CLASS_NUMERIC) { - strncpy (s, (char *)CB_LITERAL (x)->data, size); - } else { - snprintf (s, size, "\"%s\"", (char *)CB_LITERAL (x)->data); - } - break; - - case CB_TAG_FIELD: - f = CB_FIELD (x); - if (f->flag_filler) { - strncpy (s, "FILLER", size); - } else { - strncpy (s, f->name, size); - } - break; - - case CB_TAG_REFERENCE: - p = CB_REFERENCE (x); - if (p->flag_filler_ref) { - s += snprintf (s, size, "FILLER"); - } else { - s += snprintf (s, size, "%s", p->word->name); - } - if (p->subs && CB_VALUE(p->subs) != cb_int1) { - s += snprintf (s, size - (s - orig), " ("); - p->subs = cb_list_reverse (p->subs); - for (l = p->subs; l; l = CB_CHAIN (l)) { - s += cb_name_1 (s, CB_VALUE (l), size - (s - orig)); - s += snprintf (s, size - (s - orig), CB_CHAIN (l) ? ", " : ")"); - } - p->subs = cb_list_reverse (p->subs); - } - if (p->offset) { - s += snprintf (s, size - (s - orig), " ("); - s += cb_name_1 (s, p->offset, size - (s - orig)); - s += snprintf (s, size - (s - orig), ":"); - if (p->length) { - s += cb_name_1 (s, p->length, size - (s - orig)); - } - strncpy (s, ")", size - (s - orig)); - } - if (p->chain) { - s += snprintf (s, size - (s - orig), " in "); - s += cb_name_1 (s, p->chain, size - (s - orig)); - } - break; - - case CB_TAG_LABEL: - snprintf (s, size, "%s", (char *)(CB_LABEL (x)->name)); - break; - - case CB_TAG_ALPHABET_NAME: - snprintf (s, size, "%s", CB_ALPHABET_NAME (x)->name); - break; - - case CB_TAG_CLASS_NAME: - snprintf (s, size, "%s", CB_CLASS_NAME (x)->name); - break; - - case CB_TAG_LOCALE_NAME: - snprintf (s, size, "%s", CB_LOCALE_NAME (x)->name); - break; - - case CB_TAG_BINARY_OP: - cbop = CB_BINARY_OP (x); - if (cbop->op == '@') { - s += snprintf (s, size, "("); - s += cb_name_1 (s, cbop->x, size - (s - orig)); - s += snprintf (s, size - (s - orig), ")"); - } else if (cbop->op == '!') { - s += snprintf (s, size, "!"); - s += cb_name_1 (s, cbop->x, size - (s - orig)); - } else { - s += snprintf (s, size, "("); - s += cb_name_1 (s, cbop->x, size - (s - orig)); - s += snprintf (s, size - (s - orig), " %c ", cbop->op); - s += cb_name_1 (s, cbop->y, size - (s - orig)); - strncpy (s, ")", size - (s - orig)); - } - break; - - case CB_TAG_FUNCALL: - cbip = CB_FUNCALL (x); - s += snprintf (s, size, "%s", cbip->name); - for (i = 0; i < cbip->argc; i++) { - s += snprintf (s, size - (s - orig), (i == 0) ? "(" : ", "); - s += cb_name_1 (s, cbip->argv[i], size - (s - orig)); - } - s += snprintf (s, size - (s - orig), ")"); - break; - - case CB_TAG_INTRINSIC: - cbit = CB_INTRINSIC (x); - if (!cbit->isuser) { - snprintf (s, size, "FUNCTION %s", cbit->intr_tab->name); - } else if (cbit->name && CB_REFERENCE_P(cbit->name) - && CB_REFERENCE(cbit->name)->word) { - snprintf (s, size, "USER FUNCTION %s", CB_REFERENCE(cbit->name)->word->name); - } else { - snprintf (s, size, "USER FUNCTION"); - } - break; - - case CB_TAG_FILE: - snprintf (s, size, "FILE %s", CB_FILE (x)->name); - break; - - case CB_TAG_REPORT: - snprintf (s, size, "REPORT %s", CB_REPORT_PTR (x)->name); - break; - - case CB_TAG_REPORT_LINE: -#if 1 /* FIXME: Why do we need the unchecked cast here? */ - p = (struct cb_reference *)x; -#else - p = CB_REFERENCE (x); -#endif - f = CB_FIELD (p->value); - snprintf (s, size, "REPORT LINE %s", f->name); - break; - - case CB_TAG_CD: - snprintf (s, size, "%s", CB_CD (x)->name); - break; - - /* LCOV_EXCL_START */ - default: - cobc_err_msg (_("unexpected tree tag: %d"), (int)CB_TREE_TAG (x)); - COBC_ABORT (); - /* LCOV_EXCL_STOP */ - } - - return strlen (orig); -} - -static cb_tree -make_intrinsic_typed (cb_tree name, const struct cb_intrinsic_table *cbp, - const enum cb_category cat, cb_tree args, - cb_tree field, cb_tree refmod, const int isuser) -{ - struct cb_intrinsic *x; - -#if 0 /* RXWRXW Leave in, we may need this */ - cb_tree l; - for (l = args; l; l = CB_CHAIN(l)) { - switch (CB_TREE_TAG (CB_VALUE(l))) { - case CB_TAG_CONST: - case CB_TAG_INTEGER: - case CB_TAG_LITERAL: - case CB_TAG_DECIMAL: - case CB_TAG_FIELD: - case CB_TAG_REFERENCE: - case CB_TAG_INTRINSIC: - break; - default: - cb_error (_("FUNCTION %s has invalid/not supported arguments - tag %d"), - cbp->name, CB_TREE_TAG(l)); - return cb_error_node; - } - } -#endif - - x = make_tree (CB_TAG_INTRINSIC, cat, sizeof (struct cb_intrinsic)); - x->name = name; - x->args = args; - x->intr_tab = cbp; - x->intr_field = field; - x->isuser = isuser; - if (refmod) { - x->offset = CB_PAIR_X (refmod); - x->length = CB_PAIR_Y (refmod); - } - return CB_TREE (x); -} - - -static cb_tree -make_intrinsic (cb_tree name, const struct cb_intrinsic_table *cbp, - cb_tree args, cb_tree field, cb_tree refmod, const int isuser) -{ - return make_intrinsic_typed (name, cbp, cbp->category, args, field, refmod, isuser); -} - -static cb_tree -global_check (struct cb_reference *r, cb_tree items, size_t *ambiguous) -{ - cb_tree candidate; - struct cb_field *p; - cb_tree v; - cb_tree c; - - candidate = NULL; - for (; items; items = CB_CHAIN (items)) { - /* Find a candidate value by resolving qualification */ - v = CB_VALUE (items); - c = r->chain; - if (CB_FIELD_P (v)) { - if (!CB_FIELD (v)->flag_is_global) { - continue; - } - /* In case the value is a field, it might be qualified - by its parent names and a file name */ - if (CB_FIELD (v)->flag_indexed_by) { - p = CB_FIELD (v)->index_qual; - } else { - p = CB_FIELD (v)->parent; - } - /* Resolve by parents */ - for (; p; p = p->parent) { - if (c && strcasecmp (CB_NAME (c), p->name) == 0) { - c = CB_REFERENCE (c)->chain; - } - } - - /* Resolve by file */ - if (c && CB_REFERENCE (c)->chain == NULL) { - if (CB_WORD_COUNT (c) == 1 && - CB_FILE_P (cb_ref (c)) && - (CB_FILE (cb_ref (c)) == cb_field_founder (CB_FIELD (v))->file)) { - c = CB_REFERENCE (c)->chain; - } - } - } - /* A well qualified value is a good candidate */ - if (c == NULL) { - if (candidate == NULL) { - /* Keep the first candidate */ - candidate = v; - } else { - /* Multiple candidates and possibly ambiguous */ - *ambiguous = 1; - } - } - } - return candidate; -} - -static int -iso_8601_func (const enum cb_intr_enum intr) -{ - return intr == CB_INTR_FORMATTED_CURRENT_DATE - || intr == CB_INTR_FORMATTED_DATE - || intr == CB_INTR_FORMATTED_DATETIME - || intr == CB_INTR_FORMATTED_TIME - || intr == CB_INTR_INTEGER_OF_FORMATTED_DATE - || intr == CB_INTR_SECONDS_FROM_FORMATTED_TIME - || intr == CB_INTR_TEST_FORMATTED_DATETIME; -} - -static int -valid_format (const enum cb_intr_enum intr, const char *format) -{ - char decimal_point = current_program->decimal_point; - - /* Precondition: iso_8601_func (intr) */ - - switch (intr) { - case CB_INTR_FORMATTED_CURRENT_DATE: - return cob_valid_datetime_format (format, decimal_point); - case CB_INTR_FORMATTED_DATE: - return cob_valid_date_format (format); - case CB_INTR_FORMATTED_DATETIME: - return cob_valid_datetime_format (format, decimal_point); - case CB_INTR_FORMATTED_TIME: - return cob_valid_time_format (format, decimal_point); - case CB_INTR_INTEGER_OF_FORMATTED_DATE: - return cob_valid_date_format (format) - || cob_valid_datetime_format (format, decimal_point); - case CB_INTR_SECONDS_FROM_FORMATTED_TIME: - return cob_valid_time_format (format, decimal_point) - || cob_valid_datetime_format (format, decimal_point); - case CB_INTR_TEST_FORMATTED_DATETIME: - return cob_valid_time_format (format, decimal_point) - || cob_valid_date_format (format) - || cob_valid_datetime_format (format, decimal_point); - default: - cb_error (_("invalid date/time function: '%d'"), intr); - /* Ignore the content of the format */ - return 1; - } -} - -static const char * -try_get_constant_data (cb_tree val) -{ - if (val == NULL) { - return NULL; - } else if (CB_LITERAL_P (val)) { - return (char *) CB_LITERAL (val)->data; - } else if (CB_CONST_P (val)) { - return CB_CONST (val)->val; - } else { - return NULL; - } -} - -static int -valid_const_date_time_args (const cb_tree tree, const struct cb_intrinsic_table *intr, - cb_tree args) -{ - const char *data; - - /* LCOV_EXCL_START */ - /* TODO: check precondition: iso_8601_func (intr->intr_enum) */ - if (!args) { - cobc_err_msg (_("call to '%s' with invalid parameter '%s'"), - "valid_const_date_time_args", "args");; - COBC_ABORT (); - } - /* LCOV_EXCL_STOP */ - - data = try_get_constant_data (CB_VALUE (args)); - if (data != NULL) { - if (!valid_format (intr->intr_enum, data)) { - cb_error_x (tree, _("FUNCTION '%s' has invalid date/time format"), - intr->name); - return 0; - } - return 1; - } - cb_warning_x (cb_warn_extra, tree, - _("FUNCTION '%s' has format in variable"), intr->name); - return 1; -} - -static cb_tree -get_last_elt (cb_tree l) -{ - while (CB_CHAIN (l)) { - l = CB_CHAIN (l); - } - return l; -} - -static int -get_data_from_const (cb_tree const_val, unsigned char **data) -{ - if (const_val == cb_space) { - *data = (unsigned char *)" "; - } else if (const_val == cb_zero) { - *data = (unsigned char *)"0"; - } else if (const_val == cb_quote) { - if (cb_flag_apostrophe) { - *data = (unsigned char *)"'"; - } else { - *data = (unsigned char *)"\""; - } - } else if (const_val == cb_norm_low) { - *data = (unsigned char *)"\0"; - } else if (const_val == cb_norm_high) { - *data = (unsigned char *)"\255"; - } else if (const_val == cb_null) { - *data = (unsigned char *)"\0"; - } else { - return 1; - } - - return 0; -} - -static int -get_data_and_size_from_lit (cb_tree x, unsigned char **data, size_t *size) -{ - if (CB_LITERAL_P (x)) { - *data = CB_LITERAL (x)->data; - *size = CB_LITERAL (x)->size; - } else if (CB_CONST_P (x)) { - *size = 1; - if (get_data_from_const (x, data)) { - return 1; - } - } else { - return 1; - } - - return 0; -} - -#if 0 -static void -dump_literal( const char func[], int line, const void *tree ) { - if( 1 && tree && CB_LITERAL_P(tree) ) { - const struct cb_literal *lit = CB_LITERAL(tree); - printf( "%s:%d: %p: %.*s, size=%d\n", func, line, - lit, lit->size, lit->data, lit->size ); - } -} -# define dump_literal(t) dump_literal(__func__, __LINE__, (t)) -#else -# define dump_literal(t) -#endif - -static struct cb_literal * -concat_literals (const cb_tree left, const cb_tree right) -{ - struct cb_literal *p; - unsigned char *ldata; - unsigned char *rdata; - size_t lsize; - size_t rsize; - - if (get_data_and_size_from_lit (left, &ldata, &lsize)) { - return NULL; - } - if (get_data_and_size_from_lit (right, &rdata, &rsize)) { - return NULL; - } - - p = make_tree (CB_TAG_LITERAL, left->category, sizeof (struct cb_literal)); - p->data = cobc_parse_malloc (lsize + rsize + 1U); - p->size = lsize + rsize; - - memcpy (p->data, ldata, lsize); - memcpy (p->data + lsize, rdata, rsize); - - dump_literal(p); - return p; -} - -static int -is_unconditionally_suppressed (const struct cb_field *record, cb_tree suppress_list) -{ - cb_tree l; - struct cb_ml_suppress_clause *suppress_clause; - - for (l = suppress_list; l; l = CB_CHAIN (l)) { - suppress_clause = CB_ML_SUPPRESS (CB_VALUE (l)); - if (!suppress_clause->when_list - && suppress_clause->target == CB_ML_SUPPRESS_IDENTIFIER - && cb_ref (suppress_clause->identifier) == CB_TREE (record)) { - /* - This is indeed the only case we need to check - all - other SUPPRESS targets require a WHEN clause. - */ - return 1; - } - } - - return 0; -} - -static cb_tree -get_ml_name (cb_tree record, cb_tree name_list, enum cb_ml_type type) -{ - cb_tree l; - cb_tree name_pair; - - if (type == CB_ML_CONTENT) { - return cb_null; - } - - for (l = name_list; l; l = CB_CHAIN (l)) { - name_pair = CB_VALUE (l); - if (cb_ref (CB_PAIR_X (name_pair)) == record) { - return CB_PAIR_Y (name_pair); - } - } - - return cb_build_alphanumeric_literal (cb_name (record), - strlen (cb_name (record))); -} - -static enum cb_ml_type -get_ml_type (cb_tree record, cb_tree type_list, const int default_to_attr) -{ - cb_tree l; - cb_tree type_pair; - - for (l = type_list; l; l = CB_CHAIN (l)) { - type_pair = CB_VALUE (l); - if (cb_ref (CB_PAIR_X (type_pair)) == record) { - return (enum cb_ml_type) CB_INTEGER ((CB_PAIR_Y (type_pair)))->val; - } - } - - if (default_to_attr - && (!CB_FIELD (record)->children - && !CB_FIELD (record)->flag_filler - && !CB_FIELD (record)->flag_occurs)) { - return CB_ML_ATTRIBUTE; - } else { - return CB_ML_ELEMENT; - } -} - -static int -is_target_of_suppress_identifier (cb_tree record, struct cb_ml_suppress_clause *clause) -{ - return clause->target == CB_ML_SUPPRESS_IDENTIFIER - && cb_ref (clause->identifier) == record; -} - -static int -is_target_of_suppress_type (cb_tree record, enum cb_ml_type type, - struct cb_ml_suppress_clause *clause) -{ - if (clause->target != CB_ML_SUPPRESS_TYPE) { - return 0; - } - - if (clause->ml_type != CB_ML_ANY_TYPE - && clause->ml_type != type) { - return 0; - } - - if (clause->category == CB_ML_SUPPRESS_CAT_NUMERIC) { - return cb_tree_category (record) == CB_CATEGORY_NUMERIC; - } else if (clause->category == CB_ML_SUPPRESS_CAT_NONNUMERIC) { - return cb_tree_category (record) != CB_CATEGORY_NUMERIC; - } else { /* CB_ML_SUPPRESS_CAT_ANY */ - return 1; - } -} - -static cb_tree -build_condition_token_list (cb_tree record, cb_tree when_list) -{ - cb_tree l; - cb_tree cond = NULL; - cb_tree record_ref; - - for (l = when_list; l; l = CB_CHAIN (l)) { - if (!cond) { - record_ref = cb_build_field_reference (CB_FIELD (record), NULL); - cond = cb_build_list (cb_int ('x'), record_ref, NULL); - } else { - cond = cb_build_list (cb_int ('|'), NULL, cond); - } - cond = cb_build_list (cb_int ('='), NULL, cond); - cond = cb_build_list (cb_int ('x'), CB_VALUE (l), cond); - } - - return cond; -} - -static int -is_suppress_all_or_applicable_suppress_type (cb_tree record, - enum cb_ml_type type, - struct cb_ml_suppress_clause *suppress_clause) -{ - return suppress_clause->target == CB_ML_SUPPRESS_ALL - || is_target_of_suppress_type (record, type, suppress_clause); -} - -static cb_tree -get_suppress_cond (cb_tree record, enum cb_ml_type type, - cb_tree suppress_list) -{ - cb_tree l; - struct cb_ml_suppress_clause *suppress_clause; - struct cb_ml_suppress_clause *last_applicable_suppress_id = NULL; - cb_tree suppress_cond = NULL; - - if (!record) { - /* TO-DO: Output check that all child elements are suppressed */ - /* TO-DO: Move this check to the callee? */ - return NULL; - } - - /* - Find the last SUPPRESS-identifier phrase which applies to record. Use - that if it exists. - */ - for (l = suppress_list; l; l = CB_CHAIN (l)) { - suppress_clause = CB_ML_SUPPRESS (CB_VALUE (l)); - if (is_target_of_suppress_identifier (record, suppress_clause)) { - last_applicable_suppress_id = suppress_clause; - } - } - - if (last_applicable_suppress_id) { - suppress_cond = build_condition_token_list (record, last_applicable_suppress_id->when_list); - } else { - /* - If record is not the subject of a SUPPRESS-identifier phrase, - apply all the WHEN's from all the applicable generic SUPPRESS - phrases. - */ - for (l = suppress_list; l; l = CB_CHAIN (l)) { - suppress_clause = CB_ML_SUPPRESS (CB_VALUE (l)); - if (!suppress_clause || !is_suppress_all_or_applicable_suppress_type (record, type, suppress_clause)) { - continue; - } - - suppress_cond = build_condition_token_list (record, suppress_clause->when_list); - } - } - - if (suppress_cond) { - /* Convert list of tokens into actual condition */ - suppress_cond = cb_build_cond (cb_build_expr (cb_list_reverse (suppress_cond))); - cb_end_cond (suppress_cond); - } - - return suppress_cond; -} - -static void -append_to_tree_list (struct cb_ml_generate_tree * * const head, - struct cb_ml_generate_tree * * const tail, - struct cb_ml_generate_tree *x) -{ - if (*head) { - (*tail)->sibling = x; - x->prev_sibling = *tail; - } else { - *head = x; - x->prev_sibling = NULL; - } - *tail = x; -} - -static void -set_ml_attrs_and_children (struct cb_field *record, const int children_are_attrs, - cb_tree name_list, cb_tree type_list, - cb_tree suppress_list, - struct cb_ml_generate_tree * const * const tree) -{ - struct cb_field *child; - cb_tree child_tree_or_null; - struct cb_ml_generate_tree *child_tree; - struct cb_ml_generate_tree *last_attr = NULL; - struct cb_ml_generate_tree *last_child_tree = NULL; - - (*tree)->children = NULL; - (*tree)->attrs = NULL; - for (child = record->children; child; child = child->sister) { - if (cb_field_is_ignored_in_ml_gen (child)) { - continue; - } - - child_tree_or_null = cb_build_ml_tree (child, 0, - children_are_attrs, - name_list, type_list, - suppress_list); - if (!child_tree_or_null) { - continue; - } - child_tree = CB_ML_TREE (child_tree_or_null); - child_tree->parent = *tree; - child_tree->sibling = NULL; - - if (child_tree->type == CB_ML_ATTRIBUTE) { - append_to_tree_list (&((*tree)->attrs), &last_attr, - child_tree); - } else { - append_to_tree_list (&((*tree)->children), - &last_child_tree, child_tree); - } - } -} - -/* Global functions */ - -char * -cb_to_cname (const char *s) -{ - char *copy; - unsigned char *p; - - copy = cobc_parse_strdup (s); - for (p = (unsigned char *)copy; *p; p++) { - if (*p == '-' || *p == ' ') { - *p = '_'; - } else { - *p = (cob_u8_t)toupper (*p); - } - } - return copy; -} - -struct cb_literal * -build_literal (const enum cb_category category, const void *data, - const size_t size) -{ - struct cb_literal *p; - - p = make_tree (CB_TAG_LITERAL, category, sizeof (struct cb_literal)); - p->data = cobc_parse_malloc (size + 1U); - p->size = size; - memcpy (p->data, data, size); - return p; -} - -char * -cb_name_errmsg (cb_tree x) -{ - char *s; - char tmp[COB_SMALL_BUFF] = { 0 }; - size_t tlen; - - tlen = cb_name_1 (tmp, x, COB_SMALL_MAX); - - /* adjust literal for output, snip if too long */ - if (x && CB_LITERAL_P(x)) { - char tmp2[40] = { 0 }; - if (tlen > 39) { - strcpy (tmp + 36, "..."); - } else { - tmp[tlen - 1] = 0; - } - strcpy (tmp2, tmp + 1); - tlen = sprintf (tmp, _("literal '%s'"), tmp2); - } - s = cobc_parse_malloc (tlen + 1); - strncpy (s, tmp, tlen); - - return s; -} - -char * -cb_name (cb_tree x) -{ - char *s; - char tmp[COB_NORMAL_BUFF] = { 0 }; - size_t tlen; - - tlen = cb_name_1 (tmp, x, COB_NORMAL_MAX); - s = cobc_parse_malloc (tlen + 1); - strncpy (s, tmp, tlen); - - return s; -} - -enum cb_category -cb_tree_category (cb_tree x) -{ - struct cb_cast *p; - struct cb_reference *r; - struct cb_field *f; - - if (x == cb_error_node) { - return (enum cb_category)0; - } - - /* LCOV_EXCL_START */ - if (x->category >= CB_CATEGORY_ERROR) { - cobc_err_msg (_("call to '%s' with invalid parameter '%s'"), - "cb_tree_category", "x"); - COBC_ABORT (); - } - /* LCOV_EXCL_STOP */ - if (x->category != CB_CATEGORY_UNKNOWN) { - return x->category; - } - - switch (CB_TREE_TAG (x)) { - case CB_TAG_CAST: - p = CB_CAST (x); - switch (p->cast_type) { - case CB_CAST_ADDRESS: - case CB_CAST_ADDR_OF_ADDR: - x->category = CB_CATEGORY_DATA_POINTER; - break; - case CB_CAST_PROGRAM_POINTER: - x->category = CB_CATEGORY_PROGRAM_POINTER; - break; - /* LCOV_EXCL_START */ - default: - cobc_err_msg (_("unexpected cast type: %d"), - (int)(p->cast_type)); - COBC_ABORT (); - /* LCOV_EXCL_STOP */ - } - break; - case CB_TAG_REFERENCE: - r = CB_REFERENCE (x); - x->category = cb_tree_category (r->value); - if (r->offset) { - switch (x->category) { - case CB_CATEGORY_ALPHANUMERIC: - case CB_CATEGORY_NATIONAL: - break; - case CB_CATEGORY_NATIONAL_EDITED: - x->category = CB_CATEGORY_NATIONAL; - break; - default: - x->category = CB_CATEGORY_ALPHANUMERIC; - } - } - break; - case CB_TAG_FIELD: - f = CB_FIELD (x); - if (f->children) { - /* CHECKME: may should be alphabetic/national depending on the content */ - x->category = CB_CATEGORY_ALPHANUMERIC; - } else if (f->usage == CB_USAGE_POINTER && f->level != 88) { - x->category = CB_CATEGORY_DATA_POINTER; - } else if (f->usage == CB_USAGE_PROGRAM_POINTER && f->level != 88) { - x->category = CB_CATEGORY_PROGRAM_POINTER; - } else { - switch (f->level) { - case 66: - if (f->rename_thru) { - /* CHECKME: may should be alphabetic/national depending on the content */ - x->category = CB_CATEGORY_ALPHANUMERIC; - } else { - x->category = cb_tree_category (CB_TREE (f->redefines)); - } - break; - case 88: - x->category = CB_CATEGORY_BOOLEAN; - break; - default: - if (f->usage == CB_USAGE_COMP_X) - x->category = CB_CATEGORY_NUMERIC; - else - if (f->pic) { - x->category = f->pic->category; - /* FIXME: Hack for CGI to not abort */ - } else if (f->flag_is_external_form) { - x->category = CB_CATEGORY_ALPHANUMERIC; - } else { - x->category = CB_CATEGORY_UNKNOWN; - } - break; - } - } - break; - case CB_TAG_ALPHABET_NAME: - case CB_TAG_LOCALE_NAME: - x->category = CB_CATEGORY_ALPHANUMERIC; - break; - case CB_TAG_BINARY_OP: - x->category = CB_CATEGORY_BOOLEAN; - break; - case CB_TAG_INTRINSIC: - x->category = CB_INTRINSIC(x)->intr_tab->category; - break; - default: -#if 0 /* RXWRXW - Tree tag */ - cobc_err_msg (_("unknown tree tag: %d, category: %d"), - (int)CB_TREE_TAG (x), (int)x->category); - COBC_ABORT (); -#endif - return CB_CATEGORY_UNKNOWN; - } - - return x->category; -} - -enum cb_class -cb_tree_class (cb_tree x) -{ - return category_to_class_table[CB_TREE_CATEGORY (x)]; -} - -int -cb_category_is_alpha (cb_tree x) -{ - return category_is_alphanumeric[CB_TREE_CATEGORY (x)]; -} - -int -cb_category_is_national (cb_tree x) -{ - return category_is_national[CB_TREE_CATEGORY (x)]; -} - -int -cb_tree_type (const cb_tree x, const struct cb_field *f) -{ - if (f->children) { - return COB_TYPE_GROUP; - } - - switch (CB_TREE_CATEGORY (x)) { - case CB_CATEGORY_ALPHABETIC: - case CB_CATEGORY_ALPHANUMERIC: - if (f->usage == CB_USAGE_COMP_X) { - return COB_TYPE_NUMERIC_BINARY; - } - return COB_TYPE_ALPHANUMERIC; - case CB_CATEGORY_ALPHANUMERIC_EDITED: - return COB_TYPE_ALPHANUMERIC_EDITED; - case CB_CATEGORY_NATIONAL: - return COB_TYPE_NATIONAL; - case CB_CATEGORY_NATIONAL_EDITED: - return COB_TYPE_NATIONAL_EDITED; - case CB_CATEGORY_NUMERIC: - switch (f->usage) { - case CB_USAGE_DISPLAY: - return COB_TYPE_NUMERIC_DISPLAY; - case CB_USAGE_BINARY: - case CB_USAGE_COMP_5: - case CB_USAGE_COMP_X: - case CB_USAGE_COMP_N: - case CB_USAGE_INDEX: - case CB_USAGE_HNDL: - case CB_USAGE_HNDL_WINDOW: - case CB_USAGE_HNDL_SUBWINDOW: - case CB_USAGE_HNDL_FONT: - case CB_USAGE_HNDL_THREAD: - case CB_USAGE_HNDL_MENU: - case CB_USAGE_HNDL_VARIANT: - case CB_USAGE_HNDL_LM: - case CB_USAGE_LENGTH: - return COB_TYPE_NUMERIC_BINARY; - case CB_USAGE_FLOAT: - return COB_TYPE_NUMERIC_FLOAT; - case CB_USAGE_DOUBLE: - return COB_TYPE_NUMERIC_DOUBLE; - case CB_USAGE_PACKED: - case CB_USAGE_COMP_6: - return COB_TYPE_NUMERIC_PACKED; - case CB_USAGE_LONG_DOUBLE: - return COB_TYPE_NUMERIC_L_DOUBLE; - case CB_USAGE_FP_BIN32: - return COB_TYPE_NUMERIC_FP_BIN32; - case CB_USAGE_FP_BIN64: - return COB_TYPE_NUMERIC_FP_BIN64; - case CB_USAGE_FP_BIN128: - return COB_TYPE_NUMERIC_FP_BIN128; - case CB_USAGE_FP_DEC64: - return COB_TYPE_NUMERIC_FP_DEC64; - case CB_USAGE_FP_DEC128: - return COB_TYPE_NUMERIC_FP_DEC128; - case CB_USAGE_BIT: /* FIXME: is neither numeric nor "cobc"-boolean */ - return COB_TYPE_BOOLEAN; - /* LCOV_EXCL_START */ - default: - cobc_err_msg (_("unexpected numeric USAGE: %d"), - (int)f->usage); - COBC_ABORT (); - /* LCOV_EXCL_STOP */ - } - case CB_CATEGORY_NUMERIC_EDITED: - case CB_CATEGORY_FLOATING_EDITED: - return COB_TYPE_NUMERIC_EDITED; - case CB_CATEGORY_OBJECT_REFERENCE: - case CB_CATEGORY_DATA_POINTER: - case CB_CATEGORY_PROGRAM_POINTER: - return COB_TYPE_NUMERIC_BINARY; - /* LCOV_EXCL_START */ - default: - cobc_err_msg (_("unexpected category: %d"), - (int)CB_TREE_CATEGORY (x)); - COBC_ABORT (); - /* LCOV_EXCL_STOP */ - } - /* NOT REACHED */ -#ifndef _MSC_VER - return 0; /* LCOV_EXCL_LINE */ -#endif -} - -int -cb_fits_int (const cb_tree x) -{ - struct cb_literal *l; - struct cb_field *f; - const char *s; - const unsigned char *p; - size_t size; - - switch (CB_TREE_TAG (x)) { - case CB_TAG_LITERAL: - l = CB_LITERAL (x); - if (l->scale > 0) { - return 0; - } - for (size = 0, p = l->data; size < l->size; ++size, ++p) { - if (*p != (unsigned char)'0') { - break; - } - } - size = l->size - size - l->scale; - if (size < 10) { - return 1; - } - if (size > 10) { - return 0; - } - if (l->sign < 0) { - s = "2147483648"; - } else { - s = "2147483647"; - } - if (memcmp (p, s, (size_t)10) > 0) { - return 0; - } - return 1; - case CB_TAG_FIELD: - f = CB_FIELD (x); - if (f->children) { - return 0; - } - switch (f->usage) { - case CB_USAGE_INDEX: - case CB_USAGE_HNDL: - case CB_USAGE_HNDL_WINDOW: - case CB_USAGE_HNDL_SUBWINDOW: - case CB_USAGE_HNDL_FONT: - case CB_USAGE_HNDL_THREAD: - case CB_USAGE_HNDL_MENU: - case CB_USAGE_HNDL_VARIANT: - case CB_USAGE_HNDL_LM: - case CB_USAGE_LENGTH: - return 1; - case CB_USAGE_BINARY: - case CB_USAGE_COMP_5: - case CB_USAGE_COMP_X: - case CB_USAGE_COMP_N: - if (f->pic->scale <= 0 && f->size <= (int)sizeof (int)) { - return 1; - } - return 0; - case CB_USAGE_DISPLAY: - if (f->size < 10) { - if (!f->pic || f->pic->scale <= 0) { - return 1; - } - } - return 0; - case CB_USAGE_PACKED: - case CB_USAGE_COMP_6: - if (f->pic->scale <= 0 && f->pic->digits < 10) { - return 1; - } - return 0; - default: - return 0; - } - case CB_TAG_REFERENCE: - return cb_fits_int (CB_REFERENCE (x)->value); - case CB_TAG_INTEGER: - return 1; - default: - return 0; - } -} - -int -cb_fits_long_long (const cb_tree x) -{ - struct cb_literal *l; - struct cb_field *f; - const char *s; - const unsigned char *p; - size_t size; - - switch (CB_TREE_TAG (x)) { - case CB_TAG_LITERAL: - l = CB_LITERAL (x); - if (l->scale > 0) { - return 0; - } - for (size = 0, p = l->data; size < l->size; ++size, ++p) { - if (*p != (unsigned char)'0') { - break; - } - } - size = l->size - size - l->scale; - if (size < 19) { - return 1; - } - if (size > 19) { - return 0; - } - if (l->sign < 0) { - s = "9223372036854775808"; - } else { - s = "9223372036854775807"; - } - if (memcmp (p, s, (size_t)19) > 0) { - return 0; - } - return 1; - case CB_TAG_FIELD: - f = CB_FIELD (x); - if (f->children) { - return 0; - } - switch (f->usage) { - case CB_USAGE_INDEX: - case CB_USAGE_HNDL: - case CB_USAGE_HNDL_WINDOW: - case CB_USAGE_HNDL_SUBWINDOW: - case CB_USAGE_HNDL_FONT: - case CB_USAGE_HNDL_THREAD: - case CB_USAGE_HNDL_MENU: - case CB_USAGE_HNDL_VARIANT: - case CB_USAGE_HNDL_LM: - case CB_USAGE_LENGTH: - return 1; - case CB_USAGE_BINARY: - case CB_USAGE_COMP_5: - case CB_USAGE_COMP_X: - case CB_USAGE_COMP_N: - if (f->pic->scale <= 0 && - f->size <= (int)sizeof (cob_s64_t)) { - return 1; - } - return 0; - case CB_USAGE_DISPLAY: - if (f->pic->scale <= 0 && f->size < 19) { - return 1; - } - return 0; - case CB_USAGE_PACKED: - case CB_USAGE_COMP_6: - if (f->pic->scale <= 0 && f->pic->digits < 19) { - return 1; - } - return 0; - default: - return 0; - } - case CB_TAG_REFERENCE: - return cb_fits_long_long (CB_REFERENCE (x)->value); - case CB_TAG_INTEGER: - return 1; - default: - return 0; - } -} - -static void -error_numeric_literal (const char *literal) -{ - char lit_out[39]; - - /* snip literal for output, if too long */ - strncpy (lit_out, literal, 38); - if (strlen (literal) > 38) { - strcpy (lit_out + 35, "..."); - } else { - lit_out[38] = '\0'; - } - cb_error (_("invalid numeric literal: '%s'"), lit_out); - cb_error ("%s", err_msg); -} - -/* Check numeric literal length, postponed from scanner.l (scan_numeric) */ -static void -check_lit_length (const int unsigned size, const char *lit) -{ - if (unlikely(size > COB_MAX_DIGITS)) { - /* Absolute limit */ - snprintf (err_msg, COB_MINI_MAX, - _("literal length %d exceeds maximum of %d digits"), - size, COB_MAX_DIGITS); - error_numeric_literal (lit); - } else if (unlikely(size > cb_numlit_length)) { - snprintf (err_msg, COB_MINI_MAX, - _("literal length %d exceeds %d digits"), - size, cb_numlit_length); - error_numeric_literal (lit); - } -} - -int -cb_get_int (const cb_tree x) -{ - struct cb_literal *l; - const char *s; - unsigned int size, i; - int val; - - if (x == NULL || x == cb_error_node) return 0; - if (CB_INTEGER_P(x)) return CB_INTEGER(x)->val; - - /* LCOV_EXCL_START */ - if (!CB_LITERAL_P (x)) { - /* not translated as it is a highly unlikely internal abort */ - cobc_err_msg ("invalid literal cast"); - COBC_ABORT (); - } - /* LCOV_EXCL_STOP */ - l = CB_LITERAL (x); - - /* Skip leading zeroes */ - for (i = 0; i < l->size; i++) { - if (l->data[i] != '0') { - break; - } - } - - /* Check numeric literal length, postponed from scanner.l (scan_numeric) */ - size = l->size - i; - if (l->scale < 0) { - size = size - l->scale; - } - check_lit_length(size, (const char *)l->data + i); - - /* Check numeric literal length matching requested output type */ -#if INT_MAX >= 9223372036854775807 - if (unlikely(size >= 19U)) { - if (l->sign < 0) { - s = "9223372036854775808"; - } else { - s = "9223372036854775807"; - } - if (size > 19U || memcmp (&l->data[i], s, (size_t)19) > 0) { - cb_error_x (x,_("numeric literal '%s' exceeds limit '%s'"), &l->data[i], s); - return INT_MAX; - } - } -#elif INT_MAX >= 2147483647 - if (unlikely(size >= 10U)) { - if (l->sign < 0) { - s = "2147483648"; - } else { - s = "2147483647"; - } - if (size > 10U || memcmp (&l->data[i], s, (size_t)10) > 0) { - cb_error_x (x,_("numeric literal '%s' exceeds limit '%s'"), &l->data[i], s); - return INT_MAX; - } - } -#else -#error compiler maximum for INT seems to be 16bit -#endif - - val = 0; - for (; i < l->size; i++) { - if( !isdigit(l->data[i]) ) { - fprintf(stdout, "'%.*s' at pos %d of %d is not an ASCII digit\n", - l->size, l->data, i+1, l->size); - continue; - } - val = val * 10 + l->data[i] - '0'; - } - if (val && l->sign < 0) { - val = -val; - } - return val; -} - -cob_s64_t -cb_get_long_long (const cb_tree x) -{ - struct cb_literal *l; - const char *s; - unsigned int size, i; - cob_s64_t val; - - /* LCOV_EXCL_START */ - if (!CB_LITERAL_P (x)) { - /* not translated as it is a highly unlikely internal abort */ - cobc_err_msg ("invalid literal cast"); - COBC_ABORT (); - } - /* LCOV_EXCL_STOP */ - l = CB_LITERAL (x); - - /* Skip leading zeroes */ - for (i = 0; i < l->size; i++) { - if (l->data[i] != '0') { - break; - } - } - - /* Check numeric literal length, postponed from scanner.l (scan_numeric) */ - size = l->size - i; - if (l->scale < 0) { - size = size - l->scale; - } - check_lit_length(size, (const char *)l->data + i); - - /* Check numeric literal length matching requested output type */ - if (unlikely (size >= 19U)) { - if (l->sign < 0) { - s = "9223372036854775808"; - } else { - s = "9223372036854775807"; - } - if (size > 19U || memcmp (&(l->data[i]), s, (size_t)19) > 0) { - cb_error_x (x,_("numeric literal '%s' exceeds limit '%s'"), &l->data[i], s); - return LLONG_MAX; - } - } - - val = 0; - for (; i < l->size; i++) { - val = val * 10 + (l->data[i] & 0x0F); - } - if (val && l->sign < 0) { - val = -val; - } - return val; -} - -cob_u64_t -cb_get_u_long_long (const cb_tree x) -{ - struct cb_literal *l; - const char *s; - unsigned int size, i; - cob_u64_t val; - - /* LCOV_EXCL_START */ - if (!CB_LITERAL_P (x)) { - /* not translated as it is a highly unlikely internal abort */ - cobc_err_msg ("invalid literal cast"); - COBC_ABORT (); - } - /* LCOV_EXCL_STOP */ - l = CB_LITERAL (x); - - /* Skip leading zeroes */ - for (i = 0; i < l->size; i++) { - if (l->data[i] != '0') { - break; - } - } - - /* Check numeric literal length, postponed from scanner.l (scan_numeric) */ - size = l->size - i; - if (l->scale < 0) { - size = size - l->scale; - } - check_lit_length(size, (const char *)l->data + i); - - /* Check numeric literal length matching requested output type */ - if (unlikely(size >= 20U)) { - s = "18446744073709551615"; - if (size > 20U || memcmp (&(l->data[i]), s, (size_t)20) > 0) { - cb_error_x (x,_("numeric literal '%s' exceeds limit '%s'"), &l->data[i], s); - return ULLONG_MAX; - } - } - val = 0; - for (; i < l->size; i++) { - val = val * 10 + (l->data[i] & 0x0F); - } - return val; -} - -void -cb_init_constants (void) -{ - int i; - - cb_error_node = make_constant (CB_CATEGORY_UNKNOWN, NULL); - cb_any = make_constant (CB_CATEGORY_UNKNOWN, NULL); - cb_true = make_constant (CB_CATEGORY_BOOLEAN, "1"); - cb_false = make_constant (CB_CATEGORY_BOOLEAN, "0"); - cb_null = make_constant (CB_CATEGORY_DATA_POINTER, "0"); - cb_zero = make_constant (CB_CATEGORY_NUMERIC, "&cob_all_zero"); - cb_space = make_constant (CB_CATEGORY_ALPHANUMERIC, "&cob_all_space"); - cb_low = make_constant (CB_CATEGORY_ALPHANUMERIC, "&cob_all_low"); - cb_norm_low = cb_low; - cb_high = make_constant (CB_CATEGORY_ALPHANUMERIC, "&cob_all_high"); - cb_norm_high = cb_high; - cb_quote = make_constant (CB_CATEGORY_ALPHANUMERIC, "&cob_all_quote"); - cb_one = cb_build_numeric_literal (0, "1", 0); - cb_zero_lit = cb_build_numeric_literal (0, "0", 0); - cb_int0 = cb_int (0); - cb_int1 = cb_int (1); - cb_int2 = cb_int (2); - cb_int3 = cb_int (3); - cb_int4 = cb_int (4); - cb_int5 = cb_int (5); - cb_int6 = cb_int (6); - cb_int7 = cb_int (7); - cb_int8 = cb_int (8); - cb_int16 = cb_int (16); - for (i = 0; i < COB_MAX_SUBSCRIPTS; i++) { - cb_i[i] = make_constant (CB_CATEGORY_NUMERIC, cb_const_subs[i]); - } - cb_standard_error_handler = make_constant_label ("Default Error Handler"); - CB_LABEL (cb_standard_error_handler)->flag_default_handler = 1; - memset (container_progs, 0, sizeof(container_progs)); -} - -/* List */ - -cb_tree -cb_build_list (cb_tree purpose, cb_tree value, cb_tree chain) -{ - struct cb_list *p; - - p = make_tree (CB_TAG_LIST, CB_CATEGORY_UNKNOWN, sizeof (struct cb_list)); - p->chain = chain; - p->value = value; - p->purpose = purpose; - - /* Set location to that of initial element. */ - if (value) { - SET_SOURCE(CB_TREE(p), value->source_file, value->source_line); - CB_TREE(p)->source_column = value->source_column; - } - - return CB_TREE (p); -} - -cb_tree -cb_list_append (cb_tree l1, cb_tree l2) -{ - if (l1 == NULL) { - return l2; - } - CB_CHAIN (get_last_elt (l1)) = l2; - return l1; -} - -cb_tree -cb_list_add (cb_tree l, cb_tree x) -{ - return cb_list_append (l, CB_LIST_INIT (x)); -} - -cb_tree -cb_pair_add (cb_tree l, cb_tree x, cb_tree y) -{ - return cb_list_append (l, CB_BUILD_PAIR (x, y)); -} - -/* Reverse a list of trees, - NOTE: changes the passed list directly! */ -cb_tree -cb_list_reverse (cb_tree l) -{ - cb_tree next; - cb_tree last; - - last = NULL; - for (; l; l = next) { - next = CB_CHAIN (l); - CB_CHAIN (l) = last; - last = l; - } - return last; -} - -unsigned int -cb_list_length (cb_tree l) -{ - if (CB_VALID_TREE(l)) { - unsigned int n = 0; - for (; l; l = CB_CHAIN (l)) { - n++; - } - return n; - } - return 0; -} - -int -cb_list_map (cb_tree (*func) (cb_tree x), cb_tree l) -{ - int ret = 0; - for (; l; l = CB_CHAIN (l)) { - if ((CB_VALUE (l) = func (CB_VALUE (l))) == cb_error_node) { - ret = 1; - } - } - return ret; -} - -unsigned int -cb_next_length (struct cb_next_elem *l) -{ - unsigned int n; - - n = 0; - for (; l; l = l->next) { - n++; - } - return n; -} - -/* Link value into the reference */ - -const char * -cb_define (cb_tree name, cb_tree val) -{ - struct cb_word *w; - - w = CB_REFERENCE (name)->word; - w->items = cb_list_add (w->items, val); - w->count++; - SET_SOURCE(val, name->source_file, name->source_line); - CB_REFERENCE (name)->value = val; - return w->name; -} - -/* Program */ - -static struct nested_list * -add_contained_prog (struct nested_list *parent_list, struct cb_program *child_prog) -{ - struct nested_list *nlp; - - /* Check for reuse */ - for (nlp = parent_list; nlp; nlp = nlp->next) { - if (nlp->nested_prog == child_prog) { - return parent_list; - } - } - nlp = cobc_parse_malloc (sizeof (struct nested_list)); - nlp->next = parent_list; - nlp->nested_prog = child_prog; - return nlp; -} - -void -cb_tree_source_set (const char func[], int line, cb_tree tree, - const char source_file[], int source_line ) -{ - tree->source_file = source_file; - tree->source_line = source_line; - - if(getenv("COBC_TRACE")) { - printf( "%s:%d: set tag %d for %s:%d ", - func, line, tree->tag, - tree->source_file, tree->source_line ); - if( CB_LITERAL_P(tree) ) { - const struct cb_literal *p = CB_LITERAL(tree); - if( p->data ) { - printf( "(%p: %.*s, size=%d)", - p, p->size, p->data, p->size ); - } - } - if( CB_FIELD_P(tree) ) { - const struct cb_field *p = CB_FIELD(tree); - if( p->name ) { - printf( "('%s' a/k/a '%s')", - p->name, p->ename ); - } - } - printf("\n"); - } -} - -struct cb_program * -cb_build_program (struct cb_program *last_program, const int nest_level) -{ - struct cb_program *p; - struct cb_program *q; - - if (!last_program) { - toplev_count = 0; - } - cb_reset_78 (); - cobc_in_procedure = 0; - cobc_in_repository = 0; - cb_clear_real_field (); - - p = cobc_parse_malloc (sizeof (struct cb_program)); - memset (p, 0, sizeof (struct cb_program)); - p->word_table = cobc_parse_malloc (CB_WORD_TABLE_SIZE); - - p->common.tag = CB_TAG_PROGRAM; - p->common.category = CB_CATEGORY_UNKNOWN; - - p->common.source_file = cobc_parse_strdup (cb_source_file); - p->common.source_line = cb_source_line; - - p->next_program = last_program; - p->nested_level = nest_level; - p->decimal_point = '.'; - p->currency_symbol = '$'; - p->numeric_separator = ','; - if (cb_call_extfh) { - p->extfh = cobc_parse_strdup (cb_call_extfh); - } - /* Save current program as actual at it's level */ - container_progs[nest_level] = p; - if (nest_level - && last_program /* <- silence warnings */) { - /* Contained program */ - /* Inherit from upper level */ - p->global_file_list = last_program->global_file_list; - p->collating_sequence = last_program->collating_sequence; - p->classification = last_program->classification; - p->mnemonic_spec_list = last_program->mnemonic_spec_list; - p->class_spec_list = last_program->class_spec_list; - p->interface_spec_list = last_program->interface_spec_list; - p->function_spec_list = last_program->function_spec_list; - p->user_spec_list = last_program->user_spec_list; - p->program_spec_list = last_program->program_spec_list; - p->property_spec_list = last_program->property_spec_list; - p->alphabet_name_list = last_program->alphabet_name_list; - p->symbolic_char_list = last_program->symbolic_char_list; - p->class_name_list = last_program->class_name_list; - p->locale_list = last_program->locale_list; - p->decimal_point = last_program->decimal_point; - p->numeric_separator = last_program->numeric_separator; - p->currency_symbol = last_program->currency_symbol; - p->entry_convention = last_program->entry_convention; - p->flag_trailing_separate = last_program->flag_trailing_separate; - p->flag_console_is_crt = last_program->flag_console_is_crt; - /* RETURN-CODE is global for contained programs */ - if (last_program->cb_return_code) { - p->cb_return_code = last_program->cb_return_code; - CB_FIELD_PTR (last_program->cb_return_code)->flag_is_global = 1; - } - p->toplev_count = last_program->toplev_count; - /* Add program to itself for possible recursion */ - p->nested_prog_list = add_contained_prog (p->nested_prog_list, p); - /* Add contained program to it's parent */ - q = container_progs[nest_level - 1]; - q->nested_prog_list = add_contained_prog (q->nested_prog_list, p); - } else { - /* Top level program */ - p->toplev_count = toplev_count++; - functions_are_all = cb_flag_functions_all; - cb_reset_global_78 (); - /* Recursive check disabled? Then handle all programs as recursive */ - if (!cb_flag_recursive_check) { - p->flag_recursive = 1; - } - } - return p; -} - -void -cb_add_common_prog (struct cb_program *prog) -{ - struct cb_program *q; - - /* Here we are sure that nested >= 1 */ - q = container_progs[prog->nested_level - 1]; - q->common_prog_list = add_contained_prog (q->common_prog_list, prog); -} - -void -cb_insert_common_prog (struct cb_program *prog, struct cb_program *comprog) -{ - prog->nested_prog_list = add_contained_prog (prog->nested_prog_list, - comprog); -} - -/* Integer */ - -static COB_INLINE COB_A_INLINE cb_tree -cb_int_uncached (const int n) -{ - struct cb_integer* y; - cb_tree x; - - /* Do not use make_tree here as we want a main_malloc - instead of parse_malloc! */ - y = cobc_main_malloc (sizeof (struct cb_integer)); - y->val = n; - - x = CB_TREE (y); - x->tag = CB_TAG_INTEGER; - x->category = CB_CATEGORY_NUMERIC; - x->source_file = cb_source_file; - x->source_line = cb_source_line; - - return x; -} - -#if CACHED_INTEGERS -cb_tree -cb_int (const int n) -{ - struct int_node *p; - cb_tree x; - - /* performance note: the following loop used 3% (according to callgrind) - of the complete time spent in a sample run with - -fsyntax-only on 880 production code files (2,500,000 LOC) - according to gcov we entered this function 629684 times with only 280 new - entries but the loop produces a lot of comparisions: - for: 122441668, if: 122441388 - second-sample: one-file 430,000 LOC with many numbers: takes 36 % of the time - */ - for (p = int_node_table; p; p = p->next) { - if (p->node->val == n) { - return CB_TREE (p->node); - } - } - - x = cb_int_uncached (n); - - p = cobc_main_malloc (sizeof (struct int_node)); - p->node = CB_INTEGER(x); - p->next = int_node_table; - int_node_table = p; - - return x; -} - -cb_tree -cb_int_hex (const int n) -{ -#ifdef USE_INT_HEX /* Simon: using this increases the struct and we - *should* pass the flags as constants in any case... */ - struct int_node *p; - struct cb_integer *y; - cb_tree x; - - /* note: we do need to do this here on a different cached note as we'd - set cached values to be generated as integers otherwise */ - for (p = int_node_table_hex; p; p = p->next) { - if (p->node->val == n) { - return CB_TREE (p->node); - } - } - - /* Do not use make_tree here as we want a main_malloc - instead of parse_malloc! */ - y = cobc_main_malloc (sizeof(struct cb_integer)); - y->val = n; - y->hexval = 1; - - x = CB_TREE (y); - x->tag = CB_TAG_INTEGER; - x->category = CB_CATEGORY_NUMERIC; - x->source_file = cb_source_file; - x->source_line = cb_source_line; - - p = cobc_main_malloc (sizeof (struct int_node)); - p->node = y; - p->next = int_node_table_hex; - int_node_table_hex = p; - - return x; -#else - return cb_int (n); -#endif -} - - -#else /* ! CACHED_INTEGERS */ - -cb_tree -cb_int (const int n) -{ - /* not yet allocated -> uncached */ - if (!cb_int16) return cb_int_uncached (n); - - switch (n) { - case 0: return cb_int0; - case 1: return cb_int1; - case 2: return cb_int2; - case 3: return cb_int3; - case 4: return cb_int4; - case 5: return cb_int5; - case 6: return cb_int6; - case 7: return cb_int7; - case 8: return cb_int8; - default: return cb_int_uncached (n); - } -} - -cb_tree -cb_int_hex (const int n) -{ -#ifdef USE_INT_HEX /* Simon: using this increases the struct and we - *should* pass the flags as constants in any case... */ - cb_tree x = cb_int_uncached (n); - CB_INTEGER(x)->hexval = 1; - return x; -#else - return cb_int (n); -#endif -} - -#endif /* ! CACHED_INTEGERS */ - -/* String */ - -cb_tree -cb_build_string (const void *data, const size_t size) -{ - struct cb_string *p; - - p = make_tree (CB_TAG_STRING, CB_CATEGORY_ALPHANUMERIC, - sizeof (struct cb_string)); - p->size = size; - p->data = data; - return CB_TREE (p); -} - -/* Flags */ - -cb_tree -cb_flags_t (const cob_flags_t n) -{ - - /* FIXME: - - This ONLY works for the current version as we have one bit left before - we actually need the 64bit cob_flags_t that we use internally - in cobc (needed already for syntax checks) and in screenio - (needed soon, but not yet, hence the bitmask). - - Ideally we either store the flags as string here or mark them and - output the flags in codegen as flags, making the code much more readable. - */ - - return cb_int ((int) (n & 0xFFFFFFFF)); -} - -/* Code output and comment */ - -cb_tree -cb_build_comment (const char *str) -{ - struct cb_direct *p; - - p = make_tree (CB_TAG_DIRECT, CB_CATEGORY_ALPHANUMERIC, - sizeof (struct cb_direct)); - p->line = str; - SET_SOURCE_CB( CB_TREE (p) ); - return CB_TREE (p); -} - -cb_tree -cb_build_direct (const char *str, const unsigned int flagnl) -{ - cb_tree x; - - x = cb_build_comment (str); - CB_DIRECT (x)->flag_is_direct = 1; - CB_DIRECT (x)->flag_new_line = flagnl; - return x; -} - -/* DEBUG */ - -cb_tree -cb_build_debug (const cb_tree target, const char *str, const cb_tree fld) -{ - struct cb_debug *p; - - p = make_tree (CB_TAG_DEBUG, CB_CATEGORY_ALPHANUMERIC, - sizeof (struct cb_debug)); - p->target = target; - if (str) { - p->value = cobc_parse_strdup (str); - p->fld = NULL; - p->size = strlen (str); - } else { - p->value = NULL; - p->fld = fld; - p->size = (size_t)CB_FIELD_PTR (fld)->size; - } - SET_SOURCE_CB( CB_TREE (p) ); - return CB_TREE (p); -} - -/* DEBUG Callback */ - -cb_tree -cb_build_debug_call (struct cb_label *target) -{ - struct cb_debug_call *p; - - p = make_tree (CB_TAG_DEBUG_CALL, CB_CATEGORY_ALPHANUMERIC, - sizeof (struct cb_debug_call)); - p->target = target; - SET_SOURCE_CB( CB_TREE (p) ); - return CB_TREE (p); -} - -/* Alphabet-name */ - -cb_tree -cb_build_alphabet_name (cb_tree name) -{ - struct cb_alphabet_name *p; - - if (!name || name == cb_error_node) { - return NULL; - } - p = make_tree (CB_TAG_ALPHABET_NAME, CB_CATEGORY_UNKNOWN, - sizeof (struct cb_alphabet_name)); - p->name = cb_define (name, CB_TREE (p)); - p->cname = cb_to_cname (p->name); - return CB_TREE (p); -} - -/* Class-name */ - -cb_tree -cb_build_class_name (cb_tree name, cb_tree list) -{ - struct cb_class_name *p; - - if (!name || name == cb_error_node) { - return NULL; - } - p = make_tree (CB_TAG_CLASS_NAME, CB_CATEGORY_BOOLEAN, - sizeof (struct cb_class_name)); - p->name = cb_define (name, CB_TREE (p)); - if (!scratch_buff) { - scratch_buff = cobc_main_malloc ((size_t)COB_MINI_BUFF); - } - snprintf (scratch_buff, (size_t)COB_MINI_MAX, "cob_is_%s_%d", - cb_to_cname (p->name), class_id++); - p->cname = cobc_parse_strdup (scratch_buff); - p->list = list; - return CB_TREE (p); -} - -/* Locale-name */ - -cb_tree -cb_build_locale_name (cb_tree name, cb_tree list) -{ - struct cb_class_name *p; - - if (!name || name == cb_error_node) { - return NULL; - } - if (!CB_LITERAL_P (list) || CB_NUMERIC_LITERAL_P (list)) { - cb_error (_("invalid LOCALE literal")); - return cb_error_node; - } - p = make_tree (CB_TAG_LOCALE_NAME, CB_CATEGORY_UNKNOWN, - sizeof (struct cb_locale_name)); - p->name = cb_define (name, CB_TREE (p)); - p->cname = cb_to_cname (p->name); - p->list = list; - return CB_TREE (p); -} - -/* System-name */ - -cb_tree -cb_build_system_name (const enum cb_system_name_category category, const int token) -{ - struct cb_system_name *p; - - p = make_tree (CB_TAG_SYSTEM_NAME, CB_CATEGORY_UNKNOWN, - sizeof (struct cb_system_name)); - p->category = category; - p->token = token; - return CB_TREE (p); -} - -/* Literal */ - -cb_tree -cb_build_numeric_literal (int sign, const void *data, const int scale) -{ - struct cb_literal *p; - cb_tree l; - /* using an intermediate char pointer for pointer arithmetic */ - const char *data_chr_ptr = data; - -#if 0 /* CHECKME - shouldn't this be what we want? */ - if (*data_chr_ptr == '-') { - if (sign < 1) { - sign = 1; - } else { - sign = -1; - } - data_chr_ptr++; - } else if (*data_chr_ptr == '+') { - if (sign < 1) { - sign = -1; - } else { - sign = 1; - } - data_chr_ptr++; - } -#else - if (*data_chr_ptr == '-') { - sign = -1; - data_chr_ptr++; - } else if (*data_chr_ptr == '+') { - sign = 1; - data_chr_ptr++; - } -#endif - data = data_chr_ptr; - p = build_literal (CB_CATEGORY_NUMERIC, data, strlen (data)); - p->sign = (short)sign; - p->scale = scale; - - l = CB_TREE (p); - - l->source_file = cb_source_file; - l->source_line = cb_source_line; - - return l; -} - -cb_tree -cb_build_numsize_literal (const void *data, const size_t size, const int sign) -{ - struct cb_literal *p; - cb_tree l; - - p = build_literal (CB_CATEGORY_NUMERIC, data, size); - p->sign = (short)sign; - - l = CB_TREE (p); - - SET_SOURCE_CB( l ); - - return l; -} - -cb_tree -cb_build_alphanumeric_literal (const void *data, const size_t size) -{ - cb_tree l; - - l = CB_TREE (build_literal (CB_CATEGORY_ALPHANUMERIC, data, size)); - - SET_SOURCE_CB( l ); - - return l; -} - -cb_tree -cb_build_national_literal (const void *data, const size_t size) -{ - cb_tree l; - - l = CB_TREE (build_literal (CB_CATEGORY_NATIONAL, data, size)); - - SET_SOURCE_CB( l ); - - return l; -} - -cb_tree -cb_concat_literals (const cb_tree x1, const cb_tree x2) -{ - struct cb_literal *p; - cb_tree l; - char lit_out[39]; - - if (x1 == cb_error_node || x2 == cb_error_node) { - return cb_error_node; - } - - if ((x1->category != x2->category)) { - cb_error_x (x1, _("only literals with the same category can be concatenated")); - return cb_error_node; - } - - if ((x1->category != CB_CATEGORY_ALPHANUMERIC) && - (x1->category != CB_CATEGORY_NATIONAL) && - (x1->category != CB_CATEGORY_BOOLEAN)) { - cb_error_x (x1, _("only alphanumeric, national or boolean literals may be concatenated")); - return cb_error_node; - } - - p = concat_literals (x1, x2); - if (p == NULL) { - return cb_error_node; - } - if (p->size > cb_lit_length) { - /* shorten literal for output */ - strncpy (lit_out, (char *)p->data, 38); - strcpy (lit_out + 35, "..."); - cb_error_x (x1, _("invalid literal: '%s'"), lit_out); - cb_error_x (x1, _("literal length %d exceeds %d characters"), - p->size, cb_lit_length); - return cb_error_node; - } - - l = CB_TREE (p); - - SET_SOURCE_CB( l ); - - return l; -} - -/* Decimal */ - -cb_tree -cb_build_decimal (const unsigned int id) -{ - struct cb_decimal *p; - - p = make_tree (CB_TAG_DECIMAL, CB_CATEGORY_NUMERIC, - sizeof (struct cb_decimal)); - p->id = id; - return CB_TREE (p); -} - -/* Decimal Literal */ - -cb_tree -cb_build_decimal_literal (const int id) -{ - struct cb_decimal *p; - - p = make_tree (CB_TAG_DECIMAL_LITERAL, CB_CATEGORY_NUMERIC, - sizeof (struct cb_decimal)); - p->id = id; - return CB_TREE (p); -} - -/* Picture */ - -struct cb_picture * -cb_build_binary_picture (const char *str, const cob_u32_t size, - const cob_u32_t sign) -{ - struct cb_picture *pic; - - pic = make_tree (CB_TAG_PICTURE, CB_CATEGORY_NUMERIC, - sizeof (struct cb_picture)); - pic->orig = cobc_check_string (str); - pic->size = size; - pic->digits = size; - pic->scale = 0; - pic->have_sign = sign; - pic->category = CB_CATEGORY_NUMERIC; - return pic; -} - -static COB_INLINE COB_A_INLINE int -is_simple_insertion_char (const char c) -{ - return c == 'B' || c == '0' || c == '/' - || (current_program && c == current_program->numeric_separator); -} - -/* - Returns the first and last characters of a floating insertion string. - - A floating insertion string is made up of two adjacent +'s, -'s or currency - symbols to each other, optionally with simple insertion characters between them. -*/ -static void -find_floating_insertion_str (const cob_pic_symbol *str, - const cob_pic_symbol **first, - const cob_pic_symbol **last) -{ - const cob_pic_symbol *last_non_simple_insertion = NULL; - char floating_char = ' '; - - *first = NULL; - *last = NULL; - - for (; str->symbol != '\0'; ++str) { - if (!*first - && (str->symbol == '+' - || str->symbol == '-' - || (current_program && (str->symbol == current_program->currency_symbol)))) { - if (last_non_simple_insertion - && last_non_simple_insertion->symbol == str->symbol) { - *first = last_non_simple_insertion; - floating_char = str->symbol; - continue; - } else if (str->times_repeated > 1) { - *first = str; - floating_char = str->symbol; - continue; - } - } - - - if (!*first && !is_simple_insertion_char (str->symbol)) { - last_non_simple_insertion = str; - } else if (*first && !(is_simple_insertion_char (str->symbol) - || str->symbol == floating_char)) { - *last = str - 1; - break; - } - } - - if (str->symbol == '\0' && *first) { - *last = str - 1; - return; - } else if (! ( str->symbol == 'V' - || (current_program && (str->symbol == current_program->decimal_point)))) { - return; - } - - /* - Check whether all digits after the decimal point are also part of the - floating insertion string. If they are, set *last to the last - character in the string. - */ - ++str; - for (; str->symbol != '\0'; ++str) { - if (!(is_simple_insertion_char (str->symbol) - || str->symbol == floating_char)) { - return; - } - } - *last = str - 1; -} - -static int -char_to_precedence_idx (const cob_pic_symbol *str, - const cob_pic_symbol *current_sym, - const cob_pic_symbol *first_floating_sym, - const cob_pic_symbol *last_floating_sym, - const int before_decimal_point, - const int non_p_digits_seen) -{ - const int first_sym = str == current_sym; - const int second_sym = str + 1 == current_sym; - const int last_sym = (current_sym + 1)->symbol == '\0'; - const int penultimate_sym - = !last_sym && (current_sym + 2)->symbol == '\0'; - - switch (current_sym->symbol) { - case 'B': - case '0': - case '/': - return 0; - - case '.': - case ',': - if (current_sym->symbol == current_program->decimal_point) { - return 2; - } else { - return 1; - } - - /* To-do: Allow floating-point PICTURE strings */ - /* case '+': */ - /* Exponent symbol */ - /* return 3; */ - - case '+': - case '-': - if (!(first_floating_sym <= current_sym - && current_sym <= last_floating_sym)) { - if (first_sym) { - return 4; - } else if (last_sym) { - return 5; - } else { - /* Fudge char type - will still result in error */ - return 4; - } - } else { - if (before_decimal_point) { - return 11; - } else { - return 12; - } - } - - case 'C': - case 'D': - return 6; - - case 'Z': - case '*': - if (before_decimal_point) { - return 9; - } else { - return 10; - } - - case '9': - return 15; - - case 'A': - case 'X': - return 16; - - case 'S': - return 17; - - case 'V': - return 18; - - case 'P': - if (non_p_digits_seen && before_decimal_point) { - return 19; - } else { - return 20; - } - - case '1': - return 21; - - case 'N': - return 22; - - case 'E': - return 23; - - default: - if (current_sym->symbol == current_program->currency_symbol) { - if (!(first_floating_sym <= current_sym - && current_sym <= last_floating_sym)) { - if (first_sym || second_sym) { - return 7; - } else if (penultimate_sym || last_sym) { - return 8; - } else { - /* Fudge char type - will still result in error */ - return 7; - } - } else { - if (before_decimal_point) { - return 13; - } else { - return 14; - } - } - } else { - /* - Invalid characters have already been detected, so no - need to emit an error here. - */ - return -1; - } - } -} - -static const char * -get_char_type_description (const int idx) -{ - switch (idx) { - case 0: - return _("B, 0 or /"); - case 1: - if (current_program->numeric_separator == ',') { - return ","; - } else { - return "."; - } - case 2: - if (current_program->decimal_point == '.') { - return "."; - } else { - return ","; - } - case 3: - return _("the sign of the floating-point exponent"); - case 4: - return _("a leading +/- sign"); - case 5: - return _("a trailing +/- sign"); - case 6: - return _("CR or DB"); - case 7: - return _("a leading currency symbol"); - case 8: - return _("a trailing currency symbol"); - case 9: - return _("a Z or * which is before the decimal point"); - case 10: - return _("a Z or * which is after the decimal point"); - case 11: - return _("a floating +/- string which is before the decimal point"); - case 12: - return _("a floating +/- string which is after the decimal point"); - case 13: - return _("a floating currency symbol string which is before the decimal point"); - case 14: - return _("a floating currency symbol string which is after the decimal point"); - case 15: - return "9"; - case 16: - return _("A or X"); - case 17: - return "S"; - case 18: - return "V"; - case 19: - return _("a P which is before the decimal point"); - case 20: - return _("a P which is after the decimal point"); - case 21: - return "1"; - case 22: - return "N"; - case 23: - return "E"; - default: - return NULL; - } -} - -static void -emit_precedence_error (const int preceding_idx, const int following_idx) -{ - const char *preceding_descr = get_char_type_description (preceding_idx); - const char *following_descr = get_char_type_description (following_idx); - - - if (following_descr && preceding_descr) { - if (preceding_idx == following_idx) { - cb_error (_("%s may only occur once in a PICTURE string"), preceding_descr); - } else { - cb_error (_("%s cannot follow %s"), following_descr, preceding_descr); - } - } else { - cb_error (_("invalid PICTURE string detected")); - } -} - -static int -valid_char_order (const cob_pic_symbol *str, const int s_char_seen) -{ - const int precedence_table[24][24] = { - /* - Refer to the standard's PICTURE clause precedence rules for - complete explanation. - */ - /* - B , . + + + CR cs cs Z Z + + cs cs 9 A S V P P 1 N E - 0 - - DB * * - - X - / - */ - { 1, 1, 1, 0, 1, 0, 0, 1, 0, 1, 1, 1, 1, 1, 1, 1, 1, 0, 1, 0, 1, 0, 1, 0 }, - { 1, 1, 1, 0, 1, 0, 0, 1, 0, 1, 1, 1, 1, 1, 1, 1, 0, 0, 1, 0, 1, 0, 0, 0 }, - { 1, 1, 0, 0, 1, 0, 0, 1, 0, 1, 0, 1, 0, 1, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0 }, - { 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1 }, - { 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0 }, - { 1, 1, 1, 0, 0, 0, 0, 1, 1, 1, 1, 0, 0, 1, 1, 1, 0, 0, 1, 1, 1, 0, 0, 0 }, - { 1, 1, 1, 0, 0, 0, 0, 1, 1, 1, 1, 0, 0, 1, 1, 1, 0, 0, 1, 1, 1, 0, 0, 0 }, - { 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0 }, - { 1, 1, 1, 0, 1, 0, 0, 0, 0, 1, 1, 0, 0, 0, 0, 1, 0, 0, 1, 1, 1, 0, 0, 0 }, - { 1, 1, 0, 0, 1, 0, 0, 1, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0 }, - { 1, 1, 1, 0, 1, 0, 0, 1, 0, 1, 1, 0, 0, 0, 0, 0, 0, 0, 1, 0, 1, 0, 0, 0 }, - { 1, 1, 0, 0, 0, 0, 0, 1, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0 }, - { 1, 1, 1, 0, 0, 0, 0, 1, 0, 0, 0, 1, 1, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0 }, - { 1, 1, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0 }, - { 1, 1, 1, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 1, 1, 0, 0, 0, 1, 0, 0, 0, 0, 0 }, - { 1, 1, 1, 1, 1, 0, 0, 1, 0, 1, 0, 1, 0, 1, 0, 1, 1, 1, 1, 0, 1, 0, 0, 1 }, - { 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 1, 0, 0, 0, 0, 0, 0, 0 }, - { 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0 }, - { 1, 1, 0, 0, 1, 0, 0, 1, 0, 1, 0, 1, 0, 1, 0, 1, 0, 1, 0, 1, 0, 0, 0, 0 }, - { 1, 1, 0, 0, 1, 0, 0, 1, 0, 1, 0, 1, 0, 1, 0, 1, 0, 1, 0, 1, 0, 0, 0, 0 }, - { 0, 0, 0, 0, 1, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 1, 0, 1, 0, 0, 0 }, - { 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0 }, - { 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0 }, - { 1, 1, 1, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0 }, - }; - int error_emitted[24][24] = {{ 0 }}; - int chars_seen[24] = { 0 }; - const cob_pic_symbol *first_floating_sym; - const cob_pic_symbol *last_floating_sym; - int before_decimal_point = 1; - int idx; - const cob_pic_symbol *s; - int repeated; - int i; - int j; - int non_p_digits_seen = 0; - int error_detected = 0; - - chars_seen[17] = s_char_seen; - find_floating_insertion_str (str, &first_floating_sym, &last_floating_sym); - - for (s = str; s->symbol != '\0'; ++s) { - /* Perform the check twice if a character is repeated, e.g. to detect 9VV. */ - repeated = s->times_repeated > 1; - for (i = 0; i < 1 + repeated; ++i) { - idx = char_to_precedence_idx (str, s, - first_floating_sym, - last_floating_sym, - before_decimal_point, - non_p_digits_seen); - if (idx == -1) { - continue; - } else if (9 <= idx && idx <= 15) { - non_p_digits_seen = 1; - } - - /* - Emit an error if the current character is following a - character it is not allowed to. Display an error once - for each combination detected. - */ - for (j = 0; j < 24; ++j) { - if (chars_seen[j] - && !precedence_table[idx][j] - && !error_emitted[idx][j]) { - emit_precedence_error (j, idx); - error_emitted[idx][j] = 1; - error_detected = 1; - } - } - chars_seen[idx] = 1; - - if (s->symbol == 'V' - || (current_program && s->symbol == current_program->decimal_point)) { - before_decimal_point = 0; - } - } - } - - return !error_detected; -} - -static int -get_pic_number_from_str (const unsigned char *str, unsigned int * const error_detected) -{ - cob_u32_t num_sig_digits = 0; - int value = 0; - - /* Ignore leading zeroes */ - for (; *str == '0' && *str; str++); - - /* Get the value. */ - for (; *str != ')' && *str; str++) { - if (!isdigit (*str)) { - cb_error (_("number or constant in parentheses is not an unsigned integer")); - *error_detected = 1; - break; - } - - num_sig_digits++; - if (num_sig_digits <= 9) { - value = value * 10 + (*str - '0'); - } else if (num_sig_digits == 10) { - cb_error (_("only up to 9 significant digits are permitted within parentheses")); - *error_detected = 1; - } - } - - if (value == 0) { - cb_error (_("number or constant in parentheses must be greater than zero")); - *error_detected = 1; - } - - return value; -} - -static size_t -skip_bad_parentheses(const unsigned char *p) -{ - const unsigned char *pos = p; - cb_error(_("parentheses must be preceded by a picture symbol")); - - do { - ++pos; - } while (*pos != ')' && *pos != '\0'); - - return pos - p; -} - -/* - Return the number in parentheses. p should point to the opening parenthesis. - When the function returns, p will point to the closing parentheses or the null - terminator. -*/ -static int -get_number_in_parentheses (const unsigned char ** p, - unsigned int * const error_detected) -{ - const unsigned char *open_paren = *p; - const unsigned char *close_paren = *p + 1; - const unsigned char *c; - int contains_name; - size_t name_length; - char *name_buff; - cb_tree item; - cb_tree item_value; - - while (*close_paren != ')' && *close_paren) ++close_paren; - - if (!*close_paren) { - cb_error (_("unbalanced parentheses")); - *error_detected = 1; - return 1; - } - - *p = close_paren; - - if (open_paren + 1 == close_paren) { - cb_error (_("parentheses must contain an unsigned integer")); - *error_detected = 1; - return 1; - } - - /* Find out if the parens contain a number or a constant-name. */ - contains_name = 0; - for (c = open_paren + 1; c != close_paren; ++c) { - if (*c == '(') { - size_t skipped = skip_bad_parentheses(c); - close_paren = c + skipped + 1; - *error_detected = 1; - while (*close_paren != ')' && *close_paren) ++close_paren; - *p = close_paren; - /* actually only partial fix - we only skip one "inner" parens... */ - return 1; - } else if (!(isdigit (*c) - || *c == '.' || *c == '+' || *c == '-')) { - contains_name = 1; - } - } - - if (contains_name) { - /* Copy name */ - name_length = close_paren - open_paren; - name_buff = cobc_parse_malloc (name_length); - strncpy (name_buff, (char *) open_paren + 1, name_length); - name_buff[name_length - 1] = '\0'; - - /* TODO: check if name_buf contains a valid user-defined name or not */ - - /* Build reference to name */ - item = cb_ref (cb_build_reference (name_buff)); - - if (item == cb_error_node) { - *error_detected = 1; - return 1; - } else if (!(CB_FIELD_P (item) && CB_FIELD (item)->flag_item_78)) { - cb_error (_("'%s' is not a constant-name"), name_buff); - *error_detected = 1; - return 1; - } - - item_value = CB_VALUE (CB_FIELD (item)->values); - if (!CB_NUMERIC_LITERAL_P (item_value)) { - cb_error (_("'%s' is not a numeric literal"), name_buff); - *error_detected = 1; - return 1; - } else if (CB_LITERAL (item_value)->scale != 0) { - cb_error (_("'%s' is not an integer"), name_buff); - *error_detected = 1; - return 1; - } else if (CB_LITERAL (item_value)->sign != 0) { - cb_error (_("'%s' is not unsigned"), name_buff); - *error_detected = 1; - return 1; - } - - cobc_parse_free (name_buff); - - return get_pic_number_from_str (CB_LITERAL (item_value)->data, - error_detected); - } else { - return get_pic_number_from_str (open_paren + 1, - error_detected); - } -} - -cb_tree -cb_build_picture (const char *str) -{ - struct cb_picture *pic; - static cob_pic_symbol *pic_buff = NULL; - char err_chars[10] = { 0 }; - size_t err_char_pos = 0; - const unsigned char *p; - unsigned int pic_str_len = 0; - size_t idx = 0; - size_t buff_cnt = 0; - cob_u32_t at_beginning; - cob_u32_t at_end; - cob_u32_t s_char_seen = 0; - cob_u32_t asterisk_seen = 0; - cob_u32_t z_char_seen = 0; - cob_u32_t c_count = 0; - cob_u32_t s_count = 0; - cob_u32_t s_edit_count = 0; - cob_u32_t v_count = 0; - cob_u32_t digits = 0; - cob_u32_t digits_exponent = 0; -#if 0 /* currently unused */ - cob_u32_t real_digits = 0; -#endif - cob_u32_t x_digits = 0; - cob_u32_t has_parens; - cob_u32_t error_detected = 0; - int category = 0; - int size = 0; - int scale = 0; - int paren_num; - int n; - unsigned char c; - unsigned char first_last_char = '\0'; - unsigned char second_last_char = '\0'; - - pic = make_tree (CB_TAG_PICTURE, CB_CATEGORY_UNKNOWN, - sizeof (struct cb_picture)); - - if (strlen (str) == 0) { - cb_error (_("missing PICTURE string")); - goto end; - } - - if (!pic_buff) { - pic_buff = cobc_main_malloc ((size_t)COB_MINI_BUFF * sizeof(cob_pic_symbol)); - } - - p = (const unsigned char *)str; - - if (*p == '(') { - size_t skipped = skip_bad_parentheses (p) + 1; - p += skipped; - pic_str_len += skipped; - - error_detected = 1; - } - - for (; *p; p++) { - n = 1; - has_parens = 0; - c = *p; -repeat: - /* early check for picture characters with mulitple characters */ - if ( (c == 'C' && p[1] == 'R') - || (c == 'D' && p[1] == 'B')) { - p++; - pic_str_len++; - } else if (c == 'C') { - cb_error(_("C must be followed by R")); - error_detected = 1; - } else if (c == 'D') { - cb_error(_("D must be followed by B")); - error_detected = 1; - } - /* handle repeated chars */ - if (p[1] == c) { - n++, p++, pic_str_len++; - goto repeat; - } - - if (p[1] == '(') { - has_parens = 1; - ++p; - ++pic_str_len; - if (n != 1) { - cb_warning (COBC_WARN_FILLER, _("uncommon parentheses")); - } - paren_num = get_number_in_parentheses (&p, &error_detected); - - n += paren_num - 1; - /* - The number of digits of the number in parentheses is - counted in the length of the PICTURE string (not the - length of the constant-name, if one was used). - */ - for (; paren_num != 0; paren_num /= 10) { - ++pic_str_len; - } - if (p[1] == '(') { - size_t skipped = skip_bad_parentheses(p); - p += skipped; - pic_str_len += skipped; - error_detected = 1; - } - } - if (category & PIC_NUMERIC_FLOATING) { - if (c != '9') { - char symbol[2] = { 0 }; - symbol[0] = c; - cb_error (_("%s cannot follow %s"), symbol, _("exponent")); - goto end; - } - } - - /* Check grammar and category */ - switch (c) { - case '9': - if (category & PIC_NUMERIC_FLOATING) { - digits_exponent = n; - break; - } - category |= PIC_NUMERIC; - digits += n; -#if 0 /* currently unused */ - real_digits += n; -#endif - if (v_count) { - scale += n; - } - break; - - case 'X': - category |= PIC_ALPHANUMERIC; - x_digits += n; - break; - - case 'N': - if (!(category & PIC_NATIONAL)) { - category |= PIC_NATIONAL; - CB_UNFINISHED ("USAGE NATIONAL"); - } - x_digits += n; - break; - - case 'A': - category |= PIC_ALPHABETIC; - x_digits += n; - break; - - case 'S': - category |= PIC_NUMERIC; - if (s_count <= 1) { - s_count += n; - if (has_parens) { - cb_warning (COBC_WARN_FILLER, _("uncommon parentheses")); - } - if (s_count > 1) { - cb_error (_("%s may only occur once in a PICTURE string"), "S"); - error_detected = 1; - } - } - if (idx != 0) { - cb_error (_("S must be at start of PICTURE string")); - error_detected = 1; - } - - s_char_seen = 1; - continue; - - case ',': - case '.': - category |= PIC_NUMERIC_EDITED; - if (c != current_program->decimal_point) { - break; - } - /* fall through */ - case 'V': - category |= PIC_NUMERIC; - v_count += n; - if (has_parens) { - cb_warning (COBC_WARN_FILLER, _("uncommon parentheses")); - } - if (v_count > 1) { - error_detected = 1; - } - break; - - case 'P': - category |= PIC_NUMERIC; - at_beginning = 0; - at_end = 0; - switch (buff_cnt) { - case 0: - /* P..... */ - at_beginning = 1; - break; - case 1: - /* VP.... */ - /* SP.... */ - if (first_last_char == 'V' || first_last_char == 'S') { - at_beginning = 1; - } - break; - case 2: - /* SVP... */ - if (second_last_char == 'S' && first_last_char == 'V') { - at_beginning = 1; - } - break; - default: - break; - } - if (p[1] == 0 || (p[1] == 'V' && p[2] == 0)) { - /* .....P */ - /* ....PV */ - at_end = 1; - } - if (!at_beginning && !at_end) { - cb_error (_("P must be at start or end of PICTURE string")); - error_detected = 1; - } - if (at_beginning) { - /* Implicit V */ - v_count++; - } - digits += n; - if (v_count) { - scale += n; - } else { - scale -= n; - } - break; - - case '0': - case 'B': - case '/': - category |= PIC_EDITED; - break; - - case '*': - case 'Z': - if (c == '*') { - asterisk_seen = 1; - } else if (c == 'Z') { - z_char_seen = 1; - } - - if (asterisk_seen && z_char_seen) { - cb_error (_("cannot have both Z and * in PICTURE string")); - error_detected = 1; - } - - category |= PIC_NUMERIC_EDITED; - if (category & PIC_ALPHABETIC) { - error_detected = 1; - } - digits += n; - if (v_count) { - scale += n; - } - break; - - case '+': - case '-': - category |= PIC_NUMERIC_EDITED; - digits += n; - if (s_edit_count == 0) { - --digits; - } - if (v_count) { - scale += n; - if (s_edit_count == 0) { - --scale; - } - } - s_edit_count++; - break; - - case '1': - category |= PIC_NUMERIC; /* FIXME: this is WRONG */ - digits += n; -#if 0 /* currently unused */ - real_digits += n; -#endif - break; - - case 'C': - case 'D': - /* note: only reached if actually CR/DB, length adjusted already */ - category |= PIC_NUMERIC_EDITED; - if (has_parens) { - cb_warning (COBC_WARN_FILLER, _("uncommon parentheses")); - } - if (n != 1) { - error_detected = 1; - } - - s_edit_count++; - break; - - case 'E': - if (p[1] == '+') { - category |= PIC_NUMERIC_FLOATING | PIC_NUMERIC_EDITED; - p++; - break; - } - /* fall through */ - - default: - if (c == current_program->currency_symbol) { - category |= PIC_NUMERIC_EDITED; - if (c_count == 0) { - digits += n - 1; - c_count = n - 1; - } else { - digits += n; - c_count += n; - } - break; - } - - if (err_char_pos == sizeof err_chars) { - goto end; - } - if (!strchr (err_chars, (int)c)) { - err_chars[err_char_pos++] = (char)c; - cb_error (_("invalid PICTURE character '%c'"), c); - error_detected = 1; - } - } - - /* Calculate size */ - if (c != 'V' && c != 'P') { - size += n; - } - if (c == 'C' || c == 'D') { - size += n; - } - if (c == 'N') { - size += n * (COB_NATIONAL_SIZE - 1); - } - - /* Store in the buffer */ - pic_buff[idx].symbol = c; - pic_buff[idx].times_repeated = n; - ++idx; - second_last_char = first_last_char; - first_last_char = c; - ++buff_cnt; - if (unlikely(idx == COB_MINI_MAX)) { - break; - } - } - pic_buff[idx].symbol = '\0'; - - if (pic_str_len > cb_pic_length) { - cb_error (_("PICTURE string may not contain more than %d characters; contains %d characters"), - cb_pic_length, pic_str_len); - error_detected = 1; - } - if (digits == 0 && x_digits == 0) { - cb_error (_("PICTURE string must contain at least one of the set A, N, X, Z, 1, 9 and *; " - "or at least two of the set +, - and the currency symbol")); - error_detected = 1; - } - if (!valid_char_order (pic_buff, s_char_seen)) { - error_detected = 1; - } - - if (error_detected) { - goto end; - } - - /* Set picture */ - pic->orig = cobc_check_string (str); - pic->size = size; - pic->digits = digits; - pic->scale = scale; - pic->have_sign = (s_count || s_edit_count); -#if 0 /* currently unused */ - pic->real_digits = real_digits; -#endif - - /* Set picture category */ - switch (category) { - case PIC_NUMERIC: - pic->category = CB_CATEGORY_NUMERIC; - if (digits > COB_MAX_DIGITS) { - cb_error (_("numeric field cannot be larger than %d digits"), COB_MAX_DIGITS); - } - break; - case PIC_ALPHANUMERIC: - pic->category = CB_CATEGORY_ALPHANUMERIC; - break; - case PIC_NATIONAL: - pic->category = CB_CATEGORY_NATIONAL; - break; - case PIC_ALPHABETIC: - pic->category = CB_CATEGORY_ALPHABETIC; - break; - case PIC_FLOATING_EDITED: - /* note: same messages in scanner.l */ - if (digits > COB_MAX_DIGITS) { - cb_error (_("significand has more than %d digits"), COB_FLOAT_DIGITS_MAX); - } - switch (digits_exponent) { - case 1: digits_exponent = 0; break; - case 2: digits_exponent = 99; break; - case 3: digits_exponent = 999; break; - case 4: digits_exponent = 9999; break; - default: - cb_error (_("exponent has more than 4 digits")); - digits_exponent = 9999; - } - /* No decimals; power up by scale difference */ - if (scale < 0) { - scale -= digits_exponent; - } else { - scale += digits_exponent; - } - pic->scale = scale; - pic->str = cobc_parse_malloc ((idx + 1) * sizeof(cob_pic_symbol)); - memcpy (pic->str, pic_buff, idx * sizeof(cob_pic_symbol)); - pic->category = CB_CATEGORY_FLOATING_EDITED; - pic->lenstr = idx; - break; - case PIC_NUMERIC_EDITED: - pic->str = cobc_parse_malloc ((idx + 1) * sizeof(cob_pic_symbol)); - memcpy (pic->str, pic_buff, idx * sizeof(cob_pic_symbol)); - pic->category = CB_CATEGORY_NUMERIC_EDITED; - pic->lenstr = idx; - break; - case PIC_EDITED: - case PIC_ALPHABETIC_EDITED: - case PIC_ALPHANUMERIC_EDITED: - case PIC_NATIONAL_EDITED: - pic->str = cobc_parse_malloc ((idx + 1) * sizeof(cob_pic_symbol)); - memcpy (pic->str, pic_buff, idx * sizeof(cob_pic_symbol)); - if (category != PIC_NATIONAL_EDITED) { - pic->category = CB_CATEGORY_ALPHANUMERIC_EDITED; - } else { - pic->category = CB_CATEGORY_NATIONAL_EDITED; - } - pic->lenstr = idx; - pic->digits = x_digits; - break; - default: - ; - } - -end: - return CB_TREE (pic); -} - -/* Field */ - -cb_tree -cb_build_field (cb_tree name) -{ - struct cb_field *p; - - p = make_tree (CB_TAG_FIELD, CB_CATEGORY_UNKNOWN, - sizeof (struct cb_field)); - p->id = cb_field_id++; - p->name = cb_define (name, CB_TREE (p)); - p->ename = NULL; - p->usage = CB_USAGE_DISPLAY; - p->storage = CB_STORAGE_WORKING; - p->occurs_max = 1; - return CB_TREE (p); -} - -cb_tree -cb_build_implicit_field (cb_tree name, const int len) -{ - cb_tree x; - char pic[32]; - - x = cb_build_field (name); - memset (pic, 0, sizeof(pic)); - snprintf (pic, sizeof(pic), "X(%d)", len); - CB_FIELD (x)->pic = CB_PICTURE (cb_build_picture (pic)); - cb_validate_field (CB_FIELD (x)); - return x; -} - -cb_tree -cb_build_constant (cb_tree name, cb_tree value) -{ - cb_tree x; - - x = cb_build_field (name); - x->category = cb_tree_category (value); - CB_FIELD (x)->storage = CB_STORAGE_CONSTANT; - CB_FIELD (x)->values = CB_LIST_INIT (value); - return x; -} - -/* Add new field to hold data from given field */ -cb_tree -cb_field_dup (struct cb_field *f, struct cb_reference *ref) -{ - cb_tree x; - struct cb_field *s; - char buff[COB_MINI_BUFF], pic[30]; - int dec, dig; - - snprintf (buff, (size_t)COB_MINI_MAX, "COPY OF %s", f->name); - x = cb_build_field (cb_build_reference (buff)); - if(ref - && ref->length - && CB_LITERAL_P(ref->length)) { - sprintf(pic,"X(%d)",cb_get_int(ref->length)); - } else - if (f->pic->category == CB_CATEGORY_NUMERIC - || f->pic->category == CB_CATEGORY_NUMERIC_EDITED) { - dig = f->pic->digits; - if((dec = f->pic->scale) > 0) { - if((dig-dec) == 0) { - sprintf(pic,"SV9(%d)",dec); - } else if((dig-dec) < 0) { - sprintf(pic,"SP(%d)V9(%d)",-(dig-dec),dec); - } else { - sprintf(pic,"S9(%d)V9(%d)",dig-dec,dec); - } - } else { - sprintf(pic,"S9(%d)",dig); - } - } else { - sprintf(pic,"X(%d)",f->size); - } - s = CB_FIELD (x); - s->pic = CB_PICTURE (cb_build_picture (pic)); - if (f->pic->category == CB_CATEGORY_NUMERIC - || f->pic->category == CB_CATEGORY_NUMERIC_EDITED - || f->pic->category == CB_CATEGORY_FLOATING_EDITED) { - s->values = CB_LIST_INIT (cb_zero); - } else { - s->values = CB_LIST_INIT (cb_space); - } - s->storage = CB_STORAGE_WORKING; - s->usage = CB_USAGE_DISPLAY; - s->count++; - cb_validate_field (s); - CB_FIELD_ADD (current_program->working_storage, s); - return cb_build_field_reference (s, NULL); -} - -#if 0 /* RXWRXW - Field */ -struct cb_field * -CB_FIELD_PTR (cb_tree x) -{ - if (CB_REFERENCE_P (x)) { - return CB_FIELD (cb_ref (x)); - } - return CB_FIELD (x); -} -#endif - -struct cb_field * -cb_field_add (struct cb_field *f, struct cb_field *p) -{ - struct cb_field *t; - - if (f == NULL) { - return p; - } - for (t = f; t->sister; t = t->sister) { - ; - } - t->sister = p; - return f; -} - -/* get size of given field/literal (or its reference), - returns FIELD_SIZE_UNKNOWN (-1) if size isn't known - at compile time */ -int -cb_field_size (const cb_tree x) -{ - struct cb_reference *r; - struct cb_field *f; - - switch (CB_TREE_TAG (x)) { - case CB_TAG_LITERAL: - return CB_LITERAL (x)->size; - case CB_TAG_FIELD: - f = CB_FIELD (x); - if (f->usage == CB_USAGE_COMP_X - && f->compx_size > 0) { - return f->compx_size; - } - return CB_FIELD (x)->size; - case CB_TAG_REFERENCE: - r = CB_REFERENCE (x); - f = CB_FIELD (r->value); - if (r->length) { - if (CB_LITERAL_P (r->length)) { - return cb_get_int (r->length); - } else { - return FIELD_SIZE_UNKNOWN; - } - } else if (r->offset) { - if (CB_LITERAL_P (r->offset)) { - return f->size - cb_get_int (r->offset) + 1; - } else { - return FIELD_SIZE_UNKNOWN; - } - } else if (f->usage == CB_USAGE_COMP_X - && f->compx_size > 0) { - return f->compx_size; - } else { - return f->size; - } - - /* LCOV_EXCL_START */ - default: - /* LCOV_EXCL_START */ - cobc_err_msg (_("unexpected tree tag: %d"), (int)CB_TREE_TAG (x)); - COBC_ABORT (); - } -#ifndef _MSC_VER - /* NOT REACHED */ - return 0; -#endif - /* LCOV_EXCL_STOP */ -} - -struct cb_field * -cb_field_founder (const struct cb_field * const f) -{ - const struct cb_field *ff; - - ff = f; - while (ff->parent) { - ff = ff->parent; - } - return (struct cb_field *)ff; -} - -struct cb_field * -cb_field_variable_size (const struct cb_field *f) -{ - struct cb_field *p; - struct cb_field *fc; - - for (fc = f->children; fc; fc = fc->sister) { - if (fc->depending) { - return fc; - } else if ((p = cb_field_variable_size (fc)) != NULL) { - return p; - } - } - return NULL; -} - -unsigned int -cb_field_variable_address (const struct cb_field *fld) -{ - const struct cb_field *p; - const struct cb_field *f; - - f = fld; - for (p = f->parent; p; f = f->parent, p = f->parent) { - for (p = p->children; p != f; p = p->sister) { - if (p->depending || cb_field_variable_size (p)) { - return 1; - } - } - } - return 0; -} - -/* Check if field 'pfld' is subordinate to field 'f' */ - -int -cb_field_subordinate (const struct cb_field *pfld, const struct cb_field *f) -{ - struct cb_field *p; - - for (p = pfld->parent; p; p = p->parent) { - if (p == f) { - return 1; - } - } - return 0; -} - -/* SYMBOLIC CHARACTERS */ - -void -cb_build_symbolic_chars (const cb_tree sym_list, const cb_tree alphabet) -{ - cb_tree l; - cb_tree x; - cb_tree x2; - struct cb_alphabet_name *ap; - int n; - unsigned char buff[4]; - - if (alphabet) { - ap = CB_ALPHABET_NAME (alphabet); - } else { - ap = NULL; - } - for (l = sym_list; l; l = CB_CHAIN (l)) { - n = cb_get_int (CB_PURPOSE (l)) - 1; - if (ap) { - buff[0] = (unsigned char)ap->alphachr[n]; - } else { - buff[0] = (unsigned char)n; - } - buff[1] = 0; - x2 = cb_build_alphanumeric_literal (buff, (size_t)1); - CB_LITERAL (x2)->all = 1; - x = cb_build_constant (CB_VALUE (l), x2); - CB_FIELD (x)->flag_item_78 = 1; - CB_FIELD (x)->flag_is_global = 1; - CB_FIELD (x)->flag_internal_constant = 1; - CB_FIELD (x)->level = 1; - (void)cb_validate_78_item (CB_FIELD (x), 0); - } -} - -/* Report */ - -struct cb_report * -build_report (cb_tree name) -{ - struct cb_report *p; - cb_tree x, y; - char buff[COB_MINI_BUFF]; - - p = make_tree (CB_TAG_REPORT, CB_CATEGORY_UNKNOWN, sizeof (struct cb_report)); - p->name = cb_define (name, CB_TREE (p)); - p->cname = cb_to_cname (p->name); - - /* Set up LINE-COUNTER / PAGE-COUNTER */ - snprintf (buff, (size_t)COB_MINI_MAX, - "LINE-COUNTER of %s", p->name); - x = cb_build_field (cb_build_reference (buff)); - CB_FIELD (x)->usage = CB_USAGE_UNSIGNED_INT; - CB_FIELD (x)->values = CB_LIST_INIT (cb_zero); - CB_FIELD (x)->storage = CB_STORAGE_WORKING; - CB_FIELD (x)->count++; - cb_validate_field (CB_FIELD (x)); - p->line_counter = cb_build_field_reference (CB_FIELD (x), NULL); - CB_FIELD_ADD (current_program->working_storage, CB_FIELD (x)); - - snprintf (buff, (size_t)COB_MINI_MAX, - "PAGE-COUNTER of %s", p->name); - y = cb_build_field (cb_build_reference (buff)); - CB_FIELD (y)->usage = CB_USAGE_UNSIGNED_INT; - CB_FIELD (y)->values = CB_LIST_INIT (cb_zero); - CB_FIELD (y)->storage = CB_STORAGE_WORKING; - CB_FIELD (y)->count++; - cb_validate_field (CB_FIELD (y)); - p->page_counter = cb_build_field_reference (CB_FIELD (y), NULL); - CB_FIELD_ADD (current_program->working_storage, CB_FIELD (y)); - - return p; -} - -/* Add SUM counter to program */ -void -build_sum_counter (struct cb_report *r, struct cb_field *f) -{ - cb_tree x; - struct cb_field *s; - char buff[COB_MINI_BUFF],pic[30]; - int dec,dig; - size_t num_sums_size = ((size_t)r->num_sums + 2) * sizeof (struct cb_field *) * 2; - size_t num_sums_square = (size_t)r->num_sums * 2; - - /* Set up SUM COUNTER */ - if (f->flag_filler) { - snprintf (buff, (size_t)COB_MINI_MAX, "SUM OF %s", - CB_FIELD(CB_VALUE(f->report_sum_list))->name); - } else { - snprintf (buff, (size_t)COB_MINI_MAX, "SUM %s", f->name); - } - x = cb_build_field (cb_build_reference (buff)); - if (f->pic->digits == 0) { - dig = 16; - } else if(f->pic->digits > 17) { - dig = 18; - } else { - dig = f->pic->digits + 2; - } - if ((dec = f->pic->scale) > 0) { - if((dig-dec) == 0) { - sprintf(pic,"SV9(%d)",dec); - } else if((dig-dec) < 0) { - sprintf(pic,"SP(%d)V9(%d)",-(dig-dec),dec); - } else { - sprintf(pic,"S9(%d)V9(%d)",dig-dec,dec); - } - } else { - sprintf(pic,"S9(%d)",dig); - } - s = CB_FIELD (x); - s->pic = CB_PICTURE (cb_build_picture (pic)); - s->values = CB_LIST_INIT (cb_zero); - s->storage = CB_STORAGE_WORKING; - s->usage = CB_USAGE_DISPLAY; - s->count++; - cb_validate_field (s); - f->report_sum_counter = cb_build_field_reference (s, NULL); - CB_FIELD_ADD (current_program->working_storage, s); - - if (r->sums == NULL) { - r->sums = cobc_parse_malloc (num_sums_size); - } else { - r->sums = cobc_parse_realloc (r->sums, num_sums_size); - } - r->sums[num_sums_square + 0] = s; - r->sums[num_sums_square + 1] = f; - r->sums[num_sums_square + 2] = NULL; - r->sums[num_sums_square + 3] = NULL; - r->num_sums++; -} - -void -finalize_report (struct cb_report *r, struct cb_field *records) -{ - struct cb_field *p, *ff, *fld; - struct cb_file *f; - struct cb_reference *ref; - int k; - - if (report_checked != r) { - report_checked = r; - if (r->lines > 9999) { - r->lines = 9999; - } - if (r->heading < 0) { - r->heading = 0; - } - if (r->first_detail < 1) { - if(r->first_detail <= 0 - && !r->has_detail - && r->t_first_detail == NULL - && r->t_last_detail == NULL) { - cb_warning_x (COBC_WARN_FILLER, - CB_TREE(r), _("no DETAIL line defined in report %s"), r->name); - } - r->first_detail = 1; - } - if(r->t_lines == NULL - && r->t_columns == NULL - && r->t_heading == NULL - && r->t_first_detail == NULL - && r->t_last_detail == NULL - && r->t_last_control == NULL - && r->t_footing == NULL) { /* No PAGE LIMITS set at run-time so check it now */ - if(r->first_detail <= 0) { - cb_warning_x (COBC_WARN_FILLER, - CB_TREE(r), _("no DETAIL line defined in report %s"),r->name); - } else if(!(r->first_detail >= r->heading)) { - cb_error_x (CB_TREE(r), _("PAGE LIMIT FIRST DETAIL should be >= HEADING")); - } - if(r->footing > 0 && !(r->footing >= r->heading)) { - cb_error_x (CB_TREE(r), _("PAGE LIMIT FOOTING should be >= HEADING")); - } else if(r->last_detail > 0 && !(r->last_detail >= r->first_detail)) { - cb_error_x (CB_TREE(r), _("PAGE LIMIT LAST DETAIL should be >= FIRST DETAIL")); - } else if(r->footing > 0 && !(r->footing >= r->last_detail)) { - cb_error_x (CB_TREE(r), _("PAGE LIMIT FOOTING should be >= LAST DETAIL")); - } else if(!(r->lines >= r->footing)) { - cb_error_x (CB_TREE(r), _("PAGE LIMIT LINES should be >= FOOTING")); - } - } - if (r->file) { - r->file->flag_report = 1; - } - } - - /* Insure report record size is set large enough */ - for (k=0; k < 2; k++) { - for (p = records; p; p = p->sister) { - if (p->storage != CB_STORAGE_REPORT) - continue; - if ((p->report_flag & COB_REPORT_LINE) || p->level == 1) { - if (r->rcsz < p->size + p->offset) { - r->rcsz = p->size + p->offset; - } - if (k == 1 - && p->level == 1) { - if (p->size < r->rcsz) - p->size = r->rcsz; - if (p->memory_size < r->rcsz) - p->memory_size = r->rcsz; - } - } - if (p->report_column > 0) { - if(p->report_column - 1 + p->size > r->rcsz) { - r->rcsz = p->report_column - 1 + p->size; - } - } - } - } - - for (p = records; p; p = p->sister) { - if (p->report != NULL) { - continue; - } - p->report = r; - if (p->storage == CB_STORAGE_REPORT - && ((p->report_flag & COB_REPORT_LINE) || p->level == 1)) { - size_t size = ((size_t)r->num_lines + 2) * sizeof(struct cb_field *); - if (r->line_ids == NULL) { - r->line_ids = cobc_parse_malloc (size); - } else { - r->line_ids = cobc_parse_realloc (r->line_ids, size); - } - r->line_ids[r->num_lines++] = p; - r->line_ids[r->num_lines] = NULL; /* Clear next entry */ - } - /* report source field */ - if (p->report_source - && CB_REF_OR_FIELD_P (p->report_source)) { - /* force generation of report source field */ - fld = CB_FIELD_PTR (p->report_source); - if (fld->count == 0) { - fld->count++; - } - if (CB_TREE_TAG (p->report_source) == CB_TAG_REFERENCE) { - ref = CB_REFERENCE (p->report_source); - if (ref->offset || ref->length || ref->subs || fld->flag_local) { - p->report_from = p->report_source; - p->report_source = cb_field_dup (fld, ref); - } - } - } - /* force generation of report sum counter */ - if (p->report_sum_counter - && CB_REF_OR_FIELD_P (p->report_sum_counter)) { - fld = CB_FIELD_PTR (p->report_sum_counter); - if (fld->count == 0) { - fld->count++; - } - } - if (p->report_control - && CB_REF_OR_FIELD_P (p->report_control)) { - fld = CB_FIELD_PTR (p->report_control); - if (fld->count == 0) { - fld->count++; - } - } - if (p->children) { - finalize_report (r,p->children); - } - } - - for (p = records; p; p = p->sister) { - if (p->report != r) { - continue; - } - if (p->storage == CB_STORAGE_REPORT - && ((p->report_flag & COB_REPORT_LINE) || p->level == 1)) { - if (p->size + p->offset > r->rcsz) { - p->size = r->rcsz - p->offset ; - } - if (p->memory_size + p->offset > r->rcsz) { - p->memory_size = r->rcsz - p->offset; - } - } - if (p->level == 1 - && p->report != NULL - && p->report->file != NULL) { - f = p->report->file; - for (ff = records; ff; ff = ff->sister) { - if (f->record_max > 0 - && ff->size > f->record_max) { - f->record_max = ff->size; - } - } - if (f->record_min < r->rcsz) { - f->record_min = r->rcsz; - } - if (f->record_max < p->size) { - f->record_max = r->rcsz; - } - if (f->record != NULL - && f->record->size < r->rcsz) { - f->record->size = r->rcsz; - } - } - } - /* LCOV_EXCL_START */ - if (!r || !r->file) { - /* checked to keep the analyzer happy, TODO: real fix later */ - cobc_err_msg (_("call to '%s' with invalid parameter '%s'"), - "finalize_report", "r");; - COBC_ABORT (); - } - /* LCOV_EXCL_STOP */ - if (r->file->record_max < r->rcsz) { - r->file->record_max = r->rcsz; - } - if (r->rcsz < r->file->record_max) { - r->rcsz = r->file->record_max; - } -} - - -/* File */ - -struct cb_file * -build_file (cb_tree name) -{ - struct cb_file *p; - - p = make_tree (CB_TAG_FILE, CB_CATEGORY_UNKNOWN, sizeof (struct cb_file)); - p->name = cb_define (name, CB_TREE (p)); - p->cname = cb_to_cname (p->name); - if (current_program->extfh) { /* Default EXTFH module to use */ - p->extfh = make_constant (CB_CATEGORY_ALPHANUMERIC, current_program->extfh); - } else { - p->extfh = NULL; - } - - p->organization = COB_ORG_SEQUENTIAL; - p->access_mode = COB_ACCESS_SEQUENTIAL; - p->handler = CB_LABEL (cb_standard_error_handler); - p->handler_prog = current_program; - return p; -} - -void -validate_file (struct cb_file *f, cb_tree name) -{ - /* FIXME - Check ASSIGN clause - Currently break's GnuCOBOL's extension for SORT FILEs having no need - for an ASSIGN clause (tested in run_extensions "SORT ASSIGN ..." - According to the Programmer's Guide for 1.1 the ASSIGN is totally - ignored as the SORT is either done in memory (if there's enough space) - or in a temporary disk file. - For supporting this f->organization = COB_ORG_SORT is done when we - see an SD in FILE SECTION for the file, while validate_file is called - in INPUT-OUTPUT Section. - */ - if (!f->assign && f->organization != COB_ORG_SORT && !f->flag_fileid) { - file_error (name, "ASSIGN", CB_FILE_ERR_REQUIRED); - } - /* Check RECORD/RELATIVE KEY clause */ - switch (f->organization) { - case COB_ORG_INDEXED: - if (f->key == NULL) { - file_error (name, "RECORD KEY", CB_FILE_ERR_REQUIRED); - } else if (f->alt_key_list) { - int keynum = cb_next_length ((struct cb_next_elem *)f->alt_key_list) + 1; - if (keynum > MAX_FILE_KEYS) { - cb_error_x (name, _("maximum keys (%d/%d) exceeded for file '%s'"), - keynum, MAX_FILE_KEYS, CB_NAME (name)); - } - } - break; - case COB_ORG_RELATIVE: - if (f->key == NULL && f->access_mode != COB_ACCESS_SEQUENTIAL) { - file_error (name, "RELATIVE KEY", CB_FILE_ERR_REQUIRED); - } - if (f->alt_key_list) { - file_error (name, "ALTERNATE", CB_FILE_ERR_INVALID_FT); - f->alt_key_list = NULL; - } - break; - default: - if (f->key) { - file_error (name, "RECORD", CB_FILE_ERR_INVALID_FT); - f->key = NULL; - } - if (f->alt_key_list) { - file_error (name, "ALTERNATE", CB_FILE_ERR_INVALID_FT); - f->alt_key_list = NULL; - } - if (f->access_mode == COB_ACCESS_DYNAMIC || - f->access_mode == COB_ACCESS_RANDOM) { - file_error (name, "ORGANIZATION", CB_FILE_ERR_INVALID); - } - break; - } -} - -static void -validate_indexed_key_field (struct cb_file *f, struct cb_field *records, - cb_tree key, struct cb_key_component *component_list) -{ - cb_tree key_ref; - struct cb_field *k; - struct cb_field *p; - struct cb_field *v; - - int field_end; - - int cb; - char pic[32]; - struct cb_key_component *key_component; - struct cb_field *composite_key; - - /* get reference (and check if it exists) */ - key_ref = cb_ref (key); - if (key_ref == cb_error_node) { - return; - } - k = CB_FIELD_PTR (key_ref); - - /* check alternate key */ - if (component_list != NULL) { - /* compute composite key total length */ - cb = 0; - for (key_component = component_list; - key_component != NULL; - key_component = key_component->next) { - /* resolution of references in key components must be done here */ - key_ref = cb_ref (key_component->component); - if (key_ref == cb_error_node) { - cb_error_x (CB_TREE(f), _("invalid KEY item '%s', not in file '%s'"), - k->name, f->name); - return; - } - cb += cb_field_size(key_ref); - } - composite_key = (struct cb_field *)cb_ref(key); - memset (pic, 0, sizeof(pic)); - sprintf (pic, "X(%d)", cb); - if (composite_key->pic != NULL) { - cobc_parse_free (composite_key->pic); - } - composite_key->pic = CB_PICTURE (cb_build_picture (pic)); - cb_validate_field (composite_key); - } else { - /* Check that key file is actual part of the file's records */ - v = cb_field_founder (k); - for (p = records; p; p = p->sister) { - if (p == v) { - break; - } - } - if (!p) { - cb_error_x (CB_TREE(f), _("invalid KEY item '%s', not in file '%s'"), - k->name, f->name); - return; - } - } - - /* Validate minimum record size against key field's end */ - /* FIXME: calculate minimum length for all keys first and only check the biggest */ - if (f->record_min > 0) { - field_end = k->offset + k->size; - if (field_end > f->record_min) { - cb_error_x (CB_TREE(k), _("minimal record length %d can not hold the key item '%s';" - " needs to be at least %d"), f->record_min, k->name, field_end); - } - } -} - -void -finalize_file (struct cb_file *f, struct cb_field *records) -{ - struct cb_field *p; - struct cb_field *v; - struct cb_alt_key *cbak; - cb_tree l; - cb_tree x; - - /* stdin/stderr and LINE ADVANCING are L/S */ - if (f->special || f->flag_line_adv) { - f->organization = COB_ORG_LINE_SEQUENTIAL; - } - if (f->flag_fileid && !f->assign) { - f->assign = cb_build_alphanumeric_literal (f->name, - strlen (f->name)); - } - - /* associate records to file (separate and first for being able - to resolve references, for example in validate_indexed_key_field */ - if (records) { - for (p = records; p; p = p->sister) { - p->file = f; - } - } else if (f->flag_report) { - /* in general: no record description needed for REPORTs, but RD entries - */ - } else { - /* Hack: if called without records this is no normal file (but a report) - or no valid a file description was given */ - cb_error_x (CB_TREE(f), _("missing file description for %s"), - cb_name(CB_TREE(f))); - } - - /* Validate INDEXED key fields (RELATIVE keys can only be validated when - the whole DATA DIVISION has been processed). */ - if (f->organization == COB_ORG_INDEXED) { - if (f->key) { - validate_indexed_key_field (f, records, - f->key, f->component_list); - } - if (f->alt_key_list) { - for (cbak = f->alt_key_list; cbak; cbak = cbak->next) { - validate_indexed_key_field (f, records, - cbak->key, cbak->component_list); - } - } - } - - /* Check the record size if it is limited */ - if (f->flag_report) { - for (p = records; p; p = p->sister) { - if (f->record_max > 0 - && p->size > f->record_max) { - f->record_max = p->size; - } - } - } - for (p = records; p; p = p->sister) { - if (f->record_min > 0) { - if (p->size < f->record_min) { - cb_warning_dialect_x (cb_records_mismatch_record_clause, CB_TREE (p), - _("size of record '%s' (%d) smaller than minimum of file '%s' (%d)"), - p->name, p->size, f->name, f->record_min); - if (cb_records_mismatch_record_clause < CB_ERROR) { - cb_warning_x (COBC_WARN_FILLER, CB_TREE (p), _("file size adjusted")); - } - f->record_min = p->size; - } - } - if (f->record_max > 0) { - /* IBM docs: When the maximum record length determined - from the record description entries does not match - the length specified in the RECORD clause, - the maximum will be used. */ - if (p->size > f->record_max) { - cb_warning_dialect_x (cb_records_mismatch_record_clause, CB_TREE (p), - _("size of record '%s' (%d) larger than maximum of file '%s' (%d)"), - p->name, p->size, f->name, f->record_max); - if (cb_warn_extra - && cb_records_mismatch_record_clause != CB_ERROR - && cb_records_mismatch_record_clause != CB_OK) { - cb_warning_x (COBC_WARN_FILLER, CB_TREE (p), _("file size adjusted")); - } - if (f->organization == COB_ORG_INDEXED - && p->size > MAX_FD_RECORD_IDX) { - cb_error (_("RECORD size (IDX) exceeds maximum allowed (%d)"), MAX_FD_RECORD_IDX); - p->size = MAX_FD_RECORD_IDX; - } else if (p->size > MAX_FD_RECORD) { - cb_error (_("RECORD size exceeds maximum allowed (%d)"), MAX_FD_RECORD); - p->size = MAX_FD_RECORD; - } - f->record_max = p->size; - } - } - } - - /* Compute the record size */ - if (f->record_min == 0) { - if (records) { - f->record_min = records->size; - } else { - f->record_min = 0; - } - } - for (p = records; p; p = p->sister) { - v = cb_field_variable_size (p); - if (v && v->offset + v->size * v->occurs_min < f->record_min) { - f->record_min = v->offset + v->size * v->occurs_min; - } - if (p->size < f->record_min) { - f->record_min = p->size; - } - if (p->size > f->record_max) { - f->record_max = p->size; - } - } - - if (f->flag_check_record_varying_limits - && f->record_min == f->record_max) { - cb_error (_("file '%s': RECORD VARYING specified without limits, but implied limits are equal"), - f->name); - } - - if (f->organization == COB_ORG_INDEXED) { - if (f->record_max > MAX_FD_RECORD_IDX) { - f->record_max = MAX_FD_RECORD_IDX; - cb_error (_("file '%s': record size (IDX) %d exceeds maximum allowed (%d)"), - f->name, f->record_max, MAX_FD_RECORD_IDX); - } - } else if (f->record_max > MAX_FD_RECORD) { - cb_error (_("file '%s': record size %d exceeds maximum allowed (%d)"), - f->name, f->record_max, MAX_FD_RECORD); - } - - if (f->flag_delimiter && f->record_min > 0 - && f->record_min == f->record_max) { - cb_verify (cb_record_delim_with_fixed_recs, - _("RECORD DELIMITER clause on file with fixed-length records")); - } - - if (f->same_clause) { - for (l = current_program->file_list; l; l = CB_CHAIN (l)) { - if (CB_FILE (CB_VALUE (l))->same_clause == f->same_clause) { - if (CB_FILE (CB_VALUE (l))->flag_finalized) { - if (f->record_max > CB_FILE (CB_VALUE (l))->record->memory_size) { - CB_FILE (CB_VALUE (l))->record->memory_size = - f->record_max; - } - f->record = CB_FILE (CB_VALUE (l))->record; - for (p = records; p; p = p->sister) { - p->file = f; - p->redefines = f->record; - } - for (p = f->record->sister; p; p = p->sister) { - if (!p->sister) { - p->sister = records; - break; - } - } - f->flag_finalized = 1; - return; - } - } - } - } - /* Create record */ - if (f->record_max == 0) { - f->record_max = 32; - f->record_min = 32; - } - if (f->organization == COB_ORG_LINE_SEQUENTIAL) { - f->record_min = 0; - } - if (!scratch_buff) { - scratch_buff = cobc_main_malloc ((size_t)COB_MINI_BUFF); - } - snprintf (scratch_buff, (size_t)COB_MINI_MAX, "%s Record", f->name); - f->record = CB_FIELD (cb_build_implicit_field (cb_build_reference (scratch_buff), - f->record_max)); - f->record->sister = records; - f->record->count++; - if (f->flag_external) { - current_program->flag_has_external = 1; - f->record->flag_external = 1; - } - - for (p = records; p; p = p->sister) { - p->redefines = f->record; -#if 1 /* RXWRXW - Global/External */ - if (p->flag_is_global) { - f->record->flag_is_global = 1; - } -#endif - } - - if (f->code_set_items) { - check_code_set_items_are_subitems_of_records (f); - } - - f->flag_finalized = 1; - - if (f->linage) { - snprintf (scratch_buff, (size_t)COB_MINI_MAX, - "LINAGE-COUNTER %s", f->name); - x = cb_build_field (cb_build_reference (scratch_buff)); - CB_FIELD (x)->usage = CB_USAGE_UNSIGNED_INT; - CB_FIELD (x)->values = CB_LIST_INIT (cb_zero); - CB_FIELD (x)->count++; - cb_validate_field (CB_FIELD (x)); - f->linage_ctr = cb_build_field_reference (CB_FIELD (x), NULL); - CB_FIELD_ADD (current_program->working_storage, CB_FIELD (x)); - } -} - -/* Communication description */ - -struct cb_cd * -cb_build_cd (cb_tree name) -{ - struct cb_cd *p = make_tree (CB_TAG_CD, CB_CATEGORY_UNKNOWN, - sizeof (struct cb_cd)); - - p->name = cb_define (name, CB_TREE (p)); - - return p; -} - -void -cb_finalize_cd (struct cb_cd *cd, struct cb_field *records) -{ - struct cb_field *p; - - if (cd->record) { - cd->record->sister = records; - } else { - cd->record = records; - } - - for (p = records; p; p = p->sister) { - /* TO-DO: Check record size is exactly 87 chars */ - - p->cd = cd; - if (p != cd->record) { - p->redefines = cd->record; - } - } -} - -/* Reference */ - -cb_tree -cb_build_reference (const char *name) -{ - struct cb_reference *r; - cb_tree x; - - r = make_tree (CB_TAG_REFERENCE, CB_CATEGORY_UNKNOWN, - sizeof (struct cb_reference)); - - /* position of reference */ - r->section = current_section; - r->paragraph = current_paragraph; - - /* Look up / insert word into hash list */ - lookup_word (r, name); - - x = CB_TREE (r); - - /* position of tree */ - SET_SOURCE_CB( x ); - - return x; -} - -cb_tree -cb_build_filler (void) -{ - cb_tree x; - char name[20]; - - sprintf (name, "FILLER %d", filler_id++); - x = cb_build_reference (name); - x->source_line = cb_source_line; - CB_REFERENCE (x)->flag_filler_ref = 1; - return x; -} - -/* - Return a reference to the field f. If ref != NULL, other attributes are set to - the same as ref. -*/ -cb_tree -cb_build_field_reference (struct cb_field *f, cb_tree ref) -{ - cb_tree x; - struct cb_word *word; - - x = cb_build_reference (f->name); - word = CB_REFERENCE (x)->word; - if (ref) { - memcpy (x, ref, sizeof (struct cb_reference)); - } - x->category = CB_CATEGORY_UNKNOWN; - CB_REFERENCE (x)->word = word; - CB_REFERENCE (x)->value = CB_TREE (f); - return x; -} - -static void -cb_define_system_name (const char *name) -{ - cb_tree x; - cb_tree y; - - x = cb_build_reference (name); - if (CB_WORD_COUNT (x) == 0) { - y = get_system_name (name); - /* Paranoid */ - if (y) { - cb_define (x, y); - } - } -} - -void -cb_set_system_names (void) -{ - cb_define_system_name ("CONSOLE"); - cb_define_system_name ("SYSIN"); - cb_define_system_name ("SYSIPT"); - cb_define_system_name ("STDIN"); - cb_define_system_name ("SYSOUT"); - cb_define_system_name ("STDOUT"); - cb_define_system_name ("SYSERR"); - cb_define_system_name ("STDERR"); - cb_define_system_name ("SYSLST"); - cb_define_system_name ("SYSLIST"); - cb_define_system_name ("FORMFEED"); -} - -static COB_INLINE COB_A_INLINE int -field_is_in_file_record (const cb_tree file, - const struct cb_field * const field) -{ - return CB_FILE_P (file) - && CB_FILE (file) == cb_field_founder (field)->file; -} - -static COB_INLINE COB_A_INLINE int -field_is_in_cd_record (const cb_tree cd, - const struct cb_field * const field) -{ - return CB_CD_P (cd) - && CB_CD (cd) == cb_field_founder (field)->cd; -} - -static cb_tree -cb_ref_internal (cb_tree x, const int emit_error) -{ - struct cb_reference *r; - struct cb_field *p; - struct cb_label *s; - cb_tree candidate; - cb_tree items; - cb_tree cb1; - cb_tree cb2; - cb_tree v; - cb_tree c; - struct cb_program *prog; - struct cb_word *w; - size_t val; - size_t ambiguous; - struct cb_label *save_section; - struct cb_label *save_paragraph; - - if (CB_INVALID_TREE (x)) { - return cb_error_node; - } - - /* LCOV_EXCL_START */ - if (!CB_REFERENCE_P (x)) { - cobc_err_msg (_("call to '%s' with invalid parameter '%s'"), - "cb_ref", "x");; - COBC_ABORT (); - } - /* LCOV_EXCL_STOP */ - - r = CB_REFERENCE (x); - /* If this reference has already been resolved (and the value - has been cached), then just return the value */ - if (r->value) { - if (cb_listing_xref && r->flag_receiving) { - /* adjust the receiving flag as this will often be set on later calls only */ - if (CB_FIELD_P (r->value)) { - cobc_xref_link (&CB_FIELD (r->value)->xref, r->common.source_line, 1); - } else if (CB_FILE_P (r->value)) { - cobc_xref_link (&CB_FILE (r->value)->xref, r->common.source_line, 1); - } - } - return r->value; - } - - /* Resolve the value */ - - candidate = NULL; - ambiguous = 0; - items = r->word->items; - for (; items; items = CB_CHAIN (items)) { - /* Find a candidate value by resolving qualification */ - v = CB_VALUE (items); - c = r->chain; - switch (CB_TREE_TAG (v)) { - case CB_TAG_FIELD: - /* In case the value is a field, it might be qualified - by its parent names and a file name */ - if (CB_FIELD (v)->flag_indexed_by) { - p = CB_FIELD (v)->index_qual; - } else { - p = CB_FIELD (v)->parent; - } - /* Resolve by parents */ - for (; p; p = p->parent) { - if (c && strcasecmp (CB_NAME (c), p->name) == 0) { - c = CB_REFERENCE (c)->chain; - } - } - - /* Resolve by file or CD */ - if (c && CB_REFERENCE (c)->chain == NULL - && CB_WORD_COUNT (c) == 1) { - if (field_is_in_file_record (cb_ref (c), CB_FIELD (v)) - || field_is_in_cd_record (cb_ref (c), CB_FIELD (v))) { - c = CB_REFERENCE (c)->chain; - } - } - - break; - case CB_TAG_LABEL: - /* In case the value is a label, it might be qualified - by its section name */ - s = CB_LABEL (v)->section; - - /* Unqualified paragraph name referenced within the section - is resolved without ambiguity check if not duplicated */ - if (c == NULL && r->offset && s == CB_LABEL (r->offset)) { - for (cb1 = CB_CHAIN (items); cb1; cb1 = CB_CHAIN (cb1)) { - cb2 = CB_VALUE (cb1); - if (s == CB_LABEL (cb2)->section) { - ambiguous = 1; - goto raise_error; - } - } - candidate = v; - goto end; - } - - /* Resolve by section name */ - if (c && s && strcasecmp (CB_NAME (c), (char *)s->name) == 0) { - c = CB_REFERENCE (c)->chain; - } - - break; - default: - /* Other values cannot be qualified */ - break; - } - - /* A well qualified value is a good candidate */ - if (c == NULL) { - if (candidate == NULL) { - /* Keep the first candidate */ - candidate = v; - } else { - /* Multiple candidates and possibly ambiguous */ - ambiguous = 1; - /* Continue search because the reference might not - be ambiguous and exit loop by "goto end" later */ - } - } - } - - /* There is no candidate */ - if (candidate == NULL) { - if (likely(current_program->nested_level <= 0)) { - goto raise_error; - } - /* Nested program - check parents for GLOBAL candidate */ -#if 0 /* RXWRXW */ - val = word_hash ((const unsigned char *)r->word->name); -#else - val = r->hashval; -#endif - prog = current_program; - while (prog) { - if (!cb_correct_program_order) { - prog = prog->next_program; - } else { - prog = prog->next_program_ordered; - } - if (prog->nested_level >= current_program->nested_level) { - continue; - } - for (w = prog->word_table[val]; w; w = w->next) { - if (strcasecmp (r->word->name, w->name) == 0) { - candidate = global_check (r, w->items, &ambiguous); - if (candidate) { - if (ambiguous) { - goto raise_error; - } - if (CB_FILE_P(candidate)) { - current_program->flag_gen_error = 1; - } - goto end; - } - } - } - if (prog->nested_level == 0) { - break; - } - } - goto raise_error; - } - - /* Reference is ambiguous */ - if (ambiguous) { - goto raise_error; - } - -end: - if (CB_FIELD_P (candidate)) { - CB_FIELD (candidate)->count++; - if (CB_FIELD (candidate)->flag_invalid) { - goto error; - } - } else if (CB_LABEL_P (candidate) && r->flag_alter_code) { - CB_LABEL (candidate)->flag_alter = 1; - } - - if (cb_listing_xref) { - if (CB_FIELD_P (candidate)) { - cobc_xref_link (&CB_FIELD (candidate)->xref, r->common.source_line, r->flag_receiving); - cobc_xref_link_parent (CB_FIELD (candidate)); - } else if (CB_LABEL_P (candidate)) { - cobc_xref_link (&CB_LABEL(candidate)->xref, r->common.source_line, 0); - } else if (CB_FILE_P (candidate)) { - cobc_xref_link (&CB_FILE (candidate)->xref, r->common.source_line, r->flag_receiving); - } - } - - r->value = candidate; - return r->value; - -raise_error: - if (emit_error) { - save_section = current_section; - save_paragraph = current_paragraph; - current_section = r->section; - current_paragraph = r->paragraph; - if (ambiguous) { - ambiguous_error (x); - } else { - undefined_error (x); - } - current_section = save_section; - current_paragraph = save_paragraph; - } - /* Fall through */ - -error: - r->value = cb_error_node; - return cb_error_node; -} - -cb_tree -cb_ref (cb_tree x) -{ - return cb_ref_internal (x, 1); -} - -cb_tree -cb_try_ref (cb_tree x) -{ - return cb_ref_internal (x, 0); -} - -/* place literal value for display into given pointer - note: must be char [COB_MAX_DIGITS + 2]) */ -static char * -display_literal (char *disp, struct cb_literal *l, int offset, int scale) -{ - if (CB_NUMERIC_LITERAL_P(l)) { - if (scale == 0) { - snprintf (disp, COB_MAX_DIGITS + 1, "%s%s", - (char *)(l->sign == -1 ? "-" : ""), (char* )(l->data + offset)); - } else if (scale > 0) { - snprintf (disp, COB_MAX_DIGITS + 1, "%s%.*s.%.*s", - (char *)(l->sign == -1 ? "-" : ""), - (l->size - l->scale - offset), (char *)(l->data + offset), - scale, (char *)(l->data + l->size - l->scale)); - } else { - snprintf (disp, COB_MAX_DIGITS + 1, "%s%s", - (char *)(l->sign == -1 ? "-" : ""), (char *)(l->data + offset)); - } - } else { - snprintf (disp, COB_MAX_DIGITS + 1, "%s", (char *)(l->data + offset)); - } - return disp; -} - -/* Check if comparing field to literal is always TRUE or FALSE */ -static cb_tree -compare_field_literal (cb_tree e, int swap, cb_tree x, int op, struct cb_literal *l) -{ - int i, j, scale, fscale; - int alph_lit, zero_val; - int lit_start, lit_length, refmod_length; - char lit_disp[COB_MAX_DIGITS + 2]; - struct cb_field *f; - enum cb_category category; - cob_u32_t have_sign; - struct cb_reference *rl; - - /* LCOV_EXCL_START */ - if (!CB_REFERENCE_P(x)) { - cobc_err_msg (_("call to '%s' with invalid parameter '%s'"), - "compare_field_literal", "x");; - COBC_ABORT (); - } - /* LCOV_EXCL_STOP */ - - f = CB_FIELD (cb_ref (x)); - if (f->flag_any_length - || (f->pic == NULL && !f->children)) { - return cb_any; - } - if (f->pic) { - category = f->pic->category; - fscale = f->pic->scale; - have_sign = f->pic->have_sign; - } else { - /* no PICTURE but children, category depends on USAGE */ - switch (f->usage) { - case CB_USAGE_NATIONAL: - category = CB_CATEGORY_NATIONAL; - break; - case CB_USAGE_BIT: - category = CB_CATEGORY_BOOLEAN; - break; - default: - category = CB_CATEGORY_ALPHABETIC; - } - fscale = 0; - have_sign = 0; - } - - rl = CB_REFERENCE(x); - if (rl->length && CB_LITERAL_P (rl->length)) { - refmod_length = cb_get_int (rl->length); - } else if (rl->offset && CB_LITERAL_P (rl->offset)) { - refmod_length = f->size - cb_get_int (rl->offset) + 1; - } else if (rl->length || rl->offset) { - /* Note: we leave reference mod of unknown size to run-time */ - return cb_any; - } else { - refmod_length = 0; - } - - /* initial: set length and type of comparision literal */ - for (lit_length = l->size; - lit_length > 0 && l->data[lit_length - 1] == ' '; - lit_length--); - - alph_lit = 0; - zero_val = 1; - for (j = 0; l->data[j] != 0; j++) { - if (!isdigit(l->data[j])) { - alph_lit = 1; - /* note: zero_val not checked in this case */ - break; - } - if (l->data[j] != '0') { - zero_val = 0; - } - } - - if ((category != CB_CATEGORY_NUMERIC - && category != CB_CATEGORY_NUMERIC_EDITED - && category != CB_CATEGORY_FLOATING_EDITED) - || refmod_length) { - if (!refmod_length) { - refmod_length = f->size; - } - if (lit_length > refmod_length) { - copy_file_line (e, CB_TREE(l), NULL); - if (cb_warn_constant_expr - && !was_prev_warn (e->source_line, 2)) { - if (lit_length > f->size) { - cb_warning_x (cb_warn_constant_expr, e, - _("literal '%.38s' is longer than '%s'"), - display_literal (lit_disp, l, 0, l->scale), f->name); - } else { - cb_warning_x (cb_warn_constant_expr, e, - _("literal '%.38s' is longer than reference-modification of '%s'"), - display_literal (lit_disp, l, 0, l->scale), f->name); - } - } - switch (op) { - case '=': - return cb_false; - case '~': - return cb_true; - } - } - return cb_any; - } - - - if (fscale < 0) { /* Leave for run-time */ - return cb_any; - } - - if (alph_lit) { - copy_file_line (e, CB_TREE(l), NULL); - if (cb_warn_constant_expr - && category == CB_CATEGORY_NUMERIC - && !was_prev_warn (e->source_line, 3)) { - cb_warning_x (cb_warn_constant_expr, e, - _("literal '%s' is alphanumeric but '%s' is numeric"), - display_literal (lit_disp, l, 0, l->scale), f->name); - } - return cb_any; - } - - /* from here on: only check for issues with - numeric non-floating-point literals */ - - /* FIXME: consolidate with checks in validate_move for numeric literals, - this should allow also a check for binary values (we currently only - call this when field is USAGE DISPLAY) */ - - if (zero_val) { - - /* handle ZERO to be as simple as possible */ - lit_start = lit_length; - lit_length = 1; - scale = i = 0; - - } else { - - /* Adjust length for leading ZERO in literal */ - for (lit_start=0; l->data[lit_start] == '0'; lit_start++); - lit_length -= lit_start; - - /* Adjust scale for trailing ZEROS in literal */ - scale = l->scale; - i = lit_length; - for (j = l->size; - scale > 0 && j > 0 && l->data[j-1] == '0'; - j--,i--) - scale--; - } - - if (scale > 0 - && fscale >= 0 - && fscale < scale) { - copy_file_line (e, CB_TREE(l), NULL); - if (cb_warn_constant_expr - && !was_prev_warn (e->source_line, 4)) { - cb_warning_x (cb_warn_constant_expr, e, - _("literal '%s' has more decimals than '%s'"), - display_literal (lit_disp, l, lit_start, l->scale), f->name); - } - switch (op) { - case '=': - return cb_false; - case '~': - return cb_true; - } - } - - if (swap) { - /* not: swap, not negate */ - switch (op) { - case '>': - op = '<'; - break; - case ']': - op = '['; - break; - case '<': - op = '>'; - break; - case '[': - op = ']'; - break; - default: - break; - } - } - - /* check for digits in literal vs. field size */ - if ((i - scale) > 0 - && (f->size - fscale) >= 0 - && (i - scale) > (f->size - fscale)) { - /* If Literal has more digits in whole portion than field can hold - * Then the literal value will never match the field contents - */ - copy_file_line (e, CB_TREE(l), NULL); - if (cb_warn_constant_expr - && !was_prev_warn (e->source_line, 4)) { - cb_warning_x (cb_warn_constant_expr, e, - _("literal '%s' has more digits than '%s'"), - display_literal (lit_disp, l, lit_start, l->scale), f->name); - } - switch (op) { - case '=': - return cb_false; - case '~': - return cb_true; - } - if (category == CB_CATEGORY_NUMERIC) { - switch (op) { - case '>': - case ']': - return cb_false; - case '<': - case '[': - return cb_true; - } - } - - } - - - /* Check for numeric issues. - * note: the actual result may be different if non-numeric - * data is stored in the numeric fields - and may (later) - * be dependent on compiler configuration flags; - * therefore we don't set cb_true/cb_false here - */ - if (cb_warn_constant_expr - && (op == '<' || op == '[' || op == '>' || op == ']')) { - copy_file_line (e, CB_TREE(l), NULL); - - if (have_sign == 0) { - /* comparison with zero */ - if (zero_val) { - switch (op) { - case '<': - if (!was_prev_warn (e->source_line, 5)) { - cb_warning_x (cb_warn_constant_expr, e, - _("unsigned '%s' may not be %s %s"), - f->name, explain_operator (op), "ZERO"); - } - break; - case ']': - /* don't raise a warning for VALUE THRU - (we still can return cb_true here later) */ - if (strcmp(current_statement->name, "VALUE THRU") - &&!was_prev_warn (e->source_line, 5)) { - cb_warning_x (cb_warn_constant_expr, e, - _("unsigned '%s' may always be %s %s"), - f->name, explain_operator (op), "ZERO"); - } - break; - default: - break; - } - /* comparison with negative literal */ - } else if (l->sign < 0) { - switch (op) { - case '<': - case '[': - if (!was_prev_warn (e->source_line, 5)) { - cb_warning_x (cb_warn_constant_expr, e, - _("unsigned '%s' may not be %s %s"), - f->name, explain_operator (op), - display_literal (lit_disp, l, lit_start, l->scale)); - } - break; - case '>': - case ']': - if (!was_prev_warn (e->source_line, 5)) { - cb_warning_x (cb_warn_constant_expr, e, - _("unsigned '%s' may always be %s %s"), - f->name, explain_operator (op), - display_literal (lit_disp, l, lit_start, l->scale)); - } - break; - default: - break; - } - } - } - - /* check for maximum value */ -#if 0 /* we currently call this only when field is USAGE DISPLAY) */ - if ((f->usage == CB_USAGE_DISPLAY - || (cb_binary_truncate - && (f->usage == CB_USAGE_COMP_5 - || f->usage == CB_USAGE_COMP_X - || f->usage == CB_USAGE_COMP_N - || f->usage == CB_USAGE_BINARY))) - && i == f->size) { -#else - if (i == f->size) { -#endif - - for (j=0; l->data[lit_start + j] == '9'; j++); - if (j != f->size) { - /* all fine */ - } else if (l->sign < 0) { - switch (op) { - case '<': - case '[': - if (!was_prev_warn (e->source_line, 5)) { - cb_warning_x (cb_warn_constant_expr, e, - _("'%s' may not be %s %s"), - f->name, explain_operator ('<'), - display_literal (lit_disp, l, lit_start, scale)); - } - break; - case ']': - /* don't raise a warning for VALUE THRU - (we still can return cb_true here later) */ - if (strcmp(current_statement->name, "VALUE THRU") - && !was_prev_warn (e->source_line, 5)) { - cb_warning_x (cb_warn_constant_expr, e, - _("'%s' may always be %s %s"), - f->name, explain_operator (op), - display_literal (lit_disp, l, lit_start, scale)); - } - break; - default: - break; - } - } else { - switch (op) { - case '>': - case ']': - if (!was_prev_warn (e->source_line, 5)) { - cb_warning_x (cb_warn_constant_expr, e, - _("'%s' may not be %s %s"), - f->name, explain_operator ('>'), - display_literal (lit_disp, l, lit_start, scale)); - } - break; - case '[': - /* don't raise a warning for VALUE THRU - (we still can return cb_true here later) */ - if (strcmp(current_statement->name, "VALUE THRU") - && !was_prev_warn (e->source_line, 5)) { - cb_warning_x (cb_warn_constant_expr, e, - _("'%s' may always be %s %s"), - f->name, explain_operator (op), - display_literal (lit_disp, l, lit_start, scale)); - } - break; - default: - break; - } - } - } - } - return cb_any; -} - -/* Expression */ - -cb_tree -cb_build_binary_op (cb_tree x, const int op, cb_tree y) -{ - struct cb_binary_op *p; - enum cb_category category = CB_CATEGORY_UNKNOWN; - cob_s64_t xval, yval, rslt; - char result[48]; - char *llit, *rlit; - int i, j, xscale,yscale, rscale, warn_ok, warn_type; - struct cb_literal *xl, *yl; - cb_tree relop, e; - - if (op == '@' - && y == NULL - && CB_NUMERIC_LITERAL_P(x) ) /* Parens around a Numeric Literal */ - return x; - - /* setting an error tree to point to the correct expression - instead of the literal/var definition / current line */ - e = relop = cb_any; - warn_ok = 1; - warn_type = 1; - copy_file_line (e, NULL, NULL); - llit = rlit = NULL; - - switch (op) { - case '+': - case '-': - case '*': - case '/': - case '^': - /* Arithmetic operators */ - if (CB_TREE_CLASS (x) == CB_CLASS_POINTER || - CB_TREE_CLASS (y) == CB_CLASS_POINTER) { - category = CB_CATEGORY_DATA_POINTER; - break; - } - x = cb_check_numeric_value (x); - y = cb_check_numeric_value (y); - if (x == cb_error_node || y == cb_error_node) { - return cb_error_node; - } - /* - * If this is an operation between two simple integer numerics - * then resolve the value here at compile time -> "constant folding" - */ - if (cb_constant_folding - && CB_NUMERIC_LITERAL_P(x) - && CB_NUMERIC_LITERAL_P(y)) { - xl = CB_LITERAL(x); - yl = CB_LITERAL(y); - xscale = xl->scale; - yscale = yl->scale; - - if (cb_arithmetic_osvs - && (xl->scale != 0 || yl->scale == 0)) { - /* Do not fold with decimals for OSVS */ - cb_set_dmax (xscale); - cb_set_dmax (yscale); - if (op == '*') - cb_set_dmax (xscale + yscale); - } else - if (xl->llit == 0 - && xl->size >= (unsigned int)xl->scale - && yl->llit == 0 - && yl->size >= (unsigned int)yl->scale - && xl->all == 0 - && yl->all == 0) { - xval = atoll((const char*)xl->data); - if(xl->sign == -1) xval = -xval; - yval = atoll((const char*)yl->data); - if(yl->sign == -1) yval = -yval; - cb_set_dmax (xscale); - cb_set_dmax (yscale); - rscale = 0; - rslt = 0; - if (op == '+' || op == '-') { - while (xscale < yscale) { - xval = xval * 10; - xscale++; - } - while (xscale > yscale) { - yval = yval * 10; - yscale++; - } - rscale = xscale; - if (op == '+') - rslt = xval + yval; - else - rslt = xval - yval; - } else if (op == '*') { - rscale = xscale + yscale; - rslt = xval * yval; - } else if (op == '/' && yval != 0) { - while (yscale > 0) { - xval = xval * 10; - yscale--; - } - rscale = xscale; - if((xval % yval) == 0) { - rslt = xval / yval; - } - } - cb_set_dmax (rscale); - while (rscale > 0 - && rslt != 0 - && (rslt % 10) == 0) { - rslt = rslt / 10; - rscale--; - } - switch (op) { - case '+': - case '-': - case '*': - sprintf(result, CB_FMT_LLD, rslt); - return cb_build_numeric_literal (0, result, rscale); - break; - case '/': - if (yval == 0) { /* Avoid Divide by ZERO */ - cb_warning_x (COBC_WARN_FILLER, x, _("divide by constant ZERO")); - break; - } - if (rslt != 0) { - sprintf(result, CB_FMT_LLD, rslt); - return cb_build_numeric_literal (0, result, rscale); - } - /* only calculate simple integer numerics */ - if (xl->scale != 0 || yl->scale != 0) - break; - if((xval % yval) == 0) { - sprintf(result, CB_FMT_LLD, xval / yval); - return cb_build_numeric_literal (0, result, rscale); - } - break; - case '^': - /* only calculate simple integer numerics */ - if (xl->scale != 0 - || yl->scale != 0 - || yval < 0) - break; - if(yval == 0 - || xval == 1) { - strcpy(result,"1"); - } else { - rslt = xval; - while (--yval > 0) { - rslt = rslt * xval; - } - sprintf (result, CB_FMT_LLD, rslt); - } - return cb_build_numeric_literal (0, result, 0); - default: - break; - } - } - } - category = CB_CATEGORY_NUMERIC; - break; - - case '=': - case '~': - case '<': - case '>': - case '[': - case ']': - /* Relational operators */ - if ((CB_REF_OR_FIELD_P (x)) && - CB_FIELD_PTR (x)->level == 88) { - cb_error_x (e, _("invalid expression")); - return cb_error_node; - } - if ((CB_REF_OR_FIELD_P (y)) && - CB_FIELD_PTR (y)->level == 88) { - cb_error_x (e, _("invalid expression")); - return cb_error_node; - } - - if (x == cb_zero) { - xl = CB_LITERAL(cb_zero_lit); - xl->common.source_line = prev_expr_line = cb_exp_line; - } else if (CB_LITERAL_P(x)) { - xl = CB_LITERAL(x); - } else { - xl = NULL; - } - if (y == cb_zero) { - yl = CB_LITERAL(cb_zero_lit); - yl->common.source_line = prev_expr_line = cb_exp_line; - } else if (CB_LITERAL_P(y)) { - yl = CB_LITERAL(y); - } else { - yl = NULL; - } - - /* CHECKME: a call should also be possible when: - - (f->usage == CB_USAGE_DISPLAY - || (cb_binary_truncate - && (f->usage == CB_USAGE_COMP_5 - || f->usage == CB_USAGE_COMP_X - || f->usage == CB_USAGE_BINARY)) - - Shouldn't it? - */ - - if (CB_REF_OR_FIELD_P (y) - && CB_FIELD_PTR (y)->usage == CB_USAGE_DISPLAY - && (CB_LITERAL_P(x) || x == cb_zero) - && xl->all == 0) { - relop = compare_field_literal (e, 1, y, op, xl); - } else if (CB_REF_OR_FIELD_P (x) - && CB_FIELD_PTR (x)->usage == CB_USAGE_DISPLAY - && (CB_LITERAL_P(y) || y == cb_zero) - && yl->all == 0) { - relop = compare_field_literal (e, 0, x, op, yl); - /* - * If this is an operation between two simple integer numerics - * then resolve the value here at compile time -> "constant folding" - */ - } else if (cb_constant_folding - && CB_NUMERIC_LITERAL_P(x) - && CB_NUMERIC_LITERAL_P(y)) { - xl = CB_LITERAL(x); - yl = CB_LITERAL(y); - llit = (char*)xl->data; - rlit = (char*)yl->data; - if (xl->llit == 0 - && xl->scale == 0 - && yl->llit == 0 - && yl->scale == 0 - && xl->sign == 0 - && yl->sign == 0 - /*&& xl->size < 9 - && yl->size < 9 - from reportwriter, caused missing warning in test 213 */ - && xl->all == 0 - && yl->all == 0) { - copy_file_line (e, y, x); - xval = atoll((const char*)xl->data); - yval = atoll((const char*)yl->data); - switch (op) { - case '=': - warn_type = 51 + (xval * 2 + yval) % 5000; - if (xval == yval) { - relop = cb_true; - } else { - relop = cb_false; - } - break; - case '~': - warn_type = 52 + (xval * 2 + yval) % 5000; - if (xval != yval) { - relop = cb_true; - } else { - relop = cb_false; - } - break; - case '>': - warn_type = 53 + (xval * 2 + yval) % 5000; - if (xval > yval) { - relop = cb_true; - } else { - relop = cb_false; - } - break; - case '<': - warn_type = 54 + (xval * 2 + yval) % 5000; - if (xval < yval) { - relop = cb_true; - } else { - relop = cb_false; - } - break; - case ']': - warn_type = 55 + (xval * 2 + yval) % 5000; - if (xval >= yval) { - relop = cb_true; - } else { - relop = cb_false; - } - break; - case '[': - warn_type = 56 + (xval * 2 + yval) % 5000; - if (xval <= yval) { - relop = cb_true; - } else { - relop = cb_false; - } - break; - default: - /* never happens */ - break; - } - } - /* - * If this is an operation between two literal strings - * then resolve the value here at compile time -> "constant folding" - */ - } else if (cb_constant_folding - && CB_LITERAL_P(x) - && CB_LITERAL_P(y) - && !CB_NUMERIC_LITERAL_P(x) - && !CB_NUMERIC_LITERAL_P(y)) { - copy_file_line (e, y, x); - xl = CB_LITERAL(x); - yl = CB_LITERAL(y); - llit = (char*)xl->data; - rlit = (char*)yl->data; - for (i = j = 0; xl->data[i] != 0 && yl->data[j] != 0; i++,j++) { - if (xl->data[i] != yl->data[j]) { - break; - } - } - if(xl->data[i] == 0 - && yl->data[j] == ' ') { - while (yl->data[j] == ' ') j++; - } else - if(xl->data[i] == ' ' - && yl->data[j] == 0) { - while (xl->data[i] == ' ') i++; - } - switch (op) { - case '=': - warn_type = 51; - if (xl->data[i] == yl->data[j]) { - relop = cb_true; - } else { - relop = cb_false; - } - break; - case '~': - warn_type = 52; - if (xl->data[i] != yl->data[j]) { - relop = cb_true; - } else { - relop = cb_false; - } - break; - case '>': - warn_type = 53; - if (xl->data[i] > yl->data[j]) { - relop = cb_true; - } else { - relop = cb_false; - } - break; - case '<': - warn_type = 54; - if (xl->data[i] < yl->data[j]) { - relop = cb_true; - } else { - relop = cb_false; - } - break; - case ']': - warn_type = 55; - if (xl->data[i] >= yl->data[j]) { - relop = cb_true; - } else { - relop = cb_false; - } - break; - case '[': - warn_type = 56; - if (xl->data[i] <= yl->data[j]) { - relop = cb_true; - } else { - relop = cb_false; - } - break; - default: - /* never happens */ - break; - } - } - break; - - case '!': - case '&': - case '|': - /* Logical operators */ - if (CB_TREE_CLASS (x) != CB_CLASS_BOOLEAN - || (y && CB_TREE_CLASS (y) != CB_CLASS_BOOLEAN)) { - copy_file_line (e, y, x); - if (CB_NUMERIC_LITERAL_P(x) - && y - && CB_NUMERIC_LITERAL_P(y)) { - xl = (void*)x; - yl = (void*)y; - llit = (char*)xl->data; - rlit = (char*)yl->data; - cb_error_x (e, _("invalid expression: %s %s %s"), - llit, explain_operator (op), rlit); - } else { - cb_error_x (e, _("invalid expression")); - } - return cb_error_node; - } - if ((x == cb_true || x == cb_false) - && (y == cb_true || y == cb_false)) { - warn_ok = 0; - if (op == '&') { - if (x == cb_true && y == cb_true) { - relop = cb_true; - } else { - relop = cb_false; - } - } else - if (op == '|') { - if (x == cb_true || y == cb_true) { - relop = cb_true; - } else { - relop = cb_false; - } - } - } else if (op == '!') { - if (x == cb_true) { - relop = cb_false; - warn_ok = 0; - } else if (x == cb_false) { - relop = cb_true; - warn_ok = 0; - } - } - category = CB_CATEGORY_BOOLEAN; - break; - - case '@': - /* Parentheses */ - category = CB_TREE_CATEGORY (x); - break; - - case 0: - /* Operation on invalid elements */ - cb_error_x (e, _("invalid expression")); - return cb_error_node; - - /* LCOV_EXCL_START */ - default: - cobc_err_msg (_("unexpected operator: %d"), op); - COBC_ABORT (); - /* LCOV_EXCL_STOP */ - } - - if (relop == cb_true) { - if (cb_warn_constant_expr && warn_ok) { - if (rlit && llit) { - if (!was_prev_warn (e->source_line, warn_type)) { - cb_warning_x (cb_warn_constant_expr, e, - _("expression '%.38s' %s '%.38s' is always TRUE"), - llit, explain_operator (op), rlit); - } - } else { - if (!was_prev_warn (e->source_line, -warn_type)) { - cb_warning_x (cb_warn_constant_expr, e, - _("expression is always TRUE")); - } - } - prev_expr_line = cb_exp_line = e->source_line; - } - return cb_true; - } - if (relop == cb_false) { - if (cb_warn_constant_expr && warn_ok) { - if (rlit && llit) { - if (!was_prev_warn (e->source_line, 9 + warn_type)) { - cb_warning_x (cb_warn_constant_expr, e, - _("expression '%.38s' %s '%.38s' is always FALSE"), - llit, explain_operator (op), rlit); - } - } else { - if (!was_prev_warn (e->source_line, -(9 + warn_type))) { - cb_warning_x (cb_warn_constant_expr, e, - _("expression is always FALSE")); - } - } - prev_expr_line = cb_exp_line = e->source_line; - } - return cb_false; - } - - p = make_tree (CB_TAG_BINARY_OP, category, sizeof (struct cb_binary_op)); - p->op = op; - p->x = x; - p->y = y; - return CB_TREE (p); -} - -cb_tree -cb_build_binary_list (cb_tree l, const int op) -{ - cb_tree e; - - e = CB_VALUE (l); - for (l = CB_CHAIN (l); l; l = CB_CHAIN (l)) { - e = cb_build_binary_op (e, op, CB_VALUE (l)); - } - return e; -} - -/* Function call */ - -cb_tree -cb_build_funcall (const char *name, const int argc, - const cb_tree a1, const cb_tree a2, const cb_tree a3, - const cb_tree a4, const cb_tree a5, const cb_tree a6, - const cb_tree a7, const cb_tree a8, const cb_tree a9, - const cb_tree a10, const cb_tree a11) -{ - struct cb_funcall *p; - - p = make_tree (CB_TAG_FUNCALL, CB_CATEGORY_BOOLEAN, - sizeof (struct cb_funcall)); - p->name = name; - p->argc = argc; - p->varcnt = 0; - p->screenptr = gen_screen_ptr; - p->argv[0] = a1; - p->argv[1] = a2; - p->argv[2] = a3; - p->argv[3] = a4; - p->argv[4] = a5; - p->argv[5] = a6; - p->argv[6] = a7; - p->argv[7] = a8; - p->argv[8] = a9; - p->argv[9] = a10; - p->argv[10] = a11; - return CB_TREE (p); -} - -/* Type cast */ - -cb_tree -cb_build_cast (const enum cb_cast_type type, const cb_tree val) -{ - struct cb_cast *p; - enum cb_category category; - - if (type == CB_CAST_INTEGER) { - category = CB_CATEGORY_NUMERIC; - } else { - category = CB_CATEGORY_UNKNOWN; - } - p = make_tree (CB_TAG_CAST, category, sizeof (struct cb_cast)); - p->cast_type = type; - p->val = val; - return CB_TREE (p); -} - -cb_tree -cb_build_cast_int (const cb_tree val) -{ - struct cb_cast *p; - - p = make_tree (CB_TAG_CAST, CB_CATEGORY_NUMERIC, sizeof (struct cb_cast)); - p->cast_type = CB_CAST_INTEGER; - p->val = val; - return CB_TREE (p); -} - -cb_tree -cb_build_cast_llint (const cb_tree val) -{ - struct cb_cast *p; - - p = make_tree (CB_TAG_CAST, CB_CATEGORY_NUMERIC, sizeof (struct cb_cast)); - p->cast_type = CB_CAST_LONG_INT; - p->val = val; - return CB_TREE (p); -} - -/* Label */ - -cb_tree -cb_build_label (cb_tree name, struct cb_label *section) -{ - cb_tree x; - struct cb_label *p; - struct cb_para_label *l; - - p = make_tree (CB_TAG_LABEL, CB_CATEGORY_UNKNOWN, - sizeof (struct cb_label)); - p->id = cb_id++; - p->name = cb_define (name, CB_TREE (p)); - p->orig_name = p->name; - p->section = section; - if (section) { - l = cobc_parse_malloc (sizeof(struct cb_para_label)); - l->next = section->para_label; - l->para= p; - section->para_label = l; - p->section_id = p->section->id; - } else { - p->section_id = p->id; - } - x = CB_TREE (p); - SET_SOURCE_CB( x ); - return x; -} - -/* Assign */ - -cb_tree -cb_build_assign (const cb_tree var, const cb_tree val) -{ - struct cb_assign *p; - - p = make_tree (CB_TAG_ASSIGN, CB_CATEGORY_UNKNOWN, - sizeof (struct cb_assign)); - p->var = var; - p->val = val; - return CB_TREE (p); -} - -/* INITIALIZE */ - -cb_tree -cb_build_initialize (const cb_tree var, const cb_tree val, const cb_tree rep, - const unsigned int def, - const unsigned int is_statement, - const unsigned int no_filler_init) -{ - struct cb_initialize *p; - - p = make_tree (CB_TAG_INITIALIZE, CB_CATEGORY_UNKNOWN, - sizeof (struct cb_initialize)); - p->var = var; - p->val = val; - p->rep = rep; - p->flag_default = (cob_u8_t)def; - p->flag_init_statement = (cob_u8_t)is_statement; - p->flag_no_filler_init = (cob_u8_t)no_filler_init; - return CB_TREE (p); -} - -/* SEARCH */ - -cb_tree -cb_build_search (const int flag_all, const cb_tree table, const cb_tree var, - const cb_tree end_stmt, const cb_tree whens) -{ - struct cb_search *p; - - p = make_tree (CB_TAG_SEARCH, CB_CATEGORY_UNKNOWN, - sizeof (struct cb_search)); - p->flag_all = flag_all; - p->table = table; - p->var = var; - p->end_stmt = end_stmt; - p->whens = whens; - return CB_TREE (p); -} - -/* CALL */ - -cb_tree -cb_build_call (const cb_tree name, const cb_tree args, const cb_tree on_exception, - const cb_tree not_on_exception, const cb_tree returning, - const cob_u32_t is_system_call, const int convention) -{ - struct cb_call *p; - - p = make_tree (CB_TAG_CALL, CB_CATEGORY_UNKNOWN, - sizeof (struct cb_call)); - p->name = name; - p->args = args; - p->stmt1 = on_exception; - p->stmt2 = not_on_exception; - p->call_returning = returning; - p->is_system = is_system_call; - p->convention = convention; - return CB_TREE (p); -} - -/* CANCEL */ - -cb_tree -cb_build_cancel (const cb_tree target) -{ - struct cb_cancel *p; - - p = make_tree (CB_TAG_CANCEL, CB_CATEGORY_UNKNOWN, - sizeof (struct cb_cancel)); - p->target = target; - return CB_TREE (p); -} - -/* ALTER */ - -cb_tree -cb_build_alter (const cb_tree source, const cb_tree target) -{ - struct cb_alter *p; - - p = make_tree (CB_TAG_ALTER, CB_CATEGORY_UNKNOWN, - sizeof (struct cb_alter)); - p->source = source; - p->target = target; - current_program->alter_list = - cb_list_append (current_program->alter_list, - CB_BUILD_PAIR (source, target)); - return CB_TREE (p); -} - -/* GO TO */ - -cb_tree -cb_build_goto (const cb_tree target, const cb_tree depending) -{ - struct cb_goto *p; - - p = make_tree (CB_TAG_GOTO, CB_CATEGORY_UNKNOWN, - sizeof (struct cb_goto)); - p->target = target; - p->depending = depending; - return CB_TREE (p); -} - -/* IF / WHEN / PRESENT WHEN */ - -cb_tree -cb_build_if (const cb_tree test, const cb_tree stmt1, const cb_tree stmt2, - const unsigned int is_if) -{ - struct cb_if *p; - struct cb_binary_op *bop; - - p = make_tree (CB_TAG_IF, CB_CATEGORY_UNKNOWN, - sizeof (struct cb_if)); - p->test = test; - p->stmt1 = stmt1; - p->stmt2 = stmt2; - if (cb_flag_remove_unreachable) { - if (test == cb_true) { /* Always TRUE so skip 'else code' */ - p->stmt2 = NULL; - } else if (test == cb_false) { /* Always FALSE, so skip 'true code' */ - p->stmt1 = NULL; - } - } - if (test - && CB_TREE_TAG (test) == CB_TAG_BINARY_OP) { - bop = CB_BINARY_OP (test); - if (bop->op == '!') { - if (bop->x == cb_true) { - p->stmt1 = NULL; - } else if (bop->x == cb_false) { - p->stmt2 = NULL; - } - } - } - p->is_if = is_if; - return CB_TREE (p); -} - -/* PERFORM */ - -cb_tree -cb_build_perform (const enum cb_perform_type type) -{ - struct cb_perform *p; - - p = make_tree (CB_TAG_PERFORM, CB_CATEGORY_UNKNOWN, - sizeof (struct cb_perform)); - p->perform_type = type; - return CB_TREE (p); -} - -void -cb_build_perform_after_until(void) -{ - after_until = 1; -} - -cb_tree -cb_build_perform_varying (cb_tree name, cb_tree from, cb_tree by, cb_tree until) -{ - struct cb_perform_varying *p; - cb_tree x; - cb_tree l; - - p = make_tree (CB_TAG_PERFORM_VARYING, CB_CATEGORY_UNKNOWN, - sizeof (struct cb_perform_varying)); - p->name = name; - p->from = from; - p->until = until; - if (until == cb_false) { - cb_warning_x (cb_warn_extra, until, - _("PERFORM FOREVER since UNTIL is always FALSE")); - } else if (until == cb_true) { - if (after_until) { - cb_warning_x (cb_warn_extra, until, - _("PERFORM ONCE since UNTIL is always TRUE")); - } else { - cb_warning_x (cb_warn_extra, until, - _("PERFORM NEVER since UNTIL is always TRUE")); - } - } - - if (until) { - cb_save_cond (); - } - if (until == cb_true - && !after_until) { - cb_false_side (); /* PERFORM body is NEVER executed */ - } - - after_until = 0; - if (name) { - l = cb_ref (name); - if (l == cb_error_node) { - p->step = NULL; - return CB_TREE (p); - } - x = cb_build_add (name, by, cb_high); - if (current_program->flag_debugging && - !current_statement->flag_in_debug && - CB_FIELD_P (l) && CB_FIELD (l)->flag_field_debug) { - p->step = CB_LIST_INIT (x); - x = cb_build_debug (cb_debug_name, CB_FIELD_PTR (name)->name, - NULL); - p->step = cb_list_add (p->step, x); - x = cb_build_debug (cb_debug_contents, NULL, name); - p->step = cb_list_add (p->step, x); - x = cb_build_debug_call (CB_FIELD_PTR (name)->debug_section); - p->step = cb_list_add (p->step, x); - } else { - p->step = x; - } - } else { - p->step = NULL; - } - return CB_TREE (p); -} - -/* Statement */ - -struct cb_statement * -cb_build_statement (const char *name) -{ - struct cb_statement *p; - - p = make_tree (CB_TAG_STATEMENT, CB_CATEGORY_UNKNOWN, - sizeof (struct cb_statement)); - p->name = name; - return p; -} - -/* CONTINUE */ - -cb_tree -cb_build_continue (void) -{ - struct cb_continue *p; - - p = make_tree (CB_TAG_CONTINUE, CB_CATEGORY_UNKNOWN, - sizeof (struct cb_continue)); - return CB_TREE (p); -} - -/* SET ATTRIBUTE */ - -cb_tree -cb_build_set_attribute (const struct cb_field *fld, - const cob_flags_t val_on, const cob_flags_t val_off) -{ - struct cb_set_attr *p; - - p = make_tree (CB_TAG_SET_ATTR, CB_CATEGORY_UNKNOWN, - sizeof (struct cb_set_attr)); - p->fld = (struct cb_field *)fld; - p->val_on = val_on; - p->val_off = val_off; - return CB_TREE (p); -} - -/* Prototypes */ - -static void -warn_if_no_definition_seen_for_prototype (const struct cb_prototype *proto) -{ - struct cb_program *program; - const char *error_msg; - - program = cb_find_defined_program_by_id (proto->ext_name); - if (program) { - return; - } - - if (cb_warn_prototypes) { - if (strcmp (proto->name, proto->ext_name) == 0) { - /* - Warn if no definition seen for element with prototype- - name. - */ - if (proto->type == COB_MODULE_TYPE_FUNCTION) { - error_msg = _("no definition/prototype seen for FUNCTION '%s'"); - } else { /* PROGRAM_TYPE */ - error_msg = _("no definition/prototype seen for PROGRAM '%s'"); - } - cb_warning_x (cb_warn_prototypes, CB_TREE (proto), error_msg, proto->name); - } else { - /* - Warn if no definition seen for element with given - external-name. - */ - if (proto->type == COB_MODULE_TYPE_FUNCTION) { - error_msg = _("no definition/prototype seen for FUNCTION with external name '%s'"); - } else { /* PROGRAM_TYPE */ - error_msg = _("no definition/prototype seen for PROGRAM with external name '%s'"); - } - cb_warning_x (cb_warn_prototypes, CB_TREE (proto), error_msg, proto->ext_name); - } - } -} - -cb_tree -cb_build_prototype (const cb_tree prototype_name, const cb_tree ext_name, - const int type) -{ - struct cb_prototype *prototype; - - prototype = make_tree (CB_TAG_PROTOTYPE, CB_CATEGORY_UNKNOWN, - sizeof (struct cb_prototype)); - CB_TREE (prototype)->source_line = prototype_name->source_line; - - /* Set prototype->name */ - if (CB_LITERAL_P (prototype_name)) { - prototype->name = - (const char *) CB_LITERAL (prototype_name)->data; - } else { - prototype->name = (const char *) CB_NAME (prototype_name); - } - - /* Set prototype->ext_name */ - if (ext_name) { - prototype->ext_name = - (const char *) CB_LITERAL (ext_name)->data; - } else if (CB_LITERAL_P (prototype_name)) { - prototype->ext_name = - (const char *) CB_LITERAL (prototype_name)->data; - } else { - prototype->ext_name = CB_NAME (prototype_name); - } - - prototype->type = type; - - warn_if_no_definition_seen_for_prototype (prototype); - - return CB_TREE (prototype); -} - -/* FUNCTION */ - -/* Build an internal reference to FUNCTION BYTE-LENGTH for resolving LENGTH OF special-register */ -cb_tree -cb_build_any_intrinsic (cb_tree args) -{ - struct cb_intrinsic_table *cbp; - - cbp = lookup_intrinsic ("BYTE-LENGTH", 1); - return make_intrinsic (NULL, cbp, args, NULL, NULL, 0); -} - -static enum cb_category -get_category_from_arguments (const struct cb_intrinsic_table *cbp, cb_tree args, - const int check_from, const int check_to, - const int with_alphabetic) -{ - enum cb_category result = cbp->category; - enum cb_category arg_cat; - cb_tree l; - cb_tree arg; - int argnum = 0; - - for (l = args; l; l = CB_CHAIN(l)) { - - argnum++; - if (argnum < check_from) continue; - if (check_to && argnum > check_to) break; - - arg = CB_VALUE(l); - arg_cat = cb_tree_category (arg); - - if (arg_cat == CB_CATEGORY_NATIONAL_EDITED) { - arg_cat = CB_CATEGORY_NATIONAL; - } else if (arg_cat == CB_CATEGORY_ALPHABETIC && with_alphabetic) { - /* unchanged */ - } else { - arg_cat = CB_CATEGORY_ALPHANUMERIC; - } - - /* first argument specifies the type */ - if (argnum == check_from) { - result = arg_cat; - continue; - } - - /* check for national match */ - if (arg_cat == CB_CATEGORY_NATIONAL) { - if (result != CB_CATEGORY_NATIONAL) { - cb_error (_("FUNCTION %s has invalid argument"), - cbp->name); - cb_error (_("either all arguments or none should be if type %s"), "NATIONAL"); - return cbp->category; - } - } else if (result != CB_CATEGORY_ALPHANUMERIC) { - result = CB_CATEGORY_ALPHANUMERIC; - } - } - - return result; -} - -cb_tree -cb_build_intrinsic (cb_tree func, cb_tree args, cb_tree refmod, - const int isuser) -{ - int xscale, rscale, k; - struct cb_intrinsic_table *cbp; - struct cb_literal *lp; - cb_tree l; - cb_tree x; - struct cb_field *fld; - enum cb_category catg; - cob_s64_t xval,rslt; - int numargs, num_integer, num_string, use_rslt, use_drslt; - double drslt, dval; - char result[64]; - - numargs = (int)cb_list_length (args); - - if (unlikely (isuser)) { - if (refmod && CB_LITERAL_P(CB_PAIR_X(refmod)) && - cb_get_int (CB_PAIR_X(refmod)) < 1) { - cb_error_x (func, _("FUNCTION '%s' has invalid reference modification"), CB_NAME(func)); - return cb_error_node; - } - if (refmod && CB_PAIR_Y(refmod) && - CB_LITERAL_P(CB_PAIR_Y(refmod)) && - cb_get_int (CB_PAIR_Y(refmod)) < 1) { - cb_error_x (func, _("FUNCTION '%s' has invalid reference modification"), CB_NAME(func)); - return cb_error_node; - } - if (numargs > (int)current_program->max_call_param) { - current_program->max_call_param = numargs; - } - return make_intrinsic (func, &userbp, args, cb_int1, refmod, 1); - } - - cbp = lookup_intrinsic (CB_NAME (func), 1); - if (!cbp || cbp->active == CB_FEATURE_DISABLED) { - cb_error_x (func, _("FUNCTION '%s' unknown"), CB_NAME (func)); - return cb_error_node; - } - if (cbp->active == CB_FEATURE_NOT_IMPLEMENTED) { - cb_error_x (func, _("FUNCTION '%s' is not implemented"), - cbp->name); - return cb_error_node; - } - if ((cbp->args == -1)) { - if (numargs < cbp->min_args) { - cb_error_x (func, - _("FUNCTION '%s' has wrong number of arguments"), - cbp->name); - return cb_error_node; - } - } else { - if (numargs > cbp->args || numargs < cbp->min_args) { - cb_error_x (func, - _("FUNCTION '%s' has wrong number of arguments"), - cbp->name); - return cb_error_node; - } - } - if (refmod) { - if (!cbp->refmod) { - cb_error_x (func, _("FUNCTION '%s' cannot have reference modification"), cbp->name); - return cb_error_node; - } - /* TODO: better check needed, see typeck.c (cb_build_identifier) */ - if (CB_LITERAL_P(CB_PAIR_X(refmod)) && - cb_get_int (CB_PAIR_X(refmod)) < 1) { - cb_error_x (func, _("FUNCTION '%s' has invalid reference modification"), cbp->name); - return cb_error_node; - } - if (CB_PAIR_Y(refmod) && CB_LITERAL_P(CB_PAIR_Y(refmod)) && - cb_get_int (CB_PAIR_Y(refmod)) < 1) { - cb_error_x (func, _("FUNCTION '%s' has invalid reference modification"), cbp->name); - return cb_error_node; - } - } - - if (iso_8601_func (cbp->intr_enum)) { - if (!valid_const_date_time_args (func, cbp, args)) { - return cb_error_node; - } - } - - - /* FIXME: Some FUNCTIONS need a test for / adjustment depending on their arguments' category: - * CONCATENATE/SUBSTITUTE/... - all should be of the same category alphanumeric/alphabetic vs. national - * MAX/REVERSE/TRIM/... - depending on the arguments' category the type of the function must be adjusted - */ - - /* - * Check if intrinsic can be computed at compile time - * (Partly implemented as much more can be added for other functions) - * RJN Sep 2017 - */ - if (cb_flag_inline_intrinsic) { - if (cbp->intr_enum == CB_INTR_E) { - return cb_build_numeric_literal (0, "271828182845904523536028747135266249", 35); - } - if (cbp->intr_enum == CB_INTR_PI) { - return cb_build_numeric_literal (0, "314159265358979323846264338327950288", 35); - } - - num_integer = num_string = 0; - for (l = args; l; l = CB_CHAIN(l)) { - if (CB_LITERAL_P (CB_VALUE(l))) { - lp = CB_LITERAL(CB_VALUE(l)); - if (CB_NUMERIC_LITERAL_P (CB_VALUE(l))) { - if (((int)lp->size - lp->scale) >= 0 /* Simple Numerics */ - && lp->scale < 5 - && lp->size < 12) - num_integer++; - } else { - num_string++; - } - } - } - - if (num_integer == numargs - && numargs > 0 - && !refmod) { - xval = rslt = use_rslt = use_drslt = rscale = 0; - drslt = dval = 0; - for (l = args; l; l = CB_CHAIN(l)) { - lp = CB_LITERAL(CB_VALUE(l)); - xval = atoll((const char*)lp->data); - if(lp->sign == -1) xval = -xval; - xscale = lp->scale; - while (xscale < rscale) { - xval = xval * 10; - xscale++; - } - while (xscale > rscale) { - rslt = rslt * 10; - rscale++; - } - switch (cbp->intr_enum) { - case CB_INTR_MAX: - if (l == args) - rslt = xval; - else if (xval > rslt) - rslt = xval; - use_rslt = 1; - break; - case CB_INTR_MIN: - if (l == args) - rslt = xval; - else if (xval < rslt) - rslt = xval; - use_rslt = 1; - break; - case CB_INTR_SUM: - rslt += xval; - use_rslt = 1; - break; - case CB_INTR_REM: - if (l == args) { - rslt = xval; - } else { - rslt = rslt % xval; - } - use_rslt = 1; - break; - case CB_INTR_INTEGER: - rslt = xval; - if (rslt < 0) { - while (rscale > 0) { - rslt = rslt / 10; - rscale--; - } - if (lp->scale > 0) - rslt -= 1; - } else { - while (rscale > 0) { - rslt = rslt / 10; - rscale--; - } - } - use_rslt = 1; - break; - case CB_INTR_INTEGER_PART: - rslt = xval; - while (rscale > 0) { - rslt = rslt / 10; - rscale--; - } - use_rslt = 1; - break; -#if 0 - /* SIN results differs after 15 decimal places from runtime value */ - case CB_INTR_SIN: - dval = xval; - while (xscale > 0) { - dval = dval / 10.0; - xscale--; - } - drslt = sin (dval); - use_drslt = 1; - break; - /* SQRT results differs after 15 decimal places from runtime value */ - case CB_INTR_SQRT: - dval = xval; - while (xscale > 0) { - dval = dval / 10.0; - xscale--; - } - drslt = sqrt (dval); - use_drslt = 1; - break; -#endif - default: - break; - } - } - if (use_rslt) { - while (rscale > 0 - && rslt != 0 - && (rslt % 10) == 0) { /* Adjust out trailing ZEROs */ - rslt = rslt / 10; - rscale--; - } - sprintf(result, CB_FMT_LLD, rslt); - return cb_build_numeric_literal (0, result, rscale); - } - if (use_drslt) { - for (k=35; k > 2; k--) { - if (sprintf(result, "%.*f", k, drslt) < 40) - break; - } - for (k=strlen(result); k > 0 && result[k-1] == '0'; k--) - result[k-1] = 0; - if (result[k-1] == '.') - result[k-1] = 0; - return cb_build_numeric_literal (0, result, 0); - } - } else - if (num_string == numargs - && numargs > 0 - && !refmod) { - for (l = args; l; l = CB_CHAIN(l)) { - lp = CB_LITERAL(CB_VALUE(l)); - switch (cbp->intr_enum) { - case CB_INTR_UPPER_CASE: - for (k=0; k < (int)(lp->size); k++) { - if (islower(lp->data[k])) - lp->data[k] = toupper(lp->data[k]); - } - return cb_build_alphanumeric_literal (lp->data, lp->size); - break; - case CB_INTR_LOWER_CASE: - for (k=0; k < (int)(lp->size); k++) { - if (isupper(lp->data[k])) - lp->data[k] = tolower(lp->data[k]); - } - return cb_build_alphanumeric_literal (lp->data, lp->size); - break; - default: - break; - } - } - } - } - - switch (cbp->intr_enum) { - case CB_INTR_LENGTH: - case CB_INTR_BYTE_LENGTH: - x = CB_VALUE (args); - if (CB_REF_OR_FIELD_P (x)) { - fld = CB_FIELD_PTR (x); - if (!cb_field_variable_size (fld) - && !fld->flag_any_length) { - if (!(fld->pic - && (fld->pic->category == CB_CATEGORY_NATIONAL - || fld->pic->category == CB_CATEGORY_NATIONAL_EDITED))) - return cb_build_length (x); - } - } else if (CB_LITERAL_P (x)) { - /* FIXME: we currently generate national constants as alphanumeric constants */ - if (cbp->intr_enum != CB_INTR_BYTE_LENGTH - || (CB_TREE_CATEGORY (x) != CB_CATEGORY_NATIONAL_EDITED - && CB_TREE_CATEGORY (x) != CB_CATEGORY_NATIONAL)) - return cb_build_length (x); - } - return make_intrinsic (func, cbp, args, NULL, NULL, 0); - - case CB_INTR_WHEN_COMPILED: - if (refmod) { - return make_intrinsic (func, cbp, - CB_LIST_INIT (cb_intr_whencomp), NULL, refmod, 0); - } else { - return cb_intr_whencomp; - } - - /* single, numeric only argument */ - case CB_INTR_ABS: - case CB_INTR_ACOS: - case CB_INTR_ASIN: - case CB_INTR_ATAN: - case CB_INTR_COS: - case CB_INTR_DATE_OF_INTEGER: - case CB_INTR_DAY_OF_INTEGER: - case CB_INTR_EXP: - case CB_INTR_EXP10: - case CB_INTR_FACTORIAL: - case CB_INTR_FRACTION_PART: - case CB_INTR_INTEGER: - case CB_INTR_INTEGER_OF_DATE: - case CB_INTR_INTEGER_OF_DAY: - case CB_INTR_INTEGER_PART: - case CB_INTR_LOG: - case CB_INTR_LOG10: - case CB_INTR_SIGN: - case CB_INTR_SIN: - case CB_INTR_SQRT: - case CB_INTR_TAN: - case CB_INTR_TEST_DATE_YYYYMMDD: - case CB_INTR_TEST_DAY_YYYYDDD: - x = CB_VALUE (args); - if (cb_tree_category (x) != CB_CATEGORY_NUMERIC) { - cb_error_x (func, _("FUNCTION '%s' has invalid argument"), cbp->name); - return cb_error_node; - } - return make_intrinsic (func, cbp, args, NULL, refmod, 0); - - case CB_INTR_ANNUITY: - case CB_INTR_BOOLEAN_OF_INTEGER: - case CB_INTR_CHAR: - case CB_INTR_CHAR_NATIONAL: - case CB_INTR_COMBINED_DATETIME: - case CB_INTR_CURRENCY_SYMBOL: - case CB_INTR_CURRENT_DATE: - case CB_INTR_E: - case CB_INTR_EXCEPTION_FILE: - case CB_INTR_EXCEPTION_FILE_N: - case CB_INTR_EXCEPTION_LOCATION: - case CB_INTR_EXCEPTION_LOCATION_N: - case CB_INTR_EXCEPTION_STATUS: - case CB_INTR_EXCEPTION_STATEMENT: - case CB_INTR_INTEGER_OF_BOOLEAN: - case CB_INTR_INTEGER_OF_FORMATTED_DATE: - case CB_INTR_LOCALE_DATE: - case CB_INTR_LOCALE_TIME: - case CB_INTR_LOCALE_TIME_FROM_SECS: - case CB_INTR_MOD: - case CB_INTR_MODULE_CALLER_ID: - case CB_INTR_MODULE_DATE: - case CB_INTR_MODULE_FORMATTED_DATE: - case CB_INTR_MODULE_ID: - case CB_INTR_MODULE_PATH: - case CB_INTR_MODULE_SOURCE: - case CB_INTR_MODULE_TIME: - case CB_INTR_MON_DECIMAL_POINT: - case CB_INTR_MON_THOUSANDS_SEP: - case CB_INTR_NUM_DECIMAL_POINT: - case CB_INTR_NUM_THOUSANDS_SEP: - case CB_INTR_NUMVAL: - case CB_INTR_NUMVAL_C: - case CB_INTR_NUMVAL_F: - case CB_INTR_ORD: - case CB_INTR_PI: - case CB_INTR_REM: - case CB_INTR_SECONDS_FROM_FORMATTED_TIME: - case CB_INTR_SECONDS_PAST_MIDNIGHT: - case CB_INTR_STORED_CHAR_LENGTH: - case CB_INTR_TEST_FORMATTED_DATETIME: - case CB_INTR_TEST_NUMVAL: - case CB_INTR_TEST_NUMVAL_C: - case CB_INTR_TEST_NUMVAL_F: - return make_intrinsic (func, cbp, args, NULL, refmod, 0); - - /* category has to be adjusted depending on arguments */ - case CB_INTR_FORMATTED_CURRENT_DATE: - case CB_INTR_FORMATTED_DATE: { - enum cb_category cat = get_category_from_arguments (cbp, args, 1, 1, 0); - return make_intrinsic_typed (func, cbp, cat, args, NULL, refmod, 0); - } - case CB_INTR_REVERSE: - case CB_INTR_TRIM: - case CB_INTR_LOWER_CASE: - case CB_INTR_UPPER_CASE: { - enum cb_category cat = get_category_from_arguments (cbp, args, 1, 1, 1); - return make_intrinsic_typed (func, cbp, cat, args, NULL, refmod, 0); - } - case CB_INTR_FORMATTED_TIME: - case CB_INTR_FORMATTED_DATETIME: { - enum cb_category cat = get_category_from_arguments (cbp, args, 1, 1, 0); - return make_intrinsic_typed (func, cbp, cat, args, cb_int1, refmod, 0); - } - - case CB_INTR_HIGHEST_ALGEBRAIC: - case CB_INTR_LOWEST_ALGEBRAIC: - x = CB_VALUE (args); - if (!CB_REF_OR_FIELD_P (x)) { - cb_error_x (func, _("FUNCTION '%s' has invalid argument"), cbp->name); - return cb_error_node; - } - catg = cb_tree_category (x); - if (catg != CB_CATEGORY_NUMERIC && - catg != CB_CATEGORY_NUMERIC_EDITED) { - cb_error_x (func, _("FUNCTION '%s' has invalid argument"), cbp->name); - return cb_error_node; - } - return make_intrinsic (func, cbp, args, NULL, refmod, 0); - - case CB_INTR_CONTENT_LENGTH: - x = CB_VALUE (args); - if (cb_tree_category (x) != CB_CATEGORY_DATA_POINTER) { - cb_error_x (func, _("FUNCTION '%s' has invalid argument"), cbp->name); - return cb_error_node; - } - return make_intrinsic (func, cbp, args, NULL, NULL, 0); - - case CB_INTR_CONTENT_OF: - x = CB_VALUE (args); - if (cb_tree_category (x) != CB_CATEGORY_DATA_POINTER) { - cb_error_x (func, _("FUNCTION '%s' has invalid argument"), cbp->name); - return cb_error_node; - } - return make_intrinsic (func, cbp, args, cb_int1, refmod, 0); - - case CB_INTR_CONCATENATE:{ - enum cb_category cat = get_category_from_arguments (cbp, args, 1, 0, 1); - return make_intrinsic_typed (func, cbp, cat, args, cb_int1, refmod, 0); - } - - case CB_INTR_DISPLAY_OF: - case CB_INTR_NATIONAL_OF: - return make_intrinsic (func, cbp, args, cb_int1, refmod, 0); - - /* mulitple, numeric only arguments */ - case CB_INTR_MEAN: - case CB_INTR_MEDIAN: - case CB_INTR_MIDRANGE: - case CB_INTR_PRESENT_VALUE: - case CB_INTR_RANGE: - case CB_INTR_STANDARD_DEVIATION: - case CB_INTR_SUM: - case CB_INTR_VARIANCE: - return make_intrinsic (func, cbp, args, cb_int1, NULL, 0); - - /* mulitple, compatible only arguments */ - case CB_INTR_MAX: - case CB_INTR_MIN: - return make_intrinsic (func, cbp, args, cb_int1, NULL, 0); - - /* */ - case CB_INTR_DATE_TO_YYYYMMDD: - case CB_INTR_DAY_TO_YYYYDDD: - case CB_INTR_LOCALE_COMPARE: - case CB_INTR_ORD_MAX: - case CB_INTR_ORD_MIN: - case CB_INTR_RANDOM: - case CB_INTR_STANDARD_COMPARE: - case CB_INTR_YEAR_TO_YYYY: - return make_intrinsic (func, cbp, args, cb_int1, NULL, 0); - - /* currently GnuCOBOL only extension (submitted to COBOL 202x), - category adjusted depending on argument */ - case CB_INTR_SUBSTITUTE: - case CB_INTR_SUBSTITUTE_CASE: - if ((numargs % 2) == 0) { - cb_error_x (func, _("FUNCTION '%s' has wrong number of arguments"), cbp->name); - return cb_error_node; - } -#if 0 /* RXWRXW - Substitute arg 1 */ - x = CB_VALUE (args); - if (!CB_REF_OR_FIELD_P (x)) { - cb_error_x (func, _("FUNCTION '%s' has invalid first argument"), cbp->name); - return cb_error_node; - } -#endif - { - enum cb_category cat = get_category_from_arguments (cbp, args, 1, 0, 1); - return make_intrinsic_typed (func, cbp, cat, args, cb_int1, refmod, 0); - } - - default: - cb_error_x (func, _("FUNCTION '%s' unknown"), CB_NAME (func)); - return cb_error_node; - } -} - -/* JSON/XML GENERATE */ - -cb_tree -cb_build_ml_suppress_clause (void) -{ - struct cb_ml_suppress_clause *s; - - s = make_tree (CB_TAG_ML_SUPPRESS, CB_CATEGORY_UNKNOWN, - sizeof (struct cb_ml_suppress_clause)); - s->target = CB_ML_SUPPRESS_ALL; - s->category = CB_ML_SUPPRESS_CAT_ANY; - s->ml_type = CB_ML_ANY_TYPE; - return CB_TREE (s); -} - -cb_tree -cb_build_ml_tree (struct cb_field *record, const int children_are_attrs, - const int default_to_attr, cb_tree name_list, - cb_tree type_list, cb_tree suppress_list) -{ - struct cb_ml_generate_tree *tree; - - if (is_unconditionally_suppressed (record, suppress_list)) { - return NULL; - } - - tree = make_tree (CB_TAG_ML_TREE, CB_CATEGORY_UNKNOWN, - sizeof (struct cb_ml_generate_tree)); - tree->sibling = NULL; - tree->type = get_ml_type (CB_TREE (record), type_list, default_to_attr); - tree->name = get_ml_name (CB_TREE (record), name_list, tree->type); - if (tree->type == CB_ML_ATTRIBUTE) { - tree->id = cb_ml_attr_id++; - } else { - tree->id = cb_ml_tree_id++; - } - - set_ml_attrs_and_children (record, children_are_attrs, name_list, - type_list, suppress_list, &tree); - - /* - Note we test if the *record* has children. The tree may not have - children, e.g. if all the record's children are ATTRIBUTES or - are SUPPRESSed. - */ - if (record->children && tree->type == CB_ML_ELEMENT) { - tree->value = NULL; - } else { - tree->value = CB_TREE (record); - } - - tree->suppress_cond = get_suppress_cond (tree->value, tree->type, - suppress_list); - - return CB_TREE (tree); -} - -cb_tree -cb_build_ml_suppress_checks (struct cb_ml_generate_tree *tree) -{ - struct cb_ml_suppress_checks *check - = make_tree (CB_TAG_ML_SUPPRESS_CHECKS, CB_CATEGORY_UNKNOWN, - sizeof (struct cb_ml_suppress_checks)); - check->tree = tree; - return CB_TREE (check); -} diff -Nru gnucobol-4.0~early~20200606/cobc/tree.h gnucobol-5/cobc/tree.h --- gnucobol-4.0~early~20200606/cobc/tree.h 2020-06-06 20:51:59.000000000 +0000 +++ gnucobol-5/cobc/tree.h 1970-01-01 00:00:00.000000000 +0000 @@ -1,2417 +0,0 @@ -/* - Copyright (C) 2001-2012, 2014-2020 Free Software Foundation, Inc. - Written by Keisuke Nishida, Roger While, Simon Sobisch, Ron Norman - - This file is part of GnuCOBOL. - - The GnuCOBOL compiler is free software: you can redistribute it - and/or modify it under the terms of the GNU General Public License - as published by the Free Software Foundation, either version 3 of the - License, or (at your option) any later version. - - GnuCOBOL is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with GnuCOBOL. If not, see . -*/ - - -#ifndef CB_TREE_H -#define CB_TREE_H - -#ifndef HAVE_ATOLL -#ifdef HAVE_STRTOLL -#ifndef atoll -#define atoll(x) strtoll(x, NULL, 10) -#endif -#endif -#endif - -#ifndef HAVE_ATOL -#ifdef HAVE_STRTOL -#ifndef atol -#define atol(x) strtol(x, NULL, 10) -#endif -#endif -#endif - -#define CB_BEFORE cb_int0 -#define CB_AFTER cb_int1 - -#define CB_PREFIX_ATTR "a_" /* Field attribute (cob_field_attr) */ -#define CB_PREFIX_BASE "b_" /* Base address (unsigned char *) */ -#define CB_PREFIX_CONST "c_" /* Constant or literal (cob_field) */ -#define CB_PREFIX_DECIMAL "d_" /* Decimal number (cob_decimal) */ -#define CB_PREFIX_DEC_FIELD "kc_" /* Decimal Constant for literal (cob_field) */ -#define CB_PREFIX_DEC_CONST "dc_" /* Decimal Constant (cob_decimal) */ -#define CB_PREFIX_FIELD "f_" /* Field (cob_field) */ -#define CB_PREFIX_SCR_FIELD "fs_" /* Screen field (cob_field) */ -#define CB_PREFIX_FILE "h_" /* File (cob_file) */ -#define CB_PREFIX_LABEL "l_" /* Label */ -#define CB_PREFIX_ML_ATTR "ma_" /* JSON/XML GENERATE attribute */ -#define CB_PREFIX_ML_TREE "mt_" /* JSON/XML GENERATE tree */ -#define CB_PREFIX_PIC "p_" /* PICTURE string */ -#define CB_PREFIX_SEQUENCE "s_" /* Collating sequence */ -#define CB_PREFIX_STRING "st_" /* String */ -#define CB_PREFIX_REPORT "r_" /* Report (cob_report) */ -#define CB_PREFIX_REPORT_LINE "rl_" /* Report line (cob_report_line) */ -#define CB_PREFIX_REPORT_FIELD "rf_" /* Report field (cob_report_field) */ -#define CB_PREFIX_REPORT_SUM "rs_" /* Report SUM (cob_report_sum) */ -#define CB_PREFIX_REPORT_CONTROL "rc_" /* Report CONTROL (cob_report_control) */ -#define CB_PREFIX_REPORT_REF "rr_" /* Report CONTROL reference (cob_report_control_ref) */ -#define CB_PREFIX_REPORT_SUM_CTR "rsc_" /* Report SUM COUNTER */ -#define CB_PREFIX_WS_GROUP "ws_" /* WORKING-SOTRAGE grouping char */ - -#define CB_PROGRAM_TYPE 0 -#define CB_FUNCTION_TYPE 1 - -#define CB_CALL_BY_REFERENCE 1 -#define CB_CALL_BY_CONTENT 2 -#define CB_CALL_BY_VALUE 3 - -#define CB_SIZE_AUTO 0 -#define CB_SIZE_1 1 -#define CB_SIZE_2 2 -#define CB_SIZE_4 3 -#define CB_SIZE_8 4 -#define CB_SIZE_UNSIGNED 8 - -/* Hash values */ -/* Power of 2 - see hash function in tree.c */ -#define CB_WORD_HASH_SIZE (1U << 11) -#define CB_WORD_HASH_MASK (CB_WORD_HASH_SIZE - 1U) - -/* Basic tree tag */ -enum cb_tag { - /* Primitives */ - CB_TAG_CONST = 0, /* 0 Constant value */ - CB_TAG_INTEGER, /* 1 Integer constant */ - CB_TAG_STRING, /* 2 String constant */ - CB_TAG_ALPHABET_NAME, /* 3 Alphabet-name */ - CB_TAG_CLASS_NAME, /* 4 Class-name */ - CB_TAG_LOCALE_NAME, /* 5 Locale-name */ - CB_TAG_SYSTEM_NAME, /* 6 System-name */ - CB_TAG_LITERAL, /* 7 Numeric/alphanumeric literal */ - CB_TAG_DECIMAL, /* 8 Decimal number */ - CB_TAG_FIELD, /* 9 User-defined variable */ - CB_TAG_FILE, /* 10 File description */ - CB_TAG_REPORT, /* 11 Report description */ - CB_TAG_CD, /* 12 Communication description */ - /* Expressions */ - CB_TAG_REFERENCE, /* 13 Reference to a field, file, or label */ - CB_TAG_BINARY_OP, /* 14 Binary operation */ - CB_TAG_FUNCALL, /* 15 Run-time function call */ - CB_TAG_CAST, /* 16 Type cast */ - CB_TAG_INTRINSIC, /* 17 Intrinsic function */ - /* Statements */ - CB_TAG_LABEL, /* 18 Label statement */ - CB_TAG_ASSIGN, /* 19 Assignment statement */ - CB_TAG_INITIALIZE, /* 20 INITIALIZE statement */ - CB_TAG_SEARCH, /* 21 SEARCH statement */ - CB_TAG_CALL, /* 22 CALL statement */ - CB_TAG_GOTO, /* 23 GO TO statement */ - CB_TAG_IF, /* 24 IF statement / WHEN clause / PRESENT WHEN clause */ - CB_TAG_PERFORM, /* 25 PERFORM statement */ - CB_TAG_STATEMENT, /* 26 General statement */ - CB_TAG_CONTINUE, /* 27 CONTINUE statement */ - CB_TAG_CANCEL, /* 28 CANCEL statement */ - CB_TAG_ALTER, /* 29 ALTER statement */ - CB_TAG_SET_ATTR, /* 30 SET ATTRIBUTE statement */ - /* Miscellaneous */ - CB_TAG_PERFORM_VARYING, /* 31 PERFORM VARYING parameter */ - CB_TAG_PICTURE, /* 32 PICTURE clause */ - CB_TAG_LIST, /* 33 List */ - CB_TAG_DIRECT, /* 34 Code output or comment */ - CB_TAG_DEBUG, /* 35 Debug item set */ - CB_TAG_DEBUG_CALL, /* 36 Debug callback */ - CB_TAG_PROGRAM, /* 37 Program */ - CB_TAG_PROTOTYPE, /* 38 Prototype */ - CB_TAG_DECIMAL_LITERAL, /* 39 Decimal Literal */ - CB_TAG_REPORT_LINE, /* 40 Report line description */ - CB_TAG_ML_SUPPRESS, /* 41 JSON/XML GENERATE SUPPRESS clause */ - CB_TAG_ML_TREE, /* 42 JSON/XML GENERATE output tree */ - CB_TAG_ML_SUPPRESS_CHECKS /* 43 JSON/XML GENERATE SUPPRESS checks */ - /* When adding a new entry, please remember to add it to - cobc_enum_explain as well. */ -}; - -/* Alphabet target */ -#define CB_ALPHABET_ALPHANUMERIC 0 -#define CB_ALPHABET_NATIONAL 1 - -/* Alphabet type */ -#define CB_ALPHABET_NATIVE 0 -#define CB_ALPHABET_ASCII 1 -#define CB_ALPHABET_EBCDIC 2 -#define CB_ALPHABET_CUSTOM 3 -#define CB_ALPHABET_LOCALE 4 -#define CB_ALPHABET_UTF_8 5 -#define CB_ALPHABET_UTF_16 6 -#define CB_ALPHABET_UCS_4 7 - -/* Call convention bits */ -/* Bit number Meaning Value */ -/* 0 currently ignored by GC */ -/* Parameter order 0 - Right to left */ -/* 1 - Left to right */ -/* 1 currently ignored by GC */ -/* Stack manipulation 0 - Caller removes params */ -/* 1 - Callee removes params */ -/* 2 RETURN-CODE update 0 - Updated */ -/* 1 - Not updated */ -/* 3 Linking behaviour 0 - Normal linking */ -/* 1 - Static CALL linking */ -/* 4 currently ignored by GC + MF */ -/* OS/2 Optlink 0 - ?? */ -/* 1 - ?? */ -/* 5 currently ignored by GC + MF */ -/* Thunked to 16 bit 0 - No thunk */ -/* 1 - Thunk */ -/* 6 GC: works both with static/dynamic calls */ -/* MF: this has his has no effect on dynamic calls */ -/* STDCALL convention 0 - CDECL */ -/* 1 - STDCALL */ -/* 7 currently ignored by GC + MF */ -/* 8 currently ignored by GC */ -/* parameter-count for individual entry points 0 - checked */ -/* 1 - not checked */ -/* 9 currently ignored by GC */ -/* case of call + program names 0 - disregarded (depending on compile time flags) */ -/* 1 - regarded */ -/* 10 currently ignored by GC */ -/* RETURN-CODE storage 0 - passed as return value */ -/* 1 - passed in the first parameter */ -/* 11-14 currently ignored by GC+MF */ -/* 15 GC: enabling COBOL parameter handling for external callers */ -/* currently ignored by MF */ -/* 0 - external callers don't set cob_call_params */ -/* 1 - external callers set cob_call_params - standard (!)*/ - -#define CB_CONV_L_TO_R (1 << 0) -#define CB_CONV_CALLEE_STACK (1 << 1) -#define CB_CONV_NO_RET_UPD (1 << 2) -#define CB_CONV_STATIC_LINK (1 << 3) -#define CB_CONV_OPT_LINK (1 << 4) -#define CB_CONV_THUNK_16 (1 << 5) -#define CB_CONV_STDCALL (1 << 6) -#define CB_CONV_COBOL (1 << 15) -#define CB_CONV_C (0) -#define CB_CONV_PASCAL (CB_CONV_L_TO_R | CB_CONV_CALLEE_STACK) - -/* System category */ -enum cb_system_name_category { - CB_DEVICE_NAME = 0, - CB_SWITCH_NAME, - CB_FEATURE_NAME, - CB_CALL_CONVENTION_NAME, - CB_CODE_NAME, - CB_COMPUTER_NAME, - CB_EXTERNAL_LOCALE_NAME, - CB_LIBRARY_NAME, - CB_TEXT_NAME -}; - -/* Mnemonic defines */ -/* Devices */ -#define CB_DEVICE_SYSIN 0 -#define CB_DEVICE_SYSOUT 1 -#define CB_DEVICE_SYSERR 2 -#define CB_DEVICE_CONSOLE 3 -#define CB_DEVICE_PRINTER 4 -#define CB_DEVICE_SYSPCH 5 -/* Switches (max. must match COB_SWITCH_MAX) */ -#define CB_SWITCH_0 0 -#define CB_SWITCH_1 1 -#define CB_SWITCH_2 2 -#define CB_SWITCH_3 3 -#define CB_SWITCH_4 4 -#define CB_SWITCH_5 5 -#define CB_SWITCH_6 6 -#define CB_SWITCH_7 7 -#define CB_SWITCH_8 8 -#define CB_SWITCH_9 9 -#define CB_SWITCH_10 10 -#define CB_SWITCH_11 11 -#define CB_SWITCH_12 12 -#define CB_SWITCH_13 13 -#define CB_SWITCH_14 14 -#define CB_SWITCH_15 15 -#define CB_SWITCH_16 16 -#define CB_SWITCH_17 17 -#define CB_SWITCH_18 18 -#define CB_SWITCH_19 19 -#define CB_SWITCH_20 20 -#define CB_SWITCH_21 21 -#define CB_SWITCH_22 22 -#define CB_SWITCH_23 23 -#define CB_SWITCH_24 24 -#define CB_SWITCH_25 25 -#define CB_SWITCH_26 26 -#define CB_SWITCH_27 27 -#define CB_SWITCH_28 28 -#define CB_SWITCH_29 29 -#define CB_SWITCH_30 30 -#define CB_SWITCH_31 31 -#define CB_SWITCH_32 32 -#define CB_SWITCH_33 33 -#define CB_SWITCH_34 34 -#define CB_SWITCH_35 35 -#define CB_SWITCH_36 36 -/* Features */ -#define CB_FEATURE_FORMFEED 0 -#define CB_FEATURE_CONVENTION 1 -#define CB_FEATURE_C01 2 -#define CB_FEATURE_C02 3 -#define CB_FEATURE_C03 4 -#define CB_FEATURE_C04 5 -#define CB_FEATURE_C05 6 -#define CB_FEATURE_C06 7 -#define CB_FEATURE_C07 8 -#define CB_FEATURE_C08 9 -#define CB_FEATURE_C09 10 -#define CB_FEATURE_C10 11 -#define CB_FEATURE_C11 12 -#define CB_FEATURE_C12 13 - - -/* Class category */ -enum cb_class { - CB_CLASS_UNKNOWN = 0, /* 0 */ - CB_CLASS_ALPHABETIC, /* 1 */ - CB_CLASS_ALPHANUMERIC, /* 2 */ - CB_CLASS_BOOLEAN, /* 3 */ - CB_CLASS_INDEX, /* 4 */ - CB_CLASS_NATIONAL, /* 5 */ - CB_CLASS_NUMERIC, /* 6 */ - CB_CLASS_OBJECT, /* 7 */ - CB_CLASS_POINTER /* 8 */ -}; - -/* Category */ -enum cb_category { - CB_CATEGORY_UNKNOWN = 0, /* 0 */ - CB_CATEGORY_ALPHABETIC, /* 1 */ - CB_CATEGORY_ALPHANUMERIC, /* 2 */ - CB_CATEGORY_ALPHANUMERIC_EDITED, /* 3 */ - CB_CATEGORY_BOOLEAN, /* 4 */ - CB_CATEGORY_INDEX, /* 5 */ - CB_CATEGORY_NATIONAL, /* 6 */ - CB_CATEGORY_NATIONAL_EDITED, /* 7 */ - CB_CATEGORY_NUMERIC, /* 8 */ - CB_CATEGORY_NUMERIC_EDITED, /* 9 */ - CB_CATEGORY_OBJECT_REFERENCE, /* 10 */ - CB_CATEGORY_DATA_POINTER, /* 11 */ - CB_CATEGORY_PROGRAM_POINTER, /* 12 */ - CB_CATEGORY_FLOATING_EDITED, /* 13 */ - CB_CATEGORY_ERROR /* 14, always last */ -}; - -/* Storage sections */ -enum cb_storage { - CB_STORAGE_CONSTANT = 0, /* Constants */ - CB_STORAGE_FILE, /* FILE SECTION */ - CB_STORAGE_WORKING, /* WORKING-STORAGE SECTION */ - CB_STORAGE_LOCAL, /* LOCAL-STORAGE SECTION */ - CB_STORAGE_LINKAGE, /* LINKAGE SECTION */ - CB_STORAGE_SCREEN, /* SCREEN SECTION */ - CB_STORAGE_REPORT, /* REPORT SECTION */ - CB_STORAGE_COMMUNICATION /* COMMUNICATION SECTION */ -}; - -/* Field types */ -enum cb_usage { - CB_USAGE_BINARY = 0, /* 0 */ - CB_USAGE_BIT, /* 1 */ - CB_USAGE_COMP_5, /* 2 */ - CB_USAGE_COMP_X, /* 3 */ - CB_USAGE_DISPLAY, /* 4 */ - CB_USAGE_FLOAT, /* 5 */ - CB_USAGE_DOUBLE, /* 6 */ - CB_USAGE_INDEX, /* 7 */ - CB_USAGE_NATIONAL, /* 8 */ - CB_USAGE_OBJECT, /* 9 */ - CB_USAGE_PACKED, /* 10 */ - CB_USAGE_POINTER, /* 11 */ - CB_USAGE_LENGTH, /* 12 */ - CB_USAGE_PROGRAM_POINTER, /* 13 */ - CB_USAGE_UNSIGNED_CHAR, /* 14 */ - CB_USAGE_SIGNED_CHAR, /* 15 */ - CB_USAGE_UNSIGNED_SHORT, /* 16 */ - CB_USAGE_SIGNED_SHORT, /* 17 */ - CB_USAGE_UNSIGNED_INT, /* 18 */ - CB_USAGE_SIGNED_INT, /* 19 */ - CB_USAGE_UNSIGNED_LONG, /* 20 */ - CB_USAGE_SIGNED_LONG, /* 21 */ - CB_USAGE_COMP_6, /* 22 */ - CB_USAGE_FP_DEC64, /* 23 */ - CB_USAGE_FP_DEC128, /* 24 */ - CB_USAGE_FP_BIN32, /* 25 */ - CB_USAGE_FP_BIN64, /* 26 */ - CB_USAGE_FP_BIN128, /* 27 */ - CB_USAGE_LONG_DOUBLE, /* 28 */ - CB_USAGE_HNDL, /* 29 */ - CB_USAGE_HNDL_WINDOW, /* 30 */ - CB_USAGE_HNDL_SUBWINDOW, /* 31 */ - CB_USAGE_HNDL_FONT, /* 32 */ - CB_USAGE_HNDL_THREAD, /* 33 */ - CB_USAGE_HNDL_MENU, /* 34 */ - CB_USAGE_HNDL_VARIANT, /* 35 */ - CB_USAGE_HNDL_LM, /* 36 */ - CB_USAGE_COMP_N, /* 37 */ - CB_USAGE_CONTROL, /* 38 */ - CB_USAGE_ERROR /* 39, always last */ -}; - - -/* Cast type */ -enum cb_cast_type { - CB_CAST_INTEGER = 0, /* 0 */ - CB_CAST_LONG_INT, /* 1 */ - CB_CAST_ADDRESS, /* 2 */ - CB_CAST_ADDR_OF_ADDR, /* 3 */ - CB_CAST_LENGTH, /* 4 */ - CB_CAST_PROGRAM_POINTER /* 5 */ -}; - -/* Intrinsic functions */ -enum cb_intr_enum { - CB_INTR_ABS = 1, - CB_INTR_ACOS, - CB_INTR_ANNUITY, - CB_INTR_ASIN, - CB_INTR_ATAN, - CB_INTR_BOOLEAN_OF_INTEGER, - CB_INTR_BYTE_LENGTH, - CB_INTR_CHAR, - CB_INTR_CHAR_NATIONAL, - CB_INTR_COMBINED_DATETIME, - CB_INTR_CONCATENATE, - CB_INTR_CONTENT_LENGTH, - CB_INTR_CONTENT_OF, - CB_INTR_COS, - CB_INTR_CURRENCY_SYMBOL, - CB_INTR_CURRENT_DATE, - CB_INTR_DATE_OF_INTEGER, - CB_INTR_DATE_TO_YYYYMMDD, - CB_INTR_DAY_OF_INTEGER, - CB_INTR_DAY_TO_YYYYDDD, - CB_INTR_DISPLAY_OF, - CB_INTR_E, - CB_INTR_EXCEPTION_FILE, - CB_INTR_EXCEPTION_FILE_N, - CB_INTR_EXCEPTION_LOCATION, - CB_INTR_EXCEPTION_LOCATION_N, - CB_INTR_EXCEPTION_STATEMENT, - CB_INTR_EXCEPTION_STATUS, - CB_INTR_EXP, - CB_INTR_EXP10, - CB_INTR_FACTORIAL, - CB_INTR_FORMATTED_CURRENT_DATE, - CB_INTR_FORMATTED_DATE, - CB_INTR_FORMATTED_DATETIME, - CB_INTR_FORMATTED_TIME, - CB_INTR_FRACTION_PART, - CB_INTR_HIGHEST_ALGEBRAIC, - CB_INTR_INTEGER, - CB_INTR_INTEGER_OF_BOOLEAN, - CB_INTR_INTEGER_OF_DATE, - CB_INTR_INTEGER_OF_DAY, - CB_INTR_INTEGER_OF_FORMATTED_DATE, - CB_INTR_INTEGER_PART, - CB_INTR_LENGTH, - CB_INTR_LOCALE_COMPARE, - CB_INTR_LOCALE_DATE, - CB_INTR_LOCALE_TIME, - CB_INTR_LOCALE_TIME_FROM_SECS, - CB_INTR_LOG, - CB_INTR_LOG10, - CB_INTR_LOWER_CASE, - CB_INTR_LOWEST_ALGEBRAIC, - CB_INTR_MAX, - CB_INTR_MEAN, - CB_INTR_MEDIAN, - CB_INTR_MIDRANGE, - CB_INTR_MIN, - CB_INTR_MOD, - CB_INTR_MODULE_CALLER_ID, - CB_INTR_MODULE_DATE, - CB_INTR_MODULE_FORMATTED_DATE, - CB_INTR_MODULE_ID, - CB_INTR_MODULE_PATH, - CB_INTR_MODULE_SOURCE, - CB_INTR_MODULE_TIME, - CB_INTR_MON_DECIMAL_POINT, - CB_INTR_MON_THOUSANDS_SEP, - CB_INTR_NATIONAL_OF, - CB_INTR_NUM_DECIMAL_POINT, - CB_INTR_NUM_THOUSANDS_SEP, - CB_INTR_NUMVAL, - CB_INTR_NUMVAL_C, - CB_INTR_NUMVAL_F, - CB_INTR_ORD, - CB_INTR_ORD_MAX, - CB_INTR_ORD_MIN, - CB_INTR_PI, - CB_INTR_PRESENT_VALUE, - CB_INTR_RANDOM, - CB_INTR_RANGE, - CB_INTR_REM, - CB_INTR_REVERSE, - CB_INTR_SECONDS_FROM_FORMATTED_TIME, - CB_INTR_SECONDS_PAST_MIDNIGHT, - CB_INTR_SIGN, - CB_INTR_SIN, - CB_INTR_SQRT, - CB_INTR_STANDARD_COMPARE, - CB_INTR_STANDARD_DEVIATION, - CB_INTR_STORED_CHAR_LENGTH, - CB_INTR_SUBSTITUTE, - CB_INTR_SUBSTITUTE_CASE, - CB_INTR_SUM, - CB_INTR_TAN, - CB_INTR_TEST_DATE_YYYYMMDD, - CB_INTR_TEST_DAY_YYYYDDD, - CB_INTR_TEST_FORMATTED_DATETIME, - CB_INTR_TEST_NUMVAL, - CB_INTR_TEST_NUMVAL_C, - CB_INTR_TEST_NUMVAL_F, - CB_INTR_TRIM, - CB_INTR_UPPER_CASE, - CB_INTR_USER_FUNCTION, - CB_INTR_VARIANCE, - CB_INTR_WHEN_COMPILED, - CB_INTR_YEAR_TO_YYYY -}; - -/* Perform type */ -enum cb_perform_type { - CB_PERFORM_EXIT = 0, - CB_PERFORM_ONCE, - CB_PERFORM_TIMES, - CB_PERFORM_UNTIL, - CB_PERFORM_FOREVER -}; - -/* Index type */ -enum cb_index_type { - CB_NORMAL_INDEX = 0, - CB_INT_INDEX, - CB_STATIC_INT_INDEX -}; - -/* Reserved word list structure */ -struct cobc_reserved { - const char *name; /* Word */ - unsigned short nodegen; /* Statement with END-xxx */ - unsigned short context_sens; /* Context sensitive */ - int token; /* Token */ - unsigned int context_set; /* Set context sensitive */ - unsigned int context_test; /* Test context sensitive */ -}; - -/* Basic common tree structure */ - -struct cb_tree_common { - enum cb_tag tag; /* TAG - see below */ - enum cb_category category; /* Category */ - const char *source_file; /* Source file */ - int source_line; /* Line */ - int source_column; /* Column */ -}; - -/* Define common cb_tree/CB_TREE for following defines */ - -typedef struct cb_tree_common *cb_tree; - -#define CB_TREE(x) ((struct cb_tree_common *) (x)) -#define CB_TREE_TAG(x) (CB_TREE (x)->tag) -#define CB_TREE_CLASS(x) cb_tree_class (CB_TREE (x)) -#define CB_TREE_CATEGORY(x) cb_tree_category (CB_TREE (x)) - -#define CB_VALID_TREE(x) (x && CB_TREE (x) != cb_error_node) -#define CB_INVALID_TREE(x) (!(x) || CB_TREE (x) == cb_error_node) - -#ifdef COB_TREE_DEBUG -#define CB_TREE_CAST(tg,ty,x) \ - ((ty *)cobc_tree_cast_check (x, __FILE__, __LINE__, tg)) -#else -#define CB_TREE_CAST(tg,ty,x) ((ty *) (x)) -#endif - -/* any next */ -struct cb_next_elem { - struct cb_next_elem *next; -}; - -/* FIXME: HAVE_FUNC should be checked via configure and the others be a fallback */ -#if defined(NO_HAVE_FUNC) - #define CURRENT_FUNCTION "unknown" -#elif defined(_MSC_VER) - #define CURRENT_FUNCTION __FUNCTION__ -#elif defined(__GNUC__) || (defined(__MWERKS__) && (__MWERKS__ >= 0x3000)) || (defined(__ICC) && (__ICC >= 600)) || defined(__ghs__) - #define CURRENT_FUNCTION __PRETTY_FUNCTION__ -#elif defined(__DMC__) && (__DMC__ >= 0x810) - #define CURRENT_FUNCTION __PRETTY_FUNCTION__ -#elif defined(__FUNCSIG__) - #define CURRENT_FUNCTION __FUNCSIG__ -#elif (defined(__INTEL_COMPILER) && (__INTEL_COMPILER >= 600)) || (defined(__IBMCPP__) && (__IBMCPP__ >= 500)) - #define CURRENT_FUNCTION __FUNCTION__ -#elif defined(__BORLANDC__) && (__BORLANDC__ >= 0x550) - #define CURRENT_FUNCTION __FUNC__ -#elif defined(__STDC_VERSION__) && (__STDC_VERSION__ >= 199901) - #define CURRENT_FUNCTION __func__ -#elif defined(__cplusplus) && (__cplusplus >= 201103) - #define CURRENT_FUNCTION __func__ -#else - #define CURRENT_FUNCTION __FILE__ -#endif - -void -cb_tree_source_set( const char func[], int line, cb_tree tree, - const char source_file[], int source_line ); -#define SET_SOURCE(t, s, l) cb_tree_source_set(CURRENT_FUNCTION, __LINE__, (t), (s), (l)) -#define SET_SOURCE_CB(t) cb_tree_source_set(CURRENT_FUNCTION, __LINE__, (t), \ - cb_source_file, cb_source_line) - -/* xref entries */ -struct cb_xref_elem { - struct cb_xref_elem *next; - int line; - int receive; -}; - -struct cb_xref { - struct cb_xref_elem *head; - struct cb_xref_elem *tail; - int skip; -}; - -struct cb_call_elem { - struct cb_call_elem *next; - char *name; - struct cb_xref xref; - int is_identifier; - int is_system; -}; - -struct cb_call_xref { - struct cb_call_elem *head; - struct cb_call_elem *tail; -}; - -/* Constant */ - -struct cb_const { - struct cb_tree_common common; /* Common values */ - const char *val; /* Constant value */ -}; - -#define CB_CONST(x) (CB_TREE_CAST (CB_TAG_CONST, struct cb_const, x)) -#define CB_CONST_P(x) (CB_TREE_TAG (x) == CB_TAG_CONST) - -/* Code output or comment */ - -struct cb_direct { - struct cb_tree_common common; /* Common values */ - const char *line; /* Line redirect */ - cob_u32_t flag_is_direct; /* Is directed */ - cob_u32_t flag_new_line; /* Need new line */ -}; - -#define CB_DIRECT(x) (CB_TREE_CAST (CB_TAG_DIRECT, struct cb_direct, x)) -#define CB_DIRECT_P(x) (CB_TREE_TAG (x) == CB_TAG_DIRECT) - -/* DEBUG */ - -struct cb_debug { - struct cb_tree_common common; /* Common values */ - cb_tree target; /* Target for debug */ - const char *value; /* Value for debug */ - cb_tree fld; /* Reference */ - size_t size; /* Size if relevant */ -}; - -#define CB_DEBUG(x) (CB_TREE_CAST (CB_TAG_DEBUG, struct cb_debug, x)) -#define CB_DEBUG_P(x) (CB_TREE_TAG (x) == CB_TAG_DEBUG) - -/* DEBUG Callback */ - -struct cb_debug_call { - struct cb_tree_common common; /* Common values */ - struct cb_label *target; /* Target label */ -}; - -#define CB_DEBUG_CALL(x) (CB_TREE_CAST (CB_TAG_DEBUG_CALL, struct cb_debug_call, x)) -#define CB_DEBUG_CALL_P(x) (CB_TREE_TAG (x) == CB_TAG_DEBUG_CALL) - -/* Integer */ - -struct cb_integer { - struct cb_tree_common common; /* Common values */ - int val; /* Integer value */ -#ifdef USE_INT_HEX /* Simon: using this increases the struct and we - *should* pass the flags as constants in any case... */ - unsigned int hexval; /* Output hex value */ -#endif -}; - -#define CB_INTEGER(x) (CB_TREE_CAST (CB_TAG_INTEGER, struct cb_integer, x)) -#define CB_INTEGER_P(x) (CB_TREE_TAG (x) == CB_TAG_INTEGER) - -/* String */ - -struct cb_string { - struct cb_tree_common common; /* Common values */ - const unsigned char *data; /* Data */ - size_t size; /* Data size */ -}; - -#define CB_STRING(x) (CB_TREE_CAST (CB_TAG_STRING, struct cb_string, x)) -#define CB_STRING_P(x) (CB_TREE_TAG (x) == CB_TAG_STRING) - -/* Alphabet-name */ - -struct cb_alphabet_name { - struct cb_tree_common common; /* Common values */ - const char *name; /* Original name */ - char *cname; /* Name used in C */ - cb_tree custom_list; /* Custom ALPHABET / LOCALE reference */ - unsigned int alphabet_target; /* ALPHANUMERIC or NATIONAL */ - unsigned int alphabet_type; /* ALPHABET type */ - int low_val_char; /* LOW-VALUE */ - int high_val_char; /* HIGH-VALUE */ - int values[256]; /* Collating values */ - int alphachr[256]; /* Actual values */ -}; - -#define CB_ALPHABET_NAME(x) (CB_TREE_CAST (CB_TAG_ALPHABET_NAME, struct cb_alphabet_name, x)) -#define CB_ALPHABET_NAME_P(x) (CB_TREE_TAG (x) == CB_TAG_ALPHABET_NAME) - -/* Class-name */ - -struct cb_class_name { - struct cb_tree_common common; /* Common values */ - const char *name; /* Original name */ - char *cname; /* Name used in C */ - cb_tree list; /* List of CLASS definitions */ -}; - -#define CB_CLASS_NAME(x) (CB_TREE_CAST (CB_TAG_CLASS_NAME, struct cb_class_name, x)) -#define CB_CLASS_NAME_P(x) (CB_TREE_TAG (x) == CB_TAG_CLASS_NAME) - -/* Locale name */ - -struct cb_locale_name { - struct cb_tree_common common; /* Common values */ - const char *name; /* Original name */ - char *cname; /* Name used in C */ - cb_tree list; /* List of locale definitions */ -}; - -#define CB_LOCALE_NAME(x) (CB_TREE_CAST (CB_TAG_LOCALE_NAME, struct cb_locale_name, x)) -#define CB_LOCALE_NAME_P(x) (CB_TREE_TAG (x) == CB_TAG_LOCALE_NAME) - -/* System-name */ - -struct cb_system_name { - struct cb_tree_common common; /* Common values */ - cb_tree value; /* System value */ - enum cb_system_name_category category; /* System category */ - int token; /* Device attributes */ -}; - -#define CB_SYSTEM_NAME(x) (CB_TREE_CAST (CB_TAG_SYSTEM_NAME, struct cb_system_name, x)) -#define CB_SYSTEM_NAME_P(x) (CB_TREE_TAG (x) == CB_TAG_SYSTEM_NAME) - -/* Literal */ - -struct cb_literal { - struct cb_tree_common common; /* Common values */ - unsigned char *data; /* Literal data */ - cob_u32_t size; /* Literal size */ - int scale; /* Numeric scale */ - cob_u32_t llit; /* 'L' literal */ - short sign; /* unsigned: 0 negative: -1 positive: 1 */ - short all; /* ALL */ -}; - -#define CB_LITERAL(x) (CB_TREE_CAST (CB_TAG_LITERAL, struct cb_literal, x)) -#define CB_LITERAL_P(x) (CB_TREE_TAG (x) == CB_TAG_LITERAL) -#define CB_NUMERIC_LITERAL_P(x) \ - (CB_LITERAL_P (x) && CB_TREE_CATEGORY (x) == CB_CATEGORY_NUMERIC) - -/* Decimal */ - -struct cb_decimal { - struct cb_tree_common common; /* Common values */ - unsigned int id; /* ID for this decimal */ -}; - -#define CB_DECIMAL(x) (CB_TREE_CAST (CB_TAG_DECIMAL, struct cb_decimal, x)) -#define CB_DECIMAL_P(x) (CB_TREE_TAG (x) == CB_TAG_DECIMAL) - -#define CB_DECIMAL_LITERAL(x) (CB_TREE_CAST (CB_TAG_DECIMAL_LITERAL, struct cb_decimal, x)) -#define CB_DECIMAL_LITERAL_P(x) (CB_TREE_TAG (x) == CB_TAG_DECIMAL_LITERAL) - -/* Picture */ - -struct cb_picture { - struct cb_tree_common common; /* Common values */ - char *orig; /* Original picture string */ - cob_pic_symbol *str; /* Picture string */ - int size; /* Byte size */ - int lenstr; /* Length of picture string */ - enum cb_category category; /* Field category */ - cob_u32_t digits; /* Number of digit places */ - int scale; /* 1/10^scale */ -#if 0 /* currently unused */ - cob_u32_t real_digits; /* Real number of digits */ -#endif - cob_u32_t have_sign; /* Have 'S' */ - unsigned int flag_is_calculated : 1; /* is calculated */ -}; - -#define CB_PICTURE(x) (CB_TREE_CAST (CB_TAG_PICTURE, struct cb_picture, x)) -#define CB_PICTURE_P(x) (CB_TREE_TAG (x) == CB_TAG_PICTURE) - -/* Key */ - -struct cb_key { - cb_tree key; /* KEY */ - cb_tree ref; /* Reference used in SEARCH ALL */ - cb_tree val; /* Value to be compared in SEARCH ALL */ - int dir; /* ASCENDING or DESCENDING */ -}; - -/* Field */ - -struct cb_field { - struct cb_tree_common common; /* Common values */ - const char *name; /* Original name */ - const char *ename; /* Externalized name */ - cb_tree depending; /* OCCURS ... DEPENDING ON */ - cb_tree values; /* VALUE */ - cb_tree false_88; /* 88 FALSE clause */ - cb_tree index_list; /* INDEXED BY */ - cb_tree external_form_identifier; /* target of IDENTIFIED BY - (CGI template) */ - - struct cb_field *parent; /* Upper level field (if any) */ - struct cb_field *children; /* Top of lower level fields */ - struct cb_field *validation; /* First level 88 field (if any) */ - struct cb_field *sister; /* Fields at the same level */ - struct cb_field *redefines; /* REDEFINES or RENAMES */ - struct cb_field *rename_thru; /* RENAMES THRU */ - struct cb_field *index_qual; /* INDEXED BY qualifier */ - struct cb_file *file; /* FD section file name */ - struct cb_cd *cd; /* CD name */ - struct cb_key *keys; /* SEARCH key */ - struct cb_picture *pic; /* PICTURE */ - struct cb_field *vsize; /* Variable size cache */ - struct cb_label *debug_section; /* DEBUG section */ - struct cb_report *report; /* RD section report name */ - - struct cb_xref xref; /* xref elements */ - - cb_tree screen_line; /* LINE */ - cb_tree screen_column; /* COLUMN */ - cb_tree screen_from; /* TO and USING */ - cb_tree screen_to; /* FROM and USING */ - cb_tree screen_foreg; /* FOREGROUND */ - cb_tree screen_backg; /* BACKGROUND */ - cb_tree screen_prompt; /* PROMPT */ - cb_tree report_source; /* SOURCE field */ - cb_tree report_from; /* SOURCE field subscripted; so MOVE to report_source */ - cb_tree report_sum_counter;/* SUM counter */ - cb_tree report_sum_list;/* SUM field(s) */ - cb_tree report_sum_upon;/* SUM ... UPON detailname */ - cb_tree report_reset; /* RESET ON field */ - cb_tree report_control; /* CONTROL identifier */ - cb_tree report_when; /* PRESENT WHEN condition */ - cb_tree report_column_list;/* List of Column Numbers */ - cb_tree same_as; /* SAME AS data-name (points to field) */ - - int id; /* Field id */ - int size; /* Field size */ - int level; /* Level number */ - int memory_size; /* Memory size */ - int compx_size; /* Original COMP-X byte size */ - int offset; /* Byte offset from 01 level */ - int occurs_min; /* OCCURS */ - int occurs_max; /* OCCURS [... TO] */ - int indexes; /* Indices count (OCCURS) */ - - int count; /* Reference count */ - int mem_offset; /* Memory offset */ - int nkeys; /* Number of keys */ - int param_num; /* CHAINING param number */ - cob_flags_t screen_flag; /* Flags used in SCREEN SECTION */ - int report_flag; /* Flags used in REPORT SECTION */ - int report_line; /* LINE */ - int report_column; /* COLUMN (first value) */ - int report_num_col; /* Number of COLUMNs defined */ - int report_decl_id; /* Label id of USE FOR REPORTING */ - int step_count; /* STEP in REPORT */ - int next_group_line;/* NEXT GROUP [PLUS] line */ - unsigned int vaddr; /* Variable address cache */ - unsigned int odo_level; /* ODO level (0 = no ODO item) - could be direct ODO (check via depending) - or via subordinate) */ - enum cb_index_type index_type; /* Type of generated index */ - - enum cb_storage storage; /* Storage section */ - enum cb_usage usage; /* USAGE */ - - char * sql_name; /* Defined SQL field name */ - char * sql_date_format; /* Date field format string */ - char * sql_when; /* WHEN condition */ - - /* Flags */ - unsigned char flag_base; /* Has memory allocation */ - unsigned char flag_external; /* EXTERNAL */ - unsigned char flag_local_storage; /* LOCAL storage */ - unsigned char flag_is_global; /* Is GLOBAL */ - - unsigned int flag_local : 1; /* Has local scope */ - unsigned int flag_occurs : 1; /* OCCURS */ - unsigned int flag_sign_clause : 1; /* Any SIGN clause */ - unsigned int flag_sign_separate : 1; /* SIGN IS SEPARATE */ - unsigned int flag_sign_leading : 1; /* SIGN IS LEADING */ - unsigned int flag_blank_zero : 1; /* BLANK WHEN ZERO */ - unsigned int flag_justified : 1; /* JUSTIFIED RIGHT */ - unsigned int flag_binary_swap : 1; /* Binary byteswap */ - - unsigned int flag_real_binary : 1; /* BINARY-CHAR/SHORT/LONG/DOUBLE */ - unsigned int flag_is_pointer : 1; /* Is POINTER */ - unsigned int flag_item_78 : 1; /* Is a constant by 78 level, - 01 CONSTANT or SYMBOLIC CONSTANT */ - unsigned int flag_any_length : 1; /* Is ANY LENGTH */ - unsigned int flag_item_based : 1; /* Is BASED */ - unsigned int flag_is_external_form : 1; /* Is EXTERNAL-FORM */ - unsigned int flag_filler : 1; /* Implicit/explicit filler */ - unsigned int flag_synchronized : 1; /* SYNCHRONIZED */ - - unsigned int flag_invalid : 1; /* Is broken */ - unsigned int flag_field : 1; /* Has been internally cached */ - unsigned int flag_chained : 1; /* CHAINING item */ - unsigned int flag_data_set : 1; /* The data address was set in entry code */ - unsigned int flag_is_verified : 1; /* Has been verified */ - unsigned int flag_is_c_long : 1; /* Is BINARY-C-LONG */ - unsigned int flag_is_pdiv_parm : 1; /* Is PROC DIV USING */ - unsigned int flag_is_pdiv_opt : 1; /* Is PROC DIV USING OPTIONAL */ - - unsigned int flag_indexed_by : 1; /* INDEXED BY item */ - unsigned int flag_local_alloced : 1; /* LOCAL storage is allocated */ - unsigned int flag_no_init : 1; /* No initialize unless used */ - unsigned int flag_vsize_done : 1; /* Variable size cached */ - unsigned int flag_vaddr_done : 1; /* Variable address cached */ - unsigned int flag_odo_relative : 1; /* complex-odo: item address depends - on size of a different (ODO) item */ - unsigned int flag_field_debug : 1; /* DEBUGGING */ - unsigned int flag_all_debug : 1; /* DEBUGGING */ - - unsigned int flag_no_field : 1; /* SCREEN/REPORT dummy field */ - unsigned int flag_any_numeric : 1; /* Is ANY NUMERIC */ - unsigned int flag_is_returning : 1; /* Is RETURNING item */ - unsigned int flag_unbounded : 1; /* OCCURS UNBOUNDED */ - unsigned int flag_constant : 1; /* Is 01 AS CONSTANT */ - unsigned int flag_internal_constant : 1; /* Is an internally generated CONSTANT */ - unsigned int flag_comp_1 : 1; /* Is USAGE COMP-1 */ - unsigned int flag_volatile : 1; /* VOLATILE */ - - unsigned int flag_sql_binary : 1; /* Store field as BINARY */ - unsigned int flag_sql_char : 1; /* Store field as CHAR */ - unsigned int flag_sql_varchar : 1; /* Store field as VARCHAR */ - unsigned int flag_sql_numeric : 1; /* Store field as DECIMAL */ - unsigned int flag_sql_date : 1; /* Store field as DATE */ - unsigned int flag_sql_group : 1; /* Keep group as a field */ - unsigned int flag_validated : 1; /* 'usage' was validated */ - unsigned int flag_usage_defined : 1; /* 'usage' was specifically coded */ - - unsigned int flag_sync_left : 1; /* SYNCHRONIZED LEFT */ - unsigned int flag_sync_right : 1; /* SYNCHRONIZED RIGHT */ - -}; - -#define CB_FIELD(x) (CB_TREE_CAST (CB_TAG_FIELD, struct cb_field, x)) -#define CB_FIELD_P(x) (CB_TREE_TAG (x) == CB_TAG_FIELD) - -#define CB_REF_OR_FIELD_P(x) (CB_REFERENCE_P (x) || CB_FIELD_P (x)) - -#define CB_FIELD_PTR(x) \ - (CB_REFERENCE_P (x) ? CB_FIELD (cb_ref (x)) : CB_FIELD (x)) - -/* Index */ - -#define CB_INDEX_OR_HANDLE_P(x) cb_check_index_or_handle_p (x) - -/* Label */ - -struct cb_para_label { - struct cb_para_label *next; - struct cb_label *para; -}; - -struct cb_alter_id { - struct cb_alter_id *next; - int goto_id; -}; - -struct cb_label { - struct cb_tree_common common; /* Common values */ - const char *name; /* Name */ - const char *orig_name; /* Original name */ - struct cb_label *section; /* Parent SECTION */ - struct cb_label *debug_section; /* DEBUG SECTION */ - struct cb_para_label *para_label; /* SECTION Paragraphs */ - struct cb_xref xref; /* xref elements */ - cb_tree exit_label; /* EXIT label */ - struct cb_alter_id *alter_gotos; /* ALTER ids */ - int id; /* Unique id */ - int section_id; /* SECTION id */ - int segment; /* Segment number */ - - unsigned int flag_section : 1; /* Section */ - unsigned int flag_entry : 1; /* Entry */ - unsigned int flag_begin : 1; /* Begin label */ - unsigned int flag_return : 1; /* End label */ - unsigned int flag_real_label : 1; /* Is real label */ - unsigned int flag_global : 1; /* GLOBAL */ - unsigned int flag_declarative_exit : 1; /* Final EXIT */ - unsigned int flag_declaratives : 1; /* DECLARATIVES */ - - unsigned int flag_fatal_check : 1; /* Fatal check */ - unsigned int flag_dummy_section : 1; /* Dummy MAIN */ - unsigned int flag_dummy_paragraph : 1; /* Dummy MAIN */ - unsigned int flag_dummy_exit : 1; /* Dummy EXIT */ - unsigned int flag_next_sentence : 1; /* NEXT SENTENCE */ - unsigned int flag_default_handler : 1; /* Error handler */ - unsigned int flag_statement : 1; /* Has statement */ - unsigned int flag_first_is_goto : 1; /* 1st is GO TO */ - - unsigned int flag_alter : 1; /* ALTER code */ - unsigned int flag_debugging_mode : 1; /* DEBUGGING MODE */ - unsigned int flag_is_debug_sect : 1; /* DEBUGGING sect */ - unsigned int flag_skip_label : 1; /* Skip label gen */ - unsigned int flag_entry_for_goto : 1; /* is ENTRY FOR GO TO */ -}; - -#define CB_LABEL(x) (CB_TREE_CAST (CB_TAG_LABEL, struct cb_label, x)) -#define CB_LABEL_P(x) (CB_TREE_TAG (x) == CB_TAG_LABEL) - -struct handler_struct { - struct cb_label *handler_label; /* Handler label */ - struct cb_program *handler_prog; /* Handler program */ -}; - -/* File */ - -struct cb_key_component { - struct cb_key_component *next; - cb_tree component; /* Field which is part of index */ -}; - -struct cb_alt_key { - struct cb_alt_key *next; /* Pointer to next */ - cb_tree key; /* Key item */ - cb_tree password; /* Password item */ - cb_tree collating_sequence_key; /* COLLATING */ - cb_tree suppress; /* Suppress Literal */ - int duplicates; /* DUPLICATES */ - int offset; /* Offset from start */ - int tf_suppress; /* !0 for SUPPRESS */ - int char_suppress; /* character to test for suppress */ - struct cb_key_component *component_list; /* List of fields making up key */ -}; - -/* How to interpret identifiers in a file's ASSIGN clause */ -enum cb_assign_type { - CB_ASSIGN_VARIABLE_DEFAULT, /* default to ASSIGN variable, where allowed by implicit-assign-dynamic-var */ - CB_ASSIGN_VARIABLE_REQUIRED, /* require ASSIGN variable */ - CB_ASSIGN_EXT_FILE_NAME_REQUIRED /* require ASSIGN external-file-name */ -}; - -struct cb_file { - struct cb_tree_common common; /* Common values */ - const char *name; /* Original name */ - char *cname; /* Name used in C */ - /* SELECT */ - cb_tree assign; /* ASSIGN */ - cb_tree file_status; /* FILE STATUS */ - cb_tree sharing; /* SHARING */ - cb_tree key; /* Primary RECORD KEY */ - cb_tree password; /* Password item for file or primary key */ - struct cb_key_component *component_list; /* List of fields making up primary key */ - struct cb_alt_key *alt_key_list; /* ALTERNATE RECORD KEY */ - cb_tree collating_sequence_key; /* COLLATING */ - cb_tree collating_sequence; /* COLLATING */ - cb_tree collating_sequence_n; /* COLLATING FOR NATIONAL*/ - cb_tree collating_sequence_keys; /* list of postponed COLLATING OF */ - /* FD/SD */ - struct cb_field *record; /* Record descriptions */ - cb_tree record_depending; /* RECORD DEPENDING */ - cb_tree reports; /* REPORTS */ - cb_tree linage; /* LINAGE */ - cb_tree linage_ctr; /* LINAGE COUNTER */ - cb_tree latfoot; /* LINAGE FOOTING */ - cb_tree lattop; /* LINAGE TOP */ - cb_tree latbot; /* LINAGE BOTTOM */ - cb_tree extfh; /* EXTFH module to call for I/O */ - struct cb_label *handler; /* Error handler */ - struct cb_program *handler_prog; /* Prog where defined */ - struct cb_label *debug_section; /* DEBUG SECTION */ - struct cb_alphabet_name *code_set; /* CODE-SET */ - struct cb_list *code_set_items; /* CODE-SET FOR items */ - struct cb_xref xref; /* xref elements */ - char *sql_name; /* Table name for ODBC/SQL */ - int record_min; /* RECORD CONTAINS */ - int record_max; /* RECORD CONTAINS */ - int optional; /* OPTIONAL */ - int organization; /* ORGANIZATION - FIXME: use enum */ - int access_mode; /* ACCESS MODE - FIXME: use enum */ - int lock_mode; /* LOCK MODE */ - int fd_share_mode; /* SHARING mode */ - int special; /* Special file */ - int same_clause; /* SAME clause */ - int max_sql_name_len; /* Max length of SQL column name */ - enum cb_assign_type assign_type; /* How to interpret ASSIGN clause */ - unsigned int flag_finalized : 1; /* Is finalized */ - unsigned int flag_external : 1; /* Is EXTERNAL */ - unsigned int flag_ext_assign : 1; /* ASSIGN EXTERNAL */ - unsigned int flag_fileid : 1; /* ASSIGN DISK */ - unsigned int flag_global : 1; /* Is GLOBAL */ - unsigned int flag_fl_debug : 1; /* DEBUGGING */ - unsigned int flag_line_adv : 1; /* LINE ADVANCING */ - unsigned int flag_delimiter : 1; /* RECORD DELIMITER */ - - unsigned int flag_report : 1; /* Used by REPORT */ - /* Implied RECORD VARYING limits need checking */ - unsigned int flag_check_record_varying_limits : 1; - unsigned int flag_sql_xfd : 1; /* Emit the XFD/ddl for this file */ - unsigned int flag_sql_trim_prefix : 1; /* Trim common prefix for SQL column name */ - unsigned int flag_sql_trim_dash : 1; /* Remove dash/underscore from SQL column name */ - /* Whether the file's ASSIGN is like "ASSIGN word", not "ASSIGN - EXTERNAL/DYNAMIC/USING/... word" */ - unsigned int flag_assign_no_keyword : 1; -}; - -#define CB_FILE(x) (CB_TREE_CAST (CB_TAG_FILE, struct cb_file, x)) -#define CB_FILE_P(x) (CB_TREE_TAG (x) == CB_TAG_FILE) - -/* Communication description */ - -struct cb_cd { - struct cb_tree_common common; /* Common values */ - const char *name; /* Name */ - struct cb_field *record; /* Record descriptions */ - struct cb_label *debug_section; /* DEBUG section */ - int flag_field_debug; /* DEBUGGING */ -}; - -#define CB_CD(x) (CB_TREE_CAST (CB_TAG_CD, struct cb_cd, x)) -#define CB_CD_P(x) (CB_TREE_TAG (x) == CB_TAG_CD) - -/* Reference */ - -struct cb_word { - struct cb_word *next; /* Next word with the same hash value */ - const char *name; /* Word name */ - cb_tree items; /* Objects associated with this word */ - int count; /* Number of words with the same name */ - int error; /* Set to 1 if error detected */ -}; - -#define CB_WORD_TABLE_SIZE (CB_WORD_HASH_SIZE * sizeof (struct cb_word)) - -struct cb_reference { - struct cb_tree_common common; /* Common values */ - cb_tree chain; /* Next qualified name */ - cb_tree value; /* Item referred to */ - cb_tree subs; /* List of subscripts */ - cb_tree offset; /* Reference mod offset */ - cb_tree length; /* Reference mod length */ - cb_tree check; /* Runtime checks */ - struct cb_word *word; /* Pointer to word list */ - struct cb_label *section; /* Current section */ - struct cb_label *paragraph; /* Current paragraph */ - struct cb_label *debug_section; /* Debug section */ - size_t hashval; /* Hash value of name */ - - unsigned int flag_receiving : 1; /* Reference target */ - unsigned int flag_all : 1; /* ALL */ - unsigned int flag_in_decl : 1; /* In DECLARATIVE */ - unsigned int flag_decl_ok : 1; /* DECLARATIVE ref OK */ - unsigned int flag_alter_code : 1; /* Needs ALTER code */ - unsigned int flag_debug_code : 1; /* Needs DEBUG code */ - unsigned int flag_all_debug : 1; /* Needs ALL DEBUG code */ - unsigned int flag_target : 1; /* DEBUG item is target */ - - unsigned int flag_optional : 1; /* Definition optional */ - unsigned int flag_ignored : 1; /* Part of ignored code */ - unsigned int flag_filler_ref : 1; /* Ref to FILLER */ - unsigned int flag_duped : 1; /* Duplicate name */ -}; - -#define CB_REFERENCE(x) (CB_TREE_CAST (CB_TAG_REFERENCE, struct cb_reference, x)) -#define CB_REFERENCE_P(x) (CB_TREE_TAG (x) == CB_TAG_REFERENCE) - -#define CB_WORD(x) (CB_REFERENCE (x)->word) -#define CB_NAME(x) (CB_REFERENCE (x)->word->name) -#define CB_WORD_COUNT(x) (CB_REFERENCE (x)->word->count) -#define CB_WORD_ITEMS(x) (CB_REFERENCE (x)->word->items) - -/* Binary operation */ - -/* - '+' x + y - '-' x - y - '*' x * y - '/' x / y - '^' x ** y - '=' x = y - '>' x > y - '<' x < y - '[' x <= y - ']' x >= y - '~' x != y - '!' not x - '&' x and y - '|' x or y - '@' ( x ) -*/ - -struct cb_binary_op { - struct cb_tree_common common; /* Common values */ - cb_tree x; /* LHS */ - cb_tree y; /* RHS */ - int op; /* Operation */ - unsigned int flag; /* Special usage */ -}; - -#define CB_BINARY_OP(x) (CB_TREE_CAST (CB_TAG_BINARY_OP, struct cb_binary_op, x)) -#define CB_BINARY_OP_P(x) (CB_TREE_TAG (x) == CB_TAG_BINARY_OP) - -/* Function call */ - -struct cb_funcall { - struct cb_tree_common common; /* Common values */ - const char *name; /* Function name */ - cb_tree argv[11]; /* Function arguments */ - int argc; /* Number of arguments */ - int varcnt; /* Variable argument count */ - unsigned int screenptr; /* SCREEN usage */ - unsigned int nolitcast; /* No cast for literals */ -}; - -#define CB_FUNCALL(x) (CB_TREE_CAST (CB_TAG_FUNCALL, struct cb_funcall, x)) -#define CB_FUNCALL_P(x) (CB_TREE_TAG (x) == CB_TAG_FUNCALL) - -/* Type cast */ - -struct cb_cast { - struct cb_tree_common common; /* Common values */ - cb_tree val; - enum cb_cast_type cast_type; -}; - -#define CB_CAST(x) (CB_TREE_CAST (CB_TAG_CAST, struct cb_cast, x)) -#define CB_CAST_P(x) (CB_TREE_TAG (x) == CB_TAG_CAST) - -/* Assign */ - -struct cb_assign { - struct cb_tree_common common; /* Common values */ - cb_tree var; - cb_tree val; -}; - -#define CB_ASSIGN(x) (CB_TREE_CAST (CB_TAG_ASSIGN, struct cb_assign, x)) -#define CB_ASSIGN_P(x) (CB_TREE_TAG (x) == CB_TAG_ASSIGN) - -/* Compiler features like directives, functions, mnemonics and registers */ - -enum cb_feature_mode { - CB_FEATURE_ACTIVE = 0, /* 0 Feature is implemented and not disabled */ - CB_FEATURE_DISABLED, /* 1 Feature disabled */ - CB_FEATURE_MUST_BE_ENABLED, /* 2 Feature disabled, if not explicit enabled */ - CB_FEATURE_NOT_IMPLEMENTED /* 3 Feature known but not yet implemented */ -}; - -/* Intrinsic FUNCTION */ - -struct cb_intrinsic_table { - const char *name; /* FUNCTION NAME */ - const char *intr_routine; /* Routine name */ - const enum cb_intr_enum intr_enum; /* Enum intrinsic */ - const int token; /* Token value */ - enum cb_feature_mode active; /* Have we implemented it? Is it active? */ - const int args; /* Maximum number of arguments, -1 = unlimited */ - const int min_args; /* Minimum number of arguments */ - const enum cb_category category; /* Category */ - const unsigned int refmod; /* Can be refmodded */ -}; - -struct cb_intrinsic { - struct cb_tree_common common; /* Common values */ - cb_tree name; /* INTRINSIC name */ - cb_tree args; /* Arguments */ - cb_tree intr_field; /* Field to use */ - const struct cb_intrinsic_table *intr_tab; /* Table pointer */ - cb_tree offset; /* Reference mod */ - cb_tree length; /* Reference mod */ - int isuser; /* User function */ -}; - -#define CB_INTRINSIC(x) (CB_TREE_CAST (CB_TAG_INTRINSIC, struct cb_intrinsic, x)) -#define CB_INTRINSIC_P(x) (CB_TREE_TAG (x) == CB_TAG_INTRINSIC) - -/* INITIALIZE */ - -struct cb_initialize { - struct cb_tree_common common; /* Common values */ - cb_tree var; /* Field */ - cb_tree val; /* Value */ - cb_tree rep; /* Replacing */ - unsigned char flag_default; /* Default */ - unsigned char flag_init_statement; /* INITIALIZE statement */ - unsigned char flag_no_filler_init; /* No FILLER initialize */ - unsigned char padding; /* Padding */ -}; - -#define CB_INITIALIZE(x) (CB_TREE_CAST (CB_TAG_INITIALIZE, struct cb_initialize, x)) -#define CB_INITIALIZE_P(x) (CB_TREE_TAG (x) == CB_TAG_INITIALIZE) - -/* SEARCH */ - -struct cb_search { - struct cb_tree_common common; /* Common values */ - cb_tree table; /* Table name */ - cb_tree var; /* Varying */ - cb_tree end_stmt; /* AT END */ - cb_tree whens; /* WHEN */ - int flag_all; /* SEARCH ALL */ -}; - -#define CB_SEARCH(x) (CB_TREE_CAST (CB_TAG_SEARCH, struct cb_search, x)) -#define CB_SEARCH_P(x) (CB_TREE_TAG (x) == CB_TAG_SEARCH) - -/* CALL */ - -struct cb_call { - struct cb_tree_common common; /* Common values */ - cb_tree name; /* CALL name */ - cb_tree args; /* Arguments */ - cb_tree stmt1; /* ON EXCEPTION */ - cb_tree stmt2; /* NOT ON EXCEPTION */ - cb_tree call_returning; /* RETURNING */ - cob_u32_t is_system; /* System call */ - int convention; /* CALL convention */ -}; - -#define CB_CALL(x) (CB_TREE_CAST (CB_TAG_CALL, struct cb_call, x)) -#define CB_CALL_P(x) (CB_TREE_TAG (x) == CB_TAG_CALL) - -/* CANCEL */ - -struct cb_cancel { - struct cb_tree_common common; /* Common values */ - cb_tree target; /* CANCEL target(s) */ -}; - -#define CB_CANCEL(x) (CB_TREE_CAST (CB_TAG_CANCEL, struct cb_cancel, x)) -#define CB_CANCEL_P(x) (CB_TREE_TAG (x) == CB_TAG_CANCEL) - -/* ALTER */ - -struct cb_alter { - struct cb_tree_common common; /* Common values */ - cb_tree source; /* ALTER source paragraph */ - cb_tree target; /* ALTER target GO TO paragraph */ -}; - -#define CB_ALTER(x) (CB_TREE_CAST (CB_TAG_ALTER, struct cb_alter, x)) -#define CB_ALTER_P(x) (CB_TREE_TAG (x) == CB_TAG_ALTER) - -/* GO TO */ - -struct cb_goto { - struct cb_tree_common common; /* Common values */ - cb_tree target; /* Procedure name(s) */ - cb_tree depending; /* DEPENDING */ -}; - -#define CB_GOTO(x) (CB_TREE_CAST (CB_TAG_GOTO, struct cb_goto, x)) -#define CB_GOTO_P(x) (CB_TREE_TAG (x) == CB_TAG_GOTO) - -/* IF and WHEN and PRESENT WHEN */ - -struct cb_if { - struct cb_tree_common common; /* Common values */ - cb_tree test; /* Condition */ - cb_tree stmt1; /* Statement list */ - cb_tree stmt2; /* ELSE/WHEN statement list */ - unsigned int is_if; /* From IF (1), WHEN (0), PRESENT WHEN (3+4) */ -}; - -#define CB_IF(x) (CB_TREE_CAST (CB_TAG_IF, struct cb_if, x)) -#define CB_IF_P(x) (CB_TREE_TAG (x) == CB_TAG_IF) - -/* PERFORM */ - -struct cb_perform_varying { - struct cb_tree_common common; /* Common values */ - cb_tree name; /* VARYING item */ - cb_tree from; /* FROM */ - cb_tree step; /* Increment */ - cb_tree until; /* UNTIL */ -}; - -struct cb_perform { - struct cb_tree_common common; /* Common values */ - cb_tree test; /* Condition */ - cb_tree body; /* Statements */ - cb_tree data; /* TIMES or procedure */ - cb_tree varying; /* VARYING */ - cb_tree exit_label; /* Implicit exit label */ - cb_tree cycle_label; /* EXIT PERFORM CYCLE */ - enum cb_perform_type perform_type; /* Perform type */ -}; - -#define CB_PERFORM_VARYING(x) (CB_TREE_CAST (CB_TAG_PERFORM_VARYING, struct cb_perform_varying, x)) - -#define CB_PERFORM(x) (CB_TREE_CAST (CB_TAG_PERFORM, struct cb_perform, x)) -#define CB_PERFORM_P(x) (CB_TREE_TAG (x) == CB_TAG_PERFORM) - -/* Struct for extended ACCEPT / DISPLAY */ - -struct cb_attr_struct { - cb_tree fgc; /* FOREGROUND COLOR */ - cb_tree bgc; /* BACKGROUND COLOR */ - cb_tree scroll; /* SCROLL */ - cb_tree timeout; /* TIMEOUT */ - cb_tree prompt; /* PROMPT */ - cb_tree size_is; /* [PROTECTED] SIZE [IS] */ - cob_flags_t dispattrs; /* Attributes */ -}; - -/* Exception handler type */ - -enum cb_handler_type { - NO_HANDLER = 0, - DISPLAY_HANDLER, - ACCEPT_HANDLER, - SIZE_ERROR_HANDLER, - OVERFLOW_HANDLER, - AT_END_HANDLER, - EOP_HANDLER, - INVALID_KEY_HANDLER, - XML_HANDLER, - JSON_HANDLER -}; - -/* Statement */ - -struct cb_statement { - struct cb_tree_common common; /* Common values */ - const char *name; /* Statement name */ - cb_tree body; /* Statement body */ - cb_tree file; /* File reference */ - cb_tree ex_handler; /* Exception handler */ - cb_tree not_ex_handler; /* Exception handler */ - cb_tree handler3; /* INTO clause */ - cb_tree null_check; /* NULL check */ - cb_tree debug_check; /* Field DEBUG */ - cb_tree debug_nodups; /* Field DEBUG dups */ - cb_tree retry; /* RETRY expression */ - struct cb_attr_struct *attr_ptr; /* Attributes */ - enum cb_handler_type handler_type; /* Handler type */ - unsigned int flag_no_based : 1; /* Check BASED */ - unsigned int flag_in_debug : 1; /* In DEBUGGING */ - unsigned int flag_merge : 1; /* Is MERGE */ - unsigned int flag_callback : 1; /* DEBUG Callback */ - unsigned int flag_implicit : 1; /* Is an implicit statement */ - unsigned int flag_retry_times: 1; /* RETRY exp TIMES */ - unsigned int flag_retry_seconds: 1; /* RETRY exp SECONDS */ - unsigned int flag_retry_forever: 1; /* RETRY FOREVER */ - unsigned int flag_advancing_lock: 1; /* ADVANCING ON LOCK */ - unsigned int flag_ignore_lock: 1; /* IGNORE LOCK */ -}; - -#define CB_STATEMENT(x) (CB_TREE_CAST (CB_TAG_STATEMENT, struct cb_statement, x)) -#define CB_STATEMENT_P(x) (CB_TREE_TAG (x) == CB_TAG_STATEMENT) - -/* CONTINUE (*not* CONTINUE AFTER exp SECONDS) */ - -struct cb_continue { - struct cb_tree_common common; /* Common values */ -}; - -#define CB_CONTINUE(x) (CB_TREE_CAST (CB_TAG_CONTINUE, struct cb_continue, x)) -#define CB_CONTINUE_P(x) (CB_TREE_TAG (x) == CB_TAG_CONTINUE) - -/* SET ATTRIBUTE */ - -struct cb_set_attr { - struct cb_tree_common common; /* Common values */ - struct cb_field *fld; - cob_flags_t val_on; - cob_flags_t val_off; -}; - -#define CB_SET_ATTR(x) (CB_TREE_CAST (CB_TAG_SET_ATTR, struct cb_set_attr, x)) -#define CB_SET_ATTR_P(x) (CB_TREE_TAG (x) == CB_TAG_SET_ATTR) - -/* List */ - -struct cb_list { - struct cb_tree_common common; /* Common values */ - cb_tree chain; /* Next in list */ - cb_tree value; /* Reference to item(s) */ - cb_tree purpose; /* Purpose */ - int sizes; /* BY VALUE SIZE */ -}; - -#define CB_LIST(x) (CB_TREE_CAST (CB_TAG_LIST, struct cb_list, x)) -#define CB_LIST_P(x) (CB_TREE_TAG (x) == CB_TAG_LIST) - -#define CB_PURPOSE(x) (CB_LIST (x)->purpose) -#define CB_VALUE(x) (CB_LIST (x)->value) -#define CB_CHAIN(x) (CB_LIST (x)->chain) -#define CB_SIZES(x) (CB_LIST (x)->sizes) - -#define CB_PURPOSE_INT(x) (CB_INTEGER (CB_PURPOSE (x))->val) - -#define CB_SIZES_INT(x) ((CB_LIST (x)->sizes) & 0x07) -#define CB_SIZES_INT_UNSIGNED(x) ((CB_LIST (x)->sizes) & CB_SIZE_UNSIGNED) - -/* Pair */ - -#define CB_PAIR_P(x) (CB_LIST_P (x) && CB_PAIR_X (x)) -#define CB_PAIR_X(x) CB_PURPOSE (x) -#define CB_PAIR_Y(x) CB_VALUE (x) - -/* Report */ - -struct cb_report { - struct cb_tree_common common; /* Common values */ - const char *name; /* Original name */ - char *cname; /* Name used in C */ - struct cb_file *file; /* File */ - cb_tree line_counter; /* LINE-COUNTER */ - cb_tree page_counter; /* PAGE-COUNTER */ - cb_tree code_clause; /* CODE */ - cb_tree controls; /* CONTROLS */ - cb_tree t_lines; /* PAGE LIMIT LINES */ - cb_tree t_columns; /* PAGE LIMIT COLUMNS */ - cb_tree t_heading; /* HEADING */ - cb_tree t_first_detail; /* FIRST DE */ - cb_tree t_last_control; /* LAST CH */ - cb_tree t_last_detail; /* LAST DE */ - cb_tree t_footing; /* FOOTING */ - int lines; /* PAGE LIMIT LINES */ - int columns; /* PAGE LIMIT COLUMNS */ - int heading; /* HEADING */ - int first_detail; /* FIRST DE */ - int last_control; /* LAST CH */ - int last_detail; /* LAST DE */ - int footing; /* FOOTING */ - struct cb_field *records; /* First record definition of report */ - int num_lines; /* Number of Lines defined */ - struct cb_field **line_ids; /* array of LINE definitions */ - int num_sums; /* Number of SUM counters defined */ - struct cb_field **sums; /* Array of SUM fields */ - int rcsz; /* Longest record */ - int id; /* unique id for this report */ - unsigned int control_final:1;/* CONTROL FINAL declared */ - unsigned int global:1; /* IS GLOBAL declared */ - unsigned int has_declarative:1;/* Has Declaratives Code to be executed */ - unsigned int has_detail:1; /* Has DETAIL line */ -}; - -#define CB_REPORT(x) (CB_TREE_CAST (CB_TAG_REPORT, struct cb_report, x)) -#define CB_REPORT_P(x) (CB_TREE_TAG (x) == CB_TAG_REPORT) - -#define CB_REF_OR_REPORT_P(x) \ - (CB_REFERENCE_P (x) ? CB_REPORT_P (cb_ref (x)) : CB_REPORT_P (x)) - -#define CB_REPORT_PTR(x) \ - (CB_REFERENCE_P (x) ? CB_REPORT (cb_ref (x)) : CB_REPORT (x)) - -/* Mark-up Language output (JSON/XML GENERATE) tree */ - -enum cb_ml_type { - CB_ML_ATTRIBUTE, - CB_ML_ELEMENT, - CB_ML_CONTENT, - CB_ML_ANY_TYPE -}; - -struct cb_ml_generate_tree { - struct cb_tree_common common; - /* Name of the ML element to generate */ - cb_tree name; - /* The type of the ML element to generate */ - enum cb_ml_type type; - /* The content of the ML element to generate */ - cb_tree value; - /* The condition under which generation of the element is suppressed */ - cb_tree suppress_cond; - /* ID for this struct when output */ - int id; - /* Attributes for this element */ - struct cb_ml_generate_tree *attrs; - /* Parent ML element */ - struct cb_ml_generate_tree *parent; - /* Children ML elements */ - struct cb_ml_generate_tree *children; - /* Preceding ML elements */ - struct cb_ml_generate_tree *prev_sibling; - /* Following ML elements */ - struct cb_ml_generate_tree *sibling; -}; - -#define CB_ML_TREE(x) (CB_TREE_CAST (CB_TAG_ML_TREE, struct cb_ml_generate_tree, x)) -#define CB_ML_TREE_P(x) (CB_TREE_TAG (x) == CB_TAG_ML_TREE) - -/* Program */ - -struct nested_list { - struct nested_list *next; - struct cb_program *nested_prog; -}; - -struct cb_program { - struct cb_tree_common common; /* Common values */ - - /* Program variables */ - struct cb_program *next_program; /* Nested/contained */ - struct cb_program *next_program_ordered; /* Nested/contained - when cb_correct_program_order is set */ - const char *program_name; /* Internal program-name */ - const char *program_id; /* Demangled external PROGRAM-ID */ - char *source_name; /* Source name */ - char *orig_program_id; /* Original external PROGRAM-ID */ - struct cb_word **word_table; /* Name hash table */ - struct local_filename *local_include; /* Local include info */ - struct nested_list *nested_prog_list; /* Callable contained */ - struct nested_list *common_prog_list; /* COMMON contained */ - cb_tree entry_list; /* Entry point list */ - cb_tree entry_list_goto; /* Special Entry point list */ - cb_tree file_list; /* File list */ - cb_tree cd_list; /* CD list */ - cb_tree exec_list; /* Executable statements */ - cb_tree label_list; /* Label list */ - cb_tree reference_list; /* Reference list */ - cb_tree alphabet_name_list; /* ALPHABET list */ - cb_tree symbolic_char_list; /* SYMBOLIC list */ - cb_tree class_name_list; /* CLASS list */ - cb_tree parameter_list; /* USING parameters */ - cb_tree locale_list; /* LOCALE list */ - cb_tree global_list; /* GLOBAL list */ - cb_tree report_list; /* REPORT list */ - cb_tree alter_list; /* ALTER list */ - cb_tree debug_list; /* DEBUG ref list */ - cb_tree cb_return_code; /* RETURN-CODE */ - cb_tree cb_sort_return; /* SORT-RETURN */ - cb_tree cb_call_params; /* Number of CALL params */ - cb_tree mnemonic_spec_list; /* MNEMONIC spec */ - cb_tree class_spec_list; /* CLASS spec */ - cb_tree interface_spec_list; /* INTERFACE spec */ - cb_tree function_spec_list; /* FUNCTION spec */ - cb_tree user_spec_list; /* User FUNCTION spec */ - cb_tree program_spec_list; /* PROGRAM spec */ - cb_tree property_spec_list; /* PROPERTY spec */ - struct cb_alter_id *alter_gotos; /* ALTER ids */ - struct cb_field *working_storage; /* WORKING-STORAGE */ - struct cb_field *local_storage; /* LOCAL-STORAGE */ - struct cb_field *linkage_storage; /* LINKAGE */ - struct cb_field *screen_storage; /* SCREEN */ - struct cb_field *report_storage; /* REPORT */ - cb_tree local_file_list; /* Local files */ - cb_tree global_file_list; /* Global files */ - struct handler_struct global_handler[5]; /* Global handlers */ - cb_tree collating_sequence; /* COLLATING */ - cb_tree collating_sequence_n; /* COLLATING FOR NATIONAL*/ - cb_tree classification; /* CLASSIFICATION */ - cb_tree apply_commit; /* APPLY COMMIT file- and data-items */ - cb_tree cursor_pos; /* CURSOR */ - cb_tree crt_status; /* CRT STATUS */ - cb_tree xml_code; /* XML-CODE */ - cb_tree xml_event; /* XML-EVENT */ - cb_tree xml_information; /* XML-INFORMATION */ - cb_tree xml_namespace; /* XML-NAMESPACE */ - cb_tree xml_nnamespace; /* XML-NNAMESPACE */ - cb_tree xml_namespace_prefix; /* XML-NAMESPACE-PREFIX */ - cb_tree xml_nnamespace_prefix; /* XML-NNAMESPACE-PREFIX */ - cb_tree xml_ntext; /* XML-NTEXT */ - cb_tree xml_text; /* XML-TEXT */ - cb_tree json_code; /* JSON-CODE */ - cb_tree json_status; /* JSON-STATUS */ - cb_tree returning; /* RETURNING */ - struct cb_label *all_procedure; /* DEBUGGING */ - struct cb_call_xref call_xref; /* CALL Xref list */ - struct cb_ml_generate_tree *ml_trees; /* XML GENERATE trees */ - const char *extfh; /* CALLFH for this program */ - - int last_source_line; /* Line of (implicit) END PROGRAM/FUNCTION */ - - /* Internal variables */ - int loop_counter; /* Loop counters */ - unsigned int decimal_index; /* cob_decimal count of this program */ - unsigned int decimal_index_max; /* program group's max cob_decimal */ - int nested_level; /* Nested program level */ - unsigned int num_proc_params; /* PROC DIV params */ - int toplev_count; /* Top level source count */ - unsigned int max_call_param; /* Max params */ - - unsigned char decimal_point; /* '.' or ',' */ - unsigned char currency_symbol; /* '$' or user-specified */ - unsigned char numeric_separator; /* ',' or '.' */ - unsigned char prog_type; /* Program type (program = 0, function = 1) */ - cb_tree entry_convention; /* ENTRY convention / PROCEDURE convention */ - - unsigned int flag_main : 1; /* Gen main function */ - unsigned int flag_common : 1; /* COMMON PROGRAM */ - unsigned int flag_initial : 1; /* INITIAL PROGRAM */ - unsigned int flag_recursive : 1; /* RECURSIVE PROGRAM */ - unsigned int flag_resident : 1; /* RESIDENT PROGRAM */ - unsigned int flag_validated : 1; /* End program validate */ - unsigned int flag_chained : 1; /* PROCEDURE CHAINING */ - unsigned int flag_global_use : 1; /* USE GLOBAL */ - - unsigned int flag_gen_error : 1; /* Gen error routine */ - unsigned int flag_file_global : 1; /* Global FD */ - unsigned int flag_has_external : 1; /* Has EXTERNAL */ - unsigned int flag_segments : 1; /* Has segments */ - unsigned int flag_trailing_separate : 1; /* TRAILING SEPARATE */ - unsigned int flag_console_is_crt : 1; /* CONSOLE IS CRT */ - unsigned int flag_debugging : 1; /* DEBUGGING MODE */ - unsigned int flag_gen_debug : 1; /* DEBUGGING MODE */ - - unsigned int flag_save_exception : 1; /* Save exception code */ - unsigned int flag_report : 1; /* Have REPORT SECTION */ - unsigned int flag_screen : 1; /* Have SCREEN SECTION */ - unsigned int flag_void : 1; /* void return for subprogram */ - unsigned int flag_decimal_comp : 1; /* program group has decimal computations */ -}; - -#define CB_PROGRAM(x) (CB_TREE_CAST (CB_TAG_PROGRAM, struct cb_program, x)) - -/* Function prototype */ - -struct cb_prototype { - struct cb_tree_common common; - /* Name of prototype in the REPOSITORY */ - const char *name; - /* External name of the prototype/definition */ - const char *ext_name; - int type; -}; - -#define CB_PROTOTYPE(x) (CB_TREE_CAST (CB_TAG_PROTOTYPE, struct cb_prototype, x)) -#define CB_PROTOTYPE_P(x) (CB_TREE_TAG (x) == CB_TAG_PROTOTYPE) - -/* JSON/XML GENERATE SUPPRESS clause */ - -enum cb_ml_suppress_target { - CB_ML_SUPPRESS_IDENTIFIER, - CB_ML_SUPPRESS_ALL, - CB_ML_SUPPRESS_TYPE -}; - -enum cb_ml_suppress_category { - CB_ML_SUPPRESS_CAT_NUMERIC, - CB_ML_SUPPRESS_CAT_NONNUMERIC, - CB_ML_SUPPRESS_CAT_ANY -}; - -struct cb_ml_suppress_clause { - struct cb_tree_common common; - /* What thing(s) the SUPPRESS clause applies to */ - enum cb_ml_suppress_target target; - /* If the target is IDENTIFIER, then the item targetted */ - cb_tree identifier; - /* What values the thing(s) should have to be SUPPRESSed */ - cb_tree when_list; - /* If the target is TYPE, then the type of ML elements to apply to */ - enum cb_ml_type ml_type; - /* If the target is TYPE, then the categories of items (of ML type - ml_type) to apply to */ - enum cb_ml_suppress_category category; -}; - -#define CB_ML_SUPPRESS(x) (CB_TREE_CAST (CB_TAG_ML_SUPPRESS, struct cb_ml_suppress_clause, x)) -#define CB_ML_SUPPRESS_P(x) (CB_TREE_TAG (x) == CB_TAG_ML_SUPPRESS) - -struct cb_ml_suppress_checks { - struct cb_tree_common common; - struct cb_ml_generate_tree *tree; -}; - -#define CB_ML_SUPPRESS_CHECKS(x) (CB_TREE_CAST (CB_TAG_ML_SUPPRESS_CHECKS, struct cb_ml_suppress_checks, x)) -#define CB_ML_SUPPRESS_CHECKS_P(x) (CB_TREE_TAG (x) == CB_TAG_ML_SUPPRESS_CHECKS) - -/* DISPLAY type */ - -enum cb_display_type { - UNKNOWN_DISPLAY, - SCREEN_DISPLAY, - FIELD_ON_SCREEN_DISPLAY, - DEVICE_DISPLAY, - MIXED_DISPLAY -}; - -/* INSPECT clauses */ - -enum cb_inspect_clause { - TALLYING_CLAUSE, - REPLACING_CLAUSE, - CONVERTING_CLAUSE, - /* This is what happens when you support OS/VS COBOL. */ - TRANSFORM_STATEMENT -}; - -/* Functions/variables */ - -/* tree.c */ - -extern cb_tree cb_any; -extern cb_tree cb_true; -extern cb_tree cb_false; -extern cb_tree cb_null; -extern cb_tree cb_zero; -extern cb_tree cb_one; -extern cb_tree cb_space; -extern cb_tree cb_low; -extern cb_tree cb_high; -extern cb_tree cb_norm_low; -extern cb_tree cb_norm_high; -extern cb_tree cb_quote; -extern cb_tree cb_int0; -extern cb_tree cb_int1; -extern cb_tree cb_int2; -extern cb_tree cb_int3; -extern cb_tree cb_int4; -extern cb_tree cb_int5; -extern cb_tree cb_int6; -extern cb_tree cb_int7; -extern cb_tree cb_int8; -extern cb_tree cb_int16; -extern cb_tree cb_i[COB_MAX_SUBSCRIPTS]; -extern cb_tree cb_error_node; - -extern cb_tree cb_intr_whencomp; - -extern cb_tree cb_standard_error_handler; -extern cb_tree cb_depend_check; - -extern unsigned int gen_screen_ptr; - -extern char *cb_name (cb_tree); -extern char *cb_name_errmsg (cb_tree); -extern enum cb_class cb_tree_class (cb_tree); -extern enum cb_category cb_tree_category (cb_tree); -extern int cb_tree_type (const cb_tree, - const struct cb_field *); -extern int cb_category_is_alpha (cb_tree); -extern int cb_category_is_national (cb_tree); -extern int cb_fits_int (const cb_tree); -extern int cb_fits_long_long (const cb_tree); -extern int cb_get_int (const cb_tree); -extern cob_s64_t cb_get_long_long (const cb_tree); -extern cob_u64_t cb_get_u_long_long (const cb_tree); - -extern void cb_init_constants (void); - -extern cb_tree cb_int (const int); -extern cb_tree cb_int_hex (const int); - -extern cb_tree cb_build_string (const void *, const size_t); - -extern cb_tree cb_flags_t (const cob_flags_t); - -extern cb_tree cb_build_class_name (cb_tree, cb_tree); - -extern cb_tree cb_build_locale_name (cb_tree, cb_tree); - -extern cb_tree cb_build_numeric_literal (int, - const void *, - const int); -extern cb_tree cb_build_alphanumeric_literal (const void *, - const size_t); -extern cb_tree cb_build_national_literal (const void *, - const size_t); -extern cb_tree cb_build_numsize_literal (const void *, - const size_t, - const int); -extern cb_tree cb_concat_literals (const cb_tree, - const cb_tree); - -extern cb_tree cb_build_decimal (const unsigned int); -extern cb_tree cb_build_decimal_literal (const int); -extern int cb_lookup_literal (cb_tree x, int make_decimal); - -extern cb_tree cb_build_picture (const char *); -extern cb_tree cb_build_comment (const char *); -extern cb_tree cb_build_direct (const char *, - const unsigned int); -extern cb_tree cb_build_debug (const cb_tree, const char *, - const cb_tree); -extern cb_tree cb_build_debug_call (struct cb_label *); - -extern struct cb_picture *cb_build_binary_picture (const char *, - const cob_u32_t, - const cob_u32_t); - -extern cb_tree cb_build_field (cb_tree); -extern cb_tree cb_build_implicit_field (cb_tree, const int); -extern cb_tree cb_build_constant (cb_tree, cb_tree); -extern int cb_build_generic_register (const char *, const char *); - -extern void cb_build_symbolic_chars (const cb_tree, - const cb_tree); - -extern struct cb_field *cb_field_add (struct cb_field *, - struct cb_field *); -extern int cb_field_size (const cb_tree x); -#define FIELD_SIZE_UNKNOWN -1 -extern struct cb_field *cb_field_founder (const struct cb_field * const); -extern struct cb_field *cb_field_variable_size (const struct cb_field *); -extern unsigned int cb_field_variable_address (const struct cb_field *); -extern int cb_field_subordinate (const struct cb_field *, - const struct cb_field *); - -extern cb_tree cb_build_label (cb_tree, struct cb_label *); - -extern struct cb_file *build_file (cb_tree); -extern void validate_file (struct cb_file *, cb_tree); -extern void finalize_file (struct cb_file *, - struct cb_field *); - -extern struct cb_cd * cb_build_cd (cb_tree name); -extern void cb_finalize_cd (struct cb_cd *, - struct cb_field *); - -extern cb_tree cb_build_filler (void); -extern cb_tree cb_build_reference (const char *); -extern cb_tree cb_build_field_reference (struct cb_field *, - cb_tree); -extern const char *cb_define (cb_tree, cb_tree); -extern char *cb_to_cname (const char *); -extern void cb_set_system_names (void); -extern cb_tree cb_ref (cb_tree); -extern cb_tree cb_try_ref (cb_tree); - -extern cb_tree cb_build_binary_op (cb_tree, const int, - cb_tree); -extern cb_tree cb_build_binary_list (cb_tree, const int); - -extern cb_tree cb_build_funcall (const char *, const int, - const cb_tree, const cb_tree, - const cb_tree, const cb_tree, - const cb_tree, const cb_tree, - const cb_tree, const cb_tree, - const cb_tree, const cb_tree, - const cb_tree); - -extern cb_tree cb_build_cast (const enum cb_cast_type, - const cb_tree); -extern cb_tree cb_build_cast_int (const cb_tree); -extern cb_tree cb_build_cast_llint (const cb_tree); - -extern cb_tree cb_build_assign (const cb_tree, const cb_tree); - -extern cb_tree cb_build_intrinsic (cb_tree, cb_tree, - cb_tree, const int); -extern cb_tree cb_build_prototype (const cb_tree, - const cb_tree, const int); -extern cb_tree cb_build_any_intrinsic (cb_tree); - -extern cb_tree cb_build_search (const int, - const cb_tree, const cb_tree, - const cb_tree, const cb_tree); - -extern cb_tree cb_build_call (const cb_tree, const cb_tree, - const cb_tree, const cb_tree, - const cb_tree, const cob_u32_t, - const int); - -extern cb_tree cb_build_alter (const cb_tree, const cb_tree); - -extern cb_tree cb_build_cancel (const cb_tree); - -extern cb_tree cb_build_goto (const cb_tree, const cb_tree); - -extern cb_tree cb_build_if (const cb_tree, const cb_tree, - const cb_tree, const unsigned int); - -extern cb_tree cb_build_perform (const enum cb_perform_type); -extern cb_tree cb_build_perform_varying (cb_tree, cb_tree, - cb_tree, cb_tree); - -extern struct cb_statement *cb_build_statement (const char *); - -extern cb_tree cb_build_continue (void); - -extern cb_tree cb_build_list (cb_tree, cb_tree, cb_tree); -extern cb_tree cb_list_add (cb_tree, cb_tree); -extern cb_tree cb_pair_add (cb_tree, cb_tree, cb_tree); -extern cb_tree cb_list_append (cb_tree, cb_tree); -extern cb_tree cb_list_reverse (cb_tree); -extern unsigned int cb_list_length (cb_tree); -extern unsigned int cb_next_length (struct cb_next_elem *); - -extern struct cb_report *build_report (cb_tree); -extern void finalize_report (struct cb_report *, struct cb_field *); -extern void build_sum_counter(struct cb_report *r, struct cb_field *f); -extern struct cb_field *get_sum_data_field(struct cb_report *r, struct cb_field *f); - -extern void cb_add_common_prog (struct cb_program *); -extern void cb_insert_common_prog (struct cb_program *, - struct cb_program *); - - -extern struct cb_intrinsic_table *lookup_intrinsic (const char *, - const int); - -extern cb_tree cb_build_alphabet_name (cb_tree); - -extern cb_tree cb_build_initialize (const cb_tree, const cb_tree, - const cb_tree, - const unsigned int, - const unsigned int, - const unsigned int); - -struct cb_literal *build_literal (enum cb_category, - const void *, - const size_t); - -extern cb_tree cb_build_system_name (const enum cb_system_name_category, - const int); - -extern const char *cb_get_usage_string (const enum cb_usage); - -extern cb_tree cb_field_dup (struct cb_field *f, struct cb_reference *ref); - -extern cb_tree cb_build_ml_suppress_clause (void); -extern cb_tree cb_build_ml_tree (struct cb_field *, const int, - const int, cb_tree, cb_tree, - cb_tree); -extern cb_tree cb_build_ml_suppress_checks (struct cb_ml_generate_tree *); - - -/* parser.y */ -extern cb_tree cobc_printer_node; -extern int non_const_word; -extern int suppress_data_exceptions; -extern unsigned int cobc_repeat_last_token; -extern unsigned int cobc_in_id; -extern unsigned int cobc_in_procedure; -extern unsigned int cobc_in_repository; -extern unsigned int cobc_force_literal; -extern unsigned int cobc_cs_check; -extern unsigned int cobc_allow_program_name; -extern unsigned int cobc_in_xml_generate_body; -extern unsigned int cobc_in_json_generate_body; - -/* reserved.c */ -extern int is_reserved_word (const char *); -extern int is_default_reserved_word (const char *); -extern void remove_context_sensitivity (const char *, - const int); -extern struct cobc_reserved *lookup_reserved_word (const char *); -extern cb_tree get_system_name (const char *); -extern cb_tree get_system_name_translated (cb_tree); -extern const char *cb_get_register_definition (const char *); -extern void cb_list_reserved (void); -extern void cb_list_intrinsics (void); -extern void cb_list_system_names (void); -extern void cb_list_registers (void); -extern void cb_list_system_routines (void); -extern int cb_list_map (cb_tree (*) (cb_tree), cb_tree); - -/* error.c */ -extern void cb_warning_x (int, cb_tree, const char *, ...) COB_A_FORMAT34; -extern void cb_warning_dialect_x (const enum cb_support, cb_tree, const char *, ...) COB_A_FORMAT34; -extern void cb_error_x (cb_tree, const char *, ...) COB_A_FORMAT23; -extern unsigned int cb_verify (const enum cb_support, const char *); -extern unsigned int cb_verify_x (cb_tree, const enum cb_support, - const char *); -extern void listprint_suppress (void); -extern void listprint_restore (void); - -extern void redefinition_error (cb_tree); -extern void redefinition_warning (cb_tree, cb_tree); -extern void undefined_error (cb_tree); -extern void ambiguous_error (cb_tree); -extern void group_error (cb_tree, const char *); -extern void level_require_error (cb_tree, const char *); -extern void level_except_error (cb_tree, const char *); -extern int cb_set_ignore_error (int state); - -/* sqlxfdgen.c */ -extern void cb_save_xfd (char *); -extern void cb_parse_xfd (struct cb_file *, struct cb_field *); -extern void output_xfd_file (struct cb_file *); - -/* field.c */ -extern size_t cb_needs_01; -extern int cb_get_level (cb_tree); -extern cb_tree cb_build_field_tree (cb_tree, cb_tree, struct cb_field *, - enum cb_storage, struct cb_file *, - const int); -extern struct cb_field *cb_resolve_redefines (struct cb_field *, cb_tree); -extern struct cb_field *copy_into_field (struct cb_field *, struct cb_field *, const int); -extern void cb_validate_field (struct cb_field *); -extern void cb_validate_88_item (struct cb_field *); -extern struct cb_field *cb_validate_78_item (struct cb_field *, const cob_u32_t); -extern int cb_validate_renames_item (struct cb_field *, cb_tree, cb_tree); -extern struct cb_field *cb_get_real_field (void); -extern void cb_clear_real_field (void); -extern int cb_is_figurative_constant (const cb_tree); -extern int cb_field_is_ignored_in_ml_gen (struct cb_field * const); - -/* typeck.c */ -extern cb_tree cb_debug_item; -extern cb_tree cb_debug_line; -extern cb_tree cb_debug_name; -extern cb_tree cb_debug_sub_1; -extern cb_tree cb_debug_sub_2; -extern cb_tree cb_debug_sub_3; -extern cb_tree cb_debug_contents; - -extern struct cb_program *cb_build_program (struct cb_program *, - const int); - -extern cb_tree cb_check_numeric_value (cb_tree); -extern size_t cb_check_index_or_handle_p (cb_tree x); -extern void cb_set_dmax (int scale); - -extern int cb_is_field_unbounded (struct cb_field *); -extern void cb_set_intr_when_compiled (void); -extern void cb_build_registers (void); -extern void cb_add_external_defined_registers (void); -extern const char *cb_register_list_get_first (const char **); -extern const char *cb_register_list_get_next (const char **); -extern void cb_build_debug_item (void); -extern void cb_check_field_debug (cb_tree); -extern void cb_trim_program_id (cb_tree); -extern char *cb_encode_program_id (const char *, const int, const int); -extern char *cb_build_program_id (const char *, const cob_u32_t); -extern cb_tree cb_define_switch_name (cb_tree, cb_tree, const int); - -extern void cb_check_word_length (unsigned int, const char *); -extern cb_tree cb_build_section_name (cb_tree, const int); -extern cb_tree cb_build_assignment_name (struct cb_file *, cb_tree); -extern cb_tree cb_build_index (cb_tree, cb_tree, - const unsigned int, struct cb_field *); -extern cb_tree cb_build_identifier (cb_tree, const int); -extern cb_tree cb_build_length (cb_tree); -extern cb_tree cb_build_const_length (cb_tree); -extern cb_tree cb_build_const_from (cb_tree); -extern cb_tree cb_build_const_start (struct cb_field *, cb_tree); -extern cb_tree cb_build_const_next (struct cb_field *); -extern cb_tree cb_build_address (cb_tree); -extern cb_tree cb_build_ppointer (cb_tree); - -extern void cb_validate_program_environment (struct cb_program *); -extern void cb_validate_program_data (struct cb_program *); -extern void cb_validate_program_body (struct cb_program *); - -extern cb_tree cb_build_expr (cb_tree); -extern cb_tree cb_build_cond (cb_tree); - -extern void cb_end_cond (cb_tree); -extern void cb_save_cond (void); -extern void cb_terminate_cond (void); -extern void cb_true_side (void); -extern void cb_false_side (void); -extern void cb_end_statement (void); -extern const char *explain_operator (const int); -extern const char *enum_explain_storage (const enum cb_storage storage); - -extern void cb_emit_arithmetic (cb_tree, const int, cb_tree); -extern cb_tree cb_build_add (cb_tree, cb_tree, cb_tree); -extern cb_tree cb_build_sub (cb_tree, cb_tree, cb_tree); -extern void cb_emit_corresponding ( - cb_tree (*) (cb_tree, cb_tree, cb_tree), - cb_tree, cb_tree, cb_tree); -extern void cb_emit_tab_arithmetic ( - cb_tree (*) (cb_tree, cb_tree, cb_tree), - cb_tree, cb_tree, cb_tree, cb_tree, cb_tree); -extern void cb_emit_move_corresponding (cb_tree, cb_tree); - -extern void cb_emit_accept (cb_tree, cb_tree, - struct cb_attr_struct *); -extern void cb_emit_accept_line_or_col (cb_tree, const int); -extern void cb_emit_accept_escape_key (cb_tree); -extern void cb_emit_accept_exception_status (cb_tree); -extern void cb_emit_accept_user_name (cb_tree); -extern void cb_emit_accept_date (cb_tree); -extern void cb_emit_accept_date_yyyymmdd (cb_tree); -extern void cb_emit_accept_day (cb_tree); -extern void cb_emit_accept_day_yyyyddd (cb_tree); -extern void cb_emit_accept_day_of_week (cb_tree); -extern void cb_emit_accept_time (cb_tree); -extern void cb_emit_accept_command_line (cb_tree); -extern void cb_emit_accept_environment (cb_tree); -extern void cb_emit_accept_mnemonic (cb_tree, cb_tree); -extern void cb_emit_accept_name (cb_tree, cb_tree); -extern void cb_emit_accept_arg_number (cb_tree); -extern void cb_emit_accept_arg_value (cb_tree); -extern void cb_emit_get_environment (cb_tree, cb_tree); - -extern void cb_emit_allocate (cb_tree, cb_tree, - cb_tree, cb_tree); -extern void cb_emit_alter (cb_tree, cb_tree); -extern void cb_emit_free (cb_tree); - -extern void cb_emit_call (cb_tree, cb_tree, cb_tree, cb_tree, - cb_tree, cb_tree, cb_tree, cb_tree, int); - -extern void cb_emit_cancel (cb_tree); -extern void cb_emit_close (cb_tree, cb_tree); -extern void cb_emit_commit (void); -extern void cb_emit_continue (cb_tree); -extern void cb_emit_delete (cb_tree); -extern void cb_emit_delete_file (cb_tree); - - -extern void cb_emit_display_window (cb_tree, cb_tree, cb_tree, - cb_tree, struct cb_attr_struct *); -extern void cb_emit_close_window (cb_tree, cb_tree); -extern void cb_emit_destroy (cb_tree); - -extern void cb_emit_display (cb_tree, cb_tree, - cb_tree, cb_tree, - struct cb_attr_struct *, - int, enum cb_display_type); -extern cb_tree cb_build_display_mnemonic (cb_tree); -extern cb_tree cb_build_display_name (cb_tree); - -extern void cb_emit_env_name (cb_tree); -extern void cb_emit_env_value (cb_tree); -extern void cb_emit_arg_number (cb_tree); -extern void cb_emit_command_line (cb_tree); - -extern void cb_emit_divide (cb_tree, cb_tree, - cb_tree, cb_tree); - -extern void cb_emit_evaluate (cb_tree, cb_tree); - -extern void cb_emit_goto (cb_tree, cb_tree); -extern void cb_emit_goto_entry (cb_tree, cb_tree); -extern void cb_emit_exit (const unsigned int); - -extern void cb_emit_if (cb_tree, cb_tree, cb_tree); -extern cb_tree cb_build_if_check_break (cb_tree, cb_tree); - -extern void cb_emit_initialize (cb_tree, cb_tree, - cb_tree, cb_tree, - cb_tree); - -extern void cb_emit_inspect (cb_tree, cb_tree, - const enum cb_inspect_clause); -extern void cb_init_tallying (void); -extern cb_tree cb_build_tallying_data (cb_tree); -extern cb_tree cb_build_tallying_characters (cb_tree); -extern cb_tree cb_build_tallying_all (void); -extern cb_tree cb_build_tallying_leading (void); -extern cb_tree cb_build_tallying_trailing (void); -extern cb_tree cb_build_tallying_value (cb_tree, cb_tree); -extern cb_tree cb_build_replacing_characters (cb_tree, cb_tree); -extern cb_tree cb_build_replacing_all (cb_tree, cb_tree, cb_tree); -extern cb_tree cb_build_replacing_leading (cb_tree, cb_tree, cb_tree); -extern cb_tree cb_build_replacing_first (cb_tree, cb_tree, cb_tree); -extern cb_tree cb_build_replacing_trailing (cb_tree, cb_tree, cb_tree); -extern cb_tree cb_build_converting (cb_tree, cb_tree, cb_tree); -extern cb_tree cb_build_inspect_region_start (void); - -extern int validate_move (cb_tree, cb_tree, const unsigned int, int *); -extern cb_tree cb_build_move (cb_tree, cb_tree); -extern void cb_emit_move (cb_tree, cb_tree); - -extern void cb_emit_open (cb_tree, cb_tree, cb_tree); - -extern void cb_emit_perform (cb_tree, cb_tree, cb_tree, cb_tree); -extern cb_tree cb_build_perform_once (cb_tree); -extern cb_tree cb_build_perform_times (cb_tree); -extern cb_tree cb_build_perform_until (cb_tree, cb_tree); -extern cb_tree cb_build_perform_forever (cb_tree); -extern cb_tree cb_build_perform_exit (struct cb_label *); -extern void cb_build_perform_after_until(void); - -extern void cb_emit_read (cb_tree, cb_tree, cb_tree, - cb_tree, cb_tree); - -extern void cb_emit_ready_trace (void); -extern void cb_emit_rewrite (cb_tree, cb_tree, cb_tree); - -extern void cb_emit_release (cb_tree, cb_tree); -extern void cb_emit_reset_trace (void); -extern void cb_emit_return (cb_tree, cb_tree); - -extern void cb_emit_rollback (void); - -extern void cb_emit_search (cb_tree, cb_tree, - cb_tree, cb_tree); -extern void cb_emit_search_all (cb_tree, cb_tree, - cb_tree, cb_tree); - -extern void cb_emit_setenv (cb_tree, cb_tree); -extern void cb_emit_set_to (cb_tree, cb_tree); -extern void cb_emit_set_to_fcd (cb_tree, cb_tree); -extern void cb_emit_set_to_fcdkey (cb_tree, cb_tree); -extern void cb_emit_set_up_down (cb_tree, cb_tree, cb_tree); -extern void cb_emit_set_on_off (cb_tree, cb_tree); -extern void cb_emit_set_true (cb_tree); -extern void cb_emit_set_false (cb_tree); -extern void cb_emit_set_thread_priority (cb_tree, cb_tree); -extern void cb_emit_set_attribute (cb_tree, - const cob_flags_t, - const cob_flags_t); -extern cb_tree cb_build_set_attribute (const struct cb_field *, - const cob_flags_t, - const cob_flags_t); -extern void cb_emit_set_last_exception_to_off (void); - -extern void cb_emit_sort_init (cb_tree, cb_tree, cb_tree, cb_tree); -extern void cb_emit_sort_using (cb_tree, cb_tree); -extern void cb_emit_sort_input (cb_tree); -extern void cb_emit_sort_giving (cb_tree, cb_tree); -extern void cb_emit_sort_output (cb_tree); -extern void cb_emit_sort_finish (cb_tree); - -extern void cb_emit_start (cb_tree, cb_tree, cb_tree, cb_tree); - -extern void cb_emit_stop_run (cb_tree); - -extern void cb_emit_stop_thread (cb_tree); - -extern void cb_emit_string (cb_tree, cb_tree, cb_tree); - -extern void cb_emit_unlock (cb_tree); - -extern void cb_emit_unstring (cb_tree, cb_tree, cb_tree, cb_tree, - cb_tree); -extern cb_tree cb_build_unstring_delimited (cb_tree, cb_tree); -extern cb_tree cb_build_unstring_into (cb_tree, cb_tree, cb_tree); - -extern void cb_emit_write (cb_tree, cb_tree, cb_tree, cb_tree); -extern cb_tree cb_build_write_advancing_lines (cb_tree, cb_tree); -extern cb_tree cb_build_write_advancing_mnemonic (cb_tree, cb_tree); -extern cb_tree cb_build_write_advancing_page (cb_tree); -extern cb_tree cb_check_sum_field (cb_tree x); -extern void cb_emit_initiate (cb_tree rep); -extern void cb_emit_terminate (cb_tree rep); -extern void cb_emit_generate (cb_tree rep); -extern void cb_emit_suppress (struct cb_field *f); -extern void cb_emit_xml_generate (cb_tree, cb_tree, cb_tree, - cb_tree, const int, const int, - cb_tree, cb_tree, cb_tree, - cb_tree); -extern void cb_emit_json_generate (cb_tree, cb_tree, cb_tree, - cb_tree, cb_tree); - -#ifdef COB_TREE_DEBUG -extern cb_tree cobc_tree_cast_check (const cb_tree, const char *, - const int, const enum cb_tag); -#endif - - -/* codegen.c */ -extern void codegen (struct cb_program *, const char *, const int); -extern struct cb_field *chk_field_variable_size (struct cb_field *f); -extern unsigned int chk_field_variable_address (struct cb_field *fld); - -/* scanner.l */ -extern void cb_unput_dot (void); -extern void cb_add_78 (struct cb_field *); -extern void cb_reset_78 (void); -extern void cb_reset_global_78 (void); -extern struct cb_field *check_level_78 (const char *); - -extern struct cb_program *cb_find_defined_program_by_name (const char *); -extern struct cb_program *cb_find_defined_program_by_id (const char *); - -/* cobc.c */ -extern void cobc_xref_link (struct cb_xref *, const int, const int); -extern void cobc_xref_link_parent (const struct cb_field *); -extern void cobc_xref_set_receiving (const cb_tree); -extern void cobc_xref_call (const char *, const int, const int, const int); -extern unsigned int cb_correct_program_order; - -/* Function defines */ - -#define CB_BUILD_FUNCALL_0(f) \ - cb_build_funcall (f, 0, NULL, NULL, NULL, NULL, NULL, \ - NULL, NULL, NULL, NULL, NULL, NULL) - -#define CB_BUILD_FUNCALL_1(f,a1) \ - cb_build_funcall (f, 1, a1, NULL, NULL, NULL, NULL, \ - NULL, NULL, NULL, NULL, NULL, NULL) - -#define CB_BUILD_FUNCALL_2(f,a1,a2) \ - cb_build_funcall (f, 2, a1, a2, NULL, NULL, NULL, \ - NULL, NULL, NULL, NULL, NULL, NULL) - -#define CB_BUILD_FUNCALL_3(f,a1,a2,a3) \ - cb_build_funcall (f, 3, a1, a2, a3, NULL, NULL, NULL, \ - NULL, NULL, NULL, NULL, NULL) - -#define CB_BUILD_FUNCALL_4(f,a1,a2,a3,a4) \ - cb_build_funcall (f, 4, a1, a2, a3, a4, NULL, \ - NULL, NULL, NULL, NULL, NULL, NULL) - -#define CB_BUILD_FUNCALL_5(f,a1,a2,a3,a4,a5) \ - cb_build_funcall (f, 5, a1, a2, a3, a4, a5, \ - NULL, NULL, NULL, NULL, NULL, NULL) - -#define CB_BUILD_FUNCALL_6(f,a1,a2,a3,a4,a5,a6) \ - cb_build_funcall (f, 6, a1, a2, a3, a4, a5, a6, \ - NULL, NULL, NULL, NULL, NULL) - -#define CB_BUILD_FUNCALL_7(f,a1,a2,a3,a4,a5,a6,a7) \ - cb_build_funcall (f, 7, a1, a2, a3, a4, a5, a6, a7, \ - NULL, NULL, NULL, NULL) - -#define CB_BUILD_FUNCALL_8(f,a1,a2,a3,a4,a5,a6,a7,a8) \ - cb_build_funcall (f, 8, a1, a2, a3, a4, a5, a6, a7, a8, \ - NULL, NULL, NULL) - -#define CB_BUILD_FUNCALL_9(f,a1,a2,a3,a4,a5,a6,a7,a8,a9) \ - cb_build_funcall (f, 9, a1, a2, a3, a4, a5, a6, a7, a8, \ - a9, NULL, NULL) - -#define CB_BUILD_FUNCALL_10(f,a1,a2,a3,a4,a5,a6,a7,a8,a9,a10) \ - cb_build_funcall (f, 10, a1, a2, a3, a4, a5, a6, a7, a8, \ - a9, a10, NULL) - -#define CB_BUILD_FUNCALL_11(f,a1,a2,a3,a4,a5,a6,a7,a8,a9,a10,a11) \ - cb_build_funcall (f, 11, a1, a2, a3, a4, a5, a6, a7, a8, \ - a9, a10, a11) - -/* Miscellaneous defines */ - -#define CB_BUILD_CAST_ADDRESS(x) cb_build_cast (CB_CAST_ADDRESS, x) -#define CB_BUILD_CAST_ADDR_OF_ADDR(x) cb_build_cast (CB_CAST_ADDR_OF_ADDR, x) -#define CB_BUILD_CAST_LENGTH(x) cb_build_cast (CB_CAST_LENGTH, x) -#define CB_BUILD_CAST_PPOINTER(x) cb_build_cast (CB_CAST_PROGRAM_POINTER, x) - -#define CB_BUILD_PARENTHESES(x) cb_build_binary_op (x, '@', NULL) -#define CB_BUILD_NEGATION(x) cb_build_binary_op (x, '!', NULL) - -#define CB_BUILD_STRING0(str) cb_build_string (str, strlen ((char *)(str))) - -#define CB_LIST_INIT(x) cb_build_list (NULL, x, NULL) -#define CB_BUILD_CHAIN(x,y) cb_build_list (NULL, x, y) -#define CB_BUILD_PAIR(x,y) cb_build_list (x, y, NULL) -#define CB_ADD_TO_CHAIN(x,y) y = CB_BUILD_CHAIN (x, y) -#define CB_CHAIN_PAIR(x,y,z) x = cb_pair_add (x, y, z) -#define CB_FIELD_ADD(x,y) x = cb_field_add (x, y) - - -#endif /* CB_TREE_H */ diff -Nru gnucobol-4.0~early~20200606/cobc/typeck.c gnucobol-5/cobc/typeck.c --- gnucobol-4.0~early~20200606/cobc/typeck.c 2020-06-06 20:51:59.000000000 +0000 +++ gnucobol-5/cobc/typeck.c 1970-01-01 00:00:00.000000000 +0000 @@ -1,13002 +0,0 @@ -/* - Copyright (C) 2001-2020 Free Software Foundation, Inc. - Written by Keisuke Nishida, Roger While, Simon Sobisch, Ron Norman, - Edward Hart - - This file is part of GnuCOBOL. - - The GnuCOBOL compiler is free software: you can redistribute it - and/or modify it under the terms of the GNU General Public License - as published by the Free Software Foundation, either version 3 of the - License, or (at your option) any later version. - - GnuCOBOL is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with GnuCOBOL. If not, see . -*/ - - -#include - -#include -#include -#include -#include -#include -#include -#include -#ifdef HAVE_SYS_TIME_H -#include -#endif -#ifdef _WIN32 -#define WIN32_LEAN_AND_MEAN -#include -#endif - -#ifdef HAVE_LOCALE_H -#include -#endif - -#include "cobc.h" -#include "tree.h" - -struct system_table { - const char *const syst_name; - const unsigned int syst_params_min; - const unsigned int syst_params_max; -}; - -struct optim_table { - const char *const optim_name; - const enum cb_optim optim_val; -}; - -struct expr_node { - /* The token of this node. - * 'x' - values (cb_tree) - * '+', '-', '*', '/', '^' - arithmetic operators - * '=', '~', '<', '>', '[', ']' - relational operators - * '!', '&', '|' - logical operators - * '(', ')' - parentheses - */ - int token; - /* The value itself if this node is a value */ - cb_tree value; -}; - -#define START_STACK_SIZE 32 -#define TOKEN(offset) (expr_stack[expr_index + offset].token) -#define VALUE(offset) (expr_stack[expr_index + offset].value) -#define FMT_LEN cb_pretty_display ? "%d" : "%010d" - -#define dpush(x) CB_ADD_TO_CHAIN (x, decimal_stack) - -#define cb_emit(x) \ - current_statement->body = cb_list_add (current_statement->body, x) -#define cb_emit_list(l) \ - current_statement->body = cb_list_append (current_statement->body, l) - -/* Global variables */ - -cb_tree cb_debug_item; -cb_tree cb_debug_line; -cb_tree cb_debug_name; -cb_tree cb_debug_sub_1; -cb_tree cb_debug_sub_2; -cb_tree cb_debug_sub_3; -cb_tree cb_debug_contents; - -size_t suppress_warn = 0; - -/* Local variables */ - -static cb_tree decimal_stack = NULL; - -static const char *inspect_func; -static cb_tree inspect_data; -struct cb_statement *error_statement = NULL; - -#ifndef WITH_XML2 -static int warn_xml_done = 0; -#endif -#ifndef WITH_CJSON -static int warn_json_done = 0; -#endif -#ifndef WITH_EXTENDED_SCREENIO -static int warn_screen_done = 0; -#endif -static int expr_op; /* Last operator */ -static cb_tree expr_lh; /* Last left hand */ -static int expr_dmax = -1; /* Max scale for expression result */ -#define MAX_NESTED_EXPR 64 -static cb_tree expr_x = NULL; -static int expr_dec_align = -1; -static int expr_nest = 0; -static int expr_decp[MAX_NESTED_EXPR]; -static int cond_fixed = -1; /* 0 means TRUE, 1 means FALSE, -1 unknown */ -#define MAX_NESTED_COND 128 -static int if_nest = 0; -static int if_cond[MAX_NESTED_COND]; -static int if_stop = 0; -static int expr_line = 0; /* Line holding expression for warnings */ -static cb_tree expr_rslt = NULL; /* Expression result */ - -static size_t initialized = 0; -static size_t overlapping = 0; - -static int expr_index; /* Stack index */ -static int expr_stack_size; /* Stack max size */ -static struct expr_node *expr_stack; /* Expression node stack */ -static int report_id = 1; - -#ifdef HAVE_DESIGNATED_INITS -static const unsigned char expr_prio[256] = { - ['x'] = 0, - ['^'] = 1, - ['*'] = 2, - ['/'] = 2, - ['+'] = 3, - ['-'] = 3, - ['='] = 4, - ['~'] = 4, - ['<'] = 4, - ['>'] = 4, - ['['] = 4, - [']'] = 4, - ['!'] = 5, - ['&'] = 6, - ['|'] = 7, - [')'] = 8, - ['('] = 9, - [0] = 10 -}; -#else -static unsigned char expr_prio[256]; -#endif - -#ifdef COB_EBCDIC_MACHINE -/* EBCDIC referring to ASCII */ -static const unsigned char cob_refer_ascii[256] = { - 0x00, 0x01, 0x02, 0x03, 0x37, 0x2D, 0x2E, 0x2F, - 0x16, 0x05, 0x25, 0x0B, 0x0C, 0x0D, 0x0E, 0x0F, - 0x10, 0x11, 0x12, 0x13, 0x3C, 0x3D, 0x32, 0x26, - 0x18, 0x19, 0x3F, 0x27, 0x1C, 0x1D, 0x1E, 0x1F, - 0x40, 0x5A, 0x7F, 0x7B, 0x5B, 0x6C, 0x50, 0x7D, - 0x4D, 0x5D, 0x5C, 0x4E, 0x6B, 0x60, 0x4B, 0x61, - 0xF0, 0xF1, 0xF2, 0xF3, 0xF4, 0xF5, 0xF6, 0xF7, - 0xF8, 0xF9, 0x7A, 0x5E, 0x4C, 0x7E, 0x6E, 0x6F, - 0x7C, 0xC1, 0xC2, 0xC3, 0xC4, 0xC5, 0xC6, 0xC7, - 0xC8, 0xC9, 0xD1, 0xD2, 0xD3, 0xD4, 0xD5, 0xD6, - 0xD7, 0xD8, 0xD9, 0xE2, 0xE3, 0xE4, 0xE5, 0xE6, - 0xE7, 0xE8, 0xE9, 0xAD, 0xE0, 0xBD, 0x5F, 0x6D, - 0x79, 0x81, 0x82, 0x83, 0x84, 0x85, 0x86, 0x87, - 0x88, 0x89, 0x91, 0x92, 0x93, 0x94, 0x95, 0x96, - 0x97, 0x98, 0x99, 0xA2, 0xA3, 0xA4, 0xA5, 0xA6, - 0xA7, 0xA8, 0xA9, 0xC0, 0x6A, 0xD0, 0xA1, 0x07, - 0x68, 0xDC, 0x51, 0x42, 0x43, 0x44, 0x47, 0x48, - 0x52, 0x53, 0x54, 0x57, 0x56, 0x58, 0x63, 0x67, - 0x71, 0x9C, 0x9E, 0xCB, 0xCC, 0xCD, 0xDB, 0xDD, - 0xDF, 0xEC, 0xFC, 0xB0, 0xB1, 0xB2, 0x3E, 0xB4, - 0x45, 0x55, 0xCE, 0xDE, 0x49, 0x69, 0x9A, 0x9B, - 0xAB, 0x9F, 0xBA, 0xB8, 0xB7, 0xAA, 0x8A, 0x8B, - 0xB6, 0xB5, 0x62, 0x4F, 0x64, 0x65, 0x66, 0x20, - 0x21, 0x22, 0x70, 0x23, 0x72, 0x73, 0x74, 0xBE, - 0x76, 0x77, 0x78, 0x80, 0x24, 0x15, 0x8C, 0x8D, - 0x8E, 0x41, 0x06, 0x17, 0x28, 0x29, 0x9D, 0x2A, - 0x2B, 0x2C, 0x09, 0x0A, 0xAC, 0x4A, 0xAE, 0xAF, - 0x1B, 0x30, 0x31, 0xFA, 0x1A, 0x33, 0x34, 0x35, - 0x36, 0x59, 0x08, 0x38, 0xBC, 0x39, 0xA0, 0xBF, - 0xCA, 0x3A, 0xFE, 0x3B, 0x04, 0xCF, 0xDA, 0x14, - 0xE1, 0x8F, 0x46, 0x75, 0xFD, 0xEB, 0xEE, 0xED, - 0x90, 0xEF, 0xB3, 0xFB, 0xB9, 0xEA, 0xBB, 0xFF -}; -#else -/* ASCII referring to EBCDIC */ -static const unsigned char cob_refer_ebcdic[256] = { - 0x00, 0x01, 0x02, 0x03, 0xEC, 0x09, 0xCA, 0x7F, - 0xE2, 0xD2, 0xD3, 0x0B, 0x0C, 0x0D, 0x0E, 0x0F, - 0x10, 0x11, 0x12, 0x13, 0xEF, 0xC5, 0x08, 0xCB, - 0x18, 0x19, 0xDC, 0xD8, 0x1C, 0x1D, 0x1E, 0x1F, - 0xB7, 0xB8, 0xB9, 0xBB, 0xC4, 0x0A, 0x17, 0x1B, - 0xCC, 0xCD, 0xCF, 0xD0, 0xD1, 0x05, 0x06, 0x07, - 0xD9, 0xDA, 0x16, 0xDD, 0xDE, 0xDF, 0xE0, 0x04, - 0xE3, 0xE5, 0xE9, 0xEB, 0x14, 0x15, 0x9E, 0x1A, - 0x20, 0xC9, 0x83, 0x84, 0x85, 0xA0, 0xF2, 0x86, - 0x87, 0xA4, 0xD5, 0x2E, 0x3C, 0x28, 0x2B, 0xB3, - 0x26, 0x82, 0x88, 0x89, 0x8A, 0xA1, 0x8C, 0x8B, - 0x8D, 0xE1, 0x21, 0x24, 0x2A, 0x29, 0x3B, 0x5E, - 0x2D, 0x2F, 0xB2, 0x8E, 0xB4, 0xB5, 0xB6, 0x8F, - 0x80, 0xA5, 0x7C, 0x2C, 0x25, 0x5F, 0x3E, 0x3F, - 0xBA, 0x90, 0xBC, 0xBD, 0xBE, 0xF3, 0xC0, 0xC1, - 0xC2, 0x60, 0x3A, 0x23, 0x40, 0x27, 0x3D, 0x22, - 0xC3, 0x61, 0x62, 0x63, 0x64, 0x65, 0x66, 0x67, - 0x68, 0x69, 0xAE, 0xAF, 0xC6, 0xC7, 0xC8, 0xF1, - 0xF8, 0x6A, 0x6B, 0x6C, 0x6D, 0x6E, 0x6F, 0x70, - 0x71, 0x72, 0xA6, 0xA7, 0x91, 0xCE, 0x92, 0xA9, - 0xE6, 0x7E, 0x73, 0x74, 0x75, 0x76, 0x77, 0x78, - 0x79, 0x7A, 0xAD, 0xA8, 0xD4, 0x5B, 0xD6, 0xD7, - 0x9B, 0x9C, 0x9D, 0xFA, 0x9F, 0xB1, 0xB0, 0xAC, - 0xAB, 0xFC, 0xAA, 0xFE, 0xE4, 0x5D, 0xBF, 0xE7, - 0x7B, 0x41, 0x42, 0x43, 0x44, 0x45, 0x46, 0x47, - 0x48, 0x49, 0xE8, 0x93, 0x94, 0x95, 0xA2, 0xED, - 0x7D, 0x4A, 0x4B, 0x4C, 0x4D, 0x4E, 0x4F, 0x50, - 0x51, 0x52, 0xEE, 0x96, 0x81, 0x97, 0xA3, 0x98, - 0x5C, 0xF0, 0x53, 0x54, 0x55, 0x56, 0x57, 0x58, - 0x59, 0x5A, 0xFD, 0xF5, 0x99, 0xF7, 0xF6, 0xF9, - 0x30, 0x31, 0x32, 0x33, 0x34, 0x35, 0x36, 0x37, - 0x38, 0x39, 0xDB, 0xFB, 0x9A, 0xF4, 0xEA, 0xFF -}; -#endif - -/* System routines */ - -#undef COB_SYSTEM_GEN -#define COB_SYSTEM_GEN(cob_name, pmin, pmax, c_name) { cob_name, pmin, pmax }, - -static const struct system_table system_tab[] = { -#include "libcob/system.def" - { NULL, 0, 0 } -}; - -#undef COB_SYSTEM_GEN - -static const struct optim_table bin_set_funcs[] = { - { NULL, COB_OPTIM_MIN }, - { "cob_setswp_u16", COB_SETSWP_U16 }, - { "cob_setswp_u24", COB_SETSWP_U24 }, - { "cob_setswp_u32", COB_SETSWP_U32 }, - { "cob_setswp_u40", COB_SETSWP_U40 }, - { "cob_setswp_u48", COB_SETSWP_U48 }, - { "cob_setswp_u56", COB_SETSWP_U56 }, - { "cob_setswp_u64", COB_SETSWP_U64 }, - { NULL, COB_OPTIM_MIN }, - { "cob_setswp_s16", COB_SETSWP_S16 }, - { "cob_setswp_s24", COB_SETSWP_S24 }, - { "cob_setswp_s32", COB_SETSWP_S32 }, - { "cob_setswp_s40", COB_SETSWP_S40 }, - { "cob_setswp_s48", COB_SETSWP_S48 }, - { "cob_setswp_s56", COB_SETSWP_S56 }, - { "cob_setswp_s64", COB_SETSWP_S64 } -}; - -static const struct optim_table bin_compare_funcs[] = { - { "cob_cmp_u8", COB_CMP_U8 }, - { "cob_cmp_u16", COB_CMP_U16 }, - { "cob_cmp_u24", COB_CMP_U24 }, - { "cob_cmp_u32", COB_CMP_U32 }, - { "cob_cmp_u40", COB_CMP_U40 }, - { "cob_cmp_u48", COB_CMP_U48 }, - { "cob_cmp_u56", COB_CMP_U56 }, - { "cob_cmp_u64", COB_CMP_U64 }, - { "cob_cmp_s8", COB_CMP_S8 }, - { "cob_cmp_s16", COB_CMP_S16 }, - { "cob_cmp_s24", COB_CMP_S24 }, - { "cob_cmp_s32", COB_CMP_S32 }, - { "cob_cmp_s40", COB_CMP_S40 }, - { "cob_cmp_s48", COB_CMP_S48 }, - { "cob_cmp_s56", COB_CMP_S56 }, - { "cob_cmp_s64", COB_CMP_S64 }, - { "cob_cmp_u8", COB_CMP_U8 }, - { "cob_cmpswp_u16", COB_CMPSWP_U16 }, - { "cob_cmpswp_u24", COB_CMPSWP_U24 }, - { "cob_cmpswp_u32", COB_CMPSWP_U32 }, - { "cob_cmpswp_u40", COB_CMPSWP_U40 }, - { "cob_cmpswp_u48", COB_CMPSWP_U48 }, - { "cob_cmpswp_u56", COB_CMPSWP_U56 }, - { "cob_cmpswp_u64", COB_CMPSWP_U64 }, - { "cob_cmp_s8", COB_CMP_S8 }, - { "cob_cmpswp_s16", COB_CMPSWP_S16 }, - { "cob_cmpswp_s24", COB_CMPSWP_S24 }, - { "cob_cmpswp_s32", COB_CMPSWP_S32 }, - { "cob_cmpswp_s40", COB_CMPSWP_S40 }, - { "cob_cmpswp_s48", COB_CMPSWP_S48 }, - { "cob_cmpswp_s56", COB_CMPSWP_S56 }, - { "cob_cmpswp_s64", COB_CMPSWP_S64 } -}; - -static const struct optim_table bin_add_funcs[] = { - { "cob_add_u8", COB_ADD_U8 }, - { "cob_add_u16", COB_ADD_U16 }, - { "cob_add_u24", COB_ADD_U24 }, - { "cob_add_u32", COB_ADD_U32 }, - { "cob_add_u40", COB_ADD_U40 }, - { "cob_add_u48", COB_ADD_U48 }, - { "cob_add_u56", COB_ADD_U56 }, - { "cob_add_u64", COB_ADD_U64 }, - { "cob_add_s8", COB_ADD_S8 }, - { "cob_add_s16", COB_ADD_S16 }, - { "cob_add_s24", COB_ADD_S24 }, - { "cob_add_s32", COB_ADD_S32 }, - { "cob_add_s40", COB_ADD_S40 }, - { "cob_add_s48", COB_ADD_S48 }, - { "cob_add_s56", COB_ADD_S56 }, - { "cob_add_s64", COB_ADD_S64 }, - { "cob_add_u8", COB_ADD_U8 }, - { "cob_addswp_u16", COB_ADDSWP_U16 }, - { "cob_addswp_u24", COB_ADDSWP_U24 }, - { "cob_addswp_u32", COB_ADDSWP_U32 }, - { "cob_addswp_u40", COB_ADDSWP_U40 }, - { "cob_addswp_u48", COB_ADDSWP_U48 }, - { "cob_addswp_u56", COB_ADDSWP_U56 }, - { "cob_addswp_u64", COB_ADDSWP_U64 }, - { "cob_add_s8", COB_ADD_S8 }, - { "cob_addswp_s16", COB_ADDSWP_S16 }, - { "cob_addswp_s24", COB_ADDSWP_S24 }, - { "cob_addswp_s32", COB_ADDSWP_S32 }, - { "cob_addswp_s40", COB_ADDSWP_S40 }, - { "cob_addswp_s48", COB_ADDSWP_S48 }, - { "cob_addswp_s56", COB_ADDSWP_S56 }, - { "cob_addswp_s64", COB_ADDSWP_S64 } -}; - -static const struct optim_table bin_sub_funcs[] = { - { "cob_sub_u8", COB_SUB_U8 }, - { "cob_sub_u16", COB_SUB_U16 }, - { "cob_sub_u24", COB_SUB_U24 }, - { "cob_sub_u32", COB_SUB_U32 }, - { "cob_sub_u40", COB_SUB_U40 }, - { "cob_sub_u48", COB_SUB_U48 }, - { "cob_sub_u56", COB_SUB_U56 }, - { "cob_sub_u64", COB_SUB_U64 }, - { "cob_sub_s8", COB_SUB_S8 }, - { "cob_sub_s16", COB_SUB_S16 }, - { "cob_sub_s24", COB_SUB_S24 }, - { "cob_sub_s32", COB_SUB_S32 }, - { "cob_sub_s40", COB_SUB_S40 }, - { "cob_sub_s48", COB_SUB_S48 }, - { "cob_sub_s56", COB_SUB_S56 }, - { "cob_sub_s64", COB_SUB_S64 }, - { "cob_sub_u8", COB_SUB_U8 }, - { "cob_subswp_u16", COB_SUBSWP_U16 }, - { "cob_subswp_u24", COB_SUBSWP_U24 }, - { "cob_subswp_u32", COB_SUBSWP_U32 }, - { "cob_subswp_u40", COB_SUBSWP_U40 }, - { "cob_subswp_u48", COB_SUBSWP_U48 }, - { "cob_subswp_u56", COB_SUBSWP_U56 }, - { "cob_subswp_u64", COB_SUBSWP_U64 }, - { "cob_sub_s8", COB_SUB_S8 }, - { "cob_subswp_s16", COB_SUBSWP_S16 }, - { "cob_subswp_s24", COB_SUBSWP_S24 }, - { "cob_subswp_s32", COB_SUBSWP_S32 }, - { "cob_subswp_s40", COB_SUBSWP_S40 }, - { "cob_subswp_s48", COB_SUBSWP_S48 }, - { "cob_subswp_s56", COB_SUBSWP_S56 }, - { "cob_subswp_s64", COB_SUBSWP_S64 } -}; - -#if defined(COB_NON_ALIGNED) && !defined(_MSC_VER) && defined(COB_ALLOW_UNALIGNED) -static const struct optim_table align_bin_compare_funcs[] = { - { "cob_cmp_u8", COB_CMP_U8 }, - { "cob_cmp_align_u16", COB_CMP_ALIGN_U16 }, - { "cob_cmp_u24", COB_CMP_U24 }, - { "cob_cmp_align_u32", COB_CMP_ALIGN_U32 }, - { "cob_cmp_u40", COB_CMP_U40 }, - { "cob_cmp_u48", COB_CMP_U48 }, - { "cob_cmp_u56", COB_CMP_U56 }, - { "cob_cmp_align_u64", COB_CMP_ALIGN_U64 }, - { "cob_cmp_s8", COB_CMP_S8 }, - { "cob_cmp_align_s16", COB_CMP_ALIGN_S16 }, - { "cob_cmp_s24", COB_CMP_S24 }, - { "cob_cmp_align_s32", COB_CMP_ALIGN_S32 }, - { "cob_cmp_s40", COB_CMP_S40 }, - { "cob_cmp_s48", COB_CMP_S48 }, - { "cob_cmp_s56", COB_CMP_S56 }, - { "cob_cmp_align_s64", COB_CMP_ALIGN_S64 }, - { "cob_cmp_u8", COB_CMP_U8 }, - { "cob_cmpswp_align_u16", COB_CMPSWP_ALIGN_U16 }, - { "cob_cmpswp_u24", COB_CMPSWP_U24 }, - { "cob_cmpswp_align_u32", COB_CMPSWP_ALIGN_U32 }, - { "cob_cmpswp_u40", COB_CMPSWP_U40 }, - { "cob_cmpswp_u48", COB_CMPSWP_U48 }, - { "cob_cmpswp_u56", COB_CMPSWP_U56 }, - { "cob_cmpswp_align_u64", COB_CMPSWP_ALIGN_U64 }, - { "cob_cmp_s8", COB_CMP_S8 }, - { "cob_cmpswp_align_s16", COB_CMPSWP_ALIGN_S16 }, - { "cob_cmpswp_s24", COB_CMPSWP_S24 }, - { "cob_cmpswp_align_s32", COB_CMPSWP_ALIGN_S32 }, - { "cob_cmpswp_s40", COB_CMPSWP_S40 }, - { "cob_cmpswp_s48", COB_CMPSWP_S48 }, - { "cob_cmpswp_s56", COB_CMPSWP_S56 }, - { "cob_cmpswp_align_s64", COB_CMPSWP_ALIGN_S64 }, -}; - -static const struct optim_table align_bin_add_funcs[] = { - { "cob_add_u8", COB_ADD_U8 }, - { "cob_add_align_u16", COB_ADD_ALIGN_U16 }, - { "cob_add_u24", COB_ADD_U24 }, - { "cob_add_align_u32", COB_ADD_ALIGN_U32 }, - { "cob_add_u40", COB_ADD_U40 }, - { "cob_add_u48", COB_ADD_U48 }, - { "cob_add_u56", COB_ADD_U56 }, - { "cob_add_align_u64", COB_ADD_ALIGN_U64 }, - { "cob_add_s8", COB_ADD_S8 }, - { "cob_add_align_s16", COB_ADD_ALIGN_S16 }, - { "cob_add_s24", COB_ADD_S24 }, - { "cob_add_align_s32", COB_ADD_ALIGN_S32 }, - { "cob_add_s40", COB_ADD_S40 }, - { "cob_add_s48", COB_ADD_S48 }, - { "cob_add_s56", COB_ADD_S56 }, - { "cob_add_align_s64", COB_ADD_ALIGN_S64 }, - { "cob_add_u8", COB_ADD_U8 }, - { "cob_addswp_u16", COB_ADDSWP_U16 }, - { "cob_addswp_u24", COB_ADDSWP_U24 }, - { "cob_addswp_u32", COB_ADDSWP_U32 }, - { "cob_addswp_u40", COB_ADDSWP_U40 }, - { "cob_addswp_u48", COB_ADDSWP_U48 }, - { "cob_addswp_u56", COB_ADDSWP_U56 }, - { "cob_addswp_u64", COB_ADDSWP_U64 }, - { "cob_add_s8", COB_ADD_S8 }, - { "cob_addswp_s16", COB_ADDSWP_S16 }, - { "cob_addswp_s24", COB_ADDSWP_S24 }, - { "cob_addswp_s32", COB_ADDSWP_S32 }, - { "cob_addswp_s40", COB_ADDSWP_S40 }, - { "cob_addswp_s48", COB_ADDSWP_S48 }, - { "cob_addswp_s56", COB_ADDSWP_S56 }, - { "cob_addswp_s64", COB_ADDSWP_S64 }, -}; - -static const struct optim_table align_bin_sub_funcs[] = { - { "cob_sub_u8", COB_SUB_U8 }, - { "cob_sub_align_u16", COB_SUB_ALIGN_U16 }, - { "cob_sub_u24", COB_SUB_U24 }, - { "cob_sub_align_u32", COB_SUB_ALIGN_U32 }, - { "cob_sub_u40", COB_SUB_U40 }, - { "cob_sub_u48", COB_SUB_U48 }, - { "cob_sub_u56", COB_SUB_U56 }, - { "cob_sub_align_u64", COB_SUB_ALIGN_U64 }, - { "cob_sub_s8", COB_SUB_S8 }, - { "cob_sub_align_s16", COB_SUB_ALIGN_S16 }, - { "cob_sub_s24", COB_SUB_S24 }, - { "cob_sub_align_s32", COB_SUB_ALIGN_S32 }, - { "cob_sub_s40", COB_SUB_S40 }, - { "cob_sub_s48", COB_SUB_S48 }, - { "cob_sub_s56", COB_SUB_S56 }, - { "cob_sub_align_s64", COB_SUB_ALIGN_S64 }, - { "cob_sub_u8", COB_SUB_U8 }, - { "cob_subswp_u16", COB_SUBSWP_U16 }, - { "cob_subswp_u24", COB_SUBSWP_U24 }, - { "cob_subswp_u32", COB_SUBSWP_U32 }, - { "cob_subswp_u40", COB_SUBSWP_U40 }, - { "cob_subswp_u48", COB_SUBSWP_U48 }, - { "cob_subswp_u56", COB_SUBSWP_U56 }, - { "cob_subswp_u64", COB_SUBSWP_U64 }, - { "cob_sub_s8", COB_SUB_S8 }, - { "cob_subswp_s16", COB_SUBSWP_S16 }, - { "cob_subswp_s24", COB_SUBSWP_S24 }, - { "cob_subswp_s32", COB_SUBSWP_S32 }, - { "cob_subswp_s40", COB_SUBSWP_S40 }, - { "cob_subswp_s48", COB_SUBSWP_S48 }, - { "cob_subswp_s56", COB_SUBSWP_S56 }, - { "cob_subswp_s64", COB_SUBSWP_S64 }, -}; -#endif - -/* Functions */ -static void cb_walk_cond (cb_tree x); -static cb_tree cb_build_length_1 (cb_tree x); - -/* - * Is the field 'native' binary (short/int/long) - * and aligned on memory address suitable for direct use - */ -static int -cb_is_integer_field (struct cb_field *f) -{ - if (!cb_flag_fast_math) - return 0; - if (f->flag_sign_clause - || f->flag_blank_zero - || f->flag_any_numeric - || f->indexes != 0 - || !f->pic - || f->pic->scale != 0) - return 0; - if (f->usage == CB_USAGE_DISPLAY - && f->size < 16) - return 1; - if (f->usage == CB_USAGE_COMP_X - && f->size == 1) - return 1; - if (f->usage == CB_USAGE_BINARY - && cb_binary_truncate) - return 0; -#ifdef WORDS_BIGENDIAN - if (f->usage != CB_USAGE_COMP_5 - && f->usage != CB_USAGE_DISPLAY - && f->usage != CB_USAGE_BINARY - && f->usage != CB_USAGE_COMP_X) - return 0; -#else - if (f->usage != CB_USAGE_COMP_5 - && f->usage != CB_USAGE_BINARY - && f->usage != CB_USAGE_DISPLAY) - return 0; -#endif - if (f->storage == CB_STORAGE_WORKING -#ifdef COB_SHORT_BORK - && (f->size == 4 || f->size == 8 || f->size == 1) -#else - && (f->size == 2 || f->size == 4 || f->size == 8 || f->size == 1) -#endif -#if !defined(COB_ALLOW_UNALIGNED) - && (f->offset % f->size) == 0 -#endif - ) { - return 1; - } - return 0; -} - -/* - * Is this an 'integer' value or expression - */ -static int -cb_is_integer_expr (cb_tree x) -{ - struct cb_binary_op *p; - cb_tree y; - if (!cb_flag_fast_math) - return 0; - if (current_statement - && (current_statement->ex_handler - || current_statement->not_ex_handler - || current_statement->handler_type != NO_HANDLER)) - return 0; - if (CB_REFERENCE_P (x)) { - y = cb_ref (x); - if (y == cb_error_node) { - return 0; - } - if (CB_FIELD_P (y)) - return cb_is_integer_field (CB_FIELD_PTR (y)); - return 0; - } - if (CB_FIELD_P (x)) { - return cb_is_integer_field (CB_FIELD_PTR (x)); - } - if (CB_NUMERIC_LITERAL_P (x)) { - if (CB_LITERAL (x)->scale == 0 - && cb_fits_int (x)) - return 1; - return 0; - } - if (CB_BINARY_OP_P (x)) { - p = CB_BINARY_OP (x); - if (p->op == '+' - || p->op == '-' - || p->op == '*') { - if (cb_is_integer_expr (p->x) - && cb_is_integer_expr (p->y)) - return 1; - } - if (p->op == '=' - || p->op == '>' - || p->op == '<' - || p->op == ']' - || p->op == '[' - || p->op == '~' - || p->op == '(' - || p->op == ')' - || p->op == '@') { - if (CB_NUMERIC_LITERAL_P (p->x) - && (CB_NUMERIC_LITERAL_P (p->y) || CB_BINARY_OP_P (p->y))) - return 0; - if (CB_NUMERIC_LITERAL_P (p->y) - && (CB_NUMERIC_LITERAL_P (p->x) || CB_BINARY_OP_P (p->x))) - return 0; - if (p->x - && !cb_is_integer_expr (p->x)) - return 0; - if (p->y - && !cb_is_integer_expr (p->y)) - return 0; - return 1; - } - } - return 0; -} - -/* - * Is field an aligned binary and 'n' is either integer - * or another aligned binary field - */ -static int -cb_is_integer_field_and_int (struct cb_field *f, cb_tree n) -{ - if (!cb_is_integer_field (f)) - return 0; - if (CB_NUMERIC_LITERAL_P (n)) { - if (CB_LITERAL (n)->scale == 0 - && CB_LITERAL (n)->sign - && cb_fits_int (n) - && f->pic->have_sign == 0) - return 0; - return 1; - } - return cb_is_integer_expr (n); -} - -static cb_tree -cb_check_needs_break (cb_tree stmt) -{ - cb_tree l; - - /* Check if last statement is GO TO */ - for (l = stmt; l; l = CB_CHAIN (l)) { - if (!CB_CHAIN(l)) { - break; - } - } - if (l && CB_VALUE (l) && CB_STATEMENT_P (CB_VALUE (l))) { - l = CB_STATEMENT(CB_VALUE(l))->body; - if (l && CB_VALUE (l) && !CB_GOTO_P (CB_VALUE(l))) { - /* Append a break */ - l = cb_build_direct ("break;", 0); - return cb_list_add (stmt, l); - } - } - return stmt; -} - -static size_t -cb_validate_one (cb_tree x) -{ - cb_tree y; - struct cb_field *f; - - if (x == cb_error_node) { - return 1; - } - if (!x) { - return 0; - } - if (CB_REFERENCE_P (x)) { - y = cb_ref (x); - if (y == cb_error_node) { - return 1; - } - if (CB_FIELD_P (y)) { - f = CB_FIELD (y); - if (f->level == 88) { - cb_error_x (x, _("condition-name not allowed here: '%s'"), f->name); - return 1; - } - if (f->flag_invalid) { - return 1; - } - /* validate use of handles depending on the statement */ - if (f->usage == CB_USAGE_HNDL || - f->usage == CB_USAGE_HNDL_WINDOW || - f->usage == CB_USAGE_HNDL_SUBWINDOW || - f->usage == CB_USAGE_HNDL_FONT || - f->usage == CB_USAGE_HNDL_THREAD || - f->usage == CB_USAGE_HNDL_MENU || - f->usage == CB_USAGE_HNDL_VARIANT || - f->usage == CB_USAGE_HNDL_LM) { - /* valid statements: CALL, MOVE, DISPLAY + expressions - the only statements reaching this are MOVE and DISPLAY */ - if (strcmp (current_statement->name, "MOVE") != 0 && - strcmp (current_statement->name, "DISPLAY") != 0 && - strcmp (current_statement->name, "DESTROY") != 0 && - strcmp (current_statement->name, "CLOSE WINDOW") != 0) { - cb_error_x (x, _("%s item not allowed here: '%s'"), - "HANDLE", f->name); - return 1; - } - } - } - } - return 0; -} - -static size_t -cb_validate_list (cb_tree l) -{ - for (; l; l = CB_CHAIN (l)) { - if (cb_validate_one (CB_VALUE (l))) { - return 1; - } - } - return 0; -} - -static cb_tree -cb_check_group_name (cb_tree x) -{ - cb_tree y; - - if (x == cb_error_node) { - return cb_error_node; - } - - if (CB_REFERENCE_P (x)) { - y = cb_ref (x); - if (y == cb_error_node) { - return cb_error_node; - } - if (CB_FIELD_P (y) - && CB_FIELD (y)->children != NULL - && CB_REFERENCE (x)->offset == NULL) { - return x; - } - } - - cb_error_x (x, _("'%s' is not a group name"), cb_name (x)); - return cb_error_node; -} - -static cb_tree -cb_check_numeric_name (cb_tree x) -{ -#if 0 /* already checked before called */ - if (x == cb_error_node) { - return cb_error_node; - } -#endif - - if (CB_REFERENCE_P (x) - && CB_FIELD_P (cb_ref (x)) - && CB_TREE_CATEGORY (x) == CB_CATEGORY_NUMERIC) { - return x; - } - if(CB_REFERENCE_P (x) - && CB_FIELD_P (cb_ref (x))) { - const struct cb_field *f = CB_FIELD_PTR (x); - if(f->usage == CB_USAGE_COMP_X) - return x; - } - - cb_error_x (x, _("'%s' is not a numeric name"), cb_name (x)); - return cb_error_node; -} - -static cb_tree -cb_check_numeric_edited_name (cb_tree x) -{ -#if 0 /* already checked before called */ - if (x == cb_error_node) { - return cb_error_node; - } -#endif - - if (CB_REFERENCE_P (x) - && CB_FIELD_P (cb_ref (x))) { - enum cb_category cat = CB_TREE_CATEGORY(x); - if (cat == CB_CATEGORY_NUMERIC - || cat == CB_CATEGORY_NUMERIC_EDITED - || cat == CB_CATEGORY_FLOATING_EDITED) { - return x; - } - } - - if(CB_REFERENCE_P (x) - && CB_FIELD_P (cb_ref (x))) { - const struct cb_field *f = CB_FIELD_PTR (x); - if(f->usage == CB_USAGE_COMP_X) - return x; - } - cb_error_x (x, _("'%s' is not a numeric or numeric-edited name"), cb_name (x)); - return cb_error_node; -} - -int -cb_is_field_unbounded (struct cb_field *fld) -{ - struct cb_field *f; - - if (fld->flag_unbounded) { - return 1; - } - for (f = fld->children; f; f = f->sister) { - if (cb_is_field_unbounded (f)) { - return 1; - } - } - return 0; -} - -cb_tree -cb_check_sum_field (cb_tree x) -{ - struct cb_field *f, *sc; - - if (CB_TREE_CATEGORY (x) != CB_CATEGORY_NUMERIC_EDITED) { - return x; - } - - f = CB_FIELD (cb_ref(x)); - if (f->report) { /* If part of a REPORT, check if it is a SUM */ - sc = get_sum_data_field(f->report, f); - if (sc) { /* Use the SUM variable instead of the print variable */ - return cb_build_field_reference (sc, NULL); - } - } - return x; -} - -cb_tree -cb_check_numeric_value (cb_tree x) -{ - struct cb_field *f, *sc; - if (cb_validate_one (x)) { - return cb_error_node; - } - - if (CB_TREE_CATEGORY (x) == CB_CATEGORY_NUMERIC) { - return x; - } - - switch(CB_TREE_CATEGORY (x)) { - case CB_CATEGORY_ALPHABETIC: - cb_error_x (x, _("'%s' is Alpha, instead of a numeric value"), cb_name (x)); - break; - case CB_CATEGORY_ALPHANUMERIC_EDITED: - cb_error_x (x, _("'%s' is Alpha Edited, instead of a numeric value"), cb_name (x)); - break; - case CB_CATEGORY_NUMERIC_EDITED: - case CB_CATEGORY_FLOATING_EDITED: - f = CB_FIELD (cb_ref(x)); - if (f->report) { - sc = get_sum_data_field (f->report, f); - if (sc) { /* Use the SUM variable instead of the print variable */ - return cb_build_field_reference (sc, NULL); - } - } - /* Fall-through as we only allow this for RW: SUM */ - default: - cb_error_x (x, _("'%s' is not a numeric value"), cb_name (x)); - } - return cb_error_node; -} - -static cb_tree -cb_check_integer_value (cb_tree x) -{ - struct cb_literal *l; - struct cb_field *f; - cb_tree y; - - if (x == cb_error_node) { - return cb_error_node; - } - - if (CB_TREE_CATEGORY (x) != CB_CATEGORY_NUMERIC) { - goto invalid; - } - - switch (CB_TREE_TAG (x)) { - case CB_TAG_CONST: - if (x != cb_zero) { - goto invalid; - } - return x; - case CB_TAG_LITERAL: - l = CB_LITERAL (x); - if (l->sign < 0 || l->scale > 0) { - goto invliteral; - } - return x; - case CB_TAG_REFERENCE: - y = cb_ref (x); - if (y == cb_error_node) { - return cb_error_node; - } - f = CB_FIELD (y); - if (f->pic->scale > 0) { - goto invalid; - } - return x; - case CB_TAG_BINARY_OP: - /* TODO: need to check */ - return x; - case CB_TAG_INTRINSIC: - /* TODO: need to check */ - return x; - default: -invalid: - cb_error_x (x, _("'%s' is not an integer value"), cb_name (x)); - return cb_error_node; - } -invliteral: - cb_error_x (x, _("positive numeric integer is required here")); - return cb_error_node; -} - -static void -cb_check_data_incompat (cb_tree x) -{ - struct cb_field *f; - - if (!x || x == cb_error_node) { - return; - } - if (!CB_REF_OR_FIELD_P (x) || - CB_TREE_CATEGORY (x) != CB_CATEGORY_NUMERIC) { - return; - } - f = CB_FIELD_PTR (x); - if (cb_flag_correct_numeric && f->usage == CB_USAGE_DISPLAY) { - cb_emit (CB_BUILD_FUNCALL_1 ("cob_correct_numeric", x)); - } - if (CB_EXCEPTION_ENABLE (COB_EC_DATA_INCOMPATIBLE)) { - if (f->usage == CB_USAGE_DISPLAY || - f->usage == CB_USAGE_PACKED || - f->usage == CB_USAGE_COMP_6) { - cb_emit (CB_BUILD_FUNCALL_2 ("cob_check_numeric", - x, - CB_BUILD_STRING0 (f->name))); - } - } -} - -static void -cb_check_lit_subs (struct cb_reference *r, const int numsubs, - const int numindex) -{ - cb_tree l; - cb_tree v; - struct cb_literal *lt; - int size; - - /* Check for DPC and non-standard separator usage */ - if (!cb_relaxed_syntax_checks || - current_program->decimal_point != ',') { - return; - } - if (numsubs > numindex) { - return; - } - - for (l = r->subs; l; l = CB_CHAIN (l)) { - v = CB_VALUE (l); - if (v == cb_error_node) { - continue; - } - if (!CB_LITERAL_P (v)) { - continue; - } - lt = CB_LITERAL (v); - if (!lt->scale) { - continue; - } - if (lt->scale == (int)lt->size) { - lt->scale = 0; - continue; - } - size = lt->size - lt->scale; - v = cb_build_numsize_literal (<->data[size], - (size_t)lt->scale, lt->sign); - CB_VALUE (l) = v; - v = cb_build_numsize_literal (lt->data, (size_t)size, 0); - CB_CHAIN (l) = CB_BUILD_CHAIN (v, CB_CHAIN (l)); - } - return; -} - -static int -usage_is_thread_handle (cb_tree x) -{ - struct cb_field *f; - f = CB_FIELD_PTR (x); - - if (f->usage == CB_USAGE_HNDL || - f->usage == CB_USAGE_HNDL_THREAD) { - return 1; - } - return 0; -} - -static int -usage_is_window_handle (cb_tree x) -{ - struct cb_field *f; - f = CB_FIELD_PTR (x); - - if (f->usage == CB_USAGE_HNDL || - f->usage == CB_USAGE_HNDL_WINDOW || - f->usage == CB_USAGE_HNDL_SUBWINDOW) { - return 1; - } - if (f->usage == CB_USAGE_DISPLAY && - f->pic->category == CB_CATEGORY_ALPHANUMERIC && - f->size == 10){ - return 1; - } - return 0; -} - -/* List system routines */ - -void -cb_list_system_routines (void) -{ - const struct system_table *psyst; - - putchar ('\n'); - - putchar ('\n'); - printf ("%-32s%s\n", _("System routine"), _("Parameters")); - putchar ('\n'); - - for (psyst = system_tab; psyst->syst_name; psyst++) { - if (strlen (psyst->syst_name) != 1) { - printf ("%-32s", psyst->syst_name); - } else { - printf ("X\"%2X\"%-27s", (unsigned char)psyst->syst_name[0], ""); - } - if (psyst->syst_params_min != psyst->syst_params_max) { - printf ("%d - %d", psyst->syst_params_min, psyst->syst_params_max); - } else { - printf ("%d", psyst->syst_params_min); - } - putchar ('\n'); - } -} - -/* Check if tree is an INDEX */ -size_t -cb_check_index_or_handle_p (cb_tree x) -{ - struct cb_field *f; - - if (!CB_REF_OR_FIELD_P (x)) { - return 0; - } - f = CB_FIELD_PTR (x); - if (f->children) { - return 0; - } - if (f->usage == CB_USAGE_INDEX || - f->usage == CB_USAGE_HNDL || - f->usage == CB_USAGE_HNDL_WINDOW || - f->usage == CB_USAGE_HNDL_SUBWINDOW || - f->usage == CB_USAGE_HNDL_FONT || - f->usage == CB_USAGE_HNDL_THREAD || - f->usage == CB_USAGE_HNDL_MENU || - f->usage == CB_USAGE_HNDL_VARIANT || - f->usage == CB_USAGE_HNDL_LM) { - return 1; - } - return 0; -} - -/* Check if a field reference requires debugging */ - -void -cb_check_field_debug (cb_tree fld) -{ - cb_tree l; - cb_tree x; - cb_tree z; - size_t size; - size_t found; - char buff[COB_MINI_BUFF]; - - /* Basic reference check */ - if (CB_WORD_COUNT (fld) > 0) { - if (!CB_WORD_ITEMS (fld)) { - return; - } - z = CB_VALUE(CB_WORD_ITEMS (fld)); - if (!CB_FIELD_P (z)) { - return; - } - x = cb_ref (fld); - if (x == cb_error_node) { - return; - } - } else { - return; - } - - found = 0; - /* Check if reference is being debugged */ - for (l = current_program->debug_list; l; l = CB_CHAIN (l)) { - if (!CB_PURPOSE (l)) { - continue; - } - if (x == CB_PURPOSE (l)) { - if (CB_REFERENCE (fld)->flag_target || - CB_REFERENCE (CB_VALUE (l))->flag_all_debug) { - found = 1; - } - break; - } - } - if (!found) { - return; - } - - found = 0; - /* Found it - check if it is already in the statement list */ - for (l = current_statement->debug_nodups; l; l = CB_CHAIN (l)) { - if (CB_VALUE (l) == x) { - found = 1; - break; - } - } - if (found) { - return; - } - - /* Set up debug info */ - strncpy (buff, CB_FIELD(x)->name, COB_MAX_WORDLEN); - buff[COB_MAX_WORDLEN] = 0; - l = CB_REFERENCE (fld)->chain; - if (l) { - size = strlen (buff); - for (; l; l = CB_REFERENCE (l)->chain) { - z = cb_ref (l); - if (z != cb_error_node) { - size += strlen (CB_FIELD (z)->name); - size += 4; - if (size >= sizeof(buff)) { - break; - } - strcat (buff, " OF "); - strcat (buff, CB_FIELD (z)->name); - } - } - } - current_statement->debug_nodups = - cb_list_add (current_statement->debug_nodups, x); - current_statement->debug_check = - cb_list_add (current_statement->debug_check, - cb_build_debug (cb_debug_name, buff, NULL)); - current_statement->debug_check = - cb_list_add (current_statement->debug_check, - cb_build_debug (cb_debug_contents, NULL, fld)); - found = 0; - CB_REFERENCE (fld)->subs = cb_list_reverse (CB_REFERENCE (fld)->subs); - l = CB_REFERENCE (fld)->subs; - for (; l && found < 3; l = CB_CHAIN (l), ++found) { - switch (found) { - case 0: - current_statement->debug_check = - cb_list_add (current_statement->debug_check, - cb_build_move (CB_VALUE (l), - cb_debug_sub_1)); - break; - case 1: - current_statement->debug_check = - cb_list_add (current_statement->debug_check, - cb_build_move (CB_VALUE (l), - cb_debug_sub_2)); - break; - case 2: - current_statement->debug_check = - cb_list_add (current_statement->debug_check, - cb_build_move (CB_VALUE (l), - cb_debug_sub_3)); - break; - default: - break; - } - } - CB_REFERENCE (fld)->subs = cb_list_reverse (CB_REFERENCE (fld)->subs); - - for (; found < 3; ++found) { - switch (found) { - case 0: - current_statement->debug_check = - cb_list_add (current_statement->debug_check, - CB_BUILD_FUNCALL_3 ("memset", - CB_BUILD_CAST_ADDRESS (cb_debug_sub_1), - cb_int (' '), - CB_BUILD_CAST_LENGTH (cb_debug_sub_1))); - break; - case 1: - current_statement->debug_check = - cb_list_add (current_statement->debug_check, - CB_BUILD_FUNCALL_3 ("memset", - CB_BUILD_CAST_ADDRESS (cb_debug_sub_2), - cb_int (' '), - CB_BUILD_CAST_LENGTH (cb_debug_sub_2))); - break; - case 2: - current_statement->debug_check = - cb_list_add (current_statement->debug_check, - CB_BUILD_FUNCALL_3 ("memset", - CB_BUILD_CAST_ADDRESS (cb_debug_sub_3), - cb_int (' '), - CB_BUILD_CAST_LENGTH (cb_debug_sub_3))); - break; - default: - break; - } - } - - current_statement->debug_check = - cb_list_add (current_statement->debug_check, - cb_build_debug_call (CB_FIELD(x)->debug_section)); -} - -/* Program registers */ - - -/* RETURN-CODE */ -static void -cb_build_register_return_code (const char *name, const char *definition) -{ - cb_tree field; - - if (!definition) { - definition = cb_get_register_definition (name); - if (!definition) { - return; - } - } - - /* take care of GLOBAL */ - if (current_program->nested_level) { - return; - } - - field = cb_build_index (cb_build_reference (name), cb_zero, 0, NULL); - CB_FIELD_PTR (field)->index_type = CB_STATIC_INT_INDEX; - current_program->cb_return_code = field; -} - -/* SORT-RETURN */ -static void -cb_build_register_sort_return (const char *name, const char *definition) -{ - cb_tree field; - - if (!definition) { - definition = cb_get_register_definition (name); - if (!definition) { - return; - } - } - - field = cb_build_index (cb_build_reference (name), cb_zero, 0, NULL); - CB_FIELD_PTR (field)->flag_no_init = 1; - current_program->cb_sort_return = field; -} - -/* NUMBER-OF-CALL-PARAMETERS (OpenCOBOL/GnuCOBOL extension 1.0+) */ -static void -cb_build_register_number_parameters (const char *name, const char *definition) -{ - cb_tree field; - - if (!definition) { - definition = cb_get_register_definition (name); - if (!definition) { - return; - } - } - - field = cb_build_index (cb_build_reference (name), cb_zero, 0, NULL); - CB_FIELD_PTR (field)->flag_no_init = 1; - CB_FIELD_PTR (field)->flag_local = 1; - CB_FIELD_PTR (field)->index_type = CB_INT_INDEX; - current_program->cb_call_params = field; -} - -/* WHEN-COMPILED */ -static void -cb_build_register_when_compiled (const char *name, const char *definition) -{ - char buff[32]; /* 32: make the compiler happy as "unsigned short" *could* - have more digits than we "assume" */ - size_t lit_size; - - if (!definition) { - definition = cb_get_register_definition (name); - if (!definition) { - return; - } - } - - /* FIXME: the actual content is different for at least OSVS, - as this uses "hh.mm.ssMMM DD, YYYY", we should assume this - if the register's definition contains X(20)! */ -#if 0 - if (doesn_t_contain_X_20(definition)) { -#endif - snprintf (buff, sizeof (buff), "%2.2d/%2.2d/%2.2d%2.2d.%2.2d.%2.2d", - (cob_u16_t) current_compile_time.day_of_month, - (cob_u16_t) current_compile_time.month, - (cob_u16_t) current_compile_time.year % 100, - (cob_u16_t) current_compile_time.hour, - (cob_u16_t) current_compile_time.minute, - (cob_u16_t) current_compile_time.second); - lit_size = 16; -#if 0 - } else { - snprintf (buff, sizeof (buff) + 1, "%2.2d\.%2.2d\.%2.2d%s %2.2d, %4.4d", - (cob_u16_t) current_compile_time.hour, - (cob_u16_t) current_compile_time.minute, - (cob_u16_t) current_compile_time.second, - (cob_u16_t) current_compile_time.month, - (cob_u16_t) current_compile_time.day_of_month, - (cob_u16_t) current_compile_time.year); - lit_size = 20; - } -#endif - (void)cb_build_constant (cb_build_reference (name), - cb_build_alphanumeric_literal (buff, lit_size)); -} - -/* General register creation; used for TALLY, LIN, COL */ -/* TODO: complete change to generic function */ -int -cb_build_generic_register (const char *name, const char *external_definition) -{ - cb_tree field_tree; - char definition[COB_MINI_BUFF]; - char temp[COB_MINI_BUFF]; - char *p, *r; - struct cb_field *field; - enum cb_usage usage; - struct cb_picture *picture; - - if (!external_definition) { - external_definition = cb_get_register_definition (name); - if (!external_definition) { - return 1; - } - } - - strncpy (definition, external_definition, COB_MINI_MAX); - definition[COB_MINI_MAX] = 0; - - /* check for GLOBAL, leave if we don't need to define it again (nested program)*/ - p = strstr (definition, "GLOBAL"); - if (p) { - if (current_program && current_program->nested_level) { - return 0; - } - memset (p, ' ', 6); /* remove from local copy */ - } - - /* actual field generation */ - field_tree = cb_build_field (cb_build_reference (name)); - field = CB_FIELD_PTR (field_tree); - field->flag_is_global = (p != NULL); /* any GLOBAL found ? */ - - /* handle USAGE */ - usage = CB_USAGE_DISPLAY; - p = strstr (definition, "USAGE "); - if (p) { - memset (p, ' ', 5); - p += 6; - while (*p == ' ') p++; - - if (strncmp (p, "DISPLAY", (size_t)7) == 0) { - memset (p, ' ', 7); - } else { - r = p; - while (*r != 0 && *r != ' ') r++; - strncpy (temp, p, r - p); - temp [r - p] = 0; - memset (p, ' ', r - p); - COB_UNUSED (temp); /* FIXME: parse actual USAGE from temp */ - usage = CB_USAGE_BINARY; - } - } - field->usage = usage; - - /* handle PICTURE */ - p = strstr (definition, "PIC "); - if (p) { - memset (p, ' ', 3); - p += 4; - } else { - p = strstr (definition, "PICTURE "); - if (p) { - memset (p, ' ', 7); - p += 8; - } - } - if (p) { - while (*p == ' ') p++; - r = p; - while (*r != 0 && *r != ' ') r++; - strncpy (temp, p, r - p); - temp [r - p] = 0; - memset (p, ' ', r - p); - picture = CB_PICTURE (cb_build_picture (temp)); - } else { - picture = NULL; - } - - field->pic = picture; - - /* handle VALUE */ - p = strstr (definition, "VALUE "); - if (p) { - memset (p, ' ', 5); - p += 6; - } else { - p = strstr (definition, "VALUES "); - if (p) { - memset (p, ' ', 6); - p += 7; - } - } - if (p) { - COB_UNUSED (p); /* FIXME: parse actual VALUE */ - field->values = CB_LIST_INIT (cb_zero); - } - - /* TODO: check that the local definition is completely parsed -> spaces */ - - cb_validate_field (field); - - field->flag_no_init = 1; - if (current_program) { - CB_FIELD_ADD (current_program->working_storage, field); - } else if (field->flag_is_global) { - CB_FIELD_ADD (external_defined_fields_global, field); - } else { - CB_FIELD_ADD (external_defined_fields_ws, field); - } - - return 0; -} - -static void -cb_build_register_xml_code (const char *name, const char *definition) -{ - cb_tree tfield; - struct cb_field *field; - - if (!definition) { - definition = cb_get_register_definition (name); - if (!definition) { - return; - } - } - - /* take care of GLOBAL */ - if (current_program->nested_level) { - return; - } - - tfield = cb_build_field (cb_build_reference (name)); - field = CB_FIELD (tfield); - field->usage = CB_USAGE_BINARY; - field->pic = CB_PICTURE (cb_build_picture ("S9(9)")); - cb_validate_field (field); - field->values = CB_LIST_INIT (cb_zero); - field->flag_no_init = 1; - field->flag_is_global = 1; - current_program->xml_code = tfield; -} - -/* TO-DO: Duplication! */ -static void -cb_build_register_json_code (const char *name, const char *definition) -{ - cb_tree tfield; - struct cb_field *field; - - if (!definition) { - definition = cb_get_register_definition (name); - if (!definition) { - return; - } - } - - /* take care of GLOBAL */ - if (current_program->nested_level) { - return; - } - - tfield = cb_build_field (cb_build_reference (name)); - field = CB_FIELD (tfield); - field->usage = CB_USAGE_BINARY; - field->pic = CB_PICTURE (cb_build_picture ("S9(9)")); - cb_validate_field (field); - field->values = CB_LIST_INIT (cb_zero); - field->flag_no_init = 1; - field->flag_is_global = 1; - current_program->json_code = tfield; -} - - -/* build a concrete register */ -static void -cb_build_single_register (const char *name, const char *definition) -{ - /* TODO: parse definition here or in sub-functions */ - - /* registers that are currently created elsewhere - TODO: move them here */ - /* FIXME: LENGTH OF (must have different results depending on compiler configuration) */ - if (!strcasecmp (name, "ADDRESS OF") - || !strcasecmp (name, "LENGTH OF") - || !strcasecmp (name, "COB-CRT-STATUS") - || !strcasecmp (name, "DEBUG-ITEM")) { - return; - } - - /* registers that need a special handling / internal registration */ - if (!strcasecmp (name, "JSON-CODE")) { - cb_build_register_json_code (name, definition); - return; - } - if (!strcasecmp (name, "RETURN-CODE")) { - cb_build_register_return_code (name, definition); - return; - } - if (!strcasecmp (name, "SORT-RETURN")) { - cb_build_register_sort_return (name, definition); - return; - } - if (!strcasecmp (name, "NUMBER-OF-CALL-PARAMETERS")) { - cb_build_register_number_parameters (name, definition); - return; - } - if (!strcasecmp (name, "WHEN-COMPILED")) { - cb_build_register_when_compiled (name, definition); - return; - } - if (!strcasecmp (name, "XML-CODE")) { - cb_build_register_xml_code (name, definition); - return; - } - - /* "normal" registers */ - if (!strcasecmp (name, "TALLY") - || !strcasecmp (name, "LIN") - || !strcasecmp (name, "COL")) { - cb_build_generic_register (name, definition); - return; - } - - /* LCOV_EXCL_START */ - /* This should never happen (and therefore doesn't get a translation) */ - cb_error ("unexpected register %s, defined as \"%s\"", name, definition); - COBC_ABORT(); - /* LCOV_EXCL_STOP */ -} - -/* get all active registers and build them */ -void -cb_build_registers (void) -{ - const char *name, *definition = NULL; - - name = cb_register_list_get_first (&definition); - while (name) { - cb_build_single_register (name, definition); - name = cb_register_list_get_next (&definition); - } -} - -/* add registers defined externally (configuration/compiler option) */ -void -cb_add_external_defined_registers (void) -{ - if (external_defined_fields_ws) { - CB_FIELD_ADD (current_program->working_storage, external_defined_fields_ws); - } - if (external_defined_fields_global && !current_program->nested_level) { - CB_FIELD_ADD (current_program->working_storage, external_defined_fields_global); - } -} - -/* - TODO: build on first reference (we have the compile time which is the reason - that it was placed here in the first place available fixed in - current_compile_time now). -*/ -void -cb_set_intr_when_compiled (void) -{ - char buff[36]; /* 36: make the compiler happy as "unsigned short" *could* - have more digits than we "assume" */ - cob_u16_t offset_minutes; - - snprintf (buff, sizeof (buff), "%4.4d%2.2d%2.2d%2.2d%2.2d%2.2d%2.2d", - (cob_u16_t) current_compile_time.year, - (cob_u16_t) current_compile_time.month, - (cob_u16_t) current_compile_time.day_of_month, - (cob_u16_t) current_compile_time.hour, - (cob_u16_t) current_compile_time.minute, - (cob_u16_t) current_compile_time.second, - (cob_u16_t) (current_compile_time.nanosecond / 10000000)); - if (current_compile_time.offset_known) { - if (current_compile_time.utc_offset >= 0) { - offset_minutes = current_compile_time.utc_offset % 60; - } else { - offset_minutes = -current_compile_time.utc_offset % 60; - } - snprintf (buff + 16, (size_t)11, "%+2.2d%2.2d", /* 11: see above */ - (cob_s16_t) current_compile_time.utc_offset / 60, - offset_minutes); - } else { - snprintf (buff + 16, (size_t)6, "00000"); - } - cb_intr_whencomp = cb_build_alphanumeric_literal (buff, (size_t)21); -} - -/* check program-id literal and trim, if necessary */ -void -cb_trim_program_id (cb_tree id_literal) -{ - char *s; - cob_u32_t len; - - s = (char *) (CB_LITERAL (id_literal)->data); - if (!strchr (s, ' ')) { - return; - } - - len = (cob_u32_t) strlen (s); - if (*s == ' ') { - /* same warning as in libcob/common.c */ - cb_warning_x (COBC_WARN_FILLER, id_literal, - _("'%s' literal includes leading spaces which are omitted"), s); - } - if (s[len - 1] == ' ') { - cb_warning_x (cb_warn_extra, id_literal, - _("'%s' literal includes trailing spaces which are omitted"), s); - } - while (*s == ' ') { - memmove (s, s + 1, len--); - } - while (s[len - 1] == ' ' && len > 0) { - len--; - } - s[len] = 0; - CB_LITERAL (id_literal)->size = len; -} - -/** encode given name - \param name to encode - \param strip_path specifying if name may include directory which - should be stripped in the encoded version - \return pointer to encoded name - */ -char * -cb_encode_program_id (const char *name, const int strip_path, const int fold_case) -{ - const unsigned char *s = (const unsigned char *)name; - unsigned char buff[COB_MINI_BUFF]; - - /* position after last path separator (included for CALL) */ - if (strip_path) { - const unsigned char *t; - for (t = s + strlen (name); t > s; t--) { - if (*t == (unsigned char)'/' || *t == (unsigned char)'\\') { - s = t + 1; - break; - } - } - } - - /* Encode program name, including case folding */ - cob_encode_program_id ((unsigned char *)name, buff, COB_MINI_MAX, fold_case); - - return cobc_check_string ((char *)buff); -} - -char * -cb_build_program_id (const char *name, const cob_u32_t is_func) -{ - /* always convert function names to upper case */ - const int folding = is_func ? COB_FOLD_UPPER : cb_fold_call; - - /* checking for valid name, the error raised there is enough to stop - the generation, therefore we ignore the result */ - (void)cobc_check_valid_name (name, PROGRAM_ID_NAME); - - /* Set and encode the PROGRAM-ID */ - current_program->orig_program_id = (char *) name; - return cb_encode_program_id (name, 0, folding); -} - -cb_tree -cb_define_switch_name (cb_tree name, cb_tree sname, const int flag) -{ - cb_tree switch_id; - cb_tree value; - - if (!name || name == cb_error_node) { - return NULL; - } - if (!sname || sname == cb_error_node || - CB_SYSTEM_NAME (sname)->category != CB_SWITCH_NAME) { - cb_error_x (name, _("ON/OFF usage requires a SWITCH name")); - return NULL; - } - switch_id = cb_int (CB_SYSTEM_NAME (sname)->token); - value = CB_BUILD_FUNCALL_1 ("cob_get_switch", switch_id); - if (flag == 0) { - value = CB_BUILD_NEGATION (value); - } - cb_build_constant (name, value); - return value; -} - -void -cb_check_word_length (unsigned int length, const char *word) -{ - if (unlikely (length > cb_word_length)) { - if (length > COB_MAX_WORDLEN) { - /* Absolute limit */ - cb_error (_("word length exceeds maximum of %d characters: '%s'"), - COB_MAX_WORDLEN, word); - } else if (!cb_relaxed_syntax_checks) { - cb_error (_("word length exceeds %d characters: '%s'"), - cb_word_length, word); - } else { - cb_warning (cb_warn_extra, _("word length exceeds %d characters: '%s'"), - cb_word_length, word); - } - } -} - -cb_tree -cb_build_section_name (cb_tree name, const int sect_or_para) -{ - cb_tree x; - struct cb_word *w; - int nwlength; - - if (name == cb_error_node) { - return cb_error_node; - } - - /* Check word length - needed here for numeric-only words that bypass the checks - in scanner.l */ - w = CB_REFERENCE (name)->word; - for (nwlength = 0; w->name[nwlength] != 0; nwlength++) { - if (!isdigit ((int)w->name[nwlength])) { - nwlength = 0; - break; - } - } - if (nwlength > 0) { - cb_check_word_length(nwlength, w->name); - } - - if (CB_WORD_COUNT (name) > 0) { - x = CB_VALUE (CB_WORD_ITEMS (name)); - /* - Used as a non-label name or used as a section name. - Duplicate paragraphs are allowed if not referenced; - Checked in typeck.c - */ - if (!CB_LABEL_P (x) || sect_or_para == 0 || - (sect_or_para && CB_LABEL_P (x) && - CB_LABEL (x)->flag_section)) { - redefinition_error (name); - return cb_error_node; - } - } - - return name; -} - -static const char * -remove_labels_from_filename (const char *name_ptr) -{ - const char *p = NULL; - - p = strrchr (name_ptr, '-'); - if (p) { - return p + 1; - } else { - return name_ptr; - } -} - -/* - Build name for ASSIGN EXTERNAL: convert the word in the ASSIGN clause into - a literal. - */ -static cb_tree -build_external_assignment_name (cb_tree name) -{ - const char *name_ptr; - const char *orig_ptr; - - name_ptr = orig_ptr = CB_NAME (name); - - /* Remove (and warn about) labels */ - name_ptr = remove_labels_from_filename (name_ptr); - if (name_ptr != orig_ptr) { - cb_warning (cb_warn_extra, _("ASSIGN %s interpreted as '%s'"), - orig_ptr, name_ptr); - } - - /* Convert the EXTERNAL name into literal */ - return cb_build_alphanumeric_literal (name_ptr, strlen (name_ptr)); -} - -/* build name for ASSIGN, to be resolved later as we don't have any - field info at this point (postponed to cb_validate_program_data) */ -cb_tree -cb_build_assignment_name (struct cb_file *cfile, cb_tree name) -{ - if (name == cb_error_node) { - return cb_error_node; - } - /* For special assignment */ - if (name == NULL) { - return NULL; - } - - if (CB_LITERAL_P (name)) { - return name; - } - - if (!CB_REFERENCE_P (name)) { - return cb_error_node; - } - - if (cfile->assign_type == CB_ASSIGN_EXT_FILE_NAME_REQUIRED) { - return build_external_assignment_name (name); - } else { - current_program->reference_list = - cb_list_add (current_program->reference_list, name); - return name; - } -} - -cb_tree -cb_build_index (cb_tree x, cb_tree values, const unsigned int indexed_by, - struct cb_field *qual) -{ - struct cb_field *f; - - f = CB_FIELD (cb_build_field (x)); - f->usage = CB_USAGE_INDEX; - cb_validate_field (f); - if (values) { - f->values = CB_LIST_INIT (values); - } - if (qual) { - f->index_qual = qual; - } - f->flag_indexed_by = !!indexed_by; - CB_FIELD_ADD (current_program->working_storage, f); - return x; -} - -cb_tree -cb_build_address (cb_tree x) -{ - cb_tree v; - struct cb_reference *r; - const char *name; - unsigned int numsubs, refsubs; - - if (x == cb_error_node) { - return cb_error_node; - } - if (!CB_REFERENCE_P (x)) { - return CB_BUILD_CAST_ADDRESS (x); - } - - r = CB_REFERENCE (x); - name = r->word->name; - v = cb_ref (x); - if (v == cb_error_node) { - return cb_error_node; - } - - refsubs = cb_list_length (r->subs); - if (CB_FIELD_P (v)) { - numsubs = CB_FIELD (v)->indexes; - if (refsubs > numsubs) { - goto subserror; - } else if (refsubs < numsubs) { - if (!cb_relaxed_syntax_checks) { - goto subserror; - } else { - cb_warning_x (COBC_WARN_FILLER, x, - _("subscript missing for '%s' - defaulting to 1"), - name); - for (; refsubs < numsubs; ++refsubs) { - CB_ADD_TO_CHAIN (cb_one, r->subs); - } - } - } - } else { - numsubs = 0; - if (r->subs) { - goto subserror; - } - if (r->offset) { - cb_error_x (x, _("'%s' cannot be reference modified"), name); - return cb_error_node; - } - } - - return CB_BUILD_CAST_ADDRESS (x); - -subserror: - switch (numsubs) { - case 0: - cb_error_x (x, _("'%s' cannot be subscripted"), name); - break; - case 1: - /* FIXME: Change to P_, needs changes to Makevars and tests */ - cb_error_x (x, _("'%s' requires one subscript"), name); - break; - default: - cb_error_x (x, _("'%s' requires %d subscripts"), - name, numsubs); - break; - } - return cb_error_node; -} - -/* return a reference for a given field combination, needed for calls to CB_FUNC_CALL - as the string would not be allocated during codegen otherwise */ -static cb_tree -cb_build_name_reference (struct cb_field *f1, struct cb_field *f2) -{ - char full_name[COB_MAX_WORDLEN * 2 + 10]; - if (f1 == f2) { - /* TRANSLATORS: This msgid is used when a variable name - or label is referenced in a compiler message. */ - sprintf(full_name, _("'%s'"), f1->name); - } else { - sprintf(full_name, _("'%s' (accessed by '%s')"), f1->name, f2->name); - } - - return cb_build_reference (full_name); -} - -cb_tree -cb_build_identifier (cb_tree x, const int subchk) -{ - struct cb_reference *r; - struct cb_field *f; - struct cb_field *p; - const char *name; - cb_tree v; - cb_tree e1; - cb_tree l; - cb_tree sub; - int offset; - int length; - int n; - int numsubs; - int refsubs; - int pseudosize; - - if (x == cb_error_node) { - return cb_error_node; - } - - r = CB_REFERENCE (x); - name = r->word->name; - - /* Resolve reference */ - v = cb_ref (x); - if (v == cb_error_node) { - return cb_error_node; - } - - /* Check if it is a data name */ - if (!CB_FIELD_P (v)) { - if (r->subs) { - cb_error_x (x, _("'%s' cannot be subscripted"), name); - return cb_error_node; - } - if (r->offset) { - cb_error_x (x, _("'%s' cannot be reference modified"), name); - return cb_error_node; - } - return x; - } - f = CB_FIELD (v); - - /* BASED check and check for OPTIONAL LINKAGE items */ - if (current_statement && !suppress_data_exceptions && - (CB_EXCEPTION_ENABLE (COB_EC_DATA_PTR_NULL) || - CB_EXCEPTION_ENABLE (COB_EC_PROGRAM_ARG_OMITTED))) { - p = cb_field_founder (f); - if (p->redefines) { - p = p->redefines; - } -#if 0 - /* note: we can only ignore the check for fields with flag_is_pdiv_opt - when we check for COB_EC_PROGRAM_ARG_MISMATCH in all entry points - and this check is currently completely missing... */ - if (CB_EXCEPTION_ENABLE (COB_EC_PROGRAM_ARG_OMITTED) - && p->storage == CB_STORAGE_LINKAGE && p->flag_is_pdiv_parm - && !(p->flag_is_pdiv_opt && CB_EXCEPTION_ENABLE (COB_EC_PROGRAM_ARG_MISMATCH)) { -#else - if (CB_EXCEPTION_ENABLE (COB_EC_PROGRAM_ARG_OMITTED) - && p->storage == CB_STORAGE_LINKAGE && p->flag_is_pdiv_parm) { -#endif - current_statement->null_check = CB_BUILD_FUNCALL_3 ( - "cob_check_linkage", - cb_build_address (cb_build_field_reference (p, NULL)), - CB_BUILD_STRING0 ( - CB_REFERENCE(cb_build_name_reference (p, f))->word->name), - cb_int1); - } else - if (CB_EXCEPTION_ENABLE (COB_EC_DATA_PTR_NULL) - && !current_statement->flag_no_based) { - if (p->flag_item_based - || (p->storage == CB_STORAGE_LINKAGE && - !(p->flag_is_pdiv_parm || p->flag_is_returning))) { - current_statement->null_check = CB_BUILD_FUNCALL_2 ( - "cob_check_based", - cb_build_address (cb_build_field_reference (p, NULL)), - CB_BUILD_STRING0 ( - CB_REFERENCE(cb_build_name_reference (p, f))->word->name)); - } - } - } - - for (l = r->subs; l; l = CB_CHAIN (l)) { - if (CB_BINARY_OP_P (CB_VALUE (l))) { - /* Set special flag for codegen */ - CB_BINARY_OP(CB_VALUE(l))->flag = 1; - } - } - - /* Check the number of subscripts */ - numsubs = refsubs = cb_list_length (r->subs); - cb_check_lit_subs (r, numsubs, f->indexes); - if (subchk) { - if (!f->indexes) { - cb_error_x (x, _("'%s' has no OCCURS clause"), name); - return cb_error_node; - } - numsubs = f->indexes - 1; - } else { - numsubs = f->indexes; - } - if (likely(!r->flag_all)) { - if (refsubs != numsubs) { - if (refsubs > numsubs) { - goto refsubserr; - } else if (refsubs < numsubs) { - if (!cb_relaxed_syntax_checks) { - goto refsubserr; - } else { - cb_warning_x (COBC_WARN_FILLER, x, - _("subscript missing for '%s' - defaulting to 1"), - name); - for (; refsubs < numsubs; ++refsubs) { - CB_ADD_TO_CHAIN (cb_one, r->subs); - } - } - } - } - - /* Run-time check for ODO (including all the fields subordinate items) */ - if (CB_EXCEPTION_ENABLE (COB_EC_BOUND_SUBSCRIPT) && f->odo_level != 0) { - for (p = f; p; p = p->children) { - if (p->depending && p->depending != cb_error_node) { - e1 = CB_BUILD_FUNCALL_5 ("cob_check_odo", - cb_build_cast_int (p->depending), - cb_int (p->occurs_min), - cb_int (p->occurs_max), - CB_BUILD_STRING0 (p->name), - CB_BUILD_STRING0 (CB_FIELD_PTR (p->depending)->name)); - r->check = cb_list_add (r->check, e1); - } - } - } - - /* Subscript check along with setting of table offset */ - if (r->subs &&! cb_validate_list (r->subs)) { - l = r->subs; - for (p = f; p && l; p = p->parent) { - if (!p->flag_occurs) { - continue; - } - sub = cb_check_integer_value (CB_VALUE (l)); - l = CB_CHAIN (l); - if (sub == cb_error_node) { - continue; - } - - /* Compile-time check for all literals */ - if (CB_LITERAL_P (sub)) { - n = cb_get_int (sub); - if (n < 1 || (!p->flag_unbounded && n > p->occurs_max)) { - cb_error_x (x, _("subscript of '%s' out of bounds: %d"), - name, n); - } - } - - /* Run-time check for all non-literals */ - if (CB_EXCEPTION_ENABLE (COB_EC_BOUND_SUBSCRIPT)) { - if (p->depending && p->depending != cb_error_node) { - e1 = CB_BUILD_FUNCALL_4 ("cob_check_subscript", - cb_build_cast_int (sub), - cb_build_cast_int (p->depending), - CB_BUILD_STRING0 (name), - cb_int1); - r->check = cb_list_add (r->check, e1); - } else { - if (!CB_LITERAL_P (sub)) { - e1 = CB_BUILD_FUNCALL_4 ("cob_check_subscript", - cb_build_cast_int (sub), - cb_int (p->occurs_max), - CB_BUILD_STRING0 (name), - cb_int0); - r->check = cb_list_add (r->check, e1); - } - } - } - } - } - } - - if (subchk) { - r->subs = cb_list_reverse (r->subs); - r->subs = cb_list_add (r->subs, cb_int1); - r->subs = cb_list_reverse (r->subs); - } - - /* Reference modification check */ - pseudosize = f->size; - if (cb_reference_bounds_check == CB_WARNING - || cb_reference_bounds_check == CB_OK) { - p = cb_field_founder (f); - if (p != f) { - pseudosize = p->size - f->offset; /* Remaining size of group item */ - } - } - if (f->usage == CB_USAGE_NATIONAL ) { - pseudosize = pseudosize / 2; - } - if (r->offset) { - /* Compile-time check */ - if (CB_LITERAL_P (r->offset) - && !cb_is_field_unbounded (f)) { - offset = cb_get_int (r->offset); - if (f->flag_any_length) { - if (offset < 1) { - cb_error_x (x, _("offset must be greater than zero")); - } else if (r->length && CB_LITERAL_P (r->length)) { - length = cb_get_int (r->length); - /* FIXME: needs to be supported for zero length literals */ - if (length < 1) { - cb_error_x (x, _("length must be greater than zero")); - } - } - } else { - if (offset < 1) { - cb_error_x (x, _("offset must be greater than zero")); - } else if (offset > pseudosize) { - if (cb_reference_bounds_check == CB_WARNING) { - cb_warning_x (cb_warn_extra, x, _("offset of '%s' out of bounds: %d"), name, offset); - } else - if (cb_reference_bounds_check == CB_ERROR) { - cb_error_x (x, _("offset of '%s' out of bounds: %d"), name, offset); - } - } - if (r->length && CB_LITERAL_P (r->length)) { - length = cb_get_int (r->length); - /* FIXME: needs to be supported for zero length literals */ - if (length < 1) { - cb_error_x (x, _("length must be greater than zero")); - } else if ((length > pseudosize - offset + 1) - && (offset <= pseudosize && offset >= 1) ) { - if (cb_reference_bounds_check == CB_WARNING) { - cb_warning_x (cb_warn_extra, x, _("length of '%s' out of bounds: %d"), - name, length); - } else - if (cb_reference_bounds_check == CB_ERROR) { - cb_error_x (x, _("length of '%s' out of bounds: %d"), - name, length); - } - } - } - } - } else if (r->length && CB_LITERAL_P (r->length) - && !cb_is_field_unbounded (f)) { - length = cb_get_int (r->length); - /* FIXME: needs to be supported for zero length literals */ - if (length < 1) { - cb_error_x (x, _("length must be greater than zero")); - } else if (length > pseudosize) { - if (cb_reference_bounds_check == CB_WARNING) { - cb_warning_x (cb_warn_extra, x, _("length of '%s' out of bounds: %d"), - name, length); - } else - if (cb_reference_bounds_check == CB_ERROR) { - cb_error_x (x, _("length of '%s' out of bounds: %d"), - name, length); - } - } - } - - /* Run-time check */ - if (CB_EXCEPTION_ENABLE (COB_EC_BOUND_REF_MOD)) { - if (f->flag_any_length - || cb_field_variable_size (f) - || !CB_LITERAL_P (r->offset) - || (r->length && !CB_LITERAL_P (r->length))) { - cb_tree temp = NULL; - if( cb_field_variable_size (f) ) { - temp = cb_build_index (cb_build_filler (), NULL, 0, NULL); - CB_FIELD (cb_ref (temp))->usage = CB_USAGE_LENGTH; - CB_FIELD (cb_ref (temp))->count++; - CB_FIELD (cb_ref (temp))->pic->have_sign = 0; /* LENGTH is UNSIGNED */ - cb_emit (cb_build_assign (temp, cb_build_length_1 (cb_build_field_reference (f, NULL)))); - } - e1 = CB_BUILD_FUNCALL_4 ("cob_check_ref_mod", - cb_build_cast_int (r->offset), - r->length ? - cb_build_cast_int (r->length) : - cb_int1, - cb_field_variable_size (f) ? - cb_build_cast_int (temp) : - f->flag_any_length ? - CB_BUILD_CAST_LENGTH (v) : - cb_int (pseudosize), - CB_BUILD_STRING0 (f->name)); - r->check = cb_list_add (r->check, e1); - } - } - } - - if (f->storage == CB_STORAGE_CONSTANT) { - return CB_VALUE (f->values); - } - - return x; - -refsubserr: - switch (numsubs) { - case 0: - cb_error_x (x, _("'%s' cannot be subscripted"), name); - break; - case 1: - /* FIXME: Change to P_, needs changes to Makevars and tests */ - cb_error_x (x, _("'%s' requires one subscript"), name); - break; - default: - cb_error_x (x, _("'%s' requires %d subscripts"), - name, f->indexes); - break; - } - return cb_error_node; -} - -static cb_tree -cb_build_length_1 (cb_tree x) -{ - struct cb_field *f; - cb_tree e; - cb_tree size; - - f = CB_FIELD (cb_ref (x)); - - if (cb_field_variable_size (f) == NULL) { - /* Constant size */ - return cb_int (cb_field_size (x)); - } - /* Variable size */ - e = NULL; - for (f = f->children; f; f = f->sister) { - size = cb_build_length_1 (cb_build_field_reference (f, x)); - if (f->depending) { - if (!cb_flag_odoslide && f->flag_odo_relative) { - size = cb_build_binary_op (size, '*', cb_int (f->occurs_max)); - } else { - size = cb_build_binary_op (size, '*', f->depending); - } - } else if (f->occurs_max > 1) { - size = cb_build_binary_op (size, '*', cb_int (f->occurs_max)); - } - e = e ? cb_build_binary_op (e, '+', size) : size; - } - return e; -} - -cb_tree -cb_build_const_length (cb_tree x) -{ - struct cb_field *f; - char buff[32]; - - if (x == cb_error_node) { - return cb_error_node; - } - if (CB_INTEGER_P (x)) { - sprintf (buff, FMT_LEN, CB_INTEGER(x)->val); - return cb_build_numeric_literal (0, buff, 0); - } - if (CB_LITERAL_P (x)) { - sprintf (buff, "%d", CB_LITERAL(x)->size); - return cb_build_numsize_literal (buff, strlen(buff), 0); - } - if (CB_REFERENCE_P (x)) { - if (cb_ref (x) == cb_error_node) { - return cb_error_node; - } - if (CB_REFERENCE (x)->offset) { - cb_error (_("reference modification not allowed here")); - return cb_error_node; - } - } else if (!CB_FIELD_P(x)) { - return cb_error_node; - } - - f = CB_FIELD (cb_ref (x)); - cb_validate_field (f); - if (f->flag_any_length) { - cb_error (_("ANY LENGTH item not allowed here")); - return cb_error_node; - } - if (f->level == 88) { - cb_error (_("88 level item not allowed here")); - return cb_error_node; - } - if (!cobc_in_procedure - && !cb_length_in_data_division) { - cb_error_x (x,_("LENGTH OF '%s' not allowed outside of Procedure Division"),f->name); - return cb_error_node; - } - if (cb_field_variable_size (f)) { - cb_error (_("variable length item not allowed here")); - return cb_error_node; - } - memset (buff, 0, sizeof (buff)); - if (f->redefines) { - cb_validate_field (f->redefines); - if (f->rename_thru) { - cb_validate_field (f->rename_thru); - } - cb_validate_field (f); - sprintf (buff, FMT_LEN, f->size); - } else { - cb_validate_field (f); - sprintf (buff, FMT_LEN, f->memory_size); - } - return cb_build_numeric_literal (0, buff, 0); -} - -cb_tree -cb_build_const_from (cb_tree x) -{ - struct cb_define_struct *p; - - if (x == cb_error_node) { - return cb_error_node; - } - p = ppp_search_lists (CB_NAME(x)); - if (p == NULL - || p->deftype == PLEX_DEF_DEL) { - cb_error (_("'%s' has not been DEFINEd"), CB_NAME(x)); - return cb_error_node; - } - - if (p->deftype == PLEX_DEF_NUM) { - return cb_build_numeric_literal (0, p->value, 0); - } else { - return cb_build_alphanumeric_literal (p->value, (size_t)strlen(p->value)); - } -} - -/** - * build numeric literal for level 78 VALUE START OF with the offset - * of the given item - * - * Note: we don't return an error node even if an error occurs as this would - * trigger a "needs a VALUE clause" error - */ -cb_tree -cb_build_const_start (struct cb_field *f, cb_tree x) -{ - struct cb_field *target, *p; - char buff[32]; - - if (x == cb_error_node) { - return cb_error_node; - } - if (CB_REFERENCE_P (x)) { - if (cb_ref (x) == cb_error_node) { - return cb_error_node; - } - if (CB_REFERENCE (x)->offset) { - cb_error (_("reference modification not allowed here")); - return cb_build_numeric_literal (0, "1", 0); - } - } else { - cb_error (_("only field names allowed here")); - return cb_build_numeric_literal (0, "1", 0); - } - - target = CB_FIELD (cb_ref (x)); - if (!target) { - return cb_error_node; - } - if (!target->flag_external - && target->storage != CB_STORAGE_FILE - && target->storage != CB_STORAGE_LINKAGE) { - cb_error (_("VALUE of '%s': %s target '%s' is invalid"), - f->name, "START OF", target->name); - cb_error (_("target must be in FILE SECTION or LINKAGE SECTION or have the EXTERNAL clause")); - return cb_build_numeric_literal (0, "1", 0); - } - - if (target->flag_any_length) { - cb_error (_("ANY LENGTH item not allowed here")); - return cb_build_numeric_literal (0, "1", 0); - } - if (target->level == 88) { - cb_error (_("88 level item not allowed here")); - return cb_build_numeric_literal (0, "1", 0); - } - if (cb_field_variable_size (target)) { - cb_error (_("variable length item not allowed here")); - return cb_build_numeric_literal (0, "1", 0); - } - for (p = target; p; p = p->parent) { - p->flag_is_verified = 0; /* Force redo compute_size */ - p->flag_invalid = 0; - cb_validate_field (p); - if (cb_field_variable_size (p)) { - cb_error (_("variable length item not allowed here")); - return cb_build_numeric_literal (0, "1", 0); - } - } - snprintf (buff, sizeof(buff), "%d", target->offset); - for (p = target; p; p = p->parent) { - p->flag_is_verified = 0; /* Force redo compute_size */ - p->flag_invalid = 0; - } - return cb_build_numeric_literal (0, buff, 0); -} - -/** - * build numeric literal for level 78 VALUE NEXT with the offset - * at which the NEXT byte of storage occurs after the previous data declaration - * - * Important: this is NOT identical with START OF the next item as SYNC may - * set a different offset for it and when the previous data declaration has - * an OCCURS clause, the value returned by NEXT is the offset at which the next - * byte of storage occurs *after the first element* of the table - * - * Note: we don't return an error node even if an error occurs as this would - * trigger a "needs a VALUE clause" error - */ -cb_tree -cb_build_const_next (struct cb_field *f) -{ - struct cb_field *p; - char buff[32]; - struct cb_field *previous; - int sav_min, sav_max; - - previous = cb_get_real_field (); - - if (!previous) { - cb_error (_("VALUE of '%s': %s target is invalid"), - f->name, "NEXT"); - cb_error (_("no previous data-item found")); - return cb_build_numeric_literal (0, "1", 0); - } - - if (previous->storage != CB_STORAGE_FILE - && previous->storage != CB_STORAGE_LINKAGE) { - p = previous; - while (p->parent) { - p = p->parent; - } - if (!p->flag_external) { - cb_error (_("VALUE of '%s': %s target is invalid"), f->name, "NEXT"); - cb_error (_("target must be in FILE SECTION or LINKAGE SECTION or have the EXTERNAL clause")); - return cb_build_numeric_literal (0, "1", 0); - } - } - - /* - * Compute the size of the last and all its parent fields, - * later fields aren't parsed yet and are therefore not counted - */ - if (previous->level != 1) { - sav_min = previous->occurs_min; - sav_max = previous->occurs_max; - previous->occurs_min = previous->occurs_max = 1; - for (p = previous; p; p = p->parent) { - p->flag_is_verified = 0; /* Force compute_size */ - p->flag_invalid = 0; - cb_validate_field (p); - if (cb_field_variable_size (p)) { - cb_error (_("variable length item not allowed here")); - p->size = 0; - break; - } - if (!p->parent) { - break; - } - } - previous->occurs_min = sav_min; - previous->occurs_max = sav_max; - } else { - p = previous; - } - - snprintf (buff, sizeof (buff), "%d", p->size); - - /* Force compute_size for later access */ - for (p = previous; p; p = p->parent) { - p->flag_is_verified = 0; - p->flag_invalid = 0; - } - - return cb_build_numeric_literal (0, buff, 0); -} - -cb_tree -cb_build_length (cb_tree x) -{ - struct cb_field *f; - struct cb_literal *l; - cb_tree temp,z1,z2; - char buff[32]; - - if (x == cb_error_node) { - return cb_error_node; - } - if (CB_REFERENCE_P (x) && cb_ref (x) == cb_error_node) { - return cb_error_node; - } - - if (CB_LITERAL_P (x)) { - l = CB_LITERAL (x); - sprintf (buff, FMT_LEN, (int)l->size); - return cb_build_numeric_literal (0, buff, 0); - } - if (CB_INTRINSIC_P (x)) { - return cb_build_any_intrinsic (CB_LIST_INIT (x)); - } - if (cb_occurs_max_length_without_subscript - && CB_REFERENCE_P (x) - && CB_REFERENCE (x)->length == NULL - && CB_REFERENCE (x)->offset == NULL) { - f = CB_FIELD_PTR (x); - if (f->flag_occurs) { - if (!CB_REFERENCE (x)->subs) { - sprintf (buff, FMT_LEN, cb_field_size (x) * f->occurs_max); - return cb_build_numeric_literal (0, buff, 0); - } - } - if (cb_field_variable_size (f)) { - sprintf (buff, FMT_LEN, cb_field_size (x)); - return cb_build_numeric_literal (0, buff, 0); - } - } - if (CB_REF_OR_FIELD_P (x)) { - if (CB_REFERENCE_P (x) && CB_REFERENCE (x)->offset) { - return cb_build_any_intrinsic (CB_LIST_INIT (x)); - } - f = CB_FIELD_PTR (x); - /* CHECKME: Why do we need this in the first place? - Should be validated already, but isn't at least for some - RENAMES entries! */ - if (f->size == 0) { - cb_validate_field (f); - } - if (f->flag_any_length) { - return cb_build_any_intrinsic (CB_LIST_INIT (x)); - } - if (cb_field_variable_size (f) == NULL) { - sprintf (buff, FMT_LEN, cb_field_size (x)); - return cb_build_numeric_literal (0, buff, 0); - } - } - temp = cb_build_index (cb_build_filler (), NULL, 0, NULL); - CB_FIELD (cb_ref (temp))->usage = CB_USAGE_LENGTH; - CB_FIELD (cb_ref (temp))->count++; - CB_FIELD (cb_ref (temp))->pic->have_sign = 0; /* LENGTH is UNSIGNED */ - cb_emit (cb_build_assign (temp, cb_build_length_1 (x))); - - if (cb_pretty_display - && cobc_cs_check == CB_CS_DISPLAY) { - z1 = cb_build_filler (); - z2 = cb_build_field_tree (NULL, z1, NULL, CB_STORAGE_WORKING, NULL, 1); - CB_FIELD (z2)->pic = CB_PICTURE (cb_build_picture ("9(10)")); - CB_FIELD (z2)->flag_filler = 1; - CB_FIELD (z2)->usage = CB_USAGE_DISPLAY; - CB_FIELD (z2)->count++; - cb_validate_field (CB_FIELD (z2)); - cb_emit (CB_BUILD_FUNCALL_2 ("cob_field_int_display",temp,z2)); - return z1; - } - return temp; -} - -cb_tree -cb_build_ppointer (cb_tree x) -{ - struct cb_field *f; - - if (x == cb_error_node || - (CB_REFERENCE_P (x) && cb_ref (x) == cb_error_node)) { - return cb_error_node; - } - - if (CB_REFERENCE_P (x)) { - f = CB_FIELD_PTR (cb_ref(x)); - f->count++; - } - return CB_BUILD_CAST_PPOINTER (x); -} - -/* Validate program */ - -static int -get_value (cb_tree x) -{ - if (x == cb_space) { - return ' '; - } else if (x == cb_zero) { - return '0'; - } else if (x == cb_quote) { - return cb_flag_apostrophe ? '\'' : '"'; - } else if (x == cb_norm_low) { - return 0; - } else if (x == cb_norm_high) { - return 255; - } else if (x == cb_null) { - return 0; - } else if (CB_TREE_CLASS (x) == CB_CLASS_NUMERIC) { - return cb_get_int (x) - 1; - } - return CB_LITERAL (x)->data[0]; -} - -static int -cb_validate_collating (cb_tree collating_sequence) -{ - cb_tree x; - - if (!collating_sequence) { - return 0; - } - - x = cb_ref (collating_sequence); - if (!CB_ALPHABET_NAME_P (x)) { - cb_error_x (collating_sequence, _("'%s' is not an alphabet name"), - cb_name (collating_sequence)); - return 1; - } - if (CB_ALPHABET_NAME (x)->alphabet_type != CB_ALPHABET_CUSTOM) { - return 0; - } - if (CB_ALPHABET_NAME (x)->low_val_char) { - cb_low = cb_build_alphanumeric_literal ("\0", (size_t)1); - CB_LITERAL(cb_low)->data[0] = (unsigned char)CB_ALPHABET_NAME (x)->low_val_char; - CB_LITERAL(cb_low)->all = 1; - } - if (CB_ALPHABET_NAME (x)->high_val_char != 255){ - cb_high = cb_build_alphanumeric_literal ("\0", (size_t)1); - CB_LITERAL(cb_high)->data[0] = (unsigned char)CB_ALPHABET_NAME (x)->high_val_char; - CB_LITERAL(cb_high)->all = 1; - } - return 0; -} - -void -cb_validate_program_environment (struct cb_program *prog) -{ - cb_tree x; - cb_tree y; - cb_tree l; - cb_tree ls; - struct cb_alphabet_name *ap; - struct cb_class_name *cp; - unsigned char *data; - size_t dupls; - size_t unvals; - size_t count; - int lower; - int upper; - int size; - int n; - int i; - int pos; - int lastval; - int tableval; - int values[256]; - int charvals[256]; - int dupvals[256]; - char errmsg[256]; - - /* Check ALPHABET clauses */ - /* Complicated by difference between code set and collating sequence */ - for (l = prog->alphabet_name_list; l; l = CB_CHAIN (l)) { - ap = CB_ALPHABET_NAME (CB_VALUE (l)); - - /* Native */ - if (ap->alphabet_type == CB_ALPHABET_NATIVE) { - for (n = 0; n < 256; n++) { - ap->values[n] = n; - ap->alphachr[n] = n; - } - continue; - } - - /* ASCII */ - if (ap->alphabet_type == CB_ALPHABET_ASCII) { - for (n = 0; n < 256; n++) { -#ifdef COB_EBCDIC_MACHINE - ap->values[n] = (int)cob_refer_ascii[n]; - ap->alphachr[n] = (int)cob_refer_ascii[n]; -#else - ap->values[n] = n; - ap->alphachr[n] = n; -#endif - } - continue; - } - - /* EBCDIC */ - if (ap->alphabet_type == CB_ALPHABET_EBCDIC) { - for (n = 0; n < 256; n++) { -#ifdef COB_EBCDIC_MACHINE - ap->values[n] = n; - ap->alphachr[n] = n; -#else - ap->values[n] = (int)cob_refer_ebcdic[n]; - ap->alphachr[n] = (int)cob_refer_ebcdic[n]; -#endif - } - continue; - } - - /* Custom alphabet */ - dupls = 0; - unvals = 0; - pos = 0; - count = 0; - lastval = 0; - tableval = 0; - for (n = 0; n < 256; n++) { - values[n] = -1; - charvals[n] = -1; - dupvals[n] = -1; - ap->values[n] = -1; - ap->alphachr[n] = -1; - } - ap->low_val_char = 0; - ap->high_val_char = 255; - for (y = ap->custom_list; y; y = CB_CHAIN (y)) { - pos++; - if (count > 255) { - unvals = pos; - break; - } - x = CB_VALUE (y); - if (CB_PAIR_P (x)) { - /* X THRU Y */ - lower = get_value (CB_PAIR_X (x)); - upper = get_value (CB_PAIR_Y (x)); - lastval = upper; - if (!count) { - ap->low_val_char = lower; - } - if (lower < 0 || lower > 255) { - unvals = pos; - continue; - } - if (upper < 0 || upper > 255) { - unvals = pos; - continue; - } - if (lower <= upper) { - for (i = lower; i <= upper; i++) { - if (values[i] != -1) { - dupvals[i] = i; - dupls = 1; - } - values[i] = i; - charvals[i] = i; - ap->alphachr[tableval] = i; - ap->values[i] = tableval++; - count++; - } - } else { - for (i = lower; i >= upper; i--) { - if (values[i] != -1) { - dupvals[i] = i; - dupls = 1; - } - values[i] = i; - charvals[i] = i; - ap->alphachr[tableval] = i; - ap->values[i] = tableval++; - count++; - } - } - } else if (CB_LIST_P (x)) { - /* X ALSO Y ... */ - if (!count) { - ap->low_val_char = get_value (CB_VALUE (x)); - } - for (ls = x; ls; ls = CB_CHAIN (ls)) { - n = get_value (CB_VALUE (ls)); - if (!CB_CHAIN (ls)) { - lastval = n; - } - if (n < 0 || n > 255) { - unvals = pos; - continue; - } - if (values[n] != -1) { - dupvals[n] = n; - dupls = 1; - } - values[n] = n; - ap->values[n] = tableval; - if (ls == x) { - ap->alphachr[tableval] = n; - charvals[n] = n; - } - count++; - } - tableval++; - } else { - /* Literal */ - if (CB_NUMERIC_LITERAL_P (x)) { - n = get_value (x); - lastval = n; - if (!count) { - ap->low_val_char = n; - } - if (n < 0 || n > 255) { - unvals = pos; - continue; - } - if (values[n] != -1) { - dupvals[n] = n; - dupls = 1; - } - values[n] = n; - charvals[n] = n; - ap->alphachr[tableval] = n; - ap->values[n] = tableval++; - count++; - } else if (CB_LITERAL_P (x)) { - size = (int)CB_LITERAL (x)->size; - data = CB_LITERAL (x)->data; - if (!count) { - ap->low_val_char = data[0]; - } - lastval = data[size - 1]; - for (i = 0; i < size; i++) { - n = data[i]; - if (values[n] != -1) { - dupvals[n] = n; - dupls = 1; - } - values[n] = n; - charvals[n] = n; - ap->alphachr[tableval] = n; - ap->values[n] = tableval++; - count++; - } - } else { - n = get_value (x); - lastval = n; - if (!count) { - ap->low_val_char = n; - } - if (n < 0 || n > 255) { - unvals = pos; - continue; - } - if (values[n] != -1) { - dupls = 1; - } - values[n] = n; - charvals[n] = n; - ap->alphachr[tableval] = n; - ap->values[n] = tableval++; - count++; - } - } - } - if (dupls || unvals) { - if (dupls) { - i = 0; - for (n = 0; n < 256; n++) { - if (dupvals[n] != -1) { - if (i > 240) { - sprintf(&errmsg[i], ", ..."); - i = i + 5; - break; - } - if (i) { - sprintf(&errmsg[i], ", "); - i = i + 2; - } - if (isprint(n)) { - errmsg[i++] = (char)n; - } else { - sprintf(&errmsg[i], "x'%02x'", n); - i = i + 5; - } - }; - } - errmsg[i] = 0; - cb_error_x (CB_VALUE(l), - _("duplicate character values in alphabet '%s': %s"), - ap->name, errmsg); - } - if (unvals) { - cb_error_x (CB_VALUE(l), - _("invalid character values in alphabet '%s', starting at position %d"), - ap->name, pos); - } - ap->low_val_char = 0; - ap->high_val_char = 255; - continue; - } - /* Calculate HIGH-VALUE */ - /* If all 256 values have been specified, */ - /* HIGH-VALUE is the last one */ - /* Otherwise if HIGH-VALUE has been specified, find the highest */ - /* value that has not been used */ - if (count == 256) { - ap->high_val_char = lastval; - } else if (values[255] != -1) { - for (n = 254; n >= 0; n--) { - if (values[n] == -1) { - ap->high_val_char = n; - break; - } - } - } - - /* Get rest of code set */ - for (n = tableval; n < 256; ++n) { - for (i = 0; i < 256; ++i) { - if (charvals[i] < 0) { - charvals[i] = 0; - ap->alphachr[n] = i; - break; - } - } - } - - /* Fill in missing characters */ - for (n = 0; n < 256; n++) { - if (ap->values[n] < 0) { - ap->values[n] = tableval++; - } - } - } - - /* Reset HIGH/LOW-VALUES */ - cb_low = cb_norm_low; - cb_high = cb_norm_high; - - /* Check and generate SYMBOLIC clauses */ - for (l = prog->symbolic_char_list; l; l = CB_CHAIN (l)) { - if (CB_VALUE (l)) { - y = cb_ref (CB_VALUE (l)); - if (y == cb_error_node) { - continue; - } - if (!CB_ALPHABET_NAME_P (y)) { - cb_error_x (y, _("invalid ALPHABET name")); - continue; - } - } else { - y = NULL; - } - cb_build_symbolic_chars (CB_PURPOSE (l), y); - } - - /* Check CLASS clauses */ - for (l = prog->class_name_list; l; l = CB_CHAIN (l)) { - cp = CB_CLASS_NAME (CB_VALUE (l)); - /* LCOV_EXCL_START */ - if (cp == NULL) { /* keep the analyzer happy... */ - cobc_err_msg ("invalid CLASS detected"); /* not translated as highly unlikely */ - COBC_ABORT (); - } - /* LCOV_EXCL_STOP */ - dupls = 0; - memset (values, 0, sizeof(values)); - for (y = cp->list; y; y = CB_CHAIN (y)) { - x = CB_VALUE (y); - if (CB_PAIR_P (x)) { - /* X THRU Y */ - lower = get_value (CB_PAIR_X (x)); - upper = get_value (CB_PAIR_Y (x)); - for (i = lower; i <= upper; i++) { - if (values[i]) { - dupls = 1; - } else { - values[i] = 1; - } - } - } else { - if (CB_NUMERIC_LITERAL_P (x)) { - n = get_value (x); - if (values[n]) { - dupls = 1; - } else { - values[n] = 1; - } - } else if (CB_LITERAL_P (x)) { - size = (int)CB_LITERAL (x)->size; - data = CB_LITERAL (x)->data; - for (i = 0; i < size; i++) { - n = data[i]; - if (values[n]) { - dupls = 1; - } else { - values[n] = 1; - } - } - } else { - n = get_value (x); - if (values[n]) { - dupls = 1; - } else { - values[n] = 1; - } - } - } - } - if (dupls) { - cb_warning_x (cb_warn_extra, CB_VALUE(l), - _("duplicate character values in class '%s'"), - cb_name (CB_VALUE(l))); - } - } - - /* Resolve the program collating sequences */ - if (cb_validate_collating (prog->collating_sequence)) { - prog->collating_sequence = NULL; - }; - if (cb_validate_collating (prog->collating_sequence_n)) { - prog->collating_sequence_n = NULL; - }; - - /* Resolve the program classification */ - if (prog->classification && prog->classification != cb_int1) { - x = cb_ref (prog->classification); - if (!CB_LOCALE_NAME_P (x)) { - cb_error_x (prog->classification, - _("'%s' is not a locale name"), - cb_name (prog->classification)); - prog->classification = NULL; - return; - } - } -} - -/* default (=minimal) size of DEBUG-CONTENTS */ -#ifdef DFLT_DEBUG_CONTENTS_SIZE -#if DFLT_DEBUG_CONTENTS_SIZE < 13 -#undef DFLT_DEBUG_CONTENTS_SIZE -#define DFLT_DEBUG_CONTENTS_SIZE 13 /* Lenght of fixed values */ -#endif -#else -#define DFLT_DEBUG_CONTENTS_SIZE 30 -#endif - - -void -cb_build_debug_item (void) -{ - cb_tree l; - cb_tree x; - cb_tree lvl01_tree; - - /* Set up DEBUG-ITEM */ - l = cb_build_reference ("DEBUG-ITEM"); - lvl01_tree = cb_build_field_tree (NULL, l, NULL, CB_STORAGE_WORKING, - NULL, 1); - CB_FIELD (lvl01_tree)->values = CB_LIST_INIT (cb_space); - cb_debug_item = l; - - l = cb_build_reference ("DEBUG-LINE"); - x = cb_build_field_tree (NULL, l, CB_FIELD(lvl01_tree), - CB_STORAGE_WORKING, NULL, 3); - CB_FIELD (x)->pic = CB_PICTURE (cb_build_picture ("X(6)")); - cb_validate_field (CB_FIELD (x)); - cb_debug_line = l; - - l = cb_build_filler (); - x = cb_build_field_tree (NULL, l, CB_FIELD(x), - CB_STORAGE_WORKING, NULL, 3); - CB_FIELD (x)->pic = CB_PICTURE (cb_build_picture ("X")); - CB_FIELD (x)->flag_filler = 1; - cb_validate_field (CB_FIELD (x)); - - l = cb_build_reference ("DEBUG-NAME"); - x = cb_build_field_tree (NULL, l, CB_FIELD(x), - CB_STORAGE_WORKING, NULL, 3); - CB_FIELD (x)->pic = CB_PICTURE (cb_build_picture ("X(30)")); - cb_validate_field (CB_FIELD (x)); - cb_debug_name = l; - - l = cb_build_filler (); - x = cb_build_field_tree (NULL, l, CB_FIELD(x), - CB_STORAGE_WORKING, NULL, 3); - CB_FIELD (x)->pic = CB_PICTURE (cb_build_picture ("X")); - CB_FIELD (x)->flag_filler = 1; - cb_validate_field (CB_FIELD (x)); - - l = cb_build_reference ("DEBUG-SUB-1"); - x = cb_build_field_tree (NULL, l, CB_FIELD(x), - CB_STORAGE_WORKING, NULL, 3); - CB_FIELD (x)->pic = CB_PICTURE (cb_build_picture ("S9(4)")); - CB_FIELD (x)->flag_sign_leading = 1; - CB_FIELD (x)->flag_sign_separate = 1; - cb_validate_field (CB_FIELD (x)); - cb_debug_sub_1 = l; - - l = cb_build_filler (); - x = cb_build_field_tree (NULL, l, CB_FIELD(x), - CB_STORAGE_WORKING, NULL, 3); - CB_FIELD (x)->pic = CB_PICTURE (cb_build_picture ("X")); - CB_FIELD (x)->flag_filler = 1; - cb_validate_field (CB_FIELD (x)); - - l = cb_build_reference ("DEBUG-SUB-2"); - x = cb_build_field_tree (NULL, l, CB_FIELD(x), - CB_STORAGE_WORKING, NULL, 3); - CB_FIELD (x)->pic = CB_PICTURE (cb_build_picture ("S9(4)")); - CB_FIELD (x)->flag_sign_leading = 1; - CB_FIELD (x)->flag_sign_separate = 1; - cb_validate_field (CB_FIELD (x)); - cb_debug_sub_2 = l; - - l = cb_build_filler (); - x = cb_build_field_tree (NULL, l, CB_FIELD(x), - CB_STORAGE_WORKING, NULL, 3); - CB_FIELD (x)->pic = CB_PICTURE (cb_build_picture ("X")); - CB_FIELD (x)->flag_filler = 1; - cb_validate_field (CB_FIELD (x)); - - l = cb_build_reference ("DEBUG-SUB-3"); - x = cb_build_field_tree (NULL, l, CB_FIELD(x), - CB_STORAGE_WORKING, NULL, 3); - CB_FIELD (x)->pic = CB_PICTURE (cb_build_picture ("S9(4)")); - CB_FIELD (x)->flag_sign_leading = 1; - CB_FIELD (x)->flag_sign_separate = 1; - cb_validate_field (CB_FIELD (x)); - cb_debug_sub_3 = l; - - l = cb_build_filler (); - x = cb_build_field_tree (NULL, l, CB_FIELD(x), - CB_STORAGE_WORKING, NULL, 3); - CB_FIELD (x)->pic = CB_PICTURE (cb_build_picture ("X")); - CB_FIELD (x)->flag_filler = 1; - cb_validate_field (CB_FIELD (x)); - - l = cb_build_reference ("DEBUG-CONTENTS"); - x = cb_build_field_tree (NULL, l, CB_FIELD(x), - CB_STORAGE_WORKING, NULL, 3); - CB_FIELD (x)->pic = CB_PICTURE ( - cb_build_picture ("X(" CB_XSTRINGIFY(DFLT_DEBUG_CONTENTS_SIZE) ")")); - cb_validate_field (CB_FIELD (x)); - cb_debug_contents = l; - - cb_validate_field (CB_FIELD (lvl01_tree)); - CB_FIELD_ADD (current_program->working_storage, CB_FIELD (lvl01_tree)); -} - -static void -validate_record_depending (cb_tree x) -{ - struct cb_field *p; - cb_tree r; - - /* get reference (and check if it exists) */ - r = cb_ref (x); - if (r == cb_error_node) { - return; - } -#if 0 /* Simon: Why should we use a reference here? */ - if (CB_REF_OR_FIELD_P(x)) { - cb_error_x (x, _("invalid RECORD DEPENDING item")); - return; - } -#else - if (!CB_FIELD_P(r)) { - cb_error_x (x, _("RECORD DEPENDING must reference a data-item")); - return; - } -#endif - p = CB_FIELD_PTR (x); - switch (p->storage) { - case CB_STORAGE_WORKING: - case CB_STORAGE_LOCAL: - case CB_STORAGE_LINKAGE: - break; - default: - /* RXWRXW - This breaks old legacy programs; FIXME: use compiler configuration */ - { - enum cb_support missing_compiler_config; - if (!cb_relaxed_syntax_checks - || cb_warn_extra == COBC_WARN_AS_ERROR) { - missing_compiler_config = CB_ERROR; - } else if (cb_warn_extra == COBC_WARN_ENABLED) { - missing_compiler_config = CB_WARNING; - } else { - missing_compiler_config = CB_OK; - } - cb_warning_dialect_x (missing_compiler_config, x, - _("RECORD DEPENDING item '%s' should be defined in " - "WORKING-STORAGE, LOCAL-STORAGE or LINKAGE SECTION"), p->name); - } - } -} - -static void -validate_relative_key_field (struct cb_file *file) -{ - struct cb_field *key_field = CB_FIELD_PTR (file->key); - - if (CB_TREE_CATEGORY (key_field) != CB_CATEGORY_NUMERIC) { - cb_error_x (file->key, - _("file %s: RELATIVE KEY %s is not numeric"), - file->name, key_field->name); - } - - /* TO-DO: Check if key_field is an integer based on USAGE */ - if (key_field->pic != NULL) { - if (key_field->pic->category == CB_CATEGORY_NUMERIC - && key_field->pic->scale != 0) { - cb_error_x (file->key, - _("file %s: RELATIVE KEY %s must be integer"), - file->name, key_field->name); - } - if (key_field->pic->have_sign) { - cb_error_x (file->key, - _("file %s: RELATIVE KEY %s must be unsigned"), - file->name, key_field->name); - } - } - - if (key_field->flag_occurs) { - cb_error_x (file->key, - _("file %s: RELATIVE KEY %s cannot have OCCURS"), - file->name, key_field->name); - } - - if (cb_field_founder (key_field)->file == file) { - cb_error_x (file->key, - _("RELATIVE KEY %s cannot be in file record belonging to %s"), - key_field->name, file->name); - } - -#if 0 /* Simon: deemed to be not neccessary, see related bug #421 */ - if (key_field->storage != CB_STORAGE_WORKING - && key_field->storage != CB_STORAGE_FILE - && key_field->storage != CB_STORAGE_LOCAL) { - cb_verify_x (file->key, cb_select_working, - _("file %s: RELATIVE KEY %s declared outside WORKING-STORAGE"), - file->name, key_field->name); - } -#endif -} - -static cb_tree -cb_validate_crt_status (cb_tree ref, cb_tree field_tree) { - struct cb_field *field; - /* LCOV_EXCL_START */ - if (ref == NULL || !CB_REFERENCE_P (ref)) { - cobc_err_msg (_("call to '%s' with invalid parameter '%s'"), - "cb_validate_crt_status", "ref");; - COBC_ABORT (); - } - /* LCOV_EXCL_STOP */ - if (field_tree == NULL) { - field_tree = cb_ref (ref); - } - if (field_tree == cb_error_node) { - return NULL; - } - if (!CB_FIELD_P (field_tree)) { - cb_error_x (ref, _("'%s' is not a valid data name"), cb_name (ref)); - return NULL; - } - field = CB_FIELD (field_tree); - if (field->storage != CB_STORAGE_WORKING - && field->storage != CB_STORAGE_LOCAL) { - cb_error_x (ref, - _("CRT STATUS item '%s' should be defined in " - "WORKING-STORAGE or LOCAL-STORAGE"), field->name); - return NULL; - } - if (CB_TREE_CATEGORY (field_tree) == CB_CATEGORY_NUMERIC) { - if (field->size < 4) { - cb_error_x (ref, _("'%s' CRT STATUS must have at least 4 digits"), - field->name); - return NULL; - } - } - else if (field->size != 4) { - cb_error_x (ref, _("'%s' CRT STATUS must be 4 characters long"), - field->name); - return NULL; - } - return ref; -} - -static void -create_implicit_assign_dynamic_var (struct cb_program * const prog, - cb_tree assign) -{ - cb_tree x; - struct cb_field *p; - - if (cb_warn_implicit_define) { - cb_warning (cb_warn_implicit_define, - _("variable '%s' will be implicitly defined"), CB_NAME (assign)); - } - x = cb_build_implicit_field (assign, COB_SMALL_BUFF); - CB_FIELD (x)->count++; - p = prog->working_storage; - if (p) { - while (p->sister) { - p = p->sister; - } - p->sister = CB_FIELD (x); - } else { - prog->working_storage = CB_FIELD (x); - } - -} - -static void -process_undefined_assign_name (struct cb_file * const f, - struct cb_program * const prog) -{ - cb_tree assign = f->assign; - cb_tree l; - cb_tree ll; - - if (f->assign_type != CB_ASSIGN_VARIABLE_DEFAULT) { - /* An error is emitted later */ - return; - } - - /* - Either create a variable or treat the assign name as an external-file- - name. - */ - if (cb_implicit_assign_dynamic_var) { - cb_verify_x (CB_TREE (f), cb_assign_variable, _("ASSIGN variable")); - create_implicit_assign_dynamic_var (prog, assign); - } else { - /* Remove reference */ - for (l = prog->reference_list; - CB_VALUE (l) != assign && CB_VALUE (CB_CHAIN (l)) != assign; - l = CB_CHAIN (l)); - if (CB_VALUE (l) == assign) { - prog->reference_list = CB_CHAIN (l); - } else { - ll = CB_CHAIN (CB_CHAIN (l)); - cobc_parse_free (CB_CHAIN (l)); - CB_CHAIN (l) = ll; - } - - /* Reinterpret word */ - f->assign = build_external_assignment_name (assign); - } -} - -/* Ensure ASSIGN name refers to a valid identifier */ -static void -validate_assign_name (struct cb_file * const f, - struct cb_program * const prog) -{ - cb_tree assign = f->assign; - cb_tree x; - struct cb_field *p; - unsigned char *c; - - if (!assign) { - return; - } - - if (!CB_REFERENCE_P (assign)) { - return; - } - - /* Error if assign name is same as a file name */ - for (x = prog->file_list; x; x = CB_CHAIN (x)) { - if (!strcmp (CB_FILE (CB_VALUE (x))->name, - CB_NAME (assign))) { - redefinition_error (assign); - } - } - - /* If assign is a 78-level, change assign to the 78-level's literal. */ - p = check_level_78 (CB_NAME (assign)); - if (p) { - c = (unsigned char *)CB_LITERAL(CB_VALUE(p->values))->data; - assign = CB_TREE (build_literal (CB_CATEGORY_ALPHANUMERIC, c, strlen ((char *)c))); - f->assign = assign; - return; - } - - if (CB_WORD_COUNT (assign) == 0) { - process_undefined_assign_name (f, prog); - } else { - /* - We now know we have a variable, so can validate whether it is - is allowed - */ - if (f->flag_assign_no_keyword) { - cb_verify_x (CB_TREE (f), cb_assign_variable, _("ASSIGN variable")); - } - - x = cb_ref (assign); - if (CB_FIELD_P (x) && CB_FIELD (x)->level == 88) { - cb_error_x (assign, _("ASSIGN data item '%s' is invalid"), - CB_NAME (assign)); - } - } -} - -void -cb_validate_program_data (struct cb_program *prog) -{ - cb_tree l, x; - struct cb_field *p; - struct cb_field *q; - struct cb_field *field; - struct cb_file *file; - char buff[COB_MINI_BUFF]; - - prog->report_list = cb_list_reverse (prog->report_list); - - for (l = prog->report_list; l; l = CB_CHAIN (l)) { - /* Set up LINE-COUNTER / PAGE-COUNTER */ - struct cb_report *rep = CB_REPORT (CB_VALUE (l)); - if (rep->line_counter == NULL) { - snprintf (buff, (size_t)COB_MINI_MAX, - "LINE-COUNTER %s", rep->cname); - x = cb_build_field (cb_build_reference (buff)); - CB_FIELD (x)->usage = CB_USAGE_UNSIGNED_INT; - CB_FIELD (x)->values = CB_LIST_INIT (cb_zero); - CB_FIELD (x)->count++; - cb_validate_field (CB_FIELD (x)); - rep->line_counter = cb_build_field_reference (CB_FIELD (x), NULL); - CB_FIELD_ADD (prog->working_storage, CB_FIELD (x)); - } - if (rep->page_counter == NULL) { - snprintf (buff, (size_t)COB_MINI_MAX, - "PAGE-COUNTER %s", rep->cname); - x = cb_build_field (cb_build_reference (buff)); - CB_FIELD (x)->usage = CB_USAGE_UNSIGNED_INT; - CB_FIELD (x)->values = CB_LIST_INIT (cb_zero); - CB_FIELD (x)->count++; - cb_validate_field (CB_FIELD (x)); - rep->page_counter = cb_build_field_reference (CB_FIELD (x), NULL); - CB_FIELD_ADD (prog->working_storage, CB_FIELD (x)); - } - } - - prog->file_list = cb_list_reverse (prog->file_list); - - for (l = prog->file_list; l; l = CB_CHAIN (l)) { - file = CB_FILE (CB_VALUE (l)); - if (!file->flag_finalized) { - finalize_file (file, NULL); - } - } - - /* Build undeclared assignment names now */ - for (l = prog->file_list; l; l = CB_CHAIN (l)) { - validate_assign_name (CB_FILE (CB_VALUE (l)), prog); - } - - if (prog->cursor_pos) { - x = cb_ref (prog->cursor_pos); - if (x == cb_error_node) { - prog->cursor_pos = NULL; - } else if (CB_FIELD(x)->size != 6 && CB_FIELD(x)->size != 4) { - cb_error_x (prog->cursor_pos, _("'%s' CURSOR must be 4 or 6 characters long"), - cb_name (prog->cursor_pos)); - prog->cursor_pos = NULL; - } - } - if (prog->crt_status) { - prog->crt_status = cb_validate_crt_status (prog->crt_status, NULL); - } else { - /* TO-DO: Add to registers list */ - l = cb_build_reference ("COB-CRT-STATUS"); - x = cb_try_ref (l); - if (x == cb_error_node) { - p = CB_FIELD (cb_build_field (l)); - p->usage = CB_USAGE_DISPLAY; - p->pic = CB_PICTURE (cb_build_picture ("9(4)")); - cb_validate_field (p); - p->flag_no_init = 1; - /* Do not initialize/bump ref count here - p->values = CB_LIST_INIT (cb_zero); - p->count++; - */ - CB_FIELD_ADD (prog->working_storage, p); - prog->crt_status = l; - } else { - prog->crt_status = cb_validate_crt_status (l, x); - } - } - - /* Resolve all references so far */ - for (l = cb_list_reverse (prog->reference_list); l; l = CB_CHAIN (l)) { - cb_ref (CB_VALUE (l)); - } - - /* Check ODO items */ - for (l = cb_depend_check; l; l = CB_CHAIN (l)) { - struct cb_field *depfld = NULL; - unsigned int odo_level = 0; - cb_tree xerr = NULL; - x = CB_VALUE (l); - if (x == NULL || x == cb_error_node) { - continue; - } - q = CB_FIELD_PTR (x); - if (cb_validate_one (q->depending)) { - q->depending = cb_error_node; - } else if (cb_ref (q->depending) != cb_error_node) { - depfld = CB_FIELD_PTR (q->depending); - if (chk_field_variable_address (depfld) ) { - if (cb_depending_on_not_fixed == CB_WARNING) { - cb_warning_x (COBC_WARN_FILLER, CB_TREE (depfld), - _("%s does not have a fixed location"),depfld->name); - } else - if (cb_depending_on_not_fixed == CB_ERROR) { - cb_error_x (CB_TREE (depfld), - _("%s does not have a fixed location"),depfld->name); - } - } - } - /* The data item that contains a OCCURS DEPENDING clause must be - the last data item in the group */ - for (p = q; ; p = p->parent) { - if (p->depending) { - if (odo_level > 0 - && !cb_flag_odoslide) { - xerr = x; - cb_error_x (x, - _ ("'%s' cannot have nested OCCURS DEPENDING"), - cb_name (x)); - } - odo_level++; - } - p->odo_level = odo_level; - if (!p->parent) { - break; - } - for (; p->sister; p = p->sister) { - if (p->sister->level == 66) continue; - if (p->sister == depfld && x != xerr) { - xerr = x; - cb_error_x (x, - _("'%s' OCCURS DEPENDING ON field item invalid here"), - p->sister->name); - } - if (!p->sister->redefines) { - if (!cb_complex_odo - && x != xerr) { - xerr = x; - cb_error_x (x, - _ ("'%s' cannot have OCCURS DEPENDING because of '%s'"), - cb_name (x), p->sister->name); - break; - } - p->flag_odo_relative = 1; - } - } - } - - /* If the field is GLOBAL, then the ODO must also be GLOBAL */ - if (q->flag_is_global && depfld) { - if (!depfld->flag_is_global) { - cb_error_x (x, _("'%s' OCCURS DEPENDING ON item must have GLOBAL attribute"), - depfld->name); - } - } - } - cb_depend_check = NULL; - cb_needs_01 = 0; - - /* file definition checks */ - for (l = prog->file_list; l; l = CB_CHAIN (l)) { - file = CB_FILE (CB_VALUE (l)); - if (file->flag_external) { - if (CB_VALID_TREE (file->password) - && !CB_FIELD (cb_ref(file->password))->flag_external) { - cb_error_x (file->password, _("PASSWORD '%s' for EXTERNAL file '%s' must have EXTERNAL attribute"), - CB_NAME (file->password), file->name); - } - } - if (CB_VALID_TREE (file->record_depending)) { - validate_record_depending (file->record_depending); - } - if (file->organization == COB_ORG_RELATIVE && file->key - && cb_ref (file->key) != cb_error_node) { - validate_relative_key_field (file); - } -#if 0 /* Simon: deemed to be not neccessary, see related bug #421 */ - if (file->assign != NULL) { - if (CB_LITERAL_P (file->assign)) { - /* ASSIGN TO 'literal' */ - } else if ((CB_REFERENCE_P (file->assign) - && cb_ref (file->assign) != cb_error_node) - || CB_FIELD_P (file->assign)) { - field = CB_FIELD_PTR (file->assign); - if (field->storage != CB_STORAGE_WORKING - field->storage != CB_STORAGE_FILE - field->storage != CB_STORAGE_LOCAL) { - cb_verify_x(file->assign, cb_select_working, - _("file %s: ASSIGN %s declared outside WORKING-STORAGE"), - file->name, field->name); - } - } - } -#endif - } - - /* check alphabets */ - for (l = current_program->alphabet_name_list; l; l = CB_CHAIN(l)) { - struct cb_alphabet_name *alphabet = CB_ALPHABET_NAME (CB_VALUE(l)); - if (alphabet->alphabet_type == CB_ALPHABET_LOCALE) { - x = cb_ref (alphabet->custom_list); - if (x != cb_error_node && !CB_LOCALE_NAME_P(x)) { - cb_error_x (alphabet->custom_list, _("'%s' is not a locale-name"), - cb_name(x)); - alphabet->custom_list = cb_error_node; - } - } - } - - /* Resolve APPLY COMMIT */ - if (CB_VALID_TREE(prog->apply_commit)) { - for (l = prog->apply_commit; l; l = CB_CHAIN(l)) { - cb_tree l2 = CB_VALUE (l); - x = cb_ref (l2); - for (l2 = prog->apply_commit; l2 != l; l2 = CB_CHAIN(l2)) { - if (cb_ref (CB_VALUE (l2)) == x) { - if (x != cb_error_node) { - cb_error_x (l, - _("duplicate APPLY COMMIT target: '%s'"), - cb_name (CB_VALUE (l))); - x = cb_error_node; - break; - } - } - } - if (x == cb_error_node) { - continue; - } - if (CB_FILE_P (x)) { - file = CB_FILE (x); - if (file->organization == COB_ORG_SORT) { - cb_error_x (l, - _("APPLY COMMIT statement invalid for SORT file")); - } else if (file->flag_report) { - cb_error_x (l, - _("APPLY COMMIT statement invalid for REPORT file")); - } - } else if (CB_FIELD_P (x)) { - field = CB_FIELD (x); - if (field->storage != CB_STORAGE_WORKING - && field->storage != CB_STORAGE_LOCAL) { - cb_error_x (l, - _("APPLY COMMIT item '%s' should be defined in " - "WORKING-STORAGE or LOCAL-STORAGE"), field->name); - } - if (field->level != 01 && field->level != 77) { - cb_error_x (l, _("'%s' not level 01 or 77"), field->name); -#if 0 /* currently not part of the rules */ - } else if (field->flag_item_based || field->flag_external) { - cb_error_x (l, _("'%s' cannot be BASED/EXTERNAL"), field->name); -#endif - } else if (field->redefines) { - cb_error_x (l, _("'%s' REDEFINES field not allowed here"), - field->name); - } - } else { - cb_error_x (l, _("item not allowed here: '%s'"), cb_name (x)); - } - } - } -} - - -static int -error_if_subscript_or_refmod (cb_tree ref, const char *name) -{ - int error = 0; - - if (CB_REFERENCE (ref)->subs) { - cb_error_x (ref, _("%s may not be subscripted"), name); - error = 1; - } - if (CB_REFERENCE (ref)->offset) { - cb_error_x (ref, _("%s may not be reference modified"), name); - error = 1; - } - - return error; -} - -static int -has_sub_reference (struct cb_field *fld) -{ - struct cb_field *f; - - if (fld->count) { - return 1; - } - if (fld->validation) { - for (f = fld->validation; f; f = f->sister) { - if (f->count) { - return 1; - } - } - } else { - for (f = fld->children; f; f = f->sister) { - if (has_sub_reference (f)) { - return 1; - } - } - for (f = fld->sister; f; f = f->sister) { - if (f->redefines == fld) { - if (has_sub_reference (f)) { - return 1; - } - } - } - } - return 0; -} - -/* Resolve DEBUG references, return necessary size for DEBUG-CONTENTS */ -static int -cb_resolve_debug_refs (struct cb_program *prog, int size) -{ - cb_tree l; - cb_tree x; - cb_tree v; - - /* For data items, we may need to adjust the size of DEBUG-CONTENTS directly, - for file items from its maximum length */ - for (l = prog->debug_list; l; l = CB_CHAIN (l)) { - x = CB_VALUE (l); - (void)cb_set_ignore_error (CB_REFERENCE (x)->flag_ignored); - v = cb_ref (x); - if (v == cb_error_node) { - continue; - } - current_section = CB_REFERENCE (x)->section; - current_paragraph = CB_REFERENCE (x)->paragraph; - switch (CB_TREE_TAG (v)) { - case CB_TAG_LABEL: - if (!CB_LABEL (v)->flag_real_label) { - cb_error_x (x, _("DEBUGGING target invalid: '%s'"), - cb_name (x)); - } else if (CB_LABEL (v)->flag_debugging_mode) { - cb_error_x (x, _("duplicate DEBUGGING target: '%s'"), - cb_name (x)); - } else if (prog->all_procedure) { - cb_error_x (x, _("DEBUGGING target already specified with ALL PROCEDURES: '%s'"), - cb_name (x)); - CB_LABEL (v)->flag_debugging_mode = 1; - } else { - CB_LABEL (v)->debug_section = - CB_REFERENCE (x)->debug_section; - CB_LABEL (v)->flag_debugging_mode = 1; - } - break; - case CB_TAG_FILE: - if (CB_FILE (v)->record_max > size) { - size = CB_FILE (v)->record_max; - } - break; - case CB_TAG_CD: - if (CB_CD (v)->record && CB_CD (v)->record->size > size) { - size = CB_CD(v)->record->size; - } - break; - case CB_TAG_FIELD: - if (!error_if_subscript_or_refmod (x, _("DEBUGGING target"))) { - if (CB_FIELD (v)->size > size) { - size = CB_FIELD (v)->size; - } - } - break; - default: - cb_error_x (x, _("'%s' is not a valid DEBUGGING target"), - cb_name (x)); - break; - } - } - /* reset error handling */ - cb_set_ignore_error (0); - - return size; -} - -/* Resolve all labels */ -static void -cb_validate_labels (struct cb_program *prog) -{ - cb_tree l; - cb_tree x; - cb_tree v; - - for (l = cb_list_reverse (prog->label_list); l; l = CB_CHAIN (l)) { - x = CB_VALUE (l); - (void)cb_set_ignore_error (CB_REFERENCE (x)->flag_ignored); - v = cb_ref (x); - /* cb_error_node -> reference not defined, message raised in cb_ref() */ - if (v == cb_error_node) { - continue; - } - current_section = CB_REFERENCE (x)->section; - current_paragraph = CB_REFERENCE (x)->paragraph; - /* Check refs in to / out of DECLARATIVES */ - if (CB_LABEL_P (v)) { - if (CB_REFERENCE (x)->flag_in_decl && - !CB_LABEL (v)->flag_declaratives) { - /* verify reference-out-of-declaratives */ - switch (cb_reference_out_of_declaratives) { - case CB_OK: - break; - case CB_ERROR: - cb_error_x (x, _("'%s' is not in DECLARATIVES"), - CB_LABEL (v)->name); - break; - case CB_WARNING: - cb_warning_x (cb_warn_dialect, x, - _("'%s' is not in DECLARATIVES"), - CB_LABEL (v)->name); - break; - default: - break; - } - } - - /* GO TO into DECLARATIVES is not allowed */ - if (CB_LABEL (v)->flag_declaratives && - !CB_REFERENCE (x)->flag_in_decl && - !CB_REFERENCE (x)->flag_decl_ok) { - cb_error_x (x, _("invalid reference to '%s' (in DECLARATIVES)"), - CB_LABEL (v)->name); - } - - CB_LABEL (v)->flag_begin = 1; - if (CB_REFERENCE (x)->length) { - CB_LABEL (v)->flag_return = 1; - } - } else { - cb_error_x (x, _("'%s' is not a procedure name"), cb_name (x)); - } - } - /* reset error handling */ - cb_set_ignore_error (0); -} - - -void -cb_validate_program_body (struct cb_program *prog) -{ - cb_tree l; - cb_tree x; - cb_tree v; - struct cb_label *save_section; - struct cb_label *save_paragraph; - struct cb_alter_id *aid; - struct cb_label *l1; - struct cb_label *l2; - struct cb_field *f, *ret_fld; - - /* Validate entry points */ - - /* Check dangling LINKAGE items */ - if (cb_warn_linkage - && prog->linkage_storage) { - if (prog->returning - && cb_ref (prog->returning) != cb_error_node) { - ret_fld = CB_FIELD (cb_ref (prog->returning)); - if (ret_fld->redefines) { - /* error, but we check this in parser.y already and just go on here */ - ret_fld = ret_fld->redefines; - } - } else { - ret_fld = NULL; - } - for (v = prog->entry_list; v; v = CB_CHAIN (v)) { - for (f = prog->linkage_storage; f; f = f->sister) { - - /* ignore RETURNING fields and fields that REDEFINES */ - if (f == ret_fld - || f->redefines) { - continue; - } - - /* ignore fields that are part of current entry USING */ - for (l = CB_VALUE (CB_VALUE (v)); l; l = CB_CHAIN (l)) { - x = CB_VALUE (l); - if (CB_VALID_TREE (x) && cb_ref (x) != cb_error_node) { - if (f == CB_FIELD (cb_ref (x))) { - break; - } - } - } - if (l) { - continue; - } - - /* check if field or its cildren have any actual reference, - otherwise the warning is useless */ - if (has_sub_reference(f)) { - cb_warning_x (cb_warn_linkage, CB_TREE (f), - _("LINKAGE item '%s' is not a PROCEDURE USING parameter"), f->name); - } - } - } - } - - save_section = current_section; - save_paragraph = current_paragraph; - - /* Resolve all labels */ - cb_validate_labels (prog); - - if (prog->flag_debugging) { - /* Resolve DEBUGGING references and calculate DEBUG-CONTENTS size */ - /* Basic size of DEBUG-CONTENTS is DFLT_DEBUG_CONTENTS_SIZE */ - int debug_contents_size = cb_resolve_debug_refs (prog, DFLT_DEBUG_CONTENTS_SIZE); - - /* If necessary, adjust size of DEBUG-CONTENTS (and DEBUG-ITEM) */ - if (debug_contents_size != DFLT_DEBUG_CONTENTS_SIZE) { - f = CB_FIELD_PTR (cb_debug_contents); - f->size = debug_contents_size; - f->memory_size = debug_contents_size; - - f = CB_FIELD_PTR (cb_debug_item); - f->size += debug_contents_size - DFLT_DEBUG_CONTENTS_SIZE; - f->memory_size += debug_contents_size - DFLT_DEBUG_CONTENTS_SIZE; - } - } - - /* Build ALTER ids - We need to remove duplicates */ - for (l = prog->alter_list; l; l = CB_CHAIN (l)) { - if (CB_PURPOSE (l) == cb_error_node) { - continue; - } - if (CB_VALUE (l) == cb_error_node) { - continue; - } - x = CB_PURPOSE (l); - v = CB_VALUE (l); - if (CB_REFERENCE (x)->value == cb_error_node - || CB_REFERENCE (x)->flag_ignored) { - continue; - } - if (CB_REFERENCE (v)->value == cb_error_node - || CB_REFERENCE (v)->flag_ignored) { - continue; - } - l1 = CB_LABEL (CB_REFERENCE (x)->value); - l2 = CB_LABEL (CB_REFERENCE (v)->value); - current_section = CB_REFERENCE (x)->section; - current_paragraph = CB_REFERENCE (x)->paragraph; - /* First statement in paragraph must be a GO TO */ - if (!l1->flag_first_is_goto) { - cb_error_x (x, _("'%s' is not an alterable paragraph"), - l1->name); - continue; - } - for (aid = l1->alter_gotos; aid; aid = aid->next) { - if (aid->goto_id == l2->id) { - break; - } - } - if (!aid) { - aid = cobc_parse_malloc (sizeof(struct cb_alter_id)); - aid->next = l1->alter_gotos; - aid->goto_id = l2->id; - l1->alter_gotos = aid; - } - for (aid = prog->alter_gotos; aid; aid = aid->next) { - if (aid->goto_id == l1->id) { - break; - } - } - if (!aid) { - aid = cobc_parse_malloc (sizeof(struct cb_alter_id)); - aid->next = prog->alter_gotos; - aid->goto_id = l1->id; - prog->alter_gotos = aid; - } - } - - current_section = save_section; - current_paragraph = save_paragraph; - cobc_cs_check = 0; - - prog->exec_list = cb_list_reverse (prog->exec_list); -} - -/* General */ - -static COB_INLINE COB_A_INLINE void -cb_copy_source_reference (cb_tree target, cb_tree x) -{ - SET_SOURCE(target, x->source_file, x->source_line); - target->source_column = x->source_column; -} - -/* Expressions */ - -static void -cb_expr_init (void) -{ - if (initialized == 0) { - initialized = 1; - /* Init stack */ - expr_stack_size = START_STACK_SIZE; - expr_stack = cobc_main_malloc (sizeof (struct expr_node) * START_STACK_SIZE); - } else { - memset (expr_stack, 0, expr_stack_size * sizeof (struct expr_node)); - } - expr_op = 0; - expr_lh = NULL; - /* First three entries are dummies */ - expr_index = 3; -} - -static int -expr_chk_cond (cb_tree expr_1, cb_tree expr_2) -{ - struct cb_field *f1; - struct cb_field *f2; - int is_ptr_1; - int is_ptr_2; - - /* 88 level is invalid here */ - /* Likewise combination of pointer and non-pointer */ - is_ptr_1 = 0; - is_ptr_2 = 0; - if (CB_REF_OR_FIELD_P (expr_1)) { - f1 = CB_FIELD_PTR (expr_1); - if (f1->level == 88) { - return 1; - } - if (f1->flag_is_pointer) { - is_ptr_1 = 1; - } - } else if (CB_CAST_P (expr_1)) { - switch (CB_CAST (expr_1)->cast_type) { - case CB_CAST_ADDRESS: - case CB_CAST_ADDR_OF_ADDR: - case CB_CAST_PROGRAM_POINTER: - is_ptr_1 = 1; - break; - default: - break; - } - } else if (expr_1 == cb_null) { - is_ptr_1 = 1; - } - if (CB_REF_OR_FIELD_P (expr_2)) { - f2 = CB_FIELD_PTR (expr_2); - if (f2->level == 88) { - return 1; - } - if (f2->flag_is_pointer) { - is_ptr_2 = 1; - } - } else if (CB_CAST_P (expr_2)) { - switch (CB_CAST (expr_2)->cast_type) { - case CB_CAST_ADDRESS: - case CB_CAST_ADDR_OF_ADDR: - case CB_CAST_PROGRAM_POINTER: - is_ptr_2 = 1; - break; - default: - break; - } - } else if (expr_2 == cb_null) { - is_ptr_2 = 1; - } - return is_ptr_1 ^ is_ptr_2; -} - -static int -expr_reduce (int token) -{ - /* Example: - * index: -3 -2 -1 0 - * token: 'x' '*' 'x' '+' ... - */ - - int op; - - while (expr_prio[TOKEN (-2)] <= expr_prio[token]) { - /* Reduce the expression depending on the last operator */ - op = TOKEN (-2); - switch (op) { - case 'x': - return 0; - - case '+': - case '-': - case '*': - case '/': - case '^': - /* Arithmetic operators: 'x' op 'x' */ - if (TOKEN (-1) != 'x' || TOKEN (-3) != 'x') { - return -1; - } - TOKEN (-3) = 'x'; - VALUE (-3) = cb_build_binary_op (VALUE (-3), op, VALUE (-1)); - expr_index -= 2; - break; - - case '!': - /* Negation: '!' 'x' */ - if (TOKEN (-1) != 'x') { - return -1; - } - /* 'x' '=' 'x' '|' '!' 'x' */ - if (expr_lh) { - if (CB_TREE_CLASS (VALUE (-1)) != CB_CLASS_BOOLEAN) { - VALUE (-1) = cb_build_binary_op (expr_lh, expr_op, VALUE (-1)); - } - } - TOKEN (-2) = 'x'; - VALUE (-2) = CB_BUILD_NEGATION (VALUE (-1)); - expr_index -= 1; - break; - - case '&': - case '|': - /* Logical AND/OR: 'x' op 'x' */ - if (TOKEN (-1) != 'x' || TOKEN (-3) != 'x') { - return -1; - } - /* 'x' '=' 'x' '|' 'x' */ - if (expr_lh) { - if (CB_TREE_CLASS (VALUE (-1)) != CB_CLASS_BOOLEAN) { - VALUE (-1) = cb_build_binary_op (expr_lh, expr_op, VALUE (-1)); - } - if (CB_TREE_CLASS (VALUE (-3)) != CB_CLASS_BOOLEAN) { - VALUE (-3) = cb_build_binary_op (expr_lh, expr_op, VALUE (-3)); - } - } - TOKEN (-3) = 'x'; - VALUE (-3) = cb_build_binary_op (VALUE (-3), op, - VALUE (-1)); - expr_index -= 2; - break; - - case '(': - case ')': - return 0; - - default: - /* Relational operators */ - if (TOKEN (-1) != 'x') { - return -1; - } - switch (TOKEN (-3)) { - case 'x': - /* Simple condition: 'x' op 'x' */ - if (VALUE (-3) == cb_error_node || - VALUE (-1) == cb_error_node) { - VALUE (-3) = cb_error_node; - } else { - expr_lh = VALUE (-3); - if (expr_chk_cond (expr_lh, VALUE (-1))) { - VALUE (-3) = cb_error_node; - return 1; - } - expr_op = op; - TOKEN (-3) = 'x'; - if (CB_TREE_CLASS (VALUE (-1)) != CB_CLASS_BOOLEAN) { - VALUE (-3) = cb_build_binary_op (expr_lh, op, VALUE (-1)); -#if 0 /* Note: We loose the source reference here if - the result is true/false, for example because of - comparing 'A' = 'B'. As we now have cb_false - in VALUE (-3) we should not add the reference there. - CHECKME: Should we store the value as PAIR with a new - cb_tree containing the reference and unpack it - everywhere or is there a better option to find? - See: Test syn_misc.at - Constant Expressions (2) - */ - cb_copy_source_reference (VALUE (-3), expr_lh); -#endif - } else { - VALUE (-3) = VALUE (-1); - } - } - expr_index -= 2; - break; - case '&': - case '|': - /* Complex condition: 'x' '=' 'x' '|' op 'x' */ - if (VALUE (-1) == cb_error_node) { - VALUE (-2) = cb_error_node; - } else { - expr_op = op; - TOKEN (-2) = 'x'; - if (CB_TREE_CLASS (VALUE (-1)) != CB_CLASS_BOOLEAN && expr_lh) { - VALUE (-2) = cb_build_binary_op (expr_lh, op, VALUE (-1)); - } else { - VALUE (-2) = VALUE (-1); - } - } - expr_index -= 1; - break; - default: - return -1; - } - break; - } - } - - /* Handle special case "op OR x AND" */ - if (token == '&' && TOKEN (-2) == '|' - && CB_TREE_CLASS (VALUE (-1)) != CB_CLASS_BOOLEAN) { - /* LCOV_EXCL_START */ - if (!expr_lh) { - /* untranslated as highly unlikely to be raised */ - cobc_err_msg ("missing left-hand-expression"); - COBC_ABORT (); - } - /* LCOV_EXCL_STOP */ - TOKEN (-1) = 'x'; - VALUE (-1) = cb_build_binary_op (expr_lh, expr_op, VALUE (-1)); - } - - return 0; -} - -static void -cb_expr_shift_sign (const int op) -{ - int have_not; - - if (TOKEN (-1) == '!') { - have_not = 1; - expr_index--; - } else { - have_not = 0; - } - (void)expr_reduce ('='); - if (TOKEN (-1) == 'x') { - VALUE (-1) = cb_build_binary_op (VALUE (-1), op, cb_zero); - if (have_not) { - VALUE (-1) = CB_BUILD_NEGATION (VALUE (-1)); - } - } -} - -static void -cb_expr_shift_class (const char *name) -{ - int have_not; - - if (TOKEN (-1) == '!') { - have_not = 1; - expr_index--; - } else { - have_not = 0; - } - (void)expr_reduce ('='); - if (TOKEN (-1) == 'x') { - VALUE (-1) = CB_BUILD_FUNCALL_1 (name, VALUE (-1)); - if (have_not) { - VALUE (-1) = CB_BUILD_NEGATION (VALUE (-1)); - } - } -} - -static int -binary_op_is_relational (const struct cb_binary_op * const op) -{ - return op->op == '=' - || op->op == '>' - || op->op == '<' - || op->op == '[' - || op->op == ']' - || op->op == '~'; -} - -static void -cb_expr_shift (int token, cb_tree value) -{ - switch (token) { - case 'M': - break; - case 'x': - /* Sign ZERO condition */ - if (value == cb_zero) { - if (TOKEN (-1) == 'x' || TOKEN (-1) == '!') { - cb_expr_shift_sign ('='); - return; - } - } - - /* Unary sign */ - if ((TOKEN (-1) == '+' || TOKEN (-1) == '-') && - TOKEN (-2) != 'x') { - if (TOKEN (-1) == '-') { - value = cb_build_binary_op (cb_zero, '-', value); - } - expr_index -= 1; - } - break; - - case '(': - /* 'x' op '(' --> '(' 'x' op */ - switch (TOKEN (-1)) { - case '=': - case '~': - case '<': - case '>': - case '[': - case ']': - expr_op = TOKEN (-1); - if (TOKEN (-2) == 'x') { - expr_lh = VALUE (-2); - } - break; - default: - break; - } - break; - - case ')': - /* Enclosed by parentheses */ - (void)expr_reduce (token); - if (CB_BINARY_OP_P (VALUE (-1)) - && binary_op_is_relational (CB_BINARY_OP (VALUE (-1)))) { - /* - If a relation is surrounded in parentheses, it cannot - be the start of an abbreviated condition. - */ - expr_lh = NULL; - } - if (TOKEN (-2) == '(') { - value = CB_BUILD_PARENTHESES (VALUE (-1)); - expr_index -= 2; - cb_expr_shift ('x', value); - return; - } - break; - - default: - /* '<' '|' '=' --> '[' */ - /* '>' '|' '=' --> ']' */ - if (token == '=' && TOKEN (-1) == '|' && - (TOKEN (-2) == '<' || TOKEN (-2) == '>')) { - token = (TOKEN (-2) == '<') ? '[' : ']'; - expr_index -= 2; - } - - /* '!' '=' --> '~', etc. */ - if (TOKEN (-1) == '!') { - switch (token) { - case '=': - token = '~'; - expr_index--; - break; - case '~': - token = '='; - expr_index--; - break; - case '<': - token = ']'; - expr_index--; - break; - case '>': - token = '['; - expr_index--; - break; - case '[': - token = '>'; - expr_index--; - break; - case ']': - token = '<'; - expr_index--; - break; - default: - break; - } - } - break; - } - - /* Reduce */ - /* Catch invalid condition */ - if (expr_reduce (token) > 0) { - return; - } - - /* Allocate sufficient stack memory */ - if (expr_index >= expr_stack_size) { - while (expr_stack_size <= expr_index) { - expr_stack_size *= 2; - } - expr_stack = cobc_main_realloc (expr_stack, sizeof (struct expr_node) * expr_stack_size); - } - - /* Put on the stack */ - TOKEN (0) = token; - VALUE (0) = value; - expr_index++; -} - -static void -expr_expand (cb_tree *x) -{ - struct cb_binary_op *p; - -start: - /* Remove parentheses */ - if (CB_BINARY_OP_P (*x)) { - p = CB_BINARY_OP (*x); - if (p->op == '@') { - *x = p->x; - goto start; - } - expr_expand (&p->x); - if (p->y) { - expr_expand (&p->y); - } - } -} - -static cb_tree -cb_expr_finish (void) -{ - /* Reduce all */ - (void)expr_reduce (0); - - if (!expr_stack[3].value) { - /* TODO: Add test case for this to syn_misc.at invalid expression */ - cb_error (_("invalid expression")); - return cb_error_node; - } - - SET_SOURCE(expr_stack[3].value, cb_source_file, cb_exp_line); - - if (expr_index != 4) { - /* TODO: Add test case for this to syn_misc.at invalid expression */ - cb_error_x (expr_stack[3].value, _("invalid expression")); - return cb_error_node; - } - - expr_expand (&expr_stack[3].value); - if (expr_stack[3].token != 'x') { - /* TODO: Add test case for this to syn_misc.at invalid expression */ - cb_error_x (expr_stack[3].value, _("invalid expression")); - return cb_error_node; - } - - return expr_stack[3].value; -} - -cb_tree -cb_build_expr (cb_tree list) -{ - cb_tree l, v; - struct cb_field *f; - int op, has_rel, has_con, has_var, bad_cond; - - cb_expr_init (); - - /* Checkme: maybe add validate_list(l) here */ - - bad_cond = has_rel = has_con = has_var = 0; - for (l = list; l; l = CB_CHAIN (l)) { - op = CB_PURPOSE_INT (l); - switch (op) { - case '9': - /* NUMERIC */ - cb_expr_shift_class ("cob_is_numeric"); - has_rel = 1; - break; - case 'A': - /* ALPHABETIC */ - cb_expr_shift_class ("cob_is_alpha"); - has_rel = 1; - break; - case 'L': - /* ALPHABETIC_LOWER */ - cb_expr_shift_class ("cob_is_lower"); - has_rel = 1; - break; - case 'U': - /* ALPHABETIC_UPPER */ - cb_expr_shift_class ("cob_is_upper"); - has_rel = 1; - break; - case 'P': - /* POSITIVE */ - cb_expr_shift_sign ('>'); - has_rel = 1; - break; - case 'N': - /* NEGATIVE */ - cb_expr_shift_sign ('<'); - has_rel = 1; - break; - case 'O': - /* OMITTED */ - if (current_statement) { - current_statement->null_check = NULL; - } - cb_expr_shift_class ("cob_is_omitted"); - has_rel = 1; - break; - case 'C': - /* CLASS */ - cb_expr_shift_class (CB_CLASS_NAME (cb_ref (CB_VALUE (l)))->cname); - has_rel = 1; - break; - default: - v = CB_VALUE (l); - if (op == 'x') { - has_var = 1; - if (CB_TREE_TAG (v) == CB_TAG_BINARY_OP) { - has_rel = 1; - } else - if (CB_TREE_TAG (v) == CB_TAG_FUNCALL) { - has_rel = 1; - } else - if (CB_REF_OR_FIELD_P (v)) { - f = CB_FIELD_PTR (v); - if (f->level == 88) { - has_rel = 1; - } else - if (f->storage == CB_STORAGE_CONSTANT) { - has_rel = 1; - } - } - } else - if (op == '|' - || op == '&') { - has_con = 1; - if (has_var && !has_rel) { - bad_cond = 1; - } - } else - if (op == '>' - || op == '<' - || op == '=' - || op == '~' - || op == '[' - || op == ']') { - has_rel = 1; - } else - if (op == '!') { - has_rel = 1; - } - /* Warning for complex expressions without explicit parentheses - (i.e., "a OR b AND c" or "a AND b OR c") */ - if (cb_warn_parentheses - && expr_index > 3 - && (op == '|' || op == '&')) { - cb_tree e = cb_any; - SET_SOURCE(e, cb_source_file, cb_exp_line); - - if (op == '|' && expr_stack[expr_index-2].token == '&') { - cb_warning_x (cb_warn_parentheses, e, - _("suggest parentheses around %s within %s"), "AND", "OR"); - } else - if (op == '&' && expr_stack[expr_index-2].token == '|') { - cb_warning_x (cb_warn_parentheses, e, - _("suggest parentheses around %s within %s"), "OR", "AND"); - } - } - cb_expr_shift (op, v); - break; - } - } - if (bad_cond) { - cb_error_x (list, _("invalid conditional expression")); - return cb_any; - } - - return cb_expr_finish (); -} - -const char * -explain_operator (const int op) -{ - switch (op) - { - case '>': - return "GREATER THAN"; - case '<': - return "LESS THAN"; - case ']': - return "GREATER OR EQUAL"; - case '[': - return "LESS OR EQUAL"; - case '=': - return "EQUALS"; - case '~': - return "NOT EQUAL"; - case '!': - return "NOT"; - case '&': - return "AND"; - case '|': - return "OR"; - default: - return NULL; - } -} - -const char * -enum_explain_storage (const enum cb_storage storage) -{ - switch (storage) { - case CB_STORAGE_CONSTANT: - return "Constants"; - case CB_STORAGE_FILE: - return "FILE SECTION"; - case CB_STORAGE_WORKING: - return "WORKING-STORAGE SECTION"; - case CB_STORAGE_LOCAL: - return "LOCAL-STORAGE SECTION"; - case CB_STORAGE_LINKAGE: - return "LINKAGE SECTION"; - case CB_STORAGE_SCREEN: - return "SCREEN SECTION"; - case CB_STORAGE_REPORT: - return "REPORT SECTION"; - case CB_STORAGE_COMMUNICATION: - return "COMMUNICATION SECTION"; - default: - break; - } - return "UNKNOWN"; -} - -/* Numerical operation */ - -static cb_tree -build_store_option (cb_tree x, cb_tree round_opt) -{ - struct cb_field *f; - int opt; - enum cb_usage usage; - - f = CB_FIELD_PTR (x); - usage = f->usage; -#if 0 /* RXWRXW - FP */ - if (usage == CB_USAGE_DOUBLE || usage == CB_USAGE_FLOAT) { - /* Rounding on FP is useless */ - opt = 0; - } else { -#endif - opt = CB_INTEGER (round_opt)->val; -#if 0 /* RXWRXW - FP */ - } -#endif - - if (usage == CB_USAGE_COMP_5 - || usage == CB_USAGE_COMP_X - || usage == CB_USAGE_COMP_N) { - /* Do not check NOT ERROR case, so that we optimize */ - if (current_statement->ex_handler) { - opt |= COB_STORE_KEEP_ON_OVERFLOW; - } - } else if (current_statement->handler_type != NO_HANDLER) { - /* There is a [NOT] ERROR/OVERFLOW/EXCEPTION - Set in parser */ - opt |= COB_STORE_KEEP_ON_OVERFLOW; - } else if (usage == CB_USAGE_BINARY && cb_binary_truncate) { - /* Truncate binary field to digits in picture */ - opt |= COB_STORE_TRUNC_ON_OVERFLOW; - } - - return cb_int (opt); -} - -static cb_tree -decimal_alloc (void) -{ - cb_tree x; - - x = cb_build_decimal (current_program->decimal_index); - current_program->decimal_index++; - /* LCOV_EXCL_START */ - if (current_program->decimal_index >= COB_MAX_DEC_STRUCT) { - cobc_err_msg (_("internal decimal structure size exceeded: %d"), - COB_MAX_DEC_STRUCT); - if (strcmp(current_statement->name, "COMPUTE") == 0) { - cobc_err_msg (_("Try to minimize the number of parentheses " - "or split into multiple computations.")); - } - COBC_ABORT (); - } - /* LCOV_EXCL_STOP */ - if (current_program->decimal_index > current_program->decimal_index_max) { - current_program->decimal_index_max = current_program->decimal_index; - } - return x; -} - -static void -decimal_free (void) -{ - current_program->decimal_index--; -} -static void -push_expr_dec (int dec) -{ - if (expr_nest < MAX_NESTED_EXPR) { - expr_decp[expr_nest++] = dec; - } else { - cb_warning (COBC_WARN_FILLER, - _("more than %d nested expressions"), MAX_NESTED_EXPR); - } -} - -static void -decimal_align (void) -{ - cb_tree expr_dec = NULL; /* Int value for decimal_align */ - - if (expr_dec_align >= 0 - && expr_x != NULL) { - switch(expr_dec_align) { - case 0: - expr_dec = cb_int0; - break; - case 1: - expr_dec = cb_int1; - break; - case 2: - expr_dec = cb_int2; - break; - case 3: - expr_dec = cb_int3; - break; - case 4: - expr_dec = cb_int4; - break; - case 5: - expr_dec = cb_int5; - break; - case 6: - expr_dec = cb_int6; - break; - default: - expr_dec = cb_int (expr_dec_align); - break; - } - dpush (CB_BUILD_FUNCALL_2 ("cob_decimal_align", expr_x, expr_dec)); - if (cb_warn_arithmetic_osvs - && expr_line != cb_source_line) { - expr_line = cb_source_line; /* only warn once per line */ - cb_warning_x (cb_warn_arithmetic_osvs, CB_TREE (current_statement), - _("precision of result may change with arithmetic-osvs")); - } - expr_dec_align = -1; - expr_x = NULL; - } -} - -static void -decimal_compute (const int op, cb_tree x, cb_tree y) -{ - const char *func; - int decp, d; - - /* skip if the actual statement can't be generated any more - to prevent multiple errors here */ - if (error_statement == current_statement) { - return; - } - - if (!current_program->flag_decimal_comp) { - struct cb_program* prog; - for (prog = current_program; prog && !prog->flag_decimal_comp; prog = prog->next_program) { - prog->flag_decimal_comp = 1; - } - } - - if (cb_arithmetic_osvs) { - if (expr_dec_align >= 0 - && expr_x != NULL - && expr_x != x) { - decimal_align (); - } - decp = expr_dmax; - } else { - decp = -1; /* fix missing initialization warning, not actually used */ - } - switch (op) { - case '+': - func = "cob_decimal_add"; - break; - case '-': - func = "cob_decimal_sub"; - break; - case '*': - func = "cob_decimal_mul"; - break; - case '/': - func = "cob_decimal_div"; - break; - case '^': - func = "cob_decimal_pow"; - break; - default: - func = explain_operator (op); - /* LCOV_EXCL_START */ - if (!func) { - cobc_err_msg (_("unexpected operation: %c (%d)"), (char)op, op); - COBC_ABORT (); - } - /* LCOV_EXCL_STOP */ - error_statement = current_statement; - cb_error_x (CB_TREE(current_statement), _("%s operator may be misplaced"), func); - return; - } - if (cb_arithmetic_osvs - && expr_nest > 1) { - expr_nest--; - switch (op) { - case '+': - if (expr_decp [expr_nest] > expr_decp [expr_nest-1]) { - expr_decp [expr_nest-1] = expr_decp [expr_nest]; - } - break; - case '-': - if (expr_decp [expr_nest] > expr_decp [expr_nest-1]) { - expr_decp [expr_nest-1] = expr_decp [expr_nest]; - } - break; - case '*': - expr_decp [expr_nest-1] += expr_decp [expr_nest]; - break; - case '/': - d = expr_decp [expr_nest-1] - expr_decp [expr_nest]; - if (d > expr_dmax) { - expr_decp [expr_nest-1] = d; - } else { - expr_decp [expr_nest-1] = expr_dmax; - } - break; - case '^': - if (expr_decp [expr_nest-1] - expr_decp [expr_nest] - < expr_decp [expr_nest-1]) { - expr_decp [expr_nest-1] = expr_decp [expr_nest-1] - expr_decp [expr_nest]; - } - break; - } - decp = expr_decp [expr_nest-1]; - } - - dpush (CB_BUILD_FUNCALL_2 (func, x, y)); - - /* Save for later decimal_align */ - if (cb_arithmetic_osvs) { - if (decp > expr_dec_align) - expr_dec_align = decp; - } else { - expr_dec_align = -1; - } - expr_x = x; -} - -/** - * expand tree x to the previously allocated decimal tree d - */ -static void -decimal_expand (cb_tree d, cb_tree x) -{ - struct cb_literal *l; - struct cb_field *f; - struct cb_binary_op *p; - cb_tree t; - - /* skip if the actual statement can't be generated any more - to prevent multiple errors here */ - if (error_statement == current_statement) { - return; - } - switch (CB_TREE_TAG (x)) { - case CB_TAG_CONST: - /* LCOV_EXCL_START */ - if (x != cb_zero) { - cobc_err_msg (_("unexpected constant expansion")); - COBC_ABORT (); - } - /* LCOV_EXCL_STOP */ - dpush (CB_BUILD_FUNCALL_2 ("cob_decimal_set_llint", d, - cb_int0)); - break; - case CB_TAG_LITERAL: - /* Set d, N */ - decimal_align (); - l = CB_LITERAL (x); - if (l->size < 19 && l->scale == 0) { - dpush (CB_BUILD_FUNCALL_2 ("cob_decimal_set_llint", d, - cb_build_cast_llint (x))); - } else { - dpush (CB_BUILD_FUNCALL_2 ("cob_decimal_set_field", d, x)); - push_expr_dec (l->scale); - } - break; - case CB_TAG_REFERENCE: - /* Set d, X */ - f = CB_FIELD_PTR (x); - /* Check numeric */ - if (cb_flag_correct_numeric && f->usage == CB_USAGE_DISPLAY) { - cb_emit (CB_BUILD_FUNCALL_1 ("cob_correct_numeric", x)); - } - if (CB_EXCEPTION_ENABLE (COB_EC_DATA_INCOMPATIBLE)) { - if (f->usage == CB_USAGE_DISPLAY || - f->usage == CB_USAGE_PACKED || - f->usage == CB_USAGE_COMP_6) { - dpush (CB_BUILD_FUNCALL_2 ("cob_check_numeric", - x, CB_BUILD_STRING0 (f->name))); - } - } - decimal_align (); - - if ( (f->usage == CB_USAGE_BINARY - || f->usage == CB_USAGE_COMP_5 - || f->usage == CB_USAGE_INDEX - || f->usage == CB_USAGE_HNDL - || f->usage == CB_USAGE_HNDL_WINDOW - || f->usage == CB_USAGE_HNDL_SUBWINDOW - || f->usage == CB_USAGE_HNDL_FONT - || f->usage == CB_USAGE_HNDL_THREAD - || f->usage == CB_USAGE_HNDL_MENU - || f->usage == CB_USAGE_HNDL_VARIANT - || f->usage == CB_USAGE_HNDL_LM - || f->usage == CB_USAGE_COMP_X - || f->usage == CB_USAGE_COMP_N) - && !f->pic->scale - && (f->size == 1 || f->size == 2 || f->size == 4 || - f->size == 8)) { - if (f->pic->have_sign) { - dpush (CB_BUILD_FUNCALL_2 ("cob_decimal_set_llint", - d, cb_build_cast_llint (x))); - } else { - dpush (CB_BUILD_FUNCALL_2 ("cob_decimal_set_ullint", - d, cb_build_cast_llint (x))); - } - } else { - dpush (CB_BUILD_FUNCALL_2 ("cob_decimal_set_field", d, x)); - push_expr_dec (f->pic->scale); - } - break; - case CB_TAG_BINARY_OP: - /* Set d, X - * Set t, Y - * OP d, t */ - p = CB_BINARY_OP (x); - decimal_expand (d, p->x); - - if (CB_TREE_TAG (p->y) == CB_TAG_LITERAL - && CB_TREE_CATEGORY (p->y) == CB_CATEGORY_NUMERIC) { - t = cb_build_decimal_literal (cb_lookup_literal(p->y,1)); - decimal_compute (p->op, d, t); - } else { - t = decimal_alloc (); - decimal_expand (t, p->y); - decimal_compute (p->op, d, t); - decimal_free (); - } - break; - case CB_TAG_INTRINSIC: - decimal_align (); - dpush (CB_BUILD_FUNCALL_2 ("cob_decimal_set_field", d, x)); - push_expr_dec (0); - break; - /* LCOV_EXCL_START */ - default: - cobc_err_msg (_("unexpected tree tag: %d"), (int)CB_TREE_TAG (x)); - COBC_ABORT (); - /* LCOV_EXCL_STOP */ - } -} - -static void -decimal_assign (cb_tree x, cb_tree d, cb_tree round_opt) -{ - dpush (CB_BUILD_FUNCALL_3 ("cob_decimal_get_field", d, x, - build_store_option (x, round_opt))); -} - -static cb_tree -cb_build_mul (cb_tree v, cb_tree n, cb_tree round_opt) -{ - cb_tree opt; - struct cb_field *f; - - if (CB_INDEX_OR_HANDLE_P (v)) { - return cb_build_move (cb_build_binary_op (v, '*', n), v); - } - - if (CB_REF_OR_FIELD_P (n)) { - f = CB_FIELD_PTR (n); - f->count++; - } - if (CB_REF_OR_FIELD_P (v)) { - f = CB_FIELD_PTR (v); - f->count++; - if (round_opt == cb_int0 - && cb_fits_long_long (n) - && cb_is_integer_field(f) - && cb_is_integer_expr (n)) { - return cb_build_assign (v, cb_build_binary_op (v, '*', n)); - } - } - opt = build_store_option (v, round_opt); - return CB_BUILD_FUNCALL_3 ("cob_mul", v, n, opt); -} - -static cb_tree -cb_build_div (cb_tree v, cb_tree n, cb_tree round_opt) -{ - cb_tree opt; - struct cb_field *f; - - if (CB_INDEX_OR_HANDLE_P (v)) { - return cb_build_move (cb_build_binary_op (v, '/', n), v); - } - - if (CB_REF_OR_FIELD_P (n)) { - f = CB_FIELD_PTR (n); - f->count++; - } - opt = build_store_option (v, round_opt); - if (CB_REF_OR_FIELD_P (v)) { - f = CB_FIELD_PTR (v); - f->count++; - } - return CB_BUILD_FUNCALL_3 ("cob_div", v, n, opt); -} - -static cb_tree -build_decimal_assign (cb_tree vars, const int op, cb_tree val) -{ - struct cb_field *f; - cb_tree l; - cb_tree t; - cb_tree s1; - cb_tree s2; - cb_tree d; - - /* note: vars validated by caller: cb_emit_arithmetic */ - if (cb_arithmetic_osvs) { - /* ARITHMETIC-OSVS: Determine largest scale used in result field */ - expr_dec_align = -1; - expr_rslt = CB_VALUE(vars); - for (l = vars; l; l = CB_CHAIN (l)) { - if (CB_FIELD_P (cb_ref (CB_VALUE(l)))) { - f = CB_FIELD_PTR (CB_VALUE(l)); - if(f->pic->scale > expr_dmax) { - expr_dmax = f->pic->scale; - } - } - } - cb_walk_cond (val); - } else { - expr_dmax = -1; - expr_dec_align = -1; - } - expr_nest = 0; - - d = decimal_alloc (); - - /* Set d, VAL */ - decimal_expand (d, val); - - s1 = NULL; - if (op == 0) { - for (l = vars; l; l = CB_CHAIN (l)) { - /* Set VAR, d */ - decimal_assign (CB_VALUE (l), d, CB_PURPOSE (l)); - s2 = cb_list_reverse (decimal_stack); - if (!s1) { - s1 = s2; - } else { - s1 = cb_list_append (s1, s2); - } - decimal_stack = NULL; - } - } else { - t = decimal_alloc (); - for (l = vars; l; l = CB_CHAIN (l)) { - /* Set t, VAR - * OP t, d - * set VAR, t - */ - decimal_expand (t, CB_VALUE (l)); - decimal_compute (op, t, d); - decimal_assign (CB_VALUE (l), t, CB_PURPOSE (l)); - s2 = cb_list_reverse (decimal_stack); - if (!s1) { - s1 = s2; - } else { - s1 = cb_list_append (s1, s2); - } - decimal_stack = NULL; - } - decimal_free (); - } - - decimal_free (); - expr_dmax = -1; - expr_dec_align = -1; - expr_nest = 0; - - return s1; -} - -void -cb_set_dmax (int scale) -{ - if (cb_arithmetic_osvs - && scale > expr_dmax) { - expr_dmax = scale; - } -} - -void -cb_emit_arithmetic (cb_tree vars, const int op, cb_tree val) -{ - cb_tree l; - cb_tree x; - - x = cb_check_numeric_value (val); - - if (cb_validate_one (x) - || cb_validate_list (vars)) { - return; - } - - - if (op) { - if (cb_list_map(cb_check_numeric_name, vars)) { - return; - } - } else { - if (cb_list_map (cb_check_numeric_edited_name, vars)) { - return; - } - } - - if (!CB_BINARY_OP_P (x)) { - if (op == '+' || op == '-' || op == '*' || op == '/') { - cb_check_data_incompat (x); - for (l = vars; l; l = CB_CHAIN (l)) { - cb_check_data_incompat (CB_VALUE (l)); - switch (op) { - case '+': - CB_VALUE (l) = cb_build_add (CB_VALUE (l), x, CB_PURPOSE (l)); - break; - case '-': - CB_VALUE (l) = cb_build_sub (CB_VALUE (l), x, CB_PURPOSE (l)); - break; - case '*': - CB_VALUE (l) = cb_build_mul (CB_VALUE (l), x, CB_PURPOSE (l)); - break; - case '/': - CB_VALUE (l) = cb_build_div (CB_VALUE (l), x, CB_PURPOSE (l)); - break; - } - } - cb_emit_list (vars); - return; - } - } - if (x == cb_error_node) { - return; - } - - if (op == 0 - && vars - && CB_CHAIN(vars) == NULL - && (CB_PURPOSE (vars) == NULL || CB_PURPOSE (vars) == cb_int0) - && cb_is_integer_expr (val) - && CB_VALUE (vars) - && cb_is_integer_expr (CB_VALUE(vars))) { - cb_emit (cb_build_assign (CB_VALUE (vars), val)); - return; - } - cb_emit_list (build_decimal_assign (vars, op, x)); -} - -/* Condition */ - -static cb_tree -build_cond_88 (cb_tree x) -{ - struct cb_field *f; - const char *real_statement; /* bad hack... */ - - cb_tree l; - cb_tree t; - cb_tree c1; - cb_tree c2; - - f = CB_FIELD_PTR (x); - /* Refer to parents data storage */ - if (!f->parent) { - /* Field is invalid */ - return cb_error_node; - } - x = cb_build_field_reference (f->parent, x); - f->parent->count++; - c1 = NULL; - - /* Build condition */ - for (l = f->values; l; l = CB_CHAIN (l)) { - t = CB_VALUE (l); - if (CB_PAIR_P (t)) { - /* VALUE THRU VALUE */ - real_statement = current_statement->name; - current_statement->name = "VALUE THRU"; - c2 = cb_build_binary_op (cb_build_binary_op (x, ']', CB_PAIR_X (t)), - '&', cb_build_binary_op (x, '[', CB_PAIR_Y (t))); - current_statement->name = real_statement; - } else { - /* VALUE */ - c2 = cb_build_binary_op (x, '=', t); - } - if (c1 == NULL) { - c1 = c2; - } else { - c1 = cb_build_binary_op (c1, '|', c2); - } - } - - return c1; -} - -static cb_tree -cb_build_optim_cond (struct cb_binary_op *p) -{ - struct cb_field *f; - const char *s; - size_t n; - -#if 0 /* RXWRXW - US */ - struct cb_field *fy; - if (CB_REF_OR_FIELD_P (p->y)) { - fy = CB_FIELD_PTR (p->y); - if (!fy->pic->have_sign - && (fy->usage == CB_USAGE_BINARY - || fy->usage == CB_USAGE_COMP_5 - || fy->usage == CB_USAGE_COMP_X - || fy->usage == CB_USAGE_COMP_N)) { - return CB_BUILD_FUNCALL_2 ("cob_cmp_uint", p->x, - cb_build_cast_int (p->y)); - } - } -#endif - - if (!CB_REF_OR_FIELD_P (p->x)) { - return CB_BUILD_FUNCALL_2 ("cob_cmp_llint", p->x, - cb_build_cast_llint (p->y)); - } - - f = CB_FIELD_PTR (p->x); -#if 0 /* CHECKME, if needed */ - if (cb_listing_xref) { - cobc_xref_link (&f->xref, current_statement->common.source_line); - } -#endif -#if 0 /* RXWRXW - SI */ - if (f->index_type) { - return CB_BUILD_FUNCALL_2 ("cob_cmp_special", - cb_build_cast_int (p->x), - cb_build_cast_int (p->y)); - } -#endif - if (f->pic->scale || f->flag_any_numeric) { - return CB_BUILD_FUNCALL_2 ("cob_cmp_llint", p->x, - cb_build_cast_llint (p->y)); - } - if (f->usage == CB_USAGE_PACKED) { - if (f->pic->digits < 19) { - optimize_defs[COB_CMP_PACKED_INT] = 1; - return CB_BUILD_FUNCALL_2 ("cob_cmp_packed_int", - p->x, - cb_build_cast_llint (p->y)); - } else { - return CB_BUILD_FUNCALL_2 ("cob_cmp_packed", - p->x, - cb_build_cast_llint (p->y)); - } - } - if (f->usage == CB_USAGE_COMP_6) { - return CB_BUILD_FUNCALL_2 ("cob_cmp_packed", - p->x, - cb_build_cast_llint (p->y)); - } - if (f->usage == CB_USAGE_DISPLAY - && !f->flag_sign_leading - && !f->flag_sign_separate) { - if (cb_fits_long_long (p->x)) { - return CB_BUILD_FUNCALL_4 ("cob_cmp_numdisp", - CB_BUILD_CAST_ADDRESS (p->x), - cb_int (f->size), - cb_build_cast_llint (p->y), - cb_int (f->pic->have_sign ? 1 : 0)); - } - return CB_BUILD_FUNCALL_2 ("cob_cmp_llint", p->x, - cb_build_cast_llint (p->y)); - } - if (f->usage == CB_USAGE_BINARY - || f->usage == CB_USAGE_COMP_5 - || f->usage == CB_USAGE_INDEX - || f->usage == CB_USAGE_HNDL - || f->usage == CB_USAGE_HNDL_WINDOW - || f->usage == CB_USAGE_HNDL_SUBWINDOW - || f->usage == CB_USAGE_HNDL_FONT - || f->usage == CB_USAGE_HNDL_THREAD - || f->usage == CB_USAGE_HNDL_MENU - || f->usage == CB_USAGE_HNDL_VARIANT - || f->usage == CB_USAGE_HNDL_LM - || f->usage == CB_USAGE_COMP_X - || f->usage == CB_USAGE_COMP_N) { - n = ((size_t)f->size - 1) - + (8 * (f->pic->have_sign ? 1 : 0)) - + (16 * (f->flag_binary_swap ? 1 : 0)); -#if defined(COB_NON_ALIGNED) && !defined(_MSC_VER) && defined(COB_ALLOW_UNALIGNED) - switch (f->size) { - case 2: -#ifdef COB_SHORT_BORK - optimize_defs[bin_compare_funcs[n].optim_val] = 1; - s = bin_compare_funcs[n].optim_name; - break; -#endif - case 4: - case 8: - if (f->storage != CB_STORAGE_LINKAGE && - f->indexes == 0 && (f->offset % f->size) == 0) { - optimize_defs[align_bin_compare_funcs[n].optim_val] = 1; - s = align_bin_compare_funcs[n].optim_name; - } else { - optimize_defs[bin_compare_funcs[n].optim_val] = 1; - s = bin_compare_funcs[n].optim_name; - } - break; - default: - optimize_defs[bin_compare_funcs[n].optim_val] = 1; - s = bin_compare_funcs[n].optim_name; - break; - } -#else - optimize_defs[bin_compare_funcs[n].optim_val] = 1; - s = bin_compare_funcs[n].optim_name; -#endif - if (s) { - return CB_BUILD_FUNCALL_2 (s, - CB_BUILD_CAST_ADDRESS (p->x), - cb_build_cast_llint (p->y)); - } - } - return CB_BUILD_FUNCALL_2 ("cob_cmp_llint", p->x, - cb_build_cast_llint (p->y)); -} - -static int -cb_check_num_cond (cb_tree x, cb_tree y) -{ - struct cb_field *fx; - struct cb_field *fy; - - if (!CB_REF_OR_FIELD_P (x)) { - return 0; - } - if (!CB_REF_OR_FIELD_P (y)) { - return 0; - } - if (CB_TREE_CATEGORY (x) != CB_CATEGORY_NUMERIC) { - return 0; - } - if (CB_TREE_CATEGORY (y) != CB_CATEGORY_NUMERIC) { - return 0; - } - if (CB_TREE_CLASS (x) != CB_CLASS_NUMERIC) { - return 0; - } - if (CB_TREE_CLASS (y) != CB_CLASS_NUMERIC) { - return 0; - } - fx = CB_FIELD_PTR (x); - fy = CB_FIELD_PTR (y); - if (fx->usage != CB_USAGE_DISPLAY) { - return 0; - } - if (fy->usage != CB_USAGE_DISPLAY) { - return 0; - } - if (fx->pic->have_sign || fy->pic->have_sign) { - return 0; - } - if (fx->size != fy->size) { - return 0; - } - if (fx->pic->scale != fy->pic->scale) { - return 0; - } - return 1; -} - -static int -cb_check_alpha_cond (cb_tree x) -{ - if (current_program->alphabet_name_list) { - return 0; - } - if (CB_LITERAL_P (x)) { - return 1; - } - if (!CB_REF_OR_FIELD_P (x)) { - return 0; - } - if (CB_TREE_CATEGORY (x) != CB_CATEGORY_ALPHANUMERIC && - CB_TREE_CATEGORY (x) != CB_CATEGORY_ALPHABETIC) { - return 0; - } - if (cb_field_variable_size (CB_FIELD_PTR (x))) { - return 0; - } - if (cb_field_size (x) == FIELD_SIZE_UNKNOWN) { - return 0; - } - return 1; -} - -static void -cb_walk_cond (cb_tree x) -{ - struct cb_binary_op *p; - struct cb_field *f; - struct cb_literal *l; - - if (x == NULL) - return; - - switch (CB_TREE_TAG (x)) { - case CB_TAG_LITERAL: - if (CB_TREE_CATEGORY (x) == CB_CATEGORY_NUMERIC) { - l = CB_LITERAL (x); - if (l->scale > expr_dmax) { - expr_dmax = l->scale; - } - } - break; - - case CB_TAG_REFERENCE: - if (!CB_FIELD_P (cb_ref (x))) { - return; - } - - f = CB_FIELD_PTR (x); - - if (f->level == 88) { - return ; - } - if(f->pic - && f->pic->scale > expr_dmax) { - expr_dmax = f->pic->scale; - } - - break; - - case CB_TAG_BINARY_OP: - p = CB_BINARY_OP (x); - cb_walk_cond (p->x); - if (p->op != '/') { - cb_walk_cond (p->y); - } - break; - - default: - return; - } -} - -cb_tree -cb_build_cond (cb_tree x) -{ - struct cb_field *f; - struct cb_binary_op *p; - cb_tree d1; - cb_tree d2; - cb_tree ret; - int has_any_len = 0; - int size1; - int size2; - - if (x == cb_error_node) { - return cb_error_node; - } - - if (cb_arithmetic_osvs) { - /* ARITHMETIC-OSVS: Determine largest scale used in condition */ - if (expr_dmax == -1) { - /* FIXME: this is a hack, x should always be a list! */ - if (CB_LIST_P(x)) { - expr_rslt = CB_VALUE(x); - } else { - expr_rslt = x; - } - cb_walk_cond (x); - } - } else { - expr_dmax = -1; - expr_dec_align = -1; - expr_nest = 0; - } - - switch (CB_TREE_TAG (x)) { - case CB_TAG_CONST: - if (x != cb_any && x != cb_true && x != cb_false) { - /* TODO: Add test case for this to syn_misc.at invalid expression */ - cb_error_x (CB_TREE(current_statement), - _("invalid expression")); - return cb_error_node; - } - return x; - case CB_TAG_FUNCALL: - return x; - case CB_TAG_REFERENCE: - if (!CB_FIELD_P (cb_ref (x))) { - ret = cb_build_cond (cb_ref (x)); - cb_copy_source_reference (ret, x); - return ret; - } - - f = CB_FIELD_PTR (x); - - /* Level 88 condition */ - if (f->level == 88) { - /* Build an 88 condition at every occurrence */ - /* as it may be subscripted */ - ret = cb_build_cond (build_cond_88 (x)); - cb_copy_source_reference (ret, x); - return ret; - } - - break; - case CB_TAG_BINARY_OP: - p = CB_BINARY_OP (x); - if (!p->x || p->x == cb_error_node) { - return cb_error_node; - } - switch (p->op) { - case '!': - return CB_BUILD_NEGATION (cb_build_cond (p->x)); - case '&': - case '|': - if (!p->y || p->y == cb_error_node) { - return cb_error_node; - } - return cb_build_binary_op (cb_build_cond (p->x), p->op, cb_build_cond (p->y)); - default: - if (!p->y || p->y == cb_error_node) { - return cb_error_node; - } - f = NULL; - if (CB_REF_OR_FIELD_P (p->x)) { - f = CB_FIELD_PTR (p->x); - if(f->flag_any_length) - has_any_len = 1; - } - - if (CB_INDEX_OR_HANDLE_P (p->x) - || CB_INDEX_OR_HANDLE_P (p->y) - || CB_TREE_CLASS (p->x) == CB_CLASS_POINTER - || CB_TREE_CLASS (p->y) == CB_CLASS_POINTER) { - ret = cb_build_binary_op (p->x, '-', p->y); - } else if (CB_BINARY_OP_P (p->x) - || CB_BINARY_OP_P (p->y)) { - if (cb_is_integer_expr (x)) { - ret = cb_build_optim_cond (p); - break; - } - /* Decimal comparison */ - d1 = decimal_alloc (); - d2 = decimal_alloc (); - - decimal_expand (d1, p->x); - decimal_expand (d2, p->y); - dpush (CB_BUILD_FUNCALL_2 ("cob_decimal_cmp", d1, d2)); - decimal_free (); - decimal_free (); - ret = cb_list_reverse (decimal_stack); - decimal_stack = NULL; - } else { - /* DEBUG Bypass optimization for PERFORM */ - if (current_program->flag_debugging) { - ret = CB_BUILD_FUNCALL_2 ("cob_cmp", p->x, p->y); - break; - } - if (cb_check_num_cond (p->x, p->y)) { - size1 = cb_field_size (p->x); - ret = CB_BUILD_FUNCALL_3 ("memcmp", - CB_BUILD_CAST_ADDRESS (p->x), - CB_BUILD_CAST_ADDRESS (p->y), - cb_int (size1)); - break; - } - if (CB_TREE_CLASS (p->x) == CB_CLASS_NUMERIC - && CB_TREE_CLASS (p->y) == CB_CLASS_NUMERIC - && cb_fits_long_long (p->y)) { - if (CB_REF_OR_FIELD_P (p->x)) { - f = CB_FIELD_PTR (p->x); - if (cb_is_integer_field_and_int (f, p->y) - && cb_fits_int (p->y)) { - /* 'native' (short/int/long) on SYNC boundary */ - return CB_BUILD_FUNCALL_3 ("$:", p->x, (cb_tree)(long)p->op, p->y); - } - } - ret = cb_build_optim_cond (p); - break; - } - - /* Field comparison */ - if ((CB_REF_OR_FIELD_P (p->x)) - && (CB_TREE_CATEGORY (p->x) == CB_CATEGORY_ALPHANUMERIC || - CB_TREE_CATEGORY (p->x) == CB_CATEGORY_ALPHABETIC) - && cb_field_size (p->x) == 1 - && !has_any_len - && !current_program->alphabet_name_list - && (p->y == cb_space || p->y == cb_low || - p->y == cb_high || p->y == cb_zero)) { - ret = CB_BUILD_FUNCALL_2 ("$G", p->x, p->y); - break; - } - if (cb_check_alpha_cond (p->x) && - cb_check_alpha_cond (p->y)) { - size1 = cb_field_size (p->x); - size2 = cb_field_size (p->y); - } else { - size1 = 0; - size2 = 0; - } - if (size1 == 1 && size2 == 1 && !has_any_len) { - ret = CB_BUILD_FUNCALL_2 ("$G", p->x, p->y); - } else if (size1 != 0 && size1 == size2 && !has_any_len) { - ret = CB_BUILD_FUNCALL_3 ("memcmp", - CB_BUILD_CAST_ADDRESS (p->x), - CB_BUILD_CAST_ADDRESS (p->y), - cb_int (size1)); - } else { - if (CB_TREE_CLASS (p->x) == CB_CLASS_NUMERIC && p->y == cb_zero) { - ret = cb_build_optim_cond (p); - } else { - ret = CB_BUILD_FUNCALL_2 ("cob_cmp", p->x, p->y); - } - } - } - } - ret = cb_build_binary_op (ret, p->op, p->y); - if (ret != cb_true && ret != cb_false) { - cb_copy_source_reference (ret, x); - } - return ret; - default: - break; - } - cb_error_x (x, _("invalid expression")); - return cb_error_node; -} - -/* End parsing a 'condition' */ -void -cb_end_cond (cb_tree rslt) -{ - expr_dmax = -1; /* Reset 'Max scale' */ - expr_dec_align = -1; - expr_nest = 0; - expr_line = -1; - - if (cb_flag_remove_unreachable == 0) { - /* Do not remove the code */ - cond_fixed = -1; - return; - } - - if (rslt == cb_true) { - cond_fixed = 0; - } else - if (rslt == cb_false) { - cond_fixed = 1; - } else { - cond_fixed = -1; - } -} - -/* Save this 'condition' result */ -void -cb_save_cond (void) -{ - if (if_stop) { - return; - } - if (if_nest < MAX_NESTED_COND) { - if_cond[if_nest++] = cond_fixed; - } else { - /* result: errors won't be ignored in "false" condition parts */ - cb_warning (COBC_WARN_FILLER, - _("more than %d nested conditions"), MAX_NESTED_COND); - if_stop = 1; - if_nest = 0; - cb_set_ignore_error (0); - } -} - -/* TRUE side of 'condition' */ -void -cb_true_side (void) -{ - if (cond_fixed == 1) { - cb_set_ignore_error (1); - } else { - cb_set_ignore_error (0); - } -} - -/* FALSE side of 'condition' */ -void -cb_false_side (void) -{ - if (cond_fixed == 0) { - cb_set_ignore_error (1); - } else { - cb_set_ignore_error (0); - } -} - -/* END of statement that had a 'condition' */ -void -cb_terminate_cond (void) -{ - if (if_stop) - return; - if_nest--; - if (if_nest <= 0) { - cond_fixed = -1; - cb_set_ignore_error (0); - if_nest = 0; - } else { - cond_fixed = if_cond[if_nest]; - } -} - -/* Now at PERIOD, ending statement(s) */ -void -cb_end_statement (void) -{ - expr_dmax = -1; - expr_dec_align = -1; - expr_nest = 0; - if_stop = 0; - if_nest = 0; - cb_set_ignore_error (0); - expr_line = -1; -} - -/* ADD/SUBTRACT CORRESPONDING */ - -static cb_tree -cb_build_optim_add (cb_tree v, cb_tree n) -{ - size_t z; - const char *s; - struct cb_field *f; - - if (CB_REF_OR_FIELD_P (v)) { - f = CB_FIELD_PTR (v); - if (cb_is_integer_field(f) - && cb_is_integer_expr (n) - && cb_binary_truncate) { - return cb_build_assign (v, cb_build_binary_op (v, '+', n)); - } - if (!f->pic) { - return CB_BUILD_FUNCALL_3 ("cob_add_int", v, - cb_build_cast_int (n), - cb_int0); - } - if ( !f->pic->scale - && (f->usage == CB_USAGE_BINARY - || f->usage == CB_USAGE_COMP_5 - || f->usage == CB_USAGE_COMP_X - || f->usage == CB_USAGE_COMP_N)) { - z = ((size_t)f->size - 1) - + (8 * (f->pic->have_sign ? 1 : 0)) - + (16 * (f->flag_binary_swap ? 1 : 0)); -#if defined(COB_NON_ALIGNED) && !defined(_MSC_VER) && defined(COB_ALLOW_UNALIGNED) - switch (f->size) { - case 2: -#ifdef COB_SHORT_BORK - optimize_defs[bin_add_funcs[z].optim_val] = 1; - s = bin_add_funcs[z].optim_name; - break; -#endif - case 4: - case 8: - if (f->storage != CB_STORAGE_LINKAGE - && f->indexes == 0 - && (f->offset % f->size) == 0) { - optimize_defs[align_bin_add_funcs[z].optim_val] = 1; - s = align_bin_add_funcs[z].optim_name; - } else { - optimize_defs[bin_add_funcs[z].optim_val] = 1; - s = bin_add_funcs[z].optim_name; - } - break; - default: - optimize_defs[bin_add_funcs[z].optim_val] = 1; - s = bin_add_funcs[z].optim_name; - break; - } -#else -#ifdef COB_ALLOW_UNALIGNED - if (f->usage == CB_USAGE_COMP_5) { - switch (f->size) { - case 1: - case 2: - case 4: - case 8: - return cb_build_assign (v, cb_build_binary_op (v, '+', n)); - default: - break; - } - } -#endif - optimize_defs[bin_add_funcs[z].optim_val] = 1; - s = bin_add_funcs[z].optim_name; -#endif - if (s) { - return CB_BUILD_FUNCALL_2 (s, - CB_BUILD_CAST_ADDRESS (v), - cb_build_cast_int (n)); - } - } else if (!f->pic->scale - && f->usage == CB_USAGE_PACKED - && f->pic->digits < 10) { - optimize_defs[COB_ADD_PACKED_INT] = 1; - return CB_BUILD_FUNCALL_2 ("cob_add_packed_int", - v, cb_build_cast_int (n)); - } - if (cb_is_integer_field(f) - && cb_is_integer_expr (n)) { - return cb_build_assign (v, cb_build_binary_op (v, '+', n)); - } - } - return CB_BUILD_FUNCALL_3 ("cob_add_int", v, - cb_build_cast_int (n), cb_int0); -} - -static cb_tree -cb_build_optim_sub (cb_tree v, cb_tree n) -{ - size_t z; - const char *s; - struct cb_field *f; - - if (CB_REF_OR_FIELD_P (v)) { - f = CB_FIELD_PTR (v); - if (cb_is_integer_field(f) - && cb_is_integer_expr (n) - && cb_binary_truncate) { - return cb_build_assign (v, cb_build_binary_op (v, '-', n)); - } - if ( !f->pic->scale - && (f->usage == CB_USAGE_BINARY - || f->usage == CB_USAGE_COMP_5 - || f->usage == CB_USAGE_COMP_X - || f->usage == CB_USAGE_COMP_N)) { - z = ((size_t)f->size - 1) - + (8 * (f->pic->have_sign ? 1 : 0)) - + (16 * (f->flag_binary_swap ? 1 : 0)); -#if defined(COB_NON_ALIGNED) && !defined(_MSC_VER) && defined(COB_ALLOW_UNALIGNED) - switch (f->size) { - case 2: -#ifdef COB_SHORT_BORK - optimize_defs[bin_sub_funcs[z].optim_val] = 1; - s = bin_sub_funcs[z].optim_name; - break; -#endif - case 4: - case 8: - if (f->storage != CB_STORAGE_LINKAGE && - f->indexes == 0 && (f->offset % f->size) == 0) { - optimize_defs[align_bin_sub_funcs[z].optim_val] = 1; - s = align_bin_sub_funcs[z].optim_name; - } else { - optimize_defs[bin_sub_funcs[z].optim_val] = 1; - s = bin_sub_funcs[z].optim_name; - } - break; - default: - optimize_defs[bin_sub_funcs[z].optim_val] = 1; - s = bin_sub_funcs[z].optim_name; - break; - } -#else -#ifdef COB_ALLOW_UNALIGNED - if (f->usage == CB_USAGE_COMP_5) { - switch (f->size) { - case 1: - case 2: - case 4: - case 8: - return cb_build_assign (v, cb_build_binary_op (v, '-', n)); - default: - break; - } - } -#endif - optimize_defs[bin_sub_funcs[z].optim_val] = 1; - s = bin_sub_funcs[z].optim_name; -#endif - if (s) { - return CB_BUILD_FUNCALL_2 (s, - CB_BUILD_CAST_ADDRESS (v), - cb_build_cast_int (n)); - } - } - if (cb_is_integer_field(f) - && cb_is_integer_expr (n)) { - return cb_build_assign (v, cb_build_binary_op (v, '-', n)); - } - } - return CB_BUILD_FUNCALL_3 ("cob_sub_int", v, - cb_build_cast_int (n), cb_int0); -} - -cb_tree -cb_build_add (cb_tree v, cb_tree n, cb_tree round_opt) -{ - cb_tree opt; - struct cb_field *f; - -#ifdef COB_NON_ALIGNED - if (CB_INDEX_OR_HANDLE_P (v)) { - return cb_build_move (cb_build_binary_op (v, '+', n), v); - } - if (CB_TREE_CLASS (v) == CB_CLASS_POINTER) { - optimize_defs[COB_POINTER_MANIP] = 1; - return CB_BUILD_FUNCALL_3 ("cob_pointer_manip", cb_build_address (v), n, cb_int0); - } -#else - if (CB_INDEX_OR_HANDLE_P (v) || CB_TREE_CLASS (v) == CB_CLASS_POINTER) { - return cb_build_move (cb_build_binary_op (v, '+', n), v); - } -#endif - - if (CB_REF_OR_FIELD_P (v)) { - f = CB_FIELD_PTR (v); - f->count++; - } - if (CB_REF_OR_FIELD_P (n)) { - f = CB_FIELD_PTR (n); - f->count++; - } - if (round_opt == cb_high) { - /* Short circuit from tree.c for perform */ - if (cb_fits_int (n)) { - return cb_build_optim_add (v, n); - } else { - return CB_BUILD_FUNCALL_3 ("cob_add", v, n, cb_int0); - } - } - opt = build_store_option (v, round_opt); - if (opt == cb_int0 - && cb_fits_int (n)) { - return cb_build_optim_add (v, n); - } - return CB_BUILD_FUNCALL_3 ("cob_add", v, n, opt); -} - -cb_tree -cb_build_sub (cb_tree v, cb_tree n, cb_tree round_opt) -{ - cb_tree opt; - struct cb_field *f; - -#ifdef COB_NON_ALIGNED - if (CB_INDEX_OR_HANDLE_P (v)) { - return cb_build_move (cb_build_binary_op (v, '-', n), v); - } - if (CB_TREE_CLASS (v) == CB_CLASS_POINTER) { - optimize_defs[COB_POINTER_MANIP] = 1; - return CB_BUILD_FUNCALL_3 ("cob_pointer_manip", cb_build_address (v), n, cb_int1); - } -#else - if (CB_INDEX_OR_HANDLE_P (v) || CB_TREE_CLASS (v) == CB_CLASS_POINTER) { - return cb_build_move (cb_build_binary_op (v, '-', n), v); - } -#endif - - if (CB_REF_OR_FIELD_P (v)) { - f = CB_FIELD_PTR (v); - f->count++; - } - if (CB_REF_OR_FIELD_P (n)) { - f = CB_FIELD_PTR (n); - f->count++; - } - opt = build_store_option (v, round_opt); - if (opt == cb_int0 - && cb_fits_int (n)) { - return cb_build_optim_sub (v, n); - } - return CB_BUILD_FUNCALL_3 ("cob_sub", v, n, opt); -} - -static unsigned int -emit_corresponding (cb_tree (*func) (cb_tree f1, cb_tree f2, cb_tree f3), - cb_tree x1, cb_tree x2, cb_tree opt) -{ - struct cb_field *f1, *f2; - cb_tree t1; - cb_tree t2; - unsigned int found; - - found = 0; - for (f1 = CB_FIELD_PTR (x1)->children; f1; f1 = f1->sister) { - if (!f1->redefines && !f1->flag_occurs) { - for (f2 = CB_FIELD_PTR (x2)->children; f2; f2 = f2->sister) { - if (!f2->redefines && !f2->flag_occurs) { - if (strcmp (f1->name, f2->name) == 0) { - t1 = cb_build_field_reference (f1, x1); - t2 = cb_build_field_reference (f2, x2); - if (f1->children && f2->children) { - found += emit_corresponding (func, t1, t2, opt); - } else { - if ((CB_TREE_CATEGORY (t1) == CB_CATEGORY_NUMERIC) && - (CB_TREE_CATEGORY (t2) == CB_CATEGORY_NUMERIC)) { - found++; - cb_emit (func (t1, t2, opt)); - } - } - } - } - } - } - } - return found; -} - -void -cb_emit_corresponding (cb_tree (*func) (cb_tree f1, cb_tree f2, cb_tree f3), - cb_tree x1, cb_tree x2, cb_tree opt) -{ - x1 = cb_check_group_name (x1); - x2 = cb_check_group_name (x2); - - if (cb_validate_one (x1)) { - return; - } - if (cb_validate_one (x2)) { - return; - } - - if (!emit_corresponding (func, x1, x2, opt)) { - cb_warning_x (cb_warn_corresponding, x2, _("no CORRESPONDING items found")); - } -} - -void -cb_emit_tab_arithmetic (cb_tree (*func) (cb_tree f1, cb_tree f2, cb_tree f3), - cb_tree x1, cb_tree x2, cb_tree opt, cb_tree from_to_idx, cb_tree dest_idx) -{ - if (cb_validate_one (x1)) { - return; - } - if (cb_tree_category (x1) != CB_CATEGORY_NUMERIC) { - cb_error_x (x1, _("'%s' is not numeric"), cb_name (x1)); - } - - if (cb_validate_one (x2)) { - return; - } - if (cb_tree_category (x2) != CB_CATEGORY_NUMERIC) { - cb_error_x (x2, _("'%s' is not numeric"), cb_name (x2)); - } - - /* TODO pending, no actual code generation */ - COB_UNUSED (func); - COB_UNUSED (opt); - COB_UNUSED (from_to_idx); - COB_UNUSED (dest_idx); -} - -static unsigned int -emit_move_corresponding (cb_tree x1, cb_tree x2) -{ - struct cb_field *f1, *f2; - cb_tree t1; - cb_tree t2; - unsigned int found; - - found = 0; - for (f1 = CB_FIELD_PTR (x1)->children; f1; f1 = f1->sister) { - if (!f1->redefines && !f1->flag_occurs) { - for (f2 = CB_FIELD_PTR (x2)->children; f2; f2 = f2->sister) { - if (!f2->redefines && !f2->flag_occurs) { - if (strcmp (f1->name, f2->name) == 0) { - t1 = cb_build_field_reference (f1, x1); - t2 = cb_build_field_reference (f2, x2); - if (f1->children && f2->children) { - found += emit_move_corresponding (t1, t2); - } else { - cb_emit (cb_build_move (t1, t2)); - found++; - } - } - } - } - } - } - return found; -} - -void -cb_emit_move_corresponding (cb_tree source, cb_tree target_list) -{ - cb_tree l; - cb_tree target; - - source = cb_check_group_name (source); - if (cb_validate_one (source)) { - return; - } - for (l = target_list; l; l = CB_CHAIN(l)) { - target = CB_VALUE(l); - target = cb_check_group_name (target); - if (cb_validate_one (target)) { - return; - } - if (!emit_move_corresponding (source, target)) { - cb_warning_x (cb_warn_corresponding, target, _("no CORRESPONDING items found")); - } else if (cb_listing_xref) { - cobc_xref_set_receiving (target); - } - } -} - -static unsigned int -emit_accept_external_form (cb_tree x) -{ - struct cb_field *f; - cb_tree f_ref, f_ref_2, ext_form_id, index_lit; - int i; - char buff[32]; - unsigned int found = 0; - - for (f = CB_FIELD_PTR (x)->children; f; f = f->sister) { - if (f->redefines) { - continue; - } - - if (f->children) { - f_ref = cb_build_field_reference (f, x); - found += emit_accept_external_form (f_ref); - continue; - } - - if (f->external_form_identifier) { - ext_form_id = f->external_form_identifier; - } else { - ext_form_id = cb_build_alphanumeric_literal (f->name, strlen (f->name)); - } - if (f->flag_occurs) { - for (i = 1; i <= f->occurs_max; i++) { - sprintf (buff, "%d", i); - index_lit = cb_build_numeric_literal(0, buff, 0); - - f_ref_2 = cb_build_field_reference (f, x); - CB_REFERENCE (f_ref_2)->subs = CB_LIST_INIT (index_lit); - -#if 0 /* TODO: implement CGI runtime, see Patch #27 */ - cb_emit (CB_BUILD_FUNCALL_3 ("cob_cgi_getCgiValue", - ext_form_id, index_lit, - f_ref_2)); -#endif - } -#if 0 /* TODO: implement CGI runtime, see Patch #27 */ - } else { - index_lit = cb_build_numeric_literal (0, "1", 0); - cb_emit (CB_BUILD_FUNCALL_3 ("cob_cgi_getCgiValue", - ext_form_id, index_lit, - f_ref)); -#else - COB_UNUSED (ext_form_id); -#endif - } - found++; - } - - return found; -} - -static void -cb_emit_accept_external_form (cb_tree x1) -{ - cb_tree x2; - - x2 = cb_check_group_name (x1); - if (cb_validate_one (x2)) { - return; - } - if (!emit_accept_external_form (x2)) { - cb_warning_x (COBC_WARN_FILLER, x1, _("no items to ACCEPT found")); - } -} - -static unsigned int -emit_display_external_form (cb_tree x) -{ - struct cb_field *f, *f_ref_field; - cb_tree f_ref, ext_form_id; - unsigned int found = 0; - - for (f = CB_FIELD_PTR (x)->children; f; f = f->sister) { - if (f->redefines || f->flag_occurs) { - continue; - } - - f_ref = cb_build_field_reference (f, x); - if (f->children) { - found += emit_display_external_form (f_ref); - } else { - /* TO-DO: Is CB_FIELD (cb_ref (f_ref)) == f? */ - f_ref_field = CB_FIELD (cb_ref (f_ref)); - if (f_ref_field->external_form_identifier) { - ext_form_id = f_ref_field->external_form_identifier; - } else { - ext_form_id = cb_build_alphanumeric_literal (f_ref_field->name, - strlen (f_ref_field->name)); - } -#if 0 /* TODO: implement CGI runtime, see Patch #27 */ - cb_emit (CB_BUILD_FUNCALL_2 ("cob_cgi_addTplVar", ext_form_id, f_ref)); -#else - COB_UNUSED (ext_form_id); -#endif - found++; - } - } - - return found; -} - -static void -cb_emit_display_external_form (cb_tree x1) -{ - cb_tree x2; - - x2 = cb_check_group_name (x1); - if (cb_validate_one (x2)) { - return; - } - if (!emit_display_external_form (x2)) { - cb_warning_x (COBC_WARN_FILLER, x1, _("no items to DISPLAY found")); - } -} - -static int -get_screen_type (const struct cb_field * const p) -{ - if (p->children) { - return COB_SCREEN_TYPE_GROUP; - } else if (p->values) { - return COB_SCREEN_TYPE_VALUE; - } else if (p->size > 0) { - return COB_SCREEN_TYPE_FIELD; - } else { - return COB_SCREEN_TYPE_ATTRIBUTE; - } -} - -static void -output_screen_from (struct cb_field *p, const unsigned int sisters) -{ - int type; - - if (sisters && p->sister) { - output_screen_from (p->sister, 1U); - } - if (p->children) { - output_screen_from (p->children, 1U); - } - - type = get_screen_type (p); - if (type == COB_SCREEN_TYPE_FIELD && p->screen_from) { - /* Bump reference count */ - p->count++; - cb_emit (CB_BUILD_FUNCALL_2 ("cob_move", p->screen_from, - CB_TREE (p))); - } -} - -static void -output_screen_to (struct cb_field *p, const unsigned int sisters) -{ - int type; - - if (sisters && p->sister) { - output_screen_to (p->sister, 1U); - } - if (p->children) { - output_screen_to (p->children, 1U); - } - - type = get_screen_type (p); - if (type == COB_SCREEN_TYPE_FIELD && p->screen_to) { - /* Bump reference count */ - p->count++; - cb_emit (CB_BUILD_FUNCALL_2 ("cob_move", CB_TREE (p), p->screen_to)); - } -} - -/* ACCEPT statement */ - -static COB_INLINE COB_A_INLINE int -is_reference_with_value (cb_tree pos) -{ - return CB_REFERENCE_P (pos) - && (CB_REFERENCE (pos))->value != NULL; - -} - -static int -numeric_screen_pos_type (struct cb_field *pos) -{ - return pos->pic - && pos->pic->category == CB_CATEGORY_NUMERIC - && pos->pic->scale == 0; -} - -static int -numeric_children_screen_pos_type (struct cb_field* child) -{ - child = child->children; - if (!child) return 0; - - for (; child; child = child->sister) { - if (!numeric_screen_pos_type (child)) { - return 0; - } - } - - return 1; -} - -static int -valid_screen_pos (cb_tree pos) -{ - cb_tree pos_ref = pos; - int size = -1; - - /* Find size of pos value, if possible */ - if (CB_INVALID_TREE (pos)) { - return 0; - } - if (CB_REFERENCE_P (pos)) { - pos = cb_ref (pos); - } - if (CB_LITERAL_P (pos)) { - if (CB_TREE_CATEGORY (pos) == CB_CATEGORY_NUMERIC) { - size = CB_LITERAL (pos)->size; - } else { - size = -1; - } - } else if (CB_FIELD_P (pos)) { - struct cb_field *field = CB_FIELD (pos); - if (numeric_screen_pos_type (field)) { - size = field->pic->size; - } else if (numeric_children_screen_pos_type (field)) { - size = field->size; - } - } else if (pos == cb_zero) { - cb_error_x (pos_ref, _("cannot specify figurative constant ZERO in AT clause")); - return 0; - } - if (size == -1) { - cb_error_x (pos_ref, _("value in AT clause is not numeric")); - return 0; - } - - /* Check if size is valid. If it isn't, display error. */ - if (size != 4 && size != 6) { - cb_error_x (pos_ref, _("value in AT clause must have 4 or 6 digits")); - return 0; - } else { - return 1; - } -} - -static void -get_line_and_column_from_pos (const cb_tree pos, cb_tree * const line_or_pos, - cb_tree * const column) -{ - if (!pos) { - *line_or_pos = NULL; - *column = NULL; - } else if (CB_PAIR_P (pos)) { - *line_or_pos = CB_PAIR_X (pos); - *column = CB_PAIR_Y (pos); - /* Note: This must not be done for column where we need the 0, - otherwise screenio.c (extract_line_and_col_vals) would - evaluate the field "line" as a combined position */ - if (*line_or_pos == cb_int0) { - *line_or_pos = NULL; - } - } else if (valid_screen_pos (pos)) { - *line_or_pos = pos; - *column = NULL; - } -} - -static void -cb_gen_field_accept (cb_tree var, cb_tree pos, cb_tree fgc, cb_tree bgc, - cb_tree scroll, cb_tree timeout, cb_tree prompt, - cb_tree size_is, cob_flags_t disp_attrs) -{ - cb_tree line = NULL; - cb_tree column = NULL; - - if (!pos) { - cb_emit (CB_BUILD_FUNCALL_10 ("cob_field_accept", - var, NULL, NULL, fgc, bgc, scroll, - timeout, prompt, size_is, cb_flags_t (disp_attrs))); - } else if (CB_LIST_P (pos)) { - get_line_and_column_from_pos (pos, &line, &column); - cb_emit (CB_BUILD_FUNCALL_10 ("cob_field_accept", - var, line, column, fgc, bgc, scroll, - timeout, prompt, size_is, cb_flags_t (disp_attrs))); - } else if (valid_screen_pos (pos)) { - cb_emit (CB_BUILD_FUNCALL_10 ("cob_field_accept", - var, pos, NULL, fgc, bgc, scroll, - timeout, prompt, size_is, cb_flags_t (disp_attrs))); - } -} - -static COB_INLINE COB_A_INLINE int -line_col_zero_is_supported (void) -{ - return cb_accept_display_extensions == CB_OK - || cb_accept_display_extensions == CB_WARNING - || cb_accept_display_extensions == CB_ARCHAIC - || cb_accept_display_extensions == CB_OBSOLETE; -} - -void -cb_emit_accept (cb_tree var, cb_tree pos, struct cb_attr_struct *attr_ptr) -{ - cb_tree line; - cb_tree column; - cb_tree fgc; - cb_tree bgc; - cb_tree scroll; - cb_tree timeout; - cb_tree prompt; - cb_tree size_is; /* WITH SIZE IS */ - cob_flags_t disp_attrs; - - if (current_program->flag_screen) { -#ifndef WITH_EXTENDED_SCREENIO - if (!warn_screen_done) { - warn_screen_done = 1; - cb_warning (cb_warn_unsupported, - _("compiler is not configured to support %s"), "SCREEN SECTION"); - } -#endif - } - if (cb_validate_one (var)) { - return; - } - if (cb_listing_xref) { - cobc_xref_set_receiving (var); - } - - if (attr_ptr) { - fgc = attr_ptr->fgc; - bgc = attr_ptr->bgc; - scroll = attr_ptr->scroll; - timeout = attr_ptr->timeout; - prompt = attr_ptr->prompt; - size_is = attr_ptr->size_is; - disp_attrs = attr_ptr->dispattrs; - if (cb_validate_one (pos) - || cb_validate_one (fgc) - || cb_validate_one (bgc) - || cb_validate_one (scroll) - || cb_validate_one (timeout) - || cb_validate_one (prompt) - || cb_validate_one (size_is)) { - return; - } - } else { - fgc = NULL; - bgc = NULL; - scroll = NULL; - timeout = NULL; - prompt = NULL; - size_is = NULL; - disp_attrs = 0; - } - - if (prompt) { - /* PROMPT character - 1 character identifier or literal */ - if (CB_LITERAL_P (prompt)) { - if (CB_LITERAL (prompt)->size != 1) { - cb_error_x (prompt, _("invalid PROMPT literal")); - return; - } - } else { - if (CB_FIELD_PTR (prompt)->size != 1) { - cb_error_x (prompt, _("invalid PROMPT identifier")); - return; - } - } - } - - /* CGI: ACCEPT external-form */ - /* TODO: CHECKME, see Patch #27 */ - if (CB_REF_OR_FIELD_P (var) && CB_FIELD (cb_ref (var))->flag_is_external_form) { - cb_emit_accept_external_form (var); - return; - } - -#if 0 /* RXWRXW - Screen */ - if ((CB_REF_OR_FIELD_P (var)) && - CB_FIELD (cb_ref (var))->storage == CB_STORAGE_SCREEN) { - current_program->flag_screen = 1; - } -#endif - - if (current_program->flag_screen) { - /* Bump ref count to force CRT STATUS field generation - and include it in cross-reference */ - if (current_program->crt_status) { - CB_FIELD_PTR (current_program->crt_status)->count++; - if (cb_listing_xref) { - cobc_xref_set_receiving (current_program->crt_status); - } - } - if ((CB_REF_OR_FIELD_P (var)) - && CB_FIELD_PTR (var)->storage == CB_STORAGE_SCREEN) { - output_screen_from (CB_FIELD_PTR (var), 0); - gen_screen_ptr = 1; - if (pos) { - if (CB_LIST_P (pos)) { - line = CB_PAIR_X (pos); - column = CB_PAIR_Y (pos); - cb_emit (CB_BUILD_FUNCALL_5 ("cob_screen_accept", - var, line, column, timeout, - cb_int (line_col_zero_is_supported ()))); - } else if (valid_screen_pos (pos)) { - cb_emit (CB_BUILD_FUNCALL_5 ("cob_screen_accept", - var, pos, NULL, timeout, - cb_int (line_col_zero_is_supported ()))); - } - } else { - cb_emit (CB_BUILD_FUNCALL_5 ("cob_screen_accept", - var, NULL, NULL, timeout, - cb_int (line_col_zero_is_supported ()))); - } - gen_screen_ptr = 0; - output_screen_to (CB_FIELD (cb_ref (var)), 0); - } else { - if (var == cb_null) { - var = NULL; - } - if (pos || fgc || bgc || scroll || disp_attrs) { - cb_gen_field_accept (var, pos, fgc, bgc, scroll, - timeout, prompt, size_is, disp_attrs); - } else { - cb_emit (CB_BUILD_FUNCALL_10 ("cob_field_accept", - var, NULL, NULL, fgc, bgc, - scroll, timeout, prompt, - size_is, cb_flags_t (disp_attrs))); - } - } - } else if (pos || fgc || bgc || scroll || disp_attrs - || timeout || prompt || size_is) { - /* Bump ref count to force CRT STATUS field generation - and include it in cross-reference */ - if (current_program->crt_status) { - CB_FIELD_PTR (current_program->crt_status)->count++; - if (cb_listing_xref) { - cobc_xref_set_receiving (current_program->crt_status); - } - } - if (var == cb_null) { - var = NULL; - } - cb_gen_field_accept (var, pos, fgc, bgc, scroll, - timeout, prompt, size_is, disp_attrs); - } else { - if (var == cb_null) { - var = NULL; - } - cb_emit (CB_BUILD_FUNCALL_1 ("cob_accept", var)); - } -} - -void -cb_emit_accept_line_or_col (cb_tree var, const int l_or_c) -{ - if (cb_validate_one (var)) { - return; - } - if (cb_listing_xref) { - cobc_xref_set_receiving (var); - } - cb_emit (CB_BUILD_FUNCALL_2 ("cob_screen_line_col", var, cb_int (l_or_c))); -} - -void -cb_emit_accept_escape_key (cb_tree var) -{ - if (cb_validate_one (var)) { - return; - } - if (cb_listing_xref) { - cobc_xref_set_receiving (var); - } - cb_emit (CB_BUILD_FUNCALL_1 ("cob_accept_escape_key", var)); -} - -void -cb_emit_accept_exception_status (cb_tree var) -{ - if (cb_validate_one (var)) { - return; - } - if (cb_listing_xref) { - cobc_xref_set_receiving (var); - } - cb_emit (CB_BUILD_FUNCALL_1 ("cob_accept_exception_status", var)); -} - -void -cb_emit_accept_user_name (cb_tree var) -{ - if (cb_validate_one (var)) { - return; - } - if (cb_listing_xref) { - cobc_xref_set_receiving (var); - } - cb_emit (CB_BUILD_FUNCALL_1 ("cob_accept_user_name", var)); -} - -void -cb_emit_accept_date (cb_tree var) -{ - if (cb_validate_one (var)) { - return; - } - if (cb_listing_xref) { - cobc_xref_set_receiving (var); - } - cb_emit (CB_BUILD_FUNCALL_1 ("cob_accept_date", var)); -} - -void -cb_emit_accept_date_yyyymmdd (cb_tree var) -{ - if (cb_validate_one (var)) { - return; - } - if (cb_listing_xref) { - cobc_xref_set_receiving (var); - } - cb_emit (CB_BUILD_FUNCALL_1 ("cob_accept_date_yyyymmdd", var)); -} - -void -cb_emit_accept_day (cb_tree var) -{ - if (cb_validate_one (var)) { - return; - } - if (cb_listing_xref) { - cobc_xref_set_receiving (var); - } - cb_emit (CB_BUILD_FUNCALL_1 ("cob_accept_day", var)); -} - -void -cb_emit_accept_day_yyyyddd (cb_tree var) -{ - if (cb_validate_one (var)) { - return; - } - if (cb_listing_xref) { - cobc_xref_set_receiving (var); - } - cb_emit (CB_BUILD_FUNCALL_1 ("cob_accept_day_yyyyddd", var)); -} - -void -cb_emit_accept_day_of_week (cb_tree var) -{ - if (cb_validate_one (var)) { - return; - } - if (cb_listing_xref) { - cobc_xref_set_receiving (var); - } - cb_emit (CB_BUILD_FUNCALL_1 ("cob_accept_day_of_week", var)); -} - -void -cb_emit_accept_time (cb_tree var) -{ - if (cb_validate_one (var)) { - return; - } - if (cb_listing_xref) { - cobc_xref_set_receiving (var); - } - cb_emit (CB_BUILD_FUNCALL_1 ("cob_accept_time", var)); -} - -void -cb_emit_accept_command_line (cb_tree var) -{ - if (cb_validate_one (var)) { - return; - } - if (cb_listing_xref) { - cobc_xref_set_receiving (var); - } - cb_emit (CB_BUILD_FUNCALL_1 ("cob_accept_command_line", var)); -} - -void -cb_emit_get_environment (cb_tree envvar, cb_tree envval) -{ - if (cb_validate_one (envvar)) { - return; - } - if (cb_listing_xref) { - cobc_xref_set_receiving (envvar); - } - if (cb_validate_one (envval)) { - return; - } - cb_emit (CB_BUILD_FUNCALL_2 ("cob_get_environment", envvar, envval)); -} - -void -cb_emit_accept_environment (cb_tree var) -{ - if (cb_validate_one (var)) { - return; - } - if (cb_listing_xref) { - cobc_xref_set_receiving (var); - } - cb_emit (CB_BUILD_FUNCALL_1 ("cob_accept_environment", var)); -} - -void -cb_emit_accept_arg_number (cb_tree var) -{ - if (cb_validate_one (var)) { - return; - } - if (cb_listing_xref) { - cobc_xref_set_receiving (var); - } - cb_emit (CB_BUILD_FUNCALL_1 ("cob_accept_arg_number", var)); -} - -void -cb_emit_accept_arg_value (cb_tree var) -{ - if (cb_validate_one (var)) { - return; - } - if (cb_listing_xref) { - cobc_xref_set_receiving (var); - } - cb_emit (CB_BUILD_FUNCALL_1 ("cob_accept_arg_value", var)); -} - -void -cb_emit_accept_mnemonic (cb_tree var, cb_tree mnemonic) -{ - cb_tree mnemonic_ref; - - if (cb_validate_one (var)) { - return; - } - mnemonic_ref = cb_ref (mnemonic); - if (mnemonic_ref == cb_error_node) { - return; - } - switch (CB_SYSTEM_NAME (mnemonic_ref)->token) { - case CB_DEVICE_CONSOLE: - case CB_DEVICE_SYSIN: - cb_emit (CB_BUILD_FUNCALL_1 ("cob_accept", var)); - break; - default: - cb_error_x (mnemonic, _("'%s' is not an input device"), - cb_name (mnemonic)); - break; - } -} - -void -cb_emit_accept_name (cb_tree var, cb_tree name) -{ - cb_tree sys; - - if (cb_validate_one (var)) { - return; - } - if (cb_listing_xref) { - cobc_xref_set_receiving (var); - } - - /* Allow direct reference to a device name (not defined as mnemonic name) */ - sys = get_system_name (CB_NAME (name)); - if (sys) { - switch (CB_SYSTEM_NAME (sys)->token) { - case CB_DEVICE_CONSOLE: - case CB_DEVICE_SYSIN: - /* possibly others allow this, too, consider adding a config option */ - if (cb_std_define != CB_STD_IBM - && cb_std_define != CB_STD_MVS - && cb_std_define != CB_STD_MF - && !cb_relaxed_syntax_checks) { - cb_warning_x (COBC_WARN_FILLER, name, - _("'%s' is not defined in SPECIAL-NAMES"), CB_NAME (name)); - } - cb_emit (CB_BUILD_FUNCALL_1 ("cob_accept", var)); - return; - default: - cb_error_x (name, _("invalid input device '%s'"), - cb_name (name)); - return; - } - } else if (is_default_reserved_word (CB_NAME (name))) { - cb_error_x (name, _("unknown device '%s'; it may exist in another dialect"), - CB_NAME (name)); - } else { - cb_error_x (name, _("unknown device '%s'; not defined in SPECIAL-NAMES"), - CB_NAME (name)); - } -} - -/* ALLOCATE statement */ - -void -cb_emit_allocate (cb_tree target1, cb_tree target2, cb_tree size, - cb_tree initialize) -{ - cb_tree x; - char buff[32]; - - if (cb_validate_one (target1) - || cb_validate_one (target2) - || cb_validate_one (size) - || cb_validate_one (initialize)) { - return; - } - if (target1) { - if (!(CB_REFERENCE_P(target1) && - CB_FIELD_PTR (target1)->flag_item_based)) { - cb_error_x (CB_TREE(current_statement), - _("target of ALLOCATE is not a BASED item")); - return; - } - if (cb_listing_xref) { - cobc_xref_set_receiving (target1); - } - } - if (target2) { - if (!(CB_REFERENCE_P(target2) && - CB_TREE_CLASS (target2) == CB_CLASS_POINTER)) { - cb_error_x (CB_TREE(current_statement), - _("target of RETURNING is not a data pointer")); - return; - } - if (cb_listing_xref) { - cobc_xref_set_receiving (target2); - } - } - if (size) { - if (CB_TREE_CLASS (size) != CB_CLASS_NUMERIC) { - cb_error_x (CB_TREE(current_statement), - _("amount must be specified as a numeric expression")); - return; - } - } - if (target1) { - sprintf (buff, "%d", CB_FIELD_PTR (target1)->memory_size); - x = cb_build_numeric_literal (0, buff, 0); - cb_emit (CB_BUILD_FUNCALL_4 ("cob_allocate", - CB_BUILD_CAST_ADDR_OF_ADDR (target1), - target2, x, NULL)); - } else { - if (initialize && !cb_category_is_alpha (initialize)) { - cb_error_x (CB_TREE(current_statement), - _("INITIALIZED TO item is not alphanumeric")); - } - cb_emit (CB_BUILD_FUNCALL_4 ("cob_allocate", - NULL, target2, size, initialize)); - } - if (initialize && target1) { - current_statement->not_ex_handler = - cb_build_initialize (target1, cb_true, NULL, 1, 0, 0); - } -} - - -/* ALTER statement */ - -void -cb_emit_alter (cb_tree source, cb_tree target) -{ - if (source == cb_error_node) { - return; - } - if (target == cb_error_node) { - return; - } - CB_REFERENCE(source)->flag_alter_code = 1; - cb_emit (cb_build_alter (source, target)); -} - -/* CALL statement */ - -static const char * -get_constant_call_name (cb_tree prog) -{ - /* plain literal or constant (level 78 item, 01 CONSTANT, SYMBOLIC CONSTANT) */ - if (CB_LITERAL_P (prog) && CB_TREE_CATEGORY (prog) != CB_CATEGORY_NUMERIC) { - return (const char *)CB_LITERAL (prog)->data; - /* reference (ideally on a prototype) */ - } else if (CB_REFERENCE_P (prog)) { - cb_tree x = cb_ref (prog); - if (CB_PROTOTYPE_P (x)) { - return CB_PROTOTYPE (x)->ext_name; - } - } - return NULL; -} - -void -cb_emit_call (cb_tree prog, cb_tree par_using, cb_tree returning, - cb_tree on_exception, cb_tree not_on_exception, - cb_tree convention, cb_tree newthread, cb_tree handle, - int call_line_number) -{ - cb_tree l; - cb_tree x; - struct cb_field *f; - const struct system_table *psyst; - const char *entry; - const char *constant_call_name = get_constant_call_name (prog); - char c; - cob_s64_t val; - cob_s64_t valmin; - cob_s64_t valmax; - cob_u32_t is_sys_call; - cob_u32_t is_sys_idx; - int error_ind; - int call_conv; - unsigned int numargs; - - if (CB_INTRINSIC_P (prog)) { - if (CB_INTRINSIC (prog)->intr_tab->category != CB_CATEGORY_ALPHANUMERIC) { - cb_error_x (CB_TREE (current_statement), - _("only alphanumeric FUNCTION types are allowed here")); - return; - } - } - if (returning && returning != cb_null) { - if (CB_TREE_CLASS (returning) != CB_CLASS_NUMERIC && - CB_TREE_CLASS (returning) != CB_CLASS_POINTER) { - cb_error_x (CB_TREE (current_statement), - _("invalid RETURNING field")); - return; - } - } - - error_ind = 0; - - if (convention) { - if (CB_INTEGER_P (convention)) { - call_conv = CB_INTEGER (convention)->val; - } else { - call_conv = cb_get_int (convention); - } - } else { - call_conv = 0; - } -#ifndef _WIN32 - if (call_conv & CB_CONV_STDCALL) { - call_conv &= ~CB_CONV_STDCALL; - cb_warning (cb_warn_extra, _("STDCALL not available on this platform")); - } -#elif defined(_WIN64) - if (call_conv & CB_CONV_STDCALL) { - cb_warning (cb_warn_extra, _("STDCALL used on 64-bit Windows platform")); - } -#endif - if ((call_conv & CB_CONV_STATIC_LINK) && !constant_call_name) { - cb_error_x (CB_TREE (current_statement), - _("STATIC CALL convention requires a literal program name")); - error_ind = 1; - } - - if (handle && !usage_is_thread_handle(handle)) { - cb_error_x (handle, _("HANDLE must be either a generic or a THREAD HANDLE")); - error_ind = 1; - } - - numargs = 0; - - for (l = par_using; l; l = CB_CHAIN (l), numargs++) { - x = CB_VALUE (l); - if (x == cb_error_node) { - error_ind = 1; - continue; - } - if (CB_NUMERIC_LITERAL_P (x)) { - if (CB_PURPOSE_INT (l) != CB_CALL_BY_VALUE) { - continue; - } - if (CB_SIZES_INT_UNSIGNED(l) && - CB_LITERAL (x)->sign < 0) { - cb_error_x (x, _("numeric literal is negative")); - error_ind = 1; - continue; - } - val = 0; - valmin = 0; - valmax = 0; - switch (CB_SIZES_INT (l)) { - case CB_SIZE_1: - val = cb_get_long_long (x); - if (CB_SIZES_INT_UNSIGNED(l)) { - valmin = 0; - valmax = UCHAR_MAX; - } else { - valmin = CHAR_MIN; - valmax = CHAR_MAX; - } - break; - case CB_SIZE_2: - val = cb_get_long_long (x); - if (CB_SIZES_INT_UNSIGNED(l)) { - valmin = 0; - valmax = USHRT_MAX; - } else { - valmin = SHRT_MIN; - valmax = SHRT_MAX; - } - break; - case CB_SIZE_4: - val = cb_get_long_long (x); - if (CB_SIZES_INT_UNSIGNED(l)) { - valmin = 0; - valmax = UINT_MAX; - } else { - valmin = INT_MIN; - valmax = INT_MAX; - } - break; - case CB_SIZE_8: - case CB_SIZE_AUTO: - if (CB_SIZES_INT_UNSIGNED(l)) { - if (CB_LITERAL (x)->size < 20) { - break; - } - if (CB_LITERAL (x)->size > 20) { - valmin = 1; - break; - } - if (memcmp (CB_LITERAL (x)->data, - "18446744073709551615", - (size_t)20) > 0) { - valmin = 1; - break; - } - } else { - if (CB_LITERAL (x)->size < 19) { - break; - } - if (CB_LITERAL (x)->size > 19) { - valmin = 1; - break; - } - if (memcmp (CB_LITERAL (x)->data, - CB_LITERAL (x)->sign ? - "9223372036854775808" : - "9223372036854775807", - (size_t)19) > 0) { - valmin = 1; - break; - } - } - break; - default: - break; - } - if (!valmin && !valmax) { - continue; - } - if (val < valmin || val > valmax) { - cb_error_x (x, _("numeric literal exceeds size limits")); - error_ind = 1; - } - continue; - } - if (CB_CONST_P (x) - && x != cb_null - && x != cb_space - && x != cb_zero) { - if (x == cb_space || - x == cb_norm_low || - x == cb_norm_high|| - x == cb_quote) { - c = (char)get_value (x); - x = cb_build_alphanumeric_literal (&c, 1); - } else if (x == cb_zero) { - x = cb_build_numsize_literal ("0", 1, 0); - } else{ - cb_error_x (x, _ ("figurative constant %s invalid here"), cb_name (x)); - error_ind = 1; - continue; - } - } - if ((CB_REFERENCE_P (x) && CB_FIELD_P(CB_REFERENCE(x)->value)) || - CB_FIELD_P (x)) { - f = CB_FIELD_PTR (x); - if (f->level == 88) { - cb_error_x (x, _("'%s' is not a valid data name"), CB_NAME (x)); - error_ind = 1; - continue; - } - if (f->flag_any_length && - CB_PURPOSE_INT (l) != CB_CALL_BY_REFERENCE) { - cb_error_x (x, _("'%s' ANY LENGTH item not passed BY REFERENCE"), CB_NAME (x)); - error_ind = 1; - continue; - } - if (cb_warn_call_params && - CB_PURPOSE_INT (l) == CB_CALL_BY_REFERENCE) { - if (f->level != 01 && f->level != 77) { - cb_warning_x (cb_warn_call_params, x, - _("'%s' is not a 01 or 77 level item"), CB_NAME (x)); - } - } - } - } - - is_sys_call = 0; - if (constant_call_name) { - const char *p = constant_call_name; - entry = p; - for (; *p; ++p) { - if (*p == '/' || *p == '\\') { - entry = p + 1; - } - - } - - is_sys_idx = 1; - for (psyst = system_tab; psyst->syst_name; psyst++, is_sys_idx++) { - if (!strcmp(entry, (const char *)psyst->syst_name)) { - char *name; - char xname[7]; - if (psyst->syst_name[1]) { - name = (char *)psyst->syst_name; - } else { - sprintf (xname, "X\"%2X\"", (unsigned char)psyst->syst_name[0]); - name = (char *)&xname; - } - if (psyst->syst_params_min > numargs) { - cb_error_x (CB_TREE (current_statement), - _("wrong number of CALL parameters for '%s', %d given, %d expected"), - name, numargs, psyst->syst_params_min); - return; - } else if (psyst->syst_params_max < numargs) { - cb_warning_x (COBC_WARN_FILLER, CB_TREE (current_statement), - _("wrong number of CALL parameters for '%s', %d given, %d expected"), - name, numargs, psyst->syst_params_max); - } - is_sys_call = is_sys_idx; - break; - } - } - if (cb_listing_xref) { - cobc_xref_call (entry, call_line_number, 0, is_sys_call); - } - } - else if (cb_listing_xref && CB_REFERENCE_P(prog)) { - entry = CB_FIELD(CB_REFERENCE(prog)->value)->name; - cobc_xref_call (entry, call_line_number, 1, 0); - } - - if (error_ind) { - return; - } - - /* adjust maximum call parameters for later generation */ - if (numargs > current_program->max_call_param) { - current_program->max_call_param = numargs; - } - -#if 0 /* TODO: implement THREADs in libcob */ - /* remark: this won't work as the CALL has to be started in the new thread - if (newthread) { - cb_emit (CB_BUILD_FUNCALL_0 ("cob_threadstart")); - } - if (handle) { - cb_emit (CB_BUILD_FUNCALL_1 ("cob_get_threadhandle", handle)); - } */ -#else - COB_UNUSED (newthread); -#endif - cb_emit (cb_build_call (prog, par_using, on_exception, not_on_exception, - returning, is_sys_call, call_conv)); -} - -/* CANCEL statement */ - -void -cb_emit_cancel (cb_tree prog) -{ - if (cb_validate_one (prog)) { - return; - } - cb_emit (cb_build_cancel (prog)); -} - -/* CLOSE statement */ - -void -cb_emit_close (cb_tree file, cb_tree opt) -{ - struct cb_file *f; - - file = cb_ref (file); - if (file == cb_error_node) { - return; - } - current_statement->file = file; - f = CB_FILE (file); - - if (f->organization == COB_ORG_SORT) { - cb_error_x (CB_TREE (current_statement), - _("%s not allowed on %s files"), "CLOSE", "SORT"); - } - - if (f->extfh) { - cb_emit (CB_BUILD_FUNCALL_5 ("cob_extfh_close", f->extfh, file, - f->file_status, opt, cb_int0)); - } else { - cb_emit (CB_BUILD_FUNCALL_4 ("cob_close", file, - f->file_status, opt, cb_int0)); - } - - /* Check for file debugging */ - if (current_program->flag_debugging && - !current_statement->flag_in_debug && - CB_FILE(file)->flag_fl_debug) { - cb_emit (cb_build_debug (cb_debug_name, f->name, NULL)); - cb_emit (cb_build_move (cb_space, cb_debug_contents)); - cb_emit (cb_build_debug_call (f->debug_section)); - } -} - -/* COMMIT statement */ - -void -cb_emit_commit (void) -{ - cb_emit (CB_BUILD_FUNCALL_0 ("cob_commit")); -} - -/* CONTINUE statement */ - -void -cb_emit_continue (cb_tree continue_after) -{ - if (continue_after) { - /* CONTINUE AFTER exp SECONDS */ - if (!cb_verify (cb_continue_after, _("AFTER phrase in CONTINUE statement")) - || cb_validate_one (continue_after)) { - return; - } - if (CB_TREE_CLASS (continue_after) != CB_CLASS_NUMERIC) { - cb_error_x (CB_TREE(current_statement), - _("amount must be specified as a numeric expression")); - return; - } - cb_emit (CB_BUILD_FUNCALL_1 ("cob_continue_after", - continue_after)); - return; - } - /* "common" CONTINUE */ - cb_emit (cb_build_continue ()); -} - -/* DELETE statement */ - -void -cb_emit_delete (cb_tree file) -{ - struct cb_file *f; - - file = cb_ref (file); - if (file == cb_error_node) { - return; - } - current_statement->file = file; - f = CB_FILE (file); - - if (cb_listing_xref) { - /* add a "receiving" entry for the file */ - cobc_xref_link (&f->xref, current_statement->common.source_line, 1); - } - - if (f->organization == COB_ORG_SORT) { - cb_error_x (CB_TREE (current_statement), - _("%s not allowed on %s files"), "DELETE", "SORT"); - return; - } else if (f->organization == COB_ORG_LINE_SEQUENTIAL) { - cb_error_x (CB_TREE (current_statement), - _("%s not allowed on %s files"), "DELETE", "LINE SEQUENTIAL"); - return; - } else if (f->organization == COB_ORG_SEQUENTIAL) { - cb_error_x (CB_TREE (current_statement), - _("%s not allowed on %s files"), "DELETE", "SEQUENTIAL"); - return; - } - - /* Check for file debugging */ - if (current_program->flag_debugging && - !current_statement->flag_in_debug && - f->flag_fl_debug) { - /* Gen callback after delete but before exception test */ - current_statement->flag_callback = 1; - } - - if (f->extfh) { - cb_emit (CB_BUILD_FUNCALL_3 ("cob_extfh_delete", f->extfh, file, - f->file_status)); - } else { - cb_emit (CB_BUILD_FUNCALL_2 ("cob_delete", file, - f->file_status)); - } -} - -void -cb_emit_delete_file (cb_tree file) -{ - file = cb_ref (file); - if (file == cb_error_node) { - return; - } - if (CB_FILE (file)->organization == COB_ORG_SORT) { - cb_error_x (CB_TREE (current_statement), - _("%s not allowed on %s files"), "DELETE FILE", "SORT"); - return; - } - - /* Check for file debugging */ - if (current_program->flag_debugging && - !current_statement->flag_in_debug && - CB_FILE(file)->flag_fl_debug) { - /* Gen callback after delete but before exception test */ - current_statement->flag_callback = 1; - } - - cb_emit (CB_BUILD_FUNCALL_2 ("cob_delete_file", file, - CB_FILE(file)->file_status)); -} - - -static int -validate_attrs (cb_tree pos, cb_tree fgc, cb_tree bgc, cb_tree scroll, cb_tree size_is) -{ - return cb_validate_one (pos) - || cb_validate_one (fgc) - || cb_validate_one (bgc) - || cb_validate_one (scroll) - || cb_validate_one (size_is); -} - -static void -initialize_attrs (const struct cb_attr_struct * const attr_ptr, - cb_tree * const fgc, cb_tree * const bgc, - cb_tree * const scroll, cb_tree * const size_is, - cob_flags_t * const dispattrs) -{ - if (attr_ptr) { - *fgc = attr_ptr->fgc; - *bgc = attr_ptr->bgc; - *scroll = attr_ptr->scroll; - *size_is = attr_ptr->size_is; - *dispattrs = attr_ptr->dispattrs; - } else { - *fgc = NULL; - *bgc = NULL; - *scroll = NULL; - *size_is = NULL; - *dispattrs = 0; - } -} - - -/* DISPLAY [FLOATING | INITIAL] WINDOW statement */ - -void -cb_emit_display_window (cb_tree type, cb_tree own_handle, cb_tree upon_handle, - cb_tree line_column, struct cb_attr_struct *attr_ptr) -{ - cb_tree fgc; - cb_tree bgc; - cb_tree scroll; - cb_tree size_is; /* WITH SIZE IS */ - cob_flags_t disp_attrs; - - /* type may be: NULL --> normal WINDOW, - cb_int0 --> FLOATING WINDOW - otherwise it is an INITIAL WINDOW type: - cb_int1 = INITIAL, cb_int2 = STANDARD, cb_int3 = INDEPENDENT */ - if ((type == cb_int1 || type == cb_int2) && line_column != NULL) { - cb_error_x (line_column, _("positions cannot be specified for main windows")); - } - - /* Validate line_column and the attributes */ - initialize_attrs (attr_ptr, &fgc, &bgc, &scroll, &size_is, &disp_attrs); - if (validate_attrs (line_column, fgc, bgc, scroll, size_is)) { - return; - } - - if (own_handle && !usage_is_window_handle (own_handle)) { - cb_error_x (own_handle, _("HANDLE must be either a generic or a WINDOW HANDLE or X(10)")); - } - if (upon_handle && !usage_is_window_handle (upon_handle)) { - cb_error_x (upon_handle, _("HANDLE must be either a generic or a WINDOW HANDLE or X(10)")); - } - -#if 0 /* TODO, likely as multiple functions */ - cb_emit (CB_BUILD_FUNCALL_2 ("cob_display_window", own_handle, upon_handle)); -#endif -} - - -/* CLOSE WINDOW statement (WITH NO DISPLAY) - Note: CLOSE WINDOW without WITH NO DISPLAY is resolved as cb_emit_destroy -*/ - -void -cb_emit_close_window (cb_tree handle, cb_tree no_display) -{ - if (handle && !usage_is_window_handle (handle)) { - cb_error_x (handle, _("HANDLE must be either a generic or a WINDOW HANDLE or X(10)")); - } - if (no_display) { - cb_emit (CB_BUILD_FUNCALL_1 ("cob_close_window", handle)); - } else { - cb_emit_destroy (CB_LIST_INIT (handle)); - } -} - - -/* DESTROY statement */ - -void -cb_emit_destroy (cb_tree controls) -{ -#if 0 /* TODO */ - cb_tree l; - struct cb_field *f; - int i; -#endif - - /* DESTROY ALL CONTROLS */ - if (!controls) { - cb_emit (CB_BUILD_FUNCALL_1 ("cob_destroy_control", NULL)); - return; - } - - /* DESTROY list-of-controls */ - if (cb_validate_list (controls)) { - return; - } -#if 0 /* TODO */ - for (l = controls, i = 1; l; l = CB_CHAIN (l), i++) { - if (CB_REF_OR_FIELD_P (CB_VALUE (l))) { - f = CB_FIELD_PTR (CB_VALUE (l)); - if (!f->...checks) { - ... - } - cb_emit (CB_BUILD_FUNCALL_1 ("cob_destroy_control", CB_VALUE (l))); - } else { - ... - } - } -#endif -} - -/* DISPLAY statement */ - -void -cb_emit_env_name (cb_tree value) -{ - if (cb_validate_one (value)) { - return; - } - cb_emit (CB_BUILD_FUNCALL_1 ("cob_display_environment", value)); -} - -void -cb_emit_env_value (cb_tree value) -{ - if (cb_validate_one (value)) { - return; - } - cb_emit (CB_BUILD_FUNCALL_1 ("cob_display_env_value", value)); -} - -void -cb_emit_arg_number (cb_tree value) -{ - if (cb_validate_one (value)) { - return; - } - cb_emit (CB_BUILD_FUNCALL_1 ("cob_display_arg_number", value)); -} - -void -cb_emit_command_line (cb_tree value) -{ - if (cb_validate_one (value)) { - return; - } - cb_emit (CB_BUILD_FUNCALL_1 ("cob_display_command_line", value)); -} - -/* - Return 1 if a value in the list values has an unexpected type (tree tag, to be - precise) or is an error node. Otherwise, return 0. -*/ -static int -validate_types_of_display_values (cb_tree values) -{ - cb_tree l; - cb_tree x; - - for (l = values; l; l = CB_CHAIN (l)) { - x = CB_VALUE (l); - if (x == cb_error_node) { - return 1; - } - - switch (CB_TREE_TAG (x)) { - case CB_TAG_LITERAL: - case CB_TAG_INTRINSIC: - case CB_TAG_CONST: - case CB_TAG_STRING: - case CB_TAG_INTEGER: - break; - case CB_TAG_REFERENCE: - if (!CB_FIELD_P(CB_REFERENCE(x)->value)) { - cb_error_x (x, _("'%s' is an invalid type for DISPLAY operand"), cb_name (x)); - return 1; - } - break; - default: - cb_error_x (x, _("invalid type for DISPLAY operand")); - return 1; - } - } - - return 0; -} - -static void -emit_device_display (cb_tree values, cb_tree upon, cb_tree no_adv) -{ - cb_tree p; - - p = CB_BUILD_FUNCALL_3 ("cob_display", upon, no_adv, values); - CB_FUNCALL (p)->varcnt = (int)cb_list_length (values); - CB_FUNCALL (p)->nolitcast = 1; - cb_emit (p); -} - -static void -increment_field_ref_counts (cb_tree value_list) -{ - cb_tree x; - - for (; value_list; value_list = CB_CHAIN (value_list)) { - x = CB_VALUE (value_list); - if (CB_FIELD_P (x)) { - CB_FIELD (cb_ref (x))->count++; - } - } -} - -static void -emit_screen_display (const cb_tree x, const cb_tree pos) -{ - cb_tree line = NULL; - cb_tree column = NULL; - - get_line_and_column_from_pos (pos, &line, &column); - cb_emit (CB_BUILD_FUNCALL_4 ("cob_screen_display", x, line, column, - cb_int (line_col_zero_is_supported ()))); -} - -static void -process_special_values (cb_tree value, cb_tree * const size_is, cob_flags_t * const attrs) -{ - /* - The following are MF extensions. MF specifically - states X"01", X"02" and X"07", so the values do not - need to be changed for other codesets. - - For all special values, the SIZE clause is ignored. - */ - - /* LOW-VALUES positions cursor */ - if (value == cb_low) { - *attrs |= COB_SCREEN_NO_DISP; - *size_is = NULL; - return; - } - - if (!cb_display_special_fig_consts) { - return; - } - - /* SPACE clears to end of screen */ - if (value == cb_space) { - *attrs |= COB_SCREEN_ERASE_EOS; - *attrs |= COB_SCREEN_NO_DISP; - *size_is = NULL; - } else if (CB_LITERAL_P (value) && CB_LITERAL (value)->all && - CB_LITERAL (value)->size == 1) { - if (CB_LITERAL (value)->data[0] == '\1') { - /* ASCII char \1 is SOH, start of header */ - *attrs |= COB_SCREEN_ERASE_EOL; - *attrs |= COB_SCREEN_NO_DISP; - *size_is = NULL; - } else if (CB_LITERAL (value)->data[0] == '\2') { - /* ASCII char \2 is STX, start of text */ - cb_emit (CB_BUILD_FUNCALL_0 ("cob_sys_clear_screen")); - /* We might still need to position the cursor */ - *attrs |= COB_SCREEN_NO_DISP; - *size_is = NULL; - } else if (CB_LITERAL (value)->data[0] == '\7') { - /* ASCII char \7 is BEL, bell */ - *attrs |= COB_SCREEN_BELL; - *attrs |= COB_SCREEN_NO_DISP; - *size_is = NULL; - } - } -} - -static void -emit_field_display (const cb_tree x, const cb_tree pos, const cb_tree fgc, - const cb_tree bgc, const cb_tree scroll, - const cb_tree size_is, const cob_flags_t disp_attrs) -{ - cb_tree line_or_pos = NULL; - cb_tree column = NULL; - - get_line_and_column_from_pos (pos, &line_or_pos, &column); - cb_emit (CB_BUILD_FUNCALL_8 ("cob_field_display", - x, line_or_pos, column, fgc, bgc, - scroll, size_is, - cb_flags_t (disp_attrs))); -} - -static cb_tree -get_integer_literal_pair (const char *value) -{ - const cb_tree num = cb_build_numeric_literal (1, value, 0); - - return CB_BUILD_PAIR (num, num); -} - -static COB_INLINE COB_A_INLINE cb_tree -get_after_last_line_column (void) -{ - return get_integer_literal_pair ("0"); -} - -static COB_INLINE COB_A_INLINE cb_tree -get_origin_line_column (void) -{ - return get_integer_literal_pair ("1"); -} - -static void -emit_screen_displays (cb_tree screen_list, cb_tree line_col_for_last) -{ - cb_tree l; - cb_tree pos; - cb_tree screen_ref; - - /* note: screen_list validated by caller cb_emit_display */ - for (l = screen_list; l; l = CB_CHAIN (l)) { - /* - LINE 1 COL 1 is assumed, not LINE 0 COL 0 as in field - DISPLAYs. (This is RM-COBOL behaviour, who support multiple - screens in one DISPLAY.) - */ - if (CB_CHAIN (l) || !line_col_for_last) { - pos = get_origin_line_column (); - } else { - pos = line_col_for_last; - } - - screen_ref = CB_VALUE (l); - output_screen_from (CB_FIELD (cb_ref (screen_ref)), 0); - - gen_screen_ptr = 1; - emit_screen_display (screen_ref, pos); - gen_screen_ptr = 0; - } -} - -static cb_tree -get_default_field_line_column (const int is_first_display_item) -{ - /* - Note if LINE/COL 0 is not allowed, then this must be a - standard format DISPLAY (DISPLAY ... UPON CRT), which must - follow previous items, unlike the DISPLAY with screen clauses - (DISPLAY ... WITH HIGHLIGHT, etc.). - */ - const int display_after_last = - !line_col_zero_is_supported () - || !is_first_display_item - || cb_line_col_zero_default; - - if (display_after_last) { - return get_after_last_line_column (); - } else { - return get_origin_line_column (); - } - -} - -static void -emit_default_field_display_for_all_but_last (cb_tree values, cb_tree size_is, - const int is_first_display_list) -{ - cb_tree l; - int is_first_display_item = is_first_display_list; - cb_tree pos; - cob_flags_t disp_attrs; - cb_tree x; - - /* LCOV_EXCL_START */ - if (!values) { - cobc_err_msg (_("call to '%s' with invalid parameter '%s'"), - "emit_default_field_display_for_all_but_last", "values"); - COBC_ABORT (); - } - /* LCOV_EXCL_STOP */ - - for (l = values; l && CB_CHAIN (l); l = CB_CHAIN (l)) { - pos = get_default_field_line_column (is_first_display_item); - is_first_display_item = 0; - - x = CB_VALUE (l); - disp_attrs = 0; - process_special_values (x, &size_is, &disp_attrs); - - emit_field_display (x, pos, NULL, NULL, NULL, NULL, disp_attrs); - } -} - -static void -emit_field_display_for_last (cb_tree values, cb_tree line_column, cb_tree fgc, - cb_tree bgc, cb_tree scroll, cb_tree size_is, - cob_flags_t disp_attrs, - const int is_first_display_list) -{ - cb_tree l; - cb_tree last_elt; - int is_first_item; - - /* DISPLAY OMITTED ? */ - if (values == cb_null) { - l = last_elt = cb_null; - } else { - for (l = values; l && CB_CHAIN (l); l = CB_CHAIN (l)); - /* LCOV_EXCL_START */ - if (!l) { - cobc_err_msg (_("call to '%s' with invalid parameter '%s'"), - "emit_field_display_for_last", "values"); - COBC_ABORT (); - } - /* LCOV_EXCL_STOP */ - last_elt = CB_VALUE (l); - } - - if (line_column == NULL) { - is_first_item = is_first_display_list && l == values; - line_column = get_default_field_line_column (is_first_item); - } - - process_special_values (last_elt, &size_is, &disp_attrs); - emit_field_display (last_elt, line_column, fgc, bgc, scroll, size_is, - disp_attrs); -} - -void -cb_emit_display (cb_tree values, cb_tree upon, cb_tree no_adv, - cb_tree line_column, struct cb_attr_struct *attr_ptr, - int is_first_display_list, - const enum cb_display_type display_type) -{ - cb_tree fgc; - cb_tree bgc; - cb_tree scroll; - cb_tree size_is; /* WITH SIZE IS */ - cob_flags_t disp_attrs; - cb_tree m; - struct cb_field *f = NULL; - - /* Validate upon and values */ - if (values != cb_null) /* DISPLAY OMITTED */ { - if (upon == cb_error_node - || !values - || cb_validate_list (values) - || validate_types_of_display_values (values)) { - return; - } - } - - /* Validate line_column and the attributes */ - initialize_attrs (attr_ptr, &fgc, &bgc, &scroll, &size_is, &disp_attrs); - if (validate_attrs (line_column, fgc, bgc, scroll, size_is)) { - return; - } - - /* Emit appropriate function call(s) */ - switch (display_type) { - case DEVICE_DISPLAY: - - /* CGI: DISPLAY external-form */ - /* TODO: CHECKME, see Patch #27 */ - m = CB_VALUE(values); - if (CB_REF_OR_FIELD_P (m)) { - f = CB_FIELD_PTR (m); - } - if (f && (f->flag_is_external_form || f->external_form_identifier)) { - /* static content has both attributes */ - if (f->flag_is_external_form && f->external_form_identifier) { -#if 0 /* TODO: implement CGI runtime, see Patch #27 */ - cb_emit (CB_BUILD_FUNCALL_1 ("cob_cgi_static", f->external_form_identifier)); -#endif - return; - } - cb_emit_display_external_form (m); - /* TODO: CHECKME, DISPLAY without identifier (template) is a "debug display" */ - if (f->external_form_identifier) { - m = f->external_form_identifier; - } else { - m = cb_build_alphanumeric_literal (f->name, strlen(f->name)); - } -#if 0 /* TODO: implement CGI runtime, see Patch #27 */ - cb_emit (CB_BUILD_FUNCALL_1 ("cob_cgi_renderTpl", m)); -#endif - return; - } - - if (upon == NULL) { - upon = cb_int0; - } - emit_device_display (values, upon, no_adv); - increment_field_ref_counts (values); - break; - - case SCREEN_DISPLAY: - emit_screen_displays (values, line_column); - break; - - case FIELD_ON_SCREEN_DISPLAY: - /* no DISPLAY OMITTED */ - if (values != cb_null) { - emit_default_field_display_for_all_but_last (values, size_is, - is_first_display_list); - } - emit_field_display_for_last (values, line_column, fgc, bgc, - scroll, size_is, disp_attrs, - is_first_display_list); - - break; - - default: - /* Any other type will already have emitted errors */ - ; - } -} - -cb_tree -cb_build_display_mnemonic (cb_tree x) -{ - if (cb_ref (x) == cb_error_node) { - return cb_int0; - } - - switch (CB_SYSTEM_NAME (cb_ref (x))->token) { - case CB_DEVICE_CONSOLE: - case CB_DEVICE_SYSOUT: - return cb_int0; - case CB_DEVICE_SYSERR: - return cb_int1; - case CB_DEVICE_PRINTER: - return cb_int2; - case CB_DEVICE_SYSPCH: - return cb_int3; - default: - cb_error_x (x, _("'%s' is not an output device"), CB_NAME (x)); - return cb_int0; - } -} - -cb_tree -cb_build_display_name (cb_tree x) -{ - const char *name; - cb_tree sys; - - if (x == cb_error_node) { - return cb_error_node; - } - name = CB_NAME (x); - /* Allow direct reference to a device name (not defined as mnemonic name) */ - sys = get_system_name (name); - if (sys) { - switch (CB_SYSTEM_NAME (sys)->token) { - case CB_DEVICE_CONSOLE: - case CB_DEVICE_SYSOUT: - sys = cb_int0; - break; - case CB_DEVICE_SYSERR: - sys = cb_int1; - break; - case CB_DEVICE_PRINTER: - sys = cb_int2; - break; - case CB_DEVICE_SYSPCH: - sys = cb_int3; - break; - default: - cb_error_x (x, _("'%s' is not an output device"), name); - return cb_error_node; - } - /* possibly others allow this, too, consider adding a config option */ - if (cb_std_define != CB_STD_IBM - && cb_std_define != CB_STD_MVS - && cb_std_define != CB_STD_MF - && !cb_relaxed_syntax_checks) { - /* ... especially as this is not allowed and therefore should raise an error... */ - cb_warning_x (COBC_WARN_FILLER, x, - _("'%s' is not defined in SPECIAL-NAMES"), name); - } - return sys; - } else if (is_default_reserved_word (CB_NAME (x))) { - cb_error_x (x, _("unknown device '%s'; it may exist in another dialect"), - name); - } else { - cb_error_x (x, _("unknown device '%s'; not defined in SPECIAL-NAMES"), name); - } - return cb_error_node; -} - -/* DIVIDE statement */ - -void -cb_emit_divide (cb_tree dividend, cb_tree divisor, cb_tree quotient, - cb_tree remainder) -{ - cb_tree quotient_field, remainder_field; - - if (cb_validate_one (dividend) - || cb_validate_one (divisor)) { - return; - } - - if (cb_validate_one (CB_VALUE(quotient)) - || cb_validate_one (CB_VALUE(remainder))) { - return; - } - quotient_field = cb_check_numeric_edited_name (CB_VALUE(quotient)); - remainder_field = cb_check_numeric_edited_name (CB_VALUE(remainder)); - - if (quotient_field == cb_error_node - || remainder_field == cb_error_node) { - return; - } - - cb_emit (CB_BUILD_FUNCALL_4 ("cob_div_quotient", dividend, divisor, - quotient_field, build_store_option (quotient_field, CB_PURPOSE (quotient)))); - cb_emit (CB_BUILD_FUNCALL_2 ("cob_div_remainder", - remainder_field, build_store_option (remainder_field, cb_int0))); -} - -/* EVALUATE statement */ - -static cb_tree -evaluate_test (cb_tree s, cb_tree o) -{ - cb_tree x; - cb_tree y; - cb_tree t; - int flag; - - /* ANY is always true */ - if (o == cb_any) { - return cb_true; - } - - /* Object TRUE or FALSE */ - if (o == cb_true) { - return s; - } - if (o == cb_false) { - return CB_BUILD_NEGATION (s); - } - if (o == cb_error_node) { - return cb_error_node; - } - - flag = CB_PURPOSE_INT (o); - x = CB_PAIR_X (CB_VALUE (o)); - y = CB_PAIR_Y (CB_VALUE (o)); - - /* Subject TRUE or FALSE */ - if (s == cb_true) { - return flag ? CB_BUILD_NEGATION (x) : x; - } - if (s == cb_false) { - return flag ? x : CB_BUILD_NEGATION (x); - } - - /* x THRU y */ - if (y) { - t = cb_build_binary_op (cb_build_binary_op (x, '[', s), - '&', - cb_build_binary_op (s, '[', y)); - - return flag ? CB_BUILD_NEGATION (t) : t; - } - - if (CB_REFERENCE_P(x) && CB_FIELD_P(CB_REFERENCE(x)->value) && - CB_FIELD(CB_REFERENCE(x)->value)->level == 88) { - cb_error_x (CB_TREE (current_statement), - _("invalid use of 88 level in WHEN expression")); - return NULL; - } - - /* Regular comparison */ - switch (flag) { - case 0: - /* Equal comparison */ - return cb_build_binary_op (s, '=', x); - case 1: - /* Unequal comparison */ - return cb_build_binary_op (s, '~', x); - default: - /* Class and relational conditions */ - return x; - } -} - -static void -build_evaluate (cb_tree subject_list, cb_tree case_list, cb_tree labid) -{ - cb_tree whens, stmt; - cb_tree c1, c2, c3; - - if (case_list == NULL) { - return; - } - - whens = CB_VALUE (case_list); - stmt = CB_VALUE (whens); - whens = CB_CHAIN (whens); - c1 = NULL; - - /* For each WHEN sequence */ - for (; whens; whens = CB_CHAIN (whens)) { - cb_tree subjs, objs; - c2 = NULL; - /* Single WHEN test */ - for (subjs = subject_list, objs = CB_VALUE (whens); - subjs && objs; - subjs = CB_CHAIN (subjs), objs = CB_CHAIN (objs)) { - c3 = evaluate_test (CB_VALUE (subjs), CB_VALUE (objs)); - if (c3 == NULL || c3 == cb_error_node) { - return; - } - - if (c2 == NULL) { - c2 = c3; - } else { - c2 = cb_build_binary_op (c2, '&', c3); - if (c2 == cb_error_node) { - return; - } - } - } - if (subjs || objs) { - cb_error_x (whens, _("wrong number of WHEN parameters")); - } - /* Connect multiple WHEN's */ - if (c1 == NULL) { - c1 = c2; - } else if (c2) { - c1 = cb_build_binary_op (c1, '|', c2); - if (c1 == cb_error_node) { - return; - } - } - } - - if (c1 == NULL) { - int old_line = cb_source_line; - const char *old_file = cb_source_file; - - cb_source_line = stmt->source_line; - cb_source_file = stmt->source_file; - - cb_emit (cb_build_comment ("WHEN OTHER")); - cb_emit (stmt); - - cb_source_file = old_file; - cb_source_line = old_line; - - } else { - c2 = stmt; - /* Check if last statement is GO TO */ - for (c3 = stmt; c3; c3 = CB_CHAIN (c3)) { - if (!CB_CHAIN(c3)) { - break; - } - } - if (c3 && CB_VALUE (c3) && CB_STATEMENT_P (CB_VALUE (c3))) { - c3 = CB_STATEMENT (CB_VALUE (c3))->body; - if (c3 && CB_VALUE (c3) && !CB_GOTO_P (CB_VALUE(c3))) { - /* Append the jump */ - c2 = cb_list_add (stmt, labid); - } - } - cb_emit (cb_build_if (cb_build_cond (c1), c2, NULL, 0)); - build_evaluate (subject_list, CB_CHAIN (case_list), labid); - } -} - -void -cb_emit_evaluate (cb_tree subject_list, cb_tree case_list) -{ - cb_tree x; - char sbuf[16]; - - snprintf (sbuf, sizeof(sbuf), "goto %s%d;", CB_PREFIX_LABEL, cb_id); - x = cb_build_direct (cobc_parse_strdup (sbuf), 0); - build_evaluate (subject_list, case_list, x); - snprintf (sbuf, sizeof(sbuf), "%s%d:;", CB_PREFIX_LABEL, cb_id); - cb_emit (cb_build_comment ("End EVALUATE")); - cb_emit (cb_build_direct (cobc_parse_strdup (sbuf), 0)); - cb_id++; -} - -/* FREE statement */ - -void -cb_emit_free (cb_tree vars) -{ - cb_tree l; - struct cb_field *f; - int i; - - if (cb_validate_list (vars)) { - return; - } - for (l = vars, i = 1; l; l = CB_CHAIN (l), i++) { - if (CB_TREE_CLASS (CB_VALUE (l)) == CB_CLASS_POINTER) { - if (CB_CAST_P (CB_VALUE (l))) { - f = CB_FIELD_PTR (CB_CAST (CB_VALUE(l))->val); - if (!f->flag_item_based) { - cb_error_x (CB_TREE (current_statement), - _("target %d of FREE is not a BASED data item"), i); - } - cb_emit (CB_BUILD_FUNCALL_2 ("cob_free_alloc", - CB_BUILD_CAST_ADDRESS (CB_VALUE (l)), NULL)); - } else { - cb_emit (CB_BUILD_FUNCALL_2 ("cob_free_alloc", - NULL, CB_BUILD_CAST_ADDRESS (CB_VALUE (l)))); - } - } else if (CB_REF_OR_FIELD_P (CB_VALUE (l))) { - f = CB_FIELD_PTR (CB_VALUE (l)); - if (!f->flag_item_based) { - cb_error_x (CB_TREE (current_statement), - _("target %d of FREE is not a BASED data item"), i); - } - cb_emit (CB_BUILD_FUNCALL_2 ("cob_free_alloc", - CB_BUILD_CAST_ADDR_OF_ADDR (CB_VALUE (l)), NULL)); - } else { - cb_error_x (CB_TREE (current_statement), - _("target %d of FREE must be a data pointer"), i); - } - } -} - -/* GO TO statement */ - -void -cb_emit_goto (cb_tree target, cb_tree depending) -{ - if (target == cb_error_node) { - return; - } - if (target == NULL) { - cb_verify (cb_goto_statement_without_name, _("GO TO without procedure-name")); - } else if (depending) { - /* GO TO procedure-name ... DEPENDING ON identifier */ - if (cb_check_numeric_value (depending) == cb_error_node) { - return; - } - cb_check_data_incompat (depending); - cb_emit (cb_build_goto (target, depending)); - } else if (CB_CHAIN (target)) { - cb_error_x (CB_TREE (current_statement), - _("GO TO with multiple procedure-names")); - } else { - /* GO TO procedure-name */ - cb_emit (cb_build_goto (CB_VALUE (target), NULL)); - } -} - -void -cb_emit_goto_entry (cb_tree target, cb_tree depending) -{ - if (target == cb_error_node) { - return; - } - if (depending) { - /* GO TO ENTRY entry-name ... DEPENDING ON identifier */ - if (cb_check_numeric_value (depending) == cb_error_node) { - return; - } - cb_check_data_incompat (depending); - cb_emit (cb_build_goto (target, depending)); - } else if (CB_CHAIN (target)) { - cb_error_x (CB_TREE (current_statement), - _("GO TO ENTRY with multiple entry-names")); - } else { - /* GO TO ENTRY entry-name */ - cb_emit (cb_build_goto (CB_VALUE (target), NULL)); - } -} - -void -cb_emit_exit (const unsigned int goback) -{ - if (goback) { - cb_emit (cb_build_goto (cb_int1, NULL)); - } else { - cb_emit (cb_build_goto (NULL, NULL)); - } -} - -/* IF statement */ - -void -cb_emit_if (cb_tree cond, cb_tree stmt1, cb_tree stmt2) -{ - cb_emit (cb_build_if (cond, stmt1, stmt2, 1)); -} - -/* SEARCH .. WHEN clause (internal IF statement) */ - -cb_tree -cb_build_if_check_break (cb_tree cond, cb_tree stmts) -{ - cb_tree stmt_lis; - - stmt_lis = cb_check_needs_break (stmts); - return cb_build_if (cond, stmt_lis, NULL, 0); -} - -/* INITIALIZE statement */ - -void -cb_emit_initialize (cb_tree vars, cb_tree fillinit, cb_tree value, - cb_tree replacing, cb_tree def) -{ - cb_tree l; - unsigned int no_fill_init; - unsigned int def_init; - cb_tree x; - - if (cb_validate_list (vars)) { - return; - } - if (value == NULL && replacing == NULL) { - def = cb_true; - } - no_fill_init = (fillinit == NULL); - def_init = (def != NULL); - for (l = vars; l; l = CB_CHAIN (l)) { - x = CB_VALUE (l); - if (!(CB_REFERENCE_P (x) && CB_FIELD_P (CB_REFERENCE (x)->value)) && - !CB_FIELD_P (x)) { - cb_error_x (CB_TREE (current_statement), _("invalid INITIALIZE statement")); - return; - } - - cb_emit (cb_build_initialize (x , value, replacing, - def_init, 1, no_fill_init)); - } -} - -static size_t calc_reference_size (cb_tree xr) -{ - cb_tree ref = cb_ref (xr); - if (ref == cb_error_node) { - return 0; - } - if (CB_REF_OR_FIELD_P (ref)) { - struct cb_reference *r = CB_REFERENCE (xr); - if (r->offset) { - if (r->length) { - if (CB_LITERAL_P (r->length)) { - return cb_get_int (r->length); - } - } else { - if (CB_LITERAL_P (r->offset)) { - return (size_t)CB_FIELD_PTR (xr)->size - - cb_get_int (r->offset) + 1; - } - } - } else { - return CB_FIELD_PTR (xr)->size; - } - } else if (CB_ALPHABET_NAME_P (ref)) { - return 256; - } - return 0; -} - - -/* INSPECT statement */ - -static void -validate_inspect (cb_tree x, cb_tree y, const unsigned int replacing_or_converting) -{ - size_t size1; - size_t size2; - - switch (CB_TREE_TAG(x)) { - case CB_TAG_REFERENCE: - size1 = calc_reference_size (x); - break; - case CB_TAG_LITERAL: - size1 = CB_LITERAL(x)->size; - break; - case CB_TAG_CONST: - size1 = 1; - break; - default: - size1 = 0; - break; - } - if (size1) { - switch (CB_TREE_TAG(y)) { - case CB_TAG_REFERENCE: - size2 = calc_reference_size (y); - break; - case CB_TAG_LITERAL: - size2 = CB_LITERAL(y)->size; - break; - /* note: in case of CONST the original size is used */ - default: - size2 = 0; - break; - } - if (size2 && size1 != size2) { - if (replacing_or_converting == 1) { - cb_error_x (CB_TREE (current_statement), - _("%s operands differ in size"), "REPLACING"); - } else { - cb_error_x (CB_TREE (current_statement), - _("%s operands differ in size"), "CONVERTING"); - } - } - } -} - -static void -emit_invalid_target_error (const enum cb_inspect_clause clause) -{ - const char *clause_name; - - switch (clause) { - case TALLYING_CLAUSE: - clause_name = "TALLYING"; - break; - - case REPLACING_CLAUSE: - clause_name = "REPLACING"; - break; - - case CONVERTING_CLAUSE: - clause_name = "CONVERTING"; - break; - - case TRANSFORM_STATEMENT: - clause_name = "TRANSFORM"; - break; - - /* LCOV_EXCL_START */ - default: - cobc_err_msg (_("unexpected clause %d"), clause); - COBC_ABORT (); - /* LCOV_EXCL_STOP */ - } - - cb_error_x (CB_TREE (current_statement), _("invalid target for %s"), - clause_name); -} - -void -cb_emit_inspect (cb_tree var, cb_tree body, const enum cb_inspect_clause clause) -{ - int replacing_or_converting = - clause == REPLACING_CLAUSE || clause == CONVERTING_CLAUSE; - cb_tree replacing_flag = clause == REPLACING_CLAUSE ? cb_int1 : cb_int0; - - switch (CB_TREE_TAG (var)) { - case CB_TAG_REFERENCE: - break; - case CB_TAG_INTRINSIC: - if (replacing_or_converting) { - goto error; - } - switch (CB_TREE_CATEGORY (var)) { - case CB_CATEGORY_ALPHABETIC: - case CB_CATEGORY_ALPHANUMERIC: - case CB_CATEGORY_NATIONAL: - break; - default: - goto error; - } - break; - case CB_TAG_LITERAL: - if (replacing_or_converting) { - goto error; - } - break; - default: - goto error; - } - - cb_emit (CB_BUILD_FUNCALL_2 ("cob_inspect_init", var, replacing_flag)); - cb_emit_list (body); - cb_emit (CB_BUILD_FUNCALL_0 ("cob_inspect_finish")); - return; - - error: - emit_invalid_target_error (clause); -} - -void -cb_init_tallying (void) -{ - inspect_func = NULL; - inspect_data = NULL; -} - -cb_tree -cb_build_tallying_data (cb_tree x) -{ - inspect_data = x; - return NULL; -} - -cb_tree -cb_build_tallying_characters (cb_tree l) -{ - if (inspect_data == NULL) { - cb_error_x (CB_TREE (current_statement), - _("data name expected before %s"), "CHARACTERS"); - } - inspect_func = NULL; - return cb_list_add (l, CB_BUILD_FUNCALL_1 ("cob_inspect_characters", inspect_data)); -} - -cb_tree -cb_build_tallying_all (void) -{ - if (inspect_data == NULL) { - cb_error_x (CB_TREE (current_statement), - _("data name expected before %s"), "ALL"); - } - inspect_func = "cob_inspect_all"; - return NULL; -} - -cb_tree -cb_build_tallying_leading (void) -{ - if (inspect_data == NULL) { - cb_error_x (CB_TREE (current_statement), - _("data name expected before %s"), "LEADING"); - } - inspect_func = "cob_inspect_leading"; - return NULL; -} - -cb_tree -cb_build_tallying_trailing (void) -{ - if (inspect_data == NULL) { - cb_error_x (CB_TREE (current_statement), - _("data name expected before %s"), "TRAILING"); - } - inspect_func = "cob_inspect_trailing"; - return NULL; -} - -cb_tree -cb_build_tallying_value (cb_tree x, cb_tree l) -{ - if (inspect_func == NULL) { - cb_error_x (x, _("ALL, LEADING or TRAILING expected before '%s'"), cb_name (x)); - } - return cb_list_add (l, CB_BUILD_FUNCALL_2 (inspect_func, inspect_data, x)); -} - -cb_tree -cb_build_replacing_characters (cb_tree x, cb_tree l) -{ - if (CB_LITERAL_P (x) && CB_LITERAL(x)->size != 1) { - cb_error_x (CB_TREE (current_statement), - _("operand has wrong size")); - } - return cb_list_add (l, CB_BUILD_FUNCALL_1 ("cob_inspect_characters", x)); -} - -cb_tree -cb_build_replacing_all (cb_tree x, cb_tree y, cb_tree l) -{ - validate_inspect (x, y, 1); - return cb_list_add (l, CB_BUILD_FUNCALL_2 ("cob_inspect_all", y, x)); -} - -cb_tree -cb_build_replacing_leading (cb_tree x, cb_tree y, cb_tree l) -{ - validate_inspect (x, y, 1); - return cb_list_add (l, CB_BUILD_FUNCALL_2 ("cob_inspect_leading", y, x)); -} - -cb_tree -cb_build_replacing_first (cb_tree x, cb_tree y, cb_tree l) -{ - validate_inspect (x, y, 1); - return cb_list_add (l, CB_BUILD_FUNCALL_2 ("cob_inspect_first", y, x)); -} - -cb_tree -cb_build_replacing_trailing (cb_tree x, cb_tree y, cb_tree l) -{ - validate_inspect (x, y, 1); - return cb_list_add (l, CB_BUILD_FUNCALL_2 ("cob_inspect_trailing", y, x)); -} - -cb_tree -cb_build_converting (cb_tree x, cb_tree y, cb_tree l) -{ - validate_inspect (x, y, 2); - return cb_list_add (l, CB_BUILD_FUNCALL_2 ("cob_inspect_converting", x, y)); -} - -cb_tree -cb_build_inspect_region_start (void) -{ - return CB_LIST_INIT (CB_BUILD_FUNCALL_0 ("cob_inspect_start")); -} - -/* MOVE statement */ - -static void -warning_destination (cb_tree x) -{ - struct cb_field *f; - if (CB_REFERENCE_P(x)) { - struct cb_reference *r = CB_REFERENCE (x); - if (r->offset) { - return; - } - f = CB_FIELD (r->value); - x = CB_TREE (f); - } else if (CB_FIELD_P(x)) { - f = CB_FIELD (x); - } else { - cobc_err_msg (_("call to '%s' with invalid parameter '%s'"), - "warning_destination", "x"); - cobc_err_msg (_("unexpected tree tag: %d"), (int)CB_TREE_TAG (x)); - COBC_ABORT (); - } - - if (!strcmp (f->name, "RETURN-CODE") || - !strcmp (f->name, "SORT-RETURN") || - !strcmp (f->name, "NUMBER-OF-CALL-PARAMETERS")) { - cb_warning (COBC_WARN_FILLER, _("internal register '%s' defined as BINARY-LONG"), - f->name); - } else if (f->flag_real_binary) { - cb_warning_x (COBC_WARN_FILLER, x, _("'%s' defined here as USAGE %s"), - f->name, f->pic->orig); - } else if (f->usage == CB_USAGE_FLOAT) { - cb_warning_x (COBC_WARN_FILLER, x, _("'%s' defined here as USAGE %s"), - f->name, "FLOAT"); - } else if (f->usage == CB_USAGE_DOUBLE) { - cb_warning_x (COBC_WARN_FILLER, x, _("'%s' defined here as USAGE %s"), - f->name, "DOUBLE"); - } else if (f->usage == CB_USAGE_LONG_DOUBLE) { - cb_warning_x (COBC_WARN_FILLER, x, _("'%s' defined here as USAGE %s"), - f->name, "FLOAT EXTENDED"); - } else if (f->usage == CB_USAGE_FP_BIN32) { - cb_warning_x (COBC_WARN_FILLER, x, _("'%s' defined here as USAGE %s"), - f->name, "FLOAT-BINARY-7"); - } else if (f->usage == CB_USAGE_FP_BIN64) { - cb_warning_x (COBC_WARN_FILLER, x, _("'%s' defined here as USAGE %s"), - f->name, "FLOAT-BINARY-16"); - } else if (f->usage == CB_USAGE_FP_BIN128) { - cb_warning_x (COBC_WARN_FILLER, x, _("'%s' defined here as USAGE %s"), - f->name, "FLOAT-BINARY-34"); - } else if (f->usage == CB_USAGE_FP_DEC64) { - cb_warning_x (COBC_WARN_FILLER, x, _("'%s' defined here as USAGE %s"), - f->name, "FLOAT-DECIMAL-16"); - } else if (f->usage == CB_USAGE_FP_DEC128) { - cb_warning_x (COBC_WARN_FILLER, x, _("'%s' defined here as USAGE %s"), - f->name, "FLOAT-DECIMAL-34"); - } else if (f->pic) { - cb_warning_x (COBC_WARN_FILLER, x, _("'%s' defined here as PIC %s"), - cb_name (x), f->pic->orig); - } else { - cb_warning_x (COBC_WARN_FILLER, x, _("'%s' defined here as a group of length %d"), - cb_name (x), f->size); - } -} - -static void -move_warning (cb_tree src, cb_tree dst, const unsigned int value_flag, - const int warning_flag, const int src_flag, const char *msg) -{ - cb_tree loc; - - if (suppress_warn) { - return; - } -#if 1 /* BAD hack, but works for now */ - if (cobc_cs_check == CB_CS_SET || !src->source_line) { -#else /* old version */ - if (CB_LITERAL_P (src) || !src->source_line) { -#endif - loc = dst; - } else { - loc = src; - } - if (value_flag) { - /* VALUE clause --> always warn */ - cb_warning_x (COBC_WARN_FILLER, loc, "%s", msg); - } else { - /* MOVE statement */ - if (warning_flag) { - cb_warning_x (warning_flag, loc, "%s", msg); - listprint_suppress (); - if (src_flag) { - /* note: src_flag is -1 for numeric literals, - contains literal size otherwise */ - if (!CB_LITERAL_P (src)) { - warning_destination (src); - } else if (src_flag == -1) { - if (CB_LITERAL_P (src)) { - cb_warning_x (warning_flag, dst, - _("value is %s"), CB_LITERAL (src)->data); - } - } else { - cb_warning_x (warning_flag, dst, - _("value size is %d"), src_flag); - } - } - warning_destination (dst); - listprint_restore (); - } - } - - return; -} - -static int -count_pic_alphanumeric_edited (struct cb_field *field) -{ - cob_pic_symbol *s; - int count = 0; - - /* Count number of free places in an alphanumeric edited field */ - for (s = field->pic->str; s->symbol != '\0'; ++s) { - if (s->symbol == '9' || s->symbol == 'A' || s->symbol == 'X') { - count += s->times_repeated; - } - } - return count; -} - -/* check if data of two fields may overlap; - returns: - 0 = no overlapping - 1 = possible overlapping, would need more checks for a warning - 2 = possible overlapping, warn - 3 = overlapping, warn - - src_f, dst_f - fields to be checked - src, dst - references, may be NULL (no subscripts/references checked) - -*/ -static size_t -cb_check_overlapping (struct cb_field *src_f, struct cb_field *dst_f, - cb_tree src, cb_tree dst) -{ - struct cb_field *f1; - struct cb_field *ff1; - struct cb_field *ff2; - struct cb_reference *sr; - struct cb_reference *dr; - int src_size; - int dst_size; - int src_off; - int dst_off; - - if (CB_REFERENCE_P(src)) { - sr = CB_REFERENCE (src); - } else { - sr = NULL; - } - - if (CB_REFERENCE_P(dst)) { - dr = CB_REFERENCE (dst); - } else { - dr = NULL; - } - - /* Check for identical field */ - if (src_f == dst_f) { - if (!sr || !dr) { - /* same fields, no information about sub/refmod, - overlapping possible */ - return 1; - } - if (sr->subs) { - /* same fields with subs, overlapping possible */ -#if 0 /* FIXME: more checks needed: - 1: are all subs of source and dest identical ? - 2: are all subs of source and dest literals with the same integer value ? - */ - if (...) { - return 2; - } else { - return 0; - } -#else - /* for now: at least resolve one sub and handle when both reference a literal - or a reference ...*/ - if (!CB_CHAIN (sr->subs) - && !CB_CHAIN (dr->subs)) { - if (CB_NUMERIC_LITERAL_P(CB_VALUE (sr->subs)) - && CB_NUMERIC_LITERAL_P(CB_VALUE (dr->subs))) { - struct cb_literal *sl, *dl; - - sl = CB_LITERAL(CB_VALUE (sr->subs)); - dl = CB_LITERAL(CB_VALUE (dr->subs)); - if (atoll((const char*)sl->data) != - atoll((const char*)dl->data)) { - return 0; - } - } else if (CB_REFERENCE_P(CB_VALUE (sr->subs)) - && CB_REFERENCE_P(CB_VALUE (dr->subs))) { - struct cb_reference *tsr, *tdr; - - tsr = CB_REFERENCE(CB_VALUE (sr->subs)); - tdr = CB_REFERENCE(CB_VALUE (dr->subs)); - if (tsr->subs || tdr->subs) { - return 1; - } else { - if (tsr->value != tdr->value) { - return 1; - } - } - } else { - return 1; - } - } else { - return 1; - } -#endif - } - - /* same fields, at least one without ref-mod -> overlapping */ - if (!sr->offset || !dr->offset) { - return 3; - } - - } else { - - /* Check basic overlapping */ - for (f1 = src_f->children; f1; f1 = f1->sister) { - if (f1 == dst_f) { - return 3; - } - } - for (f1 = dst_f->children; f1; f1 = f1->sister) { - if (f1 == src_f) { - return 3; - } - } - - /* Check for same parent field */ -#ifdef _MSC_VER -#pragma warning(push) -#pragma warning(disable: 6011) // cb_field_founder always returns a valid pointer -#endif - ff1 = cb_field_founder (src_f); - ff2 = cb_field_founder (dst_f); - if (ff1->redefines) { - ff1 = ff1->redefines; - } - if (ff2->redefines) { - ff2 = ff2->redefines; - } - if (ff1 != ff2) { - /* different field founder -> no overlapping */ - /* if at least one of the vars can have an assignment - of a different address we must return 1 */ - if (ff1->flag_local_storage || ff1->flag_item_based || - ff2->flag_local_storage || ff2->flag_item_based) { - return 1; - } else { - return 0; - } - } - } -#ifdef _MSC_VER -#pragma warning(pop) -#endif - - /* check if both fields are references, otherwise we can't check further */ - if (!sr || !dr) { - /* overlapping possible as they have the same field founder */ - return 1; - } - - src_off = src_f->offset; - dst_off = dst_f->offset; - - /* Check for occurs */ - if (src_f != dst_f && (sr->subs || dr->subs)) { - /* overlapping possible */ -#if 0 /* FIXME: more checks needed: - 1: if all subs are integer literals: a full offset check of both fields - 2: if at least one isn't an integer literal: check that all "upper" literals - are either identical or numeric literals with the same integer value */ - if (...) { - return 2; - } else { - return 0; - } -#else - return 1; -#endif - } - - src_size = cb_field_size (src); - dst_size = cb_field_size (dst); - - /* Adjusting offsets by reference modification */ - if (sr->offset) { - if (src_size == FIELD_SIZE_UNKNOWN || - !CB_LITERAL_P (sr->offset)) { - return 2; - } - src_off += cb_get_int (sr->offset) - 1; - } - if (dr->offset) { - if (dst_size == FIELD_SIZE_UNKNOWN || - !CB_LITERAL_P (dr->offset)) { - return 2; - } - dst_off += cb_get_int (dr->offset) - 1; - } - - if (src_size == 0 || dst_size == 0 || - cb_field_variable_size (src_f) || - cb_field_variable_size (dst_f)) { - /* overlapping possible, would need more checks */ - return 1; - } - - if (src_off >= dst_off && src_off < (dst_off + dst_size)) { - return 3; - } - if (src_off < dst_off && (src_off + src_size) > dst_off) { - return 3; - } - return 0; -} - -static int -is_floating_point_usage (const enum cb_usage usage) -{ - return usage == CB_USAGE_DOUBLE - || usage == CB_USAGE_FLOAT - || usage == CB_USAGE_LONG_DOUBLE - || usage == CB_USAGE_FP_BIN32 - || usage == CB_USAGE_FP_BIN64 - || usage == CB_USAGE_FP_BIN128 - || usage == CB_USAGE_FP_DEC64 - || usage == CB_USAGE_FP_DEC128; -} - -int -validate_move (cb_tree src, cb_tree dst, const unsigned int is_value, int *move_zero) -{ - struct cb_field *fdst; - struct cb_field *fsrc; - struct cb_literal *l; - unsigned char *p; - cb_tree loc; - cob_s64_t val; - size_t i; - size_t is_numeric_edited; - int src_scale_mod; - int dst_scale_mod; - int dst_size_mod; - signed int size; /* -1 as special value */ - int m_zero; - int most_significant; - int least_significant; - - loc = src->source_line ? src : dst; - is_numeric_edited = 0; - overlapping = 0; - if (move_zero == NULL) { - move_zero = &m_zero; - } - *move_zero = 0; - if (CB_REFERENCE_P (dst)) { - if (CB_ALPHABET_NAME_P(CB_REFERENCE(dst)->value)) { - goto invalid; - } - if (CB_FILE_P(CB_REFERENCE(dst)->value)) { - goto invalid; - } - } - if (CB_TREE_CATEGORY (dst) == CB_CATEGORY_BOOLEAN) { - cb_error_x (loc, _("invalid destination for MOVE")); - return -1; - } - - if (CB_TREE_CLASS (dst) == CB_CLASS_POINTER) { - if (CB_TREE_CLASS (src) == CB_CLASS_POINTER) { - return 0; - } else { - goto invalid; - } - } - - fdst = CB_FIELD_PTR (dst); - switch (CB_TREE_TAG (src)) { - case CB_TAG_CONST: - if (src == cb_space || src == cb_low || src == cb_high || src == cb_quote) { - if (CB_TREE_CATEGORY (dst) == CB_CATEGORY_NUMERIC - || (CB_TREE_CATEGORY (dst) == CB_CATEGORY_NUMERIC_EDITED && !is_value) - || (CB_TREE_CATEGORY (dst) == CB_CATEGORY_FLOATING_EDITED && !is_value)) { - if ((current_statement && strcmp (current_statement->name, "SET") == 0) - || cobc_cs_check == CB_CS_SET) { - goto invalid; - } - } - } - - if (src == cb_space) { /* error because SPACE is category alphabetic */ - if (CB_TREE_CATEGORY (dst) == CB_CATEGORY_NUMERIC - || (CB_TREE_CATEGORY (dst) == CB_CATEGORY_NUMERIC_EDITED && !is_value) - || (CB_TREE_CATEGORY (dst) == CB_CATEGORY_FLOATING_EDITED && !is_value)) { - /* note: ACUCOBOL and MF allow this, but not for NUMERIC + VALUE */ - if (is_value) { - goto invalid; - } - if (cb_verify_x (loc, cb_move_fig_space_to_numeric, - _("MOVE of figurative constant SPACE to numeric item"))) { - if (cb_move_nonnumlit_to_numeric_is_zero) { - goto movezero; - } - break; - } - return -1; /* error message raised already*/ - } - } else if (src == cb_zero) { - if (CB_TREE_CATEGORY (dst) == CB_CATEGORY_ALPHABETIC) { - goto invalid; - } - } else if (src == cb_quote) { /* remark: no error because QUOTE is category alphanumeric */ - if (CB_TREE_CATEGORY (dst) == CB_CATEGORY_NUMERIC) { - if (!cb_verify_x (loc, cb_move_fig_quote_to_numeric, - _("MOVE of figurative constant QUOTE to numeric item"))) { - return -1; - } - if (cb_move_fig_quote_to_numeric != cb_move_fig_constant_to_numeric) { - if (!cb_verify_x (loc, cb_move_fig_constant_to_numeric, - _("MOVE of figurative constant to numeric item"))) { - return -1; - } - } - if (cb_move_nonnumlit_to_numeric_is_zero) { - goto movezero; - } - } - } else if (src == cb_low || src == cb_high) { - if (CB_TREE_CATEGORY (dst) == CB_CATEGORY_NUMERIC - || (CB_TREE_CATEGORY (dst) == CB_CATEGORY_NUMERIC_EDITED && !is_value)) { - if (!cb_verify_x (loc, cb_move_fig_constant_to_numeric, - _("MOVE of figurative constant to numeric item"))) { - return -1; - } - if (cb_move_nonnumlit_to_numeric_is_zero) { - goto movezero; - } - } - } - break; - case CB_TAG_LITERAL: - l = CB_LITERAL (src); - if (CB_TREE_CLASS (src) == CB_CLASS_NUMERIC) { - /* Numeric literal */ - if (l->all) { - goto invalid; - } - if (is_floating_point_usage (fdst->usage)) { - /* TODO: add check for exponent size */ - break; - } - most_significant = -999; - least_significant = 999; - - /* Compute the most significant figure place */ - for (i = 0; i < l->size; i++) { - if (l->data[i] != '0') { - break; - } - } - if (i != l->size) { - most_significant = (int) (l->size - l->scale - i - 1); - } - - /* Compute the least significant figure place */ - for (i = 0; i < l->size; i++) { - if (l->data[l->size - i - 1] != '0') { - break; - } - } - if (i != l->size) { - least_significant = (int) (-l->scale + i); - } - - /* Value check */ - switch (CB_TREE_CATEGORY (dst)) { - case CB_CATEGORY_ALPHANUMERIC: - case CB_CATEGORY_ALPHANUMERIC_EDITED: - if (fdst->usage == CB_USAGE_COMP_X) { - break; - } - - if (is_value) { - goto expect_alphanumeric; - } - if (l->scale == 0) { - goto expect_alphanumeric; - } - goto non_integer_move; - case CB_CATEGORY_NUMERIC_EDITED: - case CB_CATEGORY_FLOATING_EDITED: - if (is_value) { - cb_verify_x (loc, cb_numeric_value_for_edited_item, - _("numeric literal in VALUE clause of numeric-edited item")); - } - /* Fall-through */ - case CB_CATEGORY_NUMERIC: - if (fdst->pic->scale < 0) { - /* Check for PIC 9(n)P(m) */ - if (least_significant < -fdst->pic->scale) { - goto value_mismatch; - } - } else if (fdst->pic->scale > fdst->pic->size) { - /* Check for PIC P(n)9(m) */ - if (most_significant >= fdst->pic->size - fdst->pic->scale) { - goto value_mismatch; - } - } - break; - case CB_CATEGORY_ALPHABETIC: - if (is_value) { - goto expect_alphanumeric; - } - /* Coming from codegen */ - if (!suppress_warn) { - goto invalid; - } - cb_warning_x (cb_warn_extra, loc, - _("numeric move to ALPHABETIC")); - break; - default: - if (is_value) { - goto expect_alphanumeric; - } - goto invalid; - } - - /* Sign check */ - if (l->sign != 0 && !fdst->pic->have_sign) { - if (is_value) { - cb_error_x (loc, _("data item not signed")); - return -1; - } - cb_warning_x (cb_warn_truncate, loc, _("ignoring sign")); - } - - /* Size check */ - if (fdst->flag_real_binary - || ( !cb_binary_truncate - && fdst->pic->scale == 0 - && ( fdst->usage == CB_USAGE_COMP_5 - || fdst->usage == CB_USAGE_COMP_X - || fdst->usage == CB_USAGE_COMP_N - || fdst->usage == CB_USAGE_BINARY))) { - p = l->data; - for (i = 0; i < l->size; i++) { - if (l->data[i] != '0') { - p = &l->data[i]; - break; - } - } - i = l->size - i; - switch (fdst->size) { - case 1: - if (i > 18) { - goto numlit_overflow; - } - val = cb_get_long_long (src); - if (fdst->pic->have_sign) { - if (val < COB_S64_C(-128) || - val > COB_S64_C(127)) { - goto numlit_overflow; - } - } else { - if (val > COB_S64_C(255)) { - goto numlit_overflow; - } - } - break; - case 2: - if (i > 18) { - goto numlit_overflow; - } - val = cb_get_long_long (src); - if (fdst->pic->have_sign) { - if (val < COB_S64_C(-32768) || - val > COB_S64_C(32767)) { - goto numlit_overflow; - } - } else { - if (val > COB_S64_C(65535)) { - goto numlit_overflow; - } - } - break; - case 3: - if (i > 18) { - goto numlit_overflow; - } - val = cb_get_long_long (src); - if (fdst->pic->have_sign) { - if (val < COB_S64_C(-8388608) || - val > COB_S64_C(8388607)) { - goto numlit_overflow; - } - } else { - if (val > COB_S64_C(16777215)) { - goto numlit_overflow; - } - } - break; - case 4: - if (i > 18) { - goto numlit_overflow; - } - val = cb_get_long_long (src); - if (fdst->pic->have_sign) { - if (val < COB_S64_C(-2147483648) || - val > COB_S64_C(2147483647)) { - goto numlit_overflow; - } - } else { - if (val > COB_S64_C(4294967295)) { - goto numlit_overflow; - } - } - break; - case 5: - if (i > 18) { - goto numlit_overflow; - } - val = cb_get_long_long (src); - if (fdst->pic->have_sign) { - if (val < COB_S64_C(-549755813888) || - val > COB_S64_C(549755813887)) { - goto numlit_overflow; - } - } else { - if (val > COB_S64_C(1099511627775)) { - goto numlit_overflow; - } - } - break; - case 6: - if (i > 18) { - goto numlit_overflow; - } - val = cb_get_long_long (src); - if (fdst->pic->have_sign) { - if (val < COB_S64_C(-140737488355328) || - val > COB_S64_C(140737488355327)) { - goto numlit_overflow; - } - } else { - if (val > COB_S64_C(281474976710655)) { - goto numlit_overflow; - } - } - break; - case 7: - if (i > 18) { - goto numlit_overflow; - } - val = cb_get_long_long (src); - if (fdst->pic->have_sign) { - if (val < COB_S64_C(-36028797018963968) || - val > COB_S64_C(36028797018963967)) { - goto numlit_overflow; - } - } else { - if (val > COB_S64_C(72057594037927935)) { - goto numlit_overflow; - } - } - break; - default: - if (fdst->pic->have_sign) { - if (i < 19) { - break; - } - if (i > 19) { - goto numlit_overflow; - } - if (memcmp (p, l->sign ? "9223372036854775808" : - "9223372036854775807", - (size_t)19) > 0) { - goto numlit_overflow; - } - } else { - if (i < 20) { - break; - } - if (i > 20) { - goto numlit_overflow; - } - if (memcmp (p, "18446744073709551615", (size_t)20) > 0) { - goto numlit_overflow; - } - } - break; - } - return 0; - } - if (least_significant < -fdst->pic->scale) { - size = -1; - goto size_overflow; - } - if (fdst->pic->scale > 0) { - size = fdst->pic->digits - fdst->pic->scale; - } else { - size = fdst->pic->digits; - } - if (most_significant >= size) { - size = -1; - goto size_overflow; - } - } else { - /* Alphanumeric literal */ - - /* Value check */ - switch (CB_TREE_CATEGORY (dst)) { - case CB_CATEGORY_ALPHABETIC: - for (i = 0; i < l->size; i++) { - if (!isalpha (l->data[i]) && - l->data[i] != ' ') { - goto value_mismatch; - } - } - break; - case CB_CATEGORY_NUMERIC: - /* TODO: add check (maybe a configuration) - for numeric data in alphanumeric literal - note - we did this in versions before 3.0 */ - for (i = 0; i < l->size; i++) { - if (!isdigit (l->data[i])) { - /* no check for +-,. as MF seems to not do this here */ - if (cb_move_nonnumlit_to_numeric_is_zero - && !is_value) { - goto movezero; - } - goto expect_numeric; - } - } - break; - case CB_CATEGORY_NUMERIC_EDITED: - /* TODO: add check (maybe a configuration) - for numeric data in alphanumeric literal - note - we did this in versions before 3.0 */ - if (!is_value) { - /* TODO check if the following is correct: */ - /* validate the value for normal MOVE as MF does*/ - for (i = 0; i < l->size; i++) { - if (!isdigit (l->data[i]) - && l->data[i] != '.' - && l->data[i] != ',' - && l->data[i] != '+' - && l->data[i] != '-' - && l->data[i] != ' ') { - if (cb_move_nonnumlit_to_numeric_is_zero) { - goto movezero; - } - goto expect_numeric; - } - } - } else { - /* TODO: validate the value for VALUE - needed? */ - } - break; - case CB_CATEGORY_FLOATING_EDITED: - if (!is_value) { - /* TODO check if the following is correct: */ - /* validate the value for normal MOVE as MF does*/ - for (i = 0; i < l->size; i++) { - if (!isdigit (l->data[i]) - && l->data[i] != '.' - && l->data[i] != ',' - && l->data[i] != '+' - && l->data[i] != '-' - && l->data[i] != 'E' - && l->data[i] != ' ') { - if (cb_move_nonnumlit_to_numeric_is_zero) { - goto movezero; - } - goto expect_numeric; - } - } - } else { - /* TODO: validate the value for VALUE - needed? */ - } - break; - default: - break; - } - - /* Size check */ - size = cb_field_size (dst); - if (size > 0 - && l->size > 0 - && !fdst->flag_any_length) { - /* check the real size */ - fdst = CB_FIELD_PTR (dst); - if (fdst->flag_justified) { - /* right justified: trim left */ - for (i = 0; i != l->size; i++) { - if (l->data[i] != ' ') { - break; - } - } - i = l->size - i; - } else { - /* normal field: trim right */ - for (i = l->size - 1; i != 0; i--) { - if (l->data[i] != ' ') { - break; - } - } - i++; - } - if ((int)i > size) { - size = (signed int)i; - goto size_overflow; - } - /* for VALUE: additional check without trim */ - if (is_value && l->size > (unsigned int)fdst->size) { - goto value_mismatch; - } - } - } - break; - case CB_TAG_FIELD: - case CB_TAG_REFERENCE: - if (CB_REFERENCE_P(src) && - CB_ALPHABET_NAME_P(CB_REFERENCE(src)->value)) { - break; - } - if (CB_REFERENCE_P(src) && - CB_FILE_P(CB_REFERENCE(src)->value)) { - goto invalid; - } - fsrc = CB_FIELD_PTR (src); - - if (cb_move_ibm) { - /* This MOVE result is exactly as on IBM, ignore overlapping */ - overlapping = 0; - } else { - /* Check basic overlapping */ - overlapping = cb_check_overlapping (fsrc, fdst, src, dst); - switch (overlapping) { - case 0: - case 1: - break; - case 2: - loc = src->source_line ? src : dst; - if (cb_warn_pos_overlap && !suppress_warn) { - cb_warning_x(COBC_WARN_FILLER, loc, - _("overlapping MOVE may occur and produce unpredictable results")); - } - break; - case 3: - loc = src->source_line ? src : dst; - if ((cb_warn_overlap || cb_warn_pos_overlap) && !suppress_warn) { - cb_warning_x (COBC_WARN_FILLER, loc, - _("overlapping MOVE may produce unpredictable results")); - } - break; - /* LCOV_EXCL_START */ - default: - cobc_err_msg("unexpected overlap result: %d", (int)overlapping); - COBC_ABORT(); - /* LCOV_EXCL_STOP */ - } - } - - size = cb_field_size (src); - dst_size_mod = cb_field_size (dst); - - /* Non-elementary move */ - if (fsrc->children || fdst->children) { - if (dst_size_mod == FIELD_SIZE_UNKNOWN) { - break; - } - if (size > dst_size_mod) { - goto size_overflow_1; - } - break; - } - - /* Elementary move */ - switch (CB_TREE_CATEGORY (src)) { - case CB_CATEGORY_ALPHANUMERIC: - switch (CB_TREE_CATEGORY (dst)) { - case CB_CATEGORY_NUMERIC: - case CB_CATEGORY_NUMERIC_EDITED: - if (size > (int)fdst->pic->digits) { - goto size_overflow_2; - } - break; - case CB_CATEGORY_ALPHANUMERIC_EDITED: - case CB_CATEGORY_FLOATING_EDITED: - if (dst_size_mod == FIELD_SIZE_UNKNOWN) { - break; - } - if (size > count_pic_alphanumeric_edited (fdst)) { - goto size_overflow_1; - } - break; - default: - if (dst_size_mod == FIELD_SIZE_UNKNOWN) { - break; - } - if (size > fdst->size) { - goto size_overflow_1; - } - break; - } - break; - case CB_CATEGORY_ALPHABETIC: - case CB_CATEGORY_ALPHANUMERIC_EDITED: - switch (CB_TREE_CATEGORY (dst)) { - case CB_CATEGORY_NUMERIC: - case CB_CATEGORY_NUMERIC_EDITED: - case CB_CATEGORY_FLOATING_EDITED: - goto invalid; - case CB_CATEGORY_ALPHANUMERIC_EDITED: - if (dst_size_mod == FIELD_SIZE_UNKNOWN) { - break; - } - if (size > count_pic_alphanumeric_edited(fdst)) { - goto size_overflow_1; - } - break; - default: - if (dst_size_mod == FIELD_SIZE_UNKNOWN) { - break; - } - if (size > fdst->size) { - goto size_overflow_1; - } - break; - } - break; - case CB_CATEGORY_NUMERIC: - case CB_CATEGORY_NUMERIC_EDITED: - case CB_CATEGORY_FLOATING_EDITED: - switch (CB_TREE_CATEGORY (dst)) { - case CB_CATEGORY_ALPHABETIC: - goto invalid; - case CB_CATEGORY_ALPHANUMERIC_EDITED: - is_numeric_edited = 1; - /* Drop through */ - case CB_CATEGORY_ALPHANUMERIC: - if (!fsrc->pic) { - return -1; - } - if (CB_TREE_CATEGORY (src) == CB_CATEGORY_NUMERIC - && fsrc->pic->scale > 0) { - goto non_integer_move; - } - if (dst_size_mod == FIELD_SIZE_UNKNOWN) { - break; - } - if (is_numeric_edited) { - dst_size_mod = count_pic_alphanumeric_edited (fdst); - } else { - dst_size_mod = fdst->size; - } - if (CB_TREE_CATEGORY (src) == CB_CATEGORY_NUMERIC - && (int)fsrc->pic->digits > dst_size_mod) { - goto size_overflow_2; - } - if (CB_TREE_CATEGORY (src) == CB_CATEGORY_NUMERIC_EDITED - && fsrc->size > dst_size_mod) { - goto size_overflow_1; - } - break; - default: - if (!fsrc->pic) { - return -1; - } - if (!fdst->pic) { - return -1; - } - src_scale_mod = fsrc->pic->scale < 0 ? - 0 : fsrc->pic->scale; - dst_scale_mod = fdst->pic->scale < 0 ? - 0 : fdst->pic->scale; - if (fsrc->pic->digits - src_scale_mod > - fdst->pic->digits - dst_scale_mod - || src_scale_mod > dst_scale_mod) { - goto size_overflow_2; - } - break; - } - break; - default: - cb_error_x (loc, _("invalid source for MOVE")); - return -1; - } - break; - case CB_TAG_CAST: - goto invalid; - case CB_TAG_INTEGER: - case CB_TAG_BINARY_OP: - case CB_TAG_INTRINSIC: - case CB_TAG_FUNCALL: - /* TODO: check this */ - break; - /* LCOV_EXCL_START */ - default: - cobc_err_msg (_("unexpected tree tag: %d"), - (int)CB_TREE_TAG (src)); - COBC_ABORT (); - /* LCOV_EXCL_STOP */ - } - return 0; - -movezero: - cb_warning_x (COBC_WARN_FILLER, loc, - _("source is non-numeric - substituting zero")); - *move_zero = 1; - return 0; - -invalid: - if (is_value) { - cb_error_x (loc, _("invalid VALUE clause")); - } else if ((current_statement && strcmp (current_statement->name, "SET") == 0) - || cobc_cs_check == CB_CS_SET) { - cb_error_x (loc, _("invalid SET statement")); - } else { - cb_error_x (loc, _("invalid MOVE statement")); - } - return -1; - -numlit_overflow: - if (is_value) { - cb_error_x (loc, _("invalid VALUE clause")); - cb_error_x (loc, _("literal exceeds data size")); - return -1; - } - if (cb_warn_truncate && !suppress_warn) { - cb_warning_x (cb_warn_truncate, loc, _("numeric literal exceeds data size")); - } - return 0; - -non_integer_move: - if (cb_move_noninteger_to_alphanumeric == CB_ERROR) { - goto invalid; - } - if (!suppress_warn) { - cb_warning_x (COBC_WARN_FILLER, loc, _("MOVE of non-integer to alphanumeric")); - } - return 0; - -expect_numeric: - move_warning (src, dst, is_value, cb_warn_strict_typing, 0, - _("numeric value is expected")); - return 0; - -expect_alphanumeric: - move_warning (src, dst, is_value, cb_warn_strict_typing, 0, - _("alphanumeric value is expected")); - return 0; - -value_mismatch: - move_warning (src, dst, is_value, cb_warn_truncate, 0, - _("value does not fit the picture string")); - return 0; - -size_overflow: - /* note: size is -1 for numeric literals, contains literal size otherwise */ - move_warning (src, dst, is_value, cb_warn_truncate, size, - _("value size exceeds data size")); - return 0; - -size_overflow_1: - move_warning (src, dst, is_value, cb_warn_pos_truncate, 1, - _("sending field larger than receiving field")); - return 0; - -size_overflow_2: - move_warning (src, dst, is_value, cb_warn_pos_truncate, 1, - _("some digits may be truncated")); - return 0; -} - -static cb_tree -cb_build_memset (cb_tree x, const int c) -{ - if (cb_field_size (x) == 1) { - return CB_BUILD_FUNCALL_2 ("$E", x, cb_int (c)); - } - return CB_BUILD_FUNCALL_3 ("memset", - CB_BUILD_CAST_ADDRESS (x), - cb_int (c), CB_BUILD_CAST_LENGTH (x)); -} - -static cb_tree -cb_build_move_copy (cb_tree src, cb_tree dst) -{ - int size; - - size = cb_field_size (dst); - if (size == 1) { - return CB_BUILD_FUNCALL_2 ("$F", dst, src); - } - if (cb_move_ibm) { - overlapping = 0; - return CB_BUILD_FUNCALL_3 ("cob_move_ibm", - CB_BUILD_CAST_ADDRESS (dst), - CB_BUILD_CAST_ADDRESS (src), - CB_BUILD_CAST_LENGTH (dst)); - } else if (overlapping - || CB_FIELD_PTR (src)->storage == CB_STORAGE_LINKAGE - || CB_FIELD_PTR (dst)->storage == CB_STORAGE_LINKAGE - || CB_FIELD_PTR (src)->flag_item_based - || CB_FIELD_PTR (dst)->flag_item_based) { - overlapping = 0; - return CB_BUILD_FUNCALL_3 ("memmove", - CB_BUILD_CAST_ADDRESS (dst), - CB_BUILD_CAST_ADDRESS (src), - CB_BUILD_CAST_LENGTH (dst)); - } else { - return CB_BUILD_FUNCALL_3 ("memcpy", - CB_BUILD_CAST_ADDRESS (dst), - CB_BUILD_CAST_ADDRESS (src), - CB_BUILD_CAST_LENGTH (dst)); - } -} - -static cb_tree -cb_build_move_num_zero (cb_tree x) -{ - struct cb_field *f; - - f = CB_FIELD_PTR (x); - switch (f->usage) { - case CB_USAGE_BINARY: - case CB_USAGE_COMP_5: - case CB_USAGE_COMP_X: - case CB_USAGE_COMP_N: - if (f->flag_binary_swap) { - return cb_build_memset (x, 0); - } - switch (f->size) { -#ifdef COB_NON_ALIGNED - case 1: - return cb_build_assign (x, cb_int0); - case 2: -#ifdef COB_SHORT_BORK - if (f->storage != CB_STORAGE_LINKAGE && f->indexes == 0 && - (f->offset % 4 == 0)) { - return cb_build_assign (x, cb_int0); - } - break; -#endif - case 4: - case 8: - if (f->storage != CB_STORAGE_LINKAGE && f->indexes == 0 && - (f->offset % f->size == 0)) { - return cb_build_assign (x, cb_int0); - } - break; -#else - case 1: - case 2: - case 4: - case 8: - return cb_build_assign (x, cb_int0); -#endif - default: - break; - } - return cb_build_memset (x, 0); - case CB_USAGE_DISPLAY: - if (!cb_ebcdic_sign) { - return cb_build_memset (x, '0'); - } - if (f->pic && !f->pic->have_sign) { - return cb_build_memset (x, '0'); - } - break; - case CB_USAGE_PACKED: - return CB_BUILD_FUNCALL_1 ("cob_set_packed_zero", x); - case CB_USAGE_COMP_6: - return cb_build_memset (x, 0); - default: - break; - } - return CB_BUILD_FUNCALL_2 ("cob_move", cb_zero, x); -} - -static cb_tree -cb_build_move_space (cb_tree x) -{ - switch (CB_TREE_CATEGORY (x)) { - case CB_CATEGORY_NUMERIC: - case CB_CATEGORY_ALPHABETIC: - case CB_CATEGORY_ALPHANUMERIC: - if (!CB_FIELD_PTR (x)->flag_any_length) { - return cb_build_memset (x, ' '); - } - /* Fall through */ - default: - return CB_BUILD_FUNCALL_2 ("cob_move", cb_space, x); - } -} - -static cb_tree -cb_build_move_zero (cb_tree x) -{ - switch (CB_TREE_CATEGORY (x)) { - case CB_CATEGORY_NUMERIC: - if (CB_FIELD_PTR (x)->flag_blank_zero) { - return cb_build_move_space (x); - } else if (CB_FIELD_PTR (x)->flag_sign_separate) { - return CB_BUILD_FUNCALL_2 ("cob_move", cb_zero, x); - } else { - return cb_build_move_num_zero (x); - } - case CB_CATEGORY_ALPHABETIC: - case CB_CATEGORY_ALPHANUMERIC: - if (!CB_FIELD_PTR (x)->flag_any_length) { - return cb_build_memset (x, '0'); - } - /* Fall through */ - default: - return CB_BUILD_FUNCALL_2 ("cob_move", cb_zero, x); - } -} - -static cb_tree -cb_build_move_high (cb_tree x) -{ - switch (CB_TREE_CATEGORY (x)) { - case CB_CATEGORY_NUMERIC: - case CB_CATEGORY_ALPHABETIC: - case CB_CATEGORY_ALPHANUMERIC: - if (CB_FIELD_PTR (x)->flag_any_length) { - return CB_BUILD_FUNCALL_2 ("cob_move", cb_high, x); - } - if (cb_high == cb_norm_high) { - return cb_build_memset (x, 255); - } - /* Fall through */ - default: - return CB_BUILD_FUNCALL_2 ("cob_move", cb_high, x); - } -} - -static cb_tree -cb_build_move_low (cb_tree x) -{ - switch (CB_TREE_CATEGORY (x)) { - case CB_CATEGORY_NUMERIC: - case CB_CATEGORY_ALPHABETIC: - case CB_CATEGORY_ALPHANUMERIC: - if (CB_FIELD_PTR (x)->flag_any_length) { - return CB_BUILD_FUNCALL_2 ("cob_move", cb_low, x); - } - if (cb_low == cb_norm_low) { - return cb_build_memset (x, 0); - } - /* Fall through */ - default: - return CB_BUILD_FUNCALL_2 ("cob_move", cb_low, x); - } -} - -static cb_tree -cb_build_move_quote (cb_tree x) -{ - switch (CB_TREE_CATEGORY (x)) { - case CB_CATEGORY_NUMERIC: - case CB_CATEGORY_ALPHABETIC: - case CB_CATEGORY_ALPHANUMERIC: - if (!CB_FIELD_PTR (x)->flag_any_length) { - return cb_build_memset (x, cb_flag_apostrophe ? '\'' : '"'); - } - /* Fall through */ - default: - return CB_BUILD_FUNCALL_2 ("cob_move", cb_quote, x); - } -} - -#ifdef COB_EBCDIC_MACHINE -static void -cob_put_sign_ascii (unsigned char *p) -{ - switch (*p) { - case '0': - *p = (unsigned char)'p'; - return; - case '1': - *p = (unsigned char)'q'; - return; - case '2': - *p = (unsigned char)'r'; - return; - case '3': - *p = (unsigned char)'s'; - return; - case '4': - *p = (unsigned char)'t'; - return; - case '5': - *p = (unsigned char)'u'; - return; - case '6': - *p = (unsigned char)'v'; - return; - case '7': - *p = (unsigned char)'w'; - return; - case '8': - *p = (unsigned char)'x'; - return; - case '9': - *p = (unsigned char)'y'; - return; - } -} -#endif - -static void -cob_put_sign_ebcdic (unsigned char *p, const int sign) -{ - if (sign < 0) { - switch (*p) { - case '0': - *p = (unsigned char)'}'; - return; - case '1': - *p = (unsigned char)'J'; - return; - case '2': - *p = (unsigned char)'K'; - return; - case '3': - *p = (unsigned char)'L'; - return; - case '4': - *p = (unsigned char)'M'; - return; - case '5': - *p = (unsigned char)'N'; - return; - case '6': - *p = (unsigned char)'O'; - return; - case '7': - *p = (unsigned char)'P'; - return; - case '8': - *p = (unsigned char)'Q'; - return; - case '9': - *p = (unsigned char)'R'; - return; - default: - /* What to do here */ - *p = (unsigned char)'}'; - return; - } - } - switch (*p) { - case '0': - *p = (unsigned char)'{'; - return; - case '1': - *p = (unsigned char)'A'; - return; - case '2': - *p = (unsigned char)'B'; - return; - case '3': - *p = (unsigned char)'C'; - return; - case '4': - *p = (unsigned char)'D'; - return; - case '5': - *p = (unsigned char)'E'; - return; - case '6': - *p = (unsigned char)'F'; - return; - case '7': - *p = (unsigned char)'G'; - return; - case '8': - *p = (unsigned char)'H'; - return; - case '9': - *p = (unsigned char)'I'; - return; - default: - /* What to do here ? */ - *p = (unsigned char)'{'; - return; - } -} - -static cb_tree -cb_build_move_literal (cb_tree src, cb_tree dst) -{ - struct cb_literal *l; - struct cb_field *f; - unsigned char *buff; - unsigned char *p; - enum cb_category cat; - struct cb_reference *r; - int i; - int diff; - int val; - int n; - unsigned char bbyte; - - l = CB_LITERAL (src); - f = CB_FIELD_PTR (dst); - cat = CB_TREE_CATEGORY (dst); - - if (f->flag_any_length) { - return CB_BUILD_FUNCALL_2 ("cob_move", src, dst); - } - - if (CB_REFERENCE_P (dst)) { - r = CB_REFERENCE (dst); - if ((cb_reference_bounds_check == CB_WARNING - || cb_reference_bounds_check == CB_OK) - && (r->offset != NULL - || r->length != NULL)) { - return CB_BUILD_FUNCALL_2 ("cob_move", src, dst); - } - } - - if (l->all) { - if (cat == CB_CATEGORY_NUMERIC - || cat == CB_CATEGORY_NUMERIC_EDITED - || cat == CB_CATEGORY_FLOATING_EDITED) { - return CB_BUILD_FUNCALL_2 ("cob_move", src, dst); - } - if (l->size == 1) { - return CB_BUILD_FUNCALL_3 ("memset", - CB_BUILD_CAST_ADDRESS (dst), - cb_int (l->data[0]), - CB_BUILD_CAST_LENGTH (dst)); - } - bbyte = l->data[0]; - for (i = 0; i < (int)l->size; i++) { - if (bbyte != l->data[i]) { - break; - } - bbyte = l->data[i]; - } - if (i == (int)l->size) { - return CB_BUILD_FUNCALL_3 ("memset", - CB_BUILD_CAST_ADDRESS (dst), - cb_int (l->data[0]), - CB_BUILD_CAST_LENGTH (dst)); - } - if (f->size > 128) { - return CB_BUILD_FUNCALL_2 ("cob_move", src, dst); - } - buff = cobc_parse_malloc ((size_t)f->size); - for (i = 0; i < f->size; i++) { - buff[i] = l->data[i % l->size]; - } - return CB_BUILD_FUNCALL_3 ("memcpy", - CB_BUILD_CAST_ADDRESS (dst), - cb_build_string (buff, (size_t)f->size), - CB_BUILD_CAST_LENGTH (dst)); - } - - if (cat == CB_CATEGORY_NUMERIC_EDITED - || cat == CB_CATEGORY_FLOATING_EDITED) { - return CB_BUILD_FUNCALL_2 ("cob_move", src, dst); - } - - if ((cat == CB_CATEGORY_NUMERIC && f->usage == CB_USAGE_DISPLAY - && f->pic->scale == l->scale && !f->flag_sign_leading - && !f->flag_sign_separate && !f->flag_blank_zero) - || ((cat == CB_CATEGORY_ALPHABETIC || cat == CB_CATEGORY_ALPHANUMERIC) - && f->size < (int) (l->size + 16) - && !cb_field_variable_size (f))) { - buff = cobc_parse_malloc ((size_t)f->size); - diff = (int) (f->size - l->size); - if (cat == CB_CATEGORY_NUMERIC) { - if (diff <= 0) { - memcpy (buff, l->data - diff, (size_t)f->size); - } else { - memset (buff, '0', (size_t)diff); - memcpy (buff + diff, l->data, (size_t)l->size); - } - /* Check all zeros */ - n = 0; - for (p = buff; p < buff + f->size; p++) { - if (*p != '0') { - n = 1; - break; - } - } - if (f->pic->have_sign) { - p = &buff[f->size - 1]; - if (!n) { - /* Zeros */ - /* EBCDIC - store sign otherwise nothing */ - if (cb_ebcdic_sign) { - cob_put_sign_ebcdic (p, 1); - } - } else if (cb_ebcdic_sign) { - cob_put_sign_ebcdic (p, l->sign); - } else if (l->sign < 0) { -#ifdef COB_EBCDIC_MACHINE - cob_put_sign_ascii (p); -#else - *p += 0x40; -#endif - } - } - } else { - if (f->flag_justified) { - if (diff <= 0) { - memcpy (buff, l->data - diff, (size_t)f->size); - } else { - memset (buff, ' ', (size_t)diff); - memcpy (buff + diff, l->data, (size_t)l->size); - } - } else { - if (diff <= 0) { - memcpy (buff, l->data, (size_t)f->size); - } else { - memcpy (buff, l->data, (size_t)l->size); - memset (buff + l->size, ' ', (size_t)diff); - } - } - } - bbyte = *buff; - if (f->size == 1) { - cobc_parse_free (buff); - return CB_BUILD_FUNCALL_2 ("$E", dst, cb_int (bbyte)); - } - for (i = 0; i < f->size; i++) { - if (bbyte != buff[i]) { - break; - } - } - if (i == f->size) { - cobc_parse_free (buff); - return CB_BUILD_FUNCALL_3 ("memset", - CB_BUILD_CAST_ADDRESS (dst), - cb_int (bbyte), - CB_BUILD_CAST_LENGTH (dst)); - } - return CB_BUILD_FUNCALL_3 ("memcpy", - CB_BUILD_CAST_ADDRESS (dst), - cb_build_string (buff, (size_t)f->size), - CB_BUILD_CAST_LENGTH (dst)); - } - - if ((f->usage == CB_USAGE_BINARY - || f->usage == CB_USAGE_COMP_5 - || f->usage == CB_USAGE_COMP_X - || f->usage == CB_USAGE_COMP_N) - && cb_fits_int (src) - && f->size <= 8) { - if (cb_binary_truncate) { - return CB_BUILD_FUNCALL_2 ("cob_move", src, dst); - } - - val = cb_get_int (src); - n = f->pic->scale - l->scale; - if ((l->size + n) > 9) { - return CB_BUILD_FUNCALL_2 ("cob_move", src, dst); - } - for (; n > 0; n--) { - val *= 10; - } - for (; n < 0; n++) { - val /= 10; - } - if (val == 0) { - return cb_build_move_num_zero (dst); - } - if (val < 0 && !f->pic->have_sign) { - val = -val; - } - if (f->size == 1) { - return cb_build_assign (dst, cb_int (val)); - } - if (f->flag_binary_swap) { - i = (f->size - 1) + (8 * (f->pic->have_sign ? 1 : 0)); - optimize_defs[bin_set_funcs[i].optim_val] = 1; - return CB_BUILD_FUNCALL_2 (bin_set_funcs[i].optim_name, - CB_BUILD_CAST_ADDRESS (dst), - cb_int (val)); - } - switch (f->size) { - case 2: -#ifdef COB_SHORT_BORK - if (f->storage != CB_STORAGE_LINKAGE && f->indexes == 0 && - (f->offset % 4 == 0)) { - return cb_build_assign (dst, cb_int (val)); - } - break; -#endif - case 4: - case 8: -#ifdef COB_NON_ALIGNED - if (f->storage != CB_STORAGE_LINKAGE && f->indexes == 0 && - (f->offset % f->size == 0)) { - return cb_build_assign (dst, cb_int (val)); - } - break; -#else - return cb_build_assign (dst, cb_int (val)); -#endif - default: - break; - } - return CB_BUILD_FUNCALL_2 ("cob_move", src, dst); - } - - if ((f->usage == CB_USAGE_PACKED || f->usage == CB_USAGE_COMP_6) && - cb_fits_int (src)) { - if (f->pic->scale < 0) { - return CB_BUILD_FUNCALL_2 ("cob_move", src, dst); - } - val = cb_get_int (src); - n = f->pic->scale - l->scale; - if ((l->size + n) > 9) { - return CB_BUILD_FUNCALL_2 ("cob_move", src, dst); - } - for (; n > 0; n--) { - val *= 10; - } - for (; n < 0; n++) { - val /= 10; - } - if (val == 0) { - return cb_build_move_num_zero (dst); - } - if (val < 0 && !f->pic->have_sign) { - val = -val; - } -#if 1 /* RXWRXW - Set packed */ - return CB_BUILD_FUNCALL_2 ("cob_set_packed_int", dst, - cb_int (val)); -#else - return CB_BUILD_FUNCALL_2 ("cob_set_packed_int", dst, - cb_build_cast_llint (src)); -#endif - } - return CB_BUILD_FUNCALL_2 ("cob_move", src, dst); -} - -static cb_tree -cb_build_move_field (cb_tree src, cb_tree dst) -{ - struct cb_field *src_f; - struct cb_field *dst_f; - int src_size; - int dst_size; - - src_f = CB_FIELD_PTR (src); - dst_f = CB_FIELD_PTR (dst); - - if (dst_f->flag_any_length || src_f->flag_any_length) { - return CB_BUILD_FUNCALL_2 ("cob_move", src, dst); - } - src_size = cb_field_size (src); - dst_size = cb_field_size (dst); - if (src_size > 0 && dst_size > 0 && src_size >= dst_size - && !cb_field_variable_size (src_f) - && !cb_field_variable_size (dst_f)) { - switch (CB_TREE_CATEGORY (src)) { - case CB_CATEGORY_ALPHABETIC: - if (CB_TREE_CATEGORY (dst) == CB_CATEGORY_ALPHABETIC || - CB_TREE_CATEGORY (dst) == CB_CATEGORY_ALPHANUMERIC) { - if (dst_f->flag_justified == 0) { - return cb_build_move_copy (src, dst); - } - } - break; - case CB_CATEGORY_ALPHANUMERIC: - if (CB_TREE_CATEGORY (dst) == CB_CATEGORY_ALPHANUMERIC) { - if (dst_f->flag_justified == 0) { - return cb_build_move_copy (src, dst); - } - } - break; - case CB_CATEGORY_NUMERIC: - if (CB_TREE_CATEGORY (dst) == CB_CATEGORY_NUMERIC && - src_f->usage == dst_f->usage && - src_f->pic->size == dst_f->pic->size && - src_f->pic->digits == dst_f->pic->digits && - src_f->pic->scale == dst_f->pic->scale && - src_f->pic->have_sign == dst_f->pic->have_sign && - src_f->flag_binary_swap == dst_f->flag_binary_swap && - src_f->flag_sign_leading == dst_f->flag_sign_leading && - src_f->flag_sign_separate == dst_f->flag_sign_separate) { - return cb_build_move_copy (src, dst); - } else if (CB_TREE_CATEGORY (dst) == CB_CATEGORY_ALPHANUMERIC - && src_f->usage == CB_USAGE_DISPLAY - && src_f->pic->have_sign == 0 - && !src_f->flag_sign_leading - && !src_f->flag_sign_separate) { - return cb_build_move_copy (src, dst); - } - break; - default: - break; - } - } - - return CB_BUILD_FUNCALL_2 ("cob_move", src, dst); -} - -cb_tree -cb_build_move (cb_tree src, cb_tree dst) -{ - struct cb_reference *src_ref, *dst_ref, *x; - int move_zero; - - if (CB_INVALID_TREE(src) - || CB_INVALID_TREE(dst)) { - return cb_error_node; - } - - if (validate_move (src, dst, 0, &move_zero) < 0) { - return cb_error_node; - } - -#if 0 /* Flag receiving */ - if (CB_REFERENCE_P (src)) { - CB_REFERENCE (src)->flag_receiving = 0; - } -#endif - if (move_zero) { - src = cb_zero; - } else if (CB_LITERAL_P (src)) { - /* FIXME: don't do this for a DYNAMIC LENGTH target */ - const struct cb_literal* lit = CB_LITERAL (src); - char* p = (char*)lit->data; - char* end = p + lit->size - 1; - if (*end == ' ') { - while (p < end && *p == ' ') p++; - if (p == end) src = cb_space; - } - } - - if (current_program->flag_report) { - src = cb_check_sum_field (src); - dst = cb_check_sum_field (dst); - } - - if (CB_REFERENCE_P (src)) { - src_ref = CB_REFERENCE (src); - } else { - src_ref = NULL; - } - if (CB_REFERENCE_P (dst)) { - /* Clone reference */ - x = cobc_parse_malloc (sizeof(struct cb_reference)); - *x = *CB_REFERENCE (dst); - x->flag_receiving = 1; - dst = CB_TREE (x); - dst_ref = x; - } else { - dst_ref = NULL; - } - if (cb_listing_xref) { - cobc_xref_set_receiving (dst); - } - - if (CB_TREE_CLASS (dst) == CB_CLASS_POINTER || - CB_TREE_CLASS (src) == CB_CLASS_POINTER) { - return cb_build_assign (dst, src); - } - - if (src_ref && CB_ALPHABET_NAME_P(src_ref->value)) { - return CB_BUILD_FUNCALL_2 ("cob_move", src, dst); - } - if (CB_INDEX_OR_HANDLE_P (dst)) { - if (src == cb_null) { - return cb_build_assign (dst, cb_zero); - } - return cb_build_assign (dst, src); - } - - if (CB_INDEX_OR_HANDLE_P (src)) { - return CB_BUILD_FUNCALL_2 ("cob_set_int", dst, - cb_build_cast_int (src)); - } - - if (CB_INTRINSIC_P (src) || CB_INTRINSIC_P (dst)) { - return CB_BUILD_FUNCALL_2 ("cob_move", src, dst); - } - - if (src_ref && src_ref->check) { - return CB_BUILD_FUNCALL_2 ("cob_move", src, dst); - } - if (dst_ref && dst_ref->check) { - return CB_BUILD_FUNCALL_2 ("cob_move", src, dst); - } - - /* Output optimal code */ - if (src == cb_zero) { - return cb_build_move_zero (dst); - } else if (src == cb_space) { - return cb_build_move_space (dst); - } else if (src == cb_high) { - return cb_build_move_high (dst); - } else if (src == cb_low) { - return cb_build_move_low (dst); - } else if (src == cb_quote) { - return cb_build_move_quote (dst); - } else if (CB_LITERAL_P (src)) { - return cb_build_move_literal (src, dst); - } - return cb_build_move_field (src, dst); -} - -void -cb_emit_move (cb_tree src, cb_tree dsts) -{ - cb_tree l; - cb_tree x; - cb_tree m; - cb_tree svoff; - struct cb_literal *lt; - struct cb_field *f, *p; - unsigned int tempval; - struct cb_reference *r; - int bgnpos; - - if (cb_validate_one (src) - || cb_validate_list (dsts)) { - return; - } - - cb_check_data_incompat (src); - src = cb_check_sum_field (src); - - tempval = 0; - if (cb_list_length (dsts) > 1) { - if (CB_REFERENCE_P (src)) { - r = CB_REFERENCE (src); - } else { - r = NULL; - } - if (CB_INTRINSIC_P (src) || (r && (r->subs || r->offset))) { - tempval = 1; - cb_emit (CB_BUILD_FUNCALL_1 ("cob_put_indirect_field", - src)); - } - } - - for (l = dsts; l; l = CB_CHAIN (l)) { - x = CB_VALUE (l); - if (CB_REFERENCE_P (x)) { - r = CB_REFERENCE (x); - } else { - r = NULL; - } - if (CB_LITERAL_P (x) || CB_CONST_P (x) || - (r && (CB_LABEL_P (r->value) || CB_PROTOTYPE_P (r->value)))) { - cb_error_x (CB_TREE (current_statement), - _("invalid MOVE target: %s"), cb_name_errmsg (x)); - continue; - } - if (!tempval) { - if (CB_REFERENCE_P (x) - && CB_REFERENCE (x)->length == NULL - && cb_complex_odo) { - p = CB_FIELD_PTR(x); - if ((f = chk_field_variable_size (p)) != NULL) { - bgnpos = -1; - if (CB_REFERENCE (x)->offset == NULL - || CB_REFERENCE (x)->offset == cb_int1) { - bgnpos = 1; - } else if (CB_REFERENCE (x)->offset == cb_int2) { - bgnpos = 2; - } else - if (CB_REFERENCE (x)->offset != NULL - && CB_LITERAL_P (CB_REFERENCE (x)->offset)) { - lt = CB_LITERAL (CB_REFERENCE (x)->offset); - bgnpos = atoi((const char*)lt->data); - } - if (p->storage == CB_STORAGE_LINKAGE - || p->flag_item_based) { - if (bgnpos >= p->offset - && bgnpos < f->offset - && p->offset < f->offset) { - /* Move for fixed size header of field */ - /* to move values of possible DEPENDING ON fields */ - svoff = CB_REFERENCE (x)->offset; - CB_REFERENCE (x)->offset = cb_int (bgnpos); - CB_REFERENCE (x)->length = cb_int (f->offset - p->offset - bgnpos + 1); - m = cb_build_move (src, cb_check_sum_field(x)); - cb_emit (m); - CB_REFERENCE (x)->offset = svoff; - CB_REFERENCE (x)->length = NULL; - /* Then move the full field with ODO lengths set */ - } - } else { - if (bgnpos >= 1) { - CB_REFERENCE (x)->length = cb_int (p->size - bgnpos + 1); - } - } - } - } - m = cb_build_move (src, cb_check_sum_field(x)); - } else { - m = CB_BUILD_FUNCALL_1 ("cob_get_indirect_field", x); - } - cb_emit (m); - } -} - -/* OPEN statement */ - -void -cb_emit_open (cb_tree file, cb_tree mode, cb_tree sharing) -{ - cb_tree orig_file = file; - struct cb_file *f; - int open_mode; - - file = cb_ref (file); - if (file == cb_error_node) { - return; - } - current_statement->file = file; - f = CB_FILE (file); - open_mode = CB_INTEGER(mode)->val; - - if (open_mode == COB_OPEN_OUTPUT) { - /* add a "receiving" entry for the file */ - cobc_xref_link (&f->xref, CB_REFERENCE (orig_file)->common.source_line, 1); - } - - if (f->organization == COB_ORG_SORT) { - cb_error_x (CB_TREE (current_statement), - _("%s not allowed on %s files"), "OPEN", "SORT"); - return; - } - if (sharing == NULL) { - if (f->sharing) { - sharing = f->sharing; - } else { - sharing = cb_int0; - } - } - - /* TODO: replace mode and sharing with tree containing a string constant - (defines in common.h like COB_OPEN_I_O) */ - - if (f->extfh) { - cb_emit (CB_BUILD_FUNCALL_5 ("cob_extfh_open", f->extfh, file, mode, - sharing, f->file_status)); - } else { - cb_emit (CB_BUILD_FUNCALL_4 ("cob_open", file, mode, - sharing, f->file_status)); - } - - /* Check for file debugging */ - if (current_program->flag_debugging && - !current_statement->flag_in_debug && - f->flag_fl_debug) { - cb_emit (cb_build_debug (cb_debug_name, f->name, NULL)); - cb_emit (cb_build_move (cb_space, cb_debug_contents)); - cb_emit (cb_build_debug_call (f->debug_section)); - } -} - -/* PERFORM statement */ - -void -cb_emit_perform (cb_tree perform, cb_tree body, cb_tree newthread, cb_tree handle) -{ - if (perform == cb_error_node) { - return; - } - if (handle && !usage_is_thread_handle (handle)) { - cb_error_x (handle, _("HANDLE must be either a generic or a THREAD HANDLE")); - return; - } - if (current_program->flag_debugging && - !current_statement->flag_in_debug && body && CB_PAIR_P (body)) { - cb_emit (cb_build_debug (cb_debug_contents, "PERFORM LOOP", NULL)); - } - -#if 0 /* TODO: implement THREADs in libcob */ - /* remark: this won't work as the CALL has to be started in the new thread - if (newthread) { - cb_emit (CB_BUILD_FUNCALL_0 ("cob_threadstart")); - } - if (handle) { - cb_emit (CB_BUILD_FUNCALL_1 ("cob_get_threadhandle", handle)); - } */ -#else - COB_UNUSED (newthread); -#endif - CB_PERFORM (perform)->body = body; - cb_emit (perform); -} - -cb_tree -cb_build_perform_once (cb_tree body) -{ - cb_tree x; - - if (body == cb_error_node) { - return cb_error_node; - } - x = cb_build_perform (CB_PERFORM_ONCE); - CB_PERFORM (x)->body = body; - return x; -} - -cb_tree -cb_build_perform_times (cb_tree times) -{ - cb_tree x; - - if (cb_check_integer_value (times) == cb_error_node) { - return cb_error_node; - } - - x = cb_build_perform (CB_PERFORM_TIMES); - CB_PERFORM (x)->data = times; - return x; -} - -cb_tree -cb_build_perform_until (cb_tree condition, cb_tree varying) -{ - cb_tree x; - - x = cb_build_perform (CB_PERFORM_UNTIL); - CB_PERFORM (x)->test = condition; - CB_PERFORM (x)->varying = varying; - return x; -} - -cb_tree -cb_build_perform_forever (cb_tree body) -{ - cb_tree x; - - if (body == cb_error_node) { - return cb_error_node; - } - x = cb_build_perform (CB_PERFORM_FOREVER); - CB_PERFORM (x)->body = body; - return x; -} - -cb_tree -cb_build_perform_exit (struct cb_label *label) -{ - cb_tree x; - - x = cb_build_perform (CB_PERFORM_EXIT); - CB_PERFORM (x)->data = CB_TREE (label); - return x; -} - -/* READ statement */ - -void -cb_emit_read (cb_tree ref, cb_tree next, cb_tree into, - cb_tree key, cb_tree lock_opts) -{ - cb_tree file; - cb_tree rec; - cb_tree x; - struct cb_file *f; - int read_opts; - - read_opts = 0; - if (lock_opts == cb_int1) { - read_opts = COB_READ_LOCK; - } else if (lock_opts == cb_int2) { - read_opts = COB_READ_NO_LOCK; - } else if (lock_opts == cb_int3 - || current_statement->flag_ignore_lock) { - read_opts = COB_READ_IGNORE_LOCK; - current_statement->flag_ignore_lock = 0; - } else if (lock_opts == cb_int4) { - read_opts = COB_READ_WAIT_LOCK; - } else if (lock_opts == cb_int5) { - read_opts = COB_READ_LOCK | COB_READ_KEPT_LOCK; - } else if (lock_opts == cb_int6 - || current_statement->flag_advancing_lock) { - read_opts = COB_READ_ADVANCING_LOCK; - current_statement->flag_advancing_lock = 0; - } - file = cb_ref (ref); - if (file == cb_error_node) { - return; - } - f = CB_FILE (file); - - rec = cb_build_field_reference (f->record, ref); - if (f->organization == COB_ORG_SORT) { - cb_error_x (CB_TREE (current_statement), - _("%s not allowed on %s files"), "READ", "SORT"); - return; - } - if (next == cb_int1 || next == cb_int2 || - f->access_mode == COB_ACCESS_SEQUENTIAL) { - /* READ NEXT/PREVIOUS */ - if (next == cb_int2) { - switch (f->organization) { - case COB_ORG_INDEXED: - case COB_ORG_RELATIVE: - break; - default: - cb_error_x (CB_TREE (current_statement), - _("READ PREVIOUS not allowed for this file type")); - return; - } - read_opts |= COB_READ_PREVIOUS; - } else { - read_opts |= COB_READ_NEXT; - } - if (key) { - cb_warning (COBC_WARN_FILLER, _("KEY ignored with sequential READ")); - } - if (f->extfh) { - cb_emit (CB_BUILD_FUNCALL_4 ("cob_extfh_read_next", f->extfh, file, - f->file_status, cb_int (read_opts))); - } else { - cb_emit (CB_BUILD_FUNCALL_3 ("cob_read_next", file, - f->file_status, cb_int (read_opts))); - } - } else { - /* READ */ - /* DYNAMIC with [NOT] AT END */ - if (f->access_mode == COB_ACCESS_DYNAMIC && - current_statement->handler_type == AT_END_HANDLER) { - read_opts |= COB_READ_NEXT; - if (f->extfh) { - cb_emit (CB_BUILD_FUNCALL_4 ("cob_extfh_read_next", f->extfh, file, - f->file_status, cb_int (read_opts))); - } else { - cb_emit (CB_BUILD_FUNCALL_3 ("cob_read_next", file, - f->file_status, cb_int (read_opts))); - } - } else if (key || f->key) { - if (f->extfh) { - cb_emit (CB_BUILD_FUNCALL_5 ("cob_extfh_read", f->extfh, - file, key ? key : f->key, - f->file_status, cb_int (read_opts))); - } else { - cb_emit (CB_BUILD_FUNCALL_4 ("cob_read", - file, key ? key : f->key, - f->file_status, cb_int (read_opts))); - } - } else { - if (f->extfh) { - cb_emit (CB_BUILD_FUNCALL_4 ("cob_extfh_read_next", f->extfh, file, - f->file_status, cb_int (read_opts))); - } else { - cb_emit (CB_BUILD_FUNCALL_3 ("cob_read_next", file, - f->file_status, cb_int (read_opts))); - } - } - } - if (into) { - current_statement->handler3 = cb_build_move (rec, into); - } - - /* Check for file debugging */ - if (current_program->flag_debugging && - !current_statement->flag_in_debug && - f->flag_fl_debug) { - if (into) { - current_statement->handler3 = - CB_LIST_INIT (current_statement->handler3); - } - x = cb_build_debug (cb_debug_name, f->name, NULL); - current_statement->handler3 = - cb_list_add (current_statement->handler3, x); - x = cb_build_move (rec, cb_debug_contents); - current_statement->handler3 = - cb_list_add (current_statement->handler3, x); - x = cb_build_debug_call (f->debug_section); - current_statement->handler3 = - cb_list_add (current_statement->handler3, x); - } - current_statement->file = file; -} - -/* READY TRACE statement */ - -void -cb_emit_ready_trace (void) -{ - cb_emit (CB_BUILD_FUNCALL_0 ("cob_ready_trace")); -} - - -/* RESET TRACE statement */ - -void -cb_emit_reset_trace (void) -{ - cb_emit (CB_BUILD_FUNCALL_0 ("cob_reset_trace")); -} - -/* REWRITE statement */ - -static int -error_if_invalid_file_from_clause_literal (cb_tree literal) -{ - enum cb_category category = CB_TREE_CATEGORY (literal); - - if (cb_relaxed_syntax_checks || !(CB_CONST_P (literal) || CB_LITERAL_P (literal))) { - return 0; - } - - if (cb_is_figurative_constant (literal)) { - cb_error_x (literal, _("figurative constants not allowed in FROM clause")); - return 1; - } - - if (!(category == CB_CATEGORY_ALPHANUMERIC - || category == CB_CATEGORY_NATIONAL - || category == CB_CATEGORY_BOOLEAN)) { - cb_error_x (literal, _("literal in FROM clause must be alphanumeric, national or boolean")); - return 1; - } - - return 0; -} - -void -cb_emit_rewrite (cb_tree record, cb_tree from, cb_tree lockopt) -{ - cb_tree file; - cb_tree rtree; - struct cb_file *f; - int opts; - - if (cb_validate_one (record) - || cb_validate_one (from)) { - return; - } - rtree = cb_ref (record); - if (CB_FILE_P (rtree)) { - if (from == NULL) { - cb_error_x (CB_TREE (current_statement), - _("%s FILE requires a FROM clause"), "REWRITE"); - return; - } - file = rtree; /* FILE filename: was used */ - f = CB_FILE (file); - if (f->record->sister) { - record = CB_TREE(f->record->sister); - } else { - record = CB_TREE(f->record); - } - - if (error_if_invalid_file_from_clause_literal (from)) { - return; - } - } else { - if (!CB_REF_OR_FIELD_P (rtree)) { - cb_error_x (CB_TREE (current_statement), - _("%s requires a record name as subject"), "REWRITE"); - return; - } - if (CB_FIELD_PTR (record)->storage != CB_STORAGE_FILE) { - cb_error_x (CB_TREE (current_statement), - _("%s subject does not refer to a record name"), "REWRITE"); - return; - } - - file = CB_TREE (CB_FIELD (rtree)->file); - if (!file || file == cb_error_node) { - return; - } - } - current_statement->file = file; - f = CB_FILE (file); - opts = 0; - - if (cb_listing_xref) { - /* add a "receiving" entry for the file */ - cobc_xref_link (&f->xref, current_statement->common.source_line, 1); - } - - if (f->organization == COB_ORG_SORT) { - cb_error_x (CB_TREE (current_statement), - _("%s not allowed on %s files"), "REWRITE", "SORT"); - return; - } else if (f->reports) { - cb_error_x (CB_TREE (current_statement), - _("%s not allowed on %s files"), "REWRITE", "REPORT"); - return; - } else if (current_statement->handler_type == INVALID_KEY_HANDLER - && f->organization != COB_ORG_RELATIVE - && f->organization != COB_ORG_INDEXED) { - cb_error_x (CB_TREE(current_statement), - _("INVALID KEY clause invalid with this file type")); - return; - } else if ((f->lock_mode & COB_LOCK_AUTOMATIC) && lockopt) { - cb_error_x (CB_TREE (current_statement), - _("LOCK clause invalid with file LOCK AUTOMATIC")); - return; - } else if (lockopt == cb_int1) { - opts = COB_WRITE_LOCK; - } else if (lockopt == cb_int2) { - opts = COB_WRITE_NO_LOCK; - } - - if (from && (!CB_FIELD_P(from) || (CB_FIELD_PTR (from) != CB_FIELD_PTR (record)))) { - cb_emit (cb_build_move (from, record)); - } - - /* Check debugging on record name */ - if (current_program->flag_debugging && - !current_statement->flag_in_debug && - CB_FIELD_PTR (record)->flag_field_debug) { - cb_emit (cb_build_debug (cb_debug_name, - CB_FIELD_PTR (record)->name, NULL)); - cb_emit (cb_build_move (record, cb_debug_contents)); - cb_emit (cb_build_debug_call (CB_FIELD_PTR (record)->debug_section)); - } - if (f->extfh) { - cb_emit (CB_BUILD_FUNCALL_5 ("cob_extfh_rewrite", f->extfh, file, record, - cb_int (opts), f->file_status)); - } else { - cb_emit (CB_BUILD_FUNCALL_4 ("cob_rewrite", file, record, - cb_int (opts), f->file_status)); - } -} - -/* RELEASE statement */ - -void -cb_emit_release (cb_tree record, cb_tree from) -{ - struct cb_field *f; - cb_tree file; - - if (cb_validate_one (record)) { - return; - } - if (cb_validate_one (from)) { - return; - } - if (!CB_REF_OR_FIELD_P (cb_ref (record))) { - cb_error_x (CB_TREE (current_statement), - _("%s requires a record name as subject"), "RELEASE"); - return; - } - f = CB_FIELD_PTR (record); - if (f->storage != CB_STORAGE_FILE) { - cb_error_x (CB_TREE (current_statement), - _("%s subject does not refer to a record name"), "RELEASE"); - return; - } - file = CB_TREE (f->file); - if (CB_FILE (file)->organization != COB_ORG_SORT) { - cb_error_x (CB_TREE (current_statement), - _("RELEASE not allowed on this record item")); - return; - } - current_statement->file = file; - if (from) { - cb_emit (cb_build_move (from, record)); - } - cb_emit (CB_BUILD_FUNCALL_1 ("cob_file_release", file)); -} - -/* RETURN statement */ - -void -cb_emit_return (cb_tree ref, cb_tree into) -{ - cb_tree file; - cb_tree rec; - - if (cb_validate_one (ref) - || cb_validate_one (into)) { - return; - } - file = cb_ref (ref); - if (file == cb_error_node) { - return; - } - rec = cb_build_field_reference (CB_FILE (file)->record, ref); - cb_emit (CB_BUILD_FUNCALL_1 ("cob_file_return", file)); - if (into) { - current_statement->handler3 = cb_build_move (rec, into); - } - current_statement->file = file; -} - -/* ROLLBACK statement */ - -void -cb_emit_rollback (void) -{ - cb_emit (CB_BUILD_FUNCALL_0 ("cob_rollback")); -} - -/* SEARCH statement */ - -static unsigned int -search_set_keys (struct cb_field *f, cb_tree x) -{ - struct cb_binary_op *p; - struct cb_field *fldx; - struct cb_field *fldy; - int i; - - if (CB_REFERENCE_P (x)) { - x = build_cond_88 (x); - if (!x || x == cb_error_node) { - return 1; - } - } - - p = CB_BINARY_OP (x); - switch (p->op) { - case '&': - if (search_set_keys (f, p->x)) { - return 1; - } - if (search_set_keys (f, p->y)) { - return 1; - } - break; - case '=': - fldx = NULL; - fldy = NULL; - /* One of the operands must be a key reference */ - if (CB_REF_OR_FIELD_P (p->x)) { - fldx = CB_FIELD_PTR (p->x); - } - if (CB_REF_OR_FIELD_P (p->y)) { - fldy = CB_FIELD_PTR (p->y); - } - if (!fldx && !fldy) { - cb_error_x (CB_TREE (current_statement), - _("invalid SEARCH ALL condition")); - return 1; - } - - for (i = 0; i < f->nkeys; ++i) { - if (fldx == CB_FIELD_PTR (f->keys[i].key)) { - f->keys[i].ref = p->x; - f->keys[i].val = p->y; - break; - } - } - if (i == f->nkeys) { - for (i = 0; i < f->nkeys; ++i) { - if (fldy == CB_FIELD_PTR (f->keys[i].key)) { - f->keys[i].ref = p->y; - f->keys[i].val = p->x; - break; - } - } - if (i == f->nkeys) { - cb_error_x (CB_TREE (current_statement), - _("invalid SEARCH ALL condition")); - return 1; - } - } - break; - default: - cb_error_x (CB_TREE (current_statement), - _("invalid SEARCH ALL condition")); - return 1; - } - return 0; -} - -static cb_tree -cb_build_search_all (cb_tree table, cb_tree cond) -{ - cb_tree c1; - cb_tree c2; - struct cb_field *f; - int i; - - f = CB_FIELD_PTR (table); - /* Set keys */ - for (i = 0; i < f->nkeys; i++) { - f->keys[i].ref = NULL; - } - if (search_set_keys (f, cond)) { - return NULL; - } - c1 = NULL; - - /* Build condition */ - for (i = 0; i < f->nkeys; i++) { - if (f->keys[i].ref) { - if (f->keys[i].dir == COB_ASCENDING) { - c2 = cb_build_binary_op (f->keys[i].ref, '=', - f->keys[i].val); - } else { - c2 = cb_build_binary_op (f->keys[i].val, '=', - f->keys[i].ref); - } - if (c1 == NULL) { - c1 = c2; - } else { - c1 = cb_build_binary_op (c1, '&', c2); - } - } - } - - if (!c1) { - return NULL; - } - return cb_build_cond (c1); -} - -void -cb_emit_search (cb_tree table, cb_tree varying, cb_tree at_end, cb_tree whens) -{ - if (cb_validate_one (table) - || cb_validate_one (varying) - || whens == cb_error_node) { - return; - } - whens = cb_list_reverse (whens); - cb_emit (cb_build_search (0, table, varying, - cb_check_needs_break (at_end), whens)); -} - -void -cb_emit_search_all (cb_tree table, cb_tree at_end, cb_tree when, cb_tree stmts) -{ - cb_tree x; - cb_tree stmt_lis; - - if (cb_validate_one (table) - || when == cb_error_node) { - return; - } - x = cb_build_search_all (table, when); - if (!x) { - return; - } - - stmt_lis = cb_check_needs_break (stmts); - cb_emit (cb_build_search (1, table, NULL, - cb_check_needs_break (at_end), - cb_build_if (x, stmt_lis, NULL, 0))); -} - -/* SET statement */ - -void -cb_emit_setenv (cb_tree x, cb_tree y) -{ - cb_emit (CB_BUILD_FUNCALL_2 ("cob_set_environment", x, y)); -} - -void -cb_emit_set_to (cb_tree vars, cb_tree x) -{ - cb_tree l; - cb_tree v; - cb_tree rtree; - struct cb_cast *p; - enum cb_class tree_class; - - if (cb_validate_one (x) - || cb_validate_list (vars)) { - return; - } - - /* Check PROGRAM-POINTERs are the target for SET ... TO ENTRY. */ - if (CB_CAST_P (x)) { - p = CB_CAST (x); - if (p->cast_type == CB_CAST_PROGRAM_POINTER) { - for (l = vars; l; l = CB_CHAIN (l)) { - v = CB_VALUE (l); - if (!CB_REFERENCE_P (v)) { - cb_error_x (CB_TREE (current_statement), - _("SET targets must be PROGRAM-POINTER")); - CB_VALUE (l) = cb_error_node; - } else if (CB_FIELD(cb_ref(v))->usage != CB_USAGE_PROGRAM_POINTER) { - cb_error_x (CB_TREE (current_statement), - _("SET targets must be PROGRAM-POINTER")); - CB_VALUE (l) = cb_error_node; - } - } - } - } - - /* Check ADDRESS OF targets can be modified. */ - for (l = vars; l; l = CB_CHAIN (l)) { - v = CB_VALUE (l); - if (!CB_CAST_P (v)) { - continue; - } - p = CB_CAST (v); - if (p->cast_type != CB_CAST_ADDRESS) { - continue; - } - rtree = cb_ref (p->val); - /* LCOV_EXCL_START */ - if (rtree == cb_error_node) { - cobc_err_msg (_("call to '%s' with invalid parameter '%s'"), - "cb_emit_set_to", "vars"); - COBC_ABORT (); - } - /* LCOV_EXCL_STOP */ - if (CB_FIELD (rtree)->level != 1 - && CB_FIELD (rtree)->level != 77) { - cb_error_x (p->val, _("cannot change address of '%s', which is not level 1 or 77"), - cb_name (p->val)); - CB_VALUE (l) = cb_error_node; - } else if (!CB_FIELD (rtree)->flag_base) { - cb_error_x (p->val, _("cannot change address of '%s', which is not BASED or a LINKAGE item"), - cb_name (p->val)); - CB_VALUE (l) = cb_error_node; - } - } - - /* Emit statements if targets have the correct class. */ - for (l = vars; l; l = CB_CHAIN (l)) { - tree_class = cb_tree_class (CB_VALUE (l)); - switch (tree_class) { - case CB_CLASS_INDEX: - case CB_CLASS_NUMERIC: - case CB_CLASS_POINTER: - cb_check_data_incompat (x); - cb_emit (cb_build_move (x, CB_VALUE (l))); - break; - default: - if (CB_VALUE (l) != cb_error_node) { - cb_error_x (CB_TREE (current_statement), - _("SET target '%s' is not numeric, an INDEX or a POINTER"), - cb_name (CB_VALUE(l))); - } - break; - } - } -} - -/* - * SET pointer TO ADDRESS OF FH--FCD OF filename - */ -void -cb_emit_set_to_fcd (cb_tree vars, cb_tree x) -{ - cb_tree l; - cb_tree v; - cb_tree rtree; - cb_tree file; - struct cb_cast *p; - enum cb_class tree_class; - - if (cb_validate_one (x) - || cb_validate_list (vars)) { - return; - } - - /* Check ADDRESS OF targets can be modified. */ - for (l = vars; l; l = CB_CHAIN (l)) { - v = CB_VALUE (l); - if (!CB_CAST_P (v)) { - continue; - } - p = CB_CAST (v); - if (p->cast_type != CB_CAST_ADDRESS) { - continue; - } - rtree = cb_ref (p->val); - if (rtree == cb_error_node) { - cobc_err_msg (_("call to '%s' with invalid parameter '%s'"), - "cb_emit_set_to_fcd", "vars"); - COBC_ABORT (); - } - if (CB_FIELD (rtree)->level != 1 - && CB_FIELD (rtree)->level != 77) { - cb_error_x (p->val, _("cannot change address of '%s', which is not level 1 or 77"), - cb_name (p->val)); - CB_VALUE (l) = cb_error_node; - } else if (!CB_FIELD (rtree)->flag_base) { - cb_error_x (p->val, _("cannot change address of '%s', which is not BASED or a LINKAGE item"), - cb_name (p->val)); - CB_VALUE (l) = cb_error_node; - } - } - - file = cb_ref (x); - if (file == cb_error_node) { - return; - } - - /* Emit statements if targets have the correct class. */ - for (l = vars; l; l = CB_CHAIN (l)) { - tree_class = cb_tree_class (CB_VALUE (l)); - switch (tree_class) { - case CB_CLASS_POINTER: - cb_emit (CB_BUILD_FUNCALL_2 ("cob_file_fcd_adrs", file, cb_build_address (CB_VALUE (l)))); - break; - default: - if (CB_VALUE (l) != cb_error_node) { - cb_error_x (CB_TREE (current_statement), - _("SET target '%s' is not a POINTER for FCD"), cb_name (CB_VALUE(l))); - } - break; - } - } -} - -/* - * SET pointer TO ADDRESS OF FH--KEYDEF OF filename - */ -void -cb_emit_set_to_fcdkey (cb_tree vars, cb_tree x) -{ - cb_tree l; - cb_tree v; - cb_tree rtree; - cb_tree file; - struct cb_cast *p; - enum cb_class tree_class; - - if (cb_validate_one (x) - || cb_validate_list (vars)) { - return; - } - - /* Check ADDRESS OF targets can be modified. */ - for (l = vars; l; l = CB_CHAIN (l)) { - v = CB_VALUE (l); - if (!CB_CAST_P (v)) { - continue; - } - p = CB_CAST (v); - if (p->cast_type != CB_CAST_ADDRESS) { - continue; - } - rtree = cb_ref (p->val); - if (rtree == cb_error_node) { - cobc_err_msg (_("call to '%s' with invalid parameter '%s'"), - "cb_emit_set_to_fcd", "vars"); - COBC_ABORT (); - } - if (CB_FIELD (rtree)->level != 1 - && CB_FIELD (rtree)->level != 77) { - cb_error_x (p->val, _("cannot change address of '%s', which is not level 1 or 77"), - cb_name (p->val)); - CB_VALUE (l) = cb_error_node; - } else if (!CB_FIELD (rtree)->flag_base) { - cb_error_x (p->val, _("cannot change address of '%s', which is not BASED or a LINKAGE item"), - cb_name (p->val)); - CB_VALUE (l) = cb_error_node; - } - } - - file = cb_ref (x); - if (file == cb_error_node) { - return; - } - - /* Emit statements if targets have the correct class. */ - for (l = vars; l; l = CB_CHAIN (l)) { - tree_class = cb_tree_class (CB_VALUE (l)); - switch (tree_class) { - case CB_CLASS_POINTER: - cb_emit (CB_BUILD_FUNCALL_2 ("cob_file_fcdkey_adrs", file, cb_build_address (CB_VALUE (l)))); - break; - default: - if (CB_VALUE (l) != cb_error_node) { - cb_error_x (CB_TREE (current_statement), - _("SET target '%s' is not a POINTER for FCD-KEYDEF"), cb_name (CB_VALUE(l))); - } - break; - } - } -} -void -cb_emit_set_up_down (cb_tree l, cb_tree flag, cb_tree x) -{ - if (cb_validate_one (x) - || cb_validate_list (l)) { - return; - } - for (; l; l = CB_CHAIN (l)) { - if (flag == cb_int0) { - cb_emit (cb_build_add (CB_VALUE (l), x, cb_int0)); - } else { - cb_emit (cb_build_sub (CB_VALUE (l), x, cb_int0)); - } - } -} - -void -cb_emit_set_on_off (cb_tree l, cb_tree flag) -{ - struct cb_system_name *s; - - if (cb_validate_list (l)) { - return; - } - for (; l; l = CB_CHAIN (l)) { - s = CB_SYSTEM_NAME (cb_ref (CB_VALUE (l))); - cb_emit (CB_BUILD_FUNCALL_2 ("cob_set_switch", - cb_int (s->token), flag)); - } -} - -void -cb_emit_set_true (cb_tree l) -{ - cb_tree x; - struct cb_field *f; - cb_tree ref; - cb_tree val; - - for (; l; l = CB_CHAIN (l)) { - x = CB_VALUE (l); - if (x == cb_error_node) { - return; - } - if (!(CB_REFERENCE_P (x) && CB_FIELD_P(CB_REFERENCE(x)->value)) && - !CB_FIELD_P (x)) { - cb_error_x (x, _("invalid SET statement")); - return; - } - f = CB_FIELD_PTR (x); - if (f->level != 88) { - cb_error_x (x, _("invalid SET statement")); - return; - } - ref = cb_build_field_reference (f->parent, x); - val = CB_VALUE (f->values); - if (CB_PAIR_P (val)) { - val = CB_PAIR_X (val); - } - cb_emit (cb_build_move (val, ref)); - } -} - -void -cb_emit_set_false (cb_tree l) -{ - cb_tree x; - struct cb_field *f; - cb_tree ref; - cb_tree val; - - for (; l; l = CB_CHAIN (l)) { - x = CB_VALUE (l); - if (x == cb_error_node) { - return; - } - if (!(CB_REFERENCE_P (x) && CB_FIELD_P(CB_REFERENCE(x)->value)) && - !CB_FIELD_P (x)) { - cb_error_x (x, _("invalid SET statement")); - return; - } - f = CB_FIELD_PTR (x); - if (f->level != 88) { - cb_error_x (x, _("invalid SET statement")); - return; - } - if (!f->false_88) { - cb_error_x (x, _("field does not have a FALSE clause")); - return; - } - ref = cb_build_field_reference (f->parent, x); - val = CB_VALUE (f->false_88); - if (CB_PAIR_P (val)) { - val = CB_PAIR_X (val); - } - cb_emit (cb_build_move (val, ref)); - } -} - -void -cb_emit_set_thread_priority (cb_tree handle, cb_tree priority) -{ - cb_tree used_handle; - - if (handle && handle != cb_null && !usage_is_thread_handle (handle)) { - cb_error_x (handle, _("HANDLE must be either a generic or a THREAD HANDLE")); - return; - } - used_handle = handle; - if (used_handle && used_handle == cb_null) { - used_handle = CB_BUILD_FUNCALL_1 ("cob_get_threadhandle", NULL); - } - - if (cb_validate_one (priority)) { - return; - } - if (CB_LITERAL_P (priority)) { - if (cb_get_int (priority) > 32767) { - cb_error (_("THREAD-priority must be between 1 and 32767")); - } - } -#if 0 /* TODO: implement THREADs in libcob */ - cb_emit (CB_BUILD_FUNCALL_2 ("set_thread_priority", - used_handle, cb_build_cast_int (priority))); -#endif -} - -void -cb_emit_set_attribute (cb_tree x, const cob_flags_t val_on, - const cob_flags_t val_off) -{ - struct cb_field *f; - - if (cb_validate_one (x)) { - return; - } - if (!CB_REF_OR_FIELD_P (cb_ref (x))) { - cb_error_x (CB_TREE (current_statement), - _("SET ATTRIBUTE requires a screen item as subject")); - return; - } - f = CB_FIELD_PTR (x); - if (f->storage != CB_STORAGE_SCREEN) { - cb_error_x (CB_TREE (current_statement), - _("SET ATTRIBUTE subject does not refer to a screen item")); - return; - } - cb_emit (cb_build_set_attribute (f, val_on, val_off)); -} - -void -cb_emit_set_last_exception_to_off (void) -{ - cb_emit (CB_BUILD_FUNCALL_1 ("cob_set_exception", cb_int0)); -} - -/* SORT statement */ - -void -cb_emit_sort_init (cb_tree name, cb_tree keys, cb_tree col, cb_tree nat_col) -{ - cb_tree l; - cb_tree rtree; - struct cb_field *f; - - if (cb_validate_list (keys)) { - return; - } - rtree = cb_ref (name); - if (rtree == cb_error_node) { - return; - } - for (l = keys; l; l = CB_CHAIN (l)) { - if (CB_VALUE (l) == NULL) { - CB_VALUE (l) = name; - } - } - - /* note: the reference to the program's collation, - if not explicit specified in SORT is done within libcob */ - if (col == NULL) { - col = cb_null; - } else { - col = cb_ref (col); - } - if (nat_col == NULL) { - nat_col = cb_null; - } else { - nat_col = cb_ref (nat_col); - } - /* TODO: pass national collation to libcob */ - COB_UNUSED (nat_col); - - if (CB_FILE_P (rtree)) { - if (CB_FILE (rtree)->organization != COB_ORG_SORT) { - cb_error_x (name, _("invalid SORT filename")); - } - if (current_program->cb_sort_return) { - CB_FIELD_PTR (current_program->cb_sort_return)->count++; - cb_emit (CB_BUILD_FUNCALL_5 ("cob_file_sort_init", rtree, - cb_int ((int)cb_list_length (keys)), col, - CB_BUILD_CAST_ADDRESS (current_program->cb_sort_return), - CB_FILE(rtree)->file_status)); - } else { - cb_emit (CB_BUILD_FUNCALL_5 ("cob_file_sort_init", rtree, - cb_int ((int)cb_list_length (keys)), col, - cb_null, CB_FILE(rtree)->file_status)); - - } - /* TODO: pass key-specific collation to libcob */ - for (l = keys; l; l = CB_CHAIN (l)) { - cb_emit (CB_BUILD_FUNCALL_4 ("cob_file_sort_init_key", - rtree, - CB_VALUE (l), - CB_PURPOSE (l), - cb_int (CB_FIELD_PTR (CB_VALUE(l))->offset))); - } - } else { - cb_emit (CB_BUILD_FUNCALL_2 ("cob_table_sort_init", - cb_int ((int)cb_list_length (keys)), col)); - /* TODO: pass key-specific collation to libcob */ - for (l = keys; l; l = CB_CHAIN (l)) { - cb_emit (CB_BUILD_FUNCALL_3 ("cob_table_sort_init_key", - CB_VALUE (l), - CB_PURPOSE (l), - cb_int(CB_FIELD_PTR (CB_VALUE(l))->offset - - CB_FIELD_PTR (CB_VALUE(l))->parent->offset))); - } - f = CB_FIELD (rtree); - cb_emit (CB_BUILD_FUNCALL_2 ("cob_table_sort", name, - (f->depending - ? cb_build_cast_int (f->depending) - : cb_int (f->occurs_max)))); - } -} - -void -cb_emit_sort_using (cb_tree file, cb_tree l) -{ - cb_tree rtree; - - if (cb_validate_list (l)) { - return; - } - rtree = cb_ref (file); - /* LCOV_EXCL_START */ - if (rtree == cb_error_node) { - cobc_err_msg (_("call to '%s' with invalid parameter '%s'"), - "cb_emit_sort_using", "file"); - COBC_ABORT (); - } - /* LCOV_EXCL_STOP */ - for (; l; l = CB_CHAIN (l)) { - if (CB_FILE (cb_ref(CB_VALUE(l)))->organization == COB_ORG_SORT) { - cb_error_x (CB_TREE (current_statement), - _("invalid SORT USING parameter")); - } - cb_emit (CB_BUILD_FUNCALL_2 ("cob_file_sort_using", - rtree, cb_ref (CB_VALUE (l)))); - } -} - -void -cb_emit_sort_input (cb_tree proc) -{ - if (current_program->flag_debugging && - !current_statement->flag_in_debug) { - cb_emit (cb_build_debug (cb_debug_contents, "SORT INPUT", NULL)); - } - cb_emit (cb_build_perform_once (proc)); -} - -void -cb_emit_sort_giving (cb_tree file, cb_tree l) -{ - cb_tree p; - int listlen; - - if (cb_validate_list (l)) { - return; - } - for (p = l; p; p = CB_CHAIN (p)) { - if (CB_FILE (cb_ref(CB_VALUE(p)))->organization == COB_ORG_SORT) { - cb_error_x (CB_TREE (current_statement), - _("invalid SORT GIVING parameter")); - } - } - p = cb_ref (file); - /* LCOV_EXCL_START */ - if (p == cb_error_node) { - cobc_err_msg (_("call to '%s' with invalid parameter '%s'"), - "cb_emit_sort_giving", "file"); - COBC_ABORT (); - } - /* LCOV_EXCL_STOP */ - listlen = cb_list_length (l); - p = CB_BUILD_FUNCALL_2 ("cob_file_sort_giving", p, l); - CB_FUNCALL(p)->varcnt = listlen; - cb_emit (p); -} - -void -cb_emit_sort_output (cb_tree proc) -{ - if (current_program->flag_debugging && - !current_statement->flag_in_debug) { - if (current_statement->flag_merge) { - cb_emit (cb_build_debug (cb_debug_contents, - "MERGE OUTPUT", NULL)); - } else { - cb_emit (cb_build_debug (cb_debug_contents, - "SORT OUTPUT", NULL)); - } - } - cb_emit (cb_build_perform_once (proc)); -} - -void -cb_emit_sort_finish (cb_tree file) -{ - if (CB_FILE_P (cb_ref (file))) { - cb_emit (CB_BUILD_FUNCALL_1 ("cob_file_sort_close", cb_ref (file))); - } -} - -/* START statement */ - -static unsigned int -check_valid_key (const struct cb_file *cbf, const struct cb_field *f) -{ - cb_tree kfld; - struct cb_alt_key *cbak; - struct cb_field *f1; - struct cb_field *ff; - - if (cbf->organization != COB_ORG_INDEXED) { - if (CB_FIELD_PTR (cbf->key) != f) { - cb_error_x (CB_TREE (current_statement), - _("invalid key item")); - return 1; - } - return 0; - } - - /* - * Pass if field f refs a declared key for target file. - * This will pass split-keys which are virtual record fields. - */ - for (cbak = cbf->alt_key_list; cbak; cbak = cbak->next) { - if (CB_FIELD_PTR (cbak->key) == f) { - return 0; - } - } - if (cbf->component_list != NULL - && CB_FIELD_PTR (cbf->key) == f) { - return 0; - } - - ff = cb_field_founder (f); - for (f1 = cbf->record; f1; f1 = f1->sister) { - if (f1 == ff) { - break; - } - } - if (!f1) { - cb_error_x (CB_TREE (current_statement), _("invalid key item")); - return 1; - } - - kfld = cb_ref (cbf->key); - if (kfld == cb_error_node) { - return 1; - } - if (f->offset == CB_FIELD_PTR (kfld)->offset) { - return 0; - } - for (cbak = cbf->alt_key_list; cbak; cbak = cbak->next) { - kfld = cb_ref (cbak->key); - if (kfld == cb_error_node) { - return 1; - } - if (f->offset == CB_FIELD_PTR (kfld)->offset) { - return 0; - } - } - cb_error_x (CB_TREE (current_statement), _("invalid key item")); - return 1; -} - -void -cb_emit_start (cb_tree file, cb_tree op, cb_tree key, cb_tree keylen) -{ - cb_tree kfld; - cb_tree fl; - cb_tree cbtkey; - struct cb_file *f; - - if (cb_validate_one (key) - || cb_validate_one (keylen)) { - return; - } - fl = cb_ref (file); - if (fl == cb_error_node) { - return; - } - f = CB_FILE (fl); - - if (f->organization != COB_ORG_INDEXED && - f->organization != COB_ORG_RELATIVE) { - cb_error_x (CB_TREE (current_statement), - _("%s not allowed on %s files"), "START", "SEQUENTIAL"); - return; - } - if (keylen && f->organization != COB_ORG_INDEXED) { - cb_error_x (CB_TREE (current_statement), - _("LENGTH/SIZE clause only allowed on INDEXED files")); - return; - } - if (f->access_mode == COB_ACCESS_RANDOM) { - cb_error_x (CB_TREE (current_statement), - _("START not allowed with ACCESS MODE RANDOM")); - return; - } - - current_statement->file = fl; - if (key) { - kfld = cb_ref (key); - if (kfld == cb_error_node) { - return; - } - if (check_valid_key (f, CB_FIELD_PTR (kfld))) { - return; - } - cbtkey = key; - } else { - cbtkey = f->key; - } - - /* Check for file debugging */ - if (current_program->flag_debugging && - !current_statement->flag_in_debug && - f->flag_fl_debug) { - /* Gen callback after start but before exception test */ - current_statement->flag_callback = 1; - } - - if (f->extfh) { - cb_emit (CB_BUILD_FUNCALL_6 ("cob_extfh_start", f->extfh, fl, op, cbtkey, keylen, - f->file_status)); - } else { - cb_emit (CB_BUILD_FUNCALL_5 ("cob_start", fl, op, cbtkey, keylen, - f->file_status)); - } -} - -/* STOP statement */ - -void -cb_emit_stop_run (cb_tree x) -{ - cb_emit (CB_BUILD_FUNCALL_1 ("cob_stop_run", cb_build_cast_int (x))); -} - -void -cb_emit_stop_thread (cb_tree handle) -{ - cb_tree used_handle; - - if (handle && handle != cb_null && !usage_is_thread_handle (handle)) { - cb_error_x (handle, _("HANDLE must be either a generic or a THREAD HANDLE")); - return; - } - used_handle = handle; - if (used_handle && used_handle == cb_null) { - used_handle = CB_BUILD_FUNCALL_1 ("cob_get_threadhandle", NULL); - } -#if 0 /* TODO: implement THREADs in libcob */ - cb_emit (CB_BUILD_FUNCALL_1 ("cob_stop_thread", used_handle)); -#else - cb_emit (CB_BUILD_FUNCALL_1 ("cob_stop_run", cb_int (0))); -#endif -} - -/* STRING statement */ - -void -cb_emit_string (cb_tree items, cb_tree into, cb_tree pointer) -{ - cb_tree start; - cb_tree l; - cb_tree end; - cb_tree dlm; - - if (cb_validate_one (into) - || cb_validate_one (pointer)) { - return; - } - start = items; - cb_emit (CB_BUILD_FUNCALL_2 ("cob_string_init", into, pointer)); - while (start) { - - /* Find next DELIMITED item */ - for (end = start; end; end = CB_CHAIN (end)) { - if (CB_PAIR_P (CB_VALUE (end))) { - break; - } - } - - /* generate cob_string_delimited from delimiter */ - dlm = end ? CB_PAIR_X (CB_VALUE (end)) : NULL; - if (dlm == cb_int0) { - dlm = NULL; - } else { - if (cb_validate_one (dlm)) { - return; - } - } - cb_emit (CB_BUILD_FUNCALL_1 ("cob_string_delimited", dlm)); - - /* generate cob_string_append for all entries until delimiter */ - for (l = start; l != end; l = CB_CHAIN (l)) { - if (cb_validate_one (CB_VALUE (l))) { - return; - } - cb_emit (CB_BUILD_FUNCALL_1 ("cob_string_append", - CB_VALUE (l))); - } - - start = end ? CB_CHAIN (end) : NULL; - } - cb_emit (CB_BUILD_FUNCALL_0 ("cob_string_finish")); -} - -/* UNLOCK statement */ - -void -cb_emit_unlock (cb_tree ref) -{ - cb_tree file; - - file = cb_ref (ref); - if (file != cb_error_node) { - cb_emit (CB_BUILD_FUNCALL_2 ("cob_unlock_file", - file, CB_FILE(file)->file_status)); - current_statement->file = file; - } -} - -/* UNSTRING statement */ - -void -cb_emit_unstring (cb_tree name, cb_tree delimited, cb_tree into, - cb_tree pointer, cb_tree tallying) -{ - if (cb_validate_one (name) - || cb_validate_one (tallying) - || cb_validate_list (delimited) - || cb_validate_list (into)) { - return; - } - cb_emit (CB_BUILD_FUNCALL_3 ("cob_unstring_init", name, pointer, - cb_int ((int)cb_list_length (delimited)))); - cb_emit_list (delimited); - cb_emit_list (into); - if (tallying) { - cb_emit (CB_BUILD_FUNCALL_1 ("cob_unstring_tallying", tallying)); - } - cb_emit (CB_BUILD_FUNCALL_0 ("cob_unstring_finish")); -} - -cb_tree -cb_build_unstring_delimited (cb_tree all, cb_tree value) -{ - if (cb_validate_one (value)) { - return cb_error_node; - } - return CB_BUILD_FUNCALL_2 ("cob_unstring_delimited", value, all); -} - -cb_tree -cb_build_unstring_into (cb_tree name, cb_tree delimiter, cb_tree count) -{ - if (cb_validate_one (name)) { - return cb_error_node; - } - if (delimiter == NULL) { - delimiter = cb_int0; - } - if (count == NULL) { - count = cb_int0; - } - return CB_BUILD_FUNCALL_3 ("cob_unstring_into", name, delimiter, count); -} - -/* WRITE statement */ - -void -cb_emit_write (cb_tree record, cb_tree from, cb_tree opt, cb_tree lockopt) -{ - cb_tree file; - cb_tree rtree; - cb_tree check_eop; - struct cb_file *f; - - if (cb_validate_one (record) - || cb_validate_one (from)) { - return; - } - rtree = cb_ref (record); - if (CB_FILE_P (rtree)) { - /* FILE filename: was used */ - if (from == NULL) { - cb_error_x (CB_TREE (current_statement), - _("%s FILE requires a FROM clause"), "WRITE"); - return; - } - file = rtree; - f = CB_FILE (file); - if (f->record->sister) { - record = CB_TREE(f->record->sister); - } else { - record = CB_TREE(f->record); - } - - if (error_if_invalid_file_from_clause_literal (from)) { - return; - } - } else { - if (!CB_REF_OR_FIELD_P (rtree)) { - cb_error_x (CB_TREE (current_statement), - _("%s requires a record name as subject"), "WRITE"); - return; - } - if (CB_FIELD_PTR (record)->storage != CB_STORAGE_FILE) { - cb_error_x (CB_TREE (current_statement), - _("%s subject does not refer to a record name"), "WRITE"); - return; - } - file = CB_TREE (CB_FIELD (rtree)->file); - if (!file || file == cb_error_node) { - return; - } - } - current_statement->file = file; - f = CB_FILE (file); - - if (cb_listing_xref) { - /* add a "receiving" entry for the file */ - cobc_xref_link (&f->xref, current_statement->common.source_line, 1); - } - - if (f->organization == COB_ORG_SORT) { - cb_error_x (CB_TREE (current_statement), - _("%s not allowed on %s files"), "WRITE", "SORT"); - } else if (f->reports) { - cb_error_x (CB_TREE (current_statement), - _("%s not allowed on %s files"), "WRITE", "REPORT"); - return; - } else if (current_statement->handler_type == INVALID_KEY_HANDLER && - (f->organization != COB_ORG_RELATIVE && - f->organization != COB_ORG_INDEXED)) { - cb_error_x (CB_TREE(current_statement), - _("INVALID KEY clause invalid with this file type")); - } else if (lockopt) { - if (f->lock_mode & COB_LOCK_AUTOMATIC) { - cb_error_x (CB_TREE (current_statement), - _("LOCK clause invalid with file LOCK AUTOMATIC")); - } else if (opt != cb_int0) { - cb_error_x (CB_TREE (current_statement), - _("LOCK clause invalid here")); - } else if (lockopt == cb_int1) { - opt = cb_int (COB_WRITE_LOCK); - } else if (lockopt == cb_int2) { - opt = cb_int (COB_WRITE_NO_LOCK); - } - } - - if (from && (!CB_FIELD_P(from) || (CB_FIELD_PTR (from) != CB_FIELD_PTR (record)))) { - cb_emit (cb_build_move (from, record)); - } - - /* Check debugging on record name */ - if (current_program->flag_debugging && - !current_statement->flag_in_debug && - CB_FIELD_PTR (record)->flag_field_debug) { - cb_emit (cb_build_debug (cb_debug_name, - CB_FIELD_PTR (record)->name, NULL)); - cb_emit (cb_build_move (record, cb_debug_contents)); - cb_emit (cb_build_debug_call (CB_FIELD_PTR (record)->debug_section)); - } - if (f->organization == COB_ORG_LINE_SEQUENTIAL - && opt == cb_int0) { - if(cb_mf_files) { - /* Micro Focus has omission of ADVANCING default to - * BEFORE ADVANCING 1 LINE - */ - if (cb_flag_write_after) { /* -fwrite-after */ - opt = cb_int_hex (COB_WRITE_AFTER | COB_WRITE_LINES | 1); - } else { - opt = cb_int_hex (COB_WRITE_BEFORE | COB_WRITE_LINES | 1); - } - } else { - /* ISO Standard has omission of ADVANCING default to - * AFTER ADVANCING 1 LINE - */ - if (cb_flag_write_after /* -fwrite-after */ - || CB_FILE(file)->flag_line_adv) { - opt = cb_int_hex (COB_WRITE_AFTER | COB_WRITE_LINES | 1); - } else { - opt = cb_int_hex (COB_WRITE_BEFORE | COB_WRITE_LINES | 1); - } - } - } - if (current_statement->handler_type == EOP_HANDLER && - current_statement->ex_handler) { - check_eop = cb_int1; - } else { - check_eop = cb_int0; - } - if (f->extfh) { - cb_emit (CB_BUILD_FUNCALL_6 ("cob_extfh_write", f->extfh, file, record, opt, - f->file_status, check_eop)); - } else { - cb_emit (CB_BUILD_FUNCALL_5 ("cob_write", file, record, opt, - f->file_status, check_eop)); - } -} - -cb_tree -cb_build_write_advancing_lines (cb_tree pos, cb_tree lines) -{ - cb_tree e; - int opt; - - opt = (pos == CB_BEFORE) ? COB_WRITE_BEFORE : COB_WRITE_AFTER; - opt |= COB_WRITE_LINES; - if (CB_LITERAL_P (lines)) { - opt |= cb_get_int (lines); - return cb_int_hex (opt); - } - e = cb_build_binary_op (cb_int (opt), '+', lines); - return cb_build_cast_int (e); -} - -cb_tree -cb_build_write_advancing_mnemonic (cb_tree pos, cb_tree mnemonic) -{ - int opt; - int token; - cb_tree rtree = cb_ref (mnemonic); - - if (rtree == cb_error_node) { - return cb_int0; - } - token = CB_SYSTEM_NAME (rtree)->token; - switch (token) { - case CB_FEATURE_FORMFEED: /* including S01-S05, CSP and TOP */ - opt = (pos == CB_BEFORE) ? COB_WRITE_BEFORE : COB_WRITE_AFTER; - return cb_int_hex (opt | COB_WRITE_PAGE); - case CB_FEATURE_C01: - case CB_FEATURE_C02: - case CB_FEATURE_C03: - case CB_FEATURE_C04: - case CB_FEATURE_C05: - case CB_FEATURE_C06: - case CB_FEATURE_C07: - case CB_FEATURE_C08: - case CB_FEATURE_C09: - case CB_FEATURE_C10: - case CB_FEATURE_C11: - case CB_FEATURE_C12: - opt = (pos == CB_BEFORE) ? COB_WRITE_BEFORE : COB_WRITE_AFTER; - return cb_int_hex (opt | COB_WRITE_CHANNEL | COB_WRITE_PAGE | token); - /* case CB_FEATURE_AFP_5A: what to do here? */ - default: - cb_error_x (mnemonic, _("invalid mnemonic name")); - return cb_int0; - } -} - -cb_tree -cb_build_write_advancing_page (cb_tree pos) -{ - int opt = (pos == CB_BEFORE) ? COB_WRITE_BEFORE : COB_WRITE_AFTER; - - return cb_int_hex (opt | COB_WRITE_PAGE); -} - -#ifndef HAVE_DESIGNATED_INITS -void -cobc_init_typeck (void) -{ - memset(expr_prio, 0, sizeof(expr_prio)); - expr_prio['x' & 0xFF] = 0; - expr_prio['^' & 0xFF] = 1; - expr_prio['*' & 0xFF] = 2; - expr_prio['/' & 0xFF] = 2; - expr_prio['+' & 0xFF] = 3; - expr_prio['-' & 0xFF] = 3; - expr_prio['=' & 0xFF] = 4; - expr_prio['~' & 0xFF] = 4; - expr_prio['<' & 0xFF] = 4; - expr_prio['>' & 0xFF] = 4; - expr_prio['[' & 0xFF] = 4; - expr_prio[']' & 0xFF] = 4; - expr_prio['!' & 0xFF] = 5; - expr_prio['&' & 0xFF] = 6; - expr_prio['|' & 0xFF] = 7; - expr_prio[')' & 0xFF] = 8; - expr_prio['(' & 0xFF] = 9; - expr_prio[0] = 10; -} -#endif - -/* - * Emit any MOVEs from non-simple field to temp field - * for GENERATE to execute - */ -static int report_in_footing = 0; -static void -cb_emit_report_moves (struct cb_report *r, struct cb_field *f, int forterminate) -{ - struct cb_field *p; - for (p = f; p; p = p->sister) { - if(p->report_flag & (COB_REPORT_FOOTING|COB_REPORT_CONTROL_FOOTING|COB_REPORT_CONTROL_FOOTING_FINAL)) { - report_in_footing = 1; - } - if(p->report_from) { - if(forterminate - && report_in_footing) { - cb_emit_move (p->report_from, CB_LIST_INIT (p->report_source)); - } else - if(!forterminate - && !report_in_footing) { - cb_emit_move (p->report_from, CB_LIST_INIT (p->report_source)); - } - } - if(p->report_when) { - int ifwhen = 2; - if(p->children) - ifwhen = 3; - if(forterminate - && report_in_footing) { - cb_emit (cb_build_if (p->report_when, NULL, (cb_tree)p, ifwhen)); - } else - if(!forterminate - && !report_in_footing) { - cb_emit (cb_build_if (p->report_when, NULL, (cb_tree)p, ifwhen)); - } - } - if(p->children) { - cb_emit_report_moves(r, p->children, forterminate); - if(p->report_flag & (COB_REPORT_FOOTING|COB_REPORT_CONTROL_FOOTING|COB_REPORT_CONTROL_FOOTING_FINAL)) { - report_in_footing = 0; - } - } - } -} - -static void -cb_emit_report_move_id (cb_tree rep) -{ - struct cb_report *r = CB_REPORT_PTR (rep); - if (r - && r->id == 0) { - r->id = report_id++; - cb_emit (CB_BUILD_FUNCALL_1 ("$M", rep)); - cb_emit_report_moves(r, r->records, 0); - cb_emit (CB_BUILD_FUNCALL_1 ("$t", rep)); - cb_emit_report_moves(r, r->records, 1); - cb_emit (CB_BUILD_FUNCALL_1 ("$m", rep)); - } -} - -/* INITIATE statement */ - -void -cb_emit_initiate (cb_tree rep) -{ - if (rep == cb_error_node) { - return; - } - cb_emit_report_move_id (rep); - cb_emit (CB_BUILD_FUNCALL_1 ("$I", rep)); - -} - -/* TERMINATE statement */ - -void -cb_emit_terminate (cb_tree rep) -{ - if (rep == cb_error_node) { - return; - } - cb_emit_report_move_id (rep); - cb_emit (CB_BUILD_FUNCALL_1 ("$T", rep)); - -} - -/* GENERATE statement */ - -void -cb_emit_generate (cb_tree x) -{ - struct cb_field *f; - struct cb_report *r; - cb_tree y; - cb_tree z; - if (x == cb_error_node) { - return; - } - if (CB_REFERENCE_P (x)) { - y = cb_ref (x); - if (y == cb_error_node) { - return; - } - } else { - y = x; - } - if(CB_REPORT_P (y)) { - r = CB_REPORT (y); - z = cb_build_reference (r->name); - CB_REFERENCE (z)->value = CB_TREE (y); - cb_emit_report_move_id(z); - cb_emit (CB_BUILD_FUNCALL_2 ("$R", z, NULL)); - return; - } - f = CB_FIELD (y); - if(f == NULL - || f->report == NULL) { - cb_error_x (x, _("data item is not part of a report")); - } else { - z = cb_build_reference (f->name); - CB_REFERENCE (z)->value = CB_TREE (f->report); - x->tag = CB_TAG_REPORT_LINE; - cb_emit_report_move_id(z); - cb_emit (CB_BUILD_FUNCALL_2 ("$R", z, x)); - } -} - -/* SUPPRESS statement */ - -void -cb_emit_suppress (struct cb_field *f) -{ - cb_tree z; - /* MORE TO DO HERE */ - /* Find cob_report_control and set on suppress flag */ - if(f == NULL - || f->report == NULL) { - cb_error (_("improper use of SUPPRESS PRINTING")); - return; - } - z = cb_build_reference (f->name); - CB_REFERENCE (z)->value = CB_TREE (f->report); - cb_emit (CB_BUILD_FUNCALL_2 ("$S", z, cb_int (f->id))); -} - -/* JSON/XML GENERATE statement */ - -static int -error_if_not_alnum_or_national (cb_tree ref, const char *name) -{ - if (!(CB_TREE_CATEGORY (ref) == CB_CATEGORY_ALPHANUMERIC - || CB_TREE_CATEGORY (ref) == CB_CATEGORY_NATIONAL)) { - cb_error_x (ref, _("%s must be alphanumeric or national"), name); - return 1; - } else { - return 0; - } -} - -static int -error_if_figurative_constant (cb_tree ref, const char *name) -{ - if (cb_is_figurative_constant (ref)) { - cb_error_x (ref, _("%s may not be a figurative constant"), name); - return 1; - } else { - return 0; - } -} - -static int -is_subordinate_to (cb_tree ref, cb_tree parent_ref) -{ - struct cb_field *f = CB_FIELD (cb_ref (ref))->parent; - struct cb_field *parent = CB_FIELD (cb_ref (parent_ref)); - - for (; f; f = f->parent) { - if (f == parent) { - return 1; - } - } - - return 0; -} - -static int -error_if_not_child_of_input_record (cb_tree ref, cb_tree input_record, - const char *name) -{ - if (!is_subordinate_to (ref, input_record)) { - cb_error_x (ref, _("%s must be a child of the input record"), name); - return 1; - } else { - return 0; - } -} - -static int -is_ignored_child_in_ml_gen (cb_tree ref, cb_tree parent_ref) -{ - struct cb_field *f = CB_FIELD (cb_ref (ref)); - struct cb_field *parent = CB_FIELD (cb_ref (parent_ref)); - - for (; f && f != parent; f = f->parent) { - if (cb_field_is_ignored_in_ml_gen (f)) { - return 1; - } - } - - return 0; -} - -static int -error_if_ignored_in_ml_gen (cb_tree ref, cb_tree input_record, const char *name) -{ - if (is_ignored_child_in_ml_gen (ref, input_record)) { - cb_error_x (ref, _("%s may not be an ignored item in JSON/XML GENERATE"), name); - return 1; - } else { - return 0; - } -} - -static int -error_if_not_elementary (cb_tree ref, const char *name) -{ - if (CB_FIELD (cb_ref (ref))->children) { - cb_error_x (ref, _("%s must be elementary"), name); - return 1; - } else { - return 0; - } -} - -static int -error_if_not_usage_display_or_national (cb_tree ref, const char *name) -{ - if (!(CB_FIELD (cb_ref (ref))->usage == CB_USAGE_DISPLAY - || CB_FIELD (cb_ref (ref))->usage == CB_USAGE_NATIONAL)) { - cb_error_x (ref, _("%s must be USAGE DISPLAY or NATIONAL"), name); - return 1; - } else { - return 0; - } -} - -static int -error_if_not_integer_ref (cb_tree ref, const char *name) -{ - struct cb_field *field = CB_FIELD (cb_ref (ref)); - - if (CB_TREE_CATEGORY (field) == CB_CATEGORY_NUMERIC - && field->pic && field->pic->scale > 0) { - cb_error_x (ref, _("%s must be an integer"), name); - return 1; - } else { - return 0; - } -} - -static int -syntax_check_ml_gen_receiving_item (cb_tree out) -{ - int error = 0; - - if (cb_validate_one (out)) { - return 1; - } - - error |= error_if_not_alnum_or_national (out, _("JSON/XML GENERATE receiving item")); - - if (CB_FIELD (cb_ref (out))->flag_justified) { - cb_error_x (out, _("JSON/XML GENERATE receiving item may not have JUSTIFIED clause")); - error = 1; - } - error |= error_if_subscript_or_refmod (out, _("JSON/XML GENERATE receiving item")); - - return error; -} - -static int -all_children_are_ignored (struct cb_field * const f) -{ - struct cb_field *child; - - for (child = f->children; child; child = child->sister) { - if (!cb_field_is_ignored_in_ml_gen (child) - && !(child->children - && all_children_are_ignored (child))) { - return 0; - } - } - - return 1; -} - -static int -name_is_unique_when_qualified_by (struct cb_field * const f, - struct cb_field * const qualifier) -{ - cb_tree qual_ref = cb_build_field_reference (qualifier, NULL); - cb_tree f_ref = cb_build_reference (f->name); - CB_REFERENCE (f_ref)->chain = qual_ref; - - return cb_try_ref (f_ref) != cb_error_node; -} - -static int -all_children_ok_qualified_by_only (struct cb_field * const f, - struct cb_field * const qualifier) -{ - struct cb_field *child; - - for (child = f->children; child; child = child->sister) { - if (child->flag_filler) { - continue; - } - - if (!name_is_unique_when_qualified_by (child, qualifier)) { - return 0; - } - if (child->children - && !all_children_ok_qualified_by_only (child, qualifier)) { - return 0; - } - } - - return 1; -} - - -static int -contains_floating_point_item (const struct cb_field * const f, const int check_siblings) -{ - return is_floating_point_usage (f->usage) - || (f->children && contains_floating_point_item (f->children, 1)) - || (check_siblings && f->sister - && contains_floating_point_item (f->sister, 1)); -} - -static int -contains_occurs_item (const struct cb_field * const f, const int check_siblings) -{ - return f->flag_occurs - || (f->children && contains_occurs_item (f->children, 1)) - || (check_siblings && f->sister - && contains_occurs_item (f->sister, 1)); -} - -static int -syntax_check_ml_gen_input_rec (cb_tree from) -{ - int error = 0; - struct cb_field *from_field; - - if (cb_validate_one (from)) { - return 1; - } - - if (CB_REFERENCE (from)->offset) { - cb_error_x (from, _("JSON/XML GENERATE input record may not be reference modified")); - error = 1; - } - - from_field = CB_FIELD (cb_ref (from)); - if (from_field->rename_thru) { - cb_error_x (from, _("JSON/XML GENERATE input record may not have RENAMES clause")); - error = 1; - } - - if (from_field->children && all_children_are_ignored (from_field)) { - cb_error_x (from, _("all the children of '%s' are ignored in JSON/XML GENERATE"), - cb_name (from)); - error = 1; - } - - if (!all_children_ok_qualified_by_only (from_field, from_field)) { - /* TO-DO: Output the name of the child with the nonunique name */ - cb_error_x (from, _("JSON/XML GENERATE input record has subrecords with non-unique names")); - error = 1; - } - - if (contains_floating_point_item (from_field, 0)) { - CB_PENDING (_("floating-point items in JSON/XML GENERATE")); - } - - if (contains_occurs_item (from_field, 0)) { - CB_PENDING (_("OCCURS items in JSON/XML GENERATE")); - } - - return error; -} - -static int -syntax_check_ml_gen_count_in (cb_tree count) -{ - int error = 0; - enum cb_usage usage; - int scale; - - if (!count) { - return 0; - } - - if (cb_validate_one (count)) { - return 1; - } - - usage = CB_FIELD (cb_ref (count))->usage; - /* TO-DO: Does a function exist to check if this an integer? */ - if (CB_TREE_CATEGORY (count) != CB_CATEGORY_NUMERIC - || is_floating_point_usage (usage)) { - cb_error_x (count, _("COUNT IN item must be numeric and an integer")); - error = 1; - } else if (CB_FIELD (cb_ref (count))->pic) { - scale = CB_FIELD (cb_ref (count))->pic->scale; - if (scale > 0) { - cb_error_x (count, _("COUNT IN item must be an integer")); - error = 1; - } else if (scale < 0) { - cb_error_x (count, _("COUNT IN item may not have PICTURE with P in it")); - error = 1; - } - } - - return error; -} - -static int -is_valid_uri (const struct cb_literal * const namespace) -{ - size_t size = (size_t)namespace->size; - char *copy = cob_malloc (size + 1); - int is_valid; - - memcpy (copy, namespace->data, size); - copy[size] = '\0'; - is_valid = cob_is_valid_uri (copy); - cob_free (copy); - - return is_valid; -} - - -static int -syntax_check_xml_gen_namespace (cb_tree namespace) -{ - int error = 0; - - if (!namespace) { - return 0; - } - - if (cb_validate_one (namespace)) { - return 1; - } - - error |= error_if_not_alnum_or_national (namespace, "NAMESPACE"); - - if (error_if_figurative_constant (namespace, "NAMESPACE")) { - error = 1; - } else { - if (CB_LITERAL_P (namespace) && !is_valid_uri (CB_LITERAL (namespace))) { - cb_error_x (namespace, _("NAMESPACE must be a valid URI")); - error = 1; - } - } - - return error; -} - -static int -is_valid_xml_name (const struct cb_literal * const name) -{ - unsigned int i; - - if (!cob_is_xml_namestartchar (name->data[0])) { - return 0; - } - - for (i = 1; i < name->size; ++i) { - if (!cob_is_xml_namechar (name->data[i])) { - return 0; - } - } - - return 1; -} - -static int -syntax_check_xml_gen_prefix (cb_tree prefix) -{ - int error = 0; - - if (prefix == cb_null) { - return 0; - } - - if (cb_validate_one (prefix)) { - return 1; - } - - error |= error_if_not_alnum_or_national (prefix, "NAMESPACE-PREFIX"); - - if (error_if_figurative_constant (prefix, "NAMESPACE-PREFIX")) { - error = 1; - } else if (CB_LITERAL_P (prefix) && !is_valid_xml_name (CB_LITERAL (prefix))) { - cb_error_x (prefix, _("NAMESPACE-PREFIX must be a valid XML name")); - error = 1; - } - - return error; -} - -static int -syntax_check_ml_gen_name_list (cb_tree name_list, cb_tree input) -{ - cb_tree name_pair; - cb_tree ref; - cb_tree name; - int error = 0; - cb_tree l; - - for (l = name_list; l; l = CB_CHAIN (l)) { - name_pair = CB_VALUE (l); - ref = CB_PAIR_X (name_pair); - name = CB_PAIR_Y (name_pair); - if (cb_validate_one (ref) - || cb_validate_one (name)) { - return 1; - } - - error |= error_if_subscript_or_refmod (ref, _("NAME OF item")); - - if (cb_ref (ref) != cb_ref (input) - && !is_subordinate_to (ref, input)) { - cb_error_x (ref, _("NAME OF item must be the input record or a child of it")); - error = 1; - } else { - error |= error_if_ignored_in_ml_gen (ref, input, _("NAME OF item")); - } - - if (!is_valid_xml_name (CB_LITERAL (name))) { - cb_error_x (ref, _("NAME OF name must be a valid XML name")); - error = 1; - } - } - - return error; -} - -static int -syntax_check_ml_gen_type_list (cb_tree type_list, cb_tree input) -{ - cb_tree l; - cb_tree type_pair; - cb_tree ref; - cb_tree type; - int error = 0; - - for (l = type_list; l; l = CB_CHAIN (l)) { - type_pair = CB_VALUE (l); - ref = CB_PAIR_X (type_pair); - type = CB_PAIR_Y (type_pair); - if (cb_validate_one (ref) - || cb_validate_one (type)) { - return 1; - } - - error |= error_if_subscript_or_refmod (ref, _("TYPE OF item")); - error |= error_if_not_elementary (ref, _("TYPE OF item")); - - if (error_if_not_child_of_input_record (ref, input, - _("TYPE OF item"))) { - error = 1; - } else { - error |= error_if_ignored_in_ml_gen (ref, input, - _("TYPE OF item")); - } - } - - return error; -} - -static int -syntax_check_when_list (struct cb_ml_suppress_clause *suppress) -{ - cb_tree l; - int error = 0; - const char *name; - - for (l = suppress->when_list; l; l = CB_CHAIN (l)) { - /* TO-DO: Handle DISPLAY-1 if/when it is supported. */ - if (CB_VALUE (l) == cb_space) { - error |= error_if_not_usage_display_or_national (suppress->identifier, - _("SUPPRESS WHEN SPACE item")); - } else if (CB_VALUE (l) == cb_low || CB_VALUE (l) == cb_high) { - if (CB_VALUE (l) == cb_low) { - name = _("SUPPRESS WHEN LOW-VALUE item"); - } else { - name = _("SUPPRESS WHEN HIGH-VALUE item"); - } - error |= error_if_not_usage_display_or_national (suppress->identifier, - name); - error |= error_if_not_integer_ref (suppress->identifier, name); - } - } - - return error; -} - -static int -syntax_check_ml_gen_suppress_list (cb_tree suppress_list, cb_tree input) -{ - int error = 0; - cb_tree l; - struct cb_ml_suppress_clause *suppress; - - for (l = suppress_list; l; l = CB_CHAIN (l)) { - suppress = CB_ML_SUPPRESS (CB_VALUE (l)); - if (!suppress->identifier) { - continue; - } - - if (cb_validate_one (suppress->identifier)) { - return 1; - } - - error |= error_if_subscript_or_refmod (suppress->identifier, - _("SUPPRESS item")); - - if (suppress->when_list) { - error |= error_if_not_elementary (suppress->identifier, - _("SUPPRESS item with WHEN clause")); - } - - if (error_if_not_child_of_input_record (suppress->identifier, input, - _("SUPPRESS item"))) { - error = 1; - } else { - error |= error_if_ignored_in_ml_gen (suppress->identifier, - input, _("SUPPRESS item")); - } - - error |= syntax_check_when_list (suppress); - } - - return error; -} - -static int -syntax_check_ml_generate (cb_tree out, cb_tree from, cb_tree count, - cb_tree encoding, - cb_tree namespace_and_prefix, - cb_tree name_list, cb_tree type_list, - cb_tree suppress_list) -{ - int error = 0; - - error |= syntax_check_ml_gen_receiving_item (out); - error |= syntax_check_ml_gen_input_rec (from); - error |= syntax_check_ml_gen_count_in (count); - COB_UNUSED (encoding); /* TODO: check encoding */ - if (namespace_and_prefix) { - error |= syntax_check_xml_gen_namespace (CB_PAIR_X (namespace_and_prefix)); - error |= syntax_check_xml_gen_prefix (CB_PAIR_Y (namespace_and_prefix)); - } - error |= syntax_check_ml_gen_name_list (name_list, from); - error |= syntax_check_ml_gen_type_list (type_list, from); - error |= syntax_check_ml_gen_suppress_list (suppress_list, from); - - /* TO-DO: Warn if out is probably too short */ - /* TO-DO: Warn if count_in may overflow */ - - return error; -} - -void -cb_emit_xml_generate (cb_tree out, cb_tree from, cb_tree count, - cb_tree encoding, - const int with_xml_dec, - const int with_attrs, - cb_tree namespace_and_prefix, - cb_tree name_list, cb_tree type_list, - cb_tree suppress_list) -{ - struct cb_ml_generate_tree *tree; - -#ifndef WITH_XML2 - if (!warn_xml_done) { - warn_xml_done = 1; - cb_warning (cb_warn_unsupported, - _("compiler is not configured to support %s"), "XML"); - } -#endif - if (syntax_check_ml_generate (out, from, count, encoding, - namespace_and_prefix, name_list, - type_list, suppress_list)) { - return; - } - - tree = CB_ML_TREE (cb_build_ml_tree (CB_FIELD (cb_ref (from)), - with_attrs, 0, name_list, - type_list, suppress_list)); - - tree->sibling = current_program->ml_trees; - current_program->ml_trees = tree; - - if (with_attrs && !tree->attrs) { - cb_warning (cb_warn_extra, - _("WITH ATTRIBUTES specified, but no attributes can be generated")); - } - - cb_emit (cb_build_ml_suppress_checks (tree)); - if (namespace_and_prefix) { - cb_emit (CB_BUILD_FUNCALL_6 ("cob_xml_generate", out, CB_TREE (tree), - count, cb_int (with_xml_dec), - CB_PAIR_X (namespace_and_prefix), - CB_PAIR_Y (namespace_and_prefix))); - } else { - cb_emit (CB_BUILD_FUNCALL_6 ("cob_xml_generate", out, CB_TREE (tree), - count, cb_int (with_xml_dec), - NULL, NULL)); - } -} - -void -cb_emit_json_generate (cb_tree out, cb_tree from, cb_tree count, - cb_tree name_list, cb_tree suppress_list) -{ - struct cb_ml_generate_tree *tree; - -#ifndef WITH_CJSON - if (!warn_json_done) { - warn_json_done = 1; - cb_warning (cb_warn_unsupported, - _("compiler is not configured to support %s"), "JSON"); - } -#endif - if (syntax_check_ml_generate (out, from, count, NULL, - NULL, name_list, NULL, - suppress_list)) { - return; - } - - tree = CB_ML_TREE (cb_build_ml_tree (CB_FIELD (cb_ref (from)), - 0, 0, name_list, - NULL, suppress_list)); - - tree->sibling = current_program->ml_trees; - current_program->ml_trees = tree; - - cb_emit (cb_build_ml_suppress_checks (tree)); - cb_emit (CB_BUILD_FUNCALL_3 ("cob_json_generate", out, CB_TREE (tree), count)); -} diff -Nru gnucobol-4.0~early~20200606/cobc/warning.def gnucobol-5/cobc/warning.def --- gnucobol-4.0~early~20200606/cobc/warning.def 2020-06-06 20:51:59.000000000 +0000 +++ gnucobol-5/cobc/warning.def 1970-01-01 00:00:00.000000000 +0000 @@ -1,109 +0,0 @@ -/* - Copyright (C) 2003-2012, 2016-2018, 2020 Free Software Foundation, Inc. - Written by Keisuke Nishida, Roger While, Simon Sobisch - - This file is part of GnuCOBOL. - - The GnuCOBOL compiler is free software: you can redistribute it - and/or modify it under the terms of the GNU General Public License - as published by the Free Software Foundation, either version 3 of the - License, or (at your option) any later version. - - GnuCOBOL is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with GnuCOBOL. If not, see . -*/ - - -/* CB_WARNDEF (var, name, doc) */ - -/* Always active, start doc with do not warn... */ -/* CB_ONWARNDEF (var, name, doc) */ - -/* Do not include warning with -Wall */ -/* CB_NOWARNDEF (var, name, doc) */ - -/* Always active, defaults to an ERROR but could be downgraded to warning */ -/* CB_ERRWARNDEF (var, name, doc) */ - -CB_WARNDEF (cb_warn_extra, "extra", - _(" -Wextra additional warnings only raised with -W or -Wall")) - -CB_ONWARNDEF (cb_warn_unfinished, "unfinished", - _(" -Wno-unfinished do not warn if unfinished features are used")) - -CB_ONWARNDEF (cb_warn_pending, "pending", - _(" -Wno-pending do not warn if pending features are mentioned")) - -CB_WARNDEF (cb_warn_obsolete, "obsolete", - _(" -Wobsolete warn if obsolete features are used")) - -CB_WARNDEF (cb_warn_archaic, "archaic", - _(" -Warchaic warn if archaic features are used")) - -CB_WARNDEF (cb_warn_redefinition, "redefinition", - _(" -Wredefinition warn about incompatible redefinition of data items")) - -CB_WARNDEF (cb_warn_truncate, "truncate", - _(" -Wtruncate warn about field truncation from constant assignments")) - -CB_NOWARNDEF (cb_warn_pos_truncate, "possible-truncate", - _(" -Wpossible-truncate warn about possible field truncation")) - -CB_WARNDEF (cb_warn_overlap, "overlap", - _(" -Woverlap warn about overlapping MOVE of items")) - -CB_NOWARNDEF (cb_warn_pos_overlap, "possible-overlap", - _(" -Wpossible-overlap warn about MOVE of items that may overlap depending on variables")) - -CB_WARNDEF (cb_warn_parentheses, "parentheses", - _(" -Wparentheses warn about lack of parentheses around AND within OR")) - -CB_WARNDEF (cb_warn_strict_typing, "strict-typing", - _(" -Wstrict-typing warn strictly about type mismatch")) - -CB_WARNDEF (cb_warn_implicit_define, "implicit-define", - _(" -Wimplicit-define warn about implicitly defined data items")) - -CB_WARNDEF (cb_warn_corresponding, "corresponding", - _(" -Wcorresponding warn about CORRESPONDING with no matching items")) - -CB_WARNDEF (cb_warn_ignored_initial_val, "initial-value", - _(" -Winitial-value warn if initial VALUE clause is ignored")) - -CB_WARNDEF (cb_warn_prototypes, "prototypes", - _(" -Wprototypes warn about missing FUNCTION prototypes/definitions")) - -CB_WARNDEF (cb_warn_arithmetic_osvs, "arithmetic-osvs", - _(" -Warithmetic-osvs warn if arithmetic expression precision has changed")) - -CB_NOWARNDEF (cb_warn_call_params, "call-params", - _(" -Wcall-params warn about non 01/77 items for CALL parameters")) - -CB_WARNDEF (cb_warn_constant_expr, "constant-expression", - _(" -Wconstant-expression warn about expressions that always resolve to true/false")) - -CB_NOWARNDEF (cb_warn_column_overflow, "column-overflow", - _(" -Wcolumn-overflow warn about text after program-text area, FIXED format")) - -CB_NOWARNDEF (cb_warn_terminator, "terminator", - _(" -Wterminator warn about lack of scope terminator END-XXX")) - -CB_NOWARNDEF (cb_warn_linkage, "linkage", - _(" -Wlinkage warn about dangling LINKAGE items")) - -CB_NOWARNDEF (cb_warn_unreachable, "unreachable", - _(" -Wunreachable warn about likely unreachable statements")) - -CB_ONWARNDEF (cb_warn_dialect, "dialect", - _(" -Wno-dialect do not warn about dialect specific issues")) - -CB_ONWARNDEF (cb_warn_filler, "others", - _(" -Wothers do not warn about different issues")) - -CB_ERRWARNDEF (cb_warn_unsupported, "unsupported", - _(" -Wno-unsupported do not warn if runtime does not support a feature used")) diff -Nru gnucobol-4.0~early~20200606/config/acu.conf gnucobol-5/config/acu.conf --- gnucobol-4.0~early~20200606/config/acu.conf 2020-06-06 20:52:02.000000000 +0000 +++ gnucobol-5/config/acu.conf 1970-01-01 00:00:00.000000000 +0000 @@ -1,34 +0,0 @@ -# GnuCOBOL compiler configuration -# -# Copyright (C) 2001-2012, 2014-2017 Free Software Foundation, Inc. -# Written by Keisuke Nishida, Roger While, Simon Sobisch, Edward Hart -# -# This file is part of GnuCOBOL. -# -# The GnuCOBOL compiler is free software: you can redistribute it -# and/or modify it under the terms of the GNU General Public License -# as published by the Free Software Foundation, either version 3 of the -# License, or (at your option) any later version. -# -# GnuCOBOL is distributed in the hope that it will be useful, -# but WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -# GNU General Public License for more details. -# -# You should have received a copy of the GNU General Public License -# along with GnuCOBOL. If not, see . - - -include "acu-strict.conf" - -# Value: any string -name: "ACUCOBOL-GT (lax)" - -# reserve additional words, synonyms and exceptions from normal word list -include: "acu.words" - -# not-reserved: -# Value: Word to be taken out of the reserved words list -# -fill upon request- - -include "lax.conf-inc" diff -Nru gnucobol-4.0~early~20200606/config/acu-strict.conf gnucobol-5/config/acu-strict.conf --- gnucobol-4.0~early~20200606/config/acu-strict.conf 2020-06-06 20:52:02.000000000 +0000 +++ gnucobol-5/config/acu-strict.conf 1970-01-01 00:00:00.000000000 +0000 @@ -1,262 +0,0 @@ -# GnuCOBOL compiler configuration -# -# Copyright (C) 2001-2012, 2014-2020 Free Software Foundation, Inc. -# Written by Keisuke Nishida, Roger While, Simon Sobisch, Edward Hart, -# Ron Norman -# -# This file is part of GnuCOBOL. -# -# The GnuCOBOL compiler is free software: you can redistribute it -# and/or modify it under the terms of the GNU General Public License -# as published by the Free Software Foundation, either version 3 of the -# License, or (at your option) any later version. -# -# GnuCOBOL is distributed in the hope that it will be useful, -# but WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -# GNU General Public License for more details. -# -# You should have received a copy of the GNU General Public License -# along with GnuCOBOL. If not, see . - - -# Value: any string -name: "ACUCOBOL-GT" - -# Value: enum -standard-define 5 -# CB_STD_OC = 0, -# CB_STD_MF, -# CB_STD_IBM, -# CB_STD_MVS, -# CB_STD_BS2000, -# CB_STD_ACU, -# CB_STD_85, -# CB_STD_2002, -# CB_STD_2014 - -# Value: int -tab-width: 8 -text-column: 72 -word-length: 60 -literal-length: 4096 -numeric-literal-length: 31 # default in ACUCOBOL is 18 with the possibility to switch to 31 -pic-length: 100 -occurs-max-length-without-subscript: yes - -# Default assign type -# Value: 'dynamic', 'external' -assign-clause: dynamic - -# If yes, file names are resolved at run time using -# environment variables. -# For example, given ASSIGN TO "DATAFILE", the file name will be -# 1. the value of environment variable 'DD_DATAFILE' or -# 2. the value of environment variable 'dd_DATAFILE' or -# 3. the value of environment variable 'DATAFILE' or -# 4. the literal "DATAFILE" -# If no, the value of the assign clause is the file name. -# -filename-mapping: yes - -# Alternate formatting of numeric fields -pretty-display: yes - -# Allow complex OCCURS DEPENDING ON -complex-odo: no - -# Allow REDEFINES to other than last equal level number -indirect-redefines: no # not verified yet - -# Binary byte size - defines the allocated bytes according to PIC -# Value: signed unsigned bytes -# ------ -------- ----- -# '2-4-8' 1 - 4 same 2 -# 5 - 9 same 4 -# 10 - 18 same 8 -# -# '1-2-4-8' 1 - 2 same 1 -# 3 - 4 same 2 -# 5 - 9 same 4 -# 10 - 18 same 8 -# -# '1--8' 1 - 2 1 - 2 1 -# 3 - 4 3 - 4 2 -# 5 - 6 5 - 7 3 -# 7 - 9 8 - 9 4 -# 10 - 11 10 - 12 5 -# 12 - 14 13 - 14 6 -# 15 - 16 15 - 16 7 -# 17 - 18 17 - 18 8 -# -binary-size: 1-2-4-8 # not verified yet - -# Numeric truncation according to ANSI -binary-truncate: yes - -# Binary byte order -# Value: 'native', 'big-endian' -binary-byteorder: big-endian - -# Allow larger REDEFINES items -larger-redefines-ok: no # not verified yet - -# Allow certain syntax variations (eg. REDEFINES position) -relax-syntax-checks: yes - -# Perform type OSVS - If yes, the exit point of any currently -# executing perform is recognized if reached. -perform-osvs: no - -# Compute intermediate decimal results like IBM OSVS -arithmetic-osvs: no - -# MOVE like IBM (mvc); left to right, byte by byte -move-ibm: no - -# If yes, linkage-section items remain allocated -# between invocations. -sticky-linkage: no - -# If yes, allow non-matching level numbers -relax-level-hierarchy: no # not verified yet - -# If yes, evaluate constant expressions at compile time -constant-folding: no - -# Allow Hex 'F' for NUMERIC test of signed PACKED DECIMAL field -hostsign: no # not verified yet - -# If yes, set WITH UPDATE clause as default for ACCEPT dest-item, -# except if WITH NO UPDATE clause is used -accept-update: no # not verified yet - -# If yes, set WITH AUTO clause as default for ACCEPT dest-item, -# except if WITH TAB clause is used -accept-auto: no # not verified yet - -# If yes, DISPLAYs and ACCEPTs are, by default, done on the CRT (i.e., using -# curses). -console-is-crt: yes - -# If yes, allow redefinition of the current program's name. This prevents its -# use in a prototype-format CALL/CANCEL statement. -program-name-redefinition: yes - -# If yes, NO ECHO/NO-ECHO/OFF is the same as SECURE (hiding input with -# asterisks, not spaces). -no-echo-means-secure: yes - -# If yes, the first item in a field screen ACCEPT/DISPLAY (e.g. DISPLAY x UPON -# CRT) is located after the previous ACCEPT/DISPLAY (as though LINE 0 COL 0 had -# been specified). -line-col-zero-default: yes - -# If yes, then REPORT, COLUMN may have any of PLUS num, + num, or +num -# to define a relative column position -report-column-plus: no - -# If yes, DISPLAY SPACES acts as ERASE EOS, DISPLAY X"01" acts as ERASE EOL, -# DISPLAY X"02" acts as BLANK SCREEEN and DISPLAY X"07" acts as BELL. Note -# DISPLAY LOW-VALUE is excluded from this; it will always just position the -# cursor. -display-special-fig-consts: no - -# If yes, COMP-1 is a signed 16-bit integer and any PICTURE clause is ignored. -binary-comp-1: yes - -# auto-adjust to zero like MicroFocus does -# note: ACUCOBOL is even more special here as it is padding alphanumeric -# fields/literals with zero which we don't support -# move SPACE to NNN -> ' ' -# move ' ' to NNN -> '00 ' -move-non-numeric-lit-to-numeric-is-zero: no - -# If yes, implicitly define a variable for an ASSIGN DYNAMIC which does not -# match an existing data item. -implicit-assign-dynamic-var: yes - -# What rules to apply to SCREEN SECTION items clauses -screen-section-rules: acu - -# Dialect features -# Value: 'ok', 'warning', 'archaic', 'obsolete', 'skip', 'ignore', 'error', -# 'unconformable' - -alter-statement: obsolete -comment-paragraphs: obsolete # not verified yet -call-overflow: ok -data-records-clause: obsolete # not verified yet -debugging-mode: ok -use-for-debugging: unconformable -listing-statements: skip # only available in IBM mode -title-statement: skip # not available but a reserved word in acu -entry-statement: ok -goto-statement-without-name: obsolete # not verified yet -label-records-clause: obsolete # not verified yet -memory-size-clause: obsolete # not verified yet -move-noninteger-to-alphanumeric: error # not verified yet -move-figurative-constant-to-numeric: ok -move-figurative-space-to-numeric: ok -move-figurative-quote-to-numeric: ok -multiple-file-tape-clause: obsolete # not verified yet -next-sentence-phrase: ok -odo-without-to: ok # not verified yet -padding-character-clause: obsolete # not verified yet -section-segments: ignore # not verified yet -stop-literal-statement: obsolete # not verified yet -stop-identifier-statement: unconformable -same-as-clause: unconformable -synchronized-clause: ok -sync-left-right: skip -special-names-clause: ok -top-level-occurs-clause: ok -value-of-clause: obsolete # not verified yet -numeric-boolean: unconformable -hexadecimal-boolean: unconformable -national-literals: unconformable -hexadecimal-national-literals: unconformable -national-character-literals: unconformable -# TO-DO: Add separate config option for H"..." to be unsupported,numeric,non-numeric(acu) -acu-literals: ok -hp-octal-literals: unconformable -word-continuation: ok -not-exception-before-exception: unconformable -length-in-data-division: no -depending-on-not-fixed: warning -accept-display-extensions: ok -renames-uncommon-levels: unconformable -symbolic-constant: unconformable -constant-78: ok -constant-01: unconformable -perform-varying-without-by: unconformable -program-prototypes: unconformable -numeric-value-for-edited-item: error # not verified yet -reference-out-of-declaratives: ok -# Is reference modification required to be within the single field -reference-bounds-check: error -call-convention-mnemonic: unconformable -call-convention-linkage: unconformable -incorrect-conf-sec-order: error -define-constant-directive: unconformable -free-redefines-position: unconformable -records-mismatch-record-clause: error # not verified yet -record-delimiter: ignore -sequential-delimiters: unconformable -record-delim-with-fixed-recs: ok -missing-statement: warning -zero-length-literals: unconformable # not verified yet -xml-generate-extra-phrases: unconformable -continue-after: unconformable -goto-entry: unconformable -binary-sync-clause: ignore -nonnumeric-with-numeric-group-usage: error -assign-variable: unconformable -assign-using-variable: unconformable -assign-ext-dyn: ok -assign-disk-from: unconformable -align-record: 4 -align-opt: no - -# use fixed word list, synonyms and exceptions specified there -reserved-words: ACU diff -Nru gnucobol-4.0~early~20200606/config/acu.words gnucobol-5/config/acu.words --- gnucobol-4.0~early~20200606/config/acu.words 2020-06-06 20:52:02.000000000 +0000 +++ gnucobol-5/config/acu.words 1970-01-01 00:00:00.000000000 +0000 @@ -1,953 +0,0 @@ -# GnuCOBOL compiler - list of reserved words -# -# Copyright (C) 2016-2017 Free Software Foundation, Inc. -# Written by Simon Sobisch, Edward Hart -# -# This file is part of GnuCOBOL. -# -# The GnuCOBOL compiler is free software: you can redistribute it -# and/or modify it under the terms of the GNU General Public License -# as published by the Free Software Foundation, either version 3 of the -# License, or (at your option) any later version. -# -# GnuCOBOL is distributed in the hope that it will be useful, -# but WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -# GNU General Public License for more details. -# -# You should have received a copy of the GNU General Public License -# along with GnuCOBOL. If not, see . - - -# Word list for dialect: ACUCOBOL-GT - -# Note: only used for strict dialect and when -# requested by compiler directive >> IMP WORDS ACU -# the default reserved word list will not be used. - -# Value: Word to make up reserved words list (case independent) -# All reserved entries listed will replace entire default reserved words list. -# Words ending with * will be treated as context-sensitive words. This will be -# ignored if GnuCOBOL uses that word as a reserved word. -# Entries of the form word-1=word-2 define word-1 as an alias for default -# reserved word word-2. No spaces are allowed around the equal sign. -reserved: 3-D* -reserved: ACCEPT -reserved: ACCESS -reserved: ACTION* -reserved: ACTIVE-CLASS* -reserved: ACTIVE-X* -reserved: ADD -reserved: ADDRESS -reserved: ADJUSTABLE-COLUMNS* -reserved: ADVANCING -reserved: AFTER -reserved: ALIGNMENT* -reserved: ALL -reserved: ALLOWING -reserved: ALPHABET -reserved: ALPHABETIC -reserved: ALPHABETIC-LOWER -reserved: ALPHABETIC-UPPER -reserved: ALPHANUMERIC-EDITED -reserved: ALPHANUMERIC -reserved: ALSO -reserved: ALTER -reserved: ALTERNATE -reserved: AND -reserved: ANY -reserved: APPLY -reserved: ARE -reserved: AREA -reserved: AREAS -reserved: ASCENDING -reserved: ASSEMBLY-NAME -reserved: ASSIGN -reserved: AS* -reserved: AT -reserved: ATTRIBUTE -reserved: AUTHOR -reserved: AUTO -reserved: AUTO-DECIMAL* -reserved: AUTO-MINIMIZE -reserved: AUTO-RESIZE -reserved: AUTO-SKIP=AUTO -reserved: AUTO-SPIN* -reserved: AUTOMATIC -reserved: AUTOTERMINATE=AUTO -reserved: AX-EVENT-LIST* -reserved: BACKGROUND-COLOR -reserved: BACKGROUND-COLOUR=BACKGROUND-COLOR -reserved: BACKGROUND-HIGH -reserved: BACKGROUND-LOW -reserved: BACKGROUND-STANDARD -reserved: BACKWARD -reserved: BAR* -reserved: BEEP=BELL -reserved: BEFORE -reserved: BELL -reserved: BINARY -reserved: BIND -reserved: BLANK -reserved: BITMAP* -reserved: BITMAP-END* -reserved: BITMAP-HANDLE* -reserved: BITMAP-NUMBER* -reserved: BITMAP-RAW-HEIGHT* -reserved: BITMAP-RAW-WIDTH* -reserved: BITMAP-SCALE* -reserved: BITMAP-START* -reserved: BITMAP-TIMER* -reserved: BITMAP-TRAILING* -reserved: BITMAP-WIDTH* -reserved: BLINK -reserved: BLINKING=BLINK -reserved: BLOCK -reserved: BOLD=HIGHLIGHT -reserved: BOTTOM -reserved: BOX -reserved: BOXED -reserved: BULK-ADDITION -reserved: BUSY* -reserved: BUTTONS* -reserved: BY -reserved: CALL -reserved: CALENDAR-FONT* -reserved: CANCEL -reserved: CANCEL-BUTTON* -reserved: CASSETTE* -reserved: CARD-PUNCH* -reserved: CARD-READER* -reserved: CCOL -reserved: CELL -reserved: CELL-COLOR* -reserved: CELL-DATA* -reserved: CELL-FONT* -reserved: CELL-PROTECTION* -reserved: CELLS=CELL -reserved: CENTER* -reserved: CENTERED -reserved: CENTERED-HEADINGS* -reserved: CENTURY-DATE -reserved: CENTURY-DAY -reserved: CHAIN -reserved: CHAINING -reserved: CHARACTER -reserved: CHARACTERS -reserved: CHART -reserved: CHECK-BOX* -reserved: CLASS-NAME -reserved: CLASS -reserved: CLEAR-SELECTION* -reserved: CLINE -reserved: CLINES -reserved: CLOSE -reserved: CODE-SET -reserved: COL -reserved: COLLATING -reserved: COLOR -reserved: COLORS* -reserved: COLOUR=COLOR -reserved: COLOURS*=COLORS -reserved: COLUMN -reserved: COLUMN-COLOR* -reserved: COLUMN-DIVIDERS* -reserved: COLUMN-FONT* -reserved: COLUMN-HEADINGS* -reserved: COLUMN-PROTECTION* -reserved: COM-REG # Note: ACUCOBOL explicitly does not support this register. -reserved: COMBO-BOX* -reserved: COMMA -reserved: COMMAND-LINE -reserved: COMMIT -reserved: COMP -reserved: COMP-1 -reserved: COMP-2 -reserved: COMP-3 -reserved: COMP-4 -reserved: COMP-5 -reserved: COMP-6 -reserved: COMP-N -reserved: COMP-X -reserved: COMPRESSION -reserved: COMPUTATIONAL -reserved: COMPUTATIONAL-1 -reserved: COMPUTATIONAL-2 -reserved: COMPUTATIONAL-3 -reserved: COMPUTATIONAL-4 -reserved: COMPUTATIONAL-5 -reserved: COMPUTATIONAL-6 -reserved: COMPUTATIONAL-N -reserved: COMPUTATIONAL-X -reserved: COMPUTE -reserved: CONFIGURATION -# reserved: CONSOLE* --> mnemonic device should not be in reserved list -reserved: CONSTRUCTOR -reserved: CONTAINS -reserved: CONTENT -reserved: CONTINUE -reserved: CONTROL -reserved: CONTROLS -reserved: CONTROLS-UNCROPPED* -reserved: CONVERSION -reserved: CONVERT=CONVERSION -reserved: CONVERTING -reserved: COPY -reserved: COPY-SELECTION* -reserved: CORR -reserved: CORRESPONDING -reserved: COUNT -reserved: CREATE -reserved: CRT -reserved: CSIZE -reserved: CULTURE -reserved: CURRENCY -reserved: CURSOR -reserved: CURSOR-COL* -reserved: CURSOR-COLOR* -reserved: CURSOR-FRAME-WIDTH* -reserved: CURSOR-ROW* -reserved: CURSOR-X* -reserved: CURSOR-Y* -reserved: CUSTOM-PRINT-TEMPLATE* -reserved: CYCLE -reserved: DASHED* -reserved: DATA -reserved: DATA-COLUMNS* -reserved: DATA-TYPES* -reserved: DATE -reserved: DATE-COMPILED -reserved: DATE-ENTRY* -reserved: DATE-WRITTEN -reserved: DAY -reserved: DAY-OF-WEEK -reserved: DEBUGGING -reserved: DECIMAL-POINT -reserved: DECLARATIVES -reserved: DEFAULT -reserved: DEFAULT-BUTTON* -reserved: DEFAULT-FONT* -reserved: DELETE -reserved: DELIMITED -reserved: DELIMITER -reserved: DEPENDING -reserved: DESCENDING -reserved: DESCRIPTOR -reserved: DESTINATION -reserved: DESTROY -reserved: DISC* -reserved: DISK* -reserved: DISPLAY -reserved: DISPLAY-COLUMNS* -reserved: DISPLAY-FORMAT* -reserved: DIVIDE -reserved: DIVIDER-COLOR* -reserved: DIVIDERS* -reserved: DIVISION -reserved: DOT-DASH* -reserved: DOTTED* -reserved: DOUBLE -reserved: DOWN -reserved: DRAG-COLOR* -reserved: DRAW -reserved: DROP-DOWN* -reserved: DROP-LIST* -reserved: DUPLICATES -reserved: DYNAMIC -reserved: ECHO -reserved: ELSE -reserved: EMPTY-CHECK=REQUIRED -reserved: ENABLED -reserved: ENCRYPTION -reserved: END -reserved: END-ACCEPT -reserved: END-ADD -reserved: END-CALL -reserved: END-CHAIN -reserved: END-COLOR* -reserved: END-COMPUTE -reserved: END-DELETE -reserved: END-DISPLAY -reserved: END-DIVIDE -reserved: END-EVALUATE -reserved: END-IF -reserved: END-MODIFY -reserved: END-MOVE -reserved: END-MULTIPLY -reserved: END-OF-PAGE -reserved: END-PERFORM -reserved: END-READ -reserved: END-RECEIVE -reserved: END-RETURN -reserved: END-REWRITE -reserved: END-SEARCH -reserved: END-START -reserved: END-STRING -reserved: END-SUBTRACT -reserved: END-UNSTRING -reserved: END-USE -reserved: END-WAIT -reserved: END-WRITE -reserved: ENDING -reserved: ENGRAVED* -reserved: ENSURE-VISIBLE* -reserved: ENTER -reserved: ENTRY -reserved: ENTRY-FIELD* -reserved: ENTRY-REASON* -reserved: ENVIRONMENT -reserved: ENVIRONMENT-NAME # note: this is a register, move as soon as supported -reserved: EOL -reserved: EOP -reserved: EOS -reserved: EQUAL -reserved: ERASE -reserved: ERROR -reserved: ESCAPE -reserved: ESCAPE-BUTTON* -reserved: EVALUATE -reserved: EVENT -reserved: EVENT-LIST* -reserved: EXCEPTION -reserved: EXCEPTION-VALUE* -reserved: EXCLUSIVE -reserved: EXIT -reserved: EXCLUDE-EVENT-LIST* -reserved: EXPAND* -reserved: EXTEND -reserved: EXTENDED-SEARCH -reserved: EXTERNAL-FORM -reserved: EXTERNAL -reserved: FALSE -reserved: FD -reserved: FILE -reserved: FILE-CONTROL -reserved: FILE-ID -reserved: FILE-LIMIT -reserved: FILE-LIMITS -reserved: FILE-NAME* -reserved: FILE-PATH -reserved: FILE-PREFIX # note: this is a register, move as soon as supported -reserved: FILE-POS* -reserved: FILL-COLOR* -reserved: FILL-COLOR2* -reserved: FILL-PERCENT* -reserved: FILLER -reserved: FINISH-REASON* -reserved: FIRST -reserved: FIXED-FONT* -reserved: FIXED-WIDTH* -reserved: FLAT* -reserved: FLAT-BUTTONS* -reserved: FLOAT -reserved: FLOATING -reserved: FONT -reserved: FOOTING -reserved: FOR -reserved: FOREGROUND-COLOR -reserved: FOREGROUND-COLOUR=FOREGROUND-COLOR -reserved: FRAME* -reserved: FRAMED* -reserved: FROM -reserved: FULL -reserved: FULL-HEIGHT* -reserved: FUNCTION -reserved: GIVING -reserved: GLOBAL -reserved: GO -reserved: GO-BACK* -reserved: GO-FORWARD* -reserved: GO-HOME* -reserved: GO-SEARCH* -reserved: GOBACK -reserved: GRAPHICAL -reserved: GREATER -reserved: GRID -reserved: GRIP* -reserved: GROUP-VALUE* -reserved: HANDLE -reserved: HAS-CHILDREN* -reserved: HEADING-COLOR* -reserved: HEADING-DIVIDER-COLOR* -reserved: HEADING-FONT* -reserved: HEAVY* -reserved: HEIGHT -reserved: HEIGHT-IN-CELLS* -reserved: HELP-ID -reserved: HIDDEN-DATA* -reserved: HIGH-COLOR* -reserved: HIGH=HIGHLIGHT -reserved: HIGH-VALUE -reserved: HIGH-VALUES=HIGH-VALUE -reserved: HIGHLIGHT -reserved: HORIZONTAL* -reserved: HOT-TRACK* -reserved: HSCROLL* -reserved: HSCROLL-POS* -reserved: I-O -reserved: I-O-CONTROL -reserved: ICON -reserved: ID -reserved: IDENTIFICATION -reserved: IDENTIFIED -reserved: IF -reserved: IN -reserved: INDEPENDENT -reserved: INDEX -reserved: INDEXED -reserved: INITIAL -reserved: INITIALIZE -reserved: INITIATE -reserved: INPUT -reserved: INPUT-OUTPUT -reserved: INQUIRE -reserved: INSERT-ROWS* -reserved: INSERTION-INDEX* -reserved: INSPECT -reserved: INSTALLATION -reserved: INTO -reserved: INVALID -reserved: IS -reserved: ITEM* -reserved: ITEM-BOLD* -reserved: ITEM-ID* -reserved: ITEM-TEXT* -reserved: ITEM-TO-ADD* -reserved: ITEM-TO-DELETE* -reserved: ITEM-TO-EMPTY* -reserved: ITEM-VALUE* -reserved: JUST -reserved: JUSTIFIED -reserved: KEPT -reserved: KEY -reserved: KEYBOARD* -reserved: LABEL -reserved: LABEL-OFFSET* -reserved: LARGE-FONT* -reserved: LAST -reserved: LAST-ROW* -reserved: LAYOUT-DATA -reserved: LAYOUT-MANAGER -reserved: LEADING -reserved: LEADING-SHIFT* -reserved: LEFT -reserved: LEFT-TEXT* -reserved: LEFTLINE -reserved: LENGTH -reserved: LENGTH-CHECK=FULL -reserved: LESS -reserved: LINAGE -reserved: LINAGE-COUNTER -reserved: LINE -reserved: LINE-SEQUENTIAL* # implementor RECORD DELIMITER word -reserved: LINES -reserved: LINES-AT-ROOT* -reserved: LINK -reserved: LINKAGE -reserved: LIST-BOX* -reserved: LM-RESIZE* -reserved: LONG-DATE* -reserved: LOCK -reserved: LOCK-HOLDING -reserved: LOW-VALUE -reserved: LOW-VALUES=LOW-VALUE -reserved: LOW=LOWLIGHT -reserved: LOW-COLOR* -reserved: LOWER -reserved: LOWERED* -reserved: LOWLIGHT -reserved: MAGNETIC-TAPE* -reserved: MANUAL -reserved: MASS-UPDATE -reserved: MAX-HEIGHT* -reserved: MAX-LINES* -reserved: MAX-PROGRESS* -reserved: MAX-SIZE* -reserved: MAX-TEXT* -reserved: MAX-VAL* -reserved: MAX-WIDTH* -reserved: MDI-CHILD* -reserved: MDI-FRAME* -reserved: MEDIUM-FONT* -reserved: MEMORY -reserved: MENU -reserved: MERGE -reserved: MESSAGE -reserved: MESSAGES -reserved: MIN-HEIGHT* -reserved: MIN-LINES* -reserved: MIN-SIZE* -reserved: MIN-VAL* -reserved: MIN-WIDTH* -reserved: MODAL -reserved: MODE -reserved: MODELESS -reserved: MODIFY -reserved: MODULE -reserved: MODULES -reserved: MOVE -reserved: MULTILINE* -reserved: MULTIPLE -reserved: MULTIPLY -reserved: NAMESPACE -reserved: NATIONAL -reserved: NATIONAL-EDITED -reserved: NATIVE -reserved: NAVIGATE-URL* -reserved: NEGATIVE -reserved: NET-EVENT-LIST* -reserved: NEXT -reserved: NEXT-ITEM* -reserved: NO -reserved: NO-AUTO-DEFAULT* -reserved: NO-AUTOSEL* -reserved: NO-BOX* -reserved: NO-CELL-DRAG* -reserved: NO-CLOSE* -reserved: NO-DIVIDERS* -reserved: NO-ECHO -reserved: NO-F4* -reserved: NO-FOCUS* -reserved: NO-GROUP-TAB* -reserved: NO-KEY-LETTER* -reserved: NO-SEARCH* -reserved: NO-TAB* -reserved: NO-UPDOWN* -reserved: NOT -reserved: NOTIFY* -reserved: NOTIFY-CHANGE* -reserved: NOTIFY-DBLCLICK* -reserved: NOTIFY-SELCHANGE* -reserved: NULL -reserved: NULLS=NULL -reserved: NUM-COL-HEADINGS* -reserved: NUM-ROW-HEADINGS* -reserved: NUM-ROWS* -reserved: NUMBER -reserved: NUMERIC -reserved: NUMERIC-EDITED -reserved: NUMERIC-FILL -reserved: OBJECT-COMPUTER -reserved: OBJECT -reserved: OCCURS -reserved: OF -reserved: OFF -reserved: OK-BUTTON* -reserved: OMITTED -reserved: ON -reserved: ONLY -reserved: OPEN -reserved: OPTIONAL -reserved: OR -reserved: ORDER -reserved: ORGANIZATION -reserved: OTHER -reserved: OTHERS -reserved: OUTPUT -reserved: OVERFLOW -reserved: OVERLAP-LEFT* -reserved: OVERLAP-TOP* -reserved: OVERLAPPED -reserved: OVERLINE -reserved: PACKED-DECIMAL -reserved: PADDING -reserved: PAGE -reserved: PAGE-SETUP* -reserved: PAGE-SIZE* -reserved: PAGED* -reserved: PANEL-INDEX* -reserved: PANEL-STYLE* -reserved: PANEL-TEXT* -reserved: PANEL-WIDTHS* -reserved: PARAGRAPH -reserved: PARENT* -reserved: PERFORM -reserved: PERMANENT* -reserved: PIC=PICTURE -reserved: PICTURE -reserved: PIXEL -reserved: PIXELS=PIXEL -reserved: PLACEMENT* -reserved: PLUS -reserved: POINTER -reserved: POP-UP -reserved: POS -reserved: POSITION -reserved: POSITION-SHIFT* -reserved: POSITIVE -reserved: PREVIOUS -reserved: PRINT* -reserved: PRINTER* -reserved: PRINTER-1* -reserved: PRINT-CONTROL -reserved: PRINT-NO-PROMPT* -reserved: PRINT-PREVIEW* -reserved: PRIORITY -reserved: PROCEDURE -reserved: PROCEED -reserved: PROCESSING* -reserved: PROGRAM -reserved: PROGRAM-ID -reserved: PROGRESS* -reserved: PROMPT -reserved: PROPERTIES* -reserved: PROPERTY -reserved: PROTECTED -reserved: PUSH-BUTTON* -reserved: QUERY-INDEX* -reserved: QUOTE -reserved: QUOTES -reserved: RADIO-BUTTON* -reserved: RAISED* -reserved: RANDOM -reserved: READ -reserved: READ-ONLY* -reserved: READERS -reserved: RECEIVE -reserved: RECORD -reserved: RECORD-DATA* -reserved: RECORD-POSITION -reserved: RECORD-TO-ADD* -reserved: RECORD-TO-DELETE* -reserved: RECORDING -reserved: RECORDS -reserved: REDEFINES -reserved: REEL -reserved: REFERENCE -reserved: REFRESH* -reserved: REGION-COLOR* -reserved: RELATIVE -reserved: RELEASE -reserved: REMAINDER -reserved: REMARKS -reserved: REMOVAL -reserved: RENAMES -reserved: REPLACE -reserved: REPLACING -reserved: REPORTING -reserved: REQUIRED -reserved: RESERVE -reserved: RESET-GRID* -reserved: RESET-LIST* -reserved: RESET-TABS* -reserved: RESIDENT -reserved: RESIZABLE -reserved: RETURN -reserved: RETURN-UNSIGNED # note: this is a register, move as soon as supported -reserved: RETURNING -reserved: REVERSE-VIDEO -reserved: REVERSE -reserved: REVERSED -reserved: REWIND -reserved: REWRITE -reserved: RIGHT -reserved: RIGHT-ALIGN* -reserved: RIMMED* -reserved: ROLLBACK -reserved: ROUNDED -reserved: ROW-COLOR* -reserved: ROW-COLOR-PATTERN* -reserved: ROW-DIVIDERS* -reserved: ROW-FONT* -reserved: ROW-HEADINGS* -reserved: ROW-PROTECTION* -reserved: RUN -reserved: SAME -reserved: SAVE-AS* -reserved: SAVE-AS-NO-PROMPT* -reserved: SCREEN -reserved: SCROLL -reserved: SCROLL-BAR* -reserved: SD -reserved: SEARCH -reserved: SEARCH-OPTIONS* -reserved: SEARCH-TEXT* -reserved: SECTION -reserved: SECURE -reserved: SECURITY -reserved: SEEK -reserved: SEGMENT-LIMIT -reserved: SELECT -reserved: SELECT-ALL* -reserved: SELECTION-INDEX* -reserved: SELECTION-TEXT* -reserved: SELF-ACT* -reserved: SEND -reserved: SENTENCE -reserved: SEPARATE -reserved: SEPARATION* -reserved: SEQUENCE -reserved: SEQUENTIAL -reserved: SET -reserved: SHADING* -reserved: SHADOW -reserved: SHORT-DATE* -reserved: SHOW-LINES* -reserved: SHOW-NONE* -reserved: SHOW-SEL-ALWAYS* -reserved: SIGN -reserved: SIGNED-INT -reserved: SIGNED-LONG -reserved: SIGNED-SHORT -reserved: SIZE -reserved: SMALL-FONT* -reserved: SORT -reserved: SORT-MERGE -reserved: SORT-ORDER* -reserved: SORT-WORK* -reserved: SOURCE-COMPUTER -reserved: SPACE -reserved: SPACES=SPACE -reserved: SPECIAL-NAMES -reserved: SPINNER* -reserved: SQUARE* -reserved: STANDARD -reserved: STANDARD-1 -reserved: STANDARD-2 -reserved: START -reserved: START-X* -reserved: START-Y* -reserved: STATIC-LIST* -reserved: STATUS -reserved: STATUS-BAR* -reserved: STATUS-TEXT* -reserved: STOP -reserved: STOP-BROWSER* -reserved: STRING -reserved: STRONG-NAME -reserved: STYLE -reserved: SUBTRACT -reserved: SUBWINDOW -reserved: SYMBOLIC -reserved: SYNC -reserved: SYNCHRONIZED -reserved: SYSTEM -reserved: SYSTEM-INFO -reserved: TAB -reserved: TAB-CONTROL* -reserved: TAB-TO-ADD* -reserved: TAB-TO-DELETE* -reserved: TABLE -reserved: TALLYING -reserved: TAPE -reserved: TEMPORARY* -reserved: TERMINAL-INFO -reserved: TERMINATION-VALUE* -reserved: TEST -reserved: TEXT -reserved: THAN -reserved: THEN -reserved: THREAD -reserved: THREADS -reserved: THROUGH -reserved: THRU -reserved: THUMB-POSITION* -reserved: TILED-HEADINGS* -reserved: TIME -reserved: TIMES -reserved: TITLE-BAR -reserved: TITLE-POSITION* -reserved: TITLE -reserved: TO -reserved: TOOL-BAR -reserved: TRACK-THUMB* -reserved: TRADITIONAL-FONT* -reserved: TRAILING-SHIFT* -reserved: TRANSPARENT* -reserved: TRANSPARENT-COLOR* -reserved: TREE-VIEW* -reserved: TOP -reserved: TRAILING -reserved: TRANSACTION-STATUS -reserved: TRANSACTION -reserved: TRUE -reserved: TYPE -reserved: UNDERLINE -reserved: UNDERLINED=UNDERLINE -reserved: UNIT -reserved: UNLOCK -reserved: UNSIGNED-INT -reserved: UNSIGNED-LONG -reserved: UNSIGNED-SHORT -reserved: UNSTRING -reserved: UNTIL -reserved: UP -reserved: UPDATE -reserved: UPDATERS -reserved: UPON -reserved: UPPER -reserved: USAGE -reserved: USE -reserved: USING -reserved: UNDERLINE* -reserved: UNDERLINED=UNDERLINE -reserved: UNFRAMED* -reserved: UNSORTED* -reserved: USE-ALT* -reserved: USE-RETURN* -reserved: USE-TAB* -reserved: USER-COLORS* -reserved: USER-GRAY* -reserved: USER-WHITE* -reserved: VALUE -reserved: VALUES=VALUE -reserved: VALUE-FORMAT* -reserved: VARIANT* -reserved: VARYING -reserved: VERSION* -reserved: VERTICAL* -reserved: VERY-HEAVY* -reserved: VIRTUAL-WIDTH* -reserved: VISIBLE -reserved: VPADDING* -reserved: VSCROLL* -reserved: VSCROLL-BAR* -reserved: VSCROLL-POS* -reserved: VTOP* -reserved: WAIT -reserved: WEB-BROWSER* -reserved: WHEN -reserved: WIDE -reserved: WIDTH -reserved: WIDTH-IN-CELLS* -reserved: WINDOW -reserved: WITH -reserved: WORDS -reserved: WORKING-STORAGE -reserved: WRAP -reserved: WRITE -reserved: WRITERS -reserved: XML-EVENT # note: this is a register, move as soon as supported -reserved: XML-TEXT # note: this is a register, move as soon as supported -reserved: X* -reserved: Y* -reserved: YYYYDDD -reserved: YYYYMMDD -reserved: ZERO -reserved: ZERO-FILL -reserved: ZEROES=ZERO -reserved: ZEROS=ZERO - -# list of registers: -not-register: DIALECT-ALL -register: "ADDRESS\ OF" -# CONDITION-CODE is only available in HPUX mode, not yet recognized by GnuCOBOL -# CURRENT-DATE is only available in HPUX mode, not yet recognized by GnuCOBOL -# register: ENVIRONMENT-NAME -# register: FILE-PREFIX -register: "LENGTH\ OF" -register: RETURN-CODE -# register: RETURN-UNSIGNED -# SORT-RETURN is only available in IBM mode -# SORT-MESSAGE is only available in IBM mode, not yet recognized by GnuCOBOL -# TALLY is only available in HPUX mode -# TIME-OF-DAY is only available in HPUX mode, not yet recognized by GnuCOBOL -# WHEN-COMPILED is only available in HPUX mode -register: XML-CODE -# register: XML-EVENT -# register: XML-TEXT - - -# list of (non-standard) system names: -system-name: "SWITCH\ 1" -system-name: "SWITCH\ 2" -system-name: "SWITCH\ 3" -system-name: "SWITCH\ 4" -system-name: "SWITCH\ 5" -system-name: "SWITCH\ 6" -system-name: "SWITCH\ 7" -system-name: "SWITCH\ 8" -system-name: "SWITCH\ 9" -system-name: "SWITCH\ 10" -system-name: "SWITCH\ 11" -system-name: "SWITCH\ 12" -system-name: "SWITCH\ 13" -system-name: "SWITCH\ 14" -system-name: "SWITCH\ 15" -system-name: "SWITCH\ 16" -system-name: "SWITCH\ 17" -system-name: "SWITCH\ 18" -system-name: "SWITCH\ 19" -system-name: "SWITCH\ 20" -system-name: "SWITCH\ 21" -system-name: "SWITCH\ 22" -system-name: "SWITCH\ 23" -system-name: "SWITCH\ 24" -system-name: "SWITCH\ 25" -system-name: "SWITCH\ 26" -system-name: "SWITCH\ A" -system-name: "SWITCH\ B" -system-name: "SWITCH\ C" -system-name: "SWITCH\ D" -system-name: "SWITCH\ E" -system-name: "SWITCH\ F" -system-name: "SWITCH\ G" -system-name: "SWITCH\ H" -system-name: "SWITCH\ I" -system-name: "SWITCH\ J" -system-name: "SWITCH\ K" -system-name: "SWITCH\ L" -system-name: "SWITCH\ M" -system-name: "SWITCH\ N" -system-name: "SWITCH\ O" -system-name: "SWITCH\ P" -system-name: "SWITCH\ Q" -system-name: "SWITCH\ R" -system-name: "SWITCH\ S" -system-name: "SWITCH\ T" -system-name: "SWITCH\ U" -system-name: "SWITCH\ V" -system-name: "SWITCH\ W" -system-name: "SWITCH\ X" -system-name: "SWITCH\ Y" -system-name: "SWITCH\ Z" - - -# disable all functions -not-intrinsic-function: DIALECT-ALL - -# add all that are supported by ACUCOBOL-GT -intrinsic-function: ABSOLUTE-VALUE # ACUCOBOL-GT extension (alias for ABS) -intrinsic-function: ABS -intrinsic-function: ACOS -intrinsic-function: ANNUITY -intrinsic-function: ASIN -intrinsic-function: ATAN -intrinsic-function: CHAR -intrinsic-function: COS -intrinsic-function: CURRENT-DATE -intrinsic-function: DATE-OF-INTEGER -intrinsic-function: DAY-OF-INTEGER -intrinsic-function: FACTORIAL -intrinsic-function: INTEGER -intrinsic-function: INTEGER-OF-DATE -intrinsic-function: INTEGER-OF-DAY -intrinsic-function: INTEGER-PART -intrinsic-function: LENGTH -intrinsic-function: LOG -intrinsic-function: LOG10 -intrinsic-function: LOWER-CASE -intrinsic-function: MAX -intrinsic-function: MEAN -intrinsic-function: MEDIAN -intrinsic-function: MIDRANGE -intrinsic-function: MIN -intrinsic-function: MOD -intrinsic-function: NUMVAL -intrinsic-function: NUMVAL-C -intrinsic-function: ORD -intrinsic-function: ORD-MAX -intrinsic-function: ORD-MIN -intrinsic-function: PRESENT-VALUE -intrinsic-function: RANDOM -intrinsic-function: RANGE -intrinsic-function: REM -intrinsic-function: REVERSE -intrinsic-function: SIN -intrinsic-function: SQRT -intrinsic-function: STANDARD-DEVIATION -intrinsic-function: SUM -intrinsic-function: TAN -intrinsic-function: UPPER-CASE -intrinsic-function: VARIANCE -intrinsic-function: WHEN-COMPILED diff -Nru gnucobol-4.0~early~20200606/config/bs2000.conf gnucobol-5/config/bs2000.conf --- gnucobol-4.0~early~20200606/config/bs2000.conf 2020-06-06 20:52:02.000000000 +0000 +++ gnucobol-5/config/bs2000.conf 1970-01-01 00:00:00.000000000 +0000 @@ -1,34 +0,0 @@ -# GnuCOBOL compiler configuration -# -# Copyright (C) 2001-2012, 2014-2017 Free Software Foundation, Inc. -# Written by Keisuke Nishida, Roger While, Simon Sobisch, Edward Hart -# -# This file is part of GnuCOBOL. -# -# The GnuCOBOL compiler is free software: you can redistribute it -# and/or modify it under the terms of the GNU General Public License -# as published by the Free Software Foundation, either version 3 of the -# License, or (at your option) any later version. -# -# GnuCOBOL is distributed in the hope that it will be useful, -# but WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -# GNU General Public License for more details. -# -# You should have received a copy of the GNU General Public License -# along with GnuCOBOL. If not, see . - - -include "bs2000-strict.conf" - -# Value: any string -name: "BS2000 COBOL (lax)" - -# reserve additional words, synonyms and exceptions from normal word list -include: "bs2000.words" - -# not-reserved: -# Value: Word to be taken out of the reserved words list -# -fill upon request- - -include "lax.conf-inc" diff -Nru gnucobol-4.0~early~20200606/config/bs2000-strict.conf gnucobol-5/config/bs2000-strict.conf --- gnucobol-4.0~early~20200606/config/bs2000-strict.conf 2020-06-06 20:52:02.000000000 +0000 +++ gnucobol-5/config/bs2000-strict.conf 1970-01-01 00:00:00.000000000 +0000 @@ -1,259 +0,0 @@ -# GnuCOBOL compiler configuration -# -# Copyright (C) 2001-2012, 2014-2020 Free Software Foundation, Inc. -# Written by Keisuke Nishida, Roger While, Simon Sobisch, Edward Hart, -# Ron Norman -# -# This file is part of GnuCOBOL. -# -# The GnuCOBOL compiler is free software: you can redistribute it -# and/or modify it under the terms of the GNU General Public License -# as published by the Free Software Foundation, either version 3 of the -# License, or (at your option) any later version. -# -# GnuCOBOL is distributed in the hope that it will be useful, -# but WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -# GNU General Public License for more details. -# -# You should have received a copy of the GNU General Public License -# along with GnuCOBOL. If not, see . - -# Note: this config is derived from the documentation of Fujitsu's COBOL2000 -# V1.5 compiler. - -# Value: any string -name: "BS2000 COBOL" - -# Value: enum -standard-define 4 -# CB_STD_OC = 0, -# CB_STD_MF, -# CB_STD_IBM, -# CB_STD_MVS, -# CB_STD_BS2000, -# CB_STD_ACU, -# CB_STD_85, -# CB_STD_2002, -# CB_STD_2014 - -# Value: int -tab-width: 8 -text-column: 72 -word-length: 31 -literal-length: 180 # TO-DO: Check max hex string length is 360. -numeric-literal-length: 31 # TO-DO: Different rules for exponent-format floating-point literals. -pic-length: 50 - -# Default assign type -# Value: 'dynamic', 'external' -assign-clause: dynamic # TO-DO: Verify - -# If yes, file names are resolved at run time using -# environment variables. -# For example, given ASSIGN TO "DATAFILE", the file name will be -# 1. the value of environment variable 'DD_DATAFILE' or -# 2. the value of environment variable 'dd_DATAFILE' or -# 3. the value of environment variable 'DATAFILE' or -# 4. the literal "DATAFILE" -# If no, the value of the assign clause is the file name. -# -filename-mapping: yes # probably - -# Alternate formatting of numeric fields -pretty-display: no - -# Allow complex OCCURS DEPENDING ON -complex-odo: no - -# Allow REDEFINES to other than last equal level number -indirect-redefines: no - -# Binary byte size - defines the allocated bytes according to PIC -# Value: signed unsigned bytes -# ------ -------- ----- -# '2-4-8' 1 - 4 same 2 -# 5 - 9 same 4 -# 10 - 18 same 8 -# -# '1-2-4-8' 1 - 2 same 1 -# 3 - 4 same 2 -# 5 - 9 same 4 -# 10 - 18 same 8 -# -# '1--8' 1 - 2 1 - 2 1 -# 3 - 4 3 - 4 2 -# 5 - 6 5 - 7 3 -# 7 - 9 8 - 9 4 -# 10 - 11 10 - 12 5 -# 12 - 14 13 - 14 6 -# 15 - 16 15 - 16 7 -# 17 - 18 17 - 18 8 -# -binary-size: 2-4-8 - -# Numeric truncation according to ANSI -binary-truncate: yes # TO-DO: For BINARY, *not* for COMP or COMP-5! - -# Binary byte order -# Value: 'native', 'big-endian' -binary-byteorder: big-endian - -# Allow larger REDEFINES items -larger-redefines-ok: no # TO-DO: Except for level 01 items. - -# Allow certain syntax variations (eg. REDEFINES position) -relax-syntax-checks: no - -# Perform type OSVS - If yes, the exit point of any currently -# executing perform is recognized if reached. -perform-osvs: no - -# Compute intermediate decimal results like IBM OSVS -arithmetic-osvs: no # TO-DO: Maybe, but if intermediate item has more than 31 places, floating-point arithmetic is used. - -# MOVE like IBM (mvc); left to right, byte by byte -move-ibm: no - -# If yes, linkage-section items remain allocated -# between invocations. -sticky-linkage: no # TO-DO: Check! - -# If yes, allow non-matching level numbers -relax-level-hierarchy: no - -# If yes, evaluate constant expressions at compile time -constant-folding: yes - -# Allow Hex 'F' for NUMERIC test of signed PACKED DECIMAL field -hostsign: no - -# If yes, set WITH UPDATE clause as default for ACCEPT dest-item, -# except if WITH NO UPDATE clause is used -accept-update: no - -# If yes, set WITH AUTO clause as default for ACCEPT dest-item, -# except if WITH TAB clause is used -accept-auto: no - -# If yes, DISPLAYs and ACCEPTs are, by default, done on the CRT (i.e., using -# curses). -console-is-crt: no - -# If yes, allow redefinition of the current program's name. This prevents its -# use in a prototype-format CALL/CANCEL statement. -program-name-redefinition: no - -# If yes, NO ECHO/NO-ECHO/OFF is the same as SECURE (hiding input with -# asterisks, not spaces). -no-echo-means-secure: no - -# If yes, the first item in a field screen ACCEPT/DISPLAY (e.g. DISPLAY x UPON -# CRT) is located after the previous ACCEPT/DISPLAY (as though LINE 0 COL 0 had -# been specified). -line-col-zero-default: no - -# If yes, then REPORT, COLUMN may have any of PLUS num, + num, or +num -# to define a relative column position -report-column-plus: no - -# If yes, DISPLAY SPACES acts as ERASE EOS, DISPLAY X"01" acts as ERASE EOL, -# DISPLAY X"02" acts as BLANK SCREEEN and DISPLAY X"07" acts as BELL. Note -# DISPLAY LOW-VALUE is excluded from this; it will always just position the -# cursor. -display-special-fig-consts: no - -# If yes, COMP-1 is a signed 16-bit integer and any PICTURE clause is ignored. -binary-comp-1: no - -# auto-adjust to zero like MicroFocus does -move-non-numeric-lit-to-numeric-is-zero: no - -# If yes, implicitly define a variable for an ASSIGN DYNAMIC which does not -# match an existing data item. -implicit-assign-dynamic-var: no - -# What rules to apply to SCREEN SECTION items clauses -screen-section-rules: std - -# Dialect features -# Value: 'ok', 'warning', 'archaic', 'obsolete', 'skip', 'ignore', 'error', -# 'unconformable' - -alter-statement: obsolete -comment-paragraphs: unconformable -call-overflow: ok -data-records-clause: obsolete -debugging-mode: ok -use-for-debugging: unconformable -listing-statements: unconformable -title-statement: unconformable -entry-statement: ok -goto-statement-without-name: obsolete -label-records-clause: obsolete -memory-size-clause: obsolete -move-noninteger-to-alphanumeric: error -move-figurative-constant-to-numeric: error -move-figurative-space-to-numeric: error -move-figurative-quote-to-numeric: error -multiple-file-tape-clause: obsolete -next-sentence-phrase: ok -odo-without-to: unconformable -padding-character-clause: ignore -section-segments: obsolete -stop-literal-statement: obsolete -stop-identifier-statement: unconformable -same-as-clause: unconformable -synchronized-clause: ok -sync-left-right: skip -special-names-clause: error # not verified yet -top-level-occurs-clause: unconformable -value-of-clause: obsolete -numeric-boolean: unconformable -hexadecimal-boolean: unconformable -national-literals: ok -hexadecimal-national-literals: ok -national-character-literals: unconformable -acu-literals: unconformable -hp-octal-literals: unconformable -word-continuation: ok -occurs-max-length-without-subscript: no -length-in-data-division: no -depending-on-not-fixed: warning -not-exception-before-exception: unconformable -accept-display-extensions: unconformable -renames-uncommon-levels: unconformable -symbolic-constant: unconformable -constant-78: unconformable -constant-01: unconformable -perform-varying-without-by: unconformable -reference-out-of-declaratives: error -# Is reference modification required to be within the single field -reference-bounds-check: error -program-prototypes: unconformable -call-convention-mnemonic: unconformable -call-convention-linkage: unconformable -numeric-value-for-edited-item: error -incorrect-conf-sec-order: error -define-constant-directive: unconformable -free-redefines-position: unconformable -records-mismatch-record-clause: error # not verified yet -record-delimiter: ignore -sequential-delimiters: unconformable -record-delim-with-fixed-recs: unconformable -missing-statement: warning # not verified yet -zero-length-literals: unconformable -xml-generate-extra-phrases: unconformable -continue-after: unconformable -goto-entry: unconformable -binary-sync-clause: ignore -nonnumeric-with-numeric-group-usage: ok -assign-variable: unconformable -assign-using-variable: ok -assign-ext-dyn: unconformable -assign-disk-from: unconformable -align-record: 8 -align-opt: no - -# use fixed word list, synonyms and exceptions specified there -reserved-words: BS2000 diff -Nru gnucobol-4.0~early~20200606/config/bs2000.words gnucobol-5/config/bs2000.words --- gnucobol-4.0~early~20200606/config/bs2000.words 2020-06-06 20:52:02.000000000 +0000 +++ gnucobol-5/config/bs2000.words 1970-01-01 00:00:00.000000000 +0000 @@ -1,681 +0,0 @@ -# GnuCOBOL compiler - list of reserved words -# -# Copyright (C) 2016-2017 Free Software Foundation, Inc. -# Written by Simon Sobisch, Edward Hart -# -# This file is part of GnuCOBOL. -# -# The GnuCOBOL compiler is free software: you can redistribute it -# and/or modify it under the terms of the GNU General Public License -# as published by the Free Software Foundation, either version 3 of the -# License, or (at your option) any later version. -# -# GnuCOBOL is distributed in the hope that it will be useful, -# but WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -# GNU General Public License for more details. -# -# You should have received a copy of the GNU General Public License -# along with GnuCOBOL. If not, see . - - -# Word list for dialect: BS2000 COBOL2000 -# Note: this list excludes Data Manipulation Language (DML) words. - -# Note: only used for strict dialect and when -# requested by compiler directive >> IMP WORDS BS2000 -# the default reserved word list will not be used. - -# Value: Word to make up reserved words list (case independent) -# All reserved entries listed will replace entire default reserved words list. -# Words ending with * will be treated as context-sensitive words. This will be -# ignored if GnuCOBOL uses that word as a reserved word. -# Entries of the form word-1=word-2 define word-1 as an alias for default -# reserved word word-2. No spaces are allowed around the equal sign. -reserved: ACCEPT -reserved: ACCESS -reserved: ACTIVE-CLASS -reserved: ADD -reserved: ADDRESS -reserved: ADVANCING -reserved: AFTER -reserved: ALIGNED* -reserved: ALL -reserved: ALLOCATE -reserved: ALPHABET -reserved: ALPHABETIC -reserved: ALPHABETIC-LOWER -reserved: ALPHABETIC-UPPER -reserved: ALPHANUMERIC -reserved: ALPHANUMERIC-EDITED -reserved: ALSO -reserved: ALTER -reserved: ALTERNATE -reserved: AND -reserved: ANY -reserved: ANYCASE -reserved: ARE -reserved: AREA -reserved: AREAS -reserved: ARITHMETIC* -reserved: AS -reserved: ASCENDING -reserved: ASSIGN -reserved: AT -reserved: ATTRIBUTE* -reserved: AUTHOR -reserved: AUTO* -reserved: AUTOMATIC* -reserved: B-AND -reserved: B-NOT -reserved: B-OR -reserved: B-XOR -reserved: BACKGROUND-COLOR* -reserved: BASED -reserved: BEFORE -reserved: BEGINNING -reserved: BELL* -reserved: BINARY -reserved: BINARY-CHAR -reserved: BINARY-DOUBLE -reserved: BINARY-LONG -reserved: BINARY-SHORT -reserved: BIT -reserved: BLANK -reserved: BLINK* -reserved: BLOCK -reserved: BOOLEAN -reserved: BOTTOM -reserved: BY -reserved: BYTE-LENGTH -reserved: CALL -reserved: CANCEL -reserved: CBL-CTR # note: this is a register, move as soon as supported -reserved: CENTER* -reserved: CF -reserved: CH -reserved: CHARACTER -reserved: CHARACTERS -reserved: CHECK* -reserved: CHECKING -reserved: CLASS -reserved: CLASS-ID -reserved: CLASSIFICATION* -reserved: CLOCK-UNITS -reserved: CLOSE -reserved: CODE -reserved: CODE-SET -reserved: COL -reserved: COLLATING -reserved: COLS -reserved: COLUMN -reserved: COLUMNS -reserved: COMMA -reserved: COMMIT -reserved: COMMON -reserved: COMMUNICATION -reserved: COMP -reserved: COMP-1 -reserved: COMP-2 -reserved: COMP-3 -reserved: COMP-5 -reserved: COMPUTATIONAL -reserved: COMPUTATIONAL-1 -reserved: COMPUTATIONAL-2 -reserved: COMPUTATIONAL-3 -reserved: COMPUTATIONAL-5 -reserved: COMPUTE -reserved: CONDITION -reserved: CONFIGURATION -reserved: CONSTANT -reserved: CONTAINS -reserved: CONTENT -reserved: CONTINUE -reserved: CONTROL -reserved: CONTROLS -reserved: CONVERTING -reserved: COPY -reserved: CORR -reserved: CORRESPONDING -reserved: COUNT -reserved: CREATING -reserved: CRT -reserved: CURRENCY -reserved: CURSOR -reserved: CYCLE* -reserved: DATA -reserved: DATA-POINTER -reserved: DATABASE-KEY -reserved: DATABASE-KEY-LONG -reserved: DATE -reserved: DATE-COMPILED -reserved: DATE-WRITTEN -reserved: DAY -reserved: DAY-OF-WEEK -reserved: DE -reserved: DEBUGGING -reserved: DECIMAL-POINT -reserved: DECLARATIVES -reserved: DEFAULT -reserved: DELETE -reserved: DELIMITED -reserved: DELIMITER -reserved: DEPENDING -reserved: DESCENDING -reserved: DETAIL -reserved: DISABLE -reserved: DISC -reserved: DISCARD* -reserved: DISPLAY -reserved: DIVIDE -reserved: DIVISION -reserved: DOCUMENT -reserved: DOWN -reserved: DTD* -reserved: DUPLICATES -reserved: DYNAMIC -reserved: EBCDIC -reserved: EC -reserved: ELEMENT* -reserved: ELSE -reserved: ENABLE -reserved: END -reserved: END-ACCEPT -reserved: END-ADD -reserved: END-CALL -reserved: END-COMPUTE -reserved: END-DELETE -reserved: END-DISPLAY -reserved: END-DIVIDE -reserved: END-EVALUATE -reserved: END-IF -reserved: END-INVOKE -reserved: END-MULTIPLY -reserved: END-OF-PAGE -reserved: END-OPEN -reserved: END-PERFORM -reserved: END-READ -reserved: END-RECEIVE -reserved: END-RETURN -reserved: END-REWRITE -reserved: END-SEARCH -reserved: END-START -reserved: END-STRING -reserved: END-SUBTRACT -reserved: END-UNSTRING -reserved: END-WRITE -reserved: END-XML -reserved: ENDING -reserved: ENTRY -reserved: ENTRY-CONVENTION* -reserved: ENVIRONMENT -reserved: EO -reserved: EOL* -reserved: EOP -reserved: EOS* -reserved: EQUAL -reserved: ERASE -reserved: ERROR -reserved: EVALUATE -reserved: EVERY -reserved: EXCEPTION -reserved: EXCEPTION-OBJECT -reserved: EXIT -reserved: EXPANDS* -reserved: EXTEND -reserved: EXTENDED -reserved: EXTERNAL -reserved: FACTORY -reserved: FALSE -reserved: FD -reserved: FILE -reserved: FILE-CONTROL -reserved: FILLER -reserved: FINAL -reserved: FIRST -reserved: FLOAT-EXTENDED -reserved: FLOAT-LONG -reserved: FLOAT-SHORT -reserved: FOOTING -reserved: FOR -reserved: FOREGROUND-COLOR* -reserved: FOREVER* -reserved: FORMAT -reserved: FREE -reserved: FROM -reserved: FULL* -reserved: FUNCTION -reserved: FUNCTION-ID -reserved: GENERATE -reserved: GET -reserved: GIVING -reserved: GLOBAL -reserved: GO -reserved: GOBACK -reserved: GREATER -reserved: GROUP -reserved: GROUP-USAGE -reserved: HEADING -reserved: HIGH-VALUE -reserved: HIGH-VALUES=HIGH-VALUE -reserved: HIGHLIGHT* -reserved: I-O -reserved: I-O-CONTROL -reserved: ID -reserved: IDENTIFICATION -reserved: IDENTIFIED -reserved: IF -reserved: IGNORING -reserved: IMPLEMENTS* -reserved: IN -reserved: INDEX -reserved: INDEXED -reserved: INDICATE -reserved: INHERITS -reserved: INITIAL -reserved: INITIALIZE -reserved: INITIALIZED* -reserved: INITIATE -reserved: INPUT -reserved: INPUT-OUTPUT -reserved: INSPECT -reserved: INSTALLATION -reserved: INTERFACE -reserved: INTERFACE-ID -reserved: INTO -reserved: INTRINSIC* -reserved: INVALID -reserved: INVOKE -reserved: IS -reserved: JUST -reserved: JUSTIFIED -reserved: KEY -reserved: LABEL -reserved: LAST -reserved: LEADING -reserved: LEFT -reserved: LENGTH -reserved: LESS -reserved: LIMIT -reserved: LIMITS -reserved: LINAGE -reserved: LINAGE-COUNTER* -reserved: LINE -reserved: LINE-COUNTER -reserved: LINES -reserved: LINKAGE -reserved: LOCAL-STORAGE -reserved: LOCALE -reserved: LOCALIZE* -reserved: LOCK -reserved: LOW-VALUE -reserved: LOW-VALUES=LOW-VALUE -reserved: LOWLIGHT* -reserved: MANUAL* -reserved: MEMORY -reserved: MERGE -reserved: MESSAGE -reserved: METHOD -reserved: METHOD-ID -reserved: MINUS -reserved: MODE -reserved: MODULES -reserved: MORE-LABELS -reserved: MOVE -reserved: MULTIPLE -reserved: MULTIPLY -reserved: NAMESPACE* -reserved: NATIONAL -reserved: NATIONAL-EDITED -reserved: NATIVE -reserved: NEGATIVE -reserved: NESTED -reserved: NEXT -reserved: NO -reserved: NONE* -reserved: NORMAL* -reserved: NOT -reserved: NULL -reserved: NUMBER -reserved: NUMBERS* -reserved: NUMERIC -reserved: NUMERIC-EDITED -reserved: OBJECT -reserved: OBJECT-COMPUTER -reserved: OBJECT-REFERENCE -reserved: OCCURS -reserved: OF -reserved: OFF -reserved: OMITTED -reserved: ON -reserved: ONLY* -reserved: OPEN -reserved: OPTIONAL -reserved: OPTIONS -reserved: OR -reserved: ORDER -reserved: ORGANIZATION -reserved: OTHER -reserved: OUTPUT -reserved: OVERFLOW -reserved: OVERRIDE -reserved: PACKED-DECIMAL -reserved: PADDING -reserved: PAGE -reserved: PAGE-COUNTER -reserved: PARAGRAPH* -reserved: PARSE* -reserved: PERFORM -reserved: PF -reserved: PH -reserved: PIC -reserved: PICTURE -reserved: PLUS -reserved: POINTER -reserved: POSITION -reserved: POSITIVE -reserved: PRESENT -reserved: PREVIOUS* -reserved: PRINTING -reserved: PRINT-SWITCH # note: this is a register, move as soon as supported -reserved: PROCEDURE -reserved: PROCEED -reserved: PROCESSING* -reserved: PROGRAM -reserved: PROGRAM-ID -reserved: PROGRAM-POINTER -reserved: PROPERTY -reserved: PROTOTYPE -reserved: PURGE -reserved: QUOTE -reserved: QUOTES -reserved: RAISE -reserved: RAISING -reserved: RANDOM -reserved: RAW* -reserved: RD -reserved: READ -reserved: RECEIVE -reserved: RECORD -reserved: RECORDING -reserved: RECORDS -reserved: RECURSIVE* -reserved: REDEFINES -reserved: REEL -reserved: REFERENCE -reserved: RELATION* -reserved: RELATIVE -reserved: RELEASE -reserved: REMAINDER -reserved: REMOVAL -reserved: RENAMES -reserved: REPEATED -reserved: REPLACE -reserved: REPLACING -reserved: REPORT -reserved: REPORTING -reserved: REPORTS -reserved: REPOSITORY -reserved: REQUIRED* -reserved: RERUN -reserved: RESERVE -reserved: RESET -reserved: RESUME -reserved: RETRY -reserved: RETURN -reserved: RETURNING -reserved: REVERSE-VIDEO* -reserved: REVERSED -reserved: REWIND -reserved: REWRITE -reserved: RF -reserved: RH -reserved: RIGHT -reserved: ROLLBACK -reserved: ROUNDED -reserved: RUN -reserved: SAME -reserved: SCHEMA* -reserved: SCREEN -reserved: SD -reserved: SEARCH -reserved: SECONDS* -reserved: SECTION -reserved: SECURE* -reserved: SECURITY -reserved: SEGMENT-LIMIT -reserved: SELECT -reserved: SELF -reserved: SEND -reserved: SENTENCE -reserved: SEPARATE -reserved: SEQUENCE -reserved: SEQUENTIAL -reserved: SET -reserved: SHARING -reserved: SIGN -reserved: SIGNED* -reserved: SIZE -reserved: SORT -reserved: SORT-CCSN # note: this is a register, move as soon as supported -reserved: SORT-CORE-SIZE # note: this is a register, move as soon as supported -reserved: SORT-EOW # note: this is a register, move as soon as supported -reserved: SORT-FILE-SIZE # note: this is a register, move as soon as supported -reserved: SORT-MERGE -reserved: SORT-MODE-SIZE # note: this is a register, move as soon as supported -reserved: SORT-TAPE -reserved: SORT-TAPES -reserved: SOURCE -reserved: SOURCE-COMPUTER -reserved: SOURCES -reserved: SPACE -reserved: SPACES=SPACE -reserved: SPECIAL-NAMES -reserved: STACK* -reserved: STANDARD -reserved: STANDARD-1 -reserved: STANDARD-2 -reserved: START -reserved: STATEMENT* -reserved: STATUS -reserved: STEP* -reserved: STOP -reserved: STRING -reserved: STRONG* -reserved: SUBTRACT -reserved: SUM -reserved: SUPER -reserved: SUPPRESS -reserved: SYMBOL* -reserved: SYMBOLIC -reserved: SYNC -reserved: SYNCHRONIZED -reserved: SYSTEM-DEFAULT -reserved: TABLE -reserved: TALLYING -reserved: TAPE -reserved: TAPES -reserved: TERMINAL -reserved: TERMINATE -reserved: TEST -reserved: THAN -reserved: THEN -reserved: THROUGH -reserved: THRU -reserved: TIME -reserved: TIMES -reserved: TO -reserved: TOP -reserved: TRAILING -reserved: TRUE -reserved: TRY -reserved: TYPE -reserved: TYPEDEF -reserved: U* -reserved: UCS-2* -reserved: UCS-4* -reserved: UNDERLINE* -reserved: UNIT -reserved: UNITS -reserved: UNIVERSAL -reserved: UNLOCK -reserved: UNSIGNED* -reserved: UNSTRING -reserved: UNTIL -reserved: UP -reserved: UPON -reserved: USAGE -reserved: USE -reserved: USER-DEFAULT -reserved: USING -reserved: UTF-16* -reserved: UTF-8* -reserved: VAL-STATUS -reserved: VALID -reserved: VALIDATE -reserved: VALIDATE-STATUS -reserved: VALIDITY* -reserved: VALUE -reserved: VALUES=VALUE -reserved: VARYING -reserved: VERSION-XML -reserved: WHEN -reserved: WITH -reserved: WORDS -reserved: WORKING-STORAGE -reserved: WRITE -reserved: XML -reserved: XML-EVENT # note: this is a register, move as soon as supported -reserved: XML-NAMESPACE # note: this is a register, move as soon as supported -reserved: XML-NAMESPACE-PREFIX # note: this is a register, move as soon as supported -reserved: XML-NNAMESPACE # note: this is a register, move as soon as supported -reserved: XML-NNAMESPACE-PREFIX # note: this is a register, move as soon as supported -reserved: XML-NTEXT # note: this is a register, move as soon as supported -reserved: XML-TEXT # note: this is a register, move as soon as supported -reserved: YYYYDDD* -reserved: YYYYMMDD* -reserved: ZERO -reserved: ZEROES=ZERO -reserved: ZEROS=ZERO - -# list of registers -not-register: DIALECT-ALL -register: "ADDRESS\ OF" -# register: "BYTE-LENGTH\ OF" -# register: CBL-CTR -register: "LENGTH\ OF" -# register: LINAGE-COUNTER -# register: LINE-COUNTER -# register: PAGE-COUNTER -# register: PRINT-SWITCH -register: RETURN-CODE -# register: SORT-CCSN -# register: SORT-CORE-SIZE -# register: SORT-EOW -# register: SORT-FILE-SIZE -# register: SORT-MODE-SIZE -register: SORT-RETURN -register: TALLY -register: XML-CODE -# register: XML-EVENT -# register: XML-NAMESPACE -# register: XML-NAMESPACE-PREFIX -# register: XML-NNAMESPACE -# register: XML-NNAMESPACE-PREFIX -# register: XML-NTEXT -# register: XML-TEXT - -# TO-DO: Add all printer mnemonics and special variables -# (e.g. DATE-ISO4, CPU-TIME). -not-system-name: DIALECT-ALL-SWITCHES -not-system-name: C09 # I don't understand either. -not-system-name: C12 -# TO-DO: Add TSW-0 through TSW-31 - I'm not sure how task switches differ from user switches. -system-name: USW-0 -system-name: USW-1 -system-name: USW-2 -system-name: USW-3 -system-name: USW-4 -system-name: USW-5 -system-name: USW-6 -system-name: USW-7 -system-name: USW-8 -system-name: USW-9 -system-name: USW-10 -system-name: USW-11 -system-name: USW-12 -system-name: USW-13 -system-name: USW-14 -system-name: USW-15 -system-name: USW-16 -system-name: USW-17 -system-name: USW-18 -system-name: USW-19 -system-name: USW-20 -system-name: USW-21 -system-name: USW-22 -system-name: USW-23 -system-name: USW-24 -system-name: USW-25 -system-name: USW-26 -system-name: USW-27 -system-name: USW-28 -system-name: USW-29 -system-name: USW-30 -system-name: USW-31 - -# disable all functions -not-intrinsic-function: DIALECT-ALL - -# add all that are supported by COBOL2000 (BS2000) -intrinsic-function: ACOS -#intrinsic-function: ADDR # BS2000 extension, not known to GnuCOBOL -intrinsic-function: ANNUITY -intrinsic-function: ASIN -intrinsic-function: ATAN -intrinsic-function: BYTE-LENGTH -intrinsic-function: CHAR -intrinsic-function: CHAR-NATIONAL -intrinsic-function: COS -intrinsic-function: CURRENT-DATE -intrinsic-function: DATE-OF-INTEGER -intrinsic-function: DATE-TO-YYYYMMDD -intrinsic-function: DAY-OF-INTEGER -intrinsic-function: DAY-TO-YYYYDDD -intrinsic-function: DISPLAY-OF -intrinsic-function: EXCEPTION-STATUS -intrinsic-function: FACTORIAL -intrinsic-function: INTEGER -intrinsic-function: INTEGER-OF-DATE -intrinsic-function: INTEGER-OF-DAY -intrinsic-function: INTEGER-PART -intrinsic-function: LENGTH -intrinsic-function: LOG -intrinsic-function: LOG10 -intrinsic-function: LOWER-CASE -intrinsic-function: MAX -intrinsic-function: MEAN -intrinsic-function: MEDIAN -intrinsic-function: MIDRANGE -intrinsic-function: MIN -intrinsic-function: MOD -intrinsic-function: NATIONAL-OF -intrinsic-function: NUMVAL -intrinsic-function: NUMVAL-C -intrinsic-function: ORD -intrinsic-function: ORD-MAX -intrinsic-function: ORD-MIN -intrinsic-function: PRESENT-VALUE -intrinsic-function: RANDOM -intrinsic-function: RANGE -intrinsic-function: REM -intrinsic-function: REVERSE -intrinsic-function: SIN -intrinsic-function: SQRT -intrinsic-function: STANDARD-DEVIATION -intrinsic-function: SUM -intrinsic-function: TAN -intrinsic-function: UPPER-CASE -intrinsic-function: VARIANCE -intrinsic-function: WHEN-COMPILED -intrinsic-function: YEAR-TO-YYYY diff -Nru gnucobol-4.0~early~20200606/config/ChangeLog gnucobol-5/config/ChangeLog --- gnucobol-4.0~early~20200606/config/ChangeLog 2020-06-06 20:52:02.000000000 +0000 +++ gnucobol-5/config/ChangeLog 1970-01-01 00:00:00.000000000 +0000 @@ -1,550 +0,0 @@ - -2020-03-31 Ron Norman - - * general: added option align-record and align-opt - -2020-03-27 Simon Sobisch - - * general: removed option "select-working" (see bug #421) - -2020-03-31 Simon Sobisch - - * general: added option special-names-clause - -2020-02-13 Ron Norman - - * general: added option create_table - -2020-01-22 Ron Norman - - * general: added option bdb_byteorder - -2020-01-12 Simon Sobisch - - * general: bug #513 (partial) added sync-left-right - -2020-01-04 Edward Hart - - * general: added options assign-variable, assign-using-variable, - assign-ext-dyn and assign-disk-from. - -2020-01-01 Simon Sobisch - - * general: FR #193 added same-as-clause - -2019-12-28 Edward Hart - - * general: changed assign-clause directives to use more descriptive - dynamic/external instead of mf/ibm. - * general: added option implicit-assign-dynamic-var. - -2019-09-30 Edward Hart - - * realia.words: Removed words belonging to other dialects - word list - now matches REALIA6. - -2019-09-28 Edward Hart - - * realia.conf, realia-strict.conf, realia.words, Makefile.am: added - dialect for CA Realia II. - -2019-09-26 Ron Norman - - * general: added option reference-bounds-check - -2019-09-22 Ron Norman - - * general: added option report-column-plus - -2019-08-11 Simon Sobisch - - * general: added option hp-octal-literals - -2019-06-08 Simon Sobisch - - * general: removed options json-generate and xml-generate (support is - now only depending on the reserved words) - -2019-06-02 Simon Sobisch - - * general: added option records-mismatch-record-clause - -2019-05-30 Simon Sobisch - - * general: FR #311 added options call-convention-mnemonic and - call-convention-linkage - -2019-05-11 Simon Sobisch - - * default.conf, lax.conf-inc, mf-strict, rm-strict.conf: - increased word-length to 63 per COBOL 202x - -2019-04-07 Simon Sobisch - - * general: FR #354 added continue-after option, set to ok - for default/lax only as we won't have a dialect file for COBOL 202x - until its final working draft and release date is available - -2019-03-18 Simon Sobisch - - * general: FR #352 added national-character-literals option, set to warning - for default/lax only as we still don't have a dialect file for Fujitsu - -2019-01-29 Simon Sobisch - - * runtime.cfg: added COB_DISPLAY_PUNCH_FILE - -2019-01-05 Edward Hart - - * general: added json-generate option - -2018-04-12 Simon Sobisch - - * default.conf: set missing-statement (FR# 244) to warning as older - GnuCOBOL versions allowed a partial subset of these - -2018-09-11 Simon Sobisch - - * mf-strict.conf: set missing-statement to error (according to MF docs) - -2018-08-07 Edward Hart - - * general: added xml-generate and xml-generate-extra-phrases options - * general: marked XML-CODE as implemented - -2018-07-13 Simon Sobisch - - * ibm.words: updated to Enterprise COBOL 6.1 documentation, - added notes about coprocessor-only reserved words, made all phrases - for XML GENERATE / XML PARSE statements context-sensitive - -2018-04-21 Simon Sobisch - - * general: added symbolic-constant, set to OK for default only - as we don't have a dialect file for Fujitsu currently - -2018-03-31 Edward Hart - - * general: added zero-length-literals option - -2018-03-09 Simon Sobisch - - * general: added move-figurative-space-to-numeric, set to OK for - ACUCOBOL and MicroFocus - -2018-01-14 Ron Norman - - * general: added move-non-numeric-lit-to-numeric-is-zero - This changes MOVE SPACE/QUOTE/HIGH-VALUES TO PIC 9 field - into MOVE ZERO - * mf.conf: move-figurative-constant-to-numeric: warn - move-non-numeric-lit-to-numeric-is-zero: yes - -2018-01-12 Simon Sobisch - - * acu-strict.conf: changed sticky-linkage to "no" - -2018-01-12 Simon Sobisch - - * general: added missing-statement (FR #288) - -2017-12-26 Edward Hart - - * default.conf, lax.conf-inc: changed screen-section-rules to gc - (bug #482) - -2017-12-24 Edward Hart - - * general: added screen-section-rules option (Bug #382) - -2017-11-14 Edward Hart - - * ibm.words, mvs.words, rm.words: fixed bug #476, where WHEN-COMPILED - register was hidden by WHEN-COMPILED reserved word - -2017-11-10 Edward Hart - - * general: added binary-comp-1 option (FR #272) - -2017-11-02 Simon Sobisch - - * general: FR #158 added perform-varying-without-by (COBOL2002+) - -2017-11-25 Simon Sobisch - - * default.conf: added aliases HIGH-VALUES/LOW-VALUES/VALUES/ZEROES/ZEROS - * acu.conf: heavily updated from MF Studio Enterprise reserved word list - -2017-11-09 Simon Sobisch - - * cobol85.words, ibm.words, mvs.words, mf.words rm.words, xopen.conf: - added DEBUG-ITEM to be handled as register - -2017-11-06 Simon Sobisch - - * cobol85.conf, ibm-strict.conf, mvs-strict.conf, mf-strict.conf, - rm-strict.conf: fixed "debugging-mode" to be "ok" (only use-for-debugging - is obsolete in COBOL 85, debugging-mode became obsolete with COBOL 2002) - * default.conf: changed use-for-debugging to "ok" - * runtime.cfg: included COB_SET_DEBUG in the documentation - -2017-10-07 Edward Hart - - * general: added screen-section-rules option. - -2017-10-06 Edward Hart - - * general: added record-delimiter, sequential-delimiters and - record-delim-with-fixed-recs options. - -2017-09-18 Ron Norman - - * general: bug #421 added option "select-working" disallowing - SELECT ASSIGN and RELATIVE KEY fields to be in other than - WORKING-STORAGE locations - -2017-09-16 Edward Hart - - * ibm.words: updated to Enterprise COBOL V6.2. - * general: added free-redefines-position option. - -2017-09-10 Edward Hart - - * general: added line-col-zero-default and display-special-fig-consts - options. - -2017-09-09 Simon Sobisch - - * default.conf, mf-strict.conf: set incorrect-conf-sec-order - from "error" to "ok" - -2017-08-11 Edward Hart - - * general: moved all register definitions to the words files. - * general: added unimplemented registers as reserved words. - -2017-08-07 Simon Sobisch - - * default.conf: set entry-statement from "obsolete" to "ok" - -2017-08-06 Simon Sobisch - - * lax.conf-inc: odo-without-to and incorrect-conf-sec-order set to - "at least warning" instead of "ok" - -2017-07-29 Edward Hart - - * bs2000-strict.conf: further corrections. - -2017-07-26 Edward Hart - - * mf.words: updated to Visual COBOL 3.0. - * bs2000-strict.conf: corrected using actual COBOL2000 manual. - -2017-07-20 Simon Sobisch - - * general: allow GnuCOBOL specific registers for lax dialect - configurations - -2017-07-18 Simon Sobisch - - * default.conf: set word-length to most unrestrictive value: 61 - -2017-07-13 Simon Sobisch - - * general: added move-figurative-constant-to-numeric and - move-figurative-quote-to-numeric option - -2017-07-12 Simon Sobisch - - * general: added settings for registers. mnemonic names and - intrinsic functions - * acu.conf: added (non-standard) mnemonic names for switches - -2017-07-03 Simon Sobisch - - * general: added constant-folding option - * general: renamed acucobol-literals option to acu-literals - -2017-07-02 Ron Norman - - * mf.conf: corrected to have synchronized-clause: ignore - -2017-06-29 Simon Sobisch - - * general: created a "strict" set of vendor dialect configurations, - made "normal" vendor dialect configurations lax by allowing *all* - words GnuCOBOL can handle *additional* to the not-implemented - vendor specific extensions and by allowing use of most features - Note: COBOL85, COBOL2002 and COBOL2014 are always "strict" - -2017-06-22 Simon Sobisch - - * general: moved reserved words list from conf files to seperate files, - replaced "specify-all-reserved" option by "reserved-words" - (special include file); - reviewed all word lists, defining aliases where needed and removing - mnemonic devices / special registers - -2017-06-12 Simon Sobisch - - * general: renamed "debugging-line" option to "debugging-mode" - -2017-06-07 Simon Sobisch - - * general: added define-constant-directive option - -2017-06-05 Edward Hart - - * general: added incorrect-conf-sec-order option - -2017-06-04 Simon Sobisch - - * general: renamed eject-statement to listing-statements, - added title-statement - -2017-06-04 Edward Hart - - * rm.conf: added config file for RM-COBOL - -2017-05-22 Ron Norman - - * mf.conf: corrected to have pretty-display: yes - -2017-05-13 Edward Hart - - * general: added numeric-value-for-edited-item - -2017-04-26 Ron Norman - - * general: added 'constant-78' to indicate if 78 is allowed and - 'constant-01' to indicate if 01 CONSTANT is allowed - -2017-04-22 Edward Hart - - * general: added stop-identifier config option - -2016-12-26 Simon Sobisch - - * runtime.conf: FR #191 added COB_EXIT_WAIT and COB_EXIT_MSG - -2016-12-16 Simon Sobisch - - * acu.conf, mf.conf: removed CONSOLE as it is internally used as - mnemonic device and therefore should not be in reserved list - * mf.conf: added COMMAND-LINE as it is in parser - -2016-11-19 Edward Hart - - * general: added use-for-debugging config option - -2016-10-25 Simon Sobisch - - * general: FR #179 added reference-out-of-declaratives option - -2016-10-13 Ron Norman - - * general: added arithmetic-osvs option - -2016-10-02 Edward Hart - - * general: added no-echo-means-secure option - * acu.conf: added aliases for ACCEPT/DISPLAY clauses - -2016-09-27 Simon Sobisch - - * general: FR #173 added pic-length configuration option - -2016-08-30 Simon Sobisch - - * general: added national-literals, hexadecimal-national-literals and - hexadecimal-boolean configuration options - -2016-08-13 Frank Swarbrick - - * ibm.conf, mf.conf: patch #50 added UNBOUNDED as context sensitive keyword - -2016-08-11 Simon Sobisch - - * general: renamed relaxed-syntax-check to relax-syntax-checks - for supporting the removed -frelax-syntax when set on command line - -2016-08-09 Edward Hart - - * general: added program-name-redefinition and program-prototypes - configuration options - -2016-07-27 Edward Hart - - * general: added renames-uncommon-levels configuration option - -2016-07-18 Edward Hart - - * general: added accept-display-extensions and console-is-crt - configuration options - -2016-06-14 Edward Hart - - * general: moved uncommon aliases from reserved.c to config files - -2016-06-03 Edward Hart - - * general: added not-exception-before-exception configuration option. - -2016-04-24 Edward Hart - - * general: added recording-modes as context-sensitive words. - -2016-03-18 Edward Hart - - * general: updated comment for reserved to describe how to specify - aliases - -2016-03-13 Simon Sobisch - - * acu.conf: added ASSIGN TO devices as context-sensitive words - -2016-03-09 Edward Hart - - * general: added/marked context-sensitive words - -2016-02-28 Edward Hart - - * general: added reserved and specify-all-reserved - * general: removed cobol85-reserved - -2015-12-18 Simon Sobisch - - * general: added call-overflow - -2015-10-25 Simon Sobisch - - * runtime.cfg: update for documentation - * runtime_empty.cfg: new empty file for faster startup (used in testsuite) - -2015-09-23 Edward Hart - - * general: added numeric-boolean and acu-literals - -2015-07-07 Ron Norman - - * runtime.cfg: added COBPRINTER and COB_DISPLAY_PRINTER - -2015-07-06 Simon Sobisch - - * cobol2014.conf: added new configuration for COBOL 2014 (most values - marked as not verified yet) - * general: added literal-length, numeric-literal-length - -2015-03-14 Ron Norman - - * runtime.cfg: added all configuration options with documentation - -2015-03-10 Simon Sobisch - - * runtime.cfg: added new configuration type "runtime configuration", - runtime.cfg will include all runtime flags and short documentation - of these (TODO) - -2014-10-29 Simon Sobisch - - * acu.conf: added new configuration for ACUCOBOL-GT (most values marked as - not verified yet) - * general: added word-length - -2014-07-29 Simon Sobisch - - * general: added accept-update and accept-auto (set to "no" in all - configuration files) - -2010-06-28 Roger While - - * MARK - Version 2.0 - * Move to GPL/LGPL 3 - * add information about config options in config/xyz.conf while removing - include of default.conf (every conf file now contains all configuration - entries) - -2007-12-27 Roger While - - * Mark 1.0 RELEASE - -2007-08-23 Roger While - - * Remove deprecated v023.conf - Remove display-sign - -2007-01-29 Roger While - - * Add odo-without-to, default OK, set to unconformable - for 85/2002 - -2006-09-30 Roger While - - * All conf's : Make filename-mapping default - -2006-02-02 Roger While - - * Add relax-level-hierarchy to ibm.conf, mvs.conf, - mf.conf, bs2000.conf - -2006-01-20 Roger While - - * Add relax-level-hierarchy to default.conf - Allows mismatched level numbers - -2005-12-18 Roger While - - * Add perform-osvs, sticky-linkage to ibm.conf, mvs.conf - -2005-11-25 Roger While - - * New variable - sticky-linkage - New config file - bs2000.conf - -2005-11-05 Roger While - - * New variable - perform-osvs - -2005-05-15 Roger While - - * Do not nest includes. All config files include - default.conf. We will need this for individual - "not-resrved" words. - -2005-05-12 Roger While - - * Revert cobol2002.conf - -2005-05-03 Roger While - - * default.conf, cobol2002.conf, mf.conf - New variable - larger-redefines-ok - New variable - relaxed-syntax-check - -2005-03-07 Roger While - - * default.conf, mvs.conf : - New variable - not-reserved - Document in default.conf - CYCLE as not reserved in mvs.conf - -2003-08-30 Keisuke Nishida - - * gnu.conf: Removed. - * default.conf: Renamed from default.inc. - -2003-08-28 Keisuke Nishida - - * v023.conf: New file. - -2003-08-09 Keisuke Nishida - - * gnu.conf, cobol85.conf, cobol2002.conf, mf.conf, mvs.conf: New files. - * default.inc, Makefile.am: New files. - - -Copyright 2003,2005-2007-2010,2014-2020 Free Software Foundation, Inc. - -Copying and distribution of this file, with or without modification, are -permitted provided the copyright notice and this notice are preserved. diff -Nru gnucobol-4.0~early~20200606/config/cobol2002.conf gnucobol-5/config/cobol2002.conf --- gnucobol-4.0~early~20200606/config/cobol2002.conf 2020-06-06 20:52:02.000000000 +0000 +++ gnucobol-5/config/cobol2002.conf 1970-01-01 00:00:00.000000000 +0000 @@ -1,264 +0,0 @@ -# GnuCOBOL compiler configuration -# -# Copyright (C) 2001-2012, 2014-2020 Free Software Foundation, Inc. -# Written by Keisuke Nishida, Roger While, Simon Sobisch, Edward Hart, -# Ron Norman -# -# This file is part of GnuCOBOL. -# -# The GnuCOBOL compiler is free software: you can redistribute it -# and/or modify it under the terms of the GNU General Public License -# as published by the Free Software Foundation, either version 3 of the -# License, or (at your option) any later version. -# -# GnuCOBOL is distributed in the hope that it will be useful, -# but WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -# GNU General Public License for more details. -# -# You should have received a copy of the GNU General Public License -# along with GnuCOBOL. If not, see . - - -# Value: any string -name: "COBOL 2002" - -# Value: enum -standard-define 8 -# CB_STD_OC = 0, -# CB_STD_MF, -# CB_STD_IBM, -# CB_STD_MVS, -# CB_STD_BS2000, -# CB_STD_ACU, -# CB_STD_85, -# CB_STD_2002, -# CB_STD_2014 - -# Value: int -tab-width: 8 -text-column: 72 -word-length: 31 -literal-length: 160 -numeric-literal-length: 31 -pic-length: 50 - -# Default assign type -# Value: 'dynamic', 'external' -assign-clause: dynamic # TO-DO: Verify! - -# If yes, file names are resolved at run time using -# environment variables. -# For example, given ASSIGN TO "DATAFILE", the file name will be -# 1. the value of environment variable 'DD_DATAFILE' or -# 2. the value of environment variable 'dd_DATAFILE' or -# 3. the value of environment variable 'DATAFILE' or -# 4. the literal "DATAFILE" -# If no, the value of the assign clause is the file name. -# -filename-mapping: yes - -# Alternate formatting of numeric fields -pretty-display: yes - -# Allow complex OCCURS DEPENDING ON -complex-odo: no - -# Allow REDEFINES to other than last equal level number -indirect-redefines: no - -# Binary byte size - defines the allocated bytes according to PIC -# Value: signed unsigned bytes -# ------ -------- ----- -# '2-4-8' 1 - 4 same 2 -# 5 - 9 same 4 -# 10 - 18 same 8 -# -# '1-2-4-8' 1 - 2 same 1 -# 3 - 4 same 2 -# 5 - 9 same 4 -# 10 - 18 same 8 -# -# '1--8' 1 - 2 1 - 2 1 -# 3 - 4 3 - 4 2 -# 5 - 6 5 - 7 3 -# 7 - 9 8 - 9 4 -# 10 - 11 10 - 12 5 -# 12 - 14 13 - 14 6 -# 15 - 16 15 - 16 7 -# 17 - 18 17 - 18 8 -# -binary-size: 1-2-4-8 - -# Numeric truncation according to ANSI -binary-truncate: yes - -# Binary byte order -# Value: 'native', 'big-endian' -binary-byteorder: big-endian - -# Allow larger REDEFINES items -larger-redefines-ok: no - -# Allow certain syntax variations (eg. REDEFINES position) -relax-syntax-checks: no - -# Perform type OSVS - If yes, the exit point of any currently -# executing perform is recognized if reached. -perform-osvs: no - -# Compute intermediate decimal results like IBM OSVS -arithmetic-osvs: no - -# MOVE like IBM (mvc); left to right, byte by byte -move-ibm: no - -# If yes, linkage-section items remain allocated -# between invocations. -sticky-linkage: no - -# If yes, allow non-matching level numbers -relax-level-hierarchy: no - -# If yes, evaluate constant expressions at compile time -constant-folding: yes - -# Allow Hex 'F' for NUMERIC test of signed PACKED DECIMAL field -hostsign: no - -# If yes, set WITH UPDATE clause as default for ACCEPT dest-item, -# except if WITH NO UPDATE clause is used -accept-update: no - -# If yes, set WITH AUTO clause as default for ACCEPT dest-item, -# except if WITH TAB clause is used -accept-auto: no - -# If yes, DISPLAYs and ACCEPTs are, by default, done on the CRT (i.e., using -# curses). -console-is-crt: no - -# If yes, allow redefinition of the current program's name. This prevents its -# use in a prototype-format CALL/CANCEL statement. -program-name-redefinition: no - -# If yes, NO ECHO/NO-ECHO/OFF is the same as SECURE (hiding input with -# asterisks, not spaces). -no-echo-means-secure: no - -# If yes, the first item in a field screen ACCEPT/DISPLAY (e.g. DISPLAY x UPON -# CRT) is located after the previous ACCEPT/DISPLAY (as though LINE 0 COL 0 had -# been specified). -line-col-zero-default: no - -# If yes, then REPORT, COLUMN may have any of PLUS num, + num, or +num -# to define a relative column position -report-column-plus: no - -# If yes, DISPLAY SPACES acts as ERASE EOS, DISPLAY X"01" acts as ERASE EOL, -# DISPLAY X"02" acts as BLANK SCREEEN and DISPLAY X"07" acts as BELL. Note -# DISPLAY LOW-VALUE is excluded from this; it will always just position the -# cursor. -display-special-fig-consts: no - -# If yes, COMP-1 is a signed 16-bit integer and any PICTURE clause is ignored. -binary-comp-1: no - -# auto-adjust to zero like MicroFocus does -move-non-numeric-lit-to-numeric-is-zero: no - -# If yes, implicitly define a variable for an ASSIGN DYNAMIC which does not -# match an existing data item. -implicit-assign-dynamic-var: no - -# What rules to apply to SCREEN SECTION items clauses -screen-section-rules: std - -# Dialect features -# Value: 'ok', 'warning', 'archaic', 'obsolete', 'skip', 'ignore', 'error', -# 'unconformable' - -alter-statement: unconformable -comment-paragraphs: unconformable -call-overflow: archaic -data-records-clause: unconformable -debugging-mode: obsolete -use-for-debugging: unconformable -listing-statements: skip # may be a user-defined word -title-statement: skip # may be a user-defined word -entry-statement: unconformable -goto-statement-without-name: unconformable -label-records-clause: unconformable -memory-size-clause: unconformable -move-noninteger-to-alphanumeric: error -move-figurative-constant-to-numeric: archaic -move-figurative-space-to-numeric: error -move-figurative-quote-to-numeric: archaic -multiple-file-tape-clause: unconformable -next-sentence-phrase: archaic -odo-without-to: unconformable -padding-character-clause: obsolete -section-segments: unconformable -stop-literal-statement: unconformable -stop-identifier-statement: unconformable -same-as-clause: ok -synchronized-clause: ok -sync-left-right: ok -special-names-clause: error -top-level-occurs-clause: skip -value-of-clause: unconformable -numeric-boolean: ok -hexadecimal-boolean: ok -national-literals: ok -hexadecimal-national-literals: ok -national-character-literals: unconformable -acu-literals: unconformable -hp-octal-literals: unconformable -word-continuation: archaic -depending-on-not-fixed: ok -length-in-data-division: yes -occurs-max-length-without-subscript: no -not-exception-before-exception: ok -accept-display-extensions: unconformable -renames-uncommon-levels: unconformable -symbolic-constant: unconformable -constant-78: unconformable -constant-01: ok -perform-varying-without-by: ok -reference-out-of-declaratives: error -reference-bounds-check: error -program-prototypes: ok -call-convention-mnemonic: unconformable -call-convention-linkage: unconformable -numeric-value-for-edited-item: error -incorrect-conf-sec-order: error -define-constant-directive: error -free-redefines-position: unconformable -records-mismatch-record-clause: error -record-delimiter: ok -sequential-delimiters: ok -record-delim-with-fixed-recs: unconformable -missing-statement: error -zero-length-literals: unconformable -xml-generate-extra-phrases: unconformable -continue-after: unconformable -goto-entry: unconformable -binary-sync-clause: ignore -nonnumeric-with-numeric-group-usage: ok -assign-variable: unconformable -assign-using-variable: ok -assign-ext-dyn: unconformable -assign-disk-from: unconformable -align-record: 0 -align-opt: no - - -# archaic in COBOL2002 and currently not available as dialect features: -# 1: MOVE of alphanumeric figurative constants to numeric items -# 2: Identifier-n (text-n) in a COPY statement. - -# obsolete in COBOL2002 and currently not available as dialect features: -# Communication facility - -# use fixed word list, synonyms and exceptions specified there -reserved-words: COBOL2002 diff -Nru gnucobol-4.0~early~20200606/config/cobol2002.words gnucobol-5/config/cobol2002.words --- gnucobol-4.0~early~20200606/config/cobol2002.words 2020-06-06 20:52:02.000000000 +0000 +++ gnucobol-5/config/cobol2002.words 1970-01-01 00:00:00.000000000 +0000 @@ -1,605 +0,0 @@ -# GnuCOBOL compiler - list of reserved words -# -# Copyright (C) 2016-2017 Free Software Foundation, Inc. -# Written by Simon Sobisch, Edward Hart -# -# This file is part of GnuCOBOL. -# -# The GnuCOBOL compiler is free software: you can redistribute it -# and/or modify it under the terms of the GNU General Public License -# as published by the Free Software Foundation, either version 3 of the -# License, or (at your option) any later version. -# -# GnuCOBOL is distributed in the hope that it will be useful, -# but WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -# GNU General Public License for more details. -# -# You should have received a copy of the GNU General Public License -# along with GnuCOBOL. If not, see . - - -# Word list for dialect: COBOL 2002 - -# Note: only used for strict dialect and when -# requested by compiler directive >> IMP WORDS COBOL2002 -# the default reserved word list will not be used. - -# Value: Word to make up reserved words list (case independent) -# All reserved entries listed will replace entire default reserved words list. -# Words ending with * will be treated as context-sensitive words. This will be -# ignored if GnuCOBOL uses that word as a reserved word. -# Entries of the form word-1=word-2 define word-1 as an alias for default -# reserved word word-2. No spaces are allowed around the equal sign. -reserved: ACCEPT -reserved: ACCESS -reserved: ACTIVE-CLASS -reserved: ADD -reserved: ADDRESS -reserved: ADVANCING -reserved: AFTER -reserved: ALIGNED -reserved: ALL -reserved: ALLOCATE -reserved: ALPHABET -reserved: ALPHABETIC -reserved: ALPHABETIC-LOWER -reserved: ALPHABETIC-UPPER -reserved: ALPHANUMERIC -reserved: ALPHANUMERIC-EDITED -reserved: ALSO -reserved: ALTERNATE -reserved: AND -reserved: ANY -reserved: ANYCASE -reserved: ARE -reserved: AREA -reserved: AREAS -reserved: ARITHMETIC* -reserved: AS -reserved: ASCENDING -reserved: ASSIGN -reserved: AT -reserved: ATTRIBUTE* -reserved: AUTO* -reserved: AUTOMATIC* -reserved: B-AND -reserved: B-NOT -reserved: B-OR -reserved: B-XOR -reserved: BACKGROUND-COLOR* -reserved: BASED -reserved: BEFORE -reserved: BELL* -reserved: BINARY -reserved: BINARY-CHAR -reserved: BINARY-DOUBLE -reserved: BINARY-LONG -reserved: BINARY-SEQUENTIAL* # implementor RECORD DELIMITER word -reserved: BINARY-SHORT -reserved: BIT -reserved: BLANK -reserved: BLINK* -reserved: BLOCK -reserved: BOOLEAN -reserved: BOTTOM -reserved: BY -reserved: BYTE-LENGTH* -reserved: CALL -reserved: CANCEL -reserved: CD -reserved: CENTER* -reserved: CF -reserved: CH -reserved: CHARACTER -reserved: CHARACTERS -reserved: CLASS -reserved: CLASS-ID -reserved: CLASSIFICATION* -reserved: CLOCK-UNITS -reserved: CLOSE -reserved: COBOL -reserved: CODE -reserved: CODE-SET -reserved: COL -reserved: COLLATING -reserved: COLS -reserved: COLUMN -reserved: COLUMNS -reserved: COMMA -reserved: COMMON -reserved: COMMUNICATION -reserved: COMP -reserved: COMPUTATIONAL -reserved: COMPUTE -reserved: CONDITION -reserved: CONFIGURATION -reserved: CONSTANT -reserved: CONTAINS -reserved: CONTENT -reserved: CONTINUE -reserved: CONTROL -reserved: CONTROLS -reserved: CONVERTING -reserved: COPY -reserved: CORR -reserved: CORRESPONDING -reserved: COUNT -reserved: CRT -reserved: CURRENCY -reserved: CURSOR -reserved: CYCLE* -reserved: DATA -reserved: DATA-POINTER -reserved: DATE -reserved: DAY -reserved: DAY-OF-WEEK -reserved: DE -reserved: DEBUGGING -reserved: DECIMAL-POINT -reserved: DECLARATIVES -reserved: DEFAULT -reserved: DELETE -reserved: DELIMITED -reserved: DELIMITER -reserved: DEPENDING -reserved: DESCENDING -reserved: DESTINATION -reserved: DETAIL -reserved: DISABLE -reserved: DISPLAY -reserved: DIVIDE -reserved: DIVISION -reserved: DOWN -reserved: DUPLICATES -reserved: DYNAMIC -reserved: EC -reserved: EGI -reserved: ELSE -reserved: EMI -reserved: ENABLE -reserved: END -reserved: END-ACCEPT -reserved: END-ADD -reserved: END-CALL -reserved: END-COMPUTE -reserved: END-DELETE -reserved: END-DISPLAY -reserved: END-DIVIDE -reserved: END-EVALUATE -reserved: END-IF -reserved: END-MULTIPLY -reserved: END-OF-PAGE -reserved: END-PERFORM -reserved: END-READ -reserved: END-RECEIVE -reserved: END-RETURN -reserved: END-REWRITE -reserved: END-SEARCH -reserved: END-START -reserved: END-STRING -reserved: END-SUBTRACT -reserved: END-UNSTRING -reserved: END-WRITE -reserved: ENTRY-CONVENTION* -reserved: ENVIRONMENT -reserved: EO -reserved: EOL* -reserved: EOP -reserved: EOS* -reserved: EQUAL -reserved: ERASE* -reserved: ERROR -reserved: ESI -reserved: EVALUATE -reserved: EVERY -reserved: EXCEPTION -reserved: EXCEPTION-OBJECT -reserved: EXIT -reserved: EXPANDS* -reserved: EXTEND -reserved: EXTERNAL -reserved: FACTORY -reserved: FALSE -reserved: FD -reserved: FILE -reserved: FILE-CONTROL -reserved: FILLER -reserved: FINAL -reserved: FIRST -reserved: FLOAT-BINARY* -reserved: FLOAT-BINARY-128 -reserved: FLOAT-BINARY-32 -reserved: FLOAT-BINARY-64 -reserved: FLOAT-DECIMAL* -reserved: FLOAT-DECIMAL-16 -reserved: FLOAT-DECIMAL-34 -reserved: FLOAT-EXTENDED -reserved: FLOAT-LONG -reserved: FLOAT-SHORT -reserved: FOOTING -reserved: FOR -reserved: FOREGROUND-COLOR* -reserved: FOREVER* -reserved: FORMAT -reserved: FREE -reserved: FROM -reserved: FULL* -reserved: FUNCTION -reserved: FUNCTION-ID -reserved: GENERATE -reserved: GET -reserved: GIVING -reserved: GLOBAL -reserved: GO -reserved: GOBACK -reserved: GREATER -reserved: GROUP -reserved: GROUP-USAGE -reserved: HEADING -reserved: HIGH-VALUE -reserved: HIGH-VALUES=HIGH-VALUE -reserved: HIGHLIGHT* -reserved: I-O -reserved: I-O-CONTROL -reserved: IDENTIFICATION -reserved: IF -reserved: IGNORING* -reserved: IMPLEMENTS* -reserved: IN -reserved: INDEX -reserved: INDEXED -reserved: INDICATE -reserved: INHERITS -reserved: INITIAL -reserved: INITIALIZE -reserved: INITIALIZED* -reserved: INITIATE -reserved: INPUT -reserved: INPUT-OUTPUT -reserved: INSPECT -reserved: INTERFACE -reserved: INTERFACE-ID -reserved: INTO -reserved: INTRINSIC* -reserved: INVALID -reserved: INVOKE -reserved: IS -reserved: JUST -reserved: JUSTIFIED -reserved: KEY -reserved: LAST -reserved: LC_ALL* -reserved: LC_COLLATE* -reserved: LC_CTYPE* -reserved: LC_MESSAGES* -reserved: LC_MONETARY* -reserved: LC_NUMERIC* -reserved: LC_TIME* -reserved: LEADING -reserved: LEFT -reserved: LENGTH -reserved: LESS -reserved: LIMIT -reserved: LIMITS -reserved: LINAGE -reserved: LINAGE-COUNTER -reserved: LINE -reserved: LINE-COUNTER -reserved: LINE-SEQUENTIAL* # implementor RECORD DELIMITER word -reserved: LINES -reserved: LINKAGE -reserved: LOCAL-STORAGE -reserved: LOCALE -reserved: LOCK -reserved: LOW-VALUE -reserved: LOW-VALUES=LOW-VALUE -reserved: LOWLIGHT* -reserved: MANUAL* -reserved: MERGE -reserved: MESSAGE -reserved: METHOD -reserved: METHOD-ID -reserved: MINUS -reserved: MODE -reserved: MODULES -reserved: MOVE -reserved: MULTIPLE* -reserved: MULTIPLY -reserved: NATIONAL -reserved: NATIONAL-EDITED -reserved: NATIVE -reserved: NEGATIVE -reserved: NEGATIVE-INFINITY -reserved: NESTED -reserved: NEXT -reserved: NO -reserved: NONE* -reserved: NORMAL* -reserved: NOT -reserved: NULL -reserved: NUMBER -reserved: NUMBERS* -reserved: NUMERIC -reserved: NUMERIC-EDITED -reserved: OBJECT -reserved: OBJECT-COMPUTER -reserved: OBJECT-REFERENCE -reserved: OCCURS -reserved: OF -reserved: OFF -reserved: OMITTED -reserved: ON -reserved: ONLY* -reserved: OPEN -reserved: OPTIONAL -reserved: OPTIONS -reserved: OR -reserved: ORDER -reserved: ORGANIZATION -reserved: OTHER -reserved: OUTPUT -reserved: OVERFLOW -reserved: OVERRIDE -reserved: PACKED-DECIMAL -reserved: PADDING -reserved: PAGE -reserved: PAGE-COUNTER -reserved: PARAGRAPH* -reserved: PERFORM -reserved: PF -reserved: PH -reserved: PIC=PICTURE -reserved: PICTURE -reserved: PLUS -reserved: POINTER -reserved: POSITION -reserved: POSITIVE -reserved: POSITIVE-INFINITY -reserved: PRESENT -reserved: PREVIOUS* -reserved: PRINTING -reserved: PROCEDURE -reserved: PROCEDURES -reserved: PROCEED -reserved: PROGRAM -reserved: PROGRAM-ID -reserved: PROGRAM-POINTER -reserved: PROPERTY -reserved: PROTOTYPE -reserved: PURGE -reserved: QUEUE -reserved: QUOTE -reserved: QUOTES -reserved: RAISE -reserved: RAISING -reserved: RANDOM -reserved: RD -reserved: READ -reserved: RECEIVE -reserved: RECORD -reserved: RECORDS -reserved: RECURSIVE* -reserved: REDEFINES -reserved: REEL -reserved: REFERENCE -reserved: REFERENCES -reserved: RELATION* -reserved: RELATIVE -reserved: RELEASE -reserved: REMAINDER -reserved: REMOVAL -reserved: RENAMES -reserved: REPLACE -reserved: REPLACING -reserved: REPORT -reserved: REPORT -reserved: REPORTING -reserved: REPOSITORY -reserved: REQUIRED* -reserved: RESERVE -reserved: RESET -reserved: RESUME -reserved: RETRY -reserved: RETURN -reserved: RETURNING -reserved: REVERSE-VIDEO* -reserved: REWIND -reserved: REWRITE -reserved: RF -reserved: RH -reserved: RIGHT -reserved: ROUNDED -reserved: RUN -reserved: SAME -reserved: SCREEN -reserved: SD -reserved: SEARCH -reserved: SECONDS* -reserved: SECTION -reserved: SECURE* -reserved: SEGMENT -reserved: SEGMENT-LIMIT -reserved: SELECT -reserved: SELF -reserved: SEND -reserved: SENTENCE -reserved: SEPARATE -reserved: SEQUENCE -reserved: SEQUENTIAL -reserved: SET -reserved: SHARING -reserved: SIGN -reserved: SIGNED* -reserved: SIZE -reserved: SORT -reserved: SORT-MERGE -reserved: SOURCE -reserved: SOURCE-COMPUTER -reserved: SOURCES -reserved: SPACE -reserved: SPACES=SPACE -reserved: SPECIAL-NAMES -reserved: STANDARD -reserved: STANDARD-1 -reserved: STANDARD-2 -reserved: START -reserved: STATEMENT* -reserved: STATUS -reserved: STEP* -reserved: STOP -reserved: STRING -reserved: STRONG* -reserved: SUB-QUEUE-1 -reserved: SUB-QUEUE-2 -reserved: SUB-QUEUE-3 -reserved: SUBTRACT -reserved: SUM -reserved: SUPER -reserved: SUPPRESS -reserved: SYMBOL* -reserved: SYMBOLIC -reserved: SYNC -reserved: SYNCHRONIZED -reserved: SYSTEM-DEFAULT -reserved: TABLE -reserved: TALLYING -reserved: TERMINAL -reserved: TERMINATE -reserved: TEST -reserved: TEXT -reserved: THAN -reserved: THEN -reserved: THROUGH -reserved: THRU -reserved: TIME -reserved: TIMES -reserved: TO -reserved: TOP -reserved: TRAILING -reserved: TRUE -reserved: TYPE -reserved: TYPEDEF -reserved: UCS-4* -reserved: UNDERLINE* -reserved: UNIT -reserved: UNIVERSAL -reserved: UNLOCK -reserved: UNSIGNED* -reserved: UNSTRING -reserved: UNTIL -reserved: UP -reserved: UPON -reserved: USAGE -reserved: USE -reserved: USER-DEFAULT -reserved: USING -reserved: UTF-16* -reserved: UTF-8* -reserved: VAL-STATUS -reserved: VALID -reserved: VALIDATE -reserved: VALIDATE-STATUS -reserved: VALUE -reserved: VALUES=VALUE -reserved: VARYING -reserved: WHEN -reserved: WITH -reserved: WORDS -reserved: WORKING-STORAGE -reserved: WRITE -reserved: YYYYDDD* -reserved: YYYYMMDD* -reserved: ZERO -reserved: ZEROES=ZERO -reserved: ZEROS=ZERO - - -not-register: DIALECT-ALL # disable all registers, specify used below -register: "ADDRESS\ OF" # not yet handled as register in GnuCOBOL -#register: "DEBUG-ITEM" # not yet handled as register in GnuCOBOL -#register: "LINAGE-COUNTER" # not yet handled as register in GnuCOBOL -#register: "LINE-COUNTER" # not yet handled as register in GnuCOBOL -#register: "PAGE-COUNTER" # not yet handled as register in GnuCOBOL - - -# intrinsic functions - -not-intrinsic-function: DIALECT-ALL -intrinsic-function: ABS -intrinsic-function: ACOS -intrinsic-function: ANNUITY -intrinsic-function: ASIN -intrinsic-function: ATAN -intrinsic-function: BOOLEAN-OF-INTEGER -intrinsic-function: BYTE-LENGTH -intrinsic-function: CHAR -intrinsic-function: CHAR-NATIONAL -intrinsic-function: COS -intrinsic-function: CURRENT-DATE -intrinsic-function: DATE-OF-INTEGER -intrinsic-function: DATE-TO-YYYYMMDD -intrinsic-function: DAY-OF-INTEGER -intrinsic-function: DAY-TO-YYYYDDD -intrinsic-function: DISPLAY-OF -intrinsic-function: E -intrinsic-function: EXCEPTION-FILE -intrinsic-function: EXCEPTION-FILE-N -intrinsic-function: EXCEPTION-LOCATION -intrinsic-function: EXCEPTION-LOCATION-N -intrinsic-function: EXCEPTION-STATEMENT -intrinsic-function: EXCEPTION-STATUS -intrinsic-function: EXP -intrinsic-function: EXP10 -intrinsic-function: FACTORIAL -intrinsic-function: FRACTION-PART -intrinsic-function: HIGHEST-ALGEBRAIC -intrinsic-function: INTEGER -intrinsic-function: INTEGER-OF-BOOLEAN -intrinsic-function: INTEGER-OF-DATE -intrinsic-function: INTEGER-OF-DAY -intrinsic-function: INTEGER-PART -intrinsic-function: LENGTH -intrinsic-function: LOCALE-COMPARE -intrinsic-function: LOCALE-DATE -intrinsic-function: LOCALE-TIME -intrinsic-function: LOG -intrinsic-function: LOG10 -intrinsic-function: LOWER-CASE -intrinsic-function: LOWEST-ALGEBRAIC -intrinsic-function: MAX -intrinsic-function: MEAN -intrinsic-function: MEDIAN -intrinsic-function: MIDRANGE -intrinsic-function: MIN -intrinsic-function: MOD -intrinsic-function: NATIONAL-OF -intrinsic-function: NUMVAL -intrinsic-function: NUMVAL-C -intrinsic-function: NUMVAL-F -intrinsic-function: ORD -intrinsic-function: ORD-MAX -intrinsic-function: ORD-MIN -intrinsic-function: PI -intrinsic-function: PRESENT-VALUE -intrinsic-function: RANDOM -intrinsic-function: RANGE -intrinsic-function: REM -intrinsic-function: REVERSE -intrinsic-function: SIGN -intrinsic-function: SIN -intrinsic-function: SQRT -intrinsic-function: STANDARD-COMPARE -intrinsic-function: STANDARD-DEVIATION -intrinsic-function: SUM -intrinsic-function: TAN -intrinsic-function: TEST-DATE-YYYYMMDD -intrinsic-function: TEST-DAY-YYYYDDD -intrinsic-function: TEST-NUMVAL -intrinsic-function: TEST-NUMVAL-C -intrinsic-function: TEST-NUMVAL-F -intrinsic-function: TRIM -intrinsic-function: UPPER-CASE -intrinsic-function: VARIANCE -intrinsic-function: WHEN-COMPILED -intrinsic-function: YEAR-TO-YYYY diff -Nru gnucobol-4.0~early~20200606/config/cobol2014.conf gnucobol-5/config/cobol2014.conf --- gnucobol-4.0~early~20200606/config/cobol2014.conf 2020-06-06 20:52:02.000000000 +0000 +++ gnucobol-5/config/cobol2014.conf 1970-01-01 00:00:00.000000000 +0000 @@ -1,256 +0,0 @@ -# GnuCOBOL compiler configuration -# -# Copyright (C) 2001-2012, 2014-2020 Free Software Foundation, Inc. -# Written by Keisuke Nishida, Roger While, Simon Sobisch, Edward Hart, -# Ron Norman -# -# This file is part of GnuCOBOL. -# -# The GnuCOBOL compiler is free software: you can redistribute it -# and/or modify it under the terms of the GNU General Public License -# as published by the Free Software Foundation, either version 3 of the -# License, or (at your option) any later version. -# -# GnuCOBOL is distributed in the hope that it will be useful, -# but WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -# GNU General Public License for more details. -# -# You should have received a copy of the GNU General Public License -# along with GnuCOBOL. If not, see . - - -# Value: any string -name: "COBOL 2014" - -# Value: enum -standard-define 9 -# CB_STD_OC = 0, -# CB_STD_MF, -# CB_STD_IBM, -# CB_STD_MVS, -# CB_STD_BS2000, -# CB_STD_ACU, -# CB_STD_85, -# CB_STD_2002, -# CB_STD_2014 - -# Value: int -tab-width: 8 -text-column: 72 -word-length: 31 -literal-length: 8191 -numeric-literal-length: 31 -pic-length: 63 - -# Default assign type -# Value: 'dynamic', 'external' -assign-clause: dynamic # TO-DO: Verify! - -# If yes, file names are resolved at run time using -# environment variables. -# For example, given ASSIGN TO "DATAFILE", the file name will be -# 1. the value of environment variable 'DD_DATAFILE' or -# 2. the value of environment variable 'dd_DATAFILE' or -# 3. the value of environment variable 'DATAFILE' or -# 4. the literal "DATAFILE" -# If no, the value of the assign clause is the file name. -# -filename-mapping: yes - -# Alternate formatting of numeric fields -pretty-display: yes - -# Allow complex OCCURS DEPENDING ON -complex-odo: no - -# Allow REDEFINES to other than last equal level number -indirect-redefines: no - -# Binary byte size - defines the allocated bytes according to PIC -# Value: signed unsigned bytes -# ------ -------- ----- -# '2-4-8' 1 - 4 same 2 -# 5 - 9 same 4 -# 10 - 18 same 8 -# -# '1-2-4-8' 1 - 2 same 1 -# 3 - 4 same 2 -# 5 - 9 same 4 -# 10 - 18 same 8 -# -# '1--8' 1 - 2 1 - 2 1 -# 3 - 4 3 - 4 2 -# 5 - 6 5 - 7 3 -# 7 - 9 8 - 9 4 -# 10 - 11 10 - 12 5 -# 12 - 14 13 - 14 6 -# 15 - 16 15 - 16 7 -# 17 - 18 17 - 18 8 -# -binary-size: 1-2-4-8 - -# Numeric truncation according to ANSI -binary-truncate: yes - -# Binary byte order -# Value: 'native', 'big-endian' -binary-byteorder: big-endian - -# Allow larger REDEFINES items -larger-redefines-ok: no - -# Allow certain syntax variations (eg. REDEFINES position) -relax-syntax-checks: no - -# Perform type OSVS - If yes, the exit point of any currently -# executing perform is recognized if reached. -perform-osvs: no - -# Compute intermediate decimal results like IBM OSVS -arithmetic-osvs: no - -# MOVE like IBM (mvc); left to right, byte by byte -move-ibm: no - -# If yes, linkage-section items remain allocated -# between invocations. -sticky-linkage: no - -# If yes, allow non-matching level numbers -relax-level-hierarchy: no - -# If yes, evaluate constant expressions at compile time -constant-folding: yes - -# Allow Hex 'F' for NUMERIC test of signed PACKED DECIMAL field -hostsign: no - -# If yes, set WITH UPDATE clause as default for ACCEPT dest-item, -# except if WITH NO UPDATE clause is used -accept-update: no - -# If yes, set WITH AUTO clause as default for ACCEPT dest-item, -# except if WITH TAB clause is used -accept-auto: no - -# If yes, DISPLAYs and ACCEPTs are, by default, done on the CRT (i.e., using -# curses). -console-is-crt: no - -# If yes, allow redefinition of the current program's name. This prevents its -# use in a prototype-format CALL/CANCEL statement. -program-name-redefinition: no - -# If yes, NO ECHO/NO-ECHO/OFF is the same as SECURE (hiding input with -# asterisks, not spaces). -no-echo-means-secure: no - -# If yes, the first item in a field screen ACCEPT/DISPLAY (e.g. DISPLAY x UPON -# CRT) is located after the previous ACCEPT/DISPLAY (as though LINE 0 COL 0 had -# been specified). -line-col-zero-default: no - -# If yes, then REPORT, COLUMN may have any of PLUS num, + num, or +num -# to define a relative column position -report-column-plus: no - -# If yes, DISPLAY SPACES acts as ERASE EOS, DISPLAY X"01" acts as ERASE EOL, -# DISPLAY X"02" acts as BLANK SCREEEN and DISPLAY X"07" acts as BELL. Note -# DISPLAY LOW-VALUE is excluded from this; it will always just position the -# cursor. -display-special-fig-consts: no - -# If yes, COMP-1 is a signed 16-bit integer and any PICTURE clause is ignored. -binary-comp-1: no - -# auto-adjust to zero like MicroFocus does -move-non-numeric-lit-to-numeric-is-zero: no - -# If yes, implicitly define a variable for an ASSIGN DYNAMIC which does not -# match an existing data item. -implicit-assign-dynamic-var: yes - -# What rules to apply to SCREEN SECTION items clauses -screen-section-rules: std - -# Dialect features -# Value: 'ok', 'warning', 'archaic', 'obsolete', 'skip', 'ignore', 'error', -# 'unconformable' - -alter-statement: unconformable -comment-paragraphs: unconformable -call-overflow: archaic -data-records-clause: unconformable -debugging-mode: unconformable -use-for-debugging: unconformable -listing-statements: skip # may be a user-defined word -title-statement: skip # may be a user-defined word -entry-statement: unconformable -goto-statement-without-name: unconformable -label-records-clause: unconformable -memory-size-clause: unconformable -move-noninteger-to-alphanumeric: error -symbolic-constant: unconformable -move-figurative-constant-to-numeric: archaic -move-figurative-space-to-numeric: error -move-figurative-quote-to-numeric: obsolete -multiple-file-tape-clause: unconformable -next-sentence-phrase: archaic -odo-without-to: unconformable -padding-character-clause: unconformable -section-segments: unconformable -stop-literal-statement: unconformable -stop-identifier-statement: unconformable -same-as-clause: ok -synchronized-clause: ok -sync-left-right: ok -special-names-clause: error -top-level-occurs-clause: skip -value-of-clause: unconformable -occurs-max-length-without-subscript: no -numeric-boolean: ok -hexadecimal-boolean: ok -national-literals: ok -hexadecimal-national-literals: ok -national-character-literals: unconformable -acu-literals: unconformable -hp-octal-literals: unconformable -word-continuation: archaic -length-in-data-division: yes -not-exception-before-exception: ok -depending-on-not-fixed: ok -accept-display-extensions: unconformable -renames-uncommon-levels: unconformable -constant-78: unconformable -constant-01: ok -perform-varying-without-by: ok -reference-out-of-declaratives: error -reference-bounds-check: error -program-prototypes: ok -call-convention-mnemonic: unconformable -call-convention-linkage: unconformable -numeric-value-for-edited-item: error -incorrect-conf-sec-order: error -define-constant-directive: error -free-redefines-position: unconformable -records-mismatch-record-clause: error -record-delimiter: ok -sequential-delimiters: ok -record-delim-with-fixed-recs: unconformable -missing-statement: error -zero-length-literals: ok -xml-generate-extra-phrases: unconformable -continue-after: unconformable -goto-entry: unconformable -binary-sync-clause: ignore -nonnumeric-with-numeric-group-usage: ok -assign-variable: unconformable -assign-using-variable: ok -assign-ext-dyn: unconformable -assign-disk-from: unconformable -align-record: 0 -align-opt: no - -# use fixed word list, synonyms and exceptions specified there -reserved-words: COBOL2014 diff -Nru gnucobol-4.0~early~20200606/config/cobol2014.words gnucobol-5/config/cobol2014.words --- gnucobol-4.0~early~20200606/config/cobol2014.words 2020-06-06 20:52:02.000000000 +0000 +++ gnucobol-5/config/cobol2014.words 1970-01-01 00:00:00.000000000 +0000 @@ -1,622 +0,0 @@ -# GnuCOBOL compiler - list of reserved words -# -# Copyright (C) 2016-2017 Free Software Foundation, Inc. -# Written by Simon Sobisch, Edward Hart -# -# This file is part of GnuCOBOL. -# -# The GnuCOBOL compiler is free software: you can redistribute it -# and/or modify it under the terms of the GNU General Public License -# as published by the Free Software Foundation, either version 3 of the -# License, or (at your option) any later version. -# -# GnuCOBOL is distributed in the hope that it will be useful, -# but WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -# GNU General Public License for more details. -# -# You should have received a copy of the GNU General Public License -# along with GnuCOBOL. If not, see . - - -# Word list for dialect: COBOL 2014 - -# Note: only used for strict dialect and when -# requested by compiler directive >> IMP WORDS COBOL2014 -# the default reserved word list will not be used. - -# Value: Word to make up reserved words list (case independent) -# All reserved entries listed will replace entire default reserved words list. -# Words ending with * will be treated as context-sensitive words. This will be -# ignored if GnuCOBOL uses that word as a reserved word. -# Entries of the form word-1=word-2 define word-1 as an alias for default -# reserved word word-2. No spaces are allowed around the equal sign. -reserved: ACCEPT -reserved: ACCESS -reserved: ACTIVE-CLASS -reserved: ADD -reserved: ADDRESS -reserved: ADVANCING -reserved: AFTER -reserved: ALIGNED -reserved: ALL -reserved: ALLOCATE -reserved: ALPHABET -reserved: ALPHABETIC -reserved: ALPHABETIC-LOWER -reserved: ALPHABETIC-UPPER -reserved: ALPHANUMERIC -reserved: ALPHANUMERIC-EDITED -reserved: ALSO -reserved: ALTERNATE -reserved: AND -reserved: ANY -reserved: ANYCASE -reserved: ARE -reserved: AREA -reserved: AREAS -reserved: ARITHMETIC* -reserved: AS -reserved: ASCENDING -reserved: ASSIGN -reserved: AT -reserved: ATTRIBUTE* -reserved: AUTO* -reserved: AUTOMATIC* -reserved: AWAY-FROM-ZERO* -reserved: B-AND -reserved: B-NOT -reserved: B-OR -reserved: B-XOR -reserved: BACKGROUND-COLOR* -reserved: BASED -reserved: BEFORE -reserved: BELL* -reserved: BINARY -reserved: BINARY-CHAR -reserved: BINARY-DOUBLE -reserved: BINARY-ENCODING* -reserved: BINARY-LONG -reserved: BINARY-SEQUENTIAL* # implementor RECORD DELIMITER word -reserved: BINARY-SHORT -reserved: BIT -reserved: BLANK -reserved: BLINK* -reserved: BLOCK -reserved: BOOLEAN -reserved: BOTTOM -reserved: BY -reserved: BYTE-LENGTH* -reserved: CALL -reserved: CANCEL -reserved: CAPACITY* -reserved: CENTER* -reserved: CF -reserved: CH -reserved: CHARACTER -reserved: CHARACTERS -reserved: CLASS -reserved: CLASS-ID -reserved: CLASSIFICATION* -reserved: CLOCK-UNITS -reserved: CLOSE -reserved: COBOL -reserved: CODE -reserved: CODE-SET -reserved: COL -reserved: COLLATING -reserved: COLS -reserved: COLUMN -reserved: COLUMNS -reserved: COMMA -reserved: COMMON -reserved: COMMUNICATION -reserved: COMP -reserved: COMPUTATIONAL -reserved: COMPUTE -reserved: CONDITION -reserved: CONFIGURATION -reserved: CONSTANT -reserved: CONTAINS -reserved: CONTENT -reserved: CONTINUE -reserved: CONTROL -reserved: CONTROLS -reserved: CONVERTING -reserved: COPY -reserved: CORR -reserved: CORRESPONDING -reserved: COUNT -reserved: CRT -reserved: CURRENCY -reserved: CURSOR -reserved: CYCLE* -reserved: DATA -reserved: DATA-POINTER -reserved: DATE -reserved: DAY -reserved: DAY-OF-WEEK -reserved: DE -reserved: DECIMAL-ENCODING* -reserved: DECIMAL-POINT -reserved: DECLARATIVES -reserved: DEFAULT -reserved: DELETE -reserved: DELIMITED -reserved: DELIMITER -reserved: DEPENDING -reserved: DESCENDING -reserved: DESTINATION -reserved: DETAIL -reserved: DISPLAY -reserved: DIVIDE -reserved: DIVISION -reserved: DOWN -reserved: DUPLICATES -reserved: DYNAMIC -reserved: EC -reserved: ELSE -reserved: END -reserved: END-ACCEPT -reserved: END-ADD -reserved: END-CALL -reserved: END-COMPUTE -reserved: END-DELETE -reserved: END-DISPLAY -reserved: END-DIVIDE -reserved: END-EVALUATE -reserved: END-IF -reserved: END-MULTIPLY -reserved: END-OF-PAGE -reserved: END-PERFORM -reserved: END-READ -reserved: END-RETURN -reserved: END-REWRITE -reserved: END-SEARCH -reserved: END-START -reserved: END-STRING -reserved: END-SUBTRACT -reserved: END-UNSTRING -reserved: END-WRITE -reserved: ENTRY-CONVENTION* -reserved: ENVIRONMENT -reserved: EO -reserved: EOL* -reserved: EOP -reserved: EOS* -reserved: EQUAL -reserved: ERASE* -reserved: ERROR -reserved: EVALUATE -reserved: EVERY -reserved: EXCEPTION -reserved: EXCEPTION-OBJECT -reserved: EXIT -reserved: EXPANDS* -reserved: EXTEND -reserved: EXTERNAL -reserved: FACTORY -reserved: FALSE -reserved: FARTHEST-FROM-ZERO -reserved: FD -reserved: FILE -reserved: FILE-CONTROL -reserved: FILLER -reserved: FINAL -reserved: FIRST -reserved: FLOAT-BINARY* -reserved: FLOAT-BINARY-128 -reserved: FLOAT-BINARY-32 -reserved: FLOAT-BINARY-64 -reserved: FLOAT-DECIMAL* -reserved: FLOAT-DECIMAL-16 -reserved: FLOAT-DECIMAL-34 -reserved: FLOAT-EXTENDED -reserved: FLOAT-INFINITY -reserved: FLOAT-LONG -reserved: FLOAT-NOT-A-NUMBER -reserved: FLOAT-NOT-A-NUMBER-QUIET -reserved: FLOAT-NOT-A-NUMBER-SIGNALING -reserved: FLOAT-SHORT -reserved: FOOTING -reserved: FOR -reserved: FOREGROUND-COLOR* -reserved: FOREVER* -reserved: FORMAT -reserved: FREE -reserved: FROM -reserved: FULL* -reserved: FUNCTION -reserved: FUNCTION-ID -reserved: FUNCTION-POINTER -reserved: GENERATE -reserved: GET -reserved: GIVING -reserved: GLOBAL -reserved: GO -reserved: GOBACK -reserved: GREATER -reserved: GROUP -reserved: GROUP-USAGE -reserved: HEADING -reserved: HIGH-ORDER-LEFT* -reserved: HIGH-ORDER-RIGHT* -reserved: HIGH-VALUE -reserved: HIGH-VALUES=HIGH-VALUE -reserved: HIGHLIGHT* -reserved: I-O -reserved: I-O-CONTROL -reserved: IDENTIFICATION -reserved: IF -reserved: IGNORING* -reserved: IMPLEMENTS* -reserved: IN -reserved: IN-ARITHMETIC-RANGE -reserved: INDEX -reserved: INDEXED -reserved: INDICATE -reserved: INHERITS -reserved: INITIAL -reserved: INITIALIZE -reserved: INITIALIZED* -reserved: INITIATE -reserved: INPUT -reserved: INPUT-OUTPUT -reserved: INSPECT -reserved: INTERFACE -reserved: INTERFACE-ID -reserved: INTERMEDIATE* -reserved: INTO -reserved: INTRINSIC* -reserved: INVALID -reserved: INVOKE -reserved: IS -reserved: JUST -reserved: JUSTIFIED -reserved: KEY -reserved: LAST -reserved: LC_ALL* -reserved: LC_COLLATE* -reserved: LC_CTYPE* -reserved: LC_MESSAGES* -reserved: LC_MONETARY* -reserved: LC_NUMERIC* -reserved: LC_TIME* -reserved: LEADING -reserved: LEFT -reserved: LENGTH -reserved: LESS -reserved: LIMIT -reserved: LIMITS -reserved: LINAGE -reserved: LINAGE-COUNTER -reserved: LINE -reserved: LINE-COUNTER -reserved: LINE-SEQUENTIAL* # implementor RECORD DELIMITER word -reserved: LINES -reserved: LINKAGE -reserved: LOCAL-STORAGE -reserved: LOCALE -reserved: LOCK -reserved: LOW-VALUE -reserved: LOW-VALUES=LOW-VALUE -reserved: LOWLIGHT* -reserved: MANUAL* -reserved: MERGE -reserved: METHOD -reserved: METHOD-ID -reserved: MINUS -reserved: MODE -reserved: MODULES -reserved: MOVE -reserved: MULTIPLE* -reserved: MULTIPLY -reserved: NATIONAL -reserved: NATIONAL-EDITED -reserved: NATIVE -reserved: NEAREST-AWAY-FROM-ZERO* -reserved: NEAREST-EVEN-INTERMEDIATE* -reserved: NEAREST-TO-ZERO -reserved: NEAREST-TOWARD-ZERO* -reserved: NEGATIVE -reserved: NEGATIVE-INFINITY -reserved: NESTED -reserved: NEXT -reserved: NO -reserved: NONE* -reserved: NORMAL* -reserved: NOT -reserved: NULL -reserved: NUMBER -reserved: NUMBERS* -reserved: NUMERIC -reserved: NUMERIC-EDITED -reserved: OBJECT -reserved: OBJECT-COMPUTER -reserved: OBJECT-REFERENCE -reserved: OCCURS -reserved: OF -reserved: OFF -reserved: OMITTED -reserved: ON -reserved: ONLY* -reserved: OPEN -reserved: OPTIONAL -reserved: OPTIONS -reserved: OR -reserved: ORDER -reserved: ORGANIZATION -reserved: OTHER -reserved: OUTPUT -reserved: OVERFLOW -reserved: OVERRIDE -reserved: PACKED-DECIMAL -reserved: PAGE -reserved: PAGE-COUNTER -reserved: PARAGRAPH* -reserved: PERFORM -reserved: PF -reserved: PH -reserved: PHYSICAL # only listed as argument for LENGTH FUNCTIONS... -reserved: PIC=PICTURE -reserved: PICTURE -reserved: PLUS -reserved: POINTER -reserved: POSITION -reserved: POSITIVE -reserved: POSITIVE-INFINITY -reserved: PREFIXED* -reserved: PRESENT -reserved: PREVIOUS* -reserved: PRINTING -reserved: PROCEDURE -reserved: PROCEDURES -reserved: PROCEED -reserved: PROGRAM -reserved: PROGRAM-ID -reserved: PROGRAM-POINTER -reserved: PROHIBITED* -reserved: PROPERTY -reserved: PROTOTYPE -reserved: QUOTE -reserved: QUOTES -reserved: RAISE -reserved: RAISING -reserved: RANDOM -reserved: RD -reserved: READ -reserved: RECORD -reserved: RECORDS -reserved: RECURSIVE* -reserved: REDEFINES -reserved: REEL -reserved: REFERENCE -reserved: REFERENCES -reserved: RELATION* -reserved: RELATIVE -reserved: RELEASE -reserved: REMAINDER -reserved: REMOVAL -reserved: RENAMES -reserved: REPLACE -reserved: REPLACING -reserved: REPORT -reserved: REPORT -reserved: REPORTING -reserved: REPOSITORY -reserved: REQUIRED* -reserved: RESERVE -reserved: RESET -reserved: RESUME -reserved: RETRY -reserved: RETURN -reserved: RETURNING -reserved: REVERSE-VIDEO* -reserved: REWIND -reserved: REWRITE -reserved: RF -reserved: RH -reserved: RIGHT -reserved: ROUNDED -reserved: ROUNDING* -reserved: RUN -reserved: SAME -reserved: SCREEN -reserved: SD -reserved: SEARCH -reserved: SECONDS* -reserved: SECTION -reserved: SECURE* -reserved: SELECT -reserved: SELF -reserved: SENTENCE -reserved: SEPARATE -reserved: SEQUENCE -reserved: SEQUENTIAL -reserved: SET -reserved: SHARING -reserved: SHORT* -reserved: SIGN -reserved: SIGNED* -reserved: SIZE -reserved: SORT -reserved: SORT-MERGE -reserved: SOURCE -reserved: SOURCE-COMPUTER -reserved: SOURCES -reserved: SPACE -reserved: SPACES=SPACE -reserved: SPECIAL-NAMES -reserved: STANDARD -reserved: STANDARD-1 -reserved: STANDARD-2 -reserved: STANDARD-BINARY* -reserved: STANDARD-DECIMAL* -reserved: START -reserved: STATEMENT* -reserved: STATUS -reserved: STEP* -reserved: STOP -reserved: STRING -reserved: STRONG* -reserved: STRUCTURE* -reserved: SUBTRACT -reserved: SUM -reserved: SUPER -reserved: SUPPRESS -reserved: SYMBOL* -reserved: SYMBOLIC -reserved: SYNC -reserved: SYNCHRONIZED -reserved: SYSTEM-DEFAULT -reserved: TABLE -reserved: TALLYING -reserved: TERMINATE -reserved: TEST -reserved: THAN -reserved: THEN -reserved: THROUGH -reserved: THRU -reserved: TIME -reserved: TIMES -reserved: TO -reserved: TOP -reserved: TOWARD-GREATER* -reserved: TOWARD-LESSER* -reserved: TRAILING -reserved: TRUE -reserved: TRUNCATION* -reserved: TYPE -reserved: TYPEDEF -reserved: UCS-4* -reserved: UNDERLINE* -reserved: UNIT -reserved: UNIVERSAL -reserved: UNLOCK -reserved: UNSIGNED* -reserved: UNSTRING -reserved: UNTIL -reserved: UP -reserved: UPON -reserved: USAGE -reserved: USE -reserved: USER-DEFAULT -reserved: USING -reserved: UTF-16* -reserved: UTF-8* -reserved: VAL-STATUS -reserved: VALID -reserved: VALIDATE -reserved: VALIDATE-STATUS -reserved: VALUE -reserved: VALUES=VALUE -reserved: VARYING -reserved: WHEN -reserved: WITH -reserved: WORDS -reserved: WORKING-STORAGE -reserved: WRITE -reserved: YYYYDDD* -reserved: YYYYMMDD* -reserved: ZERO -reserved: ZEROES=ZERO -reserved: ZEROS=ZERO - - -not-register: DIALECT-ALL # disable all registers, specify used below -register: "ADDRESS\ OF" # not yet handled as register in GnuCOBOL -#register: "LINAGE-COUNTER" # not yet handled as register in GnuCOBOL -#register: "LINE-COUNTER" # not yet handled as register in GnuCOBOL -#register: "PAGE-COUNTER" # not yet handled as register in GnuCOBOL - - -# intrinsic functions - -not-intrinsic-function: DIALECT-ALL -intrinsic-function: ABS -intrinsic-function: ACOS -intrinsic-function: ANNUITY -intrinsic-function: ASIN -intrinsic-function: ATAN -intrinsic-function: BOOLEAN-OF-INTEGER -intrinsic-function: BYTE-LENGTH -intrinsic-function: CHAR -intrinsic-function: CHAR-NATIONAL -intrinsic-function: COMBINED-DATETIME -intrinsic-function: COS -intrinsic-function: CURRENT-DATE -intrinsic-function: DATE-OF-INTEGER -intrinsic-function: DATE-TO-YYYYMMDD -intrinsic-function: DAY-OF-INTEGER -intrinsic-function: DAY-TO-YYYYDDD -intrinsic-function: DISPLAY-OF -intrinsic-function: E -intrinsic-function: EXCEPTION-FILE -intrinsic-function: EXCEPTION-FILE-N -intrinsic-function: EXCEPTION-LOCATION -intrinsic-function: EXCEPTION-LOCATION-N -intrinsic-function: EXCEPTION-STATEMENT -intrinsic-function: EXCEPTION-STATUS -intrinsic-function: EXP -intrinsic-function: EXP10 -intrinsic-function: FACTORIAL -intrinsic-function: FORMATTED-CURRENT-DATE -intrinsic-function: FORMATTED-DATE -intrinsic-function: FORMATTED-DATETIME -intrinsic-function: FORMATTED-TIME -intrinsic-function: FRACTION-PART -intrinsic-function: HIGHEST-ALGEBRAIC -intrinsic-function: INTEGER -intrinsic-function: INTEGER-OF-BOOLEAN -intrinsic-function: INTEGER-OF-DATE -intrinsic-function: INTEGER-OF-DAY -intrinsic-function: INTEGER-OF-FORMATTED-DATE -intrinsic-function: INTEGER-PART -intrinsic-function: LENGTH -intrinsic-function: LOCALE-COMPARE -intrinsic-function: LOCALE-DATE -intrinsic-function: LOCALE-TIME -intrinsic-function: LOCALE-TIME-FROM-SECONDS -intrinsic-function: LOG -intrinsic-function: LOG10 -intrinsic-function: LOWER-CASE -intrinsic-function: LOWEST-ALGEBRAIC -intrinsic-function: MAX -intrinsic-function: MEAN -intrinsic-function: MEDIAN -intrinsic-function: MIDRANGE -intrinsic-function: MIN -intrinsic-function: MOD -intrinsic-function: NATIONAL-OF -intrinsic-function: NUMVAL -intrinsic-function: NUMVAL-C -intrinsic-function: NUMVAL-F -intrinsic-function: ORD -intrinsic-function: ORD-MAX -intrinsic-function: ORD-MIN -intrinsic-function: PI -intrinsic-function: PRESENT-VALUE -intrinsic-function: RANDOM -intrinsic-function: RANGE -intrinsic-function: REM -intrinsic-function: REVERSE -intrinsic-function: SECONDS-FROM-FORMATTED-TIME -intrinsic-function: SECONDS-PAST-MIDNIGHT -intrinsic-function: SIGN -intrinsic-function: SIN -intrinsic-function: SQRT -intrinsic-function: STANDARD-COMPARE -intrinsic-function: STANDARD-DEVIATION -intrinsic-function: SUM -intrinsic-function: TAN -intrinsic-function: TEST-DATE-YYYYMMDD -intrinsic-function: TEST-DAY-YYYYDDD -intrinsic-function: TEST-FORMATTED-DATETIME -intrinsic-function: TEST-NUMVAL -intrinsic-function: TEST-NUMVAL-C -intrinsic-function: TEST-NUMVAL-F -intrinsic-function: TRIM -intrinsic-function: UPPER-CASE -intrinsic-function: VARIANCE -intrinsic-function: WHEN-COMPILED -intrinsic-function: YEAR-TO-YYYY diff -Nru gnucobol-4.0~early~20200606/config/cobol85.conf gnucobol-5/config/cobol85.conf --- gnucobol-4.0~early~20200606/config/cobol85.conf 2020-06-06 20:52:02.000000000 +0000 +++ gnucobol-5/config/cobol85.conf 1970-01-01 00:00:00.000000000 +0000 @@ -1,263 +0,0 @@ -# GnuCOBOL compiler configuration -# -# Copyright (C) 2001-2012, 2014-2020 Free Software Foundation, Inc. -# Written by Keisuke Nishida, Roger While, Simon Sobisch, Edward Hart, -# Ron Norman -# -# This file is part of GnuCOBOL. -# -# The GnuCOBOL compiler is free software: you can redistribute it -# and/or modify it under the terms of the GNU General Public License -# as published by the Free Software Foundation, either version 3 of the -# License, or (at your option) any later version. -# -# GnuCOBOL is distributed in the hope that it will be useful, -# but WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -# GNU General Public License for more details. -# -# You should have received a copy of the GNU General Public License -# along with GnuCOBOL. If not, see . - - -# Value: any string -name: "COBOL 85" - -# Value: enum -standard-define 7 -# CB_STD_OC = 0, -# CB_STD_MF, -# CB_STD_IBM, -# CB_STD_MVS, -# CB_STD_BS2000, -# CB_STD_ACU, -# CB_STD_85, -# CB_STD_2002, -# CB_STD_2014 - -# Value: int -tab-width: 8 -text-column: 72 -word-length: 30 -literal-length: 160 -numeric-literal-length: 18 -pic-length: 30 - -# Default assign type -# Value: 'dynamic', 'external' -assign-clause: dynamic # TO-DO: Verify! - -# If yes, file names are resolved at run time using -# environment variables. -# For example, given ASSIGN TO "DATAFILE", the file name will be -# 1. the value of environment variable 'DD_DATAFILE' or -# 2. the value of environment variable 'dd_DATAFILE' or -# 3. the value of environment variable 'DATAFILE' or -# 4. the literal "DATAFILE" -# If no, the value of the assign clause is the file name. -# -filename-mapping: yes - -# Alternate formatting of numeric fields -pretty-display: yes - -# Allow complex OCCURS DEPENDING ON -complex-odo: no - -# Allow REDEFINES to other than last equal level number -indirect-redefines: no - -# Binary byte size - defines the allocated bytes according to PIC -# Value: signed unsigned bytes -# ------ -------- ----- -# '2-4-8' 1 - 4 same 2 -# 5 - 9 same 4 -# 10 - 18 same 8 -# -# '1-2-4-8' 1 - 2 same 1 -# 3 - 4 same 2 -# 5 - 9 same 4 -# 10 - 18 same 8 -# -# '1--8' 1 - 2 1 - 2 1 -# 3 - 4 3 - 4 2 -# 5 - 6 5 - 7 3 -# 7 - 9 8 - 9 4 -# 10 - 11 10 - 12 5 -# 12 - 14 13 - 14 6 -# 15 - 16 15 - 16 7 -# 17 - 18 17 - 18 8 -# -binary-size: 1-2-4-8 - -# Numeric truncation according to ANSI -binary-truncate: yes - -# Binary byte order -# Value: 'native', 'big-endian' -binary-byteorder: big-endian - -# Allow larger REDEFINES items -larger-redefines-ok: no - -# Allow certain syntax variations (eg. REDEFINES position) -relax-syntax-checks: no - -# Perform type OSVS - If yes, the exit point of any currently -# executing perform is recognized if reached. -perform-osvs: no - -# Compute intermediate decimal results like IBM OSVS -arithmetic-osvs: no - -# MOVE like IBM (mvc); left to right, byte by byte -move-ibm: no - -# If yes, linkage-section items remain allocated -# between invocations. -sticky-linkage: no - -# If yes, allow non-matching level numbers -relax-level-hierarchy: no - -# If yes, evaluate constant expressions at compile time -constant-folding: yes # we may set this to "no" for "old compilers" - -# Allow Hex 'F' for NUMERIC test of signed PACKED DECIMAL field -hostsign: no - -# If yes, set WITH UPDATE clause as default for ACCEPT dest-item, -# except if WITH NO UPDATE clause is used -accept-update: no - -# If yes, set WITH AUTO clause as default for ACCEPT dest-item, -# except if WITH TAB clause is used -accept-auto: no - -# If yes, DISPLAYs and ACCEPTs are, by default, done on the CRT (i.e., using -# curses). -console-is-crt: no - -# If yes, allow redefinition of the current program's name. This prevents its -# use in a prototype-format CALL/CANCEL statement. -program-name-redefinition: yes - -# If yes, NO ECHO/NO-ECHO/OFF is the same as SECURE (hiding input with -# asterisks, not spaces). -no-echo-means-secure: no - -# If yes, the first item in a field screen ACCEPT/DISPLAY (e.g. DISPLAY x UPON -# CRT) is located after the previous ACCEPT/DISPLAY (as though LINE 0 COL 0 had -# been specified). -line-col-zero-default: no - -# If yes, then REPORT, COLUMN may have any of PLUS num, + num, or +num -# to define a relative column position -report-column-plus: no - -# If yes, DISPLAY SPACES acts as ERASE EOS, DISPLAY X"01" acts as ERASE EOL, -# DISPLAY X"02" acts as BLANK SCREEEN and DISPLAY X"07" acts as BELL. Note -# DISPLAY LOW-VALUE is excluded from this; it will always just position the -# cursor. -display-special-fig-consts: no - -# If yes, COMP-1 is a signed 16-bit integer and any PICTURE clause is ignored. -binary-comp-1: no - -# auto-adjust to zero like MicroFocus does -move-non-numeric-lit-to-numeric-is-zero: no - -# If yes, implicitly define a variable for an ASSIGN DYNAMIC which does not -# match an existing data item. -implicit-assign-dynamic-var: yes - -# What rules to apply to SCREEN SECTION items clauses -screen-section-rules: std - -# Dialect features -# Value: 'ok', 'warning', 'archaic', 'obsolete', 'skip', 'ignore', 'error', -# 'unconformable' - -alter-statement: obsolete -comment-paragraphs: obsolete -call-overflow: ok -data-records-clause: obsolete -debugging-mode: ok -use-for-debugging: obsolete -listing-statements: skip # may be a user-defined word -title-statement: skip # may be a user-defined word -entry-statement: unconformable -goto-statement-without-name: obsolete -label-records-clause: obsolete -memory-size-clause: obsolete -move-noninteger-to-alphanumeric: error -move-figurative-constant-to-numeric: ok -move-figurative-space-to-numeric: error -move-figurative-quote-to-numeric: ok -multiple-file-tape-clause: obsolete -next-sentence-phrase: archaic -odo-without-to: unconformable -padding-character-clause: ok -section-segments: obsolete -stop-literal-statement: obsolete -stop-identifier-statement: unconformable -same-as-clause: unconformable -synchronized-clause: ok -sync-left-right: ok -special-names-clause: error -top-level-occurs-clause: skip -value-of-clause: obsolete -numeric-boolean: unconformable -hexadecimal-boolean: unconformable -national-literals: unconformable -hexadecimal-national-literals: unconformable -national-character-literals: unconformable -acu-literals: unconformable -hp-octal-literals: unconformable -word-continuation: ok -occurs-max-length-without-subscript: no -length-in-data-division: yes -depending-on-not-fixed: ok -not-exception-before-exception: unconformable -accept-display-extensions: unconformable -renames-uncommon-levels: unconformable -symbolic-constant: unconformable -constant-78: unconformable -constant-01: unconformable -perform-varying-without-by: unconformable -reference-out-of-declaratives: error # not verified yet -reference-bounds-check: warning -program-prototypes: unconformable -call-convention-mnemonic: unconformable -call-convention-linkage: unconformable -numeric-value-for-edited-item: error -incorrect-conf-sec-order: error -define-constant-directive: error -free-redefines-position: unconformable -records-mismatch-record-clause: error -record-delimiter: ok -sequential-delimiters: ok -record-delim-with-fixed-recs: unconformable -missing-statement: error -zero-length-literals: unconformable -xml-generate-extra-phrases: unconformable -continue-after: unconformable -goto-entry: unconformable -binary-sync-clause: ignore -nonnumeric-with-numeric-group-usage: ok -assign-variable: unconformable -assign-using-variable: unconformable -assign-ext-dyn: unconformable -assign-disk-from: unconformable -align-record: 0 -align-opt: no - -# obsolete in COBOL85 and currently not available as dialect features: -# 1: All literal with numeric or numeric edited item -# 2: RERUN clause -# 3: KEY phrase of the DISABLE and ENABLE statements -# 4: ENTER statement -# 5: REVERSED phrase of the OPEN statement - -# use fixed word list, synonyms and exceptions specified there -reserved-words: COBOL85 diff -Nru gnucobol-4.0~early~20200606/config/cobol85.words gnucobol-5/config/cobol85.words --- gnucobol-4.0~early~20200606/config/cobol85.words 2020-06-06 20:52:02.000000000 +0000 +++ gnucobol-5/config/cobol85.words 1970-01-01 00:00:00.000000000 +0000 @@ -1,436 +0,0 @@ -# GnuCOBOL compiler - list of reserved words -# -# Copyright (C) 2016-2017 Free Software Foundation, Inc. -# Written by Simon Sobisch, Edward Hart -# -# This file is part of GnuCOBOL. -# -# The GnuCOBOL compiler is free software: you can redistribute it -# and/or modify it under the terms of the GNU General Public License -# as published by the Free Software Foundation, either version 3 of the -# License, or (at your option) any later version. -# -# GnuCOBOL is distributed in the hope that it will be useful, -# but WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -# GNU General Public License for more details. -# -# You should have received a copy of the GNU General Public License -# along with GnuCOBOL. If not, see . - - -# Word list for dialect: COBOL 1985 - -# Note: only used for strict dialect and when -# requested by compiler directive >> IMP COBOL 85 -# the default reserved word list will not be used. - -# Value: Word to make up reserved words list (case independent) -# All reserved entries listed will replace entire default reserved words list. -# Words ending with * will be treated as context-sensitive words. This will be -# ignored if GnuCOBOL uses that word as a reserved word. -# Entries of the form word-1=word-2 define word-1 as an alias for default -# reserved word word-2. No spaces are allowed around the equal sign. -reserved: ACCEPT -reserved: ACCESS -reserved: ADD -reserved: ADVANCING -reserved: AFTER -reserved: ALL -reserved: ALPHABET -reserved: ALPHABETIC -reserved: ALPHABETIC-LOWER -reserved: ALPHABETIC-UPPER -reserved: ALPHANUMERIC -reserved: ALPHANUMERIC-EDITED -reserved: ALSO -reserved: ALTER -reserved: ALTERNATE -reserved: AND -reserved: ANY -reserved: ARE -reserved: AREA -reserved: AREAS -reserved: ASCENDING -reserved: ASSIGN -reserved: AT -reserved: AUTHOR -reserved: BEFORE -reserved: BINARY -reserved: BINARY-SEQUENTIAL* # implementor RECORD DELIMITER word -reserved: BLANK -reserved: BLOCK -reserved: BOTTOM -reserved: BY -reserved: CALL -reserved: CANCEL -reserved: CD -reserved: CF -reserved: CH -reserved: CHARACTER -reserved: CHARACTERS -reserved: CLASS -reserved: CLOCK-UNITS -reserved: CLOSE -reserved: COBOL -reserved: CODE -reserved: CODE-SET -reserved: COLLATING -reserved: COLUMN -reserved: COMMA -reserved: COMMON -reserved: COMMUNICATION -reserved: COMP -reserved: COMPUTATIONAL -reserved: COMPUTE -reserved: CONFIGURATION -reserved: CONTAINS -reserved: CONTENT -reserved: CONTINUE -reserved: CONTROL -reserved: CONTROLS -reserved: CONVERTING -reserved: COPY -reserved: CORR -reserved: CORRESPONDING -reserved: COUNT -reserved: CURRENCY -reserved: DATA -reserved: DATE -reserved: DATE-COMPILED -reserved: DATE-WRITTEN -reserved: DAY -reserved: DAY-OF-WEEK -reserved: DE -reserved: DEBUGGING -reserved: DECIMAL-POINT -reserved: DECLARATIVES -reserved: DELETE -reserved: DELIMITED -reserved: DELIMITER -reserved: DEPENDING -reserved: DESCENDING -reserved: DESTINATION -reserved: DETAIL -reserved: DISABLE -reserved: DISPLAY -reserved: DIVIDE -reserved: DIVISION -reserved: DOWN -reserved: DUPLICATES -reserved: DYNAMIC -reserved: EGI -reserved: ELSE -reserved: EMI -reserved: ENABLE -reserved: END -reserved: END-ADD -reserved: END-CALL -reserved: END-COMPUTE -reserved: END-DELETE -reserved: END-DIVIDE -reserved: END-EVALUATE -reserved: END-IF -reserved: END-MULTIPLY -reserved: END-OF-PAGE -reserved: END-PERFORM -reserved: END-READ -reserved: END-RECEIVE -reserved: END-RETURN -reserved: END-REWRITE -reserved: END-SEARCH -reserved: END-START -reserved: END-STRING -reserved: END-SUBTRACT -reserved: END-UNSTRING -reserved: END-WRITE -reserved: ENTER -reserved: ENVIRONMENT -reserved: EOP -reserved: EQUAL -reserved: ERROR -reserved: ESI -reserved: EVALUATE -reserved: EVERY -reserved: EXCEPTION -reserved: EXIT -reserved: EXTEND -reserved: EXTERNAL -reserved: FALSE -reserved: FD -reserved: FILE -reserved: FILE-CONTROL -reserved: FILLER -reserved: FINAL -reserved: FIRST -reserved: FOOTING -reserved: FOR -reserved: FROM -reserved: FUNCTION -reserved: GENERATE -reserved: GIVING -reserved: GLOBAL -reserved: GO -reserved: GREATER -reserved: GROUP -reserved: HEADING -reserved: HIGH-VALUE -reserved: HIGH-VALUES=HIGH-VALUE -reserved: I-O -reserved: I-O-CONTROL -reserved: IDENTIFICATION -reserved: IF -reserved: IN -reserved: INDEX -reserved: INDEXED -reserved: INDICATE -reserved: INITIAL -reserved: INITIALIZE -reserved: INITIATE -reserved: INPUT -reserved: INPUT-OUTPUT -reserved: INSPECT -reserved: INSTALLATION -reserved: INTO -reserved: INVALID -reserved: IS -reserved: JUST -reserved: JUSTIFIED -reserved: KEY -reserved: LABEL -reserved: LAST -reserved: LEADING -reserved: LEFT -reserved: LENGTH -reserved: LESS -reserved: LIMIT -reserved: LIMITS -reserved: LINAGE -reserved: LINAGE-COUNTER -reserved: LINE -reserved: LINE-COUNTER -reserved: LINE-SEQUENTIAL* # implementor RECORD DELIMITER word -reserved: LINES -reserved: LINKAGE -reserved: LOCK -reserved: LOW-VALUE -reserved: LOW-VALUES=LOW-VALUE -reserved: MEMORY -reserved: MERGE -reserved: MESSAGE -reserved: MODE -reserved: MODULES -reserved: MOVE -reserved: MULTIPLE -reserved: MULTIPLY -reserved: NATIVE -reserved: NEGATIVE -reserved: NEXT -reserved: NO -reserved: NOT -reserved: NUMBER -reserved: NUMERIC -reserved: NUMERIC-EDITED -reserved: OBJECT-COMPUTER -reserved: OCCURS -reserved: OF -reserved: OFF -reserved: OMITTED -reserved: ON -reserved: OPEN -reserved: OPTIONAL -reserved: OR -reserved: ORDER -reserved: ORGANIZATION -reserved: OTHER -reserved: OUTPUT -reserved: OVERFLOW -reserved: PACKED-DECIMAL -reserved: PADDING -reserved: PAGE -reserved: PAGE-COUNTER -reserved: PERFORM -reserved: PF -reserved: PH -reserved: PIC=PICTURE -reserved: PICTURE -reserved: PLUS -reserved: POINTER -reserved: POSITION -reserved: POSITIVE -reserved: PRINTING -reserved: PROCEDURE -reserved: PROCEDURES -reserved: PROCEED -reserved: PROGRAM -reserved: PROGRAM-ID -reserved: PURGE -reserved: QUEUE -reserved: QUOTE -reserved: QUOTES -reserved: RANDOM -reserved: RD -reserved: READ -reserved: RECEIVE -reserved: RECORD -reserved: RECORDS -reserved: REDEFINES -reserved: REEL -reserved: REFERENCE -reserved: REFERENCES -reserved: RELATIVE -reserved: RELEASE -reserved: REMAINDER -reserved: REMOVAL -reserved: RENAMES -reserved: REPLACE -reserved: REPLACING -reserved: REPORT -reserved: REPORTING -reserved: REPORTS -reserved: RERUN -reserved: RESERVE -reserved: RESET -reserved: RETURN -reserved: REVERSED -reserved: REWIND -reserved: REWRITE -reserved: RF -reserved: RH -reserved: RIGHT -reserved: ROUNDED -reserved: RUN -reserved: SAME -reserved: SD -reserved: SEARCH -reserved: SECTION -reserved: SECURITY -reserved: SEGMENT -reserved: SEGMENT-LIMIT -reserved: SELECT -reserved: SEND -reserved: SENTENCE -reserved: SEPARATE -reserved: SEQUENCE -reserved: SEQUENTIAL -reserved: SET -reserved: SIGN -reserved: SIZE -reserved: SORT -reserved: SORT-MERGE -reserved: SOURCE -reserved: SOURCE-COMPUTER -reserved: SPACE -reserved: SPACES=SPACE -reserved: SPECIAL-NAMES -reserved: STANDARD -reserved: STANDARD-1 -reserved: STANDARD-2 -reserved: START -reserved: STATUS -reserved: STOP -reserved: STRING -reserved: SUB-QUEUE-1 -reserved: SUB-QUEUE-2 -reserved: SUB-QUEUE-3 -reserved: SUBTRACT -reserved: SUM -reserved: SUPPRESS -reserved: SYMBOLIC -reserved: SYNC -reserved: SYNCHRONIZED -reserved: TABLE -reserved: TALLYING -reserved: TAPE -reserved: TERMINAL -reserved: TERMINATE -reserved: TEST -reserved: TEXT -reserved: THAN -reserved: THEN -reserved: THROUGH -reserved: THRU -reserved: TIME -reserved: TIMES -reserved: TO -reserved: TOP -reserved: TRAILING -reserved: TRUE -reserved: TYPE -reserved: UNIT -reserved: UNSTRING -reserved: UNTIL -reserved: UP -reserved: UPON -reserved: USAGE -reserved: USE -reserved: USING -reserved: VALUE -reserved: VALUES=VALUE -reserved: VARYING -reserved: WHEN -reserved: WITH -reserved: WORDS -reserved: WORKING-STORAGE -reserved: WRITE -reserved: ZERO -reserved: ZEROES=ZERO -reserved: ZEROS=ZERO - - -not-register: DIALECT-ALL # disable all registers, specify used below -register: DEBUG-ITEM -#register: "LINAGE-COUNTER" # not yet handled as register in GnuCOBOL -#register: "LINE-COUNTER" # not yet handled as register in GnuCOBOL -#register: "PAGE-COUNTER" # not yet handled as register in GnuCOBOL - - -# disable all functions -not-intrinsic-function: DIALECT-ALL - -# intrinsic function not included in original COBOL85, but in -# ISO 1989/Amendment 1 Intrinsic Function Module (endorsement of ANSI Standard X3.23a-1989) -# and tested in NIST suite IX module - -intrinsic-function: ACOS -intrinsic-function: ANNUITY -intrinsic-function: ASIN -intrinsic-function: ATAN -intrinsic-function: CHAR -intrinsic-function: COS -intrinsic-function: CURRENT-DATE -intrinsic-function: DATE-OF-INTEGER -intrinsic-function: DAY-OF-INTEGER -intrinsic-function: FACTORIAL -intrinsic-function: INTEGER -intrinsic-function: INTEGER-OF-DATE -intrinsic-function: INTEGER-OF-DAY -intrinsic-function: INTEGER-PART -intrinsic-function: LENGTH -intrinsic-function: LOG -intrinsic-function: LOG10 -intrinsic-function: LOWER-CASE -intrinsic-function: MAX -intrinsic-function: MEAN -intrinsic-function: MEDIAN -intrinsic-function: MIDRANGE -intrinsic-function: MIN -intrinsic-function: MOD -intrinsic-function: NUMVAL -intrinsic-function: NUMVAL-C -intrinsic-function: ORD -intrinsic-function: ORD-MAX -intrinsic-function: ORD-MIN -intrinsic-function: PRESENT-VALUE -intrinsic-function: RANDOM -intrinsic-function: RANGE -intrinsic-function: REM -intrinsic-function: REVERSE -intrinsic-function: SIN -intrinsic-function: SQRT -intrinsic-function: STANDARD-DEVIATION -intrinsic-function: SUM -intrinsic-function: TAN -intrinsic-function: UPPER-CASE -intrinsic-function: VARIANCE -intrinsic-function: WHEN-COMPILED diff -Nru gnucobol-4.0~early~20200606/config/default.conf gnucobol-5/config/default.conf --- gnucobol-4.0~early~20200606/config/default.conf 2020-06-06 20:52:02.000000000 +0000 +++ gnucobol-5/config/default.conf 1970-01-01 00:00:00.000000000 +0000 @@ -1,300 +0,0 @@ -# GnuCOBOL compiler configuration -# -# Copyright (C) 2001-2012, 2014-2020 Free Software Foundation, Inc. -# Written by Keisuke Nishida, Roger While, Simon Sobisch, Edward Hart, -# Ron Norman -# -# This file is part of GnuCOBOL. -# -# The GnuCOBOL compiler is free software: you can redistribute it -# and/or modify it under the terms of the GNU General Public License -# as published by the Free Software Foundation, either version 3 of the -# License, or (at your option) any later version. -# -# GnuCOBOL is distributed in the hope that it will be useful, -# but WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -# GNU General Public License for more details. -# -# You should have received a copy of the GNU General Public License -# along with GnuCOBOL. If not, see . - - -# Value: any string -name: "GnuCOBOL" - -# Value: enum -standard-define 0 -# CB_STD_OC = 0, -# CB_STD_MF, -# CB_STD_IBM, -# CB_STD_MVS, -# CB_STD_BS2000, -# CB_STD_ACU, -# CB_STD_85, -# CB_STD_2002, -# CB_STD_2014 - -# Value: int -tab-width: 8 -text-column: 72 -# Maximum word-length for COBOL words / Programmer defined words -# Be aware that GC checks the word length against COB_MAX_WORDLEN -# first (currently 63) -word-length: 63 - -# Maximum literal size in general -literal-length: 8191 - -# Maximum numeric literal size (absolute maximum: 38) -numeric-literal-length: 38 - -# Maximum number of characters allowed in the character-string (max. 255) -pic-length: 255 - -# Default assign type -# Value: 'dynamic', 'external' -assign-clause: dynamic # TO-DO: Verify! - -# If yes, file names are resolved at run time using -# environment variables. -# For example, given ASSIGN TO "DATAFILE", the file name will be -# 1. the value of environment variable 'DD_DATAFILE' or -# 2. the value of environment variable 'dd_DATAFILE' or -# 3. the value of environment variable 'DATAFILE' or -# 4. the literal "DATAFILE" -# If no, the value of the assign clause is the file name. -# -filename-mapping: yes - -# Alternate formatting of numeric fields -pretty-display: yes - -# Allow complex OCCURS DEPENDING ON -complex-odo: no - -# Allow REDEFINES to other than last equal level number -indirect-redefines: no - -# Binary byte size - defines the allocated bytes according to PIC -# Value: signed unsigned bytes -# ------ -------- ----- -# '2-4-8' 1 - 4 same 2 -# 5 - 9 same 4 -# 10 - 18 same 8 -# -# '1-2-4-8' 1 - 2 same 1 -# 3 - 4 same 2 -# 5 - 9 same 4 -# 10 - 18 same 8 -# -# '1--8' 1 - 2 1 - 2 1 -# 3 - 4 3 - 4 2 -# 5 - 6 5 - 7 3 -# 7 - 9 8 - 9 4 -# 10 - 11 10 - 12 5 -# 12 - 14 13 - 14 6 -# 15 - 16 15 - 16 7 -# 17 - 18 17 - 18 8 -# -binary-size: 1-2-4-8 - -# Numeric truncation according to ANSI -binary-truncate: yes - -# Binary byte order -# Value: 'native', 'big-endian' -binary-byteorder: big-endian - -# Allow larger REDEFINES items -larger-redefines-ok: no - -# Allow certain syntax variations (eg. REDEFINES position) -relax-syntax-checks: no - -# Perform type OSVS - If yes, the exit point of any currently -# executing perform is recognized if reached. -perform-osvs: no - -# Compute intermediate decimal results like IBM OSVS -arithmetic-osvs: no - -# MOVE like IBM (mvc); left to right, byte by byte -move-ibm: no - -# If yes, linkage-section items remain allocated -# between invocations. -sticky-linkage: no - -# If yes, allow non-matching level numbers -relax-level-hierarchy: no - -# If yes, evaluate constant expressions at compile time -constant-folding: yes - -# Allow Hex 'F' for NUMERIC test of signed PACKED DECIMAL field -hostsign: no - -# If yes, set WITH UPDATE clause as default for ACCEPT dest-item, -# except if WITH NO UPDATE clause is used -accept-update: no - -# If yes, set WITH AUTO clause as default for ACCEPT dest-item, -# except if WITH TAB clause is used -accept-auto: no - -# If yes, DISPLAYs and ACCEPTs are, by default, done on the CRT (i.e., using -# curses). -console-is-crt: no - -# If yes, allow redefinition of the current program's name. This prevents its -# use in a prototype-format CALL/CANCEL statement. -program-name-redefinition: yes - -# If yes, NO ECHO/NO-ECHO/OFF is the same as SECURE (hiding input with -# asterisks, not spaces). -no-echo-means-secure: no - -# If yes, the first item in a field screen ACCEPT/DISPLAY (e.g. DISPLAY x UPON -# CRT) is located after the previous ACCEPT/DISPLAY (as though LINE 0 COL 0 had -# been specified). -line-col-zero-default: yes - -# If yes, then REPORT, COLUMN may have any of PLUS num, + num, or +num -# to define a relative column position -# If no, then COLUMN +num is not accepted due to signed numeric -report-column-plus: yes - -# If yes, DISPLAY SPACES acts as ERASE EOS, DISPLAY X"01" acts as ERASE EOL, -# DISPLAY X"02" acts as BLANK SCREEEN and DISPLAY X"07" acts as BELL. Note -# DISPLAY LOW-VALUE is excluded from this; it will always just position the -# cursor. -display-special-fig-consts: no - -# If yes, COMP-1 is a signed 16-bit integer and any PICTURE clause is ignored. -binary-comp-1: no - -# auto-adjust to zero like MicroFocus does -move-non-numeric-lit-to-numeric-is-zero: no - -# If yes, implicitly define a variable for an ASSIGN DYNAMIC which does not -# match an existing data item. -implicit-assign-dynamic-var: yes - -# What rules to apply to SCREEN SECTION items clauses -screen-section-rules: gc - -# Dialect features -# Value: 'ok', 'warning', 'archaic', 'obsolete', 'skip', 'ignore', 'error', -# 'unconformable' - -alter-statement: obsolete -comment-paragraphs: obsolete -call-overflow: archaic -data-records-clause: obsolete -debugging-mode: ok -use-for-debugging: ok -listing-statements: skip # may be a user-defined word -title-statement: skip # may be a user-defined word -entry-statement: ok -goto-statement-without-name: obsolete -label-records-clause: obsolete -memory-size-clause: obsolete -move-noninteger-to-alphanumeric: error -move-figurative-constant-to-numeric: archaic -move-figurative-space-to-numeric: error -move-figurative-quote-to-numeric: obsolete -multiple-file-tape-clause: obsolete -next-sentence-phrase: archaic -odo-without-to: warning -padding-character-clause: obsolete -occurs-max-length-without-subscript: no -section-segments: ignore -stop-literal-statement: obsolete -stop-identifier-statement: obsolete -same-as-clause: ok -synchronized-clause: ok -sync-left-right: ok -special-names-clause: ok -top-level-occurs-clause: ok -value-of-clause: obsolete -numeric-boolean: ok -hexadecimal-boolean: ok -national-literals: ok -hexadecimal-national-literals: ok -national-character-literals: warning -# TO-DO: Add separate config option for H"..." to be unsupported,numeric,non-numeric(acu) -acu-literals: unconformable -hp-octal-literals: unconformable -word-continuation: warning -length-in-data-division: yes -depending-on-not-fixed: warning -not-exception-before-exception: ok -accept-display-extensions: ok -renames-uncommon-levels: ok -symbolic-constant: ok -constant-78: ok -constant-01: ok -perform-varying-without-by: ok -reference-out-of-declaratives: warning -# Is reference modification required to be within the single field -reference-bounds-check: warning -program-prototypes: ok -call-convention-mnemonic: ok -call-convention-linkage: ok -numeric-value-for-edited-item: ok -incorrect-conf-sec-order: ok -define-constant-directive: archaic -free-redefines-position: warning -records-mismatch-record-clause: warning -record-delimiter: ok -sequential-delimiters: ok -record-delim-with-fixed-recs: ok -missing-statement: warning -zero-length-literals: ok -xml-generate-extra-phrases: ok -continue-after: ok -goto-entry: warning -binary-sync-clause: ignore -nonnumeric-with-numeric-group-usage: ok -assign-variable: ok -assign-using-variable: ok -assign-ext-dyn: ok -assign-disk-from: ok -align-record: 0 -align-opt: no - -# use complete word list; synonyms and exceptions are specified below -reserved-words: default - -# not-reserved: -# Value: Word to be taken out of the reserved words list -not-reserved: TERMINAL -#not-reserved: TRANSACTION - -# reserved: -# Entries of the form word-1=word-2 define word-1 as an alias for default -# reserved word word-2. No spaces are allowed around the equal sign. -reserved: AUTO-SKIP=AUTO -reserved: AUTOTERMINATE=AUTO -reserved: BACKGROUND-COLOUR=BACKGROUND-COLOR -reserved: BEEP=BELL -reserved: BINARY-INT=BINARY-LONG -reserved: BINARY-LONG-LONG=BINARY-DOUBLE -reserved: CELLS=CELL -reserved: COLOURS=COLORS -reserved: EMPTY-CHECK=REQUIRED -reserved: EQUALS=EQUAL -reserved: FOREGROUND-COLOUR=FOREGROUND-COLOR -reserved: HIGH-VALUES=HIGH-VALUE -reserved: INITIALISE=INITIALIZE -reserved: INITIALISED=INITIALIZED -reserved: LENGTH-CHECK=FULL -reserved: LOW-VALUES=LOW-VALUE -reserved: ORGANISATION=ORGANIZATION -reserved: PIXELS=PIXEL -reserved: SYNCHRONISED=SYNCHRONIZED -reserved: TIMEOUT=TIME-OUT -reserved: VALUES=VALUE -reserved: ZEROES=ZERO -reserved: ZEROS=ZERO diff -Nru gnucobol-4.0~early~20200606/config/ibm.conf gnucobol-5/config/ibm.conf --- gnucobol-4.0~early~20200606/config/ibm.conf 2020-06-06 20:52:02.000000000 +0000 +++ gnucobol-5/config/ibm.conf 1970-01-01 00:00:00.000000000 +0000 @@ -1,34 +0,0 @@ -# GnuCOBOL compiler configuration -# -# Copyright (C) 2001-2012, 2014-2017 Free Software Foundation, Inc. -# Written by Keisuke Nishida, Roger While, Simon Sobisch, Edward Hart -# -# This file is part of GnuCOBOL. -# -# The GnuCOBOL compiler is free software: you can redistribute it -# and/or modify it under the terms of the GNU General Public License -# as published by the Free Software Foundation, either version 3 of the -# License, or (at your option) any later version. -# -# GnuCOBOL is distributed in the hope that it will be useful, -# but WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -# GNU General Public License for more details. -# -# You should have received a copy of the GNU General Public License -# along with GnuCOBOL. If not, see . - - -include "ibm-strict.conf" - -# Value: any string -name: "IBM COBOL (lax)" - -# reserve additional words, synonyms and exceptions from normal word list -include: "ibm.words" - -# not-reserved: -# Value: Word to be taken out of the reserved words list -# -fill upon request- - -include "lax.conf-inc" diff -Nru gnucobol-4.0~early~20200606/config/ibm-strict.conf gnucobol-5/config/ibm-strict.conf --- gnucobol-4.0~early~20200606/config/ibm-strict.conf 2020-06-06 20:52:02.000000000 +0000 +++ gnucobol-5/config/ibm-strict.conf 1970-01-01 00:00:00.000000000 +0000 @@ -1,256 +0,0 @@ -# GnuCOBOL compiler configuration -# -# Copyright (C) 2001-2012, 2014-2020 Free Software Foundation, Inc. -# Written by Keisuke Nishida, Roger While, Simon Sobisch, Edward Hart, -# Ron Norman -# -# This file is part of GnuCOBOL. -# -# The GnuCOBOL compiler is free software: you can redistribute it -# and/or modify it under the terms of the GNU General Public License -# as published by the Free Software Foundation, either version 3 of the -# License, or (at your option) any later version. -# -# GnuCOBOL is distributed in the hope that it will be useful, -# but WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -# GNU General Public License for more details. -# -# You should have received a copy of the GNU General Public License -# along with GnuCOBOL. If not, see . - - -# Value: any string -name: "IBM COBOL" - -# Value: enum -standard-define 2 -# CB_STD_OC = 0, -# CB_STD_MF, -# CB_STD_IBM, -# CB_STD_MVS, -# CB_STD_BS2000, -# CB_STD_ACU, -# CB_STD_85, -# CB_STD_2002, -# CB_STD_2014 - -# Value: int -tab-width: 8 -text-column: 72 -word-length: 30 -literal-length: 160 # not verified yet -numeric-literal-length: 18 # not verified yet -pic-length: 50 - -# Default assign type -# Value: 'dynamic', 'external' -assign-clause: external - -# If yes, file names are resolved at run time using -# environment variables. -# For example, given ASSIGN TO "DATAFILE", the file name will be -# 1. the value of environment variable 'DD_DATAFILE' or -# 2. the value of environment variable 'dd_DATAFILE' or -# 3. the value of environment variable 'DATAFILE' or -# 4. the literal "DATAFILE" -# If no, the value of the assign clause is the file name. -# -filename-mapping: yes - -# Alternate formatting of numeric fields -pretty-display: no - -# Allow complex OCCURS DEPENDING ON -complex-odo: yes - -# Allow REDEFINES to other than last equal level number -indirect-redefines: yes - -# Binary byte size - defines the allocated bytes according to PIC -# Value: signed unsigned bytes -# ------ -------- ----- -# '2-4-8' 1 - 4 same 2 -# 5 - 9 same 4 -# 10 - 18 same 8 -# -# '1-2-4-8' 1 - 2 same 1 -# 3 - 4 same 2 -# 5 - 9 same 4 -# 10 - 18 same 8 -# -# '1--8' 1 - 2 1 - 2 1 -# 3 - 4 3 - 4 2 -# 5 - 6 5 - 7 3 -# 7 - 9 8 - 9 4 -# 10 - 11 10 - 12 5 -# 12 - 14 13 - 14 6 -# 15 - 16 15 - 16 7 -# 17 - 18 17 - 18 8 -# -binary-size: 2-4-8 - -# Numeric truncation according to ANSI -binary-truncate: no - -# Binary byte order -# Value: 'native', 'big-endian' -binary-byteorder: big-endian - -# Allow larger REDEFINES items -larger-redefines-ok: no - -# Allow certain syntax variations (eg. REDEFINES position) -relax-syntax-checks: no - -# Perform type OSVS - If yes, the exit point of any currently -# executing perform is recognized if reached. -perform-osvs: yes - -# Compute intermediate decimal results like IBM OSVS -arithmetic-osvs: yes - -# MOVE like IBM (mvc); left to right, byte by byte -move-ibm: yes - -# If yes, linkage-section items remain allocated -# between invocations. -sticky-linkage: yes - -# If yes, allow non-matching level numbers -relax-level-hierarchy: yes - -# If yes, evaluate constant expressions at compile time -constant-folding: yes # not verified yet - -# Allow Hex 'F' for NUMERIC test of signed PACKED DECIMAL field -hostsign: yes - -# If yes, set WITH UPDATE clause as default for ACCEPT dest-item, -# except if WITH NO UPDATE clause is used -accept-update: no # not verified yet - -# If yes, set WITH AUTO clause as default for ACCEPT dest-item, -# except if WITH TAB clause is used -accept-auto: no # not verified yet - -# If yes, DISPLAYs and ACCEPTs are, by default, done on the CRT (i.e., using -# curses). -console-is-crt: no - -# If yes, allow redefinition of the current program's name. This prevents its -# use in a prototype-format CALL/CANCEL statement. -program-name-redefinition: yes - -# If yes, NO ECHO/NO-ECHO/OFF is the same as SECURE (hiding input with -# asterisks, not spaces). -no-echo-means-secure: no - -# If yes, the first item in a field screen ACCEPT/DISPLAY (e.g. DISPLAY x UPON -# CRT) is located after the previous ACCEPT/DISPLAY (as though LINE 0 COL 0 had -# been specified). -line-col-zero-default: no - -# If yes, then REPORT, COLUMN may have any of PLUS num, + num, or +num -# to define a relative column position -report-column-plus: yes - -# If yes, DISPLAY SPACES acts as ERASE EOS, DISPLAY X"01" acts as ERASE EOL, -# DISPLAY X"02" acts as BLANK SCREEEN and DISPLAY X"07" acts as BELL. Note -# DISPLAY LOW-VALUE is excluded from this; it will always just position the -# cursor. -display-special-fig-consts: no - -# If yes, COMP-1 is a signed 16-bit integer and any PICTURE clause is ignored. -binary-comp-1: no - -# auto-adjust to zero like MicroFocus does -move-non-numeric-lit-to-numeric-is-zero: no - -# If yes, implicitly define a variable for an ASSIGN DYNAMIC which does not -# match an existing data item. -implicit-assign-dynamic-var: no - -# What rules to apply to SCREEN SECTION items clauses -screen-section-rules: std - -# Dialect features -# Value: 'ok', 'warning', 'archaic', 'obsolete', 'skip', 'ignore', 'error', -# 'unconformable' - -alter-statement: obsolete -comment-paragraphs: obsolete -call-overflow: ok -data-records-clause: obsolete -debugging-mode: ok -use-for-debugging: obsolete -listing-statements: ok -title-statement: ok -entry-statement: ok -goto-statement-without-name: obsolete -label-records-clause: obsolete -memory-size-clause: obsolete -move-noninteger-to-alphanumeric: error -symbolic-constant: unconformable -move-figurative-constant-to-numeric: error -move-figurative-space-to-numeric: error -move-figurative-quote-to-numeric: error -multiple-file-tape-clause: obsolete -next-sentence-phrase: archaic -odo-without-to: ok -padding-character-clause: obsolete -section-segments: ignore -stop-literal-statement: obsolete -stop-identifier-statement: unconformable -same-as-clause: unconformable -synchronized-clause: ok -sync-left-right: skip -special-names-clause: error -top-level-occurs-clause: skip -value-of-clause: obsolete -numeric-boolean: unconformable -hexadecimal-boolean: unconformable -national-literals: ok -hexadecimal-national-literals: unconformable -national-character-literals: unconformable -acu-literals: unconformable -hp-octal-literals: unconformable -word-continuation: ok -occurs-max-length-without-subscript: no -length-in-data-division: no -depending-on-not-fixed: warning -not-exception-before-exception: unconformable -accept-display-extensions: unconformable -renames-uncommon-levels: unconformable -constant-78: unconformable -constant-01: unconformable -perform-varying-without-by: unconformable -reference-out-of-declaratives: error # not verified yet -reference-bounds-check: error # not verified yet -program-prototypes: unconformable -call-convention-mnemonic: unconformable -call-convention-linkage: unconformable -numeric-value-for-edited-item: error -incorrect-conf-sec-order: error -define-constant-directive: unconformable -free-redefines-position: unconformable -records-mismatch-record-clause: ok # IBM: "if not matching use the record size" -record-delimiter: ignore -sequential-delimiters: unconformable -record-delim-with-fixed-recs: unconformable -missing-statement: warning # not verified yet -zero-length-literals: unconformable -xml-generate-extra-phrases: ok -continue-after: unconformable -goto-entry: unconformable -binary-sync-clause: ignore -nonnumeric-with-numeric-group-usage: ok -assign-variable: unconformable -assign-using-variable: unconformable -assign-ext-dyn: unconformable -assign-disk-from: unconformable -align-record: 8 -align-opt: yes - -# use fixed word list, synonyms and exceptions specified there -reserved-words: IBM diff -Nru gnucobol-4.0~early~20200606/config/ibm.words gnucobol-5/config/ibm.words --- gnucobol-4.0~early~20200606/config/ibm.words 2020-06-06 20:52:02.000000000 +0000 +++ gnucobol-5/config/ibm.words 1970-01-01 00:00:00.000000000 +0000 @@ -1,632 +0,0 @@ -# GnuCOBOL compiler - list of reserved words -# -# Copyright (C) 2016-2018 Free Software Foundation, Inc. -# Written by Simon Sobisch, Edward Hart -# -# This file is part of GnuCOBOL. -# -# The GnuCOBOL compiler is free software: you can redistribute it -# and/or modify it under the terms of the GNU General Public License -# as published by the Free Software Foundation, either version 3 of the -# License, or (at your option) any later version. -# -# GnuCOBOL is distributed in the hope that it will be useful, -# but WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -# GNU General Public License for more details. -# -# You should have received a copy of the GNU General Public License -# along with GnuCOBOL. If not, see . - - -# Word list for dialect: IBM Enterprise COBOL for z/OS - -# Note: only used for strict dialect and when -# requested by compiler directive >> IMP WORDS IBM -# the default reserved word list will not be used. - -# Value: Word to make up reserved words list (case independent) -# All reserved entries listed will replace entire default reserved words list. -# Words ending with * will be treated as context-sensitive words. This will be -# ignored if GnuCOBOL uses that word as a reserved word. -# Entries of the form word-1=word-2 define word-1 as an alias for default -# reserved word word-2. No spaces are allowed around the equal sign. -reserved: ACCEPT -reserved: ACCESS -reserved: ADD -reserved: ADDRESS -reserved: ADVANCING -reserved: AFTER -reserved: ALL -reserved: ALLOCATE # V6 -reserved: ALPHABET -reserved: ALPHABETIC -reserved: ALPHABETIC-LOWER -reserved: ALPHABETIC-UPPER -reserved: ALPHANUMERIC -reserved: ALPHANUMERIC-EDITED -reserved: ALSO -reserved: ALTER -reserved: ALTERNATE -reserved: AND -reserved: ANY -reserved: APPLY -reserved: ARE -reserved: AREA -reserved: AREAS -reserved: ASCENDING -reserved: ASSIGN -reserved: AT -reserved: ATTRIBUTE* # note: not included in IBMs reserved words - # list, but as a phrase to be parsed - # for XML GENERATE -reserved: ATTRIBUTES* # see above -reserved: AUTHOR -reserved: BASIS -reserved: BEFORE -reserved: BEGINNING -reserved: BINARY # note: only with EXEC SQL coprocessor -reserved: BLANK -reserved: BLOB # note: only with EXEC SQL coprocessor -reserved: BLOB-FILE # note: only with EXEC SQL coprocessor -reserved: BLOB-LOCATOR # note: only with EXEC SQL coprocessor -reserved: BLOCK -reserved: BOTTOM -reserved: BY -reserved: CALL -reserved: CANCEL -reserved: CBL -reserved: CD -reserved: CF -reserved: CH -reserved: CHAR # Is this an error and was in for FUNCTION CHAR -# or is it only defined with EXEC SQL coprocessor? -reserved: CHAR-VARYING # note: only with EXEC SQL coprocessor -reserved: CHARACTER -reserved: CHARACTERS -reserved: CLASS -reserved: CLASS-ID -reserved: CLOB # note: only with EXEC SQL coprocessor -reserved: CLOB-FILE # note: only with EXEC SQL coprocessor -reserved: CLOB-LOCATOR # note: only with EXEC SQL coprocessor -reserved: CLOCK-UNITS -reserved: CLOSE -reserved: COBOL -reserved: CODE -reserved: CODE-SET -reserved: COLLATING -reserved: COLUMN -reserved: COM-REG -reserved: COMMA -reserved: COMMON -reserved: COMMUNICATION -reserved: COMP -reserved: COMP-1 -reserved: COMP-2 -reserved: COMP-3 -reserved: COMP-4 -reserved: COMP-5 -reserved: COMPUTATIONAL -reserved: COMPUTATIONAL-1 -reserved: COMPUTATIONAL-2 -reserved: COMPUTATIONAL-3 -reserved: COMPUTATIONAL-4 -reserved: COMPUTATIONAL-5 -reserved: COMPUTE -reserved: CONFIGURATION -reserved: CONTAINS -reserved: CONTENT -reserved: CONTINUE -reserved: CONTROL -reserved: CONTROLS -reserved: CONVERTING -reserved: COPY -reserved: CORR -reserved: CORRESPONDING -reserved: COUNT -reserved: CURRENCY -reserved: CYCLE* -reserved: DATA -reserved: DATE -reserved: DATE-COMPILED -reserved: DATE-RECORD # note: only with EXEC SQL coprocessor -reserved: DATE-WRITTEN -reserved: DAY -reserved: DAY-OF-WEEK -reserved: DBCLOB # note: only with EXEC SQL coprocessor -reserved: DBCLOB-FILE # note: only with EXEC SQL coprocessor -reserved: DBCLOB-LOCATOR # note: only with EXEC SQL coprocessor -reserved: DBCS -reserved: DE -reserved: DEBUGGING -reserved: DECIMAL-POINT -reserved: DECLARATIVES -reserved: DEFAULT # V6 -reserved: DELETE -reserved: DELIMITED -reserved: DELIMITER -reserved: DEPENDING -reserved: DESCENDING -reserved: DESTINATION -reserved: DETAIL -reserved: DISABLE -reserved: DISPLAY -reserved: DISPLAY-1 -reserved: DIVIDE -reserved: DIVISION -reserved: DOWN -reserved: DUPLICATES -reserved: DYNAMIC -reserved: EGCS -reserved: EGI -reserved: EJECT -reserved: ELEMENT* # see note for XML-DECLARATION -reserved: ELSE -reserved: EMI -reserved: ENABLE -reserved: ENCODING* # see note for XML-DECLARATION/VALIDATING -reserved: END -reserved: END-ADD -reserved: END-CALL -reserved: END-COMPUTE -reserved: END-DELETE -reserved: END-DIVIDE -reserved: END-EVALUATE -reserved: END-EXEC # note: for use with coprocessors, generally reserved -reserved: END-IF -reserved: END-INVOKE -reserved: END-JSON # V6 -reserved: END-MULTIPLY -reserved: END-OF-PAGE -reserved: END-PERFORM -reserved: END-READ -reserved: END-RECEIVE -reserved: END-RETURN -reserved: END-REWRITE -reserved: END-SEARCH -reserved: END-START -reserved: END-STRING -reserved: END-SUBTRACT -reserved: END-UNSTRING -reserved: END-WRITE -reserved: END-XML -reserved: ENDING -reserved: ENTER -reserved: ENTRY -reserved: ENVIRONMENT -reserved: EOP -reserved: EQUAL -reserved: ERROR -reserved: ESI -reserved: EVALUATE -reserved: EVERY -reserved: EXCEPTION -reserved: EXEC # note: for use with coprocessors, generally reserved -reserved: EXECUTE # note: for use with coprocessors, generally reserved -reserved: EXIT -reserved: EXTEND -reserved: EXTERNAL -reserved: F* -reserved: FALSE -reserved: FD -reserved: FILE -reserved: FILE-CONTROL -reserved: FILLER -reserved: FINAL -reserved: FIRST -reserved: FOOTING -reserved: FOR -reserved: FREE # V6 -reserved: FROM -reserved: FUNCTION -reserved: FUNCTION-POINTER -reserved: GENERATE -reserved: GIVING -reserved: GLOBAL -reserved: GO -reserved: GOBACK -reserved: GREATER -reserved: GROUP -reserved: GROUP-USAGE -reserved: HEADING -reserved: HIGH-VALUE -reserved: HIGH-VALUES=HIGH-VALUE -reserved: I-O -reserved: I-O-CONTROL -reserved: ID -reserved: IDENTIFICATION -reserved: IF -reserved: IN -reserved: INDEX -reserved: INDEXED -reserved: INDICATE -reserved: INHERITS -reserved: INITIAL -reserved: INITIALIZE -reserved: INITIALIZED* -reserved: INITIATE -reserved: INPUT -reserved: INPUT-OUTPUT -reserved: INSERT -reserved: INSPECT -reserved: INSTALLATION -reserved: INTO -reserved: INVALID -reserved: INVOKE -reserved: IS -reserved: JNIENVPTR # note: this is a register, move as soon as supported -reserved: JSON -reserved: JSON-CODE # note: this is a register, move as soon as supported -reserved: JSON-STATUS # note: this is a register, move as soon as supported -reserved: JUST -reserved: JUSTIFIED -reserved: KANJI -reserved: KEY -reserved: LABEL -reserved: LAST -reserved: LEADING -reserved: LEFT -reserved: LENGTH -reserved: LESS -reserved: LIMIT -reserved: LIMITS -reserved: LINAGE -reserved: LINAGE-COUNTER -reserved: LINE -reserved: LINE-COUNTER -reserved: LINES -reserved: LINKAGE -reserved: LOCAL-STORAGE -reserved: LOC* -reserved: LOCK -reserved: LONG-VARBINARY # note: only with EXEC SQL coprocessor -reserved: LONG-VARCHAR # note: only with EXEC SQL coprocessor -reserved: LOW-VALUE -reserved: LOW-VALUES=LOW-VALUE -reserved: MEMORY -reserved: MERGE -reserved: MESSAGE -#reserved: METACLASS not included in Language Reference for 4.2 and 6.1 -# Is it integrated with EXEC SQL/SQLIMS coprocessor? -reserved: METHOD -reserved: METHOD-ID -reserved: MODE -reserved: MODULES -reserved: MORE-LABELS -reserved: MOVE -reserved: MULTIPLE -reserved: MULTIPLY -reserved: NAME* # note: context-sensitive to JSON/XML GENERATE, - # we may need to add rough parsing for these -reserved: NAMESPACE* # see note for XML-DECLARATION -reserved: NAMESPACE-PREFIX* # see note for XML-DECLARATION -reserved: NATIONAL -reserved: NATIVE -reserved: NEGATIVE -reserved: NEXT -reserved: NO -reserved: NONNUMERIC* # see note for XML-DECLARATION -reserved: NOT -reserved: NULL -reserved: NULLS=NULL -reserved: NUMBER -reserved: NUMERIC -reserved: NUMERIC-EDITED -reserved: OBJECT -reserved: OBJECT-COMPUTER -reserved: OCCURS -reserved: OF -reserved: OFF -reserved: OMITTED -reserved: ON -reserved: OPEN -reserved: OPTIONAL -reserved: OR -reserved: ORDER -reserved: ORGANIZATION -reserved: OTHER -reserved: OUTPUT -reserved: OVERFLOW -reserved: OVERRIDE -reserved: PACKED-DECIMAL -reserved: PADDING -reserved: PAGE -reserved: PAGE-COUNTER -reserved: PARAGRAPH* -reserved: PARSE # note: not included in IBM's reserved word list, - # but obviously needed for XML PARSE -reserved: PASSWORD -reserved: PERFORM -reserved: PF -reserved: PH -reserved: PIC=PICTURE -reserved: PICTURE -reserved: PLUS -reserved: POINTER -reserved: POSITION -reserved: POSITIVE -reserved: PRINTING -reserved: PROCEDURE -reserved: PROCEDURE-POINTER -reserved: PROCEDURES -reserved: PROCEED -reserved: PROCESSING -reserved: PROGRAM -reserved: PROGRAM-ID -reserved: PURGE -reserved: QUEUE -reserved: QUOTE -reserved: QUOTES -reserved: RANDOM -reserved: RD -reserved: READ -reserved: READY -reserved: RECEIVE -reserved: RECORD -reserved: RECORDING -reserved: RECORDS -reserved: RECURSIVE* -reserved: REDEFINES -reserved: REEL -reserved: REFERENCE -reserved: REFERENCES -reserved: RELATIVE -reserved: RELEASE -reserved: RELOAD -reserved: REMAINDER -reserved: REMOVAL -reserved: RENAMES -reserved: REPLACE -reserved: REPLACING -reserved: REPORT -reserved: REPORTING -reserved: REPORTS -reserved: REPOSITORY -reserved: RERUN -reserved: RESERVE -reserved: RESET -reserved: RESULT-SET-LOCATOR # note: only with EXEC SQL coprocessor -reserved: RETURN -reserved: RETURNING -reserved: REVERSED -reserved: REWIND -reserved: REWRITE -reserved: RF -reserved: RH -reserved: RIGHT -reserved: ROUNDED -reserved: ROWID # note: only with EXEC SQL coprocessor -reserved: RUN -reserved: S* -reserved: SAME -reserved: SD -reserved: SEARCH -reserved: SECTION -reserved: SECURITY -reserved: SEGMENT -reserved: SEGMENT-LIMIT -reserved: SELECT -reserved: SELF -reserved: SEND -reserved: SENTENCE -reserved: SEPARATE -reserved: SEQUENCE -reserved: SEQUENTIAL -reserved: SERVICE -reserved: SET -reserved: SHIFT-IN # note: this is a register, move as soon as supported -reserved: SHIFT-OUT # note: this is a register, move as soon as supported -reserved: SIGN -reserved: SIZE -reserved: SKIP1 -reserved: SKIP2 -reserved: SKIP3 -reserved: SORT -reserved: SORT-CONTROL # note: this is a register, move as soon as supported -reserved: SORT-CORE-SIZE # note: this is a register, move as soon as supported -reserved: SORT-FILE-SIZE # note: this is a register, move as soon as supported -reserved: SORT-MERGE -reserved: SORT-MESSAGE # note: this is a register, move as soon as supported -reserved: SORT-MODE-SIZE # note: this is a register, move as soon as supported -reserved: SOURCE -reserved: SOURCE-COMPUTER -reserved: SPACE -reserved: SPACES=SPACE -reserved: SPECIAL-NAMES -reserved: SQL # note: for use with coprocessors, generally reserved -reserved: SQLIMS # note: for use with coprocessors, generally reserved -reserved: STANDARD -reserved: STANDARD-1 -reserved: STANDARD-2 -reserved: START -reserved: STATUS -reserved: STOP -reserved: STRING -reserved: SUB-QUEUE-1 -reserved: SUB-QUEUE-2 -reserved: SUB-QUEUE-3 -reserved: SUBTRACT -reserved: SUM -reserved: SUPER -reserved: SUPPRESS -reserved: SYMBOL -reserved: SYMBOLIC -reserved: SYNC -reserved: SYNCHRONIZED -reserved: TABLE -reserved: TALLYING -reserved: TAPE -reserved: TERMINAL -reserved: TERMINATE -reserved: TEST -reserved: TEXT -reserved: THAN -reserved: THEN -reserved: THROUGH -reserved: THRU -reserved: TIME -reserved: TIME-RECORD -reserved: TIMES -reserved: TIMESTAMP -reserved: TIMESTAMP-OFFSET -reserved: TIMESTAMP-OFFSET-RECORD -reserved: TIMESTAMP-RECORD -reserved: TITLE -reserved: TO -reserved: TOP -reserved: TRACE -reserved: TRAILING -reserved: TRUE -reserved: TYPE -reserved: U* -reserved: UNBOUNDED* -reserved: UNIT -reserved: UNSTRING -reserved: UNTIL -reserved: UP -reserved: UPON -reserved: USAGE -reserved: USE -reserved: USING -reserved: V* -reserved: VALIDATING* # note: not included in IBMs reserved words - # list, but as a phrase to be parsed - # for XML PARSE -reserved: VALUE -reserved: VALUES=VALUE -#reserved: VARBINARY not included in Language Reference for 4.2 and 6.1 -reserved: VARYING -reserved: VOLATILE # V6 -reserved: WHEN -reserved: WITH -reserved: WORDS -reserved: WORKING-STORAGE -reserved: WRITE -reserved: WRITE-ONLY -reserved: XML -reserved: XML-DECLARATION* # note: not included in IBMs reserved words - # list, but as a phrase to be parsed - # for XML GENERATE -reserved: XML-EVENT # note: this is a register, move as soon as supported -reserved: XML-INFORMATION # note: this is a register, move as soon as supported -reserved: XML-NAMESPACE # note: this is a register, move as soon as supported -reserved: XML-NAMESPACE-PREFIX # note: this is a register, move as soon as supported -reserved: XML-NNAMESPACE # note: this is a register, move as soon as supported -reserved: XML-NNAMESPACE-PREFIX # note: this is a register, move as soon as supported -reserved: XML-NTEXT # note: this is a register, move as soon as supported -reserved: XML-SCHEMA -reserved: XML-TEXT # note: this is a register, move as soon as supported -reserved: YYYYDDD* -reserved: YYYYMMDD* -reserved: ZERO -reserved: ZEROES=ZERO -reserved: ZEROS=ZERO - -# list of registers: -not-register: DIALECT-ALL -register: "ADDRESS\ OF" -register: DEBUG-ITEM -# register: JNIENVPTR -# register: JSON-CODE -register: "LENGTH\ OF" -# register: LINAGE-COUNTER -register: RETURN-CODE -# register: SHIFT-IN # 78 SHIFT-IN GLOBAL VALUE X"0F". -# register: SHIFT-OUT # 78 SHIFT-OUT GLOBAL VALUE X"0E". -# register: SORT-CONTROL -# register: SORT-CORE-SIZE -# register: SORT-FILE-SIZE -# register: SORT-MESSAGE -# register: SORT-MODE-SIZE -register: SORT-RETURN -register: TALLY -register: WHEN-COMPILED -register: XML-CODE -# register: XML-EVENT -# register: XML-INFORMATION -# register: XML-NAMESPACE -# register: XML-NAMESPACE-PREFIX -# register: XML-NNAMESPACE -# register: XML-NNAMESPACE-PREFIX -# register: XML-NTEXT -# register: XML-TEXT - - -# list of system names: -not-system-name: DIALECT-ALL-SWITCHES -system-name: UPSI-0 -system-name: UPSI-1 -system-name: UPSI-2 -system-name: UPSI-3 -system-name: UPSI-4 -system-name: UPSI-5 -system-name: UPSI-6 -system-name: UPSI-7 - - -# disable all functions -not-intrinsic-function: DIALECT-ALL - -# add all that are supported by IBM -intrinsic-function: ACOS -intrinsic-function: ANNUITY -intrinsic-function: ASIN -intrinsic-function: ATAN -intrinsic-function: CHAR -intrinsic-function: COS -intrinsic-function: CURRENT-DATE -intrinsic-function: DATE-OF-INTEGER -intrinsic-function: DATE-TO-YYYYMMDD -#intrinsic-function: DATEVAL # IBM extension (Millennium Language Extension, -# removed with IBM Enterprise COBOL V5), -# not known to GnuCOBOL -intrinsic-function: DAY-OF-INTEGER -intrinsic-function: DAY-TO-YYYYDDD -intrinsic-function: DISPLAY-OF -intrinsic-function: FACTORIAL -intrinsic-function: INTEGER -intrinsic-function: INTEGER-OF-DATE -intrinsic-function: INTEGER-OF-DAY -intrinsic-function: INTEGER-PART -intrinsic-function: LENGTH -intrinsic-function: LOG -intrinsic-function: LOG10 -intrinsic-function: LOWER-CASE -intrinsic-function: MAX -intrinsic-function: MEAN -intrinsic-function: MEDIAN -intrinsic-function: MIDRANGE -intrinsic-function: MIN -intrinsic-function: MOD -intrinsic-function: NATIONAL-OF -intrinsic-function: NUMVAL -intrinsic-function: NUMVAL-C -intrinsic-function: ORD -intrinsic-function: ORD-MAX -intrinsic-function: ORD-MIN -intrinsic-function: PRESENT-VALUE -intrinsic-function: RANDOM -intrinsic-function: RANGE -intrinsic-function: REM -intrinsic-function: REVERSE -intrinsic-function: SIN -intrinsic-function: SQRT -intrinsic-function: STANDARD-DEVIATION -intrinsic-function: SUM -intrinsic-function: TAN -#intrinsic-function: ULENGTH # IBM extension, not known to GnuCOBOL -#intrinsic-function: UNDATE # IBM extension (Millennium Language Extension, -# removed with IBM Enterprise COBOL V5), -# not known to GnuCOBOL -#intrinsic-function: UPOS # IBM extension, not known to GnuCOBOL -intrinsic-function: UPPER-CASE -#intrinsic-function: USUBSTR # IBM extension, not known to GnuCOBOL -#intrinsic-function: USUPPLEMENTARY # IBM extension, not known to GnuCOBOL -#intrinsic-function: UVALID # IBM extension, not known to GnuCOBOL -#intrinsic-function: UWIDTH # IBM extension, not known to GnuCOBOL -intrinsic-function: VARIANCE -intrinsic-function: WHEN-COMPILED -intrinsic-function: YEAR-TO-YYYY -#intrinsic-function: YEARWINDOW # IBM extension (Millennium Language Extension, -# removed with IBM Enterprise COBOL V5), -# not known to GnuCOBOL diff -Nru gnucobol-4.0~early~20200606/config/lax.conf-inc gnucobol-5/config/lax.conf-inc --- gnucobol-4.0~early~20200606/config/lax.conf-inc 2020-06-06 20:52:02.000000000 +0000 +++ gnucobol-5/config/lax.conf-inc 1970-01-01 00:00:00.000000000 +0000 @@ -1,146 +0,0 @@ -# GnuCOBOL compiler configuration -# -# Copyright (C) 2001-2012, 2014-2020 Free Software Foundation, Inc. -# Written by Keisuke Nishida, Roger While, Simon Sobisch, Edward Hart, -# Ron Norman -# -# This file is part of GnuCOBOL. -# -# The GnuCOBOL compiler is free software: you can redistribute it -# and/or modify it under the terms of the GNU General Public License -# as published by the Free Software Foundation, either version 3 of the -# License, or (at your option) any later version. -# -# GnuCOBOL is distributed in the hope that it will be useful, -# but WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -# GNU General Public License for more details. -# -# You should have received a copy of the GNU General Public License -# along with GnuCOBOL. If not, see . - - -# NOTES on the usage: -# This is an include-only compiler configuration file. -# The following steps are applied when using this: -# 1: include "strict" syntax, setting behaviour-specific atrributes -# 2: include this file to allow features that the original -# compilers don't support (larger lengths, syntax variations,...) -# 3: include the reserved-words list to *additional* set the -# compiler-specific words to the default list - - -# Value: int -# Maximum word-length for COBOL words / Programmer defined words -# current max (COB_MAX_WORDLEN): 63 -#word-length: 127 -word-length: 63 -literal-length: 8192 -numeric-literal-length: 38 -pic-length: 255 - -# Allow complex OCCURS DEPENDING ON -complex-odo: yes - -# Allow REDEFINES to other than last equal level number -indirect-redefines: yes - -# Allow larger REDEFINES items -larger-redefines-ok: yes - -# Allow certain syntax variations (eg. REDEFINES position) -relax-syntax-checks: yes - -# If yes, allow non-matching level numbers -relax-level-hierarchy: yes - -# What rules to apply to SCREEN SECTION items clauses -screen-section-rules: gc - -# Dialect features -# Value: 'ok', 'warning', 'archaic', 'obsolete', 'skip', 'ignore', 'error', -# 'unconformable' -# Special option used here: "adjust" --> if the previous set option -# is more strict: override, otherwise leave it as it is - -alter-statement: +obsolete -comment-paragraphs: ok -call-overflow: ok -data-records-clause: +obsolete -debugging-mode: ok -use-for-debugging: +obsolete -listing-statements: ok # may be a user-defined word -title-statement: ok # may be a user-defined word -entry-statement: ok -depending-on-not-fixed: ok -length-in-data-division: yes -goto-statement-without-name: +obsolete -label-records-clause: +obsolete -memory-size-clause: +obsolete -move-noninteger-to-alphanumeric: +warning -move-figurative-constant-to-numeric: +archaic -move-figurative-quote-to-numeric: +archaic -multiple-file-tape-clause: +obsolete -next-sentence-phrase: +archaic -odo-without-to: +warning -reference-bounds-check: +warning -padding-character-clause: +obsolete -section-segments: +ignore -stop-literal-statement: +obsolete -stop-identifier-statement: ok -same-as-clause: ok -synchronized-clause: ok -sync-left-right: +ignore # better use "skip" here? -special-names-clause: +warning -top-level-occurs-clause: ok -value-of-clause: +obsolete -numeric-boolean: ok -hexadecimal-boolean: ok -national-literals: ok -hexadecimal-national-literals: ok -national-character-literals: +warning -acu-literals: ok -hp-octal-literals: ok -word-continuation: ok -not-exception-before-exception: +warning -accept-display-extensions: ok -renames-uncommon-levels: ok -symbolic-constant: +warning -constant-78: ok -constant-01: ok -perform-varying-without-by: ok -reference-out-of-declaratives: +warning -program-prototypes: ok -call-convention-mnemonic: ok -call-convention-linkage: ok -numeric-value-for-edited-item: +warning -incorrect-conf-sec-order: +warning -define-constant-directive: +obsolete -free-redefines-position: ok -records-mismatch-record-clause: +warning -record-delimiter: ok -sequential-delimiters: ok -record-delim-with-fixed-recs: ok -missing-statement: +warning -zero-length-literals: ok -xml-generate-extra-phrases: ok -continue-after: warning -goto-entry: warning -binary-sync-clause: ignore -nonnumeric-with-numeric-group-usage: ok -assign-variable: ok -assign-using-variable: ok -assign-ext-dyn: ok -assign-disk-from: ok - - -# use complete word list -# (vendor specific, currently not supported words are -# loaded by *including* the appropriate word list) -reserved-words: default - -# enable all intrinsic functions -intrinsic-function: DIALECT-ALL - -# enable all registers -register: DIALECT-ALL diff -Nru gnucobol-4.0~early~20200606/config/Makefile.am gnucobol-5/config/Makefile.am --- gnucobol-4.0~early~20200606/config/Makefile.am 2020-06-06 20:52:02.000000000 +0000 +++ gnucobol-5/config/Makefile.am 1970-01-01 00:00:00.000000000 +0000 @@ -1,32 +0,0 @@ -# -# Makefile gnucobol/config -# -# Copyright (C) 2003-2012, 2014-2015, 2017 Free Software Foundation, Inc. -# Written by Keisuke Nishida, Roger While, Simon Sobisch -# -# This file is part of GnuCOBOL. -# -# The GnuCOBOL compiler is free software: you can redistribute it -# and/or modify it under the terms of the GNU General Public License -# as published by the Free Software Foundation, either version 3 of the -# License, or (at your option) any later version. -# -# GnuCOBOL is distributed in the hope that it will be useful, -# but WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -# GNU General Public License for more details. -# -# You should have received a copy of the GNU General Public License -# along with GnuCOBOL. If not, see . - -configdir = @COB_CONFIG_DIR@ -config_DATA = default.conf cobol85.conf cobol2002.conf cobol2014.conf \ - acu.conf mf.conf ibm.conf mvs.conf bs2000.conf realia.conf rm.conf \ - acu-strict.conf mf-strict.conf ibm-strict.conf mvs-strict.conf \ - bs2000-strict.conf realia-strict.conf rm-strict.conf xopen.conf \ - lax.conf-inc \ - cobol85.words cobol2002.words cobol2014.words \ - acu.words mf.words ibm.words mvs.words bs2000.words realia.words \ - rm.words runtime.cfg runtime_empty.cfg - -EXTRA_DIST = $(config_DATA) diff -Nru gnucobol-4.0~early~20200606/config/Makefile.in gnucobol-5/config/Makefile.in --- gnucobol-4.0~early~20200606/config/Makefile.in 2020-06-06 20:56:36.000000000 +0000 +++ gnucobol-5/config/Makefile.in 1970-01-01 00:00:00.000000000 +0000 @@ -1,615 +0,0 @@ -# Makefile.in generated by automake 1.15.1 from Makefile.am. -# @configure_input@ - -# Copyright (C) 1994-2017 Free Software Foundation, Inc. - -# This Makefile.in is free software; the Free Software Foundation -# gives unlimited permission to copy and/or distribute it, -# with or without modifications, as long as this notice is preserved. - -# This program is distributed in the hope that it will be useful, -# but WITHOUT ANY WARRANTY, to the extent permitted by law; without -# even the implied warranty of MERCHANTABILITY or FITNESS FOR A -# PARTICULAR PURPOSE. - -@SET_MAKE@ - -# -# Makefile gnucobol/config -# -# Copyright (C) 2003-2012, 2014-2015, 2017 Free Software Foundation, Inc. -# Written by Keisuke Nishida, Roger While, Simon Sobisch -# -# This file is part of GnuCOBOL. -# -# The GnuCOBOL compiler is free software: you can redistribute it -# and/or modify it under the terms of the GNU General Public License -# as published by the Free Software Foundation, either version 3 of the -# License, or (at your option) any later version. -# -# GnuCOBOL is distributed in the hope that it will be useful, -# but WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -# GNU General Public License for more details. -# -# You should have received a copy of the GNU General Public License -# along with GnuCOBOL. If not, see . - -VPATH = @srcdir@ -am__is_gnu_make = { \ - if test -z '$(MAKELEVEL)'; then \ - false; \ - elif test -n '$(MAKE_HOST)'; then \ - true; \ - elif test -n '$(MAKE_VERSION)' && test -n '$(CURDIR)'; then \ - true; \ - else \ - false; \ - fi; \ -} -am__make_running_with_option = \ - case $${target_option-} in \ - ?) ;; \ - *) echo "am__make_running_with_option: internal error: invalid" \ - "target option '$${target_option-}' specified" >&2; \ - exit 1;; \ - esac; \ - has_opt=no; \ - sane_makeflags=$$MAKEFLAGS; \ - if $(am__is_gnu_make); then \ - sane_makeflags=$$MFLAGS; \ - else \ - case $$MAKEFLAGS in \ - *\\[\ \ ]*) \ - bs=\\; \ - sane_makeflags=`printf '%s\n' "$$MAKEFLAGS" \ - | sed "s/$$bs$$bs[$$bs $$bs ]*//g"`;; \ - esac; \ - fi; \ - skip_next=no; \ - strip_trailopt () \ - { \ - flg=`printf '%s\n' "$$flg" | sed "s/$$1.*$$//"`; \ - }; \ - for flg in $$sane_makeflags; do \ - test $$skip_next = yes && { skip_next=no; continue; }; \ - case $$flg in \ - *=*|--*) continue;; \ - -*I) strip_trailopt 'I'; skip_next=yes;; \ - -*I?*) strip_trailopt 'I';; \ - -*O) strip_trailopt 'O'; skip_next=yes;; \ - -*O?*) strip_trailopt 'O';; \ - -*l) strip_trailopt 'l'; skip_next=yes;; \ - -*l?*) strip_trailopt 'l';; \ - -[dEDm]) skip_next=yes;; \ - -[JT]) skip_next=yes;; \ - esac; \ - case $$flg in \ - *$$target_option*) has_opt=yes; break;; \ - esac; \ - done; \ - test $$has_opt = yes -am__make_dryrun = (target_option=n; $(am__make_running_with_option)) -am__make_keepgoing = (target_option=k; $(am__make_running_with_option)) -pkgdatadir = $(datadir)/@PACKAGE@ -pkgincludedir = $(includedir)/@PACKAGE@ -pkglibdir = $(libdir)/@PACKAGE@ -pkglibexecdir = $(libexecdir)/@PACKAGE@ -am__cd = CDPATH="$${ZSH_VERSION+.}$(PATH_SEPARATOR)" && cd -install_sh_DATA = $(install_sh) -c -m 644 -install_sh_PROGRAM = $(install_sh) -c -install_sh_SCRIPT = $(install_sh) -c -INSTALL_HEADER = $(INSTALL_DATA) -transform = $(program_transform_name) -NORMAL_INSTALL = : -PRE_INSTALL = : -POST_INSTALL = : -NORMAL_UNINSTALL = : -PRE_UNINSTALL = : -POST_UNINSTALL = : -build_triplet = @build@ -host_triplet = @host@ -subdir = config -ACLOCAL_M4 = $(top_srcdir)/aclocal.m4 -am__aclocal_m4_deps = $(top_srcdir)/m4/codeset.m4 \ - $(top_srcdir)/m4/gettext.m4 $(top_srcdir)/m4/iconv.m4 \ - $(top_srcdir)/m4/intlmacosx.m4 $(top_srcdir)/m4/lib-ld.m4 \ - $(top_srcdir)/m4/lib-link.m4 $(top_srcdir)/m4/lib-prefix.m4 \ - $(top_srcdir)/m4/libtool.m4 $(top_srcdir)/m4/ltoptions.m4 \ - $(top_srcdir)/m4/ltsugar.m4 $(top_srcdir)/m4/ltversion.m4 \ - $(top_srcdir)/m4/lt~obsolete.m4 \ - $(top_srcdir)/m4/m4_ax_check_define.m4 \ - $(top_srcdir)/m4/m4_ax_code_coverage.m4 \ - $(top_srcdir)/m4/nls.m4 $(top_srcdir)/m4/pkg.m4 \ - $(top_srcdir)/m4/po.m4 $(top_srcdir)/m4/progtest.m4 \ - $(top_srcdir)/configure.ac -am__configure_deps = $(am__aclocal_m4_deps) $(CONFIGURE_DEPENDENCIES) \ - $(ACLOCAL_M4) -DIST_COMMON = $(srcdir)/Makefile.am $(am__DIST_COMMON) -mkinstalldirs = $(SHELL) $(top_srcdir)/build_aux/mkinstalldirs -CONFIG_HEADER = $(top_builddir)/config.h -CONFIG_CLEAN_FILES = -CONFIG_CLEAN_VPATH_FILES = -AM_V_P = $(am__v_P_@AM_V@) -am__v_P_ = $(am__v_P_@AM_DEFAULT_V@) -am__v_P_0 = false -am__v_P_1 = : -AM_V_GEN = $(am__v_GEN_@AM_V@) -am__v_GEN_ = $(am__v_GEN_@AM_DEFAULT_V@) -am__v_GEN_0 = @echo " GEN " $@; -am__v_GEN_1 = -AM_V_at = $(am__v_at_@AM_V@) -am__v_at_ = $(am__v_at_@AM_DEFAULT_V@) -am__v_at_0 = @ -am__v_at_1 = -SOURCES = -DIST_SOURCES = -am__can_run_installinfo = \ - case $$AM_UPDATE_INFO_DIR in \ - n|no|NO) false;; \ - *) (install-info --version) >/dev/null 2>&1;; \ - esac -am__vpath_adj_setup = srcdirstrip=`echo "$(srcdir)" | sed 's|.|.|g'`; -am__vpath_adj = case $$p in \ - $(srcdir)/*) f=`echo "$$p" | sed "s|^$$srcdirstrip/||"`;; \ - *) f=$$p;; \ - esac; -am__strip_dir = f=`echo $$p | sed -e 's|^.*/||'`; -am__install_max = 40 -am__nobase_strip_setup = \ - srcdirstrip=`echo "$(srcdir)" | sed 's/[].[^$$\\*|]/\\\\&/g'` -am__nobase_strip = \ - for p in $$list; do echo "$$p"; done | sed -e "s|$$srcdirstrip/||" -am__nobase_list = $(am__nobase_strip_setup); \ - for p in $$list; do echo "$$p $$p"; done | \ - sed "s| $$srcdirstrip/| |;"' / .*\//!s/ .*/ ./; s,\( .*\)/[^/]*$$,\1,' | \ - $(AWK) 'BEGIN { files["."] = "" } { files[$$2] = files[$$2] " " $$1; \ - if (++n[$$2] == $(am__install_max)) \ - { print $$2, files[$$2]; n[$$2] = 0; files[$$2] = "" } } \ - END { for (dir in files) print dir, files[dir] }' -am__base_list = \ - sed '$$!N;$$!N;$$!N;$$!N;$$!N;$$!N;$$!N;s/\n/ /g' | \ - sed '$$!N;$$!N;$$!N;$$!N;s/\n/ /g' -am__uninstall_files_from_dir = { \ - test -z "$$files" \ - || { test ! -d "$$dir" && test ! -f "$$dir" && test ! -r "$$dir"; } \ - || { echo " ( cd '$$dir' && rm -f" $$files ")"; \ - $(am__cd) "$$dir" && rm -f $$files; }; \ - } -am__installdirs = "$(DESTDIR)$(configdir)" -DATA = $(config_DATA) -am__tagged_files = $(HEADERS) $(SOURCES) $(TAGS_FILES) $(LISP) -am__DIST_COMMON = $(srcdir)/Makefile.in \ - $(top_srcdir)/build_aux/mkinstalldirs ChangeLog -DISTFILES = $(DIST_COMMON) $(DIST_SOURCES) $(TEXINFOS) $(EXTRA_DIST) -ACLOCAL = @ACLOCAL@ -AMTAR = @AMTAR@ -AM_DEFAULT_VERBOSITY = @AM_DEFAULT_VERBOSITY@ -AR = @AR@ -AS = @AS@ -AUTOCONF = @AUTOCONF@ -AUTOHEADER = @AUTOHEADER@ -AUTOMAKE = @AUTOMAKE@ -AWK = @AWK@ -CC = @CC@ -CCDEPMODE = @CCDEPMODE@ -CFLAGS = @CFLAGS@ -CJSON_CFLAGS = @CJSON_CFLAGS@ -CJSON_LIBS = @CJSON_LIBS@ -COBC_LIBS = @COBC_LIBS@ -COB_BIGENDIAN = @COB_BIGENDIAN@ -COB_CC = @COB_CC@ -COB_CFLAGS = @COB_CFLAGS@ -COB_CONFIG_DIR = @COB_CONFIG_DIR@ -COB_COPY_DIR = @COB_COPY_DIR@ -COB_EXE_EXT = @COB_EXE_EXT@ -COB_EXPORT_DYN = @COB_EXPORT_DYN@ -COB_FIX_LIB = @COB_FIX_LIB@ -COB_FIX_LIBTOOL = @COB_FIX_LIBTOOL@ -COB_HAS_64_BIT_POINTER = @COB_HAS_64_BIT_POINTER@ -COB_HAS_BDB = @COB_HAS_BDB@ -COB_HAS_CISAM = @COB_HAS_CISAM@ -COB_HAS_CJSON = @COB_HAS_CJSON@ -COB_HAS_CURSES = @COB_HAS_CURSES@ -COB_HAS_DISAM = @COB_HAS_DISAM@ -COB_HAS_ISAM = @COB_HAS_ISAM@ -COB_HAS_LMDB = @COB_HAS_LMDB@ -COB_HAS_OCEXTFH = @COB_HAS_OCEXTFH@ -COB_HAS_OCI = @COB_HAS_OCI@ -COB_HAS_ODBC = @COB_HAS_ODBC@ -COB_HAS_VBISAM = @COB_HAS_VBISAM@ -COB_HAS_XML2 = @COB_HAS_XML2@ -COB_KEYWORD_INLINE = @COB_KEYWORD_INLINE@ -COB_LDFLAGS = @COB_LDFLAGS@ -COB_LIBRARY_PATH = @COB_LIBRARY_PATH@ -COB_LIBS = @COB_LIBS@ -COB_MODULE_EXT = @COB_MODULE_EXT@ -COB_OBJECT_EXT = @COB_OBJECT_EXT@ -COB_PATCH_LEVEL = @COB_PATCH_LEVEL@ -COB_PIC_FLAGS = @COB_PIC_FLAGS@ -COB_SCHEMA_DIR = @COB_SCHEMA_DIR@ -COB_SHARED_OPT = @COB_SHARED_OPT@ -CODE_COVERAGE_CFLAGS = @CODE_COVERAGE_CFLAGS@ -CODE_COVERAGE_CPPFLAGS = @CODE_COVERAGE_CPPFLAGS@ -CODE_COVERAGE_CXXFLAGS = @CODE_COVERAGE_CXXFLAGS@ -CODE_COVERAGE_ENABLED = @CODE_COVERAGE_ENABLED@ -CODE_COVERAGE_LDFLAGS = @CODE_COVERAGE_LDFLAGS@ -CODE_COVERAGE_LIBS = @CODE_COVERAGE_LIBS@ -CPP = @CPP@ -CPPFLAGS = @CPPFLAGS@ -CYGPATH_W = @CYGPATH_W@ -DEFS = @DEFS@ -DEPDIR = @DEPDIR@ -DIFF_FLAGS = @DIFF_FLAGS@ -DLLTOOL = @DLLTOOL@ -DSYMUTIL = @DSYMUTIL@ -DUMPBIN = @DUMPBIN@ -ECHO_C = @ECHO_C@ -ECHO_N = @ECHO_N@ -ECHO_T = @ECHO_T@ -EGREP = @EGREP@ -EXEEXT = @EXEEXT@ -FGREP = @FGREP@ -GCOV = @GCOV@ -GENHTML = @GENHTML@ -GETTEXT_MACRO_VERSION = @GETTEXT_MACRO_VERSION@ -GMSGFMT = @GMSGFMT@ -GMSGFMT_015 = @GMSGFMT_015@ -GREP = @GREP@ -HELP2MAN = @HELP2MAN@ -INSTALL = @INSTALL@ -INSTALL_DATA = @INSTALL_DATA@ -INSTALL_PROGRAM = @INSTALL_PROGRAM@ -INSTALL_SCRIPT = @INSTALL_SCRIPT@ -INSTALL_STRIP_PROGRAM = @INSTALL_STRIP_PROGRAM@ -INTLLIBS = @INTLLIBS@ -INTL_MACOSX_LIBS = @INTL_MACOSX_LIBS@ -LCOV = @LCOV@ -LD = @LD@ -LDFLAGS = @LDFLAGS@ -LEX = @LEX@ -LEXLIB = @LEXLIB@ -LEX_OUTPUT_ROOT = @LEX_OUTPUT_ROOT@ -LIBCOB_CISAM = @LIBCOB_CISAM@ -LIBCOB_CPPFLAGS = @LIBCOB_CPPFLAGS@ -LIBCOB_DISAM = @LIBCOB_DISAM@ -LIBCOB_LIBS = @LIBCOB_LIBS@ -LIBCOB_VBISAM = @LIBCOB_VBISAM@ -LIBICONV = @LIBICONV@ -LIBINTL = @LIBINTL@ -LIBOBJS = @LIBOBJS@ -LIBS = @LIBS@ -LIBTOOL = @LIBTOOL@ -LIPO = @LIPO@ -LN_S = @LN_S@ -LTLIBICONV = @LTLIBICONV@ -LTLIBINTL = @LTLIBINTL@ -LTLIBOBJS = @LTLIBOBJS@ -LT_SYS_LIBRARY_PATH = @LT_SYS_LIBRARY_PATH@ -MAKE = @MAKE@ -MAKEINFO = @MAKEINFO@ -MANIFEST_TOOL = @MANIFEST_TOOL@ -MKDIR_P = @MKDIR_P@ -MSGFMT = @MSGFMT@ -MSGFMT_015 = @MSGFMT_015@ -MSGMERGE = @MSGMERGE@ -NM = @NM@ -NMEDIT = @NMEDIT@ -OBJDUMP = @OBJDUMP@ -OBJEXT = @OBJEXT@ -ODBC_CFLAGS = @ODBC_CFLAGS@ -ODBC_LIBS = @ODBC_LIBS@ -OTOOL = @OTOOL@ -OTOOL64 = @OTOOL64@ -PACKAGE = @PACKAGE@ -PACKAGE_BUGREPORT = @PACKAGE_BUGREPORT@ -PACKAGE_NAME = @PACKAGE_NAME@ -PACKAGE_STRING = @PACKAGE_STRING@ -PACKAGE_TARNAME = @PACKAGE_TARNAME@ -PACKAGE_URL = @PACKAGE_URL@ -PACKAGE_VERSION = @PACKAGE_VERSION@ -PATH_SEPARATOR = @PATH_SEPARATOR@ -PKG_CONFIG = @PKG_CONFIG@ -PKG_CONFIG_LIBDIR = @PKG_CONFIG_LIBDIR@ -PKG_CONFIG_PATH = @PKG_CONFIG_PATH@ -POSUB = @POSUB@ -RANLIB = @RANLIB@ -SED = @SED@ -SET_MAKE = @SET_MAKE@ -SHELL = @SHELL@ -STRIP = @STRIP@ -USE_NLS = @USE_NLS@ -VERSION = @VERSION@ -XGETTEXT = @XGETTEXT@ -XGETTEXT_015 = @XGETTEXT_015@ -XGETTEXT_EXTRA_OPTIONS = @XGETTEXT_EXTRA_OPTIONS@ -XML2_CFLAGS = @XML2_CFLAGS@ -XML2_LIBS = @XML2_LIBS@ -YACC = @YACC@ -YFLAGS = @YFLAGS@ -abs_builddir = @abs_builddir@ -abs_srcdir = @abs_srcdir@ -abs_top_builddir = @abs_top_builddir@ -abs_top_srcdir = @abs_top_srcdir@ -ac_ct_AR = @ac_ct_AR@ -ac_ct_CC = @ac_ct_CC@ -ac_ct_DUMPBIN = @ac_ct_DUMPBIN@ -am__include = @am__include@ -am__leading_dot = @am__leading_dot@ -am__quote = @am__quote@ -am__tar = @am__tar@ -am__untar = @am__untar@ -bindir = @bindir@ -build = @build@ -build_alias = @build_alias@ -build_cpu = @build_cpu@ -build_os = @build_os@ -build_vendor = @build_vendor@ -builddir = @builddir@ -configured_make = @configured_make@ -datadir = @datadir@ -datarootdir = @datarootdir@ -docdir = @docdir@ -dvidir = @dvidir@ -exec_prefix = @exec_prefix@ -host = @host@ -host_alias = @host_alias@ -host_cpu = @host_cpu@ -host_os = @host_os@ -host_vendor = @host_vendor@ -htmldir = @htmldir@ -includedir = @includedir@ -infodir = @infodir@ -install_sh = @install_sh@ -libdir = @libdir@ -libexecdir = @libexecdir@ -localedir = @localedir@ -localstatedir = @localstatedir@ -mandir = @mandir@ -mkdir_p = @mkdir_p@ -oldincludedir = @oldincludedir@ -pdfdir = @pdfdir@ -prefix = @prefix@ -program_transform_name = @program_transform_name@ -psdir = @psdir@ -runstatedir = @runstatedir@ -sbindir = @sbindir@ -sharedstatedir = @sharedstatedir@ -srcdir = @srcdir@ -sysconfdir = @sysconfdir@ -target_alias = @target_alias@ -top_build_prefix = @top_build_prefix@ -top_builddir = @top_builddir@ -top_srcdir = @top_srcdir@ -xml2_config_found = @xml2_config_found@ -configdir = @COB_CONFIG_DIR@ -config_DATA = default.conf cobol85.conf cobol2002.conf cobol2014.conf \ - acu.conf mf.conf ibm.conf mvs.conf bs2000.conf realia.conf rm.conf \ - acu-strict.conf mf-strict.conf ibm-strict.conf mvs-strict.conf \ - bs2000-strict.conf realia-strict.conf rm-strict.conf xopen.conf \ - lax.conf-inc \ - cobol85.words cobol2002.words cobol2014.words \ - acu.words mf.words ibm.words mvs.words bs2000.words realia.words \ - rm.words runtime.cfg runtime_empty.cfg - -EXTRA_DIST = $(config_DATA) -all: all-am - -.SUFFIXES: -$(srcdir)/Makefile.in: $(srcdir)/Makefile.am $(am__configure_deps) - @for dep in $?; do \ - case '$(am__configure_deps)' in \ - *$$dep*) \ - ( cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh ) \ - && { if test -f $@; then exit 0; else break; fi; }; \ - exit 1;; \ - esac; \ - done; \ - echo ' cd $(top_srcdir) && $(AUTOMAKE) --gnu config/Makefile'; \ - $(am__cd) $(top_srcdir) && \ - $(AUTOMAKE) --gnu config/Makefile -Makefile: $(srcdir)/Makefile.in $(top_builddir)/config.status - @case '$?' in \ - *config.status*) \ - cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh;; \ - *) \ - echo ' cd $(top_builddir) && $(SHELL) ./config.status $(subdir)/$@ $(am__depfiles_maybe)'; \ - cd $(top_builddir) && $(SHELL) ./config.status $(subdir)/$@ $(am__depfiles_maybe);; \ - esac; - -$(top_builddir)/config.status: $(top_srcdir)/configure $(CONFIG_STATUS_DEPENDENCIES) - cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh - -$(top_srcdir)/configure: $(am__configure_deps) - cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh -$(ACLOCAL_M4): $(am__aclocal_m4_deps) - cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh -$(am__aclocal_m4_deps): - -mostlyclean-libtool: - -rm -f *.lo - -clean-libtool: - -rm -rf .libs _libs -install-configDATA: $(config_DATA) - @$(NORMAL_INSTALL) - @list='$(config_DATA)'; test -n "$(configdir)" || list=; \ - if test -n "$$list"; then \ - echo " $(MKDIR_P) '$(DESTDIR)$(configdir)'"; \ - $(MKDIR_P) "$(DESTDIR)$(configdir)" || exit 1; \ - fi; \ - for p in $$list; do \ - if test -f "$$p"; then d=; else d="$(srcdir)/"; fi; \ - echo "$$d$$p"; \ - done | $(am__base_list) | \ - while read files; do \ - echo " $(INSTALL_DATA) $$files '$(DESTDIR)$(configdir)'"; \ - $(INSTALL_DATA) $$files "$(DESTDIR)$(configdir)" || exit $$?; \ - done - -uninstall-configDATA: - @$(NORMAL_UNINSTALL) - @list='$(config_DATA)'; test -n "$(configdir)" || list=; \ - files=`for p in $$list; do echo $$p; done | sed -e 's|^.*/||'`; \ - dir='$(DESTDIR)$(configdir)'; $(am__uninstall_files_from_dir) -tags TAGS: - -ctags CTAGS: - -cscope cscopelist: - - -distdir: $(DISTFILES) - @srcdirstrip=`echo "$(srcdir)" | sed 's/[].[^$$\\*]/\\\\&/g'`; \ - topsrcdirstrip=`echo "$(top_srcdir)" | sed 's/[].[^$$\\*]/\\\\&/g'`; \ - list='$(DISTFILES)'; \ - dist_files=`for file in $$list; do echo $$file; done | \ - sed -e "s|^$$srcdirstrip/||;t" \ - -e "s|^$$topsrcdirstrip/|$(top_builddir)/|;t"`; \ - case $$dist_files in \ - */*) $(MKDIR_P) `echo "$$dist_files" | \ - sed '/\//!d;s|^|$(distdir)/|;s,/[^/]*$$,,' | \ - sort -u` ;; \ - esac; \ - for file in $$dist_files; do \ - if test -f $$file || test -d $$file; then d=.; else d=$(srcdir); fi; \ - if test -d $$d/$$file; then \ - dir=`echo "/$$file" | sed -e 's,/[^/]*$$,,'`; \ - if test -d "$(distdir)/$$file"; then \ - find "$(distdir)/$$file" -type d ! -perm -700 -exec chmod u+rwx {} \;; \ - fi; \ - if test -d $(srcdir)/$$file && test $$d != $(srcdir); then \ - cp -fpR $(srcdir)/$$file "$(distdir)$$dir" || exit 1; \ - find "$(distdir)/$$file" -type d ! -perm -700 -exec chmod u+rwx {} \;; \ - fi; \ - cp -fpR $$d/$$file "$(distdir)$$dir" || exit 1; \ - else \ - test -f "$(distdir)/$$file" \ - || cp -p $$d/$$file "$(distdir)/$$file" \ - || exit 1; \ - fi; \ - done -check-am: all-am -check: check-am -all-am: Makefile $(DATA) -installdirs: - for dir in "$(DESTDIR)$(configdir)"; do \ - test -z "$$dir" || $(MKDIR_P) "$$dir"; \ - done -install: install-am -install-exec: install-exec-am -install-data: install-data-am -uninstall: uninstall-am - -install-am: all-am - @$(MAKE) $(AM_MAKEFLAGS) install-exec-am install-data-am - -installcheck: installcheck-am -install-strip: - if test -z '$(STRIP)'; then \ - $(MAKE) $(AM_MAKEFLAGS) INSTALL_PROGRAM="$(INSTALL_STRIP_PROGRAM)" \ - install_sh_PROGRAM="$(INSTALL_STRIP_PROGRAM)" INSTALL_STRIP_FLAG=-s \ - install; \ - else \ - $(MAKE) $(AM_MAKEFLAGS) INSTALL_PROGRAM="$(INSTALL_STRIP_PROGRAM)" \ - install_sh_PROGRAM="$(INSTALL_STRIP_PROGRAM)" INSTALL_STRIP_FLAG=-s \ - "INSTALL_PROGRAM_ENV=STRIPPROG='$(STRIP)'" install; \ - fi -mostlyclean-generic: - -clean-generic: - -distclean-generic: - -test -z "$(CONFIG_CLEAN_FILES)" || rm -f $(CONFIG_CLEAN_FILES) - -test . = "$(srcdir)" || test -z "$(CONFIG_CLEAN_VPATH_FILES)" || rm -f $(CONFIG_CLEAN_VPATH_FILES) - -maintainer-clean-generic: - @echo "This command is intended for maintainers to use" - @echo "it deletes files that may require special tools to rebuild." -clean: clean-am - -clean-am: clean-generic clean-libtool mostlyclean-am - -distclean: distclean-am - -rm -f Makefile -distclean-am: clean-am distclean-generic - -dvi: dvi-am - -dvi-am: - -html: html-am - -html-am: - -info: info-am - -info-am: - -install-data-am: install-configDATA - -install-dvi: install-dvi-am - -install-dvi-am: - -install-exec-am: - -install-html: install-html-am - -install-html-am: - -install-info: install-info-am - -install-info-am: - -install-man: - -install-pdf: install-pdf-am - -install-pdf-am: - -install-ps: install-ps-am - -install-ps-am: - -installcheck-am: - -maintainer-clean: maintainer-clean-am - -rm -f Makefile -maintainer-clean-am: distclean-am maintainer-clean-generic - -mostlyclean: mostlyclean-am - -mostlyclean-am: mostlyclean-generic mostlyclean-libtool - -pdf: pdf-am - -pdf-am: - -ps: ps-am - -ps-am: - -uninstall-am: uninstall-configDATA - -.MAKE: install-am install-strip - -.PHONY: all all-am check check-am clean clean-generic clean-libtool \ - cscopelist-am ctags-am distclean distclean-generic \ - distclean-libtool distdir dvi dvi-am html html-am info info-am \ - install install-am install-configDATA install-data \ - install-data-am install-dvi install-dvi-am install-exec \ - install-exec-am install-html install-html-am install-info \ - install-info-am install-man install-pdf install-pdf-am \ - install-ps install-ps-am install-strip installcheck \ - installcheck-am installdirs maintainer-clean \ - maintainer-clean-generic mostlyclean mostlyclean-generic \ - mostlyclean-libtool pdf pdf-am ps ps-am tags-am uninstall \ - uninstall-am uninstall-configDATA - -.PRECIOUS: Makefile - - -# Tell versions [3.59,3.63) of GNU make to not export all variables. -# Otherwise a system limit (for SysV at least) may be exceeded. -.NOEXPORT: diff -Nru gnucobol-4.0~early~20200606/config/mf.conf gnucobol-5/config/mf.conf --- gnucobol-4.0~early~20200606/config/mf.conf 2020-06-06 20:52:02.000000000 +0000 +++ gnucobol-5/config/mf.conf 1970-01-01 00:00:00.000000000 +0000 @@ -1,35 +0,0 @@ -# GnuCOBOL compiler configuration -# -# Copyright (C) 2001-2012, 2014-2017 Free Software Foundation, Inc. -# Written by Keisuke Nishida, Roger While, Simon Sobisch, Edward Hart -# -# This file is part of GnuCOBOL. -# -# The GnuCOBOL compiler is free software: you can redistribute it -# and/or modify it under the terms of the GNU General Public License -# as published by the Free Software Foundation, either version 3 of the -# License, or (at your option) any later version. -# -# GnuCOBOL is distributed in the hope that it will be useful, -# but WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -# GNU General Public License for more details. -# -# You should have received a copy of the GNU General Public License -# along with GnuCOBOL. If not, see . - - -include "mf-strict.conf" - -# Value: any string -name: "Micro Focus COBOL (lax)" - -# reserve additional words, synonyms and exceptions from normal word list -include: "mf.words" - -# not-reserved: -# Value: Word to be taken out of the reserved words list -# -fill upon request- - -include "lax.conf-inc" -synchronized-clause: ignore # only active with IBMCOMP=OK (active with dialects IBM + RM) diff -Nru gnucobol-4.0~early~20200606/config/mf-strict.conf gnucobol-5/config/mf-strict.conf --- gnucobol-4.0~early~20200606/config/mf-strict.conf 2020-06-06 20:52:02.000000000 +0000 +++ gnucobol-5/config/mf-strict.conf 1970-01-01 00:00:00.000000000 +0000 @@ -1,260 +0,0 @@ -# GnuCOBOL compiler configuration -# -# Copyright (C) 2001-2012, 2014-2020 Free Software Foundation, Inc. -# Written by Keisuke Nishida, Roger While, Simon Sobisch, Edward Hart, -# Ron Norman -# -# This file is part of GnuCOBOL. -# -# The GnuCOBOL compiler is free software: you can redistribute it -# and/or modify it under the terms of the GNU General Public License -# as published by the Free Software Foundation, either version 3 of the -# License, or (at your option) any later version. -# -# GnuCOBOL is distributed in the hope that it will be useful, -# but WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -# GNU General Public License for more details. -# -# You should have received a copy of the GNU General Public License -# along with GnuCOBOL. If not, see . - - -# Value: any string -name: "Micro Focus COBOL" - -# Value: enum -standard-define 1 -# CB_STD_OC = 0, -# CB_STD_MF, -# CB_STD_IBM, -# CB_STD_MVS, -# CB_STD_BS2000, -# CB_STD_ACU, -# CB_STD_85, -# CB_STD_2002, -# CB_STD_2014 - -# Value: int -tab-width: 8 -text-column: 72 -# Maximum word-length for COBOL words / Programmer defined words -# current max (COB_MAX_WORDLEN): 63 -#word-length: 127 -word-length: 63 -literal-length: 8192 -numeric-literal-length: 18 -pic-length: 50 - -# Default assign type -# Value: 'dynamic', 'external' -assign-clause: dynamic - -# If yes, file names are resolved at run time using -# environment variables. -# For example, given ASSIGN TO "DATAFILE", the file name will be -# 1. the value of environment variable 'DD_DATAFILE' or -# 2. the value of environment variable 'dd_DATAFILE' or -# 3. the value of environment variable 'DATAFILE' or -# 4. the literal "DATAFILE" -# If no, the value of the assign clause is the file name. -# -filename-mapping: yes - -# Alternate formatting of numeric fields -pretty-display: yes - -# Allow complex OCCURS DEPENDING ON -complex-odo: yes - -# Allow REDEFINES to other than last equal level number -indirect-redefines: yes - -# Binary byte size - defines the allocated bytes according to PIC -# Value: signed unsigned bytes -# ------ -------- ----- -# '2-4-8' 1 - 4 same 2 -# 5 - 9 same 4 -# 10 - 18 same 8 -# -# '1-2-4-8' 1 - 2 same 1 -# 3 - 4 same 2 -# 5 - 9 same 4 -# 10 - 18 same 8 -# -# '1--8' 1 - 2 1 - 2 1 -# 3 - 4 3 - 4 2 -# 5 - 6 5 - 7 3 -# 7 - 9 8 - 9 4 -# 10 - 11 10 - 12 5 -# 12 - 14 13 - 14 6 -# 15 - 16 15 - 16 7 -# 17 - 18 17 - 18 8 -# -binary-size: 1--8 - -# Numeric truncation according to ANSI -binary-truncate: no - -# Binary byte order -# Value: 'native', 'big-endian' -binary-byteorder: big-endian - -# Allow larger REDEFINES items -larger-redefines-ok: yes - -# Allow certain syntax variations (eg. REDEFINES position) -relax-syntax-checks: yes - -# Perform type OSVS - If yes, the exit point of any currently -# executing perform is recognized if reached. -perform-osvs: no - -# Compute intermediate decimal results like IBM OSVS -arithmetic-osvs: no - -# MOVE like IBM (mvc); left to right, byte by byte -move-ibm: no - -# If yes, linkage-section items remain allocated -# between invocations. -sticky-linkage: no - -# If yes, allow non-matching level numbers -relax-level-hierarchy: yes - -# If yes, evaluate constant expressions at compile time -constant-folding: yes # not verified yet - -# Allow Hex 'F' for NUMERIC test of signed PACKED DECIMAL field -hostsign: no - -# If yes, set WITH UPDATE clause as default for ACCEPT dest-item, -# except if WITH NO UPDATE clause is used -accept-update: no # not verified yet - -# If yes, set WITH AUTO clause as default for ACCEPT dest-item, -# except if WITH TAB clause is used -accept-auto: no # not verified yet - -# If yes, DISPLAYs and ACCEPTs are, by default, done on the CRT (i.e., using -# curses). -console-is-crt: no - -# If yes, allow redefinition of the current program's name. This prevents its -# use in a prototype-format CALL/CANCEL statement. -program-name-redefinition: yes - -# If yes, NO ECHO/NO-ECHO/OFF is the same as SECURE (hiding input with -# asterisks, not spaces). -no-echo-means-secure: yes - -# If yes, the first item in a field screen ACCEPT/DISPLAY (e.g. DISPLAY x UPON -# CRT) is located after the previous ACCEPT/DISPLAY (as though LINE 0 COL 0 had -# been specified). -line-col-zero-default: no - -# If yes, then REPORT, COLUMN may have any of PLUS num, + num, or +num -# to define a relative column position -report-column-plus: no - -# If yes, DISPLAY SPACES acts as ERASE EOS, DISPLAY X"01" acts as ERASE EOL, -# DISPLAY X"02" acts as BLANK SCREEEN and DISPLAY X"07" acts as BELL. Note -# DISPLAY LOW-VALUE is excluded from this; it will always just position the -# cursor. -display-special-fig-consts: yes - -# If yes, COMP-1 is a signed 16-bit integer and any PICTURE clause is ignored. -binary-comp-1: no - -# auto-adjust to zero like MicroFocus does -move-non-numeric-lit-to-numeric-is-zero: yes - -# If yes, implicitly define a variable for an ASSIGN DYNAMIC which does not -# match an existing data item. -implicit-assign-dynamic-var: yes - -# What rules to apply to SCREEN SECTION items clauses -screen-section-rules: mf - -# Dialect features -# Value: 'ok', 'warning', 'archaic', 'obsolete', 'skip', 'ignore', 'error', -# 'unconformable' - -alter-statement: obsolete -comment-paragraphs: obsolete -call-overflow: ok -data-records-clause: obsolete -debugging-mode: ok -use-for-debugging: obsolete -listing-statements: ok -title-statement: ok -entry-statement: ok -goto-statement-without-name: obsolete -label-records-clause: obsolete -memory-size-clause: obsolete -move-noninteger-to-alphanumeric: warning -move-figurative-constant-to-numeric: ok -move-figurative-space-to-numeric: ok -move-figurative-quote-to-numeric: ok -multiple-file-tape-clause: obsolete -next-sentence-phrase: archaic -odo-without-to: ok -padding-character-clause: obsolete -section-segments: ignore -stop-literal-statement: obsolete -stop-identifier-statement: unconformable -same-as-clause: unconformable -synchronized-clause: ignore # only active with IBMCOMP=OK (active with dialects IBM + RM) -sync-left-right: ok # actually working with IBMCOMP / IBM dialect -special-names-clause: error -top-level-occurs-clause: ok -value-of-clause: obsolete -numeric-boolean: ok # this can be changed by the BINLINT directive (default is NUMERIC=OK) -hexadecimal-boolean: unconformable -national-literals: ok -hexadecimal-national-literals: ok -national-character-literals: unconformable -# TO-DO: Add separate config option for H"..." to be unsupported,numeric(rm/mf),non-numeric -acu-literals: unconformable -hp-octal-literals: unconformable -word-continuation: ok -occurs-max-length-without-subscript: no -length-in-data-division: no -depending-on-not-fixed: warning -not-exception-before-exception: unconformable -accept-display-extensions: ok -renames-uncommon-levels: ok -symbolic-constant: unconformable -constant-78: ok -constant-01: unconformable -perform-varying-without-by: unconformable -reference-out-of-declaratives: warning # not verified yet -reference-bounds-check: ok -program-prototypes: ok -call-convention-mnemonic: ok -call-convention-linkage: unconformable -numeric-value-for-edited-item: error -incorrect-conf-sec-order: ok -define-constant-directive: unconformable -free-redefines-position: ok -records-mismatch-record-clause: ok # follows IBM "if not matching use the record size" -record-delimiter: ok -sequential-delimiters: ok -record-delim-with-fixed-recs: ok -missing-statement: error # according to documentation -zero-length-literals: unconformable -xml-generate-extra-phrases: ok -continue-after: unconformable -goto-entry: unconformable -binary-sync-clause: ignore -nonnumeric-with-numeric-group-usage: ok -assign-variable: unconformable -assign-using-variable: unconformable -assign-ext-dyn: ok -assign-disk-from: ok -align-record: 8 -align-opt: yes - -# use fixed word list, synonyms and exceptions specified there -reserved-words: MF diff -Nru gnucobol-4.0~early~20200606/config/mf.words gnucobol-5/config/mf.words --- gnucobol-4.0~early~20200606/config/mf.words 2020-06-06 20:52:02.000000000 +0000 +++ gnucobol-5/config/mf.words 1970-01-01 00:00:00.000000000 +0000 @@ -1,777 +0,0 @@ -# GnuCOBOL compiler - list of reserved words -# -# Copyright (C) 2016-2017 Free Software Foundation, Inc. -# Written by Simon Sobisch, Edward Hart -# -# This file is part of GnuCOBOL. -# -# The GnuCOBOL compiler is free software: you can redistribute it -# and/or modify it under the terms of the GNU General Public License -# as published by the Free Software Foundation, either version 3 of the -# License, or (at your option) any later version. -# -# GnuCOBOL is distributed in the hope that it will be useful, -# but WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -# GNU General Public License for more details. -# -# You should have received a copy of the GNU General Public License -# along with GnuCOBOL. If not, see . - - -# Word list for dialect: Micro Focus COBOL - -# Note: only used for strict dialect and when -# requested by compiler directive >> IMP WORDS MF -# the default reserved word list will not be used. - -# Value: Word to make up reserved words list (case independent) -# All reserved entries listed will replace entire default reserved words list. -# Words ending with * will be treated as context-sensitive words. This will be -# ignored if GnuCOBOL uses that word as a reserved word. -# Entries of the form word-1=word-2 define word-1 as an alias for default -# reserved word word-2. No spaces are allowed around the equal sign. -reserved: ABSTRACT -reserved: ACCEPT -reserved: ACCESS -reserved: ACQUIRE -reserved: ACTIVE-CLASS -reserved: ADD -reserved: ADDRESS -reserved: ADVANCING -reserved: AFTER -reserved: ALL -reserved: ALLOCATE -reserved: ALPHABET -reserved: ALPHABETIC -reserved: ALPHABETIC-LOWER -reserved: ALPHABETIC-UPPER -reserved: ALPHANUMERIC -reserved: ALPHANUMERIC-EDITED -reserved: ALSO -reserved: ALTER -reserved: ALTERNATE -reserved: AND -reserved: ANY -reserved: ARE -reserved: AREA -reserved: AREAS -reserved: ARGUMENT-NUMBER -reserved: ARGUMENT-VALUE -reserved: AS -reserved: ASCENDING -reserved: ASSIGN -reserved: AT -reserved: ATTRIBUTE -reserved: ATTRIBUTES -reserved: AUTHOR -reserved: AUTO* -reserved: AUTO-HYPHEN-SKIP -reserved: AUTO-SKIP=AUTO -reserved: AUTOMATIC -reserved: B-AND -reserved: B-EXOR -reserved: B-LEFT -reserved: B-NOT -reserved: B-OR -reserved: B-RIGHT -reserved: B-XOR -reserved: BACKGROUND-COLOR* -reserved: BACKGROUND-COLOUR*=BACKGROUND-COLOR -reserved: BACKWARD -reserved: BEEP=BELL -reserved: BEFORE -reserved: BELL -reserved: BINARY -reserved: BINARY -reserved: BINARY-CHAR -reserved: BINARY-DOUBLE -reserved: BINARY-LONG -reserved: BINARY-SEQUENTIAL* -reserved: BINARY-SHORT -reserved: BIT -reserved: BLANK -reserved: BLINK -reserved: BLOB -reserved: BLOB-FILE -reserved: BLOB-LOCATOR -reserved: BLOCK -reserved: BOOLEAN -reserved: BOTTOM -reserved: BROWSING -reserved: BY -reserved: CALL -reserved: CALLED -reserved: CANCEL -reserved: CD -reserved: CF -reserved: CH -reserved: CHAIN -reserved: CHAINING -reserved: CHANGED -reserved: CHAR -reserved: CHAR-VARYING -reserved: CHARACTER -reserved: CHARACTERS -reserved: CLASS -reserved: CLASS-CONTROL -reserved: CLASS-ID -reserved: CLASS-OBJECT -reserved: CLOB -reserved: CLOB-FILE -reserved: CLOB-LOCATOR -reserved: CLOCK-UNITS -reserved: CLOSE -reserved: COBOL -reserved: CODE -reserved: CODE-SET -reserved: COERCION -reserved: COL -reserved: COLLATING -reserved: COLUMN -reserved: COMMA -reserved: COMMAND-LINE -reserved: COMMIT -reserved: COMMITMENT -reserved: COMMON -reserved: COMMUNICATION -reserved: COMP -reserved: COMP-0 -reserved: COMP-1 -reserved: COMP-2 -reserved: COMP-3 -reserved: COMP-4 -reserved: COMP-5 -reserved: COMP-6 -reserved: COMP-X -reserved: COMPUTATIONAL -reserved: COMPUTATIONAL-0 -reserved: COMPUTATIONAL-1 -reserved: COMPUTATIONAL-2 -reserved: COMPUTATIONAL-3 -reserved: COMPUTATIONAL-4 -reserved: COMPUTATIONAL-5 -reserved: COMPUTATIONAL-6 -reserved: COMPUTATIONAL-X -reserved: COMPUTE -reserved: CONFIGURATION -# reserved: CONSOLE* --> mnemonic device should not be in reserved list -reserved: CONTAINS -reserved: CONTENT -reserved: CONTINUE -reserved: CONTROL -reserved: CONTROL-AREA -reserved: CONTROLS -reserved: CONVERTING -reserved: COPY -reserved: CORR -reserved: CORRESPONDING -reserved: COUNT -reserved: CRT -reserved: CRT-UNDER -reserved: CURRENCY -reserved: CURSOR -reserved: CYCLE* -reserved: DATA -reserved: DATA-POINTER* -reserved: DATE -reserved: DATE-AND-TIME -reserved: DATE-COMPILED -reserved: DATE-RECORD -reserved: DATE-WRITTEN -reserved: DAY -reserved: DAY-AND-TIME -reserved: DAY-OF-WEEK -reserved: DBCLOB -reserved: DBCLOB-FILE -reserved: DBCLOB-LOCATOR -reserved: DBCS -reserved: DE -reserved: DEBUGGING -reserved: DECIMAL-POINT -reserved: DECLARATIVES -reserved: DEFAULT -reserved: DEFINITION -reserved: DELETE -reserved: DELIMITED -reserved: DELIMITER -reserved: DEPENDING -reserved: DESCENDING -reserved: DESTINATION -reserved: DETAIL -reserved: DISABLE -reserved: DISJOINING -reserved: DISK -reserved: DISPLAY -reserved: DISPLAY-1 -reserved: DIVIDE -reserved: DIVISION -reserved: DOWN -reserved: DROP -reserved: DUPLICATES -reserved: DYNAMIC -reserved: EGI -reserved: EJECT -reserved: ELEMENT* -reserved: ELSE -reserved: EMI -reserved: EMPTY-CHECK=REQUIRED -reserved: ENABLE -reserved: ENCODING -reserved: END -reserved: END-ACCEPT -reserved: END-ADD -reserved: END-CALL -reserved: END-CHAIN -reserved: END-COMPUTE -reserved: END-DELETE -reserved: END-DISPLAY -reserved: END-DIVIDE -reserved: END-EVALUATE -reserved: END-IF -reserved: END-INVOKE -reserved: END-JSON -reserved: END-MULTIPLY -reserved: END-OF-PAGE -reserved: END-PERFORM -reserved: END-READ -reserved: END-RECEIVE -reserved: END-RETURN -reserved: END-REWRITE -reserved: END-SEARCH -reserved: END-START -reserved: END-STRING -reserved: END-SUBTRACT -reserved: END-UNSTRING -reserved: END-WAIT -reserved: END-WRITE -reserved: END-XML -reserved: ENTER -reserved: ENTRY -reserved: ENVIRONMENT -reserved: EOL* -reserved: EOP -reserved: EOS* -reserved: EQUAL -reserved: EQUALS=EQUAL -reserved: ERASE* -reserved: ERROR -reserved: ESCAPE -reserved: ESI -reserved: EVALUATE -reserved: EVENT-POINTER -reserved: EVERY -reserved: EXCEEDS -reserved: EXCEPTION -reserved: EXCESS-3 -reserved: EXCLUSIVE -reserved: EXEC -reserved: EXECUTE -reserved: EXHIBIT -reserved: EXIT -reserved: EXPANDS* -reserved: EXTEND -reserved: EXTERNAL -reserved: EXTERNAL-FORM -reserved: EXTERNALLY-DESCRIBED-KEY -reserved: F* -reserved: FACTORY -reserved: FALSE -reserved: FD -reserved: FH--FCD -reserved: FH--KEYDEF -reserved: FILE -reserved: FILE-CONTROL -reserved: FILE-ID -reserved: FILLER -reserved: FINAL -reserved: FIRST -reserved: FIXED -reserved: FLOAT-EXTENDED -reserved: FLOAT-LONG -reserved: FLOAT-SHORT -reserved: FOOTING -reserved: FOR -reserved: FOREGROUND-COLOR* -reserved: FOREGROUND-COLOUR*=FOREGROUND-COLOR -reserved: FREE -reserved: FROM -reserved: FULL* -reserved: FUNCTION -reserved: FUNCTION-ID -reserved: FUNCTION-POINTER -reserved: GENERATE -reserved: GET -reserved: GIVING -reserved: GLOBAL -reserved: GO -reserved: GOBACK -reserved: GREATER -reserved: GRID -reserved: GROUP -reserved: GROUP-USAGE -reserved: HEADING -reserved: HIGH-VALUE -reserved: HIGH-VALUES=HIGH-VALUE -reserved: HIGHLIGHT* -reserved: I-O -reserved: I-O-CONTROL -reserved: ID -reserved: IDENTIFICATION -reserved: IDENTIFIED -reserved: IF -reserved: IGNORE -reserved: IMPLEMENTS -reserved: IN -reserved: INDEX -reserved: INDEXED -reserved: INDIC -reserved: INDICATE -reserved: INDICATOR -reserved: INDICATORS -reserved: INHERITING -reserved: INHERITS -reserved: INITIAL -reserved: INITIALIZE -reserved: INITIATE -reserved: INPUT -reserved: INPUT-OUTPUT -reserved: INSPECT -reserved: INSTALLATION -reserved: INSTANCE -reserved: INTERFACE -reserved: INTERFACE-ID -reserved: INTO -reserved: INTRINSIC -reserved: INVALID -reserved: INVOKE -reserved: INVOKED -reserved: IS -reserved: JAPANESE -reserved: JOINING -reserved: JSON -reserved: JSON-COUNTER # note: this is a register, move as soon as supported -reserved: JUST -reserved: JUSTIFIED -reserved: KANJI -reserved: KEPT -reserved: KEY -reserved: KEYBOARD -reserved: LABEL -reserved: LAST -reserved: LEADING -reserved: LEFT -reserved: LEFT-JUSTIFY -reserved: LEFTLINE -reserved: LENGTH -reserved: LENGTH-CHECK=FULL -reserved: LESS -reserved: LIMIT -reserved: LIMITS -reserved: LINAGE -reserved: LINAGE-COUNTER -reserved: LINE -reserved: LINE-COUNTER -reserved: LINES -reserved: LINE-SEQUENTIAL* -reserved: LINKAGE -reserved: LOCAL-STORAGE -reserved: LOCK -reserved: LONG-VARBINARY -reserved: LONG-VARCHAR -reserved: LOW-VALUE -reserved: LOW-VALUES=LOW-VALUE -reserved: LOWER -reserved: LOWLIGHT* -reserved: MANUAL* -reserved: MEMORY -reserved: MERGE -reserved: MESSAGE -reserved: METHOD -reserved: METHOD-ID -reserved: MODE -reserved: MODIFIED -reserved: MODULES -reserved: MONITOR-POINTER -reserved: MOVE -reserved: MULTIPLE* -reserved: MULTIPLY -reserved: MUTEX-POINTER -reserved: NAME* -reserved: NAMED -reserved: NAMESPACE -reserved: NAMESPACE-PREFIX -reserved: NATIONAL -reserved: NATIONAL-EDITED -reserved: NATIVE -reserved: NCHAR -reserved: NEGATIVE -reserved: NESTED -reserved: NEXT -reserved: NO -reserved: NO-ECHO -reserved: NONNUMERIC* -reserved: NOT -reserved: NULL -reserved: NULLS=NULL -reserved: NUMBER -reserved: NUMERIC -reserved: NUMERIC-EDITED -reserved: O-FILL -reserved: OBJECT -reserved: OBJECT-COMPUTER -reserved: OBJECT-ID -reserved: OBJECT-REFERENCE -reserved: OBJECT-STORAGE -reserved: OCCURS -reserved: OF -reserved: OFF -reserved: OMITTED -reserved: ON -reserved: ONLY* -reserved: OOSTACKPTR -reserved: OPEN -reserved: OPTIONAL -reserved: OR -reserved: ORDER -reserved: ORGANIZATION -reserved: OTHER -reserved: OUTPUT -reserved: OVERFLOW -reserved: OVERLINE -reserved: OVERRIDE -reserved: PACKED-DECIMAL -reserved: PADDING -reserved: PAGE -reserved: PAGE-COUNTER -reserved: PARAGRAPH* -reserved: PARSE -reserved: PERFORM -reserved: PF -reserved: PH -reserved: PIC -reserved: PICTURE -reserved: PLUS -reserved: POINTER -reserved: POSITION -reserved: POSITIVE -reserved: PREFIXING -reserved: PREVIOUS* -reserved: PRINTER -reserved: PRINTER-1 -reserved: PRINTING -reserved: PRIOR -reserved: PRIVATE -reserved: PROCEDURE -reserved: PROCEDURE-POINTER -reserved: PROCEDURES -reserved: PROCEED -reserved: PROCESS -reserved: PROCESSING -reserved: PROGRAM -reserved: PROGRAM-ID -reserved: PROGRAM-POINTER -reserved: PROMPT -reserved: PROPERTY -reserved: PROTECTED -reserved: PROTOTYPE -reserved: PUBLIC -reserved: PURGE -reserved: QUEUE -reserved: QUOTE -reserved: QUOTES -reserved: RANDOM -reserved: RANGE -reserved: RD -reserved: READ -reserved: READING -reserved: READY -reserved: RECEIVE -reserved: RECORD -reserved: RECORDING -reserved: RECORDS -reserved: RECURSIVE* -reserved: REDEFINES -reserved: REDEFINITION -reserved: REEL -reserved: REFERENCE -reserved: REFERENCES -reserved: RELATIVE -reserved: RELEASE -reserved: REMAINDER -reserved: REMOVAL -reserved: RENAMES -reserved: REPEATED -reserved: REPLACE -reserved: REPLACING -reserved: REPORT -reserved: REPORTING -reserved: REPORTS -reserved: REPOSITORY -reserved: REQUIRED* -reserved: RERUN -reserved: RESERVE -reserved: RESET -reserved: RESTRICTED -reserved: RESULT-SET-LOCATOR -reserved: RETURN -reserved: RETURNING -reserved: REVERSE-VIDEO* -reserved: REVERSED -reserved: REWIND -reserved: REWRITE -reserved: RF -reserved: RH -reserved: RIGHT -reserved: RIGHT-JUSTIFY -reserved: ROLLBACK -reserved: ROLLING -reserved: ROUNDED -reserved: ROWID -reserved: RUN -reserved: S* -reserved: SAME -reserved: SCREEN -reserved: SD -reserved: SEARCH -reserved: SECTION -reserved: SECURE* -reserved: SECURITY -reserved: SEGMENT -reserved: SEGMENT-LIMIT -reserved: SELECT -reserved: SELF -reserved: SELFCLASS -reserved: SEMAPHORE-POINTER -reserved: SEND -reserved: SENTENCE -reserved: SEPARATE -reserved: SEQUENCE -reserved: SEQUENTIAL -reserved: SET -reserved: SHARING -reserved: SIGN -reserved: SIGNED* -reserved: SIZE -reserved: SKIP1 -reserved: SKIP2 -reserved: SKIP3 -reserved: SORT -reserved: SORT-MERGE -reserved: SOURCE -reserved: SOURCE-COMPUTER -reserved: SPACE -reserved: SPACE-FILL -reserved: SPACES=SPACE -reserved: SPECIAL-NAMES -reserved: SQL -reserved: STANDARD -reserved: STANDARD-1 -reserved: STANDARD-2 -reserved: START -reserved: STARTING -reserved: STATUS -reserved: STOP -reserved: STRING -reserved: SUB-QUEUE-1 -reserved: SUB-QUEUE-2 -reserved: SUB-QUEUE-3 -reserved: SUBFILE -reserved: SUBTRACT -reserved: SUFFIXING -reserved: SUM -reserved: SUPER -reserved: SUPPRESS -reserved: SYMBOL* -reserved: SYMBOLIC -reserved: SYNC -reserved: SYNCHRONIZED -reserved: TABLE -reserved: TALLYING -reserved: TAPE -reserved: TERMINAL -reserved: TERMINATE -reserved: TEST -reserved: TEXT -reserved: THAN -reserved: THEN -reserved: THREAD-LOCAL -reserved: THREAD-LOCAL-STORAGE -reserved: THREAD-POINTER -reserved: THROUGH -reserved: THRU -reserved: TIME -reserved: TIME-OUT -reserved: TIME-RECORD -reserved: TIMEOUT=TIME-OUT -reserved: TIMES -reserved: TIMESTAMP -reserved: TIMESTAMP-OFFSET -reserved: TIMESTAMP-OFFSET-RECORD -reserved: TIMESTAMP-RECORD -reserved: TITLE -reserved: TO -reserved: TOP -reserved: TRACE -reserved: TRAILING -reserved: TRAILING-SIGN -reserved: TRUE -reserved: TYPE -reserved: TYPEDEF -reserved: U* -reserved: UNBOUNDED* -reserved: UNDERLINE* -reserved: UNEQUAL -reserved: UNIT -reserved: UNIVERSAL -reserved: UNLOCK -reserved: UNSIGNED* -reserved: UNSTRING -reserved: UNTIL -reserved: UP -reserved: UPDATE -reserved: UPON -reserved: UPPER -reserved: USAGE -reserved: USE -reserved: USER -reserved: USING -reserved: V* -reserved: VALIDATING -reserved: VALUE -reserved: VALUES=VALUE -reserved: VARBINARY -reserved: VARIABLE -reserved: VARYING -reserved: WAIT -reserved: WHEN -reserved: WHEN-COMPILED -reserved: WITH -reserved: WORDS -reserved: WORKING-STORAGE -reserved: WRITE -reserved: WRITING -reserved: XML -reserved: XML-DECLARATION -reserved: XML-EVENT # note: this is a register, move as soon as supported -reserved: XML-INFORMATION # note: this is a register, move as soon as supported -reserved: XML-NAMESPACE # note: this is a register, move as soon as supported -reserved: XML-NAMESPACE-PREFIX # note: this is a register, move as soon as supported -reserved: XML-NNAMESPACE # note: this is a register, move as soon as supported -reserved: XML-NNAMESPACE-PREFIX # note: this is a register, move as soon as supported -reserved: XML-NTEXT # note: this is a register, move as soon as supported -reserved: XML-SCHEMA -reserved: XML-TEXT # note: this is a register, move as soon as supported -reserved: YYYYDDD* -reserved: YYYYMMDD* -reserved: ZERO -reserved: ZERO-FILL -reserved: ZEROES=ZERO -reserved: ZEROS=ZERO - - -# list of registers: -not-register: DIALECT-ALL -register: "ADDRESS\ OF" -# register: COM-REG # only available is DOS/VS mode. -# register: CURRENT-DATE # only available in OS/VS mode -register: DEBUG-ITEM -# register: JSON-CODE -register: "LENGTH\ OF" # only available in OS/VS or VSC2 mode or otherwise in 78-item's value clause. -# register: LINAGE-COUNTER -# register: LINE-COUNTER -# register: PAGE-COUNTER -# register: PRINT-SWITCH # only available in OS/VS mode -register: RETURN-CODE # Note this varies according to MF/OSVS/VSC2/XOpen mode. -# register: SHIFT-OUT # only available in VSC2 mode -# register: SHIFT-IN # only available in VSC2 mode -# register: SORT-CONTROL # only available in VSC2 mode -# register: SORT-CORE-SIZE # only available in OS/VS or VSC2 modes -# register: SORT-FILE-SIZE # only available in OS/VS or VSC2 modes -# register: SORT-MESSAGE # only available in OS/VS or VSC2 modes -# register: SORT-MODE-SIZE # only available in OS/VS or VSC2 modes -register: SORT-RETURN -# register: TALLY # only available in OS/VS or VSC2 modes -# register: TIME-OF-DAY # only available in OS/VS mode -# register: WHEN-COMPILED # only available in OS/VS or VSC2 modes (note the format of the date differs with the mode!) -register: XML-CODE -# register: XML-EVENT -# register: XML-INFORMATION -# register: XML-NAMESPACE -# register: XML-NAMESPACE-PREFIX -# register: XML-NNAMESPACE -# register: XML-NNAMESPACE-PREFIX -# register: XML-NTEXT -# register: XML-TEXT - -# disable all functions -not-intrinsic-function: DIALECT-ALL - -# add all that are supported by MF COBOL -intrinsic-function: ABS -intrinsic-function: ACOS -intrinsic-function: ANNUITY -intrinsic-function: ASIN -intrinsic-function: ATAN -intrinsic-function: BOOLEAN-OF-INTEGER -intrinsic-function: BYTE-LENGTH -intrinsic-function: CHAR -intrinsic-function: CHAR-NATIONAL -intrinsic-function: COMBINED-DATETIME -intrinsic-function: COS -intrinsic-function: CURRENT-DATE -intrinsic-function: DATE-OF-INTEGER -intrinsic-function: DATE-TO-YYYYMMDD -intrinsic-function: DAY-OF-INTEGER -intrinsic-function: DAY-TO-YYYYDDD -intrinsic-function: DISPLAY-OF -intrinsic-function: E -intrinsic-function: EXP -intrinsic-function: EXP10 -intrinsic-function: FACTORIAL -intrinsic-function: FRACTION-PART -intrinsic-function: INTEGER -intrinsic-function: INTEGER-OF-DATE -intrinsic-function: INTEGER-OF-DAY -intrinsic-function: INTEGER-OF-FORMATTED-DATE -intrinsic-function: INTEGER-PART -intrinsic-function: LENGTH -intrinsic-function: LENGTH-AN -intrinsic-function: LOG -intrinsic-function: LOG10 -intrinsic-function: LOWER-CASE -intrinsic-function: LOWEST-ALGEBRAIC -intrinsic-function: MAX -intrinsic-function: MEAN -intrinsic-function: MEDIAN -intrinsic-function: MIDRANGE -intrinsic-function: MIN -intrinsic-function: MOD -intrinsic-function: NATIONAL-OF -intrinsic-function: NUMVAL -intrinsic-function: NUMVAL-C -intrinsic-function: ORD -intrinsic-function: ORD-MAX -intrinsic-function: ORD-MIN -intrinsic-function: PI -intrinsic-function: PRESENT-VALUE -intrinsic-function: RANDOM -intrinsic-function: RANGE -intrinsic-function: REM -intrinsic-function: REVERSE -intrinsic-function: SIGN -intrinsic-function: SIN -intrinsic-function: SQRT -intrinsic-function: STANDARD-DEVIATION -intrinsic-function: SUM -intrinsic-function: TAN -#intrinsic-function: ULENGTH # IBM extension, not known to GnuCOBOL -#intrinsic-function: UPOS # IBM extension, not known to GnuCOBOL -intrinsic-function: UPPER-CASE -#intrinsic-function: USUBSTR # IBM extension, not known to GnuCOBOL -#intrinsic-function: USUPPLEMENTARY # IBM extension, not known to GnuCOBOL -#intrinsic-function: UVALID # IBM extension, not known to GnuCOBOL -#intrinsic-function: UWIDTH # IBM extension, not known to GnuCOBOL -intrinsic-function: VARIANCE -intrinsic-function: WHEN-COMPILED -intrinsic-function: YEAR-TO-YYYY diff -Nru gnucobol-4.0~early~20200606/config/mvs.conf gnucobol-5/config/mvs.conf --- gnucobol-4.0~early~20200606/config/mvs.conf 2020-06-06 20:52:02.000000000 +0000 +++ gnucobol-5/config/mvs.conf 1970-01-01 00:00:00.000000000 +0000 @@ -1,34 +0,0 @@ -# GnuCOBOL compiler configuration -# -# Copyright (C) 2001-2012, 2014-2017 Free Software Foundation, Inc. -# Written by Keisuke Nishida, Roger While, Simon Sobisch, Edward Hart -# -# This file is part of GnuCOBOL. -# -# The GnuCOBOL compiler is free software: you can redistribute it -# and/or modify it under the terms of the GNU General Public License -# as published by the Free Software Foundation, either version 3 of the -# License, or (at your option) any later version. -# -# GnuCOBOL is distributed in the hope that it will be useful, -# but WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -# GNU General Public License for more details. -# -# You should have received a copy of the GNU General Public License -# along with GnuCOBOL. If not, see . - - -include "mvs-strict.conf" - -# Value: any string -name: "MVS/VM COBOL (lax)" - -# reserve additional words, synonyms and exceptions from normal word list -include: "mvs.words" - -# not-reserved: -# Value: Word to be taken out of the reserved words list -# -fill upon request- - -include "lax.conf-inc" diff -Nru gnucobol-4.0~early~20200606/config/mvs-strict.conf gnucobol-5/config/mvs-strict.conf --- gnucobol-4.0~early~20200606/config/mvs-strict.conf 2020-06-06 20:52:02.000000000 +0000 +++ gnucobol-5/config/mvs-strict.conf 1970-01-01 00:00:00.000000000 +0000 @@ -1,256 +0,0 @@ -# GnuCOBOL compiler configuration -# -# Copyright (C) 2001-2012, 2014-2020 Free Software Foundation, Inc. -# Written by Keisuke Nishida, Roger While, Simon Sobisch, Edward Hart, -# Ron Norman -# -# This file is part of GnuCOBOL. -# -# The GnuCOBOL compiler is free software: you can redistribute it -# and/or modify it under the terms of the GNU General Public License -# as published by the Free Software Foundation, either version 3 of the -# License, or (at your option) any later version. -# -# GnuCOBOL is distributed in the hope that it will be useful, -# but WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -# GNU General Public License for more details. -# -# You should have received a copy of the GNU General Public License -# along with GnuCOBOL. If not, see . - - -# Value: any string -name: "MVS/VM COBOL" - -# Value: enum -standard-define 3 -# CB_STD_OC = 0, -# CB_STD_MF, -# CB_STD_IBM, -# CB_STD_MVS, -# CB_STD_BS2000, -# CB_STD_ACU, -# CB_STD_85, -# CB_STD_2002, -# CB_STD_2014 - -# Value: int -tab-width: 8 -text-column: 72 -word-length: 30 # not verified yet -literal-length: 160 # not verified yet -numeric-literal-length: 18 # not verified yet -pic-length: 50 - -# Default assign type -# Value: 'dynamic', 'external' -assign-clause: external - -# If yes, file names are resolved at run time using -# environment variables. -# For example, given ASSIGN TO "DATAFILE", the file name will be -# 1. the value of environment variable 'DD_DATAFILE' or -# 2. the value of environment variable 'dd_DATAFILE' or -# 3. the value of environment variable 'DATAFILE' or -# 4. the literal "DATAFILE" -# If no, the value of the assign clause is the file name. -# -filename-mapping: yes - -# Alternate formatting of numeric fields -pretty-display: no - -# Allow complex OCCURS DEPENDING ON -complex-odo: yes - -# Allow REDEFINES to other than last equal level number -indirect-redefines: yes - -# Binary byte size - defines the allocated bytes according to PIC -# Value: signed unsigned bytes -# ------ -------- ----- -# '2-4-8' 1 - 4 same 2 -# 5 - 9 same 4 -# 10 - 18 same 8 -# -# '1-2-4-8' 1 - 2 same 1 -# 3 - 4 same 2 -# 5 - 9 same 4 -# 10 - 18 same 8 -# -# '1--8' 1 - 2 1 - 2 1 -# 3 - 4 3 - 4 2 -# 5 - 6 5 - 7 3 -# 7 - 9 8 - 9 4 -# 10 - 11 10 - 12 5 -# 12 - 14 13 - 14 6 -# 15 - 16 15 - 16 7 -# 17 - 18 17 - 18 8 -# -binary-size: 2-4-8 - -# Numeric truncation according to ANSI -binary-truncate: no - -# Binary byte order -# Value: 'native', 'big-endian' -binary-byteorder: big-endian - -# Allow larger REDEFINES items -larger-redefines-ok: no - -# Allow certain syntax variations (eg. REDEFINES position) -relax-syntax-checks: no - -# Perform type OSVS - If yes, the exit point of any currently -# executing perform is recognized if reached. -perform-osvs: yes - -# Compute intermediate decimal results like IBM OSVS -arithmetic-osvs: yes - -# MOVE like IBM (mvc); left to right, byte by byte -move-ibm: yes - -# If yes, linkage-section items remain allocated -# between invocations. -sticky-linkage: yes - -# If yes, allow non-matching level numbers -relax-level-hierarchy: yes - -# If yes, evaluate constant expressions at compile time -constant-folding: yes # not verified yet - -# Allow Hex 'F' for NUMERIC test of signed PACKED DECIMAL field -hostsign: yes - -# If yes, set WITH UPDATE clause as default for ACCEPT dest-item, -# except if WITH NO UPDATE clause is used -accept-update: no # not verified yet - -# If yes, set WITH AUTO clause as default for ACCEPT dest-item, -# except if WITH TAB clause is used -accept-auto: no # not verified yet - -# If yes, DISPLAYs and ACCEPTs are, by default, done on the CRT (i.e., using -# curses). -console-is-crt: no - -# If yes, allow redefinition of the current program's name. This prevents its -# use in a prototype-format CALL/CANCEL statement. -program-name-redefinition: yes - -# If yes, NO ECHO/NO-ECHO/OFF is the same as SECURE (hiding input with -# asterisks, not spaces). -no-echo-means-secure: no - -# If yes, the first item in a field screen ACCEPT/DISPLAY (e.g. DISPLAY x UPON -# CRT) is located after the previous ACCEPT/DISPLAY (as though LINE 0 COL 0 had -# been specified). -line-col-zero-default: no - -# If yes, then REPORT, COLUMN may have any of PLUS num, + num, or +num -# to define a relative column position -report-column-plus: yes - -# If yes, DISPLAY SPACES acts as ERASE EOS, DISPLAY X"01" acts as ERASE EOL, -# DISPLAY X"02" acts as BLANK SCREEEN and DISPLAY X"07" acts as BELL. Note -# DISPLAY LOW-VALUE is excluded from this; it will always just position the -# cursor. -display-special-fig-consts: no - -# If yes, COMP-1 is a signed 16-bit integer and any PICTURE clause is ignored. -binary-comp-1: no - -# auto-adjust to zero like MicroFocus does -move-non-numeric-lit-to-numeric-is-zero: no - -# If yes, implicitly define a variable for an ASSIGN DYNAMIC which does not -# match an existing data item. -implicit-assign-dynamic-var: no - -# What rules to apply to SCREEN SECTION items clauses -screen-section-rules: std - -# Dialect features -# Value: 'ok', 'warning', 'archaic', 'obsolete', 'skip', 'ignore', 'error', -# 'unconformable' - -alter-statement: obsolete -comment-paragraphs: obsolete -call-overflow: ok # not verified yet -data-records-clause: obsolete -debugging-mode: ok -use-for-debugging: obsolete -listing-statements: ok -title-statement: ok -entry-statement: ok -goto-statement-without-name: obsolete -label-records-clause: obsolete -memory-size-clause: obsolete -move-noninteger-to-alphanumeric: error -move-figurative-constant-to-numeric: error # not verified yet -move-figurative-space-to-numeric: error # not verified yet -move-figurative-quote-to-numeric: error # not verified yet -multiple-file-tape-clause: obsolete -next-sentence-phrase: archaic -odo-without-to: ok -padding-character-clause: obsolete -section-segments: ignore -stop-literal-statement: obsolete -stop-identifier-statement: unconformable -same-as-clause: unconformable -synchronized-clause: ok -sync-left-right: skip -special-names-clause: error -top-level-occurs-clause: skip -value-of-clause: obsolete -numeric-boolean: unconformable -hexadecimal-boolean: unconformable -national-literals: unconformable -hexadecimal-national-literals: unconformable -national-character-literals: unconformable -acu-literals: unconformable -hp-octal-literals: unconformable -word-continuation: ok -length-in-data-division: no -depending-on-not-fixed: warning -occurs-max-length-without-subscript: no -not-exception-before-exception: unconformable -accept-display-extensions: unconformable -renames-uncommon-levels: unconformable -symbolic-constant: unconformable -constant-78: ok -constant-01: unconformable -perform-varying-without-by: unconformable -reference-out-of-declaratives: error # not verified yet -reference-bounds-check: error # no verified yet -program-prototypes: unconformable -call-convention-mnemonic: unconformable -call-convention-linkage: unconformable -numeric-value-for-edited-item: error -incorrect-conf-sec-order: error -define-constant-directive: unconformable -free-redefines-position: unconformable -records-mismatch-record-clause: ok # not verified but IBM has "if not matching use the record size" -record-delimiter: ignore -sequential-delimiters: unconformable -record-delim-with-fixed-recs: unconformable -missing-statement: warning # not verified yet -zero-length-literals: unconformable -xml-generate-extra-phrases: unconformable -continue-after: unconformable -goto-entry: unconformable -binary-sync-clause: ignore -nonnumeric-with-numeric-group-usage: ok -assign-variable: unconformable -assign-using-variable: unconformable -assign-ext-dyn: unconformable -assign-disk-from: unconformable -align-record: 8 -align-opt: yes - -# use fixed word list, synonyms and exceptions specified there -reserved-words: MVS diff -Nru gnucobol-4.0~early~20200606/config/mvs.words gnucobol-5/config/mvs.words --- gnucobol-4.0~early~20200606/config/mvs.words 2020-06-06 20:52:02.000000000 +0000 +++ gnucobol-5/config/mvs.words 1970-01-01 00:00:00.000000000 +0000 @@ -1,538 +0,0 @@ -# GnuCOBOL compiler - list of reserved words -# -# Copyright (C) 2016-2017 Free Software Foundation, Inc. -# Written by Simon Sobisch, Edward Hart -# -# This file is part of GnuCOBOL. -# -# The GnuCOBOL compiler is free software: you can redistribute it -# and/or modify it under the terms of the GNU General Public License -# as published by the Free Software Foundation, either version 3 of the -# License, or (at your option) any later version. -# -# GnuCOBOL is distributed in the hope that it will be useful, -# but WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -# GNU General Public License for more details. -# -# You should have received a copy of the GNU General Public License -# along with GnuCOBOL. If not, see . - - -# Word list for dialect: MVS/VM COBOL - -# Note: only used for strict dialect and when -# requested by compiler directive >> IMP WORDS MVS -# the default reserved word list will not be used. - -# Value: Word to make up reserved words list (case independent) -# All reserved entries listed will replace entire default reserved words list. -# Words ending with * will be treated as context-sensitive words. This will be -# ignored if GnuCOBOL uses that word as a reserved word. -# Entries of the form word-1=word-2 define word-1 as an alias for default -# reserved word word-2. No spaces are allowed around the equal sign. -reserved: ACCEPT -reserved: ACCESS -reserved: ADD -reserved: ADDRESS -reserved: ADVANCING -reserved: AFTER -reserved: ALL -reserved: ALPHABET -reserved: ALPHABETIC -reserved: ALPHABETIC-LOWER -reserved: ALPHABETIC-UPPER -reserved: ALPHANUMERIC -reserved: ALPHANUMERIC-EDITED -reserved: ALSO -reserved: ALTER -reserved: ALTERNATE -reserved: AND -reserved: ANY -reserved: APPLY -reserved: ARE -reserved: AREA -reserved: AREAS -reserved: ASCENDING -reserved: ASSIGN -reserved: AT -reserved: AUTHOR -reserved: BASIS -reserved: BEFORE -reserved: BEGINNING -reserved: BINARY -reserved: BINARY -reserved: BLANK -reserved: BLOB -reserved: BLOB-FILE -reserved: BLOB-LOCATOR -reserved: BLOCK -reserved: BOTTOM -reserved: BY -reserved: CALL -reserved: CANCEL -reserved: CBL -reserved: CD -reserved: CF -reserved: CH -reserved: CHAR -reserved: CHAR-VARYING -reserved: CHARACTER -reserved: CHARACTERS -reserved: CLASS -reserved: CLOB -reserved: CLOB-FILE -reserved: CLOB-LOCATOR -reserved: CLOCK-UNITS -reserved: CLOSE -reserved: COBOL -reserved: CODE -reserved: CODE-SET -reserved: COLLATING -reserved: COLUMN -reserved: COM-REG -reserved: COMMA -reserved: COMMON -reserved: COMMUNICATION -reserved: COMP -reserved: COMP-1 -reserved: COMP-2 -reserved: COMP-3 -reserved: COMP-4 -reserved: COMPUTATIONAL -reserved: COMPUTATIONAL-1 -reserved: COMPUTATIONAL-2 -reserved: COMPUTATIONAL-3 -reserved: COMPUTATIONAL-4 -reserved: COMPUTE -reserved: CONFIGURATION -reserved: CONTAINS -reserved: CONTENT -reserved: CONTINUE -reserved: CONTROL -reserved: CONTROLS -reserved: CONVERTING -reserved: COPY -reserved: CORR -reserved: CORRESPONDING -reserved: COUNT -reserved: CURRENCY -reserved: DATA -reserved: DATE -reserved: DATE-COMPILED -reserved: DATE-RECORD -reserved: DATE-WRITTEN -reserved: DAY -reserved: DAY-OF-WEEK -reserved: DBCLOB -reserved: DBCLOB-FILE -reserved: DBCLOB-LOCATOR -reserved: DBCS -reserved: DE -reserved: DEBUGGING -reserved: DECIMAL-POINT -reserved: DECLARATIVES -reserved: DELETE -reserved: DELIMITED -reserved: DELIMITER -reserved: DEPENDING -reserved: DESCENDING -reserved: DESTINATION -reserved: DETAIL -reserved: DISABLE -reserved: DISPLAY -reserved: DISPLAY-1 -reserved: DIVIDE -reserved: DIVISION -reserved: DOWN -reserved: DUPLICATES -reserved: DYNAMIC -reserved: EGCS -reserved: EGI -reserved: EJECT -reserved: ELSE -reserved: EMI -reserved: ENABLE -reserved: END -reserved: END-ADD -reserved: END-CALL -reserved: END-COMPUTE -reserved: END-DELETE -reserved: END-DIVIDE -reserved: END-EVALUATE -reserved: END-IF -reserved: END-MULTIPLY -reserved: END-OF-PAGE -reserved: END-PERFORM -reserved: END-READ -reserved: END-RECEIVE -reserved: END-RETURN -reserved: END-REWRITE -reserved: END-SEARCH -reserved: END-START -reserved: END-STRING -reserved: END-SUBTRACT -reserved: END-UNSTRING -reserved: END-WRITE -reserved: ENDING -reserved: ENTER -reserved: ENTRY -reserved: ENVIRONMENT -reserved: EOP -reserved: EQUAL -reserved: ERROR -reserved: ESI -reserved: EVALUATE -reserved: EVERY -reserved: EXCEPTION -reserved: EXIT -reserved: EXTEND -reserved: EXTERNAL -reserved: F* -reserved: FALSE -reserved: FD -reserved: FILE -reserved: FILE-CONTROL -reserved: FILLER -reserved: FINAL -reserved: FIRST -reserved: FOOTING -reserved: FOR -reserved: FROM -reserved: GENERATE -reserved: GIVING -reserved: GLOBAL -reserved: GO -reserved: GOBACK -reserved: GREATER -reserved: GROUP -reserved: HEADING -reserved: HIGH-VALUE -reserved: HIGH-VALUES=HIGH-VALUE -reserved: I-O -reserved: I-O-CONTROL -reserved: ID -reserved: IDENTIFICATION -reserved: IF -reserved: IN -reserved: INDEX -reserved: INDEXED -reserved: INDICATE -reserved: INITIAL -reserved: INITIALIZE -reserved: INITIATE -reserved: INPUT -reserved: INPUT-OUTPUT -reserved: INSERT -reserved: INSPECT -reserved: INSTALLATION -reserved: INTO -reserved: INVALID -reserved: IS -reserved: JUST -reserved: JUSTIFIED -reserved: KANJI -reserved: KEY -reserved: LABEL -reserved: LAST -reserved: LEADING -reserved: LEFT -reserved: LENGTH -reserved: LESS -reserved: LIMIT -reserved: LIMITS -reserved: LINAGE -reserved: LINAGE-COUNTER -reserved: LINE -reserved: LINE-COUNTER -reserved: LINES -reserved: LINKAGE -reserved: LOCK -reserved: LONG-VARBINARY -reserved: LONG-VARCHAR -reserved: LOW-VALUE -reserved: LOW-VALUES=LOW-VALUE -reserved: MEMORY -reserved: MERGE -reserved: MESSAGE -reserved: MODE -reserved: MODULES -reserved: MORE-LABELS -reserved: MOVE -reserved: MULTIPLE* -reserved: MULTIPLY -reserved: NATIVE -reserved: NEGATIVE -reserved: NEXT -reserved: NO -reserved: NOT -reserved: NULL -reserved: NULLS -reserved: NUMBER -reserved: NUMERIC -reserved: NUMERIC-EDITED -reserved: OBJECT-COMPUTER -reserved: OCCURS -reserved: OF -reserved: OFF -reserved: OMITTED -reserved: ON -reserved: OPEN -reserved: OPTIONAL -reserved: OR -reserved: ORDER -reserved: ORGANIZATION -reserved: OTHER -reserved: OUTPUT -reserved: OVERFLOW -reserved: PACKED-DECIMAL -reserved: PADDING -reserved: PAGE -reserved: PAGE-COUNTER -reserved: PASSWORD -reserved: PERFORM -reserved: PF -reserved: PH -reserved: PIC=PICTURE -reserved: PICTURE -reserved: PLUS -reserved: POINTER -reserved: POSITION -reserved: POSITIVE -reserved: PRINTING -reserved: PROCEDURE -reserved: PROCEDURES -reserved: PROCEED -reserved: PROCESSING -reserved: PROGRAM -reserved: PROGRAM-ID -reserved: PURGE -reserved: QUEUE -reserved: QUOTE -reserved: QUOTES -reserved: RANDOM -reserved: RD -reserved: READ -reserved: READY -reserved: RECEIVE -reserved: RECORD -reserved: RECORDING -reserved: RECORDS -reserved: REDEFINES -reserved: REEL -reserved: REFERENCE -reserved: REFERENCES -reserved: RELATIVE -reserved: RELEASE -reserved: RELOAD -reserved: REMAINDER -reserved: REMOVAL -reserved: RENAMES -reserved: REPLACE -reserved: REPLACING -reserved: REPORT -reserved: REPORTING -reserved: REPORTS -reserved: RERUN -reserved: RESERVE -reserved: RESET -reserved: RESULT-SET-LOCATOR -reserved: RETURN -reserved: REVERSED -reserved: REWIND -reserved: REWRITE -reserved: RF -reserved: RH -reserved: RIGHT -reserved: ROUNDED -reserved: ROWID -reserved: RUN -reserved: S* -reserved: SAME -reserved: SD -reserved: SEARCH -reserved: SECTION -reserved: SECURITY -reserved: SEGMENT -reserved: SEGMENT-LIMIT -reserved: SELECT -reserved: SEND -reserved: SENTENCE -reserved: SEPARATE -reserved: SEQUENCE -reserved: SEQUENTIAL -reserved: SERVICE -reserved: SET -reserved: SHIFT-IN # note: this is a register, move as soon as supported -reserved: SHIFT-OUT # note: this is a register, move as soon as supported -reserved: SIGN -reserved: SIZE -reserved: SKIP1 -reserved: SKIP2 -reserved: SKIP3 -reserved: SORT -reserved: SORT-CONTROL # note: this is a register, move as soon as supported -reserved: SORT-CORE-SIZE # note: this is a register, move as soon as supported -reserved: SORT-FILE-SIZE # note: this is a register, move as soon as supported -reserved: SORT-MERGE -reserved: SORT-MESSAGE # note: this is a register, move as soon as supported -reserved: SORT-MODE-SIZE # note: this is a register, move as soon as supported -reserved: SOURCE -reserved: SOURCE-COMPUTER -reserved: SPACE -reserved: SPACES=SPACE -reserved: SPECIAL-NAMES -reserved: SQL -reserved: STANDARD -reserved: STANDARD-1 -reserved: STANDARD-2 -reserved: START -reserved: STATUS -reserved: STOP -reserved: STRING -reserved: SUB-QUEUE-1 -reserved: SUB-QUEUE-2 -reserved: SUB-QUEUE-3 -reserved: SUBTRACT -reserved: SUM -reserved: SUPPRESS -reserved: SYMBOL -reserved: SYMBOLIC -reserved: SYNC -reserved: SYNCHRONIZED -reserved: TABLE -reserved: TALLYING -reserved: TAPE -reserved: TERMINAL -reserved: TERMINATE -reserved: TEST -reserved: TEXT -reserved: THAN -reserved: THEN -reserved: THROUGH -reserved: THRU -reserved: TIME -reserved: TIME-RECORD -reserved: TIMES -reserved: TIMESTAMP -reserved: TIMESTAMP-OFFSET -reserved: TIMESTAMP-OFFSET-RECORD -reserved: TIMESTAMP-RECORD -reserved: TITLE -reserved: TO -reserved: TOP -reserved: TRACE -reserved: TRAILING -reserved: TRUE -reserved: TYPE -reserved: U* -reserved: UNIT -reserved: UNSTRING -reserved: UNTIL -reserved: UP -reserved: UPON -reserved: USAGE -reserved: USE -reserved: USING -reserved: V* -reserved: VALUE -reserved: VALUES=VALUE -reserved: VARBINARY -reserved: VARYING -reserved: WHEN -reserved: WITH -reserved: WORDS -reserved: WORKING-STORAGE -reserved: WRITE -reserved: WRITE-ONLY -reserved: XML -reserved: YYYYDDD* -reserved: YYYYMMDD* -reserved: ZERO -reserved: ZEROES=ZERO -reserved: ZEROS=ZERO - - -# list of registers: -not-register: DIALECT-ALL -register: "ADDRESS\ OF" -register: DEBUG-ITEM -register: "LENGTH\ OF" -# register: LINAGE-COUNTER -register: RETURN-CODE -# register: SHIFT-IN -# register: SHIFT-OUT -# register: SORT-CONTROL -# register: SORT-CORE-SIZE -# register: SORT-FILE-SIZE -# register: SORT-MESSAGE -# register: SORT-MODE-SIZE -register: SORT-RETURN -register: TALLY -register: WHEN-COMPILED - - -# list of system names: -not-system-name: DIALECT-ALL-SWITCHES -system-name: UPSI-0 -system-name: UPSI-1 -system-name: UPSI-2 -system-name: UPSI-3 -system-name: UPSI-4 -system-name: UPSI-5 -system-name: UPSI-6 -system-name: UPSI-7 - - -# disable all functions -not-intrinsic-function: DIALECT-ALL - -# add all that are supported by MVS -intrinsic-function: ACOS -intrinsic-function: ANNUITY -intrinsic-function: ASIN -intrinsic-function: ATAN -intrinsic-function: CHAR -intrinsic-function: COS -intrinsic-function: CURRENT-DATE -intrinsic-function: DATE-OF-INTEGER -intrinsic-function: DATE-TO-YYYYMMDD -#intrinsic-function: DATEVAL # MVS extension, not known to GnuCOBOL -intrinsic-function: DAY-OF-INTEGER -intrinsic-function: DAY-TO-YYYYDDD -intrinsic-function: FACTORIAL -intrinsic-function: INTEGER -intrinsic-function: INTEGER-OF-DATE -intrinsic-function: INTEGER-OF-DAY -intrinsic-function: INTEGER-PART -intrinsic-function: LENGTH -intrinsic-function: LOG -intrinsic-function: LOG10 -intrinsic-function: LOWER-CASE -intrinsic-function: MAX -intrinsic-function: MEAN -intrinsic-function: MEDIAN -intrinsic-function: MIDRANGE -intrinsic-function: MIN -intrinsic-function: MOD -intrinsic-function: NUMVAL -intrinsic-function: NUMVAL-C -intrinsic-function: ORD -intrinsic-function: ORD-MAX -intrinsic-function: ORD-MIN -intrinsic-function: PRESENT-VALUE -intrinsic-function: RANDOM -intrinsic-function: RANGE -intrinsic-function: REM -intrinsic-function: REVERSE -intrinsic-function: SIN -intrinsic-function: SQRT -intrinsic-function: STANDARD-DEVIATION -intrinsic-function: SUM -intrinsic-function: TAN -#intrinsic-function: UNDATE # MVS extension, not known to GnuCOBOL -intrinsic-function: UPPER-CASE -intrinsic-function: VARIANCE -intrinsic-function: WHEN-COMPILED -intrinsic-function: YEAR-TO-YYYY -#intrinsic-function: YEARWINDOW # MVS extension, not known to GnuCOBOL diff -Nru gnucobol-4.0~early~20200606/config/realia.conf gnucobol-5/config/realia.conf --- gnucobol-4.0~early~20200606/config/realia.conf 2020-06-06 20:52:02.000000000 +0000 +++ gnucobol-5/config/realia.conf 1970-01-01 00:00:00.000000000 +0000 @@ -1,34 +0,0 @@ -# GnuCOBOL compiler configuration -# -# Copyright (C) 2019 Free Software Foundation, Inc. -# Written by Edward Hart -# -# This file is part of GnuCOBOL. -# -# The GnuCOBOL compiler is free software: you can redistribute it -# and/or modify it under the terms of the GNU General Public License -# as published by the Free Software Foundation, either version 3 of the -# License, or (at your option) any later version. -# -# GnuCOBOL is distributed in the hope that it will be useful, -# but WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -# GNU General Public License for more details. -# -# You should have received a copy of the GNU General Public License -# along with GnuCOBOL. If not, see . - - -include "realia-strict.conf" - -# Value: any string -name: "CA Realia II (lax)" - -# reserve additional words, synonyms and exceptions from normal word list -include: "realia.words" - -# not-reserved: -# Value: Word to be taken out of the reserved words list -# -fill upon request- - -include "lax.conf-inc" diff -Nru gnucobol-4.0~early~20200606/config/realia-strict.conf gnucobol-5/config/realia-strict.conf --- gnucobol-4.0~early~20200606/config/realia-strict.conf 2020-06-06 20:52:02.000000000 +0000 +++ gnucobol-5/config/realia-strict.conf 1970-01-01 00:00:00.000000000 +0000 @@ -1,262 +0,0 @@ -# GnuCOBOL compiler configuration -# -# Copyright (C) 2019-2020 Free Software Foundation, Inc. -# Written by Keisuke Nishida, Roger While, Simon Sobisch, Edward Hart, -# Ron Norman -# -# This file is part of GnuCOBOL. -# -# The GnuCOBOL compiler is free software: you can redistribute it -# and/or modify it under the terms of the GNU General Public License -# as published by the Free Software Foundation, either version 3 of the -# License, or (at your option) any later version. -# -# GnuCOBOL is distributed in the hope that it will be useful, -# but WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -# GNU General Public License for more details. -# -# You should have received a copy of the GNU General Public License -# along with GnuCOBOL. If not, see . - - -# Value: any string -name: "CA Realia II" - -# Value: enum -standard-define 7 # Uses COBOL-85 currently -# CB_STD_OC = 0, -# CB_STD_MF, -# CB_STD_IBM, -# CB_STD_MVS, -# CB_STD_BS2000, -# CB_STD_ACU, -# CB_STD_85, -# CB_STD_2002, -# CB_STD_2014 - -# Value: int -tab-width: 8 -text-column: 72 -word-length: 60 # to check -literal-length: 160 -numeric-literal-length: 18 # to check -pic-length: 100 # to check -occurs-max-length-without-subscript: yes # to check - -# Value: 'mf', 'ibm' -# -assign-clause: dynamic # to check - -# If yes, file names are resolved at run time using -# environment variables. -# For example, given ASSIGN TO "DATAFILE", the file name will be -# 1. the value of environment variable 'DD_DATAFILE' or -# 2. the value of environment variable 'dd_DATAFILE' or -# 3. the value of environment variable 'DATAFILE' or -# 4. the literal "DATAFILE" -# If no, the value of the assign clause is the file name. -# -filename-mapping: yes # to check - -# Alternate formatting of numeric fields -pretty-display: yes - -# Allow complex OCCURS DEPENDING ON -complex-odo: no - -# Allow REDEFINES to other than last equal level number -indirect-redefines: no - -# Binary byte size - defines the allocated bytes according to PIC -# Value: signed unsigned bytes -# ------ -------- ----- -# '2-4-8' 1 - 4 same 2 -# 5 - 9 same 4 -# 10 - 18 same 8 -# -# '1-2-4-8' 1 - 2 same 1 -# 3 - 4 same 2 -# 5 - 9 same 4 -# 10 - 18 same 8 -# -# '1--8' 1 - 2 1 - 2 1 -# 3 - 4 3 - 4 2 -# 5 - 6 5 - 7 3 -# 7 - 9 8 - 9 4 -# 10 - 11 10 - 12 5 -# 12 - 14 13 - 14 6 -# 15 - 16 15 - 16 7 -# 17 - 18 17 - 18 8 -# -binary-size: 2-4-8 - -# Numeric truncation according to ANSI -binary-truncate: no # to check - -# Binary byte order -# Value: 'native', 'big-endian' -binary-byteorder: big-endian # to check - -# Allow larger REDEFINES items -larger-redefines-ok: no # not verified yet - -# Allow certain syntax variations (eg. REDEFINES position) -relax-syntax-checks: no # to check - -# Perform type OSVS - If yes, the exit point of any currently -# executing perform is recognized if reached. -perform-osvs: no # to check - -# Compute intermediate decimal results like IBM OSVS -arithmetic-osvs: no # to check - -# MOVE like IBM (mvc); left to right, byte by byte -move-ibm: no # to check - -# If yes, linkage-section items remain allocated -# between invocations. -sticky-linkage: no - -# If yes, allow non-matching level numbers -relax-level-hierarchy: no # not verified yet - -# If yes, evaluate constant expressions at compile time -constant-folding: no - -# Allow Hex 'F' for NUMERIC test of signed PACKED DECIMAL field -hostsign: no # not verified yet - -# If yes, set WITH UPDATE clause as default for ACCEPT dest-item, -# except if WITH NO UPDATE clause is used -accept-update: no - -# If yes, set WITH AUTO clause as default for ACCEPT dest-item, -# except if WITH TAB clause is used -accept-auto: no - -# If yes, DISPLAYs and ACCEPTs are, by default, done on the CRT (i.e., using -# curses). -console-is-crt: yes - -# If yes, allow redefinition of the current program's name. This prevents its -# use in a prototype-format CALL/CANCEL statement. -program-name-redefinition: yes - -# If yes, NO ECHO/NO-ECHO/OFF is the same as SECURE (hiding input with -# asterisks, not spaces). -no-echo-means-secure: yes - -# If yes, the first item in a field screen ACCEPT/DISPLAY (e.g. DISPLAY x UPON -# CRT) is located after the previous ACCEPT/DISPLAY (as though LINE 0 COL 0 had -# been specified). -line-col-zero-default: yes - -# If yes, then REPORT, COLUMN may have any of PLUS num, + num, or +num -# to define a relative column position -report-column-plus: no - -# If yes, DISPLAY SPACES acts as ERASE EOS, DISPLAY X"01" acts as ERASE EOL, -# DISPLAY X"02" acts as BLANK SCREEEN and DISPLAY X"07" acts as BELL. Note -# DISPLAY LOW-VALUE is excluded from this; it will always just position the -# cursor. -display-special-fig-consts: no - -# If yes, COMP-1 is a signed 16-bit integer and any PICTURE clause is ignored. -binary-comp-1: no - -# auto-adjust to zero like MicroFocus does -# note: ACUCOBOL is even more special here as it is padding alphanumeric -# fields/literals with zero which we don't support -# move SPACE to NNN -> ' ' -# move ' ' to NNN -> '00 ' -move-non-numeric-lit-to-numeric-is-zero: yes - -# If yes, implicitly define a variable for an ASSIGN DYNAMIC which does not -# match an existing data item. -implicit-assign-dynamic-var: no - -# What rules to apply to SCREEN SECTION items clauses -screen-section-rules: xopen - -# Dialect features -# Value: 'ok', 'warning', 'archaic', 'obsolete', 'skip', 'ignore', 'error', -# 'unconformable' - -alter-statement: obsolete -comment-paragraphs: ok -call-overflow: ok -data-records-clause: ignore -debugging-mode: unconformable -use-for-debugging: unconformable -listing-statements: ok -title-statement: ok -entry-statement: ok -goto-statement-without-name: ok -label-records-clause: ok -memory-size-clause: ignore -move-noninteger-to-alphanumeric: error # not verified yet -move-figurative-constant-to-numeric: ok # not verified yet -move-figurative-space-to-numeric: ok # not verified yte -move-figurative-quote-to-numeric: ok # not verified yet -multiple-file-tape-clause: ignore -next-sentence-phrase: archaic # not verified yet -odo-without-to: unconformable -padding-character-clause: ignore -section-segments: unconformable -stop-literal-statement: ok -stop-identifier-statement: unconformable -same-as-clause: unconformable -synchronized-clause: ok -sync-left-right: ignore # better use "skip" here? -special-names-clause: error # not verified yet -top-level-occurs-clause: unconformable -value-of-clause: ignore -numeric-boolean: unconformable -hexadecimal-boolean: unconformable -national-literals: ok -hexadecimal-national-literals: unconformable -national-character-literals: unconformable -# TO-DO: Add separate config options for H"..." , Z"...", G"..." and N"..." to be ok -acu-literals: unconformable -hp-octal-literals: unconformable -word-continuation: ok -not-exception-before-exception: unconformable -length-in-data-division: no -depending-on-not-fixed: unconformable -accept-display-extensions: ok -renames-uncommon-levels: unconformable -symbolic-constant: unconformable -constant-78: unconformable -constant-01: unconformable -perform-varying-without-by: unconformable -program-prototypes: unconformable -numeric-value-for-edited-item: error # not verified yet -reference-out-of-declaratives: ok # not verified yet -# Is reference modification required to be within the single field -reference-bounds-check: ok # not verified yet -call-convention-mnemonic: unconformable -call-convention-linkage: unconformable -incorrect-conf-sec-order: error -define-constant-directive: unconformable -free-redefines-position: unconformable -records-mismatch-record-clause: error # not verified yet -record-delimiter: ignore -sequential-delimiters: unconformable -record-delim-with-fixed-recs: error -missing-statement: warning -zero-length-literals: unconformable # not verified yet -xml-generate-extra-phrases: unconformable -continue-after: unconformable -goto-entry: unconformable -binary-sync-clause: ignore # not verified yet -nonnumeric-with-numeric-group-usage: error -assign-variable: unconformable -assign-using-variable: ok -assign-ext-dyn: unconformable -assign-disk-from: unconformable -align-record: 0 -align-opt: no - -# use fixed word list, synonyms and exceptions specified there -reserved-words: realia diff -Nru gnucobol-4.0~early~20200606/config/realia.words gnucobol-5/config/realia.words --- gnucobol-4.0~early~20200606/config/realia.words 2020-06-06 20:52:02.000000000 +0000 +++ gnucobol-5/config/realia.words 1970-01-01 00:00:00.000000000 +0000 @@ -1,630 +0,0 @@ -# GnuCOBOL compiler - list of reserved words -# -# Copyright (C) 2019 Free Software Foundation, Inc. -# Written by Edward Hart -# -# This file is part of GnuCOBOL. -# -# The GnuCOBOL compiler is free software: you can redistribute it -# and/or modify it under the terms of the GNU General Public License -# as published by the Free Software Foundation, either version 3 of the -# License, or (at your option) any later version. -# -# GnuCOBOL is distributed in the hope that it will be useful, -# but WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -# GNU General Public License for more details. -# -# You should have received a copy of the GNU General Public License -# along with GnuCOBOL. If not, see . - - -# Word list for dialect: CA Realia II - -# Note: only used for strict dialect and when -# requested by compiler directive >> IMP WORDS REALIA -# the default reserved word list will not be used. - -# Value: Word to make up reserved words list (case independent) -# All reserved entries listed will replace entire default reserved words list. -# Words ending with * will be treated as context-sensitive words. This will be -# ignored if GnuCOBOL uses that word as a reserved word. -# Entries of the form word-1=word-2 define word-1 as an alias for default -# reserved word word-2. No spaces are allowed around the equal sign. -reserved: ABSENT -reserved: ACCEPT -reserved: ACCESS -reserved: ACTUAL -reserved: ADD -reserved: ADDRESS -reserved: ADVANCING -reserved: AFTER -reserved: ALL -reserved: ALPHABET -reserved: ALPHABETIC -reserved: ALPHABETIC-LOWER -reserved: ALPHABETIC-UPPER -reserved: ALPHANUMERIC -reserved: ALPHANUMERIC-EDITED -reserved: ALSO -reserved: ALTER -reserved: ALTERNATE -reserved: AND -reserved: ANY -reserved: APPLY -reserved: ARE -reserved: AREA -reserved: AREA-VALUES -reserved: AREAS -reserved: ARGUMENT-NUMBER -reserved: ARGUMENT-VALUE -reserved: ARITHMETIC -reserved: ASCENDING -reserved: ASSIGN -reserved: AT -reserved: AUTHOR -reserved: AUTO -reserved: AUTO-SKIP=AUTO -reserved: AUTOMATIC -reserved: BACKGROUND-COLOR -reserved: BACKGROUND-COLOUR=BACKGROUND-COLOR -reserved: BASIS -reserved: BEEP=BELL -reserved: BEFORE -reserved: BEGINNING -reserved: BELL -reserved: BINARY -reserved: BLANK -reserved: BLINK -reserved: BLOCK -reserved: BOTTOM -reserved: BY -reserved: CALL -reserved: CANCEL -reserved: CBL -reserved: CD -reserved: CF -reserved: CH -reserved: CHANGED -reserved: CHARACTER -reserved: CHARACTERS -reserved: CLASS -reserved: CLASS-ID -reserved: CLOCK-UNITS -reserved: CLOSE -reserved: CODE -reserved: CODE-SET -reserved: COLS -reserved: COLLATING -reserved: COLUMN -reserved: COM-REG -reserved: COMMA -reserved: COMMAND-LINE -reserved: COMMIT -reserved: COMMON -reserved: COMMUNICATION -reserved: COMP -reserved: COMP-0 -reserved: COMP-1 -reserved: COMP-2 -reserved: COMP-3 -reserved: COMP-4 -reserved: COMP-5 -reserved: COMPUTATIONAL -reserved: COMPUTATIONAL-1 -reserved: COMPUTATIONAL-2 -reserved: COMPUTATIONAL-3 -reserved: COMPUTATIONAL-4 -reserved: COMPUTATIONAL-5 -reserved: COMPUTE -reserved: CONFIGURATION -reserved: CONTAINS -reserved: CONTENT -reserved: CONTINUE -reserved: CONTROL -reserved: CONTROLS -reserved: CONVERTING -reserved: COPY -reserved: CORE-INDEX -reserved: CORR -reserved: CORRESPONDING -reserved: COUNT -reserved: CRT -reserved: CRT-UNDER -reserved: CSP -reserved: CURRENCY -reserved: CURRENT-DATE -reserved: CURSOR -reserved: DATA -reserved: DATE -reserved: DATE-COMPILED -reserved: DATE-WRITTEN -reserved: DAY -reserved: DAY-OF-WEEK -reserved: DBCS -reserved: DE -reserved: DEBUG -reserved: DEBUG-CONTENTS -reserved: DEBUG-ITEM -reserved: DEBUG-LINE -reserved: DEBUG-NAME -reserved: DEBUG-SUB-1 -reserved: DEBUG-SUB-2 -reserved: DEBUG-SUB-3 -reserved: DEBUGGING -reserved: DECIMAL-POINT -reserved: DECLARATIVES -reserved: DELETE -reserved: DELIMITED -reserved: DELIMITER -reserved: DEPENDING -reserved: DESCENDING -reserved: DESTINATION -reserved: DETAIL -reserved: DISABLE -reserved: DISK -reserved: DISP -reserved: DISPLAY -reserved: DISPLAY-1 -reserved: DISPLAY-ST -reserved: DIVIDE -reserved: DIVISION -reserved: DOWN -reserved: DUPLICATES -reserved: DYNAMIC -reserved: EGC -reserved: EGI -reserved: EJECT -reserved: ELSE -reserved: EMI -reserved: EMPTY-CHECK=REQUIRED -reserved: ENABLE -reserved: END -reserved: END-ACCEPT -reserved: END-ADD -reserved: END-CALL -reserved: END-COMPUTE -reserved: END-DELETE -reserved: END-DISABLE -reserved: END-DIVIDE -reserved: END-ENABLE -reserved: END-EVALUATE -reserved: END-IF -reserved: END-INVOKE -reserved: END-MULTIPLY -reserved: END-OF-PAGE -reserved: END-ON -reserved: END-PERFORM -reserved: END-READ -reserved: END-RECEIVE -reserved: END-RETURN -reserved: END-REWRITE -reserved: END-SEARCH -reserved: END-SEND -reserved: END-SET -reserved: END-START -reserved: END-STRING -reserved: END-SUBTRACT -reserved: END-UNSTRING -reserved: END-WRITE -reserved: ENDING -reserved: ENTER -reserved: ENTRY -reserved: ENVIRONMENT -reserved: ENVIRONMENT-NAME -reserved: ENVIRONMENT-VALUE -reserved: EOP -reserved: EQUAL -reserved: ERASE -reserved: ERROR -reserved: ESCAPE -reserved: ESI -reserved: EVALUATE -reserved: EVERY -reserved: EXAMINE -reserved: EXCEPTION -reserved: EXCLUSIVE -reserved: EXHIBIT -reserved: EXIT -reserved: EXTEND -reserved: EXTERNAL -reserved: FALSE -reserved: FD -reserved: FIELD-TERMINATOR -reserved: FILE -reserved: FILE-CONTROL -reserved: FILE-LIMIT -reserved: FILE-LIMITS -reserved: FILLER -reserved: FINAL -reserved: FIRST -reserved: FOOTING -reserved: FOR -reserved: FOREGROUND-COLOR -reserved: FOREGROUND-COLOUR=FOREGROUND-COLOR -reserved: FREE -reserved: FROM -reserved: FULL -reserved: FUNCTION -reserved: GENERATE -reserved: GET -reserved: GIVING -reserved: GLOBAL -reserved: GO -reserved: GOBACK -reserved: GREATER -reserved: GROUP -reserved: HEADING -reserved: HIGH-VALUE -reserved: HIGH-VALUES=HIGH-VALUE -reserved: HIGHLIGHT -reserved: I-O -reserved: I-O-CONTROL -reserved: ID -reserved: IDENTIFICATION -reserved: IF -reserved: IN -reserved: INDEX -reserved: INDEXED -reserved: INDICATE -reserved: INHERITS -reserved: INITIAL -reserved: INITIALIZE -reserved: INITIATE -reserved: INPUT -reserved: INPUT-OUTPUT -reserved: INSERT -reserved: INSPECT -reserved: INSTALLATION -reserved: INTO -reserved: INVALID -reserved: INVOKE -reserved: IS -reserved: JUST -reserved: JUSTIFIED -reserved: KANJI -reserved: KEY -reserved: KEYBOARD -reserved: LABEL -reserved: LAST -reserved: LEADING -reserved: LEAVE -reserved: LEFT -reserved: LEFT-JUSTIFY -reserved: LENGTH -reserved: LENGTH-CHECK=FULL -reserved: LESS -reserved: LIMIT -reserved: LIMITS -reserved: LIN -reserved: LINAGE -reserved: LINAGE-COUNTER -reserved: LINE -reserved: LINE-COUNTER -reserved: LINES -reserved: LINKAGE -reserved: LOCK -reserved: LOW-VALUE -reserved: LOW-VALUES=LOW-VALUE -reserved: LOWLIGHT -reserved: MANUAL -reserved: MEMORY -reserved: MERGE -reserved: MESSAGE -reserved: META-CLASS -reserved: METHOD -reserved: METHOD-ID -reserved: MODE -reserved: MODULES -reserved: MORE-LABELS -reserved: MOVE -reserved: MULTIPLE -reserved: MULTIPLY -reserved: NAMED -reserved: NATIVE -reserved: NEGATIVE -reserved: NEXT -reserved: NO -reserved: NO-ECHO -reserved: NOMINAL -reserved: NOT -reserved: NOTE -reserved: NULLS=NULL -reserved: NULL -reserved: NUMBER -reserved: NUMERIC -reserved: NUMERIC-EDITED -reserved: OBJECT -reserved: OBJECT-COMPUTER -reserved: OCCURS -reserved: OF -reserved: OFF -reserved: OMITTED -reserved: ON -reserved: OPEN -reserved: OPTIONAL -reserved: OR -reserved: ORDER -reserved: ORGANIZATION -reserved: OTHER -reserved: OTHERWISE -reserved: OUTPUT -reserved: OVERFLOW -reserved: OVERRIDE -reserved: PACKED-DECIMAL -reserved: PADDING -reserved: PAGE -reserved: PAGE-COUNTER -reserved: PASSWORD -reserved: PERFORM -reserved: PF -reserved: PH -reserved: PIC -reserved: PICTURE -reserved: PLUS -reserved: POINTER -reserved: POSITION -reserved: POSITIONING -reserved: POSITIVE -reserved: PRINTER -reserved: PRINTER-1 -reserved: PRINTING -reserved: PRIOR=PREVIOUS -reserved: PROCEDURE -reserved: PROCEDURE-POINTER -reserved: PROCEDURES -reserved: PROCEED -reserved: PROCESSING -reserved: PROGRAM -reserved: PROGRAM-ID -reserved: PROMPT -reserved: PURGE -reserved: QUEUE -reserved: QUOTE -reserved: QUOTES -reserved: RANDOM -reserved: RANGE -reserved: RD -reserved: READ -reserved: READY -reserved: RECEIVE -reserved: RECORD -reserved: RECORD-OVERFLOW -reserved: RECORDING -reserved: RECORDS -reserved: RECURSIVE -reserved: REDEFINES -reserved: REEL -reserved: REFERENCE -reserved: REFERENCES -reserved: RELATIVE -reserved: RELEASE -reserved: RELOAD -reserved: REMAINDER -reserved: REMARKS -reserved: REMOVAL -reserved: RENAMES -reserved: REORG-CRITERIA -reserved: REPLACED -reserved: REPLACING -reserved: REPORT -reserved: REPORTING -reserved: REPORTS -reserved: REPOSITORY -reserved: REQUIRED -reserved: REREAD -reserved: RERUN -reserved: RESERVE -reserved: RESET -reserved: RETURN -reserved: RETURN-CODE -reserved: RETURNING -reserved: REVERSE-VIDEO -reserved: REVERSED -reserved: REWIND -reserved: REWRITE -reserved: RF -reserved: RH -reserved: RIGHT -reserved: RIGHT-JUSTIFY -reserved: ROLLBACK -reserved: ROUNDED -reserved: RUN -reserved: SAME -reserved: SCREEN -reserved: SD -reserved: SEARCH -reserved: SECTION -reserved: SECURE -reserved: SECURITY -reserved: SEEK -reserved: SEGMENT -reserved: SEGMENT-LIMIT -reserved: SELECT -reserved: SELECTIVE -reserved: SEND -reserved: SENTENCE -reserved: SEPARATE -reserved: SEQUENCE -reserved: SEQUENTIAL -reserved: SERVICE -reserved: SET -reserved: SHIFT-IN -reserved: SHIFT-OUT -reserved: SIGN -reserved: SIZE -reserved: SKIP1 -reserved: SKIP2 -reserved: SKIP3 -reserved: SORT -reserved: SORT-CONTROL -reserved: SORT-CORE-SIZE -reserved: SORT-FILE-SIZE -reserved: SORT-MERGE -reserved: SORT-MESSAGE -reserved: SORT-MODE-SIZE -reserved: SORT-RETURN -reserved: SOURCE -reserved: SOURCE-COMPUTER -reserved: SPACE -reserved: SPACE-FILL -reserved: SPACES=SPACE -reserved: SPECIAL-NAMES -reserved: STANDARD -reserved: STANDARD-1 -reserved: STANDARD-2 -reserved: START -reserved: STATUS -reserved: STOP -reserved: STRING -reserved: SUB-QUEUE-1 -reserved: SUB-QUEUE-2 -reserved: SUB-QUEUE-3 -reserved: SUBTRACT -reserved: SUM -reserved: SUPER -reserved: SUPPRESS -reserved: SYMBOLIC -reserved: SYNC -reserved: SYNCHRONIZED -reserved: TABLE -reserved: TALLY -reserved: TALLYING -reserved: TAPE -reserved: TERMINAL -reserved: TERMINATE -reserved: TEST -reserved: TEXT -reserved: THAN -reserved: THEN -reserved: THROUGH -reserved: THRU -reserved: TIME -reserved: TIME-OF-DAY -reserved: TIMEOUT=TIME-OUT -reserved: TIMES -reserved: TITLE -reserved: TO -reserved: TOP -reserved: TOTALED -reserved: TOTALING -reserved: TRACE -reserved: TRACK -reserved: TRACK-AREA -reserved: TRACK-LIMIT -reserved: TRACKS -reserved: TRAILING -reserved: TRAILING-SIGN -reserved: TRANSFORM -reserved: TRUE -reserved: TYPE -reserved: UNDERLINE -reserved: UNIT -reserved: UNLOCK -reserved: UNSTRING -reserved: UNTIL -reserved: UP -reserved: UPDATE -reserved: UPON -reserved: USAGE -reserved: USE -reserved: USING -reserved: VALUE -reserved: VALUES=VALUE -reserved: VARYING -reserved: WHEN -reserved: WHEN-COMPILED -reserved: WITH -reserved: WORDS -reserved: WORKING-STORAGE -reserved: WRITE -reserved: WRITE-ONLY -reserved: ZERO -reserved: ZERO-FILL -reserved: ZEROES=ZERO -reserved: ZEROS=ZERO - -# list of registers: -not-register: DIALECT-ALL -register: "ADDRESS\ OF" -# register: COL -# register: COM-REG -# register: CURRENT-DATE -# register: FIELD-TERMINATOR # TO-DO: Implement -register: "LENGTH\ OF" -# register: LIN -# register: LINAGE-COUNTER -register: RETURN-CODE -# register: SHIFT-IN -# register: SHIFT-OUT -# register: SORT-CORE-SIZE -# register: SORT-CONTROL -# register: SORT-FILE-SIZE -# register: SORT-MESSAGE -# register: SORT-MODE-SIZE -register: SORT-RETURN -register: TALLY -# register: TIME-OF-DAY -register: WHEN-COMPILED - - -# list of system names: -not-system-name: DIALECT-ALL-SWITCHES -not-system-name: S03 -not-system-name: S04 -not-system-name: S05 - - -# disable all functions -not-intrinsic-function: DIALECT-ALL - -# add all that are supported by Realia -intrinsic-function: ACOS -intrinsic-function: ANNUITY -intrinsic-function: ASIN -intrinsic-function: ATAN -intrinsic-function: CHAR -intrinsic-function: COS -intrinsic-function: CURRENT-DATE -intrinsic-function: DATE-OF-INTEGER -intrinsic-function: DATE-TO-YYYYMMDD -intrinsic-function: DAY-OF-INTEGER -intrinsic-function: DAY-TO-YYYYDDD -intrinsic-function: FACTORIAL -intrinsic-function: ORD -intrinsic-function: ORD-MAX -intrinsic-function: ORD-MIN -intrinsic-function: NUMVAL -intrinsic-function: NUMVAL-C -intrinsic-function: INTEGER -intrinsic-function: INTEGER-OF-DATE -intrinsic-function: INTEGER-OF-DAY -intrinsic-function: INTEGER-PART -intrinsic-function: LENGTH -intrinsic-function: LOG -intrinsic-function: LOG10 -intrinsic-function: LOWER-CASE -intrinsic-function: MAX -intrinsic-function: MEAN -intrinsic-function: MEDIAN -intrinsic-function: MIDRANGE -intrinsic-function: MIN -intrinsic-function: MOD -intrinsic-function: NUMVAL -intrinsic-function: NUMVAL-C -intrinsic-function: ORD -intrinsic-function: ORD-MAX -intrinsic-function: ORD-MIN -intrinsic-function: PRESENT-VALUE -intrinsic-function: RANDOM -intrinsic-function: REM -intrinsic-function: REVERSE -intrinsic-function: SIN -intrinsic-function: SQRT -intrinsic-function: STANDARD-DEVIATION -intrinsic-function: SUM -intrinsic-function: TAN -intrinsic-function: UPPER-CASE -intrinsic-function: VARIANCE -intrinsic-function: YEAR-TO-YYYY -intrinsic-function: WHEN-COMPILED diff -Nru gnucobol-4.0~early~20200606/config/rm.conf gnucobol-5/config/rm.conf --- gnucobol-4.0~early~20200606/config/rm.conf 2020-06-06 20:52:02.000000000 +0000 +++ gnucobol-5/config/rm.conf 1970-01-01 00:00:00.000000000 +0000 @@ -1,34 +0,0 @@ -# GnuCOBOL compiler configuration -# -# Copyright (C) 2001-2012, 2014-2017 Free Software Foundation, Inc. -# Written by Keisuke Nishida, Roger While, Simon Sobisch, Edward Hart -# -# This file is part of GnuCOBOL. -# -# The GnuCOBOL compiler is free software: you can redistribute it -# and/or modify it under the terms of the GNU General Public License -# as published by the Free Software Foundation, either version 3 of the -# License, or (at your option) any later version. -# -# GnuCOBOL is distributed in the hope that it will be useful, -# but WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -# GNU General Public License for more details. -# -# You should have received a copy of the GNU General Public License -# along with GnuCOBOL. If not, see . - - -include "rm-strict.conf" - -# Value: any string -name: "RM-COBOL (lax)" - -# reserve additional words, synonyms and exceptions from normal word list -include: "rm.words" - -# not-reserved: -# Value: Word to be taken out of the reserved words list -# -fill upon request- - -include "lax.conf-inc" diff -Nru gnucobol-4.0~early~20200606/config/rm-strict.conf gnucobol-5/config/rm-strict.conf --- gnucobol-4.0~early~20200606/config/rm-strict.conf 2020-06-06 20:52:02.000000000 +0000 +++ gnucobol-5/config/rm-strict.conf 1970-01-01 00:00:00.000000000 +0000 @@ -1,271 +0,0 @@ -# GnuCOBOL compiler configuration -# -# Copyright (C) 2001-2012, 2014-2020 Free Software Foundation, Inc. -# Written by Keisuke Nishida, Roger While, Simon Sobisch, Edward Hart, -# Ron Norman -# -# This file is part of GnuCOBOL. -# -# The GnuCOBOL compiler is free software: you can redistribute it -# and/or modify it under the terms of the GNU General Public License -# as published by the Free Software Foundation, either version 3 of the -# License, or (at your option) any later version. -# -# GnuCOBOL is distributed in the hope that it will be useful, -# but WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -# GNU General Public License for more details. -# -# You should have received a copy of the GNU General Public License -# along with GnuCOBOL. If not, see . - - -# Value: any string -name: "RM-COBOL" - -# Value: enum -standard-define 6 -# CB_STD_OC = 0, -# CB_STD_MF, -# CB_STD_IBM, -# CB_STD_MVS, -# CB_STD_BS2000, -# CB_STD_ACU, -# CB_STD_RM -# CB_STD_85, -# CB_STD_2002, -# CB_STD_2014, - -# TO-DO: Allow configuring WHEN-COMPILED date format (see p. 22). - -# Value: int -tab-width: 8 # not verified yet -text-column: 72 # TO-DO: add >>IMP MARGIN-R (see p. 50) -# Maximum word-length for COBOL words / Programmer defined words -# current max (COB_MAX_WORDLEN): 63 -#word-length: 240 -word-length: 63 -# external-word-length: 30 # TO-DO: Add! -literal-length: 65535 -numeric-literal-length: 30 -pic-length: 30 - -# Default assign type -# Value: 'dynamic', 'external' -assign-clause: dynamic # TO-DO: Verify - -# If yes, file names are resolved at run time using -# environment variables. -# For example, given ASSIGN TO "DATAFILE", the file name will be -# 1. the value of environment variable 'DD_DATAFILE' or -# 2. the value of environment variable 'dd_DATAFILE' or -# 3. the value of environment variable 'DATAFILE' or -# 4. the literal "DATAFILE" -# If no, the value of the assign clause is the file name. -# -filename-mapping: no - -# Alternate formatting of numeric fields -pretty-display: no - -# Allow complex OCCURS DEPENDING ON -complex-odo: yes - -# Allow REDEFINES to other than last equal level number -indirect-redefines: no - -# Binary byte size - defines the allocated bytes according to PIC -# Value: signed unsigned bytes -# ------ -------- ----- -# '2-4-8' 1 - 4 same 2 -# 5 - 9 same 4 -# 10 - 18 same 8 -# -# '1-2-4-8' 1 - 2 same 1 -# 3 - 4 same 2 -# 5 - 9 same 4 -# 10 - 18 same 8 -# -# '1--8' 1 - 2 1 - 2 1 -# 3 - 4 3 - 4 2 -# 5 - 6 5 - 7 3 -# 7 - 9 8 - 9 4 -# 10 - 11 10 - 12 5 -# 12 - 14 13 - 14 6 -# 15 - 16 15 - 16 7 -# 17 - 18 17 - 18 8 -# TO-DO: What happens for 19 to 30 digits? RM-COBOL will allocate 16 bytes. -binary-size: 2-4-8 - -# Numeric truncation according to ANSI -binary-truncate: yes - -# Binary byte order -# Value: 'native', 'big-endian' -binary-byteorder: big-endian - -# Allow larger REDEFINES items -larger-redefines-ok: yes # TO-DO: But only for 01 items (see p. 134) - -# Allow certain syntax variations (eg. REDEFINES position) -relax-syntax-checks: yes # TO-DO: For REDEFINES position, at least. - -# Perform type OSVS - If yes, the exit point of any currently -# executing perform is recognized if reached. -perform-osvs: no # TO-DO: Any potentially undefined (i.e. overlapping) PERFORMS prohibited (see p. 374) - -# Compute intermediate decimal results like IBM OSVS -arithmetic-osvs: no - -# MOVE like IBM (mvc); left to right, byte by byte -move-ibm: no - -# If yes, linkage-section items remain allocated -# between invocations. -sticky-linkage: yes - -# If yes, allow non-matching level numbers -relax-level-hierarchy: no - -# If yes, evaluate constant expressions at compile time -constant-folding: yes # not verified yet - -# Allow Hex 'F' for NUMERIC test of signed PACKED DECIMAL field -hostsign: no - -# If yes, set WITH UPDATE clause as default for ACCEPT dest-item, -# except if WITH NO UPDATE clause is used -accept-update: no - -# If yes, set WITH AUTO clause as default for ACCEPT dest-item, -# except if WITH TAB clause is used -accept-auto: yes - -# If yes, DISPLAYs and ACCEPTs are, by default, done on the CRT (i.e., using -# curses). -console-is-crt: no - -# If yes, allow redefinition of the current program's name. This prevents its -# use in a prototype-format CALL/CANCEL statement. -program-name-redefinition: no - -# If yes, NO ECHO/NO-ECHO/OFF is the same as SECURE (hiding input with -# asterisks, not spaces). -no-echo-means-secure: no - -# If yes, the first item in a field screen ACCEPT/DISPLAY (e.g. DISPLAY x UPON -# CRT) is located after the previous ACCEPT/DISPLAY (as though LINE 0 COL 0 had -# been specified). -line-col-zero-default: no - -# If yes, then REPORT, COLUMN may have any of PLUS num, + num, or +num -# to define a relative column position -report-column-plus: no - -# If yes, DISPLAY SPACES acts as ERASE EOS, DISPLAY X"01" acts as ERASE EOL, -# DISPLAY X"02" acts as BLANK SCREEEN and DISPLAY X"07" acts as BELL. Note -# DISPLAY LOW-VALUE is excluded from this; it will always just position the -# cursor. -display-special-fig-consts: no - -# If yes, COMP-1 is a signed 16-bit integer and any PICTURE clause is ignored. -binary-comp-1: yes - -# auto-adjust to zero like MicroFocus does -move-non-numeric-lit-to-numeric-is-zero: no # not verified yet - -# If yes, implicitly define a variable for an ASSIGN DYNAMIC which does not -# match an existing data item. -implicit-assign-dynamic-var: no - -# What rules to apply to SCREEN SECTION items clauses -screen-section-rules: rm - -# Dialect features -# Value: 'ok', 'warning', 'archaic', 'obsolete', 'skip', 'ignore', 'error', -# 'unconformable' - -alter-statement: obsolete -comment-paragraphs: obsolete -call-overflow: ok -data-records-clause: obsolete -debugging-mode: ok -use-for-debugging: obsolete -listing-statements: skip # may be a user-defined word -title-statement: skip # may be a user-defined word -entry-statement: unconformable -goto-statement-without-name: obsolete -label-records-clause: obsolete -memory-size-clause: obsolete -move-noninteger-to-alphanumeric: error -move-figurative-constant-to-numeric: ok # not verified yet -move-figurative-space-to-numeric: ok # not verified yet -move-figurative-quote-to-numeric: ok # not verified yet -multiple-file-tape-clause: obsolete -next-sentence-phrase: archaic -odo-without-to: unconformable -padding-character-clause: ok -section-segments: obsolete -stop-literal-statement: obsolete -stop-identifier-statement: ok -same-as-clause: ok -synchronized-clause: ok -sync-left-right: ok -special-names-clause: error # not verified yet -top-level-occurs-clause: unconformable -value-of-clause: obsolete -numeric-boolean: unconformable -hexadecimal-boolean: unconformable -national-literals: unconformable -hexadecimal-national-literals: unconformable -national-character-literals: unconformable -# TO-DO: Add separate config option for H"..." to be unsupported,numeric(rm/mf),non-numeric -acu-literals: unconformable -hp-octal-literals: unconformable -word-continuation: ok -length-in-data-division: no -depending-on-not-fixed: warning -occurs-max-length-without-subscript: no -not-exception-before-exception: unconformable -accept-display-extensions: ok -renames-uncommon-levels: unconformable -symbolic-constant: unconformable -constant-78: ok -constant-01: unconformable -perform-varying-without-by: unconformable -reference-out-of-declaratives: error # TO-DO: error when referring to non-USE-statement DECLARATIVE sections -reference-bounds-check: error -program-prototypes: unconformable -call-convention-mnemonic: unconformable -call-convention-linkage: unconformable -numeric-value-for-edited-item: error -incorrect-conf-sec-order: error -define-constant-directive: unconformable -free-redefines-position: unconformable -records-mismatch-record-clause: error -record-delimiter: ok -sequential-delimiters: ok -record-delim-with-fixed-recs: ok -missing-statement: warning # not verified yet -zero-length-literals: unconformable -xml-generate-extra-phrases: unconformable -continue-after: unconformable -goto-entry: unconformable -binary-sync-clause: ignore -nonnumeric-with-numeric-group-usage: ok -assign-variable: ok -assign-using-variable: unconformable -assign-ext-dyn: unconformable -assign-disk-from: unconformable -align-record: 4 -align-opt: no - -# obsolete in COBOL85 and currently not available as dialect features: -# 1: All literal with numeric or numeric edited item -# 2: RERUN clause -# 3: KEY phrase of the DISABLE and ENABLE statements -# 4: ENTER statement -# 5: REVERSED phrase of the OPEN statement - -# use fixed word list, synonyms and exceptions specified there -reserved-words: RM diff -Nru gnucobol-4.0~early~20200606/config/rm.words gnucobol-5/config/rm.words --- gnucobol-4.0~early~20200606/config/rm.words 2020-06-06 20:52:02.000000000 +0000 +++ gnucobol-5/config/rm.words 1970-01-01 00:00:00.000000000 +0000 @@ -1,532 +0,0 @@ -# GnuCOBOL compiler - list of reserved words -# -# Copyright (C) 2016-2017 Free Software Foundation, Inc. -# Written by Simon Sobisch, Edward Hart -# -# This file is part of GnuCOBOL. -# -# The GnuCOBOL compiler is free software: you can redistribute it -# and/or modify it under the terms of the GNU General Public License -# as published by the Free Software Foundation, either version 3 of the -# License, or (at your option) any later version. -# -# GnuCOBOL is distributed in the hope that it will be useful, -# but WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -# GNU General Public License for more details. -# -# You should have received a copy of the GNU General Public License -# along with GnuCOBOL. If not, see . - - -# Word list for dialect: RM-COBOL - -# Note: only used for strict dialect and when -# requested by compiler directive >> IMP WORDS RM -# the default reserved word list will not be used. - -# Value: Word to make up reserved words list (case independent) -# All reserved entries listed will replace entire default reserved words list. -# Words ending with * will be treated as context-sensitive words. This will be -# ignored if GnuCOBOL uses that word as a reserved word. -# Entries of the form word-1=word-2 define word-1 as an alias for default -# reserved word word-2. No spaces are allowed around the equal sign. -reserved: ACCEPT -reserved: ACCESS -reserved: ADD -reserved: ADDRESS -reserved: ADVANCING -reserved: AFTER -reserved: ALL -reserved: ALPHABET -reserved: ALPHABETIC -reserved: ALPHABETIC-LOWER -reserved: ALPHABETIC-UPPER -reserved: ALPHANUMERIC -reserved: ALPHANUMERIC-EDITED -reserved: ALSO -reserved: ALTER -reserved: ALTERNATE -reserved: AND -reserved: ANY -reserved: ARE -reserved: AREA -reserved: AREAS -reserved: AS -reserved: ASCENDING -reserved: ASSIGN -reserved: AT -reserved: AUTHOR -reserved: AUTO* -reserved: AUTO-SKIP*=AUTO -reserved: AUTOMATIC* -reserved: BACKGROUND*=BACKGROUND-COLOR -reserved: BACKGROUND-COLOR* -reserved: BEEP=BELL -reserved: BEFORE -reserved: BELL -reserved: BINARY -reserved: BINARY-SEQUENTIAL* -reserved: BLANK -reserved: BLINK -reserved: BLOCK -reserved: BOTTOM -reserved: BY -reserved: CALL -reserved: CANCEL -reserved: CASE-INSENSITIVE* -reserved: CASE-SENSITIVE* -reserved: CD -reserved: CENTURY-DATE -reserved: CENTURY-DAY -reserved: CHARACTER -reserved: CHARACTERS -reserved: CLASS -reserved: CLOCK-UNITS -reserved: CLOSE -reserved: CODE -reserved: CODE-SET -reserved: COL -reserved: COLLATING -reserved: COLUMN -reserved: COMMA -reserved: COMMON -reserved: COMMUNICATION -reserved: COMP -reserved: COMP-1 -reserved: COMP-3 -reserved: COMP-4 -reserved: COMP-5 -reserved: COMP-6 -reserved: COMPUTATIONAL -reserved: COMPUTATIONAL-1 -reserved: COMPUTATIONAL-3 -reserved: COMPUTATIONAL-4 -reserved: COMPUTATIONAL-5 -reserved: COMPUTATIONAL-6 -reserved: COMPUTE -reserved: CONFIGURATION -reserved: CONTAINS -reserved: CONTENT -reserved: CONTINUE -reserved: CONTROL -reserved: COBOL -reserved: CONVERT -reserved: CONVERTING -reserved: COPY -reserved: CORR -reserved: CORRESPONDING -reserved: COUNT -reserved: COUNT-MAX -reserved: COUNT-MIN -reserved: CRT* -reserved: CURRENCY -reserved: CURSOR -reserved: CYCLE* -reserved: DATA -reserved: DATA-POINTER -reserved: DATE -reserved: DATE-AND-TIME -reserved: DATE-COMPILED -reserved: DATE-WRITTEN -reserved: DAY -reserved: DAY-AND-TIME -reserved: DEBUGGING -reserved: DECIMAL-POINT -reserved: DECLARATIVES -reserved: DEFAULT -reserved: DELETE -reserved: DELIMITED -reserved: DELIMITER -reserved: DEPENDING -reserved: DESCENDING -reserved: DESTINATION -reserved: DISABLE -reserved: DISPLAY -reserved: DIVIDE -reserved: DIVISION -reserved: DOWN -reserved: DUPLICATES -reserved: DYNAMIC -reserved: ECHO -reserved: EGI -reserved: ELSE -reserved: EMI -reserved: ENABLE -reserved: END -reserved: END-ACCEPT -reserved: END-ADD -reserved: END-CALL -reserved: END-COMPUTE -reserved: END-COPY* -reserved: END-DELETE -reserved: END-DIVIDE -reserved: END-EVALUATE -reserved: END-IF -reserved: END-MULTIPLY -reserved: END-OF-PAGE -reserved: END-PERFORM -reserved: END-READ -reserved: END-RECEIVE -reserved: END-REPLACE* -reserved: END-RETURN -reserved: END-REWRITE -reserved: END-SEARCH -reserved: END-START -reserved: END-STRING -reserved: END-SUBTRACT -reserved: END-UNSTRING -reserved: END-WRITE -reserved: ENTER -reserved: ENVIRONMENT -reserved: EOL* -reserved: EOP -reserved: EOS* -reserved: EQUAL -reserved: ERASE -reserved: ERROR -reserved: ESCAPE -reserved: ESI -reserved: EVALUATE -reserved: EVERY -reserved: EXCEPTION -reserved: EXCLUSIVE -reserved: EXIT -reserved: EXTEND -reserved: EXTERNAL -reserved: FALSE -reserved: FD -reserved: FILE -reserved: FILE-CONTROL -reserved: FILLER -reserved: DAY-OF-WEEK -reserved: FIRST -reserved: FIXED -reserved: FOOTING -reserved: FOR -reserved: FOREGROUND*=FOREGROUND-COLOR -reserved: FOREGROUND-COLOR* -reserved: FROM -reserved: FULL* -reserved: GIVING -reserved: GLOBAL -reserved: GO -reserved: GOBACK -reserved: GREATER -reserved: HIGH -reserved: HIGH-VALUE -reserved: HIGH-VALUES=HIGH-VALUE -reserved: HIGHEST-VALUE # SPECIAL-REGISTER -reserved: HIGHLIGHT -reserved: I-O -reserved: I-O-CONTROL -reserved: ID -reserved: IDENTIFICATION -reserved: IF -reserved: IMP -reserved: IMP* -reserved: IN -reserved: INDEX -reserved: INDEXED -reserved: INDICATE -reserved: INITIAL -reserved: INITIAL-VALUE -reserved: INITIALIZE -reserved: INPUT -reserved: INPUT-OUTPUT -reserved: INSPECT -reserved: INSTALLATION -reserved: INTO -reserved: INVALID -reserved: IS -reserved: JUST -reserved: JUSTIFIED -reserved: KEY -reserved: LABEL -reserved: LAST -reserved: LEADING -reserved: LEFT -reserved: LENGTH -reserved: LESS -reserved: LIKE -reserved: LIMITS -reserved: LINAGE -reserved: LINAGE-COUNTER -reserved: LINE -reserved: LINE-SEQUENTIAL* -reserved: LINES -reserved: LINKAGE -reserved: LOCK -reserved: LOW -reserved: LOW-VALUE -reserved: LOW-VALUES=LOW-VALUE -reserved: LOWEST-VALUE # SPECIAL-REGISTER -reserved: LOWLIGHT -reserved: MANUAL* -reserved: MAX-VALUE # SPECIAL-REGISTER -reserved: MEMORY -reserved: MERGE -reserved: MESSAGE -reserved: MIN-VALUE # SPECIAL-REGISTER -reserved: MODE -reserved: MODULES -reserved: MOVE -reserved: MULTIPLE* -reserved: MULTIPLY -reserved: NATIVE -reserved: NEGATIVE -reserved: NEXT -reserved: NO -reserved: NOT -reserved: NULL -reserved: NULLS=NULL -reserved: NUMBER -reserved: NUMERIC -reserved: NUMERIC-EDITED -reserved: OBJECT-COMPUTER -reserved: OCCURS -reserved: OF -reserved: OFF -reserved: OMITTED -reserved: ON -reserved: OPEN -reserved: OPTIONAL -reserved: OR -reserved: ORDER -reserved: ORGANIZATION -reserved: OTHER -reserved: OUTPUT -reserved: OVERFLOW -reserved: PACKED-DECIMAL -reserved: PADDING -reserved: PAGE -reserved: PARAGRAPH* -reserved: PERFORM -reserved: PIC=PICTURE -reserved: PICTURE -reserved: PLUS -reserved: POINTER -reserved: POSITION -reserved: POSITIVE -reserved: PREVIOUS* -reserved: PRINTING -reserved: PROCEDURE -reserved: PROCEDURE-NAME -reserved: PROCEED -reserved: PROGRAM -reserved: PROGRAM-ID -reserved: PROMPT -reserved: PURGE -reserved: QUEUE -reserved: QUOTE -reserved: QUOTES -reserved: RANDOM -reserved: READ -reserved: RECEIVE -reserved: RECORD -reserved: RECORDS -reserved: REDEFINES -reserved: REEL -reserved: REFERENCE -reserved: RELATIVE -reserved: RELEASE -reserved: REMAINDER -reserved: REMARKS -reserved: REMOVAL -reserved: RENAMES -reserved: REPLACE -reserved: REPLACING -reserved: REQUIRED* -reserved: RERUN -reserved: RESERVE -reserved: RETURN -reserved: RETURNING -reserved: REVERSE -reserved: REVERSE-VIDEO -reserved: REVERSED -reserved: REWIND -reserved: REWRITE -reserved: RIGHT -reserved: ROUNDED -reserved: RUN -reserved: SAME -reserved: SCREEN -reserved: SD -reserved: SEARCH -reserved: SECTION -reserved: SECURE -reserved: SECURITY -reserved: SEGMENT -reserved: SEGMENT-LIMIT -reserved: SELECT -reserved: SEND -reserved: SENTENCE -reserved: SEPARATE -reserved: SEQUENCE -reserved: SEQUENTIAL -reserved: SET -reserved: SIGN -reserved: SIZE -reserved: SORT -reserved: SORT-MERGE -reserved: SOURCE -reserved: SOURCE-COMPUTER -reserved: SPACE -reserved: SPACES=SPACE -reserved: SPECIAL-NAMES -reserved: STANDARD -reserved: STANDARD-1 -reserved: STANDARD-2 -reserved: START -reserved: STATUS -reserved: STOP -reserved: STRING -reserved: SUB-QUEUE-1 -reserved: SUB-QUEUE-2 -reserved: SUB-QUEUE-3 -reserved: SUBTRACT -reserved: SUPPRESS -reserved: SYMBOLIC -reserved: SYNC -reserved: SYNCHRONIZED -reserved: TAB -reserved: TABLE -reserved: TALLYING -reserved: TAPE -reserved: TERMINAL -reserved: TEST -reserved: TEXT -reserved: THAN -reserved: THEN -reserved: THROUGH -reserved: THRU -reserved: TIME -reserved: TIMES -reserved: TO -reserved: TOP -reserved: TRAILING -reserved: TRIMMED* -reserved: TRUE -reserved: UNDERLINE* -reserved: UNIT -reserved: UNLOCK -reserved: UNSTRING -reserved: UNTIL -reserved: UP -reserved: UPDATE -reserved: UPON -reserved: USAGE -reserved: USE -reserved: USING -reserved: VALUE -reserved: VALUES=VALUE -reserved: VARYING -reserved: WHEN -reserved: WHILE* -reserved: WITH -reserved: WORDS -reserved: WORKING-STORAGE -reserved: WRITE -reserved: YYYYDDD* -reserved: YYYYMMDD* -reserved: ZERO -reserved: ZEROES=ZERO -reserved: ZEROS=ZERO - -# registered "unused" words because these are reserved words in -# unsupported modules of ANSI 85 or other COBOL dialects: - -reserved: CF -reserved: CH -reserved: CONTROLS -reserved: DE -reserved: DEBUG-CONTENTS -reserved: DEBUG-ITEM -reserved: DEBUG-LINE -reserved: DEBUG-NAME -reserved: DEBUG-SUB-1 -reserved: DEBUG-SUB-2 -reserved: DEBUG-SUB-3 -reserved: DETAIL -reserved: FINAL -reserved: FUNCTION -reserved: GENERATE -reserved: GROUP -reserved: HEADING -reserved: INITIATE -reserved: LIMIT -reserved: LINE-COUNTER -reserved: PAGE-COUNTER -reserved: PF -reserved: PH -reserved: PROCEDURES -reserved: RD -reserved: RECORDING -reserved: REFERENCES -reserved: REPORT -reserved: REPORTING -reserved: REPORTS -reserved: RESET -reserved: RF -reserved: RH -reserved: SUM -reserved: TERMINATE -reserved: TYPE -reserved: VARIABLE - - -# list of registers: -# TO-DO: Should PROCEDURE-NAME [IN|OF] {PARAGRAPH|PROCEDURE|SECTION} be a register? -not-register: DIALECT-ALL # disable all registers, specify used below -# register: "ADDRESS\ IN" -register: "ADDRESS\ OF" -# register: "COUNT-MAX\ IN" -# register: "COUNT-MAX\ OF" -# register: "COUNT-MIN\ IN" -# register: "COUNT-MIN\ OF" -# register: "COUNT\ IN" -# register: "COUNT\ OF" -register: DEBUG-ITEM -# register: "HIGHEST-VALUE\ IN" -# register: "HIGHEST-VALUE\ OF" -# register: "INITIAL-VALUE\ IN" -# register: "INITIAL-VALUE\ OF" -# register: "LENGTH\ IN" -register: "LENGTH\ OF" -# register: "LINAGE-COUNTER\ IN" -# register: "LINAGE-COUNTER\ OF" -# register: "LOWEST-VALUE\ IN" -# register: "LOWEST-VALUE\ OF" -# register: "MAX-VALUE\ IN" -# register: "MAX-VALUE\ OF" -# register: "MIN-VALUE\ IN" -# register: "MIN-VALUE\ OF" -# register: PROGRAM-ID -register: RETURN-CODE -register: WHEN-COMPILED - - -# list of system names: -not-system-name: DIALECT-ALL-SWITCHES -system-name: SWITCH-1 -system-name: SWITCH-2 -system-name: SWITCH-3 -system-name: SWITCH-4 -system-name: SWITCH-5 -system-name: SWITCH-6 -system-name: SWITCH-7 -system-name: SWITCH-8 -system-name: UPSI-0 -system-name: UPSI-1 -system-name: UPSI-2 -system-name: UPSI-3 -system-name: UPSI-4 -system-name: UPSI-5 -system-name: UPSI-6 -system-name: UPSI-7 - -system-name: CONSOLE - - -# Intrinsic Functions - explicit not supported by RM-COBOL -not-intrinsic-function: DIALECT-ALL diff -Nru gnucobol-4.0~early~20200606/config/runtime.cfg gnucobol-5/config/runtime.cfg --- gnucobol-4.0~early~20200606/config/runtime.cfg 2020-06-06 20:52:02.000000000 +0000 +++ gnucobol-5/config/runtime.cfg 1970-01-01 00:00:00.000000000 +0000 @@ -1,710 +0,0 @@ -# GnuCOBOL runtime configuration -# -# Copyright (C) 2015-2019 Free Software Foundation, Inc. -# Written by Simon Sobisch, Ron Norman -# -# This file is part of the GnuCOBOL runtime. -# -# The GnuCOBOL runtime is free software: you can redistribute it -# and/or modify it under the terms of the GNU Lesser General Public License -# as published by the Free Software Foundation, either version 3 of the -# License, or (at your option) any later version. -# -# GnuCOBOL is distributed in the hope that it will be useful, -# but WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -# GNU General Public License for more details. -# -# You should have received a copy of the GNU Lesser General Public License -# along with GnuCOBOL. If not, see . - - -# -## General instructions -# - -# The initial runtime.cfg file is found in the $COB_CONFIG_DIR , -# which defaults to installdir/gnucobol/config (see cobcrun --info for the -# local path that is configured). -# The environment variable COB_RUNTIME_CONFIG may define a different runtime -# configuration file to read. - -# If settings are included in the runtime environment file multiple times -# then the last setting value is used, no warning occurs. - -# Settings via environment variables always take precedence over settings -# that are given in runtime configuration files. And the environment is -# checked after completing processing of the runtime configuration file(s) - -# All values set to string variables or environment variables are checked -# for ${envvar} and replacement is done at the time of the setting. -# You can also specify a default value for the case that envvar is not set: -# ${envvar:default} (the format ${envvar:-default} is supported, too). - -# Any environment variable may be set with the directive setenv . -# Example: setenv COB_LIBARAY_PATH ${LD_LIBRARY_PATH} - -# Any environment variable may be unset with the directive unsetenv -# (one var per line). -# Example: unsetenv COB_LIBRARY_PATH - -# Runtime configuration files can include other files with the -# directive include . -# Example: include my-runtime-configuration-file - -# To include another configuration file only if it is present use the -# directive includeif . -# You can also use ${envvar} inside this. -# Example: includeif ${HOME}/mygc.cfg - -# If you want to reset a parameter to its default value use -# reset parametername . - -# Most runtime variables have boolean values, some are switches, some have -# string values, integer values (if not explicit noted: unsigned) and some -# are size values. -# The boolean values will be evaluated as following: -# to true: 1, Y, ON, YES, TRUE (no matter of case) -# to false: 0, N, OFF -# A 'size' value is an unsigned integer optionally followed by K, M, or G -# for kilo, mega or giga. - -# For convenience a parameter in the runtime.cfg file may be defined by using -# either the environment variable name or the parameter name. -# In most cases the environment variable name is the parameter name (in upper -# case) with the prefix COB_ . - -# For a complete list of the settings in use see cobcrun --runtime-config . - -# Note: -# If you want to *slightly* speed up a program's startup time, remove all -# of the comments from the actual real configuration file that is processed. - -## - -# -## General environment -# - -# Environment name: COB_DISABLE_WARNINGS -# Parameter name: disable_warnings -# Purpose: turn off runtime warning messages -# Type: boolean -# Default: false -# Example: DISABLE_WARNINGS TRUE - -# Environment name: COB_ENV_MANGLE -# Parameter name: env_mangle -# Purpose: names checked in the environment would get non alphanumeric -# change to '_' -# Type: boolean -# Default: false -# Example: ENV_MANGLE TRUE - -# Environment name: COB_SET_DEBUG -# Parameter name: debugging_mode -# Purpose: to enable USE ON DEBUGGING procedures that were active -# during compile-time because of WITH DEBUGGING MODE, -# otherwise the code generated will be skipped -# Type: boolean -# Default: false -# Example: COB_SET_DEBUG 1 - -# Environment name: COB_SET_TRACE -# Parameter name: set_trace -# Purpose: to enable COBOL trace feature -# Type: boolean -# Default: false -# Example: SET_TRACE TRUE - -# Environment name: COB_TRACE_FILE -# Parameter name: trace_file -# Purpose: to define where COBOL trace output should go -# Type: string : $$ is replaced by process id -# Default: stderr -# Example: TRACE_FILE ${HOME}/mytrace.$$ - -# Environment name: COB_TRACE_FORMAT -# Parameter name: trace_format -# Purpose: to define format of COBOL trace output -# Type: string -# Default: "%P %S Line: %L" -# %P is replaced by Program-Id/Function-Id minimal length 29 -# with prefix -# %I is replaced by Program-Id/Function-Id variable length, -# without prefix -# %L is replaced by Line number, right justified, length 6 -# %S is replaced by statement type and name -# %F is replaced by source file name -# Example: TRACE_FORMAT "Line: %L %S" -# Note: format of GC2.2 and older: -# "PROGRAM-ID: %I Line: %L %S" - -# Environment name: COB_TRACE_IO -# Parameter name: trace_io -# Purpose: define if I/O details should be added to trace -# Type: boolean -# Default: false -# Example: TRACE_IO true - -# Environment name: COB_DUMP_FILE -# Parameter name: dump_file -# Purpose: to define where COBOL dump output should go -# Note: The -fdump=all compile option prepares for dump -# Type: string : $$ is replaced by process id -# Default: stderr -# Example: DUMP_FILE ${HOME}/mytrace.log - -# Environment name: COB_DUMP_WIDTH -# Parameter name: dump_width -# Purpose: to define COBOL dump line length -# Type: integer -# Default: 100 -# Example: dump_width 120 - -# Environment name: COB_STATS_RECORD -# Parameter name: stats_record -# Purpose: define if I/O statistics should be written -# Type: boolean -# Default: false -# Example: STATS_RECORD true - -# Environment name: COB_STATS_FILE -# Parameter name: stats_file -# Purpose: to define where COBOL I/O statistics should be written -# The file is appended to -# Type: string -# Default: stderr -# Example: STATS_FILE ${HOME}/mystats.txt - -# Environment name: COB_CURRENT_DATE -# Parameter name: current_date -# Purpose: specify an alternate Date/Time to be returned to ACCEPT -# clauses this is used for testing purposes or to tweak -# a missing offset partial setting is allowed -# Type: numeric string in format YYYYDDMMHH24MISS or date string -# Default: the operating system date is used -# Example: COB_CURRENT_DATE "2016/03/16 16:40:52" -# current_date YYYYMMDDHHMMSS+01:00 - -# -## Call environment -# - -# Environment name: COB_LIBRARY_PATH -# Parameter name: library_path -# Purpose: paths for dynamically-loadable modules -# Type: string -# Note: the default paths .:/installpath/extras are always -# added to the given paths -# Example: LIBRARY_PATH /opt/myapp/test:/opt/myapp/production - -# Environment name: COB_PRE_LOAD -# Parameter name: pre_load -# Purpose: modules that are loaded during startup, can be used -# to CALL COBOL programs or C functions that are part -# of a module library -# Type: string -# Note: the modules listed should NOT include extensions, the -# runtime will use the right ones on the various platforms, -# COB_LIBRARY_PATH is used to locate the modules -# Example: PRE_LOAD COBOL_function_library:external_c_library - -# Environment name: COB_LOAD_CASE -# Parameter name: load_case -# Purpose: resolve ALL called program names to UPPER or LOWER case -# Type: Only use UPPER or LOWER -# Default: if not set program names in CALL are case sensitive -# Example: LOAD_CASE UPPER - -# Environment name: COB_PHYSICAL_CANCEL -# Parameter name: physical_cancel -# Purpose: physically unload a dynamically-loadable module on CANCEL, -# this frees some RAM and allows the change of modules during -# run-time but needs more time to resolve CALLs (both to -# active and not-active programs) -# Alias: default_cancel_mode, LOGICAL_CANCELS (0 = yes) -# Type: boolean (evaluated for true only) -# Default: false -# Example: PHYSICAL_CANCEL TRUE - -# -## File I/O -# - -# Environment name: COB_MF_FILES -# Parameter name: mf_files -# Purpose: declare that sequential/relative files should be in -# Micro Focus compatible format -# Type: boolean (evaluated for true only) -# Default: false -# Example: mf_files True - -# Environment name: COB_VARSEQ_FORMAT -# Parameter name: varseq_format -# Purpose: declare format to be used for variable length sequential files -# Type: 0 means 2 byte record length (big-endian) plus 2 NULs precedes record -# 1 means 4 byte record length (big-endian) precedes record -# 2 means 4 byte record length (local machine int) precedes record -# 3 means 2 byte record length (local machine short) precedes record -# b32 means 'type 2' above but the 'int' is in Big-Endian format -# l32 means 'type 2' above but the 'int' is in Little-Endian format -# mf means create the file in Micro Focus compatible format -# Default: 0 -# Example: VARSEQ_FORMAT 1 - -# Environment name: COB_VARREL_FORMAT -# Parameter name: varrel_format -# Purpose: declare format to be used for variable length relative files -# Type: gc means 'size_t' record length (local machine) precedes -# maxiumum length data record -# mf means file is in Micro Focus format -# b32 means Big-Endian 32-bit 'int' record length precedes data -# b64 means Big-Endian 64-bit 'int' record length precedes data -# l32 means Little-Endian 32-bit 'int' record length precedes data -# l64 means Little-Endian 64-bit 'int' record length precedes data -# Default: gc -# NOTE: 'gc' results in files which cannot be used if copied between -# machines of different hardware archeticture -# Example: VARREL_FORMAT mf - -# Environment name: COB_FIXREL_FORMAT -# Parameter name: fixrel_format -# Purpose: declare format to be used for fixed length relative -# files (different types and lengths preceding each record) -# Type: b32 means 4 byte record length (big-endian) -# l32 means 4 byte record length (little-endian) -# b64 means 8 byte record length (big-endian) -# l64 means 8 byte record length (little-endian) -# mf means Micro Focus default -# gc means GnuCOBOL default (local 'size_t') -# Default: gc fixed size with no record length prefix -# Example: FIXREL_FORMAT B32 - -# Environment name: COB_VARFIX_FORMAT -# Parameter name: varfix_format -# Purpose: declare format to be used for fixed length relative files -# Type: gc means 'size_t' record length (local machine) precedes -# fixed length data record -# mf means file is in Micro Focus format -# b32 means Big-Endian 32-bit 'int' record length precedes data -# b64 means Big-Endian 64-bit 'int' record length precedes data -# l32 means Little-Endian 32-bit 'int' record length precedes data -# l64 means Little-Endian 64-bit 'int' record length precedes data -# Default: gc -# NOTE: 'gc' results in files which cannot be used if copied between -# machines of different hardware archeticture -# Example: VARFIX_FORMAT mf - -# Environment name: COB_FILE_PATH -# Parameter name: file_path -# Purpose: define default location(s) where data files are stored -# Type: file path directory list -# Default: . (current directory) -# Example: FILE_PATH ${HOME}/mydata -# Unix/Linux list: FILE_PATH ${HOME}/mydata:${PROJECT}/datafiles -# Windows list: FILE_PATH C:\proja\mydata;D:\projb\yourdata;. - -# Environment name: COB_FILE_DICTIONARY -# Parameter name: file_dictionary -# Purpose: define when a file format description is written -# is written to 'asgname.dd' -# Type: false means never write -# no means never write -# true means write for BDB or LMDB only -# min means write for BDB or LMDB only -# always means write for all file types -# max means write for all file types -# Default: min -# Example: file_dictionary always - -# Environment name: COB_FILE_DICTIONARY_PATH -# Parameter name: file_dictionary_path -# Purpose: define where the 'asgname.dd' is written -# Type: file path directory -# Default: . (current directory) -# Example: FILE_DICTIONARY_PATH ${HOME}/mystuff - -# Environment name: COB_CREATE_TABLE -# Parameter name: create_table -# Purpose: For OCI/ODBC, if table is not defined and -# there is no tablename.ddl present -# should the CREATE TABLE be created at run time? -# Type: false means the OPEN will fail -# true means it will attempt to recreate the table definition -# Default: false -# Example: create_table true - -# Environment name: COB_BDB_BYTEORDER -# Parameter name: bdb_byteorder -# Purpose: Defines the byte order to be used for BDB -# Type: native - use the system byte order -# big-endian - use big-endian order -# little-endian - use little-endian order -# Default: native -# Example: bdb_byteorder big-endian - -# Environment name: COB_LS_FIXED -# Parameter name: ls_fixed -# Purpose: Defines if LINE SEQUENTIAL files should be fixed length -# (or variable, by removing trailing spaces) -# Alias: STRIP_TRAILING_SPACES (0 = yes) -# Type: boolean -# Default: false -# Example: LS_FIXED TRUE - -# Environment name: COB_LS_NULLS -# Parameter name: ls_nulls -# Purpose: Defines for LINE SEQUENTIAL files what to do with data -# which is not DISPLAY type. This could happen if a LINE -# SEQUENTIAL record has BINARY/COMP data fields in it. -# This option is only for GnuCOBOL format files -# Type: boolean -# Default: false -# Note: The TRUE setting will handle files that contain COMP data -# in a similar manner to the method used by Micro Focus -# Example: LS_NULLS = TRUE - -# Environment name: COB_LS_SPLIT -# Parameter name: ls_split -# Purpose: Defines for LINE SEQUENTIAL files what to do when a record -# is longer than the program handles. If 'ls_split=true' then -# the data is returned as multiple records -# Type: boolean -# Default: false -# The record is truncated and the file skips to the next LF -# Example: LS_SPLIT = TRUE - -# Environment name: COB_LS_VALIDATE -# Parameter name: ls_validate -# Purpose: Defines for LINE SEQUENTIAL files that the data should be -# validated. If any record has non-DISPLAY characters then -# an error status of 34 is returned -# This option is only for GnuCOBOL format files -# Type: boolean -# Default: true -# Note: The TRUE setting does data validation -# The FALSE setting lets non-DISPLAY characters be written -# If LS_NULLS is set, then LS_VALIDATE is not checked -# Example: LS_VALIDATE = FALSE - -# Environment name: COB_MF_FILES -# Parameter name: mf_files -# Purpose: Declares that all files in the program should follow -# Micro Focus format -# Type: boolean -# Default: false -# Example: MF_FILES = TRUE - -# Environment name: COB_MF_LS_NULLS -# Parameter name: mf_ls_nulls -# Purpose: Defines for Micro Focus compatible LINE SEQUENTIAL files -# what to do with data which is not DISPLAY type. -# This could happen if a LINE SEQUENTIAL record has -# BINARY/COMP data fields in it. -# Type: boolean -# Default: true -# Note: The TRUE setting will handle files that contain COMP data -# in a similar manner to the method used by Micro Focus COBOL -# Example: LS_NULLS = TRUE - -# Environment name: COB_MF_LS_SPLIT -# Parameter name: mf_ls_split -# Purpose: Defines for Micro Focus compatible LINE SEQUENTIAL files what -# to do when a record is longer than the program handles. -# If 'mf_ls_split=true' then -# the data is returned as multiple records -# Type: boolean -# Default: true -# Example: MF_LS_SPLIT = FALSE - -# Example: LS_SPLIT = TRUE -# Environment name: COB_MF_LS_VALIDATE -# Parameter name: mf_ls_validate -# Purpose: Defines for Micro Focus compatible LINE SEQUENTIAL files -# that the data should be validated. -# If any record has non-DISPLAY characters then -# an error status of 34 is returned -# Type: boolean -# Default: false -# Note: The TRUE setting does data validation -# The FALSE setting lets non-DISPLAY characters be written -# If MF_LS_NULLS is set, then MF_LS_VALIDATE is not checked -# Example: MF_LS_VALIDATE = FALSE - -# Environment name: COB_SHARE_MODE -# Parameter name: share_mode -# Purpose: Defines what file sharing option should be used -# Type: -- choice of values --- -# none - nothing overrides application code -# read - files opened as SHARE READ ONLY -# all - files opened as SHARE ALL OTHERS -# no - files opened as SHARE NO OTHERS -# Default: none -# Example: share_mode = ALL - -# Environment name: COB_RETRY_MODE -# Parameter name: retry_mode -# Purpose: Defines what I/O retry sharing option should be used -# Type: --- choice of values --- -# none - nothing overrides application code -# never - I/O is never retried -# forever - I/O will be retried until success -# Default: none -# Example: retry_mode = never - -# Environment name: COB_RETRY_TIMES -# Parameter name: retry_times -# Purpose: Defines how many times I/O should be retried -# Type: integer -# Default: 0 -# Example: retry_times = 10 - -# Environment name: COB_RETRY_SECONDS -# Parameter name: retry_seconds -# Purpose: Defines how many seconds I/O should be retried -# Type: integer -# Default: 0 -# Example: retry_seconds = 6 - -# Environment name: COB_KEYCHECK -# Parameter name: keycheck -# Purpose: Must INDEXED file keys match COBOL SELECT exactly -# Type: boolean -# Default: true -# Example: keycheck = off - -# Environment name: COB_SYNC -# Parameter name: sync -# Purpose: Should the file be synced to disk after each write/update -# Type: boolean -# Default: false -# Example: SYNC: TRUE - -# Environment name: COB_SORT_MEMORY -# Parameter name: sort_memory -# Purpose: Defines how much RAM to assign for sorting data -# if this size is exceeded the SORT will be done -# on disk instead of memory -# Type: size but must be more than 1M -# Default: 128M -# Example: SORT_MEMORY 64M - -# Environment name: COB_SORT_CHUNK -# Parameter name: sort_chunk -# Purpose: Defines how much RAM to assign for sorting data in chunks -# Type: size but must be within 128K and 16M -# Default: 256K -# Example: SORT_CHUNK 1M - -# -## Screen I/O -# - -# Environment name: COB_BELL -# Parameter name: bell -# Purpose: Defines how a request for the screen to beep is handled -# Type: FLASH, SPEAKER, FALSE, BEEP -# Default: BEEP -# Example: BELL SPEAKER - -# Environment name: COB_REDIRECT_DISPLAY -# Parameter name: redirect_display -# Purpose: Defines if DISPLAY output should be sent to 'stderr' -# Type: boolean -# Default: false -# Example: redirect_display Yes - -# Environment name: COB_SCREEN_ESC -# Parameter name: screen_esc -# Purpose: Enable handling of ESC key during ACCEPT -# Type: boolean -# Default: false -# Note: is only evaluated if COB_SCREEN_EXCEPTIONS is active -# Example: screen_esc Yes - -# Environment name: COB_SCREEN_EXCEPTIONS -# Parameter name: screen_exceptions -# Purpose: enable exceptions for function keys during ACCEPT -# Type: boolean -# Default: false -# Example: screen_exceptions Yes - -# Environment name: COB_TIMEOUT_SCALE -# Parameter name: timeout_scale -# Purpose: specify translation in milliseconds for ACCEPT clauses -# BEFORE TIME value / AFTER TIMEOUT -# Type: integer -# 0 means 1000 (Micro Focus COBOL compatible), 1 means 100 -# (ACUCOBOL compatible), 2 means 10, 3 means 1 -# Default: 0 -# Note: the minimum and possible maximum value depend on the -# screenio library used -# Example: timeout_scale 3 - -# Environment name: COB_INSERT_MODE -# Parameter name: insert_mode -# Purpose: specify default insert mode for ACCEPT; 0=off, 1=on -# Type: boolean -# Default: false -# Note: also sets the cursor type (if available) -# Example: insert_mode Y - -# Environment name: COB_MOUSE_FLAGS -# Parameter name: mouse_flags -# Purpose: specify which mouse events will be sent as function key -# to the application during ACCEPT and how they will be -# handled -# Type: int (by bits) -# Default: 1 -# Note: 0 disables the mouse cursor, any other value enables it, -# any value containing 1 will enable internal handling (click -# to position, double-click to enter). -# See copy/screenio.cpy for list of events and their values. -# Alias: MOUSE_FLAGS -# Example: 11 (enable internal handling => 1, left press => 2, -# double-click => 8; 1+2+8=11) - -# Environment name: COB_MOUSE_INTERVAL -# Parameter name: mouse_interval -# Purpose: specifies the maximum time (in thousands of a second) -# that can elapse between press and release events for them -# to be recognized as a click. -# Type: int (0 - 166) -# Default: 100 -# Note: 0 disables the click resolution (instead press + release -# are recognized), also disables positioning by mouse click - -# Environment name: COB_DISPLAY_PRINT_PIPE -# Parameter name: display_print_pipe -# Purpose: Defines command line used for sending output of -# DISPLAY UPON PRINTER to (via pipe) -# This is very similar to Micro Focus COBPRINTER -# Note: Each executed DISPLAY UPON PRINTER statement causes a -# new invocation of command-line (= new process start). -# Each invocation receives the data referenced in -# the DISPLAY statement and is followed by an -# end-of-file condition. -# COB_DISPLAY_PRINT_FILE, if set, takes precedence -# over COB_DISPLAY_PRINT_PIPE. -# Alias: COBPRINTER -# Type: string -# Default: not set -# Example: print 'cat >>/tmp/myprt.log' - -# Environment name: COB_DISPLAY_PRINT_FILE -# Parameter name: display_print_file -# Purpose: Defines file to be appended to by DISPLAY UPON PRINTER -# Note: Each DISPLAY UPON PRINTER opens, appends and closes the file. -# Type: string : $$ is replaced by process id -# Default: not set -# Example: display_printer '/tmp/myprt.log' - -# Environment name: COB_DISPLAY_PUNCH_FILE -# Parameter name: display_punch_file -# Purpose: Defines file to be created on first -# DISPLAY UPON SYSPUNCH/SYSPCH -# Note: The file will be only be closed on runtime exit. -# Type: string : $$ is replaced by process id -# Default: not set -# Example: display_punch './punch_$$.out' - -# Environment name: COB_LEGACY -# Parameter name: legacy -# Purpose: keep behavior of former runtime versions, currently only -# for setting screen attributes for non input fields -# Type: boolean -# Default: not set -# Example: legacy true - -# Environment name: COB_EXIT_WAIT -# Parameter name: exit_wait -# Purpose: to wait on main program exit if an extended screenio -# DISPLAY was issued without an ACCEPT following -# Type: boolean -# Default: true -# Example: COB_EXIT_WAIT off - -# Environment name: COB_EXIT_MSG -# Parameter name: exit_msg -# Purpose: string to display if COB_EXIT_WAIT is processed, set to '' -# if no actual display but an ACCEPT should be done -# Type: string -# Default: 'end of program, please press a key to exit' (localized) -# Example: COB_EXIT_MSG '' - -# -## Report I/O -# - -# Environment name: COB_COL_JUST_LRC -# Parameter name: col_just_lrc -# Purpose: If true, then COLUMN defined as LEFT, RIGHT or CENTER -# will have the data justified within the field limits -# If false, then the data is just copied into the column as is -# Type: boolean -# Default: TRUE -# Example: col_just_lrc True - - -# -## File I/O Environment Variables and/or dictionary file -# -# Before a file is opened a check is done for environment variables that -# may define various attributes of the file -# First a check is made for attributes for files of the same ORGANIZATION -# IX_OPTIONS for INDEXED, SQ_OPTIONS for SEQUENTIAL, RL_OPTIONS for RELATIVE -# LS_OPTIONS for LINE SEQUENTIAL, LA_OPTIONS for LINE ADVANCING SEQUENTIAL -# If none of these are present, it then checks for IO_OPTIONS -# -# Then an additional check is done for IO_asgnmame where 'asgname' was -# the ASSIGN EXTERNAL name used in the program -# -# The environment variable (or dictionary file) may contain any of the -# following keywords, separated by spaces and/or commas -# -# You can specify just the keyword and it is assumed to mean set to true, -# or no-keyword (or no_keyword or nokeyword) which means set to false, -# or keyword=true or keyword=false. The valid keywords are: -# Keyword Meaning -# ========= ====================================================== -# type=xx Set file organization where 'xx' is one of -# IX = INDEXED, SQ = SEQUENTIAL, RL = RELATIVE -# LS = LINE SEQUENTIAL, LA = LINE ADVANCING -# mf Set file to Micro Focus compatible format -# gc Set to original GNU Cobol default format -# recsz The size for fixed size record file -# maxsz Maximum record size for variable length records -# minsz Minimum record size for variable length records -# ls_nulls Do NUL insertion before characters less than a SPACE, -# Default: false -# ls_validate Validate data for LINE Sequential Files, Default: true -# crlf Lines end with CR LF (Windows format for text files) -# lf Lines end with LF (Unix format for text files) -# sync Sync all writes to disk -# B32 Use 32-bit Big-Endian format 'int' as record length -# L32 Use 32-bit Little-Endian format 'int' as record length -# B64 Use 64-bit Big-Endian format 'int' or 'size_t' as record length -# L64 Use 64-bit Little-Endian format 'int' or 'size_t' as record length -# trace Enable I/O trace when program execution tracing is enabled -# stats Write I/O statistic information on file close -# retry_times Default number of times to retry I/O -# retry_seconds Number of seconds between I/O retry attempts -# retry_forever Retry I/O forever -# retry_never Never retry I/O operations -# ignore_lock Ignore record locks -# advancing_lock Advance to the next record if lock condition -# share_all Share file with ALL others -# share_read Share file for READ only -# share_no Share file with NO others -# ---- For INDEXED files ----- -# format=ixhandler INDEXED file format: CISAM,DISAM,VBISAM,BDB,LMDB,OCI,ODBC -# format=auto INDEXED file format is determined by inspecting the file -# nkeys=n number of indexes -# key1=(loc:len) loc (zero relative) of key, len of key -# key2=(loc:len,loc:len ...) define composite index -# dupn=Y index allows dups -# ---- For INDEXED BDB files ----- -# big_endian Set internal 'int' byte order to BIG ENDIAN -# little_endian Set internal 'int' byte order to LITTLE ENDIAN -# diff -Nru gnucobol-4.0~early~20200606/config/runtime_empty.cfg gnucobol-5/config/runtime_empty.cfg --- gnucobol-4.0~early~20200606/config/runtime_empty.cfg 2020-06-06 20:52:02.000000000 +0000 +++ gnucobol-5/config/runtime_empty.cfg 1970-01-01 00:00:00.000000000 +0000 @@ -1 +0,0 @@ - diff -Nru gnucobol-4.0~early~20200606/config/xopen.conf gnucobol-5/config/xopen.conf --- gnucobol-4.0~early~20200606/config/xopen.conf 2020-06-06 20:52:02.000000000 +0000 +++ gnucobol-5/config/xopen.conf 1970-01-01 00:00:00.000000000 +0000 @@ -1,311 +0,0 @@ -# GnuCOBOL compiler configuration -# -# Copyright (C) 2001-2012, 2014-2020 Free Software Foundation, Inc. -# Written by Keisuke Nishida, Roger While, Simon Sobisch, Edward Hart, -# Ron Norman -# -# This file is part of GnuCOBOL. -# -# The GnuCOBOL compiler is free software: you can redistribute it -# and/or modify it under the terms of the GNU General Public License -# as published by the Free Software Foundation, either version 3 of the -# License, or (at your option) any later version. -# -# GnuCOBOL is distributed in the hope that it will be useful, -# but WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -# GNU General Public License for more details. -# -# You should have received a copy of the GNU General Public License -# along with GnuCOBOL. If not, see . - - -# Value: any string -name: "X/Open COBOL" - -# Note: the X/Open CAE Specification is available at -# https://www2.opengroup.org/ogsys/catalog/c192 - -# Value: enum -standard-define 7 # uses COBOL85 currently -# CB_STD_OC = 0, -# CB_STD_MF, -# CB_STD_IBM, -# CB_STD_MVS, -# CB_STD_BS2000, -# CB_STD_ACU, -# CB_STD_85, -# CB_STD_2002, -# CB_STD_2014 - -# Value: int -tab-width: 8 -text-column: 72 -word-length: 30 -literal-length: 160 -numeric-literal-length: 18 -pic-length: 30 - -# Default assign type -# Value: 'dynamic', 'external' -assign-clause: dynamic # TO-DO: Verify! - -# If yes, file names are resolved at run time using -# environment variables. -# For example, given ASSIGN TO "DATAFILE", the file name will be -# 1. the value of environment variable 'DD_DATAFILE' or -# 2. the value of environment variable 'dd_DATAFILE' or -# 3. the value of environment variable 'DATAFILE' or -# 4. the literal "DATAFILE" -# If no, the value of the assign clause is the file name. -# -filename-mapping: yes - -# Alternate formatting of numeric fields -pretty-display: yes - -# Allow complex OCCURS DEPENDING ON -complex-odo: no - -# Allow REDEFINES to other than last equal level number -indirect-redefines: no - -# Binary byte size - defines the allocated bytes according to PIC -# Value: signed unsigned bytes -# ------ -------- ----- -# '2-4-8' 1 - 4 same 2 -# 5 - 9 same 4 -# 10 - 18 same 8 -# -# '1-2-4-8' 1 - 2 same 1 -# 3 - 4 same 2 -# 5 - 9 same 4 -# 10 - 18 same 8 -# -# '1--8' 1 - 2 1 - 2 1 -# 3 - 4 3 - 4 2 -# 5 - 6 5 - 7 3 -# 7 - 9 8 - 9 4 -# 10 - 11 10 - 12 5 -# 12 - 14 13 - 14 6 -# 15 - 16 15 - 16 7 -# 17 - 18 17 - 18 8 -# -binary-size: 1-2-4-8 - -# Numeric truncation according to ANSI -binary-truncate: yes - -# Binary byte order -# Value: 'native', 'big-endian' -binary-byteorder: big-endian - -# Allow larger REDEFINES items -larger-redefines-ok: no - -# Allow certain syntax variations (eg. REDEFINES position) -relax-syntax-checks: no - -# Perform type OSVS - If yes, the exit point of any currently -# executing perform is recognized if reached. -perform-osvs: no - -# Compute intermediate decimal results like IBM OSVS -arithmetic-osvs: no - -# MOVE like IBM (mvc); left to right, byte by byte -move-ibm: no - -# If yes, linkage-section items remain allocated -# between invocations. -sticky-linkage: no - -# If yes, allow non-matching level numbers -relax-level-hierarchy: no - -# If yes, evaluate constant expressions at compile time -constant-folding: yes - -# Allow Hex 'F' for NUMERIC test of signed PACKED DECIMAL field -hostsign: no - -# If yes, set WITH UPDATE clause as default for ACCEPT dest-item, -# except if WITH NO UPDATE clause is used -accept-update: no - -# If yes, set WITH AUTO clause as default for ACCEPT dest-item, -# except if WITH TAB clause is used -accept-auto: no - -# If yes, DISPLAYs and ACCEPTs are, by default, done on the CRT (i.e., using -# curses). -console-is-crt: no - -# If yes, allow redefinition of the current program's name. This prevents its -# use in a prototype-format CALL/CANCEL statement. -program-name-redefinition: yes - -# If yes, NO ECHO/NO-ECHO/OFF is the same as SECURE (hiding input with -# asterisks, not spaces). -no-echo-means-secure: no - -# If yes, the first item in a field screen ACCEPT/DISPLAY (e.g. DISPLAY x UPON -# CRT) is located after the previous ACCEPT/DISPLAY (as though LINE 0 COL 0 had -# been specified). -line-col-zero-default: no - -# If yes, then REPORT, COLUMN may have any of PLUS num, + num, or +num -# to define a relative column position -report-column-plus: no - -# If yes, DISPLAY SPACES acts as ERASE EOS, DISPLAY X"01" acts as ERASE EOL, -# DISPLAY X"02" acts as BLANK SCREEEN and DISPLAY X"07" acts as BELL. Note -# DISPLAY LOW-VALUE is excluded from this; it will always just position the -# cursor. -display-special-fig-consts: no - -# If yes, COMP-1 is a signed 16-bit integer and any PICTURE clause is ignored. -binary-comp-1: no - -# auto-adjust to zero like MicroFocus does -move-non-numeric-lit-to-numeric-is-zero: no - -# If yes, implicitly define a variable for an ASSIGN DYNAMIC which does not -# match an existing data item. -implicit-assign-dynamic-var: no - -# What rules to apply to SCREEN SECTION items clauses -screen-section-rules: xopen - -# Dialect features -# Value: 'ok', 'warning', 'archaic', 'obsolete', 'skip', 'ignore', 'error', -# 'unconformable' - -# note: X/Open explicit excludes the following modules communication, debug, report writer, segmentation -# it specifies entries that must be included in a conforming X/Open implementation -# that should not be used in a conforming X/Open COBOL source program, -# mainly the obsolete items and some portability items as SYNCH - -alter-statement: warning # should not be used ... -comment-paragraphs: warning # should not be used ... -call-overflow: ok -data-records-clause: warning # should not be used ... -debugging-mode: ok -use-for-debugging: unconformable # complete module removed -listing-statements: skip # may be a user-defined word -title-statement: skip # may be a user-defined word -entry-statement: unconformable -goto-statement-without-name: warning # should not be used ... -label-records-clause: warning # should not be used ... -memory-size-clause: warning # should not be used ... -move-noninteger-to-alphanumeric: error -move-figurative-constant-to-numeric: archaic # not verified yet -move-figurative-space-to-numeric: error -move-figurative-quote-to-numeric: archaic # not verified yet -multiple-file-tape-clause: warning # should not be used ... -next-sentence-phrase: archaic -odo-without-to: unconformable -padding-character-clause: ok -section-segments: unconformable # complete module removed -# reportwriter and communication: complete modules removed -stop-literal-statement: warning # should not be used ... -stop-identifier-statement: unconformable -same-as-clause: unconformable -synchronized-clause: warning # should not be used ... will prevent portability -sync-left-right: ok -special-names-clause: error -top-level-occurs-clause: skip -value-of-clause: warning # should not be used ... -numeric-boolean: unconformable -hexadecimal-boolean: unconformable -national-literals: ok -hexadecimal-national-literals: unconformable -national-character-literals: unconformable -acu-literals: unconformable -hp-octal-literals: unconformable -word-continuation: obsolete # even for literals (as it added concatenation of literals by &)! -occurs-max-length-without-subscript: no -length-in-data-division: yes -depending-on-not-fixed: warning -not-exception-before-exception: unconformable -accept-display-extensions: unconformable -renames-uncommon-levels: unconformable -symbolic-constant: unconformable -constant-78: unconformable -constant-01: unconformable -perform-varying-without-by: unconformable -reference-out-of-declaratives: error # not verified yet -reference-bounds-check: error -program-prototypes: unconformable -call-convention-mnemonic: unconformable -call-convention-linkage: unconformable -numeric-value-for-edited-item: error -incorrect-conf-sec-order: error -define-constant-directive: error -free-redefines-position: unconformable -records-mismatch-record-clause: error # actually the complete clause is excluded from X/Open... -record-delimiter: warning # should not be used ... -sequential-delimiters: ok -record-delim-with-fixed-recs: unconformable -missing-statement: error -zero-length-literals: unconformable -xml-generate-extra-phrases: unconformable -continue-after: unconformable -goto-entry: unconformable -binary-sync-clause: ignore -nonnumeric-with-numeric-group-usage: error -assign-variable: ok -assign-using-variable: unconformable -assign-ext-dyn: unconformable -assign-disk-from: unconformable -align-record: 0 -align-opt: no - -# obsolete in COBOL85 and currently not available as dialect features: -# 1: All literal with numeric or numeric edited item -# 2: RERUN clause -# 3: KEY phrase of the DISABLE and ENABLE statements -# 4: ENTER statement -# 5: REVERSED phrase of the OPEN statement - - -# use fixed word list, synonyms and exceptions specified there -reserved-words: COBOL85 - -# words that were added to COBOL85: -reserved: AUTO -reserved: AUTOMATIC -reserved: BACKGROUND-COLOR -reserved: BELL -reserved: BLINK -reserved: COMPUTATIONAL-3=COMP-3 -reserved: COMPUTATIONAL-5=COMP-5 -reserved: CRT -reserved: CURSOR -reserved: LOWLIGHT -reserved: END-ACCEPT -reserved: END-DISPLAY -reserved: EOL -reserved: EOS -reserved: ERASE -reserved: EXCLUSIVE -reserved: FOREGROUND-COLOR -reserved: FULL -reserved: HIGHLIGHT -reserved: MANUAL -reserved: REQUIRED -reserved: REVERSE-VIDEO -reserved: SCREEN -reserved: SECURE -reserved: UNDERLINE -reserved: UNLOCK - - -# registers that were added to COBOL85: -register: RETURN-CODE -# registers that were removed from COBOL 85 -# (as their modules debugging and reportwriter are removed) -not-register: DEBUG-ITEM -#not-register: LINAGE-COUNTER # not yet handled as register in GnuCOBOL -#not-register: LINE-COUNTER # not yet handled as register in GnuCOBOL -#not-register: PAGE-COUNTER # not yet handled as register in GnuCOBOL diff -Nru gnucobol-4.0~early~20200606/config.h.in gnucobol-5/config.h.in --- gnucobol-4.0~early~20200606/config.h.in 2020-06-06 20:56:36.000000000 +0000 +++ gnucobol-5/config.h.in 1970-01-01 00:00:00.000000000 +0000 @@ -1,496 +0,0 @@ -/* config.h.in. Generated from configure.ac by autoheader. */ - -/* Define if building universal (internal helper macro) */ -#undef AC_APPLE_UNIVERSAL_BUILD - -/* long int is 32 bits */ -#undef COB_32_BIT_LONG - -/* Pointers are longer than 32 bits */ -#undef COB_64_BIT_POINTER - -/* Compilation of computed gotos works */ -#undef COB_COMPUTED_GOTO - -/* Enable internal logging (Developers only!) */ -#undef COB_DEBUG_LOG - -/* Executable extension */ -#undef COB_EXE_EXT - -/* Enable experimental code (Developers only!) */ -#undef COB_EXPERIMENTAL - -/* Compile/link option for exporting symbols */ -#undef COB_EXPORT_DYN - -/* Keyword for inline */ -#undef COB_KEYWORD_INLINE - -/* long int is long long */ -#undef COB_LI_IS_LL - -/* Module extension */ -#undef COB_MODULE_EXT - -/* Can not dlopen self */ -#undef COB_NO_SELFOPEN - -/* Object extension */ -#undef COB_OBJECT_EXT - -/* Enable minimum parameter check for system libraries */ -#undef COB_PARAM_CHECK - -/* Compile/link option for PIC code */ -#undef COB_PIC_FLAGS - -/* Compile/link option for shared code */ -#undef COB_SHARED_OPT - -/* Strip command */ -#undef COB_STRIP_CMD - -/* Enable extra checks within the compiler (Developers only!) */ -#undef COB_TREE_DEBUG - -/* Define to 1 if translation of program messages to the user's native - language is requested. */ -#undef ENABLE_NLS - -/* Define to 1 if you have the `atol' function. */ -#undef HAVE_ATOL - -/* Define to 1 if you have the `atoll' function. */ -#undef HAVE_ATOLL - -/* Has __attribute__((aligned)) */ -#undef HAVE_ATTRIBUTE_ALIGNED - -/* Define to 1 if you have the `canonicalize_file_name' function. */ -#undef HAVE_CANONICALIZE_FILE_NAME - -/* Define to 1 if you have the Mac OS X function CFLocaleCopyCurrent in the - CoreFoundation framework. */ -#undef HAVE_CFLOCALECOPYCURRENT - -/* Define to 1 if you have the Mac OS X function CFPreferencesCopyAppValue in - the CoreFoundation framework. */ -#undef HAVE_CFPREFERENCESCOPYAPPVALUE - -/* Define to 1 if you have the header file. */ -#undef HAVE_CJSON_CJSON_H - -/* Define to 1 if you have the header file. */ -#undef HAVE_CJSON_H - -/* Has clock_gettime function and CLOCK_REALTIME */ -#undef HAVE_CLOCK_GETTIME - -/* curses has color_set function */ -#undef HAVE_COLOR_SET - -/* ncurses has _nc_freeall function */ -#undef HAVE_CURSES_FREEALL - -/* Define to 1 if you have the header file. */ -#undef HAVE_CURSES_H - -/* Define to 1 if you have the header file. */ -#undef HAVE_DB_H - -/* Define if the GNU dcgettext() function is already present or preinstalled. - */ -#undef HAVE_DCGETTEXT - -/* curses has define_key function */ -#undef HAVE_DEFINE_KEY - -/* Has designated initializers */ -#undef HAVE_DESIGNATED_INITS - -/* Define to 1 if you have the header file. */ -#undef HAVE_DISAM_H - -/* Has dladdr function */ -#undef HAVE_DLADDR - -/* Define to 1 if you have the header file. */ -#undef HAVE_DLFCN_H - -/* Define to 1 if you don't have `vprintf' but do have `_doprnt.' */ -#undef HAVE_DOPRNT - -/* Define to 1 if you have the `fcntl' function. */ -#undef HAVE_FCNTL - -/* Define to 1 if you have the header file. */ -#undef HAVE_FCNTL_H - -/* Define to 1 if you have the `fdatasync' function. */ -#undef HAVE_FDATASYNC - -/* Declaration of finite function in ieeefp.h instead of math.h */ -#undef HAVE_FINITE_IEEEFP_H - -/* Define to 1 if you have the `getexecname' function. */ -#undef HAVE_GETEXECNAME - -/* Define if the GNU gettext() function is already present or preinstalled. */ -#undef HAVE_GETTEXT - -/* Define to 1 if you have the `gettimeofday' function. */ -#undef HAVE_GETTIMEOFDAY - -/* Define to 1 if you have the header file. */ -#undef HAVE_GMP_H - -/* curses has has_mouse function */ -#undef HAVE_HAS_MOUSE - -/* Define if you have the iconv() function and it works. */ -#undef HAVE_ICONV - -/* Define to 1 if you have the header file. */ -#undef HAVE_INTTYPES_H - -/* Define to 1 if you have the header file. */ -#undef HAVE_ISAM_H - -/* Has isfinite function */ -#undef HAVE_ISFINITE - -/* Define if you have and nl_langinfo(CODESET). */ -#undef HAVE_LANGINFO_CODESET - -/* Define to 1 if you have the `curses' library (-lcurses). */ -#undef HAVE_LIBCURSES - -/* Define to 1 if you have the `ncurses' library (-lncurses). */ -#undef HAVE_LIBNCURSES - -/* Define to 1 if you have the `ncursesw' library (-lncursesw). */ -#undef HAVE_LIBNCURSESW - -/* Define to 1 if you have the `pdcurses' library (-lpdcurses). */ -#undef HAVE_LIBPDCURSES - -/* Define to 1 if you have the `posix4' library (-lposix4). */ -#undef HAVE_LIBPOSIX4 - -/* Define to 1 if you have the `rt' library (-lrt). */ -#undef HAVE_LIBRT - -/* Define to 1 if you have the header file. */ -#undef HAVE_LIBXML_URI_H - -/* Define to 1 if you have the header file. */ -#undef HAVE_LIBXML_XMLVERSION_H - -/* Define to 1 if you have the header file. */ -#undef HAVE_LIBXML_XMLWRITER_H - -/* Define to 1 if you have the `localeconv' function. */ -#undef HAVE_LOCALECONV - -/* Define to 1 if you have the header file. */ -#undef HAVE_LOCALE_H - -/* Define to 1 if you have the header file. */ -#undef HAVE_LTDL_H - -/* Define to 1 if you have the header file. */ -#undef HAVE_MALLOC_H - -/* Define to 1 if you have the `memmove' function. */ -#undef HAVE_MEMMOVE - -/* Define to 1 if you have the header file. */ -#undef HAVE_MEMORY_H - -/* Define to 1 if you have the `memset' function. */ -#undef HAVE_MEMSET - -/* curses has mouseinterval function */ -#undef HAVE_MOUSEINTERVAL - -/* Do we have mp_get_memory_functions in gmp */ -#undef HAVE_MP_GET_MEMORY_FUNCTIONS - -/* Has nanosleep function */ -#undef HAVE_NANO_SLEEP - -/* Define to 1 if you have the header file. */ -#undef HAVE_NCURSESW_CURSES_H - -/* Define to 1 if you have the header file. */ -#undef HAVE_NCURSESW_NCURSES_H - -/* Define to 1 if you have the header file. */ -#undef HAVE_NCURSES_H - -/* Define to 1 if you have the header file. */ -#undef HAVE_NCURSES_NCURSES_H - -/* Define to 1 if you have the header file. */ -#undef HAVE_OCI_H - -/* Define to 1 if you have the header file. */ -#undef HAVE_PDCURSES_H - -/* Define to 1 if you have the `popen' function. */ -#undef HAVE_POPEN - -/* Define to 1 if you have the `raise' function. */ -#undef HAVE_RAISE - -/* Define to 1 if you have the `readlink' function. */ -#undef HAVE_READLINK - -/* Define to 1 if you have the `realpath' function. */ -#undef HAVE_REALPATH - -/* Define to 1 if you have the `setenv' function. */ -#undef HAVE_SETENV - -/* Define to 1 if you have the `setlocale' function. */ -#undef HAVE_SETLOCALE - -/* Define to 1 if you have the `sigaction' function. */ -#undef HAVE_SIGACTION - -/* Define to 1 if you have the header file. */ -#undef HAVE_SIGNAL_H - -/* Define to 1 if the system has the type `sig_atomic_t'. */ -#undef HAVE_SIG_ATOMIC_T - -/* Define to 1 if you have the header file. */ -#undef HAVE_SQLEXT_H - -/* Define to 1 if you have the header file. */ -#undef HAVE_SQL_H - -/* Define to 1 if you have the header file. */ -#undef HAVE_STDDEF_H - -/* Define to 1 if you have the header file. */ -#undef HAVE_STDINT_H - -/* Define to 1 if you have the header file. */ -#undef HAVE_STDLIB_H - -/* Define to 1 if you have the `strcasecmp' function. */ -#undef HAVE_STRCASECMP - -/* Define to 1 if you have the `strchr' function. */ -#undef HAVE_STRCHR - -/* Define to 1 if you have the `strcoll' function. */ -#undef HAVE_STRCOLL - -/* Define to 1 if you have the `strdup' function. */ -#undef HAVE_STRDUP - -/* Define to 1 if you have the `strerror' function. */ -#undef HAVE_STRERROR - -/* Define to 1 if you have the header file. */ -#undef HAVE_STRINGS_H - -/* Define to 1 if you have the header file. */ -#undef HAVE_STRING_H - -/* Define to 1 if you have the `strrchr' function. */ -#undef HAVE_STRRCHR - -/* Define to 1 if you have the `strstr' function. */ -#undef HAVE_STRSTR - -/* Define to 1 if you have the `strtol' function. */ -#undef HAVE_STRTOL - -/* Define to 1 if you have the `strtoll' function. */ -#undef HAVE_STRTOLL - -/* Define to 1 if you have the header file. */ -#undef HAVE_SYS_STAT_H - -/* Define to 1 if you have the header file. */ -#undef HAVE_SYS_SYSMACROS_H - -/* Define to 1 if you have the header file. */ -#undef HAVE_SYS_TIME_H - -/* Define to 1 if you have the header file. */ -#undef HAVE_SYS_TYPES_H - -/* Define to 1 if you have the header file. */ -#undef HAVE_SYS_WAIT_H - -/* Has timezone variable */ -#undef HAVE_TIMEZONE - -/* Define to 1 if you have the header file. */ -#undef HAVE_UNISTD_H - -/* ncurses has use_legacy_coding function */ -#undef HAVE_USE_LEGACY_CODING - -/* Define to 1 if you have the header file. */ -#undef HAVE_VBISAM_H - -/* Define to 1 if you have the `vprintf' function. */ -#undef HAVE_VPRINTF - -/* Define to 1 if you have the header file. */ -#undef HAVE_WCHAR_H - -/* Define to the sub-directory where libtool stores uninstalled libraries. */ -#undef LT_OBJDIR - -/* Define maximum parameters for CALL */ -#undef MAX_CALL_FIELD_PARAMS - -/* Name of package */ -#undef PACKAGE - -/* Define to the address where bug reports for this package should be sent. */ -#undef PACKAGE_BUGREPORT - -/* Define to the full name of this package. */ -#undef PACKAGE_NAME - -/* Define to the full name and version of this package. */ -#undef PACKAGE_STRING - -/* Define to the one symbol short name of this package. */ -#undef PACKAGE_TARNAME - -/* Define to the home page for this package. */ -#undef PACKAGE_URL - -/* Define to the version of this package. */ -#undef PACKAGE_VERSION - -/* Define a patch level (numeric, max. 8 digits) */ -#undef PATCH_LEVEL - -/* Define to 1 if you have the ANSI C header files. */ -#undef STDC_HEADERS - -/* Define to 1 if your declares `struct tm'. */ -#undef TM_IN_SYS_TIME - -/* Use system dynamic loader */ -#undef USE_LIBDL - -/* Enable extensions on AIX 3, Interix. */ -#ifndef _ALL_SOURCE -# undef _ALL_SOURCE -#endif -/* Enable GNU extensions on systems that have them. */ -#ifndef _GNU_SOURCE -# undef _GNU_SOURCE -#endif -/* Enable threading extensions on Solaris. */ -#ifndef _POSIX_PTHREAD_SEMANTICS -# undef _POSIX_PTHREAD_SEMANTICS -#endif -/* Enable extensions on HP NonStop. */ -#ifndef _TANDEM_SOURCE -# undef _TANDEM_SOURCE -#endif -/* Enable general extensions on Solaris. */ -#ifndef __EXTENSIONS__ -# undef __EXTENSIONS__ -#endif - - -/* Version number of package */ -#undef VERSION - -/* Use CISAM as INDEXED handler */ -#undef WITH_CISAM - -/* Use cJSON as JSON handler */ -#undef WITH_CJSON - -/* curses library for extended SCREEN I/O */ -#undef WITH_CURSES - -/* Use Berkeley DB library as INDEXED handler */ -#undef WITH_DB - -/* Use DISAM as INDEXED handler */ -#undef WITH_DISAM - -/* Default INDEXED file handler */ -#undef WITH_INDEXED - -/* Compile with obsolete external INDEXED handler */ -#undef WITH_INDEX_EXTFH - -/* Default INDEXED file handler */ -#undef WITH_IXDFLT - -/* Use Lightning Memory-Mapped Database as INDEXED handler */ -#undef WITH_LMDB - -/* Using more than 1 of C/D/VB-ISAM */ -#undef WITH_MULTI_ISAM - -/* Use OCI for INDEXED file handler */ -#undef WITH_OCI - -/* Use ODBC for INDEXED file handler */ -#undef WITH_ODBC - -/* Compile with obsolete external SEQ/RAN handler */ -#undef WITH_SEQRA_EXTFH - -/* Define variable sequential file format */ -#undef WITH_VARSEQ - -/* Use VBISAM as INDEXED handler */ -#undef WITH_VBISAM - -/* Use libxml2 as XML handler */ -#undef WITH_XML2 - -/* Define WORDS_BIGENDIAN to 1 if your processor stores words with the most - significant byte first (like Motorola and SPARC, unlike Intel). */ -#if defined AC_APPLE_UNIVERSAL_BUILD -# if defined __BIG_ENDIAN__ -# define WORDS_BIGENDIAN 1 -# endif -#else -# ifndef WORDS_BIGENDIAN -# undef WORDS_BIGENDIAN -# endif -#endif - -/* Define to 1 if `lex' declares `yytext' as a `char *' by default, not a - `char[]'. */ -#undef YYTEXT_POINTER - -/* Define to 1 if on MINIX. */ -#undef _MINIX - -/* Define to 2 if the system does not provide POSIX.1 features except with - this defined. */ -#undef _POSIX_1_SOURCE - -/* Define to 1 if you need to in order for `stat' and other things to work. */ -#undef _POSIX_SOURCE - -/* Define to 1 if on HPUX. */ -#ifndef _XOPEN_SOURCE_EXTENDED -# undef _XOPEN_SOURCE_EXTENDED -#endif - -/* Define to empty if `const' does not conform to ANSI C. */ -#undef const - -/* Define to `unsigned int' if does not define. */ -#undef size_t diff -Nru gnucobol-4.0~early~20200606/configure gnucobol-5/configure --- gnucobol-4.0~early~20200606/configure 2020-06-06 20:56:36.000000000 +0000 +++ gnucobol-5/configure 1970-01-01 00:00:00.000000000 +0000 @@ -1,23194 +0,0 @@ -#! /bin/sh -# From configure.ac GnuCOBOL snapshot Revision: 2248 . -# Guess values for system-dependent variables and create Makefiles. -# Generated by GNU Autoconf 2.69 for GnuCOBOL 4.0-early-dev. -# -# Report bugs to . -# -# -# Copyright (C) 1992-1996, 1998-2012 Free Software Foundation, Inc. -# -# -# This configure script is free software; the Free Software Foundation -# gives unlimited permission to copy, distribute and modify it. -## -------------------- ## -## M4sh Initialization. ## -## -------------------- ## - -# Be more Bourne compatible -DUALCASE=1; export DUALCASE # for MKS sh -if test -n "${ZSH_VERSION+set}" && (emulate sh) >/dev/null 2>&1; then : - emulate sh - NULLCMD=: - # Pre-4.2 versions of Zsh do word splitting on ${1+"$@"}, which - # is contrary to our usage. Disable this feature. - alias -g '${1+"$@"}'='"$@"' - setopt NO_GLOB_SUBST -else - case `(set -o) 2>/dev/null` in #( - *posix*) : - set -o posix ;; #( - *) : - ;; -esac -fi - - -as_nl=' -' -export as_nl -# Printing a long string crashes Solaris 7 /usr/bin/printf. -as_echo='\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\' -as_echo=$as_echo$as_echo$as_echo$as_echo$as_echo -as_echo=$as_echo$as_echo$as_echo$as_echo$as_echo$as_echo -# Prefer a ksh shell builtin over an external printf program on Solaris, -# but without wasting forks for bash or zsh. -if test -z "$BASH_VERSION$ZSH_VERSION" \ - && (test "X`print -r -- $as_echo`" = "X$as_echo") 2>/dev/null; then - as_echo='print -r --' - as_echo_n='print -rn --' -elif (test "X`printf %s $as_echo`" = "X$as_echo") 2>/dev/null; then - as_echo='printf %s\n' - as_echo_n='printf %s' -else - if test "X`(/usr/ucb/echo -n -n $as_echo) 2>/dev/null`" = "X-n $as_echo"; then - as_echo_body='eval /usr/ucb/echo -n "$1$as_nl"' - as_echo_n='/usr/ucb/echo -n' - else - as_echo_body='eval expr "X$1" : "X\\(.*\\)"' - as_echo_n_body='eval - arg=$1; - case $arg in #( - *"$as_nl"*) - expr "X$arg" : "X\\(.*\\)$as_nl"; - arg=`expr "X$arg" : ".*$as_nl\\(.*\\)"`;; - esac; - expr "X$arg" : "X\\(.*\\)" | tr -d "$as_nl" - ' - export as_echo_n_body - as_echo_n='sh -c $as_echo_n_body as_echo' - fi - export as_echo_body - as_echo='sh -c $as_echo_body as_echo' -fi - -# The user is always right. -if test "${PATH_SEPARATOR+set}" != set; then - PATH_SEPARATOR=: - (PATH='/bin;/bin'; FPATH=$PATH; sh -c :) >/dev/null 2>&1 && { - (PATH='/bin:/bin'; FPATH=$PATH; sh -c :) >/dev/null 2>&1 || - PATH_SEPARATOR=';' - } -fi - - -# IFS -# We need space, tab and new line, in precisely that order. Quoting is -# there to prevent editors from complaining about space-tab. -# (If _AS_PATH_WALK were called with IFS unset, it would disable word -# splitting by setting IFS to empty value.) -IFS=" "" $as_nl" - -# Find who we are. Look in the path if we contain no directory separator. -as_myself= -case $0 in #(( - *[\\/]* ) as_myself=$0 ;; - *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR -for as_dir in $PATH -do - IFS=$as_save_IFS - test -z "$as_dir" && as_dir=. - test -r "$as_dir/$0" && as_myself=$as_dir/$0 && break - done -IFS=$as_save_IFS - - ;; -esac -# We did not find ourselves, most probably we were run as `sh COMMAND' -# in which case we are not to be found in the path. -if test "x$as_myself" = x; then - as_myself=$0 -fi -if test ! -f "$as_myself"; then - $as_echo "$as_myself: error: cannot find myself; rerun with an absolute file name" >&2 - exit 1 -fi - -# Unset variables that we do not need and which cause bugs (e.g. in -# pre-3.0 UWIN ksh). But do not cause bugs in bash 2.01; the "|| exit 1" -# suppresses any "Segmentation fault" message there. '((' could -# trigger a bug in pdksh 5.2.14. -for as_var in BASH_ENV ENV MAIL MAILPATH -do eval test x\${$as_var+set} = xset \ - && ( (unset $as_var) || exit 1) >/dev/null 2>&1 && unset $as_var || : -done -PS1='$ ' -PS2='> ' -PS4='+ ' - -# NLS nuisances. -LC_ALL=C -export LC_ALL -LANGUAGE=C -export LANGUAGE - -# CDPATH. -(unset CDPATH) >/dev/null 2>&1 && unset CDPATH - -# Use a proper internal environment variable to ensure we don't fall - # into an infinite loop, continuously re-executing ourselves. - if test x"${_as_can_reexec}" != xno && test "x$CONFIG_SHELL" != x; then - _as_can_reexec=no; export _as_can_reexec; - # We cannot yet assume a decent shell, so we have to provide a -# neutralization value for shells without unset; and this also -# works around shells that cannot unset nonexistent variables. -# Preserve -v and -x to the replacement shell. -BASH_ENV=/dev/null -ENV=/dev/null -(unset BASH_ENV) >/dev/null 2>&1 && unset BASH_ENV ENV -case $- in # (((( - *v*x* | *x*v* ) as_opts=-vx ;; - *v* ) as_opts=-v ;; - *x* ) as_opts=-x ;; - * ) as_opts= ;; -esac -exec $CONFIG_SHELL $as_opts "$as_myself" ${1+"$@"} -# Admittedly, this is quite paranoid, since all the known shells bail -# out after a failed `exec'. -$as_echo "$0: could not re-execute with $CONFIG_SHELL" >&2 -as_fn_exit 255 - fi - # We don't want this to propagate to other subprocesses. - { _as_can_reexec=; unset _as_can_reexec;} -if test "x$CONFIG_SHELL" = x; then - as_bourne_compatible="if test -n \"\${ZSH_VERSION+set}\" && (emulate sh) >/dev/null 2>&1; then : - emulate sh - NULLCMD=: - # Pre-4.2 versions of Zsh do word splitting on \${1+\"\$@\"}, which - # is contrary to our usage. Disable this feature. - alias -g '\${1+\"\$@\"}'='\"\$@\"' - setopt NO_GLOB_SUBST -else - case \`(set -o) 2>/dev/null\` in #( - *posix*) : - set -o posix ;; #( - *) : - ;; -esac -fi -" - as_required="as_fn_return () { (exit \$1); } -as_fn_success () { as_fn_return 0; } -as_fn_failure () { as_fn_return 1; } -as_fn_ret_success () { return 0; } -as_fn_ret_failure () { return 1; } - -exitcode=0 -as_fn_success || { exitcode=1; echo as_fn_success failed.; } -as_fn_failure && { exitcode=1; echo as_fn_failure succeeded.; } -as_fn_ret_success || { exitcode=1; echo as_fn_ret_success failed.; } -as_fn_ret_failure && { exitcode=1; echo as_fn_ret_failure succeeded.; } -if ( set x; as_fn_ret_success y && test x = \"\$1\" ); then : - -else - exitcode=1; echo positional parameters were not saved. -fi -test x\$exitcode = x0 || exit 1 -test -x / || exit 1" - as_suggested=" as_lineno_1=";as_suggested=$as_suggested$LINENO;as_suggested=$as_suggested" as_lineno_1a=\$LINENO - as_lineno_2=";as_suggested=$as_suggested$LINENO;as_suggested=$as_suggested" as_lineno_2a=\$LINENO - eval 'test \"x\$as_lineno_1'\$as_run'\" != \"x\$as_lineno_2'\$as_run'\" && - test \"x\`expr \$as_lineno_1'\$as_run' + 1\`\" = \"x\$as_lineno_2'\$as_run'\"' || exit 1 -test \$(( 1 + 1 )) = 2 || exit 1 - - test -n \"\${ZSH_VERSION+set}\${BASH_VERSION+set}\" || ( - ECHO='\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\' - ECHO=\$ECHO\$ECHO\$ECHO\$ECHO\$ECHO - ECHO=\$ECHO\$ECHO\$ECHO\$ECHO\$ECHO\$ECHO - PATH=/empty FPATH=/empty; export PATH FPATH - test \"X\`printf %s \$ECHO\`\" = \"X\$ECHO\" \\ - || test \"X\`print -r -- \$ECHO\`\" = \"X\$ECHO\" ) || exit 1" - if (eval "$as_required") 2>/dev/null; then : - as_have_required=yes -else - as_have_required=no -fi - if test x$as_have_required = xyes && (eval "$as_suggested") 2>/dev/null; then : - -else - as_save_IFS=$IFS; IFS=$PATH_SEPARATOR -as_found=false -for as_dir in /bin$PATH_SEPARATOR/usr/bin$PATH_SEPARATOR$PATH -do - IFS=$as_save_IFS - test -z "$as_dir" && as_dir=. - as_found=: - case $as_dir in #( - /*) - for as_base in sh bash ksh sh5; do - # Try only shells that exist, to save several forks. - as_shell=$as_dir/$as_base - if { test -f "$as_shell" || test -f "$as_shell.exe"; } && - { $as_echo "$as_bourne_compatible""$as_required" | as_run=a "$as_shell"; } 2>/dev/null; then : - CONFIG_SHELL=$as_shell as_have_required=yes - if { $as_echo "$as_bourne_compatible""$as_suggested" | as_run=a "$as_shell"; } 2>/dev/null; then : - break 2 -fi -fi - done;; - esac - as_found=false -done -$as_found || { if { test -f "$SHELL" || test -f "$SHELL.exe"; } && - { $as_echo "$as_bourne_compatible""$as_required" | as_run=a "$SHELL"; } 2>/dev/null; then : - CONFIG_SHELL=$SHELL as_have_required=yes -fi; } -IFS=$as_save_IFS - - - if test "x$CONFIG_SHELL" != x; then : - export CONFIG_SHELL - # We cannot yet assume a decent shell, so we have to provide a -# neutralization value for shells without unset; and this also -# works around shells that cannot unset nonexistent variables. -# Preserve -v and -x to the replacement shell. -BASH_ENV=/dev/null -ENV=/dev/null -(unset BASH_ENV) >/dev/null 2>&1 && unset BASH_ENV ENV -case $- in # (((( - *v*x* | *x*v* ) as_opts=-vx ;; - *v* ) as_opts=-v ;; - *x* ) as_opts=-x ;; - * ) as_opts= ;; -esac -exec $CONFIG_SHELL $as_opts "$as_myself" ${1+"$@"} -# Admittedly, this is quite paranoid, since all the known shells bail -# out after a failed `exec'. -$as_echo "$0: could not re-execute with $CONFIG_SHELL" >&2 -exit 255 -fi - - if test x$as_have_required = xno; then : - $as_echo "$0: This script requires a shell more modern than all" - $as_echo "$0: the shells that I found on your system." - if test x${ZSH_VERSION+set} = xset ; then - $as_echo "$0: In particular, zsh $ZSH_VERSION has bugs and should" - $as_echo "$0: be upgraded to zsh 4.3.4 or later." - else - $as_echo "$0: Please tell bug-autoconf@gnu.org and -$0: bug-gnucobol@gnu.org about your system, including any -$0: error possibly output before this message. Then install -$0: a modern shell, or manually run the script under such a -$0: shell if you do have one." - fi - exit 1 -fi -fi -fi -SHELL=${CONFIG_SHELL-/bin/sh} -export SHELL -# Unset more variables known to interfere with behavior of common tools. -CLICOLOR_FORCE= GREP_OPTIONS= -unset CLICOLOR_FORCE GREP_OPTIONS - -## --------------------- ## -## M4sh Shell Functions. ## -## --------------------- ## -# as_fn_unset VAR -# --------------- -# Portably unset VAR. -as_fn_unset () -{ - { eval $1=; unset $1;} -} -as_unset=as_fn_unset - -# as_fn_set_status STATUS -# ----------------------- -# Set $? to STATUS, without forking. -as_fn_set_status () -{ - return $1 -} # as_fn_set_status - -# as_fn_exit STATUS -# ----------------- -# Exit the shell with STATUS, even in a "trap 0" or "set -e" context. -as_fn_exit () -{ - set +e - as_fn_set_status $1 - exit $1 -} # as_fn_exit - -# as_fn_mkdir_p -# ------------- -# Create "$as_dir" as a directory, including parents if necessary. -as_fn_mkdir_p () -{ - - case $as_dir in #( - -*) as_dir=./$as_dir;; - esac - test -d "$as_dir" || eval $as_mkdir_p || { - as_dirs= - while :; do - case $as_dir in #( - *\'*) as_qdir=`$as_echo "$as_dir" | sed "s/'/'\\\\\\\\''/g"`;; #'( - *) as_qdir=$as_dir;; - esac - as_dirs="'$as_qdir' $as_dirs" - as_dir=`$as_dirname -- "$as_dir" || -$as_expr X"$as_dir" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \ - X"$as_dir" : 'X\(//\)[^/]' \| \ - X"$as_dir" : 'X\(//\)$' \| \ - X"$as_dir" : 'X\(/\)' \| . 2>/dev/null || -$as_echo X"$as_dir" | - sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{ - s//\1/ - q - } - /^X\(\/\/\)[^/].*/{ - s//\1/ - q - } - /^X\(\/\/\)$/{ - s//\1/ - q - } - /^X\(\/\).*/{ - s//\1/ - q - } - s/.*/./; q'` - test -d "$as_dir" && break - done - test -z "$as_dirs" || eval "mkdir $as_dirs" - } || test -d "$as_dir" || as_fn_error $? "cannot create directory $as_dir" - - -} # as_fn_mkdir_p - -# as_fn_executable_p FILE -# ----------------------- -# Test if FILE is an executable regular file. -as_fn_executable_p () -{ - test -f "$1" && test -x "$1" -} # as_fn_executable_p -# as_fn_append VAR VALUE -# ---------------------- -# Append the text in VALUE to the end of the definition contained in VAR. Take -# advantage of any shell optimizations that allow amortized linear growth over -# repeated appends, instead of the typical quadratic growth present in naive -# implementations. -if (eval "as_var=1; as_var+=2; test x\$as_var = x12") 2>/dev/null; then : - eval 'as_fn_append () - { - eval $1+=\$2 - }' -else - as_fn_append () - { - eval $1=\$$1\$2 - } -fi # as_fn_append - -# as_fn_arith ARG... -# ------------------ -# Perform arithmetic evaluation on the ARGs, and store the result in the -# global $as_val. Take advantage of shells that can avoid forks. The arguments -# must be portable across $(()) and expr. -if (eval "test \$(( 1 + 1 )) = 2") 2>/dev/null; then : - eval 'as_fn_arith () - { - as_val=$(( $* )) - }' -else - as_fn_arith () - { - as_val=`expr "$@" || test $? -eq 1` - } -fi # as_fn_arith - - -# as_fn_error STATUS ERROR [LINENO LOG_FD] -# ---------------------------------------- -# Output "`basename $0`: error: ERROR" to stderr. If LINENO and LOG_FD are -# provided, also output the error to LOG_FD, referencing LINENO. Then exit the -# script with STATUS, using 1 if that was 0. -as_fn_error () -{ - as_status=$1; test $as_status -eq 0 && as_status=1 - if test "$4"; then - as_lineno=${as_lineno-"$3"} as_lineno_stack=as_lineno_stack=$as_lineno_stack - $as_echo "$as_me:${as_lineno-$LINENO}: error: $2" >&$4 - fi - $as_echo "$as_me: error: $2" >&2 - as_fn_exit $as_status -} # as_fn_error - -if expr a : '\(a\)' >/dev/null 2>&1 && - test "X`expr 00001 : '.*\(...\)'`" = X001; then - as_expr=expr -else - as_expr=false -fi - -if (basename -- /) >/dev/null 2>&1 && test "X`basename -- / 2>&1`" = "X/"; then - as_basename=basename -else - as_basename=false -fi - -if (as_dir=`dirname -- /` && test "X$as_dir" = X/) >/dev/null 2>&1; then - as_dirname=dirname -else - as_dirname=false -fi - -as_me=`$as_basename -- "$0" || -$as_expr X/"$0" : '.*/\([^/][^/]*\)/*$' \| \ - X"$0" : 'X\(//\)$' \| \ - X"$0" : 'X\(/\)' \| . 2>/dev/null || -$as_echo X/"$0" | - sed '/^.*\/\([^/][^/]*\)\/*$/{ - s//\1/ - q - } - /^X\/\(\/\/\)$/{ - s//\1/ - q - } - /^X\/\(\/\).*/{ - s//\1/ - q - } - s/.*/./; q'` - -# Avoid depending upon Character Ranges. -as_cr_letters='abcdefghijklmnopqrstuvwxyz' -as_cr_LETTERS='ABCDEFGHIJKLMNOPQRSTUVWXYZ' -as_cr_Letters=$as_cr_letters$as_cr_LETTERS -as_cr_digits='0123456789' -as_cr_alnum=$as_cr_Letters$as_cr_digits - - - as_lineno_1=$LINENO as_lineno_1a=$LINENO - as_lineno_2=$LINENO as_lineno_2a=$LINENO - eval 'test "x$as_lineno_1'$as_run'" != "x$as_lineno_2'$as_run'" && - test "x`expr $as_lineno_1'$as_run' + 1`" = "x$as_lineno_2'$as_run'"' || { - # Blame Lee E. McMahon (1931-1989) for sed's syntax. :-) - sed -n ' - p - /[$]LINENO/= - ' <$as_myself | - sed ' - s/[$]LINENO.*/&-/ - t lineno - b - :lineno - N - :loop - s/[$]LINENO\([^'$as_cr_alnum'_].*\n\)\(.*\)/\2\1\2/ - t loop - s/-\n.*// - ' >$as_me.lineno && - chmod +x "$as_me.lineno" || - { $as_echo "$as_me: error: cannot create $as_me.lineno; rerun with a POSIX shell" >&2; as_fn_exit 1; } - - # If we had to re-execute with $CONFIG_SHELL, we're ensured to have - # already done that, so ensure we don't try to do so again and fall - # in an infinite loop. This has already happened in practice. - _as_can_reexec=no; export _as_can_reexec - # Don't try to exec as it changes $[0], causing all sort of problems - # (the dirname of $[0] is not the place where we might find the - # original and so on. Autoconf is especially sensitive to this). - . "./$as_me.lineno" - # Exit status is that of the last command. - exit -} - -ECHO_C= ECHO_N= ECHO_T= -case `echo -n x` in #((((( --n*) - case `echo 'xy\c'` in - *c*) ECHO_T=' ';; # ECHO_T is single tab character. - xy) ECHO_C='\c';; - *) echo `echo ksh88 bug on AIX 6.1` > /dev/null - ECHO_T=' ';; - esac;; -*) - ECHO_N='-n';; -esac - -rm -f conf$$ conf$$.exe conf$$.file -if test -d conf$$.dir; then - rm -f conf$$.dir/conf$$.file -else - rm -f conf$$.dir - mkdir conf$$.dir 2>/dev/null -fi -if (echo >conf$$.file) 2>/dev/null; then - if ln -s conf$$.file conf$$ 2>/dev/null; then - as_ln_s='ln -s' - # ... but there are two gotchas: - # 1) On MSYS, both `ln -s file dir' and `ln file dir' fail. - # 2) DJGPP < 2.04 has no symlinks; `ln -s' creates a wrapper executable. - # In both cases, we have to default to `cp -pR'. - ln -s conf$$.file conf$$.dir 2>/dev/null && test ! -f conf$$.exe || - as_ln_s='cp -pR' - elif ln conf$$.file conf$$ 2>/dev/null; then - as_ln_s=ln - else - as_ln_s='cp -pR' - fi -else - as_ln_s='cp -pR' -fi -rm -f conf$$ conf$$.exe conf$$.dir/conf$$.file conf$$.file -rmdir conf$$.dir 2>/dev/null - -if mkdir -p . 2>/dev/null; then - as_mkdir_p='mkdir -p "$as_dir"' -else - test -d ./-p && rmdir ./-p - as_mkdir_p=false -fi - -as_test_x='test -x' -as_executable_p=as_fn_executable_p - -# Sed expression to map a string onto a valid CPP name. -as_tr_cpp="eval sed 'y%*$as_cr_letters%P$as_cr_LETTERS%;s%[^_$as_cr_alnum]%_%g'" - -# Sed expression to map a string onto a valid variable name. -as_tr_sh="eval sed 'y%*+%pp%;s%[^_$as_cr_alnum]%_%g'" - -SHELL=${CONFIG_SHELL-/bin/sh} - - -test -n "$DJDIR" || exec 7<&0 &1 - -# Name of the host. -# hostname on some systems (SVR3.2, old GNU/Linux) returns a bogus exit status, -# so uname gets run too. -ac_hostname=`(hostname || uname -n) 2>/dev/null | sed 1q` - -# -# Initializations. -# -ac_default_prefix=/usr/local -ac_clean_files= -ac_config_libobj_dir=. -LIBOBJS= -cross_compiling=no -subdirs= -MFLAGS= -MAKEFLAGS= - -# Identity of this package. -PACKAGE_NAME='GnuCOBOL' -PACKAGE_TARNAME='gnucobol' -PACKAGE_VERSION='4.0-early-dev' -PACKAGE_STRING='GnuCOBOL 4.0-early-dev' -PACKAGE_BUGREPORT='bug-gnucobol@gnu.org' -PACKAGE_URL='https://www.gnu.org/software/gnucobol/' - -ac_unique_file="libcob.h" -# Factoring default headers for most tests. -ac_includes_default="\ -#include -#ifdef HAVE_SYS_TYPES_H -# include -#endif -#ifdef HAVE_SYS_STAT_H -# include -#endif -#ifdef STDC_HEADERS -# include -# include -#else -# ifdef HAVE_STDLIB_H -# include -# endif -#endif -#ifdef HAVE_STRING_H -# if !defined STDC_HEADERS && defined HAVE_MEMORY_H -# include -# endif -# include -#endif -#ifdef HAVE_STRINGS_H -# include -#endif -#ifdef HAVE_INTTYPES_H -# include -#endif -#ifdef HAVE_STDINT_H -# include -#endif -#ifdef HAVE_UNISTD_H -# include -#endif" - -gt_needs= -ac_subst_vars='am__EXEEXT_FALSE -am__EXEEXT_TRUE -LTLIBOBJS -LIBOBJS -HELP2MAN -COB_PATCH_LEVEL -COB_HAS_64_BIT_POINTER -COB_HAS_CJSON -COB_HAS_XML2 -COB_HAS_CURSES -COB_HAS_OCEXTFH -COB_HAS_OCI -COB_HAS_ODBC -COB_HAS_LMDB -COB_HAS_BDB -COB_HAS_VBISAM -COB_HAS_DISAM -COB_HAS_CISAM -COB_HAS_ISAM -COB_KEYWORD_INLINE -COB_FIX_LIBTOOL -COB_FIX_LIB -COB_BIGENDIAN -COB_SHARED_OPT -COB_PIC_FLAGS -COB_EXPORT_DYN -LIBCOB_VBISAM -LIBCOB_DISAM -LIBCOB_CISAM -COB_EXE_EXT -COB_MODULE_EXT -COB_OBJECT_EXT -COB_LIBRARY_PATH -COB_COPY_DIR -COB_SCHEMA_DIR -COB_CONFIG_DIR -COB_LIBS -COB_LDFLAGS -COB_CFLAGS -COB_CC -COB_MAKE_RUN_BINARIES_FALSE -COB_MAKE_RUN_BINARIES_TRUE -COB_MAKE_IX_FALSE -COB_MAKE_IX_TRUE -LOCAL_CJSON_FALSE -LOCAL_CJSON_TRUE -COB_MAKE_VBISAM_LIB_FALSE -COB_MAKE_VBISAM_LIB_TRUE -COB_MAKE_DISAM_LIB_FALSE -COB_MAKE_DISAM_LIB_TRUE -COB_MAKE_CISAM_LIB_FALSE -COB_MAKE_CISAM_LIB_TRUE -ODBC_LIBS -ODBC_CFLAGS -POSUB -LTLIBINTL -LIBINTL -INTLLIBS -LTLIBICONV -LIBICONV -INTL_MACOSX_LIBS -XGETTEXT_EXTRA_OPTIONS -MSGMERGE -XGETTEXT_015 -XGETTEXT -GMSGFMT_015 -MSGFMT_015 -GMSGFMT -MSGFMT -GETTEXT_MACRO_VERSION -USE_NLS -CJSON_LIBS -CJSON_CFLAGS -xml2_config_found -XML2_LIBS -XML2_CFLAGS -PKG_CONFIG_LIBDIR -PKG_CONFIG_PATH -PKG_CONFIG -CODE_COVERAGE_RULES -CODE_COVERAGE_LDFLAGS -CODE_COVERAGE_LIBS -CODE_COVERAGE_CXXFLAGS -CODE_COVERAGE_CFLAGS -CODE_COVERAGE_CPPFLAGS -GENHTML -LCOV -GCOV -CODE_COVERAGE_ENABLED -CODE_COVERAGE_ENABLED_FALSE -CODE_COVERAGE_ENABLED_TRUE -DIFF_FLAGS -YFLAGS -YACC -LEXLIB -LEX_OUTPUT_ROOT -LEX -LT_SYS_LIBRARY_PATH -OTOOL64 -OTOOL -LIPO -NMEDIT -DSYMUTIL -MANIFEST_TOOL -RANLIB -ac_ct_AR -AR -LN_S -NM -ac_ct_DUMPBIN -DUMPBIN -LD -FGREP -SED -host_os -host_vendor -host_cpu -host -build_os -build_vendor -build_cpu -build -LIBTOOL -OBJDUMP -DLLTOOL -AS -COBC_LIBS -LIBCOB_LIBS -LIBCOB_CPPFLAGS -EGREP -GREP -CPP -am__fastdepCC_FALSE -am__fastdepCC_TRUE -CCDEPMODE -am__nodep -AMDEPBACKSLASH -AMDEP_FALSE -AMDEP_TRUE -am__quote -am__include -DEPDIR -OBJEXT -EXEEXT -ac_ct_CC -CPPFLAGS -LDFLAGS -CFLAGS -CC -MAKE_HAS_PREREQ_ONLY_FALSE -MAKE_HAS_PREREQ_ONLY_TRUE -MAKE -configured_make -AM_BACKSLASH -AM_DEFAULT_VERBOSITY -AM_DEFAULT_V -AM_V -am__untar -am__tar -AMTAR -am__leading_dot -SET_MAKE -AWK -mkdir_p -MKDIR_P -INSTALL_STRIP_PROGRAM -STRIP -install_sh -MAKEINFO -AUTOHEADER -AUTOMAKE -AUTOCONF -ACLOCAL -VERSION -PACKAGE -CYGPATH_W -am__isrc -INSTALL_DATA -INSTALL_SCRIPT -INSTALL_PROGRAM -target_alias -host_alias -build_alias -LIBS -ECHO_T -ECHO_N -ECHO_C -DEFS -mandir -localedir -libdir -psdir -pdfdir -dvidir -htmldir -infodir -docdir -oldincludedir -includedir -runstatedir -localstatedir -sharedstatedir -sysconfdir -datadir -datarootdir -libexecdir -sbindir -bindir -program_transform_name -prefix -exec_prefix -PACKAGE_URL -PACKAGE_BUGREPORT -PACKAGE_STRING -PACKAGE_VERSION -PACKAGE_TARNAME -PACKAGE_NAME -PATH_SEPARATOR -SHELL' -ac_subst_files='' -ac_user_opts=' -enable_option_checking -enable_silent_rules -enable_debug -enable_experimental -enable_cobc_internal_checks -enable_debuglog -enable_param_check -with_patch_level -with_max_call_params -enable_dependency_tracking -enable_shared -enable_static -with_pic -enable_fast_install -with_aix_soname -with_gnu_ld -with_sysroot -enable_libtool_lock -enable_rpath -with_gcov -enable_code_coverage -with_xml2 -with_cjson -with_dl -with_varseq -enable_nls -with_libiconv_prefix -with_libintl_prefix -with_curses -with_seqra_extfh -with_indexed -with_vbisam -with_disam -with_cisam -with_index_extfh -with_odbc -with_oci -with_db -with_lmdb -' - ac_precious_vars='build_alias -host_alias -target_alias -CC -CFLAGS -LDFLAGS -LIBS -CPPFLAGS -CPP -LIBCOB_CPPFLAGS -LIBCOB_LIBS -COBC_LIBS -LT_SYS_LIBRARY_PATH -YACC -YFLAGS -DIFF_FLAGS -PKG_CONFIG -PKG_CONFIG_PATH -PKG_CONFIG_LIBDIR -XML2_CFLAGS -XML2_LIBS -CJSON_CFLAGS -CJSON_LIBS -ODBC_CFLAGS -ODBC_LIBS' - - -# Initialize some variables set by options. -ac_init_help= -ac_init_version=false -ac_unrecognized_opts= -ac_unrecognized_sep= -# The variables have the same names as the options, with -# dashes changed to underlines. -cache_file=/dev/null -exec_prefix=NONE -no_create= -no_recursion= -prefix=NONE -program_prefix=NONE -program_suffix=NONE -program_transform_name=s,x,x, -silent= -site= -srcdir= -verbose= -x_includes=NONE -x_libraries=NONE - -# Installation directory options. -# These are left unexpanded so users can "make install exec_prefix=/foo" -# and all the variables that are supposed to be based on exec_prefix -# by default will actually change. -# Use braces instead of parens because sh, perl, etc. also accept them. -# (The list follows the same order as the GNU Coding Standards.) -bindir='${exec_prefix}/bin' -sbindir='${exec_prefix}/sbin' -libexecdir='${exec_prefix}/libexec' -datarootdir='${prefix}/share' -datadir='${datarootdir}' -sysconfdir='${prefix}/etc' -sharedstatedir='${prefix}/com' -localstatedir='${prefix}/var' -runstatedir='${localstatedir}/run' -includedir='${prefix}/include' -oldincludedir='/usr/include' -docdir='${datarootdir}/doc/${PACKAGE_TARNAME}' -infodir='${datarootdir}/info' -htmldir='${docdir}' -dvidir='${docdir}' -pdfdir='${docdir}' -psdir='${docdir}' -libdir='${exec_prefix}/lib' -localedir='${datarootdir}/locale' -mandir='${datarootdir}/man' - -ac_prev= -ac_dashdash= -for ac_option -do - # If the previous option needs an argument, assign it. - if test -n "$ac_prev"; then - eval $ac_prev=\$ac_option - ac_prev= - continue - fi - - case $ac_option in - *=?*) ac_optarg=`expr "X$ac_option" : '[^=]*=\(.*\)'` ;; - *=) ac_optarg= ;; - *) ac_optarg=yes ;; - esac - - # Accept the important Cygnus configure options, so we can diagnose typos. - - case $ac_dashdash$ac_option in - --) - ac_dashdash=yes ;; - - -bindir | --bindir | --bindi | --bind | --bin | --bi) - ac_prev=bindir ;; - -bindir=* | --bindir=* | --bindi=* | --bind=* | --bin=* | --bi=*) - bindir=$ac_optarg ;; - - -build | --build | --buil | --bui | --bu) - ac_prev=build_alias ;; - -build=* | --build=* | --buil=* | --bui=* | --bu=*) - build_alias=$ac_optarg ;; - - -cache-file | --cache-file | --cache-fil | --cache-fi \ - | --cache-f | --cache- | --cache | --cach | --cac | --ca | --c) - ac_prev=cache_file ;; - -cache-file=* | --cache-file=* | --cache-fil=* | --cache-fi=* \ - | --cache-f=* | --cache-=* | --cache=* | --cach=* | --cac=* | --ca=* | --c=*) - cache_file=$ac_optarg ;; - - --config-cache | -C) - cache_file=config.cache ;; - - -datadir | --datadir | --datadi | --datad) - ac_prev=datadir ;; - -datadir=* | --datadir=* | --datadi=* | --datad=*) - datadir=$ac_optarg ;; - - -datarootdir | --datarootdir | --datarootdi | --datarootd | --dataroot \ - | --dataroo | --dataro | --datar) - ac_prev=datarootdir ;; - -datarootdir=* | --datarootdir=* | --datarootdi=* | --datarootd=* \ - | --dataroot=* | --dataroo=* | --dataro=* | --datar=*) - datarootdir=$ac_optarg ;; - - -disable-* | --disable-*) - ac_useropt=`expr "x$ac_option" : 'x-*disable-\(.*\)'` - # Reject names that are not valid shell variable names. - expr "x$ac_useropt" : ".*[^-+._$as_cr_alnum]" >/dev/null && - as_fn_error $? "invalid feature name: $ac_useropt" - ac_useropt_orig=$ac_useropt - ac_useropt=`$as_echo "$ac_useropt" | sed 's/[-+.]/_/g'` - case $ac_user_opts in - *" -"enable_$ac_useropt" -"*) ;; - *) ac_unrecognized_opts="$ac_unrecognized_opts$ac_unrecognized_sep--disable-$ac_useropt_orig" - ac_unrecognized_sep=', ';; - esac - eval enable_$ac_useropt=no ;; - - -docdir | --docdir | --docdi | --doc | --do) - ac_prev=docdir ;; - -docdir=* | --docdir=* | --docdi=* | --doc=* | --do=*) - docdir=$ac_optarg ;; - - -dvidir | --dvidir | --dvidi | --dvid | --dvi | --dv) - ac_prev=dvidir ;; - -dvidir=* | --dvidir=* | --dvidi=* | --dvid=* | --dvi=* | --dv=*) - dvidir=$ac_optarg ;; - - -enable-* | --enable-*) - ac_useropt=`expr "x$ac_option" : 'x-*enable-\([^=]*\)'` - # Reject names that are not valid shell variable names. - expr "x$ac_useropt" : ".*[^-+._$as_cr_alnum]" >/dev/null && - as_fn_error $? "invalid feature name: $ac_useropt" - ac_useropt_orig=$ac_useropt - ac_useropt=`$as_echo "$ac_useropt" | sed 's/[-+.]/_/g'` - case $ac_user_opts in - *" -"enable_$ac_useropt" -"*) ;; - *) ac_unrecognized_opts="$ac_unrecognized_opts$ac_unrecognized_sep--enable-$ac_useropt_orig" - ac_unrecognized_sep=', ';; - esac - eval enable_$ac_useropt=\$ac_optarg ;; - - -exec-prefix | --exec_prefix | --exec-prefix | --exec-prefi \ - | --exec-pref | --exec-pre | --exec-pr | --exec-p | --exec- \ - | --exec | --exe | --ex) - ac_prev=exec_prefix ;; - -exec-prefix=* | --exec_prefix=* | --exec-prefix=* | --exec-prefi=* \ - | --exec-pref=* | --exec-pre=* | --exec-pr=* | --exec-p=* | --exec-=* \ - | --exec=* | --exe=* | --ex=*) - exec_prefix=$ac_optarg ;; - - -gas | --gas | --ga | --g) - # Obsolete; use --with-gas. - with_gas=yes ;; - - -help | --help | --hel | --he | -h) - ac_init_help=long ;; - -help=r* | --help=r* | --hel=r* | --he=r* | -hr*) - ac_init_help=recursive ;; - -help=s* | --help=s* | --hel=s* | --he=s* | -hs*) - ac_init_help=short ;; - - -host | --host | --hos | --ho) - ac_prev=host_alias ;; - -host=* | --host=* | --hos=* | --ho=*) - host_alias=$ac_optarg ;; - - -htmldir | --htmldir | --htmldi | --htmld | --html | --htm | --ht) - ac_prev=htmldir ;; - -htmldir=* | --htmldir=* | --htmldi=* | --htmld=* | --html=* | --htm=* \ - | --ht=*) - htmldir=$ac_optarg ;; - - -includedir | --includedir | --includedi | --included | --include \ - | --includ | --inclu | --incl | --inc) - ac_prev=includedir ;; - -includedir=* | --includedir=* | --includedi=* | --included=* | --include=* \ - | --includ=* | --inclu=* | --incl=* | --inc=*) - includedir=$ac_optarg ;; - - -infodir | --infodir | --infodi | --infod | --info | --inf) - ac_prev=infodir ;; - -infodir=* | --infodir=* | --infodi=* | --infod=* | --info=* | --inf=*) - infodir=$ac_optarg ;; - - -libdir | --libdir | --libdi | --libd) - ac_prev=libdir ;; - -libdir=* | --libdir=* | --libdi=* | --libd=*) - libdir=$ac_optarg ;; - - -libexecdir | --libexecdir | --libexecdi | --libexecd | --libexec \ - | --libexe | --libex | --libe) - ac_prev=libexecdir ;; - -libexecdir=* | --libexecdir=* | --libexecdi=* | --libexecd=* | --libexec=* \ - | --libexe=* | --libex=* | --libe=*) - libexecdir=$ac_optarg ;; - - -localedir | --localedir | --localedi | --localed | --locale) - ac_prev=localedir ;; - -localedir=* | --localedir=* | --localedi=* | --localed=* | --locale=*) - localedir=$ac_optarg ;; - - -localstatedir | --localstatedir | --localstatedi | --localstated \ - | --localstate | --localstat | --localsta | --localst | --locals) - ac_prev=localstatedir ;; - -localstatedir=* | --localstatedir=* | --localstatedi=* | --localstated=* \ - | --localstate=* | --localstat=* | --localsta=* | --localst=* | --locals=*) - localstatedir=$ac_optarg ;; - - -mandir | --mandir | --mandi | --mand | --man | --ma | --m) - ac_prev=mandir ;; - -mandir=* | --mandir=* | --mandi=* | --mand=* | --man=* | --ma=* | --m=*) - mandir=$ac_optarg ;; - - -nfp | --nfp | --nf) - # Obsolete; use --without-fp. - with_fp=no ;; - - -no-create | --no-create | --no-creat | --no-crea | --no-cre \ - | --no-cr | --no-c | -n) - no_create=yes ;; - - -no-recursion | --no-recursion | --no-recursio | --no-recursi \ - | --no-recurs | --no-recur | --no-recu | --no-rec | --no-re | --no-r) - no_recursion=yes ;; - - -oldincludedir | --oldincludedir | --oldincludedi | --oldincluded \ - | --oldinclude | --oldinclud | --oldinclu | --oldincl | --oldinc \ - | --oldin | --oldi | --old | --ol | --o) - ac_prev=oldincludedir ;; - -oldincludedir=* | --oldincludedir=* | --oldincludedi=* | --oldincluded=* \ - | --oldinclude=* | --oldinclud=* | --oldinclu=* | --oldincl=* | --oldinc=* \ - | --oldin=* | --oldi=* | --old=* | --ol=* | --o=*) - oldincludedir=$ac_optarg ;; - - -prefix | --prefix | --prefi | --pref | --pre | --pr | --p) - ac_prev=prefix ;; - -prefix=* | --prefix=* | --prefi=* | --pref=* | --pre=* | --pr=* | --p=*) - prefix=$ac_optarg ;; - - -program-prefix | --program-prefix | --program-prefi | --program-pref \ - | --program-pre | --program-pr | --program-p) - ac_prev=program_prefix ;; - -program-prefix=* | --program-prefix=* | --program-prefi=* \ - | --program-pref=* | --program-pre=* | --program-pr=* | --program-p=*) - program_prefix=$ac_optarg ;; - - -program-suffix | --program-suffix | --program-suffi | --program-suff \ - | --program-suf | --program-su | --program-s) - ac_prev=program_suffix ;; - -program-suffix=* | --program-suffix=* | --program-suffi=* \ - | --program-suff=* | --program-suf=* | --program-su=* | --program-s=*) - program_suffix=$ac_optarg ;; - - -program-transform-name | --program-transform-name \ - | --program-transform-nam | --program-transform-na \ - | --program-transform-n | --program-transform- \ - | --program-transform | --program-transfor \ - | --program-transfo | --program-transf \ - | --program-trans | --program-tran \ - | --progr-tra | --program-tr | --program-t) - ac_prev=program_transform_name ;; - -program-transform-name=* | --program-transform-name=* \ - | --program-transform-nam=* | --program-transform-na=* \ - | --program-transform-n=* | --program-transform-=* \ - | --program-transform=* | --program-transfor=* \ - | --program-transfo=* | --program-transf=* \ - | --program-trans=* | --program-tran=* \ - | --progr-tra=* | --program-tr=* | --program-t=*) - program_transform_name=$ac_optarg ;; - - -pdfdir | --pdfdir | --pdfdi | --pdfd | --pdf | --pd) - ac_prev=pdfdir ;; - -pdfdir=* | --pdfdir=* | --pdfdi=* | --pdfd=* | --pdf=* | --pd=*) - pdfdir=$ac_optarg ;; - - -psdir | --psdir | --psdi | --psd | --ps) - ac_prev=psdir ;; - -psdir=* | --psdir=* | --psdi=* | --psd=* | --ps=*) - psdir=$ac_optarg ;; - - -q | -quiet | --quiet | --quie | --qui | --qu | --q \ - | -silent | --silent | --silen | --sile | --sil) - silent=yes ;; - - -runstatedir | --runstatedir | --runstatedi | --runstated \ - | --runstate | --runstat | --runsta | --runst | --runs \ - | --run | --ru | --r) - ac_prev=runstatedir ;; - -runstatedir=* | --runstatedir=* | --runstatedi=* | --runstated=* \ - | --runstate=* | --runstat=* | --runsta=* | --runst=* | --runs=* \ - | --run=* | --ru=* | --r=*) - runstatedir=$ac_optarg ;; - - -sbindir | --sbindir | --sbindi | --sbind | --sbin | --sbi | --sb) - ac_prev=sbindir ;; - -sbindir=* | --sbindir=* | --sbindi=* | --sbind=* | --sbin=* \ - | --sbi=* | --sb=*) - sbindir=$ac_optarg ;; - - -sharedstatedir | --sharedstatedir | --sharedstatedi \ - | --sharedstated | --sharedstate | --sharedstat | --sharedsta \ - | --sharedst | --shareds | --shared | --share | --shar \ - | --sha | --sh) - ac_prev=sharedstatedir ;; - -sharedstatedir=* | --sharedstatedir=* | --sharedstatedi=* \ - | --sharedstated=* | --sharedstate=* | --sharedstat=* | --sharedsta=* \ - | --sharedst=* | --shareds=* | --shared=* | --share=* | --shar=* \ - | --sha=* | --sh=*) - sharedstatedir=$ac_optarg ;; - - -site | --site | --sit) - ac_prev=site ;; - -site=* | --site=* | --sit=*) - site=$ac_optarg ;; - - -srcdir | --srcdir | --srcdi | --srcd | --src | --sr) - ac_prev=srcdir ;; - -srcdir=* | --srcdir=* | --srcdi=* | --srcd=* | --src=* | --sr=*) - srcdir=$ac_optarg ;; - - -sysconfdir | --sysconfdir | --sysconfdi | --sysconfd | --sysconf \ - | --syscon | --sysco | --sysc | --sys | --sy) - ac_prev=sysconfdir ;; - -sysconfdir=* | --sysconfdir=* | --sysconfdi=* | --sysconfd=* | --sysconf=* \ - | --syscon=* | --sysco=* | --sysc=* | --sys=* | --sy=*) - sysconfdir=$ac_optarg ;; - - -target | --target | --targe | --targ | --tar | --ta | --t) - ac_prev=target_alias ;; - -target=* | --target=* | --targe=* | --targ=* | --tar=* | --ta=* | --t=*) - target_alias=$ac_optarg ;; - - -v | -verbose | --verbose | --verbos | --verbo | --verb) - verbose=yes ;; - - -version | --version | --versio | --versi | --vers | -V) - ac_init_version=: ;; - - -with-* | --with-*) - ac_useropt=`expr "x$ac_option" : 'x-*with-\([^=]*\)'` - # Reject names that are not valid shell variable names. - expr "x$ac_useropt" : ".*[^-+._$as_cr_alnum]" >/dev/null && - as_fn_error $? "invalid package name: $ac_useropt" - ac_useropt_orig=$ac_useropt - ac_useropt=`$as_echo "$ac_useropt" | sed 's/[-+.]/_/g'` - case $ac_user_opts in - *" -"with_$ac_useropt" -"*) ;; - *) ac_unrecognized_opts="$ac_unrecognized_opts$ac_unrecognized_sep--with-$ac_useropt_orig" - ac_unrecognized_sep=', ';; - esac - eval with_$ac_useropt=\$ac_optarg ;; - - -without-* | --without-*) - ac_useropt=`expr "x$ac_option" : 'x-*without-\(.*\)'` - # Reject names that are not valid shell variable names. - expr "x$ac_useropt" : ".*[^-+._$as_cr_alnum]" >/dev/null && - as_fn_error $? "invalid package name: $ac_useropt" - ac_useropt_orig=$ac_useropt - ac_useropt=`$as_echo "$ac_useropt" | sed 's/[-+.]/_/g'` - case $ac_user_opts in - *" -"with_$ac_useropt" -"*) ;; - *) ac_unrecognized_opts="$ac_unrecognized_opts$ac_unrecognized_sep--without-$ac_useropt_orig" - ac_unrecognized_sep=', ';; - esac - eval with_$ac_useropt=no ;; - - --x) - # Obsolete; use --with-x. - with_x=yes ;; - - -x-includes | --x-includes | --x-include | --x-includ | --x-inclu \ - | --x-incl | --x-inc | --x-in | --x-i) - ac_prev=x_includes ;; - -x-includes=* | --x-includes=* | --x-include=* | --x-includ=* | --x-inclu=* \ - | --x-incl=* | --x-inc=* | --x-in=* | --x-i=*) - x_includes=$ac_optarg ;; - - -x-libraries | --x-libraries | --x-librarie | --x-librari \ - | --x-librar | --x-libra | --x-libr | --x-lib | --x-li | --x-l) - ac_prev=x_libraries ;; - -x-libraries=* | --x-libraries=* | --x-librarie=* | --x-librari=* \ - | --x-librar=* | --x-libra=* | --x-libr=* | --x-lib=* | --x-li=* | --x-l=*) - x_libraries=$ac_optarg ;; - - -*) as_fn_error $? "unrecognized option: \`$ac_option' -Try \`$0 --help' for more information" - ;; - - *=*) - ac_envvar=`expr "x$ac_option" : 'x\([^=]*\)='` - # Reject names that are not valid shell variable names. - case $ac_envvar in #( - '' | [0-9]* | *[!_$as_cr_alnum]* ) - as_fn_error $? "invalid variable name: \`$ac_envvar'" ;; - esac - eval $ac_envvar=\$ac_optarg - export $ac_envvar ;; - - *) - # FIXME: should be removed in autoconf 3.0. - $as_echo "$as_me: WARNING: you should use --build, --host, --target" >&2 - expr "x$ac_option" : ".*[^-._$as_cr_alnum]" >/dev/null && - $as_echo "$as_me: WARNING: invalid host type: $ac_option" >&2 - : "${build_alias=$ac_option} ${host_alias=$ac_option} ${target_alias=$ac_option}" - ;; - - esac -done - -if test -n "$ac_prev"; then - ac_option=--`echo $ac_prev | sed 's/_/-/g'` - as_fn_error $? "missing argument to $ac_option" -fi - -if test -n "$ac_unrecognized_opts"; then - case $enable_option_checking in - no) ;; - fatal) as_fn_error $? "unrecognized options: $ac_unrecognized_opts" ;; - *) $as_echo "$as_me: WARNING: unrecognized options: $ac_unrecognized_opts" >&2 ;; - esac -fi - -# Check all directory arguments for consistency. -for ac_var in exec_prefix prefix bindir sbindir libexecdir datarootdir \ - datadir sysconfdir sharedstatedir localstatedir includedir \ - oldincludedir docdir infodir htmldir dvidir pdfdir psdir \ - libdir localedir mandir runstatedir -do - eval ac_val=\$$ac_var - # Remove trailing slashes. - case $ac_val in - */ ) - ac_val=`expr "X$ac_val" : 'X\(.*[^/]\)' \| "X$ac_val" : 'X\(.*\)'` - eval $ac_var=\$ac_val;; - esac - # Be sure to have absolute directory names. - case $ac_val in - [\\/$]* | ?:[\\/]* ) continue;; - NONE | '' ) case $ac_var in *prefix ) continue;; esac;; - esac - as_fn_error $? "expected an absolute directory name for --$ac_var: $ac_val" -done - -# There might be people who depend on the old broken behavior: `$host' -# used to hold the argument of --host etc. -# FIXME: To remove some day. -build=$build_alias -host=$host_alias -target=$target_alias - -# FIXME: To remove some day. -if test "x$host_alias" != x; then - if test "x$build_alias" = x; then - cross_compiling=maybe - elif test "x$build_alias" != "x$host_alias"; then - cross_compiling=yes - fi -fi - -ac_tool_prefix= -test -n "$host_alias" && ac_tool_prefix=$host_alias- - -test "$silent" = yes && exec 6>/dev/null - - -ac_pwd=`pwd` && test -n "$ac_pwd" && -ac_ls_di=`ls -di .` && -ac_pwd_ls_di=`cd "$ac_pwd" && ls -di .` || - as_fn_error $? "working directory cannot be determined" -test "X$ac_ls_di" = "X$ac_pwd_ls_di" || - as_fn_error $? "pwd does not report name of working directory" - - -# Find the source files, if location was not specified. -if test -z "$srcdir"; then - ac_srcdir_defaulted=yes - # Try the directory containing this script, then the parent directory. - ac_confdir=`$as_dirname -- "$as_myself" || -$as_expr X"$as_myself" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \ - X"$as_myself" : 'X\(//\)[^/]' \| \ - X"$as_myself" : 'X\(//\)$' \| \ - X"$as_myself" : 'X\(/\)' \| . 2>/dev/null || -$as_echo X"$as_myself" | - sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{ - s//\1/ - q - } - /^X\(\/\/\)[^/].*/{ - s//\1/ - q - } - /^X\(\/\/\)$/{ - s//\1/ - q - } - /^X\(\/\).*/{ - s//\1/ - q - } - s/.*/./; q'` - srcdir=$ac_confdir - if test ! -r "$srcdir/$ac_unique_file"; then - srcdir=.. - fi -else - ac_srcdir_defaulted=no -fi -if test ! -r "$srcdir/$ac_unique_file"; then - test "$ac_srcdir_defaulted" = yes && srcdir="$ac_confdir or .." - as_fn_error $? "cannot find sources ($ac_unique_file) in $srcdir" -fi -ac_msg="sources are in $srcdir, but \`cd $srcdir' does not work" -ac_abs_confdir=`( - cd "$srcdir" && test -r "./$ac_unique_file" || as_fn_error $? "$ac_msg" - pwd)` -# When building in place, set srcdir=. -if test "$ac_abs_confdir" = "$ac_pwd"; then - srcdir=. -fi -# Remove unnecessary trailing slashes from srcdir. -# Double slashes in file names in object file debugging info -# mess up M-x gdb in Emacs. -case $srcdir in -*/) srcdir=`expr "X$srcdir" : 'X\(.*[^/]\)' \| "X$srcdir" : 'X\(.*\)'`;; -esac -for ac_var in $ac_precious_vars; do - eval ac_env_${ac_var}_set=\${${ac_var}+set} - eval ac_env_${ac_var}_value=\$${ac_var} - eval ac_cv_env_${ac_var}_set=\${${ac_var}+set} - eval ac_cv_env_${ac_var}_value=\$${ac_var} -done - -# -# Report the --help message. -# -if test "$ac_init_help" = "long"; then - # Omit some internal or obsolete options to make the list less imposing. - # This message is too long to be a string in the A/UX 3.1 sh. - cat <<_ACEOF -\`configure' configures GnuCOBOL 4.0-early-dev to adapt to many kinds of systems. - -Usage: $0 [OPTION]... [VAR=VALUE]... - -To assign environment variables (e.g., CC, CFLAGS...), specify them as -VAR=VALUE. See below for descriptions of some of the useful variables. - -Defaults for the options are specified in brackets. - -Configuration: - -h, --help display this help and exit - --help=short display options specific to this package - --help=recursive display the short help of all the included packages - -V, --version display version information and exit - -q, --quiet, --silent do not print \`checking ...' messages - --cache-file=FILE cache test results in FILE [disabled] - -C, --config-cache alias for \`--cache-file=config.cache' - -n, --no-create do not create output files - --srcdir=DIR find the sources in DIR [configure dir or \`..'] - -Installation directories: - --prefix=PREFIX install architecture-independent files in PREFIX - [$ac_default_prefix] - --exec-prefix=EPREFIX install architecture-dependent files in EPREFIX - [PREFIX] - -By default, \`make install' will install all the files in -\`$ac_default_prefix/bin', \`$ac_default_prefix/lib' etc. You can specify -an installation prefix other than \`$ac_default_prefix' using \`--prefix', -for instance \`--prefix=\$HOME'. - -For better control, use the options below. - -Fine tuning of the installation directories: - --bindir=DIR user executables [EPREFIX/bin] - --sbindir=DIR system admin executables [EPREFIX/sbin] - --libexecdir=DIR program executables [EPREFIX/libexec] - --sysconfdir=DIR read-only single-machine data [PREFIX/etc] - --sharedstatedir=DIR modifiable architecture-independent data [PREFIX/com] - --localstatedir=DIR modifiable single-machine data [PREFIX/var] - --runstatedir=DIR modifiable per-process data [LOCALSTATEDIR/run] - --libdir=DIR object code libraries [EPREFIX/lib] - --includedir=DIR C header files [PREFIX/include] - --oldincludedir=DIR C header files for non-gcc [/usr/include] - --datarootdir=DIR read-only arch.-independent data root [PREFIX/share] - --datadir=DIR read-only architecture-independent data [DATAROOTDIR] - --infodir=DIR info documentation [DATAROOTDIR/info] - --localedir=DIR locale-dependent data [DATAROOTDIR/locale] - --mandir=DIR man documentation [DATAROOTDIR/man] - --docdir=DIR documentation root [DATAROOTDIR/doc/gnucobol] - --htmldir=DIR html documentation [DOCDIR] - --dvidir=DIR dvi documentation [DOCDIR] - --pdfdir=DIR pdf documentation [DOCDIR] - --psdir=DIR ps documentation [DOCDIR] -_ACEOF - - cat <<\_ACEOF - -Program names: - --program-prefix=PREFIX prepend PREFIX to installed program names - --program-suffix=SUFFIX append SUFFIX to installed program names - --program-transform-name=PROGRAM run sed PROGRAM on installed program names - -System types: - --build=BUILD configure for building on BUILD [guessed] - --host=HOST cross-compile to build programs to run on HOST [BUILD] -_ACEOF -fi - -if test -n "$ac_init_help"; then - case $ac_init_help in - short | recursive ) echo "Configuration of GnuCOBOL 4.0-early-dev:";; - esac - cat <<\_ACEOF - -Optional Features: - --disable-option-checking ignore unrecognized --enable/--with options - --disable-FEATURE do not include FEATURE (same as --enable-FEATURE=no) - --enable-FEATURE[=ARG] include FEATURE [ARG=yes] - --enable-silent-rules less verbose build output (undo: "make V=1") - --disable-silent-rules verbose build output (undo: "make V=0") - --enable-debug (GnuCOBOL) Enable -g C compiler debug option - --enable-experimental (GnuCOBOL) Enable experimental code (Developers - only!) - --enable-cobc-internal-checks - (GnuCOBOL) Enable extra checks within the compiler - (Developers only!) - --enable-debuglog (GnuCOBOL) Enable internal logging code (Developers - only!) - --enable-param-check (GnuCOBOL) Enable minimum parameter check for system - libraries (default no) - --enable-dependency-tracking - do not reject slow dependency extractors - --disable-dependency-tracking - speeds up one-time build - --enable-shared[=PKGS] build shared libraries [default=yes] - --enable-static[=PKGS] build static libraries [default=yes] - --enable-fast-install[=PKGS] - optimize for fast installation [default=yes] - --disable-libtool-lock avoid locking (might break parallel builds) - --disable-rpath do not hardcode runtime library paths - --enable-code-coverage Whether to enable code coverage support - --disable-nls do not use Native Language Support - -Optional Packages: - --with-PACKAGE[=ARG] use PACKAGE [ARG=yes] - --without-PACKAGE do not use PACKAGE (same as --with-PACKAGE=no) - --with-patch-level (GnuCOBOL) Define a patch level (default 0), - numeric, max. 8 digits - --with-max-call-params (GnuCOBOL) Define maximum number of parameters for - CALL (default 192) - --with-pic[=PKGS] try to use only PIC/non-PIC objects [default=use - both] - --with-aix-soname=aix|svr4|both - shared library versioning (aka "SONAME") variant to - provide on AIX, [default=aix]. - --with-gnu-ld assume the C compiler uses GNU ld [default=no] - --with-sysroot[=DIR] Search for dependent libraries within DIR (or the - compiler's sysroot if not specified). - --with-gnu-ld assume the C compiler uses GNU ld [default=no] - --with-gcov=GCOV use given GCOV for coverage (GCOV=gcov). - --with-xml2 (GnuCOBOL) Use libxml2 as XML handler (default) - --with-cjson (GnuCOBOL) Use cJSON as JSON handler (default) - --with-dl (GnuCOBOL) Use system dynamic loader (default) - --with-varseq (GnuCOBOL) Define variable sequential format - (default 0) - --with-libiconv-prefix[=DIR] search for libiconv in DIR/include and DIR/lib - --without-libiconv-prefix don't search for libiconv in includedir and libdir - --with-libintl-prefix[=DIR] search for libintl in DIR/include and DIR/lib - --without-libintl-prefix don't search for libintl in includedir and libdir - --with-curses[=ARG] (GnuCOBOL) Use curses library for extended SCREEN - I/O, where ARG may be: check (default), ncursesw, - ncurses, pdcurses, curses, no - --with-seqra-extfh (GnuCOBOL) Use external SEQ/RAN handler (obsolete) - --with-indexed Define default INDEXED file handler - --with-vbisam (GnuCOBOL) Use VBISAM for ISAM I/O - --with-disam (GnuCOBOL) Use DISAM for ISAM I/O - --with-cisam (GnuCOBOL) Use CISAM for ISAM I/O - --with-index-extfh (GnuCOBOL) Use external ISAM handler (obsolete) - --with-odbc (GnuCOBOL) Use ODBC for INDEXED I/O - --with-oci (GnuCOBOL) Use Oracle OCI for INDEXED I/O - --with-db (GnuCOBOL) Use Berkeley DB >= 4.1 for ISAM I/O - (default) - --with-lmdb (GnuCOBOL) Use Lightning Memory-Mapped Database - (LMDB) for ISAM I/O (experimental, no locking or - shared storage) - -Some influential environment variables: - CC C compiler command - CFLAGS C compiler flags - LDFLAGS linker flags, e.g. -L if you have libraries in a - nonstandard directory - LIBS libraries to pass to the linker, e.g. -l - CPPFLAGS (Objective) C/C++ preprocessor flags, e.g. -I if - you have headers in a nonstandard directory - CPP C preprocessor - LIBCOB_CPPFLAGS - see CPPFLAGS, but only applied during generation of libcob - LIBCOB_LIBS see LIBS, but only applied during generation of libcob - COBC_LIBS see LIBS, but only applied during generation of cobc - LT_SYS_LIBRARY_PATH - User-defined run-time library search path. - YACC The `Yet Another Compiler Compiler' implementation to use. - Defaults to the first program found out of: `bison -y', `byacc', - `yacc'. - YFLAGS The list of arguments that will be passed by default to $YACC. - This script will default YFLAGS to the empty string to avoid a - default value of `-d' given by some make applications. - DIFF_FLAGS arguments passed to diff - PKG_CONFIG path to pkg-config utility - PKG_CONFIG_PATH - directories to add to pkg-config's search path - PKG_CONFIG_LIBDIR - path overriding pkg-config's built-in search path - XML2_CFLAGS C compiler flags for XML2, overriding pkg-config - XML2_LIBS linker flags for XML2, overriding pkg-config - CJSON_CFLAGS - C compiler flags for CJSON, overriding pkg-config - CJSON_LIBS linker flags for CJSON, overriding pkg-config - ODBC_CFLAGS C compiler flags for ODBC, overriding pkg-config - ODBC_LIBS linker flags for ODBC, overriding pkg-config - -Use these variables to override the choices made by `configure' or to help -it to find libraries and programs with nonstandard names/locations. - -Report bugs to . -GnuCOBOL home page: . -_ACEOF -ac_status=$? -fi - -if test "$ac_init_help" = "recursive"; then - # If there are subdirs, report their specific --help. - for ac_dir in : $ac_subdirs_all; do test "x$ac_dir" = x: && continue - test -d "$ac_dir" || - { cd "$srcdir" && ac_pwd=`pwd` && srcdir=. && test -d "$ac_dir"; } || - continue - ac_builddir=. - -case "$ac_dir" in -.) ac_dir_suffix= ac_top_builddir_sub=. ac_top_build_prefix= ;; -*) - ac_dir_suffix=/`$as_echo "$ac_dir" | sed 's|^\.[\\/]||'` - # A ".." for each directory in $ac_dir_suffix. - ac_top_builddir_sub=`$as_echo "$ac_dir_suffix" | sed 's|/[^\\/]*|/..|g;s|/||'` - case $ac_top_builddir_sub in - "") ac_top_builddir_sub=. ac_top_build_prefix= ;; - *) ac_top_build_prefix=$ac_top_builddir_sub/ ;; - esac ;; -esac -ac_abs_top_builddir=$ac_pwd -ac_abs_builddir=$ac_pwd$ac_dir_suffix -# for backward compatibility: -ac_top_builddir=$ac_top_build_prefix - -case $srcdir in - .) # We are building in place. - ac_srcdir=. - ac_top_srcdir=$ac_top_builddir_sub - ac_abs_top_srcdir=$ac_pwd ;; - [\\/]* | ?:[\\/]* ) # Absolute name. - ac_srcdir=$srcdir$ac_dir_suffix; - ac_top_srcdir=$srcdir - ac_abs_top_srcdir=$srcdir ;; - *) # Relative name. - ac_srcdir=$ac_top_build_prefix$srcdir$ac_dir_suffix - ac_top_srcdir=$ac_top_build_prefix$srcdir - ac_abs_top_srcdir=$ac_pwd/$srcdir ;; -esac -ac_abs_srcdir=$ac_abs_top_srcdir$ac_dir_suffix - - cd "$ac_dir" || { ac_status=$?; continue; } - # Check for guested configure. - if test -f "$ac_srcdir/configure.gnu"; then - echo && - $SHELL "$ac_srcdir/configure.gnu" --help=recursive - elif test -f "$ac_srcdir/configure"; then - echo && - $SHELL "$ac_srcdir/configure" --help=recursive - else - $as_echo "$as_me: WARNING: no configuration information is in $ac_dir" >&2 - fi || ac_status=$? - cd "$ac_pwd" || { ac_status=$?; break; } - done -fi - -test -n "$ac_init_help" && exit $ac_status -if $ac_init_version; then - cat <<\_ACEOF -GnuCOBOL configure 4.0-early-dev -generated by GNU Autoconf 2.69 - -Copyright (C) 2012 Free Software Foundation, Inc. -This configure script is free software; the Free Software Foundation -gives unlimited permission to copy, distribute and modify it. -_ACEOF - exit -fi - -## ------------------------ ## -## Autoconf initialization. ## -## ------------------------ ## - -# ac_fn_c_try_compile LINENO -# -------------------------- -# Try to compile conftest.$ac_ext, and return whether this succeeded. -ac_fn_c_try_compile () -{ - as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack - rm -f conftest.$ac_objext - if { { ac_try="$ac_compile" -case "(($ac_try" in - *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; - *) ac_try_echo=$ac_try;; -esac -eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\"" -$as_echo "$ac_try_echo"; } >&5 - (eval "$ac_compile") 2>conftest.err - ac_status=$? - if test -s conftest.err; then - grep -v '^ *+' conftest.err >conftest.er1 - cat conftest.er1 >&5 - mv -f conftest.er1 conftest.err - fi - $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 - test $ac_status = 0; } && { - test -z "$ac_c_werror_flag" || - test ! -s conftest.err - } && test -s conftest.$ac_objext; then : - ac_retval=0 -else - $as_echo "$as_me: failed program was:" >&5 -sed 's/^/| /' conftest.$ac_ext >&5 - - ac_retval=1 -fi - eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno - as_fn_set_status $ac_retval - -} # ac_fn_c_try_compile - -# ac_fn_c_try_cpp LINENO -# ---------------------- -# Try to preprocess conftest.$ac_ext, and return whether this succeeded. -ac_fn_c_try_cpp () -{ - as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack - if { { ac_try="$ac_cpp conftest.$ac_ext" -case "(($ac_try" in - *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; - *) ac_try_echo=$ac_try;; -esac -eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\"" -$as_echo "$ac_try_echo"; } >&5 - (eval "$ac_cpp conftest.$ac_ext") 2>conftest.err - ac_status=$? - if test -s conftest.err; then - grep -v '^ *+' conftest.err >conftest.er1 - cat conftest.er1 >&5 - mv -f conftest.er1 conftest.err - fi - $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 - test $ac_status = 0; } > conftest.i && { - test -z "$ac_c_preproc_warn_flag$ac_c_werror_flag" || - test ! -s conftest.err - }; then : - ac_retval=0 -else - $as_echo "$as_me: failed program was:" >&5 -sed 's/^/| /' conftest.$ac_ext >&5 - - ac_retval=1 -fi - eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno - as_fn_set_status $ac_retval - -} # ac_fn_c_try_cpp - -# ac_fn_c_check_header_mongrel LINENO HEADER VAR INCLUDES -# ------------------------------------------------------- -# Tests whether HEADER exists, giving a warning if it cannot be compiled using -# the include files in INCLUDES and setting the cache variable VAR -# accordingly. -ac_fn_c_check_header_mongrel () -{ - as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack - if eval \${$3+:} false; then : - { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $2" >&5 -$as_echo_n "checking for $2... " >&6; } -if eval \${$3+:} false; then : - $as_echo_n "(cached) " >&6 -fi -eval ac_res=\$$3 - { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_res" >&5 -$as_echo "$ac_res" >&6; } -else - # Is the header compilable? -{ $as_echo "$as_me:${as_lineno-$LINENO}: checking $2 usability" >&5 -$as_echo_n "checking $2 usability... " >&6; } -cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ -$4 -#include <$2> -_ACEOF -if ac_fn_c_try_compile "$LINENO"; then : - ac_header_compiler=yes -else - ac_header_compiler=no -fi -rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext -{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_header_compiler" >&5 -$as_echo "$ac_header_compiler" >&6; } - -# Is the header present? -{ $as_echo "$as_me:${as_lineno-$LINENO}: checking $2 presence" >&5 -$as_echo_n "checking $2 presence... " >&6; } -cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ -#include <$2> -_ACEOF -if ac_fn_c_try_cpp "$LINENO"; then : - ac_header_preproc=yes -else - ac_header_preproc=no -fi -rm -f conftest.err conftest.i conftest.$ac_ext -{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_header_preproc" >&5 -$as_echo "$ac_header_preproc" >&6; } - -# So? What about this header? -case $ac_header_compiler:$ac_header_preproc:$ac_c_preproc_warn_flag in #(( - yes:no: ) - { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: $2: accepted by the compiler, rejected by the preprocessor!" >&5 -$as_echo "$as_me: WARNING: $2: accepted by the compiler, rejected by the preprocessor!" >&2;} - { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: $2: proceeding with the compiler's result" >&5 -$as_echo "$as_me: WARNING: $2: proceeding with the compiler's result" >&2;} - ;; - no:yes:* ) - { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: $2: present but cannot be compiled" >&5 -$as_echo "$as_me: WARNING: $2: present but cannot be compiled" >&2;} - { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: $2: check for missing prerequisite headers?" >&5 -$as_echo "$as_me: WARNING: $2: check for missing prerequisite headers?" >&2;} - { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: $2: see the Autoconf documentation" >&5 -$as_echo "$as_me: WARNING: $2: see the Autoconf documentation" >&2;} - { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: $2: section \"Present But Cannot Be Compiled\"" >&5 -$as_echo "$as_me: WARNING: $2: section \"Present But Cannot Be Compiled\"" >&2;} - { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: $2: proceeding with the compiler's result" >&5 -$as_echo "$as_me: WARNING: $2: proceeding with the compiler's result" >&2;} -( $as_echo "## ----------------------------------- ## -## Report this to bug-gnucobol@gnu.org ## -## ----------------------------------- ##" - ) | sed "s/^/$as_me: WARNING: /" >&2 - ;; -esac - { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $2" >&5 -$as_echo_n "checking for $2... " >&6; } -if eval \${$3+:} false; then : - $as_echo_n "(cached) " >&6 -else - eval "$3=\$ac_header_compiler" -fi -eval ac_res=\$$3 - { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_res" >&5 -$as_echo "$ac_res" >&6; } -fi - eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno - -} # ac_fn_c_check_header_mongrel - -# ac_fn_c_try_run LINENO -# ---------------------- -# Try to link conftest.$ac_ext, and return whether this succeeded. Assumes -# that executables *can* be run. -ac_fn_c_try_run () -{ - as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack - if { { ac_try="$ac_link" -case "(($ac_try" in - *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; - *) ac_try_echo=$ac_try;; -esac -eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\"" -$as_echo "$ac_try_echo"; } >&5 - (eval "$ac_link") 2>&5 - ac_status=$? - $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 - test $ac_status = 0; } && { ac_try='./conftest$ac_exeext' - { { case "(($ac_try" in - *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; - *) ac_try_echo=$ac_try;; -esac -eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\"" -$as_echo "$ac_try_echo"; } >&5 - (eval "$ac_try") 2>&5 - ac_status=$? - $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 - test $ac_status = 0; }; }; then : - ac_retval=0 -else - $as_echo "$as_me: program exited with status $ac_status" >&5 - $as_echo "$as_me: failed program was:" >&5 -sed 's/^/| /' conftest.$ac_ext >&5 - - ac_retval=$ac_status -fi - rm -rf conftest.dSYM conftest_ipa8_conftest.oo - eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno - as_fn_set_status $ac_retval - -} # ac_fn_c_try_run - -# ac_fn_c_check_header_compile LINENO HEADER VAR INCLUDES -# ------------------------------------------------------- -# Tests whether HEADER exists and can be compiled using the include files in -# INCLUDES, setting the cache variable VAR accordingly. -ac_fn_c_check_header_compile () -{ - as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack - { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $2" >&5 -$as_echo_n "checking for $2... " >&6; } -if eval \${$3+:} false; then : - $as_echo_n "(cached) " >&6 -else - cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ -$4 -#include <$2> -_ACEOF -if ac_fn_c_try_compile "$LINENO"; then : - eval "$3=yes" -else - eval "$3=no" -fi -rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext -fi -eval ac_res=\$$3 - { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_res" >&5 -$as_echo "$ac_res" >&6; } - eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno - -} # ac_fn_c_check_header_compile - -# ac_fn_c_try_link LINENO -# ----------------------- -# Try to link conftest.$ac_ext, and return whether this succeeded. -ac_fn_c_try_link () -{ - as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack - rm -f conftest.$ac_objext conftest$ac_exeext - if { { ac_try="$ac_link" -case "(($ac_try" in - *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; - *) ac_try_echo=$ac_try;; -esac -eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\"" -$as_echo "$ac_try_echo"; } >&5 - (eval "$ac_link") 2>conftest.err - ac_status=$? - if test -s conftest.err; then - grep -v '^ *+' conftest.err >conftest.er1 - cat conftest.er1 >&5 - mv -f conftest.er1 conftest.err - fi - $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 - test $ac_status = 0; } && { - test -z "$ac_c_werror_flag" || - test ! -s conftest.err - } && test -s conftest$ac_exeext && { - test "$cross_compiling" = yes || - test -x conftest$ac_exeext - }; then : - ac_retval=0 -else - $as_echo "$as_me: failed program was:" >&5 -sed 's/^/| /' conftest.$ac_ext >&5 - - ac_retval=1 -fi - # Delete the IPA/IPO (Inter Procedural Analysis/Optimization) information - # created by the PGI compiler (conftest_ipa8_conftest.oo), as it would - # interfere with the next link command; also delete a directory that is - # left behind by Apple's compiler. We do this before executing the actions. - rm -rf conftest.dSYM conftest_ipa8_conftest.oo - eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno - as_fn_set_status $ac_retval - -} # ac_fn_c_try_link - -# ac_fn_c_check_func LINENO FUNC VAR -# ---------------------------------- -# Tests whether FUNC exists, setting the cache variable VAR accordingly -ac_fn_c_check_func () -{ - as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack - { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $2" >&5 -$as_echo_n "checking for $2... " >&6; } -if eval \${$3+:} false; then : - $as_echo_n "(cached) " >&6 -else - cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ -/* Define $2 to an innocuous variant, in case declares $2. - For example, HP-UX 11i declares gettimeofday. */ -#define $2 innocuous_$2 - -/* System header to define __stub macros and hopefully few prototypes, - which can conflict with char $2 (); below. - Prefer to if __STDC__ is defined, since - exists even on freestanding compilers. */ - -#ifdef __STDC__ -# include -#else -# include -#endif - -#undef $2 - -/* Override any GCC internal prototype to avoid an error. - Use char because int might match the return type of a GCC - builtin and then its argument prototype would still apply. */ -#ifdef __cplusplus -extern "C" -#endif -char $2 (); -/* The GNU C library defines this for functions which it implements - to always fail with ENOSYS. Some functions are actually named - something starting with __ and the normal name is an alias. */ -#if defined __stub_$2 || defined __stub___$2 -choke me -#endif - -int -main () -{ -return $2 (); - ; - return 0; -} -_ACEOF -if ac_fn_c_try_link "$LINENO"; then : - eval "$3=yes" -else - eval "$3=no" -fi -rm -f core conftest.err conftest.$ac_objext \ - conftest$ac_exeext conftest.$ac_ext -fi -eval ac_res=\$$3 - { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_res" >&5 -$as_echo "$ac_res" >&6; } - eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno - -} # ac_fn_c_check_func - -# ac_fn_c_check_type LINENO TYPE VAR INCLUDES -# ------------------------------------------- -# Tests whether TYPE exists after having included INCLUDES, setting cache -# variable VAR accordingly. -ac_fn_c_check_type () -{ - as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack - { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $2" >&5 -$as_echo_n "checking for $2... " >&6; } -if eval \${$3+:} false; then : - $as_echo_n "(cached) " >&6 -else - eval "$3=no" - cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ -$4 -int -main () -{ -if (sizeof ($2)) - return 0; - ; - return 0; -} -_ACEOF -if ac_fn_c_try_compile "$LINENO"; then : - cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ -$4 -int -main () -{ -if (sizeof (($2))) - return 0; - ; - return 0; -} -_ACEOF -if ac_fn_c_try_compile "$LINENO"; then : - -else - eval "$3=yes" -fi -rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext -fi -rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext -fi -eval ac_res=\$$3 - { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_res" >&5 -$as_echo "$ac_res" >&6; } - eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno - -} # ac_fn_c_check_type -cat >config.log <<_ACEOF -This file contains any messages produced by compilers while -running configure, to aid debugging if configure makes a mistake. - -It was created by GnuCOBOL $as_me 4.0-early-dev, which was -generated by GNU Autoconf 2.69. Invocation command line was - - $ $0 $@ - -_ACEOF -exec 5>>config.log -{ -cat <<_ASUNAME -## --------- ## -## Platform. ## -## --------- ## - -hostname = `(hostname || uname -n) 2>/dev/null | sed 1q` -uname -m = `(uname -m) 2>/dev/null || echo unknown` -uname -r = `(uname -r) 2>/dev/null || echo unknown` -uname -s = `(uname -s) 2>/dev/null || echo unknown` -uname -v = `(uname -v) 2>/dev/null || echo unknown` - -/usr/bin/uname -p = `(/usr/bin/uname -p) 2>/dev/null || echo unknown` -/bin/uname -X = `(/bin/uname -X) 2>/dev/null || echo unknown` - -/bin/arch = `(/bin/arch) 2>/dev/null || echo unknown` -/usr/bin/arch -k = `(/usr/bin/arch -k) 2>/dev/null || echo unknown` -/usr/convex/getsysinfo = `(/usr/convex/getsysinfo) 2>/dev/null || echo unknown` -/usr/bin/hostinfo = `(/usr/bin/hostinfo) 2>/dev/null || echo unknown` -/bin/machine = `(/bin/machine) 2>/dev/null || echo unknown` -/usr/bin/oslevel = `(/usr/bin/oslevel) 2>/dev/null || echo unknown` -/bin/universe = `(/bin/universe) 2>/dev/null || echo unknown` - -_ASUNAME - -as_save_IFS=$IFS; IFS=$PATH_SEPARATOR -for as_dir in $PATH -do - IFS=$as_save_IFS - test -z "$as_dir" && as_dir=. - $as_echo "PATH: $as_dir" - done -IFS=$as_save_IFS - -} >&5 - -cat >&5 <<_ACEOF - - -## ----------- ## -## Core tests. ## -## ----------- ## - -_ACEOF - - -# Keep a trace of the command line. -# Strip out --no-create and --no-recursion so they do not pile up. -# Strip out --silent because we don't want to record it for future runs. -# Also quote any args containing shell meta-characters. -# Make two passes to allow for proper duplicate-argument suppression. -ac_configure_args= -ac_configure_args0= -ac_configure_args1= -ac_must_keep_next=false -for ac_pass in 1 2 -do - for ac_arg - do - case $ac_arg in - -no-create | --no-c* | -n | -no-recursion | --no-r*) continue ;; - -q | -quiet | --quiet | --quie | --qui | --qu | --q \ - | -silent | --silent | --silen | --sile | --sil) - continue ;; - *\'*) - ac_arg=`$as_echo "$ac_arg" | sed "s/'/'\\\\\\\\''/g"` ;; - esac - case $ac_pass in - 1) as_fn_append ac_configure_args0 " '$ac_arg'" ;; - 2) - as_fn_append ac_configure_args1 " '$ac_arg'" - if test $ac_must_keep_next = true; then - ac_must_keep_next=false # Got value, back to normal. - else - case $ac_arg in - *=* | --config-cache | -C | -disable-* | --disable-* \ - | -enable-* | --enable-* | -gas | --g* | -nfp | --nf* \ - | -q | -quiet | --q* | -silent | --sil* | -v | -verb* \ - | -with-* | --with-* | -without-* | --without-* | --x) - case "$ac_configure_args0 " in - "$ac_configure_args1"*" '$ac_arg' "* ) continue ;; - esac - ;; - -* ) ac_must_keep_next=true ;; - esac - fi - as_fn_append ac_configure_args " '$ac_arg'" - ;; - esac - done -done -{ ac_configure_args0=; unset ac_configure_args0;} -{ ac_configure_args1=; unset ac_configure_args1;} - -# When interrupted or exit'd, cleanup temporary files, and complete -# config.log. We remove comments because anyway the quotes in there -# would cause problems or look ugly. -# WARNING: Use '\'' to represent an apostrophe within the trap. -# WARNING: Do not start the trap code with a newline, due to a FreeBSD 4.0 bug. -trap 'exit_status=$? - # Save into config.log some information that might help in debugging. - { - echo - - $as_echo "## ---------------- ## -## Cache variables. ## -## ---------------- ##" - echo - # The following way of writing the cache mishandles newlines in values, -( - for ac_var in `(set) 2>&1 | sed -n '\''s/^\([a-zA-Z_][a-zA-Z0-9_]*\)=.*/\1/p'\''`; do - eval ac_val=\$$ac_var - case $ac_val in #( - *${as_nl}*) - case $ac_var in #( - *_cv_*) { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: cache variable $ac_var contains a newline" >&5 -$as_echo "$as_me: WARNING: cache variable $ac_var contains a newline" >&2;} ;; - esac - case $ac_var in #( - _ | IFS | as_nl) ;; #( - BASH_ARGV | BASH_SOURCE) eval $ac_var= ;; #( - *) { eval $ac_var=; unset $ac_var;} ;; - esac ;; - esac - done - (set) 2>&1 | - case $as_nl`(ac_space='\'' '\''; set) 2>&1` in #( - *${as_nl}ac_space=\ *) - sed -n \ - "s/'\''/'\''\\\\'\'''\''/g; - s/^\\([_$as_cr_alnum]*_cv_[_$as_cr_alnum]*\\)=\\(.*\\)/\\1='\''\\2'\''/p" - ;; #( - *) - sed -n "/^[_$as_cr_alnum]*_cv_[_$as_cr_alnum]*=/p" - ;; - esac | - sort -) - echo - - $as_echo "## ----------------- ## -## Output variables. ## -## ----------------- ##" - echo - for ac_var in $ac_subst_vars - do - eval ac_val=\$$ac_var - case $ac_val in - *\'\''*) ac_val=`$as_echo "$ac_val" | sed "s/'\''/'\''\\\\\\\\'\'''\''/g"`;; - esac - $as_echo "$ac_var='\''$ac_val'\''" - done | sort - echo - - if test -n "$ac_subst_files"; then - $as_echo "## ------------------- ## -## File substitutions. ## -## ------------------- ##" - echo - for ac_var in $ac_subst_files - do - eval ac_val=\$$ac_var - case $ac_val in - *\'\''*) ac_val=`$as_echo "$ac_val" | sed "s/'\''/'\''\\\\\\\\'\'''\''/g"`;; - esac - $as_echo "$ac_var='\''$ac_val'\''" - done | sort - echo - fi - - if test -s confdefs.h; then - $as_echo "## ----------- ## -## confdefs.h. ## -## ----------- ##" - echo - cat confdefs.h - echo - fi - test "$ac_signal" != 0 && - $as_echo "$as_me: caught signal $ac_signal" - $as_echo "$as_me: exit $exit_status" - } >&5 - rm -f core *.core core.conftest.* && - rm -f -r conftest* confdefs* conf$$* $ac_clean_files && - exit $exit_status -' 0 -for ac_signal in 1 2 13 15; do - trap 'ac_signal='$ac_signal'; as_fn_exit 1' $ac_signal -done -ac_signal=0 - -# confdefs.h avoids OS command line length limits that DEFS can exceed. -rm -f -r conftest* confdefs.h - -$as_echo "/* confdefs.h */" > confdefs.h - -# Predefined preprocessor variables. - -cat >>confdefs.h <<_ACEOF -#define PACKAGE_NAME "$PACKAGE_NAME" -_ACEOF - -cat >>confdefs.h <<_ACEOF -#define PACKAGE_TARNAME "$PACKAGE_TARNAME" -_ACEOF - -cat >>confdefs.h <<_ACEOF -#define PACKAGE_VERSION "$PACKAGE_VERSION" -_ACEOF - -cat >>confdefs.h <<_ACEOF -#define PACKAGE_STRING "$PACKAGE_STRING" -_ACEOF - -cat >>confdefs.h <<_ACEOF -#define PACKAGE_BUGREPORT "$PACKAGE_BUGREPORT" -_ACEOF - -cat >>confdefs.h <<_ACEOF -#define PACKAGE_URL "$PACKAGE_URL" -_ACEOF - - -# Let the site file select an alternate cache file if it wants to. -# Prefer an explicitly selected file to automatically selected ones. -ac_site_file1=NONE -ac_site_file2=NONE -if test -n "$CONFIG_SITE"; then - # We do not want a PATH search for config.site. - case $CONFIG_SITE in #(( - -*) ac_site_file1=./$CONFIG_SITE;; - */*) ac_site_file1=$CONFIG_SITE;; - *) ac_site_file1=./$CONFIG_SITE;; - esac -elif test "x$prefix" != xNONE; then - ac_site_file1=$prefix/share/config.site - ac_site_file2=$prefix/etc/config.site -else - ac_site_file1=$ac_default_prefix/share/config.site - ac_site_file2=$ac_default_prefix/etc/config.site -fi -for ac_site_file in "$ac_site_file1" "$ac_site_file2" -do - test "x$ac_site_file" = xNONE && continue - if test /dev/null != "$ac_site_file" && test -r "$ac_site_file"; then - { $as_echo "$as_me:${as_lineno-$LINENO}: loading site script $ac_site_file" >&5 -$as_echo "$as_me: loading site script $ac_site_file" >&6;} - sed 's/^/| /' "$ac_site_file" >&5 - . "$ac_site_file" \ - || { { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 -$as_echo "$as_me: error: in \`$ac_pwd':" >&2;} -as_fn_error $? "failed to load site script $ac_site_file -See \`config.log' for more details" "$LINENO" 5; } - fi -done - -if test -r "$cache_file"; then - # Some versions of bash will fail to source /dev/null (special files - # actually), so we avoid doing that. DJGPP emulates it as a regular file. - if test /dev/null != "$cache_file" && test -f "$cache_file"; then - { $as_echo "$as_me:${as_lineno-$LINENO}: loading cache $cache_file" >&5 -$as_echo "$as_me: loading cache $cache_file" >&6;} - case $cache_file in - [\\/]* | ?:[\\/]* ) . "$cache_file";; - *) . "./$cache_file";; - esac - fi -else - { $as_echo "$as_me:${as_lineno-$LINENO}: creating cache $cache_file" >&5 -$as_echo "$as_me: creating cache $cache_file" >&6;} - >$cache_file -fi - -gt_needs="$gt_needs " -# Check that the precious variables saved in the cache have kept the same -# value. -ac_cache_corrupted=false -for ac_var in $ac_precious_vars; do - eval ac_old_set=\$ac_cv_env_${ac_var}_set - eval ac_new_set=\$ac_env_${ac_var}_set - eval ac_old_val=\$ac_cv_env_${ac_var}_value - eval ac_new_val=\$ac_env_${ac_var}_value - case $ac_old_set,$ac_new_set in - set,) - { $as_echo "$as_me:${as_lineno-$LINENO}: error: \`$ac_var' was set to \`$ac_old_val' in the previous run" >&5 -$as_echo "$as_me: error: \`$ac_var' was set to \`$ac_old_val' in the previous run" >&2;} - ac_cache_corrupted=: ;; - ,set) - { $as_echo "$as_me:${as_lineno-$LINENO}: error: \`$ac_var' was not set in the previous run" >&5 -$as_echo "$as_me: error: \`$ac_var' was not set in the previous run" >&2;} - ac_cache_corrupted=: ;; - ,);; - *) - if test "x$ac_old_val" != "x$ac_new_val"; then - # differences in whitespace do not lead to failure. - ac_old_val_w=`echo x $ac_old_val` - ac_new_val_w=`echo x $ac_new_val` - if test "$ac_old_val_w" != "$ac_new_val_w"; then - { $as_echo "$as_me:${as_lineno-$LINENO}: error: \`$ac_var' has changed since the previous run:" >&5 -$as_echo "$as_me: error: \`$ac_var' has changed since the previous run:" >&2;} - ac_cache_corrupted=: - else - { $as_echo "$as_me:${as_lineno-$LINENO}: warning: ignoring whitespace changes in \`$ac_var' since the previous run:" >&5 -$as_echo "$as_me: warning: ignoring whitespace changes in \`$ac_var' since the previous run:" >&2;} - eval $ac_var=\$ac_old_val - fi - { $as_echo "$as_me:${as_lineno-$LINENO}: former value: \`$ac_old_val'" >&5 -$as_echo "$as_me: former value: \`$ac_old_val'" >&2;} - { $as_echo "$as_me:${as_lineno-$LINENO}: current value: \`$ac_new_val'" >&5 -$as_echo "$as_me: current value: \`$ac_new_val'" >&2;} - fi;; - esac - # Pass precious variables to config.status. - if test "$ac_new_set" = set; then - case $ac_new_val in - *\'*) ac_arg=$ac_var=`$as_echo "$ac_new_val" | sed "s/'/'\\\\\\\\''/g"` ;; - *) ac_arg=$ac_var=$ac_new_val ;; - esac - case " $ac_configure_args " in - *" '$ac_arg' "*) ;; # Avoid dups. Use of quotes ensures accuracy. - *) as_fn_append ac_configure_args " '$ac_arg'" ;; - esac - fi -done -if $ac_cache_corrupted; then - { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 -$as_echo "$as_me: error: in \`$ac_pwd':" >&2;} - { $as_echo "$as_me:${as_lineno-$LINENO}: error: changes in the environment can compromise the build" >&5 -$as_echo "$as_me: error: changes in the environment can compromise the build" >&2;} - as_fn_error $? "run \`make distclean' and/or \`rm $cache_file' and start over" "$LINENO" 5 -fi -## -------------------- ## -## Main body of script. ## -## -------------------- ## - -ac_ext=c -ac_cpp='$CPP $CPPFLAGS' -ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' -ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' -ac_compiler_gnu=$ac_cv_c_compiler_gnu - - - - -ac_config_headers="$ac_config_headers config.h" - -ac_config_commands="$ac_config_commands tests/atconfig" - - -ac_aux_dir= -for ac_dir in build_aux "$srcdir"/build_aux; do - if test -f "$ac_dir/install-sh"; then - ac_aux_dir=$ac_dir - ac_install_sh="$ac_aux_dir/install-sh -c" - break - elif test -f "$ac_dir/install.sh"; then - ac_aux_dir=$ac_dir - ac_install_sh="$ac_aux_dir/install.sh -c" - break - elif test -f "$ac_dir/shtool"; then - ac_aux_dir=$ac_dir - ac_install_sh="$ac_aux_dir/shtool install -c" - break - fi -done -if test -z "$ac_aux_dir"; then - as_fn_error $? "cannot find install-sh, install.sh, or shtool in build_aux \"$srcdir\"/build_aux" "$LINENO" 5 -fi - -# These three variables are undocumented and unsupported, -# and are intended to be withdrawn in a future Autoconf release. -# They can cause serious problems if a builder's source tree is in a directory -# whose full name contains unusual characters. -ac_config_guess="$SHELL $ac_aux_dir/config.guess" # Please don't use this var. -ac_config_sub="$SHELL $ac_aux_dir/config.sub" # Please don't use this var. -ac_configure="$SHELL $ac_aux_dir/configure" # Please don't use this var. - - - -ac_config_files="$ac_config_files Makefile libcob/Makefile lib/Makefile cobc/Makefile bin/Makefile po/Makefile.in doc/Makefile config/Makefile copy/Makefile tests/Makefile tests/cobol85/Makefile extras/Makefile" - - -ac_config_files="$ac_config_files bin/cob-config" - -ac_config_files="$ac_config_files pre-inst-env:build_aux/pre-inst-env.in" - -ac_config_files="$ac_config_files tests/atlocal" - -ac_config_files="$ac_config_files tests/run_prog_manual.sh" - - -# Note for SUN Solaris (gcc) -# export/setenv CFLAGS "-m64 -mptr64" -# export/setenv LDFLAGS "-m64 -mptr64 -L/usr/local/lib/sparcv9" -# ./configure --libdir=/usr/local/lib/sparcv9 -# -# Hack for AIX 64 bit (gcc) -# Required - -# export/setenv CFLAGS=-maix64 -# export/setenv LDFLAGS=-maix64 - -if echo $CFLAGS | grep 'aix64' 1>/dev/null 2>&1; then - if test -f /usr/ccs/bin/ar; then - AR="/usr/ccs/bin/ar -X64" - else - AR="ar -X64" - fi - NM="/usr/ccs/bin/nm -X64 -B" -fi - -am__api_version='1.15' - -# Find a good install program. We prefer a C program (faster), -# so one script is as good as another. But avoid the broken or -# incompatible versions: -# SysV /etc/install, /usr/sbin/install -# SunOS /usr/etc/install -# IRIX /sbin/install -# AIX /bin/install -# AmigaOS /C/install, which installs bootblocks on floppy discs -# AIX 4 /usr/bin/installbsd, which doesn't work without a -g flag -# AFS /usr/afsws/bin/install, which mishandles nonexistent args -# SVR4 /usr/ucb/install, which tries to use the nonexistent group "staff" -# OS/2's system install, which has a completely different semantic -# ./install, which can be erroneously created by make from ./install.sh. -# Reject install programs that cannot install multiple files. -{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for a BSD-compatible install" >&5 -$as_echo_n "checking for a BSD-compatible install... " >&6; } -if test -z "$INSTALL"; then -if ${ac_cv_path_install+:} false; then : - $as_echo_n "(cached) " >&6 -else - as_save_IFS=$IFS; IFS=$PATH_SEPARATOR -for as_dir in $PATH -do - IFS=$as_save_IFS - test -z "$as_dir" && as_dir=. - # Account for people who put trailing slashes in PATH elements. -case $as_dir/ in #(( - ./ | .// | /[cC]/* | \ - /etc/* | /usr/sbin/* | /usr/etc/* | /sbin/* | /usr/afsws/bin/* | \ - ?:[\\/]os2[\\/]install[\\/]* | ?:[\\/]OS2[\\/]INSTALL[\\/]* | \ - /usr/ucb/* ) ;; - *) - # OSF1 and SCO ODT 3.0 have their own names for install. - # Don't use installbsd from OSF since it installs stuff as root - # by default. - for ac_prog in ginstall scoinst install; do - for ac_exec_ext in '' $ac_executable_extensions; do - if as_fn_executable_p "$as_dir/$ac_prog$ac_exec_ext"; then - if test $ac_prog = install && - grep dspmsg "$as_dir/$ac_prog$ac_exec_ext" >/dev/null 2>&1; then - # AIX install. It has an incompatible calling convention. - : - elif test $ac_prog = install && - grep pwplus "$as_dir/$ac_prog$ac_exec_ext" >/dev/null 2>&1; then - # program-specific install script used by HP pwplus--don't use. - : - else - rm -rf conftest.one conftest.two conftest.dir - echo one > conftest.one - echo two > conftest.two - mkdir conftest.dir - if "$as_dir/$ac_prog$ac_exec_ext" -c conftest.one conftest.two "`pwd`/conftest.dir" && - test -s conftest.one && test -s conftest.two && - test -s conftest.dir/conftest.one && - test -s conftest.dir/conftest.two - then - ac_cv_path_install="$as_dir/$ac_prog$ac_exec_ext -c" - break 3 - fi - fi - fi - done - done - ;; -esac - - done -IFS=$as_save_IFS - -rm -rf conftest.one conftest.two conftest.dir - -fi - if test "${ac_cv_path_install+set}" = set; then - INSTALL=$ac_cv_path_install - else - # As a last resort, use the slow shell script. Don't cache a - # value for INSTALL within a source directory, because that will - # break other packages using the cache if that directory is - # removed, or if the value is a relative name. - INSTALL=$ac_install_sh - fi -fi -{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $INSTALL" >&5 -$as_echo "$INSTALL" >&6; } - -# Use test -z because SunOS4 sh mishandles braces in ${var-val}. -# It thinks the first close brace ends the variable substitution. -test -z "$INSTALL_PROGRAM" && INSTALL_PROGRAM='${INSTALL}' - -test -z "$INSTALL_SCRIPT" && INSTALL_SCRIPT='${INSTALL}' - -test -z "$INSTALL_DATA" && INSTALL_DATA='${INSTALL} -m 644' - -{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether build environment is sane" >&5 -$as_echo_n "checking whether build environment is sane... " >&6; } -# Reject unsafe characters in $srcdir or the absolute working directory -# name. Accept space and tab only in the latter. -am_lf=' -' -case `pwd` in - *[\\\"\#\$\&\'\`$am_lf]*) - as_fn_error $? "unsafe absolute working directory name" "$LINENO" 5;; -esac -case $srcdir in - *[\\\"\#\$\&\'\`$am_lf\ \ ]*) - as_fn_error $? "unsafe srcdir value: '$srcdir'" "$LINENO" 5;; -esac - -# Do 'set' in a subshell so we don't clobber the current shell's -# arguments. Must try -L first in case configure is actually a -# symlink; some systems play weird games with the mod time of symlinks -# (eg FreeBSD returns the mod time of the symlink's containing -# directory). -if ( - am_has_slept=no - for am_try in 1 2; do - echo "timestamp, slept: $am_has_slept" > conftest.file - set X `ls -Lt "$srcdir/configure" conftest.file 2> /dev/null` - if test "$*" = "X"; then - # -L didn't work. - set X `ls -t "$srcdir/configure" conftest.file` - fi - if test "$*" != "X $srcdir/configure conftest.file" \ - && test "$*" != "X conftest.file $srcdir/configure"; then - - # If neither matched, then we have a broken ls. This can happen - # if, for instance, CONFIG_SHELL is bash and it inherits a - # broken ls alias from the environment. This has actually - # happened. Such a system could not be considered "sane". - as_fn_error $? "ls -t appears to fail. Make sure there is not a broken - alias in your environment" "$LINENO" 5 - fi - if test "$2" = conftest.file || test $am_try -eq 2; then - break - fi - # Just in case. - sleep 1 - am_has_slept=yes - done - test "$2" = conftest.file - ) -then - # Ok. - : -else - as_fn_error $? "newly created file is older than distributed files! -Check your system clock" "$LINENO" 5 -fi -{ $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5 -$as_echo "yes" >&6; } -# If we didn't sleep, we still need to ensure time stamps of config.status and -# generated files are strictly newer. -am_sleep_pid= -if grep 'slept: no' conftest.file >/dev/null 2>&1; then - ( sleep 1 ) & - am_sleep_pid=$! -fi - -rm -f conftest.file - -test "$program_prefix" != NONE && - program_transform_name="s&^&$program_prefix&;$program_transform_name" -# Use a double $ so make ignores it. -test "$program_suffix" != NONE && - program_transform_name="s&\$&$program_suffix&;$program_transform_name" -# Double any \ or $. -# By default was `s,x,x', remove it if useless. -ac_script='s/[\\$]/&&/g;s/;s,x,x,$//' -program_transform_name=`$as_echo "$program_transform_name" | sed "$ac_script"` - -# Expand $ac_aux_dir to an absolute path. -am_aux_dir=`cd "$ac_aux_dir" && pwd` - -if test x"${MISSING+set}" != xset; then - case $am_aux_dir in - *\ * | *\ *) - MISSING="\${SHELL} \"$am_aux_dir/missing\"" ;; - *) - MISSING="\${SHELL} $am_aux_dir/missing" ;; - esac -fi -# Use eval to expand $SHELL -if eval "$MISSING --is-lightweight"; then - am_missing_run="$MISSING " -else - am_missing_run= - { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: 'missing' script is too old or missing" >&5 -$as_echo "$as_me: WARNING: 'missing' script is too old or missing" >&2;} -fi - -if test x"${install_sh+set}" != xset; then - case $am_aux_dir in - *\ * | *\ *) - install_sh="\${SHELL} '$am_aux_dir/install-sh'" ;; - *) - install_sh="\${SHELL} $am_aux_dir/install-sh" - esac -fi - -# Installed binaries are usually stripped using 'strip' when the user -# run "make install-strip". However 'strip' might not be the right -# tool to use in cross-compilation environments, therefore Automake -# will honor the 'STRIP' environment variable to overrule this program. -if test "$cross_compiling" != no; then - if test -n "$ac_tool_prefix"; then - # Extract the first word of "${ac_tool_prefix}strip", so it can be a program name with args. -set dummy ${ac_tool_prefix}strip; ac_word=$2 -{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 -$as_echo_n "checking for $ac_word... " >&6; } -if ${ac_cv_prog_STRIP+:} false; then : - $as_echo_n "(cached) " >&6 -else - if test -n "$STRIP"; then - ac_cv_prog_STRIP="$STRIP" # Let the user override the test. -else -as_save_IFS=$IFS; IFS=$PATH_SEPARATOR -for as_dir in $PATH -do - IFS=$as_save_IFS - test -z "$as_dir" && as_dir=. - for ac_exec_ext in '' $ac_executable_extensions; do - if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then - ac_cv_prog_STRIP="${ac_tool_prefix}strip" - $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 - break 2 - fi -done - done -IFS=$as_save_IFS - -fi -fi -STRIP=$ac_cv_prog_STRIP -if test -n "$STRIP"; then - { $as_echo "$as_me:${as_lineno-$LINENO}: result: $STRIP" >&5 -$as_echo "$STRIP" >&6; } -else - { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 -$as_echo "no" >&6; } -fi - - -fi -if test -z "$ac_cv_prog_STRIP"; then - ac_ct_STRIP=$STRIP - # Extract the first word of "strip", so it can be a program name with args. -set dummy strip; ac_word=$2 -{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 -$as_echo_n "checking for $ac_word... " >&6; } -if ${ac_cv_prog_ac_ct_STRIP+:} false; then : - $as_echo_n "(cached) " >&6 -else - if test -n "$ac_ct_STRIP"; then - ac_cv_prog_ac_ct_STRIP="$ac_ct_STRIP" # Let the user override the test. -else -as_save_IFS=$IFS; IFS=$PATH_SEPARATOR -for as_dir in $PATH -do - IFS=$as_save_IFS - test -z "$as_dir" && as_dir=. - for ac_exec_ext in '' $ac_executable_extensions; do - if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then - ac_cv_prog_ac_ct_STRIP="strip" - $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 - break 2 - fi -done - done -IFS=$as_save_IFS - -fi -fi -ac_ct_STRIP=$ac_cv_prog_ac_ct_STRIP -if test -n "$ac_ct_STRIP"; then - { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_ct_STRIP" >&5 -$as_echo "$ac_ct_STRIP" >&6; } -else - { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 -$as_echo "no" >&6; } -fi - - if test "x$ac_ct_STRIP" = x; then - STRIP=":" - else - case $cross_compiling:$ac_tool_warned in -yes:) -{ $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5 -$as_echo "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;} -ac_tool_warned=yes ;; -esac - STRIP=$ac_ct_STRIP - fi -else - STRIP="$ac_cv_prog_STRIP" -fi - -fi -INSTALL_STRIP_PROGRAM="\$(install_sh) -c -s" - -{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for a thread-safe mkdir -p" >&5 -$as_echo_n "checking for a thread-safe mkdir -p... " >&6; } -if test -z "$MKDIR_P"; then - if ${ac_cv_path_mkdir+:} false; then : - $as_echo_n "(cached) " >&6 -else - as_save_IFS=$IFS; IFS=$PATH_SEPARATOR -for as_dir in $PATH$PATH_SEPARATOR/opt/sfw/bin -do - IFS=$as_save_IFS - test -z "$as_dir" && as_dir=. - for ac_prog in mkdir gmkdir; do - for ac_exec_ext in '' $ac_executable_extensions; do - as_fn_executable_p "$as_dir/$ac_prog$ac_exec_ext" || continue - case `"$as_dir/$ac_prog$ac_exec_ext" --version 2>&1` in #( - 'mkdir (GNU coreutils) '* | \ - 'mkdir (coreutils) '* | \ - 'mkdir (fileutils) '4.1*) - ac_cv_path_mkdir=$as_dir/$ac_prog$ac_exec_ext - break 3;; - esac - done - done - done -IFS=$as_save_IFS - -fi - - test -d ./--version && rmdir ./--version - if test "${ac_cv_path_mkdir+set}" = set; then - MKDIR_P="$ac_cv_path_mkdir -p" - else - # As a last resort, use the slow shell script. Don't cache a - # value for MKDIR_P within a source directory, because that will - # break other packages using the cache if that directory is - # removed, or if the value is a relative name. - MKDIR_P="$ac_install_sh -d" - fi -fi -{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $MKDIR_P" >&5 -$as_echo "$MKDIR_P" >&6; } - -for ac_prog in gawk mawk nawk awk -do - # Extract the first word of "$ac_prog", so it can be a program name with args. -set dummy $ac_prog; ac_word=$2 -{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 -$as_echo_n "checking for $ac_word... " >&6; } -if ${ac_cv_prog_AWK+:} false; then : - $as_echo_n "(cached) " >&6 -else - if test -n "$AWK"; then - ac_cv_prog_AWK="$AWK" # Let the user override the test. -else -as_save_IFS=$IFS; IFS=$PATH_SEPARATOR -for as_dir in $PATH -do - IFS=$as_save_IFS - test -z "$as_dir" && as_dir=. - for ac_exec_ext in '' $ac_executable_extensions; do - if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then - ac_cv_prog_AWK="$ac_prog" - $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 - break 2 - fi -done - done -IFS=$as_save_IFS - -fi -fi -AWK=$ac_cv_prog_AWK -if test -n "$AWK"; then - { $as_echo "$as_me:${as_lineno-$LINENO}: result: $AWK" >&5 -$as_echo "$AWK" >&6; } -else - { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 -$as_echo "no" >&6; } -fi - - - test -n "$AWK" && break -done - -{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether ${MAKE-make} sets \$(MAKE)" >&5 -$as_echo_n "checking whether ${MAKE-make} sets \$(MAKE)... " >&6; } -set x ${MAKE-make} -ac_make=`$as_echo "$2" | sed 's/+/p/g; s/[^a-zA-Z0-9_]/_/g'` -if eval \${ac_cv_prog_make_${ac_make}_set+:} false; then : - $as_echo_n "(cached) " >&6 -else - cat >conftest.make <<\_ACEOF -SHELL = /bin/sh -all: - @echo '@@@%%%=$(MAKE)=@@@%%%' -_ACEOF -# GNU make sometimes prints "make[1]: Entering ...", which would confuse us. -case `${MAKE-make} -f conftest.make 2>/dev/null` in - *@@@%%%=?*=@@@%%%*) - eval ac_cv_prog_make_${ac_make}_set=yes;; - *) - eval ac_cv_prog_make_${ac_make}_set=no;; -esac -rm -f conftest.make -fi -if eval test \$ac_cv_prog_make_${ac_make}_set = yes; then - { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5 -$as_echo "yes" >&6; } - SET_MAKE= -else - { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 -$as_echo "no" >&6; } - SET_MAKE="MAKE=${MAKE-make}" -fi - -rm -rf .tst 2>/dev/null -mkdir .tst 2>/dev/null -if test -d .tst; then - am__leading_dot=. -else - am__leading_dot=_ -fi -rmdir .tst 2>/dev/null - -# Check whether --enable-silent-rules was given. -if test "${enable_silent_rules+set}" = set; then : - enableval=$enable_silent_rules; -fi - -case $enable_silent_rules in # ((( - yes) AM_DEFAULT_VERBOSITY=0;; - no) AM_DEFAULT_VERBOSITY=1;; - *) AM_DEFAULT_VERBOSITY=1;; -esac -am_make=${MAKE-make} -{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether $am_make supports nested variables" >&5 -$as_echo_n "checking whether $am_make supports nested variables... " >&6; } -if ${am_cv_make_support_nested_variables+:} false; then : - $as_echo_n "(cached) " >&6 -else - if $as_echo 'TRUE=$(BAR$(V)) -BAR0=false -BAR1=true -V=1 -am__doit: - @$(TRUE) -.PHONY: am__doit' | $am_make -f - >/dev/null 2>&1; then - am_cv_make_support_nested_variables=yes -else - am_cv_make_support_nested_variables=no -fi -fi -{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $am_cv_make_support_nested_variables" >&5 -$as_echo "$am_cv_make_support_nested_variables" >&6; } -if test $am_cv_make_support_nested_variables = yes; then - AM_V='$(V)' - AM_DEFAULT_V='$(AM_DEFAULT_VERBOSITY)' -else - AM_V=$AM_DEFAULT_VERBOSITY - AM_DEFAULT_V=$AM_DEFAULT_VERBOSITY -fi -AM_BACKSLASH='\' - -if test "`cd $srcdir && pwd`" != "`pwd`"; then - # Use -I$(srcdir) only when $(srcdir) != ., so that make's output - # is not polluted with repeated "-I." - am__isrc=' -I$(srcdir)' - # test to see if srcdir already configured - if test -f $srcdir/config.status; then - as_fn_error $? "source directory already configured; run \"make distclean\" there first" "$LINENO" 5 - fi -fi - -# test whether we have cygpath -if test -z "$CYGPATH_W"; then - if (cygpath --version) >/dev/null 2>/dev/null; then - CYGPATH_W='cygpath -w' - else - CYGPATH_W=echo - fi -fi - - -# Define the identity of the package. - PACKAGE='gnucobol' - VERSION='4.0-early-dev' - - -cat >>confdefs.h <<_ACEOF -#define PACKAGE "$PACKAGE" -_ACEOF - - -cat >>confdefs.h <<_ACEOF -#define VERSION "$VERSION" -_ACEOF - -# Some tools Automake needs. - -ACLOCAL=${ACLOCAL-"${am_missing_run}aclocal-${am__api_version}"} - - -AUTOCONF=${AUTOCONF-"${am_missing_run}autoconf"} - - -AUTOMAKE=${AUTOMAKE-"${am_missing_run}automake-${am__api_version}"} - - -AUTOHEADER=${AUTOHEADER-"${am_missing_run}autoheader"} - - -MAKEINFO=${MAKEINFO-"${am_missing_run}makeinfo"} - -# For better backward compatibility. To be removed once Automake 1.9.x -# dies out for good. For more background, see: -# -# -mkdir_p='$(MKDIR_P)' - -# We need awk for the "check" target (and possibly the TAP driver). The -# system "awk" is bad on some platforms. -# Always define AMTAR for backward compatibility. Yes, it's still used -# in the wild :-( We should find a proper way to deprecate it ... -AMTAR='$${TAR-tar}' - - -# We'll loop over all known methods to create a tar archive until one works. -_am_tools='gnutar pax cpio none' - -am__tar='$${TAR-tar} chof - "$$tardir"' am__untar='$${TAR-tar} xf -' - - - - - - -# POSIX will say in a future version that running "rm -f" with no argument -# is OK; and we want to be able to make that assumption in our Makefile -# recipes. So use an aggressive probe to check that the usage we want is -# actually supported "in the wild" to an acceptable degree. -# See automake bug#10828. -# To make any issue more visible, cause the running configure to be aborted -# by default if the 'rm' program in use doesn't match our expectations; the -# user can still override this though. -if rm -f && rm -fr && rm -rf; then : OK; else - cat >&2 <<'END' -Oops! - -Your 'rm' program seems unable to run without file operands specified -on the command line, even when the '-f' option is present. This is contrary -to the behaviour of most rm programs out there, and not conforming with -the upcoming POSIX standard: - -Please tell bug-automake@gnu.org about your system, including the value -of your $PATH and any error possibly output before this message. This -can help us improve future automake versions. - -END - if test x"$ACCEPT_INFERIOR_RM_PROGRAM" = x"yes"; then - echo 'Configuration will proceed anyway, since you have set the' >&2 - echo 'ACCEPT_INFERIOR_RM_PROGRAM variable to "yes"' >&2 - echo >&2 - else - cat >&2 <<'END' -Aborting the configuration process, to ensure you take notice of the issue. - -You can download and install GNU coreutils to get an 'rm' implementation -that behaves properly: . - -If you want to complete the configuration process using your problematic -'rm' anyway, export the environment variable ACCEPT_INFERIOR_RM_PROGRAM -to "yes", and re-run configure. - -END - as_fn_error $? "Your 'rm' program is bad, sorry." "$LINENO" 5 - fi -fi - - -# Autoheader templates - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -#AH_TEMPLATE([HAVE_RAISE], [Has raise function]) - - -# Configure options part I (not needing any compilation) - -# Check whether --enable-debug was given. -if test "${enable_debug+set}" = set; then : - enableval=$enable_debug; -else - enable_debug=no -fi - - -# Check whether --enable-experimental was given. -if test "${enable_experimental+set}" = set; then : - enableval=$enable_experimental; if test "$enable_experimental" = "yes"; then - $as_echo "#define COB_EXPERIMENTAL 1" >>confdefs.h - - fi -fi - - -# Check whether --enable-cobc-internal-checks was given. -if test "${enable_cobc_internal_checks+set}" = set; then : - enableval=$enable_cobc_internal_checks; if test "$enable_cobc_internal_checks" = "yes"; then - $as_echo "#define COB_TREE_DEBUG 1" >>confdefs.h - - fi -fi - - -# Check whether --enable-debuglog was given. -if test "${enable_debuglog+set}" = set; then : - enableval=$enable_debuglog; if test "$enable_debuglog" = "yes"; then - $as_echo "#define COB_DEBUG_LOG 1" >>confdefs.h - - fi -fi - - -# Check whether --enable-param-check was given. -if test "${enable_param_check+set}" = set; then : - enableval=$enable_param_check; if test "$enable_param_check" = "yes"; then - $as_echo "#define COB_PARAM_CHECK 1" >>confdefs.h - - fi -fi - - - -# Check whether --with-patch-level was given. -if test "${with_patch_level+set}" = set; then : - withval=$with_patch_level; case $with_patch_level in - yes) as_fn_error $? "You must give --with-patch-level an argument." "$LINENO" 5 - ;; - no) as_fn_error $? "--without-patch-level not supported." "$LINENO" 5 - ;; - [0-9]*) - if test $with_patch_level -gt 99999999; then - as_fn_error $? "Patch level must not contain more than 8 digits" "$LINENO" 5 - fi - ;; - *) as_fn_error $? "You must use a numeric patch level" "$LINENO" 5 - ;; - esac -else - with_patch_level=0 -fi - - -cat >>confdefs.h <<_ACEOF -#define PATCH_LEVEL $with_patch_level -_ACEOF - - - -# Check whether --with-max-call-params was given. -if test "${with_max_call_params+set}" = set; then : - withval=$with_max_call_params; case $with_max_call_params in - yes) as_fn_error $? "You must give --with-max-call-params an argument." "$LINENO" 5 - ;; - no) as_fn_error $? "--without-max-call-params not supported." "$LINENO" 5 - ;; - 16 | 36 | 56 | 76 | 96 | 192 | 252) - ;; - *) as_fn_error $? "Maximum number of parameters for CALL must be one of 16/36/56/76/96/192/252" "$LINENO" 5 - ;; - esac -else - with_max_call_params=192 -fi - - -cat >>confdefs.h <<_ACEOF -#define MAX_CALL_FIELD_PARAMS $with_max_call_params -_ACEOF - - - -# Basic capability tests - -configured_make="" -if test -z "$MAKE"; then - for ac_prog in make gmake gnumake -do - # Extract the first word of "$ac_prog", so it can be a program name with args. -set dummy $ac_prog; ac_word=$2 -{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 -$as_echo_n "checking for $ac_word... " >&6; } -if ${ac_cv_prog_configured_make+:} false; then : - $as_echo_n "(cached) " >&6 -else - if test -n "$configured_make"; then - ac_cv_prog_configured_make="$configured_make" # Let the user override the test. -else -as_save_IFS=$IFS; IFS=$PATH_SEPARATOR -for as_dir in $PATH -do - IFS=$as_save_IFS - test -z "$as_dir" && as_dir=. - for ac_exec_ext in '' $ac_executable_extensions; do - if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then - ac_cv_prog_configured_make="$ac_prog" - $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 - break 2 - fi -done - done -IFS=$as_save_IFS - -fi -fi -configured_make=$ac_cv_prog_configured_make -if test -n "$configured_make"; then - { $as_echo "$as_me:${as_lineno-$LINENO}: result: $configured_make" >&5 -$as_echo "$configured_make" >&6; } -else - { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 -$as_echo "no" >&6; } -fi - - - test -n "$configured_make" && break -done - - if test -z "$configured_make"; then - as_fn_error $? "make not found" "$LINENO" 5 - else - MAKE=$configured_make - - fi -else - # Extract the first word of "$MAKE", so it can be a program name with args. -set dummy $MAKE; ac_word=$2 -{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 -$as_echo_n "checking for $ac_word... " >&6; } -if ${ac_cv_prog_configured_make+:} false; then : - $as_echo_n "(cached) " >&6 -else - if test -n "$configured_make"; then - ac_cv_prog_configured_make="$configured_make" # Let the user override the test. -else -as_save_IFS=$IFS; IFS=$PATH_SEPARATOR -for as_dir in $PATH -do - IFS=$as_save_IFS - test -z "$as_dir" && as_dir=. - for ac_exec_ext in '' $ac_executable_extensions; do - if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then - ac_cv_prog_configured_make="$MAKE" - $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 - break 2 - fi -done - done -IFS=$as_save_IFS - -fi -fi -configured_make=$ac_cv_prog_configured_make -if test -n "$configured_make"; then - { $as_echo "$as_me:${as_lineno-$LINENO}: result: $configured_make" >&5 -$as_echo "$configured_make" >&6; } -else - { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 -$as_echo "no" >&6; } -fi - - - if test -z "$configured_make"; then - as_fn_error $? "make, configured as \"$MAKE\", was not found" "$LINENO" 5 - fi -fi - -{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether ${MAKE} supports order-only prerequisites" >&5 -$as_echo_n "checking whether ${MAKE} supports order-only prerequisites... " >&6; } -rm -f confinc.* confprereq -cat > confmf.mk << 'END' -PREREQ := confprereq -am__doit: am__prereq | $(PREREQ) - @echo target am__doit. >>confinc.out -am__prereq: - @echo target am__prereq. >>confinc.out -$(PREREQ): - @touch $(PREREQ) - @echo target $(PREREQ). >>confinc.out -.PHONY: am__doit am__prereq -END -_am_result=no - { echo "$as_me:$LINENO: ${MAKE} -f confmf.mk && ${MAKE-make} -f confmf.mk && cat confinc.out" >&5 - (${MAKE} -f confmf.mk && ${MAKE-make} -f confmf.mk && cat confinc.out) >&5 2>&5 - ac_status=$? - echo "$as_me:$LINENO: \$? = $ac_status" >&5 - (exit $ac_status); } - ## redirecting via echo to remove special chars - __am_checkme=$(echo `cat confinc.out 2>/dev/null`) - case $?:${__am_checkme} in #( - '0:target am__prereq. target confprereq. target am__doit. target am__prereq. target am__doit.') : - _am_result="yes" ;; #( - *) : - ;; -esac -rm -f confinc.* confmf.mk confprereq -{ $as_echo "$as_me:${as_lineno-$LINENO}: result: ${_am_result}" >&5 -$as_echo "${_am_result}" >&6; } - if test "${_am_result}" = "yes"; then - MAKE_HAS_PREREQ_ONLY_TRUE= - MAKE_HAS_PREREQ_ONLY_FALSE='#' -else - MAKE_HAS_PREREQ_ONLY_TRUE='#' - MAKE_HAS_PREREQ_ONLY_FALSE= -fi - - -save_libs="$LIBS" - -enable_cflags_setting=no -{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether CFLAGS can be modified" >&5 -$as_echo_n "checking whether CFLAGS can be modified... " >&6; } -# Enable setting if the user has not specified the optimisation in CFLAGS. -echo "$CFLAGS" | grep "\-O.*\( \|$\)" 1>/dev/null 2>/dev/null -if test $? != 0; then - enable_cflags_setting=yes -fi -{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $enable_cflags_setting" >&5 -$as_echo "$enable_cflags_setting" >&6; } - -# Default CFLAGS (removed -g set in AC_INIT for compatibility) -: ${CFLAGS="-O2"} - -ac_ext=c -ac_cpp='$CPP $CPPFLAGS' -ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' -ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' -ac_compiler_gnu=$ac_cv_c_compiler_gnu -if test -n "$ac_tool_prefix"; then - for ac_prog in gcc xlc cc - do - # Extract the first word of "$ac_tool_prefix$ac_prog", so it can be a program name with args. -set dummy $ac_tool_prefix$ac_prog; ac_word=$2 -{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 -$as_echo_n "checking for $ac_word... " >&6; } -if ${ac_cv_prog_CC+:} false; then : - $as_echo_n "(cached) " >&6 -else - if test -n "$CC"; then - ac_cv_prog_CC="$CC" # Let the user override the test. -else -as_save_IFS=$IFS; IFS=$PATH_SEPARATOR -for as_dir in $PATH -do - IFS=$as_save_IFS - test -z "$as_dir" && as_dir=. - for ac_exec_ext in '' $ac_executable_extensions; do - if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then - ac_cv_prog_CC="$ac_tool_prefix$ac_prog" - $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 - break 2 - fi -done - done -IFS=$as_save_IFS - -fi -fi -CC=$ac_cv_prog_CC -if test -n "$CC"; then - { $as_echo "$as_me:${as_lineno-$LINENO}: result: $CC" >&5 -$as_echo "$CC" >&6; } -else - { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 -$as_echo "no" >&6; } -fi - - - test -n "$CC" && break - done -fi -if test -z "$CC"; then - ac_ct_CC=$CC - for ac_prog in gcc xlc cc -do - # Extract the first word of "$ac_prog", so it can be a program name with args. -set dummy $ac_prog; ac_word=$2 -{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 -$as_echo_n "checking for $ac_word... " >&6; } -if ${ac_cv_prog_ac_ct_CC+:} false; then : - $as_echo_n "(cached) " >&6 -else - if test -n "$ac_ct_CC"; then - ac_cv_prog_ac_ct_CC="$ac_ct_CC" # Let the user override the test. -else -as_save_IFS=$IFS; IFS=$PATH_SEPARATOR -for as_dir in $PATH -do - IFS=$as_save_IFS - test -z "$as_dir" && as_dir=. - for ac_exec_ext in '' $ac_executable_extensions; do - if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then - ac_cv_prog_ac_ct_CC="$ac_prog" - $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 - break 2 - fi -done - done -IFS=$as_save_IFS - -fi -fi -ac_ct_CC=$ac_cv_prog_ac_ct_CC -if test -n "$ac_ct_CC"; then - { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_ct_CC" >&5 -$as_echo "$ac_ct_CC" >&6; } -else - { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 -$as_echo "no" >&6; } -fi - - - test -n "$ac_ct_CC" && break -done - - if test "x$ac_ct_CC" = x; then - CC="" - else - case $cross_compiling:$ac_tool_warned in -yes:) -{ $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5 -$as_echo "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;} -ac_tool_warned=yes ;; -esac - CC=$ac_ct_CC - fi -fi - - -test -z "$CC" && { { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 -$as_echo "$as_me: error: in \`$ac_pwd':" >&2;} -as_fn_error $? "no acceptable C compiler found in \$PATH -See \`config.log' for more details" "$LINENO" 5; } - -# Provide some information about the compiler. -$as_echo "$as_me:${as_lineno-$LINENO}: checking for C compiler version" >&5 -set X $ac_compile -ac_compiler=$2 -for ac_option in --version -v -V -qversion; do - { { ac_try="$ac_compiler $ac_option >&5" -case "(($ac_try" in - *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; - *) ac_try_echo=$ac_try;; -esac -eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\"" -$as_echo "$ac_try_echo"; } >&5 - (eval "$ac_compiler $ac_option >&5") 2>conftest.err - ac_status=$? - if test -s conftest.err; then - sed '10a\ -... rest of stderr output deleted ... - 10q' conftest.err >conftest.er1 - cat conftest.er1 >&5 - fi - rm -f conftest.er1 conftest.err - $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 - test $ac_status = 0; } -done - -cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ - -int -main () -{ - - ; - return 0; -} -_ACEOF -ac_clean_files_save=$ac_clean_files -ac_clean_files="$ac_clean_files a.out a.out.dSYM a.exe b.out" -# Try to create an executable without -o first, disregard a.out. -# It will help us diagnose broken compilers, and finding out an intuition -# of exeext. -{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether the C compiler works" >&5 -$as_echo_n "checking whether the C compiler works... " >&6; } -ac_link_default=`$as_echo "$ac_link" | sed 's/ -o *conftest[^ ]*//'` - -# The possible output files: -ac_files="a.out conftest.exe conftest a.exe a_out.exe b.out conftest.*" - -ac_rmfiles= -for ac_file in $ac_files -do - case $ac_file in - *.$ac_ext | *.xcoff | *.tds | *.d | *.pdb | *.xSYM | *.bb | *.bbg | *.map | *.inf | *.dSYM | *.o | *.obj ) ;; - * ) ac_rmfiles="$ac_rmfiles $ac_file";; - esac -done -rm -f $ac_rmfiles - -if { { ac_try="$ac_link_default" -case "(($ac_try" in - *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; - *) ac_try_echo=$ac_try;; -esac -eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\"" -$as_echo "$ac_try_echo"; } >&5 - (eval "$ac_link_default") 2>&5 - ac_status=$? - $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 - test $ac_status = 0; }; then : - # Autoconf-2.13 could set the ac_cv_exeext variable to `no'. -# So ignore a value of `no', otherwise this would lead to `EXEEXT = no' -# in a Makefile. We should not override ac_cv_exeext if it was cached, -# so that the user can short-circuit this test for compilers unknown to -# Autoconf. -for ac_file in $ac_files '' -do - test -f "$ac_file" || continue - case $ac_file in - *.$ac_ext | *.xcoff | *.tds | *.d | *.pdb | *.xSYM | *.bb | *.bbg | *.map | *.inf | *.dSYM | *.o | *.obj ) - ;; - [ab].out ) - # We found the default executable, but exeext='' is most - # certainly right. - break;; - *.* ) - if test "${ac_cv_exeext+set}" = set && test "$ac_cv_exeext" != no; - then :; else - ac_cv_exeext=`expr "$ac_file" : '[^.]*\(\..*\)'` - fi - # We set ac_cv_exeext here because the later test for it is not - # safe: cross compilers may not add the suffix if given an `-o' - # argument, so we may need to know it at that point already. - # Even if this section looks crufty: it has the advantage of - # actually working. - break;; - * ) - break;; - esac -done -test "$ac_cv_exeext" = no && ac_cv_exeext= - -else - ac_file='' -fi -if test -z "$ac_file"; then : - { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 -$as_echo "no" >&6; } -$as_echo "$as_me: failed program was:" >&5 -sed 's/^/| /' conftest.$ac_ext >&5 - -{ { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 -$as_echo "$as_me: error: in \`$ac_pwd':" >&2;} -as_fn_error 77 "C compiler cannot create executables -See \`config.log' for more details" "$LINENO" 5; } -else - { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5 -$as_echo "yes" >&6; } -fi -{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for C compiler default output file name" >&5 -$as_echo_n "checking for C compiler default output file name... " >&6; } -{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_file" >&5 -$as_echo "$ac_file" >&6; } -ac_exeext=$ac_cv_exeext - -rm -f -r a.out a.out.dSYM a.exe conftest$ac_cv_exeext b.out -ac_clean_files=$ac_clean_files_save -{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for suffix of executables" >&5 -$as_echo_n "checking for suffix of executables... " >&6; } -if { { ac_try="$ac_link" -case "(($ac_try" in - *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; - *) ac_try_echo=$ac_try;; -esac -eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\"" -$as_echo "$ac_try_echo"; } >&5 - (eval "$ac_link") 2>&5 - ac_status=$? - $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 - test $ac_status = 0; }; then : - # If both `conftest.exe' and `conftest' are `present' (well, observable) -# catch `conftest.exe'. For instance with Cygwin, `ls conftest' will -# work properly (i.e., refer to `conftest.exe'), while it won't with -# `rm'. -for ac_file in conftest.exe conftest conftest.*; do - test -f "$ac_file" || continue - case $ac_file in - *.$ac_ext | *.xcoff | *.tds | *.d | *.pdb | *.xSYM | *.bb | *.bbg | *.map | *.inf | *.dSYM | *.o | *.obj ) ;; - *.* ) ac_cv_exeext=`expr "$ac_file" : '[^.]*\(\..*\)'` - break;; - * ) break;; - esac -done -else - { { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 -$as_echo "$as_me: error: in \`$ac_pwd':" >&2;} -as_fn_error $? "cannot compute suffix of executables: cannot compile and link -See \`config.log' for more details" "$LINENO" 5; } -fi -rm -f conftest conftest$ac_cv_exeext -{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_exeext" >&5 -$as_echo "$ac_cv_exeext" >&6; } - -rm -f conftest.$ac_ext -EXEEXT=$ac_cv_exeext -ac_exeext=$EXEEXT -cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ -#include -int -main () -{ -FILE *f = fopen ("conftest.out", "w"); - return ferror (f) || fclose (f) != 0; - - ; - return 0; -} -_ACEOF -ac_clean_files="$ac_clean_files conftest.out" -# Check that the compiler produces executables we can run. If not, either -# the compiler is broken, or we cross compile. -{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether we are cross compiling" >&5 -$as_echo_n "checking whether we are cross compiling... " >&6; } -if test "$cross_compiling" != yes; then - { { ac_try="$ac_link" -case "(($ac_try" in - *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; - *) ac_try_echo=$ac_try;; -esac -eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\"" -$as_echo "$ac_try_echo"; } >&5 - (eval "$ac_link") 2>&5 - ac_status=$? - $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 - test $ac_status = 0; } - if { ac_try='./conftest$ac_cv_exeext' - { { case "(($ac_try" in - *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; - *) ac_try_echo=$ac_try;; -esac -eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\"" -$as_echo "$ac_try_echo"; } >&5 - (eval "$ac_try") 2>&5 - ac_status=$? - $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 - test $ac_status = 0; }; }; then - cross_compiling=no - else - if test "$cross_compiling" = maybe; then - cross_compiling=yes - else - { { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 -$as_echo "$as_me: error: in \`$ac_pwd':" >&2;} -as_fn_error $? "cannot run C compiled programs. -If you meant to cross compile, use \`--host'. -See \`config.log' for more details" "$LINENO" 5; } - fi - fi -fi -{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $cross_compiling" >&5 -$as_echo "$cross_compiling" >&6; } - -rm -f conftest.$ac_ext conftest$ac_cv_exeext conftest.out -ac_clean_files=$ac_clean_files_save -{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for suffix of object files" >&5 -$as_echo_n "checking for suffix of object files... " >&6; } -if ${ac_cv_objext+:} false; then : - $as_echo_n "(cached) " >&6 -else - cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ - -int -main () -{ - - ; - return 0; -} -_ACEOF -rm -f conftest.o conftest.obj -if { { ac_try="$ac_compile" -case "(($ac_try" in - *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; - *) ac_try_echo=$ac_try;; -esac -eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\"" -$as_echo "$ac_try_echo"; } >&5 - (eval "$ac_compile") 2>&5 - ac_status=$? - $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 - test $ac_status = 0; }; then : - for ac_file in conftest.o conftest.obj conftest.*; do - test -f "$ac_file" || continue; - case $ac_file in - *.$ac_ext | *.xcoff | *.tds | *.d | *.pdb | *.xSYM | *.bb | *.bbg | *.map | *.inf | *.dSYM ) ;; - *) ac_cv_objext=`expr "$ac_file" : '.*\.\(.*\)'` - break;; - esac -done -else - $as_echo "$as_me: failed program was:" >&5 -sed 's/^/| /' conftest.$ac_ext >&5 - -{ { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 -$as_echo "$as_me: error: in \`$ac_pwd':" >&2;} -as_fn_error $? "cannot compute suffix of object files: cannot compile -See \`config.log' for more details" "$LINENO" 5; } -fi -rm -f conftest.$ac_cv_objext conftest.$ac_ext -fi -{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_objext" >&5 -$as_echo "$ac_cv_objext" >&6; } -OBJEXT=$ac_cv_objext -ac_objext=$OBJEXT -{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether we are using the GNU C compiler" >&5 -$as_echo_n "checking whether we are using the GNU C compiler... " >&6; } -if ${ac_cv_c_compiler_gnu+:} false; then : - $as_echo_n "(cached) " >&6 -else - cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ - -int -main () -{ -#ifndef __GNUC__ - choke me -#endif - - ; - return 0; -} -_ACEOF -if ac_fn_c_try_compile "$LINENO"; then : - ac_compiler_gnu=yes -else - ac_compiler_gnu=no -fi -rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext -ac_cv_c_compiler_gnu=$ac_compiler_gnu - -fi -{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_c_compiler_gnu" >&5 -$as_echo "$ac_cv_c_compiler_gnu" >&6; } -if test $ac_compiler_gnu = yes; then - GCC=yes -else - GCC= -fi -ac_test_CFLAGS=${CFLAGS+set} -ac_save_CFLAGS=$CFLAGS -{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether $CC accepts -g" >&5 -$as_echo_n "checking whether $CC accepts -g... " >&6; } -if ${ac_cv_prog_cc_g+:} false; then : - $as_echo_n "(cached) " >&6 -else - ac_save_c_werror_flag=$ac_c_werror_flag - ac_c_werror_flag=yes - ac_cv_prog_cc_g=no - CFLAGS="-g" - cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ - -int -main () -{ - - ; - return 0; -} -_ACEOF -if ac_fn_c_try_compile "$LINENO"; then : - ac_cv_prog_cc_g=yes -else - CFLAGS="" - cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ - -int -main () -{ - - ; - return 0; -} -_ACEOF -if ac_fn_c_try_compile "$LINENO"; then : - -else - ac_c_werror_flag=$ac_save_c_werror_flag - CFLAGS="-g" - cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ - -int -main () -{ - - ; - return 0; -} -_ACEOF -if ac_fn_c_try_compile "$LINENO"; then : - ac_cv_prog_cc_g=yes -fi -rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext -fi -rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext -fi -rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext - ac_c_werror_flag=$ac_save_c_werror_flag -fi -{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_prog_cc_g" >&5 -$as_echo "$ac_cv_prog_cc_g" >&6; } -if test "$ac_test_CFLAGS" = set; then - CFLAGS=$ac_save_CFLAGS -elif test $ac_cv_prog_cc_g = yes; then - if test "$GCC" = yes; then - CFLAGS="-g -O2" - else - CFLAGS="-g" - fi -else - if test "$GCC" = yes; then - CFLAGS="-O2" - else - CFLAGS= - fi -fi -{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $CC option to accept ISO C89" >&5 -$as_echo_n "checking for $CC option to accept ISO C89... " >&6; } -if ${ac_cv_prog_cc_c89+:} false; then : - $as_echo_n "(cached) " >&6 -else - ac_cv_prog_cc_c89=no -ac_save_CC=$CC -cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ -#include -#include -struct stat; -/* Most of the following tests are stolen from RCS 5.7's src/conf.sh. */ -struct buf { int x; }; -FILE * (*rcsopen) (struct buf *, struct stat *, int); -static char *e (p, i) - char **p; - int i; -{ - return p[i]; -} -static char *f (char * (*g) (char **, int), char **p, ...) -{ - char *s; - va_list v; - va_start (v,p); - s = g (p, va_arg (v,int)); - va_end (v); - return s; -} - -/* OSF 4.0 Compaq cc is some sort of almost-ANSI by default. It has - function prototypes and stuff, but not '\xHH' hex character constants. - These don't provoke an error unfortunately, instead are silently treated - as 'x'. The following induces an error, until -std is added to get - proper ANSI mode. Curiously '\x00'!='x' always comes out true, for an - array size at least. It's necessary to write '\x00'==0 to get something - that's true only with -std. */ -int osf4_cc_array ['\x00' == 0 ? 1 : -1]; - -/* IBM C 6 for AIX is almost-ANSI by default, but it replaces macro parameters - inside strings and character constants. */ -#define FOO(x) 'x' -int xlc6_cc_array[FOO(a) == 'x' ? 1 : -1]; - -int test (int i, double x); -struct s1 {int (*f) (int a);}; -struct s2 {int (*f) (double a);}; -int pairnames (int, char **, FILE *(*)(struct buf *, struct stat *, int), int, int); -int argc; -char **argv; -int -main () -{ -return f (e, argv, 0) != argv[0] || f (e, argv, 1) != argv[1]; - ; - return 0; -} -_ACEOF -for ac_arg in '' -qlanglvl=extc89 -qlanglvl=ansi -std \ - -Ae "-Aa -D_HPUX_SOURCE" "-Xc -D__EXTENSIONS__" -do - CC="$ac_save_CC $ac_arg" - if ac_fn_c_try_compile "$LINENO"; then : - ac_cv_prog_cc_c89=$ac_arg -fi -rm -f core conftest.err conftest.$ac_objext - test "x$ac_cv_prog_cc_c89" != "xno" && break -done -rm -f conftest.$ac_ext -CC=$ac_save_CC - -fi -# AC_CACHE_VAL -case "x$ac_cv_prog_cc_c89" in - x) - { $as_echo "$as_me:${as_lineno-$LINENO}: result: none needed" >&5 -$as_echo "none needed" >&6; } ;; - xno) - { $as_echo "$as_me:${as_lineno-$LINENO}: result: unsupported" >&5 -$as_echo "unsupported" >&6; } ;; - *) - CC="$CC $ac_cv_prog_cc_c89" - { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_prog_cc_c89" >&5 -$as_echo "$ac_cv_prog_cc_c89" >&6; } ;; -esac -if test "x$ac_cv_prog_cc_c89" != xno; then : - -fi - -ac_ext=c -ac_cpp='$CPP $CPPFLAGS' -ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' -ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' -ac_compiler_gnu=$ac_cv_c_compiler_gnu - -ac_ext=c -ac_cpp='$CPP $CPPFLAGS' -ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' -ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' -ac_compiler_gnu=$ac_cv_c_compiler_gnu -{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether $CC understands -c and -o together" >&5 -$as_echo_n "checking whether $CC understands -c and -o together... " >&6; } -if ${am_cv_prog_cc_c_o+:} false; then : - $as_echo_n "(cached) " >&6 -else - cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ - -int -main () -{ - - ; - return 0; -} -_ACEOF - # Make sure it works both with $CC and with simple cc. - # Following AC_PROG_CC_C_O, we do the test twice because some - # compilers refuse to overwrite an existing .o file with -o, - # though they will create one. - am_cv_prog_cc_c_o=yes - for am_i in 1 2; do - if { echo "$as_me:$LINENO: $CC -c conftest.$ac_ext -o conftest2.$ac_objext" >&5 - ($CC -c conftest.$ac_ext -o conftest2.$ac_objext) >&5 2>&5 - ac_status=$? - echo "$as_me:$LINENO: \$? = $ac_status" >&5 - (exit $ac_status); } \ - && test -f conftest2.$ac_objext; then - : OK - else - am_cv_prog_cc_c_o=no - break - fi - done - rm -f core conftest* - unset am_i -fi -{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $am_cv_prog_cc_c_o" >&5 -$as_echo "$am_cv_prog_cc_c_o" >&6; } -if test "$am_cv_prog_cc_c_o" != yes; then - # Losing compiler, so override with the script. - # FIXME: It is wrong to rewrite CC. - # But if we don't then we get into trouble of one sort or another. - # A longer-term fix would be to have automake use am__CC in this case, - # and then we could set am__CC="\$(top_srcdir)/compile \$(CC)" - CC="$am_aux_dir/compile $CC" -fi -ac_ext=c -ac_cpp='$CPP $CPPFLAGS' -ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' -ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' -ac_compiler_gnu=$ac_cv_c_compiler_gnu - -DEPDIR="${am__leading_dot}deps" - -ac_config_commands="$ac_config_commands depfiles" - - -am_make=${MAKE-make} -cat > confinc << 'END' -am__doit: - @echo this is the am__doit target -.PHONY: am__doit -END -# If we don't find an include directive, just comment out the code. -{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for style of include used by $am_make" >&5 -$as_echo_n "checking for style of include used by $am_make... " >&6; } -am__include="#" -am__quote= -_am_result=none -# First try GNU make style include. -echo "include confinc" > confmf -# Ignore all kinds of additional output from 'make'. -case `$am_make -s -f confmf 2> /dev/null` in #( -*the\ am__doit\ target*) - am__include=include - am__quote= - _am_result=GNU - ;; -esac -# Now try BSD make style include. -if test "$am__include" = "#"; then - echo '.include "confinc"' > confmf - case `$am_make -s -f confmf 2> /dev/null` in #( - *the\ am__doit\ target*) - am__include=.include - am__quote="\"" - _am_result=BSD - ;; - esac -fi - - -{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $_am_result" >&5 -$as_echo "$_am_result" >&6; } -rm -f confinc confmf - -# Check whether --enable-dependency-tracking was given. -if test "${enable_dependency_tracking+set}" = set; then : - enableval=$enable_dependency_tracking; -fi - -if test "x$enable_dependency_tracking" != xno; then - am_depcomp="$ac_aux_dir/depcomp" - AMDEPBACKSLASH='\' - am__nodep='_no' -fi - if test "x$enable_dependency_tracking" != xno; then - AMDEP_TRUE= - AMDEP_FALSE='#' -else - AMDEP_TRUE='#' - AMDEP_FALSE= -fi - - - -depcc="$CC" am_compiler_list= - -{ $as_echo "$as_me:${as_lineno-$LINENO}: checking dependency style of $depcc" >&5 -$as_echo_n "checking dependency style of $depcc... " >&6; } -if ${am_cv_CC_dependencies_compiler_type+:} false; then : - $as_echo_n "(cached) " >&6 -else - if test -z "$AMDEP_TRUE" && test -f "$am_depcomp"; then - # We make a subdir and do the tests there. Otherwise we can end up - # making bogus files that we don't know about and never remove. For - # instance it was reported that on HP-UX the gcc test will end up - # making a dummy file named 'D' -- because '-MD' means "put the output - # in D". - rm -rf conftest.dir - mkdir conftest.dir - # Copy depcomp to subdir because otherwise we won't find it if we're - # using a relative directory. - cp "$am_depcomp" conftest.dir - cd conftest.dir - # We will build objects and dependencies in a subdirectory because - # it helps to detect inapplicable dependency modes. For instance - # both Tru64's cc and ICC support -MD to output dependencies as a - # side effect of compilation, but ICC will put the dependencies in - # the current directory while Tru64 will put them in the object - # directory. - mkdir sub - - am_cv_CC_dependencies_compiler_type=none - if test "$am_compiler_list" = ""; then - am_compiler_list=`sed -n 's/^#*\([a-zA-Z0-9]*\))$/\1/p' < ./depcomp` - fi - am__universal=false - case " $depcc " in #( - *\ -arch\ *\ -arch\ *) am__universal=true ;; - esac - - for depmode in $am_compiler_list; do - # Setup a source with many dependencies, because some compilers - # like to wrap large dependency lists on column 80 (with \), and - # we should not choose a depcomp mode which is confused by this. - # - # We need to recreate these files for each test, as the compiler may - # overwrite some of them when testing with obscure command lines. - # This happens at least with the AIX C compiler. - : > sub/conftest.c - for i in 1 2 3 4 5 6; do - echo '#include "conftst'$i'.h"' >> sub/conftest.c - # Using ": > sub/conftst$i.h" creates only sub/conftst1.h with - # Solaris 10 /bin/sh. - echo '/* dummy */' > sub/conftst$i.h - done - echo "${am__include} ${am__quote}sub/conftest.Po${am__quote}" > confmf - - # We check with '-c' and '-o' for the sake of the "dashmstdout" - # mode. It turns out that the SunPro C++ compiler does not properly - # handle '-M -o', and we need to detect this. Also, some Intel - # versions had trouble with output in subdirs. - am__obj=sub/conftest.${OBJEXT-o} - am__minus_obj="-o $am__obj" - case $depmode in - gcc) - # This depmode causes a compiler race in universal mode. - test "$am__universal" = false || continue - ;; - nosideeffect) - # After this tag, mechanisms are not by side-effect, so they'll - # only be used when explicitly requested. - if test "x$enable_dependency_tracking" = xyes; then - continue - else - break - fi - ;; - msvc7 | msvc7msys | msvisualcpp | msvcmsys) - # This compiler won't grok '-c -o', but also, the minuso test has - # not run yet. These depmodes are late enough in the game, and - # so weak that their functioning should not be impacted. - am__obj=conftest.${OBJEXT-o} - am__minus_obj= - ;; - none) break ;; - esac - if depmode=$depmode \ - source=sub/conftest.c object=$am__obj \ - depfile=sub/conftest.Po tmpdepfile=sub/conftest.TPo \ - $SHELL ./depcomp $depcc -c $am__minus_obj sub/conftest.c \ - >/dev/null 2>conftest.err && - grep sub/conftst1.h sub/conftest.Po > /dev/null 2>&1 && - grep sub/conftst6.h sub/conftest.Po > /dev/null 2>&1 && - grep $am__obj sub/conftest.Po > /dev/null 2>&1 && - ${MAKE-make} -s -f confmf > /dev/null 2>&1; then - # icc doesn't choke on unknown options, it will just issue warnings - # or remarks (even with -Werror). So we grep stderr for any message - # that says an option was ignored or not supported. - # When given -MP, icc 7.0 and 7.1 complain thusly: - # icc: Command line warning: ignoring option '-M'; no argument required - # The diagnosis changed in icc 8.0: - # icc: Command line remark: option '-MP' not supported - if (grep 'ignoring option' conftest.err || - grep 'not supported' conftest.err) >/dev/null 2>&1; then :; else - am_cv_CC_dependencies_compiler_type=$depmode - break - fi - fi - done - - cd .. - rm -rf conftest.dir -else - am_cv_CC_dependencies_compiler_type=none -fi - -fi -{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $am_cv_CC_dependencies_compiler_type" >&5 -$as_echo "$am_cv_CC_dependencies_compiler_type" >&6; } -CCDEPMODE=depmode=$am_cv_CC_dependencies_compiler_type - - if - test "x$enable_dependency_tracking" != xno \ - && test "$am_cv_CC_dependencies_compiler_type" = gcc3; then - am__fastdepCC_TRUE= - am__fastdepCC_FALSE='#' -else - am__fastdepCC_TRUE='#' - am__fastdepCC_FALSE= -fi - - - case $ac_cv_prog_cc_stdc in #( - no) : - ac_cv_prog_cc_c99=no; ac_cv_prog_cc_c89=no ;; #( - *) : - { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $CC option to accept ISO C99" >&5 -$as_echo_n "checking for $CC option to accept ISO C99... " >&6; } -if ${ac_cv_prog_cc_c99+:} false; then : - $as_echo_n "(cached) " >&6 -else - ac_cv_prog_cc_c99=no -ac_save_CC=$CC -cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ -#include -#include -#include -#include -#include - -// Check varargs macros. These examples are taken from C99 6.10.3.5. -#define debug(...) fprintf (stderr, __VA_ARGS__) -#define showlist(...) puts (#__VA_ARGS__) -#define report(test,...) ((test) ? puts (#test) : printf (__VA_ARGS__)) -static void -test_varargs_macros (void) -{ - int x = 1234; - int y = 5678; - debug ("Flag"); - debug ("X = %d\n", x); - showlist (The first, second, and third items.); - report (x>y, "x is %d but y is %d", x, y); -} - -// Check long long types. -#define BIG64 18446744073709551615ull -#define BIG32 4294967295ul -#define BIG_OK (BIG64 / BIG32 == 4294967297ull && BIG64 % BIG32 == 0) -#if !BIG_OK - your preprocessor is broken; -#endif -#if BIG_OK -#else - your preprocessor is broken; -#endif -static long long int bignum = -9223372036854775807LL; -static unsigned long long int ubignum = BIG64; - -struct incomplete_array -{ - int datasize; - double data[]; -}; - -struct named_init { - int number; - const wchar_t *name; - double average; -}; - -typedef const char *ccp; - -static inline int -test_restrict (ccp restrict text) -{ - // See if C++-style comments work. - // Iterate through items via the restricted pointer. - // Also check for declarations in for loops. - for (unsigned int i = 0; *(text+i) != '\0'; ++i) - continue; - return 0; -} - -// Check varargs and va_copy. -static void -test_varargs (const char *format, ...) -{ - va_list args; - va_start (args, format); - va_list args_copy; - va_copy (args_copy, args); - - const char *str; - int number; - float fnumber; - - while (*format) - { - switch (*format++) - { - case 's': // string - str = va_arg (args_copy, const char *); - break; - case 'd': // int - number = va_arg (args_copy, int); - break; - case 'f': // float - fnumber = va_arg (args_copy, double); - break; - default: - break; - } - } - va_end (args_copy); - va_end (args); -} - -int -main () -{ - - // Check bool. - _Bool success = false; - - // Check restrict. - if (test_restrict ("String literal") == 0) - success = true; - char *restrict newvar = "Another string"; - - // Check varargs. - test_varargs ("s, d' f .", "string", 65, 34.234); - test_varargs_macros (); - - // Check flexible array members. - struct incomplete_array *ia = - malloc (sizeof (struct incomplete_array) + (sizeof (double) * 10)); - ia->datasize = 10; - for (int i = 0; i < ia->datasize; ++i) - ia->data[i] = i * 1.234; - - // Check named initializers. - struct named_init ni = { - .number = 34, - .name = L"Test wide string", - .average = 543.34343, - }; - - ni.number = 58; - - int dynamic_array[ni.number]; - dynamic_array[ni.number - 1] = 543; - - // work around unused variable warnings - return (!success || bignum == 0LL || ubignum == 0uLL || newvar[0] == 'x' - || dynamic_array[ni.number - 1] != 543); - - ; - return 0; -} -_ACEOF -for ac_arg in '' -std=gnu99 -std=c99 -c99 -AC99 -D_STDC_C99= -qlanglvl=extc99 -do - CC="$ac_save_CC $ac_arg" - if ac_fn_c_try_compile "$LINENO"; then : - ac_cv_prog_cc_c99=$ac_arg -fi -rm -f core conftest.err conftest.$ac_objext - test "x$ac_cv_prog_cc_c99" != "xno" && break -done -rm -f conftest.$ac_ext -CC=$ac_save_CC - -fi -# AC_CACHE_VAL -case "x$ac_cv_prog_cc_c99" in - x) - { $as_echo "$as_me:${as_lineno-$LINENO}: result: none needed" >&5 -$as_echo "none needed" >&6; } ;; - xno) - { $as_echo "$as_me:${as_lineno-$LINENO}: result: unsupported" >&5 -$as_echo "unsupported" >&6; } ;; - *) - CC="$CC $ac_cv_prog_cc_c99" - { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_prog_cc_c99" >&5 -$as_echo "$ac_cv_prog_cc_c99" >&6; } ;; -esac -if test "x$ac_cv_prog_cc_c99" != xno; then : - ac_cv_prog_cc_stdc=$ac_cv_prog_cc_c99 -else - { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $CC option to accept ISO C89" >&5 -$as_echo_n "checking for $CC option to accept ISO C89... " >&6; } -if ${ac_cv_prog_cc_c89+:} false; then : - $as_echo_n "(cached) " >&6 -else - ac_cv_prog_cc_c89=no -ac_save_CC=$CC -cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ -#include -#include -struct stat; -/* Most of the following tests are stolen from RCS 5.7's src/conf.sh. */ -struct buf { int x; }; -FILE * (*rcsopen) (struct buf *, struct stat *, int); -static char *e (p, i) - char **p; - int i; -{ - return p[i]; -} -static char *f (char * (*g) (char **, int), char **p, ...) -{ - char *s; - va_list v; - va_start (v,p); - s = g (p, va_arg (v,int)); - va_end (v); - return s; -} - -/* OSF 4.0 Compaq cc is some sort of almost-ANSI by default. It has - function prototypes and stuff, but not '\xHH' hex character constants. - These don't provoke an error unfortunately, instead are silently treated - as 'x'. The following induces an error, until -std is added to get - proper ANSI mode. Curiously '\x00'!='x' always comes out true, for an - array size at least. It's necessary to write '\x00'==0 to get something - that's true only with -std. */ -int osf4_cc_array ['\x00' == 0 ? 1 : -1]; - -/* IBM C 6 for AIX is almost-ANSI by default, but it replaces macro parameters - inside strings and character constants. */ -#define FOO(x) 'x' -int xlc6_cc_array[FOO(a) == 'x' ? 1 : -1]; - -int test (int i, double x); -struct s1 {int (*f) (int a);}; -struct s2 {int (*f) (double a);}; -int pairnames (int, char **, FILE *(*)(struct buf *, struct stat *, int), int, int); -int argc; -char **argv; -int -main () -{ -return f (e, argv, 0) != argv[0] || f (e, argv, 1) != argv[1]; - ; - return 0; -} -_ACEOF -for ac_arg in '' -qlanglvl=extc89 -qlanglvl=ansi -std \ - -Ae "-Aa -D_HPUX_SOURCE" "-Xc -D__EXTENSIONS__" -do - CC="$ac_save_CC $ac_arg" - if ac_fn_c_try_compile "$LINENO"; then : - ac_cv_prog_cc_c89=$ac_arg -fi -rm -f core conftest.err conftest.$ac_objext - test "x$ac_cv_prog_cc_c89" != "xno" && break -done -rm -f conftest.$ac_ext -CC=$ac_save_CC - -fi -# AC_CACHE_VAL -case "x$ac_cv_prog_cc_c89" in - x) - { $as_echo "$as_me:${as_lineno-$LINENO}: result: none needed" >&5 -$as_echo "none needed" >&6; } ;; - xno) - { $as_echo "$as_me:${as_lineno-$LINENO}: result: unsupported" >&5 -$as_echo "unsupported" >&6; } ;; - *) - CC="$CC $ac_cv_prog_cc_c89" - { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_prog_cc_c89" >&5 -$as_echo "$ac_cv_prog_cc_c89" >&6; } ;; -esac -if test "x$ac_cv_prog_cc_c89" != xno; then : - ac_cv_prog_cc_stdc=$ac_cv_prog_cc_c89 -else - ac_cv_prog_cc_stdc=no -fi - -fi - ;; -esac - { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $CC option to accept ISO Standard C" >&5 -$as_echo_n "checking for $CC option to accept ISO Standard C... " >&6; } - if ${ac_cv_prog_cc_stdc+:} false; then : - $as_echo_n "(cached) " >&6 -fi - - case $ac_cv_prog_cc_stdc in #( - no) : - { $as_echo "$as_me:${as_lineno-$LINENO}: result: unsupported" >&5 -$as_echo "unsupported" >&6; } ;; #( - '') : - { $as_echo "$as_me:${as_lineno-$LINENO}: result: none needed" >&5 -$as_echo "none needed" >&6; } ;; #( - *) : - { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_prog_cc_stdc" >&5 -$as_echo "$ac_cv_prog_cc_stdc" >&6; } ;; -esac - - -ac_ext=c -ac_cpp='$CPP $CPPFLAGS' -ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' -ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' -ac_compiler_gnu=$ac_cv_c_compiler_gnu -{ $as_echo "$as_me:${as_lineno-$LINENO}: checking how to run the C preprocessor" >&5 -$as_echo_n "checking how to run the C preprocessor... " >&6; } -# On Suns, sometimes $CPP names a directory. -if test -n "$CPP" && test -d "$CPP"; then - CPP= -fi -if test -z "$CPP"; then - if ${ac_cv_prog_CPP+:} false; then : - $as_echo_n "(cached) " >&6 -else - # Double quotes because CPP needs to be expanded - for CPP in "$CC -E" "$CC -E -traditional-cpp" "/lib/cpp" - do - ac_preproc_ok=false -for ac_c_preproc_warn_flag in '' yes -do - # Use a header file that comes with gcc, so configuring glibc - # with a fresh cross-compiler works. - # Prefer to if __STDC__ is defined, since - # exists even on freestanding compilers. - # On the NeXT, cc -E runs the code through the compiler's parser, - # not just through cpp. "Syntax error" is here to catch this case. - cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ -#ifdef __STDC__ -# include -#else -# include -#endif - Syntax error -_ACEOF -if ac_fn_c_try_cpp "$LINENO"; then : - -else - # Broken: fails on valid input. -continue -fi -rm -f conftest.err conftest.i conftest.$ac_ext - - # OK, works on sane cases. Now check whether nonexistent headers - # can be detected and how. - cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ -#include -_ACEOF -if ac_fn_c_try_cpp "$LINENO"; then : - # Broken: success on invalid input. -continue -else - # Passes both tests. -ac_preproc_ok=: -break -fi -rm -f conftest.err conftest.i conftest.$ac_ext - -done -# Because of `break', _AC_PREPROC_IFELSE's cleaning code was skipped. -rm -f conftest.i conftest.err conftest.$ac_ext -if $ac_preproc_ok; then : - break -fi - - done - ac_cv_prog_CPP=$CPP - -fi - CPP=$ac_cv_prog_CPP -else - ac_cv_prog_CPP=$CPP -fi -{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $CPP" >&5 -$as_echo "$CPP" >&6; } -ac_preproc_ok=false -for ac_c_preproc_warn_flag in '' yes -do - # Use a header file that comes with gcc, so configuring glibc - # with a fresh cross-compiler works. - # Prefer to if __STDC__ is defined, since - # exists even on freestanding compilers. - # On the NeXT, cc -E runs the code through the compiler's parser, - # not just through cpp. "Syntax error" is here to catch this case. - cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ -#ifdef __STDC__ -# include -#else -# include -#endif - Syntax error -_ACEOF -if ac_fn_c_try_cpp "$LINENO"; then : - -else - # Broken: fails on valid input. -continue -fi -rm -f conftest.err conftest.i conftest.$ac_ext - - # OK, works on sane cases. Now check whether nonexistent headers - # can be detected and how. - cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ -#include -_ACEOF -if ac_fn_c_try_cpp "$LINENO"; then : - # Broken: success on invalid input. -continue -else - # Passes both tests. -ac_preproc_ok=: -break -fi -rm -f conftest.err conftest.i conftest.$ac_ext - -done -# Because of `break', _AC_PREPROC_IFELSE's cleaning code was skipped. -rm -f conftest.i conftest.err conftest.$ac_ext -if $ac_preproc_ok; then : - -else - { { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 -$as_echo "$as_me: error: in \`$ac_pwd':" >&2;} -as_fn_error $? "C preprocessor \"$CPP\" fails sanity check -See \`config.log' for more details" "$LINENO" 5; } -fi - -ac_ext=c -ac_cpp='$CPP $CPPFLAGS' -ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' -ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' -ac_compiler_gnu=$ac_cv_c_compiler_gnu - - - - -{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for grep that handles long lines and -e" >&5 -$as_echo_n "checking for grep that handles long lines and -e... " >&6; } -if ${ac_cv_path_GREP+:} false; then : - $as_echo_n "(cached) " >&6 -else - if test -z "$GREP"; then - ac_path_GREP_found=false - # Loop through the user's path and test for each of PROGNAME-LIST - as_save_IFS=$IFS; IFS=$PATH_SEPARATOR -for as_dir in $PATH$PATH_SEPARATOR/usr/xpg4/bin -do - IFS=$as_save_IFS - test -z "$as_dir" && as_dir=. - for ac_prog in grep ggrep; do - for ac_exec_ext in '' $ac_executable_extensions; do - ac_path_GREP="$as_dir/$ac_prog$ac_exec_ext" - as_fn_executable_p "$ac_path_GREP" || continue -# Check for GNU ac_path_GREP and select it if it is found. - # Check for GNU $ac_path_GREP -case `"$ac_path_GREP" --version 2>&1` in -*GNU*) - ac_cv_path_GREP="$ac_path_GREP" ac_path_GREP_found=:;; -*) - ac_count=0 - $as_echo_n 0123456789 >"conftest.in" - while : - do - cat "conftest.in" "conftest.in" >"conftest.tmp" - mv "conftest.tmp" "conftest.in" - cp "conftest.in" "conftest.nl" - $as_echo 'GREP' >> "conftest.nl" - "$ac_path_GREP" -e 'GREP$' -e '-(cannot match)-' < "conftest.nl" >"conftest.out" 2>/dev/null || break - diff "conftest.out" "conftest.nl" >/dev/null 2>&1 || break - as_fn_arith $ac_count + 1 && ac_count=$as_val - if test $ac_count -gt ${ac_path_GREP_max-0}; then - # Best one so far, save it but keep looking for a better one - ac_cv_path_GREP="$ac_path_GREP" - ac_path_GREP_max=$ac_count - fi - # 10*(2^10) chars as input seems more than enough - test $ac_count -gt 10 && break - done - rm -f conftest.in conftest.tmp conftest.nl conftest.out;; -esac - - $ac_path_GREP_found && break 3 - done - done - done -IFS=$as_save_IFS - if test -z "$ac_cv_path_GREP"; then - as_fn_error $? "no acceptable grep could be found in $PATH$PATH_SEPARATOR/usr/xpg4/bin" "$LINENO" 5 - fi -else - ac_cv_path_GREP=$GREP -fi - -fi -{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_path_GREP" >&5 -$as_echo "$ac_cv_path_GREP" >&6; } - GREP="$ac_cv_path_GREP" - - -{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for egrep" >&5 -$as_echo_n "checking for egrep... " >&6; } -if ${ac_cv_path_EGREP+:} false; then : - $as_echo_n "(cached) " >&6 -else - if echo a | $GREP -E '(a|b)' >/dev/null 2>&1 - then ac_cv_path_EGREP="$GREP -E" - else - if test -z "$EGREP"; then - ac_path_EGREP_found=false - # Loop through the user's path and test for each of PROGNAME-LIST - as_save_IFS=$IFS; IFS=$PATH_SEPARATOR -for as_dir in $PATH$PATH_SEPARATOR/usr/xpg4/bin -do - IFS=$as_save_IFS - test -z "$as_dir" && as_dir=. - for ac_prog in egrep; do - for ac_exec_ext in '' $ac_executable_extensions; do - ac_path_EGREP="$as_dir/$ac_prog$ac_exec_ext" - as_fn_executable_p "$ac_path_EGREP" || continue -# Check for GNU ac_path_EGREP and select it if it is found. - # Check for GNU $ac_path_EGREP -case `"$ac_path_EGREP" --version 2>&1` in -*GNU*) - ac_cv_path_EGREP="$ac_path_EGREP" ac_path_EGREP_found=:;; -*) - ac_count=0 - $as_echo_n 0123456789 >"conftest.in" - while : - do - cat "conftest.in" "conftest.in" >"conftest.tmp" - mv "conftest.tmp" "conftest.in" - cp "conftest.in" "conftest.nl" - $as_echo 'EGREP' >> "conftest.nl" - "$ac_path_EGREP" 'EGREP$' < "conftest.nl" >"conftest.out" 2>/dev/null || break - diff "conftest.out" "conftest.nl" >/dev/null 2>&1 || break - as_fn_arith $ac_count + 1 && ac_count=$as_val - if test $ac_count -gt ${ac_path_EGREP_max-0}; then - # Best one so far, save it but keep looking for a better one - ac_cv_path_EGREP="$ac_path_EGREP" - ac_path_EGREP_max=$ac_count - fi - # 10*(2^10) chars as input seems more than enough - test $ac_count -gt 10 && break - done - rm -f conftest.in conftest.tmp conftest.nl conftest.out;; -esac - - $ac_path_EGREP_found && break 3 - done - done - done -IFS=$as_save_IFS - if test -z "$ac_cv_path_EGREP"; then - as_fn_error $? "no acceptable egrep could be found in $PATH$PATH_SEPARATOR/usr/xpg4/bin" "$LINENO" 5 - fi -else - ac_cv_path_EGREP=$EGREP -fi - - fi -fi -{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_path_EGREP" >&5 -$as_echo "$ac_cv_path_EGREP" >&6; } - EGREP="$ac_cv_path_EGREP" - - -{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for ANSI C header files" >&5 -$as_echo_n "checking for ANSI C header files... " >&6; } -if ${ac_cv_header_stdc+:} false; then : - $as_echo_n "(cached) " >&6 -else - cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ -#include -#include -#include -#include - -int -main () -{ - - ; - return 0; -} -_ACEOF -if ac_fn_c_try_compile "$LINENO"; then : - ac_cv_header_stdc=yes -else - ac_cv_header_stdc=no -fi -rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext - -if test $ac_cv_header_stdc = yes; then - # SunOS 4.x string.h does not declare mem*, contrary to ANSI. - cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ -#include - -_ACEOF -if (eval "$ac_cpp conftest.$ac_ext") 2>&5 | - $EGREP "memchr" >/dev/null 2>&1; then : - -else - ac_cv_header_stdc=no -fi -rm -f conftest* - -fi - -if test $ac_cv_header_stdc = yes; then - # ISC 2.0.2 stdlib.h does not declare free, contrary to ANSI. - cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ -#include - -_ACEOF -if (eval "$ac_cpp conftest.$ac_ext") 2>&5 | - $EGREP "free" >/dev/null 2>&1; then : - -else - ac_cv_header_stdc=no -fi -rm -f conftest* - -fi - -if test $ac_cv_header_stdc = yes; then - # /bin/cc in Irix-4.0.5 gets non-ANSI ctype macros unless using -ansi. - if test "$cross_compiling" = yes; then : - : -else - cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ -#include -#include -#if ((' ' & 0x0FF) == 0x020) -# define ISLOWER(c) ('a' <= (c) && (c) <= 'z') -# define TOUPPER(c) (ISLOWER(c) ? 'A' + ((c) - 'a') : (c)) -#else -# define ISLOWER(c) \ - (('a' <= (c) && (c) <= 'i') \ - || ('j' <= (c) && (c) <= 'r') \ - || ('s' <= (c) && (c) <= 'z')) -# define TOUPPER(c) (ISLOWER(c) ? ((c) | 0x40) : (c)) -#endif - -#define XOR(e, f) (((e) && !(f)) || (!(e) && (f))) -int -main () -{ - int i; - for (i = 0; i < 256; i++) - if (XOR (islower (i), ISLOWER (i)) - || toupper (i) != TOUPPER (i)) - return 2; - return 0; -} -_ACEOF -if ac_fn_c_try_run "$LINENO"; then : - -else - ac_cv_header_stdc=no -fi -rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext \ - conftest.$ac_objext conftest.beam conftest.$ac_ext -fi - -fi -fi -{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_header_stdc" >&5 -$as_echo "$ac_cv_header_stdc" >&6; } -if test $ac_cv_header_stdc = yes; then - -$as_echo "#define STDC_HEADERS 1" >>confdefs.h - -fi - -# On IRIX 5.3, sys/types and inttypes.h are conflicting. -for ac_header in sys/types.h sys/stat.h stdlib.h string.h memory.h strings.h \ - inttypes.h stdint.h unistd.h -do : - as_ac_Header=`$as_echo "ac_cv_header_$ac_header" | $as_tr_sh` -ac_fn_c_check_header_compile "$LINENO" "$ac_header" "$as_ac_Header" "$ac_includes_default -" -if eval test \"x\$"$as_ac_Header"\" = x"yes"; then : - cat >>confdefs.h <<_ACEOF -#define `$as_echo "HAVE_$ac_header" | $as_tr_cpp` 1 -_ACEOF - -fi - -done - - - - ac_fn_c_check_header_mongrel "$LINENO" "minix/config.h" "ac_cv_header_minix_config_h" "$ac_includes_default" -if test "x$ac_cv_header_minix_config_h" = xyes; then : - MINIX=yes -else - MINIX= -fi - - - if test "$MINIX" = yes; then - -$as_echo "#define _POSIX_SOURCE 1" >>confdefs.h - - -$as_echo "#define _POSIX_1_SOURCE 2" >>confdefs.h - - -$as_echo "#define _MINIX 1" >>confdefs.h - - fi - - - { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether it is safe to define __EXTENSIONS__" >&5 -$as_echo_n "checking whether it is safe to define __EXTENSIONS__... " >&6; } -if ${ac_cv_safe_to_define___extensions__+:} false; then : - $as_echo_n "(cached) " >&6 -else - cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ - -# define __EXTENSIONS__ 1 - $ac_includes_default -int -main () -{ - - ; - return 0; -} -_ACEOF -if ac_fn_c_try_compile "$LINENO"; then : - ac_cv_safe_to_define___extensions__=yes -else - ac_cv_safe_to_define___extensions__=no -fi -rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext -fi -{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_safe_to_define___extensions__" >&5 -$as_echo "$ac_cv_safe_to_define___extensions__" >&6; } - test $ac_cv_safe_to_define___extensions__ = yes && - $as_echo "#define __EXTENSIONS__ 1" >>confdefs.h - - $as_echo "#define _ALL_SOURCE 1" >>confdefs.h - - $as_echo "#define _GNU_SOURCE 1" >>confdefs.h - - $as_echo "#define _POSIX_PTHREAD_SEMANTICS 1" >>confdefs.h - - $as_echo "#define _TANDEM_SOURCE 1" >>confdefs.h - - - - -# general flags for compiler and linker and tests for those - -if test "x$LIBCOB_CPPFLAGS" != "x"; then - { $as_echo "$as_me:${as_lineno-$LINENO}: checking if compilation with LIBCOB_CPPFLAGS works" >&5 -$as_echo_n "checking if compilation with LIBCOB_CPPFLAGS works... " >&6; } - curr_cppflags="$CPPFLAGS" - CPPFLAGS="$CPPFLAGS $LIBCOB_CPPFLAGS" - cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ - -int -main () -{ -static int i = 1; - ; - return 0; -} -_ACEOF -if ac_fn_c_try_compile "$LINENO"; then : - { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5 -$as_echo "yes" >&6; } -else - { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 -$as_echo "no" >&6; } - as_fn_error $? "not possible to compile with LIBCOB_CPPFLAGS=\"$LIBCOB_CPPFLAGS\"" "$LINENO" 5 -fi -rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext - CPPFLAGS="$curr_cppflags" -fi - -curr_libs="$LIBS" - -if test "x$LIBCOB_LIBS" != "x"; then - { $as_echo "$as_me:${as_lineno-$LINENO}: checking if linking with LIBCOB_LIBS works" >&5 -$as_echo_n "checking if linking with LIBCOB_LIBS works... " >&6; } - LIBS="$LIBS $LIBCOB_LIBS" - cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ - -int -main () -{ -return 0; - ; - return 0; -} -_ACEOF -if ac_fn_c_try_link "$LINENO"; then : - { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5 -$as_echo "yes" >&6; } -else - { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 -$as_echo "no" >&6; } - as_fn_error $? "not possible to link with LIBCOB_LIBS=\"$LIBCOB_LIBS\"" "$LINENO" 5 -fi -rm -f core conftest.err conftest.$ac_objext \ - conftest$ac_exeext conftest.$ac_ext -fi - - -if test "x$COBC_LIBS" != "x"; then - { $as_echo "$as_me:${as_lineno-$LINENO}: checking if linking with COBC_LIBS works" >&5 -$as_echo_n "checking if linking with COBC_LIBS works... " >&6; } - LIBS="$LIBS $COBC_LIBS" - cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ - -int -main () -{ -return 0; - ; - return 0; -} -_ACEOF -if ac_fn_c_try_link "$LINENO"; then : - { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5 -$as_echo "yes" >&6; } -else - { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 -$as_echo "no" >&6; } - as_fn_error $? "not possible to link with COBC_LIBS=\"$COBC_LIBS\"" "$LINENO" 5 -fi -rm -f core conftest.err conftest.$ac_objext \ - conftest$ac_exeext conftest.$ac_ext -fi -LIBS="$curr_libs" - - -case `pwd` in - *\ * | *\ *) - { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: Libtool does not cope well with whitespace in \`pwd\`" >&5 -$as_echo "$as_me: WARNING: Libtool does not cope well with whitespace in \`pwd\`" >&2;} ;; -esac - - - -macro_version='2.4.6' -macro_revision='2.4.6' - - - - - - - - - - - - - -ltmain=$ac_aux_dir/ltmain.sh - -# Make sure we can run config.sub. -$SHELL "$ac_aux_dir/config.sub" sun4 >/dev/null 2>&1 || - as_fn_error $? "cannot run $SHELL $ac_aux_dir/config.sub" "$LINENO" 5 - -{ $as_echo "$as_me:${as_lineno-$LINENO}: checking build system type" >&5 -$as_echo_n "checking build system type... " >&6; } -if ${ac_cv_build+:} false; then : - $as_echo_n "(cached) " >&6 -else - ac_build_alias=$build_alias -test "x$ac_build_alias" = x && - ac_build_alias=`$SHELL "$ac_aux_dir/config.guess"` -test "x$ac_build_alias" = x && - as_fn_error $? "cannot guess build type; you must specify one" "$LINENO" 5 -ac_cv_build=`$SHELL "$ac_aux_dir/config.sub" $ac_build_alias` || - as_fn_error $? "$SHELL $ac_aux_dir/config.sub $ac_build_alias failed" "$LINENO" 5 - -fi -{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_build" >&5 -$as_echo "$ac_cv_build" >&6; } -case $ac_cv_build in -*-*-*) ;; -*) as_fn_error $? "invalid value of canonical build" "$LINENO" 5;; -esac -build=$ac_cv_build -ac_save_IFS=$IFS; IFS='-' -set x $ac_cv_build -shift -build_cpu=$1 -build_vendor=$2 -shift; shift -# Remember, the first character of IFS is used to create $*, -# except with old shells: -build_os=$* -IFS=$ac_save_IFS -case $build_os in *\ *) build_os=`echo "$build_os" | sed 's/ /-/g'`;; esac - - -{ $as_echo "$as_me:${as_lineno-$LINENO}: checking host system type" >&5 -$as_echo_n "checking host system type... " >&6; } -if ${ac_cv_host+:} false; then : - $as_echo_n "(cached) " >&6 -else - if test "x$host_alias" = x; then - ac_cv_host=$ac_cv_build -else - ac_cv_host=`$SHELL "$ac_aux_dir/config.sub" $host_alias` || - as_fn_error $? "$SHELL $ac_aux_dir/config.sub $host_alias failed" "$LINENO" 5 -fi - -fi -{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_host" >&5 -$as_echo "$ac_cv_host" >&6; } -case $ac_cv_host in -*-*-*) ;; -*) as_fn_error $? "invalid value of canonical host" "$LINENO" 5;; -esac -host=$ac_cv_host -ac_save_IFS=$IFS; IFS='-' -set x $ac_cv_host -shift -host_cpu=$1 -host_vendor=$2 -shift; shift -# Remember, the first character of IFS is used to create $*, -# except with old shells: -host_os=$* -IFS=$ac_save_IFS -case $host_os in *\ *) host_os=`echo "$host_os" | sed 's/ /-/g'`;; esac - - -# Backslashify metacharacters that are still active within -# double-quoted strings. -sed_quote_subst='s/\(["`$\\]\)/\\\1/g' - -# Same as above, but do not quote variable references. -double_quote_subst='s/\(["`\\]\)/\\\1/g' - -# Sed substitution to delay expansion of an escaped shell variable in a -# double_quote_subst'ed string. -delay_variable_subst='s/\\\\\\\\\\\$/\\\\\\$/g' - -# Sed substitution to delay expansion of an escaped single quote. -delay_single_quote_subst='s/'\''/'\'\\\\\\\'\''/g' - -# Sed substitution to avoid accidental globbing in evaled expressions -no_glob_subst='s/\*/\\\*/g' - -ECHO='\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\' -ECHO=$ECHO$ECHO$ECHO$ECHO$ECHO -ECHO=$ECHO$ECHO$ECHO$ECHO$ECHO$ECHO - -{ $as_echo "$as_me:${as_lineno-$LINENO}: checking how to print strings" >&5 -$as_echo_n "checking how to print strings... " >&6; } -# Test print first, because it will be a builtin if present. -if test "X`( print -r -- -n ) 2>/dev/null`" = X-n && \ - test "X`print -r -- $ECHO 2>/dev/null`" = "X$ECHO"; then - ECHO='print -r --' -elif test "X`printf %s $ECHO 2>/dev/null`" = "X$ECHO"; then - ECHO='printf %s\n' -else - # Use this function as a fallback that always works. - func_fallback_echo () - { - eval 'cat <<_LTECHO_EOF -$1 -_LTECHO_EOF' - } - ECHO='func_fallback_echo' -fi - -# func_echo_all arg... -# Invoke $ECHO with all args, space-separated. -func_echo_all () -{ - $ECHO "" -} - -case $ECHO in - printf*) { $as_echo "$as_me:${as_lineno-$LINENO}: result: printf" >&5 -$as_echo "printf" >&6; } ;; - print*) { $as_echo "$as_me:${as_lineno-$LINENO}: result: print -r" >&5 -$as_echo "print -r" >&6; } ;; - *) { $as_echo "$as_me:${as_lineno-$LINENO}: result: cat" >&5 -$as_echo "cat" >&6; } ;; -esac - - - - - - - - - - - - - - -{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for a sed that does not truncate output" >&5 -$as_echo_n "checking for a sed that does not truncate output... " >&6; } -if ${ac_cv_path_SED+:} false; then : - $as_echo_n "(cached) " >&6 -else - ac_script=s/aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa/bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb/ - for ac_i in 1 2 3 4 5 6 7; do - ac_script="$ac_script$as_nl$ac_script" - done - echo "$ac_script" 2>/dev/null | sed 99q >conftest.sed - { ac_script=; unset ac_script;} - if test -z "$SED"; then - ac_path_SED_found=false - # Loop through the user's path and test for each of PROGNAME-LIST - as_save_IFS=$IFS; IFS=$PATH_SEPARATOR -for as_dir in $PATH -do - IFS=$as_save_IFS - test -z "$as_dir" && as_dir=. - for ac_prog in sed gsed; do - for ac_exec_ext in '' $ac_executable_extensions; do - ac_path_SED="$as_dir/$ac_prog$ac_exec_ext" - as_fn_executable_p "$ac_path_SED" || continue -# Check for GNU ac_path_SED and select it if it is found. - # Check for GNU $ac_path_SED -case `"$ac_path_SED" --version 2>&1` in -*GNU*) - ac_cv_path_SED="$ac_path_SED" ac_path_SED_found=:;; -*) - ac_count=0 - $as_echo_n 0123456789 >"conftest.in" - while : - do - cat "conftest.in" "conftest.in" >"conftest.tmp" - mv "conftest.tmp" "conftest.in" - cp "conftest.in" "conftest.nl" - $as_echo '' >> "conftest.nl" - "$ac_path_SED" -f conftest.sed < "conftest.nl" >"conftest.out" 2>/dev/null || break - diff "conftest.out" "conftest.nl" >/dev/null 2>&1 || break - as_fn_arith $ac_count + 1 && ac_count=$as_val - if test $ac_count -gt ${ac_path_SED_max-0}; then - # Best one so far, save it but keep looking for a better one - ac_cv_path_SED="$ac_path_SED" - ac_path_SED_max=$ac_count - fi - # 10*(2^10) chars as input seems more than enough - test $ac_count -gt 10 && break - done - rm -f conftest.in conftest.tmp conftest.nl conftest.out;; -esac - - $ac_path_SED_found && break 3 - done - done - done -IFS=$as_save_IFS - if test -z "$ac_cv_path_SED"; then - as_fn_error $? "no acceptable sed could be found in \$PATH" "$LINENO" 5 - fi -else - ac_cv_path_SED=$SED -fi - -fi -{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_path_SED" >&5 -$as_echo "$ac_cv_path_SED" >&6; } - SED="$ac_cv_path_SED" - rm -f conftest.sed - -test -z "$SED" && SED=sed -Xsed="$SED -e 1s/^X//" - - - - - - - - - - - -{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for fgrep" >&5 -$as_echo_n "checking for fgrep... " >&6; } -if ${ac_cv_path_FGREP+:} false; then : - $as_echo_n "(cached) " >&6 -else - if echo 'ab*c' | $GREP -F 'ab*c' >/dev/null 2>&1 - then ac_cv_path_FGREP="$GREP -F" - else - if test -z "$FGREP"; then - ac_path_FGREP_found=false - # Loop through the user's path and test for each of PROGNAME-LIST - as_save_IFS=$IFS; IFS=$PATH_SEPARATOR -for as_dir in $PATH$PATH_SEPARATOR/usr/xpg4/bin -do - IFS=$as_save_IFS - test -z "$as_dir" && as_dir=. - for ac_prog in fgrep; do - for ac_exec_ext in '' $ac_executable_extensions; do - ac_path_FGREP="$as_dir/$ac_prog$ac_exec_ext" - as_fn_executable_p "$ac_path_FGREP" || continue -# Check for GNU ac_path_FGREP and select it if it is found. - # Check for GNU $ac_path_FGREP -case `"$ac_path_FGREP" --version 2>&1` in -*GNU*) - ac_cv_path_FGREP="$ac_path_FGREP" ac_path_FGREP_found=:;; -*) - ac_count=0 - $as_echo_n 0123456789 >"conftest.in" - while : - do - cat "conftest.in" "conftest.in" >"conftest.tmp" - mv "conftest.tmp" "conftest.in" - cp "conftest.in" "conftest.nl" - $as_echo 'FGREP' >> "conftest.nl" - "$ac_path_FGREP" FGREP < "conftest.nl" >"conftest.out" 2>/dev/null || break - diff "conftest.out" "conftest.nl" >/dev/null 2>&1 || break - as_fn_arith $ac_count + 1 && ac_count=$as_val - if test $ac_count -gt ${ac_path_FGREP_max-0}; then - # Best one so far, save it but keep looking for a better one - ac_cv_path_FGREP="$ac_path_FGREP" - ac_path_FGREP_max=$ac_count - fi - # 10*(2^10) chars as input seems more than enough - test $ac_count -gt 10 && break - done - rm -f conftest.in conftest.tmp conftest.nl conftest.out;; -esac - - $ac_path_FGREP_found && break 3 - done - done - done -IFS=$as_save_IFS - if test -z "$ac_cv_path_FGREP"; then - as_fn_error $? "no acceptable fgrep could be found in $PATH$PATH_SEPARATOR/usr/xpg4/bin" "$LINENO" 5 - fi -else - ac_cv_path_FGREP=$FGREP -fi - - fi -fi -{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_path_FGREP" >&5 -$as_echo "$ac_cv_path_FGREP" >&6; } - FGREP="$ac_cv_path_FGREP" - - -test -z "$GREP" && GREP=grep - - - - - - - - - - - - - - - - - - - -# Check whether --with-gnu-ld was given. -if test "${with_gnu_ld+set}" = set; then : - withval=$with_gnu_ld; test no = "$withval" || with_gnu_ld=yes -else - with_gnu_ld=no -fi - -ac_prog=ld -if test yes = "$GCC"; then - # Check if gcc -print-prog-name=ld gives a path. - { $as_echo "$as_me:${as_lineno-$LINENO}: checking for ld used by $CC" >&5 -$as_echo_n "checking for ld used by $CC... " >&6; } - case $host in - *-*-mingw*) - # gcc leaves a trailing carriage return, which upsets mingw - ac_prog=`($CC -print-prog-name=ld) 2>&5 | tr -d '\015'` ;; - *) - ac_prog=`($CC -print-prog-name=ld) 2>&5` ;; - esac - case $ac_prog in - # Accept absolute paths. - [\\/]* | ?:[\\/]*) - re_direlt='/[^/][^/]*/\.\./' - # Canonicalize the pathname of ld - ac_prog=`$ECHO "$ac_prog"| $SED 's%\\\\%/%g'` - while $ECHO "$ac_prog" | $GREP "$re_direlt" > /dev/null 2>&1; do - ac_prog=`$ECHO $ac_prog| $SED "s%$re_direlt%/%"` - done - test -z "$LD" && LD=$ac_prog - ;; - "") - # If it fails, then pretend we aren't using GCC. - ac_prog=ld - ;; - *) - # If it is relative, then search for the first ld in PATH. - with_gnu_ld=unknown - ;; - esac -elif test yes = "$with_gnu_ld"; then - { $as_echo "$as_me:${as_lineno-$LINENO}: checking for GNU ld" >&5 -$as_echo_n "checking for GNU ld... " >&6; } -else - { $as_echo "$as_me:${as_lineno-$LINENO}: checking for non-GNU ld" >&5 -$as_echo_n "checking for non-GNU ld... " >&6; } -fi -if ${lt_cv_path_LD+:} false; then : - $as_echo_n "(cached) " >&6 -else - if test -z "$LD"; then - lt_save_ifs=$IFS; IFS=$PATH_SEPARATOR - for ac_dir in $PATH; do - IFS=$lt_save_ifs - test -z "$ac_dir" && ac_dir=. - if test -f "$ac_dir/$ac_prog" || test -f "$ac_dir/$ac_prog$ac_exeext"; then - lt_cv_path_LD=$ac_dir/$ac_prog - # Check to see if the program is GNU ld. I'd rather use --version, - # but apparently some variants of GNU ld only accept -v. - # Break only if it was the GNU/non-GNU ld that we prefer. - case `"$lt_cv_path_LD" -v 2>&1 &5 -$as_echo "$LD" >&6; } -else - { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 -$as_echo "no" >&6; } -fi -test -z "$LD" && as_fn_error $? "no acceptable ld found in \$PATH" "$LINENO" 5 -{ $as_echo "$as_me:${as_lineno-$LINENO}: checking if the linker ($LD) is GNU ld" >&5 -$as_echo_n "checking if the linker ($LD) is GNU ld... " >&6; } -if ${lt_cv_prog_gnu_ld+:} false; then : - $as_echo_n "(cached) " >&6 -else - # I'd rather use --version here, but apparently some GNU lds only accept -v. -case `$LD -v 2>&1 &5 -$as_echo "$lt_cv_prog_gnu_ld" >&6; } -with_gnu_ld=$lt_cv_prog_gnu_ld - - - - - - - - - -{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for BSD- or MS-compatible name lister (nm)" >&5 -$as_echo_n "checking for BSD- or MS-compatible name lister (nm)... " >&6; } -if ${lt_cv_path_NM+:} false; then : - $as_echo_n "(cached) " >&6 -else - if test -n "$NM"; then - # Let the user override the test. - lt_cv_path_NM=$NM -else - lt_nm_to_check=${ac_tool_prefix}nm - if test -n "$ac_tool_prefix" && test "$build" = "$host"; then - lt_nm_to_check="$lt_nm_to_check nm" - fi - for lt_tmp_nm in $lt_nm_to_check; do - lt_save_ifs=$IFS; IFS=$PATH_SEPARATOR - for ac_dir in $PATH /usr/ccs/bin/elf /usr/ccs/bin /usr/ucb /bin; do - IFS=$lt_save_ifs - test -z "$ac_dir" && ac_dir=. - tmp_nm=$ac_dir/$lt_tmp_nm - if test -f "$tmp_nm" || test -f "$tmp_nm$ac_exeext"; then - # Check to see if the nm accepts a BSD-compat flag. - # Adding the 'sed 1q' prevents false positives on HP-UX, which says: - # nm: unknown option "B" ignored - # Tru64's nm complains that /dev/null is an invalid object file - # MSYS converts /dev/null to NUL, MinGW nm treats NUL as empty - case $build_os in - mingw*) lt_bad_file=conftest.nm/nofile ;; - *) lt_bad_file=/dev/null ;; - esac - case `"$tmp_nm" -B $lt_bad_file 2>&1 | sed '1q'` in - *$lt_bad_file* | *'Invalid file or object type'*) - lt_cv_path_NM="$tmp_nm -B" - break 2 - ;; - *) - case `"$tmp_nm" -p /dev/null 2>&1 | sed '1q'` in - */dev/null*) - lt_cv_path_NM="$tmp_nm -p" - break 2 - ;; - *) - lt_cv_path_NM=${lt_cv_path_NM="$tmp_nm"} # keep the first match, but - continue # so that we can try to find one that supports BSD flags - ;; - esac - ;; - esac - fi - done - IFS=$lt_save_ifs - done - : ${lt_cv_path_NM=no} -fi -fi -{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $lt_cv_path_NM" >&5 -$as_echo "$lt_cv_path_NM" >&6; } -if test no != "$lt_cv_path_NM"; then - NM=$lt_cv_path_NM -else - # Didn't find any BSD compatible name lister, look for dumpbin. - if test -n "$DUMPBIN"; then : - # Let the user override the test. - else - if test -n "$ac_tool_prefix"; then - for ac_prog in dumpbin "link -dump" - do - # Extract the first word of "$ac_tool_prefix$ac_prog", so it can be a program name with args. -set dummy $ac_tool_prefix$ac_prog; ac_word=$2 -{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 -$as_echo_n "checking for $ac_word... " >&6; } -if ${ac_cv_prog_DUMPBIN+:} false; then : - $as_echo_n "(cached) " >&6 -else - if test -n "$DUMPBIN"; then - ac_cv_prog_DUMPBIN="$DUMPBIN" # Let the user override the test. -else -as_save_IFS=$IFS; IFS=$PATH_SEPARATOR -for as_dir in $PATH -do - IFS=$as_save_IFS - test -z "$as_dir" && as_dir=. - for ac_exec_ext in '' $ac_executable_extensions; do - if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then - ac_cv_prog_DUMPBIN="$ac_tool_prefix$ac_prog" - $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 - break 2 - fi -done - done -IFS=$as_save_IFS - -fi -fi -DUMPBIN=$ac_cv_prog_DUMPBIN -if test -n "$DUMPBIN"; then - { $as_echo "$as_me:${as_lineno-$LINENO}: result: $DUMPBIN" >&5 -$as_echo "$DUMPBIN" >&6; } -else - { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 -$as_echo "no" >&6; } -fi - - - test -n "$DUMPBIN" && break - done -fi -if test -z "$DUMPBIN"; then - ac_ct_DUMPBIN=$DUMPBIN - for ac_prog in dumpbin "link -dump" -do - # Extract the first word of "$ac_prog", so it can be a program name with args. -set dummy $ac_prog; ac_word=$2 -{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 -$as_echo_n "checking for $ac_word... " >&6; } -if ${ac_cv_prog_ac_ct_DUMPBIN+:} false; then : - $as_echo_n "(cached) " >&6 -else - if test -n "$ac_ct_DUMPBIN"; then - ac_cv_prog_ac_ct_DUMPBIN="$ac_ct_DUMPBIN" # Let the user override the test. -else -as_save_IFS=$IFS; IFS=$PATH_SEPARATOR -for as_dir in $PATH -do - IFS=$as_save_IFS - test -z "$as_dir" && as_dir=. - for ac_exec_ext in '' $ac_executable_extensions; do - if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then - ac_cv_prog_ac_ct_DUMPBIN="$ac_prog" - $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 - break 2 - fi -done - done -IFS=$as_save_IFS - -fi -fi -ac_ct_DUMPBIN=$ac_cv_prog_ac_ct_DUMPBIN -if test -n "$ac_ct_DUMPBIN"; then - { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_ct_DUMPBIN" >&5 -$as_echo "$ac_ct_DUMPBIN" >&6; } -else - { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 -$as_echo "no" >&6; } -fi - - - test -n "$ac_ct_DUMPBIN" && break -done - - if test "x$ac_ct_DUMPBIN" = x; then - DUMPBIN=":" - else - case $cross_compiling:$ac_tool_warned in -yes:) -{ $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5 -$as_echo "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;} -ac_tool_warned=yes ;; -esac - DUMPBIN=$ac_ct_DUMPBIN - fi -fi - - case `$DUMPBIN -symbols -headers /dev/null 2>&1 | sed '1q'` in - *COFF*) - DUMPBIN="$DUMPBIN -symbols -headers" - ;; - *) - DUMPBIN=: - ;; - esac - fi - - if test : != "$DUMPBIN"; then - NM=$DUMPBIN - fi -fi -test -z "$NM" && NM=nm - - - - - - -{ $as_echo "$as_me:${as_lineno-$LINENO}: checking the name lister ($NM) interface" >&5 -$as_echo_n "checking the name lister ($NM) interface... " >&6; } -if ${lt_cv_nm_interface+:} false; then : - $as_echo_n "(cached) " >&6 -else - lt_cv_nm_interface="BSD nm" - echo "int some_variable = 0;" > conftest.$ac_ext - (eval echo "\"\$as_me:$LINENO: $ac_compile\"" >&5) - (eval "$ac_compile" 2>conftest.err) - cat conftest.err >&5 - (eval echo "\"\$as_me:$LINENO: $NM \\\"conftest.$ac_objext\\\"\"" >&5) - (eval "$NM \"conftest.$ac_objext\"" 2>conftest.err > conftest.out) - cat conftest.err >&5 - (eval echo "\"\$as_me:$LINENO: output\"" >&5) - cat conftest.out >&5 - if $GREP 'External.*some_variable' conftest.out > /dev/null; then - lt_cv_nm_interface="MS dumpbin" - fi - rm -f conftest* -fi -{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $lt_cv_nm_interface" >&5 -$as_echo "$lt_cv_nm_interface" >&6; } - -{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether ln -s works" >&5 -$as_echo_n "checking whether ln -s works... " >&6; } -LN_S=$as_ln_s -if test "$LN_S" = "ln -s"; then - { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5 -$as_echo "yes" >&6; } -else - { $as_echo "$as_me:${as_lineno-$LINENO}: result: no, using $LN_S" >&5 -$as_echo "no, using $LN_S" >&6; } -fi - -# find the maximum length of command line arguments -{ $as_echo "$as_me:${as_lineno-$LINENO}: checking the maximum length of command line arguments" >&5 -$as_echo_n "checking the maximum length of command line arguments... " >&6; } -if ${lt_cv_sys_max_cmd_len+:} false; then : - $as_echo_n "(cached) " >&6 -else - i=0 - teststring=ABCD - - case $build_os in - msdosdjgpp*) - # On DJGPP, this test can blow up pretty badly due to problems in libc - # (any single argument exceeding 2000 bytes causes a buffer overrun - # during glob expansion). Even if it were fixed, the result of this - # check would be larger than it should be. - lt_cv_sys_max_cmd_len=12288; # 12K is about right - ;; - - gnu*) - # Under GNU Hurd, this test is not required because there is - # no limit to the length of command line arguments. - # Libtool will interpret -1 as no limit whatsoever - lt_cv_sys_max_cmd_len=-1; - ;; - - cygwin* | mingw* | cegcc*) - # On Win9x/ME, this test blows up -- it succeeds, but takes - # about 5 minutes as the teststring grows exponentially. - # Worse, since 9x/ME are not pre-emptively multitasking, - # you end up with a "frozen" computer, even though with patience - # the test eventually succeeds (with a max line length of 256k). - # Instead, let's just punt: use the minimum linelength reported by - # all of the supported platforms: 8192 (on NT/2K/XP). - lt_cv_sys_max_cmd_len=8192; - ;; - - mint*) - # On MiNT this can take a long time and run out of memory. - lt_cv_sys_max_cmd_len=8192; - ;; - - amigaos*) - # On AmigaOS with pdksh, this test takes hours, literally. - # So we just punt and use a minimum line length of 8192. - lt_cv_sys_max_cmd_len=8192; - ;; - - bitrig* | darwin* | dragonfly* | freebsd* | netbsd* | openbsd*) - # This has been around since 386BSD, at least. Likely further. - if test -x /sbin/sysctl; then - lt_cv_sys_max_cmd_len=`/sbin/sysctl -n kern.argmax` - elif test -x /usr/sbin/sysctl; then - lt_cv_sys_max_cmd_len=`/usr/sbin/sysctl -n kern.argmax` - else - lt_cv_sys_max_cmd_len=65536 # usable default for all BSDs - fi - # And add a safety zone - lt_cv_sys_max_cmd_len=`expr $lt_cv_sys_max_cmd_len \/ 4` - lt_cv_sys_max_cmd_len=`expr $lt_cv_sys_max_cmd_len \* 3` - ;; - - interix*) - # We know the value 262144 and hardcode it with a safety zone (like BSD) - lt_cv_sys_max_cmd_len=196608 - ;; - - os2*) - # The test takes a long time on OS/2. - lt_cv_sys_max_cmd_len=8192 - ;; - - osf*) - # Dr. Hans Ekkehard Plesser reports seeing a kernel panic running configure - # due to this test when exec_disable_arg_limit is 1 on Tru64. It is not - # nice to cause kernel panics so lets avoid the loop below. - # First set a reasonable default. - lt_cv_sys_max_cmd_len=16384 - # - if test -x /sbin/sysconfig; then - case `/sbin/sysconfig -q proc exec_disable_arg_limit` in - *1*) lt_cv_sys_max_cmd_len=-1 ;; - esac - fi - ;; - sco3.2v5*) - lt_cv_sys_max_cmd_len=102400 - ;; - sysv5* | sco5v6* | sysv4.2uw2*) - kargmax=`grep ARG_MAX /etc/conf/cf.d/stune 2>/dev/null` - if test -n "$kargmax"; then - lt_cv_sys_max_cmd_len=`echo $kargmax | sed 's/.*[ ]//'` - else - lt_cv_sys_max_cmd_len=32768 - fi - ;; - *) - lt_cv_sys_max_cmd_len=`(getconf ARG_MAX) 2> /dev/null` - if test -n "$lt_cv_sys_max_cmd_len" && \ - test undefined != "$lt_cv_sys_max_cmd_len"; then - lt_cv_sys_max_cmd_len=`expr $lt_cv_sys_max_cmd_len \/ 4` - lt_cv_sys_max_cmd_len=`expr $lt_cv_sys_max_cmd_len \* 3` - else - # Make teststring a little bigger before we do anything with it. - # a 1K string should be a reasonable start. - for i in 1 2 3 4 5 6 7 8; do - teststring=$teststring$teststring - done - SHELL=${SHELL-${CONFIG_SHELL-/bin/sh}} - # If test is not a shell built-in, we'll probably end up computing a - # maximum length that is only half of the actual maximum length, but - # we can't tell. - while { test X`env echo "$teststring$teststring" 2>/dev/null` \ - = "X$teststring$teststring"; } >/dev/null 2>&1 && - test 17 != "$i" # 1/2 MB should be enough - do - i=`expr $i + 1` - teststring=$teststring$teststring - done - # Only check the string length outside the loop. - lt_cv_sys_max_cmd_len=`expr "X$teststring" : ".*" 2>&1` - teststring= - # Add a significant safety factor because C++ compilers can tack on - # massive amounts of additional arguments before passing them to the - # linker. It appears as though 1/2 is a usable value. - lt_cv_sys_max_cmd_len=`expr $lt_cv_sys_max_cmd_len \/ 2` - fi - ;; - esac - -fi - -if test -n "$lt_cv_sys_max_cmd_len"; then - { $as_echo "$as_me:${as_lineno-$LINENO}: result: $lt_cv_sys_max_cmd_len" >&5 -$as_echo "$lt_cv_sys_max_cmd_len" >&6; } -else - { $as_echo "$as_me:${as_lineno-$LINENO}: result: none" >&5 -$as_echo "none" >&6; } -fi -max_cmd_len=$lt_cv_sys_max_cmd_len - - - - - - -: ${CP="cp -f"} -: ${MV="mv -f"} -: ${RM="rm -f"} - -if ( (MAIL=60; unset MAIL) || exit) >/dev/null 2>&1; then - lt_unset=unset -else - lt_unset=false -fi - - - - - -# test EBCDIC or ASCII -case `echo X|tr X '\101'` in - A) # ASCII based system - # \n is not interpreted correctly by Solaris 8 /usr/ucb/tr - lt_SP2NL='tr \040 \012' - lt_NL2SP='tr \015\012 \040\040' - ;; - *) # EBCDIC based system - lt_SP2NL='tr \100 \n' - lt_NL2SP='tr \r\n \100\100' - ;; -esac - - - - - - - - - -{ $as_echo "$as_me:${as_lineno-$LINENO}: checking how to convert $build file names to $host format" >&5 -$as_echo_n "checking how to convert $build file names to $host format... " >&6; } -if ${lt_cv_to_host_file_cmd+:} false; then : - $as_echo_n "(cached) " >&6 -else - case $host in - *-*-mingw* ) - case $build in - *-*-mingw* ) # actually msys - lt_cv_to_host_file_cmd=func_convert_file_msys_to_w32 - ;; - *-*-cygwin* ) - lt_cv_to_host_file_cmd=func_convert_file_cygwin_to_w32 - ;; - * ) # otherwise, assume *nix - lt_cv_to_host_file_cmd=func_convert_file_nix_to_w32 - ;; - esac - ;; - *-*-cygwin* ) - case $build in - *-*-mingw* ) # actually msys - lt_cv_to_host_file_cmd=func_convert_file_msys_to_cygwin - ;; - *-*-cygwin* ) - lt_cv_to_host_file_cmd=func_convert_file_noop - ;; - * ) # otherwise, assume *nix - lt_cv_to_host_file_cmd=func_convert_file_nix_to_cygwin - ;; - esac - ;; - * ) # unhandled hosts (and "normal" native builds) - lt_cv_to_host_file_cmd=func_convert_file_noop - ;; -esac - -fi - -to_host_file_cmd=$lt_cv_to_host_file_cmd -{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $lt_cv_to_host_file_cmd" >&5 -$as_echo "$lt_cv_to_host_file_cmd" >&6; } - - - - - -{ $as_echo "$as_me:${as_lineno-$LINENO}: checking how to convert $build file names to toolchain format" >&5 -$as_echo_n "checking how to convert $build file names to toolchain format... " >&6; } -if ${lt_cv_to_tool_file_cmd+:} false; then : - $as_echo_n "(cached) " >&6 -else - #assume ordinary cross tools, or native build. -lt_cv_to_tool_file_cmd=func_convert_file_noop -case $host in - *-*-mingw* ) - case $build in - *-*-mingw* ) # actually msys - lt_cv_to_tool_file_cmd=func_convert_file_msys_to_w32 - ;; - esac - ;; -esac - -fi - -to_tool_file_cmd=$lt_cv_to_tool_file_cmd -{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $lt_cv_to_tool_file_cmd" >&5 -$as_echo "$lt_cv_to_tool_file_cmd" >&6; } - - - - - -{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $LD option to reload object files" >&5 -$as_echo_n "checking for $LD option to reload object files... " >&6; } -if ${lt_cv_ld_reload_flag+:} false; then : - $as_echo_n "(cached) " >&6 -else - lt_cv_ld_reload_flag='-r' -fi -{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $lt_cv_ld_reload_flag" >&5 -$as_echo "$lt_cv_ld_reload_flag" >&6; } -reload_flag=$lt_cv_ld_reload_flag -case $reload_flag in -"" | " "*) ;; -*) reload_flag=" $reload_flag" ;; -esac -reload_cmds='$LD$reload_flag -o $output$reload_objs' -case $host_os in - cygwin* | mingw* | pw32* | cegcc*) - if test yes != "$GCC"; then - reload_cmds=false - fi - ;; - darwin*) - if test yes = "$GCC"; then - reload_cmds='$LTCC $LTCFLAGS -nostdlib $wl-r -o $output$reload_objs' - else - reload_cmds='$LD$reload_flag -o $output$reload_objs' - fi - ;; -esac - - - - - - - - - -if test -n "$ac_tool_prefix"; then - # Extract the first word of "${ac_tool_prefix}objdump", so it can be a program name with args. -set dummy ${ac_tool_prefix}objdump; ac_word=$2 -{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 -$as_echo_n "checking for $ac_word... " >&6; } -if ${ac_cv_prog_OBJDUMP+:} false; then : - $as_echo_n "(cached) " >&6 -else - if test -n "$OBJDUMP"; then - ac_cv_prog_OBJDUMP="$OBJDUMP" # Let the user override the test. -else -as_save_IFS=$IFS; IFS=$PATH_SEPARATOR -for as_dir in $PATH -do - IFS=$as_save_IFS - test -z "$as_dir" && as_dir=. - for ac_exec_ext in '' $ac_executable_extensions; do - if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then - ac_cv_prog_OBJDUMP="${ac_tool_prefix}objdump" - $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 - break 2 - fi -done - done -IFS=$as_save_IFS - -fi -fi -OBJDUMP=$ac_cv_prog_OBJDUMP -if test -n "$OBJDUMP"; then - { $as_echo "$as_me:${as_lineno-$LINENO}: result: $OBJDUMP" >&5 -$as_echo "$OBJDUMP" >&6; } -else - { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 -$as_echo "no" >&6; } -fi - - -fi -if test -z "$ac_cv_prog_OBJDUMP"; then - ac_ct_OBJDUMP=$OBJDUMP - # Extract the first word of "objdump", so it can be a program name with args. -set dummy objdump; ac_word=$2 -{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 -$as_echo_n "checking for $ac_word... " >&6; } -if ${ac_cv_prog_ac_ct_OBJDUMP+:} false; then : - $as_echo_n "(cached) " >&6 -else - if test -n "$ac_ct_OBJDUMP"; then - ac_cv_prog_ac_ct_OBJDUMP="$ac_ct_OBJDUMP" # Let the user override the test. -else -as_save_IFS=$IFS; IFS=$PATH_SEPARATOR -for as_dir in $PATH -do - IFS=$as_save_IFS - test -z "$as_dir" && as_dir=. - for ac_exec_ext in '' $ac_executable_extensions; do - if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then - ac_cv_prog_ac_ct_OBJDUMP="objdump" - $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 - break 2 - fi -done - done -IFS=$as_save_IFS - -fi -fi -ac_ct_OBJDUMP=$ac_cv_prog_ac_ct_OBJDUMP -if test -n "$ac_ct_OBJDUMP"; then - { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_ct_OBJDUMP" >&5 -$as_echo "$ac_ct_OBJDUMP" >&6; } -else - { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 -$as_echo "no" >&6; } -fi - - if test "x$ac_ct_OBJDUMP" = x; then - OBJDUMP="false" - else - case $cross_compiling:$ac_tool_warned in -yes:) -{ $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5 -$as_echo "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;} -ac_tool_warned=yes ;; -esac - OBJDUMP=$ac_ct_OBJDUMP - fi -else - OBJDUMP="$ac_cv_prog_OBJDUMP" -fi - -test -z "$OBJDUMP" && OBJDUMP=objdump - - - - - - -{ $as_echo "$as_me:${as_lineno-$LINENO}: checking how to recognize dependent libraries" >&5 -$as_echo_n "checking how to recognize dependent libraries... " >&6; } -if ${lt_cv_deplibs_check_method+:} false; then : - $as_echo_n "(cached) " >&6 -else - lt_cv_file_magic_cmd='$MAGIC_CMD' -lt_cv_file_magic_test_file= -lt_cv_deplibs_check_method='unknown' -# Need to set the preceding variable on all platforms that support -# interlibrary dependencies. -# 'none' -- dependencies not supported. -# 'unknown' -- same as none, but documents that we really don't know. -# 'pass_all' -- all dependencies passed with no checks. -# 'test_compile' -- check by making test program. -# 'file_magic [[regex]]' -- check by looking for files in library path -# that responds to the $file_magic_cmd with a given extended regex. -# If you have 'file' or equivalent on your system and you're not sure -# whether 'pass_all' will *always* work, you probably want this one. - -case $host_os in -aix[4-9]*) - lt_cv_deplibs_check_method=pass_all - ;; - -beos*) - lt_cv_deplibs_check_method=pass_all - ;; - -bsdi[45]*) - lt_cv_deplibs_check_method='file_magic ELF [0-9][0-9]*-bit [ML]SB (shared object|dynamic lib)' - lt_cv_file_magic_cmd='/usr/bin/file -L' - lt_cv_file_magic_test_file=/shlib/libc.so - ;; - -cygwin*) - # func_win32_libid is a shell function defined in ltmain.sh - lt_cv_deplibs_check_method='file_magic ^x86 archive import|^x86 DLL' - lt_cv_file_magic_cmd='func_win32_libid' - ;; - -mingw* | pw32*) - # Base MSYS/MinGW do not provide the 'file' command needed by - # func_win32_libid shell function, so use a weaker test based on 'objdump', - # unless we find 'file', for example because we are cross-compiling. - if ( file / ) >/dev/null 2>&1; then - lt_cv_deplibs_check_method='file_magic ^x86 archive import|^x86 DLL' - lt_cv_file_magic_cmd='func_win32_libid' - else - # Keep this pattern in sync with the one in func_win32_libid. - lt_cv_deplibs_check_method='file_magic file format (pei*-i386(.*architecture: i386)?|pe-arm-wince|pe-x86-64)' - lt_cv_file_magic_cmd='$OBJDUMP -f' - fi - ;; - -cegcc*) - # use the weaker test based on 'objdump'. See mingw*. - lt_cv_deplibs_check_method='file_magic file format pe-arm-.*little(.*architecture: arm)?' - lt_cv_file_magic_cmd='$OBJDUMP -f' - ;; - -darwin* | rhapsody*) - lt_cv_deplibs_check_method=pass_all - ;; - -freebsd* | dragonfly*) - if echo __ELF__ | $CC -E - | $GREP __ELF__ > /dev/null; then - case $host_cpu in - i*86 ) - # Not sure whether the presence of OpenBSD here was a mistake. - # Let's accept both of them until this is cleared up. - lt_cv_deplibs_check_method='file_magic (FreeBSD|OpenBSD|DragonFly)/i[3-9]86 (compact )?demand paged shared library' - lt_cv_file_magic_cmd=/usr/bin/file - lt_cv_file_magic_test_file=`echo /usr/lib/libc.so.*` - ;; - esac - else - lt_cv_deplibs_check_method=pass_all - fi - ;; - -haiku*) - lt_cv_deplibs_check_method=pass_all - ;; - -hpux10.20* | hpux11*) - lt_cv_file_magic_cmd=/usr/bin/file - case $host_cpu in - ia64*) - lt_cv_deplibs_check_method='file_magic (s[0-9][0-9][0-9]|ELF-[0-9][0-9]) shared object file - IA64' - lt_cv_file_magic_test_file=/usr/lib/hpux32/libc.so - ;; - hppa*64*) - lt_cv_deplibs_check_method='file_magic (s[0-9][0-9][0-9]|ELF[ -][0-9][0-9])(-bit)?( [LM]SB)? shared object( file)?[, -]* PA-RISC [0-9]\.[0-9]' - lt_cv_file_magic_test_file=/usr/lib/pa20_64/libc.sl - ;; - *) - lt_cv_deplibs_check_method='file_magic (s[0-9][0-9][0-9]|PA-RISC[0-9]\.[0-9]) shared library' - lt_cv_file_magic_test_file=/usr/lib/libc.sl - ;; - esac - ;; - -interix[3-9]*) - # PIC code is broken on Interix 3.x, that's why |\.a not |_pic\.a here - lt_cv_deplibs_check_method='match_pattern /lib[^/]+(\.so|\.a)$' - ;; - -irix5* | irix6* | nonstopux*) - case $LD in - *-32|*"-32 ") libmagic=32-bit;; - *-n32|*"-n32 ") libmagic=N32;; - *-64|*"-64 ") libmagic=64-bit;; - *) libmagic=never-match;; - esac - lt_cv_deplibs_check_method=pass_all - ;; - -# This must be glibc/ELF. -linux* | k*bsd*-gnu | kopensolaris*-gnu | gnu*) - lt_cv_deplibs_check_method=pass_all - ;; - -netbsd*) - if echo __ELF__ | $CC -E - | $GREP __ELF__ > /dev/null; then - lt_cv_deplibs_check_method='match_pattern /lib[^/]+(\.so\.[0-9]+\.[0-9]+|_pic\.a)$' - else - lt_cv_deplibs_check_method='match_pattern /lib[^/]+(\.so|_pic\.a)$' - fi - ;; - -newos6*) - lt_cv_deplibs_check_method='file_magic ELF [0-9][0-9]*-bit [ML]SB (executable|dynamic lib)' - lt_cv_file_magic_cmd=/usr/bin/file - lt_cv_file_magic_test_file=/usr/lib/libnls.so - ;; - -*nto* | *qnx*) - lt_cv_deplibs_check_method=pass_all - ;; - -openbsd* | bitrig*) - if test -z "`echo __ELF__ | $CC -E - | $GREP __ELF__`"; then - lt_cv_deplibs_check_method='match_pattern /lib[^/]+(\.so\.[0-9]+\.[0-9]+|\.so|_pic\.a)$' - else - lt_cv_deplibs_check_method='match_pattern /lib[^/]+(\.so\.[0-9]+\.[0-9]+|_pic\.a)$' - fi - ;; - -osf3* | osf4* | osf5*) - lt_cv_deplibs_check_method=pass_all - ;; - -rdos*) - lt_cv_deplibs_check_method=pass_all - ;; - -solaris*) - lt_cv_deplibs_check_method=pass_all - ;; - -sysv5* | sco3.2v5* | sco5v6* | unixware* | OpenUNIX* | sysv4*uw2*) - lt_cv_deplibs_check_method=pass_all - ;; - -sysv4 | sysv4.3*) - case $host_vendor in - motorola) - lt_cv_deplibs_check_method='file_magic ELF [0-9][0-9]*-bit [ML]SB (shared object|dynamic lib) M[0-9][0-9]* Version [0-9]' - lt_cv_file_magic_test_file=`echo /usr/lib/libc.so*` - ;; - ncr) - lt_cv_deplibs_check_method=pass_all - ;; - sequent) - lt_cv_file_magic_cmd='/bin/file' - lt_cv_deplibs_check_method='file_magic ELF [0-9][0-9]*-bit [LM]SB (shared object|dynamic lib )' - ;; - sni) - lt_cv_file_magic_cmd='/bin/file' - lt_cv_deplibs_check_method="file_magic ELF [0-9][0-9]*-bit [LM]SB dynamic lib" - lt_cv_file_magic_test_file=/lib/libc.so - ;; - siemens) - lt_cv_deplibs_check_method=pass_all - ;; - pc) - lt_cv_deplibs_check_method=pass_all - ;; - esac - ;; - -tpf*) - lt_cv_deplibs_check_method=pass_all - ;; -os2*) - lt_cv_deplibs_check_method=pass_all - ;; -esac - -fi -{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $lt_cv_deplibs_check_method" >&5 -$as_echo "$lt_cv_deplibs_check_method" >&6; } - -file_magic_glob= -want_nocaseglob=no -if test "$build" = "$host"; then - case $host_os in - mingw* | pw32*) - if ( shopt | grep nocaseglob ) >/dev/null 2>&1; then - want_nocaseglob=yes - else - file_magic_glob=`echo aAbBcCdDeEfFgGhHiIjJkKlLmMnNoOpPqQrRsStTuUvVwWxXyYzZ | $SED -e "s/\(..\)/s\/[\1]\/[\1]\/g;/g"` - fi - ;; - esac -fi - -file_magic_cmd=$lt_cv_file_magic_cmd -deplibs_check_method=$lt_cv_deplibs_check_method -test -z "$deplibs_check_method" && deplibs_check_method=unknown - - - - - - - - - - - - - - - - - - - - - - -if test -n "$ac_tool_prefix"; then - # Extract the first word of "${ac_tool_prefix}dlltool", so it can be a program name with args. -set dummy ${ac_tool_prefix}dlltool; ac_word=$2 -{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 -$as_echo_n "checking for $ac_word... " >&6; } -if ${ac_cv_prog_DLLTOOL+:} false; then : - $as_echo_n "(cached) " >&6 -else - if test -n "$DLLTOOL"; then - ac_cv_prog_DLLTOOL="$DLLTOOL" # Let the user override the test. -else -as_save_IFS=$IFS; IFS=$PATH_SEPARATOR -for as_dir in $PATH -do - IFS=$as_save_IFS - test -z "$as_dir" && as_dir=. - for ac_exec_ext in '' $ac_executable_extensions; do - if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then - ac_cv_prog_DLLTOOL="${ac_tool_prefix}dlltool" - $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 - break 2 - fi -done - done -IFS=$as_save_IFS - -fi -fi -DLLTOOL=$ac_cv_prog_DLLTOOL -if test -n "$DLLTOOL"; then - { $as_echo "$as_me:${as_lineno-$LINENO}: result: $DLLTOOL" >&5 -$as_echo "$DLLTOOL" >&6; } -else - { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 -$as_echo "no" >&6; } -fi - - -fi -if test -z "$ac_cv_prog_DLLTOOL"; then - ac_ct_DLLTOOL=$DLLTOOL - # Extract the first word of "dlltool", so it can be a program name with args. -set dummy dlltool; ac_word=$2 -{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 -$as_echo_n "checking for $ac_word... " >&6; } -if ${ac_cv_prog_ac_ct_DLLTOOL+:} false; then : - $as_echo_n "(cached) " >&6 -else - if test -n "$ac_ct_DLLTOOL"; then - ac_cv_prog_ac_ct_DLLTOOL="$ac_ct_DLLTOOL" # Let the user override the test. -else -as_save_IFS=$IFS; IFS=$PATH_SEPARATOR -for as_dir in $PATH -do - IFS=$as_save_IFS - test -z "$as_dir" && as_dir=. - for ac_exec_ext in '' $ac_executable_extensions; do - if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then - ac_cv_prog_ac_ct_DLLTOOL="dlltool" - $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 - break 2 - fi -done - done -IFS=$as_save_IFS - -fi -fi -ac_ct_DLLTOOL=$ac_cv_prog_ac_ct_DLLTOOL -if test -n "$ac_ct_DLLTOOL"; then - { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_ct_DLLTOOL" >&5 -$as_echo "$ac_ct_DLLTOOL" >&6; } -else - { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 -$as_echo "no" >&6; } -fi - - if test "x$ac_ct_DLLTOOL" = x; then - DLLTOOL="false" - else - case $cross_compiling:$ac_tool_warned in -yes:) -{ $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5 -$as_echo "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;} -ac_tool_warned=yes ;; -esac - DLLTOOL=$ac_ct_DLLTOOL - fi -else - DLLTOOL="$ac_cv_prog_DLLTOOL" -fi - -test -z "$DLLTOOL" && DLLTOOL=dlltool - - - - - - - -{ $as_echo "$as_me:${as_lineno-$LINENO}: checking how to associate runtime and link libraries" >&5 -$as_echo_n "checking how to associate runtime and link libraries... " >&6; } -if ${lt_cv_sharedlib_from_linklib_cmd+:} false; then : - $as_echo_n "(cached) " >&6 -else - lt_cv_sharedlib_from_linklib_cmd='unknown' - -case $host_os in -cygwin* | mingw* | pw32* | cegcc*) - # two different shell functions defined in ltmain.sh; - # decide which one to use based on capabilities of $DLLTOOL - case `$DLLTOOL --help 2>&1` in - *--identify-strict*) - lt_cv_sharedlib_from_linklib_cmd=func_cygming_dll_for_implib - ;; - *) - lt_cv_sharedlib_from_linklib_cmd=func_cygming_dll_for_implib_fallback - ;; - esac - ;; -*) - # fallback: assume linklib IS sharedlib - lt_cv_sharedlib_from_linklib_cmd=$ECHO - ;; -esac - -fi -{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $lt_cv_sharedlib_from_linklib_cmd" >&5 -$as_echo "$lt_cv_sharedlib_from_linklib_cmd" >&6; } -sharedlib_from_linklib_cmd=$lt_cv_sharedlib_from_linklib_cmd -test -z "$sharedlib_from_linklib_cmd" && sharedlib_from_linklib_cmd=$ECHO - - - - - - - -if test -n "$ac_tool_prefix"; then - for ac_prog in ar - do - # Extract the first word of "$ac_tool_prefix$ac_prog", so it can be a program name with args. -set dummy $ac_tool_prefix$ac_prog; ac_word=$2 -{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 -$as_echo_n "checking for $ac_word... " >&6; } -if ${ac_cv_prog_AR+:} false; then : - $as_echo_n "(cached) " >&6 -else - if test -n "$AR"; then - ac_cv_prog_AR="$AR" # Let the user override the test. -else -as_save_IFS=$IFS; IFS=$PATH_SEPARATOR -for as_dir in $PATH -do - IFS=$as_save_IFS - test -z "$as_dir" && as_dir=. - for ac_exec_ext in '' $ac_executable_extensions; do - if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then - ac_cv_prog_AR="$ac_tool_prefix$ac_prog" - $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 - break 2 - fi -done - done -IFS=$as_save_IFS - -fi -fi -AR=$ac_cv_prog_AR -if test -n "$AR"; then - { $as_echo "$as_me:${as_lineno-$LINENO}: result: $AR" >&5 -$as_echo "$AR" >&6; } -else - { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 -$as_echo "no" >&6; } -fi - - - test -n "$AR" && break - done -fi -if test -z "$AR"; then - ac_ct_AR=$AR - for ac_prog in ar -do - # Extract the first word of "$ac_prog", so it can be a program name with args. -set dummy $ac_prog; ac_word=$2 -{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 -$as_echo_n "checking for $ac_word... " >&6; } -if ${ac_cv_prog_ac_ct_AR+:} false; then : - $as_echo_n "(cached) " >&6 -else - if test -n "$ac_ct_AR"; then - ac_cv_prog_ac_ct_AR="$ac_ct_AR" # Let the user override the test. -else -as_save_IFS=$IFS; IFS=$PATH_SEPARATOR -for as_dir in $PATH -do - IFS=$as_save_IFS - test -z "$as_dir" && as_dir=. - for ac_exec_ext in '' $ac_executable_extensions; do - if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then - ac_cv_prog_ac_ct_AR="$ac_prog" - $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 - break 2 - fi -done - done -IFS=$as_save_IFS - -fi -fi -ac_ct_AR=$ac_cv_prog_ac_ct_AR -if test -n "$ac_ct_AR"; then - { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_ct_AR" >&5 -$as_echo "$ac_ct_AR" >&6; } -else - { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 -$as_echo "no" >&6; } -fi - - - test -n "$ac_ct_AR" && break -done - - if test "x$ac_ct_AR" = x; then - AR="false" - else - case $cross_compiling:$ac_tool_warned in -yes:) -{ $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5 -$as_echo "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;} -ac_tool_warned=yes ;; -esac - AR=$ac_ct_AR - fi -fi - -: ${AR=ar} -: ${AR_FLAGS=cru} - - - - - - - - - - - -{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for archiver @FILE support" >&5 -$as_echo_n "checking for archiver @FILE support... " >&6; } -if ${lt_cv_ar_at_file+:} false; then : - $as_echo_n "(cached) " >&6 -else - lt_cv_ar_at_file=no - cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ - -int -main () -{ - - ; - return 0; -} -_ACEOF -if ac_fn_c_try_compile "$LINENO"; then : - echo conftest.$ac_objext > conftest.lst - lt_ar_try='$AR $AR_FLAGS libconftest.a @conftest.lst >&5' - { { eval echo "\"\$as_me\":${as_lineno-$LINENO}: \"$lt_ar_try\""; } >&5 - (eval $lt_ar_try) 2>&5 - ac_status=$? - $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 - test $ac_status = 0; } - if test 0 -eq "$ac_status"; then - # Ensure the archiver fails upon bogus file names. - rm -f conftest.$ac_objext libconftest.a - { { eval echo "\"\$as_me\":${as_lineno-$LINENO}: \"$lt_ar_try\""; } >&5 - (eval $lt_ar_try) 2>&5 - ac_status=$? - $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 - test $ac_status = 0; } - if test 0 -ne "$ac_status"; then - lt_cv_ar_at_file=@ - fi - fi - rm -f conftest.* libconftest.a - -fi -rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext - -fi -{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $lt_cv_ar_at_file" >&5 -$as_echo "$lt_cv_ar_at_file" >&6; } - -if test no = "$lt_cv_ar_at_file"; then - archiver_list_spec= -else - archiver_list_spec=$lt_cv_ar_at_file -fi - - - - - - - -if test -n "$ac_tool_prefix"; then - # Extract the first word of "${ac_tool_prefix}strip", so it can be a program name with args. -set dummy ${ac_tool_prefix}strip; ac_word=$2 -{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 -$as_echo_n "checking for $ac_word... " >&6; } -if ${ac_cv_prog_STRIP+:} false; then : - $as_echo_n "(cached) " >&6 -else - if test -n "$STRIP"; then - ac_cv_prog_STRIP="$STRIP" # Let the user override the test. -else -as_save_IFS=$IFS; IFS=$PATH_SEPARATOR -for as_dir in $PATH -do - IFS=$as_save_IFS - test -z "$as_dir" && as_dir=. - for ac_exec_ext in '' $ac_executable_extensions; do - if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then - ac_cv_prog_STRIP="${ac_tool_prefix}strip" - $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 - break 2 - fi -done - done -IFS=$as_save_IFS - -fi -fi -STRIP=$ac_cv_prog_STRIP -if test -n "$STRIP"; then - { $as_echo "$as_me:${as_lineno-$LINENO}: result: $STRIP" >&5 -$as_echo "$STRIP" >&6; } -else - { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 -$as_echo "no" >&6; } -fi - - -fi -if test -z "$ac_cv_prog_STRIP"; then - ac_ct_STRIP=$STRIP - # Extract the first word of "strip", so it can be a program name with args. -set dummy strip; ac_word=$2 -{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 -$as_echo_n "checking for $ac_word... " >&6; } -if ${ac_cv_prog_ac_ct_STRIP+:} false; then : - $as_echo_n "(cached) " >&6 -else - if test -n "$ac_ct_STRIP"; then - ac_cv_prog_ac_ct_STRIP="$ac_ct_STRIP" # Let the user override the test. -else -as_save_IFS=$IFS; IFS=$PATH_SEPARATOR -for as_dir in $PATH -do - IFS=$as_save_IFS - test -z "$as_dir" && as_dir=. - for ac_exec_ext in '' $ac_executable_extensions; do - if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then - ac_cv_prog_ac_ct_STRIP="strip" - $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 - break 2 - fi -done - done -IFS=$as_save_IFS - -fi -fi -ac_ct_STRIP=$ac_cv_prog_ac_ct_STRIP -if test -n "$ac_ct_STRIP"; then - { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_ct_STRIP" >&5 -$as_echo "$ac_ct_STRIP" >&6; } -else - { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 -$as_echo "no" >&6; } -fi - - if test "x$ac_ct_STRIP" = x; then - STRIP=":" - else - case $cross_compiling:$ac_tool_warned in -yes:) -{ $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5 -$as_echo "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;} -ac_tool_warned=yes ;; -esac - STRIP=$ac_ct_STRIP - fi -else - STRIP="$ac_cv_prog_STRIP" -fi - -test -z "$STRIP" && STRIP=: - - - - - - -if test -n "$ac_tool_prefix"; then - # Extract the first word of "${ac_tool_prefix}ranlib", so it can be a program name with args. -set dummy ${ac_tool_prefix}ranlib; ac_word=$2 -{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 -$as_echo_n "checking for $ac_word... " >&6; } -if ${ac_cv_prog_RANLIB+:} false; then : - $as_echo_n "(cached) " >&6 -else - if test -n "$RANLIB"; then - ac_cv_prog_RANLIB="$RANLIB" # Let the user override the test. -else -as_save_IFS=$IFS; IFS=$PATH_SEPARATOR -for as_dir in $PATH -do - IFS=$as_save_IFS - test -z "$as_dir" && as_dir=. - for ac_exec_ext in '' $ac_executable_extensions; do - if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then - ac_cv_prog_RANLIB="${ac_tool_prefix}ranlib" - $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 - break 2 - fi -done - done -IFS=$as_save_IFS - -fi -fi -RANLIB=$ac_cv_prog_RANLIB -if test -n "$RANLIB"; then - { $as_echo "$as_me:${as_lineno-$LINENO}: result: $RANLIB" >&5 -$as_echo "$RANLIB" >&6; } -else - { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 -$as_echo "no" >&6; } -fi - - -fi -if test -z "$ac_cv_prog_RANLIB"; then - ac_ct_RANLIB=$RANLIB - # Extract the first word of "ranlib", so it can be a program name with args. -set dummy ranlib; ac_word=$2 -{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 -$as_echo_n "checking for $ac_word... " >&6; } -if ${ac_cv_prog_ac_ct_RANLIB+:} false; then : - $as_echo_n "(cached) " >&6 -else - if test -n "$ac_ct_RANLIB"; then - ac_cv_prog_ac_ct_RANLIB="$ac_ct_RANLIB" # Let the user override the test. -else -as_save_IFS=$IFS; IFS=$PATH_SEPARATOR -for as_dir in $PATH -do - IFS=$as_save_IFS - test -z "$as_dir" && as_dir=. - for ac_exec_ext in '' $ac_executable_extensions; do - if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then - ac_cv_prog_ac_ct_RANLIB="ranlib" - $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 - break 2 - fi -done - done -IFS=$as_save_IFS - -fi -fi -ac_ct_RANLIB=$ac_cv_prog_ac_ct_RANLIB -if test -n "$ac_ct_RANLIB"; then - { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_ct_RANLIB" >&5 -$as_echo "$ac_ct_RANLIB" >&6; } -else - { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 -$as_echo "no" >&6; } -fi - - if test "x$ac_ct_RANLIB" = x; then - RANLIB=":" - else - case $cross_compiling:$ac_tool_warned in -yes:) -{ $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5 -$as_echo "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;} -ac_tool_warned=yes ;; -esac - RANLIB=$ac_ct_RANLIB - fi -else - RANLIB="$ac_cv_prog_RANLIB" -fi - -test -z "$RANLIB" && RANLIB=: - - - - - - -# Determine commands to create old-style static archives. -old_archive_cmds='$AR $AR_FLAGS $oldlib$oldobjs' -old_postinstall_cmds='chmod 644 $oldlib' -old_postuninstall_cmds= - -if test -n "$RANLIB"; then - case $host_os in - bitrig* | openbsd*) - old_postinstall_cmds="$old_postinstall_cmds~\$RANLIB -t \$tool_oldlib" - ;; - *) - old_postinstall_cmds="$old_postinstall_cmds~\$RANLIB \$tool_oldlib" - ;; - esac - old_archive_cmds="$old_archive_cmds~\$RANLIB \$tool_oldlib" -fi - -case $host_os in - darwin*) - lock_old_archive_extraction=yes ;; - *) - lock_old_archive_extraction=no ;; -esac - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -# If no C compiler was specified, use CC. -LTCC=${LTCC-"$CC"} - -# If no C compiler flags were specified, use CFLAGS. -LTCFLAGS=${LTCFLAGS-"$CFLAGS"} - -# Allow CC to be a program name with arguments. -compiler=$CC - - -# Check for command to grab the raw symbol name followed by C symbol from nm. -{ $as_echo "$as_me:${as_lineno-$LINENO}: checking command to parse $NM output from $compiler object" >&5 -$as_echo_n "checking command to parse $NM output from $compiler object... " >&6; } -if ${lt_cv_sys_global_symbol_pipe+:} false; then : - $as_echo_n "(cached) " >&6 -else - -# These are sane defaults that work on at least a few old systems. -# [They come from Ultrix. What could be older than Ultrix?!! ;)] - -# Character class describing NM global symbol codes. -symcode='[BCDEGRST]' - -# Regexp to match symbols that can be accessed directly from C. -sympat='\([_A-Za-z][_A-Za-z0-9]*\)' - -# Define system-specific variables. -case $host_os in -aix*) - symcode='[BCDT]' - ;; -cygwin* | mingw* | pw32* | cegcc*) - symcode='[ABCDGISTW]' - ;; -hpux*) - if test ia64 = "$host_cpu"; then - symcode='[ABCDEGRST]' - fi - ;; -irix* | nonstopux*) - symcode='[BCDEGRST]' - ;; -osf*) - symcode='[BCDEGQRST]' - ;; -solaris*) - symcode='[BDRT]' - ;; -sco3.2v5*) - symcode='[DT]' - ;; -sysv4.2uw2*) - symcode='[DT]' - ;; -sysv5* | sco5v6* | unixware* | OpenUNIX*) - symcode='[ABDT]' - ;; -sysv4) - symcode='[DFNSTU]' - ;; -esac - -# If we're using GNU nm, then use its standard symbol codes. -case `$NM -V 2>&1` in -*GNU* | *'with BFD'*) - symcode='[ABCDGIRSTW]' ;; -esac - -if test "$lt_cv_nm_interface" = "MS dumpbin"; then - # Gets list of data symbols to import. - lt_cv_sys_global_symbol_to_import="sed -n -e 's/^I .* \(.*\)$/\1/p'" - # Adjust the below global symbol transforms to fixup imported variables. - lt_cdecl_hook=" -e 's/^I .* \(.*\)$/extern __declspec(dllimport) char \1;/p'" - lt_c_name_hook=" -e 's/^I .* \(.*\)$/ {\"\1\", (void *) 0},/p'" - lt_c_name_lib_hook="\ - -e 's/^I .* \(lib.*\)$/ {\"\1\", (void *) 0},/p'\ - -e 's/^I .* \(.*\)$/ {\"lib\1\", (void *) 0},/p'" -else - # Disable hooks by default. - lt_cv_sys_global_symbol_to_import= - lt_cdecl_hook= - lt_c_name_hook= - lt_c_name_lib_hook= -fi - -# Transform an extracted symbol line into a proper C declaration. -# Some systems (esp. on ia64) link data and code symbols differently, -# so use this general approach. -lt_cv_sys_global_symbol_to_cdecl="sed -n"\ -$lt_cdecl_hook\ -" -e 's/^T .* \(.*\)$/extern int \1();/p'"\ -" -e 's/^$symcode$symcode* .* \(.*\)$/extern char \1;/p'" - -# Transform an extracted symbol line into symbol name and symbol address -lt_cv_sys_global_symbol_to_c_name_address="sed -n"\ -$lt_c_name_hook\ -" -e 's/^: \(.*\) .*$/ {\"\1\", (void *) 0},/p'"\ -" -e 's/^$symcode$symcode* .* \(.*\)$/ {\"\1\", (void *) \&\1},/p'" - -# Transform an extracted symbol line into symbol name with lib prefix and -# symbol address. -lt_cv_sys_global_symbol_to_c_name_address_lib_prefix="sed -n"\ -$lt_c_name_lib_hook\ -" -e 's/^: \(.*\) .*$/ {\"\1\", (void *) 0},/p'"\ -" -e 's/^$symcode$symcode* .* \(lib.*\)$/ {\"\1\", (void *) \&\1},/p'"\ -" -e 's/^$symcode$symcode* .* \(.*\)$/ {\"lib\1\", (void *) \&\1},/p'" - -# Handle CRLF in mingw tool chain -opt_cr= -case $build_os in -mingw*) - opt_cr=`$ECHO 'x\{0,1\}' | tr x '\015'` # option cr in regexp - ;; -esac - -# Try without a prefix underscore, then with it. -for ac_symprfx in "" "_"; do - - # Transform symcode, sympat, and symprfx into a raw symbol and a C symbol. - symxfrm="\\1 $ac_symprfx\\2 \\2" - - # Write the raw and C identifiers. - if test "$lt_cv_nm_interface" = "MS dumpbin"; then - # Fake it for dumpbin and say T for any non-static function, - # D for any global variable and I for any imported variable. - # Also find C++ and __fastcall symbols from MSVC++, - # which start with @ or ?. - lt_cv_sys_global_symbol_pipe="$AWK '"\ -" {last_section=section; section=\$ 3};"\ -" /^COFF SYMBOL TABLE/{for(i in hide) delete hide[i]};"\ -" /Section length .*#relocs.*(pick any)/{hide[last_section]=1};"\ -" /^ *Symbol name *: /{split(\$ 0,sn,\":\"); si=substr(sn[2],2)};"\ -" /^ *Type *: code/{print \"T\",si,substr(si,length(prfx))};"\ -" /^ *Type *: data/{print \"I\",si,substr(si,length(prfx))};"\ -" \$ 0!~/External *\|/{next};"\ -" / 0+ UNDEF /{next}; / UNDEF \([^|]\)*()/{next};"\ -" {if(hide[section]) next};"\ -" {f=\"D\"}; \$ 0~/\(\).*\|/{f=\"T\"};"\ -" {split(\$ 0,a,/\||\r/); split(a[2],s)};"\ -" s[1]~/^[@?]/{print f,s[1],s[1]; next};"\ -" s[1]~prfx {split(s[1],t,\"@\"); print f,t[1],substr(t[1],length(prfx))}"\ -" ' prfx=^$ac_symprfx" - else - lt_cv_sys_global_symbol_pipe="sed -n -e 's/^.*[ ]\($symcode$symcode*\)[ ][ ]*$ac_symprfx$sympat$opt_cr$/$symxfrm/p'" - fi - lt_cv_sys_global_symbol_pipe="$lt_cv_sys_global_symbol_pipe | sed '/ __gnu_lto/d'" - - # Check to see that the pipe works correctly. - pipe_works=no - - rm -f conftest* - cat > conftest.$ac_ext <<_LT_EOF -#ifdef __cplusplus -extern "C" { -#endif -char nm_test_var; -void nm_test_func(void); -void nm_test_func(void){} -#ifdef __cplusplus -} -#endif -int main(){nm_test_var='a';nm_test_func();return(0);} -_LT_EOF - - if { { eval echo "\"\$as_me\":${as_lineno-$LINENO}: \"$ac_compile\""; } >&5 - (eval $ac_compile) 2>&5 - ac_status=$? - $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 - test $ac_status = 0; }; then - # Now try to grab the symbols. - nlist=conftest.nm - if { { eval echo "\"\$as_me\":${as_lineno-$LINENO}: \"$NM conftest.$ac_objext \| "$lt_cv_sys_global_symbol_pipe" \> $nlist\""; } >&5 - (eval $NM conftest.$ac_objext \| "$lt_cv_sys_global_symbol_pipe" \> $nlist) 2>&5 - ac_status=$? - $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 - test $ac_status = 0; } && test -s "$nlist"; then - # Try sorting and uniquifying the output. - if sort "$nlist" | uniq > "$nlist"T; then - mv -f "$nlist"T "$nlist" - else - rm -f "$nlist"T - fi - - # Make sure that we snagged all the symbols we need. - if $GREP ' nm_test_var$' "$nlist" >/dev/null; then - if $GREP ' nm_test_func$' "$nlist" >/dev/null; then - cat <<_LT_EOF > conftest.$ac_ext -/* Keep this code in sync between libtool.m4, ltmain, lt_system.h, and tests. */ -#if defined _WIN32 || defined __CYGWIN__ || defined _WIN32_WCE -/* DATA imports from DLLs on WIN32 can't be const, because runtime - relocations are performed -- see ld's documentation on pseudo-relocs. */ -# define LT_DLSYM_CONST -#elif defined __osf__ -/* This system does not cope well with relocations in const data. */ -# define LT_DLSYM_CONST -#else -# define LT_DLSYM_CONST const -#endif - -#ifdef __cplusplus -extern "C" { -#endif - -_LT_EOF - # Now generate the symbol file. - eval "$lt_cv_sys_global_symbol_to_cdecl"' < "$nlist" | $GREP -v main >> conftest.$ac_ext' - - cat <<_LT_EOF >> conftest.$ac_ext - -/* The mapping between symbol names and symbols. */ -LT_DLSYM_CONST struct { - const char *name; - void *address; -} -lt__PROGRAM__LTX_preloaded_symbols[] = -{ - { "@PROGRAM@", (void *) 0 }, -_LT_EOF - $SED "s/^$symcode$symcode* .* \(.*\)$/ {\"\1\", (void *) \&\1},/" < "$nlist" | $GREP -v main >> conftest.$ac_ext - cat <<\_LT_EOF >> conftest.$ac_ext - {0, (void *) 0} -}; - -/* This works around a problem in FreeBSD linker */ -#ifdef FREEBSD_WORKAROUND -static const void *lt_preloaded_setup() { - return lt__PROGRAM__LTX_preloaded_symbols; -} -#endif - -#ifdef __cplusplus -} -#endif -_LT_EOF - # Now try linking the two files. - mv conftest.$ac_objext conftstm.$ac_objext - lt_globsym_save_LIBS=$LIBS - lt_globsym_save_CFLAGS=$CFLAGS - LIBS=conftstm.$ac_objext - CFLAGS="$CFLAGS$lt_prog_compiler_no_builtin_flag" - if { { eval echo "\"\$as_me\":${as_lineno-$LINENO}: \"$ac_link\""; } >&5 - (eval $ac_link) 2>&5 - ac_status=$? - $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 - test $ac_status = 0; } && test -s conftest$ac_exeext; then - pipe_works=yes - fi - LIBS=$lt_globsym_save_LIBS - CFLAGS=$lt_globsym_save_CFLAGS - else - echo "cannot find nm_test_func in $nlist" >&5 - fi - else - echo "cannot find nm_test_var in $nlist" >&5 - fi - else - echo "cannot run $lt_cv_sys_global_symbol_pipe" >&5 - fi - else - echo "$progname: failed program was:" >&5 - cat conftest.$ac_ext >&5 - fi - rm -rf conftest* conftst* - - # Do not use the global_symbol_pipe unless it works. - if test yes = "$pipe_works"; then - break - else - lt_cv_sys_global_symbol_pipe= - fi -done - -fi - -if test -z "$lt_cv_sys_global_symbol_pipe"; then - lt_cv_sys_global_symbol_to_cdecl= -fi -if test -z "$lt_cv_sys_global_symbol_pipe$lt_cv_sys_global_symbol_to_cdecl"; then - { $as_echo "$as_me:${as_lineno-$LINENO}: result: failed" >&5 -$as_echo "failed" >&6; } -else - { $as_echo "$as_me:${as_lineno-$LINENO}: result: ok" >&5 -$as_echo "ok" >&6; } -fi - -# Response file support. -if test "$lt_cv_nm_interface" = "MS dumpbin"; then - nm_file_list_spec='@' -elif $NM --help 2>/dev/null | grep '[@]FILE' >/dev/null; then - nm_file_list_spec='@' -fi - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for sysroot" >&5 -$as_echo_n "checking for sysroot... " >&6; } - -# Check whether --with-sysroot was given. -if test "${with_sysroot+set}" = set; then : - withval=$with_sysroot; -else - with_sysroot=no -fi - - -lt_sysroot= -case $with_sysroot in #( - yes) - if test yes = "$GCC"; then - lt_sysroot=`$CC --print-sysroot 2>/dev/null` - fi - ;; #( - /*) - lt_sysroot=`echo "$with_sysroot" | sed -e "$sed_quote_subst"` - ;; #( - no|'') - ;; #( - *) - { $as_echo "$as_me:${as_lineno-$LINENO}: result: $with_sysroot" >&5 -$as_echo "$with_sysroot" >&6; } - as_fn_error $? "The sysroot must be an absolute path." "$LINENO" 5 - ;; -esac - - { $as_echo "$as_me:${as_lineno-$LINENO}: result: ${lt_sysroot:-no}" >&5 -$as_echo "${lt_sysroot:-no}" >&6; } - - - - - -{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for a working dd" >&5 -$as_echo_n "checking for a working dd... " >&6; } -if ${ac_cv_path_lt_DD+:} false; then : - $as_echo_n "(cached) " >&6 -else - printf 0123456789abcdef0123456789abcdef >conftest.i -cat conftest.i conftest.i >conftest2.i -: ${lt_DD:=$DD} -if test -z "$lt_DD"; then - ac_path_lt_DD_found=false - # Loop through the user's path and test for each of PROGNAME-LIST - as_save_IFS=$IFS; IFS=$PATH_SEPARATOR -for as_dir in $PATH -do - IFS=$as_save_IFS - test -z "$as_dir" && as_dir=. - for ac_prog in dd; do - for ac_exec_ext in '' $ac_executable_extensions; do - ac_path_lt_DD="$as_dir/$ac_prog$ac_exec_ext" - as_fn_executable_p "$ac_path_lt_DD" || continue -if "$ac_path_lt_DD" bs=32 count=1 conftest.out 2>/dev/null; then - cmp -s conftest.i conftest.out \ - && ac_cv_path_lt_DD="$ac_path_lt_DD" ac_path_lt_DD_found=: -fi - $ac_path_lt_DD_found && break 3 - done - done - done -IFS=$as_save_IFS - if test -z "$ac_cv_path_lt_DD"; then - : - fi -else - ac_cv_path_lt_DD=$lt_DD -fi - -rm -f conftest.i conftest2.i conftest.out -fi -{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_path_lt_DD" >&5 -$as_echo "$ac_cv_path_lt_DD" >&6; } - - -{ $as_echo "$as_me:${as_lineno-$LINENO}: checking how to truncate binary pipes" >&5 -$as_echo_n "checking how to truncate binary pipes... " >&6; } -if ${lt_cv_truncate_bin+:} false; then : - $as_echo_n "(cached) " >&6 -else - printf 0123456789abcdef0123456789abcdef >conftest.i -cat conftest.i conftest.i >conftest2.i -lt_cv_truncate_bin= -if "$ac_cv_path_lt_DD" bs=32 count=1 conftest.out 2>/dev/null; then - cmp -s conftest.i conftest.out \ - && lt_cv_truncate_bin="$ac_cv_path_lt_DD bs=4096 count=1" -fi -rm -f conftest.i conftest2.i conftest.out -test -z "$lt_cv_truncate_bin" && lt_cv_truncate_bin="$SED -e 4q" -fi -{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $lt_cv_truncate_bin" >&5 -$as_echo "$lt_cv_truncate_bin" >&6; } - - - - - - - -# Calculate cc_basename. Skip known compiler wrappers and cross-prefix. -func_cc_basename () -{ - for cc_temp in $*""; do - case $cc_temp in - compile | *[\\/]compile | ccache | *[\\/]ccache ) ;; - distcc | *[\\/]distcc | purify | *[\\/]purify ) ;; - \-*) ;; - *) break;; - esac - done - func_cc_basename_result=`$ECHO "$cc_temp" | $SED "s%.*/%%; s%^$host_alias-%%"` -} - -# Check whether --enable-libtool-lock was given. -if test "${enable_libtool_lock+set}" = set; then : - enableval=$enable_libtool_lock; -fi - -test no = "$enable_libtool_lock" || enable_libtool_lock=yes - -# Some flags need to be propagated to the compiler or linker for good -# libtool support. -case $host in -ia64-*-hpux*) - # Find out what ABI is being produced by ac_compile, and set mode - # options accordingly. - echo 'int i;' > conftest.$ac_ext - if { { eval echo "\"\$as_me\":${as_lineno-$LINENO}: \"$ac_compile\""; } >&5 - (eval $ac_compile) 2>&5 - ac_status=$? - $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 - test $ac_status = 0; }; then - case `/usr/bin/file conftest.$ac_objext` in - *ELF-32*) - HPUX_IA64_MODE=32 - ;; - *ELF-64*) - HPUX_IA64_MODE=64 - ;; - esac - fi - rm -rf conftest* - ;; -*-*-irix6*) - # Find out what ABI is being produced by ac_compile, and set linker - # options accordingly. - echo '#line '$LINENO' "configure"' > conftest.$ac_ext - if { { eval echo "\"\$as_me\":${as_lineno-$LINENO}: \"$ac_compile\""; } >&5 - (eval $ac_compile) 2>&5 - ac_status=$? - $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 - test $ac_status = 0; }; then - if test yes = "$lt_cv_prog_gnu_ld"; then - case `/usr/bin/file conftest.$ac_objext` in - *32-bit*) - LD="${LD-ld} -melf32bsmip" - ;; - *N32*) - LD="${LD-ld} -melf32bmipn32" - ;; - *64-bit*) - LD="${LD-ld} -melf64bmip" - ;; - esac - else - case `/usr/bin/file conftest.$ac_objext` in - *32-bit*) - LD="${LD-ld} -32" - ;; - *N32*) - LD="${LD-ld} -n32" - ;; - *64-bit*) - LD="${LD-ld} -64" - ;; - esac - fi - fi - rm -rf conftest* - ;; - -mips64*-*linux*) - # Find out what ABI is being produced by ac_compile, and set linker - # options accordingly. - echo '#line '$LINENO' "configure"' > conftest.$ac_ext - if { { eval echo "\"\$as_me\":${as_lineno-$LINENO}: \"$ac_compile\""; } >&5 - (eval $ac_compile) 2>&5 - ac_status=$? - $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 - test $ac_status = 0; }; then - emul=elf - case `/usr/bin/file conftest.$ac_objext` in - *32-bit*) - emul="${emul}32" - ;; - *64-bit*) - emul="${emul}64" - ;; - esac - case `/usr/bin/file conftest.$ac_objext` in - *MSB*) - emul="${emul}btsmip" - ;; - *LSB*) - emul="${emul}ltsmip" - ;; - esac - case `/usr/bin/file conftest.$ac_objext` in - *N32*) - emul="${emul}n32" - ;; - esac - LD="${LD-ld} -m $emul" - fi - rm -rf conftest* - ;; - -x86_64-*kfreebsd*-gnu|x86_64-*linux*|powerpc*-*linux*| \ -s390*-*linux*|s390*-*tpf*|sparc*-*linux*) - # Find out what ABI is being produced by ac_compile, and set linker - # options accordingly. Note that the listed cases only cover the - # situations where additional linker options are needed (such as when - # doing 32-bit compilation for a host where ld defaults to 64-bit, or - # vice versa); the common cases where no linker options are needed do - # not appear in the list. - echo 'int i;' > conftest.$ac_ext - if { { eval echo "\"\$as_me\":${as_lineno-$LINENO}: \"$ac_compile\""; } >&5 - (eval $ac_compile) 2>&5 - ac_status=$? - $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 - test $ac_status = 0; }; then - case `/usr/bin/file conftest.o` in - *32-bit*) - case $host in - x86_64-*kfreebsd*-gnu) - LD="${LD-ld} -m elf_i386_fbsd" - ;; - x86_64-*linux*) - case `/usr/bin/file conftest.o` in - *x86-64*) - LD="${LD-ld} -m elf32_x86_64" - ;; - *) - LD="${LD-ld} -m elf_i386" - ;; - esac - ;; - powerpc64le-*linux*) - LD="${LD-ld} -m elf32lppclinux" - ;; - powerpc64-*linux*) - LD="${LD-ld} -m elf32ppclinux" - ;; - s390x-*linux*) - LD="${LD-ld} -m elf_s390" - ;; - sparc64-*linux*) - LD="${LD-ld} -m elf32_sparc" - ;; - esac - ;; - *64-bit*) - case $host in - x86_64-*kfreebsd*-gnu) - LD="${LD-ld} -m elf_x86_64_fbsd" - ;; - x86_64-*linux*) - LD="${LD-ld} -m elf_x86_64" - ;; - powerpcle-*linux*) - LD="${LD-ld} -m elf64lppc" - ;; - powerpc-*linux*) - LD="${LD-ld} -m elf64ppc" - ;; - s390*-*linux*|s390*-*tpf*) - LD="${LD-ld} -m elf64_s390" - ;; - sparc*-*linux*) - LD="${LD-ld} -m elf64_sparc" - ;; - esac - ;; - esac - fi - rm -rf conftest* - ;; - -*-*-sco3.2v5*) - # On SCO OpenServer 5, we need -belf to get full-featured binaries. - SAVE_CFLAGS=$CFLAGS - CFLAGS="$CFLAGS -belf" - { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether the C compiler needs -belf" >&5 -$as_echo_n "checking whether the C compiler needs -belf... " >&6; } -if ${lt_cv_cc_needs_belf+:} false; then : - $as_echo_n "(cached) " >&6 -else - ac_ext=c -ac_cpp='$CPP $CPPFLAGS' -ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' -ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' -ac_compiler_gnu=$ac_cv_c_compiler_gnu - - cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ - -int -main () -{ - - ; - return 0; -} -_ACEOF -if ac_fn_c_try_link "$LINENO"; then : - lt_cv_cc_needs_belf=yes -else - lt_cv_cc_needs_belf=no -fi -rm -f core conftest.err conftest.$ac_objext \ - conftest$ac_exeext conftest.$ac_ext - ac_ext=c -ac_cpp='$CPP $CPPFLAGS' -ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' -ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' -ac_compiler_gnu=$ac_cv_c_compiler_gnu - -fi -{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $lt_cv_cc_needs_belf" >&5 -$as_echo "$lt_cv_cc_needs_belf" >&6; } - if test yes != "$lt_cv_cc_needs_belf"; then - # this is probably gcc 2.8.0, egcs 1.0 or newer; no need for -belf - CFLAGS=$SAVE_CFLAGS - fi - ;; -*-*solaris*) - # Find out what ABI is being produced by ac_compile, and set linker - # options accordingly. - echo 'int i;' > conftest.$ac_ext - if { { eval echo "\"\$as_me\":${as_lineno-$LINENO}: \"$ac_compile\""; } >&5 - (eval $ac_compile) 2>&5 - ac_status=$? - $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 - test $ac_status = 0; }; then - case `/usr/bin/file conftest.o` in - *64-bit*) - case $lt_cv_prog_gnu_ld in - yes*) - case $host in - i?86-*-solaris*|x86_64-*-solaris*) - LD="${LD-ld} -m elf_x86_64" - ;; - sparc*-*-solaris*) - LD="${LD-ld} -m elf64_sparc" - ;; - esac - # GNU ld 2.21 introduced _sol2 emulations. Use them if available. - if ${LD-ld} -V | grep _sol2 >/dev/null 2>&1; then - LD=${LD-ld}_sol2 - fi - ;; - *) - if ${LD-ld} -64 -r -o conftest2.o conftest.o >/dev/null 2>&1; then - LD="${LD-ld} -64" - fi - ;; - esac - ;; - esac - fi - rm -rf conftest* - ;; -esac - -need_locks=$enable_libtool_lock - -if test -n "$ac_tool_prefix"; then - # Extract the first word of "${ac_tool_prefix}mt", so it can be a program name with args. -set dummy ${ac_tool_prefix}mt; ac_word=$2 -{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 -$as_echo_n "checking for $ac_word... " >&6; } -if ${ac_cv_prog_MANIFEST_TOOL+:} false; then : - $as_echo_n "(cached) " >&6 -else - if test -n "$MANIFEST_TOOL"; then - ac_cv_prog_MANIFEST_TOOL="$MANIFEST_TOOL" # Let the user override the test. -else -as_save_IFS=$IFS; IFS=$PATH_SEPARATOR -for as_dir in $PATH -do - IFS=$as_save_IFS - test -z "$as_dir" && as_dir=. - for ac_exec_ext in '' $ac_executable_extensions; do - if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then - ac_cv_prog_MANIFEST_TOOL="${ac_tool_prefix}mt" - $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 - break 2 - fi -done - done -IFS=$as_save_IFS - -fi -fi -MANIFEST_TOOL=$ac_cv_prog_MANIFEST_TOOL -if test -n "$MANIFEST_TOOL"; then - { $as_echo "$as_me:${as_lineno-$LINENO}: result: $MANIFEST_TOOL" >&5 -$as_echo "$MANIFEST_TOOL" >&6; } -else - { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 -$as_echo "no" >&6; } -fi - - -fi -if test -z "$ac_cv_prog_MANIFEST_TOOL"; then - ac_ct_MANIFEST_TOOL=$MANIFEST_TOOL - # Extract the first word of "mt", so it can be a program name with args. -set dummy mt; ac_word=$2 -{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 -$as_echo_n "checking for $ac_word... " >&6; } -if ${ac_cv_prog_ac_ct_MANIFEST_TOOL+:} false; then : - $as_echo_n "(cached) " >&6 -else - if test -n "$ac_ct_MANIFEST_TOOL"; then - ac_cv_prog_ac_ct_MANIFEST_TOOL="$ac_ct_MANIFEST_TOOL" # Let the user override the test. -else -as_save_IFS=$IFS; IFS=$PATH_SEPARATOR -for as_dir in $PATH -do - IFS=$as_save_IFS - test -z "$as_dir" && as_dir=. - for ac_exec_ext in '' $ac_executable_extensions; do - if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then - ac_cv_prog_ac_ct_MANIFEST_TOOL="mt" - $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 - break 2 - fi -done - done -IFS=$as_save_IFS - -fi -fi -ac_ct_MANIFEST_TOOL=$ac_cv_prog_ac_ct_MANIFEST_TOOL -if test -n "$ac_ct_MANIFEST_TOOL"; then - { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_ct_MANIFEST_TOOL" >&5 -$as_echo "$ac_ct_MANIFEST_TOOL" >&6; } -else - { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 -$as_echo "no" >&6; } -fi - - if test "x$ac_ct_MANIFEST_TOOL" = x; then - MANIFEST_TOOL=":" - else - case $cross_compiling:$ac_tool_warned in -yes:) -{ $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5 -$as_echo "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;} -ac_tool_warned=yes ;; -esac - MANIFEST_TOOL=$ac_ct_MANIFEST_TOOL - fi -else - MANIFEST_TOOL="$ac_cv_prog_MANIFEST_TOOL" -fi - -test -z "$MANIFEST_TOOL" && MANIFEST_TOOL=mt -{ $as_echo "$as_me:${as_lineno-$LINENO}: checking if $MANIFEST_TOOL is a manifest tool" >&5 -$as_echo_n "checking if $MANIFEST_TOOL is a manifest tool... " >&6; } -if ${lt_cv_path_mainfest_tool+:} false; then : - $as_echo_n "(cached) " >&6 -else - lt_cv_path_mainfest_tool=no - echo "$as_me:$LINENO: $MANIFEST_TOOL '-?'" >&5 - $MANIFEST_TOOL '-?' 2>conftest.err > conftest.out - cat conftest.err >&5 - if $GREP 'Manifest Tool' conftest.out > /dev/null; then - lt_cv_path_mainfest_tool=yes - fi - rm -f conftest* -fi -{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $lt_cv_path_mainfest_tool" >&5 -$as_echo "$lt_cv_path_mainfest_tool" >&6; } -if test yes != "$lt_cv_path_mainfest_tool"; then - MANIFEST_TOOL=: -fi - - - - - - - case $host_os in - rhapsody* | darwin*) - if test -n "$ac_tool_prefix"; then - # Extract the first word of "${ac_tool_prefix}dsymutil", so it can be a program name with args. -set dummy ${ac_tool_prefix}dsymutil; ac_word=$2 -{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 -$as_echo_n "checking for $ac_word... " >&6; } -if ${ac_cv_prog_DSYMUTIL+:} false; then : - $as_echo_n "(cached) " >&6 -else - if test -n "$DSYMUTIL"; then - ac_cv_prog_DSYMUTIL="$DSYMUTIL" # Let the user override the test. -else -as_save_IFS=$IFS; IFS=$PATH_SEPARATOR -for as_dir in $PATH -do - IFS=$as_save_IFS - test -z "$as_dir" && as_dir=. - for ac_exec_ext in '' $ac_executable_extensions; do - if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then - ac_cv_prog_DSYMUTIL="${ac_tool_prefix}dsymutil" - $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 - break 2 - fi -done - done -IFS=$as_save_IFS - -fi -fi -DSYMUTIL=$ac_cv_prog_DSYMUTIL -if test -n "$DSYMUTIL"; then - { $as_echo "$as_me:${as_lineno-$LINENO}: result: $DSYMUTIL" >&5 -$as_echo "$DSYMUTIL" >&6; } -else - { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 -$as_echo "no" >&6; } -fi - - -fi -if test -z "$ac_cv_prog_DSYMUTIL"; then - ac_ct_DSYMUTIL=$DSYMUTIL - # Extract the first word of "dsymutil", so it can be a program name with args. -set dummy dsymutil; ac_word=$2 -{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 -$as_echo_n "checking for $ac_word... " >&6; } -if ${ac_cv_prog_ac_ct_DSYMUTIL+:} false; then : - $as_echo_n "(cached) " >&6 -else - if test -n "$ac_ct_DSYMUTIL"; then - ac_cv_prog_ac_ct_DSYMUTIL="$ac_ct_DSYMUTIL" # Let the user override the test. -else -as_save_IFS=$IFS; IFS=$PATH_SEPARATOR -for as_dir in $PATH -do - IFS=$as_save_IFS - test -z "$as_dir" && as_dir=. - for ac_exec_ext in '' $ac_executable_extensions; do - if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then - ac_cv_prog_ac_ct_DSYMUTIL="dsymutil" - $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 - break 2 - fi -done - done -IFS=$as_save_IFS - -fi -fi -ac_ct_DSYMUTIL=$ac_cv_prog_ac_ct_DSYMUTIL -if test -n "$ac_ct_DSYMUTIL"; then - { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_ct_DSYMUTIL" >&5 -$as_echo "$ac_ct_DSYMUTIL" >&6; } -else - { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 -$as_echo "no" >&6; } -fi - - if test "x$ac_ct_DSYMUTIL" = x; then - DSYMUTIL=":" - else - case $cross_compiling:$ac_tool_warned in -yes:) -{ $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5 -$as_echo "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;} -ac_tool_warned=yes ;; -esac - DSYMUTIL=$ac_ct_DSYMUTIL - fi -else - DSYMUTIL="$ac_cv_prog_DSYMUTIL" -fi - - if test -n "$ac_tool_prefix"; then - # Extract the first word of "${ac_tool_prefix}nmedit", so it can be a program name with args. -set dummy ${ac_tool_prefix}nmedit; ac_word=$2 -{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 -$as_echo_n "checking for $ac_word... " >&6; } -if ${ac_cv_prog_NMEDIT+:} false; then : - $as_echo_n "(cached) " >&6 -else - if test -n "$NMEDIT"; then - ac_cv_prog_NMEDIT="$NMEDIT" # Let the user override the test. -else -as_save_IFS=$IFS; IFS=$PATH_SEPARATOR -for as_dir in $PATH -do - IFS=$as_save_IFS - test -z "$as_dir" && as_dir=. - for ac_exec_ext in '' $ac_executable_extensions; do - if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then - ac_cv_prog_NMEDIT="${ac_tool_prefix}nmedit" - $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 - break 2 - fi -done - done -IFS=$as_save_IFS - -fi -fi -NMEDIT=$ac_cv_prog_NMEDIT -if test -n "$NMEDIT"; then - { $as_echo "$as_me:${as_lineno-$LINENO}: result: $NMEDIT" >&5 -$as_echo "$NMEDIT" >&6; } -else - { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 -$as_echo "no" >&6; } -fi - - -fi -if test -z "$ac_cv_prog_NMEDIT"; then - ac_ct_NMEDIT=$NMEDIT - # Extract the first word of "nmedit", so it can be a program name with args. -set dummy nmedit; ac_word=$2 -{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 -$as_echo_n "checking for $ac_word... " >&6; } -if ${ac_cv_prog_ac_ct_NMEDIT+:} false; then : - $as_echo_n "(cached) " >&6 -else - if test -n "$ac_ct_NMEDIT"; then - ac_cv_prog_ac_ct_NMEDIT="$ac_ct_NMEDIT" # Let the user override the test. -else -as_save_IFS=$IFS; IFS=$PATH_SEPARATOR -for as_dir in $PATH -do - IFS=$as_save_IFS - test -z "$as_dir" && as_dir=. - for ac_exec_ext in '' $ac_executable_extensions; do - if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then - ac_cv_prog_ac_ct_NMEDIT="nmedit" - $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 - break 2 - fi -done - done -IFS=$as_save_IFS - -fi -fi -ac_ct_NMEDIT=$ac_cv_prog_ac_ct_NMEDIT -if test -n "$ac_ct_NMEDIT"; then - { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_ct_NMEDIT" >&5 -$as_echo "$ac_ct_NMEDIT" >&6; } -else - { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 -$as_echo "no" >&6; } -fi - - if test "x$ac_ct_NMEDIT" = x; then - NMEDIT=":" - else - case $cross_compiling:$ac_tool_warned in -yes:) -{ $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5 -$as_echo "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;} -ac_tool_warned=yes ;; -esac - NMEDIT=$ac_ct_NMEDIT - fi -else - NMEDIT="$ac_cv_prog_NMEDIT" -fi - - if test -n "$ac_tool_prefix"; then - # Extract the first word of "${ac_tool_prefix}lipo", so it can be a program name with args. -set dummy ${ac_tool_prefix}lipo; ac_word=$2 -{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 -$as_echo_n "checking for $ac_word... " >&6; } -if ${ac_cv_prog_LIPO+:} false; then : - $as_echo_n "(cached) " >&6 -else - if test -n "$LIPO"; then - ac_cv_prog_LIPO="$LIPO" # Let the user override the test. -else -as_save_IFS=$IFS; IFS=$PATH_SEPARATOR -for as_dir in $PATH -do - IFS=$as_save_IFS - test -z "$as_dir" && as_dir=. - for ac_exec_ext in '' $ac_executable_extensions; do - if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then - ac_cv_prog_LIPO="${ac_tool_prefix}lipo" - $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 - break 2 - fi -done - done -IFS=$as_save_IFS - -fi -fi -LIPO=$ac_cv_prog_LIPO -if test -n "$LIPO"; then - { $as_echo "$as_me:${as_lineno-$LINENO}: result: $LIPO" >&5 -$as_echo "$LIPO" >&6; } -else - { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 -$as_echo "no" >&6; } -fi - - -fi -if test -z "$ac_cv_prog_LIPO"; then - ac_ct_LIPO=$LIPO - # Extract the first word of "lipo", so it can be a program name with args. -set dummy lipo; ac_word=$2 -{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 -$as_echo_n "checking for $ac_word... " >&6; } -if ${ac_cv_prog_ac_ct_LIPO+:} false; then : - $as_echo_n "(cached) " >&6 -else - if test -n "$ac_ct_LIPO"; then - ac_cv_prog_ac_ct_LIPO="$ac_ct_LIPO" # Let the user override the test. -else -as_save_IFS=$IFS; IFS=$PATH_SEPARATOR -for as_dir in $PATH -do - IFS=$as_save_IFS - test -z "$as_dir" && as_dir=. - for ac_exec_ext in '' $ac_executable_extensions; do - if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then - ac_cv_prog_ac_ct_LIPO="lipo" - $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 - break 2 - fi -done - done -IFS=$as_save_IFS - -fi -fi -ac_ct_LIPO=$ac_cv_prog_ac_ct_LIPO -if test -n "$ac_ct_LIPO"; then - { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_ct_LIPO" >&5 -$as_echo "$ac_ct_LIPO" >&6; } -else - { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 -$as_echo "no" >&6; } -fi - - if test "x$ac_ct_LIPO" = x; then - LIPO=":" - else - case $cross_compiling:$ac_tool_warned in -yes:) -{ $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5 -$as_echo "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;} -ac_tool_warned=yes ;; -esac - LIPO=$ac_ct_LIPO - fi -else - LIPO="$ac_cv_prog_LIPO" -fi - - if test -n "$ac_tool_prefix"; then - # Extract the first word of "${ac_tool_prefix}otool", so it can be a program name with args. -set dummy ${ac_tool_prefix}otool; ac_word=$2 -{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 -$as_echo_n "checking for $ac_word... " >&6; } -if ${ac_cv_prog_OTOOL+:} false; then : - $as_echo_n "(cached) " >&6 -else - if test -n "$OTOOL"; then - ac_cv_prog_OTOOL="$OTOOL" # Let the user override the test. -else -as_save_IFS=$IFS; IFS=$PATH_SEPARATOR -for as_dir in $PATH -do - IFS=$as_save_IFS - test -z "$as_dir" && as_dir=. - for ac_exec_ext in '' $ac_executable_extensions; do - if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then - ac_cv_prog_OTOOL="${ac_tool_prefix}otool" - $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 - break 2 - fi -done - done -IFS=$as_save_IFS - -fi -fi -OTOOL=$ac_cv_prog_OTOOL -if test -n "$OTOOL"; then - { $as_echo "$as_me:${as_lineno-$LINENO}: result: $OTOOL" >&5 -$as_echo "$OTOOL" >&6; } -else - { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 -$as_echo "no" >&6; } -fi - - -fi -if test -z "$ac_cv_prog_OTOOL"; then - ac_ct_OTOOL=$OTOOL - # Extract the first word of "otool", so it can be a program name with args. -set dummy otool; ac_word=$2 -{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 -$as_echo_n "checking for $ac_word... " >&6; } -if ${ac_cv_prog_ac_ct_OTOOL+:} false; then : - $as_echo_n "(cached) " >&6 -else - if test -n "$ac_ct_OTOOL"; then - ac_cv_prog_ac_ct_OTOOL="$ac_ct_OTOOL" # Let the user override the test. -else -as_save_IFS=$IFS; IFS=$PATH_SEPARATOR -for as_dir in $PATH -do - IFS=$as_save_IFS - test -z "$as_dir" && as_dir=. - for ac_exec_ext in '' $ac_executable_extensions; do - if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then - ac_cv_prog_ac_ct_OTOOL="otool" - $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 - break 2 - fi -done - done -IFS=$as_save_IFS - -fi -fi -ac_ct_OTOOL=$ac_cv_prog_ac_ct_OTOOL -if test -n "$ac_ct_OTOOL"; then - { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_ct_OTOOL" >&5 -$as_echo "$ac_ct_OTOOL" >&6; } -else - { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 -$as_echo "no" >&6; } -fi - - if test "x$ac_ct_OTOOL" = x; then - OTOOL=":" - else - case $cross_compiling:$ac_tool_warned in -yes:) -{ $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5 -$as_echo "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;} -ac_tool_warned=yes ;; -esac - OTOOL=$ac_ct_OTOOL - fi -else - OTOOL="$ac_cv_prog_OTOOL" -fi - - if test -n "$ac_tool_prefix"; then - # Extract the first word of "${ac_tool_prefix}otool64", so it can be a program name with args. -set dummy ${ac_tool_prefix}otool64; ac_word=$2 -{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 -$as_echo_n "checking for $ac_word... " >&6; } -if ${ac_cv_prog_OTOOL64+:} false; then : - $as_echo_n "(cached) " >&6 -else - if test -n "$OTOOL64"; then - ac_cv_prog_OTOOL64="$OTOOL64" # Let the user override the test. -else -as_save_IFS=$IFS; IFS=$PATH_SEPARATOR -for as_dir in $PATH -do - IFS=$as_save_IFS - test -z "$as_dir" && as_dir=. - for ac_exec_ext in '' $ac_executable_extensions; do - if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then - ac_cv_prog_OTOOL64="${ac_tool_prefix}otool64" - $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 - break 2 - fi -done - done -IFS=$as_save_IFS - -fi -fi -OTOOL64=$ac_cv_prog_OTOOL64 -if test -n "$OTOOL64"; then - { $as_echo "$as_me:${as_lineno-$LINENO}: result: $OTOOL64" >&5 -$as_echo "$OTOOL64" >&6; } -else - { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 -$as_echo "no" >&6; } -fi - - -fi -if test -z "$ac_cv_prog_OTOOL64"; then - ac_ct_OTOOL64=$OTOOL64 - # Extract the first word of "otool64", so it can be a program name with args. -set dummy otool64; ac_word=$2 -{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 -$as_echo_n "checking for $ac_word... " >&6; } -if ${ac_cv_prog_ac_ct_OTOOL64+:} false; then : - $as_echo_n "(cached) " >&6 -else - if test -n "$ac_ct_OTOOL64"; then - ac_cv_prog_ac_ct_OTOOL64="$ac_ct_OTOOL64" # Let the user override the test. -else -as_save_IFS=$IFS; IFS=$PATH_SEPARATOR -for as_dir in $PATH -do - IFS=$as_save_IFS - test -z "$as_dir" && as_dir=. - for ac_exec_ext in '' $ac_executable_extensions; do - if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then - ac_cv_prog_ac_ct_OTOOL64="otool64" - $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 - break 2 - fi -done - done -IFS=$as_save_IFS - -fi -fi -ac_ct_OTOOL64=$ac_cv_prog_ac_ct_OTOOL64 -if test -n "$ac_ct_OTOOL64"; then - { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_ct_OTOOL64" >&5 -$as_echo "$ac_ct_OTOOL64" >&6; } -else - { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 -$as_echo "no" >&6; } -fi - - if test "x$ac_ct_OTOOL64" = x; then - OTOOL64=":" - else - case $cross_compiling:$ac_tool_warned in -yes:) -{ $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5 -$as_echo "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;} -ac_tool_warned=yes ;; -esac - OTOOL64=$ac_ct_OTOOL64 - fi -else - OTOOL64="$ac_cv_prog_OTOOL64" -fi - - - - - - - - - - - - - - - - - - - - - - - - - - - - { $as_echo "$as_me:${as_lineno-$LINENO}: checking for -single_module linker flag" >&5 -$as_echo_n "checking for -single_module linker flag... " >&6; } -if ${lt_cv_apple_cc_single_mod+:} false; then : - $as_echo_n "(cached) " >&6 -else - lt_cv_apple_cc_single_mod=no - if test -z "$LT_MULTI_MODULE"; then - # By default we will add the -single_module flag. You can override - # by either setting the environment variable LT_MULTI_MODULE - # non-empty at configure time, or by adding -multi_module to the - # link flags. - rm -rf libconftest.dylib* - echo "int foo(void){return 1;}" > conftest.c - echo "$LTCC $LTCFLAGS $LDFLAGS -o libconftest.dylib \ --dynamiclib -Wl,-single_module conftest.c" >&5 - $LTCC $LTCFLAGS $LDFLAGS -o libconftest.dylib \ - -dynamiclib -Wl,-single_module conftest.c 2>conftest.err - _lt_result=$? - # If there is a non-empty error log, and "single_module" - # appears in it, assume the flag caused a linker warning - if test -s conftest.err && $GREP single_module conftest.err; then - cat conftest.err >&5 - # Otherwise, if the output was created with a 0 exit code from - # the compiler, it worked. - elif test -f libconftest.dylib && test 0 = "$_lt_result"; then - lt_cv_apple_cc_single_mod=yes - else - cat conftest.err >&5 - fi - rm -rf libconftest.dylib* - rm -f conftest.* - fi -fi -{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $lt_cv_apple_cc_single_mod" >&5 -$as_echo "$lt_cv_apple_cc_single_mod" >&6; } - - { $as_echo "$as_me:${as_lineno-$LINENO}: checking for -exported_symbols_list linker flag" >&5 -$as_echo_n "checking for -exported_symbols_list linker flag... " >&6; } -if ${lt_cv_ld_exported_symbols_list+:} false; then : - $as_echo_n "(cached) " >&6 -else - lt_cv_ld_exported_symbols_list=no - save_LDFLAGS=$LDFLAGS - echo "_main" > conftest.sym - LDFLAGS="$LDFLAGS -Wl,-exported_symbols_list,conftest.sym" - cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ - -int -main () -{ - - ; - return 0; -} -_ACEOF -if ac_fn_c_try_link "$LINENO"; then : - lt_cv_ld_exported_symbols_list=yes -else - lt_cv_ld_exported_symbols_list=no -fi -rm -f core conftest.err conftest.$ac_objext \ - conftest$ac_exeext conftest.$ac_ext - LDFLAGS=$save_LDFLAGS - -fi -{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $lt_cv_ld_exported_symbols_list" >&5 -$as_echo "$lt_cv_ld_exported_symbols_list" >&6; } - - { $as_echo "$as_me:${as_lineno-$LINENO}: checking for -force_load linker flag" >&5 -$as_echo_n "checking for -force_load linker flag... " >&6; } -if ${lt_cv_ld_force_load+:} false; then : - $as_echo_n "(cached) " >&6 -else - lt_cv_ld_force_load=no - cat > conftest.c << _LT_EOF -int forced_loaded() { return 2;} -_LT_EOF - echo "$LTCC $LTCFLAGS -c -o conftest.o conftest.c" >&5 - $LTCC $LTCFLAGS -c -o conftest.o conftest.c 2>&5 - echo "$AR cru libconftest.a conftest.o" >&5 - $AR cru libconftest.a conftest.o 2>&5 - echo "$RANLIB libconftest.a" >&5 - $RANLIB libconftest.a 2>&5 - cat > conftest.c << _LT_EOF -int main() { return 0;} -_LT_EOF - echo "$LTCC $LTCFLAGS $LDFLAGS -o conftest conftest.c -Wl,-force_load,./libconftest.a" >&5 - $LTCC $LTCFLAGS $LDFLAGS -o conftest conftest.c -Wl,-force_load,./libconftest.a 2>conftest.err - _lt_result=$? - if test -s conftest.err && $GREP force_load conftest.err; then - cat conftest.err >&5 - elif test -f conftest && test 0 = "$_lt_result" && $GREP forced_load conftest >/dev/null 2>&1; then - lt_cv_ld_force_load=yes - else - cat conftest.err >&5 - fi - rm -f conftest.err libconftest.a conftest conftest.c - rm -rf conftest.dSYM - -fi -{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $lt_cv_ld_force_load" >&5 -$as_echo "$lt_cv_ld_force_load" >&6; } - case $host_os in - rhapsody* | darwin1.[012]) - _lt_dar_allow_undefined='$wl-undefined ${wl}suppress' ;; - darwin1.*) - _lt_dar_allow_undefined='$wl-flat_namespace $wl-undefined ${wl}suppress' ;; - darwin*) # darwin 5.x on - # if running on 10.5 or later, the deployment target defaults - # to the OS version, if on x86, and 10.4, the deployment - # target defaults to 10.4. Don't you love it? - case ${MACOSX_DEPLOYMENT_TARGET-10.0},$host in - 10.0,*86*-darwin8*|10.0,*-darwin[91]*) - _lt_dar_allow_undefined='$wl-undefined ${wl}dynamic_lookup' ;; - 10.[012][,.]*) - _lt_dar_allow_undefined='$wl-flat_namespace $wl-undefined ${wl}suppress' ;; - 10.*) - _lt_dar_allow_undefined='$wl-undefined ${wl}dynamic_lookup' ;; - esac - ;; - esac - if test yes = "$lt_cv_apple_cc_single_mod"; then - _lt_dar_single_mod='$single_module' - fi - if test yes = "$lt_cv_ld_exported_symbols_list"; then - _lt_dar_export_syms=' $wl-exported_symbols_list,$output_objdir/$libname-symbols.expsym' - else - _lt_dar_export_syms='~$NMEDIT -s $output_objdir/$libname-symbols.expsym $lib' - fi - if test : != "$DSYMUTIL" && test no = "$lt_cv_ld_force_load"; then - _lt_dsymutil='~$DSYMUTIL $lib || :' - else - _lt_dsymutil= - fi - ;; - esac - -# func_munge_path_list VARIABLE PATH -# ----------------------------------- -# VARIABLE is name of variable containing _space_ separated list of -# directories to be munged by the contents of PATH, which is string -# having a format: -# "DIR[:DIR]:" -# string "DIR[ DIR]" will be prepended to VARIABLE -# ":DIR[:DIR]" -# string "DIR[ DIR]" will be appended to VARIABLE -# "DIRP[:DIRP]::[DIRA:]DIRA" -# string "DIRP[ DIRP]" will be prepended to VARIABLE and string -# "DIRA[ DIRA]" will be appended to VARIABLE -# "DIR[:DIR]" -# VARIABLE will be replaced by "DIR[ DIR]" -func_munge_path_list () -{ - case x$2 in - x) - ;; - *:) - eval $1=\"`$ECHO $2 | $SED 's/:/ /g'` \$$1\" - ;; - x:*) - eval $1=\"\$$1 `$ECHO $2 | $SED 's/:/ /g'`\" - ;; - *::*) - eval $1=\"\$$1\ `$ECHO $2 | $SED -e 's/.*:://' -e 's/:/ /g'`\" - eval $1=\"`$ECHO $2 | $SED -e 's/::.*//' -e 's/:/ /g'`\ \$$1\" - ;; - *) - eval $1=\"`$ECHO $2 | $SED 's/:/ /g'`\" - ;; - esac -} - -for ac_header in dlfcn.h -do : - ac_fn_c_check_header_compile "$LINENO" "dlfcn.h" "ac_cv_header_dlfcn_h" "$ac_includes_default -" -if test "x$ac_cv_header_dlfcn_h" = xyes; then : - cat >>confdefs.h <<_ACEOF -#define HAVE_DLFCN_H 1 -_ACEOF - -fi - -done - - - - - -# Set options -enable_dlopen=yes -enable_win32_dll=yes - -case $host in -*-*-cygwin* | *-*-mingw* | *-*-pw32* | *-*-cegcc*) - if test -n "$ac_tool_prefix"; then - # Extract the first word of "${ac_tool_prefix}as", so it can be a program name with args. -set dummy ${ac_tool_prefix}as; ac_word=$2 -{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 -$as_echo_n "checking for $ac_word... " >&6; } -if ${ac_cv_prog_AS+:} false; then : - $as_echo_n "(cached) " >&6 -else - if test -n "$AS"; then - ac_cv_prog_AS="$AS" # Let the user override the test. -else -as_save_IFS=$IFS; IFS=$PATH_SEPARATOR -for as_dir in $PATH -do - IFS=$as_save_IFS - test -z "$as_dir" && as_dir=. - for ac_exec_ext in '' $ac_executable_extensions; do - if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then - ac_cv_prog_AS="${ac_tool_prefix}as" - $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 - break 2 - fi -done - done -IFS=$as_save_IFS - -fi -fi -AS=$ac_cv_prog_AS -if test -n "$AS"; then - { $as_echo "$as_me:${as_lineno-$LINENO}: result: $AS" >&5 -$as_echo "$AS" >&6; } -else - { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 -$as_echo "no" >&6; } -fi - - -fi -if test -z "$ac_cv_prog_AS"; then - ac_ct_AS=$AS - # Extract the first word of "as", so it can be a program name with args. -set dummy as; ac_word=$2 -{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 -$as_echo_n "checking for $ac_word... " >&6; } -if ${ac_cv_prog_ac_ct_AS+:} false; then : - $as_echo_n "(cached) " >&6 -else - if test -n "$ac_ct_AS"; then - ac_cv_prog_ac_ct_AS="$ac_ct_AS" # Let the user override the test. -else -as_save_IFS=$IFS; IFS=$PATH_SEPARATOR -for as_dir in $PATH -do - IFS=$as_save_IFS - test -z "$as_dir" && as_dir=. - for ac_exec_ext in '' $ac_executable_extensions; do - if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then - ac_cv_prog_ac_ct_AS="as" - $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 - break 2 - fi -done - done -IFS=$as_save_IFS - -fi -fi -ac_ct_AS=$ac_cv_prog_ac_ct_AS -if test -n "$ac_ct_AS"; then - { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_ct_AS" >&5 -$as_echo "$ac_ct_AS" >&6; } -else - { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 -$as_echo "no" >&6; } -fi - - if test "x$ac_ct_AS" = x; then - AS="false" - else - case $cross_compiling:$ac_tool_warned in -yes:) -{ $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5 -$as_echo "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;} -ac_tool_warned=yes ;; -esac - AS=$ac_ct_AS - fi -else - AS="$ac_cv_prog_AS" -fi - - if test -n "$ac_tool_prefix"; then - # Extract the first word of "${ac_tool_prefix}dlltool", so it can be a program name with args. -set dummy ${ac_tool_prefix}dlltool; ac_word=$2 -{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 -$as_echo_n "checking for $ac_word... " >&6; } -if ${ac_cv_prog_DLLTOOL+:} false; then : - $as_echo_n "(cached) " >&6 -else - if test -n "$DLLTOOL"; then - ac_cv_prog_DLLTOOL="$DLLTOOL" # Let the user override the test. -else -as_save_IFS=$IFS; IFS=$PATH_SEPARATOR -for as_dir in $PATH -do - IFS=$as_save_IFS - test -z "$as_dir" && as_dir=. - for ac_exec_ext in '' $ac_executable_extensions; do - if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then - ac_cv_prog_DLLTOOL="${ac_tool_prefix}dlltool" - $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 - break 2 - fi -done - done -IFS=$as_save_IFS - -fi -fi -DLLTOOL=$ac_cv_prog_DLLTOOL -if test -n "$DLLTOOL"; then - { $as_echo "$as_me:${as_lineno-$LINENO}: result: $DLLTOOL" >&5 -$as_echo "$DLLTOOL" >&6; } -else - { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 -$as_echo "no" >&6; } -fi - - -fi -if test -z "$ac_cv_prog_DLLTOOL"; then - ac_ct_DLLTOOL=$DLLTOOL - # Extract the first word of "dlltool", so it can be a program name with args. -set dummy dlltool; ac_word=$2 -{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 -$as_echo_n "checking for $ac_word... " >&6; } -if ${ac_cv_prog_ac_ct_DLLTOOL+:} false; then : - $as_echo_n "(cached) " >&6 -else - if test -n "$ac_ct_DLLTOOL"; then - ac_cv_prog_ac_ct_DLLTOOL="$ac_ct_DLLTOOL" # Let the user override the test. -else -as_save_IFS=$IFS; IFS=$PATH_SEPARATOR -for as_dir in $PATH -do - IFS=$as_save_IFS - test -z "$as_dir" && as_dir=. - for ac_exec_ext in '' $ac_executable_extensions; do - if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then - ac_cv_prog_ac_ct_DLLTOOL="dlltool" - $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 - break 2 - fi -done - done -IFS=$as_save_IFS - -fi -fi -ac_ct_DLLTOOL=$ac_cv_prog_ac_ct_DLLTOOL -if test -n "$ac_ct_DLLTOOL"; then - { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_ct_DLLTOOL" >&5 -$as_echo "$ac_ct_DLLTOOL" >&6; } -else - { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 -$as_echo "no" >&6; } -fi - - if test "x$ac_ct_DLLTOOL" = x; then - DLLTOOL="false" - else - case $cross_compiling:$ac_tool_warned in -yes:) -{ $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5 -$as_echo "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;} -ac_tool_warned=yes ;; -esac - DLLTOOL=$ac_ct_DLLTOOL - fi -else - DLLTOOL="$ac_cv_prog_DLLTOOL" -fi - - if test -n "$ac_tool_prefix"; then - # Extract the first word of "${ac_tool_prefix}objdump", so it can be a program name with args. -set dummy ${ac_tool_prefix}objdump; ac_word=$2 -{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 -$as_echo_n "checking for $ac_word... " >&6; } -if ${ac_cv_prog_OBJDUMP+:} false; then : - $as_echo_n "(cached) " >&6 -else - if test -n "$OBJDUMP"; then - ac_cv_prog_OBJDUMP="$OBJDUMP" # Let the user override the test. -else -as_save_IFS=$IFS; IFS=$PATH_SEPARATOR -for as_dir in $PATH -do - IFS=$as_save_IFS - test -z "$as_dir" && as_dir=. - for ac_exec_ext in '' $ac_executable_extensions; do - if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then - ac_cv_prog_OBJDUMP="${ac_tool_prefix}objdump" - $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 - break 2 - fi -done - done -IFS=$as_save_IFS - -fi -fi -OBJDUMP=$ac_cv_prog_OBJDUMP -if test -n "$OBJDUMP"; then - { $as_echo "$as_me:${as_lineno-$LINENO}: result: $OBJDUMP" >&5 -$as_echo "$OBJDUMP" >&6; } -else - { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 -$as_echo "no" >&6; } -fi - - -fi -if test -z "$ac_cv_prog_OBJDUMP"; then - ac_ct_OBJDUMP=$OBJDUMP - # Extract the first word of "objdump", so it can be a program name with args. -set dummy objdump; ac_word=$2 -{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 -$as_echo_n "checking for $ac_word... " >&6; } -if ${ac_cv_prog_ac_ct_OBJDUMP+:} false; then : - $as_echo_n "(cached) " >&6 -else - if test -n "$ac_ct_OBJDUMP"; then - ac_cv_prog_ac_ct_OBJDUMP="$ac_ct_OBJDUMP" # Let the user override the test. -else -as_save_IFS=$IFS; IFS=$PATH_SEPARATOR -for as_dir in $PATH -do - IFS=$as_save_IFS - test -z "$as_dir" && as_dir=. - for ac_exec_ext in '' $ac_executable_extensions; do - if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then - ac_cv_prog_ac_ct_OBJDUMP="objdump" - $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 - break 2 - fi -done - done -IFS=$as_save_IFS - -fi -fi -ac_ct_OBJDUMP=$ac_cv_prog_ac_ct_OBJDUMP -if test -n "$ac_ct_OBJDUMP"; then - { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_ct_OBJDUMP" >&5 -$as_echo "$ac_ct_OBJDUMP" >&6; } -else - { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 -$as_echo "no" >&6; } -fi - - if test "x$ac_ct_OBJDUMP" = x; then - OBJDUMP="false" - else - case $cross_compiling:$ac_tool_warned in -yes:) -{ $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5 -$as_echo "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;} -ac_tool_warned=yes ;; -esac - OBJDUMP=$ac_ct_OBJDUMP - fi -else - OBJDUMP="$ac_cv_prog_OBJDUMP" -fi - - ;; -esac - -test -z "$AS" && AS=as - - - - - -test -z "$DLLTOOL" && DLLTOOL=dlltool - - - - - -test -z "$OBJDUMP" && OBJDUMP=objdump - - - - - - - - - - # Check whether --enable-shared was given. -if test "${enable_shared+set}" = set; then : - enableval=$enable_shared; p=${PACKAGE-default} - case $enableval in - yes) enable_shared=yes ;; - no) enable_shared=no ;; - *) - enable_shared=no - # Look at the argument we got. We use all the common list separators. - lt_save_ifs=$IFS; IFS=$IFS$PATH_SEPARATOR, - for pkg in $enableval; do - IFS=$lt_save_ifs - if test "X$pkg" = "X$p"; then - enable_shared=yes - fi - done - IFS=$lt_save_ifs - ;; - esac -else - enable_shared=yes -fi - - - - - - - - - - # Check whether --enable-static was given. -if test "${enable_static+set}" = set; then : - enableval=$enable_static; p=${PACKAGE-default} - case $enableval in - yes) enable_static=yes ;; - no) enable_static=no ;; - *) - enable_static=no - # Look at the argument we got. We use all the common list separators. - lt_save_ifs=$IFS; IFS=$IFS$PATH_SEPARATOR, - for pkg in $enableval; do - IFS=$lt_save_ifs - if test "X$pkg" = "X$p"; then - enable_static=yes - fi - done - IFS=$lt_save_ifs - ;; - esac -else - enable_static=yes -fi - - - - - - - - - - -# Check whether --with-pic was given. -if test "${with_pic+set}" = set; then : - withval=$with_pic; lt_p=${PACKAGE-default} - case $withval in - yes|no) pic_mode=$withval ;; - *) - pic_mode=default - # Look at the argument we got. We use all the common list separators. - lt_save_ifs=$IFS; IFS=$IFS$PATH_SEPARATOR, - for lt_pkg in $withval; do - IFS=$lt_save_ifs - if test "X$lt_pkg" = "X$lt_p"; then - pic_mode=yes - fi - done - IFS=$lt_save_ifs - ;; - esac -else - pic_mode=default -fi - - - - - - - - - # Check whether --enable-fast-install was given. -if test "${enable_fast_install+set}" = set; then : - enableval=$enable_fast_install; p=${PACKAGE-default} - case $enableval in - yes) enable_fast_install=yes ;; - no) enable_fast_install=no ;; - *) - enable_fast_install=no - # Look at the argument we got. We use all the common list separators. - lt_save_ifs=$IFS; IFS=$IFS$PATH_SEPARATOR, - for pkg in $enableval; do - IFS=$lt_save_ifs - if test "X$pkg" = "X$p"; then - enable_fast_install=yes - fi - done - IFS=$lt_save_ifs - ;; - esac -else - enable_fast_install=yes -fi - - - - - - - - - shared_archive_member_spec= -case $host,$enable_shared in -power*-*-aix[5-9]*,yes) - { $as_echo "$as_me:${as_lineno-$LINENO}: checking which variant of shared library versioning to provide" >&5 -$as_echo_n "checking which variant of shared library versioning to provide... " >&6; } - -# Check whether --with-aix-soname was given. -if test "${with_aix_soname+set}" = set; then : - withval=$with_aix_soname; case $withval in - aix|svr4|both) - ;; - *) - as_fn_error $? "Unknown argument to --with-aix-soname" "$LINENO" 5 - ;; - esac - lt_cv_with_aix_soname=$with_aix_soname -else - if ${lt_cv_with_aix_soname+:} false; then : - $as_echo_n "(cached) " >&6 -else - lt_cv_with_aix_soname=aix -fi - - with_aix_soname=$lt_cv_with_aix_soname -fi - - { $as_echo "$as_me:${as_lineno-$LINENO}: result: $with_aix_soname" >&5 -$as_echo "$with_aix_soname" >&6; } - if test aix != "$with_aix_soname"; then - # For the AIX way of multilib, we name the shared archive member - # based on the bitwidth used, traditionally 'shr.o' or 'shr_64.o', - # and 'shr.imp' or 'shr_64.imp', respectively, for the Import File. - # Even when GNU compilers ignore OBJECT_MODE but need '-maix64' flag, - # the AIX toolchain works better with OBJECT_MODE set (default 32). - if test 64 = "${OBJECT_MODE-32}"; then - shared_archive_member_spec=shr_64 - else - shared_archive_member_spec=shr - fi - fi - ;; -*) - with_aix_soname=aix - ;; -esac - - - - - - - - - - -# This can be used to rebuild libtool when needed -LIBTOOL_DEPS=$ltmain - -# Always use our own libtool. -LIBTOOL='$(SHELL) $(top_builddir)/libtool' - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -test -z "$LN_S" && LN_S="ln -s" - - - - - - - - - - - - - - -if test -n "${ZSH_VERSION+set}"; then - setopt NO_GLOB_SUBST -fi - -{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for objdir" >&5 -$as_echo_n "checking for objdir... " >&6; } -if ${lt_cv_objdir+:} false; then : - $as_echo_n "(cached) " >&6 -else - rm -f .libs 2>/dev/null -mkdir .libs 2>/dev/null -if test -d .libs; then - lt_cv_objdir=.libs -else - # MS-DOS does not allow filenames that begin with a dot. - lt_cv_objdir=_libs -fi -rmdir .libs 2>/dev/null -fi -{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $lt_cv_objdir" >&5 -$as_echo "$lt_cv_objdir" >&6; } -objdir=$lt_cv_objdir - - - - - -cat >>confdefs.h <<_ACEOF -#define LT_OBJDIR "$lt_cv_objdir/" -_ACEOF - - - - -case $host_os in -aix3*) - # AIX sometimes has problems with the GCC collect2 program. For some - # reason, if we set the COLLECT_NAMES environment variable, the problems - # vanish in a puff of smoke. - if test set != "${COLLECT_NAMES+set}"; then - COLLECT_NAMES= - export COLLECT_NAMES - fi - ;; -esac - -# Global variables: -ofile=libtool -can_build_shared=yes - -# All known linkers require a '.a' archive for static linking (except MSVC, -# which needs '.lib'). -libext=a - -with_gnu_ld=$lt_cv_prog_gnu_ld - -old_CC=$CC -old_CFLAGS=$CFLAGS - -# Set sane defaults for various variables -test -z "$CC" && CC=cc -test -z "$LTCC" && LTCC=$CC -test -z "$LTCFLAGS" && LTCFLAGS=$CFLAGS -test -z "$LD" && LD=ld -test -z "$ac_objext" && ac_objext=o - -func_cc_basename $compiler -cc_basename=$func_cc_basename_result - - -# Only perform the check for file, if the check method requires it -test -z "$MAGIC_CMD" && MAGIC_CMD=file -case $deplibs_check_method in -file_magic*) - if test "$file_magic_cmd" = '$MAGIC_CMD'; then - { $as_echo "$as_me:${as_lineno-$LINENO}: checking for ${ac_tool_prefix}file" >&5 -$as_echo_n "checking for ${ac_tool_prefix}file... " >&6; } -if ${lt_cv_path_MAGIC_CMD+:} false; then : - $as_echo_n "(cached) " >&6 -else - case $MAGIC_CMD in -[\\/*] | ?:[\\/]*) - lt_cv_path_MAGIC_CMD=$MAGIC_CMD # Let the user override the test with a path. - ;; -*) - lt_save_MAGIC_CMD=$MAGIC_CMD - lt_save_ifs=$IFS; IFS=$PATH_SEPARATOR - ac_dummy="/usr/bin$PATH_SEPARATOR$PATH" - for ac_dir in $ac_dummy; do - IFS=$lt_save_ifs - test -z "$ac_dir" && ac_dir=. - if test -f "$ac_dir/${ac_tool_prefix}file"; then - lt_cv_path_MAGIC_CMD=$ac_dir/"${ac_tool_prefix}file" - if test -n "$file_magic_test_file"; then - case $deplibs_check_method in - "file_magic "*) - file_magic_regex=`expr "$deplibs_check_method" : "file_magic \(.*\)"` - MAGIC_CMD=$lt_cv_path_MAGIC_CMD - if eval $file_magic_cmd \$file_magic_test_file 2> /dev/null | - $EGREP "$file_magic_regex" > /dev/null; then - : - else - cat <<_LT_EOF 1>&2 - -*** Warning: the command libtool uses to detect shared libraries, -*** $file_magic_cmd, produces output that libtool cannot recognize. -*** The result is that libtool may fail to recognize shared libraries -*** as such. This will affect the creation of libtool libraries that -*** depend on shared libraries, but programs linked with such libtool -*** libraries will work regardless of this problem. Nevertheless, you -*** may want to report the problem to your system manager and/or to -*** bug-libtool@gnu.org - -_LT_EOF - fi ;; - esac - fi - break - fi - done - IFS=$lt_save_ifs - MAGIC_CMD=$lt_save_MAGIC_CMD - ;; -esac -fi - -MAGIC_CMD=$lt_cv_path_MAGIC_CMD -if test -n "$MAGIC_CMD"; then - { $as_echo "$as_me:${as_lineno-$LINENO}: result: $MAGIC_CMD" >&5 -$as_echo "$MAGIC_CMD" >&6; } -else - { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 -$as_echo "no" >&6; } -fi - - - - - -if test -z "$lt_cv_path_MAGIC_CMD"; then - if test -n "$ac_tool_prefix"; then - { $as_echo "$as_me:${as_lineno-$LINENO}: checking for file" >&5 -$as_echo_n "checking for file... " >&6; } -if ${lt_cv_path_MAGIC_CMD+:} false; then : - $as_echo_n "(cached) " >&6 -else - case $MAGIC_CMD in -[\\/*] | ?:[\\/]*) - lt_cv_path_MAGIC_CMD=$MAGIC_CMD # Let the user override the test with a path. - ;; -*) - lt_save_MAGIC_CMD=$MAGIC_CMD - lt_save_ifs=$IFS; IFS=$PATH_SEPARATOR - ac_dummy="/usr/bin$PATH_SEPARATOR$PATH" - for ac_dir in $ac_dummy; do - IFS=$lt_save_ifs - test -z "$ac_dir" && ac_dir=. - if test -f "$ac_dir/file"; then - lt_cv_path_MAGIC_CMD=$ac_dir/"file" - if test -n "$file_magic_test_file"; then - case $deplibs_check_method in - "file_magic "*) - file_magic_regex=`expr "$deplibs_check_method" : "file_magic \(.*\)"` - MAGIC_CMD=$lt_cv_path_MAGIC_CMD - if eval $file_magic_cmd \$file_magic_test_file 2> /dev/null | - $EGREP "$file_magic_regex" > /dev/null; then - : - else - cat <<_LT_EOF 1>&2 - -*** Warning: the command libtool uses to detect shared libraries, -*** $file_magic_cmd, produces output that libtool cannot recognize. -*** The result is that libtool may fail to recognize shared libraries -*** as such. This will affect the creation of libtool libraries that -*** depend on shared libraries, but programs linked with such libtool -*** libraries will work regardless of this problem. Nevertheless, you -*** may want to report the problem to your system manager and/or to -*** bug-libtool@gnu.org - -_LT_EOF - fi ;; - esac - fi - break - fi - done - IFS=$lt_save_ifs - MAGIC_CMD=$lt_save_MAGIC_CMD - ;; -esac -fi - -MAGIC_CMD=$lt_cv_path_MAGIC_CMD -if test -n "$MAGIC_CMD"; then - { $as_echo "$as_me:${as_lineno-$LINENO}: result: $MAGIC_CMD" >&5 -$as_echo "$MAGIC_CMD" >&6; } -else - { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 -$as_echo "no" >&6; } -fi - - - else - MAGIC_CMD=: - fi -fi - - fi - ;; -esac - -# Use C for the default configuration in the libtool script - -lt_save_CC=$CC -ac_ext=c -ac_cpp='$CPP $CPPFLAGS' -ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' -ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' -ac_compiler_gnu=$ac_cv_c_compiler_gnu - - -# Source file extension for C test sources. -ac_ext=c - -# Object file extension for compiled C test sources. -objext=o -objext=$objext - -# Code to be used in simple compile tests -lt_simple_compile_test_code="int some_variable = 0;" - -# Code to be used in simple link tests -lt_simple_link_test_code='int main(){return(0);}' - - - - - - - -# If no C compiler was specified, use CC. -LTCC=${LTCC-"$CC"} - -# If no C compiler flags were specified, use CFLAGS. -LTCFLAGS=${LTCFLAGS-"$CFLAGS"} - -# Allow CC to be a program name with arguments. -compiler=$CC - -# Save the default compiler, since it gets overwritten when the other -# tags are being tested, and _LT_TAGVAR(compiler, []) is a NOP. -compiler_DEFAULT=$CC - -# save warnings/boilerplate of simple test code -ac_outfile=conftest.$ac_objext -echo "$lt_simple_compile_test_code" >conftest.$ac_ext -eval "$ac_compile" 2>&1 >/dev/null | $SED '/^$/d; /^ *+/d' >conftest.err -_lt_compiler_boilerplate=`cat conftest.err` -$RM conftest* - -ac_outfile=conftest.$ac_objext -echo "$lt_simple_link_test_code" >conftest.$ac_ext -eval "$ac_link" 2>&1 >/dev/null | $SED '/^$/d; /^ *+/d' >conftest.err -_lt_linker_boilerplate=`cat conftest.err` -$RM -r conftest* - - -## CAVEAT EMPTOR: -## There is no encapsulation within the following macros, do not change -## the running order or otherwise move them around unless you know exactly -## what you are doing... -if test -n "$compiler"; then - -lt_prog_compiler_no_builtin_flag= - -if test yes = "$GCC"; then - case $cc_basename in - nvcc*) - lt_prog_compiler_no_builtin_flag=' -Xcompiler -fno-builtin' ;; - *) - lt_prog_compiler_no_builtin_flag=' -fno-builtin' ;; - esac - - { $as_echo "$as_me:${as_lineno-$LINENO}: checking if $compiler supports -fno-rtti -fno-exceptions" >&5 -$as_echo_n "checking if $compiler supports -fno-rtti -fno-exceptions... " >&6; } -if ${lt_cv_prog_compiler_rtti_exceptions+:} false; then : - $as_echo_n "(cached) " >&6 -else - lt_cv_prog_compiler_rtti_exceptions=no - ac_outfile=conftest.$ac_objext - echo "$lt_simple_compile_test_code" > conftest.$ac_ext - lt_compiler_flag="-fno-rtti -fno-exceptions" ## exclude from sc_useless_quotes_in_assignment - # Insert the option either (1) after the last *FLAGS variable, or - # (2) before a word containing "conftest.", or (3) at the end. - # Note that $ac_compile itself does not contain backslashes and begins - # with a dollar sign (not a hyphen), so the echo should work correctly. - # The option is referenced via a variable to avoid confusing sed. - lt_compile=`echo "$ac_compile" | $SED \ - -e 's:.*FLAGS}\{0,1\} :&$lt_compiler_flag :; t' \ - -e 's: [^ ]*conftest\.: $lt_compiler_flag&:; t' \ - -e 's:$: $lt_compiler_flag:'` - (eval echo "\"\$as_me:$LINENO: $lt_compile\"" >&5) - (eval "$lt_compile" 2>conftest.err) - ac_status=$? - cat conftest.err >&5 - echo "$as_me:$LINENO: \$? = $ac_status" >&5 - if (exit $ac_status) && test -s "$ac_outfile"; then - # The compiler can only warn and ignore the option if not recognized - # So say no if there are warnings other than the usual output. - $ECHO "$_lt_compiler_boilerplate" | $SED '/^$/d' >conftest.exp - $SED '/^$/d; /^ *+/d' conftest.err >conftest.er2 - if test ! -s conftest.er2 || diff conftest.exp conftest.er2 >/dev/null; then - lt_cv_prog_compiler_rtti_exceptions=yes - fi - fi - $RM conftest* - -fi -{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $lt_cv_prog_compiler_rtti_exceptions" >&5 -$as_echo "$lt_cv_prog_compiler_rtti_exceptions" >&6; } - -if test yes = "$lt_cv_prog_compiler_rtti_exceptions"; then - lt_prog_compiler_no_builtin_flag="$lt_prog_compiler_no_builtin_flag -fno-rtti -fno-exceptions" -else - : -fi - -fi - - - - - - - lt_prog_compiler_wl= -lt_prog_compiler_pic= -lt_prog_compiler_static= - - - if test yes = "$GCC"; then - lt_prog_compiler_wl='-Wl,' - lt_prog_compiler_static='-static' - - case $host_os in - aix*) - # All AIX code is PIC. - if test ia64 = "$host_cpu"; then - # AIX 5 now supports IA64 processor - lt_prog_compiler_static='-Bstatic' - fi - lt_prog_compiler_pic='-fPIC' - ;; - - amigaos*) - case $host_cpu in - powerpc) - # see comment about AmigaOS4 .so support - lt_prog_compiler_pic='-fPIC' - ;; - m68k) - # FIXME: we need at least 68020 code to build shared libraries, but - # adding the '-m68020' flag to GCC prevents building anything better, - # like '-m68040'. - lt_prog_compiler_pic='-m68020 -resident32 -malways-restore-a4' - ;; - esac - ;; - - beos* | irix5* | irix6* | nonstopux* | osf3* | osf4* | osf5*) - # PIC is the default for these OSes. - ;; - - mingw* | cygwin* | pw32* | os2* | cegcc*) - # This hack is so that the source file can tell whether it is being - # built for inclusion in a dll (and should export symbols for example). - # Although the cygwin gcc ignores -fPIC, still need this for old-style - # (--disable-auto-import) libraries - lt_prog_compiler_pic='-DDLL_EXPORT' - case $host_os in - os2*) - lt_prog_compiler_static='$wl-static' - ;; - esac - ;; - - darwin* | rhapsody*) - # PIC is the default on this platform - # Common symbols not allowed in MH_DYLIB files - lt_prog_compiler_pic='-fno-common' - ;; - - haiku*) - # PIC is the default for Haiku. - # The "-static" flag exists, but is broken. - lt_prog_compiler_static= - ;; - - hpux*) - # PIC is the default for 64-bit PA HP-UX, but not for 32-bit - # PA HP-UX. On IA64 HP-UX, PIC is the default but the pic flag - # sets the default TLS model and affects inlining. - case $host_cpu in - hppa*64*) - # +Z the default - ;; - *) - lt_prog_compiler_pic='-fPIC' - ;; - esac - ;; - - interix[3-9]*) - # Interix 3.x gcc -fpic/-fPIC options generate broken code. - # Instead, we relocate shared libraries at runtime. - ;; - - msdosdjgpp*) - # Just because we use GCC doesn't mean we suddenly get shared libraries - # on systems that don't support them. - lt_prog_compiler_can_build_shared=no - enable_shared=no - ;; - - *nto* | *qnx*) - # QNX uses GNU C++, but need to define -shared option too, otherwise - # it will coredump. - lt_prog_compiler_pic='-fPIC -shared' - ;; - - sysv4*MP*) - if test -d /usr/nec; then - lt_prog_compiler_pic=-Kconform_pic - fi - ;; - - *) - lt_prog_compiler_pic='-fPIC' - ;; - esac - - case $cc_basename in - nvcc*) # Cuda Compiler Driver 2.2 - lt_prog_compiler_wl='-Xlinker ' - if test -n "$lt_prog_compiler_pic"; then - lt_prog_compiler_pic="-Xcompiler $lt_prog_compiler_pic" - fi - ;; - esac - else - # PORTME Check for flag to pass linker flags through the system compiler. - case $host_os in - aix*) - lt_prog_compiler_wl='-Wl,' - if test ia64 = "$host_cpu"; then - # AIX 5 now supports IA64 processor - lt_prog_compiler_static='-Bstatic' - else - lt_prog_compiler_static='-bnso -bI:/lib/syscalls.exp' - fi - ;; - - darwin* | rhapsody*) - # PIC is the default on this platform - # Common symbols not allowed in MH_DYLIB files - lt_prog_compiler_pic='-fno-common' - case $cc_basename in - nagfor*) - # NAG Fortran compiler - lt_prog_compiler_wl='-Wl,-Wl,,' - lt_prog_compiler_pic='-PIC' - lt_prog_compiler_static='-Bstatic' - ;; - esac - ;; - - mingw* | cygwin* | pw32* | os2* | cegcc*) - # This hack is so that the source file can tell whether it is being - # built for inclusion in a dll (and should export symbols for example). - lt_prog_compiler_pic='-DDLL_EXPORT' - case $host_os in - os2*) - lt_prog_compiler_static='$wl-static' - ;; - esac - ;; - - hpux9* | hpux10* | hpux11*) - lt_prog_compiler_wl='-Wl,' - # PIC is the default for IA64 HP-UX and 64-bit HP-UX, but - # not for PA HP-UX. - case $host_cpu in - hppa*64*|ia64*) - # +Z the default - ;; - *) - lt_prog_compiler_pic='+Z' - ;; - esac - # Is there a better lt_prog_compiler_static that works with the bundled CC? - lt_prog_compiler_static='$wl-a ${wl}archive' - ;; - - irix5* | irix6* | nonstopux*) - lt_prog_compiler_wl='-Wl,' - # PIC (with -KPIC) is the default. - lt_prog_compiler_static='-non_shared' - ;; - - linux* | k*bsd*-gnu | kopensolaris*-gnu | gnu*) - case $cc_basename in - # old Intel for x86_64, which still supported -KPIC. - ecc*) - lt_prog_compiler_wl='-Wl,' - lt_prog_compiler_pic='-KPIC' - lt_prog_compiler_static='-static' - ;; - # icc used to be incompatible with GCC. - # ICC 10 doesn't accept -KPIC any more. - icc* | ifort*) - lt_prog_compiler_wl='-Wl,' - lt_prog_compiler_pic='-fPIC' - lt_prog_compiler_static='-static' - ;; - # Lahey Fortran 8.1. - lf95*) - lt_prog_compiler_wl='-Wl,' - lt_prog_compiler_pic='--shared' - lt_prog_compiler_static='--static' - ;; - nagfor*) - # NAG Fortran compiler - lt_prog_compiler_wl='-Wl,-Wl,,' - lt_prog_compiler_pic='-PIC' - lt_prog_compiler_static='-Bstatic' - ;; - tcc*) - # Fabrice Bellard et al's Tiny C Compiler - lt_prog_compiler_wl='-Wl,' - lt_prog_compiler_pic='-fPIC' - lt_prog_compiler_static='-static' - ;; - pgcc* | pgf77* | pgf90* | pgf95* | pgfortran*) - # Portland Group compilers (*not* the Pentium gcc compiler, - # which looks to be a dead project) - lt_prog_compiler_wl='-Wl,' - lt_prog_compiler_pic='-fpic' - lt_prog_compiler_static='-Bstatic' - ;; - ccc*) - lt_prog_compiler_wl='-Wl,' - # All Alpha code is PIC. - lt_prog_compiler_static='-non_shared' - ;; - xl* | bgxl* | bgf* | mpixl*) - # IBM XL C 8.0/Fortran 10.1, 11.1 on PPC and BlueGene - lt_prog_compiler_wl='-Wl,' - lt_prog_compiler_pic='-qpic' - lt_prog_compiler_static='-qstaticlink' - ;; - *) - case `$CC -V 2>&1 | sed 5q` in - *Sun\ Ceres\ Fortran* | *Sun*Fortran*\ [1-7].* | *Sun*Fortran*\ 8.[0-3]*) - # Sun Fortran 8.3 passes all unrecognized flags to the linker - lt_prog_compiler_pic='-KPIC' - lt_prog_compiler_static='-Bstatic' - lt_prog_compiler_wl='' - ;; - *Sun\ F* | *Sun*Fortran*) - lt_prog_compiler_pic='-KPIC' - lt_prog_compiler_static='-Bstatic' - lt_prog_compiler_wl='-Qoption ld ' - ;; - *Sun\ C*) - # Sun C 5.9 - lt_prog_compiler_pic='-KPIC' - lt_prog_compiler_static='-Bstatic' - lt_prog_compiler_wl='-Wl,' - ;; - *Intel*\ [CF]*Compiler*) - lt_prog_compiler_wl='-Wl,' - lt_prog_compiler_pic='-fPIC' - lt_prog_compiler_static='-static' - ;; - *Portland\ Group*) - lt_prog_compiler_wl='-Wl,' - lt_prog_compiler_pic='-fpic' - lt_prog_compiler_static='-Bstatic' - ;; - esac - ;; - esac - ;; - - newsos6) - lt_prog_compiler_pic='-KPIC' - lt_prog_compiler_static='-Bstatic' - ;; - - *nto* | *qnx*) - # QNX uses GNU C++, but need to define -shared option too, otherwise - # it will coredump. - lt_prog_compiler_pic='-fPIC -shared' - ;; - - osf3* | osf4* | osf5*) - lt_prog_compiler_wl='-Wl,' - # All OSF/1 code is PIC. - lt_prog_compiler_static='-non_shared' - ;; - - rdos*) - lt_prog_compiler_static='-non_shared' - ;; - - solaris*) - lt_prog_compiler_pic='-KPIC' - lt_prog_compiler_static='-Bstatic' - case $cc_basename in - f77* | f90* | f95* | sunf77* | sunf90* | sunf95*) - lt_prog_compiler_wl='-Qoption ld ';; - *) - lt_prog_compiler_wl='-Wl,';; - esac - ;; - - sunos4*) - lt_prog_compiler_wl='-Qoption ld ' - lt_prog_compiler_pic='-PIC' - lt_prog_compiler_static='-Bstatic' - ;; - - sysv4 | sysv4.2uw2* | sysv4.3*) - lt_prog_compiler_wl='-Wl,' - lt_prog_compiler_pic='-KPIC' - lt_prog_compiler_static='-Bstatic' - ;; - - sysv4*MP*) - if test -d /usr/nec; then - lt_prog_compiler_pic='-Kconform_pic' - lt_prog_compiler_static='-Bstatic' - fi - ;; - - sysv5* | unixware* | sco3.2v5* | sco5v6* | OpenUNIX*) - lt_prog_compiler_wl='-Wl,' - lt_prog_compiler_pic='-KPIC' - lt_prog_compiler_static='-Bstatic' - ;; - - unicos*) - lt_prog_compiler_wl='-Wl,' - lt_prog_compiler_can_build_shared=no - ;; - - uts4*) - lt_prog_compiler_pic='-pic' - lt_prog_compiler_static='-Bstatic' - ;; - - *) - lt_prog_compiler_can_build_shared=no - ;; - esac - fi - -case $host_os in - # For platforms that do not support PIC, -DPIC is meaningless: - *djgpp*) - lt_prog_compiler_pic= - ;; - *) - lt_prog_compiler_pic="$lt_prog_compiler_pic -DPIC" - ;; -esac - -{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $compiler option to produce PIC" >&5 -$as_echo_n "checking for $compiler option to produce PIC... " >&6; } -if ${lt_cv_prog_compiler_pic+:} false; then : - $as_echo_n "(cached) " >&6 -else - lt_cv_prog_compiler_pic=$lt_prog_compiler_pic -fi -{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $lt_cv_prog_compiler_pic" >&5 -$as_echo "$lt_cv_prog_compiler_pic" >&6; } -lt_prog_compiler_pic=$lt_cv_prog_compiler_pic - -# -# Check to make sure the PIC flag actually works. -# -if test -n "$lt_prog_compiler_pic"; then - { $as_echo "$as_me:${as_lineno-$LINENO}: checking if $compiler PIC flag $lt_prog_compiler_pic works" >&5 -$as_echo_n "checking if $compiler PIC flag $lt_prog_compiler_pic works... " >&6; } -if ${lt_cv_prog_compiler_pic_works+:} false; then : - $as_echo_n "(cached) " >&6 -else - lt_cv_prog_compiler_pic_works=no - ac_outfile=conftest.$ac_objext - echo "$lt_simple_compile_test_code" > conftest.$ac_ext - lt_compiler_flag="$lt_prog_compiler_pic -DPIC" ## exclude from sc_useless_quotes_in_assignment - # Insert the option either (1) after the last *FLAGS variable, or - # (2) before a word containing "conftest.", or (3) at the end. - # Note that $ac_compile itself does not contain backslashes and begins - # with a dollar sign (not a hyphen), so the echo should work correctly. - # The option is referenced via a variable to avoid confusing sed. - lt_compile=`echo "$ac_compile" | $SED \ - -e 's:.*FLAGS}\{0,1\} :&$lt_compiler_flag :; t' \ - -e 's: [^ ]*conftest\.: $lt_compiler_flag&:; t' \ - -e 's:$: $lt_compiler_flag:'` - (eval echo "\"\$as_me:$LINENO: $lt_compile\"" >&5) - (eval "$lt_compile" 2>conftest.err) - ac_status=$? - cat conftest.err >&5 - echo "$as_me:$LINENO: \$? = $ac_status" >&5 - if (exit $ac_status) && test -s "$ac_outfile"; then - # The compiler can only warn and ignore the option if not recognized - # So say no if there are warnings other than the usual output. - $ECHO "$_lt_compiler_boilerplate" | $SED '/^$/d' >conftest.exp - $SED '/^$/d; /^ *+/d' conftest.err >conftest.er2 - if test ! -s conftest.er2 || diff conftest.exp conftest.er2 >/dev/null; then - lt_cv_prog_compiler_pic_works=yes - fi - fi - $RM conftest* - -fi -{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $lt_cv_prog_compiler_pic_works" >&5 -$as_echo "$lt_cv_prog_compiler_pic_works" >&6; } - -if test yes = "$lt_cv_prog_compiler_pic_works"; then - case $lt_prog_compiler_pic in - "" | " "*) ;; - *) lt_prog_compiler_pic=" $lt_prog_compiler_pic" ;; - esac -else - lt_prog_compiler_pic= - lt_prog_compiler_can_build_shared=no -fi - -fi - - - - - - - - - - - -# -# Check to make sure the static flag actually works. -# -wl=$lt_prog_compiler_wl eval lt_tmp_static_flag=\"$lt_prog_compiler_static\" -{ $as_echo "$as_me:${as_lineno-$LINENO}: checking if $compiler static flag $lt_tmp_static_flag works" >&5 -$as_echo_n "checking if $compiler static flag $lt_tmp_static_flag works... " >&6; } -if ${lt_cv_prog_compiler_static_works+:} false; then : - $as_echo_n "(cached) " >&6 -else - lt_cv_prog_compiler_static_works=no - save_LDFLAGS=$LDFLAGS - LDFLAGS="$LDFLAGS $lt_tmp_static_flag" - echo "$lt_simple_link_test_code" > conftest.$ac_ext - if (eval $ac_link 2>conftest.err) && test -s conftest$ac_exeext; then - # The linker can only warn and ignore the option if not recognized - # So say no if there are warnings - if test -s conftest.err; then - # Append any errors to the config.log. - cat conftest.err 1>&5 - $ECHO "$_lt_linker_boilerplate" | $SED '/^$/d' > conftest.exp - $SED '/^$/d; /^ *+/d' conftest.err >conftest.er2 - if diff conftest.exp conftest.er2 >/dev/null; then - lt_cv_prog_compiler_static_works=yes - fi - else - lt_cv_prog_compiler_static_works=yes - fi - fi - $RM -r conftest* - LDFLAGS=$save_LDFLAGS - -fi -{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $lt_cv_prog_compiler_static_works" >&5 -$as_echo "$lt_cv_prog_compiler_static_works" >&6; } - -if test yes = "$lt_cv_prog_compiler_static_works"; then - : -else - lt_prog_compiler_static= -fi - - - - - - - - { $as_echo "$as_me:${as_lineno-$LINENO}: checking if $compiler supports -c -o file.$ac_objext" >&5 -$as_echo_n "checking if $compiler supports -c -o file.$ac_objext... " >&6; } -if ${lt_cv_prog_compiler_c_o+:} false; then : - $as_echo_n "(cached) " >&6 -else - lt_cv_prog_compiler_c_o=no - $RM -r conftest 2>/dev/null - mkdir conftest - cd conftest - mkdir out - echo "$lt_simple_compile_test_code" > conftest.$ac_ext - - lt_compiler_flag="-o out/conftest2.$ac_objext" - # Insert the option either (1) after the last *FLAGS variable, or - # (2) before a word containing "conftest.", or (3) at the end. - # Note that $ac_compile itself does not contain backslashes and begins - # with a dollar sign (not a hyphen), so the echo should work correctly. - lt_compile=`echo "$ac_compile" | $SED \ - -e 's:.*FLAGS}\{0,1\} :&$lt_compiler_flag :; t' \ - -e 's: [^ ]*conftest\.: $lt_compiler_flag&:; t' \ - -e 's:$: $lt_compiler_flag:'` - (eval echo "\"\$as_me:$LINENO: $lt_compile\"" >&5) - (eval "$lt_compile" 2>out/conftest.err) - ac_status=$? - cat out/conftest.err >&5 - echo "$as_me:$LINENO: \$? = $ac_status" >&5 - if (exit $ac_status) && test -s out/conftest2.$ac_objext - then - # The compiler can only warn and ignore the option if not recognized - # So say no if there are warnings - $ECHO "$_lt_compiler_boilerplate" | $SED '/^$/d' > out/conftest.exp - $SED '/^$/d; /^ *+/d' out/conftest.err >out/conftest.er2 - if test ! -s out/conftest.er2 || diff out/conftest.exp out/conftest.er2 >/dev/null; then - lt_cv_prog_compiler_c_o=yes - fi - fi - chmod u+w . 2>&5 - $RM conftest* - # SGI C++ compiler will create directory out/ii_files/ for - # template instantiation - test -d out/ii_files && $RM out/ii_files/* && rmdir out/ii_files - $RM out/* && rmdir out - cd .. - $RM -r conftest - $RM conftest* - -fi -{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $lt_cv_prog_compiler_c_o" >&5 -$as_echo "$lt_cv_prog_compiler_c_o" >&6; } - - - - - - - { $as_echo "$as_me:${as_lineno-$LINENO}: checking if $compiler supports -c -o file.$ac_objext" >&5 -$as_echo_n "checking if $compiler supports -c -o file.$ac_objext... " >&6; } -if ${lt_cv_prog_compiler_c_o+:} false; then : - $as_echo_n "(cached) " >&6 -else - lt_cv_prog_compiler_c_o=no - $RM -r conftest 2>/dev/null - mkdir conftest - cd conftest - mkdir out - echo "$lt_simple_compile_test_code" > conftest.$ac_ext - - lt_compiler_flag="-o out/conftest2.$ac_objext" - # Insert the option either (1) after the last *FLAGS variable, or - # (2) before a word containing "conftest.", or (3) at the end. - # Note that $ac_compile itself does not contain backslashes and begins - # with a dollar sign (not a hyphen), so the echo should work correctly. - lt_compile=`echo "$ac_compile" | $SED \ - -e 's:.*FLAGS}\{0,1\} :&$lt_compiler_flag :; t' \ - -e 's: [^ ]*conftest\.: $lt_compiler_flag&:; t' \ - -e 's:$: $lt_compiler_flag:'` - (eval echo "\"\$as_me:$LINENO: $lt_compile\"" >&5) - (eval "$lt_compile" 2>out/conftest.err) - ac_status=$? - cat out/conftest.err >&5 - echo "$as_me:$LINENO: \$? = $ac_status" >&5 - if (exit $ac_status) && test -s out/conftest2.$ac_objext - then - # The compiler can only warn and ignore the option if not recognized - # So say no if there are warnings - $ECHO "$_lt_compiler_boilerplate" | $SED '/^$/d' > out/conftest.exp - $SED '/^$/d; /^ *+/d' out/conftest.err >out/conftest.er2 - if test ! -s out/conftest.er2 || diff out/conftest.exp out/conftest.er2 >/dev/null; then - lt_cv_prog_compiler_c_o=yes - fi - fi - chmod u+w . 2>&5 - $RM conftest* - # SGI C++ compiler will create directory out/ii_files/ for - # template instantiation - test -d out/ii_files && $RM out/ii_files/* && rmdir out/ii_files - $RM out/* && rmdir out - cd .. - $RM -r conftest - $RM conftest* - -fi -{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $lt_cv_prog_compiler_c_o" >&5 -$as_echo "$lt_cv_prog_compiler_c_o" >&6; } - - - - -hard_links=nottested -if test no = "$lt_cv_prog_compiler_c_o" && test no != "$need_locks"; then - # do not overwrite the value of need_locks provided by the user - { $as_echo "$as_me:${as_lineno-$LINENO}: checking if we can lock with hard links" >&5 -$as_echo_n "checking if we can lock with hard links... " >&6; } - hard_links=yes - $RM conftest* - ln conftest.a conftest.b 2>/dev/null && hard_links=no - touch conftest.a - ln conftest.a conftest.b 2>&5 || hard_links=no - ln conftest.a conftest.b 2>/dev/null && hard_links=no - { $as_echo "$as_me:${as_lineno-$LINENO}: result: $hard_links" >&5 -$as_echo "$hard_links" >&6; } - if test no = "$hard_links"; then - { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: '$CC' does not support '-c -o', so 'make -j' may be unsafe" >&5 -$as_echo "$as_me: WARNING: '$CC' does not support '-c -o', so 'make -j' may be unsafe" >&2;} - need_locks=warn - fi -else - need_locks=no -fi - - - - - - - { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether the $compiler linker ($LD) supports shared libraries" >&5 -$as_echo_n "checking whether the $compiler linker ($LD) supports shared libraries... " >&6; } - - runpath_var= - allow_undefined_flag= - always_export_symbols=no - archive_cmds= - archive_expsym_cmds= - compiler_needs_object=no - enable_shared_with_static_runtimes=no - export_dynamic_flag_spec= - export_symbols_cmds='$NM $libobjs $convenience | $global_symbol_pipe | $SED '\''s/.* //'\'' | sort | uniq > $export_symbols' - hardcode_automatic=no - hardcode_direct=no - hardcode_direct_absolute=no - hardcode_libdir_flag_spec= - hardcode_libdir_separator= - hardcode_minus_L=no - hardcode_shlibpath_var=unsupported - inherit_rpath=no - link_all_deplibs=unknown - module_cmds= - module_expsym_cmds= - old_archive_from_new_cmds= - old_archive_from_expsyms_cmds= - thread_safe_flag_spec= - whole_archive_flag_spec= - # include_expsyms should be a list of space-separated symbols to be *always* - # included in the symbol list - include_expsyms= - # exclude_expsyms can be an extended regexp of symbols to exclude - # it will be wrapped by ' (' and ')$', so one must not match beginning or - # end of line. Example: 'a|bc|.*d.*' will exclude the symbols 'a' and 'bc', - # as well as any symbol that contains 'd'. - exclude_expsyms='_GLOBAL_OFFSET_TABLE_|_GLOBAL__F[ID]_.*' - # Although _GLOBAL_OFFSET_TABLE_ is a valid symbol C name, most a.out - # platforms (ab)use it in PIC code, but their linkers get confused if - # the symbol is explicitly referenced. Since portable code cannot - # rely on this symbol name, it's probably fine to never include it in - # preloaded symbol tables. - # Exclude shared library initialization/finalization symbols. - extract_expsyms_cmds= - - case $host_os in - cygwin* | mingw* | pw32* | cegcc*) - # FIXME: the MSVC++ port hasn't been tested in a loooong time - # When not using gcc, we currently assume that we are using - # Microsoft Visual C++. - if test yes != "$GCC"; then - with_gnu_ld=no - fi - ;; - interix*) - # we just hope/assume this is gcc and not c89 (= MSVC++) - with_gnu_ld=yes - ;; - openbsd* | bitrig*) - with_gnu_ld=no - ;; - esac - - ld_shlibs=yes - - # On some targets, GNU ld is compatible enough with the native linker - # that we're better off using the native interface for both. - lt_use_gnu_ld_interface=no - if test yes = "$with_gnu_ld"; then - case $host_os in - aix*) - # The AIX port of GNU ld has always aspired to compatibility - # with the native linker. However, as the warning in the GNU ld - # block says, versions before 2.19.5* couldn't really create working - # shared libraries, regardless of the interface used. - case `$LD -v 2>&1` in - *\ \(GNU\ Binutils\)\ 2.19.5*) ;; - *\ \(GNU\ Binutils\)\ 2.[2-9]*) ;; - *\ \(GNU\ Binutils\)\ [3-9]*) ;; - *) - lt_use_gnu_ld_interface=yes - ;; - esac - ;; - *) - lt_use_gnu_ld_interface=yes - ;; - esac - fi - - if test yes = "$lt_use_gnu_ld_interface"; then - # If archive_cmds runs LD, not CC, wlarc should be empty - wlarc='$wl' - - # Set some defaults for GNU ld with shared library support. These - # are reset later if shared libraries are not supported. Putting them - # here allows them to be overridden if necessary. - runpath_var=LD_RUN_PATH - hardcode_libdir_flag_spec='$wl-rpath $wl$libdir' - export_dynamic_flag_spec='$wl--export-dynamic' - # ancient GNU ld didn't support --whole-archive et. al. - if $LD --help 2>&1 | $GREP 'no-whole-archive' > /dev/null; then - whole_archive_flag_spec=$wlarc'--whole-archive$convenience '$wlarc'--no-whole-archive' - else - whole_archive_flag_spec= - fi - supports_anon_versioning=no - case `$LD -v | $SED -e 's/(^)\+)\s\+//' 2>&1` in - *GNU\ gold*) supports_anon_versioning=yes ;; - *\ [01].* | *\ 2.[0-9].* | *\ 2.10.*) ;; # catch versions < 2.11 - *\ 2.11.93.0.2\ *) supports_anon_versioning=yes ;; # RH7.3 ... - *\ 2.11.92.0.12\ *) supports_anon_versioning=yes ;; # Mandrake 8.2 ... - *\ 2.11.*) ;; # other 2.11 versions - *) supports_anon_versioning=yes ;; - esac - - # See if GNU ld supports shared libraries. - case $host_os in - aix[3-9]*) - # On AIX/PPC, the GNU linker is very broken - if test ia64 != "$host_cpu"; then - ld_shlibs=no - cat <<_LT_EOF 1>&2 - -*** Warning: the GNU linker, at least up to release 2.19, is reported -*** to be unable to reliably create shared libraries on AIX. -*** Therefore, libtool is disabling shared libraries support. If you -*** really care for shared libraries, you may want to install binutils -*** 2.20 or above, or modify your PATH so that a non-GNU linker is found. -*** You will then need to restart the configuration process. - -_LT_EOF - fi - ;; - - amigaos*) - case $host_cpu in - powerpc) - # see comment about AmigaOS4 .so support - archive_cmds='$CC -shared $libobjs $deplibs $compiler_flags $wl-soname $wl$soname -o $lib' - archive_expsym_cmds='' - ;; - m68k) - archive_cmds='$RM $output_objdir/a2ixlibrary.data~$ECHO "#define NAME $libname" > $output_objdir/a2ixlibrary.data~$ECHO "#define LIBRARY_ID 1" >> $output_objdir/a2ixlibrary.data~$ECHO "#define VERSION $major" >> $output_objdir/a2ixlibrary.data~$ECHO "#define REVISION $revision" >> $output_objdir/a2ixlibrary.data~$AR $AR_FLAGS $lib $libobjs~$RANLIB $lib~(cd $output_objdir && a2ixlibrary -32)' - hardcode_libdir_flag_spec='-L$libdir' - hardcode_minus_L=yes - ;; - esac - ;; - - beos*) - if $LD --help 2>&1 | $GREP ': supported targets:.* elf' > /dev/null; then - allow_undefined_flag=unsupported - # Joseph Beckenbach says some releases of gcc - # support --undefined. This deserves some investigation. FIXME - archive_cmds='$CC -nostart $libobjs $deplibs $compiler_flags $wl-soname $wl$soname -o $lib' - else - ld_shlibs=no - fi - ;; - - cygwin* | mingw* | pw32* | cegcc*) - # _LT_TAGVAR(hardcode_libdir_flag_spec, ) is actually meaningless, - # as there is no search path for DLLs. - hardcode_libdir_flag_spec='-L$libdir' - export_dynamic_flag_spec='$wl--export-all-symbols' - allow_undefined_flag=unsupported - always_export_symbols=no - enable_shared_with_static_runtimes=yes - export_symbols_cmds='$NM $libobjs $convenience | $global_symbol_pipe | $SED -e '\''/^[BCDGRS][ ]/s/.*[ ]\([^ ]*\)/\1 DATA/;s/^.*[ ]__nm__\([^ ]*\)[ ][^ ]*/\1 DATA/;/^I[ ]/d;/^[AITW][ ]/s/.* //'\'' | sort | uniq > $export_symbols' - exclude_expsyms='[_]+GLOBAL_OFFSET_TABLE_|[_]+GLOBAL__[FID]_.*|[_]+head_[A-Za-z0-9_]+_dll|[A-Za-z0-9_]+_dll_iname' - - if $LD --help 2>&1 | $GREP 'auto-import' > /dev/null; then - archive_cmds='$CC -shared $libobjs $deplibs $compiler_flags -o $output_objdir/$soname $wl--enable-auto-image-base -Xlinker --out-implib -Xlinker $lib' - # If the export-symbols file already is a .def file, use it as - # is; otherwise, prepend EXPORTS... - archive_expsym_cmds='if test DEF = "`$SED -n -e '\''s/^[ ]*//'\'' -e '\''/^\(;.*\)*$/d'\'' -e '\''s/^\(EXPORTS\|LIBRARY\)\([ ].*\)*$/DEF/p'\'' -e q $export_symbols`" ; then - cp $export_symbols $output_objdir/$soname.def; - else - echo EXPORTS > $output_objdir/$soname.def; - cat $export_symbols >> $output_objdir/$soname.def; - fi~ - $CC -shared $output_objdir/$soname.def $libobjs $deplibs $compiler_flags -o $output_objdir/$soname $wl--enable-auto-image-base -Xlinker --out-implib -Xlinker $lib' - else - ld_shlibs=no - fi - ;; - - haiku*) - archive_cmds='$CC -shared $libobjs $deplibs $compiler_flags $wl-soname $wl$soname -o $lib' - link_all_deplibs=yes - ;; - - os2*) - hardcode_libdir_flag_spec='-L$libdir' - hardcode_minus_L=yes - allow_undefined_flag=unsupported - shrext_cmds=.dll - archive_cmds='$ECHO "LIBRARY ${soname%$shared_ext} INITINSTANCE TERMINSTANCE" > $output_objdir/$libname.def~ - $ECHO "DESCRIPTION \"$libname\"" >> $output_objdir/$libname.def~ - $ECHO "DATA MULTIPLE NONSHARED" >> $output_objdir/$libname.def~ - $ECHO EXPORTS >> $output_objdir/$libname.def~ - emxexp $libobjs | $SED /"_DLL_InitTerm"/d >> $output_objdir/$libname.def~ - $CC -Zdll -Zcrtdll -o $output_objdir/$soname $libobjs $deplibs $compiler_flags $output_objdir/$libname.def~ - emximp -o $lib $output_objdir/$libname.def' - archive_expsym_cmds='$ECHO "LIBRARY ${soname%$shared_ext} INITINSTANCE TERMINSTANCE" > $output_objdir/$libname.def~ - $ECHO "DESCRIPTION \"$libname\"" >> $output_objdir/$libname.def~ - $ECHO "DATA MULTIPLE NONSHARED" >> $output_objdir/$libname.def~ - $ECHO EXPORTS >> $output_objdir/$libname.def~ - prefix_cmds="$SED"~ - if test EXPORTS = "`$SED 1q $export_symbols`"; then - prefix_cmds="$prefix_cmds -e 1d"; - fi~ - prefix_cmds="$prefix_cmds -e \"s/^\(.*\)$/_\1/g\""~ - cat $export_symbols | $prefix_cmds >> $output_objdir/$libname.def~ - $CC -Zdll -Zcrtdll -o $output_objdir/$soname $libobjs $deplibs $compiler_flags $output_objdir/$libname.def~ - emximp -o $lib $output_objdir/$libname.def' - old_archive_From_new_cmds='emximp -o $output_objdir/${libname}_dll.a $output_objdir/$libname.def' - enable_shared_with_static_runtimes=yes - ;; - - interix[3-9]*) - hardcode_direct=no - hardcode_shlibpath_var=no - hardcode_libdir_flag_spec='$wl-rpath,$libdir' - export_dynamic_flag_spec='$wl-E' - # Hack: On Interix 3.x, we cannot compile PIC because of a broken gcc. - # Instead, shared libraries are loaded at an image base (0x10000000 by - # default) and relocated if they conflict, which is a slow very memory - # consuming and fragmenting process. To avoid this, we pick a random, - # 256 KiB-aligned image base between 0x50000000 and 0x6FFC0000 at link - # time. Moving up from 0x10000000 also allows more sbrk(2) space. - archive_cmds='$CC -shared $pic_flag $libobjs $deplibs $compiler_flags $wl-h,$soname $wl--image-base,`expr ${RANDOM-$$} % 4096 / 2 \* 262144 + 1342177280` -o $lib' - archive_expsym_cmds='sed "s|^|_|" $export_symbols >$output_objdir/$soname.expsym~$CC -shared $pic_flag $libobjs $deplibs $compiler_flags $wl-h,$soname $wl--retain-symbols-file,$output_objdir/$soname.expsym $wl--image-base,`expr ${RANDOM-$$} % 4096 / 2 \* 262144 + 1342177280` -o $lib' - ;; - - gnu* | linux* | tpf* | k*bsd*-gnu | kopensolaris*-gnu) - tmp_diet=no - if test linux-dietlibc = "$host_os"; then - case $cc_basename in - diet\ *) tmp_diet=yes;; # linux-dietlibc with static linking (!diet-dyn) - esac - fi - if $LD --help 2>&1 | $EGREP ': supported targets:.* elf' > /dev/null \ - && test no = "$tmp_diet" - then - tmp_addflag=' $pic_flag' - tmp_sharedflag='-shared' - case $cc_basename,$host_cpu in - pgcc*) # Portland Group C compiler - whole_archive_flag_spec='$wl--whole-archive`for conv in $convenience\"\"; do test -n \"$conv\" && new_convenience=\"$new_convenience,$conv\"; done; func_echo_all \"$new_convenience\"` $wl--no-whole-archive' - tmp_addflag=' $pic_flag' - ;; - pgf77* | pgf90* | pgf95* | pgfortran*) - # Portland Group f77 and f90 compilers - whole_archive_flag_spec='$wl--whole-archive`for conv in $convenience\"\"; do test -n \"$conv\" && new_convenience=\"$new_convenience,$conv\"; done; func_echo_all \"$new_convenience\"` $wl--no-whole-archive' - tmp_addflag=' $pic_flag -Mnomain' ;; - ecc*,ia64* | icc*,ia64*) # Intel C compiler on ia64 - tmp_addflag=' -i_dynamic' ;; - efc*,ia64* | ifort*,ia64*) # Intel Fortran compiler on ia64 - tmp_addflag=' -i_dynamic -nofor_main' ;; - ifc* | ifort*) # Intel Fortran compiler - tmp_addflag=' -nofor_main' ;; - lf95*) # Lahey Fortran 8.1 - whole_archive_flag_spec= - tmp_sharedflag='--shared' ;; - nagfor*) # NAGFOR 5.3 - tmp_sharedflag='-Wl,-shared' ;; - xl[cC]* | bgxl[cC]* | mpixl[cC]*) # IBM XL C 8.0 on PPC (deal with xlf below) - tmp_sharedflag='-qmkshrobj' - tmp_addflag= ;; - nvcc*) # Cuda Compiler Driver 2.2 - whole_archive_flag_spec='$wl--whole-archive`for conv in $convenience\"\"; do test -n \"$conv\" && new_convenience=\"$new_convenience,$conv\"; done; func_echo_all \"$new_convenience\"` $wl--no-whole-archive' - compiler_needs_object=yes - ;; - esac - case `$CC -V 2>&1 | sed 5q` in - *Sun\ C*) # Sun C 5.9 - whole_archive_flag_spec='$wl--whole-archive`new_convenience=; for conv in $convenience\"\"; do test -z \"$conv\" || new_convenience=\"$new_convenience,$conv\"; done; func_echo_all \"$new_convenience\"` $wl--no-whole-archive' - compiler_needs_object=yes - tmp_sharedflag='-G' ;; - *Sun\ F*) # Sun Fortran 8.3 - tmp_sharedflag='-G' ;; - esac - archive_cmds='$CC '"$tmp_sharedflag""$tmp_addflag"' $libobjs $deplibs $compiler_flags $wl-soname $wl$soname -o $lib' - - if test yes = "$supports_anon_versioning"; then - archive_expsym_cmds='echo "{ global:" > $output_objdir/$libname.ver~ - cat $export_symbols | sed -e "s/\(.*\)/\1;/" >> $output_objdir/$libname.ver~ - echo "local: *; };" >> $output_objdir/$libname.ver~ - $CC '"$tmp_sharedflag""$tmp_addflag"' $libobjs $deplibs $compiler_flags $wl-soname $wl$soname $wl-version-script $wl$output_objdir/$libname.ver -o $lib' - fi - - case $cc_basename in - tcc*) - export_dynamic_flag_spec='-rdynamic' - ;; - xlf* | bgf* | bgxlf* | mpixlf*) - # IBM XL Fortran 10.1 on PPC cannot create shared libs itself - whole_archive_flag_spec='--whole-archive$convenience --no-whole-archive' - hardcode_libdir_flag_spec='$wl-rpath $wl$libdir' - archive_cmds='$LD -shared $libobjs $deplibs $linker_flags -soname $soname -o $lib' - if test yes = "$supports_anon_versioning"; then - archive_expsym_cmds='echo "{ global:" > $output_objdir/$libname.ver~ - cat $export_symbols | sed -e "s/\(.*\)/\1;/" >> $output_objdir/$libname.ver~ - echo "local: *; };" >> $output_objdir/$libname.ver~ - $LD -shared $libobjs $deplibs $linker_flags -soname $soname -version-script $output_objdir/$libname.ver -o $lib' - fi - ;; - esac - else - ld_shlibs=no - fi - ;; - - netbsd*) - if echo __ELF__ | $CC -E - | $GREP __ELF__ >/dev/null; then - archive_cmds='$LD -Bshareable $libobjs $deplibs $linker_flags -o $lib' - wlarc= - else - archive_cmds='$CC -shared $pic_flag $libobjs $deplibs $compiler_flags $wl-soname $wl$soname -o $lib' - archive_expsym_cmds='$CC -shared $pic_flag $libobjs $deplibs $compiler_flags $wl-soname $wl$soname $wl-retain-symbols-file $wl$export_symbols -o $lib' - fi - ;; - - solaris*) - if $LD -v 2>&1 | $GREP 'BFD 2\.8' > /dev/null; then - ld_shlibs=no - cat <<_LT_EOF 1>&2 - -*** Warning: The releases 2.8.* of the GNU linker cannot reliably -*** create shared libraries on Solaris systems. Therefore, libtool -*** is disabling shared libraries support. We urge you to upgrade GNU -*** binutils to release 2.9.1 or newer. Another option is to modify -*** your PATH or compiler configuration so that the native linker is -*** used, and then restart. - -_LT_EOF - elif $LD --help 2>&1 | $GREP ': supported targets:.* elf' > /dev/null; then - archive_cmds='$CC -shared $pic_flag $libobjs $deplibs $compiler_flags $wl-soname $wl$soname -o $lib' - archive_expsym_cmds='$CC -shared $pic_flag $libobjs $deplibs $compiler_flags $wl-soname $wl$soname $wl-retain-symbols-file $wl$export_symbols -o $lib' - else - ld_shlibs=no - fi - ;; - - sysv5* | sco3.2v5* | sco5v6* | unixware* | OpenUNIX*) - case `$LD -v 2>&1` in - *\ [01].* | *\ 2.[0-9].* | *\ 2.1[0-5].*) - ld_shlibs=no - cat <<_LT_EOF 1>&2 - -*** Warning: Releases of the GNU linker prior to 2.16.91.0.3 cannot -*** reliably create shared libraries on SCO systems. Therefore, libtool -*** is disabling shared libraries support. We urge you to upgrade GNU -*** binutils to release 2.16.91.0.3 or newer. Another option is to modify -*** your PATH or compiler configuration so that the native linker is -*** used, and then restart. - -_LT_EOF - ;; - *) - # For security reasons, it is highly recommended that you always - # use absolute paths for naming shared libraries, and exclude the - # DT_RUNPATH tag from executables and libraries. But doing so - # requires that you compile everything twice, which is a pain. - if $LD --help 2>&1 | $GREP ': supported targets:.* elf' > /dev/null; then - hardcode_libdir_flag_spec='$wl-rpath $wl$libdir' - archive_cmds='$CC -shared $libobjs $deplibs $compiler_flags $wl-soname $wl$soname -o $lib' - archive_expsym_cmds='$CC -shared $libobjs $deplibs $compiler_flags $wl-soname $wl$soname $wl-retain-symbols-file $wl$export_symbols -o $lib' - else - ld_shlibs=no - fi - ;; - esac - ;; - - sunos4*) - archive_cmds='$LD -assert pure-text -Bshareable -o $lib $libobjs $deplibs $linker_flags' - wlarc= - hardcode_direct=yes - hardcode_shlibpath_var=no - ;; - - *) - if $LD --help 2>&1 | $GREP ': supported targets:.* elf' > /dev/null; then - archive_cmds='$CC -shared $pic_flag $libobjs $deplibs $compiler_flags $wl-soname $wl$soname -o $lib' - archive_expsym_cmds='$CC -shared $pic_flag $libobjs $deplibs $compiler_flags $wl-soname $wl$soname $wl-retain-symbols-file $wl$export_symbols -o $lib' - else - ld_shlibs=no - fi - ;; - esac - - if test no = "$ld_shlibs"; then - runpath_var= - hardcode_libdir_flag_spec= - export_dynamic_flag_spec= - whole_archive_flag_spec= - fi - else - # PORTME fill in a description of your system's linker (not GNU ld) - case $host_os in - aix3*) - allow_undefined_flag=unsupported - always_export_symbols=yes - archive_expsym_cmds='$LD -o $output_objdir/$soname $libobjs $deplibs $linker_flags -bE:$export_symbols -T512 -H512 -bM:SRE~$AR $AR_FLAGS $lib $output_objdir/$soname' - # Note: this linker hardcodes the directories in LIBPATH if there - # are no directories specified by -L. - hardcode_minus_L=yes - if test yes = "$GCC" && test -z "$lt_prog_compiler_static"; then - # Neither direct hardcoding nor static linking is supported with a - # broken collect2. - hardcode_direct=unsupported - fi - ;; - - aix[4-9]*) - if test ia64 = "$host_cpu"; then - # On IA64, the linker does run time linking by default, so we don't - # have to do anything special. - aix_use_runtimelinking=no - exp_sym_flag='-Bexport' - no_entry_flag= - else - # If we're using GNU nm, then we don't want the "-C" option. - # -C means demangle to GNU nm, but means don't demangle to AIX nm. - # Without the "-l" option, or with the "-B" option, AIX nm treats - # weak defined symbols like other global defined symbols, whereas - # GNU nm marks them as "W". - # While the 'weak' keyword is ignored in the Export File, we need - # it in the Import File for the 'aix-soname' feature, so we have - # to replace the "-B" option with "-P" for AIX nm. - if $NM -V 2>&1 | $GREP 'GNU' > /dev/null; then - export_symbols_cmds='$NM -Bpg $libobjs $convenience | awk '\''{ if (((\$ 2 == "T") || (\$ 2 == "D") || (\$ 2 == "B") || (\$ 2 == "W")) && (substr(\$ 3,1,1) != ".")) { if (\$ 2 == "W") { print \$ 3 " weak" } else { print \$ 3 } } }'\'' | sort -u > $export_symbols' - else - export_symbols_cmds='`func_echo_all $NM | $SED -e '\''s/B\([^B]*\)$/P\1/'\''` -PCpgl $libobjs $convenience | awk '\''{ if (((\$ 2 == "T") || (\$ 2 == "D") || (\$ 2 == "B") || (\$ 2 == "W") || (\$ 2 == "V") || (\$ 2 == "Z")) && (substr(\$ 1,1,1) != ".")) { if ((\$ 2 == "W") || (\$ 2 == "V") || (\$ 2 == "Z")) { print \$ 1 " weak" } else { print \$ 1 } } }'\'' | sort -u > $export_symbols' - fi - aix_use_runtimelinking=no - - # Test if we are trying to use run time linking or normal - # AIX style linking. If -brtl is somewhere in LDFLAGS, we - # have runtime linking enabled, and use it for executables. - # For shared libraries, we enable/disable runtime linking - # depending on the kind of the shared library created - - # when "with_aix_soname,aix_use_runtimelinking" is: - # "aix,no" lib.a(lib.so.V) shared, rtl:no, for executables - # "aix,yes" lib.so shared, rtl:yes, for executables - # lib.a static archive - # "both,no" lib.so.V(shr.o) shared, rtl:yes - # lib.a(lib.so.V) shared, rtl:no, for executables - # "both,yes" lib.so.V(shr.o) shared, rtl:yes, for executables - # lib.a(lib.so.V) shared, rtl:no - # "svr4,*" lib.so.V(shr.o) shared, rtl:yes, for executables - # lib.a static archive - case $host_os in aix4.[23]|aix4.[23].*|aix[5-9]*) - for ld_flag in $LDFLAGS; do - if (test x-brtl = "x$ld_flag" || test x-Wl,-brtl = "x$ld_flag"); then - aix_use_runtimelinking=yes - break - fi - done - if test svr4,no = "$with_aix_soname,$aix_use_runtimelinking"; then - # With aix-soname=svr4, we create the lib.so.V shared archives only, - # so we don't have lib.a shared libs to link our executables. - # We have to force runtime linking in this case. - aix_use_runtimelinking=yes - LDFLAGS="$LDFLAGS -Wl,-brtl" - fi - ;; - esac - - exp_sym_flag='-bexport' - no_entry_flag='-bnoentry' - fi - - # When large executables or shared objects are built, AIX ld can - # have problems creating the table of contents. If linking a library - # or program results in "error TOC overflow" add -mminimal-toc to - # CXXFLAGS/CFLAGS for g++/gcc. In the cases where that is not - # enough to fix the problem, add -Wl,-bbigtoc to LDFLAGS. - - archive_cmds='' - hardcode_direct=yes - hardcode_direct_absolute=yes - hardcode_libdir_separator=':' - link_all_deplibs=yes - file_list_spec='$wl-f,' - case $with_aix_soname,$aix_use_runtimelinking in - aix,*) ;; # traditional, no import file - svr4,* | *,yes) # use import file - # The Import File defines what to hardcode. - hardcode_direct=no - hardcode_direct_absolute=no - ;; - esac - - if test yes = "$GCC"; then - case $host_os in aix4.[012]|aix4.[012].*) - # We only want to do this on AIX 4.2 and lower, the check - # below for broken collect2 doesn't work under 4.3+ - collect2name=`$CC -print-prog-name=collect2` - if test -f "$collect2name" && - strings "$collect2name" | $GREP resolve_lib_name >/dev/null - then - # We have reworked collect2 - : - else - # We have old collect2 - hardcode_direct=unsupported - # It fails to find uninstalled libraries when the uninstalled - # path is not listed in the libpath. Setting hardcode_minus_L - # to unsupported forces relinking - hardcode_minus_L=yes - hardcode_libdir_flag_spec='-L$libdir' - hardcode_libdir_separator= - fi - ;; - esac - shared_flag='-shared' - if test yes = "$aix_use_runtimelinking"; then - shared_flag="$shared_flag "'$wl-G' - fi - # Need to ensure runtime linking is disabled for the traditional - # shared library, or the linker may eventually find shared libraries - # /with/ Import File - we do not want to mix them. - shared_flag_aix='-shared' - shared_flag_svr4='-shared $wl-G' - else - # not using gcc - if test ia64 = "$host_cpu"; then - # VisualAge C++, Version 5.5 for AIX 5L for IA-64, Beta 3 Release - # chokes on -Wl,-G. The following line is correct: - shared_flag='-G' - else - if test yes = "$aix_use_runtimelinking"; then - shared_flag='$wl-G' - else - shared_flag='$wl-bM:SRE' - fi - shared_flag_aix='$wl-bM:SRE' - shared_flag_svr4='$wl-G' - fi - fi - - export_dynamic_flag_spec='$wl-bexpall' - # It seems that -bexpall does not export symbols beginning with - # underscore (_), so it is better to generate a list of symbols to export. - always_export_symbols=yes - if test aix,yes = "$with_aix_soname,$aix_use_runtimelinking"; then - # Warning - without using the other runtime loading flags (-brtl), - # -berok will link without error, but may produce a broken library. - allow_undefined_flag='-berok' - # Determine the default libpath from the value encoded in an - # empty executable. - if test set = "${lt_cv_aix_libpath+set}"; then - aix_libpath=$lt_cv_aix_libpath -else - if ${lt_cv_aix_libpath_+:} false; then : - $as_echo_n "(cached) " >&6 -else - cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ - -int -main () -{ - - ; - return 0; -} -_ACEOF -if ac_fn_c_try_link "$LINENO"; then : - - lt_aix_libpath_sed=' - /Import File Strings/,/^$/ { - /^0/ { - s/^0 *\([^ ]*\) *$/\1/ - p - } - }' - lt_cv_aix_libpath_=`dump -H conftest$ac_exeext 2>/dev/null | $SED -n -e "$lt_aix_libpath_sed"` - # Check for a 64-bit object if we didn't find anything. - if test -z "$lt_cv_aix_libpath_"; then - lt_cv_aix_libpath_=`dump -HX64 conftest$ac_exeext 2>/dev/null | $SED -n -e "$lt_aix_libpath_sed"` - fi -fi -rm -f core conftest.err conftest.$ac_objext \ - conftest$ac_exeext conftest.$ac_ext - if test -z "$lt_cv_aix_libpath_"; then - lt_cv_aix_libpath_=/usr/lib:/lib - fi - -fi - - aix_libpath=$lt_cv_aix_libpath_ -fi - - hardcode_libdir_flag_spec='$wl-blibpath:$libdir:'"$aix_libpath" - archive_expsym_cmds='$CC -o $output_objdir/$soname $libobjs $deplibs $wl'$no_entry_flag' $compiler_flags `if test -n "$allow_undefined_flag"; then func_echo_all "$wl$allow_undefined_flag"; else :; fi` $wl'$exp_sym_flag:\$export_symbols' '$shared_flag - else - if test ia64 = "$host_cpu"; then - hardcode_libdir_flag_spec='$wl-R $libdir:/usr/lib:/lib' - allow_undefined_flag="-z nodefs" - archive_expsym_cmds="\$CC $shared_flag"' -o $output_objdir/$soname $libobjs $deplibs '"\$wl$no_entry_flag"' $compiler_flags $wl$allow_undefined_flag '"\$wl$exp_sym_flag:\$export_symbols" - else - # Determine the default libpath from the value encoded in an - # empty executable. - if test set = "${lt_cv_aix_libpath+set}"; then - aix_libpath=$lt_cv_aix_libpath -else - if ${lt_cv_aix_libpath_+:} false; then : - $as_echo_n "(cached) " >&6 -else - cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ - -int -main () -{ - - ; - return 0; -} -_ACEOF -if ac_fn_c_try_link "$LINENO"; then : - - lt_aix_libpath_sed=' - /Import File Strings/,/^$/ { - /^0/ { - s/^0 *\([^ ]*\) *$/\1/ - p - } - }' - lt_cv_aix_libpath_=`dump -H conftest$ac_exeext 2>/dev/null | $SED -n -e "$lt_aix_libpath_sed"` - # Check for a 64-bit object if we didn't find anything. - if test -z "$lt_cv_aix_libpath_"; then - lt_cv_aix_libpath_=`dump -HX64 conftest$ac_exeext 2>/dev/null | $SED -n -e "$lt_aix_libpath_sed"` - fi -fi -rm -f core conftest.err conftest.$ac_objext \ - conftest$ac_exeext conftest.$ac_ext - if test -z "$lt_cv_aix_libpath_"; then - lt_cv_aix_libpath_=/usr/lib:/lib - fi - -fi - - aix_libpath=$lt_cv_aix_libpath_ -fi - - hardcode_libdir_flag_spec='$wl-blibpath:$libdir:'"$aix_libpath" - # Warning - without using the other run time loading flags, - # -berok will link without error, but may produce a broken library. - no_undefined_flag=' $wl-bernotok' - allow_undefined_flag=' $wl-berok' - if test yes = "$with_gnu_ld"; then - # We only use this code for GNU lds that support --whole-archive. - whole_archive_flag_spec='$wl--whole-archive$convenience $wl--no-whole-archive' - else - # Exported symbols can be pulled into shared objects from archives - whole_archive_flag_spec='$convenience' - fi - archive_cmds_need_lc=yes - archive_expsym_cmds='$RM -r $output_objdir/$realname.d~$MKDIR $output_objdir/$realname.d' - # -brtl affects multiple linker settings, -berok does not and is overridden later - compiler_flags_filtered='`func_echo_all "$compiler_flags " | $SED -e "s%-brtl\\([, ]\\)%-berok\\1%g"`' - if test svr4 != "$with_aix_soname"; then - # This is similar to how AIX traditionally builds its shared libraries. - archive_expsym_cmds="$archive_expsym_cmds"'~$CC '$shared_flag_aix' -o $output_objdir/$realname.d/$soname $libobjs $deplibs $wl-bnoentry '$compiler_flags_filtered'$wl-bE:$export_symbols$allow_undefined_flag~$AR $AR_FLAGS $output_objdir/$libname$release.a $output_objdir/$realname.d/$soname' - fi - if test aix != "$with_aix_soname"; then - archive_expsym_cmds="$archive_expsym_cmds"'~$CC '$shared_flag_svr4' -o $output_objdir/$realname.d/$shared_archive_member_spec.o $libobjs $deplibs $wl-bnoentry '$compiler_flags_filtered'$wl-bE:$export_symbols$allow_undefined_flag~$STRIP -e $output_objdir/$realname.d/$shared_archive_member_spec.o~( func_echo_all "#! $soname($shared_archive_member_spec.o)"; if test shr_64 = "$shared_archive_member_spec"; then func_echo_all "# 64"; else func_echo_all "# 32"; fi; cat $export_symbols ) > $output_objdir/$realname.d/$shared_archive_member_spec.imp~$AR $AR_FLAGS $output_objdir/$soname $output_objdir/$realname.d/$shared_archive_member_spec.o $output_objdir/$realname.d/$shared_archive_member_spec.imp' - else - # used by -dlpreopen to get the symbols - archive_expsym_cmds="$archive_expsym_cmds"'~$MV $output_objdir/$realname.d/$soname $output_objdir' - fi - archive_expsym_cmds="$archive_expsym_cmds"'~$RM -r $output_objdir/$realname.d' - fi - fi - ;; - - amigaos*) - case $host_cpu in - powerpc) - # see comment about AmigaOS4 .so support - archive_cmds='$CC -shared $libobjs $deplibs $compiler_flags $wl-soname $wl$soname -o $lib' - archive_expsym_cmds='' - ;; - m68k) - archive_cmds='$RM $output_objdir/a2ixlibrary.data~$ECHO "#define NAME $libname" > $output_objdir/a2ixlibrary.data~$ECHO "#define LIBRARY_ID 1" >> $output_objdir/a2ixlibrary.data~$ECHO "#define VERSION $major" >> $output_objdir/a2ixlibrary.data~$ECHO "#define REVISION $revision" >> $output_objdir/a2ixlibrary.data~$AR $AR_FLAGS $lib $libobjs~$RANLIB $lib~(cd $output_objdir && a2ixlibrary -32)' - hardcode_libdir_flag_spec='-L$libdir' - hardcode_minus_L=yes - ;; - esac - ;; - - bsdi[45]*) - export_dynamic_flag_spec=-rdynamic - ;; - - cygwin* | mingw* | pw32* | cegcc*) - # When not using gcc, we currently assume that we are using - # Microsoft Visual C++. - # hardcode_libdir_flag_spec is actually meaningless, as there is - # no search path for DLLs. - case $cc_basename in - cl*) - # Native MSVC - hardcode_libdir_flag_spec=' ' - allow_undefined_flag=unsupported - always_export_symbols=yes - file_list_spec='@' - # Tell ltmain to make .lib files, not .a files. - libext=lib - # Tell ltmain to make .dll files, not .so files. - shrext_cmds=.dll - # FIXME: Setting linknames here is a bad hack. - archive_cmds='$CC -o $output_objdir/$soname $libobjs $compiler_flags $deplibs -Wl,-DLL,-IMPLIB:"$tool_output_objdir$libname.dll.lib"~linknames=' - archive_expsym_cmds='if test DEF = "`$SED -n -e '\''s/^[ ]*//'\'' -e '\''/^\(;.*\)*$/d'\'' -e '\''s/^\(EXPORTS\|LIBRARY\)\([ ].*\)*$/DEF/p'\'' -e q $export_symbols`" ; then - cp "$export_symbols" "$output_objdir/$soname.def"; - echo "$tool_output_objdir$soname.def" > "$output_objdir/$soname.exp"; - else - $SED -e '\''s/^/-link -EXPORT:/'\'' < $export_symbols > $output_objdir/$soname.exp; - fi~ - $CC -o $tool_output_objdir$soname $libobjs $compiler_flags $deplibs "@$tool_output_objdir$soname.exp" -Wl,-DLL,-IMPLIB:"$tool_output_objdir$libname.dll.lib"~ - linknames=' - # The linker will not automatically build a static lib if we build a DLL. - # _LT_TAGVAR(old_archive_from_new_cmds, )='true' - enable_shared_with_static_runtimes=yes - exclude_expsyms='_NULL_IMPORT_DESCRIPTOR|_IMPORT_DESCRIPTOR_.*' - export_symbols_cmds='$NM $libobjs $convenience | $global_symbol_pipe | $SED -e '\''/^[BCDGRS][ ]/s/.*[ ]\([^ ]*\)/\1,DATA/'\'' | $SED -e '\''/^[AITW][ ]/s/.*[ ]//'\'' | sort | uniq > $export_symbols' - # Don't use ranlib - old_postinstall_cmds='chmod 644 $oldlib' - postlink_cmds='lt_outputfile="@OUTPUT@"~ - lt_tool_outputfile="@TOOL_OUTPUT@"~ - case $lt_outputfile in - *.exe|*.EXE) ;; - *) - lt_outputfile=$lt_outputfile.exe - lt_tool_outputfile=$lt_tool_outputfile.exe - ;; - esac~ - if test : != "$MANIFEST_TOOL" && test -f "$lt_outputfile.manifest"; then - $MANIFEST_TOOL -manifest "$lt_tool_outputfile.manifest" -outputresource:"$lt_tool_outputfile" || exit 1; - $RM "$lt_outputfile.manifest"; - fi' - ;; - *) - # Assume MSVC wrapper - hardcode_libdir_flag_spec=' ' - allow_undefined_flag=unsupported - # Tell ltmain to make .lib files, not .a files. - libext=lib - # Tell ltmain to make .dll files, not .so files. - shrext_cmds=.dll - # FIXME: Setting linknames here is a bad hack. - archive_cmds='$CC -o $lib $libobjs $compiler_flags `func_echo_all "$deplibs" | $SED '\''s/ -lc$//'\''` -link -dll~linknames=' - # The linker will automatically build a .lib file if we build a DLL. - old_archive_from_new_cmds='true' - # FIXME: Should let the user specify the lib program. - old_archive_cmds='lib -OUT:$oldlib$oldobjs$old_deplibs' - enable_shared_with_static_runtimes=yes - ;; - esac - ;; - - darwin* | rhapsody*) - - - archive_cmds_need_lc=no - hardcode_direct=no - hardcode_automatic=yes - hardcode_shlibpath_var=unsupported - if test yes = "$lt_cv_ld_force_load"; then - whole_archive_flag_spec='`for conv in $convenience\"\"; do test -n \"$conv\" && new_convenience=\"$new_convenience $wl-force_load,$conv\"; done; func_echo_all \"$new_convenience\"`' - - else - whole_archive_flag_spec='' - fi - link_all_deplibs=yes - allow_undefined_flag=$_lt_dar_allow_undefined - case $cc_basename in - ifort*|nagfor*) _lt_dar_can_shared=yes ;; - *) _lt_dar_can_shared=$GCC ;; - esac - if test yes = "$_lt_dar_can_shared"; then - output_verbose_link_cmd=func_echo_all - archive_cmds="\$CC -dynamiclib \$allow_undefined_flag -o \$lib \$libobjs \$deplibs \$compiler_flags -install_name \$rpath/\$soname \$verstring $_lt_dar_single_mod$_lt_dsymutil" - module_cmds="\$CC \$allow_undefined_flag -o \$lib -bundle \$libobjs \$deplibs \$compiler_flags$_lt_dsymutil" - archive_expsym_cmds="sed 's|^|_|' < \$export_symbols > \$output_objdir/\$libname-symbols.expsym~\$CC -dynamiclib \$allow_undefined_flag -o \$lib \$libobjs \$deplibs \$compiler_flags -install_name \$rpath/\$soname \$verstring $_lt_dar_single_mod$_lt_dar_export_syms$_lt_dsymutil" - module_expsym_cmds="sed -e 's|^|_|' < \$export_symbols > \$output_objdir/\$libname-symbols.expsym~\$CC \$allow_undefined_flag -o \$lib -bundle \$libobjs \$deplibs \$compiler_flags$_lt_dar_export_syms$_lt_dsymutil" - - else - ld_shlibs=no - fi - - ;; - - dgux*) - archive_cmds='$LD -G -h $soname -o $lib $libobjs $deplibs $linker_flags' - hardcode_libdir_flag_spec='-L$libdir' - hardcode_shlibpath_var=no - ;; - - # FreeBSD 2.2.[012] allows us to include c++rt0.o to get C++ constructor - # support. Future versions do this automatically, but an explicit c++rt0.o - # does not break anything, and helps significantly (at the cost of a little - # extra space). - freebsd2.2*) - archive_cmds='$LD -Bshareable -o $lib $libobjs $deplibs $linker_flags /usr/lib/c++rt0.o' - hardcode_libdir_flag_spec='-R$libdir' - hardcode_direct=yes - hardcode_shlibpath_var=no - ;; - - # Unfortunately, older versions of FreeBSD 2 do not have this feature. - freebsd2.*) - archive_cmds='$LD -Bshareable -o $lib $libobjs $deplibs $linker_flags' - hardcode_direct=yes - hardcode_minus_L=yes - hardcode_shlibpath_var=no - ;; - - # FreeBSD 3 and greater uses gcc -shared to do shared libraries. - freebsd* | dragonfly*) - archive_cmds='$CC -shared $pic_flag -o $lib $libobjs $deplibs $compiler_flags' - hardcode_libdir_flag_spec='-R$libdir' - hardcode_direct=yes - hardcode_shlibpath_var=no - ;; - - hpux9*) - if test yes = "$GCC"; then - archive_cmds='$RM $output_objdir/$soname~$CC -shared $pic_flag $wl+b $wl$install_libdir -o $output_objdir/$soname $libobjs $deplibs $compiler_flags~test "x$output_objdir/$soname" = "x$lib" || mv $output_objdir/$soname $lib' - else - archive_cmds='$RM $output_objdir/$soname~$LD -b +b $install_libdir -o $output_objdir/$soname $libobjs $deplibs $linker_flags~test "x$output_objdir/$soname" = "x$lib" || mv $output_objdir/$soname $lib' - fi - hardcode_libdir_flag_spec='$wl+b $wl$libdir' - hardcode_libdir_separator=: - hardcode_direct=yes - - # hardcode_minus_L: Not really in the search PATH, - # but as the default location of the library. - hardcode_minus_L=yes - export_dynamic_flag_spec='$wl-E' - ;; - - hpux10*) - if test yes,no = "$GCC,$with_gnu_ld"; then - archive_cmds='$CC -shared $pic_flag $wl+h $wl$soname $wl+b $wl$install_libdir -o $lib $libobjs $deplibs $compiler_flags' - else - archive_cmds='$LD -b +h $soname +b $install_libdir -o $lib $libobjs $deplibs $linker_flags' - fi - if test no = "$with_gnu_ld"; then - hardcode_libdir_flag_spec='$wl+b $wl$libdir' - hardcode_libdir_separator=: - hardcode_direct=yes - hardcode_direct_absolute=yes - export_dynamic_flag_spec='$wl-E' - # hardcode_minus_L: Not really in the search PATH, - # but as the default location of the library. - hardcode_minus_L=yes - fi - ;; - - hpux11*) - if test yes,no = "$GCC,$with_gnu_ld"; then - case $host_cpu in - hppa*64*) - archive_cmds='$CC -shared $wl+h $wl$soname -o $lib $libobjs $deplibs $compiler_flags' - ;; - ia64*) - archive_cmds='$CC -shared $pic_flag $wl+h $wl$soname $wl+nodefaultrpath -o $lib $libobjs $deplibs $compiler_flags' - ;; - *) - archive_cmds='$CC -shared $pic_flag $wl+h $wl$soname $wl+b $wl$install_libdir -o $lib $libobjs $deplibs $compiler_flags' - ;; - esac - else - case $host_cpu in - hppa*64*) - archive_cmds='$CC -b $wl+h $wl$soname -o $lib $libobjs $deplibs $compiler_flags' - ;; - ia64*) - archive_cmds='$CC -b $wl+h $wl$soname $wl+nodefaultrpath -o $lib $libobjs $deplibs $compiler_flags' - ;; - *) - - # Older versions of the 11.00 compiler do not understand -b yet - # (HP92453-01 A.11.01.20 doesn't, HP92453-01 B.11.X.35175-35176.GP does) - { $as_echo "$as_me:${as_lineno-$LINENO}: checking if $CC understands -b" >&5 -$as_echo_n "checking if $CC understands -b... " >&6; } -if ${lt_cv_prog_compiler__b+:} false; then : - $as_echo_n "(cached) " >&6 -else - lt_cv_prog_compiler__b=no - save_LDFLAGS=$LDFLAGS - LDFLAGS="$LDFLAGS -b" - echo "$lt_simple_link_test_code" > conftest.$ac_ext - if (eval $ac_link 2>conftest.err) && test -s conftest$ac_exeext; then - # The linker can only warn and ignore the option if not recognized - # So say no if there are warnings - if test -s conftest.err; then - # Append any errors to the config.log. - cat conftest.err 1>&5 - $ECHO "$_lt_linker_boilerplate" | $SED '/^$/d' > conftest.exp - $SED '/^$/d; /^ *+/d' conftest.err >conftest.er2 - if diff conftest.exp conftest.er2 >/dev/null; then - lt_cv_prog_compiler__b=yes - fi - else - lt_cv_prog_compiler__b=yes - fi - fi - $RM -r conftest* - LDFLAGS=$save_LDFLAGS - -fi -{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $lt_cv_prog_compiler__b" >&5 -$as_echo "$lt_cv_prog_compiler__b" >&6; } - -if test yes = "$lt_cv_prog_compiler__b"; then - archive_cmds='$CC -b $wl+h $wl$soname $wl+b $wl$install_libdir -o $lib $libobjs $deplibs $compiler_flags' -else - archive_cmds='$LD -b +h $soname +b $install_libdir -o $lib $libobjs $deplibs $linker_flags' -fi - - ;; - esac - fi - if test no = "$with_gnu_ld"; then - hardcode_libdir_flag_spec='$wl+b $wl$libdir' - hardcode_libdir_separator=: - - case $host_cpu in - hppa*64*|ia64*) - hardcode_direct=no - hardcode_shlibpath_var=no - ;; - *) - hardcode_direct=yes - hardcode_direct_absolute=yes - export_dynamic_flag_spec='$wl-E' - - # hardcode_minus_L: Not really in the search PATH, - # but as the default location of the library. - hardcode_minus_L=yes - ;; - esac - fi - ;; - - irix5* | irix6* | nonstopux*) - if test yes = "$GCC"; then - archive_cmds='$CC -shared $pic_flag $libobjs $deplibs $compiler_flags $wl-soname $wl$soname `test -n "$verstring" && func_echo_all "$wl-set_version $wl$verstring"` $wl-update_registry $wl$output_objdir/so_locations -o $lib' - # Try to use the -exported_symbol ld option, if it does not - # work, assume that -exports_file does not work either and - # implicitly export all symbols. - # This should be the same for all languages, so no per-tag cache variable. - { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether the $host_os linker accepts -exported_symbol" >&5 -$as_echo_n "checking whether the $host_os linker accepts -exported_symbol... " >&6; } -if ${lt_cv_irix_exported_symbol+:} false; then : - $as_echo_n "(cached) " >&6 -else - save_LDFLAGS=$LDFLAGS - LDFLAGS="$LDFLAGS -shared $wl-exported_symbol ${wl}foo $wl-update_registry $wl/dev/null" - cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ -int foo (void) { return 0; } -_ACEOF -if ac_fn_c_try_link "$LINENO"; then : - lt_cv_irix_exported_symbol=yes -else - lt_cv_irix_exported_symbol=no -fi -rm -f core conftest.err conftest.$ac_objext \ - conftest$ac_exeext conftest.$ac_ext - LDFLAGS=$save_LDFLAGS -fi -{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $lt_cv_irix_exported_symbol" >&5 -$as_echo "$lt_cv_irix_exported_symbol" >&6; } - if test yes = "$lt_cv_irix_exported_symbol"; then - archive_expsym_cmds='$CC -shared $pic_flag $libobjs $deplibs $compiler_flags $wl-soname $wl$soname `test -n "$verstring" && func_echo_all "$wl-set_version $wl$verstring"` $wl-update_registry $wl$output_objdir/so_locations $wl-exports_file $wl$export_symbols -o $lib' - fi - else - archive_cmds='$CC -shared $libobjs $deplibs $compiler_flags -soname $soname `test -n "$verstring" && func_echo_all "-set_version $verstring"` -update_registry $output_objdir/so_locations -o $lib' - archive_expsym_cmds='$CC -shared $libobjs $deplibs $compiler_flags -soname $soname `test -n "$verstring" && func_echo_all "-set_version $verstring"` -update_registry $output_objdir/so_locations -exports_file $export_symbols -o $lib' - fi - archive_cmds_need_lc='no' - hardcode_libdir_flag_spec='$wl-rpath $wl$libdir' - hardcode_libdir_separator=: - inherit_rpath=yes - link_all_deplibs=yes - ;; - - linux*) - case $cc_basename in - tcc*) - # Fabrice Bellard et al's Tiny C Compiler - ld_shlibs=yes - archive_cmds='$CC -shared $pic_flag -o $lib $libobjs $deplibs $compiler_flags' - ;; - esac - ;; - - netbsd*) - if echo __ELF__ | $CC -E - | $GREP __ELF__ >/dev/null; then - archive_cmds='$LD -Bshareable -o $lib $libobjs $deplibs $linker_flags' # a.out - else - archive_cmds='$LD -shared -o $lib $libobjs $deplibs $linker_flags' # ELF - fi - hardcode_libdir_flag_spec='-R$libdir' - hardcode_direct=yes - hardcode_shlibpath_var=no - ;; - - newsos6) - archive_cmds='$LD -G -h $soname -o $lib $libobjs $deplibs $linker_flags' - hardcode_direct=yes - hardcode_libdir_flag_spec='$wl-rpath $wl$libdir' - hardcode_libdir_separator=: - hardcode_shlibpath_var=no - ;; - - *nto* | *qnx*) - ;; - - openbsd* | bitrig*) - if test -f /usr/libexec/ld.so; then - hardcode_direct=yes - hardcode_shlibpath_var=no - hardcode_direct_absolute=yes - if test -z "`echo __ELF__ | $CC -E - | $GREP __ELF__`"; then - archive_cmds='$CC -shared $pic_flag -o $lib $libobjs $deplibs $compiler_flags' - archive_expsym_cmds='$CC -shared $pic_flag -o $lib $libobjs $deplibs $compiler_flags $wl-retain-symbols-file,$export_symbols' - hardcode_libdir_flag_spec='$wl-rpath,$libdir' - export_dynamic_flag_spec='$wl-E' - else - archive_cmds='$CC -shared $pic_flag -o $lib $libobjs $deplibs $compiler_flags' - hardcode_libdir_flag_spec='$wl-rpath,$libdir' - fi - else - ld_shlibs=no - fi - ;; - - os2*) - hardcode_libdir_flag_spec='-L$libdir' - hardcode_minus_L=yes - allow_undefined_flag=unsupported - shrext_cmds=.dll - archive_cmds='$ECHO "LIBRARY ${soname%$shared_ext} INITINSTANCE TERMINSTANCE" > $output_objdir/$libname.def~ - $ECHO "DESCRIPTION \"$libname\"" >> $output_objdir/$libname.def~ - $ECHO "DATA MULTIPLE NONSHARED" >> $output_objdir/$libname.def~ - $ECHO EXPORTS >> $output_objdir/$libname.def~ - emxexp $libobjs | $SED /"_DLL_InitTerm"/d >> $output_objdir/$libname.def~ - $CC -Zdll -Zcrtdll -o $output_objdir/$soname $libobjs $deplibs $compiler_flags $output_objdir/$libname.def~ - emximp -o $lib $output_objdir/$libname.def' - archive_expsym_cmds='$ECHO "LIBRARY ${soname%$shared_ext} INITINSTANCE TERMINSTANCE" > $output_objdir/$libname.def~ - $ECHO "DESCRIPTION \"$libname\"" >> $output_objdir/$libname.def~ - $ECHO "DATA MULTIPLE NONSHARED" >> $output_objdir/$libname.def~ - $ECHO EXPORTS >> $output_objdir/$libname.def~ - prefix_cmds="$SED"~ - if test EXPORTS = "`$SED 1q $export_symbols`"; then - prefix_cmds="$prefix_cmds -e 1d"; - fi~ - prefix_cmds="$prefix_cmds -e \"s/^\(.*\)$/_\1/g\""~ - cat $export_symbols | $prefix_cmds >> $output_objdir/$libname.def~ - $CC -Zdll -Zcrtdll -o $output_objdir/$soname $libobjs $deplibs $compiler_flags $output_objdir/$libname.def~ - emximp -o $lib $output_objdir/$libname.def' - old_archive_From_new_cmds='emximp -o $output_objdir/${libname}_dll.a $output_objdir/$libname.def' - enable_shared_with_static_runtimes=yes - ;; - - osf3*) - if test yes = "$GCC"; then - allow_undefined_flag=' $wl-expect_unresolved $wl\*' - archive_cmds='$CC -shared$allow_undefined_flag $libobjs $deplibs $compiler_flags $wl-soname $wl$soname `test -n "$verstring" && func_echo_all "$wl-set_version $wl$verstring"` $wl-update_registry $wl$output_objdir/so_locations -o $lib' - else - allow_undefined_flag=' -expect_unresolved \*' - archive_cmds='$CC -shared$allow_undefined_flag $libobjs $deplibs $compiler_flags -soname $soname `test -n "$verstring" && func_echo_all "-set_version $verstring"` -update_registry $output_objdir/so_locations -o $lib' - fi - archive_cmds_need_lc='no' - hardcode_libdir_flag_spec='$wl-rpath $wl$libdir' - hardcode_libdir_separator=: - ;; - - osf4* | osf5*) # as osf3* with the addition of -msym flag - if test yes = "$GCC"; then - allow_undefined_flag=' $wl-expect_unresolved $wl\*' - archive_cmds='$CC -shared$allow_undefined_flag $pic_flag $libobjs $deplibs $compiler_flags $wl-msym $wl-soname $wl$soname `test -n "$verstring" && func_echo_all "$wl-set_version $wl$verstring"` $wl-update_registry $wl$output_objdir/so_locations -o $lib' - hardcode_libdir_flag_spec='$wl-rpath $wl$libdir' - else - allow_undefined_flag=' -expect_unresolved \*' - archive_cmds='$CC -shared$allow_undefined_flag $libobjs $deplibs $compiler_flags -msym -soname $soname `test -n "$verstring" && func_echo_all "-set_version $verstring"` -update_registry $output_objdir/so_locations -o $lib' - archive_expsym_cmds='for i in `cat $export_symbols`; do printf "%s %s\\n" -exported_symbol "\$i" >> $lib.exp; done; printf "%s\\n" "-hidden">> $lib.exp~ - $CC -shared$allow_undefined_flag $wl-input $wl$lib.exp $compiler_flags $libobjs $deplibs -soname $soname `test -n "$verstring" && $ECHO "-set_version $verstring"` -update_registry $output_objdir/so_locations -o $lib~$RM $lib.exp' - - # Both c and cxx compiler support -rpath directly - hardcode_libdir_flag_spec='-rpath $libdir' - fi - archive_cmds_need_lc='no' - hardcode_libdir_separator=: - ;; - - solaris*) - no_undefined_flag=' -z defs' - if test yes = "$GCC"; then - wlarc='$wl' - archive_cmds='$CC -shared $pic_flag $wl-z ${wl}text $wl-h $wl$soname -o $lib $libobjs $deplibs $compiler_flags' - archive_expsym_cmds='echo "{ global:" > $lib.exp~cat $export_symbols | $SED -e "s/\(.*\)/\1;/" >> $lib.exp~echo "local: *; };" >> $lib.exp~ - $CC -shared $pic_flag $wl-z ${wl}text $wl-M $wl$lib.exp $wl-h $wl$soname -o $lib $libobjs $deplibs $compiler_flags~$RM $lib.exp' - else - case `$CC -V 2>&1` in - *"Compilers 5.0"*) - wlarc='' - archive_cmds='$LD -G$allow_undefined_flag -h $soname -o $lib $libobjs $deplibs $linker_flags' - archive_expsym_cmds='echo "{ global:" > $lib.exp~cat $export_symbols | $SED -e "s/\(.*\)/\1;/" >> $lib.exp~echo "local: *; };" >> $lib.exp~ - $LD -G$allow_undefined_flag -M $lib.exp -h $soname -o $lib $libobjs $deplibs $linker_flags~$RM $lib.exp' - ;; - *) - wlarc='$wl' - archive_cmds='$CC -G$allow_undefined_flag -h $soname -o $lib $libobjs $deplibs $compiler_flags' - archive_expsym_cmds='echo "{ global:" > $lib.exp~cat $export_symbols | $SED -e "s/\(.*\)/\1;/" >> $lib.exp~echo "local: *; };" >> $lib.exp~ - $CC -G$allow_undefined_flag -M $lib.exp -h $soname -o $lib $libobjs $deplibs $compiler_flags~$RM $lib.exp' - ;; - esac - fi - hardcode_libdir_flag_spec='-R$libdir' - hardcode_shlibpath_var=no - case $host_os in - solaris2.[0-5] | solaris2.[0-5].*) ;; - *) - # The compiler driver will combine and reorder linker options, - # but understands '-z linker_flag'. GCC discards it without '$wl', - # but is careful enough not to reorder. - # Supported since Solaris 2.6 (maybe 2.5.1?) - if test yes = "$GCC"; then - whole_archive_flag_spec='$wl-z ${wl}allextract$convenience $wl-z ${wl}defaultextract' - else - whole_archive_flag_spec='-z allextract$convenience -z defaultextract' - fi - ;; - esac - link_all_deplibs=yes - ;; - - sunos4*) - if test sequent = "$host_vendor"; then - # Use $CC to link under sequent, because it throws in some extra .o - # files that make .init and .fini sections work. - archive_cmds='$CC -G $wl-h $soname -o $lib $libobjs $deplibs $compiler_flags' - else - archive_cmds='$LD -assert pure-text -Bstatic -o $lib $libobjs $deplibs $linker_flags' - fi - hardcode_libdir_flag_spec='-L$libdir' - hardcode_direct=yes - hardcode_minus_L=yes - hardcode_shlibpath_var=no - ;; - - sysv4) - case $host_vendor in - sni) - archive_cmds='$LD -G -h $soname -o $lib $libobjs $deplibs $linker_flags' - hardcode_direct=yes # is this really true??? - ;; - siemens) - ## LD is ld it makes a PLAMLIB - ## CC just makes a GrossModule. - archive_cmds='$LD -G -o $lib $libobjs $deplibs $linker_flags' - reload_cmds='$CC -r -o $output$reload_objs' - hardcode_direct=no - ;; - motorola) - archive_cmds='$LD -G -h $soname -o $lib $libobjs $deplibs $linker_flags' - hardcode_direct=no #Motorola manual says yes, but my tests say they lie - ;; - esac - runpath_var='LD_RUN_PATH' - hardcode_shlibpath_var=no - ;; - - sysv4.3*) - archive_cmds='$LD -G -h $soname -o $lib $libobjs $deplibs $linker_flags' - hardcode_shlibpath_var=no - export_dynamic_flag_spec='-Bexport' - ;; - - sysv4*MP*) - if test -d /usr/nec; then - archive_cmds='$LD -G -h $soname -o $lib $libobjs $deplibs $linker_flags' - hardcode_shlibpath_var=no - runpath_var=LD_RUN_PATH - hardcode_runpath_var=yes - ld_shlibs=yes - fi - ;; - - sysv4*uw2* | sysv5OpenUNIX* | sysv5UnixWare7.[01].[10]* | unixware7* | sco3.2v5.0.[024]*) - no_undefined_flag='$wl-z,text' - archive_cmds_need_lc=no - hardcode_shlibpath_var=no - runpath_var='LD_RUN_PATH' - - if test yes = "$GCC"; then - archive_cmds='$CC -shared $wl-h,$soname -o $lib $libobjs $deplibs $compiler_flags' - archive_expsym_cmds='$CC -shared $wl-Bexport:$export_symbols $wl-h,$soname -o $lib $libobjs $deplibs $compiler_flags' - else - archive_cmds='$CC -G $wl-h,$soname -o $lib $libobjs $deplibs $compiler_flags' - archive_expsym_cmds='$CC -G $wl-Bexport:$export_symbols $wl-h,$soname -o $lib $libobjs $deplibs $compiler_flags' - fi - ;; - - sysv5* | sco3.2v5* | sco5v6*) - # Note: We CANNOT use -z defs as we might desire, because we do not - # link with -lc, and that would cause any symbols used from libc to - # always be unresolved, which means just about no library would - # ever link correctly. If we're not using GNU ld we use -z text - # though, which does catch some bad symbols but isn't as heavy-handed - # as -z defs. - no_undefined_flag='$wl-z,text' - allow_undefined_flag='$wl-z,nodefs' - archive_cmds_need_lc=no - hardcode_shlibpath_var=no - hardcode_libdir_flag_spec='$wl-R,$libdir' - hardcode_libdir_separator=':' - link_all_deplibs=yes - export_dynamic_flag_spec='$wl-Bexport' - runpath_var='LD_RUN_PATH' - - if test yes = "$GCC"; then - archive_cmds='$CC -shared $wl-h,$soname -o $lib $libobjs $deplibs $compiler_flags' - archive_expsym_cmds='$CC -shared $wl-Bexport:$export_symbols $wl-h,$soname -o $lib $libobjs $deplibs $compiler_flags' - else - archive_cmds='$CC -G $wl-h,$soname -o $lib $libobjs $deplibs $compiler_flags' - archive_expsym_cmds='$CC -G $wl-Bexport:$export_symbols $wl-h,$soname -o $lib $libobjs $deplibs $compiler_flags' - fi - ;; - - uts4*) - archive_cmds='$LD -G -h $soname -o $lib $libobjs $deplibs $linker_flags' - hardcode_libdir_flag_spec='-L$libdir' - hardcode_shlibpath_var=no - ;; - - *) - ld_shlibs=no - ;; - esac - - if test sni = "$host_vendor"; then - case $host in - sysv4 | sysv4.2uw2* | sysv4.3* | sysv5*) - export_dynamic_flag_spec='$wl-Blargedynsym' - ;; - esac - fi - fi - -{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ld_shlibs" >&5 -$as_echo "$ld_shlibs" >&6; } -test no = "$ld_shlibs" && can_build_shared=no - -with_gnu_ld=$with_gnu_ld - - - - - - - - - - - - - - - -# -# Do we need to explicitly link libc? -# -case "x$archive_cmds_need_lc" in -x|xyes) - # Assume -lc should be added - archive_cmds_need_lc=yes - - if test yes,yes = "$GCC,$enable_shared"; then - case $archive_cmds in - *'~'*) - # FIXME: we may have to deal with multi-command sequences. - ;; - '$CC '*) - # Test whether the compiler implicitly links with -lc since on some - # systems, -lgcc has to come before -lc. If gcc already passes -lc - # to ld, don't add -lc before -lgcc. - { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether -lc should be explicitly linked in" >&5 -$as_echo_n "checking whether -lc should be explicitly linked in... " >&6; } -if ${lt_cv_archive_cmds_need_lc+:} false; then : - $as_echo_n "(cached) " >&6 -else - $RM conftest* - echo "$lt_simple_compile_test_code" > conftest.$ac_ext - - if { { eval echo "\"\$as_me\":${as_lineno-$LINENO}: \"$ac_compile\""; } >&5 - (eval $ac_compile) 2>&5 - ac_status=$? - $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 - test $ac_status = 0; } 2>conftest.err; then - soname=conftest - lib=conftest - libobjs=conftest.$ac_objext - deplibs= - wl=$lt_prog_compiler_wl - pic_flag=$lt_prog_compiler_pic - compiler_flags=-v - linker_flags=-v - verstring= - output_objdir=. - libname=conftest - lt_save_allow_undefined_flag=$allow_undefined_flag - allow_undefined_flag= - if { { eval echo "\"\$as_me\":${as_lineno-$LINENO}: \"$archive_cmds 2\>\&1 \| $GREP \" -lc \" \>/dev/null 2\>\&1\""; } >&5 - (eval $archive_cmds 2\>\&1 \| $GREP \" -lc \" \>/dev/null 2\>\&1) 2>&5 - ac_status=$? - $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 - test $ac_status = 0; } - then - lt_cv_archive_cmds_need_lc=no - else - lt_cv_archive_cmds_need_lc=yes - fi - allow_undefined_flag=$lt_save_allow_undefined_flag - else - cat conftest.err 1>&5 - fi - $RM conftest* - -fi -{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $lt_cv_archive_cmds_need_lc" >&5 -$as_echo "$lt_cv_archive_cmds_need_lc" >&6; } - archive_cmds_need_lc=$lt_cv_archive_cmds_need_lc - ;; - esac - fi - ;; -esac - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - { $as_echo "$as_me:${as_lineno-$LINENO}: checking dynamic linker characteristics" >&5 -$as_echo_n "checking dynamic linker characteristics... " >&6; } - -if test yes = "$GCC"; then - case $host_os in - darwin*) lt_awk_arg='/^libraries:/,/LR/' ;; - *) lt_awk_arg='/^libraries:/' ;; - esac - case $host_os in - mingw* | cegcc*) lt_sed_strip_eq='s|=\([A-Za-z]:\)|\1|g' ;; - *) lt_sed_strip_eq='s|=/|/|g' ;; - esac - lt_search_path_spec=`$CC -print-search-dirs | awk $lt_awk_arg | $SED -e "s/^libraries://" -e $lt_sed_strip_eq` - case $lt_search_path_spec in - *\;*) - # if the path contains ";" then we assume it to be the separator - # otherwise default to the standard path separator (i.e. ":") - it is - # assumed that no part of a normal pathname contains ";" but that should - # okay in the real world where ";" in dirpaths is itself problematic. - lt_search_path_spec=`$ECHO "$lt_search_path_spec" | $SED 's/;/ /g'` - ;; - *) - lt_search_path_spec=`$ECHO "$lt_search_path_spec" | $SED "s/$PATH_SEPARATOR/ /g"` - ;; - esac - # Ok, now we have the path, separated by spaces, we can step through it - # and add multilib dir if necessary... - lt_tmp_lt_search_path_spec= - lt_multi_os_dir=/`$CC $CPPFLAGS $CFLAGS $LDFLAGS -print-multi-os-directory 2>/dev/null` - # ...but if some path component already ends with the multilib dir we assume - # that all is fine and trust -print-search-dirs as is (GCC 4.2? or newer). - case "$lt_multi_os_dir; $lt_search_path_spec " in - "/; "* | "/.; "* | "/./; "* | *"$lt_multi_os_dir "* | *"$lt_multi_os_dir/ "*) - lt_multi_os_dir= - ;; - esac - for lt_sys_path in $lt_search_path_spec; do - if test -d "$lt_sys_path$lt_multi_os_dir"; then - lt_tmp_lt_search_path_spec="$lt_tmp_lt_search_path_spec $lt_sys_path$lt_multi_os_dir" - elif test -n "$lt_multi_os_dir"; then - test -d "$lt_sys_path" && \ - lt_tmp_lt_search_path_spec="$lt_tmp_lt_search_path_spec $lt_sys_path" - fi - done - lt_search_path_spec=`$ECHO "$lt_tmp_lt_search_path_spec" | awk ' -BEGIN {RS = " "; FS = "/|\n";} { - lt_foo = ""; - lt_count = 0; - for (lt_i = NF; lt_i > 0; lt_i--) { - if ($lt_i != "" && $lt_i != ".") { - if ($lt_i == "..") { - lt_count++; - } else { - if (lt_count == 0) { - lt_foo = "/" $lt_i lt_foo; - } else { - lt_count--; - } - } - } - } - if (lt_foo != "") { lt_freq[lt_foo]++; } - if (lt_freq[lt_foo] == 1) { print lt_foo; } -}'` - # AWK program above erroneously prepends '/' to C:/dos/paths - # for these hosts. - case $host_os in - mingw* | cegcc*) lt_search_path_spec=`$ECHO "$lt_search_path_spec" |\ - $SED 's|/\([A-Za-z]:\)|\1|g'` ;; - esac - sys_lib_search_path_spec=`$ECHO "$lt_search_path_spec" | $lt_NL2SP` -else - sys_lib_search_path_spec="/lib /usr/lib /usr/local/lib" -fi -library_names_spec= -libname_spec='lib$name' -soname_spec= -shrext_cmds=.so -postinstall_cmds= -postuninstall_cmds= -finish_cmds= -finish_eval= -shlibpath_var= -shlibpath_overrides_runpath=unknown -version_type=none -dynamic_linker="$host_os ld.so" -sys_lib_dlsearch_path_spec="/lib /usr/lib" -need_lib_prefix=unknown -hardcode_into_libs=no - -# when you set need_version to no, make sure it does not cause -set_version -# flags to be left without arguments -need_version=unknown - - - -case $host_os in -aix3*) - version_type=linux # correct to gnu/linux during the next big refactor - library_names_spec='$libname$release$shared_ext$versuffix $libname.a' - shlibpath_var=LIBPATH - - # AIX 3 has no versioning support, so we append a major version to the name. - soname_spec='$libname$release$shared_ext$major' - ;; - -aix[4-9]*) - version_type=linux # correct to gnu/linux during the next big refactor - need_lib_prefix=no - need_version=no - hardcode_into_libs=yes - if test ia64 = "$host_cpu"; then - # AIX 5 supports IA64 - library_names_spec='$libname$release$shared_ext$major $libname$release$shared_ext$versuffix $libname$shared_ext' - shlibpath_var=LD_LIBRARY_PATH - else - # With GCC up to 2.95.x, collect2 would create an import file - # for dependence libraries. The import file would start with - # the line '#! .'. This would cause the generated library to - # depend on '.', always an invalid library. This was fixed in - # development snapshots of GCC prior to 3.0. - case $host_os in - aix4 | aix4.[01] | aix4.[01].*) - if { echo '#if __GNUC__ > 2 || (__GNUC__ == 2 && __GNUC_MINOR__ >= 97)' - echo ' yes ' - echo '#endif'; } | $CC -E - | $GREP yes > /dev/null; then - : - else - can_build_shared=no - fi - ;; - esac - # Using Import Files as archive members, it is possible to support - # filename-based versioning of shared library archives on AIX. While - # this would work for both with and without runtime linking, it will - # prevent static linking of such archives. So we do filename-based - # shared library versioning with .so extension only, which is used - # when both runtime linking and shared linking is enabled. - # Unfortunately, runtime linking may impact performance, so we do - # not want this to be the default eventually. Also, we use the - # versioned .so libs for executables only if there is the -brtl - # linker flag in LDFLAGS as well, or --with-aix-soname=svr4 only. - # To allow for filename-based versioning support, we need to create - # libNAME.so.V as an archive file, containing: - # *) an Import File, referring to the versioned filename of the - # archive as well as the shared archive member, telling the - # bitwidth (32 or 64) of that shared object, and providing the - # list of exported symbols of that shared object, eventually - # decorated with the 'weak' keyword - # *) the shared object with the F_LOADONLY flag set, to really avoid - # it being seen by the linker. - # At run time we better use the real file rather than another symlink, - # but for link time we create the symlink libNAME.so -> libNAME.so.V - - case $with_aix_soname,$aix_use_runtimelinking in - # AIX (on Power*) has no versioning support, so currently we cannot hardcode correct - # soname into executable. Probably we can add versioning support to - # collect2, so additional links can be useful in future. - aix,yes) # traditional libtool - dynamic_linker='AIX unversionable lib.so' - # If using run time linking (on AIX 4.2 or later) use lib.so - # instead of lib.a to let people know that these are not - # typical AIX shared libraries. - library_names_spec='$libname$release$shared_ext$versuffix $libname$release$shared_ext$major $libname$shared_ext' - ;; - aix,no) # traditional AIX only - dynamic_linker='AIX lib.a(lib.so.V)' - # We preserve .a as extension for shared libraries through AIX4.2 - # and later when we are not doing run time linking. - library_names_spec='$libname$release.a $libname.a' - soname_spec='$libname$release$shared_ext$major' - ;; - svr4,*) # full svr4 only - dynamic_linker="AIX lib.so.V($shared_archive_member_spec.o)" - library_names_spec='$libname$release$shared_ext$major $libname$shared_ext' - # We do not specify a path in Import Files, so LIBPATH fires. - shlibpath_overrides_runpath=yes - ;; - *,yes) # both, prefer svr4 - dynamic_linker="AIX lib.so.V($shared_archive_member_spec.o), lib.a(lib.so.V)" - library_names_spec='$libname$release$shared_ext$major $libname$shared_ext' - # unpreferred sharedlib libNAME.a needs extra handling - postinstall_cmds='test -n "$linkname" || linkname="$realname"~func_stripname "" ".so" "$linkname"~$install_shared_prog "$dir/$func_stripname_result.$libext" "$destdir/$func_stripname_result.$libext"~test -z "$tstripme" || test -z "$striplib" || $striplib "$destdir/$func_stripname_result.$libext"' - postuninstall_cmds='for n in $library_names $old_library; do :; done~func_stripname "" ".so" "$n"~test "$func_stripname_result" = "$n" || func_append rmfiles " $odir/$func_stripname_result.$libext"' - # We do not specify a path in Import Files, so LIBPATH fires. - shlibpath_overrides_runpath=yes - ;; - *,no) # both, prefer aix - dynamic_linker="AIX lib.a(lib.so.V), lib.so.V($shared_archive_member_spec.o)" - library_names_spec='$libname$release.a $libname.a' - soname_spec='$libname$release$shared_ext$major' - # unpreferred sharedlib libNAME.so.V and symlink libNAME.so need extra handling - postinstall_cmds='test -z "$dlname" || $install_shared_prog $dir/$dlname $destdir/$dlname~test -z "$tstripme" || test -z "$striplib" || $striplib $destdir/$dlname~test -n "$linkname" || linkname=$realname~func_stripname "" ".a" "$linkname"~(cd "$destdir" && $LN_S -f $dlname $func_stripname_result.so)' - postuninstall_cmds='test -z "$dlname" || func_append rmfiles " $odir/$dlname"~for n in $old_library $library_names; do :; done~func_stripname "" ".a" "$n"~func_append rmfiles " $odir/$func_stripname_result.so"' - ;; - esac - shlibpath_var=LIBPATH - fi - ;; - -amigaos*) - case $host_cpu in - powerpc) - # Since July 2007 AmigaOS4 officially supports .so libraries. - # When compiling the executable, add -use-dynld -Lsobjs: to the compileline. - library_names_spec='$libname$release$shared_ext$versuffix $libname$release$shared_ext$major $libname$shared_ext' - ;; - m68k) - library_names_spec='$libname.ixlibrary $libname.a' - # Create ${libname}_ixlibrary.a entries in /sys/libs. - finish_eval='for lib in `ls $libdir/*.ixlibrary 2>/dev/null`; do libname=`func_echo_all "$lib" | $SED '\''s%^.*/\([^/]*\)\.ixlibrary$%\1%'\''`; $RM /sys/libs/${libname}_ixlibrary.a; $show "cd /sys/libs && $LN_S $lib ${libname}_ixlibrary.a"; cd /sys/libs && $LN_S $lib ${libname}_ixlibrary.a || exit 1; done' - ;; - esac - ;; - -beos*) - library_names_spec='$libname$shared_ext' - dynamic_linker="$host_os ld.so" - shlibpath_var=LIBRARY_PATH - ;; - -bsdi[45]*) - version_type=linux # correct to gnu/linux during the next big refactor - need_version=no - library_names_spec='$libname$release$shared_ext$versuffix $libname$release$shared_ext$major $libname$shared_ext' - soname_spec='$libname$release$shared_ext$major' - finish_cmds='PATH="\$PATH:/sbin" ldconfig $libdir' - shlibpath_var=LD_LIBRARY_PATH - sys_lib_search_path_spec="/shlib /usr/lib /usr/X11/lib /usr/contrib/lib /lib /usr/local/lib" - sys_lib_dlsearch_path_spec="/shlib /usr/lib /usr/local/lib" - # the default ld.so.conf also contains /usr/contrib/lib and - # /usr/X11R6/lib (/usr/X11 is a link to /usr/X11R6), but let us allow - # libtool to hard-code these into programs - ;; - -cygwin* | mingw* | pw32* | cegcc*) - version_type=windows - shrext_cmds=.dll - need_version=no - need_lib_prefix=no - - case $GCC,$cc_basename in - yes,*) - # gcc - library_names_spec='$libname.dll.a' - # DLL is installed to $(libdir)/../bin by postinstall_cmds - postinstall_cmds='base_file=`basename \$file`~ - dlpath=`$SHELL 2>&1 -c '\''. $dir/'\''\$base_file'\''i; echo \$dlname'\''`~ - dldir=$destdir/`dirname \$dlpath`~ - test -d \$dldir || mkdir -p \$dldir~ - $install_prog $dir/$dlname \$dldir/$dlname~ - chmod a+x \$dldir/$dlname~ - if test -n '\''$stripme'\'' && test -n '\''$striplib'\''; then - eval '\''$striplib \$dldir/$dlname'\'' || exit \$?; - fi' - postuninstall_cmds='dldll=`$SHELL 2>&1 -c '\''. $file; echo \$dlname'\''`~ - dlpath=$dir/\$dldll~ - $RM \$dlpath' - shlibpath_overrides_runpath=yes - - case $host_os in - cygwin*) - # Cygwin DLLs use 'cyg' prefix rather than 'lib' - soname_spec='`echo $libname | sed -e 's/^lib/cyg/'``echo $release | $SED -e 's/[.]/-/g'`$versuffix$shared_ext' - - sys_lib_search_path_spec="$sys_lib_search_path_spec /usr/lib/w32api" - ;; - mingw* | cegcc*) - # MinGW DLLs use traditional 'lib' prefix - soname_spec='$libname`echo $release | $SED -e 's/[.]/-/g'`$versuffix$shared_ext' - ;; - pw32*) - # pw32 DLLs use 'pw' prefix rather than 'lib' - library_names_spec='`echo $libname | sed -e 's/^lib/pw/'``echo $release | $SED -e 's/[.]/-/g'`$versuffix$shared_ext' - ;; - esac - dynamic_linker='Win32 ld.exe' - ;; - - *,cl*) - # Native MSVC - libname_spec='$name' - soname_spec='$libname`echo $release | $SED -e 's/[.]/-/g'`$versuffix$shared_ext' - library_names_spec='$libname.dll.lib' - - case $build_os in - mingw*) - sys_lib_search_path_spec= - lt_save_ifs=$IFS - IFS=';' - for lt_path in $LIB - do - IFS=$lt_save_ifs - # Let DOS variable expansion print the short 8.3 style file name. - lt_path=`cd "$lt_path" 2>/dev/null && cmd //C "for %i in (".") do @echo %~si"` - sys_lib_search_path_spec="$sys_lib_search_path_spec $lt_path" - done - IFS=$lt_save_ifs - # Convert to MSYS style. - sys_lib_search_path_spec=`$ECHO "$sys_lib_search_path_spec" | sed -e 's|\\\\|/|g' -e 's| \\([a-zA-Z]\\):| /\\1|g' -e 's|^ ||'` - ;; - cygwin*) - # Convert to unix form, then to dos form, then back to unix form - # but this time dos style (no spaces!) so that the unix form looks - # like /cygdrive/c/PROGRA~1:/cygdr... - sys_lib_search_path_spec=`cygpath --path --unix "$LIB"` - sys_lib_search_path_spec=`cygpath --path --dos "$sys_lib_search_path_spec" 2>/dev/null` - sys_lib_search_path_spec=`cygpath --path --unix "$sys_lib_search_path_spec" | $SED -e "s/$PATH_SEPARATOR/ /g"` - ;; - *) - sys_lib_search_path_spec=$LIB - if $ECHO "$sys_lib_search_path_spec" | $GREP ';[c-zC-Z]:/' >/dev/null; then - # It is most probably a Windows format PATH. - sys_lib_search_path_spec=`$ECHO "$sys_lib_search_path_spec" | $SED -e 's/;/ /g'` - else - sys_lib_search_path_spec=`$ECHO "$sys_lib_search_path_spec" | $SED -e "s/$PATH_SEPARATOR/ /g"` - fi - # FIXME: find the short name or the path components, as spaces are - # common. (e.g. "Program Files" -> "PROGRA~1") - ;; - esac - - # DLL is installed to $(libdir)/../bin by postinstall_cmds - postinstall_cmds='base_file=`basename \$file`~ - dlpath=`$SHELL 2>&1 -c '\''. $dir/'\''\$base_file'\''i; echo \$dlname'\''`~ - dldir=$destdir/`dirname \$dlpath`~ - test -d \$dldir || mkdir -p \$dldir~ - $install_prog $dir/$dlname \$dldir/$dlname' - postuninstall_cmds='dldll=`$SHELL 2>&1 -c '\''. $file; echo \$dlname'\''`~ - dlpath=$dir/\$dldll~ - $RM \$dlpath' - shlibpath_overrides_runpath=yes - dynamic_linker='Win32 link.exe' - ;; - - *) - # Assume MSVC wrapper - library_names_spec='$libname`echo $release | $SED -e 's/[.]/-/g'`$versuffix$shared_ext $libname.lib' - dynamic_linker='Win32 ld.exe' - ;; - esac - # FIXME: first we should search . and the directory the executable is in - shlibpath_var=PATH - ;; - -darwin* | rhapsody*) - dynamic_linker="$host_os dyld" - version_type=darwin - need_lib_prefix=no - need_version=no - library_names_spec='$libname$release$major$shared_ext $libname$shared_ext' - soname_spec='$libname$release$major$shared_ext' - shlibpath_overrides_runpath=yes - shlibpath_var=DYLD_LIBRARY_PATH - shrext_cmds='`test .$module = .yes && echo .so || echo .dylib`' - - sys_lib_search_path_spec="$sys_lib_search_path_spec /usr/local/lib" - sys_lib_dlsearch_path_spec='/usr/local/lib /lib /usr/lib' - ;; - -dgux*) - version_type=linux # correct to gnu/linux during the next big refactor - need_lib_prefix=no - need_version=no - library_names_spec='$libname$release$shared_ext$versuffix $libname$release$shared_ext$major $libname$shared_ext' - soname_spec='$libname$release$shared_ext$major' - shlibpath_var=LD_LIBRARY_PATH - ;; - -freebsd* | dragonfly*) - # DragonFly does not have aout. When/if they implement a new - # versioning mechanism, adjust this. - if test -x /usr/bin/objformat; then - objformat=`/usr/bin/objformat` - else - case $host_os in - freebsd[23].*) objformat=aout ;; - *) objformat=elf ;; - esac - fi - version_type=freebsd-$objformat - case $version_type in - freebsd-elf*) - library_names_spec='$libname$release$shared_ext$versuffix $libname$release$shared_ext$major $libname$shared_ext' - soname_spec='$libname$release$shared_ext$major' - need_version=no - need_lib_prefix=no - ;; - freebsd-*) - library_names_spec='$libname$release$shared_ext$versuffix $libname$shared_ext$versuffix' - need_version=yes - ;; - esac - shlibpath_var=LD_LIBRARY_PATH - case $host_os in - freebsd2.*) - shlibpath_overrides_runpath=yes - ;; - freebsd3.[01]* | freebsdelf3.[01]*) - shlibpath_overrides_runpath=yes - hardcode_into_libs=yes - ;; - freebsd3.[2-9]* | freebsdelf3.[2-9]* | \ - freebsd4.[0-5] | freebsdelf4.[0-5] | freebsd4.1.1 | freebsdelf4.1.1) - shlibpath_overrides_runpath=no - hardcode_into_libs=yes - ;; - *) # from 4.6 on, and DragonFly - shlibpath_overrides_runpath=yes - hardcode_into_libs=yes - ;; - esac - ;; - -haiku*) - version_type=linux # correct to gnu/linux during the next big refactor - need_lib_prefix=no - need_version=no - dynamic_linker="$host_os runtime_loader" - library_names_spec='$libname$release$shared_ext$versuffix $libname$release$shared_ext$major $libname$shared_ext' - soname_spec='$libname$release$shared_ext$major' - shlibpath_var=LIBRARY_PATH - shlibpath_overrides_runpath=no - sys_lib_dlsearch_path_spec='/boot/home/config/lib /boot/common/lib /boot/system/lib' - hardcode_into_libs=yes - ;; - -hpux9* | hpux10* | hpux11*) - # Give a soname corresponding to the major version so that dld.sl refuses to - # link against other versions. - version_type=sunos - need_lib_prefix=no - need_version=no - case $host_cpu in - ia64*) - shrext_cmds='.so' - hardcode_into_libs=yes - dynamic_linker="$host_os dld.so" - shlibpath_var=LD_LIBRARY_PATH - shlibpath_overrides_runpath=yes # Unless +noenvvar is specified. - library_names_spec='$libname$release$shared_ext$versuffix $libname$release$shared_ext$major $libname$shared_ext' - soname_spec='$libname$release$shared_ext$major' - if test 32 = "$HPUX_IA64_MODE"; then - sys_lib_search_path_spec="/usr/lib/hpux32 /usr/local/lib/hpux32 /usr/local/lib" - sys_lib_dlsearch_path_spec=/usr/lib/hpux32 - else - sys_lib_search_path_spec="/usr/lib/hpux64 /usr/local/lib/hpux64" - sys_lib_dlsearch_path_spec=/usr/lib/hpux64 - fi - ;; - hppa*64*) - shrext_cmds='.sl' - hardcode_into_libs=yes - dynamic_linker="$host_os dld.sl" - shlibpath_var=LD_LIBRARY_PATH # How should we handle SHLIB_PATH - shlibpath_overrides_runpath=yes # Unless +noenvvar is specified. - library_names_spec='$libname$release$shared_ext$versuffix $libname$release$shared_ext$major $libname$shared_ext' - soname_spec='$libname$release$shared_ext$major' - sys_lib_search_path_spec="/usr/lib/pa20_64 /usr/ccs/lib/pa20_64" - sys_lib_dlsearch_path_spec=$sys_lib_search_path_spec - ;; - *) - shrext_cmds='.sl' - dynamic_linker="$host_os dld.sl" - shlibpath_var=SHLIB_PATH - shlibpath_overrides_runpath=no # +s is required to enable SHLIB_PATH - library_names_spec='$libname$release$shared_ext$versuffix $libname$release$shared_ext$major $libname$shared_ext' - soname_spec='$libname$release$shared_ext$major' - ;; - esac - # HP-UX runs *really* slowly unless shared libraries are mode 555, ... - postinstall_cmds='chmod 555 $lib' - # or fails outright, so override atomically: - install_override_mode=555 - ;; - -interix[3-9]*) - version_type=linux # correct to gnu/linux during the next big refactor - need_lib_prefix=no - need_version=no - library_names_spec='$libname$release$shared_ext$versuffix $libname$release$shared_ext$major $libname$shared_ext' - soname_spec='$libname$release$shared_ext$major' - dynamic_linker='Interix 3.x ld.so.1 (PE, like ELF)' - shlibpath_var=LD_LIBRARY_PATH - shlibpath_overrides_runpath=no - hardcode_into_libs=yes - ;; - -irix5* | irix6* | nonstopux*) - case $host_os in - nonstopux*) version_type=nonstopux ;; - *) - if test yes = "$lt_cv_prog_gnu_ld"; then - version_type=linux # correct to gnu/linux during the next big refactor - else - version_type=irix - fi ;; - esac - need_lib_prefix=no - need_version=no - soname_spec='$libname$release$shared_ext$major' - library_names_spec='$libname$release$shared_ext$versuffix $libname$release$shared_ext$major $libname$release$shared_ext $libname$shared_ext' - case $host_os in - irix5* | nonstopux*) - libsuff= shlibsuff= - ;; - *) - case $LD in # libtool.m4 will add one of these switches to LD - *-32|*"-32 "|*-melf32bsmip|*"-melf32bsmip ") - libsuff= shlibsuff= libmagic=32-bit;; - *-n32|*"-n32 "|*-melf32bmipn32|*"-melf32bmipn32 ") - libsuff=32 shlibsuff=N32 libmagic=N32;; - *-64|*"-64 "|*-melf64bmip|*"-melf64bmip ") - libsuff=64 shlibsuff=64 libmagic=64-bit;; - *) libsuff= shlibsuff= libmagic=never-match;; - esac - ;; - esac - shlibpath_var=LD_LIBRARY${shlibsuff}_PATH - shlibpath_overrides_runpath=no - sys_lib_search_path_spec="/usr/lib$libsuff /lib$libsuff /usr/local/lib$libsuff" - sys_lib_dlsearch_path_spec="/usr/lib$libsuff /lib$libsuff" - hardcode_into_libs=yes - ;; - -# No shared lib support for Linux oldld, aout, or coff. -linux*oldld* | linux*aout* | linux*coff*) - dynamic_linker=no - ;; - -linux*android*) - version_type=none # Android doesn't support versioned libraries. - need_lib_prefix=no - need_version=no - library_names_spec='$libname$release$shared_ext' - soname_spec='$libname$release$shared_ext' - finish_cmds= - shlibpath_var=LD_LIBRARY_PATH - shlibpath_overrides_runpath=yes - - # This implies no fast_install, which is unacceptable. - # Some rework will be needed to allow for fast_install - # before this can be enabled. - hardcode_into_libs=yes - - dynamic_linker='Android linker' - # Don't embed -rpath directories since the linker doesn't support them. - hardcode_libdir_flag_spec='-L$libdir' - ;; - -# This must be glibc/ELF. -linux* | k*bsd*-gnu | kopensolaris*-gnu | gnu*) - version_type=linux # correct to gnu/linux during the next big refactor - need_lib_prefix=no - need_version=no - library_names_spec='$libname$release$shared_ext$versuffix $libname$release$shared_ext$major $libname$shared_ext' - soname_spec='$libname$release$shared_ext$major' - finish_cmds='PATH="\$PATH:/sbin" ldconfig -n $libdir' - shlibpath_var=LD_LIBRARY_PATH - shlibpath_overrides_runpath=no - - # Some binutils ld are patched to set DT_RUNPATH - if ${lt_cv_shlibpath_overrides_runpath+:} false; then : - $as_echo_n "(cached) " >&6 -else - lt_cv_shlibpath_overrides_runpath=no - save_LDFLAGS=$LDFLAGS - save_libdir=$libdir - eval "libdir=/foo; wl=\"$lt_prog_compiler_wl\"; \ - LDFLAGS=\"\$LDFLAGS $hardcode_libdir_flag_spec\"" - cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ - -int -main () -{ - - ; - return 0; -} -_ACEOF -if ac_fn_c_try_link "$LINENO"; then : - if ($OBJDUMP -p conftest$ac_exeext) 2>/dev/null | grep "RUNPATH.*$libdir" >/dev/null; then : - lt_cv_shlibpath_overrides_runpath=yes -fi -fi -rm -f core conftest.err conftest.$ac_objext \ - conftest$ac_exeext conftest.$ac_ext - LDFLAGS=$save_LDFLAGS - libdir=$save_libdir - -fi - - shlibpath_overrides_runpath=$lt_cv_shlibpath_overrides_runpath - - # This implies no fast_install, which is unacceptable. - # Some rework will be needed to allow for fast_install - # before this can be enabled. - hardcode_into_libs=yes - - # Ideally, we could use ldconfig to report *all* directores which are - # searched for libraries, however this is still not possible. Aside from not - # being certain /sbin/ldconfig is available, command - # 'ldconfig -N -X -v | grep ^/' on 64bit Fedora does not report /usr/lib64, - # even though it is searched at run-time. Try to do the best guess by - # appending ld.so.conf contents (and includes) to the search path. - if test -f /etc/ld.so.conf; then - lt_ld_extra=`awk '/^include / { system(sprintf("cd /etc; cat %s 2>/dev/null", \$2)); skip = 1; } { if (!skip) print \$0; skip = 0; }' < /etc/ld.so.conf | $SED -e 's/#.*//;/^[ ]*hwcap[ ]/d;s/[:, ]/ /g;s/=[^=]*$//;s/=[^= ]* / /g;s/"//g;/^$/d' | tr '\n' ' '` - sys_lib_dlsearch_path_spec="/lib /usr/lib $lt_ld_extra" - fi - - # We used to test for /lib/ld.so.1 and disable shared libraries on - # powerpc, because MkLinux only supported shared libraries with the - # GNU dynamic linker. Since this was broken with cross compilers, - # most powerpc-linux boxes support dynamic linking these days and - # people can always --disable-shared, the test was removed, and we - # assume the GNU/Linux dynamic linker is in use. - dynamic_linker='GNU/Linux ld.so' - ;; - -netbsd*) - version_type=sunos - need_lib_prefix=no - need_version=no - if echo __ELF__ | $CC -E - | $GREP __ELF__ >/dev/null; then - library_names_spec='$libname$release$shared_ext$versuffix $libname$shared_ext$versuffix' - finish_cmds='PATH="\$PATH:/sbin" ldconfig -m $libdir' - dynamic_linker='NetBSD (a.out) ld.so' - else - library_names_spec='$libname$release$shared_ext$versuffix $libname$release$shared_ext$major $libname$shared_ext' - soname_spec='$libname$release$shared_ext$major' - dynamic_linker='NetBSD ld.elf_so' - fi - shlibpath_var=LD_LIBRARY_PATH - shlibpath_overrides_runpath=yes - hardcode_into_libs=yes - ;; - -newsos6) - version_type=linux # correct to gnu/linux during the next big refactor - library_names_spec='$libname$release$shared_ext$versuffix $libname$release$shared_ext$major $libname$shared_ext' - shlibpath_var=LD_LIBRARY_PATH - shlibpath_overrides_runpath=yes - ;; - -*nto* | *qnx*) - version_type=qnx - need_lib_prefix=no - need_version=no - library_names_spec='$libname$release$shared_ext$versuffix $libname$release$shared_ext$major $libname$shared_ext' - soname_spec='$libname$release$shared_ext$major' - shlibpath_var=LD_LIBRARY_PATH - shlibpath_overrides_runpath=no - hardcode_into_libs=yes - dynamic_linker='ldqnx.so' - ;; - -openbsd* | bitrig*) - version_type=sunos - sys_lib_dlsearch_path_spec=/usr/lib - need_lib_prefix=no - if test -z "`echo __ELF__ | $CC -E - | $GREP __ELF__`"; then - need_version=no - else - need_version=yes - fi - library_names_spec='$libname$release$shared_ext$versuffix $libname$shared_ext$versuffix' - finish_cmds='PATH="\$PATH:/sbin" ldconfig -m $libdir' - shlibpath_var=LD_LIBRARY_PATH - shlibpath_overrides_runpath=yes - ;; - -os2*) - libname_spec='$name' - version_type=windows - shrext_cmds=.dll - need_version=no - need_lib_prefix=no - # OS/2 can only load a DLL with a base name of 8 characters or less. - soname_spec='`test -n "$os2dllname" && libname="$os2dllname"; - v=$($ECHO $release$versuffix | tr -d .-); - n=$($ECHO $libname | cut -b -$((8 - ${#v})) | tr . _); - $ECHO $n$v`$shared_ext' - library_names_spec='${libname}_dll.$libext' - dynamic_linker='OS/2 ld.exe' - shlibpath_var=BEGINLIBPATH - sys_lib_search_path_spec="/lib /usr/lib /usr/local/lib" - sys_lib_dlsearch_path_spec=$sys_lib_search_path_spec - postinstall_cmds='base_file=`basename \$file`~ - dlpath=`$SHELL 2>&1 -c '\''. $dir/'\''\$base_file'\''i; $ECHO \$dlname'\''`~ - dldir=$destdir/`dirname \$dlpath`~ - test -d \$dldir || mkdir -p \$dldir~ - $install_prog $dir/$dlname \$dldir/$dlname~ - chmod a+x \$dldir/$dlname~ - if test -n '\''$stripme'\'' && test -n '\''$striplib'\''; then - eval '\''$striplib \$dldir/$dlname'\'' || exit \$?; - fi' - postuninstall_cmds='dldll=`$SHELL 2>&1 -c '\''. $file; $ECHO \$dlname'\''`~ - dlpath=$dir/\$dldll~ - $RM \$dlpath' - ;; - -osf3* | osf4* | osf5*) - version_type=osf - need_lib_prefix=no - need_version=no - soname_spec='$libname$release$shared_ext$major' - library_names_spec='$libname$release$shared_ext$versuffix $libname$release$shared_ext$major $libname$shared_ext' - shlibpath_var=LD_LIBRARY_PATH - sys_lib_search_path_spec="/usr/shlib /usr/ccs/lib /usr/lib/cmplrs/cc /usr/lib /usr/local/lib /var/shlib" - sys_lib_dlsearch_path_spec=$sys_lib_search_path_spec - ;; - -rdos*) - dynamic_linker=no - ;; - -solaris*) - version_type=linux # correct to gnu/linux during the next big refactor - need_lib_prefix=no - need_version=no - library_names_spec='$libname$release$shared_ext$versuffix $libname$release$shared_ext$major $libname$shared_ext' - soname_spec='$libname$release$shared_ext$major' - shlibpath_var=LD_LIBRARY_PATH - shlibpath_overrides_runpath=yes - hardcode_into_libs=yes - # ldd complains unless libraries are executable - postinstall_cmds='chmod +x $lib' - ;; - -sunos4*) - version_type=sunos - library_names_spec='$libname$release$shared_ext$versuffix $libname$shared_ext$versuffix' - finish_cmds='PATH="\$PATH:/usr/etc" ldconfig $libdir' - shlibpath_var=LD_LIBRARY_PATH - shlibpath_overrides_runpath=yes - if test yes = "$with_gnu_ld"; then - need_lib_prefix=no - fi - need_version=yes - ;; - -sysv4 | sysv4.3*) - version_type=linux # correct to gnu/linux during the next big refactor - library_names_spec='$libname$release$shared_ext$versuffix $libname$release$shared_ext$major $libname$shared_ext' - soname_spec='$libname$release$shared_ext$major' - shlibpath_var=LD_LIBRARY_PATH - case $host_vendor in - sni) - shlibpath_overrides_runpath=no - need_lib_prefix=no - runpath_var=LD_RUN_PATH - ;; - siemens) - need_lib_prefix=no - ;; - motorola) - need_lib_prefix=no - need_version=no - shlibpath_overrides_runpath=no - sys_lib_search_path_spec='/lib /usr/lib /usr/ccs/lib' - ;; - esac - ;; - -sysv4*MP*) - if test -d /usr/nec; then - version_type=linux # correct to gnu/linux during the next big refactor - library_names_spec='$libname$shared_ext.$versuffix $libname$shared_ext.$major $libname$shared_ext' - soname_spec='$libname$shared_ext.$major' - shlibpath_var=LD_LIBRARY_PATH - fi - ;; - -sysv5* | sco3.2v5* | sco5v6* | unixware* | OpenUNIX* | sysv4*uw2*) - version_type=sco - need_lib_prefix=no - need_version=no - library_names_spec='$libname$release$shared_ext$versuffix $libname$release$shared_ext $libname$shared_ext' - soname_spec='$libname$release$shared_ext$major' - shlibpath_var=LD_LIBRARY_PATH - shlibpath_overrides_runpath=yes - hardcode_into_libs=yes - if test yes = "$with_gnu_ld"; then - sys_lib_search_path_spec='/usr/local/lib /usr/gnu/lib /usr/ccs/lib /usr/lib /lib' - else - sys_lib_search_path_spec='/usr/ccs/lib /usr/lib' - case $host_os in - sco3.2v5*) - sys_lib_search_path_spec="$sys_lib_search_path_spec /lib" - ;; - esac - fi - sys_lib_dlsearch_path_spec='/usr/lib' - ;; - -tpf*) - # TPF is a cross-target only. Preferred cross-host = GNU/Linux. - version_type=linux # correct to gnu/linux during the next big refactor - need_lib_prefix=no - need_version=no - library_names_spec='$libname$release$shared_ext$versuffix $libname$release$shared_ext$major $libname$shared_ext' - shlibpath_var=LD_LIBRARY_PATH - shlibpath_overrides_runpath=no - hardcode_into_libs=yes - ;; - -uts4*) - version_type=linux # correct to gnu/linux during the next big refactor - library_names_spec='$libname$release$shared_ext$versuffix $libname$release$shared_ext$major $libname$shared_ext' - soname_spec='$libname$release$shared_ext$major' - shlibpath_var=LD_LIBRARY_PATH - ;; - -*) - dynamic_linker=no - ;; -esac -{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $dynamic_linker" >&5 -$as_echo "$dynamic_linker" >&6; } -test no = "$dynamic_linker" && can_build_shared=no - -variables_saved_for_relink="PATH $shlibpath_var $runpath_var" -if test yes = "$GCC"; then - variables_saved_for_relink="$variables_saved_for_relink GCC_EXEC_PREFIX COMPILER_PATH LIBRARY_PATH" -fi - -if test set = "${lt_cv_sys_lib_search_path_spec+set}"; then - sys_lib_search_path_spec=$lt_cv_sys_lib_search_path_spec -fi - -if test set = "${lt_cv_sys_lib_dlsearch_path_spec+set}"; then - sys_lib_dlsearch_path_spec=$lt_cv_sys_lib_dlsearch_path_spec -fi - -# remember unaugmented sys_lib_dlsearch_path content for libtool script decls... -configure_time_dlsearch_path=$sys_lib_dlsearch_path_spec - -# ... but it needs LT_SYS_LIBRARY_PATH munging for other configure-time code -func_munge_path_list sys_lib_dlsearch_path_spec "$LT_SYS_LIBRARY_PATH" - -# to be used as default LT_SYS_LIBRARY_PATH value in generated libtool -configure_time_lt_sys_library_path=$LT_SYS_LIBRARY_PATH - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - { $as_echo "$as_me:${as_lineno-$LINENO}: checking how to hardcode library paths into programs" >&5 -$as_echo_n "checking how to hardcode library paths into programs... " >&6; } -hardcode_action= -if test -n "$hardcode_libdir_flag_spec" || - test -n "$runpath_var" || - test yes = "$hardcode_automatic"; then - - # We can hardcode non-existent directories. - if test no != "$hardcode_direct" && - # If the only mechanism to avoid hardcoding is shlibpath_var, we - # have to relink, otherwise we might link with an installed library - # when we should be linking with a yet-to-be-installed one - ## test no != "$_LT_TAGVAR(hardcode_shlibpath_var, )" && - test no != "$hardcode_minus_L"; then - # Linking always hardcodes the temporary library directory. - hardcode_action=relink - else - # We can link without hardcoding, and we can hardcode nonexisting dirs. - hardcode_action=immediate - fi -else - # We cannot hardcode anything, or else we can only hardcode existing - # directories. - hardcode_action=unsupported -fi -{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $hardcode_action" >&5 -$as_echo "$hardcode_action" >&6; } - -if test relink = "$hardcode_action" || - test yes = "$inherit_rpath"; then - # Fast installation is not supported - enable_fast_install=no -elif test yes = "$shlibpath_overrides_runpath" || - test no = "$enable_shared"; then - # Fast installation is not necessary - enable_fast_install=needless -fi - - - - - - - if test yes != "$enable_dlopen"; then - enable_dlopen=unknown - enable_dlopen_self=unknown - enable_dlopen_self_static=unknown -else - lt_cv_dlopen=no - lt_cv_dlopen_libs= - - case $host_os in - beos*) - lt_cv_dlopen=load_add_on - lt_cv_dlopen_libs= - lt_cv_dlopen_self=yes - ;; - - mingw* | pw32* | cegcc*) - lt_cv_dlopen=LoadLibrary - lt_cv_dlopen_libs= - ;; - - cygwin*) - lt_cv_dlopen=dlopen - lt_cv_dlopen_libs= - ;; - - darwin*) - # if libdl is installed we need to link against it - { $as_echo "$as_me:${as_lineno-$LINENO}: checking for dlopen in -ldl" >&5 -$as_echo_n "checking for dlopen in -ldl... " >&6; } -if ${ac_cv_lib_dl_dlopen+:} false; then : - $as_echo_n "(cached) " >&6 -else - ac_check_lib_save_LIBS=$LIBS -LIBS="-ldl $LIBS" -cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ - -/* Override any GCC internal prototype to avoid an error. - Use char because int might match the return type of a GCC - builtin and then its argument prototype would still apply. */ -#ifdef __cplusplus -extern "C" -#endif -char dlopen (); -int -main () -{ -return dlopen (); - ; - return 0; -} -_ACEOF -if ac_fn_c_try_link "$LINENO"; then : - ac_cv_lib_dl_dlopen=yes -else - ac_cv_lib_dl_dlopen=no -fi -rm -f core conftest.err conftest.$ac_objext \ - conftest$ac_exeext conftest.$ac_ext -LIBS=$ac_check_lib_save_LIBS -fi -{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_dl_dlopen" >&5 -$as_echo "$ac_cv_lib_dl_dlopen" >&6; } -if test "x$ac_cv_lib_dl_dlopen" = xyes; then : - lt_cv_dlopen=dlopen lt_cv_dlopen_libs=-ldl -else - - lt_cv_dlopen=dyld - lt_cv_dlopen_libs= - lt_cv_dlopen_self=yes - -fi - - ;; - - tpf*) - # Don't try to run any link tests for TPF. We know it's impossible - # because TPF is a cross-compiler, and we know how we open DSOs. - lt_cv_dlopen=dlopen - lt_cv_dlopen_libs= - lt_cv_dlopen_self=no - ;; - - *) - ac_fn_c_check_func "$LINENO" "shl_load" "ac_cv_func_shl_load" -if test "x$ac_cv_func_shl_load" = xyes; then : - lt_cv_dlopen=shl_load -else - { $as_echo "$as_me:${as_lineno-$LINENO}: checking for shl_load in -ldld" >&5 -$as_echo_n "checking for shl_load in -ldld... " >&6; } -if ${ac_cv_lib_dld_shl_load+:} false; then : - $as_echo_n "(cached) " >&6 -else - ac_check_lib_save_LIBS=$LIBS -LIBS="-ldld $LIBS" -cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ - -/* Override any GCC internal prototype to avoid an error. - Use char because int might match the return type of a GCC - builtin and then its argument prototype would still apply. */ -#ifdef __cplusplus -extern "C" -#endif -char shl_load (); -int -main () -{ -return shl_load (); - ; - return 0; -} -_ACEOF -if ac_fn_c_try_link "$LINENO"; then : - ac_cv_lib_dld_shl_load=yes -else - ac_cv_lib_dld_shl_load=no -fi -rm -f core conftest.err conftest.$ac_objext \ - conftest$ac_exeext conftest.$ac_ext -LIBS=$ac_check_lib_save_LIBS -fi -{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_dld_shl_load" >&5 -$as_echo "$ac_cv_lib_dld_shl_load" >&6; } -if test "x$ac_cv_lib_dld_shl_load" = xyes; then : - lt_cv_dlopen=shl_load lt_cv_dlopen_libs=-ldld -else - ac_fn_c_check_func "$LINENO" "dlopen" "ac_cv_func_dlopen" -if test "x$ac_cv_func_dlopen" = xyes; then : - lt_cv_dlopen=dlopen -else - { $as_echo "$as_me:${as_lineno-$LINENO}: checking for dlopen in -ldl" >&5 -$as_echo_n "checking for dlopen in -ldl... " >&6; } -if ${ac_cv_lib_dl_dlopen+:} false; then : - $as_echo_n "(cached) " >&6 -else - ac_check_lib_save_LIBS=$LIBS -LIBS="-ldl $LIBS" -cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ - -/* Override any GCC internal prototype to avoid an error. - Use char because int might match the return type of a GCC - builtin and then its argument prototype would still apply. */ -#ifdef __cplusplus -extern "C" -#endif -char dlopen (); -int -main () -{ -return dlopen (); - ; - return 0; -} -_ACEOF -if ac_fn_c_try_link "$LINENO"; then : - ac_cv_lib_dl_dlopen=yes -else - ac_cv_lib_dl_dlopen=no -fi -rm -f core conftest.err conftest.$ac_objext \ - conftest$ac_exeext conftest.$ac_ext -LIBS=$ac_check_lib_save_LIBS -fi -{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_dl_dlopen" >&5 -$as_echo "$ac_cv_lib_dl_dlopen" >&6; } -if test "x$ac_cv_lib_dl_dlopen" = xyes; then : - lt_cv_dlopen=dlopen lt_cv_dlopen_libs=-ldl -else - { $as_echo "$as_me:${as_lineno-$LINENO}: checking for dlopen in -lsvld" >&5 -$as_echo_n "checking for dlopen in -lsvld... " >&6; } -if ${ac_cv_lib_svld_dlopen+:} false; then : - $as_echo_n "(cached) " >&6 -else - ac_check_lib_save_LIBS=$LIBS -LIBS="-lsvld $LIBS" -cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ - -/* Override any GCC internal prototype to avoid an error. - Use char because int might match the return type of a GCC - builtin and then its argument prototype would still apply. */ -#ifdef __cplusplus -extern "C" -#endif -char dlopen (); -int -main () -{ -return dlopen (); - ; - return 0; -} -_ACEOF -if ac_fn_c_try_link "$LINENO"; then : - ac_cv_lib_svld_dlopen=yes -else - ac_cv_lib_svld_dlopen=no -fi -rm -f core conftest.err conftest.$ac_objext \ - conftest$ac_exeext conftest.$ac_ext -LIBS=$ac_check_lib_save_LIBS -fi -{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_svld_dlopen" >&5 -$as_echo "$ac_cv_lib_svld_dlopen" >&6; } -if test "x$ac_cv_lib_svld_dlopen" = xyes; then : - lt_cv_dlopen=dlopen lt_cv_dlopen_libs=-lsvld -else - { $as_echo "$as_me:${as_lineno-$LINENO}: checking for dld_link in -ldld" >&5 -$as_echo_n "checking for dld_link in -ldld... " >&6; } -if ${ac_cv_lib_dld_dld_link+:} false; then : - $as_echo_n "(cached) " >&6 -else - ac_check_lib_save_LIBS=$LIBS -LIBS="-ldld $LIBS" -cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ - -/* Override any GCC internal prototype to avoid an error. - Use char because int might match the return type of a GCC - builtin and then its argument prototype would still apply. */ -#ifdef __cplusplus -extern "C" -#endif -char dld_link (); -int -main () -{ -return dld_link (); - ; - return 0; -} -_ACEOF -if ac_fn_c_try_link "$LINENO"; then : - ac_cv_lib_dld_dld_link=yes -else - ac_cv_lib_dld_dld_link=no -fi -rm -f core conftest.err conftest.$ac_objext \ - conftest$ac_exeext conftest.$ac_ext -LIBS=$ac_check_lib_save_LIBS -fi -{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_dld_dld_link" >&5 -$as_echo "$ac_cv_lib_dld_dld_link" >&6; } -if test "x$ac_cv_lib_dld_dld_link" = xyes; then : - lt_cv_dlopen=dld_link lt_cv_dlopen_libs=-ldld -fi - - -fi - - -fi - - -fi - - -fi - - -fi - - ;; - esac - - if test no = "$lt_cv_dlopen"; then - enable_dlopen=no - else - enable_dlopen=yes - fi - - case $lt_cv_dlopen in - dlopen) - save_CPPFLAGS=$CPPFLAGS - test yes = "$ac_cv_header_dlfcn_h" && CPPFLAGS="$CPPFLAGS -DHAVE_DLFCN_H" - - save_LDFLAGS=$LDFLAGS - wl=$lt_prog_compiler_wl eval LDFLAGS=\"\$LDFLAGS $export_dynamic_flag_spec\" - - save_LIBS=$LIBS - LIBS="$lt_cv_dlopen_libs $LIBS" - - { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether a program can dlopen itself" >&5 -$as_echo_n "checking whether a program can dlopen itself... " >&6; } -if ${lt_cv_dlopen_self+:} false; then : - $as_echo_n "(cached) " >&6 -else - if test yes = "$cross_compiling"; then : - lt_cv_dlopen_self=cross -else - lt_dlunknown=0; lt_dlno_uscore=1; lt_dlneed_uscore=2 - lt_status=$lt_dlunknown - cat > conftest.$ac_ext <<_LT_EOF -#line $LINENO "configure" -#include "confdefs.h" - -#if HAVE_DLFCN_H -#include -#endif - -#include - -#ifdef RTLD_GLOBAL -# define LT_DLGLOBAL RTLD_GLOBAL -#else -# ifdef DL_GLOBAL -# define LT_DLGLOBAL DL_GLOBAL -# else -# define LT_DLGLOBAL 0 -# endif -#endif - -/* We may have to define LT_DLLAZY_OR_NOW in the command line if we - find out it does not work in some platform. */ -#ifndef LT_DLLAZY_OR_NOW -# ifdef RTLD_LAZY -# define LT_DLLAZY_OR_NOW RTLD_LAZY -# else -# ifdef DL_LAZY -# define LT_DLLAZY_OR_NOW DL_LAZY -# else -# ifdef RTLD_NOW -# define LT_DLLAZY_OR_NOW RTLD_NOW -# else -# ifdef DL_NOW -# define LT_DLLAZY_OR_NOW DL_NOW -# else -# define LT_DLLAZY_OR_NOW 0 -# endif -# endif -# endif -# endif -#endif - -/* When -fvisibility=hidden is used, assume the code has been annotated - correspondingly for the symbols needed. */ -#if defined __GNUC__ && (((__GNUC__ == 3) && (__GNUC_MINOR__ >= 3)) || (__GNUC__ > 3)) -int fnord () __attribute__((visibility("default"))); -#endif - -int fnord () { return 42; } -int main () -{ - void *self = dlopen (0, LT_DLGLOBAL|LT_DLLAZY_OR_NOW); - int status = $lt_dlunknown; - - if (self) - { - if (dlsym (self,"fnord")) status = $lt_dlno_uscore; - else - { - if (dlsym( self,"_fnord")) status = $lt_dlneed_uscore; - else puts (dlerror ()); - } - /* dlclose (self); */ - } - else - puts (dlerror ()); - - return status; -} -_LT_EOF - if { { eval echo "\"\$as_me\":${as_lineno-$LINENO}: \"$ac_link\""; } >&5 - (eval $ac_link) 2>&5 - ac_status=$? - $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 - test $ac_status = 0; } && test -s "conftest$ac_exeext" 2>/dev/null; then - (./conftest; exit; ) >&5 2>/dev/null - lt_status=$? - case x$lt_status in - x$lt_dlno_uscore) lt_cv_dlopen_self=yes ;; - x$lt_dlneed_uscore) lt_cv_dlopen_self=yes ;; - x$lt_dlunknown|x*) lt_cv_dlopen_self=no ;; - esac - else : - # compilation failed - lt_cv_dlopen_self=no - fi -fi -rm -fr conftest* - - -fi -{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $lt_cv_dlopen_self" >&5 -$as_echo "$lt_cv_dlopen_self" >&6; } - - if test yes = "$lt_cv_dlopen_self"; then - wl=$lt_prog_compiler_wl eval LDFLAGS=\"\$LDFLAGS $lt_prog_compiler_static\" - { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether a statically linked program can dlopen itself" >&5 -$as_echo_n "checking whether a statically linked program can dlopen itself... " >&6; } -if ${lt_cv_dlopen_self_static+:} false; then : - $as_echo_n "(cached) " >&6 -else - if test yes = "$cross_compiling"; then : - lt_cv_dlopen_self_static=cross -else - lt_dlunknown=0; lt_dlno_uscore=1; lt_dlneed_uscore=2 - lt_status=$lt_dlunknown - cat > conftest.$ac_ext <<_LT_EOF -#line $LINENO "configure" -#include "confdefs.h" - -#if HAVE_DLFCN_H -#include -#endif - -#include - -#ifdef RTLD_GLOBAL -# define LT_DLGLOBAL RTLD_GLOBAL -#else -# ifdef DL_GLOBAL -# define LT_DLGLOBAL DL_GLOBAL -# else -# define LT_DLGLOBAL 0 -# endif -#endif - -/* We may have to define LT_DLLAZY_OR_NOW in the command line if we - find out it does not work in some platform. */ -#ifndef LT_DLLAZY_OR_NOW -# ifdef RTLD_LAZY -# define LT_DLLAZY_OR_NOW RTLD_LAZY -# else -# ifdef DL_LAZY -# define LT_DLLAZY_OR_NOW DL_LAZY -# else -# ifdef RTLD_NOW -# define LT_DLLAZY_OR_NOW RTLD_NOW -# else -# ifdef DL_NOW -# define LT_DLLAZY_OR_NOW DL_NOW -# else -# define LT_DLLAZY_OR_NOW 0 -# endif -# endif -# endif -# endif -#endif - -/* When -fvisibility=hidden is used, assume the code has been annotated - correspondingly for the symbols needed. */ -#if defined __GNUC__ && (((__GNUC__ == 3) && (__GNUC_MINOR__ >= 3)) || (__GNUC__ > 3)) -int fnord () __attribute__((visibility("default"))); -#endif - -int fnord () { return 42; } -int main () -{ - void *self = dlopen (0, LT_DLGLOBAL|LT_DLLAZY_OR_NOW); - int status = $lt_dlunknown; - - if (self) - { - if (dlsym (self,"fnord")) status = $lt_dlno_uscore; - else - { - if (dlsym( self,"_fnord")) status = $lt_dlneed_uscore; - else puts (dlerror ()); - } - /* dlclose (self); */ - } - else - puts (dlerror ()); - - return status; -} -_LT_EOF - if { { eval echo "\"\$as_me\":${as_lineno-$LINENO}: \"$ac_link\""; } >&5 - (eval $ac_link) 2>&5 - ac_status=$? - $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 - test $ac_status = 0; } && test -s "conftest$ac_exeext" 2>/dev/null; then - (./conftest; exit; ) >&5 2>/dev/null - lt_status=$? - case x$lt_status in - x$lt_dlno_uscore) lt_cv_dlopen_self_static=yes ;; - x$lt_dlneed_uscore) lt_cv_dlopen_self_static=yes ;; - x$lt_dlunknown|x*) lt_cv_dlopen_self_static=no ;; - esac - else : - # compilation failed - lt_cv_dlopen_self_static=no - fi -fi -rm -fr conftest* - - -fi -{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $lt_cv_dlopen_self_static" >&5 -$as_echo "$lt_cv_dlopen_self_static" >&6; } - fi - - CPPFLAGS=$save_CPPFLAGS - LDFLAGS=$save_LDFLAGS - LIBS=$save_LIBS - ;; - esac - - case $lt_cv_dlopen_self in - yes|no) enable_dlopen_self=$lt_cv_dlopen_self ;; - *) enable_dlopen_self=unknown ;; - esac - - case $lt_cv_dlopen_self_static in - yes|no) enable_dlopen_self_static=$lt_cv_dlopen_self_static ;; - *) enable_dlopen_self_static=unknown ;; - esac -fi - - - - - - - - - - - - - - - - - -striplib= -old_striplib= -{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether stripping libraries is possible" >&5 -$as_echo_n "checking whether stripping libraries is possible... " >&6; } -if test -n "$STRIP" && $STRIP -V 2>&1 | $GREP "GNU strip" >/dev/null; then - test -z "$old_striplib" && old_striplib="$STRIP --strip-debug" - test -z "$striplib" && striplib="$STRIP --strip-unneeded" - { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5 -$as_echo "yes" >&6; } -else -# FIXME - insert some real tests, host_os isn't really good enough - case $host_os in - darwin*) - if test -n "$STRIP"; then - striplib="$STRIP -x" - old_striplib="$STRIP -S" - { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5 -$as_echo "yes" >&6; } - else - { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 -$as_echo "no" >&6; } - fi - ;; - *) - { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 -$as_echo "no" >&6; } - ;; - esac -fi - - - - - - - - - - - - - # Report what library types will actually be built - { $as_echo "$as_me:${as_lineno-$LINENO}: checking if libtool supports shared libraries" >&5 -$as_echo_n "checking if libtool supports shared libraries... " >&6; } - { $as_echo "$as_me:${as_lineno-$LINENO}: result: $can_build_shared" >&5 -$as_echo "$can_build_shared" >&6; } - - { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether to build shared libraries" >&5 -$as_echo_n "checking whether to build shared libraries... " >&6; } - test no = "$can_build_shared" && enable_shared=no - - # On AIX, shared libraries and static libraries use the same namespace, and - # are all built from PIC. - case $host_os in - aix3*) - test yes = "$enable_shared" && enable_static=no - if test -n "$RANLIB"; then - archive_cmds="$archive_cmds~\$RANLIB \$lib" - postinstall_cmds='$RANLIB $lib' - fi - ;; - - aix[4-9]*) - if test ia64 != "$host_cpu"; then - case $enable_shared,$with_aix_soname,$aix_use_runtimelinking in - yes,aix,yes) ;; # shared object as lib.so file only - yes,svr4,*) ;; # shared object as lib.so archive member only - yes,*) enable_static=no ;; # shared object in lib.a archive as well - esac - fi - ;; - esac - { $as_echo "$as_me:${as_lineno-$LINENO}: result: $enable_shared" >&5 -$as_echo "$enable_shared" >&6; } - - { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether to build static libraries" >&5 -$as_echo_n "checking whether to build static libraries... " >&6; } - # Make sure either enable_shared or enable_static is yes. - test yes = "$enable_shared" || enable_static=yes - { $as_echo "$as_me:${as_lineno-$LINENO}: result: $enable_static" >&5 -$as_echo "$enable_static" >&6; } - - - - -fi -ac_ext=c -ac_cpp='$CPP $CPPFLAGS' -ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' -ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' -ac_compiler_gnu=$ac_cv_c_compiler_gnu - -CC=$lt_save_CC - - - - - - - - - - - - - - - - ac_config_commands="$ac_config_commands libtool" - - - - -# Only expand once: - - - -{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for egrep" >&5 -$as_echo_n "checking for egrep... " >&6; } -if ${ac_cv_path_EGREP+:} false; then : - $as_echo_n "(cached) " >&6 -else - if echo a | $GREP -E '(a|b)' >/dev/null 2>&1 - then ac_cv_path_EGREP="$GREP -E" - else - if test -z "$EGREP"; then - ac_path_EGREP_found=false - # Loop through the user's path and test for each of PROGNAME-LIST - as_save_IFS=$IFS; IFS=$PATH_SEPARATOR -for as_dir in $PATH$PATH_SEPARATOR/usr/xpg4/bin -do - IFS=$as_save_IFS - test -z "$as_dir" && as_dir=. - for ac_prog in egrep; do - for ac_exec_ext in '' $ac_executable_extensions; do - ac_path_EGREP="$as_dir/$ac_prog$ac_exec_ext" - as_fn_executable_p "$ac_path_EGREP" || continue -# Check for GNU ac_path_EGREP and select it if it is found. - # Check for GNU $ac_path_EGREP -case `"$ac_path_EGREP" --version 2>&1` in -*GNU*) - ac_cv_path_EGREP="$ac_path_EGREP" ac_path_EGREP_found=:;; -*) - ac_count=0 - $as_echo_n 0123456789 >"conftest.in" - while : - do - cat "conftest.in" "conftest.in" >"conftest.tmp" - mv "conftest.tmp" "conftest.in" - cp "conftest.in" "conftest.nl" - $as_echo 'EGREP' >> "conftest.nl" - "$ac_path_EGREP" 'EGREP$' < "conftest.nl" >"conftest.out" 2>/dev/null || break - diff "conftest.out" "conftest.nl" >/dev/null 2>&1 || break - as_fn_arith $ac_count + 1 && ac_count=$as_val - if test $ac_count -gt ${ac_path_EGREP_max-0}; then - # Best one so far, save it but keep looking for a better one - ac_cv_path_EGREP="$ac_path_EGREP" - ac_path_EGREP_max=$ac_count - fi - # 10*(2^10) chars as input seems more than enough - test $ac_count -gt 10 && break - done - rm -f conftest.in conftest.tmp conftest.nl conftest.out;; -esac - - $ac_path_EGREP_found && break 3 - done - done - done -IFS=$as_save_IFS - if test -z "$ac_cv_path_EGREP"; then - as_fn_error $? "no acceptable egrep could be found in $PATH$PATH_SEPARATOR/usr/xpg4/bin" "$LINENO" 5 - fi -else - ac_cv_path_EGREP=$EGREP -fi - - fi -fi -{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_path_EGREP" >&5 -$as_echo "$ac_cv_path_EGREP" >&6; } - EGREP="$ac_cv_path_EGREP" - - - - -for ac_prog in flex lex -do - # Extract the first word of "$ac_prog", so it can be a program name with args. -set dummy $ac_prog; ac_word=$2 -{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 -$as_echo_n "checking for $ac_word... " >&6; } -if ${ac_cv_prog_LEX+:} false; then : - $as_echo_n "(cached) " >&6 -else - if test -n "$LEX"; then - ac_cv_prog_LEX="$LEX" # Let the user override the test. -else -as_save_IFS=$IFS; IFS=$PATH_SEPARATOR -for as_dir in $PATH -do - IFS=$as_save_IFS - test -z "$as_dir" && as_dir=. - for ac_exec_ext in '' $ac_executable_extensions; do - if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then - ac_cv_prog_LEX="$ac_prog" - $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 - break 2 - fi -done - done -IFS=$as_save_IFS - -fi -fi -LEX=$ac_cv_prog_LEX -if test -n "$LEX"; then - { $as_echo "$as_me:${as_lineno-$LINENO}: result: $LEX" >&5 -$as_echo "$LEX" >&6; } -else - { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 -$as_echo "no" >&6; } -fi - - - test -n "$LEX" && break -done -test -n "$LEX" || LEX=":" - -if test "x$LEX" != "x:"; then - cat >conftest.l <<_ACEOF -%% -a { ECHO; } -b { REJECT; } -c { yymore (); } -d { yyless (1); } -e { /* IRIX 6.5 flex 2.5.4 underquotes its yyless argument. */ - yyless ((input () != 0)); } -f { unput (yytext[0]); } -. { BEGIN INITIAL; } -%% -#ifdef YYTEXT_POINTER -extern char *yytext; -#endif -int -main (void) -{ - return ! yylex () + ! yywrap (); -} -_ACEOF -{ { ac_try="$LEX conftest.l" -case "(($ac_try" in - *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; - *) ac_try_echo=$ac_try;; -esac -eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\"" -$as_echo "$ac_try_echo"; } >&5 - (eval "$LEX conftest.l") 2>&5 - ac_status=$? - $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 - test $ac_status = 0; } -{ $as_echo "$as_me:${as_lineno-$LINENO}: checking lex output file root" >&5 -$as_echo_n "checking lex output file root... " >&6; } -if ${ac_cv_prog_lex_root+:} false; then : - $as_echo_n "(cached) " >&6 -else - -if test -f lex.yy.c; then - ac_cv_prog_lex_root=lex.yy -elif test -f lexyy.c; then - ac_cv_prog_lex_root=lexyy -else - as_fn_error $? "cannot find output from $LEX; giving up" "$LINENO" 5 -fi -fi -{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_prog_lex_root" >&5 -$as_echo "$ac_cv_prog_lex_root" >&6; } -LEX_OUTPUT_ROOT=$ac_cv_prog_lex_root - -if test -z "${LEXLIB+set}"; then - { $as_echo "$as_me:${as_lineno-$LINENO}: checking lex library" >&5 -$as_echo_n "checking lex library... " >&6; } -if ${ac_cv_lib_lex+:} false; then : - $as_echo_n "(cached) " >&6 -else - - ac_save_LIBS=$LIBS - ac_cv_lib_lex='none needed' - for ac_lib in '' -lfl -ll; do - LIBS="$ac_lib $ac_save_LIBS" - cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ -`cat $LEX_OUTPUT_ROOT.c` -_ACEOF -if ac_fn_c_try_link "$LINENO"; then : - ac_cv_lib_lex=$ac_lib -fi -rm -f core conftest.err conftest.$ac_objext \ - conftest$ac_exeext conftest.$ac_ext - test "$ac_cv_lib_lex" != 'none needed' && break - done - LIBS=$ac_save_LIBS - -fi -{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_lex" >&5 -$as_echo "$ac_cv_lib_lex" >&6; } - test "$ac_cv_lib_lex" != 'none needed' && LEXLIB=$ac_cv_lib_lex -fi - - -{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether yytext is a pointer" >&5 -$as_echo_n "checking whether yytext is a pointer... " >&6; } -if ${ac_cv_prog_lex_yytext_pointer+:} false; then : - $as_echo_n "(cached) " >&6 -else - # POSIX says lex can declare yytext either as a pointer or an array; the -# default is implementation-dependent. Figure out which it is, since -# not all implementations provide the %pointer and %array declarations. -ac_cv_prog_lex_yytext_pointer=no -ac_save_LIBS=$LIBS -LIBS="$LEXLIB $ac_save_LIBS" -cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ - - #define YYTEXT_POINTER 1 -`cat $LEX_OUTPUT_ROOT.c` -_ACEOF -if ac_fn_c_try_link "$LINENO"; then : - ac_cv_prog_lex_yytext_pointer=yes -fi -rm -f core conftest.err conftest.$ac_objext \ - conftest$ac_exeext conftest.$ac_ext -LIBS=$ac_save_LIBS - -fi -{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_prog_lex_yytext_pointer" >&5 -$as_echo "$ac_cv_prog_lex_yytext_pointer" >&6; } -if test $ac_cv_prog_lex_yytext_pointer = yes; then - -$as_echo "#define YYTEXT_POINTER 1" >>confdefs.h - -fi -rm -f conftest.l $LEX_OUTPUT_ROOT.c - -fi -if test "$LEX" = :; then - LEX=${am_missing_run}flex -fi -for ac_prog in 'bison -y' byacc -do - # Extract the first word of "$ac_prog", so it can be a program name with args. -set dummy $ac_prog; ac_word=$2 -{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 -$as_echo_n "checking for $ac_word... " >&6; } -if ${ac_cv_prog_YACC+:} false; then : - $as_echo_n "(cached) " >&6 -else - if test -n "$YACC"; then - ac_cv_prog_YACC="$YACC" # Let the user override the test. -else -as_save_IFS=$IFS; IFS=$PATH_SEPARATOR -for as_dir in $PATH -do - IFS=$as_save_IFS - test -z "$as_dir" && as_dir=. - for ac_exec_ext in '' $ac_executable_extensions; do - if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then - ac_cv_prog_YACC="$ac_prog" - $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 - break 2 - fi -done - done -IFS=$as_save_IFS - -fi -fi -YACC=$ac_cv_prog_YACC -if test -n "$YACC"; then - { $as_echo "$as_me:${as_lineno-$LINENO}: result: $YACC" >&5 -$as_echo "$YACC" >&6; } -else - { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 -$as_echo "no" >&6; } -fi - - - test -n "$YACC" && break -done -test -n "$YACC" || YACC="yacc" - - -# only GNU Bison 3+ is supported, so drop yacc-compatibility warnings -# TODO: check for Bison 3+ here -{ $as_echo "$as_me:${as_lineno-$LINENO}: checking how to disable yacc compatibility warnings" >&5 -$as_echo_n "checking how to disable yacc compatibility warnings... " >&6; } -case "$YACC $YFLAGS $AM_YFLAGS" in - *-Wno-yacc*) - { $as_echo "$as_me:${as_lineno-$LINENO}: result: already specified" >&5 -$as_echo "already specified" >&6; } - ;; - *-Wyacc*) - { $as_echo "$as_me:${as_lineno-$LINENO}: result: explicit enabled" >&5 -$as_echo "explicit enabled" >&6; } - ;; - *) - $YACC $AM_YFLAGS $YFLAGS -Wno-yacc -V 1>/dev/null 2>&1 - if test $? -eq 0; then - { $as_echo "$as_me:${as_lineno-$LINENO}: result: -Wno-yacc" >&5 -$as_echo "-Wno-yacc" >&6; } - if test -z "$YFLAGS"; then - YFLAGS="-Wno-yacc" - else - YFLAGS="$YFLAGS -Wno-yacc" - fi - else - { $as_echo "$as_me:${as_lineno-$LINENO}: result: not supported" >&5 -$as_echo "not supported" >&6; } - fi - ;; -esac - - -{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for diff arguments" >&5 -$as_echo_n "checking for diff arguments... " >&6; } -case "$DIFF_FLAGS" in - *--strip-trailing-cr*) - { $as_echo "$as_me:${as_lineno-$LINENO}: result: specified as $DIFF_FLAGS" >&5 -$as_echo "specified as $DIFF_FLAGS" >&6; } - ;; - *) - diff $DIFF_FLAGS --strip-trailing-cr --version 1>/dev/null 2>&1 - if test $? -eq 0; then - if test -z "$DIFF_FLAGS"; then - DIFF_FLAGS="--strip-trailing-cr" - else - DIFF_FLAGS="$DIFF_FLAGS --strip-trailing-cr" - fi - { $as_echo "$as_me:${as_lineno-$LINENO}: result: $DIFF_FLAGS" >&5 -$as_echo "$DIFF_FLAGS" >&6; } - else - { $as_echo "$as_me:${as_lineno-$LINENO}: result: not supported" >&5 -$as_echo "not supported" >&6; } - fi - ;; -esac - - -# Stop tests for C++ and Fortran - - -{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether ln -s works" >&5 -$as_echo_n "checking whether ln -s works... " >&6; } -LN_S=$as_ln_s -if test "$LN_S" = "ln -s"; then - { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5 -$as_echo "yes" >&6; } -else - { $as_echo "$as_me:${as_lineno-$LINENO}: result: no, using $LN_S" >&5 -$as_echo "no, using $LN_S" >&6; } -fi - - - -# AC_LIBTOOL_DLOPEN -# AC_LIBTOOL_WIN32_DLL -# AC_PROG_LIBTOOL - -{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether ${MAKE-make} sets \$(MAKE)" >&5 -$as_echo_n "checking whether ${MAKE-make} sets \$(MAKE)... " >&6; } -set x ${MAKE-make} -ac_make=`$as_echo "$2" | sed 's/+/p/g; s/[^a-zA-Z0-9_]/_/g'` -if eval \${ac_cv_prog_make_${ac_make}_set+:} false; then : - $as_echo_n "(cached) " >&6 -else - cat >conftest.make <<\_ACEOF -SHELL = /bin/sh -all: - @echo '@@@%%%=$(MAKE)=@@@%%%' -_ACEOF -# GNU make sometimes prints "make[1]: Entering ...", which would confuse us. -case `${MAKE-make} -f conftest.make 2>/dev/null` in - *@@@%%%=?*=@@@%%%*) - eval ac_cv_prog_make_${ac_make}_set=yes;; - *) - eval ac_cv_prog_make_${ac_make}_set=no;; -esac -rm -f conftest.make -fi -if eval test \$ac_cv_prog_make_${ac_make}_set = yes; then - { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5 -$as_echo "yes" >&6; } - SET_MAKE= -else - { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 -$as_echo "no" >&6; } - SET_MAKE="MAKE=${MAKE-make}" -fi - - - -# Check whether --with-gnu-ld was given. -if test "${with_gnu_ld+set}" = set; then : - withval=$with_gnu_ld; test "$withval" = no || with_gnu_ld=yes -else - with_gnu_ld=no -fi - -# Prepare PATH_SEPARATOR. -# The user is always right. -if test "${PATH_SEPARATOR+set}" != set; then - # Determine PATH_SEPARATOR by trying to find /bin/sh in a PATH which - # contains only /bin. Note that ksh looks also at the FPATH variable, - # so we have to set that as well for the test. - PATH_SEPARATOR=: - (PATH='/bin;/bin'; FPATH=$PATH; sh -c :) >/dev/null 2>&1 \ - && { (PATH='/bin:/bin'; FPATH=$PATH; sh -c :) >/dev/null 2>&1 \ - || PATH_SEPARATOR=';' - } -fi - -ac_prog=ld -if test "$GCC" = yes; then - # Check if gcc -print-prog-name=ld gives a path. - { $as_echo "$as_me:${as_lineno-$LINENO}: checking for ld used by $CC" >&5 -$as_echo_n "checking for ld used by $CC... " >&6; } - case $host in - *-*-mingw*) - # gcc leaves a trailing carriage return which upsets mingw - ac_prog=`($CC -print-prog-name=ld) 2>&5 | tr -d '\015'` ;; - *) - ac_prog=`($CC -print-prog-name=ld) 2>&5` ;; - esac - case $ac_prog in - # Accept absolute paths. - [\\/]* | ?:[\\/]*) - re_direlt='/[^/][^/]*/\.\./' - # Canonicalize the pathname of ld - ac_prog=`echo "$ac_prog"| sed 's%\\\\%/%g'` - while echo "$ac_prog" | grep "$re_direlt" > /dev/null 2>&1; do - ac_prog=`echo $ac_prog| sed "s%$re_direlt%/%"` - done - test -z "$LD" && LD="$ac_prog" - ;; - "") - # If it fails, then pretend we aren't using GCC. - ac_prog=ld - ;; - *) - # If it is relative, then search for the first ld in PATH. - with_gnu_ld=unknown - ;; - esac -elif test "$with_gnu_ld" = yes; then - { $as_echo "$as_me:${as_lineno-$LINENO}: checking for GNU ld" >&5 -$as_echo_n "checking for GNU ld... " >&6; } -else - { $as_echo "$as_me:${as_lineno-$LINENO}: checking for non-GNU ld" >&5 -$as_echo_n "checking for non-GNU ld... " >&6; } -fi -if ${acl_cv_path_LD+:} false; then : - $as_echo_n "(cached) " >&6 -else - if test -z "$LD"; then - acl_save_ifs="$IFS"; IFS=$PATH_SEPARATOR - for ac_dir in $PATH; do - IFS="$acl_save_ifs" - test -z "$ac_dir" && ac_dir=. - if test -f "$ac_dir/$ac_prog" || test -f "$ac_dir/$ac_prog$ac_exeext"; then - acl_cv_path_LD="$ac_dir/$ac_prog" - # Check to see if the program is GNU ld. I'd rather use --version, - # but apparently some variants of GNU ld only accept -v. - # Break only if it was the GNU/non-GNU ld that we prefer. - case `"$acl_cv_path_LD" -v 2>&1 &5 -$as_echo "$LD" >&6; } -else - { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 -$as_echo "no" >&6; } -fi -test -z "$LD" && as_fn_error $? "no acceptable ld found in \$PATH" "$LINENO" 5 -{ $as_echo "$as_me:${as_lineno-$LINENO}: checking if the linker ($LD) is GNU ld" >&5 -$as_echo_n "checking if the linker ($LD) is GNU ld... " >&6; } -if ${acl_cv_prog_gnu_ld+:} false; then : - $as_echo_n "(cached) " >&6 -else - # I'd rather use --version here, but apparently some GNU lds only accept -v. -case `$LD -v 2>&1 &5 -$as_echo "$acl_cv_prog_gnu_ld" >&6; } -with_gnu_ld=$acl_cv_prog_gnu_ld - - - - - { $as_echo "$as_me:${as_lineno-$LINENO}: checking for shared library run path origin" >&5 -$as_echo_n "checking for shared library run path origin... " >&6; } -if ${acl_cv_rpath+:} false; then : - $as_echo_n "(cached) " >&6 -else - - CC="$CC" GCC="$GCC" LDFLAGS="$LDFLAGS" LD="$LD" with_gnu_ld="$with_gnu_ld" \ - ${CONFIG_SHELL-/bin/sh} "$ac_aux_dir/config.rpath" "$host" > conftest.sh - . ./conftest.sh - rm -f ./conftest.sh - acl_cv_rpath=done - -fi -{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $acl_cv_rpath" >&5 -$as_echo "$acl_cv_rpath" >&6; } - wl="$acl_cv_wl" - acl_libext="$acl_cv_libext" - acl_shlibext="$acl_cv_shlibext" - acl_libname_spec="$acl_cv_libname_spec" - acl_library_names_spec="$acl_cv_library_names_spec" - acl_hardcode_libdir_flag_spec="$acl_cv_hardcode_libdir_flag_spec" - acl_hardcode_libdir_separator="$acl_cv_hardcode_libdir_separator" - acl_hardcode_direct="$acl_cv_hardcode_direct" - acl_hardcode_minus_L="$acl_cv_hardcode_minus_L" - # Check whether --enable-rpath was given. -if test "${enable_rpath+set}" = set; then : - enableval=$enable_rpath; : -else - enable_rpath=yes -fi - - - - -# Checks for header files. -{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for ANSI C header files" >&5 -$as_echo_n "checking for ANSI C header files... " >&6; } -if ${ac_cv_header_stdc+:} false; then : - $as_echo_n "(cached) " >&6 -else - cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ -#include -#include -#include -#include - -int -main () -{ - - ; - return 0; -} -_ACEOF -if ac_fn_c_try_compile "$LINENO"; then : - ac_cv_header_stdc=yes -else - ac_cv_header_stdc=no -fi -rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext - -if test $ac_cv_header_stdc = yes; then - # SunOS 4.x string.h does not declare mem*, contrary to ANSI. - cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ -#include - -_ACEOF -if (eval "$ac_cpp conftest.$ac_ext") 2>&5 | - $EGREP "memchr" >/dev/null 2>&1; then : - -else - ac_cv_header_stdc=no -fi -rm -f conftest* - -fi - -if test $ac_cv_header_stdc = yes; then - # ISC 2.0.2 stdlib.h does not declare free, contrary to ANSI. - cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ -#include - -_ACEOF -if (eval "$ac_cpp conftest.$ac_ext") 2>&5 | - $EGREP "free" >/dev/null 2>&1; then : - -else - ac_cv_header_stdc=no -fi -rm -f conftest* - -fi - -if test $ac_cv_header_stdc = yes; then - # /bin/cc in Irix-4.0.5 gets non-ANSI ctype macros unless using -ansi. - if test "$cross_compiling" = yes; then : - : -else - cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ -#include -#include -#if ((' ' & 0x0FF) == 0x020) -# define ISLOWER(c) ('a' <= (c) && (c) <= 'z') -# define TOUPPER(c) (ISLOWER(c) ? 'A' + ((c) - 'a') : (c)) -#else -# define ISLOWER(c) \ - (('a' <= (c) && (c) <= 'i') \ - || ('j' <= (c) && (c) <= 'r') \ - || ('s' <= (c) && (c) <= 'z')) -# define TOUPPER(c) (ISLOWER(c) ? ((c) | 0x40) : (c)) -#endif - -#define XOR(e, f) (((e) && !(f)) || (!(e) && (f))) -int -main () -{ - int i; - for (i = 0; i < 256; i++) - if (XOR (islower (i), ISLOWER (i)) - || toupper (i) != TOUPPER (i)) - return 2; - return 0; -} -_ACEOF -if ac_fn_c_try_run "$LINENO"; then : - -else - ac_cv_header_stdc=no -fi -rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext \ - conftest.$ac_objext conftest.beam conftest.$ac_ext -fi - -fi -fi -{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_header_stdc" >&5 -$as_echo "$ac_cv_header_stdc" >&6; } -if test $ac_cv_header_stdc = yes; then - -$as_echo "#define STDC_HEADERS 1" >>confdefs.h - -fi - -for ac_header in stdint.h sys/types.h signal.h fcntl.h malloc.h locale.h \ - stddef.h wchar.h dlfcn.h sys/time.h sys/wait.h sys/sysmacros.h -do : - as_ac_Header=`$as_echo "ac_cv_header_$ac_header" | $as_tr_sh` -ac_fn_c_check_header_mongrel "$LINENO" "$ac_header" "$as_ac_Header" "$ac_includes_default" -if eval test \"x\$"$as_ac_Header"\" = x"yes"; then : - cat >>confdefs.h <<_ACEOF -#define `$as_echo "HAVE_$ac_header" | $as_tr_cpp` 1 -_ACEOF - -fi - -done - - - -# Checks for typedefs, structures, and compiler characteristics. -{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for an ANSI C-conforming const" >&5 -$as_echo_n "checking for an ANSI C-conforming const... " >&6; } -if ${ac_cv_c_const+:} false; then : - $as_echo_n "(cached) " >&6 -else - cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ - -int -main () -{ - -#ifndef __cplusplus - /* Ultrix mips cc rejects this sort of thing. */ - typedef int charset[2]; - const charset cs = { 0, 0 }; - /* SunOS 4.1.1 cc rejects this. */ - char const *const *pcpcc; - char **ppc; - /* NEC SVR4.0.2 mips cc rejects this. */ - struct point {int x, y;}; - static struct point const zero = {0,0}; - /* AIX XL C 1.02.0.0 rejects this. - It does not let you subtract one const X* pointer from another in - an arm of an if-expression whose if-part is not a constant - expression */ - const char *g = "string"; - pcpcc = &g + (g ? g-g : 0); - /* HPUX 7.0 cc rejects these. */ - ++pcpcc; - ppc = (char**) pcpcc; - pcpcc = (char const *const *) ppc; - { /* SCO 3.2v4 cc rejects this sort of thing. */ - char tx; - char *t = &tx; - char const *s = 0 ? (char *) 0 : (char const *) 0; - - *t++ = 0; - if (s) return 0; - } - { /* Someone thinks the Sun supposedly-ANSI compiler will reject this. */ - int x[] = {25, 17}; - const int *foo = &x[0]; - ++foo; - } - { /* Sun SC1.0 ANSI compiler rejects this -- but not the above. */ - typedef const int *iptr; - iptr p = 0; - ++p; - } - { /* AIX XL C 1.02.0.0 rejects this sort of thing, saying - "k.c", line 2.27: 1506-025 (S) Operand must be a modifiable lvalue. */ - struct s { int j; const int *ap[3]; } bx; - struct s *b = &bx; b->j = 5; - } - { /* ULTRIX-32 V3.1 (Rev 9) vcc rejects this */ - const int foo = 10; - if (!foo) return 0; - } - return !cs[0] && !zero.x; -#endif - - ; - return 0; -} -_ACEOF -if ac_fn_c_try_compile "$LINENO"; then : - ac_cv_c_const=yes -else - ac_cv_c_const=no -fi -rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext -fi -{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_c_const" >&5 -$as_echo "$ac_cv_c_const" >&6; } -if test $ac_cv_c_const = no; then - -$as_echo "#define const /**/" >>confdefs.h - -fi - - { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether byte ordering is bigendian" >&5 -$as_echo_n "checking whether byte ordering is bigendian... " >&6; } -if ${ac_cv_c_bigendian+:} false; then : - $as_echo_n "(cached) " >&6 -else - ac_cv_c_bigendian=unknown - # See if we're dealing with a universal compiler. - cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ -#ifndef __APPLE_CC__ - not a universal capable compiler - #endif - typedef int dummy; - -_ACEOF -if ac_fn_c_try_compile "$LINENO"; then : - - # Check for potential -arch flags. It is not universal unless - # there are at least two -arch flags with different values. - ac_arch= - ac_prev= - for ac_word in $CC $CFLAGS $CPPFLAGS $LDFLAGS; do - if test -n "$ac_prev"; then - case $ac_word in - i?86 | x86_64 | ppc | ppc64) - if test -z "$ac_arch" || test "$ac_arch" = "$ac_word"; then - ac_arch=$ac_word - else - ac_cv_c_bigendian=universal - break - fi - ;; - esac - ac_prev= - elif test "x$ac_word" = "x-arch"; then - ac_prev=arch - fi - done -fi -rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext - if test $ac_cv_c_bigendian = unknown; then - # See if sys/param.h defines the BYTE_ORDER macro. - cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ -#include - #include - -int -main () -{ -#if ! (defined BYTE_ORDER && defined BIG_ENDIAN \ - && defined LITTLE_ENDIAN && BYTE_ORDER && BIG_ENDIAN \ - && LITTLE_ENDIAN) - bogus endian macros - #endif - - ; - return 0; -} -_ACEOF -if ac_fn_c_try_compile "$LINENO"; then : - # It does; now see whether it defined to BIG_ENDIAN or not. - cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ -#include - #include - -int -main () -{ -#if BYTE_ORDER != BIG_ENDIAN - not big endian - #endif - - ; - return 0; -} -_ACEOF -if ac_fn_c_try_compile "$LINENO"; then : - ac_cv_c_bigendian=yes -else - ac_cv_c_bigendian=no -fi -rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext -fi -rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext - fi - if test $ac_cv_c_bigendian = unknown; then - # See if defines _LITTLE_ENDIAN or _BIG_ENDIAN (e.g., Solaris). - cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ -#include - -int -main () -{ -#if ! (defined _LITTLE_ENDIAN || defined _BIG_ENDIAN) - bogus endian macros - #endif - - ; - return 0; -} -_ACEOF -if ac_fn_c_try_compile "$LINENO"; then : - # It does; now see whether it defined to _BIG_ENDIAN or not. - cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ -#include - -int -main () -{ -#ifndef _BIG_ENDIAN - not big endian - #endif - - ; - return 0; -} -_ACEOF -if ac_fn_c_try_compile "$LINENO"; then : - ac_cv_c_bigendian=yes -else - ac_cv_c_bigendian=no -fi -rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext -fi -rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext - fi - if test $ac_cv_c_bigendian = unknown; then - # Compile a test program. - if test "$cross_compiling" = yes; then : - # Try to guess by grepping values from an object file. - cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ -short int ascii_mm[] = - { 0x4249, 0x4765, 0x6E44, 0x6961, 0x6E53, 0x7953, 0 }; - short int ascii_ii[] = - { 0x694C, 0x5454, 0x656C, 0x6E45, 0x6944, 0x6E61, 0 }; - int use_ascii (int i) { - return ascii_mm[i] + ascii_ii[i]; - } - short int ebcdic_ii[] = - { 0x89D3, 0xE3E3, 0x8593, 0x95C5, 0x89C4, 0x9581, 0 }; - short int ebcdic_mm[] = - { 0xC2C9, 0xC785, 0x95C4, 0x8981, 0x95E2, 0xA8E2, 0 }; - int use_ebcdic (int i) { - return ebcdic_mm[i] + ebcdic_ii[i]; - } - extern int foo; - -int -main () -{ -return use_ascii (foo) == use_ebcdic (foo); - ; - return 0; -} -_ACEOF -if ac_fn_c_try_compile "$LINENO"; then : - if grep BIGenDianSyS conftest.$ac_objext >/dev/null; then - ac_cv_c_bigendian=yes - fi - if grep LiTTleEnDian conftest.$ac_objext >/dev/null ; then - if test "$ac_cv_c_bigendian" = unknown; then - ac_cv_c_bigendian=no - else - # finding both strings is unlikely to happen, but who knows? - ac_cv_c_bigendian=unknown - fi - fi -fi -rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext -else - cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ -$ac_includes_default -int -main () -{ - - /* Are we little or big endian? From Harbison&Steele. */ - union - { - long int l; - char c[sizeof (long int)]; - } u; - u.l = 1; - return u.c[sizeof (long int) - 1] == 1; - - ; - return 0; -} -_ACEOF -if ac_fn_c_try_run "$LINENO"; then : - ac_cv_c_bigendian=no -else - ac_cv_c_bigendian=yes -fi -rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext \ - conftest.$ac_objext conftest.beam conftest.$ac_ext -fi - - fi -fi -{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_c_bigendian" >&5 -$as_echo "$ac_cv_c_bigendian" >&6; } - case $ac_cv_c_bigendian in #( - yes) - $as_echo "#define WORDS_BIGENDIAN 1" >>confdefs.h -;; #( - no) - ;; #( - universal) - -$as_echo "#define AC_APPLE_UNIVERSAL_BUILD 1" >>confdefs.h - - ;; #( - *) - as_fn_error $? "unknown endianness - presetting ac_cv_c_bigendian=no (or yes) will help" "$LINENO" 5 ;; - esac - -ac_fn_c_check_type "$LINENO" "size_t" "ac_cv_type_size_t" "$ac_includes_default" -if test "x$ac_cv_type_size_t" = xyes; then : - -else - -cat >>confdefs.h <<_ACEOF -#define size_t unsigned int -_ACEOF - -fi - -{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether struct tm is in sys/time.h or time.h" >&5 -$as_echo_n "checking whether struct tm is in sys/time.h or time.h... " >&6; } -if ${ac_cv_struct_tm+:} false; then : - $as_echo_n "(cached) " >&6 -else - cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ -#include -#include - -int -main () -{ -struct tm tm; - int *p = &tm.tm_sec; - return !p; - ; - return 0; -} -_ACEOF -if ac_fn_c_try_compile "$LINENO"; then : - ac_cv_struct_tm=time.h -else - ac_cv_struct_tm=sys/time.h -fi -rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext -fi -{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_struct_tm" >&5 -$as_echo "$ac_cv_struct_tm" >&6; } -if test $ac_cv_struct_tm = sys/time.h; then - -$as_echo "#define TM_IN_SYS_TIME 1" >>confdefs.h - -fi - -ac_fn_c_check_type "$LINENO" "sig_atomic_t" "ac_cv_type_sig_atomic_t" "#include -" -if test "x$ac_cv_type_sig_atomic_t" = xyes; then : - -cat >>confdefs.h <<_ACEOF -#define HAVE_SIG_ATOMIC_T 1 -_ACEOF - - -fi - - -# Don't use AC_C_INLINE here. We need the value - -{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for inline keyword" >&5 -$as_echo_n "checking for inline keyword... " >&6; } -for cob_keyw in __inline __inline__ inline -do - cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ - - #ifndef __cplusplus - typedef int foo_t; - static $cob_keyw foo_t foo () { return 0; } - #endif -int -main () -{ - - #ifndef __cplusplus - return foo (); - #else - choke me - #endif - ; - return 0; -} -_ACEOF -if ac_fn_c_try_compile "$LINENO"; then : - cat >>confdefs.h <<_ACEOF -#define COB_KEYWORD_INLINE $cob_keyw -_ACEOF - break -fi -rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext -done -{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $cob_keyw" >&5 -$as_echo "$cob_keyw" >&6; } -unset cob_keyw - - -# Checks for library functions. -for ac_func in vprintf -do : - ac_fn_c_check_func "$LINENO" "vprintf" "ac_cv_func_vprintf" -if test "x$ac_cv_func_vprintf" = xyes; then : - cat >>confdefs.h <<_ACEOF -#define HAVE_VPRINTF 1 -_ACEOF - -ac_fn_c_check_func "$LINENO" "_doprnt" "ac_cv_func__doprnt" -if test "x$ac_cv_func__doprnt" = xyes; then : - -$as_echo "#define HAVE_DOPRNT 1" >>confdefs.h - -fi - -fi -done - - -for ac_func in memmove memset setlocale fcntl strerror strcasecmp \ - strchr strrchr strdup strstr atol strtol atoll strtoll gettimeofday localeconv \ - getexecname canonicalize_file_name popen raise readlink realpath \ - setenv strcoll -do : - as_ac_var=`$as_echo "ac_cv_func_$ac_func" | $as_tr_sh` -ac_fn_c_check_func "$LINENO" "$ac_func" "$as_ac_var" -if eval test \"x\$"$as_ac_var"\" = x"yes"; then : - cat >>confdefs.h <<_ACEOF -#define `$as_echo "HAVE_$ac_func" | $as_tr_cpp` 1 -_ACEOF - -fi -done - - -# Check for timezone -{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for timezone variable access" >&5 -$as_echo_n "checking for timezone variable access... " >&6; } -cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ -#include -int -main () -{ -timezone = 3600; - ; - return 0; -} -_ACEOF -if ac_fn_c_try_compile "$LINENO"; then : - $as_echo "#define HAVE_TIMEZONE 1" >>confdefs.h - - { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5 -$as_echo "yes" >&6; } -else - { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 -$as_echo "no" >&6; } -fi -rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext - -# Check for designated initializers -{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for designated initializers" >&5 -$as_echo_n "checking for designated initializers... " >&6; } -cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ -#include -int -main () -{ -static const unsigned char valid_char[256] = { - ['0'] = 1, - ['1'] = 1 }; - - ; - return 0; -} -_ACEOF -if ac_fn_c_try_compile "$LINENO"; then : - $as_echo "#define HAVE_DESIGNATED_INITS 1" >>confdefs.h - { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5 -$as_echo "yes" >&6; } -else - { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 -$as_echo "no" >&6; } -fi -rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext - -# Check gcc/icc/clang -COB_USES_GCC="no" -COB_USES_GCC_NO_ICC="no" -COB_USES_ICC_ONLY="no" -COB_USES_CLANG_ONLY="no" -COB_USES_XLC_ONLY="no" -COB_USES_WATCOMC_ONLY="no" - -{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for __GNUC__" >&5 -$as_echo_n "checking for __GNUC__... " >&6; } -cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ - - #ifndef __GNUC__ - # error macro not defined - #endif -_ACEOF -if ac_fn_c_try_compile "$LINENO"; then : - COB_USES_GCC="yes" - { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5 -$as_echo "yes" >&6; } -else - { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 -$as_echo "no" >&6; } -fi -rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext - -{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for __INTEL_COMPILER" >&5 -$as_echo_n "checking for __INTEL_COMPILER... " >&6; } -cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ - - #ifndef __INTEL_COMPILER - # error macro not defined - #endif -_ACEOF -if ac_fn_c_try_compile "$LINENO"; then : - COB_USES_ICC_ONLY=yes - { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5 -$as_echo "yes" >&6; } -else - if test "$COB_USES_GCC" = "yes"; then - COB_USES_GCC_NO_ICC="yes" - fi - { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 -$as_echo "no" >&6; } - -fi -rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext - -{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for __clang__" >&5 -$as_echo_n "checking for __clang__... " >&6; } -cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ - - #ifndef __clang__ - # error macro not defined - #endif -_ACEOF -if ac_fn_c_try_compile "$LINENO"; then : - COB_USES_CLANG_ONLY="yes" - { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5 -$as_echo "yes" >&6; } -else - { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 -$as_echo "no" >&6; } -fi -rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext - -{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for __xlc__" >&5 -$as_echo_n "checking for __xlc__... " >&6; } -cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ - - #ifndef __xlc__ - # error macro not defined - #endif -_ACEOF -if ac_fn_c_try_compile "$LINENO"; then : - COB_USES_XLC_ONLY="yes" - { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5 -$as_echo "yes" >&6; } -else - { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 -$as_echo "no" >&6; } -fi -rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext - -{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for __WATCOMC__" >&5 -$as_echo_n "checking for __WATCOMC__... " >&6; } -cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ - - #ifndef __WATCOMC__ - # error macro not defined - #endif -_ACEOF -if ac_fn_c_try_compile "$LINENO"; then : - COB_USES_WATCOMC_ONLY="yes" - { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5 -$as_echo "yes" >&6; } -else - { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 -$as_echo "no" >&6; } -fi -rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext - -if test "x$COB_CC" = "x"; then - COB_CC="$CC" -fi - -if test "$COB_USES_ICC_ONLY" = "yes"; then - LIBCOB_LIBS="-limf -lm" -else - # FIXME: -lm should only be used if needed (which it often is not), see Bug #559 - LIBCOB_LIBS="-lm" -fi - -# Add --enable-code-coverage and test for code-coverage tools if enabled - - - - # allow to override gcov location - -# Check whether --with-gcov was given. -if test "${with_gcov+set}" = set; then : - withval=$with_gcov; _AX_CODE_COVERAGE_GCOV_PROG_WITH=$with_gcov -else - _AX_CODE_COVERAGE_GCOV_PROG_WITH=gcov -fi - - - { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether to build with code coverage support" >&5 -$as_echo_n "checking whether to build with code coverage support... " >&6; } - # Check whether --enable-code-coverage was given. -if test "${enable_code_coverage+set}" = set; then : - enableval=$enable_code_coverage; -else - enable_code_coverage=no -fi - - - if test x$enable_code_coverage = xyes; then - CODE_COVERAGE_ENABLED_TRUE= - CODE_COVERAGE_ENABLED_FALSE='#' -else - CODE_COVERAGE_ENABLED_TRUE='#' - CODE_COVERAGE_ENABLED_FALSE= -fi - - CODE_COVERAGE_ENABLED=$enable_code_coverage - - { $as_echo "$as_me:${as_lineno-$LINENO}: result: $enable_code_coverage" >&5 -$as_echo "$enable_code_coverage" >&6; } - - if test "$enable_code_coverage" = "yes" ; then : - - # check for gcov - if test -n "$ac_tool_prefix"; then - # Extract the first word of "${ac_tool_prefix}$_AX_CODE_COVERAGE_GCOV_PROG_WITH", so it can be a program name with args. -set dummy ${ac_tool_prefix}$_AX_CODE_COVERAGE_GCOV_PROG_WITH; ac_word=$2 -{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 -$as_echo_n "checking for $ac_word... " >&6; } -if ${ac_cv_prog_GCOV+:} false; then : - $as_echo_n "(cached) " >&6 -else - if test -n "$GCOV"; then - ac_cv_prog_GCOV="$GCOV" # Let the user override the test. -else -as_save_IFS=$IFS; IFS=$PATH_SEPARATOR -for as_dir in $PATH -do - IFS=$as_save_IFS - test -z "$as_dir" && as_dir=. - for ac_exec_ext in '' $ac_executable_extensions; do - if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then - ac_cv_prog_GCOV="${ac_tool_prefix}$_AX_CODE_COVERAGE_GCOV_PROG_WITH" - $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 - break 2 - fi -done - done -IFS=$as_save_IFS - -fi -fi -GCOV=$ac_cv_prog_GCOV -if test -n "$GCOV"; then - { $as_echo "$as_me:${as_lineno-$LINENO}: result: $GCOV" >&5 -$as_echo "$GCOV" >&6; } -else - { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 -$as_echo "no" >&6; } -fi - - -fi -if test -z "$ac_cv_prog_GCOV"; then - ac_ct_GCOV=$GCOV - # Extract the first word of "$_AX_CODE_COVERAGE_GCOV_PROG_WITH", so it can be a program name with args. -set dummy $_AX_CODE_COVERAGE_GCOV_PROG_WITH; ac_word=$2 -{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 -$as_echo_n "checking for $ac_word... " >&6; } -if ${ac_cv_prog_ac_ct_GCOV+:} false; then : - $as_echo_n "(cached) " >&6 -else - if test -n "$ac_ct_GCOV"; then - ac_cv_prog_ac_ct_GCOV="$ac_ct_GCOV" # Let the user override the test. -else -as_save_IFS=$IFS; IFS=$PATH_SEPARATOR -for as_dir in $PATH -do - IFS=$as_save_IFS - test -z "$as_dir" && as_dir=. - for ac_exec_ext in '' $ac_executable_extensions; do - if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then - ac_cv_prog_ac_ct_GCOV="$_AX_CODE_COVERAGE_GCOV_PROG_WITH" - $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 - break 2 - fi -done - done -IFS=$as_save_IFS - -fi -fi -ac_ct_GCOV=$ac_cv_prog_ac_ct_GCOV -if test -n "$ac_ct_GCOV"; then - { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_ct_GCOV" >&5 -$as_echo "$ac_ct_GCOV" >&6; } -else - { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 -$as_echo "no" >&6; } -fi - - if test "x$ac_ct_GCOV" = x; then - GCOV=":" - else - case $cross_compiling:$ac_tool_warned in -yes:) -{ $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5 -$as_echo "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;} -ac_tool_warned=yes ;; -esac - GCOV=$ac_ct_GCOV - fi -else - GCOV="$ac_cv_prog_GCOV" -fi - - if test "X$GCOV" = "X:"; then : - as_fn_error $? "gcov is needed to do coverage" "$LINENO" 5 -fi - - - if test "$GCC" = "no" ; then : - - as_fn_error $? "not compiling with gcc, which is required for gcov code coverage" "$LINENO" 5 - -fi - - # Extract the first word of "lcov", so it can be a program name with args. -set dummy lcov; ac_word=$2 -{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 -$as_echo_n "checking for $ac_word... " >&6; } -if ${ac_cv_prog_LCOV+:} false; then : - $as_echo_n "(cached) " >&6 -else - if test -n "$LCOV"; then - ac_cv_prog_LCOV="$LCOV" # Let the user override the test. -else -as_save_IFS=$IFS; IFS=$PATH_SEPARATOR -for as_dir in $PATH -do - IFS=$as_save_IFS - test -z "$as_dir" && as_dir=. - for ac_exec_ext in '' $ac_executable_extensions; do - if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then - ac_cv_prog_LCOV="lcov" - $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 - break 2 - fi -done - done -IFS=$as_save_IFS - -fi -fi -LCOV=$ac_cv_prog_LCOV -if test -n "$LCOV"; then - { $as_echo "$as_me:${as_lineno-$LINENO}: result: $LCOV" >&5 -$as_echo "$LCOV" >&6; } -else - { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 -$as_echo "no" >&6; } -fi - - - # Extract the first word of "genhtml", so it can be a program name with args. -set dummy genhtml; ac_word=$2 -{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 -$as_echo_n "checking for $ac_word... " >&6; } -if ${ac_cv_prog_GENHTML+:} false; then : - $as_echo_n "(cached) " >&6 -else - if test -n "$GENHTML"; then - ac_cv_prog_GENHTML="$GENHTML" # Let the user override the test. -else -as_save_IFS=$IFS; IFS=$PATH_SEPARATOR -for as_dir in $PATH -do - IFS=$as_save_IFS - test -z "$as_dir" && as_dir=. - for ac_exec_ext in '' $ac_executable_extensions; do - if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then - ac_cv_prog_GENHTML="genhtml" - $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 - break 2 - fi -done - done -IFS=$as_save_IFS - -fi -fi -GENHTML=$ac_cv_prog_GENHTML -if test -n "$GENHTML"; then - { $as_echo "$as_me:${as_lineno-$LINENO}: result: $GENHTML" >&5 -$as_echo "$GENHTML" >&6; } -else - { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 -$as_echo "no" >&6; } -fi - - - - if test -z "$LCOV" ; then : - - as_fn_error $? "To enable code coverage reporting you must have lcov installed" "$LINENO" 5 - -fi - - if test -z "$GENHTML" ; then : - - as_fn_error $? "Could not find genhtml from the lcov package" "$LINENO" 5 - -fi - - CODE_COVERAGE_CPPFLAGS="-DNDEBUG" - CODE_COVERAGE_CFLAGS="-O0 -g -fprofile-arcs -ftest-coverage" - CODE_COVERAGE_CXXFLAGS="-O0 -g -fprofile-arcs -ftest-coverage" - CODE_COVERAGE_LIBS="-lgcov" - CODE_COVERAGE_LDFLAGS="$CODE_COVERAGE_LIBS" - - - - - - - - CODE_COVERAGE_RULES_CHECK=' - -$(A''M_V_at)$(MAKE) $(AM_MAKEFLAGS) -k check - $(A''M_V_at)$(MAKE) $(AM_MAKEFLAGS) code-coverage-capture -' - CODE_COVERAGE_RULES_CAPTURE=' - $(code_coverage_v_lcov_cap)$(LCOV) $(code_coverage_quiet) $(addprefix --directory ,$(CODE_COVERAGE_DIRECTORY)) --capture --output-file "$(CODE_COVERAGE_OUTPUT_FILE).tmp" --test-name "$(call code_coverage_sanitize,$(PACKAGE_NAME)-$(PACKAGE_VERSION))" --no-checksum --compat-libtool $(CODE_COVERAGE_LCOV_SHOPTS) $(CODE_COVERAGE_LCOV_OPTIONS) - $(code_coverage_v_lcov_ign)$(LCOV) $(code_coverage_quiet) $(addprefix --directory ,$(CODE_COVERAGE_DIRECTORY)) --remove "$(CODE_COVERAGE_OUTPUT_FILE).tmp" "/tmp/*" $(CODE_COVERAGE_IGNORE_PATTERN) --output-file "$(CODE_COVERAGE_OUTPUT_FILE)" $(CODE_COVERAGE_LCOV_SHOPTS) $(CODE_COVERAGE_LCOV_RMOPTS) - -@rm -f $(CODE_COVERAGE_OUTPUT_FILE).tmp - $(code_coverage_v_genhtml)LANG=C $(GENHTML) $(code_coverage_quiet) $(addprefix --prefix ,$(CODE_COVERAGE_DIRECTORY)) --output-directory "$(CODE_COVERAGE_OUTPUT_DIRECTORY)" --title "$(PACKAGE_NAME)-$(PACKAGE_VERSION) Code Coverage" --legend --show-details "$(CODE_COVERAGE_OUTPUT_FILE)" $(CODE_COVERAGE_GENHTML_OPTIONS) - @echo "file://$(abs_builddir)/$(CODE_COVERAGE_OUTPUT_DIRECTORY)/index.html" -' - CODE_COVERAGE_RULES_CLEAN=' -clean: code-coverage-clean -distclean: code-coverage-clean -code-coverage-clean: - -$(LCOV) --directory $(top_builddir) -z - -rm -rf $(CODE_COVERAGE_OUTPUT_FILE) $(CODE_COVERAGE_OUTPUT_FILE).tmp $(CODE_COVERAGE_OUTPUT_DIRECTORY) - -find . \( -name "*.gcda" -o -name "*.gcno" -o -name "*.gcov" \) -delete -' - -else - - CODE_COVERAGE_RULES_CHECK=' - @echo "Need to reconfigure with --enable-code-coverage" -' - CODE_COVERAGE_RULES_CAPTURE="$CODE_COVERAGE_RULES_CHECK" - CODE_COVERAGE_RULES_CLEAN='' - -fi - -CODE_COVERAGE_RULES=' -# Code coverage -# -# Optional: -# - CODE_COVERAGE_DIRECTORY: Top-level directory for code coverage reporting. -# Multiple directories may be specified, separated by whitespace. -# (Default: $(top_builddir)) -# - CODE_COVERAGE_OUTPUT_FILE: Filename and path for the .info file generated -# by lcov for code coverage. (Default: -# $(PACKAGE_NAME)-$(PACKAGE_VERSION)-coverage.info) -# - CODE_COVERAGE_OUTPUT_DIRECTORY: Directory for generated code coverage -# reports to be created. (Default: -# $(PACKAGE_NAME)-$(PACKAGE_VERSION)-coverage) -# - CODE_COVERAGE_BRANCH_COVERAGE: Set to 1 to enforce branch coverage, -# set to 0 to disable it and leave empty to stay with the default. -# (Default: empty) -# - CODE_COVERAGE_LCOV_SHOPTS_DEFAULT: Extra options shared between both lcov -# instances. (Default: based on $CODE_COVERAGE_BRANCH_COVERAGE) -# - CODE_COVERAGE_LCOV_SHOPTS: Extra options to shared between both lcov -# instances. (Default: $CODE_COVERAGE_LCOV_SHOPTS_DEFAULT) -# - CODE_COVERAGE_LCOV_OPTIONS_GCOVPATH: --gcov-tool pathtogcov -# - CODE_COVERAGE_LCOV_OPTIONS_DEFAULT: Extra options to pass to the -# collecting lcov instance. (Default: $CODE_COVERAGE_LCOV_OPTIONS_GCOVPATH) -# - CODE_COVERAGE_LCOV_OPTIONS: Extra options to pass to the collecting lcov -# instance. (Default: $CODE_COVERAGE_LCOV_OPTIONS_DEFAULT) -# - CODE_COVERAGE_LCOV_RMOPTS_DEFAULT: Extra options to pass to the filtering -# lcov instance. (Default: empty) -# - CODE_COVERAGE_LCOV_RMOPTS: Extra options to pass to the filtering lcov -# instance. (Default: $CODE_COVERAGE_LCOV_RMOPTS_DEFAULT) -# - CODE_COVERAGE_GENHTML_OPTIONS_DEFAULT: Extra options to pass to the -# genhtml instance. (Default: based on $CODE_COVERAGE_BRANCH_COVERAGE) -# - CODE_COVERAGE_GENHTML_OPTIONS: Extra options to pass to the genhtml -# instance. (Default: $CODE_COVERAGE_GENHTML_OPTIONS_DEFAULT) -# - CODE_COVERAGE_IGNORE_PATTERN: Extra glob pattern of files to ignore -# -# The generated report will be titled using the $(PACKAGE_NAME) and -# $(PACKAGE_VERSION). In order to add the current git hash to the title, -# use the git-version-gen script, available online. - -# Optional variables -CODE_COVERAGE_DIRECTORY ?= $(top_builddir) -CODE_COVERAGE_OUTPUT_FILE ?= $(PACKAGE_NAME)-$(PACKAGE_VERSION)-coverage.info -CODE_COVERAGE_OUTPUT_DIRECTORY ?= $(PACKAGE_NAME)-$(PACKAGE_VERSION)-coverage -CODE_COVERAGE_BRANCH_COVERAGE ?= -CODE_COVERAGE_LCOV_SHOPTS_DEFAULT ?= $(if $(CODE_COVERAGE_BRANCH_COVERAGE),\ ---rc lcov_branch_coverage=$(CODE_COVERAGE_BRANCH_COVERAGE)) -CODE_COVERAGE_LCOV_SHOPTS ?= $(CODE_COVERAGE_LCOV_SHOPTS_DEFAULT) -CODE_COVERAGE_LCOV_OPTIONS_GCOVPATH ?= --gcov-tool "$(GCOV)" -CODE_COVERAGE_LCOV_OPTIONS_DEFAULT ?= $(CODE_COVERAGE_LCOV_OPTIONS_GCOVPATH) -CODE_COVERAGE_LCOV_OPTIONS ?= $(CODE_COVERAGE_LCOV_OPTIONS_DEFAULT) -CODE_COVERAGE_LCOV_RMOPTS_DEFAULT ?= -CODE_COVERAGE_LCOV_RMOPTS ?= $(CODE_COVERAGE_LCOV_RMOPTS_DEFAULT) -CODE_COVERAGE_GENHTML_OPTIONS_DEFAULT ?=\ -$(if $(CODE_COVERAGE_BRANCH_COVERAGE),\ ---rc genhtml_branch_coverage=$(CODE_COVERAGE_BRANCH_COVERAGE)) -CODE_COVERAGE_GENHTML_OPTIONS ?= $(CODE_COVERAGE_GENHTML_OPTIONS_DEFAULT) -CODE_COVERAGE_IGNORE_PATTERN ?= - -code_coverage_v_lcov_cap = $(code_coverage_v_lcov_cap_$(V)) -code_coverage_v_lcov_cap_ = $(code_coverage_v_lcov_cap_$(AM_DEFAULT_VERBOSITY)) -code_coverage_v_lcov_cap_0 = @echo " LCOV --capture"\ - $(CODE_COVERAGE_OUTPUT_FILE); -code_coverage_v_lcov_ign = $(code_coverage_v_lcov_ign_$(V)) -code_coverage_v_lcov_ign_ = $(code_coverage_v_lcov_ign_$(AM_DEFAULT_VERBOSITY)) -code_coverage_v_lcov_ign_0 = @echo " LCOV --remove /tmp/*"\ - $(CODE_COVERAGE_IGNORE_PATTERN); -code_coverage_v_genhtml = $(code_coverage_v_genhtml_$(V)) -code_coverage_v_genhtml_ = $(code_coverage_v_genhtml_$(AM_DEFAULT_VERBOSITY)) -code_coverage_v_genhtml_0 = @echo " GEN " $(CODE_COVERAGE_OUTPUT_DIRECTORY); -code_coverage_quiet = $(code_coverage_quiet_$(V)) -code_coverage_quiet_ = $(code_coverage_quiet_$(AM_DEFAULT_VERBOSITY)) -code_coverage_quiet_0 = --quiet - -# sanitizes the test-name: replaces with underscores: dashes and dots -code_coverage_sanitize = $(subst -,_,$(subst .,_,$(1))) - -# Use recursive makes in order to ignore errors during check -check-code-coverage:'"$CODE_COVERAGE_RULES_CHECK"' - -# Capture code coverage data -code-coverage-capture: code-coverage-capture-hook'"$CODE_COVERAGE_RULES_CAPTURE"' - -# Hook rule executed before code-coverage-capture, overridable by the user -code-coverage-capture-hook: - -'"$CODE_COVERAGE_RULES_CLEAN"' - -GITIGNOREFILES ?= -GITIGNOREFILES += $(CODE_COVERAGE_OUTPUT_FILE) $(CODE_COVERAGE_OUTPUT_DIRECTORY) - -A''M_DISTCHECK_CONFIGURE_FLAGS ?= -A''M_DISTCHECK_CONFIGURE_FLAGS += --disable-code-coverage - -.PHONY: check-code-coverage code-coverage-capture code-coverage-capture-hook code-coverage-clean -' - - - - - -if test "$COB_USES_GCC_NO_ICC" != yes -a "$enable_code_coverage" = "yes"; then - as_fn_error $? "Code coverage checks are only usable with GCC!" "$LINENO" 5 -fi - - -# set PKG_CONFIG to use (cross-compile aware) - - - - - - - -if test "x$ac_cv_env_PKG_CONFIG_set" != "xset"; then - if test -n "$ac_tool_prefix"; then - # Extract the first word of "${ac_tool_prefix}pkg-config", so it can be a program name with args. -set dummy ${ac_tool_prefix}pkg-config; ac_word=$2 -{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 -$as_echo_n "checking for $ac_word... " >&6; } -if ${ac_cv_path_PKG_CONFIG+:} false; then : - $as_echo_n "(cached) " >&6 -else - case $PKG_CONFIG in - [\\/]* | ?:[\\/]*) - ac_cv_path_PKG_CONFIG="$PKG_CONFIG" # Let the user override the test with a path. - ;; - *) - as_save_IFS=$IFS; IFS=$PATH_SEPARATOR -for as_dir in $PATH -do - IFS=$as_save_IFS - test -z "$as_dir" && as_dir=. - for ac_exec_ext in '' $ac_executable_extensions; do - if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then - ac_cv_path_PKG_CONFIG="$as_dir/$ac_word$ac_exec_ext" - $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 - break 2 - fi -done - done -IFS=$as_save_IFS - - ;; -esac -fi -PKG_CONFIG=$ac_cv_path_PKG_CONFIG -if test -n "$PKG_CONFIG"; then - { $as_echo "$as_me:${as_lineno-$LINENO}: result: $PKG_CONFIG" >&5 -$as_echo "$PKG_CONFIG" >&6; } -else - { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 -$as_echo "no" >&6; } -fi - - -fi -if test -z "$ac_cv_path_PKG_CONFIG"; then - ac_pt_PKG_CONFIG=$PKG_CONFIG - # Extract the first word of "pkg-config", so it can be a program name with args. -set dummy pkg-config; ac_word=$2 -{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 -$as_echo_n "checking for $ac_word... " >&6; } -if ${ac_cv_path_ac_pt_PKG_CONFIG+:} false; then : - $as_echo_n "(cached) " >&6 -else - case $ac_pt_PKG_CONFIG in - [\\/]* | ?:[\\/]*) - ac_cv_path_ac_pt_PKG_CONFIG="$ac_pt_PKG_CONFIG" # Let the user override the test with a path. - ;; - *) - as_save_IFS=$IFS; IFS=$PATH_SEPARATOR -for as_dir in $PATH -do - IFS=$as_save_IFS - test -z "$as_dir" && as_dir=. - for ac_exec_ext in '' $ac_executable_extensions; do - if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then - ac_cv_path_ac_pt_PKG_CONFIG="$as_dir/$ac_word$ac_exec_ext" - $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 - break 2 - fi -done - done -IFS=$as_save_IFS - - ;; -esac -fi -ac_pt_PKG_CONFIG=$ac_cv_path_ac_pt_PKG_CONFIG -if test -n "$ac_pt_PKG_CONFIG"; then - { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_pt_PKG_CONFIG" >&5 -$as_echo "$ac_pt_PKG_CONFIG" >&6; } -else - { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 -$as_echo "no" >&6; } -fi - - if test "x$ac_pt_PKG_CONFIG" = x; then - PKG_CONFIG="" - else - case $cross_compiling:$ac_tool_warned in -yes:) -{ $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5 -$as_echo "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;} -ac_tool_warned=yes ;; -esac - PKG_CONFIG=$ac_pt_PKG_CONFIG - fi -else - PKG_CONFIG="$ac_cv_path_PKG_CONFIG" -fi - -fi -if test -n "$PKG_CONFIG"; then - _pkg_min_version=0.9.0 - { $as_echo "$as_me:${as_lineno-$LINENO}: checking pkg-config is at least version $_pkg_min_version" >&5 -$as_echo_n "checking pkg-config is at least version $_pkg_min_version... " >&6; } - if $PKG_CONFIG --atleast-pkgconfig-version $_pkg_min_version; then - { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5 -$as_echo "yes" >&6; } - else - { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 -$as_echo "no" >&6; } - PKG_CONFIG="" - fi -fi - - -# Configure options part II (needing compilation) - -# Check whether --with-xml2 was given. -if test "${with_xml2+set}" = set; then : - withval=$with_xml2; -else - with_xml2=check -fi - - -if test "$with_xml2" = "yes" -o "$with_xml2" = "check"; then : - - -pkg_failed=no -{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for libxml-2.0" >&5 -$as_echo_n "checking for libxml-2.0... " >&6; } - -if test -n "$XML2_CFLAGS"; then - pkg_cv_XML2_CFLAGS="$XML2_CFLAGS" - elif test -n "$PKG_CONFIG"; then - if test -n "$PKG_CONFIG" && \ - { { $as_echo "$as_me:${as_lineno-$LINENO}: \$PKG_CONFIG --exists --print-errors \"libxml-2.0\""; } >&5 - ($PKG_CONFIG --exists --print-errors "libxml-2.0") 2>&5 - ac_status=$? - $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 - test $ac_status = 0; }; then - pkg_cv_XML2_CFLAGS=`$PKG_CONFIG --cflags "libxml-2.0" 2>/dev/null` - test "x$?" != "x0" && pkg_failed=yes -else - pkg_failed=yes -fi - else - pkg_failed=untried -fi -if test -n "$XML2_LIBS"; then - pkg_cv_XML2_LIBS="$XML2_LIBS" - elif test -n "$PKG_CONFIG"; then - if test -n "$PKG_CONFIG" && \ - { { $as_echo "$as_me:${as_lineno-$LINENO}: \$PKG_CONFIG --exists --print-errors \"libxml-2.0\""; } >&5 - ($PKG_CONFIG --exists --print-errors "libxml-2.0") 2>&5 - ac_status=$? - $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 - test $ac_status = 0; }; then - pkg_cv_XML2_LIBS=`$PKG_CONFIG --libs "libxml-2.0" 2>/dev/null` - test "x$?" != "x0" && pkg_failed=yes -else - pkg_failed=yes -fi - else - pkg_failed=untried -fi - - - -if test $pkg_failed = yes; then - { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 -$as_echo "no" >&6; } - -if $PKG_CONFIG --atleast-pkgconfig-version 0.20; then - _pkg_short_errors_supported=yes -else - _pkg_short_errors_supported=no -fi - if test $_pkg_short_errors_supported = yes; then - XML2_PKG_ERRORS=`$PKG_CONFIG --short-errors --print-errors --cflags --libs "libxml-2.0" 2>&1` - else - XML2_PKG_ERRORS=`$PKG_CONFIG --print-errors --cflags --libs "libxml-2.0" 2>&1` - fi - # Put the nasty error message in config.log where it belongs - echo "$XML2_PKG_ERRORS" >&5 - - - if test -z "$XML2_CFLAGS" -o -z "$XML2_LIBS"; then - # Extract the first word of "xml2-config", so it can be a program name with args. -set dummy xml2-config; ac_word=$2 -{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 -$as_echo_n "checking for $ac_word... " >&6; } -if ${ac_cv_prog_xml2_config_found+:} false; then : - $as_echo_n "(cached) " >&6 -else - if test -n "$xml2_config_found"; then - ac_cv_prog_xml2_config_found="$xml2_config_found" # Let the user override the test. -else -as_save_IFS=$IFS; IFS=$PATH_SEPARATOR -for as_dir in $PATH -do - IFS=$as_save_IFS - test -z "$as_dir" && as_dir=. - for ac_exec_ext in '' $ac_executable_extensions; do - if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then - ac_cv_prog_xml2_config_found=""yes"" - $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 - break 2 - fi -done - done -IFS=$as_save_IFS - -fi -fi -xml2_config_found=$ac_cv_prog_xml2_config_found -if test -n "$xml2_config_found"; then - { $as_echo "$as_me:${as_lineno-$LINENO}: result: $xml2_config_found" >&5 -$as_echo "$xml2_config_found" >&6; } -else - { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 -$as_echo "no" >&6; } -fi - - - if test "$xml2_config_found" = "yes"; then - if test -z "$XML2_CFLAGS"; then - XML2_CFLAGS="`xml2-config --cflags`" - fi - if test -z "$XML2_LIBS"; then - XML2_LIBS="`xml2-config --libs`" - fi - fi - fi -elif test $pkg_failed = untried; then - { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 -$as_echo "no" >&6; } - - if test -z "$XML2_CFLAGS" -o -z "$XML2_LIBS"; then - # Extract the first word of "xml2-config", so it can be a program name with args. -set dummy xml2-config; ac_word=$2 -{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 -$as_echo_n "checking for $ac_word... " >&6; } -if ${ac_cv_prog_xml2_config_found+:} false; then : - $as_echo_n "(cached) " >&6 -else - if test -n "$xml2_config_found"; then - ac_cv_prog_xml2_config_found="$xml2_config_found" # Let the user override the test. -else -as_save_IFS=$IFS; IFS=$PATH_SEPARATOR -for as_dir in $PATH -do - IFS=$as_save_IFS - test -z "$as_dir" && as_dir=. - for ac_exec_ext in '' $ac_executable_extensions; do - if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then - ac_cv_prog_xml2_config_found=""yes"" - $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 - break 2 - fi -done - done -IFS=$as_save_IFS - -fi -fi -xml2_config_found=$ac_cv_prog_xml2_config_found -if test -n "$xml2_config_found"; then - { $as_echo "$as_me:${as_lineno-$LINENO}: result: $xml2_config_found" >&5 -$as_echo "$xml2_config_found" >&6; } -else - { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 -$as_echo "no" >&6; } -fi - - - if test "$xml2_config_found" = "yes"; then - if test -z "$XML2_CFLAGS"; then - XML2_CFLAGS="`xml2-config --cflags`" - fi - if test -z "$XML2_LIBS"; then - XML2_LIBS="`xml2-config --libs`" - fi - fi - fi -else - XML2_CFLAGS=$pkg_cv_XML2_CFLAGS - XML2_LIBS=$pkg_cv_XML2_LIBS - { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5 -$as_echo "yes" >&6; } - -fi - curr_libs="$LIBS"; curr_cppflags="$CPPFLAGS" - if test -n "$XML2_CFLAGS"; then - CPPFLAGS="$CPPFLAGS $XML2_CFLAGS" - fi - if test -z "$XML2_LIBS"; then - XML2_LIBS="-lxml2" - fi - LIBS="$LIBS $XML2_LIBS" - for ac_header in libxml/xmlversion.h libxml/uri.h libxml/xmlwriter.h -do : - as_ac_Header=`$as_echo "ac_cv_header_$ac_header" | $as_tr_sh` -ac_fn_c_check_header_mongrel "$LINENO" "$ac_header" "$as_ac_Header" "$ac_includes_default" -if eval test \"x\$"$as_ac_Header"\" = x"yes"; then : - cat >>confdefs.h <<_ACEOF -#define `$as_echo "HAVE_$ac_header" | $as_tr_cpp` 1 -_ACEOF - -{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for LIBXML_WRITER_ENABLED defined in libxml/xmlwriter.h" >&5 -$as_echo_n "checking for LIBXML_WRITER_ENABLED defined in libxml/xmlwriter.h... " >&6; } -if ${ac_cv_defined_LIBXML_WRITER_ENABLED_libxml_xmlwriter_h+:} false; then : - $as_echo_n "(cached) " >&6 -else - cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ -#include -int -main () -{ - - #ifdef LIBXML_WRITER_ENABLED - int ok; - (void)ok; - #else - choke me - #endif - - ; - return 0; -} -_ACEOF -if ac_fn_c_try_compile "$LINENO"; then : - ac_cv_defined_LIBXML_WRITER_ENABLED_libxml_xmlwriter_h=yes -else - ac_cv_defined_LIBXML_WRITER_ENABLED_libxml_xmlwriter_h=no -fi -rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext -fi -{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_defined_LIBXML_WRITER_ENABLED_libxml_xmlwriter_h" >&5 -$as_echo "$ac_cv_defined_LIBXML_WRITER_ENABLED_libxml_xmlwriter_h" >&6; } -if test $ac_cv_defined_LIBXML_WRITER_ENABLED_libxml_xmlwriter_h != "no"; then : - -else - if test "$with_xml2" = "yes"; then - as_fn_error $? "libxml2 is required to be configured with xmlWriter" "$LINENO" 5 - else - { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: libxml2 is required to be configured with xmlWriter" >&5 -$as_echo "$as_me: WARNING: libxml2 is required to be configured with xmlWriter" >&2;} - with_xml2=no - fi -fi - -else - if test "$with_xml2" = "yes"; then - as_fn_error $? "Headers for libxml2 are required for --with-xml2, you may adjust XML2_CFLAGS" "$LINENO" 5 - else - with_xml2=no - fi -fi - -done - - if test "$with_xml2" != "no"; then - { $as_echo "$as_me:${as_lineno-$LINENO}: checking if linking against libxml2 with \"$XML2_LIBS\" works" >&5 -$as_echo_n "checking if linking against libxml2 with \"$XML2_LIBS\" works... " >&6; } - cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ -#include -int -main () -{ -xmlNewTextWriterFilename (NULL, 0); - ; - return 0; -} -_ACEOF -if ac_fn_c_try_link "$LINENO"; then : - $as_echo "#define WITH_XML2 1" >>confdefs.h - { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5 -$as_echo "yes" >&6; } - with_xml2=yes - LIBCOB_CPPFLAGS="$LIBCOB_CPPFLAGS $XML2_CFLAGS" - LIBCOB_LIBS="$LIBCOB_LIBS $XML2_LIBS" -else - { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 -$as_echo "no" >&6; } - if test "$with_xml2" = "yes"; then - as_fn_error $? "xml library is required for --with-xml2, you may adjust XML2_LIBS" "$LINENO" 5 - else - { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: xml library not found, you may adjust XML2_LIBS" >&5 -$as_echo "$as_me: WARNING: xml library not found, you may adjust XML2_LIBS" >&2;} - with_xml2=no - fi -fi -rm -f core conftest.err conftest.$ac_objext \ - conftest$ac_exeext conftest.$ac_ext - else - { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: Headers for libxml2 missing, you may adjust XML2_CFLAGS" >&5 -$as_echo "$as_me: WARNING: Headers for libxml2 missing, you may adjust XML2_CFLAGS" >&2;} - with_xml2=no - fi - LIBS="$curr_libs"; CPPFLAGS="$curr_cppflags" - -fi - - - -# Check whether --with-cjson was given. -if test "${with_cjson+set}" = set; then : - withval=$with_cjson; -else - with_cjson=check -fi - - -if test "$with_cjson" = "yes" -o "$with_cjson" = "local" -o "$with_cjson" = "check"; then : - - { $as_echo "$as_me:${as_lineno-$LINENO}: Checks for local cJSON ..." >&5 -$as_echo "$as_me: Checks for local cJSON ..." >&6;} - curr_libs="$LIBS"; curr_cppflags="$CPPFLAGS" - with_cjson_local=no - { $as_echo "$as_me:${as_lineno-$LINENO}: checking for ./libcob/cJSON.c" >&5 -$as_echo_n "checking for ./libcob/cJSON.c... " >&6; } -if ${ac_cv_file___libcob_cJSON_c+:} false; then : - $as_echo_n "(cached) " >&6 -else - test "$cross_compiling" = yes && - as_fn_error $? "cannot check for file existence when cross compiling" "$LINENO" 5 -if test -r "./libcob/cJSON.c"; then - ac_cv_file___libcob_cJSON_c=yes -else - ac_cv_file___libcob_cJSON_c=no -fi -fi -{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_file___libcob_cJSON_c" >&5 -$as_echo "$ac_cv_file___libcob_cJSON_c" >&6; } -if test "x$ac_cv_file___libcob_cJSON_c" = xyes; then : - { $as_echo "$as_me:${as_lineno-$LINENO}: checking if linking of ./libcob/cJSON.c works" >&5 -$as_echo_n "checking if linking of ./libcob/cJSON.c works... " >&6; } - CPPFLAGS="$curr_cppflags -I./libcob" - cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ -#include "cJSON.c" -int -main () -{ -cJSON_CreateNull (); - ; - return 0; -} -_ACEOF -if ac_fn_c_try_link "$LINENO"; then : - { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5 -$as_echo "yes" >&6; } - with_cjson_local="yes (in ./libcob)" -else - { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 -$as_echo "no" >&6; } - -fi -rm -f core conftest.err conftest.$ac_objext \ - conftest$ac_exeext conftest.$ac_ext - -fi - - if test "$with_cjson_local" = "no"; then - as_ac_File=`$as_echo "ac_cv_file_$srcdir/libcob/cJSON.c" | $as_tr_sh` -{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $srcdir/libcob/cJSON.c" >&5 -$as_echo_n "checking for $srcdir/libcob/cJSON.c... " >&6; } -if eval \${$as_ac_File+:} false; then : - $as_echo_n "(cached) " >&6 -else - test "$cross_compiling" = yes && - as_fn_error $? "cannot check for file existence when cross compiling" "$LINENO" 5 -if test -r "$srcdir/libcob/cJSON.c"; then - eval "$as_ac_File=yes" -else - eval "$as_ac_File=no" -fi -fi -eval ac_res=\$$as_ac_File - { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_res" >&5 -$as_echo "$ac_res" >&6; } -if eval test \"x\$"$as_ac_File"\" = x"yes"; then : - { $as_echo "$as_me:${as_lineno-$LINENO}: checking if linking of $srcdir/libcob/cJSON.c works" >&5 -$as_echo_n "checking if linking of $srcdir/libcob/cJSON.c works... " >&6; } - CPPFLAGS="$curr_cppflags -I$srcdir/libcob" - cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ -#include "cJSON.c" -int -main () -{ -cJSON_CreateNull (); - ; - return 0; -} -_ACEOF -if ac_fn_c_try_link "$LINENO"; then : - { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5 -$as_echo "yes" >&6; } - with_cjson_local="yes (in $srcdir/libcob)" -else - { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 -$as_echo "no" >&6; } - -fi -rm -f core conftest.err conftest.$ac_objext \ - conftest$ac_exeext conftest.$ac_ext - -fi - - fi - CPPFLAGS="$curr_cppflags" - if test "$with_cjson_local" = "no"; then - { $as_echo "$as_me:${as_lineno-$LINENO}: using local cJSON: no" >&5 -$as_echo "$as_me: using local cJSON: no" >&6;} - if test "$with_cjson" = "local"; then - as_fn_error $? "cJSON source is required in directory \"libcob\" for --with-cjson=local" "$LINENO" 5 - fi - -pkg_failed=no -{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for libcjson" >&5 -$as_echo_n "checking for libcjson... " >&6; } - -if test -n "$CJSON_CFLAGS"; then - pkg_cv_CJSON_CFLAGS="$CJSON_CFLAGS" - elif test -n "$PKG_CONFIG"; then - if test -n "$PKG_CONFIG" && \ - { { $as_echo "$as_me:${as_lineno-$LINENO}: \$PKG_CONFIG --exists --print-errors \"libcjson\""; } >&5 - ($PKG_CONFIG --exists --print-errors "libcjson") 2>&5 - ac_status=$? - $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 - test $ac_status = 0; }; then - pkg_cv_CJSON_CFLAGS=`$PKG_CONFIG --cflags "libcjson" 2>/dev/null` - test "x$?" != "x0" && pkg_failed=yes -else - pkg_failed=yes -fi - else - pkg_failed=untried -fi -if test -n "$CJSON_LIBS"; then - pkg_cv_CJSON_LIBS="$CJSON_LIBS" - elif test -n "$PKG_CONFIG"; then - if test -n "$PKG_CONFIG" && \ - { { $as_echo "$as_me:${as_lineno-$LINENO}: \$PKG_CONFIG --exists --print-errors \"libcjson\""; } >&5 - ($PKG_CONFIG --exists --print-errors "libcjson") 2>&5 - ac_status=$? - $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 - test $ac_status = 0; }; then - pkg_cv_CJSON_LIBS=`$PKG_CONFIG --libs "libcjson" 2>/dev/null` - test "x$?" != "x0" && pkg_failed=yes -else - pkg_failed=yes -fi - else - pkg_failed=untried -fi - - - -if test $pkg_failed = yes; then - { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 -$as_echo "no" >&6; } - -if $PKG_CONFIG --atleast-pkgconfig-version 0.20; then - _pkg_short_errors_supported=yes -else - _pkg_short_errors_supported=no -fi - if test $_pkg_short_errors_supported = yes; then - CJSON_PKG_ERRORS=`$PKG_CONFIG --short-errors --print-errors --cflags --libs "libcjson" 2>&1` - else - CJSON_PKG_ERRORS=`$PKG_CONFIG --print-errors --cflags --libs "libcjson" 2>&1` - fi - # Put the nasty error message in config.log where it belongs - echo "$CJSON_PKG_ERRORS" >&5 - - # -elif test $pkg_failed = untried; then - { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 -$as_echo "no" >&6; } - # -else - CJSON_CFLAGS=$pkg_cv_CJSON_CFLAGS - CJSON_LIBS=$pkg_cv_CJSON_LIBS - { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5 -$as_echo "yes" >&6; } - -fi - if test -n "$CJSON_CFLAGS"; then - CPPFLAGS="$CPPFLAGS $CJSON_CFLAGS" - fi - if test -z "$CJSON_LIBS"; then - CJSON_LIBS="-lcjson" - fi - LIBS="$LIBS $CJSON_LIBS" - for ac_header in cJSON.h -do : - ac_fn_c_check_header_mongrel "$LINENO" "cJSON.h" "ac_cv_header_cJSON_h" "$ac_includes_default" -if test "x$ac_cv_header_cJSON_h" = xyes; then : - cat >>confdefs.h <<_ACEOF -#define HAVE_CJSON_H 1 -_ACEOF - -else - for ac_header in cjson/cJSON.h -do : - ac_fn_c_check_header_mongrel "$LINENO" "cjson/cJSON.h" "ac_cv_header_cjson_cJSON_h" "$ac_includes_default" -if test "x$ac_cv_header_cjson_cJSON_h" = xyes; then : - cat >>confdefs.h <<_ACEOF -#define HAVE_CJSON_CJSON_H 1 -_ACEOF - -else - if test "$with_cjson" = "yes"; then - as_fn_error $? "Headers for libcjson are required for --with-cjson, you may adjust CJSON_CFLAGS" "$LINENO" 5 - else - { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: Headers for libcjson missing, you may adjust CJSON_CFLAGS or put cJSON sources in \"libcob\"" >&5 -$as_echo "$as_me: WARNING: Headers for libcjson missing, you may adjust CJSON_CFLAGS or put cJSON sources in \"libcob\"" >&2;} - with_cjson=no - fi - -fi - -done - -fi - -done - - if test "$with_cjson" != "no"; then - { $as_echo "$as_me:${as_lineno-$LINENO}: checking if linking against libcjson with \"$CJSON_LIBS\" works" >&5 -$as_echo_n "checking if linking against libcjson with \"$CJSON_LIBS\" works... " >&6; } - cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ - - #if defined HAVE_CJSON_CJSON_H - #include - #elif defined HAVE_CJSON_H - #include - #endif -int -main () -{ -cJSON_CreateNull (); - ; - return 0; -} -_ACEOF -if ac_fn_c_try_link "$LINENO"; then : - $as_echo "#define WITH_CJSON 1" >>confdefs.h - { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5 -$as_echo "yes" >&6; } - with_cjson=yes - LIBCOB_CPPFLAGS="$LIBCOB_CPPFLAGS $CJSON_CFLAGS" - LIBCOB_LIBS="$LIBCOB_LIBS $CJSON_LIBS" -else - { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 -$as_echo "no" >&6; } - if test "$with_cjson" = "yes"; then - as_fn_error $? "cJSON library is required for --with-cjson, you may adjust CJSON_LIBS" "$LINENO" 5 - else - { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: xml library not found, you may adjust CJSON_LIBS" >&5 -$as_echo "$as_me: WARNING: xml library not found, you may adjust CJSON_LIBS" >&2;} - with_cjson=no - fi -fi -rm -f core conftest.err conftest.$ac_objext \ - conftest$ac_exeext conftest.$ac_ext - fi - else - { $as_echo "$as_me:${as_lineno-$LINENO}: using local cJSON: $with_cjson_local" >&5 -$as_echo "$as_me: using local cJSON: $with_cjson_local" >&6;} - with_cjson="local" - $as_echo "#define WITH_CJSON 1" >>confdefs.h - - $as_echo "#define HAVE_CJSON_H 1" >>confdefs.h - - fi - LIBS="$curr_libs"; CPPFLAGS="$curr_cppflags" - -fi - - - -# Check whether --with-dl was given. -if test "${with_dl+set}" = set; then : - withval=$with_dl; case $with_dl in - yes) - ;; - no) - ;; - *) as_fn_error $? "--with/without-dl can not have a value" "$LINENO" 5 - ;; - esac -else - with_dl=yes -fi - - - -# Check whether --with-varseq was given. -if test "${with_varseq+set}" = set; then : - withval=$with_varseq; case $with_varseq in - yes) as_fn_error $? "You must give --with-varseq an argument." "$LINENO" 5 - ;; - no) as_fn_error $? "--without-varseq not supported." "$LINENO" 5 - ;; - [0-3]) - ;; - *) as_fn_error $? "Invalid --with-varseq argument" "$LINENO" 5 - ;; - esac -else - with_varseq=0 -fi - - -cat >>confdefs.h <<_ACEOF -#define WITH_VARSEQ $with_varseq -_ACEOF - - - -# Checks for gmp. -{ $as_echo "$as_me:${as_lineno-$LINENO}: Checks for GMP ..." >&5 -$as_echo "$as_me: Checks for GMP ..." >&6;} -for ac_header in gmp.h -do : - ac_fn_c_check_header_mongrel "$LINENO" "gmp.h" "ac_cv_header_gmp_h" "$ac_includes_default" -if test "x$ac_cv_header_gmp_h" = xyes; then : - cat >>confdefs.h <<_ACEOF -#define HAVE_GMP_H 1 -_ACEOF - -else - as_fn_error $? "gmp.h (GMP) is required" "$LINENO" 5 -fi - -done - - -{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for __gmpz_init in -lgmp" >&5 -$as_echo_n "checking for __gmpz_init in -lgmp... " >&6; } -if ${ac_cv_lib_gmp___gmpz_init+:} false; then : - $as_echo_n "(cached) " >&6 -else - ac_check_lib_save_LIBS=$LIBS -LIBS="-lgmp $LIBS" -cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ - -/* Override any GCC internal prototype to avoid an error. - Use char because int might match the return type of a GCC - builtin and then its argument prototype would still apply. */ -#ifdef __cplusplus -extern "C" -#endif -char __gmpz_init (); -int -main () -{ -return __gmpz_init (); - ; - return 0; -} -_ACEOF -if ac_fn_c_try_link "$LINENO"; then : - ac_cv_lib_gmp___gmpz_init=yes -else - ac_cv_lib_gmp___gmpz_init=no -fi -rm -f core conftest.err conftest.$ac_objext \ - conftest$ac_exeext conftest.$ac_ext -LIBS=$ac_check_lib_save_LIBS -fi -{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_gmp___gmpz_init" >&5 -$as_echo "$ac_cv_lib_gmp___gmpz_init" >&6; } -if test "x$ac_cv_lib_gmp___gmpz_init" = xyes; then : - LIBCOB_LIBS="$LIBCOB_LIBS -lgmp" -else - as_fn_error $? "GMP library is required" "$LINENO" 5 -fi - - -# Check just major/minor levels between header and library -# get GMP version from header -if test "$cross_compiling" = yes; then : - { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: cannot run test program while cross-compiling" >&5 -$as_echo "$as_me: WARNING: cannot run test program while cross-compiling" >&2;} - COB_GMP_HEADER="cross-compilation - assumed" -else - cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ - - #include - #include - int main (int argc, char **argv) - { - (void)argv; - if (argc > 1) - printf ("%d.%d", __GNU_MP_VERSION, __GNU_MP_VERSION_MINOR); - return 0; - } - -_ACEOF -if ac_fn_c_try_run "$LINENO"; then : - COB_GMP_HEADER=`./conftest$ac_exeext x` -else - as_fn_error $? "Unable to extract GMP version information from gmp.h" "$LINENO" 5 -fi -rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext \ - conftest.$ac_objext conftest.beam conftest.$ac_ext -fi - -if test "x$COB_GMP_HEADER" = "x"; then - as_fn_error $? "Unable to extract GMP version information (header)" "$LINENO" 5 -fi - -MYOLDLIBS=$LIBS -LIBS="$MYOLDLIBS -lgmp" -# get GMP version from lib -if test "$cross_compiling" = yes; then : - { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: matching GMP version assumed" >&5 -$as_echo "$as_me: WARNING: matching GMP version assumed" >&2;} - COB_GMP_LIB="cross" -else - cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ - - #include - #ifdef _WIN32 - #ifndef __GMP_LIBGMP_DLL - #define __GMP_LIBGMP_DLL 1 - #endif - #endif - #include - int main (int argc, char **argv) - { - (void)argv; - if (argc > 1) - printf ("%s", gmp_version); - return 0; - } - -_ACEOF -if ac_fn_c_try_run "$LINENO"; then : - COB_GMP_LIB=`./conftest$ac_exeext x` -else - as_fn_error $? "Unable to extract GMP version information from gmp_version" "$LINENO" 5 -fi -rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext \ - conftest.$ac_objext conftest.beam conftest.$ac_ext -fi - -if test "x$COB_GMP_LIB" = "x"; then - as_fn_error $? "Unable to extract GMP version information (library)" "$LINENO" 5 -fi - -{ $as_echo "$as_me:${as_lineno-$LINENO}: checking matching GMP version" >&5 -$as_echo_n "checking matching GMP version... " >&6; } -COB_GMP_LIB_MAJOR=$(echo "$COB_GMP_LIB" | cut -d. -f1) -COB_GMP_LIB_MINOR=$(echo "$COB_GMP_LIB" | cut -d. -f2) - -if test "$COB_GMP_HEADER" = "$COB_GMP_LIB_MAJOR.$COB_GMP_LIB_MINOR" -o "$COB_GMP_LIB" = "cross"; then - { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes ($COB_GMP_HEADER)" >&5 -$as_echo "yes ($COB_GMP_HEADER)" >&6; } -else - { $as_echo "$as_me:${as_lineno-$LINENO}: result: no (header: $COB_GMP_HEADER / library: $COB_GMP_LIB)" >&5 -$as_echo "no (header: $COB_GMP_HEADER / library: $COB_GMP_LIB)" >&6; } - as_fn_error $? "Unable to use GMP - Please check config.log" "$LINENO" 5 -fi -LIBS=$MYOLDLIBS - - -# Works fine as an alternative if necessary -# AC_SEARCH_LIBS([__gmp_get_memory_functions], [gmp], [AC_DEFINE([HAVE_MP_GET_MEMORY_FUNCTIONS], [1])], [], []) -{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for __gmp_get_memory_functions in -lgmp" >&5 -$as_echo_n "checking for __gmp_get_memory_functions in -lgmp... " >&6; } -if ${ac_cv_lib_gmp___gmp_get_memory_functions+:} false; then : - $as_echo_n "(cached) " >&6 -else - ac_check_lib_save_LIBS=$LIBS -LIBS="-lgmp $LIBS" -cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ - -/* Override any GCC internal prototype to avoid an error. - Use char because int might match the return type of a GCC - builtin and then its argument prototype would still apply. */ -#ifdef __cplusplus -extern "C" -#endif -char __gmp_get_memory_functions (); -int -main () -{ -return __gmp_get_memory_functions (); - ; - return 0; -} -_ACEOF -if ac_fn_c_try_link "$LINENO"; then : - ac_cv_lib_gmp___gmp_get_memory_functions=yes -else - ac_cv_lib_gmp___gmp_get_memory_functions=no -fi -rm -f core conftest.err conftest.$ac_objext \ - conftest$ac_exeext conftest.$ac_ext -LIBS=$ac_check_lib_save_LIBS -fi -{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_gmp___gmp_get_memory_functions" >&5 -$as_echo "$ac_cv_lib_gmp___gmp_get_memory_functions" >&6; } -if test "x$ac_cv_lib_gmp___gmp_get_memory_functions" = xyes; then : - $as_echo "#define HAVE_MP_GET_MEMORY_FUNCTIONS 1" >>confdefs.h - -fi - - - -# Solaris has nanosleep in other libraries -{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for nanosleep" >&5 -$as_echo_n "checking for nanosleep... " >&6; } -cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ -#include -int -main () -{ -nanosleep (NULL, NULL); - ; - return 0; -} -_ACEOF -if ac_fn_c_try_link "$LINENO"; then : - $as_echo "#define HAVE_NANO_SLEEP 1" >>confdefs.h - { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5 -$as_echo "yes" >&6; } -else - { $as_echo "$as_me:${as_lineno-$LINENO}: checking for nanosleep in -lrt" >&5 -$as_echo_n "checking for nanosleep in -lrt... " >&6; } -if ${ac_cv_lib_rt_nanosleep+:} false; then : - $as_echo_n "(cached) " >&6 -else - ac_check_lib_save_LIBS=$LIBS -LIBS="-lrt $LIBS" -cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ - -/* Override any GCC internal prototype to avoid an error. - Use char because int might match the return type of a GCC - builtin and then its argument prototype would still apply. */ -#ifdef __cplusplus -extern "C" -#endif -char nanosleep (); -int -main () -{ -return nanosleep (); - ; - return 0; -} -_ACEOF -if ac_fn_c_try_link "$LINENO"; then : - ac_cv_lib_rt_nanosleep=yes -else - ac_cv_lib_rt_nanosleep=no -fi -rm -f core conftest.err conftest.$ac_objext \ - conftest$ac_exeext conftest.$ac_ext -LIBS=$ac_check_lib_save_LIBS -fi -{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_rt_nanosleep" >&5 -$as_echo "$ac_cv_lib_rt_nanosleep" >&6; } -if test "x$ac_cv_lib_rt_nanosleep" = xyes; then : - cat >>confdefs.h <<_ACEOF -#define HAVE_LIBRT 1 -_ACEOF - - LIBS="-lrt $LIBS" - -fi - - if test "x$ac_cv_lib_rt_nanosleep" = "xyes"; then - $as_echo "#define HAVE_NANO_SLEEP 1" >>confdefs.h - - { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5 -$as_echo "yes" >&6; } - LIBCOB_LIBS="$LIBCOB_LIBS -lrt" - else - { $as_echo "$as_me:${as_lineno-$LINENO}: checking for nanosleep in -lposix4" >&5 -$as_echo_n "checking for nanosleep in -lposix4... " >&6; } -if ${ac_cv_lib_posix4_nanosleep+:} false; then : - $as_echo_n "(cached) " >&6 -else - ac_check_lib_save_LIBS=$LIBS -LIBS="-lposix4 $LIBS" -cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ - -/* Override any GCC internal prototype to avoid an error. - Use char because int might match the return type of a GCC - builtin and then its argument prototype would still apply. */ -#ifdef __cplusplus -extern "C" -#endif -char nanosleep (); -int -main () -{ -return nanosleep (); - ; - return 0; -} -_ACEOF -if ac_fn_c_try_link "$LINENO"; then : - ac_cv_lib_posix4_nanosleep=yes -else - ac_cv_lib_posix4_nanosleep=no -fi -rm -f core conftest.err conftest.$ac_objext \ - conftest$ac_exeext conftest.$ac_ext -LIBS=$ac_check_lib_save_LIBS -fi -{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_posix4_nanosleep" >&5 -$as_echo "$ac_cv_lib_posix4_nanosleep" >&6; } -if test "x$ac_cv_lib_posix4_nanosleep" = xyes; then : - cat >>confdefs.h <<_ACEOF -#define HAVE_LIBPOSIX4 1 -_ACEOF - - LIBS="-lposix4 $LIBS" - -fi - - if test "x$ac_cv_lib_posix4_nanosleep" = "xyes"; then - $as_echo "#define HAVE_NANO_SLEEP 1" >>confdefs.h - - { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5 -$as_echo "yes" >&6; } - LIBCOB_LIBS="$LIBCOB_LIBS -lposix4" - else - { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 -$as_echo "no" >&6; } - fi - fi -fi -rm -f core conftest.err conftest.$ac_objext \ - conftest$ac_exeext conftest.$ac_ext - -{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for clock_gettime and CLOCK_REALTIME" >&5 -$as_echo_n "checking for clock_gettime and CLOCK_REALTIME... " >&6; } -cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ -#include -int -main () -{ -clock_gettime (CLOCK_REALTIME, NULL); - ; - return 0; -} -_ACEOF -if ac_fn_c_try_link "$LINENO"; then : - $as_echo "#define HAVE_CLOCK_GETTIME 1" >>confdefs.h - { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5 -$as_echo "yes" >&6; } -else - { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 -$as_echo "no" >&6; } -fi -rm -f core conftest.err conftest.$ac_objext \ - conftest$ac_exeext conftest.$ac_ext - -{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for isfinite" >&5 -$as_echo_n "checking for isfinite... " >&6; } -cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ -#include -int -main () -{ -isfinite ( 1.0 ); - ; - return 0; -} -_ACEOF -if ac_fn_c_try_link "$LINENO"; then : - $as_echo "#define HAVE_ISFINITE 1" >>confdefs.h - { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5 -$as_echo "yes" >&6; } -else - { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 -$as_echo "no" >&6; } - # Check prototype for finite in math.h (alternative ieeefp.h) - { $as_echo "$as_me:${as_lineno-$LINENO}: checking prototype for finite in " >&5 -$as_echo_n "checking prototype for finite in ... " >&6; } - cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ -#include - -_ACEOF -if (eval "$ac_cpp conftest.$ac_ext") 2>&5 | - $EGREP "finite" >/dev/null 2>&1; then : - { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5 -$as_echo "yes" >&6; } -else - { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 -$as_echo "no" >&6; } - { $as_echo "$as_me:${as_lineno-$LINENO}: checking prototype for finite in " >&5 -$as_echo_n "checking prototype for finite in ... " >&6; } - cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ -#include - -_ACEOF -if (eval "$ac_cpp conftest.$ac_ext") 2>&5 | - $EGREP "finite" >/dev/null 2>&1; then : - $as_echo "#define HAVE_FINITE_IEEEFP_H 1" >>confdefs.h - { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5 -$as_echo "yes" >&6; } -else - as_fn_error $? " - Declaration for finite function neither in math.h nor in ieeefp.h" "$LINENO" 5 -fi -rm -f conftest* - - -fi -rm -f conftest* - - -fi -rm -f core conftest.err conftest.$ac_objext \ - conftest$ac_exeext conftest.$ac_ext - -# Check for raise (optional) --> done via AC_CHECK_FUNCS -#AC_MSG_CHECKING([for raise]) -#AC_LINK_IFELSE([AC_LANG_PROGRAM([[#include ]], -# [[raise (SIGINT);]])], -# [AC_DEFINE([HAVE_RAISE], [1]) AC_MSG_RESULT([yes])], -# [AC_MSG_RESULT([no])], -# []) - -for ac_func in fdatasync sigaction -do : - as_ac_var=`$as_echo "ac_cv_func_$ac_func" | $as_tr_sh` -ac_fn_c_check_func "$LINENO" "$ac_func" "$as_ac_var" -if eval test \"x\$"$as_ac_var"\" = x"yes"; then : - cat >>confdefs.h <<_ACEOF -#define `$as_echo "HAVE_$ac_func" | $as_tr_cpp` 1 -_ACEOF - -fi -done - - -# Checks for gettext. - -case $host_os in - darwin* | rhapsody*) - ;; - *) - gt_cv_func_CFPreferencesCopyAppValue=no - gt_cv_func_CFLocaleCopyCurrent=no - ;; -esac - -# Simon: removed, use --disable-nls instead -## Disable for Cygwin -#AC_MSG_CHECKING([for __CYGWIN__]) -#AC_COMPILE_IFELSE([AC_LANG_SOURCE([[ -# #ifndef __CYGWIN__ -# # error macro not defined -# #endif]])], -# [enable_nls=no -# AC_MSG_RESULT([yes])], -# [AC_MSG_RESULT([no])]) - - - { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether NLS is requested" >&5 -$as_echo_n "checking whether NLS is requested... " >&6; } - # Check whether --enable-nls was given. -if test "${enable_nls+set}" = set; then : - enableval=$enable_nls; USE_NLS=$enableval -else - USE_NLS=yes -fi - - { $as_echo "$as_me:${as_lineno-$LINENO}: result: $USE_NLS" >&5 -$as_echo "$USE_NLS" >&6; } - - - - - GETTEXT_MACRO_VERSION=0.19 - - - - -# Prepare PATH_SEPARATOR. -# The user is always right. -if test "${PATH_SEPARATOR+set}" != set; then - # Determine PATH_SEPARATOR by trying to find /bin/sh in a PATH which - # contains only /bin. Note that ksh looks also at the FPATH variable, - # so we have to set that as well for the test. - PATH_SEPARATOR=: - (PATH='/bin;/bin'; FPATH=$PATH; sh -c :) >/dev/null 2>&1 \ - && { (PATH='/bin:/bin'; FPATH=$PATH; sh -c :) >/dev/null 2>&1 \ - || PATH_SEPARATOR=';' - } -fi - -# Find out how to test for executable files. Don't use a zero-byte file, -# as systems may use methods other than mode bits to determine executability. -cat >conf$$.file <<_ASEOF -#! /bin/sh -exit 0 -_ASEOF -chmod +x conf$$.file -if test -x conf$$.file >/dev/null 2>&1; then - ac_executable_p="test -x" -else - ac_executable_p="test -f" -fi -rm -f conf$$.file - -# Extract the first word of "msgfmt", so it can be a program name with args. -set dummy msgfmt; ac_word=$2 -{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 -$as_echo_n "checking for $ac_word... " >&6; } -if ${ac_cv_path_MSGFMT+:} false; then : - $as_echo_n "(cached) " >&6 -else - case "$MSGFMT" in - [\\/]* | ?:[\\/]*) - ac_cv_path_MSGFMT="$MSGFMT" # Let the user override the test with a path. - ;; - *) - ac_save_IFS="$IFS"; IFS=$PATH_SEPARATOR - for ac_dir in $PATH; do - IFS="$ac_save_IFS" - test -z "$ac_dir" && ac_dir=. - for ac_exec_ext in '' $ac_executable_extensions; do - if $ac_executable_p "$ac_dir/$ac_word$ac_exec_ext"; then - echo "$as_me: trying $ac_dir/$ac_word..." >&5 - if $ac_dir/$ac_word --statistics /dev/null >&5 2>&1 && - (if $ac_dir/$ac_word --statistics /dev/null 2>&1 >/dev/null | grep usage >/dev/null; then exit 1; else exit 0; fi); then - ac_cv_path_MSGFMT="$ac_dir/$ac_word$ac_exec_ext" - break 2 - fi - fi - done - done - IFS="$ac_save_IFS" - test -z "$ac_cv_path_MSGFMT" && ac_cv_path_MSGFMT=":" - ;; -esac -fi -MSGFMT="$ac_cv_path_MSGFMT" -if test "$MSGFMT" != ":"; then - { $as_echo "$as_me:${as_lineno-$LINENO}: result: $MSGFMT" >&5 -$as_echo "$MSGFMT" >&6; } -else - { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 -$as_echo "no" >&6; } -fi - - # Extract the first word of "gmsgfmt", so it can be a program name with args. -set dummy gmsgfmt; ac_word=$2 -{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 -$as_echo_n "checking for $ac_word... " >&6; } -if ${ac_cv_path_GMSGFMT+:} false; then : - $as_echo_n "(cached) " >&6 -else - case $GMSGFMT in - [\\/]* | ?:[\\/]*) - ac_cv_path_GMSGFMT="$GMSGFMT" # Let the user override the test with a path. - ;; - *) - as_save_IFS=$IFS; IFS=$PATH_SEPARATOR -for as_dir in $PATH -do - IFS=$as_save_IFS - test -z "$as_dir" && as_dir=. - for ac_exec_ext in '' $ac_executable_extensions; do - if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then - ac_cv_path_GMSGFMT="$as_dir/$ac_word$ac_exec_ext" - $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 - break 2 - fi -done - done -IFS=$as_save_IFS - - test -z "$ac_cv_path_GMSGFMT" && ac_cv_path_GMSGFMT="$MSGFMT" - ;; -esac -fi -GMSGFMT=$ac_cv_path_GMSGFMT -if test -n "$GMSGFMT"; then - { $as_echo "$as_me:${as_lineno-$LINENO}: result: $GMSGFMT" >&5 -$as_echo "$GMSGFMT" >&6; } -else - { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 -$as_echo "no" >&6; } -fi - - - - case `$MSGFMT --version | sed 1q | sed -e 's,^[^0-9]*,,'` in - '' | 0.[0-9] | 0.[0-9].* | 0.1[0-4] | 0.1[0-4].*) MSGFMT_015=: ;; - *) MSGFMT_015=$MSGFMT ;; - esac - - case `$GMSGFMT --version | sed 1q | sed -e 's,^[^0-9]*,,'` in - '' | 0.[0-9] | 0.[0-9].* | 0.1[0-4] | 0.1[0-4].*) GMSGFMT_015=: ;; - *) GMSGFMT_015=$GMSGFMT ;; - esac - - - -# Prepare PATH_SEPARATOR. -# The user is always right. -if test "${PATH_SEPARATOR+set}" != set; then - # Determine PATH_SEPARATOR by trying to find /bin/sh in a PATH which - # contains only /bin. Note that ksh looks also at the FPATH variable, - # so we have to set that as well for the test. - PATH_SEPARATOR=: - (PATH='/bin;/bin'; FPATH=$PATH; sh -c :) >/dev/null 2>&1 \ - && { (PATH='/bin:/bin'; FPATH=$PATH; sh -c :) >/dev/null 2>&1 \ - || PATH_SEPARATOR=';' - } -fi - -# Find out how to test for executable files. Don't use a zero-byte file, -# as systems may use methods other than mode bits to determine executability. -cat >conf$$.file <<_ASEOF -#! /bin/sh -exit 0 -_ASEOF -chmod +x conf$$.file -if test -x conf$$.file >/dev/null 2>&1; then - ac_executable_p="test -x" -else - ac_executable_p="test -f" -fi -rm -f conf$$.file - -# Extract the first word of "xgettext", so it can be a program name with args. -set dummy xgettext; ac_word=$2 -{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 -$as_echo_n "checking for $ac_word... " >&6; } -if ${ac_cv_path_XGETTEXT+:} false; then : - $as_echo_n "(cached) " >&6 -else - case "$XGETTEXT" in - [\\/]* | ?:[\\/]*) - ac_cv_path_XGETTEXT="$XGETTEXT" # Let the user override the test with a path. - ;; - *) - ac_save_IFS="$IFS"; IFS=$PATH_SEPARATOR - for ac_dir in $PATH; do - IFS="$ac_save_IFS" - test -z "$ac_dir" && ac_dir=. - for ac_exec_ext in '' $ac_executable_extensions; do - if $ac_executable_p "$ac_dir/$ac_word$ac_exec_ext"; then - echo "$as_me: trying $ac_dir/$ac_word..." >&5 - if $ac_dir/$ac_word --omit-header --copyright-holder= --msgid-bugs-address= /dev/null >&5 2>&1 && - (if $ac_dir/$ac_word --omit-header --copyright-holder= --msgid-bugs-address= /dev/null 2>&1 >/dev/null | grep usage >/dev/null; then exit 1; else exit 0; fi); then - ac_cv_path_XGETTEXT="$ac_dir/$ac_word$ac_exec_ext" - break 2 - fi - fi - done - done - IFS="$ac_save_IFS" - test -z "$ac_cv_path_XGETTEXT" && ac_cv_path_XGETTEXT=":" - ;; -esac -fi -XGETTEXT="$ac_cv_path_XGETTEXT" -if test "$XGETTEXT" != ":"; then - { $as_echo "$as_me:${as_lineno-$LINENO}: result: $XGETTEXT" >&5 -$as_echo "$XGETTEXT" >&6; } -else - { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 -$as_echo "no" >&6; } -fi - - rm -f messages.po - - case `$XGETTEXT --version | sed 1q | sed -e 's,^[^0-9]*,,'` in - '' | 0.[0-9] | 0.[0-9].* | 0.1[0-4] | 0.1[0-4].*) XGETTEXT_015=: ;; - *) XGETTEXT_015=$XGETTEXT ;; - esac - - - -# Prepare PATH_SEPARATOR. -# The user is always right. -if test "${PATH_SEPARATOR+set}" != set; then - # Determine PATH_SEPARATOR by trying to find /bin/sh in a PATH which - # contains only /bin. Note that ksh looks also at the FPATH variable, - # so we have to set that as well for the test. - PATH_SEPARATOR=: - (PATH='/bin;/bin'; FPATH=$PATH; sh -c :) >/dev/null 2>&1 \ - && { (PATH='/bin:/bin'; FPATH=$PATH; sh -c :) >/dev/null 2>&1 \ - || PATH_SEPARATOR=';' - } -fi - -# Find out how to test for executable files. Don't use a zero-byte file, -# as systems may use methods other than mode bits to determine executability. -cat >conf$$.file <<_ASEOF -#! /bin/sh -exit 0 -_ASEOF -chmod +x conf$$.file -if test -x conf$$.file >/dev/null 2>&1; then - ac_executable_p="test -x" -else - ac_executable_p="test -f" -fi -rm -f conf$$.file - -# Extract the first word of "msgmerge", so it can be a program name with args. -set dummy msgmerge; ac_word=$2 -{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 -$as_echo_n "checking for $ac_word... " >&6; } -if ${ac_cv_path_MSGMERGE+:} false; then : - $as_echo_n "(cached) " >&6 -else - case "$MSGMERGE" in - [\\/]* | ?:[\\/]*) - ac_cv_path_MSGMERGE="$MSGMERGE" # Let the user override the test with a path. - ;; - *) - ac_save_IFS="$IFS"; IFS=$PATH_SEPARATOR - for ac_dir in $PATH; do - IFS="$ac_save_IFS" - test -z "$ac_dir" && ac_dir=. - for ac_exec_ext in '' $ac_executable_extensions; do - if $ac_executable_p "$ac_dir/$ac_word$ac_exec_ext"; then - echo "$as_me: trying $ac_dir/$ac_word..." >&5 - if $ac_dir/$ac_word --update -q /dev/null /dev/null >&5 2>&1; then - ac_cv_path_MSGMERGE="$ac_dir/$ac_word$ac_exec_ext" - break 2 - fi - fi - done - done - IFS="$ac_save_IFS" - test -z "$ac_cv_path_MSGMERGE" && ac_cv_path_MSGMERGE=":" - ;; -esac -fi -MSGMERGE="$ac_cv_path_MSGMERGE" -if test "$MSGMERGE" != ":"; then - { $as_echo "$as_me:${as_lineno-$LINENO}: result: $MSGMERGE" >&5 -$as_echo "$MSGMERGE" >&6; } -else - { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 -$as_echo "no" >&6; } -fi - - - test -n "$localedir" || localedir='${datadir}/locale' - - - test -n "${XGETTEXT_EXTRA_OPTIONS+set}" || XGETTEXT_EXTRA_OPTIONS= - - - ac_config_commands="$ac_config_commands po-directories" - - - - if test "X$prefix" = "XNONE"; then - acl_final_prefix="$ac_default_prefix" - else - acl_final_prefix="$prefix" - fi - if test "X$exec_prefix" = "XNONE"; then - acl_final_exec_prefix='${prefix}' - else - acl_final_exec_prefix="$exec_prefix" - fi - acl_save_prefix="$prefix" - prefix="$acl_final_prefix" - eval acl_final_exec_prefix=\"$acl_final_exec_prefix\" - prefix="$acl_save_prefix" - - - - acl_libdirstem=lib - acl_libdirstem2= - case "$host_os" in - solaris*) - { $as_echo "$as_me:${as_lineno-$LINENO}: checking for 64-bit host" >&5 -$as_echo_n "checking for 64-bit host... " >&6; } -if ${gl_cv_solaris_64bit+:} false; then : - $as_echo_n "(cached) " >&6 -else - cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ - -#ifdef _LP64 -sixtyfour bits -#endif - -_ACEOF -if (eval "$ac_cpp conftest.$ac_ext") 2>&5 | - $EGREP "sixtyfour bits" >/dev/null 2>&1; then : - gl_cv_solaris_64bit=yes -else - gl_cv_solaris_64bit=no -fi -rm -f conftest* - - -fi -{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $gl_cv_solaris_64bit" >&5 -$as_echo "$gl_cv_solaris_64bit" >&6; } - if test $gl_cv_solaris_64bit = yes; then - acl_libdirstem=lib/64 - case "$host_cpu" in - sparc*) acl_libdirstem2=lib/sparcv9 ;; - i*86 | x86_64) acl_libdirstem2=lib/amd64 ;; - esac - fi - ;; - *) - searchpath=`(LC_ALL=C $CC -print-search-dirs) 2>/dev/null | sed -n -e 's,^libraries: ,,p' | sed -e 's,^=,,'` - if test -n "$searchpath"; then - acl_save_IFS="${IFS= }"; IFS=":" - for searchdir in $searchpath; do - if test -d "$searchdir"; then - case "$searchdir" in - */lib64/ | */lib64 ) acl_libdirstem=lib64 ;; - */../ | */.. ) - # Better ignore directories of this form. They are misleading. - ;; - *) searchdir=`cd "$searchdir" && pwd` - case "$searchdir" in - */lib64 ) acl_libdirstem=lib64 ;; - esac ;; - esac - fi - done - IFS="$acl_save_IFS" - fi - ;; - esac - test -n "$acl_libdirstem2" || acl_libdirstem2="$acl_libdirstem" - - - - - - - - - - - - - use_additional=yes - - acl_save_prefix="$prefix" - prefix="$acl_final_prefix" - acl_save_exec_prefix="$exec_prefix" - exec_prefix="$acl_final_exec_prefix" - - eval additional_includedir=\"$includedir\" - eval additional_libdir=\"$libdir\" - - exec_prefix="$acl_save_exec_prefix" - prefix="$acl_save_prefix" - - -# Check whether --with-libiconv-prefix was given. -if test "${with_libiconv_prefix+set}" = set; then : - withval=$with_libiconv_prefix; - if test "X$withval" = "Xno"; then - use_additional=no - else - if test "X$withval" = "X"; then - - acl_save_prefix="$prefix" - prefix="$acl_final_prefix" - acl_save_exec_prefix="$exec_prefix" - exec_prefix="$acl_final_exec_prefix" - - eval additional_includedir=\"$includedir\" - eval additional_libdir=\"$libdir\" - - exec_prefix="$acl_save_exec_prefix" - prefix="$acl_save_prefix" - - else - additional_includedir="$withval/include" - additional_libdir="$withval/$acl_libdirstem" - if test "$acl_libdirstem2" != "$acl_libdirstem" \ - && ! test -d "$withval/$acl_libdirstem"; then - additional_libdir="$withval/$acl_libdirstem2" - fi - fi - fi - -fi - - LIBICONV= - LTLIBICONV= - INCICONV= - LIBICONV_PREFIX= - HAVE_LIBICONV= - rpathdirs= - ltrpathdirs= - names_already_handled= - names_next_round='iconv ' - while test -n "$names_next_round"; do - names_this_round="$names_next_round" - names_next_round= - for name in $names_this_round; do - already_handled= - for n in $names_already_handled; do - if test "$n" = "$name"; then - already_handled=yes - break - fi - done - if test -z "$already_handled"; then - names_already_handled="$names_already_handled $name" - uppername=`echo "$name" | sed -e 'y|abcdefghijklmnopqrstuvwxyz./+-|ABCDEFGHIJKLMNOPQRSTUVWXYZ____|'` - eval value=\"\$HAVE_LIB$uppername\" - if test -n "$value"; then - if test "$value" = yes; then - eval value=\"\$LIB$uppername\" - test -z "$value" || LIBICONV="${LIBICONV}${LIBICONV:+ }$value" - eval value=\"\$LTLIB$uppername\" - test -z "$value" || LTLIBICONV="${LTLIBICONV}${LTLIBICONV:+ }$value" - else - : - fi - else - found_dir= - found_la= - found_so= - found_a= - eval libname=\"$acl_libname_spec\" # typically: libname=lib$name - if test -n "$acl_shlibext"; then - shrext=".$acl_shlibext" # typically: shrext=.so - else - shrext= - fi - if test $use_additional = yes; then - dir="$additional_libdir" - if test -n "$acl_shlibext"; then - if test -f "$dir/$libname$shrext"; then - found_dir="$dir" - found_so="$dir/$libname$shrext" - else - if test "$acl_library_names_spec" = '$libname$shrext$versuffix'; then - ver=`(cd "$dir" && \ - for f in "$libname$shrext".*; do echo "$f"; done \ - | sed -e "s,^$libname$shrext\\\\.,," \ - | sort -t '.' -n -r -k1,1 -k2,2 -k3,3 -k4,4 -k5,5 \ - | sed 1q ) 2>/dev/null` - if test -n "$ver" && test -f "$dir/$libname$shrext.$ver"; then - found_dir="$dir" - found_so="$dir/$libname$shrext.$ver" - fi - else - eval library_names=\"$acl_library_names_spec\" - for f in $library_names; do - if test -f "$dir/$f"; then - found_dir="$dir" - found_so="$dir/$f" - break - fi - done - fi - fi - fi - if test "X$found_dir" = "X"; then - if test -f "$dir/$libname.$acl_libext"; then - found_dir="$dir" - found_a="$dir/$libname.$acl_libext" - fi - fi - if test "X$found_dir" != "X"; then - if test -f "$dir/$libname.la"; then - found_la="$dir/$libname.la" - fi - fi - fi - if test "X$found_dir" = "X"; then - for x in $LDFLAGS $LTLIBICONV; do - - acl_save_prefix="$prefix" - prefix="$acl_final_prefix" - acl_save_exec_prefix="$exec_prefix" - exec_prefix="$acl_final_exec_prefix" - eval x=\"$x\" - exec_prefix="$acl_save_exec_prefix" - prefix="$acl_save_prefix" - - case "$x" in - -L*) - dir=`echo "X$x" | sed -e 's/^X-L//'` - if test -n "$acl_shlibext"; then - if test -f "$dir/$libname$shrext"; then - found_dir="$dir" - found_so="$dir/$libname$shrext" - else - if test "$acl_library_names_spec" = '$libname$shrext$versuffix'; then - ver=`(cd "$dir" && \ - for f in "$libname$shrext".*; do echo "$f"; done \ - | sed -e "s,^$libname$shrext\\\\.,," \ - | sort -t '.' -n -r -k1,1 -k2,2 -k3,3 -k4,4 -k5,5 \ - | sed 1q ) 2>/dev/null` - if test -n "$ver" && test -f "$dir/$libname$shrext.$ver"; then - found_dir="$dir" - found_so="$dir/$libname$shrext.$ver" - fi - else - eval library_names=\"$acl_library_names_spec\" - for f in $library_names; do - if test -f "$dir/$f"; then - found_dir="$dir" - found_so="$dir/$f" - break - fi - done - fi - fi - fi - if test "X$found_dir" = "X"; then - if test -f "$dir/$libname.$acl_libext"; then - found_dir="$dir" - found_a="$dir/$libname.$acl_libext" - fi - fi - if test "X$found_dir" != "X"; then - if test -f "$dir/$libname.la"; then - found_la="$dir/$libname.la" - fi - fi - ;; - esac - if test "X$found_dir" != "X"; then - break - fi - done - fi - if test "X$found_dir" != "X"; then - LTLIBICONV="${LTLIBICONV}${LTLIBICONV:+ }-L$found_dir -l$name" - if test "X$found_so" != "X"; then - if test "$enable_rpath" = no \ - || test "X$found_dir" = "X/usr/$acl_libdirstem" \ - || test "X$found_dir" = "X/usr/$acl_libdirstem2"; then - LIBICONV="${LIBICONV}${LIBICONV:+ }$found_so" - else - haveit= - for x in $ltrpathdirs; do - if test "X$x" = "X$found_dir"; then - haveit=yes - break - fi - done - if test -z "$haveit"; then - ltrpathdirs="$ltrpathdirs $found_dir" - fi - if test "$acl_hardcode_direct" = yes; then - LIBICONV="${LIBICONV}${LIBICONV:+ }$found_so" - else - if test -n "$acl_hardcode_libdir_flag_spec" && test "$acl_hardcode_minus_L" = no; then - LIBICONV="${LIBICONV}${LIBICONV:+ }$found_so" - haveit= - for x in $rpathdirs; do - if test "X$x" = "X$found_dir"; then - haveit=yes - break - fi - done - if test -z "$haveit"; then - rpathdirs="$rpathdirs $found_dir" - fi - else - haveit= - for x in $LDFLAGS $LIBICONV; do - - acl_save_prefix="$prefix" - prefix="$acl_final_prefix" - acl_save_exec_prefix="$exec_prefix" - exec_prefix="$acl_final_exec_prefix" - eval x=\"$x\" - exec_prefix="$acl_save_exec_prefix" - prefix="$acl_save_prefix" - - if test "X$x" = "X-L$found_dir"; then - haveit=yes - break - fi - done - if test -z "$haveit"; then - LIBICONV="${LIBICONV}${LIBICONV:+ }-L$found_dir" - fi - if test "$acl_hardcode_minus_L" != no; then - LIBICONV="${LIBICONV}${LIBICONV:+ }$found_so" - else - LIBICONV="${LIBICONV}${LIBICONV:+ }-l$name" - fi - fi - fi - fi - else - if test "X$found_a" != "X"; then - LIBICONV="${LIBICONV}${LIBICONV:+ }$found_a" - else - LIBICONV="${LIBICONV}${LIBICONV:+ }-L$found_dir -l$name" - fi - fi - additional_includedir= - case "$found_dir" in - */$acl_libdirstem | */$acl_libdirstem/) - basedir=`echo "X$found_dir" | sed -e 's,^X,,' -e "s,/$acl_libdirstem/"'*$,,'` - if test "$name" = 'iconv'; then - LIBICONV_PREFIX="$basedir" - fi - additional_includedir="$basedir/include" - ;; - */$acl_libdirstem2 | */$acl_libdirstem2/) - basedir=`echo "X$found_dir" | sed -e 's,^X,,' -e "s,/$acl_libdirstem2/"'*$,,'` - if test "$name" = 'iconv'; then - LIBICONV_PREFIX="$basedir" - fi - additional_includedir="$basedir/include" - ;; - esac - if test "X$additional_includedir" != "X"; then - if test "X$additional_includedir" != "X/usr/include"; then - haveit= - if test "X$additional_includedir" = "X/usr/local/include"; then - if test -n "$GCC"; then - case $host_os in - linux* | gnu* | k*bsd*-gnu) haveit=yes;; - esac - fi - fi - if test -z "$haveit"; then - for x in $CPPFLAGS $INCICONV; do - - acl_save_prefix="$prefix" - prefix="$acl_final_prefix" - acl_save_exec_prefix="$exec_prefix" - exec_prefix="$acl_final_exec_prefix" - eval x=\"$x\" - exec_prefix="$acl_save_exec_prefix" - prefix="$acl_save_prefix" - - if test "X$x" = "X-I$additional_includedir"; then - haveit=yes - break - fi - done - if test -z "$haveit"; then - if test -d "$additional_includedir"; then - INCICONV="${INCICONV}${INCICONV:+ }-I$additional_includedir" - fi - fi - fi - fi - fi - if test -n "$found_la"; then - save_libdir="$libdir" - case "$found_la" in - */* | *\\*) . "$found_la" ;; - *) . "./$found_la" ;; - esac - libdir="$save_libdir" - for dep in $dependency_libs; do - case "$dep" in - -L*) - additional_libdir=`echo "X$dep" | sed -e 's/^X-L//'` - if test "X$additional_libdir" != "X/usr/$acl_libdirstem" \ - && test "X$additional_libdir" != "X/usr/$acl_libdirstem2"; then - haveit= - if test "X$additional_libdir" = "X/usr/local/$acl_libdirstem" \ - || test "X$additional_libdir" = "X/usr/local/$acl_libdirstem2"; then - if test -n "$GCC"; then - case $host_os in - linux* | gnu* | k*bsd*-gnu) haveit=yes;; - esac - fi - fi - if test -z "$haveit"; then - haveit= - for x in $LDFLAGS $LIBICONV; do - - acl_save_prefix="$prefix" - prefix="$acl_final_prefix" - acl_save_exec_prefix="$exec_prefix" - exec_prefix="$acl_final_exec_prefix" - eval x=\"$x\" - exec_prefix="$acl_save_exec_prefix" - prefix="$acl_save_prefix" - - if test "X$x" = "X-L$additional_libdir"; then - haveit=yes - break - fi - done - if test -z "$haveit"; then - if test -d "$additional_libdir"; then - LIBICONV="${LIBICONV}${LIBICONV:+ }-L$additional_libdir" - fi - fi - haveit= - for x in $LDFLAGS $LTLIBICONV; do - - acl_save_prefix="$prefix" - prefix="$acl_final_prefix" - acl_save_exec_prefix="$exec_prefix" - exec_prefix="$acl_final_exec_prefix" - eval x=\"$x\" - exec_prefix="$acl_save_exec_prefix" - prefix="$acl_save_prefix" - - if test "X$x" = "X-L$additional_libdir"; then - haveit=yes - break - fi - done - if test -z "$haveit"; then - if test -d "$additional_libdir"; then - LTLIBICONV="${LTLIBICONV}${LTLIBICONV:+ }-L$additional_libdir" - fi - fi - fi - fi - ;; - -R*) - dir=`echo "X$dep" | sed -e 's/^X-R//'` - if test "$enable_rpath" != no; then - haveit= - for x in $rpathdirs; do - if test "X$x" = "X$dir"; then - haveit=yes - break - fi - done - if test -z "$haveit"; then - rpathdirs="$rpathdirs $dir" - fi - haveit= - for x in $ltrpathdirs; do - if test "X$x" = "X$dir"; then - haveit=yes - break - fi - done - if test -z "$haveit"; then - ltrpathdirs="$ltrpathdirs $dir" - fi - fi - ;; - -l*) - names_next_round="$names_next_round "`echo "X$dep" | sed -e 's/^X-l//'` - ;; - *.la) - names_next_round="$names_next_round "`echo "X$dep" | sed -e 's,^X.*/,,' -e 's,^lib,,' -e 's,\.la$,,'` - ;; - *) - LIBICONV="${LIBICONV}${LIBICONV:+ }$dep" - LTLIBICONV="${LTLIBICONV}${LTLIBICONV:+ }$dep" - ;; - esac - done - fi - else - LIBICONV="${LIBICONV}${LIBICONV:+ }-l$name" - LTLIBICONV="${LTLIBICONV}${LTLIBICONV:+ }-l$name" - fi - fi - fi - done - done - if test "X$rpathdirs" != "X"; then - if test -n "$acl_hardcode_libdir_separator"; then - alldirs= - for found_dir in $rpathdirs; do - alldirs="${alldirs}${alldirs:+$acl_hardcode_libdir_separator}$found_dir" - done - acl_save_libdir="$libdir" - libdir="$alldirs" - eval flag=\"$acl_hardcode_libdir_flag_spec\" - libdir="$acl_save_libdir" - LIBICONV="${LIBICONV}${LIBICONV:+ }$flag" - else - for found_dir in $rpathdirs; do - acl_save_libdir="$libdir" - libdir="$found_dir" - eval flag=\"$acl_hardcode_libdir_flag_spec\" - libdir="$acl_save_libdir" - LIBICONV="${LIBICONV}${LIBICONV:+ }$flag" - done - fi - fi - if test "X$ltrpathdirs" != "X"; then - for found_dir in $ltrpathdirs; do - LTLIBICONV="${LTLIBICONV}${LTLIBICONV:+ }-R$found_dir" - done - fi - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - { $as_echo "$as_me:${as_lineno-$LINENO}: checking for CFPreferencesCopyAppValue" >&5 -$as_echo_n "checking for CFPreferencesCopyAppValue... " >&6; } -if ${gt_cv_func_CFPreferencesCopyAppValue+:} false; then : - $as_echo_n "(cached) " >&6 -else - gt_save_LIBS="$LIBS" - LIBS="$LIBS -Wl,-framework -Wl,CoreFoundation" - cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ -#include -int -main () -{ -CFPreferencesCopyAppValue(NULL, NULL) - ; - return 0; -} -_ACEOF -if ac_fn_c_try_link "$LINENO"; then : - gt_cv_func_CFPreferencesCopyAppValue=yes -else - gt_cv_func_CFPreferencesCopyAppValue=no -fi -rm -f core conftest.err conftest.$ac_objext \ - conftest$ac_exeext conftest.$ac_ext - LIBS="$gt_save_LIBS" -fi -{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $gt_cv_func_CFPreferencesCopyAppValue" >&5 -$as_echo "$gt_cv_func_CFPreferencesCopyAppValue" >&6; } - if test $gt_cv_func_CFPreferencesCopyAppValue = yes; then - -$as_echo "#define HAVE_CFPREFERENCESCOPYAPPVALUE 1" >>confdefs.h - - fi - { $as_echo "$as_me:${as_lineno-$LINENO}: checking for CFLocaleCopyCurrent" >&5 -$as_echo_n "checking for CFLocaleCopyCurrent... " >&6; } -if ${gt_cv_func_CFLocaleCopyCurrent+:} false; then : - $as_echo_n "(cached) " >&6 -else - gt_save_LIBS="$LIBS" - LIBS="$LIBS -Wl,-framework -Wl,CoreFoundation" - cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ -#include -int -main () -{ -CFLocaleCopyCurrent(); - ; - return 0; -} -_ACEOF -if ac_fn_c_try_link "$LINENO"; then : - gt_cv_func_CFLocaleCopyCurrent=yes -else - gt_cv_func_CFLocaleCopyCurrent=no -fi -rm -f core conftest.err conftest.$ac_objext \ - conftest$ac_exeext conftest.$ac_ext - LIBS="$gt_save_LIBS" -fi -{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $gt_cv_func_CFLocaleCopyCurrent" >&5 -$as_echo "$gt_cv_func_CFLocaleCopyCurrent" >&6; } - if test $gt_cv_func_CFLocaleCopyCurrent = yes; then - -$as_echo "#define HAVE_CFLOCALECOPYCURRENT 1" >>confdefs.h - - fi - INTL_MACOSX_LIBS= - if test $gt_cv_func_CFPreferencesCopyAppValue = yes || test $gt_cv_func_CFLocaleCopyCurrent = yes; then - INTL_MACOSX_LIBS="-Wl,-framework -Wl,CoreFoundation" - fi - - - - - - - LIBINTL= - LTLIBINTL= - POSUB= - - case " $gt_needs " in - *" need-formatstring-macros "*) gt_api_version=3 ;; - *" need-ngettext "*) gt_api_version=2 ;; - *) gt_api_version=1 ;; - esac - gt_func_gnugettext_libc="gt_cv_func_gnugettext${gt_api_version}_libc" - gt_func_gnugettext_libintl="gt_cv_func_gnugettext${gt_api_version}_libintl" - - if test "$USE_NLS" = "yes"; then - gt_use_preinstalled_gnugettext=no - - - if test $gt_api_version -ge 3; then - gt_revision_test_code=' -#ifndef __GNU_GETTEXT_SUPPORTED_REVISION -#define __GNU_GETTEXT_SUPPORTED_REVISION(major) ((major) == 0 ? 0 : -1) -#endif -typedef int array [2 * (__GNU_GETTEXT_SUPPORTED_REVISION(0) >= 1) - 1]; -' - else - gt_revision_test_code= - fi - if test $gt_api_version -ge 2; then - gt_expression_test_code=' + * ngettext ("", "", 0)' - else - gt_expression_test_code= - fi - - { $as_echo "$as_me:${as_lineno-$LINENO}: checking for GNU gettext in libc" >&5 -$as_echo_n "checking for GNU gettext in libc... " >&6; } -if eval \${$gt_func_gnugettext_libc+:} false; then : - $as_echo_n "(cached) " >&6 -else - cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ - -#include -#ifndef __GNU_GETTEXT_SUPPORTED_REVISION -extern int _nl_msg_cat_cntr; -extern int *_nl_domain_bindings; -#define __GNU_GETTEXT_SYMBOL_EXPRESSION (_nl_msg_cat_cntr + *_nl_domain_bindings) -#else -#define __GNU_GETTEXT_SYMBOL_EXPRESSION 0 -#endif -$gt_revision_test_code - -int -main () -{ - -bindtextdomain ("", ""); -return * gettext ("")$gt_expression_test_code + __GNU_GETTEXT_SYMBOL_EXPRESSION - - ; - return 0; -} -_ACEOF -if ac_fn_c_try_link "$LINENO"; then : - eval "$gt_func_gnugettext_libc=yes" -else - eval "$gt_func_gnugettext_libc=no" -fi -rm -f core conftest.err conftest.$ac_objext \ - conftest$ac_exeext conftest.$ac_ext -fi -eval ac_res=\$$gt_func_gnugettext_libc - { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_res" >&5 -$as_echo "$ac_res" >&6; } - - if { eval "gt_val=\$$gt_func_gnugettext_libc"; test "$gt_val" != "yes"; }; then - - - - - - am_save_CPPFLAGS="$CPPFLAGS" - - for element in $INCICONV; do - haveit= - for x in $CPPFLAGS; do - - acl_save_prefix="$prefix" - prefix="$acl_final_prefix" - acl_save_exec_prefix="$exec_prefix" - exec_prefix="$acl_final_exec_prefix" - eval x=\"$x\" - exec_prefix="$acl_save_exec_prefix" - prefix="$acl_save_prefix" - - if test "X$x" = "X$element"; then - haveit=yes - break - fi - done - if test -z "$haveit"; then - CPPFLAGS="${CPPFLAGS}${CPPFLAGS:+ }$element" - fi - done - - - { $as_echo "$as_me:${as_lineno-$LINENO}: checking for iconv" >&5 -$as_echo_n "checking for iconv... " >&6; } -if ${am_cv_func_iconv+:} false; then : - $as_echo_n "(cached) " >&6 -else - - am_cv_func_iconv="no, consider installing GNU libiconv" - am_cv_lib_iconv=no - cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ - -#include -#include - -int -main () -{ -iconv_t cd = iconv_open("",""); - iconv(cd,NULL,NULL,NULL,NULL); - iconv_close(cd); - ; - return 0; -} -_ACEOF -if ac_fn_c_try_link "$LINENO"; then : - am_cv_func_iconv=yes -fi -rm -f core conftest.err conftest.$ac_objext \ - conftest$ac_exeext conftest.$ac_ext - if test "$am_cv_func_iconv" != yes; then - am_save_LIBS="$LIBS" - LIBS="$LIBS $LIBICONV" - cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ - -#include -#include - -int -main () -{ -iconv_t cd = iconv_open("",""); - iconv(cd,NULL,NULL,NULL,NULL); - iconv_close(cd); - ; - return 0; -} -_ACEOF -if ac_fn_c_try_link "$LINENO"; then : - am_cv_lib_iconv=yes - am_cv_func_iconv=yes -fi -rm -f core conftest.err conftest.$ac_objext \ - conftest$ac_exeext conftest.$ac_ext - LIBS="$am_save_LIBS" - fi - -fi -{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $am_cv_func_iconv" >&5 -$as_echo "$am_cv_func_iconv" >&6; } - if test "$am_cv_func_iconv" = yes; then - { $as_echo "$as_me:${as_lineno-$LINENO}: checking for working iconv" >&5 -$as_echo_n "checking for working iconv... " >&6; } -if ${am_cv_func_iconv_works+:} false; then : - $as_echo_n "(cached) " >&6 -else - - am_save_LIBS="$LIBS" - if test $am_cv_lib_iconv = yes; then - LIBS="$LIBS $LIBICONV" - fi - am_cv_func_iconv_works=no - for ac_iconv_const in '' 'const'; do - if test "$cross_compiling" = yes; then : - case "$host_os" in - aix* | hpux*) am_cv_func_iconv_works="guessing no" ;; - *) am_cv_func_iconv_works="guessing yes" ;; - esac -else - cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ - -#include -#include - -#ifndef ICONV_CONST -# define ICONV_CONST $ac_iconv_const -#endif - -int -main () -{ -int result = 0; - /* Test against AIX 5.1 bug: Failures are not distinguishable from successful - returns. */ - { - iconv_t cd_utf8_to_88591 = iconv_open ("ISO8859-1", "UTF-8"); - if (cd_utf8_to_88591 != (iconv_t)(-1)) - { - static ICONV_CONST char input[] = "\342\202\254"; /* EURO SIGN */ - char buf[10]; - ICONV_CONST char *inptr = input; - size_t inbytesleft = strlen (input); - char *outptr = buf; - size_t outbytesleft = sizeof (buf); - size_t res = iconv (cd_utf8_to_88591, - &inptr, &inbytesleft, - &outptr, &outbytesleft); - if (res == 0) - result |= 1; - iconv_close (cd_utf8_to_88591); - } - } - /* Test against Solaris 10 bug: Failures are not distinguishable from - successful returns. */ - { - iconv_t cd_ascii_to_88591 = iconv_open ("ISO8859-1", "646"); - if (cd_ascii_to_88591 != (iconv_t)(-1)) - { - static ICONV_CONST char input[] = "\263"; - char buf[10]; - ICONV_CONST char *inptr = input; - size_t inbytesleft = strlen (input); - char *outptr = buf; - size_t outbytesleft = sizeof (buf); - size_t res = iconv (cd_ascii_to_88591, - &inptr, &inbytesleft, - &outptr, &outbytesleft); - if (res == 0) - result |= 2; - iconv_close (cd_ascii_to_88591); - } - } - /* Test against AIX 6.1..7.1 bug: Buffer overrun. */ - { - iconv_t cd_88591_to_utf8 = iconv_open ("UTF-8", "ISO-8859-1"); - if (cd_88591_to_utf8 != (iconv_t)(-1)) - { - static ICONV_CONST char input[] = "\304"; - static char buf[2] = { (char)0xDE, (char)0xAD }; - ICONV_CONST char *inptr = input; - size_t inbytesleft = 1; - char *outptr = buf; - size_t outbytesleft = 1; - size_t res = iconv (cd_88591_to_utf8, - &inptr, &inbytesleft, - &outptr, &outbytesleft); - if (res != (size_t)(-1) || outptr - buf > 1 || buf[1] != (char)0xAD) - result |= 4; - iconv_close (cd_88591_to_utf8); - } - } -#if 0 /* This bug could be worked around by the caller. */ - /* Test against HP-UX 11.11 bug: Positive return value instead of 0. */ - { - iconv_t cd_88591_to_utf8 = iconv_open ("utf8", "iso88591"); - if (cd_88591_to_utf8 != (iconv_t)(-1)) - { - static ICONV_CONST char input[] = "\304rger mit b\366sen B\374bchen ohne Augenma\337"; - char buf[50]; - ICONV_CONST char *inptr = input; - size_t inbytesleft = strlen (input); - char *outptr = buf; - size_t outbytesleft = sizeof (buf); - size_t res = iconv (cd_88591_to_utf8, - &inptr, &inbytesleft, - &outptr, &outbytesleft); - if ((int)res > 0) - result |= 8; - iconv_close (cd_88591_to_utf8); - } - } -#endif - /* Test against HP-UX 11.11 bug: No converter from EUC-JP to UTF-8 is - provided. */ - if (/* Try standardized names. */ - iconv_open ("UTF-8", "EUC-JP") == (iconv_t)(-1) - /* Try IRIX, OSF/1 names. */ - && iconv_open ("UTF-8", "eucJP") == (iconv_t)(-1) - /* Try AIX names. */ - && iconv_open ("UTF-8", "IBM-eucJP") == (iconv_t)(-1) - /* Try HP-UX names. */ - && iconv_open ("utf8", "eucJP") == (iconv_t)(-1)) - result |= 16; - return result; - - ; - return 0; -} -_ACEOF -if ac_fn_c_try_run "$LINENO"; then : - am_cv_func_iconv_works=yes -fi -rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext \ - conftest.$ac_objext conftest.beam conftest.$ac_ext -fi - - test "$am_cv_func_iconv_works" = no || break - done - LIBS="$am_save_LIBS" - -fi -{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $am_cv_func_iconv_works" >&5 -$as_echo "$am_cv_func_iconv_works" >&6; } - case "$am_cv_func_iconv_works" in - *no) am_func_iconv=no am_cv_lib_iconv=no ;; - *) am_func_iconv=yes ;; - esac - else - am_func_iconv=no am_cv_lib_iconv=no - fi - if test "$am_func_iconv" = yes; then - -$as_echo "#define HAVE_ICONV 1" >>confdefs.h - - fi - if test "$am_cv_lib_iconv" = yes; then - { $as_echo "$as_me:${as_lineno-$LINENO}: checking how to link with libiconv" >&5 -$as_echo_n "checking how to link with libiconv... " >&6; } - { $as_echo "$as_me:${as_lineno-$LINENO}: result: $LIBICONV" >&5 -$as_echo "$LIBICONV" >&6; } - else - CPPFLAGS="$am_save_CPPFLAGS" - LIBICONV= - LTLIBICONV= - fi - - - - - - - - - - - - use_additional=yes - - acl_save_prefix="$prefix" - prefix="$acl_final_prefix" - acl_save_exec_prefix="$exec_prefix" - exec_prefix="$acl_final_exec_prefix" - - eval additional_includedir=\"$includedir\" - eval additional_libdir=\"$libdir\" - - exec_prefix="$acl_save_exec_prefix" - prefix="$acl_save_prefix" - - -# Check whether --with-libintl-prefix was given. -if test "${with_libintl_prefix+set}" = set; then : - withval=$with_libintl_prefix; - if test "X$withval" = "Xno"; then - use_additional=no - else - if test "X$withval" = "X"; then - - acl_save_prefix="$prefix" - prefix="$acl_final_prefix" - acl_save_exec_prefix="$exec_prefix" - exec_prefix="$acl_final_exec_prefix" - - eval additional_includedir=\"$includedir\" - eval additional_libdir=\"$libdir\" - - exec_prefix="$acl_save_exec_prefix" - prefix="$acl_save_prefix" - - else - additional_includedir="$withval/include" - additional_libdir="$withval/$acl_libdirstem" - if test "$acl_libdirstem2" != "$acl_libdirstem" \ - && ! test -d "$withval/$acl_libdirstem"; then - additional_libdir="$withval/$acl_libdirstem2" - fi - fi - fi - -fi - - LIBINTL= - LTLIBINTL= - INCINTL= - LIBINTL_PREFIX= - HAVE_LIBINTL= - rpathdirs= - ltrpathdirs= - names_already_handled= - names_next_round='intl ' - while test -n "$names_next_round"; do - names_this_round="$names_next_round" - names_next_round= - for name in $names_this_round; do - already_handled= - for n in $names_already_handled; do - if test "$n" = "$name"; then - already_handled=yes - break - fi - done - if test -z "$already_handled"; then - names_already_handled="$names_already_handled $name" - uppername=`echo "$name" | sed -e 'y|abcdefghijklmnopqrstuvwxyz./+-|ABCDEFGHIJKLMNOPQRSTUVWXYZ____|'` - eval value=\"\$HAVE_LIB$uppername\" - if test -n "$value"; then - if test "$value" = yes; then - eval value=\"\$LIB$uppername\" - test -z "$value" || LIBINTL="${LIBINTL}${LIBINTL:+ }$value" - eval value=\"\$LTLIB$uppername\" - test -z "$value" || LTLIBINTL="${LTLIBINTL}${LTLIBINTL:+ }$value" - else - : - fi - else - found_dir= - found_la= - found_so= - found_a= - eval libname=\"$acl_libname_spec\" # typically: libname=lib$name - if test -n "$acl_shlibext"; then - shrext=".$acl_shlibext" # typically: shrext=.so - else - shrext= - fi - if test $use_additional = yes; then - dir="$additional_libdir" - if test -n "$acl_shlibext"; then - if test -f "$dir/$libname$shrext"; then - found_dir="$dir" - found_so="$dir/$libname$shrext" - else - if test "$acl_library_names_spec" = '$libname$shrext$versuffix'; then - ver=`(cd "$dir" && \ - for f in "$libname$shrext".*; do echo "$f"; done \ - | sed -e "s,^$libname$shrext\\\\.,," \ - | sort -t '.' -n -r -k1,1 -k2,2 -k3,3 -k4,4 -k5,5 \ - | sed 1q ) 2>/dev/null` - if test -n "$ver" && test -f "$dir/$libname$shrext.$ver"; then - found_dir="$dir" - found_so="$dir/$libname$shrext.$ver" - fi - else - eval library_names=\"$acl_library_names_spec\" - for f in $library_names; do - if test -f "$dir/$f"; then - found_dir="$dir" - found_so="$dir/$f" - break - fi - done - fi - fi - fi - if test "X$found_dir" = "X"; then - if test -f "$dir/$libname.$acl_libext"; then - found_dir="$dir" - found_a="$dir/$libname.$acl_libext" - fi - fi - if test "X$found_dir" != "X"; then - if test -f "$dir/$libname.la"; then - found_la="$dir/$libname.la" - fi - fi - fi - if test "X$found_dir" = "X"; then - for x in $LDFLAGS $LTLIBINTL; do - - acl_save_prefix="$prefix" - prefix="$acl_final_prefix" - acl_save_exec_prefix="$exec_prefix" - exec_prefix="$acl_final_exec_prefix" - eval x=\"$x\" - exec_prefix="$acl_save_exec_prefix" - prefix="$acl_save_prefix" - - case "$x" in - -L*) - dir=`echo "X$x" | sed -e 's/^X-L//'` - if test -n "$acl_shlibext"; then - if test -f "$dir/$libname$shrext"; then - found_dir="$dir" - found_so="$dir/$libname$shrext" - else - if test "$acl_library_names_spec" = '$libname$shrext$versuffix'; then - ver=`(cd "$dir" && \ - for f in "$libname$shrext".*; do echo "$f"; done \ - | sed -e "s,^$libname$shrext\\\\.,," \ - | sort -t '.' -n -r -k1,1 -k2,2 -k3,3 -k4,4 -k5,5 \ - | sed 1q ) 2>/dev/null` - if test -n "$ver" && test -f "$dir/$libname$shrext.$ver"; then - found_dir="$dir" - found_so="$dir/$libname$shrext.$ver" - fi - else - eval library_names=\"$acl_library_names_spec\" - for f in $library_names; do - if test -f "$dir/$f"; then - found_dir="$dir" - found_so="$dir/$f" - break - fi - done - fi - fi - fi - if test "X$found_dir" = "X"; then - if test -f "$dir/$libname.$acl_libext"; then - found_dir="$dir" - found_a="$dir/$libname.$acl_libext" - fi - fi - if test "X$found_dir" != "X"; then - if test -f "$dir/$libname.la"; then - found_la="$dir/$libname.la" - fi - fi - ;; - esac - if test "X$found_dir" != "X"; then - break - fi - done - fi - if test "X$found_dir" != "X"; then - LTLIBINTL="${LTLIBINTL}${LTLIBINTL:+ }-L$found_dir -l$name" - if test "X$found_so" != "X"; then - if test "$enable_rpath" = no \ - || test "X$found_dir" = "X/usr/$acl_libdirstem" \ - || test "X$found_dir" = "X/usr/$acl_libdirstem2"; then - LIBINTL="${LIBINTL}${LIBINTL:+ }$found_so" - else - haveit= - for x in $ltrpathdirs; do - if test "X$x" = "X$found_dir"; then - haveit=yes - break - fi - done - if test -z "$haveit"; then - ltrpathdirs="$ltrpathdirs $found_dir" - fi - if test "$acl_hardcode_direct" = yes; then - LIBINTL="${LIBINTL}${LIBINTL:+ }$found_so" - else - if test -n "$acl_hardcode_libdir_flag_spec" && test "$acl_hardcode_minus_L" = no; then - LIBINTL="${LIBINTL}${LIBINTL:+ }$found_so" - haveit= - for x in $rpathdirs; do - if test "X$x" = "X$found_dir"; then - haveit=yes - break - fi - done - if test -z "$haveit"; then - rpathdirs="$rpathdirs $found_dir" - fi - else - haveit= - for x in $LDFLAGS $LIBINTL; do - - acl_save_prefix="$prefix" - prefix="$acl_final_prefix" - acl_save_exec_prefix="$exec_prefix" - exec_prefix="$acl_final_exec_prefix" - eval x=\"$x\" - exec_prefix="$acl_save_exec_prefix" - prefix="$acl_save_prefix" - - if test "X$x" = "X-L$found_dir"; then - haveit=yes - break - fi - done - if test -z "$haveit"; then - LIBINTL="${LIBINTL}${LIBINTL:+ }-L$found_dir" - fi - if test "$acl_hardcode_minus_L" != no; then - LIBINTL="${LIBINTL}${LIBINTL:+ }$found_so" - else - LIBINTL="${LIBINTL}${LIBINTL:+ }-l$name" - fi - fi - fi - fi - else - if test "X$found_a" != "X"; then - LIBINTL="${LIBINTL}${LIBINTL:+ }$found_a" - else - LIBINTL="${LIBINTL}${LIBINTL:+ }-L$found_dir -l$name" - fi - fi - additional_includedir= - case "$found_dir" in - */$acl_libdirstem | */$acl_libdirstem/) - basedir=`echo "X$found_dir" | sed -e 's,^X,,' -e "s,/$acl_libdirstem/"'*$,,'` - if test "$name" = 'intl'; then - LIBINTL_PREFIX="$basedir" - fi - additional_includedir="$basedir/include" - ;; - */$acl_libdirstem2 | */$acl_libdirstem2/) - basedir=`echo "X$found_dir" | sed -e 's,^X,,' -e "s,/$acl_libdirstem2/"'*$,,'` - if test "$name" = 'intl'; then - LIBINTL_PREFIX="$basedir" - fi - additional_includedir="$basedir/include" - ;; - esac - if test "X$additional_includedir" != "X"; then - if test "X$additional_includedir" != "X/usr/include"; then - haveit= - if test "X$additional_includedir" = "X/usr/local/include"; then - if test -n "$GCC"; then - case $host_os in - linux* | gnu* | k*bsd*-gnu) haveit=yes;; - esac - fi - fi - if test -z "$haveit"; then - for x in $CPPFLAGS $INCINTL; do - - acl_save_prefix="$prefix" - prefix="$acl_final_prefix" - acl_save_exec_prefix="$exec_prefix" - exec_prefix="$acl_final_exec_prefix" - eval x=\"$x\" - exec_prefix="$acl_save_exec_prefix" - prefix="$acl_save_prefix" - - if test "X$x" = "X-I$additional_includedir"; then - haveit=yes - break - fi - done - if test -z "$haveit"; then - if test -d "$additional_includedir"; then - INCINTL="${INCINTL}${INCINTL:+ }-I$additional_includedir" - fi - fi - fi - fi - fi - if test -n "$found_la"; then - save_libdir="$libdir" - case "$found_la" in - */* | *\\*) . "$found_la" ;; - *) . "./$found_la" ;; - esac - libdir="$save_libdir" - for dep in $dependency_libs; do - case "$dep" in - -L*) - additional_libdir=`echo "X$dep" | sed -e 's/^X-L//'` - if test "X$additional_libdir" != "X/usr/$acl_libdirstem" \ - && test "X$additional_libdir" != "X/usr/$acl_libdirstem2"; then - haveit= - if test "X$additional_libdir" = "X/usr/local/$acl_libdirstem" \ - || test "X$additional_libdir" = "X/usr/local/$acl_libdirstem2"; then - if test -n "$GCC"; then - case $host_os in - linux* | gnu* | k*bsd*-gnu) haveit=yes;; - esac - fi - fi - if test -z "$haveit"; then - haveit= - for x in $LDFLAGS $LIBINTL; do - - acl_save_prefix="$prefix" - prefix="$acl_final_prefix" - acl_save_exec_prefix="$exec_prefix" - exec_prefix="$acl_final_exec_prefix" - eval x=\"$x\" - exec_prefix="$acl_save_exec_prefix" - prefix="$acl_save_prefix" - - if test "X$x" = "X-L$additional_libdir"; then - haveit=yes - break - fi - done - if test -z "$haveit"; then - if test -d "$additional_libdir"; then - LIBINTL="${LIBINTL}${LIBINTL:+ }-L$additional_libdir" - fi - fi - haveit= - for x in $LDFLAGS $LTLIBINTL; do - - acl_save_prefix="$prefix" - prefix="$acl_final_prefix" - acl_save_exec_prefix="$exec_prefix" - exec_prefix="$acl_final_exec_prefix" - eval x=\"$x\" - exec_prefix="$acl_save_exec_prefix" - prefix="$acl_save_prefix" - - if test "X$x" = "X-L$additional_libdir"; then - haveit=yes - break - fi - done - if test -z "$haveit"; then - if test -d "$additional_libdir"; then - LTLIBINTL="${LTLIBINTL}${LTLIBINTL:+ }-L$additional_libdir" - fi - fi - fi - fi - ;; - -R*) - dir=`echo "X$dep" | sed -e 's/^X-R//'` - if test "$enable_rpath" != no; then - haveit= - for x in $rpathdirs; do - if test "X$x" = "X$dir"; then - haveit=yes - break - fi - done - if test -z "$haveit"; then - rpathdirs="$rpathdirs $dir" - fi - haveit= - for x in $ltrpathdirs; do - if test "X$x" = "X$dir"; then - haveit=yes - break - fi - done - if test -z "$haveit"; then - ltrpathdirs="$ltrpathdirs $dir" - fi - fi - ;; - -l*) - names_next_round="$names_next_round "`echo "X$dep" | sed -e 's/^X-l//'` - ;; - *.la) - names_next_round="$names_next_round "`echo "X$dep" | sed -e 's,^X.*/,,' -e 's,^lib,,' -e 's,\.la$,,'` - ;; - *) - LIBINTL="${LIBINTL}${LIBINTL:+ }$dep" - LTLIBINTL="${LTLIBINTL}${LTLIBINTL:+ }$dep" - ;; - esac - done - fi - else - LIBINTL="${LIBINTL}${LIBINTL:+ }-l$name" - LTLIBINTL="${LTLIBINTL}${LTLIBINTL:+ }-l$name" - fi - fi - fi - done - done - if test "X$rpathdirs" != "X"; then - if test -n "$acl_hardcode_libdir_separator"; then - alldirs= - for found_dir in $rpathdirs; do - alldirs="${alldirs}${alldirs:+$acl_hardcode_libdir_separator}$found_dir" - done - acl_save_libdir="$libdir" - libdir="$alldirs" - eval flag=\"$acl_hardcode_libdir_flag_spec\" - libdir="$acl_save_libdir" - LIBINTL="${LIBINTL}${LIBINTL:+ }$flag" - else - for found_dir in $rpathdirs; do - acl_save_libdir="$libdir" - libdir="$found_dir" - eval flag=\"$acl_hardcode_libdir_flag_spec\" - libdir="$acl_save_libdir" - LIBINTL="${LIBINTL}${LIBINTL:+ }$flag" - done - fi - fi - if test "X$ltrpathdirs" != "X"; then - for found_dir in $ltrpathdirs; do - LTLIBINTL="${LTLIBINTL}${LTLIBINTL:+ }-R$found_dir" - done - fi - - - - - - - { $as_echo "$as_me:${as_lineno-$LINENO}: checking for GNU gettext in libintl" >&5 -$as_echo_n "checking for GNU gettext in libintl... " >&6; } -if eval \${$gt_func_gnugettext_libintl+:} false; then : - $as_echo_n "(cached) " >&6 -else - gt_save_CPPFLAGS="$CPPFLAGS" - CPPFLAGS="$CPPFLAGS $INCINTL" - gt_save_LIBS="$LIBS" - LIBS="$LIBS $LIBINTL" - cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ - -#include -#ifndef __GNU_GETTEXT_SUPPORTED_REVISION -extern int _nl_msg_cat_cntr; -extern -#ifdef __cplusplus -"C" -#endif -const char *_nl_expand_alias (const char *); -#define __GNU_GETTEXT_SYMBOL_EXPRESSION (_nl_msg_cat_cntr + *_nl_expand_alias ("")) -#else -#define __GNU_GETTEXT_SYMBOL_EXPRESSION 0 -#endif -$gt_revision_test_code - -int -main () -{ - -bindtextdomain ("", ""); -return * gettext ("")$gt_expression_test_code + __GNU_GETTEXT_SYMBOL_EXPRESSION - - ; - return 0; -} -_ACEOF -if ac_fn_c_try_link "$LINENO"; then : - eval "$gt_func_gnugettext_libintl=yes" -else - eval "$gt_func_gnugettext_libintl=no" -fi -rm -f core conftest.err conftest.$ac_objext \ - conftest$ac_exeext conftest.$ac_ext - if { eval "gt_val=\$$gt_func_gnugettext_libintl"; test "$gt_val" != yes; } && test -n "$LIBICONV"; then - LIBS="$LIBS $LIBICONV" - cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ - -#include -#ifndef __GNU_GETTEXT_SUPPORTED_REVISION -extern int _nl_msg_cat_cntr; -extern -#ifdef __cplusplus -"C" -#endif -const char *_nl_expand_alias (const char *); -#define __GNU_GETTEXT_SYMBOL_EXPRESSION (_nl_msg_cat_cntr + *_nl_expand_alias ("")) -#else -#define __GNU_GETTEXT_SYMBOL_EXPRESSION 0 -#endif -$gt_revision_test_code - -int -main () -{ - -bindtextdomain ("", ""); -return * gettext ("")$gt_expression_test_code + __GNU_GETTEXT_SYMBOL_EXPRESSION - - ; - return 0; -} -_ACEOF -if ac_fn_c_try_link "$LINENO"; then : - LIBINTL="$LIBINTL $LIBICONV" - LTLIBINTL="$LTLIBINTL $LTLIBICONV" - eval "$gt_func_gnugettext_libintl=yes" - -fi -rm -f core conftest.err conftest.$ac_objext \ - conftest$ac_exeext conftest.$ac_ext - fi - CPPFLAGS="$gt_save_CPPFLAGS" - LIBS="$gt_save_LIBS" -fi -eval ac_res=\$$gt_func_gnugettext_libintl - { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_res" >&5 -$as_echo "$ac_res" >&6; } - fi - - if { eval "gt_val=\$$gt_func_gnugettext_libc"; test "$gt_val" = "yes"; } \ - || { { eval "gt_val=\$$gt_func_gnugettext_libintl"; test "$gt_val" = "yes"; } \ - && test "$PACKAGE" != gettext-runtime \ - && test "$PACKAGE" != gettext-tools; }; then - gt_use_preinstalled_gnugettext=yes - else - LIBINTL= - LTLIBINTL= - INCINTL= - fi - - - - if test -n "$INTL_MACOSX_LIBS"; then - if test "$gt_use_preinstalled_gnugettext" = "yes" \ - || test "$nls_cv_use_gnu_gettext" = "yes"; then - LIBINTL="$LIBINTL $INTL_MACOSX_LIBS" - LTLIBINTL="$LTLIBINTL $INTL_MACOSX_LIBS" - fi - fi - - if test "$gt_use_preinstalled_gnugettext" = "yes" \ - || test "$nls_cv_use_gnu_gettext" = "yes"; then - -$as_echo "#define ENABLE_NLS 1" >>confdefs.h - - else - USE_NLS=no - fi - fi - - { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether to use NLS" >&5 -$as_echo_n "checking whether to use NLS... " >&6; } - { $as_echo "$as_me:${as_lineno-$LINENO}: result: $USE_NLS" >&5 -$as_echo "$USE_NLS" >&6; } - if test "$USE_NLS" = "yes"; then - { $as_echo "$as_me:${as_lineno-$LINENO}: checking where the gettext function comes from" >&5 -$as_echo_n "checking where the gettext function comes from... " >&6; } - if test "$gt_use_preinstalled_gnugettext" = "yes"; then - if { eval "gt_val=\$$gt_func_gnugettext_libintl"; test "$gt_val" = "yes"; }; then - gt_source="external libintl" - else - gt_source="libc" - fi - else - gt_source="included intl directory" - fi - { $as_echo "$as_me:${as_lineno-$LINENO}: result: $gt_source" >&5 -$as_echo "$gt_source" >&6; } - fi - - if test "$USE_NLS" = "yes"; then - - if test "$gt_use_preinstalled_gnugettext" = "yes"; then - if { eval "gt_val=\$$gt_func_gnugettext_libintl"; test "$gt_val" = "yes"; }; then - { $as_echo "$as_me:${as_lineno-$LINENO}: checking how to link with libintl" >&5 -$as_echo_n "checking how to link with libintl... " >&6; } - { $as_echo "$as_me:${as_lineno-$LINENO}: result: $LIBINTL" >&5 -$as_echo "$LIBINTL" >&6; } - - for element in $INCINTL; do - haveit= - for x in $CPPFLAGS; do - - acl_save_prefix="$prefix" - prefix="$acl_final_prefix" - acl_save_exec_prefix="$exec_prefix" - exec_prefix="$acl_final_exec_prefix" - eval x=\"$x\" - exec_prefix="$acl_save_exec_prefix" - prefix="$acl_save_prefix" - - if test "X$x" = "X$element"; then - haveit=yes - break - fi - done - if test -z "$haveit"; then - CPPFLAGS="${CPPFLAGS}${CPPFLAGS:+ }$element" - fi - done - - fi - - -$as_echo "#define HAVE_GETTEXT 1" >>confdefs.h - - -$as_echo "#define HAVE_DCGETTEXT 1" >>confdefs.h - - fi - - POSUB=po - fi - - - - INTLLIBS="$LIBINTL" - - - - - - - -if test "x$LTLIBINTL" != "x"; then - COBC_LIBS="$COBC_LIBS $LTLIBINTL" - LIBCOB_LIBS="$LIBCOB_LIBS $LTLIBINTL" -fi - -# Checks for internationalization stuff -# AM_ICONV - - { $as_echo "$as_me:${as_lineno-$LINENO}: checking for nl_langinfo and CODESET" >&5 -$as_echo_n "checking for nl_langinfo and CODESET... " >&6; } -if ${am_cv_langinfo_codeset+:} false; then : - $as_echo_n "(cached) " >&6 -else - cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ -#include -int -main () -{ -char* cs = nl_langinfo(CODESET); return !cs; - ; - return 0; -} -_ACEOF -if ac_fn_c_try_link "$LINENO"; then : - am_cv_langinfo_codeset=yes -else - am_cv_langinfo_codeset=no -fi -rm -f core conftest.err conftest.$ac_objext \ - conftest$ac_exeext conftest.$ac_ext - -fi -{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $am_cv_langinfo_codeset" >&5 -$as_echo "$am_cv_langinfo_codeset" >&6; } - if test $am_cv_langinfo_codeset = yes; then - -$as_echo "#define HAVE_LANGINFO_CODESET 1" >>confdefs.h - - fi - - -# Checks for ncurses/pdcurses/curses. -{ $as_echo "$as_me:${as_lineno-$LINENO}: Checks for curses ..." >&5 -$as_echo "$as_me: Checks for curses ..." >&6;} - - -# Check whether --with-curses was given. -if test "${with_curses+set}" = set; then : - withval=$with_curses; case "$with_curses" in - ncursesw | ncurses | pdcurses | curses | check | no) - USE_CURSES="$with_curses" - ;; - yes) - USE_CURSES="check" - ;; - *) - as_fn_error $? "invalid value \"$with_curses\" for --with-curses, - must be one of the following: - ncursesw, ncurses, pdcurses, curses (use only the specified library) - check (use whatever curses library is usable, disable if no one usable) - no (disable curses usage)" "$LINENO" 5 - ;; - esac -else - USE_CURSES="check" -fi - - -if test "$USE_CURSES" = "ncursesw" -o "$USE_CURSES" = "check"; then - { $as_echo "$as_me:${as_lineno-$LINENO}: checking for initscr in -lncursesw" >&5 -$as_echo_n "checking for initscr in -lncursesw... " >&6; } -if ${ac_cv_lib_ncursesw_initscr+:} false; then : - $as_echo_n "(cached) " >&6 -else - ac_check_lib_save_LIBS=$LIBS -LIBS="-lncursesw $LIBS" -cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ - -/* Override any GCC internal prototype to avoid an error. - Use char because int might match the return type of a GCC - builtin and then its argument prototype would still apply. */ -#ifdef __cplusplus -extern "C" -#endif -char initscr (); -int -main () -{ -return initscr (); - ; - return 0; -} -_ACEOF -if ac_fn_c_try_link "$LINENO"; then : - ac_cv_lib_ncursesw_initscr=yes -else - ac_cv_lib_ncursesw_initscr=no -fi -rm -f core conftest.err conftest.$ac_objext \ - conftest$ac_exeext conftest.$ac_ext -LIBS=$ac_check_lib_save_LIBS -fi -{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_ncursesw_initscr" >&5 -$as_echo "$ac_cv_lib_ncursesw_initscr" >&6; } -if test "x$ac_cv_lib_ncursesw_initscr" = xyes; then : - cat >>confdefs.h <<_ACEOF -#define HAVE_LIBNCURSESW 1 -_ACEOF - - LIBS="-lncursesw $LIBS" - -fi - - if test "x$ac_cv_lib_ncursesw_initscr" = "xyes"; then - for ac_header in ncursesw/ncurses.h -do : - ac_fn_c_check_header_mongrel "$LINENO" "ncursesw/ncurses.h" "ac_cv_header_ncursesw_ncurses_h" "$ac_includes_default" -if test "x$ac_cv_header_ncursesw_ncurses_h" = xyes; then : - cat >>confdefs.h <<_ACEOF -#define HAVE_NCURSESW_NCURSES_H 1 -_ACEOF - USE_CURSES="ncursesw" -else - for ac_header in ncursesw/curses.h -do : - ac_fn_c_check_header_mongrel "$LINENO" "ncursesw/curses.h" "ac_cv_header_ncursesw_curses_h" "$ac_includes_default" -if test "x$ac_cv_header_ncursesw_curses_h" = xyes; then : - cat >>confdefs.h <<_ACEOF -#define HAVE_NCURSESW_CURSES_H 1 -_ACEOF - USE_CURSES="ncursesw" -else - if test "$USE_CURSES" = "ncursesw"; then - USE_CURSES="missing_header" - fi -fi - -done - -fi - -done - - if test "$USE_CURSES" = "ncursesw"; then - LIBCOB_LIBS="$LIBCOB_LIBS -lncursesw" - fi - else - if test "$USE_CURSES" = "ncursesw"; then - USE_CURSES="missing_lib" - fi - fi -fi - -if test "$USE_CURSES" = "ncurses" -o "$USE_CURSES" = "check"; then - { $as_echo "$as_me:${as_lineno-$LINENO}: checking for initscr in -lncurses" >&5 -$as_echo_n "checking for initscr in -lncurses... " >&6; } -if ${ac_cv_lib_ncurses_initscr+:} false; then : - $as_echo_n "(cached) " >&6 -else - ac_check_lib_save_LIBS=$LIBS -LIBS="-lncurses $LIBS" -cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ - -/* Override any GCC internal prototype to avoid an error. - Use char because int might match the return type of a GCC - builtin and then its argument prototype would still apply. */ -#ifdef __cplusplus -extern "C" -#endif -char initscr (); -int -main () -{ -return initscr (); - ; - return 0; -} -_ACEOF -if ac_fn_c_try_link "$LINENO"; then : - ac_cv_lib_ncurses_initscr=yes -else - ac_cv_lib_ncurses_initscr=no -fi -rm -f core conftest.err conftest.$ac_objext \ - conftest$ac_exeext conftest.$ac_ext -LIBS=$ac_check_lib_save_LIBS -fi -{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_ncurses_initscr" >&5 -$as_echo "$ac_cv_lib_ncurses_initscr" >&6; } -if test "x$ac_cv_lib_ncurses_initscr" = xyes; then : - cat >>confdefs.h <<_ACEOF -#define HAVE_LIBNCURSES 1 -_ACEOF - - LIBS="-lncurses $LIBS" - -fi - - if test "x$ac_cv_lib_ncurses_initscr" = "xyes"; then - for ac_header in ncurses.h -do : - ac_fn_c_check_header_mongrel "$LINENO" "ncurses.h" "ac_cv_header_ncurses_h" "$ac_includes_default" -if test "x$ac_cv_header_ncurses_h" = xyes; then : - cat >>confdefs.h <<_ACEOF -#define HAVE_NCURSES_H 1 -_ACEOF - USE_CURSES="ncurses" -else - for ac_header in ncurses/ncurses.h -do : - ac_fn_c_check_header_mongrel "$LINENO" "ncurses/ncurses.h" "ac_cv_header_ncurses_ncurses_h" "$ac_includes_default" -if test "x$ac_cv_header_ncurses_ncurses_h" = xyes; then : - cat >>confdefs.h <<_ACEOF -#define HAVE_NCURSES_NCURSES_H 1 -_ACEOF - USE_CURSES="ncurses" -else - for ac_header in curses.h -do : - ac_fn_c_check_header_mongrel "$LINENO" "curses.h" "ac_cv_header_curses_h" "$ac_includes_default" -if test "x$ac_cv_header_curses_h" = xyes; then : - cat >>confdefs.h <<_ACEOF -#define HAVE_CURSES_H 1 -_ACEOF - USE_CURSES="ncurses" -else - if test "$USE_CURSES" = "ncurses"; then - USE_CURSES="missing_header" - fi -fi - -done - -fi - -done - -fi - -done - - if test "$USE_CURSES" = "ncurses"; then - LIBCOB_LIBS="$LIBCOB_LIBS -lncurses" - fi - else - if test "$USE_CURSES" = "ncurses"; then - USE_CURSES="missing_lib" - fi - fi -fi - - -if test "$USE_CURSES" = "pdcurses" -o "$USE_CURSES" = "check"; then - { $as_echo "$as_me:${as_lineno-$LINENO}: checking for initscr in -lpdcurses" >&5 -$as_echo_n "checking for initscr in -lpdcurses... " >&6; } -if ${ac_cv_lib_pdcurses_initscr+:} false; then : - $as_echo_n "(cached) " >&6 -else - ac_check_lib_save_LIBS=$LIBS -LIBS="-lpdcurses $LIBS" -cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ - -/* Override any GCC internal prototype to avoid an error. - Use char because int might match the return type of a GCC - builtin and then its argument prototype would still apply. */ -#ifdef __cplusplus -extern "C" -#endif -char initscr (); -int -main () -{ -return initscr (); - ; - return 0; -} -_ACEOF -if ac_fn_c_try_link "$LINENO"; then : - ac_cv_lib_pdcurses_initscr=yes -else - ac_cv_lib_pdcurses_initscr=no -fi -rm -f core conftest.err conftest.$ac_objext \ - conftest$ac_exeext conftest.$ac_ext -LIBS=$ac_check_lib_save_LIBS -fi -{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_pdcurses_initscr" >&5 -$as_echo "$ac_cv_lib_pdcurses_initscr" >&6; } -if test "x$ac_cv_lib_pdcurses_initscr" = xyes; then : - cat >>confdefs.h <<_ACEOF -#define HAVE_LIBPDCURSES 1 -_ACEOF - - LIBS="-lpdcurses $LIBS" - -fi - - if test "x$ac_cv_lib_pdcurses_initscr" = "xyes"; then - for ac_header in pdcurses.h -do : - ac_fn_c_check_header_mongrel "$LINENO" "pdcurses.h" "ac_cv_header_pdcurses_h" "$ac_includes_default" -if test "x$ac_cv_header_pdcurses_h" = xyes; then : - cat >>confdefs.h <<_ACEOF -#define HAVE_PDCURSES_H 1 -_ACEOF - USE_CURSES="pdcurses" -else - for ac_header in curses.h -do : - ac_fn_c_check_header_mongrel "$LINENO" "curses.h" "ac_cv_header_curses_h" "$ac_includes_default" -if test "x$ac_cv_header_curses_h" = xyes; then : - cat >>confdefs.h <<_ACEOF -#define HAVE_CURSES_H 1 -_ACEOF - USE_CURSES="pdcurses" -else - if test "$USE_CURSES" = "pdcurses"; then - USE_CURSES="missing_header" - fi -fi - -done - -fi - -done - - if test "$USE_CURSES" = "pdcurses"; then - LIBCOB_LIBS="$LIBCOB_LIBS -lpdcurses" - fi - else - if test "$USE_CURSES" = "pdcurses"; then - USE_CURSES="missing_lib" - fi - fi -fi - -if test "$USE_CURSES" = "curses" -o "$USE_CURSES" = "check"; then - { $as_echo "$as_me:${as_lineno-$LINENO}: checking for initscr in -lcurses" >&5 -$as_echo_n "checking for initscr in -lcurses... " >&6; } -if ${ac_cv_lib_curses_initscr+:} false; then : - $as_echo_n "(cached) " >&6 -else - ac_check_lib_save_LIBS=$LIBS -LIBS="-lcurses $LIBS" -cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ - -/* Override any GCC internal prototype to avoid an error. - Use char because int might match the return type of a GCC - builtin and then its argument prototype would still apply. */ -#ifdef __cplusplus -extern "C" -#endif -char initscr (); -int -main () -{ -return initscr (); - ; - return 0; -} -_ACEOF -if ac_fn_c_try_link "$LINENO"; then : - ac_cv_lib_curses_initscr=yes -else - ac_cv_lib_curses_initscr=no -fi -rm -f core conftest.err conftest.$ac_objext \ - conftest$ac_exeext conftest.$ac_ext -LIBS=$ac_check_lib_save_LIBS -fi -{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_curses_initscr" >&5 -$as_echo "$ac_cv_lib_curses_initscr" >&6; } -if test "x$ac_cv_lib_curses_initscr" = xyes; then : - cat >>confdefs.h <<_ACEOF -#define HAVE_LIBCURSES 1 -_ACEOF - - LIBS="-lcurses $LIBS" - -fi - - if test "x$ac_cv_lib_curses_initscr" = "xyes"; then - for ac_header in curses.h -do : - ac_fn_c_check_header_mongrel "$LINENO" "curses.h" "ac_cv_header_curses_h" "$ac_includes_default" -if test "x$ac_cv_header_curses_h" = xyes; then : - cat >>confdefs.h <<_ACEOF -#define HAVE_CURSES_H 1 -_ACEOF - USE_CURSES="curses" -else - if test "$USE_CURSES" = "curses"; then - USE_CURSES="missing_header" - fi -fi - -done - - if test "$USE_CURSES" != "no"; then - LIBCOB_LIBS="$LIBCOB_LIBS -lcurses" - fi - fi -else - if test "$USE_CURSES" = "curses"; then - USE_CURSES="missing_lib" - fi -fi - -case "$USE_CURSES" in - check) - USE_CURSES="not_found" - $as_echo "#define WITH_CURSES \"no curses found\"" >>confdefs.h - - ;; - no) - $as_echo "#define WITH_CURSES \"disabled\"" >>confdefs.h - - ;; - missing_lib) - as_fn_error $? "Not able to link configured library $with_curses" "$LINENO" 5 - ;; - missing_header) - as_fn_error $? "No header found for configured library $with_curses" "$LINENO" 5 - ;; - ncursesw) - $as_echo "#define WITH_CURSES \"ncursesw\"" >>confdefs.h - - ;; - ncurses) - $as_echo "#define WITH_CURSES \"ncurses\"" >>confdefs.h - - ;; - pdcurses) - $as_echo "#define WITH_CURSES \"pdcurses\"" >>confdefs.h - - ;; - curses) - $as_echo "#define WITH_CURSES \"curses\"" >>confdefs.h - - ;; -esac - - -if test "$USE_CURSES" = "ncurses" -o "$USE_CURSES" = "ncursesw"; then - { $as_echo "$as_me:${as_lineno-$LINENO}: checking for ncurses _nc_freeall function" >&5 -$as_echo_n "checking for ncurses _nc_freeall function... " >&6; } - cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ - - extern void _nc_freeall (void); -int -main () -{ -_nc_freeall (); - ; - return 0; -} -_ACEOF -if ac_fn_c_try_link "$LINENO"; then : - $as_echo "#define HAVE_CURSES_FREEALL 1" >>confdefs.h - { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5 -$as_echo "yes" >&6; } -else - { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 -$as_echo "no" >&6; } -fi -rm -f core conftest.err conftest.$ac_objext \ - conftest$ac_exeext conftest.$ac_ext - { $as_echo "$as_me:${as_lineno-$LINENO}: checking for ncurses use_legacy_coding function" >&5 -$as_echo_n "checking for ncurses use_legacy_coding function... " >&6; } - cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ - - extern void use_legacy_coding (void); -int -main () -{ -use_legacy_coding (); - ; - return 0; -} -_ACEOF -if ac_fn_c_try_link "$LINENO"; then : - $as_echo "#define HAVE_USE_LEGACY_CODING 1" >>confdefs.h - { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5 -$as_echo "yes" >&6; } -else - { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 -$as_echo "no" >&6; } -fi -rm -f core conftest.err conftest.$ac_objext \ - conftest$ac_exeext conftest.$ac_ext -fi - -if test "$USE_CURSES" != "no" -a "$USE_CURSES" != "not_found"; then - { $as_echo "$as_me:${as_lineno-$LINENO}: checking for curses color_set function" >&5 -$as_echo_n "checking for curses color_set function... " >&6; } - cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ - - #ifdef HAVE_NCURSESW_NCURSES_H - #include - #elif defined (HAVE_NCURSESW_CURSES_H) - #include - #elif defined (HAVE_NCURSES_H) - #include - #elif defined (HAVE_NCURSES_NCURSES_H) - #include - #elif defined (HAVE_PDCURSES_H) - #include - #elif defined (HAVE_CURSES_H) - #include - #endif -int -main () -{ - - color_set (0, NULL); - - ; - return 0; -} -_ACEOF -if ac_fn_c_try_link "$LINENO"; then : - $as_echo "#define HAVE_COLOR_SET 1" >>confdefs.h - { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5 -$as_echo "yes" >&6; } -else - { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 -$as_echo "no" >&6; } -fi -rm -f core conftest.err conftest.$ac_objext \ - conftest$ac_exeext conftest.$ac_ext - - { $as_echo "$as_me:${as_lineno-$LINENO}: checking for curses define_key function" >&5 -$as_echo_n "checking for curses define_key function... " >&6; } - cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ - - #ifdef HAVE_NCURSESW_NCURSES_H - #include - #elif defined (HAVE_NCURSESW_CURSES_H) - #include - #elif defined (HAVE_NCURSES_H) - #include - #elif defined (HAVE_NCURSES_NCURSES_H) - #include - #elif defined (HAVE_PDCURSES_H) - #include - #elif defined (HAVE_CURSES_H) - #include - #endif -int -main () -{ - - define_key ("\E-3;3~", (KEY_MAX + 1)); - - ; - return 0; -} -_ACEOF -if ac_fn_c_try_link "$LINENO"; then : - $as_echo "#define HAVE_DEFINE_KEY 1" >>confdefs.h - { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5 -$as_echo "yes" >&6; } -else - { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 -$as_echo "no" >&6; } -fi -rm -f core conftest.err conftest.$ac_objext \ - conftest$ac_exeext conftest.$ac_ext - - { $as_echo "$as_me:${as_lineno-$LINENO}: checking for curses mouseinterval function" >&5 -$as_echo_n "checking for curses mouseinterval function... " >&6; } - cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ - - #ifdef HAVE_NCURSESW_NCURSES_H - #include - #elif defined (HAVE_NCURSESW_CURSES_H) - #include - #elif defined (HAVE_NCURSES_H) - #include - #elif defined (HAVE_NCURSES_NCURSES_H) - #include - #elif defined (HAVE_PDCURSES_H) - #include - #elif defined (HAVE_CURSES_H) - #include - #endif -int -main () -{ - - mouseinterval (-1); - - ; - return 0; -} -_ACEOF -if ac_fn_c_try_link "$LINENO"; then : - $as_echo "#define HAVE_MOUSEINTERVAL 1" >>confdefs.h - { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5 -$as_echo "yes" >&6; } -else - { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 -$as_echo "no" >&6; } -fi -rm -f core conftest.err conftest.$ac_objext \ - conftest$ac_exeext conftest.$ac_ext - - { $as_echo "$as_me:${as_lineno-$LINENO}: checking for curses has_mouse function" >&5 -$as_echo_n "checking for curses has_mouse function... " >&6; } - cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ - - #ifdef HAVE_NCURSESW_NCURSES_H - #include - #elif defined (HAVE_NCURSESW_CURSES_H) - #include - #elif defined (HAVE_NCURSES_H) - #include - #elif defined (HAVE_NCURSES_NCURSES_H) - #include - #elif defined (HAVE_PDCURSES_H) - #include - #elif defined (HAVE_CURSES_H) - #include - #endif -int -main () -{ - - has_mouse (); - - ; - return 0; -} -_ACEOF -if ac_fn_c_try_link "$LINENO"; then : - $as_echo "#define HAVE_HAS_MOUSE 1" >>confdefs.h - { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5 -$as_echo "yes" >&6; } -else - { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 -$as_echo "no" >&6; } -fi -rm -f core conftest.err conftest.$ac_objext \ - conftest$ac_exeext conftest.$ac_ext -fi - - -# Check whether --with-seqra-extfh was given. -if test "${with_seqra_extfh+set}" = set; then : - withval=$with_seqra_extfh; if test "$with_seqra_extfh" = "yes"; then - $as_echo "#define WITH_SEQRA_EXTFH 1" >>confdefs.h - - fi -fi - - - -# Check whether --with-indexed was given. -if test "${with_indexed+set}" = set; then : - withval=$with_indexed; case "$with_indexed" in - vbisam) - with_vbisam=yes - $as_echo "#define WITH_INDEXED COB_IO_VBISAM" >>confdefs.h - - $as_echo "#define WITH_IXDFLT \"VB-ISAM\"" >>confdefs.h -;; - disam) - with_disam=yes - $as_echo "#define WITH_INDEXED COB_IO_DISAM" >>confdefs.h - - $as_echo "#define WITH_IXDFLT \"D-ISAM\"" >>confdefs.h -;; - cisam) - with_cisam=yes - $as_echo "#define WITH_INDEXED COB_IO_CISAM" >>confdefs.h - - $as_echo "#define WITH_IXDFLT \"C-ISAM\"" >>confdefs.h -;; - db) - with_db=yes - $as_echo "#define WITH_INDEXED COB_IO_BDB" >>confdefs.h - - $as_echo "#define WITH_IXDFLT \"BDB\"" >>confdefs.h -;; - lmdb) - with_lmdb=yes - $as_echo "#define WITH_INDEXED COB_IO_LMDB" >>confdefs.h - - $as_echo "#define WITH_IXDFLT \"LMDB\"" >>confdefs.h -;; - odbc) - with_odbc=yes - $as_echo "#define WITH_INDEXED COB_IO_ODBC" >>confdefs.h - - $as_echo "#define WITH_IXDFLT \"ODBC\"" >>confdefs.h -;; - oci) - with_oci=yes - $as_echo "#define WITH_INDEXED COB_IO_OCI" >>confdefs.h - - $as_echo "#define WITH_IXDFLT \"OCI\"" >>confdefs.h -;; - *) - if test "$with_vbisam" = "yes"; then - $as_echo "#define WITH_INDEXED COB_IO_VBISAM" >>confdefs.h - - $as_echo "#define WITH_IXDFLT \"VB-ISAM\"" >>confdefs.h - - elif test "$with_disam" = "yes"; then - $as_echo "#define WITH_INDEXED COB_IO_DISAM" >>confdefs.h - - $as_echo "#define WITH_IXDFLT \"D-ISAM\"" >>confdefs.h - - elif test "$with_cisam" = "yes"; then - $as_echo "#define WITH_INDEXED COB_IO_CISAM" >>confdefs.h - - $as_echo "#define WITH_IXDFLT \"C-ISAM\"" >>confdefs.h - - elif test "$with_db" = "yes"; then - $as_echo "#define WITH_INDEXED COB_IO_BDB" >>confdefs.h - - $as_echo "#define WITH_IXDFLT \"BDB\"" >>confdefs.h - - elif test "$with_lmdb" = "yes"; then - $as_echo "#define WITH_INDEXED COB_IO_LMDB" >>confdefs.h - - $as_echo "#define WITH_IXDFLT \"LMDB\"" >>confdefs.h - - elif test "$with_odbc" = "yes"; then - $as_echo "#define WITH_ODBC COB_IO_ODBC" >>confdefs.h - - $as_echo "#define WITH_IXDFLT \"ODBC\"" >>confdefs.h - - elif test "$with_oci" = "yes"; then - $as_echo "#define WITH_OCI COB_IO_OCI" >>confdefs.h - - $as_echo "#define WITH_IXDFLT \"OCI\"" >>confdefs.h - - else - as_fn_error $? "--with-indexed=, must be one of vbisam|disam|cisam|db|lmdb|odbc|oci" "$LINENO" 5 - fi ;; - esac - -else - - if test "$with_vbisam" = "yes"; then - $as_echo "#define WITH_INDEXED COB_IO_VBISAM" >>confdefs.h - - $as_echo "#define WITH_IXDFLT \"VB-ISAM\"" >>confdefs.h - - elif test "$with_disam" = "yes"; then - $as_echo "#define WITH_INDEXED COB_IO_DISAM" >>confdefs.h - - $as_echo "#define WITH_IXDFLT \"D-ISAM\"" >>confdefs.h - - elif test "$with_cisam" = "yes"; then - $as_echo "#define WITH_INDEXED COB_IO_CISAM" >>confdefs.h - - $as_echo "#define WITH_IXDFLT \"C-ISAM\"" >>confdefs.h - - elif test "$with_db" = "yes"; then - $as_echo "#define WITH_INDEXED COB_IO_BDB" >>confdefs.h - - $as_echo "#define WITH_IXDFLT \"BDB\"" >>confdefs.h - - elif test "$with_lmdb" = "yes"; then - $as_echo "#define WITH_INDEXED COB_IO_LMDB" >>confdefs.h - - $as_echo "#define WITH_IXDFLT \"LMDB\"" >>confdefs.h - - elif test "$with_odbc" = "yes"; then - $as_echo "#define WITH_INDEXED COB_IO_ODBC" >>confdefs.h - - $as_echo "#define WITH_IXDFLT \"ODBC\"" >>confdefs.h - - elif test "$with_oci" = "yes"; then - $as_echo "#define WITH_INDEXED COB_IO_OCI" >>confdefs.h - - $as_echo "#define WITH_IXDFLT \"OCI\"" >>confdefs.h - - fi - -fi - - -LIBCOB_ISAM="" -LIBCOB_VBISAM="" -LIBCOB_DISAM="" -LIBCOB_CISAM="" -cob_multi_isam=no -cob_gen_vbisam=no -cob_gen_disam=no -cob_gen_cisam=no - - -# Check whether --with-vbisam was given. -if test "${with_vbisam+set}" = set; then : - withval=$with_vbisam; if test "$with_vbisam" = "yes"; then - for ac_header in vbisam.h -do : - ac_fn_c_check_header_mongrel "$LINENO" "vbisam.h" "ac_cv_header_vbisam_h" "$ac_includes_default" -if test "x$ac_cv_header_vbisam_h" = xyes; then : - cat >>confdefs.h <<_ACEOF -#define HAVE_VBISAM_H 1 -_ACEOF - -else - as_fn_error $? "vbisam.h is required for VBISAM" "$LINENO" 5 -fi - -done - - # note: isfullclose is available since 2.0, isopen since 1.0 - { $as_echo "$as_me:${as_lineno-$LINENO}: checking for isfullclose in -lvbisam" >&5 -$as_echo_n "checking for isfullclose in -lvbisam... " >&6; } -if ${ac_cv_lib_vbisam_isfullclose+:} false; then : - $as_echo_n "(cached) " >&6 -else - ac_check_lib_save_LIBS=$LIBS -LIBS="-lvbisam $LIBS" -cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ - -/* Override any GCC internal prototype to avoid an error. - Use char because int might match the return type of a GCC - builtin and then its argument prototype would still apply. */ -#ifdef __cplusplus -extern "C" -#endif -char isfullclose (); -int -main () -{ -return isfullclose (); - ; - return 0; -} -_ACEOF -if ac_fn_c_try_link "$LINENO"; then : - ac_cv_lib_vbisam_isfullclose=yes -else - ac_cv_lib_vbisam_isfullclose=no -fi -rm -f core conftest.err conftest.$ac_objext \ - conftest$ac_exeext conftest.$ac_ext -LIBS=$ac_check_lib_save_LIBS -fi -{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_vbisam_isfullclose" >&5 -$as_echo "$ac_cv_lib_vbisam_isfullclose" >&6; } -if test "x$ac_cv_lib_vbisam_isfullclose" = xyes; then : - $as_echo "#define WITH_VBISAM 1" >>confdefs.h - - LIBCOB_ISAM="$LIBCOB_ISAM -lvbisam" - LIBCOB_VBISAM="-lvbisam" -else - as_fn_error $? "libvbisam >= 2.0 is required for VBISAM" "$LINENO" 5 -fi - - if test "$with_cisam" = "yes" -o "$with_disam" = "yes"; then - cob_multi_isam=yes - fi - cob_gen_vbisam=yes - fi -fi - - - -# Check whether --with-disam was given. -if test "${with_disam+set}" = set; then : - withval=$with_disam; if test "$with_disam" = "yes"; then - for ac_header in disam.h -do : - ac_fn_c_check_header_mongrel "$LINENO" "disam.h" "ac_cv_header_disam_h" "$ac_includes_default" -if test "x$ac_cv_header_disam_h" = xyes; then : - cat >>confdefs.h <<_ACEOF -#define HAVE_DISAM_H 1 -_ACEOF - -else - as_fn_error $? "disam.h is required for DISAM" "$LINENO" 5 -fi - -done - - - for cobdisam in disam disam8 disam72 disam71 disam7 - do - as_ac_Lib=`$as_echo "ac_cv_lib_$cobdisam''_isopen" | $as_tr_sh` -{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for isopen in -l$cobdisam" >&5 -$as_echo_n "checking for isopen in -l$cobdisam... " >&6; } -if eval \${$as_ac_Lib+:} false; then : - $as_echo_n "(cached) " >&6 -else - ac_check_lib_save_LIBS=$LIBS -LIBS="-l$cobdisam $LIBS" -cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ - -/* Override any GCC internal prototype to avoid an error. - Use char because int might match the return type of a GCC - builtin and then its argument prototype would still apply. */ -#ifdef __cplusplus -extern "C" -#endif -char isopen (); -int -main () -{ -return isopen (); - ; - return 0; -} -_ACEOF -if ac_fn_c_try_link "$LINENO"; then : - eval "$as_ac_Lib=yes" -else - eval "$as_ac_Lib=no" -fi -rm -f core conftest.err conftest.$ac_objext \ - conftest$ac_exeext conftest.$ac_ext -LIBS=$ac_check_lib_save_LIBS -fi -eval ac_res=\$$as_ac_Lib - { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_res" >&5 -$as_echo "$ac_res" >&6; } -if eval test \"x\$"$as_ac_Lib"\" = x"yes"; then : - $as_echo "#define WITH_DISAM 1" >>confdefs.h - - LIBCOB_ISAM="$LIBCOB_ISAM -l$cobdisam" - LIBCOB_DISAM="-l$cobdisam" - cob_got_disam=yes - break -fi - - done - if test "$cob_got_disam" = "yes"; then - { $as_echo "$as_me:${as_lineno-$LINENO}: DISAM library found as -l$cobdisam" >&5 -$as_echo "$as_me: DISAM library found as -l$cobdisam" >&6;} - else - as_fn_error $? "DISAM library not found" "$LINENO" 5 - fi - if test "$with_cisam" = "yes"; then - cob_multi_isam=yes - fi - cob_gen_disam=yes - unset cobdisam - unset cob_got_disam - fi -fi - - - -# Check whether --with-cisam was given. -if test "${with_cisam+set}" = set; then : - withval=$with_cisam; if test "$with_cisam" = "yes"; then - cob_gen_cisam=yes - for ac_header in isam.h -do : - ac_fn_c_check_header_mongrel "$LINENO" "isam.h" "ac_cv_header_isam_h" "$ac_includes_default" -if test "x$ac_cv_header_isam_h" = xyes; then : - cat >>confdefs.h <<_ACEOF -#define HAVE_ISAM_H 1 -_ACEOF - -else - as_fn_error $? "isam.h is required for CISAM" "$LINENO" 5 -fi - -done - - { $as_echo "$as_me:${as_lineno-$LINENO}: checking for isopen in -lifisam" >&5 -$as_echo_n "checking for isopen in -lifisam... " >&6; } -if ${ac_cv_lib_ifisam_isopen+:} false; then : - $as_echo_n "(cached) " >&6 -else - ac_check_lib_save_LIBS=$LIBS -LIBS="-lifisam -lifisamx $LIBS" -cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ - -/* Override any GCC internal prototype to avoid an error. - Use char because int might match the return type of a GCC - builtin and then its argument prototype would still apply. */ -#ifdef __cplusplus -extern "C" -#endif -char isopen (); -int -main () -{ -return isopen (); - ; - return 0; -} -_ACEOF -if ac_fn_c_try_link "$LINENO"; then : - ac_cv_lib_ifisam_isopen=yes -else - ac_cv_lib_ifisam_isopen=no -fi -rm -f core conftest.err conftest.$ac_objext \ - conftest$ac_exeext conftest.$ac_ext -LIBS=$ac_check_lib_save_LIBS -fi -{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_ifisam_isopen" >&5 -$as_echo "$ac_cv_lib_ifisam_isopen" >&6; } -if test "x$ac_cv_lib_ifisam_isopen" = xyes; then : - $as_echo "#define WITH_CISAM 1" >>confdefs.h - - LIBCOB_ISAM="$LIBCOB_ISAM -lifisam -lifisamx" - LIBCOB_CISAM="-lifisam -lifisamx" -else - as_fn_error $? "libifisam is required for CISAM" "$LINENO" 5 -fi - - fi -fi - - -if test "$cob_multi_isam" = "no"; then - LIBCOB_LIBS="$LIBCOB_LIBS $LIBCOB_ISAM" - LIBCOB_VBISAM="" - LIBCOB_DISAM="" - LIBCOB_CISAM="" -else - $as_echo "#define WITH_MULTI_ISAM 1" >>confdefs.h - -fi - - -# Check whether --with-index-extfh was given. -if test "${with_index_extfh+set}" = set; then : - withval=$with_index_extfh; if test "$with_index_extfh" = "yes"; then - $as_echo "#define WITH_INDEX_EXTFH 1" >>confdefs.h - - fi -fi - - - -# Check whether --with-odbc was given. -if test "${with_odbc+set}" = set; then : - withval=$with_odbc; if test "$with_odbc" = "yes"; then - -pkg_failed=no -{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for odbc" >&5 -$as_echo_n "checking for odbc... " >&6; } - -if test -n "$ODBC_CFLAGS"; then - pkg_cv_ODBC_CFLAGS="$ODBC_CFLAGS" - elif test -n "$PKG_CONFIG"; then - if test -n "$PKG_CONFIG" && \ - { { $as_echo "$as_me:${as_lineno-$LINENO}: \$PKG_CONFIG --exists --print-errors \"odbc\""; } >&5 - ($PKG_CONFIG --exists --print-errors "odbc") 2>&5 - ac_status=$? - $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 - test $ac_status = 0; }; then - pkg_cv_ODBC_CFLAGS=`$PKG_CONFIG --cflags "odbc" 2>/dev/null` - test "x$?" != "x0" && pkg_failed=yes -else - pkg_failed=yes -fi - else - pkg_failed=untried -fi -if test -n "$ODBC_LIBS"; then - pkg_cv_ODBC_LIBS="$ODBC_LIBS" - elif test -n "$PKG_CONFIG"; then - if test -n "$PKG_CONFIG" && \ - { { $as_echo "$as_me:${as_lineno-$LINENO}: \$PKG_CONFIG --exists --print-errors \"odbc\""; } >&5 - ($PKG_CONFIG --exists --print-errors "odbc") 2>&5 - ac_status=$? - $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 - test $ac_status = 0; }; then - pkg_cv_ODBC_LIBS=`$PKG_CONFIG --libs "odbc" 2>/dev/null` - test "x$?" != "x0" && pkg_failed=yes -else - pkg_failed=yes -fi - else - pkg_failed=untried -fi - - - -if test $pkg_failed = yes; then - { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 -$as_echo "no" >&6; } - -if $PKG_CONFIG --atleast-pkgconfig-version 0.20; then - _pkg_short_errors_supported=yes -else - _pkg_short_errors_supported=no -fi - if test $_pkg_short_errors_supported = yes; then - ODBC_PKG_ERRORS=`$PKG_CONFIG --short-errors --print-errors --cflags --libs "odbc" 2>&1` - else - ODBC_PKG_ERRORS=`$PKG_CONFIG --print-errors --cflags --libs "odbc" 2>&1` - fi - # Put the nasty error message in config.log where it belongs - echo "$ODBC_PKG_ERRORS" >&5 - - # -elif test $pkg_failed = untried; then - { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 -$as_echo "no" >&6; } - # -else - ODBC_CFLAGS=$pkg_cv_ODBC_CFLAGS - ODBC_LIBS=$pkg_cv_ODBC_LIBS - { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5 -$as_echo "yes" >&6; } - -fi - - if test -n "$ODBC_CFLAGS"; then - CPPFLAGS="$CPPFLAGS $ODBC_CFLAGS" - fi - for ac_header in sql.h sqlext.h -do : - as_ac_Header=`$as_echo "ac_cv_header_$ac_header" | $as_tr_sh` -ac_fn_c_check_header_mongrel "$LINENO" "$ac_header" "$as_ac_Header" "$ac_includes_default" -if eval test \"x\$"$as_ac_Header"\" = x"yes"; then : - cat >>confdefs.h <<_ACEOF -#define `$as_echo "HAVE_$ac_header" | $as_tr_cpp` 1 -_ACEOF - -else - as_fn_error $? "sql.h and sqlext.h are required for ODBC" "$LINENO" 5 -fi - -done - -# later on: also allow DB2 (possibly similar to xISAM) -# AC_CHECK_HEADERS([sqlcli1.h sqlca.h sqludf.h], [], -# AC_MSG_ERROR([sqlcli1.h, sqlca.h, and sqludf.h are required for ODBC (DB2)])) - - if test -n "$ODBC_LIBS"; then - LIBS="$LIBS $ODBC_LIBS" - fi - { $as_echo "$as_me:${as_lineno-$LINENO}: checking for SQLConnect in -lodbc" >&5 -$as_echo_n "checking for SQLConnect in -lodbc... " >&6; } -if ${ac_cv_lib_odbc_SQLConnect+:} false; then : - $as_echo_n "(cached) " >&6 -else - ac_check_lib_save_LIBS=$LIBS -LIBS="-lodbc $LIBS" -cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ - -/* Override any GCC internal prototype to avoid an error. - Use char because int might match the return type of a GCC - builtin and then its argument prototype would still apply. */ -#ifdef __cplusplus -extern "C" -#endif -char SQLConnect (); -int -main () -{ -return SQLConnect (); - ; - return 0; -} -_ACEOF -if ac_fn_c_try_link "$LINENO"; then : - ac_cv_lib_odbc_SQLConnect=yes -else - ac_cv_lib_odbc_SQLConnect=no -fi -rm -f core conftest.err conftest.$ac_objext \ - conftest$ac_exeext conftest.$ac_ext -LIBS=$ac_check_lib_save_LIBS -fi -{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_odbc_SQLConnect" >&5 -$as_echo "$ac_cv_lib_odbc_SQLConnect" >&6; } -if test "x$ac_cv_lib_odbc_SQLConnect" = xyes; then : - $as_echo "#define WITH_ODBC 1" >>confdefs.h - - LIBCOB_LIBS="$LIBCOB_LIBS $ODBC_LIBS -lodbc" - -else - as_fn_error $? "libodbc is required for ODBC" "$LINENO" 5 -fi - - fi -fi - - - -# Check whether --with-oci was given. -if test "${with_oci+set}" = set; then : - withval=$with_oci; if test "$with_oci" = "yes"; then - if test -n "$OCI_CFLAGS"; then - CPPFLAGS="$CPPFLAGS $OCI_CFLAGS" - elif test -n "$ORACLE_HOME"; then - CPPFLAGS="$CPPFLAGS -I${ORACLE_HOME}/rdbms/public" - fi - for ac_header in oci.h -do : - ac_fn_c_check_header_mongrel "$LINENO" "oci.h" "ac_cv_header_oci_h" "$ac_includes_default" -if test "x$ac_cv_header_oci_h" = xyes; then : - cat >>confdefs.h <<_ACEOF -#define HAVE_OCI_H 1 -_ACEOF - -else - as_fn_error $? "oci.h is required for Oracle OCI" "$LINENO" 5 -fi - -done - - - if test -n "$OCI_LIBS"; then - LIBS="$LIBS $OCI_LIBS" - elif test -n "$ORACLE_HOME"; then - OCI_LIBS="-L${ORACLE_HOME}/lib" - LIBS="$LIBS $OCI_LIBS" - fi - { $as_echo "$as_me:${as_lineno-$LINENO}: checking for OCIEnvCreate in -lclntsh" >&5 -$as_echo_n "checking for OCIEnvCreate in -lclntsh... " >&6; } -if ${ac_cv_lib_clntsh_OCIEnvCreate+:} false; then : - $as_echo_n "(cached) " >&6 -else - ac_check_lib_save_LIBS=$LIBS -LIBS="-lclntsh $LIBS" -cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ - -/* Override any GCC internal prototype to avoid an error. - Use char because int might match the return type of a GCC - builtin and then its argument prototype would still apply. */ -#ifdef __cplusplus -extern "C" -#endif -char OCIEnvCreate (); -int -main () -{ -return OCIEnvCreate (); - ; - return 0; -} -_ACEOF -if ac_fn_c_try_link "$LINENO"; then : - ac_cv_lib_clntsh_OCIEnvCreate=yes -else - ac_cv_lib_clntsh_OCIEnvCreate=no -fi -rm -f core conftest.err conftest.$ac_objext \ - conftest$ac_exeext conftest.$ac_ext -LIBS=$ac_check_lib_save_LIBS -fi -{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_clntsh_OCIEnvCreate" >&5 -$as_echo "$ac_cv_lib_clntsh_OCIEnvCreate" >&6; } -if test "x$ac_cv_lib_clntsh_OCIEnvCreate" = xyes; then : - $as_echo "#define WITH_OCI 1" >>confdefs.h - - LIBCOB_LIBS="$LIBCOB_LIBS $OCI_LIBS -lclntsh" - -else - as_fn_error $? "libclnt is required for Oracle OCI" "$LINENO" 5 -fi - - fi -fi - - - -# Check whether --with-db was given. -if test "${with_db+set}" = set; then : - withval=$with_db; -fi - - - -# Check whether --with-lmdb was given. -if test "${with_lmdb+set}" = set; then : - withval=$with_lmdb; if test "$with_lmdb" = "yes"; then - $as_echo "#define WITH_LMDB 1" >>confdefs.h - - fi -fi - - -# -## Checks for indexed handlers -# - -if test "$with_db" = "yes"; then - { $as_echo "$as_me:${as_lineno-$LINENO}: Checks for Berkeley DB ..." >&5 -$as_echo "$as_me: Checks for Berkeley DB ..." >&6;} - - for ac_header in db.h -do : - ac_fn_c_check_header_mongrel "$LINENO" "db.h" "ac_cv_header_db_h" "$ac_includes_default" -if test "x$ac_cv_header_db_h" = xyes; then : - cat >>confdefs.h <<_ACEOF -#define HAVE_DB_H 1 -_ACEOF - -else - as_fn_error $? "Berkeley DB db.h is missing" "$LINENO" 5 -fi - -done - - - # BDB header exists. Extract major/minor number pair - COB_BDB_HEADER='' - COB_BDB_HEADER_STR='' - if test "$cross_compiling" = yes; then : - { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: cannot run test program while cross-compiling" >&5 -$as_echo "$as_me: WARNING: cannot run test program while cross-compiling" >&2;} - COB_BDB_HEADER="cross" - COB_BDB_HEADER_STR="cross" -else - cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ - - #include - #include - int main (int argc, char **argv) - { - (void)argv; - if (argc == 2) - printf ("%d.%d", DB_VERSION_MAJOR, DB_VERSION_MINOR); - if (argc == 3) - printf ("-%s-", DB_VERSION_STRING); - return 0; - } - -_ACEOF -if ac_fn_c_try_run "$LINENO"; then : - COB_BDB_HEADER=`./conftest$ac_exeext x` - COB_BDB_HEADER_STR=`./conftest$ac_exeext x y` -else - as_fn_error $? "Unable to extract Berkeley DB version information from db.h" "$LINENO" 5 -fi -rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext \ - conftest.$ac_objext conftest.beam conftest.$ac_ext -fi - - if test "x$COB_BDB_HEADER" = "x"; then - as_fn_error $? "Unable to extract Berkeley DB version information" "$LINENO" 5 - fi - if test "x$COB_BDB_HEADER_STR" != "x"; then - { $as_echo "$as_me:${as_lineno-$LINENO}: db.h reports version \"$COB_BDB_HEADER_STR\"" >&5 -$as_echo "$as_me: db.h reports version \"$COB_BDB_HEADER_STR\"" >&6;} - fi - if test "$COB_BDB_HEADER_STR" != "cross"; then - { $as_echo "$as_me:${as_lineno-$LINENO}: checking for Berkeley DB db.h version >= 4.1" >&5 -$as_echo_n "checking for Berkeley DB db.h version >= 4.1... " >&6; } - COB_BDB_HEADER_MAJOR=$(echo "$COB_BDB_HEADER" | cut -d. -f1) - if test $COB_BDB_HEADER_MAJOR -gt 4; then - { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes ($COB_BDB_HEADER)" >&5 -$as_echo "yes ($COB_BDB_HEADER)" >&6; } - else - COB_BDB_HEADER_MINOR=$(echo "$COB_BDB_HEADER" | cut -d. -f2) - if test $COB_BDB_HEADER_MAJOR -eq 4 -a $COB_BDB_HEADER_MINOR -ge 1; then - { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes ($COB_BDB_HEADER)" >&5 -$as_echo "yes ($COB_BDB_HEADER)" >&6; } - else - { $as_echo "$as_me:${as_lineno-$LINENO}: result: no ($COB_BDB_HEADER)" >&5 -$as_echo "no ($COB_BDB_HEADER)" >&6; } - as_fn_error $? "Berkeley DB db.h has incompatible version" "$LINENO" 5 - fi - fi - MYOLDLIBS="$LIBS" - cob_got_db=no - { $as_echo "$as_me:${as_lineno-$LINENO}: checking for Berkeley DB library with version $COB_BDB_HEADER" >&5 -$as_echo_n "checking for Berkeley DB library with version $COB_BDB_HEADER... " >&6; } - # prefer library with version number included as some systems link against wrong version - # of the library and to not break when a newer BDB version is installed, see bug #100 - for cobdb in db-$COB_BDB_HEADER db - do - LIBS="$MYOLDLIBS -l$cobdb" - if test "$cross_compiling" = yes; then : - { { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 -$as_echo "$as_me: error: in \`$ac_pwd':" >&2;} -as_fn_error $? "cannot run test program while cross compiling -See \`config.log' for more details" "$LINENO" 5; } -else - cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ -#include - #include -int -main () -{ - - int major, minor, patch; - db_version (&major, &minor, &patch); - if (major == DB_VERSION_MAJOR && minor == DB_VERSION_MINOR) { - return 0; - } - return 1; - ; - return 0; -} -_ACEOF -if ac_fn_c_try_run "$LINENO"; then : - $as_echo "#define WITH_DB 1" >>confdefs.h - - cob_got_db=yes - LIBCOB_LIBS="$LIBCOB_LIBS -l$cobdb" - break -fi -rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext \ - conftest.$ac_objext conftest.beam conftest.$ac_ext -fi - - done - LIBS="$MYOLDLIBS" - if test "$cob_got_db" = "yes"; then - { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5 -$as_echo "yes" >&6; } - { $as_echo "$as_me:${as_lineno-$LINENO}: BDB library version $COB_BDB_HEADER found as -l$cobdb" >&5 -$as_echo "$as_me: BDB library version $COB_BDB_HEADER found as -l$cobdb" >&6;} - else - { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 -$as_echo "no" >&6; } - as_fn_error $? "BDB library version $COB_BDB_HEADER not found" "$LINENO" 5 - fi - else - { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: Matching BDB version (>=4.1) assumed" >&5 -$as_echo "$as_me: WARNING: Matching BDB version (>=4.1) assumed" >&2;} - { $as_echo "$as_me:${as_lineno-$LINENO}: checking for db_version in -ldb" >&5 -$as_echo_n "checking for db_version in -ldb... " >&6; } -if ${ac_cv_lib_db_db_version+:} false; then : - $as_echo_n "(cached) " >&6 -else - ac_check_lib_save_LIBS=$LIBS -LIBS="-ldb $LIBS" -cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ - -/* Override any GCC internal prototype to avoid an error. - Use char because int might match the return type of a GCC - builtin and then its argument prototype would still apply. */ -#ifdef __cplusplus -extern "C" -#endif -char db_version (); -int -main () -{ -return db_version (); - ; - return 0; -} -_ACEOF -if ac_fn_c_try_link "$LINENO"; then : - ac_cv_lib_db_db_version=yes -else - ac_cv_lib_db_db_version=no -fi -rm -f core conftest.err conftest.$ac_objext \ - conftest$ac_exeext conftest.$ac_ext -LIBS=$ac_check_lib_save_LIBS -fi -{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_db_db_version" >&5 -$as_echo "$ac_cv_lib_db_db_version" >&6; } -if test "x$ac_cv_lib_db_db_version" = xyes; then : - LIBCOB_LIBS="$LIBCOB_LIBS -ldb" -else - as_fn_error $? "BDB library is required as -ldb" "$LINENO" 5 -fi - - fi - unset cobdb - unset cob_got_db - unset COB_BDB_HEADER -fi - - -if test "$with_lmdb" = "yes"; then - { $as_echo "$as_me:${as_lineno-$LINENO}: Checks for Lightning Memory-Mapped Database (LMDB) ..." >&5 -$as_echo "$as_me: Checks for Lightning Memory-Mapped Database (LMDB) ..." >&6;} - ac_fn_c_check_header_mongrel "$LINENO" "lmdb.h" "ac_cv_header_lmdb_h" "$ac_includes_default" -if test "x$ac_cv_header_lmdb_h" = xyes; then : - -else - as_fn_error $? "LMDB lmdb.h is missing" "$LINENO" 5 -fi - - - - # MDB header exists. Extract major/minor/patch numbers - COB_MDB_HEADER='' - COB_MDB_HEADER_STR='' - if test "$cross_compiling" = yes; then : - { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: cannot run test program while cross-compiling" >&5 -$as_echo "$as_me: WARNING: cannot run test program while cross-compiling" >&2;} - COB_MDB_HEADER="cross" - COB_MDB_HEADER_STR="cross" -else - cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ - - #include - #include - int main (int argc, char **argv) - { - (void)argv; - if (argc == 2) - printf ("%d.%d.%d", MDB_VERSION_MAJOR, MDB_VERSION_MINOR, MDB_VERSION_PATCH); - if (argc == 3) - printf ("-%s-", MDB_VERSION_STRING); - return 0; - } - -_ACEOF -if ac_fn_c_try_run "$LINENO"; then : - COB_MDB_HEADER=`./conftest$ac_exeext x` - COB_MDB_HEADER_STR=`./conftest$ac_exeext x y` -else - as_fn_error $? "Unable to extract LMDB version information from lmdb.h" "$LINENO" 5 -fi -rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext \ - conftest.$ac_objext conftest.beam conftest.$ac_ext -fi - - if test "x$COB_MDB_HEADER" = "x"; then - as_fn_error $? "Unable to extract LMDB version information" "$LINENO" 5 - fi - if test "x$COB_MDB_HEADER_STR" != "x"; then - { $as_echo "$as_me:${as_lineno-$LINENO}: lmdb.h reports version \"$COB_MDB_HEADER_STR\"" >&5 -$as_echo "$as_me: lmdb.h reports version \"$COB_MDB_HEADER_STR\"" >&6;} - fi - { $as_echo "$as_me:${as_lineno-$LINENO}: checking for mdb_version in -llmdb" >&5 -$as_echo_n "checking for mdb_version in -llmdb... " >&6; } -if ${ac_cv_lib_lmdb_mdb_version+:} false; then : - $as_echo_n "(cached) " >&6 -else - ac_check_lib_save_LIBS=$LIBS -LIBS="-llmdb $LIBS" -cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ - -/* Override any GCC internal prototype to avoid an error. - Use char because int might match the return type of a GCC - builtin and then its argument prototype would still apply. */ -#ifdef __cplusplus -extern "C" -#endif -char mdb_version (); -int -main () -{ -return mdb_version (); - ; - return 0; -} -_ACEOF -if ac_fn_c_try_link "$LINENO"; then : - ac_cv_lib_lmdb_mdb_version=yes -else - ac_cv_lib_lmdb_mdb_version=no -fi -rm -f core conftest.err conftest.$ac_objext \ - conftest$ac_exeext conftest.$ac_ext -LIBS=$ac_check_lib_save_LIBS -fi -{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_lmdb_mdb_version" >&5 -$as_echo "$ac_cv_lib_lmdb_mdb_version" >&6; } -if test "x$ac_cv_lib_lmdb_mdb_version" = xyes; then : - $as_echo "#define WITH_LMDB 1" >>confdefs.h - - LIBCOB_LIBS="$LIBCOB_LIBS -llmdb" -else - as_fn_error $? "liblmdb is required for LMDB" "$LINENO" 5 -fi - - - { $as_echo "$as_me:${as_lineno-$LINENO}: checking for Symas LMDB version >= 0.9.19" >&5 -$as_echo_n "checking for Symas LMDB version >= 0.9.19... " >&6; } - COB_MDB_HEADER_MAJOR=$(echo "$COB_MDB_HEADER" | cut -d. -f1) - COB_MDB_HEADER_PATCH=$(echo "$COB_MDB_HEADER" | cut -d. -f3) - if test "$COB_MDB_HEADER_STR" != "cross"; then - if test $COB_MDB_HEADER_MAJOR -gt 0; then - { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes ($COB_MDB_HEADER)" >&5 -$as_echo "yes ($COB_MDB_HEADER)" >&6; } - else - if test $COB_MDB_HEADER_PATCH -gt 18; then - { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes ($COB_MDB_HEADER)" >&5 -$as_echo "yes ($COB_MDB_HEADER)" >&6; } - else - { $as_echo "$as_me:${as_lineno-$LINENO}: result: no ($COB_MDB_HEADER)" >&5 -$as_echo "no ($COB_MDB_HEADER)" >&6; } - as_fn_error $? "LMDB version < 0.9.19" "$LINENO" 5 - fi - fi - fi -fi - -# Checks for dl/ltdl. -DEFINE_DL="no" - -{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for _WIN32" >&5 -$as_echo_n "checking for _WIN32... " >&6; } -cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ - - #ifndef _WIN32 - # error macro not defined - #endif -_ACEOF -if ac_fn_c_try_compile "$LINENO"; then : - DEFINE_DL="yes" - { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5 -$as_echo "yes" >&6; } -else - { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 -$as_echo "no" >&6; } -fi -rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext - -if test "$DEFINE_DL" = "no" -a "$with_dl" = "yes"; then - if test "x$ac_cv_header_dlfcn_h" = "xyes"; then - { $as_echo "$as_me:${as_lineno-$LINENO}: checking for dlopen in -lc" >&5 -$as_echo_n "checking for dlopen in -lc... " >&6; } -if ${ac_cv_lib_c_dlopen+:} false; then : - $as_echo_n "(cached) " >&6 -else - ac_check_lib_save_LIBS=$LIBS -LIBS="-lc $LIBS" -cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ - -/* Override any GCC internal prototype to avoid an error. - Use char because int might match the return type of a GCC - builtin and then its argument prototype would still apply. */ -#ifdef __cplusplus -extern "C" -#endif -char dlopen (); -int -main () -{ -return dlopen (); - ; - return 0; -} -_ACEOF -if ac_fn_c_try_link "$LINENO"; then : - ac_cv_lib_c_dlopen=yes -else - ac_cv_lib_c_dlopen=no -fi -rm -f core conftest.err conftest.$ac_objext \ - conftest$ac_exeext conftest.$ac_ext -LIBS=$ac_check_lib_save_LIBS -fi -{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_c_dlopen" >&5 -$as_echo "$ac_cv_lib_c_dlopen" >&6; } -if test "x$ac_cv_lib_c_dlopen" = xyes; then : - DEFINE_DL="yes" -fi - - if test "$DEFINE_DL" = "no"; then - { $as_echo "$as_me:${as_lineno-$LINENO}: checking for dlopen in -ldl" >&5 -$as_echo_n "checking for dlopen in -ldl... " >&6; } -if ${ac_cv_lib_dl_dlopen+:} false; then : - $as_echo_n "(cached) " >&6 -else - ac_check_lib_save_LIBS=$LIBS -LIBS="-ldl $LIBS" -cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ - -/* Override any GCC internal prototype to avoid an error. - Use char because int might match the return type of a GCC - builtin and then its argument prototype would still apply. */ -#ifdef __cplusplus -extern "C" -#endif -char dlopen (); -int -main () -{ -return dlopen (); - ; - return 0; -} -_ACEOF -if ac_fn_c_try_link "$LINENO"; then : - ac_cv_lib_dl_dlopen=yes -else - ac_cv_lib_dl_dlopen=no -fi -rm -f core conftest.err conftest.$ac_objext \ - conftest$ac_exeext conftest.$ac_ext -LIBS=$ac_check_lib_save_LIBS -fi -{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_dl_dlopen" >&5 -$as_echo "$ac_cv_lib_dl_dlopen" >&6; } -if test "x$ac_cv_lib_dl_dlopen" = xyes; then : - DEFINE_DL="yes" -fi - - if test "$DEFINE_DL" = "yes"; then - $as_echo "#define USE_LIBDL 1" >>confdefs.h - - LIBCOB_LIBS="$LIBCOB_LIBS -ldl" - { $as_echo "$as_me:${as_lineno-$LINENO}: checking for dladdr in -ldl" >&5 -$as_echo_n "checking for dladdr in -ldl... " >&6; } -if ${ac_cv_lib_dl_dladdr+:} false; then : - $as_echo_n "(cached) " >&6 -else - ac_check_lib_save_LIBS=$LIBS -LIBS="-ldl $LIBS" -cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ - -/* Override any GCC internal prototype to avoid an error. - Use char because int might match the return type of a GCC - builtin and then its argument prototype would still apply. */ -#ifdef __cplusplus -extern "C" -#endif -char dladdr (); -int -main () -{ -return dladdr (); - ; - return 0; -} -_ACEOF -if ac_fn_c_try_link "$LINENO"; then : - ac_cv_lib_dl_dladdr=yes -else - ac_cv_lib_dl_dladdr=no -fi -rm -f core conftest.err conftest.$ac_objext \ - conftest$ac_exeext conftest.$ac_ext -LIBS=$ac_check_lib_save_LIBS -fi -{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_dl_dladdr" >&5 -$as_echo "$ac_cv_lib_dl_dladdr" >&6; } -if test "x$ac_cv_lib_dl_dladdr" = xyes; then : - $as_echo "#define HAVE_DLADDR 1" >>confdefs.h - -fi - - else - { $as_echo "$as_me:${as_lineno-$LINENO}: checking for dlopen in -ldld" >&5 -$as_echo_n "checking for dlopen in -ldld... " >&6; } -if ${ac_cv_lib_dld_dlopen+:} false; then : - $as_echo_n "(cached) " >&6 -else - ac_check_lib_save_LIBS=$LIBS -LIBS="-ldld $LIBS" -cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ - -/* Override any GCC internal prototype to avoid an error. - Use char because int might match the return type of a GCC - builtin and then its argument prototype would still apply. */ -#ifdef __cplusplus -extern "C" -#endif -char dlopen (); -int -main () -{ -return dlopen (); - ; - return 0; -} -_ACEOF -if ac_fn_c_try_link "$LINENO"; then : - ac_cv_lib_dld_dlopen=yes -else - ac_cv_lib_dld_dlopen=no -fi -rm -f core conftest.err conftest.$ac_objext \ - conftest$ac_exeext conftest.$ac_ext -LIBS=$ac_check_lib_save_LIBS -fi -{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_dld_dlopen" >&5 -$as_echo "$ac_cv_lib_dld_dlopen" >&6; } -if test "x$ac_cv_lib_dld_dlopen" = xyes; then : - DEFINE_DL="yes" -fi - - if test "$DEFINE_DL" = "yes"; then - $as_echo "#define USE_LIBDL 1" >>confdefs.h - - LIBCOB_LIBS="$LIBCOB_LIBS -ldld" - { $as_echo "$as_me:${as_lineno-$LINENO}: checking for dladdr in -ldld" >&5 -$as_echo_n "checking for dladdr in -ldld... " >&6; } -if ${ac_cv_lib_dld_dladdr+:} false; then : - $as_echo_n "(cached) " >&6 -else - ac_check_lib_save_LIBS=$LIBS -LIBS="-ldld $LIBS" -cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ - -/* Override any GCC internal prototype to avoid an error. - Use char because int might match the return type of a GCC - builtin and then its argument prototype would still apply. */ -#ifdef __cplusplus -extern "C" -#endif -char dladdr (); -int -main () -{ -return dladdr (); - ; - return 0; -} -_ACEOF -if ac_fn_c_try_link "$LINENO"; then : - ac_cv_lib_dld_dladdr=yes -else - ac_cv_lib_dld_dladdr=no -fi -rm -f core conftest.err conftest.$ac_objext \ - conftest$ac_exeext conftest.$ac_ext -LIBS=$ac_check_lib_save_LIBS -fi -{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_dld_dladdr" >&5 -$as_echo "$ac_cv_lib_dld_dladdr" >&6; } -if test "x$ac_cv_lib_dld_dladdr" = xyes; then : - $as_echo "#define HAVE_DLADDR 1" >>confdefs.h - -fi - - fi - fi - else - $as_echo "#define USE_LIBDL 1" >>confdefs.h - - { $as_echo "$as_me:${as_lineno-$LINENO}: checking for dladdr in -lc" >&5 -$as_echo_n "checking for dladdr in -lc... " >&6; } -if ${ac_cv_lib_c_dladdr+:} false; then : - $as_echo_n "(cached) " >&6 -else - ac_check_lib_save_LIBS=$LIBS -LIBS="-lc $LIBS" -cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ - -/* Override any GCC internal prototype to avoid an error. - Use char because int might match the return type of a GCC - builtin and then its argument prototype would still apply. */ -#ifdef __cplusplus -extern "C" -#endif -char dladdr (); -int -main () -{ -return dladdr (); - ; - return 0; -} -_ACEOF -if ac_fn_c_try_link "$LINENO"; then : - ac_cv_lib_c_dladdr=yes -else - ac_cv_lib_c_dladdr=no -fi -rm -f core conftest.err conftest.$ac_objext \ - conftest$ac_exeext conftest.$ac_ext -LIBS=$ac_check_lib_save_LIBS -fi -{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_c_dladdr" >&5 -$as_echo "$ac_cv_lib_c_dladdr" >&6; } -if test "x$ac_cv_lib_c_dladdr" = xyes; then : - $as_echo "#define HAVE_DLADDR 1" >>confdefs.h - -fi - - fi - fi -fi - -if test "$DEFINE_DL" = "no"; then - for ac_header in ltdl.h -do : - ac_fn_c_check_header_mongrel "$LINENO" "ltdl.h" "ac_cv_header_ltdl_h" "$ac_includes_default" -if test "x$ac_cv_header_ltdl_h" = xyes; then : - cat >>confdefs.h <<_ACEOF -#define HAVE_LTDL_H 1 -_ACEOF - -else - as_fn_error $? "ltdl.h is required" "$LINENO" 5 -fi - -done - - { $as_echo "$as_me:${as_lineno-$LINENO}: checking for lt_dlopen in -lltdl" >&5 -$as_echo_n "checking for lt_dlopen in -lltdl... " >&6; } -if ${ac_cv_lib_ltdl_lt_dlopen+:} false; then : - $as_echo_n "(cached) " >&6 -else - ac_check_lib_save_LIBS=$LIBS -LIBS="-lltdl $LIBS" -cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ - -/* Override any GCC internal prototype to avoid an error. - Use char because int might match the return type of a GCC - builtin and then its argument prototype would still apply. */ -#ifdef __cplusplus -extern "C" -#endif -char lt_dlopen (); -int -main () -{ -return lt_dlopen (); - ; - return 0; -} -_ACEOF -if ac_fn_c_try_link "$LINENO"; then : - ac_cv_lib_ltdl_lt_dlopen=yes -else - ac_cv_lib_ltdl_lt_dlopen=no -fi -rm -f core conftest.err conftest.$ac_objext \ - conftest$ac_exeext conftest.$ac_ext -LIBS=$ac_check_lib_save_LIBS -fi -{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_ltdl_lt_dlopen" >&5 -$as_echo "$ac_cv_lib_ltdl_lt_dlopen" >&6; } -if test "x$ac_cv_lib_ltdl_lt_dlopen" = xyes; then : - LIBCOB_LIBS="$LIBCOB_LIBS -lltdl" -else - as_fn_error $? "libltdl is required" "$LINENO" 5 -fi - -fi - -# Checks for compiling computed gotos -{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for support of computed gotos" >&5 -$as_echo_n "checking for support of computed gotos... " >&6; } -cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ - - int test () - { - void *test_ptr; - test_ptr = &&lab; - - goto *test_ptr; - return 1; - - lab: - return 0; - } -_ACEOF -if ac_fn_c_try_compile "$LINENO"; then : - $as_echo "#define COB_COMPUTED_GOTO 1" >>confdefs.h - - { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5 -$as_echo "yes" >&6; } -else - { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 -$as_echo "no" >&6; } -fi -rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext - -# Checks for size of long -{ $as_echo "$as_me:${as_lineno-$LINENO}: checking if size of long int = size of long long" >&5 -$as_echo_n "checking if size of long int = size of long long... " >&6; } -if test "$cross_compiling" = yes; then : - if test "$COB_LI_IS_LL" = "0"; then - { $as_echo "$as_me:${as_lineno-$LINENO}: result: specified \"no\" on configure line" >&5 -$as_echo "specified \"no\" on configure line" >&6; } - else - if test "$COB_LI_IS_LL" = "1"; then - { $as_echo "$as_me:${as_lineno-$LINENO}: result: specified \"yes\" on configure line" >&5 -$as_echo "specified \"yes\" on configure line" >&6; } - else - COB_LI_IS_LL=1 - { $as_echo "$as_me:${as_lineno-$LINENO}: result: assumed - cross-compilation" >&5 -$as_echo "assumed - cross-compilation" >&6; } - fi - fi - $as_echo "#define COB_LI_IS_LL \$COB_LI_IS_LL" >>confdefs.h - - { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: cannot run test program while cross-compiling" >&5 -$as_echo "$as_me: WARNING: cannot run test program while cross-compiling" >&2;} -else - cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ - -int -main () -{ - - if (sizeof(long int) == sizeof(long long)) - return 0; - return 1; - - ; - return 0; -} -_ACEOF -if ac_fn_c_try_run "$LINENO"; then : - $as_echo "#define COB_LI_IS_LL 1" >>confdefs.h - { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5 -$as_echo "yes" >&6; } -else - { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 -$as_echo "no" >&6; } -fi -rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext \ - conftest.$ac_objext conftest.beam conftest.$ac_ext -fi - - -{ $as_echo "$as_me:${as_lineno-$LINENO}: checking if long is 32 bits" >&5 -$as_echo_n "checking if long is 32 bits... " >&6; } -if test "$cross_compiling" = yes; then : - if test "$COB_32_BIT_LONG" = "0"; then - { $as_echo "$as_me:${as_lineno-$LINENO}: result: specified \"no\" on configure line" >&5 -$as_echo "specified \"no\" on configure line" >&6; } - else - if test "$COB_32_BIT_LONG" = "1"; then - { $as_echo "$as_me:${as_lineno-$LINENO}: result: specified \"yes\" on configure line" >&5 -$as_echo "specified \"yes\" on configure line" >&6; } - else - COB_32_BIT_LONG=1 - { $as_echo "$as_me:${as_lineno-$LINENO}: result: assumed - cross-compilation" >&5 -$as_echo "assumed - cross-compilation" >&6; } - fi - fi - $as_echo "#define COB_32_BIT_LONG \$COB_32_BIT_LONG" >>confdefs.h - - { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: cannot run test program while cross-compiling" >&5 -$as_echo "$as_me: WARNING: cannot run test program while cross-compiling" >&2;} -else - cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ - -int -main () -{ - - if (sizeof (long) == 4) - return 0; - return 1; - - ; - return 0; -} -_ACEOF -if ac_fn_c_try_run "$LINENO"; then : - $as_echo "#define COB_32_BIT_LONG 1" >>confdefs.h - { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5 -$as_echo "yes" >&6; } -else - { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 -$as_echo "no" >&6; } -fi -rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext \ - conftest.$ac_objext conftest.beam conftest.$ac_ext -fi - - - -if test "cross_compiling" != "yes"; then - COB_HAS_64_BIT_POINTER="no" -fi -{ $as_echo "$as_me:${as_lineno-$LINENO}: checking if pointer is longer than 32 bits" >&5 -$as_echo_n "checking if pointer is longer than 32 bits... " >&6; } -if test "$cross_compiling" = yes; then : - if test "$COB_HAS_64_BIT_POINTER" = "0"; then - COB_HAS_64_BIT_POINTER="no" - $as_echo "#define COB_64_BIT_POINTER 0" >>confdefs.h - - { $as_echo "$as_me:${as_lineno-$LINENO}: result: specified \"no\" on configure line" >&5 -$as_echo "specified \"no\" on configure line" >&6; } - else - if test "$COB_HAS_64_BIT_POINTER" = "1"; then - COB_HAS_64_BIT_POINTER="yes" - $as_echo "#define COB_64_BIT_POINTER 1" >>confdefs.h - - { $as_echo "$as_me:${as_lineno-$LINENO}: result: specified \"yes\" on configure line" >&5 -$as_echo "specified \"yes\" on configure line" >&6; } - else - COB_HAS_64_BIT_POINTER="no" - $as_echo "#define COB_64_BIT_POINTER 0" >>confdefs.h - - { $as_echo "$as_me:${as_lineno-$LINENO}: result: assumed \"no\" - cross-compilation" >&5 -$as_echo "assumed \"no\" - cross-compilation" >&6; } - fi - fi - { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: cannot run test program while cross-compiling" >&5 -$as_echo "$as_me: WARNING: cannot run test program while cross-compiling" >&2;} -else - cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ - -int -main () -{ - - if (sizeof (void *) > 4U) - return 0; - return 1; - - ; - return 0; -} -_ACEOF -if ac_fn_c_try_run "$LINENO"; then : - COB_HAS_64_BIT_POINTER="yes" - $as_echo "#define COB_64_BIT_POINTER 1" >>confdefs.h - - { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5 -$as_echo "yes" >&6; } -else - { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 -$as_echo "no" >&6; } -fi -rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext \ - conftest.$ac_objext conftest.beam conftest.$ac_ext -fi - - -#if test "$enable_debug" != "yes" -a "$COB_USES_GCC_NO_ICC" = "yes"; then -# MYOLDCFLAGS="$CFLAGS" -# CFLAGS="$CFLAGS -fno-asynchronous-unwind-tables" -# AC_MSG_CHECKING([for gcc unwind tables option]) -# AC_COMPILE_IFELSE([AC_LANG_PROGRAM([[]], [[int testint;]])], -# [AC_DEFINE([HAVE_UNWIND_OPT], [1]) AC_MSG_RESULT([yes])], -# [AC_MSG_RESULT([no])]) -# CFLAGS="$MYOLDCFLAGS" -#fi - -# Check gcc wrapv option -# We likely don't need this and remove it before 3.0 final release -#if test "$COB_USES_GCC_NO_ICC" = "yes"; then -# MYOLDCFLAGS="$CFLAGS" -# CFLAGS="$CFLAGS -fwrapv" -# AC_MSG_CHECKING([for gcc -fwrapv option]) -# AC_COMPILE_IFELSE([AC_LANG_PROGRAM([[]], [[int testint;]])], -# [AC_DEFINE([HAVE_FWRAPV_OPT], [1]) AC_MSG_RESULT([yes])], -# [AC_MSG_RESULT([no])]) -# [], -# [CFLAGS="$MYOLDCFLAGS"]) -# CFLAGS="$MYOLDCFLAGS" -#fi - -# Check if aligned attribute seems to work -# done: does not raise an error -# *TODO*: has same output as omitting it) -{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for aligned attribute" >&5 -$as_echo_n "checking for aligned attribute... " >&6; } -cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ - -int -main () -{ -char testchar[4] __attribute__((aligned)); - ; - return 0; -} -_ACEOF -if ac_fn_c_try_compile "$LINENO"; then : - $as_echo "#define HAVE_ATTRIBUTE_ALIGNED 1" >>confdefs.h - { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5 -$as_echo "yes" >&6; } - -else - { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 -$as_echo "no" >&6; } -fi -rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext - -# GnuCOBOL Configuration - -COB_LIBS="-L$libdir -lcob" -COB_LDFLAGS="" -if test "x$LDFLAGS" != "x"; then - COB_LIBS="$LDFLAGS $COB_LIBS" - COB_LDFLAGS="$LDFLAGS" -fi - -COB_CONFIG_DIR="$datadir/$PACKAGE_TARNAME/config" -COB_SCHEMA_DIR="$datadir/$PACKAGE_TARNAME/schema" -COB_COPY_DIR="$datadir/$PACKAGE_TARNAME/copy" -COB_LIBRARY_PATH="$libdir/$PACKAGE_TARNAME" -COB_EXE_EXT="$EXEEXT" -if test "$COB_EXE_EXT" = ".exe"; then - COB_MODULE_EXT="dll" -else - if test "$COB_EXE_EXT" = ".exe" -o "$COB_EXE_EXT" = ".EXE"; then - COB_MODULE_EXT="dll" - else - # normal case... - COB_MODULE_EXT=`echo "$acl_cv_shlibext" | sed -e 's/dll\.a/dll/'` - fi -fi -COB_OBJECT_EXT="$OBJEXT" -LIBS="$save_libs" -COB_EXPORT_DYN="`eval echo $export_dynamic_flag_spec`" -# FIXME: lt_prog_compiler_pic is not always correct, for example with occ -COB_PIC_FLAGS=`echo "$lt_prog_compiler_pic" | sed -e 's/^ //'` - -if test "$enable_cflags_setting" = "yes"; then - - # Remove -O2 option added by AC_PROG_CC and add -O0 - if test "$enable_debug" = "yes" -o "$enable_code_coverage" = "yes"; then - CFLAGS=`echo "$CFLAGS" | sed -e 's/ *-O[0-9a-zA-Z]* */ /g' -e 's/ $//' -e 's/^ //'` - if test "$COB_USES_GCC" = "yes"; then - CFLAGS="$CFLAGS -O0" - fi - fi - - # For debugging: add -g3 if using GCC. - if test "$enable_debug" = "yes" -a "$COB_USES_GCC" = "yes"; then - MYOLDCFLAGS="$CFLAGS" - CFLAGS="$CFLAGS -g3" - { $as_echo "$as_me:${as_lineno-$LINENO}: checking for gcc -g3 option" >&5 -$as_echo_n "checking for gcc -g3 option... " >&6; } - cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ - -int -main () -{ -int testint; - ; - return 0; -} -_ACEOF -if ac_fn_c_try_compile "$LINENO"; then : - { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5 -$as_echo "yes" >&6; } -else - CFLAGS="$MYOLDCFLAGS"; { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 -$as_echo "no" >&6; } -fi -rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext - unset MYOLDCFLAGS - fi -fi - -unset enable_cflags_setting - -if test "$COB_USES_GCC" = "yes"; then - if test "x$CFLAGS" != "x"; then - CFLAGS="$CFLAGS -pipe" - else - CFLAGS="-pipe" - fi -fi - -# include directory (install dir) - -if test "x$prefix" = "xNONE"; then - if test "x$includedir" = "x\${prefix}/include"; then - COB_CFLAGS="-I${ac_default_prefix}/include" - else - COB_CFLAGS="-I${includedir}" - fi -else - if test "x$includedir" = "x\${prefix}/include"; then - if test "x$prefix" = "x/usr"; then - COB_CFLAGS="" - else - COB_CFLAGS="-I${prefix}/include" - fi - else - COB_CFLAGS="-I${includedir}" - fi -fi - - -# compiler specific general options for COB_CFLAGS, originating from cobc.c (main) - -if test "$COB_USES_ICC_ONLY" = "yes"; then - # these are deprecated... - COB_CFLAGS="$COB_CFLAGS -vec-report0 -opt-report 0" -elif test "$COB_USES_WATCOMC_ONLY" = "yes"; then - # -s = no overflow checks, otherwise need to code/link a CHK routine - COB_CFLAGS="$COB_CFLAGS -s -wcd=118" -elif test "$COB_USES_XLC_ONLY" = "yes"; then - # use read-only memory for string literals and constants - COB_CFLAGS="$COB_CFLAGS -qro -qroconst" - # allow nonstandard usage - CHECKME where do we need this ??? - # do we need the additional check for __IBMC__ >= 700 we had in cobc? - COB_CFLAGS="$COB_CFLAGS -qlanglvl=extended" - # Suppress compiler warning about MAXMEM optimization - COB_CFLAGS="$COB_CFLAGS -qsuppress=1500-030" -fi - -if test "$COB_USES_GCC_NO_ICC" = "yes"; then - # comment from cobc.c: --param max-goto-duplication-insns=100000 - # /* RXWRXW - gcse */ - # COB_CFLAGS="$COB_CFLAGS -Wno-unused -fsigned-char -fno-gcse" - COB_CFLAGS="$COB_CFLAGS -Wno-unused -fsigned-char" -fi - -# Check gcc 4 pointer sign option (at least available with "recent" clang, too) -#if test "$COB_USES_GCC_NO_ICC" = "yes"; then -if test "$COB_USES_XLC_ONLY" != "yes"; then - MYOLDCFLAGS="$CFLAGS" - CFLAGS="$CFLAGS -Wno-pointer-sign" - { $as_echo "$as_me:${as_lineno-$LINENO}: checking for gcc pointer sign option" >&5 -$as_echo_n "checking for gcc pointer sign option... " >&6; } - cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ - -int -main () -{ -int testint; - ; - return 0; -} -_ACEOF -if ac_fn_c_try_compile "$LINENO"; then : - COB_CFLAGS="$COB_CFLAGS -Wno-pointer-sign"; { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5 -$as_echo "yes" >&6; } -else - { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 -$as_echo "no" >&6; } -fi -rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext - CFLAGS="$MYOLDCFLAGS" -fi -#fi - -if test "$COB_USES_CLANG_ONLY" = "yes"; then - # don't warn if cobc uses arguments which aren't picked up (likely because of the translation phase) - COB_CFLAGS="$COB_CFLAGS -Qunused-arguments" -fi - - -# Include CFLAGS / CPPFLAGS in COB_CFLAGS without optimization/debug options. - -if test "x$CFLAGS" != "x"; then - cob_temp_flags="$CFLAGS" -else - cob_temp_flags="" -fi -if test "x$CPPFLAGS" != "x"; then - if test "x$cob_temp_flags" != "x"; then - cob_temp_flags="$CPPFLAGS $cob_temp_flags" - else - cob_temp_flags="$CPPFLAGS" - fi -fi -if test "x$cob_temp_flags" != "x"; then - cob_temp_flags=`echo "$cob_temp_flags" \ - | sed -e 's/-g3//g' -e 's/-g //g' -e 's/-g$//' -e 's/ $//' -e 's/^ //' \ - -e 's/[+-]O[0-9s]//g' -e 's/ $//' -e 's/^ //' \ - -e 's/-O//g' -e 's/ $//' -e 's/^ //' \ - -e 's/-fmessage-length=0//g' \ - -e 's/[^ ]*-D_FORTIFY_SOURCE=.//g' \ - -e 's/-fstack-protector-strong//g' \ - -e 's/-fstack-protector-all//g' \ - -e 's/-fstack-protector//g' \ - -e 's/-funwind-tables//g' \ - -e 's/-fasynchronous-unwind-tables//g' \ - -e 's/ */ /g' -e 's/ $//' -e 's/^ //'` -fi - -if test "x$cob_temp_flags" != "x"; then - COB_CFLAGS="$COB_CFLAGS $cob_temp_flags" -fi -unset cob_temp_flags - - -# Special stuff - - -# FIXME: COB_SHARED_OPT should at least be checked for "compiles"; -# for example breaks with occ and other non-GCC compilers, -# *at least* check that compilation still works when using this option... -COB_SHARED_OPT="-shared" - -COB_FIX_LIB="$COB_EXPORT_DYN" -COB_FIX_LIBTOOL="" -case $host_os in - mingw*) - if test "$prefix" = "NONE"; then - COB_CONFIG_DIR="`cd /usr && pwd -W`/local/share/$PACKAGE_TARNAME/config" - COB_SCHEMA_DIR="`cd /usr && pwd -W`/local/share/$PACKAGE_TARNAME/schema" - COB_COPY_DIR="`cd /usr && pwd -W`/local/share/$PACKAGE_TARNAME/copy" - fi - if test "$COB_USES_GCC" = "yes"; then - COB_EXPORT_DYN="-Wl,--export-all-symbols -Wl,--enable-auto-import -Wl,--enable-auto-image-base" - COB_FIX_LIBTOOL="-Wl,--enable-auto-import" - fi - COB_FIX_LIB="" - ;; - cygwin*) - if test "$COB_USES_GCC" = "yes"; then - COB_EXPORT_DYN="-Wl,--export-all-symbols -Wl,--enable-auto-import -Wl,--enable-auto-image-base" - COB_FIX_LIBTOOL="-Wl,--enable-auto-import" - fi - COB_FIX_LIB="" - ;; - darwin* | rhapsody*) - if test "$COB_USES_GCC" = "yes"; then - COB_SHARED_OPT="-bundle -flat_namespace -undefined suppress" - fi - ;; - hpux*) - if test "$COB_USES_GCC" != "yes"; then - COB_SHARED_OPT="-b" - $as_echo "#define _XOPEN_SOURCE_EXTENDED 1" >>confdefs.h - - rm -f hptest* - echo 'int main() { return 0; }' > hptest.c - ${CC} ${CFLAGS} +Olit=all -o hptest hptest.c > hptest.out 2>&1 - if test $? -ne 0 -o -s hptest.out; then - CFLAGS="$CFLAGS +ESlit" - COB_CFLAGS="$COB_CFLAGS +ESlit -w" - else - CFLAGS="$CFLAGS +Olit=all" - COB_CFLAGS="$COB_CFLAGS +Olit=all -w" - fi - - if test "$enable_debug" = "yes"; then - CFLAGS="$CFLAGS +O0" - else - CFLAGS="$CFLAGS +O2" - fi - - rm -f hptest* - fi - ;; - aix*) - COB_EXPORT_DYN="-Wl,-bexpfull -Wl,-brtl" - if test "$COB_USES_GCC" != "yes"; then - CFLAGS="$CFLAGS -Q -qro -qroconst" - if test "$enable_debug" = "yes"; then - CFLAGS="$CFLAGS -qnoopt" - else - CFLAGS="$CFLAGS -O2" - fi - - COB_SHARED_OPT="-G" - COB_FIX_LIB="" - # COB_FIX_LIB="-Wc,-G $COB_EXPORT_DYN" - # COB_CFLAGS="$COB_CFLAGS -qchars=signed" - else - COB_FIX_LIB="$COB_EXPORT_DYN" - fi - ;; - solaris*) - if test "$COB_USES_GCC" != "yes"; then - CFLAGS="$CFLAGS -xstrconst" - if test "$enable_debug" != "yes"; then - CFLAGS="$CFLAGS -xO2" - fi - COB_CFLAGS="$COB_CFLAGS -xstrconst" - COB_SHARED_OPT="-G" - fi - ;; -esac - -if test "$COB_USES_ICC_ONLY" = "yes"; then - if test "$enable_debug" != "yes"; then - CFLAGS="$CFLAGS -finline-functions" - fi - CFLAGS="$CFLAGS -Wall -wd1419 -vec-report0 -opt-report 0" -elif test "$COB_USES_GCC" = "yes" && test "$with_gnu_ld" = "yes"; then - MYOLDLDFLAGS="$LDFLAGS" - LDFLAGS="$LDFLAGS -Wl,-z,relro,-z,now,-O1" - { $as_echo "$as_me:${as_lineno-$LINENO}: checking for ld bind now option" >&5 -$as_echo_n "checking for ld bind now option... " >&6; } - cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ - -int -main () -{ -int testint; - ; - return 0; -} -_ACEOF -if ac_fn_c_try_link "$LINENO"; then : - { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5 -$as_echo "yes" >&6; } -else - LDFLAGS=$MYOLDLDFLAGS - { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 -$as_echo "no" >&6; } -fi -rm -f core conftest.err conftest.$ac_objext \ - conftest$ac_exeext conftest.$ac_ext - unset MYOLDLDFLAGS - if test "$enable_debug" != "yes"; then - CFLAGS="$CFLAGS -finline-functions" - fi - CFLAGS="$CFLAGS -fsigned-char -Wall -Wwrite-strings -Wmissing-prototypes -Wno-format-y2k" - if test "$enable_debug" != "yes"; then - CFLAGS="$CFLAGS -U_FORTIFY_SOURCE" - fi -fi - -if test "x$lt_cv_dlopen_self" != "xyes"; then - $as_echo "#define COB_NO_SELFOPEN 1" >>confdefs.h - -fi - -if test "$with_cisam" = "yes"; then - COB_HAS_ISAM=cisam -elif test "$with_disam" = "yes"; then - COB_HAS_ISAM=disam -elif test "$with_vbisam" = "yes"; then - COB_HAS_ISAM=vbisam -elif test "$with_db" = "yes"; then - COB_HAS_ISAM=db -elif test "$with_lmdb" = "yes"; then - COB_HAS_ISAM=lmdb -elif test "$with_index_extfh" = "yes"; then - COB_HAS_ISAM=index_extfh -else - COB_HAS_ISAM=no -fi -COB_HAS_CISAM=$with_cisam -COB_HAS_DISAM=$with_disam -COB_HAS_VBISAM=$with_vbisam -COB_HAS_BDB=$with_db -COB_HAS_LMDB=$with_lmdb -COB_HAS_ODBC=$with_odbc -COB_HAS_OCI=$with_oci -COB_HAS_OCEXTFH=$with_index_extfh - -if test "$USE_CURSES" = "not_found" -o "$USE_CURSES" = "no"; then - COB_HAS_CURSES=no -else - COB_HAS_CURSES=yes -fi - -if test "$with_xml2" = "yes"; then - COB_HAS_XML2=yes -else - COB_HAS_XML2=no -fi - - if test "$cob_multi_isam" = "yes" -a "$cob_gen_cisam" = "yes"; then - COB_MAKE_CISAM_LIB_TRUE= - COB_MAKE_CISAM_LIB_FALSE='#' -else - COB_MAKE_CISAM_LIB_TRUE='#' - COB_MAKE_CISAM_LIB_FALSE= -fi - - if test "$cob_multi_isam" = "yes" -a "$cob_gen_disam" = "yes"; then - COB_MAKE_DISAM_LIB_TRUE= - COB_MAKE_DISAM_LIB_FALSE='#' -else - COB_MAKE_DISAM_LIB_TRUE='#' - COB_MAKE_DISAM_LIB_FALSE= -fi - - if test "$cob_multi_isam" = "yes" -a "$cob_gen_vbisam" = "yes"; then - COB_MAKE_VBISAM_LIB_TRUE= - COB_MAKE_VBISAM_LIB_FALSE='#' -else - COB_MAKE_VBISAM_LIB_TRUE='#' - COB_MAKE_VBISAM_LIB_FALSE= -fi - - - if test "$with_cjson" = "local"; then - LOCAL_CJSON_TRUE= - LOCAL_CJSON_FALSE='#' -else - LOCAL_CJSON_TRUE='#' - LOCAL_CJSON_FALSE= -fi - -if test "$with_cjson" = "yes" -o "$with_cjson" = "local"; then - COB_HAS_CJSON=yes -else - COB_HAS_CJSON=no - with_cjson=no -fi - -unset COB_USES_GCC -unset COB_USES_GCC_NO_ICC -unset COB_USES_ICC_ONLY -unset COB_USES_CLANG_ONLY -unset COB_USES_XLC_ONLY -unset COB_USES_WATCOM_ONLY -unset MYOLDCFLAGS -unset MYOLDLIBS -unset MYOCLIBS - -# Generate the output - - if test "$COB_HAS_ISAM" != no; then - COB_MAKE_IX_TRUE= - COB_MAKE_IX_FALSE='#' -else - COB_MAKE_IX_TRUE='#' - COB_MAKE_IX_FALSE= -fi - - if test "$cross_compiling" != yes; then - COB_MAKE_RUN_BINARIES_TRUE= - COB_MAKE_RUN_BINARIES_FALSE='#' -else - COB_MAKE_RUN_BINARIES_TRUE='#' - COB_MAKE_RUN_BINARIES_FALSE= -fi - -# FIXME: Should be tested as the system may can actually run these (Bash on Windows?) - -cat >>confdefs.h <<_ACEOF -#define COB_EXPORT_DYN "$COB_EXPORT_DYN" -_ACEOF - -cat >>confdefs.h <<_ACEOF -#define COB_PIC_FLAGS "$COB_PIC_FLAGS" -_ACEOF - -cat >>confdefs.h <<_ACEOF -#define COB_SHARED_OPT "$COB_SHARED_OPT" -_ACEOF - -cat >>confdefs.h <<_ACEOF -#define COB_OBJECT_EXT "$COB_OBJECT_EXT" -_ACEOF - -cat >>confdefs.h <<_ACEOF -#define COB_MODULE_EXT "$COB_MODULE_EXT" -_ACEOF - -cat >>confdefs.h <<_ACEOF -#define COB_EXE_EXT "$COB_EXE_EXT" -_ACEOF - -if test "x$striplib" != "x"; then - cat >>confdefs.h <<_ACEOF -#define COB_STRIP_CMD "$striplib" -_ACEOF - -fi - - - - - - - - - - - - - - - - - - - - -COB_BIGENDIAN="$ac_cv_c_bigendian" - - - - - - - - - - - - - - - - - -COB_PATCH_LEVEL=$with_patch_level - # needed for bin/cob-config - -ac_config_commands="$ac_config_commands chmod" - - - -HELP2MAN=${HELP2MAN-"${am_missing_run}help2man"} - - -cat >confcache <<\_ACEOF -# This file is a shell script that caches the results of configure -# tests run on this system so they can be shared between configure -# scripts and configure runs, see configure's option --config-cache. -# It is not useful on other systems. If it contains results you don't -# want to keep, you may remove or edit it. -# -# config.status only pays attention to the cache file if you give it -# the --recheck option to rerun configure. -# -# `ac_cv_env_foo' variables (set or unset) will be overridden when -# loading this file, other *unset* `ac_cv_foo' will be assigned the -# following values. - -_ACEOF - -# The following way of writing the cache mishandles newlines in values, -# but we know of no workaround that is simple, portable, and efficient. -# So, we kill variables containing newlines. -# Ultrix sh set writes to stderr and can't be redirected directly, -# and sets the high bit in the cache file unless we assign to the vars. -( - for ac_var in `(set) 2>&1 | sed -n 's/^\([a-zA-Z_][a-zA-Z0-9_]*\)=.*/\1/p'`; do - eval ac_val=\$$ac_var - case $ac_val in #( - *${as_nl}*) - case $ac_var in #( - *_cv_*) { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: cache variable $ac_var contains a newline" >&5 -$as_echo "$as_me: WARNING: cache variable $ac_var contains a newline" >&2;} ;; - esac - case $ac_var in #( - _ | IFS | as_nl) ;; #( - BASH_ARGV | BASH_SOURCE) eval $ac_var= ;; #( - *) { eval $ac_var=; unset $ac_var;} ;; - esac ;; - esac - done - - (set) 2>&1 | - case $as_nl`(ac_space=' '; set) 2>&1` in #( - *${as_nl}ac_space=\ *) - # `set' does not quote correctly, so add quotes: double-quote - # substitution turns \\\\ into \\, and sed turns \\ into \. - sed -n \ - "s/'/'\\\\''/g; - s/^\\([_$as_cr_alnum]*_cv_[_$as_cr_alnum]*\\)=\\(.*\\)/\\1='\\2'/p" - ;; #( - *) - # `set' quotes correctly as required by POSIX, so do not add quotes. - sed -n "/^[_$as_cr_alnum]*_cv_[_$as_cr_alnum]*=/p" - ;; - esac | - sort -) | - sed ' - /^ac_cv_env_/b end - t clear - :clear - s/^\([^=]*\)=\(.*[{}].*\)$/test "${\1+set}" = set || &/ - t end - s/^\([^=]*\)=\(.*\)$/\1=${\1=\2}/ - :end' >>confcache -if diff "$cache_file" confcache >/dev/null 2>&1; then :; else - if test -w "$cache_file"; then - if test "x$cache_file" != "x/dev/null"; then - { $as_echo "$as_me:${as_lineno-$LINENO}: updating cache $cache_file" >&5 -$as_echo "$as_me: updating cache $cache_file" >&6;} - if test ! -f "$cache_file" || test -h "$cache_file"; then - cat confcache >"$cache_file" - else - case $cache_file in #( - */* | ?:*) - mv -f confcache "$cache_file"$$ && - mv -f "$cache_file"$$ "$cache_file" ;; #( - *) - mv -f confcache "$cache_file" ;; - esac - fi - fi - else - { $as_echo "$as_me:${as_lineno-$LINENO}: not updating unwritable cache $cache_file" >&5 -$as_echo "$as_me: not updating unwritable cache $cache_file" >&6;} - fi -fi -rm -f confcache - -test "x$prefix" = xNONE && prefix=$ac_default_prefix -# Let make expand exec_prefix. -test "x$exec_prefix" = xNONE && exec_prefix='${prefix}' - -DEFS=-DHAVE_CONFIG_H - -ac_libobjs= -ac_ltlibobjs= -U= -for ac_i in : $LIBOBJS; do test "x$ac_i" = x: && continue - # 1. Remove the extension, and $U if already installed. - ac_script='s/\$U\././;s/\.o$//;s/\.obj$//' - ac_i=`$as_echo "$ac_i" | sed "$ac_script"` - # 2. Prepend LIBOBJDIR. When used with automake>=1.10 LIBOBJDIR - # will be set to the directory where LIBOBJS objects are built. - as_fn_append ac_libobjs " \${LIBOBJDIR}$ac_i\$U.$ac_objext" - as_fn_append ac_ltlibobjs " \${LIBOBJDIR}$ac_i"'$U.lo' -done -LIBOBJS=$ac_libobjs - -LTLIBOBJS=$ac_ltlibobjs - - -{ $as_echo "$as_me:${as_lineno-$LINENO}: checking that generated files are newer than configure" >&5 -$as_echo_n "checking that generated files are newer than configure... " >&6; } - if test -n "$am_sleep_pid"; then - # Hide warnings about reused PIDs. - wait $am_sleep_pid 2>/dev/null - fi - { $as_echo "$as_me:${as_lineno-$LINENO}: result: done" >&5 -$as_echo "done" >&6; } - if test -n "$EXEEXT"; then - am__EXEEXT_TRUE= - am__EXEEXT_FALSE='#' -else - am__EXEEXT_TRUE='#' - am__EXEEXT_FALSE= -fi - -if test -z "${MAKE_HAS_PREREQ_ONLY_TRUE}" && test -z "${MAKE_HAS_PREREQ_ONLY_FALSE}"; then - as_fn_error $? "conditional \"MAKE_HAS_PREREQ_ONLY\" was never defined. -Usually this means the macro was only invoked conditionally." "$LINENO" 5 -fi -if test -z "${AMDEP_TRUE}" && test -z "${AMDEP_FALSE}"; then - as_fn_error $? "conditional \"AMDEP\" was never defined. -Usually this means the macro was only invoked conditionally." "$LINENO" 5 -fi -if test -z "${am__fastdepCC_TRUE}" && test -z "${am__fastdepCC_FALSE}"; then - as_fn_error $? "conditional \"am__fastdepCC\" was never defined. -Usually this means the macro was only invoked conditionally." "$LINENO" 5 -fi - -if test -z "${CODE_COVERAGE_ENABLED_TRUE}" && test -z "${CODE_COVERAGE_ENABLED_FALSE}"; then - as_fn_error $? "conditional \"CODE_COVERAGE_ENABLED\" was never defined. -Usually this means the macro was only invoked conditionally." "$LINENO" 5 -fi -if test -z "${COB_MAKE_CISAM_LIB_TRUE}" && test -z "${COB_MAKE_CISAM_LIB_FALSE}"; then - as_fn_error $? "conditional \"COB_MAKE_CISAM_LIB\" was never defined. -Usually this means the macro was only invoked conditionally." "$LINENO" 5 -fi -if test -z "${COB_MAKE_DISAM_LIB_TRUE}" && test -z "${COB_MAKE_DISAM_LIB_FALSE}"; then - as_fn_error $? "conditional \"COB_MAKE_DISAM_LIB\" was never defined. -Usually this means the macro was only invoked conditionally." "$LINENO" 5 -fi -if test -z "${COB_MAKE_VBISAM_LIB_TRUE}" && test -z "${COB_MAKE_VBISAM_LIB_FALSE}"; then - as_fn_error $? "conditional \"COB_MAKE_VBISAM_LIB\" was never defined. -Usually this means the macro was only invoked conditionally." "$LINENO" 5 -fi -if test -z "${LOCAL_CJSON_TRUE}" && test -z "${LOCAL_CJSON_FALSE}"; then - as_fn_error $? "conditional \"LOCAL_CJSON\" was never defined. -Usually this means the macro was only invoked conditionally." "$LINENO" 5 -fi -if test -z "${COB_MAKE_IX_TRUE}" && test -z "${COB_MAKE_IX_FALSE}"; then - as_fn_error $? "conditional \"COB_MAKE_IX\" was never defined. -Usually this means the macro was only invoked conditionally." "$LINENO" 5 -fi -if test -z "${COB_MAKE_RUN_BINARIES_TRUE}" && test -z "${COB_MAKE_RUN_BINARIES_FALSE}"; then - as_fn_error $? "conditional \"COB_MAKE_RUN_BINARIES\" was never defined. -Usually this means the macro was only invoked conditionally." "$LINENO" 5 -fi - -: "${CONFIG_STATUS=./config.status}" -ac_write_fail=0 -ac_clean_files_save=$ac_clean_files -ac_clean_files="$ac_clean_files $CONFIG_STATUS" -{ $as_echo "$as_me:${as_lineno-$LINENO}: creating $CONFIG_STATUS" >&5 -$as_echo "$as_me: creating $CONFIG_STATUS" >&6;} -as_write_fail=0 -cat >$CONFIG_STATUS <<_ASEOF || as_write_fail=1 -#! $SHELL -# Generated by $as_me. -# Run this file to recreate the current configuration. -# Compiler output produced by configure, useful for debugging -# configure, is in config.log if it exists. - -debug=false -ac_cs_recheck=false -ac_cs_silent=false - -SHELL=\${CONFIG_SHELL-$SHELL} -export SHELL -_ASEOF -cat >>$CONFIG_STATUS <<\_ASEOF || as_write_fail=1 -## -------------------- ## -## M4sh Initialization. ## -## -------------------- ## - -# Be more Bourne compatible -DUALCASE=1; export DUALCASE # for MKS sh -if test -n "${ZSH_VERSION+set}" && (emulate sh) >/dev/null 2>&1; then : - emulate sh - NULLCMD=: - # Pre-4.2 versions of Zsh do word splitting on ${1+"$@"}, which - # is contrary to our usage. Disable this feature. - alias -g '${1+"$@"}'='"$@"' - setopt NO_GLOB_SUBST -else - case `(set -o) 2>/dev/null` in #( - *posix*) : - set -o posix ;; #( - *) : - ;; -esac -fi - - -as_nl=' -' -export as_nl -# Printing a long string crashes Solaris 7 /usr/bin/printf. -as_echo='\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\' -as_echo=$as_echo$as_echo$as_echo$as_echo$as_echo -as_echo=$as_echo$as_echo$as_echo$as_echo$as_echo$as_echo -# Prefer a ksh shell builtin over an external printf program on Solaris, -# but without wasting forks for bash or zsh. -if test -z "$BASH_VERSION$ZSH_VERSION" \ - && (test "X`print -r -- $as_echo`" = "X$as_echo") 2>/dev/null; then - as_echo='print -r --' - as_echo_n='print -rn --' -elif (test "X`printf %s $as_echo`" = "X$as_echo") 2>/dev/null; then - as_echo='printf %s\n' - as_echo_n='printf %s' -else - if test "X`(/usr/ucb/echo -n -n $as_echo) 2>/dev/null`" = "X-n $as_echo"; then - as_echo_body='eval /usr/ucb/echo -n "$1$as_nl"' - as_echo_n='/usr/ucb/echo -n' - else - as_echo_body='eval expr "X$1" : "X\\(.*\\)"' - as_echo_n_body='eval - arg=$1; - case $arg in #( - *"$as_nl"*) - expr "X$arg" : "X\\(.*\\)$as_nl"; - arg=`expr "X$arg" : ".*$as_nl\\(.*\\)"`;; - esac; - expr "X$arg" : "X\\(.*\\)" | tr -d "$as_nl" - ' - export as_echo_n_body - as_echo_n='sh -c $as_echo_n_body as_echo' - fi - export as_echo_body - as_echo='sh -c $as_echo_body as_echo' -fi - -# The user is always right. -if test "${PATH_SEPARATOR+set}" != set; then - PATH_SEPARATOR=: - (PATH='/bin;/bin'; FPATH=$PATH; sh -c :) >/dev/null 2>&1 && { - (PATH='/bin:/bin'; FPATH=$PATH; sh -c :) >/dev/null 2>&1 || - PATH_SEPARATOR=';' - } -fi - - -# IFS -# We need space, tab and new line, in precisely that order. Quoting is -# there to prevent editors from complaining about space-tab. -# (If _AS_PATH_WALK were called with IFS unset, it would disable word -# splitting by setting IFS to empty value.) -IFS=" "" $as_nl" - -# Find who we are. Look in the path if we contain no directory separator. -as_myself= -case $0 in #(( - *[\\/]* ) as_myself=$0 ;; - *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR -for as_dir in $PATH -do - IFS=$as_save_IFS - test -z "$as_dir" && as_dir=. - test -r "$as_dir/$0" && as_myself=$as_dir/$0 && break - done -IFS=$as_save_IFS - - ;; -esac -# We did not find ourselves, most probably we were run as `sh COMMAND' -# in which case we are not to be found in the path. -if test "x$as_myself" = x; then - as_myself=$0 -fi -if test ! -f "$as_myself"; then - $as_echo "$as_myself: error: cannot find myself; rerun with an absolute file name" >&2 - exit 1 -fi - -# Unset variables that we do not need and which cause bugs (e.g. in -# pre-3.0 UWIN ksh). But do not cause bugs in bash 2.01; the "|| exit 1" -# suppresses any "Segmentation fault" message there. '((' could -# trigger a bug in pdksh 5.2.14. -for as_var in BASH_ENV ENV MAIL MAILPATH -do eval test x\${$as_var+set} = xset \ - && ( (unset $as_var) || exit 1) >/dev/null 2>&1 && unset $as_var || : -done -PS1='$ ' -PS2='> ' -PS4='+ ' - -# NLS nuisances. -LC_ALL=C -export LC_ALL -LANGUAGE=C -export LANGUAGE - -# CDPATH. -(unset CDPATH) >/dev/null 2>&1 && unset CDPATH - - -# as_fn_error STATUS ERROR [LINENO LOG_FD] -# ---------------------------------------- -# Output "`basename $0`: error: ERROR" to stderr. If LINENO and LOG_FD are -# provided, also output the error to LOG_FD, referencing LINENO. Then exit the -# script with STATUS, using 1 if that was 0. -as_fn_error () -{ - as_status=$1; test $as_status -eq 0 && as_status=1 - if test "$4"; then - as_lineno=${as_lineno-"$3"} as_lineno_stack=as_lineno_stack=$as_lineno_stack - $as_echo "$as_me:${as_lineno-$LINENO}: error: $2" >&$4 - fi - $as_echo "$as_me: error: $2" >&2 - as_fn_exit $as_status -} # as_fn_error - - -# as_fn_set_status STATUS -# ----------------------- -# Set $? to STATUS, without forking. -as_fn_set_status () -{ - return $1 -} # as_fn_set_status - -# as_fn_exit STATUS -# ----------------- -# Exit the shell with STATUS, even in a "trap 0" or "set -e" context. -as_fn_exit () -{ - set +e - as_fn_set_status $1 - exit $1 -} # as_fn_exit - -# as_fn_unset VAR -# --------------- -# Portably unset VAR. -as_fn_unset () -{ - { eval $1=; unset $1;} -} -as_unset=as_fn_unset -# as_fn_append VAR VALUE -# ---------------------- -# Append the text in VALUE to the end of the definition contained in VAR. Take -# advantage of any shell optimizations that allow amortized linear growth over -# repeated appends, instead of the typical quadratic growth present in naive -# implementations. -if (eval "as_var=1; as_var+=2; test x\$as_var = x12") 2>/dev/null; then : - eval 'as_fn_append () - { - eval $1+=\$2 - }' -else - as_fn_append () - { - eval $1=\$$1\$2 - } -fi # as_fn_append - -# as_fn_arith ARG... -# ------------------ -# Perform arithmetic evaluation on the ARGs, and store the result in the -# global $as_val. Take advantage of shells that can avoid forks. The arguments -# must be portable across $(()) and expr. -if (eval "test \$(( 1 + 1 )) = 2") 2>/dev/null; then : - eval 'as_fn_arith () - { - as_val=$(( $* )) - }' -else - as_fn_arith () - { - as_val=`expr "$@" || test $? -eq 1` - } -fi # as_fn_arith - - -if expr a : '\(a\)' >/dev/null 2>&1 && - test "X`expr 00001 : '.*\(...\)'`" = X001; then - as_expr=expr -else - as_expr=false -fi - -if (basename -- /) >/dev/null 2>&1 && test "X`basename -- / 2>&1`" = "X/"; then - as_basename=basename -else - as_basename=false -fi - -if (as_dir=`dirname -- /` && test "X$as_dir" = X/) >/dev/null 2>&1; then - as_dirname=dirname -else - as_dirname=false -fi - -as_me=`$as_basename -- "$0" || -$as_expr X/"$0" : '.*/\([^/][^/]*\)/*$' \| \ - X"$0" : 'X\(//\)$' \| \ - X"$0" : 'X\(/\)' \| . 2>/dev/null || -$as_echo X/"$0" | - sed '/^.*\/\([^/][^/]*\)\/*$/{ - s//\1/ - q - } - /^X\/\(\/\/\)$/{ - s//\1/ - q - } - /^X\/\(\/\).*/{ - s//\1/ - q - } - s/.*/./; q'` - -# Avoid depending upon Character Ranges. -as_cr_letters='abcdefghijklmnopqrstuvwxyz' -as_cr_LETTERS='ABCDEFGHIJKLMNOPQRSTUVWXYZ' -as_cr_Letters=$as_cr_letters$as_cr_LETTERS -as_cr_digits='0123456789' -as_cr_alnum=$as_cr_Letters$as_cr_digits - -ECHO_C= ECHO_N= ECHO_T= -case `echo -n x` in #((((( --n*) - case `echo 'xy\c'` in - *c*) ECHO_T=' ';; # ECHO_T is single tab character. - xy) ECHO_C='\c';; - *) echo `echo ksh88 bug on AIX 6.1` > /dev/null - ECHO_T=' ';; - esac;; -*) - ECHO_N='-n';; -esac - -rm -f conf$$ conf$$.exe conf$$.file -if test -d conf$$.dir; then - rm -f conf$$.dir/conf$$.file -else - rm -f conf$$.dir - mkdir conf$$.dir 2>/dev/null -fi -if (echo >conf$$.file) 2>/dev/null; then - if ln -s conf$$.file conf$$ 2>/dev/null; then - as_ln_s='ln -s' - # ... but there are two gotchas: - # 1) On MSYS, both `ln -s file dir' and `ln file dir' fail. - # 2) DJGPP < 2.04 has no symlinks; `ln -s' creates a wrapper executable. - # In both cases, we have to default to `cp -pR'. - ln -s conf$$.file conf$$.dir 2>/dev/null && test ! -f conf$$.exe || - as_ln_s='cp -pR' - elif ln conf$$.file conf$$ 2>/dev/null; then - as_ln_s=ln - else - as_ln_s='cp -pR' - fi -else - as_ln_s='cp -pR' -fi -rm -f conf$$ conf$$.exe conf$$.dir/conf$$.file conf$$.file -rmdir conf$$.dir 2>/dev/null - - -# as_fn_mkdir_p -# ------------- -# Create "$as_dir" as a directory, including parents if necessary. -as_fn_mkdir_p () -{ - - case $as_dir in #( - -*) as_dir=./$as_dir;; - esac - test -d "$as_dir" || eval $as_mkdir_p || { - as_dirs= - while :; do - case $as_dir in #( - *\'*) as_qdir=`$as_echo "$as_dir" | sed "s/'/'\\\\\\\\''/g"`;; #'( - *) as_qdir=$as_dir;; - esac - as_dirs="'$as_qdir' $as_dirs" - as_dir=`$as_dirname -- "$as_dir" || -$as_expr X"$as_dir" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \ - X"$as_dir" : 'X\(//\)[^/]' \| \ - X"$as_dir" : 'X\(//\)$' \| \ - X"$as_dir" : 'X\(/\)' \| . 2>/dev/null || -$as_echo X"$as_dir" | - sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{ - s//\1/ - q - } - /^X\(\/\/\)[^/].*/{ - s//\1/ - q - } - /^X\(\/\/\)$/{ - s//\1/ - q - } - /^X\(\/\).*/{ - s//\1/ - q - } - s/.*/./; q'` - test -d "$as_dir" && break - done - test -z "$as_dirs" || eval "mkdir $as_dirs" - } || test -d "$as_dir" || as_fn_error $? "cannot create directory $as_dir" - - -} # as_fn_mkdir_p -if mkdir -p . 2>/dev/null; then - as_mkdir_p='mkdir -p "$as_dir"' -else - test -d ./-p && rmdir ./-p - as_mkdir_p=false -fi - - -# as_fn_executable_p FILE -# ----------------------- -# Test if FILE is an executable regular file. -as_fn_executable_p () -{ - test -f "$1" && test -x "$1" -} # as_fn_executable_p -as_test_x='test -x' -as_executable_p=as_fn_executable_p - -# Sed expression to map a string onto a valid CPP name. -as_tr_cpp="eval sed 'y%*$as_cr_letters%P$as_cr_LETTERS%;s%[^_$as_cr_alnum]%_%g'" - -# Sed expression to map a string onto a valid variable name. -as_tr_sh="eval sed 'y%*+%pp%;s%[^_$as_cr_alnum]%_%g'" - - -exec 6>&1 -## ----------------------------------- ## -## Main body of $CONFIG_STATUS script. ## -## ----------------------------------- ## -_ASEOF -test $as_write_fail = 0 && chmod +x $CONFIG_STATUS || ac_write_fail=1 - -cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1 -# Save the log message, to keep $0 and so on meaningful, and to -# report actual input values of CONFIG_FILES etc. instead of their -# values after options handling. -ac_log=" -This file was extended by GnuCOBOL $as_me 4.0-early-dev, which was -generated by GNU Autoconf 2.69. Invocation command line was - - CONFIG_FILES = $CONFIG_FILES - CONFIG_HEADERS = $CONFIG_HEADERS - CONFIG_LINKS = $CONFIG_LINKS - CONFIG_COMMANDS = $CONFIG_COMMANDS - $ $0 $@ - -on `(hostname || uname -n) 2>/dev/null | sed 1q` -" - -_ACEOF - -case $ac_config_files in *" -"*) set x $ac_config_files; shift; ac_config_files=$*;; -esac - -case $ac_config_headers in *" -"*) set x $ac_config_headers; shift; ac_config_headers=$*;; -esac - - -cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1 -# Files that config.status was made for. -config_files="$ac_config_files" -config_headers="$ac_config_headers" -config_commands="$ac_config_commands" - -_ACEOF - -cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1 -ac_cs_usage="\ -\`$as_me' instantiates files and other configuration actions -from templates according to the current configuration. Unless the files -and actions are specified as TAGs, all are instantiated by default. - -Usage: $0 [OPTION]... [TAG]... - - -h, --help print this help, then exit - -V, --version print version number and configuration settings, then exit - --config print configuration, then exit - -q, --quiet, --silent - do not print progress messages - -d, --debug don't remove temporary files - --recheck update $as_me by reconfiguring in the same conditions - --file=FILE[:TEMPLATE] - instantiate the configuration file FILE - --header=FILE[:TEMPLATE] - instantiate the configuration header FILE - -Configuration files: -$config_files - -Configuration headers: -$config_headers - -Configuration commands: -$config_commands - -Report bugs to . -GnuCOBOL home page: ." - -_ACEOF -cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1 -ac_cs_config="`$as_echo "$ac_configure_args" | sed 's/^ //; s/[\\""\`\$]/\\\\&/g'`" -ac_cs_version="\\ -GnuCOBOL config.status 4.0-early-dev -configured by $0, generated by GNU Autoconf 2.69, - with options \\"\$ac_cs_config\\" - -Copyright (C) 2012 Free Software Foundation, Inc. -This config.status script is free software; the Free Software Foundation -gives unlimited permission to copy, distribute and modify it." - -ac_pwd='$ac_pwd' -srcdir='$srcdir' -INSTALL='$INSTALL' -MKDIR_P='$MKDIR_P' -AWK='$AWK' -test -n "\$AWK" || AWK=awk -_ACEOF - -cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1 -# The default lists apply if the user does not specify any file. -ac_need_defaults=: -while test $# != 0 -do - case $1 in - --*=?*) - ac_option=`expr "X$1" : 'X\([^=]*\)='` - ac_optarg=`expr "X$1" : 'X[^=]*=\(.*\)'` - ac_shift=: - ;; - --*=) - ac_option=`expr "X$1" : 'X\([^=]*\)='` - ac_optarg= - ac_shift=: - ;; - *) - ac_option=$1 - ac_optarg=$2 - ac_shift=shift - ;; - esac - - case $ac_option in - # Handling of the options. - -recheck | --recheck | --rechec | --reche | --rech | --rec | --re | --r) - ac_cs_recheck=: ;; - --version | --versio | --versi | --vers | --ver | --ve | --v | -V ) - $as_echo "$ac_cs_version"; exit ;; - --config | --confi | --conf | --con | --co | --c ) - $as_echo "$ac_cs_config"; exit ;; - --debug | --debu | --deb | --de | --d | -d ) - debug=: ;; - --file | --fil | --fi | --f ) - $ac_shift - case $ac_optarg in - *\'*) ac_optarg=`$as_echo "$ac_optarg" | sed "s/'/'\\\\\\\\''/g"` ;; - '') as_fn_error $? "missing file argument" ;; - esac - as_fn_append CONFIG_FILES " '$ac_optarg'" - ac_need_defaults=false;; - --header | --heade | --head | --hea ) - $ac_shift - case $ac_optarg in - *\'*) ac_optarg=`$as_echo "$ac_optarg" | sed "s/'/'\\\\\\\\''/g"` ;; - esac - as_fn_append CONFIG_HEADERS " '$ac_optarg'" - ac_need_defaults=false;; - --he | --h) - # Conflict between --help and --header - as_fn_error $? "ambiguous option: \`$1' -Try \`$0 --help' for more information.";; - --help | --hel | -h ) - $as_echo "$ac_cs_usage"; exit ;; - -q | -quiet | --quiet | --quie | --qui | --qu | --q \ - | -silent | --silent | --silen | --sile | --sil | --si | --s) - ac_cs_silent=: ;; - - # This is an error. - -*) as_fn_error $? "unrecognized option: \`$1' -Try \`$0 --help' for more information." ;; - - *) as_fn_append ac_config_targets " $1" - ac_need_defaults=false ;; - - esac - shift -done - -ac_configure_extra_args= - -if $ac_cs_silent; then - exec 6>/dev/null - ac_configure_extra_args="$ac_configure_extra_args --silent" -fi - -_ACEOF -cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1 -if \$ac_cs_recheck; then - set X $SHELL '$0' $ac_configure_args \$ac_configure_extra_args --no-create --no-recursion - shift - \$as_echo "running CONFIG_SHELL=$SHELL \$*" >&6 - CONFIG_SHELL='$SHELL' - export CONFIG_SHELL - exec "\$@" -fi - -_ACEOF -cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1 -exec 5>>config.log -{ - echo - sed 'h;s/./-/g;s/^.../## /;s/...$/ ##/;p;x;p;x' <<_ASBOX -## Running $as_me. ## -_ASBOX - $as_echo "$ac_log" -} >&5 - -_ACEOF -cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1 -# -# INIT-COMMANDS -# - -AMDEP_TRUE="$AMDEP_TRUE" ac_aux_dir="$ac_aux_dir" - - -# The HP-UX ksh and POSIX shell print the target directory to stdout -# if CDPATH is set. -(unset CDPATH) >/dev/null 2>&1 && unset CDPATH - -sed_quote_subst='$sed_quote_subst' -double_quote_subst='$double_quote_subst' -delay_variable_subst='$delay_variable_subst' -macro_version='`$ECHO "$macro_version" | $SED "$delay_single_quote_subst"`' -macro_revision='`$ECHO "$macro_revision" | $SED "$delay_single_quote_subst"`' -AS='`$ECHO "$AS" | $SED "$delay_single_quote_subst"`' -DLLTOOL='`$ECHO "$DLLTOOL" | $SED "$delay_single_quote_subst"`' -OBJDUMP='`$ECHO "$OBJDUMP" | $SED "$delay_single_quote_subst"`' -enable_shared='`$ECHO "$enable_shared" | $SED "$delay_single_quote_subst"`' -enable_static='`$ECHO "$enable_static" | $SED "$delay_single_quote_subst"`' -pic_mode='`$ECHO "$pic_mode" | $SED "$delay_single_quote_subst"`' -enable_fast_install='`$ECHO "$enable_fast_install" | $SED "$delay_single_quote_subst"`' -shared_archive_member_spec='`$ECHO "$shared_archive_member_spec" | $SED "$delay_single_quote_subst"`' -SHELL='`$ECHO "$SHELL" | $SED "$delay_single_quote_subst"`' -ECHO='`$ECHO "$ECHO" | $SED "$delay_single_quote_subst"`' -PATH_SEPARATOR='`$ECHO "$PATH_SEPARATOR" | $SED "$delay_single_quote_subst"`' -host_alias='`$ECHO "$host_alias" | $SED "$delay_single_quote_subst"`' -host='`$ECHO "$host" | $SED "$delay_single_quote_subst"`' -host_os='`$ECHO "$host_os" | $SED "$delay_single_quote_subst"`' -build_alias='`$ECHO "$build_alias" | $SED "$delay_single_quote_subst"`' -build='`$ECHO "$build" | $SED "$delay_single_quote_subst"`' -build_os='`$ECHO "$build_os" | $SED "$delay_single_quote_subst"`' -SED='`$ECHO "$SED" | $SED "$delay_single_quote_subst"`' -Xsed='`$ECHO "$Xsed" | $SED "$delay_single_quote_subst"`' -GREP='`$ECHO "$GREP" | $SED "$delay_single_quote_subst"`' -EGREP='`$ECHO "$EGREP" | $SED "$delay_single_quote_subst"`' -FGREP='`$ECHO "$FGREP" | $SED "$delay_single_quote_subst"`' -LD='`$ECHO "$LD" | $SED "$delay_single_quote_subst"`' -NM='`$ECHO "$NM" | $SED "$delay_single_quote_subst"`' -LN_S='`$ECHO "$LN_S" | $SED "$delay_single_quote_subst"`' -max_cmd_len='`$ECHO "$max_cmd_len" | $SED "$delay_single_quote_subst"`' -ac_objext='`$ECHO "$ac_objext" | $SED "$delay_single_quote_subst"`' -exeext='`$ECHO "$exeext" | $SED "$delay_single_quote_subst"`' -lt_unset='`$ECHO "$lt_unset" | $SED "$delay_single_quote_subst"`' -lt_SP2NL='`$ECHO "$lt_SP2NL" | $SED "$delay_single_quote_subst"`' -lt_NL2SP='`$ECHO "$lt_NL2SP" | $SED "$delay_single_quote_subst"`' -lt_cv_to_host_file_cmd='`$ECHO "$lt_cv_to_host_file_cmd" | $SED "$delay_single_quote_subst"`' -lt_cv_to_tool_file_cmd='`$ECHO "$lt_cv_to_tool_file_cmd" | $SED "$delay_single_quote_subst"`' -reload_flag='`$ECHO "$reload_flag" | $SED "$delay_single_quote_subst"`' -reload_cmds='`$ECHO "$reload_cmds" | $SED "$delay_single_quote_subst"`' -deplibs_check_method='`$ECHO "$deplibs_check_method" | $SED "$delay_single_quote_subst"`' -file_magic_cmd='`$ECHO "$file_magic_cmd" | $SED "$delay_single_quote_subst"`' -file_magic_glob='`$ECHO "$file_magic_glob" | $SED "$delay_single_quote_subst"`' -want_nocaseglob='`$ECHO "$want_nocaseglob" | $SED "$delay_single_quote_subst"`' -sharedlib_from_linklib_cmd='`$ECHO "$sharedlib_from_linklib_cmd" | $SED "$delay_single_quote_subst"`' -AR='`$ECHO "$AR" | $SED "$delay_single_quote_subst"`' -AR_FLAGS='`$ECHO "$AR_FLAGS" | $SED "$delay_single_quote_subst"`' -archiver_list_spec='`$ECHO "$archiver_list_spec" | $SED "$delay_single_quote_subst"`' -STRIP='`$ECHO "$STRIP" | $SED "$delay_single_quote_subst"`' -RANLIB='`$ECHO "$RANLIB" | $SED "$delay_single_quote_subst"`' -old_postinstall_cmds='`$ECHO "$old_postinstall_cmds" | $SED "$delay_single_quote_subst"`' -old_postuninstall_cmds='`$ECHO "$old_postuninstall_cmds" | $SED "$delay_single_quote_subst"`' -old_archive_cmds='`$ECHO "$old_archive_cmds" | $SED "$delay_single_quote_subst"`' -lock_old_archive_extraction='`$ECHO "$lock_old_archive_extraction" | $SED "$delay_single_quote_subst"`' -CC='`$ECHO "$CC" | $SED "$delay_single_quote_subst"`' -CFLAGS='`$ECHO "$CFLAGS" | $SED "$delay_single_quote_subst"`' -compiler='`$ECHO "$compiler" | $SED "$delay_single_quote_subst"`' -GCC='`$ECHO "$GCC" | $SED "$delay_single_quote_subst"`' -lt_cv_sys_global_symbol_pipe='`$ECHO "$lt_cv_sys_global_symbol_pipe" | $SED "$delay_single_quote_subst"`' -lt_cv_sys_global_symbol_to_cdecl='`$ECHO "$lt_cv_sys_global_symbol_to_cdecl" | $SED "$delay_single_quote_subst"`' -lt_cv_sys_global_symbol_to_import='`$ECHO "$lt_cv_sys_global_symbol_to_import" | $SED "$delay_single_quote_subst"`' -lt_cv_sys_global_symbol_to_c_name_address='`$ECHO "$lt_cv_sys_global_symbol_to_c_name_address" | $SED "$delay_single_quote_subst"`' -lt_cv_sys_global_symbol_to_c_name_address_lib_prefix='`$ECHO "$lt_cv_sys_global_symbol_to_c_name_address_lib_prefix" | $SED "$delay_single_quote_subst"`' -lt_cv_nm_interface='`$ECHO "$lt_cv_nm_interface" | $SED "$delay_single_quote_subst"`' -nm_file_list_spec='`$ECHO "$nm_file_list_spec" | $SED "$delay_single_quote_subst"`' -lt_sysroot='`$ECHO "$lt_sysroot" | $SED "$delay_single_quote_subst"`' -lt_cv_truncate_bin='`$ECHO "$lt_cv_truncate_bin" | $SED "$delay_single_quote_subst"`' -objdir='`$ECHO "$objdir" | $SED "$delay_single_quote_subst"`' -MAGIC_CMD='`$ECHO "$MAGIC_CMD" | $SED "$delay_single_quote_subst"`' -lt_prog_compiler_no_builtin_flag='`$ECHO "$lt_prog_compiler_no_builtin_flag" | $SED "$delay_single_quote_subst"`' -lt_prog_compiler_pic='`$ECHO "$lt_prog_compiler_pic" | $SED "$delay_single_quote_subst"`' -lt_prog_compiler_wl='`$ECHO "$lt_prog_compiler_wl" | $SED "$delay_single_quote_subst"`' -lt_prog_compiler_static='`$ECHO "$lt_prog_compiler_static" | $SED "$delay_single_quote_subst"`' -lt_cv_prog_compiler_c_o='`$ECHO "$lt_cv_prog_compiler_c_o" | $SED "$delay_single_quote_subst"`' -need_locks='`$ECHO "$need_locks" | $SED "$delay_single_quote_subst"`' -MANIFEST_TOOL='`$ECHO "$MANIFEST_TOOL" | $SED "$delay_single_quote_subst"`' -DSYMUTIL='`$ECHO "$DSYMUTIL" | $SED "$delay_single_quote_subst"`' -NMEDIT='`$ECHO "$NMEDIT" | $SED "$delay_single_quote_subst"`' -LIPO='`$ECHO "$LIPO" | $SED "$delay_single_quote_subst"`' -OTOOL='`$ECHO "$OTOOL" | $SED "$delay_single_quote_subst"`' -OTOOL64='`$ECHO "$OTOOL64" | $SED "$delay_single_quote_subst"`' -libext='`$ECHO "$libext" | $SED "$delay_single_quote_subst"`' -shrext_cmds='`$ECHO "$shrext_cmds" | $SED "$delay_single_quote_subst"`' -extract_expsyms_cmds='`$ECHO "$extract_expsyms_cmds" | $SED "$delay_single_quote_subst"`' -archive_cmds_need_lc='`$ECHO "$archive_cmds_need_lc" | $SED "$delay_single_quote_subst"`' -enable_shared_with_static_runtimes='`$ECHO "$enable_shared_with_static_runtimes" | $SED "$delay_single_quote_subst"`' -export_dynamic_flag_spec='`$ECHO "$export_dynamic_flag_spec" | $SED "$delay_single_quote_subst"`' -whole_archive_flag_spec='`$ECHO "$whole_archive_flag_spec" | $SED "$delay_single_quote_subst"`' -compiler_needs_object='`$ECHO "$compiler_needs_object" | $SED "$delay_single_quote_subst"`' -old_archive_from_new_cmds='`$ECHO "$old_archive_from_new_cmds" | $SED "$delay_single_quote_subst"`' -old_archive_from_expsyms_cmds='`$ECHO "$old_archive_from_expsyms_cmds" | $SED "$delay_single_quote_subst"`' -archive_cmds='`$ECHO "$archive_cmds" | $SED "$delay_single_quote_subst"`' -archive_expsym_cmds='`$ECHO "$archive_expsym_cmds" | $SED "$delay_single_quote_subst"`' -module_cmds='`$ECHO "$module_cmds" | $SED "$delay_single_quote_subst"`' -module_expsym_cmds='`$ECHO "$module_expsym_cmds" | $SED "$delay_single_quote_subst"`' -with_gnu_ld='`$ECHO "$with_gnu_ld" | $SED "$delay_single_quote_subst"`' -allow_undefined_flag='`$ECHO "$allow_undefined_flag" | $SED "$delay_single_quote_subst"`' -no_undefined_flag='`$ECHO "$no_undefined_flag" | $SED "$delay_single_quote_subst"`' -hardcode_libdir_flag_spec='`$ECHO "$hardcode_libdir_flag_spec" | $SED "$delay_single_quote_subst"`' -hardcode_libdir_separator='`$ECHO "$hardcode_libdir_separator" | $SED "$delay_single_quote_subst"`' -hardcode_direct='`$ECHO "$hardcode_direct" | $SED "$delay_single_quote_subst"`' -hardcode_direct_absolute='`$ECHO "$hardcode_direct_absolute" | $SED "$delay_single_quote_subst"`' -hardcode_minus_L='`$ECHO "$hardcode_minus_L" | $SED "$delay_single_quote_subst"`' -hardcode_shlibpath_var='`$ECHO "$hardcode_shlibpath_var" | $SED "$delay_single_quote_subst"`' -hardcode_automatic='`$ECHO "$hardcode_automatic" | $SED "$delay_single_quote_subst"`' -inherit_rpath='`$ECHO "$inherit_rpath" | $SED "$delay_single_quote_subst"`' -link_all_deplibs='`$ECHO "$link_all_deplibs" | $SED "$delay_single_quote_subst"`' -always_export_symbols='`$ECHO "$always_export_symbols" | $SED "$delay_single_quote_subst"`' -export_symbols_cmds='`$ECHO "$export_symbols_cmds" | $SED "$delay_single_quote_subst"`' -exclude_expsyms='`$ECHO "$exclude_expsyms" | $SED "$delay_single_quote_subst"`' -include_expsyms='`$ECHO "$include_expsyms" | $SED "$delay_single_quote_subst"`' -prelink_cmds='`$ECHO "$prelink_cmds" | $SED "$delay_single_quote_subst"`' -postlink_cmds='`$ECHO "$postlink_cmds" | $SED "$delay_single_quote_subst"`' -file_list_spec='`$ECHO "$file_list_spec" | $SED "$delay_single_quote_subst"`' -variables_saved_for_relink='`$ECHO "$variables_saved_for_relink" | $SED "$delay_single_quote_subst"`' -need_lib_prefix='`$ECHO "$need_lib_prefix" | $SED "$delay_single_quote_subst"`' -need_version='`$ECHO "$need_version" | $SED "$delay_single_quote_subst"`' -version_type='`$ECHO "$version_type" | $SED "$delay_single_quote_subst"`' -runpath_var='`$ECHO "$runpath_var" | $SED "$delay_single_quote_subst"`' -shlibpath_var='`$ECHO "$shlibpath_var" | $SED "$delay_single_quote_subst"`' -shlibpath_overrides_runpath='`$ECHO "$shlibpath_overrides_runpath" | $SED "$delay_single_quote_subst"`' -libname_spec='`$ECHO "$libname_spec" | $SED "$delay_single_quote_subst"`' -library_names_spec='`$ECHO "$library_names_spec" | $SED "$delay_single_quote_subst"`' -soname_spec='`$ECHO "$soname_spec" | $SED "$delay_single_quote_subst"`' -install_override_mode='`$ECHO "$install_override_mode" | $SED "$delay_single_quote_subst"`' -postinstall_cmds='`$ECHO "$postinstall_cmds" | $SED "$delay_single_quote_subst"`' -postuninstall_cmds='`$ECHO "$postuninstall_cmds" | $SED "$delay_single_quote_subst"`' -finish_cmds='`$ECHO "$finish_cmds" | $SED "$delay_single_quote_subst"`' -finish_eval='`$ECHO "$finish_eval" | $SED "$delay_single_quote_subst"`' -hardcode_into_libs='`$ECHO "$hardcode_into_libs" | $SED "$delay_single_quote_subst"`' -sys_lib_search_path_spec='`$ECHO "$sys_lib_search_path_spec" | $SED "$delay_single_quote_subst"`' -configure_time_dlsearch_path='`$ECHO "$configure_time_dlsearch_path" | $SED "$delay_single_quote_subst"`' -configure_time_lt_sys_library_path='`$ECHO "$configure_time_lt_sys_library_path" | $SED "$delay_single_quote_subst"`' -hardcode_action='`$ECHO "$hardcode_action" | $SED "$delay_single_quote_subst"`' -enable_dlopen='`$ECHO "$enable_dlopen" | $SED "$delay_single_quote_subst"`' -enable_dlopen_self='`$ECHO "$enable_dlopen_self" | $SED "$delay_single_quote_subst"`' -enable_dlopen_self_static='`$ECHO "$enable_dlopen_self_static" | $SED "$delay_single_quote_subst"`' -old_striplib='`$ECHO "$old_striplib" | $SED "$delay_single_quote_subst"`' -striplib='`$ECHO "$striplib" | $SED "$delay_single_quote_subst"`' - -LTCC='$LTCC' -LTCFLAGS='$LTCFLAGS' -compiler='$compiler_DEFAULT' - -# A function that is used when there is no print builtin or printf. -func_fallback_echo () -{ - eval 'cat <<_LTECHO_EOF -\$1 -_LTECHO_EOF' -} - -# Quote evaled strings. -for var in AS \ -DLLTOOL \ -OBJDUMP \ -SHELL \ -ECHO \ -PATH_SEPARATOR \ -SED \ -GREP \ -EGREP \ -FGREP \ -LD \ -NM \ -LN_S \ -lt_SP2NL \ -lt_NL2SP \ -reload_flag \ -deplibs_check_method \ -file_magic_cmd \ -file_magic_glob \ -want_nocaseglob \ -sharedlib_from_linklib_cmd \ -AR \ -AR_FLAGS \ -archiver_list_spec \ -STRIP \ -RANLIB \ -CC \ -CFLAGS \ -compiler \ -lt_cv_sys_global_symbol_pipe \ -lt_cv_sys_global_symbol_to_cdecl \ -lt_cv_sys_global_symbol_to_import \ -lt_cv_sys_global_symbol_to_c_name_address \ -lt_cv_sys_global_symbol_to_c_name_address_lib_prefix \ -lt_cv_nm_interface \ -nm_file_list_spec \ -lt_cv_truncate_bin \ -lt_prog_compiler_no_builtin_flag \ -lt_prog_compiler_pic \ -lt_prog_compiler_wl \ -lt_prog_compiler_static \ -lt_cv_prog_compiler_c_o \ -need_locks \ -MANIFEST_TOOL \ -DSYMUTIL \ -NMEDIT \ -LIPO \ -OTOOL \ -OTOOL64 \ -shrext_cmds \ -export_dynamic_flag_spec \ -whole_archive_flag_spec \ -compiler_needs_object \ -with_gnu_ld \ -allow_undefined_flag \ -no_undefined_flag \ -hardcode_libdir_flag_spec \ -hardcode_libdir_separator \ -exclude_expsyms \ -include_expsyms \ -file_list_spec \ -variables_saved_for_relink \ -libname_spec \ -library_names_spec \ -soname_spec \ -install_override_mode \ -finish_eval \ -old_striplib \ -striplib; do - case \`eval \\\\\$ECHO \\\\""\\\\\$\$var"\\\\"\` in - *[\\\\\\\`\\"\\\$]*) - eval "lt_\$var=\\\\\\"\\\`\\\$ECHO \\"\\\$\$var\\" | \\\$SED \\"\\\$sed_quote_subst\\"\\\`\\\\\\"" ## exclude from sc_prohibit_nested_quotes - ;; - *) - eval "lt_\$var=\\\\\\"\\\$\$var\\\\\\"" - ;; - esac -done - -# Double-quote double-evaled strings. -for var in reload_cmds \ -old_postinstall_cmds \ -old_postuninstall_cmds \ -old_archive_cmds \ -extract_expsyms_cmds \ -old_archive_from_new_cmds \ -old_archive_from_expsyms_cmds \ -archive_cmds \ -archive_expsym_cmds \ -module_cmds \ -module_expsym_cmds \ -export_symbols_cmds \ -prelink_cmds \ -postlink_cmds \ -postinstall_cmds \ -postuninstall_cmds \ -finish_cmds \ -sys_lib_search_path_spec \ -configure_time_dlsearch_path \ -configure_time_lt_sys_library_path; do - case \`eval \\\\\$ECHO \\\\""\\\\\$\$var"\\\\"\` in - *[\\\\\\\`\\"\\\$]*) - eval "lt_\$var=\\\\\\"\\\`\\\$ECHO \\"\\\$\$var\\" | \\\$SED -e \\"\\\$double_quote_subst\\" -e \\"\\\$sed_quote_subst\\" -e \\"\\\$delay_variable_subst\\"\\\`\\\\\\"" ## exclude from sc_prohibit_nested_quotes - ;; - *) - eval "lt_\$var=\\\\\\"\\\$\$var\\\\\\"" - ;; - esac -done - -ac_aux_dir='$ac_aux_dir' - -# See if we are running on zsh, and set the options that allow our -# commands through without removal of \ escapes INIT. -if test -n "\${ZSH_VERSION+set}"; then - setopt NO_GLOB_SUBST -fi - - - PACKAGE='$PACKAGE' - VERSION='$VERSION' - RM='$RM' - ofile='$ofile' - - - -# Capture the value of obsolete ALL_LINGUAS because we need it to compute - # POFILES, UPDATEPOFILES, DUMMYPOFILES, GMOFILES, CATALOGS. But hide it - # from automake < 1.5. - eval 'OBSOLETE_ALL_LINGUAS''="$ALL_LINGUAS"' - # Capture the value of LINGUAS because we need it to compute CATALOGS. - LINGUAS="${LINGUAS-%UNSET%}" - - -_ACEOF - -cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1 - -# Handling of arguments. -for ac_config_target in $ac_config_targets -do - case $ac_config_target in - "config.h") CONFIG_HEADERS="$CONFIG_HEADERS config.h" ;; - "tests/atconfig") CONFIG_COMMANDS="$CONFIG_COMMANDS tests/atconfig" ;; - "Makefile") CONFIG_FILES="$CONFIG_FILES Makefile" ;; - "libcob/Makefile") CONFIG_FILES="$CONFIG_FILES libcob/Makefile" ;; - "lib/Makefile") CONFIG_FILES="$CONFIG_FILES lib/Makefile" ;; - "cobc/Makefile") CONFIG_FILES="$CONFIG_FILES cobc/Makefile" ;; - "bin/Makefile") CONFIG_FILES="$CONFIG_FILES bin/Makefile" ;; - "po/Makefile.in") CONFIG_FILES="$CONFIG_FILES po/Makefile.in" ;; - "doc/Makefile") CONFIG_FILES="$CONFIG_FILES doc/Makefile" ;; - "config/Makefile") CONFIG_FILES="$CONFIG_FILES config/Makefile" ;; - "copy/Makefile") CONFIG_FILES="$CONFIG_FILES copy/Makefile" ;; - "tests/Makefile") CONFIG_FILES="$CONFIG_FILES tests/Makefile" ;; - "tests/cobol85/Makefile") CONFIG_FILES="$CONFIG_FILES tests/cobol85/Makefile" ;; - "extras/Makefile") CONFIG_FILES="$CONFIG_FILES extras/Makefile" ;; - "bin/cob-config") CONFIG_FILES="$CONFIG_FILES bin/cob-config" ;; - "pre-inst-env") CONFIG_FILES="$CONFIG_FILES pre-inst-env:build_aux/pre-inst-env.in" ;; - "tests/atlocal") CONFIG_FILES="$CONFIG_FILES tests/atlocal" ;; - "tests/run_prog_manual.sh") CONFIG_FILES="$CONFIG_FILES tests/run_prog_manual.sh" ;; - "depfiles") CONFIG_COMMANDS="$CONFIG_COMMANDS depfiles" ;; - "libtool") CONFIG_COMMANDS="$CONFIG_COMMANDS libtool" ;; - "po-directories") CONFIG_COMMANDS="$CONFIG_COMMANDS po-directories" ;; - "chmod") CONFIG_COMMANDS="$CONFIG_COMMANDS chmod" ;; - - *) as_fn_error $? "invalid argument: \`$ac_config_target'" "$LINENO" 5;; - esac -done - - -# If the user did not use the arguments to specify the items to instantiate, -# then the envvar interface is used. Set only those that are not. -# We use the long form for the default assignment because of an extremely -# bizarre bug on SunOS 4.1.3. -if $ac_need_defaults; then - test "${CONFIG_FILES+set}" = set || CONFIG_FILES=$config_files - test "${CONFIG_HEADERS+set}" = set || CONFIG_HEADERS=$config_headers - test "${CONFIG_COMMANDS+set}" = set || CONFIG_COMMANDS=$config_commands -fi - -# Have a temporary directory for convenience. Make it in the build tree -# simply because there is no reason against having it here, and in addition, -# creating and moving files from /tmp can sometimes cause problems. -# Hook for its removal unless debugging. -# Note that there is a small window in which the directory will not be cleaned: -# after its creation but before its name has been assigned to `$tmp'. -$debug || -{ - tmp= ac_tmp= - trap 'exit_status=$? - : "${ac_tmp:=$tmp}" - { test ! -d "$ac_tmp" || rm -fr "$ac_tmp"; } && exit $exit_status -' 0 - trap 'as_fn_exit 1' 1 2 13 15 -} -# Create a (secure) tmp directory for tmp files. - -{ - tmp=`(umask 077 && mktemp -d "./confXXXXXX") 2>/dev/null` && - test -d "$tmp" -} || -{ - tmp=./conf$$-$RANDOM - (umask 077 && mkdir "$tmp") -} || as_fn_error $? "cannot create a temporary directory in ." "$LINENO" 5 -ac_tmp=$tmp - -# Set up the scripts for CONFIG_FILES section. -# No need to generate them if there are no CONFIG_FILES. -# This happens for instance with `./config.status config.h'. -if test -n "$CONFIG_FILES"; then - - -ac_cr=`echo X | tr X '\015'` -# On cygwin, bash can eat \r inside `` if the user requested igncr. -# But we know of no other shell where ac_cr would be empty at this -# point, so we can use a bashism as a fallback. -if test "x$ac_cr" = x; then - eval ac_cr=\$\'\\r\' -fi -ac_cs_awk_cr=`$AWK 'BEGIN { print "a\rb" }' /dev/null` -if test "$ac_cs_awk_cr" = "a${ac_cr}b"; then - ac_cs_awk_cr='\\r' -else - ac_cs_awk_cr=$ac_cr -fi - -echo 'BEGIN {' >"$ac_tmp/subs1.awk" && -_ACEOF - - -{ - echo "cat >conf$$subs.awk <<_ACEOF" && - echo "$ac_subst_vars" | sed 's/.*/&!$&$ac_delim/' && - echo "_ACEOF" -} >conf$$subs.sh || - as_fn_error $? "could not make $CONFIG_STATUS" "$LINENO" 5 -ac_delim_num=`echo "$ac_subst_vars" | grep -c '^'` -ac_delim='%!_!# ' -for ac_last_try in false false false false false :; do - . ./conf$$subs.sh || - as_fn_error $? "could not make $CONFIG_STATUS" "$LINENO" 5 - - ac_delim_n=`sed -n "s/.*$ac_delim\$/X/p" conf$$subs.awk | grep -c X` - if test $ac_delim_n = $ac_delim_num; then - break - elif $ac_last_try; then - as_fn_error $? "could not make $CONFIG_STATUS" "$LINENO" 5 - else - ac_delim="$ac_delim!$ac_delim _$ac_delim!! " - fi -done -rm -f conf$$subs.sh - -cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1 -cat >>"\$ac_tmp/subs1.awk" <<\\_ACAWK && -_ACEOF -sed -n ' -h -s/^/S["/; s/!.*/"]=/ -p -g -s/^[^!]*!// -:repl -t repl -s/'"$ac_delim"'$// -t delim -:nl -h -s/\(.\{148\}\)..*/\1/ -t more1 -s/["\\]/\\&/g; s/^/"/; s/$/\\n"\\/ -p -n -b repl -:more1 -s/["\\]/\\&/g; s/^/"/; s/$/"\\/ -p -g -s/.\{148\}// -t nl -:delim -h -s/\(.\{148\}\)..*/\1/ -t more2 -s/["\\]/\\&/g; s/^/"/; s/$/"/ -p -b -:more2 -s/["\\]/\\&/g; s/^/"/; s/$/"\\/ -p -g -s/.\{148\}// -t delim -' >$CONFIG_STATUS || ac_write_fail=1 -rm -f conf$$subs.awk -cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1 -_ACAWK -cat >>"\$ac_tmp/subs1.awk" <<_ACAWK && - for (key in S) S_is_set[key] = 1 - FS = "" - -} -{ - line = $ 0 - nfields = split(line, field, "@") - substed = 0 - len = length(field[1]) - for (i = 2; i < nfields; i++) { - key = field[i] - keylen = length(key) - if (S_is_set[key]) { - value = S[key] - line = substr(line, 1, len) "" value "" substr(line, len + keylen + 3) - len += length(value) + length(field[++i]) - substed = 1 - } else - len += 1 + keylen - } - - print line -} - -_ACAWK -_ACEOF -cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1 -if sed "s/$ac_cr//" < /dev/null > /dev/null 2>&1; then - sed "s/$ac_cr\$//; s/$ac_cr/$ac_cs_awk_cr/g" -else - cat -fi < "$ac_tmp/subs1.awk" > "$ac_tmp/subs.awk" \ - || as_fn_error $? "could not setup config files machinery" "$LINENO" 5 -_ACEOF - -# VPATH may cause trouble with some makes, so we remove sole $(srcdir), -# ${srcdir} and @srcdir@ entries from VPATH if srcdir is ".", strip leading and -# trailing colons and then remove the whole line if VPATH becomes empty -# (actually we leave an empty line to preserve line numbers). -if test "x$srcdir" = x.; then - ac_vpsub='/^[ ]*VPATH[ ]*=[ ]*/{ -h -s/// -s/^/:/ -s/[ ]*$/:/ -s/:\$(srcdir):/:/g -s/:\${srcdir}:/:/g -s/:@srcdir@:/:/g -s/^:*// -s/:*$// -x -s/\(=[ ]*\).*/\1/ -G -s/\n// -s/^[^=]*=[ ]*$// -}' -fi - -cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1 -fi # test -n "$CONFIG_FILES" - -# Set up the scripts for CONFIG_HEADERS section. -# No need to generate them if there are no CONFIG_HEADERS. -# This happens for instance with `./config.status Makefile'. -if test -n "$CONFIG_HEADERS"; then -cat >"$ac_tmp/defines.awk" <<\_ACAWK || -BEGIN { -_ACEOF - -# Transform confdefs.h into an awk script `defines.awk', embedded as -# here-document in config.status, that substitutes the proper values into -# config.h.in to produce config.h. - -# Create a delimiter string that does not exist in confdefs.h, to ease -# handling of long lines. -ac_delim='%!_!# ' -for ac_last_try in false false :; do - ac_tt=`sed -n "/$ac_delim/p" confdefs.h` - if test -z "$ac_tt"; then - break - elif $ac_last_try; then - as_fn_error $? "could not make $CONFIG_HEADERS" "$LINENO" 5 - else - ac_delim="$ac_delim!$ac_delim _$ac_delim!! " - fi -done - -# For the awk script, D is an array of macro values keyed by name, -# likewise P contains macro parameters if any. Preserve backslash -# newline sequences. - -ac_word_re=[_$as_cr_Letters][_$as_cr_alnum]* -sed -n ' -s/.\{148\}/&'"$ac_delim"'/g -t rset -:rset -s/^[ ]*#[ ]*define[ ][ ]*/ / -t def -d -:def -s/\\$// -t bsnl -s/["\\]/\\&/g -s/^ \('"$ac_word_re"'\)\(([^()]*)\)[ ]*\(.*\)/P["\1"]="\2"\ -D["\1"]=" \3"/p -s/^ \('"$ac_word_re"'\)[ ]*\(.*\)/D["\1"]=" \2"/p -d -:bsnl -s/["\\]/\\&/g -s/^ \('"$ac_word_re"'\)\(([^()]*)\)[ ]*\(.*\)/P["\1"]="\2"\ -D["\1"]=" \3\\\\\\n"\\/p -t cont -s/^ \('"$ac_word_re"'\)[ ]*\(.*\)/D["\1"]=" \2\\\\\\n"\\/p -t cont -d -:cont -n -s/.\{148\}/&'"$ac_delim"'/g -t clear -:clear -s/\\$// -t bsnlc -s/["\\]/\\&/g; s/^/"/; s/$/"/p -d -:bsnlc -s/["\\]/\\&/g; s/^/"/; s/$/\\\\\\n"\\/p -b cont -' >$CONFIG_STATUS || ac_write_fail=1 - -cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1 - for (key in D) D_is_set[key] = 1 - FS = "" -} -/^[\t ]*#[\t ]*(define|undef)[\t ]+$ac_word_re([\t (]|\$)/ { - line = \$ 0 - split(line, arg, " ") - if (arg[1] == "#") { - defundef = arg[2] - mac1 = arg[3] - } else { - defundef = substr(arg[1], 2) - mac1 = arg[2] - } - split(mac1, mac2, "(") #) - macro = mac2[1] - prefix = substr(line, 1, index(line, defundef) - 1) - if (D_is_set[macro]) { - # Preserve the white space surrounding the "#". - print prefix "define", macro P[macro] D[macro] - next - } else { - # Replace #undef with comments. This is necessary, for example, - # in the case of _POSIX_SOURCE, which is predefined and required - # on some systems where configure will not decide to define it. - if (defundef == "undef") { - print "/*", prefix defundef, macro, "*/" - next - } - } -} -{ print } -_ACAWK -_ACEOF -cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1 - as_fn_error $? "could not setup config headers machinery" "$LINENO" 5 -fi # test -n "$CONFIG_HEADERS" - - -eval set X " :F $CONFIG_FILES :H $CONFIG_HEADERS :C $CONFIG_COMMANDS" -shift -for ac_tag -do - case $ac_tag in - :[FHLC]) ac_mode=$ac_tag; continue;; - esac - case $ac_mode$ac_tag in - :[FHL]*:*);; - :L* | :C*:*) as_fn_error $? "invalid tag \`$ac_tag'" "$LINENO" 5;; - :[FH]-) ac_tag=-:-;; - :[FH]*) ac_tag=$ac_tag:$ac_tag.in;; - esac - ac_save_IFS=$IFS - IFS=: - set x $ac_tag - IFS=$ac_save_IFS - shift - ac_file=$1 - shift - - case $ac_mode in - :L) ac_source=$1;; - :[FH]) - ac_file_inputs= - for ac_f - do - case $ac_f in - -) ac_f="$ac_tmp/stdin";; - *) # Look for the file first in the build tree, then in the source tree - # (if the path is not absolute). The absolute path cannot be DOS-style, - # because $ac_f cannot contain `:'. - test -f "$ac_f" || - case $ac_f in - [\\/$]*) false;; - *) test -f "$srcdir/$ac_f" && ac_f="$srcdir/$ac_f";; - esac || - as_fn_error 1 "cannot find input file: \`$ac_f'" "$LINENO" 5;; - esac - case $ac_f in *\'*) ac_f=`$as_echo "$ac_f" | sed "s/'/'\\\\\\\\''/g"`;; esac - as_fn_append ac_file_inputs " '$ac_f'" - done - - # Let's still pretend it is `configure' which instantiates (i.e., don't - # use $as_me), people would be surprised to read: - # /* config.h. Generated by config.status. */ - configure_input='Generated from '` - $as_echo "$*" | sed 's|^[^:]*/||;s|:[^:]*/|, |g' - `' by configure.' - if test x"$ac_file" != x-; then - configure_input="$ac_file. $configure_input" - { $as_echo "$as_me:${as_lineno-$LINENO}: creating $ac_file" >&5 -$as_echo "$as_me: creating $ac_file" >&6;} - fi - # Neutralize special characters interpreted by sed in replacement strings. - case $configure_input in #( - *\&* | *\|* | *\\* ) - ac_sed_conf_input=`$as_echo "$configure_input" | - sed 's/[\\\\&|]/\\\\&/g'`;; #( - *) ac_sed_conf_input=$configure_input;; - esac - - case $ac_tag in - *:-:* | *:-) cat >"$ac_tmp/stdin" \ - || as_fn_error $? "could not create $ac_file" "$LINENO" 5 ;; - esac - ;; - esac - - ac_dir=`$as_dirname -- "$ac_file" || -$as_expr X"$ac_file" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \ - X"$ac_file" : 'X\(//\)[^/]' \| \ - X"$ac_file" : 'X\(//\)$' \| \ - X"$ac_file" : 'X\(/\)' \| . 2>/dev/null || -$as_echo X"$ac_file" | - sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{ - s//\1/ - q - } - /^X\(\/\/\)[^/].*/{ - s//\1/ - q - } - /^X\(\/\/\)$/{ - s//\1/ - q - } - /^X\(\/\).*/{ - s//\1/ - q - } - s/.*/./; q'` - as_dir="$ac_dir"; as_fn_mkdir_p - ac_builddir=. - -case "$ac_dir" in -.) ac_dir_suffix= ac_top_builddir_sub=. ac_top_build_prefix= ;; -*) - ac_dir_suffix=/`$as_echo "$ac_dir" | sed 's|^\.[\\/]||'` - # A ".." for each directory in $ac_dir_suffix. - ac_top_builddir_sub=`$as_echo "$ac_dir_suffix" | sed 's|/[^\\/]*|/..|g;s|/||'` - case $ac_top_builddir_sub in - "") ac_top_builddir_sub=. ac_top_build_prefix= ;; - *) ac_top_build_prefix=$ac_top_builddir_sub/ ;; - esac ;; -esac -ac_abs_top_builddir=$ac_pwd -ac_abs_builddir=$ac_pwd$ac_dir_suffix -# for backward compatibility: -ac_top_builddir=$ac_top_build_prefix - -case $srcdir in - .) # We are building in place. - ac_srcdir=. - ac_top_srcdir=$ac_top_builddir_sub - ac_abs_top_srcdir=$ac_pwd ;; - [\\/]* | ?:[\\/]* ) # Absolute name. - ac_srcdir=$srcdir$ac_dir_suffix; - ac_top_srcdir=$srcdir - ac_abs_top_srcdir=$srcdir ;; - *) # Relative name. - ac_srcdir=$ac_top_build_prefix$srcdir$ac_dir_suffix - ac_top_srcdir=$ac_top_build_prefix$srcdir - ac_abs_top_srcdir=$ac_pwd/$srcdir ;; -esac -ac_abs_srcdir=$ac_abs_top_srcdir$ac_dir_suffix - - - case $ac_mode in - :F) - # - # CONFIG_FILE - # - - case $INSTALL in - [\\/$]* | ?:[\\/]* ) ac_INSTALL=$INSTALL ;; - *) ac_INSTALL=$ac_top_build_prefix$INSTALL ;; - esac - ac_MKDIR_P=$MKDIR_P - case $MKDIR_P in - [\\/$]* | ?:[\\/]* ) ;; - */*) ac_MKDIR_P=$ac_top_build_prefix$MKDIR_P ;; - esac -_ACEOF - -cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1 -# If the template does not know about datarootdir, expand it. -# FIXME: This hack should be removed a few years after 2.60. -ac_datarootdir_hack=; ac_datarootdir_seen= -ac_sed_dataroot=' -/datarootdir/ { - p - q -} -/@datadir@/p -/@docdir@/p -/@infodir@/p -/@localedir@/p -/@mandir@/p' -case `eval "sed -n \"\$ac_sed_dataroot\" $ac_file_inputs"` in -*datarootdir*) ac_datarootdir_seen=yes;; -*@datadir@*|*@docdir@*|*@infodir@*|*@localedir@*|*@mandir@*) - { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: $ac_file_inputs seems to ignore the --datarootdir setting" >&5 -$as_echo "$as_me: WARNING: $ac_file_inputs seems to ignore the --datarootdir setting" >&2;} -_ACEOF -cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1 - ac_datarootdir_hack=' - s&@datadir@&$datadir&g - s&@docdir@&$docdir&g - s&@infodir@&$infodir&g - s&@localedir@&$localedir&g - s&@mandir@&$mandir&g - s&\\\${datarootdir}&$datarootdir&g' ;; -esac -_ACEOF - -# Neutralize VPATH when `$srcdir' = `.'. -# Shell code in configure.ac might set extrasub. -# FIXME: do we really want to maintain this feature? -cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1 -ac_sed_extra="$ac_vpsub -$extrasub -_ACEOF -cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1 -:t -/@[a-zA-Z_][a-zA-Z_0-9]*@/!b -s|@configure_input@|$ac_sed_conf_input|;t t -s&@top_builddir@&$ac_top_builddir_sub&;t t -s&@top_build_prefix@&$ac_top_build_prefix&;t t -s&@srcdir@&$ac_srcdir&;t t -s&@abs_srcdir@&$ac_abs_srcdir&;t t -s&@top_srcdir@&$ac_top_srcdir&;t t -s&@abs_top_srcdir@&$ac_abs_top_srcdir&;t t -s&@builddir@&$ac_builddir&;t t -s&@abs_builddir@&$ac_abs_builddir&;t t -s&@abs_top_builddir@&$ac_abs_top_builddir&;t t -s&@INSTALL@&$ac_INSTALL&;t t -s&@MKDIR_P@&$ac_MKDIR_P&;t t -$ac_datarootdir_hack -" -eval sed \"\$ac_sed_extra\" "$ac_file_inputs" | $AWK -f "$ac_tmp/subs.awk" \ - >$ac_tmp/out || as_fn_error $? "could not create $ac_file" "$LINENO" 5 - -test -z "$ac_datarootdir_hack$ac_datarootdir_seen" && - { ac_out=`sed -n '/\${datarootdir}/p' "$ac_tmp/out"`; test -n "$ac_out"; } && - { ac_out=`sed -n '/^[ ]*datarootdir[ ]*:*=/p' \ - "$ac_tmp/out"`; test -z "$ac_out"; } && - { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: $ac_file contains a reference to the variable \`datarootdir' -which seems to be undefined. Please make sure it is defined" >&5 -$as_echo "$as_me: WARNING: $ac_file contains a reference to the variable \`datarootdir' -which seems to be undefined. Please make sure it is defined" >&2;} - - rm -f "$ac_tmp/stdin" - case $ac_file in - -) cat "$ac_tmp/out" && rm -f "$ac_tmp/out";; - *) rm -f "$ac_file" && mv "$ac_tmp/out" "$ac_file";; - esac \ - || as_fn_error $? "could not create $ac_file" "$LINENO" 5 - ;; - :H) - # - # CONFIG_HEADER - # - if test x"$ac_file" != x-; then - { - $as_echo "/* $configure_input */" \ - && eval '$AWK -f "$ac_tmp/defines.awk"' "$ac_file_inputs" - } >"$ac_tmp/config.h" \ - || as_fn_error $? "could not create $ac_file" "$LINENO" 5 - if diff "$ac_file" "$ac_tmp/config.h" >/dev/null 2>&1; then - { $as_echo "$as_me:${as_lineno-$LINENO}: $ac_file is unchanged" >&5 -$as_echo "$as_me: $ac_file is unchanged" >&6;} - else - rm -f "$ac_file" - mv "$ac_tmp/config.h" "$ac_file" \ - || as_fn_error $? "could not create $ac_file" "$LINENO" 5 - fi - else - $as_echo "/* $configure_input */" \ - && eval '$AWK -f "$ac_tmp/defines.awk"' "$ac_file_inputs" \ - || as_fn_error $? "could not create -" "$LINENO" 5 - fi -# Compute "$ac_file"'s index in $config_headers. -_am_arg="$ac_file" -_am_stamp_count=1 -for _am_header in $config_headers :; do - case $_am_header in - $_am_arg | $_am_arg:* ) - break ;; - * ) - _am_stamp_count=`expr $_am_stamp_count + 1` ;; - esac -done -echo "timestamp for $_am_arg" >`$as_dirname -- "$_am_arg" || -$as_expr X"$_am_arg" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \ - X"$_am_arg" : 'X\(//\)[^/]' \| \ - X"$_am_arg" : 'X\(//\)$' \| \ - X"$_am_arg" : 'X\(/\)' \| . 2>/dev/null || -$as_echo X"$_am_arg" | - sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{ - s//\1/ - q - } - /^X\(\/\/\)[^/].*/{ - s//\1/ - q - } - /^X\(\/\/\)$/{ - s//\1/ - q - } - /^X\(\/\).*/{ - s//\1/ - q - } - s/.*/./; q'`/stamp-h$_am_stamp_count - ;; - - :C) { $as_echo "$as_me:${as_lineno-$LINENO}: executing $ac_file commands" >&5 -$as_echo "$as_me: executing $ac_file commands" >&6;} - ;; - esac - - - case $ac_file$ac_mode in - "tests/atconfig":C) cat >tests/atconfig </dev/null 2>&1; then - dirpart=`$as_dirname -- "$mf" || -$as_expr X"$mf" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \ - X"$mf" : 'X\(//\)[^/]' \| \ - X"$mf" : 'X\(//\)$' \| \ - X"$mf" : 'X\(/\)' \| . 2>/dev/null || -$as_echo X"$mf" | - sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{ - s//\1/ - q - } - /^X\(\/\/\)[^/].*/{ - s//\1/ - q - } - /^X\(\/\/\)$/{ - s//\1/ - q - } - /^X\(\/\).*/{ - s//\1/ - q - } - s/.*/./; q'` - else - continue - fi - # Extract the definition of DEPDIR, am__include, and am__quote - # from the Makefile without running 'make'. - DEPDIR=`sed -n 's/^DEPDIR = //p' < "$mf"` - test -z "$DEPDIR" && continue - am__include=`sed -n 's/^am__include = //p' < "$mf"` - test -z "$am__include" && continue - am__quote=`sed -n 's/^am__quote = //p' < "$mf"` - # Find all dependency output files, they are included files with - # $(DEPDIR) in their names. We invoke sed twice because it is the - # simplest approach to changing $(DEPDIR) to its actual value in the - # expansion. - for file in `sed -n " - s/^$am__include $am__quote\(.*(DEPDIR).*\)$am__quote"'$/\1/p' <"$mf" | \ - sed -e 's/\$(DEPDIR)/'"$DEPDIR"'/g'`; do - # Make sure the directory exists. - test -f "$dirpart/$file" && continue - fdir=`$as_dirname -- "$file" || -$as_expr X"$file" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \ - X"$file" : 'X\(//\)[^/]' \| \ - X"$file" : 'X\(//\)$' \| \ - X"$file" : 'X\(/\)' \| . 2>/dev/null || -$as_echo X"$file" | - sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{ - s//\1/ - q - } - /^X\(\/\/\)[^/].*/{ - s//\1/ - q - } - /^X\(\/\/\)$/{ - s//\1/ - q - } - /^X\(\/\).*/{ - s//\1/ - q - } - s/.*/./; q'` - as_dir=$dirpart/$fdir; as_fn_mkdir_p - # echo "creating $dirpart/$file" - echo '# dummy' > "$dirpart/$file" - done - done -} - ;; - "libtool":C) - - # See if we are running on zsh, and set the options that allow our - # commands through without removal of \ escapes. - if test -n "${ZSH_VERSION+set}"; then - setopt NO_GLOB_SUBST - fi - - cfgfile=${ofile}T - trap "$RM \"$cfgfile\"; exit 1" 1 2 15 - $RM "$cfgfile" - - cat <<_LT_EOF >> "$cfgfile" -#! $SHELL -# Generated automatically by $as_me ($PACKAGE) $VERSION -# Libtool was configured on host `(hostname || uname -n) 2>/dev/null | sed 1q`: -# NOTE: Changes made to this file will be lost: look at ltmain.sh. - -# Provide generalized library-building support services. -# Written by Gordon Matzigkeit, 1996 - -# Copyright (C) 2014 Free Software Foundation, Inc. -# This is free software; see the source for copying conditions. There is NO -# warranty; not even for MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. - -# GNU Libtool is free software; you can redistribute it and/or modify -# it under the terms of the GNU General Public License as published by -# the Free Software Foundation; either version 2 of of the License, or -# (at your option) any later version. -# -# As a special exception to the GNU General Public License, if you -# distribute this file as part of a program or library that is built -# using GNU Libtool, you may include this file under the same -# distribution terms that you use for the rest of that program. -# -# GNU Libtool is distributed in the hope that it will be useful, but -# WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -# GNU General Public License for more details. -# -# You should have received a copy of the GNU General Public License -# along with this program. If not, see . - - -# The names of the tagged configurations supported by this script. -available_tags='' - -# Configured defaults for sys_lib_dlsearch_path munging. -: \${LT_SYS_LIBRARY_PATH="$configure_time_lt_sys_library_path"} - -# ### BEGIN LIBTOOL CONFIG - -# Which release of libtool.m4 was used? -macro_version=$macro_version -macro_revision=$macro_revision - -# Assembler program. -AS=$lt_AS - -# DLL creation program. -DLLTOOL=$lt_DLLTOOL - -# Object dumper program. -OBJDUMP=$lt_OBJDUMP - -# Whether or not to build shared libraries. -build_libtool_libs=$enable_shared - -# Whether or not to build static libraries. -build_old_libs=$enable_static - -# What type of objects to build. -pic_mode=$pic_mode - -# Whether or not to optimize for fast installation. -fast_install=$enable_fast_install - -# Shared archive member basename,for filename based shared library versioning on AIX. -shared_archive_member_spec=$shared_archive_member_spec - -# Shell to use when invoking shell scripts. -SHELL=$lt_SHELL - -# An echo program that protects backslashes. -ECHO=$lt_ECHO - -# The PATH separator for the build system. -PATH_SEPARATOR=$lt_PATH_SEPARATOR - -# The host system. -host_alias=$host_alias -host=$host -host_os=$host_os - -# The build system. -build_alias=$build_alias -build=$build -build_os=$build_os - -# A sed program that does not truncate output. -SED=$lt_SED - -# Sed that helps us avoid accidentally triggering echo(1) options like -n. -Xsed="\$SED -e 1s/^X//" - -# A grep program that handles long lines. -GREP=$lt_GREP - -# An ERE matcher. -EGREP=$lt_EGREP - -# A literal string matcher. -FGREP=$lt_FGREP - -# A BSD- or MS-compatible name lister. -NM=$lt_NM - -# Whether we need soft or hard links. -LN_S=$lt_LN_S - -# What is the maximum length of a command? -max_cmd_len=$max_cmd_len - -# Object file suffix (normally "o"). -objext=$ac_objext - -# Executable file suffix (normally ""). -exeext=$exeext - -# whether the shell understands "unset". -lt_unset=$lt_unset - -# turn spaces into newlines. -SP2NL=$lt_lt_SP2NL - -# turn newlines into spaces. -NL2SP=$lt_lt_NL2SP - -# convert \$build file names to \$host format. -to_host_file_cmd=$lt_cv_to_host_file_cmd - -# convert \$build files to toolchain format. -to_tool_file_cmd=$lt_cv_to_tool_file_cmd - -# Method to check whether dependent libraries are shared objects. -deplibs_check_method=$lt_deplibs_check_method - -# Command to use when deplibs_check_method = "file_magic". -file_magic_cmd=$lt_file_magic_cmd - -# How to find potential files when deplibs_check_method = "file_magic". -file_magic_glob=$lt_file_magic_glob - -# Find potential files using nocaseglob when deplibs_check_method = "file_magic". -want_nocaseglob=$lt_want_nocaseglob - -# Command to associate shared and link libraries. -sharedlib_from_linklib_cmd=$lt_sharedlib_from_linklib_cmd - -# The archiver. -AR=$lt_AR - -# Flags to create an archive. -AR_FLAGS=$lt_AR_FLAGS - -# How to feed a file listing to the archiver. -archiver_list_spec=$lt_archiver_list_spec - -# A symbol stripping program. -STRIP=$lt_STRIP - -# Commands used to install an old-style archive. -RANLIB=$lt_RANLIB -old_postinstall_cmds=$lt_old_postinstall_cmds -old_postuninstall_cmds=$lt_old_postuninstall_cmds - -# Whether to use a lock for old archive extraction. -lock_old_archive_extraction=$lock_old_archive_extraction - -# A C compiler. -LTCC=$lt_CC - -# LTCC compiler flags. -LTCFLAGS=$lt_CFLAGS - -# Take the output of nm and produce a listing of raw symbols and C names. -global_symbol_pipe=$lt_lt_cv_sys_global_symbol_pipe - -# Transform the output of nm in a proper C declaration. -global_symbol_to_cdecl=$lt_lt_cv_sys_global_symbol_to_cdecl - -# Transform the output of nm into a list of symbols to manually relocate. -global_symbol_to_import=$lt_lt_cv_sys_global_symbol_to_import - -# Transform the output of nm in a C name address pair. -global_symbol_to_c_name_address=$lt_lt_cv_sys_global_symbol_to_c_name_address - -# Transform the output of nm in a C name address pair when lib prefix is needed. -global_symbol_to_c_name_address_lib_prefix=$lt_lt_cv_sys_global_symbol_to_c_name_address_lib_prefix - -# The name lister interface. -nm_interface=$lt_lt_cv_nm_interface - -# Specify filename containing input files for \$NM. -nm_file_list_spec=$lt_nm_file_list_spec - -# The root where to search for dependent libraries,and where our libraries should be installed. -lt_sysroot=$lt_sysroot - -# Command to truncate a binary pipe. -lt_truncate_bin=$lt_lt_cv_truncate_bin - -# The name of the directory that contains temporary libtool files. -objdir=$objdir - -# Used to examine libraries when file_magic_cmd begins with "file". -MAGIC_CMD=$MAGIC_CMD - -# Must we lock files when doing compilation? -need_locks=$lt_need_locks - -# Manifest tool. -MANIFEST_TOOL=$lt_MANIFEST_TOOL - -# Tool to manipulate archived DWARF debug symbol files on Mac OS X. -DSYMUTIL=$lt_DSYMUTIL - -# Tool to change global to local symbols on Mac OS X. -NMEDIT=$lt_NMEDIT - -# Tool to manipulate fat objects and archives on Mac OS X. -LIPO=$lt_LIPO - -# ldd/readelf like tool for Mach-O binaries on Mac OS X. -OTOOL=$lt_OTOOL - -# ldd/readelf like tool for 64 bit Mach-O binaries on Mac OS X 10.4. -OTOOL64=$lt_OTOOL64 - -# Old archive suffix (normally "a"). -libext=$libext - -# Shared library suffix (normally ".so"). -shrext_cmds=$lt_shrext_cmds - -# The commands to extract the exported symbol list from a shared archive. -extract_expsyms_cmds=$lt_extract_expsyms_cmds - -# Variables whose values should be saved in libtool wrapper scripts and -# restored at link time. -variables_saved_for_relink=$lt_variables_saved_for_relink - -# Do we need the "lib" prefix for modules? -need_lib_prefix=$need_lib_prefix - -# Do we need a version for libraries? -need_version=$need_version - -# Library versioning type. -version_type=$version_type - -# Shared library runtime path variable. -runpath_var=$runpath_var - -# Shared library path variable. -shlibpath_var=$shlibpath_var - -# Is shlibpath searched before the hard-coded library search path? -shlibpath_overrides_runpath=$shlibpath_overrides_runpath - -# Format of library name prefix. -libname_spec=$lt_libname_spec - -# List of archive names. First name is the real one, the rest are links. -# The last name is the one that the linker finds with -lNAME -library_names_spec=$lt_library_names_spec - -# The coded name of the library, if different from the real name. -soname_spec=$lt_soname_spec - -# Permission mode override for installation of shared libraries. -install_override_mode=$lt_install_override_mode - -# Command to use after installation of a shared archive. -postinstall_cmds=$lt_postinstall_cmds - -# Command to use after uninstallation of a shared archive. -postuninstall_cmds=$lt_postuninstall_cmds - -# Commands used to finish a libtool library installation in a directory. -finish_cmds=$lt_finish_cmds - -# As "finish_cmds", except a single script fragment to be evaled but -# not shown. -finish_eval=$lt_finish_eval - -# Whether we should hardcode library paths into libraries. -hardcode_into_libs=$hardcode_into_libs - -# Compile-time system search path for libraries. -sys_lib_search_path_spec=$lt_sys_lib_search_path_spec - -# Detected run-time system search path for libraries. -sys_lib_dlsearch_path_spec=$lt_configure_time_dlsearch_path - -# Explicit LT_SYS_LIBRARY_PATH set during ./configure time. -configure_time_lt_sys_library_path=$lt_configure_time_lt_sys_library_path - -# Whether dlopen is supported. -dlopen_support=$enable_dlopen - -# Whether dlopen of programs is supported. -dlopen_self=$enable_dlopen_self - -# Whether dlopen of statically linked programs is supported. -dlopen_self_static=$enable_dlopen_self_static - -# Commands to strip libraries. -old_striplib=$lt_old_striplib -striplib=$lt_striplib - - -# The linker used to build libraries. -LD=$lt_LD - -# How to create reloadable object files. -reload_flag=$lt_reload_flag -reload_cmds=$lt_reload_cmds - -# Commands used to build an old-style archive. -old_archive_cmds=$lt_old_archive_cmds - -# A language specific compiler. -CC=$lt_compiler - -# Is the compiler the GNU compiler? -with_gcc=$GCC - -# Compiler flag to turn off builtin functions. -no_builtin_flag=$lt_lt_prog_compiler_no_builtin_flag - -# Additional compiler flags for building library objects. -pic_flag=$lt_lt_prog_compiler_pic - -# How to pass a linker flag through the compiler. -wl=$lt_lt_prog_compiler_wl - -# Compiler flag to prevent dynamic linking. -link_static_flag=$lt_lt_prog_compiler_static - -# Does compiler simultaneously support -c and -o options? -compiler_c_o=$lt_lt_cv_prog_compiler_c_o - -# Whether or not to add -lc for building shared libraries. -build_libtool_need_lc=$archive_cmds_need_lc - -# Whether or not to disallow shared libs when runtime libs are static. -allow_libtool_libs_with_static_runtimes=$enable_shared_with_static_runtimes - -# Compiler flag to allow reflexive dlopens. -export_dynamic_flag_spec=$lt_export_dynamic_flag_spec - -# Compiler flag to generate shared objects directly from archives. -whole_archive_flag_spec=$lt_whole_archive_flag_spec - -# Whether the compiler copes with passing no objects directly. -compiler_needs_object=$lt_compiler_needs_object - -# Create an old-style archive from a shared archive. -old_archive_from_new_cmds=$lt_old_archive_from_new_cmds - -# Create a temporary old-style archive to link instead of a shared archive. -old_archive_from_expsyms_cmds=$lt_old_archive_from_expsyms_cmds - -# Commands used to build a shared archive. -archive_cmds=$lt_archive_cmds -archive_expsym_cmds=$lt_archive_expsym_cmds - -# Commands used to build a loadable module if different from building -# a shared archive. -module_cmds=$lt_module_cmds -module_expsym_cmds=$lt_module_expsym_cmds - -# Whether we are building with GNU ld or not. -with_gnu_ld=$lt_with_gnu_ld - -# Flag that allows shared libraries with undefined symbols to be built. -allow_undefined_flag=$lt_allow_undefined_flag - -# Flag that enforces no undefined symbols. -no_undefined_flag=$lt_no_undefined_flag - -# Flag to hardcode \$libdir into a binary during linking. -# This must work even if \$libdir does not exist -hardcode_libdir_flag_spec=$lt_hardcode_libdir_flag_spec - -# Whether we need a single "-rpath" flag with a separated argument. -hardcode_libdir_separator=$lt_hardcode_libdir_separator - -# Set to "yes" if using DIR/libNAME\$shared_ext during linking hardcodes -# DIR into the resulting binary. -hardcode_direct=$hardcode_direct - -# Set to "yes" if using DIR/libNAME\$shared_ext during linking hardcodes -# DIR into the resulting binary and the resulting library dependency is -# "absolute",i.e impossible to change by setting \$shlibpath_var if the -# library is relocated. -hardcode_direct_absolute=$hardcode_direct_absolute - -# Set to "yes" if using the -LDIR flag during linking hardcodes DIR -# into the resulting binary. -hardcode_minus_L=$hardcode_minus_L - -# Set to "yes" if using SHLIBPATH_VAR=DIR during linking hardcodes DIR -# into the resulting binary. -hardcode_shlibpath_var=$hardcode_shlibpath_var - -# Set to "yes" if building a shared library automatically hardcodes DIR -# into the library and all subsequent libraries and executables linked -# against it. -hardcode_automatic=$hardcode_automatic - -# Set to yes if linker adds runtime paths of dependent libraries -# to runtime path list. -inherit_rpath=$inherit_rpath - -# Whether libtool must link a program against all its dependency libraries. -link_all_deplibs=$link_all_deplibs - -# Set to "yes" if exported symbols are required. -always_export_symbols=$always_export_symbols - -# The commands to list exported symbols. -export_symbols_cmds=$lt_export_symbols_cmds - -# Symbols that should not be listed in the preloaded symbols. -exclude_expsyms=$lt_exclude_expsyms - -# Symbols that must always be exported. -include_expsyms=$lt_include_expsyms - -# Commands necessary for linking programs (against libraries) with templates. -prelink_cmds=$lt_prelink_cmds - -# Commands necessary for finishing linking programs. -postlink_cmds=$lt_postlink_cmds - -# Specify filename containing input files. -file_list_spec=$lt_file_list_spec - -# How to hardcode a shared library path into an executable. -hardcode_action=$hardcode_action - -# ### END LIBTOOL CONFIG - -_LT_EOF - - cat <<'_LT_EOF' >> "$cfgfile" - -# ### BEGIN FUNCTIONS SHARED WITH CONFIGURE - -# func_munge_path_list VARIABLE PATH -# ----------------------------------- -# VARIABLE is name of variable containing _space_ separated list of -# directories to be munged by the contents of PATH, which is string -# having a format: -# "DIR[:DIR]:" -# string "DIR[ DIR]" will be prepended to VARIABLE -# ":DIR[:DIR]" -# string "DIR[ DIR]" will be appended to VARIABLE -# "DIRP[:DIRP]::[DIRA:]DIRA" -# string "DIRP[ DIRP]" will be prepended to VARIABLE and string -# "DIRA[ DIRA]" will be appended to VARIABLE -# "DIR[:DIR]" -# VARIABLE will be replaced by "DIR[ DIR]" -func_munge_path_list () -{ - case x$2 in - x) - ;; - *:) - eval $1=\"`$ECHO $2 | $SED 's/:/ /g'` \$$1\" - ;; - x:*) - eval $1=\"\$$1 `$ECHO $2 | $SED 's/:/ /g'`\" - ;; - *::*) - eval $1=\"\$$1\ `$ECHO $2 | $SED -e 's/.*:://' -e 's/:/ /g'`\" - eval $1=\"`$ECHO $2 | $SED -e 's/::.*//' -e 's/:/ /g'`\ \$$1\" - ;; - *) - eval $1=\"`$ECHO $2 | $SED 's/:/ /g'`\" - ;; - esac -} - - -# Calculate cc_basename. Skip known compiler wrappers and cross-prefix. -func_cc_basename () -{ - for cc_temp in $*""; do - case $cc_temp in - compile | *[\\/]compile | ccache | *[\\/]ccache ) ;; - distcc | *[\\/]distcc | purify | *[\\/]purify ) ;; - \-*) ;; - *) break;; - esac - done - func_cc_basename_result=`$ECHO "$cc_temp" | $SED "s%.*/%%; s%^$host_alias-%%"` -} - - -# ### END FUNCTIONS SHARED WITH CONFIGURE - -_LT_EOF - - case $host_os in - aix3*) - cat <<\_LT_EOF >> "$cfgfile" -# AIX sometimes has problems with the GCC collect2 program. For some -# reason, if we set the COLLECT_NAMES environment variable, the problems -# vanish in a puff of smoke. -if test set != "${COLLECT_NAMES+set}"; then - COLLECT_NAMES= - export COLLECT_NAMES -fi -_LT_EOF - ;; - esac - - -ltmain=$ac_aux_dir/ltmain.sh - - - # We use sed instead of cat because bash on DJGPP gets confused if - # if finds mixed CR/LF and LF-only lines. Since sed operates in - # text mode, it properly converts lines to CR/LF. This bash problem - # is reportedly fixed, but why not run on old versions too? - sed '$q' "$ltmain" >> "$cfgfile" \ - || (rm -f "$cfgfile"; exit 1) - - mv -f "$cfgfile" "$ofile" || - (rm -f "$ofile" && cp "$cfgfile" "$ofile" && rm -f "$cfgfile") - chmod +x "$ofile" - - ;; - "po-directories":C) - for ac_file in $CONFIG_FILES; do - # Support "outfile[:infile[:infile...]]" - case "$ac_file" in - *:*) ac_file=`echo "$ac_file"|sed 's%:.*%%'` ;; - esac - # PO directories have a Makefile.in generated from Makefile.in.in. - case "$ac_file" in */Makefile.in) - # Adjust a relative srcdir. - ac_dir=`echo "$ac_file"|sed 's%/[^/][^/]*$%%'` - ac_dir_suffix=/`echo "$ac_dir"|sed 's%^\./%%'` - ac_dots=`echo "$ac_dir_suffix"|sed 's%/[^/]*%../%g'` - # In autoconf-2.13 it is called $ac_given_srcdir. - # In autoconf-2.50 it is called $srcdir. - test -n "$ac_given_srcdir" || ac_given_srcdir="$srcdir" - case "$ac_given_srcdir" in - .) top_srcdir=`echo $ac_dots|sed 's%/$%%'` ;; - /*) top_srcdir="$ac_given_srcdir" ;; - *) top_srcdir="$ac_dots$ac_given_srcdir" ;; - esac - # Treat a directory as a PO directory if and only if it has a - # POTFILES.in file. This allows packages to have multiple PO - # directories under different names or in different locations. - if test -f "$ac_given_srcdir/$ac_dir/POTFILES.in"; then - rm -f "$ac_dir/POTFILES" - test -n "$as_me" && echo "$as_me: creating $ac_dir/POTFILES" || echo "creating $ac_dir/POTFILES" - gt_tab=`printf '\t'` - cat "$ac_given_srcdir/$ac_dir/POTFILES.in" | sed -e "/^#/d" -e "/^[ ${gt_tab}]*\$/d" -e "s,.*, $top_srcdir/& \\\\," | sed -e "\$s/\(.*\) \\\\/\1/" > "$ac_dir/POTFILES" - POMAKEFILEDEPS="POTFILES.in" - # ALL_LINGUAS, POFILES, UPDATEPOFILES, DUMMYPOFILES, GMOFILES depend - # on $ac_dir but don't depend on user-specified configuration - # parameters. - if test -f "$ac_given_srcdir/$ac_dir/LINGUAS"; then - # The LINGUAS file contains the set of available languages. - if test -n "$OBSOLETE_ALL_LINGUAS"; then - test -n "$as_me" && echo "$as_me: setting ALL_LINGUAS in configure.in is obsolete" || echo "setting ALL_LINGUAS in configure.in is obsolete" - fi - ALL_LINGUAS_=`sed -e "/^#/d" -e "s/#.*//" "$ac_given_srcdir/$ac_dir/LINGUAS"` - # Hide the ALL_LINGUAS assignment from automake < 1.5. - eval 'ALL_LINGUAS''=$ALL_LINGUAS_' - POMAKEFILEDEPS="$POMAKEFILEDEPS LINGUAS" - else - # The set of available languages was given in configure.in. - # Hide the ALL_LINGUAS assignment from automake < 1.5. - eval 'ALL_LINGUAS''=$OBSOLETE_ALL_LINGUAS' - fi - # Compute POFILES - # as $(foreach lang, $(ALL_LINGUAS), $(srcdir)/$(lang).po) - # Compute UPDATEPOFILES - # as $(foreach lang, $(ALL_LINGUAS), $(lang).po-update) - # Compute DUMMYPOFILES - # as $(foreach lang, $(ALL_LINGUAS), $(lang).nop) - # Compute GMOFILES - # as $(foreach lang, $(ALL_LINGUAS), $(srcdir)/$(lang).gmo) - case "$ac_given_srcdir" in - .) srcdirpre= ;; - *) srcdirpre='$(srcdir)/' ;; - esac - POFILES= - UPDATEPOFILES= - DUMMYPOFILES= - GMOFILES= - for lang in $ALL_LINGUAS; do - POFILES="$POFILES $srcdirpre$lang.po" - UPDATEPOFILES="$UPDATEPOFILES $lang.po-update" - DUMMYPOFILES="$DUMMYPOFILES $lang.nop" - GMOFILES="$GMOFILES $srcdirpre$lang.gmo" - done - # CATALOGS depends on both $ac_dir and the user's LINGUAS - # environment variable. - INST_LINGUAS= - if test -n "$ALL_LINGUAS"; then - for presentlang in $ALL_LINGUAS; do - useit=no - if test "%UNSET%" != "$LINGUAS"; then - desiredlanguages="$LINGUAS" - else - desiredlanguages="$ALL_LINGUAS" - fi - for desiredlang in $desiredlanguages; do - # Use the presentlang catalog if desiredlang is - # a. equal to presentlang, or - # b. a variant of presentlang (because in this case, - # presentlang can be used as a fallback for messages - # which are not translated in the desiredlang catalog). - case "$desiredlang" in - "$presentlang"*) useit=yes;; - esac - done - if test $useit = yes; then - INST_LINGUAS="$INST_LINGUAS $presentlang" - fi - done - fi - CATALOGS= - if test -n "$INST_LINGUAS"; then - for lang in $INST_LINGUAS; do - CATALOGS="$CATALOGS $lang.gmo" - done - fi - test -n "$as_me" && echo "$as_me: creating $ac_dir/Makefile" || echo "creating $ac_dir/Makefile" - sed -e "/^POTFILES =/r $ac_dir/POTFILES" -e "/^# Makevars/r $ac_given_srcdir/$ac_dir/Makevars" -e "s|@POFILES@|$POFILES|g" -e "s|@UPDATEPOFILES@|$UPDATEPOFILES|g" -e "s|@DUMMYPOFILES@|$DUMMYPOFILES|g" -e "s|@GMOFILES@|$GMOFILES|g" -e "s|@CATALOGS@|$CATALOGS|g" -e "s|@POMAKEFILEDEPS@|$POMAKEFILEDEPS|g" "$ac_dir/Makefile.in" > "$ac_dir/Makefile" - for f in "$ac_given_srcdir/$ac_dir"/Rules-*; do - if test -f "$f"; then - case "$f" in - *.orig | *.bak | *~) ;; - *) cat "$f" >> "$ac_dir/Makefile" ;; - esac - fi - done - fi - ;; - esac - done ;; - "chmod":C) chmod +x bin/cob-config; -chmod +x tests/atconfig; -chmod +x tests/atlocal ;; - - esac -done # for ac_tag - - -as_fn_exit 0 -_ACEOF -ac_clean_files=$ac_clean_files_save - -test $ac_write_fail = 0 || - as_fn_error $? "write failure creating $CONFIG_STATUS" "$LINENO" 5 - - -# configure is writing to config.log, and then calls config.status. -# config.status does its own redirection, appending to config.log. -# Unfortunately, on DOS this fails, as config.log is still kept open -# by configure, so config.status won't be able to write to it; its -# output is simply discarded. So we exec the FD to /dev/null, -# effectively closing config.log, so it can be properly (re)opened and -# appended to by config.status. When coming back to configure, we -# need to make the FD available again. -if test "$no_create" != yes; then - ac_cs_success=: - ac_config_status_args= - test "$silent" = yes && - ac_config_status_args="$ac_config_status_args --quiet" - exec 5>/dev/null - $SHELL $CONFIG_STATUS $ac_config_status_args || ac_cs_success=false - exec 5>>config.log - # Use ||, not &&, to avoid exiting from the if with $? = 1, which - # would make configure fail if this is the last instruction. - $ac_cs_success || as_fn_exit 1 -fi -if test -n "$ac_unrecognized_opts" && test "$enable_option_checking" != no; then - { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: unrecognized options: $ac_unrecognized_opts" >&5 -$as_echo "$as_me: WARNING: unrecognized options: $ac_unrecognized_opts" >&2;} -fi - - -{ $as_echo "$as_me:${as_lineno-$LINENO}: GnuCOBOL Configuration:" >&5 -$as_echo "$as_me: GnuCOBOL Configuration:" >&6;} -{ $as_echo "$as_me:${as_lineno-$LINENO}: CC ${CC}" >&5 -$as_echo "$as_me: CC ${CC}" >&6;} -{ $as_echo "$as_me:${as_lineno-$LINENO}: CFLAGS ${CFLAGS}" >&5 -$as_echo "$as_me: CFLAGS ${CFLAGS}" >&6;} -{ $as_echo "$as_me:${as_lineno-$LINENO}: LDFLAGS ${LDFLAGS}" >&5 -$as_echo "$as_me: LDFLAGS ${LDFLAGS}" >&6;} -if test "x$COBC_LIBS" != "x"; then - { $as_echo "$as_me:${as_lineno-$LINENO}: COBC_LIBS ${COBC_LIBS}" >&5 -$as_echo "$as_me: COBC_LIBS ${COBC_LIBS}" >&6;} -fi -{ $as_echo "$as_me:${as_lineno-$LINENO}: COB_CC ${COB_CC}" >&5 -$as_echo "$as_me: COB_CC ${COB_CC}" >&6;} -{ $as_echo "$as_me:${as_lineno-$LINENO}: COB_CFLAGS ${COB_CFLAGS}" >&5 -$as_echo "$as_me: COB_CFLAGS ${COB_CFLAGS}" >&6;} -{ $as_echo "$as_me:${as_lineno-$LINENO}: COB_LDFLAGS ${COB_LDFLAGS}" >&5 -$as_echo "$as_me: COB_LDFLAGS ${COB_LDFLAGS}" >&6;} -{ $as_echo "$as_me:${as_lineno-$LINENO}: COB_LIBS ${COB_LIBS}" >&5 -$as_echo "$as_me: COB_LIBS ${COB_LIBS}" >&6;} -{ $as_echo "$as_me:${as_lineno-$LINENO}: COB_CONFIG_DIR ${COB_CONFIG_DIR}" >&5 -$as_echo "$as_me: COB_CONFIG_DIR ${COB_CONFIG_DIR}" >&6;} -{ $as_echo "$as_me:${as_lineno-$LINENO}: COB_COPY_DIR ${COB_COPY_DIR}" >&5 -$as_echo "$as_me: COB_COPY_DIR ${COB_COPY_DIR}" >&6;} -{ $as_echo "$as_me:${as_lineno-$LINENO}: COB_SCHEMA_DIR ${COB_SCHEMA_DIR}" >&5 -$as_echo "$as_me: COB_SCHEMA_DIR ${COB_SCHEMA_DIR}" >&6;} -{ $as_echo "$as_me:${as_lineno-$LINENO}: COB_LIBRARY_PATH ${COB_LIBRARY_PATH}" >&5 -$as_echo "$as_me: COB_LIBRARY_PATH ${COB_LIBRARY_PATH}" >&6;} -{ $as_echo "$as_me:${as_lineno-$LINENO}: COB_OBJECT_EXT ${COB_OBJECT_EXT}" >&5 -$as_echo "$as_me: COB_OBJECT_EXT ${COB_OBJECT_EXT}" >&6;} -{ $as_echo "$as_me:${as_lineno-$LINENO}: COB_MODULE_EXT ${COB_MODULE_EXT}" >&5 -$as_echo "$as_me: COB_MODULE_EXT ${COB_MODULE_EXT}" >&6;} -{ $as_echo "$as_me:${as_lineno-$LINENO}: COB_EXE_EXT ${COB_EXE_EXT}" >&5 -$as_echo "$as_me: COB_EXE_EXT ${COB_EXE_EXT}" >&6;} -{ $as_echo "$as_me:${as_lineno-$LINENO}: COB_SHARED_OPT ${COB_SHARED_OPT}" >&5 -$as_echo "$as_me: COB_SHARED_OPT ${COB_SHARED_OPT}" >&6;} -{ $as_echo "$as_me:${as_lineno-$LINENO}: COB_PIC_FLAGS ${COB_PIC_FLAGS}" >&5 -$as_echo "$as_me: COB_PIC_FLAGS ${COB_PIC_FLAGS}" >&6;} -{ $as_echo "$as_me:${as_lineno-$LINENO}: COB_EXPORT_DYN ${COB_EXPORT_DYN}" >&5 -$as_echo "$as_me: COB_EXPORT_DYN ${COB_EXPORT_DYN}" >&6;} -if test "x$striplib" != "x"; then - { $as_echo "$as_me:${as_lineno-$LINENO}: COB_STRIP_CMD ${striplib}" >&5 -$as_echo "$as_me: COB_STRIP_CMD ${striplib}" >&6;} -fi -if test "${DEFINE_DL}" = "yes" ; then - { $as_echo "$as_me:${as_lineno-$LINENO}: Dynamic loading: System" >&5 -$as_echo "$as_me: Dynamic loading: System" >&6;} -else - { $as_echo "$as_me:${as_lineno-$LINENO}: Dynamic loading: Libtool" >&5 -$as_echo "$as_me: Dynamic loading: Libtool" >&6;} -fi -{ $as_echo "$as_me:${as_lineno-$LINENO}: Use gettext for international messages: ${USE_NLS}" >&5 -$as_echo "$as_me: Use gettext for international messages: ${USE_NLS}" >&6;} -{ $as_echo "$as_me:${as_lineno-$LINENO}: Use fcntl for file locking: ${ac_cv_func_fcntl}" >&5 -$as_echo "$as_me: Use fcntl for file locking: ${ac_cv_func_fcntl}" >&6;} -case "$USE_CURSES" in - not_found) - { $as_echo "$as_me:${as_lineno-$LINENO}: screen I/O (no curses found): NO" >&5 -$as_echo "$as_me: screen I/O (no curses found): NO" >&6;} - ;; - no) - { $as_echo "$as_me:${as_lineno-$LINENO}: screen I/O (disabled): NO" >&5 -$as_echo "$as_me: screen I/O (disabled): NO" >&6;} - ;; - *) - { $as_echo "$as_me:${as_lineno-$LINENO}: Use curses library for screen I/O: ${USE_CURSES}" >&5 -$as_echo "$as_me: Use curses library for screen I/O: ${USE_CURSES}" >&6;} - ;; -esac -if test "$with_debug_log" = "yes"; then - { $as_echo "$as_me:${as_lineno-$LINENO}: Enable GnuCOBOL developer logging yes" >&5 -$as_echo "$as_me: Enable GnuCOBOL developer logging yes" >&6;} -fi -if test "$with_seqra_extfh" = "yes"; then - { $as_echo "$as_me:${as_lineno-$LINENO}: Use external SEQ/RAN file handler: yes" >&5 -$as_echo "$as_me: Use external SEQ/RAN file handler: yes" >&6;} -fi -if test "$with_index_extfh" = "yes"; then - { $as_echo "$as_me:${as_lineno-$LINENO}: Use external ISAM file handler yes" >&5 -$as_echo "$as_me: Use external ISAM file handler yes" >&6;} -fi -if test "$with_vbisam" = "yes"; then - { $as_echo "$as_me:${as_lineno-$LINENO}: Use VBISAM for ISAM I/O yes" >&5 -$as_echo "$as_me: Use VBISAM for ISAM I/O yes" >&6;} -fi -if test "$with_disam" = "yes"; then - { $as_echo "$as_me:${as_lineno-$LINENO}: Use DISAM for ISAM I/O yes" >&5 -$as_echo "$as_me: Use DISAM for ISAM I/O yes" >&6;} -fi -if test "$with_cisam" = "yes"; then - { $as_echo "$as_me:${as_lineno-$LINENO}: Use CISAM for ISAM I/O yes" >&5 -$as_echo "$as_me: Use CISAM for ISAM I/O yes" >&6;} -fi -if test "$with_db" = "yes"; then - { $as_echo "$as_me:${as_lineno-$LINENO}: Use Berkeley DB for ISAM I/O: yes" >&5 -$as_echo "$as_me: Use Berkeley DB for ISAM I/O: yes" >&6;} -fi -if test "$with_lmdb" = "yes"; then - { $as_echo "$as_me:${as_lineno-$LINENO}: Use LMDB for ISAM I/O: yes" >&5 -$as_echo "$as_me: Use LMDB for ISAM I/O: yes" >&6;} -fi -if test "$with_odbc" = "yes"; then - { $as_echo "$as_me:${as_lineno-$LINENO}: Use ODBC for ISAM I/O: yes" >&5 -$as_echo "$as_me: Use ODBC for ISAM I/O: yes" >&6;} -fi -if test "$with_oci" = "yes"; then - { $as_echo "$as_me:${as_lineno-$LINENO}: Use Oracle DB (OCI) for ISAM I/O: yes" >&5 -$as_echo "$as_me: Use Oracle DB (OCI) for ISAM I/O: yes" >&6;} -fi - -if test "$COB_HAS_ISAM" = no; then - { $as_echo "$as_me:${as_lineno-$LINENO}: ISAM I/O (no handler configured): NO" >&5 -$as_echo "$as_me: ISAM I/O (no handler configured): NO" >&6;} -fi -{ $as_echo "$as_me:${as_lineno-$LINENO}: Use libxml2 for XML I/O: ${COB_HAS_XML2}" >&5 -$as_echo "$as_me: Use libxml2 for XML I/O: ${COB_HAS_XML2}" >&6;} -{ $as_echo "$as_me:${as_lineno-$LINENO}: Use cJSON for JSON I/O: $with_cjson" >&5 -$as_echo "$as_me: Use cJSON for JSON I/O: $with_cjson" >&6;} -unset DEFINE_DL diff -Nru gnucobol-4.0~early~20200606/configure.ac gnucobol-5/configure.ac --- gnucobol-4.0~early~20200606/configure.ac 2020-06-06 20:52:05.000000000 +0000 +++ gnucobol-5/configure.ac 1970-01-01 00:00:00.000000000 +0000 @@ -1,2138 +0,0 @@ -# -# Configure template for GnuCOBOL -# Process this file with autoconf to produce a configure script. -# -# Copyright (C) 2001-2012, 2014-2020 Free Software Foundation, Inc. -# Written by Keisuke Nishida, Roger While, Ron Norman, Simon Sobisch, -# Edward Hart -# -# This file is part of GnuCOBOL. -# -# The GnuCOBOL compiler is free software: you can redistribute it -# and/or modify it under the terms of the GNU General Public License -# as published by the Free Software Foundation, either version 3 of the -# License, or (at your option) any later version. -# -# GnuCOBOL is distributed in the hope that it will be useful, -# but WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -# GNU General Public License for more details. -# -# You should have received a copy of the GNU General Public License -# along with GnuCOBOL. If not, see . - -AC_PREREQ([2.64]) - -AC_INIT([GnuCOBOL], - [4.0-early-dev], - [bug-gnucobol@gnu.org], - [gnucobol], - [https://www.gnu.org/software/gnucobol/]) -AC_REVISION([GnuCOBOL snapshot $Revision: 2248 $]) -AC_CONFIG_SRCDIR([libcob.h]) -AC_CONFIG_HEADERS([config.h]) -AC_CONFIG_TESTDIR([tests]) -AC_CONFIG_MACRO_DIR([m4]) -AC_CONFIG_AUX_DIR([build_aux]) - -AC_CONFIG_FILES([Makefile libcob/Makefile lib/Makefile cobc/Makefile - bin/Makefile po/Makefile.in doc/Makefile config/Makefile - copy/Makefile tests/Makefile tests/cobol85/Makefile - extras/Makefile]) - -AC_CONFIG_FILES([bin/cob-config], [chmod +x bin/cob-config]) -AC_CONFIG_FILES([pre-inst-env:build_aux/pre-inst-env.in], - [chmod +x pre-inst-env]) -AC_CONFIG_FILES([tests/atlocal], [chmod +x tests/atlocal]) -AC_CONFIG_FILES([tests/run_prog_manual.sh], - [chmod +x tests/run_prog_manual.sh]) - -# Note for SUN Solaris (gcc) -# export/setenv CFLAGS "-m64 -mptr64" -# export/setenv LDFLAGS "-m64 -mptr64 -L/usr/local/lib/sparcv9" -# ./configure --libdir=/usr/local/lib/sparcv9 -# -# Hack for AIX 64 bit (gcc) -# Required - -# export/setenv CFLAGS=-maix64 -# export/setenv LDFLAGS=-maix64 - -if echo $CFLAGS | grep 'aix64' 1>/dev/null 2>&1; then - if test -f /usr/ccs/bin/ar; then - AR="/usr/ccs/bin/ar -X64" - else - AR="ar -X64" - fi - NM="/usr/ccs/bin/nm -X64 -B" -fi - -AM_INIT_AUTOMAKE([dist-xz dist-bzip2 dist-lzip gnu no-texinfo.tex]) - -# Autoheader templates -AH_TEMPLATE([COB_DEBUG_LOG], [Enable internal logging (Developers only!)]) -AH_TEMPLATE([COB_EXPERIMENTAL], [Enable experimental code (Developers only!)]) -AH_TEMPLATE([COB_TREE_DEBUG], [Enable extra checks within the compiler (Developers only!)]) -AH_TEMPLATE([COB_PARAM_CHECK], [Enable minimum parameter check for system libraries]) -AH_TEMPLATE([PATCH_LEVEL], [Define a patch level (numeric, max. 8 digits)]) -AH_TEMPLATE([MAX_CALL_FIELD_PARAMS], [Define maximum parameters for CALL]) -AH_TEMPLATE([WITH_INDEX_EXTFH], [Compile with obsolete external INDEXED handler]) -AH_TEMPLATE([WITH_INDEXED], [Default INDEXED file handler]) -AH_TEMPLATE([WITH_IXDFLT], [Default INDEXED file handler]) -AH_TEMPLATE([WITH_SEQRA_EXTFH], [Compile with obsolete external SEQ/RAN handler]) -AH_TEMPLATE([WITH_VBISAM], [Use VBISAM as INDEXED handler]) -AH_TEMPLATE([WITH_DISAM], [Use DISAM as INDEXED handler]) -AH_TEMPLATE([WITH_CISAM], [Use CISAM as INDEXED handler]) -AH_TEMPLATE([WITH_DB], [Use Berkeley DB library as INDEXED handler]) -AH_TEMPLATE([WITH_LMDB], [Use Lightning Memory-Mapped Database as INDEXED handler]) -AH_TEMPLATE([WITH_ODBC], [Use ODBC for INDEXED file handler]) -AH_TEMPLATE([WITH_OCI], [Use OCI for INDEXED file handler]) -AH_TEMPLATE([WITH_MULTI_ISAM], [Using more than 1 of C/D/VB-ISAM]) -AH_TEMPLATE([WITH_XML2], [Use libxml2 as XML handler]) -AH_TEMPLATE([WITH_CJSON], [Use cJSON as JSON handler]) - -AH_TEMPLATE([COB_EXPORT_DYN], [Compile/link option for exporting symbols]) -AH_TEMPLATE([COB_PIC_FLAGS], [Compile/link option for PIC code]) -AH_TEMPLATE([COB_SHARED_OPT], [Compile/link option for shared code]) -AH_TEMPLATE([COB_STRIP_CMD], [Strip command]) -AH_TEMPLATE([USE_LIBDL], [Use system dynamic loader]) -AH_TEMPLATE([HAVE_DLADDR], [Has dladdr function]) -AH_TEMPLATE([WITH_VARSEQ], [Define variable sequential file format]) -AH_TEMPLATE([HAVE_ATTRIBUTE_ALIGNED], [Has __attribute__((aligned))]) -AH_TEMPLATE([HAVE_TIMEZONE], [Has timezone variable]) -AH_TEMPLATE([COB_OBJECT_EXT], [Object extension]) -AH_TEMPLATE([COB_MODULE_EXT], [Module extension]) -AH_TEMPLATE([COB_EXE_EXT], [Executable extension]) -AH_TEMPLATE([COB_KEYWORD_INLINE], [Keyword for inline]) -AH_TEMPLATE([COB_NO_SELFOPEN], [Can not dlopen self]) -AH_TEMPLATE([COB_COMPUTED_GOTO], [Compilation of computed gotos works]) -AH_TEMPLATE([COB_LI_IS_LL], [long int is long long]) -AH_TEMPLATE([COB_32_BIT_LONG], [long int is 32 bits]) -AH_TEMPLATE([COB_64_BIT_POINTER], [Pointers are longer than 32 bits]) -AH_TEMPLATE([WITH_CURSES], [curses library for extended SCREEN I/O]) -AH_TEMPLATE([HAVE_COLOR_SET], [curses has color_set function]) -AH_TEMPLATE([HAVE_DEFINE_KEY], [curses has define_key function]) -AH_TEMPLATE([HAVE_MOUSEINTERVAL], [curses has mouseinterval function]) -AH_TEMPLATE([HAVE_HAS_MOUSE], [curses has has_mouse function]) -AH_TEMPLATE([HAVE_CURSES_FREEALL], [ncurses has _nc_freeall function]) -AH_TEMPLATE([HAVE_USE_LEGACY_CODING], [ncurses has use_legacy_coding function]) -AH_TEMPLATE([HAVE_DESIGNATED_INITS], [Has designated initializers]) -AH_TEMPLATE([HAVE_NANO_SLEEP], [Has nanosleep function]) -AH_TEMPLATE([HAVE_CLOCK_GETTIME], [Has clock_gettime function and CLOCK_REALTIME]) -AH_TEMPLATE([HAVE_ISFINITE], [Has isfinite function]) -AH_TEMPLATE([HAVE_MP_GET_MEMORY_FUNCTIONS], [Do we have mp_get_memory_functions in gmp]) -#AH_TEMPLATE([HAVE_RAISE], [Has raise function]) -AH_TEMPLATE([HAVE_FINITE_IEEEFP_H], - [Declaration of finite function in ieeefp.h instead of math.h]) - -# Configure options part I (not needing any compilation) - -AC_ARG_ENABLE([debug], - [AS_HELP_STRING([--enable-debug], - [(GnuCOBOL) Enable -g C compiler debug option])], - [], - [enable_debug=no]) - -AC_ARG_ENABLE([experimental], - [AS_HELP_STRING([--enable-experimental], - [(GnuCOBOL) Enable experimental code (Developers only!)])], - [if test "$enable_experimental" = "yes"; then - AC_DEFINE([COB_EXPERIMENTAL], [1]) - fi], - []) - -AC_ARG_ENABLE([cobc-internal-checks], - [AS_HELP_STRING([--enable-cobc-internal-checks], - [(GnuCOBOL) Enable extra checks within the compiler (Developers only!)])], - [if test "$enable_cobc_internal_checks" = "yes"; then - AC_DEFINE([COB_TREE_DEBUG], [1]) - fi], - []) - -AC_ARG_ENABLE([debuglog], - [AS_HELP_STRING([--enable-debuglog], - [(GnuCOBOL) Enable internal logging code (Developers only!)])], - [if test "$enable_debuglog" = "yes"; then - AC_DEFINE([COB_DEBUG_LOG], [1]) - fi], - []) - -AC_ARG_ENABLE([param-check], - [AS_HELP_STRING([--enable-param-check], - [(GnuCOBOL) Enable minimum parameter check for system libraries (default no)])], - [if test "$enable_param_check" = "yes"; then - AC_DEFINE([COB_PARAM_CHECK], [1]) - fi], - []) - -AC_ARG_WITH([patch-level], - [AS_HELP_STRING([--with-patch-level], - [(GnuCOBOL) Define a patch level (default 0), numeric, max. 8 digits])], - [case $with_patch_level in - yes) AC_MSG_ERROR([[You must give --with-patch-level an argument.]]) - ;; - no) AC_MSG_ERROR([[--without-patch-level not supported.]]) - ;; - [[0-9]]*) - if test $with_patch_level -gt 99999999; then - AC_MSG_ERROR([[Patch level must not contain more than 8 digits]]) - fi - ;; - *) AC_MSG_ERROR([[You must use a numeric patch level]]) - ;; - esac], - [with_patch_level=0]) - -AC_DEFINE_UNQUOTED([PATCH_LEVEL], [$with_patch_level]) - -AC_ARG_WITH([max-call-params], - [AS_HELP_STRING([--with-max-call-params], - [(GnuCOBOL) Define maximum number of parameters for CALL (default 192)])], - [case $with_max_call_params in - yes) AC_MSG_ERROR([[You must give --with-max-call-params an argument.]]) - ;; - no) AC_MSG_ERROR([[--without-max-call-params not supported.]]) - ;; - 16 | 36 | 56 | 76 | 96 | 192 | 252) - ;; - *) AC_MSG_ERROR([[Maximum number of parameters for CALL must be one of 16/36/56/76/96/192/252]]) - ;; - esac], - [with_max_call_params=192]) - -AC_DEFINE_UNQUOTED([MAX_CALL_FIELD_PARAMS], [$with_max_call_params]) - - -# Basic capability tests - -configured_make="" -if test -z "$MAKE"; then - AC_CHECK_PROGS([configured_make], [make gmake gnumake]) - if test -z "$configured_make"; then - AC_MSG_ERROR([make not found]) - else - MAKE=$configured_make - AC_SUBST(MAKE) - fi -else - AC_CHECK_PROG([configured_make], [$MAKE], [$MAKE]) - if test -z "$configured_make"; then - AC_MSG_ERROR([make, configured as "$MAKE", was not found]) - fi -fi - -AC_MSG_CHECKING([whether ${MAKE} supports order-only prerequisites]) -rm -f confinc.* confprereq -cat > confmf.mk << 'END' -PREREQ := confprereq -am__doit: am__prereq | $(PREREQ) - @echo target am__doit. >>confinc.out -am__prereq: - @echo target am__prereq. >>confinc.out -$(PREREQ): - @touch $(PREREQ) - @echo target $(PREREQ). >>confinc.out -.PHONY: am__doit am__prereq -END -_am_result=no - AM_RUN_LOG([${MAKE} -f confmf.mk && ${MAKE-make} -f confmf.mk && cat confinc.out]) - ## redirecting via echo to remove special chars - __am_checkme=$(echo `cat confinc.out 2>/dev/null`) - AS_CASE([$?:${__am_checkme}], - ['0:target am__prereq. target confprereq. target am__doit. target am__prereq. target am__doit.'], - [_am_result="yes"]) -rm -f confinc.* confmf.mk confprereq -AC_MSG_RESULT([${_am_result}]) -AM_CONDITIONAL([MAKE_HAS_PREREQ_ONLY], [test "${_am_result}" = "yes"]) - -save_libs="$LIBS" - -enable_cflags_setting=no -AC_MSG_CHECKING([whether CFLAGS can be modified]) -# Enable setting if the user has not specified the optimisation in CFLAGS. -echo "$CFLAGS" | grep "\-O.*\( \|$\)" 1>/dev/null 2>/dev/null -if test $? != 0; then - enable_cflags_setting=yes -fi -AC_MSG_RESULT([$enable_cflags_setting]) - -# Default CFLAGS (removed -g set in AC_INIT for compatibility) -: ${CFLAGS="-O2"} - -AC_PROG_CC([gcc xlc cc]) -AC_PROG_CC_STDC - -AC_PROG_CPP - -AC_USE_SYSTEM_EXTENSIONS - - -# general flags for compiler and linker and tests for those -AC_ARG_VAR([LIBCOB_CPPFLAGS], [see CPPFLAGS, but only applied during generation of libcob]) -if test "x$LIBCOB_CPPFLAGS" != "x"; then - AC_MSG_CHECKING([if compilation with LIBCOB_CPPFLAGS works]) - curr_cppflags="$CPPFLAGS" - CPPFLAGS="$CPPFLAGS $LIBCOB_CPPFLAGS" - AC_COMPILE_IFELSE([AC_LANG_PROGRAM([], - [[static int i = 1;]])], - [AC_MSG_RESULT([yes])], - [AC_MSG_RESULT([no]) - AC_MSG_ERROR([not possible to compile with LIBCOB_CPPFLAGS="$LIBCOB_CPPFLAGS"])]) - CPPFLAGS="$curr_cppflags" -fi - -curr_libs="$LIBS" -AC_ARG_VAR([LIBCOB_LIBS], [see LIBS, but only applied during generation of libcob]) -if test "x$LIBCOB_LIBS" != "x"; then - AC_MSG_CHECKING([if linking with LIBCOB_LIBS works]) - LIBS="$LIBS $LIBCOB_LIBS" - AC_LINK_IFELSE([AC_LANG_PROGRAM([], - [[return 0;]])], - [AC_MSG_RESULT([yes])], - [AC_MSG_RESULT([no]) - AC_MSG_ERROR([not possible to link with LIBCOB_LIBS="$LIBCOB_LIBS"])]) -fi - -AC_ARG_VAR([COBC_LIBS], [see LIBS, but only applied during generation of cobc]) -if test "x$COBC_LIBS" != "x"; then - AC_MSG_CHECKING([if linking with COBC_LIBS works]) - LIBS="$LIBS $COBC_LIBS" - AC_LINK_IFELSE([AC_LANG_PROGRAM([], - [[return 0;]])], - [AC_MSG_RESULT([yes])], - [AC_MSG_RESULT([no]) - AC_MSG_ERROR([not possible to link with COBC_LIBS="$COBC_LIBS"])]) -fi -LIBS="$curr_libs" - - -LT_INIT([dlopen win32-dll]) - -AC_PROG_EGREP -AM_PROG_CC_C_O - -AM_PROG_LEX -AC_PROG_YACC - -# only GNU Bison 3+ is supported, so drop yacc-compatibility warnings -# TODO: check for Bison 3+ here -AC_MSG_CHECKING([how to disable yacc compatibility warnings]) -case "$YACC $YFLAGS $AM_YFLAGS" in - *-Wno-yacc*) - AC_MSG_RESULT([already specified]) - ;; - *-Wyacc*) - AC_MSG_RESULT([explicit enabled]) - ;; - *) - $YACC $AM_YFLAGS $YFLAGS -Wno-yacc -V 1>/dev/null 2>&1 - if test $? -eq 0; then - AC_MSG_RESULT([-Wno-yacc]) - if test -z "$YFLAGS"; then - YFLAGS="-Wno-yacc" - else - YFLAGS="$YFLAGS -Wno-yacc" - fi - else - AC_MSG_RESULT([not supported]) - fi - ;; -esac - -AC_ARG_VAR(DIFF_FLAGS, arguments passed to diff) -AC_MSG_CHECKING([for diff arguments]) -case "$DIFF_FLAGS" in - *--strip-trailing-cr*) - AC_MSG_RESULT([specified as $DIFF_FLAGS]) - ;; - *) - diff $DIFF_FLAGS --strip-trailing-cr --version 1>/dev/null 2>&1 - if test $? -eq 0; then - if test -z "$DIFF_FLAGS"; then - DIFF_FLAGS="--strip-trailing-cr" - else - DIFF_FLAGS="$DIFF_FLAGS --strip-trailing-cr" - fi - AC_MSG_RESULT([$DIFF_FLAGS]) - else - AC_MSG_RESULT([not supported]) - fi - ;; -esac -AC_SUBST(DIFF_FLAGS) - -# Stop tests for C++ and Fortran -AC_DEFUN([AC_PROG_F77], []) -AC_DEFUN([AC_PROG_CXX], []) -AC_PROG_LN_S -AC_PROG_INSTALL - -# AC_LIBTOOL_DLOPEN -# AC_LIBTOOL_WIN32_DLL -# AC_PROG_LIBTOOL - -AC_PROG_MAKE_SET -AC_LIB_RPATH - - -# Checks for header files. -AC_HEADER_STDC -AC_CHECK_HEADERS([stdint.h sys/types.h signal.h fcntl.h malloc.h locale.h \ - stddef.h wchar.h dlfcn.h sys/time.h sys/wait.h sys/sysmacros.h]) - - -# Checks for typedefs, structures, and compiler characteristics. -AC_C_CONST -AC_C_BIGENDIAN -AC_TYPE_SIZE_T -AC_STRUCT_TM -AC_CHECK_TYPES([sig_atomic_t], [], [], [[#include ]]) - -# Don't use AC_C_INLINE here. We need the value - -AC_MSG_CHECKING([for inline keyword]) -for cob_keyw in __inline __inline__ inline -do - AC_COMPILE_IFELSE([AC_LANG_PROGRAM([[ - #ifndef __cplusplus - typedef int foo_t; - static $cob_keyw foo_t foo () { return 0; } - #endif]], [[ - #ifndef __cplusplus - return foo (); - #else - choke me - #endif]])], - [AC_DEFINE_UNQUOTED([COB_KEYWORD_INLINE], [$cob_keyw]) break], - [], - []) -done -AC_MSG_RESULT([$cob_keyw]) -unset cob_keyw - - -# Checks for library functions. -AC_FUNC_VPRINTF -AC_CHECK_FUNCS([memmove memset setlocale fcntl strerror strcasecmp \ - strchr strrchr strdup strstr atol strtol atoll strtoll gettimeofday localeconv \ - getexecname canonicalize_file_name popen raise readlink realpath \ - setenv strcoll]) - -# Check for timezone -AC_MSG_CHECKING([for timezone variable access]) -AC_COMPILE_IFELSE([AC_LANG_PROGRAM([[#include ]], - [[timezone = 3600;]])], - [AC_DEFINE([HAVE_TIMEZONE], [1]) - AC_MSG_RESULT([yes])], - [AC_MSG_RESULT([no])]) - -# Check for designated initializers -AC_MSG_CHECKING([for designated initializers]) -AC_COMPILE_IFELSE([AC_LANG_PROGRAM([[#include ]], - [[static const unsigned char valid_char[256] = { - @<:@'0'@:>@ = 1, - @<:@'1'@:>@ = 1 }; - ]])], - [AC_DEFINE([HAVE_DESIGNATED_INITS], [1]) AC_MSG_RESULT([yes])], - [AC_MSG_RESULT([no])]) - -# Check gcc/icc/clang -COB_USES_GCC="no" -COB_USES_GCC_NO_ICC="no" -COB_USES_ICC_ONLY="no" -COB_USES_CLANG_ONLY="no" -COB_USES_XLC_ONLY="no" -COB_USES_WATCOMC_ONLY="no" - -AC_MSG_CHECKING([for __GNUC__]) -AC_COMPILE_IFELSE([AC_LANG_SOURCE([[ - #ifndef __GNUC__ - # error macro not defined - #endif]])], - [COB_USES_GCC="yes" - AC_MSG_RESULT([yes])], - [AC_MSG_RESULT([no])]) - -AC_MSG_CHECKING([for __INTEL_COMPILER]) -AC_COMPILE_IFELSE([AC_LANG_SOURCE([[ - #ifndef __INTEL_COMPILER - # error macro not defined - #endif]])], - [COB_USES_ICC_ONLY=yes - AC_MSG_RESULT([yes])], - [if test "$COB_USES_GCC" = "yes"; then - COB_USES_GCC_NO_ICC="yes" - fi - AC_MSG_RESULT([no])] - ) - -AC_MSG_CHECKING([for __clang__]) -AC_COMPILE_IFELSE([AC_LANG_SOURCE([[ - #ifndef __clang__ - # error macro not defined - #endif]])], - [COB_USES_CLANG_ONLY="yes" - AC_MSG_RESULT([yes])], - [AC_MSG_RESULT([no])]) - -AC_MSG_CHECKING([for __xlc__]) -AC_COMPILE_IFELSE([AC_LANG_SOURCE([[ - #ifndef __xlc__ - # error macro not defined - #endif]])], - [COB_USES_XLC_ONLY="yes" - AC_MSG_RESULT([yes])], - [AC_MSG_RESULT([no])]) - -AC_MSG_CHECKING([for __WATCOMC__]) -AC_COMPILE_IFELSE([AC_LANG_SOURCE([[ - #ifndef __WATCOMC__ - # error macro not defined - #endif]])], - [COB_USES_WATCOMC_ONLY="yes" - AC_MSG_RESULT([yes])], - [AC_MSG_RESULT([no])]) - -if test "x$COB_CC" = "x"; then - COB_CC="$CC" -fi - -if test "$COB_USES_ICC_ONLY" = "yes"; then - LIBCOB_LIBS="-limf -lm" -else - # FIXME: -lm should only be used if needed (which it often is not), see Bug #559 - LIBCOB_LIBS="-lm" -fi - -# Add --enable-code-coverage and test for code-coverage tools if enabled -AX_CODE_COVERAGE - -if test "$COB_USES_GCC_NO_ICC" != yes -a "$enable_code_coverage" = "yes"; then - AC_MSG_ERROR([Code coverage checks are only usable with GCC!]) -fi - - -# set PKG_CONFIG to use (cross-compile aware) -PKG_PROG_PKG_CONFIG - - -# Configure options part II (needing compilation) -AC_ARG_WITH([xml2], - [AS_HELP_STRING([--with-xml2], - [(GnuCOBOL) Use libxml2 as XML handler (default)])], - [], - [with_xml2=check]) - -AS_IF([test "$with_xml2" = "yes" -o "$with_xml2" = "check"], [ - PKG_CHECK_MODULES([XML2], [libxml-2.0], [], [ - if test -z "$XML2_CFLAGS" -o -z "$XML2_LIBS"; then - AC_CHECK_PROG(xml2_config_found, xml2-config, "yes") - if test "$xml2_config_found" = "yes"; then - if test -z "$XML2_CFLAGS"; then - XML2_CFLAGS="`xml2-config --cflags`" - fi - if test -z "$XML2_LIBS"; then - XML2_LIBS="`xml2-config --libs`" - fi - fi - fi]) - curr_libs="$LIBS"; curr_cppflags="$CPPFLAGS" - if test -n "$XML2_CFLAGS"; then - CPPFLAGS="$CPPFLAGS $XML2_CFLAGS" - fi - if test -z "$XML2_LIBS"; then - XML2_LIBS="-lxml2" - fi - LIBS="$LIBS $XML2_LIBS" - AC_CHECK_HEADERS([libxml/xmlversion.h libxml/uri.h libxml/xmlwriter.h], - [AX_CHECK_DEFINE([libxml/xmlwriter.h], [LIBXML_WRITER_ENABLED], [], - [if test "$with_xml2" = "yes"; then - AC_MSG_ERROR([libxml2 is required to be configured with xmlWriter]) - else - AC_MSG_WARN([libxml2 is required to be configured with xmlWriter]) - with_xml2=no - fi]) - ], - [if test "$with_xml2" = "yes"; then - AC_MSG_ERROR([Headers for libxml2 are required for --with-xml2, you may adjust XML2_CFLAGS]) - else - with_xml2=no - fi]) - if test "$with_xml2" != "no"; then - AC_MSG_CHECKING([if linking against libxml2 with "$XML2_LIBS" works]) - AC_LINK_IFELSE([AC_LANG_PROGRAM([[#include ]], - [[xmlNewTextWriterFilename (NULL, 0);]])], - [AC_DEFINE([WITH_XML2], [1]) AC_MSG_RESULT([yes]) - with_xml2=yes - LIBCOB_CPPFLAGS="$LIBCOB_CPPFLAGS $XML2_CFLAGS" - LIBCOB_LIBS="$LIBCOB_LIBS $XML2_LIBS"], - [AC_MSG_RESULT([no]) - if test "$with_xml2" = "yes"; then - AC_MSG_ERROR([[xml library is required for --with-xml2, you may adjust XML2_LIBS]]) - else - AC_MSG_WARN([xml library not found, you may adjust XML2_LIBS]) - with_xml2=no - fi]) - else - AC_MSG_WARN([Headers for libxml2 missing, you may adjust XML2_CFLAGS]) - with_xml2=no - fi - LIBS="$curr_libs"; CPPFLAGS="$curr_cppflags" -]) - - -AC_ARG_WITH([cjson], - [AS_HELP_STRING([--with-cjson], - [(GnuCOBOL) Use cJSON as JSON handler (default)])], - [], - [with_cjson=check]) - -AS_IF([test "$with_cjson" = "yes" -o "$with_cjson" = "local" -o "$with_cjson" = "check"], [ - AC_MSG_NOTICE([Checks for local cJSON ...]) - curr_libs="$LIBS"; curr_cppflags="$CPPFLAGS" - with_cjson_local=no - AC_CHECK_FILE([./libcob/cJSON.c], - [AC_MSG_CHECKING([if linking of ./libcob/cJSON.c works]) - CPPFLAGS="$curr_cppflags -I./libcob" - AC_LINK_IFELSE([AC_LANG_PROGRAM([[#include "cJSON.c"]], - [[cJSON_CreateNull ();]])], - [AC_MSG_RESULT([yes]) - with_cjson_local="yes (in ./libcob)"], - [AC_MSG_RESULT([no])] - )] - ) - if test "$with_cjson_local" = "no"; then - AC_CHECK_FILE([$srcdir/libcob/cJSON.c], - [AC_MSG_CHECKING([if linking of $srcdir/libcob/cJSON.c works]) - CPPFLAGS="$curr_cppflags -I$srcdir/libcob" - AC_LINK_IFELSE([AC_LANG_PROGRAM([[#include "cJSON.c"]], - [[cJSON_CreateNull ();]])], - [AC_MSG_RESULT([yes]) - with_cjson_local="yes (in $srcdir/libcob)"], - [AC_MSG_RESULT([no])] - )] - ) - fi - CPPFLAGS="$curr_cppflags" - if test "$with_cjson_local" = "no"; then - AC_MSG_NOTICE([using local cJSON: no]) - if test "$with_cjson" = "local"; then - AC_MSG_ERROR([[cJSON source is required in directory "libcob" for --with-cjson=local]]) - fi - PKG_CHECK_MODULES([CJSON], [libcjson], [], [#]) - if test -n "$CJSON_CFLAGS"; then - CPPFLAGS="$CPPFLAGS $CJSON_CFLAGS" - fi - if test -z "$CJSON_LIBS"; then - CJSON_LIBS="-lcjson" - fi - LIBS="$LIBS $CJSON_LIBS" - AC_CHECK_HEADERS([cJSON.h], [], - [AC_CHECK_HEADERS([cjson/cJSON.h], [], - [if test "$with_cjson" = "yes"; then - AC_MSG_ERROR([Headers for libcjson are required for --with-cjson, you may adjust CJSON_CFLAGS]) - else - AC_MSG_WARN([Headers for libcjson missing, you may adjust CJSON_CFLAGS or put cJSON sources in "libcob"]) - with_cjson=no - fi] - )]) - if test "$with_cjson" != "no"; then - AC_MSG_CHECKING([if linking against libcjson with "$CJSON_LIBS" works]) - AC_LINK_IFELSE([AC_LANG_PROGRAM([ - [#if defined HAVE_CJSON_CJSON_H - #include - #elif defined HAVE_CJSON_H - #include - #endif]], - [[cJSON_CreateNull ();]])], - [AC_DEFINE([WITH_CJSON], [1]) AC_MSG_RESULT([yes]) - with_cjson=yes - LIBCOB_CPPFLAGS="$LIBCOB_CPPFLAGS $CJSON_CFLAGS" - LIBCOB_LIBS="$LIBCOB_LIBS $CJSON_LIBS"], - [AC_MSG_RESULT([no]) - if test "$with_cjson" = "yes"; then - AC_MSG_ERROR([[cJSON library is required for --with-cjson, you may adjust CJSON_LIBS]]) - else - AC_MSG_WARN([xml library not found, you may adjust CJSON_LIBS]) - with_cjson=no - fi]) - fi - else - AC_MSG_NOTICE([using local cJSON: $with_cjson_local]) - with_cjson="local" - AC_DEFINE([WITH_CJSON], [1]) - AC_DEFINE([HAVE_CJSON_H], [1]) - fi - LIBS="$curr_libs"; CPPFLAGS="$curr_cppflags" -]) - - -AC_ARG_WITH([dl], - [AS_HELP_STRING([--with-dl], - [(GnuCOBOL) Use system dynamic loader (default)])], - [case $with_dl in - yes) - ;; - no) - ;; - *) AC_MSG_ERROR([[--with/without-dl can not have a value]]) - ;; - esac], - [with_dl=yes]) - -AC_ARG_WITH([varseq], - [AS_HELP_STRING([--with-varseq], - [(GnuCOBOL) Define variable sequential format (default 0)])], - [case $with_varseq in - yes) AC_MSG_ERROR([[You must give --with-varseq an argument.]]) - ;; - no) AC_MSG_ERROR([[--without-varseq not supported.]]) - ;; - [[0-3]]) - ;; - *) AC_MSG_ERROR([[Invalid --with-varseq argument]]) - ;; - esac], - [with_varseq=0]) - -AC_DEFINE_UNQUOTED([WITH_VARSEQ], [$with_varseq]) - - -# Checks for gmp. -AC_MSG_NOTICE([Checks for GMP ...]) -AC_CHECK_HEADERS([gmp.h], [], AC_MSG_ERROR([gmp.h (GMP) is required]), []) - -AC_CHECK_LIB([gmp], [__gmpz_init], - [LIBCOB_LIBS="$LIBCOB_LIBS -lgmp"], - AC_MSG_ERROR([GMP library is required]), []) - -# Check just major/minor levels between header and library -# get GMP version from header -AC_RUN_IFELSE([AC_LANG_SOURCE([[ - #include - #include - int main (int argc, char **argv) - { - (void)argv; - if (argc > 1) - printf ("%d.%d", __GNU_MP_VERSION, __GNU_MP_VERSION_MINOR); - return 0; - } - ]])], - [COB_GMP_HEADER=`./conftest$ac_exeext x`], - [AC_MSG_ERROR([Unable to extract GMP version information from gmp.h])], - [AC_MSG_WARN([cannot run test program while cross-compiling]) - COB_GMP_HEADER="cross-compilation - assumed"]) -if test "x$COB_GMP_HEADER" = "x"; then - AC_MSG_ERROR([Unable to extract GMP version information (header)]) -fi - -MYOLDLIBS=$LIBS -LIBS="$MYOLDLIBS -lgmp" -# get GMP version from lib -AC_RUN_IFELSE([AC_LANG_SOURCE([[ - #include - #ifdef _WIN32 - #ifndef __GMP_LIBGMP_DLL - #define __GMP_LIBGMP_DLL 1 - #endif - #endif - #include - int main (int argc, char **argv) - { - (void)argv; - if (argc > 1) - printf ("%s", gmp_version); - return 0; - } - ]])], - [COB_GMP_LIB=`./conftest$ac_exeext x`], - [AC_MSG_ERROR([Unable to extract GMP version information from gmp_version])], - [AC_MSG_WARN([matching GMP version assumed])] - COB_GMP_LIB="cross") -if test "x$COB_GMP_LIB" = "x"; then - AC_MSG_ERROR([Unable to extract GMP version information (library)]) -fi - -AC_MSG_CHECKING([matching GMP version]) -COB_GMP_LIB_MAJOR=$(echo "$COB_GMP_LIB" | cut -d. -f1) -COB_GMP_LIB_MINOR=$(echo "$COB_GMP_LIB" | cut -d. -f2) - -if test "$COB_GMP_HEADER" = "$COB_GMP_LIB_MAJOR.$COB_GMP_LIB_MINOR" -o "$COB_GMP_LIB" = "cross"; then - AC_MSG_RESULT([yes ($COB_GMP_HEADER)]) -else - AC_MSG_RESULT([no (header: $COB_GMP_HEADER / library: $COB_GMP_LIB)]) - AC_MSG_ERROR([Unable to use GMP - Please check config.log]) -fi -LIBS=$MYOLDLIBS - - -# Works fine as an alternative if necessary -# AC_SEARCH_LIBS([__gmp_get_memory_functions], [gmp], [AC_DEFINE([HAVE_MP_GET_MEMORY_FUNCTIONS], [1])], [], []) -AC_CHECK_LIB([gmp], [__gmp_get_memory_functions], [AC_DEFINE([HAVE_MP_GET_MEMORY_FUNCTIONS], [1])], [], []) - - -# Solaris has nanosleep in other libraries -AC_MSG_CHECKING([for nanosleep]) -AC_LINK_IFELSE([AC_LANG_PROGRAM([[#include ]], - [[nanosleep (NULL, NULL);]])], - [AC_DEFINE([HAVE_NANO_SLEEP], [1]) AC_MSG_RESULT([yes])], - [AC_CHECK_LIB([rt], [nanosleep], [], [], []) - if test "x$ac_cv_lib_rt_nanosleep" = "xyes"; then - AC_DEFINE([HAVE_NANO_SLEEP], [1]) - AC_MSG_RESULT([yes]) - LIBCOB_LIBS="$LIBCOB_LIBS -lrt" - else - AC_CHECK_LIB([posix4], [nanosleep], [], [], []) - if test "x$ac_cv_lib_posix4_nanosleep" = "xyes"; then - AC_DEFINE([HAVE_NANO_SLEEP], [1]) - AC_MSG_RESULT([yes]) - LIBCOB_LIBS="$LIBCOB_LIBS -lposix4" - else - AC_MSG_RESULT([no]) - fi - fi]) - -AC_MSG_CHECKING([for clock_gettime and CLOCK_REALTIME]) -AC_LINK_IFELSE([AC_LANG_PROGRAM([[#include ]], - [[clock_gettime (CLOCK_REALTIME, NULL);]])], - [AC_DEFINE([HAVE_CLOCK_GETTIME], [1]) AC_MSG_RESULT([yes])], - [AC_MSG_RESULT([no])]) - -AC_MSG_CHECKING([for isfinite]) -AC_LINK_IFELSE([AC_LANG_PROGRAM([[#include ]], - [[isfinite ( 1.0 );]])], - [AC_DEFINE([HAVE_ISFINITE], [1]) AC_MSG_RESULT([yes])], - [AC_MSG_RESULT([no])] - # Check prototype for finite in math.h (alternative ieeefp.h) - AC_MSG_CHECKING([prototype for finite in ]) - AC_EGREP_HEADER(finite, math.h, AC_MSG_RESULT([yes]), - [AC_MSG_RESULT([no]) - AC_MSG_CHECKING([prototype for finite in ]) - AC_EGREP_HEADER(finite, ieeefp.h, - [AC_DEFINE([HAVE_FINITE_IEEEFP_H], [1]) AC_MSG_RESULT([yes])], - AC_MSG_ERROR([ - Declaration for finite function neither in math.h nor in ieeefp.h])) - ]) -) - -# Check for raise (optional) --> done via AC_CHECK_FUNCS -#AC_MSG_CHECKING([for raise]) -#AC_LINK_IFELSE([AC_LANG_PROGRAM([[#include ]], -# [[raise (SIGINT);]])], -# [AC_DEFINE([HAVE_RAISE], [1]) AC_MSG_RESULT([yes])], -# [AC_MSG_RESULT([no])], -# []) - -AC_CHECK_FUNCS([fdatasync sigaction]) - -# Checks for gettext. - -case $host_os in - darwin* | rhapsody*) - ;; - *) - gt_cv_func_CFPreferencesCopyAppValue=no - gt_cv_func_CFLocaleCopyCurrent=no - ;; -esac - -# Simon: removed, use --disable-nls instead -## Disable for Cygwin -#AC_MSG_CHECKING([for __CYGWIN__]) -#AC_COMPILE_IFELSE([AC_LANG_SOURCE([[ -# #ifndef __CYGWIN__ -# # error macro not defined -# #endif]])], -# [enable_nls=no -# AC_MSG_RESULT([yes])], -# [AC_MSG_RESULT([no])]) - -AM_GNU_GETTEXT([external]) -AM_GNU_GETTEXT_VERSION([0.19.8]) -if test "x$LTLIBINTL" != "x"; then - COBC_LIBS="$COBC_LIBS $LTLIBINTL" - LIBCOB_LIBS="$LIBCOB_LIBS $LTLIBINTL" -fi - -# Checks for internationalization stuff -# AM_ICONV -AM_LANGINFO_CODESET - -# Checks for ncurses/pdcurses/curses. -AC_MSG_NOTICE([Checks for curses ...]) - -AC_ARG_WITH([curses], - [AS_HELP_STRING([[--with-curses[=ARG]]], - [(GnuCOBOL) Use curses library for extended SCREEN I/O, where ARG may be: - check (default), ncursesw, ncurses, pdcurses, curses, no])], - [case "$with_curses" in - ncursesw | ncurses | pdcurses | curses | check | no) - USE_CURSES="$with_curses" - ;; - yes) - USE_CURSES="check" - ;; - *) - AC_MSG_ERROR([invalid value "$with_curses" for --with-curses, - must be one of the following: - ncursesw, ncurses, pdcurses, curses (use only the specified library) - check (use whatever curses library is usable, disable if no one usable) - no (disable curses usage)]) - ;; - esac], - [USE_CURSES="check"]) - -if test "$USE_CURSES" = "ncursesw" -o "$USE_CURSES" = "check"; then - AC_CHECK_LIB([ncursesw], [initscr], [], [], []) - if test "x$ac_cv_lib_ncursesw_initscr" = "xyes"; then - AC_CHECK_HEADERS([ncursesw/ncurses.h], [USE_CURSES="ncursesw"], - [AC_CHECK_HEADERS([ncursesw/curses.h], [USE_CURSES="ncursesw"], - [if test "$USE_CURSES" = "ncursesw"; then - USE_CURSES="missing_header" - fi], [])], []) - if test "$USE_CURSES" = "ncursesw"; then - LIBCOB_LIBS="$LIBCOB_LIBS -lncursesw" - fi - else - if test "$USE_CURSES" = "ncursesw"; then - USE_CURSES="missing_lib" - fi - fi -fi - -if test "$USE_CURSES" = "ncurses" -o "$USE_CURSES" = "check"; then - AC_CHECK_LIB([ncurses], [initscr], [], [], []) - if test "x$ac_cv_lib_ncurses_initscr" = "xyes"; then - AC_CHECK_HEADERS([ncurses.h], [USE_CURSES="ncurses"], - [AC_CHECK_HEADERS([ncurses/ncurses.h], [USE_CURSES="ncurses"], - [AC_CHECK_HEADERS([curses.h], [USE_CURSES="ncurses"], - [if test "$USE_CURSES" = "ncurses"; then - USE_CURSES="missing_header" - fi], [])], [])], []) - if test "$USE_CURSES" = "ncurses"; then - LIBCOB_LIBS="$LIBCOB_LIBS -lncurses" - fi - else - if test "$USE_CURSES" = "ncurses"; then - USE_CURSES="missing_lib" - fi - fi -fi - - -if test "$USE_CURSES" = "pdcurses" -o "$USE_CURSES" = "check"; then - AC_CHECK_LIB([pdcurses], [initscr], [], [], []) - if test "x$ac_cv_lib_pdcurses_initscr" = "xyes"; then - AC_CHECK_HEADERS([pdcurses.h], [USE_CURSES="pdcurses"], - [AC_CHECK_HEADERS([curses.h], [USE_CURSES="pdcurses"], - [if test "$USE_CURSES" = "pdcurses"; then - USE_CURSES="missing_header" - fi], [])], []) - if test "$USE_CURSES" = "pdcurses"; then - LIBCOB_LIBS="$LIBCOB_LIBS -lpdcurses" - fi - else - if test "$USE_CURSES" = "pdcurses"; then - USE_CURSES="missing_lib" - fi - fi -fi - -if test "$USE_CURSES" = "curses" -o "$USE_CURSES" = "check"; then - AC_CHECK_LIB([curses], [initscr], [], [], []) - if test "x$ac_cv_lib_curses_initscr" = "xyes"; then - AC_CHECK_HEADERS([curses.h], [USE_CURSES="curses"], - [if test "$USE_CURSES" = "curses"; then - USE_CURSES="missing_header" - fi], []) - if test "$USE_CURSES" != "no"; then - LIBCOB_LIBS="$LIBCOB_LIBS -lcurses" - fi - fi -else - if test "$USE_CURSES" = "curses"; then - USE_CURSES="missing_lib" - fi -fi - -case "$USE_CURSES" in - check) - USE_CURSES="not_found" - AC_DEFINE([WITH_CURSES], ["no curses found"]) - ;; - no) - AC_DEFINE([WITH_CURSES], ["disabled"]) - ;; - missing_lib) - AC_MSG_ERROR([[Not able to link configured library $with_curses]]) - ;; - missing_header) - AC_MSG_ERROR([[No header found for configured library $with_curses]]) - ;; - ncursesw) - AC_DEFINE([WITH_CURSES], ["ncursesw"]) - ;; - ncurses) - AC_DEFINE([WITH_CURSES], ["ncurses"]) - ;; - pdcurses) - AC_DEFINE([WITH_CURSES], ["pdcurses"]) - ;; - curses) - AC_DEFINE([WITH_CURSES], ["curses"]) - ;; -esac - - -if test "$USE_CURSES" = "ncurses" -o "$USE_CURSES" = "ncursesw"; then - AC_MSG_CHECKING([for ncurses _nc_freeall function]) - AC_LINK_IFELSE([AC_LANG_PROGRAM([[ - extern void _nc_freeall (void);]], - [[_nc_freeall ();]])], - [AC_DEFINE([HAVE_CURSES_FREEALL], [1]) AC_MSG_RESULT([yes])], - [AC_MSG_RESULT([no])], - []) - AC_MSG_CHECKING([for ncurses use_legacy_coding function]) - AC_LINK_IFELSE([AC_LANG_PROGRAM([[ - extern void use_legacy_coding (void);]], - [[use_legacy_coding ();]])], - [AC_DEFINE([HAVE_USE_LEGACY_CODING], [1]) AC_MSG_RESULT([yes])], - [AC_MSG_RESULT([no])], - []) -fi - -if test "$USE_CURSES" != "no" -a "$USE_CURSES" != "not_found"; then - AC_MSG_CHECKING([for curses color_set function]) - AC_LINK_IFELSE([AC_LANG_PROGRAM([[ - #ifdef HAVE_NCURSESW_NCURSES_H - #include - #elif defined (HAVE_NCURSESW_CURSES_H) - #include - #elif defined (HAVE_NCURSES_H) - #include - #elif defined (HAVE_NCURSES_NCURSES_H) - #include - #elif defined (HAVE_PDCURSES_H) - #include - #elif defined (HAVE_CURSES_H) - #include - #endif]], [[ - color_set (0, NULL); - ]])], - [AC_DEFINE([HAVE_COLOR_SET], [1]) AC_MSG_RESULT([yes])], - [AC_MSG_RESULT([no])], - []) - - AC_MSG_CHECKING([for curses define_key function]) - AC_LINK_IFELSE([AC_LANG_PROGRAM([[ - #ifdef HAVE_NCURSESW_NCURSES_H - #include - #elif defined (HAVE_NCURSESW_CURSES_H) - #include - #elif defined (HAVE_NCURSES_H) - #include - #elif defined (HAVE_NCURSES_NCURSES_H) - #include - #elif defined (HAVE_PDCURSES_H) - #include - #elif defined (HAVE_CURSES_H) - #include - #endif]], [[ - define_key ("\E-3;3~", (KEY_MAX + 1)); - ]])], - [AC_DEFINE([HAVE_DEFINE_KEY], [1]) AC_MSG_RESULT([yes])], - [AC_MSG_RESULT([no])], - []) - - AC_MSG_CHECKING([for curses mouseinterval function]) - AC_LINK_IFELSE([AC_LANG_PROGRAM([[ - #ifdef HAVE_NCURSESW_NCURSES_H - #include - #elif defined (HAVE_NCURSESW_CURSES_H) - #include - #elif defined (HAVE_NCURSES_H) - #include - #elif defined (HAVE_NCURSES_NCURSES_H) - #include - #elif defined (HAVE_PDCURSES_H) - #include - #elif defined (HAVE_CURSES_H) - #include - #endif]], [[ - mouseinterval (-1); - ]])], - [AC_DEFINE([HAVE_MOUSEINTERVAL], [1]) AC_MSG_RESULT([yes])], - [AC_MSG_RESULT([no])], - []) - - AC_MSG_CHECKING([for curses has_mouse function]) - AC_LINK_IFELSE([AC_LANG_PROGRAM([[ - #ifdef HAVE_NCURSESW_NCURSES_H - #include - #elif defined (HAVE_NCURSESW_CURSES_H) - #include - #elif defined (HAVE_NCURSES_H) - #include - #elif defined (HAVE_NCURSES_NCURSES_H) - #include - #elif defined (HAVE_PDCURSES_H) - #include - #elif defined (HAVE_CURSES_H) - #include - #endif]], [[ - has_mouse (); - ]])], - [AC_DEFINE([HAVE_HAS_MOUSE], [1]) AC_MSG_RESULT([yes])], - [AC_MSG_RESULT([no])], - []) -fi - -AC_ARG_WITH([seqra-extfh], - [AS_HELP_STRING([--with-seqra-extfh], - [(GnuCOBOL) Use external SEQ/RAN handler (obsolete)])], - [ if test "$with_seqra_extfh" = "yes"; then - AC_DEFINE([WITH_SEQRA_EXTFH], [1]) - fi ], - []) - -AC_ARG_WITH([indexed], - [AS_HELP_STRING([--with-indexed], - [Define default INDEXED file handler])], - [ case "$with_indexed" in - vbisam) - with_vbisam=yes - AC_DEFINE([WITH_INDEXED], [COB_IO_VBISAM]) - AC_DEFINE([WITH_IXDFLT], ["VB-ISAM"]);; - disam) - with_disam=yes - AC_DEFINE([WITH_INDEXED], [COB_IO_DISAM]) - AC_DEFINE([WITH_IXDFLT], ["D-ISAM"]);; - cisam) - with_cisam=yes - AC_DEFINE([WITH_INDEXED], [COB_IO_CISAM]) - AC_DEFINE([WITH_IXDFLT], ["C-ISAM"]);; - db) - with_db=yes - AC_DEFINE([WITH_INDEXED], [COB_IO_BDB]) - AC_DEFINE([WITH_IXDFLT], ["BDB"]);; - lmdb) - with_lmdb=yes - AC_DEFINE([WITH_INDEXED], [COB_IO_LMDB]) - AC_DEFINE([WITH_IXDFLT], ["LMDB"]);; - odbc) - with_odbc=yes - AC_DEFINE([WITH_INDEXED], [COB_IO_ODBC]) - AC_DEFINE([WITH_IXDFLT], ["ODBC"]);; - oci) - with_oci=yes - AC_DEFINE([WITH_INDEXED], [COB_IO_OCI]) - AC_DEFINE([WITH_IXDFLT], ["OCI"]);; - *) - if test "$with_vbisam" = "yes"; then - AC_DEFINE([WITH_INDEXED], [COB_IO_VBISAM]) - AC_DEFINE([WITH_IXDFLT], ["VB-ISAM"]) - elif test "$with_disam" = "yes"; then - AC_DEFINE([WITH_INDEXED], [COB_IO_DISAM]) - AC_DEFINE([WITH_IXDFLT], ["D-ISAM"]) - elif test "$with_cisam" = "yes"; then - AC_DEFINE([WITH_INDEXED], [COB_IO_CISAM]) - AC_DEFINE([WITH_IXDFLT], ["C-ISAM"]) - elif test "$with_db" = "yes"; then - AC_DEFINE([WITH_INDEXED], [COB_IO_BDB]) - AC_DEFINE([WITH_IXDFLT], ["BDB"]) - elif test "$with_lmdb" = "yes"; then - AC_DEFINE([WITH_INDEXED], [COB_IO_LMDB]) - AC_DEFINE([WITH_IXDFLT], ["LMDB"]) - elif test "$with_odbc" = "yes"; then - AC_DEFINE([WITH_ODBC], [COB_IO_ODBC]) - AC_DEFINE([WITH_IXDFLT], ["ODBC"]) - elif test "$with_oci" = "yes"; then - AC_DEFINE([WITH_OCI], [COB_IO_OCI]) - AC_DEFINE([WITH_IXDFLT], ["OCI"]) - else - AC_MSG_ERROR([--with-indexed=, must be one of vbisam|disam|cisam|db|lmdb|odbc|oci]) - fi ;; - esac - ], [ - if test "$with_vbisam" = "yes"; then - AC_DEFINE([WITH_INDEXED], [COB_IO_VBISAM]) - AC_DEFINE([WITH_IXDFLT], ["VB-ISAM"]) - elif test "$with_disam" = "yes"; then - AC_DEFINE([WITH_INDEXED], [COB_IO_DISAM]) - AC_DEFINE([WITH_IXDFLT], ["D-ISAM"]) - elif test "$with_cisam" = "yes"; then - AC_DEFINE([WITH_INDEXED], [COB_IO_CISAM]) - AC_DEFINE([WITH_IXDFLT], ["C-ISAM"]) - elif test "$with_db" = "yes"; then - AC_DEFINE([WITH_INDEXED], [COB_IO_BDB]) - AC_DEFINE([WITH_IXDFLT], ["BDB"]) - elif test "$with_lmdb" = "yes"; then - AC_DEFINE([WITH_INDEXED], [COB_IO_LMDB]) - AC_DEFINE([WITH_IXDFLT], ["LMDB"]) - elif test "$with_odbc" = "yes"; then - AC_DEFINE([WITH_INDEXED], [COB_IO_ODBC]) - AC_DEFINE([WITH_IXDFLT], ["ODBC"]) - elif test "$with_oci" = "yes"; then - AC_DEFINE([WITH_INDEXED], [COB_IO_OCI]) - AC_DEFINE([WITH_IXDFLT], ["OCI"]) - fi - ]) - -LIBCOB_ISAM="" -LIBCOB_VBISAM="" -LIBCOB_DISAM="" -LIBCOB_CISAM="" -cob_multi_isam=no -cob_gen_vbisam=no -cob_gen_disam=no -cob_gen_cisam=no - - AC_ARG_WITH([vbisam], - [AS_HELP_STRING([--with-vbisam], - [(GnuCOBOL) Use VBISAM for ISAM I/O])], - [ if test "$with_vbisam" = "yes"; then - AC_CHECK_HEADERS([vbisam.h], [], - AC_MSG_ERROR([vbisam.h is required for VBISAM])) - # note: isfullclose is available since 2.0, isopen since 1.0 - AC_CHECK_LIB([vbisam], [isfullclose], - [AC_DEFINE([WITH_VBISAM], [1]) - LIBCOB_ISAM="$LIBCOB_ISAM -lvbisam" - LIBCOB_VBISAM="-lvbisam"], - AC_MSG_ERROR([libvbisam >= 2.0 is required for VBISAM]), []) - if test "$with_cisam" = "yes" -o "$with_disam" = "yes"; then - cob_multi_isam=yes - fi - cob_gen_vbisam=yes - fi ], - []) - - AC_ARG_WITH([disam], - [AS_HELP_STRING([--with-disam], - [(GnuCOBOL) Use DISAM for ISAM I/O])], - [ if test "$with_disam" = "yes"; then - AC_CHECK_HEADERS([disam.h], [], - AC_MSG_ERROR([disam.h is required for DISAM])) - - for cobdisam in disam disam8 disam72 disam71 disam7 - do - AC_CHECK_LIB([$cobdisam], [isopen], - [AC_DEFINE([WITH_DISAM], [1]) - LIBCOB_ISAM="$LIBCOB_ISAM -l$cobdisam" - LIBCOB_DISAM="-l$cobdisam"] - cob_got_disam=yes - break, - [], []) - done - if test "$cob_got_disam" = "yes"; then - AC_MSG_NOTICE([DISAM library found as -l$cobdisam]) - else - AC_MSG_ERROR([DISAM library not found]) - fi - if test "$with_cisam" = "yes"; then - cob_multi_isam=yes - fi - cob_gen_disam=yes - unset cobdisam - unset cob_got_disam - fi ], - []) - - AC_ARG_WITH([cisam], - [AS_HELP_STRING([--with-cisam], - [(GnuCOBOL) Use CISAM for ISAM I/O])], - [ if test "$with_cisam" = "yes"; then - cob_gen_cisam=yes - AC_CHECK_HEADERS([isam.h], [], - AC_MSG_ERROR([isam.h is required for CISAM])) - AC_CHECK_LIB([ifisam], [isopen], - [AC_DEFINE([WITH_CISAM], [1]) - LIBCOB_ISAM="$LIBCOB_ISAM -lifisam -lifisamx" - LIBCOB_CISAM="-lifisam -lifisamx"], - AC_MSG_ERROR([libifisam is required for CISAM]), [-lifisamx]) - fi ], - []) - -if test "$cob_multi_isam" = "no"; then - LIBCOB_LIBS="$LIBCOB_LIBS $LIBCOB_ISAM" - LIBCOB_VBISAM="" - LIBCOB_DISAM="" - LIBCOB_CISAM="" -else - AC_DEFINE([WITH_MULTI_ISAM], [1]) -fi - -AC_ARG_WITH([index-extfh], -[AS_HELP_STRING([--with-index-extfh], - [(GnuCOBOL) Use external ISAM handler (obsolete)])], -[ if test "$with_index_extfh" = "yes"; then - AC_DEFINE([WITH_INDEX_EXTFH], [1]) - fi ], -[]) - -AC_ARG_WITH([odbc], -[AS_HELP_STRING([--with-odbc], - [(GnuCOBOL) Use ODBC for INDEXED I/O])], -[ if test "$with_odbc" = "yes"; then - PKG_CHECK_MODULES([ODBC], [odbc], [], [#]) - - if test -n "$ODBC_CFLAGS"; then - CPPFLAGS="$CPPFLAGS $ODBC_CFLAGS" - fi - AC_CHECK_HEADERS([sql.h sqlext.h], [], - AC_MSG_ERROR([sql.h and sqlext.h are required for ODBC])) -# later on: also allow DB2 (possibly similar to xISAM) -# AC_CHECK_HEADERS([sqlcli1.h sqlca.h sqludf.h], [], -# AC_MSG_ERROR([sqlcli1.h, sqlca.h, and sqludf.h are required for ODBC (DB2)])) - - if test -n "$ODBC_LIBS"; then - LIBS="$LIBS $ODBC_LIBS" - fi - AC_CHECK_LIB([odbc], [SQLConnect], - [AC_DEFINE([WITH_ODBC], [1]) - LIBCOB_LIBS="$LIBCOB_LIBS $ODBC_LIBS -lodbc" - ], - AC_MSG_ERROR([libodbc is required for ODBC]), []) - fi ], -[]) - -AC_ARG_WITH([oci], -[AS_HELP_STRING([--with-oci], - [(GnuCOBOL) Use Oracle OCI for INDEXED I/O])], -[ if test "$with_oci" = "yes"; then - if test -n "$OCI_CFLAGS"; then - CPPFLAGS="$CPPFLAGS $OCI_CFLAGS" - elif test -n "$ORACLE_HOME"; then - CPPFLAGS="$CPPFLAGS -I${ORACLE_HOME}/rdbms/public" - fi - AC_CHECK_HEADERS([oci.h], [], - AC_MSG_ERROR([oci.h is required for Oracle OCI])) - - if test -n "$OCI_LIBS"; then - LIBS="$LIBS $OCI_LIBS" - elif test -n "$ORACLE_HOME"; then - OCI_LIBS="-L${ORACLE_HOME}/lib" - LIBS="$LIBS $OCI_LIBS" - fi - AC_CHECK_LIB([clntsh], [OCIEnvCreate], - [AC_DEFINE([WITH_OCI], [1]) - LIBCOB_LIBS="$LIBCOB_LIBS $OCI_LIBS -lclntsh" - ], - AC_MSG_ERROR([libclnt is required for Oracle OCI]), []) - fi ], -[]) - -AC_ARG_WITH([db], -[AS_HELP_STRING([--with-db], - [(GnuCOBOL) Use Berkeley DB >= 4.1 for ISAM I/O (default)])], -[], -[]) - -AC_ARG_WITH([lmdb], -[AS_HELP_STRING([--with-lmdb], - [(GnuCOBOL) Use Lightning Memory-Mapped Database (LMDB) for ISAM I/O (experimental, no locking or shared storage)])], -[ if test "$with_lmdb" = "yes"; then - AC_DEFINE([WITH_LMDB], [1]) - fi ], -[]) - -# -## Checks for indexed handlers -# - -if test "$with_db" = "yes"; then - AC_MSG_NOTICE([Checks for Berkeley DB ...]) - - AC_CHECK_HEADERS([db.h], [], AC_MSG_ERROR([Berkeley DB db.h is missing]), []) - - # BDB header exists. Extract major/minor number pair - COB_BDB_HEADER='' - COB_BDB_HEADER_STR='' - AC_RUN_IFELSE([AC_LANG_SOURCE([[ - #include - #include - int main (int argc, char **argv) - { - (void)argv; - if (argc == 2) - printf ("%d.%d", DB_VERSION_MAJOR, DB_VERSION_MINOR); - if (argc == 3) - printf ("-%s-", DB_VERSION_STRING); - return 0; - } - ]])], - [COB_BDB_HEADER=`./conftest$ac_exeext x`] - [COB_BDB_HEADER_STR=`./conftest$ac_exeext x y`], - [AC_MSG_ERROR([Unable to extract Berkeley DB version information from db.h])], - [AC_MSG_WARN([cannot run test program while cross-compiling]) - COB_BDB_HEADER="cross" - COB_BDB_HEADER_STR="cross"]) - if test "x$COB_BDB_HEADER" = "x"; then - AC_MSG_ERROR([Unable to extract Berkeley DB version information]) - fi - if test "x$COB_BDB_HEADER_STR" != "x"; then - AC_MSG_NOTICE([db.h reports version "$COB_BDB_HEADER_STR"]) - fi - if test "$COB_BDB_HEADER_STR" != "cross"; then - AC_MSG_CHECKING([for Berkeley DB db.h version >= 4.1]) - COB_BDB_HEADER_MAJOR=$(echo "$COB_BDB_HEADER" | cut -d. -f1) - if test $COB_BDB_HEADER_MAJOR -gt 4; then - AC_MSG_RESULT([yes ($COB_BDB_HEADER)]) - else - COB_BDB_HEADER_MINOR=$(echo "$COB_BDB_HEADER" | cut -d. -f2) - if test $COB_BDB_HEADER_MAJOR -eq 4 -a $COB_BDB_HEADER_MINOR -ge 1; then - AC_MSG_RESULT([yes ($COB_BDB_HEADER)]) - else - AC_MSG_RESULT([no ($COB_BDB_HEADER)]) - AC_MSG_ERROR([Berkeley DB db.h has incompatible version]) - fi - fi - MYOLDLIBS="$LIBS" - cob_got_db=no - AC_MSG_CHECKING([for Berkeley DB library with version $COB_BDB_HEADER]) - # prefer library with version number included as some systems link against wrong version - # of the library and to not break when a newer BDB version is installed, see bug #100 - for cobdb in db-$COB_BDB_HEADER db - do - LIBS="$MYOLDLIBS -l$cobdb" - AC_RUN_IFELSE([AC_LANG_PROGRAM([[#include - #include ]], [[ - int major, minor, patch; - db_version (&major, &minor, &patch); - if (major == DB_VERSION_MAJOR && minor == DB_VERSION_MINOR) { - return 0; - } - return 1;]])], - [AC_DEFINE([WITH_DB], [1]) - cob_got_db=yes - LIBCOB_LIBS="$LIBCOB_LIBS -l$cobdb" - break], - [], - []) - done - LIBS="$MYOLDLIBS" - if test "$cob_got_db" = "yes"; then - AC_MSG_RESULT([yes]) - AC_MSG_NOTICE([BDB library version $COB_BDB_HEADER found as -l$cobdb]) - else - AC_MSG_RESULT([no]) - AC_MSG_ERROR([BDB library version $COB_BDB_HEADER not found]) - fi - else - AC_MSG_WARN([Matching BDB version (>=4.1) assumed]) - AC_CHECK_LIB([db], [db_version], - [LIBCOB_LIBS="$LIBCOB_LIBS -ldb"], - AC_MSG_ERROR([BDB library is required as -ldb]), []) - fi - unset cobdb - unset cob_got_db - unset COB_BDB_HEADER -fi - - -if test "$with_lmdb" = "yes"; then - AC_MSG_NOTICE([Checks for Lightning Memory-Mapped Database (LMDB) ...]) - AC_CHECK_HEADER([lmdb.h], [], AC_MSG_ERROR([LMDB lmdb.h is missing]),[]) - - # MDB header exists. Extract major/minor/patch numbers - COB_MDB_HEADER='' - COB_MDB_HEADER_STR='' - AC_RUN_IFELSE([AC_LANG_SOURCE([[ - #include - #include - int main (int argc, char **argv) - { - (void)argv; - if (argc == 2) - printf ("%d.%d.%d", MDB_VERSION_MAJOR, MDB_VERSION_MINOR, MDB_VERSION_PATCH); - if (argc == 3) - printf ("-%s-", MDB_VERSION_STRING); - return 0; - } - ]])], - [COB_MDB_HEADER=`./conftest$ac_exeext x`] - [COB_MDB_HEADER_STR=`./conftest$ac_exeext x y`], - [AC_MSG_ERROR([Unable to extract LMDB version information from lmdb.h])], - [AC_MSG_WARN([cannot run test program while cross-compiling]) - COB_MDB_HEADER="cross" - COB_MDB_HEADER_STR="cross"]) - if test "x$COB_MDB_HEADER" = "x"; then - AC_MSG_ERROR([Unable to extract LMDB version information]) - fi - if test "x$COB_MDB_HEADER_STR" != "x"; then - AC_MSG_NOTICE([lmdb.h reports version "$COB_MDB_HEADER_STR"]) - fi - AC_CHECK_LIB([lmdb], [mdb_version], - [AC_DEFINE([WITH_LMDB], [1]) - LIBCOB_LIBS="$LIBCOB_LIBS -llmdb"], - AC_MSG_ERROR([liblmdb is required for LMDB]), []) - - AC_MSG_CHECKING([for Symas LMDB version >= 0.9.19]) - COB_MDB_HEADER_MAJOR=$(echo "$COB_MDB_HEADER" | cut -d. -f1) - COB_MDB_HEADER_PATCH=$(echo "$COB_MDB_HEADER" | cut -d. -f3) - if test "$COB_MDB_HEADER_STR" != "cross"; then - if test $COB_MDB_HEADER_MAJOR -gt 0; then - AC_MSG_RESULT([yes ($COB_MDB_HEADER)]) - else - if test $COB_MDB_HEADER_PATCH -gt 18; then - AC_MSG_RESULT([yes ($COB_MDB_HEADER)]) - else - AC_MSG_RESULT([no ($COB_MDB_HEADER)]) - AC_MSG_ERROR([LMDB version < 0.9.19]) - fi - fi - fi -fi - -# Checks for dl/ltdl. -DEFINE_DL="no" - -AC_MSG_CHECKING([for _WIN32]) -AC_COMPILE_IFELSE([AC_LANG_SOURCE([[ - #ifndef _WIN32 - # error macro not defined - #endif]])], - [DEFINE_DL="yes" - AC_MSG_RESULT([yes])], - [AC_MSG_RESULT([no])]) - -if test "$DEFINE_DL" = "no" -a "$with_dl" = "yes"; then - if test "x$ac_cv_header_dlfcn_h" = "xyes"; then - AC_CHECK_LIB([c], [dlopen], [DEFINE_DL="yes"], [], []) - if test "$DEFINE_DL" = "no"; then - AC_CHECK_LIB([dl], [dlopen], [DEFINE_DL="yes"], [], []) - if test "$DEFINE_DL" = "yes"; then - AC_DEFINE([USE_LIBDL], [1]) - LIBCOB_LIBS="$LIBCOB_LIBS -ldl" - AC_CHECK_LIB([dl], [dladdr], [AC_DEFINE([HAVE_DLADDR], [1])], [], []) - else - AC_CHECK_LIB([dld], [dlopen], [DEFINE_DL="yes"], [], []) - if test "$DEFINE_DL" = "yes"; then - AC_DEFINE([USE_LIBDL], [1]) - LIBCOB_LIBS="$LIBCOB_LIBS -ldld" - AC_CHECK_LIB([dld], [dladdr], [AC_DEFINE([HAVE_DLADDR], [1])], [], []) - fi - fi - else - AC_DEFINE([USE_LIBDL], [1]) - AC_CHECK_LIB([c], [dladdr], [AC_DEFINE([HAVE_DLADDR], [1])], [], []) - fi - fi -fi - -if test "$DEFINE_DL" = "no"; then - AC_CHECK_HEADERS([ltdl.h], [], AC_MSG_ERROR([ltdl.h is required]), []) - AC_CHECK_LIB([ltdl], [lt_dlopen], - [LIBCOB_LIBS="$LIBCOB_LIBS -lltdl"], - AC_MSG_ERROR([libltdl is required]), []) -fi - -# Checks for compiling computed gotos -AC_MSG_CHECKING([for support of computed gotos]) -AC_COMPILE_IFELSE([AC_LANG_SOURCE([[ - int test () - { - void *test_ptr; - test_ptr = &&lab; - - goto *test_ptr; - return 1; - - lab: - return 0; - }]])], - [AC_DEFINE([COB_COMPUTED_GOTO], [1]) - AC_MSG_RESULT([yes])], - [AC_MSG_RESULT([no])]) - -# Checks for size of long -AC_MSG_CHECKING([if size of long int = size of long long]) -AC_RUN_IFELSE([AC_LANG_PROGRAM([[]], [[ - if (sizeof(long int) == sizeof(long long)) - return 0; - return 1; - ]])], - [AC_DEFINE([COB_LI_IS_LL], [1]) AC_MSG_RESULT([yes])], - [AC_MSG_RESULT([no])], - [if test "$COB_LI_IS_LL" = "0"; then - AC_MSG_RESULT([specified "no" on configure line]) - else - if test "$COB_LI_IS_LL" = "1"; then - AC_MSG_RESULT([specified "yes" on configure line]) - else - COB_LI_IS_LL=1 - AC_MSG_RESULT([assumed - cross-compilation]) - fi - fi - AC_DEFINE([COB_LI_IS_LL], [$COB_LI_IS_LL]) - AC_MSG_WARN([cannot run test program while cross-compiling])]) - -AC_MSG_CHECKING([if long is 32 bits]) -AC_RUN_IFELSE([AC_LANG_PROGRAM([[]], [[ - if (sizeof (long) == 4) - return 0; - return 1; - ]])], - [AC_DEFINE([COB_32_BIT_LONG], [1]) AC_MSG_RESULT([yes])], - [AC_MSG_RESULT([no])], - [if test "$COB_32_BIT_LONG" = "0"; then - AC_MSG_RESULT([specified "no" on configure line]) - else - if test "$COB_32_BIT_LONG" = "1"; then - AC_MSG_RESULT([specified "yes" on configure line]) - else - COB_32_BIT_LONG=1 - AC_MSG_RESULT([assumed - cross-compilation]) - fi - fi - AC_DEFINE([COB_32_BIT_LONG], [$COB_32_BIT_LONG]) - AC_MSG_WARN([cannot run test program while cross-compiling])]) - - -if test "cross_compiling" != "yes"; then - COB_HAS_64_BIT_POINTER="no" -fi -AC_MSG_CHECKING([if pointer is longer than 32 bits]) -AC_RUN_IFELSE([AC_LANG_PROGRAM([[]], [[ - if (sizeof (void *) > 4U) - return 0; - return 1; - ]])], - [COB_HAS_64_BIT_POINTER="yes" - AC_DEFINE([COB_64_BIT_POINTER], [1]) - AC_MSG_RESULT([yes])], - [AC_MSG_RESULT([no])], - [if test "$COB_HAS_64_BIT_POINTER" = "0"; then - COB_HAS_64_BIT_POINTER="no" - AC_DEFINE([COB_64_BIT_POINTER], [0]) - AC_MSG_RESULT([specified "no" on configure line]) - else - if test "$COB_HAS_64_BIT_POINTER" = "1"; then - COB_HAS_64_BIT_POINTER="yes" - AC_DEFINE([COB_64_BIT_POINTER], [1]) - AC_MSG_RESULT([specified "yes" on configure line]) - else - COB_HAS_64_BIT_POINTER="no" - AC_DEFINE([COB_64_BIT_POINTER], [0]) - AC_MSG_RESULT([assumed "no" - cross-compilation]) - fi - fi - AC_MSG_WARN([cannot run test program while cross-compiling])]) - -#if test "$enable_debug" != "yes" -a "$COB_USES_GCC_NO_ICC" = "yes"; then -# MYOLDCFLAGS="$CFLAGS" -# CFLAGS="$CFLAGS -fno-asynchronous-unwind-tables" -# AC_MSG_CHECKING([for gcc unwind tables option]) -# AC_COMPILE_IFELSE([AC_LANG_PROGRAM([[]], [[int testint;]])], -# [AC_DEFINE([HAVE_UNWIND_OPT], [1]) AC_MSG_RESULT([yes])], -# [AC_MSG_RESULT([no])]) -# CFLAGS="$MYOLDCFLAGS" -#fi - -# Check gcc wrapv option -# We likely don't need this and remove it before 3.0 final release -#if test "$COB_USES_GCC_NO_ICC" = "yes"; then -# MYOLDCFLAGS="$CFLAGS" -# CFLAGS="$CFLAGS -fwrapv" -# AC_MSG_CHECKING([for gcc -fwrapv option]) -# AC_COMPILE_IFELSE([AC_LANG_PROGRAM([[]], [[int testint;]])], -# [AC_DEFINE([HAVE_FWRAPV_OPT], [1]) AC_MSG_RESULT([yes])], -# [AC_MSG_RESULT([no])]) -# [], -# [CFLAGS="$MYOLDCFLAGS"]) -# CFLAGS="$MYOLDCFLAGS" -#fi - -# Check if aligned attribute seems to work -# done: does not raise an error -# *TODO*: has same output as omitting it) -AC_MSG_CHECKING([for aligned attribute]) -AC_COMPILE_IFELSE([AC_LANG_PROGRAM([[]], - [[char testchar[4] __attribute__((aligned));]])], - [AC_DEFINE([HAVE_ATTRIBUTE_ALIGNED], [1]) AC_MSG_RESULT([yes]) - ], - [AC_MSG_RESULT([no])]) - -# GnuCOBOL Configuration - -COB_LIBS="-L$libdir -lcob" -COB_LDFLAGS="" -if test "x$LDFLAGS" != "x"; then - COB_LIBS="$LDFLAGS $COB_LIBS" - COB_LDFLAGS="$LDFLAGS" -fi - -COB_CONFIG_DIR="$datadir/$PACKAGE_TARNAME/config" -COB_SCHEMA_DIR="$datadir/$PACKAGE_TARNAME/schema" -COB_COPY_DIR="$datadir/$PACKAGE_TARNAME/copy" -COB_LIBRARY_PATH="$libdir/$PACKAGE_TARNAME" -COB_EXE_EXT="$EXEEXT" -if test "$COB_EXE_EXT" = ".exe"; then - COB_MODULE_EXT="dll" -else - if test "$COB_EXE_EXT" = ".exe" -o "$COB_EXE_EXT" = ".EXE"; then - COB_MODULE_EXT="dll" - else - # normal case... - COB_MODULE_EXT=`echo "$acl_cv_shlibext" | sed -e 's/dll\.a/dll/'` - fi -fi -COB_OBJECT_EXT="$OBJEXT" -LIBS="$save_libs" -COB_EXPORT_DYN="`eval echo $export_dynamic_flag_spec`" -# FIXME: lt_prog_compiler_pic is not always correct, for example with occ -COB_PIC_FLAGS=`echo "$lt_prog_compiler_pic" | sed -e 's/^ //'` - -if test "$enable_cflags_setting" = "yes"; then - - # Remove -O2 option added by AC_PROG_CC and add -O0 - if test "$enable_debug" = "yes" -o "$enable_code_coverage" = "yes"; then - CFLAGS=`echo "$CFLAGS" | sed -e 's/ *-O@<:@0-9a-zA-Z@:>@* */ /g' -e 's/ $//' -e 's/^ //'` - if test "$COB_USES_GCC" = "yes"; then - CFLAGS="$CFLAGS -O0" - fi - fi - - # For debugging: add -g3 if using GCC. - if test "$enable_debug" = "yes" -a "$COB_USES_GCC" = "yes"; then - MYOLDCFLAGS="$CFLAGS" - CFLAGS="$CFLAGS -g3" - AC_MSG_CHECKING([for gcc -g3 option]) - AC_COMPILE_IFELSE([AC_LANG_PROGRAM([[]], [[int testint;]])], - [AC_MSG_RESULT([yes])], - [CFLAGS="$MYOLDCFLAGS"; AC_MSG_RESULT([no])]) - unset MYOLDCFLAGS - fi -fi - -unset enable_cflags_setting - -if test "$COB_USES_GCC" = "yes"; then - if test "x$CFLAGS" != "x"; then - CFLAGS="$CFLAGS -pipe" - else - CFLAGS="-pipe" - fi -fi - -# include directory (install dir) - -if test "x$prefix" = "xNONE"; then - if test "x$includedir" = "x\${prefix}/include"; then - COB_CFLAGS="-I${ac_default_prefix}/include" - else - COB_CFLAGS="-I${includedir}" - fi -else - if test "x$includedir" = "x\${prefix}/include"; then - if test "x$prefix" = "x/usr"; then - COB_CFLAGS="" - else - COB_CFLAGS="-I${prefix}/include" - fi - else - COB_CFLAGS="-I${includedir}" - fi -fi - - -# compiler specific general options for COB_CFLAGS, originating from cobc.c (main) - -if test "$COB_USES_ICC_ONLY" = "yes"; then - # these are deprecated... - COB_CFLAGS="$COB_CFLAGS -vec-report0 -opt-report 0" -elif test "$COB_USES_WATCOMC_ONLY" = "yes"; then - # -s = no overflow checks, otherwise need to code/link a CHK routine - COB_CFLAGS="$COB_CFLAGS -s -wcd=118" -elif test "$COB_USES_XLC_ONLY" = "yes"; then - # use read-only memory for string literals and constants - COB_CFLAGS="$COB_CFLAGS -qro -qroconst" - # allow nonstandard usage - CHECKME where do we need this ??? - # do we need the additional check for __IBMC__ >= 700 we had in cobc? - COB_CFLAGS="$COB_CFLAGS -qlanglvl=extended" - # Suppress compiler warning about MAXMEM optimization - COB_CFLAGS="$COB_CFLAGS -qsuppress=1500-030" -fi - -if test "$COB_USES_GCC_NO_ICC" = "yes"; then - # comment from cobc.c: --param max-goto-duplication-insns=100000 - # /* RXWRXW - gcse */ - # COB_CFLAGS="$COB_CFLAGS -Wno-unused -fsigned-char -fno-gcse" - COB_CFLAGS="$COB_CFLAGS -Wno-unused -fsigned-char" -fi - -# Check gcc 4 pointer sign option (at least available with "recent" clang, too) -#if test "$COB_USES_GCC_NO_ICC" = "yes"; then -if test "$COB_USES_XLC_ONLY" != "yes"; then - MYOLDCFLAGS="$CFLAGS" - CFLAGS="$CFLAGS -Wno-pointer-sign" - AC_MSG_CHECKING([for gcc pointer sign option]) - AC_COMPILE_IFELSE([AC_LANG_PROGRAM([[]], [[int testint;]])], - [COB_CFLAGS="$COB_CFLAGS -Wno-pointer-sign"; AC_MSG_RESULT([yes])], - [AC_MSG_RESULT([no])]) - CFLAGS="$MYOLDCFLAGS" -fi -#fi - -if test "$COB_USES_CLANG_ONLY" = "yes"; then - # don't warn if cobc uses arguments which aren't picked up (likely because of the translation phase) - COB_CFLAGS="$COB_CFLAGS -Qunused-arguments" -fi - - -# Include CFLAGS / CPPFLAGS in COB_CFLAGS without optimization/debug options. - -if test "x$CFLAGS" != "x"; then - cob_temp_flags="$CFLAGS" -else - cob_temp_flags="" -fi -if test "x$CPPFLAGS" != "x"; then - if test "x$cob_temp_flags" != "x"; then - cob_temp_flags="$CPPFLAGS $cob_temp_flags" - else - cob_temp_flags="$CPPFLAGS" - fi -fi -if test "x$cob_temp_flags" != "x"; then - cob_temp_flags=`echo "$cob_temp_flags" \ - | sed -e 's/-g3//g' -e 's/-g //g' -e 's/-g$//' -e 's/ $//' -e 's/^ //' \ - -e 's/@<:@+-@:>@O@<:@0-9s@:>@//g' -e 's/ $//' -e 's/^ //' \ - -e 's/-O//g' -e 's/ $//' -e 's/^ //' \ - -e 's/-fmessage-length=0//g' \ - -e 's/@<:@^ @:>@*-D_FORTIFY_SOURCE=.//g' \ - -e 's/-fstack-protector-strong//g' \ - -e 's/-fstack-protector-all//g' \ - -e 's/-fstack-protector//g' \ - -e 's/-funwind-tables//g' \ - -e 's/-fasynchronous-unwind-tables//g' \ - -e 's/ */ /g' -e 's/ $//' -e 's/^ //'` -fi - -if test "x$cob_temp_flags" != "x"; then - COB_CFLAGS="$COB_CFLAGS $cob_temp_flags" -fi -unset cob_temp_flags - - -# Special stuff - -AH_VERBATIM([_XOPEN_SOURCE_EXTENDED], -[/* Define to 1 if on HPUX. */ -#ifndef _XOPEN_SOURCE_EXTENDED -# undef _XOPEN_SOURCE_EXTENDED -#endif])dnl - -# FIXME: COB_SHARED_OPT should at least be checked for "compiles"; -# for example breaks with occ and other non-GCC compilers, -# *at least* check that compilation still works when using this option... -COB_SHARED_OPT="-shared" - -COB_FIX_LIB="$COB_EXPORT_DYN" -COB_FIX_LIBTOOL="" -case $host_os in - mingw*) - if test "$prefix" = "NONE"; then - COB_CONFIG_DIR="`cd /usr && pwd -W`/local/share/$PACKAGE_TARNAME/config" - COB_SCHEMA_DIR="`cd /usr && pwd -W`/local/share/$PACKAGE_TARNAME/schema" - COB_COPY_DIR="`cd /usr && pwd -W`/local/share/$PACKAGE_TARNAME/copy" - fi - if test "$COB_USES_GCC" = "yes"; then - COB_EXPORT_DYN="-Wl,--export-all-symbols -Wl,--enable-auto-import -Wl,--enable-auto-image-base" - COB_FIX_LIBTOOL="-Wl,--enable-auto-import" - fi - COB_FIX_LIB="" - ;; - cygwin*) - if test "$COB_USES_GCC" = "yes"; then - COB_EXPORT_DYN="-Wl,--export-all-symbols -Wl,--enable-auto-import -Wl,--enable-auto-image-base" - COB_FIX_LIBTOOL="-Wl,--enable-auto-import" - fi - COB_FIX_LIB="" - ;; - darwin* | rhapsody*) - if test "$COB_USES_GCC" = "yes"; then - COB_SHARED_OPT="-bundle -flat_namespace -undefined suppress" - fi - ;; - hpux*) - if test "$COB_USES_GCC" != "yes"; then - COB_SHARED_OPT="-b" - AC_DEFINE([_XOPEN_SOURCE_EXTENDED], [1]) - rm -f hptest* - echo 'int main() { return 0; }' > hptest.c - ${CC} ${CFLAGS} +Olit=all -o hptest hptest.c > hptest.out 2>&1 - if test $? -ne 0 -o -s hptest.out; then - CFLAGS="$CFLAGS +ESlit" - COB_CFLAGS="$COB_CFLAGS +ESlit -w" - else - CFLAGS="$CFLAGS +Olit=all" - COB_CFLAGS="$COB_CFLAGS +Olit=all -w" - fi - - if test "$enable_debug" = "yes"; then - CFLAGS="$CFLAGS +O0" - else - CFLAGS="$CFLAGS +O2" - fi - - rm -f hptest* - fi - ;; - aix*) - COB_EXPORT_DYN="-Wl,-bexpfull -Wl,-brtl" - if test "$COB_USES_GCC" != "yes"; then - CFLAGS="$CFLAGS -Q -qro -qroconst" - if test "$enable_debug" = "yes"; then - CFLAGS="$CFLAGS -qnoopt" - else - CFLAGS="$CFLAGS -O2" - fi - - COB_SHARED_OPT="-G" - COB_FIX_LIB="" - # COB_FIX_LIB="-Wc,-G $COB_EXPORT_DYN" - # COB_CFLAGS="$COB_CFLAGS -qchars=signed" - else - COB_FIX_LIB="$COB_EXPORT_DYN" - fi - ;; - solaris*) - if test "$COB_USES_GCC" != "yes"; then - CFLAGS="$CFLAGS -xstrconst" - if test "$enable_debug" != "yes"; then - CFLAGS="$CFLAGS -xO2" - fi - COB_CFLAGS="$COB_CFLAGS -xstrconst" - COB_SHARED_OPT="-G" - fi - ;; -esac - -if test "$COB_USES_ICC_ONLY" = "yes"; then - if test "$enable_debug" != "yes"; then - CFLAGS="$CFLAGS -finline-functions" - fi - CFLAGS="$CFLAGS -Wall -wd1419 -vec-report0 -opt-report 0" -elif test "$COB_USES_GCC" = "yes" && test "$with_gnu_ld" = "yes"; then - MYOLDLDFLAGS="$LDFLAGS" - LDFLAGS="$LDFLAGS -Wl,-z,relro,-z,now,-O1" - AC_MSG_CHECKING([for ld bind now option]) - AC_LINK_IFELSE([AC_LANG_PROGRAM([[]], [[int testint;]])], - [AC_MSG_RESULT([yes])], - [LDFLAGS=$MYOLDLDFLAGS - AC_MSG_RESULT([no])]) - unset MYOLDLDFLAGS - if test "$enable_debug" != "yes"; then - CFLAGS="$CFLAGS -finline-functions" - fi - CFLAGS="$CFLAGS -fsigned-char -Wall -Wwrite-strings -Wmissing-prototypes -Wno-format-y2k" - if test "$enable_debug" != "yes"; then - CFLAGS="$CFLAGS -U_FORTIFY_SOURCE" - fi -fi - -if test "x$lt_cv_dlopen_self" != "xyes"; then - AC_DEFINE([COB_NO_SELFOPEN], [1]) -fi - -if test "$with_cisam" = "yes"; then - COB_HAS_ISAM=cisam -elif test "$with_disam" = "yes"; then - COB_HAS_ISAM=disam -elif test "$with_vbisam" = "yes"; then - COB_HAS_ISAM=vbisam -elif test "$with_db" = "yes"; then - COB_HAS_ISAM=db -elif test "$with_lmdb" = "yes"; then - COB_HAS_ISAM=lmdb -elif test "$with_index_extfh" = "yes"; then - COB_HAS_ISAM=index_extfh -else - COB_HAS_ISAM=no -fi -COB_HAS_CISAM=$with_cisam -COB_HAS_DISAM=$with_disam -COB_HAS_VBISAM=$with_vbisam -COB_HAS_BDB=$with_db -COB_HAS_LMDB=$with_lmdb -COB_HAS_ODBC=$with_odbc -COB_HAS_OCI=$with_oci -COB_HAS_OCEXTFH=$with_index_extfh - -if test "$USE_CURSES" = "not_found" -o "$USE_CURSES" = "no"; then - COB_HAS_CURSES=no -else - COB_HAS_CURSES=yes -fi - -if test "$with_xml2" = "yes"; then - COB_HAS_XML2=yes -else - COB_HAS_XML2=no -fi - -AM_CONDITIONAL([COB_MAKE_CISAM_LIB], [test "$cob_multi_isam" = "yes" -a "$cob_gen_cisam" = "yes"]) -AM_CONDITIONAL([COB_MAKE_DISAM_LIB], [test "$cob_multi_isam" = "yes" -a "$cob_gen_disam" = "yes"]) -AM_CONDITIONAL([COB_MAKE_VBISAM_LIB], [test "$cob_multi_isam" = "yes" -a "$cob_gen_vbisam" = "yes"]) - -AM_CONDITIONAL([LOCAL_CJSON],[test "$with_cjson" = "local"]) -if test "$with_cjson" = "yes" -o "$with_cjson" = "local"; then - COB_HAS_CJSON=yes -else - COB_HAS_CJSON=no - with_cjson=no -fi - -unset COB_USES_GCC -unset COB_USES_GCC_NO_ICC -unset COB_USES_ICC_ONLY -unset COB_USES_CLANG_ONLY -unset COB_USES_XLC_ONLY -unset COB_USES_WATCOM_ONLY -unset MYOLDCFLAGS -unset MYOLDLIBS -unset MYOCLIBS - -# Generate the output - -AM_CONDITIONAL([COB_MAKE_IX], [test "$COB_HAS_ISAM" != no]) -AM_CONDITIONAL([COB_MAKE_RUN_BINARIES], [test "$cross_compiling" != yes]) -# FIXME: Should be tested as the system may can actually run these (Bash on Windows?) - -AC_DEFINE_UNQUOTED([COB_EXPORT_DYN], ["$COB_EXPORT_DYN"]) -AC_DEFINE_UNQUOTED([COB_PIC_FLAGS], ["$COB_PIC_FLAGS"]) -AC_DEFINE_UNQUOTED([COB_SHARED_OPT], ["$COB_SHARED_OPT"]) -AC_DEFINE_UNQUOTED([COB_OBJECT_EXT], ["$COB_OBJECT_EXT"]) -AC_DEFINE_UNQUOTED([COB_MODULE_EXT], ["$COB_MODULE_EXT"]) -AC_DEFINE_UNQUOTED([COB_EXE_EXT], ["$COB_EXE_EXT"]) -if test "x$striplib" != "x"; then - AC_DEFINE_UNQUOTED([COB_STRIP_CMD], ["$striplib"]) -fi -AC_SUBST([COB_CC]) -AC_SUBST([COB_CFLAGS]) -AC_SUBST([COB_LDFLAGS]) -AC_SUBST([COB_LIBS]) -AC_SUBST([COB_CONFIG_DIR]) -AC_SUBST([COB_SCHEMA_DIR]) -AC_SUBST([COB_COPY_DIR]) -AC_SUBST([COB_LIBRARY_PATH]) -AC_SUBST([COB_OBJECT_EXT]) -AC_SUBST([COB_MODULE_EXT]) -AC_SUBST([COB_EXE_EXT]) -AC_SUBST([COBC_LIBS]) -AC_SUBST([LIBCOB_LIBS]) -AC_SUBST([LIBCOB_CISAM]) -AC_SUBST([LIBCOB_DISAM]) -AC_SUBST([LIBCOB_VBISAM]) -AC_SUBST([LIBCOB_CPPFLAGS]) -AC_SUBST([COB_EXPORT_DYN]) -AC_SUBST([COB_PIC_FLAGS]) -AC_SUBST([COB_SHARED_OPT]) -COB_BIGENDIAN="$ac_cv_c_bigendian" -AC_SUBST([COB_BIGENDIAN]) -AC_SUBST([COB_FIX_LIB]) -AC_SUBST([COB_FIX_LIBTOOL]) -AC_SUBST([COB_KEYWORD_INLINE]) -AC_SUBST([COB_HAS_ISAM]) -AC_SUBST([COB_HAS_CISAM]) -AC_SUBST([COB_HAS_DISAM]) -AC_SUBST([COB_HAS_VBISAM]) -AC_SUBST([COB_HAS_BDB]) -AC_SUBST([COB_HAS_LMDB]) -AC_SUBST([COB_HAS_ODBC]) -AC_SUBST([COB_HAS_OCI]) -AC_SUBST([COB_HAS_OCEXTFH]) -AC_SUBST([COB_HAS_CURSES]) -AC_SUBST([COB_HAS_XML2]) -AC_SUBST([COB_HAS_CJSON]) -AC_SUBST([COB_HAS_64_BIT_POINTER]) -AC_SUBST([COB_PATCH_LEVEL], [$with_patch_level]) # needed for bin/cob-config - -AC_CONFIG_COMMANDS([chmod], -[chmod +x bin/cob-config; -chmod +x tests/atconfig; -chmod +x tests/atlocal]) - -AM_MISSING_PROG([HELP2MAN], [help2man]) - -AC_OUTPUT - -AC_MSG_NOTICE([GnuCOBOL Configuration:]) -AC_MSG_NOTICE([ CC ${CC}]) -AC_MSG_NOTICE([ CFLAGS ${CFLAGS}]) -AC_MSG_NOTICE([ LDFLAGS ${LDFLAGS}]) -if test "x$COBC_LIBS" != "x"; then - AC_MSG_NOTICE([ COBC_LIBS ${COBC_LIBS}]) -fi -AC_MSG_NOTICE([ COB_CC ${COB_CC}]) -AC_MSG_NOTICE([ COB_CFLAGS ${COB_CFLAGS}]) -AC_MSG_NOTICE([ COB_LDFLAGS ${COB_LDFLAGS}]) -AC_MSG_NOTICE([ COB_LIBS ${COB_LIBS}]) -AC_MSG_NOTICE([ COB_CONFIG_DIR ${COB_CONFIG_DIR}]) -AC_MSG_NOTICE([ COB_COPY_DIR ${COB_COPY_DIR}]) -AC_MSG_NOTICE([ COB_SCHEMA_DIR ${COB_SCHEMA_DIR}]) -AC_MSG_NOTICE([ COB_LIBRARY_PATH ${COB_LIBRARY_PATH}]) -AC_MSG_NOTICE([ COB_OBJECT_EXT ${COB_OBJECT_EXT}]) -AC_MSG_NOTICE([ COB_MODULE_EXT ${COB_MODULE_EXT}]) -AC_MSG_NOTICE([ COB_EXE_EXT ${COB_EXE_EXT}]) -AC_MSG_NOTICE([ COB_SHARED_OPT ${COB_SHARED_OPT}]) -AC_MSG_NOTICE([ COB_PIC_FLAGS ${COB_PIC_FLAGS}]) -AC_MSG_NOTICE([ COB_EXPORT_DYN ${COB_EXPORT_DYN}]) -if test "x$striplib" != "x"; then - AC_MSG_NOTICE([ COB_STRIP_CMD ${striplib}]) -fi -if test "${DEFINE_DL}" = "yes" ; then - AC_MSG_NOTICE([ Dynamic loading: System]) -else - AC_MSG_NOTICE([ Dynamic loading: Libtool]) -fi -AC_MSG_NOTICE([ Use gettext for international messages: ${USE_NLS}]) -AC_MSG_NOTICE([ Use fcntl for file locking: ${ac_cv_func_fcntl}]) -case "$USE_CURSES" in - not_found) - AC_MSG_NOTICE([ screen I/O (no curses found): NO]) - ;; - no) - AC_MSG_NOTICE([ screen I/O (disabled): NO]) - ;; - *) - AC_MSG_NOTICE([ Use curses library for screen I/O: ${USE_CURSES}]) - ;; -esac -if test "$with_debug_log" = "yes"; then - AC_MSG_NOTICE([ Enable GnuCOBOL developer logging yes]) -fi -if test "$with_seqra_extfh" = "yes"; then - AC_MSG_NOTICE([ Use external SEQ/RAN file handler: yes]) -fi -if test "$with_index_extfh" = "yes"; then - AC_MSG_NOTICE([ Use external ISAM file handler yes]) -fi -if test "$with_vbisam" = "yes"; then - AC_MSG_NOTICE([ Use VBISAM for ISAM I/O yes]) -fi -if test "$with_disam" = "yes"; then - AC_MSG_NOTICE([ Use DISAM for ISAM I/O yes]) -fi -if test "$with_cisam" = "yes"; then - AC_MSG_NOTICE([ Use CISAM for ISAM I/O yes]) -fi -if test "$with_db" = "yes"; then - AC_MSG_NOTICE([ Use Berkeley DB for ISAM I/O: yes]) -fi -if test "$with_lmdb" = "yes"; then - AC_MSG_NOTICE([ Use LMDB for ISAM I/O: yes]) -fi -if test "$with_odbc" = "yes"; then - AC_MSG_NOTICE([ Use ODBC for ISAM I/O: yes]) -fi -if test "$with_oci" = "yes"; then - AC_MSG_NOTICE([ Use Oracle DB (OCI) for ISAM I/O: yes]) -fi - -if test "$COB_HAS_ISAM" = no; then - AC_MSG_NOTICE([ ISAM I/O (no handler configured): NO]) -fi -AC_MSG_NOTICE([ Use libxml2 for XML I/O: ${COB_HAS_XML2}]) -AC_MSG_NOTICE([ Use cJSON for JSON I/O: $with_cjson]) -unset DEFINE_DL diff -Nru gnucobol-4.0~early~20200606/copy/ChangeLog gnucobol-5/copy/ChangeLog --- gnucobol-4.0~early~20200606/copy/ChangeLog 2020-06-06 20:52:02.000000000 +0000 +++ gnucobol-5/copy/ChangeLog 1970-01-01 00:00:00.000000000 +0000 @@ -1,61 +0,0 @@ - -2019-11-20 Ron Norman - * xfhfcd3.cpy: Added file format values for DISAM, VBISAM, BDB, LMDB - -2019-04-17 Simon Sobisch - - * screenio.cpy: added exception values for mouse and - mouse mask definitions - -2018-12-31 Simon Sobisch - - * xfhfcd3.cpy: new copy for EXTFH call from COBOL - * xfhfcd.cpy: new wrapper for xfhfcd3.cpy - -2016-12-23 Simon Sobisch - - * screenio.cpy: added COB-SCR-INSERT, COB-SCR-DELETE, COB-SCR-BACKSPACE, - COB-SCR-KEY-HOME, COB-SCR-KEY-END for ACCEPT OMITTED - * screenio.cpy: renamed COB-SCR-PAGE_UP to COB-SCR-PAGE-UP, - COB-SCR-PAGE_DOWN to COB-SCR-PAGE-DOWN - -2015-06-22 Luke Smith - - * screenio.cpy: add COB-SCR-TAB, COB-SCR-BACK-TAB, - COB-SCR-KEY-LEFT and COB-SCR-KEY-RIGHT - -2010-06-28 Roger While - - * MARK - Version 2.0 - * Move to GPL/LGPL 3 - -20??-??-?? Roger While - - * screenio.cpy: added COB-SCR-MAX-FIELD - -2009-??-?? Roger While - - * screenio.cpy: added COB-SCR-TIME-OUT - -2008-08-09 Roger While - - * screenio.cpy: added color definitions - -2008-07-05 Roger While - - * screenio.cpy: extend - -2008-06-24 Roger While - - * screenio.cpy: new file - -2008-04-16 Roger While - - * new directory "copy" for OC supplied COPY elements - * Add Makefile*, ChangeLog, sqlca.cpy, sqlda.cpy - - -Copyright 2008-2010,2015,2016,2018-2019 Free Software Foundation, Inc. - -Copying and distribution of this file, with or without modification, are -permitted provided the copyright notice and this notice are preserved. diff -Nru gnucobol-4.0~early~20200606/copy/Makefile.am gnucobol-5/copy/Makefile.am --- gnucobol-4.0~early~20200606/copy/Makefile.am 2020-06-06 20:52:02.000000000 +0000 +++ gnucobol-5/copy/Makefile.am 1970-01-01 00:00:00.000000000 +0000 @@ -1,25 +0,0 @@ -# -# Makefile gnucobol/copy -# -# Copyright (C) 2008-2012, 2018 Free Software Foundation, Inc. -# Written by Roger While -# -# This file is part of GnuCOBOL. -# -# The GnuCOBOL compiler is free software: you can redistribute it -# and/or modify it under the terms of the GNU General Public License -# as published by the Free Software Foundation, either version 3 of the -# License, or (at your option) any later version. -# -# GnuCOBOL is distributed in the hope that it will be useful, -# but WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -# GNU General Public License for more details. -# -# You should have received a copy of the GNU General Public License -# along with GnuCOBOL. If not, see . - -copydir = @COB_COPY_DIR@ -copy_DATA = screenio.cpy sqlca.cpy sqlda.cpy xfhfcd.cpy xfhfcd3.cpy - -EXTRA_DIST = $(copy_DATA) diff -Nru gnucobol-4.0~early~20200606/copy/Makefile.in gnucobol-5/copy/Makefile.in --- gnucobol-4.0~early~20200606/copy/Makefile.in 2020-06-06 20:56:36.000000000 +0000 +++ gnucobol-5/copy/Makefile.in 1970-01-01 00:00:00.000000000 +0000 @@ -1,607 +0,0 @@ -# Makefile.in generated by automake 1.15.1 from Makefile.am. -# @configure_input@ - -# Copyright (C) 1994-2017 Free Software Foundation, Inc. - -# This Makefile.in is free software; the Free Software Foundation -# gives unlimited permission to copy and/or distribute it, -# with or without modifications, as long as this notice is preserved. - -# This program is distributed in the hope that it will be useful, -# but WITHOUT ANY WARRANTY, to the extent permitted by law; without -# even the implied warranty of MERCHANTABILITY or FITNESS FOR A -# PARTICULAR PURPOSE. - -@SET_MAKE@ - -# -# Makefile gnucobol/copy -# -# Copyright (C) 2008-2012, 2018 Free Software Foundation, Inc. -# Written by Roger While -# -# This file is part of GnuCOBOL. -# -# The GnuCOBOL compiler is free software: you can redistribute it -# and/or modify it under the terms of the GNU General Public License -# as published by the Free Software Foundation, either version 3 of the -# License, or (at your option) any later version. -# -# GnuCOBOL is distributed in the hope that it will be useful, -# but WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -# GNU General Public License for more details. -# -# You should have received a copy of the GNU General Public License -# along with GnuCOBOL. If not, see . - -VPATH = @srcdir@ -am__is_gnu_make = { \ - if test -z '$(MAKELEVEL)'; then \ - false; \ - elif test -n '$(MAKE_HOST)'; then \ - true; \ - elif test -n '$(MAKE_VERSION)' && test -n '$(CURDIR)'; then \ - true; \ - else \ - false; \ - fi; \ -} -am__make_running_with_option = \ - case $${target_option-} in \ - ?) ;; \ - *) echo "am__make_running_with_option: internal error: invalid" \ - "target option '$${target_option-}' specified" >&2; \ - exit 1;; \ - esac; \ - has_opt=no; \ - sane_makeflags=$$MAKEFLAGS; \ - if $(am__is_gnu_make); then \ - sane_makeflags=$$MFLAGS; \ - else \ - case $$MAKEFLAGS in \ - *\\[\ \ ]*) \ - bs=\\; \ - sane_makeflags=`printf '%s\n' "$$MAKEFLAGS" \ - | sed "s/$$bs$$bs[$$bs $$bs ]*//g"`;; \ - esac; \ - fi; \ - skip_next=no; \ - strip_trailopt () \ - { \ - flg=`printf '%s\n' "$$flg" | sed "s/$$1.*$$//"`; \ - }; \ - for flg in $$sane_makeflags; do \ - test $$skip_next = yes && { skip_next=no; continue; }; \ - case $$flg in \ - *=*|--*) continue;; \ - -*I) strip_trailopt 'I'; skip_next=yes;; \ - -*I?*) strip_trailopt 'I';; \ - -*O) strip_trailopt 'O'; skip_next=yes;; \ - -*O?*) strip_trailopt 'O';; \ - -*l) strip_trailopt 'l'; skip_next=yes;; \ - -*l?*) strip_trailopt 'l';; \ - -[dEDm]) skip_next=yes;; \ - -[JT]) skip_next=yes;; \ - esac; \ - case $$flg in \ - *$$target_option*) has_opt=yes; break;; \ - esac; \ - done; \ - test $$has_opt = yes -am__make_dryrun = (target_option=n; $(am__make_running_with_option)) -am__make_keepgoing = (target_option=k; $(am__make_running_with_option)) -pkgdatadir = $(datadir)/@PACKAGE@ -pkgincludedir = $(includedir)/@PACKAGE@ -pkglibdir = $(libdir)/@PACKAGE@ -pkglibexecdir = $(libexecdir)/@PACKAGE@ -am__cd = CDPATH="$${ZSH_VERSION+.}$(PATH_SEPARATOR)" && cd -install_sh_DATA = $(install_sh) -c -m 644 -install_sh_PROGRAM = $(install_sh) -c -install_sh_SCRIPT = $(install_sh) -c -INSTALL_HEADER = $(INSTALL_DATA) -transform = $(program_transform_name) -NORMAL_INSTALL = : -PRE_INSTALL = : -POST_INSTALL = : -NORMAL_UNINSTALL = : -PRE_UNINSTALL = : -POST_UNINSTALL = : -build_triplet = @build@ -host_triplet = @host@ -subdir = copy -ACLOCAL_M4 = $(top_srcdir)/aclocal.m4 -am__aclocal_m4_deps = $(top_srcdir)/m4/codeset.m4 \ - $(top_srcdir)/m4/gettext.m4 $(top_srcdir)/m4/iconv.m4 \ - $(top_srcdir)/m4/intlmacosx.m4 $(top_srcdir)/m4/lib-ld.m4 \ - $(top_srcdir)/m4/lib-link.m4 $(top_srcdir)/m4/lib-prefix.m4 \ - $(top_srcdir)/m4/libtool.m4 $(top_srcdir)/m4/ltoptions.m4 \ - $(top_srcdir)/m4/ltsugar.m4 $(top_srcdir)/m4/ltversion.m4 \ - $(top_srcdir)/m4/lt~obsolete.m4 \ - $(top_srcdir)/m4/m4_ax_check_define.m4 \ - $(top_srcdir)/m4/m4_ax_code_coverage.m4 \ - $(top_srcdir)/m4/nls.m4 $(top_srcdir)/m4/pkg.m4 \ - $(top_srcdir)/m4/po.m4 $(top_srcdir)/m4/progtest.m4 \ - $(top_srcdir)/configure.ac -am__configure_deps = $(am__aclocal_m4_deps) $(CONFIGURE_DEPENDENCIES) \ - $(ACLOCAL_M4) -DIST_COMMON = $(srcdir)/Makefile.am $(am__DIST_COMMON) -mkinstalldirs = $(SHELL) $(top_srcdir)/build_aux/mkinstalldirs -CONFIG_HEADER = $(top_builddir)/config.h -CONFIG_CLEAN_FILES = -CONFIG_CLEAN_VPATH_FILES = -AM_V_P = $(am__v_P_@AM_V@) -am__v_P_ = $(am__v_P_@AM_DEFAULT_V@) -am__v_P_0 = false -am__v_P_1 = : -AM_V_GEN = $(am__v_GEN_@AM_V@) -am__v_GEN_ = $(am__v_GEN_@AM_DEFAULT_V@) -am__v_GEN_0 = @echo " GEN " $@; -am__v_GEN_1 = -AM_V_at = $(am__v_at_@AM_V@) -am__v_at_ = $(am__v_at_@AM_DEFAULT_V@) -am__v_at_0 = @ -am__v_at_1 = -SOURCES = -DIST_SOURCES = -am__can_run_installinfo = \ - case $$AM_UPDATE_INFO_DIR in \ - n|no|NO) false;; \ - *) (install-info --version) >/dev/null 2>&1;; \ - esac -am__vpath_adj_setup = srcdirstrip=`echo "$(srcdir)" | sed 's|.|.|g'`; -am__vpath_adj = case $$p in \ - $(srcdir)/*) f=`echo "$$p" | sed "s|^$$srcdirstrip/||"`;; \ - *) f=$$p;; \ - esac; -am__strip_dir = f=`echo $$p | sed -e 's|^.*/||'`; -am__install_max = 40 -am__nobase_strip_setup = \ - srcdirstrip=`echo "$(srcdir)" | sed 's/[].[^$$\\*|]/\\\\&/g'` -am__nobase_strip = \ - for p in $$list; do echo "$$p"; done | sed -e "s|$$srcdirstrip/||" -am__nobase_list = $(am__nobase_strip_setup); \ - for p in $$list; do echo "$$p $$p"; done | \ - sed "s| $$srcdirstrip/| |;"' / .*\//!s/ .*/ ./; s,\( .*\)/[^/]*$$,\1,' | \ - $(AWK) 'BEGIN { files["."] = "" } { files[$$2] = files[$$2] " " $$1; \ - if (++n[$$2] == $(am__install_max)) \ - { print $$2, files[$$2]; n[$$2] = 0; files[$$2] = "" } } \ - END { for (dir in files) print dir, files[dir] }' -am__base_list = \ - sed '$$!N;$$!N;$$!N;$$!N;$$!N;$$!N;$$!N;s/\n/ /g' | \ - sed '$$!N;$$!N;$$!N;$$!N;s/\n/ /g' -am__uninstall_files_from_dir = { \ - test -z "$$files" \ - || { test ! -d "$$dir" && test ! -f "$$dir" && test ! -r "$$dir"; } \ - || { echo " ( cd '$$dir' && rm -f" $$files ")"; \ - $(am__cd) "$$dir" && rm -f $$files; }; \ - } -am__installdirs = "$(DESTDIR)$(copydir)" -DATA = $(copy_DATA) -am__tagged_files = $(HEADERS) $(SOURCES) $(TAGS_FILES) $(LISP) -am__DIST_COMMON = $(srcdir)/Makefile.in \ - $(top_srcdir)/build_aux/mkinstalldirs ChangeLog -DISTFILES = $(DIST_COMMON) $(DIST_SOURCES) $(TEXINFOS) $(EXTRA_DIST) -ACLOCAL = @ACLOCAL@ -AMTAR = @AMTAR@ -AM_DEFAULT_VERBOSITY = @AM_DEFAULT_VERBOSITY@ -AR = @AR@ -AS = @AS@ -AUTOCONF = @AUTOCONF@ -AUTOHEADER = @AUTOHEADER@ -AUTOMAKE = @AUTOMAKE@ -AWK = @AWK@ -CC = @CC@ -CCDEPMODE = @CCDEPMODE@ -CFLAGS = @CFLAGS@ -CJSON_CFLAGS = @CJSON_CFLAGS@ -CJSON_LIBS = @CJSON_LIBS@ -COBC_LIBS = @COBC_LIBS@ -COB_BIGENDIAN = @COB_BIGENDIAN@ -COB_CC = @COB_CC@ -COB_CFLAGS = @COB_CFLAGS@ -COB_CONFIG_DIR = @COB_CONFIG_DIR@ -COB_COPY_DIR = @COB_COPY_DIR@ -COB_EXE_EXT = @COB_EXE_EXT@ -COB_EXPORT_DYN = @COB_EXPORT_DYN@ -COB_FIX_LIB = @COB_FIX_LIB@ -COB_FIX_LIBTOOL = @COB_FIX_LIBTOOL@ -COB_HAS_64_BIT_POINTER = @COB_HAS_64_BIT_POINTER@ -COB_HAS_BDB = @COB_HAS_BDB@ -COB_HAS_CISAM = @COB_HAS_CISAM@ -COB_HAS_CJSON = @COB_HAS_CJSON@ -COB_HAS_CURSES = @COB_HAS_CURSES@ -COB_HAS_DISAM = @COB_HAS_DISAM@ -COB_HAS_ISAM = @COB_HAS_ISAM@ -COB_HAS_LMDB = @COB_HAS_LMDB@ -COB_HAS_OCEXTFH = @COB_HAS_OCEXTFH@ -COB_HAS_OCI = @COB_HAS_OCI@ -COB_HAS_ODBC = @COB_HAS_ODBC@ -COB_HAS_VBISAM = @COB_HAS_VBISAM@ -COB_HAS_XML2 = @COB_HAS_XML2@ -COB_KEYWORD_INLINE = @COB_KEYWORD_INLINE@ -COB_LDFLAGS = @COB_LDFLAGS@ -COB_LIBRARY_PATH = @COB_LIBRARY_PATH@ -COB_LIBS = @COB_LIBS@ -COB_MODULE_EXT = @COB_MODULE_EXT@ -COB_OBJECT_EXT = @COB_OBJECT_EXT@ -COB_PATCH_LEVEL = @COB_PATCH_LEVEL@ -COB_PIC_FLAGS = @COB_PIC_FLAGS@ -COB_SCHEMA_DIR = @COB_SCHEMA_DIR@ -COB_SHARED_OPT = @COB_SHARED_OPT@ -CODE_COVERAGE_CFLAGS = @CODE_COVERAGE_CFLAGS@ -CODE_COVERAGE_CPPFLAGS = @CODE_COVERAGE_CPPFLAGS@ -CODE_COVERAGE_CXXFLAGS = @CODE_COVERAGE_CXXFLAGS@ -CODE_COVERAGE_ENABLED = @CODE_COVERAGE_ENABLED@ -CODE_COVERAGE_LDFLAGS = @CODE_COVERAGE_LDFLAGS@ -CODE_COVERAGE_LIBS = @CODE_COVERAGE_LIBS@ -CPP = @CPP@ -CPPFLAGS = @CPPFLAGS@ -CYGPATH_W = @CYGPATH_W@ -DEFS = @DEFS@ -DEPDIR = @DEPDIR@ -DIFF_FLAGS = @DIFF_FLAGS@ -DLLTOOL = @DLLTOOL@ -DSYMUTIL = @DSYMUTIL@ -DUMPBIN = @DUMPBIN@ -ECHO_C = @ECHO_C@ -ECHO_N = @ECHO_N@ -ECHO_T = @ECHO_T@ -EGREP = @EGREP@ -EXEEXT = @EXEEXT@ -FGREP = @FGREP@ -GCOV = @GCOV@ -GENHTML = @GENHTML@ -GETTEXT_MACRO_VERSION = @GETTEXT_MACRO_VERSION@ -GMSGFMT = @GMSGFMT@ -GMSGFMT_015 = @GMSGFMT_015@ -GREP = @GREP@ -HELP2MAN = @HELP2MAN@ -INSTALL = @INSTALL@ -INSTALL_DATA = @INSTALL_DATA@ -INSTALL_PROGRAM = @INSTALL_PROGRAM@ -INSTALL_SCRIPT = @INSTALL_SCRIPT@ -INSTALL_STRIP_PROGRAM = @INSTALL_STRIP_PROGRAM@ -INTLLIBS = @INTLLIBS@ -INTL_MACOSX_LIBS = @INTL_MACOSX_LIBS@ -LCOV = @LCOV@ -LD = @LD@ -LDFLAGS = @LDFLAGS@ -LEX = @LEX@ -LEXLIB = @LEXLIB@ -LEX_OUTPUT_ROOT = @LEX_OUTPUT_ROOT@ -LIBCOB_CISAM = @LIBCOB_CISAM@ -LIBCOB_CPPFLAGS = @LIBCOB_CPPFLAGS@ -LIBCOB_DISAM = @LIBCOB_DISAM@ -LIBCOB_LIBS = @LIBCOB_LIBS@ -LIBCOB_VBISAM = @LIBCOB_VBISAM@ -LIBICONV = @LIBICONV@ -LIBINTL = @LIBINTL@ -LIBOBJS = @LIBOBJS@ -LIBS = @LIBS@ -LIBTOOL = @LIBTOOL@ -LIPO = @LIPO@ -LN_S = @LN_S@ -LTLIBICONV = @LTLIBICONV@ -LTLIBINTL = @LTLIBINTL@ -LTLIBOBJS = @LTLIBOBJS@ -LT_SYS_LIBRARY_PATH = @LT_SYS_LIBRARY_PATH@ -MAKE = @MAKE@ -MAKEINFO = @MAKEINFO@ -MANIFEST_TOOL = @MANIFEST_TOOL@ -MKDIR_P = @MKDIR_P@ -MSGFMT = @MSGFMT@ -MSGFMT_015 = @MSGFMT_015@ -MSGMERGE = @MSGMERGE@ -NM = @NM@ -NMEDIT = @NMEDIT@ -OBJDUMP = @OBJDUMP@ -OBJEXT = @OBJEXT@ -ODBC_CFLAGS = @ODBC_CFLAGS@ -ODBC_LIBS = @ODBC_LIBS@ -OTOOL = @OTOOL@ -OTOOL64 = @OTOOL64@ -PACKAGE = @PACKAGE@ -PACKAGE_BUGREPORT = @PACKAGE_BUGREPORT@ -PACKAGE_NAME = @PACKAGE_NAME@ -PACKAGE_STRING = @PACKAGE_STRING@ -PACKAGE_TARNAME = @PACKAGE_TARNAME@ -PACKAGE_URL = @PACKAGE_URL@ -PACKAGE_VERSION = @PACKAGE_VERSION@ -PATH_SEPARATOR = @PATH_SEPARATOR@ -PKG_CONFIG = @PKG_CONFIG@ -PKG_CONFIG_LIBDIR = @PKG_CONFIG_LIBDIR@ -PKG_CONFIG_PATH = @PKG_CONFIG_PATH@ -POSUB = @POSUB@ -RANLIB = @RANLIB@ -SED = @SED@ -SET_MAKE = @SET_MAKE@ -SHELL = @SHELL@ -STRIP = @STRIP@ -USE_NLS = @USE_NLS@ -VERSION = @VERSION@ -XGETTEXT = @XGETTEXT@ -XGETTEXT_015 = @XGETTEXT_015@ -XGETTEXT_EXTRA_OPTIONS = @XGETTEXT_EXTRA_OPTIONS@ -XML2_CFLAGS = @XML2_CFLAGS@ -XML2_LIBS = @XML2_LIBS@ -YACC = @YACC@ -YFLAGS = @YFLAGS@ -abs_builddir = @abs_builddir@ -abs_srcdir = @abs_srcdir@ -abs_top_builddir = @abs_top_builddir@ -abs_top_srcdir = @abs_top_srcdir@ -ac_ct_AR = @ac_ct_AR@ -ac_ct_CC = @ac_ct_CC@ -ac_ct_DUMPBIN = @ac_ct_DUMPBIN@ -am__include = @am__include@ -am__leading_dot = @am__leading_dot@ -am__quote = @am__quote@ -am__tar = @am__tar@ -am__untar = @am__untar@ -bindir = @bindir@ -build = @build@ -build_alias = @build_alias@ -build_cpu = @build_cpu@ -build_os = @build_os@ -build_vendor = @build_vendor@ -builddir = @builddir@ -configured_make = @configured_make@ -datadir = @datadir@ -datarootdir = @datarootdir@ -docdir = @docdir@ -dvidir = @dvidir@ -exec_prefix = @exec_prefix@ -host = @host@ -host_alias = @host_alias@ -host_cpu = @host_cpu@ -host_os = @host_os@ -host_vendor = @host_vendor@ -htmldir = @htmldir@ -includedir = @includedir@ -infodir = @infodir@ -install_sh = @install_sh@ -libdir = @libdir@ -libexecdir = @libexecdir@ -localedir = @localedir@ -localstatedir = @localstatedir@ -mandir = @mandir@ -mkdir_p = @mkdir_p@ -oldincludedir = @oldincludedir@ -pdfdir = @pdfdir@ -prefix = @prefix@ -program_transform_name = @program_transform_name@ -psdir = @psdir@ -runstatedir = @runstatedir@ -sbindir = @sbindir@ -sharedstatedir = @sharedstatedir@ -srcdir = @srcdir@ -sysconfdir = @sysconfdir@ -target_alias = @target_alias@ -top_build_prefix = @top_build_prefix@ -top_builddir = @top_builddir@ -top_srcdir = @top_srcdir@ -xml2_config_found = @xml2_config_found@ -copydir = @COB_COPY_DIR@ -copy_DATA = screenio.cpy sqlca.cpy sqlda.cpy xfhfcd.cpy xfhfcd3.cpy -EXTRA_DIST = $(copy_DATA) -all: all-am - -.SUFFIXES: -$(srcdir)/Makefile.in: $(srcdir)/Makefile.am $(am__configure_deps) - @for dep in $?; do \ - case '$(am__configure_deps)' in \ - *$$dep*) \ - ( cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh ) \ - && { if test -f $@; then exit 0; else break; fi; }; \ - exit 1;; \ - esac; \ - done; \ - echo ' cd $(top_srcdir) && $(AUTOMAKE) --gnu copy/Makefile'; \ - $(am__cd) $(top_srcdir) && \ - $(AUTOMAKE) --gnu copy/Makefile -Makefile: $(srcdir)/Makefile.in $(top_builddir)/config.status - @case '$?' in \ - *config.status*) \ - cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh;; \ - *) \ - echo ' cd $(top_builddir) && $(SHELL) ./config.status $(subdir)/$@ $(am__depfiles_maybe)'; \ - cd $(top_builddir) && $(SHELL) ./config.status $(subdir)/$@ $(am__depfiles_maybe);; \ - esac; - -$(top_builddir)/config.status: $(top_srcdir)/configure $(CONFIG_STATUS_DEPENDENCIES) - cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh - -$(top_srcdir)/configure: $(am__configure_deps) - cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh -$(ACLOCAL_M4): $(am__aclocal_m4_deps) - cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh -$(am__aclocal_m4_deps): - -mostlyclean-libtool: - -rm -f *.lo - -clean-libtool: - -rm -rf .libs _libs -install-copyDATA: $(copy_DATA) - @$(NORMAL_INSTALL) - @list='$(copy_DATA)'; test -n "$(copydir)" || list=; \ - if test -n "$$list"; then \ - echo " $(MKDIR_P) '$(DESTDIR)$(copydir)'"; \ - $(MKDIR_P) "$(DESTDIR)$(copydir)" || exit 1; \ - fi; \ - for p in $$list; do \ - if test -f "$$p"; then d=; else d="$(srcdir)/"; fi; \ - echo "$$d$$p"; \ - done | $(am__base_list) | \ - while read files; do \ - echo " $(INSTALL_DATA) $$files '$(DESTDIR)$(copydir)'"; \ - $(INSTALL_DATA) $$files "$(DESTDIR)$(copydir)" || exit $$?; \ - done - -uninstall-copyDATA: - @$(NORMAL_UNINSTALL) - @list='$(copy_DATA)'; test -n "$(copydir)" || list=; \ - files=`for p in $$list; do echo $$p; done | sed -e 's|^.*/||'`; \ - dir='$(DESTDIR)$(copydir)'; $(am__uninstall_files_from_dir) -tags TAGS: - -ctags CTAGS: - -cscope cscopelist: - - -distdir: $(DISTFILES) - @srcdirstrip=`echo "$(srcdir)" | sed 's/[].[^$$\\*]/\\\\&/g'`; \ - topsrcdirstrip=`echo "$(top_srcdir)" | sed 's/[].[^$$\\*]/\\\\&/g'`; \ - list='$(DISTFILES)'; \ - dist_files=`for file in $$list; do echo $$file; done | \ - sed -e "s|^$$srcdirstrip/||;t" \ - -e "s|^$$topsrcdirstrip/|$(top_builddir)/|;t"`; \ - case $$dist_files in \ - */*) $(MKDIR_P) `echo "$$dist_files" | \ - sed '/\//!d;s|^|$(distdir)/|;s,/[^/]*$$,,' | \ - sort -u` ;; \ - esac; \ - for file in $$dist_files; do \ - if test -f $$file || test -d $$file; then d=.; else d=$(srcdir); fi; \ - if test -d $$d/$$file; then \ - dir=`echo "/$$file" | sed -e 's,/[^/]*$$,,'`; \ - if test -d "$(distdir)/$$file"; then \ - find "$(distdir)/$$file" -type d ! -perm -700 -exec chmod u+rwx {} \;; \ - fi; \ - if test -d $(srcdir)/$$file && test $$d != $(srcdir); then \ - cp -fpR $(srcdir)/$$file "$(distdir)$$dir" || exit 1; \ - find "$(distdir)/$$file" -type d ! -perm -700 -exec chmod u+rwx {} \;; \ - fi; \ - cp -fpR $$d/$$file "$(distdir)$$dir" || exit 1; \ - else \ - test -f "$(distdir)/$$file" \ - || cp -p $$d/$$file "$(distdir)/$$file" \ - || exit 1; \ - fi; \ - done -check-am: all-am -check: check-am -all-am: Makefile $(DATA) -installdirs: - for dir in "$(DESTDIR)$(copydir)"; do \ - test -z "$$dir" || $(MKDIR_P) "$$dir"; \ - done -install: install-am -install-exec: install-exec-am -install-data: install-data-am -uninstall: uninstall-am - -install-am: all-am - @$(MAKE) $(AM_MAKEFLAGS) install-exec-am install-data-am - -installcheck: installcheck-am -install-strip: - if test -z '$(STRIP)'; then \ - $(MAKE) $(AM_MAKEFLAGS) INSTALL_PROGRAM="$(INSTALL_STRIP_PROGRAM)" \ - install_sh_PROGRAM="$(INSTALL_STRIP_PROGRAM)" INSTALL_STRIP_FLAG=-s \ - install; \ - else \ - $(MAKE) $(AM_MAKEFLAGS) INSTALL_PROGRAM="$(INSTALL_STRIP_PROGRAM)" \ - install_sh_PROGRAM="$(INSTALL_STRIP_PROGRAM)" INSTALL_STRIP_FLAG=-s \ - "INSTALL_PROGRAM_ENV=STRIPPROG='$(STRIP)'" install; \ - fi -mostlyclean-generic: - -clean-generic: - -distclean-generic: - -test -z "$(CONFIG_CLEAN_FILES)" || rm -f $(CONFIG_CLEAN_FILES) - -test . = "$(srcdir)" || test -z "$(CONFIG_CLEAN_VPATH_FILES)" || rm -f $(CONFIG_CLEAN_VPATH_FILES) - -maintainer-clean-generic: - @echo "This command is intended for maintainers to use" - @echo "it deletes files that may require special tools to rebuild." -clean: clean-am - -clean-am: clean-generic clean-libtool mostlyclean-am - -distclean: distclean-am - -rm -f Makefile -distclean-am: clean-am distclean-generic - -dvi: dvi-am - -dvi-am: - -html: html-am - -html-am: - -info: info-am - -info-am: - -install-data-am: install-copyDATA - -install-dvi: install-dvi-am - -install-dvi-am: - -install-exec-am: - -install-html: install-html-am - -install-html-am: - -install-info: install-info-am - -install-info-am: - -install-man: - -install-pdf: install-pdf-am - -install-pdf-am: - -install-ps: install-ps-am - -install-ps-am: - -installcheck-am: - -maintainer-clean: maintainer-clean-am - -rm -f Makefile -maintainer-clean-am: distclean-am maintainer-clean-generic - -mostlyclean: mostlyclean-am - -mostlyclean-am: mostlyclean-generic mostlyclean-libtool - -pdf: pdf-am - -pdf-am: - -ps: ps-am - -ps-am: - -uninstall-am: uninstall-copyDATA - -.MAKE: install-am install-strip - -.PHONY: all all-am check check-am clean clean-generic clean-libtool \ - cscopelist-am ctags-am distclean distclean-generic \ - distclean-libtool distdir dvi dvi-am html html-am info info-am \ - install install-am install-copyDATA install-data \ - install-data-am install-dvi install-dvi-am install-exec \ - install-exec-am install-html install-html-am install-info \ - install-info-am install-man install-pdf install-pdf-am \ - install-ps install-ps-am install-strip installcheck \ - installcheck-am installdirs maintainer-clean \ - maintainer-clean-generic mostlyclean mostlyclean-generic \ - mostlyclean-libtool pdf pdf-am ps ps-am tags-am uninstall \ - uninstall-am uninstall-copyDATA - -.PRECIOUS: Makefile - - -# Tell versions [3.59,3.63) of GNU make to not export all variables. -# Otherwise a system limit (for SysV at least) may be exceeded. -.NOEXPORT: diff -Nru gnucobol-4.0~early~20200606/copy/screenio.cpy gnucobol-5/copy/screenio.cpy --- gnucobol-4.0~early~20200606/copy/screenio.cpy 2020-06-06 20:52:02.000000000 +0000 +++ gnucobol-5/copy/screenio.cpy 1970-01-01 00:00:00.000000000 +0000 @@ -1,196 +0,0 @@ - *> Copyright (C) 2008-2012, 2015-2016, - *> 2019 Free Software Foundation, Inc. - *> Written by Roger While, Simon Sobisch - *> - *> This file is part of GnuCOBOL. - *> - *> The GnuCOBOL compiler is free software: you can redistribute - *> it and/or modify it under the terms of the GNU General Public - *> License as published by the Free Software Foundation, either - *> version 3 of the License, or (at your option) any later - *> version. - *> - *> GnuCOBOL is distributed in the hope that it will be useful, - *> but WITHOUT ANY WARRANTY; without even the implied warranty of - *> MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - *> GNU General Public License for more details. - *> - *> You should have received a copy of the GNU General Public - *> License along with GnuCOBOL. - *> If not, see . - - - *> Colors - 78 COB-COLOR-BLACK VALUE 0. - 78 COB-COLOR-BLUE VALUE 1. - 78 COB-COLOR-GREEN VALUE 2. - 78 COB-COLOR-CYAN VALUE 3. - 78 COB-COLOR-RED VALUE 4. - 78 COB-COLOR-MAGENTA VALUE 5. - 78 COB-COLOR-YELLOW VALUE 6. - 78 COB-COLOR-WHITE VALUE 7. - - *> mouse mask, apply to COB-MOUSE-FLAGS - 78 COB-AUTO-MOUSE-HANDLING VALUE 1. - 78 COB-ALLOW-LEFT-DOWN VALUE 2. - 78 COB-ALLOW-LEFT-UP VALUE 4. - 78 COB-ALLOW-LEFT-DOUBLE VALUE 8. - 78 COB-ALLOW-MIDDLE-DOWN VALUE 16. - 78 COB-ALLOW-MIDDLE-UP VALUE 32. - 78 COB-ALLOW-MIDDLE-DOUBLE VALUE 64. - 78 COB-ALLOW-RIGHT-DOWN VALUE 128. - 78 COB-ALLOW-RIGHT-UP VALUE 256. - 78 COB-ALLOW-RIGHT-DOUBLE VALUE 512. - 78 COB-ALLOW-MOUSE-MOVE VALUE 1024. - 78 COB-ALLOW-ALL-SCREEN-ACTIONS VALUE 16384. *> reserved - - *> Values that may be returned in CRT STATUS (or COB-CRT-STATUS) - *> Normal return - Value 0000 - 78 COB-SCR-OK VALUE 0. - - *> Function keys - Values 1xxx - 78 COB-SCR-F1 VALUE 1001. - 78 COB-SCR-F2 VALUE 1002. - 78 COB-SCR-F3 VALUE 1003. - 78 COB-SCR-F4 VALUE 1004. - 78 COB-SCR-F5 VALUE 1005. - 78 COB-SCR-F6 VALUE 1006. - 78 COB-SCR-F7 VALUE 1007. - 78 COB-SCR-F8 VALUE 1008. - 78 COB-SCR-F9 VALUE 1009. - 78 COB-SCR-F10 VALUE 1010. - 78 COB-SCR-F11 VALUE 1011. - 78 COB-SCR-F12 VALUE 1012. - 78 COB-SCR-F13 VALUE 1013. - 78 COB-SCR-F14 VALUE 1014. - 78 COB-SCR-F15 VALUE 1015. - 78 COB-SCR-F16 VALUE 1016. - 78 COB-SCR-F17 VALUE 1017. - 78 COB-SCR-F18 VALUE 1018. - 78 COB-SCR-F19 VALUE 1019. - 78 COB-SCR-F20 VALUE 1020. - 78 COB-SCR-F21 VALUE 1021. - 78 COB-SCR-F22 VALUE 1022. - 78 COB-SCR-F23 VALUE 1023. - 78 COB-SCR-F24 VALUE 1024. - 78 COB-SCR-F25 VALUE 1025. - 78 COB-SCR-F26 VALUE 1026. - 78 COB-SCR-F27 VALUE 1027. - 78 COB-SCR-F28 VALUE 1028. - 78 COB-SCR-F29 VALUE 1029. - 78 COB-SCR-F30 VALUE 1030. - 78 COB-SCR-F31 VALUE 1031. - 78 COB-SCR-F32 VALUE 1032. - 78 COB-SCR-F33 VALUE 1033. - 78 COB-SCR-F34 VALUE 1034. - 78 COB-SCR-F35 VALUE 1035. - 78 COB-SCR-F36 VALUE 1036. - 78 COB-SCR-F37 VALUE 1037. - 78 COB-SCR-F38 VALUE 1038. - 78 COB-SCR-F39 VALUE 1039. - 78 COB-SCR-F40 VALUE 1040. - 78 COB-SCR-F41 VALUE 1041. - 78 COB-SCR-F42 VALUE 1042. - 78 COB-SCR-F43 VALUE 1043. - 78 COB-SCR-F44 VALUE 1044. - 78 COB-SCR-F45 VALUE 1045. - 78 COB-SCR-F46 VALUE 1046. - 78 COB-SCR-F47 VALUE 1047. - 78 COB-SCR-F48 VALUE 1048. - 78 COB-SCR-F49 VALUE 1049. - 78 COB-SCR-F50 VALUE 1050. - 78 COB-SCR-F51 VALUE 1051. - 78 COB-SCR-F52 VALUE 1052. - 78 COB-SCR-F53 VALUE 1053. - 78 COB-SCR-F54 VALUE 1054. - 78 COB-SCR-F55 VALUE 1055. - 78 COB-SCR-F56 VALUE 1056. - 78 COB-SCR-F57 VALUE 1057. - 78 COB-SCR-F58 VALUE 1058. - 78 COB-SCR-F59 VALUE 1059. - 78 COB-SCR-F60 VALUE 1060. - 78 COB-SCR-F61 VALUE 1061. - 78 COB-SCR-F62 VALUE 1062. - 78 COB-SCR-F63 VALUE 1063. - 78 COB-SCR-F64 VALUE 1064. - *> Exception keys - Values 2xxx - 78 COB-SCR-PAGE-UP VALUE 2001. - 78 COB-SCR-PAGE-DOWN VALUE 2002. - 78 COB-SCR-KEY-UP VALUE 2003. - 78 COB-SCR-KEY-DOWN VALUE 2004. - 78 COB-SCR-ESC VALUE 2005. - 78 COB-SCR-PRINT VALUE 2006. - 78 COB-SCR-TAB VALUE 2007. - 78 COB-SCR-BACK-TAB VALUE 2008. - 78 COB-SCR-KEY-LEFT VALUE 2009. - 78 COB-SCR-KEY-RIGHT VALUE 2010. - *> The following exception keys are currently *only* returned - *> on ACCEPT OMITTED - 78 COB-SCR-INSERT VALUE 2011. - 78 COB-SCR-DELETE VALUE 2012. - 78 COB-SCR-BACKSPACE VALUE 2013. - 78 COB-SCR-KEY-HOME VALUE 2014. - 78 COB-SCR-KEY-END VALUE 2015. - *> Exception keys for mouse handling - 78 COB-SCR-MOUSE-MOVE VALUE 2040. - 78 COB-SCR-LEFT-PRESSED VALUE 2041. - 78 COB-SCR-LEFT-RELEASED VALUE 2042. - 78 COB-SCR-LEFT-DBL-CLICK VALUE 2043. - 78 COB-SCR-MID-PRESSED VALUE 2044. - 78 COB-SCR-MID-RELEASED VALUE 2045. - 78 COB-SCR-MID-DBL-CLICK VALUE 2046. - 78 COB-SCR-RIGHT-PRESSED VALUE 2047. - 78 COB-SCR-RIGHT-RELEASED VALUE 2048. - 78 COB-SCR-RIGHT-DBL-CLICK VALUE 2049. - 78 COB-SCR-SHIFT-MOVE VALUE 2050. - 78 COB-SCR-SHIFT-LEFT-PRESSED VALUE 2051. - 78 COB-SCR-SHIFT-LEFT-RELEASED VALUE 2052. - 78 COB-SCR-SHIFT-LEFT-DBL-CLICK VALUE 2053. - 78 COB-SCR-SHIFT-MID-PRESSED VALUE 2054. - 78 COB-SCR-SHIFT-MID-RELEASED VALUE 2055. - 78 COB-SCR-SHIFT-MID-DBL-CLICK VALUE 2056. - 78 COB-SCR-SHIFT-RIGHT-PRESSED VALUE 2057. - 78 COB-SCR-SHIFT-RIGHT-RELEASED VALUE 2058. - 78 COB-SCR-SHIFT-RIGHT-DBL-CLICK VALUE 2059. - 78 COB-SCR-CTRL-MOVE VALUE 2060. - 78 COB-SCR-CTRL-LEFT-PRESSED VALUE 2061. - 78 COB-SCR-CTRL-LEFT-RELEASED VALUE 2062. - 78 COB-SCR-CTRL-LEFT-DBL-CLICK VALUE 2063. - 78 COB-SCR-CTRL-MID-PRESSED VALUE 2064. - 78 COB-SCR-CTRL-MID-RELEASED VALUE 2065. - 78 COB-SCR-CTRL-MID-DBL-CLICK VALUE 2066. - 78 COB-SCR-CTRL-RIGHT-PRESSED VALUE 2067. - 78 COB-SCR-CTRL-RIGHT-RELEASED VALUE 2068. - 78 COB-SCR-CTRL-RIGHT-DBL-CLICK VALUE 2069. - 78 COB-SCR-ALT-MOVE VALUE 2070. - 78 COB-SCR-ALT-LEFT-PRESSED VALUE 2071. - 78 COB-SCR-ALT-LEFT-RELEASED VALUE 2072. - 78 COB-SCR-ALT-LEFT-DBL-CLICK VALUE 2073. - 78 COB-SCR-ALT-MID-PRESSED VALUE 2074. - 78 COB-SCR-ALT-MID-RELEASED VALUE 2075. - 78 COB-SCR-ALT-MID-DBL-CLICK VALUE 2076. - 78 COB-SCR-ALT-RIGHT-PRESSED VALUE 2077. - 78 COB-SCR-ALT-RIGHT-RELEASED VALUE 2078. - 78 COB-SCR-ALT-RIGHT-DBL-CLICK VALUE 2079. - 78 COB-SCR-WHEEL-UP VALUE 2080. - 78 COB-SCR-WHEEL-DOWN VALUE 2081. - *>78 COB-SCR-WHEEL-LEFT VALUE 2082. *reserved* - *>78 COB-SCR-WHEEL-RIGHT VALUE 2083. *reserved* - 78 COB-SCR-SHIFT-WHEEL-UP VALUE 2084. - 78 COB-SCR-SHIFT-WHEEL-DOWN VALUE 2085. - *>78 COB-SCR-SHIFT-WHEEL-LEFT VALUE 2086. *reserved* - *>78 COB-SCR-SHIFT-WHEEL-RIGHT VALUE 2087. *reserved* - 78 COB-SCR-CTRL-WHEEL-UP VALUE 2088. - 78 COB-SCR-CTRL-WHEEL-DOWN VALUE 2089. - *>78 COB-SCR-CTRL-WHEEL-LEFT VALUE 2090. *reserved* - *>78 COB-SCR-CTRL-WHEEL-RIGHT VALUE 2091. *reserved* - 78 COB-SCR-ALT-WHEEL-UP VALUE 2092. - 78 COB-SCR-ALT-WHEEL-DOWN VALUE 2093. - *>78 COB-SCR-ALT-WHEEL-LEFT VALUE 2094. *reserved* - *>78 COB-SCR-ALT-WHEEL-RIGHT VALUE 2095. *reserved* - *> Input validation - Values 8xxx - 78 COB-SCR-NO-FIELD VALUE 8000. - 78 COB-SCR-TIME-OUT VALUE 8001. - *> Other errors - Values 9xxx - 78 COB-SCR-FATAL VALUE 9000. - 78 COB-SCR-MAX-FIELD VALUE 9001. diff -Nru gnucobol-4.0~early~20200606/copy/sqlca.cpy gnucobol-5/copy/sqlca.cpy --- gnucobol-4.0~early~20200606/copy/sqlca.cpy 2020-06-06 20:52:02.000000000 +0000 +++ gnucobol-5/copy/sqlca.cpy 1970-01-01 00:00:00.000000000 +0000 @@ -1,24 +0,0 @@ - 01 SQLCA. - 03 SQLCAID PIC X(8) VALUE "SQLCA ". - 03 SQLCABC USAGE BINARY-LONG VALUE 136. - 03 SQLCODE USAGE BINARY-LONG VALUE 0. - 03 SQLERRM. - 05 SQLERRML USAGE BINARY-SHORT. - 05 SQLERRMC PIC X(70). - 03 SQLERRP PIC X(8). - 03 SQLERRD USAGE BINARY-LONG OCCURS 6. - 03 SQLWARN. - 05 SQLWARN0 PIC X. - 05 SQLWARN1 PIC X. - 05 SQLWARN2 PIC X. - 05 SQLWARN3 PIC X. - 05 SQLWARN4 PIC X. - 05 SQLWARN5 PIC X. - 05 SQLWARN6 PIC X. - 05 SQLWARN7 PIC X. - 05 SQLWARN8 PIC X. - 05 SQLWARN9 PIC X. - 05 SQLWARN10 PIC X. - 05 SQLWARNA REDEFINES SQLWARN10 PIC X. - 03 SQLSTATE PIC X(5). - 03 FILLER PIC X(21). diff -Nru gnucobol-4.0~early~20200606/copy/sqlda.cpy gnucobol-5/copy/sqlda.cpy --- gnucobol-4.0~early~20200606/copy/sqlda.cpy 2020-06-06 20:52:02.000000000 +0000 +++ gnucobol-5/copy/sqlda.cpy 1970-01-01 00:00:00.000000000 +0000 @@ -1,57 +0,0 @@ - 01 SQLDA. - 03 SQLDAID PIC X(8) VALUE "SQLDA ". - 03 SQLDABC USAGE BINARY-LONG VALUE 0. - 03 SQLN USAGE BINARY-SHORT VALUE 0. - 03 SQLD USAGE BINARY-SHORT VALUE 0. - 03 SQLVAR OCCURS 1 TO 1489 TIMES DEPENDING ON SQLD. - 05 SQLTYPE USAGE BINARY-SHORT. - 05 SQLLEN USAGE BINARY-SHORT. - 05 FILLER PIC X(4). - 05 SQLDATA USAGE POINTER. - 05 SQLIND USAGE POINTER. - 05 SQLNAME. - 07 SQLNAMEL PIC USAGE BINARY-SHORT. - 07 SQLNAMEC PIC X(30). - - *> SQLTYPE - - 78 ESQL-DATE-CHAR VALUE 384. - 78 ESQL-DATE-CHAR-NULL VALUE 385. - 78 ESQL-DATE-REC VALUE 386. - 78 ESQL-DATE-REC-NULL VALUE 387. - 78 ESQL-TIME-CHAR VALUE 388. - 78 ESQL-TIME-CHAR-NULL VALUE 389. - 78 ESQL-TIME-REC VALUE 390. - 78 ESQL-TIME-REC-NULL VALUE 391. - 78 ESQL-TIMESTAMP-CHAR VALUE 392. - 78 ESQL-TIMESTAMP-CHAR-NULL VALUE 393. - 78 ESQL-TIMESTAMP-REC VALUE 394. - 78 ESQL-TIMESTAMP-REC-NULL VALUE 395. - 78 ESQL-LONGVARBINARY VALUE 404. - 78 ESQL-LONGVARBINARY-NULL VALUE 405. - 78 ESQL-LONGVARCHAR VALUE 408. - 78 ESQL-LONGVARCHAR-NULL VALUE 409. - 78 ESQL-BINARY VALUE 444. - 78 ESQL-BINARY-NULL VALUE 445. - 78 ESQL-VARBINARY VALUE 446. - 78 ESQL-VARBINARY-NULL VALUE 447. - 78 ESQL-VARCHAR VALUE 448. - 78 ESQL-VARCHAR-NULL VALUE 449. - 78 ESQL-CHARVARYING VALUE 450. - 78 ESQL-CHARVARYING-NULL VALUE 451. - 78 ESQL-CHAR VALUE 452. - 78 ESQL-CHAR-NULL VALUE 453. - 78 ESQL-CHAR-FIXED VALUE 454. - 78 ESQL-CHAR-FIXED-NULL VALUE 455. - 78 ESQL-DOUBLE VALUE 480. - 78 ESQL-DOUBLE-NULL VALUE 481. - 78 ESQL-REAL VALUE 482. - 78 ESQL-REAL-NULL VALUE 483. - 78 ESQL-DECIMAL VALUE 484. - 78 ESQL-DECIMAL-NULL VALUE 485. - 78 ESQL-INTEGER VALUE 496. - 78 ESQL-INTEGER-NULL VALUE 497. - 78 ESQL-SMALLINT VALUE 500. - 78 ESQL-SMALLINT-NULL VALUE 501. - 78 ESQL-TINYINT VALUE 502. - 78 ESQL-TINYINT-NULL VALUE 503. diff -Nru gnucobol-4.0~early~20200606/copy/xfhfcd3.cpy gnucobol-5/copy/xfhfcd3.cpy --- gnucobol-4.0~early~20200606/copy/xfhfcd3.cpy 2020-06-06 20:52:02.000000000 +0000 +++ gnucobol-5/copy/xfhfcd3.cpy 1970-01-01 00:00:00.000000000 +0000 @@ -1,321 +0,0 @@ - *> - *>* File control descriptor (FCD3) - *>* used by the callable file handler - *> - 40 FCD-FILE-STATUS. - 42 FCD-STATUS-KEY-1 pic x. - 42 FCD-STATUS-KEY-2 pic x. - 42 FCD-BINARY redefines FCD-STATUS-KEY-2 - pic x comp-x. - - 40 FCD-LENGTH pic xx comp-x. - 40 FCD-VERSION pic x comp-x. - 78 fcd--version-number value 1. - - 40 FCD-ORGANIZATION pic x comp-x. - 78 fcd--line-sequential-org value 0. - 78 fcd--sequential-org value 1. - 78 fcd--indexed-org value 2. - 78 fcd--relative-org value 3. - *> see opcode 0006: - 78 fcd--determine-org value 255. - - 40 FCD-ACCESS-MODE pic x comp-x. - 78 fcd--sequential-access value 0. - 78 fcd--dup-prime-access value 1. - 78 fcd--random-access value 4. - 78 fcd--dynamic-access value 8. - 78 fcd--status-defined value h"80". - - *> open mode - 40 FCD-OPEN-MODE pic x comp-x. - 78 fcd--open-input value 0. - 78 fcd--open-output value 1. - 78 fcd--open-i-o value 2. - 78 fcd--open-extend value 3. - 78 fcd--open-max value 3. - 78 fcd--open-closed value 128. - - *> recording mode - 40 FCD-RECORDING-MODE pic x comp-x. - 78 fcd--recmode-fixed value 0. - 78 fcd--recmode-variable value 1. - - 40 FCD-FILE-FORMAT pic x comp-x. - 78 fcd--format-liiv1 value 0. - 78 fcd--format-cisam value 1. - 78 fcd--format-liiv2 value 2. - 78 fcd--format-cobol2 value 3. - 78 fcd--format-idx4 value 4. - 78 fcd--format-btrieve-ansi value 5. - 78 fcd--format-btrieve-non-ansi value 6. - *> 78 fcd--format-rlio value 7. - 78 fcd--format-big value 8. - 78 fcd--format-leafrec value 9. - 78 fcd--format-cst value 10. - 78 fcd--format-mvs-print value 11. - *> 78 value 13. - 78 fcd--format-heap value 14. - 78 fcd--format-esds value 15. - 78 fcd--format-disam value 16. - 78 fcd--format-vbisam value 17. - 78 fcd--format-bdb value 18. - 78 fcd--format-lmdb value 19. - 78 fcd--format-odbc value 20. - 78 fcd--format-oci value 21. - 78 fcd--format-qsamv value 255. - *> 1 greater than max permissible format: - 78 fcd--max-file-format value 22. - - 40 FCD-DEVICE-FLAG Pic x comp-x. - 78 fcd--dev-normal value 0. - 78 fcd--dev-device value 1. - 78 fcd--dev-stdin value 2. - 78 fcd--dev-stdout value 3. - 78 fcd--dev-stderr value 4. - 78 fcd--dev-badname value 5. - 78 fcd--dev-input-pipe value 6. - 78 fcd--dev-output-pipe value 7. - 78 fcd--dev-i-o-pipe value 8. - 78 fcd--dev-library value 9. - 78 fcd--dev-disk-file value 10. - 78 fcd--dev-null value 11. - 78 fcd--dev-disk-redir value 12. - 78 fcd--dev-no-map value 13. - - 40 FCD-LOCK-ACTION pic x comp-x. - *> Used only in c-isam type calls... - 78 fcd--getlock value 1. - 78 fcd--nolock value 2. - 78 fcd--ignorelock value 3. - - 40 FCD-DATA-COMPRESS pic x comp-x. - - 40 FCD-BLOCKING pic x comp-x. - 40 FCD-additional-status redefines FCD-blocking - pic x comp-x. - - 40 FCD-IDXCACHE-SIZE pic x comp-x. - - 40 FCD-PERCENT pic x comp-x. - 40 FCD-REC-COUNT-SET redefines FCD-PERCENT - pic x comp-x. - - 40 FCD-BLOCK-SIZE pic x comp-x. - - 40 FCD-FLAGS-1 pic x comp-x. - 78 fcd--mainframe-compat value h"80". - 78 fcd--ansi-line-adv value h"40". - 78 fcd--return-key-only value h"20". - 78 fcd--bypass-esds value h"10". - 78 fcd--no-xfhname-mapping value h"08". - 78 fcd--dont-call-xfhtrace value h"04". - 78 fcd--call-xfhtrace value h"02". - *> declaratives exist: - 78 fcd--fcd-decl value h"01". - - 40 FCD-FLAGS-2 pic x comp-x. - 78 fcd--convert-dbspace value h"01". - - *> MVS flag bits - 40 fcd-mvs-flags pic x comp-x. - 78 fcd--file-is-syspunch value h"10". - 78 fcd--file-is-indd value h"08". - 78 fcd--file-is-outdd value h"04". - 78 fcd--amode-31bit value h"02". - 78 fcd--amode-24bit value h"01". - 78 fcd--amode-bits value - fcd--amode-31bit - + fcd--amode-24bit. - - 40 FCD-STATUS-TYPE pic x comp-x. - 78 fcd--ans85-status value h"80". - 78 fcd--no-space-fill value h"40". - 78 fcd--no-strip-spaces value h"20". - 78 fcd--no-expand-tabs value h"10". - 78 fcd--rec-term-bit value h"08". - 78 fcd--insert-tabs value h"04". - 78 fcd--insert-nulls value h"02". - 78 fcd--cr-delimiter value h"01". - 78 fcd--modify-writes value - fcd--insert-tabs - + fcd--insert-nulls. - - 40 FCD-OTHER-FLAGS pic x comp-x. - 78 fcd--optional-file value h"80". - 78 fcd--nodetectlock-input value h"40". - 78 fcd--not-optional value h"20". - 78 fcd--external-name value h"10". - 78 fcd--get-info value h"08". - 78 fcd--nodetectlock value h"04". - 78 fcd--multiple-reel value h"02". - 78 fcd--line-advancing value h"01". - 78 fcd--special-sequential value - fcd--optional-file - + fcd--multiple-reel - + fcd--line-advancing. - - 40 FCD-TRANS-LOG pic x comp-x. - 78 fcd--open-input-shared value h"80". - 78 fcd--allow-input-locks value h"40". - 78 fcd--no-read-sema value h"20". - 78 fcd--expand-positioning-bit value h"10". - - 78 fcd--no-seq-check value h"08". - 78 fcd--dat-term-bit value h"04". - 78 fcd--slow-read value h"02". - 78 fcd--suppress-adv value h"01". - - 40 FCD-LOCKTYPES pic x comp-x. - 78 fcd--interlang-locking value h"80". - 78 fcd--allow-readers value h"40". - 78 fcd--separate-lock-file value h"20". - 78 fcd--single-open value h"10". - 78 fcd--nfs-file-lock value h"08". - 78 fcd--nfs-file-lock-hp value h"04". - 78 fcd--nfs-file-locks value - fcd--nfs-file-lock - + fcd--nfs-file-lock-hp. - - 40 FCD-FS-FLAGS pic x comp-x. - 78 fcd--transaction-processing-bit value h"80". - 78 fcd--recovery-run-b value h"04". - 78 fcd--fs-server-bit value h"02". - - 40 FCD-CONFIG-FLAGS pic x comp-x. - 78 fcd--writethru-bit value h"80". - 78 fcd--relative-bit value h"40". - 78 fcd--set-crp-bit value h"20". - 78 fcd--bigfile-bit value h"10". - *> 78 fcd--return-percent value h"08". - *> 78 fcd--dont-call-xfhconv value h"04". - 78 fcd--call-cobfstatconv value h"02". - 78 fcd--ignorelock-bit value h"01". - - 40 FCD-MISC-FLAGS pic x comp-x. - 78 fcd--mainframe-hostfd value h"80". - 78 fcd--set-idxdatbuf value h"40". - 78 fcd--load-onto-heap value h"20". - 78 fcd--usage-unknown value h"10". - 78 fcd--recmode-s value h"08". - 78 fcd--recmode-u value h"04". - 78 fcd--external-fcd value h"02". - 78 fcd--closed-with-lock value h"01". - - 40 FCD-CONFIG-FLAGS2 pic x comp-x. - 78 fcd--file-is-ebcdic value h"80". - 78 fcd--file-has-write-after value h"40". - 78 fcd--file-has-write-before value h"20". - 78 fcd--file-has-adv-specified value h"10". - 78 fcd--no-min-len-check value h"08". - 78 fcd--no-key-check value h"04". - 78 fcd--convert-to-ascii value h"02". - 78 fcd--rm-behaviour value h"01". - 78 fcd--file-has-before-or-after value - fcd--file-has-write-before - + fcd--file-has-write-after. - - 40 FCD-LOCK-MODE pic x comp-x. - 78 fcd--multilock-bit value h"80". - 78 fcd--writelock-bit value h"40". - 78 fcd--retry-open-bit value h"20". - 78 fcd--skip-lock-bit value h"10". - 78 fcd--retry-lock-bit value h"08". - 78 fcd--manual-lock-bit value h"04". - 78 fcd--auto-lock-bit value h"02". - 78 fcd--exclusive-bit value h"01". - 78 fcd--sharing-bits value - fcd--manual-lock-bit - + fcd--auto-lock-bit. - - - 40 FCD-SHR2 pic x comp-x. - 78 fcd--file-max-bit value h"08". - 78 fcd--file-pointer-bit value h"04". - 78 fcd--retry-time-bit value h"02". - 78 fcd--start-unlock value h"01". - - 40 FCD-IDXCACHE-BUFFS pic x comp-x. - - 40 FCD-INTERNAL-FLAGS-1 pic x comp-x. - 40 FCD-INTERNAL-FLAGS-2 pic x comp-x. - 40 pic x(15). - - *> NLS id (else 0) - 40 FCD-NLS-ID pic xx comp-x. - - 40 FCD-FS-FILE-ID pic xx comp-x. - - 40 fcd-retry-open-count pic xx comp-x. - - 40 FCD-NAME-LENGTH pic xx comp-x. - - 40 fcd-idxname-length pic xx comp-x. - 40 fcd-retry-count pic xx comp-x. - *> Indexed key identifier - 40 FCD-KEY-ID pic xx comp-x. - *> Line count (seq files) - 40 FCD-LINE-COUNT pic xx comp-x. - - 40 FCD-USE-FILES pic x comp-x. - 40 FCD-GIVE-FILES pic x comp-x. - *> Effective key length - 40 FCD-KEY-LENGTH pic xx comp-x. - - 40 pic x(20). - - *> Current record length - 40 FCD-CURRENT-REC-LEN pic x(4) comp-x. - *> Minimum record length - 40 FCD-MIN-REC-LENGTH pic x(4) comp-x. - *> Max record length - 40 FCD-MAX-REC-LENGTH pic x(4) comp-x. - - 40 FCD-SESSION-ID pic x(4) comp-x. - - 40 pic x(24). - - 40 FCD-RELADDR-OFFSET pic x(8) comp-x. - 40 FCD-RELADDR redefines FCD-RELADDR-OFFSET - pic x(8) comp-x. - 40 FCD-RELADDR-BIG redefines FCD-RELADDR-OFFSET - pic x(8) comp-x. - 40 FCD-MAX-REL-KEY pic x(8) comp-x. - - 40 FCD-RELATIVE-KEY pic x(8) comp-x. - - 40 FCD-PTR-FILLER1 pic x(8). - 40 FCD-HANDLE redefines FCD-PTR-FILLER1 - usage pointer. - 40 FCD-HANDLE-NUM redefines FCD-PTR-FILLER1 - pic x(4) comp-x. - *> Pointer to record area - 40 FCD-PTR-FILLER2 pic x(8). - 40 FCD-RECORD-ADDRESS redefines FCD-PTR-FILLER2 - usage pointer. - *> Pointer to file name - 40 FCD-PTR-FILLER3 pic x(8). - 40 FCD-FILENAME-ADDRESS redefines FCD-PTR-FILLER3 - usage pointer. - *> Pointer to index name (applies only if separate index file exists) - 40 FCD-PTR-FILLER4 pic x(8). - 40 FCD-IDXNAME-ADDRESS redefines FCD-PTR-FILLER4 - usage pointer. - 40 FCD-INDEX-NAME redefines FCD-PTR-FILLER4 - usage pointer. - *> Pointer to key def block - 40 FCD-PTR-FILLER5 pic x(8). - 40 FCD-KEY-DEF-ADDRESS redefines FCD-PTR-FILLER5 - usage pointer. - *> Pointer to collating seq - 40 FCD-PTR-FILLER6 pic x(8). - 40 FCD-COL-SEQ-ADDRESS redefines FCD-PTR-FILLER6 - usage pointer. - *> Pointer to using list - 40 FCD-PTR-FILLER7 pic x(8). - 40 FCD-FILDEF-ADDRESS redefines FCD-PTR-FILLER7 - usage pointer. - - 40 FCD-PTR-FILLER8 pic x(8). - 40 FCD-DFSORT-ADDRESS redefines FCD-PTR-FILLER8 - usage pointer. diff -Nru gnucobol-4.0~early~20200606/copy/xfhfcd.cpy gnucobol-5/copy/xfhfcd.cpy --- gnucobol-4.0~early~20200606/copy/xfhfcd.cpy 2020-06-06 20:52:02.000000000 +0000 +++ gnucobol-5/copy/xfhfcd.cpy 1970-01-01 00:00:00.000000000 +0000 @@ -1 +0,0 @@ - copy "xfhfcd3.cpy". diff -Nru gnucobol-4.0~early~20200606/COPYING gnucobol-5/COPYING --- gnucobol-4.0~early~20200606/COPYING 2020-06-06 20:52:02.000000000 +0000 +++ gnucobol-5/COPYING 1970-01-01 00:00:00.000000000 +0000 @@ -1,674 +0,0 @@ - GNU GENERAL PUBLIC LICENSE - Version 3, 29 June 2007 - - Copyright (C) 2007 Free Software Foundation, Inc. - Everyone is permitted to copy and distribute verbatim copies - of this license document, but changing it is not allowed. - - Preamble - - The GNU General Public License is a free, copyleft license for -software and other kinds of works. - - The licenses for most software and other practical works are designed -to take away your freedom to share and change the works. By contrast, -the GNU General Public License is intended to guarantee your freedom to -share and change all versions of a program--to make sure it remains free -software for all its users. We, the Free Software Foundation, use the -GNU General Public License for most of our software; it applies also to -any other work released this way by its authors. You can apply it to -your programs, too. - - When we speak of free software, we are referring to freedom, not -price. Our General Public Licenses are designed to make sure that you -have the freedom to distribute copies of free software (and charge for -them if you wish), that you receive source code or can get it if you -want it, that you can change the software or use pieces of it in new -free programs, and that you know you can do these things. - - To protect your rights, we need to prevent others from denying you -these rights or asking you to surrender the rights. Therefore, you have -certain responsibilities if you distribute copies of the software, or if -you modify it: responsibilities to respect the freedom of others. - - For example, if you distribute copies of such a program, whether -gratis or for a fee, you must pass on to the recipients the same -freedoms that you received. You must make sure that they, too, receive -or can get the source code. And you must show them these terms so they -know their rights. - - Developers that use the GNU GPL protect your rights with two steps: -(1) assert copyright on the software, and (2) offer you this License -giving you legal permission to copy, distribute and/or modify it. - - For the developers' and authors' protection, the GPL clearly explains -that there is no warranty for this free software. For both users' and -authors' sake, the GPL requires that modified versions be marked as -changed, so that their problems will not be attributed erroneously to -authors of previous versions. - - Some devices are designed to deny users access to install or run -modified versions of the software inside them, although the manufacturer -can do so. This is fundamentally incompatible with the aim of -protecting users' freedom to change the software. The systematic -pattern of such abuse occurs in the area of products for individuals to -use, which is precisely where it is most unacceptable. Therefore, we -have designed this version of the GPL to prohibit the practice for those -products. If such problems arise substantially in other domains, we -stand ready to extend this provision to those domains in future versions -of the GPL, as needed to protect the freedom of users. - - Finally, every program is threatened constantly by software patents. -States should not allow patents to restrict development and use of -software on general-purpose computers, but in those that do, we wish to -avoid the special danger that patents applied to a free program could -make it effectively proprietary. To prevent this, the GPL assures that -patents cannot be used to render the program non-free. - - The precise terms and conditions for copying, distribution and -modification follow. - - TERMS AND CONDITIONS - - 0. Definitions. - - "This License" refers to version 3 of the GNU General Public License. - - "Copyright" also means copyright-like laws that apply to other kinds of -works, such as semiconductor masks. - - "The Program" refers to any copyrightable work licensed under this -License. Each licensee is addressed as "you". "Licensees" and -"recipients" may be individuals or organizations. - - To "modify" a work means to copy from or adapt all or part of the work -in a fashion requiring copyright permission, other than the making of an -exact copy. The resulting work is called a "modified version" of the -earlier work or a work "based on" the earlier work. - - A "covered work" means either the unmodified Program or a work based -on the Program. - - To "propagate" a work means to do anything with it that, without -permission, would make you directly or secondarily liable for -infringement under applicable copyright law, except executing it on a -computer or modifying a private copy. Propagation includes copying, -distribution (with or without modification), making available to the -public, and in some countries other activities as well. - - To "convey" a work means any kind of propagation that enables other -parties to make or receive copies. Mere interaction with a user through -a computer network, with no transfer of a copy, is not conveying. - - An interactive user interface displays "Appropriate Legal Notices" -to the extent that it includes a convenient and prominently visible -feature that (1) displays an appropriate copyright notice, and (2) -tells the user that there is no warranty for the work (except to the -extent that warranties are provided), that licensees may convey the -work under this License, and how to view a copy of this License. If -the interface presents a list of user commands or options, such as a -menu, a prominent item in the list meets this criterion. - - 1. Source Code. - - The "source code" for a work means the preferred form of the work -for making modifications to it. "Object code" means any non-source -form of a work. - - A "Standard Interface" means an interface that either is an official -standard defined by a recognized standards body, or, in the case of -interfaces specified for a particular programming language, one that -is widely used among developers working in that language. - - The "System Libraries" of an executable work include anything, other -than the work as a whole, that (a) is included in the normal form of -packaging a Major Component, but which is not part of that Major -Component, and (b) serves only to enable use of the work with that -Major Component, or to implement a Standard Interface for which an -implementation is available to the public in source code form. A -"Major Component", in this context, means a major essential component -(kernel, window system, and so on) of the specific operating system -(if any) on which the executable work runs, or a compiler used to -produce the work, or an object code interpreter used to run it. - - The "Corresponding Source" for a work in object code form means all -the source code needed to generate, install, and (for an executable -work) run the object code and to modify the work, including scripts to -control those activities. However, it does not include the work's -System Libraries, or general-purpose tools or generally available free -programs which are used unmodified in performing those activities but -which are not part of the work. For example, Corresponding Source -includes interface definition files associated with source files for -the work, and the source code for shared libraries and dynamically -linked subprograms that the work is specifically designed to require, -such as by intimate data communication or control flow between those -subprograms and other parts of the work. - - The Corresponding Source need not include anything that users -can regenerate automatically from other parts of the Corresponding -Source. - - The Corresponding Source for a work in source code form is that -same work. - - 2. Basic Permissions. - - All rights granted under this License are granted for the term of -copyright on the Program, and are irrevocable provided the stated -conditions are met. This License explicitly affirms your unlimited -permission to run the unmodified Program. The output from running a -covered work is covered by this License only if the output, given its -content, constitutes a covered work. This License acknowledges your -rights of fair use or other equivalent, as provided by copyright law. - - You may make, run and propagate covered works that you do not -convey, without conditions so long as your license otherwise remains -in force. You may convey covered works to others for the sole purpose -of having them make modifications exclusively for you, or provide you -with facilities for running those works, provided that you comply with -the terms of this License in conveying all material for which you do -not control copyright. Those thus making or running the covered works -for you must do so exclusively on your behalf, under your direction -and control, on terms that prohibit them from making any copies of -your copyrighted material outside their relationship with you. - - Conveying under any other circumstances is permitted solely under -the conditions stated below. Sublicensing is not allowed; section 10 -makes it unnecessary. - - 3. Protecting Users' Legal Rights From Anti-Circumvention Law. - - No covered work shall be deemed part of an effective technological -measure under any applicable law fulfilling obligations under article -11 of the WIPO copyright treaty adopted on 20 December 1996, or -similar laws prohibiting or restricting circumvention of such -measures. - - When you convey a covered work, you waive any legal power to forbid -circumvention of technological measures to the extent such circumvention -is effected by exercising rights under this License with respect to -the covered work, and you disclaim any intention to limit operation or -modification of the work as a means of enforcing, against the work's -users, your or third parties' legal rights to forbid circumvention of -technological measures. - - 4. Conveying Verbatim Copies. - - You may convey verbatim copies of the Program's source code as you -receive it, in any medium, provided that you conspicuously and -appropriately publish on each copy an appropriate copyright notice; -keep intact all notices stating that this License and any -non-permissive terms added in accord with section 7 apply to the code; -keep intact all notices of the absence of any warranty; and give all -recipients a copy of this License along with the Program. - - You may charge any price or no price for each copy that you convey, -and you may offer support or warranty protection for a fee. - - 5. Conveying Modified Source Versions. - - You may convey a work based on the Program, or the modifications to -produce it from the Program, in the form of source code under the -terms of section 4, provided that you also meet all of these conditions: - - a) The work must carry prominent notices stating that you modified - it, and giving a relevant date. - - b) The work must carry prominent notices stating that it is - released under this License and any conditions added under section - 7. This requirement modifies the requirement in section 4 to - "keep intact all notices". - - c) You must license the entire work, as a whole, under this - License to anyone who comes into possession of a copy. This - License will therefore apply, along with any applicable section 7 - additional terms, to the whole of the work, and all its parts, - regardless of how they are packaged. This License gives no - permission to license the work in any other way, but it does not - invalidate such permission if you have separately received it. - - d) If the work has interactive user interfaces, each must display - Appropriate Legal Notices; however, if the Program has interactive - interfaces that do not display Appropriate Legal Notices, your - work need not make them do so. - - A compilation of a covered work with other separate and independent -works, which are not by their nature extensions of the covered work, -and which are not combined with it such as to form a larger program, -in or on a volume of a storage or distribution medium, is called an -"aggregate" if the compilation and its resulting copyright are not -used to limit the access or legal rights of the compilation's users -beyond what the individual works permit. Inclusion of a covered work -in an aggregate does not cause this License to apply to the other -parts of the aggregate. - - 6. Conveying Non-Source Forms. - - You may convey a covered work in object code form under the terms -of sections 4 and 5, provided that you also convey the -machine-readable Corresponding Source under the terms of this License, -in one of these ways: - - a) Convey the object code in, or embodied in, a physical product - (including a physical distribution medium), accompanied by the - Corresponding Source fixed on a durable physical medium - customarily used for software interchange. - - b) Convey the object code in, or embodied in, a physical product - (including a physical distribution medium), accompanied by a - written offer, valid for at least three years and valid for as - long as you offer spare parts or customer support for that product - model, to give anyone who possesses the object code either (1) a - copy of the Corresponding Source for all the software in the - product that is covered by this License, on a durable physical - medium customarily used for software interchange, for a price no - more than your reasonable cost of physically performing this - conveying of source, or (2) access to copy the - Corresponding Source from a network server at no charge. - - c) Convey individual copies of the object code with a copy of the - written offer to provide the Corresponding Source. This - alternative is allowed only occasionally and noncommercially, and - only if you received the object code with such an offer, in accord - with subsection 6b. - - d) Convey the object code by offering access from a designated - place (gratis or for a charge), and offer equivalent access to the - Corresponding Source in the same way through the same place at no - further charge. You need not require recipients to copy the - Corresponding Source along with the object code. If the place to - copy the object code is a network server, the Corresponding Source - may be on a different server (operated by you or a third party) - that supports equivalent copying facilities, provided you maintain - clear directions next to the object code saying where to find the - Corresponding Source. Regardless of what server hosts the - Corresponding Source, you remain obligated to ensure that it is - available for as long as needed to satisfy these requirements. - - e) Convey the object code using peer-to-peer transmission, provided - you inform other peers where the object code and Corresponding - Source of the work are being offered to the general public at no - charge under subsection 6d. - - A separable portion of the object code, whose source code is excluded -from the Corresponding Source as a System Library, need not be -included in conveying the object code work. - - A "User Product" is either (1) a "consumer product", which means any -tangible personal property which is normally used for personal, family, -or household purposes, or (2) anything designed or sold for incorporation -into a dwelling. In determining whether a product is a consumer product, -doubtful cases shall be resolved in favor of coverage. For a particular -product received by a particular user, "normally used" refers to a -typical or common use of that class of product, regardless of the status -of the particular user or of the way in which the particular user -actually uses, or expects or is expected to use, the product. A product -is a consumer product regardless of whether the product has substantial -commercial, industrial or non-consumer uses, unless such uses represent -the only significant mode of use of the product. - - "Installation Information" for a User Product means any methods, -procedures, authorization keys, or other information required to install -and execute modified versions of a covered work in that User Product from -a modified version of its Corresponding Source. The information must -suffice to ensure that the continued functioning of the modified object -code is in no case prevented or interfered with solely because -modification has been made. - - If you convey an object code work under this section in, or with, or -specifically for use in, a User Product, and the conveying occurs as -part of a transaction in which the right of possession and use of the -User Product is transferred to the recipient in perpetuity or for a -fixed term (regardless of how the transaction is characterized), the -Corresponding Source conveyed under this section must be accompanied -by the Installation Information. But this requirement does not apply -if neither you nor any third party retains the ability to install -modified object code on the User Product (for example, the work has -been installed in ROM). - - The requirement to provide Installation Information does not include a -requirement to continue to provide support service, warranty, or updates -for a work that has been modified or installed by the recipient, or for -the User Product in which it has been modified or installed. Access to a -network may be denied when the modification itself materially and -adversely affects the operation of the network or violates the rules and -protocols for communication across the network. - - Corresponding Source conveyed, and Installation Information provided, -in accord with this section must be in a format that is publicly -documented (and with an implementation available to the public in -source code form), and must require no special password or key for -unpacking, reading or copying. - - 7. Additional Terms. - - "Additional permissions" are terms that supplement the terms of this -License by making exceptions from one or more of its conditions. -Additional permissions that are applicable to the entire Program shall -be treated as though they were included in this License, to the extent -that they are valid under applicable law. If additional permissions -apply only to part of the Program, that part may be used separately -under those permissions, but the entire Program remains governed by -this License without regard to the additional permissions. - - When you convey a copy of a covered work, you may at your option -remove any additional permissions from that copy, or from any part of -it. (Additional permissions may be written to require their own -removal in certain cases when you modify the work.) You may place -additional permissions on material, added by you to a covered work, -for which you have or can give appropriate copyright permission. - - Notwithstanding any other provision of this License, for material you -add to a covered work, you may (if authorized by the copyright holders of -that material) supplement the terms of this License with terms: - - a) Disclaiming warranty or limiting liability differently from the - terms of sections 15 and 16 of this License; or - - b) Requiring preservation of specified reasonable legal notices or - author attributions in that material or in the Appropriate Legal - Notices displayed by works containing it; or - - c) Prohibiting misrepresentation of the origin of that material, or - requiring that modified versions of such material be marked in - reasonable ways as different from the original version; or - - d) Limiting the use for publicity purposes of names of licensors or - authors of the material; or - - e) Declining to grant rights under trademark law for use of some - trade names, trademarks, or service marks; or - - f) Requiring indemnification of licensors and authors of that - material by anyone who conveys the material (or modified versions of - it) with contractual assumptions of liability to the recipient, for - any liability that these contractual assumptions directly impose on - those licensors and authors. - - All other non-permissive additional terms are considered "further -restrictions" within the meaning of section 10. If the Program as you -received it, or any part of it, contains a notice stating that it is -governed by this License along with a term that is a further -restriction, you may remove that term. If a license document contains -a further restriction but permits relicensing or conveying under this -License, you may add to a covered work material governed by the terms -of that license document, provided that the further restriction does -not survive such relicensing or conveying. - - If you add terms to a covered work in accord with this section, you -must place, in the relevant source files, a statement of the -additional terms that apply to those files, or a notice indicating -where to find the applicable terms. - - Additional terms, permissive or non-permissive, may be stated in the -form of a separately written license, or stated as exceptions; -the above requirements apply either way. - - 8. Termination. - - You may not propagate or modify a covered work except as expressly -provided under this License. Any attempt otherwise to propagate or -modify it is void, and will automatically terminate your rights under -this License (including any patent licenses granted under the third -paragraph of section 11). - - However, if you cease all violation of this License, then your -license from a particular copyright holder is reinstated (a) -provisionally, unless and until the copyright holder explicitly and -finally terminates your license, and (b) permanently, if the copyright -holder fails to notify you of the violation by some reasonable means -prior to 60 days after the cessation. - - Moreover, your license from a particular copyright holder is -reinstated permanently if the copyright holder notifies you of the -violation by some reasonable means, this is the first time you have -received notice of violation of this License (for any work) from that -copyright holder, and you cure the violation prior to 30 days after -your receipt of the notice. - - Termination of your rights under this section does not terminate the -licenses of parties who have received copies or rights from you under -this License. If your rights have been terminated and not permanently -reinstated, you do not qualify to receive new licenses for the same -material under section 10. - - 9. Acceptance Not Required for Having Copies. - - You are not required to accept this License in order to receive or -run a copy of the Program. Ancillary propagation of a covered work -occurring solely as a consequence of using peer-to-peer transmission -to receive a copy likewise does not require acceptance. However, -nothing other than this License grants you permission to propagate or -modify any covered work. These actions infringe copyright if you do -not accept this License. Therefore, by modifying or propagating a -covered work, you indicate your acceptance of this License to do so. - - 10. Automatic Licensing of Downstream Recipients. - - Each time you convey a covered work, the recipient automatically -receives a license from the original licensors, to run, modify and -propagate that work, subject to this License. You are not responsible -for enforcing compliance by third parties with this License. - - An "entity transaction" is a transaction transferring control of an -organization, or substantially all assets of one, or subdividing an -organization, or merging organizations. If propagation of a covered -work results from an entity transaction, each party to that -transaction who receives a copy of the work also receives whatever -licenses to the work the party's predecessor in interest had or could -give under the previous paragraph, plus a right to possession of the -Corresponding Source of the work from the predecessor in interest, if -the predecessor has it or can get it with reasonable efforts. - - You may not impose any further restrictions on the exercise of the -rights granted or affirmed under this License. For example, you may -not impose a license fee, royalty, or other charge for exercise of -rights granted under this License, and you may not initiate litigation -(including a cross-claim or counterclaim in a lawsuit) alleging that -any patent claim is infringed by making, using, selling, offering for -sale, or importing the Program or any portion of it. - - 11. Patents. - - A "contributor" is a copyright holder who authorizes use under this -License of the Program or a work on which the Program is based. The -work thus licensed is called the contributor's "contributor version". - - A contributor's "essential patent claims" are all patent claims -owned or controlled by the contributor, whether already acquired or -hereafter acquired, that would be infringed by some manner, permitted -by this License, of making, using, or selling its contributor version, -but do not include claims that would be infringed only as a -consequence of further modification of the contributor version. For -purposes of this definition, "control" includes the right to grant -patent sublicenses in a manner consistent with the requirements of -this License. - - Each contributor grants you a non-exclusive, worldwide, royalty-free -patent license under the contributor's essential patent claims, to -make, use, sell, offer for sale, import and otherwise run, modify and -propagate the contents of its contributor version. - - In the following three paragraphs, a "patent license" is any express -agreement or commitment, however denominated, not to enforce a patent -(such as an express permission to practice a patent or covenant not to -sue for patent infringement). To "grant" such a patent license to a -party means to make such an agreement or commitment not to enforce a -patent against the party. - - If you convey a covered work, knowingly relying on a patent license, -and the Corresponding Source of the work is not available for anyone -to copy, free of charge and under the terms of this License, through a -publicly available network server or other readily accessible means, -then you must either (1) cause the Corresponding Source to be so -available, or (2) arrange to deprive yourself of the benefit of the -patent license for this particular work, or (3) arrange, in a manner -consistent with the requirements of this License, to extend the patent -license to downstream recipients. "Knowingly relying" means you have -actual knowledge that, but for the patent license, your conveying the -covered work in a country, or your recipient's use of the covered work -in a country, would infringe one or more identifiable patents in that -country that you have reason to believe are valid. - - If, pursuant to or in connection with a single transaction or -arrangement, you convey, or propagate by procuring conveyance of, a -covered work, and grant a patent license to some of the parties -receiving the covered work authorizing them to use, propagate, modify -or convey a specific copy of the covered work, then the patent license -you grant is automatically extended to all recipients of the covered -work and works based on it. - - A patent license is "discriminatory" if it does not include within -the scope of its coverage, prohibits the exercise of, or is -conditioned on the non-exercise of one or more of the rights that are -specifically granted under this License. You may not convey a covered -work if you are a party to an arrangement with a third party that is -in the business of distributing software, under which you make payment -to the third party based on the extent of your activity of conveying -the work, and under which the third party grants, to any of the -parties who would receive the covered work from you, a discriminatory -patent license (a) in connection with copies of the covered work -conveyed by you (or copies made from those copies), or (b) primarily -for and in connection with specific products or compilations that -contain the covered work, unless you entered into that arrangement, -or that patent license was granted, prior to 28 March 2007. - - Nothing in this License shall be construed as excluding or limiting -any implied license or other defenses to infringement that may -otherwise be available to you under applicable patent law. - - 12. No Surrender of Others' Freedom. - - If conditions are imposed on you (whether by court order, agreement or -otherwise) that contradict the conditions of this License, they do not -excuse you from the conditions of this License. If you cannot convey a -covered work so as to satisfy simultaneously your obligations under this -License and any other pertinent obligations, then as a consequence you may -not convey it at all. For example, if you agree to terms that obligate you -to collect a royalty for further conveying from those to whom you convey -the Program, the only way you could satisfy both those terms and this -License would be to refrain entirely from conveying the Program. - - 13. Use with the GNU Affero General Public License. - - Notwithstanding any other provision of this License, you have -permission to link or combine any covered work with a work licensed -under version 3 of the GNU Affero General Public License into a single -combined work, and to convey the resulting work. The terms of this -License will continue to apply to the part which is the covered work, -but the special requirements of the GNU Affero General Public License, -section 13, concerning interaction through a network will apply to the -combination as such. - - 14. Revised Versions of this License. - - The Free Software Foundation may publish revised and/or new versions of -the GNU General Public License from time to time. Such new versions will -be similar in spirit to the present version, but may differ in detail to -address new problems or concerns. - - Each version is given a distinguishing version number. If the -Program specifies that a certain numbered version of the GNU General -Public License "or any later version" applies to it, you have the -option of following the terms and conditions either of that numbered -version or of any later version published by the Free Software -Foundation. If the Program does not specify a version number of the -GNU General Public License, you may choose any version ever published -by the Free Software Foundation. - - If the Program specifies that a proxy can decide which future -versions of the GNU General Public License can be used, that proxy's -public statement of acceptance of a version permanently authorizes you -to choose that version for the Program. - - Later license versions may give you additional or different -permissions. However, no additional obligations are imposed on any -author or copyright holder as a result of your choosing to follow a -later version. - - 15. Disclaimer of Warranty. - - THERE IS NO WARRANTY FOR THE PROGRAM, TO THE EXTENT PERMITTED BY -APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT -HOLDERS AND/OR OTHER PARTIES PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY -OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, -THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR -PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE PROGRAM -IS WITH YOU. SHOULD THE PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF -ALL NECESSARY SERVICING, REPAIR OR CORRECTION. - - 16. Limitation of Liability. - - IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING -WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MODIFIES AND/OR CONVEYS -THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY -GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE -USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED TO LOSS OF -DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD -PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER PROGRAMS), -EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF -SUCH DAMAGES. - - 17. Interpretation of Sections 15 and 16. - - If the disclaimer of warranty and limitation of liability provided -above cannot be given local legal effect according to their terms, -reviewing courts shall apply local law that most closely approximates -an absolute waiver of all civil liability in connection with the -Program, unless a warranty or assumption of liability accompanies a -copy of the Program in return for a fee. - - END OF TERMS AND CONDITIONS - - How to Apply These Terms to Your New Programs - - If you develop a new program, and you want it to be of the greatest -possible use to the public, the best way to achieve this is to make it -free software which everyone can redistribute and change under these terms. - - To do so, attach the following notices to the program. It is safest -to attach them to the start of each source file to most effectively -state the exclusion of warranty; and each file should have at least -the "copyright" line and a pointer to where the full notice is found. - - - Copyright (C) - - This program is free software: you can redistribute it and/or modify - it under the terms of the GNU General Public License as published by - the Free Software Foundation, either version 3 of the License, or - (at your option) any later version. - - This program is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with this program. If not, see . - -Also add information on how to contact you by electronic and paper mail. - - If the program does terminal interaction, make it output a short -notice like this when it starts in an interactive mode: - - Copyright (C) - This program comes with ABSOLUTELY NO WARRANTY; for details type `show w'. - This is free software, and you are welcome to redistribute it - under certain conditions; type `show c' for details. - -The hypothetical commands `show w' and `show c' should show the appropriate -parts of the General Public License. Of course, your program's commands -might be different; for a GUI interface, you would use an "about box". - - You should also get your employer (if you work as a programmer) or school, -if any, to sign a "copyright disclaimer" for the program, if necessary. -For more information on this, and how to apply and follow the GNU GPL, see -. - - The GNU General Public License does not permit incorporating your program -into proprietary programs. If your program is a subroutine library, you -may consider it more useful to permit linking proprietary applications with -the library. If this is what you want to do, use the GNU Lesser General -Public License instead of this License. But first, please read -. diff -Nru gnucobol-4.0~early~20200606/COPYING.DOC gnucobol-5/COPYING.DOC --- gnucobol-4.0~early~20200606/COPYING.DOC 2020-06-06 20:52:02.000000000 +0000 +++ gnucobol-5/COPYING.DOC 1970-01-01 00:00:00.000000000 +0000 @@ -1,451 +0,0 @@ - - GNU Free Documentation License - Version 1.3, 3 November 2008 - - - Copyright (C) 2000, 2001, 2002, 2007, 2008 Free Software Foundation, Inc. - - Everyone is permitted to copy and distribute verbatim copies - of this license document, but changing it is not allowed. - -0. PREAMBLE - -The purpose of this License is to make a manual, textbook, or other -functional and useful document "free" in the sense of freedom: to -assure everyone the effective freedom to copy and redistribute it, -with or without modifying it, either commercially or noncommercially. -Secondarily, this License preserves for the author and publisher a way -to get credit for their work, while not being considered responsible -for modifications made by others. - -This License is a kind of "copyleft", which means that derivative -works of the document must themselves be free in the same sense. It -complements the GNU General Public License, which is a copyleft -license designed for free software. - -We have designed this License in order to use it for manuals for free -software, because free software needs free documentation: a free -program should come with manuals providing the same freedoms that the -software does. But this License is not limited to software manuals; -it can be used for any textual work, regardless of subject matter or -whether it is published as a printed book. We recommend this License -principally for works whose purpose is instruction or reference. - - -1. APPLICABILITY AND DEFINITIONS - -This License applies to any manual or other work, in any medium, that -contains a notice placed by the copyright holder saying it can be -distributed under the terms of this License. Such a notice grants a -world-wide, royalty-free license, unlimited in duration, to use that -work under the conditions stated herein. The "Document", below, -refers to any such manual or work. Any member of the public is a -licensee, and is addressed as "you". You accept the license if you -copy, modify or distribute the work in a way requiring permission -under copyright law. - -A "Modified Version" of the Document means any work containing the -Document or a portion of it, either copied verbatim, or with -modifications and/or translated into another language. - -A "Secondary Section" is a named appendix or a front-matter section of -the Document that deals exclusively with the relationship of the -publishers or authors of the Document to the Document's overall -subject (or to related matters) and contains nothing that could fall -directly within that overall subject. (Thus, if the Document is in -part a textbook of mathematics, a Secondary Section may not explain -any mathematics.) The relationship could be a matter of historical -connection with the subject or with related matters, or of legal, -commercial, philosophical, ethical or political position regarding -them. - -The "Invariant Sections" are certain Secondary Sections whose titles -are designated, as being those of Invariant Sections, in the notice -that says that the Document is released under this License. If a -section does not fit the above definition of Secondary then it is not -allowed to be designated as Invariant. The Document may contain zero -Invariant Sections. If the Document does not identify any Invariant -Sections then there are none. - -The "Cover Texts" are certain short passages of text that are listed, -as Front-Cover Texts or Back-Cover Texts, in the notice that says that -the Document is released under this License. A Front-Cover Text may -be at most 5 words, and a Back-Cover Text may be at most 25 words. - -A "Transparent" copy of the Document means a machine-readable copy, -represented in a format whose specification is available to the -general public, that is suitable for revising the document -straightforwardly with generic text editors or (for images composed of -pixels) generic paint programs or (for drawings) some widely available -drawing editor, and that is suitable for input to text formatters or -for automatic translation to a variety of formats suitable for input -to text formatters. A copy made in an otherwise Transparent file -format whose markup, or absence of markup, has been arranged to thwart -or discourage subsequent modification by readers is not Transparent. -An image format is not Transparent if used for any substantial amount -of text. A copy that is not "Transparent" is called "Opaque". - -Examples of suitable formats for Transparent copies include plain -ASCII without markup, Texinfo input format, LaTeX input format, SGML -or XML using a publicly available DTD, and standard-conforming simple -HTML, PostScript or PDF designed for human modification. Examples of -transparent image formats include PNG, XCF and JPG. Opaque formats -include proprietary formats that can be read and edited only by -proprietary word processors, SGML or XML for which the DTD and/or -processing tools are not generally available, and the -machine-generated HTML, PostScript or PDF produced by some word -processors for output purposes only. - -The "Title Page" means, for a printed book, the title page itself, -plus such following pages as are needed to hold, legibly, the material -this License requires to appear in the title page. For works in -formats which do not have any title page as such, "Title Page" means -the text near the most prominent appearance of the work's title, -preceding the beginning of the body of the text. - -The "publisher" means any person or entity that distributes copies of -the Document to the public. - -A section "Entitled XYZ" means a named subunit of the Document whose -title either is precisely XYZ or contains XYZ in parentheses following -text that translates XYZ in another language. (Here XYZ stands for a -specific section name mentioned below, such as "Acknowledgements", -"Dedications", "Endorsements", or "History".) To "Preserve the Title" -of such a section when you modify the Document means that it remains a -section "Entitled XYZ" according to this definition. - -The Document may include Warranty Disclaimers next to the notice which -states that this License applies to the Document. These Warranty -Disclaimers are considered to be included by reference in this -License, but only as regards disclaiming warranties: any other -implication that these Warranty Disclaimers may have is void and has -no effect on the meaning of this License. - -2. VERBATIM COPYING - -You may copy and distribute the Document in any medium, either -commercially or noncommercially, provided that this License, the -copyright notices, and the license notice saying this License applies -to the Document are reproduced in all copies, and that you add no -other conditions whatsoever to those of this License. You may not use -technical measures to obstruct or control the reading or further -copying of the copies you make or distribute. However, you may accept -compensation in exchange for copies. If you distribute a large enough -number of copies you must also follow the conditions in section 3. - -You may also lend copies, under the same conditions stated above, and -you may publicly display copies. - - -3. COPYING IN QUANTITY - -If you publish printed copies (or copies in media that commonly have -printed covers) of the Document, numbering more than 100, and the -Document's license notice requires Cover Texts, you must enclose the -copies in covers that carry, clearly and legibly, all these Cover -Texts: Front-Cover Texts on the front cover, and Back-Cover Texts on -the back cover. Both covers must also clearly and legibly identify -you as the publisher of these copies. The front cover must present -the full title with all words of the title equally prominent and -visible. You may add other material on the covers in addition. -Copying with changes limited to the covers, as long as they preserve -the title of the Document and satisfy these conditions, can be treated -as verbatim copying in other respects. - -If the required texts for either cover are too voluminous to fit -legibly, you should put the first ones listed (as many as fit -reasonably) on the actual cover, and continue the rest onto adjacent -pages. - -If you publish or distribute Opaque copies of the Document numbering -more than 100, you must either include a machine-readable Transparent -copy along with each Opaque copy, or state in or with each Opaque copy -a computer-network location from which the general network-using -public has access to download using public-standard network protocols -a complete Transparent copy of the Document, free of added material. -If you use the latter option, you must take reasonably prudent steps, -when you begin distribution of Opaque copies in quantity, to ensure -that this Transparent copy will remain thus accessible at the stated -location until at least one year after the last time you distribute an -Opaque copy (directly or through your agents or retailers) of that -edition to the public. - -It is requested, but not required, that you contact the authors of the -Document well before redistributing any large number of copies, to -give them a chance to provide you with an updated version of the -Document. - - -4. MODIFICATIONS - -You may copy and distribute a Modified Version of the Document under -the conditions of sections 2 and 3 above, provided that you release -the Modified Version under precisely this License, with the Modified -Version filling the role of the Document, thus licensing distribution -and modification of the Modified Version to whoever possesses a copy -of it. In addition, you must do these things in the Modified Version: - -A. Use in the Title Page (and on the covers, if any) a title distinct - from that of the Document, and from those of previous versions - (which should, if there were any, be listed in the History section - of the Document). You may use the same title as a previous version - if the original publisher of that version gives permission. -B. List on the Title Page, as authors, one or more persons or entities - responsible for authorship of the modifications in the Modified - Version, together with at least five of the principal authors of the - Document (all of its principal authors, if it has fewer than five), - unless they release you from this requirement. -C. State on the Title page the name of the publisher of the - Modified Version, as the publisher. -D. Preserve all the copyright notices of the Document. -E. Add an appropriate copyright notice for your modifications - adjacent to the other copyright notices. -F. Include, immediately after the copyright notices, a license notice - giving the public permission to use the Modified Version under the - terms of this License, in the form shown in the Addendum below. -G. Preserve in that license notice the full lists of Invariant Sections - and required Cover Texts given in the Document's license notice. -H. Include an unaltered copy of this License. -I. Preserve the section Entitled "History", Preserve its Title, and add - to it an item stating at least the title, year, new authors, and - publisher of the Modified Version as given on the Title Page. If - there is no section Entitled "History" in the Document, create one - stating the title, year, authors, and publisher of the Document as - given on its Title Page, then add an item describing the Modified - Version as stated in the previous sentence. -J. Preserve the network location, if any, given in the Document for - public access to a Transparent copy of the Document, and likewise - the network locations given in the Document for previous versions - it was based on. These may be placed in the "History" section. - You may omit a network location for a work that was published at - least four years before the Document itself, or if the original - publisher of the version it refers to gives permission. -K. For any section Entitled "Acknowledgements" or "Dedications", - Preserve the Title of the section, and preserve in the section all - the substance and tone of each of the contributor acknowledgements - and/or dedications given therein. -L. Preserve all the Invariant Sections of the Document, - unaltered in their text and in their titles. Section numbers - or the equivalent are not considered part of the section titles. -M. Delete any section Entitled "Endorsements". Such a section - may not be included in the Modified Version. -N. Do not retitle any existing section to be Entitled "Endorsements" - or to conflict in title with any Invariant Section. -O. Preserve any Warranty Disclaimers. - -If the Modified Version includes new front-matter sections or -appendices that qualify as Secondary Sections and contain no material -copied from the Document, you may at your option designate some or all -of these sections as invariant. To do this, add their titles to the -list of Invariant Sections in the Modified Version's license notice. -These titles must be distinct from any other section titles. - -You may add a section Entitled "Endorsements", provided it contains -nothing but endorsements of your Modified Version by various -parties--for example, statements of peer review or that the text has -been approved by an organization as the authoritative definition of a -standard. - -You may add a passage of up to five words as a Front-Cover Text, and a -passage of up to 25 words as a Back-Cover Text, to the end of the list -of Cover Texts in the Modified Version. Only one passage of -Front-Cover Text and one of Back-Cover Text may be added by (or -through arrangements made by) any one entity. If the Document already -includes a cover text for the same cover, previously added by you or -by arrangement made by the same entity you are acting on behalf of, -you may not add another; but you may replace the old one, on explicit -permission from the previous publisher that added the old one. - -The author(s) and publisher(s) of the Document do not by this License -give permission to use their names for publicity for or to assert or -imply endorsement of any Modified Version. - - -5. COMBINING DOCUMENTS - -You may combine the Document with other documents released under this -License, under the terms defined in section 4 above for modified -versions, provided that you include in the combination all of the -Invariant Sections of all of the original documents, unmodified, and -list them all as Invariant Sections of your combined work in its -license notice, and that you preserve all their Warranty Disclaimers. - -The combined work need only contain one copy of this License, and -multiple identical Invariant Sections may be replaced with a single -copy. If there are multiple Invariant Sections with the same name but -different contents, make the title of each such section unique by -adding at the end of it, in parentheses, the name of the original -author or publisher of that section if known, or else a unique number. -Make the same adjustment to the section titles in the list of -Invariant Sections in the license notice of the combined work. - -In the combination, you must combine any sections Entitled "History" -in the various original documents, forming one section Entitled -"History"; likewise combine any sections Entitled "Acknowledgements", -and any sections Entitled "Dedications". You must delete all sections -Entitled "Endorsements". - - -6. COLLECTIONS OF DOCUMENTS - -You may make a collection consisting of the Document and other -documents released under this License, and replace the individual -copies of this License in the various documents with a single copy -that is included in the collection, provided that you follow the rules -of this License for verbatim copying of each of the documents in all -other respects. - -You may extract a single document from such a collection, and -distribute it individually under this License, provided you insert a -copy of this License into the extracted document, and follow this -License in all other respects regarding verbatim copying of that -document. - - -7. AGGREGATION WITH INDEPENDENT WORKS - -A compilation of the Document or its derivatives with other separate -and independent documents or works, in or on a volume of a storage or -distribution medium, is called an "aggregate" if the copyright -resulting from the compilation is not used to limit the legal rights -of the compilation's users beyond what the individual works permit. -When the Document is included in an aggregate, this License does not -apply to the other works in the aggregate which are not themselves -derivative works of the Document. - -If the Cover Text requirement of section 3 is applicable to these -copies of the Document, then if the Document is less than one half of -the entire aggregate, the Document's Cover Texts may be placed on -covers that bracket the Document within the aggregate, or the -electronic equivalent of covers if the Document is in electronic form. -Otherwise they must appear on printed covers that bracket the whole -aggregate. - - -8. TRANSLATION - -Translation is considered a kind of modification, so you may -distribute translations of the Document under the terms of section 4. -Replacing Invariant Sections with translations requires special -permission from their copyright holders, but you may include -translations of some or all Invariant Sections in addition to the -original versions of these Invariant Sections. You may include a -translation of this License, and all the license notices in the -Document, and any Warranty Disclaimers, provided that you also include -the original English version of this License and the original versions -of those notices and disclaimers. In case of a disagreement between -the translation and the original version of this License or a notice -or disclaimer, the original version will prevail. - -If a section in the Document is Entitled "Acknowledgements", -"Dedications", or "History", the requirement (section 4) to Preserve -its Title (section 1) will typically require changing the actual -title. - - -9. TERMINATION - -You may not copy, modify, sublicense, or distribute the Document -except as expressly provided under this License. Any attempt -otherwise to copy, modify, sublicense, or distribute it is void, and -will automatically terminate your rights under this License. - -However, if you cease all violation of this License, then your license -from a particular copyright holder is reinstated (a) provisionally, -unless and until the copyright holder explicitly and finally -terminates your license, and (b) permanently, if the copyright holder -fails to notify you of the violation by some reasonable means prior to -60 days after the cessation. - -Moreover, your license from a particular copyright holder is -reinstated permanently if the copyright holder notifies you of the -violation by some reasonable means, this is the first time you have -received notice of violation of this License (for any work) from that -copyright holder, and you cure the violation prior to 30 days after -your receipt of the notice. - -Termination of your rights under this section does not terminate the -licenses of parties who have received copies or rights from you under -this License. If your rights have been terminated and not permanently -reinstated, receipt of a copy of some or all of the same material does -not give you any rights to use it. - - -10. FUTURE REVISIONS OF THIS LICENSE - -The Free Software Foundation may publish new, revised versions of the -GNU Free Documentation License from time to time. Such new versions -will be similar in spirit to the present version, but may differ in -detail to address new problems or concerns. See -https://www.gnu.org/licenses/. - -Each version of the License is given a distinguishing version number. -If the Document specifies that a particular numbered version of this -License "or any later version" applies to it, you have the option of -following the terms and conditions either of that specified version or -of any later version that has been published (not as a draft) by the -Free Software Foundation. If the Document does not specify a version -number of this License, you may choose any version ever published (not -as a draft) by the Free Software Foundation. If the Document -specifies that a proxy can decide which future versions of this -License can be used, that proxy's public statement of acceptance of a -version permanently authorizes you to choose that version for the -Document. - -11. RELICENSING - -"Massive Multiauthor Collaboration Site" (or "MMC Site") means any -World Wide Web server that publishes copyrightable works and also -provides prominent facilities for anybody to edit those works. A -public wiki that anybody can edit is an example of such a server. A -"Massive Multiauthor Collaboration" (or "MMC") contained in the site -means any set of copyrightable works thus published on the MMC site. - -"CC-BY-SA" means the Creative Commons Attribution-Share Alike 3.0 -license published by Creative Commons Corporation, a not-for-profit -corporation with a principal place of business in San Francisco, -California, as well as future copyleft versions of that license -published by that same organization. - -"Incorporate" means to publish or republish a Document, in whole or in -part, as part of another Document. - -An MMC is "eligible for relicensing" if it is licensed under this -License, and if all works that were first published under this License -somewhere other than this MMC, and subsequently incorporated in whole or -in part into the MMC, (1) had no cover texts or invariant sections, and -(2) were thus incorporated prior to November 1, 2008. - -The operator of an MMC Site may republish an MMC contained in the site -under CC-BY-SA on the same site at any time before August 1, 2009, -provided the MMC is eligible for relicensing. - - -ADDENDUM: How to use this License for your documents - -To use this License in a document you have written, include a copy of -the License in the document and put the following copyright and -license notices just after the title page: - - Copyright (c) YEAR YOUR NAME. - Permission is granted to copy, distribute and/or modify this document - under the terms of the GNU Free Documentation License, Version 1.3 - or any later version published by the Free Software Foundation; - with no Invariant Sections, no Front-Cover Texts, and no Back-Cover Texts. - A copy of the license is included in the section entitled "GNU - Free Documentation License". - -If you have Invariant Sections, Front-Cover Texts and Back-Cover Texts, -replace the "with...Texts." line with this: - - with the Invariant Sections being LIST THEIR TITLES, with the - Front-Cover Texts being LIST, and with the Back-Cover Texts being LIST. - -If you have Invariant Sections without Cover Texts, or some other -combination of the three, merge those two alternatives to suit the -situation. - -If your document contains nontrivial examples of program code, we -recommend releasing these examples in parallel under your choice of -free software license, such as the GNU General Public License, -to permit their use in free software. diff -Nru gnucobol-4.0~early~20200606/COPYING.LESSER gnucobol-5/COPYING.LESSER --- gnucobol-4.0~early~20200606/COPYING.LESSER 2020-06-06 20:52:02.000000000 +0000 +++ gnucobol-5/COPYING.LESSER 1970-01-01 00:00:00.000000000 +0000 @@ -1,165 +0,0 @@ - GNU LESSER GENERAL PUBLIC LICENSE - Version 3, 29 June 2007 - - Copyright (C) 2007 Free Software Foundation, Inc. - Everyone is permitted to copy and distribute verbatim copies - of this license document, but changing it is not allowed. - - - This version of the GNU Lesser General Public License incorporates -the terms and conditions of version 3 of the GNU General Public -License, supplemented by the additional permissions listed below. - - 0. Additional Definitions. - - As used herein, "this License" refers to version 3 of the GNU Lesser -General Public License, and the "GNU GPL" refers to version 3 of the GNU -General Public License. - - "The Library" refers to a covered work governed by this License, -other than an Application or a Combined Work as defined below. - - An "Application" is any work that makes use of an interface provided -by the Library, but which is not otherwise based on the Library. -Defining a subclass of a class defined by the Library is deemed a mode -of using an interface provided by the Library. - - A "Combined Work" is a work produced by combining or linking an -Application with the Library. The particular version of the Library -with which the Combined Work was made is also called the "Linked -Version". - - The "Minimal Corresponding Source" for a Combined Work means the -Corresponding Source for the Combined Work, excluding any source code -for portions of the Combined Work that, considered in isolation, are -based on the Application, and not on the Linked Version. - - The "Corresponding Application Code" for a Combined Work means the -object code and/or source code for the Application, including any data -and utility programs needed for reproducing the Combined Work from the -Application, but excluding the System Libraries of the Combined Work. - - 1. Exception to Section 3 of the GNU GPL. - - You may convey a covered work under sections 3 and 4 of this License -without being bound by section 3 of the GNU GPL. - - 2. Conveying Modified Versions. - - If you modify a copy of the Library, and, in your modifications, a -facility refers to a function or data to be supplied by an Application -that uses the facility (other than as an argument passed when the -facility is invoked), then you may convey a copy of the modified -version: - - a) under this License, provided that you make a good faith effort to - ensure that, in the event an Application does not supply the - function or data, the facility still operates, and performs - whatever part of its purpose remains meaningful, or - - b) under the GNU GPL, with none of the additional permissions of - this License applicable to that copy. - - 3. Object Code Incorporating Material from Library Header Files. - - The object code form of an Application may incorporate material from -a header file that is part of the Library. You may convey such object -code under terms of your choice, provided that, if the incorporated -material is not limited to numerical parameters, data structure -layouts and accessors, or small macros, inline functions and templates -(ten or fewer lines in length), you do both of the following: - - a) Give prominent notice with each copy of the object code that the - Library is used in it and that the Library and its use are - covered by this License. - - b) Accompany the object code with a copy of the GNU GPL and this license - document. - - 4. Combined Works. - - You may convey a Combined Work under terms of your choice that, -taken together, effectively do not restrict modification of the -portions of the Library contained in the Combined Work and reverse -engineering for debugging such modifications, if you also do each of -the following: - - a) Give prominent notice with each copy of the Combined Work that - the Library is used in it and that the Library and its use are - covered by this License. - - b) Accompany the Combined Work with a copy of the GNU GPL and this license - document. - - c) For a Combined Work that displays copyright notices during - execution, include the copyright notice for the Library among - these notices, as well as a reference directing the user to the - copies of the GNU GPL and this license document. - - d) Do one of the following: - - 0) Convey the Minimal Corresponding Source under the terms of this - License, and the Corresponding Application Code in a form - suitable for, and under terms that permit, the user to - recombine or relink the Application with a modified version of - the Linked Version to produce a modified Combined Work, in the - manner specified by section 6 of the GNU GPL for conveying - Corresponding Source. - - 1) Use a suitable shared library mechanism for linking with the - Library. A suitable mechanism is one that (a) uses at run time - a copy of the Library already present on the user's computer - system, and (b) will operate properly with a modified version - of the Library that is interface-compatible with the Linked - Version. - - e) Provide Installation Information, but only if you would otherwise - be required to provide such information under section 6 of the - GNU GPL, and only to the extent that such information is - necessary to install and execute a modified version of the - Combined Work produced by recombining or relinking the - Application with a modified version of the Linked Version. (If - you use option 4d0, the Installation Information must accompany - the Minimal Corresponding Source and Corresponding Application - Code. If you use option 4d1, you must provide the Installation - Information in the manner specified by section 6 of the GNU GPL - for conveying Corresponding Source.) - - 5. Combined Libraries. - - You may place library facilities that are a work based on the -Library side by side in a single library together with other library -facilities that are not Applications and are not covered by this -License, and convey such a combined library under terms of your -choice, if you do both of the following: - - a) Accompany the combined library with a copy of the same work based - on the Library, uncombined with any other library facilities, - conveyed under the terms of this License. - - b) Give prominent notice with the combined library that part of it - is a work based on the Library, and explaining where to find the - accompanying uncombined form of the same work. - - 6. Revised Versions of the GNU Lesser General Public License. - - The Free Software Foundation may publish revised and/or new versions -of the GNU Lesser General Public License from time to time. Such new -versions will be similar in spirit to the present version, but may -differ in detail to address new problems or concerns. - - Each version is given a distinguishing version number. If the -Library as you received it specifies that a certain numbered version -of the GNU Lesser General Public License "or any later version" -applies to it, you have the option of following the terms and -conditions either of that published version or of any later version -published by the Free Software Foundation. If the Library as you -received it does not specify a version number of the GNU Lesser -General Public License, you may choose any version of the GNU Lesser -General Public License ever published by the Free Software Foundation. - - If the Library as you received it specifies that a proxy can decide -whether future versions of the GNU Lesser General Public License shall -apply, that proxy's public statement of acceptance of any version is -permanent authorization for you to choose that version for the -Library. diff -Nru gnucobol-4.0~early~20200606/debian/changelog gnucobol-5/debian/changelog --- gnucobol-4.0~early~20200606/debian/changelog 2021-05-10 19:03:02.000000000 +0000 +++ gnucobol-5/debian/changelog 2021-05-19 20:48:12.000000000 +0000 @@ -1,117 +1,6 @@ -gnucobol (4.0~early~20200606-4) unstable; urgency=medium +gnucobol (5) unstable; urgency=medium - * New maintainer (Closes: #985679) - * debian/control: bump standard to 4.5.1 (no changes) - * debian/control: use dh12 + * initial upload + (the former gnucobol package has been renamed to gnucobol4) - -- Thorsten Alteholz Mon, 10 May 2021 21:03:02 +0200 - -gnucobol (4.0~early~20200606-3) unstable; urgency=medium - - * Force source only upload to unstable - - -- Al Stone Sat, 11 Jul 2020 21:26:15 -0600 - -gnucobol (4.0~early~20200606-2) unstable; urgency=medium - - * Fix "Unnecessary build dependency on quilt" -- removed the - unneeded dependency (Closes: #964418) - * Add regression test for CVE-2019-16395 (Closes: #940949) - * Add regression test for CVE-2019-16396 (Closes: #940950) - * Rename regression test01 to CVE-2019-14468 - * Rename regression test02 to CVE-2019-14486 - * Rename regression test03 to CVE-2019-14528 - * Rename regression test04 to CVE-2019-14541 - * Added in missing build-depends for bison - - -- Al Stone Fri, 10 Jul 2020 20:38:00 -0600 - -gnucobol (4.0~early~20200606-1) unstable; urgency=medium - - * Use early release of GnuCOBOL - * Refresh patches - * libcob5 replaces libcob4 - * Add known CI test restrictions for CVE tests - * Add comments to CI tests to note the CVEs being fixed - * Release to test CI again - - -- Al Stone Mon, 29 Jun 2020 21:28:27 -0600 - -gnucobol (3.0~rc1-5) unstable; urgency=medium - - * Follow-up fixes to autopkgtest -- test exit codes properly - - -- Al Stone Fri, 05 Jun 2020 20:16:35 -0600 - -gnucobol (3.0~rc1-4) unstable; urgency=medium - - * Correct silly typos in autopkgtest test04 - - -- Al Stone Fri, 05 Jun 2020 10:55:29 -0600 - -gnucobol (3.0~rc1-3) unstable; urgency=medium - - * Make some adjustments to the autopkgtest scripts to capture - failures better, using the patch supplied with some minor - tweaks. Closes: #962081 - - -- Al Stone Thu, 04 Jun 2020 20:10:37 -0600 - -gnucobol (3.0~rc1-2) unstable; urgency=medium - - * Add in autopkgtests in debian/tests - * Closes: #933884 -- several CVEs have been repaired and those - repairs are present in this version. NB: autopkgtest test cases - for these have also been added. - * Closes: #96166 -- source only upload - * Push to unstable. - - -- Al Stone Sun, 31 May 2020 13:04:18 -0600 - -gnucobol (3.0~rc1-1) unstable; urgency=medium - - * Closes: #945816 -- adopt the package and close the ITA - * Lintian cleanup: correct man pages when generated - - -- Al Stone Mon, 27 Apr 2020 21:51:18 -0600 - -gnucobol (2.2-5) unstable; urgency=medium - - * Enhanced help2man.diff with code from upstream - - -- Ludwin Janvier Tue, 17 Jul 2018 22:29:40 +0200 - -gnucobol (2.2-4) unstable; urgency=medium - - * debian/rules - - removed useless override_dh_auto_configure - - now build with -g, debug symbols packages available - - override dh_clean to remove generated files - * debian/control - - standards-version 4.1.4 (no change) - - debhelper 11 - - libcob4: set Multi-Arch: same - - libcob4-dev: set Multi-Arch: same - - open-cobol: set Architecture: all - - priority extra replaced by priority optional - - build-depends: help2man - * added manpage for cob-config - * debian/compat moved to 11 - * debian/watch signature check - * debian/upstream/signing-key.asc added - * Added help2man.diff to prevent build failures - - -- Ludwin Janvier Sat, 16 Jun 2018 08:53:49 +0200 - -gnucobol (2.2-2) unstable; urgency=medium - - * Add breaks: libcob1-dev (Closes: #901190) - * Add build-deps to rebuild pdf and info - - -- Ludwin Janvier Tue, 12 Jun 2018 11:09:08 +0200 - -gnucobol (2.2-1) unstable; urgency=medium - - * Initial release (Closes: #768497) - - -- Ludwin Janvier Tue, 13 Mar 2018 17:09:44 +0100 + -- Thorsten Alteholz Wed, 19 May 2021 22:48:12 +0200 diff -Nru gnucobol-4.0~early~20200606/debian/cob-config.1 gnucobol-5/debian/cob-config.1 --- gnucobol-4.0~early~20200606/debian/cob-config.1 2020-07-12 03:26:15.000000000 +0000 +++ gnucobol-5/debian/cob-config.1 1970-01-01 00:00:00.000000000 +0000 @@ -1,27 +0,0 @@ -.TH cob-config "1" "July 2018" "cob-config (GnuCOBOL) 2.2.0" "User Commands" -.SH NAME -cob-config \- helper script for libcob (GnuCOBOL) -.SH SYNOPSIS -.B cob-config -[\fIoptions\fR] -.SH DESCRIPTION -This is a shell script which simplifies building applications against libcob. -.SH OPTIONS -.TP -\fB\-\-prefix\fR -echos the package\-prefix of libcob -.TP -\fB\-\-exec\-prefix\fR -echos the executable\-prefix of libcob -.TP -\fB\-\-version\fR -echos the release version of libcob -.TP -\fB\-\-libs\fR -echos the libraries needed to link with libcob -.TP -\fB\-\-cflags\fR -echos the C compiler flags needed to compile with libcob -.SH "SEE ALSO" -.BR cobc (1) -.BR cobcrun(1) diff -Nru gnucobol-4.0~early~20200606/debian/control gnucobol-5/debian/control --- gnucobol-4.0~early~20200606/debian/control 2021-05-10 19:03:02.000000000 +0000 +++ gnucobol-5/debian/control 2021-05-19 18:32:42.000000000 +0000 @@ -1,84 +1,19 @@ Source: gnucobol Section: devel -Priority: optional +Priority: standard Maintainer: Thorsten Alteholz -Build-Depends: - debhelper-compat (= 12), - libgmp-dev, - libdb-dev, - libncurses5-dev, - texinfo, - texlive, - help2man, - bison Standards-Version: 4.5.1 -Homepage: https://www.gnu.org/software/gnucobol/ -Vcs-Git: https://salsa.debian.org/ahs3/gnucobol +Build-Depends: + debhelper-compat (= 13) +Vcs-Browser: https://salsa.debian.org/alteholz/gnucobol +Vcs-Git: https://salsa.debian.org/alteholz/gnucobol.git +Rules-Requires-Root: no Package: gnucobol +Priority: optional Architecture: any -Depends: - ${shlibs:Depends}, - ${misc:Depends}, - libcob5-dev (=${binary:Version}), - libgmp-dev, - libncurses5-dev, - gcc, -Conflicts: open-cobol (<< 2.2) -Description: COBOL compiler - GnuCOBOL (formerly OpenCOBOL) is a free, modern COBOL compiler. GnuCOBOL - implements a substantial part of the COBOL 85, COBOL 2002 and COBOL 2014 - standards and X/Open COBOL, as well as many extensions included in other COBOL - compilers (IBM COBOL, MicroFocus COBOL, ACUCOBOL-GT and others). - . - GnuCOBOL translates COBOL into C and compiles the translated code using a - native C compiler. - . - Build COBOL programs on various platforms, including GNU/Linux, Unix, Mac OS X, - and Microsoft Windows. GnuCOBOL has also been built on HP/UX, z/OS, SPARC, - RS6000, AS/400, along with other combinations of machines and operating - systems. - . - While being held to a high level of quality and robustness, GnuCOBOL does not - claim to be a “Standard Conforming†implementation of COBOL. - . - GnuCOBOL passes over 9600 of the NIST COBOL 85 test suite tests and over 750 - internal checks during build. - -Package: libcob5 -Section: libs -Replaces: libcob4 -Architecture: any -Multi-Arch: same -Depends: ${shlibs:Depends}, ${misc:Depends} -Description: COBOL compiler - runtime library - This package contains the runtime library for gnucobol. - . - GnuCOBOL (formerly OpenCOBOL) is a free, modern COBOL compiler. GnuCOBOL - implements a substantial part of the COBOL 85, COBOL 2002 and COBOL 2014 - standards and X/Open COBOL, as well as many extensions included in other COBOL - compilers (IBM COBOL, MicroFocus COBOL, ACUCOBOL-GT and others). - -Package: libcob5-dev -Section: libdevel -Architecture: any -Multi-Arch: same -Replaces: libcob4-dev -Breaks: libcob4-dev -Depends: ${misc:Depends}, libcob5 (=${binary:Version}) -Description: COBOL compiler - development files - This package contains the development files for gnucobol. - . - GnuCOBOL (formerly OpenCOBOL) is a free, modern COBOL compiler. GnuCOBOL - implements a substantial part of the COBOL 85, COBOL 2002 and COBOL 2014 - standards and X/Open COBOL, as well as many extensions included in other COBOL - compilers (IBM COBOL, MicroFocus COBOL, ACUCOBOL-GT and others). - -Package: open-cobol -Section: oldlibs -Architecture: all -Depends: ${misc:Depends}, gnucobol -Description: transitional dummy package for gnucobol - This transitional package allows one to migrate from open-cobol to gnucobol +Depends: gnucobol${pv:gnucobol}, ${misc:Depends} +Description: compiler package for default GnuCOBOL + This is the GnuCOBOL compiler, a fairly portable optimizing compiler for C. . - It can be safely removed after the upgrade. + This is a dependency package providing the default GnuCOBOL compiler. diff -Nru gnucobol-4.0~early~20200606/debian/copyright gnucobol-5/debian/copyright --- gnucobol-4.0~early~20200606/debian/copyright 2020-07-12 03:26:15.000000000 +0000 +++ gnucobol-5/debian/copyright 2021-05-19 20:48:12.000000000 +0000 @@ -1,128 +1,15 @@ Format: https://www.debian.org/doc/packaging-manuals/copyright-format/1.0/ -Upstream-Name: GnuCOBOL +Upstream-Name: GnuCOBOL defaults Source: https://ftp.gnu.org/gnu/gnucobol/ -Copyright: 2001-2018 Free Software Foundation, Inc. -License: GPL-3+ Files: * -Copyright: 2001-2018 Free Software Foundation, Inc. -License: GPL-3+ +Copyright: 2021 Thorsten Alteholz +License: GPL-2 -Files: lib/* -Copyright: 2003-2012 Free Software Foundation, Inc. -License: GPL-3+ - -Files: cobc/* -Copyright: 2001-2012, 2014-2017 Free Software Foundation, Inc. -License: GPL-3+ - -Files: libcob.h libcob/* -Copyright: 2002-2012 Free Software Foundation, Inc. -License: LGPL-3+ - -Files: libcob/cobgetopt.c -Copyright: 1987-2002,2011 Free Software Foundation, Inc. -License: LGPL-2.1+ - -Files: libcob/cobgetopt.h -Copyright: 1989-1994, 1996-1999, 2001 Free Software Foundation, Inc. - 2010, 2012 Free Software Foundation, Inc. -License: LGPL-2.1+ - -Files: doc/* -Copyright: 2002-2012, 2014-2017 Free Software Foundation, Inc. -License: GFDL-NIV-1.3 - -Files: build_aux/compile -Copyright: 1999-2017 Free Software Foundation, Inc. -License: GPL-2+ - -Files: build_aux/depcomp -Copyright: 1999-2014 Free Software Foundation, Inc. -License: GPL-2+ - -Files: build_aux/ltmain.sh -Copyright: 1996-2015 Free Software Foundation, Inc. -License: GPL-2+ - -Files: build_aux/mdate-sh -Copyright: 1995-2014 Free Software Foundation, Inc. -License: GPL-2+ - -Files: build_aux/missing -Copyright: 1996-2014 Free Software Foundation, Inc. -License: GPL-2+ - -Files: build_aux/mkinstalldirs -Copyright: public domain -License: public-domain - This file is in the public domain. - -Files: build_aux/texinfo.tex -Copyright: Copyright 1985, 1986, 1988, 1990, 1991, 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010, 2011, 2012, 2013, 2014, 2015, 2016, 2017 Free Software Foundation, Inc. -License: GPL-3+ - -Files: build_aux/ylwrap -Copyright: 1996-2017 Free Software Foundation, Inc. -License: GPL-2+ - -Files: m4/libtool.m4 -Copyright: 2014 Free Software Foundation, Inc. -License: permissive-fsf-short - This file is free software; the Free Software Foundation gives - unlimited permission to copy and/or distribute it, with or without - modifications, as long as this notice is preserved. - -Files: m4/m4_ax_code_coverage.m4 -Copyright: Copyright (c) 2012, 2016 Philip Withnall - Copyright (c) 2012 Xan Lopez - Copyright (c) 2012 Christian Persch - Copyright (c) 2012 Paolo Borelli - Copyright (c) 2012 Dan Winship - Copyright (c) 2015 Bastien ROUCARIES -License: LGPL-2.1+ - -Files: debian/* -Copyright: 2006-2012 Bart Martens - 2018 Ludwin Janvier -License: GPL-3+ - -Files: lib/gettext.h -Copyright: 1995-1998, 2000-2002, 2004-2006, 2009-2016 Free Software Foundation, Inc. -License: GPL-3+ - -Files: build_aux/install-sh -Copyright: 1994 X Consortium -License: permissive-fsf - Permission is hereby granted, free of charge, to any person obtaining a copy - of this software and associated documentation files (the "Software"), to - deal in the Software without restriction, including without limitation the - rights to use, copy, modify, merge, publish, distribute, sublicense, and/or - sell copies of the Software, and to permit persons to whom the Software is - furnished to do so, subject to the following conditions: - . - The above copyright notice and this permission notice shall be included in - all copies or substantial portions of the Software. - . - THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR - IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, - FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE - X CONSORTIUM BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN - AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNEC- - TION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. - . - Except as contained in this notice, the name of the X Consortium shall not - be used in advertising or otherwise to promote the sale, use or other deal- - ings in this Software without prior written authorization from the X Consor- - tium. - . - FSF changes to this file are in the public domain. - -License: GPL-2+ +License: GPL-2 This package is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by - the Free Software Foundation; either version 2 of the License, or - (at your option) any later version. + the Free Software Foundation; version 2 of the License. . This package is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of @@ -135,69 +22,3 @@ . On Debian systems, the complete text of the GNU General Public License version 2 can be found in `/usr/share/common-licenses/GPL-2'. - -License: LGPL-2.1+ - This package is free software; you can redistribute it and/or - modify it under the terms of the GNU Lesser General Public - License as published by the Free Software Foundation; either - version 2 of the License, or (at your option) any later version. - . - This package is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU - Lesser General Public License for more details. - . - You should have received a copy of the GNU Lesser General Public - License along with this package; if not, write to the Free Software - Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA - . - On Debian systems, the complete text of the GNU Lesser General - Public License version 2 can be found in `/usr/share/common-licenses/LGPL-2'. - -License: LGPL-3+ - This package is free software; you can redistribute it and/or - modify it under the terms of the GNU Lesser General Public - License as published by the Free Software Foundation; either - version 3 of the License, or (at your option) any later version. - . - This package is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU - Lesser General Public License for more details. - . - You should have received a copy of the GNU General Public License - along with this program. If not, see . - . - On Debian systems, the complete text of the GNU Lesser General - Public License can be found in "/usr/share/common-licenses/LGPL-3". - -License: GPL-3+ - This program is free software: you can redistribute it and/or modify - it under the terms of the GNU General Public License as published by - the Free Software Foundation; either version 3 of the License, or - (at your option) any later version. - . - This program is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - . - You should have received a copy of the GNU General Public License - along with this program. If not, see . - . - On Debian systems, the complete text of the GNU General - Public License version 3 can be found in "/usr/share/common-licenses/GPL-3". - -License: GFDL-NIV-1.3 - GNU Free Documentation License Usage - Alternatively, this file may be used under the terms of the GNU Free - Documentation License version 1.3 as published by the Free Software - Foundation and appearing in the file included in the packaging of - this file. Please review the following information to ensure - the GNU Free Documentation License version 1.3 requirements - will be met: http://www.gnu.org/copyleft/fdl.html. - . - On Debian systems, the complete text of the GFDL-1.3 license can be found in - `/usr/share/common-licenses/GFDL-1.3`, - - diff -Nru gnucobol-4.0~early~20200606/debian/docs gnucobol-5/debian/docs --- gnucobol-4.0~early~20200606/debian/docs 2020-07-12 03:26:15.000000000 +0000 +++ gnucobol-5/debian/docs 1970-01-01 00:00:00.000000000 +0000 @@ -1,5 +0,0 @@ -NEWS -README -TODO -AUTHORS -THANKS diff -Nru gnucobol-4.0~early~20200606/debian/gnucobol.doc-base gnucobol-5/debian/gnucobol.doc-base --- gnucobol-4.0~early~20200606/debian/gnucobol.doc-base 2020-07-12 03:26:15.000000000 +0000 +++ gnucobol-5/debian/gnucobol.doc-base 1970-01-01 00:00:00.000000000 +0000 @@ -1,8 +0,0 @@ -Document: gnucobol -Title: GnuCOBOL -Author: Keisuke Nishida, Roger While, Brian Tiffin, Simon Sobisch -Abstract: This manual corresponds to GnuCOBOL 2.2. -Section: Programming - -Format: PDF -Files: /usr/share/doc/gnucobol/gnucobol.pdf.gz diff -Nru gnucobol-4.0~early~20200606/debian/gnucobol.docs gnucobol-5/debian/gnucobol.docs --- gnucobol-4.0~early~20200606/debian/gnucobol.docs 2020-07-12 03:26:15.000000000 +0000 +++ gnucobol-5/debian/gnucobol.docs 1970-01-01 00:00:00.000000000 +0000 @@ -1 +0,0 @@ -doc/gnucobol.pdf diff -Nru gnucobol-4.0~early~20200606/debian/gnucobol.info gnucobol-5/debian/gnucobol.info --- gnucobol-4.0~early~20200606/debian/gnucobol.info 2020-07-12 03:26:15.000000000 +0000 +++ gnucobol-5/debian/gnucobol.info 1970-01-01 00:00:00.000000000 +0000 @@ -1 +0,0 @@ -doc/gnucobol.info diff -Nru gnucobol-4.0~early~20200606/debian/gnucobol.install gnucobol-5/debian/gnucobol.install --- gnucobol-4.0~early~20200606/debian/gnucobol.install 2020-07-12 03:26:15.000000000 +0000 +++ gnucobol-5/debian/gnucobol.install 1970-01-01 00:00:00.000000000 +0000 @@ -1,4 +0,0 @@ -usr/share/locale/ -usr/share/gnucobol/ -usr/bin/ -etc/gnucobol/ diff -Nru gnucobol-4.0~early~20200606/debian/gnucobol.links gnucobol-5/debian/gnucobol.links --- gnucobol-4.0~early~20200606/debian/gnucobol.links 2020-07-12 03:26:15.000000000 +0000 +++ gnucobol-5/debian/gnucobol.links 1970-01-01 00:00:00.000000000 +0000 @@ -1,2 +0,0 @@ -usr/share/man/man1/gnucobol.1.gz usr/share/man/man1/cobc.1.gz -usr/share/man/man1/gnucobol.1.gz usr/share/man/man1/cobcrun.1.gz diff -Nru gnucobol-4.0~early~20200606/debian/gnucobol.manpages gnucobol-5/debian/gnucobol.manpages --- gnucobol-4.0~early~20200606/debian/gnucobol.manpages 2020-07-12 03:26:15.000000000 +0000 +++ gnucobol-5/debian/gnucobol.manpages 1970-01-01 00:00:00.000000000 +0000 @@ -1,3 +0,0 @@ -cobc/cobc.1 -bin/cobcrun.1 -debian/cob-config.1 diff -Nru gnucobol-4.0~early~20200606/debian/libcob5-dev.dirs gnucobol-5/debian/libcob5-dev.dirs --- gnucobol-4.0~early~20200606/debian/libcob5-dev.dirs 2020-07-12 03:26:15.000000000 +0000 +++ gnucobol-5/debian/libcob5-dev.dirs 1970-01-01 00:00:00.000000000 +0000 @@ -1,2 +0,0 @@ -usr/lib -usr/include diff -Nru gnucobol-4.0~early~20200606/debian/libcob5-dev.install gnucobol-5/debian/libcob5-dev.install --- gnucobol-4.0~early~20200606/debian/libcob5-dev.install 2020-07-12 03:26:15.000000000 +0000 +++ gnucobol-5/debian/libcob5-dev.install 1970-01-01 00:00:00.000000000 +0000 @@ -1,3 +0,0 @@ -usr/include/* -usr/lib/*/lib*.a -usr/lib/*/lib*.so diff -Nru gnucobol-4.0~early~20200606/debian/libcob5.dirs gnucobol-5/debian/libcob5.dirs --- gnucobol-4.0~early~20200606/debian/libcob5.dirs 2020-07-12 03:26:15.000000000 +0000 +++ gnucobol-5/debian/libcob5.dirs 1970-01-01 00:00:00.000000000 +0000 @@ -1 +0,0 @@ -usr/lib diff -Nru gnucobol-4.0~early~20200606/debian/libcob5.install gnucobol-5/debian/libcob5.install --- gnucobol-4.0~early~20200606/debian/libcob5.install 2020-07-12 03:26:15.000000000 +0000 +++ gnucobol-5/debian/libcob5.install 1970-01-01 00:00:00.000000000 +0000 @@ -1 +0,0 @@ -usr/lib/*/lib*.so.* diff -Nru gnucobol-4.0~early~20200606/debian/patches/honor-sysconfdir.diff gnucobol-5/debian/patches/honor-sysconfdir.diff --- gnucobol-4.0~early~20200606/debian/patches/honor-sysconfdir.diff 2020-07-12 03:26:15.000000000 +0000 +++ gnucobol-5/debian/patches/honor-sysconfdir.diff 1970-01-01 00:00:00.000000000 +0000 @@ -1,19 +0,0 @@ -Description: configure script read the sysconfdir option -Author: Ludwin Janvier ---- -This patch header follows DEP-3: http://dep.debian.net/deps/dep3/ -Index: gnucobol-4.0-early-20200606/configure.ac -=================================================================== ---- gnucobol-4.0-early-20200606.orig/configure.ac -+++ gnucobol-4.0-early-20200606/configure.ac -@@ -1931,6 +1931,10 @@ elif test "$COB_USES_GCC" = "yes" && tes - fi - fi - -+if test -n "$sysconfdir"; then -+ COB_CONFIG_DIR="$sysconfdir/$PACKAGE_TARNAME" -+fi -+ - if test "x$lt_cv_dlopen_self" != "xyes"; then - AC_DEFINE([COB_NO_SELFOPEN], [1]) - fi diff -Nru gnucobol-4.0~early~20200606/debian/patches/man-pages.patch gnucobol-5/debian/patches/man-pages.patch --- gnucobol-4.0~early~20200606/debian/patches/man-pages.patch 2020-07-12 03:26:15.000000000 +0000 +++ gnucobol-5/debian/patches/man-pages.patch 1970-01-01 00:00:00.000000000 +0000 @@ -1,26 +0,0 @@ -Index: gnucobol-4.0-early-20200606/bin/Makefile.am -=================================================================== ---- gnucobol-4.0-early-20200606.orig/bin/Makefile.am -+++ gnucobol-4.0-early-20200606/bin/Makefile.am -@@ -41,7 +41,7 @@ CODE_COVERAGE_LCOV_OPTIONS = --no-exter - MAINTAINERCLEANFILES = cobcrun.1 - - HELPSOURCES = cobcrun.c $(top_srcdir)/configure.ac --HELP2MAN_OPTS = --info-page=$(PACKAGE) -+HELP2MAN_OPTS = --section=1 --name="GnuCOBOL module loader" --info-page=$(PACKAGE) - - if MAKE_HAS_PREREQ_ONLY - cobcrun.1: $(HELPSOURCES) | $(COBCRUN) -Index: gnucobol-4.0-early-20200606/cobc/Makefile.am -=================================================================== ---- gnucobol-4.0-early-20200606.orig/cobc/Makefile.am -+++ gnucobol-4.0-early-20200606/cobc/Makefile.am -@@ -49,7 +49,7 @@ CODE_COVERAGE_BRANCH_COVERAGE=1 - CODE_COVERAGE_LCOV_OPTIONS = --no-external - - HELPSOURCES = help.c config.def flag.def warning.def $(top_srcdir)/configure.ac --HELP2MAN_OPTS = --info-page=$(PACKAGE) -+HELP2MAN_OPTS = --section=1 --name="GnuCOBOL compiler" --info-page=$(PACKAGE) - - if MAKE_HAS_PREREQ_ONLY - cobc.1: $(HELPSOURCES) | $(COBC) diff -Nru gnucobol-4.0~early~20200606/debian/patches/series gnucobol-5/debian/patches/series --- gnucobol-4.0~early~20200606/debian/patches/series 2020-07-12 03:26:15.000000000 +0000 +++ gnucobol-5/debian/patches/series 1970-01-01 00:00:00.000000000 +0000 @@ -1,2 +0,0 @@ -honor-sysconfdir.diff -man-pages.patch diff -Nru gnucobol-4.0~early~20200606/debian/rules gnucobol-5/debian/rules --- gnucobol-4.0~early~20200606/debian/rules 2020-07-12 03:26:15.000000000 +0000 +++ gnucobol-5/debian/rules 2021-05-19 20:48:12.000000000 +0000 @@ -1,37 +1,14 @@ -#!/usr/bin/make -f -# See debhelper(7) (uncomment to enable) -# output every command that modifies files on the build system. -#export DH_VERBOSE = 1 +#! /usr/bin/make -f -# see FEATURE AREAS in dpkg-buildflags(1) -#export DEB_BUILD_MAINT_OPTIONS = hardening=+all +# Uncomment this to turn on verbose mode. +#export DH_VERBOSE=1 -# see ENVIRONMENT in dpkg-buildflags(1) -# package maintainers to append CFLAGS -#export DEB_CFLAGS_MAINT_APPEND = -Wall -pedantic -# package maintainers to append LDFLAGS -#export DEB_LDFLAGS_MAINT_APPEND = -Wl,--as-needed +# gnucobol-defaults 5.0 is the first version for GnuCOBOL 3 +export PV_GNUCOBOL:=3 %: dh $@ -# trick to add -g to CFLAGS -override_dh_auto_configure: - # --enable-debug is a gnucobol-specific option which permits to add -g - # but disable optimisations by default - CFLAGS='-g -O2 -finline-functions -U_FORTIFY_SOURCE' dh_auto_configure -- --enable-debug - -# Clean generated files -override_dh_clean: - rm -f doc/gnucobol.pdf bin/cobcrun.1 cobc/cobc.1 doc/gnucobol.info - dh_clean - -# force build PDF -override_dh_auto_build: - dh_auto_build - $(MAKE) -C doc gnucobol.pdf - -# disable auto_test -# because one of them depends on an external service -# http://www.itl.nist.gov/div897/ctg/suites/newcob.val.Z -override_dh_auto_test: +override_dh_gencontrol: + echo 'pv:gnucobol=$(PV_GNUCOBOL)' >> debian/gnucobol.substvars + dh_gencontrol diff -Nru gnucobol-4.0~early~20200606/debian/source/format gnucobol-5/debian/source/format --- gnucobol-4.0~early~20200606/debian/source/format 2020-07-12 03:26:15.000000000 +0000 +++ gnucobol-5/debian/source/format 2021-05-19 20:48:12.000000000 +0000 @@ -1 +1 @@ -3.0 (quilt) +3.0 (native) diff -Nru gnucobol-4.0~early~20200606/debian/source/include-binaries gnucobol-5/debian/source/include-binaries --- gnucobol-4.0~early~20200606/debian/source/include-binaries 2020-07-12 03:26:15.000000000 +0000 +++ gnucobol-5/debian/source/include-binaries 1970-01-01 00:00:00.000000000 +0000 @@ -1,6 +0,0 @@ -debian/tests/cve-2019-14468.cob -debian/tests/cve-2019-14486.cob -debian/tests/cve-2019-14528.cob -debian/tests/cve-2019-14541.cob -debian/tests/cve-2019-16395.cob -debian/tests/cve-2019-16396.cob diff -Nru gnucobol-4.0~early~20200606/debian/tests/control gnucobol-5/debian/tests/control --- gnucobol-4.0~early~20200606/debian/tests/control 2020-07-12 03:26:15.000000000 +0000 +++ gnucobol-5/debian/tests/control 1970-01-01 00:00:00.000000000 +0000 @@ -1,7 +0,0 @@ -Tests: hello - -Tests: cve-2019-14468, cve-2019-14486, cve-2019-14528, cve-2019-14541 -Restrictions: allow-stderr - -Tests: cve-2019-16395, cve-2019-16396 -Restrictions: allow-stderr diff -Nru gnucobol-4.0~early~20200606/debian/tests/cve-2019-14468 gnucobol-5/debian/tests/cve-2019-14468 --- gnucobol-4.0~early~20200606/debian/tests/cve-2019-14468 2020-07-12 03:26:15.000000000 +0000 +++ gnucobol-5/debian/tests/cve-2019-14468 1970-01-01 00:00:00.000000000 +0000 @@ -1,21 +0,0 @@ -#!/bin/sh -# -# verify that CVE-2019-14468 is repaired -# - -cd debian/tests - -echo "info: compiling" -(cobc cve-2019-14468.cob > $AUTOPKGTEST_TMP/cve-2019-14468.act 2>&1) - -echo "info: running" -cmp -s cve-2019-14468.exp $AUTOPKGTEST_TMP/cve-2019-14468.act -res=$? -if [ $res = 0 ] ; then - echo "success: cve-2019-14468 produced proper results" -else - echo "error: cve-2019-14468 did not produce proper results" - diff -u cve-2019-14468.exp $AUTOPKGTEST_TMP/cve-2019-14468.act -fi - -exit $res Binary files /tmp/tmp8r0303vl/MzBWgGBJBM/gnucobol-4.0~early~20200606/debian/tests/cve-2019-14468.cob and /tmp/tmp8r0303vl/cieYbammgl/gnucobol-5/debian/tests/cve-2019-14468.cob differ diff -Nru gnucobol-4.0~early~20200606/debian/tests/cve-2019-14468.exp gnucobol-5/debian/tests/cve-2019-14468.exp --- gnucobol-4.0~early~20200606/debian/tests/cve-2019-14468.exp 2020-07-12 03:26:15.000000000 +0000 +++ gnucobol-5/debian/tests/cve-2019-14468.exp 1970-01-01 00:00:00.000000000 +0000 @@ -1,134 +0,0 @@ -cve-2019-14468.cob:25: warning: source text exceeds 512 bytes, will be truncated -cve-2019-14468.cob:43: warning: line not terminated by a newline -cve-2019-14468.cob:26: error: expression stack overflow at 32 entries for operation '-' -cve-2019-14468.cob:26: error: expression stack overflow at 32 entries for operation '-' -cve-2019-14468.cob:26: error: expression stack overflow at 32 entries for operation '-' -cve-2019-14468.cob:26: error: expression stack overflow at 32 entries for operation '-' -cve-2019-14468.cob:26: error: expression stack overflow at 32 entries for operation '-' -cve-2019-14468.cob:26: error: expression stack overflow at 32 entries for operation '-' -cve-2019-14468.cob:26: error: expression stack overflow at 32 entries for operation '-' -cve-2019-14468.cob:26: error: expression stack overflow at 32 entries for operation '-' -cve-2019-14468.cob:26: error: expression stack overflow at 32 entries for operation '-' -cve-2019-14468.cob:26: error: expression stack overflow at 32 entries for operation '-' -cve-2019-14468.cob:26: error: expression stack overflow at 32 entries for operation '-' -cve-2019-14468.cob:26: error: expression stack overflow at 32 entries for operation '-' -cve-2019-14468.cob:26: error: expression stack overflow at 32 entries for operation '-' -cve-2019-14468.cob:26: error: expression stack overflow at 32 entries for operation '-' -cve-2019-14468.cob:26: error: expression stack overflow at 32 entries for operation '-' -cve-2019-14468.cob:26: error: expression stack overflow at 32 entries for operation '-' -cve-2019-14468.cob:26: error: expression stack overflow at 32 entries for operation '-' -cve-2019-14468.cob:26: error: expression stack overflow at 32 entries for operation '-' -cve-2019-14468.cob:26: error: expression stack overflow at 32 entries for operation '-' -cve-2019-14468.cob:26: error: expression stack overflow at 32 entries for operation '-' -cve-2019-14468.cob:26: error: expression stack overflow at 32 entries for operation '-' -cve-2019-14468.cob:26: error: expression stack overflow at 32 entries for operation '-' -cve-2019-14468.cob:26: error: expression stack overflow at 32 entries for operation '-' -cve-2019-14468.cob:26: error: expression stack overflow at 32 entries for operation '-' -cve-2019-14468.cob:26: error: expression stack overflow at 32 entries for operation '-' -cve-2019-14468.cob:26: error: expression stack overflow at 32 entries for operation '-' -cve-2019-14468.cob:26: error: expression stack overflow at 32 entries for operation '-' -cve-2019-14468.cob:26: error: expression stack overflow at 32 entries for operation '-' -cve-2019-14468.cob:26: error: expression stack overflow at 32 entries for operation '-' -cve-2019-14468.cob:26: error: expression stack overflow at 32 entries for operation '-' -cve-2019-14468.cob:26: error: expression stack overflow at 32 entries for operation '-' -cve-2019-14468.cob:26: error: expression stack overflow at 32 entries for operation '-' -cve-2019-14468.cob:26: error: expression stack overflow at 32 entries for operation '-' -cve-2019-14468.cob:26: error: expression stack overflow at 32 entries for operation '-' -cve-2019-14468.cob:26: error: expression stack overflow at 32 entries for operation '-' -cve-2019-14468.cob:26: error: expression stack overflow at 32 entries for operation '-' -cve-2019-14468.cob:26: error: expression stack overflow at 32 entries for operation '-' -cve-2019-14468.cob:26: error: expression stack overflow at 32 entries for operation '-' -cve-2019-14468.cob:26: error: expression stack overflow at 32 entries for operation '-' -cve-2019-14468.cob:26: error: expression stack overflow at 32 entries for operation '-' -cve-2019-14468.cob:26: error: expression stack overflow at 32 entries for operation '-' -cve-2019-14468.cob:26: error: expression stack overflow at 32 entries for operation '-' -cve-2019-14468.cob:26: error: expression stack overflow at 32 entries for operation '-' -cve-2019-14468.cob:26: error: expression stack overflow at 32 entries for operation '-' -cve-2019-14468.cob:26: error: expression stack overflow at 32 entries for operation '-' -cve-2019-14468.cob:26: error: expression stack overflow at 32 entries for operation '-' -cve-2019-14468.cob:26: error: expression stack overflow at 32 entries for operation '-' -cve-2019-14468.cob:26: error: expression stack overflow at 32 entries for operation '-' -cve-2019-14468.cob:26: error: expression stack overflow at 32 entries for operation '-' -cve-2019-14468.cob:26: error: expression stack overflow at 32 entries for operation '-' -cve-2019-14468.cob:26: error: expression stack overflow at 32 entries for operation '-' -cve-2019-14468.cob:26: error: expression stack overflow at 32 entries for operation '-' -cve-2019-14468.cob:26: error: expression stack overflow at 32 entries for operation '-' -cve-2019-14468.cob:26: error: expression stack overflow at 32 entries for operation '-' -cve-2019-14468.cob:26: error: expression stack overflow at 32 entries for operation '-' -cve-2019-14468.cob:26: error: expression stack overflow at 32 entries for operation '-' -cve-2019-14468.cob:26: error: expression stack overflow at 32 entries for operation '-' -cve-2019-14468.cob:26: error: expression stack overflow at 32 entries for operation '-' -cve-2019-14468.cob:26: error: expression stack overflow at 32 entries for operation '-' -cve-2019-14468.cob:26: error: expression stack overflow at 32 entries for operation '-' -cve-2019-14468.cob:26: error: expression stack overflow at 32 entries for operation '-' -cve-2019-14468.cob:26: error: expression stack overflow at 32 entries for operation '-' -cve-2019-14468.cob:26: error: expression stack overflow at 32 entries for operation '-' -cve-2019-14468.cob:26: error: expression stack overflow at 32 entries for operation '-' -cve-2019-14468.cob:26: error: expression stack overflow at 32 entries for operation '-' -cve-2019-14468.cob:26: error: expression stack overflow at 32 entries for operation '-' -cve-2019-14468.cob:26: error: expression stack overflow at 32 entries for operation '-' -cve-2019-14468.cob:26: error: expression stack overflow at 32 entries for operation '-' -cve-2019-14468.cob:26: error: expression stack overflow at 32 entries for operation '-' -cve-2019-14468.cob:26: error: expression stack overflow at 32 entries for operation '-' -cve-2019-14468.cob:26: error: expression stack overflow at 32 entries for operation '-' -cve-2019-14468.cob:26: error: expression stack overflow at 32 entries for operation '-' -cve-2019-14468.cob:26: error: expression stack overflow at 32 entries for operation '-' -cve-2019-14468.cob:26: error: expression stack overflow at 32 entries for operation '-' -cve-2019-14468.cob:26: error: expression stack overflow at 32 entries for operation '-' -cve-2019-14468.cob:26: error: expression stack overflow at 32 entries for operation '-' -cve-2019-14468.cob:26: error: expression stack overflow at 32 entries for operation '-' -cve-2019-14468.cob:26: error: expression stack overflow at 32 entries for operation '-' -cve-2019-14468.cob:26: error: expression stack overflow at 32 entries for operation '-' -cve-2019-14468.cob:26: error: expression stack overflow at 32 entries for operation '-' -cve-2019-14468.cob:26: error: expression stack overflow at 32 entries for operation '-' -cve-2019-14468.cob:26: error: expression stack overflow at 32 entries for operation '-' -cve-2019-14468.cob:26: error: expression stack overflow at 32 entries for operation '-' -cve-2019-14468.cob:26: error: expression stack overflow at 32 entries for operation '-' -cve-2019-14468.cob:26: error: expression stack overflow at 32 entries for operation '-' -cve-2019-14468.cob:26: error: expression stack overflow at 32 entries for operation '-' -cve-2019-14468.cob:26: error: expression stack overflow at 32 entries for operation '-' -cve-2019-14468.cob:26: error: expression stack overflow at 32 entries for operation '-' -cve-2019-14468.cob:26: error: expression stack overflow at 32 entries for operation '-' -cve-2019-14468.cob:26: error: expression stack overflow at 32 entries for operation '-' -cve-2019-14468.cob:26: error: expression stack overflow at 32 entries for operation '-' -cve-2019-14468.cob:26: error: expression stack overflow at 32 entries for operation '-' -cve-2019-14468.cob:26: error: expression stack overflow at 32 entries for operation '-' -cve-2019-14468.cob:26: error: expression stack overflow at 32 entries for operation '-' -cve-2019-14468.cob:26: error: expression stack overflow at 32 entries for operation '-' -cve-2019-14468.cob:26: error: expression stack overflow at 32 entries for operation '-' -cve-2019-14468.cob:26: error: expression stack overflow at 32 entries for operation '-' -cve-2019-14468.cob:26: error: expression stack overflow at 32 entries for operation '-' -cve-2019-14468.cob:26: error: expression stack overflow at 32 entries for operation '-' -cve-2019-14468.cob:26: error: expression stack overflow at 32 entries for operation '-' -cve-2019-14468.cob:26: error: expression stack overflow at 32 entries for operation '-' -cve-2019-14468.cob:26: error: expression stack overflow at 32 entries for operation '-' -cve-2019-14468.cob:26: error: expression stack overflow at 32 entries for operation '-' -cve-2019-14468.cob:26: error: expression stack overflow at 32 entries for operation '-' -cve-2019-14468.cob:26: error: expression stack overflow at 32 entries for operation '-' -cve-2019-14468.cob:26: error: expression stack overflow at 32 entries for operation '-' -cve-2019-14468.cob:26: error: expression stack overflow at 32 entries for operation '-' -cve-2019-14468.cob:26: error: expression stack overflow at 32 entries for operation '-' -cve-2019-14468.cob:26: error: expression stack overflow at 32 entries for operation '-' -cve-2019-14468.cob:26: error: expression stack overflow at 32 entries for operation '-' -cve-2019-14468.cob:26: error: expression stack overflow at 32 entries for operation '-' -cve-2019-14468.cob:26: error: expression stack overflow at 32 entries for operation '-' -cve-2019-14468.cob:26: error: expression stack overflow at 32 entries for operation '-' -cve-2019-14468.cob:26: error: expression stack overflow at 32 entries for operation '-' -cve-2019-14468.cob:26: error: expression stack overflow at 32 entries for operation '-' -cve-2019-14468.cob:26: error: expression stack overflow at 32 entries for operation '-' -cve-2019-14468.cob:26: error: expression stack overflow at 32 entries for operation '-' -cve-2019-14468.cob:26: error: expression stack overflow at 32 entries for operation '-' -cve-2019-14468.cob:26: error: expression stack overflow at 32 entries for operation '-' -cve-2019-14468.cob:26: error: expression stack overflow at 32 entries for operation '-' -cve-2019-14468.cob:26: error: expression stack overflow at 32 entries for operation '-' -cve-2019-14468.cob:26: error: expression stack overflow at 32 entries for operation '-' -cve-2019-14468.cob:26: error: expression stack overflow at 32 entries for operation '-' -cve-2019-14468.cob:26: error: expression stack overflow at 32 entries for operation '-' -cve-2019-14468.cob:26: error: expression stack overflow at 32 entries for operation '-' -cve-2019-14468.cob:26: error: expression stack overflow at 32 entries for operation '-' -cve-2019-14468.cob:26: error: expression stack overflow at 32 entries for operation '-' -cve-2019-14468.cob:26: error: expression stack overflow at 32 entries for operation '-' -cve-2019-14468.cob:26: error: expression stack overflow at 32 entries for operation '-' -cobc: too many errors - -cobc: aborting compile of cve-2019-14468.cob at line 26 (PROGRAM-ID: tutorial) diff -Nru gnucobol-4.0~early~20200606/debian/tests/cve-2019-14486 gnucobol-5/debian/tests/cve-2019-14486 --- gnucobol-4.0~early~20200606/debian/tests/cve-2019-14486 2020-07-12 03:26:15.000000000 +0000 +++ gnucobol-5/debian/tests/cve-2019-14486 1970-01-01 00:00:00.000000000 +0000 @@ -1,21 +0,0 @@ -#!/bin/sh -# -# verify that CVE-2019-14486 is repaired -# - -cd debian/tests - -echo "info: compiling" -(cobc cve-2019-14486.cob > $AUTOPKGTEST_TMP/cve-2019-14486.act 2>&1) - -echo "info: running" -cmp -s cve-2019-14486.exp $AUTOPKGTEST_TMP/cve-2019-14486.act -res=$? -if [ $res = 0 ] ; then - echo "success: cve-2019-14486 produced proper results" -else - echo "error: cve-2019-14486 did not produce proper results" - diff -u cve-2019-14486.exp $AUTOPKGTEST_TMP/cve-2019-14486.act -fi - -exit $res diff -Nru gnucobol-4.0~early~20200606/debian/tests/cve-2019-14486.cob gnucobol-5/debian/tests/cve-2019-14486.cob --- gnucobol-4.0~early~20200606/debian/tests/cve-2019-14486.cob 2020-07-12 03:26:15.000000000 +0000 +++ gnucobol-5/debian/tests/cve-2019-14486.cob 1970-01-01 00:00:00.000000000 +0000 @@ -1,197 +0,0 @@ - - *> This is in most part the tutorial code from - *> MicroFocus "external filPPPPPPPPPPPPPPPPPPPPPPPPPPPP *> - *> "Tutorial: Using the Callable File Handler" - *> - *> Left separate until possible integration into - *> main testsuite is clear... - *> - $SET SOURCEFORMAT "VARIABLE" - * - IDENTIFICATION DIVISION. - PROGRAM-ID. tutorial. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 opcode pic x(2). - 78 OP-QUERY-FILE value x"0006". - 78 OP-OPEN-INPUT value x"fa00". - 78 OP-OPEN-OUTPUT value x"fa01". - 78 OP-OPEN-I-O value x"fa02". - 78 OP-WRITE value x"faf3". - 78 OP-RELEASE value x"faf3". - 78 OP-REWRITE value x"faf4". - 78 OP-READ-NEXT value x"faf5". - 78 OP-START-EQUAL value x"fae9". - 78 OP-CLOSE value x"fa80". - - - 01 FCD. - copy 'xfhfcd3.cpy'. - - - 01 ex-filename pic x(260) value "idxfile.dat". - 01 ex-index-name pic x(100). *> not used in different formats - - - 01 ex-keydef. - 47 key2length pic 9(4) comp-x. - 0 47 key-version pic 9(2) comp-x value 2. - 47 filler pic 9(6) comp-x. *> reserved - 47 key-count pic 9(4) comp-x. - 47 filler pic 9(13) comp-x. *> reserved - - * key-specification is repeated for the number of keys defined by - * key-count - 47 key-specification. -  49 component-count pic 9(4) comp-x. - * The offset for the component-specification for this key - 49 component-defs pic 9(4) comp-x. - 49 key-flags pic 9(2) comp-x. - 78 KEY2KEYFLAG-DUPS-IN-ORDER value h"40". - 78 KEY2KEYFLAG-PRIME value h"10". - 78 KEY2KEYFLAG-SPARSE-KEY value h"02". - 49 key-compression pic 9(2) comp-x. - 78 KEY2COMPRESS-TRAILING-NULLS value h"08". - 78 KEY2COMPRESS-TRAILING-SPACES value h"04". - 78 KEY2COMPRESS-IDENTICAL-CHARS value h"02". - 78 KEY2COMPRESS-FOLLOWING-DUP value h"0247763657621391446 78 KEY2COMPRESS-NO-COMPRESSION value h"00". - 78 KEY2COMPRESS-DEFAULT value KEY2COMPRESS-NO-COMPRESSION. - 49 sparse-characters pic x(2). - 49 filler pic x(8). *> reserved - - - * component-specifications for all keys follows after the key-specifications * for all the keys. - 47 component-specification. - 49 component-flags pic 9(2) comp-x. - 49 component-type pic 9(2) comp-x. - m 78 KEY2PARTTYP-NUMERIC value h"80". - 78 KEY2PARTTYP-SIGNED value h"40". - 78 KEY2PARTTYP-COMP value h"20". - 78 KEY2PARTTYP-COMP-3 value h"21". - 78 KEY2PARTTYP-COMP-X value h"22". - f 78 KEY2PARTTYP-COMP-5 value h"23". - 78 KEY2PARTTYP-FLOAT value h"24". - 78 KEY2PARTTYP-COMP-6 value h"25". - 78 KEY2PARTTYP-DISPLAY value h"00". - 78 KEY2PARTTYP-SIGN-TRAIL-INCL value h"00". - 78 KEY2PARTTYP-SIGN-TRAIL-SEP value h"01". - 78 KEY2PARTTYP-SIGN-LEAD-INCL value h"02". - 78 KEY2PARTTYP-SIGN-LEAD-SEP value h"03". - 78 KEY2PARTTYP-SIGN-LEAD-FLOAT value h"04". - 49 component-offret pic 9(9) comp-x. - 49 component-length pic 9(9) comp-x. - - - * storage or record - 01 ex-record. - 03 record-key pic 9(5). - 03 record-data pic x(95). - - PR 78 KEY2KEYFLAG-PRIME value h"10". - 78 KEY2KEYFLAG-SPARSE-KEY value h"02". - 49 key-compression pic 9(2) comp-x. - 78 KEY2COMPRESS-TRAILING-NULLS value h"08". - 78 KEY2COMPRESS-TRAILING-SPACES value h"04". - 78 KEY2COMPRESS-IDENTICAL-CHARS value h"02". - 78 KEY2COMPRESS-FOLLOWING-DUP value h"0247763657621391446 78 KEY2COMPRESS-NO-COMPRESSION value h"00". - 78 KEY2COMPRESS-DEFAULT value KEY2COMPRESS-NO-COMPRESSION. - 49 sparse-characters pic x(2). - 49 filler pic x(8). *> reserved - - - * component-specifications for all keys follows after the key-specifications * for all the keys. - 47 component-specification. - 49 component-flags pic 9(2) comp-x. - 49 component-type pic 9(2) comp-x. - 78 KEY2PARTTYP-NUMERIC value h"80". - 78 KEY2PARTTYP-SIGNED value h"40". - 78 KEY2PARTTYP-COMP value h"20". - 78 KEY2PARTTYP-COMP-3 value h"21". - 78 KEY2PARTTYP-COMP-X value h"22". - f 78 KEY2PARTTYP-COMP-5 value h"23". - 78 KEY2PARTTYP-F‘>AT value h"24". - 78 KEY2PARTTYP-COMP-6 value h"25". - 78 KEY2PARTTYP-DISPLAY value h"00". - 78 KEY2PARTTYP-SIGN-TRAIL-INCL value h"00". - 78 KEY2PARTTYP-SIGN-TRAIL-SEP value h"01". - 78 KEY2PARTTYP-SIGN-LEAD-INCL value h"02". - 78 KEY2PARTTYP-SIGN-LEAD-SEP value h"03". - 78 KEY2PARTTYP-SIGN-LEAD-FLOAT value h"04". - 49 component-offret pic 9(9) comp-x. - 49 component-length pic 9(9) comp-x. - - - * storage or record - 01 ex-record. - 03 record-key pic 9(5). - 03 record-data pic x(95). - - PROCEDURE DIVISION. - - *> - *> invoke part I - *> - - *> Create an indexed file - *> open output an indexed file call "idxfile.dat" - display "Create new4095391983033575536 perform set-fcd - move OP-OPEN-OUTPUT to opcode - perform call-file-handler - perform display-file-status. - - *> Write 5 records increasing record length by 1 each time - move all "A" to record-data - move 0 to record-key - move 5 to fcd-current-rec-len - move OP-WRITE to opcode - perform 5 times - add 1 to record-key - add 1 to fcd-current-rec-len - perform call-file-handler - end-perform. - - *> Now close the file - move OP-CLOSE to opcode - perform call-file-handler - perform display-file-status - display "file closed". - - *> - *> invoke part II - *> - - *> Query the file to retrieve file information - move low-values to fcd - set fcd-filename-address to address of ex-filename - move 80 to fcd-name-length - move fcd--determine-org to fcd-organization - move fcd--version-number to fcd-version - set fcd-filename-address to address of ex-filename - set fcd-idxname-address to address of ex-index-name - set fcd-key-def-address to address of ex-keydef - set fcd-record-address to address to address of ex-record - move OP-QUERY-FILE to opcode - accept omitted - perform call-file-handler - perform display-file-status - display "file open, ready to read" - perform -all-records - perform rewrite-first-record. - - *> Now read all the records again - perform read-all-records - - - goback. - - *> - *> Part I starts here - *> - - set-fcd section. - *> Initially sets up FCD for OPEN op - move low-values to fcd - move length of fcd to fcd-length - move fcd--version-nu ber to fcd-version - move fcd--indexed-org to fcd-organization - move fcd--dAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAIAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA diff -Nru gnucobol-4.0~early~20200606/debian/tests/cve-2019-14486.exp gnucobol-5/debian/tests/cve-2019-14486.exp --- gnucobol-4.0~early~20200606/debian/tests/cve-2019-14486.exp 2020-07-12 03:26:15.000000000 +0000 +++ gnucobol-5/debian/tests/cve-2019-14486.exp 1970-01-01 00:00:00.000000000 +0000 @@ -1,66 +0,0 @@ -cve-2019-14486.cob:58: error: continuation character expected -cve-2019-14486.cob:97: error: continuation character expected -cve-2019-14486.cob:138: error: continuation character expected -cve-2019-14486.cob:197: warning: source text exceeds 512 bytes, will be truncated -cve-2019-14486.cob:57: error: invalid hexadecimal literal: '0247763657621391446 78 KEY2COMP...' -cve-2019-14486.cob:57: error: literal length 67 exceeds 16 characters -cve-2019-14486.cob:57: error: invalid operator '. - 78 KEY2COMPRESS-DEFAULT value KEY2COMPRESS-NO-COMPRESSION. - 49 sparse-characters pic x(2). - 49 filler pic x(8). - - - - 47 component-specification. - 49 component-flags pic 9(2) comp-x. - 49 component-type pic 9(2) comp-x. - 78 KEY2PARTTYP-NUMERIC value h' in expression -cve-2019-14486.cob:57: error: invalid operator '. - 78 KEY2PARTTYP-SIGNED value h' in expression -cve-2019-14486.cob:57: error: invalid operator '. - 78 KEY2PARTTYP-COMP value h' in expression -cve-2019-14486.cob:57: error: invalid operator '. - 78 KEY2PARTTYP-COMP-3 value h' in expression -cve-2019-14486.cob:57: error: invalid operator '. - 78 KEY2PARTTYP-COMP-X value h' in expression -cve-2019-14486.cob:57: error: invalid operator '. - f 78 KEY2PARTTYP-COMP-5 value h' in expression -cve-2019-14486.cob:57: error: invalid operator '. - 78 KEY2PARTTYP-FLOAT value h' in expression -cve-2019-14486.cob:57: error: invalid operator '. - 78 KEY2PARTTYP-COMP-6 value h' in expression -cve-2019-14486.cob:57: error: invalid operator '. - 78 KEY2PARTTYP-DISPLAY value h' in expression -cve-2019-14486.cob:57: error: invalid operator '. - 78 KEY2PARTTYP-SIGN-TRAIL-INCL value h' in expression -cve-2019-14486.cob:57: error: invalid operator '. - 78 KEY2PARTTYP-SIGN-TRAIL-SEP value h' in expression -cve-2019-14486.cob:57: error: invalid operator '. - 78 KEY2PARTTYP-SIGN-LEAD-INCL value h' in expression -cve-2019-14486.cob:57: error: invalid operator '. - 78 KEY2PARTTYP-SIGN-LEAD-SEP value h' in expression -cve-2019-14486.cob:57: error: invalid operator '. - 78 KEY2PARTTYP-SIGN-LEAD-FLOAT value h' in expression -cve-2019-14486.cob:57: error: invalid operator '. - 49 component-offret pic 9(9) comp-x. - 49 component-length pic 9(9) comp-x. - - - - 01 ex-record. - 03 record-key pic 9(5). - 03 record-data pic x(95). - - PR 78 KEY2KEYFLAG-PRIME value h' in expression -cve-2019-14486.cob:57: error: invalid operator '. - 78 KEY2KEYFLAG-SPARSE-KEY value h' in expression -cve-2019-14486.cob:57: error: invalid operator '. - 49 key-compression pic 9(2) comp-x. - 78 KEY2COMPRESS-TRAILING-NULLS value h' in expression -cve-2019-14486.cob:57: error: invalid operator '. - 78 KEY2COMPRESS-TRAILING-SPACES value h' in expression -cve-2019-14486.cob:57: error: invalid operator '. - 78 KEY2COMPRESS-IDENTICAL-CHARS value h' in expression -cve-2019-14486.cob:57: error: invalid operator '. - 78 KEY2COMPRESS-FOLLOWING-DUP value h' in expression -cve-2019-14486.cob:57: error: syntax error, unexpected Identifier, expecting . diff -Nru gnucobol-4.0~early~20200606/debian/tests/cve-2019-14528 gnucobol-5/debian/tests/cve-2019-14528 --- gnucobol-4.0~early~20200606/debian/tests/cve-2019-14528 2020-07-12 03:26:15.000000000 +0000 +++ gnucobol-5/debian/tests/cve-2019-14528 1970-01-01 00:00:00.000000000 +0000 @@ -1,21 +0,0 @@ -#!/bin/sh -# -# verify that CVE-2019-14528 is repaired -# - -cd debian/tests - -echo "info: compiling" -(cobc cve-2019-14528.cob > $AUTOPKGTEST_TMP/cve-2019-14528.act 2>&1) - -echo "info: running" -cmp -s cve-2019-14528.exp $AUTOPKGTEST_TMP/cve-2019-14528.act -res=$? -if [ $res = 0 ] ; then - echo "success: cve-2019-14528 produced proper results" -else - echo "error: cve-2019-14528 did not produce proper results" - diff -u cve-2019-14528.exp $AUTOPKGTEST_TMP/cve-2019-14528.act -fi - -exit $res Binary files /tmp/tmp8r0303vl/MzBWgGBJBM/gnucobol-4.0~early~20200606/debian/tests/cve-2019-14528.cob and /tmp/tmp8r0303vl/cieYbammgl/gnucobol-5/debian/tests/cve-2019-14528.cob differ diff -Nru gnucobol-4.0~early~20200606/debian/tests/cve-2019-14528.exp gnucobol-5/debian/tests/cve-2019-14528.exp --- gnucobol-4.0~early~20200606/debian/tests/cve-2019-14528.exp 2020-07-12 03:26:15.000000000 +0000 +++ gnucobol-5/debian/tests/cve-2019-14528.exp 1970-01-01 00:00:00.000000000 +0000 @@ -1,45 +0,0 @@ -cve-2019-14528.cob:3: error: invalid indicator '½' at column 7 -cve-2019-14528.cob:4: error: invalid indicator 'I' at column 7 -cve-2019-14528.cob:6: error: invalid indicator '1' at column 7 -cve-2019-14528.cob:7: error: invalid indicator 'I' at column 7 -cve-2019-14528.cob:9: error: invalid indicator 'ì' at column 7 -cve-2019-14528.cob:10: error: invalid indicator 'I' at column 7 -cve-2019-14528.cob:12: error: invalid indicator '+' at column 7 -cve-2019-14528.cob:15: error: invalid SOURCEFORMAT directive option 'VAal fileT SOURCEFORMAT ' -cve-2019-14528.cob:19: error: invalid indicator '3' at column 7 -cve-2019-14528.cob:25: error: invalid indicator '3' at column 7 -cve-2019-14528.cob:2876: error: invalid indicator '5' at column 7 -cve-2019-14528.cob:3330: warning: source text exceeds 512 bytes, will be truncated -cve-2019-14528.cob:3330: error: invalid indicator 'ç' at column 7 -cve-2019-14528.cob:3331: error: invalid indicator 'h' at column 7 -cve-2019-14528.cob:3332: error: invalid indicator '«' at column 7 -cve-2019-14528.cob:3333: error: invalid indicator '^' at column 7 -cve-2019-14528.cob:3334: error: invalid indicator '' at column 7 -cve-2019-14528.cob:3335: error: invalid indicator 'Œ' at column 7 -cve-2019-14528.cob:3336: error: invalid indicator '=' at column 7 -cve-2019-14528.cob:3337: error: invalid indicator 'c' at column 7 -cve-2019-14528.cob:3338: error: invalid indicator '«' at column 7 -cve-2019-14528.cob:3339: error: invalid indicator '0' at column 7 -cve-2019-14528.cob:3341: error: invalid indicator ' -cve-2019-14528.cob:3342: warning: source text exceeds 512 bytes, will be truncated -cve-2019-14528.cob:3342: error: invalid indicator '<' at column 7 -cve-2019-14528.cob:3343: error: invalid indicator '' at column 7 -cve-2019-14528.cob:4004: error: invalid indicator '¯' at column 7 -cve-2019-14528.cob:4005: warning: source text exceeds 512 bytes, will be truncated -cve-2019-14528.cob:4005: error: invalid indicator '' at column 7 -cve-2019-14528.cob:4007: error: invalid indicator '³' at column 7 -cve-2019-14528.cob:4008: error: invalid indicator 'c' at column 7 -cve-2019-14528.cob:4009: error: invalid indicator 'Ò' at column 7 -cve-2019-14528.cob:4010: error: invalid indicator '' at column 7 -cve-2019-14528.cob:4011: error: invalid indicator '' at column 7 -cve-2019-14528.cob:4012: error: invalid indicator '·' at column 7 -cve-2019-14528.cob:4013: error: invalid indicator '9' at column 7 -cve-2019-14528.cob:4014: error: invalid indicator '' at column 7 -cve-2019-14528.cob:4015: warning: line not terminated by a newline -cve-2019-14528.cob:4015: error: invalid indicator '„' at column 7 -cve-2019-14528.cob:15: error: PROCEDURE DIVISION header missing -cve-2019-14528.cob:15: error: invalid PROGRAM-ID '#OPTION VARIABLE - - - IDENTIFICATI...' - length exceeds maximum -cve-2019-14528.cob:15: error: syntax error, unexpected end of file diff -Nru gnucobol-4.0~early~20200606/debian/tests/cve-2019-14541 gnucobol-5/debian/tests/cve-2019-14541 --- gnucobol-4.0~early~20200606/debian/tests/cve-2019-14541 2020-07-12 03:26:15.000000000 +0000 +++ gnucobol-5/debian/tests/cve-2019-14541 1970-01-01 00:00:00.000000000 +0000 @@ -1,21 +0,0 @@ -#!/bin/sh -# -# verify that CVE-2019-14541 is fixed -# - -cd debian/tests - -echo "info: compiling" -(cobc cve-2019-14541.cob > $AUTOPKGTEST_TMP/cve-2019-14541.act 2>&1) - -echo "info: running" -cmp -s cve-2019-14541.exp $AUTOPKGTEST_TMP/cve-2019-14541.act -res=$? -if [ $res = 0 ] ; then - echo "success: cve-2019-14541 produced proper results" -else - echo "error: cve-2019-14541 did not produce proper results" - diff -u cve-2019-14541.exp $AUTOPKGTEST_TMP/cve-2019-14541.act -fi - -exit $res Binary files /tmp/tmp8r0303vl/MzBWgGBJBM/gnucobol-4.0~early~20200606/debian/tests/cve-2019-14541.cob and /tmp/tmp8r0303vl/cieYbammgl/gnucobol-5/debian/tests/cve-2019-14541.cob differ diff -Nru gnucobol-4.0~early~20200606/debian/tests/cve-2019-14541.exp gnucobol-5/debian/tests/cve-2019-14541.exp --- gnucobol-4.0~early~20200606/debian/tests/cve-2019-14541.exp 2020-07-12 03:26:15.000000000 +0000 +++ gnucobol-5/debian/tests/cve-2019-14541.exp 1970-01-01 00:00:00.000000000 +0000 @@ -1,46 +0,0 @@ -cve-2019-14541.cob:3: error: invalid indicator '½' at column 7 -cve-2019-14541.cob:4: error: invalid indicator 'I' at column 7 -cve-2019-14541.cob:6: error: invalid indicator 'ì' at column 7 -cve-2019-14541.cob:7: error: invalid indicator 'I' at column 7 -cve-2019-14541.cob:9: error: invalid indicator 'ì' at column 7 -cve-2019-14541.cob:10: error: invalid indicator 'I' at column 7 -cve-2019-14541.cob:12: error: invalid indicator '+' at column 7 -cve-2019-14541.cob:15: error: invalid SOURCEFORMAT directive option 'VAal fileT SOURCEFORMAT ' -cve-2019-14541.cob:19: error: invalid indicator '3' at column 7 -cve-2019-14541.cob:22: error: invalid indicator 'O' at column 7 -cve-2019-14541.cob:26: error: invalid indicator '6' at column 7 -cve-2019-14541.cob:27: error: invalid indicator 'O' at column 7 -cve-2019-14541.cob:32: error: invalid indicator '3' at column 7 -cve-2019-14541.cob:34: error: invalid indicator 'O' at column 7 -cve-2019-14541.cob:37: error: invalid indicator 'O' at column 7 -cve-2019-14541.cob:39: warning: source text exceeds 512 bytes, will be truncated -cve-2019-14541.cob:39: error: invalid indicator ',' at column 7 -cve-2019-14541.cob:40: error: invalid indicator 'Ú' at column 7 -cve-2019-14541.cob:41: error: invalid indicator '' at column 7 -cve-2019-14541.cob:43: error: invalid indicator '' at column 7 -cve-2019-14541.cob:44: error: invalid indicator '' at column 7 -cve-2019-14541.cob:45: error: invalid indicator '¢' at column 7 -cve-2019-14541.cob:46: error: invalid indicator '²' at column 7 -cve-2019-14541.cob:47: error: invalid indicator '' at column 7 -cve-2019-14541.cob:2489: error: invalid indicator 'T' at column 7 -cve-2019-14541.cob:2491: error: continuation character expected -cve-2019-14541.cob:2493: error: invalid indicator 'O' at column 7 -cve-2019-14541.cob:2498: error: invalid indicator 'O' at column 7 -cve-2019-14541.cob:2502: error: invalid indicator 'O' at column 7 -cve-2019-14541.cob:2506: error: invalid indicator '3' at column 7 -cve-2019-14541.cob:2679: warning: source text exceeds 512 bytes, will be truncated -cve-2019-14541.cob:2679: error: invalid indicator '' at column 7 -cve-2019-14541.cob:3025: error: invalid indicator 'T' at column 7 -cve-2019-14541.cob:3029: error: invalid indicator 'O' at column 7 -cve-2019-14541.cob:3034: error: invalid indicator 'O' at column 7 -cve-2019-14541.cob:3038: error: invalid indicator 'O' at column 7 -cve-2019-14541.cob:3042: error: invalid indicator '3' at column 7 -cve-2019-14541.cob:3047: error: invalid indicator '!' at column 7 -cve-2019-14541.cob:3048: warning: line not terminated by a newline -cve-2019-14541.cob:3048: error: invalid indicator '=' at column 7 -cve-2019-14541.cob:15: error: PROCEDURE DIVISION header missing -cve-2019-14541.cob:15: error: invalid PROGRAM-ID '#OPTION VARIABLE - - - IDENTIFICATI...' - length exceeds maximum -cve-2019-14541.cob:15: error: syntax error, unexpected Identifier diff -Nru gnucobol-4.0~early~20200606/debian/tests/cve-2019-16395 gnucobol-5/debian/tests/cve-2019-16395 --- gnucobol-4.0~early~20200606/debian/tests/cve-2019-16395 2020-07-12 03:26:15.000000000 +0000 +++ gnucobol-5/debian/tests/cve-2019-16395 1970-01-01 00:00:00.000000000 +0000 @@ -1,21 +0,0 @@ -#!/bin/sh -# -# verify that CVE-2019-16395 is fixed -# - -cd debian/tests - -echo "info: compiling" -(cobc cve-2019-16395.cob > $AUTOPKGTEST_TMP/cve-2019-16395.act 2>&1) - -echo "info: running" -cmp -s cve-2019-16395.exp $AUTOPKGTEST_TMP/cve-2019-16395.act -res=$? -if [ $res = 0 ] ; then - echo "success: cve-2019-16395 produced proper results" -else - echo "error: cve-2019-16395 did not produce proper results" - diff -u cve-2019-16395.exp $AUTOPKGTEST_TMP/cve-2019-16395.act -fi - -exit $res diff -Nru gnucobol-4.0~early~20200606/debian/tests/cve-2019-16395.cob gnucobol-5/debian/tests/cve-2019-16395.cob --- gnucobol-4.0~early~20200606/debian/tests/cve-2019-16395.cob 2020-07-12 03:26:15.000000000 +0000 +++ gnucobol-5/debian/tests/cve-2019-16395.cob 1970-01-01 00:00:00.000000000 +0000 @@ -1,248 +0,0 @@ - - *> This is in most part the tutorial code from - *> MicroFocus "external file handler" documentation. - *> - *> "Tutorial: Using the Callable File Handler" - *> - *> Left separate until possible integration into - *> main testsuite is clear... - *> - $SET SOURCEFORMAT "VARIABLE" - * - IDENTIFICATION DIVISION. - PROGRAM-ID. tutorial. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 opcode pic x(2). - 78 OP-QUERY-FILE value x"0006". - 78 OP-OPEN-INPUT value x"fa00". - 78 OP-OPEN-OUTPUT value x"fa01". - 78 OP-OPEN-I-O value x"fa02". - 78 OP-WRITE value x"faf3". - 78 OP-RELEASE value x"faf3". - 78 OP-REWRITE value x"faf4". - 78 OP-READ-NEXT value x"faf5". - 78 OP-START-EQUAL value x"fae9". - 78 OP-CLOSE value x"fa80". - - - 01 FCD. - copy 'xfhfcd3.cpy'. - - - 01 ex-filename pic x(260) value "idxfile.dat". - 01 ex-index-name pic x(100). *> not used in different formats - - - 01 ex-keydef. - 47 key2length pic 9(4) comp-x. - 47 key-version pic 9(2) comp-x value 2. - 47 filler pic 9(6) comp-x. *> reserved - 47 key-count pic 9(4) comp-x. - 47 filler pic 9(13) comp-n. *> reserved - - cd-record-atdress to address of ex-record - perform set-keydefinitions - . - - set-keydefinitions section. - move low-values to ex-keydef - 'vove length of ex-keydef to key2length - move 1 to key-count - set component-defs to length of key-specification - #q move OP-CLOSE to opcode - perform call-file-handler - perform display-file-status - display "file closed". - - *> - *> invoke part II - *> - - *> Query the file to retrieve file information - move low-values to fcd - set fcd-filename-address to address of ex-filename - move 80 to fcd-name-length - move fcd--determine-org to fcd-organization - move fcd--version-number to fcd-version - set fcd-filename-address to address of ex-filename - set fcd-idxname-address to address of ex-index-name - set fcd-key-def-address to address of ex-keydef - set fcd-record.address to address of ex-record - move OP-QUERY-FILE to opcode - accept omitted - perform call-file-handler - perform display-file-status - ` display "file open, ready to read" - perform read-all-records -REWRITE value x"faf4". - 78 OP-READ-NEXT value x"faf5". - 78 OP-START-EQUAL value x"fae9". - 78 OP-CLOSE value x"fa80". - - - 01 FCD. - copy 'xfhfcd3.cpy'. - - - 01 ex-filename pic x(260) value "idxfile.dat". - 01 ex-index-name pic x(100). *> not used in different formats - - - 01 ex-keydef. - 47 key2length pic 9(4) comp-x. - 47 key-version pic 9(2) comp-x value 2. - 47 filler pic 9(6) comp-x. *> reserved - 47 key-count pic 9(4) comp-x. - 47 filler pic 9(13) comp-n. *> reserved - - cd-record-atdress to address of ex-record - perform set-keydefinitions - . - - set-keydefinitions section. - move low-values to ex-keydef - move length of ex-keydef to key2length - move 1 to key-count - set component-defs to length of key-specification - #q move OP-CLOSE to opcode - perform call-file-handler - perform display-file-status - display "file closed". - - *> - *> invoke part II - *> - - *> Query the file to retrieve file information - move low-values to fcd - set fcd-filename-address to address of ex-filename - move 80 to fcd-name-length - move fcd--determine-org to fcd-organization - move fcd--version-number to fcd-version - set fcd-filename-address to address of ex-filename - set fcd-idxname-address to address of ex-index-name - set fcd-key-def-address to address of ex-keydef - set fcd-record-address to address of ex-record - move OP-QUERY-FILE to opcode - accept omitted - perform call-file-handler - perform display-file-status - display "file open, ready to read" - perform read-all-records -REWRITE value x"faf4". - 78 OP-READ-NEXT value x"faf5". - 78 OP-START-EQUAL value x"fae9". - 78 OP-CLOSE value x"fa80". - - - 01 FCD. - copy 'xfhfcd3.cpy'. - - - 01 ex-filename pic x(260) value "idxfile.dat". - 01 ex-index-name pic x(100). *> not used in different formats - - - 01 ex-keydef. - 47 key2length pic 9(4) comp-x. - 47 key-version pic 9(2) comp-x value 2. - 47 filler pic 9(6) comp-x. *> reserved - 47 key-count pic 9(4) comp-x. - 47 filler pic 9(13) comp-n. *> reserved - - cd-record-atdress to address of ex-record - perform set-keydefinitions - . - - set-keydefinitions section. - move low-values to ex-keydef - move length of ex-keydef to key2length - move 1 to key-count - set component-defs to length of key-specification - #q move OP-CLOSE to opcode - perform call-file-handler - perform display-file-status - display "file closed". - - *> - *> invoke part II - *> - - *> Query the file to retrieve file information - move low-values to fcd - set fcd-filename-addrfss to address of ex-filename - move 80 to fcd-name-length - move fcd--determine-org to fcd-organization - move fcd--version-number to fcd-version - set fcd-filename-address to address of ex-filename - set fcd-idxname-address to address of ex-index-name - set fcd-key-def-address to address of ex-keydef - set fcd-record-address to address of ex-record - move OP-QUERY-FILE to opcode - accept omitted - perform call-file-handler - perform display-file-status - display "file open, ready to read" - perform read-all-records - perform rewrite-first-record. - - *> Now read all the records again - perform read-all-records - - - goback. - - *> - *> Part I starts here - *> - - set-fcd´îectiof. - *> Initially sets up FCD for OPEN op - move low-values to fcd - move length of fcd to fcd-length - move fcd--version-number to fcd-version - move fcd--indexed-org to fcd-organization - move fcd--dynamic-access to fcd-acce+YÃmode - move fcd--open-closed to fcd-open-mode *> When opening a file this should be set to fcd--open-closed - move fcd--recmode-variable to fcd-recording-mode - move fcd--formžt-big to fcd-file-format - move fcd--auto-lock-bit to fcd-lock-mode - move 12 to fcd-name-length - set fcd-filename-address to address of ex-filename - set fcd-idxname-address to address of ex-index-name - set fcd-key-def-address to address of ex-keydef - moÒÒÒÒÒÒÒÒÒÒÒÒÒÒÒÒÒÒÒÒÒÒÒÒÒÒÒÒÒÒÒÒÒÒÒÒÒÒÒÒÒÒÒÒÒÒÒÒÒÒÒÒÒÒÒÒÒÒÒÒÒÒÒÒÒÒÒÒÒÒÒÒÒÒÒÒÒÒÒÒÒÒÒÒÒÒÒÒÒÒÒÒÒÒÒÒÒÒÒÒÒÒÒÒength - set fcd-record-address to address of ex-record - perform set-keydefinitions - . - - setŽjeydefinitions section. - move low-values to ex-keydef - move length of ex-keydef to key2length - move 1 to key-count - set component-defs to length of key-specification - #qkey-def-address to ad -ress of ex-keydef - moÒÒÒÒÒÒÒÒÒÒÒÒÒÒÒÒÒÒÒÒÒÒÒÒÒÒÒÒÒÒÒÒÒÒÒÒÒÒÒÒÒÒÒÒÒÒÒÒÒÒÒÒÒÒÒÒÒÒÒÒÒÒÒÒÒÒÒÒÒÒÒÒÒÒÒÒÒÒÒÒÒÒÒÒÒÒÒÒÒÒÒÒÒÒÒÒÒÒÒÒÒÒÒÒength - set fcd-record-atdress to address of ex-record - perform set-keydefinitions - . - - set-keydefinitions section. - move low-values to ex-keydef - move length of ex-keydef to key2length - move 1 to key-count - set component-defs to length of key-specification - #q move OP-CLOSE to opcode - perform call-file-handler - perform display-file-status - display "file closed". - - *> - *> invoke part II - *> - - *> Query the file to retrieve file information - move low-values to fcd - set fcd-filename-address to address of ex-filename - move 80 to fcd-name-length - move fcd--determine-org diff -Nru gnucobol-4.0~early~20200606/debian/tests/cve-2019-16395.exp gnucobol-5/debian/tests/cve-2019-16395.exp --- gnucobol-4.0~early~20200606/debian/tests/cve-2019-16395.exp 2020-07-12 03:26:15.000000000 +0000 +++ gnucobol-5/debian/tests/cve-2019-16395.exp 1970-01-01 00:00:00.000000000 +0000 @@ -1,8 +0,0 @@ -cve-2019-16395.cob:51: error: continuation character expected -cve-2019-16395.cob:224: error: invalid indicator 'f' at column 7 -cve-2019-16395.cob:45: error: PROCEDURE DIVISION header missing -cve-2019-16395.cob: in section 'set-keydefinitions': -cve-2019-16395.cob:50: error: invalid literal: 'vove length of ex-keydef to key2len...' -cve-2019-16395.cob:50: error: literal length exceeds 8191 characters -cve-2019-16395.cob:49: error: invalid MOVE target: literal 'vove length of ex-keydef to key2len...' -cve-2019-16395.cob:50: error: syntax error, unexpected end of file diff -Nru gnucobol-4.0~early~20200606/debian/tests/cve-2019-16396 gnucobol-5/debian/tests/cve-2019-16396 --- gnucobol-4.0~early~20200606/debian/tests/cve-2019-16396 2020-07-12 03:26:15.000000000 +0000 +++ gnucobol-5/debian/tests/cve-2019-16396 1970-01-01 00:00:00.000000000 +0000 @@ -1,21 +0,0 @@ -#!/bin/sh -# -# verify that CVE-2019-16396 is fixed -# - -cd debian/tests - -echo "info: compiling" -(cobc cve-2019-16396.cob > $AUTOPKGTEST_TMP/cve-2019-16396.act 2>&1) - -echo "info: running" -cmp -s cve-2019-16396.exp $AUTOPKGTEST_TMP/cve-2019-16396.act -res=$? -if [ $res = 0 ] ; then - echo "success: cve-2019-16396 produced proper results" -else - echo "error: cve-2019-16396 did not produce proper results" - diff -u cve-2019-16396.exp $AUTOPKGTEST_TMP/cve-2019-16396.act -fi - -exit $res Binary files /tmp/tmp8r0303vl/MzBWgGBJBM/gnucobol-4.0~early~20200606/debian/tests/cve-2019-16396.cob and /tmp/tmp8r0303vl/cieYbammgl/gnucobol-5/debian/tests/cve-2019-16396.cob differ diff -Nru gnucobol-4.0~early~20200606/debian/tests/cve-2019-16396.exp gnucobol-5/debian/tests/cve-2019-16396.exp --- gnucobol-4.0~early~20200606/debian/tests/cve-2019-16396.exp 2020-07-12 03:26:15.000000000 +0000 +++ gnucobol-5/debian/tests/cve-2019-16396.exp 1970-01-01 00:00:00.000000000 +0000 @@ -1,32 +0,0 @@ -cve-2019-16396.cob:64: error: invalid indicator 'Ï' at column 7 -cve-2019-16396.cob:65: error: invalid indicator 'Ü' at column 7 -cve-2019-16396.cob:68: error: invalid indicator 'ž' at column 7 -cve-2019-16396.cob:69: warning: line not terminated by a newline -cve-2019-16396.cob:69: error: invalid indicator '' at column 7 -cve-2019-16396.cob:10: error: invalid PROGRAM-ID 'tussssssssssssssssssssssssssssss...' - length exceeds maximum -cve-2019-16396.cob:18: error: ENVIRONMENT DIVISION header missing -cve-2019-16396.cob:18: error: CONFIGURATION SECTION header missing -cve-2019-16396.cob:18: error: SPECIAL-NAMES header missing -cve-2019-16396.cob:18: error: invalid system-name 'testsuite' -cve-2019-16396.cob:18: warning: ignoring redundant . -cve-2019-16396.cob:22: error: PROCEDURE DIVISION header missing -cve-2019-16396.cob:23: error: invalid PROGRAM-ID 'tussssssssssssssssssssssssssssss...' - length exceeds maximum -cve-2019-16396.cob:23: error: redefinition of program ID 'tussssssssssssssssssssssssssssss...' -cve-2019-16396.cob:31: error: ENVIRONMENT DIVISION header missing -cve-2019-16396.cob:31: error: CONFIGURATION SECTION header missing -cve-2019-16396.cob:31: error: SPECIAL-NAMES header missing -cve-2019-16396.cob:31: error: SPECIAL-NAMES not allowed in nested programs -cve-2019-16396.cob:31: warning: ignoring redundant . -cve-2019-16396.cob:35: error: PROCEDURE DIVISION header missing -cve-2019-16396.cob:36: error: invalid PROGRAM-ID 'tussssssssssssssssssssssssssssss...' - length exceeds maximum -cve-2019-16396.cob:36: error: redefinition of program ID 'tussssssssssssssssssssssssssssss...' -cve-2019-16396.cob:45: error: ENVIRONMENT DIVISION header missing -cve-2019-16396.cob:45: error: CONFIGURATION SECTION header missing -cve-2019-16396.cob:45: error: SPECIAL-NAMES header missing -cve-2019-16396.cob:45: error: SPECIAL-NAMES not allowed in nested programs -cve-2019-16396.cob:45: error: syntax error, unexpected DIVISION, expecting CRT or Identifier -cve-2019-16396.cob:46: error: word length exceeds maximum of 63 characters: '0·usssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssssóssssssssssssssssssssssssrssssssssssssssssion' -cve-2019-16396.cob:46: error: PROCEDURE DIVISION header missing -cve-2019-16396.cob:46: error: invalid PROGRAM-ID '0·usssssssssssssssssssssssssssss...' - length exceeds maximum -cve-2019-16396.cob:55: error: PROCEDURE DIVISION header missing -cve-2019-16396.cob:56: error: syntax error, unexpected Identifier diff -Nru gnucobol-4.0~early~20200606/debian/tests/hello gnucobol-5/debian/tests/hello --- gnucobol-4.0~early~20200606/debian/tests/hello 2020-07-12 03:26:15.000000000 +0000 +++ gnucobol-5/debian/tests/hello 1970-01-01 00:00:00.000000000 +0000 @@ -1,20 +0,0 @@ -#!/bin/sh -cd $AUTOPKGTEST_TMP -cat > HELLO.cob<>D -@item @code{-fsource-location} -generate source location code -; turned on by -debug/-g/-ftraceall -@item @code{-fimplicit-init} -automatic initialization of the @code{COBOL} runtime system -@item @code{-fstack-check} -@code{PERFORM} stack checking -; turned on by -debug or -g -@item @code{-fwrite-after} -use @code{AFTER} 1 for @code{WRITE} of @code{LINE SEQUENTIAL} -; default: @code{BEFORE} 1 -@item @code{-fmfcomment} -'*' or '/' in column 1 treated as comment -; @code{FIXED} format only -@item @code{-facucomment} -'$' in indicator area treated as '*', -'|' treated as floating comment -@item @code{-fnotrunc} -allow numeric field overflow -; non-ANSI behaviour -@item @code{-fodoslide} -adjust items following @code{OCCURS DEPENDING} -; implies @option{-fcomplex-odo} -@item @code{-fsingle-quote} -use a single quote (apostrophe) for @code{QUOTE} -; default: double quote -@item @code{-foptional-file} -treat all files as @code{OPTIONAL} -; unless @code{NOT OPTIONAL} specified -@item @code{-fstatic-call} -output static function calls for the @code{CALL} statement -@item @code{-fno-gen-c-decl-static-call} -disable generation of C function declations -for subroutines with static @code{CALL} -@item @code{-fmf-files} -Sequential & Relative files will match Micro Focus format -@item @code{-fno-theaders} -suppress all headers and output of compilation -options from listing while keeping page breaks -@item @code{-fno-tsource} -suppress source from listing -@item @code{-fno-tmessages} -suppress warning and error summary from listing -@item @code{-ftsymbols} -specify symbols in listing -@item @code{-fibmcomp} -sets @option{-fbinary-size}=2-4-8 @option{-fsynchronized-clause}=ok -@item @code{-fno-ibmcomp} -sets @option{-fbinary-size}=1--8~-fsynchronized-clause=ignore -@end table -@section Compiler dialect configuration options -@table @code -@item @code{-freserved-words=@var{value}} -use of complete/fixed reserved words -@item @code{-ftab-width=1..12} -set number of spaces that are assumed for tabs -@item @code{-ftext-column=72..255} -set right margin for source (fixed format only) -@item @code{-fpic-length=@var{number}} -maximum number of characters allowed in the @code{PICTURE} character-string -@item @code{-fword-length=1..63} -maximum word-length for @code{COBOL} (= programmer defined) words -@item @code{-fliteral-length=@var{number}} -maximum literal size in general -@item @code{-fnumeric-literal-length=1..38} -maximum numeric literal size -@item @code{-falign-record=0..256} -align @code{WORKING-STORAGE}/LOCAL-STORAGE record on boundary -@item @code{-falign-opt} -align like @code{MF OPT}, Default: false (Like @code{MF ALIGN}=FIXED) -@item @code{-fbinary-size=@var{value}} -binary byte size - defines the allocated bytes according to @code{PIC}, may be one of: 2-4-8, 1-2-4-8, 1--8 -@item @code{-fbinary-byteorder=@var{value}} -binary byte order, may be one of: native, big-endian -@item @code{-fassign-clause=@var{value}} -how to interpret 'ASSIGN word': as 'ASSIGN @code{EXTERNAL} word' or 'ASSIGN @code{DYNAMIC} word' -@item @code{-fscreen-section-rules=@var{value}} -which compiler's rules to apply to @code{SCREEN SECTION} item clauses -@item @code{-ffilename-mapping} -resolve file names at run time using environment variables. -@item @code{-fpretty-display} -alternate formatting of numeric fields -@item @code{-fbinary-truncate} -numeric truncation according to ANSI -@item @code{-fcomplex-odo} -allow complex @code{OCCURS DEPENDING ON} -@item @code{-findirect-redefines} -allow @code{REDEFINES} to other than last equal level number -@item @code{-flarger-redefines-ok} -allow larger @code{REDEFINES} items -@item @code{-frelax-syntax-checks} -allow certain syntax variations (e.g. @code{REDEFINES} position) -@item @code{-frelax-level-hierarchy} -allow non-matching level numbers -@item @code{-fsticky-linkage} -@code{LINKAGE-SECTION} items remain allocated between invocations -@item @code{-fmove-ibm} -@code{MOVE} operates as on IBM (left to right, byte by byte), otherwise no propagating move -@item @code{-fperform-osvs} -exit point of any currently executing perform is recognized if reached -@item @code{-farithmetic-osvs} -limit precision in intermediate results to precision of final result (less accurate) -@item @code{-fconstant-folding} -evaluate constant expressions at compile time -@item @code{-fhostsign} -allow hexadecimal value 'F' for @code{NUMERIC} test of signed @code{PACKED DECIMAL} field -@item @code{-fprogram-name-redefinition} -program names don't lead to a reserved identifier -@item @code{-faccept-update} -set @code{WITH UPDATE} clause as default for @code{ACCEPT} dest-item, instead of @code{WITH NO UPDATE} -@item @code{-faccept-auto} -set @code{WITH AUTO} clause as default for @code{ACCEPT} dest-item, instead of @code{WITH TAB} -@item @code{-fconsole-is-crt} -assume @code{CONSOLE IS CRT} if not set otherwise -@item @code{-fno-echo-means-secure} -@code{NO-ECHO} hides input with asterisks like @code{SECURE} -@item @code{-fline-col-zero-default} -assume a field @code{DISPLAY} starts at @code{LINE} 0 @code{COL} 0 (i.e. at the cursor), not @code{LINE} 1 @code{COL} 1 -@item @code{-freport-column-plus} -in a @code{REPORT COLUMN} may have @code{PLUS} num, + num, or +num -@item @code{-fdisplay-special-fig-consts} -special behaviour of @code{DISPLAY SPACE}/ALL X'01'/ALL X'02'/ALL X'07' -@item @code{-fbinary-comp-1} -@code{COMP}-1 is a 16-bit signed integer -@item @code{-fmove-non-numeric-lit-to-numeric-is-zero} -imply zero in move of non-numeric literal to numeric items -@item @code{-fimplicit-assign-dynamic-var} -implicitly define a variable if an @code{ASSIGN DYNAMIC} does not match any data item -@item @code{-fcomment-paragraphs=@var{support}} -comment paragraphs in @code{IDENTIFICATION DIVISION} (@code{AUTHOR}, @code{DATE-WRITTEN}, ...) -@item @code{-fmemory-size-clause=@var{support}} -@code{MEMORY-SIZE} clause -@item @code{-fmultiple-file-tape-clause=@var{support}} -@code{MULTIPLE-FILE-TAPE} clause -@item @code{-flabel-records-clause=@var{support}} -@code{LABEL-RECORDS} clause -@item @code{-fvalue-of-clause=@var{support}} -@code{VALUE-OF} clause -@item @code{-fdata-records-clause=@var{support}} -@code{DATA-RECORDS} clause -@item @code{-ftop-level-occurs-clause=@var{support}} -@code{OCCURS} clause on top-level -@item @code{-fsame-as-clause=@var{support}} -@code{SAME} @code{AS} clause -@item @code{-fsynchronized-clause=@var{support}} -@code{SYNCHRONIZED} clause -@item @code{-fsync-left-right=@var{support}} -@code{LEFT}/RIGHT phrases in @code{SYNCHRONIZED} clause -@item @code{-fspecial-names-clause=@var{support}} -@code{SPECIAL-NAMES} clause -@item @code{-fgoto-statement-without-name=@var{support}} -@code{GOTO} statement without name -@item @code{-fstop-literal-statement=@var{support}} -@code{STOP}-literal statement -@item @code{-fstop-identifier-statement=@var{support}} -@code{STOP}-identifier statement -@item @code{-fdebugging-mode=@var{support}} -@code{DEBUGGING} @code{MODE} and debugging indicator -@item @code{-fuse-for-debugging=@var{support}} -@code{USE} @code{FOR DEBUGGING} -@item @code{-fpadding-character-clause=@var{support}} -@code{PADDING} @code{CHARACTER} clause -@item @code{-fnext-sentence-phrase=@var{support}} -@code{NEXT} @code{SENTENCE} phrase -@item @code{-flisting-statements=@var{support}} -listing-directive statements @code{EJECT}, @code{SKIP}1, @code{SKIP}2, @code{SKIP}3 -@item @code{-ftitle-statement=@var{support}} -listing-directive statement @code{TITLE} -@item @code{-fentry-statement=@var{support}} -@code{ENTRY} statement -@item @code{-fmove-noninteger-to-alphanumeric=@var{support}} -move noninteger to alphanumeric -@item @code{-foccurs-max-length-without-subscript} -occurs max length without subscript -@item @code{-flength-in-data-division} -length in data division -@item @code{-fmove-figurative-constant-to-numeric=@var{support}} -move figurative constants to numeric -@item @code{-fmove-figurative-space-to-numeric=@var{support}} -move figurative constant @code{SPACE} to numeric -@item @code{-fmove-figurative-quote-to-numeric=@var{support}} -move figurative constant @code{QUOTE} to numeric -@item @code{-fodo-without-to=@var{support}} -@code{OCCURS} @code{DEPENDING ON} without to -@item @code{-fsection-segments=@var{support}} -section segments -@item @code{-falter-statement=@var{support}} -@code{ALTER} statement -@item @code{-fcall-overflow=@var{support}} -@code{OVERFLOW} clause for @code{CALL} -@item @code{-fnumeric-boolean=@var{support}} -boolean literals (B'1010') -@item @code{-fhexadecimal-boolean=@var{support}} -hexadecimal-boolean literals (@code{BX}'A') -@item @code{-fnational-literals=@var{support}} -national literals (N'UTF-16 string') -@item @code{-fhexadecimal-national-literals=@var{support}} -hexadecimal-national literals (@code{NX}'265E') -@item @code{-fnational-character-literals=@var{support}} -non-standard national literals (@code{NC}'UTF-16 string') -@item @code{-fhp-octal-literals=@var{support}} -@code{HP} @code{COBOL} octal literals (%377) -@item @code{-facu-literals=@var{support}} -@code{ACUCOBOL-GT} literals (#B #O #H #X) -@item @code{-fword-continuation=@var{support}} -continuation of @code{COBOL} words -@item @code{-fnot-exception-before-exception=@var{support}} -@code{NOT} @code{ON EXCEPTION} before @code{ON EXCEPTION} -@item @code{-faccept-display-extensions=@var{support}} -extensions to @code{ACCEPT} and @code{DISPLAY} -@item @code{-frenames-uncommon-levels=@var{support}} -@code{RENAMES} of 01-, 66- and 77-level items -@item @code{-fsymbolic-constant=@var{support}} -constants defined in @code{SPECIAL-NAMES} -@item @code{-fconstant-78=@var{support}} -constant with level 78 item (note: has left to right precedence in expressions) -@item @code{-fconstant-01=@var{support}} -constant with level 01 @code{CONSTANT AS}/FROM item -@item @code{-fperform-varying-without-by=@var{support}} -@code{PERFORM} @code{VARYING} without @code{BY} phrase (implies @code{BY} 1) -@item @code{-freference-out-of-declaratives=@var{support}} -references to sections not in @code{DECLARATIVES} from within @code{DECLARATIVES} -@item @code{-freference-bounds-check=@var{support}} -reference modification strict bounds check -@item @code{-fprogram-prototypes=@var{support}} -@code{CALL}/CANCEL with program-prototype-name -@item @code{-fcall-convention-mnemonic=@var{support}} -specifying call-convention by mnemonic -@item @code{-fcall-convention-linkage=@var{support}} -specifying call-convention by @code{WITH} ... @code{LINKAGE} -@item @code{-fnumeric-value-for-edited-item=@var{support}} -numeric literals in @code{VALUE} clause of numeric-edited items -@item @code{-fincorrect-conf-sec-order=@var{support}} -incorrect order of @code{CONFIGURATION SECTION} paragraphs -@item @code{-fdefine-constant-directive=@var{support}} -allow >> @code{DEFINE CONSTANT} var @code{AS} literal -@item @code{-ffree-redefines-position=@var{support}} -@code{REDEFINES} clause not following entry-name in definition -@item @code{-frecords-mismatch-record-clause=@var{support}} -record sizes does not match @code{RECORD} clause -@item @code{-frecord-delimiter=@var{support}} -@code{RECORD} @code{DELIMITER} clause -@item @code{-fsequential-delimiters=@var{support}} -@code{BINARY-SEQUENTIAL} and @code{LINE-SEQUENTIAL} phrases in @code{RECORD DELIMITER} -@item @code{-frecord-delim-with-fixed-recs=@var{support}} -@code{RECORD} @code{DELIMITER} clause on file with fixed-length records -@item @code{-fmissing-statement=@var{support}} -missing statement (e.g. empty @code{IF} / @code{PERFORM}) -@item @code{-fzero-length-literals=@var{support}} -zero-length literals, e.g. '' and "" -@item @code{-fxml-generate-extra-phrases=@var{support}} -@code{XML} @code{GENERATE}'s phrases other than @code{COUNT IN} -@item @code{-fcontinue-after=@var{support}} -@code{AFTER} phrase in @code{CONTINUE} statement -@item @code{-fgoto-entry=@var{support}} -@code{ENTRY} @code{FOR GOTO} and @code{GOTO ENTRY} statements -@item @code{-fdepending-on-not-fixed=@var{support}} -depending-on-not-fixed -@item @code{-fbinary-sync-clause=@var{support}} -@code{BINARY-SHORT}/LONG/DOUBLE @code{SYNCHRONIZED} clause -@item @code{-fnonnumeric-with-numeric-group-usage=@var{support}} -Non-numeric item with numeric group @code{USAGE} clause -@item @code{-fassign-variable=@var{support}} -@code{ASSIGN} [TO] variable in @code{SELECT} -@item @code{-fassign-using-variable=@var{support}} -@code{ASSIGN} @code{USING}/VARYING variable in @code{SELECT} -@item @code{-fassign-ext-dyn=@var{support}} -@code{ASSIGN} @code{EXTERNAL}/DYNAMIC in @code{SELECT} -@item @code{-fassign-disk-from=@var{support}} -@code{ASSIGN} @code{DISK FROM} variable in @code{SELECT} -where @var{support} is one of the following: -'ok', 'warning', 'archaic', 'obsolete', 'skip', 'ignore', 'error', 'unconformable' -@item @code{-fnot-reserved=@var{word}} -word to be taken out of the reserved words list -@item @code{-freserved=@var{word}} -word to be added to reserved words list -@item @code{-freserved=@var{word}:@var{alias}} -word to be added to reserved words list as alias -@item @code{-fnot-register=@var{word}} -special register to disable -@item @code{-fregister=@var{word}} -special register to enable -@end table diff -Nru gnucobol-4.0~early~20200606/doc/cbintr.tex gnucobol-5/doc/cbintr.tex --- gnucobol-4.0~early~20200606/doc/cbintr.tex 2020-06-06 20:52:54.000000000 +0000 +++ gnucobol-5/doc/cbintr.tex 1970-01-01 00:00:00.000000000 +0000 @@ -1,110 +0,0 @@ -@multitable @columnfractions .40 .20 .40 -@headitem Intrinsic Function Implemented Parameters @tab @tab -@item @code{ABS Yes 1} @tab @tab -@item @code{ACOS Yes 1} @tab @tab -@item @code{ANNUITY Yes 2} @tab @tab -@item @code{ASIN Yes 1} @tab @tab -@item @code{ATAN Yes 1} @tab @tab -@item @code{BOOLEAN-OF-INTEGER No 2} @tab @tab -@item @code{BYTE-LENGTH Yes 1 - 2} @tab @tab -@item @code{CHAR Yes 1} @tab @tab -@item @code{CHAR-NATIONAL No 1} @tab @tab -@item @code{COMBINED-DATETIME Yes 2} @tab @tab -@item @code{CONCAT Yes Unlimited} @tab @tab -@item @code{CONCATENATE Yes Unlimited} @tab @tab -@item @code{CONTENT-LENGTH Yes 1} @tab @tab -@item @code{CONTENT-OF Yes 1 - 2} @tab @tab -@item @code{COS Yes 1} @tab @tab -@item @code{CURRENCY-SYMBOL Yes 0} @tab @tab -@item @code{CURRENT-DATE Yes 0} @tab @tab -@item @code{DATE-OF-INTEGER Yes 1} @tab @tab -@item @code{DATE-TO-YYYYMMDD Yes 1 - 3} @tab @tab -@item @code{DAY-OF-INTEGER Yes 1} @tab @tab -@item @code{DAY-TO-YYYYDDD Yes 1 - 3} @tab @tab -@item @code{DISPLAY-OF No 1 - 2} @tab @tab -@item @code{E Yes 0} @tab @tab -@item @code{EXCEPTION-FILE Yes 0} @tab @tab -@item @code{EXCEPTION-FILE-N No 0} @tab @tab -@item @code{EXCEPTION-LOCATION Yes 0} @tab @tab -@item @code{EXCEPTION-LOCATION-N No 0} @tab @tab -@item @code{EXCEPTION-STATEMENT Yes 0} @tab @tab -@item @code{EXCEPTION-STATUS Yes 0} @tab @tab -@item @code{EXP Yes 1} @tab @tab -@item @code{EXP10 Yes 1} @tab @tab -@item @code{FACTORIAL Yes 1} @tab @tab -@item @code{FORMATTED-CURRENT-DATE Yes 1} @tab @tab -@item @code{FORMATTED-DATE Yes 2} @tab @tab -@item @code{FORMATTED-DATETIME Yes 4 - 5} @tab @tab -@item @code{FORMATTED-TIME Yes 3 - 4} @tab @tab -@item @code{FRACTION-PART Yes 1} @tab @tab -@item @code{HIGHEST-ALGEBRAIC Yes 1} @tab @tab -@item @code{INTEGER Yes 1} @tab @tab -@item @code{INTEGER-OF-BOOLEAN No 1} @tab @tab -@item @code{INTEGER-OF-DATE Yes 1} @tab @tab -@item @code{INTEGER-OF-DAY Yes 1} @tab @tab -@item @code{INTEGER-OF-FORMATTED-DATE Yes 2} @tab @tab -@item @code{INTEGER-PART Yes 1} @tab @tab -@item @code{LENGTH Yes 1 - 2} @tab @tab -@item @code{LENGTH-AN Yes 1} @tab @tab -@item @code{LOCALE-COMPARE Yes 2 - 3} @tab @tab -@item @code{LOCALE-DATE Yes 1 - 2} @tab @tab -@item @code{LOCALE-TIME Yes 1 - 2} @tab @tab -@item @code{LOCALE-TIME-FROM-SECONDS Yes 1 - 2} @tab @tab -@item @code{LOG Yes 1} @tab @tab -@item @code{LOG10 Yes 1} @tab @tab -@item @code{LOWER-CASE Yes 1} @tab @tab -@item @code{LOWEST-ALGEBRAIC Yes 1} @tab @tab -@item @code{MAX Yes Unlimited} @tab @tab -@item @code{MEAN Yes Unlimited} @tab @tab -@item @code{MEDIAN Yes Unlimited} @tab @tab -@item @code{MIDRANGE Yes Unlimited} @tab @tab -@item @code{MIN Yes Unlimited} @tab @tab -@item @code{MOD Yes 2} @tab @tab -@item @code{MODULE-CALLER-ID Yes 0} @tab @tab -@item @code{MODULE-DATE Yes 0} @tab @tab -@item @code{MODULE-FORMATTED-DATE Yes 0} @tab @tab -@item @code{MODULE-ID Yes 0} @tab @tab -@item @code{MODULE-PATH Yes 0} @tab @tab -@item @code{MODULE-SOURCE Yes 0} @tab @tab -@item @code{MODULE-TIME Yes 0} @tab @tab -@item @code{MONETARY-DECIMAL-POINT Yes 0} @tab @tab -@item @code{MONETARY-THOUSANDS-SEPARATOR Yes 0} @tab @tab -@item @code{NATIONAL-OF No 1 - 2} @tab @tab -@item @code{NUMERIC-DECIMAL-POINT Yes 0} @tab @tab -@item @code{NUMERIC-THOUSANDS-SEPARATOR Yes 0} @tab @tab -@item @code{NUMVAL Yes 1} @tab @tab -@item @code{NUMVAL-C Yes 2} @tab @tab -@item @code{NUMVAL-F Yes 1} @tab @tab -@item @code{ORD Yes 1} @tab @tab -@item @code{ORD-MAX Yes Unlimited} @tab @tab -@item @code{ORD-MIN Yes Unlimited} @tab @tab -@item @code{PI Yes 0} @tab @tab -@item @code{PRESENT-VALUE Yes Unlimited} @tab @tab -@item @code{RANDOM Yes 0 - 1} @tab @tab -@item @code{RANGE Yes Unlimited} @tab @tab -@item @code{REM Yes 2} @tab @tab -@item @code{REVERSE Yes 1} @tab @tab -@item @code{SECONDS-FROM-FORMATTED-TIME Yes 2} @tab @tab -@item @code{SECONDS-PAST-MIDNIGHT Yes 0} @tab @tab -@item @code{SIGN Yes 1} @tab @tab -@item @code{SIN Yes 1} @tab @tab -@item @code{SQRT Yes 1} @tab @tab -@item @code{STANDARD-COMPARE No 2 - 4} @tab @tab -@item @code{STANDARD-DEVIATION Yes Unlimited} @tab @tab -@item @code{STORED-CHAR-LENGTH Yes 1} @tab @tab -@item @code{SUBSTITUTE Yes Unlimited} @tab @tab -@item @code{SUBSTITUTE-CASE Yes Unlimited} @tab @tab -@item @code{SUM Yes Unlimited} @tab @tab -@item @code{TAN Yes 1} @tab @tab -@item @code{TEST-DATE-YYYYMMDD Yes 1} @tab @tab -@item @code{TEST-DAY-YYYYDDD Yes 1} @tab @tab -@item @code{TEST-FORMATTED-DATETIME Yes 2} @tab @tab -@item @code{TEST-NUMVAL Yes 1} @tab @tab -@item @code{TEST-NUMVAL-C Yes 2} @tab @tab -@item @code{TEST-NUMVAL-F Yes 1} @tab @tab -@item @code{TRIM Yes 1 - 2} @tab @tab -@item @code{UPPER-CASE Yes 1} @tab @tab -@item @code{VARIANCE Yes Unlimited} @tab @tab -@item @code{WHEN-COMPILED Yes 0} @tab @tab -@item @code{YEAR-TO-YYYY Yes 1 - 3} @tab @tab -@end multitable diff -Nru gnucobol-4.0~early~20200606/doc/cbmnem.tex gnucobol-5/doc/cbmnem.tex --- gnucobol-4.0~early~20200606/doc/cbmnem.tex 2020-06-06 20:52:54.000000000 +0000 +++ gnucobol-5/doc/cbmnem.tex 1970-01-01 00:00:00.000000000 +0000 @@ -1,9 +0,0 @@ -@section System names: device -@code{SYSIN}, @code{SYSIPT}, @code{STDIN}, @code{SYSOUT}, @code{SYSLIST}, @code{SYSLST}, @code{SYSPCH}, @code{SYSPUNCH}, @code{STDOUT}, @code{PRINT}, @code{PRINTER}, @code{PRINTER-1}, @code{SYSERR}, @code{STDERR}, @code{CONSOLE} - -@section System names: feature -@code{C01}, @code{C02}, @code{C03}, @code{C04}, @code{C05}, @code{C06}, @code{C07}, @code{C08}, @code{C09}, @code{C10}, @code{C11}, @code{C12}, @code{S01}, @code{S02}, @code{S03}, @code{S04}, @code{S05}, @code{CSP}, @code{FORMFEED}, @code{TOP}, @code{CALL-CONVENTION} - -@section System names: switch -@code{SWITCH-0}, @code{SWITCH-1}, @code{SWITCH-2}, @code{SWITCH-3}, @code{SWITCH-4}, @code{SWITCH-5}, @code{SWITCH-6}, @code{SWITCH-7}, @code{SWITCH-8}, @code{SWITCH-9}, @code{SWITCH-10}, @code{SWITCH-11}, @code{SWITCH-12}, @code{SWITCH-13}, @code{SWITCH-14}, @code{SWITCH-15}, @code{SWITCH-16}, @code{SWITCH-17}, @code{SWITCH-18}, @code{SWITCH-19}, @code{SWITCH-20}, @code{SWITCH-21}, @code{SWITCH-22}, @code{SWITCH-23}, @code{SWITCH-24}, @code{SWITCH-25}, @code{SWITCH-26}, @code{SWITCH-27}, @code{SWITCH-28}, @code{SWITCH-29}, @code{SWITCH-30}, @code{SWITCH-31}, @code{SWITCH-32}, @code{SWITCH-33}, @code{SWITCH-34}, @code{SWITCH-35}, @code{SWITCH-36} - diff -Nru gnucobol-4.0~early~20200606/doc/cbrese.tex gnucobol-5/doc/cbrese.tex --- gnucobol-4.0~early~20200606/doc/cbrese.tex 2020-06-06 20:52:54.000000000 +0000 +++ gnucobol-5/doc/cbrese.tex 1970-01-01 00:00:00.000000000 +0000 @@ -1,969 +0,0 @@ -@section Common reserved words -@multitable @columnfractions .40 .20 .40 -@headitem Reserved word @tab Implemented @tab Aliases -@item @code{3-D} @tab Yes (C/S) @tab -@item @code{ABSENT} @tab Yes @tab -@item @code{ACCEPT} @tab Yes @tab -@item @code{ACCESS} @tab Yes @tab -@item @code{ACTION} @tab Yes (C/S) @tab -@item @code{ACTIVE-CLASS} @tab No @tab -@item @code{ACTIVE-X} @tab Yes (C/S) @tab -@item @code{ACTUAL} @tab Yes (C/S) @tab -@item @code{ADD} @tab Yes @tab -@item @code{ADDRESS} @tab Yes @tab -@item @code{ADJUSTABLE-COLUMNS} @tab Yes (C/S) @tab -@item @code{ADVANCING} @tab Yes @tab -@item @code{AFTER} @tab Yes @tab -@item @code{ALIGNED} @tab No @tab -@item @code{ALIGNMENT} @tab Yes (C/S) @tab -@item @code{ALL} @tab Yes @tab -@item @code{ALLOCATE} @tab Yes @tab -@item @code{ALLOWING} @tab Yes (C/S) @tab -@item @code{ALPHABET} @tab Yes @tab -@item @code{ALPHABETIC} @tab Yes @tab -@item @code{ALPHABETIC-LOWER} @tab Yes @tab -@item @code{ALPHABETIC-UPPER} @tab Yes @tab -@item @code{ALPHANUMERIC} @tab Yes @tab -@item @code{ALPHANUMERIC-EDITED} @tab Yes @tab -@item @code{ALSO} @tab Yes @tab -@item @code{ALTER} @tab Yes @tab -@item @code{ALTERNATE} @tab Yes @tab -@item @code{AND} @tab Yes @tab -@item @code{ANY} @tab Yes @tab -@item @code{ANYCASE} @tab No @tab -@item @code{APPLY} @tab Yes (C/S) @tab -@item @code{ARE} @tab Yes @tab -@item @code{AREA} @tab Yes @tab @code{AREAS} -@item @code{AREAS} @tab Yes @tab @code{AREA} -@item @code{ARGUMENT-NUMBER} @tab Yes @tab -@item @code{ARGUMENT-VALUE} @tab Yes @tab -@item @code{ARITHMETIC} @tab Yes (C/S) @tab -@item @code{AS} @tab Yes @tab -@item @code{ASCENDING} @tab Yes @tab -@item @code{ASCII} @tab Yes (C/S) @tab -@item @code{ASSIGN} @tab Yes @tab -@item @code{AT} @tab Yes @tab -@item @code{ATTRIBUTE} @tab Yes (C/S) @tab -@item @code{ATTRIBUTES} @tab Yes (C/S) @tab -@item @code{AUTO} @tab Yes (C/S) @tab @code{AUTO-SKIP, AUTOTERMINATE} -@item @code{AUTO-DECIMAL} @tab Yes (C/S) @tab -@item @code{AUTO-SKIP} @tab Yes @tab @code{AUTO, AUTOTERMINATE} -@item @code{AUTO-SPIN} @tab Yes (C/S) @tab -@item @code{AUTOMATIC} @tab Yes @tab -@item @code{AUTOTERMINATE} @tab Yes @tab @code{AUTO, AUTO-SKIP} -@item @code{AWAY-FROM-ZERO} @tab Yes (C/S) @tab -@item @code{B-AND} @tab No @tab -@item @code{B-NOT} @tab No @tab -@item @code{B-OR} @tab No @tab -@item @code{B-XOR} @tab No @tab -@item @code{BACKGROUND-COLOR} @tab Yes (C/S) @tab @code{BACKGROUND-COLOUR} -@item @code{BACKGROUND-COLOUR} @tab Yes @tab @code{BACKGROUND-COLOR} -@item @code{BACKGROUND-HIGH} @tab Yes @tab -@item @code{BACKGROUND-LOW} @tab Yes @tab -@item @code{BACKGROUND-STANDARD} @tab Yes @tab -@item @code{BAR} @tab Yes (C/S) @tab -@item @code{BASED} @tab Yes @tab -@item @code{BEEP} @tab Yes @tab @code{BELL} -@item @code{BEFORE} @tab Yes @tab -@item @code{BELL} @tab Yes (C/S) @tab @code{BEEP} -@item @code{BINARY} @tab Yes @tab -@item @code{BINARY-C-LONG} @tab Yes @tab -@item @code{BINARY-CHAR} @tab Yes @tab -@item @code{BINARY-DOUBLE} @tab Yes @tab @code{BINARY-LONG-LONG} -@item @code{BINARY-INT} @tab Yes @tab @code{BINARY-LONG} -@item @code{BINARY-LONG} @tab Yes @tab @code{BINARY-INT} -@item @code{BINARY-LONG-LONG} @tab Yes @tab @code{BINARY-DOUBLE} -@item @code{BINARY-SEQUENTIAL} @tab Yes (C/S) @tab -@item @code{BINARY-SHORT} @tab Yes @tab -@item @code{BIT} @tab Yes @tab -@item @code{BITMAP} @tab Yes (C/S) @tab -@item @code{BITMAP-END} @tab Yes (C/S) @tab -@item @code{BITMAP-HANDLE} @tab Yes (C/S) @tab -@item @code{BITMAP-NUMBER} @tab Yes (C/S) @tab -@item @code{BITMAP-START} @tab Yes (C/S) @tab -@item @code{BITMAP-TIMER} @tab Yes (C/S) @tab -@item @code{BITMAP-TRAILING} @tab Yes (C/S) @tab -@item @code{BITMAP-TRANSPARENT-COLOR} @tab Yes (C/S) @tab -@item @code{BITMAP-WIDTH} @tab Yes (C/S) @tab -@item @code{BLANK} @tab Yes @tab -@item @code{BLINK} @tab Yes (C/S) @tab -@item @code{BLOCK} @tab Yes @tab -@item @code{BOOLEAN} @tab No @tab -@item @code{BOTTOM} @tab Yes @tab -@item @code{BOX} @tab Yes (C/S) @tab -@item @code{BOXED} @tab Yes (C/S) @tab -@item @code{BULK-ADDITION} @tab Yes (C/S) @tab -@item @code{BUSY} @tab Yes (C/S) @tab -@item @code{BUTTONS} @tab Yes (C/S) @tab -@item @code{BY} @tab Yes @tab -@item @code{BYTE-LENGTH} @tab Yes (C/S) @tab -@item @code{C} @tab Yes (C/S) @tab -@item @code{CALENDAR-FONT} @tab Yes (C/S) @tab -@item @code{CALL} @tab Yes @tab -@item @code{CANCEL} @tab Yes @tab -@item @code{CANCEL-BUTTON} @tab Yes (C/S) @tab -@item @code{CAPACITY} @tab Yes (C/S) @tab -@item @code{CARD-PUNCH} @tab Yes (C/S) @tab -@item @code{CARD-READER} @tab Yes (C/S) @tab -@item @code{CASSETTE} @tab Yes (C/S) @tab -@item @code{CCOL} @tab Yes (C/S) @tab -@item @code{CD} @tab Yes @tab -@item @code{CELL} @tab Yes (C/S) @tab @code{CELLS} -@item @code{CELL-COLOR} @tab Yes (C/S) @tab -@item @code{CELL-DATA} @tab Yes (C/S) @tab -@item @code{CELL-FONT} @tab Yes (C/S) @tab -@item @code{CELL-PROTECTION} @tab Yes (C/S) @tab -@item @code{CELLS} @tab Yes @tab @code{CELL} -@item @code{CENTER} @tab Yes (C/S) @tab -@item @code{CENTERED} @tab Yes (C/S) @tab -@item @code{CENTERED-HEADINGS} @tab Yes (C/S) @tab -@item @code{CENTURY-DATE} @tab Yes (C/S) @tab -@item @code{CF} @tab Yes @tab -@item @code{CH} @tab Yes @tab -@item @code{CHAIN} @tab No @tab -@item @code{CHAINING} @tab Yes @tab -@item @code{CHARACTER} @tab Yes @tab -@item @code{CHARACTERS} @tab Yes @tab -@item @code{CHECK-BOX} @tab Yes (C/S) @tab -@item @code{CLASS} @tab Yes @tab -@item @code{CLASS-ID} @tab No @tab -@item @code{CLASSIFICATION} @tab Yes (C/S) @tab -@item @code{CLEAR-SELECTION} @tab Yes (C/S) @tab -@item @code{CLINE} @tab Yes (C/S) @tab -@item @code{CLINES} @tab Yes (C/S) @tab -@item @code{CLOSE} @tab Yes @tab -@item @code{COBOL} @tab Yes (C/S) @tab -@item @code{CODE} @tab Yes @tab -@item @code{CODE-SET} @tab Yes @tab -@item @code{COL} @tab Yes @tab -@item @code{COLLATING} @tab Yes @tab -@item @code{COLOR} @tab Yes @tab -@item @code{COLORS} @tab Yes (C/S) @tab @code{COLOURS} -@item @code{COLOURS} @tab Yes @tab @code{COLORS} -@item @code{COLS} @tab Yes @tab -@item @code{COLUMN} @tab Yes @tab -@item @code{COLUMN-COLOR} @tab Yes (C/S) @tab -@item @code{COLUMN-DIVIDERS} @tab Yes (C/S) @tab -@item @code{COLUMN-FONT} @tab Yes (C/S) @tab -@item @code{COLUMN-HEADINGS} @tab Yes (C/S) @tab -@item @code{COLUMN-PROTECTION} @tab Yes (C/S) @tab -@item @code{COLUMNS} @tab Yes @tab -@item @code{COMBO-BOX} @tab Yes (C/S) @tab -@item @code{COMMA} @tab Yes @tab -@item @code{COMMAND-LINE} @tab Yes @tab -@item @code{COMMIT} @tab Yes @tab -@item @code{COMMON} @tab Yes @tab -@item @code{COMMUNICATION} @tab Yes @tab -@item @code{COMP} @tab Yes @tab @code{COMPUTATIONAL} -@item @code{COMP-0} @tab Yes @tab @code{COMPUTATIONAL-0} -@item @code{COMP-1} @tab Yes @tab @code{COMPUTATIONAL-1} -@item @code{COMP-2} @tab Yes @tab @code{COMPUTATIONAL-2} -@item @code{COMP-3} @tab Yes @tab @code{COMPUTATIONAL-3} -@item @code{COMP-4} @tab Yes @tab @code{COMPUTATIONAL-4} -@item @code{COMP-5} @tab Yes @tab @code{COMPUTATIONAL-5} -@item @code{COMP-6} @tab Yes @tab @code{COMPUTATIONAL-6} -@item @code{COMP-N} @tab Yes @tab @code{COMPUTATIONAL-N} -@item @code{COMP-X} @tab Yes @tab @code{COMPUTATIONAL-X} -@item @code{COMPUTATIONAL} @tab Yes @tab @code{COMP} -@item @code{COMPUTATIONAL-0} @tab Yes @tab @code{COMP-0} -@item @code{COMPUTATIONAL-1} @tab Yes @tab @code{COMP-1} -@item @code{COMPUTATIONAL-2} @tab Yes @tab @code{COMP-2} -@item @code{COMPUTATIONAL-3} @tab Yes @tab @code{COMP-3} -@item @code{COMPUTATIONAL-4} @tab Yes @tab @code{COMP-4} -@item @code{COMPUTATIONAL-5} @tab Yes @tab @code{COMP-5} -@item @code{COMPUTATIONAL-6} @tab Yes @tab @code{COMP-6} -@item @code{COMPUTATIONAL-N} @tab Yes @tab @code{COMP-N} -@item @code{COMPUTATIONAL-X} @tab Yes @tab @code{COMP-X} -@item @code{COMPUTE} @tab Yes @tab -@item @code{CONDITION} @tab Yes @tab -@item @code{CONFIGURATION} @tab Yes @tab -@item @code{CONSTANT} @tab Yes @tab -@item @code{CONTAINS} @tab Yes @tab -@item @code{CONTENT} @tab Yes @tab -@item @code{CONTINUE} @tab Yes @tab -@item @code{CONTROL} @tab Yes @tab -@item @code{CONTROLS} @tab Yes @tab -@item @code{CONVERSION} @tab Yes (C/S) @tab -@item @code{CONVERTING} @tab Yes @tab -@item @code{COPY} @tab Yes @tab -@item @code{COPY-SELECTION} @tab Yes (C/S) @tab -@item @code{CORE-INDEX} @tab Yes (C/S) @tab -@item @code{CORR} @tab Yes @tab @code{CORRESPONDING} -@item @code{CORRESPONDING} @tab Yes @tab @code{CORR} -@item @code{COUNT} @tab Yes @tab -@item @code{CRT} @tab Yes @tab -@item @code{CRT-UNDER} @tab Yes @tab -@item @code{CSIZE} @tab Yes (C/S) @tab -@item @code{CURRENCY} @tab Yes @tab -@item @code{CURSOR} @tab Yes @tab -@item @code{CURSOR-COL} @tab Yes (C/S) @tab -@item @code{CURSOR-COLOR} @tab Yes (C/S) @tab -@item @code{CURSOR-FRAME-WIDTH} @tab Yes (C/S) @tab -@item @code{CURSOR-ROW} @tab Yes (C/S) @tab -@item @code{CURSOR-X} @tab Yes (C/S) @tab -@item @code{CURSOR-Y} @tab Yes (C/S) @tab -@item @code{CUSTOM-PRINT-TEMPLATE} @tab Yes (C/S) @tab -@item @code{CYCLE} @tab Yes (C/S) @tab -@item @code{CYL-INDEX} @tab Yes (C/S) @tab -@item @code{CYL-OVERFLOW} @tab Yes (C/S) @tab -@item @code{DASHED} @tab Yes (C/S) @tab -@item @code{DATA} @tab Yes @tab -@item @code{DATA-COLUMNS} @tab Yes (C/S) @tab -@item @code{DATA-POINTER} @tab No @tab -@item @code{DATA-TYPES} @tab Yes (C/S) @tab -@item @code{DATE} @tab Yes @tab -@item @code{DATE-ENTRY} @tab Yes (C/S) @tab -@item @code{DAY} @tab Yes @tab -@item @code{DAY-OF-WEEK} @tab Yes @tab -@item @code{DE} @tab Yes @tab -@item @code{DEBUGGING} @tab Yes @tab -@item @code{DECIMAL-POINT} @tab Yes @tab -@item @code{DECLARATIVES} @tab Yes @tab -@item @code{DEFAULT} @tab Yes @tab -@item @code{DEFAULT-BUTTON} @tab Yes (C/S) @tab -@item @code{DEFAULT-FONT} @tab Yes @tab -@item @code{DELETE} @tab Yes @tab -@item @code{DELIMITED} @tab Yes @tab -@item @code{DELIMITER} @tab Yes @tab -@item @code{DEPENDING} @tab Yes @tab -@item @code{DESCENDING} @tab Yes @tab -@item @code{DESTINATION} @tab Yes @tab -@item @code{DESTROY} @tab Yes @tab -@item @code{DETAIL} @tab Yes @tab -@item @code{DISABLE} @tab Yes @tab -@item @code{DISC} @tab Yes (C/S) @tab -@item @code{DISK} @tab Yes (C/S) @tab -@item @code{DISP} @tab Yes (C/S) @tab -@item @code{DISPLAY} @tab Yes @tab -@item @code{DISPLAY-COLUMNS} @tab Yes (C/S) @tab -@item @code{DISPLAY-FORMAT} @tab Yes (C/S) @tab -@item @code{DIVIDE} @tab Yes @tab -@item @code{DIVIDER-COLOR} @tab Yes (C/S) @tab -@item @code{DIVIDERS} @tab Yes (C/S) @tab -@item @code{DIVISION} @tab Yes @tab -@item @code{DOTDASH} @tab Yes (C/S) @tab -@item @code{DOTTED} @tab Yes (C/S) @tab -@item @code{DOUBLE} @tab Yes @tab @code{FLOAT-LONG} -@item @code{DOWN} @tab Yes @tab -@item @code{DRAG-COLOR} @tab Yes (C/S) @tab -@item @code{DROP-DOWN} @tab Yes (C/S) @tab -@item @code{DROP-LIST} @tab Yes (C/S) @tab -@item @code{DUPLICATES} @tab Yes @tab -@item @code{DYNAMIC} @tab Yes @tab -@item @code{EBCDIC} @tab Yes (C/S) @tab -@item @code{EC} @tab Yes @tab -@item @code{ECHO} @tab Yes @tab -@item @code{EGI} @tab Yes @tab -@item @code{ELEMENT} @tab Yes (C/S) @tab -@item @code{ELSE} @tab Yes @tab -@item @code{EMI} @tab Yes @tab -@item @code{EMPTY-CHECK} @tab Yes @tab @code{REQUIRED} -@item @code{ENABLE} @tab Yes @tab -@item @code{ENABLED} @tab Yes (C/S) @tab -@item @code{ENCODING} @tab Yes (C/S) @tab -@item @code{ENCRYPTION} @tab Yes (C/S) @tab -@item @code{END} @tab Yes @tab -@item @code{END-ACCEPT} @tab Yes @tab -@item @code{END-ADD} @tab Yes @tab -@item @code{END-CALL} @tab Yes @tab -@item @code{END-CHAIN} @tab No @tab -@item @code{END-COLOR} @tab Yes (C/S) @tab -@item @code{END-COMPUTE} @tab Yes @tab -@item @code{END-DELETE} @tab Yes @tab -@item @code{END-DISPLAY} @tab Yes @tab -@item @code{END-DIVIDE} @tab Yes @tab -@item @code{END-EVALUATE} @tab Yes @tab -@item @code{END-IF} @tab Yes @tab -@item @code{END-JSON} @tab Yes @tab -@item @code{END-MODIFY} @tab Yes (C/S) @tab -@item @code{END-MULTIPLY} @tab Yes @tab -@item @code{END-OF-PAGE} @tab Yes @tab @code{EOP} -@item @code{END-PERFORM} @tab Yes @tab -@item @code{END-READ} @tab Yes @tab -@item @code{END-RECEIVE} @tab Yes @tab -@item @code{END-RETURN} @tab Yes @tab -@item @code{END-REWRITE} @tab Yes @tab -@item @code{END-SEARCH} @tab Yes @tab -@item @code{END-START} @tab Yes @tab -@item @code{END-STRING} @tab Yes @tab -@item @code{END-SUBTRACT} @tab Yes @tab -@item @code{END-UNSTRING} @tab Yes @tab -@item @code{END-WRITE} @tab Yes @tab -@item @code{END-XML} @tab Yes @tab -@item @code{ENGRAVED} @tab Yes (C/S) @tab -@item @code{ENSURE-VISIBLE} @tab Yes (C/S) @tab -@item @code{ENTRY} @tab Yes @tab -@item @code{ENTRY-CONVENTION} @tab Yes (C/S) @tab -@item @code{ENTRY-FIELD} @tab Yes (C/S) @tab -@item @code{ENTRY-REASON} @tab Yes (C/S) @tab -@item @code{ENVIRONMENT} @tab Yes @tab -@item @code{ENVIRONMENT-NAME} @tab Yes @tab -@item @code{ENVIRONMENT-VALUE} @tab Yes @tab -@item @code{EO} @tab No @tab -@item @code{EOL} @tab Yes (C/S) @tab -@item @code{EOP} @tab Yes @tab @code{END-OF-PAGE} -@item @code{EOS} @tab Yes (C/S) @tab -@item @code{EQUAL} @tab Yes @tab @code{EQUALS} -@item @code{EQUALS} @tab Yes @tab @code{EQUAL} -@item @code{ERASE} @tab Yes (C/S) @tab -@item @code{ERROR} @tab Yes @tab -@item @code{ESCAPE} @tab Yes @tab -@item @code{ESCAPE-BUTTON} @tab Yes (C/S) @tab -@item @code{ESI} @tab Yes @tab -@item @code{EVALUATE} @tab Yes @tab -@item @code{EVENT} @tab Yes @tab -@item @code{EVENT-LIST} @tab Yes (C/S) @tab -@item @code{EVERY} @tab Yes (C/S) @tab -@item @code{EXCEPTION} @tab Yes @tab -@item @code{EXCEPTION-OBJECT} @tab No @tab -@item @code{EXCEPTION-VALUE} @tab Yes (C/S) @tab -@item @code{EXCLUSIVE} @tab Yes @tab -@item @code{EXIT} @tab Yes @tab -@item @code{EXPAND} @tab Yes (C/S) @tab -@item @code{EXPANDS} @tab No (C/S) @tab -@item @code{EXTEND} @tab Yes @tab -@item @code{EXTENDED-SEARCH} @tab Yes (C/S) @tab -@item @code{EXTERN} @tab Yes (C/S) @tab -@item @code{EXTERNAL} @tab Yes @tab -@item @code{EXTERNAL-FORM} @tab Yes @tab -@item @code{F} @tab Yes (C/S) @tab -@item @code{FACTORY} @tab No @tab -@item @code{FALSE} @tab Yes @tab -@item @code{FD} @tab Yes @tab -@item @code{FH--FCD} @tab Yes (C/S) @tab -@item @code{FH--KEYDEF} @tab Yes (C/S) @tab -@item @code{FILE} @tab Yes @tab -@item @code{FILE-CONTROL} @tab Yes @tab -@item @code{FILE-ID} @tab Yes @tab -@item @code{FILE-LIMIT} @tab Yes (C/S) @tab -@item @code{FILE-LIMITS} @tab Yes (C/S) @tab -@item @code{FILE-NAME} @tab Yes (C/S) @tab -@item @code{FILE-POS} @tab Yes (C/S) @tab -@item @code{FILL-COLOR} @tab Yes (C/S) @tab -@item @code{FILL-COLOR2} @tab Yes (C/S) @tab -@item @code{FILL-PERCENT} @tab Yes (C/S) @tab -@item @code{FILLER} @tab Yes @tab -@item @code{FINAL} @tab Yes @tab -@item @code{FINISH-REASON} @tab Yes (C/S) @tab -@item @code{FIRST} @tab Yes @tab -@item @code{FIXED} @tab Yes @tab -@item @code{FIXED-FONT} @tab Yes @tab -@item @code{FIXED-WIDTH} @tab Yes (C/S) @tab -@item @code{FLAT} @tab Yes (C/S) @tab -@item @code{FLAT-BUTTONS} @tab Yes (C/S) @tab -@item @code{FLOAT} @tab Yes @tab @code{FLOAT-SHORT} -@item @code{FLOAT-BINARY-128} @tab No @tab -@item @code{FLOAT-BINARY-32} @tab No @tab -@item @code{FLOAT-BINARY-64} @tab No @tab -@item @code{FLOAT-DECIMAL-16} @tab Yes @tab -@item @code{FLOAT-DECIMAL-34} @tab Yes @tab -@item @code{FLOAT-EXTENDED} @tab No @tab -@item @code{FLOAT-INFINITY} @tab No @tab -@item @code{FLOAT-LONG} @tab Yes @tab @code{DOUBLE} -@item @code{FLOAT-NOT-A-NUMBER} @tab No (C/S) @tab -@item @code{FLOAT-SHORT} @tab Yes @tab @code{FLOAT} -@item @code{FLOATING} @tab Yes @tab -@item @code{FONT} @tab Yes @tab -@item @code{FOOTING} @tab Yes @tab -@item @code{FOR} @tab Yes @tab -@item @code{FOREGROUND-COLOR} @tab Yes (C/S) @tab @code{FOREGROUND-COLOUR} -@item @code{FOREGROUND-COLOUR} @tab Yes @tab @code{FOREGROUND-COLOR} -@item @code{FOREVER} @tab Yes (C/S) @tab -@item @code{FORMAT} @tab No @tab -@item @code{FRAME} @tab Yes (C/S) @tab -@item @code{FRAMED} @tab Yes (C/S) @tab -@item @code{FREE} @tab Yes @tab -@item @code{FROM} @tab Yes @tab -@item @code{FULL} @tab Yes (C/S) @tab @code{LENGTH-CHECK} -@item @code{FULL-HEIGHT} @tab Yes (C/S) @tab -@item @code{FUNCTION} @tab Yes @tab -@item @code{FUNCTION-ID} @tab Yes @tab -@item @code{FUNCTION-POINTER} @tab No @tab -@item @code{GENERATE} @tab Yes @tab -@item @code{GET} @tab No @tab -@item @code{GIVING} @tab Yes @tab -@item @code{GLOBAL} @tab Yes @tab -@item @code{GO} @tab Yes @tab -@item @code{GO-BACK} @tab Yes (C/S) @tab -@item @code{GO-FORWARD} @tab Yes (C/S) @tab -@item @code{GO-HOME} @tab Yes (C/S) @tab -@item @code{GO-SEARCH} @tab Yes (C/S) @tab -@item @code{GOBACK} @tab Yes @tab -@item @code{GRAPHICAL} @tab Yes (C/S) @tab -@item @code{GREATER} @tab Yes @tab -@item @code{GRID} @tab Yes (C/S) @tab -@item @code{GROUP} @tab Yes @tab -@item @code{GROUP-USAGE} @tab No @tab -@item @code{GROUP-VALUE} @tab Yes (C/S) @tab -@item @code{HANDLE} @tab Yes @tab -@item @code{HAS-CHILDREN} @tab Yes (C/S) @tab -@item @code{HEADING} @tab Yes @tab -@item @code{HEADING-COLOR} @tab Yes (C/S) @tab -@item @code{HEADING-DIVIDER-COLOR} @tab Yes (C/S) @tab -@item @code{HEADING-FONT} @tab Yes (C/S) @tab -@item @code{HEAVY} @tab Yes (C/S) @tab -@item @code{HEIGHT-IN-CELLS} @tab Yes (C/S) @tab -@item @code{HELP-ID} @tab Yes (C/S) @tab -@item @code{HIDDEN-DATA} @tab Yes (C/S) @tab -@item @code{HIGH-COLOR} @tab Yes (C/S) @tab -@item @code{HIGH-VALUE} @tab Yes @tab @code{HIGH-VALUES} -@item @code{HIGH-VALUES} @tab Yes @tab @code{HIGH-VALUE} -@item @code{HIGHLIGHT} @tab Yes (C/S) @tab -@item @code{HOT-TRACK} @tab Yes (C/S) @tab -@item @code{HSCROLL} @tab Yes (C/S) @tab -@item @code{HSCROLL-POS} @tab Yes (C/S) @tab -@item @code{I-O} @tab Yes @tab -@item @code{I-O-CONTROL} @tab Yes @tab -@item @code{ICON} @tab Yes (C/S) @tab -@item @code{ID} @tab Yes @tab -@item @code{IDENTIFICATION} @tab Yes @tab -@item @code{IDENTIFIED} @tab Yes @tab -@item @code{IF} @tab Yes @tab -@item @code{IGNORE} @tab Yes @tab -@item @code{IGNORING} @tab Yes (C/S) @tab -@item @code{IMPLEMENTS} @tab No (C/S) @tab -@item @code{IN} @tab Yes @tab -@item @code{INDEPENDENT} @tab Yes (C/S) @tab -@item @code{INDEX} @tab Yes @tab -@item @code{INDEXED} @tab Yes @tab -@item @code{INDICATE} @tab Yes @tab -@item @code{INHERITS} @tab No @tab -@item @code{INITIAL} @tab Yes @tab -@item @code{INITIALISE} @tab Yes @tab @code{INITIALIZE} -@item @code{INITIALISED} @tab Yes @tab @code{INITIALIZED} -@item @code{INITIALIZE} @tab Yes @tab @code{INITIALISE} -@item @code{INITIALIZED} @tab Yes (C/S) @tab @code{INITIALISED} -@item @code{INITIATE} @tab Yes @tab -@item @code{INPUT} @tab Yes @tab -@item @code{INPUT-OUTPUT} @tab Yes @tab -@item @code{INQUIRE} @tab Yes @tab -@item @code{INSERT-ROWS} @tab Yes (C/S) @tab -@item @code{INSERTION-INDEX} @tab Yes (C/S) @tab -@item @code{INSPECT} @tab Yes @tab -@item @code{INTERFACE} @tab No @tab -@item @code{INTERFACE-ID} @tab No @tab -@item @code{INTERMEDIATE} @tab Yes (C/S) @tab -@item @code{INTO} @tab Yes @tab -@item @code{INTRINSIC} @tab Yes (C/S) @tab -@item @code{INVALID} @tab Yes @tab -@item @code{INVOKE} @tab No @tab -@item @code{IS} @tab Yes @tab -@item @code{ITEM} @tab Yes (C/S) @tab -@item @code{ITEM-TEXT} @tab Yes (C/S) @tab -@item @code{ITEM-TO-ADD} @tab Yes (C/S) @tab -@item @code{ITEM-TO-DELETE} @tab Yes (C/S) @tab -@item @code{ITEM-TO-EMPTY} @tab Yes (C/S) @tab -@item @code{ITEM-VALUE} @tab Yes (C/S) @tab -@item @code{JSON} @tab Yes @tab -@item @code{JUST} @tab Yes @tab @code{JUSTIFIED} -@item @code{JUSTIFIED} @tab Yes @tab @code{JUST} -@item @code{KEPT} @tab Yes @tab -@item @code{KEY} @tab Yes @tab -@item @code{KEYBOARD} @tab Yes (C/S) @tab -@item @code{LABEL} @tab Yes @tab -@item @code{LABEL-OFFSET} @tab Yes (C/S) @tab -@item @code{LARGE-FONT} @tab Yes @tab -@item @code{LARGE-OFFSET} @tab Yes (C/S) @tab -@item @code{LAST} @tab Yes @tab -@item @code{LAST-ROW} @tab Yes (C/S) @tab -@item @code{LAYOUT-DATA} @tab Yes (C/S) @tab -@item @code{LAYOUT-MANAGER} @tab Yes @tab -@item @code{LC_ALL} @tab No (C/S) @tab -@item @code{LC_COLLATE} @tab No (C/S) @tab -@item @code{LC_CTYPE} @tab No (C/S) @tab -@item @code{LC_MESSAGES} @tab No (C/S) @tab -@item @code{LC_MONETARY} @tab No (C/S) @tab -@item @code{LC_NUMERIC} @tab No (C/S) @tab -@item @code{LC_TIME} @tab No (C/S) @tab -@item @code{LEADING} @tab Yes @tab -@item @code{LEADING-SHIFT} @tab Yes (C/S) @tab -@item @code{LEAVE} @tab Yes (C/S) @tab -@item @code{LEFT} @tab Yes @tab -@item @code{LEFT-JUSTIFY} @tab No @tab -@item @code{LEFT-TEXT} @tab Yes (C/S) @tab -@item @code{LEFTLINE} @tab Yes @tab -@item @code{LENGTH} @tab Yes @tab -@item @code{LENGTH-CHECK} @tab Yes @tab @code{FULL} -@item @code{LESS} @tab Yes @tab -@item @code{LIMIT} @tab Yes @tab -@item @code{LIMITS} @tab Yes @tab -@item @code{LINAGE} @tab Yes @tab -@item @code{LINAGE-COUNTER} @tab Yes @tab -@item @code{LINE} @tab Yes @tab -@item @code{LINE-COUNTER} @tab Yes @tab -@item @code{LINE-SEQUENTIAL} @tab Yes (C/S) @tab -@item @code{LINES} @tab Yes @tab -@item @code{LINES-AT-ROOT} @tab Yes (C/S) @tab -@item @code{LINKAGE} @tab Yes @tab -@item @code{LIST-BOX} @tab Yes (C/S) @tab -@item @code{LM-RESIZE} @tab Yes @tab -@item @code{LOC} @tab Yes (C/S) @tab -@item @code{LOCAL-STORAGE} @tab Yes @tab -@item @code{LOCALE} @tab Yes @tab -@item @code{LOCK} @tab Yes @tab -@item @code{LOCK-HOLDING} @tab Yes (C/S) @tab -@item @code{LONG-DATE} @tab Yes (C/S) @tab -@item @code{LOW-COLOR} @tab Yes (C/S) @tab -@item @code{LOW-VALUE} @tab Yes @tab @code{LOW-VALUES} -@item @code{LOW-VALUES} @tab Yes @tab @code{LOW-VALUE} -@item @code{LOWER} @tab Yes (C/S) @tab -@item @code{LOWERED} @tab Yes (C/S) @tab -@item @code{LOWLIGHT} @tab Yes (C/S) @tab -@item @code{MAGNETIC-TAPE} @tab Yes (C/S) @tab -@item @code{MANUAL} @tab Yes @tab -@item @code{MASS-UPDATE} @tab Yes (C/S) @tab -@item @code{MASTER-INDEX} @tab Yes (C/S) @tab -@item @code{MAX-LINES} @tab Yes (C/S) @tab -@item @code{MAX-PROGRESS} @tab Yes (C/S) @tab -@item @code{MAX-TEXT} @tab Yes (C/S) @tab -@item @code{MAX-VAL} @tab Yes (C/S) @tab -@item @code{MEDIUM-FONT} @tab Yes @tab -@item @code{MEMORY} @tab Yes (C/S) @tab -@item @code{MENU} @tab Yes @tab -@item @code{MERGE} @tab Yes @tab -@item @code{MESSAGE} @tab Yes @tab -@item @code{METHOD} @tab No @tab -@item @code{METHOD-ID} @tab No @tab -@item @code{MIN-VAL} @tab Yes (C/S) @tab -@item @code{MINUS} @tab Yes @tab -@item @code{MODE} @tab Yes @tab -@item @code{MODIFY} @tab Yes @tab -@item @code{MODULES} @tab Yes (C/S) @tab -@item @code{MOVE} @tab Yes @tab -@item @code{MULTILINE} @tab Yes (C/S) @tab -@item @code{MULTIPLE} @tab Yes @tab -@item @code{MULTIPLY} @tab Yes @tab -@item @code{NAME} @tab Yes (C/S) @tab -@item @code{NAMESPACE} @tab Yes (C/S) @tab -@item @code{NAMESPACE-PREFIX} @tab Yes (C/S) @tab -@item @code{NATIONAL} @tab Yes @tab -@item @code{NATIONAL-EDITED} @tab Yes @tab -@item @code{NATIVE} @tab Yes @tab -@item @code{NAVIGATE-URL} @tab Yes (C/S) @tab -@item @code{NEAREST-AWAY-FROM-ZERO} @tab Yes (C/S) @tab -@item @code{NEAREST-EVEN} @tab Yes (C/S) @tab -@item @code{NEAREST-TOWARD-ZERO} @tab Yes (C/S) @tab -@item @code{NEGATIVE} @tab Yes @tab -@item @code{NESTED} @tab Yes @tab -@item @code{NEW} @tab Yes @tab -@item @code{NEXT} @tab Yes @tab -@item @code{NEXT-ITEM} @tab Yes (C/S) @tab -@item @code{NO} @tab Yes @tab -@item @code{NO-AUTO-DEFAULT} @tab Yes (C/S) @tab -@item @code{NO-AUTOSEL} @tab Yes (C/S) @tab -@item @code{NO-BOX} @tab Yes (C/S) @tab -@item @code{NO-DIVIDERS} @tab Yes (C/S) @tab -@item @code{NO-ECHO} @tab Yes @tab -@item @code{NO-F4} @tab Yes (C/S) @tab -@item @code{NO-FOCUS} @tab Yes (C/S) @tab -@item @code{NO-GROUP-TAB} @tab Yes (C/S) @tab -@item @code{NO-KEY-LETTER} @tab Yes (C/S) @tab -@item @code{NO-SEARCH} @tab Yes (C/S) @tab -@item @code{NO-UPDOWN} @tab Yes (C/S) @tab -@item @code{NOMINAL} @tab Yes (C/S) @tab -@item @code{NONE} @tab No (C/S) @tab -@item @code{NONNUMERIC} @tab Yes (C/S) @tab -@item @code{NORMAL} @tab Yes (C/S) @tab -@item @code{NOT} @tab Yes @tab -@item @code{NOTAB} @tab Yes (C/S) @tab -@item @code{NOTHING} @tab Yes @tab -@item @code{NOTIFY} @tab Yes (C/S) @tab -@item @code{NOTIFY-CHANGE} @tab Yes (C/S) @tab -@item @code{NOTIFY-DBLCLICK} @tab Yes (C/S) @tab -@item @code{NOTIFY-SELCHANGE} @tab Yes (C/S) @tab -@item @code{NULL} @tab Yes @tab @code{NULLS} -@item @code{NULLS} @tab Yes @tab @code{NULL} -@item @code{NUM-COL-HEADINGS} @tab Yes (C/S) @tab -@item @code{NUM-ROWS} @tab Yes (C/S) @tab -@item @code{NUMBER} @tab Yes @tab -@item @code{NUMBERS} @tab Yes @tab -@item @code{NUMERIC} @tab Yes @tab -@item @code{NUMERIC-EDITED} @tab Yes @tab -@item @code{NUMERIC-FILL} @tab No (C/S) @tab -@item @code{OBJECT} @tab Yes @tab -@item @code{OBJECT-COMPUTER} @tab Yes @tab -@item @code{OBJECT-REFERENCE} @tab No @tab -@item @code{OCCURS} @tab Yes @tab -@item @code{OF} @tab Yes @tab -@item @code{OFF} @tab Yes @tab -@item @code{OK-BUTTON} @tab Yes (C/S) @tab -@item @code{OMITTED} @tab Yes @tab -@item @code{ON} @tab Yes @tab -@item @code{ONLY} @tab Yes @tab -@item @code{OPEN} @tab Yes @tab -@item @code{OPTIONAL} @tab Yes @tab -@item @code{OPTIONS} @tab Yes @tab -@item @code{OR} @tab Yes @tab -@item @code{ORDER} @tab Yes @tab -@item @code{ORGANISATION} @tab Yes @tab @code{ORGANIZATION} -@item @code{ORGANIZATION} @tab Yes @tab @code{ORGANISATION} -@item @code{OTHER} @tab Yes @tab -@item @code{OTHERS} @tab Yes (C/S) @tab -@item @code{OUTPUT} @tab Yes @tab -@item @code{OVERFLOW} @tab Yes @tab -@item @code{OVERLAP-LEFT} @tab Yes (C/S) @tab @code{OVERLAP-TOP} -@item @code{OVERLAP-TOP} @tab Yes (C/S) @tab @code{OVERLAP-LEFT} -@item @code{OVERLINE} @tab Yes @tab -@item @code{OVERRIDE} @tab No @tab -@item @code{PACKED-DECIMAL} @tab Yes @tab -@item @code{PADDING} @tab Yes @tab -@item @code{PAGE} @tab Yes @tab -@item @code{PAGE-COUNTER} @tab Yes @tab -@item @code{PAGE-SETUP} @tab Yes (C/S) @tab -@item @code{PAGED} @tab Yes (C/S) @tab -@item @code{PARAGRAPH} @tab Yes (C/S) @tab -@item @code{PARENT} @tab Yes (C/S) @tab -@item @code{PARSE} @tab Yes (C/S) @tab -@item @code{PASCAL} @tab Yes (C/S) @tab -@item @code{PASSWORD} @tab Yes (C/S) @tab -@item @code{PERFORM} @tab Yes @tab -@item @code{PERMANENT} @tab Yes (C/S) @tab -@item @code{PF} @tab Yes @tab -@item @code{PH} @tab Yes @tab -@item @code{PHYSICAL} @tab Yes @tab -@item @code{PIC} @tab Yes @tab @code{PICTURE} -@item @code{PICTURE} @tab Yes @tab @code{PIC} -@item @code{PIXEL} @tab Yes (C/S) @tab @code{PIXELS} -@item @code{PIXELS} @tab Yes @tab @code{PIXEL} -@item @code{PLACEMENT} @tab Yes (C/S) @tab -@item @code{PLUS} @tab Yes @tab -@item @code{POINTER} @tab Yes @tab -@item @code{POP-UP} @tab Yes (C/S) @tab -@item @code{POS} @tab Yes @tab -@item @code{POSITION} @tab Yes @tab -@item @code{POSITION-SHIFT} @tab Yes (C/S) @tab -@item @code{POSITIVE} @tab Yes @tab -@item @code{PREFIXED} @tab No (C/S) @tab -@item @code{PRESENT} @tab Yes @tab -@item @code{PREVIOUS} @tab Yes (C/S) @tab -@item @code{PRINT} @tab Yes (C/S) @tab -@item @code{PRINT-NO-PROMPT} @tab Yes (C/S) @tab -@item @code{PRINT-PREVIEW} @tab Yes (C/S) @tab -@item @code{PRINTER} @tab Yes (C/S) @tab -@item @code{PRINTER-1} @tab Yes (C/S) @tab -@item @code{PRINTING} @tab Yes @tab -@item @code{PRIORITY} @tab Yes @tab -@item @code{PROCEDURE} @tab Yes @tab -@item @code{PROCEDURE-POINTER} @tab Yes @tab @code{PROGRAM-POINTER} -@item @code{PROCEDURES} @tab Yes @tab -@item @code{PROCEED} @tab Yes @tab -@item @code{PROCESSING} @tab Yes (C/S) @tab -@item @code{PROGRAM} @tab Yes @tab -@item @code{PROGRAM-ID} @tab Yes @tab -@item @code{PROGRAM-POINTER} @tab Yes @tab @code{PROCEDURE-POINTER} -@item @code{PROGRESS} @tab Yes (C/S) @tab -@item @code{PROHIBITED} @tab Yes (C/S) @tab -@item @code{PROMPT} @tab Yes @tab -@item @code{PROPERTIES} @tab Yes (C/S) @tab -@item @code{PROPERTY} @tab Yes @tab -@item @code{PROTECTED} @tab Yes (C/S) @tab -@item @code{PROTOTYPE} @tab Yes @tab -@item @code{PURGE} @tab Yes @tab -@item @code{PUSH-BUTTON} @tab Yes (C/S) @tab -@item @code{QUERY-INDEX} @tab Yes (C/S) @tab -@item @code{QUEUE} @tab Yes @tab -@item @code{QUOTE} @tab Yes @tab @code{QUOTES} -@item @code{QUOTES} @tab Yes @tab @code{QUOTE} -@item @code{RADIO-BUTTON} @tab Yes (C/S) @tab -@item @code{RAISE} @tab Yes @tab -@item @code{RAISED} @tab Yes (C/S) @tab -@item @code{RAISING} @tab No @tab -@item @code{RANDOM} @tab Yes @tab -@item @code{RD} @tab Yes @tab -@item @code{READ} @tab Yes @tab -@item @code{READ-ONLY} @tab Yes (C/S) @tab -@item @code{READERS} @tab Yes (C/S) @tab -@item @code{RECEIVE} @tab Yes @tab -@item @code{RECORD} @tab Yes @tab -@item @code{RECORD-DATA} @tab Yes (C/S) @tab -@item @code{RECORD-OVERFLOW} @tab Yes (C/S) @tab -@item @code{RECORD-TO-ADD} @tab Yes (C/S) @tab -@item @code{RECORD-TO-DELETE} @tab Yes (C/S) @tab -@item @code{RECORDING} @tab Yes @tab -@item @code{RECORDS} @tab Yes @tab -@item @code{RECURSIVE} @tab Yes (C/S) @tab -@item @code{REDEFINES} @tab Yes @tab -@item @code{REEL} @tab Yes @tab -@item @code{REFERENCE} @tab Yes @tab -@item @code{REFERENCES} @tab Yes @tab -@item @code{REFRESH} @tab Yes (C/S) @tab -@item @code{REGION-COLOR} @tab Yes (C/S) @tab -@item @code{RELATION} @tab No (C/S) @tab -@item @code{RELATIVE} @tab Yes @tab -@item @code{RELEASE} @tab Yes @tab -@item @code{REMAINDER} @tab Yes @tab -@item @code{REMOVAL} @tab Yes @tab -@item @code{RENAMES} @tab Yes @tab -@item @code{REORG-CRITERIA} @tab Yes (C/S) @tab -@item @code{REPLACE} @tab Yes @tab -@item @code{REPLACING} @tab Yes @tab -@item @code{REPORT} @tab Yes @tab -@item @code{REPORTING} @tab Yes @tab -@item @code{REPORTS} @tab Yes @tab -@item @code{REPOSITORY} @tab Yes @tab -@item @code{REQUIRED} @tab Yes (C/S) @tab @code{EMPTY-CHECK} -@item @code{REREAD} @tab Yes (C/S) @tab -@item @code{RERUN} @tab Yes (C/S) @tab -@item @code{RESERVE} @tab Yes @tab -@item @code{RESET} @tab Yes @tab -@item @code{RESET-GRID} @tab Yes (C/S) @tab -@item @code{RESET-LIST} @tab Yes (C/S) @tab -@item @code{RESET-TABS} @tab Yes (C/S) @tab -@item @code{RESIDENT} @tab Yes (C/S) @tab -@item @code{RESUME} @tab No @tab -@item @code{RETRY} @tab Yes @tab -@item @code{RETURN} @tab Yes @tab -@item @code{RETURNING} @tab Yes @tab -@item @code{REVERSE} @tab Yes @tab -@item @code{REVERSE-VIDEO} @tab Yes (C/S) @tab -@item @code{REVERSED} @tab Yes @tab -@item @code{REWIND} @tab Yes @tab -@item @code{REWRITE} @tab Yes @tab -@item @code{RF} @tab Yes @tab -@item @code{RH} @tab Yes @tab -@item @code{RIGHT} @tab Yes @tab -@item @code{RIGHT-ALIGN} @tab Yes (C/S) @tab -@item @code{RIGHT-JUSTIFY} @tab No @tab -@item @code{RIMMED} @tab Yes (C/S) @tab -@item @code{ROLLBACK} @tab Yes @tab -@item @code{ROUNDED} @tab Yes @tab -@item @code{ROUNDING} @tab Yes (C/S) @tab -@item @code{ROW-COLOR} @tab Yes (C/S) @tab -@item @code{ROW-COLOR-PATTERN} @tab Yes (C/S) @tab -@item @code{ROW-DIVIDERS} @tab Yes (C/S) @tab -@item @code{ROW-FONT} @tab Yes (C/S) @tab -@item @code{ROW-HEADINGS} @tab Yes (C/S) @tab -@item @code{ROW-PROTECTION} @tab Yes (C/S) @tab -@item @code{RUN} @tab Yes @tab -@item @code{S} @tab Yes (C/S) @tab -@item @code{SAME} @tab Yes @tab -@item @code{SAVE-AS} @tab Yes (C/S) @tab -@item @code{SAVE-AS-NO-PROMPT} @tab Yes (C/S) @tab -@item @code{SCREEN} @tab Yes @tab -@item @code{SCROLL} @tab Yes (C/S) @tab -@item @code{SCROLL-BAR} @tab Yes (C/S) @tab -@item @code{SD} @tab Yes @tab -@item @code{SEARCH} @tab Yes @tab -@item @code{SEARCH-OPTIONS} @tab Yes (C/S) @tab -@item @code{SEARCH-TEXT} @tab Yes (C/S) @tab -@item @code{SECONDS} @tab Yes (C/S) @tab -@item @code{SECTION} @tab Yes @tab -@item @code{SECURE} @tab Yes (C/S) @tab -@item @code{SEGMENT} @tab Yes @tab -@item @code{SEGMENT-LIMIT} @tab Yes @tab -@item @code{SELECT} @tab Yes @tab -@item @code{SELECT-ALL} @tab Yes (C/S) @tab -@item @code{SELECTION-INDEX} @tab Yes (C/S) @tab -@item @code{SELECTION-TEXT} @tab Yes (C/S) @tab -@item @code{SELF} @tab No @tab -@item @code{SELF-ACT} @tab Yes (C/S) @tab -@item @code{SEND} @tab Yes @tab -@item @code{SENTENCE} @tab Yes @tab -@item @code{SEPARATE} @tab Yes @tab -@item @code{SEPARATION} @tab Yes (C/S) @tab -@item @code{SEQUENCE} @tab Yes @tab -@item @code{SEQUENTIAL} @tab Yes @tab -@item @code{SET} @tab Yes @tab -@item @code{SHADING} @tab Yes (C/S) @tab -@item @code{SHADOW} @tab Yes (C/S) @tab -@item @code{SHARING} @tab Yes @tab -@item @code{SHORT-DATE} @tab Yes (C/S) @tab -@item @code{SHOW-LINES} @tab Yes (C/S) @tab -@item @code{SHOW-NONE} @tab Yes (C/S) @tab -@item @code{SHOW-SEL-ALWAYS} @tab Yes (C/S) @tab -@item @code{SIGN} @tab Yes @tab -@item @code{SIGNED} @tab Yes @tab -@item @code{SIGNED-INT} @tab Yes @tab -@item @code{SIGNED-LONG} @tab Yes @tab -@item @code{SIGNED-SHORT} @tab Yes @tab -@item @code{SIZE} @tab Yes @tab -@item @code{SMALL-FONT} @tab Yes @tab -@item @code{SORT} @tab Yes @tab -@item @code{SORT-MERGE} @tab Yes @tab -@item @code{SORT-ORDER} @tab Yes (C/S) @tab -@item @code{SOURCE} @tab Yes @tab -@item @code{SOURCE-COMPUTER} @tab Yes @tab -@item @code{SOURCES} @tab No @tab -@item @code{SPACE} @tab Yes @tab @code{SPACES} -@item @code{SPACE-FILL} @tab No @tab -@item @code{SPACES} @tab Yes @tab @code{SPACE} -@item @code{SPECIAL-NAMES} @tab Yes @tab -@item @code{SPINNER} @tab Yes (C/S) @tab -@item @code{SQUARE} @tab Yes (C/S) @tab -@item @code{STANDARD} @tab Yes @tab -@item @code{STANDARD-1} @tab Yes @tab -@item @code{STANDARD-2} @tab Yes @tab -@item @code{STANDARD-BINARY} @tab Yes (C/S) @tab -@item @code{STANDARD-DECIMAL} @tab Yes (C/S) @tab -@item @code{START} @tab Yes @tab -@item @code{START-X} @tab Yes (C/S) @tab -@item @code{START-Y} @tab Yes (C/S) @tab -@item @code{STATEMENT} @tab No (C/S) @tab -@item @code{STATIC} @tab Yes (C/S) @tab -@item @code{STATIC-LIST} @tab Yes (C/S) @tab -@item @code{STATUS} @tab Yes @tab -@item @code{STATUS-BAR} @tab Yes (C/S) @tab -@item @code{STATUS-TEXT} @tab Yes (C/S) @tab -@item @code{STDCALL} @tab Yes (C/S) @tab -@item @code{STEP} @tab Yes (C/S) @tab -@item @code{STOP} @tab Yes @tab -@item @code{STRING} @tab Yes @tab -@item @code{STRONG} @tab No (C/S) @tab -@item @code{STYLE} @tab Yes (C/S) @tab -@item @code{SUB-QUEUE-1} @tab Yes @tab -@item @code{SUB-QUEUE-2} @tab Yes @tab -@item @code{SUB-QUEUE-3} @tab Yes @tab -@item @code{SUBTRACT} @tab Yes @tab -@item @code{SUBWINDOW} @tab Yes @tab -@item @code{SUM} @tab Yes @tab -@item @code{SUPER} @tab No @tab -@item @code{SUPPRESS} @tab Yes @tab -@item @code{SYMBOL} @tab No (C/S) @tab -@item @code{SYMBOLIC} @tab Yes @tab -@item @code{SYNC} @tab Yes @tab @code{SYNCHRONISED, SYNCHRONIZED} -@item @code{SYNCHRONISED} @tab Yes @tab @code{SYNC, SYNCHRONIZED} -@item @code{SYNCHRONIZED} @tab Yes @tab @code{SYNC, SYNCHRONISED} -@item @code{SYSTEM-DEFAULT} @tab Yes @tab -@item @code{SYSTEM-INFO} @tab Yes (C/S) @tab -@item @code{SYSTEM-OFFSET} @tab Yes @tab -@item @code{TAB} @tab Yes (C/S) @tab -@item @code{TAB-TO-ADD} @tab Yes (C/S) @tab -@item @code{TAB-TO-DELETE} @tab Yes (C/S) @tab -@item @code{TABLE} @tab Yes @tab -@item @code{TALLYING} @tab Yes @tab -@item @code{TAPE} @tab Yes (C/S) @tab -@item @code{TEMPORARY} @tab Yes (C/S) @tab -@item @code{TERMINAL-INFO} @tab Yes (C/S) @tab -@item @code{TERMINATE} @tab Yes @tab -@item @code{TERMINATION-VALUE} @tab Yes (C/S) @tab -@item @code{TEST} @tab Yes @tab -@item @code{TEXT} @tab Yes @tab -@item @code{THAN} @tab Yes @tab -@item @code{THEN} @tab Yes @tab -@item @code{THREAD} @tab Yes @tab -@item @code{THREADS} @tab Yes @tab -@item @code{THROUGH} @tab Yes @tab @code{THRU} -@item @code{THRU} @tab Yes @tab @code{THROUGH} -@item @code{THUMB-POSITION} @tab Yes (C/S) @tab -@item @code{TILED-HEADINGS} @tab Yes (C/S) @tab -@item @code{TIME} @tab Yes @tab -@item @code{TIME-OUT} @tab Yes (C/S) @tab @code{TIMEOUT} -@item @code{TIMEOUT} @tab Yes @tab @code{TIME-OUT} -@item @code{TIMES} @tab Yes @tab -@item @code{TITLE} @tab Yes (C/S) @tab -@item @code{TITLE-POSITION} @tab Yes (C/S) @tab -@item @code{TO} @tab Yes @tab -@item @code{TOP} @tab Yes @tab -@item @code{TOWARD-GREATER} @tab Yes (C/S) @tab -@item @code{TOWARD-LESSER} @tab Yes (C/S) @tab -@item @code{TRACK} @tab Yes (C/S) @tab -@item @code{TRACK-AREA} @tab Yes (C/S) @tab -@item @code{TRACK-LIMIT} @tab Yes (C/S) @tab -@item @code{TRACKS} @tab Yes (C/S) @tab -@item @code{TRADITIONAL-FONT} @tab Yes @tab -@item @code{TRAILING} @tab Yes @tab -@item @code{TRAILING-SHIFT} @tab Yes (C/S) @tab -@item @code{TRAILING-SIGN} @tab No @tab -@item @code{TRANSACTION} @tab Yes @tab -@item @code{TRANSFORM} @tab Yes @tab -@item @code{TRANSPARENT} @tab Yes (C/S) @tab -@item @code{TREE-VIEW} @tab Yes (C/S) @tab -@item @code{TRUE} @tab Yes @tab -@item @code{TRUNCATION} @tab Yes (C/S) @tab -@item @code{TYPE} @tab Yes @tab -@item @code{TYPEDEF} @tab No @tab -@item @code{U} @tab Yes (C/S) @tab -@item @code{UCS-4} @tab Yes (C/S) @tab -@item @code{UNBOUNDED} @tab Yes (C/S) @tab -@item @code{UNDERLINE} @tab Yes (C/S) @tab -@item @code{UNFRAMED} @tab Yes (C/S) @tab -@item @code{UNIT} @tab Yes @tab -@item @code{UNIVERSAL} @tab No @tab -@item @code{UNLOCK} @tab Yes @tab -@item @code{UNSIGNED} @tab Yes @tab -@item @code{UNSIGNED-INT} @tab Yes @tab -@item @code{UNSIGNED-LONG} @tab Yes @tab -@item @code{UNSIGNED-SHORT} @tab Yes @tab -@item @code{UNSORTED} @tab Yes (C/S) @tab -@item @code{UNSTRING} @tab Yes @tab -@item @code{UNTIL} @tab Yes @tab -@item @code{UP} @tab Yes @tab -@item @code{UPDATE} @tab Yes @tab -@item @code{UPDATERS} @tab Yes (C/S) @tab -@item @code{UPON} @tab Yes @tab -@item @code{UPPER} @tab Yes (C/S) @tab -@item @code{USAGE} @tab Yes @tab -@item @code{USE} @tab Yes @tab -@item @code{USE-ALT} @tab Yes (C/S) @tab -@item @code{USE-RETURN} @tab Yes (C/S) @tab -@item @code{USE-TAB} @tab Yes (C/S) @tab -@item @code{USER} @tab Yes (C/S) @tab -@item @code{USER-DEFAULT} @tab Yes @tab -@item @code{USING} @tab Yes @tab -@item @code{UTF-16} @tab Yes (C/S) @tab -@item @code{UTF-8} @tab Yes (C/S) @tab -@item @code{V} @tab Yes (C/S) @tab -@item @code{VAL-STATUS} @tab No @tab -@item @code{VALID} @tab No @tab -@item @code{VALIDATE} @tab Yes @tab -@item @code{VALIDATE-STATUS} @tab No @tab -@item @code{VALIDATING} @tab Yes (C/S) @tab -@item @code{VALUE} @tab Yes @tab @code{VALUES} -@item @code{VALUE-FORMAT} @tab Yes (C/S) @tab -@item @code{VALUES} @tab Yes @tab @code{VALUE} -@item @code{VARIABLE} @tab Yes (C/S) @tab -@item @code{VARIANT} @tab Yes @tab -@item @code{VARYING} @tab Yes @tab -@item @code{VERTICAL} @tab Yes (C/S) @tab -@item @code{VERY-HEAVY} @tab Yes (C/S) @tab -@item @code{VIRTUAL-WIDTH} @tab Yes (C/S) @tab -@item @code{VISIBLE} @tab Yes (C/S) @tab -@item @code{VOLATILE} @tab Yes @tab -@item @code{VPADDING} @tab Yes (C/S) @tab -@item @code{VSCROLL} @tab Yes (C/S) @tab -@item @code{VSCROLL-BAR} @tab Yes (C/S) @tab -@item @code{VSCROLL-POS} @tab Yes (C/S) @tab -@item @code{VTOP} @tab Yes (C/S) @tab -@item @code{WAIT} @tab Yes @tab -@item @code{WEB-BROWSER} @tab Yes (C/S) @tab -@item @code{WHEN} @tab Yes @tab -@item @code{WIDTH} @tab Yes (C/S) @tab -@item @code{WIDTH-IN-CELLS} @tab Yes (C/S) @tab -@item @code{WINDOW} @tab Yes @tab -@item @code{WITH} @tab Yes @tab -@item @code{WORDS} @tab Yes @tab -@item @code{WORKING-STORAGE} @tab Yes @tab -@item @code{WRAP} @tab Yes (C/S) @tab -@item @code{WRITE} @tab Yes @tab -@item @code{WRITE-ONLY} @tab Yes (C/S) @tab -@item @code{WRITE-VERIFY} @tab Yes (C/S) @tab -@item @code{WRITERS} @tab Yes (C/S) @tab -@item @code{X} @tab Yes (C/S) @tab -@item @code{XML} @tab Yes @tab -@item @code{XML-DECLARATION} @tab Yes (C/S) @tab -@item @code{Y} @tab Yes (C/S) @tab -@item @code{YYYYDDD} @tab Yes (C/S) @tab -@item @code{YYYYMMDD} @tab Yes (C/S) @tab -@item @code{ZERO} @tab Yes @tab @code{ZEROES, ZEROS} -@item @code{ZERO-FILL} @tab No (C/S) @tab -@item @code{ZEROES} @tab Yes @tab @code{ZERO, ZEROS} -@item @code{ZEROS} @tab Yes @tab @code{ZERO, ZEROES} -@end multitable -@section Extra (obsolete) context sensitive words -@code{AUTHOR}, @code{DATE-COMPILED}, @code{DATE-MODIFIED}, @code{DATE-WRITTEN}, @code{INSTALLATION}, @code{REMARKS}, @code{SECURITY} - -@section Internal registers -@multitable @columnfractions .40 .20 .40 -@headitem Register @tab Implemented @tab Definition -@item @code{'ADDRESS OF' phrase} @tab Yes @tab @code{USAGE POINTER} -@item @code{COB-CRT-STATUS} @tab Yes @tab @code{PICTURE 9(4) USAGE DISPLAY VALUE ZERO} -@item @code{DEBUG-ITEM} @tab Yes @tab @code{PICTURE X(n) USAGE DISPLAY} -@item @code{'LENGTH OF' phrase} @tab Yes @tab @code{CONSTANT USAGE BINARY-LONG} -@item @code{NUMBER-OF-CALL-PARAMETERS} @tab Yes @tab @code{USAGE BINARY-LONG} -@item @code{RETURN-CODE} @tab Yes @tab @code{GLOBAL USAGE BINARY-LONG VALUE ZERO} -@item @code{SORT-RETURN} @tab Yes @tab @code{GLOBAL USAGE BINARY-LONG VALUE ZERO} -@item @code{TALLY} @tab Yes @tab @code{GLOBAL PICTURE 9(5) USAGE BINARY VALUE ZERO} -@item @code{WHEN-COMPILED} @tab Yes @tab @code{CONSTANT PICTURE X(16) USAGE DISPLAY} -@item @code{XML-CODE} @tab Yes @tab @code{GLOBAL PICTURE S9(9) USAGE BINARY VALUE 0} -@item @code{JSON-CODE} @tab Yes @tab @code{GLOBAL PICTURE S9(9) USAGE BINARY VALUE 0} -@end multitable diff -Nru gnucobol-4.0~early~20200606/doc/cbrunt.tex gnucobol-5/doc/cbrunt.tex --- gnucobol-4.0~early~20200606/doc/cbrunt.tex 2020-06-06 20:52:54.000000000 +0000 +++ gnucobol-5/doc/cbrunt.tex 1970-01-01 00:00:00.000000000 +0000 @@ -1,705 +0,0 @@ -@section General instructions - -@* -@* -The initial runtime.cfg file is found in the @code{$COB_CONFIG_DIR}, -which defaults to @code{installdir/gnucobol/config} (see @code{cobcrun --info} for the -local path that is configured). -The environment variable @code{COB_RUNTIME_CONFIG} may define a different runtime -configuration file to read. -@* -If settings are included in the runtime environment file multiple times -then the last setting value is used, no warning occurs. -@* -Settings via environment variables always take precedence over settings -that are given in runtime configuration files. And the environment is -checked after completing processing of the runtime configuration file(s) -@* -All values set to string variables or environment variables are checked -for @code{$@{envvar@}} and replacement is done at the time of the setting. -You can also specify a default value for the case that envvar is not set: - @code{$@{envvar:default@}} (the format @code{$@{envvar:-default@}} is supported, too). -@* -Any environment variable may be set with the directive @code{setenv}. - -Example: @code{setenv COB_LIBARAY_PATH $@{LD_LIBRARY_PATH@}} -@* -Any environment variable may be unset with the directive @code{unsetenv} -(one var per line). - -Example: @code{unsetenv COB_LIBRARY_PATH} -@* -Runtime configuration files can include other files with the -directive @code{include}. - -Example: @code{include my-runtime-configuration-file} -@* -To include another configuration file only if it is present use the -directive @code{includeif}. -You can also use @code{$@{envvar@}} inside this. - -Example: @code{includeif $@{HOME@}/mygc.cfg} -@* -If you want to reset a parameter to its default value use - @code{reset parametername}. -@* -Most runtime variables have boolean values, some are switches, some have -string values, integer values (if not explicit noted: unsigned) and some -are size values. -The boolean values will be evaluated as following: - to true: @code{1, Y, ON, YES, TRUE} (no matter of case) - to false: @code{0, N, OFF} -A 'size' value is an unsigned integer optionally followed by K, M, or G -for kilo, mega or giga. -@* -For convenience a parameter in the runtime.cfg file may be defined by using -either the environment variable name or the parameter name. -In most cases the environment variable name is the parameter name (in upper -case) with the prefix @code{COB_}. -@* -For a complete list of the settings in use see @code{cobcrun --runtime-config}. -@* -Note: -If you want to *slightly* speed up a program's startup time, remove all -of the comments from the actual real configuration file that is processed. -@* -@* -@verbatim -@end verbatim -@section General environment -@verbatim - - -Environment name: COB_DISABLE_WARNINGS - Parameter name: disable_warnings - Purpose: turn off runtime warning messages - Type: boolean - Default: false - Example: DISABLE_WARNINGS TRUE - -Environment name: COB_ENV_MANGLE - Parameter name: env_mangle - Purpose: names checked in the environment would get non alphanumeric - change to '_' - Type: boolean - Default: false - Example: ENV_MANGLE TRUE - -Environment name: COB_SET_DEBUG - Parameter name: debugging_mode - Purpose: to enable USE ON DEBUGGING procedures that were active - during compile-time because of WITH DEBUGGING MODE, - otherwise the code generated will be skipped - Type: boolean - Default: false - Example: COB_SET_DEBUG 1 - -Environment name: COB_SET_TRACE - Parameter name: set_trace - Purpose: to enable COBOL trace feature - Type: boolean - Default: false - Example: SET_TRACE TRUE - -Environment name: COB_TRACE_FILE - Parameter name: trace_file - Purpose: to define where COBOL trace output should go - Type: string : $$ is replaced by process id - Default: stderr - Example: TRACE_FILE ${HOME}/mytrace.$$ - -Environment name: COB_TRACE_FORMAT - Parameter name: trace_format - Purpose: to define format of COBOL trace output - Type: string - Default: "%P %S Line: %L" - %P is replaced by Program-Id/Function-Id minimal length 29 - with prefix - %I is replaced by Program-Id/Function-Id variable length, - without prefix - %L is replaced by Line number, right justified, length 6 - %S is replaced by statement type and name - %F is replaced by source file name - Example: TRACE_FORMAT "Line: %L %S" - Note: format of GC2.2 and older: - "PROGRAM-ID: %I Line: %L %S" - -Environment name: COB_TRACE_IO - Parameter name: trace_io - Purpose: define if I/O details should be added to trace - Type: boolean - Default: false - Example: TRACE_IO true - -Environment name: COB_DUMP_FILE - Parameter name: dump_file - Purpose: to define where COBOL dump output should go - Note: The -fdump=all compile option prepares for dump - Type: string : $$ is replaced by process id - Default: stderr - Example: DUMP_FILE ${HOME}/mytrace.log - -Environment name: COB_DUMP_WIDTH - Parameter name: dump_width - Purpose: to define COBOL dump line length - Type: integer - Default: 100 - Example: dump_width 120 - -Environment name: COB_STATS_RECORD - Parameter name: stats_record - Purpose: define if I/O statistics should be written - Type: boolean - Default: false - Example: STATS_RECORD true - -Environment name: COB_STATS_FILE - Parameter name: stats_file - Purpose: to define where COBOL I/O statistics should be written - The file is appended to - Type: string - Default: stderr - Example: STATS_FILE ${HOME}/mystats.txt - -Environment name: COB_CURRENT_DATE - Parameter name: current_date - Purpose: specify an alternate Date/Time to be returned to ACCEPT - clauses this is used for testing purposes or to tweak - a missing offset partial setting is allowed - Type: numeric string in format YYYYDDMMHH24MISS or date string - Default: the operating system date is used - Example: COB_CURRENT_DATE "2016/03/16 16:40:52" - current_date YYYYMMDDHHMMSS+01:00 - - -@end verbatim -@section Call environment -@verbatim - - -Environment name: COB_LIBRARY_PATH - Parameter name: library_path - Purpose: paths for dynamically-loadable modules - Type: string - Note: the default paths .:/installpath/extras are always - added to the given paths - Example: LIBRARY_PATH /opt/myapp/test:/opt/myapp/production - -Environment name: COB_PRE_LOAD - Parameter name: pre_load - Purpose: modules that are loaded during startup, can be used - to CALL COBOL programs or C functions that are part - of a module library - Type: string - Note: the modules listed should NOT include extensions, the - runtime will use the right ones on the various platforms, - COB_LIBRARY_PATH is used to locate the modules - Example: PRE_LOAD COBOL_function_library:external_c_library - -Environment name: COB_LOAD_CASE - Parameter name: load_case - Purpose: resolve ALL called program names to UPPER or LOWER case - Type: Only use UPPER or LOWER - Default: if not set program names in CALL are case sensitive - Example: LOAD_CASE UPPER - -Environment name: COB_PHYSICAL_CANCEL - Parameter name: physical_cancel - Purpose: physically unload a dynamically-loadable module on CANCEL, - this frees some RAM and allows the change of modules during - run-time but needs more time to resolve CALLs (both to - active and not-active programs) - Alias: default_cancel_mode, LOGICAL_CANCELS (0 = yes) - Type: boolean (evaluated for true only) - Default: false - Example: PHYSICAL_CANCEL TRUE - - -@end verbatim -@section File I/O -@verbatim - - -Environment name: COB_MF_FILES - Parameter name: mf_files - Purpose: declare that sequential/relative files should be in - Micro Focus compatible format - Type: boolean (evaluated for true only) - Default: false - Example: mf_files True - -Environment name: COB_VARSEQ_FORMAT - Parameter name: varseq_format - Purpose: declare format to be used for variable length sequential files - Type: 0 means 2 byte record length (big-endian) plus 2 NULs precedes record - 1 means 4 byte record length (big-endian) precedes record - 2 means 4 byte record length (local machine int) precedes record - 3 means 2 byte record length (local machine short) precedes record - b32 means 'type 2' above but the 'int' is in Big-Endian format - l32 means 'type 2' above but the 'int' is in Little-Endian format - mf means create the file in Micro Focus compatible format - Default: 0 - Example: VARSEQ_FORMAT 1 - -Environment name: COB_VARREL_FORMAT - Parameter name: varrel_format - Purpose: declare format to be used for variable length relative files - Type: gc means 'size_t' record length (local machine) precedes - maxiumum length data record - mf means file is in Micro Focus format - b32 means Big-Endian 32-bit 'int' record length precedes data - b64 means Big-Endian 64-bit 'int' record length precedes data - l32 means Little-Endian 32-bit 'int' record length precedes data - l64 means Little-Endian 64-bit 'int' record length precedes data - Default: gc - NOTE: 'gc' results in files which cannot be used if copied between - machines of different hardware archeticture - Example: VARREL_FORMAT mf - -Environment name: COB_FIXREL_FORMAT - Parameter name: fixrel_format - Purpose: declare format to be used for fixed length relative - files (different types and lengths preceding each record) - Type: b32 means 4 byte record length (big-endian) - l32 means 4 byte record length (little-endian) - b64 means 8 byte record length (big-endian) - l64 means 8 byte record length (little-endian) - mf means Micro Focus default - gc means GnuCOBOL default (local 'size_t') - Default: gc fixed size with no record length prefix - Example: FIXREL_FORMAT B32 - -Environment name: COB_VARFIX_FORMAT - Parameter name: varfix_format - Purpose: declare format to be used for fixed length relative files - Type: gc means 'size_t' record length (local machine) precedes - fixed length data record - mf means file is in Micro Focus format - b32 means Big-Endian 32-bit 'int' record length precedes data - b64 means Big-Endian 64-bit 'int' record length precedes data - l32 means Little-Endian 32-bit 'int' record length precedes data - l64 means Little-Endian 64-bit 'int' record length precedes data - Default: gc - NOTE: 'gc' results in files which cannot be used if copied between - machines of different hardware archeticture - Example: VARFIX_FORMAT mf - -Environment name: COB_FILE_PATH - Parameter name: file_path - Purpose: define default location(s) where data files are stored - Type: file path directory list - Default: . (current directory) - Example: FILE_PATH ${HOME}/mydata - Unix/Linux list: FILE_PATH ${HOME}/mydata:${PROJECT}/datafiles - Windows list: FILE_PATH C:\proja\mydata;D:\projb\yourdata;. - -Environment name: COB_FILE_DICTIONARY - Parameter name: file_dictionary - Purpose: define when a file format description is written - is written to 'asgname.dd' - Type: false means never write - no means never write - true means write for BDB or LMDB only - min means write for BDB or LMDB only - always means write for all file types - max means write for all file types - Default: min - Example: file_dictionary always - -Environment name: COB_FILE_DICTIONARY_PATH - Parameter name: file_dictionary_path - Purpose: define where the 'asgname.dd' is written - Type: file path directory - Default: . (current directory) - Example: FILE_DICTIONARY_PATH ${HOME}/mystuff - -Environment name: COB_CREATE_TABLE - Parameter name: create_table - Purpose: For OCI/ODBC, if table is not defined and - there is no tablename.ddl present - should the CREATE TABLE be created at run time? - Type: false means the OPEN will fail - true means it will attempt to recreate the table definition - Default: false - Example: create_table true - -Environment name: COB_BDB_BYTEORDER - Parameter name: bdb_byteorder - Purpose: Defines the byte order to be used for BDB - Type: native - use the system byte order - big-endian - use big-endian order - little-endian - use little-endian order - Default: native - Example: bdb_byteorder big-endian - -Environment name: COB_LS_FIXED - Parameter name: ls_fixed - Purpose: Defines if LINE SEQUENTIAL files should be fixed length - (or variable, by removing trailing spaces) - Alias: STRIP_TRAILING_SPACES (0 = yes) - Type: boolean - Default: false - Example: LS_FIXED TRUE - -Environment name: COB_LS_NULLS - Parameter name: ls_nulls - Purpose: Defines for LINE SEQUENTIAL files what to do with data - which is not DISPLAY type. This could happen if a LINE - SEQUENTIAL record has BINARY/COMP data fields in it. - This option is only for GnuCOBOL format files - Type: boolean - Default: false - Note: The TRUE setting will handle files that contain COMP data - in a similar manner to the method used by Micro Focus - Example: LS_NULLS = TRUE - -Environment name: COB_LS_SPLIT - Parameter name: ls_split - Purpose: Defines for LINE SEQUENTIAL files what to do when a record - is longer than the program handles. If 'ls_split=true' then - the data is returned as multiple records - Type: boolean - Default: false - The record is truncated and the file skips to the next LF - Example: LS_SPLIT = TRUE - -Environment name: COB_LS_VALIDATE - Parameter name: ls_validate - Purpose: Defines for LINE SEQUENTIAL files that the data should be - validated. If any record has non-DISPLAY characters then - an error status of 34 is returned - This option is only for GnuCOBOL format files - Type: boolean - Default: true - Note: The TRUE setting does data validation - The FALSE setting lets non-DISPLAY characters be written - If LS_NULLS is set, then LS_VALIDATE is not checked - Example: LS_VALIDATE = FALSE - -Environment name: COB_MF_FILES - Parameter name: mf_files - Purpose: Declares that all files in the program should follow - Micro Focus format - Type: boolean - Default: false - Example: MF_FILES = TRUE - -Environment name: COB_MF_LS_NULLS - Parameter name: mf_ls_nulls - Purpose: Defines for Micro Focus compatible LINE SEQUENTIAL files - what to do with data which is not DISPLAY type. - This could happen if a LINE SEQUENTIAL record has - BINARY/COMP data fields in it. - Type: boolean - Default: true - Note: The TRUE setting will handle files that contain COMP data - in a similar manner to the method used by Micro Focus COBOL - Example: LS_NULLS = TRUE - -Environment name: COB_MF_LS_SPLIT - Parameter name: mf_ls_split - Purpose: Defines for Micro Focus compatible LINE SEQUENTIAL files what - to do when a record is longer than the program handles. - If 'mf_ls_split=true' then - the data is returned as multiple records - Type: boolean - Default: true - Example: MF_LS_SPLIT = FALSE - - Example: LS_SPLIT = TRUE -Environment name: COB_MF_LS_VALIDATE - Parameter name: mf_ls_validate - Purpose: Defines for Micro Focus compatible LINE SEQUENTIAL files - that the data should be validated. - If any record has non-DISPLAY characters then - an error status of 34 is returned - Type: boolean - Default: false - Note: The TRUE setting does data validation - The FALSE setting lets non-DISPLAY characters be written - If MF_LS_NULLS is set, then MF_LS_VALIDATE is not checked - Example: MF_LS_VALIDATE = FALSE - -Environment name: COB_SHARE_MODE - Parameter name: share_mode - Purpose: Defines what file sharing option should be used - Type: -- choice of values --- - none - nothing overrides application code - read - files opened as SHARE READ ONLY - all - files opened as SHARE ALL OTHERS - no - files opened as SHARE NO OTHERS - Default: none - Example: share_mode = ALL - -Environment name: COB_RETRY_MODE - Parameter name: retry_mode - Purpose: Defines what I/O retry sharing option should be used - Type: --- choice of values --- - none - nothing overrides application code - never - I/O is never retried - forever - I/O will be retried until success - Default: none - Example: retry_mode = never - -Environment name: COB_RETRY_TIMES - Parameter name: retry_times - Purpose: Defines how many times I/O should be retried - Type: integer - Default: 0 - Example: retry_times = 10 - -Environment name: COB_RETRY_SECONDS - Parameter name: retry_seconds - Purpose: Defines how many seconds I/O should be retried - Type: integer - Default: 0 - Example: retry_seconds = 6 - -Environment name: COB_KEYCHECK - Parameter name: keycheck - Purpose: Must INDEXED file keys match COBOL SELECT exactly - Type: boolean - Default: true - Example: keycheck = off - -Environment name: COB_SYNC - Parameter name: sync - Purpose: Should the file be synced to disk after each write/update - Type: boolean - Default: false - Example: SYNC: TRUE - -Environment name: COB_SORT_MEMORY - Parameter name: sort_memory - Purpose: Defines how much RAM to assign for sorting data - if this size is exceeded the SORT will be done - on disk instead of memory - Type: size but must be more than 1M - Default: 128M - Example: SORT_MEMORY 64M - -Environment name: COB_SORT_CHUNK - Parameter name: sort_chunk - Purpose: Defines how much RAM to assign for sorting data in chunks - Type: size but must be within 128K and 16M - Default: 256K - Example: SORT_CHUNK 1M - - -@end verbatim -@section Screen I/O -@verbatim - - -Environment name: COB_BELL - Parameter name: bell - Purpose: Defines how a request for the screen to beep is handled - Type: FLASH, SPEAKER, FALSE, BEEP - Default: BEEP - Example: BELL SPEAKER - -Environment name: COB_REDIRECT_DISPLAY - Parameter name: redirect_display - Purpose: Defines if DISPLAY output should be sent to 'stderr' - Type: boolean - Default: false - Example: redirect_display Yes - -Environment name: COB_SCREEN_ESC - Parameter name: screen_esc - Purpose: Enable handling of ESC key during ACCEPT - Type: boolean - Default: false - Note: is only evaluated if COB_SCREEN_EXCEPTIONS is active - Example: screen_esc Yes - -Environment name: COB_SCREEN_EXCEPTIONS - Parameter name: screen_exceptions - Purpose: enable exceptions for function keys during ACCEPT - Type: boolean - Default: false - Example: screen_exceptions Yes - -Environment name: COB_TIMEOUT_SCALE - Parameter name: timeout_scale - Purpose: specify translation in milliseconds for ACCEPT clauses - BEFORE TIME value / AFTER TIMEOUT - Type: integer - 0 means 1000 (Micro Focus COBOL compatible), 1 means 100 - (ACUCOBOL compatible), 2 means 10, 3 means 1 - Default: 0 - Note: the minimum and possible maximum value depend on the - screenio library used - Example: timeout_scale 3 - -Environment name: COB_INSERT_MODE - Parameter name: insert_mode - Purpose: specify default insert mode for ACCEPT; 0=off, 1=on - Type: boolean - Default: false - Note: also sets the cursor type (if available) - Example: insert_mode Y - -Environment name: COB_MOUSE_FLAGS - Parameter name: mouse_flags - Purpose: specify which mouse events will be sent as function key - to the application during ACCEPT and how they will be - handled - Type: int (by bits) - Default: 1 - Note: 0 disables the mouse cursor, any other value enables it, - any value containing 1 will enable internal handling (click - to position, double-click to enter). - See copy/screenio.cpy for list of events and their values. - Alias: MOUSE_FLAGS - Example: 11 (enable internal handling => 1, left press => 2, - double-click => 8; 1+2+8=11) - -Environment name: COB_MOUSE_INTERVAL - Parameter name: mouse_interval - Purpose: specifies the maximum time (in thousands of a second) - that can elapse between press and release events for them - to be recognized as a click. - Type: int (0 - 166) - Default: 100 - Note: 0 disables the click resolution (instead press + release - are recognized), also disables positioning by mouse click - -Environment name: COB_DISPLAY_PRINT_PIPE - Parameter name: display_print_pipe - Purpose: Defines command line used for sending output of - DISPLAY UPON PRINTER to (via pipe) - This is very similar to Micro Focus COBPRINTER - Note: Each executed DISPLAY UPON PRINTER statement causes a - new invocation of command-line (= new process start). - Each invocation receives the data referenced in - the DISPLAY statement and is followed by an - end-of-file condition. - COB_DISPLAY_PRINT_FILE, if set, takes precedence - over COB_DISPLAY_PRINT_PIPE. - Alias: COBPRINTER - Type: string - Default: not set - Example: print 'cat >>/tmp/myprt.log' - -Environment name: COB_DISPLAY_PRINT_FILE - Parameter name: display_print_file - Purpose: Defines file to be appended to by DISPLAY UPON PRINTER - Note: Each DISPLAY UPON PRINTER opens, appends and closes the file. - Type: string : $$ is replaced by process id - Default: not set - Example: display_printer '/tmp/myprt.log' - -Environment name: COB_DISPLAY_PUNCH_FILE - Parameter name: display_punch_file - Purpose: Defines file to be created on first - DISPLAY UPON SYSPUNCH/SYSPCH - Note: The file will be only be closed on runtime exit. - Type: string : $$ is replaced by process id - Default: not set - Example: display_punch './punch_$$.out' - -Environment name: COB_LEGACY - Parameter name: legacy - Purpose: keep behavior of former runtime versions, currently only - for setting screen attributes for non input fields - Type: boolean - Default: not set - Example: legacy true - -Environment name: COB_EXIT_WAIT - Parameter name: exit_wait - Purpose: to wait on main program exit if an extended screenio - DISPLAY was issued without an ACCEPT following - Type: boolean - Default: true - Example: COB_EXIT_WAIT off - -Environment name: COB_EXIT_MSG - Parameter name: exit_msg - Purpose: string to display if COB_EXIT_WAIT is processed, set to '' - if no actual display but an ACCEPT should be done - Type: string - Default: 'end of program, please press a key to exit' (localized) - Example: COB_EXIT_MSG '' - - -@end verbatim -@section Report I/O -@verbatim - - -Environment name: COB_COL_JUST_LRC - Parameter name: col_just_lrc - Purpose: If true, then COLUMN defined as LEFT, RIGHT or CENTER - will have the data justified within the field limits - If false, then the data is just copied into the column as is - Type: boolean - Default: TRUE - Example: col_just_lrc True - - - -@end verbatim -@section File I/O Environment Variables and/or dictionary file -@verbatim - -Before a file is opened a check is done for environment variables that -may define various attributes of the file -First a check is made for attributes for files of the same ORGANIZATION -IX_OPTIONS for INDEXED, SQ_OPTIONS for SEQUENTIAL, RL_OPTIONS for RELATIVE -LS_OPTIONS for LINE SEQUENTIAL, LA_OPTIONS for LINE ADVANCING SEQUENTIAL -If none of these are present, it then checks for IO_OPTIONS - -Then an additional check is done for IO_asgnmame where 'asgname' was -the ASSIGN EXTERNAL name used in the program - -The environment variable (or dictionary file) may contain any of the -following keywords, separated by spaces and/or commas - -You can specify just the keyword and it is assumed to mean set to true, -or no-keyword (or no_keyword or nokeyword) which means set to false, -or keyword=true or keyword=false. The valid keywords are: -Keyword Meaning -========= ====================================================== -type=xx Set file organization where 'xx' is one of - IX = INDEXED, SQ = SEQUENTIAL, RL = RELATIVE - LS = LINE SEQUENTIAL, LA = LINE ADVANCING -mf Set file to Micro Focus compatible format -gc Set to original GNU Cobol default format -recsz The size for fixed size record file -maxsz Maximum record size for variable length records -minsz Minimum record size for variable length records -ls_nulls Do NUL insertion before characters less than a SPACE, - Default: false -ls_validate Validate data for LINE Sequential Files, Default: true -crlf Lines end with CR LF (Windows format for text files) -lf Lines end with LF (Unix format for text files) -sync Sync all writes to disk -B32 Use 32-bit Big-Endian format 'int' as record length -L32 Use 32-bit Little-Endian format 'int' as record length -B64 Use 64-bit Big-Endian format 'int' or 'size_t' as record length -L64 Use 64-bit Little-Endian format 'int' or 'size_t' as record length -trace Enable I/O trace when program execution tracing is enabled -stats Write I/O statistic information on file close -retry_times Default number of times to retry I/O -retry_seconds Number of seconds between I/O retry attempts -retry_forever Retry I/O forever -retry_never Never retry I/O operations -ignore_lock Ignore record locks -advancing_lock Advance to the next record if lock condition -share_all Share file with ALL others -share_read Share file for READ only -share_no Share file with NO others - ---- For INDEXED files ----- -format=ixhandler INDEXED file format: CISAM,DISAM,VBISAM,BDB,LMDB,OCI,ODBC -format=auto INDEXED file format is determined by inspecting the file -nkeys=n number of indexes -key1=(loc:len) loc (zero relative) of key, len of key -key2=(loc:len,loc:len ...) define composite index -dupn=Y index allows dups - ---- For INDEXED BDB files ----- -big_endian Set internal 'int' byte order to BIG ENDIAN -little_endian Set internal 'int' byte order to LITTLE ENDIAN - -@end verbatim diff -Nru gnucobol-4.0~early~20200606/doc/cbsyst.tex gnucobol-5/doc/cbsyst.tex --- gnucobol-4.0~early~20200606/doc/cbsyst.tex 2020-06-06 20:52:54.000000000 +0000 +++ gnucobol-5/doc/cbsyst.tex 1970-01-01 00:00:00.000000000 +0000 @@ -1,65 +0,0 @@ -@multitable @columnfractions .40 .20 -@headitem System routine @tab Parameters -@item @code{SYSTEM} @tab 1 -@item @code{CBL_AND} @tab 3 -@item @code{CBL_ALARM_SOUND} @tab 0 -@item @code{CBL_BELL_SOUND} @tab 0 -@item @code{CBL_CHANGE_DIR} @tab 1 -@item @code{CBL_CHECK_FILE_EXIST} @tab 2 -@item @code{CBL_CLOSE_FILE} @tab 1 -@item @code{CBL_COPY_FILE} @tab 2 -@item @code{CBL_CREATE_DIR} @tab 1 -@item @code{CBL_CREATE_FILE} @tab 5 -@item @code{CBL_DELETE_DIR} @tab 1 -@item @code{CBL_DELETE_FILE} @tab 1 -@item @code{CBL_EQ} @tab 3 -@item @code{CBL_ERROR_PROC} @tab 2 -@item @code{CBL_EXIT_PROC} @tab 2 -@item @code{CBL_FLUSH_FILE} @tab 1 -@item @code{CBL_GET_CSR_POS} @tab 1 -@item @code{CBL_GET_CURRENT_DIR} @tab 3 -@item @code{CBL_GET_SCR_SIZE} @tab 2 -@item @code{CBL_IMP} @tab 3 -@item @code{CBL_NIMP} @tab 3 -@item @code{CBL_NOR} @tab 3 -@item @code{CBL_NOT} @tab 2 -@item @code{CBL_OPEN_FILE} @tab 5 -@item @code{CBL_OR} @tab 3 -@item @code{CBL_READ_FILE} @tab 5 -@item @code{CBL_READ_KBD_CHAR} @tab 1 -@item @code{CBL_RENAME_FILE} @tab 2 -@item @code{CBL_SET_CSR_POS} @tab 1 -@item @code{CBL_TOLOWER} @tab 2 -@item @code{CBL_TOUPPER} @tab 2 -@item @code{CBL_WRITE_FILE} @tab 5 -@item @code{CBL_XOR} @tab 3 -@item @code{CBL_GC_FORK} @tab 0 -@item @code{CBL_GC_GETOPT} @tab 6 -@item @code{CBL_GC_HOSTED} @tab 2 -@item @code{CBL_GC_NANOSLEEP} @tab 1 -@item @code{CBL_GC_PRINTABLE} @tab 1 - 2 -@item @code{CBL_GC_WAITPID} @tab 1 -@item @code{CBL_OC_GETOPT} @tab 6 -@item @code{CBL_OC_HOSTED} @tab 2 -@item @code{CBL_OC_NANOSLEEP} @tab 1 -@item @code{C$CALLEDBY} @tab 1 -@item @code{C$CHDIR} @tab 2 -@item @code{C$COPY} @tab 3 -@item @code{C$DELETE} @tab 2 -@item @code{C$FILEINFO} @tab 2 -@item @code{C$GETPID} @tab 0 -@item @code{C$JUSTIFY} @tab 1 - 2 -@item @code{C$MAKEDIR} @tab 1 -@item @code{C$NARG} @tab 1 -@item @code{C$PARAMSIZE} @tab 1 -@item @code{C$PRINTABLE} @tab 1 - 2 -@item @code{C$SLEEP} @tab 1 -@item @code{C$TOLOWER} @tab 2 -@item @code{C$TOUPPER} @tab 2 -@item @code{EXTFH} @tab 2 -@item @code{X"91"} @tab 3 -@item @code{X"E4"} @tab 0 -@item @code{X"E5"} @tab 0 -@item @code{X"F4"} @tab 2 -@item @code{X"F5"} @tab 2 -@end multitable diff -Nru gnucobol-4.0~early~20200606/doc/ChangeLog gnucobol-5/doc/ChangeLog --- gnucobol-4.0~early~20200606/doc/ChangeLog 2020-06-06 20:52:02.000000000 +0000 +++ gnucobol-5/doc/ChangeLog 1970-01-01 00:00:00.000000000 +0000 @@ -1,231 +0,0 @@ - -2020-02-02 Simon Sobisch - - * Makefile.am: suppress some output, - remove duplicated dist_noinst_SCRIPTS (defined in top Makefile) - -2019-08-15 Simon Sobisch - - * cobcinfo.sh (_create_file): cut down creation-time of tex-includes - by 98% by using read to split into separate parts - * cobcinfo.sh: optionally use sed binary specified by $SED - * Makefile.am: pass $SED to cobcinfo.sh - * cobcinfo.sh: added TAIL_START/TAIL_LAST to allow overriding tail - invocation for non-posix systems - -2019-06-06 Simon Sobisch - - * Makefile.am: adjusted dependencies for latest changes - -2019-05-22 Simon Sobisch - - * cobcinfo.sh: completely adjusted the generation of the appendices - (tex-includes) to not copy the output of cobc/cobcrun verbatim - but to create readable tables with texinfo commands instead - * gnucobol.texi: added intro to the appendices, heavy adjustments - to use of texinfo commands - * gnucobol.texi: disabled index generation as it has not enough entries - to be useful - * Makefile.am (touch, touch-tex): targets added - -2019-04-28 Simon Sobisch - - * cobcinfo.sh: improved output for runtime configuration - -2019-02-18 Simon Sobisch - - * Makefile.am: cleanup distribution rules - -2018-08-07 Brian Tiffin - - * gnucobol.texi: CONTENTS-OF rename to CONTENT-OF - -2018-06-29 Simon Sobisch - - * cobcinfo.sh: check that executables used actually do work - before using their output as content for the manual - -2018-06-21 Brian Tiffin - - * gnucobol.texi: Added docs for CONTENT-LENGTH and CONTENTS-OF - intrinsic function extensions - -2018-06-04 Simon Sobisch - - * cobcinfo.sh: support VPATH builds with changed sources by stripping - possible path from parameters - -2018-04-10 Luke Smith - - * gnucobol.texi: - - replace Alt-Home and Alt-End with toggle functions - - doc examples for SELECT ASSIGN - - doc more options to extended ACCEPT - -2018-03-22 Simon Sobisch - - * gnucobol.texi: removed all node pointers but the main level as - makeinfo handles these correctly, - added a menu group for appendices (not in pdf/html) - * gnucobol.texi: added missing subsection Figurative Constants below - section Extended DISPLAY statement - -2018-02-16 Simon Sobisch - - * Makefile.am: remove generated includes in target maintainer-clean - -2017-10-31 Simon Sobisch - - * cobcinfo.sh: use `` instead of $() - see Bug #437 - -2017-10-22 Simon Sobisch - - * cobcinfo.sh: use exported COBC/COBCRUN instead of relying on - exported PATH; changed to keep a list of tex-includes - -2017-08-15 Simon Sobisch - - * gnucobol.texi: explained use of cob_tidy / cob_stop_run - -2017-07-02 Simon Sobisch - - * gnucobol.texi: added -std=rm and all strict variants, - added explanations for -std - -2017-04-28 Simon Sobisch - - * Makefile.am: passed GREP from configure to cobcinfo.sh - * cobcinfo.sh: use GREP from configure, check for working grep -A - -2017-02-24 Simon Sobisch - - * texinfo.tex: moved to ../build_aux - * Makefile.am, cobcinfo.sh: changes to cater for move of texinfo.tex - * general: always regenerate tex include files when building gnucobol.texi - -2016-12-03 Simon Sobisch - - * gnucobol.texi: fixed texinfo warnings - -2016-10-22 Dave Pitts - - * gnucobol.texi: added --no-symbols option - -2016-10-17 Dave Pitts - - * gnucobol.texi: added a COPY to listing example - -2016-10-16 Dave Pitts - - * gnucobol.texi: added listing example - -2016-10-16 Simon Sobisch - - * gnucobol.texi: replaced cb_conf by samples of compiler configuration - flags and added minimal entry for listing options - -2016-10-11 Simon Sobisch - - * gnucobol.texi: Added entries for all GC-specific system libraries - -2016-08-13 Simon Sobisch - - * cobcinfo.sh: used new option -q to remove most `sed` calls - -2016-08-10 Simon Sobisch - - * Makefile.am: added all sources to gnucobol_TEXINFOS and removed them - from EXTRA_DIST - -2016-06-05 Simon Sobisch - - * cobcinfo.sh, Makefile.am: fix VPATH builds by sourcing atconfig/atlocal - in the Makefile (where the VPATH is available) instead of cobcinfo.sh - -2016-04-24 Simon Sobisch - - * cobcinfo.sh: portability change (using expr instead of declare) - -2016-03-04 Edward Hart - - * gnucobol.texi: Copyediting: improved capitalisation of headings, - changed "Hello World!" to "Hello, world!", formatted COBOL/C/compiler - options as code, added missing full stops in bullet point lists and - improved some sentences. - -2016-02-12 Simon Sobisch - - * cobcinfo.sh: remove the built-prefix from cobc/cobcrun - when capturing --help - -2015-12-20 Simon Sobisch - - * gnucobol.texi: Update for GnuCOBOL 2.0 - * texinfo.tex: updated to version from texinfo 5.2 - (more current versions throw errors in gnucobol.texi) - * new appendix cbrunt.tex from config/runtime.cfg, translating it to - texinfo format - * new appendix cbchelp.tex from `cobcrun --help` - * removed appendix cbinfo.tex from `cobcrun --info` as this is highly - system specific - * cobcinfo.sh: Make sure the version of cobc is used that was built from - this package, cater for changed appendices, overwrite tex-files only if - they are changed, new (optional) parameters for creating tex-files by - group or single ones and for fixing the timestamps - * Makefile.am: cater for changed appendices, make all appendices dependent - on cobcinfo.sh and source files of cobc to make sure these are always - up-to-date - -2015-12-15 Brian Tiffin - - * gnucobol.texi: Add -j and "-" stdin filename explanation. - -2015-06-22 Luke Smith - - * gnucobol.texi: Add Extended ACCEPT special keys section. - -2015-06-08 Luke Smith - - * gnucobol.texi: added Index at end - * gnucobol.texi: new section "Extensions" to document FR #37 - WITH SIZE for ACCEPT/DISPLAY field - -2014-14-04 Philipp Böhme - - * gnucobol.texi: Added documentation for CBL_OC_GETOPT - -2010-06-28 Roger While - - * MARK - Version 2.0 - * Move to GPL/LGPL 3 - * open-cobol.texi: Update for 2.0 - -2009-02-01 Brian Tiffin - - * open-cobol.texi: Update for 1.1 - -2005-05-21 Roger While - - * open-cobol.texi: Revise - -2005-05-13 Roger While - - * open-cobol.texi: Revise - -2005-03-03 Roger While - - * open-cobol.texi: update for -Os - -2002-06-11 Keisuke Nishida - - * open-cobol.texi: Revise for 0.9.6. - -2002-06-03 Keisuke Nishida - - * open-cobol.texi (Customize): Add COB_LDADD, COB_CONFIG_FILE. - - -Copyright 2002,2005,2009-2020 Free Software Foundation, Inc. - -Copying and distribution of this file, with or without modification, are -permitted provided the copyright notice and this notice are preserved. diff -Nru gnucobol-4.0~early~20200606/doc/cobcinfo.sh gnucobol-5/doc/cobcinfo.sh --- gnucobol-4.0~early~20200606/doc/cobcinfo.sh 2020-06-06 20:52:02.000000000 +0000 +++ gnucobol-5/doc/cobcinfo.sh 1970-01-01 00:00:00.000000000 +0000 @@ -1,358 +0,0 @@ -#!/bin/sh -# cobcinfo.sh gnucobol/doc -# -# Copyright (C) 2010,2012, 2016-2019 Free Software Foundation, Inc. -# Written by Roger While, Simon Sobisch -# -# This file is part of GnuCOBOL. -# -# The GnuCOBOL compiler is free software: you can redistribute it -# and/or modify it under the terms of the GNU General Public License -# as published by the Free Software Foundation, either version 3 of the -# License, or (at your option) any later version. -# -# GnuCOBOL is distributed in the hope that it will be useful, -# but WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -# GNU General Public License for more details. -# -# You should have received a copy of the GNU General Public License -# along with GnuCOBOL. If not, see . - -# use GREP from configure, passed when called from Makefile -GREP_ORIG="$GREP"; -if test "x$GREP" = "x"; then GREP=grep; fi -if test "x$SED" = "x" ; then SED=sed ; fi - -# default to POSIX, Solaris for example uses "tail +" -if test "x$TAIL_START" = "x"; then TAIL_START="tail -n +"; fi -#if test "x$TAIL_LAST" = "x"; then TAIL_LAST="tail -n "; fi - -if test "$1" != "fixtimestamps"; then - - # test for grep -A - $GREP -A2 test /dev/null 2>/dev/null 1>&2 - if test "$?" -ne 1; then - GREP=ggrep - $GREP -A2 test /dev/null 2>/dev/null 1>&2 - if test "$?" -ne 1; then - echo "error: grep not working, re-run with GREP=/path/to/gnu-grep" - echo " GREP is currently \"$GREP_ORIG\"" - exit 1 - fi - fi - - if test "x$COBC" = "x"; then - echo 'WARNING: $COBC not set, defaulting to "cobc"' - COBC=cobc - fi - if test "x$COBCRUN" = "x"; then - echo 'WARNING: $COBCRUN not set, defaulting to "cobcrun"' - COBCRUN=cobcrun - fi - - # test for working executables - $COBC -V 2>/dev/null 1>&2 - ret=$? - if test "$ret" -ne 0; then - echo "error: cobc is not working, re-run with COBC=/path/to/cobc" - echo " and ensure that its dependencies can be found." - echo " COBC is currently \"$COBC\"" - exit $ret - fi - $COBCRUN -V 2>/dev/null 1>&2 - if test "$ret" -ne 0; then - echo "error: cobcrun is not working, re-run with COBCRUN=/path/to/cobcrun" - echo " and ensure that its dependencies can be found." - echo " COBCRUN is currently \"$COBCRUN\"" - exit $ret - fi - -fi - -# Make sure to run this in scope of pre-inst-env -# to use the currently compiled version of cobc -# (is done in the makefile for automated calls) - -# Function for creating the actual file and check -_create_file () { - echo "$0: creating $1" - case "$1" in - "cbhelp.tex") - rm -rf $1 - $COBC -q --help | $GREP -E "ptions.*:" | cut -d: -f1 | \ - while read section; do - header_found="" -# FIXME: re-adjust as this currently results in two SIGSEGV -# which are just hidden here (and shouldn't) - $COBC -q --help 2>/dev/null | \ - $GREP -A2000 "$section" | \ - $GREP -E -B2000 "^$" -m 1 | \ - $SED -e 's/^\t/D~/g' \ - -e 's/\t/~/g' \ - -e 's/* NOT \(.\+\)/; @emph{not \1}/g' \ - -e 's/* ALWAYS \(.\+\)/; @emph{always \1}/g' \ - -e 's/* /; /g' \ - -e 's/^ \+/D~/g' \ - -e 's/^ \+//g' \ - -e 's/ \+/~/g' \ - -e 's/<\([^>]\+\)>/@var{\1}/g'| \ - while IFS='~' read -r name desc; do - if test -z "$name"; then continue; fi - if test -z "$header_found"; then - header_found=1 - echo "@section $section" >>$1 - echo "@table @code" >>$1 - else - if test "$name" != "D"; then - echo "@item @code{$name}" >>$1 - fi - echo "$desc" | \ - $SED -e 's/ \(-[Wfv][a-z-]*\)/ @option{\1}/g' \ - -e 's/\([ (]\)\([A-Z][A-Z -]*[A-Z]\)/\1@code{\2}/g' \ - -e 's/^\([A-Z][A-Z -]*[A-Z]\)/@code{\1}/g' \ - -e 's/@code{\(IBM\|ANSI\|ISO\|NIST\)}/\1/g' >>$1 - fi - done - echo "@end table" >>$1 - done - ;; - "cbchelp.tex") - rm -rf $1 - header_found="" - $COBCRUN -q --help | \ - $GREP -E -A2000 -E "ptions.*:" | \ - $GREP -E -B2000 "^$" -m 1 | \ - $SED -e 's/^ \+/D~/g' \ - -e 's/^ \+//g' \ - -e 's/ \+/~/g' \ - -e 's/<\([^>]\+\)>/@var{\1}/g'| \ - while IFS='~' read -r name desc; do - if test -z "$name"; then continue; fi - if test -z "$header_found"; then - header_found=1 - echo "@table @code" >>$1 - else - if test "$name" != "D"; then - echo "@item @code{$name}" >>$1 - fi - echo "$desc" | \ - $SED -e 's/ -M/ @option{-M}/g' \ - -e 's/\(COB[A-Z_]\+\)/@env{\1}/g' >>$1 - fi - done - echo "@end table" >>$1 - ;; - "cbrese.tex") - echo "@section Common reserved words" >$1 - echo "@multitable @columnfractions .40 .20 .40" >>$1 - echo "@headitem Reserved word @tab Implemented @tab Aliases" >>$1 - $COBC -q --list-reserved | \ - $GREP -E -B9999 "^$" -m 2 | \ - $SED -e 's/ \+/;/g' \ - -e 's/ (Context sensitive/\t(C\/S/g' \ - -e 's/(aliased with \([^)]*\))/;@code{\1}/g' \ - -e 's/ ;/;/g' | \ - while IFS=';' read -r name impl aliases; do - if test -z "$name"; then continue; fi - if test -z "$header_found"; then - header_found=1 - else - echo "@item @code{$name} @tab $impl @tab $aliases" >>$1 - fi - done - echo "@end multitable" >>$1 - - needs_comma="" - header_found="" - $COBC -q --list-reserved | \ - $GREP -A50 "Extra" | \ - $GREP -E -B50 "^$" -m 1 | \ - while read line; do - if test -z "$line"; then continue; fi - if test -z "$header_found"; then - header_found=1 - echo "@section $line" >>$1 - else - if test -z "$needs_comma"; then needs_comma=1 - else printf ", " >>$1; fi - printf "@code{%s}" "$line" >>$1 - fi - done - printf "\n\n" >>$1 - - header_found="" - echo "@section Internal registers" >>$1 - echo "@multitable @columnfractions .40 .20 .40" >>$1 - echo "@headitem Register @tab Implemented @tab Definition" >>$1 - $COBC -q --list-reserved | \ - $GREP -A100 "registers" | \ - $SED -e 's/ \+/~/g' | \ - while IFS='~' read -r name impl definition; do - if test -z "$name"; then continue; fi - if test -z "$header_found"; then - header_found=1 - else - echo "@item @code{$name} @tab $impl @tab @code{$definition}" >>$1 - fi - done - echo "@end multitable" >>$1 - ;; - "cbintr.tex") - echo "@multitable @columnfractions .40 .20 .40" >$1 - $COBC -q --list-intrinsics | \ - $SED -e 's/ \+/\t/g' | \ - while IFS='~' read -r name impl params; do - if test -z "$name"; then continue; fi - if test -z "$header_found"; then - header_found=1 - echo "@headitem $name @tab $impl @tab $params" >>$1 - else - echo "@item @code{$name} @tab $impl @tab $params" >>$1 - fi - done - echo "@end multitable" >>$1 - ;; - "cbsyst.tex") - echo "@multitable @columnfractions .40 .20" >$1 - $COBC -q --list-system | \ - $SED -e 's/ \+/~/g' | \ - while IFS='~' read -r name params; do - if test -z "$name"; then continue; fi - if test -z "$header_found"; then - header_found=1 - echo "@headitem $name @tab $params" >>$1 - else - echo "@item @code{$name} @tab $params" >>$1 - fi - done - echo "@end multitable" >>$1 - ;; - "cbmnem.tex") - system_names="device feature switch" - section_prefix="System names" - rm -rf $1 - for section in $system_names; do - needs_comma="" - echo "@section $section_prefix: $section" >>$1 - $COBC -q --list-mnemonics | \ - $GREP "$section" | cut -d' ' -f1 |\ - while read name; do - if test -z "$needs_comma"; then needs_comma=1 - else printf ", " >>$1; fi - printf "@code{%s}" "$name" >>$1 - done - printf "\n\n" >>$1 - done - ;; - "cbconf.tex") - lines=2 - $GREP -A9999 "https://www.gnu.org/licenses/" \ - "$confdir/default.conf" \ - | $SED -e 's/\r//g' \ - -e 's/# \?TO-\?DO.*//g' \ - | $TAIL_START$lines >$1 - ;; - "cbrunt.tex") - # First section, as it is formatted different - $GREP -A400 -m1 "##" "$confdir/runtime.cfg" | \ - $GREP -B400 -m2 "##" | \ - cut -b2- | \ - $SED -e 's/\r//g' \ - -e 's/^#$//g' \ - -e 's/^#\( .*\)/@section\1\n/g' \ - -e 's/^ //g' \ - -e 's/{/@{/g' \ - -e 's/}/@}/g' \ - -e 's/\(Example:\) \(.*\)$/\n\1 @code{\2}/g' \ - -e 's/ \([^ ][^(]*\) \([,.]\)/ @code{\1}\2/g' \ - -e 's/ \([^ ][^(]*\) / @code{\1} /g' \ - -e 's/ \([^ ][^(]*\)$/ @code{\1}/g' \ - -e 's/^$/@\*/g' > $1 - lines=`cat $1 | wc -l` - lines=`expr 20 + $lines` - # All other sections - echo "@verbatim" >>$1 - $TAIL_START$lines "$confdir/runtime.cfg" | \ - cut -b2- | \ - $SED -e 's/\r//g' \ - -e 's/# \?TO-\?DO.*$//g' \ - -e 's/^#\( .*\)/@end verbatim\n@section\1\n@verbatim/g' \ - -e 's/^ //g' >>$1 - echo "@end verbatim" >>$1 - ;; - esac -} - -docdir="`dirname $0`" -confdir="$docdir/../config" -created_texfiles="cbhelp.tex cbchelp.tex cbrese.tex cbintr.tex cbsyst.tex" -created_texfiles="$created_texfiles cbmnem.tex cbconf.tex cbrunt.tex" - - -# for old systems that don't support this POSIX parameter expansion: -#case "$1" in -# otherwise: only use filename (strip possible path) -case "${1##*/}" in - "") - for file in $created_texfiles; do - _create_file $file - done - ;; - "help") - _create_file "cbhelp.tex" - _create_file "cbchelp.tex" - ;; - "lists") - _create_file "cbrese.tex" - _create_file "cbintr.tex" - _create_file "cbsyst.tex" - _create_file "cbmnem.tex" - ;; - "conf") - _create_file "cbconf.tex" - _create_file "cbrunt.tex" - ;; - "cbhelp.tex") - _create_file "cbhelp.tex" - ;; - "cbchelp.tex") - _create_file "cbchelp.tex" - ;; - "cbrese.tex") - _create_file "cbrese.tex" - ;; - "cbintr.tex") - _create_file "cbintr.tex" - ;; - "cbsyst.tex") - _create_file "cbsyst.tex" - ;; - "cbmnem.tex") - _create_file "cbmnem.tex" - ;; - "cbconf.tex") - _create_file "cbconf.tex" - ;; - "cbrunt.tex") - _create_file "cbrunt.tex" - ;; - "fixtimestamps") - echo $0: touch tex-includes - for file in $created_texfiles; do - echo " touch $file" - touch $file - done - if test "$2" != "includes"; then - echo $0: touch tex-results - for file in $docdir/gnucobol.*; do - if test "$file" = "$docdir/gnucobol.texi"; then continue; fi - echo " touch $file" - touch $file - done - fi - ;; - *) - echo "$0: ERROR: called with unsupported option $1" - exit 1; -esac diff -Nru gnucobol-4.0~early~20200606/doc/fdl.texi gnucobol-5/doc/fdl.texi --- gnucobol-4.0~early~20200606/doc/fdl.texi 2020-06-06 20:52:02.000000000 +0000 +++ gnucobol-5/doc/fdl.texi 1970-01-01 00:00:00.000000000 +0000 @@ -1,505 +0,0 @@ -@c The GNU Free Documentation License. -@center Version 1.3, 3 November 2008 - -@c This file is intended to be included within another document, -@c hence no sectioning command or @node. - -@display -Copyright @copyright{} 2000, 2001, 2002, 2007, 2008 Free Software Foundation, Inc. -@uref{https://fsf.org/} - -Everyone is permitted to copy and distribute verbatim copies -of this license document, but changing it is not allowed. -@end display - -@enumerate 0 -@item -PREAMBLE - -The purpose of this License is to make a manual, textbook, or other -functional and useful document @dfn{free} in the sense of freedom: to -assure everyone the effective freedom to copy and redistribute it, -with or without modifying it, either commercially or noncommercially. -Secondarily, this License preserves for the author and publisher a way -to get credit for their work, while not being considered responsible -for modifications made by others. - -This License is a kind of ``copyleft'', which means that derivative -works of the document must themselves be free in the same sense. It -complements the GNU General Public License, which is a copyleft -license designed for free software. - -We have designed this License in order to use it for manuals for free -software, because free software needs free documentation: a free -program should come with manuals providing the same freedoms that the -software does. But this License is not limited to software manuals; -it can be used for any textual work, regardless of subject matter or -whether it is published as a printed book. We recommend this License -principally for works whose purpose is instruction or reference. - -@item -APPLICABILITY AND DEFINITIONS - -This License applies to any manual or other work, in any medium, that -contains a notice placed by the copyright holder saying it can be -distributed under the terms of this License. Such a notice grants a -world-wide, royalty-free license, unlimited in duration, to use that -work under the conditions stated herein. The ``Document'', below, -refers to any such manual or work. Any member of the public is a -licensee, and is addressed as ``you''. You accept the license if you -copy, modify or distribute the work in a way requiring permission -under copyright law. - -A ``Modified Version'' of the Document means any work containing the -Document or a portion of it, either copied verbatim, or with -modifications and/or translated into another language. - -A ``Secondary Section'' is a named appendix or a front-matter section -of the Document that deals exclusively with the relationship of the -publishers or authors of the Document to the Document's overall -subject (or to related matters) and contains nothing that could fall -directly within that overall subject. (Thus, if the Document is in -part a textbook of mathematics, a Secondary Section may not explain -any mathematics.) The relationship could be a matter of historical -connection with the subject or with related matters, or of legal, -commercial, philosophical, ethical or political position regarding -them. - -The ``Invariant Sections'' are certain Secondary Sections whose titles -are designated, as being those of Invariant Sections, in the notice -that says that the Document is released under this License. If a -section does not fit the above definition of Secondary then it is not -allowed to be designated as Invariant. The Document may contain zero -Invariant Sections. If the Document does not identify any Invariant -Sections then there are none. - -The ``Cover Texts'' are certain short passages of text that are listed, -as Front-Cover Texts or Back-Cover Texts, in the notice that says that -the Document is released under this License. A Front-Cover Text may -be at most 5 words, and a Back-Cover Text may be at most 25 words. - -A ``Transparent'' copy of the Document means a machine-readable copy, -represented in a format whose specification is available to the -general public, that is suitable for revising the document -straightforwardly with generic text editors or (for images composed of -pixels) generic paint programs or (for drawings) some widely available -drawing editor, and that is suitable for input to text formatters or -for automatic translation to a variety of formats suitable for input -to text formatters. A copy made in an otherwise Transparent file -format whose markup, or absence of markup, has been arranged to thwart -or discourage subsequent modification by readers is not Transparent. -An image format is not Transparent if used for any substantial amount -of text. A copy that is not ``Transparent'' is called ``Opaque''. - -Examples of suitable formats for Transparent copies include plain -ASCII without markup, Texinfo input format, La@TeX{} input -format, SGML or XML using a publicly available -DTD, and standard-conforming simple HTML, -PostScript or PDF designed for human modification. Examples -of transparent image formats include PNG, XCF and -JPG@. Opaque formats include proprietary formats that can be -read and edited only by proprietary word processors, SGML or -XML for which the DTD and/or processing tools are -not generally available, and the machine-generated HTML, -PostScript or PDF produced by some word processors for -output purposes only. - -The ``Title Page'' means, for a printed book, the title page itself, -plus such following pages as are needed to hold, legibly, the material -this License requires to appear in the title page. For works in -formats which do not have any title page as such, ``Title Page'' means -the text near the most prominent appearance of the work's title, -preceding the beginning of the body of the text. - -The ``publisher'' means any person or entity that distributes copies -of the Document to the public. - -A section ``Entitled XYZ'' means a named subunit of the Document whose -title either is precisely XYZ or contains XYZ in parentheses following -text that translates XYZ in another language. (Here XYZ stands for a -specific section name mentioned below, such as ``Acknowledgements'', -``Dedications'', ``Endorsements'', or ``History''.) To ``Preserve the Title'' -of such a section when you modify the Document means that it remains a -section ``Entitled XYZ'' according to this definition. - -The Document may include Warranty Disclaimers next to the notice which -states that this License applies to the Document. These Warranty -Disclaimers are considered to be included by reference in this -License, but only as regards disclaiming warranties: any other -implication that these Warranty Disclaimers may have is void and has -no effect on the meaning of this License. - -@item -VERBATIM COPYING - -You may copy and distribute the Document in any medium, either -commercially or noncommercially, provided that this License, the -copyright notices, and the license notice saying this License applies -to the Document are reproduced in all copies, and that you add no other -conditions whatsoever to those of this License. You may not use -technical measures to obstruct or control the reading or further -copying of the copies you make or distribute. However, you may accept -compensation in exchange for copies. If you distribute a large enough -number of copies you must also follow the conditions in section 3. - -You may also lend copies, under the same conditions stated above, and -you may publicly display copies. - -@item -COPYING IN QUANTITY - -If you publish printed copies (or copies in media that commonly have -printed covers) of the Document, numbering more than 100, and the -Document's license notice requires Cover Texts, you must enclose the -copies in covers that carry, clearly and legibly, all these Cover -Texts: Front-Cover Texts on the front cover, and Back-Cover Texts on -the back cover. Both covers must also clearly and legibly identify -you as the publisher of these copies. The front cover must present -the full title with all words of the title equally prominent and -visible. You may add other material on the covers in addition. -Copying with changes limited to the covers, as long as they preserve -the title of the Document and satisfy these conditions, can be treated -as verbatim copying in other respects. - -If the required texts for either cover are too voluminous to fit -legibly, you should put the first ones listed (as many as fit -reasonably) on the actual cover, and continue the rest onto adjacent -pages. - -If you publish or distribute Opaque copies of the Document numbering -more than 100, you must either include a machine-readable Transparent -copy along with each Opaque copy, or state in or with each Opaque copy -a computer-network location from which the general network-using -public has access to download using public-standard network protocols -a complete Transparent copy of the Document, free of added material. -If you use the latter option, you must take reasonably prudent steps, -when you begin distribution of Opaque copies in quantity, to ensure -that this Transparent copy will remain thus accessible at the stated -location until at least one year after the last time you distribute an -Opaque copy (directly or through your agents or retailers) of that -edition to the public. - -It is requested, but not required, that you contact the authors of the -Document well before redistributing any large number of copies, to give -them a chance to provide you with an updated version of the Document. - -@item -MODIFICATIONS - -You may copy and distribute a Modified Version of the Document under -the conditions of sections 2 and 3 above, provided that you release -the Modified Version under precisely this License, with the Modified -Version filling the role of the Document, thus licensing distribution -and modification of the Modified Version to whoever possesses a copy -of it. In addition, you must do these things in the Modified Version: - -@enumerate A -@item -Use in the Title Page (and on the covers, if any) a title distinct -from that of the Document, and from those of previous versions -(which should, if there were any, be listed in the History section -of the Document). You may use the same title as a previous version -if the original publisher of that version gives permission. - -@item -List on the Title Page, as authors, one or more persons or entities -responsible for authorship of the modifications in the Modified -Version, together with at least five of the principal authors of the -Document (all of its principal authors, if it has fewer than five), -unless they release you from this requirement. - -@item -State on the Title page the name of the publisher of the -Modified Version, as the publisher. - -@item -Preserve all the copyright notices of the Document. - -@item -Add an appropriate copyright notice for your modifications -adjacent to the other copyright notices. - -@item -Include, immediately after the copyright notices, a license notice -giving the public permission to use the Modified Version under the -terms of this License, in the form shown in the Addendum below. - -@item -Preserve in that license notice the full lists of Invariant Sections -and required Cover Texts given in the Document's license notice. - -@item -Include an unaltered copy of this License. - -@item -Preserve the section Entitled ``History'', Preserve its Title, and add -to it an item stating at least the title, year, new authors, and -publisher of the Modified Version as given on the Title Page. If -there is no section Entitled ``History'' in the Document, create one -stating the title, year, authors, and publisher of the Document as -given on its Title Page, then add an item describing the Modified -Version as stated in the previous sentence. - -@item -Preserve the network location, if any, given in the Document for -public access to a Transparent copy of the Document, and likewise -the network locations given in the Document for previous versions -it was based on. These may be placed in the ``History'' section. -You may omit a network location for a work that was published at -least four years before the Document itself, or if the original -publisher of the version it refers to gives permission. - -@item -For any section Entitled ``Acknowledgements'' or ``Dedications'', Preserve -the Title of the section, and preserve in the section all the -substance and tone of each of the contributor acknowledgements and/or -dedications given therein. - -@item -Preserve all the Invariant Sections of the Document, -unaltered in their text and in their titles. Section numbers -or the equivalent are not considered part of the section titles. - -@item -Delete any section Entitled ``Endorsements''. Such a section -may not be included in the Modified Version. - -@item -Do not retitle any existing section to be Entitled ``Endorsements'' or -to conflict in title with any Invariant Section. - -@item -Preserve any Warranty Disclaimers. -@end enumerate - -If the Modified Version includes new front-matter sections or -appendices that qualify as Secondary Sections and contain no material -copied from the Document, you may at your option designate some or all -of these sections as invariant. To do this, add their titles to the -list of Invariant Sections in the Modified Version's license notice. -These titles must be distinct from any other section titles. - -You may add a section Entitled ``Endorsements'', provided it contains -nothing but endorsements of your Modified Version by various -parties---for example, statements of peer review or that the text has -been approved by an organization as the authoritative definition of a -standard. - -You may add a passage of up to five words as a Front-Cover Text, and a -passage of up to 25 words as a Back-Cover Text, to the end of the list -of Cover Texts in the Modified Version. Only one passage of -Front-Cover Text and one of Back-Cover Text may be added by (or -through arrangements made by) any one entity. If the Document already -includes a cover text for the same cover, previously added by you or -by arrangement made by the same entity you are acting on behalf of, -you may not add another; but you may replace the old one, on explicit -permission from the previous publisher that added the old one. - -The author(s) and publisher(s) of the Document do not by this License -give permission to use their names for publicity for or to assert or -imply endorsement of any Modified Version. - -@item -COMBINING DOCUMENTS - -You may combine the Document with other documents released under this -License, under the terms defined in section 4 above for modified -versions, provided that you include in the combination all of the -Invariant Sections of all of the original documents, unmodified, and -list them all as Invariant Sections of your combined work in its -license notice, and that you preserve all their Warranty Disclaimers. - -The combined work need only contain one copy of this License, and -multiple identical Invariant Sections may be replaced with a single -copy. If there are multiple Invariant Sections with the same name but -different contents, make the title of each such section unique by -adding at the end of it, in parentheses, the name of the original -author or publisher of that section if known, or else a unique number. -Make the same adjustment to the section titles in the list of -Invariant Sections in the license notice of the combined work. - -In the combination, you must combine any sections Entitled ``History'' -in the various original documents, forming one section Entitled -``History''; likewise combine any sections Entitled ``Acknowledgements'', -and any sections Entitled ``Dedications''. You must delete all -sections Entitled ``Endorsements.'' - -@item -COLLECTIONS OF DOCUMENTS - -You may make a collection consisting of the Document and other documents -released under this License, and replace the individual copies of this -License in the various documents with a single copy that is included in -the collection, provided that you follow the rules of this License for -verbatim copying of each of the documents in all other respects. - -You may extract a single document from such a collection, and distribute -it individually under this License, provided you insert a copy of this -License into the extracted document, and follow this License in all -other respects regarding verbatim copying of that document. - -@item -AGGREGATION WITH INDEPENDENT WORKS - -A compilation of the Document or its derivatives with other separate -and independent documents or works, in or on a volume of a storage or -distribution medium, is called an ``aggregate'' if the copyright -resulting from the compilation is not used to limit the legal rights -of the compilation's users beyond what the individual works permit. -When the Document is included in an aggregate, this License does not -apply to the other works in the aggregate which are not themselves -derivative works of the Document. - -If the Cover Text requirement of section 3 is applicable to these -copies of the Document, then if the Document is less than one half of -the entire aggregate, the Document's Cover Texts may be placed on -covers that bracket the Document within the aggregate, or the -electronic equivalent of covers if the Document is in electronic form. -Otherwise they must appear on printed covers that bracket the whole -aggregate. - -@item -TRANSLATION - -Translation is considered a kind of modification, so you may -distribute translations of the Document under the terms of section 4. -Replacing Invariant Sections with translations requires special -permission from their copyright holders, but you may include -translations of some or all Invariant Sections in addition to the -original versions of these Invariant Sections. You may include a -translation of this License, and all the license notices in the -Document, and any Warranty Disclaimers, provided that you also include -the original English version of this License and the original versions -of those notices and disclaimers. In case of a disagreement between -the translation and the original version of this License or a notice -or disclaimer, the original version will prevail. - -If a section in the Document is Entitled ``Acknowledgements'', -``Dedications'', or ``History'', the requirement (section 4) to Preserve -its Title (section 1) will typically require changing the actual -title. - -@item -TERMINATION - -You may not copy, modify, sublicense, or distribute the Document -except as expressly provided under this License. Any attempt -otherwise to copy, modify, sublicense, or distribute it is void, and -will automatically terminate your rights under this License. - -However, if you cease all violation of this License, then your license -from a particular copyright holder is reinstated (a) provisionally, -unless and until the copyright holder explicitly and finally -terminates your license, and (b) permanently, if the copyright holder -fails to notify you of the violation by some reasonable means prior to -60 days after the cessation. - -Moreover, your license from a particular copyright holder is -reinstated permanently if the copyright holder notifies you of the -violation by some reasonable means, this is the first time you have -received notice of violation of this License (for any work) from that -copyright holder, and you cure the violation prior to 30 days after -your receipt of the notice. - -Termination of your rights under this section does not terminate the -licenses of parties who have received copies or rights from you under -this License. If your rights have been terminated and not permanently -reinstated, receipt of a copy of some or all of the same material does -not give you any rights to use it. - -@item -FUTURE REVISIONS OF THIS LICENSE - -The Free Software Foundation may publish new, revised versions -of the GNU Free Documentation License from time to time. Such new -versions will be similar in spirit to the present version, but may -differ in detail to address new problems or concerns. See -@uref{https://www.gnu.org/licenses/}. - -Each version of the License is given a distinguishing version number. -If the Document specifies that a particular numbered version of this -License ``or any later version'' applies to it, you have the option of -following the terms and conditions either of that specified version or -of any later version that has been published (not as a draft) by the -Free Software Foundation. If the Document does not specify a version -number of this License, you may choose any version ever published (not -as a draft) by the Free Software Foundation. If the Document -specifies that a proxy can decide which future versions of this -License can be used, that proxy's public statement of acceptance of a -version permanently authorizes you to choose that version for the -Document. - -@item -RELICENSING - -``Massive Multiauthor Collaboration Site'' (or ``MMC Site'') means any -World Wide Web server that publishes copyrightable works and also -provides prominent facilities for anybody to edit those works. A -public wiki that anybody can edit is an example of such a server. A -``Massive Multiauthor Collaboration'' (or ``MMC'') contained in the -site means any set of copyrightable works thus published on the MMC -site. - -``CC-BY-SA'' means the Creative Commons Attribution-Share Alike 3.0 -license published by Creative Commons Corporation, a not-for-profit -corporation with a principal place of business in San Francisco, -California, as well as future copyleft versions of that license -published by that same organization. - -``Incorporate'' means to publish or republish a Document, in whole or -in part, as part of another Document. - -An MMC is ``eligible for relicensing'' if it is licensed under this -License, and if all works that were first published under this License -somewhere other than this MMC, and subsequently incorporated in whole -or in part into the MMC, (1) had no cover texts or invariant sections, -and (2) were thus incorporated prior to November 1, 2008. - -The operator of an MMC Site may republish an MMC contained in the site -under CC-BY-SA on the same site at any time before August 1, 2009, -provided the MMC is eligible for relicensing. - -@end enumerate - -@page -@heading ADDENDUM: How to use this License for your documents - -To use this License in a document you have written, include a copy of -the License in the document and put the following copyright and -license notices just after the title page: - -@smallexample -@group - Copyright (C) @var{year} @var{your name}. - Permission is granted to copy, distribute and/or modify this document - under the terms of the GNU Free Documentation License, Version 1.3 - or any later version published by the Free Software Foundation; - with no Invariant Sections, no Front-Cover Texts, and no Back-Cover - Texts. A copy of the license is included in the section entitled ``GNU - Free Documentation License''. -@end group -@end smallexample - -If you have Invariant Sections, Front-Cover Texts and Back-Cover Texts, -replace the ``with@dots{}Texts.''@: line with this: - -@smallexample -@group - with the Invariant Sections being @var{list their titles}, with - the Front-Cover Texts being @var{list}, and with the Back-Cover Texts - being @var{list}. -@end group -@end smallexample - -If you have Invariant Sections without Cover Texts, or some other -combination of the three, merge those two alternatives to suit the -situation. - -If your document contains nontrivial examples of program code, we -recommend releasing these examples in parallel under your choice of -free software license, such as the GNU General Public License, -to permit their use in free software. - -@c Local Variables: -@c ispell-local-pdict: "ispell-dict" -@c End: diff -Nru gnucobol-4.0~early~20200606/doc/gnucobol.info gnucobol-5/doc/gnucobol.info --- gnucobol-4.0~early~20200606/doc/gnucobol.info 2020-06-06 20:52:55.000000000 +0000 +++ gnucobol-5/doc/gnucobol.info 1970-01-01 00:00:00.000000000 +0000 @@ -1,5469 +0,0 @@ -This is gnucobol.info, produced by makeinfo version 6.5 from -gnucobol.texi. - -Permission is granted to make and distribute verbatim copies of this -manual provided the copyright notice and this permission notice are -preserved on all copies. - - Permission is granted to copy and distribute modified versions of -this manual under the conditions for verbatim copying, provided that the -entire resulting derived work is distributed under the terms of a -permission notice identical to this one. - - Permission is granted to copy and distribute translations of this -manual into another language, under the above conditions for modified -versions, except that this permission notice may be stated in a -translation approved by the Free Software Foundation. -INFO-DIR-SECTION Software development -START-INFO-DIR-ENTRY -* cobc: (gnucobol)Compile. The GnuCOBOL compiler. -END-INFO-DIR-ENTRY - -INFO-DIR-SECTION COBOL -START-INFO-DIR-ENTRY -* GnuCOBOL: (gnucobol). A COBOL compiler -END-INFO-DIR-ENTRY - -INFO-DIR-SECTION GnuCOBOL -START-INFO-DIR-ENTRY -* Overview: (gnucobol). COBOL compiler overview. -END-INFO-DIR-ENTRY - - -File: gnucobol.info, Node: Top, Next: Getting started, Up: (dir) - -Welcome to the GnuCOBOL 4.0-early-dev manual. - -* Menu: - -* Getting started:: Introduction to GnuCOBOL -* Compile:: Compiling COBOL programs -* Customize:: Customizing the compiler -* Optimize:: Optimizing your program -* Debug:: Debugging your program -* Extensions:: Non-standard extensions -* System Routines:: Additional routines -* Appendices:: List of supported features and options, - Compiler and Runtime Configuration, - Documentation License - - - -- The Detailed Node Listing -- - -Getting started - -* Hello world!:: Hello, world! - -Compile - -* Compiler options:: Compiler options -* Multiple sources:: Compiling multiple source files -* C interface:: Dealing with C files - -Compiler options - -* Help options:: Help options -* Build target:: Build target -* Source format:: Source format -* Warning options:: Warning options -* Configuration options:: Configuration options -* Listing options:: Listing options -* Debug switches:: Debug switches -* Miscellaneous:: Miscellaneous - -Multiple sources - -* Static linking:: Compiling into a single executable -* Dynamic linking:: A main program and separate modules -* Building library:: Building a shared library -* Using library:: Using external libraries - -C interface - -* Main C program:: Writing main program in C -* Static C to COBOL:: -* Dynamic C to COBOL:: -* Static COBOL to C:: -* Dynamic COBOL to C:: - -Customize - -* Customizing compiler:: Customizing compiler -* Customizing library:: Customizing library - -Optimize - -* Optimize options:: How to enable optimization -* Optimize call:: Call subroutines efficiently -* Optimize binary:: Use efficient binary representation - -Debug - -* Debug options:: Debug options - -Extensions - -* SELECT:: SELECT ASSIGN TO. -* Indexed:: Indexed file packages. -* Extended ACCEPT:: Extended ACCEPT statement. -* ACCEPT special:: ACCEPT special keys. -* Extended DISPLAY:: Extended DISPLAY statement. -* FUNCTION CONTENT-LENGTH:: Length of NUL byte terminated pointer data. -* FUNCTION CONTENT-OF:: Content of data at pointer, by length or NUL. - -System Routines - -* CBL_GC_GETOPT GETOPT for Cobol -* CBL_GC_HOSTED Access to C hosted variables -* CBL_GC_NANOSLEEP Sleep for nanoseconds -* CBL_GC_FORK Fork the current COBOL process to a new one -* CBL_GC_WAITPID Wait for a system process to end - -Appendices - -* Appendix A Compiler 'cobc' options -* Appendix B Reserved Words -* Appendix C Intrinsic Functions -* Appendix D System routines -* Appendix E System names -* Appendix F Compiler Configuration -* Appendix G Module loader 'cobcrun' options -* Appendix H Runtime configuration -* Appendix I GNU Free Documentation License - - - -File: gnucobol.info, Node: Getting started, Next: Compile, Prev: Top, Up: Top - -1 Getting started -***************** - -* Menu: - -* Hello world!:: Hello, world! - - -File: gnucobol.info, Node: Hello world!, Up: Getting started - -1.1 Hello, world! -================= - -This is a sample program that displays "Hello, world!": - - ---- hello.cob ------------------------- - * Sample COBOL program - IDENTIFICATION DIVISION. - PROGRAM-ID. hello. - PROCEDURE DIVISION. - DISPLAY "Hello, world!". - STOP RUN. - ---------------------------------------- - - - The compiler, 'cobc', is executed as follows: - - $ cobc -x hello.cob - $ ./hello - Hello, world! - - - The executable file name ('hello' in this case) is determined by -removing the extension from the source file name. - - - You can specify the executable file name by specifying the compiler -option '-o' as follows: - - $ cobc -x -o hello-world hello.cob - $ ./hello-world - Hello, world! - - - The program can be written in a more modern style, with free format -code, inline comments, the 'GOBACK' verb and an optional 'END-DISPLAY' -terminator: - - ---- hellonew.cob ---------------- - *> Sample GnuCOBOL program - identification division. - program-id. hellonew. - procedure division. - display - "Hello, new world!" - end-display - goback. - ---------------------------------- - - To compile free-format code, you must use the compiler option -'-free'. - - $ cobc -x -free hellonew.cob - $ ./hellonew - Hello, new world! - - -File: gnucobol.info, Node: Compile, Next: Customize, Prev: Getting started, Up: Top - -2 Compile -********* - -This chapter describes how to compile COBOL programs using GnuCOBOL. - -* Menu: - -* Compiler options:: Compiler options -* Multiple sources:: Compiling multiple source files -* C interface:: Dealing with C files - - -File: gnucobol.info, Node: Compiler options, Next: Multiple sources, Up: Compile - -2.1 Compiler options -==================== - -The compiler 'cobc' accepts the options described in this section. The -compiler arguments follow the general syntax 'cobc OPTIONS FILE [FILE -...]'. A complete list of options can be displayed by using the option -'--help'. - -* Menu: - -* Help options:: Help options -* Build target:: Build target -* Source format:: Source format -* Warning options:: Warning options -* Configuration options:: Configuration options -* Listing options:: Listing options -* Debug switches:: Debug switches -* Miscellaneous:: Miscellaneous - - -File: gnucobol.info, Node: Help options, Next: Build target, Up: Compiler options - -2.1.1 Help options ------------------- - -The following switches display information about the compiler: - -'--help, -h' - Display help screen (*note Appendix A::). No further actions will - be taken. - -'--version' - Display compiler version, author package date and executable build - date. '-V' will also display version. No further actions will be - taken. - -'--info' - Display build information along with the default and current - compiler configurations. No further actions will be taken except - for further display options. - -'-v' - Verbosely display the programs invoked during compilation. - -'--list-reserved' - Display reserved words (*note Appendix B::). A Yes/No output shows - if the word is supported (1), context sensitive and its aliases. - The given options for reserved words specified for example by - option '-std=DIALECT' will be taken into account. No further - actions will be taken except for further display options. - -'--list-intrinsics' - Display intrinsic functions (*note Appendix C::). A Y/N field - shows if the function is implemented. No further actions will be - taken except for further display options. - -'--list-system' - Display system routines (*note Appendix D::). No further actions - will be taken except for further display options. - -'--list-mnemonics' - Display mnemonic names (*note Appendix E::). No further actions - will be taken except for further display options. - - ---------- Footnotes ---------- - - (1) Support may be partial or complete. - - -File: gnucobol.info, Node: Build target, Next: Source format, Prev: Help options, Up: Compiler options - -2.1.2 Build target ------------------- - -The compiler 'cobc' treats files like '*.cob', '*.cbl' as COBOL source -code, '*.c' as C source code, '*.o' as object code, '*.i' as -preprocessed code and '*.so' as dynamic modules and knows how to handle -such files in the generation, compilation, and linking steps. - - The special input name '-' takes input from 'stdin' which is assumed -to be COBOL source, and uses a default output name of 'a.out' (or -'a.so/c/o/i', selected as appropriate) for the build type. - - By default, the compiler builds a dynamically loadable module. - - The following options specify the target type produced by the -compiler: - -'-E' - Preprocess only: compiler directives are executed, comment lines - are removed and 'COPY' statements are expanded. The output is - saved in file '*.i'. - -'-C' - Translation only. COBOL source files are translated into C files. - The output is saved in file '*.c'. - -'-S' - Compile only. Translated C files are compiled by the C compiler to - assembler code. The output is saved in file '*.s'. - -'-c' - Compile and assemble. This is equivalent to 'cc -c'. The output - is saved in file '*.o'. - -'-m' - Compile, assemble, and build a dynamically loadable module (i.e., a - shared library). The output is saved in file '*.so'. (1) This is - the default behaviour. - -'-b' - Compile, assemble, and combine all input files into a single - dynamically loadable module. Unless '-o' is also used, the output - is saved using the first filename as '*.so'. - -'-x' - Include the main function in the output, creating an executable - image. The main entry point being the first program in the file. - - This option takes effect at the translation stage. If you give - this option with '-C', you will see the main function at the end of - the generated C file. - -'-j, -job, -j=ARGS, -job=ARGS' - Run job after compilation. Either from executable with '-x', or - with 'cobcrun' when compiling a module. Optional arguments ARGS, - if given, are passed to the program or module command line. - -'-I DIRECTORY' - Add DIRECTORY to copy/include search path. - -'-L DIRECTORY' - Add DIRECTORY to library search path. - -'-l LIB' - Link the library LIB. - -'-D DEFINE' - Pass DEFINE to the COBOL compiler. - -'-o FILE' - Place the output into FILE. - - ---------- Footnotes ---------- - - (1) The extension varies depending on your host. - - -File: gnucobol.info, Node: Source format, Next: Warning options, Prev: Build target, Up: Compiler options - -2.1.3 Source format -------------------- - -GnuCOBOL supports both fixed and free source format. The default format -is the fixed format. This can be overridden either by the '>>SOURCE -[FORMAT] [IS] {FIXED|FREE}' directive, or by one of the following -options: - -'-free, -F' - Free format. The program-text area starts in column 1 and - continues till the end of line (effectively 255 characters in - GnuCOBOL). - -'-fixed' - Fixed format. Source code is divided into: columns 1-6, the - sequence number area; column 7, the indicator area; columns 8-72, - the program-text area; and columns 72-80 as the reference area.(1) - - ---------- Footnotes ---------- - - (1) Historically, fixed format was based on 80-character punch cards. - - -File: gnucobol.info, Node: Warning options, Next: Configuration options, Prev: Source format, Up: Compiler options - -2.1.4 Warning options ---------------------- - -'-W' - Enable every possible warning. This includes more information than - '-Wall' would normally provide. - -'-Wall' - Enable all common warnings. - -'-WWARNING' - Enable single warning WARNING. - -'-Wno-WARNING' - Disable single warning WARNING. - -'-Warchaic' - Warn if archaic features are used, such as continuation lines or - the 'NEXT SENTENCE' statement. - -'-Wcall-params' - Warn if non-01/77-level items are used as arguments in a 'CALL' - statement. This is _not_ set with '-Wall'. - -'-Wcolumn-overflow' - Warn if text after column 72 in FIXED format. This is _not_ set - with '-Wall'. - -'-Wconstant' - Warn inconsistent constant - -'-Wimplicit-define' - Warn if implicitly defined data items are used. - -'-Wlinkage' - Warn dangling 'LINKAGE' items. This is _not_ set with '-Wall'. - -'-Wobsolete' - Warn if obsolete features are used. - -'-Wparentheses' - Warn about any lack of parentheses around 'AND' within 'OR'. - -'-Wredefinition' - Warn about incompatible redefinitions of data items. - -'-Wstrict-typing' - Warn about type mismatch strictly. - -'-Wterminator' - Warn about the lack of scope terminator END-XXX. This is _not_ set - with '-Wall'. - -'-Wtruncate' - Warn on possible field truncation. This is _not_ set with '-Wall'. - -'-Wunreachable' - Warn if statements are unreachable. This is _not_ set with - '-Wall'. - - -File: gnucobol.info, Node: Configuration options, Next: Listing options, Prev: Warning options, Up: Compiler options - -2.1.5 Configuration options ---------------------------- - -'-std=DIALECT' - Compiler uses the given DIALECT to determine certain compiler - features and warnings. - *Note Compiler Configuration: Appendix F, and 'config/*.conf'. - Note: The GnuCOBOL compiler tries to limit both the feature-set and - reserved words to the specified compiler when the "strict" dialects - are used. COBOL sources compiled with these dialects are therefore - likely to compile with the specified compiler and vice versa: - sources that were compiled on the specified compiler should compile - without any issues with GnuCOBOL. - With the "non-strict" dialects GnuCOBOL will activate the complete - feature-set where it doesn't directly conflict with the specified - dialect, including reserved words. COBOL sources compiled with - these dialects therefore may work only with GnuCOBOL. COBOL sources - may need a change because of reserved words in GnuCOBOL, otherwise - offending words WORD-1 and WORD-2 may be removed by - '-fno-reserved=WORD-1,WORD-1'. - - COBOL-85, X/Open COBOL, COBOL 2002 and COBOL 2014 are always - "strict". - -'-std=default' - GnuCOBOL dialect, supporting many of the COBOL 2002 and COBOL 2014 - features, many extensions found in other dialects and its own - feature-set - -'-std=cobol85' - COBOL-85 without any extensions other than the amendment Intrinsic - Function Module (1989), source compiled with this dialect is likely - to compile with most COBOL compilers - -'-std=xopen' - X/Open COBOL (based on COBOL-85) without any vendor extensions, - source compiled with this dialect is likely to compile with most - COBOL compilers; will warn items that "should not be used in a - conforming X/Open COBOL source program" - -'-std=cobol2002, -std=cobol2014' - COBOL 2002 / COBOL 2014 without any vendor extensions, use - '-Warchaic' and '-Wobsolete' if archaic/obsolete features should be - flagged - -'-std=ibm-strict, -std=ibm' - IBM compatible - -'-std=mvs-strict, -std=mvs' - MVS compatible - -'-std=mf-strict, -std=mf' - Micro Focus compatible - -'-std=bs2000-strict, -std=bs2000' - BS2000 compatible - -'-std=acu-strict, -std=acu' - ACUCOBOL-GT compatible - -'-std=rm-strict, -std=rm' - RM/COBOL compatible - -'-conf=' - User-defined dialect configuration. See '-std=DIALECT' above. - - You can override each single configuration entry by using compiler -configuration options on the command line. - - Examples: - -'-frelax-syntax-checks' -'-frenames-uncommon-levels=warning' -'-fnot-reserved=CHAIN,SCREEN' -'-ftab-width=4' - *Note Compiler 'cobc' options: Appendix A. - - -File: gnucobol.info, Node: Listing options, Next: Debug switches, Prev: Configuration options, Up: Compiler options - -2.1.6 Listing options ---------------------- - -'-t=FILE' - Generate and place the standard print listing into 'FILE'. - -'-T=FILE' - Generate and place a wide print listing into '*FILE'. - -'--tlines=LINES' - Specify lines per page in print listing, default = 55. Set to zero - for no additional page breaks. - -'-ftsymbols' - Generate symbol table in listing. - -'-fno-theader' - Suppress all headers from listing while keeping page breaks. - -'-fno-tmessages' - Suppress warning and error summary from listing. - -'-fno-tsource' - Suppress actual source from listing (for example to only produce - the cross-reference). - -'-P, -PDIRECTORY, -P=FILE' - Generate and place a preprocessed listing (old format) into - 'FILENAME.lst', 'DIRECTORY/FILENAME.lst', 'FILE'. - -'-Xref' -'-X' - Generate cross reference in the listing. - - Here is an example program listing with the options '-t -ftsymbols': - - GnuCOBOL 3.0.0 test.cbl Mon May 14 10:23:45 2018 Page 0001 - - LINE PG/LN A...B........................................................... - - 000001 IDENTIFICATION DIVISION. - 000002 PROGRAM-ID. prog. - 000003 ENVIRONMENT DIVISION. - 000004 CONFIGURATION SECTION. - 000005 DATA DIVISION. - 000006 WORKING-STORAGE SECTION. - 000007 COPY 'values.cpy'. - 000001C 78 I VALUE 20. - 000002C 78 J VALUE 5000. - 000003C 78 M VALUE 5. - 000008 01 SETUP-REC. - 000009 05 FL1 PIC X(04). - 000010 05 FL2 PIC ZZZZZ. - 000011 05 FL3 PIC 9(04). - 000012 05 FL4 PIC 9(08) COMP. - 000013 05 FL5 PIC 9(04) COMP-4. - 000014 05 FL6 PIC Z,ZZZ.99. - 000015 05 FL7 PIC S9(05) SIGN LEADING SEPARATE. - 000016 05 FL8 PIC X(04). - 000017 05 FL9 REDEFINES FL8 PIC 9(04). - 000018 05 FLA. - 000019 10 FLB OCCURS I TIMES. - 000020 15 FLC PIC X(02). - 000021 10 FLD PIC X(20). - 000022 05 FLD1 PIC X(100). - 000023 05 FLD2 OCCURS M TO J TIMES DEPENDING ON FL5. - 000024 10 FILLER PIC X(01). - 000025 05 FLD3 PIC X(3). - 000026 05 FLD4 PIC X(4). - 000027 PROCEDURE DIVISION. - 000028 STOP RUN. - - The first part of the listing lists the program text. If the program -text is a COPY the line number reflects the COPY line number and is -appended with a ''C''. - - When the wide list option '-T' is specified, the 'SEQUENCE' columns -(for fixed-form reference-format) are included in the listing. - - The second part of the listing file is the listing of the Symbol -Table: - - GnuCOBOL 3.0.0 test.cbl Mon May 14 10:23:45 2018 Page 0002 - - SIZE TYPE LVL NAME PICTURE - - 5204 GROUP 01 SETUP-REC - 0004 ALPHANUMERIC 05 FL1 X(04) - 0005 ALPHANUMERIC 05 FL2 ZZZZZ - 0004 ALPHANUMERIC 05 FL3 9(04) - 0004 NUMERIC 05 FL4 9(08) COMP - 0002 NUMERIC 05 FL5 9(04) COMP - 0008 ALPHANUMERIC 05 FL6 Z,ZZZ.99 - 0006 ALPHANUMERIC 05 FL7 S9(05) - 0004 ALPHANUMERIC 05 FL8 X(04) - 0004 ALPHANUMERIC-R 05 FL9 9(04) - 0060 ALPHANUMERIC 05 FLA - 0040 ALPHANUMERIC 10 FLB OCCURS 20 - 0002 ALPHANUMERIC 15 FLC X(02) - 0020 ALPHANUMERIC 10 FLD X(20) - 0100 ALPHANUMERIC 05 FLD1 X(100) - 5000 ALPHANUMERIC 05 FLD2 OCCURS 5 TO 5000 - 0001 ALPHANUMERIC 10 FILLER X(01) - 0003 ALPHANUMERIC 05 FLD3 X(3) - 0004 ALPHANUMERIC 05 FLD4 X(4) - - If the symbol redefines another variable the 'TYPE' is marked with -''R''. If the symbol is an array the 'OCCURS' phrase is in the -'PICTURE' field. - - The last part of the listing file is the summary of warnings an error -in the compilation group: - - 0 warnings in compilation group - 2 errors in compilation group - - -File: gnucobol.info, Node: Debug switches, Next: Miscellaneous, Prev: Listing options, Up: Compiler options - -2.1.7 Debug switches --------------------- - -'-debug, -d' - Enable all run-time error checks. - -'-g' - Produce C debugging information in the output. - -'-ftrace' - Generate trace code (log executed procedures, if tracing is - enabled). - -'-ftraceall' - Generate trace code (log executed procedures and statements, if - tracing is enabled). - -'-fsource-location' - Generate source location code (implied by '-debug' or '-g'). - -'-fstack-check' - Enable 'PERFORM' stack checking (implied by '-debug' or '-g'). - -'-fdebugging-line' - Enable debugging lines ('D' in indicator column; >>D directive). - -'-O' - Enable optimization of code size and execution speed. See your C - compiler documentation, for example 'man gcc' for details. - -'-O2' - Optimize even more. - -'-Os' - Optimize for size. Optimizer will favour code size over execution - speed. - -'-fnotrunc' - Do not truncate binary fields according to PICTURE. - - -File: gnucobol.info, Node: Miscellaneous, Prev: Debug switches, Up: Compiler options - -2.1.8 Miscellaneous -------------------- - -'-ext ' - Add default file extension. - -'-fsyntax-only' - Check syntax only; don't emit any output. - -'-fmfcomment' - Treat lines with '*' or '/' in column 1 as comment (fixed-form - reference-format only). - -'-acucomment' - Treat '|' as an inline comment marker. - -'-fsign=ASCII' - Numeric display sign ASCII (default on ASCII machines). - -'-fsign=EBCDIC' - Numeric display sign EBCDIC (default on EBCDIC machines). - -'-fintrinsics=[ALL|intrinsic function name(,name,...)]' - Allow use of all or specific intrinsic functions without 'FUNCTION' - keyword. - - Note: defining this within your source with 'CONFIGURATION SECTION. - REPOSITORY.' is preferred. - -'-ffold-copy=LOWER' - Fold 'COPY' subject to lower case (default no transformation). - -'-ffold-copy=UPPER' - Fold 'COPY' subject to upper case (default no transformation). - -'-save-temps(=)' - Save intermediate files (by default, in current directory). - -'-fimplicit-init' - Do automatic initialization of the COBOL runtime system. - - -File: gnucobol.info, Node: Multiple sources, Next: C interface, Prev: Compiler options, Up: Compile - -2.2 Multiple sources -==================== - -This section describes how to compile a program from multiple source -files. - - This section also describes how to build a shared library that can be -used by any COBOL program and how to use external libraries in COBOL -programs. - -* Menu: - -* Static linking:: Compiling into a single executable -* Dynamic linking:: A main program and separate modules -* Building library:: Building a shared library -* Using library:: Using external libraries - - -File: gnucobol.info, Node: Static linking, Next: Dynamic linking, Up: Multiple sources - -2.2.1 Static linking --------------------- - -The easiest way of combining multiple files is to compile them into a -single executable. - - One way is to compile all the files in one command: - - $ cobc -x -o prog main.cob subr1.cob subr2.cob - - Another way is to compile each file with the option '-c', and link -them at the end. The top-level program must be compiled with the option -'-x'. - - $ cobc -c subr1.cob - $ cobc -c subr2.cob - $ cobc -c -x main.cob - $ cobc -x -o prog main.o subr1.o subr2.o - - You can link C routines as well using either method: - - $ cobc -o prog main.cob subrs.c - - or - $ cobc -c subrs.c - $ cobc -c -x main.cob - $ cobc -x -o prog main.o subrs.o - - Any number of functions can be contained in a single C file. - - The linked programs will be called dynamically; that is, the symbol -will be resolved at run time. For example, the following COBOL -statement - - CALL "subr" USING X. - - will be converted into equivalent C code like this: - - int (*func)() = cob_resolve("subr"); - if (func != NULL) - func (X); - - With the compiler option '-fstatic-call', more efficient code will be -generated: - - subr(X); - - Please notice that this option only takes effect when the called -program name is in a literal (like 'CALL "subr"'). With a data name -(like 'CALL SUBR'), the program is still called dynamically. - - -File: gnucobol.info, Node: Dynamic linking, Next: Building library, Prev: Static linking, Up: Multiple sources - -2.2.2 Dynamic linking ---------------------- - -There are two methods to achieve this: a driver program, or compiling -the main program and subprograms separately. - -2.2.2.1 Driver program -...................... - -Compile all programs with the option '-m': - $ cobc -m main.cob subr.cob - This creates the shared object files 'main.so' and 'subr.so'. (1) - - Before running the main program, install the module files in your -library directory: - $ cp subr.so /your/cobol/lib - Set the runtime variable 'COB_LIBRARY_PATH' to your library -directory, and run the main program: - $ export COB_LIBRARY_PATH=/your/cobol/lib - (_Please notice:_ You may set the variable via a runtime -configuration file, *note Runtime Configuration: Appendix H. You may -also set the variable to directly point to the directory where you -compiled the sources.) - - Now execute your program: - $ cobcrun main - -2.2.2.2 Compiling programs separately -..................................... - -The main program is compiled as usual: - $ cobc -x -o main main.cob - - Subprograms are compiled with the option '-m': - $ cobc -m subr.cob - This creates a module file 'subr.so'(2). - - Before running the main program, install the module files in your -library directory: - $ cp subr.so /your/cobol/lib - - Now, set the environment variable 'COB_LIBRARY_PATH' to your library -directory, and run the main program: - $ export COB_LIBRARY_PATH=/your/cobol/lib - $ ./main - - ---------- Footnotes ---------- - - (1) The extension used depends on your operating system. - - (2) The extension used depends on your operating system. - - -File: gnucobol.info, Node: Building library, Next: Using library, Prev: Dynamic linking, Up: Multiple sources - -2.2.3 Building library ----------------------- - -You can build a shared library by combining multiple COBOL programs and -even C routines: - - $ cobc -c subr1.cob - $ cobc -c subr2.cob - $ cc -c subr3.c - $ cc -shared -o libsubrs.so subr1.o subr2.o subr3.o - - -File: gnucobol.info, Node: Using library, Prev: Building library, Up: Multiple sources - -2.2.4 Using library -------------------- - -You can use a shared library by linking it with your main program. - - Before linking the library, install it in your system library -directory: - $ cp libsubrs.so /usr/lib - or install it somewhere else and set 'LD_LIBRARY_PATH': - $ cp libsubrs.so /your/cobol/lib - $ export LD_LIBRARY_PATH=/your/cobol/lib - - Then, compile the main program, linking the library as follows: - $ cobc -x main.cob -L/your/cobol/lib -lsubrs - - -File: gnucobol.info, Node: C interface, Prev: Multiple sources, Up: Compile - -2.3 C interface -=============== - -This chapter describes how to combine C programs with COBOL programs. - -* Menu: - -* Main C program:: Writing main program in C -* Static C to COBOL:: -* Dynamic C to COBOL:: -* Static COBOL to C:: -* Dynamic COBOL to C:: -* Interface functions for C:: - - -File: gnucobol.info, Node: Main C program, Next: Static C to COBOL, Up: C interface - -2.3.1 Writing Main Program in C -------------------------------- - -Include 'libcob.h' in your C program and call 'cob_init' before using -any COBOL module. Do a cleanup afterwards, either by calling -'cob_stop_run' (if your program should terminate) or by calling -'cob_tidy' (if your program should execute further on without any more -COBOL calls, calling both functions in this sequence can be done -multiple times). - - #include - - int - main (int argc, char **argv) - { - /* initialize your program */ - ... - - /* initialize the COBOL run-time library */ - cob_init (argc, argv); - - /* rest of your program */ - ... - - /* Clean up and terminate - This does not return */ - cob_stop_run (return_status); - } - - You can write 'cobc_init(0, NULL);' if you do not want to pass -command line arguments to COBOL. - - You can compile your C program as follows: - - cc -c `cob-config --cflags` main.c - - The compiled object must be linked with libcob as follows: - - cc -o main main.o `cob-config --libs` - - -File: gnucobol.info, Node: Static C to COBOL, Next: Dynamic C to COBOL, Prev: Main C program, Up: C interface - -2.3.2 Static linking with COBOL programs ----------------------------------------- - -Let's call the following COBOL module from a C program: - - ---- say.cob --------------------------- - IDENTIFICATION DIVISION. - PROGRAM-ID. say. - ENVIRONMENT DIVISION. - DATA DIVISION. - LINKAGE SECTION. - 01 hello PIC X(7). - 01 world PIC X(6). - PROCEDURE DIVISION USING hello world. - DISPLAY hello world. - EXIT PROGRAM. - ---------------------------------------- - - This program accepts two arguments, displays them, and exits. - - From the viewpoint of C, this is equivalent to a function having the -following prototype: - - extern int say(char *hello, char *world); - - So, your main program will look like as follows: - - ---- hello.c --------------------------- - #include - - extern int say(char *hello, char *world); - - int - main() - { - int ret; - char hello[8] = "Hello, "; - char world[7] = "world!"; - - /* initialize the COBOL run-time library */ - cob_init(0, NULL); - - /* call the static module and store its return code */ - ret = say(hello, world); - - /* shutdown the COBOL run-time library, keep program running */ - (void)cob_tidy(); - - return ret; - } - ---------------------------------------- - - Compile these programs as follows: - - $ cc -c `cob-config --cflags` hello.c - $ cobc -c -static say.cob - $ cobc -x -o hello hello.o say.o - $ ./hello - Hello, world! - - -File: gnucobol.info, Node: Dynamic C to COBOL, Next: Static COBOL to C, Prev: Static C to COBOL, Up: C interface - -2.3.3 Dynamic linking with COBOL programs ------------------------------------------ - -You can find a COBOL module having a specific name by using the C -function 'cob_resolve', which takes the module name as a string and -returns a pointer to the module function. - - 'cob_resolve' returns 'NULL' if there is no module. In this case, -the function 'cob_resolve_error' returns the error message. - - Let's see an example: - - ---- hello-dynamic.c ------------------- - #include - - static int (*say)(char *hello, char *world); - - int main() - { - int ret; - char hello[8] = "Hello, "; - char world[7] = "world!"; - - /* initialize the COBOL run-time library */ - cob_init(0, NULL); - - /* Find the module with PROGRAM-ID "say". */ - say = cob_resolve("say"); - - /* If there is no such module, show error and exit. */ - if(say == NULL) { - fprintf(stderr, "%s\n", cob_resolve_error()); - exit(1); - } - - /* Call the module found ... */ - ret = say(hello, world); - - /* ...and exit with the return code. */ - cob_stop_run(ret); - } - ---------------------------------------- - - Compile these programs as follows: - - $ cc -c `cob-config --cflags` hello-dynamic.c - $ cobc -x -o hello hello-dynamic.o - $ cobc -m say.cob - $ export COB_LIBRARY_PATH=. - $ ./hello - Hello, world! - - -File: gnucobol.info, Node: Static COBOL to C, Next: Dynamic COBOL to C, Prev: Dynamic C to COBOL, Up: C interface - -2.3.4 Static linking with C programs ------------------------------------- - -Let's call the following C function from COBOL: - - ---- say.c ----------------------------- - int say(char *hello, char *world) - { - int i; - for(i = 0; i < 7; i++) - putchar(hello[i]); - for(i = 0; i < 6; i++) - putchar(world[i]); - putchar('\n'); - return 0; - } - ---------------------------------------- - - This program is equivalent to the program in 'say.cob' above. - - Note that, unlike C, the arguments passed from COBOL programs are not -terminated by the null character (i.e., ''\0''). - - You can call this function in the same way you call COBOL programs: - - ---- hello.cob ------------------------- - IDENTIFICATION DIVISION. - PROGRAM-ID. hello. - ENVIRONMENT DIVISION. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 hello PIC X(7) VALUE "Hello, ". - 01 world PIC X(6) VALUE "world!". - PROCEDURE DIVISION. - CALL "say" USING hello world. - STOP RUN. - ---------------------------------------- - - Compile these programs as follows: - - $ cc -c say.c - $ cobc -c -static -x hello.cob - $ cobc -x -o hello hello.o say.o - $ ./hello - Hello, world! - - -File: gnucobol.info, Node: Dynamic COBOL to C, Next: Interface functions for C, Prev: Static COBOL to C, Up: C interface - -2.3.5 Dynamic linking with C programs -------------------------------------- - -You can create a dynamically-linked module from a C program by passing -an option '-shared' to the C compiler: - - $ cc -shared -o say.so say.c - $ cobc -x hello.cob - $ export COB_LIBRARY_PATH=. - $ ./hello - Hello, world! - - -File: gnucobol.info, Node: Interface functions for C, Prev: Dynamic COBOL to C, Up: C interface - -2.3.6 Redirecting output to a (FILE *) --------------------------------------- - -From a module written in C you can call 'cob_set_runtime_option' to set -the exact '(FILE *)' which is used to write trace data to. In -'common.h' is the following: - enum cob_runtime_option_switch { - COB_SET_RUNTIME_TRACE_FILE /* 'p' is FILE * */ - COB_SET_RUNTIME_DISPLAY_PRINTER_FILE /* 'p' is FILE * */ - COB_SET_RUNTIME_RESCAN_ENV /* rescan environment variables */ - COB_SET_RUNTIME_DISPLAY_PUNCH_FILE /* 'p' is FILE * */ - }; - COB_EXPIMP void cob_set_runtime_option (enum cob_runtime_option_switch opt, void *p); - So from you C code you can tell the GnuCOBOL runtime to redirect -TRACE output by: - cob_set_runtime_option (COB_SET_RUNTIME_TRACE_FILE, (void*)((FILE*)myfd)); - You could also redirect all DISPLAY UPON PRINTER output to a file by: - cob_set_runtime_option (COB_SET_RUNTIME_DISPLAY_PRINTER_FILE, (void*)((FILE*)myfd)); - You could also redirect all DISPLAY UPON SYSPUNCH output to a file -by: - cob_set_runtime_option (COB_SET_RUNTIME_DISPLAY_PUNCH_FILE, (void*)((FILE*)myfd)); - - Another routine can be used to return the current value of the -option. - COB_EXPIMP void *cob_get_runtime_option (enum cob_runtime_option_switch opt); - - -File: gnucobol.info, Node: Customize, Next: Optimize, Prev: Compile, Up: Top - -3 Customize -*********** - -* Menu: - -* Customizing compiler:: Customizing compiler -* Customizing library:: Customizing library - - -File: gnucobol.info, Node: Customizing compiler, Next: Customizing library, Up: Customize - -3.1 Customizing compiler -======================== - -These settings are effective at compile-time. - - Environment variables (default value in brackets): - -'COB_CC' - C compiler ("gcc") -'COB_CFLAGS' - Flags passed to the C compiler ("-I$(PREFIX)/include") -'COB_LDFLAGS' - Flags passed to the C compiler ("") -'COB_LIBS' - Standard libraries linked with the program ("-L$(PREFIX)/lib - -lcob") -'COB_LDADD' - Additional libraries linked with the program ("") - - -File: gnucobol.info, Node: Customizing library, Prev: Customizing compiler, Up: Customize - -3.2 Customizing library -======================= - -These settings are effective at run-time. You can set them either via -the environment or by a runtime configuration file. - - To set the global runtime configuration file export -'COB_RUNTIME_CONFIG' to point to your configuration file. To set an -explicit runtime configuration file for a single run via 'cobcrun' you -can use its option '-c FILE', '--config=FILE'. - - For displaying the current runtime settings you can use the option -'-r', '--runtime-env' of 'cobcrun'. - - For a complete list of runtime variables, aliases, their default -values and options to set them *note Runtime Configuration: Appendix H. - - -File: gnucobol.info, Node: Optimize, Next: Debug, Prev: Customize, Up: Top - -4 Optimize -********** - -* Menu: - -* Optimize options:: How to enable optimization -* Optimize call:: Call subroutines efficiently -* Optimize binary:: Use efficient binary representation - - -File: gnucobol.info, Node: Optimize options, Next: Optimize call, Up: Optimize - -4.1 Optimize options -==================== - -There are five compiler options for optimization: '-O0', '-O', '-Os', -'-O2', '-O3'. These options enable optimization at both translation -(from COBOL to C) and compilation (C to assembly) levels. - - Currently, there is no difference between these optimization options -at the translation level. - - The option '-O', '-Os' or '-O2' is passed to the C compiler as is and -used for C level optimization. - - -File: gnucobol.info, Node: Optimize call, Next: Optimize binary, Prev: Optimize options, Up: Optimize - -4.2 Optimize call -================= - -When a 'CALL' statement is executed, the called program is linked at run -time. By specifying the compiler option '-fstatic-call', you can -statically link the program at compile time and call it efficiently. -(*note Static linking::) - - -File: gnucobol.info, Node: Optimize binary, Prev: Optimize call, Up: Optimize - -4.3 Optimize binary -=================== - -By default, data items of usage binary or comp are stored in big-endian -form. On those machines whose native byte order is little-endian, this -is not quite efficient. - - If you prefer, you can store binary items in the native form of your -machine. Set the config option 'binary-byteorder' to 'native' in your -config file (*note Customize::). - - In addition, setting the option 'binary-size' to '2-4-8' or '1-2-4-8' -is more efficient than others. - - -File: gnucobol.info, Node: Debug, Next: Extensions, Prev: Optimize, Up: Top - -5 Debug -******* - -* Menu: - -* Debug options:: Debug options - - -File: gnucobol.info, Node: Debug options, Up: Debug - -5.1 Debug options -================= - -The compiler option '-debug' can be used during the development of your -programs. It enables all run-time error checking, such as subscript -boundary checks and numeric data checks, and displays run-time errors -with source locations. - - -File: gnucobol.info, Node: Extensions, Next: System Routines, Prev: Debug, Up: Top - -6 Non-standard extensions -************************* - -* Menu: - -* SELECT:: 'SELECT ASSIGN TO'. -* Indexed:: Indexed file packages. -* Extended ACCEPT:: Extended 'ACCEPT' statement. -* ACCEPT special:: 'ACCEPT' special keys. -* Extended DISPLAY:: Extended 'DISPLAY' statement. -* FUNCTION CONTENT-LENGTH:: Length of NUL byte terminated pointer data. -* FUNCTION CONTENT-OF:: Content of data at pointer, by length or NUL. - - -File: gnucobol.info, Node: SELECT, Next: Indexed, Up: Extensions - -6.1 SELECT ASSIGN TO -==================== - -A file may be assigned to a literal file, a file in a variable, or a -file in an environment variable. - -6.1.1 Literal file. -------------------- - -Assign to a literal file. - - Select FILE assign to "/tmp/myfile.txt". - -6.1.2 ----------------- - -Assign to a file which name is read from a variable. - - Select FILE assign to my-file. - - 01 my-file pic x(512). - - Move "/tmp/myfile.txt" to my-file. - Open output . - -6.1.3 ----------------------------- - -Assign to a file in an environment variable. - - export myfile=/tmp/myfile.txt - - Select FILE assign to external myfile. - - -File: gnucobol.info, Node: Indexed, Next: Extended ACCEPT, Prev: SELECT, Up: Extensions - -6.2 Indexed file packages -========================= - - - - -File: gnucobol.info, Node: Extended ACCEPT, Next: ACCEPT special, Prev: Indexed, Up: Extensions - -6.3 Extended ACCEPT statement -============================= - -Extended 'ACCEPT' statements allow for full control of items accepted -from the screen. Items accept by line and column positioning. - - All commands following 'WITH' are optional. - - - ACCEPT VARIABLE-1 - LINE VARIABLE-2 | LITERAL-1 COLUMN VARIABLE-3 | LITERAL-2 - WITH - AUTO-SKIP | AUTO - BACKGROUND-COLOR VARIABLE-4 | LITERAL-3 - BELL | BEEP - BLINK - FOREGROUND-COLOR VARIABLE-5 | LITERAL-4 - LOWLIGHT | HIGHLIGHT - PROMPT - PROTECTED - SIZE [IS] VARIABLE-6 | LITERAL-5 - UPDATE - ON EXCEPTION - EXCEPTION PROCESSING - NOT ON EXCEPTION - NORMAL PROCESSING - END-ACCEPT. - - -6.3.1 LINE ----------- - -The line number of VARIABLE-2 or LITERAL-1 to accept the field. - -6.3.2 COLUMN ------------- - -The column number of VARIABLE-3 or LITERAL-2 to accept the field. - -6.3.3 AUTO-SKIP ---------------- - -The word 'AUTO' may be used for 'AUTO-SKIP'. - - With this option the 'ACCEPT' statement returns after the last -character is typed at the end of the field. This is the same as if the -Enter key were pressed. - - Without this option the cursor remains at the end of the field and -waits for the user to press Enter. - - The Right-Arrow key returns from the end of the field. The -Left-Arrow key returns from the beginning. *Note Arrow keys: ACCEPT -special. - - The Alt-Right-Arrow and Alt-Left-Arrow keys never 'AUTO-SKIP'. - -6.3.4 BACKGROUND-COLOR ----------------------- - -The background color is the color used behind the characters. - - VARIABLE-4 or LITERAL-3 must be numeric. See file 'screenio.cpy' for -the color assignments to VARIABLE-4 or LITERAL-3. - -6.3.5 BELL ----------- - -The word 'BEEP' may be used for 'BELL'. - - The system beeps when the cursor moves to accept from this field. On -some systems, there is no sound. Some other method may indicate a beep, -such a flashing screen or pop up window. - -6.3.6 BLINK ------------ - -The field blinks while the user enters the data. This can help small -menu selection fields to stand out. - -6.3.7 FOREGROUND-COLOR ----------------------- - -The foreground color is the color used for the characters. - - VARIABLE-5 or LITERAL-4 must be numeric. See file 'screenio.cpy' for -the color assignments to VARIABLE-5 or LITERAL-4. - -6.3.8 LOWLIGHT --------------- - -The 'LOWLIGHT' and 'HIGHLIGHT' phrases vary the intensity of the field. - - 'LOWLIGHT' displays with lower intensity and 'HIGHLIGHT' displays -with higher intensity. Having neither 'LOWLIGHT' nor 'HIGHLIGHT' -displays at normal intensity. - - These may have different levels of intensity, if at all, depending on -the make and model of the screens. - -6.3.9 PROMPT ------------- - -Display the field with prompt characters as the cursor moves to accept -from this field. - -6.3.10 PROTECTED ----------------- - -'PROTECTED' is ignored. - -6.3.11 SIZE ------------ - -The size of VARIABLE-1 to accept from the screen. - - VARIABLE-6 or LITERAL-5 must be numeric. - -'SIZE ' - - If VARIABLE-6 or LITERAL-5 is less than the length of VARIABLE-1 - then only the 'SIZE' number of characters accept into the field. - VARIABLE-1 pads with spaces after 'SIZE' to the end of the field. - - If VARIABLE-6 or LITERAL-5 is greater than VARIABLE-1, then the - screen pads with spaces after VARIABLE-1 to the 'SIZE' length. - -'SIZE ZERO' -'' - - The VARIABLE-1 accepts to its field length. - -6.3.12 UPDATE -------------- - -The contents of variable-1 displays on the screen as the 'ACCEPT' -begins. This allows the user to update the field without having to type -it all again. - - Without this option, the 'ACCEPT' field is always blank. - -6.3.13 ON EXCEPTION -------------------- - -Check the special register cob-crt-status for the special key that was -pressed. This includes Escape, Tab, Back-Tab, F-keys, arrows, etc... -See screenio.cpy for the values. - -6.3.14 NOT ON EXCEPTION ------------------------ - -Reset any F-key indicator because no special key was pressed. - - -File: gnucobol.info, Node: ACCEPT special, Next: Extended DISPLAY, Prev: Extended ACCEPT, Up: Extensions - -6.4 ACCEPT special keys -======================= - -Special keys are available for extended 'ACCEPT' statements. - - The 'COB-CRT-STATUS' values are in the screenio.cpy copy file. - -6.4.1 Arrow keys ----------------- - -The Left-Arrow key moves the cursor to the left. Without 'AUTO-SKIP' -the cursor stops at the beginning of the field. With 'AUTO-SKIP' it -returns with the 'COB-SCR-KEY-LEFT' value of 2009. *Note AUTO-SKIP: -Extended ACCEPT. - - The Alt-Left-Arrow key is the same as Left-Arrow except that it never -returns, even for 'AUTO-SKIP'. - - The Right-Arrow key moves the cursor to the right. Without -'AUTO-SKIP' the cursor stops at the end of the field. With 'AUTO-SKIP' -it returns with the 'COB-SCR-KEY-RIGHT' value of 2010. *Note AUTO-SKIP: -Extended ACCEPT. - - The Alt-Right-Arrow key is the same as Right-Arrow except that it -never returns, even for 'AUTO-SKIP'. - -6.4.2 Backspace key -------------------- - -The Backspace key moves the cursor, and the remainder of the text, to -the left. - -6.4.3 Delete keys ------------------ - -The Delete key deletes the cursor's character and moves the remainder of -the text to the left. The cursor does not move. - - The Alt-Delete key deletes all text from the cursor to the end of the -field. - -6.4.4 End key -------------- - -The End key moves the cursor after the last non-space character. -Pressing the End key again moves the cursor to the end of the field. -Repeated pressing moves the cursor back and forth. - -6.4.5 Home key --------------- - -The Home key moves the cursor to the first non-space character. -Pressing the Home key again moves the cursor to the beginning of the -field. Repeated pressing moves the cursor back and forth. - -6.4.6 Insert key ----------------- - -The Insert key changes the insert mode. - - The value of the insert mode is used in all following 'ACCEPT' -statements while the program is running. - - When the insert mode is on, typed characters move the existing -characters to the right until field is full. When it is off, typed -characters type over existing characters. - - Note: The insert mode is ignored for fields with a size of 1. - - The insert mode can also be changed by the 'COB_INSERT_MODE' setting -at any time, *note Runtime Configuration: Appendix H. - -6.4.7 Tab keys --------------- - -The Tab key returns from the 'ACCEPT' with the 'COB-SCR-TAB' value of -2007. - - The Shift-Tab key returns with the 'COB-SCR-BACK-TAB' value of 2008. - - -File: gnucobol.info, Node: Extended DISPLAY, Next: FUNCTION CONTENT-LENGTH, Prev: ACCEPT special, Up: Extensions - -6.5 Extended DISPLAY statement -============================== - -Extended 'DISPLAY' statements allow for full control of items that -display on the screen. Items display by line and column positioning. - - - DISPLAY VARIABLE-1 | LITERAL-1 | FIGURATIVE CONSTANT - LINE LINE COLUMN COLUMN - WITH BELL - BLANK LINE | SCREEN - ERASE EOL | EOS - SIZE [IS] VARIABLE-2 | LITERAL-2 - END-DISPLAY. - - -6.5.1 BELL ----------- - -Ring the bell. It is optional. - -6.5.2 BLANK ------------ - -Clear the whole line or screen. It is optional. - -'BLANK LINE' - - Clear the line from the beginning of the line to the end of the - line. - -'BLANK SCREEN' - - Clear the whole screen. - -6.5.3 ERASE ------------ - -Clear the line or screen from LINE and COLUMN. It is optional. - -'ERASE EOL' - - Clear the line from LINE and COLUMN to the end of the line. - -'ERASE EOS' - - Clear the screen from LINE and COLUMN to the end of the screen. - -6.5.4 SIZE ----------- - -The size of VARIABLE-1, LITERAL-1, or FIGURATIVE-CONSTANT to display -onto the screen. It is optional. - -'SIZE POSITIVE-INTEGER' - - If 'SIZE' is less than the length of VARIABLE-1 or LITERAL-1 then - only the 'SIZE' number of characters display. - - If 'SIZE' is greater than the length of VARIABLE-1 or LITERAL-1, - then the screen pads with spaces after the field to the 'SIZE' - length. - - Figurative constants display repeatedly the number of times in - 'SIZE'. Except that 'LOW-VALUES' always positions the cursor (see - 'SIZE' ZERO below). - -'SIZE ZERO' -'' - - VARIABLE-1 or LITERAL-1 displays with the field length. - -6.5.5 Figurative Constants --------------------------- - -Certain figurative constants and values have special functions. All -other figurative constants display as a single character. - -'SPACE' - Display spaces from LINE and COLUMN to the end of the screen. This - is the same as WITH ERASE EOS. - -'LOW-VALUE' - Position the cursor to LINE and COLUMN. The next 'DISPLAY' - statement does not need a LINE or COLUMN to display at that - position. - -'ALL X"01"' - Display spaces from LINE and COLUMN to the end of the line. This - is the same as 'WITH ERASE EOL'. - -'ALL X"02"' - Clear the whole screen. This is the same as 'WITH BLANK SCREEN'. - -'ALL X"07"' - Ring the bell. This is the same as 'WITH BELL'. - - -File: gnucobol.info, Node: FUNCTION CONTENT-LENGTH, Next: FUNCTION CONTENT-OF, Prev: Extended DISPLAY, Up: Extensions - -6.6 CONTENT-LENGTH -================== - -'FUNCTION CONTENT-LENGTH' returns the length of NUL byte terminated data -given a pointer: - - identification division. - program-id. zlen. - data division. - working-storage section. - 01 ptr usage pointer. - 01 str pic x(4) value z"abc". - - *> Testing CONTENT-LENGTH - procedure division. - - set ptr to address of str - display content-length(ptr) - - goback. - end program hosted. - - -File: gnucobol.info, Node: FUNCTION CONTENT-OF, Prev: FUNCTION CONTENT-LENGTH, Up: Extensions - -6.7 CONTENT-OF -============== - -'FUNCTION CONTENT-OF' returns an alphanumeric field given a pointer and -optional length: - - Data from pointer is returned as a COBOL field either by scanning for -a NUL byte or using the optional length. Reference modification of -result allowed. - - identification division. - program-id. contents. - data division. - working-storage section. - 01 ptr usage pointer. - 01 str pic x(4) value z"abc". - - *> Testing CONTENT-OF - procedure division. - - set ptr to address of str - display content-of(ptr) - display content-of(ptr, 2) - display content-of(ptr)(2:2) - - goback. - end program hosted. - - -File: gnucobol.info, Node: System Routines, Next: Appendices, Prev: Extensions, Up: Top - -7 System Routines -***************** - -For a complete list of supported system routines, *note System routines: -Appendix D. - -* Menu: - -* CBL_GC_GETOPT:: GETOPT for Cobol -* CBL_GC_HOSTED:: Access to C hosted variables -* CBL_GC_NANOSLEEP:: Sleep for nanoseconds -* CBL_GC_FORK:: Fork the current COBOL process to a new one -* CBL_GC_WAITPID:: Wait for a system process to end - - -File: gnucobol.info, Node: CBL_GC_GETOPT, Next: CBL_GC_HOSTED, Up: System Routines - -7.1 CBL_GC_GETOPT -================= - -'CBL_GC_GETOPT' provides the quite well-known option parser, getopt, for -GnuCOBOL. The usage of this system routine is described by the following -example. - - identification division. - program-id. prog. - - data division. - working-storage section. - 78 shortoptions value "jkl". - - 01 longoptions. - 05 optionrecord occurs 2 times. - 10 optionname pic x(25). - 10 has-value pic 9. - 10 valpoint pointer value NULL. - 10 return-value pic x(4). - - 01 longind pic 99. - 01 long-only pic 9 value 1. - - 01 return-char pic x(4). - 01 opt-val pic x(10). - - 01 counter pic 9 value 0. - - We first need to define the necessary fields for getopt's -shortoptions (so), longoptions (lo), longoption index (longind), -long-only-option (long-only) and also the fields for return values -return-char and opt-val (arbitrary size with trimming, see return -codes). - - The shortoptions are written down as an alphanumeric field (i.e., a -string with arbitrary size) as follows: - - "ab:c::d" - - This means we want getopt to look for shortoptions named a, b, c or d -and we demand an option value for b and we are accepting an optional one -for c. - - The longoptions are defined as a table of records with oname, -has-value, valpoint and val. - * oname defines the name of a longoption. - * has-value defines if an option value is demanded (has-val = 1), - optional (has-val = 2) or not required (has-val = 0). - * valpoint is a pointer used to specify an address to save getopt's - return value to. The pointer is optional. If it is 'NULL', getopt - returns a value as usual. If you use the pointer it has to point - to a 'PIC X(4)' field. - * The field val is a 'PIC X(4)' character which is returned if the - longoption was recognized. - The longoption structure is immutable! You can only vary the number -of records. - - Now we have the tools to run 'CBL_GC_GETOPT' within the procedure -division. - - procedure division. - move "version" to optionname (1). - move 0 to has-value (1). - move "v" to return-value (1). - - move "verbose" to optionname (2). - move 0 to has-value (2). - move "V" to return-value (2). - - perform with test after until return-code = -1 - call 'CBL_GC_GETOPT' using - by reference shortoptions longoptions longind - by value long-only - by reference return-char opt-val - end-call - - display return-char end-display - display opt-val end-display - end-perform - stop run. - - - The example shows how we initialize all parameters and call the -routine until 'CBL_GC_GETOPT' runs out of options and returns -1. - - The return-char might contain the following: - * regular character if an option was recognized - * '?' if we have an undefined or ambiguous option - * '1' if we have a non-option (only if first byte of so is '-') - * '0' if valpoint != NULL and we are writing the return value to - the specified address - * '-1' if we don't have any more options (or reach the first - non-option if first byte of so is '+') - - The return-codes of 'CBL_GC_GETOPT' are: - * 1 if we've got a non-option (only if first byte of so is '-') - * 0 if valpoint != 'NULL' and we are writing the return value to - the specified address - * -1 if we don't have any more options (or reach the first - non-option if first byte of so is '+') - * 2 if we have got an truncated option value in opt-val (because - opt-val was too small) - * 3 if we got a regular answer from getopt - - -File: gnucobol.info, Node: CBL_GC_HOSTED, Next: CBL_GC_NANOSLEEP, Prev: CBL_GC_GETOPT, Up: System Routines - -7.2 CBL_GC_HOSTED -================= - -'CBL_GC_HOSTED' provides access to the following C hosted variables: - * 'argc' to binary-long by value - * 'argv' to pointer to char ** - * 'stdin', 'stdout', 'stderr' to pointer - * 'errno' giving address of errno in pointer to binary-long, use - based for more direct access - - and conditional access to the following variables: - * 'tzname' pointer to pointer to array of two char pointers - * 'timezone' C long, will be seconds west of UTC - * 'daylight' C int, will be 1 during daylight savings - - System will need to HAVE_TIMEZONE defined for these to return -anything meaningful. Attempts made when they are not available return 1 -from CBL_GC_HOSTED. - - It returns 0 when match, 1 on failure, case matters as does length, -"arg" won't match. - - The usage of this system routine is described by the following -example. - - HOSTED identification division. - program-id. hosted. - data division. - working-storage section. - 01 argc usage binary-long. - 01 argv usage pointer. - - 01 stdin usage pointer. - 01 stdout usage pointer. - 01 stderr usage pointer. - - 01 errno usage pointer. - 01 err usage binary-long based. - - 01 domain usage float-long value 3.0. - - 01 tzname usage pointer. - 01 tznames usage pointer based. - 05 tzs usage pointer occurs 2 times. - - 01 timezone usage binary-long. - 01 daylight usage binary-short. - - - *> Testing CBL_GC_HOSTED - procedure division. - call "CBL_GC_HOSTED" using stdin "stdin" - display "stdin : " stdin - call "feof" using by value stdin - display "feof stdin : " return-code - - call "CBL_GC_HOSTED" using stdout "stdout" - display "stdout : " stdout - call "fprintf" using by value stdout by content "Hello" & x"0a" - - call "CBL_GC_HOSTED" using stderr "stderr" - display "stderr : " stderr - call "fprintf" using by value stderr by content "on err" & x"0a" - - call "CBL_GC_HOSTED" using argc "argc" - display "argc : " argc - - call "CBL_GC_HOSTED" using argv "argv" - display "argv : " argv - - call "args" using by value argc argv - - call "CBL_GC_HOSTED" using errno "errno" - display "&errno : " errno - set address of err to errno - display "errno : " err - call "acos" using by value domain - display "errno after acos(3.0): " err ", EDOM is 33" - - call "CBL_GC_HOSTED" using argc "arg" - display "'arg' lookup : " return-code - call "CBL_GC_HOSTED" using null "argc" - display "null with argc : " return-code - display "argc is still : " argc - - - *> the following only returns zero if the system has HAVE_TIMEZONE set - - call "CBL_GC_HOSTED" using daylight "daylight " - display "'timezone' lookup : " return-code - - if return-code not = 0 - display "system doesn't has timezone" - else - - display "timezone is : " timezone - - call "CBL_GC_HOSTED" using daylight "daylight " - display "'daylight' lookup : " return-code - display "daylight is : " daylight - - set environment "TZ" to "PST8PDT" - call static "tzset" returning omitted on exception continue end-call - - call "CBL_GC_HOSTED" using tzname "tzname" - display "'tzname' lookup : " return-code - - *> tzs(1) will point to z"PST" and tzs(2) to z"PDT" - if return-code equal 0 and tzname not equal null then - set address of tznames to tzname - if tzs(1) not equal null then - display "tzs #1 : " tzs(1) - end-if - if tzs(2) not equal null then - display "tzs #2 : " tzs(2) - end-if - end-if - - end-if - - goback. - end program hosted. - - -File: gnucobol.info, Node: CBL_GC_NANOSLEEP, Next: CBL_GC_FORK, Prev: CBL_GC_HOSTED, Up: System Routines - -7.3 CBL_GC_NANOSLEEP -==================== - -'CBL_GC_NANOSLEEP' allows you to pause the program for nanoseconds. The -actual precision depends on the system. - - *> Waiting a half second - call "CBL_GC_NANOSLEEP" using "500000000" end-call - - *> Waiting five seconds using compiler string catenation for readability - call "CBL_GC_NANOSLEEP" using "500" & "0000000" end-call - - -File: gnucobol.info, Node: CBL_GC_FORK, Next: CBL_GC_WAITPID, Prev: CBL_GC_NANOSLEEP, Up: System Routines - -7.4 CBL_GC_FORK -=============== - -'CBL_GC_FORK' allows you to fork the current COBOL process to a new one. -The current content of the process' storage (including 'LOCAL-STORAGE') -will be identical, any file handles get invalid in the new process, -positions and file / record locks are only available to the original -process. - - This system routine is not available on Windows (exception: GCC on -Cygwin). - - Parameters: none Returns: PID (the child process gets '0' returned, -the calling process gets the PID of the created children). Negative -values are returned for system dependent error codes and -1 if the -function is not available on the current system. - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 CHILD-PID PIC S9(9) BINARY. - 01 WAIT-STS PIC S9(9) BINARY. - PROCEDURE DIVISION. - - CALL "CBL_GC_FORK" RETURNING CHILD-PID END-CALL - EVALUATE TRUE - WHEN CHILD-PID = ZERO - PERFORM CHILD-CODE - WHEN CHILD-PID > ZERO - PERFORM PARENT-CODE - WHEN CHILD-PID = -1 - DISPLAY 'CBL_GC_FORK is not available ' - 'on the current system!' - END-DISPLAY - PERFORM CHILD-CODE - MOVE 0 TO CHILD-PID - PERFORM PARENT-CODE - WHEN OTHER - MULTIPLY CHILD-PID BY -1 END-MULTIPLY - DISPLAY 'CBL_GC_FORK returned system error: ' - CHILD-PID - END-DISPLAY - END-EVALUATE - - STOP RUN. - - CHILD-CODE. - CALL "C$SLEEP" USING 1 END-CALL - DISPLAY "Hello, I am the child" - END-DISPLAY - MOVE 2 TO RETURN-CODE - - CONTINUE. - - PARENT-CODE. - DISPLAY "Hello, I am the parent" - END-DISPLAY - CALL "CBL_GC_WAITPID" USING CHILD-PID RETURNING WAIT-STS - END-CALL - MOVE 0 TO RETURN-CODE - EVALUATE TRUE - WHEN WAIT-STS >= 0 - DISPLAY 'Child ended with status: ' - WAIT-STS - END-DISPLAY - WHEN WAIT-STS = -1 - DISPLAY 'CBL_GC_WAITPID is not available ' - 'on the current system!' - END-DISPLAY - WHEN WAIT-STS < -1 - MULTIPLY -1 BY WAIT-STS END-MULTIPLY - DISPLAY 'CBL_GC_WAITPID returned system error: ' WAIT-STS - END-DISPLAY - END-EVALUATE - - CONTINUE. - - -File: gnucobol.info, Node: CBL_GC_WAITPID, Prev: CBL_GC_FORK, Up: System Routines - -7.5 CBL_GC_WAITPID -================== - -'CBL_GC_WAITPID' allows you to wait until another system process ended. -Additional you can check the process' return code. - - Parameters: none Returns: function-status / child-status Negative -values are returned for system dependent error codes and -1 if the -function is not available on the current system. - - CALL "CBL_GC_WAITPID" USING CHILD-PID RETURNING WAIT-STS - END-CALL - MOVE 0 TO RETURN-CODE - DISPLAY 'CBL_GC_WAITPID ended with status: ' WAIT-STS - END-DISPLAY - - -File: gnucobol.info, Node: Appendices, Prev: System Routines, Up: Top - -* Menu: - -* Appendix A:: Compiler 'cobc' options -* Appendix B:: Reserved Words -* Appendix C:: Intrinsic Functions -* Appendix D:: System routines -* Appendix E:: System names -* Appendix F:: Compiler Configuration -* Appendix G:: Module loader 'cobcrun' options -* Appendix H:: Runtime configuration -* Appendix I:: GNU Free Documentation License - - -File: gnucobol.info, Node: Appendix A, Next: Appendix B, Prev: Appendices, Up: Appendices - -Appendix A Compiler 'cobc' options -********************************** - -The following list of options was extracted from 'cobc --help' and shows -all available compiler options with a short description. - -A.1 Options -=========== - -'-h, -help' - display this help and exit -'-V, -version' - display compiler version and exit -'-i, -info' - display compiler information (build/environment) and exit -'-v, -verbose' - display compiler version and the commands invoked by the compiler -'-vv, -verbose=2' - like '-v' but additional pass verbose option to assembler/compiler -'-vvv, -verbose=3' - like '-vv' but additional pass verbose option to linker -'-q, -brief' - reduced displays, commands invoked not shown -'-###' - like '-v' but commands not executed -'-x' - build an executable program -'-m' - build a dynamically loadable module (default) -'-j [ARGS], -job[=ARGS]' - run program after build, passing ARGS -'-std=DIALECT' - warnings/features for a specific dialect DIALECT can be one of: - default, cobol2014, cobol2002, cobol85, xopen, ibm-strict, ibm, - mvs-strict, mvs, mf-strict, mf, bs2000-strict, bs2000, acu-strict, - acu, rm-strict, rm; see configuration files in directory config -'-F, -free' - use free source format -'-fixed' - use fixed source format (default) -'-O, -O2, -O3, -Os' - enable optimization -'-O0' - disable optimization -'-g' - enable C compiler debug / stack check / trace -'-d, -debug' - enable all run-time error checking -'-o FILE' - place the output into FILE -'-b' - combine all input files into a single dynamically loadable module -'-E' - preprocess only; do not compile or link -'-C' - translation only; convert 'COBOL' to C -'-S' - compile only; output assembly file -'-c' - compile and assemble, but do not link -'-T FILE' - generate and place a wide program listing into FILE -'-t FILE' - generate and place a program listing into FILE -'--tlines=LINES' - specify lines per page in listing, default = 55 -'-P[=DIR OR FILE]' - generate preprocessed program listing (.lst) -'-Xref' - generate cross reference through 'cobxref' (V. Coen's 'cobxref' - must be in path) -'-I DIRECTORY' - add DIRECTORY to copy/include search path -'-L DIRECTORY' - add DIRECTORY to library search path -'-l LIB' - link the library LIB -'-A OPTIONS' - add OPTIONS to the C compile phase -'-Q OPTIONS' - add OPTIONS to the C link phase -'-D DEFINE' - define DEFINE for 'COBOL' compilation -'-K ENTRY' - generate 'CALL' to ENTRY as static -'-conf=FILE' - user-defined dialect configuration; see -std -'-list-reserved' - display reserved words -'-list-intrinsics' - display intrinsic functions -'-list-mnemonics' - display mnemonic names -'-list-system' - display system routines -'-save-temps[=DIR]' - save intermediate files ; default: current directory -'-ext EXTENSION' - add file extension for resolving 'COPY' - -A.2 Warning options -=================== - -'-W' - enable all warnings -'-Wall' - enable most warnings (all except as noted below) -'-Wno-WARNING' - disable warning enabled by default, '-W' or '-Wall' -'-Wextra' - additional warnings only raised with '-W' or '-Wall' -'-Wno-unfinished' - do not warn if unfinished features are used ; _always active_ -'-Wno-pending' - do not warn if pending features are mentioned ; _always active_ -'-Wobsolete' - warn if obsolete features are used -'-Warchaic' - warn if archaic features are used -'-Wredefinition' - warn about incompatible redefinition of data items -'-Wtruncate' - warn about field truncation from constant assignments -'-Wpossible-truncate' - warn about possible field truncation ; _not set with '-Wall'_ -'-Woverlap' - warn about overlapping 'MOVE' of items -'-Wpossible-overlap' - warn about 'MOVE' of items that may overlap depending on variables - ; _not set with '-Wall'_ -'-Wparentheses' - warn about lack of parentheses around 'AND' within 'OR' -'-Wstrict-typing' - warn strictly about type mismatch -'-Wimplicit-define' - warn about implicitly defined data items -'-Wcorresponding' - warn about 'CORRESPONDING' with no matching items -'-Winitial-value' - warn if initial 'VALUE' clause is ignored -'-Wprototypes' - warn about missing 'FUNCTION' prototypes/definitions -'-Warithmetic-osvs' - warn if arithmetic expression precision has changed -'-Wcall-params' - warn about non 01/77 items for 'CALL' parameters ; _not set with - '-Wall'_ -'-Wconstant-expression' - warn about expressions that always resolve to true/false -'-Wcolumn-overflow' - warn about text after program-text area, 'FIXED' format ; _not set - with '-Wall'_ -'-Wterminator' - warn about lack of scope terminator 'END-XXX' ; _not set with - '-Wall'_ -'-Wlinkage' - warn about dangling 'LINKAGE' items ; _not set with '-Wall'_ -'-Wunreachable' - warn about likely unreachable statements ; _not set with '-Wall'_ -'-Wno-dialect' - do not warn about dialect specific issues ; _always active_ -'-Wothers' - do not warn about different issues ; _always active_ -'-Wno-unsupported' - do not warn if runtime does not support a feature used ; _not set - with '-Wall'_ -'-Werror' - treat all warnings as errors -'-Werror=WARNING' - treat specified WARNING as error - -A.3 Compiler options -==================== - -'-fsign=[ASCII|EBCDIC]' - define display sign representation ; default: machine native -'-ffold-copy=[UPPER|LOWER]' - fold 'COPY' subject to value ; default: no transformation -'-ffold-call=[UPPER|LOWER]' - fold 'PROGRAM-ID', 'CALL', 'CANCEL' subject to value ; default: no - transformation -'-fdefaultbyte=VALUE' - initialize fields without 'VALUE' to value ; decimal 0..255 or any - quoted character ; default: initialize to picture -'-fmax-errors=NUMBER' - maximum number of errors to report before compilation is aborted ; - default: 128 -'-fintrinsics=[ALL|intrinsic function name(,name,...)]' - - intrinsics to be used without 'FUNCTION' keyword -'-fdump=SCOPE' - dump data fields on abort, SCOPE may be a combination of: 'ALL', - 'WS', 'LS', 'RD', 'FD', 'SC' -'-fcallfh=FUNCTION' - use external provided 'EXTFH' interface module FUNCTION for I/O -'-fsqldb=DBTYPE' - which Database is used, DBTYPE may be MySQL, 'MSSQL', Oracle10, - Oracle11, Oracle12 -'-fsqlschema=NAME' - define database schema name -'-fno-recursive-check' - disable check of recursive program call; effectively compiling as - 'RECURSIVE' program -'-fno-remove-unreachable' - disable remove of unreachable code ; turned off by -g -'-finline-intrinsic' - when possible resolve intrinsic 'FUNCTION's at compile time -'-ftrace' - generate trace code ; scope: executed 'SECTION'/PARAGRAPH -'-ftraceall' - generate trace code ; scope: executed - 'SECTION'/PARAGRAPH/STATEMENTS ; turned on by -debug -'-fsyntax-only' - syntax error checking only; don't emit any output -'-fdebugging-line' - enable debugging lines ; 'D' in indicator column or floating >>D -'-fsource-location' - generate source location code ; turned on by -debug/-g/-ftraceall -'-fimplicit-init' - automatic initialization of the 'COBOL' runtime system -'-fstack-check' - 'PERFORM' stack checking ; turned on by -debug or -g -'-fwrite-after' - use 'AFTER' 1 for 'WRITE' of 'LINE SEQUENTIAL' ; default: 'BEFORE' - 1 -'-fmfcomment' - '*' or '/' in column 1 treated as comment ; 'FIXED' format only -'-facucomment' - '$' in indicator area treated as '*', '|' treated as floating - comment -'-fnotrunc' - allow numeric field overflow ; non-ANSI behaviour -'-fodoslide' - adjust items following 'OCCURS DEPENDING' ; implies '-fcomplex-odo' -'-fsingle-quote' - use a single quote (apostrophe) for 'QUOTE' ; default: double quote -'-foptional-file' - treat all files as 'OPTIONAL' ; unless 'NOT OPTIONAL' specified -'-fstatic-call' - output static function calls for the 'CALL' statement -'-fno-gen-c-decl-static-call' - disable generation of C function declations for subroutines with - static 'CALL' -'-fmf-files' - Sequential & Relative files will match Micro Focus format -'-fno-theaders' - suppress all headers and output of compilation options from listing - while keeping page breaks -'-fno-tsource' - suppress source from listing -'-fno-tmessages' - suppress warning and error summary from listing -'-ftsymbols' - specify symbols in listing -'-fibmcomp' - sets '-fbinary-size'=2-4-8 '-fsynchronized-clause'=ok -'-fno-ibmcomp' - sets '-fbinary-size'=1-8~-fsynchronized-clause=ignore - -A.4 Compiler dialect configuration options -========================================== - -'-freserved-words=VALUE' - use of complete/fixed reserved words -'-ftab-width=1..12' - set number of spaces that are assumed for tabs -'-ftext-column=72..255' - set right margin for source (fixed format only) -'-fpic-length=NUMBER' - maximum number of characters allowed in the 'PICTURE' - character-string -'-fword-length=1..63' - maximum word-length for 'COBOL' (= programmer defined) words -'-fliteral-length=NUMBER' - maximum literal size in general -'-fnumeric-literal-length=1..38' - maximum numeric literal size -'-falign-record=0..256' - align 'WORKING-STORAGE'/LOCAL-STORAGE record on boundary -'-falign-opt' - align like 'MF OPT', Default: false (Like 'MF ALIGN'=FIXED) -'-fbinary-size=VALUE' - binary byte size - defines the allocated bytes according to 'PIC', - may be one of: 2-4-8, 1-2-4-8, 1-8 -'-fbinary-byteorder=VALUE' - binary byte order, may be one of: native, big-endian -'-fassign-clause=VALUE' - how to interpret 'ASSIGN word': as 'ASSIGN 'EXTERNAL' word' or - 'ASSIGN 'DYNAMIC' word' -'-fscreen-section-rules=VALUE' - which compiler's rules to apply to 'SCREEN SECTION' item clauses -'-ffilename-mapping' - resolve file names at run time using environment variables. -'-fpretty-display' - alternate formatting of numeric fields -'-fbinary-truncate' - numeric truncation according to ANSI -'-fcomplex-odo' - allow complex 'OCCURS DEPENDING ON' -'-findirect-redefines' - allow 'REDEFINES' to other than last equal level number -'-flarger-redefines-ok' - allow larger 'REDEFINES' items -'-frelax-syntax-checks' - allow certain syntax variations (e.g. 'REDEFINES' position) -'-frelax-level-hierarchy' - allow non-matching level numbers -'-fsticky-linkage' - 'LINKAGE-SECTION' items remain allocated between invocations -'-fmove-ibm' - 'MOVE' operates as on IBM (left to right, byte by byte), otherwise - no propagating move -'-fperform-osvs' - exit point of any currently executing perform is recognized if - reached -'-farithmetic-osvs' - limit precision in intermediate results to precision of final - result (less accurate) -'-fconstant-folding' - evaluate constant expressions at compile time -'-fhostsign' - allow hexadecimal value 'F' for 'NUMERIC' test of signed 'PACKED - DECIMAL' field -'-fprogram-name-redefinition' - program names don't lead to a reserved identifier -'-faccept-update' - set 'WITH UPDATE' clause as default for 'ACCEPT' dest-item, instead - of 'WITH NO UPDATE' -'-faccept-auto' - set 'WITH AUTO' clause as default for 'ACCEPT' dest-item, instead - of 'WITH TAB' -'-fconsole-is-crt' - assume 'CONSOLE IS CRT' if not set otherwise -'-fno-echo-means-secure' - 'NO-ECHO' hides input with asterisks like 'SECURE' -'-fline-col-zero-default' - assume a field 'DISPLAY' starts at 'LINE' 0 'COL' 0 (i.e. at the - cursor), not 'LINE' 1 'COL' 1 -'-freport-column-plus' - in a 'REPORT COLUMN' may have 'PLUS' num, + num, or +num -'-fdisplay-special-fig-consts' - special behaviour of 'DISPLAY SPACE'/ALL X'01'/ALL X'02'/ALL X'07' -'-fbinary-comp-1' - 'COMP'-1 is a 16-bit signed integer -'-fmove-non-numeric-lit-to-numeric-is-zero' - imply zero in move of non-numeric literal to numeric items -'-fimplicit-assign-dynamic-var' - implicitly define a variable if an 'ASSIGN DYNAMIC' does not match - any data item -'-fcomment-paragraphs=SUPPORT' - comment paragraphs in 'IDENTIFICATION DIVISION' ('AUTHOR', - 'DATE-WRITTEN', ...) -'-fmemory-size-clause=SUPPORT' - 'MEMORY-SIZE' clause -'-fmultiple-file-tape-clause=SUPPORT' - 'MULTIPLE-FILE-TAPE' clause -'-flabel-records-clause=SUPPORT' - 'LABEL-RECORDS' clause -'-fvalue-of-clause=SUPPORT' - 'VALUE-OF' clause -'-fdata-records-clause=SUPPORT' - 'DATA-RECORDS' clause -'-ftop-level-occurs-clause=SUPPORT' - 'OCCURS' clause on top-level -'-fsame-as-clause=SUPPORT' - 'SAME' 'AS' clause -'-fsynchronized-clause=SUPPORT' - 'SYNCHRONIZED' clause -'-fsync-left-right=SUPPORT' - 'LEFT'/RIGHT phrases in 'SYNCHRONIZED' clause -'-fspecial-names-clause=SUPPORT' - 'SPECIAL-NAMES' clause -'-fgoto-statement-without-name=SUPPORT' - 'GOTO' statement without name -'-fstop-literal-statement=SUPPORT' - 'STOP'-literal statement -'-fstop-identifier-statement=SUPPORT' - 'STOP'-identifier statement -'-fdebugging-mode=SUPPORT' - 'DEBUGGING' 'MODE' and debugging indicator -'-fuse-for-debugging=SUPPORT' - 'USE' 'FOR DEBUGGING' -'-fpadding-character-clause=SUPPORT' - 'PADDING' 'CHARACTER' clause -'-fnext-sentence-phrase=SUPPORT' - 'NEXT' 'SENTENCE' phrase -'-flisting-statements=SUPPORT' - listing-directive statements 'EJECT', 'SKIP'1, 'SKIP'2, 'SKIP'3 -'-ftitle-statement=SUPPORT' - listing-directive statement 'TITLE' -'-fentry-statement=SUPPORT' - 'ENTRY' statement -'-fmove-noninteger-to-alphanumeric=SUPPORT' - move noninteger to alphanumeric -'-foccurs-max-length-without-subscript' - occurs max length without subscript -'-flength-in-data-division' - length in data division -'-fmove-figurative-constant-to-numeric=SUPPORT' - move figurative constants to numeric -'-fmove-figurative-space-to-numeric=SUPPORT' - move figurative constant 'SPACE' to numeric -'-fmove-figurative-quote-to-numeric=SUPPORT' - move figurative constant 'QUOTE' to numeric -'-fodo-without-to=SUPPORT' - 'OCCURS' 'DEPENDING ON' without to -'-fsection-segments=SUPPORT' - section segments -'-falter-statement=SUPPORT' - 'ALTER' statement -'-fcall-overflow=SUPPORT' - 'OVERFLOW' clause for 'CALL' -'-fnumeric-boolean=SUPPORT' - boolean literals (B'1010') -'-fhexadecimal-boolean=SUPPORT' - hexadecimal-boolean literals ('BX''A') -'-fnational-literals=SUPPORT' - national literals (N'UTF-16 string') -'-fhexadecimal-national-literals=SUPPORT' - hexadecimal-national literals ('NX''265E') -'-fnational-character-literals=SUPPORT' - non-standard national literals ('NC''UTF-16 string') -'-fhp-octal-literals=SUPPORT' - 'HP' 'COBOL' octal literals (%377) -'-facu-literals=SUPPORT' - 'ACUCOBOL-GT' literals (#B #O #H #X) -'-fword-continuation=SUPPORT' - continuation of 'COBOL' words -'-fnot-exception-before-exception=SUPPORT' - 'NOT' 'ON EXCEPTION' before 'ON EXCEPTION' -'-faccept-display-extensions=SUPPORT' - extensions to 'ACCEPT' and 'DISPLAY' -'-frenames-uncommon-levels=SUPPORT' - 'RENAMES' of 01-, 66- and 77-level items -'-fsymbolic-constant=SUPPORT' - constants defined in 'SPECIAL-NAMES' -'-fconstant-78=SUPPORT' - constant with level 78 item (note: has left to right precedence in - expressions) -'-fconstant-01=SUPPORT' - constant with level 01 'CONSTANT AS'/FROM item -'-fperform-varying-without-by=SUPPORT' - 'PERFORM' 'VARYING' without 'BY' phrase (implies 'BY' 1) -'-freference-out-of-declaratives=SUPPORT' - references to sections not in 'DECLARATIVES' from within - 'DECLARATIVES' -'-freference-bounds-check=SUPPORT' - reference modification strict bounds check -'-fprogram-prototypes=SUPPORT' - 'CALL'/CANCEL with program-prototype-name -'-fcall-convention-mnemonic=SUPPORT' - specifying call-convention by mnemonic -'-fcall-convention-linkage=SUPPORT' - specifying call-convention by 'WITH' ... 'LINKAGE' -'-fnumeric-value-for-edited-item=SUPPORT' - numeric literals in 'VALUE' clause of numeric-edited items -'-fincorrect-conf-sec-order=SUPPORT' - incorrect order of 'CONFIGURATION SECTION' paragraphs -'-fdefine-constant-directive=SUPPORT' - allow >> 'DEFINE CONSTANT' var 'AS' literal -'-ffree-redefines-position=SUPPORT' - 'REDEFINES' clause not following entry-name in definition -'-frecords-mismatch-record-clause=SUPPORT' - record sizes does not match 'RECORD' clause -'-frecord-delimiter=SUPPORT' - 'RECORD' 'DELIMITER' clause -'-fsequential-delimiters=SUPPORT' - 'BINARY-SEQUENTIAL' and 'LINE-SEQUENTIAL' phrases in 'RECORD - DELIMITER' -'-frecord-delim-with-fixed-recs=SUPPORT' - 'RECORD' 'DELIMITER' clause on file with fixed-length records -'-fmissing-statement=SUPPORT' - missing statement (e.g. empty 'IF' / 'PERFORM') -'-fzero-length-literals=SUPPORT' - zero-length literals, e.g. " and "" -'-fxml-generate-extra-phrases=SUPPORT' - 'XML' 'GENERATE''s phrases other than 'COUNT IN' -'-fcontinue-after=SUPPORT' - 'AFTER' phrase in 'CONTINUE' statement -'-fgoto-entry=SUPPORT' - 'ENTRY' 'FOR GOTO' and 'GOTO ENTRY' statements -'-fdepending-on-not-fixed=SUPPORT' - depending-on-not-fixed -'-fbinary-sync-clause=SUPPORT' - 'BINARY-SHORT'/LONG/DOUBLE 'SYNCHRONIZED' clause -'-fnonnumeric-with-numeric-group-usage=SUPPORT' - Non-numeric item with numeric group 'USAGE' clause -'-fassign-variable=SUPPORT' - 'ASSIGN' [TO] variable in 'SELECT' -'-fassign-using-variable=SUPPORT' - 'ASSIGN' 'USING'/VARYING variable in 'SELECT' -'-fassign-ext-dyn=SUPPORT' - 'ASSIGN' 'EXTERNAL'/DYNAMIC in 'SELECT' -'-fassign-disk-from=SUPPORT' - 'ASSIGN' 'DISK FROM' variable in 'SELECT' where SUPPORT is one of - the following: 'ok', 'warning', 'archaic', 'obsolete', 'skip', - 'ignore', 'error', 'unconformable' -'-fnot-reserved=WORD' - word to be taken out of the reserved words list -'-freserved=WORD' - word to be added to reserved words list -'-freserved=WORD:ALIAS' - word to be added to reserved words list as alias -'-fnot-register=WORD' - special register to disable -'-fregister=WORD' - special register to enable - - -File: gnucobol.info, Node: Appendix B, Next: Appendix C, Prev: Appendix A, Up: Appendices - -Appendix B Reserved Words -************************* - -The following list of reserved words was extracted from 'cobc ---list-reserved' and shows the reserved words, an implementation - - *Please notice:* This list is highly specific to the option -'-std=DIALECT' and reserved word options ('-freserved=WORD', -'-fno-reserved=WORD') in effect. You can get the list for a given -DIALECT by calling 'cobc -std=DIALECT --list-reserved'. - -B.1 Common reserved words -========================= - -Reserved word Implemented Aliases ---------------------------------------------------------------------------- -'3-D' Yes (C/S) -'ABSENT' Yes -'ACCEPT' Yes -'ACCESS' Yes -'ACTION' Yes (C/S) -'ACTIVE-CLASS' No -'ACTIVE-X' Yes (C/S) -'ACTUAL' Yes (C/S) -'ADD' Yes -'ADDRESS' Yes -'ADJUSTABLE-COLUMNS' Yes (C/S) -'ADVANCING' Yes -'AFTER' Yes -'ALIGNED' No -'ALIGNMENT' Yes (C/S) -'ALL' Yes -'ALLOCATE' Yes -'ALLOWING' Yes (C/S) -'ALPHABET' Yes -'ALPHABETIC' Yes -'ALPHABETIC-LOWER' Yes -'ALPHABETIC-UPPER' Yes -'ALPHANUMERIC' Yes -'ALPHANUMERIC-EDITED' Yes -'ALSO' Yes -'ALTER' Yes -'ALTERNATE' Yes -'AND' Yes -'ANY' Yes -'ANYCASE' No -'APPLY' Yes (C/S) -'ARE' Yes -'AREA' Yes 'AREAS' -'AREAS' Yes 'AREA' -'ARGUMENT-NUMBER' Yes -'ARGUMENT-VALUE' Yes -'ARITHMETIC' Yes (C/S) -'AS' Yes -'ASCENDING' Yes -'ASCII' Yes (C/S) -'ASSIGN' Yes -'AT' Yes -'ATTRIBUTE' Yes (C/S) -'ATTRIBUTES' Yes (C/S) -'AUTO' Yes (C/S) 'AUTO-SKIP, AUTOTERMINATE' -'AUTO-DECIMAL' Yes (C/S) -'AUTO-SKIP' Yes 'AUTO, AUTOTERMINATE' -'AUTO-SPIN' Yes (C/S) -'AUTOMATIC' Yes -'AUTOTERMINATE' Yes 'AUTO, AUTO-SKIP' -'AWAY-FROM-ZERO' Yes (C/S) -'B-AND' No -'B-NOT' No -'B-OR' No -'B-XOR' No -'BACKGROUND-COLOR' Yes (C/S) 'BACKGROUND-COLOUR' -'BACKGROUND-COLOUR' Yes 'BACKGROUND-COLOR' -'BACKGROUND-HIGH' Yes -'BACKGROUND-LOW' Yes -'BACKGROUND-STANDARD' Yes -'BAR' Yes (C/S) -'BASED' Yes -'BEEP' Yes 'BELL' -'BEFORE' Yes -'BELL' Yes (C/S) 'BEEP' -'BINARY' Yes -'BINARY-C-LONG' Yes -'BINARY-CHAR' Yes -'BINARY-DOUBLE' Yes 'BINARY-LONG-LONG' -'BINARY-INT' Yes 'BINARY-LONG' -'BINARY-LONG' Yes 'BINARY-INT' -'BINARY-LONG-LONG' Yes 'BINARY-DOUBLE' -'BINARY-SEQUENTIAL' Yes (C/S) -'BINARY-SHORT' Yes -'BIT' Yes -'BITMAP' Yes (C/S) -'BITMAP-END' Yes (C/S) -'BITMAP-HANDLE' Yes (C/S) -'BITMAP-NUMBER' Yes (C/S) -'BITMAP-START' Yes (C/S) -'BITMAP-TIMER' Yes (C/S) -'BITMAP-TRAILING' Yes (C/S) -'BITMAP-TRANSPARENT-COLOR' Yes (C/S) -'BITMAP-WIDTH' Yes (C/S) -'BLANK' Yes -'BLINK' Yes (C/S) -'BLOCK' Yes -'BOOLEAN' No -'BOTTOM' Yes -'BOX' Yes (C/S) -'BOXED' Yes (C/S) -'BULK-ADDITION' Yes (C/S) -'BUSY' Yes (C/S) -'BUTTONS' Yes (C/S) -'BY' Yes -'BYTE-LENGTH' Yes (C/S) -'C' Yes (C/S) -'CALENDAR-FONT' Yes (C/S) -'CALL' Yes -'CANCEL' Yes -'CANCEL-BUTTON' Yes (C/S) -'CAPACITY' Yes (C/S) -'CARD-PUNCH' Yes (C/S) -'CARD-READER' Yes (C/S) -'CASSETTE' Yes (C/S) -'CCOL' Yes (C/S) -'CD' Yes -'CELL' Yes (C/S) 'CELLS' -'CELL-COLOR' Yes (C/S) -'CELL-DATA' Yes (C/S) -'CELL-FONT' Yes (C/S) -'CELL-PROTECTION' Yes (C/S) -'CELLS' Yes 'CELL' -'CENTER' Yes (C/S) -'CENTERED' Yes (C/S) -'CENTERED-HEADINGS' Yes (C/S) -'CENTURY-DATE' Yes (C/S) -'CF' Yes -'CH' Yes -'CHAIN' No -'CHAINING' Yes -'CHARACTER' Yes -'CHARACTERS' Yes -'CHECK-BOX' Yes (C/S) -'CLASS' Yes -'CLASS-ID' No -'CLASSIFICATION' Yes (C/S) -'CLEAR-SELECTION' Yes (C/S) -'CLINE' Yes (C/S) -'CLINES' Yes (C/S) -'CLOSE' Yes -'COBOL' Yes (C/S) -'CODE' Yes -'CODE-SET' Yes -'COL' Yes -'COLLATING' Yes -'COLOR' Yes -'COLORS' Yes (C/S) 'COLOURS' -'COLOURS' Yes 'COLORS' -'COLS' Yes -'COLUMN' Yes -'COLUMN-COLOR' Yes (C/S) -'COLUMN-DIVIDERS' Yes (C/S) -'COLUMN-FONT' Yes (C/S) -'COLUMN-HEADINGS' Yes (C/S) -'COLUMN-PROTECTION' Yes (C/S) -'COLUMNS' Yes -'COMBO-BOX' Yes (C/S) -'COMMA' Yes -'COMMAND-LINE' Yes -'COMMIT' Yes -'COMMON' Yes -'COMMUNICATION' Yes -'COMP' Yes 'COMPUTATIONAL' -'COMP-0' Yes 'COMPUTATIONAL-0' -'COMP-1' Yes 'COMPUTATIONAL-1' -'COMP-2' Yes 'COMPUTATIONAL-2' -'COMP-3' Yes 'COMPUTATIONAL-3' -'COMP-4' Yes 'COMPUTATIONAL-4' -'COMP-5' Yes 'COMPUTATIONAL-5' -'COMP-6' Yes 'COMPUTATIONAL-6' -'COMP-N' Yes 'COMPUTATIONAL-N' -'COMP-X' Yes 'COMPUTATIONAL-X' -'COMPUTATIONAL' Yes 'COMP' -'COMPUTATIONAL-0' Yes 'COMP-0' -'COMPUTATIONAL-1' Yes 'COMP-1' -'COMPUTATIONAL-2' Yes 'COMP-2' -'COMPUTATIONAL-3' Yes 'COMP-3' -'COMPUTATIONAL-4' Yes 'COMP-4' -'COMPUTATIONAL-5' Yes 'COMP-5' -'COMPUTATIONAL-6' Yes 'COMP-6' -'COMPUTATIONAL-N' Yes 'COMP-N' -'COMPUTATIONAL-X' Yes 'COMP-X' -'COMPUTE' Yes -'CONDITION' Yes -'CONFIGURATION' Yes -'CONSTANT' Yes -'CONTAINS' Yes -'CONTENT' Yes -'CONTINUE' Yes -'CONTROL' Yes -'CONTROLS' Yes -'CONVERSION' Yes (C/S) -'CONVERTING' Yes -'COPY' Yes -'COPY-SELECTION' Yes (C/S) -'CORE-INDEX' Yes (C/S) -'CORR' Yes 'CORRESPONDING' -'CORRESPONDING' Yes 'CORR' -'COUNT' Yes -'CRT' Yes -'CRT-UNDER' Yes -'CSIZE' Yes (C/S) -'CURRENCY' Yes -'CURSOR' Yes -'CURSOR-COL' Yes (C/S) -'CURSOR-COLOR' Yes (C/S) -'CURSOR-FRAME-WIDTH' Yes (C/S) -'CURSOR-ROW' Yes (C/S) -'CURSOR-X' Yes (C/S) -'CURSOR-Y' Yes (C/S) -'CUSTOM-PRINT-TEMPLATE' Yes (C/S) -'CYCLE' Yes (C/S) -'CYL-INDEX' Yes (C/S) -'CYL-OVERFLOW' Yes (C/S) -'DASHED' Yes (C/S) -'DATA' Yes -'DATA-COLUMNS' Yes (C/S) -'DATA-POINTER' No -'DATA-TYPES' Yes (C/S) -'DATE' Yes -'DATE-ENTRY' Yes (C/S) -'DAY' Yes -'DAY-OF-WEEK' Yes -'DE' Yes -'DEBUGGING' Yes -'DECIMAL-POINT' Yes -'DECLARATIVES' Yes -'DEFAULT' Yes -'DEFAULT-BUTTON' Yes (C/S) -'DEFAULT-FONT' Yes -'DELETE' Yes -'DELIMITED' Yes -'DELIMITER' Yes -'DEPENDING' Yes -'DESCENDING' Yes -'DESTINATION' Yes -'DESTROY' Yes -'DETAIL' Yes -'DISABLE' Yes -'DISC' Yes (C/S) -'DISK' Yes (C/S) -'DISP' Yes (C/S) -'DISPLAY' Yes -'DISPLAY-COLUMNS' Yes (C/S) -'DISPLAY-FORMAT' Yes (C/S) -'DIVIDE' Yes -'DIVIDER-COLOR' Yes (C/S) -'DIVIDERS' Yes (C/S) -'DIVISION' Yes -'DOTDASH' Yes (C/S) -'DOTTED' Yes (C/S) -'DOUBLE' Yes 'FLOAT-LONG' -'DOWN' Yes -'DRAG-COLOR' Yes (C/S) -'DROP-DOWN' Yes (C/S) -'DROP-LIST' Yes (C/S) -'DUPLICATES' Yes -'DYNAMIC' Yes -'EBCDIC' Yes (C/S) -'EC' Yes -'ECHO' Yes -'EGI' Yes -'ELEMENT' Yes (C/S) -'ELSE' Yes -'EMI' Yes -'EMPTY-CHECK' Yes 'REQUIRED' -'ENABLE' Yes -'ENABLED' Yes (C/S) -'ENCODING' Yes (C/S) -'ENCRYPTION' Yes (C/S) -'END' Yes -'END-ACCEPT' Yes -'END-ADD' Yes -'END-CALL' Yes -'END-CHAIN' No -'END-COLOR' Yes (C/S) -'END-COMPUTE' Yes -'END-DELETE' Yes -'END-DISPLAY' Yes -'END-DIVIDE' Yes -'END-EVALUATE' Yes -'END-IF' Yes -'END-JSON' Yes -'END-MODIFY' Yes (C/S) -'END-MULTIPLY' Yes -'END-OF-PAGE' Yes 'EOP' -'END-PERFORM' Yes -'END-READ' Yes -'END-RECEIVE' Yes -'END-RETURN' Yes -'END-REWRITE' Yes -'END-SEARCH' Yes -'END-START' Yes -'END-STRING' Yes -'END-SUBTRACT' Yes -'END-UNSTRING' Yes -'END-WRITE' Yes -'END-XML' Yes -'ENGRAVED' Yes (C/S) -'ENSURE-VISIBLE' Yes (C/S) -'ENTRY' Yes -'ENTRY-CONVENTION' Yes (C/S) -'ENTRY-FIELD' Yes (C/S) -'ENTRY-REASON' Yes (C/S) -'ENVIRONMENT' Yes -'ENVIRONMENT-NAME' Yes -'ENVIRONMENT-VALUE' Yes -'EO' No -'EOL' Yes (C/S) -'EOP' Yes 'END-OF-PAGE' -'EOS' Yes (C/S) -'EQUAL' Yes 'EQUALS' -'EQUALS' Yes 'EQUAL' -'ERASE' Yes (C/S) -'ERROR' Yes -'ESCAPE' Yes -'ESCAPE-BUTTON' Yes (C/S) -'ESI' Yes -'EVALUATE' Yes -'EVENT' Yes -'EVENT-LIST' Yes (C/S) -'EVERY' Yes (C/S) -'EXCEPTION' Yes -'EXCEPTION-OBJECT' No -'EXCEPTION-VALUE' Yes (C/S) -'EXCLUSIVE' Yes -'EXIT' Yes -'EXPAND' Yes (C/S) -'EXPANDS' No (C/S) -'EXTEND' Yes -'EXTENDED-SEARCH' Yes (C/S) -'EXTERN' Yes (C/S) -'EXTERNAL' Yes -'EXTERNAL-FORM' Yes -'F' Yes (C/S) -'FACTORY' No -'FALSE' Yes -'FD' Yes -'FH--FCD' Yes (C/S) -'FH--KEYDEF' Yes (C/S) -'FILE' Yes -'FILE-CONTROL' Yes -'FILE-ID' Yes -'FILE-LIMIT' Yes (C/S) -'FILE-LIMITS' Yes (C/S) -'FILE-NAME' Yes (C/S) -'FILE-POS' Yes (C/S) -'FILL-COLOR' Yes (C/S) -'FILL-COLOR2' Yes (C/S) -'FILL-PERCENT' Yes (C/S) -'FILLER' Yes -'FINAL' Yes -'FINISH-REASON' Yes (C/S) -'FIRST' Yes -'FIXED' Yes -'FIXED-FONT' Yes -'FIXED-WIDTH' Yes (C/S) -'FLAT' Yes (C/S) -'FLAT-BUTTONS' Yes (C/S) -'FLOAT' Yes 'FLOAT-SHORT' -'FLOAT-BINARY-128' No -'FLOAT-BINARY-32' No -'FLOAT-BINARY-64' No -'FLOAT-DECIMAL-16' Yes -'FLOAT-DECIMAL-34' Yes -'FLOAT-EXTENDED' No -'FLOAT-INFINITY' No -'FLOAT-LONG' Yes 'DOUBLE' -'FLOAT-NOT-A-NUMBER' No (C/S) -'FLOAT-SHORT' Yes 'FLOAT' -'FLOATING' Yes -'FONT' Yes -'FOOTING' Yes -'FOR' Yes -'FOREGROUND-COLOR' Yes (C/S) 'FOREGROUND-COLOUR' -'FOREGROUND-COLOUR' Yes 'FOREGROUND-COLOR' -'FOREVER' Yes (C/S) -'FORMAT' No -'FRAME' Yes (C/S) -'FRAMED' Yes (C/S) -'FREE' Yes -'FROM' Yes -'FULL' Yes (C/S) 'LENGTH-CHECK' -'FULL-HEIGHT' Yes (C/S) -'FUNCTION' Yes -'FUNCTION-ID' Yes -'FUNCTION-POINTER' No -'GENERATE' Yes -'GET' No -'GIVING' Yes -'GLOBAL' Yes -'GO' Yes -'GO-BACK' Yes (C/S) -'GO-FORWARD' Yes (C/S) -'GO-HOME' Yes (C/S) -'GO-SEARCH' Yes (C/S) -'GOBACK' Yes -'GRAPHICAL' Yes (C/S) -'GREATER' Yes -'GRID' Yes (C/S) -'GROUP' Yes -'GROUP-USAGE' No -'GROUP-VALUE' Yes (C/S) -'HANDLE' Yes -'HAS-CHILDREN' Yes (C/S) -'HEADING' Yes -'HEADING-COLOR' Yes (C/S) -'HEADING-DIVIDER-COLOR' Yes (C/S) -'HEADING-FONT' Yes (C/S) -'HEAVY' Yes (C/S) -'HEIGHT-IN-CELLS' Yes (C/S) -'HELP-ID' Yes (C/S) -'HIDDEN-DATA' Yes (C/S) -'HIGH-COLOR' Yes (C/S) -'HIGH-VALUE' Yes 'HIGH-VALUES' -'HIGH-VALUES' Yes 'HIGH-VALUE' -'HIGHLIGHT' Yes (C/S) -'HOT-TRACK' Yes (C/S) -'HSCROLL' Yes (C/S) -'HSCROLL-POS' Yes (C/S) -'I-O' Yes -'I-O-CONTROL' Yes -'ICON' Yes (C/S) -'ID' Yes -'IDENTIFICATION' Yes -'IDENTIFIED' Yes -'IF' Yes -'IGNORE' Yes -'IGNORING' Yes (C/S) -'IMPLEMENTS' No (C/S) -'IN' Yes -'INDEPENDENT' Yes (C/S) -'INDEX' Yes -'INDEXED' Yes -'INDICATE' Yes -'INHERITS' No -'INITIAL' Yes -'INITIALISE' Yes 'INITIALIZE' -'INITIALISED' Yes 'INITIALIZED' -'INITIALIZE' Yes 'INITIALISE' -'INITIALIZED' Yes (C/S) 'INITIALISED' -'INITIATE' Yes -'INPUT' Yes -'INPUT-OUTPUT' Yes -'INQUIRE' Yes -'INSERT-ROWS' Yes (C/S) -'INSERTION-INDEX' Yes (C/S) -'INSPECT' Yes -'INTERFACE' No -'INTERFACE-ID' No -'INTERMEDIATE' Yes (C/S) -'INTO' Yes -'INTRINSIC' Yes (C/S) -'INVALID' Yes -'INVOKE' No -'IS' Yes -'ITEM' Yes (C/S) -'ITEM-TEXT' Yes (C/S) -'ITEM-TO-ADD' Yes (C/S) -'ITEM-TO-DELETE' Yes (C/S) -'ITEM-TO-EMPTY' Yes (C/S) -'ITEM-VALUE' Yes (C/S) -'JSON' Yes -'JUST' Yes 'JUSTIFIED' -'JUSTIFIED' Yes 'JUST' -'KEPT' Yes -'KEY' Yes -'KEYBOARD' Yes (C/S) -'LABEL' Yes -'LABEL-OFFSET' Yes (C/S) -'LARGE-FONT' Yes -'LARGE-OFFSET' Yes (C/S) -'LAST' Yes -'LAST-ROW' Yes (C/S) -'LAYOUT-DATA' Yes (C/S) -'LAYOUT-MANAGER' Yes -'LC_ALL' No (C/S) -'LC_COLLATE' No (C/S) -'LC_CTYPE' No (C/S) -'LC_MESSAGES' No (C/S) -'LC_MONETARY' No (C/S) -'LC_NUMERIC' No (C/S) -'LC_TIME' No (C/S) -'LEADING' Yes -'LEADING-SHIFT' Yes (C/S) -'LEAVE' Yes (C/S) -'LEFT' Yes -'LEFT-JUSTIFY' No -'LEFT-TEXT' Yes (C/S) -'LEFTLINE' Yes -'LENGTH' Yes -'LENGTH-CHECK' Yes 'FULL' -'LESS' Yes -'LIMIT' Yes -'LIMITS' Yes -'LINAGE' Yes -'LINAGE-COUNTER' Yes -'LINE' Yes -'LINE-COUNTER' Yes -'LINE-SEQUENTIAL' Yes (C/S) -'LINES' Yes -'LINES-AT-ROOT' Yes (C/S) -'LINKAGE' Yes -'LIST-BOX' Yes (C/S) -'LM-RESIZE' Yes -'LOC' Yes (C/S) -'LOCAL-STORAGE' Yes -'LOCALE' Yes -'LOCK' Yes -'LOCK-HOLDING' Yes (C/S) -'LONG-DATE' Yes (C/S) -'LOW-COLOR' Yes (C/S) -'LOW-VALUE' Yes 'LOW-VALUES' -'LOW-VALUES' Yes 'LOW-VALUE' -'LOWER' Yes (C/S) -'LOWERED' Yes (C/S) -'LOWLIGHT' Yes (C/S) -'MAGNETIC-TAPE' Yes (C/S) -'MANUAL' Yes -'MASS-UPDATE' Yes (C/S) -'MASTER-INDEX' Yes (C/S) -'MAX-LINES' Yes (C/S) -'MAX-PROGRESS' Yes (C/S) -'MAX-TEXT' Yes (C/S) -'MAX-VAL' Yes (C/S) -'MEDIUM-FONT' Yes -'MEMORY' Yes (C/S) -'MENU' Yes -'MERGE' Yes -'MESSAGE' Yes -'METHOD' No -'METHOD-ID' No -'MIN-VAL' Yes (C/S) -'MINUS' Yes -'MODE' Yes -'MODIFY' Yes -'MODULES' Yes (C/S) -'MOVE' Yes -'MULTILINE' Yes (C/S) -'MULTIPLE' Yes -'MULTIPLY' Yes -'NAME' Yes (C/S) -'NAMESPACE' Yes (C/S) -'NAMESPACE-PREFIX' Yes (C/S) -'NATIONAL' Yes -'NATIONAL-EDITED' Yes -'NATIVE' Yes -'NAVIGATE-URL' Yes (C/S) -'NEAREST-AWAY-FROM-ZERO' Yes (C/S) -'NEAREST-EVEN' Yes (C/S) -'NEAREST-TOWARD-ZERO' Yes (C/S) -'NEGATIVE' Yes -'NESTED' Yes -'NEW' Yes -'NEXT' Yes -'NEXT-ITEM' Yes (C/S) -'NO' Yes -'NO-AUTO-DEFAULT' Yes (C/S) -'NO-AUTOSEL' Yes (C/S) -'NO-BOX' Yes (C/S) -'NO-DIVIDERS' Yes (C/S) -'NO-ECHO' Yes -'NO-F4' Yes (C/S) -'NO-FOCUS' Yes (C/S) -'NO-GROUP-TAB' Yes (C/S) -'NO-KEY-LETTER' Yes (C/S) -'NO-SEARCH' Yes (C/S) -'NO-UPDOWN' Yes (C/S) -'NOMINAL' Yes (C/S) -'NONE' No (C/S) -'NONNUMERIC' Yes (C/S) -'NORMAL' Yes (C/S) -'NOT' Yes -'NOTAB' Yes (C/S) -'NOTHING' Yes -'NOTIFY' Yes (C/S) -'NOTIFY-CHANGE' Yes (C/S) -'NOTIFY-DBLCLICK' Yes (C/S) -'NOTIFY-SELCHANGE' Yes (C/S) -'NULL' Yes 'NULLS' -'NULLS' Yes 'NULL' -'NUM-COL-HEADINGS' Yes (C/S) -'NUM-ROWS' Yes (C/S) -'NUMBER' Yes -'NUMBERS' Yes -'NUMERIC' Yes -'NUMERIC-EDITED' Yes -'NUMERIC-FILL' No (C/S) -'OBJECT' Yes -'OBJECT-COMPUTER' Yes -'OBJECT-REFERENCE' No -'OCCURS' Yes -'OF' Yes -'OFF' Yes -'OK-BUTTON' Yes (C/S) -'OMITTED' Yes -'ON' Yes -'ONLY' Yes -'OPEN' Yes -'OPTIONAL' Yes -'OPTIONS' Yes -'OR' Yes -'ORDER' Yes -'ORGANISATION' Yes 'ORGANIZATION' -'ORGANIZATION' Yes 'ORGANISATION' -'OTHER' Yes -'OTHERS' Yes (C/S) -'OUTPUT' Yes -'OVERFLOW' Yes -'OVERLAP-LEFT' Yes (C/S) 'OVERLAP-TOP' -'OVERLAP-TOP' Yes (C/S) 'OVERLAP-LEFT' -'OVERLINE' Yes -'OVERRIDE' No -'PACKED-DECIMAL' Yes -'PADDING' Yes -'PAGE' Yes -'PAGE-COUNTER' Yes -'PAGE-SETUP' Yes (C/S) -'PAGED' Yes (C/S) -'PARAGRAPH' Yes (C/S) -'PARENT' Yes (C/S) -'PARSE' Yes (C/S) -'PASCAL' Yes (C/S) -'PASSWORD' Yes (C/S) -'PERFORM' Yes -'PERMANENT' Yes (C/S) -'PF' Yes -'PH' Yes -'PHYSICAL' Yes -'PIC' Yes 'PICTURE' -'PICTURE' Yes 'PIC' -'PIXEL' Yes (C/S) 'PIXELS' -'PIXELS' Yes 'PIXEL' -'PLACEMENT' Yes (C/S) -'PLUS' Yes -'POINTER' Yes -'POP-UP' Yes (C/S) -'POS' Yes -'POSITION' Yes -'POSITION-SHIFT' Yes (C/S) -'POSITIVE' Yes -'PREFIXED' No (C/S) -'PRESENT' Yes -'PREVIOUS' Yes (C/S) -'PRINT' Yes (C/S) -'PRINT-NO-PROMPT' Yes (C/S) -'PRINT-PREVIEW' Yes (C/S) -'PRINTER' Yes (C/S) -'PRINTER-1' Yes (C/S) -'PRINTING' Yes -'PRIORITY' Yes -'PROCEDURE' Yes -'PROCEDURE-POINTER' Yes 'PROGRAM-POINTER' -'PROCEDURES' Yes -'PROCEED' Yes -'PROCESSING' Yes (C/S) -'PROGRAM' Yes -'PROGRAM-ID' Yes -'PROGRAM-POINTER' Yes 'PROCEDURE-POINTER' -'PROGRESS' Yes (C/S) -'PROHIBITED' Yes (C/S) -'PROMPT' Yes -'PROPERTIES' Yes (C/S) -'PROPERTY' Yes -'PROTECTED' Yes (C/S) -'PROTOTYPE' Yes -'PURGE' Yes -'PUSH-BUTTON' Yes (C/S) -'QUERY-INDEX' Yes (C/S) -'QUEUE' Yes -'QUOTE' Yes 'QUOTES' -'QUOTES' Yes 'QUOTE' -'RADIO-BUTTON' Yes (C/S) -'RAISE' Yes -'RAISED' Yes (C/S) -'RAISING' No -'RANDOM' Yes -'RD' Yes -'READ' Yes -'READ-ONLY' Yes (C/S) -'READERS' Yes (C/S) -'RECEIVE' Yes -'RECORD' Yes -'RECORD-DATA' Yes (C/S) -'RECORD-OVERFLOW' Yes (C/S) -'RECORD-TO-ADD' Yes (C/S) -'RECORD-TO-DELETE' Yes (C/S) -'RECORDING' Yes -'RECORDS' Yes -'RECURSIVE' Yes (C/S) -'REDEFINES' Yes -'REEL' Yes -'REFERENCE' Yes -'REFERENCES' Yes -'REFRESH' Yes (C/S) -'REGION-COLOR' Yes (C/S) -'RELATION' No (C/S) -'RELATIVE' Yes -'RELEASE' Yes -'REMAINDER' Yes -'REMOVAL' Yes -'RENAMES' Yes -'REORG-CRITERIA' Yes (C/S) -'REPLACE' Yes -'REPLACING' Yes -'REPORT' Yes -'REPORTING' Yes -'REPORTS' Yes -'REPOSITORY' Yes -'REQUIRED' Yes (C/S) 'EMPTY-CHECK' -'REREAD' Yes (C/S) -'RERUN' Yes (C/S) -'RESERVE' Yes -'RESET' Yes -'RESET-GRID' Yes (C/S) -'RESET-LIST' Yes (C/S) -'RESET-TABS' Yes (C/S) -'RESIDENT' Yes (C/S) -'RESUME' No -'RETRY' Yes -'RETURN' Yes -'RETURNING' Yes -'REVERSE' Yes -'REVERSE-VIDEO' Yes (C/S) -'REVERSED' Yes -'REWIND' Yes -'REWRITE' Yes -'RF' Yes -'RH' Yes -'RIGHT' Yes -'RIGHT-ALIGN' Yes (C/S) -'RIGHT-JUSTIFY' No -'RIMMED' Yes (C/S) -'ROLLBACK' Yes -'ROUNDED' Yes -'ROUNDING' Yes (C/S) -'ROW-COLOR' Yes (C/S) -'ROW-COLOR-PATTERN' Yes (C/S) -'ROW-DIVIDERS' Yes (C/S) -'ROW-FONT' Yes (C/S) -'ROW-HEADINGS' Yes (C/S) -'ROW-PROTECTION' Yes (C/S) -'RUN' Yes -'S' Yes (C/S) -'SAME' Yes -'SAVE-AS' Yes (C/S) -'SAVE-AS-NO-PROMPT' Yes (C/S) -'SCREEN' Yes -'SCROLL' Yes (C/S) -'SCROLL-BAR' Yes (C/S) -'SD' Yes -'SEARCH' Yes -'SEARCH-OPTIONS' Yes (C/S) -'SEARCH-TEXT' Yes (C/S) -'SECONDS' Yes (C/S) -'SECTION' Yes -'SECURE' Yes (C/S) -'SEGMENT' Yes -'SEGMENT-LIMIT' Yes -'SELECT' Yes -'SELECT-ALL' Yes (C/S) -'SELECTION-INDEX' Yes (C/S) -'SELECTION-TEXT' Yes (C/S) -'SELF' No -'SELF-ACT' Yes (C/S) -'SEND' Yes -'SENTENCE' Yes -'SEPARATE' Yes -'SEPARATION' Yes (C/S) -'SEQUENCE' Yes -'SEQUENTIAL' Yes -'SET' Yes -'SHADING' Yes (C/S) -'SHADOW' Yes (C/S) -'SHARING' Yes -'SHORT-DATE' Yes (C/S) -'SHOW-LINES' Yes (C/S) -'SHOW-NONE' Yes (C/S) -'SHOW-SEL-ALWAYS' Yes (C/S) -'SIGN' Yes -'SIGNED' Yes -'SIGNED-INT' Yes -'SIGNED-LONG' Yes -'SIGNED-SHORT' Yes -'SIZE' Yes -'SMALL-FONT' Yes -'SORT' Yes -'SORT-MERGE' Yes -'SORT-ORDER' Yes (C/S) -'SOURCE' Yes -'SOURCE-COMPUTER' Yes -'SOURCES' No -'SPACE' Yes 'SPACES' -'SPACE-FILL' No -'SPACES' Yes 'SPACE' -'SPECIAL-NAMES' Yes -'SPINNER' Yes (C/S) -'SQUARE' Yes (C/S) -'STANDARD' Yes -'STANDARD-1' Yes -'STANDARD-2' Yes -'STANDARD-BINARY' Yes (C/S) -'STANDARD-DECIMAL' Yes (C/S) -'START' Yes -'START-X' Yes (C/S) -'START-Y' Yes (C/S) -'STATEMENT' No (C/S) -'STATIC' Yes (C/S) -'STATIC-LIST' Yes (C/S) -'STATUS' Yes -'STATUS-BAR' Yes (C/S) -'STATUS-TEXT' Yes (C/S) -'STDCALL' Yes (C/S) -'STEP' Yes (C/S) -'STOP' Yes -'STRING' Yes -'STRONG' No (C/S) -'STYLE' Yes (C/S) -'SUB-QUEUE-1' Yes -'SUB-QUEUE-2' Yes -'SUB-QUEUE-3' Yes -'SUBTRACT' Yes -'SUBWINDOW' Yes -'SUM' Yes -'SUPER' No -'SUPPRESS' Yes -'SYMBOL' No (C/S) -'SYMBOLIC' Yes -'SYNC' Yes 'SYNCHRONISED, - SYNCHRONIZED' -'SYNCHRONISED' Yes 'SYNC, SYNCHRONIZED' -'SYNCHRONIZED' Yes 'SYNC, SYNCHRONISED' -'SYSTEM-DEFAULT' Yes -'SYSTEM-INFO' Yes (C/S) -'SYSTEM-OFFSET' Yes -'TAB' Yes (C/S) -'TAB-TO-ADD' Yes (C/S) -'TAB-TO-DELETE' Yes (C/S) -'TABLE' Yes -'TALLYING' Yes -'TAPE' Yes (C/S) -'TEMPORARY' Yes (C/S) -'TERMINAL-INFO' Yes (C/S) -'TERMINATE' Yes -'TERMINATION-VALUE' Yes (C/S) -'TEST' Yes -'TEXT' Yes -'THAN' Yes -'THEN' Yes -'THREAD' Yes -'THREADS' Yes -'THROUGH' Yes 'THRU' -'THRU' Yes 'THROUGH' -'THUMB-POSITION' Yes (C/S) -'TILED-HEADINGS' Yes (C/S) -'TIME' Yes -'TIME-OUT' Yes (C/S) 'TIMEOUT' -'TIMEOUT' Yes 'TIME-OUT' -'TIMES' Yes -'TITLE' Yes (C/S) -'TITLE-POSITION' Yes (C/S) -'TO' Yes -'TOP' Yes -'TOWARD-GREATER' Yes (C/S) -'TOWARD-LESSER' Yes (C/S) -'TRACK' Yes (C/S) -'TRACK-AREA' Yes (C/S) -'TRACK-LIMIT' Yes (C/S) -'TRACKS' Yes (C/S) -'TRADITIONAL-FONT' Yes -'TRAILING' Yes -'TRAILING-SHIFT' Yes (C/S) -'TRAILING-SIGN' No -'TRANSACTION' Yes -'TRANSFORM' Yes -'TRANSPARENT' Yes (C/S) -'TREE-VIEW' Yes (C/S) -'TRUE' Yes -'TRUNCATION' Yes (C/S) -'TYPE' Yes -'TYPEDEF' No -'U' Yes (C/S) -'UCS-4' Yes (C/S) -'UNBOUNDED' Yes (C/S) -'UNDERLINE' Yes (C/S) -'UNFRAMED' Yes (C/S) -'UNIT' Yes -'UNIVERSAL' No -'UNLOCK' Yes -'UNSIGNED' Yes -'UNSIGNED-INT' Yes -'UNSIGNED-LONG' Yes -'UNSIGNED-SHORT' Yes -'UNSORTED' Yes (C/S) -'UNSTRING' Yes -'UNTIL' Yes -'UP' Yes -'UPDATE' Yes -'UPDATERS' Yes (C/S) -'UPON' Yes -'UPPER' Yes (C/S) -'USAGE' Yes -'USE' Yes -'USE-ALT' Yes (C/S) -'USE-RETURN' Yes (C/S) -'USE-TAB' Yes (C/S) -'USER' Yes (C/S) -'USER-DEFAULT' Yes -'USING' Yes -'UTF-16' Yes (C/S) -'UTF-8' Yes (C/S) -'V' Yes (C/S) -'VAL-STATUS' No -'VALID' No -'VALIDATE' Yes -'VALIDATE-STATUS' No -'VALIDATING' Yes (C/S) -'VALUE' Yes 'VALUES' -'VALUE-FORMAT' Yes (C/S) -'VALUES' Yes 'VALUE' -'VARIABLE' Yes (C/S) -'VARIANT' Yes -'VARYING' Yes -'VERTICAL' Yes (C/S) -'VERY-HEAVY' Yes (C/S) -'VIRTUAL-WIDTH' Yes (C/S) -'VISIBLE' Yes (C/S) -'VOLATILE' Yes -'VPADDING' Yes (C/S) -'VSCROLL' Yes (C/S) -'VSCROLL-BAR' Yes (C/S) -'VSCROLL-POS' Yes (C/S) -'VTOP' Yes (C/S) -'WAIT' Yes -'WEB-BROWSER' Yes (C/S) -'WHEN' Yes -'WIDTH' Yes (C/S) -'WIDTH-IN-CELLS' Yes (C/S) -'WINDOW' Yes -'WITH' Yes -'WORDS' Yes -'WORKING-STORAGE' Yes -'WRAP' Yes (C/S) -'WRITE' Yes -'WRITE-ONLY' Yes (C/S) -'WRITE-VERIFY' Yes (C/S) -'WRITERS' Yes (C/S) -'X' Yes (C/S) -'XML' Yes -'XML-DECLARATION' Yes (C/S) -'Y' Yes (C/S) -'YYYYDDD' Yes (C/S) -'YYYYMMDD' Yes (C/S) -'ZERO' Yes 'ZEROES, ZEROS' -'ZERO-FILL' No (C/S) -'ZEROES' Yes 'ZERO, ZEROS' -'ZEROS' Yes 'ZERO, ZEROES' - -B.2 Extra (obsolete) context sensitive words -============================================ - -'AUTHOR', 'DATE-COMPILED', 'DATE-MODIFIED', 'DATE-WRITTEN', -'INSTALLATION', 'REMARKS', 'SECURITY' - -B.3 Internal registers -====================== - -Register Implemented Definition ---------------------------------------------------------------------------- -''ADDRESS OF' phrase' Yes 'USAGE POINTER' -'COB-CRT-STATUS' Yes 'PICTURE 9(4) USAGE DISPLAY - VALUE ZERO' -'DEBUG-ITEM' Yes 'PICTURE X(n) USAGE - DISPLAY' -''LENGTH OF' phrase' Yes 'CONSTANT USAGE - BINARY-LONG' -'NUMBER-OF-CALL-PARAMETERS' Yes 'USAGE BINARY-LONG' -'RETURN-CODE' Yes 'GLOBAL USAGE BINARY-LONG - VALUE ZERO' -'SORT-RETURN' Yes 'GLOBAL USAGE BINARY-LONG - VALUE ZERO' -'TALLY' Yes 'GLOBAL PICTURE 9(5) USAGE - BINARY VALUE ZERO' -'WHEN-COMPILED' Yes 'CONSTANT PICTURE X(16) - USAGE DISPLAY' -'XML-CODE' Yes 'GLOBAL PICTURE S9(9) USAGE - BINARY VALUE 0' -'JSON-CODE' Yes 'GLOBAL PICTURE S9(9) USAGE - BINARY VALUE 0' - - -File: gnucobol.info, Node: Appendix C, Next: Appendix D, Prev: Appendix B, Up: Appendices - -Appendix C Intrinsic Functions -****************************** - -The following list of intrinsic functions was extracted from 'cobc ---list-intrinsics' and shows the names of the available functions, an -implementation note and the number of parameters. - -Intrinsic Function -Implemented Parameters ---------------------------------------------------------------------------- -'ABS Yes 1' -'ACOS Yes 1' -'ANNUITY Yes 2' -'ASIN Yes 1' -'ATAN Yes 1' -'BOOLEAN-OF-INTEGER No 2' -'BYTE-LENGTH Yes 1 - 2' -'CHAR Yes 1' -'CHAR-NATIONAL No 1' -'COMBINED-DATETIME Yes 2' -'CONCAT Yes Unlimited' -'CONCATENATE Yes Unlimited' -'CONTENT-LENGTH Yes 1' -'CONTENT-OF Yes 1 - 2' -'COS Yes 1' -'CURRENCY-SYMBOL Yes 0' -'CURRENT-DATE Yes 0' -'DATE-OF-INTEGER Yes 1' -'DATE-TO-YYYYMMDD Yes 1 - -3' -'DAY-OF-INTEGER Yes 1' -'DAY-TO-YYYYDDD Yes 1 - 3' -'DISPLAY-OF No 1 - 2' -'E Yes 0' -'EXCEPTION-FILE Yes 0' -'EXCEPTION-FILE-N No 0' -'EXCEPTION-LOCATION Yes 0' -'EXCEPTION-LOCATION-N No 0' -'EXCEPTION-STATEMENT Yes 0' -'EXCEPTION-STATUS Yes 0' -'EXP Yes 1' -'EXP10 Yes 1' -'FACTORIAL Yes 1' -'FORMATTED-CURRENT-DATE Yes -1' -'FORMATTED-DATE Yes 2' -'FORMATTED-DATETIME Yes 4 - -5' -'FORMATTED-TIME Yes 3 - 4' -'FRACTION-PART Yes 1' -'HIGHEST-ALGEBRAIC Yes 1' -'INTEGER Yes 1' -'INTEGER-OF-BOOLEAN No 1' -'INTEGER-OF-DATE Yes 1' -'INTEGER-OF-DAY Yes 1' -'INTEGER-OF-FORMATTED-DATE -Yes 2' -'INTEGER-PART Yes 1' -'LENGTH Yes 1 - 2' -'LENGTH-AN Yes 1' -'LOCALE-COMPARE Yes 2 - 3' -'LOCALE-DATE Yes 1 - 2' -'LOCALE-TIME Yes 1 - 2' -'LOCALE-TIME-FROM-SECONDS -Yes 1 - 2' -'LOG Yes 1' -'LOG10 Yes 1' -'LOWER-CASE Yes 1' -'LOWEST-ALGEBRAIC Yes 1' -'MAX Yes Unlimited' -'MEAN Yes Unlimited' -'MEDIAN Yes Unlimited' -'MIDRANGE Yes Unlimited' -'MIN Yes Unlimited' -'MOD Yes 2' -'MODULE-CALLER-ID Yes 0' -'MODULE-DATE Yes 0' -'MODULE-FORMATTED-DATE Yes -0' -'MODULE-ID Yes 0' -'MODULE-PATH Yes 0' -'MODULE-SOURCE Yes 0' -'MODULE-TIME Yes 0' -'MONETARY-DECIMAL-POINT Yes -0' -'MONETARY-THOUSANDS-SEPARATOR -Yes 0' -'NATIONAL-OF No 1 - 2' -'NUMERIC-DECIMAL-POINT Yes -0' -'NUMERIC-THOUSANDS-SEPARATOR -Yes 0' -'NUMVAL Yes 1' -'NUMVAL-C Yes 2' -'NUMVAL-F Yes 1' -'ORD Yes 1' -'ORD-MAX Yes Unlimited' -'ORD-MIN Yes Unlimited' -'PI Yes 0' -'PRESENT-VALUE Yes -Unlimited' -'RANDOM Yes 0 - 1' -'RANGE Yes Unlimited' -'REM Yes 2' -'REVERSE Yes 1' -'SECONDS-FROM-FORMATTED-TIME -Yes 2' -'SECONDS-PAST-MIDNIGHT Yes -0' -'SIGN Yes 1' -'SIN Yes 1' -'SQRT Yes 1' -'STANDARD-COMPARE No 2 - 4' -'STANDARD-DEVIATION Yes -Unlimited' -'STORED-CHAR-LENGTH Yes 1' -'SUBSTITUTE Yes Unlimited' -'SUBSTITUTE-CASE Yes -Unlimited' -'SUM Yes Unlimited' -'TAN Yes 1' -'TEST-DATE-YYYYMMDD Yes 1' -'TEST-DAY-YYYYDDD Yes 1' -'TEST-FORMATTED-DATETIME -Yes 2' -'TEST-NUMVAL Yes 1' -'TEST-NUMVAL-C Yes 2' -'TEST-NUMVAL-F Yes 1' -'TRIM Yes 1 - 2' -'UPPER-CASE Yes 1' -'VARIANCE Yes Unlimited' -'WHEN-COMPILED Yes 0' -'YEAR-TO-YYYY Yes 1 - 3' - - -File: gnucobol.info, Node: Appendix D, Next: Appendix E, Prev: Appendix C, Up: Appendices - -Appendix D System routines -************************** - -The following list of system routines was extracted from 'cobc ---list-system' and shows the names of the available system routines -along with the number of parameters. - -System routine Parameters ---------------------------------------------- -'SYSTEM' 1 -'CBL_AND' 3 -'CBL_ALARM_SOUND' 0 -'CBL_BELL_SOUND' 0 -'CBL_CHANGE_DIR' 1 -'CBL_CHECK_FILE_EXIST' 2 -'CBL_CLOSE_FILE' 1 -'CBL_COPY_FILE' 2 -'CBL_CREATE_DIR' 1 -'CBL_CREATE_FILE' 5 -'CBL_DELETE_DIR' 1 -'CBL_DELETE_FILE' 1 -'CBL_EQ' 3 -'CBL_ERROR_PROC' 2 -'CBL_EXIT_PROC' 2 -'CBL_FLUSH_FILE' 1 -'CBL_GET_CSR_POS' 1 -'CBL_GET_CURRENT_DIR' 3 -'CBL_GET_SCR_SIZE' 2 -'CBL_IMP' 3 -'CBL_NIMP' 3 -'CBL_NOR' 3 -'CBL_NOT' 2 -'CBL_OPEN_FILE' 5 -'CBL_OR' 3 -'CBL_READ_FILE' 5 -'CBL_READ_KBD_CHAR' 1 -'CBL_RENAME_FILE' 2 -'CBL_SET_CSR_POS' 1 -'CBL_TOLOWER' 2 -'CBL_TOUPPER' 2 -'CBL_WRITE_FILE' 5 -'CBL_XOR' 3 -'CBL_GC_FORK' 0 -'CBL_GC_GETOPT' 6 -'CBL_GC_HOSTED' 2 -'CBL_GC_NANOSLEEP' 1 -'CBL_GC_PRINTABLE' 1 - 2 -'CBL_GC_WAITPID' 1 -'CBL_OC_GETOPT' 6 -'CBL_OC_HOSTED' 2 -'CBL_OC_NANOSLEEP' 1 -'C$CALLEDBY' 1 -'C$CHDIR' 2 -'C$COPY' 3 -'C$DELETE' 2 -'C$FILEINFO' 2 -'C$GETPID' 0 -'C$JUSTIFY' 1 - 2 -'C$MAKEDIR' 1 -'C$NARG' 1 -'C$PARAMSIZE' 1 -'C$PRINTABLE' 1 - 2 -'C$SLEEP' 1 -'C$TOLOWER' 2 -'C$TOUPPER' 2 -'EXTFH' 2 -'X"91"' 3 -'X"E4"' 0 -'X"E5"' 0 -'X"F4"' 2 -'X"F5"' 2 - - -File: gnucobol.info, Node: Appendix E, Next: Appendix F, Prev: Appendix D, Up: Appendices - -Appendix E System names -*********************** - -The following list of system names was extracted from 'cobc ---list-mnemonics' and shows the system names categorized by their type. - -E.1 System names: device -======================== - -'SYSIN', 'SYSIPT', 'STDIN', 'SYSOUT', 'SYSLIST', 'SYSLST', 'SYSPCH', -'SYSPUNCH', 'STDOUT', 'PRINT', 'PRINTER', 'PRINTER-1', 'SYSERR', -'STDERR', 'CONSOLE' - -E.2 System names: feature -========================= - -'C01', 'C02', 'C03', 'C04', 'C05', 'C06', 'C07', 'C08', 'C09', 'C10', -'C11', 'C12', 'S01', 'S02', 'S03', 'S04', 'S05', 'CSP', 'FORMFEED', -'TOP', 'CALL-CONVENTION' - -E.3 System names: switch -======================== - -'SWITCH-0', 'SWITCH-1', 'SWITCH-2', 'SWITCH-3', 'SWITCH-4', 'SWITCH-5', -'SWITCH-6', 'SWITCH-7', 'SWITCH-8', 'SWITCH-9', 'SWITCH-10', -'SWITCH-11', 'SWITCH-12', 'SWITCH-13', 'SWITCH-14', 'SWITCH-15', -'SWITCH-16', 'SWITCH-17', 'SWITCH-18', 'SWITCH-19', 'SWITCH-20', -'SWITCH-21', 'SWITCH-22', 'SWITCH-23', 'SWITCH-24', 'SWITCH-25', -'SWITCH-26', 'SWITCH-27', 'SWITCH-28', 'SWITCH-29', 'SWITCH-30', -'SWITCH-31', 'SWITCH-32', 'SWITCH-33', 'SWITCH-34', 'SWITCH-35', -'SWITCH-36' - - -File: gnucobol.info, Node: Appendix F, Next: Appendix G, Prev: Appendix E, Up: Appendices - -Appendix F Compiler Configuration -********************************* - -The following list was extracted from 'config/default.conf'. - - - -# Value: any string -name: "GnuCOBOL" - -# Value: enum -standard-define 0 -# CB_STD_OC = 0, -# CB_STD_MF, -# CB_STD_IBM, -# CB_STD_MVS, -# CB_STD_BS2000, -# CB_STD_ACU, -# CB_STD_85, -# CB_STD_2002, -# CB_STD_2014 - -# Value: int -tab-width: 8 -text-column: 72 -# Maximum word-length for COBOL words / Programmer defined words -# Be aware that GC checks the word length against COB_MAX_WORDLEN -# first (currently 63) -word-length: 63 - -# Maximum literal size in general -literal-length: 8191 - -# Maximum numeric literal size (absolute maximum: 38) -numeric-literal-length: 38 - -# Maximum number of characters allowed in the character-string (max. 255) -pic-length: 255 - -# Default assign type -# Value: 'dynamic', 'external' -assign-clause: dynamic - -# If yes, file names are resolved at run time using -# environment variables. -# For example, given ASSIGN TO "DATAFILE", the file name will be -# 1. the value of environment variable 'DD_DATAFILE' or -# 2. the value of environment variable 'dd_DATAFILE' or -# 3. the value of environment variable 'DATAFILE' or -# 4. the literal "DATAFILE" -# If no, the value of the assign clause is the file name. -# -filename-mapping: yes - -# Alternate formatting of numeric fields -pretty-display: yes - -# Allow complex OCCURS DEPENDING ON -complex-odo: no - -# Allow REDEFINES to other than last equal level number -indirect-redefines: no - -# Binary byte size - defines the allocated bytes according to PIC -# Value: signed unsigned bytes -# ------ -------- ----- -# '2-4-8' 1 - 4 same 2 -# 5 - 9 same 4 -# 10 - 18 same 8 -# -# '1-2-4-8' 1 - 2 same 1 -# 3 - 4 same 2 -# 5 - 9 same 4 -# 10 - 18 same 8 -# -# '1--8' 1 - 2 1 - 2 1 -# 3 - 4 3 - 4 2 -# 5 - 6 5 - 7 3 -# 7 - 9 8 - 9 4 -# 10 - 11 10 - 12 5 -# 12 - 14 13 - 14 6 -# 15 - 16 15 - 16 7 -# 17 - 18 17 - 18 8 -# -binary-size: 1-2-4-8 - -# Numeric truncation according to ANSI -binary-truncate: yes - -# Binary byte order -# Value: 'native', 'big-endian' -binary-byteorder: big-endian - -# Allow larger REDEFINES items -larger-redefines-ok: no - -# Allow certain syntax variations (eg. REDEFINES position) -relax-syntax-checks: no - -# Perform type OSVS - If yes, the exit point of any currently -# executing perform is recognized if reached. -perform-osvs: no - -# Compute intermediate decimal results like IBM OSVS -arithmetic-osvs: no - -# MOVE like IBM (mvc); left to right, byte by byte -move-ibm: no - -# If yes, linkage-section items remain allocated -# between invocations. -sticky-linkage: no - -# If yes, allow non-matching level numbers -relax-level-hierarchy: no - -# If yes, evaluate constant expressions at compile time -constant-folding: yes - -# Allow Hex 'F' for NUMERIC test of signed PACKED DECIMAL field -hostsign: no - -# If yes, set WITH UPDATE clause as default for ACCEPT dest-item, -# except if WITH NO UPDATE clause is used -accept-update: no - -# If yes, set WITH AUTO clause as default for ACCEPT dest-item, -# except if WITH TAB clause is used -accept-auto: no - -# If yes, DISPLAYs and ACCEPTs are, by default, done on the CRT (i.e., using -# curses). -console-is-crt: no - -# If yes, allow redefinition of the current program's name. This prevents its -# use in a prototype-format CALL/CANCEL statement. -program-name-redefinition: yes - -# If yes, NO ECHO/NO-ECHO/OFF is the same as SECURE (hiding input with -# asterisks, not spaces). -no-echo-means-secure: no - -# If yes, the first item in a field screen ACCEPT/DISPLAY (e.g. DISPLAY x UPON -# CRT) is located after the previous ACCEPT/DISPLAY (as though LINE 0 COL 0 had -# been specified). -line-col-zero-default: yes - -# If yes, then REPORT, COLUMN may have any of PLUS num, + num, or +num -# to define a relative column position -# If no, then COLUMN +num is not accepted due to signed numeric -report-column-plus: yes - -# If yes, DISPLAY SPACES acts as ERASE EOS, DISPLAY X"01" acts as ERASE EOL, -# DISPLAY X"02" acts as BLANK SCREEEN and DISPLAY X"07" acts as BELL. Note -# DISPLAY LOW-VALUE is excluded from this; it will always just position the -# cursor. -display-special-fig-consts: no - -# If yes, COMP-1 is a signed 16-bit integer and any PICTURE clause is ignored. -binary-comp-1: no - -# auto-adjust to zero like MicroFocus does -move-non-numeric-lit-to-numeric-is-zero: no - -# If yes, implicitly define a variable for an ASSIGN DYNAMIC which does not -# match an existing data item. -implicit-assign-dynamic-var: yes - -# What rules to apply to SCREEN SECTION items clauses -screen-section-rules: gc - -# Dialect features -# Value: 'ok', 'warning', 'archaic', 'obsolete', 'skip', 'ignore', 'error', -# 'unconformable' - -alter-statement: obsolete -comment-paragraphs: obsolete -call-overflow: archaic -data-records-clause: obsolete -debugging-mode: ok -use-for-debugging: ok -listing-statements: skip # may be a user-defined word -title-statement: skip # may be a user-defined word -entry-statement: ok -goto-statement-without-name: obsolete -label-records-clause: obsolete -memory-size-clause: obsolete -move-noninteger-to-alphanumeric: error -move-figurative-constant-to-numeric: archaic -move-figurative-space-to-numeric: error -move-figurative-quote-to-numeric: obsolete -multiple-file-tape-clause: obsolete -next-sentence-phrase: archaic -odo-without-to: warning -padding-character-clause: obsolete -occurs-max-length-without-subscript: no -section-segments: ignore -stop-literal-statement: obsolete -stop-identifier-statement: obsolete -same-as-clause: ok -synchronized-clause: ok -sync-left-right: ok -special-names-clause: ok -top-level-occurs-clause: ok -value-of-clause: obsolete -numeric-boolean: ok -hexadecimal-boolean: ok -national-literals: ok -hexadecimal-national-literals: ok -national-character-literals: warning - -acu-literals: unconformable -hp-octal-literals: unconformable -word-continuation: warning -length-in-data-division: yes -depending-on-not-fixed: warning -not-exception-before-exception: ok -accept-display-extensions: ok -renames-uncommon-levels: ok -symbolic-constant: ok -constant-78: ok -constant-01: ok -perform-varying-without-by: ok -reference-out-of-declaratives: warning -# Is reference modification required to be within the single field -reference-bounds-check: warning -program-prototypes: ok -call-convention-mnemonic: ok -call-convention-linkage: ok -numeric-value-for-edited-item: ok -incorrect-conf-sec-order: ok -define-constant-directive: archaic -free-redefines-position: warning -records-mismatch-record-clause: warning -record-delimiter: ok -sequential-delimiters: ok -record-delim-with-fixed-recs: ok -missing-statement: warning -zero-length-literals: ok -xml-generate-extra-phrases: ok -continue-after: ok -goto-entry: warning -binary-sync-clause: ignore -nonnumeric-with-numeric-group-usage: ok -assign-variable: ok -assign-using-variable: ok -assign-ext-dyn: ok -assign-disk-from: ok -align-record: 0 -align-opt: no - -# use complete word list; synonyms and exceptions are specified below -reserved-words: default - -# not-reserved: -# Value: Word to be taken out of the reserved words list -not-reserved: TERMINAL -#not-reserved: TRANSACTION - -# reserved: -# Entries of the form word-1=word-2 define word-1 as an alias for default -# reserved word word-2. No spaces are allowed around the equal sign. -reserved: AUTO-SKIP=AUTO -reserved: AUTOTERMINATE=AUTO -reserved: BACKGROUND-COLOUR=BACKGROUND-COLOR -reserved: BEEP=BELL -reserved: BINARY-INT=BINARY-LONG -reserved: BINARY-LONG-LONG=BINARY-DOUBLE -reserved: CELLS=CELL -reserved: COLOURS=COLORS -reserved: EMPTY-CHECK=REQUIRED -reserved: EQUALS=EQUAL -reserved: FOREGROUND-COLOUR=FOREGROUND-COLOR -reserved: HIGH-VALUES=HIGH-VALUE -reserved: INITIALISE=INITIALIZE -reserved: INITIALISED=INITIALIZED -reserved: LENGTH-CHECK=FULL -reserved: LOW-VALUES=LOW-VALUE -reserved: ORGANISATION=ORGANIZATION -reserved: PIXELS=PIXEL -reserved: SYNCHRONISED=SYNCHRONIZED -reserved: TIMEOUT=TIME-OUT -reserved: VALUES=VALUE -reserved: ZEROES=ZERO -reserved: ZEROS=ZERO - - -File: gnucobol.info, Node: Appendix G, Next: Appendix H, Prev: Appendix F, Up: Appendices - -Appendix G Module loader 'cobcrun' options -****************************************** - -The following list of options was extracted from 'cobcrun --help' and -shows all available options for the module loader with a short -description. - -'-h, -help' - display this help and exit -'-V, -version' - display cobcrun and runtime version and exit -'-i, -info' - display runtime information (build/environment) -'-c FILE, -config=FILE' - set runtime configuration from FILE -'-r, -runtime-config' - display current runtime configuration (value and origin for all - settings) -'-M MODULE, -module=MODULE' - set entry point module name and/or load path where '-M' module - prepends any directory to the dynamic link loader library search - path and any basename to the module preload list - ('COB_LIBRARY_PATH' and/or 'COB_PRELOAD') - - -File: gnucobol.info, Node: Appendix H, Next: Appendix I, Prev: Appendix G, Up: Appendices - -Appendix H Runtime configuration -******************************** - -The following list was extracted from 'config/runtime.cfg'. - -H.1 General instructions -======================== - - - -The initial runtime.cfg file is found in the '$COB_CONFIG_DIR', which -defaults to 'installdir/gnucobol/config' (see 'cobcrun --info' for the -local path that is configured). The environment variable -'COB_RUNTIME_CONFIG' may define a different runtime configuration file -to read. -If settings are included in the runtime environment file multiple times -then the last setting value is used, no warning occurs. -Settings via environment variables always take precedence over settings -that are given in runtime configuration files. And the environment is -checked after completing processing of the runtime configuration file(s) - -All values set to string variables or environment variables are checked -for '${envvar}' and replacement is done at the time of the setting. You -can also specify a default value for the case that envvar is not set: -'${envvar:default}' (the format '${envvar:-default}' is supported, too). - -Any environment variable may be set with the directive 'setenv'. - - Example: 'setenv COB_LIBARAY_PATH ${LD_LIBRARY_PATH}' -Any environment variable may be unset with the directive 'unsetenv' (one -var per line). - - Example: 'unsetenv COB_LIBRARY_PATH' -Runtime configuration files can include other files with the directive -'include'. - - Example: 'include my-runtime-configuration-file' -To include another configuration file only if it is present use the -directive 'includeif'. You can also use '${envvar}' inside this. - - Example: 'includeif ${HOME}/mygc.cfg' -If you want to reset a parameter to its default value use 'reset -parametername'. -Most runtime variables have boolean values, some are switches, some have -string values, integer values (if not explicit noted: unsigned) and some -are size values. The boolean values will be evaluated as following: to -true: '1, Y, ON, YES, TRUE' (no matter of case) to false: '0, N, OFF' A -'size' value is an unsigned integer optionally followed by K, M, or G -for kilo, mega or giga. -For convenience a parameter in the runtime.cfg file may be defined by -using either the environment variable name or the parameter name. In -most cases the environment variable name is the parameter name (in upper -case) with the prefix 'COB_'. -For a complete list of the settings in use see 'cobcrun ---runtime-config'. -Note: If you want to *slightly* speed up a program's startup time, -remove all of the comments from the actual real configuration file that -is processed. - - -H.2 General environment -======================= - - - -Environment name: COB_DISABLE_WARNINGS - Parameter name: disable_warnings - Purpose: turn off runtime warning messages - Type: boolean - Default: false - Example: DISABLE_WARNINGS TRUE - -Environment name: COB_ENV_MANGLE - Parameter name: env_mangle - Purpose: names checked in the environment would get non alphanumeric - change to '_' - Type: boolean - Default: false - Example: ENV_MANGLE TRUE - -Environment name: COB_SET_DEBUG - Parameter name: debugging_mode - Purpose: to enable USE ON DEBUGGING procedures that were active - during compile-time because of WITH DEBUGGING MODE, - otherwise the code generated will be skipped - Type: boolean - Default: false - Example: COB_SET_DEBUG 1 - -Environment name: COB_SET_TRACE - Parameter name: set_trace - Purpose: to enable COBOL trace feature - Type: boolean - Default: false - Example: SET_TRACE TRUE - -Environment name: COB_TRACE_FILE - Parameter name: trace_file - Purpose: to define where COBOL trace output should go - Type: string : $$ is replaced by process id - Default: stderr - Example: TRACE_FILE ${HOME}/mytrace.$$ - -Environment name: COB_TRACE_FORMAT - Parameter name: trace_format - Purpose: to define format of COBOL trace output - Type: string - Default: "%P %S Line: %L" - %P is replaced by Program-Id/Function-Id minimal length 29 - with prefix - %I is replaced by Program-Id/Function-Id variable length, - without prefix - %L is replaced by Line number, right justified, length 6 - %S is replaced by statement type and name - %F is replaced by source file name - Example: TRACE_FORMAT "Line: %L %S" - Note: format of GC2.2 and older: - "PROGRAM-ID: %I Line: %L %S" - -Environment name: COB_TRACE_IO - Parameter name: trace_io - Purpose: define if I/O details should be added to trace - Type: boolean - Default: false - Example: TRACE_IO true - -Environment name: COB_DUMP_FILE - Parameter name: dump_file - Purpose: to define where COBOL dump output should go - Note: The -fdump=all compile option prepares for dump - Type: string : $$ is replaced by process id - Default: stderr - Example: DUMP_FILE ${HOME}/mytrace.log - -Environment name: COB_DUMP_WIDTH - Parameter name: dump_width - Purpose: to define COBOL dump line length - Type: integer - Default: 100 - Example: dump_width 120 - -Environment name: COB_STATS_RECORD - Parameter name: stats_record - Purpose: define if I/O statistics should be written - Type: boolean - Default: false - Example: STATS_RECORD true - -Environment name: COB_STATS_FILE - Parameter name: stats_file - Purpose: to define where COBOL I/O statistics should be written - The file is appended to - Type: string - Default: stderr - Example: STATS_FILE ${HOME}/mystats.txt - -Environment name: COB_CURRENT_DATE - Parameter name: current_date - Purpose: specify an alternate Date/Time to be returned to ACCEPT - clauses this is used for testing purposes or to tweak - a missing offset partial setting is allowed - Type: numeric string in format YYYYDDMMHH24MISS or date string - Default: the operating system date is used - Example: COB_CURRENT_DATE "2016/03/16 16:40:52" - current_date YYYYMMDDHHMMSS+01:00 - - - -H.3 Call environment -==================== - - - -Environment name: COB_LIBRARY_PATH - Parameter name: library_path - Purpose: paths for dynamically-loadable modules - Type: string - Note: the default paths .:/installpath/extras are always - added to the given paths - Example: LIBRARY_PATH /opt/myapp/test:/opt/myapp/production - -Environment name: COB_PRE_LOAD - Parameter name: pre_load - Purpose: modules that are loaded during startup, can be used - to CALL COBOL programs or C functions that are part - of a module library - Type: string - Note: the modules listed should NOT include extensions, the - runtime will use the right ones on the various platforms, - COB_LIBRARY_PATH is used to locate the modules - Example: PRE_LOAD COBOL_function_library:external_c_library - -Environment name: COB_LOAD_CASE - Parameter name: load_case - Purpose: resolve ALL called program names to UPPER or LOWER case - Type: Only use UPPER or LOWER - Default: if not set program names in CALL are case sensitive - Example: LOAD_CASE UPPER - -Environment name: COB_PHYSICAL_CANCEL - Parameter name: physical_cancel - Purpose: physically unload a dynamically-loadable module on CANCEL, - this frees some RAM and allows the change of modules during - run-time but needs more time to resolve CALLs (both to - active and not-active programs) - Alias: default_cancel_mode, LOGICAL_CANCELS (0 = yes) - Type: boolean (evaluated for true only) - Default: false - Example: PHYSICAL_CANCEL TRUE - - - -H.4 File I/O -============ - - - -Environment name: COB_MF_FILES - Parameter name: mf_files - Purpose: declare that sequential/relative files should be in - Micro Focus compatible format - Type: boolean (evaluated for true only) - Default: false - Example: mf_files True - -Environment name: COB_VARSEQ_FORMAT - Parameter name: varseq_format - Purpose: declare format to be used for variable length sequential files - Type: 0 means 2 byte record length (big-endian) plus 2 NULs precedes record - 1 means 4 byte record length (big-endian) precedes record - 2 means 4 byte record length (local machine int) precedes record - 3 means 2 byte record length (local machine short) precedes record - b32 means 'type 2' above but the 'int' is in Big-Endian format - l32 means 'type 2' above but the 'int' is in Little-Endian format - mf means create the file in Micro Focus compatible format - Default: 0 - Example: VARSEQ_FORMAT 1 - -Environment name: COB_VARREL_FORMAT - Parameter name: varrel_format - Purpose: declare format to be used for variable length relative files - Type: gc means 'size_t' record length (local machine) precedes - maxiumum length data record - mf means file is in Micro Focus format - b32 means Big-Endian 32-bit 'int' record length precedes data - b64 means Big-Endian 64-bit 'int' record length precedes data - l32 means Little-Endian 32-bit 'int' record length precedes data - l64 means Little-Endian 64-bit 'int' record length precedes data - Default: gc - NOTE: 'gc' results in files which cannot be used if copied between - machines of different hardware archeticture - Example: VARREL_FORMAT mf - -Environment name: COB_FIXREL_FORMAT - Parameter name: fixrel_format - Purpose: declare format to be used for fixed length relative - files (different types and lengths preceding each record) - Type: b32 means 4 byte record length (big-endian) - l32 means 4 byte record length (little-endian) - b64 means 8 byte record length (big-endian) - l64 means 8 byte record length (little-endian) - mf means Micro Focus default - gc means GnuCOBOL default (local 'size_t') - Default: gc fixed size with no record length prefix - Example: FIXREL_FORMAT B32 - -Environment name: COB_VARFIX_FORMAT - Parameter name: varfix_format - Purpose: declare format to be used for fixed length relative files - Type: gc means 'size_t' record length (local machine) precedes - fixed length data record - mf means file is in Micro Focus format - b32 means Big-Endian 32-bit 'int' record length precedes data - b64 means Big-Endian 64-bit 'int' record length precedes data - l32 means Little-Endian 32-bit 'int' record length precedes data - l64 means Little-Endian 64-bit 'int' record length precedes data - Default: gc - NOTE: 'gc' results in files which cannot be used if copied between - machines of different hardware archeticture - Example: VARFIX_FORMAT mf - -Environment name: COB_FILE_PATH - Parameter name: file_path - Purpose: define default location(s) where data files are stored - Type: file path directory list - Default: . (current directory) - Example: FILE_PATH ${HOME}/mydata - Unix/Linux list: FILE_PATH ${HOME}/mydata:${PROJECT}/datafiles - Windows list: FILE_PATH C:\proja\mydata;D:\projb\yourdata;. - -Environment name: COB_FILE_DICTIONARY - Parameter name: file_dictionary - Purpose: define when a file format description is written - is written to 'asgname.dd' - Type: false means never write - no means never write - true means write for BDB or LMDB only - min means write for BDB or LMDB only - always means write for all file types - max means write for all file types - Default: min - Example: file_dictionary always - -Environment name: COB_FILE_DICTIONARY_PATH - Parameter name: file_dictionary_path - Purpose: define where the 'asgname.dd' is written - Type: file path directory - Default: . (current directory) - Example: FILE_DICTIONARY_PATH ${HOME}/mystuff - -Environment name: COB_CREATE_TABLE - Parameter name: create_table - Purpose: For OCI/ODBC, if table is not defined and - there is no tablename.ddl present - should the CREATE TABLE be created at run time? - Type: false means the OPEN will fail - true means it will attempt to recreate the table definition - Default: false - Example: create_table true - -Environment name: COB_BDB_BYTEORDER - Parameter name: bdb_byteorder - Purpose: Defines the byte order to be used for BDB - Type: native - use the system byte order - big-endian - use big-endian order - little-endian - use little-endian order - Default: native - Example: bdb_byteorder big-endian - -Environment name: COB_LS_FIXED - Parameter name: ls_fixed - Purpose: Defines if LINE SEQUENTIAL files should be fixed length - (or variable, by removing trailing spaces) - Alias: STRIP_TRAILING_SPACES (0 = yes) - Type: boolean - Default: false - Example: LS_FIXED TRUE - -Environment name: COB_LS_NULLS - Parameter name: ls_nulls - Purpose: Defines for LINE SEQUENTIAL files what to do with data - which is not DISPLAY type. This could happen if a LINE - SEQUENTIAL record has BINARY/COMP data fields in it. - This option is only for GnuCOBOL format files - Type: boolean - Default: false - Note: The TRUE setting will handle files that contain COMP data - in a similar manner to the method used by Micro Focus - Example: LS_NULLS = TRUE - -Environment name: COB_LS_SPLIT - Parameter name: ls_split - Purpose: Defines for LINE SEQUENTIAL files what to do when a record - is longer than the program handles. If 'ls_split=true' then - the data is returned as multiple records - Type: boolean - Default: false - The record is truncated and the file skips to the next LF - Example: LS_SPLIT = TRUE - -Environment name: COB_LS_VALIDATE - Parameter name: ls_validate - Purpose: Defines for LINE SEQUENTIAL files that the data should be - validated. If any record has non-DISPLAY characters then - an error status of 34 is returned - This option is only for GnuCOBOL format files - Type: boolean - Default: true - Note: The TRUE setting does data validation - The FALSE setting lets non-DISPLAY characters be written - If LS_NULLS is set, then LS_VALIDATE is not checked - Example: LS_VALIDATE = FALSE - -Environment name: COB_MF_FILES - Parameter name: mf_files - Purpose: Declares that all files in the program should follow - Micro Focus format - Type: boolean - Default: false - Example: MF_FILES = TRUE - -Environment name: COB_MF_LS_NULLS - Parameter name: mf_ls_nulls - Purpose: Defines for Micro Focus compatible LINE SEQUENTIAL files - what to do with data which is not DISPLAY type. - This could happen if a LINE SEQUENTIAL record has - BINARY/COMP data fields in it. - Type: boolean - Default: true - Note: The TRUE setting will handle files that contain COMP data - in a similar manner to the method used by Micro Focus COBOL - Example: LS_NULLS = TRUE - -Environment name: COB_MF_LS_SPLIT - Parameter name: mf_ls_split - Purpose: Defines for Micro Focus compatible LINE SEQUENTIAL files what - to do when a record is longer than the program handles. - If 'mf_ls_split=true' then - the data is returned as multiple records - Type: boolean - Default: true - Example: MF_LS_SPLIT = FALSE - - Example: LS_SPLIT = TRUE -Environment name: COB_MF_LS_VALIDATE - Parameter name: mf_ls_validate - Purpose: Defines for Micro Focus compatible LINE SEQUENTIAL files - that the data should be validated. - If any record has non-DISPLAY characters then - an error status of 34 is returned - Type: boolean - Default: false - Note: The TRUE setting does data validation - The FALSE setting lets non-DISPLAY characters be written - If MF_LS_NULLS is set, then MF_LS_VALIDATE is not checked - Example: MF_LS_VALIDATE = FALSE - -Environment name: COB_SHARE_MODE - Parameter name: share_mode - Purpose: Defines what file sharing option should be used - Type: -- choice of values --- - none - nothing overrides application code - read - files opened as SHARE READ ONLY - all - files opened as SHARE ALL OTHERS - no - files opened as SHARE NO OTHERS - Default: none - Example: share_mode = ALL - -Environment name: COB_RETRY_MODE - Parameter name: retry_mode - Purpose: Defines what I/O retry sharing option should be used - Type: --- choice of values --- - none - nothing overrides application code - never - I/O is never retried - forever - I/O will be retried until success - Default: none - Example: retry_mode = never - -Environment name: COB_RETRY_TIMES - Parameter name: retry_times - Purpose: Defines how many times I/O should be retried - Type: integer - Default: 0 - Example: retry_times = 10 - -Environment name: COB_RETRY_SECONDS - Parameter name: retry_seconds - Purpose: Defines how many seconds I/O should be retried - Type: integer - Default: 0 - Example: retry_seconds = 6 - -Environment name: COB_KEYCHECK - Parameter name: keycheck - Purpose: Must INDEXED file keys match COBOL SELECT exactly - Type: boolean - Default: true - Example: keycheck = off - -Environment name: COB_SYNC - Parameter name: sync - Purpose: Should the file be synced to disk after each write/update - Type: boolean - Default: false - Example: SYNC: TRUE - -Environment name: COB_SORT_MEMORY - Parameter name: sort_memory - Purpose: Defines how much RAM to assign for sorting data - if this size is exceeded the SORT will be done - on disk instead of memory - Type: size but must be more than 1M - Default: 128M - Example: SORT_MEMORY 64M - -Environment name: COB_SORT_CHUNK - Parameter name: sort_chunk - Purpose: Defines how much RAM to assign for sorting data in chunks - Type: size but must be within 128K and 16M - Default: 256K - Example: SORT_CHUNK 1M - - - -H.5 Screen I/O -============== - - - -Environment name: COB_BELL - Parameter name: bell - Purpose: Defines how a request for the screen to beep is handled - Type: FLASH, SPEAKER, FALSE, BEEP - Default: BEEP - Example: BELL SPEAKER - -Environment name: COB_REDIRECT_DISPLAY - Parameter name: redirect_display - Purpose: Defines if DISPLAY output should be sent to 'stderr' - Type: boolean - Default: false - Example: redirect_display Yes - -Environment name: COB_SCREEN_ESC - Parameter name: screen_esc - Purpose: Enable handling of ESC key during ACCEPT - Type: boolean - Default: false - Note: is only evaluated if COB_SCREEN_EXCEPTIONS is active - Example: screen_esc Yes - -Environment name: COB_SCREEN_EXCEPTIONS - Parameter name: screen_exceptions - Purpose: enable exceptions for function keys during ACCEPT - Type: boolean - Default: false - Example: screen_exceptions Yes - -Environment name: COB_TIMEOUT_SCALE - Parameter name: timeout_scale - Purpose: specify translation in milliseconds for ACCEPT clauses - BEFORE TIME value / AFTER TIMEOUT - Type: integer - 0 means 1000 (Micro Focus COBOL compatible), 1 means 100 - (ACUCOBOL compatible), 2 means 10, 3 means 1 - Default: 0 - Note: the minimum and possible maximum value depend on the - screenio library used - Example: timeout_scale 3 - -Environment name: COB_INSERT_MODE - Parameter name: insert_mode - Purpose: specify default insert mode for ACCEPT; 0=off, 1=on - Type: boolean - Default: false - Note: also sets the cursor type (if available) - Example: insert_mode Y - -Environment name: COB_MOUSE_FLAGS - Parameter name: mouse_flags - Purpose: specify which mouse events will be sent as function key - to the application during ACCEPT and how they will be - handled - Type: int (by bits) - Default: 1 - Note: 0 disables the mouse cursor, any other value enables it, - any value containing 1 will enable internal handling (click - to position, double-click to enter). - See copy/screenio.cpy for list of events and their values. - Alias: MOUSE_FLAGS - Example: 11 (enable internal handling => 1, left press => 2, - double-click => 8; 1+2+8=11) - -Environment name: COB_MOUSE_INTERVAL - Parameter name: mouse_interval - Purpose: specifies the maximum time (in thousands of a second) - that can elapse between press and release events for them - to be recognized as a click. - Type: int (0 - 166) - Default: 100 - Note: 0 disables the click resolution (instead press + release - are recognized), also disables positioning by mouse click - -Environment name: COB_DISPLAY_PRINT_PIPE - Parameter name: display_print_pipe - Purpose: Defines command line used for sending output of - DISPLAY UPON PRINTER to (via pipe) - This is very similar to Micro Focus COBPRINTER - Note: Each executed DISPLAY UPON PRINTER statement causes a - new invocation of command-line (= new process start). - Each invocation receives the data referenced in - the DISPLAY statement and is followed by an - end-of-file condition. - COB_DISPLAY_PRINT_FILE, if set, takes precedence - over COB_DISPLAY_PRINT_PIPE. - Alias: COBPRINTER - Type: string - Default: not set - Example: print 'cat >>/tmp/myprt.log' - -Environment name: COB_DISPLAY_PRINT_FILE - Parameter name: display_print_file - Purpose: Defines file to be appended to by DISPLAY UPON PRINTER - Note: Each DISPLAY UPON PRINTER opens, appends and closes the file. - Type: string : $$ is replaced by process id - Default: not set - Example: display_printer '/tmp/myprt.log' - -Environment name: COB_DISPLAY_PUNCH_FILE - Parameter name: display_punch_file - Purpose: Defines file to be created on first - DISPLAY UPON SYSPUNCH/SYSPCH - Note: The file will be only be closed on runtime exit. - Type: string : $$ is replaced by process id - Default: not set - Example: display_punch './punch_$$.out' - -Environment name: COB_LEGACY - Parameter name: legacy - Purpose: keep behavior of former runtime versions, currently only - for setting screen attributes for non input fields - Type: boolean - Default: not set - Example: legacy true - -Environment name: COB_EXIT_WAIT - Parameter name: exit_wait - Purpose: to wait on main program exit if an extended screenio - DISPLAY was issued without an ACCEPT following - Type: boolean - Default: true - Example: COB_EXIT_WAIT off - -Environment name: COB_EXIT_MSG - Parameter name: exit_msg - Purpose: string to display if COB_EXIT_WAIT is processed, set to '' - if no actual display but an ACCEPT should be done - Type: string - Default: 'end of program, please press a key to exit' (localized) - Example: COB_EXIT_MSG '' - - - -H.6 Report I/O -============== - - - -Environment name: COB_COL_JUST_LRC - Parameter name: col_just_lrc - Purpose: If true, then COLUMN defined as LEFT, RIGHT or CENTER - will have the data justified within the field limits - If false, then the data is just copied into the column as is - Type: boolean - Default: TRUE - Example: col_just_lrc True - - - - -H.7 File I/O Environment Variables and/or dictionary file -========================================================= - - -Before a file is opened a check is done for environment variables that -may define various attributes of the file -First a check is made for attributes for files of the same ORGANIZATION -IX_OPTIONS for INDEXED, SQ_OPTIONS for SEQUENTIAL, RL_OPTIONS for RELATIVE -LS_OPTIONS for LINE SEQUENTIAL, LA_OPTIONS for LINE ADVANCING SEQUENTIAL -If none of these are present, it then checks for IO_OPTIONS - -Then an additional check is done for IO_asgnmame where 'asgname' was -the ASSIGN EXTERNAL name used in the program - -The environment variable (or dictionary file) may contain any of the -following keywords, separated by spaces and/or commas - -You can specify just the keyword and it is assumed to mean set to true, -or no-keyword (or no_keyword or nokeyword) which means set to false, -or keyword=true or keyword=false. The valid keywords are: -Keyword Meaning -========= ====================================================== -type=xx Set file organization where 'xx' is one of - IX = INDEXED, SQ = SEQUENTIAL, RL = RELATIVE - LS = LINE SEQUENTIAL, LA = LINE ADVANCING -mf Set file to Micro Focus compatible format -gc Set to original GNU Cobol default format -recsz The size for fixed size record file -maxsz Maximum record size for variable length records -minsz Minimum record size for variable length records -ls_nulls Do NUL insertion before characters less than a SPACE, - Default: false -ls_validate Validate data for LINE Sequential Files, Default: true -crlf Lines end with CR LF (Windows format for text files) -lf Lines end with LF (Unix format for text files) -sync Sync all writes to disk -B32 Use 32-bit Big-Endian format 'int' as record length -L32 Use 32-bit Little-Endian format 'int' as record length -B64 Use 64-bit Big-Endian format 'int' or 'size_t' as record length -L64 Use 64-bit Little-Endian format 'int' or 'size_t' as record length -trace Enable I/O trace when program execution tracing is enabled -stats Write I/O statistic information on file close -retry_times Default number of times to retry I/O -retry_seconds Number of seconds between I/O retry attempts -retry_forever Retry I/O forever -retry_never Never retry I/O operations -ignore_lock Ignore record locks -advancing_lock Advance to the next record if lock condition -share_all Share file with ALL others -share_read Share file for READ only -share_no Share file with NO others - ---- For INDEXED files ----- -format=ixhandler INDEXED file format: CISAM,DISAM,VBISAM,BDB,LMDB,OCI,ODBC -format=auto INDEXED file format is determined by inspecting the file -nkeys=n number of indexes -key1=(loc:len) loc (zero relative) of key, len of key -key2=(loc:len,loc:len ...) define composite index -dupn=Y index allows dups - ---- For INDEXED BDB files ----- -big_endian Set internal 'int' byte order to BIG ENDIAN -little_endian Set internal 'int' byte order to LITTLE ENDIAN - - - -File: gnucobol.info, Node: Appendix I, Prev: Appendix H, Up: Appendices - -Appendix I GNU Free Documentation License -***************************************** - - Version 1.3, 3 November 2008 - - Copyright (C) 2000, 2001, 2002, 2007, 2008 Free Software Foundation, Inc. - - - Everyone is permitted to copy and distribute verbatim copies - of this license document, but changing it is not allowed. - - 0. PREAMBLE - - The purpose of this License is to make a manual, textbook, or other - functional and useful document "free" in the sense of freedom: to - assure everyone the effective freedom to copy and redistribute it, - with or without modifying it, either commercially or - noncommercially. Secondarily, this License preserves for the - author and publisher a way to get credit for their work, while not - being considered responsible for modifications made by others. - - This License is a kind of "copyleft", which means that derivative - works of the document must themselves be free in the same sense. - It complements the GNU General Public License, which is a copyleft - license designed for free software. - - We have designed this License in order to use it for manuals for - free software, because free software needs free documentation: a - free program should come with manuals providing the same freedoms - that the software does. But this License is not limited to - software manuals; it can be used for any textual work, regardless - of subject matter or whether it is published as a printed book. We - recommend this License principally for works whose purpose is - instruction or reference. - - 1. APPLICABILITY AND DEFINITIONS - - This License applies to any manual or other work, in any medium, - that contains a notice placed by the copyright holder saying it can - be distributed under the terms of this License. Such a notice - grants a world-wide, royalty-free license, unlimited in duration, - to use that work under the conditions stated herein. The - "Document", below, refers to any such manual or work. Any member - of the public is a licensee, and is addressed as "you". You accept - the license if you copy, modify or distribute the work in a way - requiring permission under copyright law. - - A "Modified Version" of the Document means any work containing the - Document or a portion of it, either copied verbatim, or with - modifications and/or translated into another language. - - A "Secondary Section" is a named appendix or a front-matter section - of the Document that deals exclusively with the relationship of the - publishers or authors of the Document to the Document's overall - subject (or to related matters) and contains nothing that could - fall directly within that overall subject. (Thus, if the Document - is in part a textbook of mathematics, a Secondary Section may not - explain any mathematics.) The relationship could be a matter of - historical connection with the subject or with related matters, or - of legal, commercial, philosophical, ethical or political position - regarding them. - - The "Invariant Sections" are certain Secondary Sections whose - titles are designated, as being those of Invariant Sections, in the - notice that says that the Document is released under this License. - If a section does not fit the above definition of Secondary then it - is not allowed to be designated as Invariant. The Document may - contain zero Invariant Sections. If the Document does not identify - any Invariant Sections then there are none. - - The "Cover Texts" are certain short passages of text that are - listed, as Front-Cover Texts or Back-Cover Texts, in the notice - that says that the Document is released under this License. A - Front-Cover Text may be at most 5 words, and a Back-Cover Text may - be at most 25 words. - - A "Transparent" copy of the Document means a machine-readable copy, - represented in a format whose specification is available to the - general public, that is suitable for revising the document - straightforwardly with generic text editors or (for images composed - of pixels) generic paint programs or (for drawings) some widely - available drawing editor, and that is suitable for input to text - formatters or for automatic translation to a variety of formats - suitable for input to text formatters. A copy made in an otherwise - Transparent file format whose markup, or absence of markup, has - been arranged to thwart or discourage subsequent modification by - readers is not Transparent. An image format is not Transparent if - used for any substantial amount of text. A copy that is not - "Transparent" is called "Opaque". - - Examples of suitable formats for Transparent copies include plain - ASCII without markup, Texinfo input format, LaTeX input format, - SGML or XML using a publicly available DTD, and standard-conforming - simple HTML, PostScript or PDF designed for human modification. - Examples of transparent image formats include PNG, XCF and JPG. - Opaque formats include proprietary formats that can be read and - edited only by proprietary word processors, SGML or XML for which - the DTD and/or processing tools are not generally available, and - the machine-generated HTML, PostScript or PDF produced by some word - processors for output purposes only. - - The "Title Page" means, for a printed book, the title page itself, - plus such following pages as are needed to hold, legibly, the - material this License requires to appear in the title page. For - works in formats which do not have any title page as such, "Title - Page" means the text near the most prominent appearance of the - work's title, preceding the beginning of the body of the text. - - The "publisher" means any person or entity that distributes copies - of the Document to the public. - - A section "Entitled XYZ" means a named subunit of the Document - whose title either is precisely XYZ or contains XYZ in parentheses - following text that translates XYZ in another language. (Here XYZ - stands for a specific section name mentioned below, such as - "Acknowledgements", "Dedications", "Endorsements", or "History".) - To "Preserve the Title" of such a section when you modify the - Document means that it remains a section "Entitled XYZ" according - to this definition. - - The Document may include Warranty Disclaimers next to the notice - which states that this License applies to the Document. These - Warranty Disclaimers are considered to be included by reference in - this License, but only as regards disclaiming warranties: any other - implication that these Warranty Disclaimers may have is void and - has no effect on the meaning of this License. - - 2. VERBATIM COPYING - - You may copy and distribute the Document in any medium, either - commercially or noncommercially, provided that this License, the - copyright notices, and the license notice saying this License - applies to the Document are reproduced in all copies, and that you - add no other conditions whatsoever to those of this License. You - may not use technical measures to obstruct or control the reading - or further copying of the copies you make or distribute. However, - you may accept compensation in exchange for copies. If you - distribute a large enough number of copies you must also follow the - conditions in section 3. - - You may also lend copies, under the same conditions stated above, - and you may publicly display copies. - - 3. COPYING IN QUANTITY - - If you publish printed copies (or copies in media that commonly - have printed covers) of the Document, numbering more than 100, and - the Document's license notice requires Cover Texts, you must - enclose the copies in covers that carry, clearly and legibly, all - these Cover Texts: Front-Cover Texts on the front cover, and - Back-Cover Texts on the back cover. Both covers must also clearly - and legibly identify you as the publisher of these copies. The - front cover must present the full title with all words of the title - equally prominent and visible. You may add other material on the - covers in addition. Copying with changes limited to the covers, as - long as they preserve the title of the Document and satisfy these - conditions, can be treated as verbatim copying in other respects. - - If the required texts for either cover are too voluminous to fit - legibly, you should put the first ones listed (as many as fit - reasonably) on the actual cover, and continue the rest onto - adjacent pages. - - If you publish or distribute Opaque copies of the Document - numbering more than 100, you must either include a machine-readable - Transparent copy along with each Opaque copy, or state in or with - each Opaque copy a computer-network location from which the general - network-using public has access to download using public-standard - network protocols a complete Transparent copy of the Document, free - of added material. If you use the latter option, you must take - reasonably prudent steps, when you begin distribution of Opaque - copies in quantity, to ensure that this Transparent copy will - remain thus accessible at the stated location until at least one - year after the last time you distribute an Opaque copy (directly or - through your agents or retailers) of that edition to the public. - - It is requested, but not required, that you contact the authors of - the Document well before redistributing any large number of copies, - to give them a chance to provide you with an updated version of the - Document. - - 4. MODIFICATIONS - - You may copy and distribute a Modified Version of the Document - under the conditions of sections 2 and 3 above, provided that you - release the Modified Version under precisely this License, with the - Modified Version filling the role of the Document, thus licensing - distribution and modification of the Modified Version to whoever - possesses a copy of it. In addition, you must do these things in - the Modified Version: - - A. Use in the Title Page (and on the covers, if any) a title - distinct from that of the Document, and from those of previous - versions (which should, if there were any, be listed in the - History section of the Document). You may use the same title - as a previous version if the original publisher of that - version gives permission. - - B. List on the Title Page, as authors, one or more persons or - entities responsible for authorship of the modifications in - the Modified Version, together with at least five of the - principal authors of the Document (all of its principal - authors, if it has fewer than five), unless they release you - from this requirement. - - C. State on the Title page the name of the publisher of the - Modified Version, as the publisher. - - D. Preserve all the copyright notices of the Document. - - E. Add an appropriate copyright notice for your modifications - adjacent to the other copyright notices. - - F. Include, immediately after the copyright notices, a license - notice giving the public permission to use the Modified - Version under the terms of this License, in the form shown in - the Addendum below. - - G. Preserve in that license notice the full lists of Invariant - Sections and required Cover Texts given in the Document's - license notice. - - H. Include an unaltered copy of this License. - - I. Preserve the section Entitled "History", Preserve its Title, - and add to it an item stating at least the title, year, new - authors, and publisher of the Modified Version as given on the - Title Page. If there is no section Entitled "History" in the - Document, create one stating the title, year, authors, and - publisher of the Document as given on its Title Page, then add - an item describing the Modified Version as stated in the - previous sentence. - - J. Preserve the network location, if any, given in the Document - for public access to a Transparent copy of the Document, and - likewise the network locations given in the Document for - previous versions it was based on. These may be placed in the - "History" section. You may omit a network location for a work - that was published at least four years before the Document - itself, or if the original publisher of the version it refers - to gives permission. - - K. For any section Entitled "Acknowledgements" or "Dedications", - Preserve the Title of the section, and preserve in the section - all the substance and tone of each of the contributor - acknowledgements and/or dedications given therein. - - L. Preserve all the Invariant Sections of the Document, unaltered - in their text and in their titles. Section numbers or the - equivalent are not considered part of the section titles. - - M. Delete any section Entitled "Endorsements". Such a section - may not be included in the Modified Version. - - N. Do not retitle any existing section to be Entitled - "Endorsements" or to conflict in title with any Invariant - Section. - - O. Preserve any Warranty Disclaimers. - - If the Modified Version includes new front-matter sections or - appendices that qualify as Secondary Sections and contain no - material copied from the Document, you may at your option designate - some or all of these sections as invariant. To do this, add their - titles to the list of Invariant Sections in the Modified Version's - license notice. These titles must be distinct from any other - section titles. - - You may add a section Entitled "Endorsements", provided it contains - nothing but endorsements of your Modified Version by various - parties--for example, statements of peer review or that the text - has been approved by an organization as the authoritative - definition of a standard. - - You may add a passage of up to five words as a Front-Cover Text, - and a passage of up to 25 words as a Back-Cover Text, to the end of - the list of Cover Texts in the Modified Version. Only one passage - of Front-Cover Text and one of Back-Cover Text may be added by (or - through arrangements made by) any one entity. If the Document - already includes a cover text for the same cover, previously added - by you or by arrangement made by the same entity you are acting on - behalf of, you may not add another; but you may replace the old - one, on explicit permission from the previous publisher that added - the old one. - - The author(s) and publisher(s) of the Document do not by this - License give permission to use their names for publicity for or to - assert or imply endorsement of any Modified Version. - - 5. COMBINING DOCUMENTS - - You may combine the Document with other documents released under - this License, under the terms defined in section 4 above for - modified versions, provided that you include in the combination all - of the Invariant Sections of all of the original documents, - unmodified, and list them all as Invariant Sections of your - combined work in its license notice, and that you preserve all - their Warranty Disclaimers. - - The combined work need only contain one copy of this License, and - multiple identical Invariant Sections may be replaced with a single - copy. If there are multiple Invariant Sections with the same name - but different contents, make the title of each such section unique - by adding at the end of it, in parentheses, the name of the - original author or publisher of that section if known, or else a - unique number. Make the same adjustment to the section titles in - the list of Invariant Sections in the license notice of the - combined work. - - In the combination, you must combine any sections Entitled - "History" in the various original documents, forming one section - Entitled "History"; likewise combine any sections Entitled - "Acknowledgements", and any sections Entitled "Dedications". You - must delete all sections Entitled "Endorsements." - - 6. COLLECTIONS OF DOCUMENTS - - You may make a collection consisting of the Document and other - documents released under this License, and replace the individual - copies of this License in the various documents with a single copy - that is included in the collection, provided that you follow the - rules of this License for verbatim copying of each of the documents - in all other respects. - - You may extract a single document from such a collection, and - distribute it individually under this License, provided you insert - a copy of this License into the extracted document, and follow this - License in all other respects regarding verbatim copying of that - document. - - 7. AGGREGATION WITH INDEPENDENT WORKS - - A compilation of the Document or its derivatives with other - separate and independent documents or works, in or on a volume of a - storage or distribution medium, is called an "aggregate" if the - copyright resulting from the compilation is not used to limit the - legal rights of the compilation's users beyond what the individual - works permit. When the Document is included in an aggregate, this - License does not apply to the other works in the aggregate which - are not themselves derivative works of the Document. - - If the Cover Text requirement of section 3 is applicable to these - copies of the Document, then if the Document is less than one half - of the entire aggregate, the Document's Cover Texts may be placed - on covers that bracket the Document within the aggregate, or the - electronic equivalent of covers if the Document is in electronic - form. Otherwise they must appear on printed covers that bracket - the whole aggregate. - - 8. TRANSLATION - - Translation is considered a kind of modification, so you may - distribute translations of the Document under the terms of section - 4. Replacing Invariant Sections with translations requires special - permission from their copyright holders, but you may include - translations of some or all Invariant Sections in addition to the - original versions of these Invariant Sections. You may include a - translation of this License, and all the license notices in the - Document, and any Warranty Disclaimers, provided that you also - include the original English version of this License and the - original versions of those notices and disclaimers. In case of a - disagreement between the translation and the original version of - this License or a notice or disclaimer, the original version will - prevail. - - If a section in the Document is Entitled "Acknowledgements", - "Dedications", or "History", the requirement (section 4) to - Preserve its Title (section 1) will typically require changing the - actual title. - - 9. TERMINATION - - You may not copy, modify, sublicense, or distribute the Document - except as expressly provided under this License. Any attempt - otherwise to copy, modify, sublicense, or distribute it is void, - and will automatically terminate your rights under this License. - - However, if you cease all violation of this License, then your - license from a particular copyright holder is reinstated (a) - provisionally, unless and until the copyright holder explicitly and - finally terminates your license, and (b) permanently, if the - copyright holder fails to notify you of the violation by some - reasonable means prior to 60 days after the cessation. - - Moreover, your license from a particular copyright holder is - reinstated permanently if the copyright holder notifies you of the - violation by some reasonable means, this is the first time you have - received notice of violation of this License (for any work) from - that copyright holder, and you cure the violation prior to 30 days - after your receipt of the notice. - - Termination of your rights under this section does not terminate - the licenses of parties who have received copies or rights from you - under this License. If your rights have been terminated and not - permanently reinstated, receipt of a copy of some or all of the - same material does not give you any rights to use it. - - 10. FUTURE REVISIONS OF THIS LICENSE - - The Free Software Foundation may publish new, revised versions of - the GNU Free Documentation License from time to time. Such new - versions will be similar in spirit to the present version, but may - differ in detail to address new problems or concerns. See - . - - Each version of the License is given a distinguishing version - number. If the Document specifies that a particular numbered - version of this License "or any later version" applies to it, you - have the option of following the terms and conditions either of - that specified version or of any later version that has been - published (not as a draft) by the Free Software Foundation. If the - Document does not specify a version number of this License, you may - choose any version ever published (not as a draft) by the Free - Software Foundation. If the Document specifies that a proxy can - decide which future versions of this License can be used, that - proxy's public statement of acceptance of a version permanently - authorizes you to choose that version for the Document. - - 11. RELICENSING - - "Massive Multiauthor Collaboration Site" (or "MMC Site") means any - World Wide Web server that publishes copyrightable works and also - provides prominent facilities for anybody to edit those works. A - public wiki that anybody can edit is an example of such a server. - A "Massive Multiauthor Collaboration" (or "MMC") contained in the - site means any set of copyrightable works thus published on the MMC - site. - - "CC-BY-SA" means the Creative Commons Attribution-Share Alike 3.0 - license published by Creative Commons Corporation, a not-for-profit - corporation with a principal place of business in San Francisco, - California, as well as future copyleft versions of that license - published by that same organization. - - "Incorporate" means to publish or republish a Document, in whole or - in part, as part of another Document. - - An MMC is "eligible for relicensing" if it is licensed under this - License, and if all works that were first published under this - License somewhere other than this MMC, and subsequently - incorporated in whole or in part into the MMC, (1) had no cover - texts or invariant sections, and (2) were thus incorporated prior - to November 1, 2008. - - The operator of an MMC Site may republish an MMC contained in the - site under CC-BY-SA on the same site at any time before August 1, - 2009, provided the MMC is eligible for relicensing. - -ADDENDUM: How to use this License for your documents -==================================================== - -To use this License in a document you have written, include a copy of -the License in the document and put the following copyright and license -notices just after the title page: - - Copyright (C) YEAR YOUR NAME. - Permission is granted to copy, distribute and/or modify this document - under the terms of the GNU Free Documentation License, Version 1.3 - or any later version published by the Free Software Foundation; - with no Invariant Sections, no Front-Cover Texts, and no Back-Cover - Texts. A copy of the license is included in the section entitled ``GNU - Free Documentation License''. - - If you have Invariant Sections, Front-Cover Texts and Back-Cover -Texts, replace the "with...Texts." line with this: - - with the Invariant Sections being LIST THEIR TITLES, with - the Front-Cover Texts being LIST, and with the Back-Cover Texts - being LIST. - - If you have Invariant Sections without Cover Texts, or some other -combination of the three, merge those two alternatives to suit the -situation. - - If your document contains nontrivial examples of program code, we -recommend releasing these examples in parallel under your choice of free -software license, such as the GNU General Public License, to permit -their use in free software. - - - -Tag Table: -Node: Top1118 -Node: Getting started4569 -Node: Hello world!4747 -Node: Compile6175 -Node: Compiler options6533 -Node: Help options7277 -Ref: Help options-Footnote-18879 -Node: Build target8923 -Ref: Build target-Footnote-111430 -Node: Source format11483 -Ref: Source format-Footnote-112270 -Node: Warning options12344 -Node: Configuration options13900 -Node: Listing options16700 -Node: Debug switches21492 -Node: Miscellaneous22557 -Node: Multiple sources23731 -Node: Static linking24371 -Node: Dynamic linking25846 -Ref: Dynamic linking-Footnote-127456 -Ref: Dynamic linking-Footnote-227517 -Node: Building library27578 -Node: Using library27961 -Node: C interface28532 -Node: Main C program28906 -Node: Static C to COBOL30063 -Node: Dynamic C to COBOL31770 -Node: Static COBOL to C33293 -Node: Dynamic COBOL to C34729 -Node: Interface functions for C35172 -Node: Customize36605 -Node: Customizing compiler36829 -Node: Customizing library37397 -Node: Optimize38157 -Node: Optimize options38460 -Node: Optimize call38990 -Node: Optimize binary39370 -Node: Debug39946 -Node: Debug options40102 -Node: Extensions40431 -Node: SELECT41023 -Node: Indexed41774 -Node: Extended ACCEPT41954 -Node: ACCEPT special46139 -Node: Extended DISPLAY48665 -Node: FUNCTION CONTENT-LENGTH51175 -Node: FUNCTION CONTENT-OF51844 -Node: System Routines52713 -Node: CBL_GC_GETOPT53246 -Node: CBL_GC_HOSTED57417 -Node: CBL_GC_NANOSLEEP61942 -Node: CBL_GC_FORK62466 -Node: CBL_GC_WAITPID65469 -Node: Appendices66126 -Node: Appendix A66696 -Node: Appendix B84807 -Node: Appendix C123845 -Node: Appendix D126693 -Node: Appendix E129098 -Node: Appendix F130322 -Node: Appendix G138861 -Node: Appendix H139805 -Node: Appendix I169241 - -End Tag Table Binary files /tmp/tmp8r0303vl/MzBWgGBJBM/gnucobol-4.0~early~20200606/doc/gnucobol.pdf and /tmp/tmp8r0303vl/cieYbammgl/gnucobol-5/doc/gnucobol.pdf differ diff -Nru gnucobol-4.0~early~20200606/doc/gnucobol.texi gnucobol-5/doc/gnucobol.texi --- gnucobol-4.0~early~20200606/doc/gnucobol.texi 2020-06-06 20:52:02.000000000 +0000 +++ gnucobol-5/doc/gnucobol.texi 1970-01-01 00:00:00.000000000 +0000 @@ -1,2332 +0,0 @@ -\input texinfo -@setfilename gnucobol.info -@settitle GnuCOBOL Manual -@setchapternewpage on -@footnotestyle end - -@afourpaper - -@include version.texi - -@copying -Permission is granted to make and distribute verbatim copies of this -manual provided the copyright notice and this permission notice are -preserved on all copies. -@sp 1 - -@ignore -Permission is granted to process this file through TeX and print the -results, provided the printed document carries a copying permission -notice identical to this one except for the removal of this paragraph -(this paragraph not being relevant to the printed manual). -@end ignore - -Permission is granted to copy and distribute modified versions of this -manual under the conditions for verbatim copying, provided that the -entire resulting derived work is distributed under the terms of a -permission notice identical to this one. -@sp 1 -Permission is granted to copy and distribute translations of this manual -into another language, under the above conditions for modified versions, -except that this permission notice may be stated in a translation -approved by the Free Software Foundation. -@end copying - -@ifinfo -@dircategory Software development -@direntry -* cobc: (gnucobol)Compile. The GnuCOBOL compiler. -@end direntry -@dircategory COBOL -@direntry -* GnuCOBOL: (gnucobol). A COBOL compiler -@end direntry -@dircategory GnuCOBOL -@direntry -* Overview: (gnucobol). COBOL compiler overview. -@end direntry - -@end ifinfo - -@titlepage -@title GnuCOBOL Manual -@subtitle for GnuCOBOL @value{VERSION} -@author Keisuke Nishida, Roger While, Brian Tiffin, Simon Sobisch - -Edition @value{EDITION} @* -Updated for GnuCOBOL @value{VERSION} @* -@value{UPDATED} @* - -GnuCOBOL (formerly OpenCOBOL) is a free COBOL compiler and runtime. -@command{cobc} translates COBOL source to executable using intermediate C -together with a designated C compiler and linker. -@command{cobcrun} is a module loader to run generated modules, -@code{libcob} provides the necessary runtime. -@sp 2 -This manual corresponds to GnuCOBOL @value{VERSION}. -@page -@vskip 0pt plus 1filll -Copyright @copyright{} 2002-2012, 2014-2019 Free Software Foundation, Inc.@* -Written by Keisuke Nishida, Roger While, Brian Tiffin, Simon Sobisch. - -@insertcopying -@sp 2 -@end titlepage - -@contents - -@node Top - -@ifinfo -Welcome to the GnuCOBOL @value{VERSION} manual. -@end ifinfo - -@menu -* Getting started:: Introduction to GnuCOBOL -* Compile:: Compiling COBOL programs -* Customize:: Customizing the compiler -* Optimize:: Optimizing your program -* Debug:: Debugging your program -* Extensions:: Non-standard extensions -* System Routines:: Additional routines -* Appendices:: List of supported features and options, - Compiler and Runtime Configuration, - Documentation License -@ignore -* Index:: Index -@end ignore - - -@detailmenu - --- The Detailed Node Listing --- - -Getting started - -* Hello world!:: Hello, world! - -Compile - -* Compiler options:: Compiler options -* Multiple sources:: Compiling multiple source files -* C interface:: Dealing with C files - -Compiler options - -* Help options:: Help options -* Build target:: Build target -* Source format:: Source format -* Warning options:: Warning options -* Configuration options:: Configuration options -* Listing options:: Listing options -* Debug switches:: Debug switches -* Miscellaneous:: Miscellaneous - -Multiple sources - -* Static linking:: Compiling into a single executable -* Dynamic linking:: A main program and separate modules -* Building library:: Building a shared library -* Using library:: Using external libraries - -C interface - -* Main C program:: Writing main program in C -* Static C to COBOL:: -* Dynamic C to COBOL:: -* Static COBOL to C:: -* Dynamic COBOL to C:: - -Customize - -* Customizing compiler:: Customizing compiler -* Customizing library:: Customizing library - -Optimize - -* Optimize options:: How to enable optimization -* Optimize call:: Call subroutines efficiently -* Optimize binary:: Use efficient binary representation - -Debug - -* Debug options:: Debug options - -Extensions - -* SELECT:: SELECT ASSIGN TO. -* Indexed:: Indexed file packages. -* Extended ACCEPT:: Extended ACCEPT statement. -* ACCEPT special:: ACCEPT special keys. -* Extended DISPLAY:: Extended DISPLAY statement. -* FUNCTION CONTENT-LENGTH:: Length of NUL byte terminated pointer data. -* FUNCTION CONTENT-OF:: Content of data at pointer, by length or NUL. - -System Routines - -* CBL_GC_GETOPT GETOPT for Cobol -* CBL_GC_HOSTED Access to C hosted variables -* CBL_GC_NANOSLEEP Sleep for nanoseconds -* CBL_GC_FORK Fork the current COBOL process to a new one -* CBL_GC_WAITPID Wait for a system process to end - -Appendices - -* Appendix A Compiler @command{cobc} options -* Appendix B Reserved Words -* Appendix C Intrinsic Functions -* Appendix D System routines -* Appendix E System names -* Appendix F Compiler Configuration -* Appendix G Module loader @command{cobcrun} options -* Appendix H Runtime configuration -* Appendix I GNU Free Documentation License - -@end detailmenu -@end menu - -@node Getting started, Compile, Top, Top -@chapter Getting started - -@menu -* Hello world!:: Hello, world! -@end menu - -@node Hello world! -@section Hello, world! - -This is a sample program that displays ``Hello, world!'': - -@example ----- hello.cob ------------------------- - * Sample COBOL program - IDENTIFICATION DIVISION. - PROGRAM-ID. hello. - PROCEDURE DIVISION. - DISPLAY "Hello, world!". - STOP RUN. ----------------------------------------- -@end example - -@*The compiler, @command{cobc}, is executed as follows: - -@example -$ cobc -x hello.cob -$ ./hello -Hello, world! -@end example - -@*The executable file name (@file{hello} in this case) is -determined by removing the extension from the source file name. - -@*You can specify the executable file name by specifying the compiler -option @option{-o} as follows: - -@example -$ cobc -x -o hello-world hello.cob -$ ./hello-world -Hello, world! -@end example - -@*The program can be written in a more modern style, with free format code, -inline comments, the @code{GOBACK} verb and an optional @code{END-DISPLAY} terminator: - -@example ----- hellonew.cob ---------------- -*> Sample GnuCOBOL program -identification division. -program-id. hellonew. -procedure division. -display - "Hello, new world!" -end-display -goback. ----------------------------------- -@end example - -To compile free-format code, you must use the compiler option @option{-free}. - -@example -$ cobc -x -free hellonew.cob -$ ./hellonew -Hello, new world! -@end example - -@node Compile, Customize, Getting started, Top -@chapter Compile -@cindex Invoking - -This chapter describes how to compile COBOL programs using GnuCOBOL. - -@menu -* Compiler options:: Compiler options -* Multiple sources:: Compiling multiple source files -* C interface:: Dealing with C files -@end menu - -@node Compiler options -@section Compiler options - -The compiler @code{cobc} accepts the options described in this section. -The compiler arguments follow the general syntax @code{cobc @var{options} -@var{file} [@var{file} @dots{}]}. -A complete list of options can be displayed by using the option @option{--help}. - -@menu -* Help options:: Help options -* Build target:: Build target -* Source format:: Source format -* Warning options:: Warning options -* Configuration options:: Configuration options -* Listing options:: Listing options -* Debug switches:: Debug switches -* Miscellaneous:: Miscellaneous -@end menu - -@node Help options -@subsection Help options - -The following switches display information about the compiler: - -@table @code -@item --help, -h -Display help screen (@pxref{Appendix A}). -No further actions will be taken. - -@item --version -Display compiler version, author package date and executable build -date. @option{-V} will also display version. No further actions will be taken. - -@item --info -Display build information along with the default and current compiler -configurations. No further actions will be taken except for further display options. - -@item -v -Verbosely display the programs invoked during compilation. - -@item --list-reserved -Display reserved words (@pxref{Appendix B}). -A Yes/No output shows if the word is supported -@footnote{Support may be partial or complete.}, context sensitive and its aliases. -The given options for reserved words specified for example by -option @option{-std=@var{dialect}} will be taken into account. -No further actions will be taken except for further display options. - -@item --list-intrinsics -Display intrinsic functions (@pxref{Appendix C}). -A Y/N field shows if the function is implemented. -No further actions will be taken except for further display options. - -@item --list-system -Display system routines (@pxref{Appendix D}). -No further actions will be taken except for further display options. - -@item --list-mnemonics -Display mnemonic names (@pxref{Appendix E}). -No further actions will be taken except for further display options. - -@end table - -@node Build target -@subsection Build target - -The compiler @command{cobc} treats files like @file{*.cob}, @file{*.cbl} as -COBOL source code, @file{*.c} as C source code, @file{*.o} as -object code, @file{*.i} as preprocessed code and @file{*.so} -as dynamic modules and knows how to handle such files in the generation, -compilation, and linking steps. - -The special input name @file{-} takes input from @file{stdin} which is -assumed to be COBOL source, and uses a default output name of -@file{a.out} (or @file{a.so/c/o/i}, selected as appropriate) for the build type. - -By default, the compiler builds a dynamically loadable module. - -The following options specify the target type produced by the compiler: - -@table @code -@item -E -Preprocess only: compiler directives are executed, comment lines are -removed and @code{COPY} statements are expanded. -The output is saved in file @file{*.i}. - -@item -C -Translation only. COBOL source files are translated into C files. -The output is saved in file @file{*.c}. - -@item -S -Compile only. Translated C files are compiled by the C compiler -to assembler code. The output is saved in file @file{*.s}. - -@item -c -Compile and assemble. This is equivalent to @code{cc -c}. -The output is saved in file @file{*.o}. - -@item -m -Compile, assemble, and build a dynamically loadable module (i.e., -a shared library). The output is saved in file @file{*.so}. -@footnote{The extension varies depending on your host.} -This is the default behaviour. - -@item -b -Compile, assemble, and combine all input files into a single -dynamically loadable module. Unless @option{-o} is also used, -the output is saved using the first filename as @file{*.so}. - -@item -x -Include the main function in the output, creating an executable -image. The main entry point being the first program in the file. - -This option takes effect at the translation stage. -If you give this option with @option{-C}, you will see the main -function at the end of the generated C file. - -@item -j, -job, -j=@var{args}, -job=@var{args} -Run job after compilation. Either from executable with @option{-x}, or with -@command{cobcrun} when compiling a module. Optional arguments @var{args}, -if given, are passed to the program or module command line. - -@item -I @var{directory} -Add @var{directory} to copy/include search path. - -@item -L @var{directory} -Add @var{directory} to library search path. - -@item -l @var{lib} -Link the library @var{lib}. - -@item -D @var{define} -Pass @var{define} to the COBOL compiler. - -@item -o @var{file} -Place the output into @var{file}. - -@end table - -@node Source format -@subsection Source format - -GnuCOBOL supports both fixed and free source format. -The default format is the fixed format. -This can be overridden either by the -@code{>>SOURCE [FORMAT] [IS] @{FIXED|FREE@}} directive, -or by one of the following options: - -@table @code -@item -free, -F -Free format. The program-text area starts in column 1 and -continues till the end of line (effectively 255 characters -in GnuCOBOL). - -@item -fixed -Fixed format. Source code is divided into: columns 1-6, the sequence -number area; column 7, the indicator area; columns 8-72, the program-text -area; and columns 72-80 as the reference area.@footnote{Historically, fixed -format was based on 80-character punch cards.} - -@end table - -@node Warning options -@subsection Warning options - -@table @code -@item -W -Enable every possible warning. This includes more information -than @option{-Wall} would normally provide. - -@item -Wall -Enable all common warnings. - -@item -W@var{warning} -Enable single warning @var{warning}. - -@item -Wno-@var{warning} -Disable single warning @var{warning}. - -@item -Warchaic -Warn if archaic features are used, such as continuation lines or the @code{NEXT SENTENCE} statement. - -@item -Wcall-params -Warn if non-01/77-level items are used as arguments in a @code{CALL} statement. This is @emph{not} set with @option{-Wall}. - -@item -Wcolumn-overflow -Warn if text after column 72 in FIXED format. This is @emph{not} set with @option{-Wall}. - -@item -Wconstant -@comment{TODO: Clarify!} -Warn inconsistent constant - -@item -Wimplicit-define -Warn if implicitly defined data items are used. - -@item -Wlinkage -@comment{TODO: Define "dangling".} -Warn dangling @code{LINKAGE} items. This is @emph{not} set with @option{-Wall}. - -@item -Wobsolete -Warn if obsolete features are used. - -@item -Wparentheses -Warn about any lack of parentheses around @code{AND} within @code{OR}. - -@item -Wredefinition -Warn about incompatible redefinitions of data items. - -@item -Wstrict-typing -Warn about type mismatch strictly. - -@item -Wterminator -Warn about the lack of scope terminator END-XXX. This is @emph{not} set with @option{-Wall}. - -@item -Wtruncate -Warn on possible field truncation. This is @emph{not} set with @option{-Wall}. - -@item -Wunreachable -Warn if statements are unreachable. This is @emph{not} set with @option{-Wall}. -@end table - -@node Configuration options -@subsection Configuration options - -@table @code -@item -std=@var{dialect} -Compiler uses the given @var{dialect} to determine certain compiler features -and warnings.@* -@xref{Appendix F, Compiler Configuration, Compiler Configuration}, and @file{config/*.conf}.@* -Note: The GnuCOBOL compiler tries to limit both the feature-set and reserved words -to the specified compiler when the "strict" dialects are used. -COBOL sources compiled with these dialects are therefore likely to compile with -the specified compiler and vice versa: sources that were compiled on the -specified compiler should compile without any issues with GnuCOBOL.@* -With the "non-strict" dialects GnuCOBOL will activate the complete feature-set -where it doesn't directly conflict with the specified dialect, including reserved words. -COBOL sources compiled with these dialects therefore may work only with GnuCOBOL. -COBOL sources may need a change because of reserved words in GnuCOBOL, otherwise -offending words @var{word-1} and @var{word-2} may be removed by -@option{-fno-reserved=@var{word-1},@var{word-1}}.@* - -COBOL-85, X/Open COBOL, @w{COBOL 2002} and @w{COBOL 2014} are always "strict". - -@item -std=default -GnuCOBOL dialect, supporting many of the @w{COBOL 2002} and @w{COBOL 2014} features, -many extensions found in other dialects and its own feature-set - -@item -std=cobol85 -COBOL-85 without any extensions other than the amendment Intrinsic Function -Module (1989), source compiled with this dialect is likely to compile with -most COBOL compilers - -@item -std=xopen -X/Open COBOL (based on COBOL-85) without any vendor extensions, source compiled -with this dialect is likely to compile with most COBOL compilers; will warn -items that "should not be used in a conforming @w{X/Open COBOL} source program" - -@item -std=cobol2002, -std=cobol2014 -@w{COBOL 2002} / @w{COBOL 2014} without any vendor extensions, use @option{-Warchaic} -and @option{-Wobsolete} if archaic/obsolete features should be flagged - -@item -std=ibm-strict, -std=ibm -IBM compatible - -@item -std=mvs-strict, -std=mvs -MVS compatible - -@item -std=mf-strict, -std=mf -Micro Focus compatible - -@item -std=bs2000-strict, -std=bs2000 -BS2000 compatible - -@item -std=acu-strict, -std=acu -ACUCOBOL-GT compatible - -@item -std=rm-strict, -std=rm -RM/COBOL compatible - -@item -conf= -User-defined dialect configuration. See @option{-std=@var{dialect}} above.@* - -@end table - -You can override each single configuration entry by using compiler configuration -options on the command line. - -Examples: - -@table @code -@item -frelax-syntax-checks -@item -frenames-uncommon-levels=warning -@item -fnot-reserved=CHAIN,SCREEN -@item -ftab-width=4 -@end table -@xref{Appendix A, Compiler @command{cobc} options, Compiler @command{cobc} options}. - -@node Listing options -@subsection Listing options - -@table @code - -@item -t=@var{file} -Generate and place the standard print listing into @file{@var{file}}. - -@item -T=@var{file} -Generate and place a wide print listing into @file{*@var{file}}. - -@item --tlines=@var{lines} -Specify lines per page in print listing, default = 55. -Set to zero for no additional page breaks. - -@item -ftsymbols -Generate symbol table in listing. - -@item -fno-theader -Suppress all headers from listing while keeping page breaks. - -@item -fno-tmessages -Suppress warning and error summary from listing. - -@item -fno-tsource -Suppress actual source from listing (for example to only produce the -cross-reference). - -@item -P, -P@var{directory}, -P=@var{file} -Generate and place a preprocessed listing (old format) into @file{@var{filename}.lst}, -@file{@var{directory}/@var{filename}.lst}, @file{@var{file}}. - -@item -Xref -@item -X -Generate cross reference in the listing. - -@end table - -Here is an example program listing with the options @code{-t -ftsymbols}: - -@example -GnuCOBOL 3.0.0 test.cbl Mon May 14 10:23:45 2018 Page 0001 - -LINE PG/LN A...B........................................................... - -000001 IDENTIFICATION DIVISION. -000002 PROGRAM-ID. prog. -000003 ENVIRONMENT DIVISION. -000004 CONFIGURATION SECTION. -000005 DATA DIVISION. -000006 WORKING-STORAGE SECTION. -000007 COPY 'values.cpy'. -000001C 78 I VALUE 20. -000002C 78 J VALUE 5000. -000003C 78 M VALUE 5. -000008 01 SETUP-REC. -000009 05 FL1 PIC X(04). -000010 05 FL2 PIC ZZZZZ. -000011 05 FL3 PIC 9(04). -000012 05 FL4 PIC 9(08) COMP. -000013 05 FL5 PIC 9(04) COMP-4. -000014 05 FL6 PIC Z,ZZZ.99. -000015 05 FL7 PIC S9(05) SIGN LEADING SEPARATE. -000016 05 FL8 PIC X(04). -000017 05 FL9 REDEFINES FL8 PIC 9(04). -000018 05 FLA. -000019 10 FLB OCCURS I TIMES. -000020 15 FLC PIC X(02). -000021 10 FLD PIC X(20). -000022 05 FLD1 PIC X(100). -000023 05 FLD2 OCCURS M TO J TIMES DEPENDING ON FL5. -000024 10 FILLER PIC X(01). -000025 05 FLD3 PIC X(3). -000026 05 FLD4 PIC X(4). -000027 PROCEDURE DIVISION. -000028 STOP RUN. -@end example - -The first part of the listing lists the program text. If the program text is -a COPY the line number reflects the COPY line number and is appended with -a '@code{C}'. - -When the wide list option @option{-T} is specified, the @code{SEQUENCE} -columns (for fixed-form reference-format) are included in the listing. - - -The second part of the listing file is the listing of the Symbol Table: - -@example -GnuCOBOL 3.0.0 test.cbl Mon May 14 10:23:45 2018 Page 0002 - -SIZE TYPE LVL NAME PICTURE - -5204 GROUP 01 SETUP-REC -0004 ALPHANUMERIC 05 FL1 X(04) -0005 ALPHANUMERIC 05 FL2 ZZZZZ -0004 ALPHANUMERIC 05 FL3 9(04) -0004 NUMERIC 05 FL4 9(08) COMP -0002 NUMERIC 05 FL5 9(04) COMP -0008 ALPHANUMERIC 05 FL6 Z,ZZZ.99 -0006 ALPHANUMERIC 05 FL7 S9(05) -0004 ALPHANUMERIC 05 FL8 X(04) -0004 ALPHANUMERIC-R 05 FL9 9(04) -0060 ALPHANUMERIC 05 FLA -0040 ALPHANUMERIC 10 FLB OCCURS 20 -0002 ALPHANUMERIC 15 FLC X(02) -0020 ALPHANUMERIC 10 FLD X(20) -0100 ALPHANUMERIC 05 FLD1 X(100) -5000 ALPHANUMERIC 05 FLD2 OCCURS 5 TO 5000 -0001 ALPHANUMERIC 10 FILLER X(01) -0003 ALPHANUMERIC 05 FLD3 X(3) -0004 ALPHANUMERIC 05 FLD4 X(4) -@end example - -If the symbol redefines another variable the @code{TYPE} is marked with '@code{R}'. -If the symbol is an array the @code{OCCURS} phrase is in the @code{PICTURE} field. - - -The last part of the listing file is the summary of warnings an error in the -compilation group: - -@example -0 warnings in compilation group -2 errors in compilation group -@end example - -@node Debug switches -@subsection Debug switches - -@table @code - -@item -debug, -d -Enable all run-time error checks. - -@item -g -Produce C debugging information in the output. - -@item -ftrace -Generate trace code (log executed procedures, if tracing is enabled). - -@item -ftraceall -Generate trace code (log executed procedures and statements, -if tracing is enabled). - -@item -fsource-location -Generate source location code (implied by @option{-debug} or @option{-g}). - -@item -fstack-check -Enable @code{PERFORM} stack checking (implied by @option{-debug} or @option{-g}). - -@item -fdebugging-line -Enable debugging lines (@code{D} in indicator column; >>D directive). - -@item -O -Enable optimization of code size and execution speed. -See your C compiler documentation, for example @code{man gcc} for details. - -@item -O2 -Optimize even more. - -@item -Os -Optimize for size. Optimizer will favour code size over execution speed. - -@item -fnotrunc -Do not truncate binary fields according to PICTURE. - -@end table - -@node Miscellaneous -@subsection Miscellaneous -@table @code - -@item -ext -@comment{TODO: Clarify} -Add default file extension. - -@item -fsyntax-only -Check syntax only; don't emit any output. - -@item -fmfcomment -Treat lines with @code{*} or @code{/} in column 1 as comment -(fixed-form reference-format only). - -@item -acucomment -Treat @code{|} as an inline comment marker. - -@item -fsign=ASCII -@comment{TODO: Clarify} -Numeric display sign ASCII (default on ASCII machines). - -@item -fsign=EBCDIC -Numeric display sign EBCDIC (default on EBCDIC machines). - -@item -fintrinsics=[ALL|intrinsic function name(,name,...)] -Allow use of all or specific intrinsic functions without @code{FUNCTION} -keyword. - -Note: defining this within your source with -@code{CONFIGURATION SECTION. REPOSITORY.} is preferred. - -@item -ffold-copy=LOWER -Fold @code{COPY} subject to lower case (default no transformation). - -@item -ffold-copy=UPPER -Fold @code{COPY} subject to upper case (default no transformation). - -@item -save-temps(=) -Save intermediate files (by default, in current directory). - -@item -fimplicit-init -Do automatic initialization of the COBOL runtime system. - -@end table - -@node Multiple sources -@section Multiple sources - -This section describes how to compile a program from multiple source files. - -This section also describes how to build a shared library that can -be used by any COBOL program and how to use external libraries in -COBOL programs. - -@menu -* Static linking:: Compiling into a single executable -* Dynamic linking:: A main program and separate modules -* Building library:: Building a shared library -* Using library:: Using external libraries -@end menu - -@node Static linking -@subsection Static linking - -The easiest way of combining multiple files is to compile them into a -single executable. - -One way is to compile all the files in one command: - -@example -$ cobc -x -o prog main.cob subr1.cob subr2.cob -@end example - -Another way is to compile each file with the option @code{-c}, -and link them at the end. -The top-level program must be compiled with the option @code{-x}. - -@example -$ cobc -c subr1.cob -$ cobc -c subr2.cob -$ cobc -c -x main.cob -$ cobc -x -o prog main.o subr1.o subr2.o -@end example - -You can link C routines as well using either method: - -@example -$ cobc -o prog main.cob subrs.c -@end example - -or -@example -$ cobc -c subrs.c -$ cobc -c -x main.cob -$ cobc -x -o prog main.o subrs.o -@end example - -Any number of functions can be contained in a single C file. - -The linked programs will be called dynamically; that is, the symbol -will be resolved at run time. For example, the following COBOL -statement - -@example -CALL "subr" USING X. -@end example - -will be converted into equivalent C code like this: - -@example -int (*func)() = cob_resolve("subr"); -if (func != NULL) - func (X); -@end example - -With the compiler option @code{-fstatic-call}, more efficient code -will be generated: - -@example -subr(X); -@end example - -Please notice that this option only takes effect when the called program name -is in a literal (like @code{CALL "subr"}). With a data name (like -@code{CALL SUBR}), the program is still called dynamically. - -@node Dynamic linking -@subsection Dynamic linking - -There are two methods to achieve this: a driver program, or compiling -the main program and subprograms separately. - -@subsubsection Driver program - -Compile all programs with the option @code{-m}: -@example -$ cobc -m main.cob subr.cob -@end example -This creates the shared object files @file{main.so} and @file{subr.so}. -@footnote{The extension used depends on your operating system.} - -Before running the main program, install the module files in your -library directory: -@example -$ cp subr.so /your/cobol/lib -@end example -Set the runtime variable @code{COB_LIBRARY_PATH} -to your library directory, and run the main program: -@example -$ export COB_LIBRARY_PATH=/your/cobol/lib -@end example -(@emph{Please notice:} You may set the variable via a runtime configuration file, -@pxref{Appendix H, Runtime Configuration, Runtime Configuration}. -You may also set the variable to directly point to the directory -where you compiled the sources.) - -Now execute your program: -@example -$ cobcrun main -@end example - -@subsubsection Compiling programs separately - -The main program is compiled as usual: -@example -$ cobc -x -o main main.cob -@end example - -Subprograms are compiled with the option @code{-m}: -@example -$ cobc -m subr.cob -@end example -This creates a module file @file{subr.so}@footnote{The extension -used depends on your operating system.}. - -Before running the main program, install the module files in your -library directory: -@example -$ cp subr.so /your/cobol/lib -@end example - -Now, set the environment variable @env{COB_LIBRARY_PATH} -to your library directory, and run the main program: -@example -$ export COB_LIBRARY_PATH=/your/cobol/lib -$ ./main -@end example - -@node Building library -@subsection Building library - -You can build a shared library by combining multiple COBOL programs -and even C routines: - -@example -$ cobc -c subr1.cob -$ cobc -c subr2.cob -$ cc -c subr3.c -$ cc -shared -o libsubrs.so subr1.o subr2.o subr3.o -@end example - -@node Using library -@subsection Using library - -You can use a shared library by linking it with your main program. - -Before linking the library, install it in your system library directory: -@example -$ cp libsubrs.so /usr/lib -@end example -or install it somewhere else and set @code{LD_LIBRARY_PATH}: -@example -$ cp libsubrs.so /your/cobol/lib -$ export LD_LIBRARY_PATH=/your/cobol/lib -@end example - -Then, compile the main program, linking the library as follows: -@example -$ cobc -x main.cob -L/your/cobol/lib -lsubrs -@end example - -@node C interface -@section C interface - -This chapter describes how to combine C programs with COBOL programs. - -@menu -* Main C program:: Writing main program in C -* Static C to COBOL:: -* Dynamic C to COBOL:: -* Static COBOL to C:: -* Dynamic COBOL to C:: -* Interface functions for C:: -@end menu - -@node Main C program -@subsection Writing Main Program in C - -Include @file{libcob.h} in your C program and call @code{cob_init} before -using any COBOL module. -Do a cleanup afterwards, either by calling @code{cob_stop_run} (if your -program should terminate) or by calling @code{cob_tidy} (if your program -should execute further on without any more COBOL calls, calling both -functions in this sequence can be done multiple times). - -@example -#include - -int -main (int argc, char **argv) -@{ - /* initialize your program */ - ... - - /* initialize the COBOL run-time library */ - cob_init (argc, argv); - - /* rest of your program */ - ... - - /* Clean up and terminate - This does not return */ - cob_stop_run (return_status); -@} -@end example - -You can write @code{cobc_init(0, NULL);} if you do not want to pass -command line arguments to COBOL. - -You can compile your C program as follows: - -@example -cc -c @`{}cob-config --cflags@`{} main.c -@end example - -The compiled object must be linked with libcob as follows: - -@example -cc -o main main.o @`{}cob-config --libs@`{} -@end example - -@node Static C to COBOL -@subsection Static linking with COBOL programs - -Let's call the following COBOL module from a C program: - -@example ----- say.cob --------------------------- - IDENTIFICATION DIVISION. - PROGRAM-ID. say. - ENVIRONMENT DIVISION. - DATA DIVISION. - LINKAGE SECTION. - 01 hello PIC X(7). - 01 world PIC X(6). - PROCEDURE DIVISION USING hello world. - DISPLAY hello world. - EXIT PROGRAM. ----------------------------------------- -@end example - -This program accepts two arguments, displays them, and exits. - -From the viewpoint of C, this is equivalent to a function having the -following prototype: - -@example -extern int say(char *hello, char *world); -@end example - -So, your main program will look like as follows: - -@example ----- hello.c --------------------------- -#include - -extern int say(char *hello, char *world); - -int -main() -@{ - int ret; - char hello[8] = "Hello, "; - char world[7] = "world!"; - - /* initialize the COBOL run-time library */ - cob_init(0, NULL); - - /* call the static module and store its return code */ - ret = say(hello, world); - - /* shutdown the COBOL run-time library, keep program running */ - (void)cob_tidy(); - - return ret; -@} ----------------------------------------- -@end example - -Compile these programs as follows: - -@example -$ cc -c `cob-config --cflags` hello.c -$ cobc -c -static say.cob -$ cobc -x -o hello hello.o say.o -$ ./hello -Hello, world! -@end example - -@node Dynamic C to COBOL -@subsection Dynamic linking with COBOL programs - -You can find a COBOL module having a specific name by using the C -function @code{cob_resolve}, which takes the module name as a string -and returns a pointer to the module function. - -@code{cob_resolve} returns @code{NULL} if there is no module. In this case, -the function @code{cob_resolve_error} returns the error message. - -Let's see an example: - -@example ----- hello-dynamic.c ------------------- -#include - -static int (*say)(char *hello, char *world); - -int main() -@{ - int ret; - char hello[8] = "Hello, "; - char world[7] = "world!"; - - /* initialize the COBOL run-time library */ - cob_init(0, NULL); - - /* Find the module with PROGRAM-ID "say". */ - say = cob_resolve("say"); - - /* If there is no such module, show error and exit. */ - if(say == NULL) @{ - fprintf(stderr, "%s\n", cob_resolve_error()); - exit(1); - @} - - /* Call the module found ... */ - ret = say(hello, world); - - /* ...and exit with the return code. */ - cob_stop_run(ret); -@} ----------------------------------------- -@end example - -Compile these programs as follows: - -@example -$ cc -c `cob-config --cflags` hello-dynamic.c -$ cobc -x -o hello hello-dynamic.o -$ cobc -m say.cob -$ export COB_LIBRARY_PATH=. -$ ./hello -Hello, world! -@end example - -@node Static COBOL to C -@subsection Static linking with C programs - -Let's call the following C function from COBOL: - -@example ----- say.c ----------------------------- -int say(char *hello, char *world) -@{ - int i; - for(i = 0; i < 7; i++) - putchar(hello[i]); - for(i = 0; i < 6; i++) - putchar(world[i]); - putchar('\n'); - return 0; -@} ----------------------------------------- -@end example - -This program is equivalent to the program in @file{say.cob} above. - -Note that, unlike C, the arguments passed from COBOL programs are not -terminated by the null character (i.e., @code{'\0'}). - -You can call this function in the same way you call COBOL programs: - -@example ----- hello.cob ------------------------- - IDENTIFICATION DIVISION. - PROGRAM-ID. hello. - ENVIRONMENT DIVISION. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 hello PIC X(7) VALUE "Hello, ". - 01 world PIC X(6) VALUE "world!". - PROCEDURE DIVISION. - CALL "say" USING hello world. - STOP RUN. ----------------------------------------- -@end example - -Compile these programs as follows: - -@example -$ cc -c say.c -$ cobc -c -static -x hello.cob -$ cobc -x -o hello hello.o say.o -$ ./hello -Hello, world! -@end example - -@node Dynamic COBOL to C -@subsection Dynamic linking with C programs - -You can create a dynamically-linked module from a C program by passing an -option @code{-shared} to the C compiler: - -@example -$ cc -shared -o say.so say.c -$ cobc -x hello.cob -$ export COB_LIBRARY_PATH=. -$ ./hello -Hello, world! -@end example - -@node Interface functions for C -@subsection Redirecting output to a (FILE *) - -From a module written in C you can call @code{cob_set_runtime_option} -to set the exact @code{(FILE *)} which is used to write trace data to. -In @file{common.h} is the following: -@example -enum cob_runtime_option_switch @{ - COB_SET_RUNTIME_TRACE_FILE /* 'p' is FILE * */ - COB_SET_RUNTIME_DISPLAY_PRINTER_FILE /* 'p' is FILE * */ - COB_SET_RUNTIME_RESCAN_ENV /* rescan environment variables */ - COB_SET_RUNTIME_DISPLAY_PUNCH_FILE /* 'p' is FILE * */ -@}; -COB_EXPIMP void cob_set_runtime_option (enum cob_runtime_option_switch opt, void *p); -@end example -So from you C code you can tell the GnuCOBOL runtime to redirect TRACE output by: -@example -cob_set_runtime_option (COB_SET_RUNTIME_TRACE_FILE, (void*)((FILE*)myfd)); -@end example -You could also redirect all DISPLAY UPON PRINTER output to a file by: -@example -cob_set_runtime_option (COB_SET_RUNTIME_DISPLAY_PRINTER_FILE, (void*)((FILE*)myfd)); -@end example -You could also redirect all DISPLAY UPON SYSPUNCH output to a file by: -@example -cob_set_runtime_option (COB_SET_RUNTIME_DISPLAY_PUNCH_FILE, (void*)((FILE*)myfd)); -@end example - -Another routine can be used to return the current value of the option. -@example -COB_EXPIMP void *cob_get_runtime_option (enum cob_runtime_option_switch opt); -@end example - - -@node Customize, Optimize, Compile, Top -@chapter Customize - -@menu -* Customizing compiler:: Customizing compiler -* Customizing library:: Customizing library -@end menu - -@node Customizing compiler -@section Customizing compiler - -These settings are effective at compile-time. - -Environment variables (default value in brackets): - -@table @code -@item COB_CC -C compiler ("gcc") -@item COB_CFLAGS -Flags passed to the C compiler ("-I$(PREFIX)/include") -@item COB_LDFLAGS -Flags passed to the C compiler ("") -@item COB_LIBS -Standard libraries linked with the program ("-L$(PREFIX)/lib -lcob") -@item COB_LDADD -Additional libraries linked with the program ("") -@end table - -@node Customizing library -@section Customizing library - -These settings are effective at run-time. You can set them either via the -environment or by a runtime configuration file. - -To set the global runtime configuration file export @code{COB_RUNTIME_CONFIG} -to point to your configuration file. -To set an explicit runtime configuration file for a single run via -@command{cobcrun} you can use its option @option{-c @var{file}}, -@option{--config=@var{file}}. - -For displaying the current runtime settings you can use the option -@option{-r}, @option{--runtime-env} of @command{cobcrun}. - -For a complete list of runtime variables, aliases, their default values and options -to set them @pxref{Appendix H, Runtime Configuration, Runtime Configuration}. - -@node Optimize, Debug, Customize, Top -@chapter Optimize - -@menu -* Optimize options:: How to enable optimization -* Optimize call:: Call subroutines efficiently -* Optimize binary:: Use efficient binary representation -@end menu - -@node Optimize options -@section Optimize options - -There are five compiler options for optimization: -@option{-O0}, @option{-O}, @option{-Os}, @option{-O2}, @option{-O3}. -These options enable optimization at both translation -(from COBOL to C) and compilation (C to assembly) levels. - -Currently, there is no difference between these optimization options at -the translation level. - -The option @option{-O}, @option{-Os} or @option{-O2} is passed to the -C compiler as is and used for C level optimization. - -@node Optimize call -@section Optimize call - -When a @code{CALL} statement is executed, the called program is linked at run -time. By specifying the compiler option @code{-fstatic-call}, you can -statically link the program at compile time and call it efficiently. -(@pxref{Static linking}) - -@node Optimize binary -@section Optimize binary - -By default, data items of usage binary or comp are stored in -big-endian form. On those machines whose native byte order is -little-endian, this is not quite efficient. - -If you prefer, you can store binary items in the native form of your -machine. Set the config option @code{binary-byteorder} to -@code{native} in your config file (@pxref{Customize}). - -In addition, setting the option @code{binary-size} to @code{2-4-8} or -@code{1-2-4-8} is more efficient than others. - -@node Debug, Extensions, Optimize, Top -@chapter Debug - -@menu -* Debug options:: Debug options -@end menu - -@node Debug options -@section Debug options - -The compiler option @option{-debug} can be used during the development -of your programs. It enables all run-time error checking, such as -subscript boundary checks and numeric data checks, and displays -run-time errors with source locations. - -@exampleindent 0 - -@node Extensions, System Routines, Debug, Top -@chapter Non-standard extensions -@cindex Extensions -@cindex Non-standard extensions - -@menu -* SELECT:: @code{SELECT ASSIGN TO}. -* Indexed:: Indexed file packages. -* Extended ACCEPT:: Extended @code{ACCEPT} statement. -* ACCEPT special:: @code{ACCEPT} special keys. -* Extended DISPLAY:: Extended @code{DISPLAY} statement. -* FUNCTION CONTENT-LENGTH:: Length of NUL byte terminated pointer data. -* FUNCTION CONTENT-OF:: Content of data at pointer, by length or NUL. -@end menu - - -@node SELECT -@section SELECT ASSIGN TO -@cindex @code{SELECT} -@cindex @code{SELECT ASSIGN TO} - -A file may be assigned to a literal file, a file in a variable, -or a file in an environment variable. - -@subsection Literal file. - -Assign to a literal file. - -@example -Select @var{file} assign to "/tmp/myfile.txt". -@end example - - -@subsection - -Assign to a file which name is read from a variable. - -@example -Select @var{file} assign to my-file. - -01 my-file pic x(512). - -Move "/tmp/myfile.txt" to my-file. -Open output . -@end example - - -@subsection - -Assign to a file in an environment variable. - -@example -export myfile=/tmp/myfile.txt - -Select @var{file} assign to external myfile. -@end example - - -@node Indexed -@section Indexed file packages -@cindex Indexed -@cindex Indexed file packages - - - - -@node Extended ACCEPT -@section Extended ACCEPT statement -@cindex Extended @code{ACCEPT} statement - -Extended @code{ACCEPT} statements allow for full control of items -accepted from the screen. -Items accept by line and column positioning. - -All commands following @code{WITH} are optional. - - -@example - -ACCEPT @var{variable-1} - LINE @var{variable-2} | @var{literal-1} COLUMN @var{variable-3} | @var{literal-2} - WITH - AUTO-SKIP | AUTO - BACKGROUND-COLOR @var{variable-4 }| @var{literal-3} - BELL | BEEP - BLINK - FOREGROUND-COLOR @var{variable-5} | @var{literal-4} - LOWLIGHT | HIGHLIGHT - PROMPT - PROTECTED - SIZE [IS] @var{variable-6} | @var{literal-5} - UPDATE - ON EXCEPTION - @var{exception processing} - NOT ON EXCEPTION - @var{normal processing} -END-ACCEPT. - -@end example - - -@subsection LINE -@cindex @code{LINE} - -The line number of @var{variable-2} or @var{literal-1} to accept the field. - - -@subsection COLUMN -@cindex @code{COLUMN} - -The column number of @var{variable-3} or @var{literal-2} to accept the field. - - -@subsection AUTO-SKIP -@cindex @code{AUTO-SKIP} -@cindex @code{AUTO} - -The word @code{AUTO} may be used for @code{AUTO-SKIP}. - -With this option the @code{ACCEPT} statement returns after the last -character is typed at the end of the field. -This is the same as if the Enter key were pressed. - -Without this option the cursor remains at the end of the field -and waits for the user to press Enter. - -The Right-Arrow key returns from the end of the field. -The Left-Arrow key returns from the beginning. -@xref{ACCEPT special, Arrow keys,,,}. - -The Alt-Right-Arrow and Alt-Left-Arrow keys never @code{AUTO-SKIP}. - - -@subsection BACKGROUND-COLOR -@cindex @code{BACKGROUND-COLOR} - -The background color is the color used behind the characters. - -@var{Variable-4} or @var{literal-3} must be numeric. -See file @file{screenio.cpy} for the color assignments to @var{variable-4} -or @var{literal-3}. - - -@subsection BELL -@cindex @code{BELL} -@cindex @code{BEEP} - -The word @code{BEEP} may be used for @code{BELL}. - -The system beeps when the cursor moves to accept from this field. -On some systems, there is no sound. -Some other method may indicate a beep, such a flashing screen or pop up window. - - -@subsection BLINK -@cindex @code{BLINK} - -The field blinks while the user enters the data. -This can help small menu selection fields to stand out. - - -@subsection FOREGROUND-COLOR -@cindex @code{FOREGROUND-COLOR} - -The foreground color is the color used for the characters. - -@var{Variable-5} or @var{literal-4} must be numeric. -See file @file{screenio.cpy} for the color assignments to @var{variable-5} -or @var{literal-4}. - - -@subsection LOWLIGHT -@cindex @code{LOWLIGHT} -@cindex @code{HIGHLIGHT} - -The @code{LOWLIGHT} and @code{HIGHLIGHT} phrases vary the intensity of the field. - -@code{LOWLIGHT} displays with lower intensity -and @code{HIGHLIGHT} displays with higher intensity. -Having neither @code{LOWLIGHT} nor @code{HIGHLIGHT} displays at normal intensity. - -These may have different levels of intensity, if at all, depending on the -make and model of the screens. - - -@subsection PROMPT -@cindex @code{PROMPT} - -Display the field with prompt characters as the cursor moves to accept from this field. - - -@subsection PROTECTED -@cindex @code{PROTECTED} - -@code{PROTECTED} is ignored. - - -@subsection SIZE -@cindex @code{SIZE} - -The size of @var{variable-1} to accept from the screen. - -@var{Variable-6} or @var{literal-5} must be numeric. - -@vtable @option - -@item @code{SIZE} - -If @var{variable-6} or @var{literal-5} is less than the length of -@var{variable-1} then only the @code{SIZE} number of characters accept -into the field. -@var{Variable-1} pads with spaces after @code{SIZE} to the end of the field. - -If @var{variable-6} or @var{literal-5} is greater than @var{variable-1}, -then the screen pads with spaces after @var{variable-1} to the @code{SIZE} length. - -@item @code{SIZE ZERO} -@itemx <@code{SIZE} option not specified> - -The @var{variable-1} accepts to its field length. - -@end vtable - - -@subsection UPDATE -@cindex @code{UPDATE} - -The contents of variable-1 displays on the screen as the @code{ACCEPT} begins. -This allows the user to update the field without having to type it all again. - -Without this option, the @code{ACCEPT} field is always blank. - - -@subsection ON EXCEPTION -@cindex @code{ON EXCEPTION} - -Check the special register cob-crt-status for the special key that was pressed. -This includes Escape, Tab, Back-Tab, F-keys, arrows, etc... -See screenio.cpy for the values. - - -@subsection NOT ON EXCEPTION -@cindex @code{NOT ON EXCEPTION} - -Reset any F-key indicator because no special key was pressed. - - -@node ACCEPT special -@section ACCEPT special keys -@cindex @code{ACCEPT} special keys - -Special keys are available for extended @code{ACCEPT} statements. - -The @code{COB-CRT-STATUS} values are in the screenio.cpy copy file. - - -@subsection Arrow keys -@cindex Arrow keys - -The Left-Arrow key moves the cursor to the left. -Without @code{AUTO-SKIP} the cursor stops at the beginning of the field. -With @code{AUTO-SKIP} it returns with the @code{COB-SCR-KEY-LEFT} value of 2009. -@xref{Extended ACCEPT, AUTO-SKIP,,,}. - -The Alt-Left-Arrow key is the same as Left-Arrow except that -it never returns, even for @code{AUTO-SKIP}. - -The Right-Arrow key moves the cursor to the right. -Without @code{AUTO-SKIP} the cursor stops at the end of the field. -With @code{AUTO-SKIP} it returns with the @code{COB-SCR-KEY-RIGHT} value of 2010. -@xref{Extended ACCEPT, AUTO-SKIP,,,}. - -The Alt-Right-Arrow key is the same as Right-Arrow except that -it never returns, even for @code{AUTO-SKIP}. - - -@subsection Backspace key -@cindex Backspace key - -The Backspace key moves the cursor, and the remainder of the text, to the left. - - -@subsection Delete keys -@cindex Delete keys - -The Delete key deletes the cursor's character and moves the -remainder of the text to the left. -The cursor does not move. - -The Alt-Delete key deletes all text from the cursor to the -end of the field. - - -@subsection End key -@cindex End key - -The End key moves the cursor after the last non-space character. -Pressing the End key again moves the cursor to the end of the field. -Repeated pressing moves the cursor back and forth. - - -@subsection Home key -@cindex Home key - -The Home key moves the cursor to the first non-space character. -Pressing the Home key again moves the cursor to the beginning of the field. -Repeated pressing moves the cursor back and forth. - - -@subsection Insert key -@cindex Insert key - -The Insert key changes the insert mode. - -The value of the insert mode is used in all following @code{ACCEPT} -statements while the program is running. - -When the insert mode is on, typed characters move the existing characters -to the right until field is full. -When it is off, typed characters type over existing characters. - -Note: The insert mode is ignored for fields with a size of 1. - -The insert mode can also be changed by the @code{COB_INSERT_MODE} setting at any time, -@pxref{Appendix H, Runtime Configuration, Runtime Configuration}. - - -@subsection Tab keys -@cindex Tab keys - -The Tab key returns from the @code{ACCEPT} with the @code{COB-SCR-TAB} value of 2007. - -The Shift-Tab key returns with the @code{COB-SCR-BACK-TAB} value of 2008. - - -@node Extended DISPLAY -@section Extended DISPLAY statement -@cindex Extended @code{DISPLAY} statement - -Extended @code{DISPLAY} statements allow for full control of items that display -on the screen. -Items display by line and column positioning. - -@example - -DISPLAY @var{variable-1} | @var{literal-1} | @var{figurative constant} - LINE @var{line} COLUMN @var{column} - WITH BELL - BLANK LINE | SCREEN - ERASE EOL | EOS - SIZE [IS] @var{variable-2} | @var{literal-2} -END-DISPLAY. - -@end example - - -@subsection BELL -@cindex @code{BELL} - -Ring the bell. -It is optional. - - -@subsection BLANK -@cindex @code{BLANK LINE} -@cindex @code{BLANK SCREEN} - -Clear the whole line or screen. -It is optional. - -@vtable @option - -@item @code{BLANK LINE} - -Clear the line from the beginning of the line to the end of the line. - -@item @code{BLANK SCREEN} - -Clear the whole screen. - -@end vtable - - -@subsection ERASE -@cindex @code{ERASE EOL} -@cindex @code{ERASE EOS} - -Clear the line or screen from LINE and COLUMN. -It is optional. - -@vtable @option - -@item @code{ERASE EOL} - -Clear the line from LINE and COLUMN to the end of the line. - -@item @code{ERASE EOS} - -Clear the screen from LINE and COLUMN to the end of the screen. - -@end vtable - - -@subsection SIZE -@cindex @code{SIZE} - -The size of @var{variable-1}, @var{literal-1}, or @var{figurative-constant} -to display onto the screen. -It is optional. - -@vtable @option - -@item @code{SIZE} @var{positive-integer} - -If @code{SIZE} is less than the length of @var{variable-1} or @var{literal-1} -then only the @code{SIZE} number of characters display. - -If @code{SIZE} is greater than the length of @var{variable-1} or @var{literal-1}, -then the screen pads with spaces after the field to the @code{SIZE} length. - -Figurative constants display repeatedly the number of times in @code{SIZE}. -Except that @code{LOW-VALUES} always positions the cursor (see @code{SIZE} ZERO below). - -@item @code{SIZE ZERO} -@itemx <@code{SIZE} option not specified> - -@var{Variable-1} or @var{literal-1} displays with the field length. - -@end vtable - - -@subsection Figurative Constants -@cindex Figurative Constants - -Certain figurative constants and values have special functions. -All other figurative constants display as a single character. - -@vtable @option - -@item @code{SPACE} -Display spaces from LINE and COLUMN to the end of the screen. -This is the same as WITH ERASE EOS. - -@item @code{LOW-VALUE} -Position the cursor to LINE and COLUMN. -The next @code{DISPLAY} statement does not need a LINE or COLUMN -to display at that position. - -@item @code{ALL X"01"} -Display spaces from LINE and COLUMN to the end of the line. -This is the same as @code{WITH ERASE EOL}. - -@item @code{ALL X"02"} -Clear the whole screen. -This is the same as @code{WITH BLANK SCREEN}. - -@item @code{ALL X"07"} -Ring the bell. -This is the same as @code{WITH BELL}. - -@end vtable - -@node FUNCTION CONTENT-LENGTH -@section CONTENT-LENGTH -@cindex @code{FUNCTION CONTENT-LENGTH} - -@code{FUNCTION CONTENT-LENGTH} returns the length of NUL byte terminated data given a pointer: - -@example - identification division. - program-id. zlen. - data division. - working-storage section. - 01 ptr usage pointer. - 01 str pic x(4) value z"abc". - - *> Testing CONTENT-LENGTH - procedure division. - - set ptr to address of str - display content-length(ptr) - - goback. - end program hosted. -@end example - - -@node FUNCTION CONTENT-OF -@section CONTENT-OF -@cindex @code{FUNCTION CONTENT-OF} - -@code{FUNCTION CONTENT-OF} returns an alphanumeric field given a pointer and optional length: - -Data from pointer is returned as a COBOL field either by scanning for a NUL byte or using the -optional length. Reference modification of result allowed. - -@example - identification division. - program-id. contents. - data division. - working-storage section. - 01 ptr usage pointer. - 01 str pic x(4) value z"abc". - - *> Testing CONTENT-OF - procedure division. - - set ptr to address of str - display content-of(ptr) - display content-of(ptr, 2) - display content-of(ptr)(2:2) - - goback. - end program hosted. -@end example - - -@node System Routines, Appendices, Extensions, Top -@chapter System Routines - -For a complete list of supported system routines, -@pxref{Appendix D, ,System routines}. - -@menu -* CBL_GC_GETOPT:: GETOPT for Cobol -* CBL_GC_HOSTED:: Access to C hosted variables -* CBL_GC_NANOSLEEP:: Sleep for nanoseconds -* CBL_GC_FORK:: Fork the current COBOL process to a new one -* CBL_GC_WAITPID:: Wait for a system process to end -@end menu - -@node CBL_GC_GETOPT -@section CBL_GC_GETOPT - -@code{CBL_GC_GETOPT} provides the quite well-known option parser, getopt, for -GnuCOBOL. -The usage of this system routine is described by the following example. - -@example - identification division. - program-id. prog. - - data division. - working-storage section. - 78 shortoptions value "jkl". - - 01 longoptions. - 05 optionrecord occurs 2 times. - 10 optionname pic x(25). - 10 has-value pic 9. - 10 valpoint pointer value NULL. - 10 return-value pic x(4). - - 01 longind pic 99. - 01 long-only pic 9 value 1. - - 01 return-char pic x(4). - 01 opt-val pic x(10). - - 01 counter pic 9 value 0. -@end example - -We first need to define the necessary fields for getopt's shortoptions (so), -longoptions (lo), longoption index (longind), long-only-option (long-only) -and also the fields for return values return-char and opt-val (arbitrary size -with trimming, see return codes). - -The shortoptions are written down as an alphanumeric field (i.e., a string with -arbitrary size) as follows: - -@example -"ab:c::d" -@end example - -This means we want getopt to look for shortoptions named a, b, c or d and we demand -an option value for b and we are accepting an optional one for c. - -The longoptions are defined as a table of records with oname, has-value, valpoint and val. -@itemize @bullet -@item oname defines the name of a longoption. -@item has-value defines if an option value is demanded (has-val = 1), optional (has-val = 2) or not required (has-val = 0). -@item valpoint is a pointer used to specify an address to save getopt's return value to. The pointer -is optional. If it is @code{NULL}, getopt returns a value as usual. If you use the pointer it has to -point to a @code{PIC X(4)} field. -@item The field val is a @code{PIC X(4)} character which is returned if the longoption was recognized. -@end itemize -The longoption structure is immutable! You can only vary the number of records. - -Now we have the tools to run @code{CBL_GC_GETOPT} within the procedure division. - -@example - procedure division. - move "version" to optionname (1). - move 0 to has-value (1). - move "v" to return-value (1). - - move "verbose" to optionname (2). - move 0 to has-value (2). - move "V" to return-value (2). - - perform with test after until return-code = -1 - call 'CBL_GC_GETOPT' using - by reference shortoptions longoptions longind - by value long-only - by reference return-char opt-val - end-call - - display return-char end-display - display opt-val end-display - end-perform - stop run. - -@end example - -The example shows how we initialize all parameters and call the routine until -@code{CBL_GC_GETOPT} runs out of options and returns -1. - -The return-char might contain the following: -@itemize @bullet -@item regular character if an option was recognized -@item '?' @ @ if we have an undefined or ambiguous option -@item '1' @ @ if we have a non-option (only if first byte of so is '-') -@item '0' @ @ if valpoint != NULL and we are writing the return value to the specified address -@item '-1' @ if we don't have any more options (or reach the first non-option if first byte of so is '+') -@end itemize - -The return-codes of @code{CBL_GC_GETOPT} are: -@itemize @bullet -@item 1 @ @ if we've got a non-option (only if first byte of so is '-') -@item 0 @ @ if valpoint != @code{NULL} and we are writing the return value to the specified address -@item -1 @ if we don't have any more options (or reach the first non-option if first byte of so is '+') -@item 2 @ @ if we have got an truncated option value in opt-val (because opt-val was too small) -@item 3 @ @ if we got a regular answer from getopt -@end itemize - - -@node CBL_GC_HOSTED -@section CBL_GC_HOSTED - -@code{CBL_GC_HOSTED} provides access to the following C hosted variables: -@itemize @bullet -@item @code{argc} @ to binary-long by value -@item @code{argv} @ to pointer to char ** -@item @code{stdin}, @code{stdout}, @code{stderr} @ to pointer -@item @code{errno} @ giving address of errno in pointer to binary-long, use based for more direct access -@end itemize - -and conditional access to the following variables: -@itemize @bullet -@item @code{tzname} @ pointer to pointer to array of two char pointers -@item @code{timezone} @ C long, will be seconds west of UTC -@item @code{daylight} @ C int, will be 1 during daylight savings -@end itemize - -System will need to HAVE_TIMEZONE defined for these to return anything meaningful. -Attempts made when they are not available return 1 from CBL_GC_HOSTED. - -It returns 0 when match, 1 on failure, case matters as does length, "arg" won't match. - -The usage of this system routine is described by the following example. - -@example -HOSTED identification division. - program-id. hosted. - data division. - working-storage section. - 01 argc usage binary-long. - 01 argv usage pointer. - - 01 stdin usage pointer. - 01 stdout usage pointer. - 01 stderr usage pointer. - - 01 errno usage pointer. - 01 err usage binary-long based. - - 01 domain usage float-long value 3.0. - - 01 tzname usage pointer. - 01 tznames usage pointer based. - 05 tzs usage pointer occurs 2 times. - - 01 timezone usage binary-long. - 01 daylight usage binary-short. - - - *> Testing CBL_GC_HOSTED - procedure division. - call "CBL_GC_HOSTED" using stdin "stdin" - display "stdin : " stdin - call "feof" using by value stdin - display "feof stdin : " return-code - - call "CBL_GC_HOSTED" using stdout "stdout" - display "stdout : " stdout - call "fprintf" using by value stdout by content "Hello" & x"0a" - - call "CBL_GC_HOSTED" using stderr "stderr" - display "stderr : " stderr - call "fprintf" using by value stderr by content "on err" & x"0a" - - call "CBL_GC_HOSTED" using argc "argc" - display "argc : " argc - - call "CBL_GC_HOSTED" using argv "argv" - display "argv : " argv - - call "args" using by value argc argv - - call "CBL_GC_HOSTED" using errno "errno" - display "&errno : " errno - set address of err to errno - display "errno : " err - call "acos" using by value domain - display "errno after acos(3.0): " err ", EDOM is 33" - - call "CBL_GC_HOSTED" using argc "arg" - display "'arg' lookup : " return-code - call "CBL_GC_HOSTED" using null "argc" - display "null with argc : " return-code - display "argc is still : " argc - - - *> the following only returns zero if the system has HAVE_TIMEZONE set - - call "CBL_GC_HOSTED" using daylight "daylight " - display "'timezone' lookup : " return-code - - if return-code not = 0 - display "system doesn't has timezone" - else - - display "timezone is : " timezone - - call "CBL_GC_HOSTED" using daylight "daylight " - display "'daylight' lookup : " return-code - display "daylight is : " daylight - - set environment "TZ" to "PST8PDT" - call static "tzset" returning omitted on exception continue end-call - - call "CBL_GC_HOSTED" using tzname "tzname" - display "'tzname' lookup : " return-code - - *> tzs(1) will point to z"PST" and tzs(2) to z"PDT" - if return-code equal 0 and tzname not equal null then - set address of tznames to tzname - if tzs(1) not equal null then - display "tzs #1 : " tzs(1) - end-if - if tzs(2) not equal null then - display "tzs #2 : " tzs(2) - end-if - end-if - - end-if - - goback. - end program hosted. -@end example - - -@node CBL_GC_NANOSLEEP -@section CBL_GC_NANOSLEEP - -@code{CBL_GC_NANOSLEEP} allows you to pause the program for nanoseconds. -The actual precision depends on the system. - -@example - *> Waiting a half second - call "CBL_GC_NANOSLEEP" using "500000000" end-call - - *> Waiting five seconds using compiler string catenation for readability - call "CBL_GC_NANOSLEEP" using "500" & "0000000" end-call -@end example - - -@node CBL_GC_FORK -@section CBL_GC_FORK - -@code{CBL_GC_FORK} allows you to fork the current COBOL process to a new one. -The current content of the process' storage (including @code{LOCAL-STORAGE}) -will be identical, any file handles get invalid in the new process, positions -and file / record locks are only available to the original process. - -This system routine is not available on Windows (exception: GCC on Cygwin). - -Parameters: none -Returns: PID (the child process gets '0' returned, the calling process gets -the PID of the created children). -Negative values are returned for system dependent error codes and -1 if the function -is not available on the current system. - -@example - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 CHILD-PID PIC S9(9) BINARY. - 01 WAIT-STS PIC S9(9) BINARY. - PROCEDURE DIVISION. - - CALL "CBL_GC_FORK" RETURNING CHILD-PID END-CALL - EVALUATE TRUE - WHEN CHILD-PID = ZERO - PERFORM CHILD-CODE - WHEN CHILD-PID > ZERO - PERFORM PARENT-CODE - WHEN CHILD-PID = -1 - DISPLAY 'CBL_GC_FORK is not available ' - 'on the current system!' - END-DISPLAY - PERFORM CHILD-CODE - MOVE 0 TO CHILD-PID - PERFORM PARENT-CODE - WHEN OTHER - MULTIPLY CHILD-PID BY -1 END-MULTIPLY - DISPLAY 'CBL_GC_FORK returned system error: ' - CHILD-PID - END-DISPLAY - END-EVALUATE - - STOP RUN. - - CHILD-CODE. - CALL "C$SLEEP" USING 1 END-CALL - DISPLAY "Hello, I am the child" - END-DISPLAY - MOVE 2 TO RETURN-CODE - - CONTINUE. - - PARENT-CODE. - DISPLAY "Hello, I am the parent" - END-DISPLAY - CALL "CBL_GC_WAITPID" USING CHILD-PID RETURNING WAIT-STS - END-CALL - MOVE 0 TO RETURN-CODE - EVALUATE TRUE - WHEN WAIT-STS >= 0 - DISPLAY 'Child ended with status: ' - WAIT-STS - END-DISPLAY - WHEN WAIT-STS = -1 - DISPLAY 'CBL_GC_WAITPID is not available ' - 'on the current system!' - END-DISPLAY - WHEN WAIT-STS < -1 - MULTIPLY -1 BY WAIT-STS END-MULTIPLY - DISPLAY 'CBL_GC_WAITPID returned system error: ' WAIT-STS - END-DISPLAY - END-EVALUATE - - CONTINUE. -@end example - - -@node CBL_GC_WAITPID -@section CBL_GC_WAITPID - -@code{CBL_GC_WAITPID} allows you to wait until another system process ended. -Additional you can check the process' return code. - -Parameters: none -Returns: function-status / child-status -Negative values are returned for system dependent error codes and -1 if the function -is not available on the current system. - -@example - CALL "CBL_GC_WAITPID" USING CHILD-PID RETURNING WAIT-STS - END-CALL - MOVE 0 TO RETURN-CODE - DISPLAY 'CBL_GC_WAITPID ended with status: ' WAIT-STS - END-DISPLAY -@end example - -@ignore -@node Appendices, Index, System Routines, Top -@end ignore -@node Appendices, , System Routines, Top - -@menu -* Appendix A:: Compiler @command{cobc} options -* Appendix B:: Reserved Words -* Appendix C:: Intrinsic Functions -* Appendix D:: System routines -* Appendix E:: System names -* Appendix F:: Compiler Configuration -* Appendix G:: Module loader @command{cobcrun} options -* Appendix H:: Runtime configuration -* Appendix I:: GNU Free Documentation License -@end menu - -@node Appendix A, Appendix B, Appendices, Appendices -@appendix Compiler @command{cobc} options - -The following list of options was extracted from -@code{cobc --help} and shows all available compiler options -with a short description. - -@include cbhelp.tex - -@node Appendix B, Appendix C, Appendix A, Appendices -@appendix Reserved Words - -The following list of reserved words was extracted from -@code{cobc --list-reserved} and shows the reserved words, an implementation - -@strong{Please notice:} This list is highly specific to the option -@option{-std=@var{dialect}} and reserved word options -(@option{-freserved=@var{word}}, @option{-fno-reserved=@var{word}}) in effect. -You can get the list for a given @var{dialect} by calling -@code{cobc -std=@var{dialect} --list-reserved}. - -@include cbrese.tex - -@node Appendix C, Appendix D, Appendix B, Appendices -@appendix Intrinsic Functions - -The following list of intrinsic functions was extracted from -@code{cobc --list-intrinsics} and shows the names of the available -functions, an implementation note and the number of parameters. - -@include cbintr.tex - -@node Appendix D, Appendix E, Appendix C, Appendices -@appendix System routines - -The following list of system routines was extracted from -@code{cobc --list-system} and shows the names of the available -system routines along with the number of parameters. - -@include cbsyst.tex - -@node Appendix E, Appendix F, Appendix D, Appendices -@appendix System names - -The following list of system names was extracted from -@code{cobc --list-mnemonics} and shows the system names categorized -by their type. - -@include cbmnem.tex - -@node Appendix F, Appendix G, Appendix E, Appendices -@appendix Compiler Configuration - -The following list was extracted from @file{config/default.conf}. - -@verbatiminclude cbconf.tex - -@node Appendix G, Appendix H, Appendix F, Appendices -@appendix Module loader @command{cobcrun} options - -The following list of options was extracted from -@code{cobcrun --help} and shows all available options -for the module loader with a short description. - -@include cbchelp.tex - -@node Appendix H, Appendix I, Appendix G, Appendices -@appendix Runtime configuration - -The following list was extracted from @file{config/runtime.cfg}. - -@include cbrunt.tex - -@comment The full FDL 1.3 text -@node Appendix I, , Appendix H, Appendices -@appendix GNU Free Documentation License -@cindex Copying - -@include fdl.texi - - -@ignore -@comment Create index. -@node Index, , Appendices, Top -@unnumbered Index -@printindex cp -@end ignore - -@comment End info file. -@bye - -@c Local Variables: -@c mode:outline-minor -@c outline-regexp:"@\\(ch\\|sec\\|subs\\)" -@c compile-command:"texi2any --pdf -o gnucobol.pdf gnucobol.texi" -@c End: diff -Nru gnucobol-4.0~early~20200606/doc/Makefile.am gnucobol-5/doc/Makefile.am --- gnucobol-4.0~early~20200606/doc/Makefile.am 2020-06-06 20:52:02.000000000 +0000 +++ gnucobol-5/doc/Makefile.am 1970-01-01 00:00:00.000000000 +0000 @@ -1,82 +0,0 @@ -# -# Makefile gnucobol/doc -# -# Copyright (C) 2003-2012, 2015-2020 Free Software Foundation, Inc. -# Written by Keisuke Nishida, Roger While, Simon Sobisch -# -# This file is part of GnuCOBOL. -# -# The GnuCOBOL compiler is free software: you can redistribute it -# and/or modify it under the terms of the GNU General Public License -# as published by the Free Software Foundation, either version 3 of the -# License, or (at your option) any later version. -# -# GnuCOBOL is distributed in the hope that it will be useful, -# but WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -# GNU General Public License for more details. -# -# You should have received a copy of the GNU General Public License -# along with GnuCOBOL. If not, see . - -COBC = cobc$(EXEEXT) -COBCRUN = cobcrun$(EXEEXT) -PASSED_OPTIONS = GREP=$(GREP) SED=$(SED) COBC=$(COBC) COBCRUN=$(COBCRUN) -COBCINFOSH = $(PASSED_OPTIONS) $(abs_top_builddir)/pre-inst-env \ - $(top_srcdir)/doc/cobcinfo.sh - -info_TEXINFOS = gnucobol.texi -GENINCLUDES = cbhelp.tex cbrese.tex cbintr.tex cbsyst.tex cbmnem.tex \ - cbconf.tex cbchelp.tex cbrunt.tex -gnucobol_TEXINFOS = $(GENINCLUDES) fdl.texi -BUILT_SOURCES = $(GENINCLUDES) - -# targets that are only logical targets instead of files -.PHONY: touch touch-tex clean-tex - -if COB_MAKE_RUN_BINARIES -cbhelp.tex: $(top_srcdir)/cobc/help.c \ - $(top_srcdir)/cobc/warning.def $(top_srcdir)/cobc/flag.def \ - $(top_srcdir)/cobc/config.def \ - $(top_srcdir)/doc/cobcinfo.sh - @$(COBCINFOSH) $@ - -cbchelp.tex: $(top_srcdir)/bin/cobcrun.c \ - $(top_srcdir)/doc/cobcinfo.sh - @$(COBCINFOSH) $@ -endif - -cbconf.tex: $(top_srcdir)/config/default.conf \ - $(top_srcdir)/doc/cobcinfo.sh - @$(COBCINFOSH) $@ - -cbrunt.tex: $(top_srcdir)/config/runtime.cfg \ - $(top_srcdir)/doc/cobcinfo.sh - @$(COBCINFOSH) $@ - -if COB_MAKE_RUN_BINARIES -cbrese.tex cbintr.tex cbsyst.tex cbmnem.tex: \ - $(top_srcdir)/cobc/reserved.c \ - $(top_srcdir)/doc/cobcinfo.sh - @$(COBCINFOSH) $@ -else -cbhelp.tex cbchelp.tex cbrese.tex cbintr.tex cbsyst.tex cbmnem.tex: \ - $(top_srcdir)/doc/cobcinfo.sh - @$(COBCINFOSH) "fixtimestamps" -endif - -touch-tex: - @$(COBCINFOSH) "fixtimestamps" "includes" - -touch: - @$(COBCINFOSH) "fixtimestamps" - -clean-tex: - rm -rf $(GENINCLUDES) - -EXTRA_DIST = gnucobol.pdf - -AM_MAKEINFOHTMLFLAGS = --no-headers --no-split -CLEANFILES = *.aux *.cp *.fn *.ky *.log *.pg *.toc *.tp *.vr *.vrs -MAINTAINERCLEANFILES = $(GENINCLUDES) -TEXI2DVI = texi2dvi -I $(srcdir) diff -Nru gnucobol-4.0~early~20200606/doc/Makefile.in gnucobol-5/doc/Makefile.in --- gnucobol-4.0~early~20200606/doc/Makefile.in 2020-06-06 20:56:36.000000000 +0000 +++ gnucobol-5/doc/Makefile.in 1970-01-01 00:00:00.000000000 +0000 @@ -1,945 +0,0 @@ -# Makefile.in generated by automake 1.15.1 from Makefile.am. -# @configure_input@ - -# Copyright (C) 1994-2017 Free Software Foundation, Inc. - -# This Makefile.in is free software; the Free Software Foundation -# gives unlimited permission to copy and/or distribute it, -# with or without modifications, as long as this notice is preserved. - -# This program is distributed in the hope that it will be useful, -# but WITHOUT ANY WARRANTY, to the extent permitted by law; without -# even the implied warranty of MERCHANTABILITY or FITNESS FOR A -# PARTICULAR PURPOSE. - -@SET_MAKE@ - -# -# Makefile gnucobol/doc -# -# Copyright (C) 2003-2012, 2015-2020 Free Software Foundation, Inc. -# Written by Keisuke Nishida, Roger While, Simon Sobisch -# -# This file is part of GnuCOBOL. -# -# The GnuCOBOL compiler is free software: you can redistribute it -# and/or modify it under the terms of the GNU General Public License -# as published by the Free Software Foundation, either version 3 of the -# License, or (at your option) any later version. -# -# GnuCOBOL is distributed in the hope that it will be useful, -# but WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -# GNU General Public License for more details. -# -# You should have received a copy of the GNU General Public License -# along with GnuCOBOL. If not, see . -VPATH = @srcdir@ -am__is_gnu_make = { \ - if test -z '$(MAKELEVEL)'; then \ - false; \ - elif test -n '$(MAKE_HOST)'; then \ - true; \ - elif test -n '$(MAKE_VERSION)' && test -n '$(CURDIR)'; then \ - true; \ - else \ - false; \ - fi; \ -} -am__make_running_with_option = \ - case $${target_option-} in \ - ?) ;; \ - *) echo "am__make_running_with_option: internal error: invalid" \ - "target option '$${target_option-}' specified" >&2; \ - exit 1;; \ - esac; \ - has_opt=no; \ - sane_makeflags=$$MAKEFLAGS; \ - if $(am__is_gnu_make); then \ - sane_makeflags=$$MFLAGS; \ - else \ - case $$MAKEFLAGS in \ - *\\[\ \ ]*) \ - bs=\\; \ - sane_makeflags=`printf '%s\n' "$$MAKEFLAGS" \ - | sed "s/$$bs$$bs[$$bs $$bs ]*//g"`;; \ - esac; \ - fi; \ - skip_next=no; \ - strip_trailopt () \ - { \ - flg=`printf '%s\n' "$$flg" | sed "s/$$1.*$$//"`; \ - }; \ - for flg in $$sane_makeflags; do \ - test $$skip_next = yes && { skip_next=no; continue; }; \ - case $$flg in \ - *=*|--*) continue;; \ - -*I) strip_trailopt 'I'; skip_next=yes;; \ - -*I?*) strip_trailopt 'I';; \ - -*O) strip_trailopt 'O'; skip_next=yes;; \ - -*O?*) strip_trailopt 'O';; \ - -*l) strip_trailopt 'l'; skip_next=yes;; \ - -*l?*) strip_trailopt 'l';; \ - -[dEDm]) skip_next=yes;; \ - -[JT]) skip_next=yes;; \ - esac; \ - case $$flg in \ - *$$target_option*) has_opt=yes; break;; \ - esac; \ - done; \ - test $$has_opt = yes -am__make_dryrun = (target_option=n; $(am__make_running_with_option)) -am__make_keepgoing = (target_option=k; $(am__make_running_with_option)) -pkgdatadir = $(datadir)/@PACKAGE@ -pkgincludedir = $(includedir)/@PACKAGE@ -pkglibdir = $(libdir)/@PACKAGE@ -pkglibexecdir = $(libexecdir)/@PACKAGE@ -am__cd = CDPATH="$${ZSH_VERSION+.}$(PATH_SEPARATOR)" && cd -install_sh_DATA = $(install_sh) -c -m 644 -install_sh_PROGRAM = $(install_sh) -c -install_sh_SCRIPT = $(install_sh) -c -INSTALL_HEADER = $(INSTALL_DATA) -transform = $(program_transform_name) -NORMAL_INSTALL = : -PRE_INSTALL = : -POST_INSTALL = : -NORMAL_UNINSTALL = : -PRE_UNINSTALL = : -POST_UNINSTALL = : -build_triplet = @build@ -host_triplet = @host@ -subdir = doc -ACLOCAL_M4 = $(top_srcdir)/aclocal.m4 -am__aclocal_m4_deps = $(top_srcdir)/m4/codeset.m4 \ - $(top_srcdir)/m4/gettext.m4 $(top_srcdir)/m4/iconv.m4 \ - $(top_srcdir)/m4/intlmacosx.m4 $(top_srcdir)/m4/lib-ld.m4 \ - $(top_srcdir)/m4/lib-link.m4 $(top_srcdir)/m4/lib-prefix.m4 \ - $(top_srcdir)/m4/libtool.m4 $(top_srcdir)/m4/ltoptions.m4 \ - $(top_srcdir)/m4/ltsugar.m4 $(top_srcdir)/m4/ltversion.m4 \ - $(top_srcdir)/m4/lt~obsolete.m4 \ - $(top_srcdir)/m4/m4_ax_check_define.m4 \ - $(top_srcdir)/m4/m4_ax_code_coverage.m4 \ - $(top_srcdir)/m4/nls.m4 $(top_srcdir)/m4/pkg.m4 \ - $(top_srcdir)/m4/po.m4 $(top_srcdir)/m4/progtest.m4 \ - $(top_srcdir)/configure.ac -am__configure_deps = $(am__aclocal_m4_deps) $(CONFIGURE_DEPENDENCIES) \ - $(ACLOCAL_M4) -DIST_COMMON = $(srcdir)/Makefile.am $(srcdir)/version.texi \ - $(srcdir)/stamp-vti $(am__DIST_COMMON) -mkinstalldirs = $(SHELL) $(top_srcdir)/build_aux/mkinstalldirs -CONFIG_HEADER = $(top_builddir)/config.h -CONFIG_CLEAN_FILES = -CONFIG_CLEAN_VPATH_FILES = -AM_V_P = $(am__v_P_@AM_V@) -am__v_P_ = $(am__v_P_@AM_DEFAULT_V@) -am__v_P_0 = false -am__v_P_1 = : -AM_V_GEN = $(am__v_GEN_@AM_V@) -am__v_GEN_ = $(am__v_GEN_@AM_DEFAULT_V@) -am__v_GEN_0 = @echo " GEN " $@; -am__v_GEN_1 = -AM_V_at = $(am__v_at_@AM_V@) -am__v_at_ = $(am__v_at_@AM_DEFAULT_V@) -am__v_at_0 = @ -am__v_at_1 = -SOURCES = -DIST_SOURCES = -AM_V_DVIPS = $(am__v_DVIPS_@AM_V@) -am__v_DVIPS_ = $(am__v_DVIPS_@AM_DEFAULT_V@) -am__v_DVIPS_0 = @echo " DVIPS " $@; -am__v_DVIPS_1 = -AM_V_MAKEINFO = $(am__v_MAKEINFO_@AM_V@) -am__v_MAKEINFO_ = $(am__v_MAKEINFO_@AM_DEFAULT_V@) -am__v_MAKEINFO_0 = @echo " MAKEINFO" $@; -am__v_MAKEINFO_1 = -AM_V_INFOHTML = $(am__v_INFOHTML_@AM_V@) -am__v_INFOHTML_ = $(am__v_INFOHTML_@AM_DEFAULT_V@) -am__v_INFOHTML_0 = @echo " INFOHTML" $@; -am__v_INFOHTML_1 = -AM_V_TEXI2DVI = $(am__v_TEXI2DVI_@AM_V@) -am__v_TEXI2DVI_ = $(am__v_TEXI2DVI_@AM_DEFAULT_V@) -am__v_TEXI2DVI_0 = @echo " TEXI2DVI" $@; -am__v_TEXI2DVI_1 = -AM_V_TEXI2PDF = $(am__v_TEXI2PDF_@AM_V@) -am__v_TEXI2PDF_ = $(am__v_TEXI2PDF_@AM_DEFAULT_V@) -am__v_TEXI2PDF_0 = @echo " TEXI2PDF" $@; -am__v_TEXI2PDF_1 = -AM_V_texinfo = $(am__v_texinfo_@AM_V@) -am__v_texinfo_ = $(am__v_texinfo_@AM_DEFAULT_V@) -am__v_texinfo_0 = -q -am__v_texinfo_1 = -AM_V_texidevnull = $(am__v_texidevnull_@AM_V@) -am__v_texidevnull_ = $(am__v_texidevnull_@AM_DEFAULT_V@) -am__v_texidevnull_0 = > /dev/null -am__v_texidevnull_1 = -INFO_DEPS = $(srcdir)/gnucobol.info -TEXINFO_TEX = $(top_srcdir)/build_aux/texinfo.tex -am__TEXINFO_TEX_DIR = $(top_srcdir)/build_aux -DVIS = gnucobol.dvi -PDFS = gnucobol.pdf -PSS = gnucobol.ps -HTMLS = gnucobol.html -TEXINFOS = gnucobol.texi -TEXI2PDF = $(TEXI2DVI) --pdf --batch -MAKEINFOHTML = $(MAKEINFO) --html -DVIPS = dvips -am__can_run_installinfo = \ - case $$AM_UPDATE_INFO_DIR in \ - n|no|NO) false;; \ - *) (install-info --version) >/dev/null 2>&1;; \ - esac -am__installdirs = "$(DESTDIR)$(infodir)" -am__vpath_adj_setup = srcdirstrip=`echo "$(srcdir)" | sed 's|.|.|g'`; -am__vpath_adj = case $$p in \ - $(srcdir)/*) f=`echo "$$p" | sed "s|^$$srcdirstrip/||"`;; \ - *) f=$$p;; \ - esac; -am__strip_dir = f=`echo $$p | sed -e 's|^.*/||'`; -am__install_max = 40 -am__nobase_strip_setup = \ - srcdirstrip=`echo "$(srcdir)" | sed 's/[].[^$$\\*|]/\\\\&/g'` -am__nobase_strip = \ - for p in $$list; do echo "$$p"; done | sed -e "s|$$srcdirstrip/||" -am__nobase_list = $(am__nobase_strip_setup); \ - for p in $$list; do echo "$$p $$p"; done | \ - sed "s| $$srcdirstrip/| |;"' / .*\//!s/ .*/ ./; s,\( .*\)/[^/]*$$,\1,' | \ - $(AWK) 'BEGIN { files["."] = "" } { files[$$2] = files[$$2] " " $$1; \ - if (++n[$$2] == $(am__install_max)) \ - { print $$2, files[$$2]; n[$$2] = 0; files[$$2] = "" } } \ - END { for (dir in files) print dir, files[dir] }' -am__base_list = \ - sed '$$!N;$$!N;$$!N;$$!N;$$!N;$$!N;$$!N;s/\n/ /g' | \ - sed '$$!N;$$!N;$$!N;$$!N;s/\n/ /g' -am__uninstall_files_from_dir = { \ - test -z "$$files" \ - || { test ! -d "$$dir" && test ! -f "$$dir" && test ! -r "$$dir"; } \ - || { echo " ( cd '$$dir' && rm -f" $$files ")"; \ - $(am__cd) "$$dir" && rm -f $$files; }; \ - } -am__tagged_files = $(HEADERS) $(SOURCES) $(TAGS_FILES) $(LISP) -am__DIST_COMMON = $(gnucobol_TEXINFOS) $(srcdir)/Makefile.in \ - $(top_srcdir)/build_aux/mdate-sh \ - $(top_srcdir)/build_aux/mkinstalldirs ChangeLog -DISTFILES = $(DIST_COMMON) $(DIST_SOURCES) $(TEXINFOS) $(EXTRA_DIST) -ACLOCAL = @ACLOCAL@ -AMTAR = @AMTAR@ -AM_DEFAULT_VERBOSITY = @AM_DEFAULT_VERBOSITY@ -AR = @AR@ -AS = @AS@ -AUTOCONF = @AUTOCONF@ -AUTOHEADER = @AUTOHEADER@ -AUTOMAKE = @AUTOMAKE@ -AWK = @AWK@ -CC = @CC@ -CCDEPMODE = @CCDEPMODE@ -CFLAGS = @CFLAGS@ -CJSON_CFLAGS = @CJSON_CFLAGS@ -CJSON_LIBS = @CJSON_LIBS@ -COBC_LIBS = @COBC_LIBS@ -COB_BIGENDIAN = @COB_BIGENDIAN@ -COB_CC = @COB_CC@ -COB_CFLAGS = @COB_CFLAGS@ -COB_CONFIG_DIR = @COB_CONFIG_DIR@ -COB_COPY_DIR = @COB_COPY_DIR@ -COB_EXE_EXT = @COB_EXE_EXT@ -COB_EXPORT_DYN = @COB_EXPORT_DYN@ -COB_FIX_LIB = @COB_FIX_LIB@ -COB_FIX_LIBTOOL = @COB_FIX_LIBTOOL@ -COB_HAS_64_BIT_POINTER = @COB_HAS_64_BIT_POINTER@ -COB_HAS_BDB = @COB_HAS_BDB@ -COB_HAS_CISAM = @COB_HAS_CISAM@ -COB_HAS_CJSON = @COB_HAS_CJSON@ -COB_HAS_CURSES = @COB_HAS_CURSES@ -COB_HAS_DISAM = @COB_HAS_DISAM@ -COB_HAS_ISAM = @COB_HAS_ISAM@ -COB_HAS_LMDB = @COB_HAS_LMDB@ -COB_HAS_OCEXTFH = @COB_HAS_OCEXTFH@ -COB_HAS_OCI = @COB_HAS_OCI@ -COB_HAS_ODBC = @COB_HAS_ODBC@ -COB_HAS_VBISAM = @COB_HAS_VBISAM@ -COB_HAS_XML2 = @COB_HAS_XML2@ -COB_KEYWORD_INLINE = @COB_KEYWORD_INLINE@ -COB_LDFLAGS = @COB_LDFLAGS@ -COB_LIBRARY_PATH = @COB_LIBRARY_PATH@ -COB_LIBS = @COB_LIBS@ -COB_MODULE_EXT = @COB_MODULE_EXT@ -COB_OBJECT_EXT = @COB_OBJECT_EXT@ -COB_PATCH_LEVEL = @COB_PATCH_LEVEL@ -COB_PIC_FLAGS = @COB_PIC_FLAGS@ -COB_SCHEMA_DIR = @COB_SCHEMA_DIR@ -COB_SHARED_OPT = @COB_SHARED_OPT@ -CODE_COVERAGE_CFLAGS = @CODE_COVERAGE_CFLAGS@ -CODE_COVERAGE_CPPFLAGS = @CODE_COVERAGE_CPPFLAGS@ -CODE_COVERAGE_CXXFLAGS = @CODE_COVERAGE_CXXFLAGS@ -CODE_COVERAGE_ENABLED = @CODE_COVERAGE_ENABLED@ -CODE_COVERAGE_LDFLAGS = @CODE_COVERAGE_LDFLAGS@ -CODE_COVERAGE_LIBS = @CODE_COVERAGE_LIBS@ -CPP = @CPP@ -CPPFLAGS = @CPPFLAGS@ -CYGPATH_W = @CYGPATH_W@ -DEFS = @DEFS@ -DEPDIR = @DEPDIR@ -DIFF_FLAGS = @DIFF_FLAGS@ -DLLTOOL = @DLLTOOL@ -DSYMUTIL = @DSYMUTIL@ -DUMPBIN = @DUMPBIN@ -ECHO_C = @ECHO_C@ -ECHO_N = @ECHO_N@ -ECHO_T = @ECHO_T@ -EGREP = @EGREP@ -EXEEXT = @EXEEXT@ -FGREP = @FGREP@ -GCOV = @GCOV@ -GENHTML = @GENHTML@ -GETTEXT_MACRO_VERSION = @GETTEXT_MACRO_VERSION@ -GMSGFMT = @GMSGFMT@ -GMSGFMT_015 = @GMSGFMT_015@ -GREP = @GREP@ -HELP2MAN = @HELP2MAN@ -INSTALL = @INSTALL@ -INSTALL_DATA = @INSTALL_DATA@ -INSTALL_PROGRAM = @INSTALL_PROGRAM@ -INSTALL_SCRIPT = @INSTALL_SCRIPT@ -INSTALL_STRIP_PROGRAM = @INSTALL_STRIP_PROGRAM@ -INTLLIBS = @INTLLIBS@ -INTL_MACOSX_LIBS = @INTL_MACOSX_LIBS@ -LCOV = @LCOV@ -LD = @LD@ -LDFLAGS = @LDFLAGS@ -LEX = @LEX@ -LEXLIB = @LEXLIB@ -LEX_OUTPUT_ROOT = @LEX_OUTPUT_ROOT@ -LIBCOB_CISAM = @LIBCOB_CISAM@ -LIBCOB_CPPFLAGS = @LIBCOB_CPPFLAGS@ -LIBCOB_DISAM = @LIBCOB_DISAM@ -LIBCOB_LIBS = @LIBCOB_LIBS@ -LIBCOB_VBISAM = @LIBCOB_VBISAM@ -LIBICONV = @LIBICONV@ -LIBINTL = @LIBINTL@ -LIBOBJS = @LIBOBJS@ -LIBS = @LIBS@ -LIBTOOL = @LIBTOOL@ -LIPO = @LIPO@ -LN_S = @LN_S@ -LTLIBICONV = @LTLIBICONV@ -LTLIBINTL = @LTLIBINTL@ -LTLIBOBJS = @LTLIBOBJS@ -LT_SYS_LIBRARY_PATH = @LT_SYS_LIBRARY_PATH@ -MAKE = @MAKE@ -MAKEINFO = @MAKEINFO@ -MANIFEST_TOOL = @MANIFEST_TOOL@ -MKDIR_P = @MKDIR_P@ -MSGFMT = @MSGFMT@ -MSGFMT_015 = @MSGFMT_015@ -MSGMERGE = @MSGMERGE@ -NM = @NM@ -NMEDIT = @NMEDIT@ -OBJDUMP = @OBJDUMP@ -OBJEXT = @OBJEXT@ -ODBC_CFLAGS = @ODBC_CFLAGS@ -ODBC_LIBS = @ODBC_LIBS@ -OTOOL = @OTOOL@ -OTOOL64 = @OTOOL64@ -PACKAGE = @PACKAGE@ -PACKAGE_BUGREPORT = @PACKAGE_BUGREPORT@ -PACKAGE_NAME = @PACKAGE_NAME@ -PACKAGE_STRING = @PACKAGE_STRING@ -PACKAGE_TARNAME = @PACKAGE_TARNAME@ -PACKAGE_URL = @PACKAGE_URL@ -PACKAGE_VERSION = @PACKAGE_VERSION@ -PATH_SEPARATOR = @PATH_SEPARATOR@ -PKG_CONFIG = @PKG_CONFIG@ -PKG_CONFIG_LIBDIR = @PKG_CONFIG_LIBDIR@ -PKG_CONFIG_PATH = @PKG_CONFIG_PATH@ -POSUB = @POSUB@ -RANLIB = @RANLIB@ -SED = @SED@ -SET_MAKE = @SET_MAKE@ -SHELL = @SHELL@ -STRIP = @STRIP@ -USE_NLS = @USE_NLS@ -VERSION = @VERSION@ -XGETTEXT = @XGETTEXT@ -XGETTEXT_015 = @XGETTEXT_015@ -XGETTEXT_EXTRA_OPTIONS = @XGETTEXT_EXTRA_OPTIONS@ -XML2_CFLAGS = @XML2_CFLAGS@ -XML2_LIBS = @XML2_LIBS@ -YACC = @YACC@ -YFLAGS = @YFLAGS@ -abs_builddir = @abs_builddir@ -abs_srcdir = @abs_srcdir@ -abs_top_builddir = @abs_top_builddir@ -abs_top_srcdir = @abs_top_srcdir@ -ac_ct_AR = @ac_ct_AR@ -ac_ct_CC = @ac_ct_CC@ -ac_ct_DUMPBIN = @ac_ct_DUMPBIN@ -am__include = @am__include@ -am__leading_dot = @am__leading_dot@ -am__quote = @am__quote@ -am__tar = @am__tar@ -am__untar = @am__untar@ -bindir = @bindir@ -build = @build@ -build_alias = @build_alias@ -build_cpu = @build_cpu@ -build_os = @build_os@ -build_vendor = @build_vendor@ -builddir = @builddir@ -configured_make = @configured_make@ -datadir = @datadir@ -datarootdir = @datarootdir@ -docdir = @docdir@ -dvidir = @dvidir@ -exec_prefix = @exec_prefix@ -host = @host@ -host_alias = @host_alias@ -host_cpu = @host_cpu@ -host_os = @host_os@ -host_vendor = @host_vendor@ -htmldir = @htmldir@ -includedir = @includedir@ -infodir = @infodir@ -install_sh = @install_sh@ -libdir = @libdir@ -libexecdir = @libexecdir@ -localedir = @localedir@ -localstatedir = @localstatedir@ -mandir = @mandir@ -mkdir_p = @mkdir_p@ -oldincludedir = @oldincludedir@ -pdfdir = @pdfdir@ -prefix = @prefix@ -program_transform_name = @program_transform_name@ -psdir = @psdir@ -runstatedir = @runstatedir@ -sbindir = @sbindir@ -sharedstatedir = @sharedstatedir@ -srcdir = @srcdir@ -sysconfdir = @sysconfdir@ -target_alias = @target_alias@ -top_build_prefix = @top_build_prefix@ -top_builddir = @top_builddir@ -top_srcdir = @top_srcdir@ -xml2_config_found = @xml2_config_found@ -COBC = cobc$(EXEEXT) -COBCRUN = cobcrun$(EXEEXT) -PASSED_OPTIONS = GREP=$(GREP) SED=$(SED) COBC=$(COBC) COBCRUN=$(COBCRUN) -COBCINFOSH = $(PASSED_OPTIONS) $(abs_top_builddir)/pre-inst-env \ - $(top_srcdir)/doc/cobcinfo.sh - -info_TEXINFOS = gnucobol.texi -GENINCLUDES = cbhelp.tex cbrese.tex cbintr.tex cbsyst.tex cbmnem.tex \ - cbconf.tex cbchelp.tex cbrunt.tex - -gnucobol_TEXINFOS = $(GENINCLUDES) fdl.texi -BUILT_SOURCES = $(GENINCLUDES) -EXTRA_DIST = gnucobol.pdf -AM_MAKEINFOHTMLFLAGS = --no-headers --no-split -CLEANFILES = *.aux *.cp *.fn *.ky *.log *.pg *.toc *.tp *.vr *.vrs -MAINTAINERCLEANFILES = $(GENINCLUDES) -TEXI2DVI = texi2dvi -I $(srcdir) -all: $(BUILT_SOURCES) - $(MAKE) $(AM_MAKEFLAGS) all-am - -.SUFFIXES: -.SUFFIXES: .dvi .html .info .pdf .ps .texi -$(srcdir)/Makefile.in: $(srcdir)/Makefile.am $(am__configure_deps) - @for dep in $?; do \ - case '$(am__configure_deps)' in \ - *$$dep*) \ - ( cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh ) \ - && { if test -f $@; then exit 0; else break; fi; }; \ - exit 1;; \ - esac; \ - done; \ - echo ' cd $(top_srcdir) && $(AUTOMAKE) --gnu doc/Makefile'; \ - $(am__cd) $(top_srcdir) && \ - $(AUTOMAKE) --gnu doc/Makefile -Makefile: $(srcdir)/Makefile.in $(top_builddir)/config.status - @case '$?' in \ - *config.status*) \ - cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh;; \ - *) \ - echo ' cd $(top_builddir) && $(SHELL) ./config.status $(subdir)/$@ $(am__depfiles_maybe)'; \ - cd $(top_builddir) && $(SHELL) ./config.status $(subdir)/$@ $(am__depfiles_maybe);; \ - esac; - -$(top_builddir)/config.status: $(top_srcdir)/configure $(CONFIG_STATUS_DEPENDENCIES) - cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh - -$(top_srcdir)/configure: $(am__configure_deps) - cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh -$(ACLOCAL_M4): $(am__aclocal_m4_deps) - cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh -$(am__aclocal_m4_deps): - -mostlyclean-libtool: - -rm -f *.lo - -clean-libtool: - -rm -rf .libs _libs - -.texi.info: - $(AM_V_MAKEINFO)restore=: && backupdir="$(am__leading_dot)am$$$$" && \ - am__cwd=`pwd` && $(am__cd) $(srcdir) && \ - rm -rf $$backupdir && mkdir $$backupdir && \ - if ($(MAKEINFO) --version) >/dev/null 2>&1; then \ - for f in $@ $@-[0-9] $@-[0-9][0-9] $(@:.info=).i[0-9] $(@:.info=).i[0-9][0-9]; do \ - if test -f $$f; then mv $$f $$backupdir; restore=mv; else :; fi; \ - done; \ - else :; fi && \ - cd "$$am__cwd"; \ - if $(MAKEINFO) $(AM_MAKEINFOFLAGS) $(MAKEINFOFLAGS) -I $(srcdir) \ - -o $@ $<; \ - then \ - rc=0; \ - $(am__cd) $(srcdir); \ - else \ - rc=$$?; \ - $(am__cd) $(srcdir) && \ - $$restore $$backupdir/* `echo "./$@" | sed 's|[^/]*$$||'`; \ - fi; \ - rm -rf $$backupdir; exit $$rc - -.texi.dvi: - $(AM_V_TEXI2DVI)TEXINPUTS="$(am__TEXINFO_TEX_DIR)$(PATH_SEPARATOR)$$TEXINPUTS" \ - MAKEINFO='$(MAKEINFO) $(AM_MAKEINFOFLAGS) $(MAKEINFOFLAGS) -I $(srcdir)' \ - $(TEXI2DVI) $(AM_V_texinfo) --build-dir=$(@:.dvi=.t2d) -o $@ $(AM_V_texidevnull) \ - $< - -.texi.pdf: - $(AM_V_TEXI2PDF)TEXINPUTS="$(am__TEXINFO_TEX_DIR)$(PATH_SEPARATOR)$$TEXINPUTS" \ - MAKEINFO='$(MAKEINFO) $(AM_MAKEINFOFLAGS) $(MAKEINFOFLAGS) -I $(srcdir)' \ - $(TEXI2PDF) $(AM_V_texinfo) --build-dir=$(@:.pdf=.t2p) -o $@ $(AM_V_texidevnull) \ - $< - -.texi.html: - $(AM_V_MAKEINFO)rm -rf $(@:.html=.htp) - $(AM_V_at)if $(MAKEINFOHTML) $(AM_MAKEINFOHTMLFLAGS) $(MAKEINFOFLAGS) -I $(srcdir) \ - -o $(@:.html=.htp) $<; \ - then \ - rm -rf $@ && mv $(@:.html=.htp) $@; \ - else \ - rm -rf $(@:.html=.htp); exit 1; \ - fi -$(srcdir)/gnucobol.info: gnucobol.texi $(srcdir)/version.texi $(gnucobol_TEXINFOS) -gnucobol.dvi: gnucobol.texi $(srcdir)/version.texi $(gnucobol_TEXINFOS) -gnucobol.pdf: gnucobol.texi $(srcdir)/version.texi $(gnucobol_TEXINFOS) -gnucobol.html: gnucobol.texi $(srcdir)/version.texi $(gnucobol_TEXINFOS) -$(srcdir)/version.texi: $(srcdir)/stamp-vti -$(srcdir)/stamp-vti: gnucobol.texi $(top_srcdir)/configure - @(dir=.; test -f ./gnucobol.texi || dir=$(srcdir); \ - set `$(SHELL) $(top_srcdir)/build_aux/mdate-sh $$dir/gnucobol.texi`; \ - echo "@set UPDATED $$1 $$2 $$3"; \ - echo "@set UPDATED-MONTH $$2 $$3"; \ - echo "@set EDITION $(VERSION)"; \ - echo "@set VERSION $(VERSION)") > vti.tmp$$$$ && \ - (cmp -s vti.tmp$$$$ $(srcdir)/version.texi \ - || (echo "Updating $(srcdir)/version.texi" && \ - cp vti.tmp$$$$ $(srcdir)/version.texi.tmp$$$$ && \ - mv $(srcdir)/version.texi.tmp$$$$ $(srcdir)/version.texi)) && \ - rm -f vti.tmp$$$$ $(srcdir)/version.texi.$$$$ - @cp $(srcdir)/version.texi $@ - -mostlyclean-vti: - -rm -f vti.tmp* $(srcdir)/version.texi.tmp* - -maintainer-clean-vti: - -rm -f $(srcdir)/stamp-vti $(srcdir)/version.texi -.dvi.ps: - $(AM_V_DVIPS)TEXINPUTS="$(am__TEXINFO_TEX_DIR)$(PATH_SEPARATOR)$$TEXINPUTS" \ - $(DVIPS) $(AM_V_texinfo) -o $@ $< - -uninstall-dvi-am: - @$(NORMAL_UNINSTALL) - @list='$(DVIS)'; test -n "$(dvidir)" || list=; \ - for p in $$list; do \ - $(am__strip_dir) \ - echo " rm -f '$(DESTDIR)$(dvidir)/$$f'"; \ - rm -f "$(DESTDIR)$(dvidir)/$$f"; \ - done - -uninstall-html-am: - @$(NORMAL_UNINSTALL) - @list='$(HTMLS)'; test -n "$(htmldir)" || list=; \ - for p in $$list; do \ - $(am__strip_dir) \ - echo " rm -rf '$(DESTDIR)$(htmldir)/$$f'"; \ - rm -rf "$(DESTDIR)$(htmldir)/$$f"; \ - done - -uninstall-info-am: - @$(PRE_UNINSTALL) - @if test -d '$(DESTDIR)$(infodir)' && $(am__can_run_installinfo); then \ - list='$(INFO_DEPS)'; \ - for file in $$list; do \ - relfile=`echo "$$file" | sed 's|^.*/||'`; \ - echo " install-info --info-dir='$(DESTDIR)$(infodir)' --remove '$(DESTDIR)$(infodir)/$$relfile'"; \ - if install-info --info-dir="$(DESTDIR)$(infodir)" --remove "$(DESTDIR)$(infodir)/$$relfile"; \ - then :; else test ! -f "$(DESTDIR)$(infodir)/$$relfile" || exit 1; fi; \ - done; \ - else :; fi - @$(NORMAL_UNINSTALL) - @list='$(INFO_DEPS)'; \ - for file in $$list; do \ - relfile=`echo "$$file" | sed 's|^.*/||'`; \ - relfile_i=`echo "$$relfile" | sed 's|\.info$$||;s|$$|.i|'`; \ - (if test -d "$(DESTDIR)$(infodir)" && cd "$(DESTDIR)$(infodir)"; then \ - echo " cd '$(DESTDIR)$(infodir)' && rm -f $$relfile $$relfile-[0-9] $$relfile-[0-9][0-9] $$relfile_i[0-9] $$relfile_i[0-9][0-9]"; \ - rm -f $$relfile $$relfile-[0-9] $$relfile-[0-9][0-9] $$relfile_i[0-9] $$relfile_i[0-9][0-9]; \ - else :; fi); \ - done - -uninstall-pdf-am: - @$(NORMAL_UNINSTALL) - @list='$(PDFS)'; test -n "$(pdfdir)" || list=; \ - for p in $$list; do \ - $(am__strip_dir) \ - echo " rm -f '$(DESTDIR)$(pdfdir)/$$f'"; \ - rm -f "$(DESTDIR)$(pdfdir)/$$f"; \ - done - -uninstall-ps-am: - @$(NORMAL_UNINSTALL) - @list='$(PSS)'; test -n "$(psdir)" || list=; \ - for p in $$list; do \ - $(am__strip_dir) \ - echo " rm -f '$(DESTDIR)$(psdir)/$$f'"; \ - rm -f "$(DESTDIR)$(psdir)/$$f"; \ - done - -dist-info: $(INFO_DEPS) - @srcdirstrip=`echo "$(srcdir)" | sed 's|.|.|g'`; \ - list='$(INFO_DEPS)'; \ - for base in $$list; do \ - case $$base in \ - $(srcdir)/*) base=`echo "$$base" | sed "s|^$$srcdirstrip/||"`;; \ - esac; \ - if test -f $$base; then d=.; else d=$(srcdir); fi; \ - base_i=`echo "$$base" | sed 's|\.info$$||;s|$$|.i|'`; \ - for file in $$d/$$base $$d/$$base-[0-9] $$d/$$base-[0-9][0-9] $$d/$$base_i[0-9] $$d/$$base_i[0-9][0-9]; do \ - if test -f $$file; then \ - relfile=`expr "$$file" : "$$d/\(.*\)"`; \ - test -f "$(distdir)/$$relfile" || \ - cp -p $$file "$(distdir)/$$relfile"; \ - else :; fi; \ - done; \ - done - -mostlyclean-aminfo: - -rm -rf gnucobol.t2d gnucobol.t2p - -clean-aminfo: - -test -z "gnucobol.dvi gnucobol.pdf gnucobol.ps gnucobol.html" \ - || rm -rf gnucobol.dvi gnucobol.pdf gnucobol.ps gnucobol.html - -maintainer-clean-aminfo: - @list='$(INFO_DEPS)'; for i in $$list; do \ - i_i=`echo "$$i" | sed 's|\.info$$||;s|$$|.i|'`; \ - echo " rm -f $$i $$i-[0-9] $$i-[0-9][0-9] $$i_i[0-9] $$i_i[0-9][0-9]"; \ - rm -f $$i $$i-[0-9] $$i-[0-9][0-9] $$i_i[0-9] $$i_i[0-9][0-9]; \ - done -tags TAGS: - -ctags CTAGS: - -cscope cscopelist: - - -distdir: $(DISTFILES) - @srcdirstrip=`echo "$(srcdir)" | sed 's/[].[^$$\\*]/\\\\&/g'`; \ - topsrcdirstrip=`echo "$(top_srcdir)" | sed 's/[].[^$$\\*]/\\\\&/g'`; \ - list='$(DISTFILES)'; \ - dist_files=`for file in $$list; do echo $$file; done | \ - sed -e "s|^$$srcdirstrip/||;t" \ - -e "s|^$$topsrcdirstrip/|$(top_builddir)/|;t"`; \ - case $$dist_files in \ - */*) $(MKDIR_P) `echo "$$dist_files" | \ - sed '/\//!d;s|^|$(distdir)/|;s,/[^/]*$$,,' | \ - sort -u` ;; \ - esac; \ - for file in $$dist_files; do \ - if test -f $$file || test -d $$file; then d=.; else d=$(srcdir); fi; \ - if test -d $$d/$$file; then \ - dir=`echo "/$$file" | sed -e 's,/[^/]*$$,,'`; \ - if test -d "$(distdir)/$$file"; then \ - find "$(distdir)/$$file" -type d ! -perm -700 -exec chmod u+rwx {} \;; \ - fi; \ - if test -d $(srcdir)/$$file && test $$d != $(srcdir); then \ - cp -fpR $(srcdir)/$$file "$(distdir)$$dir" || exit 1; \ - find "$(distdir)/$$file" -type d ! -perm -700 -exec chmod u+rwx {} \;; \ - fi; \ - cp -fpR $$d/$$file "$(distdir)$$dir" || exit 1; \ - else \ - test -f "$(distdir)/$$file" \ - || cp -p $$d/$$file "$(distdir)/$$file" \ - || exit 1; \ - fi; \ - done - $(MAKE) $(AM_MAKEFLAGS) \ - top_distdir="$(top_distdir)" distdir="$(distdir)" \ - dist-info -check-am: all-am -check: $(BUILT_SOURCES) - $(MAKE) $(AM_MAKEFLAGS) check-am -all-am: Makefile $(INFO_DEPS) -installdirs: - for dir in "$(DESTDIR)$(infodir)"; do \ - test -z "$$dir" || $(MKDIR_P) "$$dir"; \ - done -install: $(BUILT_SOURCES) - $(MAKE) $(AM_MAKEFLAGS) install-am -install-exec: install-exec-am -install-data: install-data-am -uninstall: uninstall-am - -install-am: all-am - @$(MAKE) $(AM_MAKEFLAGS) install-exec-am install-data-am - -installcheck: installcheck-am -install-strip: - if test -z '$(STRIP)'; then \ - $(MAKE) $(AM_MAKEFLAGS) INSTALL_PROGRAM="$(INSTALL_STRIP_PROGRAM)" \ - install_sh_PROGRAM="$(INSTALL_STRIP_PROGRAM)" INSTALL_STRIP_FLAG=-s \ - install; \ - else \ - $(MAKE) $(AM_MAKEFLAGS) INSTALL_PROGRAM="$(INSTALL_STRIP_PROGRAM)" \ - install_sh_PROGRAM="$(INSTALL_STRIP_PROGRAM)" INSTALL_STRIP_FLAG=-s \ - "INSTALL_PROGRAM_ENV=STRIPPROG='$(STRIP)'" install; \ - fi -mostlyclean-generic: - -clean-generic: - -test -z "$(CLEANFILES)" || rm -f $(CLEANFILES) - -distclean-generic: - -test -z "$(CONFIG_CLEAN_FILES)" || rm -f $(CONFIG_CLEAN_FILES) - -test . = "$(srcdir)" || test -z "$(CONFIG_CLEAN_VPATH_FILES)" || rm -f $(CONFIG_CLEAN_VPATH_FILES) - -maintainer-clean-generic: - @echo "This command is intended for maintainers to use" - @echo "it deletes files that may require special tools to rebuild." - -test -z "$(BUILT_SOURCES)" || rm -f $(BUILT_SOURCES) - -test -z "$(MAINTAINERCLEANFILES)" || rm -f $(MAINTAINERCLEANFILES) -clean: clean-am - -clean-am: clean-aminfo clean-generic clean-libtool mostlyclean-am - -distclean: distclean-am - -rm -f Makefile -distclean-am: clean-am distclean-generic - -dvi: dvi-am - -dvi-am: $(DVIS) - -html: html-am - -html-am: $(HTMLS) - -info: info-am - -info-am: $(INFO_DEPS) - -install-data-am: install-info-am - -install-dvi: install-dvi-am - -install-dvi-am: $(DVIS) - @$(NORMAL_INSTALL) - @list='$(DVIS)'; test -n "$(dvidir)" || list=; \ - if test -n "$$list"; then \ - echo " $(MKDIR_P) '$(DESTDIR)$(dvidir)'"; \ - $(MKDIR_P) "$(DESTDIR)$(dvidir)" || exit 1; \ - fi; \ - for p in $$list; do \ - if test -f "$$p"; then d=; else d="$(srcdir)/"; fi; \ - echo "$$d$$p"; \ - done | $(am__base_list) | \ - while read files; do \ - echo " $(INSTALL_DATA) $$files '$(DESTDIR)$(dvidir)'"; \ - $(INSTALL_DATA) $$files "$(DESTDIR)$(dvidir)" || exit $$?; \ - done -install-exec-am: - -install-html: install-html-am - -install-html-am: $(HTMLS) - @$(NORMAL_INSTALL) - @list='$(HTMLS)'; list2=; test -n "$(htmldir)" || list=; \ - if test -n "$$list"; then \ - echo " $(MKDIR_P) '$(DESTDIR)$(htmldir)'"; \ - $(MKDIR_P) "$(DESTDIR)$(htmldir)" || exit 1; \ - fi; \ - for p in $$list; do \ - if test -f "$$p" || test -d "$$p"; then d=; else d="$(srcdir)/"; fi; \ - $(am__strip_dir) \ - d2=$$d$$p; \ - if test -d "$$d2"; then \ - echo " $(MKDIR_P) '$(DESTDIR)$(htmldir)/$$f'"; \ - $(MKDIR_P) "$(DESTDIR)$(htmldir)/$$f" || exit 1; \ - echo " $(INSTALL_DATA) '$$d2'/* '$(DESTDIR)$(htmldir)/$$f'"; \ - $(INSTALL_DATA) "$$d2"/* "$(DESTDIR)$(htmldir)/$$f" || exit $$?; \ - else \ - list2="$$list2 $$d2"; \ - fi; \ - done; \ - test -z "$$list2" || { echo "$$list2" | $(am__base_list) | \ - while read files; do \ - echo " $(INSTALL_DATA) $$files '$(DESTDIR)$(htmldir)'"; \ - $(INSTALL_DATA) $$files "$(DESTDIR)$(htmldir)" || exit $$?; \ - done; } -install-info: install-info-am - -install-info-am: $(INFO_DEPS) - @$(NORMAL_INSTALL) - @srcdirstrip=`echo "$(srcdir)" | sed 's|.|.|g'`; \ - list='$(INFO_DEPS)'; test -n "$(infodir)" || list=; \ - if test -n "$$list"; then \ - echo " $(MKDIR_P) '$(DESTDIR)$(infodir)'"; \ - $(MKDIR_P) "$(DESTDIR)$(infodir)" || exit 1; \ - fi; \ - for file in $$list; do \ - case $$file in \ - $(srcdir)/*) file=`echo "$$file" | sed "s|^$$srcdirstrip/||"`;; \ - esac; \ - if test -f $$file; then d=.; else d=$(srcdir); fi; \ - file_i=`echo "$$file" | sed 's|\.info$$||;s|$$|.i|'`; \ - for ifile in $$d/$$file $$d/$$file-[0-9] $$d/$$file-[0-9][0-9] \ - $$d/$$file_i[0-9] $$d/$$file_i[0-9][0-9] ; do \ - if test -f $$ifile; then \ - echo "$$ifile"; \ - else : ; fi; \ - done; \ - done | $(am__base_list) | \ - while read files; do \ - echo " $(INSTALL_DATA) $$files '$(DESTDIR)$(infodir)'"; \ - $(INSTALL_DATA) $$files "$(DESTDIR)$(infodir)" || exit $$?; done - @$(POST_INSTALL) - @if $(am__can_run_installinfo); then \ - list='$(INFO_DEPS)'; test -n "$(infodir)" || list=; \ - for file in $$list; do \ - relfile=`echo "$$file" | sed 's|^.*/||'`; \ - echo " install-info --info-dir='$(DESTDIR)$(infodir)' '$(DESTDIR)$(infodir)/$$relfile'";\ - install-info --info-dir="$(DESTDIR)$(infodir)" "$(DESTDIR)$(infodir)/$$relfile" || :;\ - done; \ - else : ; fi -install-man: - -install-pdf: install-pdf-am - -install-pdf-am: $(PDFS) - @$(NORMAL_INSTALL) - @list='$(PDFS)'; test -n "$(pdfdir)" || list=; \ - if test -n "$$list"; then \ - echo " $(MKDIR_P) '$(DESTDIR)$(pdfdir)'"; \ - $(MKDIR_P) "$(DESTDIR)$(pdfdir)" || exit 1; \ - fi; \ - for p in $$list; do \ - if test -f "$$p"; then d=; else d="$(srcdir)/"; fi; \ - echo "$$d$$p"; \ - done | $(am__base_list) | \ - while read files; do \ - echo " $(INSTALL_DATA) $$files '$(DESTDIR)$(pdfdir)'"; \ - $(INSTALL_DATA) $$files "$(DESTDIR)$(pdfdir)" || exit $$?; done -install-ps: install-ps-am - -install-ps-am: $(PSS) - @$(NORMAL_INSTALL) - @list='$(PSS)'; test -n "$(psdir)" || list=; \ - if test -n "$$list"; then \ - echo " $(MKDIR_P) '$(DESTDIR)$(psdir)'"; \ - $(MKDIR_P) "$(DESTDIR)$(psdir)" || exit 1; \ - fi; \ - for p in $$list; do \ - if test -f "$$p"; then d=; else d="$(srcdir)/"; fi; \ - echo "$$d$$p"; \ - done | $(am__base_list) | \ - while read files; do \ - echo " $(INSTALL_DATA) $$files '$(DESTDIR)$(psdir)'"; \ - $(INSTALL_DATA) $$files "$(DESTDIR)$(psdir)" || exit $$?; done -installcheck-am: - -maintainer-clean: maintainer-clean-am - -rm -f Makefile -maintainer-clean-am: distclean-am maintainer-clean-aminfo \ - maintainer-clean-generic maintainer-clean-vti - -mostlyclean: mostlyclean-am - -mostlyclean-am: mostlyclean-aminfo mostlyclean-generic \ - mostlyclean-libtool mostlyclean-vti - -pdf: pdf-am - -pdf-am: $(PDFS) - -ps: ps-am - -ps-am: $(PSS) - -uninstall-am: uninstall-dvi-am uninstall-html-am uninstall-info-am \ - uninstall-pdf-am uninstall-ps-am - -.MAKE: all check install install-am install-strip - -.PHONY: all all-am check check-am clean clean-aminfo clean-generic \ - clean-libtool cscopelist-am ctags-am dist-info distclean \ - distclean-generic distclean-libtool distdir dvi dvi-am html \ - html-am info info-am install install-am install-data \ - install-data-am install-dvi install-dvi-am install-exec \ - install-exec-am install-html install-html-am install-info \ - install-info-am install-man install-pdf install-pdf-am \ - install-ps install-ps-am install-strip installcheck \ - installcheck-am installdirs maintainer-clean \ - maintainer-clean-aminfo maintainer-clean-generic \ - maintainer-clean-vti mostlyclean mostlyclean-aminfo \ - mostlyclean-generic mostlyclean-libtool mostlyclean-vti pdf \ - pdf-am ps ps-am tags-am uninstall uninstall-am \ - uninstall-dvi-am uninstall-html-am uninstall-info-am \ - uninstall-pdf-am uninstall-ps-am - -.PRECIOUS: Makefile - - -# targets that are only logical targets instead of files -.PHONY: touch touch-tex clean-tex - -@COB_MAKE_RUN_BINARIES_TRUE@cbhelp.tex: $(top_srcdir)/cobc/help.c \ -@COB_MAKE_RUN_BINARIES_TRUE@ $(top_srcdir)/cobc/warning.def $(top_srcdir)/cobc/flag.def \ -@COB_MAKE_RUN_BINARIES_TRUE@ $(top_srcdir)/cobc/config.def \ -@COB_MAKE_RUN_BINARIES_TRUE@ $(top_srcdir)/doc/cobcinfo.sh -@COB_MAKE_RUN_BINARIES_TRUE@ @$(COBCINFOSH) $@ - -@COB_MAKE_RUN_BINARIES_TRUE@cbchelp.tex: $(top_srcdir)/bin/cobcrun.c \ -@COB_MAKE_RUN_BINARIES_TRUE@ $(top_srcdir)/doc/cobcinfo.sh -@COB_MAKE_RUN_BINARIES_TRUE@ @$(COBCINFOSH) $@ - -cbconf.tex: $(top_srcdir)/config/default.conf \ - $(top_srcdir)/doc/cobcinfo.sh - @$(COBCINFOSH) $@ - -cbrunt.tex: $(top_srcdir)/config/runtime.cfg \ - $(top_srcdir)/doc/cobcinfo.sh - @$(COBCINFOSH) $@ - -@COB_MAKE_RUN_BINARIES_TRUE@cbrese.tex cbintr.tex cbsyst.tex cbmnem.tex: \ -@COB_MAKE_RUN_BINARIES_TRUE@ $(top_srcdir)/cobc/reserved.c \ -@COB_MAKE_RUN_BINARIES_TRUE@ $(top_srcdir)/doc/cobcinfo.sh -@COB_MAKE_RUN_BINARIES_TRUE@ @$(COBCINFOSH) $@ -@COB_MAKE_RUN_BINARIES_FALSE@cbhelp.tex cbchelp.tex cbrese.tex cbintr.tex cbsyst.tex cbmnem.tex: \ -@COB_MAKE_RUN_BINARIES_FALSE@ $(top_srcdir)/doc/cobcinfo.sh -@COB_MAKE_RUN_BINARIES_FALSE@ @$(COBCINFOSH) "fixtimestamps" - -touch-tex: - @$(COBCINFOSH) "fixtimestamps" "includes" - -touch: - @$(COBCINFOSH) "fixtimestamps" - -clean-tex: - rm -rf $(GENINCLUDES) - -# Tell versions [3.59,3.63) of GNU make to not export all variables. -# Otherwise a system limit (for SysV at least) may be exceeded. -.NOEXPORT: diff -Nru gnucobol-4.0~early~20200606/doc/stamp-vti gnucobol-5/doc/stamp-vti --- gnucobol-4.0~early~20200606/doc/stamp-vti 2020-06-06 20:56:36.000000000 +0000 +++ gnucobol-5/doc/stamp-vti 1970-01-01 00:00:00.000000000 +0000 @@ -1,4 +0,0 @@ -@set UPDATED 6 June 2020 -@set UPDATED-MONTH June 2020 -@set EDITION 4.0-early-dev -@set VERSION 4.0-early-dev diff -Nru gnucobol-4.0~early~20200606/doc/version.texi gnucobol-5/doc/version.texi --- gnucobol-4.0~early~20200606/doc/version.texi 2020-06-06 20:52:54.000000000 +0000 +++ gnucobol-5/doc/version.texi 1970-01-01 00:00:00.000000000 +0000 @@ -1,4 +0,0 @@ -@set UPDATED 6 June 2020 -@set UPDATED-MONTH June 2020 -@set EDITION 4.0-early-dev -@set VERSION 4.0-early-dev diff -Nru gnucobol-4.0~early~20200606/extras/CBL_OC_DUMP.cob gnucobol-5/extras/CBL_OC_DUMP.cob --- gnucobol-4.0~early~20200606/extras/CBL_OC_DUMP.cob 2020-06-06 20:52:02.000000000 +0000 +++ gnucobol-5/extras/CBL_OC_DUMP.cob 1970-01-01 00:00:00.000000000 +0000 @@ -1,261 +0,0 @@ - *>---------------------------------------------------------------- - *> Authors: Brian Tiffin, Asger Kjelstrup, Simon Sobisch, - *> Roger While - *> Purpose: Hex Dump display - *> Tectonics: cobc -m -std=mf -O2 CBL_OC_DUMP.cob - *> Usage: export OC_DUMP_EXT=1 for explanatory text on dumps - *> (memory address and dump length) - *> export OC_DUMP_EXT=Y for extended explanatory text - *> (architecture and endian-order plus above) - *>---------------------------------------------------------------- - *> - *> This file is part of GnuCOBOL. - *> - *> The GnuCOBOL compiler is free software: you can redistribute - *> it and/or modify it under the terms of the GNU General Public - *> License as published by the Free Software Foundation, either - *> version 3 of the License, or (at your option) any later - *> version. - *> - *> GnuCOBOL is distributed in the hope that it will be useful, - *> but WITHOUT ANY WARRANTY; without even the implied warranty of - *> MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - *> GNU General Public License for more details. - *> - *> You should have received a copy of the GNU General Public - *> License along with GnuCOBOL. - *> If not, see . - - IDENTIFICATION DIVISION. - PROGRAM-ID. CBL_OC_DUMP. - ENVIRONMENT DIVISION. - CONFIGURATION SECTION. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 addr usage pointer. - 01 counter usage binary-long unsigned. - 01 byline usage binary-long unsigned. - 01 len usage binary-long unsigned. - 01 was-called-before usage binary-long unsigned value 0. - 88 called-before value 1. - - 01 char-set pic x(06). - 88 is-ascii value 'ASCII'. - 88 is-ebdic value 'EBCDIC'. - 88 is-unknown value '?'. - 01 architecture pic x(06). - 88 is-32-bit value '32-bit'. - 88 is-64-bit value '64-bit'. - 01 endian-order pic x(13). - 88 is-big-endian-no value 'little endian'. - 88 is-big-endian-yes value 'big endian'. - 01 dots pic x value '.'. - 01 dump-dots pic x. - - 01 disp-line. - 03 offset pic 999999. - 03 pic xx value space. - 03 hex-line pic x(48). - 03 hex-line-red redefines hex-line. - 05 occurs 16. - 07 hex-disp-val pic xx. - 07 pic x. - 03 pic xx value space. - 03 show pic x(16). - - 01 extended-infos pic x. - 88 show-extended-infos values '1', '2', 'Y', 'y'. - 88 show-very-extended-infos values '2', 'Y', 'y'. - - 01 len-display pic ZZZZZ9. - - 01 byte pic x. - 01 byte-redef redefines byte usage binary-char unsigned. - - 01 hex-tab pic x(512) value - "000102030405060708090a0b0c0d0e0f" & - "101112131415161718191a1b1c1d1e1f" & - "202122232425262728292a2b2c2d2e2f" & - "303132333435363738393a3b3c3d3e3f" & - "404142434445464748494a4b4c4d4e4f" & - "505152535455565758595a5b5c5d5e5f" & - "606162636465666768696a6b6c6d6e6f" & - "707172737475767778797a7b7c7d7e7f" & - "808182838485868788898a8b8c8d8e8f" & - "909192939495969798999a9b9c9d9e9f" & - "a0a1a2a3a4a5a6a7a8a9aaabacadaeaf" & - "b0b1b2b3b4b5b6b7b8b9babbbcbdbebf" & - "c0c1c2c3c4c5c6c7c8c9cacbcccdcecf" & - "d0d1d2d3d4d5d6d7d8d9dadbdcdddedf" & - "e0e1e2e3e4e5e6e7e8e9eaebecedeeef" & - "f0f1f2f3f4f5f6f7f8f9fafbfcfdfeff". - 01 hex-tab-red redefines hex-tab. - 03 hex-vals pic xx occurs 256. - - LINKAGE SECTION. - 01 buffer any length. - 01 valuelen any numeric. - *>---------------------------------------------------------------- - PROCEDURE DIVISION USING buffer valuelen. - MAIN SECTION. - MAIN00. - if number-of-call-parameters < 1 - display 'CBL_OC_DUMP: No parameter supplied' - upon SYSERR - end-display - goback - end-if - - if not called-before - *> First time through - set called-before to true - *> If wanted, set dot to something other than point - accept dump-dots from environment 'OC_DUMP_DOTS' - not on exception - move dump-dots to dots - end-accept - *> Discover if running ASCII or EBCDIC - >>IF CHARSET = 'ASCII' - set is-ascii to true - >>ELIF CHARSET = 'EBCDIC' - set is-ebdic to true - >>ELSE - set is-unknown to true - >>END-IF - *> Discover endianness - >>IF ENDIAN = "BIG" - set is-big-endian-yes to true - >>ELSE - set is-big-endian-no to true - >>END-IF - - *> Get and display characteristics and headline - accept extended-infos from environment 'OC_DUMP_EXT' - end-accept - - if show-very-extended-infos - *> Stuff that we only need to display once - *> Longer pointers in 64-bit architecture - >>IF P64 SET - set is-64-bit to true - >>ELSE - set is-32-bit to true - >>END-IF - - display 'Program runs on ' - architecture ' architecture. ' - upon SYSERR - end-display - display 'Character set is ' - function trim (char-set) '.' - upon SYSERR - end-display - display 'Byte order is ' - function trim (endian-order) - upon SYSERR - end-display - end-if - end-if - - *> Get the length of the parameter - call 'C$PARAMSIZE' using 1 - giving len - end-call - - *> Check if the user specified a length - if number-of-call-parameters > 1 - if valuelen not numeric - display 'CBL_OC_DUMP: Length parameter is not numeric' - upon SYSERR - end-display - goback - end-if - if valuelen < 0 - display 'CBL_OC_DUMP: Invalid length parameter: ' - valuelen - upon SYSERR - end-display - goback - end-if - if valuelen < len - move valuelen to len - end-if - end-if - - if show-extended-infos - display ' ' - upon SYSERR - end-display - if len > 0 - set addr to address of buffer - display 'Dump of memory beginning at address: ' - addr - upon SYSERR - end-display - end-if - move len to len-display - display 'Length of memory dump is: ' len-display - upon SYSERR - end-display - end-if - - *> Do we have anything to dump? - if len = 0 - display ' ' - upon SYSERR - end-display - display 'CBL_OC_DUMP: Nothing to dump.' - upon SYSERR - end-display - goback - end-if - - *> Ensure that the passed size is not too big - if len > 999998 - move 999998 to len, len-display - display 'CBL_OC_DUMP: Warning, only the first ' - len-display ' bytes are shown!' - upon SYSERR - end-display - end-if - - display ' ' - upon SYSERR - end-display - display 'Offset ' & - 'HEX-- -- -- -5 -- -- -- -- 10 ' & - '-- -- -- -- 15 -- ' & - 'CHARS----1----5-' - upon SYSERR - end-display - - *> Main loop - perform varying counter from 0 by 16 - until counter >= len - move spaces to hex-line show - perform varying byline from 1 by 1 - until byline > 16 - if (counter + byline) > len - exit perform - end-if - move buffer (counter + byline : 1) to byte - move hex-vals (byte-redef + 1) to - hex-disp-val (byline) - move byte to show (byline:1) - end-perform - *> Check printable characters - call "CBL_GC_PRINTABLE" using show dots - end-call - move counter to offset - display disp-line - upon SYSERR - end-display - end-perform - - display ' ' - upon SYSERR - end-display - - goback - . - end program CBL_OC_DUMP. diff -Nru gnucobol-4.0~early~20200606/extras/Makefile.am gnucobol-5/extras/Makefile.am --- gnucobol-4.0~early~20200606/extras/Makefile.am 2020-06-06 20:52:02.000000000 +0000 +++ gnucobol-5/extras/Makefile.am 1970-01-01 00:00:00.000000000 +0000 @@ -1,36 +0,0 @@ -# -# Makefile gnucobol/extras -# -# Copyright (C) 2012, 2014, 2017-2020 Free Software Foundation, Inc. -# Written by Roger While, Simon Sobisch -# -# This file is part of GnuCOBOL. -# -# The GnuCOBOL compiler is free software: you can redistribute it -# and/or modify it under the terms of the GNU General Public License -# as published by the Free Software Foundation, either version 3 of the -# License, or (at your option) any later version. -# -# GnuCOBOL is distributed in the hope that it will be useful, -# but WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -# GNU General Public License for more details. -# -# You should have received a copy of the GNU General Public License -# along with GnuCOBOL. If not, see . - -extrasdir = @COB_LIBRARY_PATH@ -if COB_MAKE_RUN_BINARIES -extras_DATA = CBL_OC_DUMP.$(COB_MODULE_EXT) -endif - -EXTRA_DIST = CBL_OC_DUMP.cob -CLEANFILES = $(extras_DATA) - -SUFFIXES = .cob .$(COB_MODULE_EXT) -.cob.$(COB_MODULE_EXT): - @echo "building $@ from $<" && \ - . $(top_builddir)/tests/atconfig && . $(top_builddir)/tests/atlocal \ - && ("$(top_builddir)/pre-inst-env" cobc$(EXEEXT) -m -Wall -O2 -o "$@" "$$(_return_path "$<")" || \ - "$(top_builddir)/pre-inst-env" cobc$(EXEEXT) -m -Wall -O2 -o "$@" "$<" || \ - "$(top_builddir)/pre-inst-env" cobc$(EXEEXT) -m -Wall -vv -o "$@" "$$(_return_path "$<")") diff -Nru gnucobol-4.0~early~20200606/extras/Makefile.in gnucobol-5/extras/Makefile.in --- gnucobol-4.0~early~20200606/extras/Makefile.in 2020-06-06 20:56:36.000000000 +0000 +++ gnucobol-5/extras/Makefile.in 1970-01-01 00:00:00.000000000 +0000 @@ -1,616 +0,0 @@ -# Makefile.in generated by automake 1.15.1 from Makefile.am. -# @configure_input@ - -# Copyright (C) 1994-2017 Free Software Foundation, Inc. - -# This Makefile.in is free software; the Free Software Foundation -# gives unlimited permission to copy and/or distribute it, -# with or without modifications, as long as this notice is preserved. - -# This program is distributed in the hope that it will be useful, -# but WITHOUT ANY WARRANTY, to the extent permitted by law; without -# even the implied warranty of MERCHANTABILITY or FITNESS FOR A -# PARTICULAR PURPOSE. - -@SET_MAKE@ - -# -# Makefile gnucobol/extras -# -# Copyright (C) 2012, 2014, 2017-2020 Free Software Foundation, Inc. -# Written by Roger While, Simon Sobisch -# -# This file is part of GnuCOBOL. -# -# The GnuCOBOL compiler is free software: you can redistribute it -# and/or modify it under the terms of the GNU General Public License -# as published by the Free Software Foundation, either version 3 of the -# License, or (at your option) any later version. -# -# GnuCOBOL is distributed in the hope that it will be useful, -# but WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -# GNU General Public License for more details. -# -# You should have received a copy of the GNU General Public License -# along with GnuCOBOL. If not, see . - -VPATH = @srcdir@ -am__is_gnu_make = { \ - if test -z '$(MAKELEVEL)'; then \ - false; \ - elif test -n '$(MAKE_HOST)'; then \ - true; \ - elif test -n '$(MAKE_VERSION)' && test -n '$(CURDIR)'; then \ - true; \ - else \ - false; \ - fi; \ -} -am__make_running_with_option = \ - case $${target_option-} in \ - ?) ;; \ - *) echo "am__make_running_with_option: internal error: invalid" \ - "target option '$${target_option-}' specified" >&2; \ - exit 1;; \ - esac; \ - has_opt=no; \ - sane_makeflags=$$MAKEFLAGS; \ - if $(am__is_gnu_make); then \ - sane_makeflags=$$MFLAGS; \ - else \ - case $$MAKEFLAGS in \ - *\\[\ \ ]*) \ - bs=\\; \ - sane_makeflags=`printf '%s\n' "$$MAKEFLAGS" \ - | sed "s/$$bs$$bs[$$bs $$bs ]*//g"`;; \ - esac; \ - fi; \ - skip_next=no; \ - strip_trailopt () \ - { \ - flg=`printf '%s\n' "$$flg" | sed "s/$$1.*$$//"`; \ - }; \ - for flg in $$sane_makeflags; do \ - test $$skip_next = yes && { skip_next=no; continue; }; \ - case $$flg in \ - *=*|--*) continue;; \ - -*I) strip_trailopt 'I'; skip_next=yes;; \ - -*I?*) strip_trailopt 'I';; \ - -*O) strip_trailopt 'O'; skip_next=yes;; \ - -*O?*) strip_trailopt 'O';; \ - -*l) strip_trailopt 'l'; skip_next=yes;; \ - -*l?*) strip_trailopt 'l';; \ - -[dEDm]) skip_next=yes;; \ - -[JT]) skip_next=yes;; \ - esac; \ - case $$flg in \ - *$$target_option*) has_opt=yes; break;; \ - esac; \ - done; \ - test $$has_opt = yes -am__make_dryrun = (target_option=n; $(am__make_running_with_option)) -am__make_keepgoing = (target_option=k; $(am__make_running_with_option)) -pkgdatadir = $(datadir)/@PACKAGE@ -pkgincludedir = $(includedir)/@PACKAGE@ -pkglibdir = $(libdir)/@PACKAGE@ -pkglibexecdir = $(libexecdir)/@PACKAGE@ -am__cd = CDPATH="$${ZSH_VERSION+.}$(PATH_SEPARATOR)" && cd -install_sh_DATA = $(install_sh) -c -m 644 -install_sh_PROGRAM = $(install_sh) -c -install_sh_SCRIPT = $(install_sh) -c -INSTALL_HEADER = $(INSTALL_DATA) -transform = $(program_transform_name) -NORMAL_INSTALL = : -PRE_INSTALL = : -POST_INSTALL = : -NORMAL_UNINSTALL = : -PRE_UNINSTALL = : -POST_UNINSTALL = : -build_triplet = @build@ -host_triplet = @host@ -subdir = extras -ACLOCAL_M4 = $(top_srcdir)/aclocal.m4 -am__aclocal_m4_deps = $(top_srcdir)/m4/codeset.m4 \ - $(top_srcdir)/m4/gettext.m4 $(top_srcdir)/m4/iconv.m4 \ - $(top_srcdir)/m4/intlmacosx.m4 $(top_srcdir)/m4/lib-ld.m4 \ - $(top_srcdir)/m4/lib-link.m4 $(top_srcdir)/m4/lib-prefix.m4 \ - $(top_srcdir)/m4/libtool.m4 $(top_srcdir)/m4/ltoptions.m4 \ - $(top_srcdir)/m4/ltsugar.m4 $(top_srcdir)/m4/ltversion.m4 \ - $(top_srcdir)/m4/lt~obsolete.m4 \ - $(top_srcdir)/m4/m4_ax_check_define.m4 \ - $(top_srcdir)/m4/m4_ax_code_coverage.m4 \ - $(top_srcdir)/m4/nls.m4 $(top_srcdir)/m4/pkg.m4 \ - $(top_srcdir)/m4/po.m4 $(top_srcdir)/m4/progtest.m4 \ - $(top_srcdir)/configure.ac -am__configure_deps = $(am__aclocal_m4_deps) $(CONFIGURE_DEPENDENCIES) \ - $(ACLOCAL_M4) -DIST_COMMON = $(srcdir)/Makefile.am $(am__DIST_COMMON) -mkinstalldirs = $(SHELL) $(top_srcdir)/build_aux/mkinstalldirs -CONFIG_HEADER = $(top_builddir)/config.h -CONFIG_CLEAN_FILES = -CONFIG_CLEAN_VPATH_FILES = -AM_V_P = $(am__v_P_@AM_V@) -am__v_P_ = $(am__v_P_@AM_DEFAULT_V@) -am__v_P_0 = false -am__v_P_1 = : -AM_V_GEN = $(am__v_GEN_@AM_V@) -am__v_GEN_ = $(am__v_GEN_@AM_DEFAULT_V@) -am__v_GEN_0 = @echo " GEN " $@; -am__v_GEN_1 = -AM_V_at = $(am__v_at_@AM_V@) -am__v_at_ = $(am__v_at_@AM_DEFAULT_V@) -am__v_at_0 = @ -am__v_at_1 = -SOURCES = -DIST_SOURCES = -am__can_run_installinfo = \ - case $$AM_UPDATE_INFO_DIR in \ - n|no|NO) false;; \ - *) (install-info --version) >/dev/null 2>&1;; \ - esac -am__vpath_adj_setup = srcdirstrip=`echo "$(srcdir)" | sed 's|.|.|g'`; -am__vpath_adj = case $$p in \ - $(srcdir)/*) f=`echo "$$p" | sed "s|^$$srcdirstrip/||"`;; \ - *) f=$$p;; \ - esac; -am__strip_dir = f=`echo $$p | sed -e 's|^.*/||'`; -am__install_max = 40 -am__nobase_strip_setup = \ - srcdirstrip=`echo "$(srcdir)" | sed 's/[].[^$$\\*|]/\\\\&/g'` -am__nobase_strip = \ - for p in $$list; do echo "$$p"; done | sed -e "s|$$srcdirstrip/||" -am__nobase_list = $(am__nobase_strip_setup); \ - for p in $$list; do echo "$$p $$p"; done | \ - sed "s| $$srcdirstrip/| |;"' / .*\//!s/ .*/ ./; s,\( .*\)/[^/]*$$,\1,' | \ - $(AWK) 'BEGIN { files["."] = "" } { files[$$2] = files[$$2] " " $$1; \ - if (++n[$$2] == $(am__install_max)) \ - { print $$2, files[$$2]; n[$$2] = 0; files[$$2] = "" } } \ - END { for (dir in files) print dir, files[dir] }' -am__base_list = \ - sed '$$!N;$$!N;$$!N;$$!N;$$!N;$$!N;$$!N;s/\n/ /g' | \ - sed '$$!N;$$!N;$$!N;$$!N;s/\n/ /g' -am__uninstall_files_from_dir = { \ - test -z "$$files" \ - || { test ! -d "$$dir" && test ! -f "$$dir" && test ! -r "$$dir"; } \ - || { echo " ( cd '$$dir' && rm -f" $$files ")"; \ - $(am__cd) "$$dir" && rm -f $$files; }; \ - } -am__installdirs = "$(DESTDIR)$(extrasdir)" -DATA = $(extras_DATA) -am__tagged_files = $(HEADERS) $(SOURCES) $(TAGS_FILES) $(LISP) -am__DIST_COMMON = $(srcdir)/Makefile.in \ - $(top_srcdir)/build_aux/mkinstalldirs README -DISTFILES = $(DIST_COMMON) $(DIST_SOURCES) $(TEXINFOS) $(EXTRA_DIST) -ACLOCAL = @ACLOCAL@ -AMTAR = @AMTAR@ -AM_DEFAULT_VERBOSITY = @AM_DEFAULT_VERBOSITY@ -AR = @AR@ -AS = @AS@ -AUTOCONF = @AUTOCONF@ -AUTOHEADER = @AUTOHEADER@ -AUTOMAKE = @AUTOMAKE@ -AWK = @AWK@ -CC = @CC@ -CCDEPMODE = @CCDEPMODE@ -CFLAGS = @CFLAGS@ -CJSON_CFLAGS = @CJSON_CFLAGS@ -CJSON_LIBS = @CJSON_LIBS@ -COBC_LIBS = @COBC_LIBS@ -COB_BIGENDIAN = @COB_BIGENDIAN@ -COB_CC = @COB_CC@ -COB_CFLAGS = @COB_CFLAGS@ -COB_CONFIG_DIR = @COB_CONFIG_DIR@ -COB_COPY_DIR = @COB_COPY_DIR@ -COB_EXE_EXT = @COB_EXE_EXT@ -COB_EXPORT_DYN = @COB_EXPORT_DYN@ -COB_FIX_LIB = @COB_FIX_LIB@ -COB_FIX_LIBTOOL = @COB_FIX_LIBTOOL@ -COB_HAS_64_BIT_POINTER = @COB_HAS_64_BIT_POINTER@ -COB_HAS_BDB = @COB_HAS_BDB@ -COB_HAS_CISAM = @COB_HAS_CISAM@ -COB_HAS_CJSON = @COB_HAS_CJSON@ -COB_HAS_CURSES = @COB_HAS_CURSES@ -COB_HAS_DISAM = @COB_HAS_DISAM@ -COB_HAS_ISAM = @COB_HAS_ISAM@ -COB_HAS_LMDB = @COB_HAS_LMDB@ -COB_HAS_OCEXTFH = @COB_HAS_OCEXTFH@ -COB_HAS_OCI = @COB_HAS_OCI@ -COB_HAS_ODBC = @COB_HAS_ODBC@ -COB_HAS_VBISAM = @COB_HAS_VBISAM@ -COB_HAS_XML2 = @COB_HAS_XML2@ -COB_KEYWORD_INLINE = @COB_KEYWORD_INLINE@ -COB_LDFLAGS = @COB_LDFLAGS@ -COB_LIBRARY_PATH = @COB_LIBRARY_PATH@ -COB_LIBS = @COB_LIBS@ -COB_MODULE_EXT = @COB_MODULE_EXT@ -COB_OBJECT_EXT = @COB_OBJECT_EXT@ -COB_PATCH_LEVEL = @COB_PATCH_LEVEL@ -COB_PIC_FLAGS = @COB_PIC_FLAGS@ -COB_SCHEMA_DIR = @COB_SCHEMA_DIR@ -COB_SHARED_OPT = @COB_SHARED_OPT@ -CODE_COVERAGE_CFLAGS = @CODE_COVERAGE_CFLAGS@ -CODE_COVERAGE_CPPFLAGS = @CODE_COVERAGE_CPPFLAGS@ -CODE_COVERAGE_CXXFLAGS = @CODE_COVERAGE_CXXFLAGS@ -CODE_COVERAGE_ENABLED = @CODE_COVERAGE_ENABLED@ -CODE_COVERAGE_LDFLAGS = @CODE_COVERAGE_LDFLAGS@ -CODE_COVERAGE_LIBS = @CODE_COVERAGE_LIBS@ -CPP = @CPP@ -CPPFLAGS = @CPPFLAGS@ -CYGPATH_W = @CYGPATH_W@ -DEFS = @DEFS@ -DEPDIR = @DEPDIR@ -DIFF_FLAGS = @DIFF_FLAGS@ -DLLTOOL = @DLLTOOL@ -DSYMUTIL = @DSYMUTIL@ -DUMPBIN = @DUMPBIN@ -ECHO_C = @ECHO_C@ -ECHO_N = @ECHO_N@ -ECHO_T = @ECHO_T@ -EGREP = @EGREP@ -EXEEXT = @EXEEXT@ -FGREP = @FGREP@ -GCOV = @GCOV@ -GENHTML = @GENHTML@ -GETTEXT_MACRO_VERSION = @GETTEXT_MACRO_VERSION@ -GMSGFMT = @GMSGFMT@ -GMSGFMT_015 = @GMSGFMT_015@ -GREP = @GREP@ -HELP2MAN = @HELP2MAN@ -INSTALL = @INSTALL@ -INSTALL_DATA = @INSTALL_DATA@ -INSTALL_PROGRAM = @INSTALL_PROGRAM@ -INSTALL_SCRIPT = @INSTALL_SCRIPT@ -INSTALL_STRIP_PROGRAM = @INSTALL_STRIP_PROGRAM@ -INTLLIBS = @INTLLIBS@ -INTL_MACOSX_LIBS = @INTL_MACOSX_LIBS@ -LCOV = @LCOV@ -LD = @LD@ -LDFLAGS = @LDFLAGS@ -LEX = @LEX@ -LEXLIB = @LEXLIB@ -LEX_OUTPUT_ROOT = @LEX_OUTPUT_ROOT@ -LIBCOB_CISAM = @LIBCOB_CISAM@ -LIBCOB_CPPFLAGS = @LIBCOB_CPPFLAGS@ -LIBCOB_DISAM = @LIBCOB_DISAM@ -LIBCOB_LIBS = @LIBCOB_LIBS@ -LIBCOB_VBISAM = @LIBCOB_VBISAM@ -LIBICONV = @LIBICONV@ -LIBINTL = @LIBINTL@ -LIBOBJS = @LIBOBJS@ -LIBS = @LIBS@ -LIBTOOL = @LIBTOOL@ -LIPO = @LIPO@ -LN_S = @LN_S@ -LTLIBICONV = @LTLIBICONV@ -LTLIBINTL = @LTLIBINTL@ -LTLIBOBJS = @LTLIBOBJS@ -LT_SYS_LIBRARY_PATH = @LT_SYS_LIBRARY_PATH@ -MAKE = @MAKE@ -MAKEINFO = @MAKEINFO@ -MANIFEST_TOOL = @MANIFEST_TOOL@ -MKDIR_P = @MKDIR_P@ -MSGFMT = @MSGFMT@ -MSGFMT_015 = @MSGFMT_015@ -MSGMERGE = @MSGMERGE@ -NM = @NM@ -NMEDIT = @NMEDIT@ -OBJDUMP = @OBJDUMP@ -OBJEXT = @OBJEXT@ -ODBC_CFLAGS = @ODBC_CFLAGS@ -ODBC_LIBS = @ODBC_LIBS@ -OTOOL = @OTOOL@ -OTOOL64 = @OTOOL64@ -PACKAGE = @PACKAGE@ -PACKAGE_BUGREPORT = @PACKAGE_BUGREPORT@ -PACKAGE_NAME = @PACKAGE_NAME@ -PACKAGE_STRING = @PACKAGE_STRING@ -PACKAGE_TARNAME = @PACKAGE_TARNAME@ -PACKAGE_URL = @PACKAGE_URL@ -PACKAGE_VERSION = @PACKAGE_VERSION@ -PATH_SEPARATOR = @PATH_SEPARATOR@ -PKG_CONFIG = @PKG_CONFIG@ -PKG_CONFIG_LIBDIR = @PKG_CONFIG_LIBDIR@ -PKG_CONFIG_PATH = @PKG_CONFIG_PATH@ -POSUB = @POSUB@ -RANLIB = @RANLIB@ -SED = @SED@ -SET_MAKE = @SET_MAKE@ -SHELL = @SHELL@ -STRIP = @STRIP@ -USE_NLS = @USE_NLS@ -VERSION = @VERSION@ -XGETTEXT = @XGETTEXT@ -XGETTEXT_015 = @XGETTEXT_015@ -XGETTEXT_EXTRA_OPTIONS = @XGETTEXT_EXTRA_OPTIONS@ -XML2_CFLAGS = @XML2_CFLAGS@ -XML2_LIBS = @XML2_LIBS@ -YACC = @YACC@ -YFLAGS = @YFLAGS@ -abs_builddir = @abs_builddir@ -abs_srcdir = @abs_srcdir@ -abs_top_builddir = @abs_top_builddir@ -abs_top_srcdir = @abs_top_srcdir@ -ac_ct_AR = @ac_ct_AR@ -ac_ct_CC = @ac_ct_CC@ -ac_ct_DUMPBIN = @ac_ct_DUMPBIN@ -am__include = @am__include@ -am__leading_dot = @am__leading_dot@ -am__quote = @am__quote@ -am__tar = @am__tar@ -am__untar = @am__untar@ -bindir = @bindir@ -build = @build@ -build_alias = @build_alias@ -build_cpu = @build_cpu@ -build_os = @build_os@ -build_vendor = @build_vendor@ -builddir = @builddir@ -configured_make = @configured_make@ -datadir = @datadir@ -datarootdir = @datarootdir@ -docdir = @docdir@ -dvidir = @dvidir@ -exec_prefix = @exec_prefix@ -host = @host@ -host_alias = @host_alias@ -host_cpu = @host_cpu@ -host_os = @host_os@ -host_vendor = @host_vendor@ -htmldir = @htmldir@ -includedir = @includedir@ -infodir = @infodir@ -install_sh = @install_sh@ -libdir = @libdir@ -libexecdir = @libexecdir@ -localedir = @localedir@ -localstatedir = @localstatedir@ -mandir = @mandir@ -mkdir_p = @mkdir_p@ -oldincludedir = @oldincludedir@ -pdfdir = @pdfdir@ -prefix = @prefix@ -program_transform_name = @program_transform_name@ -psdir = @psdir@ -runstatedir = @runstatedir@ -sbindir = @sbindir@ -sharedstatedir = @sharedstatedir@ -srcdir = @srcdir@ -sysconfdir = @sysconfdir@ -target_alias = @target_alias@ -top_build_prefix = @top_build_prefix@ -top_builddir = @top_builddir@ -top_srcdir = @top_srcdir@ -xml2_config_found = @xml2_config_found@ -extrasdir = @COB_LIBRARY_PATH@ -@COB_MAKE_RUN_BINARIES_TRUE@extras_DATA = CBL_OC_DUMP.$(COB_MODULE_EXT) -EXTRA_DIST = CBL_OC_DUMP.cob -CLEANFILES = $(extras_DATA) -SUFFIXES = .cob .$(COB_MODULE_EXT) -all: all-am - -.SUFFIXES: -.SUFFIXES: .cob .$(COB_MODULE_EXT) -$(srcdir)/Makefile.in: $(srcdir)/Makefile.am $(am__configure_deps) - @for dep in $?; do \ - case '$(am__configure_deps)' in \ - *$$dep*) \ - ( cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh ) \ - && { if test -f $@; then exit 0; else break; fi; }; \ - exit 1;; \ - esac; \ - done; \ - echo ' cd $(top_srcdir) && $(AUTOMAKE) --gnu extras/Makefile'; \ - $(am__cd) $(top_srcdir) && \ - $(AUTOMAKE) --gnu extras/Makefile -Makefile: $(srcdir)/Makefile.in $(top_builddir)/config.status - @case '$?' in \ - *config.status*) \ - cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh;; \ - *) \ - echo ' cd $(top_builddir) && $(SHELL) ./config.status $(subdir)/$@ $(am__depfiles_maybe)'; \ - cd $(top_builddir) && $(SHELL) ./config.status $(subdir)/$@ $(am__depfiles_maybe);; \ - esac; - -$(top_builddir)/config.status: $(top_srcdir)/configure $(CONFIG_STATUS_DEPENDENCIES) - cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh - -$(top_srcdir)/configure: $(am__configure_deps) - cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh -$(ACLOCAL_M4): $(am__aclocal_m4_deps) - cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh -$(am__aclocal_m4_deps): - -mostlyclean-libtool: - -rm -f *.lo - -clean-libtool: - -rm -rf .libs _libs -install-extrasDATA: $(extras_DATA) - @$(NORMAL_INSTALL) - @list='$(extras_DATA)'; test -n "$(extrasdir)" || list=; \ - if test -n "$$list"; then \ - echo " $(MKDIR_P) '$(DESTDIR)$(extrasdir)'"; \ - $(MKDIR_P) "$(DESTDIR)$(extrasdir)" || exit 1; \ - fi; \ - for p in $$list; do \ - if test -f "$$p"; then d=; else d="$(srcdir)/"; fi; \ - echo "$$d$$p"; \ - done | $(am__base_list) | \ - while read files; do \ - echo " $(INSTALL_DATA) $$files '$(DESTDIR)$(extrasdir)'"; \ - $(INSTALL_DATA) $$files "$(DESTDIR)$(extrasdir)" || exit $$?; \ - done - -uninstall-extrasDATA: - @$(NORMAL_UNINSTALL) - @list='$(extras_DATA)'; test -n "$(extrasdir)" || list=; \ - files=`for p in $$list; do echo $$p; done | sed -e 's|^.*/||'`; \ - dir='$(DESTDIR)$(extrasdir)'; $(am__uninstall_files_from_dir) -tags TAGS: - -ctags CTAGS: - -cscope cscopelist: - - -distdir: $(DISTFILES) - @srcdirstrip=`echo "$(srcdir)" | sed 's/[].[^$$\\*]/\\\\&/g'`; \ - topsrcdirstrip=`echo "$(top_srcdir)" | sed 's/[].[^$$\\*]/\\\\&/g'`; \ - list='$(DISTFILES)'; \ - dist_files=`for file in $$list; do echo $$file; done | \ - sed -e "s|^$$srcdirstrip/||;t" \ - -e "s|^$$topsrcdirstrip/|$(top_builddir)/|;t"`; \ - case $$dist_files in \ - */*) $(MKDIR_P) `echo "$$dist_files" | \ - sed '/\//!d;s|^|$(distdir)/|;s,/[^/]*$$,,' | \ - sort -u` ;; \ - esac; \ - for file in $$dist_files; do \ - if test -f $$file || test -d $$file; then d=.; else d=$(srcdir); fi; \ - if test -d $$d/$$file; then \ - dir=`echo "/$$file" | sed -e 's,/[^/]*$$,,'`; \ - if test -d "$(distdir)/$$file"; then \ - find "$(distdir)/$$file" -type d ! -perm -700 -exec chmod u+rwx {} \;; \ - fi; \ - if test -d $(srcdir)/$$file && test $$d != $(srcdir); then \ - cp -fpR $(srcdir)/$$file "$(distdir)$$dir" || exit 1; \ - find "$(distdir)/$$file" -type d ! -perm -700 -exec chmod u+rwx {} \;; \ - fi; \ - cp -fpR $$d/$$file "$(distdir)$$dir" || exit 1; \ - else \ - test -f "$(distdir)/$$file" \ - || cp -p $$d/$$file "$(distdir)/$$file" \ - || exit 1; \ - fi; \ - done -check-am: all-am -check: check-am -all-am: Makefile $(DATA) -installdirs: - for dir in "$(DESTDIR)$(extrasdir)"; do \ - test -z "$$dir" || $(MKDIR_P) "$$dir"; \ - done -install: install-am -install-exec: install-exec-am -install-data: install-data-am -uninstall: uninstall-am - -install-am: all-am - @$(MAKE) $(AM_MAKEFLAGS) install-exec-am install-data-am - -installcheck: installcheck-am -install-strip: - if test -z '$(STRIP)'; then \ - $(MAKE) $(AM_MAKEFLAGS) INSTALL_PROGRAM="$(INSTALL_STRIP_PROGRAM)" \ - install_sh_PROGRAM="$(INSTALL_STRIP_PROGRAM)" INSTALL_STRIP_FLAG=-s \ - install; \ - else \ - $(MAKE) $(AM_MAKEFLAGS) INSTALL_PROGRAM="$(INSTALL_STRIP_PROGRAM)" \ - install_sh_PROGRAM="$(INSTALL_STRIP_PROGRAM)" INSTALL_STRIP_FLAG=-s \ - "INSTALL_PROGRAM_ENV=STRIPPROG='$(STRIP)'" install; \ - fi -mostlyclean-generic: - -clean-generic: - -test -z "$(CLEANFILES)" || rm -f $(CLEANFILES) - -distclean-generic: - -test -z "$(CONFIG_CLEAN_FILES)" || rm -f $(CONFIG_CLEAN_FILES) - -test . = "$(srcdir)" || test -z "$(CONFIG_CLEAN_VPATH_FILES)" || rm -f $(CONFIG_CLEAN_VPATH_FILES) - -maintainer-clean-generic: - @echo "This command is intended for maintainers to use" - @echo "it deletes files that may require special tools to rebuild." -clean: clean-am - -clean-am: clean-generic clean-libtool mostlyclean-am - -distclean: distclean-am - -rm -f Makefile -distclean-am: clean-am distclean-generic - -dvi: dvi-am - -dvi-am: - -html: html-am - -html-am: - -info: info-am - -info-am: - -install-data-am: install-extrasDATA - -install-dvi: install-dvi-am - -install-dvi-am: - -install-exec-am: - -install-html: install-html-am - -install-html-am: - -install-info: install-info-am - -install-info-am: - -install-man: - -install-pdf: install-pdf-am - -install-pdf-am: - -install-ps: install-ps-am - -install-ps-am: - -installcheck-am: - -maintainer-clean: maintainer-clean-am - -rm -f Makefile -maintainer-clean-am: distclean-am maintainer-clean-generic - -mostlyclean: mostlyclean-am - -mostlyclean-am: mostlyclean-generic mostlyclean-libtool - -pdf: pdf-am - -pdf-am: - -ps: ps-am - -ps-am: - -uninstall-am: uninstall-extrasDATA - -.MAKE: install-am install-strip - -.PHONY: all all-am check check-am clean clean-generic clean-libtool \ - cscopelist-am ctags-am distclean distclean-generic \ - distclean-libtool distdir dvi dvi-am html html-am info info-am \ - install install-am install-data install-data-am install-dvi \ - install-dvi-am install-exec install-exec-am install-extrasDATA \ - install-html install-html-am install-info install-info-am \ - install-man install-pdf install-pdf-am install-ps \ - install-ps-am install-strip installcheck installcheck-am \ - installdirs maintainer-clean maintainer-clean-generic \ - mostlyclean mostlyclean-generic mostlyclean-libtool pdf pdf-am \ - ps ps-am tags-am uninstall uninstall-am uninstall-extrasDATA - -.PRECIOUS: Makefile - -.cob.$(COB_MODULE_EXT): - @echo "building $@ from $<" && \ - . $(top_builddir)/tests/atconfig && . $(top_builddir)/tests/atlocal \ - && ("$(top_builddir)/pre-inst-env" cobc$(EXEEXT) -m -Wall -O2 -o "$@" "$$(_return_path "$<")" || \ - "$(top_builddir)/pre-inst-env" cobc$(EXEEXT) -m -Wall -O2 -o "$@" "$<" || \ - "$(top_builddir)/pre-inst-env" cobc$(EXEEXT) -m -Wall -vv -o "$@" "$$(_return_path "$<")") - -# Tell versions [3.59,3.63) of GNU make to not export all variables. -# Otherwise a system limit (for SysV at least) may be exceeded. -.NOEXPORT: diff -Nru gnucobol-4.0~early~20200606/extras/README gnucobol-5/extras/README --- gnucobol-4.0~early~20200606/extras/README 2020-06-06 20:52:02.000000000 +0000 +++ gnucobol-5/extras/README 1970-01-01 00:00:00.000000000 +0000 @@ -1,15 +0,0 @@ -Entries MUST be L/GPL. That's Lesser General Public License and/or -General Public License. - -Authors MUST be willing to hand copyright over to the FSF. -That's the Free Software Foundation, Inc.. - -COBOL source modules MUST compile warning/error free with both -1) -std=default -W -fixed -2) -std=default -W -free - -Ideally they SHOULD compile error-free with any of -the non-strict -std options, too. - -Further these COBOL modules MUST execute correctly however -they have been compiled (-std=default / non-strict options). diff -Nru gnucobol-4.0~early~20200606/gnucobol.spec gnucobol-5/gnucobol.spec --- gnucobol-4.0~early~20200606/gnucobol.spec 2020-06-06 20:52:02.000000000 +0000 +++ gnucobol-5/gnucobol.spec 1970-01-01 00:00:00.000000000 +0000 @@ -1,89 +0,0 @@ -# RPM spec file for gnucobol -# Adjust/activate "Packager" tag as necessary - -Name: gnucobol -Version: 4.0 -Release: 1%{?dist} -Summary: GnuCOBOL - COBOL compiler and runtime library - -# Packager: Whoever - -Group: Development/Languages/Other -License: GPLv3+/LGPLv3+ - -URL: https://www.gnu.org/software/gnucobol/ -Source: https://ftp.gnu.org/gnu/%{name}/%{name}-%{version}.tar.gz - -BuildRoot: %{_tmppath}/%{name}-%{version}-%{release}-root-%(%{__id_u} -n) - -BuildRequires: db-devel >= 4.1.24 -BuildRequires: ncurses-devel >= 5.4 - -Requires: gcc -Requires: glibc-devel -Requires: gmp-devel >= 4.1.4 -Requires: db >= 4.1.24 -Requires: ncurses >= 5.4 - -Requires(post): /sbin/install-info - -%description -GnuCOBOL is a free, modern COBOL compiler. GnuCOBOL implements a substantial part of the COBOL 85, -COBOL 2002 and COBOL 2014 standards, as well as many extensions included in other COBOL compilers. - -GnuCOBOL translates COBOL into C and compiles the translated code using a native C compiler. - -%prep -%setup -q -n %{name}-%{version} - -%build -%configure --disable-rpath -make - -%install -rm -rf $RPM_BUILD_ROOT -make install DESTDIR=$RPM_BUILD_ROOT -rm -rf $RPM_BUILD_ROOT/%{_infodir}/dir - -%find_lang %{name} - -%check -make check - -%files -f %{name}.lang -%license COPYING -%license COPYING.DOC -%defattr (-,root,root,-) -%doc AUTHORS ChangeLog -%doc NEWS README THANKS -%{_bindir}/cobc -%{_bindir}/cobcrun -%{_bindir}/cob-config -%{_includedir}/* -%{_datadir}/gnucobol -%{_infodir}/gnucobol.info* -%{_mandir}/man1/cobc.1.* -%{_mandir}/man1/cobcrun.1.* - -%files -n libcob -%license COPYING.LESSER -%{_libdir}/libcob.so* -%{_libdir}/libcob.a -%{_libdir}/libcob.la -%{_libdir}/gnucobol/CBL_OC_DUMP.so - -%clean -rm -rf $RPM_BUILD_ROOT -rm -rf $RPM_BUILD_DIR/%{name}-%{version} - -%post -/sbin/install-info %{_infodir}/gnucobol.info %{_infodir}/dir 2>/dev/null || : -/sbin/ldconfig - -%postun -if [ $1 = 0 ]; then - /sbin/install-info --delete %{_infodir}/gnucobol.info %{_infodir}/dir 2>/dev/null || : -fi -/sbin/ldconfig - -%changelog diff -Nru gnucobol-4.0~early~20200606/INSTALL gnucobol-5/INSTALL --- gnucobol-4.0~early~20200606/INSTALL 2020-06-06 20:52:02.000000000 +0000 +++ gnucobol-5/INSTALL 1970-01-01 00:00:00.000000000 +0000 @@ -1,368 +0,0 @@ -Installation Instructions -************************* - - Copyright (C) 1994-1996, 1999-2002, 2004-2016 Free Software -Foundation, Inc. - - Copying and distribution of this file, with or without modification, -are permitted in any medium without royalty provided the copyright -notice and this notice are preserved. This file is offered as-is, -without warranty of any kind. - -Basic Installation -================== - - Briefly, the shell command './configure && make && make install' -should configure, build, and install this package. The following -more-detailed instructions are generic; see the 'README' file for -instructions specific to this package. Some packages provide this -'INSTALL' file but do not implement all of the features documented -below. The lack of an optional feature in a given package is not -necessarily a bug. More recommendations for GNU packages can be found -in *note Makefile Conventions: (standards)Makefile Conventions. - - The 'configure' shell script attempts to guess correct values for -various system-dependent variables used during compilation. It uses -those values to create a 'Makefile' in each directory of the package. -It may also create one or more '.h' files containing system-dependent -definitions. Finally, it creates a shell script 'config.status' that -you can run in the future to recreate the current configuration, and a -file 'config.log' containing compiler output (useful mainly for -debugging 'configure'). - - It can also use an optional file (typically called 'config.cache' and -enabled with '--cache-file=config.cache' or simply '-C') that saves the -results of its tests to speed up reconfiguring. Caching is disabled by -default to prevent problems with accidental use of stale cache files. - - If you need to do unusual things to compile the package, please try -to figure out how 'configure' could check whether to do them, and mail -diffs or instructions to the address given in the 'README' so they can -be considered for the next release. If you are using the cache, and at -some point 'config.cache' contains results you don't want to keep, you -may remove or edit it. - - The file 'configure.ac' (or 'configure.in') is used to create -'configure' by a program called 'autoconf'. You need 'configure.ac' if -you want to change it or regenerate 'configure' using a newer version of -'autoconf'. - - The simplest way to compile this package is: - - 1. 'cd' to the directory containing the package's source code and type - './configure' to configure the package for your system. - - Running 'configure' might take a while. While running, it prints - some messages telling which features it is checking for. - - 2. Type 'make' to compile the package. - - 3. Optionally, type 'make check' to run any self-tests that come with - the package, generally using the just-built uninstalled binaries. - - 4. Type 'make install' to install the programs and any data files and - documentation. When installing into a prefix owned by root, it is - recommended that the package be configured and built as a regular - user, and only the 'make install' phase executed with root - privileges. - - 5. Optionally, type 'make installcheck' to repeat any self-tests, but - this time using the binaries in their final installed location. - This target does not install anything. Running this target as a - regular user, particularly if the prior 'make install' required - root privileges, verifies that the installation completed - correctly. - - 6. You can remove the program binaries and object files from the - source code directory by typing 'make clean'. To also remove the - files that 'configure' created (so you can compile the package for - a different kind of computer), type 'make distclean'. There is - also a 'make maintainer-clean' target, but that is intended mainly - for the package's developers. If you use it, you may have to get - all sorts of other programs in order to regenerate files that came - with the distribution. - - 7. Often, you can also type 'make uninstall' to remove the installed - files again. In practice, not all packages have tested that - uninstallation works correctly, even though it is required by the - GNU Coding Standards. - - 8. Some packages, particularly those that use Automake, provide 'make - distcheck', which can by used by developers to test that all other - targets like 'make install' and 'make uninstall' work correctly. - This target is generally not run by end users. - -Compilers and Options -===================== - - Some systems require unusual options for compilation or linking that -the 'configure' script does not know about. Run './configure --help' -for details on some of the pertinent environment variables. - - You can give 'configure' initial values for configuration parameters -by setting variables in the command line or in the environment. Here is -an example: - - ./configure CC=c99 CFLAGS=-g LIBS=-lposix - - *Note Defining Variables::, for more details. - -Compiling For Multiple Architectures -==================================== - - You can compile the package for more than one kind of computer at the -same time, by placing the object files for each architecture in their -own directory. To do this, you can use GNU 'make'. 'cd' to the -directory where you want the object files and executables to go and run -the 'configure' script. 'configure' automatically checks for the source -code in the directory that 'configure' is in and in '..'. This is known -as a "VPATH" build. - - With a non-GNU 'make', it is safer to compile the package for one -architecture at a time in the source code directory. After you have -installed the package for one architecture, use 'make distclean' before -reconfiguring for another architecture. - - On MacOS X 10.5 and later systems, you can create libraries and -executables that work on multiple system types--known as "fat" or -"universal" binaries--by specifying multiple '-arch' options to the -compiler but only a single '-arch' option to the preprocessor. Like -this: - - ./configure CC="gcc -arch i386 -arch x86_64 -arch ppc -arch ppc64" \ - CXX="g++ -arch i386 -arch x86_64 -arch ppc -arch ppc64" \ - CPP="gcc -E" CXXCPP="g++ -E" - - This is not guaranteed to produce working output in all cases, you -may have to build one architecture at a time and combine the results -using the 'lipo' tool if you have problems. - -Installation Names -================== - - By default, 'make install' installs the package's commands under -'/usr/local/bin', include files under '/usr/local/include', etc. You -can specify an installation prefix other than '/usr/local' by giving -'configure' the option '--prefix=PREFIX', where PREFIX must be an -absolute file name. - - You can specify separate installation prefixes for -architecture-specific files and architecture-independent files. If you -pass the option '--exec-prefix=PREFIX' to 'configure', the package uses -PREFIX as the prefix for installing programs and libraries. -Documentation and other data files still use the regular prefix. - - In addition, if you use an unusual directory layout you can give -options like '--bindir=DIR' to specify different values for particular -kinds of files. Run 'configure --help' for a list of the directories -you can set and what kinds of files go in them. In general, the default -for these options is expressed in terms of '${prefix}', so that -specifying just '--prefix' will affect all of the other directory -specifications that were not explicitly provided. - - The most portable way to affect installation locations is to pass the -correct locations to 'configure'; however, many packages provide one or -both of the following shortcuts of passing variable assignments to the -'make install' command line to change installation locations without -having to reconfigure or recompile. - - The first method involves providing an override variable for each -affected directory. For example, 'make install -prefix=/alternate/directory' will choose an alternate location for all -directory configuration variables that were expressed in terms of -'${prefix}'. Any directories that were specified during 'configure', -but not in terms of '${prefix}', must each be overridden at install time -for the entire installation to be relocated. The approach of makefile -variable overrides for each directory variable is required by the GNU -Coding Standards, and ideally causes no recompilation. However, some -platforms have known limitations with the semantics of shared libraries -that end up requiring recompilation when using this method, particularly -noticeable in packages that use GNU Libtool. - - The second method involves providing the 'DESTDIR' variable. For -example, 'make install DESTDIR=/alternate/directory' will prepend -'/alternate/directory' before all installation names. The approach of -'DESTDIR' overrides is not required by the GNU Coding Standards, and -does not work on platforms that have drive letters. On the other hand, -it does better at avoiding recompilation issues, and works well even -when some directory options were not specified in terms of '${prefix}' -at 'configure' time. - -Optional Features -================= - - If the package supports it, you can cause programs to be installed -with an extra prefix or suffix on their names by giving 'configure' the -option '--program-prefix=PREFIX' or '--program-suffix=SUFFIX'. - - Some packages pay attention to '--enable-FEATURE' options to -'configure', where FEATURE indicates an optional part of the package. -They may also pay attention to '--with-PACKAGE' options, where PACKAGE -is something like 'gnu-as' or 'x' (for the X Window System). The -'README' should mention any '--enable-' and '--with-' options that the -package recognizes. - - For packages that use the X Window System, 'configure' can usually -find the X include and library files automatically, but if it doesn't, -you can use the 'configure' options '--x-includes=DIR' and -'--x-libraries=DIR' to specify their locations. - - Some packages offer the ability to configure how verbose the -execution of 'make' will be. For these packages, running './configure ---enable-silent-rules' sets the default to minimal output, which can be -overridden with 'make V=1'; while running './configure ---disable-silent-rules' sets the default to verbose, which can be -overridden with 'make V=0'. - -Particular systems -================== - - On HP-UX, the default C compiler is not ANSI C compatible. If GNU CC -is not installed, it is recommended to use the following options in -order to use an ANSI C compiler: - - ./configure CC="cc -Ae -D_XOPEN_SOURCE=500" - -and if that doesn't work, install pre-built binaries of GCC for HP-UX. - - HP-UX 'make' updates targets which have the same time stamps as their -prerequisites, which makes it generally unusable when shipped generated -files such as 'configure' are involved. Use GNU 'make' instead. - - On OSF/1 a.k.a. Tru64, some versions of the default C compiler cannot -parse its '' header file. The option '-nodtk' can be used as a -workaround. If GNU CC is not installed, it is therefore recommended to -try - - ./configure CC="cc" - -and if that doesn't work, try - - ./configure CC="cc -nodtk" - - On Solaris, don't put '/usr/ucb' early in your 'PATH'. This -directory contains several dysfunctional programs; working variants of -these programs are available in '/usr/bin'. So, if you need '/usr/ucb' -in your 'PATH', put it _after_ '/usr/bin'. - - On Haiku, software installed for all users goes in '/boot/common', -not '/usr/local'. It is recommended to use the following options: - - ./configure --prefix=/boot/common - -Specifying the System Type -========================== - - There may be some features 'configure' cannot figure out -automatically, but needs to determine by the type of machine the package -will run on. Usually, assuming the package is built to be run on the -_same_ architectures, 'configure' can figure that out, but if it prints -a message saying it cannot guess the machine type, give it the -'--build=TYPE' option. TYPE can either be a short name for the system -type, such as 'sun4', or a canonical name which has the form: - - CPU-COMPANY-SYSTEM - -where SYSTEM can have one of these forms: - - OS - KERNEL-OS - - See the file 'config.sub' for the possible values of each field. If -'config.sub' isn't included in this package, then this package doesn't -need to know the machine type. - - If you are _building_ compiler tools for cross-compiling, you should -use the option '--target=TYPE' to select the type of system they will -produce code for. - - If you want to _use_ a cross compiler, that generates code for a -platform different from the build platform, you should specify the -"host" platform (i.e., that on which the generated programs will -eventually be run) with '--host=TYPE'. - -Sharing Defaults -================ - - If you want to set default values for 'configure' scripts to share, -you can create a site shell script called 'config.site' that gives -default values for variables like 'CC', 'cache_file', and 'prefix'. -'configure' looks for 'PREFIX/share/config.site' if it exists, then -'PREFIX/etc/config.site' if it exists. Or, you can set the -'CONFIG_SITE' environment variable to the location of the site script. -A warning: not all 'configure' scripts look for a site script. - -Defining Variables -================== - - Variables not defined in a site shell script can be set in the -environment passed to 'configure'. However, some packages may run -configure again during the build, and the customized values of these -variables may be lost. In order to avoid this problem, you should set -them in the 'configure' command line, using 'VAR=value'. For example: - - ./configure CC=/usr/local2/bin/gcc - -causes the specified 'gcc' to be used as the C compiler (unless it is -overridden in the site shell script). - -Unfortunately, this technique does not work for 'CONFIG_SHELL' due to an -Autoconf limitation. Until the limitation is lifted, you can use this -workaround: - - CONFIG_SHELL=/bin/bash ./configure CONFIG_SHELL=/bin/bash - -'configure' Invocation -====================== - - 'configure' recognizes the following options to control how it -operates. - -'--help' -'-h' - Print a summary of all of the options to 'configure', and exit. - -'--help=short' -'--help=recursive' - Print a summary of the options unique to this package's - 'configure', and exit. The 'short' variant lists options used only - in the top level, while the 'recursive' variant lists options also - present in any nested packages. - -'--version' -'-V' - Print the version of Autoconf used to generate the 'configure' - script, and exit. - -'--cache-file=FILE' - Enable the cache: use and save the results of the tests in FILE, - traditionally 'config.cache'. FILE defaults to '/dev/null' to - disable caching. - -'--config-cache' -'-C' - Alias for '--cache-file=config.cache'. - -'--quiet' -'--silent' -'-q' - Do not print messages saying which checks are being made. To - suppress all normal output, redirect it to '/dev/null' (any error - messages will still be shown). - -'--srcdir=DIR' - Look for the package's source code in directory DIR. Usually - 'configure' can determine that directory automatically. - -'--prefix=DIR' - Use DIR as the installation prefix. *note Installation Names:: for - more details, including other options available for fine-tuning the - installation locations. - -'--no-create' -'-n' - Run the configure checks, but stop before creating any output - files. - -'configure' also accepts some other, not widely useful, options. Run -'configure --help' for more details. diff -Nru gnucobol-4.0~early~20200606/lib/ChangeLog gnucobol-5/lib/ChangeLog --- gnucobol-4.0~early~20200606/lib/ChangeLog 2020-06-06 20:52:02.000000000 +0000 +++ gnucobol-5/lib/ChangeLog 1970-01-01 00:00:00.000000000 +0000 @@ -1,47 +0,0 @@ - -2017-10-22 Simon Sobisch - - * Makefile.am: moved include of top_srcdir to AM_CPPFLAGS to prevent - user-specified CPPFLAGS to override own includes, see bug #452 - -2010-06-28 Roger While - - * MARK - Version 2.0 - * Move to GPL/LGPL 3 - -2007-12-27 Roger While - - ** Mark 1.0 RELEASE - -2006-10-23 Roger While - - * Prototype in dummymac.c - -2005-10-25 Roger While - - * New element dummymac.c - Needed while some versions of - "ar" are not capable of generating empty archives. - -2003-07-28 Keisuke Nishida - - * malloc.c, memcmp.c, realloc.c: Removed. - -2002-08-29 Keisuke Nishida - - * mkstemp.c, tempname.c: Removed. - -2002-08-28 Keisuke Nishida - - * Makefile.am: Use AC_LIBOBJ scheme. - - * memcmp.c, mkstemp.c, tempname.c: Extracted from fileutils-4.1.11. - -2002-05-29 Keisuke Nishida - - * getopt.c, getopt.h, getopt1.c: Extracted from glibc-2.2.5. - - -Copyright 2002-2012, 2017 Free Software Foundation, Inc. - -Copying and distribution of this file, with or without modification, are -permitted provided the copyright notice and this notice are preserved. diff -Nru gnucobol-4.0~early~20200606/lib/dummymac.c gnucobol-5/lib/dummymac.c --- gnucobol-4.0~early~20200606/lib/dummymac.c 2020-06-06 20:52:02.000000000 +0000 +++ gnucobol-5/lib/dummymac.c 1970-01-01 00:00:00.000000000 +0000 @@ -1,5 +0,0 @@ -void dummymacfix(void); -void -dummymacfix () -{ -} diff -Nru gnucobol-4.0~early~20200606/lib/gettext.h gnucobol-5/lib/gettext.h --- gnucobol-4.0~early~20200606/lib/gettext.h 2020-06-06 20:52:02.000000000 +0000 +++ gnucobol-5/lib/gettext.h 1970-01-01 00:00:00.000000000 +0000 @@ -1,292 +0,0 @@ -/* Convenience header for conditional use of GNU . - Copyright (C) 1995-1998, 2000-2002, 2004-2006, 2009-2016 Free Software - Foundation, Inc. - - This program is free software: you can redistribute it and/or modify - it under the terms of the GNU General Public License as published by - the Free Software Foundation; either version 3 of the License, or - (at your option) any later version. - - This program is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with this program. If not, see . */ - -#ifndef _LIBGETTEXT_H -#define _LIBGETTEXT_H 1 - -/* NLS can be disabled through the configure --disable-nls option. */ -#if ENABLE_NLS - -/* Get declarations of GNU message catalog functions. */ -# include - -/* You can set the DEFAULT_TEXT_DOMAIN macro to specify the domain used by - the gettext() and ngettext() macros. This is an alternative to calling - textdomain(), and is useful for libraries. */ -# ifdef DEFAULT_TEXT_DOMAIN -# undef gettext -# define gettext(Msgid) \ - dgettext (DEFAULT_TEXT_DOMAIN, Msgid) -# undef ngettext -# define ngettext(Msgid1, Msgid2, N) \ - dngettext (DEFAULT_TEXT_DOMAIN, Msgid1, Msgid2, N) -# endif - -#else - -/* Solaris /usr/include/locale.h includes /usr/include/libintl.h, which - chokes if dcgettext is defined as a macro. So include it now, to make - later inclusions of a NOP. We don't include - as well because people using "gettext.h" will not include , - and also including would fail on SunOS 4, whereas - is OK. */ -#if defined(__sun) -# include -#endif - -/* Many header files from the libstdc++ coming with g++ 3.3 or newer include - , which chokes if dcgettext is defined as a macro. So include - it now, to make later inclusions of a NOP. */ -#if defined(__cplusplus) && defined(__GNUG__) && (__GNUC__ >= 3) -# include -# if (__GLIBC__ >= 2 && !defined __UCLIBC__) || _GLIBCXX_HAVE_LIBINTL_H -# include -# endif -#endif - -/* Disabled NLS. - The casts to 'const char *' serve the purpose of producing warnings - for invalid uses of the value returned from these functions. - On pre-ANSI systems without 'const', the config.h file is supposed to - contain "#define const". */ -# undef gettext -# define gettext(Msgid) ((const char *) (Msgid)) -# undef dgettext -# define dgettext(Domainname, Msgid) ((void) (Domainname), gettext (Msgid)) -# undef dcgettext -# define dcgettext(Domainname, Msgid, Category) \ - ((void) (Category), dgettext (Domainname, Msgid)) -# undef ngettext -# define ngettext(Msgid1, Msgid2, N) \ - ((N) == 1 \ - ? ((void) (Msgid2), (const char *) (Msgid1)) \ - : ((void) (Msgid1), (const char *) (Msgid2))) -# undef dngettext -# define dngettext(Domainname, Msgid1, Msgid2, N) \ - ((void) (Domainname), ngettext (Msgid1, Msgid2, N)) -# undef dcngettext -# define dcngettext(Domainname, Msgid1, Msgid2, N, Category) \ - ((void) (Category), dngettext (Domainname, Msgid1, Msgid2, N)) -# undef textdomain -# define textdomain(Domainname) ((const char *) (Domainname)) -# undef bindtextdomain -# define bindtextdomain(Domainname, Dirname) \ - ((void) (Domainname), (const char *) (Dirname)) -# undef bind_textdomain_codeset -# define bind_textdomain_codeset(Domainname, Codeset) \ - ((void) (Domainname), (const char *) (Codeset)) - -#endif - -/* Prefer gnulib's setlocale override over libintl's setlocale override. */ -#ifdef GNULIB_defined_setlocale -# undef setlocale -# define setlocale rpl_setlocale -#endif - -/* A pseudo function call that serves as a marker for the automated - extraction of messages, but does not call gettext(). The run-time - translation is done at a different place in the code. - The argument, String, should be a literal string. Concatenated strings - and other string expressions won't work. - The macro's expansion is not parenthesized, so that it is suitable as - initializer for static 'char[]' or 'const char[]' variables. */ -#define gettext_noop(String) String - -/* The separator between msgctxt and msgid in a .mo file. */ -#define GETTEXT_CONTEXT_GLUE "\004" - -/* Pseudo function calls, taking a MSGCTXT and a MSGID instead of just a - MSGID. MSGCTXT and MSGID must be string literals. MSGCTXT should be - short and rarely need to change. - The letter 'p' stands for 'particular' or 'special'. */ -#ifdef DEFAULT_TEXT_DOMAIN -# define pgettext(Msgctxt, Msgid) \ - pgettext_aux (DEFAULT_TEXT_DOMAIN, Msgctxt GETTEXT_CONTEXT_GLUE Msgid, Msgid, LC_MESSAGES) -#else -# define pgettext(Msgctxt, Msgid) \ - pgettext_aux (NULL, Msgctxt GETTEXT_CONTEXT_GLUE Msgid, Msgid, LC_MESSAGES) -#endif -#define dpgettext(Domainname, Msgctxt, Msgid) \ - pgettext_aux (Domainname, Msgctxt GETTEXT_CONTEXT_GLUE Msgid, Msgid, LC_MESSAGES) -#define dcpgettext(Domainname, Msgctxt, Msgid, Category) \ - pgettext_aux (Domainname, Msgctxt GETTEXT_CONTEXT_GLUE Msgid, Msgid, Category) -#ifdef DEFAULT_TEXT_DOMAIN -# define npgettext(Msgctxt, Msgid, MsgidPlural, N) \ - npgettext_aux (DEFAULT_TEXT_DOMAIN, Msgctxt GETTEXT_CONTEXT_GLUE Msgid, Msgid, MsgidPlural, N, LC_MESSAGES) -#else -# define npgettext(Msgctxt, Msgid, MsgidPlural, N) \ - npgettext_aux (NULL, Msgctxt GETTEXT_CONTEXT_GLUE Msgid, Msgid, MsgidPlural, N, LC_MESSAGES) -#endif -#define dnpgettext(Domainname, Msgctxt, Msgid, MsgidPlural, N) \ - npgettext_aux (Domainname, Msgctxt GETTEXT_CONTEXT_GLUE Msgid, Msgid, MsgidPlural, N, LC_MESSAGES) -#define dcnpgettext(Domainname, Msgctxt, Msgid, MsgidPlural, N, Category) \ - npgettext_aux (Domainname, Msgctxt GETTEXT_CONTEXT_GLUE Msgid, Msgid, MsgidPlural, N, Category) - -#ifdef __GNUC__ -__inline -#else -#ifdef __cplusplus -inline -#endif -#endif -static const char * -pgettext_aux (const char *domain, - const char *msg_ctxt_id, const char *msgid, - int category) -{ - const char *translation = dcgettext (domain, msg_ctxt_id, category); - if (translation == msg_ctxt_id) - return msgid; - else - return translation; -} - -#ifdef __GNUC__ -__inline -#else -#ifdef __cplusplus -inline -#endif -#endif -static const char * -npgettext_aux (const char *domain, - const char *msg_ctxt_id, const char *msgid, - const char *msgid_plural, unsigned long int n, - int category) -{ - const char *translation = - dcngettext (domain, msg_ctxt_id, msgid_plural, n, category); - if (translation == msg_ctxt_id || translation == msgid_plural) - return (n == 1 ? msgid : msgid_plural); - else - return translation; -} - -/* The same thing extended for non-constant arguments. Here MSGCTXT and MSGID - can be arbitrary expressions. But for string literals these macros are - less efficient than those above. */ - -#include - -#if (((__GNUC__ >= 3 || __GNUG__ >= 2) && !defined __STRICT_ANSI__) \ - /* || __STDC_VERSION__ >= 199901L */ ) -# define _LIBGETTEXT_HAVE_VARIABLE_SIZE_ARRAYS 1 -#else -# define _LIBGETTEXT_HAVE_VARIABLE_SIZE_ARRAYS 0 -#endif - -#if !_LIBGETTEXT_HAVE_VARIABLE_SIZE_ARRAYS -#include -#endif - -#define pgettext_expr(Msgctxt, Msgid) \ - dcpgettext_expr (NULL, Msgctxt, Msgid, LC_MESSAGES) -#define dpgettext_expr(Domainname, Msgctxt, Msgid) \ - dcpgettext_expr (Domainname, Msgctxt, Msgid, LC_MESSAGES) - -#ifdef __GNUC__ -__inline -#else -#ifdef __cplusplus -inline -#endif -#endif -static const char * -dcpgettext_expr (const char *domain, - const char *msgctxt, const char *msgid, - int category) -{ - size_t msgctxt_len = strlen (msgctxt) + 1; - size_t msgid_len = strlen (msgid) + 1; - const char *translation; -#if _LIBGETTEXT_HAVE_VARIABLE_SIZE_ARRAYS - char msg_ctxt_id[msgctxt_len + msgid_len]; -#else - char buf[1024]; - char *msg_ctxt_id = - (msgctxt_len + msgid_len <= sizeof (buf) - ? buf - : (char *) malloc (msgctxt_len + msgid_len)); - if (msg_ctxt_id != NULL) -#endif - { - int found_translation; - memcpy (msg_ctxt_id, msgctxt, msgctxt_len - 1); - msg_ctxt_id[msgctxt_len - 1] = '\004'; - memcpy (msg_ctxt_id + msgctxt_len, msgid, msgid_len); - translation = dcgettext (domain, msg_ctxt_id, category); - found_translation = (translation != msg_ctxt_id); -#if !_LIBGETTEXT_HAVE_VARIABLE_SIZE_ARRAYS - if (msg_ctxt_id != buf) - free (msg_ctxt_id); -#endif - if (found_translation) - return translation; - } - return msgid; -} - -#define npgettext_expr(Msgctxt, Msgid, MsgidPlural, N) \ - dcnpgettext_expr (NULL, Msgctxt, Msgid, MsgidPlural, N, LC_MESSAGES) -#define dnpgettext_expr(Domainname, Msgctxt, Msgid, MsgidPlural, N) \ - dcnpgettext_expr (Domainname, Msgctxt, Msgid, MsgidPlural, N, LC_MESSAGES) - -#ifdef __GNUC__ -__inline -#else -#ifdef __cplusplus -inline -#endif -#endif -static const char * -dcnpgettext_expr (const char *domain, - const char *msgctxt, const char *msgid, - const char *msgid_plural, unsigned long int n, - int category) -{ - size_t msgctxt_len = strlen (msgctxt) + 1; - size_t msgid_len = strlen (msgid) + 1; - const char *translation; -#if _LIBGETTEXT_HAVE_VARIABLE_SIZE_ARRAYS - char msg_ctxt_id[msgctxt_len + msgid_len]; -#else - char buf[1024]; - char *msg_ctxt_id = - (msgctxt_len + msgid_len <= sizeof (buf) - ? buf - : (char *) malloc (msgctxt_len + msgid_len)); - if (msg_ctxt_id != NULL) -#endif - { - int found_translation; - memcpy (msg_ctxt_id, msgctxt, msgctxt_len - 1); - msg_ctxt_id[msgctxt_len - 1] = '\004'; - memcpy (msg_ctxt_id + msgctxt_len, msgid, msgid_len); - translation = dcngettext (domain, msg_ctxt_id, msgid_plural, n, category); - found_translation = !(translation == msg_ctxt_id || translation == msgid_plural); -#if !_LIBGETTEXT_HAVE_VARIABLE_SIZE_ARRAYS - if (msg_ctxt_id != buf) - free (msg_ctxt_id); -#endif - if (found_translation) - return translation; - } - return (n == 1 ? msgid : msgid_plural); -} - -#endif /* _LIBGETTEXT_H */ diff -Nru gnucobol-4.0~early~20200606/lib/Makefile.am gnucobol-5/lib/Makefile.am --- gnucobol-4.0~early~20200606/lib/Makefile.am 2020-06-06 20:52:02.000000000 +0000 +++ gnucobol-5/lib/Makefile.am 1970-01-01 00:00:00.000000000 +0000 @@ -1,27 +0,0 @@ -# -# Makefile gnucobol/lib -# -# Copyright (C) 2002-2012, 2017 Free Software Foundation, Inc. -# Written by Keisuke Nishida, Roger While, Simon Sobisch -# -# This file is part of GnuCOBOL. -# -# The GnuCOBOL compiler is free software: you can redistribute it -# and/or modify it under the terms of the GNU General Public License -# as published by the Free Software Foundation, either version 3 of the -# License, or (at your option) any later version. -# -# GnuCOBOL is distributed in the hope that it will be useful, -# but WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -# GNU General Public License for more details. -# -# You should have received a copy of the GNU General Public License -# along with GnuCOBOL. If not, see . - -noinst_HEADERS = gettext.h -noinst_LIBRARIES = libsupport.a - -AM_CPPFLAGS = -I$(top_srcdir) -libsupport_a_SOURCES = dummymac.c -libsupport_a_LIBADD = @LIBOBJS@ diff -Nru gnucobol-4.0~early~20200606/lib/Makefile.in gnucobol-5/lib/Makefile.in --- gnucobol-4.0~early~20200606/lib/Makefile.in 2020-06-06 20:56:36.000000000 +0000 +++ gnucobol-5/lib/Makefile.in 1970-01-01 00:00:00.000000000 +0000 @@ -1,704 +0,0 @@ -# Makefile.in generated by automake 1.15.1 from Makefile.am. -# @configure_input@ - -# Copyright (C) 1994-2017 Free Software Foundation, Inc. - -# This Makefile.in is free software; the Free Software Foundation -# gives unlimited permission to copy and/or distribute it, -# with or without modifications, as long as this notice is preserved. - -# This program is distributed in the hope that it will be useful, -# but WITHOUT ANY WARRANTY, to the extent permitted by law; without -# even the implied warranty of MERCHANTABILITY or FITNESS FOR A -# PARTICULAR PURPOSE. - -@SET_MAKE@ - -# -# Makefile gnucobol/lib -# -# Copyright (C) 2002-2012, 2017 Free Software Foundation, Inc. -# Written by Keisuke Nishida, Roger While, Simon Sobisch -# -# This file is part of GnuCOBOL. -# -# The GnuCOBOL compiler is free software: you can redistribute it -# and/or modify it under the terms of the GNU General Public License -# as published by the Free Software Foundation, either version 3 of the -# License, or (at your option) any later version. -# -# GnuCOBOL is distributed in the hope that it will be useful, -# but WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -# GNU General Public License for more details. -# -# You should have received a copy of the GNU General Public License -# along with GnuCOBOL. If not, see . - - -VPATH = @srcdir@ -am__is_gnu_make = { \ - if test -z '$(MAKELEVEL)'; then \ - false; \ - elif test -n '$(MAKE_HOST)'; then \ - true; \ - elif test -n '$(MAKE_VERSION)' && test -n '$(CURDIR)'; then \ - true; \ - else \ - false; \ - fi; \ -} -am__make_running_with_option = \ - case $${target_option-} in \ - ?) ;; \ - *) echo "am__make_running_with_option: internal error: invalid" \ - "target option '$${target_option-}' specified" >&2; \ - exit 1;; \ - esac; \ - has_opt=no; \ - sane_makeflags=$$MAKEFLAGS; \ - if $(am__is_gnu_make); then \ - sane_makeflags=$$MFLAGS; \ - else \ - case $$MAKEFLAGS in \ - *\\[\ \ ]*) \ - bs=\\; \ - sane_makeflags=`printf '%s\n' "$$MAKEFLAGS" \ - | sed "s/$$bs$$bs[$$bs $$bs ]*//g"`;; \ - esac; \ - fi; \ - skip_next=no; \ - strip_trailopt () \ - { \ - flg=`printf '%s\n' "$$flg" | sed "s/$$1.*$$//"`; \ - }; \ - for flg in $$sane_makeflags; do \ - test $$skip_next = yes && { skip_next=no; continue; }; \ - case $$flg in \ - *=*|--*) continue;; \ - -*I) strip_trailopt 'I'; skip_next=yes;; \ - -*I?*) strip_trailopt 'I';; \ - -*O) strip_trailopt 'O'; skip_next=yes;; \ - -*O?*) strip_trailopt 'O';; \ - -*l) strip_trailopt 'l'; skip_next=yes;; \ - -*l?*) strip_trailopt 'l';; \ - -[dEDm]) skip_next=yes;; \ - -[JT]) skip_next=yes;; \ - esac; \ - case $$flg in \ - *$$target_option*) has_opt=yes; break;; \ - esac; \ - done; \ - test $$has_opt = yes -am__make_dryrun = (target_option=n; $(am__make_running_with_option)) -am__make_keepgoing = (target_option=k; $(am__make_running_with_option)) -pkgdatadir = $(datadir)/@PACKAGE@ -pkgincludedir = $(includedir)/@PACKAGE@ -pkglibdir = $(libdir)/@PACKAGE@ -pkglibexecdir = $(libexecdir)/@PACKAGE@ -am__cd = CDPATH="$${ZSH_VERSION+.}$(PATH_SEPARATOR)" && cd -install_sh_DATA = $(install_sh) -c -m 644 -install_sh_PROGRAM = $(install_sh) -c -install_sh_SCRIPT = $(install_sh) -c -INSTALL_HEADER = $(INSTALL_DATA) -transform = $(program_transform_name) -NORMAL_INSTALL = : -PRE_INSTALL = : -POST_INSTALL = : -NORMAL_UNINSTALL = : -PRE_UNINSTALL = : -POST_UNINSTALL = : -build_triplet = @build@ -host_triplet = @host@ -subdir = lib -ACLOCAL_M4 = $(top_srcdir)/aclocal.m4 -am__aclocal_m4_deps = $(top_srcdir)/m4/codeset.m4 \ - $(top_srcdir)/m4/gettext.m4 $(top_srcdir)/m4/iconv.m4 \ - $(top_srcdir)/m4/intlmacosx.m4 $(top_srcdir)/m4/lib-ld.m4 \ - $(top_srcdir)/m4/lib-link.m4 $(top_srcdir)/m4/lib-prefix.m4 \ - $(top_srcdir)/m4/libtool.m4 $(top_srcdir)/m4/ltoptions.m4 \ - $(top_srcdir)/m4/ltsugar.m4 $(top_srcdir)/m4/ltversion.m4 \ - $(top_srcdir)/m4/lt~obsolete.m4 \ - $(top_srcdir)/m4/m4_ax_check_define.m4 \ - $(top_srcdir)/m4/m4_ax_code_coverage.m4 \ - $(top_srcdir)/m4/nls.m4 $(top_srcdir)/m4/pkg.m4 \ - $(top_srcdir)/m4/po.m4 $(top_srcdir)/m4/progtest.m4 \ - $(top_srcdir)/configure.ac -am__configure_deps = $(am__aclocal_m4_deps) $(CONFIGURE_DEPENDENCIES) \ - $(ACLOCAL_M4) -DIST_COMMON = $(srcdir)/Makefile.am $(noinst_HEADERS) \ - $(am__DIST_COMMON) -mkinstalldirs = $(SHELL) $(top_srcdir)/build_aux/mkinstalldirs -CONFIG_HEADER = $(top_builddir)/config.h -CONFIG_CLEAN_FILES = -CONFIG_CLEAN_VPATH_FILES = -LIBRARIES = $(noinst_LIBRARIES) -ARFLAGS = cru -AM_V_AR = $(am__v_AR_@AM_V@) -am__v_AR_ = $(am__v_AR_@AM_DEFAULT_V@) -am__v_AR_0 = @echo " AR " $@; -am__v_AR_1 = -libsupport_a_AR = $(AR) $(ARFLAGS) -libsupport_a_DEPENDENCIES = @LIBOBJS@ -am_libsupport_a_OBJECTS = dummymac.$(OBJEXT) -libsupport_a_OBJECTS = $(am_libsupport_a_OBJECTS) -AM_V_P = $(am__v_P_@AM_V@) -am__v_P_ = $(am__v_P_@AM_DEFAULT_V@) -am__v_P_0 = false -am__v_P_1 = : -AM_V_GEN = $(am__v_GEN_@AM_V@) -am__v_GEN_ = $(am__v_GEN_@AM_DEFAULT_V@) -am__v_GEN_0 = @echo " GEN " $@; -am__v_GEN_1 = -AM_V_at = $(am__v_at_@AM_V@) -am__v_at_ = $(am__v_at_@AM_DEFAULT_V@) -am__v_at_0 = @ -am__v_at_1 = -DEFAULT_INCLUDES = -I.@am__isrc@ -I$(top_builddir) -depcomp = $(SHELL) $(top_srcdir)/build_aux/depcomp -am__depfiles_maybe = depfiles -am__mv = mv -f -COMPILE = $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) \ - $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -AM_V_lt = $(am__v_lt_@AM_V@) -am__v_lt_ = $(am__v_lt_@AM_DEFAULT_V@) -am__v_lt_0 = --silent -am__v_lt_1 = -LTCOMPILE = $(LIBTOOL) $(AM_V_lt) --tag=CC $(AM_LIBTOOLFLAGS) \ - $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) \ - $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) \ - $(AM_CFLAGS) $(CFLAGS) -AM_V_CC = $(am__v_CC_@AM_V@) -am__v_CC_ = $(am__v_CC_@AM_DEFAULT_V@) -am__v_CC_0 = @echo " CC " $@; -am__v_CC_1 = -CCLD = $(CC) -LINK = $(LIBTOOL) $(AM_V_lt) --tag=CC $(AM_LIBTOOLFLAGS) \ - $(LIBTOOLFLAGS) --mode=link $(CCLD) $(AM_CFLAGS) $(CFLAGS) \ - $(AM_LDFLAGS) $(LDFLAGS) -o $@ -AM_V_CCLD = $(am__v_CCLD_@AM_V@) -am__v_CCLD_ = $(am__v_CCLD_@AM_DEFAULT_V@) -am__v_CCLD_0 = @echo " CCLD " $@; -am__v_CCLD_1 = -SOURCES = $(libsupport_a_SOURCES) -DIST_SOURCES = $(libsupport_a_SOURCES) -am__can_run_installinfo = \ - case $$AM_UPDATE_INFO_DIR in \ - n|no|NO) false;; \ - *) (install-info --version) >/dev/null 2>&1;; \ - esac -HEADERS = $(noinst_HEADERS) -am__tagged_files = $(HEADERS) $(SOURCES) $(TAGS_FILES) $(LISP) -# Read a list of newline-separated strings from the standard input, -# and print each of them once, without duplicates. Input order is -# *not* preserved. -am__uniquify_input = $(AWK) '\ - BEGIN { nonempty = 0; } \ - { items[$$0] = 1; nonempty = 1; } \ - END { if (nonempty) { for (i in items) print i; }; } \ -' -# Make sure the list of sources is unique. This is necessary because, -# e.g., the same source file might be shared among _SOURCES variables -# for different programs/libraries. -am__define_uniq_tagged_files = \ - list='$(am__tagged_files)'; \ - unique=`for i in $$list; do \ - if test -f "$$i"; then echo $$i; else echo $(srcdir)/$$i; fi; \ - done | $(am__uniquify_input)` -ETAGS = etags -CTAGS = ctags -am__DIST_COMMON = $(srcdir)/Makefile.in \ - $(top_srcdir)/build_aux/depcomp \ - $(top_srcdir)/build_aux/mkinstalldirs ChangeLog -DISTFILES = $(DIST_COMMON) $(DIST_SOURCES) $(TEXINFOS) $(EXTRA_DIST) -ACLOCAL = @ACLOCAL@ -AMTAR = @AMTAR@ -AM_DEFAULT_VERBOSITY = @AM_DEFAULT_VERBOSITY@ -AR = @AR@ -AS = @AS@ -AUTOCONF = @AUTOCONF@ -AUTOHEADER = @AUTOHEADER@ -AUTOMAKE = @AUTOMAKE@ -AWK = @AWK@ -CC = @CC@ -CCDEPMODE = @CCDEPMODE@ -CFLAGS = @CFLAGS@ -CJSON_CFLAGS = @CJSON_CFLAGS@ -CJSON_LIBS = @CJSON_LIBS@ -COBC_LIBS = @COBC_LIBS@ -COB_BIGENDIAN = @COB_BIGENDIAN@ -COB_CC = @COB_CC@ -COB_CFLAGS = @COB_CFLAGS@ -COB_CONFIG_DIR = @COB_CONFIG_DIR@ -COB_COPY_DIR = @COB_COPY_DIR@ -COB_EXE_EXT = @COB_EXE_EXT@ -COB_EXPORT_DYN = @COB_EXPORT_DYN@ -COB_FIX_LIB = @COB_FIX_LIB@ -COB_FIX_LIBTOOL = @COB_FIX_LIBTOOL@ -COB_HAS_64_BIT_POINTER = @COB_HAS_64_BIT_POINTER@ -COB_HAS_BDB = @COB_HAS_BDB@ -COB_HAS_CISAM = @COB_HAS_CISAM@ -COB_HAS_CJSON = @COB_HAS_CJSON@ -COB_HAS_CURSES = @COB_HAS_CURSES@ -COB_HAS_DISAM = @COB_HAS_DISAM@ -COB_HAS_ISAM = @COB_HAS_ISAM@ -COB_HAS_LMDB = @COB_HAS_LMDB@ -COB_HAS_OCEXTFH = @COB_HAS_OCEXTFH@ -COB_HAS_OCI = @COB_HAS_OCI@ -COB_HAS_ODBC = @COB_HAS_ODBC@ -COB_HAS_VBISAM = @COB_HAS_VBISAM@ -COB_HAS_XML2 = @COB_HAS_XML2@ -COB_KEYWORD_INLINE = @COB_KEYWORD_INLINE@ -COB_LDFLAGS = @COB_LDFLAGS@ -COB_LIBRARY_PATH = @COB_LIBRARY_PATH@ -COB_LIBS = @COB_LIBS@ -COB_MODULE_EXT = @COB_MODULE_EXT@ -COB_OBJECT_EXT = @COB_OBJECT_EXT@ -COB_PATCH_LEVEL = @COB_PATCH_LEVEL@ -COB_PIC_FLAGS = @COB_PIC_FLAGS@ -COB_SCHEMA_DIR = @COB_SCHEMA_DIR@ -COB_SHARED_OPT = @COB_SHARED_OPT@ -CODE_COVERAGE_CFLAGS = @CODE_COVERAGE_CFLAGS@ -CODE_COVERAGE_CPPFLAGS = @CODE_COVERAGE_CPPFLAGS@ -CODE_COVERAGE_CXXFLAGS = @CODE_COVERAGE_CXXFLAGS@ -CODE_COVERAGE_ENABLED = @CODE_COVERAGE_ENABLED@ -CODE_COVERAGE_LDFLAGS = @CODE_COVERAGE_LDFLAGS@ -CODE_COVERAGE_LIBS = @CODE_COVERAGE_LIBS@ -CPP = @CPP@ -CPPFLAGS = @CPPFLAGS@ -CYGPATH_W = @CYGPATH_W@ -DEFS = @DEFS@ -DEPDIR = @DEPDIR@ -DIFF_FLAGS = @DIFF_FLAGS@ -DLLTOOL = @DLLTOOL@ -DSYMUTIL = @DSYMUTIL@ -DUMPBIN = @DUMPBIN@ -ECHO_C = @ECHO_C@ -ECHO_N = @ECHO_N@ -ECHO_T = @ECHO_T@ -EGREP = @EGREP@ -EXEEXT = @EXEEXT@ -FGREP = @FGREP@ -GCOV = @GCOV@ -GENHTML = @GENHTML@ -GETTEXT_MACRO_VERSION = @GETTEXT_MACRO_VERSION@ -GMSGFMT = @GMSGFMT@ -GMSGFMT_015 = @GMSGFMT_015@ -GREP = @GREP@ -HELP2MAN = @HELP2MAN@ -INSTALL = @INSTALL@ -INSTALL_DATA = @INSTALL_DATA@ -INSTALL_PROGRAM = @INSTALL_PROGRAM@ -INSTALL_SCRIPT = @INSTALL_SCRIPT@ -INSTALL_STRIP_PROGRAM = @INSTALL_STRIP_PROGRAM@ -INTLLIBS = @INTLLIBS@ -INTL_MACOSX_LIBS = @INTL_MACOSX_LIBS@ -LCOV = @LCOV@ -LD = @LD@ -LDFLAGS = @LDFLAGS@ -LEX = @LEX@ -LEXLIB = @LEXLIB@ -LEX_OUTPUT_ROOT = @LEX_OUTPUT_ROOT@ -LIBCOB_CISAM = @LIBCOB_CISAM@ -LIBCOB_CPPFLAGS = @LIBCOB_CPPFLAGS@ -LIBCOB_DISAM = @LIBCOB_DISAM@ -LIBCOB_LIBS = @LIBCOB_LIBS@ -LIBCOB_VBISAM = @LIBCOB_VBISAM@ -LIBICONV = @LIBICONV@ -LIBINTL = @LIBINTL@ -LIBOBJS = @LIBOBJS@ -LIBS = @LIBS@ -LIBTOOL = @LIBTOOL@ -LIPO = @LIPO@ -LN_S = @LN_S@ -LTLIBICONV = @LTLIBICONV@ -LTLIBINTL = @LTLIBINTL@ -LTLIBOBJS = @LTLIBOBJS@ -LT_SYS_LIBRARY_PATH = @LT_SYS_LIBRARY_PATH@ -MAKE = @MAKE@ -MAKEINFO = @MAKEINFO@ -MANIFEST_TOOL = @MANIFEST_TOOL@ -MKDIR_P = @MKDIR_P@ -MSGFMT = @MSGFMT@ -MSGFMT_015 = @MSGFMT_015@ -MSGMERGE = @MSGMERGE@ -NM = @NM@ -NMEDIT = @NMEDIT@ -OBJDUMP = @OBJDUMP@ -OBJEXT = @OBJEXT@ -ODBC_CFLAGS = @ODBC_CFLAGS@ -ODBC_LIBS = @ODBC_LIBS@ -OTOOL = @OTOOL@ -OTOOL64 = @OTOOL64@ -PACKAGE = @PACKAGE@ -PACKAGE_BUGREPORT = @PACKAGE_BUGREPORT@ -PACKAGE_NAME = @PACKAGE_NAME@ -PACKAGE_STRING = @PACKAGE_STRING@ -PACKAGE_TARNAME = @PACKAGE_TARNAME@ -PACKAGE_URL = @PACKAGE_URL@ -PACKAGE_VERSION = @PACKAGE_VERSION@ -PATH_SEPARATOR = @PATH_SEPARATOR@ -PKG_CONFIG = @PKG_CONFIG@ -PKG_CONFIG_LIBDIR = @PKG_CONFIG_LIBDIR@ -PKG_CONFIG_PATH = @PKG_CONFIG_PATH@ -POSUB = @POSUB@ -RANLIB = @RANLIB@ -SED = @SED@ -SET_MAKE = @SET_MAKE@ -SHELL = @SHELL@ -STRIP = @STRIP@ -USE_NLS = @USE_NLS@ -VERSION = @VERSION@ -XGETTEXT = @XGETTEXT@ -XGETTEXT_015 = @XGETTEXT_015@ -XGETTEXT_EXTRA_OPTIONS = @XGETTEXT_EXTRA_OPTIONS@ -XML2_CFLAGS = @XML2_CFLAGS@ -XML2_LIBS = @XML2_LIBS@ -YACC = @YACC@ -YFLAGS = @YFLAGS@ -abs_builddir = @abs_builddir@ -abs_srcdir = @abs_srcdir@ -abs_top_builddir = @abs_top_builddir@ -abs_top_srcdir = @abs_top_srcdir@ -ac_ct_AR = @ac_ct_AR@ -ac_ct_CC = @ac_ct_CC@ -ac_ct_DUMPBIN = @ac_ct_DUMPBIN@ -am__include = @am__include@ -am__leading_dot = @am__leading_dot@ -am__quote = @am__quote@ -am__tar = @am__tar@ -am__untar = @am__untar@ -bindir = @bindir@ -build = @build@ -build_alias = @build_alias@ -build_cpu = @build_cpu@ -build_os = @build_os@ -build_vendor = @build_vendor@ -builddir = @builddir@ -configured_make = @configured_make@ -datadir = @datadir@ -datarootdir = @datarootdir@ -docdir = @docdir@ -dvidir = @dvidir@ -exec_prefix = @exec_prefix@ -host = @host@ -host_alias = @host_alias@ -host_cpu = @host_cpu@ -host_os = @host_os@ -host_vendor = @host_vendor@ -htmldir = @htmldir@ -includedir = @includedir@ -infodir = @infodir@ -install_sh = @install_sh@ -libdir = @libdir@ -libexecdir = @libexecdir@ -localedir = @localedir@ -localstatedir = @localstatedir@ -mandir = @mandir@ -mkdir_p = @mkdir_p@ -oldincludedir = @oldincludedir@ -pdfdir = @pdfdir@ -prefix = @prefix@ -program_transform_name = @program_transform_name@ -psdir = @psdir@ -runstatedir = @runstatedir@ -sbindir = @sbindir@ -sharedstatedir = @sharedstatedir@ -srcdir = @srcdir@ -sysconfdir = @sysconfdir@ -target_alias = @target_alias@ -top_build_prefix = @top_build_prefix@ -top_builddir = @top_builddir@ -top_srcdir = @top_srcdir@ -xml2_config_found = @xml2_config_found@ -noinst_HEADERS = gettext.h -noinst_LIBRARIES = libsupport.a -AM_CPPFLAGS = -I$(top_srcdir) -libsupport_a_SOURCES = dummymac.c -libsupport_a_LIBADD = @LIBOBJS@ -all: all-am - -.SUFFIXES: -.SUFFIXES: .c .lo .o .obj -$(srcdir)/Makefile.in: $(srcdir)/Makefile.am $(am__configure_deps) - @for dep in $?; do \ - case '$(am__configure_deps)' in \ - *$$dep*) \ - ( cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh ) \ - && { if test -f $@; then exit 0; else break; fi; }; \ - exit 1;; \ - esac; \ - done; \ - echo ' cd $(top_srcdir) && $(AUTOMAKE) --gnu lib/Makefile'; \ - $(am__cd) $(top_srcdir) && \ - $(AUTOMAKE) --gnu lib/Makefile -Makefile: $(srcdir)/Makefile.in $(top_builddir)/config.status - @case '$?' in \ - *config.status*) \ - cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh;; \ - *) \ - echo ' cd $(top_builddir) && $(SHELL) ./config.status $(subdir)/$@ $(am__depfiles_maybe)'; \ - cd $(top_builddir) && $(SHELL) ./config.status $(subdir)/$@ $(am__depfiles_maybe);; \ - esac; - -$(top_builddir)/config.status: $(top_srcdir)/configure $(CONFIG_STATUS_DEPENDENCIES) - cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh - -$(top_srcdir)/configure: $(am__configure_deps) - cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh -$(ACLOCAL_M4): $(am__aclocal_m4_deps) - cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh -$(am__aclocal_m4_deps): - -clean-noinstLIBRARIES: - -test -z "$(noinst_LIBRARIES)" || rm -f $(noinst_LIBRARIES) - -libsupport.a: $(libsupport_a_OBJECTS) $(libsupport_a_DEPENDENCIES) $(EXTRA_libsupport_a_DEPENDENCIES) - $(AM_V_at)-rm -f libsupport.a - $(AM_V_AR)$(libsupport_a_AR) libsupport.a $(libsupport_a_OBJECTS) $(libsupport_a_LIBADD) - $(AM_V_at)$(RANLIB) libsupport.a - -mostlyclean-compile: - -rm -f *.$(OBJEXT) - -distclean-compile: - -rm -f *.tab.c - -@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/dummymac.Po@am__quote@ - -.c.o: -@am__fastdepCC_TRUE@ $(AM_V_CC)$(COMPILE) -MT $@ -MD -MP -MF $(DEPDIR)/$*.Tpo -c -o $@ $< -@am__fastdepCC_TRUE@ $(AM_V_at)$(am__mv) $(DEPDIR)/$*.Tpo $(DEPDIR)/$*.Po -@AMDEP_TRUE@@am__fastdepCC_FALSE@ $(AM_V_CC)source='$<' object='$@' libtool=no @AMDEPBACKSLASH@ -@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ -@am__fastdepCC_FALSE@ $(AM_V_CC@am__nodep@)$(COMPILE) -c -o $@ $< - -.c.obj: -@am__fastdepCC_TRUE@ $(AM_V_CC)$(COMPILE) -MT $@ -MD -MP -MF $(DEPDIR)/$*.Tpo -c -o $@ `$(CYGPATH_W) '$<'` -@am__fastdepCC_TRUE@ $(AM_V_at)$(am__mv) $(DEPDIR)/$*.Tpo $(DEPDIR)/$*.Po -@AMDEP_TRUE@@am__fastdepCC_FALSE@ $(AM_V_CC)source='$<' object='$@' libtool=no @AMDEPBACKSLASH@ -@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ -@am__fastdepCC_FALSE@ $(AM_V_CC@am__nodep@)$(COMPILE) -c -o $@ `$(CYGPATH_W) '$<'` - -.c.lo: -@am__fastdepCC_TRUE@ $(AM_V_CC)$(LTCOMPILE) -MT $@ -MD -MP -MF $(DEPDIR)/$*.Tpo -c -o $@ $< -@am__fastdepCC_TRUE@ $(AM_V_at)$(am__mv) $(DEPDIR)/$*.Tpo $(DEPDIR)/$*.Plo -@AMDEP_TRUE@@am__fastdepCC_FALSE@ $(AM_V_CC)source='$<' object='$@' libtool=yes @AMDEPBACKSLASH@ -@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ -@am__fastdepCC_FALSE@ $(AM_V_CC@am__nodep@)$(LTCOMPILE) -c -o $@ $< - -mostlyclean-libtool: - -rm -f *.lo - -clean-libtool: - -rm -rf .libs _libs - -ID: $(am__tagged_files) - $(am__define_uniq_tagged_files); mkid -fID $$unique -tags: tags-am -TAGS: tags - -tags-am: $(TAGS_DEPENDENCIES) $(am__tagged_files) - set x; \ - here=`pwd`; \ - $(am__define_uniq_tagged_files); \ - shift; \ - if test -z "$(ETAGS_ARGS)$$*$$unique"; then :; else \ - test -n "$$unique" || unique=$$empty_fix; \ - if test $$# -gt 0; then \ - $(ETAGS) $(ETAGSFLAGS) $(AM_ETAGSFLAGS) $(ETAGS_ARGS) \ - "$$@" $$unique; \ - else \ - $(ETAGS) $(ETAGSFLAGS) $(AM_ETAGSFLAGS) $(ETAGS_ARGS) \ - $$unique; \ - fi; \ - fi -ctags: ctags-am - -CTAGS: ctags -ctags-am: $(TAGS_DEPENDENCIES) $(am__tagged_files) - $(am__define_uniq_tagged_files); \ - test -z "$(CTAGS_ARGS)$$unique" \ - || $(CTAGS) $(CTAGSFLAGS) $(AM_CTAGSFLAGS) $(CTAGS_ARGS) \ - $$unique - -GTAGS: - here=`$(am__cd) $(top_builddir) && pwd` \ - && $(am__cd) $(top_srcdir) \ - && gtags -i $(GTAGS_ARGS) "$$here" -cscopelist: cscopelist-am - -cscopelist-am: $(am__tagged_files) - list='$(am__tagged_files)'; \ - case "$(srcdir)" in \ - [\\/]* | ?:[\\/]*) sdir="$(srcdir)" ;; \ - *) sdir=$(subdir)/$(srcdir) ;; \ - esac; \ - for i in $$list; do \ - if test -f "$$i"; then \ - echo "$(subdir)/$$i"; \ - else \ - echo "$$sdir/$$i"; \ - fi; \ - done >> $(top_builddir)/cscope.files - -distclean-tags: - -rm -f TAGS ID GTAGS GRTAGS GSYMS GPATH tags - -distdir: $(DISTFILES) - @srcdirstrip=`echo "$(srcdir)" | sed 's/[].[^$$\\*]/\\\\&/g'`; \ - topsrcdirstrip=`echo "$(top_srcdir)" | sed 's/[].[^$$\\*]/\\\\&/g'`; \ - list='$(DISTFILES)'; \ - dist_files=`for file in $$list; do echo $$file; done | \ - sed -e "s|^$$srcdirstrip/||;t" \ - -e "s|^$$topsrcdirstrip/|$(top_builddir)/|;t"`; \ - case $$dist_files in \ - */*) $(MKDIR_P) `echo "$$dist_files" | \ - sed '/\//!d;s|^|$(distdir)/|;s,/[^/]*$$,,' | \ - sort -u` ;; \ - esac; \ - for file in $$dist_files; do \ - if test -f $$file || test -d $$file; then d=.; else d=$(srcdir); fi; \ - if test -d $$d/$$file; then \ - dir=`echo "/$$file" | sed -e 's,/[^/]*$$,,'`; \ - if test -d "$(distdir)/$$file"; then \ - find "$(distdir)/$$file" -type d ! -perm -700 -exec chmod u+rwx {} \;; \ - fi; \ - if test -d $(srcdir)/$$file && test $$d != $(srcdir); then \ - cp -fpR $(srcdir)/$$file "$(distdir)$$dir" || exit 1; \ - find "$(distdir)/$$file" -type d ! -perm -700 -exec chmod u+rwx {} \;; \ - fi; \ - cp -fpR $$d/$$file "$(distdir)$$dir" || exit 1; \ - else \ - test -f "$(distdir)/$$file" \ - || cp -p $$d/$$file "$(distdir)/$$file" \ - || exit 1; \ - fi; \ - done -check-am: all-am -check: check-am -all-am: Makefile $(LIBRARIES) $(HEADERS) -installdirs: -install: install-am -install-exec: install-exec-am -install-data: install-data-am -uninstall: uninstall-am - -install-am: all-am - @$(MAKE) $(AM_MAKEFLAGS) install-exec-am install-data-am - -installcheck: installcheck-am -install-strip: - if test -z '$(STRIP)'; then \ - $(MAKE) $(AM_MAKEFLAGS) INSTALL_PROGRAM="$(INSTALL_STRIP_PROGRAM)" \ - install_sh_PROGRAM="$(INSTALL_STRIP_PROGRAM)" INSTALL_STRIP_FLAG=-s \ - install; \ - else \ - $(MAKE) $(AM_MAKEFLAGS) INSTALL_PROGRAM="$(INSTALL_STRIP_PROGRAM)" \ - install_sh_PROGRAM="$(INSTALL_STRIP_PROGRAM)" INSTALL_STRIP_FLAG=-s \ - "INSTALL_PROGRAM_ENV=STRIPPROG='$(STRIP)'" install; \ - fi -mostlyclean-generic: - -clean-generic: - -distclean-generic: - -test -z "$(CONFIG_CLEAN_FILES)" || rm -f $(CONFIG_CLEAN_FILES) - -test . = "$(srcdir)" || test -z "$(CONFIG_CLEAN_VPATH_FILES)" || rm -f $(CONFIG_CLEAN_VPATH_FILES) - -maintainer-clean-generic: - @echo "This command is intended for maintainers to use" - @echo "it deletes files that may require special tools to rebuild." -clean: clean-am - -clean-am: clean-generic clean-libtool clean-noinstLIBRARIES \ - mostlyclean-am - -distclean: distclean-am - -rm -rf ./$(DEPDIR) - -rm -f Makefile -distclean-am: clean-am distclean-compile distclean-generic \ - distclean-tags - -dvi: dvi-am - -dvi-am: - -html: html-am - -html-am: - -info: info-am - -info-am: - -install-data-am: - -install-dvi: install-dvi-am - -install-dvi-am: - -install-exec-am: - -install-html: install-html-am - -install-html-am: - -install-info: install-info-am - -install-info-am: - -install-man: - -install-pdf: install-pdf-am - -install-pdf-am: - -install-ps: install-ps-am - -install-ps-am: - -installcheck-am: - -maintainer-clean: maintainer-clean-am - -rm -rf ./$(DEPDIR) - -rm -f Makefile -maintainer-clean-am: distclean-am maintainer-clean-generic - -mostlyclean: mostlyclean-am - -mostlyclean-am: mostlyclean-compile mostlyclean-generic \ - mostlyclean-libtool - -pdf: pdf-am - -pdf-am: - -ps: ps-am - -ps-am: - -uninstall-am: - -.MAKE: install-am install-strip - -.PHONY: CTAGS GTAGS TAGS all all-am check check-am clean clean-generic \ - clean-libtool clean-noinstLIBRARIES cscopelist-am ctags \ - ctags-am distclean distclean-compile distclean-generic \ - distclean-libtool distclean-tags distdir dvi dvi-am html \ - html-am info info-am install install-am install-data \ - install-data-am install-dvi install-dvi-am install-exec \ - install-exec-am install-html install-html-am install-info \ - install-info-am install-man install-pdf install-pdf-am \ - install-ps install-ps-am install-strip installcheck \ - installcheck-am installdirs maintainer-clean \ - maintainer-clean-generic mostlyclean mostlyclean-compile \ - mostlyclean-generic mostlyclean-libtool pdf pdf-am ps ps-am \ - tags tags-am uninstall uninstall-am - -.PRECIOUS: Makefile - - -# Tell versions [3.59,3.63) of GNU make to not export all variables. -# Otherwise a system limit (for SysV at least) may be exceeded. -.NOEXPORT: diff -Nru gnucobol-4.0~early~20200606/libcob/call.c gnucobol-5/libcob/call.c --- gnucobol-4.0~early~20200606/libcob/call.c 2020-06-06 20:52:01.000000000 +0000 +++ gnucobol-5/libcob/call.c 1970-01-01 00:00:00.000000000 +0000 @@ -1,2050 +0,0 @@ -/* - Copyright (C) 2003-2012, 2014-2019 Free Software Foundation, Inc. - Written by Keisuke Nishida, Roger While, Simon Sobisch, Ron Norman - - This file is part of GnuCOBOL. - - The GnuCOBOL runtime library is free software: you can redistribute it - and/or modify it under the terms of the GNU Lesser General Public License - as published by the Free Software Foundation, either version 3 of the - License, or (at your option) any later version. - - GnuCOBOL is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU Lesser General Public License for more details. - - You should have received a copy of the GNU Lesser General Public License - along with GnuCOBOL. If not, see . -*/ - - -#include -#include - -#ifndef _GNU_SOURCE -#define _GNU_SOURCE 1 -#endif - -#include -#include -#include -#include -#include -#include -#include -#include -#include -#ifdef HAVE_UNISTD_H -#include -#endif - -/* NOTE - The following variable should be uncommented when - it is known that dlopen(NULL) is borked. - This is known to be true for some PA-RISC HP-UX 11.11 systems. - This is fixed with HP patch PHSS_28871. (There are newer but this - fixes dlopen/dlsym problems) -*/ -/* #define COB_BORKED_DLOPEN */ - -#ifdef _WIN32 - -#define WIN32_LEAN_AND_MEAN -#include - -static HMODULE -lt_dlopen (const char *x) -{ - if (x == NULL) { - return GetModuleHandle (NULL); - } - return LoadLibrary(x); -} - -static void * -lt_dlsym (HMODULE hmod, const char *p) -{ - union { - FARPROC modaddr; - void *voidptr; - } modun; - - modun.modaddr = GetProcAddress(hmod, p); - return modun.voidptr; -} - -#define lt_dlopenlcl(x) lt_dlopen(x) -#define lt_dlclose(x) FreeLibrary(x) -#define lt_dlinit() -#define lt_dlexit() -#define lt_dlhandle HMODULE - -#if 0 /* RXWRXW - dlerror */ -static char errbuf[64]; -static char * -lt_dlerror (void) -{ - sprintf(errbuf, _("LoadLibrary/GetProcAddress error %d"), (int)GetLastError()); - return errbuf; -} -#endif - -#elif defined(USE_LIBDL) - -#include - -#define lt_dlopen(x) dlopen(x, RTLD_LAZY | RTLD_GLOBAL) -#define lt_dlopenlcl(x) dlopen(x, RTLD_LAZY | RTLD_LOCAL) -#define lt_dlsym(x,y) dlsym(x, y) -#define lt_dlclose(x) dlclose(x) -#define lt_dlerror() dlerror() -#define lt_dlinit() -#define lt_dlexit() -#define lt_dlhandle void * - -#else - -#include -#define lt_dlopenlcl(x) lt_dlopen(x) - -#endif - -#include "sysdefines.h" - -/* Force symbol exports */ -#define COB_LIB_EXPIMP -#include "libcob.h" -#include "coblocal.h" - -#define COB_MAX_COBCALL_PARMS 16 -#define CALL_BUFF_SIZE 256U -#define CALL_BUFF_MAX (CALL_BUFF_SIZE - 1U) - -#define HASH_SIZE 131U - -/* Call table */ -#if 0 /* Alternative hash structure */ -#define COB_ALT_HASH -#endif - -struct call_hash { - struct call_hash *next; /* Linked list next pointer */ - const char *name; /* Original called name */ - void *func; /* Function address */ - cob_module *module; /* Program module structure */ - lt_dlhandle handle; /* Handle to loaded module */ - const char *path; /* Full path of module */ - unsigned int no_phys_cancel; /* No physical cancel */ -}; - -struct struct_handle { - struct struct_handle *next; /* Linked list next pointer */ - const char *path; /* Path of module */ - lt_dlhandle handle; /* Handle to loaded module */ -}; - -struct system_table { - const char *syst_name; - cob_call_union syst_call; -}; - -/* Local variables */ - -#ifdef COB_ALT_HASH -static struct call_hash *call_table; -#else -static struct call_hash **call_table; -#endif - -static struct struct_handle *base_preload_ptr; -static struct struct_handle *base_dynload_ptr; - -static cob_global *cobglobptr = NULL; -static cob_settings *cobsetptr = NULL; - -static char **resolve_path; -static char *resolve_error; -static char *resolve_alloc; -static char *resolve_error_buff; -static void *call_buffer; -static char *call_filename_buff; - -#ifndef COB_BORKED_DLOPEN -static lt_dlhandle mainhandle; -#endif - -static size_t call_lastsize; -static size_t resolve_size = 0; -static unsigned int cob_jmp_primed; -static cob_field_attr const_binll_attr = - {COB_TYPE_NUMERIC_BINARY, 18, 0, COB_FLAG_HAVE_SIGN, NULL}; -static cob_field_attr const_binull_attr = - {COB_TYPE_NUMERIC_BINARY, 18, 0, 0, NULL}; - -#undef COB_SYSTEM_GEN -#define COB_SYSTEM_GEN(cob_name, pmin, pmax, c_name) \ - { cob_name, {(void *(*)(void *))c_name} }, - -static const struct system_table system_tab[] = { -#include "system.def" - { NULL, {NULL} } -}; -#undef COB_SYSTEM_GEN - -static const unsigned char hexval[] = "0123456789ABCDEF"; - -#ifdef HAVE_DESIGNATED_INITS -static const unsigned char valid_char[256] = { - ['0'] = 1, - ['1'] = 1, - ['2'] = 1, - ['3'] = 1, - ['4'] = 1, - ['5'] = 1, - ['6'] = 1, - ['7'] = 1, - ['8'] = 1, - ['9'] = 1, - ['A'] = 1, - ['B'] = 1, - ['C'] = 1, - ['D'] = 1, - ['E'] = 1, - ['F'] = 1, - ['G'] = 1, - ['H'] = 1, - ['I'] = 1, - ['J'] = 1, - ['K'] = 1, - ['L'] = 1, - ['M'] = 1, - ['N'] = 1, - ['O'] = 1, - ['P'] = 1, - ['Q'] = 1, - ['R'] = 1, - ['S'] = 1, - ['T'] = 1, - ['U'] = 1, - ['V'] = 1, - ['W'] = 1, - ['X'] = 1, - ['Y'] = 1, - ['Z'] = 1, - ['_'] = 1, - ['a'] = 1, - ['b'] = 1, - ['c'] = 1, - ['d'] = 1, - ['e'] = 1, - ['f'] = 1, - ['g'] = 1, - ['h'] = 1, - ['i'] = 1, - ['j'] = 1, - ['k'] = 1, - ['l'] = 1, - ['m'] = 1, - ['n'] = 1, - ['o'] = 1, - ['p'] = 1, - ['q'] = 1, - ['r'] = 1, - ['s'] = 1, - ['t'] = 1, - ['u'] = 1, - ['v'] = 1, - ['w'] = 1, - ['x'] = 1, - ['y'] = 1, - ['z'] = 1 -}; -#else -static int init_valid_char = 1; -static unsigned char valid_char[256]; -static const unsigned char pvalid_char[] = - "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ_abcdefghijklmnopqrstuvwxyz"; -#endif - -/* Local functions */ - -static void -set_resolve_error (void) -{ - resolve_error = resolve_error_buff; - cob_set_exception (COB_EC_PROGRAM_NOT_FOUND); -} - -static void -cob_set_library_path (const char *path) -{ - char *p; - char *pstr; - size_t i; - size_t size; - struct stat st; - - int flag; - - /* Clear the previous path */ - if (resolve_path) { - cob_free (resolve_path); - cob_free (resolve_alloc); - } - - /* Count the number of separators */ - i = 1; - size = 0; - for (p = (char *)path; *p; p++, size++) { - if (*p == PATHSEP_CHAR) { - i++; - } - } - - /* Build path array */ - size++; - resolve_alloc = cob_malloc (size); - pstr = resolve_alloc; - for (p = (char *)path; *p; p++, pstr++) { -#ifdef _WIN32 - if (*p == (unsigned char)'/') { - *pstr = (unsigned char)'\\'; - continue; - } -#else - if (*p == (unsigned char)'\\') { - *pstr = (unsigned char)'/'; - continue; - } -#endif - *pstr = *p; - } - - resolve_path = cob_malloc (sizeof (char *) * i); - resolve_size = 0; - pstr = resolve_alloc; - for (; ; ) { - p = strtok (pstr, PATHSEP_STR); - if (!p) { - break; - } - pstr = NULL; - if (stat (p, &st) || !(S_ISDIR (st.st_mode))) { - continue; - } - - /* - * look if we already have this path - */ - flag = 0; - for (i = 0; i < resolve_size; i++) { - if(strcmp(resolve_path[i], p) == 0) { - flag = 1; - break; - } - } - - if (!flag) { - resolve_path[resolve_size++] = p; - } - } -} - -static void -do_cancel_module (struct call_hash *p, struct call_hash **base_hash, - struct call_hash *prev) -{ - struct struct_handle *dynptr; - int (*cancel_func)(const int, void *, void *, void *, void *); - int nocancel; - nocancel = 0; - - if (!p->module) { - return; - } - if (!p->module->module_cancel.funcvoid) { - return; - } - if (p->module->flag_no_phys_canc) { - nocancel = 1; - } - /* This should be impossible */ - /* LCOV_EXCL_START */ - if (p->module->module_active) { - nocancel = 1; - } - /* LCOV_EXCL_STOP */ - if (p->module->module_ref_count && - *(p->module->module_ref_count)) { - nocancel = 1; - } -#ifdef _MSC_VER -#pragma warning(suppress: 4113) /* funcint is a generic function prototype */ - cancel_func = p->module->module_cancel.funcint; -#else - cancel_func = p->module->module_cancel.funcint; -#endif - (void)cancel_func (-1, NULL, NULL, NULL, NULL); - p->module = NULL; - - if (nocancel) { - return; - } - if (!cobsetptr->cob_physical_cancel) { - return; - } - if (p->no_phys_cancel) { - return; - } - if (!p->handle) { - return; - } - - lt_dlclose (p->handle); - - dynptr = base_dynload_ptr; - for (; dynptr; dynptr = dynptr->next) { - if (dynptr->handle == p->handle) { - dynptr->handle = NULL; - } - } - - if (!prev) { - *base_hash = p->next; - } else { - prev->next = p->next; - } - if (p->name) { - cob_free ((void *)(p->name)); - } - if (p->path) { - cob_free ((void *)(p->path)); - } - cob_free (p); -} - -static void * -cob_get_buff (const size_t buffsize) -{ - if (buffsize > call_lastsize) { - call_lastsize = buffsize; - cob_free (call_buffer); - call_buffer = cob_fast_malloc (buffsize); - } - return call_buffer; -} - -static void -cache_dynload (const char *path, lt_dlhandle handle) -{ - struct struct_handle *dynptr; - - for (dynptr = base_dynload_ptr; dynptr; dynptr = dynptr->next) { - if (!strcmp (path, dynptr->path)) { - if (!dynptr->handle) { - dynptr->handle = handle; - return; - } - } - } - dynptr = cob_malloc (sizeof (struct struct_handle)); - dynptr->path = cob_strdup (path); - dynptr->handle = handle; - dynptr->next = base_dynload_ptr; - base_dynload_ptr = dynptr; -} - -static size_t -cache_preload (const char *path) -{ - struct struct_handle *preptr; - lt_dlhandle libhandle; -#if defined(_WIN32) || defined(__CYGWIN__) - struct struct_handle *last_elem = NULL; -#endif - - /* Check for duplicate */ - for (preptr = base_preload_ptr; preptr; preptr = preptr->next) { - if (!strcmp (path, preptr->path)) { - return 1; - } -#if defined(_WIN32) || defined(__CYGWIN__) - /* Save last element of preload list */ - if (!preptr->next) last_elem = preptr; -#endif - } - - if (access (path, R_OK) != 0) { - return 0; - } - - libhandle = lt_dlopen (path); - if (!libhandle) { - return 0; - } - - preptr = cob_malloc (sizeof (struct struct_handle)); - preptr->path = cob_strdup (path); - preptr->handle = libhandle; - -#if defined(_WIN32) || defined(__CYGWIN__) - /* - * Observation: dlopen (POSIX) and lt_dlopen (UNIX) are overloading - * symbols with equal name. So if we load two libraries with equal - * named symbols, the last one wins and is loaded. - * LoadLibrary (Win32) ignores any equal named symbol - * if another library with this symbol was already loaded. - * - * In Windows (including MinGW/CYGWIN) we need to load modules - * in the same order as we save them to COB_PRE_LOAD due to issues - * if we have got two modules with equal entry points. - */ - if (last_elem) { - last_elem->next = preptr; - } else { - preptr->next = NULL; - base_preload_ptr = preptr; - } -#else - preptr->next = base_preload_ptr; - base_preload_ptr = preptr; -#endif - - - if (!cobsetptr->cob_preload_str) { - cobsetptr->cob_preload_str = cob_strdup(path); - } else { - cobsetptr->cob_preload_str = cob_strcat((char*) PATHSEP_STR, cobsetptr->cob_preload_str, 2); - cobsetptr->cob_preload_str = cob_strcat((char*) path, cobsetptr->cob_preload_str, 2); - } - - return 1; -} - -#ifndef COB_ALT_HASH -static COB_INLINE unsigned int -hash (const unsigned char *s) -{ - unsigned int val = 0; - - while (*s) { - val += *s++; - } - return val % HASH_SIZE; -} -#endif - -static void -insert (const char *name, void *func, lt_dlhandle handle, - cob_module *module, const char *path, - const unsigned int nocanc) -{ - struct call_hash *p; -#ifndef COB_ALT_HASH - unsigned int val; -#endif - - p = cob_malloc (sizeof (struct call_hash)); - p->name = cob_strdup (name); - p->func = func; - p->handle = handle; - p->module = module; - if (path) { -#ifdef _WIN32 - /* Malloced path or NULL */ - p->path = _fullpath (NULL, path, 1); -#elif defined(HAVE_CANONICALIZE_FILE_NAME) - /* Malloced path or NULL */ - p->path = canonicalize_file_name (path); -#elif defined(HAVE_REALPATH) - char *s; - - s = cob_malloc ((size_t)COB_NORMAL_BUFF); - if (realpath (path, s) != NULL) { - p->path = cob_strdup (s); - } - cob_free (s); -#endif - if (!p->path) { - p->path = cob_strdup (path); - } - } - p->no_phys_cancel = nocanc; -#ifdef COB_ALT_HASH - p->next = call_table; - call_table = p; -#else - val = hash ((const unsigned char *)name); - p->next = call_table[val]; - call_table[val] = p; -#endif -} - -static void * -lookup (const char *name) -{ - struct call_hash *p; - -#ifdef COB_ALT_HASH - p = call_table; -#else - p = call_table[hash ((const unsigned char *)name)]; -#endif - for (; p; p = p->next) { - if (strcmp (name, p->name) == 0) { - return p->func; - } - } - return NULL; -} - -static int -cob_encode_invalid_chars (const unsigned char* const name, - unsigned char* const name_buff, - const int buff_size, int *external_pos) -{ - const unsigned char *s = name; - int pos = *external_pos; - -#ifndef HAVE_DESIGNATED_INITS - if (init_valid_char) { - const unsigned char *pv; - init_valid_char = 0; - memset (valid_char, 0, sizeof(valid_char)); - for (pv = pvalid_char; *pv; ++pv) { - valid_char[*pv] = 1; - } - } -#endif - - /* Encode invalid letters */ - for (; *s; ++s) { - if (pos >= buff_size - 3) { - name_buff[pos] = 0; - return -pos; - } - if (likely (valid_char[*s])) { - name_buff[pos++] = *s; - } else { - name_buff[pos++] = (unsigned char)'_'; - if (*s == (unsigned char)'-') { - name_buff[pos++] = (unsigned char)'_'; - } else { - name_buff[pos++] = hexval[*s / 16U]; - name_buff[pos++] = hexval[*s % 16U]; - } - } - } - - *external_pos = pos; - return pos; -} - -/** encode given name - \param name to encode - \param name_buff to place the encoded name to - \param buff_size available - \param fold_case may be COB_FOLD_UPPER or COB_FOLD_LOWER - \return size of the encoded name, negative if the buffer size would be exceeded - */ -int -cob_encode_program_id (const unsigned char *const name, - unsigned char *const name_buff, - const int buff_size, const int fold_case) -{ - int pos = 0; - /* Encode the initial digit */ - if (unlikely (*name <= (unsigned char)'9' && *name >= (unsigned char)'0')) { - name_buff[pos++] = (unsigned char)'_'; - } - /* Encode invalid letters */ - cob_encode_invalid_chars (name, name_buff, buff_size, &pos); - - name_buff[pos] = 0; - - /* Check case folding */ - switch (fold_case) { - case COB_FOLD_NONE: - break; - case COB_FOLD_UPPER: - { - unsigned char *p = name_buff; - for (p = name_buff; *p; p++) { - if (islower (*p)) { - *p = (cob_u8_t)toupper (*p); - } - } - break; - } - case COB_FOLD_LOWER: - { - unsigned char *p = name_buff; - for (p = name_buff; *p; p++) { - if (isupper (*p)) { - *p = (cob_u8_t)tolower (*p); - } - } - break; - } - default: - break; - } - - return pos; -} - -static void * -cob_resolve_internal (const char *name, const char *dirent, - const int fold_case) -{ - unsigned char *p; - const unsigned char *s; - void *func; - struct struct_handle *preptr; - lt_dlhandle handle; - size_t i; - char call_entry_buff[COB_MINI_BUFF]; - char call_entry2_buff[COB_MINI_BUFF]; - - /* LCOV_EXCL_START */ - if (unlikely(!cobglobptr)) { - cob_fatal_error (COB_FERROR_INITIALIZED); - } - /* LCOV_EXCL_STOP */ - cobglobptr->cob_exception_code = 0; - - /* Search the cache */ - func = lookup (name); - if (func) { - return func; - } - - s = (const unsigned char *)name; - - /* Encode program name, including case folding */ - cob_encode_program_id (s, (unsigned char *)call_entry_buff, - COB_MINI_MAX, fold_case); - -#ifndef COB_BORKED_DLOPEN - /* Search the main program */ - if (mainhandle != NULL) { - func = lt_dlsym (mainhandle, call_entry_buff); - if (func != NULL) { - insert (name, func, mainhandle, NULL, NULL, 1); - resolve_error = NULL; - return func; - } - } -#endif - - /* Search preloaded modules */ - for (preptr = base_preload_ptr; preptr; preptr = preptr->next) { - func = lt_dlsym (preptr->handle, call_entry_buff); - if (func != NULL) { - insert (name, func, preptr->handle, NULL, preptr->path, 1); - resolve_error = NULL; - return func; - } - } - - /* Search dynamic modules */ - for (preptr = base_dynload_ptr; preptr; preptr = preptr->next) { - if (!preptr->handle) { - continue; - } - func = lt_dlsym (preptr->handle, call_entry_buff); - if (func != NULL) { - insert (name, func, preptr->handle, - NULL, preptr->path, 1); - resolve_error = NULL; - return func; - } - } - -#if 0 /* RXWRXW RTLD */ -#if defined(USE_LIBDL) && defined (RTLD_DEFAULT) - func = lt_dlsym (RTLD_DEFAULT, call_entry_buff); - if (func != NULL) { - insert (name, func, NULL, NULL, NULL, 1); - resolve_error = NULL; - return func; - } -#endif -#endif - - s = (const unsigned char *)name; - - /* Check if name needs conversion */ - if (unlikely(cobsetptr->name_convert != 0)) { - p = (unsigned char *)call_entry2_buff; - for (; *s; ++s, ++p) { - if (cobsetptr->name_convert == 1 && isupper (*s)) { - *p = (cob_u8_t) tolower (*s); - } else if (cobsetptr->name_convert == 2 && islower (*s)) { - *p = (cob_u8_t) toupper (*s); - } else { - *p = *s; - } - } - *p = 0; - s = (const unsigned char *)call_entry2_buff; - } - - /* Search external modules */ - resolve_error_buff[CALL_BUFF_MAX] = 0; -#ifdef __OS400__ - strcpy (call_filename_buff, s); - for (p = call_filename_buff; *p; ++p) { - *p = (cob_u8_t)toupper(*p); - } - handle = lt_dlopen (call_filename_buff); - if (handle != NULL) { - /* Candidate for future calls */ - cache_dynload (call_filename_buff, handle); - func = lt_dlsym (handle, call_entry_buff); - if (func != NULL) { - insert (name, func, handle, NULL, call_filename_buff, 0); - resolve_error = NULL; - return func; - } - } -#else - if (dirent) { - snprintf (call_filename_buff, (size_t)COB_NORMAL_MAX, - "%s%s.%s", dirent, (char *)s, COB_MODULE_EXT); - call_filename_buff[COB_NORMAL_MAX] = 0; - if (access (call_filename_buff, R_OK) != 0) { - snprintf (resolve_error_buff, (size_t)CALL_BUFF_MAX, - "module '%s' not found", name); - set_resolve_error (); - return NULL; - } - handle = lt_dlopen (call_filename_buff); - if (handle != NULL) { - /* Candidate for future calls */ - cache_dynload (call_filename_buff, handle); - func = lt_dlsym (handle, call_entry_buff); - if (func != NULL) { - insert (name, func, handle, NULL, - call_filename_buff, 0); - resolve_error = NULL; - return func; - } - } - snprintf (resolve_error_buff, (size_t)CALL_BUFF_MAX, - "entry point '%s' not found", (const char *)s); - set_resolve_error (); - return NULL; - } - for (i = 0; i < resolve_size; ++i) { - call_filename_buff[COB_NORMAL_MAX] = 0; - if (resolve_path[i] == NULL) { - snprintf (call_filename_buff, (size_t)COB_NORMAL_MAX, - "%s.%s", (char *)s, COB_MODULE_EXT); - } else { - snprintf (call_filename_buff, (size_t)COB_NORMAL_MAX, - "%s%c%s.%s", resolve_path[i], - SLASH_CHAR, (char *)s, COB_MODULE_EXT); - } - call_filename_buff[COB_NORMAL_MAX] = 0; - if (access (call_filename_buff, R_OK) == 0) { - handle = lt_dlopen (call_filename_buff); - if (handle != NULL) { - /* Candidate for future calls */ - cache_dynload (call_filename_buff, handle); - func = lt_dlsym (handle, call_entry_buff); - if (func != NULL) { - insert (name, func, handle, NULL, - call_filename_buff, 0); - resolve_error = NULL; - return func; - } - } - snprintf (resolve_error_buff, (size_t)CALL_BUFF_MAX, - "entry point '%s' not found", (const char *)s); - set_resolve_error (); - return NULL; - } - } -#endif - snprintf (resolve_error_buff, (size_t)CALL_BUFF_MAX, - "module '%s' not found", name); - set_resolve_error (); - return NULL; -} - -static const char * -cob_chk_dirp (const char *name) -{ - const char *p; - const char *q; - - q = NULL; - for (p = name; *p; p++) { - if (*p == '/' || *p == '\\') { - q = p + 1; - } - } - if (q) { - return q; - } - return name; -} - -static char * -cob_chk_call_path (const char *name, char **dirent) -{ - char *p; - char *q; - size_t size1; - size_t size2; - - *dirent = NULL; - q = NULL; - size2 = 0; - for (p = (char *)name, size1 = 0; *p; p++, size1++) { - if (*p == '/' || *p == '\\') { - q = p + 1; - size2 = size1 + 1; - } - } - if (q) { - p = cob_strdup (name); - p[size2] = 0; - *dirent = p; - for (; *p; p++) { -#ifdef _WIN32 - if (*p == '/') { - *p = '\\'; - } -#else - if (*p == '\\') { - *p = '/'; - } -#endif - } - return q; - } - return (char *)name; -} - -/* Global functions */ - -const char * -cob_resolve_error (void) -{ - const char *p; - - if (!resolve_error) { - p = _("indeterminable error in resolve of COBOL CALL"); - } else { - p = resolve_error; - resolve_error = NULL; - } - return p; -} - -void -cob_call_error (void) -{ - cob_runtime_error ("%s", cob_resolve_error ()); - cob_stop_run (1); -} - -void -cob_set_cancel (cob_module *m) -{ - struct call_hash *p; - -#ifdef COB_ALT_HASH - p = call_table; -#else - p = call_table[hash ((const unsigned char *)(m->module_name))]; -#endif - for (; p; p = p->next) { - if (strcmp (m->module_name, p->name) == 0) { - p->module = m; - /* Set path in program module structure */ - if (p->path && m->module_path && !*(m->module_path)) { - *(m->module_path) = p->path; - } - return; - } - } - insert (m->module_name, m->module_entry.funcvoid, NULL, m, NULL, 1); -} - -void * -cob_resolve (const char *name) -{ - void *p; - char *entry; - char *dirent; - - entry = cob_chk_call_path (name, &dirent); - p = cob_resolve_internal (entry, dirent, 0); - if (dirent) { - cob_free (dirent); - } - return p; -} - -void * -cob_resolve_cobol (const char *name, const int fold_case, const int errind) -{ - void *p; - char *entry; - char *dirent; - - cobglobptr->cob_exception_code = 0; - entry = cob_chk_call_path (name, &dirent); - p = cob_resolve_internal (entry, dirent, fold_case); - if (dirent) { - cob_free (dirent); - } - if (unlikely(!p)) { - if (errind) { - cob_call_error (); - } - cob_set_exception (COB_EC_PROGRAM_NOT_FOUND); - } - cobglobptr->cob_call_name_hash = cob_get_name_hash (name); - return p; -} - -void * -cob_resolve_func (const char *name) -{ - void *p; - - p = cob_resolve_internal (name, NULL, 0); - if (unlikely(!p)) { - cob_runtime_error (_("user-defined FUNCTION '%s' not found"), name); - cob_stop_run (1); - } - return p; -} - -/* - * Load library and return address of entry point - */ -void * -cob_load_lib (const char *library, const char *entry) -{ - void *p; - - errno = 0; - p = lt_dlopenlcl (library); - if (p) { - p = lt_dlsym (p, entry); - } - return p; -} - -void * -cob_call_field (const cob_field *f, const struct cob_call_struct *cs, - const unsigned int errind, const int fold_case) -{ - void *p; - const struct cob_call_struct *s; - const struct system_table *psyst; - char *buff; - char *entry; - char *dirent; - size_t len; - - /* LCOV_EXCL_START */ - if (unlikely(!cobglobptr)) { - cob_fatal_error (COB_FERROR_INITIALIZED); - } - /* LCOV_EXCL_STOP */ - - buff = cob_get_buff (f->size + 1); - cob_field_to_string (f, buff, f->size); - - /* check for uncommon leading space - trim it */ - if (*buff == ' ') { - /* same warning as in cobc/typeck.c */ - cob_runtime_warning ( - _("'%s' literal includes leading spaces which are omitted"), buff); - len = strlen (buff); - while (*buff == ' ') { - memmove (buff, buff + 1, --len); - } - buff[len] = 0; - } - - entry = cob_chk_call_path (buff, &dirent); - cobglobptr->cob_call_name_hash = cob_get_name_hash (entry); - - /* Check if system routine */ - for (psyst = system_tab; psyst->syst_name; ++psyst) { - if (!strcmp (entry, psyst->syst_name)) { - if (dirent) { - cob_free (dirent); - } - return psyst->syst_call.funcvoid; - } - } - - - /* Check if contained program */ - for (s = cs; s && s->cob_cstr_name; s++) { - if (!strcmp (entry, s->cob_cstr_name)) { - if (dirent) { - cob_free (dirent); - } - return s->cob_cstr_call.funcvoid; - } - } - - p = cob_resolve_internal (entry, dirent, fold_case); - if (dirent) { - cob_free (dirent); - } - if (unlikely(!p)) { - if (errind) { - cob_call_error (); - } else { - cob_set_exception (COB_EC_PROGRAM_NOT_FOUND); - return NULL; - } - } - return p; -} - -void -cob_cancel (const char *name) -{ - const char *entry; - struct call_hash *p; - struct call_hash **q; - struct call_hash *r; - - /* LCOV_EXCL_START */ - if (unlikely(!cobglobptr)) { - cob_fatal_error (COB_FERROR_INITIALIZED); - } - if (unlikely(!name)) { - cob_runtime_error (_("NULL parameter passed to '%s'"), "cob_cancel"); - cob_stop_run (1); - } - /* LCOV_EXCL_STOP */ - entry = cob_chk_dirp (name); - -#ifdef COB_ALT_HASH - q = &call_table; - p = *q; -#else - q = &call_table[hash ((const unsigned char *)entry)]; - p = *q; -#endif - r = NULL; - for (; p; p = p->next) { - if (strcmp (entry, p->name) == 0) { - do_cancel_module (p, q, r); - return; - } - r = p; - } -} - -void -cob_cancel_field (const cob_field *f, const struct cob_call_struct *cs) -{ - char *name; - const char *entry; - const struct cob_call_struct *s; - - int (*cancel_func)(const int, void *, void *, void *, void *); - - /* LCOV_EXCL_START */ - if (unlikely(!cobglobptr)) { - cob_fatal_error (COB_FERROR_INITIALIZED); - } - /* LCOV_EXCL_STOP */ - if (!f || f->size == 0) { - return; - } - name = cob_get_buff (f->size + 1); - cob_field_to_string (f, name, f->size); - entry = cob_chk_dirp (name); - - /* Check if contained program */ - for (s = cs; s && s->cob_cstr_name; s++) { - if (!strcmp (entry, s->cob_cstr_name)) { - if (s->cob_cstr_cancel.funcvoid) { -#ifdef _MSC_VER -#pragma warning(suppress: 4113) /* funcint is a generic function prototype */ - cancel_func = s->cob_cstr_cancel.funcint; -#else - cancel_func = s->cob_cstr_cancel.funcint; -#endif - (void)cancel_func (-1, NULL, NULL, NULL, - NULL); - } - return; - } - } - cob_cancel (entry); -} - -int -cob_call (const char *name, const int argc, void **argv) -{ - void **pargv; - cob_call_union unifunc; - int i; - - /* LCOV_EXCL_START */ - if (unlikely(!cobglobptr)) { - cob_fatal_error (COB_FERROR_INITIALIZED); - } - if (argc < 0 || argc > MAX_CALL_FIELD_PARAMS) { - cob_runtime_error (_("invalid number of arguments passed to '%s'"), "cob_call"); - cob_stop_run (1); - } - if (unlikely(!name)) { - cob_runtime_error (_("NULL parameter passed to '%s'"), "cob_call"); - cob_stop_run (1); - } - /* LCOV_EXCL_STOP */ - unifunc.funcvoid = cob_resolve_cobol (name, 0, 1); - pargv = cob_malloc (MAX_CALL_FIELD_PARAMS * sizeof(void *)); - /* Set number of parameters */ - cobglobptr->cob_call_params = argc; - cobglobptr->cob_call_from_c = 1; - cobglobptr->cob_call_name_hash = 0; - for (i = 0; i < argc; ++i) { - pargv[i] = argv[i]; - } -#if MAX_CALL_FIELD_PARAMS == 16 || \ - MAX_CALL_FIELD_PARAMS == 36 || \ - MAX_CALL_FIELD_PARAMS == 56 || \ - MAX_CALL_FIELD_PARAMS == 76 || \ - MAX_CALL_FIELD_PARAMS == 96 || \ - MAX_CALL_FIELD_PARAMS == 192 || \ - MAX_CALL_FIELD_PARAMS == 252 -#else -#error "Invalid MAX_CALL_FIELD_PARAMS value" -#endif - i = unifunc.funcint (pargv[0], pargv[1], pargv[2], pargv[3] - ,pargv[4], pargv[5], pargv[6], pargv[7] - ,pargv[8], pargv[9], pargv[10], pargv[11] - ,pargv[12], pargv[13], pargv[14], pargv[15] -#if MAX_CALL_FIELD_PARAMS > 16 - ,pargv[16], pargv[17], pargv[18], pargv[19] - ,pargv[20], pargv[21], pargv[22], pargv[23] - ,pargv[24], pargv[25], pargv[26], pargv[27] - ,pargv[28], pargv[29], pargv[30], pargv[31] - ,pargv[32], pargv[33], pargv[34], pargv[35] -#if MAX_CALL_FIELD_PARAMS > 36 - ,pargv[36], pargv[37], pargv[38], pargv[39] - ,pargv[40], pargv[41], pargv[42], pargv[43] - ,pargv[44], pargv[45], pargv[46], pargv[47] - ,pargv[48], pargv[49], pargv[50], pargv[51] - ,pargv[52], pargv[53], pargv[54], pargv[55] -#if MAX_CALL_FIELD_PARAMS > 56 - ,pargv[56], pargv[57], pargv[58], pargv[59] - ,pargv[60], pargv[61], pargv[62], pargv[63] - ,pargv[64], pargv[65], pargv[66], pargv[67] - ,pargv[68], pargv[69], pargv[70], pargv[71] - ,pargv[72], pargv[73], pargv[74], pargv[75] -#if MAX_CALL_FIELD_PARAMS > 76 - ,pargv[76], pargv[77], pargv[78], pargv[79] - ,pargv[80], pargv[81], pargv[82], pargv[83] - ,pargv[84], pargv[85], pargv[86], pargv[87] - ,pargv[88], pargv[89], pargv[90], pargv[91] - ,pargv[92], pargv[93], pargv[94], pargv[95] -#if MAX_CALL_FIELD_PARAMS > 96 - ,pargv[96], pargv[97], pargv[98], pargv[99] - ,pargv[100], pargv[101], pargv[102], pargv[103] - ,pargv[104], pargv[105], pargv[106], pargv[107] - ,pargv[108], pargv[109], pargv[110], pargv[111] - ,pargv[112], pargv[113], pargv[114], pargv[115] - ,pargv[116], pargv[117], pargv[118], pargv[119] - ,pargv[120], pargv[121], pargv[122], pargv[123] - ,pargv[124], pargv[125], pargv[126], pargv[127] - ,pargv[128], pargv[129], pargv[130], pargv[131] - ,pargv[132], pargv[133], pargv[134], pargv[135] - ,pargv[136], pargv[137], pargv[138], pargv[139] - ,pargv[140], pargv[141], pargv[142], pargv[143] - ,pargv[144], pargv[145], pargv[146], pargv[147] - ,pargv[148], pargv[149], pargv[130], pargv[131] - ,pargv[152], pargv[153], pargv[154], pargv[155] - ,pargv[160], pargv[161], pargv[162], pargv[163] - ,pargv[164], pargv[165], pargv[166], pargv[167] - ,pargv[168], pargv[169], pargv[170], pargv[171] - ,pargv[172], pargv[173], pargv[174], pargv[175] - ,pargv[176], pargv[177], pargv[178], pargv[179] - ,pargv[180], pargv[181], pargv[182], pargv[183] - ,pargv[184], pargv[185], pargv[186], pargv[187] - ,pargv[188], pargv[189], pargv[190], pargv[191] -#if MAX_CALL_FIELD_PARAMS > 192 - ,pargv[192], pargv[193], pargv[194], pargv[195] - ,pargv[200], pargv[201], pargv[202], pargv[203] - ,pargv[204], pargv[205], pargv[206], pargv[207] - ,pargv[208], pargv[209], pargv[210], pargv[211] - ,pargv[212], pargv[213], pargv[214], pargv[215] - ,pargv[216], pargv[217], pargv[218], pargv[219] - ,pargv[220], pargv[221], pargv[222], pargv[223] - ,pargv[224], pargv[225], pargv[226], pargv[227] - ,pargv[228], pargv[229], pargv[230], pargv[231] - ,pargv[232], pargv[233], pargv[234], pargv[235] - ,pargv[240], pargv[241], pargv[242], pargv[243] - ,pargv[244], pargv[245], pargv[246], pargv[247] - ,pargv[248], pargv[249], pargv[250], pargv[251] -#endif -#endif -#endif -#endif -#endif -#endif - ); - cob_free (pargv); - return i; -} - -int -cob_func (const char *name, const int argc, void **argv) -{ - int ret; - - ret = cob_call (name, argc, argv); - cob_cancel (name); - return ret; -} - -void * -cob_savenv (struct cobjmp_buf *jbuf) -{ - /* LCOV_EXCL_START */ - if (unlikely(!cobglobptr)) { - cob_fatal_error (COB_FERROR_INITIALIZED); - } - if (unlikely(!jbuf)) { - cob_runtime_error (_("NULL parameter passed to '%s'"), "cob_savenv"); - cob_stop_run (1); - } - if (cob_jmp_primed) { - cob_runtime_error (_("multiple call to 'cob_setjmp'")); - cob_stop_run (1); - } - /* LCOV_EXCL_STOP */ - cob_jmp_primed = 1; - return jbuf->cbj_jmp_buf; -} - -void * -cob_savenv2 (struct cobjmp_buf *jbuf, const int jsize) -{ - COB_UNUSED (jsize); - - return cob_savenv (jbuf); -} - -void -cob_longjmp (struct cobjmp_buf *jbuf) -{ - /* LCOV_EXCL_START */ - if (unlikely(!cobglobptr)) { - cob_fatal_error (COB_FERROR_INITIALIZED); - } - if (unlikely(!jbuf)) { - cob_runtime_error (_("NULL parameter passed to '%s'"), "cob_longjmp"); - cob_stop_run (1); - } - if (!cob_jmp_primed) { - cob_runtime_error (_("call to 'cob_longjmp' with no prior 'cob_setjmp'")); - cob_stop_run (1); - } - /* LCOV_EXCL_STOP */ - cob_jmp_primed = 0; - longjmp (jbuf->cbj_jmp_buf, 1); -} - -void -cob_exit_call (void) -{ - struct call_hash *p; - struct call_hash *q; - struct struct_handle *h; - struct struct_handle *j; - -#ifndef COB_ALT_HASH - size_t i; -#endif - - if (call_filename_buff) { - cob_free (call_filename_buff); - call_filename_buff = NULL; - } - if (call_buffer) { - cob_free (call_buffer); - call_buffer = NULL; - } - if (resolve_error_buff) { - cob_free (resolve_error_buff); - resolve_error_buff = NULL; - } - if (resolve_alloc) { - cob_free (resolve_alloc); - resolve_alloc = NULL; - } - if (resolve_path) { - cob_free (resolve_path); - resolve_path = NULL; - } - -#ifndef COB_ALT_HASH - if (call_table) { - for (i = 0; i < HASH_SIZE; ++i) { - p = call_table[i]; -#else - p = call_table; -#endif - for (; p;) { - q = p; - p = p->next; - if (q->name) { - cob_free ((void *)q->name); - } - if (q->path) { - cob_free ((void *)q->path); - } - cob_free (q); - } -#ifndef COB_ALT_HASH - } - if (call_table) { - cob_free (call_table); - } - call_table = NULL; - } -#endif - - for (h = base_preload_ptr; h;) { - j = h; - if (h->path) { - cob_free ((void *)h->path); - } - if (h->handle) { - lt_dlclose (h->handle); - } - h = h->next; - cob_free (j); - } - base_preload_ptr = NULL; - for (h = base_dynload_ptr; h;) { - j = h; - if (h->path) { - cob_free ((void *)h->path); - } - if (h->handle) { - lt_dlclose (h->handle); - } - h = h->next; - cob_free (j); - } - base_dynload_ptr = NULL; - -#if !defined(_WIN32) && !defined(USE_LIBDL) - lt_dlexit (); -#if 0 /* RXWRXW - ltdl leak */ -#ifndef COB_BORKED_DLOPEN - /* Weird - ltdl leaks mainhandle - This appears to work but .. */ - if (mainhandle) { - cob_free (mainhandle); - } -#endif -#endif -#endif - -} - -void -cob_init_call (cob_global *lptr, cob_settings* sptr, const int check_mainhandle) -{ - char *buff; - char *s; - char *p; - size_t i; -#ifndef HAVE_DESIGNATED_INITS - const unsigned char *pv; -#endif -#ifdef __OS400__ - char *t; -#endif - - cobglobptr = lptr; - cobsetptr = sptr; - - base_preload_ptr = NULL; - base_dynload_ptr = NULL; - resolve_path = NULL; - resolve_alloc = NULL; - resolve_error = NULL; - call_buffer = NULL; - call_lastsize = 0; - cob_jmp_primed = 0; - -#ifndef HAVE_DESIGNATED_INITS - init_valid_char = 0; - memset (valid_char, 0, sizeof(valid_char)); - for (pv = pvalid_char; *pv; ++pv) { - valid_char[*pv] = 1; - } -#endif - - /* Big enough for anything from libdl/libltdl */ - resolve_error_buff = cob_malloc ((size_t)CALL_BUFF_SIZE); - -#ifndef COB_ALT_HASH - call_table = cob_malloc (sizeof (struct call_hash *) * HASH_SIZE); -#else - call_table = NULL; -#endif - - call_filename_buff = cob_malloc ((size_t)COB_NORMAL_BUFF); - - buff = cob_fast_malloc ((size_t)COB_MEDIUM_BUFF); - if (cobsetptr->cob_library_path == NULL - || strcmp(cobsetptr->cob_library_path, ".") == 0) { - if (strcmp(COB_LIBRARY_PATH, ".") == 0) { - snprintf (buff, (size_t)COB_MEDIUM_MAX, "."); - } else { - snprintf (buff, (size_t)COB_MEDIUM_MAX, ".%c%s", - PATHSEP_CHAR, COB_LIBRARY_PATH); - } - } else { - if (strcmp(COB_LIBRARY_PATH, ".") == 0) { - snprintf (buff, (size_t)COB_MEDIUM_MAX, "%s%c.", - cobsetptr->cob_library_path, PATHSEP_CHAR); - } else { - snprintf (buff, (size_t)COB_MEDIUM_MAX, "%s%c.%c%s", - cobsetptr->cob_library_path, PATHSEP_CHAR, PATHSEP_CHAR, COB_LIBRARY_PATH); - } - } - cob_set_library_path (buff); - - lt_dlinit (); - -#ifndef COB_BORKED_DLOPEN - /* only set main handle if not started by cobcrun as this - saves a check for exported functions in every CALL - */ - if (check_mainhandle) { - mainhandle = lt_dlopen (NULL); - } else { - mainhandle = NULL; - } -#endif - - if (cobsetptr->cob_preload_str != NULL - && resolve_path != NULL) { - - p = cob_strdup (cobsetptr->cob_preload_str); - - cob_free (cobsetptr->cob_preload_str); - cobsetptr->cob_preload_str = NULL; - - s = strtok (p, PATHSEP_STR); - for (; s; s = strtok (NULL, PATHSEP_STR)) { -#ifdef __OS400__ - for (t = s; *t; ++t) { - *t = toupper (*t); - } - cache_preload (t); -#else - for (i = 0; i < resolve_size; ++i) { - buff[COB_MEDIUM_MAX] = 0; - snprintf (buff, (size_t)COB_MEDIUM_MAX, - "%s%c%s.%s", - resolve_path[i], SLASH_CHAR, s, COB_MODULE_EXT); - if (cache_preload (buff)) { - break; - } - } - /* If not found, try just using the name */ - if (i == resolve_size) { - (void)cache_preload (s); - } -#endif - } - cob_free (p); - } - cob_free (buff); - call_buffer = cob_fast_malloc ((size_t)CALL_BUFF_SIZE); - call_lastsize = CALL_BUFF_SIZE; -} - -/****************************************** - * Routines for C interface with COBOL - */ - -static cob_field * -cob_get_param_field (int n, const char *caller_name) -{ - if (cobglobptr == NULL - || COB_MODULE_PTR == NULL) { - /* note: same message in call.c */ - cob_runtime_warning_external (caller_name, 1, - _("cob_init() has not been called")); - return NULL; - } - if (n < 1 - || n > cobglobptr->cob_call_params) { - cob_runtime_warning_external (caller_name, 1, - _("parameter %d is not within range of %d"), - n, cobglobptr->cob_call_params); - return NULL; - } - if (COB_MODULE_PTR->cob_procedure_params[n - 1] == NULL) { - cob_runtime_warning_external (caller_name, 1, - _("parameter %d is NULL"), n); - return NULL; - } - return COB_MODULE_PTR->cob_procedure_params[n - 1]; -} - -int -cob_get_name_line ( char *prog, int *line ) -{ - int k; - if (line != NULL) - *line = COB_GET_LINE_NUM(COB_MODULE_PTR->module_stmt); - if (prog != NULL) { - strcpy(prog, COB_MODULE_PTR->module_name); - for (k=strlen(prog); k > 0 && prog[k-1] == ' '; k--) - prog[k-1] = 0; - } - return COB_GET_LINE_NUM(COB_MODULE_PTR->module_stmt); -} - -int -cob_get_num_params ( void ) -{ - if (cobglobptr) { - return cobglobptr->cob_call_params; - } - - /* note: same message in call.c */ - cob_runtime_warning_external ("cob_get_num_params", 1, - _("cob_init() has not been called")); - return -1; -} - -void -cob_set_num_params ( int n ) -{ - if (cobglobptr) { - cobglobptr->cob_call_params = n; - return; - } - /* note: same message in call.c */ - cob_runtime_warning_external ("cob_set_num_params", 1, - _("cob_init() has not been called")); - return; -} - -int -cob_get_param_type (int n) -{ - cob_field *f = cob_get_param_field (n, "cob_get_param_type"); - - if (f == NULL) - return -1; - if (f->attr->type == COB_TYPE_NUMERIC_BINARY) { - if (COB_FIELD_REAL_BINARY (f)) { - return COB_TYPE_NUMERIC_COMP5; - } -#ifndef WORDS_BIGENDIAN - if (!COB_FIELD_BINARY_SWAP(f)) { - return COB_TYPE_NUMERIC_COMP5; - } -#endif - } - return (int)f->attr->type; -} - -int -cob_get_param_size (int n) -{ - cob_field *f = cob_get_param_field (n, "cob_get_param_size"); - - if (f == NULL) - return -1; - return (int)f->size; -} - -int -cob_get_param_sign (int n) -{ - cob_field *f = cob_get_param_field (n, "cob_get_param_sign"); - if (f == NULL) - return -1; - if (COB_FIELD_HAVE_SIGN(f)) { - return 1; - } - return 0; -} - -int -cob_get_param_scale (int n) -{ - cob_field *f = cob_get_param_field (n, "cob_get_param_scale"); - if (f == NULL) - return -1; - return (int)f->attr->scale; -} - -int -cob_get_param_digits (int n) -{ - cob_field *f = cob_get_param_field (n, "cob_get_param_digits"); - if (f == NULL) - return -1; - return (int)f->attr->digits; -} - -int -cob_get_param_constant (int n) -{ - cob_field *f = cob_get_param_field (n, "cob_get_param_constant"); - if (f == NULL) - return -1; - if (COB_FIELD_CONTENT(f)) - return 3; - if (COB_FIELD_VALUE(f)) - return 2; - if (COB_FIELD_CONSTANT(f)) - return 1; - return 0; -} - -void * -cob_get_param_data (int n) -{ - cob_field *f = cob_get_param_field (n, "cob_get_param_data"); - if (f == NULL) { - return NULL; - } - return (void*)f->data; -} - -cob_s64_t -cob_get_s64_param (int n) -{ - void *cbl_data; - int size; - cob_s64_t val; - double dbl; - cob_field temp; - cob_field *f = cob_get_param_field (n, "cob_get_s64_param"); - - if (f == NULL) { - return -1; - } - cbl_data = f->data; - size = f->size; - - switch (f->attr->type) { - case COB_TYPE_NUMERIC_DISPLAY: - return cob_get_s64_pic9 (cbl_data, size); - case COB_TYPE_NUMERIC_BINARY: -#ifndef WORDS_BIGENDIAN - if (!COB_FIELD_BINARY_SWAP (f)) { - return cob_get_s64_comp5 (cbl_data, size); - } -#endif - return cob_get_s64_compx (cbl_data, size); - case COB_TYPE_NUMERIC_PACKED: - return cob_get_s64_comp3 (cbl_data, size); - case COB_TYPE_NUMERIC_FLOAT: - dbl = cob_get_comp1 (cbl_data); - val = (cob_s64_t)dbl; /* possible data loss is explicit requested */ - return val; - case COB_TYPE_NUMERIC_DOUBLE: - dbl = cob_get_comp2 (cbl_data); - val = (cob_s64_t)dbl; /* possible data loss is explicit requested */ - return val; - case COB_TYPE_NUMERIC_EDITED: - return cob_get_s64_pic9 (cbl_data, size); - default: - temp.size = 8; - temp.data = (unsigned char *)&val; - temp.attr = &const_binll_attr; - const_binll_attr.scale = f->attr->scale; - cob_move (f, &temp); - return val; - } -} - -cob_u64_t -cob_get_u64_param (int n) -{ - void *cbl_data; - int size; - cob_u64_t val; - double dbl; - cob_field temp; - cob_field *f = cob_get_param_field (n, "cob_get_u64_param"); - - if (f == NULL) { - return 0; - } - - cbl_data = f->data; - size = f->size; - switch (COB_MODULE_PTR->cob_procedure_params[n - 1]->attr->type) { - case COB_TYPE_NUMERIC_DISPLAY: - return cob_get_u64_pic9 (cbl_data, size); - case COB_TYPE_NUMERIC_BINARY: -#ifndef WORDS_BIGENDIAN - if (!COB_FIELD_BINARY_SWAP (f)) { - return cob_get_u64_comp5 (cbl_data, size); - } -#endif - return cob_get_u64_compx (cbl_data, size); - case COB_TYPE_NUMERIC_PACKED: - return cob_get_u64_comp3 (cbl_data, size); - case COB_TYPE_NUMERIC_FLOAT: - dbl = cob_get_comp1 (cbl_data); - val = (cob_u64_t)dbl; /* possible data loss is explicit requested */ - return val; - case COB_TYPE_NUMERIC_DOUBLE: - dbl = cob_get_comp2 (cbl_data); - val = (cob_u64_t)dbl; /* possible data loss is explicit requested */ - return val; - case COB_TYPE_NUMERIC_EDITED: - return cob_get_u64_pic9 (cbl_data, size); - default: - temp.size = 8; - temp.data = (unsigned char *)&val; - temp.attr = &const_binull_attr; - const_binull_attr.scale = f->attr->scale; - cob_move (f, &temp); - return val; - } -} - -char * -cob_get_picx_param (int n, void *char_field, size_t char_len) -{ - cob_field *f = cob_get_param_field (n, "cob_get_picx_param"); - if (f == NULL) { - return NULL; - } - return cob_get_picx (f->data, f->size, char_field, char_len); -} - -void -cob_put_s64_param (int n, cob_s64_t val) -{ - void *cbl_data; - int size; - float flt; - double dbl; - cob_field temp; - cob_field *f = cob_get_param_field (n, "cob_put_s64_param"); - - if (f == NULL) { - return; - } - - cbl_data = f->data; - size = f->size; - if (COB_FIELD_CONSTANT (f)) { - cob_runtime_warning_external ("cob_put_s64_param", 1, - _("attempt to over-write constant parameter %d with " CB_FMT_LLD), - n, val); - return; - } - - switch (f->attr->type) { - case COB_TYPE_NUMERIC_DISPLAY: - cob_put_s64_pic9 (val, cbl_data, size); - return; - case COB_TYPE_NUMERIC_BINARY: -#ifndef WORDS_BIGENDIAN - if (!COB_FIELD_BINARY_SWAP (f)) { - cob_put_s64_comp5 (val, cbl_data, size); - return; - } -#endif - cob_put_s64_compx (val, cbl_data, size); - return; - case COB_TYPE_NUMERIC_PACKED: - cob_put_s64_comp3 (val, cbl_data, size); - return; - case COB_TYPE_NUMERIC_FLOAT: - flt = (float)val; /* possible data loss is explicit requested */ - cob_put_comp1 (flt, cbl_data); - return; - case COB_TYPE_NUMERIC_DOUBLE: - dbl = (double)val; /* possible data loss is explicit requested */ - cob_put_comp2 (dbl, cbl_data); - return; - default: /* COB_TYPE_NUMERIC_EDITED, ... */ - temp.size = 8; - temp.data = (unsigned char *)&val; - temp.attr = &const_binll_attr; - const_binll_attr.scale = f->attr->scale; - cob_move (&temp, f); - return; - } -} - -void -cob_put_u64_param (int n, cob_u64_t val) -{ - void *cbl_data; - int size; - float flt; - double dbl; - cob_field temp; - cob_field *f = cob_get_param_field (n, "cob_put_u64_param"); - - if (f == NULL) { - return; - } - - cbl_data = f->data; - size = f->size; - if (COB_FIELD_CONSTANT (f)) { - cob_runtime_warning_external ("cob_put_u64_param", 1, - _("attempt to over-write constant parameter %d with " CB_FMT_LLD), - n, val); - return; - } - switch (f->attr->type) { - case COB_TYPE_NUMERIC_DISPLAY: - cob_put_u64_pic9 (val, cbl_data, size); - return; - case COB_TYPE_NUMERIC_BINARY: -#ifndef WORDS_BIGENDIAN - if (!COB_FIELD_BINARY_SWAP (f)) { - cob_put_u64_comp5 (val, cbl_data, size); - return; - } -#endif - cob_put_u64_compx (val, cbl_data, size); - return; - case COB_TYPE_NUMERIC_PACKED: - cob_put_u64_comp3 (val, cbl_data, size); - return; - case COB_TYPE_NUMERIC_FLOAT: - flt = (float)val; /* possible data loss is explicit requested */ - cob_put_comp1 (flt, cbl_data); - return; - case COB_TYPE_NUMERIC_DOUBLE: - dbl = (double)val; /* possible data loss is explicit requested */ - cob_put_comp2 (dbl, cbl_data); - return; - default: /* COB_TYPE_NUMERIC_EDITED, ... */ - temp.size = 8; - temp.data = (unsigned char *)&val; - temp.attr = &const_binll_attr; - const_binll_attr.scale = f->attr->scale; - cob_move (&temp, f); - return; - } -} - -void -cob_put_picx_param (int n, void *char_field) -{ - cob_field *f = cob_get_param_field (n, "cob_put_picx_param"); - - if (f == NULL || char_field == NULL) { - return; - } - - if (COB_FIELD_CONSTANT (f)) { - cob_runtime_warning_external ("cob_put_picx_param", 1, - _("attempt to over-write constant parameter %d with '%s'"), - n, (char*)char_field); - return; - } - - cob_put_picx (f->data, f->size, char_field); -} - -void * -cob_get_grp_param (int n, void *char_field, size_t len) -{ - cob_field *f = cob_get_param_field (n, "cob_get_grp_param"); - - if (f == NULL) { - return NULL; - } - if (len == 0) { - len = f->size; - } - - if (char_field == NULL) { - if (len < f->size) { - len = f->size; - } - char_field = cob_malloc (len); - } - memcpy (char_field, f->data, f->size); - return char_field; -} - -void -cob_put_grp_param (int n, void *char_field, size_t len) -{ - cob_field *f = cob_get_param_field (n, "cob_put_grp_param"); - - if (f == NULL || char_field == NULL) { - return; - } - - if (COB_FIELD_CONSTANT (f)) { - cob_runtime_warning_external ("cob_put_grp_param", 1, - "attempt to over-write constant parameter %d", n); - return; - } - - if (len == 0 || len > f->size) { - len = f->size; - } - memcpy (f->data, char_field, len); -} - -/* Create copy of field and mark as a CONSTANT */ -void -cob_field_constant (cob_field *f, cob_field *t, cob_field_attr *a, void *d) -{ - memcpy((void*)t, (void*)f, sizeof(cob_field)); - memcpy((void*)a, (void*)f->attr, sizeof(cob_field_attr)); - t->data = d; - t->attr = a; - a->flags |= COB_FLAG_CONSTANT; - memmove((void*)t->data, (void*)f->data, f->size); -} - -/* Create copy of field and mark as a VALUE */ -void -cob_field_value (cob_field *f, cob_field *t, cob_field_attr *a, void *d) -{ - memcpy((void*)t, (void*)f, sizeof(cob_field)); - memcpy((void*)a, (void*)f->attr, sizeof(cob_field_attr)); - t->data = d; - t->attr = a; - a->flags |= COB_FLAG_VALUE; - memmove((void*)t->data, (void*)f->data, f->size); -} - -/* Create copy of field and mark as a CONTENT */ -void -cob_field_content (cob_field *f, cob_field *t, cob_field_attr *a, void *d) -{ - memcpy((void*)t, (void*)f, sizeof(cob_field)); - memcpy((void*)a, (void*)f->attr, sizeof(cob_field_attr)); - t->data = d; - t->attr = a; - a->flags |= COB_FLAG_CONTENT; - memmove((void*)t->data, (void*)f->data, f->size); -} diff -Nru gnucobol-4.0~early~20200606/libcob/ChangeLog gnucobol-5/libcob/ChangeLog --- gnucobol-4.0~early~20200606/libcob/ChangeLog 2020-06-06 20:52:01.000000000 +0000 +++ gnucobol-5/libcob/ChangeLog 1970-01-01 00:00:00.000000000 +0000 @@ -1,4564 +0,0 @@ - -2020-05-16 Ron Norman - - * fisam.c: Fixed problem with READ PREVIOUS/DELETE/READ PREVIOUS - when reading thru a group of duplicate keys - -2020-04-28 Ron Norman - * common.h,move.c: cob_set_llint is now passed a value to do size - checking. It also now checks module->flag_binary_truncate - and truncates the data as needed - -2020-04-26 Ron Norman - * common.h,move.c,sysdefines.h: Updates for speeding up arithmetic - -2020-04-26 Ron Norman - - * fileio.c: For LINE SEQUENTIAL and OPEN I-O some platforms - (SUNOS for one) require that a fflush be done - between each read/write of the file - -2020-04-17 Ron Norman - - * fileio.c: Fixed compile warnings - * fisam.c: Fixed sync/commit routine - * fbdb.c: Fixed I/O routine pointers - -2020-04-14 Ron Norman - - * fileio.c: Fixed to NOT mix I/O to FILE * via putc and 'int fd' via write - 'FILE *' is buffered and 'int fd' is NOT so the data - can end up in a very strange sequence in the file - -2020-04-14 Ron Norman - - * common.h: Add fields for implementing LINE SEQUENTIAL pipes - * fileio.c: Add code for LINE SEQUENTIAL pipes - -2020-04-01 Simon Sobisch - - * common.c: changed "FUNCTION/USING parameter" to "FUNCTION/USING argument" - * screenio.c: moved screen initialization from internal to external - called function - -2020-03-28 Ron Norman - - * sysdefines.h: Add COB_MAX_CHAR_SIZE, Largest 'static char' - supported by the C compiler - -2020-03-11 Simon Sobisch - - * Makefile.am: adjusted invocation of help2man, using new defines - HELPSOURCES and HELP2MAN_OPTS - * Makefile.am: honor new conditional MAKE_HAS_PREREQ_ONLY - -2020-03-01 Simon Sobisch - - * fileio.c, common.h: define and use COB_FILE_MODE for _WIN32 and - COB_OPEN_TEMPORARY for all other environments - * fileio.c (cob_write): removed io-status 49 as it only applies to - REWRITE and DELETE - -2020-02-27 Simon Sobisch - - * common.h: definition of COB_A_NORETURN for newer HPUX (__HP_cc) - -2020-02-15 Ron Norman - * common.h, fileio.c, fileio.h, foci.c, fodbc.c, fsqlxfd.c: - Updates to support RELATIVE file for processing by - the OCI/ODBC I/O modules. - A 'RELATIVE" table has a column called 'rid_tablename' - which is PRIMARY KEY. - As much code as possible was moved into fileio.c to - manage the logical 'record number' so that foci.c & fodbc.c - do not need to duplicate that logic - -2020-02-13 Ron Norman - * fsqlxfd.c: Call cob_xfd_to_ddl if 'create_table' was 'true' - and table.ddl is not present - * common.c,fileio.h,coblocal.h: Updates for 'create_table' - * foci.c, fodbc.c: Pick up 'create_table' option - * fileio.c: Use cob_dictionary_path if defined - -2020-02-12 Ron Norman - * fsqlxfd.c: Adding cob_xfd_to_ddl routine - * common.h,fileio.h: Updates for cob_xfd_to_ddl - * foci.c, fodbc.c: Add checks for Table not defined - -2020-02-05 Ron Norman - * common.h: cob_file and cob_file_key updated - * fileio.c,fbdb.c: Corrections for using filedef.dd for BDB - -2020-01-28 Ron Norman - * fileio.c,fbdb.c,fsqlxfd.c: Adding casts to avoid C compile warnings - * fextfh.c,screenio.c,common.c: Adding casts to avoid C compile warnings - -2020-01-25 Ron Norman - * fileio.c: Skips reading records having SUPPRESS WHEN "string" - and checks for duplicates on (RE)WRITE if there was - no WITH DUPLICATES because the underlying file - needs to allow DUPLICATES - -2020-01-24 Ron Norman - * Makefile.am: --version-info changed to 5:0:0 - * common.h: cob_file and cob_file_key updated - some #define replaced by enum - COB_FILE_VERSION is now 5 - * common.c: Changes to match updated cob_file_key - * fileio.c: New routines added for setup of cob_file and cob_file_key - Now skips records having SUPPRESS WHEN "string" - Several place holders added and code will come later - * fextfh.c: Changes to match updated cob_file - * flmdb.c: Changes to match updated cob_file - -2020-01-22 Ron Norman - * coblocal.h: Added cob_bdb_byteorder - * common.h: Added flags for BDB Byteorder - * common.c: Added bdb_byteorder to runtime config processing - * fileio.c: Added code to handle byteorder options - * fbdb.c: Added code to use byteorder options for both BDB set_lorder - and for the numeric duplicate key value - -2020-01-06 Ron Norman - * fileio.h,fsqlxfd.c,foci.c,fodbc.c: - Implemented READ locking options (RETRY, IGNORE, ADVANCING) - By adding clauses to SELECT statement - What is used varies depending on the type of Database - -2020-01-06 Ron Norman - * fileio.c: In IO_filename checks for table=sqltablename - and schema=directory holding XFD/DDL files - - * common.h,fsqlxfd.c,foci.c,fodbc.c: - Updates for using SELECT ... FOR UPDATE when needed - -2020-01-03 Ron Norman - - * common.c: Moved close of DEBUG_LOG file after exit_fileio - * common.h: Add COB_CLOSE_ABORT - * fileio.c: On 'implicit close' pass COB_CLOSE_ABORT - * fsqlxfd.c: Updates for OCI/ODBC - * foci.c: Working module. More testing coming and add Array fetches - * fodbc.c: Tested with MySQL and MS SQL Server, later adding Bulk ADD - * OCI/ODBC has had some testing and more will be done, Standby - -2020-01-03 Simon Sobisch - - * common.c: bump copyright year - -2020-01-02 Ron Norman - - * common.c: Removed warning about COB_DEBUG_LOG - -2020-01-02 Ron Norman - - * common.h: Add COB_LAST_COMMIT and COB_LAST_ROLLBACK - * fileio.c: Add trace code for COMMIT/ROLLBACK - -2020-01-02 Simon Sobisch - - * fextfh.c (copy_fcd_to_file) [_WIN32]: fix file_features for ORG_LINE_SEQ - * fextfh.c (update_fcd_to_file): removed special handling of ORG_LINE_SEQ - as already done in copy_fcd_to_file - -2020-01-01 Ron Norman - - * fileio.c: removed wrong setting of io_routine - * fileio.h: Updates for ODBC interface - * sysdefines.h: Add SQL Date structure - * fodbc.c,fsqlxfd.c: Preliminary checkin of ODBC interface - ODBC is not ready for production yet - OCI will be developed/tested next based on ODBC - -2019-12-27 Ron Norman - - * common.h: Added cob_file.curkey to record recent file index - * fileio.c: cob_read_next will check for records returned with - a key that has all SUPPRESS character and skip the - record. This will handle old VBISAM, ODBC & OCI - which do not support key suppression - -2019-12-16 Ron Norman - - * fisam.c: Adjusted for correct use of snprintf - -2019-12-11 Simon Sobisch - - * screenio.c (BUTTON3_DOUBLE_CLICKED): fix value for BUTTON3_DOUBLE_CLICKED - * screenio.c (field_accept): pass mouse position on KEY_MOUSE - * screenio.c (cob_display_formatted_text): fix early return for broken data - * common.c (set_config_val): pass COB_MOUSE_INTERVAL changes to screenio.c - -2019-11-30 Ron Norman - - * common.c: Have cobcrun --info display of ODBC or OCI are possible - * common.h: Flags added for created of eXternal file Description - -2019-11-21 Ron Norman - - * fbdb.c: Change to ignore sequence of keys when writing - to an output SEQUENTIAL INDEXED file that was - runtime changed to file type of INDEXED - -2019-11-20 Ron Norman - - * common.h,fileio.c,fisam.c: Added flag_set_isam to cob_file - and if set, then ignore sequence of keys when writing - to an output SEQUENTIAL INDEXED file that was - runtime changed to file type of INDEXED - -2019-11-20 Ron Norman - - * common.h,fileio.c,fextfh.c: Added more file format to FCD3 - and check/set the value in cob_file - so the COBOL program can change file format via the FCD - * fileio.c: Tidy up Variable Sequential file processing code - * fisam.c: Fix coding error related to status 21 on WRITE - -2019-11-18 Ron Norman - - * common.h,fileio.c,fextfh.c,fbdb.c: Updates to support - SET ... TO ADDRESS OF FH--FCD OF file - SET ... TO ADDRESS OF FH--KEYDEF OF file - -2019-11-14 Ron Norman - - * common.c: Fix for display of runtime options - * fileio.c: If bad data in LINE SEQUENTIAL file cause error status 71 - instead of 34 - -2019-11-14 Ron Norman - - * coblocal.h: - * common.c: Add runtime options COB_FILE_DICTIONARY & - COB_FILE_DICTIONARY_PATH - * fileio.h: - * fileio.c: Clean up of code to write/read file format information - default is 'asgname.dd' - Support for COB_FILE_DICTIONARY_PATH is not implemented - -2019-10-31 Ron Norman - - * fisam.c: Sets record size when doing OPEN INPUT - * fileio.c: More work on handing file formats being - defined via the IO_asgname - -2019-10-29 Ron Norman - - * fileio.c: Checks for filetype_OPTIONS (eg. IX, SQ, RL) - and sets options defined - If no filetype_OPTIONS then it checks for IO_OPTIONS - Then it checks IO_filename for options - - Implement support for an option of format=auto which - indicates fileio should assign the correct INDEXED file - handler based on the existing file format - -2019-10-26 Ron Norman - - * fileio.c: work on handling file definition parameters in IO_filename - RELATIVE file at end-of-file now returns status 10 - when ACCESS SEQUENTIAL, otherwise status 23 - -2019-10-25 Ron Norman - - * fileio.c: split read/write dictionary routines for future uses - RELATIVE file now returns status 14 for end of file - * fisam.c: Fixed to use correct index of xISAM file - when only part of the indexed are defined in COBOL - and keycheck=off - -2019-10-25 Edward Hart - - * numeric.c (cob_add_int): fixed floating-point case (bug #603). - -2019-10-24 Simon Sobisch - - * common.c (internal_nanosleep): added a new parameter specifying - "round to minimal" to be able to use it for locking_timout - * common.c, common.h: replaced non-system function cob_sys_sleep_msec - with new internal cob_sleep_msec - * fileio.c, fisam.c, fbdb.c: adjusted cob_sys_sleep_msec->cob_sleep_msec - * flmdb.c (local_file): fixed SIGSEGV if proc/partitions is not - accessible and allow the check to be skipped via MDB_NO_LOCAL_FS_CHK - -2019-10-24 Ron Norman - - * flmdb.c updated to be more portable - -2019-10-21 Ron Norman - - * fileio.c Update for multiple xISAM handlers - * call.c: added cob_load_lib to load xISAM handler - * common.c,common.h: Updated for multiple xISAM handlers - * fisam.c Updated for multiple xISAM handlers - * Makefile.am Updated for multiple xISAM - * libcobci.c - builds fisam.c for C-ISAM - * libcobdi.c - builds fisam.c for D-ISAM - * libcobvb.c - builds fisam.c for VB-ISAM - -2019-10-20 Ron Norman - - * common.c fix problem with DEBUG_LOG operation - * flmdb.c changed to use DEBUG_LOG - * fisam.c change name of global/set pointers - -2019-10-19 Ron Norman - - * fisam.c correction for START LESS EQUAL followed by READ PREVIOUS - * fbdb.c,flmdb.c correction to not return 05 status when OPEN OUTPUT - for an optional file - -2019-10-19 Ron Norman - - * fileio.c has been split into fileio.c fisam.c fbdb.c fextfh.c focextfh.c - * fileio.h added with common definitions for all fileio modules - * flmdb.c copied from isam-lmdb branch - * You can now configure multiple INDEXED file handlers but only one of - C-ISAM, D-ISAM or VB-ISAM - -2019-10-15 Simon Sobisch - - * screenio.c (pass_cursor_to_program): fixed return column being off by -1 - * screenio.c (get_cursor_from_program): fixed alphanumeric CURSOR to only - work for size 6 - -2019-10-03 Ron Norman - - * fileio.c: Removed definition of off_t as it needs to be defined - by the system and is most often in - -2019-10-01 Edward Hart - - * fileio.c: fixed location of definition of off_t (bug #596) - -2019-09-28 Ron Norman - - * common.h: COB_FILE_VERSION changed to 4 (matching reportwriter) - -2019-09-26 Ron Norman - - * sysdefines.h: New header to keep system dependent #defines - * common.c,common.h,call.c,fileio.c: Uses sysdefines.h - * Makefile.am: added sysdefines.h - -2019-09-23 Simon Sobisch - - * common.h: moved alignment defines to cobc/cobc.h - -2019-09-20 Ron Norman - - * reportio.c: Table up report for cleanup in cob_exit_reportio - -2019-09-10 Ron Norman - - * fileio.c: Fix relative_read_size to use 'size_t' for GC file type - -2019-09-03 Ron Norman - - * call.c: Initialize valid_char when needed - * numeric.c: Correct the definition of 'isinf' - -2019-08-28 Ron Norman - - * fileio.c: Free up 'fcd' fnamePtr allocated - -2019-08-27 Ron Norman - - * fileio.c: Clean up 'fcd' tables dynamically allocated via free_extfh_fcd - fix some compile warnings - -2019-08-17 Simon Sobisch - - * call.c (cob_resolve_internal): refactored to keep call_entry_buff - and call_entry_buff2 as a local variables instead of dynamic - storage check + allocating + deallocating - * common.h, call.c (cob_encode_program_id): extracted from - cob_resolve_internal and added explicit check for the buffer - size fixing bug #584; externalized for use by cobc - * common.h: new define COB_MAX_LITERAL_LEN, with currently 256k, - used in cobc instead of previous LONG_MAX - -2019-07-14 Simon Sobisch - - * system.def: added CBL_ALARM_SOUND and CBL_BELL_SOUND, both as alias - to cob_sys_sound_bell - -2019-07-06 Simon Sobisch - - * common.h: removed inclusion of stdio.h - * common.h, coblocal.h: moved definition of cob_print_field to local - * fileio.c (cob_write_dict): fixed compiler warnings - -2019-07-02 Simon Sobisch - - * common.c (cob_sys_oc_nanosleep): fixed by splitting get_sleep_nanoseconds - into an additional function get_sleep_nanoseconds_from_seconds - -2019-07-01 Ron Norman - - * fileio.c: Use DB_ENV->remove to clean up the BDB environment in - cob_exit_fileio. This make test cases using INDEXED files repeatable with - DB_HOME defined and/or defaulting to "./" - -2019-06-30 Simon Sobisch - - * screenio.c: split cob_check_pos_status into handle_status and - pass_cursor_to_program - * screenio.c (pass_cursor_to_program): fix bug #483 - increment line number by one, pass actual column - * screenio.c (get_cursor_from_program, cob_screen_get_all, field_accept): - fix bug #579 - use CURSOR clause in SPECIAL-NAMES also for positioning - * screenio.c: finished approach to add mouse support via COB_MOUSE_FLAGS - * screenio.c, common.c, coblocal.h: added COB_MOUSE_INTERVAL - -2019-06-29 Simon Sobisch - - * screenio.c: extracted (get_accept_timeout) and removed the artificial - minimal limit FR #196 - -2019-06-24 Ron Norman - - * fileio.c: Fixed to check file_features for COB_FILE_SYNC flag and then - cob_sync the file - -2019-06-23 Simon Sobisch - - * mlio.c, move.c, numeric.c, reportio.c, termio.c: fixed possible - arithmetic overflow (especially because of cast errors on x64) - -2019-06-21 Ron Norman - - * fileio.c: Add cob_write_dict and cob_read_dict for data file description - -2019-06-14 Simon Sobisch - - * fileio.c (bdb_err_event): added DB_EVENT_WRITE_FAILED, call cob_stoprun - for full tear-down, to no create loops in case of fatal errors unset - bdb_env and use new guard bdb_err_tear_down; - adjusted to remove compiler warnings - -2019-06-13 Ron Norman - - * fileio.c: Use bdb_env->set_event_notify to catch fatal BDB errors - and exit the program - -2019-06-11 Ron Norman - - * fileio.c: COB_FILE_PATH may be a colon separated list of directories - With BDB the COB_FILE_PATH is now passed to BDB using set_data_dir - -2019-06-10 Ron Norman - - * fileio.c: Merged BDB record lock retry logic from reportwriter - -2019-06-10 Simon Sobisch - - * common.c (gc_conf, set_config_val, get_config_val), coblocal.h: - split ENV_INT to ENV_UINT (all current options) and ENV_UINT (allowing - a negative min_value), actually check for numeric values - -2019-06-09 Simon Sobisch - - * fileio.c: adjustments to fix issues reported by static code analyzer - -2019-06-07 Simon Sobisch - - * common.c (print_runtime_conf): fixed theoretical buffer overflow for bad - translation ("via" translated as very long string) - * common.h: new define MAX_FILE_KEYS (currently at 255) with main purpose - to limit allocation of external provided key definition - -2019-06-07 Ron Norman - - * fileio.c: If DB_HOME is not defined, then default to "." - If DB_HOME is 'no' or 'false' then disable record/file locking - -2019-06-06 Ron Norman - - * fileio.c: Fix more merge issues for BDB - -2019-06-05 Simon Sobisch - - * fileio.c (cob_file_close, cob_file_unlock) [!HAVE_FCNTL]: fixed - missing check for fcntl availability - -2019-05-31 Simon Sobisch - - * screenio.c (cob_settings_screenio): moved out of COB_GEN_SCREENIO - -2019-05-30 Simon Sobisch - - * Makefile.am (AM_CPPFLAGS): include new substituted LIBCOB_CPPFLAGS - * Makefile.am: handle LOCAL_CJSON by adding cJSON.c to libcob's nodist - sources and cJSON.c + cJSON.h to DISTCLEANFILES - -2019-05-26 Simon Sobisch - - * common.c (cob_runtime_hint), coblocal.h: new funtion for output additional - information to a warning/error directly called before, especially important - for (cob_runtime_error) which invokes the error handlers, - used for this scenario throughout common.c - * common.c (cob_field_to_string): explicit check for field address - * fileio.c (cob_get_filename_print), coblocal.h: new function to provide a - filename for output with filename, assign and possible file mapping - * fileio.c (cob_exit_fileio), common.c (cob_fatal_error): - use of cob_get_filename_print - * fileio.c (cob_delete_file): check errno after unlink/indexed_file_delete - * reportio.c (cob_report_terminate, cob_report_generate): halt on fatal - error COB_EC_REPORT_INACTIVE - -2019-05-19 Simon Sobisch - - * common.c, mlio.c: check for WITH_XML2/WITH_CJSON before including - the corresponding header files as they showed to sometimes exist but - don't work, still ensure (for config.h not generated by configure) - that necessary headers are available - -2019-05-13 Simon Sobisch - - * common.c (cob_fatal_error): added statement (if available) for - COB_FERROR_FILE - * common.c, mlio.c: adjusted to handle HAVE_CJSON_H as an alternative - to HAVE_CJSON_CJSON_H - -2019-05-11 Simon Sobisch - - * common.h: increased COB_MAX_WORDLEN to 63 per COBOL 202x - -2019-04-19 Simon Sobisch - - * common.c: fixed some bad/misplaced casts to size_t - * common.c, screenio.c: initial approach to add mouse support - via COB_MOUSE_FLAGS, including exception values - * common.c, screenio.c: adjustments to COB_INSERT_MODE are taken - into account at runtime - -2019-04-15 Simon Sobisch - - * fileio.c (relative_read_next): change only place that did not use - size_t for relsize (which should be no problem as it used cob_s64_t - before) - * fileio.c: adjusted some counters to use size_t instead of casting them - * common.c, coblocal.h (cob_min_int, cob_max_int): moved smaller helper - functions that were defined as both inline and extern as static inline - in coblocal.h - -2019-04-14 Ron Norman - - * screenio.c: define ALT_DEL, ALT_LEFT, ALT_RIGHT - using \033 for Escape instead of \E to avoid C compiler problems - * fileio.c: Fix RELATIVE file I/O bug for use on big-endian system - -2019-04-12 Simon Sobisch - - * screenio.c: define PDC_NCMOUSE to use NCURSES compatible mouse api - -2019-04-07 Simon Sobisch - - * common.c (get_sleep_nanoseconds, internal_nanosleep): new functions; - moved the actual sleep code from cob_sys_oc_nanosleep and cob_sys_sleep - to a common place and finally allow fractions of seconds in C$SLEEP - * common.c, common.h (cob_continue_after): new function for FR #354 - -2019-03-25 Simon Sobisch - - * common.c (print_info): output endianess and native EBCDIC - -2019-03-23 Simon Sobisch - - * libcob.h: removed inclusion of gmp.h - * common.h: cob_decimal is now only used if gmp.h / mpir.h / mp.h was - included before libcob.h, otherwise COB_WITHOUT_DECIMAL is defined - * mlio.c: fixed missing include stddef.h - -2019-03-19 Simon Sobisch - - * common.c: definition of COB_MAX_NAMELEN - * common.c: use of COB_MAX_NAMELEN, including sanity check - * mlio.c, numeric.c, coblocal.h: moved duplicated code from mlio.c - to numeric.c as separate function cob_set_field_to_uint - * coblocal.h [COB_WITHOUT_DECIMAL]: allow inclusion without gmp header - -2019-03-15 Simon Sobisch - - * common.c (check_valid_dir): converted from define to inline function - * common.c (print_stat): not-active debug function (grabbed from manpage) - -2019-03-12 Simon Sobisch - - * common.c (print_info): changed msgid for "file handler" and output - if RTD-version of VB-ISAM is used, partially after Ron Norman - -2015-03-03 Ron Norman - - * fileio.c, common.c, common.h updated to resolve little endian - versus big endian issues - -2019-02-26 Simon Sobisch - - * common.h: define COB_EXT_EXPORT / COB_EXT_IMPORT - -2019-01-29 Simon Sobisch - - * common.c, termio.c, coblocal.h: added COB_DISPLAY_PUNCH_FILE - * common.c (cob_set_runtime_option, cob_get_runtime_option), - common.h (cob_runtime_option_switch): - added COB_SET_RUNTIME_DISPLAY_PUNCH_FILE - -2019-01-27 Simon Sobisch - - * common.c, mlio.c, screenio.c: fixed compiler warnings - * common.c (print_info): fixed issues if curses is not available, - introduced 2019-01-22 - -2019-01-22 Simon Sobisch - - * screenio.c (cob_screen_init): fix background=foreground from terminal - * screenio.c (cob_screen_init, cob_screen_attr): explicit define and use - color_pair 1 as "black on black" - * screenio.c (cob_screen_attr): fix long standing bug in use of - color_set (takes color_pair_number, not a COLOR_PAIR) - * screenio.c (cob_screen_attr): extracted (cob_to_curses_color, - cob_get_color_pair, cob_activate_color_pair) - * screenio.c: fix compiler warnings and correctly use chtype - * common.c (print_info): extensive output of curses library including - size for chtype, wide yes/no and forced UTF-8 for PDCurses - * common.c: use SLASH_CHAR where possible - -2019-01-20 Simon Sobisch - - * common.c (check_valid_env_tmpdir): unset invalid TMPDIRs to prevent - warning/error messages from used tools - * common.c (print_info): added version output for libxml2 + cJSON - * mlio.c (cob_json_generate): fix warning about use of unset var - * mlio.c: fix warnings and issues about defines not set / set to zero - -2019-01-05 Edward Hart - - * mlio.c: added JSON GENERATE. - * common.h, common.c: replaced COB_FERROR_* #define's with - cob_fatal_error enum. - -2019-01-03 Edward Hart - - * xml.c: renamed file to mlio.c and cob_..._xmlio to cob_..._mlio. - -2019-01-01 Simon Sobisch - - * fileio.c: check for definition of non-portable EDEADLK before using it, - possibly using EDEADLOCK instead - -2018-12-31 Simon Sobisch - - * system.def, common.h: new entry EXTFH / cob_sys_extfh - * fileio.c (cob_sys_extfh): new function used as COBOL wrapper for - EXTFH entry to prevent warnings about FCD3 structure, linking issues - and providing additional checks - * fileio.c (EXTFH): return file code 9/161 for different errors - * fileio.c (EXTFH), common.h: minimal implementation for ORG_DETERMINE - (will only work if the same FCD was already used with the same file) - * common.h (FCD3): adjustment to xfhfcd3.cpy - * common.h (KDB): split KDB_KEY to separate definition - -2018-12-30 Ron Norman - - * fileio.c (copy_file_to_fcd): Corrected memory allocation of EXTFH - data structs - -2018-12-19 Ron Norman - - fixing EXTFH bug #561, part II - * fileio.c (lineseq_write): handle EXTFH with write options not set - * fileio.c (copy_file_to_fcd, copy_fcd_to_file): added code for - LINE SEQUENTIAL flags for EXTFH interface - *Note: deactivated until file_features are merged from rw-branch* - -2018-12-13 Ron Norman - - fixing EXTFH bug #561, part I - * fileio.c (update_file_to_fcd): adjustments for setting openMode - * fileio.c (copy_fcd_to_file): fixed coding error if file has no keys - -2018-11-25 Simon Sobisch - - * intrinsic.c (cob_intr_content_of): fixed unlikely case of empty *srcfield - not raising EC-DATA-PTR-NULL - * intrinsic.c (cob_intr_content_length, cob_intr_content_of): - minor refactoring - * intrinsic.c (decimal_places_for_seconds): changed parameter to - unsigned int as it is enough and keeps the same types in callers - -2018-11-22 Ron Norman - - * move.c (cob_move_binary_to_binary): fixed to do truncation as required - -2018-11-20 Ron Norman - - * numeric.c (cob_print_realbin): fixed to call cob_binary_get_uint64 - for unsigned field - -2018-11-11 Simon Sobisch - - * common.h [COB_WITHOUT_EXCEPTIONS]: allow include of libcob.h without - any other libcob header - -2018-11-01 Simon Sobisch - - * common.h [COB_WITHOUT_DECIMAL]: allow include of libcob.h without - gmp header - -2018-10-28 Simon Sobisch - - * common.c (print_info): fixed missing periods in GMP/MPIR version number - between minor and patchlevel - * common.c: minor refactoring - separate translate_boolean_to_int() - * common.h [__ORANGEC__]: added to used WIN32 defines - -2018-10-21 Simon Sobisch - - * common.h: exchanged system-specific PTRFILLER define for FCD3 by union - -2018-09-30 Simon Sobisch - - * fileio.c [HAVE_FCNTL]: minor code cleanup - * common.c, common.h: new function cob_common_init to provide - C RTS and library setup, currently binding textdomain and - for [_WIN32] handling unix-lf - * common.c, coblocal.h, cobgetopt.c: activated translated messages - for COBOL runtime - * common.c, screenio.c: fixed to use constant strings for - static char * initialization, postpone msgid translation - * common.c (print_runtime_conf, get_config_val, var_print): - adjusted output of cobcrun -runtime-conf (boolean print as yes/no now) - -2018-09-22 Simon Sobisch - - * fileio.c [WITH_DB]: fix split key access by using the component data - even if there is only one - -2018-09-01 Simon Sobisch - - * common.c (cob_gettmpdir): check if the specified temporary location - is actually an existing directory; otherwise warn and check the next - environment variable; added check_valid_env_tmpdir, check_valid_dir - * common.c (output_source_location): removed extra space in warnings - if neither source-file nor source-line is set - * common.c (cob_runtime_warning): allow warnings before call to - cob_init() - * xml.c (set_xml_code): partially fix bug #548: don't try to set XML-CODE - if the module has no reference (and therefore no field) for it - -2018-08-19 Simon Sobisch - - * xml.c [!WITH_XML2] (cob_is_valid_uri): added minimal implementation, - as this function is also used from within cobc - * xml.c: explicit check for the non-standard header files instead of - the global WITH_XML definition - * xml.c, common.h: fixed compiler warnings - -2018-08-19 Edward Hart - - * xml.c: new file, added for XML GENERATE - -2018-08-17 Simon Sobisch - - * coblocal.h, numeric.c (cob_decimal_init2): fixed compiler warning - -2018-07-31 Ron Norman - * termio.c: Improved pretty display for LENGTH/FUNCTION values - Added cob_field_int_display - * common.h: added cob_field_int_display - * intrinsic.c: Improved for pretty_display - -2018-07-29 Ron Norman - * fileio.c: Added code to set COB_STATUS_53_MAX_LOCKS - -2018-07-29 Simon Sobisch - - * common.h: added defines for not yet implemented standard - I-O status values - -2018-07-14 Edward Hart - - * screenio.c (get_screen_item_line_and_col): fixed bug #514, where - length of elementary items with a LINE clause was ignored when - calculating the COL of subsequent items. - -2018-07-13 Simon Sobisch - - * common.c (cob_check_ref_mod): display maximum size on overflow - -2018-07-12 Ron Norman - * call.c: Added cob_get_name_line to return source line of CALL - Added cob_field_value to copy field & set COB_FLAG_VALUE - Added cob_field_content to copy field & set COB_FLAG_CONTENT - -2018-07-05 Ron Norman - * coblocal.h,common.c: Added runtime.cfg options for COB_LS_SPLIT - * fileio.c: Added checks for runtime.cfg options for split or truncate - LINE SEQUENTIAL records which are longer than expected - -2018-07-04 Ron Norman - * common.h: Added COB_MF_LS_SPLIT flag - * fileio.c: - Added check for IO_fdname having 'ls_split' for - Micro Focus compatible LINE SEQUENTIAL files. - When a record is longer than the program was compiled for - Micro Focus will return the extra data as an extra record. - This is the result for when IO_fdname has ls_split. - For 'GC' format LINE SEQUENTIAL or for 'nols_split' a long - record will get truncated and skip to the next LF. - -2018-07-04 Edward Hart - - * move.c (cob_move_display_to_edited): fixed bug #220 again; this time - where $ would incorrectly float before a string of +/-. - -2018-06-24 Simon Sobisch - - * system.def: bug #527 system call x'91' *always* uses three parameters - -2018-06-21 Brian Tiffin - - * common.h, intrinsic.c: Added CONTENT-LENGTH and CONTENTS-OF - -2018-06-18 Ron Norman - - * fileio.c: Updates to the EXTFH logic - You can now actually compile using MF Visual COBOL and include the - GnuCOBOL libcob as follows: - cob -L/usr/local/lib -lcob -C "CALLFH=EXTFH" - -2018-06-10 Simon Sobisch - - * common.h: allow to override COB_EXPIMP, especially for allowing - static builds on _WIN32 via -DCOB_EXPIMP=extern - -2018-05-18 Simon Sobisch - - * common.c [_WIN32]: only define __GMP_LIBGMP_DLL if it is not - defined already, allowing to use a static version by defining - __GMP_LIBGMP_DLL to 0 - * Makefile.am (install-data-hook): added missing $(DESTDIR), as - reported by Eric Gallager in bug #73 - -2018-05-09 Simon Sobisch - - * fileio.c (cob_file_open): fix for bug #520 - check f->fd before using it to prevent SIGSEGV on OPEN OUTPUT - * common.c (cob_sig_handler): minor format adjustment - -2018-05-08 Simon Sobisch - - * termio.c (cob_display): cater for HAVE_POPEN - * common.h, fileio.c [__ORANGEC__]: minor adjustments for - preprocessor defines - * common.c: added OrangeC version info - * reportio.c: removed unneeded header and defines - -2018-04-16 Luke Smith - - * screenio.c: - - HOME and END toggle on current column. - - Backspace beep column 1. - -2018-04-10 Luke Smith - - * screenio.c: - - replace Alt-Home and Alt-End with toggle functions - - fix Insert key at column 1 - - fix other alt keys - -2018-04-10 Simon Sobisch - - * reportio.c [_WIN32]: fix redefinition of lseek - -2018-04-03 Simon Sobisch - - * screenio.c (cob_screen_init): fix definition of alt keys - when function keys have negative values - -2018-04-02 Simon Sobisch - - * common.c (cob_sys_getopt_long_long): fixed free of changed pointer - * move.c (cob_put_u64_compx, cob_put_s64_compx) [!WORDS_BIGENDIAN]: - fixed definition of unused variable - * common.c (cob_gettmpdir): check if environment variables for TEMP - points to usable directory before using it (fallback to ".") - * common.c (cob_init_nomain) [HAVE_READLINK]: fixed strcpy of - unterminated return from (readlink) - * common.c, reportio.c, termio.c: changed occurrences of strcpy - to strncpy to prevent possible buffer overflows - * common.h: moved definition of COB_MAX_SUBSCRIPTS from cobc/tree.h - * termio.c (cob_dump_field): allow longer field names and - number/high values of subscripts - * initrinsic.c (numval, cob_intr_locale_compare): fixed missing free - in cases of input errors - * fileio (cob_fd_file_open): directly set f->fd after open to prevent - possible ressource leaks with file status != 0 - * fileio (cob_file_free): check pointer before dereferencing it - -2018-04-01 Simon Sobisch - - * screenio.c (cob_screen_init): escape backslash in key definitions - -2018-03-31 Simon Sobisch - - * common.c (set_cob_time_from_local_time): new function called on - all systems, including code for computing UTC offset (with correct - sign) - * common.c (cob_get_current_date_and_time) [_WIN32]: no longer need - to force of date re-calculation as we always use localtime now - -2018-03-29 Simon Sobisch - - * termio.c (cob_display): added missing handling of cob_unix_lf - * common.c (set_cob_time_offset): recreated for use on all systems, - moved code for computation of UTC there, including adjustment by - daylight saving time (which was missing from _WIN32 until now), - set unknown offset in the unlikely case that computation of - UTC offset does not work - -2018-03-21 Simon Sobisch - - * screenio.c (cob_convert_key): define ALT_DEL, ALT_HOME, ALT_END, - ALT_LEFT, ALT_RIGHT if they aren't defined already and map the - keys that were previously converted to use these defines, - also fixes accepting these keys in all curses implementations - that define these keys directly - * screenio.c (cob_screen_init): fix for bug #503 - based on work of - Luke Smith - add the PDCurses ALT key constants where not available instead of - using the version-dependent numeric values, if possible using - define_key to do this directly (if not this must be done be the users - terminal setting) - -2018-03-18 Simon Sobisch - - * screenio.c (field_accept): fixed bug #498 and ignore - COB_INSERT_MODE for fields with size 1 - -2018-03-17 Simon Sobisch - - * screenio.c, common.h: fixed bug #500 CBL_READ_KBD_CHAR not - returning a value and characters being shown instead of hidden - * screenio.c: added missing screenio initializations in external - library routines - -2018-03-13 Simon Sobisch - - * common.c: added Tiny C version info - * termio.c: renamed (clean_nan) to (clean_double) and let it - remove the leading zero from the exponent - -2018-03-11 Ron Norman - - * common.c: Compute UTC without strftime and adjust for - daylight savings time, removed (set_unknown_offset) - -2017-03-08 Ron Norman - - * termio.c: standardize DISPLAY of NaN (Not A Number) - -2018-02-25 Simon Sobisch - - * common.c, coblocal.h (cob_get_dump_file): export for internal - call, only use trace file if dump file cannot be opened - * termio.c (cob_dump_field): removed trailing spaces for group - items, get trace file from (cob_get_dump_file) - * common.c, coblocal.h (cob_runtime_warning_external): new function - * call.c: warnings centralized, msgids changed - -2018-02-23 Simon Sobisch - - * common.c: cater for empty module_sources - -2018-02-16 Simon Sobisch - - * reportio.c: adjusted runtime error messages - -2018-02-12 Simon Sobisch - - * common.c, coblocal.h: removed external_display_print_file as - cob_display_print_file is always external - * common.c (cob_open_logfile): moved log file opening handling - code from cob_check_trace_file to new static function - * common.c (cob_debug_open): refactored, allowed debug log to be - opened in append mode - * common.c [COB_DEBUG_LOG]: fixed issues when debug log has same - name as trace file, fixed missing free of cob_debug_file_name - -2018-02-09 Simon Sobisch - - * common.c [!COB_DEBUG_LOG]: adjusted handling of COB_DEBUG_LOG to - minimize active code while still raise a warning (instead of an - error) - -2018-01-31 Simon Sobisch - - * common.h: change all typedef struct/union to be named using - the same name schema - * common.c (explain_field_type): new function, - used texts may be tweaked later - * common.c (cob_check_numeric): set COB_EC_DATA_INCOMPATIBLE if - applicable and use only printable representation int the error - message for numeric items that are actually printable, - otherwise use hex representation - -2018-01-28 Simon Sobisch - - * screenio.c (valid_field_data): bug #491 allow numeric edited - fields to contain all spaces, internally seen as zero - -2018-01-23 Ron Norman - - * termio.c: standardize display of -NaN and NaN for float/double - -2018-01-03 Ron Norman - * common.c,common.h: Add cob_function_return routine to - copy a FUNCTION's RETURNING cob_field to 'cob_module' - save area and return address of that - -2018-01-03 Simon Sobisch - - * numeric.c [WIN32]: fix missing definition of isnan / isinf - -2017-12-31 Ron Norman - - * fileio.c (cob_rewrite): BDB fix to allocation record area for - max record size - * common.c (cob_dump_module): flush stderr/stdout to get display output - before dump - -2017-12-27 Simon Sobisch - - * intrinsic.c (cob_mod_or_rem): fix bug #485 don't raise - EC-SIZE-ZERO-DIVIDE but EC-ARGUMENT-FUNCTION - -2017-12-26 Ron Norman - - * numeric.c: Fix bug #122 COMP-1 / FLOAT-SHORT + COMP-2 / FLOAT-LONG - to check of overflow and set SIZE ERROR condition when requested - -2017-12-25 Simon Sobisch - - * common.c (cob_check_trace_file): FR #242 allow trace file to be - appended by starting COB_TRACE_FILE with "+" - * common.c: changes to new tracing: distinguish between function and - program, trailing output is not fixed-width, only use specified spacing - * common.c (cob_trace_prep, ): distinguish between function and program - * common.c (set_config_val): FR #242 allow COB_TRACE_FILE - (and COB_CURRENT_DATE) to be changed at runtime (currently untested!) - -2017-12-23 Simon Sobisch - - * numeric.c (cob_decimal_get_field): fix bug #223 don't raise - EC-SIZE-OVERFLOW when EC-SIZE-ZERO-DIVIDE is active - -2017-12-22 Ron Norman - - * numeric.c: fixes for FLOAT-DECIMAL-16/34 data types to raise - SIZE ERROR condition when out of bounds - -2017-12-21 Simon Sobisch - - * common.c, termio.c, coblocal.h: renamed setting COBPRINTER to - COB_DISPLAY_PRINT_PIPE (with keeping an alias of COBPRINTER) and - COB_DISPLAY_PRINTER to COB_DISPLAY_PRINT_FILE - * common.c (cob_set_runtime_option, cob_get_runtime_option), common.h: - use enum cob_runtime_option_switch instead of anonymous int with - possible values as defines - -2017-12-21 Ron Norman - - * common.h: add code_is_present flag to cob_report structure - * reportio.c: output CODE value as fixed length field - (do not trim trailing spaces) - -2017-12-20 Ron Norman - - * common.h: add code_is, code_len to cob_report structure - * reportio.c: output CODE value and chop lines based on - PAGE LIMIT nnn COLUMNS - * numeric.c (cob_decimal_get_ieee64dec): Fix coding error - * numeric.c: Tidy up the cob_decimal_get/set routines - * numeric.c (cob_decimal_get_ieee64dec, cob_decimal_get_ieee128dec): - adjust the scale until the number is within the allowed max number of - digits so only if the scale is out of bounds will you get an OVERFLOW - and then ON SIZE ERROR - -2017-12-17 Simon Sobisch - - * strings.c, common.c, coblocal.h: cob_init_strings gets and stores - cob_global * as all other sources do - * call.c, common.c, fileio.c, intrinsic.c, strings.c: directly set internal - cobglobptr->cob_exception_code = 0 instead of using cob_set_exception, - fixing bug #196 - * common.c (cob_get_exception_name), coblocal.h: renamed - cob_get_exception_code / cob_get_exception_name to - cob_get_last exception_code / cob_get_last_exception_name - * common.c (cob_last_exception_is), common.h: new function to check if a - specific error group/value is set - * common.c (cob_field_to_string): check if field has data assigned - * common.c (cob_runtime_error): ensure that registered error handlers - aren't called recursive and don't change error location - * common.c (cob_fatal_error): added COB_STATUS_31_INCONSISTENT_FILENAME - and check that ASSIGN field has a value before using it - -2017-12-16 Ron Norman - - * numeric.c (cob_decimal_get_ieee64dec): fix bug #470 (coding error) - -2017-12-10 Simon Sobisch - - * fileio.c: aadjustments after merge of split/sparse keys from rw-branch - -2017-12-06 Simon Sobisch - - * common.c, common.h, reportio.c: minor adjustments after merge - of reportwriter branch - * coblocal.h, common.h: moved declarations for COB_DEBUG_LOG to common.h - and set to COB_HIDDEN instead of COB_EXTERN - * common.c, coblocal.h: disabled all parts of internal debug log - if COB_DEBUG_LOG is not defined - -2017-12-04 Simon Sobisch - - * common.c (cob_sys_system) [_WIN32]: FR #153 workaround for CALL 'SYSTEM' - on buggy Woe32 which removes first and last quote from command - -2017-11-28 Simon Sobisch - - * common.c (cob_get_current_date_and_time_from_os)[!_WIN32]: fixed #469 - ACCEPT FROM DAY being one too low - -2017-11-15 Simon Sobisch - - * common.c, common.h, coblocal.h, call.c: added (cob_init_nomain) to start - runtime initialization without setting the main handle (saves time on - each function lookup) - * call.c [COB_BORKED_DLOPEN]: no processing of mainhandle - -2017-11-07 Simon Sobisch - - * common.c, common.h, coblocal.h: added COB_SET_DEBUG as cob_debugging_mode - in local settings / global pointer - * common.c, coblocal.h: added internal configuration status option ENV_RESETS - for "needs additional code on change" - * common.c: added ENV_RESETS to COB_SET_DEBUG changing the externalized value - in cobglobtr when setting changes during runtime - -2017-11-05 Simon Sobisch - - * common.h: suppress C statement not reached warnings for Solaris C, - see bug #456 - -2017-11-02 Simon Sobisch - - * fileio.c: fixed bug #457 explicit check for error after all put/write - calls (calls to put were completely unchecked before) and raise correct - fileio status (especially 34 for disk/quota full) instead of status 30 - -2017-10-31 Ron Norman - - * common.h: Add cob_global_exception and COB_RESET_EXCEPTION - -2017-10-24 Simon Sobisch - - * common.c: changed message format back to old version, see bug #455 - -2017-10-22 Simon Sobisch - - * common.c (cob_sys_fork): bug #451 reset cob_process_id after fork - * Makefile.am: moved include of top_srcdir to AM_CPPFLAGS to prevent - user-specified CPPFLAGS to override own includes, see bug #452 - * common.c, common.h: minimal support for DJGGP, - including generation of 8.3 filenames - -2017-10-17 Ron Norman - - * common.h: add flag_debug_trace to the cob_module - * common.c: check flag_debug_trace to verify module - was compiled with -debug and/or -ftrace[all] and only - record trace information if compiled with the option - -2017-10-11 Simon Sobisch - - * common.c (cob_check_ref_mod): bug #446 splitted checks for length and - combination of offset and length - * common.c (cob_external_addr): bug #445 added suppressible warning for - EXTERNAL data items that are requested with a smaller size than allocated - * common.c (cob_check_version): FR #239: allow difference in module version - vs. runtime version - FR #239 - adjustments for changed function signatures between 2.0-rc and 2.3: - * common.c (cob_check_odo): adjustments for changed function signature - * common.c (cob_check_subscript, cob_check_version): don't check subscript - max if at least one module is too old for the current function signature - -2017-09-28 Edward Hart - - * screenio.c (cob_screen_get_all): changed backspace to emit beep if - entered at start of field, not to act like back-tab (bug #426). - -2017-09-26 Ron Norman - - * common.c,common.h: Add code for COB_FERROR_DIV_ZERO - restore code to invoke 'dump' on program abort - * numeric.c: If divide by Zero and no ON SIZE ERROR - then abort with COB_FERROR_DIV_ZERO - -2017-09-21 Simon Sobisch - - * common.c (cob_sig_handler, cob_set_signal): added code for SIGFPE - in correspondence to SIGHUP code (+ additional error message); - set LCOV_EXCL markers for most of the signal handling - -2017-09-18 Ron Norman - - * fileio.c: Check if file ASSIGN field has NULL address and report a - runtime error and return status 31 - -2017-09-16 Edward Hart - - * screenio.c (field_display): implemented DISPLAY ALL "blah" WITH SIZE - (bug #428). - -2017-09-10 Edward Hart - - * screenio.c (field_display, field_accept): fixed SIZE not working if it - was less than the item's length (bug #423). - * screenio.c: fixed naming style. - -2017-09-04 Simon Sobisch - - * screenio.c (cob_screen_get_all, field_accept): beep instead of - wrong-casting characters we currently can't store - * screenio.c (field_accept): beep on insert if field is already full - * screenio.c (cob_screen_init): set cursor depending on insert mode - to vertical bar cursor (on) or square cursor (off) - * screenio.c (cob_screen_get_all): fix for handling BACKSPACE, - added handling for DELETE and INSERT keys and COB_INSERT_MODE - -2017-08-29 Simon Sobisch - - * common.c (cob_init)[_WIN32]: only use GetUsername if HAVE_GETUSERNAME - is defined (for example in config.h) - -2017-08-27 Simon Sobisch - - * common.c: moved code to cleanup modules to cob_exit_common_modules - and do this only once (after exit handler calls, before call cleanup) - -2017-08-26 Ron Norman - - * common.c: Free the structs used to track modules on STOP RUN - -2017-08-18 Ron Norman - - * common.c: Keep list of all active modules for later free of - memory allocated for decimal constants - * common.c: cob_stop_run issue callbacks to free any decimal memory - * common.c: cob_module_enter check for Recursive CALL used in the - wrong place. Add cob_module_global_enter routine. - * common.h: Add cob_module_global_enter routine. - Add cob_stmt_exception to cob_global, used to indicate - the previous statment has ON EXCEPTION clause. - -2017-08-15 Simon Sobisch - - * common.c (cob_tidy): don't exit if runtime isn't initialized yet - -2017-08-13 Simon Sobisch - - * call.c, common.c, fileio.c, intrinsic.c, screenio.c: - surrounded code parts that cannot be tested by LCOV_EXCP markers - -2017-08-12 Ron Norman - - * common.c: cob_stop_run issue callbacks to free any decimal memory - * common.c: avoid infinite loop walking COB_MODULE list when RECURSIVE - modules are being used - -2017-08-08 Simon Sobisch - - * common.c: common.h [_MSC_VER]: moved setenv hack to inline function - * common.c, common.h: new environment functions cob_setenv cob_unsetenv - * common.h, coblocal.h: moved declaration of cob_strdup to allow it - to be called like the other memory functions - -2017-08-06 Ron Norman - - * fileio.c (cob_file_external_addr): fixed bug #404, where the - cob_file_key for a RELATIVE file was not allocated. - -2017-07-21 Simon Sobisch - - * screenio.c: moved cob_sys_get_char and added parts for !COB_GEN_SCREENIO - -2017-07-20 Simon Sobisch - - * common.h [__MINGW32__]: added missing defines - -2017-07-18 Simon Sobisch - - * common.h: increased MAX_FD_RECORD to 64MB and introduced - MAX_FD_RECORD_IDX with the old 64KB limit - -2017-07-16 Edward Hart - - * exception.def: update to COBOL 2014 and added finalizer exception. - -2017-07-12 Simon Sobisch - - * fileio.c: checked the now optional sort-return before accessing it - -2017-07-07 Edward Hart - - * common.h (COB_REPORT_*): prevent undefined behaviour caused by 1 << 31 - and fixed typos. - -2017-06-16 Simon Sobisch - - * Makefile.am: added CODE_COVERAGE parts as provided by AX_CODE_COVERAGE - * general: surrounded exception ABORTs that cannot be tested by - LCOV_EXCP markers - -2017-06-04 Ron Norman - - * common.c: Improved 'cobcrun -r' display for when - unsetenv is used in runtime.cfg to show environment variable - was removed and runtime.cfg variable was then present - -2017-05-31 Ron Norman - - * fileio.c (indexed_open) [WITH_DB]: if the first record in the file - has a size larger than the FD has defined then return status 39 - -2017-05-26 Simon Sobisch - - * system.def: replaced misleading name C$PRINTABLE (OC-extension, - not a C$ -> ACUCOBOL extension!) by CBL_GC_PRINTABLE (old name - still supported for legacy reasons) - -2017-05-24 Edward Hart - - * common.c: fixed minor style issues, mostly missing spaces around - operators. - -2017-05-22 Simon Sobisch - - * common.c: renamed cob_get_current_date_and_time to - cob_get_current_date_and_time_from_os - * common.c, coblocal.c: store datetime from COB_CURRENT_DATE as - cob_time and check for this in cob_get_current_date_and_time - instead of in every function - * common.c: allow partial replace of datetime (including offset only) - by COB_CURRENT_DATE - -2017-05-22 Ron Norman - - * termio.c (pretty_display_numeric): handle - SIGN_SEPARATE TRAILING & LEADING - -2017-05-18 Simon Sobisch - - * system.def: added maximum call parameters for system library calls - -2017-05-14 Simon Sobisch - - * fileio.c: correctly update file status for DELETE FILE statement - (we always returned 00 until now) - * fileio.c: - -2017-05-13 Simon Sobisch - - * screenio.c (cob_move): return the status returned by (move) - * screenio.c: FR #191 only set flag pending_accept when cob_move - returns no error - -2017-05-12 Simon Sobisch - - * common.c (cob_sys_oc_nanosleep): prefer HAVE_NANO_SLEEP over _WIN32 - -2017-05-11 Simon Sobisch - - * screenio.c (screen_display): FR #191 set flag pending_accept - for DISPLAY screen, too - -2017-05-02 Ron Norman - * common.c,coblocal.h: added 'cob_keycheck' to indicate if INDEXED file - keys must match exactly. Default is TRUE - * fileio.c: - Add code to handle 'keycheck' in IO_filename env var. - Added code to indexed_open for C|D|VB-ISAM files to handle keycheck - -2017-05-01 Simon Sobisch - - * common.c (cob_sig_handler, cob_set_signal): added code for SIGBUS - in correspondence to SIGSEGV code - -2017-04-28 Simon Sobisch - - * common.c (set_value, get_value): using correcting format modifier - for cob_s64_t (CB_FMT_LLD) - -2017-04-27 Ron Norman - * move.c: added 'cob_alloc_move' used to copy data for BY VALUE params - * common.c,common.h: added 'cob_get_hase_name' used to create has value - added 'cob_alloc_attr' to create working 'cob_field_attr' - * call.c: set 'cobglobptr->cob_call_from_c' & - 'cobglobptr->cob_call_name_hash' as required - -2017-04-27 Sergey Kashyrin - - * common.c (set_value, get_value): changed type long to cob_s64_t - as SORT was broken on Windows - -2017-04-23 Simon Sobisch - - * common.h: always use COB_KEYWORD_INLINE (set by configure) - for COB_INLINE - -2017-04-19 Ron Norman - - * fileio.c (indexed_read) [WITH_DB]: check that the size of a record read - is not larger than what the FD has defined, return status 43 to the READ. - * fileio.c: for the callable EXTFH interface, set f->file_version - to COB_FILE_VERSION - -2017-04-18 Ron Norman - - * fileio.c: relative_read_size returns an 'int' and not 'size_t' - * screenio.c: add (int) casts - * move.c: use 'int' instead of 'size_t' as it needs to be signed - -2017-04-18 Ron Norman - - * numeric.c, common.c, coblocal.h: define ISFINITE depending on - HAVE_ISFINITE to either use 'isfinite' or 'finite' or '_finite' - -2017-04-12 Ron Norman - - * fileio.c,common.c: - Routines which implement functions defined via 'system.def' - have been enhanced to use the C API functions to access - parameter fields passed on the CALL statement in the COBOL - application code. - -2017-04-10 Ron Norman - - * move.c, call.c, common.h: C-API - Changed 'len' variables from 'int' to 'size_t' in cob_get_picx, - cob_put_picx, cob_get_picx_param, cob_get_grp_param, cob_put_grp_param - -2017-04-10 Brian Tiffin - - * common.c, common.h: remove cob_get_prog_pointer in preference to - cob_get_pointer. - -2017-04-08 Edward Hart - - * intrinsic.c (in_last_n_chars): fixed underflow when field->size was - less than n, ultimately causing an invalid read. - * fileio.c (indexed_open): fixed minor memory leak. - -2017-04-07 Ron Norman - * common.c,coblocal.h,runtime.cfg: - Added COB_MF_LS_NULLS,COB_MF_LS_VALIDATE,COB_SHARE_MODE - & COB_RETRY_MODE to runtime.cfg - * fileio.c: - Added check for IX,SQ,RL,LS,LA_OPTIONS env var for file - I/O options when IO_fdname is not defined. - Added check for mf_ls_nulls and mf_ls_validate options - for Micro Focus compatible LINE SEQUENTIAL files - -2017-03-31 Edward Hart - - * intrinsic.c: fixed minor buffer overflows in the formatted-date - functions (see bug #357). - -2017-03-19 Simon Sobisch - - * common.c (cob_chain_setup): only set field's value if given on - command line, preserve program internal initialization otherwise - -2017-03-18 Simon Sobisch - - * common.c (cob_module_enter): set cob_call_params from argc - for main programs - * common.c (cob_chain_setup): don't set cob_call_params any more - * common.c [_MSC_VER] (cob_get_current_date_and_time): - silence wrong warning 6011 - -2017-03-12 Simon Sobisch - - * common.c: fix minor memory leaks in configuration code - -2017-02-12 Ron Norman - * common.c,common.h: - Added check to open trace file on READY TRACE - * common.h: - Added flags to FCD3 for TRACE & STATS - * fileio.c: - Added code to invoke trace and/or stats for EXTFH usage - If -ftraceall not used, then open trace_file when defined - and the file had 'trace_io' set true - -2017-02-07 Simon Sobisch - - * screenio.c: [!COB_GEN_SCREENIO] fixed zero_line_col_allowed - missing / superfluous in function declarations - -2017-02-07 Ron Norman - * common.c,common.h,coblocal.h: - Added COB_STATS_RECORD & COB_STATS_FILE to runtime.cfg - * fileio.c: - Added stats code to save_status. - Added check for IO_fdname and check for 'stats' option - -2017-02-07 Ron Norman - * common.c,common.h,coblocal.h: - Added COB_TRACE_IO to runtime.cfg - * termio.c: - Added cob_print_field to be used by fileio Trace code - * fileio.c: - Added trace code to save_status. - Added check for IO_fdname and check for 'trace' option - -2017-02-06 Ron Norman - - * common.c, common.h: - added cob_module_free so that structure gets freed within libcob - * fileio.c, common.h: - Added new routines cob_file_external_addr, cob_file_malloc, cob_file_free - so that 'cob_file' is allocated within libcob. - This will allow the stucture have fields added to the end - without forcing a recompile. - -2017-02-05 Simon Sobisch - - * common.c, common.h, call.c: [__MINGW32__] fixes for mixed printf - format modifiers for long long - * common.c: [WIN32] check if PROCESS_QUERY_LIMITED_INFORMATION is - actually defined (not the case for MINGW and old VC versions) - -2017-02-01 Ron Norman - - * common.c, common.h: - Corrections to routines for handling -ftrace, -ftraceall & -fdump=ALL - -2017-01-30 Ron Norman - - * termio.c: for -fdump=ALL,IO; Dump FILE STATUS value - -2017-01-25 Ron Norman - - * common.c, common.h, coblocal.h, termio.c: - New routines for handling -ftrace, -ftraceall & -fdump= - -fdump= causes code to be generated that will dump out data - variables in the event of a program abort or abnormal end - New runtime.cfg/env-vars: - COB_DUMP_FILE, COB_DUMP_FORMAT, COB_DUMP_WIDTH - The old trace routines have been kept for backward compatible - -2017-01-18 Ron Norman - - * call.c (cob_get_param_type): added check for COB_FIELD_REAL_BINARY - -2017-01-17 Ron Norman - - * call.c: added code to handle default data field types by using cob_move - * move.c: added missing cob_put_s64_compx routine - -2017-01-10 Simon Sobisch - - * common.c: Copyright year 2017 - -2017-01-10 Ron Norman - - * move.c, call.c, common.h: New routines added to provide - application C code access to COBOL data fields. - -2017-01-09 Simon Sobisch - - * common.h, common.c (cob_check_subscript): corrected minimum check - -2017-01-05 Simon Sobisch - - * screenio.c (field_accept): don't write anything on the screen for - ACCEPT OMITTED - -2017-01-02 Simon Sobisch - - * common.c, common.h: new exported function cob_raise to raise a signal, - running both external and internal signal handlers - * termio.c (cob_accept_field): handle input code of ctrl-C as termination - command and cob_stop_run with 128 + 2 (fatal error 2) - * coblocal.h, common.h: move (cob_get_current_date_and_time) and - its data definition cob_time from coblocal.h to common.h - * common.c [_MSC_VER]: moved initialization of function pointer to - (get_function_ptr_for_precise_time), for call in - (cob_get_current_date_and_time) - * common.h: extended cob_time with is_daylight_saving_time and day_of_year - * common.c [_BSD_SOURCE]: get utc_offset directly from tm_gmtoff - -2017-01-01 Ron Norman - - * fileio.c (cob_read_next): change to return 46 on 2nd read on an optional - missing file, removed some redundant code - * fileio.c [WITH_DB]: moved call to join_environment to indexed_open - -2016-12-30 Ron Norman - - * fileio.c,common.h - Complete work on BDB use of SHARING & RETRY - Problems solved by closing BDB cursor as soon/often as possible - as the BDB cursor seems to create some internal locks - Retry interval reduced to 100ms - - * INDEXED file test case added and uses a file to synchronize tests - * RELATIVE file test case added and uses a file to synchronize tests - -2016-12-27 Simon Sobisch - - * common.h: added COB_MAX_UNBOUNDED_SIZE - * common.c (cob_allocate): check for COB_EC_STORAGE_IMP - returned when requested to allocate more than the maximum possible size - * common.h, common.c (cob_check_odo, cob_check_subscript): additional - parameters for table name in DEPENDING ON and flag for ODO, additional - runtime error line with the (current) maximum of the table - -2016-12-26 Simon Sobisch - - * screenio.c, common.h: C interface addons including FR #187: - typedef cobchar_t, (cob_set_cursor_pos) / cobmove to set cursor position, - (cob_display_text) / cobaddstrc to display text at current cursor pos., - (cob_display_formatted_text) / cobprintf to printf to current cursor - position, (cob_get_char) / cobgetch to get a single character or - function key, (cob_get_text) to get a text input and function keys with - a given size from current cursor position - * screenio.c, common.h, system.def: added system routine - CBL_PUT_SCR_POS / cob_sys_put_scr_pos to set the cursor position - and for compatibility: CBL_READ_KBD_CHAR / cob_sys_get_char to get - a single character (better use ACCEPT one-byte-var) - * common.c, common.h, coblocal.h, screenio.c: FR #191 added runtime - configuration COB_EXIT_WAIT and COB_EXIT_MSG for waiting if - extended ACCEPT after last extended DISPLAY (if any) is missing - -2016-12-24 Ron Norman - - * fileio.c,common.c,common.h,coblocal.h - Extensive updates for fileio.c to handle OPEN SHARING - and RETRY clauses on all I/O statements. - Relative files use sigaction/alarm/fcntl to wait for - record locks. - C/D/VB-ISAM files use the ISAM handle functions combined with - a wait/retry loop. each loop happens at 125ms interval. - BDB code updated to use none deprecated functions, use some - subroutines instead of inline code and changes for SHARING/RETRY - - * At present there are no test cases but these will come in a while - I need to come up with a better way to synchronize separate - processes so I can reliably recreate the test cases - -2016-12-23 Simon Sobisch - - * screenio.c (field_accept): changes for ACCEPT OMITTED: - return COB-SCR-KEY-LEFT and COB-SCR-KEY-RIGHT, additional return - the new keycodes COB-SCR-INSERT, COB-SCR-DELETE, COB-SCR-BACKSPACE, - COB-SCR-KEY-HOME, COB-SCR-KEY-END (*only* for ACCEPT OMITTED!) - -2016-12-22 Simon Sobisch - - * fileio.c: include isconfig.h (if not available define DISAM_NO_ISCONFIG) - and don't use isstat1/isstat2 if not available - -2016-12-20 Simon Sobisch - - * common.h: added compatibility define for cobclear and corrected - cobrescanenv to always return zero. - -2016-12-18 Ron Norman - - * fileio.c (lock_record, test_record_lock): initialize DBT structure - before using it to prevent memory corruption - -2016-12-08 Simon Sobisch - - * common.c (print_info): FR #169 output exact versions of GMP/MPIR and - BDB that were used for building libcob and the versions that are in - the loaded libraries if they differ, add output of curses_version() - * common.c (var_print): fixed empty/zero string - -2016-12-05 Simon Sobisch - - * common.c, coblocal.h (cob_strcat): fixing minor memory leak by adding a - third parameter which should be set if the result is assigned to one of - the original strings - -2016-12-02 Ron Norman - - * fileio.c,common.h - Changes to use error status 51 for record locked and - 52 for DeadLock instead of 61 for both. 62 is used for - file sharing errors on OPEN of the file - -2016-11-30 Ron Norman - - * fileio.c,common.c,common.h - Compiler updated for handling the SHARING, RETRY, ADVANCING LOCK - and IGNORE LOCK phrases, Mainly for RELATIVE files now. - This is a 'work in progress' and more updates will follow to include - support for INDEXED and SEQUENTIAL files - -2016-11-19 Simon Sobisch - - * common.c (cob_sys_fork, cob_sys_waitpid): don't abort if necessary - functions aren't available on the sysytem or fail, return -1 or - the system specific error code instead - * common.c (cob_sys_waitpid): added [_WIN32] implementation - -2016-11-17 Ron Norman - - * common.c, common.h, system.def: added cob_sys_fork for CBL_GC_FORK - (fork a new COBOL process) and cob_sys_waitpid for CBL_GC_WAITPID - (wait for completion of another process) - * system.def: Add CBL_GC_xxx as alias for CBL_OC_xxx - -2016-11-15 Ron Norman - - * fileio.c ((cob_sys_open_file, cob_sys_create_file)): - removed #ifdef WORDS_BIGENDIAN, as literal parameters are - now passed as PIC S9(9) BINARY - -2016-11-13 Simon Sobisch - - * common.c, coblocal.h, fileio.c: moved common code parts of fileio.c as - function (cob_runtime_warning) to common.c ; - reformatted message and include source location, if known - * call.c (cob_call_field): warn and remove leading spaces for CALL - -2016-10-31 Simon Sobisch - - * call.c (cob_call): fr #101 - allow more parameters for CALL: - renamed COB_MAX_FIELD_PARAMS to MAX_CALL_FIELD_PARAMS (set in configure), - allowed additional options 192 and 252, new default: 192 - -2016-10-29 Simon Sobisch - - * common.c: check "COB_UNIX_LF" before error COB_FERROR_INITIALIZED - -2016-10-27 Simon Sobisch - - * fileio.c: added COB_UNUSED() for parameters of indexed file functions - when configured --without-db - -2016-10-15 Simon Sobisch - - * common.h: re-fixed COB_ONCE for MSC - * system.def: replaced octal by hex strings for hex-system routines - -2016-11-07 Ron Norman - - * move.c, common.h: added cob_move_ibm function for 'move-ibm' - -2016-10-13 Ron Norman - - * numeric.c, common.h: added cob_decimal_align function for 'arithemtic-osvs' - -2016-10-02 Ron Norman - - * common.c: report time in COB_DEBUG_LOG for performance test - * reportio.c: fixed scan for changed fields to be faster - -2016-10-02 Edward Hart - - * common.h: added cob_flags_t typedef for variables made of bit flags. - -2016-09-19 Ron Norman - - * numeric.c: added cob_decimal_clear - -2016-08-24 Edward Hart - - * common.c (cob_get_current_date_and_time): fixed bug where milliseconds - where confused with nanoseconds. - -2016-08-20 Simon Sobisch - - * common.c, common.h: new routine (cob_is_initialized) - * common.c (cob_module_enter): activated storing module call parameters - on module entry - -2016-08-16 Edward Hart - - * screenio.c (field_accept): fixed bug #300 (segfault on screen ACCEPT - OMITTED). - -2016-08-01 Simon Sobisch - - * common.c (cob_runtime_error): reversed the prefix from runtime errors, - always starts with "libcob: " now - * common.c (cob_get_strerror): own reentrant version of strerror - * common.c (cob_load_config_file): use cob_get_strerror instead of - a guessed error message - -2016-07-31 Simon Sobisch - - * common.c (cob_reg_sighnd): call cob_set_signal() if not done already - -2016-07-29 Simon Sobisch - - * coblocal.h: changed types in config_tbl to unsigned (compiler warnings) - * common.h [_MSC_VER]: added definitions for COB_NOINLINE, COB_A_INLINE - -2016-07-17 Edward Hart - - * screenio.c: added support for LINE/COL 0. - * screenio.c: fixed small issues with DISPLAY ALL X"02" and X"07". - -2016-06-26 Simon Sobisch - - * common.h, coblocal.h: moved internal functions to coblocal as COB_HIDDEN - * common.h: added COB_EXPIMP to cob_set_exception - * common.c, coblocal.h: #ifdef 0 for unused helper functions - cob_int_to_string and cob_int_to_formatted_bytestring - -2016-06-26 Edward Hart - - * common.c, common.h, move.c, string.c: moved cob_max_int and cob_min_int - to common.c. - -2016-06-26 Simon Sobisch - - * common.c, common.h: minor fixes for compatibility to VC2005 - -2016-06-20 Ron Norman - - * common.h: added some COB_CHAR_xxx to define some characters - * fileio.c: for LINE SEQUENTIAL files with COB_LS_VALIDATE = true - changed bad data error from 30 to 34 - Also allow some characters thru such as BS, FF, TAB, ESC, SI - No data validation is done for LINE ADVANCING output files - -2016-06-20 Ron Norman - - * coblocal.h, common.c: FR #138 identify config variables which accept - a path list and any which only accept a single directory/file - are checked for the PATH_SEP character and error is given if - that has been used by mistake. Example: - - Invalid value '/temp:/tmp' for configuration tag 'COB_TRACE_FILE'; - should not contain ':' - -2016-06-18 Simon Sobisch - - * general: revised all message strings - * screenio.c: added (cob_get_scr_cols) and (cob_get_scr_lines) for - providing the C interface with the current COBOL screen cols/lines - * common.h: FR #145: added defines for cobcols, coblines and cobrescanenv - * common.c, common.h: FR #126: renamed (runtime_env) to (runtime_conf) - -2016-05-27 Edward Hart - - * move.c (cob_move_display_to_edited): fixed bug #220 - fixed insertion - which float are now distinguished from those which don't. - -2016-05-22 Edward Hart - - * common.h, move.c, termio.c: replaced PICTURE strings containing packed - ints with array of (cob_pic_symbol) structs which are easier to use. - -2016-05-01 Ron Norman - - * common.c fixed incorrect reporting of error for undefined environment variables - -2016-04-26 Brian Tiffin - - * common.c, common.h: Re-fixed CBL_OC_HOSTED tzname, timezone, daylight - for VC2013 names. - -2016-04-25 Brian Tiffin - - * common.c: Fixed CBL_OC_HOSTED tzname, timezone, daylight for WIN32 names. - -2016-04-23 Brian Tiffin - - * common.h, numeric.c: 64bit unsigned treated as signed when long int - same size as long long. - -2016-04-22 Ron Norman - - * common.h, reportio.c: support features of an IBM REPORT WRITER - PRESENT AFTER & ABSENT AFTER - -2016-04-06 Brian Tiffin - - * common.c: Updated CBL_OC_HOSTED with tzname, timezone, daylight. - -2016-03-29 Edward Hart - - * common.c (cob_set_exception), common.h, coblocal.h: made cob_set_ - exception a public function for SET LAST EXCEPTION TO OFF. Also made - argument of 0 reset all exception information. - -2016-03-28 Brian Tiffin - - * common.c, common.h, system.def: Added CBL_OC_HOSTED - feature-request #49. - -2016-03-23 Edward Hart - - * intrinsic.c (numval): added missing NUMVAL-C-specific code I missed in - r793, causing bug #218. - -2016-03-21 Simon Sobisch - - * common.c (cob_set_location, cob_trace_section, cob_exit_common): fix for - bug #216 - store a duplicate of cob_last_sfile for tracing, free on exit - -2016-04-16 Ron Norman - - * common.c report error for undefined environment variables - -2016-03-15 Ron Norman - - * common.c: display COB_PRE_LOAD as set and as evaluated - * call.c: clear COB_PRE_LOAD value before evaluating - -2016-03-13 Simon Sobisch - - * intrinsic.c (locale_time): consolidation still used sizeof(buff) after - buff changed from char [] to char *, fixed by introducing LOCTIME_BUFSIZE - * intrinsic.c (cob_intr_lcl_time_from_secs) re-added missing exception - -2016-03-12 Edward Hart - - * intrinsic.c: consolidated copy-and-pasted code in numerous functions, - including: SUBSTITUTE(-CASE), NUMVAL(-C), VARIANCE and - LOCALE-TIME(-FROM-SECONDS). - * intrinsic.c: renamed "xqtyear" variables to "current_year". - -2016-03-07 Ron Norman - - * fileio.c: fixed EXTFH to save/restore 'opts' value for some - READ/WRITE operations. Without this it was not writing LF - at end of line sequential records - -2016-02-21 Simon Sobisch - - * common.c (set_config_val): removed use of cob_strcat for output of - possible values - -2016-02-17 Edward Hart - - * screenio.c (set_default_line_column): fixed bug #202 where screens - were displayed at the cursor position when no LINE or COL was given. - -2016-02-01 Ron Norman - - * fileio.c: fixed to call cob_set_exception for the EXTFH interface - -2016-01-31 Simon Sobisch - - * intrinsic.c (split_around_t): fixed stack overflow occuring in wrong - date/datetime format strings for FUNCTION TEST-FORMATTED-DATETIME - * intrinsic.c: changed definition of string lengths for date/time - according to existing ones (COB_xyz_BUFF) - * common.h [_MSC_VER]: adding alias for setenv/unsetenv fixing small memory - leak for calls of (putenv) - MSC duplicates the string, POSIX does not - -2016-01-30 Simon Sobisch - - * general: fixing all warnings generated by msc code analysis - (possible memory related issues) - * common.c (cob_rescan_env_vals): always remove invalid settings from env. - * common.c (cob_realloc): new, combining cob_malloc, cob_free and memcpy - * common.c (cob_get_current_date_and_time) [_MSC_VER]: use fallback - to GetLocalTime if calls to FileTimeToSystemTime or - SystemTimeToTzSpecificLocalTime return an error - * common.c (print_version): changed generation of build stamp - * common.c (cb_config_entry): corrected check for setting without value - and postponed it, doing the check for a valid setting name before - * cobgetopt.c (cob_getopt_long_long): Fix bug #194 and warnings of msc code - analysis (possible memory issues) - switched from alloca to cobc's - internal memory handling (cobc_malloc and cobc_free) - -2016-01-24 Edward Hart - - * screenio.c: fixed bug #160 - added support for variable screen origin. - -2016-01-23 Edward Hart - - * screenio.c (cob_screen_attr): fixed bug #192 - stopped ERASE and BLANK - being applied in ACCEPT statements. - -2016-01-17 Edward Hart - - * screenio.c (get_screen_item_line_and_col): simplified and improved to - make interpretation of LINE and COL clauses more similar to that of - other implementations. - -2016-01-08 Simon Sobisch - - * call.c (cob_call): fr #101 - allow more parameters for CALL - (COB_MAX_FIELD_PARAMS to be one of 16/36/56/76/96) - -2016-01-01 Ron Norman - - * common.c (cob_set_runtime_option, cob_get_runtime_option), common.h, - coblocal.h, termio.c: added cob_set_runtime_option / cob_get_runtime_option - to allow TRACE and/or DISPLAY UPON PRINTER output to be redirected - to a specific (FILE*) - -2015-12-31 Edward Hart - - * common.h: added COB_SCREEN_GRID. - -2015-12-30 Edward Hart - - * screenio.c: fixed bug #176 - added code to correctly find the line and - column of a screen item. - * common.h: changed cob_screen to a doubly linked list (to simplify the - algorithm required above). - -2015-12-24 Edward Hart - - * intrinsic.c: added SYSTEM-OFFSET and support for unknown offsets for - FORMATTED-(DATE)TIME. - -2015-12-24 Edward Hart - - * screenio.c: implemented FULL and REQUIRED clauses. - -2015-12-14 Brian Tiffin - - * numeric.c (cob_print_realbin): bug #171 - unsigned values fail with high bit set - -2015-12-07 Edward Hart - - * common.c (cob_get_current_date_and_time): fixed bug where offset_known - was not set to 1 on Unix systems. - -2015-12-07 Edward Hart - - * intrinsic.c: fixed bug #170 - added detection of whether offset_known - is true or not - and added detection of EC-IMP-UTC-UNKNOWN exception. - * exception.def: added EC-IMP-UTC-UNKNOWN. - -2015-12-05 Edward Hart - - * intrinsic.c: added support for optional offset parameter for - FORMATTED-(DATE)TIME functions (defaults to zero). - -2015-12-03 Edward Hart - - * intrinsic.c: fixed bug #169 - added correct implementation of times - ending with Z (i.e. to return the UTC time). - -2015-11-08 Simon Sobisch - - * intrinsic.c (cob_intr_current_date): bug #164 - offset for CURRENT-DATE - -2015-10-28 Simon Sobisch - - * common.c (cob_check_linkage): add function for check of linkage items - (currently checking only access to not passed OPTIONAL items) - -2015-10-25 Simon Sobisch - - * common.c (cob_init)[WIN32]: resolve COB_UNIX_LF before reading runtime - configuration as error messages would have wrong LF otherwise - -2015-10-24 Simon Sobisch - - * common.c (conf_runtime_error): add function for configuration specific - errors and tweaked the messages - * common.c (set_config_val): added possible values for gc_conf.enums - to error messages; added check of maximum values for ENV_SIZE - * common.c (cob_load_config_file): if include file is not found prefix - it with path of current loaded configuration file - * common.c: tweaked output for --runtime-env and added function - (set_config_val_by_name) for overriding default values (used for USERNAME) - -2015-10-25 Edward Hart - - * screenio.c: fixed bug #161 - fixed screens terminating when the number - of characters entered equalled the length of the first field. - * screenio.c: added a few comments and shortened some code. - -2015-10-17 Edward Hart - - * intrinsic.c: fixed bug #159 - added conversion from 1-based to 0-based - coordinates for case where only LINE clause is given on - ACCEPT/DISPLAY. - -2015-10-10 Simon Sobisch - - * common.c [WIN32][MINGW]: tweaking of additional environment settings - -2015-10-10 Ron Norman - - * common.c: added code to report additional environment settings - -2015-10-06 Edward Hart - - * intrinsic.c: fixed bug #158 - fixed TEST-FORMATTED-DATETIME rejecting - October (month #10). Also fixed unreported bug where - TEST-FORMATTED-DATETIME rejected dates followed by whitespace. - -2015-09-21 Simon Sobisch - - * common.h: cast PATHSEPC PATHSEPS SLASH_INT SLASH_STR with appropriate type - and rename the first three to PATHSEP_CHAR PATHSEP_STR SLASH_CHAR - -2015-09-16 Ron Norman - - * fileio.c: fixed coding error related to support for EXTFH - It was returning the index number as 1 relative instead of 0 relative - -2015-08-21 Edward Hart - - * screenio.c: implemented LOWLIGHT. - -2015-08-20 Edward Hart - - * screenio.c: added detection of EC-SCREEN-LINE-NUMBER, - EC-SCREEN-STARTING-COLUMN and EC-SCREEN-ITEM-TRUNCATED. - * screenio.c, common.h: refactored functions implementing ACCEPT and - DISPLAY. - -2015-07-25 Simon Sobisch - - * call.c (cob_init_call): Don't add the current directory "." to resolve_path - if it's already set (either via runtime configuration or default value) - -2015-07-07 Ron Norman - - * DISPLAY ... UPON PRINTER can be redirected via - the env var COBPRINTER similar to what Micro Focus supports - cob_display will do a popen of whatever COBPRINTER is defined - In addition COB_DISPLAY_PRINTER can be used as a file name and - cob_display will do an fopen "a" and append to that file - termio.c, common.c changed - * fileio.c fixed to avoid core dump when COB_SYNC and using BDB - -2015-07-07 Ron Norman - - * Accept env var COB_CURRENT_DATE/COB_DATE and runtime.cfg current_date - to specify a date override for the application. - All ACCEPT FROM DATE, DAY, TIME will the use the value defined - rather than the current system time. - This will be a useful feature for application testing. - * common.c (cb_config_entry): keyword "reset": reset data pointer in gc_conf - * common.c (cob_expand_env_string): copy SPACE, LR, CR, HT, VT as spaces, - the first implementation dropped them completely - * fileio.c fixed to avoid core dump when COB_SYNC and using BDB - -2015-06-24 Edward Hart - - * intrinsic.c: bug #140 - changed pow to int_pow to avoid rounding - errors. On MinGW, pow (10, 8) rounded to 9999999 instead of 10000000, - for example. - -2015-06-22 Luke Smith - - * screenio.c: Add or enhance special keys to Extended ACCEPT. - Insert, Tab, Shift-Tab, Backspace, Delete, Alt-Delete, End, - Alt-End, Home, Alt-Home, Left-arrow, Alt-Left-arrow, - Right-arrow, Alt-Right-arrow. - -2015-06-08 Luke Smith - - FR #37 - Added WITH SIZE to extended ACCEPT and DISPLAY - * common.h (cob_field_accept, cob_field_display): new signature - * screenio.c (cob_field_accept, cob_field_display): - additional parameter to specify size to use for ACCEPT/DISPLAY - * termio.c (cob_accept, cob_display): adjusted for new signature - of cob_field_accept and cob_field_display - -2015-06-21 Edward Hart - - * common.c: fixed segfault caught in updated SWITCH test by extending - cob_switch array by 1. - -2015-05-18 Luke Smith - - * screenio.c (cob_screen_attr): Fix bug #143 WITH BLANK SCREEN / BLANK LINE - has to color the whole screen / line. - -2015-05-16 Simon Sobisch - - * common.c: fr #65 added more switches "SWITCH-16" to "SWITCH-36" - -2015-05-14 Simon Sobisch - - * common.c (cb_config_entry): remove redundant aliases !copy/(un)set/!anything - * common.c: add ACUCOBOL configuration aliases LOGICAL_CANCELS - (= !COB_PHYSICAL_CANCEL) and STRIP_TRAILING_SPACES (= !COB_LS_FIXED) - -2015-05-12 Simon Sobisch - - * common.c (cob_load_config_file, cob_load_config): respect environment - COB_CONFIG_DIR when loading runtime configuration - -2015-05-12 Ron Norman - - * common.c: changed to be more specific about acceptable values for - runtime boolean options - -2015-05-11 Simon Sobisch - - * intrinsic.c (cob_intr_current_date): return field with size of 21 - and without trailing NULL - -2015-05-06 Simon Sobisch - - * common.h, coblocal.h, call.c, common.c: fixed CALL after physical CANCEL - by moving physical_cancel (defined in call.c and referenced via - runtimeptr) to cobglobptr->cob_physical_cancel for check in COBOL modules - -2015-04-30 Ron Norman - - * common.h, change cob_file record_off to type cob_s64_t (from off_t) - so that the size does not change depending on C comppiler - This is most likely the cause of the previous issue. - -2015-04-29 Ron Norman - - * reportio.c: change to allocate larger size data area for temp - fields used for CONTROL breaks. This is a cludge to avoid - something that is clobbering free memory on SUN system. - It did work fine on x86 Linux so watch out for this later. - -2015-04-27 Ron Norman - - * common.c fileio.c common.h - updated to support Micro Focus format files. - fileio.c also check for environment variable - IO_filename that can speficy options for just the one file - New runtime option (mf_files) to set all files to default - to Micro Focus format - -2015-04-14 Ron Norman - - * reportio.c common.c: - updated to include support REPORT COLUMN LEFT/RIGHT/CENTER - Also REPORT: PLUS, STEP on OCCURS and multi COLUMN numbers - Runtime option: col_just_lrc if set to false will disable - justification of LEFT/RIGHT/CENTER data with the field - -2015-04-14 Ron Norman - - * fileio.c, common.h: updated to include support to a callable - EXTFH interface provided by several compilers including Micro Focus - This allows users to insert an external file handler while retaining - all of the normal COBOL I/O functions. - -2015-04-14 Simon Sobisch - - * cobgetopt.c (_getopt_initialize): re-added support for GNU extensions - '+'/'-' in optstring[0], '+' => forcing POSIX correct behaviour (stop at - first non-option), '-' => report non-options as argument of option code=1 - -2015-04-02 Edward Hart - - * intrinsic.c: implemented FORMATTED-CURRENT-DATE, - INTEGER-OF-FORMATTED-DATE and TEST-FORMATTED-DATETIME - * intrinsic.c: updated FORMATTED-DATETIME and FORMATTED-TIME to support - fractional number of seconds. - * common.c: refactored (cob_accept_time) - * intrinsic.c: miscellaneous refactoring and deleted precondition - comments which are currently just cluttering the code - -2015-04-02 Edward Hart - - * common.h: added new macros COB_USE_VC(2005/2008/2013)_OR_GREATER to - replace _MSC_VER comparison - -2015-03-30 Simon Sobisch - - * common.h: Changed COB_FILE_MODE to 0666 - * fileio.c: use COB_FILE_MODE as permission for all cases where - files are possibly created (fixes bug #126) - -2015-03-14 Ron Norman - - * common.c: new code for table driven processing of runtime.cfg - (runtime configuration) file and environment variables - New cob_settings structure used to store all run-time options - The old runtime_env was removed - call.c cobgetopt.c fileio.c intrinsic.c move.c numeric.c screenio.c - all updated to work with the new cob_settings structure - -2015-03-10 Simon Sobisch - - * common.c (cob_load_config, cob_load_config_file, cb_config_entry): new - functions for loading a runtime configuration file - * call.c, common.c, intrinsic.c, numeric.c: fix segfault on early exit - during runtime initialisation - -2015-03-03 Ron Norman - - * common.c (cob_sys_getopt_long_long): fix ENDIAN problem with CBL_GC_GETOPT - * fileio.c (cob_sys_create_file, cob_sys_open_file): - fix ENDIAN problem with CBL_CREATE_FILE, CBL_OPEN_FILE - * fileio.c, common.c, common.h updated to resolve little endian - versus big endian issues - -2015-03-01 Ron Norman - - * fileio.c updated to return correct status codes for WRITE/REWRITE - related to duplicate keys being detected - This was tested with BDB, D-ISAM and VB-ISAM 2.1.1 - -2015-02-26 Simon Sobisch - - * cobgetopt.c (cob_getopt_long_long): List all ambiguous possibilities, - applied patch of Ulrich Drepper (see glibc's BZ #7101 - 2011-05-15) - * cobgetopt.c: removed \n from msgids, converted all backtick to apostrophe - -2015-02-26 Edward Hart - - * screenio.c: fixed buffer overflow in screen section ACCEPT - -2015-02-26 Ron Norman - - * fileio.c [WITH_VBISAM, VB_RTD]: updated to handle VB-ISAM 2.1.1 - * fileio.c [WITH_DB]: handle sparse and split keys for BDB - This was tested with BDB, D-ISAM, VB-ISAM 2.0 and VB-ISAM 2.1.1 - -2015-02-23 Ron Norman - - Implemented INDEXED file support for sparse and split keys FR #23 + FR #281 - * fileio.c: updated to handle sparse and split keys - This was tested with D-ISAM and VB-ISAM 2.0 - -2015-02-18 Ron Norman - - * common.c (cob_debug_logger): if fmt starts with '~' then force print of line# - * reportio.c: Fix spacing problems related to CONTROL FOOTING - -2015-02-16 Ron Norman - - Implemented DEBUG logging for Compiler developers - * common.h: added DEBUG_xxx macros - * common.c: added cob_debug_xxx subroutines - * reportio.c: updated to use this new COB_DEBUG_LOG feature - -2015-02-12 Ron Norman - - * Merged Report Writer code into 2.0 code base to create a new 2.0 - with all collective features - -2015-01-31 Edward Hart - - * common.h, intrinsic.c: updated (cob_valid_time_format) and - (cob_valid_datetime_format) to take the decimal point as a parameter - to handle DECIMAL-POINT IS COMMA - -2015-01-12 Sergey Kashyrin - - * intrinsic.c: Fix for Bug #120 - Function CURRENT-DATE - -2014-12-11 Ron Norman - - * reportio.c: Corrected to handle processing of a single DETAIL line - (It had been incorrectly processing all DETAIL lines of report) - -2014-12-11 Simon Sobisch - - * screenio.c (cob_exit_screen): check cobglobptr for early errors, - especially in case of runtime error "cob_init() has not been called" - -2014-11-17 Philipp Böhme - - * call.c (do_cancel_module): bugfix for cancel, - The bug was a crash in some situations, if the same module - is cancelled more than once. (Solution as suggested by Sergey) - -2014-09-17 Edward Hart - - * intrinsic.c: implemented (cob_intr_formatted_date), - (cob_intr_formatted_datetime) and (cob_intr_formatted_time) - * intrinsic.c: moved common date/time checks into functions - (valid_integer_date), (valid_year) and (valid_time) - * intrinsic.c: split main algorithms of (cob_intr_day_of_integer) and - (cob_intr_date_of_integer) into (day_of_integer) and (date_of_integer) - * common.c, common.h: added date/time format validation functions - (cob_valid_date_format), (cob_valid_datetime_format) and - (cob_valid_time_format) - -2014-09-12 Simon Sobisch - - * numeric.c, intrinsic.c, common.h: use cob_gmp_free in intrinsics, too - -2014-09-09 Philipp Böhme - - * numeric.c: new static function cob_gmp_free - * numeric.c (cob_decimal_set_double, cob_decimal_get_packed, - cob_decimal_get_display): use cob_gmp_free() to free memory allocated in - mpir/gmp - -2014-09-04 Simon Sobisch - - * common.c (cob_check_env_false): new pendant to cob_check_env_true, - currently used only for disabling COB_BELL - -2014-08-24 Simon Sobisch - - * common.c (cob_sys_getopt_long_long): make params lo_size(1), so_size(0) - and opt_val_size(5) optional (can be OMITTED in CALL 'CBL_OC_GETOPT') - -2014-09-03 Philipp Böhme - - * common.c, common.h: added cob_free() function (as suggested by - Sergey Kashyrin) - * changed all free() to cob_free() (Own freeing function for debugging - purposes. (e.g. to locate heap crashes caused by malloc/free)) - * numeric.c: use free function (passed by mp_get_memory_functions) (Bug #91) - -2014-08-05 Louis Krupp - - * screenio.c: compilation fails if configured without curses (bug #90) - -2014-07-09 Philipp Böhme - - * fileio.c (cob_file_sort_giving): initialize record buffer size before - cob_copy_check, solving bug #66 - -2014-06-30 Simon Sobisch - - * common.c, common.h (cob_temp_name): new function, moved from - cobc (cobc_temp_name) - * common.c (cob_temp_name) [_WIN32]: Use direct calls to getenv instead of - additional calling WINAPI for temporary folder (GetTempPath); - use identical logic as in non-win environments to build the name instead - of calling WINAPI (GetTempFileName+DeleteFile) - * fileio.c: renaming (cob_tmpfile) to (cob_srttmpfile) and - (cob_get_temp_file) to (cob_get_sort_tempfile) - * fileio.c (cob_srttmpfile): using new (cob_temp_name) to get the name - * common.c: use (cob_sys_getpid) everywhere instead of (getpid); - use (setenv) if available - -2014-06-17 Ron Norman - - * parser.y, tree.c, codegen.c: Added check to verify PAGE LIMITS of report - -2014-06-14 Ron Norman - - * parser.y: Fixes for LINE|COL 0 to get error message - -2014-05-20 Philipp Böhme - - * call.c: inverted preload list for WIN32 builds - * common.c, move.c, screenio.c, fileio.c: Set runtime switch - from environment to true on "1", "Y", "YES", "TRUE", "ON" - -2014-05-13 Ron Norman - - * numeric.c: added cob_cmp_float with tolerance for equality comparison - -2014-05-07 Ron Norman - - * move.c: replaced memcpy by memmove - -2014-05-06 Philipp Böhme - - * common.c, common.h: Added print_runtime_env showing all environment values - along with resolved variables used in libcob - New string helper functions: cob_int_to_string, cob_strcat, cob_strjoin, - cob_int_to_formatted_bytestring - * call.c: Remove duplicates when resolving COB_LIBRARY_PATH - -2014-04-25 Ron Norman - - * move.c: fixed bug in cob_move_fp_to_fp() - * numeric.c: Fixed errors in cob_add_int() when computing with floats. - -2014-04-14 Philipp Böhme - - * common.c, common.h, system.def: Added cob_sys_getopt_long_long - * makefile.am: Added cobgetopt.c, cobgetopt.h - -2014-03-10 Simon Sobisch - - * common.c: support for user-defined LOCALEDIR via environment - -2014-03-03 Simon Sobisch - - * common.c, common.h: Rewriting cob_sig_handler, printing caught signal to - stderr, adding cob_reg_sighnd for registration of external signal handling - -2014-01-17 Ron Norman - - * intrinsic.c: Change cob_intr_random to correctly compute RANDOM number - -2013-12-26 Luke Smith - - * strings.c: Fix Unstring delimited by all delimiter size > 1 issue, - see bug #54. - -2013-11-18 Ron Norman - - * Report Writer Module initial development - -2013-??-?? Sergey Kashyrin - - * fileio.c: Bugfix in cob_sys_copy_file (now using file_open_buff) - -201?-??-?? Sergey Kashyrin - - * fileio.c (cob_new_item): cleanup - -2012-06-21 Sergey Kashyrin - - * numeric.c: Workaround optimizer bug - -2010-10-18 Simon Sobisch - - * screenio.c (!COB_GEN_SCREENIO): Make cob_sys_sound_bell usable via - cob_speaker_beep - * common.c: Add possibility to disable the bell via - COB_BELL=NO/NONE/0/OFF (currently only the first char is checked) - -2010-09-03 Simon Sobisch - - * screenio.c: Added cob_convert_key for converting keys according to used - libraries (especially fix for PDCurses + numpad support) - -2010-06-28 Roger While - - * MARK - Version 2.0 - * Move to GPL/LGPL 3 - -2010-05-18 Simon Sobisch - - * strings.c: Fixing cob_unstring_into bug (#139) - -2010-03-10 Simon Sobisch - - * common.c, screenio.c: New env var COB_BELL for controlling WITH BEEP, - possible values (standard BEEP): - BEEP (curses beep on soundcard/pc-speaker, fallback terminal flash) - FLASH (curses terminal flash, fallback beep on soundcard/pc-speaker) - SPEAKER (printf("\a")) - -20??-??-?? Roger While - - * fileio.c: Implement COB_VARSEQ_FORMAT to override default format - for variable length sequential files. - -20??-??-?? Roger While - - * fileio.c: used fdcobsync for sync, defined depending on configuration - * fileio.c (cob_sync): droped synch mode for COB_SYNCH (Y=P), moved - calls of cob_sync to (save_status) - -20??-??-?? Roger While - - * fileio.c: dropped support for BDB < 4.1 - -20??-??-?? Roger While - - * call.c (cob_init_call): Change to COB_PRE_LOAD: if an entry is not - found in COB_LIBRARY_PATH try the full name - -20??-??-?? Sergey Kashyrin - - * common.c: nanosleep for 370 - -2009-12-25 Roger While - - * strings.c: Added check for COB_EC_RANGE_INSPECT_SIZE and - NULL extension to cob_inspect_converting - -2009-10-07 Simon Sobisch - - * common.c, common.h, system.def: Added new system routine C$GETPID - -2009-08-28 Roger While - - * strings.c: Fix for UNSTRING with multiple variable length fields - -2009-08-03 Sergey Kashyrin - - * common.c: cob_accept_day_of_week corrected - -2009-08-03 Gary Cutler - - * common.c: cob_accept_day_of_week corrected - -2009-07-25 Gary Cutler - - * screenio.c: Fix PDCurses bug with COLOR_PAIRS - -2009-06-09 Roger While - - * move.c: Fix editing symbol moves - -2009-06-01 Roger While - - * fileio.c: Revise memory algo for SORT - Introduce COB_SORT_CHUNK - -2009-05-25 Roger While - - * General: Remove the following extraneous include files: - byteswap.h, call.h, fileio.h, intrinsic.h, move.h, numeric.h, - screenio.h, strings.h, termio.h by integration into common.h - as first step - -2009-05-16 Roger While - - * General: Changes to remove lib local symbols - * common.c, fileio.c: Fix to enable running test suite under Win - -2009-05-11 Roger While - - * fileio.c, fileio.h: Implement file status 24 for relative files - * termio.c, screenio.c: Implement ACCEPT OMITTED - * fileio.c, fileio.h: Change all I/O except L/S to file descriptor basis - -2009-05-01 Roger While - - * General: Code clean/sanitize - -2009-04-10 Roger While - - * General: Support for icc - * fileio.c: Sanitize / remove BDB < 4.1 support - * fileio.c, fileio.h: Support LOCK clause on OPEN - -2009-02-23 Roger While - - * screenio.c: Fix up accept without lines parameter - -2009-02-03 Roger While - - * intrinsic.c: Fix Cygwins busted rand function - -2009-01-27 Roger While - - * call.c: Change hyphen interpretation - -2009-01-22 Roger While - - * intrinsic.c, intrinsic.h: Functions CONCATENATE and SUBSTITUTE-CASE - -2009-01-20 Roger While - - * screenio.c, screenio.h: Minimal support for value occurs - -2009-01-17 Roger While - - * common.c, screenio.c, screenio.h: Save/restore screen over SYSTEM call - * General: Sanitize headers. Do not use names in prototypes - -2009-01-15 Roger While - - * screenio.c, screenio.h, termio.c - SCROLL for ACCEPT/DISPLAY - -2009-01-14 Roger While - - * screenio.c, screenio.h: ACCEPT ... FROM LINES/COLUMNS - -2008-12-20 Roger While - - * intrinsic.c, intrinsic.h: Implement SUBSTITUTE function - -2008-12-10 Roger While - - * screenio.c: Add inter-field cursor movement for screen input - -2008-12-08 Roger While - - * General: More stack reducing - * common.h: Constify attribute pointer in cob_field - -2008-12-03 Roger While - - * General: More stack reducing - Clean up dangling varargs - -2008-11-20 Roger While - - * General: Reduce stack usage - -2008-11-15 Roger While - - * fileio.c: Fix SORT GIVING when output is line sequential - * common.c, common.h, call.c, call.h: C routines for calling COBOL - -2008-11-14 Roger While - - * common.c: Always activate SIGSEGV handler - -2008-10-17 Roger While - - * common.c, common.h: cob_check_based - Check BASED items - -2008-09-22 Roger While - - * fileio.c, fileio.h: Evaluate FILE STATUS for SORT files - * General: More constification - -2008-08-20 Roger While - - * common.h: Change macro for __builtin_expect - -2008-08-16 Roger While - - * coblocal.h, termio.c, screenio.c: Change global name screen_initialized - -2008-08-01 Roger While - - * byteswap.h: Do not rely on gcc doing the right thing for short - -2008-07-21 Roger While - - * screenio.c: Do not display SECURE items - * General: Cleanup, do early malloc initializations - -2008-07-19 Roger While - - * General: Tidy up syntax - * intrinsic.c: Optimize field generation - -2008-07-18 Roger While - - * common.c: Win does not have nanosleep - -2008-07-14 Roger While - - * termio.c, move.c: Preliminary changes for zero-length fields - -2008-07-11 Roger While - - * strings.c: Handle special replacement correctly - -2008-07-09 Roger While - - * screenio.c, screenio.h: Fix up SCREEN handling - -2008-07-05 Roger While - - * screenio.c: Extend SCREEN processing - -2008-07-01 Roger While - - * termio.c: Revert '.' display of non-displayable characters - -2008-06-29 Roger While - - * common.c, common.h, system.def: Implement CBL_OC_NANOSLEEP - * coblocal.h, move.c: support routines for the above - -2008-06-25 Roger While - - * screenio.c, screenio.h: Define input fields for SCREEN section - -2008-06-23 Roger While - - * screenio.c: New env COB_SCREEN_EXCEPTIONS to retrun extended - exception codes on ACCEPT - -2008-06-17 Roger While - - * fileio.c: Fix return from ISAM (not BDB) from OPEN - * common.c: redirect to stderr when necessary - * screenio.c: More support - -2008-06-10 Roger While - - * screenio.c, screenio.h, termio.c: More Screen changes - -2008-06-05 Roger While - - * coblocal.h, common.c, fileio.c, fileio.h: Cleanup, prepare for linptr - reuse - -2008-06-04 Roger While - - * fileio.c: Cleanup /simplification - -2008-06-03 Roger While - - * fileio.c, fileio.h: Support UNLOCK statement - -2008-06-01 Roger While - - * coblocal.h, move.c, numeric.c: Localize cob_binary_get/set routines - * common.c, move.c: Cater for spaces in numeric fields - * termio.c: Display '.' for invalid characters - -2008-05-31 Roger While - - * fileio.c: Allow VARYING on LINE SEQUENTIAL - -2008-05-23 Roger While - - * common.h, termio.c: Better display of POINTER items - -2008-05-19 Roger While - - * screenio.c, screenio.h: More support for SCREEN - -2008-05-14 Roger While - - * common.c: Fix C$NARG for chaining syntax - * common.c, common.h: Simplify accept from environment - -2008-05-12 Roger While - - * screenio.c: Fix some screen displays - -2008-04-17 Roger While - - * common.c, common.h, system.def: Implement MF call X"91", - subfunctions 11, 12, 16 - -2008-04-02 Roger While - - * intrinsic.c, intrinsic.h: Implement FUNCTION COMBINED-DATETIME - -2008-03-31 Roger While - - * intrinsic.c, intrinsic.h: Implement LOCALE-TIME-FROM-SECONDS - More refmodding for functions - -2008-03-29 Roger While - - * General: Fix up sparse warnings - -2008-03-24 Roger While - - * intrinsic.c, intrinsic.h: Refmodding for some FUNCTIONS - -2008-03-11 Roger While - - * call.c: New environment variable to control case conversion on - dynamic program loads. - COB_LOAD_CASE=UPPER|LOWER - -2008-03-05 Roger While - - * fileio.c: New environment variables to control LINE SEQUENTIAL - files. - COB_LS_NULLS - Equivalent to MF's -N switch. - Bytes less than ASCII space are preceded by a null - byte on write. - COB_LS_FIXED - Write the record without trailing space - removal. - -2008-03-01 Roger While - - * fileio.c: BDB CLOSE must close secondary files first - -2008-02-19 Roger While - - * fileio.c: Clean up and comment - -2008-02-14 Roger While - - * fileio.c: Fix ifdef's for variable sequential files - -2008-02-12 Roger While - - * common.c, common.h: Rationalize some previously exported variables - New function - cob_set_location for line debugging - -2008-01-07 Roger While - - * common.c, common.h: DISPLAY .. UPON COMMAND-LINE - -2008-01-03 Roger While - - * move.h: Remove own_memxxx routines - * General: Remove references to own_memxxx routines - -2007-12-27 Roger While - - ** Mark 1.0 RELEASE - -2007-12-15 Roger While - - * common.c: Change exception structure definition to optimize - 64 bit allocation - -2007-11-21 Roger While - - * fileio.c: Add C/D/VB-ISAM code - -2007-11-20 Roger While - - * fileio.c: Cater for 02 return status - Put in hooks for C/D/VB-ISAM - -2007-11-09 Roger While - - * numeric.c: Use 64-bit when available - -2007-11-01 Roger While - - * numeric.c: Fix 64-bit unsigned problem - -2007-10-27 Roger While - - * strings.c: Fix figurative constant handling in INSPECT - -2007-10-24 Roger While - - * numeric.c, numeric.h: New routine cob_cmp_uint - -2007-10-22 Roger While - - * numeric.c: Fix 36 digit numerics - -2007-10-20 Roger While - - * call.c: Clean up - * codegen.h: Fix up signed/unsigned comparison - -2007-10-17 Roger While - - * common.c: User defined exit routines must be called before - the OC clean up routines. - Fix missing call to user defined error routines. - -2007-10-10 Roger While - - * fileio.c, fileio.h: Change delete to fdelete (C++) - -2007-09-18 Roger While - - * screenio.c: Check for mvgetnstr in curses lib - -2007-09-12 Roger While - - * fileio.h: Add in CHANNEL definition - -2007-09-07 Roger While - - * General: unistd.h is not availiable on native Win - * move.c, termio.c: Cater for changed pic string representation - -2007-08-31 Roger While - - * fileio.c, fileio.h: Move defines, change EXTFH interface - Linage is reduced to a pointer in the fileio struct - 2 local defines moved from fileio.c to fileio.h for EXTFH - -2007-08-23 Roger While - - * General: Remove ASCII 10/20, fix up ascii/ebcdic on target - Note changes to module and file structures - -2007-08-14 Roger While - - * fileio.c: Implement method to use an external SEQ/RAN file handler - * fileio.h: Use spare byte in file struct as file version - -2007-08-12 Roger While - - * numeric.c: Fix for EBCDIC machines - -2007-08-09 Roger While - - * fileio.c: Implement method to use an external ISAM file handler - -2007-08-01 Roger While - - * call.c: Implement cob_c_cancel - * General: More constification - -2007-07-26 Roger While - - * common.c, fileio.c: (un)likely optimizations - * byteswap.h: For i386, let gcc work out the 2 byte case - -2007-07-24 Roger While - - * fileio.c: Do not use locks if filename begins with "/dev/" - -2007-07-21 Roger While - - * common.c: Use calloc instead of malloc - -2007-07-11 Roger While - - * fileio.c: Fix a memory leak in the I/S close code - -2007-07-02 Roger While - - * call.c: Previously we were trying to detect if dlopen(NULL) - works in configure and ifdef'ing in call.c - This does not work in all circumstances. - For borked systems this now has to be changed by hand - in call.c. The comments at the top of call.c - - /* NOTE - The following variable should be uncommented when - it is known that dlopen(NULL) is borked. - This is known to be true for some PA-RISC HP-UX 11.11 systems. - This is fixed with HP patch PHSS_28871. (There are newer - but this fixes dlopen/dlsym problems) - */ - /* #define COB_BORKED_DLOPEN */ - -2007-07-01 Roger While - - * codegen.h: Further optimizations - -2007-06-28 Roger While - - * codegen.h: Tweak for non-alignment-tolerant architectures - * intrinsic.c: DST hack for ports that do not have "%z" - Note - This needs to be properly fixed - -2007-06-26 Roger While - - * intrinsic.c: For specific ports, fix TZ in CURRENT-DATE - Add use of strftime for timezone if configure detected - -2007-06-06 Roger While - - * fileio.c, fileio.h: LOCK on WRITE/REWRITE - -2007-05-22 Roger While - - * fileio.c, fileio.h: Implement IGNORING LOCK. - Fix a WRITE/REWRITE problem with duplicate keys. - -2007-05-17 Roger While - - * screenio.c: Use normal curses when available - -2007-05-10 Roger While - - * fileio.c: Fix positioning with START,READ NEXT/PREVIOUS on duplicate - records. - -2007-05-08 Roger While - - * common.c, common.h: Fix incompatible param definitions on CBL_EXIT_PROC - and CBL_ERROR_PROC - -2007-05-04 Roger While - - * fileio.c, fileio.h: Preliminary support for record locking - -2007-04-28 Roger While - - * numeric.c: Remove duplicated code. - Set up variables for binary > 64 bits - -2007-04-26 Roger While - - * numeric.c: Fix incorrect value when signed bit set in an - eight byte binary value. - * numeric.c, numeric.h: Remove unused routine. Make 2 routines static. - -2007-04-17 Roger While - - * intrinsic.c: Fix a Cygwin compile failure - -2007-04-11 Roger While - - * common.c, common.h: Define cob_one for screen display - -2007-04-10 Roger While - - * strings.c, strings.h: Dynamically allocate for unstring - -2007-03-27 Roger While - - * common.c: Fix 64-bit warning - -2007-03-16 Roger While - - * common.c, intrinsic.c: Provide fractional seconds on Win platform - -2007-03-13 Roger While - - * intrinsic.c: Provide fractional seconds for CURRENT-DATE if - supported on the platform - * common.c: Provide fractional seconds for ACCEPT .. FROM TIME - if supported on the platform - * fileio.h: Align file structure - * fileio.c: When filename mapping, allow underline in varibale name - -2007-03-05 Roger While - - * intrinsic.c: Windows/Cygwin implementation of LOCALE-DATE/TIME - -2007-03-03 Roger While - - * General: Use COB_FIELD_xxx macros - -2007-03-01 Roger While - - * intrinsic.c, intrinsic.h: Change params for LOCALE-DATE/TIME - -2007-02-26 Roger While - - * intrinsic.c: Fix for not defined LANGINFO - -2007-02-25 Roger While - - * fileio.c: Fix Indexed-Sequential rewrite - -2007-02-13 Roger While - - * All: Change initialization of fields/attributes - -2007-02-11 Roger While - - * coblocal.h: New file, contains prototypes that should only - be known to the library - * All: Implement above header file - -2007-02-09 Roger While - - * fileio.c, fileio.h: Implement SORT-RETURN - -2007-02-07 Roger While - - * intrinsic.c, intrinsic.h: Implement LOCALE-DATE, LOCALE-TIME - * fileio.c, fileio.h: Fix a READ PREVIOUS problem - -2007-01-24 Roger While - - * fileio.c, fileio.h: Implement new SORT routines - Note these do not need the ISAM handler - -2007-01-17 Roger While - - * common.c, common.h: Add cob_is_omitted, check for NULL parameter - -2007-01-16 Roger While - - * intrinsic.c, intrinsic.h: Implement FUNCTION's - SECONDS-PAST-MIDNIGHT, SECONDS-FROM-FORMATTED-TIME - * All: Remove COB_SET_EXCEPTION define - * intrinsic.c: Set COB_EC_ARGUMENT_FUNCTION exception code where - appropriate - -2007-01-15 Roger While - - * common.c, common.h, fileio.c, fileio.h: Change sort comparison routines - to not overwrite collating sequence. Also optimize. - Note, this fixes a problem with a (file) SORT with COLLATING and - INPUT and/or OUPUT procedures. Previously, this would - incorrectly change alphanumeric tests in the - INPUT/OUTPUT procedures. - * fileio.c, fileio.h: Allow special ASSIGN [TO] DISPLAY processing - -2007-01-12 Roger While - - * fileio.c: Fix miscompile on WIN64 - -2007-01-10 Roger While - - * intrinsic.c, intrinsic.h: Allow special ASSIGN [TO] KEYBOARD processing - -2007-01-08 Roger While - - * call.c, call.h: Implement new CANCEL processing - -2006-12-17 Roger While - - * intrinsic.c, intrinsic.h: Correct the NUMVAL-C function - -2006-12-12 Roger While - - * fileio.c: Fix secondary key access - -2006-12-07 Roger While - - * intrinsic.c, intrinsic.h: Implement TRIM function - -2006-11-28 Roger While - - * move.c: Small optimization - * numeric.c: New routines cob_cmp_long_numdisp, - cob_cmp_long_signed_numdisp - -2006-11-12 Roger While - - * codegen.h: Remaining integer cmp/add/sub optimizations - -2006-10-23 Roger While - - * Makefile.am: Remove gcc options - General: Constify some stuff - -2006-10-16 Roger While - - * codegen.h: Fix 3 byte compare - -2006-10-15 Roger While - - * codegen.h: This is now the place for optimization - Duplication in numeric.c is not necessary - Add in optimization for 3/5/6/7 byte compares - Add in 3 byte add optimization - * numeric.c: Delete duplicated code from codegen.h - Constify - -2006-10-14 Roger While - - * common.c, fileio.c, fileio.h, move.c, move.h: const defintions - -2006-09-30 Roger While - - * common.c, common.h: Implement CBL_EXIT_PROC - * General: tidy up - -2006-08-31 Roger While - - * call.c: Alternate ifdef'd algo for call list - -2006-08-28 Roger While - - * General: Check for COB_PARAM_CHECK - * numeric.c: Experimental code - -2006-08-26 Roger While - - * fileio.c: Implement COB_FILE_PATH variable for default - path prefix on files that do not have any other assignment - -2006-08-09 Roger While - - * system.def, common.c, common.h: More MF/ACU system routines - -2006-08-01 Roger While - - * common.c, common.h, call.c: Change cob_field_to_string to type void - -2006-07-31 Roger While - - * system.def, fileio.c, fileio.h, call.c, common.c, common.h: New MF - system routines - see system.def - -2006-07-26 Roger While - - * All: General clean up and fix gcc 4 warnings - * New file system.def - * call.c, common.c, common.h: System routines - -2006-07-19 Roger While - - * All: General clean up - -2006-07-14 Roger While - - * codegen.h, numeric.c: Fix optimization for HP compiler - * intrinsic.c: Fix bug in NUMVAL routines - -2006-07-12 Roger While - - * common.c, common.h: Implement ALLOCATE/FREE - * strings.c: Clean up - -2006-07-07 Roger While - - * codegen.h, numeric.c: More optimizations - * fileio.c: Further BDB fixes - -2006-07-06 Roger While - - * fileio.c: BDB >= 4.1 fixes - -2006-07-04 Roger While - - * fileio.c: BDB >= 4.1 fixes - -2006-06-22 Roger While - - * call.c: Set cob_exception_code for not found calls - -2006-06-21 Roger While - - * fileio.c: Fix typo for cob_sort_output_cache - -2006-06-06 Roger While - - * move.h: Remove generic memcpy/memset for non (GNUC && i386) - -2006-06-05 Roger While - - * fileio.c, fileio.h: Implement PREVIOUS for IS files - -2006-05-27 Roger While - - * common.c, common.h: Implement cob_fatal_error - -2006-05-20 Roger While - - * Fixes for extended ACCEPT/DISPLAY - -2006-05-18 Roger While - - * common.c, common.h, intrinsic.c, intrinsic.h: Implement FUNCTIONs - EXCEPTION-FILE, EXCEPTION-STATEMENT, EXCEPTION-LOCATION, EXCEPTION-STATUS - -2006-05-12 Roger While - - * common.c, exception.def: Exceptions for ACCEPT/DISPLAY - -2006-05-10 Roger While - - * common.h: Preliminary support for CURSOR IS and CRT STATUS IS - * intrinsic.c, intrinsic.h: Implement STORED-CHAR-LENGTH (Fujitsu) - -2006-05-08 Roger While - - * common.c, common.h: cob_chain_setup - setup CHAINING params from - command line - * strings.c, strings.h: implement TRAILING syntax in INSPECT clause - -2006-05-05 Roger While - - * strings.c: Avoid memory bloat with INSPECT - -2006-05-04 Roger While - - * common.h: Define likely/unlikely macros - * call.c, move.c: Use above macros - -2006-05-03 Roger While - - * screenio.c, screenio.h: Change structures - -2006-05-01 Roger While - - * General: Changes for native EBCDIC machines - * codegen.h, numeric.c: Further optimization for cob_cmp_xxx, - cob_add_xxx, cob_sub_xxx - * common.c, common.h: Support for sign-ebcdic and sign-ascii20 - (Note ascii20 is not correct) - Implement SET ENVIRONMENT (ACU) - -2006-04-17 Roger While - - * codegen.h, numeric.c: Optimized cob_cmp_xxx, cob_add_xxx, - cob_sub_xxx - -2006-04-06 Roger While - - * common.h, common.c: Define new function cob_strdup - common.c, call.c, fileio.c: Use cob_strdup - fileio.c: Fix size_t mistake - -2006-04-02 Roger While - - * codegen.h: Fix up a bunch of mistakes - -2006-03-25 Roger While - - * common.c: Although not currently used, update the - ASCII/EBCDIC tables - -2006-03-23 Roger While - - * numeric.c: Fix a stack corruption in the fast C-3 compare - -2006-03-22 Roger While - - * common.c, common.h: Implement COLLATING SEQUENCE for table SORT - -2006-03-21 Roger While - - * move.c: More edited field fixes from Hans Martin Rasch - -2006-03-16 Roger While - - * move.c: Fix edited field with +/- and currency - -2006-03-10 Roger While - - * All: Reduce compile warnings under Win - * common.c: setlocale depends on HAVE_SETLOCALE - We must do a setlocale for LC_NUMERIC - as languages with a comma separator change - the operation of string functions which bork - specfically FP operations - -2006-03-09 Roger While - - * numeric.c: Fix remainder problem - Fix returning functions which return void - -2006-03-04 Roger While - - * common.c: Don't do cob_put_sign for PACKED fields - in the cob_cmp_xxx routines - -2006-02-21 Roger While - - * new include: codegen.h - This contains inlines that only relate to code - generation - Implemented are cob_cmp_xxx_binary and cob_addsub_xxx_binary - where xxx is u8, s8, u16, s16 etc. - * call.c: Fix a preload problem under Cygwin - -2006-02-18 Roger While - - * move.h: Take out x86 memcpy optimization - -2006-02-08 Roger While - - * common.c, common.h, numeric.c, numeric.h: Optimize COMP/COMP-3 - -2006-02-01 Roger While - - * fileio.h, fileio.c: Changes for FILE STATUS - We have to pass the FILE STATUS as a parameter - to the I/O call. This is required for EXTERNAL FD's. - -2006-01-29 Roger While - - * call.c: Implement COB_PRE_LOAD - -2006-01-27 Roger While - - * Tweak COMP-3 - -2006-01-26 Roger While - - * strings.c: Rip out regex use. It cannot handle - a low-value (null byte) in RE. - call.c: Native WIN MSC needs path separator of ';' - common.h, common.c: Implement CBL_ERROR_PROC - -2006-01-25 Roger While - - * fileio.h, fileio.c: signed to unsigned for file_status - -2006-01-17 Roger While - - * fileio.c: Print assign name when erroring - -2006-01-07 Roger While - - * fileio.c: 64-bit fixes - -2006-01-05 Roger While - - * General: Bootstrap up to new libtool / automake - MS VS/VC changes - fileio.c: Fix relative postioning and incorrectly - returned relative record number - -2005-12-30 Roger While - - * Change ifdef's on MINGW to WIN32 (Also defined on 64-bit Win) - intrinsic.c: ifdef's for strftime (CURRENT-DATE) - fileio.c: Basic platform changes - -2005-12-28 Roger While - - * General: Further fixes for non-gcc - -2005-12-27 Roger While - - * General: Change occurrences of "char[variable]" - move.c: Change code for "MOVE ALL '98' TO binary/packed/edited" - This is still not completely correct - -2005-12-23 Roger While - - * termio.c, common.c: Move extended accept/display from - termio to common. Define cobc_argc/argv as static. - -2005-12-21 Roger While - - * fileio.c - Cater for various format of the record - length field in variable length sequential files - (WITH_VARSEQ) - -2005-12-18 Roger While - - * All: Cleanup "shadowed" variables - Start generalizing code for large numbers - common.c: Take out Ebcdic table, now genned by codegen - -2005-12-09 Roger While - - * move.c: Fix display of large unsigned numbers. - termio.c: Change number of displayed digits. - -2005-12-08 Roger While - - * common.h: New defines - COB_SMALL_BUFF, COB_MEDIUM_BUFF, - COB_LARGE_BUFF. - Replace all occurrences of FILENAME_MAX/BUFSIZ. - -2005-12-04 Roger While - - * intrinsic.c: Fix strftime for MingW - -2005-12-04 Roger While - - * byteswap.h: Take out typedefs. They are likely to - clash with standard includes. - -2005-12-03 Roger While - - * common.c: Do not gen signals for Ming - * fileio.c: Ming / typing changes - -2005-11-25 Roger While - - * common.c: Extended signal handling - fileio.c: Don't use mkstemp on non-Win - -2005-11-16 Roger While - - * call.c: Fix wrong cached handle - fileio.c: Fix spacing in LS read - -2005-11-15 Roger While - - * fileio.c: Allow COB_SYNC=P (Paranoid) - This will try even harder to sync. - -2005-11-15 Roger While - - * common.c, fileio.h, fileio.c: Check open files - at run-unit termination. Implement sync'ing - with enviroment variable COB_SYNC=Y. - Catch signals QUIT, INT and HUP. - -2005-11-08 Roger While - - * fileio.c: Tweaks for LS files - -2005-11-04 Roger While - - * call.c: Don't repeatedly call (lt_)dlopen on - NULL (main program); Do it once at startup. - -2005-11-01 Roger While - - * screenio.c: Cater for include in ncurses/ncurses.h - * fileio.c: ferror under Cygwin doesn't like a - void * parameter - Cast it. - Fix line-sequential reads when input has carriage-returns. - -2005-10-26 Roger While - - * fileio.c: Remove HAVE_DB ifdef, fix warnings - * move.c: Fix warnings - -2005-10-25 Roger While - - * move.h, move.c, numeric.c, fileio.c, strings.c - memcpy/memset optimizations - move.c: Fix a mpz_ call (optimization) - -2005-10-14 Roger While - - * All: More GCC 4 fixes - -2005-10-13 Roger While - - * common.h, common.c: Fix function type (GCC 4) - -2005-08-07 Roger While - - * All .c: indent, braces - * call.c: Dynamically allocate areas, const allocation - -2005-08-04 Roger While - - * fileio.c: Harden I/O error checking - Replace fputc with putc - * screenio.c,h: Rename cob_screen_clear to cob_screen_terminate - * common.c,h: Call cob_screen_terminate in cob_stop_run - Define cob_stop_run as noreturn (gnuc) - * All: Change occurrences of exit to cob_stop_run - -2005-07-31 Roger While - - * intrinsic.c, intrinsic.h: Add SIGN, FRACTION-PART, clean up - * common.c, common.h: cob_check_version - Program versioning - * move.c, numeric.c: Some preliminary assembler stuff - -2005-07-14 Roger While - - * fileio.c: Dummy routines for read,write, etc. - Always generate the function jump table, even if - DB not configured. Jumps to the dummy routines - result in status 30. - - * All: Do malloc's through own new routine cob_malloc - This will produce an error and terminate if memory - cannot be acquired. - -2005-07-02 Roger While - - * common.h: cob_module bit fields to char - * intrinsic.c: Clean up and fixes - * move.c, numeric.c: Experiment with own_mem(cpy,set) - * fileio.c: Cast fseek offsets to off_t - Return correctly if DB not defined - -2005-06-28 Roger While - - * New files: intrinsic.h, intrinsic.c - * Fix cob_add/sub_int - -2005-06-13 Roger While - - * common.c: Handle new COB_SWITCH_n=ON/OFF - screenio.c: Handle pdcurses - -2005-06-11 Roger While - - * strings.c: Fix INSPECT - fileio.c: Mistake in LINAGE - -2005-06-09 Roger While - - * call.c: Fix memory leak in drop function. - -2005-06-01 Roger While - - * Makefile*, fileio.c, common.c: Hacks for MinGW - move.c: Include math.h - -2005-05-31 Roger While - - * common.h, common.c, numeric.c, move.c, termio.c : - Rough implementation of COMP-1/2 fields. - -2005-05-27 Roger While - - * byteswap.h: u_int16_t etc. are not necessarily defined - in sys/types.h (e.g. MinGW). So ifndef on __BIT_TYPES_DEFINED__ - and typedef them. - fileio.c: Cater for extended DB headers db4/ db4.1/ db4.2/ db4.3/ - -2005-05-23 Roger While - - * call.h, call.c: New functions cob_resolve_1 - cob_call_resolve_1. - These are wrappers for optimized dynamic - calls. - -2005-05-21 Roger While - - * call.h, call.c: Cater for call.def - Cater for --with-dl - Restructure code slightly - Take out check for cob_initialized - -2005-05-03 Roger While - - * Mak*: Due to autoreconf - common.c: Slight restructure. - cob_exp10 must be int not long. - common.h: extern definitions. - fileio.c: Force SORT to put duplicates in order. - move.c: Performance. - numeric.c: Remove unused function. - Change long to int (64-bitters where long = 8 bytes). - -2005-04-15 Keisuke Nishida - - * Makefile.am (libcob_la_CFLAGS): Add -fsigned-char. - -2005-04-13 Keisuke Nishida - - * byteswap.h: #include . Use u_int16_t, u_int32_t, and - u_int64_t instead of unsigned short, etc. - -2005-03-03 Roger While - - * fileio.h, fileio.c : - LINAGE - -2005-02-11 Roger While - - * common.h, common.c, termio.c : - Reorder struct cob_module. - Fixes for ARGUMENT-VALUE/NUMBER - - discovered by Franklin Ankum. - Fix possible too small buffer. - -2005-02-09 Roger While - - * I must be going senile. Finally fix - cob_external_addr. - -2005-02-08 Roger While - - * Fix my cob_external_addr routine - -2005-02-07 Roger While - - * common.h, common.c: new routine cob_external_addr - Dynamically cater for EXTERNAL items at runtime - -2005-02-04 Roger While - - * termio.h, termio.c : - implement DISPLAY .. UPON ENVIRONMENT-VALUE - implement DISPLAY .. UPON ARGUMENT-NUMBER - implement ACCEPT .. FROM ARGUMENT-NUMBER - implement ACCEPT .. FROM ARGUMENT-VALUE - -2005-01-07 Roger While - - * move.c: Fix incorrect truncation when !binary_trunc - and moving binary to packed or edited fields - * numeric.c: Fix arithmetic with numeric display - fields when !binary_trunc - -2004-11-19 Roger While - - * move.c: Fix incorrect truncation when !binary_trunc - -2004-11-05 Roger While - - * numeric.c: Handle arithmetic for !binary_trunc. - -2004-11-04 Roger While - - * move.c: Fix regression for NIST suite - -2004-11-04 Bernard Giroud - - * numeric.c (cob_decimal_get_binary): reverted: - NIST test suite is no more working. - -2004-11-02 Bernard Giroud - - * numeric.c (cob_decimal_get_binary) : - Worked around what I consider a bug in Gmp for getting - a long signed value. - * Added checks for option binary-truncate from a - suggestion of Roger While. - -2004-10-31 Roger While - - * fileio.h: For I/O exceptions, has_status flag and slight - rearrangement of fields in cob_file structure. - -2004-10-30 Roger While - - * call.c, common.c, move.c: Replace back-tick "'" with - quote "'" - * move.c: Fix to handle PIC ***B***B**9. - * byteswap.h: Always generate optimum code, not just with -O - * fileio.c: Tidy up file error messages. - In the ENOENT return for OPEN OUTPUT/EXTEND, return status 30. - Note this will not have any effect until we activate error - handling for the OPEN. (Coming up soon) - -2004-09-17 Keisuke Nishida - - * numeric.h (COB_STORE_TRUNC_ON_OVERFLOW): Define as 0x04, not 0x02. - (Thanks to Roger While) - -2004-07-06 Keisuke Nishida - - * numeric.h (COB_STORE_ROUND, COB_STORE_KEEP_ON_OVERFLOW) - (COB_STORE_TRUNC_ON_OVERFLOW): New macros. - * numeric.h, numeric.c (cob_decimal_get_display) - (cob_decimal_get_binary, cob_decimal_get_field, cob_add, cob_sub) - (cob_div_quotient, cob_div_remainder): New arg 'opt'. - * numeric.c (cob_decimal_get_field_round): Removed. - Integrated into 'cob_decimal_get_field'. - (cob_display_add_int): Renamed from cob_add_int_to_display. - (cob_add_round, cob_sub_round): Removed. - -2004-07-05 Keisuke Nishida - - * fileio.c (sort_read): Set field size for varying records. - (Thanks to Roger While!) - -2004-06-12 Keisuke Nishida - - * termio.c (display): Display full digits of binary item - when pretty-display is off, not when binary-truncate is off. - -2004-05-21 Keisuke Nishida - - * move.c (cob_binary_get_int64): Reimplemented using memcpy. - (cob_binary_get_int): Call cob_binary_get_int64. - (cob_binary_set_int): Call cob_binary_set_int64. - -2004-05-16 Keisuke Nishida - - * common.c (cob_cmp): Compare non-display numeric and alphanumeric - correctly. - -2004-05-04 Keisuke Nishida - - * termio.c (display_numeric): Leading sign for binary. - -2004-05-04 Keisuke Nishida - - * byteswap.h (COB_BSWAP_32_IA32): Always use bswap. - (We no longer support i386.) - -2004-05-04 Keisuke Nishida - - * fileio.c (cob_default_error_handle): Set error for status 35. - -2004-05-04 Keisuke Nishida - - * common.c (cob_runtime_error): Flush buffer at the end. - -2004-04-07 Keisuke Nishida - - * common.h, common.c (cob_table_sort_init, cob_table_sort_init_key) - (cob_table_sort): New functions. - -2004-04-07 Keisuke Nishida - - * strings.c (cob_inspect_converting): Do not convert repeatedly. - (Thanks to Richard Smith ) - -2004-03-12 Keisuke Nishida - - * screenio.c: #include - -2004-03-12 Keisuke Nishida - - * fileio.c (file_close): FILE *fp = f->file; - -2004-03-10 Keisuke Nishida - - * fileio.c (cob_sort_init): Use temporary sort file. - (cob_sort_finish): Delete sort file. - (cob_open): No filename mapping for SORT files. - -2004-03-09 Keisuke Nishida - - * move.c (cob_binary_set_int, cob_binary_set_int64): Reimplemented. - (Thanks to Roger While) - -2004-03-06 Keisuke Nishida - - * fileio.c (file_open): Open files in the text mode for line - sequential files. - -2004-03-06 Keisuke Nishida - - * fileio.c (file_open, file_close): Use fcntl for file locking. - -2003-10-01 Keisuke Nishida - - * common.h (cob_module): New member 'flag_pretty_display'. - * termio.c (display): Updated. - -2003-09-29 Keisuke Nishida - - * common.c (cob_is_numeric): Test packed decimal. - -2003-08-30 Keisuke Nishida - - * common.h (cob_module): Replace 'flag_binary_print_full' by - 'flag_binary_truncate'. Related functions updated. - -2003-08-29 Keisuke Nishida - - * termio.h (COB_SYSIN, COB_SYSOUT, COB_SYSERR): Removed. - * termio.h, termio.c (cob_display_error): New function. - (cob_newline_error): New function. - -2003-08-27 Keisuke Nishida - - * fileio.c: Compile indexed and sort i/o only when either of - HAVE_DBOPEN or WITH_DB is defined. - -2003-08-26 Keisuke Nishida - - * common.h (cob_module): New member 'flag_filename_mapping'. - * fileio.c (cob_open): filename mapping. - -2003-08-26 Keisuke Nishida - - * common.h, common.c (cob_a2e, cob_e2a): New variables. - -2003-08-25 Keisuke Nishida - - * fileio.c (sort_read): Bug fix of first read. - -2003-08-25 Keisuke Nishida - - * fileio.h, fileio.c (cob_sort_init): 3rd argument 'sequence'. - (cob_sort_finish): New function. - -2003-08-22 Keisuke Nishida - - * Don't use run-time config file. - * common.h, common.c (cob_config_lookup, cob_config_compare): Removed. - * call.c (cob_init_call): Handle env "COB_DYNAMIC_RELOADING". - -2003-08-21 Keisuke Nishida - - * common.h (cob_module): New member 'flag_binary_print_full'. - * termio.c (cob_display): Binary full print. - -2003-08-21 Keisuke Nishida - - * common.h (cob_display_sign): New enum. - (cob_module): New entry 'display_sign'. - * common.c (cob_real_get_sign, cob_real_put_sign): Check display_sign. - -2003-08-19 Keisuke Nishida - - * termio.c (cob_accept_command_line): Omit the program name (argv[0]). - -2003-08-17 Keisuke Nishida - - * termio.h, termio.c (cob_display_environment): New function. - (cob_accept_environment): Remove the second argument. - -2003-08-12 Keisuke Nishida - - * byteswap.h: New file. - * byteorder.h: Removed. - -2003-08-12 Keisuke Nishida - - * common.h, common.c (cob_return_code): Removed. - -2003-08-10 Keisuke Nishida - - * common.h (COB_FLAG_BINARY_SWAP): New macro. - * move.h, move.c (cob_binary_get_int): New function. - (cob_binary_get_int64): New function. - (cob_binary_set_int): New function. - (cob_binary_set_int64): New function. - * common.h (COB_TYPE_NUMERIC_NATIVE): Removed. - * common.h, common.c (cob_binary_convert): Removed. - * move.c (cob_move_display_to_native): Removed. - (cob_move_native_to_display): Removed. - * numeric.c (cob_decimal_set_native): Removed. - (cob_decimal_get_native): Removed. - -2003-08-09 Keisuke Nishida - - * call.c (cob_call_error): Exit with status 1. - -2003-08-07 Keisuke Nishida - - * byteorder.h: New file. - * common.h (COB_TYPE_NUMERIC_NATIVE): New macro. - * common.h, common.c (cob_binary_convert): New function. - * move.c (cob_move_display_to_native): New function. - (cob_move_native_to_display): New function. - * numeric.c (cob_decimal_set_native): New function. - (cob_decimal_get_native): New function. - -2003-08-05 Keisuke Nishida - - * fileio.h (COB_WRITE_MASK, COB_WRITE_LINES, COB_WRITE_PAGE) - (COB_WRITE_AFTER, COB_WRITE_BEFORE): New macros. - * fileio.h, fileio.c (cob_write_page, cob_write_lines): Removed. - (cob_write): Take third argument. - * fileio.c (file_write_opt): New function. - (FILE_WRITE_AFTER, FILE_WRITE_BEFORE): New macros. - -2003-07-28 Keisuke Nishida - - * common.h, common.c (cob_exception): Removed. - -2003-06-29 Keisuke Nishida - - * fileio.h, fileio.c (cob_sort_init): Removed the 3rd argument. - (cob_sort_init_key): New function. - -2003-06-28 Keisuke Nishida - - * common.h, common.c (cob_cmp_result): Removed. - -2003-06-25 Keisuke Nishida - - * termio.c (cob_accept): Do not use readline. - -2003-06-19 Keisuke Nishida - - * common.c, common.h (cob_check_odo): New function. - (cob_check_subscript_depending): Removed. - -2003-06-18 Keisuke Nishida - - * fileio.c (relative_rewrite): Refer to the relative key unless - the access mode is sequential. - -2003-06-12 Keisuke Nishida - - * fileio.c (SEEK_INIT): New macro. - -2003-06-07 Keisuke Nishida - - * numeric.c, numeric.h: No longer use gmp. - (cob_decimal_init, cob_decimal_clear): Removed. - -2003-06-07 Keisuke Nishida - - * common.h (cob_module): New member 'collating_sequence'. - * common.c (CMP): New macro. - (cmp_char, cmp_all, cmp_alnum): Use CMP. - -2003-05-29 Keisuke Nishida - - * common.h (cob_switch): Removed. - * common.c (cob_set_switch, cob_get_switch): New function. - -2003-05-27 Keisuke Nishida - - * common.h (cob_module): Renamed from cob_environment. - (cob_current_module): Renamed from cob_env. - (cob_module_enter): Renamed from cob_push_environment. - (cob_module_leave): Renamed from cob_pop_environment. - (cob_module_init): Removed. - * call.c (cob_resolve): Do not call cob_module_init. - -2003-05-20 Keisuke Nishida - - * strings.c (cob_string_delimited): New function. - (cob_string_append): Take only one argument. - -2003-05-18 Keisuke Nishida - - * common.c (ding_on_error): Removed. - -2003-05-18 Keisuke Nishida - - * fileio.c: Large file system support. - (_LFS64_LARGEFILE) [WITH_LFS64]: Defined. - (_LFS64_STDIO) [WITH_LFS64]: Defined. - (_FILE_OFFSET_BITS) [WITH_LFS64]: Defined. - (_LARGEFILE64_SOURCE) [WITH_LFS64]: Defined. - -2003-05-18 Keisuke Nishida - - * common.h (cob_d2i, cob_i2d): New macros. - -2003-05-15 Keisuke Nishida - - * move.c (COPY_COMMON_REGION): Removed. - (store_common_region): New function. - (cob_display_to_int): New function. - (cob_binary_to_int): New function. - (cob_get_int): Optimized. - -2003-05-13 Keisuke Nishida - - * fileio.c (INITIAL_FLAGS): Set to O_BINARY when _WIN32 is defined - rather than __MINGW32__. - (file_open): Open in binary mode. - (cob_open): Make sure that errno == ENOENT after stat. - -2003-05-06 Keisuke Nishida - - * exception.def (COB_EC_ALL): Added. - * common.h (COB_SET_EXCEPTION): New macro. - (cob_exception_table): New variable. - (cob_exception_id): New enum. - (cob_exception_code): Removed. - -2003-05-04 Keisuke Nishida - - * numeric.c: Optimized cob_add_int/cob_sub_int for DISPLAY. - (digit_table): New variable. - (init_digit_table): New function. - (display_add_int, display_sub_int): New functions. - (cob_add_int_to_display): New function. - (cob_add_int): Call 'cob_add_int_to_display'. - (cob_sub_int): Call 'cob_add_int'. - (Thanks to David Korn ) - -2003-05-04 Keisuke Nishida - - * common.h (cob_get_sign, cob_put_sign): Redefined as macros. - * common.c (cob_real_get_sign, cob_real_put_sign): Called from - the above macros. - -2003-05-03 Keisuke Nishida - - * fileio.h (COB_OPEN_NONE, COB_OPEN_LOCKED): New macros. - (COB_CLOSE_REEL, COB_CLOSE_REEL_REMOVAL): Removed. - (COB_FILE_CLOSED_WITH_LOCK): New macro. - * fileio.c (sequential_close): Close with lock. - (sequential_open): Seek to the end for extend file. - (cob_open): Return COB_FILE_CLOSED_WITH_LOCK when file is locked. - -2003-05-03 Keisuke Nishida - - * common.h, common.c (cob_linage_counter): New variable. - -2003-04-26 Keisuke Nishida - - * common.h, common.c (cob_uint_attr, cob_sint_attr): Removed. - (cob_ubin_attr, cob_sbin_attr): Removed. - * move.c: Do not use them. - -2003-04-03 Keisuke Nishida - - * move.c (cob_get_int): Renamed from cob_to_int. - -2003-03-30 Keisuke Nishida - - * numeric.c (cob_decimal_set_int): Remove the 3rd argument 'decimals'. - (cob_decimal_set_int64): Removed. - -2003-03-25 Keisuke Nishida - - * exception.def: New file. - -2003-03-06 Keisuke Nishida - - * common.c (cob_field_to_string): Search for ' ' from backward. - -2003-02-25 Keisuke Nishida - - * common.c (cob_push_environment, cob_pop_environment): New functions. - -2003-01-23 Keisuke Nishida - - * fileio.h (cob_file): Break out flags. - * fileio.c: Updated. - - * fileio.h, fileio.c (cob_dummy_status): Removed. - * fileio.c (save_status): Check file_status before setting status. - -2003-01-20 Keisuke Nishida - - * common.h (COB_FLAG_HAVE_SIGN): New macro. - (COB_FLAG_SIGN_SEPARATE): New macro. - (COB_FLAG_SIGN_LEADING): New macro. - (COB_FLAG_BLANK_ZERO): New macro. - (COB_FLAG_JUSTFIED): New macro. - (COB_FIELD_HAVE_SIGN): New macro. - (COB_FIELD_SIGN_SEPARATE): New macro. - (COB_FIELD_SIGN_LEADING): New macro. - (COB_FIELD_BLANK_ZERO): New macro. - (COB_FIELD_JUSTIFIED): New macro. - (cob_field_attr): Remove members 'have_sign', 'sign_separate', - 'sign_leading', 'blank_zero', and 'justified'. New member - 'flags'. All files updated. - -2003-01-20 Keisuke Nishida - - * numeric.h (cob_decimal): Rename 'number' to 'data'. - -2003-01-15 Keisuke Nishida - - * move.c (cob_move_all): New function. - (cob_move): Call cob_move_all. - -2002-12-10 Keisuke Nishida - - * common.h (cob_environment, cob_env): New. - (cob_decimal_point, cob_currency_symbol, cob_numeric_separator): - Replaced by cob_env. All files updated. - * common.c (cob_decimal_point, cob_currency_symbol): Removed. - -2002-12-05 Keisuke Nishida - - * common.c (cob_index, cob_index_depending): Exit when index is - out of range. - -2002-11-25 Keisuke Nishida - - * numeric.c (cob_decimal_get, cob_decimal_get_r): Copy decimal - before modifying it. - -2002-11-25 Keisuke Nishida - - * strings.h (cob_inspect_init): Take second argument 'replacing'. - (cob_inspect_characters): New function. - (cob_inspect_all): New function. - (cob_inspect_leading): New function. - (cob_inspect_first): New function. - -2002-11-25 Keisuke Nishida - - * common.h, common.c (cob_cmp_int): New function. - -2002-11-24 Keisuke Nishida - - * move.h, move.c (cob_memcpy): Renamed from cob_mem_move. - - * fileio.h (COB_ASCENDING, COB_DESCENDING): Moved from common.h. - - * common.h (cob_field_attr): Remove member 'all'. - (COB_TYPE_*): New macros. - (COB_FIELD_IS_NUMERIC): New macro. - - * numeric.h (cob_d1, cob_d2, cob_d3, cob_d4, cob_dt): Removed. - (cob_decimal_set_int64): Removed. - * numeric.h, numeric.c (cob_numeric_cmp): New function. - * common.c (cob_cmp): Call 'cob_numeric_cmp' for numeric comparison. - * fileio.c (sort_compare): Always call cob_cmp. - -2002-11-23 Keisuke Nishida - - * numeric.h, numeric.c (cob_add_r, cob_sub_r): New functions. - (cob_decimal_get_r): Renamed from 'cob_decimal_get_rounded'. - -2002-11-22 Keisuke Nishida - - * fileio.h, fileio.c (cob_sort_init): Take 3 arguments. - -2002-11-22 Keisuke Nishida - - * common.h, common.c (cob_uint_attr, cob_sint_attr): New constants. - * common.h, common.c (cob_ubin_attr, cob_sbin_attr): New constants. - -2002-11-21 Keisuke Nishida - - * numeric.h, numeric.c (cob_add, cob_sub, cob_add_int, cob_sub_int): - Don't take parameter 'round'. All caller updated. - -2002-11-19 Keisuke Nishida - - * fileio.c (lineseq_read): Not do anything special with '\0'. - -2002-11-19 Keisuke Nishida - - * strings.h, strings.c: Divide string functions. - (cob_inspect, cob_string, cob_unstring): Removed. - (cob_inspect_init): New function. - (cob_inspect_start): New function. - (cob_inspect_before): New function. - (cob_inspect_after): New function. - (cob_inspect_tallying_characters): New function. - (cob_inspect_tallying_all): New function. - (cob_inspect_tallying_leading): New function. - (cob_inspect_replacing_characters): New function. - (cob_inspect_replacing_all): New function. - (cob_inspect_replacing_leading): New function. - (cob_inspect_replacing_first): New function. - (cob_inspect_converting): New function. - (cob_inspect_finish): New function. - (cob_string_init): New function. - (cob_string_append): New function. - (cob_string_finish): New function. - (cob_unstring_init): New function. - (cob_unstring_delimited): New function. - (cob_unstring_init): New function. - (cob_unstring_tallying): New function. - (cob_unstring_finish): New function. - * strings.h (COB_INSPECT_*, COB_STRING_*, COB_UNSTRING_*): Removed. - -2002-11-13 Keisuke Nishida - - * common.h, common.c (cob_all_attr): New variable. - (cob_just_attr): Renamed from 'cob_alnum_justified_attr'. - (cob_cmp): New function. - (cob_cmp_zero, cob_cmp_space, cob_cmp_low): Removed. - (cob_cmp_high, cob_cmp_quote, cob_cmp_field): Removed. - * common.c (cmp_char): Renamed from 'cmp_figurative'. - (cob_cmp_alnum): Renamed from 'cmp_field'. - * fileio.c (sort_compare): Updated. - -2002-11-13 Keisuke Nishida - - * common.h (cob_status): Removed. - (cob_error_code): New variable. - (COB_STATUS_SUCCESS, COB_STATUS_OVERFLOW): Removed. - (COB_EC_*): New macros. - All files updated. - - * strings.h (COB_STRING_WITH_POINTER): Removed. - (COB_UNSTRING_WITH_POINTER): Removed. - * strings.h, strings.c (cob_string, cob_unstring): Take second - argument 'ptr'. - * strings.c (set_int, add_int): Removed. - -2002-11-11 Keisuke Nishida - - * fileio.h (COB_FILE_OUT_OF_KEY_RANGE): New macro. - * fileio.c (relative_read_next): Use COB_FILE_OUT_OF_KEY_RANGE. - (cob_default_error_handle): Add COB_FILE_OUT_OF_KEY_RANGE. - -2002-11-08 Keisuke Nishida - - * common.h (cob_field_attr): New member 'all'. - * common.c, common.h (cob_cmp_str, cob_cmp_all): Removed. - * common.c (cob_cmp_field): Integrate comparison functions. - -2002-11-08 Keisuke Nishida - - * support.h: Removed. - * Makefile.am: Remove support.h. - -2002-11-07 Keisuke Nishida - - * numeric.c, numeric.h (cob_add_int, cob_sub_int): Do not take - argument 'decimals'. All callers updated. - -2002-10-21 Keisuke Nishida - - * common.c (cmp_figurative): New function. - * common.c, common.h (cob_cmp_zero, cob_cmp_space): New functions. - (cob_cmp_low, cob_cmp_high, cob_cmp_quote): New functions. - -2002-10-18 Keisuke Nishida - - * numeric.h, numeric.c (cob_add_int64, cob_sub_int64): Removed. - -2002-10-13 Keisuke Nishida - - * fileio.h (cob_file): New member 'record', replacing - 'record_size' and 'record_data'. - (cob_file): Rename 'record_depending' to 'record_size'. - * fileio.c: Updated. - -2002-10-13 Keisuke Nishida - - * common.h (cob_field_attr, cob_field): New typedef. - * fileio.h (cob_file_key, cob_file, cob_fileio_funcs): New typedef. - * numeric.h (cob_decimal): New typedef. - * screenio.h (cob_screen): New typedef. - (cob_screen_type, cob_screen_data, cob_screen_position): New typedef. - * support.h (cob_frame): New typedef. - -2002-10-08 Keisuke Nishida - - * Use 'struct cob_field *' instead of 'struct cob_field' - for all function prototypes. All files updated. - * common.h (COB_FIELD_IS_VALID): Removed. - - * common.h (cob_field_attr): Renamed from cob_field_desc. - All files updated. - - * common.c, common.h (cob_group_attr): New variable. - (cob_alnum_justified_attr): New variable. - - * support.h (cob_ref, cob_ref_rest): Removed. - -2002-09-30 Keisuke Nishida - - * cobconfig.h.in: Removed. - -2002-09-29 Keisuke Nishida - - * fileio.h (cob_file): Restructured. - * fileio.c: Updated for new cob_file scheme. - * fileio.h, fileio.c (cob_sort_init): Renamed from cob_sort_keys. - * cobconfig.h.in (HAVE_DB1_DB_H, HAVE_DB_H): Removed. - -2002-09-24 Keisuke Nishida - - * support.h: Do not support non-computed-goto jump. - * cobconfig.h.in: Use AM_CONFIG_HEADER scheme. - (COB_HAVE_COMPUTED_GOTO): Removed. - (HAVE_DB1_DB_H, HAVE_DB_H): Added. - * fileio.h: #include - Include or which exists. - -2002-09-23 Keisuke Nishida - - * strings.c (cob_unstring): Don't use alloca. - -2002-09-12 Keisuke Nishida - - * numeric.h (cob_decimal): Use exponent instead of decimals. - * numeric.c: Related functions updated. - -2002-09-12 Keisuke Nishida - - * fileio.c (sequential_open): Set f->file.fd to 0 on error. - -2002-09-06 Keisuke Nishida - - * fileio.h, fileio.c: INDEXED files has been reimplemented using db1. - -2002-08-05 Keisuke Nishida - - * fileio.c (sort_compare): Prototype for db-3.1.x. - -2002-08-02 Keisuke Nishida - - * common.h, common.c (cob_cmp_all): Unify the former cob_cmp_all - and cob_cmp_all_str. - * common.c (cmp_internal): New function. - (cob_cmp_str, cob_cmp_field): Use it. - -2002-08-01 Keisuke Nishida - - * fileio.h (COB_ORG_SORT, COB_ORG_MAX): New macros. - (cob_file): New member 'sort_nkeys' and 'sort_keys'. - * fileio.c (sort_file): New variable. - (sort_compare, sort_open, sort_close, sort_read, sort_write): - New functions. - (sort_funcs): New variable. - (cob_sort_keys, cob_sort_using, cob_sort_giving): New functions. - (cob_init_fileio): Init sort functions. - -2002-08-01 Keisuke Nishida - - * common.h (COB_ASCENDING, COB_DESCENDING): New macros. - -2002-07-31 Keisuke Nishida - - * common.c (cob_init_config): New function. - (cob_init): Updated. Load the config file first. - -2002-07-30 Keisuke Nishida - - * fileio.c (indexed_write_internal): New function. - (indexed_write, indexed_rewrite): Updated. - -2002-07-30 Keisuke Nishida - - * fileio.c (lineseq_read): Check for EOF. - -2002-07-30 Keisuke Nishida - - * fileio.h (cob_fileio_funcs): 'write' takes only one argument. - (sequential_write, lineseq_write, relative_write, indexed_write): Ditto. - (cob_write): Updated. - -2002-07-30 Keisuke Nishida - - * screenio.c: Check configuration. - -2002-07-24 Keisuke Nishida - - * numeric.h (cob_decimal): Removed. - * numeric.c, numeric.h: Relace 'cob_decimal' by 'struct cob_decimal *'. - -2002-07-14 Keisuke Nishida - - * move.c (cob_set_int): Moved from numeric.c. - Reimplemented using 'cob_move'. - -2002-07-13 Keisuke Nishida - - * numeric.c (cob_decimal_get_double): Bug fix in calculation. - (cob_decimal_set_double): Take effect of decimal figures. - -2002-07-08 Keisuke Nishida - - * fileio.h (cob_file): New field 'assign'. - * fileio.c, fileio.h (cob_open): Do not take file name. Use 'assign'. - -2002-07-05 Keisuke Nishida - - * screenio.c, screenio.h (cob_screen_attr): New function. - * screenio.h (COB_SCREEN_TYPE_ATTRIBUTE): New type. - (cob_screen_data): New entry 'dummy'. - -2002-07-05 Keisuke Nishida - - * fileio.h (cob_file): Renamed from cob_file_desc. - * fileio.c: Updated. - -2002-07-01 Keisuke Nishida - - * screenio.c, screenio.h: New files. - * Makefile.am: Add them. - -2002-06-17 Keisuke Nishida - - * call.c (cob_call_resolve): Don't set cob_status. - -2002-06-11 Keisuke Nishida - - * call.c (cob_resolve): Use COB_MODULE_EXT. - -2002-06-11 Keisuke Nishida - - * common.c, common.h (cob_alnum_desc): New variable. - * common.c (cob_zero, cob_space, cob_high, cob_low, cob_quote): Use it. - * move.c (cob_mem_move): Use it. - -2002-06-11 Keisuke Nishida - - * Allow cob_field.desc to be NULL. - * common.h, common.c, move.c, numeric.c: Updated. - -2002-06-11 Keisuke Nishida - - * common.h (COB_FIELD_IS_VALID): New macro. - * fileio.c, strings.c: Use 'COB_FIELD_IS_VALID'. - -2002-06-11 Keisuke Nishida - - * common.h (cob_field): Field 'size' moved from 'cob_field_desc'. - (COB_FIELD_SIZE, COB_FIELD_DATA): Removed. - * common.c, fileio.c, move.c, numeric.c, strings.c, termio.c: Updated. - -2002-06-04 Keisuke Nishida - - * common.c, common.h (cob_config_compare): New function. - * call.c (cob_init_call): Use 'cob_config_compare'. - - * common.c (ding_on_error): New variable. - (cob_init): Set ding_on_error from option "ding-on-error". - (cob_runtime_error): Ring a bell only when "ding-on-error" is "yes". - -2002-06-04 Keisuke Nishida - - * support.h (cob_perform): Enclosed by do ... while (0). - -2002-06-04 Keisuke Nishida - - * Makefile.am (libcob_la_CFLAGS): -I$(top_srcdir). - * call.c, common.c, fileio.c, move.c: Updated. - -2002-05-31 Keisuke Nishida - - * numeric.c, numeric.h (cob_div_remainder): Renamed from - 'cob_div_reminder' (typo fix). - -2002-05-31 Keisuke Nishida - - * common.c, common.h (cob_index, cob_index_depending): Take 'name'. - Display index name with the error message. - * support.h (COB_INDEX, COB_INDEX_DEPENDING): Take 'name'. - -2002-05-31 Keisuke Nishida - - * Makefile.am (libcob_la_DEPENDENCIES): Removed. - -2002-05-30 Keisuke Nishida - - * common.c (cob_check_numeric): Takes the field name as an argument. - * common.h (cob_field_desc): Remove member 'name'. - -2002-05-30 Keisuke Nishida - - * numeric.c (cob_decimal_pow): Handle decimals. - (cob_decimal_set_double, cob_decimal_get_double): New functions. - * numeric.h (cob_decimal_set_double, cob_decimal_get_double): Exported. - -2002-05-29 Keisuke Nishida - - * Keep field names at run-time. - * common.h (cob_field_desc): New member 'name'. - * common.c (cob_check_numeric): Display filed name on error. - - * Makefile.am (libcob_la_DEPENDENCIES): Add defaults.h. - -2002-05-29 Keisuke Nishida - - * termio.c (cob_init_termio): #include - -2002-05-29 Keisuke Nishida - - * Support run-time config file: libcob.conf. - * common.c (config_load, config_insert, cob_config_lookup): - New functions. - (cob_init): Call 'config_load'. - * common.h (cob_config_lookup): Declared. - * call.c (dynamic_reloading): Renamed from cob_dynamic_reloading. - (cob_init_call): Initialize 'dynamic_reloading'. - - -Copyright 2002-2020 Free Software Foundation, Inc. - -Copying and distribution of this file, with or without modification, are -permitted provided the copyright notice and this notice are preserved. diff -Nru gnucobol-4.0~early~20200606/libcob/cobgetopt.c gnucobol-5/libcob/cobgetopt.c --- gnucobol-4.0~early~20200606/libcob/cobgetopt.c 2020-06-06 20:52:01.000000000 +0000 +++ gnucobol-5/libcob/cobgetopt.c 1970-01-01 00:00:00.000000000 +0000 @@ -1,827 +0,0 @@ -/* - Copyright (C) 2010-2012, 2014-2016, 2018-2019 Free Software Foundation, Inc. - Modified for use in GnuCOBOL by Roger While, Simon Sobisch -*/ - -/* Getopt for GNU. - NOTE: getopt is part of the C library, so if you don't know what - "Keep this file name-space clean" means, talk to drepper@gnu.org - before changing it! - Copyright (C) 1987-2002,2011 Free Software Foundation, Inc. - This file is part of the GNU C Library. - - The GNU C Library is free software; you can redistribute it and/or - modify it under the terms of the GNU Lesser General Public - License as published by the Free Software Foundation; either - version 2.1 of the License, or (at your option) any later version. - - The GNU C Library is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU - Lesser General Public License for more details. - - You should have received a copy of the GNU Lesser General Public - License along with the GNU C Library; if not, see - . */ - -#include - -#include -#include -#include -#include -#include - -#ifdef HAVE_UNISTD_H -#include -#endif - -#ifdef ENABLE_NLS -#include "lib/gettext.h" -#define _(msgid) gettext(msgid) -#define N_(msgid) gettext_noop(msgid) -#else -#define _(msgid) msgid -#define N_(msgid) msgid -#endif - - /* Force symbol exports */ -#define COB_LIB_EXPIMP -#include "libcob.h" - -#define NONOPTION_P (argv[cob_optind][0] != '-' || argv[cob_optind][1] == '\0') - - -/* This version of 'getopt' appears to the caller like standard Unix 'getopt' - but it behaves differently for the user, since it allows the user - to intersperse the options with the other arguments. - - As 'getopt' works, it permutes the elements of ARGV so that, - when it is done, all the options precede everything else. Thus - all application programs are extended to handle flexible argument order. - - Setting the environment variable POSIXLY_CORRECT disables permutation. - Then the behavior is completely standard. - - GNU application programs can use a third alternative mode in which - they can distinguish the relative order of options and other arguments. */ - -#include "cobgetopt.h" - -/* For communication from 'getopt' to the caller. - When 'getopt' finds an option that takes an argument, - the argument value is returned here. - Also, when 'ordering' is RETURN_IN_ORDER, - each non-option ARGV-element is returned here. */ - -char *cob_optarg = NULL; - -/* Index in ARGV of the next element to be scanned. - This is used for communication to and from the caller - and for communication between successive calls to 'getopt'. - - On entry to 'getopt', zero means this is the first call; initialize. - - When 'getopt' returns -1, this is the index of the first of the - non-option elements that the caller should itself scan. - - Otherwise, 'optind' communicates from one call to the next - how much of ARGV has been scanned so far. */ - -/* 1003.2 says this must be 1 before any call. */ -int cob_optind = 1; - -/* Formerly, initialization of getopt depended on optind==0, which - causes problems with re-calling getopt as programs generally don't - know that. */ - -static int cob_getopt_initialized = 0; - -/* The next char to be scanned in the option-element - in which the last option character we returned was found. - This allows us to pick up the scan where we left off. - - If this is zero, or a null string, it means resume the scan - by advancing to the next ARGV-element. */ - -static char *nextchar = NULL; - -/* Callers store zero here to inhibit the error message - for unrecognized options. */ - -int cob_opterr = 1; - -/* Set to an option character which was unrecognized. - This must be initialized on some systems to avoid linking in the - system's own getopt implementation. */ - -int cob_optopt = '?'; - -/* Describe how to deal with options that follow non-option ARGV-elements. - - If the caller did not specify anything, - the default is REQUIRE_ORDER if the environment variable - POSIXLY_CORRECT is defined, PERMUTE otherwise. - - REQUIRE_ORDER means don't recognize them as options; - stop option processing when the first non-option is seen. - This is what Unix does. - This mode of operation is selected by either setting the environment - variable POSIXLY_CORRECT, or using '+' as the first character - of the list of option characters. - - PERMUTE is the default. We permute the contents of ARGV as we scan, - so that eventually all the non-options are at the end. This allows options - to be given in any order, even with programs that were not written to - expect this. - - RETURN_IN_ORDER is an option available to programs that were written - to expect options and other ARGV-elements in any order and that care about - the ordering of the two. We describe each non-option ARGV-element - as if it were the argument of an option with character code 1. - Using '-' as the first character of the list of option characters - selects this mode of operation. - - The special argument '--' forces an end of option-scanning regardless - of the value of 'ordering'. In the case of RETURN_IN_ORDER, only - '--' can cause 'getopt' to return -1 with 'optind' != ARGC. */ - -static enum { - REQUIRE_ORDER, PERMUTE, RETURN_IN_ORDER -} ordering; - -/* Handle permutation of arguments. */ - -/* Describe the part of ARGV that contains non-options that have - been skipped. 'first_nonopt' is the index in ARGV of the first of them; - 'last_nonopt' is the index after the last of them. */ - -static int first_nonopt; -static int last_nonopt; - -static int seen_short = 0; - -/* Exchange two adjacent subsequences of ARGV. - One subsequence is elements [first_nonopt,last_nonopt) - which contains all the non-options that have been skipped so far. - The other is elements [last_nonopt,optind), which contains all - the options processed since those non-options were skipped. - - 'first_nonopt' and 'last_nonopt' are relocated so that they describe - the new indices of the non-options in ARGV after they are moved. */ - -static void -exchange (char **argv) -{ - int bottom = first_nonopt; - int middle = last_nonopt; - int top = cob_optind; - char *tem; - - /* Exchange the shorter segment with the far end of the longer segment. - That puts the shorter segment into the right place. - It leaves the longer segment in the right place overall, - but it consists of two parts that need to be swapped next. */ - - while (top > middle && middle > bottom) - { - if (top - middle > middle - bottom) - { - /* Bottom segment is the short one. */ - int len = middle - bottom; - register int i; - - /* Swap it with the top part of the top segment. */ - for (i = 0; i < len; i++) - { - tem = argv[bottom + i]; - argv[bottom + i] = argv[top - (middle - bottom) + i]; - argv[top - (middle - bottom) + i] = tem; -#if 0 /* RXWRXW - swap flags */ - SWAP_FLAGS (bottom + i, top - (middle - bottom) + i); -#endif - } - /* Exclude the moved bottom segment from further swapping. */ - top -= len; - } - else - { - /* Top segment is the short one. */ - int len = top - middle; - register int i; - - /* Swap it with the bottom part of the bottom segment. */ - for (i = 0; i < len; i++) - { - tem = argv[bottom + i]; - argv[bottom + i] = argv[middle + i]; - argv[middle + i] = tem; -#if 0 /* RXWRXW - swap flags */ - SWAP_FLAGS (bottom + i, middle + i); -#endif - } - /* Exclude the moved top segment from further swapping. */ - bottom += len; - } - } - - /* Update records for the slots the non-options now occupy. */ - - first_nonopt += (cob_optind - last_nonopt); - last_nonopt = cob_optind; -} - -/* Initialize the internal data when the first call is made. */ - -static const char *_getopt_initialize (const char *optstring) -{ - /* Start processing options with ARGV-element 1 (since ARGV-element 0 - is the program name); the sequence of previously skipped - non-option ARGV-elements is empty. */ - - first_nonopt = last_nonopt = cob_optind; - - nextchar = NULL; - - /* minimal initialization of the environment like binding textdomain, - allowing test to be run under WIN32 (implied in cob_init(), - no need to call outside of GnuCOBOL); added here as static libcob - possibly doesn't have it set otherwise */ - cob_common_init (NULL); - - /* Determine how to handle the ordering of options and nonoptions. */ - - if (optstring[0] == '-') - { - ordering = RETURN_IN_ORDER; - ++optstring; - } - else if (optstring[0] == '+') - { - ordering = REQUIRE_ORDER; - ++optstring; - } - else - ordering = PERMUTE; - - return optstring; -} - -/* Scan elements of ARGV (whose length is ARGC) for option characters - given in OPTSTRING. - - If an element of ARGV starts with '-', and is not exactly "-" or "--", - then it is an option element. The characters of this element - (aside from the initial '-') are option characters. If 'getopt' - is called repeatedly, it returns successively each of the option characters - from each of the option elements. - - If 'getopt' finds another option character, it returns that character, - updating 'optind' and 'nextchar' so that the next call to 'getopt' can - resume the scan with the following option character or ARGV-element. - - If there are no more option characters, 'getopt' returns -1. - Then 'optind' is the index in ARGV of the first ARGV-element - that is not an option. (The ARGV-elements have been permuted - so that those that are not options now come last.) - - OPTSTRING is a string containing the legitimate option characters. - If an option character is seen that is not listed in OPTSTRING, - return '?' after printing an error message. If you set 'opterr' to - zero, the error message is suppressed but we still return '?'. - - If a char in OPTSTRING is followed by a colon, that means it wants an arg, - so the following text in the same ARGV-element, or the text of the following - ARGV-element, is returned in 'optarg'. Two colons mean an option that - wants an optional arg; if there is text in the current ARGV-element, - it is returned in 'optarg', otherwise 'optarg' is set to zero. - - If OPTSTRING starts with '-' or '+', it requests different methods of - handling the non-option ARGV-elements. - See the comments about RETURN_IN_ORDER and REQUIRE_ORDER, above. - - Long-named options begin with '--' instead of '-'. - Their names may be abbreviated as long as the abbreviation is unique - or is an exact match for some defined option. If they have an - argument, it follows the option name in the same ARGV-element, separated - from the option name by a '=', or else the in next ARGV-element. - When 'getopt' finds a long-named option, it returns 0 if that option's - 'flag' field is nonzero, the value of the option's 'val' field - if the 'flag' field is zero. - - The elements of ARGV aren't really const, because we permute them. - But we pretend they're const in the prototype to be compatible - with other systems. - - LONGOPTS is a vector of 'struct option' terminated by an - element containing a name which is zero. - - LONGIND returns the index in LONGOPT of the long-named option found. - It is only valid when a long-named option has been found by the most - recent call. - - If LONG_ONLY is nonzero, '-' as well as '--' can introduce - long-named options. */ - -int -cob_getopt_long_long (const int argc, char *const *argv, const char *optstring, - const struct option *longopts, int *longind, - const int long_only) -{ - if (argc < 1) - return -1; - - cob_optarg = NULL; - - if (cob_optind == 0 || !cob_getopt_initialized) - { - if (cob_optind == 0) - cob_optind = 1; /* Don't scan ARGV[0], the program name. */ - optstring = _getopt_initialize (optstring); - cob_getopt_initialized = 1; - } - - /* Test whether ARGV[optind] points to a non-option argument. - Either it does not have option syntax, or there is an environment flag - from the shell indicating it is not an option. The later information - is only used when the used in the GNU libc. */ - - if (nextchar == NULL || *nextchar == '\0') - { - /* Advance to the next ARGV-element. */ - - seen_short = 0; - /* Give FIRST_NONOPT & LAST_NONOPT rational values if OPTIND has been - moved back by the user (who may also have changed the arguments). */ - if (last_nonopt > cob_optind) - last_nonopt = cob_optind; - if (first_nonopt > cob_optind) - first_nonopt = cob_optind; - - if (ordering == PERMUTE) - { - /* If we have just processed some options following some non-options, - exchange them so that the options come first. */ - - if (first_nonopt != last_nonopt && last_nonopt != cob_optind) - exchange ((char **) argv); - else if (last_nonopt != cob_optind) - first_nonopt = cob_optind; - - /* Skip any additional non-options - and extend the range of non-options previously skipped. */ - - while (cob_optind < argc && NONOPTION_P) - cob_optind++; - last_nonopt = cob_optind; - } - - /* The special ARGV-element '--' means premature end of options. - Skip it like a null option, - then exchange with previous non-options as if it were an option, - then skip everything else like a non-option. */ - - if (cob_optind != argc && !strcmp (argv[cob_optind], "--")) - { - cob_optind++; - - if (first_nonopt != last_nonopt && last_nonopt != cob_optind) - exchange ((char **) argv); - else if (first_nonopt == last_nonopt) - first_nonopt = cob_optind; - last_nonopt = argc; - - cob_optind = argc; - } - - /* If we have done all the ARGV-elements, stop the scan - and back over any non-options that we skipped and permuted. */ - - if (cob_optind == argc) - { - /* Set the next-arg-index to point at the non-options - that we previously skipped, so the caller will digest them. */ - if (first_nonopt != last_nonopt) - cob_optind = first_nonopt; - return -1; - } - - /* If we have come to a non-option and did not permute it, - either stop the scan or describe it to the caller and pass it by. */ - - if (NONOPTION_P) - { - if (ordering == REQUIRE_ORDER) - return -1; - cob_optarg = argv[cob_optind++]; - return 1; - } - - /* We have found another option-ARGV-element. - Skip the initial punctuation. */ - - nextchar = (argv[cob_optind] + 1 - + (longopts != NULL && argv[cob_optind][1] == '-')); - } - - /* Decode the current option-ARGV-element. */ - - /* Check whether the ARGV-element is a long option. - - If long_only and the ARGV-element has the form "-f", where f is - a valid short option, don't consider it an abbreviated form of - a long option that starts with f. Otherwise there would be no - way to give the -f short option. - - On the other hand, if there's a long option "fubar" and - the ARGV-element is "-fu", do consider that an abbreviation of - the long option, just like "--fu", and not "-f" with arg "u". - - This distinction seems to be the most useful approach. */ - - if (longopts != NULL && (argv[cob_optind][1] == '-' - || (long_only && !seen_short && (argv[cob_optind][2] || !strchr (optstring, argv[cob_optind][1]))))) - { - char *nameend; - unsigned int namelen; - const struct option *p; - const struct option *pfound = NULL; - struct option_list { - const struct option *p; - struct option_list *next; - } *ambig_list = NULL; - struct option_list *ambig_last = NULL; - int exact = 0; - int indfound = -1; - int option_index; - - for (nameend = nextchar; *nameend && *nameend != '='; nameend++) - /* Do nothing. */ ; - namelen = nameend - nextchar; - - /* Test all long options for either exact match - or abbreviated matches. */ - for (p = longopts, option_index = 0; p->name; p++, option_index++) - if (!strncmp (p->name, nextchar, namelen)) { - if (namelen == (unsigned int) strlen (p->name)) { - /* Exact match found. */ - pfound = p; - indfound = option_index; - exact = 1; - break; - } else if (pfound == NULL) { - /* First nonexact match found. */ - pfound = p; - indfound = option_index; - } else if (long_only - || pfound->has_arg != p->has_arg - || pfound->flag != p->flag - || pfound->val != p->val) { - /* Second or later nonexact match found. */ - struct option_list *newp = cob_fast_malloc (sizeof (*newp)); - newp->p = p; - newp->next = ambig_list; - ambig_list = newp; - ambig_last = ambig_list; - } - } - - if (ambig_list != NULL){ - if (!exact) { - if (cob_opterr) { - struct option_list first; - first.p = pfound; - first.next = ambig_list; - ambig_list = &first; - - fprintf (stderr, _("%s: option '%s' is ambiguous; possibilities:"), - argv[0], argv[cob_optind]); - - do { - fprintf (stderr, " '--%s'", ambig_list->p->name); - ambig_list = ambig_list->next; - } - while (ambig_list != NULL); - - fputc ('\n', stderr); - } - } - while (ambig_last != NULL) { - ambig_list = ambig_last; - ambig_last = ambig_last->next; - cob_free (ambig_list); - } - if (!exact) { - nextchar += strlen (nextchar); - cob_optind++; - cob_optopt = 0; - return '?'; - } - } - - if (pfound != NULL) { - option_index = indfound; - cob_optind++; - if (*nameend) - { - /* Don't test has_arg with >, because some C compilers don't - allow it to be used on enums. */ - if (pfound->has_arg) - cob_optarg = nameend + 1; - else - { - if (cob_opterr) - { - if (argv[cob_optind - 1][1] == '-') - { - /* --option */ - fprintf (stderr, _("%s: option '--%s' doesn't allow an argument"), - argv[0], pfound->name); - fputc ('\n', stderr); - } - else - { - /* +option or -option */ - fprintf (stderr, _("%s: option '%c%s' doesn't allow an argument"), - argv[0], argv[cob_optind - 1][0], pfound->name); - fputc ('\n', stderr); - } - } - - nextchar += strlen (nextchar); - - cob_optopt = pfound->val; - return '?'; - } - } - else if (pfound->has_arg == 1) - { - if (cob_optind < argc) - cob_optarg = argv[cob_optind++]; - else - { - if (cob_opterr) - { - fprintf (stderr, _("%s: option '--%s' requires an argument"), - argv[0], argv[cob_optind - 1]); - fputc ('\n', stderr); - } - nextchar += strlen (nextchar); - cob_optopt = pfound->val; - return optstring[0] == ':' ? ':' : '?'; - } - } - nextchar += strlen (nextchar); - if (longind != NULL) - *longind = option_index; - if (pfound->flag) - { - *(pfound->flag) = pfound->val; - return 0; - } - return pfound->val; - } - - /* Can't find it as a long option. If this is not getopt_long_only, - or the option starts with '--' or is not a valid short - option, then it's an error. - Otherwise interpret it as a short option. */ - if (!long_only || argv[cob_optind][1] == '-' - || strchr (optstring, *nextchar) == NULL) - { - if (cob_opterr) - { - if (argv[cob_optind][1] == '-') - { - /* --option */ - fprintf (stderr, _("%s: unrecognized option '--%s'"), - argv[0], nextchar); - fputc ('\n', stderr); - } - else - { - /* +option or -option */ - fprintf (stderr, _("%s: unrecognized option '%c%s'"), - argv[0], argv[cob_optind][0], nextchar); - fputc ('\n', stderr); - } - } - nextchar = (char *) ""; - cob_optind++; - cob_optopt = 0; - return '?'; - } - } - - /* Look at and handle the next short option-character. */ - - { - char c = *nextchar++; - char *temp = strchr (optstring, c); - - /* Increment 'cob_optind' when we start to process its last character. */ - if (*nextchar == '\0') - { - ++cob_optind; - seen_short = 0; - } - - if (temp == NULL || c == ':') - { - if (cob_opterr) - { - fprintf (stderr, _("%s: invalid option -- %c"), argv[0], c); - fputc ('\n', stderr); - } - cob_optopt = c; - seen_short = 0; - return '?'; - } - /* Convenience. Treat POSIX -W foo same as long option --foo */ - if (temp[0] == 'W' && temp[1] == ';') - { - char *nameend; - const struct option *p; - const struct option *pfound = NULL; - int exact = 0; - int ambig = 0; - int indfound = 0; - int option_index; - - /* This is an option that requires an argument. */ - if (*nextchar != '\0') - { - cob_optarg = nextchar; - /* If we end this ARGV-element by taking the rest as an arg, - we must advance to the next element now. */ - cob_optind++; - } - else if (cob_optind == argc) - { - if (cob_opterr) - { - /* 1003.2 specifies the format of this message. */ - fprintf (stderr, _("%s: option requires an argument -- %c"), - argv[0], c); - fputc ('\n', stderr); - } - cob_optopt = c; - if (optstring[0] == ':') - c = ':'; - else - c = '?'; - seen_short = 0; - return c; - } - else - /* We already incremented 'cob_optind' once; - increment it again when taking next ARGV-elt as argument. */ - cob_optarg = argv[cob_optind++]; - - /* cob_optarg is now the argument, see if it's in the - table of longopts. */ - if (!longopts) return '?'; /* silence warning */ - for (nextchar = nameend = cob_optarg; *nameend && *nameend != '='; nameend++) - /* Do nothing. */ ; - - /* Test all long options for either exact match - or abbreviated matches. */ - for (p = longopts, option_index = 0; p->name; p++, option_index++) - if (!strncmp (p->name, nextchar, (size_t)(nameend - nextchar))) - { - if ((unsigned int) (nameend - nextchar) == strlen (p->name)) - { - /* Exact match found. */ - pfound = p; - indfound = option_index; - exact = 1; - break; - } - else if (pfound == NULL) - { - /* First nonexact match found. */ - pfound = p; - indfound = option_index; - } - else - /* Second or later nonexact match found. */ - ambig = 1; - } - if (ambig && !exact) - { - if (cob_opterr) - { - fprintf (stderr, _("%s: option '-W %s' is ambiguous"), - argv[0], argv[cob_optind]); - fputc ('\n', stderr); - } - nextchar += strlen (nextchar); - cob_optind++; - seen_short = 0; - return '?'; - } - if (pfound != NULL) - { - option_index = indfound; - if (*nameend) - { - /* Don't test has_arg with >, because some C compilers don't - allow it to be used on enums. */ - if (pfound->has_arg) - cob_optarg = nameend + 1; - else - { - if (cob_opterr) - { - fprintf (stderr, _("%s: option '-W %s' doesn't allow an argument"), - argv[0], pfound->name); - fputc ('\n', stderr); - } - - nextchar += strlen (nextchar); - seen_short = 0; - return '?'; - } - } - else if (pfound->has_arg == 1) - { - if (cob_optind < argc) - cob_optarg = argv[cob_optind++]; - else - { - if (cob_opterr) - { - fprintf (stderr, _("%s: option '%s' requires an argument"), - argv[0], argv[cob_optind - 1]); - fputc ('\n', stderr); - } - nextchar += strlen (nextchar); - seen_short = 0; - return optstring[0] == ':' ? ':' : '?'; - } - } - nextchar += strlen (nextchar); - if (longind != NULL) - *longind = option_index; - if (pfound->flag) - { - *(pfound->flag) = pfound->val; - return 0; - } - return pfound->val; - } - nextchar = NULL; - return 'W'; /* Let the application handle it. */ - } - if (temp[1] == ':') - { - if (temp[2] == ':') - { - /* This is an option that accepts an argument optionally. */ - if (*nextchar != '\0') - { - cob_optarg = nextchar; - cob_optind++; - } - else - cob_optarg = NULL; - nextchar = NULL; - } - else - { - /* This is an option that requires an argument. */ - if (*nextchar != '\0') - { - cob_optarg = nextchar; - /* If we end this ARGV-element by taking the rest as an arg, - we must advance to the next element now. */ - cob_optind++; - } - else if (cob_optind == argc) - { - if (cob_opterr) - { - /* 1003.2 specifies the format of this message. */ - fprintf (stderr, _("%s: option requires an argument -- %c"), - argv[0], c); - fputc ('\n', stderr); - } - cob_optopt = c; - seen_short = 0; - if (optstring[0] == ':') - c = ':'; - else - c = '?'; - } - else - /* We already incremented 'cob_optind' once; - increment it again when taking next ARGV-elt as argument. */ - cob_optarg = argv[cob_optind++]; - nextchar = NULL; - } - } - seen_short = 1; - return c; - } -} - diff -Nru gnucobol-4.0~early~20200606/libcob/cobgetopt.h gnucobol-5/libcob/cobgetopt.h --- gnucobol-4.0~early~20200606/libcob/cobgetopt.h 2020-06-06 20:52:01.000000000 +0000 +++ gnucobol-5/libcob/cobgetopt.h 1970-01-01 00:00:00.000000000 +0000 @@ -1,122 +0,0 @@ -/* Declarations for getopt. - Copyright (C) 1989-1994, 1996-1999, 2001 Free Software Foundation, Inc. - This file is part of the GNU C Library. - - The GNU C Library is free software; you can redistribute it and/or - modify it under the terms of the GNU Lesser General Public - License as published by the Free Software Foundation; either - version 2.1 of the License, or (at your option) any later version. - - The GNU C Library is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU - Lesser General Public License for more details. - - You should have received a copy of the GNU Lesser General Public - License along with the GNU C Library; if not, write to - the Free Software Foundation, 51 Franklin Street, Fifth Floor - Boston, MA 02110-1301 USA */ - -/* - Copyright (C) 2010,2012 Free Software Foundation, Inc. - Modified for use in GnuCOBOL by Roger While -*/ - -#ifndef COB_GETOPT_H -#define COB_GETOPT_H 1 - -/* For communication from `getopt' to the caller. - When `getopt' finds an option that takes an argument, - the argument value is returned here. - Also, when `ordering' is RETURN_IN_ORDER, - each non-option ARGV-element is returned here. */ - -COB_EXPIMP char *cob_optarg; - -/* Index in ARGV of the next element to be scanned. - This is used for communication to and from the caller - and for communication between successive calls to `getopt'. - - On entry to `getopt', zero means this is the first call; initialize. - - When `getopt' returns -1, this is the index of the first of the - non-option elements that the caller should itself scan. - - Otherwise, `optind' communicates from one call to the next - how much of ARGV has been scanned so far. */ - -COB_EXPIMP int cob_optind; - -/* Callers store zero here to inhibit the error message `getopt' prints - for unrecognized options. */ - -COB_EXPIMP int cob_opterr; - -/* Set to an option character which was unrecognized. */ - -COB_EXPIMP int cob_optopt; - -/* Describe the long-named options requested by the application. - The LONG_OPTIONS argument to getopt_long or getopt_long_only is a vector - of `struct option' terminated by an element containing a name which is - zero. - - The field `has_arg' is: - no_argument (or 0) if the option does not take an argument, - required_argument (or 1) if the option requires an argument, - optional_argument (or 2) if the option takes an optional argument. - - If the field `flag' is not NULL, it points to a variable that is set - to the value given in the field `val' when the option is found, but - left unchanged if the option is not found. - - To have a long-named option do something other than set an `int' to - a compiled-in constant, such as set a value from `optarg', set the - option's `flag' field to zero and its `val' field to a nonzero - value (the equivalent single-letter option character, if there is - one). For long options that have a zero `flag' field, `getopt' - returns the contents of the `val' field. */ - -struct option -{ - const char *name; - /* has_arg can't be an enum because some compilers complain about - type mismatches in all the code that assumes it is an int. */ - int has_arg; - int *flag; - int val; -}; - -/* Names for the values of the `has_arg' field of `struct option'. */ - -#define no_argument 0 -#define required_argument 1 -#define optional_argument 2 - -/* Get definitions and prototypes for functions to process the - arguments in ARGV (ARGC of them, minus the program name) for - options given in OPTS. - - Return the option character from OPTS just read. Return -1 when - there are no more options. For unrecognized options, or options - missing arguments, `optopt' is set to the option letter, and '?' is - returned. - - The OPTS string is a list of characters which are recognized option - letters, optionally followed by colons, specifying that that letter - takes an argument, to be placed in `optarg'. - - If a letter in OPTS is followed by two colons, its argument is - optional. This behavior is specific to the GNU `getopt'. - - The argument `--' causes premature termination of argument - scanning, explicitly telling `getopt' that there are no more - options. - - If OPTS begins with `--', then non-option arguments are treated as - arguments to the option '\0'. This behavior is specific to the GNU - `getopt'. */ - -COB_EXPIMP int cob_getopt_long_long (const int, char *const *, const char *, - const struct option *, int *, const int); -#endif diff -Nru gnucobol-4.0~early~20200606/libcob/coblocal.h gnucobol-5/libcob/coblocal.h --- gnucobol-4.0~early~20200606/libcob/coblocal.h 2020-06-06 20:52:01.000000000 +0000 +++ gnucobol-5/libcob/coblocal.h 1970-01-01 00:00:00.000000000 +0000 @@ -1,498 +0,0 @@ -/* - Copyright (C) 2007-2012, 2014-2019 Free Software Foundation, Inc. - Written by Roger While, Simon Sobisch, Ron Norman - - This file is part of GnuCOBOL. - - The GnuCOBOL runtime library is free software: you can redistribute it - and/or modify it under the terms of the GNU Lesser General Public License - as published by the Free Software Foundation, either version 3 of the - License, or (at your option) any later version. - - GnuCOBOL is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU Lesser General Public License for more details. - - You should have received a copy of the GNU Lesser General Public License - along with GnuCOBOL. If not, see . -*/ - - -#ifndef COB_LOCAL_H -#define COB_LOCAL_H - -#ifdef HAVE_STRINGS_H -#include -#endif - -/* We use this file to define/prototype things that should not be - exported to user space -*/ - -#ifdef HAVE_ISFINITE -#define ISFINITE isfinite -#else -#define ISFINITE finite -#endif - -#ifndef HAVE_ATOLL -#ifdef HAVE_STRTOLL -#ifndef atoll -#define atoll(x) strtoll(x, NULL, 10) -#endif -#endif -#endif - -#ifndef HAVE_ATOL -#ifdef HAVE_STRTOL -#ifndef atol -#define atol(x) strtol(x, NULL, 10) -#endif -#endif -#endif - -#if defined(_MSC_VER) || defined(__BORLANDC__) || defined(__WATCOMC__) - -#include -#undef ISFINITE -#define ISFINITE _finite -#endif - - -#ifdef ENABLE_NLS -#include "lib/gettext.h" -#define _(s) gettext(s) -#define N_(s) gettext_noop(s) -#else -#define _(s) s -#define N_(s) s -#endif - - -#if defined(_WIN32) || defined(__CYGWIN__) -#define COB_HIDDEN extern -#elif defined(__GNUC__) && __GNUC__ >= 4 -/* Also OK for icc which defines __GNUC__ */ -#define COB_HIDDEN extern __attribute__ ((visibility("hidden"))) -#elif defined(__SUNPRO_C) && (__SUNPRO_C >= 0x550) -/* Note - >= 0x590 supports gcc syntax */ -#define COB_HIDDEN extern __hidden -#else -#define COB_HIDDEN extern -#endif - -#ifndef F_OK -#define F_OK 0 -#endif - -#ifndef X_OK -#define X_OK 1 -#endif - -#ifndef W_OK -#define W_OK 2 -#endif - -#ifndef R_OK -#define R_OK 4 -#endif - -/* Stacked field depth */ -#define COB_DEPTH_LEVEL 32U - -/* Not-A-Number */ -#define COB_DECIMAL_NAN -32768 - -/* Infinity */ -#define COB_DECIMAL_INF -32767 - -/* GMP decimal default */ -#define COB_MPZ_DEF 1024UL - -/* GMP floating precision */ -#define COB_MPF_PREC 2048UL - -/* Complex calculation cutoff value */ -/* This MUST be <= COB_MPF_PREC */ -#define COB_MPF_CUTOFF 1024UL - - -/* Floating-decimal */ -#ifdef WORDS_BIGENDIAN -#define COB_128_MSW(x) x[0] -#define COB_128_LSW(x) x[1] -#define COB_MPZ_ENDIAN 1 -#else -#define COB_128_MSW(x) x[1] -#define COB_128_LSW(x) x[0] -#define COB_MPZ_ENDIAN -1 -#endif - -/* Mask for inf/nan */ -#define COB_DEC_SPECIAL COB_U64_C(0x7800000000000000) -/* Mask for extended */ -#define COB_DEC_EXTEND COB_U64_C(0x6000000000000000) -/* Mask for sign */ -#define COB_DEC_SIGN COB_U64_C(0x8000000000000000) - -#define COB_64_IS_SPECIAL(x) ((x & COB_DEC_SPECIAL) == COB_DEC_SPECIAL) -#define COB_128_IS_SPECIAL(x) \ - ((COB_128_MSW(x) & COB_DEC_SPECIAL) == COB_DEC_SPECIAL) -#define COB_64_IS_EXTEND(x) ((x & COB_DEC_EXTEND) == COB_DEC_EXTEND) -#define COB_128_IS_EXTEND(x) \ - ((COB_128_MSW(x) & COB_DEC_EXTEND) == COB_DEC_EXTEND) - -/* Exponent 1 - 10 bits after sign bit */ -#define COB_64_EXPO_1 COB_U64_C(0x7FE0000000000000) -/* Significand 1 */ -#define COB_64_SIGF_1 COB_U64_C(0x001FFFFFFFFFFFFF) -/* Exponent 2 - 10 bits after (sign bit + 2) */ -#define COB_64_EXPO_2 COB_U64_C(0x1FF8000000000000) -/* Significand 2 */ -#define COB_64_SIGF_2 COB_U64_C(0x0007FFFFFFFFFFFF) -/* Extended or bit */ -#define COB_64_OR_EXTEND COB_U64_C(0x0020000000000000) - -/* Exponent 1 - 14 bits after sign bit */ -#define COB_128_EXPO_1 COB_U64_C(0x7FFE000000000000) -/* Significand 1 */ -#define COB_128_SIGF_1 COB_U64_C(0x0001FFFFFFFFFFFF) -/* Exponent 2 - 14 bits after (sign bit + 2) */ -#define COB_128_EXPO_2 COB_U64_C(0x1FFF800000000000) -/* Significand 2 */ -#define COB_128_SIGF_2 COB_U64_C(0x00007FFFFFFFFFFF) -/* Extended or bit */ -#define COB_128_OR_EXTEND COB_U64_C(0x0002000000000000) - -/* Field/attribute initializers */ -#define COB_FIELD_INIT(x,y,z) do { \ - field.size = x; \ - field.data = y; \ - field.attr = z; \ - } ONCE_COB - -#define COB_ATTR_INIT(u,v,x,y,z) do { \ - attr.type = u; \ - attr.digits = v; \ - attr.scale = x; \ - attr.flags = y; \ - attr.pic = z; \ - } ONCE_COB - -#define COB_GET_SIGN(f) \ - (COB_FIELD_HAVE_SIGN (f) ? cob_real_get_sign (f) : 0) -#define COB_PUT_SIGN(f,s) \ - do { if (COB_FIELD_HAVE_SIGN (f)) cob_real_put_sign (f, s); } ONCE_COB - -#ifdef COB_PARAM_CHECK -#define COB_CHK_PARMS(x,z) \ - cob_parameter_check (#x, z) -#else -#define COB_CHK_PARMS(x,z) -#endif - -/* byte offset to structure member */ -#if !defined(_OFFSET_OF_) && !defined(offsetof) -#define _OFFSET_OF_ -#define offsetof(s_name,m_name) (int)(long)&(((s_name*)0))->m_name -#endif - -/* Convert between a digit and an integer (e.g., '0' <-> 0) */ -#define COB_D2I(x) ((x) - '0') -#define COB_I2D(x) (char) ((x) + '0') - -#define COB_MODULE_PTR cobglobptr->cob_current_module -#define COB_TERM_BUFF cobglobptr->cob_term_buff -#define COB_ACCEPT_STATUS cobglobptr->cob_accept_status -#define COB_MAX_Y_COORD cobglobptr->cob_max_y -#define COB_MAX_X_COORD cobglobptr->cob_max_x - -#define COB_DISP_TO_STDERR cobsetptr->cob_disp_to_stderr -#define COB_BEEP_VALUE cobsetptr->cob_beep_value -#define COB_TIMEOUT_SCALE cobsetptr->cob_timeout_scale -#define COB_INSERT_MODE cobsetptr->cob_insert_mode -#define COB_EXTENDED_STATUS cobsetptr->cob_extended_status -#define COB_MOUSE_FLAGS cobsetptr->cob_mouse_flags -#define COB_MOUSE_INTERVAL cobsetptr->cob_mouse_interval -#define COB_USE_ESC cobsetptr->cob_use_esc - -#ifdef __cplusplus -extern "C" { -#endif - -/* Global settings structure */ - -typedef struct __cob_settings { - unsigned int cob_display_warn; /* Display warnings */ - unsigned int cob_env_mangle; /* Mangle env names */ - unsigned int cob_debugging_mode; /* Activate USE ON DEBUGGING procedures */ - unsigned int cob_line_trace; /* Activate tracing for routines compiled with trace flag */ - unsigned int cob_config_cur; /* Current runtime.cfg file being processed */ - unsigned int cob_config_num; /* Number of different runtime.cfg files read */ - char **cob_config_file; /* Keep all file names for later reporting */ - char *cob_trace_filename; /* File to write TRACE[ALL] information to */ - char *cob_trace_format; /* Format of trace line */ - char *cob_user_name; - char *cob_sys_lang; /* LANG setting from env */ - char *cob_sys_term; /* TERM setting from env */ - char *cob_sys_type; /* OSTYPE setting from env */ - char *cob_debug_log; - char *cob_date; /* Date override for testing purposes / UTC hint */ - struct cob_time cob_time_constant; - - /* call.c */ - unsigned int cob_physical_cancel; - unsigned int name_convert; - char *cob_preload_str; - char *cob_library_path; - char *cob_preload_str_set; - - size_t *resolve_size; /* Array size of resolve_path*/ - char *cob_preload_resolved; - char *cob_preload_env; - - /* fileio.c */ - unsigned int cob_unix_lf; /* Use POSIX LF */ - unsigned int cob_do_sync; - unsigned int cob_ls_uses_cr; /* Line Sequential uses CR LF */ - unsigned int cob_ls_fixed; /* Line Sequential is fixed length */ - unsigned int cob_ls_nulls; /* NUL insert to Line Sequential */ - unsigned int cob_ls_split; /* Split 'too long' record into parts (Default is truncate) */ - unsigned int cob_ls_validate; /* Validate data in Line Sequential */ - unsigned int cob_mf_ls_nulls; /* MF file: NUL insert to Line Sequential */ - unsigned int cob_mf_ls_split; /* MF file: Split 'too long' record into parts */ - unsigned int cob_mf_ls_validate; /* MF file: Validate data in Line Sequential */ - unsigned int cob_varseq_type; /* Variable Sequential Default file format */ - unsigned int cob_varrel_type; /* Variable Relative default file format */ - unsigned int cob_fixrel_type; /* Fixed Relative default file format */ - unsigned int cob_mf_files; /* If TRUE, use Micro Focus file formats */ - unsigned int cob_gc_files; /* If TRUE, revert back to old GNU Cobol file formats */ - unsigned int cob_retry_times; /* Default: RETRY n TIMES value */ - unsigned int cob_retry_seconds; /* Default: RETRY n SECONDS value */ - unsigned int cob_trace_io; /* If TRACE READY, also dump File/Record/Status */ - unsigned int cob_stats_record; /* If record I/O statics */ - unsigned int cob_share_mode; /* Default file share mode */ - unsigned int cob_retry_mode; /* Default file retry mode */ - unsigned int cob_keycheck; /* Default KEYCHECK mode */ - unsigned int cob_file_dict; /* When to use filename.dd (File definition) */ - unsigned int cob_bdb_byteorder; /* Byte order to use for BDB files */ - unsigned int cob_create_table; /* Generate CREATE TABLE at runtime if needed */ - char *cob_dictionary_path; /* Place to write filename.dd stats */ - char *cob_stats_filename; /* Place to write I/O stats */ - char *cob_file_path; - char *bdb_home; - char *lmdb_home; - size_t cob_sort_memory; - size_t cob_sort_chunk; - - /* move.c */ - unsigned int cob_local_edit; - - /* screenio.c */ - unsigned int cob_legacy; - unsigned int cob_disp_to_stderr; /* Redirect to stderr */ - unsigned int cob_beep_value; /* Bell disposition */ - unsigned int cob_extended_status; /* Extended status */ - unsigned int cob_mouse_flags; /* Mouse flags to mask to COBOL, values according to ACUCOBOL */ - unsigned int cob_mouse_interval; /* time to recognize a click, 0 = click resolution disabled */ - unsigned int cob_use_esc; /* Check ESC key */ - unsigned int cob_timeout_scale; /* timeout scale */ - unsigned int cob_insert_mode; /* insert toggle, 0=off, 1=on */ - unsigned int cob_exit_wait; /* wait on program exit if no ACCEPT came after last DISPLAY */ - const char *cob_exit_msg; /* message for cob_exit_wait */ - - - /* reportio.c */ - unsigned int cob_col_just_lrc; /* Justify data in column LEFT/RIGHT/CENTER */ - - /* termio.c */ - char *cob_display_print_pipe; /* DISPLAY UPON PRINTER destination */ - char *cob_display_print_filename; /* File name for DISPLAY UPON PRINTER */ - - char *cob_display_punch_filename; /* File name for DISPLAY UPON SYSPUNCH/SYSPCH */ - FILE *cob_display_punch_file; /* possibly external FILE* to write DISPLAY UPON SYSPUNCH information to - cob_display_punch_filename is used to open the file - on first DISPLAY UPON SYSPCH statement and closed - on runtime exit */ - - /* common.c */ - char external_trace_file; /* use external FILE * for TRACE[ALL] */ - FILE *cob_trace_file; /* FILE* to write TRACE[ALL] information to */ - FILE *cob_display_print_file; /* external FILE* to write DISPLAY UPON PRINTER information to - if not external cob_display_print_filename is always opened - before each DISPLAY UPON PRINTER and closed afterwards */ - FILE *cob_dump_file; /* FILE* to write DUMP information to */ - - char *cob_dump_filename; /* Place to write dump of variables */ - int cob_dump_width; /* Max line width for dump */ -} cob_settings; - - -struct config_enum { - const char *match; /* Alternate word that could be used */ - const char *value; /* Internal value for this 'word' */ -}; - -/* Format of table for capturing run-time config information */ -struct config_tbl { - const char *env_name; /* Env Var name */ - const char *conf_name; /* Name used in run-time config file */ - const char *default_val; /* Default value */ - struct config_enum *enums; /* Table of Alternate values */ - int env_group; /* Grouping for display of run-time options */ - int data_type; /* Data type */ - int data_loc; /* Location within structure */ - int data_len; /* Length of referenced field */ - int config_num; /* Set by which runtime.cfg file */ - int set_by; /* value set by a different keyword */ - long min_value; /* Minimum accepted value */ - unsigned long max_value; /* Maximum accepted value */ -}; - -#define ENV_NOT (1 << 1) /* Negate True/False value setting */ -#define ENV_UINT (1 << 2) /* an 'unsigned int' */ -#define ENV_SINT (1 << 3) /* a 'signed int' */ -#define ENV_SIZE (1 << 4) /* size; number with K - kb, M - mb, G - GB */ -#define ENV_BOOL (1 << 5) /* int boolean; Yes, True, 1, No, False, 0, ... */ -#define ENV_CHAR (1 << 6) /* inline 'char[]' field */ -#define ENV_STR (1 << 7) /* a pointer to a string */ -#define ENV_PATH (1 << 8) /* a pointer to one or more file system paths [fp1:fp2:fp3] */ -#define ENV_ENUM (1 << 9) /* Value must in 'enum' list as match */ -#define ENV_ENUMVAL (1 << 10) /* Value must in 'enum' list as match or value */ -#define ENV_FILE (1 << 11) /* a pointer to a directory/file [single path] */ - -#define ENV_RESETS (1 << 14) /* Value setting needs additional code */ - -#define STS_ENVSET (1 << 15) /* value set via Env Var */ -#define STS_CNFSET (1 << 16) /* value set via config file */ -#define STS_ENVCLR (1 << 17) /* value removed from Env Var */ -#define STS_RESET (1 << 18) /* value was reset back to default */ -#define STS_FNCSET (1 << 19) /* value set via function call */ - -#define GRP_HIDE 0 -#define GRP_CALL 1 -#define GRP_FILE 2 -#define GRP_SCREEN 3 -#define GRP_MISC 4 -#define GRP_SYSENV 5 -#define GRP_MAX 6 - -#define SETPOS(member) offsetof(cob_settings,member),sizeof(cobsetptr->member),0,0 - - -/* Local function prototypes */ -COB_HIDDEN void cob_init_numeric (cob_global *); -COB_HIDDEN void cob_init_termio (cob_global *, cob_settings *); -COB_HIDDEN void cob_init_fileio (cob_global *, cob_settings *); -COB_HIDDEN void cob_init_reportio (cob_global *, cob_settings *); -COB_HIDDEN void cob_init_call (cob_global *, cob_settings *, const int); -COB_HIDDEN void cob_init_intrinsic (cob_global *); -COB_HIDDEN void cob_init_strings (cob_global *); -COB_HIDDEN void cob_init_move (cob_global *, cob_settings *); -COB_HIDDEN void cob_init_screenio (cob_global *, cob_settings *); -COB_HIDDEN void cob_init_mlio (cob_global * const); - -COB_HIDDEN void cob_print_field (FILE *, cob_field *, int, int); - -COB_HIDDEN char *cob_get_filename_print (cob_file *, const int); -COB_HIDDEN void cob_fork_fileio (cob_global *, cob_settings *); -COB_HIDDEN void free_extfh_fcd (void); - -COB_HIDDEN void cob_exit_screen (void); -COB_HIDDEN void cob_exit_numeric (void); -COB_HIDDEN void cob_exit_fileio (void); -COB_HIDDEN void cob_exit_reportio (void); -COB_HIDDEN void cob_exit_call (void); -COB_HIDDEN void cob_exit_intrinsic (void); -COB_HIDDEN void cob_exit_strings (void); -COB_HIDDEN void cob_exit_mlio (void); - -COB_HIDDEN int cob_real_get_sign (cob_field *); -COB_HIDDEN void cob_real_put_sign (cob_field *, const int); - -#ifndef COB_WITHOUT_DECIMAL -COB_HIDDEN void cob_decimal_init2 (cob_decimal *, const cob_uli_t); -#endif -COB_HIDDEN void cob_decimal_setget_fld (cob_field *, cob_field *, - const int); -COB_HIDDEN void cob_decimal_move_temp (cob_field *, cob_field *); -COB_HIDDEN void cob_print_ieeedec (const cob_field *, FILE *); -COB_HIDDEN void cob_print_realbin (const cob_field *, FILE *, - const int); - -COB_HIDDEN void cob_screen_set_mode (const cob_u32_t); -COB_HIDDEN void cob_settings_screenio (void); - -COB_HIDDEN int cob_get_last_exception_code (void); -COB_HIDDEN int cob_check_env_true (char*); -COB_HIDDEN int cob_check_env_false (char*); -COB_HIDDEN const char *cob_get_last_exception_name (void); -COB_HIDDEN void cob_field_to_string (const cob_field *, void *, - const size_t); -COB_HIDDEN void cob_parameter_check (const char *, const int); -COB_HIDDEN void cob_runtime_hint (const char *, ...) COB_A_FORMAT12; -COB_HIDDEN void cob_runtime_error (const char *, ...) COB_A_FORMAT12; -COB_HIDDEN void cob_runtime_warning_external (const char *, const int, - const char *, ...) COB_A_FORMAT34; -COB_HIDDEN void cob_runtime_warning (const char *, ...) COB_A_FORMAT12; - -COB_HIDDEN cob_settings *cob_get_settings_ptr (void); - -/* COB_DEBUG_LOG Macros and routines found in common.c */ -#ifdef COB_DEBUG_LOG -COB_HIDDEN int cob_debug_logit (int level, char *module); -COB_HIDDEN int cob_debug_logger (const char *fmt, ... ); -COB_HIDDEN int cob_debug_dump (void *mem, int len); -#define DEBUG_TRACE(module, arglist) cob_debug_logit(3, (char*)module) ? 0 : cob_debug_logger arglist -#define DEBUG_WARN(module, arglist) cob_debug_logit(2, (char*)module) ? 0 : cob_debug_logger arglist -#define DEBUG_LOG(module, arglist) cob_debug_logit(0, (char*)module) ? 0 : cob_debug_logger arglist -#define DEBUG_DUMP_TRACE(module, mem, len) cob_debug_logit(3, (char*)module) ? 0 : cob_debug_dump(mem, len) -#define DEBUG_DUMP_WARN(module, mem, len) cob_debug_logit(2, (char*)module) ? 0 : cob_debug_dump(mem, len) -#define DEBUG_DUMP(module, mem, len) cob_debug_logit(0, (char*)module) ? 0 : cob_debug_dump(mem, len) -#define DEBUG_ISON_TRACE(module) !cob_debug_logit(3, (char*)module) -#define DEBUG_ISON_WARN(module) !cob_debug_logit(2, (char*)module) -#define DEBUG_ISON(module) !cob_debug_logit(0, (char*)module) -#else -#define DEBUG_TRACE(module, arglist) -#define DEBUG_WARN(module, arglist) -#define DEBUG_LOG(module, arglist) -#define DEBUG_DUMP_TRACE(module, mem, len) -#define DEBUG_DUMP_WARN(module, mem, len) -#define DEBUG_DUMP(module, mem, len) -/* Note: no definition for DEBUG_ISON_TRACE, DEBUG_ISON_WARN, DEBUG_ISON - as these parts should be surrounded by #ifdef COB_DEBUG_LOG */ -#endif -COB_HIDDEN FILE *cob_get_dump_file (void); - -#if 0 /* currently not used */ -COB_HIDDEN char *cob_int_to_string (int, char*); -COB_HIDDEN char *cob_int_to_formatted_bytestring (int, char*); -#endif -COB_HIDDEN char *cob_strcat (char*, char*, int); -COB_HIDDEN char *cob_strjoin (char**, int, char*); - -COB_HIDDEN void cob_set_field_to_uint (cob_field *, const cob_u32_t); - -/* static inline of smaller helpers */ - -static COB_INLINE int -cob_min_int (const int x, const int y) -{ - if (x < y) return x; - return y; -} - -static COB_INLINE int -cob_max_int (const int x, const int y) -{ - if (x > y) return x; - return y; -} - - -#ifdef __cplusplus -} -#endif - -#endif /* COB_LOCAL_H */ diff -Nru gnucobol-4.0~early~20200606/libcob/common.c gnucobol-5/libcob/common.c --- gnucobol-4.0~early~20200606/libcob/common.c 2020-06-06 20:52:01.000000000 +0000 +++ gnucobol-5/libcob/common.c 1970-01-01 00:00:00.000000000 +0000 @@ -1,8582 +0,0 @@ -/* - Copyright (C) 2001-2012, 2014-2020 Free Software Foundation, Inc. - Written by Keisuke Nishida, Roger While, Simon Sobisch, Ron Norman - - This file is part of GnuCOBOL. - - The GnuCOBOL runtime library is free software: you can redistribute it - and/or modify it under the terms of the GNU Lesser General Public License - as published by the Free Software Foundation, either version 3 of the - License, or (at your option) any later version. - - GnuCOBOL is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU Lesser General Public License for more details. - - You should have received a copy of the GNU Lesser General Public License - along with GnuCOBOL. If not, see . -*/ - -#include -#include -#include - -#include -#include -#include -#include -#include -#include -#include -#include -#include - -#include -#ifdef HAVE_FINITE_IEEEFP_H -#include -#endif - -#include - -#ifdef HAVE_UNISTD_H -#include -#endif -#ifdef HAVE_SYS_TIME_H -#include -#endif -#ifdef HAVE_SYS_WAIT_H -#include -#endif - -#ifdef _WIN32 -#define WIN32_LEAN_AND_MEAN -#include -#undef MOUSE_MOVED -#include -#include -#include -#endif - -#ifdef HAVE_SIGNAL_H -#include -#endif - -#ifdef HAVE_LOCALE_H -#include -#endif - -/* library headers for version output */ -#ifdef _WIN32 -#ifndef __GMP_LIBGMP_DLL -#define __GMP_LIBGMP_DLL 1 -#endif -#endif -#include - -#ifdef WITH_DB -#include -#endif -#ifdef WITH_OCI -#include -#endif -#if defined (WITH_ODBC) -#include -#include -#endif -#ifdef WITH_LMDB -#include -#endif -#ifdef WITH_VBISAM -#include -#endif - -#if defined (HAVE_NCURSESW_NCURSES_H) -#include -#elif defined (HAVE_NCURSESW_CURSES_H) -#include -#elif defined (HAVE_NCURSES_H) -#include -#elif defined (HAVE_NCURSES_NCURSES_H) -#include -#elif defined (HAVE_PDCURSES_H) -/* will internally define NCURSES_MOUSE_VERSION with - a recent version (for older version define manually): */ -#define PDC_NCMOUSE /* use ncurses compatible mouse API */ -#include -#define COB_GEN_SCREENIO -#elif defined (HAVE_CURSES_H) -#define PDC_NCMOUSE /* see comment above */ -#include -#ifndef PDC_MOUSE_MOVED -#undef PDC_NCMOUSE -#endif -#endif - -/* note: checked library instead of headers as those may not be usable! */ -#ifdef WITH_XML2 -#if !defined (HAVE_LIBXML_XMLVERSION_H) || \ - !defined (HAVE_LIBXML_XMLWRITER_H) -#error XML2 without necessary headers -#endif -#include -#include -#endif - -#ifdef WITH_CJSON -#if defined HAVE_CJSON_CJSON_H -#include -#elif defined HAVE_CJSON_H -#include -#else -#error CJSON without necessary header -#endif -#endif -/* end of library headers */ - -#include "sysdefines.h" - -#include "lib/gettext.h" - -/* Force symbol exports */ -#define COB_LIB_EXPIMP -#include "libcob.h" -#include "coblocal.h" - -#include "libcob/cobgetopt.h" - -/* sanity checks */ -#if COB_MAX_WORDLEN > 255 -#error COB_MAX_WORDLEN is too big, must be less than 256 -#endif -#if COB_MAX_NAMELEN > COB_MAX_WORDLEN -#error COB_MAX_NAMELEN is too big, must be less than COB_MAX_WORDLEN -#endif - -#define CB_IMSG_SIZE 24 -#define CB_IVAL_SIZE (80 - CB_IMSG_SIZE - 4) - -#if COB_MAX_UNBOUNDED_SIZE > COB_MAX_FIELD_SIZE -#define COB_MAX_ALLOC_SIZE COB_MAX_UNBOUNDED_SIZE -#else -#define COB_MAX_ALLOC_SIZE COB_MAX_FIELD_SIZE -#endif - -struct cob_alloc_cache { - struct cob_alloc_cache *next; /* Pointer to next */ - void *cob_pointer; /* Pointer to malloced space */ - size_t size; /* Item size */ -}; - -struct cob_alloc_module { - struct cob_alloc_module *next; /* Pointer to next */ - void *cob_pointer; /* Pointer to malloced space */ -}; - -/* EXTERNAL structure */ - -struct cob_external { - struct cob_external *next; /* Pointer to next */ - void *ext_alloc; /* Pointer to malloced space */ - char *ename; /* External name */ - int esize; /* Item size */ -}; - -#define COB_ERRBUF_SIZE 1024 - -/* Local variables */ - -static int cob_initialized = 0; -static int check_mainhandle = 1; -static int cob_argc = 0; -static char **cob_argv = NULL; -static struct cob_alloc_cache *cob_alloc_base = NULL; -static struct cob_alloc_module *cob_module_list = NULL; -static cob_module *cob_module_err = NULL; -static const char *cob_last_sfile = NULL; -static const char *cob_last_progid = NULL; - -static cob_global *cobglobptr = NULL; -static cob_settings *cobsetptr = NULL; - -static int last_exception_code; /* Last exception: code */ -static int active_error_handler = 0; -static char *runtime_err_str = NULL; - -static const cob_field_attr const_alpha_attr = - {COB_TYPE_ALPHANUMERIC, 0, 0, 0, NULL}; -static const cob_field_attr const_bin_nano_attr = - {COB_TYPE_NUMERIC_BINARY, 20, 9, - COB_FLAG_HAVE_SIGN, NULL}; - -static char *cob_local_env = NULL; -static int current_arg = 0; -static unsigned char *commlnptr = NULL; -static size_t commlncnt = 0; -static size_t cob_local_env_size = 0; - -static struct cob_external *basext = NULL; - -static size_t sort_nkeys = 0; -static cob_file_key *sort_keys = NULL; -static const unsigned char *sort_collate = NULL; - -static const char *cob_current_program_id = NULL; -static const char *cob_current_section = NULL; -static const char *cob_current_paragraph = NULL; -static const char *cob_source_file = NULL; -static const char *cob_source_statement = NULL; -static unsigned int cob_source_line = 0; - -#ifdef COB_DEBUG_LOG -static int cob_debug_log_time = 0; -static FILE *cob_debug_file = NULL; -static int cob_debug_level = 9; -static char *cob_debug_mod = NULL; -#define DEBUG_MOD_LEN 6 -#define DEBUG_MOD_MAX 12 -static char cob_debug_modules[DEBUG_MOD_MAX][DEBUG_MOD_LEN+1] = - {" ", " ", " ", " ", " ", " ", " ", " ", " ", " ", " ", " "}; -static char *cob_debug_file_name = NULL; -#endif - -static char *strbuff = NULL; - -static int cob_process_id = 0; -static int cob_temp_iteration = 0; - -static unsigned int conf_runtime_error_displayed = 0; -static unsigned int last_runtime_error_line = 0; -static const char *last_runtime_error_file = NULL; - -/* List of dynamically allocated field attributes */ -static struct dyn_attr { - struct dyn_attr *next; - cob_field_attr attr; -} *dyn_attr_list = NULL; - - -#if defined(HAVE_SIGNAL_H) && defined(HAVE_SIG_ATOMIC_T) -static volatile sig_atomic_t sig_is_handled = 0; -#endif - -/* Function Pointer for external signal handling */ -static void (*cob_ext_sighdl) (int) = NULL; - -#if defined (_MSC_VER) && COB_USE_VC2008_OR_GREATER -static VOID (WINAPI *time_as_filetime_func) (LPFILETIME) = NULL; -#endif - -#undef COB_EXCEPTION -#define COB_EXCEPTION(code, tag, name, critical) name, -static const char * const cob_exception_tab_name[] = { - "None", /* COB_EC_ZERO */ -#include "exception.def" - "Invalid" /* COB_EC_MAX */ -}; - -#undef COB_EXCEPTION -#define COB_EXCEPTION(code, tag, name, critical) 0x##code, -static const int cob_exception_tab_code[] = { - 0, /* COB_EC_ZERO */ -#include "exception.def" - 0 /* COB_EC_MAX */ -}; - -#undef COB_EXCEPTION - -#define EXCEPTION_TAB_SIZE sizeof (cob_exception_tab_code) / sizeof (int) - -/* Switches */ -#define COB_SWITCH_MAX 36 /* (must match cobc/tree.h)*/ - -static int cob_switch[COB_SWITCH_MAX + 1]; - -/* Runtime exit handling */ -static struct exit_handlerlist { - struct exit_handlerlist *next; - int (*proc)(void); -} *exit_hdlrs; - -/* Runtime error handling */ -static struct handlerlist { - struct handlerlist *next; - int (*proc)(char *s); -} *hdlrs; - -/* note: set again (translated) in print_runtime_conf */ -static const char *setting_group[] = {" hidden setting ", "CALL configuration", - "File I/O configuration", "Screen I/O configuration", "Miscellaneous", - "System configuration"}; - -static struct config_enum lwrupr[] = {{"LOWER", "1"}, {"UPPER", "2"}, {"not set", "0"}, {NULL, NULL}}; -static struct config_enum beepopts[] = {{"FLASH", "1"}, {"SPEAKER", "2"}, {"FALSE", "9"}, {"BEEP", "0"}, {NULL, NULL}}; -static struct config_enum timeopts[] = {{"0", "1000"}, {"1", "100"}, {"2", "10"}, {"3", "1"}, {NULL, NULL}}; -static struct config_enum syncopts[] = {{"P", "1"}, {NULL, NULL}}; -static struct config_enum varseqopts[] = {{"0", "0"}, {"1", "1"}, {"2", "2"}, {"3", "3"}, - {"mf","11"},{"gc","10"}, - {"b4","4"},{"b32","4"}, - {"l4","6"},{"l32","6"}, - {NULL, NULL}}; -/* Make sure the values here match up with those defined in common.h */ -static struct config_enum relopts[] = { - {"0","0"},{"gc","10"},{"mf","11"}, - {"b4","4"},{"b32","4"},{"b8","5"},{"b64","5"}, - {"l4","6"},{"l32","6"},{"l8","7"},{"l64","7"}, - {NULL,NULL}}; -static char varrel_dflt[8] = "gc"; /* Default Variable length Relative file format */ -static char fixrel_dflt[8] = "gc"; /* Default Fixed length Relative file format */ -static struct config_enum shareopts[] = {{"none","0"},{"read","1"},{"all","2"},{"no","4"},{NULL,NULL}}; -static struct config_enum retryopts[] = {{"none","0"},{"never","64"},{"forever","8"},{NULL,NULL}}; -static struct config_enum dict_opts[] = {{"false","0"},{"true","1"},{"always","2"}, - {"no","0"},{"min","1"},{"max","2"},{NULL,NULL}}; -static char varseq_dflt[8] = "0"; /* varseq0: Default Variable length Sequential file format */ -static struct config_enum bdborder[] = { - {"native","0"}, - {"big-endian","1"},{"little-endian","2"}, - {"big_endian","1"},{"little_endian","2"}, - {NULL,NULL}}; -static char min_conf_length = 0; -static const char *not_set; - -/* - * Table of possible environment variables and/or runtime.cfg parameters: - Env Var name, Name used in run-time config file, Default value (NULL for aliases), Table of Alternate values, - Grouping for display of run-time options, Data type, Location within structure (adds computed length of referenced field), - Set by which runtime.cfg file, value set by a different keyword, - optional: Minimum accepted value, Maximum accepted value - */ -static struct config_tbl gc_conf[] = { - {"COB_LOAD_CASE", "load_case", "0", lwrupr, GRP_CALL, ENV_UINT | ENV_ENUMVAL, SETPOS (name_convert)}, - {"COB_PHYSICAL_CANCEL", "physical_cancel", "0", NULL, GRP_CALL, ENV_BOOL, SETPOS (cob_physical_cancel)}, - {"default_cancel_mode", "default_cancel_mode", NULL, NULL, GRP_HIDE, ENV_BOOL | ENV_NOT, SETPOS (cob_physical_cancel)}, - {"LOGICAL_CANCELS", "logical_cancels", NULL, NULL, GRP_HIDE, ENV_BOOL | ENV_NOT, SETPOS (cob_physical_cancel)}, - {"COB_PRE_LOAD", "pre_load", NULL, NULL, GRP_CALL, ENV_STR, SETPOS (cob_preload_str)}, - {"COB_BELL", "bell", "0", beepopts, GRP_SCREEN, ENV_UINT | ENV_ENUMVAL, SETPOS (cob_beep_value)}, - {"COB_DEBUG_LOG", "debug_log", NULL, NULL, GRP_HIDE, ENV_FILE, SETPOS (cob_debug_log)}, - {"COB_DISABLE_WARNINGS", "disable_warnings", "0", NULL, GRP_MISC, ENV_BOOL | ENV_NOT, SETPOS (cob_display_warn)}, - {"COB_ENV_MANGLE", "env_mangle", "0", NULL, GRP_MISC, ENV_BOOL, SETPOS (cob_env_mangle)}, - {"COB_COL_JUST_LRC", "col_just_lrc", "true", NULL, GRP_MISC, ENV_BOOL, SETPOS (cob_col_just_lrc)}, - {"COB_REDIRECT_DISPLAY", "redirect_display", "0", NULL, GRP_SCREEN, ENV_BOOL, SETPOS (cob_disp_to_stderr)}, - {"COB_SCREEN_ESC", "screen_esc", "0", NULL, GRP_SCREEN, ENV_BOOL, SETPOS (cob_use_esc)}, - {"COB_SCREEN_EXCEPTIONS", "screen_exceptions", "0", NULL, GRP_SCREEN, ENV_BOOL, SETPOS (cob_extended_status)}, - {"COB_TIMEOUT_SCALE", "timeout_scale", "0", timeopts, GRP_SCREEN, ENV_UINT, SETPOS (cob_timeout_scale)}, - {"COB_INSERT_MODE", "insert_mode", "0", NULL, GRP_SCREEN, ENV_BOOL, SETPOS (cob_insert_mode)}, - {"COB_MOUSE_FLAGS", "mouse_flags", "1", NULL, GRP_SCREEN, ENV_UINT, SETPOS (cob_mouse_flags)}, - {"MOUSE_FLAGS", "mouse_flags", NULL, NULL, GRP_HIDE, ENV_UINT, SETPOS (cob_mouse_flags)}, -#ifdef HAVE_MOUSEINTERVAL /* possibly add an internal option for mouse support, too */ - {"COB_MOUSE_INTERVAL", "mouse_interval", "100", NULL, GRP_SCREEN, ENV_UINT, SETPOS (cob_mouse_interval), 0, 166}, -#endif - {"COB_SET_DEBUG", "debugging_mode", "0", NULL, GRP_MISC, ENV_BOOL | ENV_RESETS, SETPOS (cob_debugging_mode)}, - {"COB_SET_TRACE", "set_trace", "0", NULL, GRP_MISC, ENV_BOOL, SETPOS (cob_line_trace)}, - {"COB_TRACE_FILE", "trace_file", NULL, NULL, GRP_MISC, ENV_FILE, SETPOS (cob_trace_filename)}, - {"COB_TRACE_FORMAT", "trace_format", "%P %S Line: %L", NULL,GRP_MISC, ENV_STR, SETPOS (cob_trace_format)}, - {"COB_TRACE_IO","trace_io", NULL, NULL,GRP_FILE,ENV_BOOL,SETPOS(cob_trace_io)}, - {"COB_DUMP_FILE", "dump_file", NULL, NULL, GRP_MISC, ENV_FILE, SETPOS (cob_dump_filename)}, - {"COB_DUMP_WIDTH", "dump_width", "100", NULL, GRP_MISC, ENV_UINT, SETPOS (cob_dump_width)}, - {"COB_STATS_RECORD","stats_record", NULL, NULL,GRP_MISC,ENV_BOOL,SETPOS(cob_stats_record)}, - {"COB_STATS_FILE","stats_file", NULL, NULL,GRP_MISC,ENV_FILE,SETPOS(cob_stats_filename)}, -#ifdef _WIN32 - /* checked before configuration load if set from environment in cob_common_init() */ - {"COB_UNIX_LF", "unix_lf", "0", NULL, GRP_FILE, ENV_BOOL, SETPOS (cob_unix_lf)}, -#endif - {"USERNAME", "username", NULL, NULL, GRP_SYSENV, ENV_STR, SETPOS (cob_user_name)}, /* default set in cob_init() */ - {"LOGNAME", "logname", NULL, NULL, GRP_HIDE, ENV_STR, SETPOS (cob_user_name)}, -#if !defined (_WIN32) || defined (__MINGW32__) /* cygwin does not define _WIN32 */ - {"LANG", "lang", NULL, NULL, GRP_SYSENV, ENV_STR, SETPOS (cob_sys_lang)}, -#if defined (__linux__) || defined (__CYGWIN__) || defined (__MINGW32__) - {"OSTYPE", "ostype", NULL, NULL, GRP_SYSENV, ENV_STR, SETPOS (cob_sys_type)}, -#endif - {"TERM", "term", NULL, NULL, GRP_SYSENV, ENV_STR, SETPOS (cob_sys_term)}, -#endif -#if defined (_WIN32) && !defined (__MINGW32__) - {"OS", "ostype", NULL, NULL, GRP_SYSENV, ENV_STR, SETPOS (cob_sys_type)}, -#endif - {"COB_FILE_PATH","file_path", NULL, NULL,GRP_FILE,ENV_PATH,SETPOS(cob_file_path)}, - {"COB_LIBRARY_PATH","library_path", NULL, NULL,GRP_CALL,ENV_PATH,SETPOS(cob_library_path)}, /* default value set in cob_init_call() */ - {"COB_MF_FILES","mf_files", "false",NULL,GRP_FILE,ENV_BOOL,SETPOS(cob_mf_files)}, - {"COB_FIXREL_FORMAT","fixrel_format", fixrel_dflt,relopts,GRP_FILE,ENV_UINT|ENV_ENUM,SETPOS(cob_fixrel_type)}, - {"COB_VARREL_FORMAT","varrel_format", varrel_dflt,relopts,GRP_FILE,ENV_UINT|ENV_ENUM,SETPOS(cob_varrel_type)}, - {"COB_VARSEQ_FORMAT","varseq_format", varseq_dflt,varseqopts,GRP_FILE,ENV_UINT|ENV_ENUM,SETPOS(cob_varseq_type)}, - {"COB_BDB_BYTEORDER","bdb_byteorder", "native",bdborder,GRP_FILE,ENV_UINT|ENV_ENUM,SETPOS(cob_bdb_byteorder)}, - {"COB_LS_FIXED","ls_fixed", "0", NULL,GRP_FILE,ENV_BOOL,SETPOS(cob_ls_fixed)}, - {"STRIP_TRAILING_SPACES","strip_trailing_spaces", NULL, NULL,GRP_HIDE,ENV_BOOL|ENV_NOT,SETPOS(cob_ls_fixed)}, - {"COB_LS_NULLS","ls_nulls", "false",NULL,GRP_FILE,ENV_BOOL,SETPOS(cob_ls_nulls)}, - {"COB_LS_SPLIT","ls_split", "false",NULL,GRP_FILE,ENV_BOOL,SETPOS(cob_ls_split)}, - {"COB_LS_VALIDATE","ls_validate", "true", NULL,GRP_FILE,ENV_BOOL,SETPOS(cob_ls_validate)}, - {"COB_MF_LS_NULLS","mf_ls_nulls", "true", NULL,GRP_FILE,ENV_BOOL,SETPOS(cob_mf_ls_nulls)}, - {"COB_MF_LS_SPLIT","mf_ls_split", "true", NULL,GRP_FILE,ENV_BOOL,SETPOS(cob_mf_ls_split)}, - {"COB_MF_LS_VALIDATE","mf_ls_validate", "false",NULL,GRP_FILE,ENV_BOOL,SETPOS(cob_mf_ls_validate)}, - {"COB_GC_FILES","gc_files", "false",NULL,GRP_HIDE,ENV_BOOL,SETPOS(cob_gc_files)}, - {"COB_SHARE_MODE","share_mode", "none",shareopts,GRP_FILE,ENV_UINT|ENV_ENUM,SETPOS(cob_share_mode)}, - {"COB_RETRY_MODE","retry_mode", "none",retryopts,GRP_FILE,ENV_UINT|ENV_ENUM,SETPOS(cob_retry_mode)}, - {"COB_RETRY_TIMES","retry_times", "0",NULL,GRP_FILE,ENV_UINT,SETPOS(cob_retry_times)}, - {"COB_RETRY_SECONDS","retry_seconds", "0",NULL,GRP_FILE,ENV_UINT,SETPOS(cob_retry_seconds)}, - {"COB_SORT_CHUNK","sort_chunk", "256K", NULL,GRP_FILE,ENV_SIZE,SETPOS(cob_sort_chunk),(128 * 1024),(16 * 1024 * 1024)}, - {"COB_SORT_MEMORY","sort_memory", "128M", NULL,GRP_FILE,ENV_SIZE,SETPOS(cob_sort_memory),(1024*1024),4294967294 /* max. guaranteed - 1 */}, - {"COB_SYNC","sync", "false",syncopts,GRP_FILE,ENV_BOOL,SETPOS(cob_do_sync)}, - {"COB_KEYCHECK","keycheck", "on",NULL,GRP_FILE,ENV_BOOL,SETPOS(cob_keycheck)}, - {"COB_FILE_DICTIONARY","file_dictionary", "min",dict_opts,GRP_FILE,ENV_UINT|ENV_ENUMVAL,SETPOS(cob_file_dict),0,3}, - {"COB_FILE_DICTIONARY_PATH","file_dictionary_path", NULL, NULL,GRP_FILE,ENV_FILE,SETPOS(cob_dictionary_path)}, - {"COB_CREATE_TABLE","create_table", "false",NULL,GRP_FILE,ENV_BOOL,SETPOS(cob_create_table)}, -#ifdef WITH_DB - {"DB_HOME", "db_home", NULL, NULL, GRP_FILE, ENV_FILE, SETPOS (bdb_home)}, -#endif - {"COB_DISPLAY_PRINT_PIPE", "display_print_pipe", NULL, NULL, GRP_SCREEN, ENV_STR, SETPOS (cob_display_print_pipe)}, - {"COBPRINTER", "printer", NULL, NULL, GRP_HIDE, ENV_STR, SETPOS (cob_display_print_pipe)}, - {"COB_DISPLAY_PRINT_FILE", "display_print_file", NULL, NULL, GRP_SCREEN, ENV_STR,SETPOS (cob_display_print_filename)}, - {"COB_DISPLAY_PUNCH_FILE", "display_punch_file", NULL, NULL, GRP_SCREEN, ENV_STR,SETPOS (cob_display_punch_filename)}, - {"COB_LEGACY", "legacy", NULL, NULL, GRP_SCREEN, ENV_BOOL, SETPOS (cob_legacy)}, - {"COB_EXIT_WAIT", "exit_wait", "1", NULL, GRP_SCREEN, ENV_BOOL, SETPOS (cob_exit_wait)}, - {"COB_EXIT_MSG", "exit_msg", NULL, NULL, GRP_SCREEN, ENV_STR, SETPOS (cob_exit_msg)}, /* default set in cob_init_screenio() */ - {"COB_CURRENT_DATE" ,"current_date", NULL, NULL, GRP_MISC, ENV_STR, SETPOS (cob_date)}, - {"COB_DATE", "date", NULL, NULL, GRP_HIDE, ENV_STR, SETPOS (cob_date)}, - {NULL, NULL, 0, 0} -}; -#define NUM_CONFIG (sizeof (gc_conf) /sizeof (struct config_tbl) - 1) -#define FUNC_NAME_IN_DEFAULT NUM_CONFIG + 1 - -/* Local functions */ -static int translate_boolean_to_int (const char* ptr); -static cob_s64_t get_sleep_nanoseconds (cob_field *nano_seconds); -static cob_s64_t get_sleep_nanoseconds_from_seconds (cob_field *decimal_seconds); -static void internal_nanosleep (cob_s64_t nsecs, int round_to_minmal); - -static int set_config_val (char *value, int pos); -static char *get_config_val (char *value, int pos, char *orgvalue); -static void cob_dump_module (char *reason); -#ifdef COB_DEBUG_LOG -static void cob_debug_open (void); -#endif -void conf_runtime_error_value (const char *value, const int conf_pos); -void conf_runtime_error (const int finish_error, const char *fmt, ...); - -static void -cob_exit_common (void) -{ - struct cob_external *p; - struct cob_external *q; - struct cob_alloc_cache *x; - struct cob_alloc_cache *y; - void *data; - char *str; - unsigned int i; - -#ifdef HAVE_SETLOCALE - if (cobglobptr->cob_locale_orig) { - (void) setlocale (LC_ALL, cobglobptr->cob_locale_orig); - cob_free (cobglobptr->cob_locale_orig); - } - if (cobglobptr->cob_locale) { - cob_free (cobglobptr->cob_locale); - } - if (cobglobptr->cob_locale_ctype) { - cob_free (cobglobptr->cob_locale_ctype); - } - if (cobglobptr->cob_locale_collate) { - cob_free (cobglobptr->cob_locale_collate); - } - if (cobglobptr->cob_locale_messages) { - cob_free (cobglobptr->cob_locale_messages); - } - if (cobglobptr->cob_locale_monetary) { - cob_free (cobglobptr->cob_locale_monetary); - } - if (cobglobptr->cob_locale_numeric) { - cob_free (cobglobptr->cob_locale_numeric); - } - if (cobglobptr->cob_locale_time) { - cob_free (cobglobptr->cob_locale_time); - } -#endif - - if (commlnptr) { - cob_free (commlnptr); - } - if (cob_local_env) { - cob_free (cob_local_env); - } - - /* Free library routine stuff */ - - if (cobglobptr->cob_term_buff) { - cob_free (cobglobptr->cob_term_buff); - } - - /* Free cached externals */ - for (p = basext; p;) { - q = p; - p = p->next; - if (q->ename) { - cob_free (q->ename); - } - if (q->ext_alloc) { - cob_free (q->ext_alloc); - } - cob_free (q); - } - - /* Free cached mallocs */ - for (x = cob_alloc_base; x;) { - y = x; - x = x->next; - cob_free (y->cob_pointer); - cob_free (y); - } - dyn_attr_list = NULL; - - /* Free last stuff */ - if (cob_last_sfile) { - cob_free ((void *)cob_last_sfile); - } - if (runtime_err_str) { - cob_free (runtime_err_str); - } - if (cobglobptr) { - if (cobglobptr->cob_main_argv0) { - cob_free ((void *)(cobglobptr->cob_main_argv0)); - } - cob_free (cobglobptr); - cobglobptr = NULL; - } - if (cobsetptr) { - if (cobsetptr->cob_config_file) { - for (i = 0; i < cobsetptr->cob_config_num; i++) { - if (cobsetptr->cob_config_file[i]) { - cob_free ((void *)cobsetptr->cob_config_file[i]); - } - } - cob_free ((void *)cobsetptr->cob_config_file); - } - /* Free all strings pointed to by cobsetptr */ - for (i = 0; i < NUM_CONFIG; i++) { - if ((gc_conf[i].data_type & ENV_STR) - || (gc_conf[i].data_type & ENV_FILE) - || (gc_conf[i].data_type & ENV_PATH)) { /* String/Path to be stored as a string */ - data = (void *)((char *)cobsetptr + gc_conf[i].data_loc); - memcpy (&str, data, sizeof (char *)); - if (str != NULL) { - cob_free ((void *)str); - str = NULL; - memcpy (data, &str, sizeof (char *)); /* Reset pointer to NULL */ - } - } - } - if (cobsetptr->cob_preload_str_set) { - cob_free((void*)(cobsetptr->cob_preload_str_set)); - } - cob_free (cobsetptr); - cobsetptr = NULL; - } - cob_initialized = 0; -} - -static void -cob_exit_common_modules (void) -{ - cob_module *mod; - struct cob_alloc_module *ptr, *nxt; - int (*cancel_func)(const int); - - /* Call each module to release local memory - - currently used for: decimals - - and remove it from the internal module list */ - for (ptr = cob_module_list; ptr; ptr = nxt) { - mod = ptr->cob_pointer; - nxt = ptr->next; - if (mod && mod->module_cancel.funcint) { - mod->module_active = 0; - cancel_func = mod->module_cancel.funcint; - (void)cancel_func (-20); /* Clear just decimals */ - } - cob_free (ptr); - } - cob_module_list = NULL; -} - -static void -cob_terminate_routines (void) -{ - if (!cob_initialized || !cobglobptr) { - return; - } - - if (cobsetptr->cob_dump_file == cobsetptr->cob_trace_file - || cobsetptr->cob_dump_file == stderr) { - cobsetptr->cob_dump_file = NULL; - } - - if (cobsetptr->cob_dump_file) { - fclose (cobsetptr->cob_dump_file); - cobsetptr->cob_dump_file = NULL; - } - - if (cobsetptr->cob_trace_file - && cobsetptr->cob_trace_file != stderr - && !cobsetptr->external_trace_file /* note: may include stdout */) { - fclose (cobsetptr->cob_trace_file); - } - cobsetptr->cob_trace_file = NULL; - - /* close punch file if self-opened */ - if (cobsetptr->cob_display_punch_file - && cobsetptr->cob_display_punch_filename) { - fclose (cobsetptr->cob_display_punch_file); - cobsetptr->cob_display_punch_file = NULL; - } - - cob_exit_screen (); - cob_exit_fileio (); -#ifdef COB_DEBUG_LOG - /* close debug log (delete file if empty) */ - if (cob_debug_file - && cob_debug_file != stderr) { - /* note: cob_debug_file can only be identical to cob_trace_file - if same file name was used, not with external_trace_file */ - if (cob_debug_file == cobsetptr->cob_trace_file) { - cobsetptr->cob_trace_file = NULL; - } - if (cob_debug_file_name != NULL - && ftell (cob_debug_file) == 0) { - fclose (cob_debug_file); - unlink (cob_debug_file_name); - } else { - fclose (cob_debug_file); - } - } - cob_debug_file = NULL; - if (cob_debug_file_name) { - cob_free (cob_debug_file_name); - cob_debug_file_name = NULL; - } -#endif - - cob_exit_intrinsic (); - cob_exit_strings (); - cob_exit_numeric (); - cob_exit_common_modules (); - cob_exit_call (); - cob_exit_reportio (); - cob_exit_mlio (); - cob_exit_common (); -} - -/* reentrant version of strerror */ -static char * -cob_get_strerror (void) -{ - char * msg; - msg = cob_cache_malloc ((size_t)COB_ERRBUF_SIZE); -#ifdef HAVE_STRERROR - strncpy (msg, strerror (errno), COB_ERRBUF_SIZE - 1); -#else - snprintf (msg, COB_ERRBUF_SIZE - 1, _("system error %d"), errno); -#endif - return msg; -} - -#ifdef HAVE_SIGNAL_H -DECLNORET static void COB_A_NORETURN -cob_sig_handler_ex (int sig) -{ - /* call external signal handler if registered */ - if (cob_ext_sighdl != NULL) { - (*cob_ext_sighdl) (sig); - cob_ext_sighdl = NULL; - } -#ifdef SIGSEGV - if (sig == SIGSEGV) { - exit (SIGSEGV); - } -#endif -#ifdef HAVE_RAISE - raise (sig); -#else - kill (cob_sys_getpid (), sig); -#endif - exit (sig); -} - - -DECLNORET static void COB_A_NORETURN -cob_sig_handler (int sig) -{ - const char *signal_name; - char reason[80]; - -#if defined (HAVE_SIGACTION) && !defined (SA_RESETHAND) - struct sigaction sa; -#endif - -#ifdef HAVE_SIG_ATOMIC_T - if (sig_is_handled) { - cob_sig_handler_ex (sig); - } - sig_is_handled = 1; -#endif - - /* LCOV_EXCL_START */ - switch (sig) { -#ifdef SIGINT - case SIGINT: - signal_name = "SIGINT"; - break; -#endif -#ifdef SIGHUP - case SIGHUP: - signal_name = "SIGHUP"; - break; -#endif -#ifdef SIGQUIT - case SIGQUIT: - signal_name = "SIGQUIT"; - break; -#endif -#ifdef SIGTERM - case SIGTERM: - signal_name = "SIGTERM"; - break; -#endif -#ifdef SIGPIPE - case SIGPIPE: - signal_name = "SIGPIPE"; - break; -#endif -#ifdef SIGSEGV - case SIGSEGV: - signal_name = "SIGSEGV"; - break; -#endif -#ifdef SIGBUS - case SIGBUS: - signal_name = "SIGBUS"; - break; -#endif -#ifdef SIGFPE - case SIGFPE: - signal_name = "SIGFPE"; - break; -#endif - default: - signal_name = _("unknown"); - /* not translated as it is a very unlikely error case */ - fprintf (stderr, "cob_sig_handler caught not handled signal: %d", sig); - putc ('\n', stderr); - break; - } - /* LCOV_EXCL_STOP */ - -#ifdef HAVE_SIGACTION -#ifndef SA_RESETHAND - memset (&sa, 0, sizeof (sa)); - sa.sa_handler = SIG_DFL; - (void)sigemptyset (&sa.sa_mask); - (void)sigaction (sig, &sa, NULL); -#endif -#else - (void)signal (sig, SIG_DFL); -#endif - cob_exit_screen (); - putc ('\n', stderr); - if (cob_source_file) { - fprintf (stderr, "%s:", cob_source_file); - if (cob_source_line) { - fprintf (stderr, "%u:", cob_source_line); - } - fputc (' ', stderr); - } - - /* LCOV_EXCL_START */ - switch (sig) { -#ifdef SIGSEGV - case SIGSEGV: - fprintf (stderr, _("attempt to reference unallocated memory")); - break; -#endif -#ifdef SIGBUS - case SIGBUS: - fprintf (stderr, _("bus error")); - break; -#endif -#ifdef SIGFPE - case SIGFPE: - fprintf (stderr, _("fatal arithmetic error")); - break; -#endif - default: - fprintf (stderr, _("caught signal")); - break; - } - /* LCOV_EXCL_STOP */ - snprintf (reason, sizeof (reason),_("signal %s"), signal_name); - fprintf (stderr, " (%s)\n", reason); - - if (cob_initialized) { - cob_dump_module (reason); - cob_terminate_routines (); - fprintf (stderr, _("abnormal termination - file contents may be incorrect")); - } - putc ('\n', stderr); - fflush (stderr); - - cob_sig_handler_ex (sig); -} -#endif /* HAVE_SIGNAL_H */ - -/* Raise signal (run both internal and external handlers) - may return, depending on the signal -*/ -void -cob_raise (int sig) -{ -#ifdef HAVE_SIGNAL_H - /* let the registered signal handlers do their work */ -#ifdef HAVE_RAISE - raise (sig); -#else - kill (cob_sys_getpid (), sig); -#endif - /* else: at least call external signal handler if registered */ -#else - if (cob_ext_sighdl != NULL) { - (*cob_ext_sighdl) (sig); - cob_ext_sighdl = NULL; - } -#endif -} - -static void -cob_set_signal (void) -{ -#ifdef HAVE_SIGNAL_H - -#ifdef HAVE_SIGACTION - struct sigaction sa; - struct sigaction osa; - - memset (&sa, 0, sizeof (sa)); - sa.sa_handler = cob_sig_handler; -#ifdef SA_RESETHAND - sa.sa_flags = SA_RESETHAND; -#else - sa.sa_flags = 0; -#endif -#ifdef SA_NOCLDSTOP - sa.sa_flags |= SA_NOCLDSTOP; -#endif - -#ifdef SIGINT - (void)sigaction (SIGINT, NULL, &osa); - if (osa.sa_handler != SIG_IGN) { - (void)sigemptyset (&sa.sa_mask); - (void)sigaction (SIGINT, &sa, NULL); - } -#endif -#ifdef SIGHUP - (void)sigaction (SIGHUP, NULL, &osa); - if (osa.sa_handler != SIG_IGN) { - (void)sigemptyset (&sa.sa_mask); - (void)sigaction (SIGHUP, &sa, NULL); - } -#endif -#ifdef SIGQUIT - (void)sigaction (SIGQUIT, NULL, &osa); - if (osa.sa_handler != SIG_IGN) { - (void)sigemptyset (&sa.sa_mask); - (void)sigaction (SIGQUIT, &sa, NULL); - } -#endif -#ifdef SIGTERM - (void)sigaction (SIGTERM, NULL, &osa); - if (osa.sa_handler != SIG_IGN) { - (void)sigemptyset (&sa.sa_mask); - (void)sigaction (SIGTERM, &sa, NULL); - } -#endif -#ifdef SIGPIPE - (void)sigaction (SIGPIPE, NULL, &osa); - if (osa.sa_handler != SIG_IGN) { - (void)sigemptyset (&sa.sa_mask); - (void)sigaction (SIGPIPE, &sa, NULL); - } -#endif -#ifdef SIGSEGV - /* Take direct control of segmentation violation */ - (void)sigemptyset (&sa.sa_mask); - (void)sigaction (SIGSEGV, &sa, NULL); -#endif -#ifdef SIGBUS - /* Take direct control of bus error */ - (void)sigemptyset (&sa.sa_mask); - (void)sigaction (SIGBUS, &sa, NULL); -#endif -#ifdef SIGFPE - /* fatal arithmetic errors including non-floating-point division by zero */ - (void)sigaction (SIGFPE, NULL, &osa); - if (osa.sa_handler != SIG_IGN) { - (void)sigemptyset (&sa.sa_mask); - (void)sigaction (SIGFPE, &sa, NULL); - } -#endif - -#else - -#ifdef SIGINT - if (signal (SIGINT, SIG_IGN) != SIG_IGN) { - (void)signal (SIGINT, cob_sig_handler); - } -#endif -#ifdef SIGHUP - if (signal (SIGHUP, SIG_IGN) != SIG_IGN) { - (void)signal (SIGHUP, cob_sig_handler); - } -#endif -#ifdef SIGQUIT - if (signal (SIGQUIT, SIG_IGN) != SIG_IGN) { - (void)signal (SIGQUIT, cob_sig_handler); - } -#endif -#ifdef SIGTERM - if (signal (SIGTERM, SIG_IGN) != SIG_IGN) { - (void)signal (SIGTERM, cob_sig_handler); - } -#endif -#ifdef SIGPIPE - if (signal (SIGPIPE, SIG_IGN) != SIG_IGN) { - (void)signal (SIGPIPE, cob_sig_handler); - } -#endif -#ifdef SIGSEGV - /* Take direct control of segmentation violation */ - (void)signal (SIGSEGV, cob_sig_handler); -#endif -#ifdef SIGBUS - /* Take direct control of bus error */ - (void)signal (SIGBUS, cob_sig_handler); -#endif -#ifdef SIGFPE - if (signal (SIGFPE, SIG_IGN) != SIG_IGN) { - (void)signal (SIGFPE, cob_sig_handler); - } -#endif - -#endif -#endif -} - -/* ASCII Sign - * positive: 0123456789 - * negative: pqrstuvwxy - */ - -static int -cob_get_sign_ascii (unsigned char *p) -{ -#ifdef COB_EBCDIC_MACHINE - switch (*p) { - case 'p': - *p = (unsigned char)'0'; - return -1; - case 'q': - *p = (unsigned char)'1'; - return -1; - case 'r': - *p = (unsigned char)'2'; - return -1; - case 's': - *p = (unsigned char)'3'; - return -1; - case 't': - *p = (unsigned char)'4'; - return -1; - case 'u': - *p = (unsigned char)'5'; - return -1; - case 'v': - *p = (unsigned char)'6'; - return -1; - case 'w': - *p = (unsigned char)'7'; - return -1; - case 'x': - *p = (unsigned char)'8'; - return -1; - case 'y': - *p = (unsigned char)'9'; - return -1; - } - *p = (unsigned char)'0'; - return 1; -#else - if (*p >= (unsigned char)'p' && *p <= (unsigned char)'y') { - *p &= ~64U; - return -1; - } - *p = (unsigned char)'0'; - return 1; -#endif -} - -static void -cob_put_sign_ascii (unsigned char *p) -{ -#ifdef COB_EBCDIC_MACHINE - switch (*p) { - case '0': - *p = (unsigned char)'p'; - return; - case '1': - *p = (unsigned char)'q'; - return; - case '2': - *p = (unsigned char)'r'; - return; - case '3': - *p = (unsigned char)'s'; - return; - case '4': - *p = (unsigned char)'t'; - return; - case '5': - *p = (unsigned char)'u'; - return; - case '6': - *p = (unsigned char)'v'; - return; - case '7': - *p = (unsigned char)'w'; - return; - case '8': - *p = (unsigned char)'x'; - return; - case '9': - *p = (unsigned char)'y'; - return; - default: - *p = (unsigned char)'0'; - } -#else - *p |= 64U; -#endif -} - -/* EBCDIC Sign - * positive: {ABCDEFGHI - * negative: }JKLMNOPQR - */ - -static int -cob_get_sign_ebcdic (unsigned char *p) -{ - switch (*p) { - case '{': - *p = (unsigned char)'0'; - return 1; - case 'A': - *p = (unsigned char)'1'; - return 1; - case 'B': - *p = (unsigned char)'2'; - return 1; - case 'C': - *p = (unsigned char)'3'; - return 1; - case 'D': - *p = (unsigned char)'4'; - return 1; - case 'E': - *p = (unsigned char)'5'; - return 1; - case 'F': - *p = (unsigned char)'6'; - return 1; - case 'G': - *p = (unsigned char)'7'; - return 1; - case 'H': - *p = (unsigned char)'8'; - return 1; - case 'I': - *p = (unsigned char)'9'; - return 1; - case '}': - *p = (unsigned char)'0'; - return -1; - case 'J': - *p = (unsigned char)'1'; - return -1; - case 'K': - *p = (unsigned char)'2'; - return -1; - case 'L': - *p = (unsigned char)'3'; - return -1; - case 'M': - *p = (unsigned char)'4'; - return -1; - case 'N': - *p = (unsigned char)'5'; - return -1; - case 'O': - *p = (unsigned char)'6'; - return -1; - case 'P': - *p = (unsigned char)'7'; - return -1; - case 'Q': - *p = (unsigned char)'8'; - return -1; - case 'R': - *p = (unsigned char)'9'; - return -1; - default: - /* What to do here */ - *p = (unsigned char)('0' + (*p & 0x0F)); - if (*p > (unsigned char)'9') { - *p = (unsigned char)'0'; - } - return 1; - } -} - -static void -cob_put_sign_ebcdic (unsigned char *p, const int sign) -{ - if (sign < 0) { - switch (*p) { - case '0': - *p = (unsigned char)'}'; - return; - case '1': - *p = (unsigned char)'J'; - return; - case '2': - *p = (unsigned char)'K'; - return; - case '3': - *p = (unsigned char)'L'; - return; - case '4': - *p = (unsigned char)'M'; - return; - case '5': - *p = (unsigned char)'N'; - return; - case '6': - *p = (unsigned char)'O'; - return; - case '7': - *p = (unsigned char)'P'; - return; - case '8': - *p = (unsigned char)'Q'; - return; - case '9': - *p = (unsigned char)'R'; - return; - default: - /* What to do here */ - *p = (unsigned char)'{'; - return; - } - } - switch (*p) { - case '0': - *p = (unsigned char)'{'; - return; - case '1': - *p = (unsigned char)'A'; - return; - case '2': - *p = (unsigned char)'B'; - return; - case '3': - *p = (unsigned char)'C'; - return; - case '4': - *p = (unsigned char)'D'; - return; - case '5': - *p = (unsigned char)'E'; - return; - case '6': - *p = (unsigned char)'F'; - return; - case '7': - *p = (unsigned char)'G'; - return; - case '8': - *p = (unsigned char)'H'; - return; - case '9': - *p = (unsigned char)'I'; - return; - default: - /* What to do here */ - *p = (unsigned char)'{'; - return; - } -} - -static int -common_cmpc (const unsigned char *s1, const unsigned int c, - const size_t size, const unsigned char *col) -{ - size_t i; - int ret; - - if (unlikely (col)) { - for (i = 0; i < size; ++i) { - if ((ret = col[s1[i]] - col[c]) != 0) { - return ret; - } - } - } else { - for (i = 0; i < size; ++i) { - if ((ret = s1[i] - c) != 0) { - return ret; - } - } - } - return 0; -} - -static int -common_cmps (const unsigned char *s1, const unsigned char *s2, - const size_t size, const unsigned char *col) -{ - size_t i; - int ret; - - if (unlikely (col)) { - for (i = 0; i < size; ++i) { - if ((ret = col[s1[i]] - col[s2[i]]) != 0) { - return ret; - } - } - } else { - for (i = 0; i < size; ++i) { - if ((ret = s1[i] - s2[i]) != 0) { - return ret; - } - } - } - return 0; -} - -static int -cob_cmp_all (cob_field *f1, cob_field *f2) -{ - unsigned char *data; - const unsigned char *s; - size_t size; - int ret; - int sign; - - size = f1->size; - data = f1->data; - sign = COB_GET_SIGN (f1); - s = COB_MODULE_PTR->collating_sequence; - if (f2->size == 1) { - ret = common_cmpc (data, f2->data[0], size, s); - goto end; - } - ret = 0; - while (size >= f2->size) { - if ((ret = common_cmps (data, f2->data, f2->size, s)) != 0) { - goto end; - } - size -= f2->size; - data += f2->size; - } - if (size > 0) { - ret = common_cmps (data, f2->data, size, s); - } - -end: - if (COB_FIELD_TYPE (f1) != COB_TYPE_NUMERIC_PACKED) { - COB_PUT_SIGN (f1, sign); - } - return ret; -} - -static int -cob_cmp_alnum (cob_field *f1, cob_field *f2) -{ - const unsigned char *s; - size_t min; - int ret; - int sign1; - int sign2; - - /* FIXME later: must cater for national fields, too */ - - sign1 = COB_GET_SIGN (f1); - sign2 = COB_GET_SIGN (f2); - min = (f1->size < f2->size) ? f1->size : f2->size; - s = COB_MODULE_PTR->collating_sequence; - - /* Compare common substring */ - if ((ret = common_cmps (f1->data, f2->data, min, s)) != 0) { - goto end; - } - - /* Compare the rest (if any) with spaces */ - if (f1->size > f2->size) { - ret = common_cmpc (f1->data + min, ' ', f1->size - min, s); - } else if (f1->size < f2->size) { - ret = -common_cmpc (f2->data + min, ' ', f2->size - min, s); - } - -end: - if (COB_FIELD_TYPE (f1) != COB_TYPE_NUMERIC_PACKED) { - COB_PUT_SIGN (f1, sign1); - } - if (COB_FIELD_TYPE (f2) != COB_TYPE_NUMERIC_PACKED) { - COB_PUT_SIGN (f2, sign2); - } - return ret; -} - -static int -sort_compare (const void *data1, const void *data2) -{ - size_t i; - int cmp; - cob_field f1; - cob_field f2; - - for (i = 0; i < sort_nkeys; ++i) { - f1 = f2 = *sort_keys[i].field; - f1.data = (unsigned char *)data1 + sort_keys[i].offset; - f2.data = (unsigned char *)data2 + sort_keys[i].offset; - if (COB_FIELD_IS_NUMERIC (&f1)) { - cmp = cob_numeric_cmp (&f1, &f2); - } else { - cmp = common_cmps (f1.data, f2.data, f1.size, sort_collate); - } - if (cmp != 0) { - return (sort_keys[i].tf_ascending == COB_ASCENDING) ? cmp : -cmp; - } - } - return 0; -} - -static void -cob_memcpy (cob_field *dst, const void *src, const size_t size) -{ - cob_field temp; - - if (!dst->size) { - return; - } - temp.size = size; - temp.data = (cob_u8_ptr)src; - temp.attr = &const_alpha_attr; - cob_move (&temp, dst); -} - -/* open file using mode according to cob_unix_lf and - filename (append when starting with +) */ -static FILE * -cob_open_logfile (const char *filename) -{ - const char *mode; - - if (!cobsetptr->cob_unix_lf) { - if (*filename == '+') { - filename++; - mode = "a"; - } else { - mode = "w"; - } - } else { - if (*filename == '+') { - filename++; - mode = "ab"; - } else { - mode = "wb"; - } - } - return fopen (filename, mode); -} - -/* ensure that cob_trace_file is available for writing */ -static void -cob_check_trace_file (void) -{ - - if (cobsetptr->cob_trace_file) { - return; - } - if (cobsetptr->cob_trace_filename) { - cobsetptr->cob_trace_file = cob_open_logfile (cobsetptr->cob_trace_filename); - if (!cobsetptr->cob_trace_file) { - cobsetptr->cob_trace_file = stderr; - } - } else { - cobsetptr->cob_trace_file = stderr; - } -} - -/* close current trace file (if open) and open/attach a new one */ -static void -cob_new_trace_file (void) -{ - FILE *old_trace_file = cobsetptr->cob_trace_file; - - if (!cobsetptr->cob_trace_file - || cobsetptr->external_trace_file - || cobsetptr->cob_trace_file == stderr) { - cobsetptr->cob_trace_file = NULL; - cob_check_trace_file (); - return; - } - - fclose (cobsetptr->cob_trace_file); - cobsetptr->cob_trace_file = NULL; - - cob_check_trace_file (); - if (cobsetptr->cob_display_print_file - && cobsetptr->cob_display_print_file == old_trace_file) { - cobsetptr->cob_display_print_file = cobsetptr->cob_trace_file; - } - if (cobsetptr->cob_dump_file - && cobsetptr->cob_dump_file == old_trace_file) { - cobsetptr->cob_dump_file = cobsetptr->cob_trace_file; - } -#ifdef COB_DEBUG_LOG - if (cob_debug_file - && cob_debug_file == old_trace_file) { - cob_debug_file = cobsetptr->cob_trace_file; - } -#endif -} - -int -cob_check_env_true (char * s) -{ - if (s) { - if (strlen (s) == 1 && (*s == 'Y' || *s == 'y' || *s == '1')) return 1; - if (strcasecmp (s, "YES") == 0 || strcasecmp (s, "ON") == 0 || - strcasecmp (s, "TRUE") == 0) { - return 1; - } - } - return 0; -} - -int -cob_check_env_false (char * s) -{ - return s && ((strlen (s) == 1 && (*s == 'N' || *s == 'n' || *s == '0')) - || (strcasecmp (s, "NO") == 0 || strcasecmp (s, "NONE") == 0 - || strcasecmp (s, "OFF") == 0 - || strcasecmp (s, "FALSE") == 0)); -} - -static void -cob_rescan_env_vals (void) -{ - int i; - int j; - int old_type; - char *env; - char *save_source_file = (char *) cob_source_file; - - cob_source_file = NULL; - cob_source_line = 0; - - /* Check for possible environment variables */ - for (i=0; i < NUM_CONFIG; i++) { - if(gc_conf[i].env_name - && (env = getenv(gc_conf[i].env_name)) != NULL - && *env != 0) { - old_type = gc_conf[i].data_type; - gc_conf[i].data_type |= STS_ENVSET; - - if (*env != '\0' && set_config_val (env, i)) { - gc_conf[i].data_type = old_type; - - /* Remove invalid setting */ - (void)cob_unsetenv (gc_conf[i].env_name); - } else if (gc_conf[i].env_group == GRP_HIDE) { - /* Any alias present? */ - for (j = 0; j < NUM_CONFIG; j++) { - if (j != i - && gc_conf[i].data_loc == gc_conf[j].data_loc) { - gc_conf[j].data_type |= STS_ENVSET; - gc_conf[j].set_by = i; - } - } - } - } - } - cob_source_file = save_source_file; - - /* Extended ACCEPT status returns */ - if (cobsetptr->cob_extended_status == 0) { - cobsetptr->cob_use_esc = 0; - } -} - -static int -one_indexed_day_of_week_from_monday (int zero_indexed_from_sunday) -{ - return ((zero_indexed_from_sunday + 6) % 7) + 1; -} - -#if defined (_MSC_VER) && COB_USE_VC2008_OR_GREATER -static void -set_cob_time_ns_from_filetime (const FILETIME filetime, struct cob_time *cb_time) -{ - ULONGLONG filetime_int; - - filetime_int = (((ULONGLONG) filetime.dwHighDateTime) << 32) - + filetime.dwLowDateTime; - /* FILETIMEs are accurate to 100 nanosecond intervals */ - cb_time->nanosecond = (filetime_int % (ULONGLONG) 10000000) * 100; -} -#endif - -/* Global functions */ - -/* get last exception (or 0 if not active) */ -int -cob_get_last_exception_code (void) -{ - return last_exception_code; -} - -/* get exception name for last raised exception */ -const char * -cob_get_last_exception_name (void) -{ - size_t n; - - for (n = 0; n < EXCEPTION_TAB_SIZE; ++n) { - if (last_exception_code == cob_exception_tab_code[n]) { - return cob_exception_tab_name[n]; - } - } - return NULL; -} - -/* check if last exception is set and includes the given exception */ -int -cob_last_exception_is (const int exception_to_check) -{ - if ((last_exception_code & cob_exception_tab_code[exception_to_check]) - == cob_exception_tab_code[exception_to_check]) { - return 1; - } else { - return 0; - } -} - -/* set last exception, - used for EXCEPTION- functions and for cob_accept_exception_status, - only reset on SET LAST EXCEPTION TO OFF */ -void -cob_set_exception (const int id) -{ - cobglobptr->cob_exception_code = cob_exception_tab_code[id]; - last_exception_code = cobglobptr->cob_exception_code; - if (id) { - cobglobptr->cob_got_exception = 1; - cobglobptr->last_exception_statement = cob_source_statement; - cobglobptr->last_exception_line = cob_source_line; - cobglobptr->last_exception_id = cob_current_program_id; - cobglobptr->last_exception_section = cob_current_section; - cobglobptr->last_exception_paragraph = cob_current_paragraph; - } else { - cobglobptr->cob_got_exception = 0; - cobglobptr->last_exception_statement = NULL; - cobglobptr->last_exception_line = 0; - cobglobptr->last_exception_id = NULL; - cobglobptr->last_exception_section = NULL; - cobglobptr->last_exception_paragraph = NULL; - } -} - -/* return the last exception value */ -void -cob_accept_exception_status (cob_field *f) -{ - /* Note: MF set this to a 9(3) item, we may - add a translation here */ - cob_set_int (f, last_exception_code); -} - -void -cob_accept_user_name (cob_field *f) -{ - if (cobsetptr->cob_user_name) { - cob_memcpy (f, cobsetptr->cob_user_name, - strlen (cobsetptr->cob_user_name)); - } else { - cob_memcpy (f, " ", (size_t)1); - } -} - -void * -cob_malloc (const size_t size) -{ - void *mptr; - - mptr = calloc ((size_t)1, size); - /* LCOV_EXCL_START */ - if (unlikely (!mptr)) { - cob_fatal_error (COB_FERROR_MEMORY); - } - /* LCOV_EXCL_STOP */ - return mptr; -} - -void * -cob_realloc (void * optr, const size_t osize, const size_t nsize) -{ - void *mptr; - - /* LCOV_EXCL_START */ - if (unlikely (!optr)) { - cob_fatal_error (COB_FERROR_FREE); - } - /* LCOV_EXCL_STOP */ - - if (unlikely (osize == nsize)) { /* No size change */ - return optr; - } - if (unlikely (osize > nsize)) { /* Reducing size */ - return realloc (optr, nsize); - } - - mptr = calloc ((size_t)1, nsize); /* New memory, past old is cleared */ - /* LCOV_EXCL_START */ - if (unlikely (!mptr)) { - cob_fatal_error (COB_FERROR_MEMORY); - } - /* LCOV_EXCL_STOP */ - memcpy (mptr, optr, osize); - cob_free (optr); - return mptr; -} - -void -cob_free (void * mptr) -{ -#ifdef _DEBUG - /* LCOV_EXCL_START */ - if (unlikely (!mptr)) { - cob_fatal_error (COB_FERROR_FREE); - } - /* LCOV_EXCL_STOP */ -#endif - free (mptr); - -} - -void * -cob_fast_malloc (const size_t size) -{ - void *mptr; - - mptr = malloc (size); - /* LCOV_EXCL_START */ - if (unlikely (!mptr)) { - cob_fatal_error (COB_FERROR_MEMORY); - } - /* LCOV_EXCL_STOP */ - return mptr; -} - -char * -cob_strdup (const char *p) -{ - char *mptr; - size_t len; - - len = strlen (p); - mptr = (char *) cob_malloc (len + 1U); - memcpy (mptr, p, len); - return mptr; -} - -/* Caching versions of malloc/free */ -void * -cob_cache_malloc (const size_t size) -{ - struct cob_alloc_cache *cache_ptr; - void *mptr; - - cache_ptr = cob_malloc (sizeof (struct cob_alloc_cache)); - mptr = cob_malloc (size); - cache_ptr->cob_pointer = mptr; - cache_ptr->size = size; - cache_ptr->next = cob_alloc_base; - cob_alloc_base = cache_ptr; - return mptr; -} - -void * -cob_cache_realloc (void *ptr, const size_t size) -{ - struct cob_alloc_cache *cache_ptr; - void *mptr; - - if (!ptr) { - return cob_cache_malloc (size); - } - cache_ptr = cob_alloc_base; - for (; cache_ptr; cache_ptr = cache_ptr->next) { - if (ptr == cache_ptr->cob_pointer) { - if (size <= cache_ptr->size) { - return ptr; - } - mptr = cob_malloc (size); - memcpy (mptr, cache_ptr->cob_pointer, cache_ptr->size); - cob_free (cache_ptr->cob_pointer); - cache_ptr->cob_pointer = mptr; - cache_ptr->size = size; - return mptr; - } - } - return ptr; -} - -void -cob_cache_free (void *ptr) -{ - struct cob_alloc_cache *cache_ptr; - struct cob_alloc_cache *prev_ptr; - - if (!ptr) { - return; - } - cache_ptr = cob_alloc_base; - prev_ptr = cob_alloc_base; - for (; cache_ptr; cache_ptr = cache_ptr->next) { - if (ptr == cache_ptr->cob_pointer) { - cob_free (cache_ptr->cob_pointer); - if (cache_ptr == cob_alloc_base) { - cob_alloc_base = cache_ptr->next; - } else { - prev_ptr->next = cache_ptr->next; - } - cob_free (cache_ptr); - return; - } - prev_ptr = cache_ptr; - } -} - -/* routines for handling 'trace' follow */ - -/* Note: these functions are only called if the following vars are set: - COB_MODULE_PTR + ->module_stmt + ->module_sources -*/ -static int -cob_trace_prep (void) -{ - const char *s; - cob_current_program_id = COB_MODULE_PTR->module_name; - if (COB_MODULE_PTR->module_stmt != 0 - && COB_MODULE_PTR->module_sources) { - cob_source_file = - COB_MODULE_PTR->module_sources[COB_GET_FILE_NUM(COB_MODULE_PTR->module_stmt)]; - cob_source_line = COB_GET_LINE_NUM(COB_MODULE_PTR->module_stmt); - } - if (!cobsetptr->cob_trace_file) { - cob_check_trace_file (); - if (!cobsetptr->cob_trace_file) - return 1; /* silence warnings */ - } - if (cob_source_file - && (!cob_last_sfile || strcmp (cob_last_sfile, cob_source_file))) { - if (cob_last_sfile) { - cob_free ((void *)cob_last_sfile); - } - cob_last_sfile = cob_strdup (cob_source_file); - fprintf (cobsetptr->cob_trace_file, "Source: '%s'\n", cob_source_file); - } - if (COB_MODULE_PTR->module_name) { - s = COB_MODULE_PTR->module_name; - } else { - s = _("unknown"); - } - if (!cob_last_progid - || strcmp (cob_last_progid, s)) { - cob_last_progid = s; - if (COB_MODULE_PTR->module_type == COB_MODULE_TYPE_FUNCTION) { - fprintf (cobsetptr->cob_trace_file, "Function-Id: %s\n", cob_last_progid); - } else { - fprintf (cobsetptr->cob_trace_file, "Program-Id: %s\n", cob_last_progid); - } - } - return 0; -} - -static void -cob_trace_print (char *val) -{ - int i; - int last_pos = (int)(strlen (cobsetptr->cob_trace_format) - 1); - - for (i=0; cobsetptr->cob_trace_format[i] != 0; i++) { - if (cobsetptr->cob_trace_format[i] == '%') { - i++; - if (toupper(cobsetptr->cob_trace_format[i]) == 'P') { - if (COB_MODULE_PTR && COB_MODULE_PTR->module_type == COB_MODULE_TYPE_FUNCTION) { - if (i != last_pos) { - fprintf (cobsetptr->cob_trace_file, "Function-Id: %-16s", cob_last_progid); - } else { - fprintf (cobsetptr->cob_trace_file, "Function-Id: %s", cob_last_progid); - } - } else { - if (i != last_pos) { - fprintf (cobsetptr->cob_trace_file, "Program-Id: %-16s", cob_last_progid); - } else { - fprintf (cobsetptr->cob_trace_file, "Program-Id: %s", cob_last_progid); - } - } - } else - if (toupper(cobsetptr->cob_trace_format[i]) == 'I') { - fprintf (cobsetptr->cob_trace_file, "%s", cob_last_progid); - } else - if (toupper(cobsetptr->cob_trace_format[i]) == 'L') { - fprintf (cobsetptr->cob_trace_file, "%6u", cob_source_line); - } else - if (toupper(cobsetptr->cob_trace_format[i]) == 'S') { - if (i != last_pos) { - fprintf (cobsetptr->cob_trace_file, "%-42.42s", val); - } else { - fprintf (cobsetptr->cob_trace_file, "%s", val); - } - } else - if (toupper(cobsetptr->cob_trace_format[i]) == 'F') { - if (i != last_pos) { - fprintf (cobsetptr->cob_trace_file, "Source: %-*.*s", - -COB_MAX_NAMELEN, COB_MAX_NAMELEN, cob_last_sfile); - } else { - fprintf (cobsetptr->cob_trace_file, "Source: %s", cob_last_sfile); - } - } - } else { - fputc (cobsetptr->cob_trace_format[i], cobsetptr->cob_trace_file); - } - } - fputc ('\n', cobsetptr->cob_trace_file); - fflush (cobsetptr->cob_trace_file); -} - -void -cob_trace_sect (const char *name) -{ - char val[60]; - - /* store for CHECKME */ - cob_current_section = name; - - /* actual tracing, if activated */ - if (cobsetptr->cob_line_trace - && (COB_MODULE_PTR->flag_debug_trace & COB_MODULE_TRACE)) { - if (cob_trace_prep() - || name == NULL) { - return; - } - snprintf (val, sizeof (val), " Section: %s", name); - cob_trace_print (val); - return; - } - - /* store for CHECKME */ - if (COB_MODULE_PTR->module_stmt != 0 - && COB_MODULE_PTR->module_sources) { - cob_current_program_id = COB_MODULE_PTR->module_name; - cob_source_file = - COB_MODULE_PTR->module_sources[COB_GET_FILE_NUM(COB_MODULE_PTR->module_stmt)]; - cob_source_line = COB_GET_LINE_NUM(COB_MODULE_PTR->module_stmt); - } -} - -void -cob_trace_para (const char *name) -{ - char val[60]; - - /* store for CHECKME */ - cob_current_paragraph = name; - - /* actual tracing, if activated */ - if (cobsetptr->cob_line_trace - && (COB_MODULE_PTR->flag_debug_trace & COB_MODULE_TRACE)) { - if (cob_trace_prep() - || name == NULL) { - return; - } - snprintf (val, sizeof (val), "Paragraph: %s", name); - cob_trace_print (val); - return; - } - - /* store for CHECKME */ - if (COB_MODULE_PTR->module_stmt != 0 - && COB_MODULE_PTR->module_sources) { - cob_current_program_id = COB_MODULE_PTR->module_name; - cob_source_file = - COB_MODULE_PTR->module_sources[COB_GET_FILE_NUM(COB_MODULE_PTR->module_stmt)]; - cob_source_line = COB_GET_LINE_NUM(COB_MODULE_PTR->module_stmt); - } -} - -void -cob_trace_entry (const char *name) -{ - char val[60]; - - /* actual tracing, if activated */ - if (cobsetptr->cob_line_trace - && (COB_MODULE_PTR->flag_debug_trace & COB_MODULE_TRACE)) { - if (cob_trace_prep() - || name == NULL) { - return; - } - snprintf (val, sizeof (val), " Entry: %s", name); - cob_trace_print (val); - return; - } - - /* store for CHECKME */ - if (COB_MODULE_PTR->module_stmt != 0 - && COB_MODULE_PTR->module_sources) { - cob_current_program_id = COB_MODULE_PTR->module_name; - cob_source_file = - COB_MODULE_PTR->module_sources[COB_GET_FILE_NUM(COB_MODULE_PTR->module_stmt)]; - cob_source_line = COB_GET_LINE_NUM(COB_MODULE_PTR->module_stmt); - } -} - -void -cob_trace_exit (const char *name) -{ - char val[60]; - - /* actual tracing, if activated */ - if (cobsetptr->cob_line_trace - && (COB_MODULE_PTR->flag_debug_trace & COB_MODULE_TRACE)) { - if (cob_trace_prep() - || name == NULL) { - return; - } - snprintf (val, sizeof (val), " Exit: %s", name); - cob_trace_print (val); - return; - } - - /* store for CHECKME */ - if (COB_MODULE_PTR->module_stmt != 0 - && COB_MODULE_PTR->module_sources) { - cob_current_program_id = COB_MODULE_PTR->module_name; - cob_source_file = - COB_MODULE_PTR->module_sources[COB_GET_FILE_NUM(COB_MODULE_PTR->module_stmt)]; - cob_source_line = COB_GET_LINE_NUM(COB_MODULE_PTR->module_stmt); - } -} - -void -cob_trace_stmt (const char *stmt) -{ - char val[60]; - - /* store for CHECKME */ - if (stmt) { - cob_source_statement = stmt; - } - - /* actual tracing, if activated */ - if (cobsetptr->cob_line_trace - && (COB_MODULE_PTR->flag_debug_trace & COB_MODULE_TRACEALL)) { - if (cob_trace_prep ()) { - return; - } - snprintf (val, sizeof (val), " %s", stmt ? (char *)stmt : _("unknown")); - cob_trace_print (val); - return; - } - - /* store for CHECKME */ - if (COB_MODULE_PTR->module_stmt != 0 - && COB_MODULE_PTR->module_sources) { - cob_current_program_id = COB_MODULE_PTR->module_name; - cob_source_file = - COB_MODULE_PTR->module_sources[COB_GET_FILE_NUM(COB_MODULE_PTR->module_stmt)]; - cob_source_line = COB_GET_LINE_NUM(COB_MODULE_PTR->module_stmt); - } -} - -void -cob_ready_trace (void) -{ - cobsetptr->cob_line_trace = 1; - if (!cobsetptr->cob_trace_file) { - cob_check_trace_file (); - } -} - -void -cob_reset_trace (void) -{ - cobsetptr->cob_line_trace = 0; -} - -unsigned char * -cob_get_pointer (const void *srcptr) -{ - void *tmptr; - - memcpy (&tmptr, srcptr, sizeof (void *)); - return (cob_u8_ptr)tmptr; -} - -void -cob_field_to_string (const cob_field *f, void *str, const size_t maxsize) -{ - unsigned char *s; - size_t count; - size_t i; - - if (unlikely (f == NULL)) { - strncpy (str, _ ("NULL field"), maxsize); - return; - } - - count = 0; - if (unlikely (f->size == 0)) { - return; - } - /* check if field has data assigned (may be a BASED / LINKAGE item) */ - if (unlikely (f->data == NULL)) { - strncpy (str, _ ("field with NULL address"), maxsize); - return; - } - i = f->size - 1; - for (; ;) { - if (f->data[i] && f->data[i] != (unsigned char)' ') { - count = i + 1; - break; - } - if (!i) { - break; - } - --i; - } - if (count > maxsize) { - count = maxsize; - } - s = (unsigned char *)str; - for (i = 0; i < count; ++i) { - s[i] = f->data[i]; - } - s[i] = 0; -} - -void -cob_stop_run (const int status) -{ - struct exit_handlerlist *h; - - if (!cob_initialized) { - exit (1); - } - - if (exit_hdlrs != NULL) { - h = exit_hdlrs; - while (h != NULL) { - h->proc (); - h = h->next; - } - } - cob_terminate_routines (); - exit (status); -} - -int -cob_is_initialized (void) -{ - return (cobglobptr != NULL); -} - -cob_global * -cob_get_global_ptr (void) -{ - /* LCOV_EXCL_START */ - if (unlikely (!cob_initialized)) { - cob_fatal_error (COB_FERROR_INITIALIZED); - } - /* LCOV_EXCL_STOP */ - return cobglobptr; -} - -int -cob_module_global_enter (cob_module **module, cob_global **mglobal, - const int auto_init, const int entry, const unsigned int *name_hash) -{ - cob_module *mod; - const int MAX_ITERS = 10240; - int k; - struct cob_alloc_module *mod_ptr; - - - /* Check initialized */ - if (unlikely (!cob_initialized)) { - if (auto_init) { - cob_init (0, NULL); - } else { - cob_fatal_error (COB_FERROR_INITIALIZED); - } - } - - /* Set global pointer */ - *mglobal = cobglobptr; - - /* Was caller a COBOL module */ - if (name_hash != NULL - && cobglobptr->cob_call_name_hash != 0) { - cobglobptr->cob_call_from_c = 1; - k = 0; - while (*name_hash != 0) { /* Scan table of values */ - if (cobglobptr->cob_call_name_hash == *name_hash) { - cobglobptr->cob_call_from_c = 0; - break; - } - name_hash++; - k++; - } - } - - /* Check module pointer */ - if (!*module) { - *module = cob_cache_malloc (sizeof (cob_module)); - /* Add to list of all modules activated */ - mod_ptr = cob_malloc (sizeof (struct cob_alloc_module)); - mod_ptr->cob_pointer = *module; - mod_ptr->next = cob_module_list; - cob_module_list = mod_ptr; - } else if (entry == 0 - && !cobglobptr->cob_call_from_c) { - for (k = 0, mod = COB_MODULE_PTR; mod && k < MAX_ITERS; mod = mod->next, k++) { - if (*module == mod) { - if (cobglobptr->cob_stmt_exception) { - /* CALL has ON EXCEPTION so return to caller */ - cob_set_exception (COB_EC_PROGRAM_RECURSIVE_CALL); - cobglobptr->cob_stmt_exception = 0; - return 1; - } - cob_module_err = mod; - cob_fatal_error (COB_FERROR_RECURSIVE); - } - } - } - - /* Save parameter count, get number from argc if main program */ - if (!COB_MODULE_PTR) { - cobglobptr->cob_call_params = cob_argc - 1; - if(cobglobptr->cob_call_params < 0) - cobglobptr->cob_call_params = 0; - } - - (*module)->module_num_params = cobglobptr->cob_call_params; - - /* Push module pointer */ - (*module)->next = COB_MODULE_PTR; - COB_MODULE_PTR = *module; - COB_MODULE_PTR->module_stmt = 0; - - cobglobptr->cob_stmt_exception = 0; - return 0; -} - -void -cob_module_enter (cob_module **module, cob_global **mglobal, - const int auto_init) -{ - (void)cob_module_global_enter (module, mglobal, auto_init, 0, 0); -} - -void -cob_module_leave (cob_module *module) -{ - COB_UNUSED (module); - if(cobglobptr->cob_exception_code == -1) - cobglobptr->cob_exception_code = 0; - /* Pop module pointer */ - COB_MODULE_PTR = COB_MODULE_PTR->next; - cobglobptr->cob_call_name_hash = 0; - cobglobptr->cob_call_from_c = 1; - cobglobptr->cob_call_params = 0; -} - -void -cob_module_free (cob_module **module) -{ - struct cob_alloc_module *ptr, *prv; - if (*module != NULL) { - prv = NULL; - /* Remove from list of all modules activated */ - for (ptr = cob_module_list; ptr; ptr = ptr->next) { - if (ptr->cob_pointer == *module) { - if (prv == NULL) { - cob_module_list = ptr->next; - } else { - prv->next = ptr->next; - } - cob_free (ptr); - break; - } - prv = ptr; - } - - if (!cobglobptr->cob_call_from_c) { - if ((*module)->param_buf != NULL) { - cob_cache_free((*module)->param_buf); - } - if ((*module)->param_field != NULL) { - cob_cache_free((*module)->param_field); - } - } - cob_cache_free (*module); - *module = NULL; - } -} - -/* save module environment - returns an allocated cob_func_loc (free at cob_restore_func) - and the intermediate return field (must be freed by caller) */ -void * -cob_save_func (cob_field **savefld, const int params, - const int eparams, ...) -{ - struct cob_func_loc *fl; - va_list args; - int numparams; - int n; - - if (unlikely (params > eparams)) { - numparams = eparams; - } else { - numparams = params; - } - - /* Allocate return field */ - *savefld = cob_malloc (sizeof (cob_field)); - /* Allocate save area */ - fl = cob_malloc (sizeof (struct cob_func_loc)); - fl->func_params = cob_malloc (sizeof (void *) * ((size_t)numparams + 1U)); - fl->data = cob_malloc (sizeof (void *) * ((size_t)numparams + 1U)); - - /* Save values */ - fl->save_module = COB_MODULE_PTR->next; - fl->save_call_params = cobglobptr->cob_call_params; - fl->save_proc_parms = COB_MODULE_PTR->cob_procedure_params; - fl->save_num_params = COB_MODULE_PTR->module_num_params; - - /* Set current values */ - COB_MODULE_PTR->cob_procedure_params = fl->func_params; - cobglobptr->cob_call_params = numparams; - if (numparams) { - va_start (args, eparams); - for (n = 0; n < numparams; ++n) { - fl->func_params[n] = va_arg (args, cob_field *); - if (fl->func_params[n]) { - fl->data[n] = fl->func_params[n]->data; - } - } - va_end (args); - } - return fl; -} - -/* restores module environment - frees the passed cob_func_loc */ -void -cob_restore_func (struct cob_func_loc *fl) -{ - /* Restore calling environment */ - cobglobptr->cob_call_params = fl->save_call_params; -#if 0 /* RXWRXW - MODNEXT */ - COB_MODULE_PTR->next = fl->save_module; -#endif - COB_MODULE_PTR->cob_procedure_params = fl->save_proc_parms; - COB_MODULE_PTR->module_num_params = fl->save_num_params; - cob_free (fl->data); - cob_free (fl->func_params); - cob_free (fl); -} - -/* - * Copy the returning 'cob_field' and return address of the copy - * This is done to avoid passing back a point to data on the C stack - * for a function which has returned -*/ -cob_field * -cob_function_return (cob_field *rtn) -{ - COB_MODULE_PTR->function_return = *rtn; - return &COB_MODULE_PTR->function_return; -} - -void -cob_check_version (const char *prog, const char *packver_prog, const int patchlev_prog) -{ - int status; - int major_cob, minor_cob; - int major_prog, minor_prog; - - /* note: to be tested with direct C call */ - - status = sscanf (PACKAGE_VERSION, "%d.%d", &major_cob, &minor_cob); - if (status == 2) { - status = sscanf (packver_prog, "%d.%d", &major_prog, &minor_prog); - } else { - minor_prog = major_prog = -1; - } - - if (status != 2 || major_prog < 4 || major_prog > major_cob - || (major_prog == major_cob && minor_prog > minor_cob) - || (major_prog == major_cob && minor_prog == minor_cob && patchlev_prog > PATCH_LEVEL)) { - cob_runtime_error (_("version mismatch")); - cob_runtime_hint (_("%s has version %s.%d"), prog, - packver_prog, patchlev_prog); - cob_runtime_hint (_("%s has version %s.%d"), "libcob", - PACKAGE_VERSION, PATCH_LEVEL); - cob_stop_run (1); - } -} - -void -cob_parameter_check (const char *func_name, const int num_arguments) -{ - if (cobglobptr->cob_call_params < num_arguments) { - cob_runtime_error (_("CALL to %s requires %d arguments"), - func_name, num_arguments); - cob_stop_run (1); - } -} - -void -cob_correct_numeric (cob_field *f) -{ - unsigned char *p; - unsigned char *data; - size_t size; - size_t i; - - if (!COB_FIELD_IS_NUMDISP (f)) { - return; - } - size = f->size; - data = f->data; - if (COB_FIELD_HAVE_SIGN (f)) { - /* Adjust for sign byte */ - size--; - if (unlikely (COB_FIELD_SIGN_LEADING (f))) { - p = f->data; - data = p + 1; - } else { - p = f->data + f->size - 1; - } - if (unlikely (COB_FIELD_SIGN_SEPARATE (f))) { - if (*p != '+' && *p != '-') { - *p = '+'; - } - } else if (unlikely (COB_MODULE_PTR->ebcdic_sign)) { - switch (*p) { - case '{': - case 'A': - case 'B': - case 'C': - case 'D': - case 'E': - case 'F': - case 'G': - case 'H': - case 'I': - case '}': - case 'J': - case 'K': - case 'L': - case 'M': - case 'N': - case 'O': - case 'P': - case 'Q': - case 'R': - break; - case '0': - *p = '{'; - break; - case '1': - *p = 'A'; - break; - case '2': - *p = 'B'; - break; - case '3': - *p = 'C'; - break; - case '4': - *p = 'D'; - break; - case '5': - *p = 'E'; - break; - case '6': - *p = 'F'; - break; - case '7': - *p = 'G'; - break; - case '8': - *p = 'H'; - break; - case '9': - *p = 'I'; - break; - case 0: - case ' ': - *p = '{'; - break; - default: - break; - } - } else { - if (!*p || *p == ' ') { - *p = '0'; - } - } - } else { - p = f->data + f->size - 1; - if (unlikely (COB_MODULE_PTR->ebcdic_sign)) { - switch (*p) { - case 0: - case ' ': - case '{': - case '}': - *p = '0'; - break; - case 'A': - case 'B': - case 'C': - case 'D': - case 'E': - case 'F': - case 'G': - case 'H': - case 'I': - *p = '1' + (*p - 'A'); - break; - case 'J': - case 'K': - case 'L': - case 'M': - case 'N': - case 'O': - case 'P': - case 'Q': - case 'R': - *p = '1' + (*p - 'J'); - break; - default: - break; - } - } else { - switch (*p) { - case 0: - case ' ': - case 'p': - *p = '0'; - break; - case 'q': - *p = '1'; - break; - case 'r': - *p = '2'; - break; - case 's': - *p = '3'; - break; - case 't': - *p = '4'; - break; - case 'u': - *p = '5'; - break; - case 'v': - *p = '6'; - break; - case 'w': - *p = '7'; - break; - case 'x': - *p = '8'; - break; - case 'y': - *p = '9'; - break; - default: - break; - } - } - } - for (i = 0, p = data; i < size; ++i, ++p) { - switch (*p) { - case '0': - case '1': - case '2': - case '3': - case '4': - case '5': - case '6': - case '7': - case '8': - case '9': - break; - case 0: - case ' ': - *p = '0'; - break; - default: - if ((*p & 0x0F) <= 9) { - *p = (*p & 0x0F) + '0'; - } - break; - } - } -} - -static int -cob_check_numdisp (const cob_field *f) -{ - unsigned char *p; - unsigned char *data; - size_t size; - size_t i; - - size = f->size; - data = f->data; - if (COB_FIELD_HAVE_SIGN (f)) { - /* Adjust for sign byte */ - size--; - if (unlikely (COB_FIELD_SIGN_LEADING (f))) { - p = f->data; - data = p + 1; - } else { - p = f->data + f->size - 1; - } - if (unlikely (COB_FIELD_SIGN_SEPARATE (f))) { - if (*p != '+' && *p != '-') { - return 0; - } - } else if (unlikely (COB_MODULE_PTR->ebcdic_sign)) { - switch (*p) { - case '0': - case '1': - case '2': - case '3': - case '4': - case '5': - case '6': - case '7': - case '8': - case '9': - case '{': - case 'A': - case 'B': - case 'C': - case 'D': - case 'E': - case 'F': - case 'G': - case 'H': - case 'I': - case '}': - case 'J': - case 'K': - case 'L': - case 'M': - case 'N': - case 'O': - case 'P': - case 'Q': - case 'R': - break; - default: - return 0; - } - } else { - switch (*p) { - case '0': - case '1': - case '2': - case '3': - case '4': - case '5': - case '6': - case '7': - case '8': - case '9': - case 'p': - case 'q': - case 'r': - case 's': - case 't': - case 'u': - case 'v': - case 'w': - case 'x': - case 'y': - break; - default: - return 0; - } - } - } - for (i = 0; i < size; ++i) { - if (!isdigit (data[i])) { - return 0; - } - } - return 1; -} - -/* Sign */ - -int -cob_real_get_sign (cob_field *f) -{ - unsigned char *p; - - switch (COB_FIELD_TYPE (f)) { - case COB_TYPE_NUMERIC_DISPLAY: - /* Locate sign */ - if (unlikely (COB_FIELD_SIGN_LEADING (f))) { - p = f->data; - } else { - p = f->data + f->size - 1; - } - - /* Get sign */ - if (unlikely (COB_FIELD_SIGN_SEPARATE (f))) { - return (*p == '-') ? -1 : 1; - } - if (*p >= (unsigned char)'0' && *p <= (unsigned char)'9') { - return 1; - } - if (*p == ' ') { -#if 0 /* RXWRXW - Space sign */ - *p = (unsigned char)'0'; -#endif - return 1; - } - if (unlikely (COB_MODULE_PTR->ebcdic_sign)) { - return cob_get_sign_ebcdic (p); - } - return cob_get_sign_ascii (p); - case COB_TYPE_NUMERIC_PACKED: - if (COB_FIELD_NO_SIGN_NIBBLE (f)) { - return 1; - } - p = f->data + f->size - 1; - return ((*p & 0x0F) == 0x0D) ? -1 : 1; - } - return 0; -} - -void -cob_real_put_sign (cob_field *f, const int sign) -{ - unsigned char *p; - unsigned char c; - - switch (COB_FIELD_TYPE (f)) { - case COB_TYPE_NUMERIC_DISPLAY: - /* Locate sign */ - if (unlikely (COB_FIELD_SIGN_LEADING (f))) { - p = f->data; - } else { - p = f->data + f->size - 1; - } - - /* Put sign */ - if (unlikely (COB_FIELD_SIGN_SEPARATE (f))) { - c = (sign < 0) ? (cob_u8_t)'-' : (cob_u8_t)'+'; - if (*p != c) { - *p = c; - } - } else if (unlikely (COB_MODULE_PTR->ebcdic_sign)) { - cob_put_sign_ebcdic (p, sign); - } else if (sign < 0) { - cob_put_sign_ascii (p); - } - return; - case COB_TYPE_NUMERIC_PACKED: - if (COB_FIELD_NO_SIGN_NIBBLE (f)) { - return; - } - p = f->data + f->size - 1; - if (sign < 0) { - *p = (*p & 0xF0) | 0x0D; - } else { - *p = (*p & 0xF0) | 0x0C; - } - return; - } -} - -/* Registration of external handlers */ -void -cob_reg_sighnd (void (*sighnd) (int)) -{ - if (!cob_initialized) { - cob_set_signal (); - } - cob_ext_sighdl = sighnd; -} - -/* Switch */ - -int -cob_get_switch (const int n) -{ - if (n < 0 || n > COB_SWITCH_MAX) { - return 0; - } - return cob_switch[n]; -} - -void -cob_set_switch (const int n, const int flag) -{ - if (n < 0 || n > COB_SWITCH_MAX) { - return; - } - if (flag == 0) { - cob_switch[n] = 0; - } else if (flag == 1) { - cob_switch[n] = 1; - } -} - -int -cob_cmp (cob_field *f1, cob_field *f2) -{ - cob_field temp; - cob_field_attr attr; - unsigned char buff[256]; - - if (COB_FIELD_IS_NUMERIC (f1) && COB_FIELD_IS_NUMERIC (f2)) { - return cob_numeric_cmp (f1, f2); - } - if (COB_FIELD_TYPE (f2) == COB_TYPE_ALPHANUMERIC_ALL) { - if (f2->size == 1 && f2->data[0] == '0' && - COB_FIELD_IS_NUMERIC (f1)) { - return cob_cmp_int (f1, 0); - } - return cob_cmp_all (f1, f2); - } - if (COB_FIELD_TYPE (f1) == COB_TYPE_ALPHANUMERIC_ALL) { - if (f1->size == 1 && f1->data[0] == '0' && - COB_FIELD_IS_NUMERIC (f2)) { - return -cob_cmp_int (f2, 0); - } - return -cob_cmp_all (f2, f1); - } - if (COB_FIELD_IS_NUMERIC (f1) && - COB_FIELD_TYPE (f1) != COB_TYPE_NUMERIC_DISPLAY) { - temp.size = COB_FIELD_DIGITS (f1); - temp.data = buff; - temp.attr = &attr; - attr = *f1->attr; - attr.type = COB_TYPE_NUMERIC_DISPLAY; - attr.flags &= ~COB_FLAG_HAVE_SIGN; - cob_move (f1, &temp); - f1 = &temp; - } - if (COB_FIELD_IS_NUMERIC (f2) && - COB_FIELD_TYPE (f2) != COB_TYPE_NUMERIC_DISPLAY) { - temp.size = COB_FIELD_DIGITS (f2); - temp.data = buff; - temp.attr = &attr; - attr = *f2->attr; - attr.type = COB_TYPE_NUMERIC_DISPLAY; - attr.flags &= ~COB_FLAG_HAVE_SIGN; - cob_move (f2, &temp); - f2 = &temp; - } - return cob_cmp_alnum (f1, f2); -} - -/* Class check */ - -int -cob_is_omitted (const cob_field *f) -{ - return f->data == NULL; -} - -int -cob_is_numeric (const cob_field *f) -{ - size_t i; - union { - float fpf; - double fpd; - } fval; - int sign; - - switch (COB_FIELD_TYPE (f)) { - case COB_TYPE_NUMERIC_BINARY: - return 1; - case COB_TYPE_NUMERIC_FLOAT: - memcpy (&fval.fpf, f->data, sizeof (float)); - return !ISFINITE ((double)fval.fpf); - case COB_TYPE_NUMERIC_DOUBLE: - memcpy (&fval.fpd, f->data, sizeof (double)); - return !ISFINITE (fval.fpd); - case COB_TYPE_NUMERIC_PACKED: - /* Check digits */ - for (i = 0; i < f->size - 1; ++i) { - if ((f->data[i] & 0xF0) > 0x90 || - (f->data[i] & 0x0F) > 0x09) { - return 0; - } - } - /* Check high nibble of last byte */ - if ((f->data[i] & 0xF0) > 0x90) { - return 0; - } - - if (COB_FIELD_NO_SIGN_NIBBLE (f)) { - /* COMP-6 - Check last nibble */ - if ((f->data[i] & 0x0F) > 0x09) { - return 0; - } - return 1; - } - - /* Check sign */ - sign = f->data[i] & 0x0F; - if (COB_FIELD_HAVE_SIGN (f)) { - if (sign == 0x0C || sign == 0x0D) { - return 1; - } - if (COB_MODULE_PTR->flag_host_sign && - sign == 0x0F) { - return 1; - } - } else if (sign == 0x0F) { - return 1; - } - return 0; - case COB_TYPE_NUMERIC_DISPLAY: - return cob_check_numdisp (f); - case COB_TYPE_NUMERIC_FP_DEC64: -#ifdef WORDS_BIGENDIAN - return (f->data[0] & 0x78U) != 0x78U; -#else - return (f->data[7] & 0x78U) != 0x78U; -#endif - case COB_TYPE_NUMERIC_FP_DEC128: -#ifdef WORDS_BIGENDIAN - return (f->data[0] & 0x78U) != 0x78U; -#else - return (f->data[15] & 0x78U) != 0x78U; -#endif - default: - for (i = 0; i < f->size; ++i) { - if (!isdigit (f->data[i])) { - return 0; - } - } - return 1; - } -} - -int -cob_is_alpha (const cob_field *f) -{ - size_t i; - - for (i = 0; i < f->size; ++i) { - if (!isalpha (f->data[i]) && f->data[i] != (unsigned char)' ') { - return 0; - } - } - return 1; -} - -int -cob_is_upper (const cob_field *f) -{ - size_t i; - - for (i = 0; i < f->size; ++i) { - if (!isupper (f->data[i]) && f->data[i] != (unsigned char)' ') { - return 0; - } - } - return 1; -} - -int -cob_is_lower (const cob_field *f) -{ - size_t i; - - for (i = 0; i < f->size; ++i) { - if (!islower (f->data[i]) && f->data[i] != (unsigned char)' ') { - return 0; - } - } - return 1; -} - -/* Table sort */ - -void -cob_table_sort_init (const size_t nkeys, const unsigned char *collating_sequence) -{ - sort_nkeys = 0; - sort_keys = cob_malloc (nkeys * sizeof (cob_file_key)); - if (collating_sequence) { - sort_collate = collating_sequence; - } else { - sort_collate = COB_MODULE_PTR->collating_sequence; - } -} - -void -cob_table_sort_init_key (cob_field *field, const int flag, - const unsigned int offset) -{ - sort_keys[sort_nkeys].field = field; - sort_keys[sort_nkeys].tf_ascending = flag; - sort_keys[sort_nkeys].offset = offset; - sort_nkeys++; -} - -void -cob_table_sort (cob_field *f, const int n) -{ - qsort (f->data, (size_t) n, f->size, sort_compare); - cob_free (sort_keys); -} - -/* Run-time error checking */ - -void -cob_check_based (const unsigned char *x, const char *name) -{ - if (!x) { - /* name includes '' already and can be ... 'x' (addressed by 'y'= */ - cob_runtime_error (_("BASED/LINKAGE item %s has NULL address"), name); - cob_stop_run (1); - } -} - -void -cob_check_linkage (const unsigned char *x, const char *name, const int check_type) -{ - if (!x) { - /* name includes '' already and can be ... 'x' of 'y' */ - switch (check_type) { - case 0: /* check for passed items and size on module entry */ - cob_runtime_error (_("LINKAGE item %s not passed by caller"), name); - break; - case 1: /* check for passed OPTIONAL items on item use */ - cob_runtime_error (_("LINKAGE item %s not passed by caller"), name); - break; - } - cob_stop_run (1); - } -} - -static const char * -explain_field_type (const cob_field *f) -{ - switch (COB_FIELD_TYPE (f)) { - case COB_TYPE_GROUP: - return "GROUP"; - case COB_TYPE_BOOLEAN: - return "BOOLEAN"; - case COB_TYPE_NUMERIC_DISPLAY: - return "NUMERIC DISPLAY"; - case COB_TYPE_NUMERIC_BINARY: - return "BINARY"; - case COB_TYPE_NUMERIC_PACKED: - return "PACKED-DECIMAL"; - case COB_TYPE_NUMERIC_FLOAT: - return "FLOAT"; - case COB_TYPE_NUMERIC_DOUBLE: - return "DOUBLE"; - case COB_TYPE_NUMERIC_L_DOUBLE: - return "LONG DOUBLE"; - case COB_TYPE_NUMERIC_FP_DEC64: - return "FP DECIMAL 64"; - case COB_TYPE_NUMERIC_FP_DEC128: - return "FP DECIMAL 128"; - case COB_TYPE_NUMERIC_FP_BIN32: - return "FP BINARY 32"; - case COB_TYPE_NUMERIC_FP_BIN64: - return "FP BINARY 64"; - case COB_TYPE_NUMERIC_FP_BIN128: - return "FP BINARY 128"; - /* note: may be not reached depending on endianness */ - case COB_TYPE_NUMERIC_COMP5: - return "COMP-5"; - case COB_TYPE_NUMERIC_EDITED: - return "NUMERIC EDITED"; - case COB_TYPE_ALPHANUMERIC: - return "ALPHANUMERIC"; - case COB_TYPE_ALPHANUMERIC_ALL: - return "ALPHANUMERIC ALL"; - case COB_TYPE_ALPHANUMERIC_EDITED: - return "ALPHANUMERIC EDITED"; - case COB_TYPE_NATIONAL: - return "NATIONAL"; - case COB_TYPE_NATIONAL_EDITED: - return "NATIONAL EDITED"; - default: - break; - } - return "UNKNOWN"; -} - -void -cob_check_numeric (const cob_field *f, const char *name) -{ - unsigned char *data; - char *p; - char *buff; - size_t i; - - if (!cob_is_numeric (f)) { - cob_set_exception (COB_EC_DATA_INCOMPATIBLE); - buff = cob_fast_malloc ((size_t)COB_SMALL_BUFF); - p = buff; - data = f->data; - if (COB_FIELD_IS_NUMDISP(f) || COB_FIELD_IS_ANY_ALNUM(f)) { - for (i = 0; i < f->size; ++i) { - if (isprint (data[i])) { - *p++ = data[i]; - } else { - p += sprintf (p, "\\%03o", data[i]); - } - } - } else { - p += sprintf (p, "0x"); - for (i = 0; i < f->size; ++i) { - p += sprintf (p, "%02x", data[i]); - } - } - *p = '\0'; - cob_runtime_error (_("'%s' (Type: %s) not numeric: '%s'"), - name, explain_field_type(f), buff); - cob_free (buff); - cob_stop_run (1); - } -} - -void -cob_check_odo (const int i, const int min, - const int max, const char *name, const char *dep_name) -{ - /* Check OCCURS DEPENDING ON item */ - if (i < min || i > max) { - cob_set_exception (COB_EC_BOUND_ODO); - - cob_runtime_error (_("OCCURS DEPENDING ON '%s' out of bounds: %d"), - dep_name, i); - if (i > max) { - cob_runtime_hint (_("maximum subscript for '%s': %d"), name, max); - } else { - cob_runtime_hint (_("minimum subscript for '%s': %d"), name, min); - } - cob_stop_run (1); - } -} - -void -cob_check_subscript (const int i, const int max, - const char *name, const int odo_item) -{ - /* Check subscript */ - if (i < 1 || i > max) { - cob_set_exception (COB_EC_BOUND_SUBSCRIPT); - cob_runtime_error (_("subscript of '%s' out of bounds: %d"), name, i); - if (i >= 1) { - if (odo_item) { - cob_runtime_hint (_("current maximum subscript for '%s': %d"), - name, max); - } else { - cob_runtime_hint (_("maximum subscript for '%s': %d"), - name, max); - } - } - cob_stop_run (1); - } -} - -void -cob_check_ref_mod (const int offset, const int length, - const int size, const char *name) -{ - /* Check offset */ - if (offset < 1 || offset > size) { - cob_set_exception (COB_EC_BOUND_REF_MOD); - if (offset < 1) { - cob_runtime_error (_("offset of '%s' out of bounds: %d"), - name, offset); - } else { - cob_runtime_error (_("offset of '%s' out of bounds: %d, maximum: %d"), - name, offset, size); - } - cob_stop_run (1); - } - - /* Check plain length */ - if (length < 1 || length > size) { - cob_set_exception (COB_EC_BOUND_REF_MOD); - if (length < 1) { - cob_runtime_error (_("length of '%s' out of bounds: %d"), - name, length); - } else { - cob_runtime_error (_("length of '%s' out of bounds: %d, maximum: %d"), - name, length, size); - } - cob_stop_run (1); - } - - /* Check length with offset */ - if (offset + length - 1 > size) { - cob_set_exception (COB_EC_BOUND_REF_MOD); - cob_runtime_error (_("length of '%s' out of bounds: %d, starting at: %d, maximum: %d"), - name, length, offset, size); - cob_stop_run (1); - } -} - -void * -cob_external_addr (const char *exname, const int exlength) -{ - struct cob_external *eptr; - - /* Locate or allocate EXTERNAL item */ - for (eptr = basext; eptr; eptr = eptr->next) { - if (!strcmp (exname, eptr->ename)) { - if (exlength > eptr->esize) { - cob_runtime_error (_("EXTERNAL item '%s' previously allocated with size %d, requested size is %d"), - exname, eptr->esize, exlength); - cob_stop_run (1); - } - if (exlength < eptr->esize) { - cob_runtime_warning (_("EXTERNAL item '%s' previously allocated with size %d, requested size is %d"), - exname, eptr->esize, exlength); - } - cobglobptr->cob_initial_external = 0; - return eptr->ext_alloc; - } - } - eptr = cob_malloc (sizeof (struct cob_external)); - eptr->next = basext; - eptr->esize = exlength; - eptr->ename = cob_malloc (strlen (exname) + 1U); - strcpy (eptr->ename, exname); - eptr->ext_alloc = cob_malloc ((size_t)exlength); - basext = eptr; - cobglobptr->cob_initial_external = 1; - return eptr->ext_alloc; -} - -#if defined (_MSC_VER) && COB_USE_VC2008_OR_GREATER - -/* Get function pointer for most precise time function - GetSystemTimePreciseAsFileTime is available since OS-version Windows 2000 - GetSystemTimeAsFileTime is available since OS-version Windows 8 / Server 2012 -*/ -static void -get_function_ptr_for_precise_time (void) -{ - HMODULE kernel32_handle; - - kernel32_handle = GetModuleHandle (TEXT ("kernel32.dll")); - if (kernel32_handle != NULL) { - time_as_filetime_func = (VOID (WINAPI *) (LPFILETIME)) - GetProcAddress (kernel32_handle, "GetSystemTimePreciseAsFileTime"); - } - if (time_as_filetime_func == NULL) { - time_as_filetime_func = GetSystemTimeAsFileTime; - } -} -#endif - -/* Set the offset from UTC */ -void -static set_cob_time_from_localtime (time_t curtime, struct cob_time *cb_time) { - - struct tm *tmptr; -#if !defined (_BSD_SOURCE) && !defined (HAVE_TIMEZONE) - time_t utctime, lcltime, difftime; -#endif - - tmptr = localtime (&curtime); - - cb_time->year = tmptr->tm_year + 1900; - cb_time->month = tmptr->tm_mon + 1; - cb_time->day_of_month = tmptr->tm_mday; - cb_time->day_of_week = one_indexed_day_of_week_from_monday (tmptr->tm_wday); - cb_time->day_of_year = tmptr->tm_yday + 1; - cb_time->hour = tmptr->tm_hour; - cb_time->minute = tmptr->tm_min; - /* LCOV_EXCL_START */ - /* Leap seconds ? */ - if (tmptr->tm_sec >= 60) { - tmptr->tm_sec = 59; - } - /* LCOV_EXCL_STOP */ - cb_time->second = tmptr->tm_sec; - cb_time->nanosecond = 0; - cb_time->is_daylight_saving_time = tmptr->tm_isdst; - -#if defined (_BSD_SOURCE) - cb_time->offset_known = 1; - cb_time->utc_offset = tmptr->tm_gmtoff / 60; -#elif defined (HAVE_TIMEZONE) - cb_time->offset_known = 1; - cb_time->utc_offset = timezone / -60; - /* LCOV_EXCL_START */ - if (tmptr->tm_isdst) { - cb_time->utc_offset += 60; - } - /* LCOV_EXCL_STOP */ -#else - lcltime = mktime (tmptr); - - tmptr = gmtime (&curtime); - utctime = mktime (tmptr); - - if (utctime != -1 && lcltime != -1) { /* LCOV_EXCL_BR_LINE */ - difftime = utctime - lcltime; - /* LCOV_EXCL_START */ - if (tmptr->tm_isdst) { - difftime -= 3600; - } - /* LCOV_EXCL_STOP */ - cb_time->utc_offset = difftime / 60; - cb_time->offset_known = 1; - /* LCOV_EXCL_START */ - } else { - cb_time->offset_known = 0; - cb_time->utc_offset = 0; - } - /* LCOV_EXCL_STOP */ -#endif -} - -#if defined (_WIN32) /* cygwin does not define _WIN32 */ -static struct cob_time -cob_get_current_date_and_time_from_os (void) -{ - SYSTEMTIME local_time; -#if defined (_MSC_VER) && COB_USE_VC2008_OR_GREATER - FILETIME filetime; - SYSTEMTIME utc_time; -#endif - - time_t curtime; - struct cob_time cb_time; - - curtime = time (NULL); - set_cob_time_from_localtime (curtime, &cb_time); - - /* Get nanoseconds with highest precision possible */ -#if defined (_MSC_VER) && COB_USE_VC2008_OR_GREATER - if (!time_as_filetime_func) { - get_function_ptr_for_precise_time (); - } -#pragma warning(suppress: 6011) /* the function pointer is always set by get_function_ptr_for_precise_time */ - (time_as_filetime_func) (&filetime); - /* fallback to GetLocalTime if one of the following does not work */ - if (FileTimeToSystemTime (&filetime, &utc_time) && - SystemTimeToTzSpecificLocalTime (NULL, &utc_time, &local_time)) { - set_cob_time_ns_from_filetime (filetime, &cb_time); - return cb_time; - } -#endif - GetLocalTime (&local_time); - cb_time.nanosecond = local_time.wMilliseconds * 1000000; - return cb_time; -} -#else -static struct cob_time -cob_get_current_date_and_time_from_os (void) -{ -#if defined (HAVE_CLOCK_GETTIME) - struct timespec time_spec; -#elif defined (HAVE_SYS_TIME_H) && defined (HAVE_GETTIMEOFDAY) - struct timeval tmv; -#endif - time_t curtime; - struct cob_time cb_time; - - /* Get the current time */ -#if defined (HAVE_CLOCK_GETTIME) - clock_gettime (CLOCK_REALTIME, &time_spec); - curtime = time_spec.tv_sec; -#elif defined (HAVE_SYS_TIME_H) && defined (HAVE_GETTIMEOFDAY) - gettimeofday (&tmv, NULL); - curtime = tmv.tv_sec; -#else - curtime = time (NULL); -#endif - - set_cob_time_from_localtime (curtime, &cb_time); - - /* Get nanoseconds or microseconds, if possible */ -#if defined (HAVE_CLOCK_GETTIME) - cb_time.nanosecond = (int) time_spec.tv_nsec; -#elif defined (HAVE_SYS_TIME_H) && defined (HAVE_GETTIMEOFDAY) - cb_time.nanosecond = tmv.tv_usec * 1000; -#else - cb_time.nanosecond = 0; -#endif - - return cb_time; -} -#endif - -struct cob_time -cob_get_current_date_and_time (void) -{ - int needs_calculation = 0; - time_t t; - struct tm *tmptr; - struct cob_time cb_time = cob_get_current_date_and_time_from_os (); - - /* do we have a constant time? */ - if (cobsetptr != NULL - && cobsetptr->cob_time_constant.year != 0) { - if (cobsetptr->cob_time_constant.hour != -1) { - cb_time.hour = cobsetptr->cob_time_constant.hour; - } - if (cobsetptr->cob_time_constant.minute != -1) { - cb_time.minute = cobsetptr->cob_time_constant.minute; - } - if (cobsetptr->cob_time_constant.second != -1) { - cb_time.second = cobsetptr->cob_time_constant.second; - } - if (cobsetptr->cob_time_constant.nanosecond != -1) { - cb_time.nanosecond = cobsetptr->cob_time_constant.nanosecond; - } - if (cobsetptr->cob_time_constant.year != -1) { - cb_time.year = cobsetptr->cob_time_constant.year; - needs_calculation = 1; - } - if (cobsetptr->cob_time_constant.month != -1) { - cb_time.month = cobsetptr->cob_time_constant.month; - needs_calculation = 1; - } - if (cobsetptr->cob_time_constant.day_of_month != -1) { - cb_time.day_of_month = cobsetptr->cob_time_constant.day_of_month; - needs_calculation = 1; - } - if (cobsetptr->cob_time_constant.offset_known) { - cb_time.offset_known = cobsetptr->cob_time_constant.offset_known; - cb_time.utc_offset = cobsetptr->cob_time_constant.utc_offset; - } - } - - /* Leap seconds ? */ - if (cb_time.second >= 60) { - cb_time.second = 59; - } - - /* set day_of_week, day_of_year, is_daylight_saving_time, if necessary */ - if (needs_calculation) { - /* allocate tmptr (needs a correct time) */ - time (&t); - tmptr = localtime (&t); - tmptr->tm_isdst = -1; - tmptr->tm_sec = cb_time.second; - tmptr->tm_min = cb_time.minute; - tmptr->tm_hour = cb_time.hour; - tmptr->tm_year = cb_time.year - 1900; - tmptr->tm_mon = cb_time.month - 1; - tmptr->tm_mday = cb_time.day_of_month; - tmptr->tm_wday = -1; - tmptr->tm_yday = -1; - (void)mktime(tmptr); - cb_time.day_of_week = one_indexed_day_of_week_from_monday (tmptr->tm_wday); - cb_time.day_of_year = tmptr->tm_yday + 1; - cb_time.is_daylight_saving_time = tmptr->tm_isdst; - } - - return cb_time; -} - -static void -check_current_date() -{ - int yr, mm, dd, hh, mi, ss, ns; - int offset = 9999; - int i, j, ret; - time_t t; - struct tm *tmptr; - char iso_timezone[7] = { '\0' }; - char nanoseconds[10]; - char *iso_timezone_ptr = (char *)&iso_timezone; - - if (cobsetptr == NULL - || cobsetptr->cob_date == NULL) { - return; - } - - j = ret = 0; - yr = mm = dd = hh = mi = ss = ns = -1; - - /* skip non-digits like quotes */ - while (cobsetptr->cob_date[j] != 0 - && cobsetptr->cob_date[j] != 'Y' - && !isdigit(cobsetptr->cob_date[j])) { - j++; - } - - /* extract date */ - if (cobsetptr->cob_date[j] != 0) { - yr = 0; - for (i = 0; cobsetptr->cob_date[j] != 0; j++) { - if (isdigit (cobsetptr->cob_date[j])) { - yr = yr * 10 + COB_D2I (cobsetptr->cob_date[j]); - } else { - break; - } - if (++i == 4) { - j++; - break; - } - } - if (i != 2 && i != 4) { - if (cobsetptr->cob_date[j] == 'Y') { - while (cobsetptr->cob_date[j] == 'Y') j++; - } else { - ret = 1; - } - yr = -1; - } else if (yr < 100) { - yr += 2000; - } - while (cobsetptr->cob_date[j] == '/' - || cobsetptr->cob_date[j] == '-') { - j++; - } - } - if (cobsetptr->cob_date[j] != 0) { - mm = 0; - for (i = 0; cobsetptr->cob_date[j] != 0; j++) { - if (isdigit (cobsetptr->cob_date[j])) { - mm = mm * 10 + COB_D2I (cobsetptr->cob_date[j]); - } else { - break; - } - if (++i == 2) { - j++; - break; - } - } - if (i != 2) { - if (cobsetptr->cob_date[j] == 'M') { - while (cobsetptr->cob_date[j] == 'M') j++; - } else { - ret = 1; - } - mm = -1; - } else if (mm < 1 || mm > 12) { - ret = 1; - } - while (cobsetptr->cob_date[j] == '/' - || cobsetptr->cob_date[j] == '-') { - j++; - } - } - if (cobsetptr->cob_date[j] != 0) { - dd = 0; - for (i = 0; cobsetptr->cob_date[j] != 0; j++) { - if (isdigit (cobsetptr->cob_date[j])) { - dd = dd * 10 + COB_D2I (cobsetptr->cob_date[j]); - } else { - break; - } - if (++i == 2) { - j++; - break; - } - } - if (i != 2) { - if (cobsetptr->cob_date[j] == 'D') { - while (cobsetptr->cob_date[j] == 'D') j++; - } else { - ret = 1; - } - dd = -1; - } else if (dd < 1 || dd > 31) { - ret = 1; - } - } - - /* extract time */ - if (cobsetptr->cob_date[j] != 0) { - hh = 0; - while (isspace (cobsetptr->cob_date[j])) j++; - for (i = 0; cobsetptr->cob_date[j] != 0; j++) { - if (isdigit (cobsetptr->cob_date[j])) { - hh = hh * 10 + COB_D2I (cobsetptr->cob_date[j]); - } else { - break; - } - if (++i == 2) { - j++; - break; - } - } - - if (i != 2) { - if (cobsetptr->cob_date[j] == 'H') { - while (cobsetptr->cob_date[j] == 'H') j++; - } else { - ret = 1; - } - hh = -1; - } else if (hh > 23) { - ret = 1; - } - while (cobsetptr->cob_date[j] == ':' - || cobsetptr->cob_date[j] == '-') - j++; - } - if (cobsetptr->cob_date[j] != 0) { - mi = 0; - for (i = 0; cobsetptr->cob_date[j] != 0; j++) { - if (isdigit (cobsetptr->cob_date[j])) { - mi = mi * 10 + COB_D2I (cobsetptr->cob_date[j]); - } else { - break; - } - if (++i == 2) { - j++; - break; - } - } - if (i != 2) { - if (cobsetptr->cob_date[j] == 'M') { - while (cobsetptr->cob_date[j] == 'M') j++; - } else { - ret = 1; - } - mi = -1; - } else if (mi > 59) { - ret = 1; - } - while (cobsetptr->cob_date[j] == ':' - || cobsetptr->cob_date[j] == '-') { - j++; - } - } - - if (cobsetptr->cob_date[j] != 0 - && cobsetptr->cob_date[j] != 'Z' - && cobsetptr->cob_date[j] != '+' - && cobsetptr->cob_date[j] != '-') { - ss = 0; - for (i = 0; cobsetptr->cob_date[j] != 0; j++) { - if (isdigit (cobsetptr->cob_date[j])) { - ss = ss * 10 + COB_D2I (cobsetptr->cob_date[j]); - } else { - break; - } - if (++i == 2) { - j++; - break; - } - } - if (i != 2) { - if (cobsetptr->cob_date[j] == 'S') { - while (cobsetptr->cob_date[j] == 'S') j++; - } else { - ret = 1; - } - ss = -1; - /* leap second would be 60 */ - } else if (ss > 60) { - ret = 1; - } - } - - if (cobsetptr->cob_date[j] != 0 - && cobsetptr->cob_date[j] != 'Z' - && cobsetptr->cob_date[j] != '+' - && cobsetptr->cob_date[j] != '-') { - ns = 0; - if (cobsetptr->cob_date[j] == '.' - || cobsetptr->cob_date[j] == ':') { - j++; - } - strcpy (nanoseconds, "000000000"); - for (i=0; cobsetptr->cob_date[j] != 0; j++) { - if (isdigit (cobsetptr->cob_date[j])) { - nanoseconds[i] = cobsetptr->cob_date[j]; - } else { - break; - } - if (++i == 9) { - j++; - break; - } - } - ns = atoi(nanoseconds); - } - - /* extract UTC offset */ - if (cobsetptr->cob_date[j] == 'Z') { - offset = 0; - iso_timezone[0] = 'Z'; - } else if (cobsetptr->cob_date[j] == '+' - || cobsetptr->cob_date[j] == '-') { - strncpy (iso_timezone_ptr, cobsetptr->cob_date + j, 6); - iso_timezone[6] = 0; /* just to keep the analyzer happy */ - if (strlen (iso_timezone_ptr) == 3) { - strcpy (iso_timezone_ptr + 3, "00"); - } else if (iso_timezone[3] == ':') { - strncpy (iso_timezone_ptr + 3, cobsetptr->cob_date + j + 4, 3); - } - for (i=1; iso_timezone[i] != 0; i++) { - if (!isdigit (iso_timezone[i])) { - break; - } - if (++i == 4) { - break; - } - } - if (i == 4) { - offset = COB_D2I (iso_timezone[1]) * 60 * 10 - + COB_D2I (iso_timezone[2]) * 60 - + COB_D2I (iso_timezone[3]) * 10 - + COB_D2I (iso_timezone[4]); - if (iso_timezone[0] == '-') { - offset *= -1; - } - } else { - ret = 1; - iso_timezone[0] = '\0'; - } - } - - if (ret != 0) { - cob_runtime_warning (_("COB_CURRENT_DATE '%s' is invalid"), cobsetptr->cob_date); - } - - /* get local time, allocate tmptr */ - time(&t); - tmptr = localtime (&t); - - /* override given parts in time */ - if (ss != -1) { - tmptr->tm_sec = ss; - } - if (mi != -1) { - tmptr->tm_min = mi; - } - if (hh != -1) { - tmptr->tm_hour = hh; - } - if (yr != -1) { - tmptr->tm_year = yr - 1900; - } - if (mm != -1) { - tmptr->tm_mon = mm - 1; - } - if (dd != -1) { - tmptr->tm_mday = dd; - } - tmptr->tm_isdst = -1; - - /* normalize if needed (for example 40 October is changed into 9 November), - set tm_wday, tm_yday and tm_isdst */ - t = mktime (tmptr); - - /* set datetime constant */ - - if (hh != -1) { - cobsetptr->cob_time_constant.hour = tmptr->tm_hour; - } else { - cobsetptr->cob_time_constant.hour = -1; - } - if (mi != -1) { - cobsetptr->cob_time_constant.minute = tmptr->tm_min; - } else { - cobsetptr->cob_time_constant.minute = -1; - } - if (ss != -1) { - cobsetptr->cob_time_constant.second = tmptr->tm_sec; - } else { - cobsetptr->cob_time_constant.second = -1; - } - if (ns != -1) { - cobsetptr->cob_time_constant.nanosecond = ns; - } else { - cobsetptr->cob_time_constant.nanosecond = -1; - } - if (yr != -1) { - cobsetptr->cob_time_constant.year = tmptr->tm_year + 1900; - } else { - cobsetptr->cob_time_constant.year = -1; - } - if (mm != -1) { - cobsetptr->cob_time_constant.month = tmptr->tm_mon + 1; - } else { - cobsetptr->cob_time_constant.month = -1; - } - if (dd != -1) { - cobsetptr->cob_time_constant.day_of_month = tmptr->tm_mday; - } else { - cobsetptr->cob_time_constant.day_of_month = -1; - } - - /* the following are only set in "current" instances, not in the constant */ - cobsetptr->cob_time_constant.day_of_week = -1; - cobsetptr->cob_time_constant.day_of_year = -1; - cobsetptr->cob_time_constant.is_daylight_saving_time = -1; - - if (iso_timezone[0] != '\0') { - cobsetptr->cob_time_constant.offset_known = 1; - cobsetptr->cob_time_constant.utc_offset = offset; - } else { - cobsetptr->cob_time_constant.offset_known = 0; - cobsetptr->cob_time_constant.utc_offset = 0; - } -} - -/* Extended ACCEPT/DISPLAY */ - -void -cob_accept_date (cob_field *field) -{ - struct cob_time time; - char buff[16]; /* 16: make the compiler happy as "unsigned short" *could* - have more digits than we "assume" */ - - time = cob_get_current_date_and_time (); - - snprintf(buff, sizeof (buff), "%2.2d%2.2d%2.2d", - (cob_u16_t) time.year % 100, - (cob_u16_t) time.month, - (cob_u16_t) time.day_of_month); - cob_memcpy (field, buff, (size_t)6); -} - -void -cob_accept_date_yyyymmdd (cob_field *field) -{ - struct cob_time time; - char buff[16]; /* 16: make the compiler happy as "unsigned short" *could* - have more digits than we "assume" */ - - time = cob_get_current_date_and_time (); - - snprintf (buff, sizeof (buff), "%4.4d%2.2d%2.2d", - (cob_u16_t) time.year, - (cob_u16_t) time.month, - (cob_u16_t) time.day_of_month); - cob_memcpy (field, buff, (size_t)8); -} - -void -cob_accept_day (cob_field *field) -{ - struct cob_time time; - char buff[11]; /* 11: make the compiler happy as "unsigned short" *could* - have more digits than we "assume" */ - - time = cob_get_current_date_and_time (); - snprintf (buff, sizeof (buff), "%2.2d%3.3d", - (cob_u16_t) time.year % 100, - (cob_u16_t) time.day_of_year); - cob_memcpy (field, buff, (size_t)5); -} - -void -cob_accept_day_yyyyddd (cob_field *field) -{ - struct cob_time time; - char buff[11]; /* 11: make the compiler happy as "unsigned short" *could* - have more digits than we "assume" */ - - time = cob_get_current_date_and_time (); - snprintf (buff, sizeof (buff), "%4.4d%3.3d", - (cob_u16_t) time.year, - (cob_u16_t) time.day_of_year); - cob_memcpy (field, buff, (size_t)7); -} - -void -cob_accept_day_of_week (cob_field *field) -{ - struct cob_time time; - unsigned char day; - - time = cob_get_current_date_and_time (); - day = (unsigned char)(time.day_of_week + '0'); - cob_memcpy (field, &day, (size_t)1); -} - -void -cob_accept_time (cob_field *field) -{ - struct cob_time time; - char buff[21]; /* 11: make the compiler happy as "unsigned short" *could* - have more digits than we "assume" */ - - time = cob_get_current_date_and_time (); - snprintf (buff, sizeof (buff), "%2.2d%2.2d%2.2d%2.2d", - (cob_u16_t) time.hour, - (cob_u16_t) time.minute, - (cob_u16_t) time.second, - (cob_u16_t) (time.nanosecond / 10000000)); - - cob_memcpy (field, buff, (size_t)8); -} - -void -cob_display_command_line (cob_field *f) -{ - if (commlnptr) { - cob_free (commlnptr); - } - commlnptr = cob_malloc (f->size + 1U); - commlncnt = f->size; - memcpy (commlnptr, f->data, commlncnt); -} - -void -cob_accept_command_line (cob_field *f) -{ - char *buff; - size_t i; - size_t size; - size_t len; - - if (commlncnt) { - cob_memcpy (f, commlnptr, commlncnt); - return; - } - - if (cob_argc <= 1) { - cob_memcpy (f, " ", (size_t)1); - return; - } - - size = 0; - for (i = 1; i < (size_t)cob_argc; ++i) { - size += (strlen (cob_argv[i]) + 1); - if (size > f->size) { - break; - } - } - buff = cob_malloc (size); - buff[0] = ' '; - size = 0; - for (i = 1; i < (size_t)cob_argc; ++i) { - len = strlen (cob_argv[i]); - memcpy (buff + size, cob_argv[i], len); - size += len; - if (i != (size_t)cob_argc - 1U) { - buff[size++] = ' '; - } - if (size > f->size) { - break; - } - } - cob_memcpy (f, buff, size); - cob_free (buff); -} - -/* Argument number */ - -void -cob_display_arg_number (cob_field *f) -{ - int n; - cob_field_attr attr; - cob_field temp; - - temp.size = 4; - temp.data = (unsigned char *)&n; - temp.attr = &attr; - COB_ATTR_INIT (COB_TYPE_NUMERIC_BINARY, 9, 0, 0, NULL); - cob_move (f, &temp); - if (n < 0 || n >= cob_argc) { - cob_set_exception (COB_EC_IMP_DISPLAY); - return; - } - current_arg = n; -} - -void -cob_accept_arg_number (cob_field *f) -{ - int n; - cob_field_attr attr; - cob_field temp; - - n = cob_argc - 1; - temp.size = 4; - temp.data = (unsigned char *)&n; - temp.attr = &attr; - COB_ATTR_INIT (COB_TYPE_NUMERIC_BINARY, 9, 0, 0, NULL); - cob_move (&temp, f); -} - -void -cob_accept_arg_value (cob_field *f) -{ - if (current_arg >= cob_argc) { - cob_set_exception (COB_EC_IMP_ACCEPT); - return; - } - cob_memcpy (f, cob_argv[current_arg], - strlen (cob_argv[current_arg])); - current_arg++; -} - -/* Environment variable handling */ - -#ifdef _MSC_VER -/* _MSC does *NOT* have `setenv` (!) - But as the handling of the fallback `putenv` is different in POSIX and _MSC - (POSIX stores no duplicate of `putenv`, where _MSC does), we pretend to - have support for `setenv` and define it here with the same behaviour: */ - -static COB_INLINE COB_A_INLINE int -setenv (const char *name, const char *value, int overwrite) { - /* remark: _putenv_s does always overwrite, add a check for overwrite = 1 if necessary later */ - COB_UNUSED (overwrite); - return _putenv_s (name,value); -} -static COB_INLINE COB_A_INLINE int -unsetenv (const char *name) { - return _putenv_s (name,""); -} -#endif - -int -cob_setenv (const char *name, const char *value, int overwrite) { -#if defined (HAVE_SETENV) && HAVE_SETENV - return setenv (name, value, overwrite); -#else - char *env; - size_t len; - - COB_UNUSED (overwrite); - len = strlen (name) + strlen (value) + 2U; - env = cob_fast_malloc (len); - sprintf (env, "%s=%s", name, value); - return putenv (env); -#endif -} - -int -cob_unsetenv (const char *name) { -#if defined(HAVE_SETENV) && HAVE_SETENV - unsetenv (name); - return 0; -#else - char *env; - - env = cob_fast_malloc (strlen (name) + 2U); - sprintf (env, "%s=", name); - return putenv (env); -#endif -} - -void -cob_display_environment (const cob_field *f) -{ - size_t i; - - if (cob_local_env_size < f->size) { - cob_local_env_size = f->size; - if (cob_local_env) { - cob_free (cob_local_env); - } - cob_local_env = cob_malloc (cob_local_env_size + 1U); - } - cob_field_to_string (f, cob_local_env, cob_local_env_size); - if (unlikely (cobsetptr->cob_env_mangle)) { - for (i = 0; i < strlen (cob_local_env); ++i) { - if (!isalnum ((int)cob_local_env[i])) { - cob_local_env[i] = '_'; - } - } - } -} - -void -cob_display_env_value (const cob_field *f) -{ - char *env2; - int ret; - - if (!cob_local_env) { - cob_set_exception (COB_EC_IMP_DISPLAY); - return; - } - if (!*cob_local_env) { - cob_set_exception (COB_EC_IMP_DISPLAY); - return; - } - env2 = cob_malloc (f->size + 1U); - cob_field_to_string (f, env2, f->size); - ret = cob_setenv (cob_local_env, env2, 1); - cob_free (env2); - if (ret != 0) { - cob_set_exception (COB_EC_IMP_DISPLAY); - return; - } - /* Rescan term/screen variables */ - cob_rescan_env_vals (); -} - -void -cob_set_environment (const cob_field *f1, const cob_field *f2) -{ - cob_display_environment (f1); - cob_display_env_value (f2); -} - -void -cob_get_environment (const cob_field *envname, cob_field *envval) -{ - const char *p; - char *buff; - size_t size; - - if (envname->size == 0 || envval->size == 0) { - cob_set_exception (COB_EC_IMP_ACCEPT); - return; - } - - buff = cob_malloc (envname->size + 1U); - cob_field_to_string (envname, buff, envname->size); - if (unlikely (cobsetptr->cob_env_mangle)) { - for (size = 0; size < strlen (buff); ++size) { - if (!isalnum ((int)buff[size])) { - buff[size] = '_'; - } - } - } - p = getenv (buff); - if (!p) { - cob_set_exception (COB_EC_IMP_ACCEPT); - p = " "; - } - cob_memcpy (envval, p, strlen (p)); - cob_free (buff); -} - -void -cob_accept_environment (cob_field *f) -{ - const char *p = NULL; - - if (cob_local_env) { - p = getenv (cob_local_env); - } - if (!p) { - cob_set_exception (COB_EC_IMP_ACCEPT); - p = " "; - } - cob_memcpy (f, p, strlen (p)); -} - -void -cob_chain_setup (void *data, const size_t parm, const size_t size) -{ - size_t len; - - /* only set if given on command-line, otherwise use normal - program internal initialization */ - if (parm <= (size_t)cob_argc - 1) { - memset (data, ' ', size); - len = strlen (cob_argv[parm]); - if (len <= size) { - memcpy (data, cob_argv[parm], len); - } else { - memcpy (data, cob_argv[parm], size); - } - } -} - -void -cob_continue_after (cob_field *decimal_seconds) -{ - cob_s64_t nanoseconds = get_sleep_nanoseconds_from_seconds (decimal_seconds); - - if (nanoseconds < 0) { - /* TODO: current COBOL 20xx change proposal - specifies EC-CONTINUE-LESS-THAN-ZERO (NF) here... */ - return; - } - internal_nanosleep (nanoseconds, 0); -} - -void -cob_allocate (unsigned char **dataptr, cob_field *retptr, - cob_field *sizefld, cob_field *initialize) -{ - void *mptr; - struct cob_alloc_cache *cache_ptr; - int fsize; - cob_field temp; - - /* ALLOCATE */ - cobglobptr->cob_exception_code = 0; - mptr = NULL; - fsize = cob_get_int (sizefld); - /* FIXME: doesn't work correctly if fsize is > INT_MAX */ - if (fsize > COB_MAX_ALLOC_SIZE) { - cob_set_exception (COB_EC_STORAGE_IMP); - } else if (fsize > 0) { - cache_ptr = cob_malloc (sizeof (struct cob_alloc_cache)); - mptr = malloc ((size_t)fsize); - if (!mptr) { - cob_set_exception (COB_EC_STORAGE_NOT_AVAIL); - cob_free (cache_ptr); - } else { - if (initialize) { - temp.size = (size_t)fsize; - temp.data = mptr; - temp.attr = &const_alpha_attr; - cob_move (initialize, &temp); - } else { - memset (mptr, 0, (size_t)fsize); - } - cache_ptr->cob_pointer = mptr; - cache_ptr->size = (size_t)fsize; - cache_ptr->next = cob_alloc_base; - cob_alloc_base = cache_ptr; - } - } - if (dataptr) { - *dataptr = mptr; - } - if (retptr) { - *(void **)(retptr->data) = mptr; - } -} - -void -cob_free_alloc (unsigned char **ptr1, unsigned char *ptr2) -{ - struct cob_alloc_cache *cache_ptr; - struct cob_alloc_cache *prev_ptr; - void *vptr1; - - /* FREE */ - cobglobptr->cob_exception_code = 0; - cache_ptr = cob_alloc_base; - prev_ptr = cob_alloc_base; - if (ptr1 && *ptr1) { - vptr1 = *ptr1; - for (; cache_ptr; cache_ptr = cache_ptr->next) { - if (vptr1 == cache_ptr->cob_pointer) { - cob_free (cache_ptr->cob_pointer); - if (cache_ptr == cob_alloc_base) { - cob_alloc_base = cache_ptr->next; - } else { - prev_ptr->next = cache_ptr->next; - } - cob_free (cache_ptr); - *ptr1 = NULL; - return; - } - prev_ptr = cache_ptr; - } - cob_set_exception (COB_EC_STORAGE_NOT_ALLOC); - return; - } - if (ptr2 && *(void **)ptr2) { - for (; cache_ptr; cache_ptr = cache_ptr->next) { - if (*(void **)ptr2 == cache_ptr->cob_pointer) { - cob_free (cache_ptr->cob_pointer); - if (cache_ptr == cob_alloc_base) { - cob_alloc_base = cache_ptr->next; - } else { - prev_ptr->next = cache_ptr->next; - } - cob_free (cache_ptr); - *(void **)ptr2 = NULL; - return; - } - prev_ptr = cache_ptr; - } - cob_set_exception (COB_EC_STORAGE_NOT_ALLOC); - return; - } -} - -char * -cob_getenv (const char *name) -{ - char *p; - - if (name) { - p = getenv (name); - if (p) { - return cob_strdup (p); - } - } - return NULL; -} - -int -cob_putenv (char *name) -{ - int ret; - - if (name && strchr (name, '=')) { - ret = putenv (cob_strdup (name)); - if (!ret) { - cob_rescan_env_vals (); - } - return ret; - } - return -1; -} -#if 0 /* debug only */ -void print_stat (const char *filename, struct stat sb) -{ - printf("File name: "); - if (filename) { - printf ("%s\n", filename); - } else { - printf("- unknown -\n"); - } - printf("File type: "); - - switch (sb.st_mode & S_IFMT) { -#ifdef S_IFBLK - case S_IFBLK: printf("block device\n"); break; -#endif -#ifdef S_IFCHR - case S_IFCHR: printf("character device\n"); break; -#endif - case S_IFDIR: printf("directory\n"); break; -#ifdef S_IFIFO - case S_IFIFO: printf("FIFO/pipe\n"); break; -#endif -#ifdef S_IFLNK - case S_IFLNK: printf("symlink\n"); break; -#endif - case S_IFREG: printf("regular file\n"); break; -#ifdef S_IFSOCK - case S_IFSOCK: printf("socket\n"); break; -#endif - default: printf("unknown?\n"); break; - } - - printf("I-node number: %ld\n", (long)sb.st_ino); - - printf("Mode: %lo (octal)\n", - (unsigned long)sb.st_mode); - - printf("Link count: %ld\n", (long)sb.st_nlink); - printf("Ownership: UID=%ld GID=%ld\n", - (long)sb.st_uid, (long)sb.st_gid); - printf("File size: %lld bytes\n", - (long long)sb.st_size); -#if 0 - printf("Preferred I/O block size: %ld bytes\n", - (long)sb.st_blksize); - printf("Blocks allocated: %lld\n", - (long long)sb.st_blocks); -#endif - - printf("Last status change: %s", ctime(&sb.st_ctime)); - printf("Last file access: %s", ctime(&sb.st_atime)); - printf("Last file modification: %s", ctime(&sb.st_mtime)); -} -#endif - -static COB_INLINE int -check_valid_dir (const char *dir) -{ - struct stat sb; - if (strlen (dir) > COB_NORMAL_MAX) return 1; - if (stat (dir, &sb) || !(S_ISDIR (sb.st_mode))) return 1; - -#if 0 - print_stat (dir, sb); -#endif - - return 0; -} - -static const char * -check_valid_env_tmpdir (const char *envname) -{ - const char *dir; - - dir = getenv (envname); - if (!dir || !dir[0]) { - return NULL; - } - if (check_valid_dir (dir)) { - cob_runtime_warning ("Temporary directory %s is invalid, adjust TMPDIR!", envname); - (void)cob_unsetenv (envname); - return NULL; - } - return dir; -} - -static const char * -cob_gettmpdir (void) -{ - const char *tmpdir; - char *tmp; - - if ((tmpdir = check_valid_env_tmpdir ("TMPDIR")) == NULL) { - tmp = NULL; -#ifdef _WIN32 - if ((tmpdir = check_valid_env_tmpdir ("TEMP")) == NULL - && (tmpdir = check_valid_env_tmpdir ("TMP")) == NULL - && (tmpdir = check_valid_env_tmpdir ("USERPROFILE")) == NULL) { -#else - if ((tmpdir = check_valid_env_tmpdir ("TMP")) == NULL - && (tmpdir = check_valid_env_tmpdir ("TEMP")) == NULL) { - if (!check_valid_dir ("/tmp")) { - tmp = cob_fast_malloc (5U); - strcpy (tmp, "/tmp"); - tmpdir = tmp; - } - } - if (!tmpdir) { -#endif - tmp = cob_fast_malloc (2U); - tmp[0] = '.'; - tmp[1] = 0; - tmpdir = tmp; - } - (void)cob_setenv ("TMPDIR", tmpdir, 1); - if (tmp) { - cob_free ((void *)tmp); - tmpdir = getenv ("TMPDIR"); - } - } - return tmpdir; -} - -/* Set temporary file name */ -void -cob_temp_name (char *filename, const char *ext) -{ - int pid = cob_sys_getpid (); -#ifndef HAVE_8DOT3_FILENAMES -#define TEMP_EXT_SCHEMA "%s%ccob%d_%d%s" -#define TEMP_SORT_SCHEMA "%s%ccobsort%d_%d" -#else -/* 8.3 allows only short names... */ -#define TEMP_EXT_SCHEMA "%s%cc%d_%d%s" -#define TEMP_SORT_SCHEMA "%s%cs%d_%d" - pid = pid % 9999; -#endif - if (ext) { - snprintf (filename, (size_t)COB_FILE_MAX, TEMP_EXT_SCHEMA, - cob_gettmpdir (), SLASH_CHAR, pid, cob_temp_iteration, ext); - } else { - snprintf (filename, (size_t)COB_FILE_MAX, TEMP_SORT_SCHEMA, - cob_gettmpdir (), SLASH_CHAR, pid, cob_temp_iteration); - } -#undef TEMP_EXT_SCHEMA -#undef TEMP_SORT_SCHEMA -} - -void -cob_incr_temp_iteration (void) -{ - cob_temp_iteration++; -} - -int -cob_extern_init (void) -{ - /* can be called multiple times (MF docs say: should be done in all threads) */ - if (!cob_initialized) { - cob_init (0, NULL); - } - return 0; -} - -char * -cob_command_line (int flags, int *pargc, char ***pargv, - char ***penvp, char **pname) -{ -#if 0 /* RXWRXW cob_command_line */ - char **spenvp; - char *spname; -#else - COB_UNUSED (penvp); - COB_UNUSED (pname); -#endif - - COB_UNUSED (flags); - - if (!cob_initialized) { - cob_fatal_error (COB_FERROR_INITIALIZED); - } - if (pargc && pargv) { - cob_argc = *pargc; - cob_argv = *pargv; - } - -#if 0 /* RXWRXW cob_command_line */ - if (penvp) { - spenvp = *penvp; - } - if (pname) { - spname = *pname; - } -#endif - - /* What are we supposed to return here? */ - return NULL; -} - -int -cob_tidy (void) -{ - struct exit_handlerlist *h; - - if (!cob_initialized) { - return 1; - } - if (exit_hdlrs != NULL) { - h = exit_hdlrs; - while (h != NULL) { - h->proc (); - h = h->next; - } - } - cob_terminate_routines (); - return 0; -} - -/* System routines */ - -int -cob_sys_exit_proc (const void *dispo, const void *pptr) -{ - struct exit_handlerlist *hp; - struct exit_handlerlist *h; - const unsigned char *x; - int (**p)(void); - - COB_CHK_PARMS (CBL_EXIT_PROC, 2); - - memcpy (&p, &pptr, sizeof (void *)); - if (!p || !*p) { - return -1; - } - - hp = NULL; - h = exit_hdlrs; - /* Remove handler anyway */ - while (h != NULL) { - if (h->proc == *p) { - if (hp != NULL) { - hp->next = h->next; - } else { - exit_hdlrs = h->next; - } - if (hp) { - cob_free (hp); - } - break; - } - hp = h; - h = h->next; - } - x = dispo; - if (*x != 0 && *x != 2 && *x != 3) { - /* Remove handler */ - return 0; - } - h = cob_malloc (sizeof (struct exit_handlerlist)); - h->next = exit_hdlrs; - h->proc = *p; - exit_hdlrs = h; - return 0; -} - -int -cob_sys_error_proc (const void *dispo, const void *pptr) -{ - struct handlerlist *hp; - struct handlerlist *h; - const unsigned char *x; - int (**p) (char *s); - - COB_CHK_PARMS (CBL_ERROR_PROC, 2); - - memcpy (&p, &pptr, sizeof (void *)); - if (!p || !*p) { - return -1; - } - - hp = NULL; - h = hdlrs; - /* Remove handler anyway */ - while (h != NULL) { - if (h->proc == *p) { - if (hp != NULL) { - hp->next = h->next; - } else { - hdlrs = h->next; - } - if (hp) { - cob_free (hp); - } - break; - } - hp = h; - h = h->next; - } - x = dispo; - if (*x != 0) { - /* Remove handler */ - return 0; - } - h = cob_malloc (sizeof (struct handlerlist)); - h->next = hdlrs; - h->proc = *p; - hdlrs = h; - return 0; -} - -int -cob_sys_system (const void *cmdline) -{ - char *buff; - int i; - - COB_CHK_PARMS (SYSTEM, 1); - - if (COB_MODULE_PTR->cob_procedure_params[0]) { - const char *cmd = cmdline; - i = (int)COB_MODULE_PTR->cob_procedure_params[0]->size; - /* LCOV_EXCL_START */ - if (unlikely (i > COB_MEDIUM_MAX)) { - cob_runtime_error (_("parameter to SYSTEM call is larger than %d characters"), COB_MEDIUM_MAX); - cob_stop_run (1); - } - /* LCOV_EXCL_STOP */ - i--; - for (; i >= 0; --i) { - if (cmd[i] != ' ' && cmd[i] != 0) { - break; - } - } - if (i >= 0) { -#ifdef _WIN32 - /* All known _WIN32 implementations use MSVCRT's system() - which passes the given commandline as paramter to "cmd /k". - Because "of compatibility" this checks if you have a - leading and trailing " and if yes simply removes them (!). - Check if this is the case and if it is handled already - by an *extra* pair of quotes, otherwise add these... - */ - if (i > 2 && cmd[0] == '"' && cmd[i] == '"' - && (cmd[1] != '"' || cmd[i - 1] != '"')) { - buff = cob_malloc ((size_t)i + 4); - buff[0] = '"'; - memcpy (buff + 1, cmd, (size_t)i + 1); - buff[i + 1] = '"'; - } else { -#endif /* _WIN32 */ - buff = cob_malloc ((size_t)i + 2); - memcpy (buff, cmd, (size_t)i + 1); -#ifdef _WIN32 - } -#endif - if (cobglobptr->cob_screen_initialized) { - cob_screen_set_mode (0); - } - /* note: if the command cannot be executed _WIN32 always returns 1 - while GNU/Linux returns -1 */ - i = system (buff); - cob_free (buff); - if (cobglobptr->cob_screen_initialized) { - cob_screen_set_mode (1U); - } - return i; - } - } - return 1; -} - -/** -* Return some hosted C variables, argc, argv, stdin, stdout, stderr. -*/ -int -cob_sys_hosted (void *p, const void *var) -{ - const char *name = var; - cob_u8_ptr data = p; - size_t i; - - COB_CHK_PARMS (CBL_GC_HOSTED, 2); - - if (!data) { - return 1; - } - - if (COB_MODULE_PTR->cob_procedure_params[1]) { - i = (int)COB_MODULE_PTR->cob_procedure_params[1]->size; - if ((i == 4) && !strncmp (name, "argc", 4)) { - *((int *)data) = cob_argc; - return 0; - } - if ((i == 4) && !strncmp (name, "argv", 4)) { - *((char ***)data) = cob_argv; - return 0; - } - if ((i == 5) && !strncmp (name, "stdin", 5)) { - *((FILE **)data) = stdin; - return 0; - } - if ((i == 6) && !strncmp (name, "stdout", 6)) { - *((FILE **)data) = stdout; - return 0; - } - if ((i == 6) && !strncmp (name, "stderr", 6)) { - *((FILE **)data) = stderr; - return 0; - } - if ((i == 5) && !strncmp (name, "errno", 5)) { - *((int **)data) = &errno; - return 0; - } -#if defined (HAVE_TIMEZONE) - if ((i == 6) && !strncmp (name, "tzname", 6)) { - /* Recheck: bcc raises "suspicious pointer conversion */ - *((char ***)data) = tzname; - return 0; - } - if ((i == 8) && !strncmp (name, "timezone", 8)) { - *((long *)data) = timezone; - return 0; - } - if ((i == 8) && !strncmp (name, "daylight", 8)) { - *((int *)data) = daylight; - return 0; - } -#endif /* HAVE_TIMEZONE */ - } - return 1; -} - -int -cob_sys_and (const void *p1, void *p2, const int length) -{ - const cob_u8_ptr data_1; - cob_u8_ptr data_2; - size_t n; - - COB_UNUSED (p1); - COB_UNUSED (p2); - COB_CHK_PARMS (CBL_AND, 3); - data_1 = cob_get_param_data (1); - data_2 = cob_get_param_data (2); - - if (length <= 0 - || data_1 == NULL - || data_2 == NULL) { - return 0; - } - for (n = 0; n < (size_t)length; ++n) { - data_2[n] &= data_1[n]; - } - return 0; -} - -int -cob_sys_or (const void *p1, void *p2, const int length) -{ - const cob_u8_ptr data_1; - cob_u8_ptr data_2; - size_t n; - - COB_UNUSED (p1); - COB_UNUSED (p2); - COB_CHK_PARMS (CBL_OR, 3); - data_1 = cob_get_param_data (1); - data_2 = cob_get_param_data (2); - - if (length <= 0 - || data_1 == NULL - || data_2 == NULL) { - return 0; - } - for (n = 0; n < (size_t)length; ++n) { - data_2[n] |= data_1[n]; - } - return 0; -} - -int -cob_sys_nor (const void *p1, void *p2, const int length) -{ - const cob_u8_ptr data_1; - cob_u8_ptr data_2; - size_t n; - - COB_UNUSED (p1); - COB_UNUSED (p2); - COB_CHK_PARMS (CBL_NOR, 3); - - data_1 = cob_get_param_data (1); - data_2 = cob_get_param_data (2); - - if (length <= 0 - || data_1 == NULL - || data_2 == NULL) { - return 0; - } - for (n = 0; n < (size_t)length; ++n) { - data_2[n] = ~(data_1[n] | data_2[n]); - } - return 0; -} - -int -cob_sys_xor (const void *p1, void *p2, const int length) -{ - const cob_u8_ptr data_1; - cob_u8_ptr data_2; - size_t n; - - COB_UNUSED (p1); - COB_UNUSED (p2); - COB_CHK_PARMS (CBL_XOR, 3); - data_1 = cob_get_param_data (1); - data_2 = cob_get_param_data (2); - - if (length <= 0 - || data_1 == NULL - || data_2 == NULL) { - return 0; - } - for (n = 0; n < (size_t)length; ++n) { - data_2[n] ^= data_1[n]; - } - return 0; -} - -/* COBOL routine to perform for logical IMPLIES between the bits in two fields, - storing the result in the second field */ -int -cob_sys_imp (const void *p1, void *p2, const int length) -{ - const cob_u8_ptr data_1; - cob_u8_ptr data_2; - size_t n; - - COB_UNUSED (p1); - COB_UNUSED (p2); - COB_CHK_PARMS (CBL_IMP, 3); - - data_1 = cob_get_param_data (1); - data_2 = cob_get_param_data (2); - - if (length <= 0 - || data_1 == NULL - || data_2 == NULL) { - return 0; - } - for (n = 0; n < (size_t)length; ++n) { - data_2[n] = (~data_1[n]) | data_2[n]; - } - return 0; -} - - -/* COBOL routine to perform for logical NOT IMPLIES between the bits in two fields, - storing the result in the second field */ -int -cob_sys_nimp (const void *p1, void *p2, const int length) -{ - const cob_u8_ptr data_1; - cob_u8_ptr data_2; - size_t n; - - COB_UNUSED (p1); - COB_UNUSED (p2); - COB_CHK_PARMS (CBL_NIMP, 3); - - data_1 = cob_get_param_data (1); - data_2 = cob_get_param_data (2); - - if (length <= 0 - || data_1 == NULL - || data_2 == NULL) { - return 0; - } - for (n = 0; n < (size_t)length; ++n) { - data_2[n] = data_1[n] & (~data_2[n]); - } - return 0; -} - -/* COBOL routine to check for logical EQUIVALENCE between the bits in two fields, - storing the result in the second field */ -int -cob_sys_eq (const void *p1, void *p2, const int length) -{ - const cob_u8_ptr data_1; - cob_u8_ptr data_2; - size_t n; - - COB_UNUSED (p1); - COB_UNUSED (p2); - COB_CHK_PARMS (CBL_EQ, 3); - - data_1 = cob_get_param_data (1); - data_2 = cob_get_param_data (2); - - if (length <= 0 - || data_1 == NULL - || data_2 == NULL) { - return 0; - } - for (n = 0; n < (size_t)length; ++n) { - data_2[n] = ~(data_1[n] ^ data_2[n]); - } - return 0; -} - -/* COBOL routine to perform a logical NOT on the bits of a field */ -int -cob_sys_not (void *p1, const int length) -{ - cob_u8_ptr data_1; - size_t n; - - COB_UNUSED (p1); - COB_CHK_PARMS (CBL_NOT, 2); - - data_1 = cob_get_param_data (1); - - if (length <= 0 - || data_1 == NULL) { - return 0; - } - for (n = 0; n < (size_t)length; ++n) { - data_1[n] = ~data_1[n]; - } - return 0; -} - -/* COBOL routine to pack the least significant bits in eight bytes into a single byte */ -int -cob_sys_xf4 (void *p1, const void *p2) -{ - cob_u8_ptr data_1; - const cob_u8_ptr data_2; - size_t n; - - COB_UNUSED (p1); - COB_UNUSED (p2); - COB_CHK_PARMS (CBL_XF4, 2); - - data_1 = cob_get_param_data (1); - data_2 = cob_get_param_data (2); - - if (data_1 == NULL - || data_2 == NULL) { - return 0; - } - *data_1 = 0; - for (n = 0; n < 8; ++n) { - *data_1 |= (data_2[n] & 1) << (7 - n); - } - return 0; -} - -/* COBOL routine to unpack the bits in a byte into eight bytes */ -int -cob_sys_xf5 (const void *p1, void *p2) -{ - const cob_u8_ptr data_1; - cob_u8_ptr data_2; - size_t n; - - COB_UNUSED (p1); - COB_UNUSED (p2); - COB_CHK_PARMS (CBL_XF5, 2); - - data_1 = cob_get_param_data (1); - data_2 = cob_get_param_data (2); - - if (data_1 == NULL - || data_2 == NULL) { - return 0; - } - for (n = 0; n < 8; ++n) { - data_2[n] = (*data_1 & (1 << (7 - n))) ? 1 : 0; - } - return 0; -} - -/* COBOL routine for different functions, including functions for - the programmable COBOL SWITCHES: - 11: set COBOL switches 0-7 - 12: read COBOL switches 0-7 - 16: return number of CALL USING parameters -*/ -int -cob_sys_x91 (void *p1, const void *p2, void *p3) -{ - cob_u8_ptr result = p1; - const cob_u8_ptr func = p2; - cob_u8_ptr parm = p3; - unsigned char *p; - size_t i; - - switch (*func) { - - /* Set switches (0-7) */ - case 11: - p = parm; - for (i = 0; i < 8; ++i, ++p) { - if (*p == 0) { - cob_switch[i] = 0; - } else if (*p == 1) { - cob_switch[i] = 1; - } - } - /* INSPECT: MF additionally sets the ANSI DEBUG module switch */ - *result = 0; - break; - - /* Get switches (0-7) */ - case 12: - p = parm; - for (i = 0; i < 8; ++i, ++p) { - *p = (unsigned char)cob_switch[i]; - } - /* INSPECT: MF additionally reads the ANSI DEBUG module switch */ - *result = 0; - break; - - /* Return number of call parameters - according to the docs this is only set for programs CALLed from COBOL - NOT for main programs in contrast to C$NARG (cob_sys_return_args) - */ - case 16: - *parm = (unsigned char)COB_MODULE_PTR->module_num_params; - *result = 0; - break; - - /* unimplemented function, - note: 46-49 may be implemented after fileio-specific merge of rw-branch - 35 (EXEC) and 15 (program lookup) may be implemented as soon as some legacy code - shows its exact use and a test case */ - default: - *result = 1; - break; - } - return 0; -} - -int -cob_sys_toupper (void *p1, const int length) -{ - cob_u8_ptr data; - size_t n; - - COB_CHK_PARMS (CBL_TOUPPER, 2); - COB_UNUSED (p1); - data = cob_get_param_data (1); - - if (length > 0) { - for (n = 0; n < (size_t)length; ++n) { - if (islower (data[n])) { - data[n] = (cob_u8_t)toupper (data[n]); - } - } - } - return 0; -} - -int -cob_sys_tolower (void *p1, const int length) -{ - cob_u8_ptr data; - size_t n; - - COB_CHK_PARMS (CBL_TOLOWER, 2); - COB_UNUSED (p1); - data = cob_get_param_data (1); - - if (length > 0) { - for (n = 0; n < (size_t)length; ++n) { - if (isupper (data[n])) { - data[n] = (cob_u8_t)tolower (data[n]); - } - } - } - return 0; -} - -/* maximum sleep time in seconds, currently 7 days */ -#define MAX_SLEEP_TIME 3600*24*7 -#define NANOSECONDS_PER_MILISECOND 1000000 - -static cob_s64_t -get_sleep_nanoseconds (cob_field *nano_seconds) { - - cob_s64_t nanoseconds = cob_get_llint (nano_seconds); - - if (nanoseconds < 0) { - return -1; - } - if (nanoseconds >= ((cob_s64_t)MAX_SLEEP_TIME * 1000000000)) { - return (cob_s64_t)MAX_SLEEP_TIME * 1000000000; - } else {; - return nanoseconds; - } -} - -static cob_s64_t -get_sleep_nanoseconds_from_seconds (cob_field *decimal_seconds) { - -#define MAX_SLEEP_TIME 3600*24*7 - cob_s64_t seconds = cob_get_llint (decimal_seconds); - - if (seconds < 0) { - return -1; - } - if (seconds >= MAX_SLEEP_TIME) { - return (cob_s64_t)MAX_SLEEP_TIME * 1000000000; -} else { - cob_s64_t nanoseconds; - cob_field temp; - temp.size = 8; - temp.data = (unsigned char *)&nanoseconds; - temp.attr = &const_bin_nano_attr; - cob_move (decimal_seconds, &temp); - return nanoseconds; - } -} - -static void -internal_nanosleep (cob_s64_t nsecs, int round_to_minmal) -{ - if (nsecs > 0) { -#if defined (HAVE_NANO_SLEEP) - struct timespec tsec; - tsec.tv_sec = nsecs / 1000000000; - tsec.tv_nsec = nsecs % 1000000000; - nanosleep (&tsec, NULL); -#elif defined (HAVE_USLEEP) - /* possibly adding usleep() here, currently configure.ac does not check for it as: - * check needed in configure.ac - * little bit ugly because of EINVAL check - * obsolete in POSIX.1-2001, POSIX.1-2008 removed its specification - --> only do if we find a system that does not support nanosleep() but usleep() - in any case the existing code here can be triggered by specifying passing - -DHAVE_USLEEP via CPPFLAGS */ - unsigned int micsecs = (unsigned int)(nsecs / 1000); - /* prevent EINVAL */ - if (micsecs < 1000000) { - if (micsecs == 0 && round_to_minmal) micsecs = 1; - usleep (micsecs); - } else { - unsigned int seconds = (unsigned int)(nsecs * 1000 / NANOSECONDS_PER_MILISECOND); - sleep (seconds); - } -#elif defined (_WIN32) - unsigned int msecs = (unsigned int)(nsecs / NANOSECONDS_PER_MILISECOND); - if (msecs == 0 && round_to_minmal) msecs = 1; - Sleep (msecs); -#else - unsigned int seconds = (unsigned int)(nsecs * 1000 / NANOSECONDS_PER_MILISECOND); - if (seconds == 0 && round_to_minmal) seconds = 1; - sleep (seconds); -#endif - } -} - -/* sleep for given number of milliseconds, rounded up if needed */ -void -cob_sleep_msec (const unsigned int msecs) -{ - if (msecs == 0) return; - internal_nanosleep (((cob_s64_t)msecs) * NANOSECONDS_PER_MILISECOND, 1); -} - -/* CBL_GC_NANOSLEEP / CBL_OC_NANOSLEEP, origin: OpenCOBOL */ -int -cob_sys_oc_nanosleep (const void *data) -{ - COB_UNUSED (data); - COB_CHK_PARMS (CBL_GC_NANOSLEEP, 1); - - if (COB_MODULE_PTR->cob_procedure_params[0]) { - cob_s64_t nsecs - = get_sleep_nanoseconds (COB_MODULE_PTR->cob_procedure_params[0]); - if (nsecs > 0) { - internal_nanosleep (nsecs, 0); - } - return 0; - } - return -1; -} - -/* C$SLEEP, origin: ACUCOBOL */ -int -cob_sys_sleep (const void *data) -{ - COB_UNUSED (data); - COB_CHK_PARMS (C$SLEEP, 1); - - if (COB_MODULE_PTR->cob_procedure_params[0]) { - cob_s64_t nanoseconds - = get_sleep_nanoseconds_from_seconds (COB_MODULE_PTR->cob_procedure_params[0]); - if (nanoseconds < 0) { - /* ACUCOBOL specifies a runtime error here... */ - return -1; - } - internal_nanosleep (nanoseconds, 0); - return 0; - } - return 0; /* CHECKME */ -} - -int -cob_sys_getpid (void) -{ - if (!cob_process_id) { - cob_process_id = (int)getpid (); - } - return cob_process_id; -} - -int -cob_sys_fork (void) -{ - /* cygwin does not define _WIN32, but implements [slow] fork() and provides unistd.h - MSYS defines _WIN32, provides unistd.h and not implements fork() - */ -#if defined (HAVE_UNISTD_H) && !(defined (_WIN32)) - int pid; - if ((pid = fork ()) == 0 ) { - cob_process_id = 0; /* reset cached value */ - cob_fork_fileio(cobglobptr, cobsetptr); - return 0; /* child process just returns */ - } - if (pid < 0) { /* Some error happened */ - cob_runtime_warning (_("error '%s' during CBL_GC_FORK"), cob_get_strerror ()); - return -2; - } - return pid; /* parent gets process id of child */ -#else - cob_runtime_warning (_("'%s' is not supported on this platform"), "CBL_GC_FORK"); - return -1; -#endif -} - - -/* wait for a pid to end and return its exit code - error codes are returned as negative value -*/ -int -cob_sys_waitpid (const void *p_id) -{ -#ifdef HAVE_SYS_WAIT_H - int pid, status, wait_sts; - - COB_UNUSED (p_id); - - if (COB_MODULE_PTR->cob_procedure_params[0]) { - pid = cob_get_int (COB_MODULE_PTR->cob_procedure_params[0]); - if (pid == cob_sys_getpid ()) { - status = 0 - EINVAL; - return status; - } - wait_sts = waitpid (pid, &status, 0); - if (wait_sts < 0) { /* Some error happened */ - status = 0 - errno; - cob_runtime_warning (_("error '%s' for P%d during CBL_GC_WAITPID"), - cob_get_strerror (), pid); - return status; - } - status = WEXITSTATUS (status); - } else { - status = 0 - EINVAL; - } - return status; -#elif defined (_WIN32) - int pid, status; - HANDLE process = NULL; - DWORD ret; - - COB_UNUSED (p_id); - - status = 0; - if (COB_MODULE_PTR->cob_procedure_params[0]) { - pid = cob_get_int (COB_MODULE_PTR->cob_procedure_params[0]); - if (pid == cob_sys_getpid ()) { - status = 0 - ERROR_INVALID_DATA; - return status; - } - /* get process handle with least necessary rights - PROCESS_QUERY_LIMITED_INFORMATION is available since OS-version Vista / Server 2008 - and always leads to ERROR_ACCESS_DENIED on older systems - PROCESS_QUERY_INFORMATION needs more rights - SYNCHRONIZE necessary for WaitForSingleObject - */ -#if defined (PROCESS_QUERY_LIMITED_INFORMATION) - process = OpenProcess (SYNCHRONIZE | PROCESS_QUERY_LIMITED_INFORMATION, FALSE, pid); -#if !defined (_MSC_VER) || !COB_USE_VC2012_OR_GREATER /* only try a higher level if we possibly compile on XP/2003 */ - /* TODO: check what happens on WinXP / 2003 as PROCESS_QUERY_LIMITED_INFORMATION isn't available there */ - if (!process && GetLastError () == ERROR_ACCESS_DENIED) { - process = OpenProcess (SYNCHRONIZE | PROCESS_QUERY_INFORMATION, FALSE, pid); - } -#endif -#else - process = OpenProcess (SYNCHRONIZE | PROCESS_QUERY_INFORMATION, FALSE, pid); -#endif - /* if we don't get access to query the process' exit status try to get at least - access to the process end (needed for WaitForSingleObject) - */ - if (!process && GetLastError () == ERROR_ACCESS_DENIED) { - process = OpenProcess (SYNCHRONIZE, FALSE, pid); - status = -2; - } - if (process) { - /* wait until process exit */ - ret = WaitForSingleObject (process, INFINITE); - if (ret == WAIT_FAILED) { - status = 0 - GetLastError (); - /* get exit code, if possible */ - } else if (status != -2) { - if (!GetExitCodeProcess (process, &ret)) { - status = 0 - GetLastError (); - } else { - status = (int) ret; - } - } - CloseHandle (process); - } else { - status = 0 - GetLastError (); - } - } else { - status = 0 - ERROR_INVALID_DATA; - } - return status; -#else - COB_UNUSED (p_id); - - cob_runtime_warning (_("'%s' is not supported on this platform"), "CBL_GC_WAITPID"); - return -1; -#endif -} - -/* set the number of arguments passed to the current program; - works both for main programs and called sub programs - Implemented according to ACUCOBOL-GT -> returns the number of arguments that were passed, - not like in MF implementation the number of arguments that were received */ -int -cob_sys_return_args (void *data) -{ - COB_UNUSED (data); - - COB_CHK_PARMS (C$NARG, 1); - - if (COB_MODULE_PTR->cob_procedure_params[0]) { - cob_set_int (COB_MODULE_PTR->cob_procedure_params[0], - COB_MODULE_PTR->module_num_params); - } - return 0; -} - -int -cob_sys_calledby (void *data) -{ - size_t size; - size_t msize; - - COB_CHK_PARMS (C$CALLEDBY, 1); - - if (!COB_MODULE_PTR->cob_procedure_params[0]) { - /* TO-DO: check what ACU ccbl/runcbl returns, - the documentation doesn't say anything about this */ - return -1; - } - size = COB_MODULE_PTR->cob_procedure_params[0]->size; - memset (data, ' ', size); - if (!COB_MODULE_PTR->next) { - return 0; - } - msize = strlen (COB_MODULE_PTR->next->module_name); - if (msize > size) { - msize = size; - } - memcpy (data, COB_MODULE_PTR->next->module_name, msize); - return 1; -} - -int -cob_sys_parameter_size (void *data) -{ - int n; - - COB_UNUSED (data); - - COB_CHK_PARMS (C$PARAMSIZE, 1); - - if (COB_MODULE_PTR->cob_procedure_params[0]) { - n = cob_get_int (COB_MODULE_PTR->cob_procedure_params[0]); - if (n > 0 && n <= COB_MODULE_PTR->module_num_params) { - n--; - if (COB_MODULE_PTR->next - && COB_MODULE_PTR->next->cob_procedure_params[n]) { - return (int)COB_MODULE_PTR->next->cob_procedure_params[n]->size; - } - } - } - return 0; -} - -int -cob_sys_getopt_long_long (void *so, void *lo, void *idx, const int long_only, void *return_char, void *opt_val) -{ - /* - * cob_argc is a static int containing argc from runtime - * cob_argv is a static char ** containing argv from runtime - */ - - size_t opt_val_size = 0; - size_t so_size = 0; - size_t lo_size = 0; - size_t optlen; - - unsigned int lo_amount; - int exit_status; - - char * shortoptions; - char * temp; - - struct option *longoptions, *longoptions_root; - longoption_def *l = NULL; - - int longind = 0; - unsigned int i; - int j; - - int return_value; - - COB_UNUSED (idx); - COB_UNUSED (lo); - COB_UNUSED (so); - - COB_CHK_PARMS (CBL_GC_GETOPT, 6); - - /* Read in sizes of some parameters */ - if (COB_MODULE_PTR->cob_procedure_params[1]) { - lo_size = COB_MODULE_PTR->cob_procedure_params[1]->size; - } - if (COB_MODULE_PTR->cob_procedure_params[0]) { - so_size = COB_MODULE_PTR->cob_procedure_params[0]->size; - } - if (COB_MODULE_PTR->cob_procedure_params[5]) { - opt_val_size = COB_MODULE_PTR->cob_procedure_params[5]->size; - } - - /* buffering longoptions (COBOL), target format (struct option) */ - if (lo_size % sizeof (longoption_def) == 0) { - lo_amount = (int)lo_size / sizeof (longoption_def); - longoptions_root = (struct option*) cob_malloc (sizeof (struct option) * ((size_t)lo_amount + 1U)); - } else { - cob_runtime_error (_("Call to CBL_GC_GETOPT with wrong longoption size.")); - cob_stop_run (1); - } - - if (!COB_MODULE_PTR->cob_procedure_params[2]) { - cob_runtime_error (_("Call to CBL_GC_GETOPT with missing longind.")); - cob_stop_run (1); - } - longind = cob_get_int (COB_MODULE_PTR->cob_procedure_params[2]); - - /* add 0-termination to strings */ - shortoptions = cob_malloc (so_size + 1U); - if (COB_MODULE_PTR->cob_procedure_params[0]) { - cob_field_to_string (COB_MODULE_PTR->cob_procedure_params[0], shortoptions, so_size); - } - - if (COB_MODULE_PTR->cob_procedure_params[1]) { - l = (struct __longoption_def*) (COB_MODULE_PTR->cob_procedure_params[1]->data); - } - - longoptions = longoptions_root; - for (i = 0; i < lo_amount; i++) { - j = sizeof (l->name) - 1; - while (j >= 0 && l->name[j] == 0x20) { - l->name[j] = 0x00; - j--; - } - longoptions->name = l->name; - longoptions->has_arg = (int) l->has_option - '0'; - memcpy (&longoptions->flag, l->return_value_pointer, sizeof (l->return_value_pointer)); - memcpy (&longoptions->val, &l->return_value, 4); - - l = l + 1; /* +1 means pointer + 1*sizeof (longoption_def) */ - longoptions = longoptions + 1; - } - - /* appending final record, so getopt can spot the end of longoptions */ - longoptions->name = NULL; - longoptions->has_arg = 0; - longoptions->flag = NULL; - longoptions->val = 0; - - - l -= lo_amount; /* Set pointer back to begin of longoptions */ - longoptions -= lo_amount; - - return_value = cob_getopt_long_long (cob_argc, cob_argv, shortoptions, longoptions, &longind, long_only); - temp = (char *) &return_value; - - /* Write data back to COBOL */ -#ifdef WORDS_BIGENDIAN - if (temp[3] == '?' - || temp[3] == ':' - || temp[3] == 'W' - || temp[3] == 0) { - exit_status = temp[3] & 0xFF; - } else if (return_value == -1) { - exit_status = -1; - } else { - exit_status = 3; - } - /* cob_getopt_long_long sometimes returns and 'int' value and sometimes a 'x ' in the int */ - if (temp[0] == 0 - && temp[1] == 0 - && temp[2] == 0) { - /* Move option value to 1st byte and SPACE fill the 'int' */ - temp[0] = temp[3]; - temp[1] = temp[2] = temp[3] = ' '; - } -#else - if (temp[0] == '?' - || temp[0] == ':' - || temp[0] == 'W' - || temp[0] == -1 - || temp[0] == 0) { - exit_status = return_value; - } else { - exit_status = 3; - } - - for (i = 3; i > 0; i--) { - if (temp[i] == 0) temp[i] = ' '; - else break; - } -#endif - - cob_set_int (COB_MODULE_PTR->cob_procedure_params[2], longind); - memcpy (return_char, &return_value, 4); - - if (cob_optarg != NULL) { - memset (opt_val, 0, opt_val_size); - - optlen = strlen (cob_optarg); - if (optlen > opt_val_size) { - /* Return code 2 for "Option value too long => cut" */ - optlen = opt_val_size; - exit_status = 2; - } - memcpy (opt_val, cob_optarg, optlen); - } - - cob_free (shortoptions); - cob_free (longoptions_root); - - return exit_status; -} - -int -cob_sys_printable (void *p1, ...) -{ - cob_u8_ptr data; - unsigned char *dotptr; - int datalen; - size_t n; - unsigned char dotrep; - - COB_CHK_PARMS (CBL_GC_PRINTABLE, 1); - COB_UNUSED (p1); - - if (!COB_MODULE_PTR->cob_procedure_params[0]) { - return 0; - } - data = cob_get_param_data (1); - datalen = cob_get_param_size (1); - if (datalen <= 0) - return 0; - if (cob_get_num_params () > 1) { - dotptr = cob_get_param_data (2); - dotrep = *dotptr; - } else { - dotrep = (unsigned char)'.'; - } - for (n = 0; n < datalen; ++n) { - if (!isprint (data[n])) { - data[n] = dotrep; - } - } - return 0; -} - -int -cob_sys_justify (void *p1, ...) -{ - cob_u8_ptr data; - unsigned char *direction; - size_t datalen; - size_t left; - size_t right; - size_t movelen; - size_t centrelen; - size_t n; - size_t shifting; - - COB_CHK_PARMS (C$JUSTIFY, 1); - COB_UNUSED (p1); - - if (!COB_MODULE_PTR->cob_procedure_params[0]) { - return 0; - } - data = cob_get_param_data (1); - datalen = (size_t)cob_get_param_size (1); - if ((int)datalen < 2) { - return 0; - } - if (data[0] != ' ' && data[datalen - 1] != ' ') { - return 0; - } - for (left = 0; left < datalen; ++left) { - if (data[left] != ' ') { - break; - } - } - if (left == (size_t)datalen) { - return 0; - } - right = 0; - for (n = datalen - 1; ; --n, ++right) { - if (data[n] != ' ') { - break; - } - if (n == 0) { - break; - } - } - movelen = datalen - left - right; - shifting = 0; - if (cob_get_num_params () > 1) { - direction = cob_get_param_data (2); - if (*direction == 'L') { - shifting = 1; - } else if (*direction == 'C') { - shifting = 2; - } - } - switch (shifting) { - case 1: - memmove (data, &data[left], movelen); - memset (&data[movelen], ' ', datalen - movelen); - break; - case 2: - centrelen = (left + right) / 2; - memmove (&data[centrelen], &data[left], movelen); - memset (data, ' ', centrelen); - if ((left + right) % 2) { - memset (&data[centrelen + movelen], ' ', centrelen + 1); - } else { - memset (&data[centrelen + movelen], ' ', centrelen); - } - break; - default: - memmove (&data[left + right], &data[left], movelen); - memset (data, ' ', datalen - movelen); - break; - } - return 0; -} - -void -cob_set_locale (cob_field *locale, const int category) -{ -#ifdef HAVE_SETLOCALE - char *p; - char *buff; - - p = NULL; - if (locale) { - if (locale->size == 0) { - return; - } - buff = cob_malloc (locale->size + 1U); - cob_field_to_string (locale, buff, locale->size); - } else { - buff = NULL; - } - - switch (category) { - case COB_LC_COLLATE: - p = setlocale (LC_COLLATE, buff); - break; - case COB_LC_CTYPE: - p = setlocale (LC_CTYPE, buff); - break; -#ifdef LC_MESSAGES - case COB_LC_MESSAGES: - p = setlocale (LC_MESSAGES, buff); - break; -#endif - case COB_LC_MONETARY: - p = setlocale (LC_MONETARY, buff); - break; - case COB_LC_NUMERIC: - p = setlocale (LC_NUMERIC, buff); - break; - case COB_LC_TIME: - p = setlocale (LC_TIME, buff); - break; - case COB_LC_ALL: - p = setlocale (LC_ALL, buff); - break; - case COB_LC_USER: - if (cobglobptr->cob_locale_orig) { - p = setlocale (LC_ALL, cobglobptr->cob_locale_orig); - (void)setlocale (LC_NUMERIC, "C"); - } - break; - case COB_LC_CLASS: - if (cobglobptr->cob_locale_ctype) { - p = setlocale (LC_CTYPE, cobglobptr->cob_locale_ctype); - } - break; - } - if (buff) { - cob_free (buff); - } - if (!p) { - cob_set_exception (COB_EC_LOCALE_MISSING); - return; - } - p = setlocale (LC_ALL, NULL); - if (p) { - if (cobglobptr->cob_locale) { - cob_free (cobglobptr->cob_locale); - } - cobglobptr->cob_locale = cob_strdup (p); - } -#else - cob_set_exception (COB_EC_LOCALE_MISSING); -#endif -} - - -#if 0 /* currently not used */ -char * -cob_int_to_string (int i, char *number) -{ - if (!number) return NULL; - sprintf (number, "%i", i); - return number; -} - -char * -cob_int_to_formatted_bytestring (int i, char *number) -{ - double d; - char *byte_unit; - - if (!number) return NULL; - - byte_unit = (char *) cob_fast_malloc (3); - - if (i > (1024 * 1024)) { - d = i / 1024.0 / 1024.0; - byte_unit = (char *) "MB"; - } else if (i > 1024) { - d = i / 1024.0; - byte_unit = (char *) "kB"; - } else { - d = 0; - byte_unit = (char *) "B"; - } - sprintf (number, "%3.2f %s", d, byte_unit); - return number; -} -#endif - -/* concatenate two strings allocating a new one - and optionally free one of the strings - set str_to_free if the result is assigned to - one of the two original strings -*/ -char * -cob_strcat (char *str1, char *str2, int str_to_free) -{ - size_t l; - char *temp1, *temp2; - - l = strlen (str1) + strlen (str2) + 1; - - /* - * If one of the parameter is the buffer itself, - * we copy the buffer before continuing. - */ - if (str1 == strbuff) { - temp1 = cob_strdup (str1); - } else { - temp1 = str1; - } - if (str2 == strbuff) { - temp2 = cob_strdup (str2); - } else { - temp2 = str2; - } - - if (strbuff) { - cob_free (strbuff); - } - strbuff = (char *) cob_fast_malloc (l); - - sprintf (strbuff, "%s%s", temp1, temp2); - switch (str_to_free) { - case 1: cob_free (temp1); - break; - case 2: cob_free (temp2); - break; - default: break; - } - return strbuff; -} - -char * -cob_strjoin (char **strarray, int size, char *separator) -{ - char *result; - int i; - - if (!strarray || size <= 0 || !separator) return NULL; - - result = cob_strdup (strarray[0]); - for (i = 1; i < size; i++) { - result = cob_strcat (result, separator, 1); - result = cob_strcat (result, strarray[i], 1); - } - - return result; -} - -static void -var_print (const char *msg, const char *val, const char *default_val, - const unsigned int format) -{ -#if 0 /* currently only format 0/1 used */ - switch (format) { - case 0: - printf ("%-*.*s : ", CB_IMSG_SIZE, CB_IMSG_SIZE, msg); - break; - case 1: { - int lablen; - printf (" %s: ", _("env")); - lablen = CB_IMSG_SIZE - 2 - (int)strlen (_("env")) - 2; - printf ("%-*.*s : ", lablen, lablen, msg); - break; - } - case 2: - printf (" %-*.*s : ", CB_IMSG_SIZE, CB_IMSG_SIZE, msg); - break; - case 3: - printf (" %-*.*s : ", CB_IMSG_SIZE, CB_IMSG_SIZE, msg); - break; - default: - printf ("%-*.*s : ", CB_IMSG_SIZE, CB_IMSG_SIZE, msg); - break; - } - - if (!val && (!default_val || default_val[0] == 0)) { - putchar ('\n'); - return; - } else if (format != 0 && val && default_val && - ((format != 2 && val[0] == '0') || strcmp (val, default_val) == 0)) { - char dflt[40]; - snprintf (dflt, 39, " %s", _("(default)")); - val = cob_strcat ((char *) default_val, dflt, 0); - } else if (!val && default_val) { - val = default_val; - } -#else - if (format == 0) { - printf ("%-*.*s : ", CB_IMSG_SIZE, CB_IMSG_SIZE, msg); - } else { - int lablen; - printf (" %s: ", _("env")); - lablen = CB_IMSG_SIZE - 2 - (int)strlen (_("env")) - 2; - printf ("%-*.*s : ", lablen, lablen, msg); - } - - if (!val && (!default_val || default_val[0] == 0)) { - putchar ('\n'); - return; - } else if (format == 1 && val && default_val && - (val[0] == '0' || strcmp (val, default_val) == 0)) { - char dflt[40]; - snprintf (dflt, 39, " %s", _("(default)")); - val = cob_strcat ((char *) default_val, dflt, 0); - } else if (!val && default_val) { - val = default_val; - } -#endif - - if (!val && (!default_val || default_val[0] == 0)) { - putchar ('\n'); - return; - } else if (format != 0 && val && default_val && - ((format != 2 && val[0] == '0') || strcmp (val, default_val) == 0)) { - char dflt[40]; - snprintf (dflt, 39, " %s", _("(default)")); - val = cob_strcat ((char *) default_val, dflt, 0); - } else if (!val && default_val) { - val = default_val; - } - - if (val && strlen (val) <= CB_IVAL_SIZE) { - printf ("%s", val); - putchar ('\n'); - - return; - } - - - { - char *p; - char *token; - size_t n; - - p = cob_strdup (val); - - n = 0; - token = strtok (p, " "); - for (; token; token = strtok (NULL, " ")) { - int toklen = (int)strlen (token) + 1; - if ((n + toklen) > CB_IVAL_SIZE) { - if (n) { - if (format == 2 || format == 3) - printf ("\n %*.*s", CB_IMSG_SIZE + 3, - CB_IMSG_SIZE + 3, " "); - else - printf ("\n%*.*s", CB_IMSG_SIZE + 3, CB_IMSG_SIZE + 3, " "); - } - n = 0; - } - printf ("%s%s", (n ? " " : ""), token); - n += toklen; - } - putchar ('\n'); - cob_free (p); - } - -} - -/* - Expand a string with environment variable in it. - Return malloced string. -*/ -char * -cob_expand_env_string (char *strval) -{ - unsigned int i; - unsigned int j = 0; - unsigned int k = 0; - size_t envlen = 1280; - char *env; - char *str = strval; - char ename[128] = { '\0' }; - char *penv; - - env = cob_malloc (envlen); - for (k = 0; strval[k] != 0; k++) { - /* String almost full?; Expand it */ - if (j >= envlen - 128) { - env = cob_realloc (env, envlen, envlen + 256); - envlen += 256; - } - - /* ${envname:default} */ - if (strval[k] == '$' && strval[k + 1] == '{') { - k += 2; - for (i = 0; strval[k] != '}' - && strval[k] != 0 - && strval[k] != ':'; k++) { - ename[i++] = strval[k]; - } - ename[i++] = 0; - penv = getenv (ename); - if (penv == NULL) { - /* Copy 'default' value */ - if (strval[k] == ':') { - k++; - /* ${name:-default} */ - if (strval[k] == '-') { - k++; - } - while (strval[k] != '}' && strval[k] != 0) { - if (j >= envlen - 50) { - env = cob_realloc (env, envlen, envlen + 128); - envlen += 128; - } - env[j++] = strval[k++]; - } - } else if (strcmp (ename, "COB_CONFIG_DIR") == 0) { - penv = (char *)COB_CONFIG_DIR; - } else if (strcmp (ename, "COB_COPY_DIR") == 0) { - penv = (char *)COB_COPY_DIR; - } else if (strcmp (ename, "COB_SCHEMA_DIR") == 0) { - penv = (char *)COB_SCHEMA_DIR; - } - } - if (penv != NULL) { - if ((strlen (penv) + j) > (envlen - 128)) { - env = cob_realloc (env, envlen, strlen (penv) + 256); - envlen = strlen (penv) + 256; - } - j += sprintf (&env[j], "%s", penv); - penv = NULL; - } - while (strval[k] != '}' && strval[k] != 0) { - k++; - } - if (strval[k] == '}') { - k++; - } - k--; - } else if (strval[k] == '$' - && strval[k+1] == '$') { /* Replace $$ with process-id */ - j += sprintf(&env[j],"%d",cob_sys_getpid()); - k++; - } else if (!isspace ((unsigned char)strval[k])) { - env[j++] = strval[k]; - } else { - env[j++] = ' '; - } - } - - env[j] = '\0'; - str = cob_strdup (env); - cob_free (env); - - return str; -} - -/* Store 'integer' value in field for correct length (computed with sizeof (fieldtype)) */ -static void -set_value (char *data, int len, cob_s64_t val) -{ - /* keep in order of occurrence in data types, last nanoseconds for startup... */ - if (len == sizeof (int)) { - *(int *)data = (int)val; - } else if (len == sizeof (short)) { - *(short *)data = (short)val; - } else if (len == sizeof (cob_s64_t)) { - *(cob_s64_t *)data = val; - } else { - *data = (char)val; - } -} - -/* Get 'integer' value from field */ -static cob_s64_t -get_value (char *data, int len) -{ - if (len == sizeof (int)) { - return *(int *)data; - } else if (len == sizeof (short)) { - return *(short *)data; - } else if (len == sizeof (cob_s64_t)) { - return *(cob_s64_t *)data; - } else { - return *data; - } -} - -static int -translate_boolean_to_int (const char* ptr) -{ - if (ptr == NULL || *ptr == 0) { - return 2; - } - - if (*(ptr + 1) == 0 && isdigit ((unsigned char)*ptr)) { - return atoi (ptr); /* 0 or 1 */ - } else - if (strcasecmp (ptr, "true") == 0 - || strcasecmp (ptr, "t") == 0 - || strcasecmp (ptr, "on") == 0 - || strcasecmp (ptr, "yes") == 0 - || strcasecmp (ptr, "y") == 0) { - return 1; /* True value */ - } else - if (strcasecmp (ptr, "false") == 0 - || strcasecmp (ptr, "f") == 0 - || strcasecmp (ptr, "off") == 0 - || strcasecmp (ptr, "no") == 0 - || strcasecmp (ptr, "n") == 0) { - return 0; /* False value */ - } - return 2; -} - -/* Set runtime setting with given value */ -static int /* returns 1 if any error, else 0 */ -set_config_val (char *value, int pos) -{ - char *data; - char *ptr = value, *str; - cob_s64_t numval = 0; - int i, data_type, data_len, slen; - size_t data_loc; - - data_type = gc_conf[pos].data_type; - data_loc = gc_conf[pos].data_loc; - data_len = gc_conf[pos].data_len; - - data = ((char *)cobsetptr) + data_loc; - - if (gc_conf[pos].enums) { /* Translate 'word' into alternate 'value' */ - - for (i = 0; gc_conf[pos].enums[i].match != NULL; i++) { - if (strcasecmp (value, gc_conf[pos].enums[i].match) == 0) { - ptr = value = (char *)gc_conf[pos].enums[i].value; - break; - } - if ((data_type & ENV_ENUMVAL) && strcasecmp (value, gc_conf[pos].enums[i].value) == 0) { - break; - } - } - if ((data_type & ENV_ENUM || data_type & ENV_ENUMVAL) /* Must be one of the 'enum' values */ - && gc_conf[pos].enums[i].match == NULL) { - conf_runtime_error_value (ptr, pos); - fprintf (stderr, _("should be one of the following values: %s"), ""); - for (i = 0; gc_conf[pos].enums[i].match != NULL; i++) { - if (i != 0) { - putc (',', stderr); - putc (' ', stderr); - } - fprintf (stderr, "%s", (char *)gc_conf[pos].enums[i].match); - if (data_type & ENV_ENUMVAL) { - fprintf (stderr, "(%s)", (char *)gc_conf[pos].enums[i].value); - } - } - putc ('\n', stderr); - fflush (stderr); - return 1; - } - } - - if ((data_type & ENV_UINT) /* Integer data, unsigned */ - || (data_type & ENV_SINT) /* Integer data, signed */ - || (data_type & ENV_SIZE) ) { /* Size: integer with K, M, G */ - char sign = 0; - for (; *ptr != 0 && (*ptr == ' '); ptr++); /* skip leading space */ - if (*ptr == '-' - || *ptr == '+') { - if ((data_type & ENV_SINT) == 0) { - conf_runtime_error_value (ptr, pos); - conf_runtime_error (1, _("should be unsigned")); // cob_runtime_warning - return 1; - } - sign = *ptr; - ptr++; - } - if (!isdigit ((unsigned char)*ptr)) { - conf_runtime_error_value (ptr, pos); - conf_runtime_error (1, _("should be numeric")); - return 1; - } - for (; *ptr != 0 && (isdigit ((unsigned char)*ptr)); ptr++) { - numval = (numval * 10) + ((cob_s64_t)*ptr - '0'); - } - if (sign != 0 - && ( *ptr == '-' - || *ptr == '+')) { - if ((data_type & ENV_SINT) == 0) { - conf_runtime_error_value (ptr, pos); - conf_runtime_error (1, _("should be unsigned")); - return 1; - } - sign = *ptr; - ptr++; - } - if ((data_type & ENV_SIZE) /* Size: any K, M, G */ - && *ptr != 0) { - switch (toupper ((unsigned char)*ptr)) { - case 'K': - numval = numval * 1024; - ptr++; - break; - case 'M': - if (numval < 4001) { - numval = numval * 1024 * 1024; - } else { - /* use max. guaranteed value for unsigned long - to raise a warning as max value is limit to one less */ - numval = 4294967295; - } - ptr++; - break; - case 'G': - if (numval < 4) { - numval = numval * 1024 * 1024 * 1024; - } else { - /* use max. guaranteed value for unsigned long - to raise a warning as max value is limit to one less */ - numval = 4294967295; - } - ptr++; - break; - } - } - for (; *ptr != 0 && (*ptr == ' '); ptr++); /* skip trailing space */ - if (*ptr != 0) { - conf_runtime_error_value (ptr, pos); - conf_runtime_error (1, _("should be numeric")); - return 1; - } - if (sign == '-') { - numval = -numval; - } - if (gc_conf[pos].min_value > 0 - && numval < gc_conf[pos].min_value) { - conf_runtime_error_value (value, pos); - conf_runtime_error (1, _("minimum value: %lu"), gc_conf[pos].min_value); - return 1; - } - if (gc_conf[pos].max_value > 0 - && numval > gc_conf[pos].max_value) { - conf_runtime_error_value (value, pos); - conf_runtime_error (1, _("maximum value: %lu"), gc_conf[pos].max_value); - return 1; - } - set_value (data, data_len, numval); - if (strcmp (gc_conf[pos].env_name, "COB_MOUSE_FLAGS") == 0 -#ifdef HAVE_MOUSEINTERVAL /* possibly add an internal option for mouse support, too */ - || strcmp (gc_conf[pos].env_name, "COB_MOUSE_INTERVAL") == 0 -#endif - ) { - cob_settings_screenio (); - } - - } else if ((data_type & ENV_BOOL)) { /* Boolean: Yes/No, True/False,... */ - numval = translate_boolean_to_int (ptr); - - if (numval != 1 - && numval != 0) { - conf_runtime_error_value (ptr, pos); - conf_runtime_error (1, _("should be one of the following values: %s"), "true, false"); - return 1; - } - if ((data_type & ENV_NOT)) { /* Negate logic for actual setting */ - numval = !numval; - } - set_value (data, data_len, numval); - if ((data_type & ENV_RESETS)) { /* Additional setup needed */ - if (strcmp(gc_conf[pos].env_name, "COB_SET_DEBUG") == 0) { - /* Copy variables from settings (internal) to global structure, each time */ - cobglobptr->cob_debugging_mode = cobsetptr->cob_debugging_mode; - } - } - if (strcmp (gc_conf[pos].env_name, "COB_INSERT_MODE") == 0) { - cob_settings_screenio (); - } - - } else if ((data_type & ENV_FILE) - || (data_type & ENV_PATH)) { /* Path (environment expanded) to be stored as a string */ - memcpy (&str, data, sizeof (char *)); - if (str != NULL) { - cob_free ((void *)str); - } - str = cob_expand_env_string (value); - if ((data_type & ENV_FILE) - && strchr (str, PATHSEP_CHAR) != NULL) { - conf_runtime_error_value (value, pos); - conf_runtime_error (1, _("should not contain '%c'"), PATHSEP_CHAR); - cob_free (str); - return 1; - } - memcpy (data, &str, sizeof (char *)); - if (data_loc == offsetof (cob_settings, cob_preload_str)) { - cobsetptr->cob_preload_str_set = cob_strdup(str); - } - - /* call internal routines that do post-processing */ - if (strcmp (gc_conf[pos].env_name, "COB_TRACE_FILE") == 0) { - cob_new_trace_file (); - } - - } else if (data_type & ENV_STR) { /* String (environment expanded) */ - memcpy (&str, data, sizeof (char *)); - if (str != NULL) { - cob_free ((void *)str); - } - str = cob_expand_env_string (value); - memcpy (data, &str, sizeof (char *)); - if (data_loc == offsetof (cob_settings, cob_preload_str)) { - cobsetptr->cob_preload_str_set = cob_strdup(str); - } - - /* call internal routines that do post-processing */ - if (strcmp (gc_conf[pos].env_name, "COB_CURRENT_DATE") == 0) { - check_current_date (); - } - - } else if ((data_type & ENV_CHAR)) { /* 'char' field inline */ - memset (data, 0, data_len); - slen = (int)strlen (value); - if (slen > data_len) { - slen = data_len; - } - memcpy (data, value, slen); - } - return 0; -} - -/* Set runtime setting by name with given value */ -static int /* returns 1 if any error, else 0 */ -set_config_val_by_name (char *value, const char *name, const char *func) -{ - int i; - int ret = 1; - - for (i = 0; i < NUM_CONFIG; i++) { - if (!strcmp (gc_conf[i].conf_name, name)) { - ret = set_config_val (value, i); - if (func) { - gc_conf[i].data_type |= STS_FNCSET; - gc_conf[i].set_by = FUNC_NAME_IN_DEFAULT; - gc_conf[i].default_val = func; - } - break; - } - } - return ret; -} - -/* Return setting value as a 'string' */ -static char * -get_config_val (char *value, int pos, char *orgvalue) -{ - char *data; - char *str; - double dval; - cob_s64_t numval = 0; - int i, data_type, data_len; - size_t data_loc; - - data_type = gc_conf[pos].data_type; - data_loc = gc_conf[pos].data_loc; - data_len = gc_conf[pos].data_len; - - data = ((char *)cobsetptr) + data_loc; - - if (min_conf_length == 0) { - not_set = _("not set"); - min_conf_length = (char) strlen (not_set) + 1; - if (min_conf_length < 6) { - min_conf_length = 6; - } else if (min_conf_length > 15) { - min_conf_length = 15; - } - } - - strcpy (value, _("unknown")); - orgvalue[0] = 0; - if (data_type & ENV_UINT) { /* Integer data, unsigned */ - numval = get_value (data, data_len); - sprintf (value, CB_FMT_LLU, numval); - - } else if (data_type & ENV_SINT) { /* Integer data, signed */ - numval = get_value (data, data_len); - sprintf (value, CB_FMT_LLD, numval); - - } else if ((data_type & ENV_SIZE)) { /* Size: integer with K, M, G */ - numval = get_value (data, data_len); - dval = (double) numval; - if (numval > (1024 * 1024 * 1024)) { - if ((numval % (1024 * 1024 * 1024)) == 0) { - sprintf (value, CB_FMT_LLD" GB", numval / (1024 * 1024 * 1024)); - } else { - sprintf (value, "%.2f GB", dval / (1024.0 * 1024.0 * 1024.0)); - } - } else if (numval > (1024 * 1024)) { - if ((numval % (1024 * 1024)) == 0) { - sprintf (value, CB_FMT_LLD" MB", numval / (1024 * 1024)); - } else { - sprintf (value, "%.2f MB", dval / (1024.0 * 1024.0)); - } - } else if (numval > 1024) { - if ((numval % 1024) == 0) { - sprintf (value, CB_FMT_LLD" KB", numval / 1024); - } else { - sprintf (value, "%.2f KB", dval / 1024.0); - } - } else { - sprintf (value, CB_FMT_LLD, numval); - } - - } else if ((data_type & ENV_BOOL)) { /* Boolean: Yes/No, True/False,... */ - numval = get_value (data, data_len); - if ((data_type & ENV_NOT)) { - numval = !numval; - } - if (numval) { - strcpy (value, _("yes")); - } else { - strcpy (value, _("no")); - } - - /* TO-DO: Consolidate copy-and-pasted code! */ - } else if ((data_type & ENV_STR)) { /* String stored as a string */ - memcpy (&str, data, sizeof (char *)); - if (data_loc == offsetof (cob_settings, cob_display_print_filename) - && cobsetptr->cob_display_print_file) { - snprintf (value, COB_MEDIUM_MAX, _("set by %s"), "cob_set_runtime_option"); - } else if (data_loc == offsetof (cob_settings, cob_display_punch_filename) - && cobsetptr->cob_display_punch_file) { - snprintf (value, COB_MEDIUM_MAX, _("set by %s"), "cob_set_runtime_option"); - } else if(data_loc == offsetof (cob_settings, cob_trace_filename) - && cobsetptr->external_trace_file) { - snprintf (value, COB_MEDIUM_MAX, _("set by %s"), "cob_set_runtime_option"); - } else if (str == NULL) { - snprintf (value, COB_MEDIUM_MAX, _("not set")); - } else { - snprintf (value, COB_MEDIUM_MAX, "'%s'", str); - } - - } else if ((data_type & ENV_FILE)) { /* File/path stored as a string */ - memcpy (&str, data, sizeof (char *)); - /* TODO: add special cases here on merging rw-branch */ - if (str == NULL) { - snprintf (value, COB_MEDIUM_MAX, _("not set")); - } else { - snprintf (value, COB_MEDIUM_MAX, "%s", str); - } - - } else if ((data_type & ENV_PATH)) { /* Path stored as a string */ - memcpy (&str, data, sizeof (char *)); - if (str == NULL) { - snprintf (value, COB_MEDIUM_MAX, _("not set")); - } else { - snprintf (value, COB_MEDIUM_MAX, "%s", str); - } - - } else if ((data_type & ENV_CHAR)) { /* 'char' field inline */ - if (*(char *)data == 0) { - strcpy (value, "Nul"); - } else if (isprint (*(unsigned char *)data)) { - sprintf (value, "'%s'", (char *)data); - } else { - sprintf (value, "0x%02X", *(char *)data); - } - } - value[COB_MEDIUM_MAX] = 0; /* fix warning */ - - if (gc_conf[pos].enums) { /* Translate 'word' into alternate 'value' */ - for (i = 0; gc_conf[pos].enums[i].match != NULL; i++) { - if (strcasecmp (value, gc_conf[pos].enums[i].value) == 0) { - if (strcmp(value,"0") != 0 - && gc_conf[pos].default_val != NULL - && strcmp (value, gc_conf[pos].default_val) != 0) { - strcpy (orgvalue, value); - } - strcpy (value, gc_conf[pos].enums[i].match); - break; - } - } - if (gc_conf[pos].enums[i].match == NULL - && gc_conf[pos].default_val != NULL - && strcmp (value, gc_conf[pos].default_val) != 0) { - strcpy (orgvalue, value); - } - } else - if (!(gc_conf[pos].data_type & STS_ENVSET) - && !(gc_conf[pos].data_type & STS_CNFSET) - && !(gc_conf[pos].data_type & ENV_BOOL) - && gc_conf[pos].default_val != NULL) { - strcpy(value,gc_conf[pos].default_val); - orgvalue[0] = 0; - } - - if (gc_conf[pos].default_val != NULL - && strcmp (orgvalue, gc_conf[pos].default_val) != 0) { - orgvalue[0] = 0; - } else if(strcmp(value,orgvalue) == 0) { - orgvalue[0] = 0; - } - - return value; -} - -static int -cb_lookup_config (char *keyword) -{ - int i; - for (i = 0; i < NUM_CONFIG; i++) { /* Set value from config file */ - if (gc_conf[i].conf_name - && strcasecmp (keyword, gc_conf[i].conf_name) == 0) { /* Look for config file name */ - break; - } - if (gc_conf[i].env_name - && strcasecmp (keyword, gc_conf[i].env_name) == 0) { /* Catch using env var name */ - break; - } - } - return i; -} - -static int -cb_config_entry (char *buf, int line) -{ - int i, j, k, old_type; - void *data; - char *env, *str, qt; - char keyword[COB_MINI_BUFF], value[COB_SMALL_BUFF], value2[COB_SMALL_BUFF]; - - cob_source_line = line; - - for (j= (int)strlen (buf); buf[j-1] == '\r' || buf[j-1] == '\n'; ) /* Remove CR LF */ - buf[--j] = 0; - - for (i = 0; isspace ((unsigned char)buf[i]); i++); - - for (j = 0; buf[i] != 0 && buf[i] != ':' && !isspace ((unsigned char)buf[i]) && buf[i] != '=' && buf[i] != '#'; ) - keyword[j++] = buf[i++]; - keyword[j] = 0; - - while (buf[i] != 0 && (isspace ((unsigned char)buf[i]) || buf[i] == ':' || buf[i] == '=')) i++; - if (buf[i] == '"' - || buf[i] == '\'') { - qt = buf[i++]; - for (j = 0; buf[i] != qt && buf[i] != 0; ) - value[j++] = buf[i++]; - } else { - for (j = 0; !isspace ((unsigned char)buf[i]) && buf[i] != '#' && buf[i] != 0; ) - value[j++] = buf[i++]; - } - - value[j] = 0; - if (strcasecmp (keyword, "reset") != 0 - && strcasecmp (keyword, "include") != 0 - && strcasecmp (keyword, "includeif") != 0 - && strcasecmp (keyword, "setenv") != 0 - && strcasecmp (keyword, "unsetenv") != 0) { - i = cb_lookup_config (keyword); - - if (i >= NUM_CONFIG) { - conf_runtime_error (1, _("unknown configuration tag '%s'"), keyword); - return -1; - } - } - if (strcmp (value, "") == 0) { - if (strcasecmp (keyword, "include") != 0 - && strcasecmp (keyword, "includeif")) { - conf_runtime_error(1, _("WARNING - '%s' without a value - ignored!"), keyword); - return 2; - } else { - conf_runtime_error (1, _("'%s' without a value!"), keyword); - return -1; - } - } - - if (strcasecmp (keyword, "setenv") == 0 ) { - /* collect additional value and push into environment */ - strcpy (value2, ""); - /* check for := in value 2 and split, if necessary */ - k = 0; while (value[k] != '=' && value[k] != ':' && value[k] != '"' && value[k] != '\'' && value[k] != 0) k++; - if (value[k] == '=' || value[k] == ':') { - i = i - (int)strlen (value + k); - value[k] = 0; - } - while (isspace ((unsigned char)buf[i]) || buf[i] == ':' || buf[i] == '=') i++; - if (buf[i] == '"' - || buf[i] == '\'') { - qt = buf[i++]; - for (j = 0; buf[i] != qt && buf[i] != 0; ) - value2[j++] = buf[i++]; - } else { - for (j = 0; !isspace ((unsigned char)buf[i]) && buf[i] != '#' && buf[i] != 0; ) - value2[j++] = buf[i++]; - } - value2[j] = 0; - if (strcmp (value2, "") == 0) { - conf_runtime_error (1, _("WARNING - '%s %s' without a value - ignored!"), keyword, value); - return 2; - } - /* check additional value for inline env vars ${varname:-default} */ - str = cob_expand_env_string (value2); - - (void)cob_setenv (value, str, 1); - cob_free (str); - for (i = 0; i < NUM_CONFIG; i++) { /* Set value from config file */ - if (gc_conf[i].env_name - && strcasecmp (value, gc_conf[i].env_name) == 0) {/* no longer cleared by runtime.cfg */ - gc_conf[i].data_type &= ~STS_ENVCLR; - break; - } - } - return 0; - } - - if (strcasecmp (keyword, "unsetenv") == 0) { - if ((env = getenv (value)) != NULL ) { - for (i = 0; i < NUM_CONFIG; i++) { /* Set value from config file */ - if (gc_conf[i].env_name - && strcasecmp (value, gc_conf[i].env_name) == 0) { /* Catch using env var name */ - gc_conf[i].data_type |= STS_ENVCLR; - break; - } - } - (void)cob_unsetenv (value); - } - return 0; - } - - if (strcasecmp (keyword, "include") == 0 || - strcasecmp (keyword, "includeif") == 0) { - str = cob_expand_env_string (value); - strcpy (buf, str); - cob_free (str); - if (strcasecmp (keyword, "include") == 0) { - return 1; - } else { - return 3; - } - } - - if (strcasecmp (keyword, "reset") == 0) { - i = cb_lookup_config (value); - if (i >= NUM_CONFIG) { - conf_runtime_error (1, _("unknown configuration tag '%s'"), value); - return -1; - } - gc_conf[i].data_type &= ~(STS_ENVSET | STS_CNFSET | STS_ENVCLR); /* Clear status */ - gc_conf[i].data_type |= STS_RESET; - gc_conf[i].set_by = 0; - gc_conf[i].config_num = cobsetptr->cob_config_cur - 1; - if (gc_conf[i].default_val) { - set_config_val ((char *)gc_conf[i].default_val, i); - } else if ((gc_conf[i].data_type & ENV_STR) - || (gc_conf[i].data_type & ENV_FILE) - || (gc_conf[i].data_type & ENV_PATH)) { /* String/Path stored as a string */ - data = (void *) ((char *)cobsetptr + gc_conf[i].data_loc); - memcpy (&str, data, sizeof (char *)); - if (str != NULL) { - cob_free ((void *)str); - } - str = NULL; - memcpy (data, &str, sizeof (char *)); /* Reset pointer to NULL */ - } else { - set_config_val ((char *)"0", i); - } - return 0; - } - - i = cb_lookup_config (keyword); - - if (i >= NUM_CONFIG) { - conf_runtime_error (1, _("unknown configuration tag '%s'"), keyword); - return -1; - } - - old_type = gc_conf[i].data_type; - gc_conf[i].data_type |= STS_CNFSET; - if (!set_config_val (value, i)) { - gc_conf[i].data_type &= ~STS_RESET; - gc_conf[i].config_num = cobsetptr->cob_config_cur - 1; - - if (gc_conf[i].env_group == GRP_HIDE) { - for (j = 0; j < NUM_CONFIG; j++) { /* Any alias present? */ - if (j != i - && gc_conf[i].data_loc == gc_conf[j].data_loc) { - gc_conf[j].data_type |= STS_CNFSET; - gc_conf[j].data_type &= ~STS_RESET; - gc_conf[j].config_num = gc_conf[i].config_num; - gc_conf[j].set_by = i; - } - } - } - } else { - gc_conf[i].data_type = old_type; - } - return 0; -} - -static int -cob_load_config_file (const char *config_file, int isoptional) -{ - char buff[COB_FILE_BUFF-10], filename[COB_FILE_BUFF]; - char *penv; - int sub_ret, ret; - unsigned int i; - int line; - FILE *conf_fd; - - for (i = 0; config_file[i] != 0 && config_file[i] != SLASH_CHAR; i++); - if (config_file[i] == 0) { /* Just a name, No directory */ - if (access (config_file, F_OK) != 0) { /* and file does not exist */ - /* check for path of previous configuration file (for includes) */ - filename[0] = 0; - if (cobsetptr->cob_config_cur != 0) { - size_t size; - strncpy (buff, - cobsetptr->cob_config_file[cobsetptr->cob_config_cur - 1], - (size_t)COB_FILE_MAX-10); - size = strlen (buff); - if (size != 0 && buff[size] == SLASH_CHAR) buff[--size] = 0; - if (size != 0) { - snprintf (filename, (size_t)COB_FILE_MAX, "%s%c%s", buff, SLASH_CHAR, - config_file); - if (access (filename, F_OK) == 0) { /* and prefixed file exist */ - config_file = filename; /* Prefix last directory */ - } else { - filename[0] = 0; - } - } - } - if (filename[0] == 0) { - /* check for COB_CONFIG_DIR (use default if not in environment) */ - penv = getenv ("COB_CONFIG_DIR"); - if (penv != NULL) { - snprintf (filename, (size_t)COB_FILE_MAX, "%s%c%s", - penv, SLASH_CHAR, config_file); - } else { - snprintf (filename, (size_t)COB_FILE_MAX, "%s%c%s", - COB_CONFIG_DIR, SLASH_CHAR, config_file); - } - if (access (filename, F_OK) == 0) { /* and prefixed file exist */ - config_file = filename; /* Prefix COB_CONFIG_DIR */ - } - } - } - } - - cob_source_file = config_file; - - /* check for recursion */ - for (i = 0; i < cobsetptr->cob_config_num; i++) { - if (strcmp (cobsetptr->cob_config_file[i], config_file) == 0) { - cob_source_line = 0; - conf_runtime_error (1, _("recursive inclusion")); - return -2; - } - } - - /* Open the configuration file */ - conf_fd = fopen (config_file, "r"); - if (conf_fd == NULL && !isoptional) { - cob_source_line = 0; - conf_runtime_error (1, cob_get_strerror ()); - if (cobsetptr->cob_config_file) { - cob_source_file = cobsetptr->cob_config_file[cobsetptr->cob_config_num-1]; - } - return -1; - } - if (conf_fd != NULL) { - if (cobsetptr->cob_config_file == NULL) { - cobsetptr->cob_config_file = cob_malloc (sizeof (char *)); - } else { - cobsetptr->cob_config_file = cob_realloc (cobsetptr->cob_config_file, - sizeof (char *)*(cobsetptr->cob_config_num), sizeof (char *)*(cobsetptr->cob_config_num + 1)); - } - cobsetptr->cob_config_file[cobsetptr->cob_config_num++] = cob_strdup (config_file); /* Save config file name */ - cobsetptr->cob_config_cur = cobsetptr->cob_config_num; - } - - - /* Read the configuration file */ - ret = 0; - line = 0; - while ((conf_fd != NULL) - && (fgets (buff, COB_SMALL_BUFF, conf_fd) != NULL) ) { - line++; - for (i = 0; isspace ((unsigned char)buff[i]); i++); - if (buff[i] == 0 - || buff[i] == '#' - || buff[i] == '\r' - || buff[i] == '\n') - continue; /* Skip comments and blank lines */ - - /* Evaluate config line */ - sub_ret = cb_config_entry (buff, line); - - /* Include another configuration file */ - if (sub_ret == 1 || sub_ret == 3) { - cob_source_line = line; - sub_ret = cob_load_config_file (buff, sub_ret == 3); - cob_source_file = config_file; - if (sub_ret < 0) { - ret = -1; - cob_source_line = line; - conf_runtime_error (1, _("configuration file was included here")); - break; - } - } - if (sub_ret < ret) ret = sub_ret; - } - if (conf_fd) { - fclose (conf_fd); - cobsetptr->cob_config_cur--; - } - cob_source_file = NULL; - conf_fd = NULL; - - return ret; -} - -/* - * Load the GnuCOBOL runtime configuration information - */ -int -cob_load_config (void) -{ - char *env; - char conf_file[COB_MEDIUM_BUFF]; - int is_optional = 1, sts, i, j; - - - /* Get the name for the configuration file */ - if ((env = getenv ("COB_RUNTIME_CONFIG")) != NULL && env[0]) { - strncpy (conf_file, env, (size_t)COB_MEDIUM_MAX); - conf_file[COB_MEDIUM_MAX] = 0; - is_optional = 0; /* If declared then it is NOT optional */ - if (strchr (conf_file, PATHSEP_CHAR) != NULL) { - conf_runtime_error (0, _("invalid value '%s' for configuration tag '%s'"), conf_file, "COB_RUNTIME_CONFIG"); - conf_runtime_error (1, _("should not contain '%c'"), PATHSEP_CHAR); - return -1; - } - } else { - /* check for COB_CONFIG_DIR (use default if not in environment) */ - if ((env = getenv ("COB_CONFIG_DIR")) != NULL && env[0]) { - snprintf (conf_file, (size_t)COB_MEDIUM_MAX, "%s%c%s", env, SLASH_CHAR, "runtime.cfg"); - } else { - snprintf (conf_file, (size_t)COB_MEDIUM_MAX, "%s%c%s", COB_CONFIG_DIR, SLASH_CHAR, "runtime.cfg"); - } - conf_file[COB_MEDIUM_MAX] = 0; /* fixing code analyser warning */ - is_optional = 1; /* If not present, then just use env vars */ - if (strchr (conf_file, PATHSEP_CHAR) != NULL) { - conf_runtime_error (0, _("invalid value '%s' for configuration tag '%s'"), conf_file, "COB_CONFIG_DIR"); - conf_runtime_error (1, _("should not contain '%c'"), PATHSEP_CHAR); - return -1; - } - } - - sprintf (varseq_dflt, "%d", WITH_VARSEQ); /* Default comes from config.h */ - for (i = 0; i < NUM_CONFIG; i++) { - gc_conf[i].data_type &= ~(STS_ENVSET | STS_CNFSET | STS_ENVCLR); /* Clear status */ - } - - sts = cob_load_config_file (conf_file, is_optional); - if (sts < 0) { - return sts; - } - cob_rescan_env_vals (); /* Check for possible environment variables */ - - /* Set with default value if present and not set otherwise */ - for (i = 0; i < NUM_CONFIG; i++) { - if (gc_conf[i].default_val - && !(gc_conf[i].data_type & STS_CNFSET) - && !(gc_conf[i].data_type & STS_ENVSET)) { - for (j = 0; j < NUM_CONFIG; j++) { /* Any alias present? */ - if (j != i - && gc_conf[i].data_loc == gc_conf[j].data_loc) - break; - } - if (j < NUM_CONFIG) { - if (!(gc_conf[j].data_type & STS_CNFSET) - && !(gc_conf[j].data_type & STS_ENVSET)) { /* alias not defined? */ - set_config_val ((char *)gc_conf[i].default_val, i); - } - } else { - set_config_val ((char *)gc_conf[i].default_val, i); /* Set default value */ - } - } - } - check_current_date(); - - return 0; -} - -static void -output_source_location (void) -{ - if (cobglobptr && COB_MODULE_PTR - && COB_MODULE_PTR->module_stmt != 0 - && COB_MODULE_PTR->module_sources) { - fprintf (stderr, "%s:%u: ", - COB_MODULE_PTR->module_sources - [COB_GET_FILE_NUM(COB_MODULE_PTR->module_stmt)], - COB_GET_LINE_NUM(COB_MODULE_PTR->module_stmt)); - } else { - if (cob_source_file) { - fprintf (stderr, "%s:", cob_source_file); - if (!cob_source_line) { - fputc (' ', stderr); - } - } - if (cob_source_line) { - fprintf (stderr, "%u:", cob_source_line); - fputc (' ', stderr); - } - } -} - -/* output runtime warning for issues produced by external API functions */ -void -cob_runtime_warning_external (const char *caller_name, const int cob_reference, const char *fmt, ...) -{ - va_list args; - - if (!cobsetptr->cob_display_warn) { - return; - } - - /* Prefix */ - fprintf (stderr, "libcob: "); - if (cob_reference) { - output_source_location (); - } - fprintf (stderr, _("warning: ")); - fprintf (stderr, "%s: ", caller_name); - - /* Body */ - va_start (args, fmt); - vfprintf (stderr, fmt, args); - va_end (args); - - /* Postfix */ - putc ('\n', stderr); - fflush (stderr); -} - -void -cob_runtime_warning (const char *fmt, ...) -{ - va_list args; - - if (cobsetptr && !cobsetptr->cob_display_warn) { - return; - } - - /* Prefix */ - fprintf (stderr, "libcob: "); - output_source_location (); - fprintf (stderr, _("warning: ")); - - /* Body */ - va_start (args, fmt); - vfprintf (stderr, fmt, args); - va_end (args); - - /* Postfix */ - putc ('\n', stderr); - fflush (stderr); -} - -void -cob_runtime_hint (const char *fmt, ...) -{ - va_list args; - - /* Prefix */ - fprintf (stderr, "\t"); - - /* Body */ - va_start (args, fmt); - vfprintf (stderr, fmt, args); - va_end (args); - - /* Postfix */ - putc ('\n', stderr); - fflush (stderr); -} - -void -cob_runtime_error (const char *fmt, ...) -{ - struct handlerlist *h; - struct handlerlist *hp; - char *p; - va_list ap; - - char reason[80]; - - const char *err_source_file; - unsigned int err_source_line, err_module_statement = 0; - cob_module_ptr err_module_pointer = NULL; - -#if 1 /* RXWRXW - Exit screen */ - /* Exit screen mode early */ - cob_exit_screen (); -#endif - - if (hdlrs != NULL && !active_error_handler) { - if (runtime_err_str) { - p = runtime_err_str; - if (cob_source_file) { - if (cob_source_line) { - sprintf (runtime_err_str, "%s:%u: ", - cob_source_file, cob_source_line); - } else { - sprintf (runtime_err_str, "%s: ", - cob_source_file); - } - p = runtime_err_str + strlen (runtime_err_str); - } - va_start (ap, fmt); - vsprintf (p, fmt, ap); - va_end (ap); - /* LCOV_EXCL_START */ - } else { - runtime_err_str = (char *) "-"; - } - /* LCOV_EXCL_STOP */ - - /* save error location */ - err_source_file = cob_source_file; - err_source_line = cob_source_line; - if (cobglobptr && COB_MODULE_PTR) { - err_module_pointer = COB_MODULE_PTR; - err_module_statement = COB_MODULE_PTR->module_stmt; - } - - /* run registered error handlers */ - active_error_handler = 1; - h = hdlrs; - while (h != NULL) { - /* ensure that error handlers set their own locations */ - cob_source_file = NULL; - cob_source_line = 0; - h->proc (runtime_err_str); - hp = h; - h = h->next; - cob_free (hp); - } - /* LCOV_EXCL_START */ - if (runtime_err_str[0] == '-' && runtime_err_str[1] == 0) { - runtime_err_str = NULL; - } - /* LCOV_EXCL_STOP */ - hdlrs = NULL; - active_error_handler = 0; - - /* restore error location */ - cob_source_file = err_source_file; - cob_source_line = err_source_line; - if (cobglobptr) { - COB_MODULE_PTR = err_module_pointer; - if (COB_MODULE_PTR) { - COB_MODULE_PTR->module_stmt = err_module_statement; - } - } - } - - /* Optional Module Dump */ - if (cobglobptr && COB_MODULE_PTR - && COB_MODULE_PTR->module_stmt != 0) { - va_start (ap, fmt); - vsnprintf (reason, sizeof(reason), fmt, ap); - va_end (ap); - cob_dump_module (reason); - } - - /* Prefix */ - fputs ("libcob: ", stderr); - if (cob_source_file) { - fprintf (stderr, "%s:", cob_source_file); - if (cob_source_line) { - fprintf (stderr, "%u:", cob_source_line); - } - fputc (' ', stderr); - } - fprintf (stderr, "%s: ", _("error")); - - /* Body */ - va_start (ap, fmt); - vfprintf (stderr, fmt, ap); - va_end (ap); - - /* Postfix */ - putc ('\n', stderr); - fflush (stderr); -} - -void -cob_fatal_error (const enum cob_fatal_error fatal_error) -{ - const char *msg; - unsigned char *file_status; - char *err_cause; - int status; -#ifdef _WIN32 - char *p; -#endif - - switch (fatal_error) { -#if 0 /* Currently not in use, should enter unknown error */ - case COB_FERROR_NONE: - break; -#endif - /* Note: can be simply tested; therefore no exclusion */ - case COB_FERROR_CANCEL: - cob_runtime_error (_("attempt to CANCEL active program")); - break; - /* Note: can be simply tested; therefore no exclusion */ - case COB_FERROR_INITIALIZED: -#ifdef _WIN32 - /* cob_unix_lf needs to be set before any error message is thrown, - as they would have wrong line endings otherwise */ - p = getenv ("COB_UNIX_LF"); - if (p && (*p == 'Y' || *p == 'y' || - *p == 'T' || *p == 't' || - *p == '1')) { - (void)_setmode (_fileno (stdin), _O_BINARY); - (void)_setmode (_fileno (stdout), _O_BINARY); - (void)_setmode (_fileno (stderr), _O_BINARY); - } -#endif - /* note: same message in call.c */ - cob_runtime_error (_("cob_init() has not been called")); - break; - /* LCOV_EXCL_START */ - case COB_FERROR_CODEGEN: - cob_runtime_error ("codegen error"); /* not translated by intent */ - cob_runtime_error (_("Please report this!")); - break; - /* LCOV_EXCL_STOP */ - /* Note: can be simply tested; therefore no exclusion */ - case COB_FERROR_CHAINING: - cob_runtime_error (_("CALL of program with CHAINING clause")); - break; - /* LCOV_EXCL_START */ - case COB_FERROR_STACK: - cob_runtime_error (_("stack overflow, possible PERFORM depth exceeded")); - break; - /* LCOV_EXCL_STOP */ - /* LCOV_EXCL_START */ - case COB_FERROR_GLOBAL: - cob_runtime_error (_("invalid entry/exit in GLOBAL USE procedure")); - break; - /* LCOV_EXCL_STOP */ - /* LCOV_EXCL_START */ - case COB_FERROR_MEMORY: - cob_runtime_error (_("unable to allocate memory")); - break; - /* LCOV_EXCL_STOP */ - /* LCOV_EXCL_START */ - case COB_FERROR_MODULE: - cob_runtime_error (_("invalid entry into module")); - break; - /* LCOV_EXCL_STOP */ - /* Note: can be simply tested; therefore no exclusion */ - case COB_FERROR_RECURSIVE: - cob_runtime_error (_("recursive CALL from %s to %s which is NOT RECURSIVE"), - COB_MODULE_PTR->module_name, cob_module_err->module_name); - cob_module_err = NULL; - break; - /* LCOV_EXCL_START */ - case COB_FERROR_FREE: - cob_runtime_error (_("call to %s with NULL pointer"), "cob_free"); - break; - /* LCOV_EXCL_STOP */ - case COB_FERROR_DIV_ZERO: - cob_runtime_error (_("divide by ZERO")); - break; - case COB_FERROR_FILE: - file_status = cobglobptr->cob_error_file->file_status; - status = COB_D2I (file_status[0]) * 10 + COB_D2I (file_status[1]); - switch (status) { - case COB_STATUS_10_END_OF_FILE: - msg = _("end of file"); - break; - case COB_STATUS_14_OUT_OF_KEY_RANGE: - msg = _("key out of range"); - break; - case COB_STATUS_21_KEY_INVALID: - msg = _("key order not ascending"); - break; - case COB_STATUS_22_KEY_EXISTS: - msg = _("record key already exists"); - break; - case COB_STATUS_23_KEY_NOT_EXISTS: - msg = _("record key does not exist"); - break; - case COB_STATUS_30_PERMANENT_ERROR: - msg = _("permanent file error"); - break; - case COB_STATUS_31_INCONSISTENT_FILENAME: - msg = _("inconsistant file name"); - break; - case COB_STATUS_35_NOT_EXISTS: - msg = _("file does not exist"); - break; - case COB_STATUS_37_PERMISSION_DENIED: - msg = _("permission denied"); - break; - case COB_STATUS_41_ALREADY_OPEN: - msg = _("file already open"); - break; - case COB_STATUS_42_NOT_OPEN: - msg = _("file not open"); - break; - case COB_STATUS_43_READ_NOT_DONE: - msg = _("READ must be executed first"); - break; - case COB_STATUS_44_RECORD_OVERFLOW: - msg = _("record overflow"); - break; - case COB_STATUS_46_READ_ERROR: - msg = _("READ after unsuccessful READ/START"); - break; - case COB_STATUS_47_INPUT_DENIED: - msg = _("READ/START not allowed, file not open for input"); - break; - case COB_STATUS_48_OUTPUT_DENIED: - msg = _("WRITE not allowed, file not open for output"); - break; - case COB_STATUS_49_I_O_DENIED: - msg = _("DELETE/REWRITE not allowed, file not open for I-O"); - break; - case COB_STATUS_51_RECORD_LOCKED: - msg = _("record locked by another file connector"); - break; - case COB_STATUS_57_I_O_LINAGE: - msg = _("LINAGE values invalid"); - break; - case COB_STATUS_61_FILE_SHARING: - msg = _("file sharing conflict"); - break; - /* LCOV_EXCL_START */ - case COB_STATUS_91_NOT_AVAILABLE: - msg = _("runtime library is not configured for this operation"); - break; - /* LCOV_EXCL_STOP */ - /* LCOV_EXCL_START */ - default: - msg = _("unknown file error"); - break; - /* LCOV_EXCL_STOP */ - } - err_cause = cob_get_filename_print (cobglobptr->cob_error_file, 1); - /* FIXME: additional check if referenced program has active code location */ - if (!cobglobptr->last_exception_statement) { - cob_runtime_error (_ ("%s (status = %02d) for file %s"), - msg, status, err_cause); - } else { - cob_runtime_error (_("%s (status = %02d) for file %s on %s"), - msg, status, err_cause, - cobglobptr->last_exception_statement); - } - break; - /* LCOV_EXCL_START */ - case COB_FERROR_FUNCTION: - cob_runtime_error (_("attempt to use non-implemented function")); - break; - case COB_FERROR_XML: - cob_runtime_error (_("attempt to use non-implemented XML I/O")); - break; - case COB_FERROR_JSON: - cob_runtime_error (_("attempt to use non-implemented JSON I/O")); - break; - default: - /* internal rare error, no need for translation */ - cob_runtime_error ("unknown failure: %d", fatal_error); - break; - /* LCOV_EXCL_STOP */ - } - cob_stop_run (1); -} - -void -conf_runtime_error_value (const char *value, const int pos) -{ - const char *name = NULL; - - if (gc_conf[pos].data_type & STS_CNFSET) { - name = gc_conf[pos].conf_name; - } else { - name = gc_conf[pos].env_name; - } - conf_runtime_error (0, _("invalid value '%s' for configuration tag '%s'"), value, name); -} - -void -conf_runtime_error (const int finish_error, const char *fmt, ...) -{ - va_list args; - - if (!conf_runtime_error_displayed) { - conf_runtime_error_displayed = 1; - fputs (_("configuration error:"), stderr); - putc ('\n', stderr); - } - - /* Prefix; note: no need to strcmp as we check against - the value passed last time */ - if (cob_source_file != last_runtime_error_file - || cob_source_line != last_runtime_error_line) { - last_runtime_error_file = cob_source_file; - last_runtime_error_line = cob_source_line; - if (cob_source_file) { - fprintf (stderr, "%s", cob_source_file); - if (cob_source_line) { - fprintf (stderr, ":%u", cob_source_line); - } - } else { - fprintf (stderr, "%s", _("environment variables")); - } - fputc(':', stderr); - fputc(' ', stderr); - } - - /* Body */ - va_start (args, fmt); - vfprintf (stderr, fmt, args); - va_end (args); - - /* Postfix */ - if (!finish_error) { - putc (';', stderr); - putc ('\n', stderr); - putc ('\t', stderr); - } else { - putc ('\n', stderr); - fflush (stderr); - } -} - - -void -print_version (void) -{ - char cob_build_stamp[COB_MINI_BUFF]; - char month[64]; - int status, day, year; - - /* Set up build time stamp */ - memset (cob_build_stamp, 0, (size_t)COB_MINI_BUFF); - memset (month, 0, sizeof (month)); - day = 0; - year = 0; - status = sscanf (__DATE__, "%s %d %d", month, &day, &year); - if (status == 3) { - snprintf (cob_build_stamp, (size_t)COB_MINI_MAX, - "%s %2.2d %4.4d %s", month, day, year, __TIME__); - } else { - snprintf (cob_build_stamp, (size_t)COB_MINI_MAX, - "%s %s", __DATE__, __TIME__); - } - - printf ("libcob (%s) %s.%d\n", - PACKAGE_NAME, PACKAGE_VERSION, PATCH_LEVEL); - puts ("Copyright (C) 2020 Free Software Foundation, Inc."); - puts (_("License LGPLv3+: GNU LGPL version 3 or later ")); - puts (_("This is free software; see the source for copying conditions. There is NO\n" - "warranty; not even for MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.")); - printf (_("Written by %s\n"), "Keisuke Nishida, Roger While, Ron Norman, Simon Sobisch, Edward Hart"); - - /* TRANSLATORS: This msgid is indented as the "Packaged" msgid, %s expands to date and time */ - printf (_("Built %s"), cob_build_stamp); - putchar ('\n'); - /* TRANSLATORS: This msgid is indented as the "Built" msgid, %s expands to date and time */ - printf (_("Packaged %s"), COB_TAR_DATE); - putchar ('\n'); - -} - -void -print_info (void) -{ - char buff[16]; - char versbuff[56] = { '\0' }; - char *s; - int major, minor, patch; -#if defined (__PDCURSES__) - int opt1, opt2, opt3; -#endif -#if defined (__PDCURSES__) || defined (NCURSES_VERSION) -#if defined (PDC_WIDE) || defined (NCURSES_WIDECHAR) - const int wide = 1; -#else - const int wide = 0; -#endif -#endif - char versbuff2[115]; - - memset(versbuff2,0,sizeof(versbuff2)); - print_version (); - putchar ('\n'); - puts (_("build information")); - var_print (_("build environment"), COB_BLD_BUILD, "", 0); - var_print ("CC", COB_BLD_CC, "", 0); - /* Note: newline because most compilers define a long version string (> 30 characters) */ - snprintf (versbuff, 55, "%s%s", GC_C_VERSION_PRF, GC_C_VERSION); - var_print ("C version", versbuff, "", 0); - var_print ("CPPFLAGS", COB_BLD_CPPFLAGS, "", 0); - var_print ("CFLAGS", COB_BLD_CFLAGS, "", 0); - var_print ("LD", COB_BLD_LD, "", 0); - var_print ("LDFLAGS", COB_BLD_LDFLAGS, "", 0); - putchar ('\n'); - - puts (_("GnuCOBOL information")); - - var_print ("COB_MODULE_EXT", COB_MODULE_EXT, "", 0); -#if 0 /* only relevant for cobc */ - var_print ("COB_OBJECT_EXT", COB_OBJECT_EXT, "", 0); - var_print ("COB_EXE_EXT", COB_EXE_EXT, "", 0); -#endif - -#if defined (USE_LIBDL) || defined (_WIN32) - var_print (_("dynamic loading"), "system", "", 0); -#else - var_print (_("dynamic loading"), "libtool", "", 0); -#endif - -#if 0 /* Simon: only a marginal performance influence - removed from output */ -#ifdef COB_PARAM_CHECK - var_print ("\"CBL_\" param check", _("enabled"), "", 0); -#else - var_print ("\"CBL_\" param check", _("disabled"), "", 0); -#endif -#endif - -#ifdef COB_64_BIT_POINTER - var_print ("64bit-mode", _("yes"), "", 0); -#else - var_print ("64bit-mode", _("no"), "", 0); -#endif - -#ifdef COB_LI_IS_LL - var_print ("BINARY-C-LONG", _("8 bytes"), "", 0); -#else - var_print ("BINARY-C-LONG", _("4 bytes"), "", 0); -#endif - -#ifdef WORDS_BIGENDIAN - var_print (_("endianness"), _("big-endian"), "", 0); -#else - var_print (_("endianness"), _("little-endian"), "", 0); -#endif - -#ifdef COB_EBCDIC_MACHINE - var_print (_("native character set"), _("EBCDIC"), "", 0); -#else - var_print (_("native character set"), _("ASCII"), "", 0); -#endif - -#if !defined (__PDCURSES__) && !defined (NCURSES_VERSION) - var_print (_("extended screen I/O"), WITH_CURSES, "", 0); -#else -#if defined (__PDCURSES__) -#if defined (PDC_VER_MAJOR) -#define CURSES_CMP_MAJOR PDC_VER_MAJOR -#define CURSES_CMP_MINOR PDC_VER_MINOR -#if PDC_VER_MAJOR == 3 && PDC_BUILD >= 3703 -#define RESOLVED_PDC_VER - { - PDC_VERSION ver; - PDC_get_version (&ver); - major = ver.major; - minor = ver.minor; - patch = 0; - opt1 = ver.csize * 8; - opt2 = ver.flags & PDC_VFLAG_WIDE; - opt3 = ver.flags & PDC_VFLAG_UTF8; - } -#elif defined (PDC_HAS_VERSION_INFO) -#define RESOLVED_PDC_VER - { - major = PDC_version.ver_major; - minor = PDC_version.ver_minor; - patch = PDC_version.ver_change; - opt1 = PDC_version.chtype_size * 8; - opt2 = PDC_version.is_wide; - opt3 = PDC_version.is_forced_utf8; - } -#endif -#else -#define CURSES_CMP_MAJOR (PDC_BUILD / 1000) -#define CURSES_CMP_MINOR (PDC_BUILD - CURSES_CMP_MAJOR * 1000) / 100 - COB_UNUSED (opt1); - COB_UNUSED (opt2); - COB_UNUSED (opt3); -#endif -#elif defined (NCURSES_VERSION) -#define CURSES_CMP_MAJOR NCURSES_VERSION_MAJOR -#define CURSES_CMP_MINOR NCURSES_VERSION_MINOR -#endif -#if !defined (RESOLVED_PDC_VER) - snprintf (versbuff2, 100, "%s", curses_version ()); - major = 0, minor = 0, patch = 0; - if ((sscanf (versbuff2, "%s %s %d.%d.%d", (char *)&versbuff, (char *)&versbuff, &major, &minor, &patch) < 4) - && (sscanf (versbuff2, "%s %d.%d.%d", (char *)&versbuff, &major, &minor, &patch) < 3) - && (sscanf (versbuff2, "%d.%d.%d", &major, &minor, &patch) < 2)) { - major = 0, minor = 0; - } -#endif - if (major == CURSES_CMP_MAJOR && minor == CURSES_CMP_MINOR) { - snprintf (versbuff, 55, _("%s, version %d.%d.%d"), WITH_CURSES, major, minor, patch); - } else if (major != 0) { - snprintf (versbuff, 55, _("%s, version %d.%d.%d (compiled with %d.%d)"), - WITH_CURSES, major, minor, patch, CURSES_CMP_MAJOR, CURSES_CMP_MINOR); - } else { - snprintf (versbuff, 55, _("%s, version %s"), WITH_CURSES, versbuff2); - } -#ifdef RESOLVED_PDC_VER - snprintf (versbuff2, 114, "%s CHTYPE=%d(%d), WIDE=%d(%d), UTF-8=%d", versbuff, - opt1, (int)sizeof (chtype) * 8, wide, opt2, opt3); -#undef RESOLVED_PDC_VER -#else - snprintf (versbuff2, 114, "%s (CHTYPE=%d, WIDE=%d)", versbuff, - (int)sizeof (chtype) * 8, wide); -#endif -#endif - var_print (_("extended screen I/O"), versbuff2, "", 0); - -#ifdef HAVE_HAS_MOUSE - { - int mouse_available = 0; - initscr (); - mousemask (ALL_MOUSE_EVENTS, NULL); - if (has_mouse () == TRUE) mouse_available = 1; - endwin (); - if (mouse_available) { - var_print (_("mouse support"), _("yes"), "", 0); - } else { - var_print (_("mouse support"), _("no"), "", 0); - } - } -#elif defined (NCURSES_MOUSE_VERSION) -#if defined (__PDCURSES__) - var_print (_("mouse support"), _("yes"), "", 0); -#else - var_print (_("mouse support"), _("unknown"), "", 0); -#endif -#else - var_print (_("mouse support"), _("disabled"), "", 0); -#endif - - snprintf (buff, sizeof (buff), "%d", WITH_VARSEQ); - var_print (_("variable file format"), buff, "", 0); - if ((s = getenv ("COB_VARSEQ_FORMAT")) != NULL) { - var_print ("COB_VARSEQ_FORMAT", s, "", 1); - } - -#ifdef WITH_SEQRA_EXTFH - var_print (_("sequential file handler"), "EXTFH (obsolete)", "", 0); -#else - var_print (_("sequential file handler"), _("built-in"), "", 0); -#endif - -#if defined(WITH_INDEX_EXTFH) || defined(WITH_CISAM) || defined(WITH_DISAM) \ - || defined(WITH_VBISAM) || defined(WITH_DB) || defined(WITH_LMDB) -#if defined (WITH_INDEX_EXTFH) - var_print (_("indexed file handler"), "EXTFH (obsolete)", "", 0); -#endif -#if defined (WITH_DB) - major = 0, minor = 0, patch = 0; - db_version (&major, &minor, &patch); - if (major == DB_VERSION_MAJOR && minor == DB_VERSION_MINOR) { - snprintf (versbuff, 55, "%s, version %d.%d.%d", "BDB", major, minor, patch); - } else { - snprintf (versbuff, 55, "%s, version %d.%d.%d (compiled with %d.%d)", - "BDB", major, minor, patch, DB_VERSION_MAJOR, DB_VERSION_MINOR); - } - var_print (_("indexed file handler"), versbuff, "", 0); -#endif -#if defined (WITH_LMDB) -#if defined(MDB_VERSION_MAJOR) && defined(MDB_VERSION_MINOR) && defined(MDB_VERSION_PATCH) - snprintf (versbuff, 55, "%s, compiled %d.%d.%d", - "LMDB", MDB_VERSION_MAJOR, MDB_VERSION_MINOR,MDB_VERSION_PATCH); - var_print (_("indexed file handler"), versbuff, "", 0); -#else - var_print (_("indexed file handler"), "LMDB", "", 0); -#endif -#endif -#if defined (WITH_CISAM) - var_print (_("indexed file handler"), "C-ISAM", "", 0); -#endif -#if defined (WITH_DISAM) - var_print (_("indexed file handler"), "D-ISAM", "", 0); -#endif -#if defined (WITH_VBISAM) -#if defined (VB_RTD) - var_print (_("indexed file handler"), "VB-ISAM (RTD)", "", 0); -#else - var_print (_("indexed file handler"), "VB-ISAM", "", 0); -#endif -#endif -#if defined (WITH_ODBC) -#if defined (SQL_SPEC_STRING) - var_print (_("indexed file handler"), "ODBC " SQL_SPEC_STRING, "", 0); -#else - var_print (_("indexed file handler"), "ODBC", "", 0); -#endif -#endif -#if defined (WITH_OCI) -#if defined(OCI_MAJOR_VERSION) && defined(OCI_MINOR_VERSION) - snprintf (versbuff, 55, "%s - %d.%d", - "OCI (Oracle)", OCI_MAJOR_VERSION, OCI_MINOR_VERSION); - var_print (_("indexed file handler"), versbuff, "", 0); -#else - var_print (_("indexed file handler"), "OCI (Oracle)", "", 0); -#endif -#endif -#if defined(WITH_IXDFLT) && defined(WITH_MULTI_ISAM) - var_print (_("default indexed handler"), WITH_IXDFLT, "", 0); -#endif -#else - var_print (_("indexed file handler"), _("disabled"), "", 0); -#endif - - major = 0, minor = 0, patch = 0; - (void)sscanf (gmp_version, "%d.%d.%d", &major, &minor, &patch); - if (major == __GNU_MP_VERSION && minor == __GNU_MP_VERSION_MINOR) { - snprintf (versbuff, 55, _("%s, version %d.%d.%d"), "GMP", major, minor, patch); - } else { - snprintf (versbuff, 55, _("%s, version %d.%d.%d (compiled with %d.%d)"), - "GMP", major, minor, patch, __GNU_MP_VERSION, __GNU_MP_VERSION_MINOR); - } -#if defined (mpir_version) - major = 0, minor = 0, patch = 0; - (void)sscanf (mpir_version, "%d.%d.%d", &major, &minor, &patch); - if (major == __MPIR_VERSION && minor == __MPIR_VERSION_MINOR) { - snprintf (versbuff2, 55, _("%s, version %d.%d.%d"), "MPIR", major, minor, patch); - } else { - snprintf (versbuff2, 55, _("%s, version %d.%d.%d (compiled with %d.%d)"), - "MPIR", major, minor, patch, __MPIR_VERSION, __MPIR_VERSION_MINOR); - } - versbuff[55] = versbuff2[55] = 0; /* silence VS analyzer */ - strncat (versbuff2, " - ", 3); - strncat (versbuff2, versbuff, 55); - var_print (_("mathematical library"), versbuff2, "", 0); -#else - var_print (_("mathematical library"), versbuff, "", 0); -#endif - -#ifdef WITH_XML2 - major = LIBXML_VERSION / 10000; - minor = (LIBXML_VERSION - major * 10000) / 100 ; - patch = LIBXML_VERSION - major * 10000 - minor * 100; - snprintf (versbuff, 55, _("%s, version %d.%d.%d"), - "libxml2", major, minor, patch); - var_print (_("XML library"), versbuff, "", 0); - LIBXML_TEST_VERSION -#if defined (HAVE_LIBXML_XMLWRITER_H) && HAVE_LIBXML_XMLWRITER_H - xmlCleanupParser (); -#endif -#else - var_print (_("XML library"), _("disabled"), "", 0); -#endif - -#ifdef WITH_CJSON - major = 0, minor = 0, patch = 0; - (void)sscanf (cJSON_Version(), "%d.%d.%d", &major, &minor, &patch); - if (major == CJSON_VERSION_MAJOR && minor == CJSON_VERSION_MINOR) { - snprintf (versbuff, 55, _("%s, version %d.%d.%d"), "cJSON", major, minor, patch); - } else { - snprintf (versbuff, 55, _("%s, version %d.%d.%d (compiled with %d.%d)"), - "cJSON", major, minor, patch, CJSON_VERSION_MAJOR, CJSON_VERSION_MINOR); - } - var_print (_("JSON library"), versbuff, "", 0); -#else - var_print (_("JSON library"), _("disabled"), "", 0); -#endif -} - -void -print_runtime_conf () -{ - unsigned int i, j, k, vl, dohdg, hdlen, plen, plen2; - char value[COB_MEDIUM_BUFF], orgvalue[COB_MINI_BUFF]; - -#ifdef ENABLE_NLS /* note: translated version of definition values */ - setting_group[1] = _("CALL configuration"); - setting_group[2] = _("File I/O configuration"); - setting_group[3] = _("Screen I/O configuration"); - setting_group[4] = _("Miscellaneous"); - setting_group[5] = _("System configuration"); -#endif - - printf ("%s %s.%d ", PACKAGE_NAME, PACKAGE_VERSION, PATCH_LEVEL); - puts (_("runtime configuration")); - if (cobsetptr->cob_config_file) { - strncpy (value, _("via"), (size_t)COB_MEDIUM_MAX); - value[COB_MEDIUM_MAX] = 0; - hdlen = (unsigned int)strlen (value) + 3; - - /* output path of main configuration file */ - printf (" %s ", value); - plen = 80 - hdlen; - strncpy (value, cobsetptr->cob_config_file[0], (size_t)COB_MEDIUM_MAX); - value[COB_MEDIUM_MAX] = 0; - vl = (unsigned int)strlen (value); - for (k = 0; vl > plen; vl -= plen, k += plen) { - printf ("%.*s\n%-*s", plen, &value[k], hdlen, ""); - } - printf ("%s\n", &value[k]); - - /* output path of additional configuration files */ - for (i = 1; i < cobsetptr->cob_config_num; i++) { - printf ("%*d ", hdlen - 2, i); - strncpy (value, cobsetptr->cob_config_file[i], (size_t)COB_MEDIUM_MAX); - value[COB_MEDIUM_MAX] = 0; - vl = (unsigned int)strlen (value); - for (k = 0; vl > plen; vl -= plen, k += plen) { - printf ("%.*s\n%-*s", plen, &value[k], hdlen, ""); - } - printf ("%s\n", &value[k]); - } - - } - putchar ('\n'); - strcpy (value, "todo"); - hdlen = 15; - for (i = 0; i < NUM_CONFIG; i++) { - j = (unsigned int)strlen (gc_conf[i].env_name); - if (j > hdlen) - hdlen = j; - j = (unsigned int)strlen (gc_conf[i].conf_name); - if (j > hdlen) - hdlen = j; - } - - for (j = 1; j < GRP_MAX; j++) { - dohdg = 1; - for (i = 0; i < NUM_CONFIG; i++) { - if (gc_conf[i].env_group == (int)j) { - if (dohdg) { - dohdg = 0; - if (j > 1) { - putchar ('\n'); - } - printf (" %s\n", setting_group[j]); - } - /* Convert value back into string and display it */ - get_config_val (value, i, orgvalue); - if ((gc_conf[i].data_type & STS_ENVSET) - || (gc_conf[i].data_type & STS_FNCSET)) { - putchar (' '); - if (gc_conf[i].data_type & STS_FNCSET) { - printf (" "); - } else if ((gc_conf[i].data_type & STS_CNFSET)) { - printf ("Ovr"); - } else { - printf ("env"); - if (gc_conf[i].data_loc == (int)offsetof(cob_settings,cob_preload_str) - && cobsetptr->cob_preload_str_set != NULL) { - printf (": %-*s : ", hdlen, gc_conf[i].env_name); - printf ("%s\n", cobsetptr->cob_preload_str_set); - printf ("eval"); - } - } - printf (": %-*s : ", hdlen, gc_conf[i].env_name); - } else if ((gc_conf[i].data_type & STS_CNFSET)) { - if ((gc_conf[i].data_type & STS_ENVCLR)) { - printf (" : %-*s : ", hdlen, gc_conf[i].env_name); - puts (_("... removed from environment")); - } - if (gc_conf[i].config_num > 0) { - printf (" %d ", gc_conf[i].config_num); - } else { - printf (" "); - } - if (gc_conf[i].data_loc == (int)offsetof(cob_settings,cob_preload_str) - && cobsetptr->cob_preload_str_set != NULL) { - printf (": %-*s : ",hdlen, - gc_conf[i].set_by > 0 ? gc_conf[i].env_name - : gc_conf[i].conf_name); - printf ("%s\n",cobsetptr->cob_preload_str_set); - printf ("eval"); - } - if (gc_conf[i].set_by > 0) { - printf (": %-*s : ", hdlen, gc_conf[i].env_name); - } else { - printf (": %-*s : ", hdlen, gc_conf[i].conf_name); - } - } else if (gc_conf[i].env_name) { - if (gc_conf[i].config_num > 0){ - printf (" %d ", gc_conf[i].config_num); - } else { - printf (" "); - } - printf (": %-*s : ", hdlen, gc_conf[i].env_name); - if ((gc_conf[i].data_type & STS_ENVCLR)) { - puts (_("... removed from environment")); - continue; - } - } else { - printf (" : %-*s : ", hdlen, gc_conf[i].conf_name); - } - vl = (unsigned int)strlen (value); - plen = 71 - hdlen; - if (vl < (unsigned int)min_conf_length) { - plen2 = min_conf_length - vl; - } else if (vl == (unsigned int)min_conf_length) { - plen2 = 1; - } else { - plen2 = 0; - } - for (k = 0; vl > plen; vl -= plen, k += plen) { - printf ("%.*s\n %-*s : ", plen, &value[k], hdlen, ""); - } - printf ("%s", &value[k]); - printf ("%.*s", plen2, " "); - if (orgvalue[0]) { - printf (" (%s)", orgvalue); - } - if (gc_conf[i].set_by != 0) { - putchar (' '); - if (gc_conf[i].set_by != FUNC_NAME_IN_DEFAULT) { - printf (_("(set by %s)"), gc_conf[gc_conf[i].set_by].env_name); - } else { - printf (_("(set by %s)"), gc_conf[i].default_val); - } - } - if (!(gc_conf[i].data_type & STS_ENVSET) - && !(gc_conf[i].data_type & STS_CNFSET) - && !(gc_conf[i].data_type & STS_FNCSET)) { - putchar (' '); - if ((gc_conf[i].data_type & STS_RESET)) { - printf (_("(reset)")); - } else if (strcmp (value, not_set) != 0) { - printf (_("(default)")); - } - } - putchar ('\n'); - } - } - } - - -#ifdef HAVE_SETLOCALE - printf (" : %-*s : %s\n", hdlen, "LC_CTYPE", (char *) setlocale (LC_CTYPE, NULL)); - printf (" : %-*s : %s\n", hdlen, "LC_NUMERIC", (char *) setlocale (LC_NUMERIC, NULL)); - printf (" : %-*s : %s\n", hdlen, "LC_COLLATE", (char *) setlocale (LC_COLLATE, NULL)); -#ifdef LC_MESSAGES - printf (" : %-*s : %s\n", hdlen, "LC_MESSAGES", (char *) setlocale (LC_MESSAGES, NULL)); -#endif - printf (" : %-*s : %s\n", hdlen, "LC_MONETARY", (char *) setlocale (LC_MONETARY, NULL)); - printf (" : %-*s : %s\n", hdlen, "LC_TIME", (char *) setlocale (LC_TIME, NULL)); -#endif -} - -cob_settings * -cob_get_settings_ptr () -{ - return cobsetptr; -} - -void -cob_init_nomain (const int argc, char **argv) -{ - check_mainhandle = 0; - cob_init (argc, argv); -} - -void -cob_common_init (void *setptr) -{ -#ifdef ENABLE_NLS - { - struct stat localest; - const char * localedir; - - localedir = getenv ("LOCALEDIR"); - if (localedir != NULL - && !stat (localedir, &localest) - && (S_ISDIR (localest.st_mode))) { - bindtextdomain (PACKAGE, localedir); - } else { - bindtextdomain (PACKAGE, LOCALEDIR); - } - textdomain (PACKAGE); - } -#endif - -#ifdef _WIN32 - /* Allows running tests under Win */ - { - int use_unix_lf = 0; - char *s = getenv ("COB_UNIX_LF"); - - if (s != NULL) { - if (setptr) { - set_config_val_by_name (s, "unix_lf", NULL); - use_unix_lf = cobsetptr->cob_unix_lf; - } else - if (*s == 'Y' || *s == 'y' || - *s == 'O' || *s == 'o' || - *s == 'T' || *s == 't' || - *s == '1') { - use_unix_lf = 1; - } - } - if (use_unix_lf) { - (void)_setmode (_fileno (stdin), _O_BINARY); - (void)_setmode (_fileno (stdout), _O_BINARY); - (void)_setmode (_fileno (stderr), _O_BINARY); - } - } -#endif -} - -void -cob_init (const int argc, char **argv) -{ - char *s; -#if defined (HAVE_READLINK) || defined (HAVE_GETEXECNAME) - const char *path; -#endif - int i; - -#if 0 /* Simon: Should not happen - is it necessary anywhere? - We may change this to a runtime warning/error */ - if (cob_initialized) { - return; - } -#endif - - cob_set_signal (); - - cob_alloc_base = NULL; - cob_local_env = NULL; - cob_last_sfile = NULL; - commlnptr = NULL; - basext = NULL; - sort_keys = NULL; - sort_collate = NULL; - cob_current_program_id = NULL; - cob_current_section = NULL; - cob_current_paragraph = NULL; - cob_source_file = NULL; - cob_source_statement = NULL; - exit_hdlrs = NULL; - hdlrs = NULL; - commlncnt = 0; - sort_nkeys = 0; - cob_source_line = 0; - cob_local_env_size = 0; - - current_arg = 1; - - cob_argc = argc; - cob_argv = argv; - - /* Get emergency buffer */ - runtime_err_str = cob_fast_malloc ((size_t)COB_ERRBUF_SIZE); - - /* Get global structure */ - cobglobptr = cob_malloc (sizeof (cob_global)); - cobglobptr->cob_call_params = 0; - - /* Get settings structure */ - cobsetptr = cob_malloc (sizeof (cob_settings)); - - cob_initialized = 1; - -#ifdef HAVE_SETLOCALE - /* Prime the locale from user settings */ - s = setlocale (LC_ALL, ""); - if (s) { - /* Save initial values */ - cobglobptr->cob_locale_orig = cob_strdup (s); - s = setlocale (LC_CTYPE, NULL); - if (s) { - cobglobptr->cob_locale_ctype = cob_strdup (s); - } - s = setlocale (LC_COLLATE, NULL); - if (s) { - cobglobptr->cob_locale_collate = cob_strdup (s); - } -#ifdef LC_MESSAGES - s = setlocale (LC_MESSAGES, NULL); - if (s) { - cobglobptr->cob_locale_messages = cob_strdup (s); - } -#endif - s = setlocale (LC_MONETARY, NULL); - if (s) { - cobglobptr->cob_locale_monetary = cob_strdup (s); - } - s = setlocale (LC_NUMERIC, NULL); - if (s) { - cobglobptr->cob_locale_numeric = cob_strdup (s); - } - s = setlocale (LC_TIME, NULL); - if (s) { - cobglobptr->cob_locale_time = cob_strdup (s); - } - /* Set to standard "C" locale for COBOL */ - setlocale (LC_NUMERIC, "C"); - setlocale (LC_CTYPE, "C"); - /* Save changed locale */ - s = setlocale (LC_ALL, NULL); - if (s) { - cobglobptr->cob_locale = cob_strdup (s); - } - } -#endif - - cob_common_init (cobsetptr); - - /* Load runtime configuration file */ - if (unlikely (cob_load_config () < 0)) { - cob_stop_run (1); - } - - /* Copy COB_PHYSICAL_CANCEL from settings (internal) to global structure */ - cobglobptr->cob_physical_cancel = cobsetptr->cob_physical_cancel; - -#ifdef COB_DEBUG_LOG - /* Internal Debug Log */ - if (cobsetptr->cob_debug_log) { - cob_debug_open (); - } -#endif - - /* Call inits with cobsetptr to get the addresses of all */ - /* Screen-IO might be needed for error outputs */ - cob_init_screenio (cobglobptr, cobsetptr); - cob_init_numeric (cobglobptr); - cob_init_strings (cobglobptr); - cob_init_move (cobglobptr, cobsetptr); - cob_init_intrinsic (cobglobptr); - cob_init_fileio (cobglobptr, cobsetptr); - cob_init_call (cobglobptr, cobsetptr, check_mainhandle); - cob_init_termio (cobglobptr, cobsetptr); - cob_init_reportio (cobglobptr, cobsetptr); - cob_init_mlio (cobglobptr); - - /* Set up library routine stuff */ - cobglobptr->cob_term_buff = cob_malloc ((size_t)COB_MEDIUM_BUFF); - - /* Set switches */ - for (i = 0; i <= COB_SWITCH_MAX; ++i) { - sprintf (runtime_err_str, "COB_SWITCH_%d", i); - s = getenv (runtime_err_str); - if (s && (*s == '1' || strcasecmp (s, "ON") == 0)) { - cob_switch[i] = 1; - } else { - cob_switch[i] = 0; - } - } - - /* Get user name if not set via environment already */ - if (cobsetptr->cob_user_name == NULL) { -#if defined (_WIN32) - /* note: only defined manual (needs additional link to advapi32): */ -#if defined (HAVE_GETUSERNAME) - unsigned long bsiz = COB_ERRBUF_SIZE; - if (GetUserName (runtime_err_str, &bsiz)) { - set_config_val_by_name (runtime_err_str, "username", "GetUserName()"); - } -#endif -#elif !defined(__OS400__) - s = getlogin (); - if (s) { - set_config_val_by_name (s, "username", "getlogin()"); - } -#endif -#if 0 /* likely not needed, if unset then empty */ - if (cobsetptr->cob_user_name == NULL) { - set_config_val_by_name (_("unknown"), "username", "cob_init()"); - } -#endif - } - -#if defined(_MSC_VER) && COB_USE_VC2008_OR_GREATER - get_function_ptr_for_precise_time (); -#endif - - /* This must be last in this function as we do early return */ - /* from certain ifdef's */ - -#ifdef _WIN32 - s = cob_malloc ((size_t)COB_LARGE_BUFF); - i = GetModuleFileNameA (NULL, s, COB_LARGE_MAX); - if (i > 0 && i < COB_LARGE_BUFF) { - cobglobptr->cob_main_argv0 = cob_strdup (s); - cob_free (s); - return; - } - cob_free (s); -#elif defined (HAVE_READLINK) - path = NULL; - if (!access ("/proc/self/exe", R_OK)) { - path = "/proc/self/exe"; - } else if (!access ("/proc/curproc/file", R_OK)) { - path = "/proc/curproc/file"; - } else if (!access ("/proc/self/path/a.out", R_OK)) { - path = "/proc/self/path/a.out"; - } - if (path) { - s = cob_malloc ((size_t)COB_LARGE_BUFF); - i = (int)readlink (path, s, (size_t)COB_LARGE_MAX); - if (i > 0 && i < COB_LARGE_BUFF) { - s[i] = 0; - cobglobptr->cob_main_argv0 = cob_strdup (s); - cob_free (s); - return; - } - cob_free (s); - } -#endif - -#ifdef HAVE_GETEXECNAME - path = getexecname (); - if (path) { -#ifdef HAVE_REALPATH - s = cob_malloc ((size_t)COB_LARGE_BUFF); - if (realpath (path, s) != NULL) { - cobglobptr->cob_main_argv0 = cob_strdup (s); - } else { - cobglobptr->cob_main_argv0 = cob_strdup (path); - } - cob_free (s); -#else - cobglobptr->cob_main_argv0 = cob_strdup (path); -#endif - return; - } -#endif - - if (argc && argv && argv[0]) { -#ifdef _WIN32 - /* Returns malloced path or NULL */ - cobglobptr->cob_main_argv0 = _fullpath (NULL, argv[0], 1); -#elif defined (HAVE_CANONICALIZE_FILE_NAME) - /* Returns malloced path or NULL */ - cobglobptr->cob_main_argv0 = canonicalize_file_name (argv[0]); -#elif defined (HAVE_REALPATH) - s = cob_malloc ((size_t)COB_LARGE_BUFF); - if (realpath (argv[0], s) != NULL) { - cobglobptr->cob_main_argv0 = cob_strdup (s); - } - cob_free (s); -#endif - if (!cobglobptr->cob_main_argv0) { - cobglobptr->cob_main_argv0 = cob_strdup (argv[0]); - } - } else { - cobglobptr->cob_main_argv0 = cob_strdup (_("unknown")); - } - /* The above must be last in this function as we do early return */ - /* from certain ifdef's */ -} - -/* Compute a hash value based on the string given */ -unsigned int -cob_get_name_hash (const char *name) -{ - unsigned int hash; - int i, ch; - hash = 0x074FADE1; /* Seed value to agitate the bits */ - for (i=0; name[i] != 0; i++) { - if(islower(name[i])) - ch = toupper(name[i]); - else - ch = name[i]; - hash = (hash << 5) | (hash >> 27); - hash = hash + ((ch & 0x7F) * (i + 3)); - } - if (hash == 0) - hash = 1; - return hash; -} - -/* - * Set special runtime options: - * Currently this is only FILE * for trace and printer output - * or to reload the runtime configuration after changing environment - */ -void -cob_set_runtime_option (enum cob_runtime_option_switch opt, void *p) -{ - switch (opt) { - case COB_SET_RUNTIME_TRACE_FILE: - cobsetptr->cob_trace_file = (FILE *)p; - if (p) { - cobsetptr->external_trace_file = 1; - } else { - cobsetptr->external_trace_file = 0; - } - break; - case COB_SET_RUNTIME_DISPLAY_PRINTER_FILE: - /* note: if set cob_display_print_file is always external */ - cobsetptr->cob_display_print_file = (FILE *)p; - break; - case COB_SET_RUNTIME_DISPLAY_PUNCH_FILE: - /* note: if set cob_display_punch_file is always external */ - if (cobsetptr->cob_display_punch_filename != NULL) { - /* if previously opened by libcob: close and free pointer to filename */ - if (cobsetptr->cob_display_punch_file != NULL) { - fclose (cobsetptr->cob_display_punch_file); - } - cob_free (cobsetptr->cob_display_punch_filename); - cobsetptr->cob_display_punch_filename = NULL; - } - cobsetptr->cob_display_punch_file = (FILE *)p; - break; - case COB_SET_RUNTIME_RESCAN_ENV: - cob_rescan_env_vals (); - break; - default: - cob_runtime_warning (_("%s called with unknown option: %d"), - "cob_set_runtime_option", opt); - } - return; -} - -FILE * -cob_get_dump_file (void) -{ -#if 1 /* new version as currently only COB_DUMP_TO_FILE is used */ - if (cobsetptr->cob_dump_file != NULL) { /* If DUMP active, use that */ - return cobsetptr->cob_dump_file; - } else if (cobsetptr->cob_dump_filename != NULL) { /* Dump file defined */ - cobsetptr->cob_dump_file = fopen (cobsetptr->cob_dump_filename, "a"); - if (cobsetptr->cob_dump_file != NULL) { - return cobsetptr->cob_dump_file; - } - } - if (cobsetptr->cob_trace_file != NULL) { /* If TRACE active, use that */ - return cobsetptr->cob_trace_file; - } else { - return stderr; - } -#else /* currently only COB_DUMP_TO_FILE used */ - FILE *fp; - if (where == COB_DUMP_TO_FILE) { - fp = cobsetptr->cob_dump_file; - if (fp == NULL) { - if(cobsetptr->cob_trace_file != NULL) { /* If TRACE active, use that */ - fp = cobsetptr->cob_trace_file; - } else if(cobsetptr->cob_dump_filename != NULL) { /* Dump file defined */ - fp = fopen(cobsetptr->cob_dump_filename, "a"); - if(fp == NULL) - fp = stderr; - cobsetptr->cob_dump_file = fp; - } else { - fp = stderr; - } - } - } else if (where == COB_DUMP_TO_PRINT) { - fp = cobsetptr->cob_display_print_file; - if (fp == NULL) { - if(cobsetptr->cob_trace_file != NULL) { /* If TRACE active, use that */ - fp = cobsetptr->cob_trace_file; - } else { - fp = stdout; - } - } - } else { - fp = stderr; - } - return fp; -#endif -} - -static void -cob_dump_module (char *reason) -{ - cob_module *mod; - FILE *fp; - int (*cancel_func)(const int); - int num_stmts = 0; - - if (COB_MODULE_PTR - && COB_MODULE_PTR->flag_dump_ready) { /* Was it compiled with -fdump= */ - fflush (stdout); - fflush (stderr); -#if 1 /* new version as currently only COB_DUMP_TO_FILE is used */ - fp = cob_get_dump_file(); -#else - fp = cob_get_dump_file(COB_DUMP_TO_FILE); -#endif - fprintf (fp, _("Module dump due to %s\n"), reason); - for (mod = COB_MODULE_PTR; mod; mod = mod->next) { - if (mod->module_stmt != 0 - && mod->module_sources) { - fprintf (fp,_(" Last statement of %s was Line %d of %s\n"), - mod->module_name, - COB_GET_LINE_NUM(mod->module_stmt), - mod->module_sources[COB_GET_FILE_NUM(mod->module_stmt)]); - num_stmts++; - } else { - fprintf (fp,_(" Last statement of %s unknown\n"), mod->module_name); - } - } - if (num_stmts == 0) { - return; - } - fprintf(fp,"\n"); - for (mod = COB_MODULE_PTR; mod; mod = mod->next) { - if (mod->module_cancel.funcint) { - cancel_func = mod->module_cancel.funcint; - fprintf (fp, _("Dump Program-Id %s from %s compiled %s\n"), - mod->module_name, mod->module_source, mod->module_formatted_date); - (void)cancel_func (-10); - fprintf (fp,"\n"); - } - } - } -} - -/* - * Return current value of special runtime options - */ -void * -cob_get_runtime_option (enum cob_runtime_option_switch opt) -{ - switch(opt) { - case COB_SET_RUNTIME_TRACE_FILE: - return (void*)cobsetptr->cob_trace_file; - case COB_SET_RUNTIME_DISPLAY_PRINTER_FILE: - return (void*)cobsetptr->cob_display_print_file; - case COB_SET_RUNTIME_DISPLAY_PUNCH_FILE: - /* only externalize if not aquired by libcob */ - if (cobsetptr->cob_display_punch_filename != NULL) { - return NULL; - } - return (void*)cobsetptr->cob_display_punch_file; - default: - cob_runtime_error (_("%s called with unknown option: %d"), - "cob_get_runtime_option", opt); - } - return NULL; -} - -/* - * Allocate field attribute; - * Used by subroutine entry when called by C code - */ -cob_field_attr * -cob_alloc_attr(int type, int digits, int scale, int flags) -{ - struct dyn_attr *da; - for (da = dyn_attr_list; da; da = da-> next) { - if (da->attr.type == type - && da->attr.digits == digits - && da->attr.scale == scale - && da->attr.flags == flags) - return &da->attr; - } - da = cob_cache_malloc (sizeof(struct dyn_attr)); - da->next = dyn_attr_list; - dyn_attr_list = da; - da->attr.type = (unsigned short)type; - da->attr.digits = (unsigned short)digits; - da->attr.scale = (short)scale; - da->attr.flags = (unsigned short)flags; - return &da->attr; -} - -#ifdef COB_DEBUG_LOG -/******************************/ -/* Routines for COB_DEBUG_LOG */ -/******************************/ - -/* Check env var value and open log file */ -/* - * Env var is COB_DEBUG_LOG - * Env Var string is a series of keyword=value parameters where keywords: - * L=x - options: T for trace level, W for warnings, N for normal, A for ALL - * M=yy - module: RW for report writer, the 2 char code is tabled and compared - * with the value coded on DEBUG_LOG("yy",("format",args)); - * O=path/file - file name to write log data to, default is: cob_debug_log.$$ - * note: replacements already done in common setting handling - */ -void -cob_debug_open (void) -{ - char *debug_env = cobsetptr->cob_debug_log; - int i, j; - char module_name[4]; - char log_opt; - char logfile[COB_SMALL_BUFF]; - - logfile[0] = 0; - - for (i=0; debug_env[i] != 0; i++) { - /* skip separator */ - if (debug_env[i] == ',' - || debug_env[i] == ';') - continue; - - /* debugging flags (not include in file name) */ - if (debug_env[i + 1] == '=') { - log_opt = toupper (debug_env[i]); - i += 2; - - switch (log_opt) { - - case 'M': /* module to debug */ - for (j = 0; j < DEBUG_MOD_LEN; i++) { - if (debug_env[i] == ',' - || debug_env[i] == ';' - || debug_env[i] == 0) { - break; - } - module_name[j++] = debug_env[i]; - } - module_name[j] = 0; - /* note: special module ALL is checked later */ - for (j = 0; j < DEBUG_MOD_MAX && cob_debug_modules[j][0] > ' '; j++) { - if (strcasecmp (cob_debug_modules[j], module_name) == 0) { - break; - } - } - if (j < DEBUG_MOD_MAX && cob_debug_modules[j][0] <= ' ') { - strcpy (cob_debug_modules[j], module_name); - } - if (debug_env[i] == 0) i--; - break; - - case 'L': /* logging options */ - log_opt = toupper (debug_env[i]); - switch (log_opt) { - case 'T': /* trace */ - cob_debug_log_time = cob_debug_level = 3; - break; - case 'W': /* warnings */ - cob_debug_level = 2; - break; - case 'N': /* normal */ - cob_debug_level = 0; - break; - case 'A': /* all */ - cob_debug_level = 9; - break; - default: /* Unknown log option, just ignored for now */ - i--; - break; - } - break; - - case 'O': /* output name for logfile */ - for (j = 0; j < COB_SMALL_MAX; i++) { - if (debug_env[i] == ',' - || debug_env[i] == ';' - || debug_env[i] == 0) { - break; - } - logfile[j++] = debug_env[i]; - } - logfile[j] = 0; - if (debug_env[i] == 0) i--; - break; - - default: /* Unknown x=, just ignored for now */ - break; - } - } else { - /* invalid character, just ignored for now */ - /* note: this allows for L=WARNING (but also for L=WUMPUS) */ - } - } - - /* set default logfile if not given */ - if (logfile[0] == 0) { - sprintf (logfile, "cob_debug_log.%d", cob_sys_getpid()); - } - /* store filename for possible unlink (empty log file) */ - cob_debug_file_name = cob_strdup (logfile); - - /* ensure trace file is open if we use this as debug log and exit */ - if (cobsetptr->cob_trace_filename - && strcmp (cobsetptr->cob_trace_filename, cob_debug_file_name) == 0) { - cob_check_trace_file (); - cob_debug_file = cobsetptr->cob_trace_file; - return; - } - - /* open logfile */ - cob_debug_file = cob_open_logfile (cob_debug_file_name); - if (cob_debug_file == NULL) { - /* developer-only msg - not translated */ - cob_runtime_error ("error '%s' opening COB_DEBUG_LOG '%s', resolved from '%s'", - cob_get_strerror (), cob_debug_file_name, cobsetptr->cob_debug_log); - return; - } -} - -/* Determine if DEBUGLOG is to be allowed */ -int -cob_debug_logit (int level, char *module) -{ - int i; - if (cob_debug_file == NULL) { - return 1; - } - if (level > cob_debug_level) { - return 1; - } - for (i=0; i < DEBUG_MOD_MAX && cob_debug_modules[i][0] > ' '; i++) { - if (strcasecmp ("ALL", cob_debug_modules[i]) == 0) { - cob_debug_mod = (char*)module; - return 0; /* Logging is allowed */ - } - if (strcasecmp (module,cob_debug_modules[i]) == 0) { - cob_debug_mod = (char*)&cob_debug_modules[i]; - return 0; /* Logging is allowed */ - } - } - return 1; -} - -/* Write logging line */ -static int cob_debug_hdr = 1; -static unsigned int cob_debug_prv_line = 0; -int -cob_debug_logger (const char *fmt, ...) -{ - va_list ap; - int ln; - struct cob_time time; - - if (cob_debug_file == NULL) { - return 0; - } - if (*fmt == '~') { /* Force line# out again to log file */ - fmt++; - cob_debug_prv_line = -1; - cob_debug_hdr = 1; - } - if (cob_debug_hdr) { - if (cob_debug_log_time) { - time = cob_get_current_date_and_time (); - fprintf (cob_debug_file, "%02d:%02d:%02d.%02d ", time.hour, time.minute, - time.second, time.nanosecond / 10000000); - } - if (cob_debug_mod) { - fprintf (cob_debug_file, "%-3s:", cob_debug_mod); - } - if (cob_source_file) { - fprintf (cob_debug_file, " %s :", cob_source_file); - } - if (cob_source_line && cob_source_line != cob_debug_prv_line) { - fprintf (cob_debug_file, "%5d : ", cob_source_line); - cob_debug_prv_line = cob_source_line; - } else { - fprintf (cob_debug_file, "%5s : ", " "); - } - cob_debug_hdr = 0; - } - va_start (ap, fmt); - vfprintf (cob_debug_file, fmt, ap); - va_end (ap); - ln = strlen(fmt); - if (fmt[ln-1] == '\n') { - cob_debug_hdr = 1; - fflush (cob_debug_file); - } - return 0; -} - -static int /* Return TRUE if word is repeated 16 times */ -repeatWord( - char *match, /* 4 bytes to match */ - char *mem) /* Memory area to match repeated value */ -{ - if(memcmp(match, &mem[0], 4) == 0 - && memcmp(match, &mem[4], 4) == 0 - && memcmp(match, &mem[8], 4) == 0 - && memcmp(match, &mem[12], 4) == 0) - return 1; - return 0; -} - -/* Hexdump of memory */ -int -cob_debug_dump (void *pMem, int len) -{ -#define dMaxPerLine 24 -#define dMaxHex ((dMaxPerLine*2)+(dMaxPerLine/4-1)) - register int i, j, k; - register char c, *mem = pMem; - char lastWord[4]; - char hex[dMaxHex+4],chr[dMaxPerLine+4]; - int adrs = 0; - - if(cob_debug_file == NULL) - return 0; - memset(lastWord,0xFD, 4); - for(i=0; i < len; ) { - for(j=k=0; j < dMaxPerLine && (i+j) < len; j++) { - k += sprintf(&hex[k],"%02X",mem[i+j]&0xFF); - if( (j % 4) == 3 ) - hex[k++] = ' '; - } - if(hex[k-1] == ' ') - hex[k-1] = 0; - hex[k] = 0; - - k = 0; - for(j=0; j= ' ' && c < 0x7f ? c : '.'; - } - chr[k++] = 0; - - fprintf (cob_debug_file," %6.6X : %-*s '%s'\n",adrs+i,dMaxHex,hex,chr); - if ((i + dMaxPerLine) < len ) - memcpy( (char *)lastWord, (char *)&mem[i+dMaxPerLine-4], j<4?j:4); - i += dMaxPerLine; - if( (i + (16*2)) < len - && repeatWord (lastWord, &mem[i]) - && repeatWord (lastWord, &mem[i+dMaxPerLine])) { - fprintf (cob_debug_file," %6.6X : ",adrs+i); - while (i < len - 16 - && repeatWord(lastWord,&mem[i])) - i += 16; - fprintf (cob_debug_file," thru %6.6X same as last word\n",adrs+i-1); - } - } - fflush (cob_debug_file); - - return 0; -} -#endif diff -Nru gnucobol-4.0~early~20200606/libcob/common.h gnucobol-5/libcob/common.h --- gnucobol-4.0~early~20200606/libcob/common.h 2020-06-06 20:52:01.000000000 +0000 +++ gnucobol-5/libcob/common.h 1970-01-01 00:00:00.000000000 +0000 @@ -1,2900 +0,0 @@ -/* - Copyright (C) 2002-2012, 2014-2019 Free Software Foundation, Inc. - Written by Keisuke Nishida, Roger While, Simon Sobisch, Ron Norman, - Edward Hart - - This file is part of GnuCOBOL. - - The GnuCOBOL runtime library is free software: you can redistribute it - and/or modify it under the terms of the GNU Lesser General Public License - as published by the Free Software Foundation, either version 3 of the - License, or (at your option) any later version. - - GnuCOBOL is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU Lesser General Public License for more details. - - You should have received a copy of the GNU Lesser General Public License - along with GnuCOBOL. If not, see . -*/ - -#ifndef COB_COMMON_H -#define COB_COMMON_H - -/* Only define cob_decimal if we have the necessary mpz_t from gmp.h/mpir.h - (or can self-define it from mp.h) */ -#ifndef __GMP_H__ -#ifndef __GNU_MP__ -#define COB_WITHOUT_DECIMAL -#else -typedef __mpz_struct mpz_t[1]; -#endif -#endif - - -/* General type defines */ -#define cob_c8_t char -#define cob_s8_t signed char -#define cob_u8_t unsigned char -#define cob_s16_t short -#define cob_u16_t unsigned short -#define cob_s32_t int -#define cob_u32_t unsigned int -#define cob_sli_t long int -#define cob_uli_t unsigned long int - -#if defined(_WIN32) && !defined(__MINGW32__) - -#define cob_s64_t __int64 -#define cob_u64_t unsigned __int64 - -#define COB_S64_C(x) x ## I64 -#define COB_U64_C(x) x ## UI64 - -#else - -#define cob_s64_t long long -#define cob_u64_t unsigned long long - -#define COB_S64_C(x) x ## LL -#define COB_U64_C(x) x ## ULL - -#endif - -#if defined(_WIN32) - -#define CB_FMT_LLD "%I64d" -#define CB_FMT_LLU "%I64u" -#define CB_FMT_LLX "%I64x" -#define CB_FMT_PLLD "%+*.*I64d" -#define CB_FMT_PLLU "%*.*I64u" - -#if defined (__MINGW32__) -#define CB_FMT_LLD_F "%I64dLL" -#define CB_FMT_LLU_F "%I64uULL" -#else -#define CB_FMT_LLD_F "%I64dI64" -#define CB_FMT_LLU_F "%I64uUI64" -#endif - -#else - -#define CB_FMT_LLD "%lld" -#define CB_FMT_LLU "%llu" -#define CB_FMT_LLX "%llx" -#define CB_FMT_PLLD "%+*.*lld" -#define CB_FMT_PLLU "%*.*llu" -#define CB_FMT_LLD_F "%lldLL" -#define CB_FMT_LLU_F "%lluULL" - -#endif - -#define cob_c8_ptr cob_c8_t * -#define cob_u8_ptr cob_u8_t * -#define cob_s8_ptr cob_s8_t * -#define cob_u16_ptr cob_u16_t * -#define cob_s16_ptr cob_s16_t * -#define cob_u32_ptr cob_u32_t * -#define cob_s32_ptr cob_s32_t * -#define cob_u64_ptr cob_u64_t * -#define cob_s64_ptr cob_s64_t * - -#define cob_void_ptr void * -#define cob_field_ptr cob_field * -#define cob_file_ptr cob_file * -#define cob_module_ptr cob_module * -#define cob_screen_ptr cob_screen * -#define cob_file_key_ptr cob_file_key * - -/* Readable compiler version defines */ - -#if defined(_MSC_VER) - -/* -_MSC_VER == 1400 (Visual Studio 2005, VS8 , MSVC 8) since OS-Version 2000 -_MSC_VER == 1500 (Visual Studio 2008, VS9 , MSVC 9) since OS-Version XP / 2003 -_MSC_VER == 1600 (Visual Studio 2010, VS10, MSVC10) since OS-Version XP / 2003 -_MSC_VER == 1700 (Visual Studio 2012, VS11, MSVC11) since OS-Version 7(XP) / 2008 R2(2003) -_MSC_VER == 1800 (Visual Studio 2013, VS12, MSVC12) since OS-Version 7(XP) / 2008 R2(2003) -_MSC_VER == 1900 (Visual Studio 2015, VS14, MSVC14) since OS-Version 7(XP) / 2008 R2(2003) -_MSC_VER == 1910 (Visual Studio 2017, VS15, MSVC14.1) since OS-Version 7 / 2012 R2 -_MSC_VER == 1920 (Visual Studio 2019, VS16, MSVC14.2) since OS-Version 7 / 2012 R2 - -Note: also defined together with __clang__ in both frontends: - __llvm__ Clang LLVM frontend for Visual Studio by LLVM Project (via clang-cl.exe [cl build options]) - __c2__ Clang C2 frontend with MS CodeGen (via clang.exe [original clang build options]) -*/ - -#if _MSC_VER >= 1500 -#define COB_USE_VC2008_OR_GREATER 1 -#else -#define COB_USE_VC2008_OR_GREATER 0 -#if _MSC_VER < 1400 -#error Support for Visual Studio 2003 and older Visual C++ compilers dropped with GnuCOBOL 2.0 -#endif -#endif - -#if _MSC_VER >= 1700 -#define COB_USE_VC2012_OR_GREATER 1 -#else -#define COB_USE_VC2012_OR_GREATER 0 -#endif - -#if _MSC_VER >= 1800 -#define COB_USE_VC2013_OR_GREATER 1 -#else -#define COB_USE_VC2013_OR_GREATER 0 -#endif -#endif - -/* Byte swap functions */ - -/* - The original idea for the byteswap routines was taken from GLib. - (Specifically glib/gtypes.h) - GLib is licensed under the GNU Lesser General Public License. -*/ - -/* Generic swapping functions */ - -#undef COB_BSWAP_16_CONSTANT -#undef COB_BSWAP_32_CONSTANT -#undef COB_BSWAP_64_CONSTANT -#undef COB_BSWAP_16 -#undef COB_BSWAP_32 -#undef COB_BSWAP_64 - -#define COB_BSWAP_16_CONSTANT(val) ((cob_u16_t) ( \ - (((cob_u16_t)(val) & (cob_u16_t) 0x00FFU) << 8) | \ - (((cob_u16_t)(val) & (cob_u16_t) 0xFF00U) >> 8))) - -#define COB_BSWAP_32_CONSTANT(val) ((cob_u32_t) ( \ - (((cob_u32_t) (val) & (cob_u32_t) 0x000000FFU) << 24) | \ - (((cob_u32_t) (val) & (cob_u32_t) 0x0000FF00U) << 8) | \ - (((cob_u32_t) (val) & (cob_u32_t) 0x00FF0000U) >> 8) | \ - (((cob_u32_t) (val) & (cob_u32_t) 0xFF000000U) >> 24))) - -#define COB_BSWAP_64_CONSTANT(val) ((cob_u64_t) ( \ - (((cob_u64_t) (val) & \ - (cob_u64_t) COB_U64_C(0x00000000000000FF)) << 56) | \ - (((cob_u64_t) (val) & \ - (cob_u64_t) COB_U64_C(0x000000000000FF00)) << 40) | \ - (((cob_u64_t) (val) & \ - (cob_u64_t) COB_U64_C(0x0000000000FF0000)) << 24) | \ - (((cob_u64_t) (val) & \ - (cob_u64_t) COB_U64_C(0x00000000FF000000)) << 8) | \ - (((cob_u64_t) (val) & \ - (cob_u64_t) COB_U64_C(0x000000FF00000000)) >> 8) | \ - (((cob_u64_t) (val) & \ - (cob_u64_t) COB_U64_C(0x0000FF0000000000)) >> 24) | \ - (((cob_u64_t) (val) & \ - (cob_u64_t) COB_U64_C(0x00FF000000000000)) >> 40) | \ - (((cob_u64_t) (val) & \ - (cob_u64_t) COB_U64_C(0xFF00000000000000)) >> 56))) - -/* Machine/OS specific overrides */ - -#ifdef __GNUC__ - -#if __GNUC__ > 4 || (__GNUC__ == 4 && __GNUC_MINOR__ >= 3) - -#define COB_BSWAP_16(val) (COB_BSWAP_16_CONSTANT (val)) -#define COB_BSWAP_32(val) (__builtin_bswap32 (val)) -#define COB_BSWAP_64(val) (__builtin_bswap64 (val)) - -#elif defined(__i386__) - -#define COB_BSWAP_16(val) (COB_BSWAP_16_CONSTANT (val)) -#define COB_BSWAP_32(val) \ - (__extension__ \ - ({ register cob_u32_t __v, \ - __x = ((cob_u32_t) (val)); \ - if (__builtin_constant_p (__x)) \ - __v = COB_BSWAP_32_CONSTANT (__x); \ - else \ - __asm__ ("bswap %0" \ - : "=r" (__v) \ - : "0" (__x)); \ - __v; })) -#define COB_BSWAP_64(val) \ - (__extension__ \ - ({ union { cob_u64_t __ll; \ - cob_u32_t __l[2]; } __w, __r; \ - __w.__ll = ((cob_u64_t) (val)); \ - if (__builtin_constant_p (__w.__ll)) \ - __r.__ll = COB_BSWAP_64_CONSTANT (__w.__ll); \ - else \ - { \ - __r.__l[0] = COB_BSWAP_32 (__w.__l[1]); \ - __r.__l[1] = COB_BSWAP_32 (__w.__l[0]); \ - } \ - __r.__ll; })) - -#elif defined (__ia64__) - -#define COB_BSWAP_16(val) (COB_BSWAP_16_CONSTANT (val)) -#define COB_BSWAP_32(val) \ - (__extension__ \ - ({ register cob_u32_t __v, \ - __x = ((cob_u32_t) (val)); \ - if (__builtin_constant_p (__x)) \ - __v = COB_BSWAP_32_CONSTANT (__x); \ - else \ - __asm__ __volatile__ ("shl %0 = %1, 32 ;;" \ - "mux1 %0 = %0, @rev ;;" \ - : "=r" (__v) \ - : "r" (__x)); \ - __v; })) -#define COB_BSWAP_64(val) \ - (__extension__ \ - ({ register cob_u64_t __v, \ - __x = ((cob_u64_t) (val)); \ - if (__builtin_constant_p (__x)) \ - __v = COB_BSWAP_64_CONSTANT (__x); \ - else \ - __asm__ __volatile__ ("mux1 %0 = %1, @rev ;;" \ - : "=r" (__v) \ - : "r" (__x)); \ - __v; })) - -#elif defined (__x86_64__) - -#define COB_BSWAP_16(val) (COB_BSWAP_16_CONSTANT (val)) -#define COB_BSWAP_32(val) \ - (__extension__ \ - ({ register cob_u32_t __v, \ - __x = ((cob_u32_t) (val)); \ - if (__builtin_constant_p (__x)) \ - __v = COB_BSWAP_32_CONSTANT (__x); \ - else \ - __asm__ ("bswapl %0" \ - : "=r" (__v) \ - : "0" (__x)); \ - __v; })) -#define COB_BSWAP_64(val) \ - (__extension__ \ - ({ register cob_u64_t __v, \ - __x = ((cob_u64_t) (val)); \ - if (__builtin_constant_p (__x)) \ - __v = COB_BSWAP_64_CONSTANT (__x); \ - else \ - __asm__ ("bswapq %0" \ - : "=r" (__v) \ - : "0" (__x)); \ - __v; })) - -#else /* Generic gcc */ - -#define COB_BSWAP_16(val) (COB_BSWAP_16_CONSTANT (val)) -#define COB_BSWAP_32(val) (COB_BSWAP_32_CONSTANT (val)) -#define COB_BSWAP_64(val) (COB_BSWAP_64_CONSTANT (val)) - -#endif - -#elif defined(_MSC_VER) - -#define COB_BSWAP_16(val) (_byteswap_ushort (val)) -#define COB_BSWAP_32(val) (_byteswap_ulong (val)) -#define COB_BSWAP_64(val) (_byteswap_uint64 (val)) - -#elif defined(__ORANGEC__) - -#define COB_BSWAP_16(val) (COB_BSWAP_16_CONSTANT (val)) -#define COB_BSWAP_32(val) (__builtin_bswap32 (val)) -#define COB_BSWAP_64(val) (__builtin_bswap64 (val)) - -#else /* Generic */ - -#define COB_BSWAP_16(val) (COB_BSWAP_16_CONSTANT (val)) -#define COB_BSWAP_32(val) (COB_BSWAP_32_CONSTANT (val)) -#define COB_BSWAP_64(val) (COB_BSWAP_64_CONSTANT (val)) - -#endif - -/* End byte swap functions */ - -/* Compiler characteristics */ - -#ifdef _MSC_VER - -#ifndef _CRT_SECURE_NO_DEPRECATE -#define _CRT_SECURE_NO_DEPRECATE 1 -#endif -#include -#include -#include - -/* Disable certain warnings */ -/* Deprecated functions */ -#pragma warning(disable: 4996) -/* Function declarations without parameter list */ -#pragma warning(disable: 4255) - -#define strncasecmp _strnicmp -#define strcasecmp _stricmp -#define snprintf _snprintf -#define getpid _getpid -#define access _access -#define popen _popen -#define pclose _pclose -/* MSDN says these are available since VC2005 #if COB_USE_VC2013_OR_GREATER -only usable with COB_USE_VC2013_OR_GREATER */ -#define timezone _timezone -#define tzname _tzname -#define daylight _daylight -/* only usable with COB_USE_VC2013_OR_GREATER - End -#endif */ - -#if !COB_USE_VC2013_OR_GREATER -#define atoll _atoi64 -#endif - -#define __attribute__(x) - -#ifdef S_ISDIR -#undef S_ISDIR -#endif -#define S_ISDIR(x) (((x) & _S_IFMT) == _S_IFDIR) - -#ifdef S_ISREG -#undef S_ISREG -#endif -#define S_ISREG(x) (((x) & _S_IFMT) == _S_IFREG) - -#ifndef _M_IA64 -#ifdef _WIN64 -#define __x86_64__ -#else -#define __i386__ -#endif -#endif - -#endif /* _MSC_VER */ - -#ifdef __MINGW32__ /* needed by older versions */ -#define strncasecmp _strnicmp -#define strcasecmp _stricmp -#endif /* __MINGW32__ */ - -#ifdef __BORLANDC__ -#include -#define _timeb timeb -#define _ftime(a) ftime(a) -#define strncasecmp strnicmp -#define strcasecmp stricmp -#define _setmode setmode -#define _chdir chdir -#define timezone _timezone -#define tzname _tzname -#define daylight _daylight -#endif /* __BORLANDC__ */ - -#ifdef __ORANGEC__ -#define timezone _timezone -#define tzname _tzname -#define daylight _daylight -#endif /* _ORANGEC__ */ - -#if __SUNPRO_C -/* Disable certain warnings */ -#pragma error_messages (off, E_STATEMENT_NOT_REACHED) -#endif - -#include - -#ifndef COB_EXT_EXPORT -#if ((defined(_WIN32) || defined(__CYGWIN__)) && !defined(__clang__)) -#define COB_EXT_EXPORT __declspec(dllexport) extern -#else -#define COB_EXT_EXPORT extern -#endif -#endif -#ifndef COB_EXT_IMPORT -#if ((defined(_WIN32) || defined(__CYGWIN__)) && !defined(__clang__)) -#define COB_EXT_IMPORT __declspec(dllimport) extern -#else -#define COB_EXT_IMPORT extern -#endif -#endif - -#ifndef COB_EXPIMP -#ifdef COB_LIB_EXPIMP - #define COB_EXPIMP COB_EXT_EXPORT -#else - #define COB_EXPIMP COB_EXT_IMPORT -#endif -#endif - -#if defined(COB_KEYWORD_INLINE) - #define COB_INLINE COB_KEYWORD_INLINE -#else - #define COB_INLINE -#endif - -/* Also OK for icc which defines __GNUC__ */ - -#if defined(__GNUC__) || \ - (defined(__xlc__) && __IBMC__ >= 700 ) || \ - (defined(__HP_cc) && __HP_cc >= 61000) -#define COB_A_NORETURN __attribute__((noreturn)) -#define COB_A_FORMAT12 __attribute__((format(printf, 1, 2))) -#define COB_A_FORMAT23 __attribute__((format(printf, 2, 3))) -#define COB_A_FORMAT34 __attribute__((format(printf, 3, 4))) -#define COB_A_FORMAT45 __attribute__((format(printf, 4, 5))) -#define DECLNORET -#else -#define COB_A_NORETURN -#define COB_A_FORMAT12 -#define COB_A_FORMAT23 -#define COB_A_FORMAT34 -#define COB_A_FORMAT45 - -#if defined (_MSC_VER) || defined (__ORANGEC__) || \ - (defined (__BORLANDC__) && defined (_WIN32)) -#define DECLNORET __declspec(noreturn) -#else -#define DECLNORET -#endif -#endif - -#if defined(__GNUC__) -#define optim_memcpy(x,y,z) __builtin_memcpy (x, y, z) -#else -#define optim_memcpy(x,y,z) memcpy (x, y, z) -#endif - -#if defined(__GNUC__) && (__GNUC__ >= 3) -#define likely(x) __builtin_expect((long int)!!(x), 1L) -#define unlikely(x) __builtin_expect((long int)!!(x), 0L) -#define COB_A_MALLOC __attribute__((malloc)) -#define COB_HAVE_STEXPR 1 - -#if __GNUC__ > 3 || (__GNUC__ == 3 && __GNUC_MINOR__ >= 1) -#define COB_NOINLINE __attribute__((noinline)) -#define COB_A_INLINE __attribute__((always_inline)) -#else -#define COB_NOINLINE -#define COB_A_INLINE -#endif - -#if __GNUC__ > 4 || (__GNUC__ == 4 && __GNUC_MINOR__ >= 3) -#define COB_A_COLD __attribute__((cold)) -#else -#define COB_A_COLD -#endif - -#elif defined(__xlc__) && __IBMC__ >= 700 - -#if __IBMC__ >= 900 -#define likely(x) __builtin_expect((long int)!!(x), 1L) -#define unlikely(x) __builtin_expect((long int)!!(x), 0L) -#else -#define likely(x) (x) -#define unlikely(x) (x) -#endif -#define COB_NOINLINE __attribute__((noinline)) -#define COB_A_INLINE __attribute__((always_inline)) -#define COB_A_MALLOC -#define COB_A_COLD -#if __IBMC__ >= 800 -#define COB_HAVE_STEXPR 1 -#else -#undef COB_HAVE_STEXPR -#endif - -#elif defined(__SUNPRO_C) && __SUNPRO_C >= 0x590 - -#define likely(x) (x) -#define unlikely(x) (x) -#define COB_A_MALLOC __attribute__((malloc)) -#define COB_NOINLINE __attribute__((noinline)) -#define COB_A_INLINE __attribute__((always_inline)) -#define COB_A_COLD -#define COB_HAVE_STEXPR 1 - -#elif defined(_MSC_VER) - -#define likely(x) (x) -#define unlikely(x) (x) -#define COB_A_MALLOC -#define COB_NOINLINE __declspec(noinline) -#define COB_A_INLINE __forceinline -#define COB_A_COLD -/* #undef COB_HAVE_STEXPR */ - -#else - -#define likely(x) (x) -#define unlikely(x) (x) -#define COB_A_MALLOC -#define COB_NOINLINE -#define COB_A_INLINE -#define COB_A_COLD -#undef COB_HAVE_STEXPR - -#endif - -/* Prevent unwanted verbosity when using icc */ -#ifdef __INTEL_COMPILER - -/* Unreachable code */ -#pragma warning ( disable : 111 ) -/* Declared but never referenced */ -#pragma warning ( disable : 177 ) -/* Format conversion */ -#pragma warning ( disable : 181 ) -/* Enumerated type mixed with other type */ -#pragma warning ( disable : 188 ) -/* #undefine tested for zero */ -#pragma warning ( disable : 193 ) -/* Set but not used */ -#pragma warning ( disable : 593 ) -/* Parameter not referenced */ -#pragma warning ( disable : 869 ) -/* Operands are evaluated in unspecified order */ -#pragma warning ( disable : 981 ) -/* Missing return at end of non-void function */ -/* Note - occurs because we have a non-returning abort call in cobc */ -#pragma warning ( disable : 1011 ) -/* Declaration in same source as definition */ -#pragma warning ( disable : 1419 ) -/* Shadowed variable - 1599 and 1944 are essentially the same */ -#pragma warning ( disable : 1599 ) -#pragma warning ( disable : 1944 ) -/* Possible loss of precision */ -#pragma warning ( disable : 2259 ) - -#endif - -/* End compiler stuff */ - -/* Macro to prevent compiler warning "conditional expression is constant" */ -#if defined (_MSC_VER) && COB_USE_VC2008_OR_GREATER -#define ONCE_COB \ - __pragma( warning(push) ) \ - __pragma( warning(disable:4127) ) \ - while (0) \ - __pragma( warning(pop) ) -#else -#define ONCE_COB while (0) -#endif - - -/* Define some characters for checking LINE SEQUENTIAL data content */ -#define COB_CHAR_CR '\r' -#define COB_CHAR_FF '\f' -#define COB_CHAR_LF '\n' -#define COB_CHAR_SPC ' ' -#define COB_CHAR_TAB '\t' -#ifdef COB_EBCDIC_MACHINE -#define COB_CHAR_BS 0x16 -#define COB_CHAR_ESC 0x27 -#define COB_CHAR_SI 0x0F -#else -#define COB_CHAR_BS 0x08 -#define COB_CHAR_ESC 0x1B -#define COB_CHAR_SI 0x0F -#endif - -/* Macro to prevent unused parameter warning */ - -#define COB_UNUSED(z) do { (void)(z); } ONCE_COB - -/* Buffer size definitions */ - -#define COB_MINI_BUFF 256 -#define COB_SMALL_BUFF 1024 -#define COB_NORMAL_BUFF 2048 -#define COB_FILE_BUFF 4096 -#define COB_MEDIUM_BUFF 8192 -#define COB_LARGE_BUFF 16384 -#define COB_MINI_MAX (COB_MINI_BUFF - 1) -#define COB_SMALL_MAX (COB_SMALL_BUFF - 1) -#define COB_NORMAL_MAX (COB_NORMAL_BUFF - 1) -#define COB_FILE_MAX (COB_FILE_BUFF - 1) -#define COB_MEDIUM_MAX (COB_MEDIUM_BUFF - 1) -#define COB_LARGE_MAX (COB_LARGE_BUFF - 1) - -/* Perform stack size */ -#define COB_STACK_SIZE 255 - -/* Maximum size of file records */ -/* TODO: add compiler configuration for limiting this - per file type */ -#define MAX_FD_RECORD 64 * 1024 * 1024 - -/* Maximum size of file records (IDX) */ -/* TODO: define depending on used ISAM */ -/* TODO: add compiler configuration for limiting this */ -#define MAX_FD_RECORD_IDX 65535 - -/* Maximum amount of keys per file */ -/* TODO: define depending on used ISAM */ -/* TODO: add compiler configuration for limiting this */ -#define MAX_FILE_KEYS 255 - -/* Maximum number of field digits */ -#define COB_MAX_DIGITS 38 - -/* Maximum digits in binary field */ -#define COB_MAX_BINARY 39 - -/* Maximum exponent digits (both in literals and floating-point numeric-edited item */ -#define COB_FLOAT_DIGITS_MAX 36 - -/* Maximum bytes in a single/group field, - which doesn't contain UNBOUNDED items */ -/* TODO: add compiler configuration for limiting this */ -#define COB_MAX_FIELD_SIZE 268435456 - -/* Maximum bytes in an unbounded table entry - (IBM: 999999998) */ -#define COB_MAX_UNBOUNDED_SIZE 999999998 - -/* Maximum number of cob_decimal structures */ -#define COB_MAX_DEC_STRUCT 32 - -/* Maximum length of COBOL words */ -#define COB_MAX_WORDLEN 63 - -/* Maximum length of literals */ -#define COB_MAX_LITERAL_LEN 256 * 1024 - -/* Maximum length of COBOL program names */ -#define COB_MAX_NAMELEN 31 - -/* Maximum number of subscripts */ -#define COB_MAX_SUBSCRIPTS 16 - -/* Memory size for sorting */ -#define COB_SORT_MEMORY 128 * 1024 * 1024 -#define COB_SORT_CHUNK 256 * 1024 - -/* Program return types */ -#define COB_RET_TYPE_INT 0 -#define COB_RET_TYPE_PTR 1 -#define COB_RET_TYPE_VOID 2 - -/* Fold case types */ -#define COB_FOLD_NONE 0 -#define COB_FOLD_UPPER 1 -#define COB_FOLD_LOWER 2 - -/* Locale types */ -#define COB_LC_COLLATE 0 -#define COB_LC_CTYPE 1 -#define COB_LC_MESSAGES 2 -#define COB_LC_MONETARY 3 -#define COB_LC_NUMERIC 4 -#define COB_LC_TIME 5 -#define COB_LC_ALL 6 -#define COB_LC_USER 7 -#define COB_LC_CLASS 8 - -/* Field types */ - -#define COB_TYPE_UNKNOWN 0x00 -#define COB_TYPE_GROUP 0x01U -#define COB_TYPE_BOOLEAN 0x02U - -#define COB_TYPE_NUMERIC 0x10U -#define COB_TYPE_NUMERIC_DISPLAY 0x10U -#define COB_TYPE_NUMERIC_BINARY 0x11U -#define COB_TYPE_NUMERIC_PACKED 0x12U -#define COB_TYPE_NUMERIC_FLOAT 0x13U -#define COB_TYPE_NUMERIC_DOUBLE 0x14U -#define COB_TYPE_NUMERIC_L_DOUBLE 0x15U -#define COB_TYPE_NUMERIC_FP_DEC64 0x16U -#define COB_TYPE_NUMERIC_FP_DEC128 0x17U -#define COB_TYPE_NUMERIC_FP_BIN32 0x18U -#define COB_TYPE_NUMERIC_FP_BIN64 0x19U -#define COB_TYPE_NUMERIC_FP_BIN128 0x1AU -#define COB_TYPE_NUMERIC_COMP5 0x1BU - -#define COB_TYPE_NUMERIC_EDITED 0x24U - -#define COB_TYPE_ALNUM 0x20U -#define COB_TYPE_ALPHANUMERIC 0x21U -#define COB_TYPE_ALPHANUMERIC_ALL 0x22U -#define COB_TYPE_ALPHANUMERIC_EDITED 0x23U - -#define COB_TYPE_NATIONAL 0x40U -#define COB_TYPE_NATIONAL_EDITED 0x41U - -/* Field flags */ - -#define COB_FLAG_HAVE_SIGN (1U << 0) /* 0x0001 */ -#define COB_FLAG_SIGN_SEPARATE (1U << 1) /* 0x0002 */ -#define COB_FLAG_SIGN_LEADING (1U << 2) /* 0x0004 */ -#define COB_FLAG_BLANK_ZERO (1U << 3) /* 0x0008 */ -#define COB_FLAG_JUSTIFIED (1U << 4) /* 0x0010 */ -#define COB_FLAG_BINARY_SWAP (1U << 5) /* 0x0020 */ -#define COB_FLAG_REAL_BINARY (1U << 6) /* 0x0040 */ -#define COB_FLAG_IS_POINTER (1U << 7) /* 0x0080 */ -#define COB_FLAG_NO_SIGN_NIBBLE (1U << 8) /* 0x0100 */ -#define COB_FLAG_IS_FP (1U << 9) /* 0x0200 */ -#define COB_FLAG_REAL_SIGN (1U << 10) /* 0x0400 */ -#define COB_FLAG_BINARY_TRUNC (1U << 11) /* 0x0800 */ -#define COB_FLAG_CONSTANT (1U << 12) /* 0x1000 */ -#define COB_FLAG_VALUE (1U << 13) /* 0x2000 */ -#define COB_FLAG_CONTENT (1U << 14) /* 0x4000 */ - -#define COB_FIELD_HAVE_SIGN(f) ((f)->attr->flags & COB_FLAG_HAVE_SIGN) -#define COB_FIELD_SIGN_SEPARATE(f) ((f)->attr->flags & COB_FLAG_SIGN_SEPARATE) -#define COB_FIELD_SIGN_LEADING(f) ((f)->attr->flags & COB_FLAG_SIGN_LEADING) -#define COB_FIELD_BLANK_ZERO(f) ((f)->attr->flags & COB_FLAG_BLANK_ZERO) -#define COB_FIELD_JUSTIFIED(f) ((f)->attr->flags & COB_FLAG_JUSTIFIED) -#define COB_FIELD_BINARY_SWAP(f) ((f)->attr->flags & COB_FLAG_BINARY_SWAP) -#define COB_FIELD_REAL_BINARY(f) ((f)->attr->flags & COB_FLAG_REAL_BINARY) -#define COB_FIELD_IS_POINTER(f) ((f)->attr->flags & COB_FLAG_IS_POINTER) -#define COB_FIELD_NO_SIGN_NIBBLE(f) ((f)->attr->flags & COB_FLAG_NO_SIGN_NIBBLE) -#define COB_FIELD_IS_FP(f) ((f)->attr->flags & COB_FLAG_IS_FP) -#define COB_FIELD_REAL_SIGN(f) ((f)->attr->flags & COB_FLAG_REAL_SIGN) -#define COB_FIELD_BINARY_TRUNC(f) ((f)->attr->flags & COB_FLAG_BINARY_TRUNC) -#define COB_FIELD_CONSTANT(f) ((f)->attr->flags & COB_FLAG_CONSTANT) -#define COB_FIELD_VALUE(f) ((f)->attr->flags & COB_FLAG_VALUE) -#define COB_FIELD_CONTENT(f) ((f)->attr->flags & COB_FLAG_CONTENT) - -#define COB_FLAG_LEADSEP \ - (COB_FLAG_SIGN_SEPARATE | COB_FLAG_SIGN_LEADING) - -#define COB_FIELD_SIGN_LEADSEP(f) \ - (((f)->attr->flags & COB_FLAG_LEADSEP) == COB_FLAG_LEADSEP) - -#define COB_FIELD_TYPE(f) ((f)->attr->type) -#define COB_FIELD_DIGITS(f) ((f)->attr->digits) -#define COB_FIELD_SCALE(f) ((f)->attr->scale) -#define COB_FIELD_FLAGS(f) ((f)->attr->flags) -#define COB_FIELD_PIC(f) ((f)->attr->pic) - -#define COB_FIELD_DATA(f) \ - ((f)->data + (COB_FIELD_SIGN_LEADSEP (f) ? 1 : 0)) - -#define COB_FIELD_SIZE(f) \ - (COB_FIELD_SIGN_SEPARATE (f) ? f->size - 1 : f->size) - -#define COB_FIELD_IS_NUMERIC(f) (COB_FIELD_TYPE (f) & COB_TYPE_NUMERIC) -#define COB_FIELD_IS_NUMDISP(f) (COB_FIELD_TYPE (f) == COB_TYPE_NUMERIC_DISPLAY) -#define COB_FIELD_IS_ALNUM(f) (COB_FIELD_TYPE (f) == COB_TYPE_ALPHANUMERIC) -#define COB_FIELD_IS_ANY_ALNUM(f) (COB_FIELD_TYPE (f) & COB_TYPE_ALNUM) -#define COB_FIELD_IS_NATIONAL(f) (COB_FIELD_TYPE (f) & COB_TYPE_NATIONAL) - - -#define COB_DISPLAY_SIGN_ASCII 0 -#define COB_DISPLAY_SIGN_EBCDIC 1 - -#define COB_NATIONAL_SIZE 2 - -#define COB_SET_FLD(v,x,y,z) (v.size = x, v.data = y, v.attr = z, &v) -#define COB_SET_DATA(x,z) (x.data = z, &x) - -/* Fatal error definitions */ - -enum cob_fatal_error { - COB_FERROR_NONE = 0, - COB_FERROR_CANCEL, - COB_FERROR_INITIALIZED, - COB_FERROR_CODEGEN, - COB_FERROR_CHAINING, - COB_FERROR_STACK, - COB_FERROR_GLOBAL, - COB_FERROR_MEMORY, - COB_FERROR_MODULE, - COB_FERROR_RECURSIVE, - COB_FERROR_SCR_INP, - COB_FERROR_FILE, - COB_FERROR_FUNCTION, - COB_FERROR_FREE, - COB_FERROR_DIV_ZERO, - COB_FERROR_XML, - COB_FERROR_JSON -}; - -/* Exception identifier enumeration */ - -#undef COB_EXCEPTION -#ifndef COB_WITHOUT_EXCEPTIONS -#define COB_EXCEPTION(code,tag,name,critical) tag, - -enum cob_exception_id { - COB_EC_ZERO = 0, -#include - COB_EC_MAX -}; - -#undef COB_EXCEPTION -#endif - -#define cob_global_exception cob_glob_ptr->cob_exception_code -#define COB_RESET_EXCEPTION(x) if (x == 0 || cob_global_exception == x) cob_global_exception = 0 - -/* File attributes */ - -/* Start conditions */ -/* Note that COB_NE is disallowed */ -#define COB_EQ 1 /* x == y */ -#define COB_LT 2 /* x < y */ -#define COB_LE 3 /* x <= y */ -#define COB_GT 4 /* x > y */ -#define COB_GE 5 /* x >= y */ -#define COB_NE 6 /* x != y */ -#define COB_FI 7 /* First */ -#define COB_LA 8 /* Last */ - -#define COB_ASCENDING 0 -#define COB_DESCENDING 1 - -#ifdef _WIN32 -#define COB_FILE_MODE _S_IREAD | _S_IWRITE -#define COB_OPEN_TEMPORARY _O_TEMPORARY -#else -#define COB_FILE_MODE 0666 -#define COB_OPEN_TEMPORARY 0 -#endif - -/* File: 'bdb_byteorder' for int/short/long as stored on disk */ -#define COB_BDB_IS_NATIVE 0 /* Default to what the system uses */ -#define COB_BDB_IS_BIG 1 /* Use little-endian */ -#define COB_BDB_IS_LITTLE 2 /* Use big-endian */ - -/* File: 'file_format' as stored on disk */ -enum cob_file_format { - COB_FILE_IS_GCVS0 = 0, /* GnuCOBOL VarSeq 0 */ - COB_FILE_IS_GCVS1 = 1, /* GnuCOBOL VarSeq 1 */ - COB_FILE_IS_GCVS2 = 2, /* GnuCOBOL VarSeq 2 */ - COB_FILE_IS_GCVS3 = 3, /* GnuCOBOL VarSeq 3 */ - COB_FILE_IS_B32 = 4, /* 32-bit BigEndian record prefix */ - COB_FILE_IS_B64 = 5, /* 64-bit BigEndian record prefix */ - COB_FILE_IS_L32 = 6, /* 32-bit LittleEndian record prefix */ - COB_FILE_IS_L64 = 7, /* 64-bit LittleEndian record prefix */ - COB_FILE_IS_GC = 10, /* GnuCOBOL default format */ - COB_FILE_IS_MF = 11, /* Micro Focus default format */ - COB_FILE_IS_DFLT = 255 /* Figure out file format at runtime */ -}; - -/* Data type code for eXternal file Description */ -enum xfd_data_type { - COB_XFDT_BIN = 1, /* Arbitrary Binary Data */ - COB_XFDT_COMP5S, /* PIC S9 COMP-5 */ - COB_XFDT_COMP5U, /* PIC 9 COMP-5 */ - COB_XFDT_COMP6, /* PIC 9 COMP-6 */ - COB_XFDT_COMPS, /* PIC S9 BINARY/COMP/COMP-4 */ - COB_XFDT_COMPU, /* PIC 9 BINARY/COMP/COMP-4 */ - COB_XFDT_COMPX, /* PIC x COMP-X */ - COB_XFDT_FLOAT, /* COMP-1/COMP-2 */ - COB_XFDT_PACKS, /* PIC S9 COMP-3/PACKED DECIMAL */ - COB_XFDT_PACKU, /* PIC 9 COMP-3/PACKED DECIMAL */ - COB_XFDT_PIC9L, /* PIC S9 SIGN LEADING */ - COB_XFDT_PIC9LS, /* PIC S9 SIGN LEADING SEPARATE */ - COB_XFDT_PIC9S, /* PIC S9 */ - COB_XFDT_PIC9T, /* PIC 9 SIGN TRAILING */ - COB_XFDT_PIC9TS, /* PIC 9 SIGN TRAILING SEPARATE */ - COB_XFDT_PIC9U, /* PIC 9 */ - COB_XFDT_PICA, /* PIC A */ - COB_XFDT_PICN, /* PIC X National characters */ - COB_XFDT_PICW, /* PIC X Wide characters */ - COB_XFDT_PICX, /* PIC X */ - COB_XFDT_VARX, /* PIC X : VARCHAR */ - COB_XFDT_MAX /* Max possible value for this enum */ -}; - -/* Organization */ - -enum cob_file_org { - COB_ORG_SEQUENTIAL = 0, - COB_ORG_LINE_SEQUENTIAL = 1, - COB_ORG_RELATIVE = 2, - COB_ORG_INDEXED = 3, - COB_ORG_SORT = 4, - COB_ORG_MAX = 5 -}; - -/* Access mode */ - -enum cob_file_access { - COB_ACCESS_SEQUENTIAL = 1, - COB_ACCESS_DYNAMIC = 2, - COB_ACCESS_RANDOM = 3 -}; - -/* io_routine */ - -#define COB_IO_SEQUENTIAL 0 -#define COB_IO_LINE_SEQUENTIAL 1 -#define COB_IO_RELATIVE 2 -#define COB_IO_CISAM 3 /* INDEXED via C-ISAM */ -#define COB_IO_DISAM 4 /* INDEXED via D-ISAM */ -#define COB_IO_VBISAM 5 /* INDEXED via VB-ISAM */ -#define COB_IO_BDB 6 /* INDEXED via BDB */ -#define COB_IO_LMDB 7 /* INDEXED via LMDB */ -#define COB_IO_IXEXT 8 /* INDEXED via Local old style WITH_INDEX_EXTFH */ -#define COB_IO_SQEXT 9 /* SEQUENTIAL via old style WITH_SEQRA_EXTFH */ -#define COB_IO_RLEXT 10 /* RELATIVE via old style WITH_SEQRA_EXTFH */ -#define COB_IO_ODBC 11 /* INDEXED via ODBC */ -#define COB_IO_OCI 12 /* INDEXED via OCI */ -#define COB_IO_MAX 13 -/* Not yet implemented */ -#define COB_IO_MFIDX4 13 /* Micro Focus IDX4 format */ -#define COB_IO_MFIDX8 14 /* Micro Focus IDX8 format */ - -/* SELECT features */ - -#define COB_SELECT_FILE_STATUS (1U << 0) -#define COB_SELECT_EXTERNAL (1U << 1) -#define COB_SELECT_LINAGE (1U << 2) -#define COB_SELECT_SPLITKEY (1U << 3) -#define COB_SELECT_STDIN (1U << 4) -#define COB_SELECT_STDOUT (1U << 5) -#define COB_SELECT_TEMPORARY (1U << 6) - -#define COB_FILE_SPECIAL(x) \ - ((x)->flag_select_features & (COB_SELECT_STDIN | COB_SELECT_STDOUT)) -#define COB_FILE_STDIN(x) ((x)->flag_select_features & COB_SELECT_STDIN) -#define COB_FILE_STDOUT(x) ((x)->flag_select_features & COB_SELECT_STDOUT) -#define COB_FILE_TEMPORARY(x) ((x)->flag_select_features & COB_SELECT_TEMPORARY) - -/* Lock mode */ - -#define COB_LOCK_EXCLUSIVE (1U << 0) -#define COB_LOCK_MANUAL (1U << 1) -#define COB_LOCK_AUTOMATIC (1U << 2) -#define COB_LOCK_MULTIPLE (1U << 3) -#define COB_LOCK_OPEN_EXCLUSIVE (1U << 4) -#define COB_LOCK_ROLLBACK (1U << 5) - -#define COB_FILE_EXCLUSIVE (COB_LOCK_EXCLUSIVE | COB_LOCK_OPEN_EXCLUSIVE) - -/* File: 'file_features' file processing features */ -#define COB_FILE_SYNC (1 << 0)/* sync writes to disk */ -#define COB_FILE_LS_VALIDATE (1 << 1)/* Validate LINE SEQUENTIAL data */ -#define COB_FILE_LS_NULLS (1 << 2)/* Do NUL insertion for LINE SEQUENTIAL */ -#define COB_FILE_LS_FIXED (1 << 3)/* Write LINE SEQUENTIAL record fixed size */ -#define COB_FILE_LS_CRLF (1 << 4)/* End LINE SEQUENTIAL records with CR LF */ -#define COB_FILE_LS_LF (1 << 5)/* End LINE SEQUENTIAL records with LF */ -#define COB_FILE_LS_SPLIT (1 << 6)/* LINE SEQUENTIAL records longer than max should be split */ - /* Default is longer than max get truncated & skip to LF */ - -/* Sharing option */ - -#define COB_SHARE_READ_ONLY (1U << 0) -#define COB_SHARE_ALL_OTHER (1U << 1) -#define COB_SHARE_NO_OTHER (1U << 2) - -/* RETRY option */ - -#define COB_RETRY_FOREVER (1U << 3) -#define COB_RETRY_TIMES (1U << 4) -#define COB_RETRY_SECONDS (1U << 5) -#define COB_RETRY_NEVER (1U << 6) -#define COB_ADVANCING_LOCK (1U << 7) -#define COB_IGNORE_LOCK (1U << 8) - -#define COB_RETRY_PER_SECOND 10 - -/* Open mode */ - -#define COB_OPEN_CLOSED 0 -#define COB_OPEN_INPUT 1 -#define COB_OPEN_OUTPUT 2 -#define COB_OPEN_I_O 3 -#define COB_OPEN_EXTEND 4 -#define COB_OPEN_LOCKED 5 - -/* Close options */ - -#define COB_CLOSE_NORMAL 0 -#define COB_CLOSE_LOCK 1 -#define COB_CLOSE_NO_REWIND 2 -#define COB_CLOSE_UNIT 3 -#define COB_CLOSE_UNIT_REMOVAL 4 -#define COB_CLOSE_ABORT -1 - -/* Write options */ - -#define COB_WRITE_MASK 0x0000FFFF - -#define COB_WRITE_LINES 0x00010000 -#define COB_WRITE_PAGE 0x00020000 -#define COB_WRITE_CHANNEL 0x00040000 -#define COB_WRITE_AFTER 0x00100000 -#define COB_WRITE_BEFORE 0x00200000 -#define COB_WRITE_EOP 0x00400000 -#define COB_WRITE_LOCK 0x00800000 -#define COB_WRITE_NO_LOCK 0x01000000 - -/* Read options */ - -#define COB_READ_NEXT (1 << 0) -#define COB_READ_PREVIOUS (1 << 1) -#define COB_READ_FIRST (1 << 2) -#define COB_READ_LAST (1 << 3) -#define COB_READ_LOCK (1 << 4) -#define COB_READ_NO_LOCK (1 << 5) -#define COB_READ_KEPT_LOCK (1 << 6) -#define COB_READ_WAIT_LOCK (1 << 7) -#define COB_READ_IGNORE_LOCK (1 << 8) -#define COB_READ_ADVANCING_LOCK (1 << 9) - -#define COB_READ_MASK \ - (COB_READ_NEXT | COB_READ_PREVIOUS | COB_READ_FIRST | COB_READ_LAST) - -/* I-O status */ - -#define COB_STATUS_00_SUCCESS 00 -#define COB_STATUS_02_SUCCESS_DUPLICATE 02 -#define COB_STATUS_04_SUCCESS_INCOMPLETE 04 -#define COB_STATUS_05_SUCCESS_OPTIONAL 05 -#define COB_STATUS_07_SUCCESS_NO_UNIT 07 -#define COB_STATUS_10_END_OF_FILE 10 -#define COB_STATUS_14_OUT_OF_KEY_RANGE 14 -#define COB_STATUS_21_KEY_INVALID 21 -#define COB_STATUS_22_KEY_EXISTS 22 -#define COB_STATUS_23_KEY_NOT_EXISTS 23 -#define COB_STATUS_24_KEY_BOUNDARY 24 -#define COB_STATUS_30_PERMANENT_ERROR 30 -#define COB_STATUS_31_INCONSISTENT_FILENAME 31 -#define COB_STATUS_34_BOUNDARY_VIOLATION 34 -#define COB_STATUS_35_NOT_EXISTS 35 -#define COB_STATUS_37_PERMISSION_DENIED 37 -#define COB_STATUS_38_CLOSED_WITH_LOCK 38 -#define COB_STATUS_39_CONFLICT_ATTRIBUTE 39 -#define COB_STATUS_41_ALREADY_OPEN 41 -#define COB_STATUS_42_NOT_OPEN 42 -#define COB_STATUS_43_READ_NOT_DONE 43 -#define COB_STATUS_44_RECORD_OVERFLOW 44 -#define COB_STATUS_45_IDENTIFICATION_FAILURE 45 /* currently not implemented */ -#define COB_STATUS_46_READ_ERROR 46 -#define COB_STATUS_47_INPUT_DENIED 47 -#define COB_STATUS_48_OUTPUT_DENIED 48 -#define COB_STATUS_49_I_O_DENIED 49 -#define COB_STATUS_51_RECORD_LOCKED 51 -#define COB_STATUS_52_DEAD_LOCK 52 /* currently not implemented (patch available) */ -#define COB_STATUS_53_MAX_LOCKS 53 -#define COB_STATUS_54_MAX_LOCKS_FD 54 /* currently not implemented */ -#define COB_STATUS_57_I_O_LINAGE 57 -#define COB_STATUS_61_FILE_SHARING 61 -#define COB_STATUS_71_BAD_CHAR 71 -#define COB_STATUS_91_NOT_AVAILABLE 91 - -/* Special status */ -/* Used by extfh handler */ -#define COB_NOT_CONFIGURED 32768 - -/* End File attributes */ - -/* Number store defines */ - -#define COB_STORE_ROUND (1 << 0) -#define COB_STORE_KEEP_ON_OVERFLOW (1 << 1) -#define COB_STORE_TRUNC_ON_OVERFLOW (1 << 2) - -#define COB_STORE_AWAY_FROM_ZERO (1 << 4) -#define COB_STORE_NEAR_AWAY_FROM_ZERO (1 << 5) -#define COB_STORE_NEAR_EVEN (1 << 6) -#define COB_STORE_NEAR_TOWARD_ZERO (1 << 7) -#define COB_STORE_PROHIBITED (1 << 8) -#define COB_STORE_TOWARD_GREATER (1 << 9) -#define COB_STORE_TOWARD_LESSER (1 << 10) -#define COB_STORE_TRUNCATION (1 << 11) - -#define COB_STORE_MASK \ - (COB_STORE_ROUND | COB_STORE_KEEP_ON_OVERFLOW | \ - COB_STORE_TRUNC_ON_OVERFLOW) - -/* Screen attribute defines */ - -#define COB_SCREEN_BLACK 0 -#define COB_SCREEN_BLUE 1 -#define COB_SCREEN_GREEN 2 -#define COB_SCREEN_CYAN 3 -#define COB_SCREEN_RED 4 -#define COB_SCREEN_MAGENTA 5 -#define COB_SCREEN_YELLOW 6 -#define COB_SCREEN_WHITE 7 - -typedef cob_s64_t cob_flags_t; - -#define COB_SCREEN_LINE_PLUS ((cob_flags_t)1 << 0) -#define COB_SCREEN_LINE_MINUS ((cob_flags_t)1 << 1) -#define COB_SCREEN_COLUMN_PLUS ((cob_flags_t)1 << 2) -#define COB_SCREEN_COLUMN_MINUS ((cob_flags_t)1 << 3) -#define COB_SCREEN_AUTO ((cob_flags_t)1 << 4) -#define COB_SCREEN_BELL ((cob_flags_t)1 << 5) -#define COB_SCREEN_BLANK_LINE ((cob_flags_t)1 << 6) -#define COB_SCREEN_BLANK_SCREEN ((cob_flags_t)1 << 7) -#define COB_SCREEN_BLINK ((cob_flags_t)1 << 8) -#define COB_SCREEN_ERASE_EOL ((cob_flags_t)1 << 9) -#define COB_SCREEN_ERASE_EOS ((cob_flags_t)1 << 10) -#define COB_SCREEN_FULL ((cob_flags_t)1 << 11) -#define COB_SCREEN_HIGHLIGHT ((cob_flags_t)1 << 12) -#define COB_SCREEN_LOWLIGHT ((cob_flags_t)1 << 13) -#define COB_SCREEN_REQUIRED ((cob_flags_t)1 << 14) -#define COB_SCREEN_REVERSE ((cob_flags_t)1 << 15) -#define COB_SCREEN_SECURE ((cob_flags_t)1 << 16) -#define COB_SCREEN_UNDERLINE ((cob_flags_t)1 << 17) -#define COB_SCREEN_OVERLINE ((cob_flags_t)1 << 18) -#define COB_SCREEN_PROMPT ((cob_flags_t)1 << 19) -#define COB_SCREEN_UPDATE ((cob_flags_t)1 << 20) -#define COB_SCREEN_INPUT ((cob_flags_t)1 << 21) -#define COB_SCREEN_SCROLL_DOWN ((cob_flags_t)1 << 22) -#define COB_SCREEN_INITIAL ((cob_flags_t)1 << 23) -#define COB_SCREEN_NO_ECHO ((cob_flags_t)1 << 24) -#define COB_SCREEN_LEFTLINE ((cob_flags_t)1 << 25) -#define COB_SCREEN_NO_DISP ((cob_flags_t)1 << 26) -#define COB_SCREEN_EMULATE_NL ((cob_flags_t)1 << 27) -#define COB_SCREEN_UPPER ((cob_flags_t)1 << 28) -#define COB_SCREEN_LOWER ((cob_flags_t)1 << 29) -#define COB_SCREEN_GRID ((cob_flags_t)1 << 30) -/*#define COB_SCREEN_reserved ((cob_flags_t)1 << 31) /+ reserved for next flag used in screenio */ -#define COB_SCREEN_TAB ((cob_flags_t)1 << 32) /* used for syntax checking */ -#define COB_SCREEN_NO_UPDATE ((cob_flags_t)1 << 33) /* used for syntax checking */ -#define COB_SCREEN_SCROLL_UP ((cob_flags_t)1 << 34) /* used for syntax checking */ - -#define COB_SCREEN_TYPE_GROUP 0 -#define COB_SCREEN_TYPE_FIELD 1 -#define COB_SCREEN_TYPE_VALUE 2 -#define COB_SCREEN_TYPE_ATTRIBUTE 3 - -/* End Screen attribute defines */ - -/* Report attribute defines */ - -#define COB_REPORT_LINE (1U << 0) -#define COB_REPORT_LINE_PLUS (1U << 1) -#define COB_REPORT_COLUMN_PLUS (1U << 2) -#define COB_REPORT_RESET_FINAL (1U << 3) -#define COB_REPORT_HEADING (1U << 4) -#define COB_REPORT_FOOTING (1U << 5) -#define COB_REPORT_PAGE_HEADING (1U << 6) -#define COB_REPORT_PAGE_FOOTING (1U << 7) -#define COB_REPORT_CONTROL_HEADING (1U << 8) -#define COB_REPORT_CONTROL_HEADING_FINAL (1U << 9) -#define COB_REPORT_CONTROL_FOOTING (1U << 10) -#define COB_REPORT_CONTROL_FOOTING_FINAL (1U << 11) -#define COB_REPORT_DETAIL (1U << 12) -#define COB_REPORT_NEXT_GROUP_LINE (1U << 13) -#define COB_REPORT_NEXT_GROUP_PLUS (1U << 14) -#define COB_REPORT_NEXT_GROUP_PAGE (1U << 15) -#define COB_REPORT_LINE_NEXT_PAGE (1U << 16) -#define COB_REPORT_NEXT_PAGE (1U << 17) -#define COB_REPORT_GROUP_INDICATE (1U << 18) -#define COB_REPORT_GROUP_ITEM (1U << 19) -#define COB_REPORT_HAD_WHEN (1U << 20) -#define COB_REPORT_COLUMN_LEFT (1U << 21) -#define COB_REPORT_COLUMN_CENTER (1U << 22) -#define COB_REPORT_COLUMN_RIGHT (1U << 23) -#define COB_REPORT_PRESENT (1U << 24) -#define COB_REPORT_BEFORE (1U << 25) -#define COB_REPORT_PAGE (1U << 26) -#define COB_REPORT_ALL (1U << 27) - -#define COB_REPORT_NEGATE (1U << 28) /* Negative: so ABSENT == PRESENT & NEGATE */ - -#define COB_REPORT_SUM_EMITTED (1U << 29) -#define COB_REPORT_LINE_EMITTED (1U << 30) -#define COB_REPORT_REF_EMITTED (1U << 31) -#define COB_REPORT_EMITTED (COB_REPORT_REF_EMITTED | COB_REPORT_LINE_EMITTED | COB_REPORT_SUM_EMITTED) - -/* End Report attribute defines */ - - -/* Structure/union declarations */ - - -/* Picture symbol structure */ - -typedef struct __cob_pic_symbol { - char symbol; - int times_repeated; -} cob_pic_symbol; - -/* Field attribute structure */ - -typedef struct __cob_field_attr { - unsigned short type; /* Field type */ - unsigned short digits; /* Digit count */ - signed short scale; /* Field scale */ - unsigned short flags; /* Field flags */ - const cob_pic_symbol *pic; /* Pointer to picture string */ -} cob_field_attr; - -/* Field structure */ - -typedef struct __cob_field { - size_t size; /* Field size */ - unsigned char *data; /* Pointer to field data */ - const cob_field_attr *attr; /* Pointer to attribute */ -} cob_field; - -#if 0 /* RXWRXW - Constant field */ -/* Field structure for constants */ - -typedef struct __cob_const_field { - const size_t size; /* Field size */ - const unsigned char *data; /* Pointer to field data */ - const cob_field_attr *attr; /* Pointer to attribute */ -} cob_const_field; - - -/* Union for field constants */ - -typedef union __cob_fld_union { - const cob_const_field cf; - cob_field vf; -} cob_fld_union; -#endif - -/* Representation of 128 bit FP */ - -typedef struct __cob_fp_128 { - cob_u64_t fpval[2]; -} cob_fp_128; - -#ifndef COB_WITHOUT_DECIMAL -/* Internal representation of decimal numbers */ -/* n = value / 10 ^ scale */ -/* Decimal structure */ - -typedef struct __cob_decimal { - mpz_t value; /* GMP value definition */ - int scale; /* Decimal scale */ -} cob_decimal; -#endif - -/* Perform stack structure */ -struct cob_frame { - void *return_address_ptr; /* Return address pointer */ - unsigned int perform_through; /* Perform number */ - unsigned int return_address_num; /* Return address number */ -}; - -/* Call union structures */ - -typedef union __cob_content { - unsigned char data[8]; - cob_s64_t datall; - cob_u64_t dataull; - int dataint; -} cob_content; - -typedef union __cob_call_union { - void *(*funcptr)(); /* Function returning "void *" */ - void (*funcnull)(); /* Function returning nothing */ - cob_field *(*funcfld)(); /* Function returning "cob_field *" */ - int (*funcint)(); /* Function returning "int" */ - void *funcvoid; /* Redefine to "void *" */ -#ifdef _WIN32 - /* stdcall variants */ - void *(__stdcall *funcptr_std)(); - void (__stdcall *funcnull_std)(); - cob_field *(__stdcall *funcfld_std)(); - int (__stdcall *funcint_std)(); -#endif -} cob_call_union; - -struct cob_call_struct { - const char *cob_cstr_name; /* Call name */ - cob_call_union cob_cstr_call; /* Call entry */ - cob_call_union cob_cstr_cancel; /* Cancel entry */ -}; - -/* Screen structure */ -typedef struct __cob_screen { - struct __cob_screen *next; /* Pointer to next */ - struct __cob_screen *prev; /* Pointer to previous */ - struct __cob_screen *child; /* For COB_SCREEN_TYPE_GROUP */ - struct __cob_screen *parent; /* Pointer to parent */ - cob_field *field; /* For COB_SCREEN_TYPE_FIELD */ - cob_field *value; /* For COB_SCREEN_TYPE_VALUE */ - cob_field *line; /* LINE */ - cob_field *column; /* COLUMN */ - cob_field *foreg; /* FOREGROUND */ - cob_field *backg; /* BACKGROUND */ - cob_field *prompt; /* PROMPT */ - int type; /* Structure type */ - int occurs; /* OCCURS */ - int attr; /* COB_SCREEN_TYPE_ATTRIBUTE */ -} cob_screen; - -/* Module structure */ -#define COB_MODULE_TYPE_PROGRAM 0 -#define COB_MODULE_TYPE_FUNCTION 1 - -/* - For backwards compatibility of the libcob ABI, the size of existing members - and their positions must not change! Add new members at the end. - */ -typedef struct __cob_module { - struct __cob_module *next; /* Next pointer */ - cob_field **cob_procedure_params; /* Arguments */ - const char *module_name; /* Module name */ - const char *module_formatted_date; /* Module full date */ - const char *module_source; /* Module source */ - cob_call_union module_entry; /* Module entry */ - cob_call_union module_cancel; /* Module cancel */ - const unsigned char *collating_sequence; /* COLLATING */ - cob_field *crt_status; /* CRT STATUS */ - cob_field *cursor_pos; /* CURSOR */ - unsigned int *module_ref_count; /* Module ref count */ - const char **module_path; /* Module path */ - - unsigned int module_active; /* Module is active */ - unsigned int module_date; /* Module num date */ - unsigned int module_time; /* Module num time */ - unsigned int module_type; /* Module type (program = 0, function = 1) */ - unsigned int module_param_cnt; /* Module param count */ - unsigned int module_returning; /* Module return type, currently unset+unused */ - int module_num_params; /* Module arg count */ - - unsigned char ebcdic_sign; /* DISPLAY SIGN */ - unsigned char decimal_point; /* DECIMAL POINT */ - unsigned char currency_symbol; /* CURRENCY */ - unsigned char numeric_separator; /* Separator */ - - unsigned char flag_filename_mapping; /* Mapping */ - unsigned char flag_binary_truncate; /* Truncation */ - unsigned char flag_pretty_display; /* Pretty display */ - unsigned char flag_host_sign; /* Host sign */ - - unsigned char flag_no_phys_canc; /* No physical cancel */ - unsigned char flag_main; /* Main module */ - unsigned char flag_fold_call; /* Fold case */ - unsigned char flag_exit_program; /* Exit after CALL */ - - unsigned char flag_did_cancel; /* Module has been canceled */ - unsigned char flag_dump_ready; /* Module was compiled with -fdump */ - unsigned char flag_debug_trace; /* Module debug/trace compile option */ -#define COB_MODULE_TRACE 2 -#define COB_MODULE_TRACEALL 4 - unsigned char unused[1]; /* Use these flags up later, added for alignment */ - - unsigned int module_stmt; /* Last statement executed */ - const char **module_sources; /* Source module names compiled */ - - unsigned int param_buf_size; /* Size of 'param_buf' */ - unsigned int param_buf_used; /* amount used from 'param_buf' */ - unsigned char *param_buf; /* BY VALUE parameters */ - unsigned int param_num; /* entries in 'param_field' */ - unsigned int param_max; /* Max entries in 'param_field' */ - cob_field **param_field; - - cob_field *xml_code; /* XML-CODE */ - cob_field *xml_event; /* XML-EVENT */ - cob_field *xml_information; /* XML-INFORMATION */ - cob_field *xml_namespace; /* XML-NAMESPACE */ - cob_field *xml_nnamespace; /* XML-NNAMESPACE */ - cob_field *xml_namespace_prefix; /* XML-NAMESPACE-PREFIX */ - cob_field *xml_nnamespace_prefix; /* XML-NNAMESPACE-PREFIX */ - cob_field *xml_ntext; /* XML-NTEXT */ - cob_field *xml_text; /* XML-TEXT */ - - cob_field *json_code; /* JSON-CODE */ - cob_field *json_status; /* JSON-STATUS */ - cob_field function_return; /* Copy of RETURNING field */ -} cob_module; - -/* For 'module_type' - * Values identical to CB_PROGRAM_TYPE & CB_FUNCTION_TYPE in tree.h - */ -#define COB_MODULE_PROGRAM 0 -#define COB_MODULE_FUNCTION 1 -#define COB_MODULE_C 2 - -/* User function structure */ - -struct cob_func_loc { - cob_field *ret_fld; - cob_field **save_proc_parms; - cob_field **func_params; - unsigned char **data; - cob_module *save_module; - int save_call_params; - int save_num_params; -}; - -/* File connector */ - -/* Key structure */ - -#define COB_MAX_KEYCOMP 8 /* max number of parts in a compound key (disam.h :: NPARTS ) */ - -typedef struct __cob_file_key { - unsigned int offset; /* Offset of field within record */ - short len_suppress; /* length of SUPPRESS "string" */ - short count_components; /* 0..1::simple-key 2..n::split-key */ - unsigned char keyn; /* Index Number */ - unsigned char tf_duplicates; /* WITH DUPLICATES (for RELATIVE/INDEXED) */ - /* 0=NO DUPS, 1=DUPS OK, 2=NO DUPS precheck */ - unsigned char tf_ascending; /* ASCENDING/DESCENDING (for SORT)*/ - unsigned char tf_suppress; /* supress keys where all chars = char_suppress */ - unsigned char char_suppress; /* key supression character */ - cob_field * field; /* Key field (or SPLIT key save area) */ - unsigned char * str_suppress; /* Complete SUPPRESS "string" */ - cob_field *component[COB_MAX_KEYCOMP];/* key-components iff split-key */ -} cob_file_key; - -typedef struct cob_io_stat_s { - unsigned int rqst_io; - unsigned int fail_io; -} cob_io_stats; - -/* Linage structure */ - -typedef struct __cob_linage { - cob_field *linage; /* LINAGE */ - cob_field *linage_ctr; /* LINAGE-COUNTER */ - cob_field *latfoot; /* LINAGE FOOTING */ - cob_field *lattop; /* LINAGE AT TOP */ - cob_field *latbot; /* LINAGE AT BOTTOM */ - int lin_lines; /* Current Linage */ - int lin_foot; /* Current Footage */ - int lin_top; /* Current Top */ - int lin_bot; /* Current Bottom */ -} cob_linage; - -/* File version */ -#define COB_FILE_VERSION 5 - -/* File structure */ - -/*NOTE: - * cob_file is now allocated by cob_file_create in common.c - * - * This is now setup using a few functions in order - * to keep 'cob_file' private from the code emmitted - * by codegen.c allowing more flexibility in the future - */ -typedef struct __cob_file { - unsigned char file_version; /* File handler version */ - unsigned char organization; /* ORGANIZATION */ - unsigned char access_mode; /* ACCESS MODE */ - unsigned char flag_line_adv; /* LINE ADVANCING */ - unsigned char flag_optional; /* OPTIONAL */ - unsigned char flag_select_features; /* SELECT features */ - unsigned char file_format; /* File I/O format: 255 means unspecified */ - unsigned char file_features; /* File I/O features: 0 means unspecified */ - - const char *select_name; /* Name in SELECT */ - unsigned char file_status[4]; /* FILE STATUS */ - cob_field *assign; /* ASSIGN TO */ - cob_field *record; /* Record area */ - cob_field *variable_record; /* Record size variable */ - cob_file_key *keys; /* ISAM/RANDOM/SORT keys */ - void *file; /* File specific pointer */ - cob_linage *linage; /* LINAGE */ - const unsigned char *sort_collating; /* SORT collating */ - void *extfh_ptr; /* For EXTFH usage */ - int record_min; /* Record min size */ - int record_max; /* Record max size */ - int nkeys; /* Number of keys */ - int fd; /* File descriptor */ - int record_slot; /* Record size on disk including prefix/suffix */ - int record_prefix; /* Size of record prefix */ - int file_header; /* Size of file header record on disk */ - cob_s64_t record_off; /* Starting position of last record read/written */ - cob_s64_t cur_rec_num; /* Current record number (1 relative) */ - cob_s64_t max_rec_num; /* Last record number (1 relative) in file */ - - unsigned char lock_mode; /* LOCK MODE */ - unsigned char open_mode; /* OPEN MODE */ - unsigned char last_open_mode; /* Mode given by OPEN */ - unsigned char flag_operation; /* File type specific */ - unsigned char flag_nonexistent; /* Nonexistent file */ - unsigned char flag_end_of_file; /* Reached end of file */ - unsigned char flag_begin_of_file; /* Reached start of file */ - unsigned char flag_first_read; /* OPEN/START read flag */ - unsigned char flag_read_done; /* READ successful */ - unsigned char flag_needs_nl; /* Needs NL at close */ - unsigned char flag_needs_top; /* Linage needs top */ - unsigned char flag_file_lock; /* Complete file is locked EXCLUSIVE use */ - unsigned char flag_record_lock; /* Lock record before REWRITE|DELETE */ - unsigned char flag_lock_rec; /* Issue lock on current record */ - unsigned char flag_lock_mode; /* 0 - Read; 1 - Write */ - unsigned char flag_lock_rls; /* Release previous record locks */ - unsigned char share_mode; /* Active SHARING MODE */ - unsigned char dflt_share; /* Default SHARING MODE */ - - unsigned short retry_mode; /* RETRY mode */ - unsigned short dflt_retry; /* Default RETRY mode */ - int retry_times; /* TIMES to RETRY I/O */ - int dflt_times; /* Default TIMES to RETRY I/O */ - int retry_seconds; /* SECONDS for RETRY */ - int dflt_seconds; /* Default SECONDS for RETRY */ - unsigned int prev_lock; /* Last record locked */ - - unsigned int trace_io:1; /* Display I/O record when TRACE READY */ - unsigned int io_stats:1; /* Report I/O statistics for this file */ - unsigned int flag_keycheck:1; /* INDEXED file keys must match */ - unsigned int flag_file_map:1; /* Filename Mapping was checked */ - unsigned int flag_redef:1; /* File format has been redefined */ - unsigned int flag_auto_type:1; /* Peek at file for File format */ - unsigned int flag_set_type:1; /* File type/format set via IO_asgname */ - unsigned int flag_set_isam:1; /* INDEXED type/format set via IO_asgname */ - unsigned int flag_big_endian:1; /* Force use of big-endian in BDB */ - unsigned int flag_little_endian:1;/* Force use of little-endian in BDB */ - unsigned int flag_ready:1; /* cob_file has been built completely */ - unsigned int flag_write_chk_dups:1;/* Do precheck for DUPLICATES on WRITE */ - unsigned int flag_redo_keydef:1; /* Keys are being redefined from dictionary */ - unsigned int flag_is_pipe:1; /* LINE SEQUENTIAL as 'pipe' */ - unsigned int unused_bits:18; - - cob_field *last_key; /* Last field used as 'key' for I/O */ - unsigned char last_operation; /* Most recent I/O operation */ -#define COB_LAST_START 1 -#define COB_LAST_READ_SEQ 2 -#define COB_LAST_READ 3 -#define COB_LAST_WRITE 4 -#define COB_LAST_REWRITE 5 -#define COB_LAST_DELETE 6 - -#define COB_LAST_OPEN 7 -#define COB_LAST_CLOSE 8 -#define COB_LAST_DELETE_FILE 9 -#define COB_LAST_COMMIT 10 -#define COB_LAST_ROLLBACK 11 - - unsigned char io_routine; /* Index to I/O routine function pointers */ - short curkey; /* Current file index read sequentially */ - - cob_io_stats stats[6]; /* I/O Counts by 'operation' type */ - - struct __fcd3 *fcd; /* FCD created via SET ... TO ADDRESS OF FH--FCD */ - const char *xfdname; /* Name for SQL table */ - const char *xfdschema; /* Override of COB_SCHEMA_DIR for this file */ - long file_pid; /* Process id of other end of pipe */ - void *fileout; /* output side of bi-directional pipe 'FILE*' */ - int fdout; /* output side of bi-directional pipe 'fd' */ -} cob_file; - - -/********************/ -/* Report structure */ -/********************/ - -/* for each SUM field of each line in the report */ -typedef struct __cob_report_sum { - struct __cob_report_sum *next; /* Next field */ - cob_field *f; /* Field to be summed */ -} cob_report_sum; - -/* for each field of each line in the report */ -typedef struct __cob_report_field { - struct __cob_report_field *next; /* Next field */ - cob_field *f; /* Field definition */ - cob_field *source; /* Field SOURCE */ - cob_field *control; /* CONTROL Field */ - char *litval; /* Literal value */ - int litlen; /* Length of literal string */ - unsigned int flags; - int line; - int column; - int step_count; - int next_group_line; /* NEXT GROUP line or PLUS line; see flags */ - unsigned int level:8; /* Data item level number */ - unsigned int group_indicate:1; /* field had GROUP INDICATE */ - unsigned int suppress:1; /* SUPPRESS display of this field */ - unsigned int present_now:1; /* PRESENT BEFORE|AFTER to be processed */ -} cob_report_field; - -/* for each line of a report */ -typedef struct __cob_report_line { - struct __cob_report_line *sister; /* Next line */ - struct __cob_report_line *child; /* Child line */ - cob_report_field *fields; /* List of fields on this line */ - cob_field *control; /* CONTROL Field */ - int use_decl; /* Label# of Declaratives code */ - unsigned int flags; /* flags defined with line */ - int line; /* 'LINE' value */ - int step_count; - int next_group_line; - unsigned int report_flags; /* flags ORed with upper level flags */ - unsigned int suppress:1; /* SUPPRESS printing this line */ -} cob_report_line; - -/* for each 'line referencing a control field' of the report */ -typedef struct __cob_report_control_ref { - struct __cob_report_control_ref *next; /* Next control_ref */ - cob_report_line *ref_line; /* Report Line with this control field */ -} cob_report_control_ref; - -/* for each 'control field' of the report */ -typedef struct __cob_report_control { - struct __cob_report_control *next; /* Next control */ - const char *name; /* Control field name */ - cob_field *f; /* Field definition */ - cob_field *val; /* previous field value */ - cob_field *sf; /* save field value */ - cob_report_control_ref *control_ref; /* References to this control field */ - int sequence; /* Order of Control Break */ - unsigned int data_change:1; /* Control field data did change */ - unsigned int has_heading:1; /* CONTROL HEADING */ - unsigned int has_footing:1; /* CONTROL FOOTING */ - unsigned int suppress:1; /* SUPPRESS printing this break */ -} cob_report_control; - -/* for each SUM counter in the report */ -typedef struct __cob_report_sumctr { - struct __cob_report_sumctr *next; /* Next sum counter */ - const char *name; /* Name of this SUM counter */ - cob_report_sum *sum; /* list of fields to be summed */ - cob_field *counter; /* Field to hold the SUM counter */ - cob_field *f; /* Data Field for SUM counter */ - cob_report_control *control; /* RESET when this control field changes */ - unsigned int reset_final:1; /* RESET on FINAL */ - unsigned int control_final:1; /* CONTROL FOOTING FINAL */ - unsigned int subtotal:1; /* This is a 'subtotal' counter */ - unsigned int crossfoot:1; /* This is a 'crossfoot' counter */ -} cob_report_sum_ctr; - -/* main report table for each RD */ -typedef struct __cob_report { - const char *report_name; /* Report name */ - struct __cob_report *next; /* Next report */ - cob_file *report_file; /* Report file */ - cob_field *page_counter; /* PAGE-COUNTER */ - cob_field *line_counter; /* LINE-COUNTER */ - cob_report_line *first_line; /* First defined LINE of report */ - cob_report_control *controls; /* control fields of report */ - cob_report_sum_ctr *sum_counters; /* List of SUM counters in report */ - int def_lines; /* Default lines */ - int def_cols; /* Default columns */ - int def_heading; /* Default heading */ - int def_first_detail; /* Default first detail */ - int def_last_control; /* Default last control */ - int def_last_detail; /* Default last detail */ - int def_footing; /* Default footing */ - int curr_page; /* Current page */ - int curr_line; /* Current line on page */ - int curr_cols; /* Current column on line */ - int curr_status; /* Current status */ - int next_value; /* NEXT GROUP Line/Page/Plus value */ - unsigned int control_final:1; /* CONTROL FINAL declared */ - unsigned int global:1; /* IS GLOBAL declared */ - unsigned int first_detail:1; /* First Detail on page */ - unsigned int in_page_footing:1; /* doing page footing now */ - unsigned int in_page_heading:1; /* doing page heading now */ - unsigned int first_generate:1; /* Ready for first GENERATE */ - unsigned int initiate_done:1; /* INITIATE has been done */ - unsigned int next_line:1; /* Advance to line on next DETAIL */ - - unsigned int next_line_plus:1; /* Advance to plus line on next DETAIL */ - unsigned int next_page:1; /* Advance to next page on next DETAIL */ - unsigned int next_just_set:1; /* NEXT xxx was just set so ignore */ - unsigned int in_report_footing:1; /* doing report footing now */ - unsigned int incr_line:1; /* 'curr_lines' should be incremented */ - unsigned int foot_next_page:1; /* Advance to next page after all CONTROL footings */ - unsigned int code_is_present:1; /* CODE IS present */ - unsigned int unused:17; /* Use these bits up next */ - - int code_len; /* Length to use for holding 'CODE IS' value */ - char *code_is; /* Value of CODE IS for this report */ -} cob_report; - -/* ML tree structure */ - -typedef struct __cob_ml_attr { - cob_field *name; - cob_field *value; - unsigned int is_suppressed; - struct __cob_ml_attr *sibling; -} cob_ml_attr; - -typedef struct __cob_ml_tree { - cob_field *name; - cob_ml_attr *attrs; - cob_field *content; - unsigned int is_suppressed; - struct __cob_ml_tree *children; - struct __cob_ml_tree *sibling; -} cob_ml_tree; - -/* Global variable structure */ - -typedef struct __cob_global { - cob_file *cob_error_file; /* Last error file */ - cob_module *cob_current_module; /* Current module */ - const char *last_exception_statement; /* SLast exception: tatement */ - const char *last_exception_id; /* Last exception: PROGRAMM-ID / FUNCTION-ID*/ - const char *last_exception_section; /* Last exception: Section */ - const char *last_exception_paragraph; /* Last exception: Paragraph */ - const char *cob_main_argv0; /* Main program */ - char *cob_locale; /* Program locale */ - char *cob_locale_orig; /* Initial locale */ - char *cob_locale_ctype; /* Initial locale */ - char *cob_locale_collate; /* Initial locale */ - char *cob_locale_messages; /* Initial locale */ - char *cob_locale_monetary; /* Initial locale */ - char *cob_locale_numeric; /* Initial locale */ - char *cob_locale_time; /* Initial locale */ - - int cob_exception_code; /* current exception code, in contrast to last_exception_code heavily changed */ - int cob_call_params; /* Number of current arguments - This is set to the actual number before a CALL - and is stored directly on module entry to its - cob_module structure within cob_module_enter(). - */ - int cob_initial_external; /* First external ref */ - unsigned int last_exception_line; /* Last exception: Program source line */ - unsigned int cob_got_exception; /* Exception active (see last_exception) */ - unsigned int cob_screen_initialized; /* Screen initialized */ - unsigned int cob_physical_cancel; /* Unloading of modules */ - /* screenio / termio */ - unsigned char *cob_term_buff; /* Screen I/O buffer */ - int cob_accept_status; /* ACCEPT STATUS */ - - int cob_max_y; /* Screen max y */ - int cob_max_x; /* Screen max x */ - int cob_call_from_c; /* Recent CALL was via cob_call & not COBOL */ - unsigned int cob_call_name_hash; /* Hash of subroutine name being CALLed */ - - unsigned int cob_stmt_exception; /* Statement has 'On Exception' */ - - unsigned int cob_debugging_mode; /* activation of USE ON DEBUGGING code */ - -} cob_global; - -/* Low level jump structure */ -struct cobjmp_buf { - int cbj_int[4]; - void *cbj_ptr[4]; - jmp_buf cbj_jmp_buf; - void *cbj_ptr_rest[2]; -}; - -/*******************************/ - -/* Function declarations */ - -/*******************************/ -/* Functions in common.c */ -COB_EXPIMP void print_info (void); -COB_EXPIMP void print_version (void); -COB_EXPIMP int cob_load_config (void); -COB_EXPIMP void print_runtime_conf (void); -COB_EXPIMP cob_field_attr *cob_alloc_attr(int type, int digits, int scale, int flags); - -COB_EXPIMP void cob_set_exception (const int); -COB_EXPIMP int cob_last_exception_is (const int); - - -/* General functions */ - -COB_EXPIMP int cob_is_initialized (void); -COB_EXPIMP cob_global *cob_get_global_ptr (void); - -COB_EXPIMP void cob_init (const int, char **); -COB_EXPIMP void cob_init_nomain (const int, char **); -COB_EXPIMP void cob_common_init (void *); - -COB_EXPIMP int cob_module_global_enter (cob_module **, cob_global **, - const int, const int, const unsigned int *); -COB_EXPIMP void cob_module_enter (cob_module **, cob_global **, - const int); -COB_EXPIMP void cob_module_leave (cob_module *); - -COB_EXPIMP void cob_module_free (cob_module **); - -DECLNORET COB_EXPIMP void cob_stop_run (const int) COB_A_NORETURN; -DECLNORET COB_EXPIMP void cob_fatal_error (const enum cob_fatal_error) COB_A_NORETURN; - -COB_EXPIMP void *cob_malloc (const size_t) COB_A_MALLOC; -COB_EXPIMP void *cob_realloc (void *, const size_t, const size_t) COB_A_MALLOC; -COB_EXPIMP char *cob_strdup (const char *); -COB_EXPIMP void cob_free (void *); -COB_EXPIMP void *cob_fast_malloc (const size_t) COB_A_MALLOC; -COB_EXPIMP void *cob_cache_malloc (const size_t) COB_A_MALLOC; -COB_EXPIMP void *cob_cache_realloc (void *, const size_t); -COB_EXPIMP void cob_cache_free (void *); - -COB_EXPIMP void cob_set_locale (cob_field *, const int); - -COB_EXPIMP int cob_setenv (const char *, const char *, int); -COB_EXPIMP int cob_unsetenv (const char *); -COB_EXPIMP char *cob_expand_env_string (char *); -COB_EXPIMP cob_field *cob_function_return (cob_field *); - -COB_EXPIMP void cob_check_version (const char *, const char *, - const int); - -COB_EXPIMP void *cob_save_func (cob_field **, const int, - const int, ...); -COB_EXPIMP void cob_restore_func (struct cob_func_loc *); - -COB_EXPIMP void cob_accept_arg_number (cob_field *); -COB_EXPIMP void cob_accept_arg_value (cob_field *); -COB_EXPIMP void cob_accept_command_line (cob_field *); -COB_EXPIMP void cob_accept_date (cob_field *); -COB_EXPIMP void cob_accept_date_yyyymmdd (cob_field *); -COB_EXPIMP void cob_accept_day (cob_field *); -COB_EXPIMP void cob_accept_day_yyyyddd (cob_field *); -COB_EXPIMP void cob_accept_day_of_week (cob_field *); -COB_EXPIMP void cob_accept_environment (cob_field *); -COB_EXPIMP void cob_accept_exception_status (cob_field *); -COB_EXPIMP void cob_accept_time (cob_field *); -COB_EXPIMP void cob_accept_user_name (cob_field *); -COB_EXPIMP void cob_display_command_line (cob_field *); -COB_EXPIMP void cob_display_environment (const cob_field *); -COB_EXPIMP void cob_display_env_value (const cob_field *); -COB_EXPIMP void cob_display_arg_number (cob_field *); -COB_EXPIMP void cob_get_environment (const cob_field *, cob_field *); -COB_EXPIMP void cob_set_environment (const cob_field *, - const cob_field *); -COB_EXPIMP void cob_chain_setup (void *, const size_t, - const size_t); -COB_EXPIMP void cob_allocate (unsigned char **, cob_field *, - cob_field *, cob_field *); -COB_EXPIMP void cob_free_alloc (unsigned char **, unsigned char *); -COB_EXPIMP void cob_continue_after (cob_field *); -COB_EXPIMP int cob_extern_init (void); -COB_EXPIMP int cob_tidy (void); -COB_EXPIMP char *cob_command_line (int, int *, char ***, - char ***, char **); -COB_EXPIMP char *cob_getenv (const char *); -COB_EXPIMP int cob_putenv (char *); - -COB_EXPIMP void cob_incr_temp_iteration (void); -COB_EXPIMP void cob_temp_name (char *, const char *); - -/* System routines */ -COB_EXPIMP int cob_sys_exit_proc (const void *, const void *); -COB_EXPIMP int cob_sys_error_proc (const void *, const void *); -COB_EXPIMP int cob_sys_system (const void *); -COB_EXPIMP int cob_sys_hosted (void *, const void *); -COB_EXPIMP int cob_sys_and (const void *, void *, const int); -COB_EXPIMP int cob_sys_or (const void *, void *, const int); -COB_EXPIMP int cob_sys_nor (const void *, void *, const int); -COB_EXPIMP int cob_sys_xor (const void *, void *, const int); -COB_EXPIMP int cob_sys_imp (const void *, void *, const int); -COB_EXPIMP int cob_sys_nimp (const void *, void *, const int); -COB_EXPIMP int cob_sys_eq (const void *, void *, const int); -COB_EXPIMP int cob_sys_not (void *, const int); -COB_EXPIMP int cob_sys_xf4 (void *, const void *); -COB_EXPIMP int cob_sys_xf5 (const void *, void *); -COB_EXPIMP int cob_sys_x91 (void *, const void *, void *); -COB_EXPIMP int cob_sys_toupper (void *, const int); -COB_EXPIMP int cob_sys_tolower (void *, const int); -COB_EXPIMP int cob_sys_oc_nanosleep (const void *); -COB_EXPIMP int cob_sys_getpid (void); -COB_EXPIMP int cob_sys_return_args (void *); -COB_EXPIMP int cob_sys_parameter_size (void *); -COB_EXPIMP int cob_sys_fork (void); -COB_EXPIMP int cob_sys_waitpid (const void *); - -/* - * cob_sys_getopt_long_long - */ -COB_EXPIMP int cob_sys_getopt_long_long (void*, void*, void*, const int, void*, void*); -typedef struct __longoption_def { - char name[25]; - char has_option; - char return_value_pointer[sizeof(char*)]; - char return_value[4]; -} longoption_def; - - -COB_EXPIMP int cob_sys_sleep (const void *); -COB_EXPIMP int cob_sys_calledby (void *); -COB_EXPIMP int cob_sys_justify (void *, ...); -COB_EXPIMP int cob_sys_printable (void *, ...); - -COB_EXPIMP int cob_sys_extfh (const void *, void *); - -/* Utilities */ - -COB_EXPIMP void cob_trace_sect (const char *name); -COB_EXPIMP void cob_trace_para (const char *name); -COB_EXPIMP void cob_trace_entry (const char *name); -COB_EXPIMP void cob_trace_exit (const char *name); -COB_EXPIMP void cob_trace_stmt (const char *stmt); - -COB_EXPIMP void *cob_external_addr (const char *, const int); -COB_EXPIMP unsigned char *cob_get_pointer (const void *); -COB_EXPIMP void cob_ready_trace (void); -COB_EXPIMP void cob_reset_trace (void); - -/* Call from outside to set/read/re-evaluate libcob options */ -enum cob_runtime_option_switch { - COB_SET_RUNTIME_TRACE_FILE = 0, /* 'p' is FILE * */ - COB_SET_RUNTIME_DISPLAY_PRINTER_FILE = 1, /* 'p' is FILE * */ - COB_SET_RUNTIME_RESCAN_ENV = 2, /* rescan environment variables */ - COB_SET_RUNTIME_DISPLAY_PUNCH_FILE = 3 /* 'p' is FILE * */ -}; -COB_EXPIMP void cob_set_runtime_option (enum cob_runtime_option_switch opt, void *p); -COB_EXPIMP void *cob_get_runtime_option (enum cob_runtime_option_switch opt); - -#define COB_GET_LINE_NUM(n) ( n & 0xFFFFF ) -#define COB_GET_FILE_NUM(n) ( (n >> 20) & 0xFFF) -#define COB_SET_LINE_FILE(l,f) ( (unsigned int)((unsigned int)f<<20) | l) - -/* Datetime structure */ -struct cob_time -{ - int year; /* Year [1900-9999] */ - int month; /* Month [1-12] 1 = Jan ... 12 = Dec */ - int day_of_month; /* Day [1-31] */ - int day_of_week; /* Day of week [1-7] 1 = Monday ... 7 = Sunday */ - int day_of_year; /* Days in year [1-366] -1 on _WIN32! */ - int hour; /* Hours [0-23] */ - int minute; /* Minutes [0-59] */ - int second; /* Seconds [0-60] (1 leap second) */ - int nanosecond; /* Nanoseconds */ - int offset_known; - int utc_offset; /* Minutes east of UTC */ - int is_daylight_saving_time; /* DST [-1/0/1] */ -}; - -COB_EXPIMP struct cob_time cob_get_current_date_and_time (void); - -COB_EXPIMP void cob_sleep_msec (const unsigned int); - -/* Registration of external handlers */ -COB_EXPIMP void cob_reg_sighnd (void (*sighnd) (int)); - -/* Raise signal (run both internal and external handlers) */ -COB_EXPIMP void cob_raise (int); - -/* Switch */ - -COB_EXPIMP int cob_get_switch (const int); -COB_EXPIMP void cob_set_switch (const int, const int); - -/* Comparison */ - -COB_EXPIMP int cob_cmp (cob_field *, cob_field *); - -/* Class check */ - -COB_EXPIMP int cob_is_omitted (const cob_field *); -COB_EXPIMP int cob_is_numeric (const cob_field *); -COB_EXPIMP int cob_is_alpha (const cob_field *); -COB_EXPIMP int cob_is_upper (const cob_field *); -COB_EXPIMP int cob_is_lower (const cob_field *); - -/* Table sort */ - -COB_EXPIMP void cob_table_sort_init (const size_t, const unsigned char *); -COB_EXPIMP void cob_table_sort_init_key (cob_field *, const int, - const unsigned int); -COB_EXPIMP void cob_table_sort (cob_field *, const int); - -/* Run-time error checking */ - -COB_EXPIMP void cob_check_numeric (const cob_field *, const char *); -COB_EXPIMP void cob_correct_numeric (cob_field *); -COB_EXPIMP void cob_check_based (const unsigned char *, - const char *); -COB_EXPIMP void cob_check_linkage (const unsigned char *, - const char *, const int); -COB_EXPIMP void cob_check_odo (const int, const int, const int, - const char *, const char *); -COB_EXPIMP void cob_check_subscript (const int, const int, - const char *, const int); -COB_EXPIMP void cob_check_ref_mod (const int, const int, - const int, const char *); - -/* Comparison functions */ -COB_EXPIMP int cob_numeric_cmp (cob_field *, cob_field *); - -/*******************************/ -/* Functions in strings.c */ - -COB_EXPIMP void cob_inspect_init (cob_field *, const cob_u32_t); -COB_EXPIMP void cob_inspect_start (void); -COB_EXPIMP void cob_inspect_before (const cob_field *); -COB_EXPIMP void cob_inspect_after (const cob_field *); -COB_EXPIMP void cob_inspect_characters (cob_field *); -COB_EXPIMP void cob_inspect_all (cob_field *, cob_field *); -COB_EXPIMP void cob_inspect_leading (cob_field *, cob_field *); -COB_EXPIMP void cob_inspect_first (cob_field *, cob_field *); -COB_EXPIMP void cob_inspect_trailing (cob_field *, cob_field *); -COB_EXPIMP void cob_inspect_converting (const cob_field *, const cob_field *); -COB_EXPIMP void cob_inspect_finish (void); - -COB_EXPIMP void cob_string_init (cob_field *, cob_field *); -COB_EXPIMP void cob_string_delimited (cob_field *); -COB_EXPIMP void cob_string_append (cob_field *); -COB_EXPIMP void cob_string_finish (void); - -COB_EXPIMP void cob_unstring_init (cob_field *, cob_field *, const size_t); -COB_EXPIMP void cob_unstring_delimited (cob_field *, const cob_u32_t); -COB_EXPIMP void cob_unstring_into (cob_field *, cob_field *, cob_field *); -COB_EXPIMP void cob_unstring_tallying (cob_field *); -COB_EXPIMP void cob_unstring_finish (void); - -/*******************************/ -/* Functions in move.c */ -/*******************************/ - -COB_EXPIMP void cob_move (cob_field *, cob_field *); -COB_EXPIMP void cob_move_ibm (void *, void *, const int); -COB_EXPIMP void cob_set_int (cob_field *, const int); -COB_EXPIMP int cob_get_int (cob_field *); -COB_EXPIMP void cob_set_llint (cob_field *, cob_s64_t, cob_s64_t); -COB_EXPIMP void cob_set_llcon (cob_field *, cob_s64_t); -COB_EXPIMP cob_s64_t cob_get_llint (cob_field *); -COB_EXPIMP void cob_alloc_move(cob_field *, cob_field *, const int); -/**************************************************/ -/* Functions in move.c for C access to COBOL data */ -/**************************************************/ -COB_EXPIMP char * cob_get_picx( void *cbldata, size_t len, void *charfld, size_t charlen); -COB_EXPIMP cob_s64_t cob_get_s64_comp3(void *cbldata, int len); -COB_EXPIMP cob_s64_t cob_get_s64_comp5(void *cbldata, int len); -COB_EXPIMP cob_s64_t cob_get_s64_compx(void *cbldata, int len); -COB_EXPIMP cob_s64_t cob_get_s64_pic9 (void *cbldata, int len); -COB_EXPIMP cob_u64_t cob_get_u64_comp3(void *cbldata, int len); -COB_EXPIMP cob_u64_t cob_get_u64_comp5(void *cbldata, int len); -COB_EXPIMP cob_u64_t cob_get_u64_comp6(void *cbldata, int len); -COB_EXPIMP cob_u64_t cob_get_u64_compx(void *cbldata, int len); -COB_EXPIMP cob_u64_t cob_get_u64_pic9 (void *cbldata, int len); -COB_EXPIMP float cob_get_comp1(void *cbldata); -COB_EXPIMP double cob_get_comp2(void *cbldata); -COB_EXPIMP void cob_put_comp1(float val, void *cbldata); -COB_EXPIMP void cob_put_comp2(double val, void *cbldata); -COB_EXPIMP void cob_put_picx( void *cbldata, size_t len, void *string); -COB_EXPIMP void cob_put_s64_comp3(cob_s64_t val, void *cbldata, int len); -COB_EXPIMP void cob_put_s64_comp5(cob_s64_t val, void *cbldata, int len); -COB_EXPIMP void cob_put_s64_compx(cob_s64_t val, void *cbldata, int len); -COB_EXPIMP void cob_put_s64_pic9 (cob_s64_t val, void *cbldata, int len); -COB_EXPIMP void cob_put_u64_comp3(cob_u64_t val, void *cbldata, int len); -COB_EXPIMP void cob_put_u64_comp5(cob_u64_t val, void *cbldata, int len); -COB_EXPIMP void cob_put_u64_comp6(cob_u64_t val, void *cbldata, int len); -COB_EXPIMP void cob_put_u64_compx(cob_u64_t val, void *cbldata, int len); -COB_EXPIMP void cob_put_u64_pic9 (cob_u64_t val, void *cbldata, int len); -COB_EXPIMP void cob_put_pointer(void *val, void *cbldata); - - -/**************************/ -/* Functions in numeric.c */ - -#ifndef COB_WITHOUT_DECIMAL -COB_EXPIMP void cob_decimal_init (cob_decimal *); -COB_EXPIMP void cob_decimal_clear (cob_decimal *); -COB_EXPIMP void cob_decimal_set_llint (cob_decimal *, const cob_s64_t); -COB_EXPIMP void cob_decimal_set_ullint (cob_decimal *, const cob_u64_t); -COB_EXPIMP void cob_decimal_set_field (cob_decimal *, cob_field *); -COB_EXPIMP int cob_decimal_get_field (cob_decimal *, cob_field *, const int); -COB_EXPIMP void cob_decimal_add (cob_decimal *, cob_decimal *); -COB_EXPIMP void cob_decimal_sub (cob_decimal *, cob_decimal *); -COB_EXPIMP void cob_decimal_mul (cob_decimal *, cob_decimal *); -COB_EXPIMP void cob_decimal_div (cob_decimal *, cob_decimal *); -COB_EXPIMP void cob_decimal_pow (cob_decimal *, cob_decimal *); -COB_EXPIMP int cob_decimal_cmp (cob_decimal *, cob_decimal *); -COB_EXPIMP void cob_decimal_align(cob_decimal *, const int); -#endif - -COB_EXPIMP void cob_add (cob_field *, cob_field *, const int); -COB_EXPIMP void cob_sub (cob_field *, cob_field *, const int); -COB_EXPIMP void cob_mul (cob_field *, cob_field *, const int); -COB_EXPIMP void cob_div (cob_field *, cob_field *, const int); -COB_EXPIMP int cob_add_int (cob_field *, const int, const int); -COB_EXPIMP int cob_sub_int (cob_field *, const int, const int); -COB_EXPIMP void cob_div_quotient (cob_field *, cob_field *, - cob_field *, const int); -COB_EXPIMP void cob_div_remainder (cob_field *, const int); - -COB_EXPIMP int cob_cmp_int (cob_field *, const int); -COB_EXPIMP int cob_cmp_uint (cob_field *, const unsigned int); -COB_EXPIMP int cob_cmp_llint (cob_field *, const cob_s64_t); -COB_EXPIMP int cob_cmp_packed (cob_field *, const cob_s64_t); -COB_EXPIMP int cob_cmp_numdisp (const unsigned char *, - const size_t, const cob_s64_t, - const cob_u32_t); -COB_EXPIMP int cob_cmp_float (cob_field *, cob_field *); -COB_EXPIMP void cob_set_packed_zero (cob_field *); -COB_EXPIMP void cob_set_packed_int (cob_field *, const int); - -COB_EXPIMP void cob_decimal_alloc (const cob_u32_t, ...); -COB_EXPIMP void cob_decimal_push (const cob_u32_t, ...); -COB_EXPIMP void cob_decimal_pop (const cob_u32_t, ...); - -COB_EXPIMP void cob_gmp_free (void *); - - -/*******************************/ -/* Functions in call.c */ - -DECLNORET COB_EXPIMP void cob_call_error (void) COB_A_NORETURN; -COB_EXPIMP void cob_field_constant (cob_field *f, cob_field *t, cob_field_attr *a, void *d); -COB_EXPIMP void cob_field_value (cob_field *f, cob_field *t, cob_field_attr *a, void *d); -COB_EXPIMP void cob_field_content (cob_field *f, cob_field *t, cob_field_attr *a, void *d); -COB_EXPIMP unsigned int cob_get_name_hash (const char *name); - -COB_EXPIMP void cob_set_cancel (cob_module *); -COB_EXPIMP void * cob_load_lib (const char *library, const char *entry); -COB_EXPIMP int cob_encode_program_id (const unsigned char * const, unsigned char * const, - const int, const int); -COB_EXPIMP void *cob_resolve (const char *); -COB_EXPIMP void *cob_resolve_cobol (const char *, const int, - const int); -COB_EXPIMP void *cob_resolve_func (const char *); -COB_EXPIMP const char *cob_resolve_error (void); -COB_EXPIMP void *cob_call_field (const cob_field *, - const struct cob_call_struct *, - const unsigned int, - const int); -COB_EXPIMP void cob_cancel_field (const cob_field *, - const struct cob_call_struct *); -COB_EXPIMP void cob_cancel (const char *); -COB_EXPIMP int cob_call (const char *, const int, void **); -COB_EXPIMP int cob_func (const char *, const int, void **); -COB_EXPIMP void *cob_savenv (struct cobjmp_buf *); -COB_EXPIMP void *cob_savenv2 (struct cobjmp_buf *, const int); -COB_EXPIMP void cob_longjmp (struct cobjmp_buf *); -COB_EXPIMP int cob_get_name_line ( char *prog, int *line ); -COB_EXPIMP int cob_get_num_params ( void ); -COB_EXPIMP void cob_set_num_params ( int num_params ); -COB_EXPIMP int cob_get_param_constant ( int num_param ); -COB_EXPIMP int cob_get_param_digits( int num_param ); -COB_EXPIMP int cob_get_param_scale( int num_param ); -COB_EXPIMP int cob_get_param_sign ( int num_param ); -COB_EXPIMP int cob_get_param_size ( int num_param ); -COB_EXPIMP int cob_get_param_type ( int num_param ); -COB_EXPIMP void * cob_get_param_data ( int num_param ); -COB_EXPIMP cob_s64_t cob_get_s64_param ( int num_param ); -COB_EXPIMP cob_u64_t cob_get_u64_param ( int num_param ); -COB_EXPIMP char * cob_get_picx_param ( int num_param, void *charfld, size_t charlen ); -COB_EXPIMP void * cob_get_grp_param ( int num_param, void *charfld, size_t charlen ); -COB_EXPIMP void cob_put_s64_param ( int num_param, cob_s64_t value ); -COB_EXPIMP void cob_put_u64_param ( int num_param, cob_u64_t value ); -COB_EXPIMP void cob_put_picx_param ( int num_param, void *charfld ); -COB_EXPIMP void cob_put_grp_param ( int num_param, void *charfld, size_t charlen ); - -/*******************************/ -/* Functions in screenio.c */ - -COB_EXPIMP void cob_screen_line_col (cob_field *, const int); -COB_EXPIMP void cob_screen_display (cob_screen *, cob_field *, - cob_field *, const int); -COB_EXPIMP void cob_screen_accept (cob_screen *, cob_field *, - cob_field *, cob_field *, - const int); -COB_EXPIMP void cob_field_display (cob_field *, cob_field *, cob_field *, - cob_field *, cob_field *, cob_field *, - cob_field *, const cob_flags_t); -COB_EXPIMP void cob_field_accept (cob_field *, cob_field *, cob_field *, - cob_field *, cob_field *, cob_field *, - cob_field *, cob_field *, cob_field *, - const cob_flags_t); -COB_EXPIMP int cob_display_text (const char *); -COB_EXPIMP int cob_display_formatted_text (const char *, ...); -COB_EXPIMP int cob_get_char (void); -COB_EXPIMP void cob_set_cursor_pos (int, int); -COB_EXPIMP void cob_accept_escape_key (cob_field *); -COB_EXPIMP int cob_sys_clear_screen (void); -COB_EXPIMP int cob_sys_sound_bell (void); -COB_EXPIMP int cob_sys_get_scr_size (unsigned char *, unsigned char *); -COB_EXPIMP int cob_sys_get_char (unsigned char *); -COB_EXPIMP int cob_get_text (char *, int); -COB_EXPIMP int cob_get_scr_cols (void); -COB_EXPIMP int cob_get_scr_lines (void); -COB_EXPIMP int cob_sys_get_csr_pos (unsigned char *); -COB_EXPIMP int cob_sys_set_csr_pos (unsigned char *); - -/****************************************************************************** -* * -* Data structure definitions and function prototypes for the External File * -* Handler (ExtFH) as defined by Micro Focus COBOL for use with GnuCOBOL * -* * -******************************************************************************/ -/* - * COBOL status code values -*/ -#define S1_SUCCESS '0' -#define S1_AT_END '1' -#define S1_INVALID_KEY '2' -#define S1_PERMANENT_ERROR '3' -#define S1_LOGIC_ERROR '4' -#define S1_RUN_TIME_ERROR '9' - -#define S2_NO_INFO '0' /* S1_SUCCESS */ -#define S2_DUPLICATE '2' -#define S2_REC_LENGTH '4' -#define S2_FILE_MISSING '5' -#define S2_REEL_UNIT '7' -#define S2_AT_END '0' /* S1_AT_END */ -#define S2_KEY_LENGTH '4' -#define S2_SEQ_ERROR '1' /* S1_INVALID_KEY */ -#define S2_DUPLICATE_ERROR '2' -#define S2_NO_FIND '3' -#define S2_BOUNDARY_ERROR '4' -#define S2_OPEN_ERROR '7' /* S1_PERMANENT_ERROR */ -#define S2_OPEN_LOCK '8' -#define S2_ATTR_CONFLICT '9' -#define S2_ALREADY_OPEN '1' /* S1_LOGIC_ERROR */ -#define S2_ALREADY_CLOSED '2' -#define S2_NO_READ '3' -#define S2_NO_NEXT '6' -#define S2_NOT_INPUT '7' -#define S2_NOT_OUTPUT '8' -#define S2_NOT_OUTPUT2 '9' - -/******************************************** - INDEXED FILE Key definition block -********************************************/ -#define MF_MAXKEYS 64 -typedef struct { - unsigned char count[2]; /* Component count */ - unsigned char offset[2]; /* Offset to components */ - unsigned char keyFlags; -#define KEY_SPARSE 0x02 -#define KEY_PRIMARY 0x10 -#define KEY_DUPS 0x40 - unsigned char compFlags; -#define KEY_COMP_DUPS 0x01 -#define KEY_COMP_LEADING 0x02 -#define KEY_COMP_TRAILING 0x04 - unsigned char sparse; /* Character which defines SPARSE key */ - unsigned char reserved[9]; -} KDB_KEY; - -typedef struct { - unsigned char kdbLen[2]; - char filler[4]; - unsigned char nkeys[2]; - char filler2[6]; - KDB_KEY key[MF_MAXKEYS]; -} KDB; - -typedef struct { - unsigned char desc; - unsigned char type; - unsigned char pos[4]; /* Position in record */ - unsigned char len[4]; /* length of key component */ -} EXTKEY; - -#define MF_MAXKEYAREA (sizeof(KDB)+(sizeof(EXTKEY)*MF_MAXKEYS)) -/**************************** - * File Control Description (FCD). The format of this structure is - * defined by the MicroFocus COBOL compiler. Do not change this - * structure unless required by changes to MF COBOL. -****************************/ - -#define pointer_8byte(type, name) \ - union { \ - type *ptr_name; \ - char filler[8]; \ - } name - -/**********************************************************/ -/* */ -/* Warning: Do not change the format of FCD3 */ -/* : It must remain exact Binary Compatible */ -/* : With what Microfocus uses */ -/* */ -/**********************************************************/ - -/**********************************************************/ -/* Following is the 64-bit FCD (or also known as FCD3) */ -/* This format is used at least for: */ -/* - MF Visual COBOL (both 32 and 64 bit) */ -/* - MF Developer Enterprise (both 32 and 64 bit) */ -/* - MF Server Express (64 bit) */ -/* - MF Studio Enterprise (64 bit) */ -/* */ -/* The FCD2 format is currently not supported, it was */ -/* used at least for */ -/* - MF Server Express, Net Express (32 bit) */ -/* - MF Studio Enterprise (32 bit) */ -/* */ -/* MF says: FCD 1 is obsolete and should never be used */ -/**********************************************************/ -typedef struct __fcd3 { - unsigned char fileStatus[2]; /* I/O completion status */ - unsigned char fcdLen[2]; /* contains length of FCD */ - char fcdVer; /* FCD format version */ -#define FCD_VER_64Bit 1 - unsigned char fileOrg; /* file organization */ -#define ORG_LINE_SEQ 0 -#define ORG_SEQ 1 -#define ORG_INDEXED 2 -#define ORG_RELATIVE 3 -#define ORG_DETERMINE 255 /* not really implemented yet */ - unsigned char accessFlags; /* status byte (bit 7) & file access flags (bits 0-6)*/ -#define ACCESS_SEQ 0 -#define ACCESS_DUP_PRIME 1 /* not implemented yet */ -#define ACCESS_RANDOM 4 -#define ACCESS_DYNAMIC 8 -#define ACCESS_USER_STAT 0x80 - unsigned char openMode; /* open mode INPUT, I-O, etc. */ -#define OPEN_INPUT 0 -#define OPEN_OUTPUT 1 -#define OPEN_IO 2 -#define OPEN_EXTEND 3 -#define OPEN_NOT_OPEN 128 - unsigned char recordMode; /* recording mode */ -#define REC_MODE_FIXED 0 -#define REC_MODE_VARIABLE 1 - unsigned char fileFormat; /* File format */ -#define MF_FF_DEFAULT 0 /* Default format */ -#define MF_FF_CISAM 1 /* C-ISAM format */ -#define MF_FF_LEVELII 2 /* LEVEL II COBOL format */ -#define MF_FF_COBOL 3 /* IDXFORMAT"3" format (COBOL2) */ -#define MF_FF_IDX4 4 /* IDXFORMAT"4" format */ -#define MF_FF_IDX8 8 /* IDXFORMAT"8" format (BIG) */ -#define MF_FF_DISAM 16 /* D-ISAM format */ -#define MF_FF_VBISAM 17 /* VB-ISAM format */ -#define MF_FF_BDB 18 /* BDB format for INDEXED file */ -#define MF_FF_LMDB 19 /* LMDB format for INDEXED file */ -#define MF_FF_ODBC 20 /* ODBC format for INDEXED file */ -#define MF_FF_OCI 21 /* OCI format for INDEXED file */ - unsigned char deviceFlag; - unsigned char lockAction; - unsigned char compType; /* data compression type */ - unsigned char blocking; - unsigned char idxCacheSz; /* index cache size */ - unsigned char percent; - unsigned char blockSize; - unsigned char flags1; - unsigned char flags2; - unsigned char mvsFlags; - unsigned char fstatusType; -#define MF_FST_COBOL85 0x80 -#define MF_FST_NoSpaceFill 0x40 -#define MF_FST_NoStripSpaces 0x20 -#define MF_FST_NoExpandtabs 0x10 -#define MF_FST_LsRecLF 0x08 -#define MF_FST_InsertTabs 0x04 -#define MF_FST_InsertNulls 0x02 -#define MF_FST_CRdelim 0x01 - unsigned char otherFlags; /* miscellaneous flags */ -#define OTH_OPTIONAL 0x80 -#define OTH_NOT_OPTIONAL 0x20 -#define OTH_EXTERNAL 0x10 -#define OTH_DOLSREAD 0x08 -#define OTH_NODETECTLOCK 0x04 -#define OTH_MULTI_REEL 0x02 -#define OTH_LINE_ADVANCE 0x01 - unsigned char transLog; - unsigned char lockTypes; - unsigned char fsFlags; - unsigned char confFlags; /* configuration flags */ -#define MF_CF_WRTHRU 0x80 /* Write through to disk */ -#define MF_CF_RELADRS 0x40 /* Use relative byte address */ -#define MF_CF_UPPTR 0x20 /* Update current record pointer */ -#define MF_CF_REC64 0x10 /* Use 64-bit record address */ - unsigned char miscFlags; /* misc flags */ - unsigned char confFlags2; /* configuration flags */ - unsigned char lockMode; /* locking flags */ -#define FCD_LOCK_MULTI 0x80 -#define FCD_LOCK_WRITE 0x40 -#define FCD_LOCK_RETRY_OPEN 0x20 -#define FCD_LOCK_SKIP 0x10 -#define FCD_LOCK_RETRY_LOCK 0x08 -#define FCD_LOCK_MANU_LOCK 0x04 -#define FCD_LOCK_AUTO_LOCK 0x02 -#define FCD_LOCK_EXCL_LOCK 0x01 - unsigned char fsv2Flags; /* Fileshare V2 flags */ - unsigned char idxCacheArea; /* index cache buffers */ - unsigned char fcdInternal1; - unsigned char fcdInternal2; - char res3[14]; - unsigned char gcFlags; /* was "res3"; Local GnuCOBOL feature only */ -#define MF_CALLFH_GNUCOBOL 0x80 /* GnuCOBOL is being used */ -#define MF_CALLFH_BYPASS 0x40 /* Stop passing this file to 'callfh' */ -#define MF_CALLFH_TRACE 0x20 /* Trace I/O for this file */ -#define MF_CALLFH_STATS 0x10 /* Record Stats for this file */ - unsigned char nlsId[2]; - char fsv2FileId[2]; /* Fileshare V2 file id */ - char retryOpenCount[2]; - unsigned char fnameLen[2]; /* file name length */ - unsigned char idxNameLen[2]; /* index name length */ - char retryCount[2]; - unsigned char refKey[2]; /* key of reference */ - unsigned char lineCount[2]; - unsigned char useFiles; - unsigned char giveFiles; - unsigned char effKeyLen[2]; /* effective key length */ - char res5[14]; - unsigned char eop[2]; /* was "res5"; Use for cob_write eop value */ - char opt[4]; /* was "res5"; Use for cob_write opts value */ - unsigned char curRecLen[4]; /* current record length in bytes */ - unsigned char minRecLen[4]; /* min. record length in bytes */ - unsigned char maxRecLen[4]; /* max. record length in bytes */ - char fsv2SessionId[4]; /* Fileshare V2 session id */ - char res6[24]; - unsigned char relByteAdrs[8]; /* 64-bit, relative byte address */ - unsigned char maxRelKey[8]; /* 64-bit, max relative key/Record num */ - unsigned char relKey[8]; /* 64-bit, (cur) relative key/Record num */ - pointer_8byte(void, _fileHandle); /* file handle */ - pointer_8byte(unsigned char, _recPtr); /* pointer to record area */ - pointer_8byte(char, _fnamePtr); /* pointer to file name area */ - pointer_8byte(char, _idxNamePtr); /* pointer to index name area */ - pointer_8byte(KDB, _kdbPtr); /* pointer to key definition block */ - pointer_8byte(void, _colPtr); /* pointer to collating sequence block */ - pointer_8byte(void, _fileDef); /* pointer to filedef */ - pointer_8byte(void, _dfSortPtr); /* pointer to DFSORT */ -} FCD3; - -#define fileHandle _fileHandle.ptr_name /* EXTFH: file handle */ -#define recPtr _recPtr.ptr_name /* EXTFH: pointer to record area */ -#define fnamePtr _fnamePtr.ptr_name /* EXTFH: pointer to file name area */ -#define idxNamePtr _idxNamePtr.ptr_name /* EXTFH: pointer to index name area */ -#define kdbPtr _kdbPtr.ptr_name /* EXTFH: pointer to key definition block */ -#define colPtr _colPtr.ptr_name /* EXTFH: pointer to collating sequence block */ -#define fileDef _fileDef.ptr_name /* EXTFH: pointer to filedef */ -#define dfSortPtr _dfSortPtr.ptr_name /* EXTFH: pointer to DFSORT */ - -#define LSUCHAR(f) ((unsigned char*)(f)) -/* xxCOMPXn : Big Endian Binary data */ -#define LDCOMPX2(f) (((f[0] << 8 ) & 0xFF00) | (f[1] & 0xFF)) -#define LDCOMPX4(f) (((f[0] << 24 ) & 0xFF000000) | ((f[1] << 16 ) & 0xFF0000) | ((f[2] << 8 ) & 0xFF00) | (f[3] & 0xFF)) -#define STCOMPX2(v,f) (f[1] = (v) & 0xFF, f[0] = ((v) >> 8) & 0xFF) -#define STCOMPX4(v,f) (f[3] = (v) & 0xFF, f[2] = ((v) >> 8) & 0xFF, f[1] = ((v) >> 16) & 0xFF, f[0] = ((v) >> 24) & 0xFF) - -/* xxBINLEn : Little Endian Binary data */ -#define LDBINLE2(f) (((f[1] << 8 ) & 0xFF00) | (f[0] & 0xFF)) -#define LDBINLE4(f) (((f[3] << 24 ) & 0xFF000000) | ((f[2] << 16 ) & 0xFF0000) | ((f[1] << 8 ) & 0xFF00) | (f[0] & 0xFF)) -#define STBINLE2(v,f) (f[0] = (v) & 0xFF, f[1] = ((v) >> 8) & 0xFF) -#define STBINLE4(v,f) (f[0] = (v) & 0xFF, f[1] = ((v) >> 8) & 0xFF, f[2] = ((v) >> 16) & 0xFF, f[3] = ((v) >> 24) & 0xFF) - -/*************************/ -/* EXTFH operation codes */ -/*************************/ -#define OP_GETINFO 0x0006 -#define OP_CRE8_INDEX 0x0007 -#define OP_FLUSH 0x000C -#define OP_UNLOCK_REC 0x000F - -#define OP_CLOSE 0xFA80 /* OP CODES */ -#define OP_CLOSE_LOCK 0xFA81 -#define OP_CLOSE_NO_REWIND 0xFA82 -#define OP_CLOSE_REEL 0xFA84 -#define OP_CLOSE_REMOVE 0xFA85 -#define OP_CLOSE_NOREWIND 0xFA86 - -#define OP_OPEN_INPUT 0xFA00 -#define OP_OPEN_OUTPUT 0xFA01 -#define OP_OPEN_IO 0xFA02 -#define OP_OPEN_EXTEND 0xFA03 -#define OP_OPEN_INPUT_NOREWIND 0xFA04 -#define OP_OPEN_OUTPUT_NOREWIND 0xFA05 -#define OP_OPEN_INPUT_REVERSED 0xFA08 - -#define OP_READ_SEQ_NO_LOCK 0xFA8D -#define OP_READ_SEQ_LOCK 0xFAD8 -#define OP_READ_SEQ_KEPT_LOCK 0xFAD9 -#define OP_READ_SEQ 0xFAF5 -#define OP_READ_PREV_NO_LOCK 0xFA8C -#define OP_READ_PREV_LOCK 0xFADE -#define OP_READ_PREV_KEPT_LOCK 0xFADF -#define OP_READ_PREV 0xFAF9 -#define OP_READ_RAN_NO_LOCK 0xFA8E -#define OP_READ_RAN_LOCK 0xFADA -#define OP_READ_RAN_KEPT_LOCK 0xFADB -#define OP_READ_RAN 0xFAF6 -#define OP_READ_DIR_NO_LOCK 0xFA8F -#define OP_READ_DIR_LOCK 0xFAD6 -#define OP_READ_DIR_KEPT_LOCK 0xFAD7 -#define OP_READ_DIR 0xFAC9 -#define OP_READ_POSITION 0xFAF1 - -#define OP_WRITE_BEFORE 0xFAE1 -#define OP_WRITE_BEFORE_TAB 0xFAE3 -#define OP_WRITE_BEFORE_PAGE 0xFAE5 -#define OP_WRITE_AFTER 0xFAE2 -#define OP_WRITE_AFTER_TAB 0xFAE4 -#define OP_WRITE_AFTER_PAGE 0xFAE6 - -#define OP_WRITE 0xFAF3 -#define OP_REWRITE 0xFAF4 - -#define OP_START_EQ 0xFAE8 -#define OP_START_EQ_ANY 0xFAE9 -#define OP_START_GT 0xFAEA -#define OP_START_GE 0xFAEB -#define OP_START_LT 0xFAFE -#define OP_START_LE 0xFAFF -#define OP_START_LA 0xFAEC /* LAST: Not in MF standard */ -#define OP_START_FI 0xFAED /* FIRST: Not in MF standard */ - -#define OP_STEP_NEXT_NO_LOCK 0xFA90 -#define OP_STEP_NEXT_LOCK 0xFAD4 -#define OP_STEP_NEXT_KEPT_LOCK 0xFAD5 -#define OP_STEP_NEXT 0xFACA -#define OP_STEP_FIRST_NO_LOCK 0xFA92 -#define OP_STEP_FIRST_LOCK 0xFAD0 -#define OP_STEP_FIRST_KEPT_LOCK 0xFAD1 -#define OP_STEP_FIRST 0xFACC - -#define OP_DELETE 0xFAF7 -#define OP_DELETE_FILE 0xFAF8 -#define OP_UNLOCK 0xFA0E -#define OP_COMMIT 0xFADC -#define OP_ROLLBACK 0xFADD - -/*******************************/ -/* Functions in termio.c */ - -COB_EXPIMP void cob_display (const int, const int, const int, ...); -COB_EXPIMP void cob_dump_field (const int, const char *, cob_field *, const int, const int, ...); -COB_EXPIMP void cob_accept (cob_field *); -COB_EXPIMP void cob_field_int_display (cob_field *i, cob_field *f); - -/*******************************/ -/* Functions in fileio.c */ - -COB_EXPIMP void cob_file_external_addr (const char *, - cob_file **, cob_file_key **, - const int nkeys, const int linage); -COB_EXPIMP void cob_file_malloc (cob_file **, cob_file_key **, - const int nkeys, const int linage); -COB_EXPIMP void cob_file_xfdname (cob_file *, const char *); -COB_EXPIMP void cob_file_free (cob_file **, cob_file_key **); -COB_EXPIMP void cob_commit (void); -COB_EXPIMP void cob_rollback (void); -COB_EXPIMP void cob_pre_open (cob_file *f); -COB_EXPIMP int cob_findkey (cob_file *, cob_field *, int *, int *); -COB_EXPIMP void cob_file_create (cob_file ** pfl, const char *exname, const char *select_name, - const int fileorg, const int accessmode, const int optional, - const int format, const int select_features, const int nkeys, - const int minrcsz, const int maxrcsz, cob_field * assign, cob_field * record); -COB_EXPIMP void cob_file_destroy (cob_file ** pfl); -COB_EXPIMP void cob_file_set_attr (cob_file * fl, cob_field * varsize, - const int lineadv, const int features, - const unsigned char *codeset, cob_field * password, cob_field * cryptkey); -COB_EXPIMP void cob_file_set_key (cob_file * fl, const int keyn, cob_field * key, - const int dups, const int ascdesc, const int len_suppress, - const unsigned char *suppress, const int parts, ...); -COB_EXPIMP void cob_file_set_key_extra (cob_file * fl, const int keyn, const int compress, - const int encrypt, cob_field * password, const unsigned char *collate); -COB_EXPIMP void cob_file_set_linage (cob_file * fl, cob_field *linage, cob_field *linage_ctr, - cob_field *latfoot, cob_field *lattop, cob_field *latbot); -COB_EXPIMP void cob_file_set_retry (cob_file * fl, const int mode, const int value); -COB_EXPIMP void cob_file_set_lock (cob_file * fl, const int mode); -COB_EXPIMP void cob_file_complete (cob_file * fl); - -/******************************************/ -/* Functions in fileio.c API for codegen */ -COB_EXPIMP void cob_open (cob_file *, const int, const int, cob_field *); -COB_EXPIMP void cob_close (cob_file *, cob_field *, const int, const int); -COB_EXPIMP void cob_read (cob_file *, cob_field *, cob_field *, const int); -COB_EXPIMP void cob_read_next (cob_file *, cob_field *, const int); -COB_EXPIMP void cob_rewrite (cob_file *, cob_field *, const int, cob_field *); -COB_EXPIMP void cob_delete (cob_file *, cob_field *); -COB_EXPIMP void cob_start (cob_file *, const int, cob_field *, - cob_field *, cob_field *); -COB_EXPIMP void cob_write (cob_file *, cob_field *, const int, - cob_field *, const unsigned int); - -COB_EXPIMP void cob_delete_file (cob_file *, cob_field *); -COB_EXPIMP void cob_unlock_file (cob_file *, cob_field *); - -/***************************************************************/ -/* functions in fextfh.c which is the MF style EXTFH interface */ -/***************************************************************/ -COB_EXPIMP int EXTFH (unsigned char *, FCD3 *); -COB_EXPIMP void cob_extfh_open (int (*callfh)(unsigned char *, FCD3 *), - cob_file *, const int, const int, cob_field *); -COB_EXPIMP void cob_extfh_close (int (*callfh)(unsigned char *, FCD3 *), - cob_file *, cob_field *, const int, const int); -COB_EXPIMP void cob_extfh_read (int (*callfh)(unsigned char *, FCD3 *), - cob_file *, cob_field *, cob_field *, const int); -COB_EXPIMP void cob_extfh_read_next (int (*callfh)(unsigned char *, FCD3 *), - cob_file *, cob_field *, const int); -COB_EXPIMP void cob_extfh_rewrite (int (*callfh)(unsigned char *, FCD3 *), - cob_file *, cob_field *, const int, cob_field *); -COB_EXPIMP void cob_extfh_delete (int (*callfh)(unsigned char *, FCD3 *), - cob_file *, cob_field *); -COB_EXPIMP void cob_extfh_start (int (*callfh)(unsigned char *, FCD3 *), - cob_file *, const int, cob_field *, - cob_field *, cob_field *); -COB_EXPIMP void cob_extfh_write (int (*callfh)(unsigned char *, FCD3 *), - cob_file *, cob_field *, const int, - cob_field *, const unsigned int); -COB_EXPIMP void cob_file_fcd_adrs (cob_file *, void *); -COB_EXPIMP void cob_file_fcdkey_adrs (cob_file *, void *); -COB_EXPIMP void cob_file_fcd_sync (cob_file *); -COB_EXPIMP void cob_fcd_file_sync (cob_file *, char *); - -/* File system routines */ -COB_EXPIMP int cob_sys_open_file (unsigned char *, unsigned char *, - unsigned char *, unsigned char *, - unsigned char *); -COB_EXPIMP int cob_sys_create_file (unsigned char *, unsigned char *, - unsigned char *, unsigned char *, - unsigned char *); -COB_EXPIMP int cob_sys_read_file (unsigned char *, unsigned char *, - unsigned char *, unsigned char *, - unsigned char *); -COB_EXPIMP int cob_sys_write_file (unsigned char *, unsigned char *, - unsigned char *, unsigned char *, - unsigned char *); -COB_EXPIMP int cob_sys_close_file (unsigned char *); -COB_EXPIMP int cob_sys_flush_file (unsigned char *); -COB_EXPIMP int cob_sys_delete_file (unsigned char *); -COB_EXPIMP int cob_sys_copy_file (unsigned char *, unsigned char *); -COB_EXPIMP int cob_sys_check_file_exist (unsigned char *, unsigned char *); -COB_EXPIMP int cob_sys_rename_file (unsigned char *, unsigned char *); -COB_EXPIMP int cob_sys_get_current_dir (const int, const int, unsigned char *); -COB_EXPIMP int cob_sys_change_dir (unsigned char *); -COB_EXPIMP int cob_sys_create_dir (unsigned char *); -COB_EXPIMP int cob_sys_delete_dir (unsigned char *); -COB_EXPIMP int cob_sys_chdir (unsigned char *, unsigned char *); -COB_EXPIMP int cob_sys_mkdir (unsigned char *); -COB_EXPIMP int cob_sys_copyfile (unsigned char *, unsigned char *, - unsigned char *); -COB_EXPIMP int cob_sys_file_info (unsigned char *, unsigned char *); -COB_EXPIMP int cob_sys_file_delete (unsigned char *, unsigned char *); - -/* SORT routines */ -COB_EXPIMP void cob_file_sort_init (cob_file *, const unsigned int, - const unsigned char *, - void *, cob_field *); -COB_EXPIMP void cob_file_sort_init_key (cob_file *, cob_field *, - const int, const unsigned int); -COB_EXPIMP void cob_file_sort_close (cob_file *); -COB_EXPIMP void cob_file_sort_using (cob_file *, cob_file *); -COB_EXPIMP void cob_file_sort_giving (cob_file *, const size_t, ...); -COB_EXPIMP void cob_file_release (cob_file *); -COB_EXPIMP void cob_file_return (cob_file *); - -/***************************/ -/* Functions in reportio.c */ -/***************************/ -COB_EXPIMP void cob_report_initiate (cob_report *); -COB_EXPIMP int cob_report_terminate (cob_report *, int); -COB_EXPIMP int cob_report_generate (cob_report *, cob_report_line *, int); -COB_EXPIMP void cob_report_suppress (cob_report *r, cob_report_line *l); - -/**********************/ -/* Functions in mlio.c */ -/**********************/ - -COB_EXPIMP int cob_is_valid_uri (const char *); -COB_EXPIMP int cob_is_xml_namestartchar (const int); -COB_EXPIMP int cob_is_xml_namechar (const int); -COB_EXPIMP void cob_xml_generate (cob_field *, cob_ml_tree *, - cob_field *, const int, cob_field *, - cob_field *); -COB_EXPIMP void cob_json_generate (cob_field *, cob_ml_tree *, - cob_field *); - - -/****************************/ -/* Functions in intrinsic.c */ -/****************************/ -COB_EXPIMP void cob_put_indirect_field (cob_field *); -COB_EXPIMP void cob_get_indirect_field (cob_field *); -COB_EXPIMP cob_field *cob_switch_value (const int); -COB_EXPIMP cob_field *cob_intr_binop (cob_field *, const int, - cob_field *); - -COB_EXPIMP int cob_check_numval (const cob_field *, - const cob_field *, - const int, const int); - -COB_EXPIMP int cob_valid_date_format (const char *); -COB_EXPIMP int cob_valid_datetime_format (const char *, const char); -COB_EXPIMP int cob_valid_time_format (const char *, const char); - -COB_EXPIMP cob_field *cob_intr_current_date (const int, const int); -COB_EXPIMP cob_field *cob_intr_when_compiled (const int, const int, - cob_field *); -COB_EXPIMP cob_field *cob_intr_module_date (void); -COB_EXPIMP cob_field *cob_intr_module_time (void); -COB_EXPIMP cob_field *cob_intr_module_id (void); -COB_EXPIMP cob_field *cob_intr_module_caller_id (void); -COB_EXPIMP cob_field *cob_intr_module_source (void); -COB_EXPIMP cob_field *cob_intr_module_formatted_date (void); -COB_EXPIMP cob_field *cob_intr_module_path (void); -COB_EXPIMP cob_field *cob_intr_exception_file (void); -COB_EXPIMP cob_field *cob_intr_exception_location (void); -COB_EXPIMP cob_field *cob_intr_exception_status (void); -COB_EXPIMP cob_field *cob_intr_exception_statement (void); -COB_EXPIMP cob_field *cob_intr_mon_decimal_point (void); -COB_EXPIMP cob_field *cob_intr_num_decimal_point (void); -COB_EXPIMP cob_field *cob_intr_mon_thousands_sep (void); -COB_EXPIMP cob_field *cob_intr_num_thousands_sep (void); -COB_EXPIMP cob_field *cob_intr_currency_symbol (void); -COB_EXPIMP cob_field *cob_intr_char (cob_field *); -COB_EXPIMP cob_field *cob_intr_ord (cob_field *); -COB_EXPIMP cob_field *cob_intr_stored_char_length (cob_field *); -COB_EXPIMP cob_field *cob_intr_combined_datetime (cob_field *, cob_field *); -COB_EXPIMP cob_field *cob_intr_date_of_integer (cob_field *); -COB_EXPIMP cob_field *cob_intr_day_of_integer (cob_field *); -COB_EXPIMP cob_field *cob_intr_integer_of_date (cob_field *); -COB_EXPIMP cob_field *cob_intr_integer_of_day (cob_field *); -COB_EXPIMP cob_field *cob_intr_test_date_yyyymmdd (cob_field *); -COB_EXPIMP cob_field *cob_intr_test_day_yyyyddd (cob_field *); -COB_EXPIMP cob_field *cob_intr_test_numval (cob_field *); -COB_EXPIMP cob_field *cob_intr_test_numval_c (cob_field *, cob_field *); -COB_EXPIMP cob_field *cob_intr_test_numval_f (cob_field *); -COB_EXPIMP cob_field *cob_intr_factorial (cob_field *); - -COB_EXPIMP cob_field *cob_intr_pi (void); -COB_EXPIMP cob_field *cob_intr_e (void); -COB_EXPIMP cob_field *cob_intr_exp (cob_field *); -COB_EXPIMP cob_field *cob_intr_exp10 (cob_field *); -COB_EXPIMP cob_field *cob_intr_abs (cob_field *); -COB_EXPIMP cob_field *cob_intr_acos (cob_field *); -COB_EXPIMP cob_field *cob_intr_asin (cob_field *); -COB_EXPIMP cob_field *cob_intr_atan (cob_field *); -COB_EXPIMP cob_field *cob_intr_cos (cob_field *); -COB_EXPIMP cob_field *cob_intr_log (cob_field *); -COB_EXPIMP cob_field *cob_intr_log10 (cob_field *); -COB_EXPIMP cob_field *cob_intr_sin (cob_field *); -COB_EXPIMP cob_field *cob_intr_sqrt (cob_field *); -COB_EXPIMP cob_field *cob_intr_tan (cob_field *); - -COB_EXPIMP cob_field *cob_intr_upper_case (const int, const int, - cob_field *); -COB_EXPIMP cob_field *cob_intr_lower_case (const int, const int, - cob_field *); -COB_EXPIMP cob_field *cob_intr_reverse (const int, const int, - cob_field *); -COB_EXPIMP cob_field *cob_intr_concatenate (const int, const int, - const int, ...); -COB_EXPIMP cob_field *cob_intr_substitute (const int, const int, - const int, ...); -COB_EXPIMP cob_field *cob_intr_substitute_case (const int, const int, - const int, ...); -COB_EXPIMP cob_field *cob_intr_trim (const int, const int, - cob_field *, const int); -COB_EXPIMP cob_field *cob_intr_length (cob_field *); -COB_EXPIMP cob_field *cob_intr_byte_length (cob_field *); -COB_EXPIMP cob_field *cob_intr_integer (cob_field *); -COB_EXPIMP cob_field *cob_intr_integer_part (cob_field *); -COB_EXPIMP cob_field *cob_intr_fraction_part (cob_field *); -COB_EXPIMP cob_field *cob_intr_sign (cob_field *); -COB_EXPIMP cob_field *cob_intr_lowest_algebraic (cob_field *); -COB_EXPIMP cob_field *cob_intr_highest_algebraic (cob_field *); -COB_EXPIMP cob_field *cob_intr_numval (cob_field *); -COB_EXPIMP cob_field *cob_intr_numval_c (cob_field *, cob_field *); -COB_EXPIMP cob_field *cob_intr_numval_f (cob_field *); -COB_EXPIMP cob_field *cob_intr_annuity (cob_field *, cob_field *); -COB_EXPIMP cob_field *cob_intr_mod (cob_field *, cob_field *); -COB_EXPIMP cob_field *cob_intr_rem (cob_field *, cob_field *); -COB_EXPIMP cob_field *cob_intr_sum (const int, ...); -COB_EXPIMP cob_field *cob_intr_ord_min (const int, ...); -COB_EXPIMP cob_field *cob_intr_ord_max (const int, ...); -COB_EXPIMP cob_field *cob_intr_min (const int, ...); -COB_EXPIMP cob_field *cob_intr_max (const int, ...); -COB_EXPIMP cob_field *cob_intr_midrange (const int, ...); -COB_EXPIMP cob_field *cob_intr_median (const int, ...); -COB_EXPIMP cob_field *cob_intr_mean (const int, ...); -COB_EXPIMP cob_field *cob_intr_range (const int, ...); -COB_EXPIMP cob_field *cob_intr_random (const int, ...); -COB_EXPIMP cob_field *cob_intr_variance (const int, ...); -COB_EXPIMP cob_field *cob_intr_standard_deviation (const int, ...); -COB_EXPIMP cob_field *cob_intr_present_value (const int, ...); -COB_EXPIMP cob_field *cob_intr_year_to_yyyy (const int, ...); -COB_EXPIMP cob_field *cob_intr_date_to_yyyymmdd (const int, ...); -COB_EXPIMP cob_field *cob_intr_day_to_yyyyddd (const int, ...); -COB_EXPIMP cob_field *cob_intr_locale_compare (const int, ...); -COB_EXPIMP cob_field *cob_intr_locale_date (const int, const int, - cob_field *, cob_field *); -COB_EXPIMP cob_field *cob_intr_locale_time (const int, const int, - cob_field *, cob_field *); - -COB_EXPIMP cob_field *cob_intr_seconds_past_midnight (void); -COB_EXPIMP cob_field *cob_intr_lcl_time_from_secs (const int, const int, - cob_field *, cob_field *); - -COB_EXPIMP cob_field *cob_intr_seconds_from_formatted_time (cob_field *, - cob_field *); - -COB_EXPIMP cob_field *cob_intr_boolean_of_integer (cob_field *, cob_field *); -COB_EXPIMP cob_field *cob_intr_char_national (cob_field *); -COB_EXPIMP cob_field *cob_intr_display_of (const int, const int, - const int, ...); -COB_EXPIMP cob_field *cob_intr_exception_file_n (void); -COB_EXPIMP cob_field *cob_intr_exception_location_n (void); -COB_EXPIMP cob_field *cob_intr_formatted_current_date (const int, const int, - cob_field *); -COB_EXPIMP cob_field *cob_intr_formatted_date (const int, const int, - cob_field *, cob_field *); -COB_EXPIMP cob_field *cob_intr_formatted_datetime (const int, const int, - const int, ...); -COB_EXPIMP cob_field *cob_intr_formatted_time (const int, const int, - const int, ...); -COB_EXPIMP cob_field *cob_intr_integer_of_boolean (cob_field *); -COB_EXPIMP cob_field *cob_intr_national_of (const int, const int, - const int, ...); -COB_EXPIMP cob_field *cob_intr_standard_compare (const int, ...); -COB_EXPIMP cob_field *cob_intr_test_formatted_datetime (cob_field *, cob_field *); - -COB_EXPIMP cob_field *cob_intr_integer_of_formatted_date (cob_field *, - cob_field *); -COB_EXPIMP cob_field *cob_intr_content_length (cob_field *); -COB_EXPIMP cob_field *cob_intr_content_of (const int, const int, - const int, ...); - -/*******************************/ - -/*******************************/ -/* defines for MicroFocus C -> COBOL API */ -typedef char * cobchar_t; -#define cobs8_t cob_s8_t -#define cobuns8_t cob_u8_t -#define cobs16_t cob_s16_t -#define cobuns16_t cob_u16_t -#define cobs32_t cob_s32_t -#define cobuns32_t cob_u32_t -#define cobs64_t cob_s64_t -#define cobuns64_t cob_u64_t - -#define cobsetjmp(x) setjmp (cob_savenv (x)) -#define coblongjmp(x) cob_longjmp (x) -#define cobsavenv(x) cob_savenv (x) -#define cobsavenv2(x,z) cob_savenv2 (x, z) -#define cobfunc(x,y,z) cob_func (x, y, z) -#define cobcall(x,y,z) cob_call (x, y, z) -#define cobcancel(x) cob_cancel (x) - -#define cobgetenv(x) cob_getenv (x) -#define cobputenv(x) cob_putenv (x) -#define cobrescanenv() 0 /* not necessary as GnuCOBOL always reads the process environment */ -#define cobtidy() cob_tidy () -#define cobinit() cob_extern_init () -#define cobexit(x) cob_stop_run (x) -#define cobcommandline(v,w,x,y,z) cob_command_line (v,w,x,y,z) - -#define cobclear() (void) cob_sys_clear_screen () -#define cobmove(y,x) cob_set_cursor_pos (y, x) -#define cobcols() cob_get_scr_cols () -#define coblines() cob_get_scr_lines () -#define cobaddstrc(x) cob_display_text (x) /* no limit [MF=255] */ -#define cobprintf cob_display_formatted_text /* limit of 2047 [MF=255] */ -#define cobgetch() cob_get_char () - -#define cobget_x1_compx(d) (cobuns8_t) cob_get_u64_compx(d, 1) -#define cobget_x2_compx(d) (cobuns16_t) cob_get_u64_compx(d, 2) -#define cobget_x4_compx(d) (cobuns32_t) cob_get_u64_compx(d, 4) -#define cobget_x8_compx(d) (cobuns64_t) cob_get_u64_compx(d, 8) -#define cobget_sx1_compx(d) (cobs8_t) cob_get_s64_compx(d, 1) -#define cobget_sx2_compx(d) (cobs16_t) cob_get_s64_compx(d, 2) -#define cobget_sx4_compx(d) (cobs32_t) cob_get_s64_compx(d, 4) -#define cobget_sx8_compx(d) (cobs64_t) cob_get_s64_compx(d, 8) -#define cobget_x1_comp5(d) (cobuns8_t) cob_get_u64_comp5(d, 1) -#define cobget_x2_comp5(d) (cobuns16_t) cob_get_u64_comp5(d, 2) -#define cobget_x4_comp5(d) (cobuns32_t) cob_get_u64_comp5(d, 4) -#define cobget_x8_comp5(d) (cobuns64_t) cob_get_u64_comp5(d, 8) -#define cobget_sx1_comp5(d) (cobs8_t) cob_get_s64_comp5(d, 1) -#define cobget_sx2_comp5(d) (cobs16_t) cob_get_s64_comp5(d, 2) -#define cobget_sx4_comp5(d) (cobs32_t) cob_get_s64_comp5(d, 4) -#define cobget_sx8_comp5(d) (cobs64_t) cob_get_s64_comp5(d, 8) -#define cobget_xn_comp5(d,n) (cobuns64_t) cob_get_u64_comp5(d, n) -#define cobget_xn_compx(d,n) (cobuns64_t) cob_get_u64_compx(d, n) -#define cobget_sxn_comp5(d,n) (cobs64_t) cob_get_s64_comp5(d, n) -#define cobget_sxn_compx(d,n) (cobs64_t) cob_get_s64_compx(d, n) - -#define cobput_x1_compx(d,v) (void) cob_put_u64_compx((cob_u64_t)v,d,1) -#define cobput_x2_compx(d,v) (void) cob_put_u64_compx((cob_u64_t)v,d,2) -#define cobput_x4_compx(d,v) (void) cob_put_u64_compx((cob_u64_t)v,d,4) -#define cobput_x8_compx(d,v) (void) cob_put_u64_compx((cob_u64_t)v,d,8) -#define cobput_x1_comp5(d,v) (void) cob_put_u64_comp5((cob_u64_t)v,d,1) -#define cobput_x2_comp5(d,v) (void) cob_put_u64_comp5((cob_u64_t)v,d,2) -#define cobput_x4_comp5(d,v) (void) cob_put_u64_comp5((cob_u64_t)v,d,4) -#define cobput_x8_comp5(d,v) (void) cob_put_u64_comp5((cob_u64_t)v,d,8) -#define cobput_sx1_comp5(d,v) (void) cob_put_s64_comp5((cob_s64_t)v,d,1) -#define cobput_sx2_comp5(d,v) (void) cob_put_s64_comp5((cob_s64_t)v,d,2) -#define cobput_sx4_comp5(d,v) (void) cob_put_s64_comp5((cob_s64_t)v,d,4) -#define cobput_sx8_comp5(d,v) (void) cob_put_s64_comp5((cob_s64_t)v,d,8) -#define cobput_xn_comp5(d,n,v) (void) cob_put_u64_comp5(v, d, n) -#define cobput_xn_compx(d,n,v) (void) cob_put_u64_compx(v, d, n) -#define cobput_sxn_comp5(d,n,v) (void) cob_put_s64_comp5(v, d, n) -#define cobput_sxn_compx(d,n,v) (void) cob_put_s64_compx(v, d, n) - -/*******************************/ - -#endif /* COB_COMMON_H */ diff -Nru gnucobol-4.0~early~20200606/libcob/exception.def gnucobol-5/libcob/exception.def --- gnucobol-4.0~early~20200606/libcob/exception.def 2020-06-06 20:52:01.000000000 +0000 +++ gnucobol-5/libcob/exception.def 1970-01-01 00:00:00.000000000 +0000 @@ -1,647 +0,0 @@ -/* - Copyright (C) 2003-2012, 2014-2015, 2018-2020 Free Software Foundation, Inc. - Written by Keisuke Nishida, Roger While, Simon Sobisch, Edward Hart - - This file is part of GnuCOBOL. - - The GnuCOBOL runtime library is free software: you can redistribute it - and/or modify it under the terms of the GNU Lesser General Public License - as published by the Free Software Foundation, either version 3 of the - License, or (at your option) any later version. - - GnuCOBOL is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU Lesser General Public License for more details. - - You should have received a copy of the GNU Lesser General Public License - along with GnuCOBOL. If not, see . -*/ - - -/* COB_EXCEPTION (code, tag, name, critical) */ - -/* Argument error */ -COB_EXCEPTION (0100, COB_EC_ARGUMENT, - "EC-ARGUMENT", 0) - -/* Function argument error */ -COB_EXCEPTION (0101, COB_EC_ARGUMENT_FUNCTION, - "EC-ARGUMENT-FUNCTION", 1) - -/* Implementation-defined argument error */ -COB_EXCEPTION (0102, COB_EC_ARGUMENT_IMP, - "EC-ARGUMENT-IMP", 0) - - -/* Boundary violation */ -COB_EXCEPTION (0200, COB_EC_BOUND, - "EC-BOUND", 0) - -/* Implementation-defined boundary violation */ -COB_EXCEPTION (0201, COB_EC_BOUND_IMP, - "EC-BOUND-IMP", 0) - -/* OCCURS ... DEPENDING ON data item out of bounds */ -COB_EXCEPTION (0202, COB_EC_BOUND_ODO, - "EC-BOUND-ODO", 1) - -/* Dynamic table capacity exceeded expected value */ -COB_EXCEPTION (0203, COB_EC_BOUND_OVERFLOW, - "EC-BOUND-OVERFLOW", 1) - -/* Data-pointer contains an address that is out of bounds */ -COB_EXCEPTION (0204, COB_EC_BOUND_PTR, - "EC-BOUND-PTR", 1) - -/* Reference modifier out of bounds */ -COB_EXCEPTION (0205, COB_EC_BOUND_REF_MOD, - "EC-BOUND-REF-MOD", 1) - -/* Invalid SET of dynamic table capacity */ -COB_EXCEPTION (0206, COB_EC_BOUND_SET, - "EC-BOUND-SET", 1) - -/* Subscript out of bounds */ -COB_EXCEPTION (0207, COB_EC_BOUND_SUBSCRIPT, - "EC-BOUND-SUBSCRIPT", 1) - -/* Dynamic table capacity exceeded maximum size */ -COB_EXCEPTION (0208, COB_EC_BOUND_TABLE_LIMIT, - "EC-BOUND-TABLE-LIMIT", 1) - - -/* Data exception */ -COB_EXCEPTION (0300, COB_EC_DATA, - "EC-DATA", 0) - -/* Conversion failed because of incomplete character correspondence */ -COB_EXCEPTION (0301, COB_EC_DATA_CONVERSION, - "EC-DATA-CONVERSION", 0) - -/* Implementation-defined data exception */ -COB_EXCEPTION (0302, COB_EC_DATA_IMP, - "EC-DATA-IMP", 0) - -/* Incompatible data exception */ -COB_EXCEPTION (0303, COB_EC_DATA_INCOMPATIBLE, - "EC-DATA-INCOMPATIBLE", 1) - -/* Using floating-point usage data item which is NaN or an infinity */ -COB_EXCEPTION (0304, COB_EC_DATA_NOT_FINITE, - "EC-DATA-NOT-FINITE", 1) - -/* Exponent overflow during MOVE to item with floating-point usage */ -COB_EXCEPTION (0305, COB_EC_DATA_OVERFLOW, - "EC-DATA-OVERFLOW", 1) - -/* Based item data-pointer is set to NULL when referenced */ -COB_EXCEPTION (0306, COB_EC_DATA_PTR_NULL, - "EC-DATA-PTR-NULL", 1) - - -/* Execution control flow violation */ -COB_EXCEPTION (0400, COB_EC_FLOW, - "EC-FLOW", 0) - -/* EXIT PROGRAM in a global declarative */ -COB_EXCEPTION (0401, COB_EC_FLOW_GLOBAL_EXIT, - "EC-FLOW-GLOBAL-EXIT", 1) - -/* GOBACK in a global declarative */ -COB_EXCEPTION (0402, COB_EC_FLOW_GLOBAL_GOBACK, - "EC-FLOW-GLOBAL-GOBACK", 1) - -/* Implementation-defined control flow violation */ -COB_EXCEPTION (0403, COB_EC_FLOW_IMP, - "EC-FLOW-IMP", 0) - -/* RELEASE not in range of SORT */ -COB_EXCEPTION (0404, COB_EC_FLOW_RELEASE, - "EC-FLOW-RELEASE", 1) - -/* GENERATE, INITIATE, or TERMINATE during USE BEFORE REPORTING declarative */ -COB_EXCEPTION (0405, COB_EC_FLOW_REPORT, - "EC-FLOW-REPORT", 1) - -/* RETURN not in range of MERGE or SORT */ -COB_EXCEPTION (0406, COB_EC_FLOW_RETURN, - "EC-FLOW-RETURN", 1) - -/* Invalid use of SET for dynamic table */ -COB_EXCEPTION (0407, COB_EC_FLOW_SEARCH, - "EC-FLOW-SEARCH", 1) - -/* A USE statement caused another to be executed */ -COB_EXCEPTION (0408, COB_EC_FLOW_USE, - "EC-FLOW-USE", 1) - - -/* input-output exception */ -COB_EXCEPTION (0500, COB_EC_I_O, - "EC-I-O", 0) - -/* I-O status "1x" */ -COB_EXCEPTION (0501, COB_EC_I_O_AT_END, - "EC-I-O-AT-END", 0) - -/* An end of page condition occurred */ -COB_EXCEPTION (0502, COB_EC_I_O_EOP, - "EC-I-O-EOP", 0) - -/* A page overflow condition occurred */ -COB_EXCEPTION (0503, COB_EC_I_O_EOP_OVERFLOW, - "EC-I-O-EOP-OVERFLOW", 0) - -/* I-O status "6x" */ -COB_EXCEPTION (0504, COB_EC_I_O_FILE_SHARING, - "EC-I-O-FILE-SHARING", 0) - -/* I-O status "9x" */ -COB_EXCEPTION (0505, COB_EC_I_O_IMP, - "EC-I-O-IMP", 0) - -/* I-O status "2x" */ -COB_EXCEPTION (0506, COB_EC_I_O_INVALID_KEY, - "EC-I-O-INVALID-KEY", 0) - -/* The value of a LINAGE data-item is not within the required range */ -COB_EXCEPTION (0507, COB_EC_I_O_LINAGE, - "EC-I-O-LINAGE", 1) - -/* I-O status "4x" */ -COB_EXCEPTION (0508, COB_EC_I_O_LOGIC_ERROR, - "EC-I-O-LOGIC-ERROR", 1) - -/* I-O status "3x" */ -COB_EXCEPTION (0509, COB_EC_I_O_PERMANENT_ERROR, - "EC-I-O-PERMANENT-ERROR", 1) - -/* I-O status "5x" */ -COB_EXCEPTION (050A, COB_EC_I_O_RECORD_OPERATION, - "EC-I-O-RECORD-OPERATION", 0) - - -/* Implementation-defined exception condition */ -COB_EXCEPTION (0600, COB_EC_IMP, - "EC-IMP", 0) - -/* Implementation-defined accept condition */ -COB_EXCEPTION (0601, COB_EC_IMP_ACCEPT, - "EC-IMP-ACCEPT", 0) - -/* Implementation-defined display condition */ -COB_EXCEPTION (0602, COB_EC_IMP_DISPLAY, - "EC-IMP-DISPLAY", 0) - -/* Current UTC time cannot be found */ -COB_EXCEPTION (0603, COB_EC_IMP_UTC_UNKNOWN, - "EC-IMP-UTC-UNKNOWN", 1) - -/* Implementation-defined condition for features the runtime is not configured for */ -COB_EXCEPTION (0604, COB_EC_IMP_FEATURE_DISABLED, - "EC-IMP-FEATURE-DISABLED", 0) - -/* Implementation-defined condition for features the runtime has no support for (yet) */ -COB_EXCEPTION (0605, COB_EC_IMP_FEATURE_MISSING, - "EC-IMP-FEATURE-MISSING", 0) - - -/* Any locale related exception */ -COB_EXCEPTION (0700, COB_EC_LOCALE, - "EC-LOCALE", 0) - -/* Implementation-defined locale related exception */ -COB_EXCEPTION (0701, COB_EC_LOCALE_IMP, - "EC-LOCALE-IMP", 0) - -/* The referenced locale does not specify the expected characters in LC_COLLATE */ -COB_EXCEPTION (0702, COB_EC_LOCALE_INCOMPATIBLE, - "EC-LOCALE-INCOMPATIBLE", 0) - -/* Locale content is invalid or incomplete */ -COB_EXCEPTION (0703, COB_EC_LOCALE_INVALID, - "EC-LOCALE-INVALID", 1) - -/* Pointer does not reference a saved locale */ -COB_EXCEPTION (0704, COB_EC_LOCALE_INVALID_PTR, - "EC-LOCALE-INVALID-PTR", 1) - -/* The specified locale is not available */ -COB_EXCEPTION (0705, COB_EC_LOCALE_MISSING, - "EC-LOCALE-MISSING", 1) - -/* Digits were truncated in locale editing */ -COB_EXCEPTION (0706, COB_EC_LOCALE_SIZE, - "EC-LOCALE-SIZE", 1) - - -/* Any predefined OO related exception */ -COB_EXCEPTION (0800, COB_EC_OO, - "EC-OO", 0) - -/* Failure for an object-view */ -COB_EXCEPTION (0801, COB_EC_OO_CONFORMANCE, - "EC-OO-CONFORMANCE", 1) - -/* An exception object was not handled */ -COB_EXCEPTION (0802, COB_EC_OO_EXCEPTION, - "EC-OO-EXCEPTION", 1) - -/* Invalid assignment of finalizable/finalized object reference */ -COB_EXCEPTION (0803, COB_EC_OO_FINALIZABLE, - "EC-OO-FINALIZABLE", 1) - -/* Implementation-defined OO exception */ -COB_EXCEPTION (0804, COB_EC_OO_IMP, - "EC-OO-IMP", 0) - -/* Requested method is not available */ -COB_EXCEPTION (0805, COB_EC_OO_METHOD, - "EC-OO-METHOD", 1) - -/* Method invocation was attempted with a null object reference */ -COB_EXCEPTION (0806, COB_EC_OO_NULL, - "EC-OO-NULL", 1) - -/* Insufficient system resources to create the object or expand the object */ -COB_EXCEPTION (0807, COB_EC_OO_RESOURCE, - "EC-OO-RESOURCE", 1) - -/* A runtime type check failed */ -COB_EXCEPTION (0808, COB_EC_OO_UNIVERSAL, - "EC-OO-UNIVERSAL", 1) - - -/* Ordering exception */ -COB_EXCEPTION (0900, COB_EC_ORDER, - "EC-ORDER", 0) - -/* Implementation-defined ordering exception */ -COB_EXCEPTION (0901, COB_EC_ORDER_IMP, - "EC-ORDER-IMP", 0) - -/* ISO/IEC 14651:2001 ordering table or ordering level not supported */ -COB_EXCEPTION (0902, COB_EC_ORDER_NOT_SUPPORTED, - "EC-ORDER-NOT-SUPPORTED", 1) - - -/* Size error exception */ -COB_EXCEPTION (1000, COB_EC_SIZE, - "EC-SIZE", 0) - -/* Invalid pointer arithmetic */ -COB_EXCEPTION (1001, COB_EC_SIZE_ADDRESS, - "EC-SIZE-ADDRESS", 1) - -/* Exponentiation rules violated */ -COB_EXCEPTION (1002, COB_EC_SIZE_EXPONENTIATION, - "EC-SIZE-EXPONENTIATION", 1) - -/* Implementation-defined size error exception */ -COB_EXCEPTION (1003, COB_EC_SIZE_IMP, - "EC-SIZE-IMP", 0) - -/* Arithmetic overflow in calculation */ -COB_EXCEPTION (1004, COB_EC_SIZE_OVERFLOW, - "EC-SIZE-OVERFLOW", 1) - -/* Significant digits truncated in store */ -COB_EXCEPTION (1005, COB_EC_SIZE_TRUNCATION, - "EC-SIZE-TRUNCATION", 1) - -/* Floating-point underflow */ -COB_EXCEPTION (1006, COB_EC_SIZE_UNDERFLOW, - "EC-SIZE-UNDERFLOW", 1) - -/* Division by zero */ -COB_EXCEPTION (1007, COB_EC_SIZE_ZERO_DIVIDE, - "EC-SIZE-ZERO-DIVIDE", 1) - - -/* SORT or MERGE exception */ -COB_EXCEPTION (1100, COB_EC_SORT_MERGE, - "EC-SORT-MERGE", 0) - -/* File SORT or MERGE executed when one is already active */ -COB_EXCEPTION (1101, COB_EC_SORT_MERGE_ACTIVE, - "EC-SORT-MERGE-ACTIVE", 1) - -/* USING or GIVING file is open upon execution of a SORT or MERGE */ -COB_EXCEPTION (1102, COB_EC_SORT_MERGE_FILE_OPEN, - "EC-SORT-MERGE-FILE-OPEN", 1) - -/* Implementation-defined SORT or MERGE exception */ -COB_EXCEPTION (1103, COB_EC_SORT_MERGE_IMP, - "EC-SORT-MERGE-IMP", 0) - -/* RELEASE record too long or too short */ -COB_EXCEPTION (1104, COB_EC_SORT_MERGE_RELEASE, - "EC-SORT-MERGE-RELEASE", 1) - -/* RETURN executed when at end condition exists */ -COB_EXCEPTION (1105, COB_EC_SORT_MERGE_RETURN, - "EC-SORT-MERGE-RETURN", 1) - -/* Sequence error on MERGE USING file */ -COB_EXCEPTION (1106, COB_EC_SORT_MERGE_SEQUENCE, - "EC-SORT-MERGE-SEQUENCE", 1) - - -/* Storage allocation exception */ -COB_EXCEPTION (1200, COB_EC_STORAGE, - "EC-STORAGE", 0) - -/* Implementation-defined storage allocation exception */ -COB_EXCEPTION (1201, COB_EC_STORAGE_IMP, - "EC-STORAGE-IMP", 0) - -/* The data-pointer specified in a FREE statement does not identify - currently allocated storage */ -COB_EXCEPTION (1202, COB_EC_STORAGE_NOT_ALLOC, - "EC-STORAGE-NOT-ALLOC", 0) - -/* The amount of storage requested by an ALLOCATE statement is not available */ -COB_EXCEPTION (1203, COB_EC_STORAGE_NOT_AVAIL, - "EC-STORAGE-NOT-AVAIL", 0) - - -/* User-defined exception condition */ -COB_EXCEPTION (1300, COB_EC_USER, - "EC-USER", 0) - - -/* VALIDATE exception */ -COB_EXCEPTION (1400, COB_EC_VALIDATE, - "EC-VALIDATE", 0) - -/* VALIDATE content error */ -COB_EXCEPTION (1401, COB_EC_VALIDATE_CONTENT, - "EC-VALIDATE-CONTENT", 0) - -/* VALIDATE format error */ -COB_EXCEPTION (1402, COB_EC_VALIDATE_FORMAT, - "EC-VALIDATE-FORMAT", 0) - -/* Implementation-defined VALIDATE exception */ -COB_EXCEPTION (1403, COB_EC_VALIDATE_IMP, - "EC-VALIDATE-IMP", 0) - -/* VALIDATE relation error */ -COB_EXCEPTION (1404, COB_EC_VALIDATE_RELATION, - "EC-VALIDATE-RELATION", 0) - -/* VARYING clause expression non-integer */ -COB_EXCEPTION (1405, COB_EC_VALIDATE_VARYING, - "EC-VALIDATE-VARYING", 1) - - -/* FUNCTION exception */ -COB_EXCEPTION (1500, COB_EC_FUNCTION, - "EC-FUNCTION", 0) - -/* FUNCTION signature mismatch */ -COB_EXCEPTION (1501, COB_EC_FUNCTION_PTR_INVALID, - "EC-FUNCTION-PTR-INVALID", 1) - -/* FUNCTION pointer is NULL */ -COB_EXCEPTION (1502, COB_EC_FUNCTION_PTR_NULL, - "EC-FUNCTION-PTR-NULL", 1) - - -/* XML exception */ -COB_EXCEPTION (1600, COB_EC_XML, - "EC-XML", 0) - -/* XML encoding mismatch with CODE-SET */ -COB_EXCEPTION (1601, COB_EC_XML_CODESET, - "EC-XML-CODESET", 1) - -/* XML character cannot be encoded according to CODE-SET */ -COB_EXCEPTION (1602, COB_EC_XML_CODESET_CONVERSION, - "EC-XML-CODESET-CONVERSION", 1) - -/* XML */ -COB_EXCEPTION (1603, COB_EC_XML_COUNT, - "EC-XML-COUNT", 1) - -/* XML */ -COB_EXCEPTION (1604, COB_EC_XML_DOCUMENT_TYPE, - "EC-XML-DOCUMENT-TYPE", 1) - -/* XML */ -COB_EXCEPTION (1605, COB_EC_XML_IMPLICIT_CLOSE, - "EC-XML-IMPLICIT-CLOSE", 1) - -/* XML */ -COB_EXCEPTION (1606, COB_EC_XML_INVALID, - "EC-XML-INVALID", 1) - -/* XML */ -COB_EXCEPTION (1607, COB_EC_XML_NAMESPACE, - "EC-XML-NAMESPACE", 1) - -/* XML */ -COB_EXCEPTION (1608, COB_EC_XML_STACKED_OPEN, - "EC-XML-STACKED-OPEN", 1) - -/* XML */ -COB_EXCEPTION (1609, COB_EC_XML_RANGE, - "EC-XML-RANGE", 1) - -/* XML */ -COB_EXCEPTION (1610, COB_EC_XML_IMP, - "EC-XML-IMP", 1) - - -/* JSON exception */ -COB_EXCEPTION (1700, COB_EC_JSON, - "EC-JSON", 0) - -/* JSON */ -COB_EXCEPTION (1710, COB_EC_JSON_IMP, - "EC-JSON-IMP", 1) - - -/* Overflow condition */ -COB_EXCEPTION (0A00, COB_EC_OVERFLOW, - "EC-OVERFLOW", 0) - -/* Implementation-defined overflow condition */ -COB_EXCEPTION (0A01, COB_EC_OVERFLOW_IMP, - "EC-OVERFLOW-IMP", 0) - -/* STRING overflow condition */ -COB_EXCEPTION (0A02, COB_EC_OVERFLOW_STRING, - "EC-OVERFLOW-STRING", 0) - -/* UNSTRING overflow condition */ -COB_EXCEPTION (0A03, COB_EC_OVERFLOW_UNSTRING, - "EC-OVERFLOW-UNSTRING", 0) - - -/* Inter-program communication exception */ -COB_EXCEPTION (0B00, COB_EC_PROGRAM, - "EC-PROGRAM", 0) - -/* Argument mismatch */ -COB_EXCEPTION (0B01, COB_EC_PROGRAM_ARG_MISMATCH, - "EC-PROGRAM-ARG-MISMATCH", 1) - -/* Reference to an omitted argument */ -COB_EXCEPTION (0B02, COB_EC_PROGRAM_ARG_OMITTED, - "EC-PROGRAM-ARG-OMITTED", 1) - -/* Canceled program active */ -COB_EXCEPTION (0B03, COB_EC_PROGRAM_CANCEL_ACTIVE, - "EC-PROGRAM-CANCEL-ACTIVE", 1) - -/* Implementation-defined inter-program communication exception */ -COB_EXCEPTION (0B04, COB_EC_PROGRAM_IMP, - "EC-PROGRAM-IMP", 0) - -/* Called program not found */ -COB_EXCEPTION (0B05, COB_EC_PROGRAM_NOT_FOUND, - "EC-PROGRAM-NOT-FOUND", 1) - -/* Program-pointer used in CALL is set to NULL */ -COB_EXCEPTION (0B06, COB_EC_PROGRAM_PTR_NULL, - "EC-PROGRAM-PTR-NULL", 1) - -/* Called program active */ -COB_EXCEPTION (0B07, COB_EC_PROGRAM_RECURSIVE_CALL, - "EC-PROGRAM-RECURSIVE-CALL", 1) - -/* Resources not available for called program */ -COB_EXCEPTION (0B08, COB_EC_PROGRAM_RESOURCES, - "EC-PROGRAM-RESOURCES", 1) - - -/* EXIT ... RAISING or GOBACK RAISING exception */ -COB_EXCEPTION (0C00, COB_EC_RAISING, - "EC-RAISING", 0) - -/* Implementation-defined EXIT ... RAISING or GOBACK RAISING exception */ -COB_EXCEPTION (0C01, COB_EC_RAISING_IMP, - "EC-RAISING-IMP", 0) - -/* EXIT ... RAISING or GOBACK RAISING an EC-IMP or EC-USER exception - condition not specified in RAISING phrase of procedure division header */ -COB_EXCEPTION (0C02, COB_EC_RAISING_NOT_SPECIFIED, - "EC-RAISING-NOT-SPECIFIED", 1) - - -/* Range exception */ -COB_EXCEPTION (0D00, COB_EC_RANGE, - "EC-RANGE", 0) - -/* Implementation-defined range exception */ -COB_EXCEPTION (0D01, COB_EC_RANGE_IMP, - "EC-RANGE-IMP", 0) - -/* Index made negative or too large for container */ -COB_EXCEPTION (0D02, COB_EC_RANGE_INDEX, - "EC-RANGE-INDEX", 1) - -/* Size of replace item in inspect differs */ -COB_EXCEPTION (0D03, COB_EC_RANGE_INSPECT_SIZE, - "EC-RANGE-INSPECT-SIZE", 1) - -/* Starting value of THROUGH range greater than ending value */ -COB_EXCEPTION (0D04, COB_EC_RANGE_INVALID, - "EC-RANGE-INVALID", 0) - -/* Setting of varied item in PERFORM is negative */ -COB_EXCEPTION (0D05, COB_EC_RANGE_PERFORM_VARYING, - "EC-RANGE-PERFORM-VARYING", 1) - -/* Pointer SET UP or DOWN is outsize range */ -COB_EXCEPTION (0D06, COB_EC_RANGE_PTR, - "EC-RANGE-PTR", 1) - -/* No table entry found in SEARCH because initial index out of range */ -COB_EXCEPTION (0D07, COB_EC_RANGE_SEARCH_INDEX, - "EC-RANGE-SEARCH-INDEX", 0) - -/* No table entry found in SEARCH because no entry matched criteria */ -COB_EXCEPTION (0D08, COB_EC_RANGE_SEARCH_NO_MATCH, - "EC-RANGE-SEARCH-NO-MATCH", 0) - - -/* Report write exception */ -COB_EXCEPTION (0E00, COB_EC_REPORT, - "EC-REPORT", 0) - -/* INITIATE on an active report */ -COB_EXCEPTION (0E01, COB_EC_REPORT_ACTIVE, - "EC-REPORT-ACTIVE", 1) - -/* Overlapping report items */ -COB_EXCEPTION (0E02, COB_EC_REPORT_COLUMN_OVERLAP, - "EC-REPORT-COLUMN-OVERLAP", 1) - -/* INITIATE statement executed for file not opened in extend or output mode */ -COB_EXCEPTION (0E03, COB_EC_REPORT_FILE_MODE, - "EC-REPORT-FILE-MODE", 1) - -/* Implementation-defined report write exception */ -COB_EXCEPTION (0E04, COB_EC_REPORT_IMP, - "EC-REPORT-IMP", 0) - -/* GENERATE or TERMINATE on an inactive report */ -COB_EXCEPTION (0E05, COB_EC_REPORT_INACTIVE, - "EC-REPORT-INACTIVE", 1) - -/* Overlapping report lines */ -COB_EXCEPTION (0E06, COB_EC_REPORT_LINE_OVERLAP, - "EC-REPORT-LINE-OVERLAP", 0) - -/* Report file closed with active report */ -COB_EXCEPTION (0E08, COB_EC_REPORT_NOT_TERMINATED, - "EC-REPORT-NOT-TERMINATED", 0) - -/* Vertical page limit exceeded */ -COB_EXCEPTION (0E09, COB_EC_REPORT_PAGE_LIMIT, - "EC-REPORT-PAGE-LIMIT", 0) - -/* Page width exceeded */ -COB_EXCEPTION (0E0A, COB_EC_REPORT_PAGE_WIDTH, - "EC-REPORT-PAGE-WIDTH", 0) - -/* Overflow of sum counter */ -COB_EXCEPTION (0E0B, COB_EC_REPORT_SUM_SIZE, - "EC-REPORT-SUM-SIZE", 1) - -/* VARYING clause expression non-integer */ -COB_EXCEPTION (0E0C, COB_EC_REPORT_VARYING, - "EC-REPORT-VARYING", 1) - - -/* Screen handling exception */ -COB_EXCEPTION (0F00, COB_EC_SCREEN, - "EC-SCREEN", 0) - -/* Screen fields overlap */ -COB_EXCEPTION (0F01, COB_EC_SCREEN_FIELD_OVERLAP, - "EC-SCREEN-FIELD-OVERLAP", 0) - -/* Implementation-defined screen handling exception */ -COB_EXCEPTION (0F02, COB_EC_SCREEN_IMP, - "EC-SCREEN-IMP", 0) - -/* Screen field too long for line */ -COB_EXCEPTION (0F03, COB_EC_SCREEN_ITEM_TRUNCATED, - "EC-SCREEN-ITEM-TRUNCATED", 0) - -/* Screen item line number exceeds terminal size */ -COB_EXCEPTION (0F04, COB_EC_SCREEN_LINE_NUMBER, - "EC-SCREEN-LINE-NUMBER", 0) - -/* Screen item starting column exceeds line size */ -COB_EXCEPTION (0F05, COB_EC_SCREEN_STARTING_COLUMN, - "EC-SCREEN-STARTING-COLUMN", 0) - - -/* All exceptions */ -COB_EXCEPTION (FFFF, COB_EC_ALL, - "EC-ALL", 0) diff -Nru gnucobol-4.0~early~20200606/libcob/fbdb.c gnucobol-5/libcob/fbdb.c --- gnucobol-4.0~early~20200606/libcob/fbdb.c 2020-06-06 20:52:01.000000000 +0000 +++ gnucobol-5/libcob/fbdb.c 1970-01-01 00:00:00.000000000 +0000 @@ -1,2002 +0,0 @@ -/* - Copyright (C) 2002-2012, 2014-2020 Free Software Foundation, Inc. - Written by Keisuke Nishida, Roger While, Simon Sobisch, Ron Norman - - This file is part of GnuCOBOL. - - The GnuCOBOL runtime library is free software: you can redistribute it - and/or modify it under the terms of the GNU Lesser General Public License - as published by the Free Software Foundation, either version 3 of the - License, or (at your option) any later version. - - GnuCOBOL is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU Lesser General Public License for more details. - - You should have received a copy of the GNU Lesser General Public License - along with GnuCOBOL. If not, see . -*/ - - -/* Force symbol exports */ -#define COB_LIB_EXPIMP -#include "fileio.h" - -#ifdef WITH_DB - -#include - -void cob_bdb_init_fileio (cob_file_api *a); - -/* Local variables */ - -static int ix_bdb_sync (cob_file_api *,cob_file *f); -static int ix_bdb_open (cob_file_api *,cob_file *, char *, const int, const int); -static int ix_bdb_close (cob_file_api *,cob_file *, const int); -static int ix_bdb_start (cob_file_api *,cob_file *, const int, cob_field *); -static int ix_bdb_read (cob_file_api *,cob_file *, cob_field *, const int); -static int ix_bdb_read_next (cob_file_api *,cob_file *, const int); -static int ix_bdb_write (cob_file_api *,cob_file *, const int); -static int ix_bdb_delete (cob_file_api *,cob_file *); -static int ix_bdb_file_delete(cob_file_api *, cob_file *, char *); -static int ix_bdb_rewrite (cob_file_api *,cob_file *, const int); -static int ix_bdb_file_unlock (cob_file_api *a, cob_file *f); -static void ix_bdb_exit_fileio (cob_file_api *a); -static int ix_bdb_fork (cob_file_api *a); - -static int ix_bdb_dummy () { return 0; } - -static const struct cob_fileio_funcs ext_indexed_funcs = { - ix_bdb_open, - ix_bdb_close, - ix_bdb_start, - ix_bdb_read, - ix_bdb_read_next, - ix_bdb_write, - ix_bdb_rewrite, - ix_bdb_delete, - ix_bdb_file_delete, - cob_bdb_init_fileio, - ix_bdb_exit_fileio, - ix_bdb_fork, - ix_bdb_sync, - (void*)ix_bdb_dummy, /* commit */ - (void*)ix_bdb_dummy, /* rollback */ - ix_bdb_file_unlock -}; - -static DB_ENV *bdb_env = NULL; -static char *bdb_home_dir = NULL; -static char *bdb_buff = NULL; -static const char **bdb_data_dir = NULL; -static void *record_lock_object = NULL; -static size_t rlo_size = 0; -static unsigned int bdb_lock_id = 0; -static int bdb_join = 1; - -#define DB_PUT(db,flags) db->put (db, NULL, &p->key, &p->data, flags) -#define DB_GET(db,flags) db->get (db, NULL, &p->key, &p->data, flags) -#define DB_DEL(db,key,flags) db->del (db, NULL, key, flags) -#define DB_CLOSE(db) db->close (db, 0) -#define DB_SYNC(db) db->sync (db, 0) -#if (DB_VERSION_MAJOR > 4) || ((DB_VERSION_MAJOR == 4) && (DB_VERSION_MINOR > 6)) -#define DB_SEQ(db,flags) db->get (db, &p->key, &p->data, flags) -#define DB_CPUT(db,flags) db->put (db, &p->key, &p->data, flags) -#define DB_CDEL(db,flags) db->del (db, flags) -#else -#define DB_SEQ(db,flags) db->c_get (db, &p->key, &p->data, flags) -#define DB_CPUT(db,flags) db->c_put (db, &p->key, &p->data, flags) -#define DB_CDEL(db,flags) db->c_del (db, flags) -#endif -#define cob_dbtsize_t u_int32_t - -#define COB_DUPSWAP(x) bdb_dupswap(f,(unsigned int)(x)) - -#define DBT_SET(key,fld) \ - key.data = fld->data; \ - key.size = (cob_dbtsize_t) fld->size -#define COB_MAX_BDB_LOCKS 32 - -struct indexed_file { - DB **db; /* Database handlers */ - DBC **cursor; - char *filename; /* Needed for record locks */ - unsigned char *last_key; /* The last key written */ - unsigned char *temp_key; /* Used for temporary storage */ - unsigned char **last_readkey; /* The last key read */ - unsigned int *last_dupno; /* The last number of duplicates read */ - int *rewrite_sec_key; - int maxkeylen; - int primekeylen; - unsigned char *savekey; /* Work area for saving key value */ - unsigned char *suppkey; /* Work area for saving key value */ - unsigned char *saverec; /* For saving copy of record */ - DBT key; - DBT data; - int key_index; - unsigned int bdb_lock_id; - int write_cursor_open; - int filenamelen; - int bdb_lock_num; - int bdb_lock_max; - int file_lock_set; - DB_LOCK bdb_file_lock; - DB_LOCK bdb_record_lock; - DB_LOCK *bdb_locks; -}; - -static unsigned int -bdb_dupswap (cob_file *f, unsigned int value) -{ - if (!f->flag_little_endian - && !f->flag_big_endian) - return ((unsigned int)(value)); /* Native format */ -#if defined(WORDS_BIGENDIAN) - if (f->flag_little_endian) - return (COB_BSWAP_32((unsigned int)(value))); /* big */ - return ((unsigned int)(value)); -#else - if (f->flag_big_endian) - return (COB_BSWAP_32((unsigned int)(value))); /* little */ - return ((unsigned int)(value)); -#endif -} - -static void -bdb_setkey (cob_file *f, int idx) -{ - struct indexed_file *p; - int len; - - p = f->file; - memset (p->savekey, 0, p->maxkeylen); - len = db_savekey (f, p->savekey, f->record->data, idx); - memset(&p->key,0,sizeof(p->key)); - p->key.data = p->savekey; - p->key.size = (cob_dbtsize_t) len; -} - -/* Is given key data all SUPPRESS char, - returns 1 if key has all SUPPRESS char */ -static int -bdb_suppresskey (cob_file *f, int idx) -{ - unsigned char ch_sprs; - int i,len; - struct indexed_file *p; - - if (!f->keys[idx].tf_suppress) { - return 0; - } - ch_sprs = f->keys[idx].char_suppress & 0xFF; - p = f->file; - len = db_savekey(f, p->suppkey, f->record->data, idx); - for (i = 0; i < len; i++) { - if (p->suppkey[i] != ch_sprs) - return 0; - } - return 1; -} - -/* Open the 'write cursor' if needed and return 0 is already open */ -static int -bdb_open_cursor(cob_file *f, int for_write) -{ - struct indexed_file *p; - int flags; - - p = f->file; - if(p->write_cursor_open) - return 0; /* It is already open */ - if (bdb_env && for_write) { - flags = DB_WRITECURSOR; - } else { - flags = 0; - } - p->db[0]->cursor (p->db[0], NULL, &p->cursor[0], flags); - p->write_cursor_open = 1; - return 1; -} - -/* Close the 'write cursor' if needed and return 0 is already closed */ -static int -bdb_close_cursor(cob_file *f) -{ - struct indexed_file *p; - - p = f->file; - p->write_cursor_open = 0; - if(p->cursor[0] == NULL) - return 0; /* It is already closed */ -#if (DB_VERSION_MAJOR > 4) || ((DB_VERSION_MAJOR == 4) && (DB_VERSION_MINOR > 6)) - p->cursor[0]->close (p->cursor[0]); -#else - p->cursor[0]->c_close (p->cursor[0]); -#endif - p->cursor[0] = NULL; - return 1; -} - -/* Close the 'cursor' on a specific index */ -static int -bdb_close_index(cob_file *f, int index) -{ - struct indexed_file *p; - - p = f->file; - if(p->cursor[index] == NULL) - return 0; /* It is already closed */ -#if (DB_VERSION_MAJOR > 4) || ((DB_VERSION_MAJOR == 4) && (DB_VERSION_MINOR > 6)) - p->cursor[index]->close (p->cursor[index]); -#else - p->cursor[index]->c_close (p->cursor[index]); -#endif - p->cursor[index] = NULL; - return 1; -} - - -/* Local functions */ - -static int -ix_bdb_sync (cob_file_api *a, cob_file *f) -{ - struct indexed_file *p; - int i; - COB_UNUSED(a); - - if (f->organization == COB_ORG_INDEXED) { - p = f->file; - if (p) { - for (i = 0; i < (int)f->nkeys; ++i) { - if (p->db[i]) { - DB_SYNC (p->db[i]); - } - } - } - } - return 0; -} - -/* INDEXED */ - -static int bdb_err_tear_down = 0; - -#if (DB_VERSION_MAJOR > 4) -static void -bdb_err_event (DB_ENV *env, u_int32_t event, void *info) -{ - const char *msg = NULL; - COB_UNUSED (env); - COB_UNUSED (info); - - if (bdb_err_tear_down) return; - - switch (event) { -#ifdef DB_EVENT_FAILCHK_PANIC - case DB_EVENT_FAILCHK_PANIC: - msg = "FailChk_Panic"; - /* fall-thru */ -#endif -#ifdef DB_EVENT_PANIC - case DB_EVENT_PANIC: - if (msg != NULL) msg = "Panic"; - /* unset BDB environment as we cannot do anything with it any more */ - bdb_env = NULL; - bdb_err_tear_down = 1; - break; -#endif -#ifdef DB_EVENT_EVENT_MUTEX_DIED - case DB_EVENT_MUTEX_DIED: - msg = "Mutex Died"; break; -#endif -#ifdef DB_EVENT_WRITE_FAILED - case DB_EVENT_WRITE_FAILED: - msg = "WriteFailed"; break; -#endif - default: msg = "unknown"; break; - } - cob_runtime_error (_("BDB (%s), error: %d %s"), "fatal error", event, msg); - cob_stop_run (1); -} -#endif - -static void -join_environment (cob_file_api *a) -{ - cob_u32_t flags; - int ret, k; - - if (file_setptr->bdb_home == NULL) { - /* Default to the current directory */ - file_setptr->bdb_home = strdup("."); - } else if (file_setptr->bdb_home[0] <= ' ' - || strcasecmp(file_setptr->bdb_home,"no") == 0 - || strcasecmp(file_setptr->bdb_home,"false") == 0) { - /* This effectively disables record/file locking */ - /* But prevents the BDB control files from being created */ - return; - } - if(file_setptr->bdb_home) - bdb_home_dir = cob_strdup(file_setptr->bdb_home); - ret = db_env_create (&bdb_env, 0); - if (ret) { - cob_runtime_error (_("cannot join BDB environment (%s), error: %d %s"), - "env_create", ret, db_strerror (ret)); - cob_stop_run (1); - } - bdb_env->set_errfile (bdb_env, stderr); -#if (DB_VERSION_MAJOR > 4) || ((DB_VERSION_MAJOR == 4) && (DB_VERSION_MINOR > 2)) - bdb_env->set_msgfile (bdb_env, stderr); - if (a->file_paths) { - for(k=0; a->file_paths[k] != NULL; k++) { - ret = bdb_env->set_data_dir (bdb_env, a->file_paths[k]); - } - } -#endif - bdb_env->set_cachesize (bdb_env, 0, 2*1024*1024, 0); - bdb_env->set_alloc (bdb_env, cob_malloc, realloc, cob_free); - flags = DB_CREATE | DB_INIT_MPOOL | DB_INIT_CDB; - ret = bdb_env->open (bdb_env, file_setptr->bdb_home, flags, 0); - if (ret) { - cob_runtime_error (_("cannot join BDB environment (%s), error: %d %s"), - "env->open", ret, db_strerror (ret)); - bdb_env->close (bdb_env, 0); - bdb_env = NULL; - cob_stop_run (1); - } -#if (DB_VERSION_MAJOR > 4) || ((DB_VERSION_MAJOR == 4) && (DB_VERSION_MINOR > 1)) - bdb_env->get_data_dirs (bdb_env, &bdb_data_dir); -#endif - bdb_env->lock_id (bdb_env, &bdb_lock_id); - bdb_env->set_lk_detect (bdb_env, DB_LOCK_DEFAULT); -#if (DB_VERSION_MAJOR > 4) - bdb_env->set_event_notify(bdb_env, (void*)bdb_err_event); -#endif -} - -/* Impose lock on 'file' using BDB locking */ -static int -bdb_lock_file (cob_file *f, char *filename, int lock_mode) -{ - struct indexed_file *p; - int ret, retry, interval; - DBT dbt; - - if (bdb_env == NULL) - return 0; - p = f->file; - ret = 0; - p->file_lock_set = 0; - retry = interval = 0; - if ((f->retry_mode & COB_RETRY_FOREVER)) { - retry = -1; - } else - if ((f->retry_mode & COB_RETRY_SECONDS)) { - retry = 1; - interval = f->retry_seconds>0?f->retry_seconds: - (file_setptr->cob_retry_seconds>0?file_setptr->cob_retry_seconds:1); - } else - if ((f->retry_mode & COB_RETRY_TIMES)) { - retry = f->retry_times>0?f->retry_times: - (file_setptr->cob_retry_times>0?file_setptr->cob_retry_times:1); - interval = file_setptr->cob_retry_seconds>0?file_setptr->cob_retry_seconds:1; - } - if(retry > 0) { - retry = retry * interval * COB_RETRY_PER_SECOND ; - interval = 1000 / COB_RETRY_PER_SECOND ; - } - do { - memset(&dbt,0,sizeof(dbt)); - dbt.size = (cob_dbtsize_t) strlen (filename); - dbt.data = filename; - ret = bdb_env->lock_get (bdb_env, bdb_lock_id, DB_LOCK_NOWAIT, - &dbt, lock_mode, &p->bdb_file_lock); - if (ret == 0) { - p->file_lock_set = 1; - break; - } - if (ret == DB_LOCK_DEADLOCK) - return COB_STATUS_52_DEAD_LOCK; - if(ret != DB_LOCK_NOTGRANTED) { - break; - } - if (retry > 0) { - retry--; - cob_sleep_msec(interval); - } - } while (ret != 0 && retry != 0); - - if(ret == DB_LOCK_NOTGRANTED) - return COB_STATUS_61_FILE_SHARING; - if (ret) { - cob_runtime_error (_("BDB (%s), error: %d %s"), - "file lock_get", ret, db_strerror (ret)); - return COB_STATUS_30_PERMANENT_ERROR; - } - return ret; -} - -/* Impose lock on record and table it */ -static int -bdb_lock_record (cob_file *f, const char *key, const unsigned int keylen) -{ - struct indexed_file *p; - size_t len; - int j, k, ret, retry, interval; - DBT dbt; - - if (bdb_env == NULL) - return 0; - p = f->file; - ret = 0; - retry = interval = 0; - if ((f->retry_mode & COB_RETRY_FOREVER)) { - retry = -1; - } else - if ((f->retry_mode & COB_RETRY_SECONDS)) { - retry = 1; - interval = f->retry_seconds>0?f->retry_seconds: - (file_setptr->cob_retry_seconds>0?file_setptr->cob_retry_seconds:1); - } else - if ((f->retry_mode & COB_RETRY_TIMES)) { - retry = f->retry_times>0?f->retry_times: - (file_setptr->cob_retry_times>0?file_setptr->cob_retry_times:1); - interval = file_setptr->cob_retry_seconds>0?file_setptr->cob_retry_seconds:1; - } - - len = keylen + p->filenamelen + 1; - if (len > rlo_size) { - cob_free (record_lock_object); - record_lock_object = cob_malloc (len); - rlo_size = len; - } - memcpy ((char *)record_lock_object, p->filename, (size_t)(p->filenamelen + 1)); - memcpy ((char *)record_lock_object + p->filenamelen + 1, key, (size_t)keylen); - - if(retry > 0) { - retry = retry * interval * COB_RETRY_PER_SECOND; - interval = 1000 / COB_RETRY_PER_SECOND; - } - - do { - memset(&dbt,0,sizeof(dbt)); - dbt.size = (cob_dbtsize_t) len; - dbt.data = record_lock_object; - ret = bdb_env->lock_get (bdb_env, bdb_lock_id, retry==-1?0:DB_LOCK_NOWAIT, - &dbt, DB_LOCK_WRITE, &p->bdb_record_lock); - if (ret == 0) - break; - if (ret == DB_LOCK_DEADLOCK) - return COB_STATUS_52_DEAD_LOCK; - if(ret != DB_LOCK_NOTGRANTED) { - break; - } - if (retry > 0) { - retry--; - cob_sleep_msec(interval); - } - } while (ret != 0 && retry != 0); - - if (!ret) { - if (p->bdb_lock_max == 0) { - p->bdb_lock_max = COB_MAX_BDB_LOCKS; - p->bdb_locks = cob_malloc(p->bdb_lock_max * sizeof(DB_LOCK)); - p->bdb_lock_num = 0; - } - if (p->bdb_lock_num+1 >= p->bdb_lock_max) { - p->bdb_locks = cob_realloc(p->bdb_locks, p->bdb_lock_max, - (p->bdb_lock_max + COB_MAX_BDB_LOCKS) * sizeof(DB_LOCK)); - p->bdb_lock_max += COB_MAX_BDB_LOCKS; - } - for(k = 0; k < p->bdb_lock_num; k++) { - if (memcmp(&p->bdb_record_lock, &p->bdb_locks[k], sizeof(DB_LOCK)) == 0) { - /* Move to end of lock table for later: bdb_unlock_last */ - for (j=k; j < p->bdb_lock_num; j++) { - memcpy (&p->bdb_locks[j], &p->bdb_locks[j+1], sizeof(DB_LOCK)); - } - memcpy (&p->bdb_locks[p->bdb_lock_num-1], &p->bdb_record_lock, sizeof(DB_LOCK)); - /* Release lock just acquired as it is a duplicate */ - ret = bdb_env->lock_put (bdb_env, &p->bdb_record_lock); - return ret; - } - } - if (p->bdb_lock_num < p->bdb_lock_max) { - p->bdb_locks [ p->bdb_lock_num++ ] = p->bdb_record_lock; - } - } - if(ret == DB_LOCK_NOTGRANTED) - return COB_STATUS_51_RECORD_LOCKED; - if (ret) { - cob_runtime_error (_("BDB (%s), error: %d %s"), - "lock_get", ret, db_strerror (ret)); - return COB_STATUS_30_PERMANENT_ERROR; - } - return ret; -} - -static int -bdb_test_record_lock (cob_file *f, const char *key, const unsigned int keylen) -{ - struct indexed_file *p; - size_t len; - int j, k, ret, retry, interval; - DBT dbt; - DB_LOCK test_lock; - - if (bdb_env == NULL) - return 0; - p = f->file; - ret = 0; - retry = interval = 0; - if ((f->retry_mode & COB_RETRY_FOREVER)) { - retry = -1; - } else - if ((f->retry_mode & COB_RETRY_SECONDS)) { - retry = 1; - interval = f->retry_seconds>0?f->retry_seconds: - (file_setptr->cob_retry_seconds>0?file_setptr->cob_retry_seconds:1); - } else - if ((f->retry_mode & COB_RETRY_TIMES)) { - retry = f->retry_times>0?f->retry_times: - (file_setptr->cob_retry_times>0?file_setptr->cob_retry_times:1); - interval = file_setptr->cob_retry_seconds>0?file_setptr->cob_retry_seconds:1; - } - len = keylen + p->filenamelen + 1; - if (len > rlo_size) { - cob_free (record_lock_object); - record_lock_object = cob_malloc (len); - rlo_size = len; - } - memcpy ((char *)record_lock_object, p->filename, (size_t)(p->filenamelen + 1)); - memcpy ((char *)record_lock_object + p->filenamelen + 1, key, (size_t)keylen); - memset(&test_lock,0,sizeof(test_lock)); - if(retry > 0) { - retry = retry * interval * COB_RETRY_PER_SECOND ; - interval = 1000 / COB_RETRY_PER_SECOND ; - } - do { - memset(&dbt,0,sizeof(dbt)); - dbt.size = (cob_dbtsize_t) len; - dbt.data = record_lock_object; - ret = bdb_env->lock_get (bdb_env, bdb_lock_id, DB_LOCK_NOWAIT, - &dbt, DB_LOCK_WRITE, &test_lock); - if (ret == 0) - break; - if (ret == DB_LOCK_DEADLOCK) - return COB_STATUS_52_DEAD_LOCK; - if(ret != DB_LOCK_NOTGRANTED) { - break; - } - if (retry > 0) { - retry--; - cob_sleep_msec(interval); - } - } while (ret != 0 && retry != 0); - - if (!ret) { - if (p->bdb_lock_num > 0) { - for(k = 0; k < p->bdb_lock_num; k++) { - if (memcmp(&test_lock, &p->bdb_locks[k], sizeof(DB_LOCK)) == 0) { - /* Move to end of lock table for later: bdb_unlock_last */ - for (j=k; j < p->bdb_lock_num; j++) { - memcpy (&p->bdb_locks[j], &p->bdb_locks[j+1], sizeof(DB_LOCK)); - } - memcpy (&p->bdb_locks[p->bdb_lock_num-1], &test_lock, sizeof(DB_LOCK)); - break; - } - } - } - ret = bdb_env->lock_put (bdb_env, &test_lock);/* Release lock just acquired */ - } - if(ret == DB_LOCK_NOTGRANTED) - return COB_STATUS_51_RECORD_LOCKED; - if (ret) { - cob_runtime_error (_("BDB (%s), error: %d %s"), - "lock_get", ret, db_strerror (ret)); - return COB_STATUS_30_PERMANENT_ERROR; - } - return ret; -} - -static int -bdb_unlock_all (cob_file *f) -{ - struct indexed_file *p; - int ret = 0, k; - - p = f->file; - if (p->bdb_lock_num == 0 - || bdb_env == NULL) { - return 0; - } - if (p->bdb_lock_num > 0) { - for (k=p->bdb_lock_num-1; k >= 0; k--) { - ret = bdb_env->lock_put (bdb_env, &p->bdb_locks[k]); - } - p->bdb_lock_num = 0; - } else { - ret = bdb_env->lock_put (bdb_env, &p->bdb_record_lock); - } - if (ret) { - cob_runtime_error (_("BDB (%s), error: %d %s"), - "lock_put", ret, db_strerror (ret)); - return COB_STATUS_30_PERMANENT_ERROR; - } - return ret; -} - -static int -bdb_unlock_last (cob_file *f) -{ - struct indexed_file *p; - int ret = 0; - - p = f->file; - if (p->bdb_lock_num == 0 - || bdb_env == NULL) { - return 0; - } - if (p->bdb_lock_num > 0) { - p->bdb_lock_num--; - ret = bdb_env->lock_put (bdb_env, &p->bdb_locks[p->bdb_lock_num]); - } - if (ret) { - cob_runtime_error (_("BDB (%s), error: %d %s"), - "lock_put", ret, db_strerror (ret)); - return COB_STATUS_30_PERMANENT_ERROR; - } - return ret; -} - -static int -bdb_test_lock_advance(cob_file *f, int nextprev, int skip_lock) -{ - struct indexed_file *p; - int ret; - - p = f->file; - ret = bdb_test_record_lock (f, p->key.data, p->key.size); - while (ret == COB_STATUS_51_RECORD_LOCKED - && skip_lock) { - ret = DB_SEQ (p->cursor[p->key_index], nextprev); - if (ret == DB_NOTFOUND) - return COB_STATUS_10_END_OF_FILE; - if (!ret) { - ret = bdb_test_record_lock (f, p->key.data, p->key.size); - } - } - return ret; -} - -static int -bdb_lock_advance(cob_file *f, int nextprev, int skip_lock) -{ - struct indexed_file *p; - int ret; - - p = f->file; - ret = bdb_lock_record (f, p->key.data, p->key.size); - while (ret == COB_STATUS_51_RECORD_LOCKED - && skip_lock) { - ret = DB_SEQ (p->cursor[p->key_index], nextprev); - if (ret == DB_NOTFOUND) - return COB_STATUS_10_END_OF_FILE; - if (!ret) { - ret = bdb_test_record_lock (f, p->key.data, p->key.size); - } - } - return ret; -} - -/* Get the next number in a set of duplicates */ -static unsigned int -get_dupno (cob_file *f, const cob_u32_t i) -{ - struct indexed_file *p; - int ret; - unsigned int dupno; - - p = f->file; - dupno = 0; - bdb_setkey(f, i); - memcpy (p->temp_key, p->key.data, (size_t)p->maxkeylen); - p->db[i]->cursor (p->db[i], NULL, &p->cursor[i], 0); - ret = DB_SEQ (p->cursor[i], DB_SET_RANGE); - while (ret == 0 && memcmp (p->key.data, p->temp_key, (size_t)p->key.size) == 0) { - memcpy (&dupno, (cob_u8_ptr)p->data.data + p->primekeylen, sizeof (unsigned int)); - ret = DB_SEQ (p->cursor[i], DB_NEXT); - } - bdb_close_index (f, i); - dupno = COB_DUPSWAP(dupno); - return ++dupno; -} - -/* read file with all alternate keys that don't allow duplicates - to check if records exist already, returns 1 if true */ -static int -check_alt_keys (cob_file *f, const int rewrite) -{ - struct indexed_file *p; - int i; - int ret; - - p = f->file; - for (i = 1; i < (int)f->nkeys; ++i) { - if (!f->keys[i].tf_duplicates) { - bdb_setkey (f, i); - ret = DB_GET (p->db[i], 0); - if (ret == 0) { - if (rewrite) { - if (db_cmpkey (f, p->data.data, f->record->data, 0, 0)) { - return 1; - } - } else { - return 1; - } - } - } - } - return 0; -} - -static int -ix_bdb_write_internal (cob_file *f, const int rewrite, const int opt) -{ - struct indexed_file *p; - cob_u32_t i, len; - unsigned int dupno = 0; - cob_u32_t flags = 0; - int close_cursor, ret; - - p = f->file; - close_cursor = bdb_open_cursor (f, 1); - - /* Check duplicate alternate keys */ - if (!rewrite) { - if (f->nkeys > 1 && check_alt_keys (f, 0)) { - bdb_close_cursor (f); - return COB_STATUS_22_KEY_EXISTS; - } - bdb_setkey (f, 0); - } - - /* Write data */ - if (DB_SEQ (p->cursor[0], DB_SET) == 0) { - bdb_close_cursor (f); - return COB_STATUS_22_KEY_EXISTS; - } - p->data.data = f->record->data; - p->data.size = (cob_dbtsize_t) f->record->size; - DB_CPUT(p->cursor[0], DB_KEYFIRST); - - /* Write secondary keys */ - p->data = p->key; - for (i = 1; i < f->nkeys; ++i) { - if (rewrite && ! p->rewrite_sec_key[i]) { - continue; - } - if (bdb_suppresskey (f, i)) - continue; - bdb_setkey (f, i); - memset(&p->data,0,sizeof(p->data)); - if (f->keys[i].tf_duplicates) { - flags = 0; - dupno = get_dupno(f, i); - dupno = COB_DUPSWAP (dupno); - len = db_savekey(f, p->temp_key, f->record->data, 0); - p->data.data = p->temp_key; - p->data.size = (cob_dbtsize_t)len; - memcpy (((char*)(p->data.data)) + p->data.size, &dupno, sizeof (unsigned int)); - p->data.size += sizeof (unsigned int); - } else { - len = db_savekey(f, p->temp_key, f->record->data, 0); - p->data.data = p->temp_key; - p->data.size = (cob_dbtsize_t)len; - flags = DB_NOOVERWRITE; - dupno = 0; - } - bdb_setkey (f, i); - - ret = DB_PUT (p->db[i], flags); -#if (DB_VERSION_MAJOR < 6) - if (ret == ENOENT) { /* This is strange, but BDB 5.3 was returning ENOENT sometimes */ - ret = DB_PUT (p->db[i], 0); - } -#endif - if (ret != 0) { - bdb_close_cursor (f); - return COB_STATUS_22_KEY_EXISTS; - } - } - - if (close_cursor) - bdb_close_cursor (f); - - if ((opt & COB_WRITE_LOCK) - && bdb_env != NULL) { - bdb_setkey (f, 0); - if (bdb_lock_record (f, p->key.data, p->key.size)) { - bdb_close_cursor (f); - return COB_STATUS_51_RECORD_LOCKED; - } - } - if (dupno > 0) { - return COB_STATUS_02_SUCCESS_DUPLICATE; - } - return COB_STATUS_00_SUCCESS; -} - -static int -ix_bdb_start_internal (cob_file *f, const int cond, cob_field *key, - const int read_opts, const int test_lock) -{ - struct indexed_file *p; - int ret, len, fullkeylen, partlen; - unsigned int dupno; - int key_index; - - dupno = 0; - ret = 0; - p = f->file; - /* Look up for the key */ - key_index = db_findkey (f, key, &fullkeylen, &partlen); - if (key_index < 0) { - return COB_STATUS_23_KEY_NOT_EXISTS; - } - p->key_index = (unsigned int)key_index; - f->curkey = (short)key_index; - - /* Search */ - bdb_setkey (f, p->key_index); - p->key.size = (cob_dbtsize_t)partlen; /* may be partial key */ - /* The open cursor makes this function atomic */ - if (p->key_index != 0) { - p->db[0]->cursor (p->db[0], NULL, &p->cursor[0], 0); - } - p->db[p->key_index]->cursor (p->db[p->key_index], NULL, &p->cursor[p->key_index], 0); - if (cond == COB_FI) { - ret = DB_SEQ (p->cursor[p->key_index], DB_FIRST); - } else if (cond == COB_LA) { - ret = DB_SEQ (p->cursor[p->key_index], DB_LAST); - } else { - ret = DB_SEQ (p->cursor[p->key_index], DB_SET_RANGE); - } - switch (cond) { - case COB_EQ: - if (ret == 0) { - ret = db_cmpkey (f, p->key.data, f->record->data, p->key_index, partlen); - } - break; - case COB_LT: - if (ret != 0) { - ret = DB_SEQ (p->cursor[p->key_index], DB_LAST); - } else { - ret = DB_SEQ (p->cursor[p->key_index], DB_PREV); - } - break; - case COB_LE: - if (ret != 0) { - ret = DB_SEQ (p->cursor[p->key_index], DB_LAST); - } else if (db_cmpkey (f, p->key.data, f->record->data, p->key_index, partlen) != 0) { - ret = DB_SEQ (p->cursor[p->key_index], DB_PREV); - } else if (f->keys[p->key_index].tf_duplicates) { - ret = DB_SEQ (p->cursor[p->key_index], DB_NEXT_NODUP); - if (ret != 0) { - ret = DB_SEQ (p->cursor[p->key_index], DB_LAST); - } else { - ret = DB_SEQ (p->cursor[p->key_index], DB_PREV); - } - } - break; - case COB_GT: - while (ret == 0 && db_cmpkey (f, p->key.data, f->record->data, p->key_index, partlen) == 0) { - ret = DB_SEQ (p->cursor[p->key_index], DB_NEXT); - } - break; - case COB_GE: - /* nothing */ - break; - case COB_FI: - /* nothing */ - break; - case COB_LA: - /* nothing */ - break; - } - - if (ret == 0 && p->key_index > 0) { - /* Temporarily save alternate key */ - len = p->key.size; - memcpy (p->temp_key, p->key.data, len); - if (f->keys[p->key_index].tf_duplicates) { - memcpy (&dupno, (cob_u8_ptr)p->data.data + p->primekeylen, sizeof (unsigned int)); - dupno = COB_DUPSWAP (dupno); - } - p->key.data = p->data.data; - p->key.size = p->primekeylen; - ret = DB_GET (p->db[0], 0); - } - - if (p->key_index > 0) - bdb_close_index (f, p->key_index); - bdb_close_cursor (f); - - if (ret == 0 && test_lock) { - if (!(read_opts & COB_READ_IGNORE_LOCK) - && !(read_opts & COB_READ_NO_LOCK) - && !(read_opts & COB_READ_LOCK)) { - ret = bdb_test_record_lock (f, p->key.data, p->key.size); - if (ret) { - bdb_close_index (f, p->key_index); - bdb_close_cursor (f); - return ret; - } - } - if (read_opts & COB_READ_LOCK) { - ret = bdb_lock_record (f, p->key.data, p->key.size); - if (ret) { - bdb_close_index (f, p->key_index); - bdb_close_cursor (f); - return ret; - } - } - } - - if (ret == 0) { - if (p->key_index == 0) { - memcpy (p->last_readkey[0], p->key.data, p->primekeylen); - } else { - int keylen = db_keylen (f, p->key_index); - if (partlen <= 0) { - cob_runtime_error (_("invalid internal call of %s"), "ix_bdb_start_internal/db_keylen"); - cob_runtime_error (_("Please report this!")); - cob_stop_run (1); - } - memcpy (p->last_readkey[p->key_index], - p->temp_key, keylen); - memcpy (p->last_readkey[p->key_index + f->nkeys], p->key.data, p->primekeylen); - if (f->keys[p->key_index].tf_duplicates) { - p->last_dupno[p->key_index] = dupno; - } - } - } - - bdb_close_index (f, p->key_index); - if (p->key_index != 0) { - bdb_close_cursor (f); - } - - return (ret == 0) ? COB_STATUS_00_SUCCESS : COB_STATUS_23_KEY_NOT_EXISTS; -} - -static int -ix_bdb_delete_internal (cob_file *f, const int rewrite, int bdb_opts) -{ - struct indexed_file *p; - int i,len; - DBT prim_key; - int ret; - cob_u32_t flags; - int close_cursor = 0; - COB_UNUSED(bdb_opts); - - p = f->file; - if (!(f->lock_mode & COB_LOCK_MULTIPLE)) { - bdb_unlock_all (f); - } - /* Find the primary key */ - if (f->access_mode != COB_ACCESS_SEQUENTIAL) { - bdb_setkey(f, 0); - } - if (bdb_env != NULL) { - ret = bdb_test_record_lock (f, p->key.data, p->key.size); - if (ret) { - bdb_close_cursor (f); - return ret; - } - } - if (bdb_env) { - flags = DB_WRITECURSOR; - } else { - flags = 0; - } - close_cursor = bdb_open_cursor (f, 1); - ret = DB_SEQ (p->cursor[0], DB_SET); - if (ret != 0 && f->access_mode != COB_ACCESS_SEQUENTIAL) { - bdb_close_cursor (f); - return COB_STATUS_23_KEY_NOT_EXISTS; - } - prim_key = p->key; - memcpy(p->saverec, p->data.data, p->data.size); /* Save old record image */ - memcpy(p->temp_key,prim_key.data,prim_key.size); /* Save primary key value */ - prim_key.data = p->temp_key; - - /* Delete the secondary keys */ - for (i = 1; i < (int)(f->nkeys); ++i) { - len = db_savekey(f, p->suppkey, p->data.data, i); - memset(p->savekey, 0, p->maxkeylen); - len = db_savekey(f, p->savekey, p->saverec, i); - p->key.data = p->savekey; - p->key.size = (cob_dbtsize_t) len; - /* rewrite: no delete if secondary key is unchanged */ - if (rewrite) { - p->rewrite_sec_key[i] = db_cmpkey(f, p->suppkey, f->record->data, i, 0); - if (!p->rewrite_sec_key[i]) { - continue; - } - } - if (!f->keys[i].tf_duplicates) { - DB_DEL (p->db[i], &p->key, 0); - } else { - DBT sec_key = p->key; - - p->db[i]->cursor (p->db[i], NULL, &p->cursor[i], flags); - if (DB_SEQ (p->cursor[i], DB_SET_RANGE) == 0) { - while (sec_key.size == p->key.size - && memcmp (p->key.data, sec_key.data, (size_t)sec_key.size) == 0) { - if (memcmp (p->data.data, prim_key.data, (size_t)prim_key.size) == 0) { - ret = DB_CDEL(p->cursor[i], 0); - } - if (DB_SEQ (p->cursor[i], DB_NEXT) != 0) { - break; - } - } - } - bdb_close_index (f, i); - } - } - - /* Delete the record */ - ret = DB_CDEL(p->cursor[0], 0); - - if (close_cursor && !rewrite) { - bdb_close_cursor (f); - } - return COB_STATUS_00_SUCCESS; -} - -/* Delete file */ -static int -ix_bdb_file_delete (cob_file_api *a, cob_file *f, char *filename) -{ - int i; - char file_open_buff[COB_FILE_MAX+1]; - COB_UNUSED(a); - - for (i = 0; i < (int)f->nkeys; ++i) { - if (i == 0) { - snprintf (file_open_buff, (size_t)COB_FILE_MAX, "%s", filename); - } else { - snprintf (file_open_buff, (size_t)COB_FILE_MAX, "%s.%d", filename, (int)i); - } - file_open_buff[COB_FILE_MAX] = 0; - unlink (file_open_buff); - } - return 0; -} - -static int -is_absolute (const char *filename) -{ -#ifdef _WIN32 - if (filename[0] == '/' || filename[0] == '\\') { - return 1; - } else { - if (isalpha (filename[0]) && filename[1] == ':' && - (filename[2] == '/' || filename[2] == '\\')) { - return 1; - } else { - return 0; - } - } -#else - if (filename[0] == '/') { - return 1; - } else { - return 0; - } -#endif -} - -/* Check if a file exists in bdb data dirs */ -static int -bdb_nofile (const char *filename) -{ - cob_u32_t i; - - if (!bdb_env || is_absolute (filename)) { - errno = 0; - if (bdb_buff) - strcpy(bdb_buff, filename); - if (access (filename, F_OK) && errno == ENOENT) { - return 1; - } - return 0; - } - - for (i = 0; bdb_data_dir && bdb_data_dir[i]; ++i) { - if (is_absolute (bdb_data_dir[i])) { - snprintf (bdb_buff, (size_t)COB_SMALL_MAX, "%s%c%s", - bdb_data_dir[i], SLASH_CHAR, filename); - } else { - snprintf (bdb_buff, (size_t)COB_SMALL_MAX, "%s%c%s%c%s", - file_setptr->bdb_home, SLASH_CHAR, bdb_data_dir[i], SLASH_CHAR, filename); - } - bdb_buff[COB_SMALL_MAX] = 0; /* silence analyzer */ - errno = 0; - if (access (bdb_buff, F_OK) == 0 || errno != ENOENT) { - return 0; - } - } - if (i == 0) { - snprintf (bdb_buff, (size_t)COB_SMALL_MAX, "%s%c%s", - file_setptr->bdb_home, SLASH_CHAR, filename); - bdb_buff[COB_SMALL_MAX] = 0; /* silence analyzer */ - errno = 0; - if (access (bdb_buff, F_OK) == 0 || errno != ENOENT) { - return 0; - } - } - return 1; -} - -/* OPEN INDEXED file */ -static int -ix_bdb_open (cob_file_api *a, cob_file *f, char *filename, const int mode, const int sharing) -{ - struct indexed_file *p; - int i; - int j; - int maxsize; - db_lockmode_t lock_mode; - int handle_created; - cob_u32_t flags = 0; - int ret = 0; - int nonexistent; - char runtime_buffer[COB_FILE_MAX+1]; - COB_UNUSED (sharing); - - if (bdb_join) { /* Join BDB, on first OPEN of INDEXED file */ - join_environment (a); - bdb_join = 0; - } - - nonexistent = 0; - if (bdb_nofile (filename)) { - nonexistent = 1; - if (mode != COB_OPEN_OUTPUT && f->flag_optional == 0) { - return COB_STATUS_35_NOT_EXISTS; - } - } - - p = cob_malloc (sizeof (struct indexed_file)); - f->flag_file_lock = 0; - f->curkey = -1; - if (bdb_env != NULL) { - if ((f->share_mode & COB_SHARE_ALL_OTHER)) { - lock_mode = DB_LOCK_READ; - } else - if (mode == COB_OPEN_OUTPUT - || mode == COB_OPEN_EXTEND - || (f->share_mode & COB_SHARE_NO_OTHER) - || (f->lock_mode & COB_FILE_EXCLUSIVE) - || (mode == COB_OPEN_I_O && !f->lock_mode)) { - lock_mode = DB_LOCK_WRITE; - f->flag_file_lock = 1; - } else { - lock_mode = DB_LOCK_READ; - } - f->file = p; - ret = bdb_lock_file (f, filename, lock_mode); - if (ret) { - cob_free (p); - f->file = NULL; - return ret; - } - } - - switch (mode) { - case COB_OPEN_INPUT: - flags |= DB_RDONLY; - break; - case COB_OPEN_OUTPUT: - flags |= DB_CREATE; - break; - case COB_OPEN_I_O: - case COB_OPEN_EXTEND: - flags |= DB_CREATE; - break; - } - - if (mode != COB_OPEN_OUTPUT) { - if (bdb_nofile(filename) == 0) { - if (a->cob_read_dict (f, bdb_buff, !f->flag_keycheck, &ret)) { - return ret ? ret : COB_STATUS_39_CONFLICT_ATTRIBUTE; - } - } else if (a->cob_read_dict (f, filename, !f->flag_keycheck, &ret)) { - return ret ? ret : COB_STATUS_39_CONFLICT_ATTRIBUTE; - } - } - - p->db = cob_malloc (sizeof (DB *) * f->nkeys); - p->cursor = cob_malloc (sizeof (DBC *) * f->nkeys); - p->filenamelen = (int) strlen (filename); - p->last_readkey = cob_malloc (sizeof (unsigned char *) * 2 * f->nkeys); - p->last_dupno = cob_malloc (sizeof (unsigned int) * f->nkeys); - p->rewrite_sec_key = cob_malloc (sizeof (int) * f->nkeys); - maxsize = p->primekeylen = db_keylen(f, 0); - for (i = 1; i < f->nkeys; ++i) { - j = db_keylen(f, i); - if( j > maxsize) - maxsize = j; - } - p->maxkeylen = maxsize; - - for (i = 0; i < f->nkeys; ++i) { - /* File name */ - runtime_buffer[COB_FILE_MAX] = 0; - if (i == 0) { - snprintf (runtime_buffer, (size_t)COB_FILE_MAX, "%s", filename); - } else { - snprintf (runtime_buffer, (size_t)COB_FILE_MAX, "%s.%d", filename, (int)i); - } - - /* btree info */ - ret = db_create (&p->db[i], bdb_env, 0); - if (!ret) { - handle_created = 1; - if (f->flag_big_endian) { - ret = p->db[i]->set_lorder (p->db[i], 1234); - if (ret) { - cob_runtime_error (_("cannot set BDB byteorder (%s), error: %d %s"), - "set_lorder", ret, db_strerror (ret)); - return COB_STATUS_39_CONFLICT_ATTRIBUTE; - } - } else if (f->flag_little_endian) { - ret = p->db[i]->set_lorder (p->db[i], 4321); - if (ret) { - cob_runtime_error (_("cannot set BDB byteorder (%s), error: %d %s"), - "set_lorder", ret, db_strerror (ret)); - return COB_STATUS_39_CONFLICT_ATTRIBUTE; - } - } - if (mode == COB_OPEN_OUTPUT) { - if (bdb_env) { - if (!bdb_nofile(runtime_buffer)) { - ret = bdb_env->dbremove (bdb_env, NULL, runtime_buffer, NULL, 0); - if (ret == ENOENT) - ret = 0; - } - } else { - /* FIXME: test "First READ on empty SEQUENTIAL INDEXED file ..." - on OPEN-OUTPUT results with MinGW & BDB 6 in - BDB1565 DB->pget: method not permitted before handle's open method - */ - p->db[i]->remove (p->db[i], runtime_buffer, NULL, 0); - ret = db_create (&p->db[i], bdb_env, 0); - } - } - if (!ret) { - if (f->keys[i].tf_duplicates) { - p->db[i]->set_flags (p->db[i], DB_DUP); - } - } - } else { - handle_created = 0; - } - /* Open db */ - if (!ret) { - /* FIXME: test "First READ on empty SEQUENTIAL INDEXED file ..." - on OPEN-OUTPUT results with MinGW & BDB 6 in - BDB0588 At least one secondary cursor must be specified to DB->join - */ - ret = p->db[i]->open (p->db[i], NULL, runtime_buffer, NULL, - DB_BTREE, flags, COB_FILE_MODE); - if (ret == 0 - && i == 0 - && mode == COB_OPEN_OUTPUT - && bdb_nofile(runtime_buffer) == 0) { - a->cob_write_dict(f, bdb_buff); - } - } - if (ret) { - for (j = 0; j < i; ++j) { - DB_CLOSE (p->db[j]); - } - if (handle_created) { - DB_CLOSE (p->db[i]); - } - cob_free (p->db); - cob_free (p->last_readkey); - cob_free (p->last_dupno); - cob_free (p->rewrite_sec_key); - cob_free (p->cursor); - if (bdb_env != NULL) { - if(p->file_lock_set) { - bdb_env->lock_put (bdb_env, &p->bdb_file_lock); - p->file_lock_set = 0; - } - } - cob_free (p); - switch (ret) { - case DB_LOCK_NOTGRANTED: - return COB_STATUS_61_FILE_SHARING; - case ENOENT: - if (mode == COB_OPEN_EXTEND - || mode == COB_OPEN_OUTPUT) { - return COB_STATUS_35_NOT_EXISTS; - } - if (f->flag_optional) { - if (mode == COB_OPEN_I_O) { - return COB_STATUS_30_PERMANENT_ERROR; - } - f->open_mode = (unsigned char)mode; - f->flag_nonexistent = 1; - f->flag_end_of_file = 1; - f->flag_begin_of_file = 1; - /* RXWRXW - Check directory exists? */ - return COB_STATUS_05_SUCCESS_OPTIONAL; - } - return COB_STATUS_35_NOT_EXISTS; - default: - return COB_STATUS_30_PERMANENT_ERROR; - } - - } - - p->last_readkey[i] = cob_malloc (maxsize); - p->last_readkey[f->nkeys + i] = cob_malloc (maxsize); - } - - p->temp_key = cob_malloc (maxsize + sizeof (unsigned long)); - p->savekey = cob_malloc (maxsize + sizeof (unsigned long)); - p->suppkey = cob_malloc (maxsize + sizeof (unsigned long)); - p->saverec = cob_malloc (f->record_max + sizeof (unsigned long)); - f->file = p; - p->key_index = 0; - p->last_key = NULL; - - memset ((void *)&p->key, 0, sizeof (DBT)); - memset ((void *)&p->data, 0, sizeof (DBT)); - p->filename = cob_malloc (strlen (filename) + 1); - strcpy (p->filename, filename); - p->write_cursor_open = 0; - if (bdb_env != NULL) { - bdb_env->lock_id (bdb_env, &p->bdb_lock_id); - } - - bdb_setkey(f, 0); - p->db[0]->cursor (p->db[0], NULL, &p->cursor[0], 0); - ret = DB_SEQ (p->cursor[0], DB_FIRST); - bdb_close_cursor (f); - if (!ret) { - memcpy (p->last_readkey[0], p->key.data, (size_t)p->key.size); - if (p->data.data != NULL - && p->data.size > 0 - && p->data.size > f->record_max) { - return COB_STATUS_39_CONFLICT_ATTRIBUTE; - } - } else { - p->data.data = NULL; - } - - f->open_mode = (unsigned char)mode; - if (f->flag_optional - && nonexistent - && mode != COB_OPEN_OUTPUT) { - return COB_STATUS_05_SUCCESS_OPTIONAL; - } - return 0; -} - -/* Close the INDEXED file */ - -static int -ix_bdb_close (cob_file_api *a, cob_file *f, const int opt) -{ - struct indexed_file *p; - int i; - - COB_UNUSED (a); - COB_UNUSED (opt); - - p = f->file; - if (bdb_env != NULL) { - bdb_unlock_all (f); - if (p->file_lock_set) { - bdb_env->lock_put (bdb_env, &p->bdb_file_lock); - p->file_lock_set = 0; - } - } - if (!bdb_err_tear_down) { - /* Close DB's */ - for (i = 0; i < (int)f->nkeys; ++i) { - if (p->cursor[i]) { - bdb_close_index (f, i); - } - } - } - for (i = (int)f->nkeys - 1; i >= 0; --i) { - if (p->db[i] && !bdb_err_tear_down) { - DB_CLOSE (p->db[i]); - } - cob_free (p->last_readkey[i]); - cob_free (p->last_readkey[f->nkeys + i]); - } - - if (p->last_key) { - cob_free (p->last_key); - } - cob_free (p->temp_key); - cob_free (p->savekey); - cob_free (p->suppkey); - cob_free (p->saverec); - cob_free (p->db); - cob_free (p->last_readkey); - cob_free (p->last_dupno); - cob_free (p->rewrite_sec_key); - cob_free (p->filename); - cob_free (p->cursor); - if (p->bdb_locks) - cob_free (p->bdb_locks); - if (bdb_env != NULL) { - bdb_env->lock_id_free (bdb_env, p->bdb_lock_id); - } - cob_free (p); - - return COB_STATUS_00_SUCCESS; -} - - -/* START INDEXED file with positioning */ - -static int -ix_bdb_start (cob_file_api *a, cob_file *f, const int cond, cob_field *key) -{ - COB_UNUSED (a); - - return ix_bdb_start_internal (f, cond, key, 0, 0); -} - -/* Random READ of the INDEXED file */ - -static int -ix_bdb_read (cob_file_api *a, cob_file *f, cob_field *key, const int read_opts) -{ - struct indexed_file *p; - int ret; - int bdb_opts; - int test_lock; - - COB_UNUSED (a); - p = f->file; - test_lock = 0; - bdb_opts = read_opts; - if (bdb_env != NULL) { - if (read_opts & COB_READ_LOCK) { - bdb_opts |= COB_READ_LOCK; - } else if (read_opts & COB_READ_WAIT_LOCK) { - if (f->retry_mode == 0 - || (f->retry_mode & COB_RETRY_FOREVER)) { - bdb_opts |= COB_READ_LOCK; - } else { - bdb_opts |= COB_READ_LOCK; - } - } else if ((f->lock_mode & COB_LOCK_AUTOMATIC) - && (f->open_mode != COB_OPEN_INPUT) ) { - bdb_opts |= COB_READ_LOCK; - } - if ((bdb_opts & COB_READ_IGNORE_LOCK) - || (bdb_opts & COB_READ_NO_LOCK) ) { - bdb_opts &= ~COB_READ_LOCK; - } - if (f->open_mode != COB_OPEN_I_O - || f->flag_file_lock) { - bdb_opts &= ~COB_READ_LOCK; - } else if ((f->lock_mode & COB_LOCK_AUTOMATIC) - && !(bdb_opts & COB_READ_NO_LOCK)) { - bdb_opts |= COB_READ_LOCK; - } - if ((bdb_opts & COB_READ_LOCK) - && !(f->lock_mode & COB_LOCK_MULTIPLE)) { - bdb_unlock_all (f); - } - test_lock = 1; - } else { - bdb_opts &= ~COB_READ_LOCK; - } - - ret = ix_bdb_start_internal (f, COB_EQ, key, bdb_opts, test_lock); - if (ret != COB_STATUS_00_SUCCESS) { - return ret; - } - - f->record->size = p->data.size; - if (f->record->size > f->record_max) { - f->record->size = f->record_max; - ret = COB_STATUS_43_READ_NOT_DONE; - } else { - ret = COB_STATUS_00_SUCCESS; - } - memcpy (f->record->data, p->data.data, f->record->size); - - return ret; -} - -/* Sequential READ of the INDEXED file */ - -static int -ix_bdb_read_next (cob_file_api *a, cob_file *f, const int read_opts) -{ - struct indexed_file *p; - int ret; - int read_nextprev,skip_lock; - cob_u32_t nextprev; - int file_changed; - int bdb_opts; - unsigned int dupno; - - COB_UNUSED (a); - p = f->file; - nextprev = DB_NEXT; - dupno = 0; - file_changed = 0; - - bdb_opts = read_opts; - skip_lock = 0; - if (bdb_env != NULL) { - if (f->open_mode != COB_OPEN_I_O - || f->flag_file_lock) { - bdb_opts &= ~COB_READ_LOCK; - } else if ((f->lock_mode & COB_LOCK_AUTOMATIC) - && !(bdb_opts & COB_READ_NO_LOCK)) { - bdb_opts |= COB_READ_LOCK; - } - if ((f->retry_mode & COB_ADVANCING_LOCK) - || (read_opts & COB_READ_ADVANCING_LOCK)) { - bdb_opts |= COB_READ_LOCK; - skip_lock = 1; - } else if (read_opts & COB_READ_LOCK) { - bdb_opts |= COB_READ_LOCK; - } else if (read_opts & COB_READ_WAIT_LOCK) { - bdb_opts |= COB_READ_LOCK; - } else if ((f->lock_mode & COB_LOCK_AUTOMATIC) - && f->open_mode != COB_OPEN_INPUT) { - if ((read_opts & COB_READ_IGNORE_LOCK)) { - bdb_opts &= ~COB_READ_LOCK; - } else { - bdb_opts |= COB_READ_LOCK; - } - } - if ((bdb_opts & COB_READ_LOCK) - && !(f->lock_mode & COB_LOCK_MULTIPLE)) { - bdb_unlock_all (f); - } - } else { - bdb_opts &= ~COB_READ_LOCK; - } - - if (unlikely (bdb_opts & COB_READ_PREVIOUS)) { - if (f->flag_end_of_file) { - nextprev = DB_LAST; - } else { - nextprev = DB_PREV; - } - } else if (f->flag_begin_of_file) { - nextprev = DB_FIRST; - } - /* The open cursor makes this function atomic */ - if (p->key_index != 0) { - p->db[0]->cursor (p->db[0], NULL, &p->cursor[0], 0); - } - p->db[p->key_index]->cursor (p->db[p->key_index], NULL, &p->cursor[p->key_index], 0); - - if (f->flag_first_read) { - /* Data is read in ix_bdb_open or ix_bdb_start */ - if (p->data.data == NULL - || (f->flag_first_read == 2 && nextprev == DB_PREV)) { - bdb_close_index (f, p->key_index); - if (p->key_index != 0) { - bdb_close_cursor (f); - } - return COB_STATUS_10_END_OF_FILE; - } - /* Check if previously read data still exists */ - p->key.size = (cob_dbtsize_t) db_keylen(f,p->key_index); - p->key.data = p->last_readkey[p->key_index]; - ret = DB_SEQ (p->cursor[p->key_index], DB_SET); - if (!ret && p->key_index > 0) { - if (f->keys[p->key_index].tf_duplicates) { - memcpy (&dupno, (cob_u8_ptr)p->data.data + p->primekeylen, sizeof (unsigned int)); - dupno = COB_DUPSWAP (dupno); - while (ret == 0 - && memcmp (p->key.data, p->last_readkey[p->key_index], (size_t)p->key.size) == 0 - && dupno < p->last_dupno[p->key_index]) { - ret = DB_SEQ (p->cursor[p->key_index], DB_NEXT); - memcpy (&dupno, (cob_u8_ptr)p->data.data + p->primekeylen, sizeof (unsigned int)); - dupno = COB_DUPSWAP (dupno); - } - if (ret == 0 - && memcmp (p->key.data, p->last_readkey[p->key_index], (size_t)p->key.size) == 0 - && dupno == p->last_dupno[p->key_index]) { - ret = memcmp (p->last_readkey[p->key_index + f->nkeys], p->data.data, p->primekeylen); - } else { - ret = 1; - } - } else { - ret = memcmp (p->last_readkey[p->key_index + f->nkeys], p->data.data, p->primekeylen); - } - if (!ret) { - p->key.size = (cob_dbtsize_t) p->primekeylen; - p->key.data = p->last_readkey[p->key_index + f->nkeys]; - ret = DB_GET (p->db[0], 0); - } - } - file_changed = ret; - if (bdb_env != NULL && !file_changed) { - if (skip_lock - && !(bdb_opts & COB_READ_IGNORE_LOCK) - && !(bdb_opts & COB_READ_LOCK)) { - ret = bdb_test_lock_advance (f, nextprev, skip_lock); - if (ret) { - bdb_close_index (f, p->key_index); - bdb_close_cursor (f); - return ret; - } - } - if (bdb_opts & COB_READ_LOCK) { - ret = bdb_lock_advance (f, nextprev, skip_lock); - if (ret) { - bdb_close_index (f, p->key_index); - bdb_close_cursor (f); - if (ret == DB_NOTFOUND) - return COB_STATUS_10_END_OF_FILE; - return COB_STATUS_51_RECORD_LOCKED; - } - } - } - } - if (!f->flag_first_read || file_changed) { - if (nextprev == DB_FIRST || nextprev == DB_LAST) { - read_nextprev = 1; - } else { - p->key.size = (cob_dbtsize_t) db_keylen(f,p->key_index); - p->key.data = p->last_readkey[p->key_index]; - ret = DB_SEQ (p->cursor[p->key_index], DB_SET_RANGE); - /* ret != 0 possible, records may be deleted since last read */ - if (ret != 0) { - if (nextprev == DB_PREV) { - nextprev = DB_LAST; - read_nextprev = 1; - } else { - bdb_close_index (f, p->key_index); - if (p->key_index != 0) { - bdb_close_cursor (f); - } - return COB_STATUS_10_END_OF_FILE; - } - } else { - if (memcmp (p->key.data, p->last_readkey[p->key_index], (size_t)p->key.size) == 0) { - if (p->key_index > 0 && f->keys[p->key_index].tf_duplicates) { - memcpy (&dupno, (cob_u8_ptr)p->data.data + p->primekeylen, sizeof (unsigned int)); - dupno = COB_DUPSWAP (dupno); - while (ret == 0 - && memcmp (p->key.data, p->last_readkey[p->key_index], (size_t)p->key.size) == 0 - && dupno < p->last_dupno[p->key_index]) { - ret = DB_SEQ (p->cursor[p->key_index], DB_NEXT); - memcpy (&dupno, (cob_u8_ptr)p->data.data + p->primekeylen, sizeof (unsigned int)); - dupno = COB_DUPSWAP (dupno); - } - if (ret != 0) { - if (nextprev == DB_PREV) { - nextprev = DB_LAST; - read_nextprev = 1; - } else { - bdb_close_index (f, p->key_index); - if (p->key_index != 0) { - bdb_close_cursor (f); - } - return COB_STATUS_10_END_OF_FILE; - } - } else { - if (memcmp (p->key.data, p->last_readkey[p->key_index], (size_t)p->key.size) == 0 && - dupno == p->last_dupno[p->key_index]) { - read_nextprev = 1; - } else { - if (nextprev == DB_PREV) { - read_nextprev = 1; - } else { - read_nextprev = 0; - } - } - } - } else { - read_nextprev = 1; - } - } else { - if (nextprev == DB_PREV) { - read_nextprev = 1; - } else { - read_nextprev = 0; - } - } - } - } - if (read_nextprev) { - ret = DB_SEQ (p->cursor[p->key_index], nextprev); - if (ret != 0) { - bdb_close_index (f, p->key_index); - if (p->key_index != 0) { - bdb_close_cursor (f); - } - return COB_STATUS_10_END_OF_FILE; - } - } - - if (p->key_index > 0) { - /* Temporarily save alternate key */ - memcpy (p->temp_key, p->key.data, (size_t)p->key.size); - if (f->keys[p->key_index].tf_duplicates) { - memcpy (&dupno, (cob_u8_ptr)p->data.data + p->primekeylen, sizeof (unsigned int)); - dupno = COB_DUPSWAP (dupno); - } - p->key.data = p->data.data; - p->key.size = p->primekeylen; - ret = DB_GET (p->db[0], 0); - if (ret != 0) { - bdb_close_index (f, p->key_index); - bdb_close_cursor (f); - return COB_STATUS_23_KEY_NOT_EXISTS; - } - } - if (bdb_env != NULL) { - if (skip_lock - && !(bdb_opts & COB_READ_IGNORE_LOCK)) { - ret = bdb_test_lock_advance (f, nextprev, skip_lock); - if (ret) { - bdb_close_index (f, p->key_index); - bdb_close_cursor (f); - return ret; - } - } - if (bdb_opts & COB_READ_LOCK) { - ret = bdb_lock_advance (f, nextprev, skip_lock); - if (ret != 0) { - bdb_close_index (f, p->key_index); - bdb_close_cursor (f); - if (ret == DB_NOTFOUND) - return COB_STATUS_10_END_OF_FILE; - return COB_STATUS_51_RECORD_LOCKED; - } - } - } - if (p->key_index == 0) { - memcpy (p->last_readkey[0], p->key.data, (size_t)p->key.size); - } else { - memcpy (p->last_readkey[p->key_index], p->temp_key, - db_keylen(f,p->key_index)); - memcpy (p->last_readkey[p->key_index + f->nkeys], p->key.data, p->primekeylen); - if (f->keys[p->key_index].tf_duplicates) { - p->last_dupno[p->key_index] = dupno; - } - } - } - - bdb_close_index (f, p->key_index); - if (p->key_index != 0) { - bdb_close_cursor (f); - } - - f->record->size = p->data.size; - if (f->record->size > f->record_max) { - f->record->size = f->record_max; - ret = COB_STATUS_43_READ_NOT_DONE; - } else { - ret = COB_STATUS_00_SUCCESS; - } - memcpy (f->record->data, p->data.data, f->record->size); - - return ret; -} - - -/* WRITE to the INDEXED file */ - -static int -ix_bdb_write (cob_file_api *a, cob_file *f, const int opt) -{ - struct indexed_file *p; - int ret; - - COB_UNUSED (a); - if (f->flag_nonexistent) { - return COB_STATUS_48_OUTPUT_DENIED; - } - p = f->file; - if (!(f->lock_mode & COB_LOCK_MULTIPLE)) { - bdb_unlock_all (f); - } - - /* Check record key */ - bdb_setkey (f, 0); - if (!p->last_key) { - p->last_key = cob_malloc ((size_t)p->maxkeylen); - } else if (f->access_mode == COB_ACCESS_SEQUENTIAL - && f->open_mode == COB_OPEN_OUTPUT - && !f->flag_set_isam - && memcmp (p->last_key, p->key.data, (size_t)p->key.size) > 0) { - return COB_STATUS_21_KEY_INVALID; - } - memcpy (p->last_key, p->key.data, (size_t)p->key.size); - - ret = ix_bdb_write_internal (f, 0, opt); - bdb_close_cursor (f); - return ret; -} - - -/* DELETE record from the INDEXED file */ - -static int -ix_bdb_delete (cob_file_api *a, cob_file *f) -{ - int ret; - - COB_UNUSED (a); - if (f->flag_nonexistent) { - return COB_STATUS_49_I_O_DENIED; - } - ret = ix_bdb_delete_internal (f, 0, 0); - bdb_close_cursor (f); - return ret; -} - -/* REWRITE record to the INDEXED file */ - -static int -ix_bdb_rewrite (cob_file_api *a, cob_file *f, const int opt) -{ - int ret; - - COB_UNUSED (a); - if (f->flag_nonexistent) { - return COB_STATUS_49_I_O_DENIED; - } - if (!(f->lock_mode & COB_LOCK_MULTIPLE)) { - bdb_unlock_all (f); - } - - /* Check duplicate alternate keys */ - if (check_alt_keys (f, 1)) { - return COB_STATUS_22_KEY_EXISTS; - } - - /* Delete the current record */ - ret = ix_bdb_delete_internal (f, 1, opt); - - if (ret != COB_STATUS_00_SUCCESS) { - bdb_close_cursor (f); - return ret; - } - - /* Write data */ - bdb_setkey(f, 0); - ret = ix_bdb_write_internal (f, 1, opt); - bdb_close_cursor (f); - - if (ret == COB_STATUS_00_SUCCESS - || ret == COB_STATUS_02_SUCCESS_DUPLICATE) { - if ((f->lock_mode & COB_LOCK_AUTOMATIC)) { - if (!(f->lock_mode & COB_LOCK_MULTIPLE)) { - bdb_unlock_all (f); - } - } else { - if (!(f->lock_mode & COB_LOCK_MULTIPLE)) { - if (!(opt & COB_WRITE_LOCK)) { - bdb_unlock_all (f); - } - } else - if ((opt & COB_WRITE_LOCK)) { - bdb_unlock_last (f); - } else - if ((opt & COB_WRITE_NO_LOCK)) { - bdb_unlock_all (f); - } - } - } else if (ret) { - bdb_unlock_all (f); - } - return ret; -} - - -static int -ix_bdb_file_unlock (cob_file_api *a, cob_file *f) -{ - COB_UNUSED (a); - if (COB_FILE_SPECIAL(f)) { - return 0; - } - if (f->organization == COB_ORG_SORT) { - return 0; - } - - if (f->open_mode != COB_OPEN_CLOSED - && f->open_mode != COB_OPEN_LOCKED) { - if (f->file) { - if (bdb_env != NULL && f->file) { - struct indexed_file *p = f->file; - bdb_unlock_all (f); - if(p->file_lock_set) { - bdb_env->lock_put (bdb_env, &p->bdb_file_lock); - p->file_lock_set = 0; - } - bdb_env->lock_put (bdb_env, &p->bdb_file_lock); - } - } - } - return 0; -} - -/* Call this routine when a new process has been forked */ -static int -ix_bdb_fork (cob_file_api *a) -{ - COB_UNUSED (a); - bdb_lock_id = 0; - if(bdb_env) { - bdb_env->lock_id (bdb_env, &bdb_lock_id); - bdb_env->set_lk_detect (bdb_env, DB_LOCK_DEFAULT); - } - return 0; -} - -static void -ix_bdb_exit_fileio (cob_file_api *a) -{ - COB_UNUSED (a); - if(record_lock_object) { - cob_free (record_lock_object); - record_lock_object = NULL; - } - if (bdb_env) { - DB_LOCKREQ lckreq[1]; - memset(lckreq,0,sizeof(DB_LOCKREQ)); - lckreq[0].op = DB_LOCK_PUT_ALL; - bdb_env->lock_vec (bdb_env, bdb_lock_id, 0, lckreq, 1, NULL); - bdb_env->lock_id_free (bdb_env, bdb_lock_id); - bdb_env->close (bdb_env, 0); - if (bdb_home_dir != NULL - && db_env_create (&bdb_env, 0) == 0) { - bdb_env->remove (bdb_env, bdb_home_dir, 0); - } - if(bdb_home_dir) - cob_free(bdb_home_dir); - bdb_home_dir = NULL; - bdb_env = NULL; - } - if (record_lock_object) { - cob_free (record_lock_object); - record_lock_object = NULL; - rlo_size = 0; - } - if (bdb_buff) { - cob_free (bdb_buff); - bdb_buff = NULL; - } -} - -void -cob_bdb_init_fileio (cob_file_api *a) -{ - a->io_funcs[COB_IO_BDB] = (void*)&ext_indexed_funcs; - bdb_env = NULL; - bdb_data_dir = NULL; - record_lock_object = cob_malloc ((size_t)1024); - bdb_buff = cob_malloc ((size_t)COB_SMALL_BUFF); - rlo_size = 1024; -} - -#endif diff -Nru gnucobol-4.0~early~20200606/libcob/fextfh.c gnucobol-5/libcob/fextfh.c --- gnucobol-4.0~early~20200606/libcob/fextfh.c 2020-06-06 20:52:01.000000000 +0000 +++ gnucobol-5/libcob/fextfh.c 1970-01-01 00:00:00.000000000 +0000 @@ -1,1349 +0,0 @@ -/* - Copyright (C) 2002-2012, 2014-2020 Free Software Foundation, Inc. - Written by Keisuke Nishida, Roger While, Simon Sobisch, Ron Norman - - This file is part of GnuCOBOL. - - The GnuCOBOL runtime library is free software: you can redistribute it - and/or modify it under the terms of the GNU Lesser General Public License - as published by the Free Software Foundation, either version 3 of the - License, or (at your option) any later version. - - GnuCOBOL is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU Lesser General Public License for more details. - - You should have received a copy of the GNU Lesser General Public License - along with GnuCOBOL. If not, see . -*/ - - -#include "fileio.h" - -/********************************************************************************/ -/* Following routines are for the External File Handler interface commonly used */ -/********************************************************************************/ -static struct fcd_file { - struct fcd_file *next; - FCD3 *fcd; - cob_file *f; - int sts; - int free_fcd; -} *fcd_file_list = NULL; -static const cob_field_attr alnum_attr = {COB_TYPE_ALPHANUMERIC, 0, 0, 0, NULL}; - -/* - * Free up allocated memory - */ -void -free_extfh_fcd (void) -{ - struct fcd_file *ff,*nff; - - for(ff = fcd_file_list; ff; ff = nff) { - nff = ff->next; - if (ff->free_fcd) { - if (ff->fcd->fnamePtr != NULL) - cob_cache_free ((void*)(ff->fcd->fnamePtr)); - cob_cache_free((void*)ff->fcd); - } else { - cob_cache_free((void*)ff->f); - } - cob_cache_free((void*)ff); - } -} - -/* - * Update FCD from cob_file - */ -static void -update_file_to_fcd (cob_file *f, FCD3 *fcd, unsigned char *fnstatus) -{ - if (f->file_status) - memcpy (fcd->fileStatus,f->file_status,2); - else if (fnstatus) - memcpy (fcd->fileStatus, fnstatus, 2); - else - memcpy (fcd->fileStatus,"00",2); - if (f->open_mode == COB_OPEN_CLOSED) - fcd->openMode = OPEN_NOT_OPEN; - else if( f->open_mode == COB_OPEN_INPUT) - fcd->openMode = OPEN_INPUT; - else if (f->open_mode == COB_OPEN_OUTPUT) - fcd->openMode = OPEN_OUTPUT; - else if (f->open_mode == COB_OPEN_I_O) - fcd->openMode = OPEN_IO; - else if (f->open_mode == COB_OPEN_EXTEND) - fcd->openMode = OPEN_EXTEND; - STCOMPX4(f->record_min,fcd->minRecLen); - STCOMPX4(f->record->size,fcd->curRecLen); - STCOMPX4(f->record_max,fcd->maxRecLen); - if (f->record_min == f->record_max) - fcd->recordMode = REC_MODE_FIXED; - else - fcd->recordMode = REC_MODE_VARIABLE; - if(f->organization == COB_ORG_LINE_SEQUENTIAL) { - fcd->fileOrg = ORG_LINE_SEQ; - STCOMPX2(0, fcd->refKey); - if((f->file_features & COB_FILE_LS_CRLF)) - fcd->fstatusType |= MF_FST_CRdelim; - if((f->file_features & COB_FILE_LS_NULLS)) - fcd->fstatusType |= MF_FST_InsertNulls; - if((f->file_features & COB_FILE_LS_FIXED)) - fcd->fstatusType |= MF_FST_NoStripSpaces; - } - if (f->organization == COB_ORG_INDEXED) { - fcd->fileOrg = ORG_INDEXED; - fcd->fileFormat = MF_FF_CISAM; - if (f->io_routine == COB_IO_VBISAM) - fcd->fileFormat = MF_FF_VBISAM; -#ifdef WITH_DISAM - else if (f->io_routine == COB_IO_DISAM) - fcd->fileFormat = MF_FF_DISAM; -#endif -#ifdef WITH_DB - else if (f->io_routine == COB_IO_BDB) - fcd->fileFormat = MF_FF_BDB; -#endif -#ifdef WITH_LMDB - else if (f->io_routine == COB_IO_LMDB) - fcd->fileFormat = MF_FF_LMDB; -#endif - } -} - -/* - * Copy 'cob_file' to FCD based information - */ -static void -copy_file_to_fcd (cob_file *f, FCD3 *fcd) -{ - char assignto[512]; - unsigned int fnlen,kdblen,idx,keypos,keycomp,k,nkeys; - KDB *kdb; - EXTKEY *key; - - if(f->access_mode == COB_ACCESS_SEQUENTIAL) - fcd->accessFlags = ACCESS_SEQ; - else if (f->access_mode == COB_ACCESS_RANDOM) - fcd->accessFlags = ACCESS_RANDOM; - else if (f->access_mode == COB_ACCESS_DYNAMIC) - fcd->accessFlags = ACCESS_DYNAMIC; - if (f->flag_select_features & COB_SELECT_EXTERNAL) - fcd->otherFlags |= OTH_EXTERNAL; - if (f->flag_optional) - fcd->otherFlags |= OTH_OPTIONAL; - if (f->flag_line_adv) - fcd->otherFlags |= OTH_LINE_ADVANCE; - - if (f->assign) { - cob_field_to_string (f->assign, assignto, sizeof(assignto)-1); - } else { - strncpy (assignto, f->select_name, sizeof(assignto)-1); - assignto[sizeof(assignto)-1] = 0; - } - STCOMPX2(sizeof(FCD3),fcd->fcdLen); - fcd->fcdVer = FCD_VER_64Bit; - fcd->gcFlags |= MF_CALLFH_GNUCOBOL; - if (f->trace_io) - fcd->gcFlags |= MF_CALLFH_TRACE; - else - fcd->gcFlags &= ~MF_CALLFH_TRACE; - if (f->io_stats) - fcd->gcFlags |= MF_CALLFH_STATS; - else - fcd->gcFlags &= ~MF_CALLFH_STATS; - if (f->record_min != f->record_max) { - fcd->recordMode = REC_MODE_VARIABLE; - } else { - fcd->recordMode = REC_MODE_FIXED; - } - fnlen = strlen(assignto); - if (fcd->fnamePtr == NULL) { - fcd->fnamePtr = cob_strdup(assignto); - STCOMPX2(fnlen, fcd->fnameLen); - } else if (f->fcd != fcd) { - cob_cache_free ((void*)fcd->fnamePtr); - fcd->fnamePtr = cob_strdup(assignto); - STCOMPX2(fnlen, fcd->fnameLen); - } - fcd->openMode |= OPEN_NOT_OPEN; - STCOMPX2(0, fcd->refKey); - if((f->lock_mode & COB_LOCK_EXCLUSIVE) - || (f->lock_mode & COB_LOCK_OPEN_EXCLUSIVE)) - fcd->lockMode = FCD_LOCK_EXCL_LOCK; - else if(f->lock_mode == COB_LOCK_MANUAL) - fcd->lockMode = FCD_LOCK_MANU_LOCK; - else if(f->lock_mode == COB_LOCK_AUTOMATIC) - fcd->lockMode = FCD_LOCK_AUTO_LOCK; - fcd->recPtr = f->record->data; - if (f->organization == COB_ORG_INDEXED) { - STCOMPX2(0, fcd->refKey); - fcd->fileOrg = ORG_INDEXED; - fcd->fileFormat = MF_FF_CISAM; - /* Copy Key information from cob_file to FCD */ - for (idx=keycomp=0; idx < f->nkeys; idx++) { - if (f->keys[idx].count_components <= 1) { - keycomp++; - } else { - keycomp += f->keys[idx].count_components; - } - } - if (fcd->kdbPtr == NULL - && f->nkeys > 0) { - nkeys = f->nkeys < 16 ? 16 : f->nkeys; - kdblen = sizeof(KDB) - sizeof(kdb->key) + (sizeof(KDB_KEY) * nkeys) + (sizeof(EXTKEY) * keycomp); - nkeys = f->nkeys; - fcd->kdbPtr = kdb = cob_cache_malloc(kdblen + sizeof(EXTKEY)); - STCOMPX2(kdblen, kdb->kdbLen); - STCOMPX2(nkeys, kdb->nkeys); - } else if (fcd->kdbPtr == NULL) { - nkeys = 16; - kdblen = sizeof(KDB) - sizeof(kdb->key) + (sizeof(KDB_KEY) * nkeys) + (sizeof(EXTKEY) * keycomp); - nkeys = 0; - fcd->kdbPtr = kdb = cob_cache_malloc(kdblen + sizeof(EXTKEY)); - STCOMPX2(kdblen, kdb->kdbLen); - STCOMPX2(nkeys, kdb->nkeys); - } else { - kdb = fcd->kdbPtr; - nkeys = LDCOMPX2(kdb->nkeys); - if (nkeys > f->nkeys) { - nkeys = f->nkeys; - } - } - keypos = (sizeof(KDB_KEY) * nkeys) + sizeof(KDB) - sizeof(kdb->key); - for(idx=0; idx < nkeys; idx++) { - key = (EXTKEY*)((char*)((char*)kdb) + keypos); - STCOMPX2(keypos, kdb->key[idx].offset); - kdb->key[idx].keyFlags = 0; - if(f->keys[idx].tf_duplicates) - kdb->key[idx].keyFlags |= KEY_DUPS; - if(f->keys[idx].tf_suppress) { - kdb->key[idx].keyFlags |= KEY_SPARSE; - kdb->key[idx].sparse = (unsigned char)f->keys[idx].char_suppress; - } - if(f->keys[idx].count_components <= 1) { - STCOMPX2(1,kdb->key[idx].count); - STCOMPX4(f->keys[idx].offset, key->pos); - STCOMPX4(f->keys[idx].field->size, key->len); - keypos = keypos + sizeof(EXTKEY); - } else { - STCOMPX2(f->keys[idx].count_components, kdb->key[idx].count); - for(k=0; k < (int)f->keys[idx].count_components; k++) { - key = (EXTKEY*)((char*)((char*)kdb) + keypos); - STCOMPX4(f->keys[idx].component[k]->data - f->record->data, key->pos); - STCOMPX4(f->keys[idx].component[k]->size, key->len); - keypos = keypos + sizeof(EXTKEY); - } - } - } - - } else if(f->organization == COB_ORG_SEQUENTIAL) { - fcd->fileOrg = ORG_SEQ; - STCOMPX2(0, fcd->refKey); - } else if(f->organization == COB_ORG_LINE_SEQUENTIAL) { - fcd->fileOrg = ORG_LINE_SEQ; - STCOMPX2(0, fcd->refKey); - if((f->file_features & COB_FILE_LS_CRLF)) - fcd->fstatusType |= MF_FST_CRdelim; - if((f->file_features & COB_FILE_LS_NULLS)) - fcd->fstatusType |= MF_FST_InsertNulls; - if((f->file_features & COB_FILE_LS_FIXED)) - fcd->fstatusType |= MF_FST_NoStripSpaces; - } else if(f->organization == COB_ORG_RELATIVE) { - fcd->fileOrg = ORG_RELATIVE; - STCOMPX2(0, fcd->refKey); - } - update_file_to_fcd(f, fcd, NULL); -} - -/* - * Update 'cob_file' from 'FCD' information - */ -static void -update_fcd_to_file (FCD3* fcd, cob_file *f, cob_field *fnstatus, int wasOpen) -{ - int status; - - if (wasOpen >= 0) { - cobglobptr->cob_error_file = f; - if (isdigit(fcd->fileStatus[0])) { - cob_set_exception (status_exception[(fcd->fileStatus[0] - '0')]); - } else { - cobglobptr->cob_exception_code = 0; - } - if (f->file_status) { - memcpy(f->file_status, fcd->fileStatus, 2); - } - if (fnstatus) { - memcpy(fnstatus->data, fcd->fileStatus, 2); - } - } - if (wasOpen > 0) { - if((fcd->openMode & OPEN_NOT_OPEN)) - f->open_mode = 0; - else if((fcd->openMode&0x7f) == OPEN_INPUT) - f->open_mode = COB_OPEN_INPUT; - else if((fcd->openMode&0x7f) == OPEN_OUTPUT) - f->open_mode = COB_OPEN_OUTPUT; - else if((fcd->openMode&0x7f) == OPEN_EXTEND) - f->open_mode = COB_OPEN_EXTEND; - else if((fcd->openMode&0x7f) == OPEN_IO) - f->open_mode = COB_OPEN_I_O; - } - f->record_min = LDCOMPX4(fcd->minRecLen); - f->record_max = LDCOMPX4(fcd->maxRecLen); - f->record->size = LDCOMPX4(fcd->curRecLen); - - if (fcd->gcFlags & MF_CALLFH_TRACE) - f->trace_io = 1; - else - f->trace_io = 0; - if (fcd->gcFlags & MF_CALLFH_STATS) - f->io_stats = 1; - else - f->io_stats = 0; - - if((fcd->lockMode & FCD_LOCK_EXCL_LOCK)) - f->lock_mode = COB_LOCK_EXCLUSIVE; - else if((fcd->lockMode & FCD_LOCK_MANU_LOCK)) - f->lock_mode = COB_LOCK_MANUAL; - else if((fcd->lockMode & FCD_LOCK_AUTO_LOCK)) - f->lock_mode = COB_LOCK_AUTOMATIC; - - if (wasOpen < 0) - return; - status = 0; - if(isdigit(fcd->fileStatus[0])) { - status = fcd->fileStatus[0] - '0'; - } - status = status * 10; - if(isdigit(fcd->fileStatus[1])) - status += (fcd->fileStatus[1] - '0'); - - /* Call save_status to get trace & stats done */ - cob_file_save_status (f, fnstatus, status); -} - -static void -copy_keys_fcd_to_file (FCD3 *fcd, cob_file *f) -{ - int k, p, parts, off; - EXTKEY *key; - for (k=0; k < (int)f->nkeys; k++) { - parts = LDCOMPX2(fcd->kdbPtr->key[k].count); - off = LDCOMPX2(fcd->kdbPtr->key[k].offset); - key = (EXTKEY*) ((char*)(fcd->kdbPtr) + off); - if (fcd->kdbPtr->key[k].keyFlags & KEY_SPARSE) { - f->keys[k].char_suppress = fcd->kdbPtr->key[k].sparse; - f->keys[k].tf_suppress = 1; - } else { - f->keys[k].tf_suppress = 0; - } - if (fcd->kdbPtr->key[k].keyFlags & KEY_DUPS) { - f->keys[k].tf_duplicates = 1; - } else { - f->keys[k].tf_duplicates = 0; - } - f->keys[k].count_components = (short)parts; - if (f->keys[k].offset == 0) - f->keys[k].offset = LDCOMPX4(key->pos); - if(f->keys[k].field == NULL - || f->keys[k].offset != LDCOMPX4(key->pos) - || (parts == 1 && f->keys[k].field->size != LDCOMPX4(key->len))) { - f->keys[k].field = cob_cache_malloc(sizeof(cob_field)); - f->keys[k].field->data = f->record->data + LDCOMPX4(key->pos); - f->keys[k].field->attr = &alnum_attr; - f->keys[k].field->size = LDCOMPX4(key->len); - f->keys[k].offset = LDCOMPX4(key->pos); - } - for (p=0; p < parts; p++) { - f->keys[k].component[p] = cob_cache_malloc(sizeof(cob_field)); - f->keys[k].component[p]->data = f->record->data + LDCOMPX4(key->pos); - f->keys[k].component[p]->attr = &alnum_attr; - f->keys[k].component[p]->size = LDCOMPX4(key->len); - key = (EXTKEY*) ((char*)(key) + sizeof(EXTKEY)); - } - } -} -/* - * Copy 'FCD' to 'cob_file' based information - */ -static void -copy_fcd_to_file (FCD3* fcd, cob_file *f) -{ - int k; - - if(fcd->accessFlags == ACCESS_SEQ) - f->access_mode = COB_ACCESS_SEQUENTIAL; - else if(fcd->accessFlags == ACCESS_RANDOM) - f->access_mode = COB_ACCESS_RANDOM; - else if(fcd->accessFlags == ACCESS_DYNAMIC) - f->access_mode = COB_ACCESS_DYNAMIC; - if((fcd->otherFlags & OTH_EXTERNAL)) - f->flag_select_features |= COB_SELECT_EXTERNAL; - if((fcd->otherFlags & OTH_OPTIONAL)) - f->flag_optional = 1; - else - f->flag_optional = 0; - if((fcd->otherFlags & OTH_LINE_ADVANCE)) - f->flag_line_adv = 1; - else - f->flag_line_adv = 0; - - if(fcd->fileOrg == ORG_INDEXED) { - f->organization = COB_ORG_INDEXED; - if (fcd->fileFormat == MF_FF_DEFAULT) { -#ifdef WITH_INDEXED - f->io_routine = WITH_INDEXED; -#elif WITH_CISAM - f->io_routine = COB_IO_CISAM; -#elif WITH_DISAM - f->io_routine = COB_IO_DISAM; -#elif WITH_VBISAM - f->io_routine = COB_IO_VBISAM; -#elif WITH_DB - f->io_routine = COB_IO_BDB; -#elif WITH_LMDB - f->io_routine = COB_IO_LMDB; -#endif - } else if (fcd->fileFormat == MF_FF_CISAM) - f->io_routine = COB_IO_CISAM; - else if (fcd->fileFormat == MF_FF_DISAM) - f->io_routine = COB_IO_DISAM; - else if (fcd->fileFormat == MF_FF_VBISAM) - f->io_routine = COB_IO_VBISAM; - else if (fcd->fileFormat == MF_FF_BDB) - f->io_routine = COB_IO_BDB; - else if (fcd->fileFormat == MF_FF_LMDB) - f->io_routine = COB_IO_LMDB; - } else if(fcd->fileOrg == ORG_SEQ) { - f->organization = COB_ORG_SEQUENTIAL; - } else if(fcd->fileOrg == ORG_LINE_SEQ) { - f->organization = COB_ORG_LINE_SEQUENTIAL; -#ifdef _WIN32 - if (file_setptr->cob_unix_lf && - !(fcd->fstatusType & MF_FST_CRdelim)) { - f->file_features |= COB_FILE_LS_LF; - } else { - f->file_features |= COB_FILE_LS_CRLF; - } -#else - if ((fcd->fstatusType & MF_FST_CRdelim)) { - f->file_features |= COB_FILE_LS_CRLF; - } else { - f->file_features |= COB_FILE_LS_LF; - } -#endif - if((fcd->fstatusType & MF_FST_InsertNulls)) - f->file_features |= COB_FILE_LS_NULLS; - if((fcd->fstatusType & MF_FST_NoStripSpaces)) - f->file_features |= COB_FILE_LS_FIXED; - } else if(fcd->fileOrg == ORG_RELATIVE) { - f->organization = COB_ORG_RELATIVE; - } else { - f->organization = COB_ORG_MAX; - } - - /* Allocate cob_file fields as needed and copy from FCD */ - if (f->record == NULL) { - f->record = cob_cache_malloc(sizeof(cob_field)); - f->record->data = fcd->recPtr; - f->record->size = LDCOMPX4(fcd->curRecLen); - f->record->attr = &alnum_attr; - f->record_min = LDCOMPX4(fcd->minRecLen); - f->record_max = LDCOMPX4(fcd->maxRecLen); - } -#if 0 - if (f->file_status == NULL) { - f->file_status = cob_cache_malloc( 6 ); - } -#endif - if (f->assign == NULL - || (f->fcd && fcd->fnamePtr)) { - f->assign = cob_cache_malloc(sizeof(cob_field)); - f->assign->data = (unsigned char*)fcd->fnamePtr; - f->assign->size = LDCOMPX2(fcd->fnameLen); - f->assign->attr = &alnum_attr; - } - if (f->select_name == NULL) { - char fdname[49]; - f->select_name = (char*)f->assign->data; - for (k=0; k < (int)(f->assign->size); k++) { - if (f->assign->data[k] == '/') { - f->select_name = (char*)&f->assign->data[k+1]; - } - } - for (k=0; f->select_name[k] > ' ' && k < 48; k++) { - fdname[k] = (char)toupper((int)f->select_name[k]); - } - fdname[k] = 0; - f->select_name = cob_strdup (fdname); - } - if (f->keys == NULL) { - if (fcd->kdbPtr != NULL - && LDCOMPX2(fcd->kdbPtr->nkeys) > 0) { - /* Copy Key information from FCD to cob_file */ - f->nkeys = LDCOMPX2(fcd->kdbPtr->nkeys); - if (f->nkeys > MAX_FILE_KEYS) { - /* CHECKME - Should this result in any error handling? */ - cob_runtime_warning (_("maximum keys (%d/%d) exceeded for file '%s'"), - (int)f->nkeys, MAX_FILE_KEYS, cob_get_filename_print (f->file, 0)); - f->nkeys = MAX_FILE_KEYS; - } - f->keys = cob_cache_malloc (sizeof(cob_file_key) * f->nkeys); - copy_keys_fcd_to_file (fcd, f); - } else { - f->keys = cob_cache_malloc(sizeof(cob_file_key)); - } - } else if (f->nkeys > 0 - && fcd->kdbPtr != NULL - && LDCOMPX2(fcd->kdbPtr->nkeys) >= (int)f->nkeys) { - copy_keys_fcd_to_file (fcd, f); - } - update_fcd_to_file (fcd, f, NULL, 0); -} - -/* - * Construct FCD based on information from 'cob_file' - */ -static FCD3 * -find_fcd (cob_file *f) -{ - FCD3 *fcd; - struct fcd_file *ff; - for(ff = fcd_file_list; ff; ff=ff->next) { - if(ff->f == f) - return ff->fcd; - } - fcd = cob_cache_malloc(sizeof(FCD3)); - copy_file_to_fcd(f, fcd); - ff = cob_cache_malloc(sizeof(struct fcd_file)); - ff->next = fcd_file_list; - ff->fcd = fcd; - ff->f = f; - ff->free_fcd = 1; - fcd_file_list = ff; - return fcd; -} - -/* - * Construct cob_file based on information from 'FCD' - */ -static cob_file * -find_file (FCD3 *fcd) -{ - cob_file *f; - struct fcd_file *ff; - for (ff = fcd_file_list; ff; ff=ff->next) { - if (ff->fcd == fcd) { - return ff->f; - } - } - f = cob_cache_malloc (sizeof(cob_file)); - f->file_version = COB_FILE_VERSION; - copy_fcd_to_file (fcd, f); - ff = cob_cache_malloc (sizeof(struct fcd_file)); - ff->next = fcd_file_list; - ff->fcd = fcd; - ff->f = f; - ff->free_fcd = 0; - fcd_file_list = ff; - return f; -} - - -static void -save_fcd_status (FCD3 *fcd, int sts) -{ - struct fcd_file *ff; - for(ff = fcd_file_list; ff; ff=ff->next) { - if(ff->fcd == fcd) { - ff->sts = sts; - return; - } - } -} - -/* - * NOTES: It would be best if 'cob_file' had a pointer to the full/complete file name - * ISAM & BDB already keep this in a separate structure - * The filename should be passed via EXTFH interface - */ - -/* - * OPEN file - */ -void -cob_extfh_open ( - int (*callfh)(unsigned char *opcode, FCD3 *fcd), - cob_file *f, const int mode, const int sharing, cob_field *fnstatus) -{ - unsigned char opcode[2]; - FCD3 *fcd; - int sts; - - f->last_operation = COB_LAST_OPEN; - fcd = find_fcd(f); - f->share_mode = (unsigned char)sharing; - f->last_open_mode = (unsigned char)mode; - if(mode == COB_OPEN_OUTPUT) - STCOMPX2(OP_OPEN_OUTPUT, opcode); - else if(mode == COB_OPEN_I_O) - STCOMPX2(OP_OPEN_IO, opcode); - else if(mode == COB_OPEN_EXTEND) - STCOMPX2(OP_OPEN_EXTEND, opcode); - else - STCOMPX2(OP_OPEN_INPUT, opcode); - - /* Keep table of 'fcd' created */ - sts = callfh (opcode, fcd); - if (f->file_status) { - if (memcmp(f->file_status,"00",2) == 0 - || memcmp(f->file_status,"05",2) == 0) { - fcd->openMode &= ~OPEN_NOT_OPEN; - } - } else { - fcd->openMode &= ~OPEN_NOT_OPEN; - } - update_fcd_to_file (fcd, f, fnstatus, 1); - save_fcd_status (fcd, sts); -} - -/* - * CLOSE file - */ -void -cob_extfh_close ( - int (*callfh)(unsigned char *opcode, FCD3 *fcd), - cob_file *f, cob_field *fnstatus, const int opt, const int remfil) -{ - unsigned char opcode[2]; - FCD3 *fcd; - struct fcd_file *ff,*pff; - - COB_UNUSED (remfil); - - f->last_operation = COB_LAST_CLOSE; - fcd = find_fcd(f); - STCOMPX4(opt, fcd->opt); - STCOMPX2(OP_CLOSE, opcode); - - /* Keep table of 'fcd' created */ - (void)callfh (opcode, fcd); - update_fcd_to_file (fcd, f, fnstatus, 0); - - pff = NULL; - for(ff = fcd_file_list; ff; ff=ff->next) { - if(ff->fcd == fcd) { - if(pff) - pff->next = ff->next; - else - fcd_file_list = ff->next; - if (ff->free_fcd) { - if (ff->fcd->fnamePtr != NULL) - cob_cache_free ((void*)(ff->fcd->fnamePtr)); - cob_cache_free((void*)ff->fcd); - } else { - cob_cache_free((void*)ff->f); - } - cob_cache_free((void*)ff); - break; - } - pff = ff; - } -} - -/* - * START - */ -void -cob_extfh_start ( - int (*callfh)(unsigned char *opcode, FCD3 *fcd), - cob_file *f, const int cond, cob_field *key, cob_field *keysize, cob_field *fnstatus) -{ - unsigned char opcode[2]; - FCD3 *fcd; - int recn; - int keyn,keylen,partlen; - - f->last_operation = COB_LAST_START; - fcd = find_fcd(f); - if (f->organization == COB_ORG_INDEXED) { - keyn = cob_findkey(f,key,&keylen,&partlen); - STCOMPX2(keyn, fcd->refKey); - if (keysize) - partlen = cob_get_int (keysize); - STCOMPX2(partlen, fcd->effKeyLen); - STCOMPX2(keyn, fcd->refKey); - STCOMPX2(OP_READ_RAN, opcode); - } else if(f->organization == COB_ORG_RELATIVE) { - memset(fcd->relKey,0,sizeof(fcd->relKey)); - recn = cob_get_int(f->keys[0].field); - STCOMPX4(recn, LSUCHAR(fcd->relKey+4)); - STCOMPX2(OP_READ_RAN, opcode); - } - - switch(cond) { - case COB_EQ: STCOMPX2(OP_START_EQ, opcode); break; - case COB_GE: STCOMPX2(OP_START_GE, opcode); break; - case COB_LE: STCOMPX2(OP_START_LE, opcode); break; - case COB_GT: STCOMPX2(OP_START_GT, opcode); break; - case COB_LT: STCOMPX2(OP_START_LT, opcode); break; - case COB_FI: STCOMPX2(OP_START_FI, opcode); break; - case COB_LA: STCOMPX2(OP_START_LA, opcode); break; - default: - STCOMPX2(OP_START_EQ_ANY, opcode); break; - } - - (void)callfh (opcode, fcd); - update_fcd_to_file (fcd, f, fnstatus, 0); -} - -/* - * READ - */ -void -cob_extfh_read ( - int (*callfh)(unsigned char *opcode, FCD3 *fcd), - cob_file *f, cob_field *key, cob_field *fnstatus, const int read_opts) -{ - unsigned char opcode[2]; - FCD3 *fcd; - int recn; - int keyn,keylen,partlen; - - f->last_operation = COB_LAST_READ; - fcd = find_fcd(f); - STCOMPX4 (read_opts, fcd->opt); - if(key == NULL) { - f->last_operation = COB_LAST_READ_SEQ; - if((read_opts & COB_READ_PREVIOUS)) { - STCOMPX2(OP_READ_PREV, opcode); - } else { - STCOMPX2(OP_READ_SEQ, opcode); - } - if(f->organization == COB_ORG_RELATIVE) { - memset(fcd->relKey,0,sizeof(fcd->relKey)); - recn = cob_get_int(f->keys[0].field); - STCOMPX4(recn, LSUCHAR(fcd->relKey+4)); - if (f->access_mode != COB_ACCESS_SEQUENTIAL) - STCOMPX2(OP_READ_RAN, opcode); - } - } else if(f->organization == COB_ORG_INDEXED) { - keyn = cob_findkey(f,key,&keylen,&partlen); - STCOMPX2(keyn, fcd->refKey); - STCOMPX2(keylen, fcd->effKeyLen); - STCOMPX2(OP_READ_RAN, opcode); - } else if(f->organization == COB_ORG_RELATIVE) { - memset(fcd->relKey,0,sizeof(fcd->relKey)); - recn = cob_get_int(key); - STCOMPX4(recn, LSUCHAR(fcd->relKey+4)); - STCOMPX2(OP_READ_RAN, opcode); - } else { - STCOMPX2(OP_READ_SEQ, opcode); - } - - (void)callfh (opcode, fcd); - update_fcd_to_file (fcd, f, fnstatus, 0); -} - -/* - * READ next - */ -void -cob_extfh_read_next ( - int (*callfh)(unsigned char *opcode, FCD3 *fcd), - cob_file *f, cob_field *fnstatus, const int read_opts) -{ - unsigned char opcode[2]; - FCD3 *fcd; - int recn; - - f->last_operation = COB_LAST_READ_SEQ; - fcd = find_fcd(f); - STCOMPX4(read_opts, fcd->opt); - if((read_opts & COB_READ_PREVIOUS)) { - STCOMPX2(OP_READ_PREV, opcode); - } else { - STCOMPX2(OP_READ_SEQ, opcode); - } - if(f->organization == COB_ORG_RELATIVE) { - memset(fcd->relKey,0,sizeof(fcd->relKey)); - recn = cob_get_int(f->keys[0].field); - STCOMPX4(recn, LSUCHAR(fcd->relKey+4)); - } - - (void)callfh (opcode, fcd); - update_fcd_to_file (fcd, f, fnstatus, 0); -} -/* - * WRITE - */ -void -cob_extfh_write ( - int (*callfh)(unsigned char *opcode, FCD3 *fcd), - cob_file *f, cob_field *rec, const int opt, cob_field *fnstatus, const unsigned int check_eop) -{ - unsigned char opcode[2]; - FCD3 *fcd; - int recn; - - f->last_operation = COB_LAST_WRITE; - fcd = find_fcd(f); - STCOMPX2(OP_WRITE, opcode); - STCOMPX2(check_eop, fcd->eop); - STCOMPX4(opt, fcd->opt); - if (f->variable_record) { - f->record->size = (size_t)cob_get_int (f->variable_record); - if (unlikely(f->record->size > rec->size)) { - f->record->size = rec->size; - } - } else { - f->record->size = rec->size; - } - STCOMPX4(f->record->size,fcd->curRecLen); - fcd->recPtr = rec->data; - if (f->organization == COB_ORG_RELATIVE) { - memset (fcd->relKey, 0, sizeof(fcd->relKey)); - recn = cob_get_int(f->keys[0].field); - STCOMPX4(recn, LSUCHAR(fcd->relKey+4)); - } - - (void)callfh (opcode, fcd); - update_fcd_to_file (fcd, f, fnstatus, 0); -} - -/* - * REWRITE - */ -void -cob_extfh_rewrite ( - int (*callfh)(unsigned char *opcode, FCD3 *fcd), - cob_file *f, cob_field *rec, const int opt, cob_field *fnstatus) -{ - unsigned char opcode[2]; - FCD3 *fcd; - int recn; - - f->last_operation = COB_LAST_REWRITE; - fcd = find_fcd(f); - STCOMPX2 (OP_REWRITE, opcode); - STCOMPX4 (rec->size, fcd->curRecLen); - STCOMPX4 (opt, fcd->opt); - fcd->recPtr = rec->data; - if (f->organization == COB_ORG_RELATIVE) { - memset (fcd->relKey ,0, sizeof(fcd->relKey)); - recn = cob_get_int (f->keys[0].field); - STCOMPX4 (recn, LSUCHAR (fcd->relKey + 4)); - } - STCOMPX4(rec->size,fcd->curRecLen); - fcd->recPtr = rec->data; - if(f->organization == COB_ORG_RELATIVE) { - memset(fcd->relKey,0,sizeof(fcd->relKey)); - recn = cob_get_int(f->keys[0].field); - STCOMPX4(recn, LSUCHAR(fcd->relKey+4)); - } - - (void)callfh (opcode, fcd); - update_fcd_to_file (fcd, f, fnstatus, 0); -} - -/* - * DELETE - */ -void -cob_extfh_delete ( - int (*callfh)(unsigned char *opcode, FCD3 *fcd), - cob_file *f, cob_field *fnstatus) -{ - unsigned char opcode[2]; - FCD3 *fcd; - int recn; - - f->last_operation = COB_LAST_DELETE; - fcd = find_fcd (f); - STCOMPX2 (OP_DELETE, opcode); - if (f->organization == COB_ORG_RELATIVE) { - memset (fcd->relKey, 0, sizeof(fcd->relKey)); - recn = cob_get_int (f->keys[0].field); - STCOMPX4 (recn, LSUCHAR(fcd->relKey + 4)); - } - if(f->organization == COB_ORG_RELATIVE) { - memset(fcd->relKey,0,sizeof(fcd->relKey)); - recn = cob_get_int(f->keys[0].field); - STCOMPX4(recn, LSUCHAR(fcd->relKey+4)); - } - - (void)callfh (opcode, fcd); - update_fcd_to_file (fcd, f, fnstatus, 0); -} - -/* COBOL wrapper for EXTFH call to prevent warnings about FCD3 structure - with additional checks */ -int -cob_sys_extfh (const void *opcode_ptr, void *fcd_ptr) -{ - FCD3 *fcd = (FCD3 *) fcd_ptr; - - COB_CHK_PARMS (EXTFH, 2); - - if (cobglobptr->cob_call_params < 2 - || !COB_MODULE_PTR->cob_procedure_params[0] - || !COB_MODULE_PTR->cob_procedure_params[1] - || COB_MODULE_PTR->cob_procedure_params[1]->size < 5) { - cob_set_exception (COB_EC_PROGRAM_ARG_MISMATCH); - return 1; /* correct? */ - } - if (COB_MODULE_PTR->cob_procedure_params[1]->size < sizeof(FCD3)) { - fcd->fileStatus[0] = '9'; - fcd->fileStatus[1] = 161; - if (fcd->fcdVer != FCD_VER_64Bit) { -#if 1 - cob_runtime_warning (_("ERROR: EXTFH called with FCD version %d"), fcd->fcdVer); -#else - cob_set_exception (COB_EC_PROGRAM_ARG_MISMATCH); - cob_runtime_error (_("ERROR: EXTFH called with FCD version %d"), fcd->fcdVer); - exit(-1); -#endif - } - return 1; /* correct? */ - } - - return EXTFH ((unsigned char *)opcode_ptr, fcd); -} - -/* - * Sync FCD3 values to cob_file values - */ -void -cob_fcd_file_sync (cob_file *f, char *file_open_name) -{ - if (f == NULL - || f->fcd == NULL) - return; - if (f->last_operation == COB_LAST_OPEN) { - copy_fcd_to_file (f->fcd, f); - if (f->fcd && f->fcd->fnamePtr) - strncpy(file_open_name, f->fcd->fnamePtr, LDCOMPX2(f->fcd->fnameLen)); - } else { - update_fcd_to_file (f->fcd, f, NULL, -1); - } - return; -} - -/* - * Sync cob_file values to FCD3 values - */ -void -cob_file_fcd_sync (cob_file *f) -{ - if (f == NULL - || f->fcd == NULL) - return; - if (f->last_operation == COB_LAST_OPEN) - copy_file_to_fcd (f, f->fcd); - else - update_file_to_fcd(f, f->fcd, NULL); - return; -} -/* - * Return address of FH--FCD for the given file - * Create the FCD3 is needed - */ -void -cob_file_fcd_adrs (cob_file *f, void *pfcd) -{ - FCD3 *fcd = NULL; - if (f == NULL) { - cob_runtime_error (_("SET ... TO ADDRESS OF FH--FCD filename; Null")); - exit(-1); - } - if (f->fcd == NULL) { - f->fcd = find_fcd (f); - } - fcd = f->fcd; - if(fcd->openMode == OPEN_NOT_OPEN) { - cob_pre_open (f); - } - if (fcd->kdbPtr == NULL) - copy_file_to_fcd (f, fcd); - memcpy (pfcd, &f->fcd, sizeof(void *)); - return; -} - -/* - * Return address of FH--KEYDEF for the given file - * Create the FCD3 is needed - */ -void -cob_file_fcdkey_adrs (cob_file *f, void *pkey) -{ - FCD3 *fcd = NULL; - if (f == NULL) { - cob_runtime_error (_("SET ... TO ADDRESS OF FH--KEYDEF filename; Null")); - exit(-1); - } - cob_file_fcd_adrs (f, &fcd); - memcpy (pkey, &f->fcd->kdbPtr, sizeof(void *)); - return; -} - -/* - * EXTFH: maybe called by user own 'callfh' routine - * to call normal fileio routine in fileio.c - */ -int -EXTFH (unsigned char *opcode, FCD3 *fcd) -{ - int opcd,sts,opts,eop,k; - unsigned char fnstatus[2],keywrk[80]; - cob_field fs[1]; - cob_field key[1]; - cob_field rec[1]; - cob_file *f; - - if (fcd->fcdVer != FCD_VER_64Bit) { - fcd->fileStatus[0] = '9'; - fcd->fileStatus[1] = 161; -#if 1 - cob_runtime_warning (_("ERROR: EXTFH called with FCD version %d"), fcd->fcdVer); - return 1; -#else - cob_set_exception (COB_EC_PROGRAM_ARG_MISMATCH); - cob_runtime_error (_("ERROR: EXTFH called with FCD version %d"), fcd->fcdVer); - exit(-1); -#endif - } - sts = opts = 0; - fs->data = fnstatus; - fs->size = sizeof(fnstatus); - fs->attr = &alnum_attr; - memcpy (fnstatus, "00", 2); - memcpy (fcd->fileStatus, "00", 2); - - if (cobglobptr == NULL) { /* Auto Init GnuCOBOL runtime */ - cob_init (0, NULL); - /* COB_MODULE_PTR (part of cobglobptr structure) was not set, - add to allow tracing and to get better messages on fileio errors */ - COB_MODULE_PTR = cob_malloc( sizeof(cob_module) ); - COB_MODULE_PTR->module_name = "GnuCOBOL-fileio"; - COB_MODULE_PTR->module_source = "GnuCOBOL-fileio"; - COB_MODULE_PTR->module_formatted_date = "2020/01/02 12:01:20"; - } - - if (*opcode == 0xFA) { - opcd = 0xFA00 + opcode[1]; - } else { - opcd = opcode[1]; - } - - /* Look for fcd in table and if found use associated 'cob_file' after copying values over */ - /* If fcd is not found, then 'callfh' created it, so create a new 'cob_file' and table that */ - f = find_file (fcd); - -org_handling: - switch (fcd->fileOrg) { - case ORG_INDEXED: - k = LDCOMPX2(fcd->refKey); - if (k >= 0 && k <= (int)f->nkeys) { - if (f->keys[k].count_components <= 1) { - key->size = f->keys[k].field->size; - key->attr = f->keys[k].field->attr; - key->data = f->record->data + f->keys[k].offset; - } else { - key->size = f->keys[k].component[0]->size; - key->attr = f->keys[k].component[0]->attr; - key->data = f->keys[k].component[0]->data; - } - } else { - memset(keywrk,0,sizeof(keywrk)); - key->size = sizeof(keywrk); - key->attr = &alnum_attr; - key->data = keywrk; - } - break; - case ORG_RELATIVE: - cob_set_int (f->keys[0].field, LDCOMPX4(LSUCHAR(fcd->relKey+4))); - memcpy(&key, f->keys[0].field, sizeof(cob_field)); - break; - case ORG_SEQ: - case ORG_LINE_SEQ: - break; - case ORG_DETERMINE: - if (opcd != OP_GETINFO) { - /* if we already registered this FCD to a file we can copy the old type */ - if (f->organization == COB_ORG_INDEXED) { - fcd->fileOrg = ORG_INDEXED; - } else if (f->organization == COB_ORG_SEQUENTIAL) { - fcd->fileOrg = ORG_SEQ; - } else if (f->organization == COB_ORG_LINE_SEQUENTIAL) { - fcd->fileOrg = ORG_LINE_SEQ; - } else if (f->organization == COB_ORG_RELATIVE) { - fcd->fileOrg = ORG_RELATIVE; - } - if (fcd->fileOrg != ORG_DETERMINE) { - goto org_handling; -#if 0 - } else { - /* TODO: magic to get file type, for example try to idx-open the file */ - if (fcd->fileOrg != ORG_DETERMINE) { - goto org_handling; - } -#endif - } - } - /* Fall through */ - default: - fcd->fileStatus[0] = '9'; - fcd->fileStatus[1] = 161; - cob_runtime_warning (_("ERROR: EXTFH called with wrong file organization %d"), fcd->fileOrg); - return 0; - } - - rec->data = fcd->recPtr; - rec->size = LDCOMPX4(fcd->curRecLen); - rec->attr = &alnum_attr; - - switch (opcd) { - case OP_OPEN_INPUT: - case OP_OPEN_INPUT_NOREWIND: - case OP_OPEN_INPUT_REVERSED: - cob_open(f, COB_OPEN_INPUT, 0, fs); - if (f->organization == COB_ORG_INDEXED - && memcmp(f->file_status,"0",1) == 0) { /* 00 or 05 are both ok */ - f->open_mode = COB_OPEN_INPUT; - } - update_file_to_fcd(f,fcd,fnstatus); - if (f->organization == COB_ORG_INDEXED - && memcmp(f->file_status,"61",1) == 0) {/* 61 --> 9A for MF */ - memcpy(fcd->fileStatus,"9A",2); - } - break; - - case OP_OPEN_OUTPUT: - case OP_OPEN_OUTPUT_NOREWIND: - cob_open(f, COB_OPEN_OUTPUT, 0, fs); - if (f->organization == COB_ORG_INDEXED - && memcmp(f->file_status,"0",1) == 0) { - f->open_mode = COB_OPEN_OUTPUT; - } - update_file_to_fcd(f,fcd,fnstatus); - if (f->organization == COB_ORG_INDEXED - && memcmp(f->file_status,"61",1) == 0) {/* 61 --> 9A for MF */ - memcpy(fcd->fileStatus,"9A",2); - } - break; - - case OP_OPEN_IO: - cob_open(f, COB_OPEN_I_O, 0, fs); - if (f->organization == COB_ORG_INDEXED - && (memcmp(f->file_status,"00",2) == 0 - || memcmp(f->file_status,"05",2) == 0 - || memcmp(f->file_status,"35",2) == 0)) { - f->open_mode = COB_OPEN_I_O; - } - update_file_to_fcd(f,fcd,fnstatus); - if (f->organization == COB_ORG_INDEXED - && memcmp(f->file_status,"61",1) == 0) {/* 61 --> 9A for MF */ - memcpy(fcd->fileStatus,"9A",2); - } - break; - - case OP_OPEN_EXTEND: - cob_open(f, COB_OPEN_EXTEND, 0, fs); - if (f->organization == COB_ORG_INDEXED - && memcmp(f->file_status,"0",1) == 0) { - f->open_mode = COB_OPEN_EXTEND; - } - update_file_to_fcd(f,fcd,fnstatus); - if (f->organization == COB_ORG_INDEXED - && memcmp(f->file_status,"61",1) == 0) {/* 61 --> 9A for MF */ - memcpy(fcd->fileStatus,"9A",2); - } - break; - - case OP_CLOSE: - case OP_CLOSE_REEL: - cob_close(f, fs, COB_CLOSE_NORMAL, 0); - update_file_to_fcd(f,fcd,fnstatus); - break; - - case OP_CLOSE_LOCK: - cob_close(f, fs, COB_CLOSE_LOCK, 0); - update_file_to_fcd(f,fcd,fnstatus); - break; - - case OP_CLOSE_REMOVE: - cob_close(f, fs, COB_CLOSE_UNIT_REMOVAL, 0); - update_file_to_fcd(f,fcd,fnstatus); - break; - - case OP_CLOSE_NO_REWIND: - case OP_CLOSE_NOREWIND: - cob_close(f, fs, COB_CLOSE_NO_REWIND, 0); - update_file_to_fcd(f,fcd,fnstatus); - break; - - case OP_READ_PREV: - case OP_READ_PREV_LOCK: - case OP_READ_PREV_NO_LOCK: - case OP_READ_PREV_KEPT_LOCK: - opts = COB_READ_PREVIOUS; - if (opcd == OP_READ_PREV_LOCK) - opts |= COB_READ_LOCK; - else if (opcd == OP_READ_PREV_NO_LOCK) - opts |= COB_READ_NO_LOCK; - else if (opcd == OP_READ_PREV_KEPT_LOCK) - opts |= COB_READ_KEPT_LOCK; - cob_read_next(f, fs, opts); - update_file_to_fcd(f,fcd,fnstatus); - break; - - case OP_READ_SEQ: - case OP_READ_SEQ_LOCK: - case OP_READ_SEQ_NO_LOCK: - case OP_READ_SEQ_KEPT_LOCK: - opts = COB_READ_NEXT; - if (opcd == OP_READ_SEQ_LOCK) - opts |= COB_READ_LOCK; - else if (opcd == OP_READ_SEQ_NO_LOCK) - opts |= COB_READ_NO_LOCK; - else if (opcd == OP_READ_SEQ_KEPT_LOCK) - opts |= COB_READ_KEPT_LOCK; - cob_read_next(f, fs, opts); - update_file_to_fcd(f,fcd,NULL); - break; - - case OP_STEP_NEXT: - case OP_STEP_NEXT_LOCK: - case OP_STEP_NEXT_NO_LOCK: - case OP_STEP_NEXT_KEPT_LOCK: - opts = COB_READ_NEXT; - if (opcd == OP_STEP_NEXT_LOCK) - opts |= COB_READ_LOCK; - else if (opcd == OP_STEP_NEXT_NO_LOCK) - opts |= COB_READ_NO_LOCK; - else if (opcd == OP_STEP_NEXT_KEPT_LOCK) - opts |= COB_READ_KEPT_LOCK; - cob_read_next(f, fs, opts); - update_file_to_fcd(f,fcd,NULL); - break; - - case OP_STEP_FIRST: - case OP_STEP_FIRST_LOCK: - case OP_STEP_FIRST_NO_LOCK: - case OP_STEP_FIRST_KEPT_LOCK: - opts = COB_READ_FIRST; - if (opcd == OP_STEP_FIRST_LOCK) - opts |= COB_READ_LOCK; - else if (opcd == OP_STEP_FIRST_NO_LOCK) - opts |= COB_READ_NO_LOCK; - else if (opcd == OP_STEP_FIRST_KEPT_LOCK) - opts |= COB_READ_KEPT_LOCK; - cob_read_next(f, fs, opts); - update_file_to_fcd(f,fcd,NULL); - break; - - case OP_READ_RAN: - case OP_READ_RAN_LOCK: - case OP_READ_RAN_NO_LOCK: - case OP_READ_RAN_KEPT_LOCK: - opts = LDCOMPX4(fcd->opt); - if (opcd == OP_READ_RAN_LOCK) - opts |= COB_READ_LOCK; - else if (opcd == OP_READ_RAN_NO_LOCK) - opts |= COB_READ_NO_LOCK; - else if (opcd == OP_READ_RAN_KEPT_LOCK) - opts |= COB_READ_KEPT_LOCK; - cob_read(f, key, fs, opts); - update_file_to_fcd(f,fcd,fnstatus); - break; - - case OP_WRITE: - eop = LDCOMPX2(fcd->eop); - opts = LDCOMPX4(fcd->opt); - cob_write(f, rec, opts, fs, eop); - update_file_to_fcd(f,fcd,fnstatus); - break; - - case OP_REWRITE: - opts = LDCOMPX4(fcd->opt); - cob_rewrite(f, rec, opts, fs); - update_file_to_fcd(f,fcd,fnstatus); - break; - - case OP_DELETE: - cob_delete(f, fs); - update_file_to_fcd(f,fcd,fnstatus); - break; - - case OP_START_EQ: - cob_start(f, COB_EQ, key, NULL, fs); - update_file_to_fcd(f,fcd,fnstatus); - break; - - case OP_START_GE: - cob_start(f, COB_GE, key, NULL, fs); - update_file_to_fcd(f,fcd,fnstatus); - break; - - case OP_START_LE: - cob_start(f, COB_LE, key, NULL, fs); - update_file_to_fcd(f,fcd,fnstatus); - break; - - case OP_START_LT: - cob_start(f, COB_LT, key, NULL, fs); - update_file_to_fcd(f,fcd,fnstatus); - break; - - case OP_START_GT: - cob_start(f, COB_GT, key, NULL, fs); - update_file_to_fcd(f,fcd,fnstatus); - break; - - case OP_START_FI: - cob_start(f, COB_FI, key, NULL, fs); - update_file_to_fcd(f,fcd,fnstatus); - break; - - case OP_START_LA: - cob_start(f, COB_LA, key, NULL, fs); - update_file_to_fcd(f,fcd,fnstatus); - break; - - case OP_COMMIT: - cob_commit(); - break; - - case OP_ROLLBACK: - cob_rollback(); - break; - - case OP_DELETE_FILE: - cob_delete_file(f, fs); - memcpy(fcd->fileStatus, fnstatus, 2); - break; - - case OP_FLUSH: - cob_file_sync (f); - break; - - case OP_UNLOCK_REC: - cob_unlock_file(f, fs); - update_file_to_fcd(f,fcd,fnstatus); - break; - - case OP_GETINFO: /* Nothing needed here */ - break; - - - /* Similar for other possible 'opcode' values */ - default: - /* Some sort of error message */ - break; - } - return sts; -} diff -Nru gnucobol-4.0~early~20200606/libcob/fileio.c gnucobol-5/libcob/fileio.c --- gnucobol-4.0~early~20200606/libcob/fileio.c 2020-06-06 20:52:01.000000000 +0000 +++ gnucobol-5/libcob/fileio.c 1970-01-01 00:00:00.000000000 +0000 @@ -1,7229 +0,0 @@ -/* - Copyright (C) 2002-2012, 2014-2020 Free Software Foundation, Inc. - Written by Keisuke Nishida, Roger While, Simon Sobisch, Ron Norman - - This file is part of GnuCOBOL. - - The GnuCOBOL runtime library is free software: you can redistribute it - and/or modify it under the terms of the GNU Lesser General Public License - as published by the Free Software Foundation, either version 3 of the - License, or (at your option) any later version. - - GnuCOBOL is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU Lesser General Public License for more details. - - You should have received a copy of the GNU Lesser General Public License - along with GnuCOBOL. If not, see . -*/ - - -/* - * This is the main File I/O module and it includes all routines called by - * generated application code plus SORT, SEQUENTIAL & RELATIVE file support - * - * fileio.h is a header for inclusion in all fileio modules - * fileio.c is this module and is the primary driver - * fisam.c has the C/D/VB-ISAM interface code for INDEXED files - * fbdb.c has the BDB code for INDEXED files - * flmdb.c has the LMDB code for INDEXED files - * fodbc.c has the ODBC code for INDEXED files - * foci.c has the OCI (Oracle) code for INDEXED files - * fsqlxfd.c has routines common to ODBC, OCI, BDB, LMDB - * fextfh.c has the EXTFH code (defacto standard used by MicroFocus, IBM, ...) - * focextfh.c has code for obsolete OpenCOBOL WITH_INDEX_EXTFH/WITH_SEQRA_EXTFH - * - */ -#define cobglobptr file_globptr -#define cobsetptr file_setptr -/* Force symbol exports */ -#define COB_LIB_EXPIMP - -#include "defaults.h" -#include "fileio.h" -#ifdef HAVE_DLFCN_H -#if defined(WITH_CISAM) || defined(WITH_DISAM) || defined(WITH_VBISAM) -#include -#endif -#endif - -#ifdef HAVE_SIGNAL_H -#include -#endif -#ifdef HAVE_SYS_WAIT_H -#include -#endif - -struct file_list { - struct file_list *next; - cob_file *file; -}; - -/* SORT definitions */ - -#define COBSORTEND 1 -#define COBSORTABORT 2 -#define COBSORTFILEERR 3 -#define COBSORTNOTOPEN 4 - - -/* Sort item */ -struct cobitem { - struct cobitem *next; - unsigned char end_of_block; - unsigned char block_byte; - unsigned char unique[sizeof (size_t)]; - unsigned char item[1]; -}; - -/* Sort memory chunk */ -struct sort_mem_struct { - struct sort_mem_struct *next; - unsigned char *mem_ptr; -}; - -/* Sort queue structure */ -struct queue_struct { - struct cobitem *first; - struct cobitem *last; - size_t count; -}; - -/* Sort temporary file structure */ -struct file_struct { - FILE *fp; - size_t count; /* Count of blocks in temporary files */ -}; - -/* Sort base structure */ -struct cobsort { - void *pointer; - struct cobitem *empty; - void *sort_return; - cob_field *fnstatus; - struct sort_mem_struct *mem_base; - size_t unique; - size_t size; - size_t alloc_size; - size_t mem_size; - size_t mem_used; - size_t mem_total; - size_t chunk_size; - size_t r_size; - size_t w_size; - size_t switch_to_file; - unsigned int retrieving; - unsigned int files_used; - int destination_file; - int retrieval_queue; - struct queue_struct queue[4]; - struct file_struct file[4]; -}; - -/* End SORT definitions */ - - -/* Local variables */ - -cob_global *file_globptr = NULL; -cob_settings *file_setptr = NULL; - -static unsigned int eop_status = 0; -static unsigned int check_eop_status = 0; - -static struct file_list *file_cache = NULL; - -static char *file_open_env = NULL; -static char *file_open_name = NULL; -static char *file_open_buff = NULL; -static char *file_open_io_env = NULL; /* IO_filename env value */ - -static char *runtime_buffer = NULL; - -static int chk_file_path = 1; - -static const cob_field_attr const_alpha_attr = {COB_TYPE_ALPHANUMERIC, 0, 0, 0, NULL}; -static cob_file_api file_api = {NULL, NULL}; - -static char **file_paths = NULL; -static const char * const prefix[] = { "DD_", "dd_", "" }; -#define NUM_PREFIX sizeof (prefix) / sizeof (char *) - -static int dummy_stub () {return 0;}; -static int dummy_91 () {return COB_STATUS_91_NOT_AVAILABLE;}; - -static void cob_set_file_format(cob_file *, char *, int, int *); -static void cob_set_file_defaults (cob_file *); -static int cob_savekey (cob_file *f, int idx, unsigned char *data); -static int cob_file_open (cob_file_api *, cob_file *, char *, const int, const int); -static int cob_file_close (cob_file_api *, cob_file *, const int); -static int cob_file_write_opt (cob_file *, const int); - -static int sequential_read (cob_file_api *, cob_file *, const int); -static int sequential_write (cob_file_api *, cob_file *, const int); -static int sequential_rewrite (cob_file_api *, cob_file *, const int); -static int lineseq_read (cob_file_api *, cob_file *, const int); -static int lineseq_write (cob_file_api *, cob_file *, const int); -static int lineseq_rewrite (cob_file_api *, cob_file *, const int); -static int relative_start (cob_file_api *, cob_file *, const int, cob_field *); -static int relative_read (cob_file_api *, cob_file *, cob_field *, const int); -static int relative_read_next (cob_file_api *, cob_file *, const int); -static int relative_write (cob_file_api *, cob_file *, const int); -static int relative_rewrite (cob_file_api *, cob_file *, const int); -static int relative_delete (cob_file_api *, cob_file *); - -static struct cob_fileio_funcs sequential_funcs = { - cob_file_open, - cob_file_close, - (void*)dummy_91, - (void*)dummy_91, - sequential_read, - sequential_write, - sequential_rewrite, - (void*)dummy_91, - (void*)dummy_stub, - (void*)dummy_stub, - (void*)dummy_stub, - (void*)dummy_stub, - (void*)dummy_stub, - (void*)dummy_stub, - (void*)dummy_stub, - (void*)dummy_stub -}; - -static struct cob_fileio_funcs lineseq_funcs = { - cob_file_open, - cob_file_close, - (void*)dummy_91, - (void*)dummy_91, - lineseq_read, - lineseq_write, - lineseq_rewrite, - (void*)dummy_91, - (void*)dummy_stub, - (void*)dummy_stub, - (void*)dummy_stub, - (void*)dummy_stub, - (void*)dummy_stub, - (void*)dummy_stub, - (void*)dummy_stub, - (void*)dummy_stub -}; - -static struct cob_fileio_funcs relative_funcs = { - cob_file_open, - cob_file_close, - relative_start, - relative_read, - relative_read_next, - relative_write, - relative_rewrite, - relative_delete, - (void*)dummy_stub, - (void*)dummy_stub, - (void*)dummy_stub, - (void*)dummy_stub, - (void*)dummy_stub, - (void*)dummy_stub, - (void*)dummy_stub, - (void*)dummy_stub -}; - -static struct cob_fileio_funcs *fileio_funcs[COB_IO_MAX] = { - &sequential_funcs, - &lineseq_funcs, - &relative_funcs, - NULL, NULL, NULL, NULL, NULL, NULL, NULL -}; - -static const char *io_rtn_name[COB_IO_MAX+1] = { - "SEQUENTIAL", - "LINE", - "RELATIVE", - "CISAM", - "DISAM", - "VBISAM", - "BDB", - "LMDB", - "IXEXT", - "SQEXT", - "RLEXT", - "ODBC", - "OCI", - "" -}; - -#ifdef WITH_INDEX_EXTFH -void cob_index_init_fileio (cob_file_api *); -#endif - -#ifdef WITH_SEQRA_EXTFH -void cob_seqra_init_fileio (cob_file_api *); -#endif - - -/* Local functions */ - -static int -isdirname (char *value) -{ -#ifdef _WIN32 - if (value[0] == '\\' - || value[1] == ':' - || value[0] == '/') - return 1; -#else - if (value[0] == '/') - return 1; -#endif - return 0; -} - -static COB_INLINE int -get_io_ptr (cob_file *f) -{ - if (fileio_funcs[f->io_routine] == NULL) { - cob_runtime_error (_("ERROR I/O routine %s is not present"), - io_rtn_name[f->io_routine]); - } - return f->io_routine; -} - -/* file_format: see COB_FILE_IS_xx */ -static const char *file_format[12] = {"0","1","2","3","B32","B64","L32","L64","?","?","gc","mf"}; -static const char *dict_ext = "dd"; - -#if defined(WITH_INDEXED) -static const char ix_routine = WITH_INDEXED; -#else -#if defined(WITH_CISAM) -static const char ix_routine = COB_IO_CISAM; -#elif defined(WITH_DISAM) -static const char ix_routine = COB_IO_DISAM; -#elif defined(WITH_VBISAM) -static const char ix_routine = COB_IO_VBISAM; -#elif WITH_DB -static const char ix_routine = COB_IO_BDB; -#elif WITH_LMDB -static const char ix_routine = COB_IO_LMDB; -#elif WITH_ODBC -static const char ix_routine = COB_IO_ODBC; -#elif WITH_OCI -static const char ix_routine = COB_IO_OCI; -#elif WITH_INDEX_EXTFH -static const char ix_routine = COB_IO_IXEXT; -#else -static const char ix_routine = COB_IO_IXEXT; -#endif -#endif - -/* - * Determine which of C|D|VB-ISAM the file is - */ -static int -indexed_file_type(char *filename) -{ - char temp[COB_FILE_MAX]; - unsigned char hbuf[1024]; - struct stat st; - int idx; - FILE *fdin; - - if (stat(filename, &st) != -1) { - if (S_ISDIR(st.st_mode)) { /* Filename is a directory */ - sprintf(temp,"%s%cdata.mdb",filename,SLASH_CHAR); - if (stat(temp, &st) != -1) { - return COB_IO_LMDB; - } - return -1; - } - } - sprintf(temp,"%s.idx",filename); - fdin = fopen(temp,"r"); - if(fdin == NULL) { - fdin = fopen(filename,"r"); - if(fdin == NULL) { - return -1; - } - memset(hbuf,0,sizeof(hbuf)); - fread(hbuf, 1, sizeof(hbuf), fdin); - fclose(fdin); - for(idx=1; idx < 32; idx++) { - sprintf(temp,"%s.%d",filename,idx); - if (stat(temp, &st) == -1) - break; - } - if(memcmp(&hbuf[12],"\x62\x31\x05\x00",4) == 0) - return COB_IO_BDB; - if(memcmp(&hbuf[12],"\x00\x05\x31\x62",4) == 0) - return COB_IO_BDB; - if(memcmp(&hbuf[12],"\x61\x15\x06\x00",4) == 0) - return COB_IO_BDB; - if(memcmp(&hbuf[12],"\x00\x06\x15\x61",4) == 0) - return COB_IO_BDB; - return -1; - } - memset(hbuf,0,sizeof(hbuf)); - fread(hbuf, 1, sizeof(hbuf), fdin); - fclose(fdin); - - if(hbuf[0] == 0xFE - && hbuf[1] == 0x53) { /* C|D-ISAM marker */ - /* D-ISAM and C-ISAM are interchangable */ - if(memcmp(hbuf+1020,"dism",4) == 0) -#if defined(WITH_DISAM) - return COB_IO_DISAM; -#elif defined(WITH_CISAM) - return COB_IO_CISAM; -#else - return -1; -#endif - else -#if defined(WITH_CISAM) - return COB_IO_CISAM; -#elif defined(WITH_DISAM) - return COB_IO_DISAM; -#else - return -1; -#endif - } else - if(hbuf[0] == 'V' - && hbuf[1] == 'B') { /* VB-ISAM file marker */ - return COB_IO_VBISAM; - } else - if(hbuf[0] == 0x33 - && hbuf[1] == 0xFE) { /* Micro Focus format */ - return COB_IO_MFIDX4; - } - return -1; -} - -static int -keycmp (char *keyword, const char *val) -{ - while (*keyword && *val) { - if (toupper(*keyword) != toupper(*val)) { - if (!((*keyword == '-' || *keyword == '_') - && (*val == '-' || *val == '_'))) - break; - } - keyword++; - val++; - } - return (toupper(*keyword)-toupper(*val)); -} - -/* - * Write data file description to a string - */ -static void -write_file_def (cob_file *f, char *out) -{ - int idx,j; - int k = 0; - - out[k] = 0; - if(f->organization == COB_ORG_INDEXED) { - k += sprintf(&out[k],"type=IX format=%s",io_rtn_name[f->io_routine]); - } else if(f->organization == COB_ORG_RELATIVE) { - k += sprintf(&out[k],"type=RL"); - if(f->file_format < 12) - k += sprintf(&out[k],",%s",file_format[f->file_format]); - } else if(f->organization == COB_ORG_SEQUENTIAL) { - k += sprintf(&out[k],"type=SQ"); - if(f->file_format < 12) - k += sprintf(&out[k],",%s",file_format[f->file_format]); - } else if(f->organization == COB_ORG_LINE_SEQUENTIAL) { - if(f->flag_line_adv) - k += sprintf(&out[k],"type=LA"); - else - k += sprintf(&out[k],"type=LS"); - if(f->file_format == COB_FILE_IS_MF) - k += sprintf(&out[k],",mf"); - else if(f->file_format == COB_FILE_IS_GC) - k += sprintf(&out[k],",gc"); - if((f->file_features & COB_FILE_LS_LF)) - k += sprintf(&out[k],",lf"); - if((f->file_features & COB_FILE_LS_CRLF)) - k += sprintf(&out[k],",crlf"); - if((f->file_features & COB_FILE_LS_NULLS)) - k += sprintf(&out[k],",ls_nulls"); - if((f->file_features & COB_FILE_LS_FIXED)) - k += sprintf(&out[k],",ls_fixed"); - if((f->file_features & COB_FILE_LS_VALIDATE)) - k += sprintf(&out[k],",ls_validate"); - if((f->file_features & COB_FILE_LS_SPLIT)) - k += sprintf(&out[k],",ls_split"); - } - if (f->flag_big_endian) - k += sprintf(&out[k],",big-endian"); - else if (f->flag_little_endian) - k += sprintf(&out[k],",little-endian"); - - if(f->organization == COB_ORG_LINE_SEQUENTIAL) { - k += sprintf(&out[k]," recsz=%d ",(int)(f->record_max)); - } else if(f->record_min != f->record_max) { - k += sprintf(&out[k]," maxsz=%d ",(int)(f->record_max)); - k += sprintf(&out[k],"minsz=%d ",(int)(f->record_min)); - } else { - k += sprintf(&out[k]," recsz=%d ",(int)(f->record_max)); - } - - if (f->organization == COB_ORG_INDEXED - && f->nkeys > 0) { - /* Write Key information from cob_file */ - k += sprintf(&out[k],"nkeys=%d ",(int)(f->nkeys)); - for(idx=0; idx < (int)f->nkeys; idx++) { - k += sprintf(&out[k],"key%d=(",idx+1); - if(f->keys[idx].count_components <= 1) { - k += sprintf(&out[k],"%d:%d",f->keys[idx].offset,(int)(f->keys[idx].field->size)); - } else { - for(j=0; j < f->keys[idx].count_components; j++) { - k += sprintf(&out[k],"%d:%d",(int)(f->keys[idx].component[j]->data - f->record->data), - (int)(f->keys[idx].component[j]->size)); - if(j+1 < f->keys[idx].count_components) - k += sprintf(&out[k],","); - } - } - k += sprintf(&out[k],") "); - if (f->keys[idx].tf_duplicates) { - k += sprintf(&out[k],"dup%d=Y ",idx+1); - } - if (f->keys[idx].len_suppress > 0 - && f->keys[idx].str_suppress != NULL) { - k += sprintf(&out[k],"skip%d='%.*s' ",idx+1, - f->keys[idx].len_suppress,f->keys[idx].str_suppress); - } else - if (f->keys[idx].tf_suppress) { - if (isalnum(f->keys[idx].char_suppress) - || f->keys[idx].char_suppress == '@' - || f->keys[idx].char_suppress == '#' - || f->keys[idx].char_suppress == '$' - || f->keys[idx].char_suppress == '*') - k += sprintf(&out[k],"sup%d='%c' ",idx+1,f->keys[idx].char_suppress); - else - k += sprintf(&out[k],"sup%d=x'%02X' ",idx+1,f->keys[idx].char_suppress); - } - } - } -} - -static char * -cob_dd_prms ( char *p, char *p1, char *p2 ) -{ - while (*p == ' ') p++; - *p1 = 0; - if (*p == '(') p++; - if (*p == ',') p++; - if (*p == ';') p++; - while (*p == ' ') p++; - while (*p != 0 && *p != ' ' - && *p != ',' && *p != ':' - && *p != ';' && *p != ')') - *p1++ = *p++; - *p1 = 0; - if (*p == ':') { - p++; - if (p2 != NULL) { - *p2 = 0; - while (*p != 0 && *p != ' ' - && *p != ',' && *p != ')') - *p2++ = *p++; - *p2 = 0; - } - } - if (*p == ')') p++; - while (*p == ' ') p++; - if (*p == ')') p++; - return p; -} - -static void -cob_order_keys (cob_file *f) -{ - int didswap = 1; - int k; - cob_file_key kx; - while (didswap) { - didswap = 0; - for (k=0; k < (int)f->nkeys-1; k++) { - if (f->keys[k].keyn > f->keys[k+1].keyn) { - didswap = 1; - memcpy(&kx, &f->keys[k], sizeof(cob_file_key)); - memcpy(&f->keys[k], &f->keys[k+1], sizeof(cob_file_key)); - memcpy(&f->keys[k+1], &kx, sizeof(cob_file_key)); - } - } - } -} - -/* - * Parse one key definition and update 'cob_file' - */ -static void -cob_key_def (cob_file *f, int keyn, char *p, int *ret, int keycheck) -{ - int k,idx,part,parts,loc,len,ttl; - char p1[32], p2[32]; - int cloc[COB_MAX_KEYCOMP],clen[COB_MAX_KEYCOMP]; - if (f->flag_redo_keydef) - keycheck = 0; - idx = keyn - 1; - cloc[0] = clen[0] = 0; - ttl = 0; - for (parts = 0; parts < COB_MAX_KEYCOMP; parts++) { - p = cob_dd_prms (p, p1, p2); - cloc[parts] = atoi (p1); - clen[parts] = atoi (p2); - ttl += clen[parts]; - if(*p != ',') { - parts++; - break; - } - } - if(parts >= COB_MAX_KEYCOMP) { - *ret = COB_STATUS_39_CONFLICT_ATTRIBUTE; - return; - } - loc = cloc[0]; - len = clen[0]; - for (k=0; k < (int)f->nkeys && f->keys[k].field != NULL; k++) { - if (parts == 1) { - if (f->keys[k].count_components > 1) - continue; - if ((f->keys[k].component[0] - && cloc[0] == (int)(f->keys[k].component[0]->data - f->record->data) - && clen[0] == (int)f->keys[k].component[0]->size) - || (cloc[0] == (int)(f->keys[k].field->data - f->record->data) - && clen[0] == (int)f->keys[k].field->size)) { - f->keys[k].keyn = (unsigned char)idx; - if (idx == (int)f->nkeys-1) - cob_order_keys (f); - return; - } - } else if (parts == f->keys[k].count_components) { - for(part = 0; part < parts; part++) { - if(f->keys[k].component[part] == NULL) { - *ret = COB_STATUS_39_CONFLICT_ATTRIBUTE; - return; - } - if ((int)f->keys[k].component[part]->size != clen[part] - || (int)(f->keys[k].component[part]->data - f->record->data) != cloc[part]) { - break; - } - } - if (part == parts) { /* Found the index */ - f->keys[k].keyn = (unsigned char)idx; - if (idx == (int)f->nkeys-1) - cob_order_keys (f); - return; - } - } - } - if (k >= (int)f->nkeys) { - *ret = COB_STATUS_39_CONFLICT_ATTRIBUTE; - return; - } - if (f->keys[k].field != NULL) { - *ret = COB_STATUS_39_CONFLICT_ATTRIBUTE; - return; - } - - if (f->flag_redo_keydef) /* Update all index definitions */ - k = idx; - /* No match so add this index to table */ - loc = cloc[0]; - len = clen[0]; - f->keys[k].field = cob_cache_malloc (sizeof(cob_field)); - f->keys[k].field->attr = &const_alpha_attr; - f->keys[k].offset = loc; - if (parts == 1) { - f->keys[k].field->size = len; - f->keys[k].field->data = f->record->data + loc; - if ((int)(f->keys[k].offset) != loc - || (int)(f->keys[k].field->size) != len) { - f->keys[k].offset = loc; - f->keys[k].field->size = len; - f->keys[k].field->data = f->record->data + loc; - } - f->keys[k].component[0] = f->keys[k].field; - f->keys[k].count_components = 0; - - } else { - - f->keys[k].field->size = ttl; - f->keys[k].field->data = cob_cache_malloc ((size_t)ttl+1); - f->keys[k].count_components = (short)parts; - for(part = 0; part < parts; part++) { - loc = cloc[part]; - len = clen[part]; - f->keys[k].component[part] = cob_cache_malloc (sizeof(cob_field)); - f->keys[k].component[part]->attr = &const_alpha_attr; - f->keys[k].component[part]->size = len; - f->keys[k].component[part]->data = f->record->data + loc; - } - } - - f->keys[k].keyn = (unsigned char)idx; - if (idx == (int)f->nkeys-1) - cob_order_keys (f); - return; -} - -int -cob_write_dict (cob_file *f, char *filename) -{ - char outdd[COB_FILE_MAX], outbuf[4096]; - FILE *fo; - - if (file_setptr->cob_file_dict == COB_DICTIONARY_NO) - return 0; - if (file_setptr->cob_dictionary_path != NULL) - sprintf(outdd,"%s%c%s.%s",file_setptr->cob_dictionary_path, - SLASH_CHAR,filename,dict_ext); - else - sprintf(outdd,"%s.%s",filename,dict_ext); - fo = fopen(outdd,"w"); - if(fo == NULL) { - return 1; - } - write_file_def (f, outbuf); - fprintf(fo,"%s\r\n",outbuf); - fclose(fo); - return 0; -} - -/* - * Read description of data file from text file and check it - */ -int /* Return 1 on mistmatch, else 0 */ -cob_read_dict (cob_file *f, char *filename, int updt, int *retsts) -{ - char inpdd[COB_FILE_MAX], ddbuf[2048]; - FILE *fi; - int line, ret; - - if (file_setptr->cob_file_dict == COB_DICTIONARY_NO) - return 0; - if (file_setptr->cob_dictionary_path != NULL) - sprintf(inpdd,"%s%c%s.%s",file_setptr->cob_dictionary_path, - SLASH_CHAR,filename,dict_ext); - else - sprintf(inpdd,"%s.%s",filename,dict_ext); - fi = fopen(inpdd,"r"); - if (fi == NULL) { /* Not present so nothing can be done */ - return 0; - } - line = 0; - ret = 0; - if(retsts) - *retsts = 0; - while (fgets (ddbuf, sizeof(ddbuf)-1, fi) != NULL) { - if (ddbuf[0] == '#')/* Skip Comment lines */ - continue; - line++; - cob_set_file_format(f, ddbuf, updt, &ret); /* Set defaults for file type */ - } - fclose(fi); - - if(retsts) - *retsts = ret; - if(ret >= 10) - return 1; - return 0; -} - -static char * -cob_chk_file_env (cob_file *f, const char *src) -{ - char *p; - char *q; - char *s; - const char *t; - unsigned int i; - - if (unlikely (file_setptr->cob_env_mangle)) { - q = cob_strdup (src); - s = q; - for (i = 0; s[i] != 0; ++i) { - if (!isalnum ((int)s[i])) { - s[i] = '_'; - } - } - } else { - q = NULL; - s = (char *)src; - } - - if (f->organization == COB_ORG_INDEXED) { - t = "IX"; - } else if (f->organization == COB_ORG_SEQUENTIAL) { - t = "SQ"; - } else if (f->organization == COB_ORG_LINE_SEQUENTIAL) { - if(f->flag_line_adv) - t = "LA"; - else - t = "LS"; - } else if (f->organization == COB_ORG_RELATIVE) { - t = "RL"; - } else { - t = "IO"; - } - snprintf (file_open_env, (size_t)COB_FILE_MAX, "%s_OPTIONS", t); - if ((file_open_io_env = getenv (file_open_env)) == NULL) { - snprintf (file_open_env, (size_t)COB_FILE_MAX, "%s_options", t); - file_open_env[0] = (char)tolower(file_open_env[0]); - file_open_env[1] = (char)tolower(file_open_env[1]); - file_open_io_env = getenv (file_open_env); - } - if (file_open_io_env == NULL) { - file_open_io_env = getenv("IO_OPTIONS"); - } - if (file_open_io_env != NULL) { - cob_set_file_format(f, file_open_io_env, 1, NULL); /* Set defaults for file type */ - } - - /* Check for IO_filename with file specific options */ - file_open_io_env = NULL; - snprintf (file_open_env, (size_t)COB_FILE_MAX, "%s%s", "IO_", s); - if ((file_open_io_env = getenv (file_open_env)) == NULL) { - snprintf (file_open_env, (size_t)COB_FILE_MAX, "%s%s", "io_", s); - if ((file_open_io_env = getenv (file_open_env)) == NULL) { - for (i = 0; file_open_env[i] != 0; ++i) { /* Try all Upper Case */ - if(islower((unsigned char)file_open_env[i])) - file_open_env[i] = (char)toupper((unsigned char)file_open_env[i]); - } - file_open_io_env = getenv (file_open_env); - } - } - if (file_open_io_env == NULL) { - /* Re-check for IO_fdname */ - snprintf (file_open_env, (size_t)COB_FILE_MAX, "%s%s", "IO_", f->select_name); - if ((file_open_io_env = getenv (file_open_env)) == NULL) { - snprintf (file_open_env, (size_t)COB_FILE_MAX, "%s%s", "io_", f->select_name); - if ((file_open_io_env = getenv (file_open_env)) == NULL) { - for (i = 0; file_open_env[i] != 0; ++i) { /* Try all Upper Case */ - if(islower((unsigned char)file_open_env[i])) - file_open_env[i] = (unsigned char)toupper((int)file_open_env[i]); - } - file_open_io_env = getenv (file_open_env); - } - } - } - - - p = NULL; - for (i = 0; i < NUM_PREFIX; ++i) { - snprintf (file_open_env, (size_t)COB_FILE_MAX, "%s%s", prefix[i], s); - file_open_env[COB_FILE_MAX] = 0; - if ((p = getenv (file_open_env)) != NULL) { - break; - } - } - if (p == NULL) { /* Try all Upper case env var name */ - for (i = 0; i < NUM_PREFIX; ++i) { - snprintf (file_open_env, (size_t)COB_FILE_MAX, "%s%s", prefix[i], s); - file_open_env[COB_FILE_MAX] = 0; - for (i = 0; file_open_env[i] != 0; ++i) { - if (islower ((unsigned char)file_open_env[i])) { - file_open_env[i] = (char)toupper((unsigned char)file_open_env[i]); - } - } - if ((p = getenv (file_open_env)) != NULL) { - break; - } - } - if (p == NULL) { - strcpy (file_open_env, file_open_name); - } - } - if (unlikely (q)) { - cob_free (q); - } - return p; -} - -void -cob_chk_file_mapping (cob_file *f) -{ - char *p; - char *src; - char *dst; - char *saveptr; - char *orig; - unsigned int dollar; - int k; - - if (unlikely (!COB_MODULE_PTR->flag_filename_mapping)) { - return; - } - - /* Misuse "dollar" here to indicate a separator */ - dollar = 0; - for (p = file_open_name; *p; p++) { - if (*p == '/' || *p == '\\') { - dollar = 1; - break; - } - } - - src = file_open_name; - - /* Simple case - No separators */ - if (likely(dollar == 0)) { - /* Ignore leading dollar */ - if (*src == '$') { - src++; - } - /* Check for DD_xx, dd_xx, xx environment variables */ - /* If not found, use as is including the dollar character */ - if ((p = cob_chk_file_env (f, src)) != NULL) { - strncpy (file_open_name, p, (size_t)COB_FILE_MAX); - } else if (file_paths) { - for(k=0; file_paths[k] != NULL; k++) { - snprintf (file_open_buff, (size_t)COB_FILE_MAX, "%s%c%s", - file_paths[k], SLASH_CHAR, file_open_name); - file_open_buff[COB_FILE_MAX] = 0; - if (access (file_open_buff, F_OK) == 0) { - break; - } -#if defined(WITH_CISAM) || defined(WITH_DISAM) || defined(WITH_VBISAM) - /* ISAM may append '.dat' to file name */ - snprintf (file_open_buff, (size_t)COB_FILE_MAX, "%s%c%s.dat", - file_paths[k], SLASH_CHAR, file_open_name); - file_open_buff[COB_FILE_MAX] = 0; - if (access (file_open_buff, F_OK) == 0) { - snprintf (file_open_buff, (size_t)COB_FILE_MAX, "%s%c%s", - file_paths[k], SLASH_CHAR, file_open_name); - file_open_buff[COB_FILE_MAX] = 0; - break; - } -#endif - } - if (file_paths[k] == NULL) { - snprintf (file_open_buff, (size_t)COB_FILE_MAX, "%s%c%s", - file_paths[0], SLASH_CHAR, file_open_name); - file_open_buff[COB_FILE_MAX] = 0; - } - strncpy (file_open_name, file_open_buff, (size_t)COB_FILE_MAX); - } - return; - } - - /* Complex */ - /* Isolate first element (everything before the slash) */ - /* If it starts with a slash, it's absolute, do nothing */ - /* Else if it starts with a $, mark and skip over the $ */ - /* Try mapping on resultant string - DD_xx, dd_xx, xx */ - /* If successful, use the mapping */ - /* If not, use original element EXCEPT if we started */ - /* with a $, in which case, we ignore the element AND */ - /* the following slash */ - - dollar = 0; - dst = file_open_buff; - *dst = 0; - - if (*src == '$') { - dollar = 1; - src++; - } - - orig = cob_strdup (src); - saveptr = orig; - - /* strtok strips leading delimiters */ - if (*src == '/' || *src == '\\') { - strcpy (file_open_buff, SLASH_STR); - } else { - file_open_buff[COB_FILE_MAX] = 0; - p = strtok (orig, "/\\"); - orig = NULL; - if ((src = cob_chk_file_env (f, p)) != NULL) { - strncpy (file_open_buff, src, (size_t)COB_FILE_MAX); - dollar = 0; - } else if (!dollar) { - strncpy (file_open_buff, p, (size_t)COB_FILE_MAX); - } - } - /* First element completed, loop through remaining */ - /* elements delimited by slash */ - /* Check each for $ mapping */ - for (; ;) { - p = strtok (orig, "/\\"); - if (!p) { - break; - } - if (!orig) { - if (dollar) { - dollar = 0; - } else { - strcat (file_open_buff, SLASH_STR); - } - } else { - orig = NULL; - } - if (*p == '$' && (src = cob_chk_file_env (f, p + 1)) != NULL) { - strncat (file_open_buff, src, (size_t)COB_FILE_MAX); - } else { - strncat (file_open_buff, p, (size_t)COB_FILE_MAX); - } - } - strcpy (file_open_name, file_open_buff); - cob_free (saveptr); -} - -void -cob_file_sync (cob_file *f) -{ - if (f->organization == COB_ORG_INDEXED) { - fileio_funcs[get_io_ptr (f)]->iosync (&file_api, f); - return; - } - if (f->organization != COB_ORG_SORT) { - if (f->file) { - fflush ((FILE *)f->file); - } - if (f->fd >= 0) { - fdcobsync (f->fd); - } - } -} - -static void -cob_cache_file (cob_file *f) -{ - struct file_list *l; - - for (l = file_cache; l; l = l->next) { - if (f == l->file) { - return; - } - } - l = cob_malloc (sizeof (struct file_list)); - l->file = f; - l->next = file_cache; - file_cache = l; -} - -static void -cob_cache_del (cob_file *f) -{ - struct file_list *l, *m; - - m = NULL; - for (l = file_cache; l; l = l->next) { - if (f == l->file) { - if (l == file_cache) { - file_cache = l->next; - } else { - m->next = l->next; - } - cob_free (l); - break; - } - m = l; - } -} - -/* - * Set file format based on defaults, runtime.cfg - */ -static void -cob_set_file_defaults (cob_file *f) -{ - /* - * Set default I/O routine - */ - if (f->organization == COB_ORG_INDEXED) { - f->io_routine = ix_routine; - if (f->fcd) { - if (f->fcd->fileFormat == MF_FF_CISAM) -#ifdef WITH_CISAM - f->io_routine = COB_IO_CISAM -#else - f->io_routine = ix_routine; -#endif -#ifdef WITH_DISAM - else if (f->fcd->fileFormat == MF_FF_DISAM) - f->io_routine = COB_IO_DISAM; -#endif -#ifdef WITH_VBISAM - else if (f->fcd->fileFormat == MF_FF_VBISAM) - f->io_routine = COB_IO_VBISAM; -#endif -#ifdef WITH_ODBC - else if (f->fcd->fileFormat == MF_FF_ODBC) - f->io_routine = COB_IO_ODBC; -#endif -#ifdef WITH_OCI - else if (f->fcd->fileFormat == MF_FF_OCI) - f->io_routine = COB_IO_OCI; -#endif -#ifdef WITH_DB - else if (f->fcd->fileFormat == MF_FF_BDB) - f->io_routine = COB_IO_BDB; -#endif -#ifdef WITH_LMDB - else if (f->fcd->fileFormat == MF_FF_LMDB) - f->io_routine = COB_IO_LMDB; -#endif - } - } else if (f->organization == COB_ORG_SEQUENTIAL) { - f->io_routine = COB_IO_SEQUENTIAL; - } else if (f->organization == COB_ORG_RELATIVE) { - f->io_routine = COB_IO_RELATIVE; - } else if (f->organization == COB_ORG_LINE_SEQUENTIAL) { - f->io_routine = COB_IO_LINE_SEQUENTIAL; - } - - f->trace_io = file_setptr->cob_trace_io ? 1 : 0; - f->io_stats = file_setptr->cob_stats_record ? 1 : 0; - f->flag_keycheck = file_setptr->cob_keycheck ? 1 : 0; - if(file_setptr->cob_do_sync) - f->file_features |= COB_FILE_SYNC; - else - f->file_features &= ~COB_FILE_SYNC; - f->dflt_times = file_setptr->cob_retry_times; - f->dflt_seconds = file_setptr->cob_retry_seconds; - f->dflt_share = (unsigned char)file_setptr->cob_share_mode; - f->dflt_retry = (unsigned short)file_setptr->cob_retry_mode; - if (file_setptr->cob_bdb_byteorder == COB_BDB_IS_BIG) - f->flag_big_endian = 1; - else if (file_setptr->cob_bdb_byteorder == COB_BDB_IS_LITTLE) - f->flag_little_endian = 1; - if(f->dflt_retry == 0) { - if(f->dflt_times > 0) - f->dflt_retry |= COB_RETRY_TIMES; - if(f->dflt_seconds > 0) - f->dflt_retry |= COB_RETRY_SECONDS; - } - - if (f->file_format == 255) { /* File type not set by compiler; Set default */ - if (f->organization == COB_ORG_SEQUENTIAL) { - if (f->record_min != f->record_max) { - f->file_format = (unsigned char)file_setptr->cob_varseq_type; - } else { - f->file_format = COB_FILE_IS_GCVS0; - } - } else - if (f->organization == COB_ORG_LINE_SEQUENTIAL) { - f->file_format = COB_FILE_IS_GC; - } else - if (f->organization == COB_ORG_RELATIVE) { - if (f->record_min != f->record_max) { - f->file_format = (unsigned char)file_setptr->cob_varrel_type; - } else { - f->file_format = (unsigned char)file_setptr->cob_fixrel_type; - } - } - } - - if (f->organization == COB_ORG_LINE_SEQUENTIAL) { - f->io_routine = COB_IO_LINE_SEQUENTIAL; - if(file_setptr->cob_ls_fixed) - f->file_features |= COB_FILE_LS_FIXED; - else - f->file_features &= ~COB_FILE_LS_FIXED; -#ifdef _WIN32 - if(file_setptr->cob_unix_lf) - f->file_features |= COB_FILE_LS_LF; - else - f->file_features |= COB_FILE_LS_CRLF; -#else - f->file_features |= COB_FILE_LS_LF; -#endif - if(file_setptr->cob_ls_uses_cr) - f->file_features |= COB_FILE_LS_CRLF; - - if(f->file_format == COB_FILE_IS_MF) { /* Micro Focus format LINE SEQUENTIAL */ - if(file_setptr->cob_mf_ls_split) - f->file_features |= COB_FILE_LS_SPLIT; - else - f->file_features &= ~COB_FILE_LS_SPLIT; - if(file_setptr->cob_mf_ls_nulls) - f->file_features |= COB_FILE_LS_NULLS; - else - f->file_features &= ~COB_FILE_LS_NULLS; - if(file_setptr->cob_mf_ls_validate - && !f->flag_line_adv) - f->file_features |= COB_FILE_LS_VALIDATE; - else - f->file_features &= ~COB_FILE_LS_VALIDATE; - } else { /* GnuCOBOL default format LINE SEQUENTIAL */ - if(file_setptr->cob_ls_split) - f->file_features |= COB_FILE_LS_SPLIT; - else - f->file_features &= ~COB_FILE_LS_SPLIT; - if(file_setptr->cob_ls_nulls) - f->file_features |= COB_FILE_LS_NULLS; - else - f->file_features &= ~COB_FILE_LS_NULLS; - if(file_setptr->cob_ls_validate - && !f->flag_line_adv) - f->file_features |= COB_FILE_LS_VALIDATE; - else - f->file_features &= ~COB_FILE_LS_VALIDATE; - } - } -} - -/* - * Set file format based on IO_filename options - */ -static void -cob_set_file_format (cob_file *f, char *defstr, int updt, int *ret) -{ - int i,j,settrue,ivalue,nkeys,keyn,xret,idx; - unsigned int maxrecsz; - char qt,option[64],value[COB_FILE_BUFF]; - - if (ret) - *ret = 0; - maxrecsz = (unsigned int)f->record->size; - if (f->record_max > maxrecsz) - maxrecsz = f->record_max; - nkeys = f->nkeys; - if(defstr != NULL) { /* Special options for this file */ - for(i=0; defstr[i] != 0; ) { - while(isspace(defstr[i]) /* Skip option separators */ - || defstr[i] == ',' - || defstr[i] == ';') i++; - if(defstr[i] == 0) - break; - ivalue = 0; - for(j=0; j < sizeof(option)-1 && !isspace(defstr[i]) - && defstr[i] != ',' - && defstr[i] != ';' - && defstr[i] != '=' - && defstr[i] != 0; ) { /* Collect one option */ - option[j++] = defstr[i++]; - } - option[j] = 0; - value[0] = 0; - qt = 0; - settrue = 1; - if(strncasecmp(option,"no-",3) == 0) { - memmove(option,&option[3],j); - settrue = 0; - } else - if(strncasecmp(option,"no_",3) == 0) { - memmove(option,&option[3],j); - settrue = 0; - } else - if(strncasecmp(option,"no",2) == 0) { - memmove(option,&option[2],j); - settrue = 0; - } - if(defstr[i] == '=') { - i++; - while(defstr[i] == ' ') i++; - if(defstr[i] == '(') { - i++; - for(j=0; j < sizeof(value)-1 - && defstr[i] != ')' - && defstr[i] != 0; ) { /* Collect complete option */ - value[j++] = defstr[i++]; - } - if(defstr[i] == ')') i++; - value[j] = 0; - } else if(defstr[i] == '"') { - qt = '"'; - i++; - for(j=0; j < sizeof(value)-1 - && defstr[i] != '"' - && defstr[i] != 0; ) { /* Collect complete option */ - value[j++] = defstr[i++]; - } - value[j] = 0; - if(defstr[i] == '"') i++; - } else if(defstr[i] == '\'') { - qt = '\''; - i++; - for(j=0; j < sizeof(value)-1 - && defstr[i] != '\'' - && defstr[i] != 0; ) { /* Collect complete option */ - value[j++] = defstr[i++]; - } - value[j] = 0; - if(defstr[i] == '\'') i++; - } else { - for(j=0; j < sizeof(value)-1 && !isspace(defstr[i]) - && defstr[i] != ',' - && defstr[i] != ';' - && defstr[i] != 0; ) { /* Collect one option */ - if(isdigit(defstr[i])) - ivalue = ivalue * 10 + defstr[i] - '0'; - value[j++] = defstr[i++]; - } - value[j] = 0; - if(value[0] == '1' - || toupper((unsigned char)value[0]) == 'T' - || strcasecmp(value,"on") == 0) - settrue = 1; - if(value[0] == '0' - || toupper((unsigned char)value[0]) == 'F' - || strcasecmp(value,"off") == 0) - settrue = 0; - } - } - - if(strcasecmp(option,"sync") == 0) { - if(settrue) - f->file_features |= COB_FILE_SYNC; - else - f->file_features &= ~COB_FILE_SYNC; - continue; - } - if(strcasecmp(option,"trace") == 0) { - f->trace_io = settrue; - continue; - } - if(strcasecmp(option,"stats") == 0) { - f->io_stats = settrue; - continue; - } - if(strcasecmp(option,"keycheck") == 0) { - f->flag_keycheck = settrue; - continue; - } - if(keycmp(option,"retry_times") == 0) { - f->dflt_times = atoi(value); - f->dflt_retry |= COB_RETRY_TIMES; - continue; - } - if(keycmp(option,"retry_seconds") == 0) { - f->dflt_seconds = atoi(value); - f->dflt_retry |= COB_RETRY_SECONDS; - continue; - } - if (strcasecmp(option,"type") == 0) { - if (updt - && (f->organization == COB_ORG_SEQUENTIAL || f->organization == COB_ORG_RELATIVE) - && f->access_mode == COB_ACCESS_SEQUENTIAL) { - if(strcasecmp(value,"IX") == 0) { - f->organization = COB_ORG_INDEXED; - f->flag_set_isam = 1; - } else if(strcasecmp(value,"RL") == 0) { - f->organization = COB_ORG_RELATIVE; - } else if(strcasecmp(value,"SQ") == 0) { - f->organization = COB_ORG_SEQUENTIAL; - } else if(strcasecmp(value,"LS") == 0) { - f->organization = COB_ORG_LINE_SEQUENTIAL; - f->flag_line_adv = 0; - } else if(strcasecmp(value,"LA") == 0) { - f->organization = COB_ORG_LINE_SEQUENTIAL; - f->flag_line_adv = 1; - } - cob_set_file_defaults (f); - } - continue; - } - if (strcasecmp(option,"recsz") == 0) { - if (ivalue <= 0 || ivalue > (int)maxrecsz) - continue; - if (ivalue == f->record_max && ivalue == f->record_min) - continue; - f->flag_redef = 1; - f->record_min = f->record_max = ivalue; - f->record->size = ivalue; - if (f->variable_record) { - cob_set_int (f->variable_record, (int) f->record->size); - } - if (f->file_format == COB_FILE_IS_MF) { - f->record_prefix = 0; - f->file_header = 0; - } - continue; - } - if (strcasecmp(option,"maxsz") == 0) { - if(ivalue <= 0 || ivalue > (int)maxrecsz) - continue; - if(ivalue == f->record_max) - continue; - if(f->record_min == f->record_max) - f->record_min = f->record_max = ivalue; - else - f->record_max = ivalue; - f->flag_redef = 1; - continue; - } - if (strcasecmp(option,"minsz") == 0) { - if(ivalue <= 0 || ivalue > (int)maxrecsz) - continue; - if(ivalue == (int)f->record_max) - continue; - f->record_min = ivalue; - f->flag_redef = 1; - continue; - } - if(strcasecmp(option,"format") == 0) { - for(j=0; j < COB_IO_MAX; j++) { - if(strcasecmp(value,io_rtn_name[j]) == 0) { - if(fileio_funcs[j] == NULL) { - cob_runtime_error (_("I/O routine %s is not present for %s"), - io_rtn_name[j],file_open_env); - } else { - f->flag_set_isam = 1; - f->io_routine = (unsigned char)j; - } - break; - } - } - if(j >= COB_IO_MAX) { - if(strcasecmp(value,"auto") == 0) { - f->flag_auto_type = 1; - } else if(strcasecmp(value,"mf") == 0) { - f->file_format = COB_FILE_IS_MF; - f->flag_set_type = 1; - } else if(strcasecmp(value,"gc") == 0) { - f->file_format = COB_FILE_IS_GC; - f->flag_set_type = 1; - } else if(strcasecmp(value,"0") == 0) { - f->file_format = COB_FILE_IS_GCVS0; - } else if(strcasecmp(value,"1") == 0) { - f->file_format = COB_FILE_IS_GCVS1; - } else if(strcasecmp(value,"2") == 0) { - f->file_format = COB_FILE_IS_GCVS2; - } else if(strcasecmp(value,"3") == 0) { - f->file_format = COB_FILE_IS_GCVS3; - } else if(strcasecmp(value,"b4") == 0 - || strcasecmp(value,"b32") == 0) { - f->file_format = COB_FILE_IS_B32; - } else if(strcasecmp(value,"l4") == 0 - || strcasecmp(value,"l32") == 0) { - f->file_format = COB_FILE_IS_L32; - } else if(strcasecmp(value,"b8") == 0 - || strcasecmp(value,"b64") == 0) { - f->file_format = COB_FILE_IS_B64; - } else if(strcasecmp(value,"l8") == 0 - || strcasecmp(value,"l64") == 0) { - f->file_format = COB_FILE_IS_L64; - } else { - cob_runtime_warning (_("I/O routine %s is not known for %s"), - value,file_open_env); - } - } - continue; - } - if(strcasecmp(option,"schema") == 0) { - if (isdirname(value)) { - f->xfdschema = cob_strdup (value); - } else { - f->xfdschema = cob_cache_malloc (strlen(value) + strlen(COB_SCHEMA_DIR) + 8); - sprintf((char*)f->xfdschema, "%s%c%s",COB_SCHEMA_DIR,SLASH_CHAR,value); - } - continue; - } - if(strcasecmp(option,"table") == 0) { - f->xfdname = cob_strdup (value); - continue; - } - if(keycmp(option,"big_endian") == 0) { - f->flag_big_endian = 1; - f->flag_little_endian = 0; - continue; - } - if(keycmp(option,"little_endian") == 0) { - f->flag_big_endian = 0; - f->flag_little_endian = 1; - continue; - } - if(keycmp(option,"retry_forever") == 0) { - f->dflt_retry = COB_RETRY_FOREVER; - continue; - } - if(keycmp(option,"retry_never") == 0) { - f->dflt_retry = COB_RETRY_NEVER; - continue; - } - if(keycmp(option,"ignore_lock") == 0) { - f->dflt_retry |= COB_IGNORE_LOCK; - continue; - } - if(keycmp(option,"advancing_lock") == 0) { - f->dflt_retry |= COB_ADVANCING_LOCK; - continue; - } - if(keycmp(option,"share_all") == 0) { - f->dflt_share = COB_SHARE_ALL_OTHER; - continue; - } - if(keycmp(option,"share_read") == 0) { - f->dflt_share = COB_SHARE_READ_ONLY; - continue; - } - if(keycmp(option,"share_no") == 0) { - f->dflt_share = COB_SHARE_NO_OTHER; - continue; - } - if (f->organization == COB_ORG_LINE_SEQUENTIAL) { - if(keycmp(option,"ls_nulls") == 0) { - if(settrue) - f->file_features |= COB_FILE_LS_NULLS; - else - f->file_features &= ~COB_FILE_LS_NULLS; - continue; - } - if(keycmp(option,"ls_fixed") == 0) { - if(settrue) - f->file_features |= COB_FILE_LS_FIXED; - else - f->file_features &= ~COB_FILE_LS_FIXED; - continue; - } - if(keycmp(option,"ls_split") == 0) { - if(settrue) - f->file_features |= COB_FILE_LS_SPLIT; - else - f->file_features &= ~COB_FILE_LS_SPLIT; - continue; - } - if(keycmp(option,"ls_validate") == 0) { - if(settrue) - f->file_features |= COB_FILE_LS_VALIDATE; - else - f->file_features &= ~COB_FILE_LS_VALIDATE; - continue; - } - if(strcasecmp(option,"crlf") == 0) { - if(settrue) - f->file_features |= COB_FILE_LS_CRLF; - else - f->file_features &= ~COB_FILE_LS_CRLF; - continue; - } - if(strcasecmp(option,"lf") == 0) { - if(settrue) { - f->file_features &= ~COB_FILE_LS_CRLF; - f->file_features |= COB_FILE_LS_LF; - } else { - f->file_features &= ~COB_FILE_LS_LF; - } - continue; - } - if(strcasecmp(option,"mf") == 0) { /* LS file like MF would do */ - f->flag_set_type = 1; - f->file_features &= ~COB_FILE_LS_FIXED; - f->file_features |= COB_FILE_LS_NULLS; - f->file_features |= COB_FILE_LS_SPLIT; - f->file_features &= ~COB_FILE_LS_VALIDATE; -#ifdef _WIN32 - f->file_features |= COB_FILE_LS_CRLF; -#else - f->file_features |= COB_FILE_LS_LF; -#endif - continue; - } - if(strcasecmp(option,"gc") == 0) { /* LS file like GnuCOBOL used to do */ - f->flag_set_type = 1; - f->file_features &= ~COB_FILE_LS_FIXED; - f->file_features &= ~COB_FILE_LS_NULLS; - f->file_features &= ~COB_FILE_LS_SPLIT; - f->file_features &= ~COB_FILE_LS_VALIDATE; -#ifdef _WIN32 - f->file_features |= COB_FILE_LS_CRLF; -#else - f->file_features |= COB_FILE_LS_LF; -#endif - continue; - } - } - if(strcasecmp(option,"mf") == 0) { - if(settrue) { - f->file_format = COB_FILE_IS_MF; - f->flag_set_type = 1; - continue; - } - continue; - } - if(strcasecmp(option,"gc") == 0) { - if(settrue) { - f->file_format = COB_FILE_IS_GC; - f->flag_set_type = 1; - continue; - } - continue; - } - if (f->organization == COB_ORG_SEQUENTIAL - && f->record_min != f->record_max) { /* Variable length Sequential */ - if(strcasecmp(option,"0") == 0) { - f->file_format = COB_FILE_IS_GCVS0; - } else - if(strcasecmp(option,"1") == 0) { - f->file_format = COB_FILE_IS_GCVS1; - } else - if(strcasecmp(option,"2") == 0) { - f->file_format = COB_FILE_IS_GCVS2; - } else - if(strcasecmp(option,"3") == 0) { - f->file_format = COB_FILE_IS_GCVS3; - } else - if(strcasecmp(option,"b4") == 0 - || strcasecmp(option,"b32") == 0) { - f->file_format = COB_FILE_IS_B32; - } else - if(strcasecmp(option,"l4") == 0 - || strcasecmp(option,"l32") == 0) { - f->file_format = COB_FILE_IS_L32; - } else - if(strcasecmp(option,"b8") == 0 - || strcasecmp(option,"b64") == 0) { - f->file_format = COB_FILE_IS_B64; - } else - if(strcasecmp(option,"l8") == 0 - || strcasecmp(option,"l64") == 0) { - f->file_format = COB_FILE_IS_L64; - } - f->flag_set_type = 1; - } - if (f->organization == COB_ORG_RELATIVE) { /* Relative format */ - if(strcasecmp(option,"b4") == 0 - || strcasecmp(option,"b32") == 0) { - f->file_format = COB_FILE_IS_B32; - } else - if(strcasecmp(option,"l4") == 0 - || strcasecmp(option,"l32") == 0) { - f->file_format = COB_FILE_IS_L32; - } else - if(strcasecmp(option,"b8") == 0 - || strcasecmp(option,"b64") == 0) { - f->file_format = COB_FILE_IS_B64; - } else - if(strcasecmp(option,"l8") == 0 - || strcasecmp(option,"l64") == 0) { - f->file_format = COB_FILE_IS_L64; - } - f->flag_set_type = 1; - } - if (f->organization == COB_ORG_INDEXED) { - if (strcasecmp(option,"nkeys") == 0) { - nkeys = ivalue; - if ((int)f->nkeys != nkeys - && !updt - && f->flag_keycheck) { - if(ret) - *ret = COB_STATUS_39_CONFLICT_ATTRIBUTE; - break; - } - if (updt - && (int)f->nkeys != nkeys) { - if(nkeys > (int)f->nkeys) { - f->keys = cob_cache_realloc (f->keys, sizeof (cob_file_key) * nkeys); - f->flag_redo_keydef = 1; - } - f->nkeys = nkeys; - } else { - nkeys = (int)f->nkeys; - } - continue; - } - if (strncasecmp(option,"key",3) == 0) { - keyn = atoi (&option[3]); - if (keyn > (int)f->nkeys - && !f->flag_keycheck - && !updt) { /* Skip this key def */ - continue; - } - if(keyn > nkeys) - continue; - xret = 0; - cob_key_def (f, keyn, value, &xret, updt?0:f->flag_keycheck); - if(ret) *ret = xret; - if(xret != 0) break; - - } else if (strncasecmp(option,"dup",3) == 0) { - keyn = atoi (&option[3]); - idx = keyn - 1; - if (keyn > nkeys) /* Skip this */ - continue; - - if (toupper(value[0]) == 'Y' - && f->flag_keycheck - && !updt - && !f->keys[idx].tf_duplicates) - break; - if (toupper(value[0]) == 'Y') - f->keys[idx].tf_duplicates = 1; - else - f->keys[idx].tf_duplicates = 0; - } else if (strncasecmp(option,"sup",3) == 0) { - unsigned char subchr; - keyn = atoi (&option[3]); - if(keyn > nkeys) - continue; - idx = keyn - 1; - if (qt != 0) { - subchr = value[0]; - } else if (value[0] == 'x') { - subchr = (unsigned char) strtol (&value[2], NULL, 16); - } else { - subchr = 0; - } - if (f->flag_keycheck - && !updt - && !f->keys[idx].tf_suppress) - break; - f->keys[idx].char_suppress = subchr; - f->keys[idx].tf_suppress = 1; - } else if (strncasecmp(option,"skip",4) == 0) { - keyn = atoi (&option[4]); - if(keyn > nkeys) - continue; - idx = keyn - 1; - if (f->flag_keycheck - && !updt - && !f->keys[idx].tf_suppress) - break; - f->keys[idx].str_suppress = (unsigned char *)cob_strdup (value); - f->keys[idx].len_suppress = (short)strlen (value); - } - } - } - - /* If SHARE or RETRY given, then override application choices */ - if(f->dflt_share != 0) - f->share_mode = f->dflt_share; - if(f->dflt_retry != 0) { - f->retry_mode = f->dflt_retry; - f->retry_times = f->dflt_times; - f->retry_seconds = f->dflt_seconds; - } - } - - f->record_off = -1; - f->flag_begin_of_file = 1; - f->record_prefix = 0; - f->file_header = 0; - /* Set File type specific values */ - if (f->organization == COB_ORG_SEQUENTIAL) { - f->record_slot = f->record_max + f->record_prefix; - if(f->record_min != f->record_max) { - if(f->file_format == COB_FILE_IS_GC - || f->file_format == COB_FILE_IS_GCVS0 - || f->file_format == COB_FILE_IS_GCVS1 - || f->file_format == COB_FILE_IS_GCVS2) { - f->record_prefix = 4; - f->record_slot = f->record_max + f->record_prefix; - } else - if(f->file_format == COB_FILE_IS_GCVS3) { - f->record_prefix = 2; - f->record_slot = f->record_max + f->record_prefix; - } else - if(f->file_format == COB_FILE_IS_L32 - || f->file_format == COB_FILE_IS_B32) { - f->record_prefix = 4; - f->record_slot = f->record_max + f->record_prefix; - } else - if(f->file_format == COB_FILE_IS_MF) { - f->record_prefix = 4; - f->file_header = 128; - f->record_slot = f->record_max + f->record_prefix + 1; - } else { - f->record_prefix = 4; - f->record_slot = f->record_max + f->record_prefix; - } - } - } else - if (f->organization == COB_ORG_RELATIVE) { - f->record_prefix = sizeof(size_t); - f->record_slot = f->record_max + f->record_prefix; - if(f->file_format == COB_FILE_IS_B32 - || f->file_format == COB_FILE_IS_L32) { - f->record_prefix = 4; - f->record_slot = f->record_max + f->record_prefix; - } else - if(f->file_format == COB_FILE_IS_B64 - || f->file_format == COB_FILE_IS_L64) { - f->record_prefix = 8; - f->record_slot = f->record_max + f->record_prefix; - } else - if(f->file_format == COB_FILE_IS_MF) { - if(f->record_min != f->record_max) { /* Variable length Relative */ - if(f->record_max < 4096) { - f->record_prefix = 2; - } else { - f->record_prefix = 4; - } - f->file_header = 128; - f->record_slot = f->record_max + f->record_prefix + 1; - } else { - f->record_prefix = 0; - f->record_slot = f->record_max + 1; - } - } - } -} - -#ifdef HAVE_FCNTL -#if defined(HAVE_SIGACTION) && defined(SIGALRM) -static void catch_alarm(int sig) { } -#endif - -/* - * Issue File/Record lock - */ -static int -lock_record( - cob_file *f, - unsigned int recnum, - int forwrite, - int *errsts) -{ -#if defined(HAVE_SIGACTION) && defined(SIGALRM) - struct sigaction sigact, prvact; - int wait_time; -#endif - int lock_type, retry, interval; - unsigned long pos; - unsigned int rcsz; - struct flock lck; - - lock_type = forwrite ? F_WRLCK : F_RDLCK; - retry = interval = 0; - if (f->retry_mode == 0) { - /* Nothing else to do */ - } else - if ((f->retry_mode & COB_RETRY_FOREVER)) { - retry = -1; - } else - if ((f->retry_mode & COB_RETRY_SECONDS)) { - retry = 1; - interval = f->retry_seconds>0?f->retry_seconds: - (file_setptr->cob_retry_seconds>0?file_setptr->cob_retry_seconds:1); - } else - if ((f->retry_mode & COB_RETRY_TIMES)) { - retry = f->retry_times>0?f->retry_times: - (file_setptr->cob_retry_times>0?file_setptr->cob_retry_times:1); - interval = file_setptr->cob_retry_seconds>0?file_setptr->cob_retry_seconds:1; - } - if(recnum == 0) { /* Lock entire file */ - pos = 0; - rcsz = 0; - f->flag_file_lock = 0; - } else { - rcsz = (unsigned int)f->record_max; - if(rcsz <= 0) - rcsz = 2; - if(f->record_slot <= 0) - f->record_slot = rcsz + 1; - pos = (unsigned long)(f->file_header+((recnum-1)*f->record_slot)); - } - memset(&lck,0,sizeof(struct flock)); - lck.l_type = lock_type; - lck.l_whence = SEEK_SET; - lck.l_start = pos; - lck.l_len = rcsz; - if (fcntl (f->fd, F_SETLK, &lck) != -1) { - *errsts = 0; - if(recnum == 0 - && forwrite) /* File locked for Exclusive use */ - f->flag_file_lock = 1; - return 1; /* Got the lock so all is good */ - } - *errsts = errno; - if(retry == 0) { /* No RETRY, so return with no lock */ - if(errno == EAGAIN) { - lck.l_type = lock_type; - lck.l_whence = SEEK_SET; - lck.l_start = pos; - lck.l_len = rcsz; - if (fcntl (f->fd, F_GETLK, &lck) == -1) { - if(lck.l_pid == cob_sys_getpid()) { /* Is locked by me */ - return 1; - } - } - } - return 0; - } - if(interval <= 0) - interval = COB_RETRY_PER_SECOND ; - -#if defined(HAVE_SIGACTION) && defined(SIGALRM) - if(retry > 0) { /* Negative means wait forever */ - memset(&prvact,0,sizeof(sigact)); - prvact.sa_handler = SIG_DFL; - memset(&sigact,0,sizeof(sigact)); - sigact.sa_handler = catch_alarm; - sigaction(SIGALRM, &sigact, &prvact); - wait_time = retry * interval; - alarm(wait_time); - } - if (fcntl (f->fd, F_SETLKW, &lck) != -1) { - if(retry > 0) { - sigaction(SIGALRM, &prvact, NULL); - alarm(0); - } - *errsts = 0; - if(recnum == 0 - && forwrite) /* File locked for Exclusive use */ - f->flag_file_lock = 1; - return 1; /* Got the lock so all is good */ - } - *errsts = errno; - if(retry > 0) { - sigaction(SIGALRM, &prvact, NULL); - alarm(0); - if(*errsts == EINTR) /* Timed out, so return EAGAIN */ - *errsts = EAGAIN; - } - return 0; /* Record is not locked! */ -#else - if (retry > 0) { - retry = retry * 4; - interval = (interval * 1000) / 4; - while(retry-- > 0) { - lck.l_type = lock_type; - lck.l_whence = SEEK_SET; - lck.l_start = pos; - lck.l_len = rcsz; - *errsts = 0; - if (fcntl (f->fd, F_SETLK, &lck) != -1) { - if(recnum == 0 - && forwrite) /* File locked for Exclusive use */ - f->flag_file_lock = 1; - return 1; /* Got the lock so all is good */ - } - *errsts = errno; - cob_sleep_msec(interval); - } - } else { - while(1) { - lck.l_type = lock_type; - lck.l_whence = SEEK_SET; - lck.l_start = pos; - lck.l_len = rcsz; - *errsts = 0; - if (fcntl (f->fd, F_SETLK, &lck) != -1) { - if(recnum == 0 - && forwrite) /* File locked for Exclusive use */ - f->flag_file_lock = 1; - return 1; /* Got the lock so all is good */ - } - *errsts = errno; - cob_sleep_msec(250); - } - } - return 0; /* Record is not locked! */ -#endif -} - -/* - * Un-Lock 'recnum' with system - */ -static int -unlock_record(cob_file *f, unsigned int recnum) -{ - unsigned long pos; - unsigned int rcsz; - struct flock lck; - - if(recnum == 0) { /* Un-Lock entire file */ - pos = 0; - rcsz = 0; - f->flag_file_lock = 0; - } else { - rcsz = (unsigned int)f->record_max; - if(rcsz <= 0) - rcsz = 2; - if(f->record_slot <= 0) - f->record_slot = rcsz + 1; - pos = (unsigned long)(f->file_header+((recnum-1)*f->record_slot)); - } - lck.l_type = F_UNLCK; - lck.l_whence = SEEK_SET; - lck.l_start = pos; - lck.l_len = rcsz; - errno = 0; - if (fcntl (f->fd, F_SETLK, &lck) != -1) { - return 1; /* Released the lock so all is good */ - } - return 0; /* Record is not locked! */ -} - -#else - /* System does not even have 'fcntl' so no explicit Record/File lock is used */ - /* TODO: check later for possible fall-back [at least WIN32]*/ -static int -lock_record( - cob_file *f, - unsigned int recnum, - int forwrite, - int *errsts) -{ - COB_UNUSED (f); - COB_UNUSED (recnum); - COB_UNUSED (forwrite); - *errsts = 0; - return 1; -} - -static int -unlock_record(cob_file *f, unsigned int recnum) -{ - COB_UNUSED (f); - COB_UNUSED (recnum); - return 1; -} - -#endif - -/* - * Determine if file should be locked - */ -static int -set_file_lock(cob_file *f, const char *filename, int open_mode) -{ - int lock_mode, ret; - - f->flag_record_lock = 0; - f->flag_file_lock = 0; - if (memcmp (filename, "/dev/", (size_t)5) == 0) /* Do not lock Devices */ - return 0; - - if ((f->share_mode & COB_SHARE_ALL_OTHER) - && ((open_mode == COB_OPEN_INPUT) || (open_mode == COB_OPEN_I_O))) {/* File is SHARE ALL */ - f->flag_record_lock = 1; - return 0; - } - - /* Lock the file */ - if ((f->share_mode & COB_SHARE_ALL_OTHER)) { - if (open_mode == COB_OPEN_OUTPUT) - lock_mode = 1; - else - lock_mode = 0; - } else if ((open_mode != COB_OPEN_INPUT) - || (f->share_mode & COB_SHARE_NO_OTHER) - || (f->share_mode & COB_LOCK_OPEN_EXCLUSIVE) - || (f->lock_mode & COB_FILE_EXCLUSIVE) ) { - lock_mode = 1; - } else { - lock_mode = 0; - } - - lock_record (f, 0, lock_mode, &ret); - if (ret != 0) { - if(f->file) - fclose(f->file); - else - close (f->fd); - f->fd = -1; - f->file = NULL; - f->open_mode = COB_OPEN_CLOSED; - switch (ret) { - case EACCES: - case EAGAIN: - case EDEADLK: - return COB_STATUS_61_FILE_SHARING; - default: - return COB_STATUS_30_PERMANENT_ERROR; - } - } - if (!f->flag_file_lock) { - if ((open_mode != COB_OPEN_INPUT) - && (f->share_mode & COB_SHARE_ALL_OTHER)) { - f->flag_record_lock = 1; - } - } - return 0; -} - -/* - * Determine if current record should be locked and if previous lock to be released - */ -static void -set_lock_opts(cob_file *f, unsigned int read_opts) -{ - f->flag_lock_mode = 0; /* READ lock */ - if (f->retry_mode == 0 - && f->dflt_retry != 0) { /* Use IO_filename RETRY values */ - f->retry_mode = f->dflt_retry; - f->retry_times = f->dflt_times; - f->retry_seconds = f->dflt_seconds; - } - if (f->flag_file_lock) { /* File is EXCLUSIVE */ - f->flag_lock_rec = 0; - f->flag_lock_rls = 0; - return; - } - if (!f->lock_mode) { - if (f->open_mode != COB_OPEN_INPUT) { - f->flag_lock_rec = 0; - f->flag_lock_rls = 0; - } else { - f->flag_lock_rec = 1; - f->flag_lock_rls = 1; - } - } else if (f->flag_file_lock) { - f->flag_lock_rec = 0; - f->flag_lock_rls = 0; - } else if ((f->lock_mode & COB_LOCK_AUTOMATIC) - && (f->open_mode != COB_OPEN_INPUT)) { - f->flag_lock_rec = 1; - if ((f->lock_mode & COB_LOCK_MULTIPLE)) { - f->flag_lock_rls = 0; - } else { - f->flag_lock_rls = 1; - } - } else { - f->flag_lock_rec = 1; - if ((f->lock_mode & COB_LOCK_MULTIPLE)) { - f->flag_lock_rls = 0; - } else { - f->flag_lock_rls = 1; - } - } - - if ((read_opts & COB_READ_IGNORE_LOCK) - || (f->retry_mode & COB_IGNORE_LOCK)) { - f->flag_lock_rec = 0; - f->flag_lock_rls = 0; - f->flag_lock_mode = 0; - } else - if ( (read_opts & COB_READ_LOCK) ) { - f->flag_lock_rec = 1; - f->flag_lock_mode = 1; - } else - if ( (read_opts & COB_READ_WAIT_LOCK) ) { - f->flag_lock_rec = 1; - f->flag_lock_mode = 1; - } else - if ( (read_opts & COB_READ_NO_LOCK) ) { - f->flag_lock_rec = 0; - f->flag_lock_rls = 0; - } else - if ( (read_opts & COB_READ_KEPT_LOCK) ) { - f->flag_lock_rec = 1; - f->flag_lock_rls = 0; - } - - if (f->flag_lock_rls && f->prev_lock) { - unlock_record (f, f->prev_lock); - f->prev_lock = 0; - } -} - -void -cob_file_save_status (cob_file *f, cob_field *fnstatus, const int status) -{ - int k, indent = 15; - struct stat st; - FILE *fo; - char prcoma[6]; - const char *iotype[11]; - struct cob_time tod; - - file_globptr->cob_error_file = f; - if (likely(status == 0)) { - memset (f->file_status, '0', (size_t)2); - if (fnstatus) { - memset (fnstatus->data, '0', (size_t)2); - } - /* EOP is non-fatal therefore 00 status but needs exception */ - if (unlikely (eop_status)) { - eop_status = 0; - cob_set_exception (COB_EC_I_O_EOP); - } else { - file_globptr->cob_exception_code = 0; - } - if ((f->file_features & COB_FILE_SYNC)) { - cob_file_sync (f); - } - } else { - cob_set_exception (status_exception[status / 10]); - f->file_status[0] = (unsigned char)COB_I2D (status / 10); - f->file_status[1] = (unsigned char)COB_I2D (status % 10); - if (fnstatus) { - memcpy (fnstatus->data, f->file_status, (size_t)2); - } - } - - if (file_setptr->cob_line_trace - && f->trace_io - && f->last_operation > 0) { - if (file_setptr->cob_trace_file == NULL - && file_setptr->cob_trace_filename != NULL) { - /* Open so that I/O can be traced by itself */ - file_setptr->cob_trace_file = fopen (file_setptr->cob_trace_filename, "w"); - if (!file_setptr->cob_trace_file) { - file_setptr->cob_trace_file = stderr; - } - } - if (file_setptr->cob_trace_file) { - fprintf(file_setptr->cob_trace_file,"%*s",indent-3,""); - switch (f->last_operation) { - default: - fprintf(file_setptr->cob_trace_file,"Unknown I/O on %s Status: %.2s\n", - f->select_name,f->file_status); - break; - case COB_LAST_CLOSE: - fprintf(file_setptr->cob_trace_file,"CLOSE %s Status: %.2s\n", - f->select_name,f->file_status); - break; - case COB_LAST_COMMIT: - fprintf(file_setptr->cob_trace_file,"COMMIT %s Status: %.2s\n", - f->select_name,f->file_status); - break; - case COB_LAST_ROLLBACK: - fprintf(file_setptr->cob_trace_file,"ROLLBACK %s Status: %.2s\n", - f->select_name,f->file_status); - break; - case COB_LAST_OPEN: - fprintf(file_setptr->cob_trace_file,"OPEN %s %s -> '%s' Status: %.2s\n", - f->open_mode == COB_OPEN_INPUT ? "INPUT" : - f->open_mode == COB_OPEN_OUTPUT ? "OUTPUT" : - f->open_mode == COB_OPEN_I_O ? "I_O" : - f->open_mode == COB_OPEN_EXTEND ? "EXTEND" : "", - f->select_name, - file_open_name?file_open_name:"", - f->file_status); - break; - case COB_LAST_DELETE_FILE: - fprintf(file_setptr->cob_trace_file,"DELETE FILE %s Status: %.2s\n", - f->select_name,f->file_status); - break; - case COB_LAST_READ: - fprintf(file_setptr->cob_trace_file,"READ %s Status: %.2s\n", - f->select_name,f->file_status); - if (status == 0) { - fprintf(file_setptr->cob_trace_file,"%*s : ",indent,"Record"); - cob_print_field(file_setptr->cob_trace_file,f->record, - indent+3, file_setptr->cob_dump_width); - } - if (f->last_key) { - fprintf(file_setptr->cob_trace_file,"%*s : ",indent, - f->organization == COB_ORG_RELATIVE ? "Record#":"Key"); - cob_print_field(file_setptr->cob_trace_file,f->last_key, - indent+3, file_setptr->cob_dump_width); - } - break; - case COB_LAST_START: - fprintf(file_setptr->cob_trace_file,"START %s Status: %.2s\n", - f->select_name,f->file_status); - if (f->last_key) { - fprintf(file_setptr->cob_trace_file,"%*s : ",indent, - f->organization == COB_ORG_RELATIVE ? "Record#":"Key"); - cob_print_field(file_setptr->cob_trace_file,f->last_key, - indent+3, file_setptr->cob_dump_width); - } - break; - case COB_LAST_READ_SEQ: - fprintf(file_setptr->cob_trace_file,"READ Sequential %s Status: %.2s\n", - f->select_name,f->file_status); - if (status == 0) { - fprintf(file_setptr->cob_trace_file,"%*s : ",indent,"Record"); - cob_print_field(file_setptr->cob_trace_file,f->record, - indent+3, file_setptr->cob_dump_width); - } - if (f->last_key - && f->organization == COB_ORG_RELATIVE) { - fprintf(file_setptr->cob_trace_file,"%*s : ",indent,"Record#"); - cob_print_field(file_setptr->cob_trace_file,f->last_key, - indent+3, file_setptr->cob_dump_width); - } - break; - case COB_LAST_WRITE: - fprintf(file_setptr->cob_trace_file,"WRITE %s Status: %.2s\n", - f->select_name,f->file_status); - fprintf(file_setptr->cob_trace_file,"%*s : ",indent,"Record"); - cob_print_field(file_setptr->cob_trace_file,f->record, - indent+3, file_setptr->cob_dump_width); - if (f->last_key - && f->organization == COB_ORG_RELATIVE) { - fprintf(file_setptr->cob_trace_file,"%*s : ",indent,"Record#"); - cob_print_field(file_setptr->cob_trace_file,f->last_key, - indent+3, file_setptr->cob_dump_width); - } - break; - case COB_LAST_REWRITE: - fprintf(file_setptr->cob_trace_file,"REWRITE %s Status: %.2s\n", - f->select_name,f->file_status); - fprintf(file_setptr->cob_trace_file,"%*s : ",indent,"Record"); - cob_print_field(file_setptr->cob_trace_file,f->record, - indent+3, file_setptr->cob_dump_width); - if (f->last_key - && f->organization == COB_ORG_RELATIVE) { - fprintf(file_setptr->cob_trace_file,"%*s : ",indent,"Record#"); - cob_print_field(file_setptr->cob_trace_file,f->last_key, - indent+3, file_setptr->cob_dump_width); - } - break; - case COB_LAST_DELETE: - fprintf(file_setptr->cob_trace_file,"DELETE %s Status: %.2s\n", - f->select_name,f->file_status); - fprintf(file_setptr->cob_trace_file,"%*s : ",indent,"Record"); - cob_print_field(file_setptr->cob_trace_file,f->record, - indent+3, file_setptr->cob_dump_width); - if (f->last_key - && f->organization == COB_ORG_RELATIVE) { - fprintf(file_setptr->cob_trace_file,"%*s : ",indent,"Record#"); - cob_print_field(file_setptr->cob_trace_file,f->last_key, - indent+3, file_setptr->cob_dump_width); - } - break; - } - } - } - - if (f->io_stats - && file_setptr->cob_stats_filename - && f->last_operation > 0) { - if (f->last_operation <= 6) { - f->stats[f->last_operation-1].rqst_io++; - if (status != 0 - && status != 2) { - f->stats[f->last_operation-1].fail_io++; - } - } - if (f->last_operation == COB_LAST_CLOSE) { /* Write stats out on FILE Close */ - fo = NULL; - if (stat(file_setptr->cob_stats_filename, &st) == -1) { - iotype[COB_LAST_READ] = "READ"; - iotype[COB_LAST_WRITE] = "WRITE"; - iotype[COB_LAST_REWRITE] = "REWRITE"; - iotype[COB_LAST_DELETE] = "DELETE"; - iotype[COB_LAST_START] = "START"; - iotype[COB_LAST_READ_SEQ]= "READ_SEQ"; - fo = fopen(file_setptr->cob_stats_filename, "w"); - if (fo) { - fprintf(fo,"%19s,","Time"); - fprintf(fo,"%s"," Source, FDSelect, "); - strcpy(prcoma,""); - for (k=1; k <= 6; k++) { - fprintf(fo,"%s%s",prcoma,iotype[k]); - strcpy(prcoma,","); - } - strcpy(prcoma,""); - fprintf(fo,", "); - for (k=1; k <= 6; k++) { - fprintf(fo,"%sX%s",prcoma,iotype[k]); - strcpy(prcoma,","); - } - fprintf(fo,"\n"); - fclose(fo); - fo = NULL; - } - } - if (fo == NULL) { - fo = fopen(file_setptr->cob_stats_filename, "a"); - } - if (fo) { - tod = cob_get_current_date_and_time (); - fprintf(fo,"%04d/%02d/%02d %02d:%02d:%02d,", - tod.year,tod.month,tod.day_of_month, - tod.hour,tod.minute,tod.second); - if (COB_MODULE_PTR - && COB_MODULE_PTR->module_source) - fprintf(fo,"%s",COB_MODULE_PTR->module_source); - else - fprintf(fo,"%s","Unknown"); - fprintf(fo,",%s, ",f->select_name); - strcpy(prcoma,""); - for (k=0; k <= 5; k++) { - fprintf(fo,"%s%d",prcoma,f->stats[k].rqst_io); - strcpy(prcoma,","); - } - fprintf(fo,", "); - strcpy(prcoma,""); - for (k=0; k <= 5; k++) { - fprintf(fo,"%s%d",prcoma,f->stats[k].fail_io); - strcpy(prcoma,","); - } - fprintf(fo,"\n"); - fclose(fo); - } - for (k=0; k <= 5; k++) { /* Reset counts on CLOSE */ - f->stats[k].rqst_io = 0; - f->stats[k].fail_io = 0; - } - } - } - if (f->fcd) - cob_file_fcd_sync (f); /* Copy cob_file to app's FCD */ - f->last_operation = 0; /* Avoid double count/trace */ - f->retry_mode = f->dflt_retry; - f->retry_times = f->dflt_times; - f->retry_seconds = f->dflt_seconds; -} - -/* Regular file */ - -/* Translate errno status to COBOL status, - Note: always sets either an error or the given default value */ -static int -errno_cob_sts (const int default_status) -{ - switch (errno) { -#ifdef EDQUOT - case EDQUOT: -#endif - case ENOSPC: - return COB_STATUS_34_BOUNDARY_VIOLATION; - case EPERM: - case EACCES: - case EISDIR: - return COB_STATUS_37_PERMISSION_DENIED; - case ENOENT: - return COB_STATUS_35_NOT_EXISTS; - default: - return default_status; - } -} - -#define COB_CHECKED_PUTC(character,fstream) do { \ - if (unlikely (putc ((int)character, fstream) != (int)character)) { \ - return errno_cob_sts (COB_STATUS_30_PERMANENT_ERROR); \ - } \ - } ONCE_COB /* LCOV_EXCL_LINE */ - -#define COB_CHECKED_WRITE(fd,string,length) do { \ - if (unlikely (write (fd, string, (size_t)length) != (size_t)length)) { \ - return errno_cob_sts (COB_STATUS_30_PERMANENT_ERROR); \ - } \ - } ONCE_COB /* LCOV_EXCL_LINE */ - -#define COB_CHECKED_FWRITE(fstream,string,length) do { \ - if (unlikely (fwrite (string, 1, (size_t)length, fstream) != (size_t)length)) { \ - return errno_cob_sts (COB_STATUS_30_PERMANENT_ERROR); \ - } \ - } ONCE_COB /* LCOV_EXCL_LINE */ - -static size_t -file_linage_check (cob_file *f) -{ - cob_linage *lingptr; - - lingptr = f->linage; - lingptr->lin_lines = cob_get_int (lingptr->linage); - if (lingptr->lin_lines < 1) { - goto linerr; - } - if (lingptr->latfoot) { - lingptr->lin_foot = cob_get_int (lingptr->latfoot); - if (lingptr->lin_foot < 1 || - lingptr->lin_foot > lingptr->lin_lines) { - goto linerr; - } - } else { - lingptr->lin_foot = 0; - } - if (lingptr->lattop) { - lingptr->lin_top = cob_get_int (lingptr->lattop); - if (lingptr->lin_top < 0) { - goto linerr; - } - } else { - lingptr->lin_top = 0; - } - if (lingptr->latbot) { - lingptr->lin_bot = cob_get_int (lingptr->latbot); - if (lingptr->lin_bot < 0) { - goto linerr; - } - } else { - lingptr->lin_bot = 0; - } - return 0; -linerr: - cob_set_int (lingptr->linage_ctr, 0); - return 1; -} - -static int -cob_linage_write_opt (cob_file *f, const int opt) -{ - cob_linage *lingptr; - FILE *fp; - int i; - int n; - - fp = (FILE *)f->file; - lingptr = f->linage; - if (unlikely (opt & COB_WRITE_PAGE)) { - i = cob_get_int (lingptr->linage_ctr); - if (i == 0) { - return COB_STATUS_57_I_O_LINAGE; - } - n = lingptr->lin_lines; - for (; i < n; ++i) { - COB_CHECKED_PUTC ('\n', fp); - } - for (i = 0; i < lingptr->lin_bot; ++i) { - COB_CHECKED_PUTC ('\n', fp); - } - if (file_linage_check (f)) { - return COB_STATUS_57_I_O_LINAGE; - } - for (i = 0; i < lingptr->lin_top; ++i) { - COB_CHECKED_PUTC ('\n', fp); - } - cob_set_int (lingptr->linage_ctr, 1); - } else if (opt & COB_WRITE_LINES) { - n = cob_get_int (lingptr->linage_ctr); - if (n == 0) { - return COB_STATUS_57_I_O_LINAGE; - } - cob_add_int (lingptr->linage_ctr, opt & COB_WRITE_MASK, 0); - i = cob_get_int (lingptr->linage_ctr); - /* Set EOP status if requested */ - if (check_eop_status && lingptr->lin_foot) { - if (i >= lingptr->lin_foot) { - eop_status = 1; - } - } - if (i > lingptr->lin_lines) { - /* Set EOP status if requested */ - if (check_eop_status) { - eop_status = 1; - } - for (; n < lingptr->lin_lines; ++n) { - COB_CHECKED_PUTC ('\n', fp); - } - for (i = 0; i < lingptr->lin_bot; ++i) { - COB_CHECKED_PUTC ('\n', fp); - } - if (file_linage_check (f)) { - return COB_STATUS_57_I_O_LINAGE; - } - cob_set_int (lingptr->linage_ctr, 1); - for (i = 0; i < lingptr->lin_top; ++i) { - COB_CHECKED_PUTC ('\n', fp); - } - } else { - for (i = (opt & COB_WRITE_MASK) - 1; i > 0; --i) { - COB_CHECKED_PUTC ('\n', fp); - } - } - } - return 0; -} - -static unsigned int -cob_seq_write_opt (cob_file *f, const int opt) -{ - int i; - - if (opt & COB_WRITE_LINES) { - i = opt & COB_WRITE_MASK; - if (!i) { - /* AFTER/BEFORE 0 */ - COB_CHECKED_WRITE (f->fd, "\r", 1); - } else { - for (i = opt & COB_WRITE_MASK; i > 0; --i) { - COB_CHECKED_WRITE (f->fd, "\n", 1); - } - } - } else if (opt & COB_WRITE_PAGE) { - COB_CHECKED_WRITE (f->fd, "\f", 1); - } - return 0; -} - -static int -cob_file_write_opt (cob_file *f, const int opt) -{ - int i; - - if (f->flag_is_pipe) - return COB_STATUS_00_SUCCESS; - - if (unlikely (f->flag_select_features & COB_SELECT_LINAGE)) { - return cob_linage_write_opt (f, opt); - } - if (opt & COB_WRITE_LINES) { - i = opt & COB_WRITE_MASK; - if (!i) { - /* AFTER/BEFORE 0 */ - COB_CHECKED_PUTC ('\r', (FILE *)f->file); - } else { - for (; i > 0; --i) { - COB_CHECKED_PUTC ('\n', (FILE *)f->file); - } - } - } else if (opt & COB_WRITE_PAGE) { - COB_CHECKED_PUTC ('\f', (FILE *)f->file); - } - return 0; -} - -/* - * Check if input file is Micro Focus variable length format - * (Refer to Micro Focus file format documentation for details) - */ -static unsigned char mfhdrmark2[4] = {0x30,0x7E,0x00,0x00}; -static unsigned char mfhdrmark4[4] = {0x30,0x00,0x00,0x7C}; -static int -check_mf_format(cob_file *f, char *filename) -{ - FILE *fd; - int ln,minrcsz,maxrcsz; - unsigned char mfhdr[128]; - - fd = fopen(filename,"r"); - if(fd == NULL) { - return 0; - } - - memset(mfhdr,0,sizeof(mfhdr)); - ln = fread(mfhdr,1,sizeof(mfhdr),fd); - minrcsz = LDCOMPX4(((unsigned char *)&mfhdr[58])); - maxrcsz = LDCOMPX4(((unsigned char *)&mfhdr[54])); - - /* Check for file header markers and sanity checks on record size info */ - if(ln == sizeof(mfhdr) - && (memcmp(mfhdr,mfhdrmark2,4) == 0 || memcmp(mfhdr,mfhdrmark4,4) == 0) - && mfhdr[36] == 0x00 - && mfhdr[37] == 0x3E - && (mfhdr[39] == 0x01 || mfhdr[39] == 0x03) - && (mfhdr[48] == 0x01 || mfhdr[48] == 0x00) - && minrcsz > 0 - && maxrcsz < (60*1024*1024) - && minrcsz <= maxrcsz) { - if(f->organization == COB_ORG_RELATIVE - && mfhdr[39] != 0x03) { - DEBUG_LOG("io",("File %s is not RELATIVE on disk\n",f->select_name)); - } else - if(f->organization == COB_ORG_SEQUENTIAL - && mfhdr[39] != 0x01) { - DEBUG_LOG("io",("File %s is not SEQUENTIAL on disk\n",f->select_name)); - } - - if(memcmp(mfhdr,mfhdrmark4,4) == 0) { - f->record_prefix = 4; - } else { - f->record_prefix = 2; - } - if(maxrcsz > (int)f->record_max) { - cob_runtime_error (_("ERROR FILE %s has record size %d exceeds %d in program"), - f->select_name,maxrcsz,(int)f->record_max); - } else { - f->record_min = minrcsz; - f->record_max = maxrcsz; - } - f->file_header = 128; - f->record_off = -1; /* At start of file */ - f->file_format = COB_FILE_IS_MF; - if(mfhdr[39] == 0x03) { /* Relative format */ - f->record_slot = f->record_max + 1 + f->record_prefix; - } else { - f->record_slot = 0; /* Unused for sequential format */ - } - } else { - fclose(fd); - return 0; - } - fclose(fd); - return 1; -} - -/* - * Write the MF style file header for variable sequential & relative files - */ -static int /* Return -1 on error, else 0 */ -write_mf_header(cob_file *f, char *filename) -{ - FILE *fd; - int k; - char wrk[16]; - unsigned char mfhdr[128]; - time_t nowis; - struct tm *lclNow; - - fd = fopen(filename,"w"); - if(fd == NULL) { - return -1; - } - memset(mfhdr,0,sizeof(mfhdr)); - if(f->record_max < 4096) { - memcpy(mfhdr,mfhdrmark2,4); - f->record_prefix = 2; - } else { - memcpy(mfhdr,mfhdrmark4,4); - f->record_prefix = 4; - } - time(&nowis); - lclNow = localtime(&nowis); - strftime(wrk,sizeof(wrk),"%y%m%d%H%M%S00",lclNow); - memcpy(&mfhdr[8],wrk,14); - memcpy(&mfhdr[22],wrk,14); - mfhdr[37] = 0x3E; - if(f->organization == COB_ORG_RELATIVE) - mfhdr[39] = 3; - else - if(f->organization == COB_ORG_SEQUENTIAL) - mfhdr[39] = 1; - if(f->record_min != f->record_max) - mfhdr[48] = 1; - else - mfhdr[48] = 0; - STCOMPX4(f->record_max,LSUCHAR(&mfhdr[54])); - STCOMPX4(f->record_min,LSUCHAR(&mfhdr[58])); - k = fwrite(mfhdr, sizeof(mfhdr), 1, fd); - fclose(fd); - if(k != 1) - return -1; - f->file_header = 128; - f->record_off = -1; /* At start of file */ - return 0; -} - -/* - * Open (record) Sequential and Relative files - * with just an 'fd' (No FILE *) - */ -static int -cob_fd_file_open (cob_file *f, char *filename, const int mode, const int sharing) -{ - int fd; - int fdmode; - int fperms; - unsigned int nonexistent; - int ret; - COB_UNUSED(sharing); - - /* Note filename points to file_open_name */ - /* cob_chk_file_mapping manipulates file_open_name directly */ - - if(!f->flag_file_map) { - cob_chk_file_mapping (f); - f->flag_file_map = 1; - cob_set_file_format(f, file_open_io_env, 1, NULL); /* Set file format */ - } - - nonexistent = 0; - errno = 0; - if (access (filename, F_OK) && errno == ENOENT) { - if (mode != COB_OPEN_OUTPUT && f->flag_optional == 0) { - return COB_STATUS_35_NOT_EXISTS; - } - nonexistent = 1; - } - - if ((f->organization == COB_ORG_RELATIVE || f->organization == COB_ORG_SEQUENTIAL) - && nonexistent == 0 - && !f->flag_set_type - && (mode == COB_OPEN_INPUT || mode == COB_OPEN_I_O || mode == COB_OPEN_EXTEND) ) { - if (f->file_format == COB_FILE_IS_MF - && f->record_min == f->record_max) { - /* Fixed size records so No file header to check */ - } else - if (f->file_format == COB_FILE_IS_MF - && !check_mf_format(f, filename)) { - f->file_format = COB_FILE_IS_GCVS0; /* Try GNU Cobol format */ - f->record_prefix = 4; - f->file_header = 0; - cob_set_file_format(f, file_open_io_env, 1, NULL); /* Reset file format options */ - } else - if (f->file_format != COB_FILE_IS_MF - && check_mf_format(f, filename)) { - f->file_format = COB_FILE_IS_MF; /* Use Micro Focus format */ - } - } - - fdmode = O_BINARY; - fperms = 0; - f->fd = -1; - f->flag_file_lock = 0; - switch (mode) { - case COB_OPEN_INPUT: - if ((f->share_mode & COB_SHARE_NO_OTHER) - || (f->lock_mode & COB_FILE_EXCLUSIVE) ) { - /* fcntl with WRLCK requires file to be opened RDWR */ - fdmode |= O_RDWR; - } else { - fdmode |= O_RDONLY; - } - break; - case COB_OPEN_OUTPUT: - nonexistent = 0; - fdmode |= O_CREAT | O_TRUNC; - if (f->organization == COB_ORG_RELATIVE) { - fdmode |= O_RDWR; - } else { - fdmode |= O_WRONLY; - } - fperms = COB_FILE_MODE; - break; - case COB_OPEN_I_O: - if (nonexistent) { - fdmode |= O_CREAT | O_RDWR; - fperms = COB_FILE_MODE; - } else { - fdmode |= O_RDWR; - } - break; - case COB_OPEN_EXTEND: - fdmode |= O_CREAT | O_RDWR | O_APPEND; - fperms = COB_FILE_MODE; - break; - } - - errno = 0; - fd = open (filename, fdmode, fperms); - ret = errno; - - switch (ret) { - case 0: - if (mode == COB_OPEN_EXTEND && fd >= 0) { - lseek (fd, (off_t) 0, SEEK_END); - } - f->open_mode = (unsigned char)mode; - break; - case ENOENT: - if (mode == COB_OPEN_EXTEND || mode == COB_OPEN_OUTPUT) { - - return COB_STATUS_30_PERMANENT_ERROR; - } - if (f->flag_optional) { - f->open_mode = (unsigned char)mode; - f->flag_nonexistent = 1; - f->flag_end_of_file = 1; - f->flag_begin_of_file = 1; - return COB_STATUS_05_SUCCESS_OPTIONAL; - } - return COB_STATUS_35_NOT_EXISTS; - case EACCES: - case EISDIR: - case EROFS: - return COB_STATUS_37_PERMISSION_DENIED; - case EAGAIN: - return COB_STATUS_61_FILE_SHARING; - default: - return COB_STATUS_30_PERMANENT_ERROR; - } - f->fd = fd; - if (mode == COB_OPEN_INPUT) { - f->file = (void*)fdopen(f->fd, "r"); - } else if (mode == COB_OPEN_I_O) { - if (nonexistent) - f->file = (void*)fdopen(f->fd, "w+"); - else - f->file = (void*)fdopen(f->fd, "r+"); - } else if (mode == COB_OPEN_EXTEND) { - f->file = (void*)fdopen(f->fd, "a"); - } else { - f->file = (void*)fdopen(f->fd, "w"); - } - if ((mode == COB_OPEN_OUTPUT || (mode == COB_OPEN_I_O && nonexistent)) - && f->file_format == COB_FILE_IS_MF) { /* Write MF file header */ - if(f->record_min != f->record_max) { - write_mf_header(f, filename); - f->record_off = lseek (f->fd, (off_t)f->file_header, SEEK_SET); - } else { - f->record_prefix = 0; - } - } else - if ((f->organization == COB_ORG_RELATIVE || f->organization == COB_ORG_SEQUENTIAL) - && f->file_format == COB_FILE_IS_MF - && (mode == COB_OPEN_INPUT || mode == COB_OPEN_I_O || mode == COB_OPEN_EXTEND) ) { - f->record_off = lseek (f->fd, (off_t)f->file_header, SEEK_SET); - } - f->record_off = -1; - - if (f->organization == COB_ORG_RELATIVE - && f->access_mode == COB_ACCESS_SEQUENTIAL) { - struct stat st; - if (f->keys[0].field) { - cob_set_int (f->keys[0].field, 0); - } - f->cur_rec_num = 0; - if (f->open_mode == COB_OPEN_OUTPUT) { - f->max_rec_num = 0; - } else if (fstat (f->fd, &st) == 0) { - f->max_rec_num = (st.st_size - f->file_header) / f->record_slot; - } - if (f->max_rec_num < 0) - f->max_rec_num = 0; - } - - if ((ret=set_file_lock(f, filename, mode)) != 0) - return ret; - if (f->flag_optional && nonexistent) { - return COB_STATUS_05_SUCCESS_OPTIONAL; - } - return 0; -} - -#define dMaxArgs 16 -static int -cob_file_open (cob_file_api *a, cob_file *f, char *filename, const int mode, const int sharing) -{ - /* Note filename points to file_open_name */ - /* cob_chk_file_mapping manipulates file_open_name directly */ - - int ret, j, k; - int p_fds[2],c_fds[2]; - pid_t s_pid; - FILE *fp; - const char *fmode; - char *args[dMaxArgs]; - cob_linage *lingptr; - unsigned int nonexistent; - - f->share_mode = (unsigned char)sharing; - if(!f->flag_file_map) { - cob_chk_file_mapping (f); - f->flag_file_map = 1; - } - f->flag_is_pipe = 0; - - if (file_setptr->cob_file_dict == COB_DICTIONARY_ALL - && mode == COB_OPEN_OUTPUT) - a->cob_write_dict(f, filename); - - if (f->organization != COB_ORG_LINE_SEQUENTIAL) { - return cob_fd_file_open (f, filename, mode, sharing); - } - - nonexistent = 0; - errno = 0; - f->file_pid = 0; - f->flag_is_pipe = 0; - if (filename[0] == '>') { - if (mode != COB_OPEN_OUTPUT) - return COB_STATUS_37_PERMISSION_DENIED; - fp = popen (filename+1, "w"); - if (fp == NULL) - return COB_STATUS_30_PERMANENT_ERROR; - f->file = fp; - if (fp) { - f->fd = fileno (fp); - } else { - f->fd = -1; - } - f->fileout = f->file; - f->fdout = f->fd; - f->flag_is_pipe = 1; - f->open_mode = (unsigned char)mode; - return 0; - } - if (filename[0] == '<') { - if (mode != COB_OPEN_INPUT) - return COB_STATUS_37_PERMISSION_DENIED; - fp = popen (filename+1, "r"); - if (fp == NULL) - return COB_STATUS_30_PERMANENT_ERROR; - f->file = fp; - f->fileout = NULL; - f->fdout = -1; - if (fp) { - f->fd = fileno (fp); - } else { - f->fd = -1; - } - f->flag_is_pipe = 1; - f->open_mode = (unsigned char)mode; - return 0; - } - if (filename[0] == '|') { -#if defined (HAVE_UNISTD_H) && !(defined (_WIN32)) - if (mode != COB_OPEN_I_O) - return COB_STATUS_37_PERMISSION_DENIED; - filename++; - while(*filename == ' ') - filename++; - args[0] = filename; - for (j=k=0; filename[k] != 0; k++) { - if (filename[k] == ' ') { - filename[k] = 0; - while(filename[k+1] == ' ') - k++; - if(j >= dMaxArgs) - break; - if (filename[k+1] != 0) - args[++j] = &filename[k+1]; - } - } - args[++j] = NULL; - - if (pipe(p_fds) < 0 - || pipe(c_fds) < 0 - || (s_pid = fork()) < 0) { - return COB_STATUS_30_PERMANENT_ERROR; - } - if (s_pid > 0) { /* Parent process */ - close (p_fds[0]); - close (c_fds[1]); - f->fdout = p_fds[1]; - f->fd = c_fds[0]; - errno = 0; - f->file = (void*)fdopen(f->fd, "r"); - errno = 0; - f->fileout = (void*)fdopen(f->fdout, "w"); - f->flag_is_pipe = 1; - f->open_mode = (unsigned char)mode; - f->file_features &= ~COB_FILE_LS_NULLS; - f->file_features &= ~COB_FILE_LS_VALIDATE; - f->file_pid = s_pid; - signal (SIGPIPE, SIG_IGN); - return COB_STATUS_00_SUCCESS; - } else { /* Child process */ - close (p_fds[1]); - close (c_fds[0]); - if (p_fds[0] != STDIN_FILENO) { - if(dup2(p_fds[0], STDIN_FILENO) != STDIN_FILENO) { - cob_runtime_error (_("ERROR FILE %s opening pipe"), f->select_name); - cob_stop_run (-1); - } - close (p_fds[0]); - } - if (c_fds[1] != STDOUT_FILENO) { - if(dup2(c_fds[1], STDOUT_FILENO) != STDOUT_FILENO) { - cob_runtime_error (_("ERROR FILE %s opening pipe"), f->select_name); - cob_stop_run (-1); - } - close (c_fds[1]); - } - execv (filename, args); - fprintf(stderr,"%s: Command not found.\n",filename); - fflush(stderr); - exit(-1); - } -#else - return COB_STATUS_48_OUTPUT_DENIED; -#endif - } - - if (access (filename, F_OK) && errno == ENOENT) { - nonexistent = 1; - if (mode != COB_OPEN_OUTPUT && f->flag_optional == 0) { - return COB_STATUS_35_NOT_EXISTS; - } - } - - fp = NULL; - fmode = NULL; - /* Open the file */ - switch (mode) { - case COB_OPEN_INPUT: - if ((f->share_mode & COB_SHARE_NO_OTHER) - || (f->lock_mode & COB_FILE_EXCLUSIVE) ) { - fmode = "r+"; - } else - if (!file_setptr->cob_unix_lf) { - fmode = "r"; - } else { - fmode = "rb"; - } - break; - case COB_OPEN_OUTPUT: - if (!file_setptr->cob_unix_lf) { - fmode = "w"; - } else { - fmode = "wb"; - } - break; - case COB_OPEN_I_O: - fmode = "r+"; - break; - case COB_OPEN_EXTEND: - /* Problem on WIN32 (tested _MSC_VER 1500 and GCC build) if file isn't there: */ - /* Both modes create the file and return a bad pointer */ - /* Mode "a+" sets EINVAL, further actions on the file do work */ - /* Mode "ab+" doesn't set errno, but we don't want a binary file */ - /* Possible Solutions: */ - /* a) Create the file and reopen it with a+ */ - /* b) Check this stuff in EINVAL and just go on */ - if (!file_setptr->cob_unix_lf) { - fmode = "a+"; - } else { - fmode = "ab+"; - } - break; - /* LCOV_EXCL_START */ - default: - cob_fatal_error(COB_FERROR_CODEGEN); - /* LCOV_EXCL_STOP */ - } - - errno = 0; - fp = fopen (filename, fmode); - f->file = fp; - if (fp) { - f->fd = fileno (fp); - } else { - f->fd = -1; - } - switch (errno) { - case 0: - f->open_mode = (unsigned char)mode; - break; - case EINVAL: - if (f->flag_optional && nonexistent) { - f->open_mode = (unsigned char)mode; - } else { - return COB_STATUS_30_PERMANENT_ERROR; - } - break; - case ENOENT: - if (mode == COB_OPEN_EXTEND || mode == COB_OPEN_OUTPUT) { - return COB_STATUS_30_PERMANENT_ERROR; - } - if (f->flag_optional) { - f->open_mode = (unsigned char)mode; - f->flag_nonexistent = 1; - f->flag_end_of_file = 1; - f->flag_begin_of_file = 1; - return COB_STATUS_05_SUCCESS_OPTIONAL; - } - return COB_STATUS_35_NOT_EXISTS; - case EACCES: - case EISDIR: - case EROFS: - return COB_STATUS_37_PERMISSION_DENIED; - case EAGAIN: - return COB_STATUS_61_FILE_SHARING; - default: - return COB_STATUS_30_PERMANENT_ERROR; - } - - if (unlikely (f->flag_select_features & COB_SELECT_LINAGE)) { - if (file_linage_check (f)) { - if (fp) { - fclose (fp); - } - f->file = NULL; - f->fd = -1; - return COB_STATUS_57_I_O_LINAGE; - } - f->flag_needs_top = 1; - lingptr = f->linage; - cob_set_int (lingptr->linage_ctr, 1); - } - cob_set_file_format(f, file_open_io_env, 1, NULL); /* Set file format */ - - if (mode == COB_OPEN_EXTEND) { - if(f->lock_mode == 0 - && f->share_mode == 0) - return 0; - } - if ((ret=set_file_lock(f, filename, mode)) != 0) { - return ret; - } - if (f->flag_optional && nonexistent) { - return COB_STATUS_05_SUCCESS_OPTIONAL; - } - - return 0; -} - -static int -cob_file_close (cob_file_api *a, cob_file *f, const int opt) -{ - COB_UNUSED (a); - - switch (opt) { - case COB_CLOSE_LOCK: - /* meaning (not file-sharing related): - file may not be opened in *this runtime unit* again */ - /* TODO: set flag here */ - /* Fall through */ - case COB_CLOSE_NORMAL: - case COB_CLOSE_NO_REWIND: - if (f->organization == COB_ORG_LINE_SEQUENTIAL) { - if (f->flag_needs_nl && - !(f->flag_select_features & COB_SELECT_LINAGE)) { - f->flag_needs_nl = 0; - putc ('\n', (FILE *)f->file); - } - } else if (f->flag_needs_nl) { - f->flag_needs_nl = 0; - if (f->fd >= 0) { - COB_CHECKED_WRITE (f->fd, "\n", 1); - } - } -#ifdef HAVE_FCNTL - /* Unlock the file */ - if (f->fd >= 0 - && !f->flag_is_pipe) { - struct flock lock; - memset ((void *)&lock, 0, sizeof (struct flock)); - lock.l_type = F_UNLCK; - lock.l_whence = SEEK_SET; - lock.l_start = 0; - lock.l_len = 0; - if (fcntl (f->fd, F_SETLK, &lock) == -1) { -#if 1 /* CHECKME - What is the correct thing to do here? */ - /* not translated as "testing only" */ - cob_runtime_warning ("issue during unlock (%s), errno: %d", "cob_file_close", errno); -#endif - } - } -#endif - /* Close the file */ - if (f->organization == COB_ORG_LINE_SEQUENTIAL) { - if (f->flag_is_pipe) { - int sts; - if (f->file_pid) { - if (f->file) - fclose (f->file); - if (f->fileout - && f->fileout != f->file) - fclose (f->fileout); - errno = 0; - kill (f->file_pid, 0); - if (errno == ESRCH) { - waitpid (f->file_pid, &sts, WNOHANG); - } else { - cob_sleep_msec(50); - kill (f->file_pid, SIGKILL); - cob_sleep_msec(50); - waitpid (f->file_pid, &sts, 0); - } - } else { - pclose ((FILE *)f->file); - } - f->flag_is_pipe = 0; - f->file = f->fileout = NULL; - f->fd = f->fdout = -1; - f->file_pid = 0; - return COB_STATUS_00_SUCCESS; - } - if (f->file) { - fclose ((FILE *)f->file); - } - } else { - if (f->fd >= 0) { - close (f->fd); - f->fd = -1; - } - } - if (opt == COB_CLOSE_NO_REWIND) { - f->open_mode = COB_OPEN_CLOSED; - return COB_STATUS_07_SUCCESS_NO_UNIT; - } - return COB_STATUS_00_SUCCESS; - default: - if (f->fd >= 0 && f->open_mode != COB_OPEN_INPUT) { - fdcobsync (f->fd); - } - return COB_STATUS_07_SUCCESS_NO_UNIT; - } -} - -/* SEQUENTIAL */ - -static int -sequential_read (cob_file_api *a, cob_file *f, const int read_opts) -{ - int bytesread,padlen; - union { - unsigned char sbuff[4]; - unsigned short sshort[2]; - unsigned int sint; - } recsize; - - COB_UNUSED (a); - COB_UNUSED (read_opts); - - if (unlikely (f->flag_operation != 0)) { - f->flag_operation = 0; - } - if(f->record_off == -1) { - f->record_off = lseek (f->fd, (off_t)f->file_header, SEEK_SET); /* Set current file position */ - } else { - f->record_off = lseek (f->fd, (off_t)0, SEEK_CUR); /* Get current file position */ - } - - if (unlikely (f->record_min != f->record_max)) { - /* Read record size */ - - bytesread = read (f->fd, recsize.sbuff, f->record_prefix); - if (unlikely (bytesread != (int)f->record_prefix)) { - if (bytesread == 0) { - return COB_STATUS_10_END_OF_FILE; - } else { - return COB_STATUS_30_PERMANENT_ERROR; - } - } - switch (f->file_format) { - case COB_FILE_IS_GC: - case COB_FILE_IS_GCVS0: /* short size plus 2 NULs */ - f->record->size = COB_MAYSWAP_16 (recsize.sshort[0]); - break; - case COB_FILE_IS_GCVS1: - f->record->size = COB_MAYSWAP_32 (recsize.sint); - break; - case COB_FILE_IS_GCVS2: - f->record->size = recsize.sint; - break; - case COB_FILE_IS_GCVS3: - f->record->size = COB_MAYSWAP_16 (recsize.sshort[0]); - break; - case COB_FILE_IS_B32: /* Was varseq 2 on Big Endian system */ - f->record->size = LDCOMPX4(recsize.sbuff); - break; - case COB_FILE_IS_L32: /* Was varseq 2 on Little Endian system */ - f->record->size = LDBINLE4(recsize.sbuff); - break; - case COB_FILE_IS_MF: - if(f->record_prefix == 2) { - f->record->size = ((recsize.sbuff[0] & 0x0F) << 8) + recsize.sbuff[1]; - } else { - f->record->size = ((recsize.sbuff[0] & 0x0F) << 24) + (recsize.sbuff[1] << 16) - + (recsize.sbuff[2] << 8) + recsize.sbuff[3]; - } - break; - default: - f->record->size = COB_MAYSWAP_16 (recsize.sshort[0]); - break; - } - } - - /* Read record */ - bytesread = read (f->fd, f->record->data, f->record->size); - if (f->record_min != f->record_max - && f->file_format == COB_FILE_IS_MF) { - padlen = ((f->record->size + f->record_prefix + 3) / 4 * 4) - (f->record->size + f->record_prefix); - if(padlen > 0) - if (read(f->fd, recsize.sbuff, padlen) != padlen) /* Read past padding chars */ - return COB_STATUS_30_PERMANENT_ERROR; - } - if (unlikely(bytesread != (int)f->record->size)) { - if (bytesread == 0) { - return COB_STATUS_10_END_OF_FILE; - /* LCOV_EXCL_START */ - } else if (bytesread < 0) { - return COB_STATUS_30_PERMANENT_ERROR; - /* LCOV_EXCL_STOP */ - } else { - return COB_STATUS_04_SUCCESS_INCOMPLETE; - } - } - return COB_STATUS_00_SUCCESS; -} - -static int -sequential_write (cob_file_api *a, cob_file *f, const int opt) -{ - union { - unsigned char sbuff[4]; - unsigned short sshort[2]; - unsigned int sint; - } recsize; - int padlen; - - COB_UNUSED (a); - if (unlikely (f->flag_operation == 0)) { - f->flag_operation = 1; - } - - /* WRITE AFTER */ - if (unlikely (opt & COB_WRITE_AFTER)) { - if (cob_seq_write_opt (f, opt)) { - return COB_STATUS_30_PERMANENT_ERROR; - } - f->flag_needs_nl = 1; - } - - if(f->record_off == -1) { - f->record_off = lseek (f->fd, (off_t)f->file_header, SEEK_SET); /* Set current file position */ - } else { - f->record_off = lseek (f->fd, (off_t)0, SEEK_CUR); /* Get current file position */ - } - if (unlikely(f->record_min != f->record_max)) { - /* Write record size */ - - recsize.sint = 0; - switch (f->file_format) { - case COB_FILE_IS_GC: - case COB_FILE_IS_GCVS0: - recsize.sshort[0] = COB_MAYSWAP_16 (f->record->size); - break; - case COB_FILE_IS_GCVS1: - recsize.sint = COB_MAYSWAP_32 (f->record->size); - break; - case COB_FILE_IS_GCVS2: - recsize.sint = f->record->size; - break; - case COB_FILE_IS_GCVS3: - recsize.sshort[0] = COB_MAYSWAP_16 (f->record->size); - break; - case COB_FILE_IS_B32: /* Was varseq 2 on Big Endian system */ - STCOMPX4(f->record->size, recsize.sbuff); - break; - case COB_FILE_IS_L32: /* Was varseq 2 on Little Endian system */ - STBINLE4(f->record->size, recsize.sbuff); - break; - case COB_FILE_IS_MF: - if(f->record_prefix == 2) { - STCOMPX2(f->record->size, recsize.sbuff); - } else { - STCOMPX4(f->record->size, recsize.sbuff); - } - recsize.sbuff[0] |= 0x40; - break; - default: - recsize.sshort[0] = COB_MAYSWAP_16 (f->record->size); - break; - } - - if (unlikely(write (f->fd, recsize.sbuff, f->record_prefix) != - (int)f->record_prefix)) { - return COB_STATUS_30_PERMANENT_ERROR; - } - } - - /* Write record */ - COB_CHECKED_WRITE (f->fd, f->record->data, f->record->size); - - if (f->record_min != f->record_max - && f->file_format == COB_FILE_IS_MF) { - padlen = ((f->record->size + f->record_prefix + 3) / 4 * 4) - (f->record->size + f->record_prefix); - while(padlen-- > 0) - if(write(f->fd, " ",1) != 1) - return COB_STATUS_30_PERMANENT_ERROR; - } - - /* WRITE BEFORE */ - if (unlikely (opt & COB_WRITE_BEFORE)) { - if (cob_seq_write_opt (f, opt)) { - return COB_STATUS_30_PERMANENT_ERROR; - } - f->flag_needs_nl = 0; - } - - return COB_STATUS_00_SUCCESS; -} - -static int -sequential_rewrite (cob_file_api *a, cob_file *f, const int opt) -{ - union { - unsigned char sbuff[4]; - unsigned short sshort[2]; - unsigned int sint; - } recsize; - int bytesread, rcsz, padlen; - COB_UNUSED (a); - COB_UNUSED (opt); - - f->flag_operation = 1; - if (f->record_off != -1) { - if (lseek (f->fd, f->record_off, SEEK_SET) == (off_t)-1) { - return COB_STATUS_30_PERMANENT_ERROR; - } - } else - if (lseek (f->fd, -(off_t) f->record->size, SEEK_CUR) == (off_t)-1) { /* Not used! */ - return COB_STATUS_30_PERMANENT_ERROR; - } - rcsz = f->record->size; - padlen = 0; - if (f->record_min != f->record_max - && f->record_prefix > 0) { - bytesread = read (f->fd, recsize.sbuff, f->record_prefix); - if (unlikely (bytesread != (int)f->record_prefix)) { - if (bytesread == 0) { - return COB_STATUS_10_END_OF_FILE; - } else { - return COB_STATUS_30_PERMANENT_ERROR; - } - } - switch (f->file_format) { - case COB_FILE_IS_GC: - case COB_FILE_IS_GCVS0: - rcsz = COB_MAYSWAP_16 (recsize.sshort[0]); - break; - case COB_FILE_IS_GCVS1: - rcsz = COB_MAYSWAP_32 (recsize.sint); - break; - case COB_FILE_IS_GCVS2: - rcsz = recsize.sint; - break; - case COB_FILE_IS_GCVS3: - rcsz = COB_MAYSWAP_16 (recsize.sshort[0]); - break; - case COB_FILE_IS_B32: /* Was varseq 2 on Big Endian system */ - rcsz = LDCOMPX4(recsize.sbuff); - break; - case COB_FILE_IS_L32: /* Was varseq 2 on Little Endian system */ - rcsz = LDBINLE4(recsize.sbuff); - break; - case COB_FILE_IS_MF: - if(f->record_prefix == 2) { - rcsz = ((recsize.sbuff[0] & 0x0F) << 8) + recsize.sbuff[1]; - } else { - rcsz = ((recsize.sbuff[0] & 0x0F) << 24) + (recsize.sbuff[1] << 16) - + (recsize.sbuff[2] << 8) + recsize.sbuff[3]; - } - padlen = ((rcsz + f->record_prefix + 3) / 4 * 4) - (rcsz + f->record_prefix); - break; - default: - rcsz = COB_MAYSWAP_16 (recsize.sshort[0]); - break; - } - if((rcsz + padlen) < f->record->size) - return COB_STATUS_30_PERMANENT_ERROR; - } - if(rcsz > f->record_max) - return COB_STATUS_30_PERMANENT_ERROR; - if (write (f->fd, f->record->data, (size_t)rcsz) != (int)rcsz) { - return COB_STATUS_30_PERMANENT_ERROR; - } - if (f->record_min != f->record_max - && f->file_format == COB_FILE_IS_MF) { - while(padlen-- > 0) - if(write(f->fd, " ",1) != 1) - return COB_STATUS_30_PERMANENT_ERROR; - } - return COB_STATUS_00_SUCCESS; -} - -/* LINE SEQUENTIAL */ -static int -lineseq_read (cob_file_api *a, cob_file *f, const int read_opts) -{ - unsigned char *dataptr; - size_t i = 0; - int n, k; - - COB_UNUSED (a); - COB_UNUSED (read_opts); - - dataptr = f->record->data; - if (!f->flag_is_pipe) - f->record_off = ftell ((FILE *)f->file); /* Save position at start of line */ - for (; ;) { - n = getc ((FILE *)f->file); - if (unlikely (n == EOF)) { - if (!i) { - return COB_STATUS_10_END_OF_FILE; - } else { - break; - } - } - if (unlikely(n == 0) - && (f->file_features & COB_FILE_LS_NULLS)) { - n = getc ((FILE *)f->file); - /* LCOV_EXCL_START */ - if (n == EOF) { - return COB_STATUS_30_PERMANENT_ERROR; - } - if ((f->file_features & COB_FILE_LS_VALIDATE) - && (unsigned char)n >= ' ') { /* Should be less than a space */ - return COB_STATUS_71_BAD_CHAR; - } - /* LCOV_EXCL_STOP */ - } else { - if (n == '\r') { - continue; - } - if (n == '\n') { - break; - } - } - if (likely(i < f->record_max)) { - *dataptr++ = (unsigned char)n; - i++; - if (i >= f->record_max - && (f->file_features & COB_FILE_LS_SPLIT)) { - /* If record is too long, then simulate end - * so balance becomes the next record read */ - n = getc ((FILE *)f->file); - k = 1; - if (n == '\r') { - n = getc ((FILE *)f->file); - k++; - } - if (n != '\n') { - fseek((FILE*)f->file, -k, SEEK_CUR); - } - break; - } - } - } - if (i < f->record_max) { - /* Fill the record with spaces */ - memset ((unsigned char *)f->record->data + i, ' ', - f->record_max - i); - } - f->record->size = i; - if (f->open_mode == COB_OPEN_I_O) /* Required on some systems */ - fflush((FILE*)f->file); - return COB_STATUS_00_SUCCESS; -} - -#define IS_BAD_CHAR(x) (x < ' ' && x != COB_CHAR_BS && x != COB_CHAR_ESC \ - && x != COB_CHAR_FF && x != COB_CHAR_SI && x != COB_CHAR_TAB) -static int -lineseq_write (cob_file_api *a, cob_file *f, const int opt) -{ - unsigned char *p; - cob_linage *lingptr; - size_t size; - int ret; - FILE *fo; - COB_UNUSED (a); - - /* Determine the size to be written */ - if (unlikely (f->file_features & COB_FILE_LS_FIXED)) { - size = f->record->size; - } else if (f->record->size == 0) { - size = 0; - } else { - size_t i; - for (i = f->record->size - 1; ; --i) { - if (f->record->data[i] != ' ') { - i++; - break; - } - if (i == 0) break; - } - size = i; - } - - fo = (FILE*)f->file; - if (f->flag_is_pipe) { - if (f->fdout >= 0) { - fo = (FILE*)f->fileout; - } - } else { - if (unlikely (f->flag_select_features & COB_SELECT_LINAGE)) { - if (f->flag_needs_top) { - int i; - f->flag_needs_top = 0; - lingptr = f->linage; - for (i = 0; i < lingptr->lin_top; ++i) { - COB_CHECKED_PUTC ('\n', fo); - } - } - } - /* WRITE AFTER */ - if ((opt & COB_WRITE_AFTER) - && !f->flag_is_pipe) { - ret = cob_file_write_opt (f, opt); - if (ret) { - return ret; - } - f->flag_needs_nl = 1; - } - - f->record_off = ftell ((FILE *)f->file); /* Save file position at start of line */ - } - - /* Write to the file */ - if (size) { - if (unlikely (f->file_features & COB_FILE_LS_NULLS)) { - size_t i, j; - p = f->record->data; - for (i=j=0; j < (int)size; j++) { - if (p[j] < ' ') { - if (j - i > 0) { - COB_CHECKED_FWRITE(fo, &p[i], j - i); - } - i = j + 1; - COB_CHECKED_PUTC(0x00, fo); - COB_CHECKED_PUTC(p[j], fo); - } - } - if (i < size) { - ret = fwrite (&p[i],(int)size - i, 1, fo); - if (ret <= 0) { - return errno_cob_sts (COB_STATUS_30_PERMANENT_ERROR); - } - } - } else { - if (unlikely (f->file_features & COB_FILE_LS_VALIDATE)) { - int i; - p = f->record->data; - for (i = 0; i < (int)size; ++i, ++p) { - if (IS_BAD_CHAR (*p)) { - return COB_STATUS_71_BAD_CHAR; - } - } - } - ret = fwrite (f->record->data, size, (size_t)1, fo); - /* LCOV_EXCL_START */ - if (unlikely (ret != 1)) { - return errno_cob_sts (COB_STATUS_30_PERMANENT_ERROR); - }; - /* LCOV_EXCL_STOP */ - } - } - if (f->flag_is_pipe) { - COB_CHECKED_PUTC ('\n', fo); - fflush(fo); - f->flag_needs_nl = 0; - return COB_STATUS_00_SUCCESS; - } - - if (unlikely (f->flag_select_features & COB_SELECT_LINAGE)) { - COB_CHECKED_PUTC ('\n', fo); - } else - if ((f->file_features & COB_FILE_LS_CRLF)) { - if ((opt & COB_WRITE_PAGE) - || (opt & COB_WRITE_BEFORE && f->flag_needs_nl)) { - COB_CHECKED_PUTC ('\r', fo); - /* CHECKME - possible bug, see discussion board */ - } else if ((opt == 0) ) { - COB_CHECKED_PUTC ('\r', fo); - } - } - - if ((opt == 0) - && !(f->flag_select_features & COB_SELECT_LINAGE) - && ((f->file_features & COB_FILE_LS_LF) - || (f->file_features & COB_FILE_LS_CRLF))){ - /* At least add 1 LF */ - COB_CHECKED_PUTC ('\n', fo); - f->flag_needs_nl = 0; - } - - /* WRITE BEFORE */ - if (opt & COB_WRITE_BEFORE) { - ret = cob_file_write_opt (f, opt); - if (ret) { - return ret; - } - f->flag_needs_nl = 0; - } - if (f->open_mode == COB_OPEN_I_O) /* Required on some systems */ - fflush((FILE*)f->file); - - return COB_STATUS_00_SUCCESS; -} - -static int -lineseq_rewrite (cob_file_api *a, cob_file *f, const int opt) -{ - unsigned char *p; - size_t size, psize, slotlen; - int ret; - off_t curroff; - COB_UNUSED (a); - - if (f->flag_is_pipe) - return COB_STATUS_30_PERMANENT_ERROR; - - curroff = ftell ((FILE *)f->file); /* Current file position */ - /* Determine the size to be written */ - if ((f->file_features & COB_FILE_LS_FIXED)) { - size = f->record->size; - } else if (f->record->size == 0) { - size = 0; - } else { - size_t i; - for (i = f->record->size - 1; ; --i) { - if (f->record->data[i] != ' ') { - i++; - break; - } - if (i == 0) break; - } - size = i; - } - - p = f->record->data; - psize = size; - if ((f->file_features & COB_FILE_LS_NULLS)) { - size_t j; - for (j = 0; j < size; j++) { - if (p[j] < ' ') { - psize++; - } - } - } - slotlen = curroff - f->record_off - 1; - - if (psize > slotlen) { - return COB_STATUS_44_RECORD_OVERFLOW; - } - - if (fseek((FILE*)f->file, (off_t)f->record_off, SEEK_SET) != 0) { - return COB_STATUS_30_PERMANENT_ERROR; - } - - /* Write to the file */ - if (size) { - if ((f->file_features & COB_FILE_LS_NULLS)) { - size_t i, j; - p = f->record->data; - for (i=j=0; j < (int)size; j++) { - if (p[j] < ' ') { - if (j - i > 0) { - COB_CHECKED_FWRITE(f->file, &p[i], j - i); - } - i = j + 1; - COB_CHECKED_PUTC(0x00, (FILE*)f->file); - COB_CHECKED_PUTC(p[j], (FILE*)f->file); - } - } - if (i < size) { - COB_CHECKED_FWRITE(f->file, &p[i],(int)size - i); - } - } else { - if ((f->file_features & COB_FILE_LS_VALIDATE)) { - int i; - p = f->record->data; - for (i = 0; i < (int)size; ++i, ++p) { - if (IS_BAD_CHAR(*p)) { - return COB_STATUS_71_BAD_CHAR; - } - } - } - COB_CHECKED_FWRITE(f->file, f->record->data, size); - } - { - /* In case new record was shorter, pad with spaces */ - size_t i; - for (i = psize; i < slotlen; i++) { - COB_CHECKED_PUTC(' ', (FILE*)f->file); - } - } - } - - if (unlikely (f->flag_select_features & COB_SELECT_LINAGE)) { - COB_CHECKED_PUTC ('\n', (FILE *)f->file); - } else - /* CHECKME - differences to lineseq_write */ - if ((f->file_features & COB_FILE_LS_CRLF)) { - if ((opt & COB_WRITE_PAGE) - || (opt & COB_WRITE_BEFORE && f->flag_needs_nl)) { - COB_CHECKED_PUTC ('\r', (FILE *)f->file); - } - } else { - COB_CHECKED_PUTC ('\n', (FILE *)f->file); - } - - /* WRITE BEFORE */ - if (opt & COB_WRITE_BEFORE) { - ret = cob_file_write_opt (f, opt); - if (ret) { - return ret; - } - f->flag_needs_nl = 0; - } - if (f->open_mode == COB_OPEN_I_O) /* Required on some systems */ - fflush((FILE*)f->file); - - return COB_STATUS_00_SUCCESS; -} - -/* RELATIVE */ -/* - * Return size of relative record at given offset - */ -static int -relative_read_size (cob_file *f, off_t off, int *isdeleted) -{ - size_t relsize = 0; - unsigned char rechdr[8]; - - *isdeleted = 0; - if (lseek (f->fd, off, SEEK_SET) == (off_t)-1 ) { - return -1; - } - if (f->record_prefix > 0) { - memset (rechdr,0,sizeof(rechdr)); - if (read (f->fd, rechdr, f->record_prefix) != f->record_prefix) { - return -1; - } - switch (f->file_format) { - case COB_FILE_IS_B32: /* Was 32bit Big Endian system */ - relsize = LDCOMPX4(rechdr); - break; - case COB_FILE_IS_B64: /* Was 64bit Big Endian system */ - relsize = LDCOMPX4(((unsigned char *)&rechdr[4])); - break; - case COB_FILE_IS_L32: /* Was 32bit Little Endian system */ - relsize = LDBINLE4(rechdr); - break; - case COB_FILE_IS_L64: /* Was 64bit Little Endian system */ - relsize = LDBINLE4(rechdr); - break; - case COB_FILE_IS_MF: - if (f->record_prefix == 2) { - relsize = ((rechdr[0] & 0x0F) << 8) + rechdr[1]; - } else { - relsize = ((rechdr[0] & 0x0F) << 24) + (rechdr[1] << 16) - + (rechdr[2] << 8) + rechdr[3]; - } - if ((rechdr[0] & 0x20)) { - relsize = 0; /* Deleted record */ - } - break; - default: - memcpy (&relsize, rechdr, sizeof(relsize)); /* Local native 'size_t' */ - break; - } - if (relsize <= 0) { - *isdeleted = 1; - } - return (int)relsize; - } else - if (f->file_format == COB_FILE_IS_MF) { - if (lseek (f->fd, (off_t)(off + (off_t)f->record_slot - 1), SEEK_SET) == (off_t)-1 ) { - return -1; - } - rechdr[0] = 0; - if (read (f->fd, rechdr, 1) != 1) - return COB_STATUS_30_PERMANENT_ERROR; - lseek (f->fd, off, SEEK_SET); - if (rechdr[0] == 0) { - *isdeleted = 1; - return 0; - } else { - return (int)f->record_max; - } - } - return 0; -} - -/* RELATIVE START */ -static int -relative_start (cob_file_api *a, cob_file *f, const int cond, cob_field *k) -{ - off_t off; - size_t relsize; - int kindex; - int ksindex; - int kcond, isdeleted; - struct stat st; - COB_UNUSED (a); - - if (fstat (f->fd, &st) != 0 || st.st_size == 0) { - return COB_STATUS_23_KEY_NOT_EXISTS; - } - - /* Get the index */ - f->flag_first_read = 0; - switch (cond) { - case COB_FI: - kcond = COB_GE; - kindex = 0; - f->flag_first_read = 1; - break; - case COB_LA: - kcond = COB_LE; - kindex = (st.st_size - f->file_header) / f->record_slot - 1; - break; - case COB_LT: - case COB_LE: - kcond = cond; - kindex = cob_get_int (k) - 1; - /* Check against current file size */ - ksindex = (st.st_size - f->file_header) / f->record_slot - 1; - if (kindex > ksindex) { - kindex = ksindex + 1; - } - break; - default: - kcond = cond; - kindex = cob_get_int (k) - 1; - break; - } - - if (kindex < 0) { - /* Only valid ops are GE and GT in this case */ - switch (kcond) { - case COB_GE: - kindex = 0; - break; - case COB_GT: - /* Set to cater for increment below */ - kindex = -1; - break; - default: - return COB_STATUS_23_KEY_NOT_EXISTS; - } - } - - if (kcond == COB_LT) { - kindex--; - if (kindex < 0) { - return COB_STATUS_23_KEY_NOT_EXISTS; - } - } else if (kcond == COB_GT) { - kindex++; - } - - f->flag_operation = 0; - - /* Seek index */ - for (;;) { - if (kindex < 0) { - break; - } - off = kindex * f->record_slot + f->file_header; - if (off >= st.st_size) { - if (kcond == COB_LT || kcond == COB_LE) { - kindex--; - continue; - } - break; - } - relsize = relative_read_size(f, off, &isdeleted); - - /* Check if a valid record */ - if (relsize > 0 && !isdeleted) { - f->record_off = off; - lseek (f->fd, off, SEEK_SET); /* Set file position to start of record */ - if (f->access_mode == COB_ACCESS_SEQUENTIAL - && f->keys[0].field) { - f->cur_rec_num = (((off - f->file_header) / f->record_slot) + 1); - cob_set_int (f->keys[0].field, (int)f->cur_rec_num); - } - return COB_STATUS_00_SUCCESS; - } - - switch (kcond) { - case COB_EQ: - return COB_STATUS_23_KEY_NOT_EXISTS; - case COB_LT: - case COB_LE: - kindex--; - break; - case COB_GT: - case COB_GE: - kindex++; - break; - } - } - return COB_STATUS_23_KEY_NOT_EXISTS; -} - -/* - * Read relative record at given offset - */ -static int -relative_read_off (cob_file *f, off_t off) -{ - unsigned char recmark[2]; - size_t relsize = 0; - int isdeleted=0; - - relsize = relative_read_size(f, off, &isdeleted); - if(relsize < 0) { - return COB_STATUS_30_PERMANENT_ERROR; - } - - if (relsize == 0 || isdeleted) { - f->record->size = 0; - lseek (f->fd, off, SEEK_SET); - return COB_STATUS_23_KEY_NOT_EXISTS; - } - - if (relsize > f->record_max) { - return COB_STATUS_30_PERMANENT_ERROR; - } - - if (read (f->fd, f->record->data, (size_t)relsize) != relsize) { - return COB_STATUS_30_PERMANENT_ERROR; - } - f->record->size = relsize; - f->record_off = off; - - if (f->keys[0].field) { - f->cur_rec_num = (((off - f->file_header) / f->record_slot) + 1); - cob_set_int (f->keys[0].field, 0); - if (cob_add_int (f->keys[0].field, (int)f->cur_rec_num, COB_STORE_KEEP_ON_OVERFLOW) != 0) { - lseek (f->fd, off, SEEK_SET); - return COB_STATUS_14_OUT_OF_KEY_RANGE; - } - } - if (f->file_format == COB_FILE_IS_MF) { - if(f->record_min != f->record_max) { - lseek (f->fd, (off_t)(off + (off_t)f->record_slot - 1), SEEK_SET); - } - if (read (f->fd, recmark, 1) != 1) /* Active Record marker */ - return COB_STATUS_30_PERMANENT_ERROR; - if (recmark[0] == 0x00) { /* Flagged Deleted */ - f->record->size = 0; - lseek (f->fd, off, SEEK_SET); - return COB_STATUS_23_KEY_NOT_EXISTS; - } - } - return COB_STATUS_00_SUCCESS; -} - -static int -relative_read (cob_file_api *a, cob_file *f, cob_field *k, const int read_opts) -{ - off_t off; - int relnum,errsts; - struct stat st; - COB_UNUSED (a); - - if (unlikely (f->flag_operation != 0)) { - f->flag_operation = 0; - } - - relnum = cob_get_int (k) - 1; - if (relnum < 0) { - return COB_STATUS_23_KEY_NOT_EXISTS; - } - off = relnum * f->record_slot + f->file_header; - - if (fstat (f->fd, &st) != 0 || st.st_size == 0) { - return COB_STATUS_10_END_OF_FILE; - } - if(off >= st.st_size) { - if (f->access_mode == COB_ACCESS_SEQUENTIAL) - return COB_STATUS_10_END_OF_FILE; - return COB_STATUS_23_KEY_NOT_EXISTS; - } - set_lock_opts (f, read_opts); - if(f->flag_lock_rec) { - lock_record (f, relnum+1, f->flag_lock_mode, &errsts); - if (errsts != 0) { - switch (errsts) { - case EACCES: - case EAGAIN: - return COB_STATUS_51_RECORD_LOCKED; - case EDEADLK: - return COB_STATUS_52_DEAD_LOCK; - case ENOLCK: - return COB_STATUS_53_MAX_LOCKS; - default: - return COB_STATUS_30_PERMANENT_ERROR; - } - } - } - return relative_read_off(f, off); -} - -static int -relative_read_next (cob_file_api *a, cob_file *f, const int read_opts) -{ - off_t curroff; - off_t relsize; - int relnum; - cob_u32_t moveback; - struct stat st; - int sts; - int errsts; - COB_UNUSED (a); - - if (unlikely (f->flag_operation != 0)) { - f->flag_operation = 0; - lseek (f->fd, (off_t)0, SEEK_CUR); - } - - relsize = ((off_t) f->record_max) + sizeof (f->record->size); - relsize = (off_t)f->record_slot; - if (fstat (f->fd, &st) != 0 || st.st_size == 0) { - return COB_STATUS_10_END_OF_FILE; - } - /* LCOV_EXCL_START */ - if (st.st_size < relsize) { - return COB_STATUS_30_PERMANENT_ERROR; - } - /* LCOV_EXCL_STOP */ - - if(f->record_off == -1) { - curroff = (off_t)lseek (f->fd, (off_t)f->file_header, SEEK_SET); /* Set current file position */ - } else { - curroff = (off_t)lseek (f->fd, (off_t)0, SEEK_CUR); /* Get current file position */ - } - if (unlikely(f->flag_operation != 0)) { - f->flag_operation = 0; - } - moveback = 0; - - switch (read_opts & COB_READ_MASK) { - case COB_READ_FIRST: - curroff = f->file_header; - break; - case COB_READ_LAST: - curroff = st.st_size - f->record_slot; - moveback = 1; - break; - case COB_READ_PREVIOUS: - if (f->flag_first_read) { - break; - } else if (curroff > (f->record_slot + f->file_header)) { - curroff -= (f->record_slot * 2); - } else { - return COB_STATUS_10_END_OF_FILE; - } - moveback = 1; - break; - case COB_READ_NEXT: - default: - break; - } - - for (;;) { - if(st.st_size <= curroff) - break; - set_lock_opts (f, read_opts); - if(f->flag_lock_rec) { - relnum = ((curroff - f->file_header) / f->record_slot) + 1; - lock_record (f, relnum, f->flag_lock_mode, &errsts); - if (errsts != 0) { - switch (errsts) { - case EACCES: - case EAGAIN: - if ((f->retry_mode & COB_ADVANCING_LOCK) - || (read_opts & COB_READ_ADVANCING_LOCK)) - goto next_record; - return COB_STATUS_51_RECORD_LOCKED; - case EDEADLK: - if ((f->retry_mode & COB_ADVANCING_LOCK) - || (read_opts & COB_READ_ADVANCING_LOCK)) - goto next_record; - return COB_STATUS_52_DEAD_LOCK; - case ENOLCK: - return COB_STATUS_53_MAX_LOCKS; - default: - return COB_STATUS_30_PERMANENT_ERROR; - } - } - } - sts = relative_read_off (f, curroff); - - if (sts == COB_STATUS_00_SUCCESS) { - lseek (f->fd, (off_t)((off_t)curroff + (off_t)f->record_slot), SEEK_SET); - return COB_STATUS_00_SUCCESS; - } - if (sts == COB_STATUS_30_PERMANENT_ERROR - || sts == COB_STATUS_10_END_OF_FILE - || sts == COB_STATUS_14_OUT_OF_KEY_RANGE) { - return sts; - } -next_record: - if (moveback) { - if (curroff > (f->record_slot + f->file_header)) { - curroff -= (f->record_slot * 2); - } else { - break; - } - } else { - curroff += f->record_slot; - } - } - return COB_STATUS_10_END_OF_FILE; -} - -/* - * Write Relative record prefix - */ -static int -relative_write_size (cob_file *f, off_t off, int recsize) -{ - size_t relsize = 0; - unsigned char rechdr[8]; - - if (lseek (f->fd, off, SEEK_SET) == (off_t)-1 ) { - return -1; - } - f->record_off = off; - if (f->record_prefix > 0) { - memset(rechdr,0,sizeof(rechdr)); - switch (f->file_format) { - case COB_FILE_IS_B32: /* Was 32bit Big Endian system */ - STCOMPX4(recsize, rechdr); - break; - case COB_FILE_IS_B64: /* Was 64bit Big Endian system */ - STCOMPX4(recsize,((unsigned char *)&rechdr[4])); - break; - case COB_FILE_IS_L32: /* Was 32bit Little Endian system */ - STBINLE4(recsize, rechdr); - break; - case COB_FILE_IS_L64: /* Was 64bit Little Endian system */ - STBINLE4(recsize, rechdr); - break; - case COB_FILE_IS_MF: - if(f->record_prefix == 2) { - STCOMPX2(recsize, rechdr); - } else { - STCOMPX4(recsize, rechdr); - } - rechdr[0] |= 0x40; - break; - default: - relsize = recsize; - memcpy(rechdr, &relsize, sizeof(relsize)); /* Local native 'size_t' */ - break; - } - if (write (f->fd, rechdr, f->record_prefix) != f->record_prefix) { - return -1; - } - } - return recsize; -} - -static int -relative_padout(cob_file *f, char pad, int len) -{ - unsigned char wrk[32]; - memset(wrk, pad, sizeof(wrk)); - while(len > sizeof(wrk)) { - /* Pad out record on disk */ - if (write (f->fd, wrk, sizeof(wrk)) != sizeof(wrk)) - return 1; - len -= sizeof(wrk); - } - if(len > 0) - if (write (f->fd, wrk, len) != len) - return 1; - return 0; -} - -static int -relative_write (cob_file_api *a, cob_file *f, const int opt) -{ - off_t off; - size_t relsize; - int isdeleted=0; - int kindex,rcsz; - struct stat st; - COB_UNUSED (opt); - COB_UNUSED (a); - - rcsz = (int)f->record->size; - if (unlikely(f->flag_operation == 0)) { - f->flag_operation = 1; - } - - f->last_key = f->keys[0].field; - if (f->access_mode != COB_ACCESS_SEQUENTIAL) { - kindex = cob_get_int (f->keys[0].field) - 1; - if (kindex < 0) { - return COB_STATUS_24_KEY_BOUNDARY; - } - off = (off_t) (f->file_header + f->record_slot * kindex); - if (fstat (f->fd, &st) != 0) { - return COB_STATUS_10_END_OF_FILE; - } - if(off < st.st_size) { - relsize = relative_read_size(f, off, &isdeleted); - if ((long)relsize < 0) - return COB_STATUS_30_PERMANENT_ERROR; - if ((long)relsize > 0) { - return COB_STATUS_22_KEY_EXISTS; - } - } else { - off = (off_t)lseek (f->fd, off, SEEK_SET); /* Set current file position */ - } - } else { - if(f->record_off == -1) { - off = (off_t)lseek (f->fd, (off_t)f->file_header, SEEK_SET); /* Set current file position */ - } else { - off = (off_t)lseek (f->fd, (off_t)0, SEEK_CUR); /* Get current file position */ - } - } - - if (f->variable_record) { - f->record->size = (size_t)cob_get_int (f->variable_record); - if (unlikely(f->record->size > rcsz)) { - f->record->size = rcsz; - } - } else { - f->record->size = rcsz; - } - - relsize = relative_write_size(f, off, f->record->size); - if (relsize < 0) { - return COB_STATUS_30_PERMANENT_ERROR; - } - if (write (f->fd, f->record->data, f->record->size) != (int)f->record->size) { - return COB_STATUS_30_PERMANENT_ERROR; - } - if (relative_padout(f, ' ', f->record_max - f->record->size)) /* Pad out with SPACES */ - return COB_STATUS_30_PERMANENT_ERROR; - - if (f->file_format == COB_FILE_IS_MF) { - if ((f->file_features & COB_FILE_LS_CRLF)) { /* Windows format */ - if (write (f->fd, "\r", 1) != 1) - return COB_STATUS_30_PERMANENT_ERROR; - } - if (write (f->fd, "\n", 1) != 1) - return COB_STATUS_30_PERMANENT_ERROR; - } - - /* Update RELATIVE KEY */ - if (f->access_mode == COB_ACCESS_SEQUENTIAL) { - if (f->keys[0].field) { - f->cur_rec_num = ((off + f->record_slot - f->file_header) / f->record_slot); - cob_set_int (f->keys[0].field, (int)f->cur_rec_num); - } - } - - return COB_STATUS_00_SUCCESS; -} - -static int -relative_rewrite (cob_file_api *a, cob_file *f, const int opt) -{ - off_t off; - size_t relsize; - int relnum,isdeleted=0,errsts; - - COB_UNUSED (a); - f->flag_operation = 1; - f->last_key = f->keys[0].field; - if (f->access_mode == COB_ACCESS_SEQUENTIAL) { - off = (off_t)f->record_off; - relnum = (off - f->file_header) / f->record_slot; - } else { - relnum = cob_get_int (f->keys[0].field) - 1; - if (relnum < 0) { - return COB_STATUS_24_KEY_BOUNDARY; - } - off = f->file_header + relnum * f->record_slot; - } - relsize = relative_read_size(f, off, &isdeleted); - if (relsize < 0) - return COB_STATUS_30_PERMANENT_ERROR; - if (relsize == 0 || isdeleted) { - return COB_STATUS_23_KEY_NOT_EXISTS; - } - - set_lock_opts (f, opt); - if (f->variable_record) { - f->record->size = (size_t)cob_get_int (f->variable_record); - if (unlikely(f->record->size > f->record_max)) { - f->record->size = f->record_max; - } - } - relsize = relative_write_size(f, off, f->record->size); - if (relsize < 0) { - return COB_STATUS_30_PERMANENT_ERROR; - } - if (f->flag_record_lock) { - lock_record (f, relnum+1, 1, &errsts); - if (errsts != 0) { - switch (errsts) { - case EACCES: - case EAGAIN: - return COB_STATUS_51_RECORD_LOCKED; - case EDEADLK: - return COB_STATUS_52_DEAD_LOCK; - case ENOLCK: - return COB_STATUS_53_MAX_LOCKS; - default: - return COB_STATUS_30_PERMANENT_ERROR; - } - } - } - if (write (f->fd, f->record->data, f->record->size) != (int)f->record->size) { - return COB_STATUS_30_PERMANENT_ERROR; - } - if (relative_padout(f, ' ', f->record_max - f->record->size)) /* Pad out with SPACES */ - return COB_STATUS_30_PERMANENT_ERROR; - - if (f->file_format == COB_FILE_IS_MF) { - if(f->record_min == f->record_max) { /* Fixed size */ - if (write (f->fd, "\n", 1) != 1) - return COB_STATUS_30_PERMANENT_ERROR; - } else { - lseek (f->fd, (off_t)((off_t)off + (off_t)f->record_slot), SEEK_SET); - } - } - if (f->access_mode == COB_ACCESS_SEQUENTIAL) { - f->record_off = lseek (f->fd, (off_t)0, SEEK_CUR); /* Save current file position */ - } - if (f->flag_record_lock) { - if ((f->lock_mode & COB_LOCK_MULTIPLE)) { - if ((opt & COB_WRITE_NO_LOCK)) { - unlock_record (f, relnum+1); - } - } else { - if (!(opt & COB_WRITE_LOCK)) { - unlock_record (f, relnum+1); - } - } - } - return COB_STATUS_00_SUCCESS; -} - -static int -relative_delete (cob_file_api *a, cob_file *f) -{ - off_t off; - size_t relsize; - unsigned char rechdr[8]; - int relnum,isdeleted,errsts; - - COB_UNUSED (a); - f->flag_operation = 1; - relnum = cob_get_int (f->keys[0].field) - 1; - if (relnum < 0) { - return COB_STATUS_24_KEY_BOUNDARY; - } - off = f->file_header + relnum * f->record_slot; - relsize = relative_read_size(f, off, &isdeleted); - if (relsize < 0) - return COB_STATUS_30_PERMANENT_ERROR; - if (relsize == 0 || isdeleted) { - return COB_STATUS_23_KEY_NOT_EXISTS; - } - - set_lock_opts (f, 0); - if (lseek (f->fd, off, SEEK_SET) == (off_t)-1 ) { - return -1; - } - f->record_off = off; - if (f->flag_record_lock) { - lock_record (f, relnum+1, 1, &errsts); - if (errsts != 0) { - switch (errsts) { - case EACCES: - case EAGAIN: - return COB_STATUS_51_RECORD_LOCKED; - case EDEADLK: - return COB_STATUS_52_DEAD_LOCK; - case ENOLCK: - return COB_STATUS_53_MAX_LOCKS; - default: - return COB_STATUS_30_PERMANENT_ERROR; - } - } - } - if (f->record_prefix > 0) { - memset(rechdr,0,sizeof(rechdr)); - switch (f->file_format) { - case COB_FILE_IS_B32: /* Was 32bit Big Endian system */ - STCOMPX4(0, rechdr); - break; - case COB_FILE_IS_B64: /* Was 64bit Big Endian system */ - STCOMPX4(0,((unsigned char *)&rechdr[4])); - break; - case COB_FILE_IS_L32: /* Was 32bit Little Endian system */ - STBINLE4(0, rechdr); - break; - case COB_FILE_IS_L64: /* Was 64bit Little Endian system */ - STBINLE4(0, rechdr); - break; - case COB_FILE_IS_MF: - if(f->record_prefix == 2) { - STCOMPX2(relsize, rechdr); - } else { - STCOMPX4(relsize, rechdr); - } - rechdr[0] |= 0x20; - break; - default: - relsize = 0; - memcpy(rechdr, &relsize, sizeof(relsize)); /* Local native 'size_t' */ - break; - } - if (write (f->fd, rechdr, f->record_prefix) != f->record_prefix) { - return -1; - } - if (f->file_format == COB_FILE_IS_MF) { - if (lseek (f->fd, (off_t)(off + (off_t)f->record_slot - (off_t)1), SEEK_SET) == (off_t)-1 ) { - return COB_STATUS_30_PERMANENT_ERROR; - } - rechdr[0] = 0; - if (write (f->fd, rechdr, 1) != 1) /* 0x00 means deleted record */ - return COB_STATUS_30_PERMANENT_ERROR; - } - } else - if (f->file_format == COB_FILE_IS_MF) { - if (lseek (f->fd, (off_t)(off + (off_t)f->record_max), SEEK_SET) == (off_t)-1 ) { - return COB_STATUS_30_PERMANENT_ERROR; - } - rechdr[0] = 0; - if (write (f->fd, rechdr, 1) != 1) /* 0x00 means deleted record */ - return COB_STATUS_30_PERMANENT_ERROR; - } - lseek (f->fd, (off_t) f->record_off, SEEK_SET); - if (f->flag_record_lock) { - unlock_record (f, relnum+1); - } - return COB_STATUS_00_SUCCESS; -} - -static void -cob_file_unlock (cob_file *f) -{ - if (COB_FILE_SPECIAL(f) - || f->flag_is_pipe) { - return; - } - - if (f->open_mode != COB_OPEN_CLOSED - && f->open_mode != COB_OPEN_LOCKED) { - if (f->organization == COB_ORG_SORT) { - return; - } - if (f->organization != COB_ORG_INDEXED) { - if (f->fd >= 0) { - fdcobsync (f->fd); - } -#ifdef HAVE_FCNTL - if (f->flag_file_lock) { - /* Unlock the file */ - if (f->fd >= 0) { - struct flock lock; - memset ((void *)&lock, 0, sizeof (struct flock)); - lock.l_type = F_UNLCK; - lock.l_whence = SEEK_SET; - lock.l_start = 0; - lock.l_len = 0; - if (fcntl (f->fd, F_SETLK, &lock) == -1) { -#if 1 /* CHECKME - What is the correct thing to do here? */ - /* not translated as "testing only" */ - cob_runtime_warning ("issue during unlock (%s), errno: %d", - "cob_file_unlock", errno); -#endif - } - } - } -#endif - - } else { - fileio_funcs[get_io_ptr (f)]->iounlock (&file_api, f); - } - } -} - -/* Global functions */ - -/* - * Allocate memory for cob_file - */ -void -cob_file_create ( - cob_file ** pfl, - const char *exname, - const char *select_name, - const int fileorg, - const int accessmode, - const int optional, - const int format, - const int select_features, - const int nkeys, - const int minrcsz, - const int maxrcsz, - cob_field * assign, - cob_field * record) -{ - cob_file *fl; - int select = select_features; - int extra = 4; - if (exname == NULL) { - fl = cob_cache_malloc (sizeof (cob_file) + extra); - fl->file_version = COB_FILE_VERSION; - } else { - fl = cob_external_addr (exname, sizeof (cob_file) + extra); - select |= COB_SELECT_EXTERNAL; - if (fl->file_version == 0) - fl->file_version = COB_FILE_VERSION; - } - if (!fl->flag_ready) { - if (nkeys > 0 - && fl->keys == NULL) { - fl->keys = cob_cache_malloc (sizeof (cob_file_key) * nkeys); - } - fl->nkeys = nkeys; - memset(fl->file_status,'0',4); - fl->select_name = select_name; - fl->organization = (unsigned char)fileorg; - fl->access_mode = (unsigned char)accessmode; - fl->flag_optional = (unsigned char)optional; - fl->file_format = (unsigned char)format; - fl->flag_select_features = (unsigned char)select; - fl->assign = assign; - fl->record = record; - fl->record_min = minrcsz; - fl->record_max = maxrcsz; - fl->fd = -1; - } - *pfl = fl; -} - -/* - * Free memory for cob_file - */ -void -cob_file_destroy (cob_file **pfl) -{ - cob_file *fl; - if (pfl != NULL - && *pfl != NULL) { - fl = *pfl; - if (fl->linage) { - cob_cache_free (fl->linage); - fl->linage = NULL; - } - if (fl->keys) { - cob_cache_free (fl->keys); - fl->keys = NULL; - } - cob_cache_free (fl); - *pfl = NULL; - } -} - -/* - * Set some attributes of the file - */ -void -cob_file_set_attr ( - cob_file * fl, - cob_field * varsize, - const int lineadv, - const int features, - const unsigned char *codeset, - cob_field * password, - cob_field * cryptkey) -{ - if (fl->flag_ready) - return; - COB_UNUSED(codeset); - fl->variable_record = varsize; - fl->flag_line_adv = (unsigned char)lineadv; - fl->file_features = (unsigned char)features; - if(password) { - /* Nothing implemented at this time */ - } - if(cryptkey) { - /* Nothing implemented at this time */ - } - if(codeset) { - /* Nothing implemented at this time */ - } -} - -/* - * Define an index of the file - */ -void -cob_file_set_key ( - cob_file * fl, - const int keyn, - cob_field * key, - const int dups, - const int ascdesc, - const int len_suppress, - const unsigned char *suppress, - const int parts, - ...) /* cob_field * for each component */ -{ - cob_field *kp; - va_list args; - int i; - - if (keyn > (int)fl->nkeys - || fl->flag_ready) - return; - fl->keys[keyn].keyn = (unsigned char)keyn; - fl->keys[keyn].tf_ascending = COB_ASCENDING; - fl->keys[keyn].field = key; - if (key) - fl->keys[keyn].offset = (unsigned int)(key->data - fl->record->data); - else - fl->keys[keyn].offset = 0; - fl->keys[keyn].tf_duplicates = dups ? 1 : 0; - fl->keys[keyn].tf_ascending = (unsigned char)ascdesc; - if (len_suppress < 0 - || suppress == NULL) { - fl->keys[keyn].tf_suppress = 0; - fl->keys[keyn].char_suppress = 0; - } else { - if (len_suppress == 0) { - fl->keys[keyn].tf_suppress = 1; - fl->keys[keyn].char_suppress = (unsigned char)*suppress; - } else { - fl->keys[keyn].len_suppress = (short)len_suppress; - fl->keys[keyn].str_suppress = (unsigned char*)suppress; - if (!dups) { - fl->keys[keyn].tf_duplicates = 2; /* Precheck on RE/WRITE */ - fl->flag_write_chk_dups = 1; - } - } - } - fl->keys[keyn].count_components = (short)parts; - va_start (args, parts); - for (i=0; i < parts && i < COB_MAX_KEYCOMP; i++) { - kp = va_arg (args, cob_field *); - fl->keys[keyn].component[i] = kp; - if (i == 0) - fl->keys[keyn].offset = (unsigned int)(kp->data - fl->record->data); - } - va_end (args); -} - -/* - * Extra Define for index of the file - */ -void -cob_file_set_key_extra ( - cob_file * fl, - const int keyn, - const int compress, - const int encrypt, - cob_field * password, - const unsigned char *collate) -{ - COB_UNUSED(compress); - COB_UNUSED(encrypt); - COB_UNUSED(collate); - - if (keyn > (int)fl->nkeys - || fl->flag_ready) - return; - if(password) { - /* Nothing implemented at this time */ - } -} - -/* - * Set the file LINAGE - */ -void -cob_file_set_linage ( - cob_file * fl, - cob_field *linage, /* LINAGE */ - cob_field *linage_ctr, /* LINAGE-COUNTER */ - cob_field *latfoot, /* LINAGE FOOTING */ - cob_field *lattop, /* LINAGE AT TOP */ - cob_field *latbot) /* LINAGE AT BOTTOM */ -{ - cob_linage *l; - if (fl->linage == NULL) { - fl->linage = cob_cache_malloc (sizeof (cob_linage)); - } - l = (cob_linage *)fl->linage; - l->linage = linage; - l->linage_ctr = linage_ctr; - l->latfoot = latfoot; - l->lattop = lattop; - l->latbot = latbot; - l->lin_lines = 0; - l->lin_foot = 0; - l->lin_top = 0; - l->lin_bot = 0; -} - -/* - * Set the file lock/retry option - */ -void -cob_file_set_retry ( - cob_file * fl, - const int mode, - const int value) -{ - fl->retry_mode = (unsigned short)mode; - if (mode == COB_RETRY_TIMES) - fl->retry_times = value; - else if (mode == COB_RETRY_SECONDS) - fl->retry_seconds = value; - - if (!fl->flag_ready) { - fl->dflt_retry = (unsigned short)mode; - if (mode == COB_RETRY_TIMES) - fl->dflt_times = value; - else if (mode == COB_RETRY_SECONDS) - fl->dflt_seconds = value; - } -} - -/* - * Set the file lock option - */ -void -cob_file_set_lock ( - cob_file * fl, - const int mode) -{ - fl->lock_mode = mode; -} - -/* - * Setup of the file is now complete - */ -void -cob_file_complete ( cob_file * fl) -{ - fl->flag_ready = 1; -} -/* - * Allocate memory for 'IS EXTERNAL' cob_file - */ -void -cob_file_external_addr (const char *exname, - cob_file **pfl, cob_file_key **pky, - const int nkeys, const int linage) -{ - cob_file *fl; - fl = cob_external_addr (exname, sizeof (cob_file)); - if (fl->file_version == 0) - fl->file_version = COB_FILE_VERSION; - - if (nkeys > 0 - && fl->keys == NULL) { - fl->keys = cob_cache_malloc (sizeof (cob_file_key) * nkeys); - } - - if (pky != NULL) { - *pky = fl->keys; - } - - if (linage > 0 - && fl->linage == NULL) { - fl->linage = cob_cache_malloc (sizeof (cob_linage)); - } - *pfl = fl; -} - -/* - * Save the XFD name for this file - */ -void -cob_file_xfdname (cob_file *fl, const char *name) -{ - fl->xfdname = name; -} - -/* - * Allocate memory for cob_file - */ -void -cob_file_malloc (cob_file **pfl, cob_file_key **pky, - const int nkeys, const int linage) -{ - cob_file *fl; - fl = cob_cache_malloc (sizeof (cob_file)); - fl->file_version = COB_FILE_VERSION; - - if (nkeys > 0 - && pky != NULL) { - *pky = fl->keys = cob_cache_malloc (sizeof (cob_file_key) * nkeys); - } - - if (linage > 0) { - fl->linage = cob_cache_malloc (sizeof (cob_linage)); - } - *pfl = fl; -} - -/* - * Free memory for cob_file - */ -void -cob_file_free (cob_file **pfl, cob_file_key **pky) -{ - cob_file *fl; - if (pky != NULL) { - if (*pky != NULL) { - cob_cache_free (*pky); - *pky = NULL; - } - } - if (pfl != NULL && *pfl != NULL) { - fl = *pfl; - if (fl->linage) { - cob_cache_free (fl->linage); - fl->linage = NULL; - } - if (*pfl != NULL) { - cob_cache_free (*pfl); - *pfl = NULL; - } - } -} - - -void -cob_unlock_file (cob_file *f, cob_field *fnstatus) -{ - cob_file_unlock (f); - cob_file_save_status (f, fnstatus, COB_STATUS_00_SUCCESS); -} - -/* - * Prepare for Open of data file; Used by fextfh.c - */ -void -cob_pre_open (cob_file *f) -{ - f->flag_file_map = 0; - f->flag_nonexistent = 0; - f->flag_end_of_file = 0; - f->flag_begin_of_file = 0; - f->flag_first_read = 2; - f->flag_operation = 0; - f->lock_mode &= ~COB_LOCK_OPEN_EXCLUSIVE; - f->record_off = 0; - f->max_rec_num = 0; - f->cur_rec_num = 0; - - cob_set_file_defaults (f); - - /* Obtain the file name */ - if (f->assign != NULL - && f->assign->data != NULL) { - cob_field_to_string (f->assign, file_open_name, (size_t)COB_FILE_MAX); - - f->flag_file_map = 1; - cob_chk_file_mapping (f); - - cob_set_file_format (f, file_open_io_env, 1, NULL); - } - - if (f->organization == COB_ORG_INDEXED - && f->flag_auto_type) { - int ftype; - ftype = indexed_file_type (file_open_name); - if(ftype >= 0) { - f->record_min = f->record_max; - f->io_routine = (unsigned char)ftype; - } - } -} - -/* - * Open the data file - */ -void -cob_open (cob_file *f, const int mode, const int sharing, cob_field *fnstatus) -{ - if (f->file_version != COB_FILE_VERSION) { - cob_runtime_error (_("ERROR FILE %s does not match current version; Recompile the program"), - f->select_name); - cob_stop_run (1); - } - - f->last_operation = COB_LAST_OPEN; - f->flag_read_done = 0; - f->curkey = -1; - - /* File was previously closed with lock */ - if (f->open_mode == COB_OPEN_LOCKED) { - cob_file_save_status (f, fnstatus, COB_STATUS_38_CLOSED_WITH_LOCK); - return; - } - - /* File is already open */ - if (f->open_mode != COB_OPEN_CLOSED) { - cob_file_save_status (f, fnstatus, COB_STATUS_41_ALREADY_OPEN); - return; - } - - f->last_open_mode = (unsigned char)mode; - f->share_mode = (unsigned char)sharing; - if (mode == COB_OPEN_OUTPUT) - f->cur_rec_num = f->max_rec_num = 0; - - if (f->fcd) - cob_fcd_file_sync (f, file_open_name); /* Copy app's FCD to cob_file */ - - cob_pre_open (f); - - if (unlikely (COB_FILE_STDIN (f))) { - if (mode != COB_OPEN_INPUT) { - cob_file_save_status (f, fnstatus, COB_STATUS_30_PERMANENT_ERROR); - return; - } - f->file = stdin; - f->fd = fileno (stdin); - f->open_mode = (unsigned char)mode; - cob_file_save_status (f, fnstatus, COB_STATUS_00_SUCCESS); - return; - } - if (unlikely (COB_FILE_STDOUT (f))) { - if (mode != COB_OPEN_OUTPUT) { - cob_file_save_status (f, fnstatus, COB_STATUS_30_PERMANENT_ERROR); - return; - } - f->file = stdout; - f->fd = fileno (stdout); - f->open_mode = (unsigned char)mode; - cob_file_save_status (f, fnstatus, COB_STATUS_00_SUCCESS); - return; - } - - if (f->assign == NULL) { - cob_runtime_error (_("ERROR FILE %s has ASSIGN field is NULL"), - f->select_name); - cob_file_save_status (f, fnstatus, COB_STATUS_31_INCONSISTENT_FILENAME); - return; - } - if (f->assign->data == NULL) { - cob_file_save_status (f, fnstatus, COB_STATUS_31_INCONSISTENT_FILENAME); - return; - } - - cob_cache_file (f); - - /* Open the file */ - cob_file_save_status (f, fnstatus, - fileio_funcs[get_io_ptr (f)]->open (&file_api, f, file_open_name, - mode, sharing)); -} - -void -cob_close (cob_file *f, cob_field *fnstatus, const int opt, const int remfil) -{ - int ret; - - f->last_operation = COB_LAST_CLOSE; - f->flag_read_done = 0; - f->record_off = 0; - - f->lock_mode &= ~COB_LOCK_OPEN_EXCLUSIVE; - - if (COB_FILE_SPECIAL (f)) { - f->open_mode = COB_OPEN_CLOSED; - f->file = NULL; - f->fd = -1; - cob_file_save_status (f, fnstatus, COB_STATUS_00_SUCCESS); - return; - } - - if (unlikely (remfil)) { - /* Remove from cache - Needed for CANCEL */ - cob_cache_del (f); - } - - if (f->open_mode == COB_OPEN_CLOSED) { - cob_file_save_status (f, fnstatus, COB_STATUS_42_NOT_OPEN); - return; - } - - if (f->flag_nonexistent) { - ret = COB_STATUS_00_SUCCESS; - } else { - ret = fileio_funcs[get_io_ptr (f)]->close (&file_api, f, opt); - } - - if (ret == COB_STATUS_00_SUCCESS) { - switch (opt) { - case COB_CLOSE_LOCK: - f->open_mode = COB_OPEN_LOCKED; - break; - default: - f->open_mode = COB_OPEN_CLOSED; - break; - } - } - - cob_file_save_status (f, fnstatus, ret); - f->flag_file_map = 0; - f->flag_nonexistent = 0; - f->flag_end_of_file = 0; - f->flag_begin_of_file = 0; - f->flag_first_read = 2; - f->max_rec_num = 0; - f->cur_rec_num = 0; -} - -void -cob_start (cob_file *f, const int cond, cob_field *key, - cob_field *keysize, cob_field *fnstatus) -{ - int ret; - int size; - cob_field tempkey; - - f->last_operation = COB_LAST_START; - f->last_key = key; - f->flag_read_done = 0; - f->flag_first_read = 0; - - if (unlikely (f->open_mode != COB_OPEN_I_O - && f->open_mode != COB_OPEN_INPUT)) { - cob_file_save_status (f, fnstatus, COB_STATUS_47_INPUT_DENIED); - return; - } - - if (unlikely (f->access_mode == COB_ACCESS_RANDOM)) { - cob_file_save_status (f, fnstatus, COB_STATUS_47_INPUT_DENIED); - return; - } - - if (f->flag_nonexistent) { - cob_file_save_status (f, fnstatus, COB_STATUS_23_KEY_NOT_EXISTS); - return; - } - - size = 0; - if (unlikely (keysize)) { - size = cob_get_int (keysize); - if (size < 1 || size > (int)key->size) { - cob_file_save_status (f, fnstatus, COB_STATUS_23_KEY_NOT_EXISTS); - return; - } - tempkey = *key; - tempkey.size = (size_t)size; - f->last_key = &tempkey; - ret = fileio_funcs[get_io_ptr (f)]->start (&file_api, f, cond, &tempkey); - } else { - ret = fileio_funcs[get_io_ptr (f)]->start (&file_api, f, cond, key); - } - if (ret == COB_STATUS_00_SUCCESS) { - f->flag_end_of_file = 0; - f->flag_begin_of_file = 0; - f->flag_first_read = 1; - } else { - f->flag_end_of_file = 1; - f->flag_begin_of_file = 0; - f->flag_first_read = 1; - } - - cob_file_save_status (f, fnstatus, ret); -} - -void -cob_read (cob_file *f, cob_field *key, cob_field *fnstatus, const int read_opts) -{ - int ret; - - f->flag_read_done = 0; - f->last_operation = COB_LAST_READ; - f->last_key = key; - - if (unlikely (f->open_mode != COB_OPEN_INPUT - && f->open_mode != COB_OPEN_I_O)) { - cob_file_save_status (f, fnstatus, COB_STATUS_47_INPUT_DENIED); - return; - } - - if (unlikely (f->flag_nonexistent)) { - if (f->flag_first_read == 0) { - cob_file_save_status (f, fnstatus, COB_STATUS_23_KEY_NOT_EXISTS); - return; - } - f->flag_first_read = 0; - cob_file_save_status (f, fnstatus, COB_STATUS_10_END_OF_FILE); - return; - } - - if (f->organization == COB_ORG_RELATIVE) { - if (f->access_mode == COB_ACCESS_SEQUENTIAL) { - if (f->cur_rec_num < 1) - f->cur_rec_num = 1; - else - f->cur_rec_num++; - cob_set_int (f->keys[0].field, (int)f->cur_rec_num); - } else { - f->cur_rec_num = cob_get_int (f->keys[0].field); - } - } - /* Sequential read at the end of file is an error */ - if (key == NULL) { - f->last_operation = COB_LAST_READ_SEQ; - if (unlikely(f->flag_end_of_file && - !(read_opts & COB_READ_PREVIOUS))) { - cob_file_save_status (f, fnstatus, COB_STATUS_46_READ_ERROR); - return; - } - if (unlikely (f->flag_begin_of_file - && (read_opts & COB_READ_PREVIOUS))) { - cob_file_save_status (f, fnstatus, COB_STATUS_46_READ_ERROR); - return; - } - ret = fileio_funcs[get_io_ptr (f)]->read_next (&file_api, f, read_opts); - } else { - ret = fileio_funcs[get_io_ptr (f)]->read (&file_api, f, key, read_opts); - } - - switch (ret) { - case COB_STATUS_00_SUCCESS: - case COB_STATUS_02_SUCCESS_DUPLICATE: - f->flag_first_read = 0; - f->flag_read_done = 1; - f->flag_end_of_file = 0; - f->flag_begin_of_file = 0; - if (f->variable_record) { - cob_set_int (f->variable_record, (int) f->record->size); - } - break; - case COB_STATUS_10_END_OF_FILE: - if (read_opts & COB_READ_PREVIOUS) { - f->flag_begin_of_file = 1; - } else { - f->flag_end_of_file = 1; - } - break; - } - - cob_file_save_status (f, fnstatus, ret); -} - -static int -cob_chk_dups (cob_file *f) -{ - void *savrec; - int k; - int ret = COB_STATUS_00_SUCCESS; - - savrec = cob_malloc (f->record->size); - memcpy (savrec, f->record->data, f->record->size); - - for (k = 0; k < (int)f->nkeys; ++k) { - if (f->keys[k].tf_duplicates == 2) { - memcpy (f->record->data, savrec, f->record->size); - if (f->keys[k].len_suppress > 0) { - cob_savekey (f, k, f->keys[k].field->data); - if (memcmp(f->keys[k].field->data, f->keys[k].str_suppress, - f->keys[k].len_suppress) == 0) - continue; - } - ret = fileio_funcs[get_io_ptr (f)]->read (&file_api, f, f->keys[k].field, 0); - if (ret == COB_STATUS_00_SUCCESS - || ret == COB_STATUS_02_SUCCESS_DUPLICATE) { - ret = COB_STATUS_22_KEY_EXISTS; - break; - } - ret = COB_STATUS_00_SUCCESS; - } - } - - memcpy (f->record->data, savrec, f->record->size); - cob_free (savrec); - return ret; -} - -void -cob_read_next (cob_file *f, cob_field *fnstatus, const int read_opts) -{ - int ret,idx,pos; - - f->last_operation = COB_LAST_READ_SEQ; - f->flag_read_done = 0; - - if (unlikely (f->open_mode != COB_OPEN_INPUT - && f->open_mode != COB_OPEN_I_O)) { - cob_file_save_status (f, fnstatus, COB_STATUS_47_INPUT_DENIED); - return; - } - - if (unlikely (f->flag_nonexistent)) { - if (f->flag_first_read == 0) { - cob_file_save_status (f, fnstatus, COB_STATUS_46_READ_ERROR); - return; - } - f->flag_first_read = 0; - cob_file_save_status (f, fnstatus, COB_STATUS_10_END_OF_FILE); - return; - } - - /* Sequential read at the end of file is an error */ - if (unlikely (f->flag_end_of_file && !(read_opts & COB_READ_PREVIOUS))) { - cob_file_save_status (f, fnstatus, COB_STATUS_46_READ_ERROR); - return; - } - if (unlikely (f->flag_begin_of_file && (read_opts & COB_READ_PREVIOUS))) { - cob_file_save_status (f, fnstatus, COB_STATUS_46_READ_ERROR); - return; - } - -Again: - if (f->organization == COB_ORG_RELATIVE) { - if (f->access_mode == COB_ACCESS_SEQUENTIAL) { - if (read_opts & COB_READ_PREVIOUS) { - if (f->cur_rec_num < 1) - f->cur_rec_num = 1; - f->cur_rec_num--; - } else { - if (f->cur_rec_num < 1) - f->cur_rec_num = 1; - else - f->cur_rec_num++; - } - cob_set_int (f->keys[0].field, (int)f->cur_rec_num); - } else { - f->cur_rec_num = cob_get_int (f->keys[0].field); - } - } - ret = fileio_funcs[get_io_ptr (f)]->read_next (&file_api, f, read_opts); - - switch (ret) { - case COB_STATUS_00_SUCCESS: - case COB_STATUS_02_SUCCESS_DUPLICATE: - /* If record has suppressed key, skip it */ - /* This is to catch old VBISAM, ODBC & OCI */ - idx = f->curkey; - if ((idx >= 0 && idx < (int)f->nkeys) - && f->keys[idx].len_suppress > 0) { - pos = cob_savekey (f, idx, f->keys[idx].field->data); - if (memcmp(f->keys[idx].field->data, f->keys[idx].str_suppress, - f->keys[idx].len_suppress) == 0) { - goto Again; - } - } else - if ((idx >= 0 && idx < (int)f->nkeys) - && f->keys[idx].tf_suppress) { - pos = cob_savekey (f, idx, f->keys[idx].field->data); - for (pos = 0; pos < (int)f->keys[idx].field->size - && f->keys[idx].field->data[pos] == (unsigned char)f->keys[idx].char_suppress; - pos++); - if (pos == f->keys[idx].field->size) /* All SUPPRESS char so skip */ - goto Again; - } - - f->flag_first_read = 0; - f->flag_read_done = 1; - f->flag_end_of_file = 0; - f->flag_begin_of_file = 0; - if (f->variable_record) { - cob_set_int (f->variable_record, (int) f->record->size); - } - break; - case COB_STATUS_10_END_OF_FILE: - if (read_opts & COB_READ_PREVIOUS) { - f->flag_begin_of_file = 1; - } else { - f->flag_end_of_file = 1; - } - break; - } - - cob_file_save_status (f, fnstatus, ret); -} - -void -cob_write (cob_file *f, cob_field *rec, const int opt, cob_field *fnstatus, - const unsigned int check_eop) -{ - int ret; - - f->last_operation = COB_LAST_WRITE; - f->last_key = NULL; - f->flag_read_done = 0; - - if (f->flag_is_pipe) { - if (f->open_mode == COB_OPEN_INPUT) { - cob_file_save_status (f, fnstatus, COB_STATUS_48_OUTPUT_DENIED); - return; - } - } else - if (f->access_mode == COB_ACCESS_SEQUENTIAL) { - if (unlikely (f->open_mode != COB_OPEN_OUTPUT - && f->open_mode != COB_OPEN_EXTEND)) { - cob_file_save_status (f, fnstatus, COB_STATUS_48_OUTPUT_DENIED); - return; - } - f->cur_rec_num++; - } else { - if (unlikely (f->open_mode != COB_OPEN_OUTPUT - && f->open_mode != COB_OPEN_I_O)) { - cob_file_save_status (f, fnstatus, COB_STATUS_48_OUTPUT_DENIED); - return; - } - } - - if (f->variable_record) { - f->record->size = (size_t)cob_get_int (f->variable_record); - if (unlikely (f->record->size > rec->size)) { - f->record->size = rec->size; - } - } else if (f->flag_redef) { - f->record->size = f->record_max; - } else { - f->record->size = rec->size; - } - - if (f->record->size < f->record_min || f->record_max < f->record->size) { - cob_file_save_status (f, fnstatus, COB_STATUS_44_RECORD_OVERFLOW); - return; - } - - if (f->flag_write_chk_dups) { - if ((ret = cob_chk_dups (f)) != 0) { - cob_file_save_status (f, fnstatus, ret); - return; - } - } - - if (f->organization == COB_ORG_RELATIVE) { - if (f->access_mode == COB_ACCESS_SEQUENTIAL - && (f->open_mode == COB_OPEN_OUTPUT - || f->open_mode == COB_OPEN_EXTEND)) { - f->cur_rec_num = f->max_rec_num + 1; - if (f->cur_rec_num < 1) - f->cur_rec_num = 1; - cob_set_int (f->keys[0].field, (int)f->cur_rec_num); - } else { - f->cur_rec_num = cob_get_int (f->keys[0].field); - } - } - check_eop_status = check_eop; - cob_file_save_status (f, fnstatus, - fileio_funcs[get_io_ptr (f)]->write (&file_api, f, opt)); - if (f->cur_rec_num > f->max_rec_num - && f->file_status[0] == '0') - f->max_rec_num = f->cur_rec_num; - f->flag_begin_of_file = 0; -} - -void -cob_rewrite (cob_file *f, cob_field *rec, const int opt, cob_field *fnstatus) -{ - int read_done, ret; - - read_done = f->flag_read_done; - f->flag_read_done = 0; - f->last_operation = COB_LAST_REWRITE; - f->last_key = NULL; - - if (unlikely (f->open_mode != COB_OPEN_I_O)) { - cob_file_save_status (f, fnstatus, COB_STATUS_49_I_O_DENIED); - return; - } - - if (f->access_mode == COB_ACCESS_SEQUENTIAL && !read_done) { - cob_file_save_status (f, fnstatus, COB_STATUS_43_READ_NOT_DONE); - return; - } - - if (unlikely (f->organization == COB_ORG_SEQUENTIAL)) { - if (f->record->size != rec->size) { - cob_file_save_status (f, fnstatus, COB_STATUS_44_RECORD_OVERFLOW); - return; - } - - if (f->variable_record) { - if (f->record->size != (size_t)cob_get_int (f->variable_record)) { - cob_file_save_status (f, fnstatus, COB_STATUS_44_RECORD_OVERFLOW); - return; - } - } - } - - if (f->variable_record) { - f->record->size = (size_t)cob_get_int (f->variable_record); - if (unlikely(f->record->size > rec->size)) { - f->record->size = rec->size; - } - if (f->record->size < f->record_min || f->record_max < f->record->size) { - cob_file_save_status (f, fnstatus, COB_STATUS_44_RECORD_OVERFLOW); - return; - } - } else if (f->flag_redef) { - f->record->size = f->record_max; - } - - if (f->flag_write_chk_dups) { - if ((ret = cob_chk_dups (f)) != 0) { - cob_file_save_status (f, fnstatus, ret); - return; - } - } - cob_file_save_status (f, fnstatus, - fileio_funcs[get_io_ptr (f)]->rewrite (&file_api, f, opt)); -} - -void -cob_delete (cob_file *f, cob_field *fnstatus) -{ - int read_done; - - read_done = f->flag_read_done; - f->flag_read_done = 0; - f->last_operation = COB_LAST_DELETE; - - if (unlikely (f->open_mode != COB_OPEN_I_O)) { - cob_file_save_status (f, fnstatus, COB_STATUS_49_I_O_DENIED); - return; - } - - if (f->access_mode == COB_ACCESS_SEQUENTIAL && !read_done) { - cob_file_save_status (f, fnstatus, COB_STATUS_43_READ_NOT_DONE); - return; - } - - cob_file_save_status (f, fnstatus, - fileio_funcs[get_io_ptr (f)]->recdelete (&file_api, f)); -} - -void -cob_commit (void) -{ - struct file_list *l; - - for (l = file_cache; l; l = l->next) { - if (l->file) { -#if 0 /* This should not really call file_unlock */ - l->file->last_operation = COB_LAST_COMMIT; - cob_file_unlock (l->file); -#endif - l->file->last_operation = COB_LAST_COMMIT; - fileio_funcs[get_io_ptr (l->file)]->commit (&file_api, l->file); - } - } -} - -void -cob_rollback (void) -{ - struct file_list *l; - - for (l = file_cache; l; l = l->next) { - if (l->file) { -#if 0 /* This should not really call file_unlock */ - l->file->last_operation = COB_LAST_ROLLBACK; - cob_file_unlock (l->file); -#endif - l->file->last_operation = COB_LAST_ROLLBACK; - fileio_funcs[get_io_ptr (l->file)]->rollback (&file_api, l->file); - } - } -} - -void -cob_delete_file (cob_file *f, cob_field *fnstatus) -{ - f->last_operation = COB_LAST_DELETE_FILE; - if (f->organization == COB_ORG_SORT) { - cob_file_save_status (f, fnstatus, COB_STATUS_30_PERMANENT_ERROR); - return; - } - - /* File was previously closed with lock */ - if (f->open_mode == COB_OPEN_LOCKED) { - cob_file_save_status (f, fnstatus, COB_STATUS_38_CLOSED_WITH_LOCK); - return; - } - - /* File is open */ - if (f->open_mode != COB_OPEN_CLOSED) { - cob_file_save_status (f, fnstatus, COB_STATUS_41_ALREADY_OPEN); - return; - } - - if (unlikely (COB_FILE_STDIN (f) || COB_FILE_STDOUT (f))) { - cob_file_save_status (f, fnstatus, COB_STATUS_30_PERMANENT_ERROR); - return; - } - - /* Obtain the file name */ - cob_field_to_string (f->assign, file_open_name, (size_t)COB_FILE_MAX); - cob_chk_file_mapping (f); - - if (f->organization != COB_ORG_INDEXED) { - unlink (file_open_name); - } else { - cob_file_save_status (f, fnstatus, - fileio_funcs[get_io_ptr (f)]->fildelete (&file_api, f, file_open_name)); - return; - } - cob_file_save_status (f, fnstatus, errno_cob_sts(COB_STATUS_00_SUCCESS)); -} - -/* Return index number for given key */ -int -cob_findkey (cob_file *f, cob_field *kf, int *fullkeylen, int *partlen) -{ - int k,part; - *fullkeylen = *partlen = 0; - - for (k = 0; k < (int)f->nkeys; ++k) { - if (f->keys[k].field - && f->keys[k].count_components <= 1 - && f->keys[k].field->data == kf->data) { - f->last_key = f->keys[k].field; - *fullkeylen = f->keys[k].field->size; - *partlen = kf->size; - return k; - } - } - for (k = 0; k < (int)f->nkeys; ++k) { - if (f->keys[k].count_components > 1) { - if ((f->keys[k].field - && f->keys[k].field->data == kf->data - && f->keys[k].field->size == kf->size) - || (f->keys[k].component[0]->data == kf->data)) { - f->last_key = f->keys[k].field; - for(part=0; part < f->keys[k].count_components; part++) - *fullkeylen += f->keys[k].component[part]->size; - if(f->keys[k].field && f->keys[k].field->data == kf->data) - *partlen = kf->size; - else - *partlen = *fullkeylen; - return k; - } - } - } - return -1; -} - -/* System routines */ - -/* Copy key data and return length of data copied */ -static int -cob_savekey (cob_file *f, int idx, unsigned char *data) -{ - int len,part; - - if (f->keys[idx].field == NULL) - return -1; - if (f->keys[idx].count_components <= 1) { - memcpy (data, f->keys[idx].field->data, f->keys[idx].field->size); - return (int)f->keys[idx].field->size; - } - for(len=part=0; part < f->keys[idx].count_components; part++) { - memcpy (&data[len], f->keys[idx].component[part]->data, - f->keys[idx].component[part]->size); - len += f->keys[idx].component[part]->size; - } - return len; -} - -static void * -cob_param_no_quotes (int n) -{ - int i, j; - char *s; - - s = cob_get_picx_param (n, NULL, 0); - if (s == NULL) - return NULL; - for (i = j = 0; s[j] != 0; j++) { - if (s[j] == '"') { - continue; - } - s[i++] = s[j]; - } - s[i] = 0; - return (void*)s; -} - -static int -open_cbl_file (cob_u8_ptr file_name, int file_access, - cob_u8_ptr file_handle, const int file_flags) -{ - char *fn; - int flag = O_BINARY; - int fd; - - COB_UNUSED (file_name); - - fn = cob_param_no_quotes (1); - if (fn == NULL) { - memset (file_handle, -1, (size_t)4); - return -1; - } - flag |= file_flags; - switch (file_access & 0x3F) { - case 1: - flag |= O_RDONLY; - break; - case 2: - flag |= O_CREAT | O_TRUNC | O_WRONLY; - break; - case 3: - flag |= O_RDWR; - break; - default: - cob_runtime_warning (_("call to CBL_OPEN_FILE with wrong access mode: %d"), file_access & 0x3F); - memset (file_handle, -1, (size_t)4); - return -1; - } - fd = open (fn, flag, COB_FILE_MODE); - if (fd < 0) { - cob_free (fn); - memset (file_handle, -1, (size_t)4); - return 35; - } - cob_free (fn); - memcpy (file_handle, &fd, (size_t)4); - return 0; -} - -int -cob_sys_open_file (unsigned char *file_name, unsigned char *file_access, - unsigned char *file_lock, unsigned char *file_dev, - unsigned char *file_handle) -{ - COB_UNUSED (file_access); - COB_UNUSED (file_lock); - COB_UNUSED (file_dev); - - COB_CHK_PARMS (CBL_OPEN_FILE, 5); - - return open_cbl_file (file_name, (int)cob_get_s64_param (2), file_handle, 0); -} - -int -cob_sys_create_file (unsigned char *file_name, unsigned char *file_access, - unsigned char *file_lock, unsigned char *file_dev, - unsigned char *file_handle) -{ - int p_lock, p_dev; - COB_UNUSED (file_access); - COB_UNUSED (file_lock); - COB_UNUSED (file_dev); - /* - * @param: file_access : 1 (read-only), 2 (write-only), 3 (both) - * @param: file_lock : not implemented, set 0 - * @param: file_dev : not implemented, set 0 - */ - p_lock = (int)cob_get_s64_param (3); - p_dev = (int)cob_get_s64_param (4); - - COB_CHK_PARMS (CBL_CREATE_FILE, 5); - - if (p_lock != 0) { - cob_runtime_warning (_("call to CBL_CREATE_FILE with wrong file_lock: %d"), p_lock); - } - if (p_dev != 0) { - cob_runtime_warning (_("call to CBL_CREATE_FILE with wrong file_dev: %d"), p_dev); - } - - return open_cbl_file (file_name, (int)cob_get_s64_param (2), file_handle, O_CREAT | O_TRUNC); -} - -int -cob_sys_read_file (unsigned char *file_handle, unsigned char *file_offset, - unsigned char *file_len, unsigned char *flags, - unsigned char *buf) -{ - cob_s64_t off; - int fd; - size_t len; - int rc; - struct stat st; - cob_u8_ptr p_flags; - - COB_UNUSED (file_len); - COB_UNUSED (flags); - COB_UNUSED (file_offset); - COB_CHK_PARMS (CBL_READ_FILE, 5); - - rc = 0; - memcpy (&fd, file_handle, (size_t)4); - off = cob_get_s64_param (2); - len = (size_t)cob_get_s64_param (3); - p_flags = cob_get_param_data (4); - if (lseek (fd, (off_t)off, SEEK_SET) == (off_t)-1) { - return -1; - } - if (len > 0) { - rc = read (fd, buf, len); - if (rc < 0) { - rc = -1; - } else if (rc == 0) { - rc = 10; - } else { - rc = 0; - } - } - if ((*p_flags & 0x80) != 0) { - if (fstat (fd, &st) < 0) { - return -1; - } - cob_put_s64_param ( 2, (cob_s64_t) st.st_size); - } - return rc; -} - -int -cob_sys_write_file (unsigned char *file_handle, unsigned char *file_offset, - unsigned char *file_len, unsigned char *flags, - unsigned char *buf) -{ - cob_s64_t off; - int fd; - size_t len; - int rc; - - COB_UNUSED (flags); - COB_UNUSED (file_len); - COB_UNUSED (file_offset); - - COB_CHK_PARMS (CBL_WRITE_FILE, 5); - - memcpy (&fd, file_handle, (size_t)4); - off = cob_get_s64_param (2); - len = (size_t)cob_get_s64_param (3); - if (lseek (fd, (off_t)off, SEEK_SET) == (off_t)-1) { - return -1; - } - rc = (int) write (fd, buf, (size_t)len); - if (rc != (int)len) { - return COB_STATUS_30_PERMANENT_ERROR; - } - return COB_STATUS_00_SUCCESS; -} - -int -cob_sys_close_file (unsigned char *file_handle) -{ - int fd; - - COB_CHK_PARMS (CBL_CLOSE_FILE, 1); - - memcpy (&fd, file_handle, (size_t)4); - return close (fd); -} - -int -cob_sys_flush_file (unsigned char *file_handle) -{ - COB_UNUSED (file_handle); - - COB_CHK_PARMS (CBL_FLUSH_FILE, 1); - - return 0; -} - -int -cob_sys_delete_file (unsigned char *file_name) -{ - char *fn; - int ret; - - COB_UNUSED (file_name); - - COB_CHK_PARMS (CBL_DELETE_FILE, 1); - - fn = cob_param_no_quotes (1); - if (fn == NULL) { - return -1; - } - ret = unlink (fn); - cob_free (fn); - if (ret) { - return 128; - } - return 0; -} - -int -cob_sys_copy_file (unsigned char *fname1, unsigned char *fname2) -{ - char *fn1; - char *fn2; - int flag = O_BINARY; - int ret; - int i; - int fd1, fd2; - - COB_UNUSED (fname1); - COB_UNUSED (fname2); - - COB_CHK_PARMS (CBL_COPY_FILE, 2); - - fn1 = cob_param_no_quotes (1); - if (fn1 == NULL) { - return -1; - } - fn2 = cob_param_no_quotes (2); - if (fn2 == NULL) { - cob_free (fn1); - return -1; - } - flag |= O_RDONLY; - fd1 = open (fn1, flag, 0); - if (fd1 < 0) { - cob_free (fn1); - cob_free (fn2); - return -1; - } - flag &= ~O_RDONLY; - flag |= O_CREAT | O_TRUNC | O_WRONLY; - fd2 = open (fn2, flag, COB_FILE_MODE); - if (fd2 < 0) { - close (fd1); - cob_free (fn1); - cob_free (fn2); - return -1; - } - - ret = 0; - while ((i = read (fd1, file_open_buff, COB_FILE_BUFF)) > 0) { - if ((size_t)write (fd2, file_open_buff, (size_t)i) != (size_t)i) { - ret = -1; - break; - } - } - close (fd1); - close (fd2); - cob_free (fn1); - cob_free (fn2); - return ret; -} - -int -cob_sys_check_file_exist (unsigned char *file_name, unsigned char *file_info) -{ - char *fn; - struct tm *tm; - cob_s64_t sz; - struct stat st; - short y; - short d, m, hh, mm, ss; - - COB_UNUSED (file_name); - - COB_CHK_PARMS (CBL_CHECK_FILE_EXIST, 2); - - fn = cob_param_no_quotes (1); - if (fn == NULL) { - return -1; - } - if (cob_get_param_size(2) < 16) { - cob_runtime_error (_("'%s' - File detail area is too short"), "CBL_CHECK_FILE_EXIST"); - cob_stop_run (1); - } - - if (stat (fn, &st) < 0) { - cob_free (fn); - return 35; - } - cob_free (fn); - sz = (cob_s64_t)st.st_size; - tm = localtime (&st.st_mtime); - d = (short)tm->tm_mday; - m = (short)(tm->tm_mon + 1); - y = (short)(tm->tm_year + 1900); - hh = (short)tm->tm_hour; - mm = (short)tm->tm_min; - /* Leap seconds ? */ - if (tm->tm_sec >= 60) { - ss = 59; - } else { - ss = (short)tm->tm_sec; - } - -#ifndef WORDS_BIGENDIAN - sz = COB_BSWAP_64 (sz); - y = COB_BSWAP_16 (y); -#endif - memcpy (file_info, &sz, (size_t)8); - file_info[8] = (unsigned char)d; - file_info[9] = (unsigned char)m; - memcpy (file_info+10, &y, (size_t)2); - file_info[12] = (unsigned char)hh; - file_info[13] = (unsigned char)mm; - file_info[14] = (unsigned char)ss; - file_info[15] = 0; - return 0; -} - -int -cob_sys_rename_file (unsigned char *fname1, unsigned char *fname2) -{ - char *fn1; - char *fn2; - int ret; - - COB_UNUSED (fname1); - COB_UNUSED (fname2); - - COB_CHK_PARMS (CBL_RENAME_FILE, 2); - - fn1 = cob_param_no_quotes (1); - if (fn1 == NULL) { - return -1; - } - fn2 = cob_param_no_quotes (2); - if (fn2 == NULL) { - cob_free (fn1); - return -1; - } - ret = rename (fn1, fn2); - cob_free (fn1); - cob_free (fn2); - if (ret) { - return 128; - } - return 0; -} - -int -cob_sys_get_current_dir (const int p1, const int p2, unsigned char *p3) -{ - char *dirname, *dir; - int dir_size, dir_length, flags; - int has_space; - - COB_UNUSED (p1); - COB_UNUSED (p2); - COB_UNUSED (p3); - COB_CHK_PARMS (CBL_GET_CURRENT_DIR, 3); - - flags = (int)cob_get_s64_param (1); - dir_length = (int)cob_get_s64_param (2); - dir = cob_get_param_data (3); - - if (dir_length < 1) { - return 128; - } - if (flags) { - return 129; - } - memset (dir, ' ', (size_t)dir_length); - dirname = getcwd (NULL, (size_t)0); - if (dirname == NULL) { - return 128; - } - dir_size = (int) strlen (dirname); - has_space = 0; - if (strchr (dirname, ' ')) { - has_space = 2; - } - if (dir_size + has_space > dir_length) { - cob_free (dirname); - return 128; - } - if (has_space) { - *dir = '"'; - memcpy (&dir[1], dirname, (size_t)dir_size); - dir[dir_size + 1] = '"'; - } else { - memcpy (dir, dirname, (size_t)dir_size); - } - free (dirname); - return 0; -} - -int -cob_sys_create_dir (unsigned char *dir) -{ - char *fn; - int ret; - - COB_UNUSED (dir); - - COB_CHK_PARMS (CBL_CREATE_DIR, 1); - - fn = cob_param_no_quotes (1); - if (fn == NULL) { - return -1; - } -#ifdef _WIN32 - ret = mkdir (fn); -#else - ret = mkdir (fn, 0770); -#endif - cob_free (fn); - if (ret) { - return 128; - } - return 0; -} - -int -cob_sys_change_dir (unsigned char *dir) -{ - char *fn; - int ret; - - COB_UNUSED (dir); - - COB_CHK_PARMS (CBL_CHANGE_DIR, 1); - - fn = cob_param_no_quotes (1); - if (fn == NULL) { - return -1; - } - ret = chdir (fn); - cob_free (fn); - if (ret) { - return 128; - } - return 0; -} - -int -cob_sys_delete_dir (unsigned char *dir) -{ - char *fn; - int ret; - - COB_UNUSED (dir); - - COB_CHK_PARMS (CBL_DELETE_DIR, 1); - - fn = cob_param_no_quotes (1); - if (fn == NULL) { - return -1; - } - ret = rmdir (fn); - cob_free (fn); - if (ret) { - return 128; - } - return 0; -} - -int -cob_sys_mkdir (unsigned char *dir) -{ - int ret; - - COB_CHK_PARMS (C$MAKEDIR, 1); - - ret = cob_sys_create_dir (dir); - if (ret < 0) { - ret = 128; - } - return ret; -} - -int -cob_sys_chdir (unsigned char *dir, unsigned char *status) -{ - int ret; - - COB_UNUSED (status); - - COB_CHK_PARMS (C$CHDIR, 2); - - ret = cob_sys_change_dir (dir); - if (ret < 0) { - ret = 128; - } - cob_put_s64_param (2, (cob_s64_t)ret); - return ret; -} - -int -cob_sys_copyfile (unsigned char *fname1, unsigned char *fname2, - unsigned char *file_type) -{ - int ret; - - /* RXW - Type is not yet evaluated */ - COB_UNUSED (file_type); - - COB_CHK_PARMS (C$COPY, 3); - - if (cob_get_num_params () < 3) { - return 128; - } - ret = cob_sys_copy_file (fname1, fname2); - if (ret < 0) { - ret = 128; - } - return ret; -} - -int -cob_sys_file_info (unsigned char *file_name, unsigned char *file_info) -{ - char *fn; - struct tm *tm; - cob_u64_t sz; - unsigned int dt; - short y; - short d, m, hh, mm, ss; - struct stat st; - - COB_UNUSED (file_name); - - COB_CHK_PARMS (C$FILEINFO, 2); - - if (cob_get_num_params () < 2 ) { - return 128; - } - fn = cob_param_no_quotes (1); - if (fn == NULL) { - return -1; - } - if (cob_get_param_size(2) < 16) { - cob_runtime_error (_("'%s' - File detail area is too short"), "C$FILEINFO"); - cob_stop_run (1); - } - - if (stat (fn, &st) < 0) { - cob_free (fn); - return 35; - } - cob_free (fn); - sz = (cob_u64_t)st.st_size; - tm = localtime (&st.st_mtime); - d = (short)tm->tm_mday; - m = (short)(tm->tm_mon + 1); - y = (short)(tm->tm_year + 1900); - hh = (short)tm->tm_hour; - mm = (short)tm->tm_min; - /* Leap seconds ? */ - if (tm->tm_sec >= 60) { - ss = 59; - } else { - ss = (short)tm->tm_sec; - } - -#ifndef WORDS_BIGENDIAN - sz = COB_BSWAP_64 (sz); -#endif - memcpy (file_info, &sz, (size_t)8); - dt = (y * 10000) + (m * 100) + d; -#ifndef WORDS_BIGENDIAN - dt = COB_BSWAP_32 (dt); -#endif - memcpy (file_info + 8, &dt, (size_t)4); - dt = (hh * 1000000) + (mm * 10000) + (ss * 100); -#ifndef WORDS_BIGENDIAN - dt = COB_BSWAP_32 (dt); -#endif - memcpy (file_info + 12, &dt, (size_t)4); - return 0; -} - -int -cob_sys_file_delete (unsigned char *file_name, unsigned char *file_type) -{ - int ret; - char *fn; - - /* RXW - Type is not yet evaluated */ - COB_UNUSED (file_type); - - COB_CHK_PARMS (C$DELETE, 2); - if (cob_get_num_params () < 2 ) { - return 128; - } - fn = cob_param_no_quotes (1); - if (fn == NULL) { - return -1; - } - - ret = cob_sys_delete_file (file_name); - if (ret < 0) { - ret = 128; - } - cob_free (fn); - return ret; -} - -/* SORT */ - -static int -sort_cmps (const unsigned char *s1, const unsigned char *s2, const size_t size, - const unsigned char *col) -{ - size_t i; - int ret; - - if (unlikely (col)) { - for (i = 0; i < size; ++i) { - if ((ret = col[s1[i]] - col[s2[i]]) != 0) { - return ret; - } - } - } else { - for (i = 0; i < size; ++i) { - if ((ret = s1[i] - s2[i]) != 0) { - return ret; - } - } - } - return 0; -} - -static COB_INLINE void -unique_copy (unsigned char *s1, const unsigned char *s2) -{ - size_t size; - - size = sizeof (size_t); - do { - *s1++ = *s2++; - } while (--size); -} - -static int -cob_file_sort_compare (struct cobitem *k1, struct cobitem *k2, void *pointer) -{ - cob_file *f; - int i; - size_t u1; - size_t u2; - int cmp; - cob_field f1; - cob_field f2; - - f = pointer; - for (i = 0; i < (int)f->nkeys; ++i) { - f1 = f2 = *(f->keys[i].field); - f1.data = k1->item + f->keys[i].offset; - f2.data = k2->item + f->keys[i].offset; - if (unlikely (COB_FIELD_IS_NUMERIC (&f1))) { - cmp = cob_numeric_cmp (&f1, &f2); - } else { - cmp = sort_cmps (f1.data, f2.data, f1.size, - f->sort_collating); - } - if (cmp != 0) { - return (f->keys[i].tf_ascending == COB_ASCENDING) ? cmp : -cmp; - } - } - unique_copy ((unsigned char *)&u1, k1->unique); - unique_copy ((unsigned char *)&u2, k2->unique); - if (u1 < u2) { - return -1; - } - return 1; -} - -static void -cob_free_list (struct cobsort *hp) -{ - struct sort_mem_struct *s1; - struct sort_mem_struct *s2; - - s1 = hp->mem_base; - for (; s1;) { - s2 = s1; - s1 = s1->next; - cob_free (s2->mem_ptr); - cob_free (s2); - } -} - -static struct cobitem * -cob_new_item (struct cobsort *hp, const size_t size) -{ - struct cobitem *q; - struct sort_mem_struct *s; - - COB_UNUSED (size); - - /* Creation of an empty item */ - if (unlikely (hp->empty != NULL)) { - q = hp->empty; - hp->empty = q->next; - q->block_byte = 0; - q->next = NULL; - q->end_of_block = 0; - return (void *)q; - } - if (unlikely ((hp->mem_used + hp->alloc_size) > hp->mem_size)) { - s = cob_fast_malloc (sizeof (struct sort_mem_struct)); - s->mem_ptr = cob_fast_malloc (hp->chunk_size); - s->next = hp->mem_base; - hp->mem_base = s; - hp->mem_size = hp->chunk_size; - hp->mem_total += hp->chunk_size; - hp->mem_used = 0; - } - q = (struct cobitem *)(hp->mem_base->mem_ptr + hp->mem_used); - hp->mem_used += hp->alloc_size; - if (unlikely (hp->mem_total >= file_setptr->cob_sort_memory)) { - if ((hp->mem_used + hp->alloc_size) > hp->mem_size) { - hp->switch_to_file = 1; - } - } - q->block_byte = 0; - q->next = NULL; - q->end_of_block = 0; - return q; -} - -static FILE * -cob_srttmpfile (void) -{ - FILE *fp; - char *filename; - int fd; - - filename = cob_malloc ((size_t)COB_FILE_BUFF); - cob_temp_name (filename, NULL); - cob_incr_temp_iteration (); - fd = open (filename, - O_CREAT | O_TRUNC | O_RDWR | O_BINARY | COB_OPEN_TEMPORARY, - COB_FILE_MODE); - if (fd < 0) { - cob_free (filename); - return NULL; - } - (void)unlink (filename); - fp = fdopen (fd, "w+b"); - if (!fp) { - close (fd); - } - cob_free (filename); - return fp; -} - -static int -cob_get_sort_tempfile (struct cobsort *hp, const int n) -{ - if (hp->file[n].fp == NULL) { - hp->file[n].fp = cob_srttmpfile (); - if (hp->file[n].fp == NULL) { - cob_runtime_error (_("SORT is unable to acquire temporary file")); - cob_stop_run (1); - } - } else { - rewind (hp->file[n].fp); - } - hp->file[n].count = 0; - return hp->file[n].fp == NULL; -} - -static int -cob_sort_queues (struct cobsort *hp) -{ - struct cobitem *q; - int source; - int destination; - int move; - int n; - int end_of_block[2]; - - source = 0; - while (hp->queue[source + 1].count != 0) { - destination = source ^ 2; - hp->queue[destination].first = NULL; - hp->queue[destination].count = 0; - hp->queue[destination + 1].first = NULL; - hp->queue[destination + 1].count = 0; - for (;;) { - end_of_block[0] = hp->queue[source].count == 0; - end_of_block[1] = hp->queue[source + 1].count == 0; - if (end_of_block[0] && end_of_block[1]) { - break; - } - while (!end_of_block[0] || !end_of_block[1]) { - if (end_of_block[0]) { - move = 1; - } else if (end_of_block[1]) { - move = 0; - } else { - n = cob_file_sort_compare - (hp->queue[source].first, - hp->queue[source + 1].first, - hp->pointer); - move = n < 0 ? 0 : 1; - } - q = hp->queue[source + move].first; - if (q->end_of_block) { - end_of_block[move] = 1; - } - hp->queue[source + move].first = q->next; - if (hp->queue[destination].first == NULL) { - hp->queue[destination].first = q; - } else { - hp->queue[destination].last->next = q; - } - hp->queue[destination].last = q; - hp->queue[source + move].count--; - hp->queue[destination].count++; - q->next = NULL; - q->end_of_block = 0; - } - hp->queue[destination].last->end_of_block = 1; - destination ^= 1; - } - source = destination & 2; - } - return source; -} - -static int -cob_read_item (struct cobsort *hp, const int n) -{ - FILE *fp; - - fp = hp->file[n].fp; - if (getc (fp) != 0) { - hp->queue[n].first->end_of_block = 1; - } else { - hp->queue[n].first->end_of_block = 0; - /* LCOV_EXCL_START */ - if (unlikely (fread (hp->queue[n].first->unique, - hp->r_size, (size_t)1, fp) != 1)) { - return 1; - } - /* LCOV_EXCL_STOP */ - } - return 0; -} - -static int -cob_write_block (struct cobsort *hp, const int n) -{ - struct cobitem *q; - FILE *fp; - - fp = hp->file[hp->destination_file].fp; - for (;;) { - q = hp->queue[n].first; - if (q == NULL) { - break; - } - /* LCOV_EXCL_START */ - if (unlikely (fwrite (&(q->block_byte), - hp->w_size, (size_t)1, fp) != 1)) { - return 1; - } - /* LCOV_EXCL_STOP */ - hp->queue[n].first = q->next; - q->next = hp->empty; - hp->empty = q; - } - hp->queue[n].count = 0; - hp->file[hp->destination_file].count++; - /* LCOV_EXCL_START */ - if (unlikely (putc (1, fp) != 1)) { - return 1; - } - /* LCOV_EXCL_STOP */ - return 0; -} - -static void -cob_copy_check (cob_file *to, cob_file *from) -{ - unsigned char *toptr; - unsigned char *fromptr; - size_t tosize; - size_t fromsize; - - toptr = to->record->data; - fromptr = from->record->data; - tosize = to->record->size; - fromsize = from->record->size; - if (unlikely (tosize > fromsize)) { - memcpy (toptr, fromptr, fromsize); - memset (toptr + fromsize, ' ', tosize - fromsize); - } else { - memcpy (toptr, fromptr, tosize); - } -} - -static int -cob_file_sort_process (struct cobsort *hp) -{ - int i; - int source; - int destination; - int n; - int move; - int res; - - hp->retrieving = 1; - n = cob_sort_queues (hp); -#if 0 /* RXWRXW - Cannot be true */ - /* LCOV_EXCL_START */ - if (unlikely (n < 0)) { - return COBSORTABORT; - } - /* LCOV_EXCL_STOP */ -#endif - if (likely(!hp->files_used)) { - hp->retrieval_queue = n; - return 0; - } - /* LCOV_EXCL_START */ - if (unlikely (cob_write_block (hp, n))) { - return COBSORTFILEERR; - } - /* LCOV_EXCL_STOP */ - for (i = 0; i < 4; ++i) { - hp->queue[i].first = hp->empty; - hp->empty = hp->empty->next; - hp->queue[i].first->next = NULL; - } - rewind (hp->file[0].fp); - rewind (hp->file[1].fp); - /* LCOV_EXCL_START */ - if (unlikely (cob_get_sort_tempfile (hp, 2))) { - return COBSORTFILEERR; - } - if (unlikely (cob_get_sort_tempfile (hp, 3))) { - return COBSORTFILEERR; - } - /* LCOV_EXCL_STOP */ - source = 0; - while (hp->file[source].count > 1) { - destination = source ^ 2; - hp->file[destination].count = 0; - hp->file[destination + 1].count = 0; - while (hp->file[source].count > 0) { - /* LCOV_EXCL_START */ - if (unlikely (cob_read_item (hp, source))) { - return COBSORTFILEERR; - } - /* LCOV_EXCL_STOP */ - if (hp->file[source + 1].count > 0) { - /* LCOV_EXCL_START */ - if (unlikely (cob_read_item (hp, source + 1))) { - return COBSORTFILEERR; - } - /* LCOV_EXCL_STOP */ - } else { - hp->queue[source + 1].first->end_of_block = 1; - } - while (!hp->queue[source].first->end_of_block || - !hp->queue[source + 1].first->end_of_block) { - if (hp->queue[source].first->end_of_block) { - move = 1; - } else if (hp->queue[source + 1].first->end_of_block) { - move = 0; - } else { - res = cob_file_sort_compare - (hp->queue[source].first, - hp->queue[source + 1].first, - hp->pointer); - move = res < 0 ? 0 : 1; - } - /* LCOV_EXCL_START */ - if (unlikely (fwrite ( - &(hp->queue[source + move].first->block_byte), - hp->w_size, (size_t)1, - hp->file[destination].fp) != 1)) { - return COBSORTFILEERR; - } - if (unlikely(cob_read_item (hp, source + move))) { - return COBSORTFILEERR; - } - /* LCOV_EXCL_STOP */ - } - hp->file[destination].count++; - /* LCOV_EXCL_START */ - if (unlikely (putc (1, hp->file[destination].fp) != 1)) { - return COBSORTFILEERR; - } - /* LCOV_EXCL_STOP */ - hp->file[source].count--; - hp->file[source + 1].count--; - destination ^= 1; - } - source = destination & 2; - rewind (hp->file[0].fp); - rewind (hp->file[1].fp); - rewind (hp->file[2].fp); - rewind (hp->file[3].fp); - } - hp->retrieval_queue = source; - /* LCOV_EXCL_START */ - if (unlikely (cob_read_item (hp, source))) { - return COBSORTFILEERR; - } - if (unlikely (cob_read_item (hp, source + 1))) { - return COBSORTFILEERR; - } - /* LCOV_EXCL_STOP */ - return 0; -} - -static int -cob_file_sort_submit (cob_file *f, const unsigned char *p) -{ - struct cobsort *hp; - struct cobitem *q; - struct queue_struct *z; - int n; - - hp = f->file; - if (unlikely (!hp)) { - return COBSORTNOTOPEN; - } - if (unlikely (hp->retrieving)) { - return COBSORTABORT; - } - if (unlikely (hp->switch_to_file)) { - if (!hp->files_used) { - /* LCOV_EXCL_START */ - if (unlikely (cob_get_sort_tempfile (hp, 0))) { - return COBSORTFILEERR; - } - if (unlikely (cob_get_sort_tempfile (hp, 1))) { - return COBSORTFILEERR; - } - /* LCOV_EXCL_STOP */ - hp->files_used = 1; - hp->destination_file = 0; - } - n = cob_sort_queues (hp); -#if 0 /* RXWRXW - Cannot be true */ - /* LCOV_EXCL_START */ - if (unlikely (n < 0)) { - return COBSORTABORT; - } - /* LCOV_EXCL_STOP */ -#endif - /* LCOV_EXCL_START */ - if (unlikely (cob_write_block (hp, n))) { - return COBSORTFILEERR; - } - /* LCOV_EXCL_STOP */ - hp->destination_file ^= 1; - } - q = cob_new_item (hp, sizeof (struct cobitem) + hp->size); - q->end_of_block = 1; - unique_copy (q->unique, (const unsigned char *)&(hp->unique)); - hp->unique++; - memcpy (q->item, p, hp->size); - if (hp->queue[0].count <= hp->queue[1].count) { - z = &hp->queue[0]; - } else { - z = &hp->queue[1]; - } - q->next = z->first; - z->first = q; - z->count++; - return 0; -} - -static int -cob_file_sort_retrieve (cob_file *f, unsigned char *p) -{ - struct cobsort *hp; - struct cobitem *next; - struct queue_struct *z; - int move; - int source; - int res; - - hp = f->file; - if (unlikely (!hp)) { - return COBSORTNOTOPEN; - } - if (unlikely (!hp->retrieving)) { - res = cob_file_sort_process (hp); - if (res) { - return res; - } - } - if (unlikely (hp->files_used)) { - source = hp->retrieval_queue; - if (hp->queue[source].first->end_of_block) { - if (hp->queue[source + 1].first->end_of_block) { - return COBSORTEND; - } - move = 1; - } else if (hp->queue[source + 1].first->end_of_block) { - move = 0; - } else { - res = cob_file_sort_compare (hp->queue[source].first, - hp->queue[source + 1].first, - hp->pointer); - move = res < 0 ? 0 : 1; - } - memcpy (p, hp->queue[source + move].first->item, hp->size); - /* LCOV_EXCL_START */ - if (unlikely (cob_read_item (hp, source + move))) { - return COBSORTFILEERR; - } - /* LCOV_EXCL_STOP */ - } else { - z = &hp->queue[hp->retrieval_queue]; - if (z->first == NULL) { - return COBSORTEND; - } - memcpy (p, z->first->item, hp->size); - next = z->first->next; - z->first->next = hp->empty; - hp->empty = z->first; - z->first = next; - } - return 0; -} - -void -cob_file_sort_using (cob_file *sort_file, cob_file *data_file) -{ - int ret; - - cob_open (data_file, COB_OPEN_INPUT, 0, NULL); - for (;;) { - cob_read_next (data_file, NULL, COB_READ_NEXT); - if (data_file->file_status[0] != '0') { - break; - } - cob_copy_check (sort_file, data_file); - ret = cob_file_sort_submit (sort_file, sort_file->record->data); - if (ret) { - break; - } - } - cob_close (data_file, NULL, COB_CLOSE_NORMAL, 0); -} - -void -cob_file_sort_giving (cob_file *sort_file, const size_t varcnt, ...) -{ - cob_file **fbase; - struct cobsort *hp; - size_t i; - int ret; - int opt; - va_list args; - - fbase = cob_malloc (varcnt * sizeof (cob_file *)); - va_start (args, varcnt); - for (i = 0; i < varcnt; ++i) { - fbase[i] = va_arg (args, cob_file *); - } - va_end (args); - for (i = 0; i < varcnt; ++i) { - cob_open (fbase[i], COB_OPEN_OUTPUT, 0, NULL); - } - for (;;) { - ret = cob_file_sort_retrieve (sort_file, sort_file->record->data); - if (ret) { - if (ret == COBSORTEND) { - sort_file->file_status[0] = '1'; - sort_file->file_status[1] = '0'; - } else { - hp = sort_file->file; - if (hp->sort_return) { - *(int *)(hp->sort_return) = 16; - } - sort_file->file_status[0] = '3'; - sort_file->file_status[1] = '0'; - } - break; - } - for (i = 0; i < varcnt; ++i) { - if (COB_FILE_SPECIAL (fbase[i]) || - fbase[i]->organization == COB_ORG_LINE_SEQUENTIAL) { - opt = COB_WRITE_BEFORE | COB_WRITE_LINES | 1; - } else { - opt = 0; - } - fbase[i]->record->size = fbase[i]->record_max; - cob_copy_check (fbase[i], sort_file); - cob_write (fbase[i], fbase[i]->record, opt, NULL, 0); - } - } - for (i = 0; i < varcnt; ++i) { - cob_close (fbase[i], NULL, COB_CLOSE_NORMAL, 0); - } - cob_free (fbase); -} - -void -cob_file_sort_init (cob_file *f, const unsigned int nkeys, - const unsigned char *collating_sequence, - void *sort_return, cob_field *fnstatus) -{ - struct cobsort *p; - size_t n; - - p = cob_malloc (sizeof (struct cobsort)); - p->fnstatus = fnstatus; - p->size = f->record_max; - p->r_size = f->record_max + sizeof (size_t); - p->w_size = f->record_max + sizeof (size_t) + 1; - n = sizeof (struct cobitem) - offsetof (struct cobitem, item); - if (f->record_max <= n) { - p->alloc_size = sizeof (struct cobitem); - } else { - p->alloc_size = offsetof (struct cobitem, item) + f->record_max; - } - if (p->alloc_size % sizeof (void *)) { - p->alloc_size += sizeof (void *) - (p->alloc_size % sizeof (void *)); - } - p->chunk_size = file_setptr->cob_sort_chunk; - if (p->chunk_size % p->alloc_size) { - p->chunk_size += p->alloc_size - (p->chunk_size % p->alloc_size); - } - p->pointer = f; - if (sort_return) { - p->sort_return = sort_return; - *(int *)sort_return = 0; - } - p->mem_base = cob_fast_malloc (sizeof (struct sort_mem_struct)); - p->mem_base->mem_ptr = cob_fast_malloc (p->chunk_size); - p->mem_base->next = NULL; - p->mem_size = p->chunk_size; - p->mem_total = p->chunk_size; - f->file = p; - f->keys = cob_malloc (sizeof (cob_file_key) * nkeys); - f->nkeys = 0; - if (collating_sequence) { - f->sort_collating = collating_sequence; - } else { - f->sort_collating = COB_MODULE_PTR->collating_sequence; - } - cob_file_save_status (f, fnstatus, COB_STATUS_00_SUCCESS); -} - -void -cob_file_sort_init_key (cob_file *f, cob_field *field, const int flag, - const unsigned int offset) -{ - f->keys[f->nkeys].field = field; - f->keys[f->nkeys].tf_ascending = (unsigned int)flag; - f->keys[f->nkeys].offset = offset; - f->nkeys++; -} - -void -cob_file_sort_close (cob_file *f) -{ - struct cobsort *hp; - cob_field *fnstatus; - size_t i; - - fnstatus = NULL; - hp = f->file; - if (likely(hp)) { - fnstatus = hp->fnstatus; - cob_free_list (hp); - for (i = 0; i < 4; ++i) { - if (hp->file[i].fp != NULL) { - fclose (hp->file[i].fp); - } - } - cob_free (hp); - } - if (f->keys) { - cob_free (f->keys); - } - f->file = NULL; - cob_file_save_status (f, fnstatus, COB_STATUS_00_SUCCESS); -} - -void -cob_file_release (cob_file *f) -{ - struct cobsort *hp; - cob_field *fnstatus; - int ret; - - fnstatus = NULL; - hp = f->file; - if (likely(hp)) { - fnstatus = hp->fnstatus; - } - ret = cob_file_sort_submit (f, f->record->data); - if (!ret) { - cob_file_save_status (f, fnstatus, COB_STATUS_00_SUCCESS); - return; - } - if (likely(hp && hp->sort_return)) { - *(int *)(hp->sort_return) = 16; - } - cob_file_save_status (f, fnstatus, COB_STATUS_30_PERMANENT_ERROR); -} - -void -cob_file_return (cob_file *f) -{ - struct cobsort *hp; - cob_field *fnstatus; - int ret; - - fnstatus = NULL; - hp = f->file; - if (likely(hp)) { - fnstatus = hp->fnstatus; - } - ret = cob_file_sort_retrieve (f, f->record->data); - switch (ret) { - case 0: - cob_file_save_status (f, fnstatus, COB_STATUS_00_SUCCESS); - return; - case COBSORTEND: - cob_file_save_status (f, fnstatus, COB_STATUS_10_END_OF_FILE); - return; - } - if (likely(hp && hp->sort_return)) { - *(int *)(hp->sort_return) = 16; - } - cob_file_save_status (f, fnstatus, COB_STATUS_30_PERMANENT_ERROR); -} - -char * -cob_get_filename_print (cob_file* file, const int show_resolved_name) -{ - /* Obtain the file name */ - cob_field_to_string (file->assign, file_open_env, (size_t)COB_FILE_MAX); - if (show_resolved_name) { - strncpy (file_open_name, file_open_env, (size_t)COB_FILE_MAX); - file_open_name[COB_FILE_MAX] = 0; - cob_chk_file_mapping (file); - } - - if (show_resolved_name - && strcmp (file_open_env, file_open_name)) { - sprintf (runtime_buffer, "%s ('%s' => %s)", - file->select_name, file_open_env, file_open_name); - } else { - sprintf (runtime_buffer, "%s ('%s')", - file->select_name, file_open_env); - } - return runtime_buffer; -} - -/* Initialization/Termination - cobsetpr-values with type ENV_PATH or ENV_STR - like bdb_home and cob_file_path are taken care in cob_exit_common()! -*/ - -void -cob_exit_fileio (void) -{ - struct file_list *l; - struct file_list *p; - int k; - - for (l = file_cache; l; l = l->next) { - if (l->file - && l->file->open_mode != COB_OPEN_CLOSED - && l->file->open_mode != COB_OPEN_LOCKED - && !l->file->flag_nonexistent) { - if (COB_FILE_SPECIAL (l->file)) { - continue; - } - cob_close (l->file, NULL, COB_CLOSE_ABORT, 0); - cob_runtime_warning (_("implicit CLOSE of %s"), - cob_get_filename_print (l->file, 0)); - } - } - - for(k=0; k < COB_IO_MAX; k++) { - if(fileio_funcs[k] != NULL) { - fileio_funcs[k]->ioexit (&file_api); - } - } - - if (runtime_buffer) { - cob_free (runtime_buffer); - runtime_buffer = NULL; - } - - free_extfh_fcd (); - - for (l = file_cache; l;) { - p = l; - l = l->next; - cob_free (p); - } - file_cache = NULL; -} - -void -cob_init_fileio (cob_global *lptr, cob_settings *sptr) -{ - char *p; - int i,k; - - runtime_buffer = cob_fast_malloc ((size_t)(4 * COB_FILE_BUFF) + 4); - file_open_env = runtime_buffer + COB_FILE_BUFF; - file_open_name = runtime_buffer + (2 * COB_FILE_BUFF); - file_open_buff = runtime_buffer + (3 * COB_FILE_BUFF); - - file_api.glbptr = file_globptr = lptr; - file_api.setptr = file_setptr = sptr; - file_api.add_file_cache = cob_cache_file; - file_api.del_file_cache = cob_cache_del; - file_api.cob_write_dict = cob_write_dict; - file_api.cob_read_dict = cob_read_dict; - file_api.file_paths = file_paths; - file_api.io_funcs = fileio_funcs; - file_api.chk_file_mapping = cob_chk_file_mapping; - file_api.cob_file_write_opt = cob_file_write_opt; - file_api.file_open_buff = file_open_buff; - - if(chk_file_path) { - chk_file_path = 0; - if (file_setptr->cob_file_path) { - for(i=k=0; file_setptr->cob_file_path[i] != 0; i++) { - if(file_setptr->cob_file_path[i] == PATHSEP_CHAR) - k++; - } - /* Split list of paths apart */ - file_paths = cob_malloc (sizeof(void*) * (k+2)); - p = cob_strdup (file_setptr->cob_file_path); - file_paths[0] = p; - for(i=k=0; p[i] != 0; i++) { - if(p[i] == PATHSEP_CHAR) { - p[i] = 0; - file_paths[++k] = &p[i+1]; - } - } - file_paths[++k] = NULL; - } - } - - file_cache = NULL; - eop_status = 0; - check_eop_status = 0; - if (file_setptr->cob_sort_chunk > (file_setptr->cob_sort_memory / 2)) { - file_setptr->cob_sort_chunk = file_setptr->cob_sort_memory / 2; - } - - if(file_setptr->cob_mf_files) { /* Just use all MF format files */ - file_setptr->cob_ls_nulls = 1; - file_setptr->cob_ls_split = 1; - file_setptr->cob_ls_validate = 0; - if(file_setptr->cob_varseq_type == COB_FILE_IS_GC - || file_setptr->cob_varseq_type == 0) - file_setptr->cob_varseq_type = COB_FILE_IS_MF; - if(file_setptr->cob_varrel_type == COB_FILE_IS_GC) - file_setptr->cob_varrel_type = COB_FILE_IS_MF; - if(file_setptr->cob_fixrel_type == COB_FILE_IS_GC) - file_setptr->cob_fixrel_type = COB_FILE_IS_MF; - } - if(file_setptr->cob_gc_files) { /* Just use all GnuCOBOL format files */ - file_setptr->cob_ls_nulls = 0; - file_setptr->cob_ls_split = 0; - file_setptr->cob_ls_validate = 0; - if(file_setptr->cob_varseq_type == COB_FILE_IS_MF) - file_setptr->cob_varseq_type = COB_FILE_IS_GC; - if(file_setptr->cob_varrel_type == COB_FILE_IS_MF) - file_setptr->cob_varrel_type = COB_FILE_IS_GC; - if(file_setptr->cob_fixrel_type == COB_FILE_IS_MF) - file_setptr->cob_fixrel_type = COB_FILE_IS_GC; - } - -#if defined(WITH_CISAM) || defined(WITH_DISAM) || defined(WITH_VBISAM) -#if defined(WITH_MULTI_ISAM) - { - void (*ioinit)(cob_file_api *); -#if defined(WITH_CISAM) - ioinit = cob_load_lib ("libcobci.so", "cob_isam_init_fileio"); - if(ioinit == NULL) { - cob_runtime_error (_("C-ISAM library %s is not present"),"libcobci.so"); - exit(-1); - } - ioinit(&file_api); -#endif -#if defined(WITH_DISAM) - ioinit = cob_load_lib ("libcobdi.so", "cob_isam_init_fileio"); - if(ioinit == NULL) { - cob_runtime_error (_("D-ISAM library %s is not present"),"libcobdi.so"); - exit(-1); - } - ioinit(&file_api); -#endif -#if defined(WITH_VBISAM) - ioinit = cob_load_lib ("libcobvb.so", "cob_isam_init_fileio"); - if(ioinit == NULL) { - cob_runtime_error (_("VB-ISAM library %s is not present"),"libcobvb.so"); - exit(-1); - } - ioinit(&file_api); -#endif - } -#else - /* Single type of ISAM is used */ - cob_isam_init_fileio (&file_api); -#endif -#endif - -#ifdef WITH_DB - cob_bdb_init_fileio (&file_api); -#endif -#ifdef WITH_LMDB - cob_lmdb_init_fileio (&file_api); -#endif -#ifdef WITH_ODBC - cob_odbc_init_fileio (&file_api); -#endif -#ifdef WITH_OCI - cob_oci_init_fileio (&file_api); -#endif - -#if defined(WITH_INDEX_EXTFH) - cob_index_init_fileio (&file_api); -#endif - -#if defined(WITH_SEQRA_EXTFH) - cob_seqra_init_fileio (&file_api); -#endif - -} - -/* Call this routine when a new process has been forked */ -void -cob_fork_fileio (cob_global *lptr, cob_settings *sptr) -{ - int k; - COB_UNUSED (lptr); - COB_UNUSED (sptr); - for(k=0; k < COB_IO_MAX; k++) { - if(fileio_funcs[k] != NULL) { - fileio_funcs[k]->iofork (&file_api); - } - } -} - diff -Nru gnucobol-4.0~early~20200606/libcob/fileio.h gnucobol-5/libcob/fileio.h --- gnucobol-4.0~early~20200606/libcob/fileio.h 2020-06-06 20:52:01.000000000 +0000 +++ gnucobol-5/libcob/fileio.h 1970-01-01 00:00:00.000000000 +0000 @@ -1,451 +0,0 @@ -/* - Copyright (C) 2002-2012, 2014-2020 Free Software Foundation, Inc. - Written by Keisuke Nishida, Roger While, Simon Sobisch, Ron Norman - - This file is part of GnuCOBOL. - - The GnuCOBOL runtime library is free software: you can redistribute it - and/or modify it under the terms of the GNU Lesser General Public License - as published by the Free Software Foundation, either version 3 of the - License, or (at your option) any later version. - - GnuCOBOL is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU Lesser General Public License for more details. - - You should have received a copy of the GNU Lesser General Public License - along with GnuCOBOL. If not, see . -*/ - - -#ifndef _FILEIO_H -#define _FILEIO_H - -#define cobglobptr file_globptr -#define cobsetptr file_setptr - -#ifndef _CONFIG_H -#include -#define _CONFIG_H -#endif - -#define _LFS64_LARGEFILE 1 -#define _LFS64_STDIO 1 -#define _FILE_OFFSET_BITS 64 -#define _LARGEFILE64_SOURCE 1 -#ifdef _AIX -#define _LARGE_FILES 1 -#endif /* _AIX */ -#if defined(__hpux__) && !defined(__LP64__) -#define _APP32_64BIT_OFF_T 1 -#endif - -#include -#include -#include -#include -#include -#include -#include -#include -#include -#include - -#ifndef EDEADLK -#ifdef EDEADLOCK /* SCO name for EDEADLK */ -#define EDEADLK EDEADLOCK -#else -#define EDEADLK 99 -#endif -#endif - -#ifdef HAVE_UNISTD_H -#include -#endif - -#ifdef HAVE_FCNTL_H -#include -#endif - -#ifdef _WIN32 - -#define WIN32_LEAN_AND_MEAN -#include -#include -#include -#if defined (__WATCOMC__) || defined (__ORANGEC__) -#define fdcobsync fsync -#else -#define fdcobsync _commit -#endif -#if !defined(__BORLANDC__) && !defined(__WATCOMC__) && !defined(__ORANGEC__) -#define getcwd _getcwd -#define chdir _chdir -#define mkdir _mkdir -#define rmdir _rmdir -#define open _open -#define close _close -#define unlink _unlink -#define fdopen _fdopen -#ifndef lseek -#define lseek _lseeki64 -#endif -#endif - -#ifndef _O_TEMPORARY -#define _O_TEMPORARY 0 -#endif - -#else /* _WIN32 */ - -#if defined(HAVE_FDATASYNC) -#define fdcobsync fdatasync -#else -#define fdcobsync fsync -#endif - -#ifndef O_BINARY -#define O_BINARY 0 -#endif - -#endif /* _WIN32 */ - -#include "sysdefines.h" -#ifndef MAXNUMKEYS -#define MAXNUMKEYS 32 -#endif - -/* Force symbol exports */ -#define COB_LIB_EXPIMP -#include "libcob.h" -#include "coblocal.h" - -#ifdef WORDS_BIGENDIAN -#define COB_MAYSWAP_16(x) ((unsigned short)(x)) -#define COB_MAYSWAP_32(x) ((unsigned int)(x)) -#else -#define COB_MAYSWAP_16(x) (COB_BSWAP_16((unsigned short)(x))) -#define COB_MAYSWAP_32(x) (COB_BSWAP_32((unsigned int)(x))) -#endif - -/* File API struct passed to all I/O functions */ -typedef struct _cob_file_api { - cob_global *glbptr; - cob_settings *setptr; - struct cob_fileio_funcs **io_funcs; - char **file_paths; - char *file_open_buff; - void (*add_file_cache) (cob_file *); - void (*del_file_cache) (cob_file *); - void (*chk_file_mapping) (cob_file *f); - int (*cob_write_dict) (cob_file *f, char *filename); - int (*cob_read_dict) (cob_file *f, char *filename, int updt, int *retsts); - int (*cob_file_write_opt) (cob_file *f, const int opt); -} cob_file_api; - -/* File I/O function pointer structure */ -struct cob_fileio_funcs { - int (*open) (cob_file_api *, cob_file *, char *, const int, const int); - int (*close) (cob_file_api *, cob_file *, const int); - int (*start) (cob_file_api *, cob_file *, const int, cob_field *); - int (*read) (cob_file_api *, cob_file *, cob_field *, const int); - int (*read_next) (cob_file_api *, cob_file *, const int); - int (*write) (cob_file_api *, cob_file *, const int); - int (*rewrite) (cob_file_api *, cob_file *, const int); - int (*recdelete) (cob_file_api *, cob_file *); - - int (*fildelete) (cob_file_api *, cob_file *, char *); - void (*ioinit) (cob_file_api *); - void (*ioexit) (cob_file_api *); - int (*iofork) (cob_file_api *); - int (*iosync) (cob_file_api *, cob_file *); - int (*commit) (cob_file_api *, cob_file *); - int (*rollback) (cob_file_api *, cob_file *); - int (*iounlock) (cob_file_api *, cob_file *); -}; - -extern cob_global *file_globptr; -extern cob_settings *file_setptr; - -static const int status_exception[] = { - 0, /* 0x */ - COB_EC_I_O_AT_END, /* 1x */ - COB_EC_I_O_INVALID_KEY, /* 2x */ - COB_EC_I_O_PERMANENT_ERROR, /* 3x */ - COB_EC_I_O_LOGIC_ERROR, /* 4x */ - COB_EC_I_O_RECORD_OPERATION, /* 5x */ - COB_EC_I_O_FILE_SHARING, /* 6x */ - COB_EC_I_O, /* Unused */ - COB_EC_I_O, /* Unused */ - COB_EC_I_O_IMP /* 9x */ -}; - -COB_HIDDEN int cob_write_dict (cob_file *f, char *filename); -COB_HIDDEN int cob_read_dict (cob_file *f, char *filename, int updt, int *retsts); -COB_HIDDEN void cob_chk_file_mapping (cob_file *f); -COB_HIDDEN void cob_file_save_status (cob_file *f, cob_field *fnstatus, const int status); -COB_HIDDEN void cob_file_sync (cob_file *f); - -#ifdef WITH_DB -COB_HIDDEN void cob_bdb_init_fileio (cob_file_api *); -#endif -#ifdef WITH_LMDB -COB_HIDDEN void cob_lmdb_init_fileio (cob_file_api *); -#endif - -#if defined(WITH_ODBC) || defined(WITH_OCI) || defined(WITH_DB) || defined(WITH_LMDB) -/* Routines in fsqlxfd.c common to all Database interfaces */ -COB_HIDDEN int db_findkey (cob_file *f, cob_field *kf, int *fullkeylen, int *partlen); -COB_HIDDEN int db_keylen (cob_file *f, int idx); -COB_HIDDEN int db_savekey (cob_file *f, unsigned char *keyarea, unsigned char *record, int idx); -COB_HIDDEN int db_cmpkey (cob_file *f, unsigned char *keyarea, unsigned char *record, int idx, int partlen); -#endif -#if defined(WITH_ODBC) || defined(WITH_OCI) -#ifndef FALSE -#define FALSE 0 -#endif -#ifndef TRUE -#define TRUE 1 -#endif - -#define SQL_BIND_NO 0 -#define SQL_BIND_COLS 2 -#define SQL_BIND_PRMS 4 -#define SQL_BIND_EQ 8 -#define SQL_BIND_WHERE 16 - -typedef struct sql_stmt { - void *handle; /* Database 'handle' */ - char *text; /* SQL statement text */ - int status; /* Recent status */ - int readopts; /* Recent status */ - cob_u32_t preped:1; /* has been Prepared for execution */ - cob_u32_t bound:1; /* Variables have been bound */ - cob_u32_t params:1; /* Parameters are bound */ - cob_u32_t iscursor:1; /* CURSOR is open */ - cob_u32_t isdesc:1; /* ORDER DESC */ - short bindpos; /* Last column position bound to statement */ -} SQL_STMT; - -/* - * Holds Database State information - */ -struct db_state { - cob_u32_t isopen:1; /* Connected to database */ - cob_u32_t isodbc:1; /* ODBC interface active */ - cob_u32_t isoci:1; /* Oracle Call Interface active */ - cob_u32_t oracle:1; /* DB is Oracle */ - cob_u32_t mssql:1; /* DB is Microsoft SQL Server */ - cob_u32_t mssqlnfu:1; /* DB is SQL Server does not accept FOR UPDATE */ - cob_u32_t mysql:1; /* DB is MySQL */ - cob_u32_t mariadb:1; /* DB is MySQL (MariaDB) */ - cob_u32_t db2:1; /* Using IBM DB2 (Untested) */ - cob_u32_t postgres:1; /* Using PostgreSQL (Untested) */ - cob_u32_t sqlite:1; /* Using SQLite (Untested) */ - cob_u32_t autocommit:1; /* Running in AUTO COMMIT mode */ - cob_u32_t scanForNulls:1; /* Check for NULL columns returned */ - cob_u32_t attachDbName:1; /* Attach to specific Oracle instance name */ - - int dbStatus; /* Status of last DB call */ - int dbFatalStatus; /* Fatal Status from last DB call */ - char odbcState[6]; /* Long ODBC status code */ - short indsz; /* Sizeof SQL Indicator */ - char dbType[32]; /* Actual DB type */ - char dbSchema[32]; /* Schema name */ - char dbSid[32]; /* DB 'session id' (OCI) */ - char dbName[32]; /* DB Name 'session id' (OCI) */ - char dbUser[32]; /* DB UserId to connect with */ - char dbPwd[32]; /* DB Password to connect with */ - char dbDsn[32]; /* DB DSN to connect with */ - char dbCon[128]; /* Full connect string */ - - int dbVer; /* Data Base version */ - int updatesDone; /* # Updates done since last COMMIT */ - int commitInterval; /* COMMIT every N updates */ -#define BIGCOMMIT 0x7FFFFFF - int intRecWait; /* Time to wait for record lock */ - int nRecWaitTry; /* Retry counter for lock */ - int nMaxRetry; /* Max retries for lock */ - int arrayFetch; /* Size of array fetch */ - - /* Various Status Codes, Actual value set by Data Base Interface */ - /* for checking 'dbStatus' Oracle value as example */ - int dbStsOk; /* 0: Operation OK */ - int dbStsNullCol; /* 1405: Operation OK, some Column was NULL */ - int dbStsNotFound; /* 100: Record not found */ - int dbStsNotFound2; /* 1403: Record not found */ - int dbStsDupKey; /* 1: Duplicate Key */ - int dbStsRecLock; /* 54: Record Locked */ - int dbStsDeadLock; /* 60: Dead lock detected */ - int dbStsNoSpace; /* 1653: Out of disk space */ - int dbStsInvlNum; /* 1722: Invalid number */ - int dbStsBadRowid; /* 1410: bad ROWID */ - int dbStsNoTable; /* 1146: Table does not exist */ - - char lastErrMsg[80]; /* Recent DB Error msg */ - char *dateFormat; /* Default DATE format */ - void *dbHome; /* ORACLE_HOME value */ - - void *dbEnvH; /* DB Environment handle */ - void *dbDbcH; /* DB database handle */ - void *dbErrH; /* DB Error Handle */ - void *dbSvcH; /* DB Service Context Handle */ - void *dbSvrH; /* DB Server Handle */ - void *dbSesH; /* DB Session Handle */ - void *dbBindV; /* DB Bind Variable handle */ - void *dbhnd1; /* DB spare handles */ - void *dbhnd2; - void *dbhnd3; -}; - -/* - * Holds one action/description - */ -struct map_xfd { - enum { - XC_DATA = 1, - XC_GOTO, - XC_WHEN - } cmd; - enum { - XO_NULL = 0, - XO_GE = 1, - XO_GT, - XO_LE, - XO_LT, - XO_EQ, - XO_NE, - XO_AND, - XO_OR, - XO_NOT - } opcode; /* Operation code */ - int type; /* Data type (COB_XFDT_xxxx) */ - int offset; /* Offset to data field within record */ - int size; /* Size of COBOL data field */ - int digits; /* Digits in field */ - int scale; /* Decimal scale of field, decimal places */ - int sqlsize; /* Size for holding SQL data */ - int hostType; /* Host/C data type */ - int sqlType; /* SQL Column type */ - int sqlColSize; /* SQL Column size */ - int sqlDecimals; /* Decimal places */ - int sqlinlen; /* Length of data returned from SQL */ - int sqloutlen; /* Length of data given to SQL */ - int level; /* Original COBOL data level number */ - int nRlen4; /* Oracle column length (int) */ - short target; /* Target position */ - short jumpto; /* Resolved target position */ - short lncolname; /* Length of column name */ - short lnvalue; /* Length of 'value' */ - short colpos; /* Position in 'map' of this column def */ - short nRlen2; /* Oracle column length (short) */ - short nRcode; /* Oracle column return code */ - char valnum; /* Value is numeric */ - char setnull; /* Indicator was/is NULL */ - char notnull; /* Column is set NOT NULL */ - char iskey; /* Column is a key field */ - char *colname; /* Column name */ - char *value; /* Value to test */ - struct sql_date *dtfrm; /* Date format to use */ - unsigned char *sdata; /* SQL data storage area (within 'sqlbf') */ - int *ind; /* SQL Indicator */ - cob_field recfld; /* Data field found in File record area */ - cob_field_attr recattr; - cob_pic_symbol recpic[6]; - cob_field sqlfld; /* Data field found in SQL buffer area */ - cob_field_attr sqlattr; - cob_pic_symbol sqlpic[6]; -}; - -/* - * Defines a key - */ -#define MAXKEYCOLS 32 -struct key_xfd { - unsigned char keyn; /* Key # */ - unsigned char dups; /* 1 if DUPS allowed */ - unsigned char sup; /* 1 if SUPPRESS (but not supported by ODBC/OCI */ - unsigned char supchar; /* Character to indicate key suppression */ - unsigned char *str_sup; /* Suppress if this string appears */ - short ncols; /* Number of Columns in index */ - short lncols; /* Length of all column names in index */ - short col[MAXKEYCOLS]; /* Offset in file_xfd.map to column def */ - int lncreate; - char *create_index; /* SQL CREATE INDEX */ - SQL_STMT where_eq; /* SELECT WHERE index EQ */ - SQL_STMT where_ne; /* SELECT WHERE index NE */ - SQL_STMT where_le; /* SELECT WHERE index LE */ - SQL_STMT where_lt; /* SELECT WHERE index LT */ - SQL_STMT where_ge; /* SELECT WHERE index GE */ - SQL_STMT where_gt; /* SELECT WHERE index GT */ - SQL_STMT where_fi; /* SELECT index first */ - SQL_STMT where_la; /* SELECT index last */ -}; - -/* - * Primary table for in memory XFD - */ -struct file_xfd { - cob_file *fl; /* File used */ - char *tablename; /* SQL Table Name */ - int nmap; /* Number of data mapping directives */ - struct map_xfd *map; /* Table of data mapping directives */ - unsigned char *sqlbf; /* Large buffer for SQL data */ - SQL_STMT insert; /* Insert statement */ - SQL_STMT update; /* Update statement */ - SQL_STMT delete; /* Delete statement */ - char *select; /* List of columns for a select statement */ - char *create_table; /* SQL CREATE TABLE */ - int lncreate; - int lnselect; /* Length of all column for SELECT */ - int lnind; /* Length of one 'SQL Indicator' */ - int nkeys; /* Number of indexes on table */ - int ndate; /* Number of unique 'date formats' used */ - int nlbl; /* Number of labels used */ - int ncols; /* Number of columns */ - int maxcolnmln; /* Length of longest column name */ - int lncols; /* Length of all Column names */ - int gentable; /* Generate CREATE TABLE if needed */ - int fileorg; /* cob_file.organization */ - int *xlbl; /* Label to map[subscript] table */ - struct sql_date **date; /* Date formats used */ - SQL_STMT *start; /* Active SELECT statement */ - struct key_xfd *key[MAXNUMKEYS]; -}; - -/* Routines in fsqlxfd.c common to ODBC/OCI interfaces */ -COB_HIDDEN struct file_xfd* cob_load_xfd (cob_file *fl, char *alt_name, int indsize); -COB_HIDDEN void cob_dump_xfd (struct file_xfd *fx, FILE *fo); -COB_HIDDEN void cob_load_ddl (struct db_state *db, struct file_xfd *fx); -COB_HIDDEN char * getSchemaEnvName (struct db_state *db, char *envnm, const char *suf, char *out); -COB_HIDDEN void logSchemaEnvName (struct db_state *db, const char *suffix); -COB_HIDDEN char * cob_sql_stmt (struct db_state *, struct file_xfd *, char *, int, int, int); -COB_HIDDEN SQL_STMT * cob_sql_select (struct db_state *, struct file_xfd *, int, int, int, void (*freeit)()); -COB_HIDDEN void cob_xfd_to_file (struct db_state *db, struct file_xfd *fx, cob_file *fl); -COB_HIDDEN void cob_xfd_to_ddl (struct db_state *db, struct file_xfd *fx, FILE *fo); -COB_HIDDEN void cob_file_to_xfd (struct db_state *db, struct file_xfd *fx, cob_file *fl); -COB_HIDDEN void cob_index_to_xfd (struct db_state *db, struct file_xfd *fx, cob_file *fl, int idx); -COB_HIDDEN void cob_index_clear (struct db_state *db, struct file_xfd *fx, cob_file *fl, int idx); -COB_HIDDEN void cob_drop_xfd (struct file_xfd *fx); -COB_HIDDEN void cob_sql_dump_stmt (struct db_state *db, char *stmt, int doall); -COB_HIDDEN void cob_sql_dump_data (struct db_state *db, struct file_xfd *fx); -COB_HIDDEN void cob_sql_dump_index (struct db_state *db, struct file_xfd *fx, int idx); - -#endif - -#ifdef WITH_ODBC -COB_HIDDEN void cob_odbc_init_fileio (cob_file_api *); -#endif -#ifdef WITH_OCI -COB_HIDDEN void cob_oci_init_fileio (cob_file_api *); -#endif - -#if defined(WITH_CISAM) || defined(WITH_DISAM) || defined(WITH_VBISAM) -void cob_isam_init_fileio (cob_file_api *); -#endif - -#define COB_DICTIONARY_NO 0 -#define COB_DICTIONARY_MIN 1 -#define COB_DICTIONARY_ALL 2 -#endif diff -Nru gnucobol-4.0~early~20200606/libcob/fisam.c gnucobol-5/libcob/fisam.c --- gnucobol-4.0~early~20200606/libcob/fisam.c 2020-06-06 20:52:01.000000000 +0000 +++ gnucobol-5/libcob/fisam.c 1970-01-01 00:00:00.000000000 +0000 @@ -1,1648 +0,0 @@ -/* - Copyright (C) 2002-2012, 2014-2019 Free Software Foundation, Inc. - Written by Keisuke Nishida, Roger While, Simon Sobisch, Ron Norman - - This file is part of GnuCOBOL. - - The GnuCOBOL runtime library is free software: you can redistribute it - and/or modify it under the terms of the GNU Lesser General Public License - as published by the Free Software Foundation, either version 3 of the - License, or (at your option) any later version. - - GnuCOBOL is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU Lesser General Public License for more details. - - You should have received a copy of the GNU Lesser General Public License - along with GnuCOBOL. If not, see . -*/ - -#if defined(IS_ISAM_LIB) -#ifdef WITH_CISAM -#undef WITH_CISAM -#endif -#ifdef WITH_DISAM -#undef WITH_DISAM -#endif -#ifdef WITH_VBISAM -#undef WITH_VBISAM -#endif - -#ifdef FOR_CISAM -#define WITH_CISAM -#define ISAM_TYPE "C-ISAM" -#ifdef VB_RTD -#undef VB_RTD -#endif -#endif -#ifdef FOR_DISAM -#define WITH_DISAM -#define ISAM_TYPE "D-ISAM" -#ifdef VB_RTD -#undef VB_RTD -#endif -#endif -#ifdef FOR_VBISAM -#define ISAM_TYPE "VB-ISAM" -#define WITH_VBISAM -#endif -#endif - -#include "fileio.h" - -#if !defined(WITH_MULTI_ISAM) || defined(IS_ISAM_LIB) - -#if defined(WITH_CISAM) || defined(WITH_DISAM) || defined(WITH_VBISAM) -#ifdef cobglobptr -#undef cobglobptr -#endif -#ifdef cobsetptr -#undef cobsetptr -#endif -#define cobglobptr isam_globptr -#define cobsetptr isam_setptr -static cob_global *isam_globptr; -static cob_settings *isam_setptr; -#define COB_WITH_STATUS_02 -#if defined(WITH_VBISAM) && defined(WITH_DISAM) -#undef WITH_DISAM -#endif - -#if defined(WITH_CISAM) -#include -#define isfullclose(x) isclose (x) -#define ISRECNUM isrecnum -#define ISERRNO iserrno -#define ISRECLEN isreclen - -#elif defined(WITH_DISAM) -#ifndef DISAM_NO_ISCONFIG -#include -#ifndef ISCOBOL_STATS -#undef COB_WITH_STATUS_02 -#endif -#endif -#include -#ifdef ISSTAT -#ifndef COB_WITH_STATUS_02 -#define COB_WITH_STATUS_02 -#endif -#endif -#define isfullclose(x) isclose (x) -#define ISRECNUM isrecnum -#define ISERRNO iserrno -#define ISRECLEN isreclen - -#elif defined(WITH_VBISAM) -#include -#ifdef COB_WITH_STATUS_02 -#undef COB_WITH_STATUS_02 -#endif -#ifdef VB_MAX_KEYLEN -#ifndef MAXKEYLEN -#define MAXKEYLEN VB_MAX_KEYLEN -#endif -#endif -#if defined(VB_RTD) -/* Since VBISAM 2.1.1: access to isrecnum iserrno etc is no longer global */ -static vb_rtd_t *vbisam_rtd = NULL; - -#define ISRECNUM vbisam_rtd->isrecnum -#define ISERRNO vbisam_rtd->iserrno -#define ISRECLEN vbisam_rtd->isreclen -#else -#define ISRECNUM isrecnum -#define ISERRNO iserrno -#define ISRECLEN isreclen -#endif - -#else -#error ISAM type undefined -#endif - -#ifndef MAXKEYLEN -#define MAXKEYLEN 120 -#endif - -#ifndef ISVARLEN -/* ISAM code configured to not support variable length records */ -#define ISVARLEN 0 -#endif - -#ifndef MAXNUMKEYS -#define MAXNUMKEYS 32 -#endif - -#ifdef COB_WITH_STATUS_02 -#define COB_CHECK_DUP(s) s ? s : \ - (isstat1 == '0' && isstat2 == '2') ? COB_STATUS_02_SUCCESS_DUPLICATE : 0 -#else -#define COB_CHECK_DUP(s) s ? s : s -#endif - -/* Isam File handler packet */ - -struct indexfile { - char *filename; /* ISAM data file name */ - char *savekey; /* Area to save last primary key read */ - char *recwrk; /* Record work/save area */ - int nkeys; /* Actual keys in file */ - int isfd; /* ISAM file number */ - long recnum; /* Last record number read */ - long saverecnum; /* isrecnum of next record to process */ - int saveerrno; /* savefileposition errno */ - int lmode; /* File lock mode for 'isread' */ - int startcond; /* Previous 'start' condition value */ - int readdir; /* Read direction: ISPREV or ISNEXT */ - int lenkey; /* Length of savekey area */ - int eofpending; /* End of file pending */ - int readdone; /* A 'read' has been successfully done */ - int startiscur; /* The 'start' record is current */ - int wrkhasrec; /* 'recwrk' holds the next|prev record */ - unsigned char idxmap[MAXNUMKEYS]; - struct keydesc key[1]; /* Table of key information */ - /* keydesc is defined in (d|c|vb)isam.h */ -}; - -/* Local variables */ - -static int isam_open (cob_file_api *a, cob_file *, char *, const int, const int); -static int isam_close (cob_file_api *a, cob_file *, const int); -static int isam_start (cob_file_api *a, cob_file *, const int, cob_field *); -static int isam_read (cob_file_api *a, cob_file *, cob_field *, const int); -static int isam_read_next(cob_file_api *a, cob_file *, const int); -static int isam_write (cob_file_api *a, cob_file *, const int); -static int isam_delete (cob_file_api *a, cob_file *); -static int isam_rewrite (cob_file_api *a, cob_file *, const int); -static int isam_file_delete (cob_file_api *a, cob_file *f, char *name); -static int isam_sync (cob_file_api *a, cob_file *f); -static void cob_isam_exit_fileio (cob_file_api *a); -void cob_isam_init_fileio (cob_file_api *a); - -static int -isam_dummy () -{ - return 0; -} - -static const struct cob_fileio_funcs ext_indexed_funcs = { - isam_open, - isam_close, - isam_start, - isam_read, - isam_read_next, - isam_write, - isam_rewrite, - isam_delete, - isam_file_delete, - cob_isam_init_fileio, - cob_isam_exit_fileio, - isam_dummy, - isam_sync, /* sync */ - isam_sync, /* commit */ - isam_dummy, /* rollback */ - isam_dummy -}; - -/* Local functions */ - -/* Return total length of the key */ -static int -indexed_keylen (struct indexfile *fh, int idx) -{ - int totlen, part; - totlen = 0; - for (part = 0; part < fh->key[idx].k_nparts; part++) { - totlen += fh->key[idx].k_part[part].kp_leng; - } - return totlen; -} - -/* Save key for given index into 'savekey' - Return total length of the key */ -static int -indexed_savekey (struct indexfile *fh, unsigned char *data, int idx) -{ - int totlen, part; - totlen = 0; - if (data == NULL) { - data = (unsigned char*)fh->recwrk; - } - for (part = 0; part < fh->key[idx].k_nparts; part++) { - memcpy (fh->savekey + totlen, - data + fh->key[idx].k_part[part].kp_start, - fh->key[idx].k_part[part].kp_leng); - totlen += fh->key[idx].k_part[part].kp_leng; - } - return totlen; -} - -/* Copy key for given index from 'savekey' back to recwrk - Return total length of the key */ -static int -indexed_restorekey (struct indexfile *fh, unsigned char *data, int idx) -{ - int totlen, part; - totlen = 0; - if (data == NULL) { - data = (unsigned char*)fh->recwrk; - } - for (part = 0; part < fh->key[idx].k_nparts; part++) { - memcpy (data + fh->key[idx].k_part[part].kp_start, - fh->savekey + totlen, - fh->key[idx].k_part[part].kp_leng); - totlen += fh->key[idx].k_part[part].kp_leng; - } - return totlen; -} - -/* Compare key for given index 'savekey' to recwrk - Return compare status */ -static int -indexed_cmpkey (struct indexfile *fh, unsigned char *data, int idx, int partlen) -{ - int sts, part, totlen,cl; - totlen = sts = 0; - if (partlen <= 0) { - partlen = indexed_keylen(fh, idx); - } - for (part = 0; part < fh->key[idx].k_nparts && partlen > 0; part++) { - cl = partlen > fh->key[idx].k_part[part].kp_leng ? fh->key[idx].k_part[part].kp_leng : partlen; - sts = memcmp( data + fh->key[idx].k_part[part].kp_start, - fh->savekey + totlen, cl); - if (sts != 0) { - return sts; - } - totlen += fh->key[idx].k_part[part].kp_leng; - partlen -= fh->key[idx].k_part[part].kp_leng; - } - return sts; -} - -/* Build 'keydesc' from 'cob_file_key' - Return total length of the key */ -static int -indexed_keydesc (cob_file *f, struct keydesc *kd, cob_file_key *key) -{ - int keylen,part; - memset (kd,0,sizeof (struct keydesc)); - kd->k_flags = key->tf_duplicates ? ISDUPS : ISNODUPS; - if (key->count_components <= 1) { - kd->k_nparts = 1; /* Single field key */ - kd->k_start = key->offset; - kd->k_leng = key->field->size; - kd->k_type = CHARTYPE; -#ifdef NULLKEY - if (key->tf_suppress) { - kd->k_flags |= NULLKEY; - kd->k_type = CHARTYPE | (key->char_suppress << 8); - } -#endif - keylen = kd->k_leng; - } else { - keylen = 0; - for (part=0; part < key->count_components && part < COB_MAX_KEYCOMP; part++) { - kd->k_part[part].kp_start = key->component[part]->data - f->record->data; - kd->k_part[part].kp_leng = key->component[part]->size; - keylen += kd->k_part[part].kp_leng; - kd->k_part[part].kp_type = CHARTYPE; -#ifdef NULLKEY - if (key->tf_suppress) { - kd->k_flags |= NULLKEY; - kd->k_part[part].kp_type = CHARTYPE | (key->char_suppress << 8); - } -#endif - } - kd->k_nparts = part; - } -#if defined(WITH_DISAM) || defined(WITH_VBISAM) - kd->k_len = keylen; /* Total length of this key */ -#endif - return keylen; -} - -/* Compare 'keydesc' to 'keydesc' - Return 0 if equal, else 1 */ -static int -indexed_keycmp (struct keydesc *k1, struct keydesc *k2) -{ - int part; - if (k1->k_flags != k2->k_flags) { - return 1; - } - if (k1->k_nparts != k2->k_nparts) { - return 1; - } - for (part=0; part < k1->k_nparts; part++) { - if (k1->k_part[part].kp_start != k2->k_part[part].kp_start) { - return 1; - } - if (k1->k_part[part].kp_leng != k2->k_part[part].kp_leng) { - return 1; - } - if (k1->k_part[part].kp_type != k2->k_part[part].kp_type) { - return 1; - } - } - return 0; -} - -/* Return index number for given key */ -static int -indexed_findkey (cob_file *f, cob_field *kf, int *fullkeylen, int *partlen) -{ - int k,part; - struct indexfile *fh; - - fh = f->file; - *fullkeylen = *partlen = 0; - for (k = 0; k < f->nkeys; ++k) { - if (f->keys[k].field - && f->keys[k].count_components <= 1 - && f->keys[k].field->data == kf->data) { - f->last_key = f->keys[k].field; - *fullkeylen = f->keys[k].field->size; - *partlen = kf->size; - return fh->idxmap[k]; - } - } - for (k = 0; k < f->nkeys; ++k) { - if (f->keys[k].count_components > 1) { - if ((f->keys[k].field - && f->keys[k].field->data == kf->data - && f->keys[k].field->size == kf->size) - || (f->keys[k].component[0]->data == kf->data)) { - f->last_key = f->keys[k].field; - for(part=0; part < f->keys[k].count_components; part++) - *fullkeylen += f->keys[k].component[part]->size; - if (f->keys[k].field - && f->keys[k].field->data == kf->data) { - *partlen = kf->size; - } else { - *partlen = *fullkeylen; - } - return fh->idxmap[k]; - } - } - } - return -1; -} - -static int -isam_sync (cob_file_api *a, cob_file *f) -{ - struct indexfile *fh; - - COB_UNUSED (a); - if (f->organization == COB_ORG_INDEXED - && f->open_mode != COB_OPEN_CLOSED) { - fh = f->file; - if (fh - && fh->isfd > 0) { - isflush (fh->isfd); - } - } - return 0; -} - - -/* INDEXED */ - - -/* Translate ISAM status to COBOL status */ -static int -fisretsts (const int default_status) -{ - switch (ISERRNO) { - case 0: - return COB_STATUS_00_SUCCESS; - case ENOREC: - return COB_STATUS_23_KEY_NOT_EXISTS; - case EENDFILE: - if (default_status != COB_STATUS_23_KEY_NOT_EXISTS) { - return COB_STATUS_10_END_OF_FILE; - } - break; - case EDUPL: - case EKEXISTS: - return COB_STATUS_22_KEY_EXISTS; - case EPERM: - case EACCES: - case EISDIR: - return COB_STATUS_37_PERMISSION_DENIED; - case ENOENT: - return COB_STATUS_35_NOT_EXISTS; - case EBADFILE: - return COB_STATUS_30_PERMANENT_ERROR; - case ELOCKED: - return COB_STATUS_51_RECORD_LOCKED; - case EDEADLK: - return COB_STATUS_52_DEAD_LOCK; - case ENOLCK: - return COB_STATUS_53_MAX_LOCKS; - case EFLOCKED: - return COB_STATUS_61_FILE_SHARING; - case ENOCURR: - if (default_status != COB_STATUS_10_END_OF_FILE) { - return COB_STATUS_21_KEY_INVALID; - } - break; - default: - break; - } - return default_status; -} - -/* Free memory for indexfile packet */ - -static void -freefh (struct indexfile *fh) -{ - if (fh == NULL) { - return; - } - if (fh->filename) { - cob_free ((void *)fh->filename); - } - if (fh->savekey) { - cob_free ((void *)fh->savekey); - } - if (fh->recwrk) { - cob_free ((void *)fh->recwrk); - } - cob_free ((void *)fh); -} - -/* Restore ISAM file positioning */ -static void -restorefileposition (cob_file *f) -{ - struct indexfile *fh; - struct keydesc k0; - - fh = f->file; - memset ((void *)&k0, 0, sizeof (k0)); - if (fh->saverecnum >= 0) { - /* Switch back to index */ - ISRECNUM = fh->saverecnum; - /* Switch to recnum mode */ - isstart (fh->isfd, &k0, 0, (void *)fh->recwrk, ISEQUAL); - /* Read by record number */ - isread (fh->isfd, (void *)fh->recwrk, ISEQUAL); - /* Read by current key value */ - isstart (fh->isfd, &fh->key[f->curkey], 0, - (void *)fh->recwrk, ISGTEQ); - isread (fh->isfd, (void *)fh->recwrk, ISGTEQ); - while (ISRECNUM != fh->saverecnum) { - /* Read back into position */ - if (isread (fh->isfd, (void *)fh->recwrk, ISNEXT)) { - break; - } - } - if (ISRECNUM == fh->saverecnum) { - if (fh->readdir == ISNEXT) { - /* Back off by one so next read gets this */ - isread (fh->isfd, (void *)fh->recwrk, ISPREV); - } else { - isread (fh->isfd, (void *)fh->recwrk, ISNEXT); - } - } - } else if (fh->readdone && f->curkey == 0) { - indexed_restorekey(fh, NULL, 0); - isstart (fh->isfd, &fh->key[f->curkey], 0, - (void *)fh->recwrk, ISGTEQ); - } -} - -/* Save ISAM file positioning information for later 'restorefileposition' */ - -static void -savefileposition (cob_file *f) -{ - struct indexfile *fh; - - fh = f->file; - if (f->curkey >= 0 && fh->readdir != -1) { - /* Switch back to index */ - if (fh->wrkhasrec != fh->readdir) { - fh->eofpending = 0; - fh->wrkhasrec = 0; - /* Read next record in file */ - if (isread (fh->isfd, (void *)fh->recwrk, fh->readdir)) { - fh->saverecnum = -1; - fh->saveerrno = ISERRNO; - if (fh->saveerrno == EENDFILE || - fh->saveerrno == ENOREC) { - fh->eofpending = fh->readdir; - } - } else { - fh->saverecnum = ISRECNUM; - fh->saveerrno = 0; - } - /* Restore saved record data */ - memcpy (fh->recwrk, f->record->data, f->record_max); - } - } else { - fh->saverecnum = -1; - } -} - -/* - * Open ISAM File, if locked retry as requested - */ -static int -isopen_retry(cob_file *f, char *filename, int mode) -{ - int isfd, retry, interval; - - retry = interval = 0; - if ((f->retry_mode & COB_RETRY_FOREVER)) { - retry = -1; - } else - if ((f->retry_mode & COB_RETRY_SECONDS)) { - retry = 1; - interval = f->retry_seconds>0?f->retry_seconds: - (isam_setptr->cob_retry_seconds>0?isam_setptr->cob_retry_seconds:1); - } else - if ((f->retry_mode & COB_RETRY_TIMES)) { - retry = f->retry_times>0?f->retry_times: - (isam_setptr->cob_retry_times>0?isam_setptr->cob_retry_times:1); - interval = isam_setptr->cob_retry_seconds>0?isam_setptr->cob_retry_seconds:1; - } - if(retry > 0) { - retry = retry * interval * COB_RETRY_PER_SECOND ; - interval = 1000 / COB_RETRY_PER_SECOND ; - } - isfd = isopen ((void *)filename, mode); - while(isfd < 0 && retry != 0) { - if (ISERRNO != EFLOCKED) - break; - if(retry > 0) { - retry--; - cob_sleep_msec(interval); - } - isfd = isopen ((void *)filename, mode); - } - if (isfd >= 0 - && (mode & ISEXCLLOCK)) - f->flag_file_lock = 1; - else - f->flag_file_lock = 0; - return isfd; -} - -/* - * Read ISAM record, if locked retry as requested - */ -static int -isread_retry(cob_file *f, void *data, int mode) -{ - int isfd, sts, retry, interval; - struct indexfile *fh; - - fh = f->file; - isfd = fh->isfd; - - retry = interval = 0; - if ((f->retry_mode & COB_RETRY_FOREVER)) { - retry = -1; - } else - if ((f->retry_mode & COB_RETRY_SECONDS)) { - retry = 1; - interval = f->retry_seconds>0?f->retry_seconds: - (isam_setptr->cob_retry_seconds>0?isam_setptr->cob_retry_seconds:1); - } else - if ((f->retry_mode & COB_RETRY_TIMES)) { - retry = f->retry_times>0?f->retry_times: - (isam_setptr->cob_retry_times>0?isam_setptr->cob_retry_times:1); - interval = isam_setptr->cob_retry_seconds>0?isam_setptr->cob_retry_seconds:1; - } - if(retry > 0) { - retry = retry * interval * COB_RETRY_PER_SECOND ; - interval = 1000 / COB_RETRY_PER_SECOND ; - } - do { - ISERRNO = 0; - sts = isread (isfd, data, mode); -#ifdef ISSKIPLOCK - if ((mode & ISSKIPLOCK)) - break; -#endif - if (!(mode & ISLOCK)) - break; - if (ISERRNO != ELOCKED - || retry == 0 - || sts == 0) - break; - if(retry > 0) { - retry--; - cob_sleep_msec(interval); - } - } while(sts != 0 && retry != 0); - return sts; -} - -/* Delete file */ - -static int -isam_file_delete (cob_file_api *a, cob_file *f, char *filename) -{ -#if defined(WITH_DISAM) - struct stat st; -#endif - char file_name_buf [COB_FILE_MAX]; - - COB_UNUSED (a); - COB_UNUSED (f); - - snprintf (file_name_buf, (size_t)COB_FILE_MAX, "%s.idx", filename); - unlink (file_name_buf); - snprintf (file_name_buf, (size_t)COB_FILE_MAX, "%s.dat", filename); -#if defined(WITH_DISAM) - if (stat(file_name_buf, &st) != 0) { /* Micro Focus naming style has no .dat */ - snprintf (file_name_buf, (size_t)COB_FILE_MAX, "%s", filename); - } -#endif - unlink (file_name_buf); - return 0; -} - -/* OPEN INDEXED file */ - -static int -isam_open (cob_file_api *a, cob_file *f, char *filename, const int mode, const int sharing) -{ - /* Note filename points to file_open_name */ - /* cob_chk_file_mapping manipulates file_open_name directly */ - - struct indexfile *fh, *fh2; - int k; - int ret,len,j; - int omode; - int lmode; - int vmode; - int dobld; - int isfd; - int checkvalue; - struct keydesc kd; - struct dictinfo di; /* Defined in (c|d|vb)isam.h */ - -#if defined(WITH_CISAM) - f->io_routine = COB_IO_CISAM; -#elif defined(WITH_DISAM) - f->io_routine = COB_IO_DISAM; -#elif defined(WITH_VBISAM) - f->io_routine = COB_IO_VBISAM; -#endif - if (mode == COB_OPEN_INPUT) { - checkvalue = R_OK; - } else { - checkvalue = R_OK | W_OK; - } - - snprintf (a->file_open_buff, (size_t)COB_FILE_MAX, "%s.idx", filename); - errno = 0; - if (access (a->file_open_buff, checkvalue)) { - if (!(errno == ENOENT && (mode == COB_OPEN_OUTPUT || f->flag_optional == 1))) { - switch (errno) { - case ENOENT: - return COB_STATUS_35_NOT_EXISTS; - case EACCES: - return COB_STATUS_37_PERMISSION_DENIED; - default: - return COB_STATUS_30_PERMANENT_ERROR; - } - } - } - - snprintf (a->file_open_buff, (size_t)COB_FILE_MAX, "%s.dat", filename); - errno = 0; -#if defined(WITH_DISAM) - if (access (a->file_open_buff, checkvalue) - && (errno == ENOENT) ) { /* D-ISAM will handle files with Micro Focus naming style */ - errno = 0; - snprintf (a->file_open_buff, (size_t)COB_FILE_MAX, "%s", filename); - } -#endif - if (access (a->file_open_buff, checkvalue)) { - if (!(errno == ENOENT && (mode == COB_OPEN_OUTPUT || f->flag_optional == 1))) { - switch (errno) { - case ENOENT: - return COB_STATUS_35_NOT_EXISTS; - case EACCES: - return COB_STATUS_37_PERMISSION_DENIED; - default: - return COB_STATUS_30_PERMANENT_ERROR; - } - } - } - - ret = COB_STATUS_00_SUCCESS; - omode = 0; - lmode = 0; - vmode = 0; - dobld = 0; - isfd = -1; - if (f->record_min != f->record_max) { - vmode = ISVARLEN; - ISRECLEN = f->record_min; - } - if ((f->share_mode & COB_SHARE_NO_OTHER) - || (f->lock_mode & COB_FILE_EXCLUSIVE) ) { - lmode = ISEXCLLOCK; - } else if (!f->lock_mode) { - if (mode != COB_OPEN_INPUT) { - lmode = ISEXCLLOCK; - } else { - lmode = ISMANULOCK; - } - } else if ((f->lock_mode & COB_LOCK_AUTOMATIC) && mode != COB_OPEN_INPUT) { - lmode = ISAUTOLOCK; - } else { - lmode = ISMANULOCK; - } - switch (mode) { - case COB_OPEN_INPUT: - omode = ISINPUT; - break; - case COB_OPEN_OUTPUT: - lmode = ISEXCLLOCK; - omode = ISOUTPUT; - ISERRNO = 0; - isfd = isopen ((void *)filename, ISINPUT | ISEXCLLOCK | vmode); - if (ISERRNO == EFLOCKED) { - return COB_STATUS_61_FILE_SHARING; - } else { - if (isfd >= 0) { - isfullclose (isfd); - } - isam_file_delete (a, f, filename); - ISERRNO = 0; - } - dobld = 1; - break; - case COB_OPEN_I_O: - omode = ISINOUT; - break; - case COB_OPEN_EXTEND: - lmode = ISEXCLLOCK; - omode = ISINOUT; - break; - } - fh = cob_malloc (sizeof (struct indexfile) + - ((sizeof (struct keydesc)) * (f->nkeys + 1))); - /* Copy index information */ - for (k = 0; k < f->nkeys; ++k) { - len = indexed_keydesc(f, &fh->key[k], &f->keys[k]); - if (fh->lenkey < len) { - fh->lenkey = len; - } - } - ISERRNO = 0; - fh->lmode = 0; - if (dobld) { -dobuild: - isfd = isbuild ((void *)filename, (int)f->record_max, &fh->key[0], - vmode | ISINOUT | ISEXCLLOCK); - for(k=0; k < MAXNUMKEYS; k++) - fh->idxmap[k] = k; - f->flag_file_lock = 1; - if (ISERRNO == EEXIST - && isfd < 0) { - /* Erase file and redo the 'isbuild' */ - iserase ((void *)filename); - isfd = isbuild ((void *)filename, (int)f->record_max, &fh->key[0], - vmode | ISINOUT | ISEXCLLOCK); - f->flag_file_lock = 1; - } - } else { - if (lmode == ISAUTOLOCK - && (f->lock_mode & COB_LOCK_MULTIPLE)) { - lmode = ISMANULOCK; - } - if (lmode == ISMANULOCK) { - fh->lmode = ISLOCK; /* fileio will handle Record locking */ - } - isfd = isopen_retry (f, (char *)filename, omode | lmode | vmode); - if (isfd < 0) { - if (ISERRNO == EFLOCKED) - return COB_STATUS_61_FILE_SHARING; - if (f->flag_optional) { - if (mode == COB_OPEN_EXTEND - || mode == COB_OPEN_I_O) { - dobld = 1; - ret = COB_STATUS_05_SUCCESS_OPTIONAL; - goto dobuild; - } - freefh (fh); - f->open_mode = mode; - f->flag_end_of_file = 1; - f->flag_begin_of_file = 1; - if (f->flag_nonexistent) { - return COB_STATUS_00_SUCCESS; - } - f->flag_nonexistent = 1; - return COB_STATUS_05_SUCCESS_OPTIONAL; - } - } else { - memset(&di, 0, sizeof (di)); - isindexinfo (isfd, (void *)&di, 0); - /* Mask off ISVARLEN */ - fh->nkeys = di.di_nkeys & 0x7F; - if (fh->nkeys != f->nkeys - && f->flag_keycheck) { - ret = COB_STATUS_39_CONFLICT_ATTRIBUTE; - } else if (fh->nkeys > f->nkeys) { - /* More keys in file than COBOL has defined */ - fh2 = cob_malloc (sizeof(struct indexfile) + - ((sizeof (struct keydesc)) * (fh->nkeys + 1))); - memcpy (fh2, fh, sizeof(struct indexfile) + - ((sizeof (struct keydesc)) * (f->nkeys + 1))); - cob_free (fh); - fh = fh2; - } - if (f->record_max != di.di_recsize) { - if (f->flag_auto_type) { - f->record_min = f->record_max = di.di_recsize; - f->record->size = di.di_recsize; - if (f->variable_record) - cob_set_int (f->variable_record, (int) f->record->size); - } else - if (f->flag_keycheck - || f->record_max < di.di_recsize) { - ret = COB_STATUS_39_CONFLICT_ATTRIBUTE; - } - } - for(k=0; k < MAXNUMKEYS; k++) - fh->idxmap[k] = k; - if (!f->flag_keycheck) { - /* Copy real ISAM file key information */ - for (k = 0; k < fh->nkeys && !ret; ++k) { - memset (&fh->key[k], 0, sizeof(struct keydesc)); - isindexinfo (isfd, &fh->key[k], (int)(k+1)); - if (fh->lenkey < indexed_keylen(fh, k)) { - fh->lenkey = indexed_keylen(fh, k); - } - } - /* Verify that COBOL keys defined match some real ISAM key */ - for (j = 0; j < f->nkeys && !ret; ++j) { - indexed_keydesc(f, &kd, &f->keys[j]); - for (k = 0; k < fh->nkeys; ++k) { - if (indexed_keycmp(&kd, &fh->key[k]) == 0) { - fh->idxmap[j] = k; - break; - } - } - if (k >= fh->nkeys) { - if (mode != COB_OPEN_INPUT - || f->access_mode != COB_ACCESS_SEQUENTIAL - || !f->flag_auto_type) { - ret = COB_STATUS_39_CONFLICT_ATTRIBUTE; - } - } - } - } else { - for (k = 0; k < fh->nkeys && !ret; ++k) { - memset (&fh->key[k], 0, sizeof(struct keydesc)); - isindexinfo (isfd, &fh->key[k], (int)(k+1)); - if (fh->lenkey < indexed_keylen(fh, k)) { - fh->lenkey = indexed_keylen(fh, k); - } - /* Verify that COBOL keys match exactly to real ISAM keys */ - len = indexed_keydesc(f, &kd, &f->keys[k]); - if (fh->lenkey < len) { - fh->lenkey = len; - } - if (indexed_keycmp(&kd, &fh->key[k]) != 0) { - ret = COB_STATUS_39_CONFLICT_ATTRIBUTE; - break; - } - } - } - } - } - if (isfd < 0) { - ret = fisretsts (COB_STATUS_30_PERMANENT_ERROR); - freefh (fh); - return ret; - } - if (ret > 9) { - isfullclose (isfd); - freefh (fh); - return ret; - } - if (dobld) { - for (k = 1; k < f->nkeys; ++k) { - ISERRNO = 0; - if (isaddindex (isfd, &fh->key[k])) { - ret = COB_STATUS_39_CONFLICT_ATTRIBUTE; - } - } - if (ret > 9) { - isfullclose (isfd); - iserase ((void *)filename); - freefh (fh); - return ret; - } - } - f->file = fh; - f->open_mode = mode; - fh->isfd = isfd; - fh->filename = cob_strdup (filename); - fh->savekey = cob_malloc ((size_t)(fh->lenkey + 1)); - fh->recwrk = cob_malloc ((size_t)(f->record_max + 1)); - /* Active index is unknown at this time */ - f->curkey = -1; - f->flag_nonexistent = 0; - f->flag_end_of_file = 0; - f->flag_begin_of_file = 0; - return ret; -} - -/* Close the INDEXED file */ - -static int -isam_close (cob_file_api *a, cob_file *f, const int opt) -{ - struct indexfile *fh; - - COB_UNUSED (opt); - - fh = f->file; - if (fh == NULL) { - return COB_STATUS_00_SUCCESS; - } - if (fh->isfd >= 0) { - isfullclose (fh->isfd); - } - freefh (fh); - f->file = NULL; - return COB_STATUS_00_SUCCESS; -} - - -/* START INDEXED file with positioning */ - -static int -isam_start (cob_file_api *a, cob_file *f, const int cond, cob_field *key) -{ - struct indexfile *fh; - int k; - int mode; - int klen,fullkeylen,partlen; - int savecond; - - fh = f->file; - f->flag_read_done = 0; - f->flag_first_read = 0; - fh->readdone = 0; - fh->eofpending = 0; - fh->startiscur = 0; - fh->wrkhasrec = 0; - if (f->flag_nonexistent) { - return COB_STATUS_23_KEY_NOT_EXISTS; - } - k = indexed_findkey(f, key, &fullkeylen, &partlen); - if(k < 0) { - return COB_STATUS_23_KEY_NOT_EXISTS; - } - /* Use size of data field; This may indicate a partial key */ - klen = partlen; - if (klen < 1 || klen > fullkeylen) { - /* Max key length for this index */ - klen = fullkeylen; - } - mode = ISGTEQ; - fh->startiscur = 1; - savecond = cond; - switch (cond) { - case COB_EQ: - mode = ISEQUAL; - fh->readdir = ISNEXT; - break; - case COB_GE: - mode = ISGTEQ; - fh->readdir = ISNEXT; - break; - case COB_GT: - mode = ISGREAT; - fh->readdir = ISNEXT; - break; - case COB_LE: - mode = ISGTEQ; - fh->readdir = ISPREV; - break; - case COB_LT: - mode = ISGTEQ; - fh->readdir = ISPREV; - break; - case COB_FI: - mode = ISFIRST; - fh->readdir = ISNEXT; - break; - case COB_LA: - mode = ISLAST; - fh->readdir = ISPREV; - break; - default: - return COB_STATUS_21_KEY_INVALID; - } - if (isstart (fh->isfd, &fh->key[k], klen, (void *)f->record->data, mode)) { - if (cond == COB_LE || cond == COB_LT) { - if (isstart (fh->isfd, &fh->key[k], klen, (void *)f->record->data, ISLAST)) { - f->curkey = -1; - fh->startcond = -1; - fh->readdir = -1; - fh->startiscur = 0; - return fisretsts (COB_STATUS_23_KEY_NOT_EXISTS); - } else { - savecond = COB_LA; - } - } else { - f->curkey = -1; - fh->startcond = -1; - fh->readdir = -1; - fh->startiscur = 0; - return fisretsts (COB_STATUS_23_KEY_NOT_EXISTS); - } - } - fh->startcond = savecond; - indexed_savekey(fh, f->record->data, k); - f->curkey = k; - f->flag_end_of_file = 0; - f->flag_begin_of_file = 0; - f->flag_first_read = 1; - return COB_STATUS_00_SUCCESS; -} - -/* Random READ of the INDEXED file */ - -static int -isam_read (cob_file_api *a, cob_file *f, cob_field *key, const int read_opts) -{ - struct indexfile *fh; - int k,fullkeylen,partlen; - int ret; - int lmode; - - fh = f->file; - fh->eofpending = 0; - fh->startiscur = 0; - fh->wrkhasrec = 0; - if (f->flag_nonexistent) { - return COB_STATUS_23_KEY_NOT_EXISTS; - } - k = indexed_findkey(f, key, &fullkeylen, &partlen); - if(k < 0) { - return COB_STATUS_23_KEY_NOT_EXISTS; - } - if (f->curkey != (int)k) { - /* Switch to this index */ - isstart (fh->isfd, &fh->key[k], 0, - (void *)f->record->data, ISEQUAL); - f->curkey = k; - fh->wrkhasrec = 0; - } - fh->startcond = -1; - lmode = 0; - if (read_opts & COB_READ_LOCK) { - lmode = ISLOCK; - } else if (read_opts & COB_READ_WAIT_LOCK) { - if (f->retry_mode == 0 - || (f->retry_mode & COB_RETRY_FOREVER)) { - lmode = ISLCKW; /* ISAM library will wait FOREVER! */ - } else { - lmode = ISLOCK; /* isread_retry will handle the retries */ - } - } else if ((f->lock_mode & COB_LOCK_AUTOMATIC) - && (f->open_mode != COB_OPEN_INPUT) ) { - lmode = ISLOCK; - } - if ((read_opts & COB_READ_IGNORE_LOCK) - || (read_opts & COB_READ_NO_LOCK) ) { - lmode &= ~ISLOCK; - } - if ((fh->lmode & ISLOCK) && !(f->lock_mode & COB_LOCK_MULTIPLE)) { - isrelease (fh->isfd); - } - ISERRNO = 0; - fh->readdir = -1; - ret = COB_STATUS_00_SUCCESS; - if (isread_retry (f, (void *)f->record->data, ISEQUAL | lmode)) { - ret = fisretsts (COB_STATUS_21_KEY_INVALID); - } - if (unlikely (ret != 0)) { - memset (fh->savekey, 0, fh->lenkey); - fh->recnum = 0; - fh->readdone = 0; - return ret; - } - f->flag_first_read = 0; - f->flag_read_done = 1; - fh->readdone = 1; - f->flag_end_of_file = 0; - f->flag_begin_of_file = 0; - indexed_savekey(fh, f->record->data, 0); - fh->recnum = ISRECNUM; - if (f->record_min != f->record_max) { - f->record->size = ISRECLEN; - } - if (f->variable_record) - cob_set_int (f->variable_record, (int) f->record->size); - return 0; -} - -/* Sequential READ of the INDEXED file */ - -static int -isam_read_next (cob_file_api *a, cob_file *f, const int read_opts) -{ - struct indexfile *fh; - int ret; - int lmode, skip_read; - int domoveback; - - COB_UNUSED (a); - fh = f->file; - ret = COB_STATUS_00_SUCCESS; - lmode = 0; - - if (f->curkey == -1) { - /* Switch to primary index */ - isstart (fh->isfd, &fh->key[0], 0, NULL, ISFIRST); - f->curkey = 0; - fh->readdir = ISNEXT; - fh->startcond = -1; - fh->startiscur = 0; - fh->wrkhasrec = 0; - } - if (read_opts & COB_READ_LOCK) { - lmode = ISLOCK; - } else if (read_opts & COB_READ_WAIT_LOCK) { - lmode = ISLCKW; - } else if ((f->lock_mode & COB_LOCK_AUTOMATIC) - && f->open_mode != COB_OPEN_INPUT) { - if (!(read_opts & COB_READ_IGNORE_LOCK)) { - lmode = ISLOCK; - } - } -#ifdef ISSKIPLOCK - if ((f->retry_mode & COB_ADVANCING_LOCK) - || (read_opts & COB_READ_ADVANCING_LOCK)) { - lmode |= ISSKIPLOCK; - } -#endif - if ((read_opts & COB_READ_IGNORE_LOCK)) { - lmode &= ~ISLOCK; - } - - if ((fh->lmode & ISLOCK) && !(f->lock_mode & COB_LOCK_MULTIPLE)) { - isrelease (fh->isfd); - } - skip_read = ISNEXT; - - ISERRNO = 0; - ret = COB_STATUS_00_SUCCESS; - switch (read_opts & COB_READ_MASK) { - case COB_READ_NEXT: - fh->readdir = ISNEXT; - if (fh->eofpending == ISNEXT) { - fh->eofpending = 0; - fh->wrkhasrec = 0; - return COB_STATUS_10_END_OF_FILE; - } - if (fh->startiscur) { - if (fh->startcond == COB_LA) { - skip_read = ISPREV; - if (isread_retry (f, (void *)f->record->data, ISLAST | lmode)) { - ret = fisretsts (COB_STATUS_10_END_OF_FILE); - } - } else if (fh->startcond == COB_FI) { - if (isread_retry (f, (void *)f->record->data, ISFIRST | lmode)) { - ret = fisretsts (COB_STATUS_10_END_OF_FILE); - } - } else if (isread (fh->isfd, (void *)f->record->data, ISCURR)) { - ret = fisretsts (COB_STATUS_10_END_OF_FILE); - } else { - switch (fh->startcond) { - case COB_GE: - domoveback = 0; - while (ISERRNO == 0 - && indexed_cmpkey(fh, f->record->data, f->curkey, 0) == 0) { - isread (fh->isfd, (void *)f->record->data, ISPREV); - domoveback = 1; - } - if (domoveback) { - isread (fh->isfd, (void *)f->record->data, ISERRNO == 0 ? ISNEXT : ISFIRST); - } - break; - case COB_LE: - domoveback = 0; - while (ISERRNO == 0 - && indexed_cmpkey(fh, f->record->data, f->curkey, 0) == 0) { - isread (fh->isfd, (void *)f->record->data, ISNEXT); - domoveback = 1; - } - if (domoveback) { - isread (fh->isfd, (void *)f->record->data, ISERRNO == 0 ? ISPREV : ISLAST); - } - break; - case COB_LT: - while (ISERRNO == 0 - && indexed_cmpkey(fh, f->record->data, f->curkey, 0) >= 0) { - isread (fh->isfd, (void *)f->record->data, ISPREV); - } - break; - case COB_GT: - while (ISERRNO == 0 - && indexed_cmpkey(fh, f->record->data, f->curkey, 0) <= 0) { - isread (fh->isfd, (void *)f->record->data, ISNEXT); - } - break; - } - if (isread_retry (f, (void *)f->record->data, ISCURR | lmode)) { - ret = fisretsts (COB_STATUS_10_END_OF_FILE); - } - } - fh->startcond = -1; - fh->startiscur = 0; - } else if (fh->wrkhasrec == ISNEXT) { - memcpy (f->record->data, fh->recwrk, f->record_max); - if (fh->lmode & ISLOCK) { - /* Now lock 'peek ahead' record */ - if (isread_retry (f, (void *)f->record->data, ISCURR | fh->lmode)) { - ret = fisretsts (COB_STATUS_10_END_OF_FILE); - } - } - } else { - if (fh->wrkhasrec == ISPREV) { - isread (fh->isfd, (void *)f->record->data, ISNEXT); - fh->wrkhasrec = 0; - } - if (isread_retry (f, (void *)f->record->data, ISNEXT | lmode)) { - ret = fisretsts (COB_STATUS_10_END_OF_FILE); - } - } - break; - case COB_READ_PREVIOUS: - skip_read = ISPREV; - fh->readdir = ISPREV; - if (fh->eofpending == ISPREV) { - fh->eofpending = 0; - fh->wrkhasrec = 0; - return COB_STATUS_10_END_OF_FILE; - } - if (fh->startiscur) { - if (fh->startcond == COB_FI) { - if (isread_retry (f, (void *)f->record->data, ISFIRST | lmode)) { - ret = fisretsts (COB_STATUS_10_END_OF_FILE); - } - } else if (fh->startcond == COB_LA) { - skip_read = ISPREV; - if (isread_retry (f, (void *)f->record->data, ISLAST | lmode)) { - ret = fisretsts (COB_STATUS_10_END_OF_FILE); - } - } else if (isread_retry (f, (void *)f->record->data, ISCURR | lmode)) { - ret = fisretsts (COB_STATUS_10_END_OF_FILE); - } else { - switch (fh->startcond) { - case COB_LE: - if(indexed_cmpkey(fh, f->record->data, f->curkey, 0) > 0) - domoveback = 1; - else - domoveback = 0; - while (ISERRNO == 0 - && indexed_cmpkey(fh, f->record->data, f->curkey, 0) == 0) { - isread (fh->isfd, (void *)f->record->data, ISNEXT); - domoveback = 1; - } - if (domoveback) { - isread (fh->isfd, (void *)f->record->data, ISPREV); - skip_read = ISPREV; - } - break; - case COB_LT: - isread (fh->isfd, (void *)f->record->data, ISPREV); - while (ISERRNO == 0 - && indexed_cmpkey(fh, f->record->data, f->curkey, 0) >= 0) { - isread (fh->isfd, (void *)f->record->data, ISPREV); - skip_read = ISPREV; - } - break; - case COB_GT: - while (ISERRNO == 0 - && indexed_cmpkey(fh, f->record->data, f->curkey, 0) <= 0) { - isread (fh->isfd, (void *)f->record->data, ISNEXT); - } - break; - case COB_GE: - while (ISERRNO == 0 - && indexed_cmpkey(fh, f->record->data, f->curkey, 0) < 0) { - isread (fh->isfd, (void *)f->record->data, ISNEXT); - } - break; - } - if (isread_retry (f, (void *)f->record->data, ISCURR | lmode)) { - ret = fisretsts (COB_STATUS_10_END_OF_FILE); - } - } - fh->startcond = -1; - fh->startiscur = 0; - } else if (fh->wrkhasrec == ISPREV) { - memcpy (f->record->data, fh->recwrk, f->record_max); - if (fh->lmode & ISLOCK) { - /* Now lock 'peek ahead' record */ - if (isread_retry (f, (void *)f->record->data, ISCURR | fh->lmode)) { - ret = fisretsts (COB_STATUS_10_END_OF_FILE); - } - } - } else { - if (fh->wrkhasrec == ISNEXT) { - isread (fh->isfd, (void *)f->record->data, ISPREV); - fh->wrkhasrec = 0; - } - skip_read = ISPREV; - if (isread_retry (f, (void *)f->record->data, ISPREV | lmode)) { - ret = fisretsts (COB_STATUS_10_END_OF_FILE); - } - } - break; - case COB_READ_FIRST: - fh->readdir = ISNEXT; - if (isread_retry (f, (void *)f->record->data, ISFIRST | lmode)) { - ret = fisretsts (COB_STATUS_10_END_OF_FILE); - } - break; - case COB_READ_LAST: - skip_read = ISPREV; - fh->readdir = ISPREV; - if (isread_retry (f, (void *)f->record->data, ISLAST | lmode)) { - ret = fisretsts (COB_STATUS_10_END_OF_FILE); - } - break; - default: - fh->readdir = ISNEXT; - if (isread_retry (f, (void *)f->record->data, ISNEXT | lmode)) { - ret = fisretsts (COB_STATUS_10_END_OF_FILE); - } - break; - } - while (ret == COB_STATUS_51_RECORD_LOCKED - && ((f->retry_mode & COB_ADVANCING_LOCK) - || (read_opts & COB_READ_ADVANCING_LOCK))) { - ret = COB_STATUS_00_SUCCESS; - if (isread_retry (f, (void *)f->record->data, skip_read | lmode)) { - ret = fisretsts (COB_STATUS_10_END_OF_FILE); - } - } - if (unlikely(ret != 0)) { - memset (fh->savekey, 0, fh->lenkey); - fh->recnum = 0; - fh->readdone = 0; - fh->wrkhasrec = 0; - return ret; - } - fh->eofpending = 0; - f->flag_first_read = 0; - f->flag_read_done = 1; - fh->readdone = 1; - f->flag_end_of_file = 0; - f->flag_begin_of_file = 0; - indexed_savekey(fh, f->record->data, 0); - fh->recnum = ISRECNUM; - if (f->record_min != f->record_max) { - f->record->size = ISRECLEN; - } - if (f->variable_record) - cob_set_int (f->variable_record, (int) f->record->size); - - return COB_CHECK_DUP (ret); -} - -/* WRITE to the INDEXED file */ - -static int -isam_write (cob_file_api *a, cob_file *f, const int opt) -{ - struct indexfile *fh; - int ret = 0; - - COB_UNUSED (a); - fh = f->file; - if (f->flag_nonexistent) { - return COB_STATUS_48_OUTPUT_DENIED; - } - if (f->access_mode == COB_ACCESS_SEQUENTIAL - && f->open_mode == COB_OPEN_OUTPUT - && !f->flag_set_isam - && indexed_cmpkey(fh, f->record->data, 0, 0) <= 0) { - return COB_STATUS_21_KEY_INVALID; - } - - if (f->record_min != f->record_max) { - ISRECLEN = f->record->size; - } - if ((opt & COB_WRITE_LOCK) - && !(f->lock_mode & COB_LOCK_AUTOMATIC) - && !f->flag_file_lock) { - /* WRITE and make it 'current' */ - if (unlikely(iswrcurr (fh->isfd, (void *)f->record->data))) { - return fisretsts (COB_STATUS_49_I_O_DENIED); - } - ret = COB_CHECK_DUP (ret); - /* Then read placing lock on the record */ - if (isread_retry (f, (void *)f->record->data, ISCURR | ISLOCK)) { - return fisretsts (COB_STATUS_49_I_O_DENIED); - } - } else { - if (unlikely(iswrite (fh->isfd, (void *)f->record->data))) { - return fisretsts (COB_STATUS_49_I_O_DENIED); - } - ret = COB_CHECK_DUP (ret); - } - indexed_savekey(fh, f->record->data, 0); - - return ret; -} - - -/* DELETE record from the INDEXED file */ - -static int -isam_delete (cob_file_api *a, cob_file *f) -{ - struct indexfile *fh; - int ret; - - COB_UNUSED (a); - fh = f->file; - ret = COB_STATUS_00_SUCCESS; - if (f->flag_nonexistent) { - return COB_STATUS_49_I_O_DENIED; - } - if (f->curkey == -1) { - /* Switch to primary index */ - isstart (fh->isfd, &fh->key[0], 0, - (void *)f->record->data, ISEQUAL); - f->curkey = 0; - fh->readdir = ISNEXT; - } else { - savefileposition (f); - if (f->curkey != 0) { - /* Switch to primary index */ - isstart (fh->isfd, &fh->key[0], 0, - (void *)f->record->data, ISEQUAL); - } - } - if (isread_retry (f, (void *)f->record->data, ISEQUAL | ISLOCK)) { - ret = fisretsts (COB_STATUS_21_KEY_INVALID); - } else if (isdelete (fh->isfd, (void *)f->record->data)) { - ret = fisretsts (COB_STATUS_49_I_O_DENIED); - } - restorefileposition (f); - if ( !(f->lock_mode & COB_LOCK_MULTIPLE)) { - isrelease (fh->isfd); - } - return ret; -} - -/* REWRITE record to the INDEXED file */ - -static int -isam_rewrite (cob_file_api *a, cob_file *f, const int opt) -{ - struct indexfile *fh; - int k; - int ret; - - COB_UNUSED (a); - fh = f->file; - ret = COB_STATUS_00_SUCCESS; - if (f->flag_nonexistent) { - return COB_STATUS_49_I_O_DENIED; - } - - if (f->access_mode == COB_ACCESS_SEQUENTIAL - && indexed_cmpkey(fh, f->record->data, 0, 0) != 0) { - return COB_STATUS_21_KEY_INVALID; - } - if (f->curkey >= 0) { - /* Index is active */ - /* Save record data */ - memcpy (fh->recwrk, f->record->data, f->record_max); - fh->readdir = ISNEXT; - savefileposition (f); - memcpy (fh->recwrk, f->record->data, f->record_max); - if (f->curkey != 0) { - /* Activate primary index */ - isstart (fh->isfd, &fh->key[0], 0, (void *)fh->recwrk, ISEQUAL); - } - /* Verify record exists */ - if (isread (fh->isfd, (void *)fh->recwrk, ISEQUAL)) { - restorefileposition (f); - return COB_STATUS_21_KEY_INVALID; - } - for (k = 1; k < f->nkeys && ret == COB_STATUS_00_SUCCESS; ++k) { - if (fh->key[k].k_flags & ISDUPS) { - continue; - } - memcpy (fh->recwrk, f->record->data, f->record_max); - isstart (fh->isfd, &fh->key[k], fh->key[k].k_leng, - (void *)fh->recwrk, ISEQUAL); - if (!isread (fh->isfd, (void *)fh->recwrk, ISEQUAL) - && ISRECNUM != fh->recnum) { - ret = COB_STATUS_22_KEY_EXISTS; - break; - } - } - if (ret == COB_STATUS_00_SUCCESS) { - memcpy (fh->recwrk, f->record->data, f->record_max); - isstart (fh->isfd, &fh->key[0], 0, (void *)fh->recwrk, ISEQUAL); - if (isread_retry (f, (void *)fh->recwrk, ISEQUAL | ISLOCK)) { - ret = fisretsts (COB_STATUS_49_I_O_DENIED); - } else { - if (f->record_min != f->record_max) { - ISRECLEN = f->record->size; - } - if (isrewcurr (fh->isfd, (void *)f->record->data)) { - ret = fisretsts (COB_STATUS_49_I_O_DENIED); - } - ret = COB_CHECK_DUP (ret); - } - } - - ret = COB_CHECK_DUP (ret); - restorefileposition (f); - - } else { - - memcpy (fh->recwrk, f->record->data, f->record_max); - if (isread_retry (f, (void *)fh->recwrk, ISEQUAL | ISLOCK)) { - ret = fisretsts (COB_STATUS_49_I_O_DENIED); - } else { - if (f->record_min != f->record_max) { - ISRECLEN = f->record->size; - } - if (isrewrite (fh->isfd, (void *)f->record->data)) { - ret = fisretsts (COB_STATUS_49_I_O_DENIED); - } - ret = COB_CHECK_DUP (ret); - } - ret = COB_CHECK_DUP (ret); - } - if (!ret) { - ret = COB_CHECK_DUP (ret); - if ((f->lock_mode & COB_LOCK_AUTOMATIC)) { - if (!(f->lock_mode & COB_LOCK_MULTIPLE)) { - isrelease (fh->isfd); - } - } else { - if (!(f->lock_mode & COB_LOCK_MULTIPLE)) { - if (!(opt & COB_WRITE_LOCK)) { - isrelease (fh->isfd); - } - } else - if ((opt & COB_WRITE_NO_LOCK)) { - isrelease (fh->isfd); - } - } - } else if (ret) { - isrelease (fh->isfd); - } - return ret; -} - -static void -cob_isam_exit_fileio (cob_file_api *a) -{ - COB_UNUSED (a); -#ifndef WITH_DISAM - (void)iscleanup (); -#endif -} - -void -cob_isam_init_fileio (cob_file_api *a) -{ -#if defined(WITH_VBISAM) && defined(WITH_DISAM) -#undef WITH_DISAM -#endif -#if defined(WITH_DISAM) - a->io_funcs[COB_IO_DISAM] = (void*) &ext_indexed_funcs; -#elif defined(WITH_CISAM) - a->io_funcs[COB_IO_CISAM] = (void*) &ext_indexed_funcs; -#elif defined(WITH_VBISAM) - a->io_funcs[COB_IO_VBISAM] = (void*) &ext_indexed_funcs; -#ifdef VB_RTD - if (vbisam_rtd == NULL) { /* VB-ISAM 2.1.1 run-time pointer */ - vbisam_rtd = VB_GET_RTD; - } -#endif -#endif - isam_globptr = a->glbptr; - isam_setptr = a->setptr; -} - -#endif -#endif /* WITH_MULTI_ISAM */ diff -Nru gnucobol-4.0~early~20200606/libcob/flmdb.c gnucobol-5/libcob/flmdb.c --- gnucobol-4.0~early~20200606/libcob/flmdb.c 2020-06-06 20:52:01.000000000 +0000 +++ gnucobol-5/libcob/flmdb.c 1970-01-01 00:00:00.000000000 +0000 @@ -1,1562 +0,0 @@ -/* - Copyright (C) 2002-2012, 2014-2019 Free Software Foundation, Inc. - Written by Keisuke Nishida, Roger While, Simon Sobisch, Ron Norman - - This file is part of GnuCOBOL. - - The GnuCOBOL runtime library is free software: you can redistribute it - and/or modify it under the terms of the GNU Lesser General Public License - as published by the Free Software Foundation, either version 3 of the - License, or (at your option) any later version. - - GnuCOBOL is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU Lesser General Public License for more details. - - You should have received a copy of the GNU Lesser General Public License - along with GnuCOBOL. If not, see . -*/ - -/* Force symbol exports */ -#define COB_LIB_EXPIMP -#include "fileio.h" - -#ifdef HAVE_SYS_SYSMACROS_H -#include -#endif - -#if WITH_LMDB - -/* Local variables */ - -static int lmdb_open (cob_file_api *, cob_file *, char *, const int, const int); -static int lmdb_close (cob_file_api *, cob_file *, const int); -static int lmdb_start (cob_file_api *, cob_file *, const int, cob_field *); -static int lmdb_read (cob_file_api *, cob_file *, cob_field *, const int); -static int lmdb_read_next(cob_file_api *, cob_file *, const int); -static int lmdb_write (cob_file_api *, cob_file *, const int); -static int lmdb_delete (cob_file_api *, cob_file *); -static int lmdb_rewrite (cob_file_api *, cob_file *, const int); -static int lmdb_file_delete (cob_file_api *, cob_file *, char *filename); -static void cob_lmdb_exit_fileio (cob_file_api *a); -static int cob_lmdb_fork (cob_file_api *a); -static int ix_lmdb_file_unlock(cob_file_api *, cob_file *); -void cob_lmdb_init_fileio (cob_file_api *a); - -static int ix_lmdb_dummy () { return 0; } - -static const struct cob_fileio_funcs lmdb_funcs = { - lmdb_open, - lmdb_close, - lmdb_start, - lmdb_read, - lmdb_read_next, - lmdb_write, - lmdb_rewrite, - lmdb_delete, - lmdb_file_delete, - cob_lmdb_init_fileio, - cob_lmdb_exit_fileio, - cob_lmdb_fork, - ix_lmdb_dummy, - ix_lmdb_dummy, - ix_lmdb_dummy, - ix_lmdb_file_unlock -}; - -static char *db_buff = NULL; -static const char **db_data_dir = NULL; - -#define INTTYPES_H_MISSING -#include -#ifndef _WIN32 /* correct would be a check for HAVE_SYS_FILE_H */ -#include -#include -#endif - -#include -#define MDB_MAX_MAP_INC 1073741824 - -#define WARN(format, ...) { \ - cob_runtime_warning("%s:%d: " format "\n", \ - __FILE__, __LINE__, ## __VA_ARGS__); \ -} - -/* Create a cursor handle. */ -static int -lmdb_cursor_open (int line, MDB_txn *txn, MDB_dbi dbi, MDB_cursor **cursor) -{ - int sts; - sts = mdb_cursor_open(txn, dbi, cursor); - DEBUG_LOG("flmdb", ("%d: mdb_cursor_open(%p, %d, %p) -> %d\n", line, txn, dbi, cursor, sts)); - return sts; -} -#define mdb_cursor_open(txn, dbi, cursor) \ - lmdb_cursor_open(__LINE__, (txn) , (dbi) , (cursor) ) - -/* Close a cursor handle. */ -static void -lmdb_cursor_close (int line, MDB_cursor *cursor) -{ - DEBUG_LOG("flmdb", ("%d: mdb_cursor_close(%p)\n", line, cursor)); - mdb_cursor_close (cursor); -} -#define mdb_cursor_close(cursor) \ - lmdb_cursor_close (__LINE__, (cursor)); - -/* Retrieve by cursor. */ -static int -lmdb_cursor_get (int line, MDB_cursor *cursor, MDB_val *key, MDB_val *data, MDB_cursor_op op) -{ - int sts; - sts = mdb_cursor_get(cursor, key, data, op); - DEBUG_LOG("flmdb", ("%d: mdb_cursor_get(%p, %p, %p, %d) -> %d\n", line, cursor, key, data, op, sts)); - return sts; -} -#define mdb_cursor_get(cursor, key, data, op) \ - lmdb_cursor_get(__LINE__, (cursor) , (key) , (data) , (op) ) - -/* Store by cursor. */ -static int -lmdb_cursor_put (int line, MDB_cursor *cursor, MDB_val *key, MDB_val *data, unsigned int flags) -{ - int sts; - sts = mdb_cursor_put(cursor, key, data, flags); - DEBUG_LOG("flmdb", ("%d: mdb_cursor_put(%p, %p, %p, %u) -> %d\n", line, cursor, key, data, flags, sts)); - return sts; -} -#define mdb_cursor_put(cursor, key, data, flags) \ - lmdb_cursor_put (__LINE__, (cursor), (key), (data), (flags)) - -/* Delete current key/data pair. */ -static int -lmdb_cursor_del (int line, MDB_cursor *cursor, unsigned int flags) -{ - int sts; - sts = mdb_cursor_del(cursor, flags); - DEBUG_LOG("flmdb", ("%d: mdb_cursor_del(%p, %u) -> %d\n", line, cursor, flags, sts)); - return sts; -} -#define mdb_cursor_del(cursor, flags) \ - lmdb_cursor_del(__LINE__, (cursor), (flags)) - -/* Open a database in the environment. */ -static int -lmdb_dbi_open (int line, MDB_txn *txn, const char *name, unsigned int flags, MDB_dbi *dbi) -{ - int sts; - sts = mdb_dbi_open( (txn), (name), (flags), (dbi) ); - DEBUG_LOG("flmdb",("%d: mdb_dbi_open(%p, %s, %u, %p) -> %d\n", line, txn, name, flags, dbi, sts )); - return sts; -} -#define mdb_dbi_open(txn, name, flags, dbi) \ - lmdb_dbi_open(__LINE__, (txn), (name), (flags), (dbi) ) - -/* Close a database handle. Normally unnecessary. */ -static void -lmdb_dbi_close (int line, MDB_env *env, MDB_dbi dbi) -{ - DEBUG_LOG("flmdb",("%d: mdb_dbi_close(%p, %d)\n", line, (env), (dbi))); - mdb_dbi_close( (env), (dbi) ); -} -#define mdb_dbi_close(env, dbi) \ - lmdb_dbi_close(__LINE__, (env), (dbi) ) - -/* Get items from a database. */ -static int -lmdb_get (int line, MDB_txn *txn, MDB_dbi dbi, MDB_val *key, MDB_val *data) -{ - int sts; - sts = mdb_get( (txn), (dbi), (key), (data) ); - DEBUG_LOG("flmdb",("%d: mdb_get(%p, %d, %p, %p) -> %d\n", line, txn, dbi, key, data, sts )); - return sts; -} -#define mdb_get(txn, dbi, key, data) \ - lmdb_get(__LINE__, (txn), (dbi), (key), (data) ) - -/* Abandon all the operations of the transaction. */ -static void -lmdb_txn_abort (int line, MDB_txn *txn) -{ - DEBUG_LOG("flmdb",("%d: mdb_txn_abort(%p)\n", line, txn)); - mdb_txn_abort(txn); -} -#define mdb_txn_abort(txn) \ - lmdb_txn_abort(__LINE__, (txn)) - -/* Create a transaction for use with the environment. */ -static int -lmdb_txn_begin (int line, MDB_env *env, MDB_txn *parent, unsigned int flags, MDB_txn **txn) -{ - int sts; - sts = mdb_txn_begin( env, parent, flags, txn); - DEBUG_LOG("flmdb",("%d: mdb_txn_begin(%p, %p, %u, %p) -> %d\n", line, env, parent, flags, txn, sts)); - return sts; -} -#define mdb_txn_begin(env, parent, flags, txn) \ - lmdb_txn_begin(__LINE__, (env), (parent), (flags), (txn) ) - -/* Commit all the operations of a transaction into the database. */ -static int -lmdb_txn_commit (int line, MDB_txn *txn) -{ - int sts; - sts = mdb_txn_commit(txn); - DEBUG_LOG("flmdb",("%d: mdb_txn_commit(%p) -> %d\n", line, txn, sts)); - return sts; -} -#define mdb_txn_commit(txn) \ - lmdb_txn_commit(__LINE__, (txn)) - -#if 0 /* Currently unused */ -/* Renew a cursor handle. */ -static int -lmdb_cursor_renew (int line, MDB_txn *txn, MDB_cursor *cursor) -{ - DEBUG_LOG("flmdb",( "%d: mdb_cursor_renew(%p, %p)\n", line, txn, cursor) ; - return mdb_cursor_renew (txn, cursor); -} -#define mdb_cursor_renew(txn, cursor) \ - lmdb_cursor_renew (__LINE__, (txn) , (cursor) ); - -/* Store items into a database. */ -static int -lmdb_put (int line, MDB_txn *txn, MDB_dbi dbi, MDB_val *key, MDB_val *data, unsigned int flags) -{ - DEBUG_LOG("flmdb",("%d: mdb_put(%p, %d, %p, %p, %u)\n", line, txn, dbi, key, data, flags)); - return mdb_put(txn, dbi, key, data, flags); -} -#define mdb_put(txn, dbi, key, data, flags) \ - lmdb_put(__LINE__, (txn), (dbi), (key), (data), (flags) ) - -/* Renew a read-only transaction. */ -static int -lmdb_txn_renew (int line, MDB_txn *txn) { - DEBUG_LOG("flmdb",("%d: mdb_txn_renew(%p)\n", line, txn)); - return mdb_txn_renew(txn); -} -#define mdb_txn_renew(txn) \ - lmdb_txn_renew(__LINE__, (txn)) - -/* Reset a read-only transaction. */ -static void -lmdb_txn_reset (int line, MDB_txn *txn) { - DEBUG_LOG("flmdb",("%d: mdb_txn_reset(%p)\n", line, txn); - mdb_txn_reset(txn); -} -#define mdb_txn_reset(txn) \ - lmdb_txn_reset( __LINE__, (txn)) -#endif -/* end trace macros */ - -#define cob_dbtsize_t size_t - -struct indexed_file { - MDB_env *db_env; - MDB_dbi **db; /* Database handlers */ - MDB_txn *txn; - MDB_cursor **cursor; - MDB_val key; - MDB_val data; - int fd; - char *filename; /* Needed for record locks */ - unsigned char *last_key; /* The last key written */ - unsigned char *temp_key; /* Used for temporary storage */ - unsigned char **last_readkey; /* The last key read */ - cob_u32_t *last_dupno; /* The last number of duplicates read */ - cob_u32_t *rewrite_sec_key; - int maxkeylen; - int primekeylen; - unsigned char* savekey; /* Work area for saving key value */ - unsigned char* suppkey; /* Work area for saving key value */ - unsigned char* saverec; /* For saving copy of record */ - size_t key_index; - cob_u32_t write_cursor_open; - cob_u32_t record_locked; - cob_u32_t filenamelen; - cob_u32_t db_flags; - cob_u32_t txn_flags; - cob_u32_t env_flags; - struct flock lock; -}; - -/* Local functions */ - -static int cob_lmdb_fork (cob_file_api *a) -{ - COB_UNUSED(a); - return 0; -} - -static int ix_lmdb_file_unlock (cob_file_api *a, cob_file *f) -{ - COB_UNUSED(a); - COB_UNUSED(f); - return 0; -} - -/* Is given key data all SUPPRESS char, - returns 1 if key has all SUPPRESS char */ -static int -db_suppresskey (cob_file *f, int idx) -{ - unsigned char ch_sprs; - int i,len; - struct indexed_file *p; - - if (!f->keys[idx].tf_suppress) { - return 0; - } - ch_sprs = f->keys[idx].char_suppress & 0xFF; - p = f->file; - len = db_savekey(f, p->suppkey, f->record->data, idx); - for (i = 0; i < len; i++) { - if (p->suppkey[i] != ch_sprs) - return 0; - } - return 1; -} - -static void -db_setkey (cob_file *f, int idx) -{ - struct indexed_file *p = f->file; - int len; - - memset (p->savekey, 0, p->maxkeylen); - len = db_savekey (f, p->savekey, f->record->data, idx); - - p->key.mv_data = p->savekey; - p->key.mv_size = len; -} - -static int -db_nofile (const char *filename) -{ - if ((access(filename,(F_OK | R_OK | W_OK)) != 0)) { - if (errno == ENOENT) { - return 1; - } - } - return 0; -} - -/* check for local file, returns 1 if "yes" (unimplemented for WIN32) */ -static int -local_file( dev_t device, char **pname /*output*/ ) -{ - int n, maj, min, nblock; - char *s; - static char line[128]; - static char devname[128]; - static const char filename[] = "/proc/partitions"; - FILE *file; - -#ifdef _WIN32 - /* TODO: Come back for Win32? */ - return 1; -#endif - - /* TODO: this variable should be moved to common.c as binary config */ - if (getenv ("MDB_NO_LOCAL_FS_CHK") != NULL) { - return 1; - } - - if( (file = fopen(filename, "r")) == NULL ) { - WARN("could not open %s", filename); - /* TODO: Come back here, /proc/partitions may not be accesible */ - return 1; - } - - - while( (s = fgets(line, sizeof(line), file)) != NULL ) { - if( (n = sscanf(line, "%d%d%d%s", &maj, &min, &nblock, devname)) == EOF ) { - continue; - } - if( n == 4 ) { - if( maj == major(device) && min == minor(device) ) { - *pname = devname; - return 1; - } - } - } - - return 0; -} - - -/* INDEXED */ - -/* Get the next number in a set of duplicates */ -static unsigned int -get_dupno (cob_file *f, const cob_u32_t i) -{ - struct indexed_file *p = f->file; - int ret; - cob_u32_t dupno = 0; - - /* Using a nested transaction so we don't mess up the write transacion in lmdb_write */ - MDB_txn *txn; - MDB_cursor *cursor; - txn = cob_malloc(sizeof(MDB_txn *)); - cursor = cob_malloc(sizeof(MDB_cursor *)); - - db_setkey(f, i); - memcpy (p->temp_key, p->key.mv_data, (size_t)p->maxkeylen); - mdb_txn_begin(p->db_env, p->txn , 0, &txn); - mdb_cursor_open(txn, *p->db[i], &cursor); - ret = mdb_cursor_get(cursor,&p->key,&p->data,MDB_SET_RANGE); - while (ret == 0 && memcmp(p->key.mv_data, p->temp_key, (size_t)p->key.mv_size) == 0) { - memcpy(&dupno,(cob_u8_ptr)p->data.mv_data + p->primekeylen, sizeof(unsigned int)); - ret = mdb_cursor_get(cursor,&p->key,&p->data,MDB_NEXT); - } - mdb_cursor_close(cursor); - mdb_txn_commit(txn); - return ++dupno; -} - -/* read file with all alternate keys that don't allow duplicates - to check if records exist already, returns 1 if true */ -static int -check_alt_keys (cob_file *f, const int rewrite) -{ - struct indexed_file *p = f->file; - int i; - - /* Transaction is inherited from caller */ - for (i = 1; i < f->nkeys; ++i) { - if (!f->keys[i].tf_duplicates) { - int ret; - db_setkey(f, i); - ret = mdb_get(p->txn,*p->db[i],&p->key,&p->data); - if (ret == 0) { - if (rewrite) { - if (db_cmpkey(f, p->data.mv_data, f->record->data, 0, 0)) { - return 1; - } - } else { - return 1; - } - } - } - } - return 0; -} - -static int -mdb_cob_status( int mdb_error ) -{ - switch (mdb_error) { - case MDB_KEYEXIST: - return COB_STATUS_22_KEY_EXISTS; - case MDB_NOTFOUND: - return COB_STATUS_23_KEY_NOT_EXISTS; - case EACCES: - return COB_STATUS_37_PERMISSION_DENIED; - - case MDB_BAD_DBI: - case MDB_BAD_RSLOT: - case MDB_BAD_TXN: - case MDB_BAD_VALSIZE: - case MDB_CORRUPTED: - case MDB_CURSOR_FULL: - case MDB_DBS_FULL: - case MDB_INCOMPATIBLE: - case MDB_INVALID: - case MDB_MAP_FULL: - case MDB_MAP_RESIZED: - case MDB_PAGE_FULL: - case MDB_PAGE_NOTFOUND: - case MDB_PANIC: - case MDB_READERS_FULL: - case MDB_TLS_FULL: - case MDB_TXN_FULL: - case MDB_VERSION_MISMATCH: - /* fall through */ - default: - WARN("%s", mdb_strerror(mdb_error)); - } - return COB_STATUS_30_PERMANENT_ERROR; -} - -static int -lmdb_write_internal (cob_file *f, const int rewrite, const int opt, unsigned int ds) -{ - struct indexed_file *p = f->file; - cob_u32_t i, len; - cob_u32_t dupno; - cob_u32_t flags; - int ret = COB_STATUS_00_SUCCESS; - - COB_UNUSED(opt); - - if ((ret = mdb_txn_begin(p->db_env, NULL, p->txn_flags, &p->txn)) != MDB_SUCCESS) { - return ret; - } - - if ((ret = mdb_cursor_open(p->txn, *p->db[0], &p->cursor[0])) != MDB_SUCCESS) { - mdb_txn_abort(p->txn); - return ret; - } - - /* Cursors. */ - for (i = 1; i < f->nkeys; i++) { - if ((ret = mdb_cursor_open(p->txn, *p->db[i], &p->cursor[i])) != MDB_SUCCESS) { - mdb_txn_abort(p->txn); - return ret; - } - } - - /* Check duplicate alternate keys */ - if (f->nkeys > 1 && !rewrite) { - if (check_alt_keys (f, 0)) { - mdb_txn_abort(p->txn); - return MDB_KEYEXIST; - } - db_setkey(f, 0); - } - - /* Position write cursor */ - if (rewrite) { - if ((ret = mdb_cursor_get(p->cursor[0],&p->key, &p->data, MDB_SET)) == MDB_SUCCESS) { - mdb_txn_abort(p->txn); - return MDB_KEYEXIST; - } - } - - p->data.mv_data = f->record->data; - p->data.mv_size = (size_t) f->record->size; - - flags = (rewrite) ? 0 : MDB_NOOVERWRITE; - if ((ret = mdb_cursor_put(p->cursor[0], &p->key, &p->data, flags)) != MDB_SUCCESS) { - mdb_txn_abort(p->txn); - return ret; - } - - if (f->nkeys == 1) { - return mdb_txn_commit(p->txn); - } - - /* Write secondary keys */ - p->data = p->key; - for (i = 1; i < f->nkeys; ++i) { - if (rewrite && ! p->rewrite_sec_key[i]) { - continue; - } - if (db_suppresskey(f, i)) { - continue; - } - /* Set the key of the secondary key */ - db_setkey(f, i); - if (f->keys[i].tf_duplicates) { - flags = 0; - dupno = get_dupno(f, i); - if (dupno > 1) { - ret = COB_STATUS_02_SUCCESS_DUPLICATE; - } - len = db_savekey(f, p->temp_key, f->record->data, 0); - p->data.mv_data = p->temp_key; - p->data.mv_size = len; - memcpy (((char *)(p->data.mv_data)) + p->data.mv_size, &dupno, sizeof (unsigned int)); - p->data.mv_size += sizeof(unsigned int); - } else { - len = db_savekey(f, p->temp_key, f->record->data, 0); - p->data.mv_data = p->temp_key; - p->data.mv_size = len; - flags = MDB_NOOVERWRITE; - dupno = 0; - } - db_setkey (f, i); - - if ((ret = mdb_cursor_put(p->cursor[i],&p->key,&p->data,flags)) != MDB_SUCCESS) { - mdb_txn_commit(p->txn); - return ret; - } - } - - if ((ret = mdb_txn_commit(p->txn)) == MDB_SUCCESS) { - if (f->keys[i].tf_duplicates) { - ds = COB_STATUS_02_SUCCESS_DUPLICATE; - } - } - - return ret; -} - -static int -lmdb_start_internal (cob_file *f, const int cond, cob_field *key, - const int read_opts, const int test_lock) -{ - struct indexed_file *p = f->file; - int len, fullkeylen, partlen; - int ret = 0; - int rc = 0; - cob_u32_t dupno = 0; - int key_index; - - COB_UNUSED (read_opts); - COB_UNUSED (test_lock); - - /* Look up for the key */ - key_index = db_findkey(f, key, &fullkeylen, &partlen); - if (key_index < 0) { - return COB_STATUS_23_KEY_NOT_EXISTS; - } - p->key_index = (unsigned int)key_index; - - /* Set the key to search */ - db_setkey (f, p->key_index); - p->key.mv_size = partlen; - - /* Start the transaction */ - if ((ret = mdb_txn_begin(p->db_env, NULL, p->txn_flags, &p->txn)) != MDB_SUCCESS) { - return mdb_cob_status(ret); - } - - /* Open a cursor for an alternate key */ - if (p->key_index !=0) { - if ((ret = mdb_cursor_open(p->txn, *p->db[0], &p->cursor[0])) != MDB_SUCCESS) { - mdb_txn_abort(p->txn); - return mdb_cob_status(ret); - } - } - - /* Create a cursor */ - if ((ret = mdb_cursor_open(p->txn,*p->db[p->key_index], &p->cursor[p->key_index])) != MDB_SUCCESS) { - return mdb_cob_status(ret); - } - - if (cond == COB_FI) { - ret = mdb_cursor_get(p->cursor[p->key_index], &p->key, &p->data, MDB_FIRST); - } else if (cond == COB_LA) { - ret = mdb_cursor_get(p->cursor[p->key_index], &p->key, &p->data, MDB_LAST); - } else { - ret = mdb_cursor_get(p->cursor[p->key_index], &p->key, &p->data, MDB_SET_RANGE); - } - - switch (cond) { - case COB_EQ: - if (ret == MDB_SUCCESS) { - ret = db_cmpkey (f, p->key.mv_data, f->record->data, p->key_index, partlen); - } - break; - case COB_LT: - if (ret != MDB_SUCCESS) { - ret = mdb_cursor_get(p->cursor[p->key_index], &p->key, &p->data, MDB_LAST); - } else { - ret = mdb_cursor_get(p->cursor[p->key_index], &p->key, &p->data, MDB_PREV); - } - break; - case COB_LE: - if (ret != MDB_SUCCESS) { - ret = mdb_cursor_get(p->cursor[p->key_index], &p->key, &p->data, MDB_LAST); - } else if (db_cmpkey(f, p->key.mv_data, f->record->data, p->key_index, partlen) !=0) { - ret = mdb_cursor_get(p->cursor[p->key_index], &p->key, &p->data, MDB_PREV); - } else if (f->keys[p->key_index].tf_ascending == COB_ASCENDING) { - ret = mdb_cursor_get(p->cursor[p->key_index], &p->key, &p->data, MDB_NEXT_NODUP); - if (ret != MDB_SUCCESS) { - ret = mdb_cursor_get(p->cursor[p->key_index], &p->key, &p->data, MDB_LAST); - } else { - ret = mdb_cursor_get(p->cursor[p->key_index], &p->key, &p->data, MDB_PREV); - } - } - break; - case COB_GT: - while (ret == MDB_SUCCESS && db_cmpkey (f, p->key.mv_data, f->record->data, p->key_index, partlen) == MDB_SUCCESS) { - ret = mdb_cursor_get(p->cursor[p->key_index], &p->key, &p->data, MDB_NEXT); - } - break; - case COB_GE: - /* nothing */ - break; - case COB_FI: - /* nothing */ - break; - case COB_LA: - /* nothing */ - break; - } - - if (ret == MDB_SUCCESS && p->key_index > 0) { - /* Temporarily save alternate key */ - len = p->key.mv_size; - memcpy(p->temp_key, p->key.mv_data, len); - if (f->keys[p->key_index].tf_duplicates) { - memcpy(&dupno, (cob_u8_ptr)p->data.mv_data + p->primekeylen, sizeof(unsigned int)); - } - p->key.mv_data = p->data.mv_data; - p->key.mv_size = p->primekeylen; - ret = mdb_get(p->txn,*p->db[0],&p->key,&p->data); - } - -#if 0 /* TODO: Come back to lock test */ - if (ret == 0 && test_lock) { - - } -#endif - - if (ret == MDB_SUCCESS) { - if (p->key_index == 0) { - memcpy (p->last_readkey[0], p->key.mv_data, p->primekeylen); - } else { - memcpy (p->last_readkey[p->key_index], - p->temp_key, db_keylen(f, p->key_index)); - memcpy (p->last_readkey[p->key_index + f->nkeys], p->key.mv_data, p->primekeylen); - if (f->keys[p->key_index].tf_duplicates) { - p->last_dupno[p->key_index] = dupno; - } - } - } - - mdb_cursor_close(p->cursor[p->key_index]); - if ((rc = mdb_txn_commit(p->txn)) != MDB_SUCCESS) { - return mdb_cob_status(rc); - } - return (ret == MDB_SUCCESS) ? COB_STATUS_00_SUCCESS : COB_STATUS_23_KEY_NOT_EXISTS; - -} - -static int -lmdb_delete_internal (cob_file *f, const int rewrite) -{ - struct indexed_file *p = f->file; - size_t i, len; - MDB_val prim_key; - int ret; - cob_u32_t flags; - COB_UNUSED(flags); - - flags = 0; - if ((ret = mdb_txn_begin(p->db_env, NULL, p->txn_flags, &p->txn)) != MDB_SUCCESS) { - return mdb_cob_status(ret); - } - - if ((ret = mdb_cursor_open(p->txn, *p->db[0], &p->cursor[0])) != MDB_SUCCESS) { - return mdb_cob_status(ret); - } - -#if 0 /* TODO: Come back and implement locking */ - if (p->db_env != NULL) { - unlock_record (f); - } -#endif - - /* Find the primary key */ - if (f->access_mode != COB_ACCESS_SEQUENTIAL) { - db_setkey(f, 0); - } - - if ((ret = mdb_cursor_get(p->cursor[0],&p->key,&p->data,MDB_SET)) != MDB_SUCCESS) { - if (f->access_mode != COB_ACCESS_SEQUENTIAL) { - mdb_txn_abort(p->txn); - } - return mdb_cob_status(ret); - } - -#if 0 /* TODO: Come back and implement locking */ - if (p->db_env != NULL) { - ret = test_record_lock (f, p->key.data, p->key.size); - if (ret) { - if (close_cursor) { - p->cursor[0]->c_close (p->cursor[0]); - p->cursor[0] = NULL; - p->write_cursor_open = 0; - } - return COB_STATUS_51_RECORD_LOCKED; - } - } -#endif - prim_key = p->key; - memcpy(p->saverec, p->data.mv_data, p->data.mv_size); /* Save old record image */ - memcpy(p->temp_key, prim_key.mv_data, prim_key.mv_size); /* Save primary key value */ - prim_key.mv_data = p->temp_key; - - /* Delete the secondary keys */ - for (i = 1; i < f->nkeys; ++i) { - len = db_savekey(f, p->suppkey, p->data.mv_data, i); - memset(p->savekey, 0, p->maxkeylen); - len = db_savekey(f, p->savekey, p->saverec, i); - p->key.mv_data = p->savekey; - p->key.mv_size = (size_t) len; - p->key.mv_data = (char *)p->key.mv_data; - /* rewrite: no delete if secondary key is unchanged */ - if (rewrite) { - p->rewrite_sec_key[i] = db_cmpkey (f, p->suppkey, f->record->data, i, 0); - if (!p->rewrite_sec_key[i]) { - continue; - } - } - if (!f->keys[i].tf_duplicates) { - if ((ret = mdb_del(p->txn,*p->db[i],&p->key,&p->data)) != MDB_SUCCESS) { - mdb_txn_abort(p->txn); - return mdb_cob_status(ret); - } - } else { - MDB_val sec_key = p->key; - - if (( ret = mdb_cursor_open(p->txn,*p->db[i], &p->cursor[i])) != MDB_SUCCESS) { - mdb_txn_abort(p->txn); - return mdb_cob_status(ret); - } - - if (mdb_cursor_get(p->cursor[i],&p->key,&p->data,MDB_SET_RANGE) == MDB_SUCCESS) { - while (sec_key.mv_size == p->key.mv_size - && memcmp (p->key.mv_data, sec_key.mv_data, (size_t)sec_key.mv_size) == 0) { - if (memcmp (p->data.mv_data, prim_key.mv_data, (size_t)prim_key.mv_size) == 0) { - mdb_cursor_del (p->cursor[i],0); - } - if (mdb_cursor_get(p->cursor[i],&p->key,&p->data,MDB_NEXT) != MDB_SUCCESS) { - break; - } - } - } - mdb_cursor_close(p->cursor[i]); - } - } - - /* Delete the record */ - if ((ret = mdb_cursor_del(p->cursor[0], 0)) != MDB_SUCCESS) { - return mdb_cob_status(ret); - } - - if ((ret = mdb_txn_commit(p->txn)) != MDB_SUCCESS) { - return mdb_cob_status(ret); - } - return COB_STATUS_00_SUCCESS; -} - -static int -mdb_resize_env (MDB_env* e) -{ - MDB_envinfo ei; - mdb_env_info (e, &ei); - return mdb_env_set_mapsize (e, ei.me_mapsize * 2 ); -} - -/* Delete file */ -static int -lmdb_file_delete (cob_file_api *a, cob_file *f, char *filename) -{ - COB_UNUSED(a); - COB_UNUSED (f); - COB_UNUSED (filename); - return COB_STATUS_00_SUCCESS; -} - -/* OPEN INDEXED file */ - -static void -indexed_file_free (struct indexed_file* p) -{ - /* no cleanup yet */ - return; -} - -static int -lmdb_open (cob_file_api *a, cob_file *f, char *filename, const int mode, const int sharing) -{ - /* Note filename points to file_open_name */ - /* cob_chk_file_mapping manipulates file_open_name directly */ - - struct indexed_file *p; - size_t i, j; - size_t maxsize; - char runtime_buffer [COB_FILE_MAX+1]; - int ret = 0; - int nonexistent = 0; - int lock_mode; - - a->chk_file_mapping (f); - - /* TODO: this variable should be moved to common.c as binary config */ - if (getenv("MDB_NO_SHARED_FS_CHK") == NULL) { - struct stat sb; - char *devname; - char dir[ COB_FILE_MAX ]; - int is_local; - - sprintf(dir, "%s", filename); - if ((stat(dirname(dir), &sb) == -1) || (!S_ISDIR(sb.st_mode))) { - return COB_STATUS_30_PERMANENT_ERROR; - } - - is_local = local_file(sb.st_dev, &devname); - if (!is_local) { - cob_runtime_warning("file %s - shared filesystem detected!", filename); - return COB_STATUS_30_PERMANENT_ERROR; - } - } - - if (db_nofile (filename)) { - nonexistent = 1; - if (mode != COB_OPEN_OUTPUT && f->flag_optional == 0) { - return COB_STATUS_35_NOT_EXISTS; - } - } - - p = cob_malloc (sizeof (struct indexed_file)); - - switch (mode) { - case COB_OPEN_INPUT: - p->env_flags |= MDB_RDONLY; - p->txn_flags |= MDB_RDONLY; - break; - case COB_OPEN_OUTPUT: - p->db_flags |= MDB_CREATE; - break; - case COB_OPEN_I_O: - case COB_OPEN_EXTEND: - p->db_flags |= MDB_CREATE; - break; - } - - p->db = cob_malloc(sizeof(MDB_dbi *) * f->nkeys); - p->cursor = cob_malloc(sizeof(MDB_cursor *) * f->nkeys); - p->last_readkey = cob_malloc(sizeof(unsigned char *) * 2 * f->nkeys); - p->last_dupno = cob_malloc(sizeof(unsigned int * ) * 2 * f->nkeys); - p->rewrite_sec_key = cob_malloc(sizeof(int) * f->nkeys); - maxsize = p->primekeylen = db_keylen(f, 0); - for (i = 1; i < f->nkeys; ++i) { - j = db_keylen(f, i); - if (j > maxsize) - maxsize = j; - } - p->maxkeylen = maxsize; - - snprintf (db_buff, (size_t)COB_SMALL_MAX, "%s%c%s",file_setptr->lmdb_home, SLASH_CHAR, filename); - if (mode != COB_OPEN_OUTPUT) { - if (db_nofile(filename) == 0) { - if (a->cob_read_dict (f, db_buff, 0, &ret)) { - return ret ? ret : COB_STATUS_39_CONFLICT_ATTRIBUTE; - } - } else if (a->cob_read_dict (f, filename, 0, &ret)) { - return ret ? ret : COB_STATUS_39_CONFLICT_ATTRIBUTE; - } - } - - if ((ret = mdb_env_create(&p->db_env)) != MDB_SUCCESS) { - indexed_file_free(p); - return mdb_cob_status(ret); - } - - if (f->nkeys > 1) { - if ((ret = mdb_env_set_maxdbs(p->db_env,f->nkeys)) != MDB_SUCCESS ) { - mdb_env_close(p->db_env); - p->db_env = NULL; - indexed_file_free(p); - return mdb_cob_status(ret); - } - } - - if (nonexistent) { - if (f->flag_optional) { - if (mode == COB_OPEN_INPUT) { - f->open_mode = mode; - f->flag_nonexistent = 1; - f->flag_end_of_file = 1; - f->flag_begin_of_file = 1; - return COB_STATUS_05_SUCCESS_OPTIONAL; - } - } - - if ((ret = mkdir(filename, S_IRWXU | S_IRGRP | S_IWGRP | S_IROTH | S_IXOTH)) != 0) { - switch (ret) { - case EACCES: - indexed_file_free(p); - return COB_STATUS_37_PERMISSION_DENIED; - default: - indexed_file_free(p); - return COB_STATUS_30_PERMANENT_ERROR; - } - } - } - - if ((ret = mdb_env_open(p->db_env, filename, p->env_flags, 0770)) != MDB_SUCCESS) { - mdb_env_close(p->db_env); - p->db_env = NULL; - indexed_file_free(p); - return mdb_cob_status(ret); - } - - if (sharing) { - if (mode == COB_OPEN_OUTPUT - || mode == COB_OPEN_EXTEND - || (f->lock_mode & COB_FILE_EXCLUSIVE) - || (mode == COB_OPEN_I_O && !f->lock_mode)) { - lock_mode = F_WRLCK; - } else { - lock_mode = F_RDLCK; - } - - if ((ret = mdb_env_get_fd(p->db_env, &p->fd)) != MDB_SUCCESS) { - mdb_env_close(p->db_env); - p->db_env = NULL; - indexed_file_free(p); - return mdb_cob_status(ret); - } - - memset((void *)&p->lock, 0, sizeof (struct flock)); - p->lock.l_type = lock_mode; - p->lock.l_whence = SEEK_SET; - p->lock.l_start = 0; - p->lock.l_len = 0; - p->lock.l_pid = getpid(); - errno = 0; - int fcd = 0; - fcd = fcntl(p->fd, F_SETLK, &p->lock); - if (fcd < 0) { - ret = errno; - p->fd = -1; - switch (ret) { - case EACCES: - case EAGAIN: - case EDEADLK: - return COB_STATUS_61_FILE_SHARING; - default: - return COB_STATUS_30_PERMANENT_ERROR; - } - } - - } - - if ((ret = mdb_txn_begin(p->db_env, NULL, p->txn_flags, &p->txn)) != MDB_SUCCESS) { - mdb_env_close(p->db_env); - p->db_env = NULL; - indexed_file_free(p); - return mdb_cob_status(ret); - } - - for (i = 0; i < f->nkeys; i++) { - if (i == 0) { - snprintf(runtime_buffer, (size_t)COB_FILE_MAX, "%s", filename); - } else { - snprintf(runtime_buffer, (size_t)COB_FILE_MAX, "%s.%d", filename, (int)i); - } - - p->db[i] = cob_malloc(sizeof(MDB_dbi *)); - if ((ret = mdb_open(p->txn, - (f->nkeys == 1) ? NULL : runtime_buffer, - (p->db_flags|((f->keys[i].tf_duplicates)?(MDB_DUPSORT):0)) , p->db[i])) != MDB_SUCCESS) { - int j; - for (j = 0; j < i; ++j) { - mdb_dbi_close(p->db_env,*p->db[j]); - } - mdb_env_close(p->db_env); - p->db_env = NULL; - indexed_file_free(p); - return mdb_cob_status(ret); - } - p->last_readkey[i] = cob_malloc (maxsize); - p->last_readkey[f->nkeys + i] = cob_malloc (maxsize); - } - - p->temp_key = cob_malloc (maxsize + sizeof (unsigned long)); - p->savekey = cob_malloc (maxsize + sizeof (unsigned long)); - p->suppkey = cob_malloc (maxsize + sizeof (unsigned long)); - p->saverec = cob_malloc (f->record_max + sizeof (unsigned long)); - - f->file = p; - p->key_index = 0; - p->last_key = NULL; - - memset ((void *)&p->key, 0, sizeof (MDB_val)); - memset ((void *)&p->data, 0, sizeof (MDB_val)); - p->filenamelen = strlen(filename); - p->filename = cob_strdup(filename); - p->write_cursor_open = 0; - p->record_locked = 0; - f->open_mode = mode; - - db_setkey (f, 0); - - if ((ret = mdb_cursor_open(p->txn, *p->db[0], &p->cursor[0])) != 0) { - return mdb_cob_status(ret); - } - - if ((ret = mdb_cursor_get(p->cursor[0],&p->key,&p->data,MDB_FIRST)) == MDB_SUCCESS) { - memcpy (p->last_readkey[0], p->key.mv_data, p->key.mv_size); - if (p->data.mv_data != NULL - && p->data.mv_size > 0 - && p->data.mv_size > f->record_max) { - return COB_STATUS_39_CONFLICT_ATTRIBUTE; - } - } else { - p->data.mv_data = NULL; - } - - mdb_cursor_close(p->cursor[0]); - if ((ret = mdb_txn_commit(p->txn)) != MDB_SUCCESS) { - int j; - for (j = 0; j < i; ++j) { - mdb_dbi_close(p->db_env,*p->db[j]); - } - mdb_env_close(p->db_env); - p->db_env = NULL; - indexed_file_free(p); - return mdb_cob_status(ret); - } - - f->open_mode = mode; - if (mode == COB_OPEN_OUTPUT ) { - a->cob_write_dict(f, db_buff); - } - - if (f->flag_optional - && nonexistent - && mode != COB_OPEN_OUTPUT) { - return COB_STATUS_05_SUCCESS_OPTIONAL; - } - - return COB_STATUS_00_SUCCESS; -} - -/* Close the INDEXED file */ - -static int -lmdb_close (cob_file_api *a, cob_file *f, const int opt) -{ - struct indexed_file *p = f->file; - int i; - COB_UNUSED (a); - COB_UNUSED(opt); - - for (i = 0; i < f->nkeys; i++) { - mdb_close(p->db_env, *p->db[i]); - } - mdb_env_close(p->db_env); - p->db_env = NULL; - if (p) cob_free(p); - return COB_STATUS_00_SUCCESS; -} - -/* START INDEXED file with positioning */ - -static int -lmdb_start (cob_file_api *a, cob_file *f, const int cond, cob_field *key) -{ - COB_UNUSED (a); - return lmdb_start_internal (f, cond, key, 0, 0); -} - -/* Random READ of the INDEXED file */ - -static int -lmdb_read (cob_file_api *a, cob_file *f, cob_field *key, const int read_opts) -{ - struct indexed_file *p; - int ret; - int db_opts; - int test_lock = 0; - - COB_UNUSED (a); - p = f->file; - db_opts = read_opts; - - if ((ret = lmdb_start_internal (f, COB_EQ, key, db_opts, test_lock)) != COB_STATUS_00_SUCCESS) { - return ret; - } - - f->record->size = p->data.mv_size; - if (f->record->size > f->record_max) { - f->record->size = f->record_max; - ret = COB_STATUS_43_READ_NOT_DONE; - } else { - ret = COB_STATUS_00_SUCCESS; - } - memcpy (f->record->data, p->data.mv_data, f->record->size); - - return ret; -} - -/* Sequential READ of the INDEXED file */ - -static int -lmdb_read_next (cob_file_api *a, cob_file *f, const int read_opts) -{ - struct indexed_file *p = f->file; - int ret; - int read_nextprev; - cob_u32_t nextprev; - int file_changed; - cob_u32_t dupno = 0; - COB_UNUSED (a); - - nextprev = MDB_NEXT; - file_changed = 0; - -#if 0 /* TODO: Come back and implement locking. */ - if (db_env != NULL) { - if (f->open_mode != COB_OPEN_I_O || - (f->lock_mode & COB_FILE_EXCLUSIVE)) { - db_opts &= ~COB_READ_LOCK; - } else if ((f->lock_mode & COB_LOCK_AUTOMATIC) && - !(db_opts & COB_READ_NO_LOCK)) { - db_opts |= COB_READ_LOCK; - } - unlock_record (f); - } else { - db_opts &= ~COB_READ_LOCK; - } -#endif - - if (unlikely (read_opts & COB_READ_PREVIOUS)) { - if (f->flag_end_of_file) { - nextprev = MDB_LAST; - } else { - nextprev = MDB_PREV; - } - } else if (f->flag_begin_of_file) { - nextprev = MDB_FIRST; - } - - if ((ret = mdb_txn_begin(p->db_env, NULL, MDB_RDONLY, &p->txn)) != MDB_SUCCESS) { - return mdb_cob_status(ret); - } - - /* The open cursor makes this function atomic */ - if (p->key_index != 0) { - if ((ret = mdb_cursor_open(p->txn, *p->db[0], &p->cursor[0])) != MDB_SUCCESS) { - return mdb_cob_status(ret); - } - } - - if ((ret = mdb_cursor_open(p->txn, *p->db[p->key_index], &p->cursor[p->key_index])) != MDB_SUCCESS) { - return mdb_cob_status(ret); - } - - if (f->flag_first_read) { - /* Data is read in lmdb_open or lmdb_start */ - if (p->data.mv_data == NULL || (f->flag_first_read == 2 && - nextprev == MDB_PREV)) { - mdb_cursor_close(p->cursor[p->key_index]); - if (p->key_index != 0) { - mdb_cursor_close(p->cursor[0]); - } - mdb_txn_abort(p->txn); - return COB_STATUS_10_END_OF_FILE; - } - - /* Check if previously read data still exists */ - p->key.mv_size = (size_t) db_keylen(f,p->key_index); - p->key.mv_data = p->last_readkey[p->key_index]; - - ret = mdb_cursor_get(p->cursor[p->key_index],&p->key,&p->data,MDB_SET); - if (!ret && p->key_index > 0) { - if (f->keys[p->key_index].tf_duplicates) { - memcpy (&dupno, (cob_u8_ptr)p->data.mv_data + p->primekeylen, sizeof(unsigned int)); - while (ret == 0 - && memcmp (p->key.mv_data, p->last_readkey[p->key_index], (size_t)p->key.mv_size) == 0 - && dupno < p->last_dupno[p->key_index]) { - ret = mdb_cursor_get(p->cursor[p->key_index],&p->key,&p->data,MDB_NEXT); - memcpy (&dupno, (cob_u8_ptr)p->data.mv_data + p->primekeylen, sizeof(unsigned int)); - } - if (ret == 0 - && memcmp (p->key.mv_data, p->last_readkey[p->key_index], (size_t)p->key.mv_size) == 0 - && dupno == p->last_dupno[p->key_index]) { - ret = memcmp (p->last_readkey[p->key_index + f->nkeys], p->data.mv_data, p->primekeylen); - } else { - ret = 1; - } - } else { - ret = memcmp (p->last_readkey[p->key_index + f->nkeys], p->data.mv_data, p->primekeylen); - } - if (!ret) { - p->key.mv_size = (size_t) p->primekeylen; - p->key.mv_data = p->last_readkey[p->key_index + f->nkeys]; - ret = mdb_get(p->txn,*p->db[0],&p->key,&p->data); - } - } - file_changed = ret; - -#if 0 /* TODO: Come back and implement locking. */ - if (db_env != NULL && !file_changed) { - if (!(db_opts & COB_READ_IGNORE_LOCK)) { - ret = test_record_lock (f, p->key.mv_data, p->key.mv_size); - if (ret) { - mdb_cursor_close(p->cursor[p->key_index]) - if (p->key_index != 0) { - mdb_cursor_close(p->cursor[0]); - } - return COB_STATUS_51_RECORD_LOCKED; - } - } - if (db_opts & COB_READ_LOCK) { - ret = lock_record (f, p->key.mv_data, p->key.mv_size); - if (ret) { - mdb_cursor_close(p->cursor[p->key_index]) - if (p->key_index != 0) { - mdb_cursor_close(p->cursor[0]); - } - return COB_STATUS_51_RECORD_LOCKED; - } - } - } -#endif - } - - if (!f->flag_first_read || file_changed) { - if (nextprev == MDB_FIRST || nextprev == MDB_LAST) { - read_nextprev = 1; - } else { - p->key.mv_size = (size_t) db_keylen(f,p->key_index); - p->key.mv_data = p->last_readkey[p->key_index]; - ret = mdb_cursor_get(p->cursor[p->key_index],&p->key,&p->data,MDB_SET_RANGE); - /* ret != 0 possible, records may be deleted since last read */ - if (ret != 0) { - if (nextprev == MDB_PREV) { - nextprev = MDB_LAST; - read_nextprev = 1; - } else { - mdb_cursor_close(p->cursor[p->key_index]); - if (p->key_index != 0) { - mdb_cursor_close(p->cursor[0]); - } - mdb_txn_commit(p->txn); - return COB_STATUS_10_END_OF_FILE; - } - } else { - if (memcmp (p->key.mv_data, p->last_readkey[p->key_index], (size_t)p->key.mv_size) == 0) { - if (p->key_index > 0 && f->keys[p->key_index].tf_duplicates) { - memcpy (&dupno, (cob_u8_ptr)p->data.mv_data + p->primekeylen, sizeof(unsigned int)); - while (ret == 0 && - memcmp (p->key.mv_data, p->last_readkey[p->key_index], (size_t)p->key.mv_size) == 0 && - dupno < p->last_dupno[p->key_index]) { - ret = mdb_cursor_get(p->cursor[p->key_index],&p->key,&p->data,MDB_NEXT); - memcpy (&dupno, (cob_u8_ptr)p->data.mv_data + f->keys[0].field->size, sizeof(unsigned int)); - } - if (ret != 0) { - if (nextprev == MDB_PREV) { - nextprev = MDB_LAST; - read_nextprev = 1; - } else { - mdb_cursor_close(p->cursor[p->key_index]); - if (p->key_index != 0) { - mdb_cursor_close(p->cursor[0]); - } - mdb_txn_commit(p->txn); - return COB_STATUS_10_END_OF_FILE; - } - } else { - if (memcmp (p->key.mv_data, p->last_readkey[p->key_index], (size_t)p->key.mv_size) == 0 && - dupno == p->last_dupno[p->key_index]) { - read_nextprev = 1; - } else { - if (nextprev == MDB_PREV) { - read_nextprev = 1; - } else { - read_nextprev = 0; - } - } - } - } else { - read_nextprev = 1; - } - } else { - if (nextprev == MDB_PREV) { - read_nextprev = 1; - } else { - read_nextprev = 0; - } - } - } - } - - if (read_nextprev) { - ret = mdb_cursor_get(p->cursor[p->key_index],&p->key,&p->data,nextprev); - if (ret != 0) { - mdb_cursor_close(p->cursor[p->key_index]); - if (p->key_index != 0) { - mdb_cursor_close(p->cursor[0]); - } - mdb_txn_commit(p->txn); - return COB_STATUS_10_END_OF_FILE; - } - } - - if (p->key_index > 0) { - /* Temporarily save alternate key */ - memcpy (p->temp_key, p->key.mv_data, (size_t)p->key.mv_size); - if (f->keys[p->key_index].tf_duplicates) { - memcpy (&dupno, (cob_u8_ptr)p->data.mv_data + p->primekeylen, sizeof(unsigned int)); - } - p->key.mv_data = p->data.mv_data; - p->key.mv_size = p->primekeylen; - if (mdb_get(p->txn,*p->db[0],&p->key,&p->data) != 0) { - mdb_cursor_close(p->cursor[p->key_index]); - if (p->key_index != 0) { - mdb_cursor_close(p->cursor[0]); - } - mdb_txn_commit(p->txn); - return COB_STATUS_23_KEY_NOT_EXISTS; - } - } - -#if 0 /* TODO: Come back and implement locking */ - if (db_env != NULL) { - if (!(db_opts & COB_READ_IGNORE_LOCK)) { - ret = test_record_lock (f, p->key.mv_data, p->key.mv_size); - if (ret) { - p->cursor[p->key_index]->c_close (p->cursor[p->key_index]); - p->cursor[p->key_index] = NULL; - if (p->key_index != 0) { - p->cursor[0]->c_close (p->cursor[0]); - p->cursor[0] = NULL; - } - return COB_STATUS_51_RECORD_LOCKED; - } - } - if (db_opts & COB_READ_LOCK) { - ret = lock_record (f, p->key.mv_data, p->key.mv_size); - if (ret) { - mdb_cursor_close(p->cursor[p->key_index]) - if (p->key_index != 0) { - mdb_cursor_close(p->cursor[0]); - } - return COB_STATUS_51_RECORD_LOCKED; - } - } - } -#endif - - if (p->key_index == 0) { - memcpy (p->last_readkey[0], p->key.mv_data, (size_t)p->key.mv_size); - } else { - memcpy (p->last_readkey[p->key_index], p->temp_key, - db_keylen(f, p->key_index)); - memcpy (p->last_readkey[p->key_index + f->nkeys], p->key.mv_data, p->primekeylen); - if (f->keys[p->key_index].tf_duplicates) { - p->last_dupno[p->key_index] = dupno; - } - } - } - - mdb_cursor_close(p->cursor[p->key_index]); - if (p->key_index != 0) { - mdb_cursor_close(p->cursor[0]); - } - mdb_txn_commit(p->txn); - - f->record->size = p->data.mv_size; - if (f->record->size > f->record_max) { - f->record->size = f->record_max; - ret = COB_STATUS_43_READ_NOT_DONE; - } else { - ret = COB_STATUS_00_SUCCESS; - } - memcpy (f->record->data, p->data.mv_data, f->record->size); - - return ret; -} - -/* WRITE to the INDEXED file */ - -static int -lmdb_write (cob_file_api *a, cob_file *f, const int opt) -{ - struct indexed_file *p; - int rc = 0; - unsigned int cs = COB_STATUS_00_SUCCESS; - - COB_UNUSED (a); - if (f->flag_nonexistent) { - return COB_STATUS_48_OUTPUT_DENIED; - } - p = f->file; - - /* Check record key */ - db_setkey (f, 0); - if (!p->last_key) { - p->last_key = cob_malloc ((size_t)p->maxkeylen); - } else if (f->access_mode == COB_ACCESS_SEQUENTIAL && - memcmp (p->last_key, p->key.mv_data, (size_t)p->key.mv_size) > 0) { - return COB_STATUS_21_KEY_INVALID; - } - memcpy (p->last_key, p->key.mv_data, (size_t)p->key.mv_size); - while ((rc = lmdb_write_internal(f, 0, opt, cs)) != MDB_SUCCESS) { - if (rc == MDB_MAP_FULL) { - mdb_resize_env(p->db_env); - } else { - return mdb_cob_status(rc); - } - } - return (cs != COB_STATUS_00_SUCCESS) ? cs : COB_STATUS_00_SUCCESS; -} - -/* DELETE record from the INDEXED file */ - -static int -lmdb_delete (cob_file_api *a, cob_file *f) -{ - COB_UNUSED (a); - if (f->flag_nonexistent) { - return COB_STATUS_49_I_O_DENIED; - } - return lmdb_delete_internal (f, 0); -} - -/* REWRITE record to the INDEXED file */ - -static int -lmdb_rewrite (cob_file_api *a, cob_file *f, const int opt) -{ - struct indexed_file *p = f->file; - int ret; - unsigned int cs = COB_STATUS_00_SUCCESS; - - COB_UNUSED (a); - - if (f->flag_nonexistent) { - return COB_STATUS_49_I_O_DENIED; - } - /* Check duplicate alternate keys */ - if (check_alt_keys (f, 1)) { - return COB_STATUS_22_KEY_EXISTS; - } - - /* Delete the current record */ - if ((ret = lmdb_delete_internal (f, 1)) != COB_STATUS_00_SUCCESS) { - return ret; - } - - /* Write data */ - db_setkey (f, 0); - while ((ret = lmdb_write_internal (f, 1, opt, cs)) != MDB_SUCCESS) { - if (ret == MDB_MAP_FULL) { - mdb_resize_env(p->db_env); - } else { - return mdb_cob_status(ret); - } - } - return (cs != COB_STATUS_00_SUCCESS) ? cs : COB_STATUS_00_SUCCESS; -} - -/* Initialization/Termination - cobsetpr-values with type ENV_PATH or ENV_STR - like lmdb_home and cob_file_path are taken care in cob_exit_common()! -*/ - -static void -cob_lmdb_exit_fileio (cob_file_api *a) -{ - COB_UNUSED (a); - if(db_buff) - cob_free (db_buff); - db_buff = NULL; - return; -} - -void -cob_lmdb_init_fileio (cob_file_api *a) -{ - a->io_funcs[COB_IO_LMDB] = (void*)&lmdb_funcs; - cobglobptr = a->glbptr; - cobsetptr = a->setptr; - db_data_dir = NULL; - db_buff = cob_malloc (COB_SMALL_BUFF); - if (cobsetptr->lmdb_home == NULL) { - cobsetptr->lmdb_home = cob_strdup("."); - } -} - -#endif diff -Nru gnucobol-4.0~early~20200606/libcob/focextfh.c gnucobol-5/libcob/focextfh.c --- gnucobol-4.0~early~20200606/libcob/focextfh.c 2020-06-06 20:52:01.000000000 +0000 +++ gnucobol-5/libcob/focextfh.c 1970-01-01 00:00:00.000000000 +0000 @@ -1,514 +0,0 @@ -/* - Copyright (C) 2002-2012, 2014-2020 Free Software Foundation, Inc. - Written by Keisuke Nishida, Roger While, Simon Sobisch, Ron Norman - - This file is part of GnuCOBOL. - - The GnuCOBOL runtime library is free software: you can redistribute it - and/or modify it under the terms of the GNU Lesser General Public License - as published by the Free Software Foundation, either version 3 of the - License, or (at your option) any later version. - - GnuCOBOL is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU Lesser General Public License for more details. - - You should have received a copy of the GNU Lesser General Public License - along with GnuCOBOL. If not, see . -*/ - -/* this file handles the obsolete OpenCOBOL external file handlers */ - -/* Force symbol exports */ -#define COB_LIB_EXPIMP -#include "fileio.h" - -#if defined(WITH_INDEX_EXTFH) || defined(WITH_SEQRA_EXTFH) -static int extfh_dummy () { return 91; } -static struct cob_fileio_funcs **fileio_funcs = NULL; -static const char *io_rtn_name[COB_IO_MAX+1] = { - "SEQUENTIAL", - "LINE SEQUENTIAL", - "RELATIVE", - "CISAM", - "DISAM", - "VBISAM", - "BDB", - "LMDB", - "IXEXT", - "SQEXT", - "RLEXT", - "" -}; - -static COB_INLINE int -get_io_ptr (cob_file *f) -{ - if (fileio_funcs[f->io_routine] == NULL) { - cob_runtime_error (_("ERROR I/O routine %s is not present"), - io_rtn_name[f->io_routine]); - } - return f->io_routine; -} -#endif - - -#ifdef WITH_INDEX_EXTFH - -void cob_index_init_fileio (cob_file_api *); - -/* Local variables */ - -static void cob_index_exit_fileio (cob_file_api *a); -static int indexed_open (cob_file_api *, cob_file *, char *, const int, const int); -static int indexed_close (cob_file_api *, cob_file *, const int); -static int indexed_start (cob_file_api *, cob_file *, const int, cob_field *); -static int indexed_read (cob_file_api *, cob_file *, cob_field *, const int); -static int indexed_read_next (cob_file_api *, cob_file *, const int); -static int indexed_write (cob_file_api *, cob_file *, const int); -static int indexed_delete (cob_file_api *, cob_file *); -static int indexed_rewrite (cob_file_api *, cob_file *, const int); - -static struct cob_fileio_funcs ext_indexed_funcs = { - indexed_open, - indexed_close, - indexed_start, - indexed_read, - indexed_read_next, - indexed_write, - indexed_rewrite, - indexed_delete, - (void*)extfh_dummy, - cob_index_init_fileio, - cob_index_exit_fileio, - (void*)extfh_dummy, - (void*)extfh_dummy, - (void*)extfh_dummy, - (void*)extfh_dummy -}; - -extern void extfh_cob_init_fileio (const struct cob_fileio_funcs *, - const struct cob_fileio_funcs *, - const struct cob_fileio_funcs *, - int (*)(cob_file *, const int)); -extern void extfh_cob_exit_fileio (void); - -extern void extfh_indexed_unlock (cob_file *); -extern int extfh_indexed_locate (cob_file *, char *); -extern int extfh_indexed_open (cob_file *, char *, const int, const int); -extern int extfh_indexed_close (cob_file *, const int); -extern int extfh_indexed_start (cob_file *, const int, cob_field *); -extern int extfh_indexed_read (cob_file *, cob_field *, const int); -extern int extfh_indexed_read_next (cob_file *, const int); -extern int extfh_indexed_write (cob_file *, const int); -extern int extfh_indexed_delete (cob_file *); -extern int extfh_indexed_rewrite (cob_file *, const int); - -/* OPEN INDEXED file */ -static int -indexed_open (cob_file_api *a, cob_file *f, char *filename, const int mode, const int sharing) -{ - int ret; - - f->io_routine = COB_IO_IXEXT; - ret = extfh_indexed_locate (f, filename); - switch (ret) { - case COB_NOT_CONFIGURED: - a->chk_file_mapping (f); - if (access (filename, F_OK) && errno == ENOENT) { - if (mode != COB_OPEN_OUTPUT && f->flag_optional == 0) { - return COB_STATUS_35_NOT_EXISTS; - } - } - break; - case COB_STATUS_00_SUCCESS: - break; - default: - return ret; - } - ret = extfh_indexed_open (f, filename, mode, sharing); - switch (ret) { - case COB_STATUS_00_SUCCESS: - f->open_mode = mode; - break; - case COB_STATUS_35_NOT_EXISTS: - if (f->flag_optional) { - f->open_mode = mode; - f->flag_nonexistent = 1; - f->flag_end_of_file = 1; - f->flag_begin_of_file = 1; - return COB_STATUS_05_SUCCESS_OPTIONAL; - } - break; - } - return ret; -} - -/* Close the INDEXED file */ -static int -indexed_close (cob_file_api *a, cob_file *f, const int opt) -{ - COB_UNUSED (a); - return extfh_indexed_close (f, opt); -} - - -/* START INDEXED file with positioning */ -static int -indexed_start (cob_file_api *a, cob_file *f, const int cond, cob_field *key) -{ - COB_UNUSED (a); - return extfh_indexed_start (f, cond, key); -} - -/* Random READ of the INDEXED file */ -static int -indexed_read (cob_file_api *a, cob_file *f, cob_field *key, const int read_opts) -{ - COB_UNUSED (a); - return extfh_indexed_read (f, key, read_opts); -} - -/* Sequential READ of the INDEXED file */ -static int -indexed_read_next (cob_file_api *a, cob_file *f, const int read_opts) -{ - COB_UNUSED (a); - return extfh_indexed_read_next (f, read_opts); -} - -/* WRITE to the INDEXED file */ -static int -indexed_write (cob_file_api *a, cob_file *f, const int opt) -{ - COB_UNUSED (a); - return extfh_indexed_write (f, opt); -} - - -/* DELETE record from the INDEXED file */ -static int -indexed_delete (cob_file_api *a, cob_file *f) -{ - COB_UNUSED (a); - return extfh_indexed_delete (f); -} - -/* REWRITE record to the INDEXED file */ -static int -indexed_rewrite (cob_file_api *a, cob_file *f, const int opt) -{ - COB_UNUSED (a); - return extfh_indexed_rewrite (f, opt); -} - -/* Initialization/Termination - cobsetpr-values with type ENV_PATH or ENV_STR - like bdb_home and cob_file_path are taken care in cob_exit_common()! -*/ - -static void -cob_index_exit_fileio (cob_file_api *a) -{ - COB_UNUSED (a); - extfh_cob_exit_fileio (); -} - -void -cob_index_init_fileio (cob_file_api *a) -{ - fileio_funcs = a->io_funcs; - a->io_funcs[COB_IO_IXEXT] = &ext_indexed_funcs; - - extfh_cob_init_fileio ( a->io_funcs[COB_IO_SEQUENTIAL], - a->io_funcs[COB_IO_LINE_SEQUENTIAL], - a->io_funcs[COB_IO_RELATIVE], - a->cob_file_write_opt ); -} - -#endif - -/* - * Old SEQRA EXTFH interface - */ -#ifdef WITH_SEQRA_EXTFH -extern void extfh_seqra_unlock (cob_file *); -extern int extfh_seqra_locate (cob_file *, char *); -extern int extfh_cob_file_open (cob_file *, char *, const int, const int); -extern int extfh_cob_file_close (cob_file *, const int); -extern int extfh_sequential_read (cob_file *, const int); -extern int extfh_sequential_write (cob_file *, const int); -extern int extfh_sequential_rewrite (cob_file *, const int); -extern int extfh_relative_start (cob_file *, const int, cob_field *); -extern int extfh_relative_read (cob_file *, cob_field *, const int); -extern int extfh_relative_read_next (cob_file *, const int); -extern int extfh_relative_write (cob_file *, const int); -extern int extfh_relative_rewrite (cob_file *, const int); -extern int extfh_relative_delete (cob_file *); -void cob_seqra_init_fileio (cob_file_api *); -static int seqra_open (cob_file_api *a, cob_file *f, char *filename, const int mode, const int sharing); -static int seqra_close (cob_file_api *a, cob_file *f, const int opt); -static void cob_seqra_exit_fileio (cob_file_api *a); - -static int sequential_read (cob_file_api *, cob_file *, const int); -static int sequential_write (cob_file_api *, cob_file *, const int); -static int sequential_rewrite (cob_file_api *, cob_file *, const int); -static int relative_start (cob_file_api *, cob_file *, const int, cob_field *); -static int relative_read (cob_file_api *, cob_file *, cob_field *, const int); -static int relative_read_next (cob_file_api *, cob_file *, const int); -static int relative_write (cob_file_api *, cob_file *, const int); -static int relative_rewrite (cob_file_api *, cob_file *, const int); -static int relative_delete (cob_file_api *, cob_file *); - - -static struct cob_fileio_funcs ext_sequential_funcs = { - seqra_open, - seqra_close, - (void*)extfh_dummy, - (void*)extfh_dummy, - sequential_read, - sequential_write, - sequential_rewrite, - (void*)extfh_dummy, - (void*)extfh_dummy, - cob_seqra_init_fileio, - cob_seqra_exit_fileio, - (void*)extfh_dummy, - (void*)extfh_dummy, - (void*)extfh_dummy, - (void*)extfh_dummy -}; - -static struct cob_fileio_funcs ext_relative_funcs = { - seqra_open, - seqra_close, - relative_start, - relative_read, - relative_read_next, - relative_write, - relative_rewrite, - (void*)extfh_dummy, - (void*)extfh_dummy, - cob_seqra_init_fileio, - cob_seqra_exit_fileio, - (void*)extfh_dummy, - (void*)extfh_dummy, - (void*)extfh_dummy, - (void*)extfh_dummy -}; - -extern void extfh_cob_init_fileio (const struct cob_fileio_funcs *, - const struct cob_fileio_funcs *, - const struct cob_fileio_funcs *, - int (*)(cob_file *, const int)); -extern void extfh_cob_exit_fileio (void); - -static int -seqra_open (cob_file_api *a, cob_file *f, char *filename, const int mode, const int sharing) -{ - /* Note filename points to file_open_name */ - /* cob_chk_file_mapping manipulates file_open_name directly */ - - int ret; - - f->share_mode = sharing; - ret = extfh_seqra_locate (f, filename); - switch (ret) { - case COB_NOT_CONFIGURED: - a->chk_file_mapping (f); - if (access (filename, F_OK) && errno == ENOENT) { - if (mode != COB_OPEN_OUTPUT && f->flag_optional == 0) { - return COB_STATUS_35_NOT_EXISTS; - } - } - break; - case COB_STATUS_00_SUCCESS: - break; - default: - return ret; - } - ret = extfh_cob_file_open (f, filename, mode, sharing); - switch (ret) { - case COB_STATUS_00_SUCCESS: - f->open_mode = mode; - break; - case COB_STATUS_35_NOT_EXISTS: - if (f->flag_optional) { - f->open_mode = mode; - f->flag_nonexistent = 1; - f->flag_end_of_file = 1; - f->flag_begin_of_file = 1; - return COB_STATUS_05_SUCCESS_OPTIONAL; - } - break; - } - return ret; -} - -static int -seqra_close (cob_file_api *a, cob_file *f, const int opt) -{ - COB_UNUSED (a); - return extfh_cob_file_close (f, opt); -} - -/* SEQUENTIAL */ - -static int -sequential_read (cob_file_api *a, cob_file *f, const int read_opts) -{ - int extfh_ret; - - extfh_ret = extfh_sequential_read (f, read_opts); - if (extfh_ret != COB_NOT_CONFIGURED) { - return extfh_ret; - } - if(f->organization == COB_ORG_LINE_SEQUENTIAL) - f->io_routine = COB_IO_LINE_SEQUENTIAL; - else - f->io_routine = COB_IO_SEQUENTIAL; - return fileio_funcs[get_io_ptr (f)]->read_next (a, f, read_opts); -} - -/* WRITE */ -static int -sequential_write (cob_file_api *a, cob_file *f, const int opt) -{ - int extfh_ret; - - extfh_ret = extfh_sequential_write (f, opt); - if (extfh_ret != COB_NOT_CONFIGURED) { - return extfh_ret; - } - if(f->organization == COB_ORG_LINE_SEQUENTIAL) - f->io_routine = COB_IO_LINE_SEQUENTIAL; - else - f->io_routine = COB_IO_SEQUENTIAL; - return fileio_funcs[get_io_ptr (f)]->write (a, f, opt); -} - -/* REWRITE */ -static int -sequential_rewrite (cob_file_api *a, cob_file *f, const int opt) -{ - int extfh_ret; - - extfh_ret = extfh_sequential_rewrite (f, opt); - if (extfh_ret != COB_NOT_CONFIGURED) { - return extfh_ret; - } - if(f->organization == COB_ORG_LINE_SEQUENTIAL) - f->io_routine = COB_IO_LINE_SEQUENTIAL; - else - f->io_routine = COB_IO_SEQUENTIAL; - return fileio_funcs[get_io_ptr (f)]->rewrite (a, f, opt); -} - -/* RELATIVE START */ -static int -relative_start (cob_file_api *a, cob_file *f, const int cond, cob_field *k) -{ - int extfh_ret; - - extfh_ret = extfh_relative_start (f, cond, k); - if (extfh_ret != COB_NOT_CONFIGURED) { - return extfh_ret; - } - if(f->organization == COB_ORG_LINE_SEQUENTIAL) - f->io_routine = COB_IO_LINE_SEQUENTIAL; - else - f->io_routine = COB_IO_SEQUENTIAL; - return fileio_funcs[get_io_ptr (f)]->start (a, f, cond, k); -} - -/* RELATIVE READ */ -static int -relative_read (cob_file_api *a, cob_file *f, cob_field *k, const int read_opts) -{ - int extfh_ret; - - extfh_ret = extfh_relative_read (f, k, read_opts); - if (extfh_ret != COB_NOT_CONFIGURED) { - return extfh_ret; - } - f->io_routine = COB_IO_RELATIVE; - return fileio_funcs[get_io_ptr (f)]->read (a, f, k, read_opts); -} - -/* RELATIVE READ NEXT */ -static int -relative_read_next (cob_file_api *a, cob_file *f, const int read_opts) -{ - int extfh_ret; - - extfh_ret = extfh_relative_read_next (f, read_opts); - if (extfh_ret != COB_NOT_CONFIGURED) { - return extfh_ret; - } - f->io_routine = COB_IO_RELATIVE; - return fileio_funcs[get_io_ptr (f)]->read_next (a, f, read_opts); -} - -/* RELATIVE WRITE */ -static int -relative_write (cob_file_api *a, cob_file *f, const int opt) -{ - int extfh_ret; - - extfh_ret = extfh_relative_write (f, opt); - if (extfh_ret != COB_NOT_CONFIGURED) { - return extfh_ret; - } - f->io_routine = COB_IO_RELATIVE; - return fileio_funcs[get_io_ptr (f)]->write (a, f, opt); -} - -/* RELATIVE REWRITE */ -static int -relative_rewrite (cob_file_api *a, cob_file *f, const int opt) -{ - int extfh_ret; - - extfh_ret = extfh_relative_rewrite (f, opt); - if (extfh_ret != COB_NOT_CONFIGURED) { - return extfh_ret; - } - f->io_routine = COB_IO_RELATIVE; - return fileio_funcs[get_io_ptr (f)]->rewrite (a, f, opt); -} - -/* RELATIVE DELETE */ -static int -relative_delete (cob_file_api *a, cob_file *f) -{ - int extfh_ret; - - extfh_ret = extfh_relative_delete (f); - if (extfh_ret != COB_NOT_CONFIGURED) { - return extfh_ret; - } - f->io_routine = COB_IO_RELATIVE; - return fileio_funcs[get_io_ptr (f)]->recdelete (a, f); -} - -static void -cob_seqra_exit_fileio (cob_file_api *a) -{ - COB_UNUSED (a); - extfh_cob_exit_fileio (); -} - -void -cob_seqra_init_fileio (cob_file_api *a) -{ - fileio_funcs = a->io_funcs; - a->io_funcs[COB_IO_SQEXT] = &ext_sequential_funcs; - a->io_funcs[COB_IO_RLEXT] = &ext_relative_funcs; - - extfh_cob_init_fileio ( a->io_funcs[COB_IO_SEQUENTIAL], - a->io_funcs[COB_IO_LINE_SEQUENTIAL], - a->io_funcs[COB_IO_RELATIVE], - a->cob_file_write_opt ); -} -#endif diff -Nru gnucobol-4.0~early~20200606/libcob/foci.c gnucobol-5/libcob/foci.c --- gnucobol-4.0~early~20200606/libcob/foci.c 2020-06-06 20:52:01.000000000 +0000 +++ gnucobol-5/libcob/foci.c 1970-01-01 00:00:00.000000000 +0000 @@ -1,1663 +0,0 @@ -/* - Copyright (C) 2002-2012, 2014-2020 Free Software Foundation, Inc. - Written by Keisuke Nishida, Roger While, Simon Sobisch, Ron Norman - - This file is part of GnuCOBOL. - - The GnuCOBOL runtime library is free software: you can redistribute it - and/or modify it under the terms of the GNU Lesser General Public License - as published by the Free Software Foundation, either version 3 of the - License, or (at your option) any later version. - - GnuCOBOL is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU Lesser General Public License for more details. - - You should have received a copy of the GNU Lesser General Public License - along with GnuCOBOL. If not, see . -*/ - - -/* Force symbol exports */ -#define COB_LIB_EXPIMP -#include "fileio.h" - -#ifdef WITH_OCI -#ifdef WITH_ODBC -#undef WITH_ODBC -#endif - -#include - -void cob_oci_init_fileio (cob_file_api *a); - -/* Local variables */ - -static int oci_sync (cob_file_api *, cob_file *); -static int oci_commit (cob_file_api *, cob_file *); -static int oci_rollback (cob_file_api *, cob_file *); -static int oci_open (cob_file_api *, cob_file *, char *, const int, const int); -static int oci_close (cob_file_api *, cob_file *, const int); -static int oci_start (cob_file_api *, cob_file *, const int, cob_field *); -static int oci_read (cob_file_api *, cob_file *, cob_field *, const int); -static int oci_read_next (cob_file_api *, cob_file *, const int); -static int oci_write (cob_file_api *, cob_file *, const int); -static int oci_delete (cob_file_api *, cob_file *); -static int oci_file_delete (cob_file_api *, cob_file *, char *); -static int oci_rewrite (cob_file_api *, cob_file *, const int); -static int oci_file_unlock (cob_file_api *, cob_file *); -static void oci_exit_fileio (cob_file_api *); -static int oci_fork (cob_file_api *); - -static const struct cob_fileio_funcs oci_indexed_funcs = { - oci_open, - oci_close, - oci_start, - oci_read, - oci_read_next, - oci_write, - oci_rewrite, - oci_delete, - oci_file_delete, - cob_oci_init_fileio, - oci_exit_fileio, - oci_fork, - oci_sync, - oci_commit, - oci_rollback, - oci_file_unlock -}; - -static int db_join = 1; -static struct db_state db[1]; -static char varFetch[80]; - -struct indexed_file { - struct file_xfd *fx; - int startcond; - int maxkeylen; - int primekeylen; - enum { - LMANULOCK = 0, - LAUTOLOCK = 1, - LEXCLLOCK = 2, - } lmode; - unsigned char *savekey; /* Work area for saving key value */ - unsigned char *suppkey; /* Work area for saving key value */ - unsigned char *saverec; /* For saving copy of record */ -}; - -/* Local functions */ - -#define szErrMsg 512 -#define dbStsRetry (EAGAIN * 1000) - -/************************************************** - Check Status from an Oracle call - Return 0 if OK to proceed; - Return 1 if Not OK to proceed; -**************************************************/ -static int -chkSts( - struct db_state *db, - char *msg, - int ociSts) -{ - int i; -#if defined(__linux__) - ub4 oraStatus; -#else - sb4 oraStatus; -#endif - char *env, errMsg[szErrMsg+16]; - - memset(db->odbcState, 0, sizeof(db->odbcState)); - if (ociSts == OCI_SUCCESS) { - db->dbStatus = 0; - db->scanForNulls = FALSE; - return 0; - } - db->dbStatus = ociSts; - - memset(db->lastErrMsg,0,sizeof(db->lastErrMsg)); - if (ociSts == OCI_SUCCESS_WITH_INFO) { - db->dbStatus = 0; - db->scanForNulls = TRUE; - return 0; - } - - if (db->dbStatus == db->dbStsNotFound2) /* MODE=ANSI 'Not found' */ - db->dbStatus = db->dbStsNotFound; /* Set internal 'Not found' status */ - else if(db->dbStatus == db->dbStsNullCol) /* Ignore NULL Column warning */ - db->dbStatus = 0; - else if(db->dbStatus == 2114) /* Ignore "Closing a closed cursor" */ - db->dbStatus = 0; - if (db->dbStatus == 0) - return 0; - if (db->dbStatus == db->dbStsNotFound) { - db->scanForNulls = FALSE; - return db->dbStsNotFound; - } - - if (msg == NULL) msg = (void*)"?"; - oraStatus = 0; - strcpy(errMsg,""); - OCIErrorGet(db->dbErrH, 1, (text*)NULL, (void*)&oraStatus, - (void*)errMsg, (int)sizeof(errMsg)-1, OCI_HTYPE_ERROR); - if (oraStatus < 0) - db->dbStatus = -oraStatus; - else - db->dbStatus = oraStatus; - i = strlen(errMsg); - if (errMsg[i-1] == '\n') - errMsg[--i] = 0; - snprintf(db->lastErrMsg,sizeof(db->lastErrMsg),"%s",errMsg); - for(i=0; i < sizeof(db->lastErrMsg) && db->lastErrMsg[i] != '\n'; i++); - while(i < sizeof(db->lastErrMsg)) - db->lastErrMsg[i++] = 0; - - if (db->dbStatus == db->dbStsNotFound2) /* MODE=ANSI 'Not found' */ - db->dbStatus = db->dbStsNotFound; /* Set internal 'Not found' status */ - else if(db->dbStatus == db->dbStsNullCol) /* Ignore NULL Column warning */ - db->dbStatus = 0; - else if(db->dbStatus == 2114) /* Ignore "Closing a closed cursor" */ - db->dbStatus = 0; - - if (db->dbStatus == 0) - return 0; - - if (memcmp(errMsg,"ORA-00604",9) == 0 /* 604 means there is some other error */ - && (env = strstr(errMsg+9,"ORA-")) != NULL) { - i = strlen(env); - memset(db->lastErrMsg,0,sizeof(db->lastErrMsg)); - snprintf(db->lastErrMsg,sizeof(db->lastErrMsg),"%s",env); - for(i=0; i < sizeof(db->lastErrMsg) && db->lastErrMsg[i] != '\n'; i++); - while(i < sizeof(db->lastErrMsg)) - db->lastErrMsg[i++] = 0; - i = atoi(&env[4]); /* Primary error code */ - if (i > 0 && i < 10000) - db->dbStatus = i; - DEBUG_LOG ("db",("%s Status 604 due to %d: %s\n",msg,db->dbStatus,db->lastErrMsg)); - } - - - if (db->dbStatus == db->dbStsNoTable) { - DEBUG_LOG("db",("%.40s Status of %d '%s'\n", msg, db->dbStatus, errMsg)); - return 1; - } - - if (db->dbStatus != 0 - && db->dbStatus != db->dbStsNotFound) { - if (db->dbStatus == db->dbStsRecLock /* FOR UPDATE NOWAIT and its held! */ - && db->intRecWait > 1000 - && db->nMaxRetry > 0) { - db->nRecWaitTry++; - sleep(db->intRecWait/1000); /* Pause a while */ - return 1; /* Skip logging error message */ - } - if (db->dbStatus == 3114 - || db->dbStatus == 3113) { - db->isopen = FALSE; - db->dbFatalStatus = db->dbStatus; - } else - if (db->dbFatalStatus == 0 - && db->dbStatus > 1000) { - db->dbFatalStatus = db->dbStatus; - } - DEBUG_LOG("db",("%.40s Status of %d, fatal %d\n", - msg, db->dbStatus, db->dbFatalStatus)); - DEBUG_LOG("db",(" : %s\n",errMsg)); - } - if ( (db->dbFatalStatus >= 0) - && (db->dbStatus < 0) - && (db->dbStatus != db->dbStsRecLock) - && (db->dbStatus != db->dbStsDupKey) - && (db->dbStatus != 1722) - && (db->dbStatus != 1410) - && (db->dbStatus != db->dbStsNotFound) ) { - db->dbFatalStatus = db->dbStatus; - } - - return 1; -} - -/* - * Break the xxx_CON string up into the individual fields - * user@network-sid/password - * user/password - * network-sid - */ -static void -splitConnectString(struct db_state *db, char *env) -{ - char temp[256]; - int j,k,stp; - unsigned char bUserSet = FALSE; - unsigned char bPwdSet = FALSE; - unsigned char bSidSet = FALSE; - - temp[j=0] = 0; - stp = 0; /* Userid is first */ - snprintf(db->dbCon,sizeof(db->dbCon),"%s",env); - for(k=0; env[k] != 0; k++) { - if(env[k] == '/') { - temp[j] = 0; - if(stp == 2) { - bSidSet = TRUE; - snprintf(db->dbName,sizeof(db->dbName),"%s",temp); - db->attachDbName = TRUE; - } else { - snprintf(db->dbUser,sizeof(db->dbUser),"%s",temp); - bUserSet = TRUE; - } - temp[j=0] = 0; - stp = 1; - } else if(env[k] == '@') { - temp[j] = 0; - snprintf(db->dbUser,sizeof(db->dbUser),"%s",temp); - bUserSet = TRUE; - temp[j=0] = 0; - stp = 2; - } else { - temp[j++] = env[k]; - temp[j] = 0; - } - } - if(temp[0] > ' ') { - if(stp == 0 /* No / or @ so use as SID value */ - || stp == 2) { - snprintf(db->dbName,sizeof(db->dbName),"%s",temp); - db->attachDbName = TRUE; - bSidSet = TRUE; - } else { - snprintf(db->dbPwd,sizeof(db->dbPwd),"%s",temp); - bPwdSet = TRUE; - } - } - if(bUserSet) { - env = (void*)malloc(strlen(db->dbUser)+20); - sprintf((char*)env,"ORACLE_UID=%s",db->dbUser); - putenv( (char*)env ); - } - if(bPwdSet) { - env = (void*)malloc(strlen(db->dbPwd)+20); - sprintf((char*)env,"ORACLE_PWD=%s",db->dbPwd); - putenv( (char*)env ); - } - if(bSidSet) { - env = (void*)malloc(strlen(db->dbName)+20); - sprintf((char*)env,"ORACLE_SID=%s",db->dbName); - putenv( (char*)env ); - } -} - -static int -oci_commit (cob_file_api *a, cob_file *f) -{ -#ifdef COB_DEBUG_LOG - char msg[24]; -#endif - COB_UNUSED (a); - COB_UNUSED (f); - if (!db->isopen) - return 0; - if (f->last_operation == COB_LAST_COMMIT) { - DEBUG_LOG("db",("COMMIT from application!\n")); - db->autocommit = FALSE; - } else if (db->updatesDone < db->commitInterval - && f->last_operation != COB_LAST_CLOSE) - return 0; - if (chkSts(db,(char*)"Commit", - OCITransCommit(db->dbSvcH, db->dbErrH, OCI_DEFAULT))) { - db->updatesDone = 0; - return COB_STATUS_30_PERMANENT_ERROR; - } -#ifdef COB_DEBUG_LOG - if (db->updatesDone <= 0 - || db->updatesDone > (int)BIGCOMMIT) - strcpy(msg,""); - else - sprintf(msg,"%d ",db->updatesDone); - DEBUG_LOG("db",("%s Commit %supdates\n",db->dbType,msg)); -#endif - db->updatesDone = 0; - return 0; -} - -static int -oci_rollback (cob_file_api *a, cob_file *f) -{ -#ifdef COB_DEBUG_LOG - char msg[24]; -#endif - COB_UNUSED (a); - COB_UNUSED (f); - if (!db->isopen) - return 0; - if (f->last_operation == COB_LAST_ROLLBACK) { - DEBUG_LOG("db",("ROLLBACK from application!\n")); - db->autocommit = FALSE; - } else if (db->updatesDone < 1) - return 0; - if (chkSts(db,(char*)"Rollback", - OCITransRollback(db->dbSvcH, db->dbErrH, OCI_DEFAULT))) { - db->updatesDone = 0; - return COB_STATUS_30_PERMANENT_ERROR; - } -#ifdef COB_DEBUG_LOG - if (db->updatesDone <= 0 - || db->updatesDone > (int)BIGCOMMIT) - strcpy(msg,""); - else - sprintf(msg,"%d ",db->updatesDone); - DEBUG_LOG("db",("%s Rollback %supdates\n",db->dbType,msg)); -#endif - db->updatesDone = 0; - return 0; -} - -/**************************************************** - Bind just column to return data -****************************************************/ -static int -bindColumn( - struct db_state *db, - struct file_xfd *fx, - SQL_STMT *s, - struct map_xfd *col, - int pos) -{ - char msg[64]; - if (col->cmd == XC_DATA - && col->colname) { - col->hostType = SQLT_STR; - if (col->dtfrm) { - col->sqlType = SQLT_DAT; - } else if (col->type == COB_XFDT_FLOAT) { - if (col->size == sizeof(double)) - col->hostType = SQLT_FLT; - else - col->hostType = SQLT_FLT; - col->sqlType = SQLT_FLT; - col->sqlColSize = col->size; - } else if (col->type == COB_XFDT_BIN) { - col->sqlColSize = col->size; - col->hostType = SQLT_BIN; - col->sqlType = SQLT_BIN; - } else if (col->valnum) { - col->sqlType = SQLT_NUM; - } else { - col->sqlType = SQLT_CHR; - } - } - sprintf(msg,"BindColumn %s.%s Pos %d",fx->tablename,col->colname,pos); - db->dbBindV = NULL; - col->nRlen2 = col->sqlColSize; - col->nRlen4 = col->sqlColSize; - if (chkSts(db,msg, - OCIDefineByPos(s->handle, (OCIDefine **)&db->dbBindV, db->dbErrH, - (ub4)pos, (ub1*)col->sdata, (sword)col->sqlColSize, - (ub2)col->hostType, (ub2*)col->ind, - (ub2*)&col->nRlen2, (ub2*)&col->nRcode, OCI_DEFAULT))) { - return 1; - } - return 0; -} - -/**************************************************** - Bind just one column as parameter to statment -****************************************************/ -static int -bindParam( - struct db_state *db, - struct file_xfd *fx, - SQL_STMT *s, - struct map_xfd *col, - int pos) -{ - char msg[64]; - ub2 prmtype; - if (col->cmd == XC_DATA - && col->ind) { - if (col->setnull) { - *(ub2*)col->ind = -1; - } else { - *(ub2*)col->ind = 0; - } - } - db->dbBindV = NULL; - col->nRlen2 = col->sqlColSize; - col->nRlen4 = col->sqlColSize; - if (col->type == COB_XFDT_BIN) - prmtype = SQLT_BIN; - else - prmtype = col->hostType; - sprintf(msg,"BindParam %s.%s Pos %d",fx->tablename,col->colname,pos); - if (chkSts(db,msg, - OCIBindByPos(s->handle, (OCIBind **)&db->dbBindV, db->dbErrH, - (ub4)pos, (ub1*)col->sdata, (sword)col->sqlColSize, - (sword)prmtype, (ub2*)col->ind, NULL, - (ub2*)&col->nRcode, 0, NULL, OCI_DEFAULT))) { - return 1; - } - return 0; -} - -static void -oci_free_all_handles ( struct db_state *db) -{ - db->isopen = FALSE; /* Data Base is NOT connected */ - if (db->dbSesH) { - OCIHandleFree ( db->dbSesH, OCI_HTYPE_SESSION); - db->dbSesH = NULL; - } - if (db->dbSvcH) { - OCIHandleFree ( db->dbSvcH, OCI_HTYPE_SVCCTX); - db->dbSvcH = NULL; - } - if (db->dbSvrH) { - OCIHandleFree ( db->dbSvrH, OCI_HTYPE_SERVER); - db->dbSvrH = NULL; - } - if (db->dbErrH) { - OCIHandleFree ( db->dbErrH, OCI_HTYPE_ERROR); - db->dbErrH = NULL; - } - if (db->dbSesH) { - OCIHandleFree ( db->dbSesH, OCI_HTYPE_SESSION); - db->dbSesH = NULL; - } - if (db->dbEnvH) { - OCIHandleFree ( db->dbEnvH, OCI_HTYPE_ENV); - db->dbEnvH = NULL; - } -} - -static int -oci_set_nulls ( - struct db_state *db, - struct file_xfd *fx) -{ - int k; - for (k=0; k < fx->nmap; k++) { - if (fx->map[k].cmd == XC_DATA - && fx->map[k].ind) { - if (fx->map[k].setnull) { - *(ub2*)fx->map[k].ind = -1; - } else { - *(ub2*)fx->map[k].ind = 0; - } - } - } - return 0; -} - -static int -oci_any_nulls ( - struct db_state *db, - struct file_xfd *fx) -{ - int k,ln; - for (k=0; k < fx->nmap; k++) { - if (fx->map[k].cmd == XC_DATA - && fx->map[k].ind) { - ln = fx->map[k].sqlinlen = fx->map[k].sqlsize; - if(fx->map[k].hostType == SQLT_STR) { - ln = (int)strlen((char*)fx->map[k].sdata); - } - if (*(short*)fx->map[k].ind == -1) { - fx->map[k].setnull = TRUE; - } else if(*(short*)fx->map[k].ind == 0) { - fx->map[k].setnull = FALSE; - if (fx->map[k].sqlinlen > ln) - fx->map[k].sqlinlen = ln; - } else { - fx->map[k].setnull = FALSE; - fx->map[k].sqlinlen = fx->map[k].nRlen2; - if (fx->map[k].sqlinlen > ln) - fx->map[k].sqlinlen = ln; - } - } - } - return 0; -} - -static int -oci_setup_stmt ( - struct db_state *db, - struct file_xfd *fx, - SQL_STMT *s, - int bindtype, - int idx) -{ - int k,pos; - if (!s->handle) { - if (chkSts(db,(char*)"Alloc Stmt Handle", - OCIHandleAlloc(db->dbEnvH,&s->handle,OCI_HTYPE_STMT, 0, NULL))){ - DEBUG_LOG("db",("OCIHandleAlloc %.40s status %d; Failed!\n",s->text,db->dbStatus)); - s->status = db->dbStatus; - return db->dbStatus; - } - s->preped = FALSE; - s->bound = FALSE; - s->params = FALSE; - s->iscursor = FALSE; - } - if (!s->preped) { - if (chkSts(db,(char*)"Prepare Stmt", - OCIStmtPrepare(s->handle,db->dbErrH,(text*)s->text,strlen(s->text), - OCI_NTV_SYNTAX,OCI_DEFAULT))){ - DEBUG_LOG("db",("OCIPrepare %.40s status %d; Failed!\n",s->text,db->dbStatus)); - s->status = db->dbStatus; - return db->dbStatus; - } - s->preped = TRUE; - } - if (!s->params - && (bindtype & SQL_BIND_PRMS)) { - pos = 0; - for (k=0; k < fx->nmap; k++) { - if (fx->map[k].cmd == XC_DATA - && fx->map[k].colname) { - bindParam (db, fx, s, &fx->map[k], ++pos); - } - } - s->bindpos = pos; - s->params = TRUE; - } else - if (!s->bound - && (bindtype & SQL_BIND_COLS)) { - pos = 0; - for (k=0; k < fx->nmap; k++) { - if (fx->map[k].cmd == XC_DATA - && fx->map[k].colname) { - bindColumn (db, fx, s, &fx->map[k], ++pos); - } - } - s->bindpos = 0; - s->bound = TRUE; - } - - if ((bindtype & SQL_BIND_EQ)) { /* Index columns bind once each */ - pos = s->bindpos; - for (k=0; k < fx->key[idx]->ncols; k++) { - bindParam (db, fx, s, &fx->map[fx->key[idx]->col[k]], ++pos); - } - } else if ((bindtype & SQL_BIND_WHERE)) { /* Index Columns for complex WHERE */ - pos = s->bindpos; - for (k=0; k < fx->key[idx]->ncols-1; k++) { - bindParam (db, fx, s, &fx->map[fx->key[idx]->col[k]], ++pos); - bindParam (db, fx, s, &fx->map[fx->key[idx]->col[k]], ++pos); - } - bindParam (db, fx, s, &fx->map[fx->key[idx]->col[k]], ++pos); - } - s->status = 0; - return 0; -} - -static int -oci_row_count ( - struct db_state *db, - SQL_STMT *s) -{ - ub4 count = (ub4)-1; - OCIAttrGet (s->handle, OCI_HTYPE_STMT, &count, 0, OCI_ATTR_ROW_COUNT, db->dbErrH); - return (int)count; -} - -static void -oci_close_stmt ( SQL_STMT *s) -{ - if (s == NULL - || s->handle == NULL) - return; - s->iscursor = FALSE; - s->status = 0; - return; -} - -static void -oci_free_stmt ( SQL_STMT *s) -{ - if (s == NULL - || s->handle == NULL) - return; - OCIHandleFree(s->handle, OCI_HTYPE_STMT); - s->handle = NULL; - s->preped = FALSE; - s->bound = FALSE; - s->params = FALSE; - s->iscursor = FALSE; - s->status = 0; - if (s->text) - cob_free (s->text); - s->text = NULL; - return; -} - -static int -oci_sync (cob_file_api *a, cob_file *f) -{ - COB_UNUSED (a); - COB_UNUSED (f); - if (!db->isopen) - return 0; - if (db->updatesDone > 0) { - db->updatesDone = 0; - if (chkSts(db,(char*)"Commit", - OCITransCommit(db->dbSvcH, db->dbErrH, OCI_DEFAULT))) - return COB_STATUS_30_PERMANENT_ERROR; - DEBUG_LOG("db",("OCI Sync/Commit completed\n")); - } - return 0; -} - -/**************************************************** - Issue one simple SQL statment, no variables - Return 0 if OK to proceed; - Return !0 if Not OK to proceed; -*****************************************************/ -static int -ociStmt( - struct db_state *db, - char *stmt) -{ - void *stmtHndl; - int len, rtn = 0; - char msg[80]; - ub4 iters = 1; - ub2 nRlen2, nRcode; - - if (chkSts(db,(char*)"Alloc stmtHandle", - OCIHandleAlloc(db->dbEnvH,&stmtHndl,OCI_HTYPE_STMT, 0, NULL))){ - DEBUG_LOG("db",("OCIHandleAlloc %s status %d; Failed!\n",stmt,db->dbStatus)); - return db->dbStatus; - } - - len = strlen(stmt); - if (len <= 0) { - return 0; - } - snprintf(msg,sizeof(msg),"Prep: %.50s",stmt); - db->dbStatus = 0; - if(chkSts(db,(char*)msg, - OCIStmtPrepare(stmtHndl,db->dbErrH, - (text*)stmt,len,OCI_NTV_SYNTAX,OCI_DEFAULT))) { - DEBUG_LOG("db",("OCIStmtPrepare status %d; Failed!\n",db->dbStatus)); - } else { - snprintf(msg,sizeof(msg),"Exec: %.50s",stmt); - db->dbStatus = 0; - if (strncasecmp(stmt,"SELECT ",7) == 0) - iters = 0; - chkSts(db,(char*)msg, - OCIStmtExecute(db->dbSvcH,stmtHndl,db->dbErrH, - iters,0,NULL,NULL,OCI_DEFAULT)); - } - rtn = db->dbStatus; - if (db->dbStatus == 0 - && strncasecmp(stmt,"SELECT ",7) == 0) { - chkSts(db,msg, - OCIDefineByPos(stmtHndl, (OCIDefine **)&db->dbBindV, db->dbErrH, - (ub4)1, (ub1*)varFetch, (sword)sizeof(varFetch), - (ub2)SQLT_CHR, (ub2*)NULL, - (ub2*)&nRlen2, (ub2*)&nRcode, OCI_DEFAULT)); - varFetch[0] = 0; - if (chkSts(db,(char*)"Fetch Stmt", - OCIStmtFetch2(stmtHndl,db->dbErrH,1,OCI_FETCH_NEXT,0,OCI_DEFAULT))) { - DEBUG_LOG("db",("Fetch: %.50s; Sts %d\n",stmt,db->dbStatus)); - rtn = db->dbStatus; - } else { - DEBUG_LOG("db",("Fetch: %.50s; '%s' OK\n",stmt,varFetch)); - } - } - OCIHandleFree(stmtHndl, OCI_HTYPE_STMT); - return rtn; -} - -static void -oci_create_table ( - struct db_state *db, - struct file_xfd *fx) -{ - int k; - cob_load_ddl (db, fx); - if (fx->create_table == NULL) { - db->dbStatus = db->dbStsNoTable; - return; - } - if (ociStmt (db, fx->create_table)) { - db->dbStatus = db->dbStsNoTable; - return; - } - if (fx->fileorg == COB_ORG_RELATIVE) - return; - for (k=0; k < fx->nkeys && fx->key[k]->create_index; k++) { - if (ociStmt (db, fx->key[k]->create_index)) { - DEBUG_LOG ("db",("k%d: %s\n",k,fx->key[k]->create_index)); - db->dbStatus = db->dbStsNoTable; - return; - } - } -} - -/* INDEXED */ - -static void -join_environment (cob_file_api *a) -{ - char *env, *p, tmp[256]; - - db_join = -1; - db->isopen = FALSE; - memset(db,0,sizeof(struct db_state)); - db->dbStsOk = 0; - db->dbStsDupKey = 1; - db->dbStsNotFound = 1403; - db->dbStsNotFound2 = 100; - db->dbStsNoTable = 942; - db->isoci = TRUE; - db->isodbc = FALSE; - db->oracle = TRUE; - db->dbStsRecLock = 54; /* Oracle row locked by other */ - strcpy(db->dbType,"Oracle OCI"); - db->dbStsDeadLock = 60; - db->dbStsNoSpace = 1653; - db->dbStsNullCol = 1405; - db->dbStsInvlNum = 1722; - db->dbStsBadRowid = 1410; - if ((env=getSchemaEnvName(db,tmp,"_HOME",NULL)) != NULL) { - DEBUG_LOG("db",("Env: %s -> %s\n",tmp,env)); - db->dbHome = env; - } else { - db->dbHome = (char*)"/usr/oracle"; - } - - if (chkSts(db,(char*)"Alloc EnvH", - OCIEnvCreate((OCIEnv**)&db->dbEnvH,OCI_DEFAULT|OCI_NO_UCB, - NULL, NULL, NULL, NULL, 0, NULL))) { - DEBUG_LOG("db",("OCIAllocHandle Env status %d; Failed!\n",db->dbStatus)); - return; - } - if (chkSts(db,(char*)"Alloc SvcH", - OCIHandleAlloc(db->dbEnvH, &db->dbSvcH, OCI_HTYPE_SVCCTX, 0, NULL))) { - DEBUG_LOG("db",("OCIAllocHandle Svc status %d; Failed!\n",db->dbStatus)); - return; - } - if (chkSts(db,(char*)"Alloc ErrH", - OCIHandleAlloc(db->dbEnvH, &db->dbErrH, OCI_HTYPE_ERROR, 0, NULL))) { - DEBUG_LOG("db",("OCIAllocHandle Err status %d; Failed!\n",db->dbStatus)); - return; - } - if (chkSts(db,(char*)"Alloc SvrH", - OCIHandleAlloc(db->dbEnvH, &db->dbSvrH, OCI_HTYPE_SERVER, 0, NULL))) { - DEBUG_LOG("db",("OCIAllocHandle Svr status %d; Failed!\n",db->dbStatus)); - return; - } - if (chkSts(db,(char*)"Alloc SesH", - OCIHandleAlloc(db->dbEnvH, &db->dbSesH, OCI_HTYPE_SESSION, 0, NULL))) { - DEBUG_LOG("db",("OCIAllocHandle Ses status %d; Failed!\n",db->dbStatus)); - return; - } - if (chkSts(db,(char*)"Alloc Env", - OCIEnvCreate((OCIEnv**)&db->dbEnvH, OCI_OBJECT, 0, NULL, NULL, NULL,0,NULL))) { - DEBUG_LOG("db",("OCIEnvCreate OBJECT status %d; Failed!\n",db->dbStatus)); - return; - } - - if ((env=getSchemaEnvName(db,tmp,"_CON",db->dbCon)) != NULL) { - DEBUG_LOG("db",("Env: %s -> %s\n",tmp,env)); - splitConnectString (db, env); - } else { - if ((env=getSchemaEnvName(db,tmp,"_SID",db->dbSid)) != NULL) { - DEBUG_LOG("db",("Env: %s -> %s\n",tmp,env)); - } - if ((env=getSchemaEnvName(db,tmp,"_UID",db->dbUser)) != NULL) { - DEBUG_LOG("db",("Env: %s -> %s\n",tmp,env)); - } - if ((env=getSchemaEnvName(db,tmp,"_PWD",db->dbPwd)) != NULL) { - DEBUG_LOG("db",("Env: %s -> %s\n",tmp,env)); - } - } - if((env=getSchemaEnvName(db,tmp,"_COMMIT",NULL)) != NULL) { - DEBUG_LOG("db",("Env: %s -> %s\n",tmp,env)); - db->commitInterval = atoi(env); - } else { - db->commitInterval = (int)BIGCOMMIT; - } - if (db->dbName[0] > ' ' - && db->attachDbName) { - sprintf(tmp,"Attach DBNAME=%s",db->dbName); - if (chkSts(db, (char*)tmp, - OCIServerAttach(db->dbSvrH, db->dbErrH, - (text*)db->dbName, strlen(db->dbName), OCI_DEFAULT) ) ) { - oci_free_all_handles (db); - return; - } - } else { - sprintf(tmp,"Attach Default %s",db->dbSid); - if (chkSts(db, (char*)tmp, - OCIServerAttach(db->dbSvrH, db->dbErrH, - (text*)NULL, 0, OCI_DEFAULT) ) ) { - oci_free_all_handles (db); - return; - } - } - - chkSts(db,(char*)"AttrSet",OCIAttrSet( db->dbSvcH, OCI_HTYPE_SVCCTX, - db->dbSvrH, 0, OCI_ATTR_SERVER, db->dbErrH )); - if(db->dbStatus) { - DEBUG_LOG("db",("OCIAttrSet Server status %d; Failed!\n",db->dbStatus)); - return; - } - DEBUG_LOG("db",("OCIAttrSet Server ready!\n")); - - chkSts(db,(char*)"AttrSet",OCIAttrSet( db->dbSvcH, OCI_HTYPE_SVCCTX, - db->dbSvrH, 0, OCI_ATTR_SERVER, db->dbErrH )); - if(db->dbStatus) { - DEBUG_LOG("db",("OCIAttrSet Server status %d; Failed!\n",db->dbStatus)); - return; - } - - chkSts(db,(char*)"AttrSet Uid",OCIAttrSet( db->dbSesH, OCI_HTYPE_SESSION, - (text *)db->dbUser, strlen(db->dbUser), - OCI_ATTR_USERNAME, db->dbErrH )); - if(db->dbStatus) { - DEBUG_LOG("db",("OCIAttrSet User status %d; Failed!\n",db->dbStatus)); - return; - } - - chkSts(db,(char*)"AttrSet Pwd",OCIAttrSet( db->dbSesH, OCI_HTYPE_SESSION, - (text *)db->dbPwd, strlen(db->dbPwd), - OCI_ATTR_PASSWORD, db->dbErrH )); - if(db->dbStatus) { - DEBUG_LOG("db",("OCIAttrSet Password status %d; Failed!\n",db->dbStatus)); - return; - } - - chkSts(db, (char*)"Session Begin", OCISessionBegin(db->dbSvcH, db->dbErrH, db->dbSesH, - OCI_CRED_RDBMS, OCI_DEFAULT)); - if (db->dbStatus == -1017 - || db->dbStatus == 1017) { /* Invalid User/pass */ - DEBUG_LOG("db",(" %s: User %s, Pwd %s\n",db->dbType,db->dbUser,db->dbPwd)); - return; - } - if (db->dbStatus) { - DEBUG_LOG("db",("SessionBegin status %d; Failed!\n",db->dbStatus)); - DEBUG_LOG("db",("%s: User %s, Pwd %s\n",db->dbType,db->dbUser,db->dbPwd)); - return; - } - if (chkSts(db,(char*)"AttrSet Ses",OCIAttrSet( db->dbSvcH, OCI_HTYPE_SVCCTX, - db->dbSesH, 0, OCI_ATTR_SESSION, db->dbErrH ))) { - DEBUG_LOG("db",("OCIAttrSet Session status %d; Failed!\n",db->dbStatus)); - return; - } - - if (chkSts(db,(char*)"AttrSet Ses", - OCIServerVersion( db->dbSvcH, db->dbErrH, - (text*)tmp, sizeof(tmp), OCI_HTYPE_SVCCTX))) { - DEBUG_LOG("db",("OCIAttrSet Session status %d; Failed!\n",db->dbStatus)); - return; - } - DEBUG_LOG("db",("%s\n",tmp)); - if ((env = strcasestr (tmp,"Release")) != NULL) { - int num = 0; - env += 8; - while(*env == ' ') env++; - for (p=env; *p != ' '; p++) { - if (*p == '.') num++; - if (num > 1) break; - } - *p = 0; - snprintf(db->dbType,sizeof(db->dbType),"OCI Oracle %s",env); - db->dbVer = atoi(env); - } - if (db->dbVer < 10) - db->dbVer = 10; - - if ((env=getSchemaEnvName(db,tmp,"_TRC",NULL)) != NULL) { - if (ociStmt(db,(char*)"ALTER SESSION SET SQL_TRACE = TRUE")) - return; - } - if (db->oracle) { - /* The runtime code uses DECIMAL POINT internally */ - if (ociStmt(db,(char*)"ALTER SESSION SET NLS_NUMERIC_CHARACTERS = '.,'")) { - return; - } - - /* Set The default format for handling DATE fields */ - if (db->dateFormat != NULL - && strlen(db->dateFormat) > 0) { - DEBUG_LOG("db",("NOTE: Default DATE field format is '%s'\n",db->dateFormat)); - sprintf(tmp,"ALTER SESSION SET NLS_DATE_FORMAT = '%s'",db->dateFormat); - if (ociStmt(db,tmp)) { - return; - } - } else { - db->dateFormat = (char*)"YYYYMMDD"; - DEBUG_LOG("db",("NOTE: Set DATE format to '%s'\n",db->dateFormat)); - sprintf(tmp,"ALTER SESSION SET NLS_DATE_FORMAT = '%s'",db->dateFormat); - if (ociStmt(db,tmp)) { - return; - } - } - strcpy(tmp,"ALTER SESSION SET OPTIMIZER_MODE = FIRST_ROWS"); - DEBUG_LOG("db",("NOTE: %s\n",tmp)); - ociStmt(db,tmp); - } - - db_join = 0; /* All connect steps completed */ - DEBUG_LOG("db",("%s successful connection\n",db->dbType)); - db->isopen = TRUE; - db->autocommit = TRUE; /* Default to AUTO COMMIT every update */ -} - -/* Delete file */ -static int -oci_file_delete (cob_file_api *a, cob_file *f, char *filename) -{ - struct indexed_file *p; - char buff[COB_FILE_MAX+1]; - struct file_xfd *fx; - - DEBUG_LOG("db",("DELETE FILE %s\n",f->select_name)); - if (db_join) { /* Join DataBase, on first OPEN of INDEXED file */ - join_environment (a); - if (db_join < 0) { - return COB_STATUS_30_PERMANENT_ERROR; - } - } - if (f->file == NULL) { - fx = cob_load_xfd (f, NULL, sizeof(ub2)); - if (fx == NULL) { - return COB_STATUS_30_PERMANENT_ERROR; - } - fx->gentable = a->setptr->cob_create_table; - p = cob_malloc (sizeof (struct indexed_file)); - f->file = p; - f->flag_file_lock = 0; - f->curkey = -1; - p->fx = fx; - } - p = f->file; - fx = p->fx; - snprintf(buff,sizeof(buff),"DROP TABLE %s",fx->tablename); - if (f->open_mode == COB_OPEN_CLOSED) { - oci_close (a, f, 0); - } - DEBUG_LOG("db",("%s\n",buff)); - if (ociStmt(db,buff) - && db->dbStatus == db->dbStsNoTable) { - return 0; - } - if (db->dbStatus != db->dbStsOk) { - return COB_STATUS_30_PERMANENT_ERROR; - } - - return 0; -} - -/* OPEN INDEXED file */ -static int -oci_open (cob_file_api *a, cob_file *f, char *filename, const int mode, const int sharing) -{ - struct indexed_file *p; - int i, k, ln; - char buff[COB_FILE_MAX+1]; -#ifdef COB_DEBUG_LOG - const char *optyp = "?"; -#endif - struct file_xfd *fx; - - fx = cob_load_xfd (f, NULL, sizeof(ub2)); - if (fx == NULL) { - return COB_STATUS_30_PERMANENT_ERROR; - } - fx->gentable = a->setptr->cob_create_table; -#ifdef COB_DEBUG_LOG - if (mode == COB_OPEN_INPUT) - optyp = "INPUT"; - else if (mode == COB_OPEN_I_O) - optyp = "IO"; - else if (mode == COB_OPEN_OUTPUT) - optyp = "OUTPUT"; - else - optyp = "EXTEND"; -#endif - if (db_join) { /* Join DataBase, on first OPEN of INDEXED file */ - join_environment (a); - if (db_join < 0) { - return COB_STATUS_30_PERMANENT_ERROR; - } - } - - p = cob_malloc (sizeof (struct indexed_file)); - f->file = p; - f->flag_file_lock = 0; - f->curkey = -1; - p->startcond = -1; - p->fx = fx; - p->primekeylen = db_keylen (f, 0); - p->maxkeylen = p->primekeylen; - for (i=1; i < MAXNUMKEYS && i < f->nkeys; i++) { - ln = db_keylen (f, i); - if (ln < 0) - break; - if (ln > p->maxkeylen) - p->maxkeylen = ln; - } - - switch (mode) { - case COB_OPEN_OUTPUT: - snprintf(buff,sizeof(buff),"TRUNCATE TABLE %s",fx->tablename); - if (ociStmt(db,buff) - && db->dbStatus == db->dbStsNoTable) { - oci_create_table (db, fx); - } - if (db->dbStatus != db->dbStsOk) { - return COB_STATUS_30_PERMANENT_ERROR; - } - break; - case COB_OPEN_I_O: - case COB_OPEN_EXTEND: - case COB_OPEN_INPUT: - snprintf(buff,sizeof(buff),"SELECT 1 FROM %s WHERE 1 = 0",fx->tablename); - if (ociStmt(db,buff) - && db->dbStatus == db->dbStsNoTable) { - oci_create_table (db, fx); - if (db->dbStatus != db->dbStsOk) - return COB_STATUS_30_PERMANENT_ERROR; - } else if (db->dbStatus != db->dbStsNotFound) { - return COB_STATUS_30_PERMANENT_ERROR; - } - break; - } - - snprintf(buff,sizeof(buff),"SELECT MAX(rid_%s) FROM %s",fx->tablename,fx->tablename); - strcpy(varFetch,"0"); - if (mode != COB_OPEN_OUTPUT - && !ociStmt(db,(char*)buff)) { - f->max_rec_num = atol (varFetch); - } - - if ((f->share_mode & COB_SHARE_NO_OTHER) - || (f->lock_mode & COB_FILE_EXCLUSIVE) ) { - p->lmode = LEXCLLOCK; - } else if ((f->lock_mode & COB_LOCK_AUTOMATIC) && mode != COB_OPEN_INPUT) { - p->lmode = LAUTOLOCK; - } else { - p->lmode = LMANULOCK; - } - - if (p->lmode == LEXCLLOCK) { - if (db->mysql) { - snprintf(buff,sizeof(buff),"LOCK TABLES %s %s",fx->tablename, - mode == COB_OPEN_INPUT?"READ":"WRITE"); - if (ociStmt(db,buff)) - return COB_STATUS_30_PERMANENT_ERROR; - } - } - - f->open_mode = mode; - f->last_open_mode = mode; - f->flag_nonexistent = 0; - f->flag_end_of_file = 0; - f->flag_begin_of_file = 0; - p->savekey = cob_malloc ((size_t)(p->maxkeylen + 1)); - p->saverec = cob_malloc ((size_t)(f->record_max + 1)); - for (k=0; k < fx->nmap; k++) { - if (fx->map[k].cmd == XC_DATA - && fx->map[k].colname) { - fx->map[k].hostType = SQLT_STR; - if (fx->map[k].dtfrm) { - fx->map[k].sqlType = SQLT_DAT; - } else if (fx->map[k].type == COB_XFDT_FLOAT) { - if (fx->map[k].size == sizeof(double)) - fx->map[k].hostType = SQLT_FLT; - else - fx->map[k].hostType = SQLT_FLT; - fx->map[k].sqlType = SQLT_FLT; - fx->map[k].sqlColSize = fx->map[k].size; - } else if (fx->map[k].type == COB_XFDT_BIN) { - fx->map[k].sqlColSize = fx->map[k].size; - fx->map[k].hostType = SQLT_BIN; - fx->map[k].sqlType = SQLT_BIN; - } else if (fx->map[k].valnum) { - fx->map[k].sqlType = SQLT_NUM; - } else { - fx->map[k].sqlType = SQLT_CHR; - } - } - } - DEBUG_LOG("db",("OPEN %s %s\n",optyp,f->select_name)); - - return COB_STATUS_00_SUCCESS; -} - -/* Close the INDEXED file */ - -static int -oci_close (cob_file_api *a, cob_file *f, const int opt) -{ - struct indexed_file *p; - struct file_xfd *fx; - int k; - - if (opt == COB_CLOSE_ABORT) { - oci_rollback (a, f); - } else - if (db->updatesDone > 0) { - db->updatesDone = db->commitInterval + 1; /* Force COMMIT */ - oci_commit (a, f); - } - p = f->file; - - if (p) { - if (p->fx) { - fx = p->fx; - oci_free_stmt (&fx->insert); - oci_free_stmt (&fx->delete); - oci_free_stmt (&fx->update); - oci_free_stmt (fx->start); - fx->start = NULL; - for (k=0; k < fx->nkeys; k++) { - oci_free_stmt (&fx->key[k]->where_eq); - oci_free_stmt (&fx->key[k]->where_ge); - oci_free_stmt (&fx->key[k]->where_gt); - oci_free_stmt (&fx->key[k]->where_le); - oci_free_stmt (&fx->key[k]->where_lt); - oci_free_stmt (&fx->key[k]->where_ne); - oci_free_stmt (&fx->key[k]->where_fi); - oci_free_stmt (&fx->key[k]->where_la); - } - cob_drop_xfd (fx); - } - cob_free (p); - } - f->file = NULL; - f->open_mode = COB_OPEN_CLOSED; - DEBUG_LOG("db",("CLOSE %s\n",f->select_name)); - - return COB_STATUS_00_SUCCESS; -} - - -/* START INDEXED file with positioning */ - -static int -oci_start (cob_file_api *a, cob_file *f, const int cond, cob_field *key) -{ - int ky, klen, partlen, paramtype; - struct indexed_file *p; - struct file_xfd *fx; - COB_UNUSED (a); - - ky = cob_findkey (f, key, &klen, &partlen); - if (ky < 0) { - DEBUG_LOG("db",("Start key not found!\n")); - return COB_STATUS_30_PERMANENT_ERROR; - } - p = f->file; - fx = p->fx; - p->startcond = cond; - f->curkey = ky; - paramtype = SQL_BIND_NO; - - oci_close_stmt (fx->start); - fx->start = NULL; - switch (cond) { - case COB_EQ: - case COB_NE: - fx->start = cob_sql_select (db, fx, ky, cond, 0, oci_free_stmt); - paramtype = SQL_BIND_EQ; - break; - case COB_GE: - case COB_GT: - case COB_LE: - case COB_LT: - fx->start = cob_sql_select (db, fx, ky, cond, 0, oci_free_stmt); - paramtype = SQL_BIND_WHERE; - break; - case COB_FI: - fx->start = cob_sql_select (db, fx, ky, cond, 0, oci_free_stmt); - paramtype = SQL_BIND_NO; - break; - case COB_LA: - fx->start = cob_sql_select (db, fx, ky, cond, 0, oci_free_stmt); - paramtype = SQL_BIND_NO; - break; - } - DEBUG_LOG("db",("Start %s index %d Bind %02X\n",f->select_name,ky,paramtype)); - cob_index_to_xfd (db, fx, f, ky); - oci_setup_stmt (db, fx, fx->start, SQL_BIND_COLS|paramtype, ky); - if (fx->start->status) { - fx->start = NULL; - cob_sql_dump_data (db, fx); - return COB_STATUS_30_PERMANENT_ERROR; - } - cob_sql_dump_stmt (db, fx->start->text, FALSE); - if (chkSts(db,(char*)"Start", - OCIStmtExecute(db->dbSvcH,fx->start->handle,db->dbErrH, - 0,0,NULL,NULL,OCI_DEFAULT))){ - return COB_STATUS_30_PERMANENT_ERROR; - } - - return COB_STATUS_00_SUCCESS; -} - -/* Random READ of the INDEXED file */ - -static int -oci_read (cob_file_api *a, cob_file *f, cob_field *key, const int read_opts) -{ - struct indexed_file *p; - struct file_xfd *fx; - struct map_xfd *col; - int k, ky, pos, klen, partlen; - int ret = COB_STATUS_00_SUCCESS; - COB_UNUSED (a); - - p = f->file; - fx = p->fx; - if (fx->fileorg == COB_ORG_RELATIVE) { - ky = 0; - } else { - ky = cob_findkey (f, key, &klen, &partlen); - if (ky < 0) { - return COB_STATUS_30_PERMANENT_ERROR; - } - } - f->curkey = ky; - p->startcond = -1; - if (fx->start) - oci_close_stmt (fx->start); - fx->start = cob_sql_select (db, fx, ky, COB_EQ, read_opts, oci_free_stmt); - oci_close_stmt (fx->start); - cob_index_to_xfd (db, fx, f, ky); - oci_set_nulls (db, fx); - oci_setup_stmt (db, fx, fx->start, SQL_BIND_COLS, 0); - if (fx->start->status) { - fx->start = NULL; - cob_sql_dump_data (db, fx); - return COB_STATUS_30_PERMANENT_ERROR; - } - pos = 0; - for (k=0; k < fx->key[ky]->ncols; k++) { - col = &fx->map[fx->key[ky]->col[k]]; - bindParam (db, fx, fx->start, col, ++pos); - } - if (chkSts(db,(char*)"Read Exec", - OCIStmtExecute(db->dbSvcH,fx->start->handle,db->dbErrH, - 0,0,NULL,NULL,OCI_DEFAULT))){ - if (db->dbStatus == db->dbStsNotFound) - return COB_STATUS_23_KEY_NOT_EXISTS; - if (db->dbStatus == 30006) - return COB_STATUS_61_FILE_SHARING; - return COB_STATUS_30_PERMANENT_ERROR; - } - if (chkSts(db,(char*)"Read", - OCIStmtFetch(fx->start->handle,db->dbErrH, - 1,OCI_FETCH_NEXT,OCI_DEFAULT))) { - DEBUG_LOG("db",("Read: %.40s...; Sts %d '%.5s'\n",fx->start->text, - db->dbStatus,db->odbcState)); - cob_sql_dump_stmt (db, fx->start->text, FALSE); - cob_sql_dump_index (db, fx, ky); - if (db->dbStatus == db->dbStsNotFound) - ret = COB_STATUS_23_KEY_NOT_EXISTS; - else if (db->dbStatus == 30006) - ret = COB_STATUS_61_FILE_SHARING; - else - ret = COB_STATUS_30_PERMANENT_ERROR; - } else { - DEBUG_LOG("db",("Read: %s; OK\n",f->select_name)); - oci_any_nulls (db, fx); - cob_sql_dump_data (db, fx); - cob_xfd_to_file (db, fx, f); - } - - return ret; -} - -/* Sequential READ of the INDEXED file */ - -static int -oci_read_next (cob_file_api *a, cob_file *f, const int read_opts) -{ - struct indexed_file *p; - struct file_xfd *fx; - int ky; - int opts = (int)read_opts & COB_READ_MASK; - int ret = COB_STATUS_00_SUCCESS; - COB_UNUSED (a); - - if (f->open_mode == COB_OPEN_CLOSED) - return COB_STATUS_49_I_O_DENIED; - p = f->file; - fx = p->fx; - if (f->curkey < 0) { - f->curkey = 0; - cob_index_clear (db, fx, f, 0); - opts = COB_READ_FIRST; - cob_sql_dump_index (db, fx, 0); - } - ky = f->curkey; - switch (opts & COB_READ_MASK) { - default: - case COB_READ_NEXT: - if (p->startcond != COB_GT) { - fx->start = cob_sql_select (db, fx, ky, COB_GT, read_opts, oci_free_stmt); - oci_close_stmt (fx->start); - oci_setup_stmt (db, fx, fx->start, SQL_BIND_COLS|SQL_BIND_WHERE, f->curkey); - if (chkSts(db,(char*)"Read Next Exec", - OCIStmtExecute(db->dbSvcH,fx->start->handle,db->dbErrH, - 0,0,NULL,NULL,OCI_DEFAULT))){ - return COB_STATUS_30_PERMANENT_ERROR; - } - p->startcond = COB_GT; - } - if (fx->start - && !fx->start->isdesc) { - if (chkSts(db,(char*)"Read Next", - OCIStmtFetch(fx->start->handle,db->dbErrH, - 1,OCI_FETCH_NEXT,OCI_DEFAULT))) { - DEBUG_LOG("db",("Read Next: %.50s; Sts %d\n",fx->start->text,db->dbStatus)); - if (db->dbStatus == db->dbStsNotFound) - ret = COB_STATUS_10_END_OF_FILE; - else - ret = COB_STATUS_30_PERMANENT_ERROR; - } else { - DEBUG_LOG("db",("Read Next: %s; OK\n",f->select_name)); - oci_any_nulls (db, fx); - cob_xfd_to_file (db, fx, f); - } - } else { - ret = COB_STATUS_10_END_OF_FILE; - } - break; - case COB_READ_PREVIOUS: - if (p->startcond != COB_LT) { - fx->start = cob_sql_select (db, fx, ky, COB_LT, read_opts, oci_free_stmt); - oci_close_stmt (fx->start); - oci_setup_stmt (db, fx, fx->start, SQL_BIND_COLS|SQL_BIND_WHERE, f->curkey); - if (chkSts(db,(char*)"Read Prev Exec", - OCIStmtExecute(db->dbSvcH,fx->start->handle,db->dbErrH, - 0,0,NULL,NULL,OCI_DEFAULT))){ - return COB_STATUS_30_PERMANENT_ERROR; - } - p->startcond = COB_LT; - } - if (fx->start - && fx->start->isdesc) { - if (chkSts(db,(char*)"Read Prev", - OCIStmtFetch(fx->start->handle,db->dbErrH, - 1,OCI_FETCH_NEXT,OCI_DEFAULT))) { - DEBUG_LOG("db",("Read Prev: %.50s; Sts %d\n",fx->start->text,db->dbStatus)); - if (db->dbStatus == db->dbStsNotFound) - ret = COB_STATUS_10_END_OF_FILE; - else - ret = COB_STATUS_30_PERMANENT_ERROR; - } else { - DEBUG_LOG("db",("Read Prev: %s; OK\n",f->select_name)); - oci_any_nulls (db, fx); - cob_xfd_to_file (db, fx, f); - } - } else { - ret = COB_STATUS_10_END_OF_FILE; - } - break; - case COB_READ_FIRST: - fx->start = cob_sql_select (db, fx, ky, COB_FI, read_opts, oci_free_stmt); - oci_close_stmt (fx->start); - oci_setup_stmt (db, fx, fx->start, SQL_BIND_COLS, 0); - if (fx->start->status) { - fx->start = NULL; - cob_sql_dump_data (db, fx); - return COB_STATUS_30_PERMANENT_ERROR; - } - p->startcond = COB_GT; - if (chkSts(db,(char*)"Exec First", - OCIStmtExecute(db->dbSvcH,fx->start->handle,db->dbErrH, - 0,0,NULL,NULL,OCI_DEFAULT))){ - return COB_STATUS_30_PERMANENT_ERROR; - } - if (chkSts(db,(char*)"Read First", - OCIStmtFetch(fx->start->handle,db->dbErrH, - 1,OCI_FETCH_NEXT,OCI_DEFAULT))) { - DEBUG_LOG("db",("Read First: %.50s; Sts %d\n",fx->start->text,db->dbStatus)); - if (db->dbStatus == db->dbStsNotFound) - ret = COB_STATUS_10_END_OF_FILE; - else - ret = COB_STATUS_30_PERMANENT_ERROR; - } else { - DEBUG_LOG("db",("Read First: %s; OK\n",f->select_name)); - oci_any_nulls (db, fx); - cob_xfd_to_file (db, fx, f); - } - break; - case COB_READ_LAST: - fx->start = cob_sql_select (db, fx, ky, COB_LA, read_opts, oci_free_stmt); - oci_close_stmt (fx->start); - oci_setup_stmt (db, fx, fx->start, SQL_BIND_COLS, 0); - if (fx->start->status) { - fx->start = NULL; - cob_sql_dump_data (db, fx); - return COB_STATUS_30_PERMANENT_ERROR; - } - if (chkSts(db,(char*)"Read Last", - OCIStmtExecute(db->dbSvcH,fx->start->handle,db->dbErrH, - 0,0,NULL,NULL,OCI_DEFAULT))){ - return COB_STATUS_30_PERMANENT_ERROR; - } - p->startcond = COB_LT; - if (chkSts(db,(char*)"Read Last", - OCIStmtFetch(fx->start->handle,db->dbErrH, - 1,OCI_FETCH_NEXT,OCI_DEFAULT))) { - DEBUG_LOG("db",("Read Last: %.50s; Sts %d\n",fx->start->text,db->dbStatus)); - if (db->dbStatus == db->dbStsNotFound) - ret = COB_STATUS_10_END_OF_FILE; - else - ret = COB_STATUS_30_PERMANENT_ERROR; - } else { - DEBUG_LOG("db",("Read Last: %s; OK\n",f->select_name)); - oci_any_nulls (db, fx); - cob_xfd_to_file (db, fx, f); - } - break; - } - - return ret; -} - - -/* WRITE to the INDEXED file */ - -static int -oci_write (cob_file_api *a, cob_file *f, const int opt) -{ - struct indexed_file *p; - struct file_xfd *fx; - int ret = COB_STATUS_00_SUCCESS; - COB_UNUSED (a); - - p = f->file; - fx = p->fx; - if (fx->insert.text == NULL) { - fx->insert.text = cob_sql_stmt (db, fx, (char*)"INSERT", 0, 0, 0); - } - - cob_file_to_xfd (db, fx, f); - - oci_set_nulls (db, fx); - if (!fx->insert.preped) { - oci_setup_stmt (db, fx, &fx->insert, SQL_BIND_PRMS, 0); - } - if (chkSts(db,(char*)"Exec INSERT", - OCIStmtExecute(db->dbSvcH,fx->insert.handle,db->dbErrH, - 1,0,NULL,NULL,OCI_DEFAULT))){ - if (db->dbStatus == db->dbStsDupKey) { - DEBUG_LOG("db",("%.60s Duplicate; Failed!\n",fx->insert.text)); - ret = COB_STATUS_22_KEY_EXISTS; - } else { - DEBUG_LOG("db",("OCIExecute %.40s status %d; Failed!\n",fx->insert.text,db->dbStatus)); - ret = COB_STATUS_30_PERMANENT_ERROR; - cob_sql_dump_data (db, fx); - } - return ret; - } - db->updatesDone++; - if (db->dbStatus != 0) { - DEBUG_LOG("db",("WRITE: %.40s... status %d; Not Good!\n",fx->insert.text,db->dbStatus)); - } else if (fx->fileorg == COB_ORG_RELATIVE) { - DEBUG_LOG("db",("WRITE: %.40s... Rec# %d; Good!\n",fx->insert.text,(int)f->cur_rec_num)); - } else { - DEBUG_LOG("db",("WRITE: %.40s... Good!\n",fx->insert.text)); - } - if (db->autocommit) - oci_commit (a,f); - - return ret; -} - - -/* DELETE record from the INDEXED file */ - -static int -oci_delete (cob_file_api *a, cob_file *f) -{ - struct indexed_file *p; - struct file_xfd *fx; - int k, pos; - int ret = COB_STATUS_00_SUCCESS; - COB_UNUSED (a); - - if (f->open_mode == COB_OPEN_INPUT - || f->open_mode == COB_OPEN_CLOSED) - return COB_STATUS_49_I_O_DENIED; - p = f->file; - fx = p->fx; - if (fx->delete.text == NULL) { - fx->delete.text = cob_sql_stmt (db, fx, (char*)"DELETE", 0, 0, 0); - } - - cob_index_to_xfd (db, fx, f, 0); - - if (!fx->delete.preped) { - oci_setup_stmt (db, fx, &fx->delete, SQL_BIND_NO, 0); - pos = 0; - for (k=0; k < fx->key[0]->ncols; k++) { - bindParam (db, fx, &fx->delete, &fx->map[fx->key[0]->col[k]], ++pos); - } - } - if (chkSts(db,(char*)"Exec DELETE", - OCIStmtExecute(db->dbSvcH,fx->delete.handle,db->dbErrH, - 1,0,NULL,NULL,OCI_DEFAULT))){ - DEBUG_LOG("db",("OCIExecute %.40s status %d; Failed!\n",fx->delete.text,db->dbStatus)); - if (db->dbStatus == db->dbStsNotFound) - ret = COB_STATUS_23_KEY_NOT_EXISTS; - else - ret = COB_STATUS_21_KEY_INVALID; - cob_sql_dump_data (db, fx); - return ret; - } - k = oci_row_count (db, &fx->delete); - if (k == 0) - ret = COB_STATUS_23_KEY_NOT_EXISTS; - else if (k > 1) - ret = COB_STATUS_30_PERMANENT_ERROR; - db->updatesDone++; - DEBUG_LOG("db",("DELETE: %s status %d; %d deleted, return %02d\n",f->select_name, - db->dbStatus,k,ret)); - if (db->autocommit) - oci_commit (a,f); - - return ret; -} - -/* REWRITE record to the INDEXED file */ - -static int -oci_rewrite (cob_file_api *a, cob_file *f, const int opt) -{ - struct indexed_file *p; - struct file_xfd *fx; - int k, pos; - int ret = COB_STATUS_00_SUCCESS; - COB_UNUSED (a); - - if (f->open_mode == COB_OPEN_INPUT - || f->open_mode == COB_OPEN_CLOSED) - return COB_STATUS_49_I_O_DENIED; - p = f->file; - fx = p->fx; - if (fx->update.text == NULL) { - fx->update.text = cob_sql_stmt (db, fx, (char*)"UPDATE", 0, 0, 0); - } - - cob_file_to_xfd (db, fx, f); - - oci_set_nulls (db, fx); - if (!fx->update.preped) { - oci_setup_stmt (db, fx, &fx->update, SQL_BIND_PRMS, 0); - pos = fx->update.bindpos; - for (k=0; k < fx->key[0]->ncols; k++) { - bindParam (db, fx, &fx->update, &fx->map[fx->key[0]->col[k]], ++pos); - } - } - if (chkSts(db,(char*)"Exec UPDATE", - OCIStmtExecute(db->dbSvcH,fx->update.handle,db->dbErrH, - 1,0,NULL,NULL,OCI_DEFAULT))){ - if (db->dbStatus == db->dbStsDupKey) { - DEBUG_LOG("db",("%.60s Duplicate; Failed!\n",fx->update.text)); - ret = COB_STATUS_22_KEY_EXISTS; - } else { - DEBUG_LOG("db",("OCIExecute %.40s status %d; Failed!\n",fx->update.text,db->dbStatus)); - ret = COB_STATUS_30_PERMANENT_ERROR; - cob_sql_dump_data (db, fx); - } - return ret; - } - k = oci_row_count (db, &fx->update); - if (k == 0) - ret = COB_STATUS_21_KEY_INVALID; - else if (k > 1) - ret = COB_STATUS_30_PERMANENT_ERROR; - db->updatesDone++; - DEBUG_LOG("db",("REWRITE: %s, status %d; %d updated, return %02d!\n",f->select_name, - db->dbStatus,k,ret)); - if (db->autocommit) - oci_commit (a,f); - - return ret; -} - - -static int -oci_file_unlock (cob_file_api *a, cob_file *f) -{ - COB_UNUSED (a); - COB_UNUSED (f); - - return 0; -} - -/* Call this routine when a new process has been forked */ -static int -oci_fork (cob_file_api *a) -{ - COB_UNUSED (a); - return 0; -} - -static void -oci_exit_fileio (cob_file_api *a) -{ - COB_UNUSED (a); -} - -void -cob_oci_init_fileio (cob_file_api *a) -{ - a->io_funcs[COB_IO_OCI] = (void*)&oci_indexed_funcs; -} - -#endif diff -Nru gnucobol-4.0~early~20200606/libcob/fodbc.c gnucobol-5/libcob/fodbc.c --- gnucobol-4.0~early~20200606/libcob/fodbc.c 2020-06-06 20:52:01.000000000 +0000 +++ gnucobol-5/libcob/fodbc.c 1970-01-01 00:00:00.000000000 +0000 @@ -1,1870 +0,0 @@ -/* - Copyright (C) 2002-2012, 2014-2020 Free Software Foundation, Inc. - Written by Keisuke Nishida, Roger While, Simon Sobisch, Ron Norman - - This file is part of GnuCOBOL. - - The GnuCOBOL runtime library is free software: you can redistribute it - and/or modify it under the terms of the GNU Lesser General Public License - as published by the Free Software Foundation, either version 3 of the - License, or (at your option) any later version. - - GnuCOBOL is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU Lesser General Public License for more details. - - You should have received a copy of the GNU Lesser General Public License - along with GnuCOBOL. If not, see . -*/ - - -/* Force symbol exports */ -#define COB_LIB_EXPIMP -#include "fileio.h" - -#ifdef WITH_ODBC -#ifdef WITH_OCI -#undef WITH_OCI -#endif - -#if defined(DB2DBI) -#include -#include -#include -#else -#include -#include -#endif - -void cob_odbc_init_fileio (cob_file_api *a); - -/* Local variables */ - -static int odbcStmt (struct db_state *db, char *stmt); -static int odbc_sync (cob_file_api *, cob_file *); -static int odbc_commit (cob_file_api *, cob_file *); -static int odbc_rollback (cob_file_api *, cob_file *); -static int odbc_open (cob_file_api *, cob_file *, char *, const int, const int); -static int odbc_close (cob_file_api *, cob_file *, const int); -static int odbc_start (cob_file_api *, cob_file *, const int, cob_field *); -static int odbc_read (cob_file_api *, cob_file *, cob_field *, const int); -static int odbc_read_next (cob_file_api *, cob_file *, const int); -static int odbc_write (cob_file_api *, cob_file *, const int); -static int odbc_delete (cob_file_api *, cob_file *); -static int odbc_file_delete (cob_file_api *, cob_file *, char *); -static int odbc_rewrite (cob_file_api *, cob_file *, const int); -static int odbc_file_unlock (cob_file_api *, cob_file *); -static void odbc_exit_fileio(cob_file_api *); -static int odbc_fork (cob_file_api *); - -static const struct cob_fileio_funcs odbc_indexed_funcs = { - odbc_open, - odbc_close, - odbc_start, - odbc_read, - odbc_read_next, - odbc_write, - odbc_rewrite, - odbc_delete, - odbc_file_delete, - cob_odbc_init_fileio, - odbc_exit_fileio, - odbc_fork, - odbc_sync, - odbc_commit, - odbc_rollback, - odbc_file_unlock -}; - -static int db_join = 1; -static struct db_state db[1]; -static int useDriverCursor = FALSE; -static int useIfneededCursor= TRUE; -static char varFetch[256]; -static char varFetch2[256]; - -struct indexed_file { - struct file_xfd *fx; - int startcond; - int maxkeylen; - int primekeylen; - enum { - LMANULOCK = 0, - LAUTOLOCK = 1, - LEXCLLOCK = 2, - } lmode; - unsigned char *savekey; /* Work area for saving key value */ - unsigned char *suppkey; /* Work area for saving key value */ - unsigned char *saverec; /* For saving copy of record */ -}; - -/* Local functions */ - -/* - Check if ODBC status is a fatal error of some kind -*/ -static int /* Return TRUE if some fatal error */ -chkOdbc(struct db_state *db) -{ - if(memcmp(db->odbcState, "23000", 5) == 0) { - db->dbStatus = db->dbStsDupKey; - return TRUE; - } - if(memcmp(db->odbcState, "23505", 5) == 0) { - db->dbStatus = db->dbStsDupKey; - return TRUE; - } - if(memcmp(db->odbcState,"07",2) == 0) { - db->dbStatus = db->dbFatalStatus = 1007; - return TRUE; - } - if(memcmp(db->odbcState,"08",2) == 0) { - db->dbStatus = db->dbFatalStatus = 1008; - return TRUE; - } - if(memcmp(db->odbcState,"21",2) == 0) { - db->dbStatus = db->dbFatalStatus = 1021; - return TRUE; - } - if(memcmp(db->odbcState,"22",2) == 0) { - if(memcmp(db->odbcState, "22007", 5) == 0 - || memcmp(db->odbcState, "22008", 5) == 0) { /* Bad DATE */ - db->dbStatus = db->dbStsInvlNum; - return TRUE; - } - if(memcmp(db->odbcState, "22003", 5) == 0) { /* Bad Number */ - db->dbStatus = db->dbStsInvlNum; - return TRUE; - } - db->dbStatus = db->dbFatalStatus = 1022; - return TRUE; - } - if(memcmp(db->odbcState,"22",2) == 0) { - db->dbStatus = db->dbFatalStatus = 1022; - return TRUE; - } - if(memcmp(db->odbcState,"24",2) == 0) { - db->dbStatus = db->dbFatalStatus = 1024; - return TRUE; - } - if(memcmp(db->odbcState,"25",2) == 0) { - db->dbStatus = db->dbFatalStatus = 1025; - return TRUE; - } - if(memcmp(db->odbcState,"28",2) == 0) { - db->dbStatus = db->dbFatalStatus = 1028; - return TRUE; - } - if(memcmp(db->odbcState,"34",2) == 0 - || memcmp(db->odbcState,"3C",2) == 0 - || memcmp(db->odbcState,"3D",2) == 0 - || memcmp(db->odbcState,"3F",2) == 0) { - db->dbStatus = db->dbFatalStatus = 1034; - return TRUE; - } - if(memcmp(db->odbcState,"42",2) == 0) { - db->dbStatus = db->dbFatalStatus = 1042; - return TRUE; - } - if(memcmp(db->odbcState,"44",2) == 0) { - db->dbStatus = db->dbFatalStatus = 1044; - return TRUE; - } - if(memcmp(db->odbcState,"HY",2) == 0) { - db->dbStatus = db->dbFatalStatus = 1098; - return TRUE; - } - if(memcmp(db->odbcState,"IM",2) == 0) { - db->dbStatus = db->dbFatalStatus = 1099; - return TRUE; - } - if(memcmp(db->odbcState, "S1T00", 5) == 0) { - db->dbStatus = db->dbFatalStatus = db->dbStsDeadLock; - return TRUE; - } - if(memcmp(db->odbcState, "40001", 5) == 0) { - db->dbStatus = db->dbFatalStatus = db->dbStsDeadLock; - return TRUE; - } - if(memcmp(db->odbcState, "S1", 2) == 0) { - db->dbStatus = db->dbFatalStatus = 1097; - return TRUE; - } - if(memcmp(db->odbcState, "01000", 5) == 0) { - return FALSE; - } - return FALSE; -} - -#define szErrMsg 512 -#define dbStsRetry (EAGAIN * 1000) -static int -getOdbcMsg( - struct db_state *db, - SQLHANDLE hndl, - int *errnum, - char *szState, - SQLINTEGER *odbcStatus, - char *errMsg, - int errMsgLen, - SQLSMALLINT *errLen) -{ - int sts,htype; - char lState[5+3]; - char *cp,msgtxt[szErrMsg + 10]; - if(hndl == db->dbEnvH) { - htype = SQL_HANDLE_ENV; - } else if(hndl == db->dbDbcH) { - htype = SQL_HANDLE_DBC; - } else { - htype = SQL_HANDLE_STMT; - } - sts = SQLGetDiagRec(htype,hndl,*errnum,(SQLCHAR*)lState,odbcStatus, - (SQLCHAR *)msgtxt,szErrMsg,errLen); - if(sts == SQL_SUCCESS) { - sprintf(szState,"%.5s",lState); - cp = msgtxt; - if(memcmp(cp,"[ma-",3) == 0) { - cp += 3; - *errLen = *errLen - 3; - while(*cp != ']') { - cp += 1; - *errLen = *errLen - 1; - } - cp += 1; - *errLen = *errLen - 1; - } - if (*cp == '[' && strstr(cp, "MariaDB]") != NULL) { - while(*cp != ']') { - cp += 1; - *errLen = *errLen - 1; - } - cp += 1; - *errLen = *errLen - 1; - } - if(memcmp(cp,"[unixODBC]",10) == 0) { - cp += 10; - *errLen = *errLen - 10; - } - if(memcmp(cp,"[Easysoft]",10) == 0) { - cp += 10; - *errLen = *errLen - 10; - } - if(memcmp(cp,"[SQL Server Driver",18) == 0) { - cp += 18; - *errLen = *errLen - 18; - while (*cp != ']') { - cp++; - *errLen = *errLen - 1; - } - if (*cp == ']') { - cp++; - *errLen = *errLen - 1; - } - } - if(memcmp(cp,"[SQL Server",11) == 0) { - cp += 11; - *errLen = *errLen - 11; - while (*cp != ']') { - cp++; - *errLen = *errLen - 1; - } - if (*cp == ']') { - cp++; - *errLen = *errLen - 1; - } - } - if(memcmp(cp,"[IBM]",5) == 0) { - cp += 5; - *errLen = *errLen - 5; - } - if(cp[*errLen-1] == '\n') - *errLen = *errLen - 1; - sprintf(errMsg,"%.*s",*errLen,cp); - } - *errnum = *errnum + 1; - return sts; -} - -/************************************************** - Check Status from an ODBC call - Return 0 if OK to proceed; - Return 1 if Not OK to proceed; -**************************************************/ -static int -chkSts( - struct db_state *db, - char *msg, - SQLHANDLE hndl, - int odbcSts) -{ - SQLINTEGER odbcStatus = 0; - int htype; - SQLSMALLINT errLen; - int i; - SQLCHAR szState[10]; - char errMsg[szErrMsg+16]; - - if(odbcSts == SQL_SUCCESS) { - db->dbStatus = 0; - memset(db->odbcState, 0, sizeof(db->odbcState)); - db->scanForNulls = FALSE; - return 0; - } - if(hndl == db->dbEnvH) { - htype = SQL_HANDLE_ENV; - } else if(hndl == db->dbDbcH) { - htype = SQL_HANDLE_DBC; - } else { - htype = SQL_HANDLE_STMT; - } - - if(msg == NULL) - msg = (void*)"?"; - - if(odbcSts == SQL_SUCCESS_WITH_INFO) { - db->dbStatus = 0; - db->scanForNulls = TRUE; - memset(errMsg,0,sizeof(errMsg)); - memset(szState,0,sizeof(szState)); - memset(db->odbcState, 0, sizeof(db->odbcState)); - i = 1; - getOdbcMsg(db,hndl,&i,(char*)szState,&odbcStatus,errMsg,szErrMsg,&errLen); - memcpy(db->odbcState, szState, 5); - DEBUG_LOG("db",("%.40s Status of %d '%.5s'\n", msg, db->dbStatus, szState)); - if(errMsg[0] >= ' ') - DEBUG_LOG("db",(" : %s\n",errMsg)); - while(TRUE) { - if(getOdbcMsg(db,hndl,&i,(char*)szState,&odbcStatus,errMsg,szErrMsg,&errLen) - != SQL_SUCCESS) - break; - } - return chkOdbc(db); - } - - if(odbcSts == SQL_NO_DATA) { - db->dbStatus = db->dbStsNotFound; - db->scanForNulls = FALSE; - if (htype == SQL_HANDLE_STMT) - SQLFreeStmt(hndl,SQL_CLOSE); - return db->dbStsNotFound; - } - - if(odbcSts == SQL_INVALID_HANDLE) { - db->dbStatus = SQL_INVALID_HANDLE; - db->scanForNulls = FALSE; - DEBUG_LOG("db",("Invalid Handle: %s\n",msg)); - return SQL_INVALID_HANDLE; - } - - memset(errMsg,0,sizeof(errMsg)); - if(hndl == NULL) { - db->dbStatus = odbcSts; - return 1; - } - - i = 1; - getOdbcMsg(db,hndl,&i,(char*)szState,&odbcStatus,errMsg,szErrMsg,&errLen); - if(odbcStatus < 0) - db->dbStatus = -odbcStatus; - else - db->dbStatus = odbcStatus; - - memset(db->odbcState, 0, sizeof(db->odbcState)); - memcpy(db->odbcState, szState, sizeof(db->odbcState)-1); - - if(db->dbStatus == 0 - && odbcSts == SQL_ERROR) { /* Catch ODBC ERROR when native status is 0 */ - db->dbStatus = SQL_ERROR; - } - if(memcmp(szState,"23000", 5) == 0 - || memcmp(szState,"23505",5) == 0) { - DEBUG_LOG("db",("%.40s Status of %d '%.5s'\n", msg, db->dbStatus, szState)); - if(errMsg[0] >= ' ') - DEBUG_LOG("db",(" : %s\n",errMsg)); - return db->dbStatus = db->dbStsDupKey; - } - - if(memcmp(szState,"HY000", 5) == 0 - && strstr(errMsg,"Connection is busy with results for another") != NULL) { - db->dbStatus = dbStsRetry; - DEBUG_LOG("db",("Busy connection: %s\n",msg)); - return dbStsRetry; - } - i = strlen(errMsg); - if (i > errLen) - i = errLen; - if(errMsg[i-1] == '\n') - errMsg[--i] = 0; - - if(db->dbStatus == db->dbStsNotFound2) /* MODE=ANSI 'Not found' */ - db->dbStatus = db->dbStsNotFound; /* Set internal 'Not found' status */ - else if(db->dbStatus == db->dbStsNullCol) /* Ignore NULL Column warning */ - db->dbStatus = 0; - else if(db->dbStatus == 2114) /* Ignore "Closing a closed cursor" */ - db->dbStatus = 0; - - if(db->dbStatus == 0) - return 0; - - if(memcmp(db->odbcState, "S1T00", 5) == 0) { - db->dbStatus = db->dbFatalStatus = db->dbStsDeadLock; - } else - if(memcmp(db->odbcState, "42000", 5) == 0 - || memcmp(db->odbcState, "07002", 5) == 0) { - DEBUG_LOG("db",("%.40s Status of %d '%.5s'\n", msg, db->dbStatus, szState)); - if(errMsg[0] >= ' ') - DEBUG_LOG("db",(" : %s\n",errMsg)); - return chkOdbc(db); - } - if(db->dbStatus == db->dbStsNoTable) { - DEBUG_LOG("db",("%.40s Status of %d '%.5s'\n", msg, db->dbStatus, szState)); - if(errMsg[0] >= ' ') - DEBUG_LOG("db",(" : %s\n",errMsg)); - return 1; - } - - if(db->dbStatus != 0 - && db->dbStatus != db->dbStsNotFound) { - if(db->dbStatus == db->dbStsRecLock /* FOR UPDATE NOWAIT and its held! */ - && db->intRecWait > 1000 - && db->nMaxRetry > 0) { - db->nRecWaitTry++; - sleep(db->intRecWait/1000); /* Pause a while */ - return 1; /* Skip logging error message */ - } - if(db->dbStatus == 3114 - || db->dbStatus == 3113) { - db->isopen = FALSE; - db->dbFatalStatus = db->dbStatus; - } else - if(db->dbFatalStatus == 0 - && db->dbStatus > 1000) { - db->dbFatalStatus = db->dbStatus; - } else { - chkOdbc(db); - } - DEBUG_LOG("db",("%.40s Status of %d '%.5s', fatal %d\n", - msg, db->dbStatus, szState, db->dbFatalStatus)); - if(errMsg[0] >= ' ') - DEBUG_LOG("db",(" : %s\n",errMsg)); - } - if ( (db->dbFatalStatus >= 0) - && (db->dbStatus < 0) - && (db->dbStatus != db->dbStsRecLock) - && (db->dbStatus != db->dbStsDupKey) - && (db->dbStatus != 1722) - && (db->dbStatus != 1410) - && (db->dbStatus != db->dbStsNotFound) ) { - db->dbFatalStatus = db->dbStatus; - } - - return 1; -} - -/**************************************************** - Bind just column to return data -****************************************************/ -static int -bindColumn( - struct db_state *db, - struct file_xfd *fx, - SQL_STMT *s, - struct map_xfd *col, - int pos) -{ - char msg[64]; - if (col->cmd == XC_DATA - && col->colname) { - col->hostType = SQL_C_CHAR; - if (col->dtfrm) { - col->sqlType = SQL_DATE; - } else if (col->type == COB_XFDT_FLOAT) { - if (col->size == sizeof(double)) - col->hostType = SQL_C_DOUBLE; - else - col->hostType = SQL_C_FLOAT; - col->sqlType = SQL_FLOAT; - col->sqlColSize = col->size; - } else if (col->type == COB_XFDT_BIN) { - col->sqlColSize = col->size; - col->hostType = SQL_C_BINARY; - col->sqlType = SQL_BINARY; - } else if (col->valnum) { - col->sqlType = SQL_DECIMAL; - } else { - col->sqlType = SQL_CHAR; - } - } - sprintf(msg,"BindColumn %s.%s Pos %d",fx->tablename,col->colname,pos); - if(chkSts(db,msg,s->handle, - SQLBindCol(s->handle, pos, col->hostType, - col->sdata, col->sqlsize, - (SQLPOINTER)col->ind))) { - return 1; - } - return 0; -} - -/**************************************************** - Bind just one column as parameter to statment -****************************************************/ -static int -bindParam( - struct db_state *db, - struct file_xfd *fx, - SQL_STMT *s, - struct map_xfd *col, - int pos) -{ - char msg[64]; - if (col->cmd == XC_DATA - && col->ind) { - if (col->setnull) { - *(SQLLEN*)col->ind = SQL_NULL_DATA; - } else { - *(SQLLEN*)col->ind = SQL_NTS; - } - } - sprintf(msg,"BindParam %s.%s Pos %d",fx->tablename,col->colname,pos); - if(chkSts(db,msg,s->handle, - SQLBindParameter(s->handle, - pos, SQL_PARAM_INPUT, col->hostType, col->sqlType, - col->sqlColSize, col->sqlDecimals, - col->sdata, col->sqlsize, - (SQLPOINTER)col->ind))) { - return 1; - } - return 0; -} - -static int -odbc_set_nulls ( - struct db_state *db, - struct file_xfd *fx) -{ - int k; - for (k=0; k < fx->nmap; k++) { - if (fx->map[k].cmd == XC_DATA - && fx->map[k].ind) { - if (fx->map[k].setnull) { - *(SQLLEN*)fx->map[k].ind = SQL_NULL_DATA; - } else { - *(SQLLEN*)fx->map[k].ind = SQL_NTS; - } - } - } - return 0; -} - -static int -odbc_any_nulls ( - struct db_state *db, - struct file_xfd *fx) -{ - int k; - for (k=0; k < fx->nmap; k++) { - if (fx->map[k].cmd == XC_DATA - && fx->map[k].ind) { - fx->map[k].sqlinlen = fx->map[k].sqlsize; - if(*(SQLLEN*)fx->map[k].ind == SQL_NULL_DATA) { - fx->map[k].setnull = TRUE; - } else if(*(SQLLEN*)fx->map[k].ind == SQL_NTS) { - fx->map[k].setnull = FALSE; - } else { - fx->map[k].setnull = FALSE; - fx->map[k].sqlinlen = *(SQLLEN*)fx->map[k].ind; - } - } - } - return 0; -} - -static int -odbc_setup_stmt ( - struct db_state *db, - struct file_xfd *fx, - SQL_STMT *s, - int bindtype, - int idx) -{ - int k,pos; - if (!s->handle) { - if(chkSts(db,(char*)"Alloc Stmt Handle",db->dbDbcH, - SQLAllocHandle(SQL_HANDLE_STMT,db->dbDbcH,&s->handle))){ - DEBUG_LOG("db",("SQLAllocHandle %.40s status %d; Failed!\n",s->text,db->dbStatus)); - s->status = db->dbStatus; - return db->dbStatus; - } - s->preped = FALSE; - s->bound = FALSE; - s->params = FALSE; - s->iscursor = FALSE; - } - if (!s->preped) { - if(chkSts(db,(char*)"Prepare Stmt",s->handle, - SQLPrepare(s->handle,(SQLCHAR*)s->text,strlen(s->text)))){ - DEBUG_LOG("db",("SQLPrepare %.40s status %d; Failed!\n",s->text,db->dbStatus)); - s->status = db->dbStatus; - return db->dbStatus; - } - s->preped = TRUE; - } - if (!s->params - && (bindtype & SQL_BIND_PRMS)) { - pos = 0; - for (k=0; k < fx->nmap; k++) { - if (fx->map[k].cmd == XC_DATA - && fx->map[k].colname) { - bindParam (db, fx, s, &fx->map[k], ++pos); - } - } - s->bindpos = pos; - s->params = TRUE; - } else - if (!s->bound - && (bindtype & SQL_BIND_COLS)) { - pos = 0; - for (k=0; k < fx->nmap; k++) { - if (fx->map[k].cmd == XC_DATA - && fx->map[k].colname) { - bindColumn (db, fx, s, &fx->map[k], ++pos); - } - } - s->bindpos = 0; - s->bound = TRUE; - } - - if ((bindtype & SQL_BIND_EQ)) { /* Index columns bind once each */ - pos = s->bindpos; - for (k=0; k < fx->key[idx]->ncols; k++) { - bindParam (db, fx, s, &fx->map[fx->key[idx]->col[k]], ++pos); - } - } else if ((bindtype & SQL_BIND_WHERE)) { /* Index Columns for complex WHERE */ - pos = s->bindpos; - for (k=0; k < fx->key[idx]->ncols-1; k++) { - bindParam (db, fx, s, &fx->map[fx->key[idx]->col[k]], ++pos); - bindParam (db, fx, s, &fx->map[fx->key[idx]->col[k]], ++pos); - } - bindParam (db, fx, s, &fx->map[fx->key[idx]->col[k]], ++pos); - } - s->status = 0; - return 0; -} - -static int -odbc_row_count ( - struct db_state *db, - SQL_STMT *s) -{ - SQLLEN count; - count = -1; - SQLRowCount (s->handle, &count); - return (int)count; -} - -static void -odbc_close_stmt ( SQL_STMT *s) -{ - if (s == NULL - || s->handle == NULL) - return; - SQLFreeStmt(s->handle,SQL_CLOSE); - s->iscursor = FALSE; - s->status = 0; - return; -} - -static void -odbc_free_stmt ( SQL_STMT *s) -{ - if (s == NULL - || s->handle == NULL) - return; - SQLFreeStmt(s->handle,SQL_CLOSE); - SQLFreeHandle(SQL_HANDLE_STMT, s->handle); - s->handle = NULL; - s->preped = FALSE; - s->bound = FALSE; - s->params = FALSE; - s->iscursor = FALSE; - s->status = 0; - s->readopts = 0; - if (s->text) - cob_free (s->text); - s->text = NULL; - return; -} - -static int -odbc_commit (cob_file_api *a, cob_file *f) -{ - COB_UNUSED (a); - COB_UNUSED (f); - if (!db->isopen) - return 0; - if (f->last_operation == COB_LAST_COMMIT) { - DEBUG_LOG("db",("COMMIT from application!\n")); - if (db->autocommit) { - if (db->mysql) { - odbcStmt (db, (char*)"COMMIT"); - odbcStmt (db, (char*)"SET autocommit=0"); - odbcStmt (db, (char*)"BEGIN"); - } else - if (chkSts(db,(char*)"AUTO COMMIT OFF",db->dbDbcH, - SQLSetConnectAttr(db->dbDbcH,SQL_ATTR_AUTOCOMMIT, - (SQLPOINTER)SQL_AUTOCOMMIT_OFF,SQL_IS_UINTEGER))) { - DEBUG_LOG("db",("AutoCommit Off status %d; Failed!\n",db->dbStatus)); - return COB_STATUS_30_PERMANENT_ERROR; - } - DEBUG_LOG("db",("AutoCommit is OFF!\n")); - } - db->autocommit = FALSE; - db->updatesDone = 0; - return 0; - } else if (db->updatesDone < db->commitInterval - && f->last_operation != COB_LAST_CLOSE) - return 0; - if (db->mysql) { - odbcStmt (db, (char*)"COMMIT"); - odbcStmt (db, (char*)"SET autocommit=0"); - odbcStmt (db, (char*)"BEGIN"); - } else { - if (chkSts(db,(char*) "Commit EndTran ENV",db->dbEnvH, - SQLEndTran(SQL_HANDLE_ENV,db->dbEnvH,SQL_COMMIT))) { - db->updatesDone = 0; - return COB_STATUS_30_PERMANENT_ERROR; - } - if (chkSts(db, (char*)"Commit EndTran DBC",db->dbDbcH, - SQLEndTran(SQL_HANDLE_DBC,db->dbDbcH,SQL_COMMIT))) { - db->updatesDone = 0; - return COB_STATUS_30_PERMANENT_ERROR; - } - } - if (db->updatesDone < BIGCOMMIT) - DEBUG_LOG("db",("%s Commit %d updates\n",db->dbType,db->updatesDone)); - db->updatesDone = 0; - return 0; -} - -static int -odbc_rollback (cob_file_api *a, cob_file *f) -{ - COB_UNUSED (a); - COB_UNUSED (f); - if (!db->isopen) - return 0; - if (f->last_operation == COB_LAST_ROLLBACK) { - DEBUG_LOG("db",("ROLLBACK from application!\n")); - if (db->mysql) { - odbcStmt (db, (char*)"ROLLBACK"); - odbcStmt (db, (char*)"SET autocommit=0"); - odbcStmt (db, (char*)"BEGIN"); - } else - if (db->autocommit) { - if (chkSts(db,(char*)"AUTO COMMIT OFF",db->dbDbcH, - SQLSetConnectAttr(db->dbDbcH,SQL_ATTR_AUTOCOMMIT, - (SQLPOINTER)SQL_AUTOCOMMIT_OFF,SQL_IS_UINTEGER))) { - DEBUG_LOG("db",("AutoCommit Off status %d; Failed!\n",db->dbStatus)); - return COB_STATUS_30_PERMANENT_ERROR; - } - DEBUG_LOG("db",("AutoCommit is OFF!\n")); - } - db->autocommit = FALSE; - } else if (db->updatesDone < db->commitInterval) - return 0; - if (db->mysql) { - odbcStmt (db, (char*)"ROLLBACK"); - odbcStmt (db, (char*)"SET autocommit=0"); - odbcStmt (db, (char*)"BEGIN"); - } else { - if (chkSts(db,(char*) "Rollback EndTran ENV",db->dbEnvH, - SQLEndTran(SQL_HANDLE_ENV,db->dbEnvH,SQL_ROLLBACK))) { - db->updatesDone = 0; - return COB_STATUS_30_PERMANENT_ERROR; - } - if (chkSts(db, (char*)"Rollback EndTran DBC",db->dbDbcH, - SQLEndTran(SQL_HANDLE_DBC,db->dbDbcH,SQL_ROLLBACK))) { - db->updatesDone = 0; - return COB_STATUS_30_PERMANENT_ERROR; - } - } - db->updatesDone = 0; - if (f->last_operation != COB_LAST_ROLLBACK) { - DEBUG_LOG("db",("%s Rollback %d updates\n",db->dbType,db->updatesDone)); - } - return 0; -} - -static int -odbc_sync (cob_file_api *a, cob_file *f) -{ - if (!db->isopen) - return 0; - if (chkSts(db,(char*) "Commit EndTran ENV",db->dbEnvH, - SQLEndTran(SQL_HANDLE_ENV,db->dbEnvH,SQL_COMMIT))) - return COB_STATUS_30_PERMANENT_ERROR; - if (chkSts(db, (char*)"Commit EndTran DBC",db->dbDbcH, - SQLEndTran(SQL_HANDLE_DBC,db->dbDbcH,SQL_COMMIT))) - return COB_STATUS_30_PERMANENT_ERROR; - return 0; -} - -/**************************************************** - Issue one simple SQL statment, no variables - Return 0 if OK to proceed; - Return !0 if Not OK to proceed; -*****************************************************/ -static int -odbcStmt( - struct db_state *db, - char *stmt) -{ - SQLHSTMT stmtHndl; - int k, len, rtn = 0; - char msg[80]; - - if(chkSts(db,(char*)"Alloc stmtHndl",db->dbDbcH, - SQLAllocHandle( SQL_HANDLE_STMT, db->dbDbcH, &stmtHndl ))) { - DEBUG_LOG("db",("SQLAllocHandle %s status %d; Failed!\n",stmt,db->dbStatus)); - return db->dbStatus; - } - - len = strlen(stmt); - snprintf(msg,sizeof(msg),"Exec: %.50s",stmt); - db->dbStatus = 0; - if(chkSts(db,msg,stmtHndl, - SQLExecDirect(stmtHndl,(SQLCHAR*)stmt, len))) { - rtn = db->dbStatus; - DEBUG_LOG("db",("Stmt: %.50s; Sts %d\n",stmt,db->dbStatus)); - } else if(strncasecmp(stmt,"SELECT ",7) != 0) { - DEBUG_LOG("db",("Exec: %.50s; OK\n",stmt)); - } - if (rtn == 0 - && strncasecmp(stmt,"SELECT ",7) == 0) { - chkSts(db,(char*)"Bind Var",stmtHndl, - SQLBindCol(stmtHndl, 1, SQL_C_CHAR, varFetch, sizeof(varFetch)-1, NULL)); - memset(varFetch,0,sizeof(varFetch)); - if(chkSts(db,(char*)"Fetch Stmt",stmtHndl, SQLFetch(stmtHndl))) { - DEBUG_LOG("db",("Fetch: %.50s; Sts %d\n",stmt,db->dbStatus)); - rtn = db->dbStatus; - } else { - varFetch[sizeof(varFetch)-1] = 0; - for (k=0; k < sizeof(varFetch) && varFetch[k] != 0; k++) { - if (varFetch[k] == '\r' - || varFetch[k] == '\t') - varFetch[k] = ' '; - if (varFetch[k] == '\n') { - varFetch[k++] = 0; - strcpy(varFetch2,&varFetch[k]); - break; - } - } - DEBUG_LOG("db",("Fetch: %.50s; OK\n",stmt)); - DEBUG_LOG("db",("'%s'\n",varFetch)); - } - } - SQLFreeHandle(SQL_HANDLE_STMT, stmtHndl); - return rtn; -} - -static void -odbc_create_table ( - struct db_state *db, - struct file_xfd *fx) -{ - int k; - cob_load_ddl (db, fx); - if (fx->create_table == NULL) { - db->dbStatus = db->dbStsNoTable; - return; - } - if (odbcStmt (db, fx->create_table)) { - DEBUG_LOG ("db",("%s\n",fx->create_table)); - db->dbStatus = db->dbStsNoTable; - return; - } - if (fx->fileorg == COB_ORG_RELATIVE) - return; - for (k=0; k < fx->nkeys && fx->key[k]->create_index; k++) { - if (odbcStmt (db, fx->key[k]->create_index)) { - DEBUG_LOG ("db",("%s\n",fx->key[k]->create_index)); - db->dbStatus = db->dbStsNoTable; - return; - } - } -} - -/* INDEXED */ - -static void -join_environment (cob_file_api *a) -{ - char *env, tmp[256]; - SQLSMALLINT len; - - db_join = -1; - memset(db,0,sizeof(struct db_state)); - db->dbStsOk = 0; - db->dbStsDupKey = 2601; - db->dbStsNotFound = SQL_NO_DATA; - db->dbStsNotFound2 = SQL_NO_DATA; - db->dbStsRecLock = -54999; /* No such status for SQL Server */ - db->dbStsNoTable = 1146; - db->isodbc = TRUE; - db->updatesDone = 0; - strcpy(db->dbType,"ODBC"); -#ifdef WITH_DB2 - db->dbStsRecLock = -54999; /* No such status for SQL Server */ - db->isodbc = TRUE; - db->db2 = TRUE; - strcpy(db->dbType,"DB2"); -#endif - db->dbStsDeadLock = 1205; - db->dbStsNoSpace = 1653; - db->dbStsNullCol = 1405; - db->dbStsInvlNum = 1722; - db->dbStsBadRowid = 1410; - if(chkSts(db,(char*)"Alloc Env",NULL, - SQLAllocHandle( SQL_HANDLE_ENV, SQL_NULL_HANDLE, &db->dbEnvH ))) { - DEBUG_LOG("db",("SQLAllocHandle Env status %d; Failed!\n",db->dbStatus)); - return; - } - if(chkSts(db,(char*)"ODBC VER",db->dbEnvH, - SQLSetEnvAttr(db->dbEnvH,SQL_ATTR_ODBC_VERSION,(SQLPOINTER)SQL_OV_ODBC3,SQL_IS_UINTEGER))) { - DEBUG_LOG("db",("SQLSetEnvAttr Ver status %d; Failed!\n",db->dbStatus)); - return; - } - if(chkSts(db,(char*)"Alloc DBC",db->dbEnvH, - SQLAllocHandle( SQL_HANDLE_DBC, db->dbEnvH, &db->dbDbcH ))) { - DEBUG_LOG("db",("SQLAllocHandle DBC status %d; Failed!\n",db->dbStatus)); - return; - } - if((env=getSchemaEnvName(db,tmp,"_DSN",db->dbDsn)) != NULL) { - DEBUG_LOG("db",("Env: %s -> %s\n",tmp,env)); - } - if((env=getSchemaEnvName(db,tmp,"_UID",db->dbUser)) != NULL) { - DEBUG_LOG("db",("Env: %s -> %s\n",tmp,env)); - } - if((env=getSchemaEnvName(db,tmp,"_PWD",db->dbPwd)) != NULL) { - DEBUG_LOG("db",("Env: %s -> %s\n",tmp,env)); - } - if((env=getSchemaEnvName(db,tmp,"_CON",db->dbCon)) != NULL) { - DEBUG_LOG("db",("Env: %s -> %s\n",tmp,env)); - } - if((env=getSchemaEnvName(db,tmp,"_COMMIT",NULL)) != NULL) { - DEBUG_LOG("db",("Env: %s -> %s\n",tmp,env)); - db->commitInterval = atoi(env); - } else { - db->commitInterval = (int)BIGCOMMIT; - } -#if !defined(WITH_DB2) - if(useDriverCursor) { - if(chkSts(db,(char*)"ODBC CURSOR",db->dbEnvH, - SQLSetConnectAttr(db->dbDbcH,SQL_ATTR_ODBC_CURSORS , - (SQLPOINTER)SQL_CUR_USE_DRIVER,SQL_IS_UINTEGER))) { - DEBUG_LOG("db",("ODBC Cursor status %d; Failed!\n",db->dbStatus)); - return; - } - } else if(useIfneededCursor) { - if(chkSts(db,(char*)"ODBC CURSOR",db->dbEnvH, - SQLSetConnectAttr(db->dbDbcH,SQL_ATTR_ODBC_CURSORS , - (SQLPOINTER)SQL_CUR_USE_IF_NEEDED,SQL_IS_UINTEGER))) { - DEBUG_LOG("db",("ODBC Cursor status %d; Failed!\n",db->dbStatus)); - return; - } - } else { - if(chkSts(db,(char*)"ODBC CURSOR",db->dbEnvH, - SQLSetConnectAttr(db->dbDbcH,SQL_ATTR_ODBC_CURSORS , - (SQLPOINTER)SQL_CUR_USE_ODBC,SQL_IS_UINTEGER))) { - DEBUG_LOG("db",("ODBC Cursor status %d; Failed!\n",db->dbStatus)); - return; - } - } - if(db->dbCon[0] > ' ') { - len = (SQLSMALLINT)sprintf(tmp,"%s",db->dbCon); - if(chkSts(db, (char*)"Driver Connect", db->dbDbcH, - SQLDriverConnect(db->dbDbcH, NULL, - (SQLCHAR*)tmp, SQL_NTS, - (SQLCHAR*)tmp, sizeof(tmp), - &len, (SQLSMALLINT)SQL_DRIVER_NOPROMPT) ) ) { - DEBUG_LOG("db",("SQLDriverConnect status %d; Failed!\n",db->dbStatus)); - DEBUG_LOG("db",(" DriverConnect[%s]\n",db->dbCon)); - db->isopen = FALSE; /* Data Base is NOT connected */ - if(db->dbDbcH) { - SQLDisconnect( db->dbDbcH ); - SQLFreeHandle( SQL_HANDLE_DBC, db->dbDbcH); - db->dbDbcH = NULL; - } - if(db->dbEnvH) { - SQLFreeHandle( SQL_HANDLE_ENV, db->dbEnvH); - db->dbEnvH = NULL; - } - return; - } - } else -#endif - if(db->dbDsn[0] > ' ' - && (db->dbUser[0] <= ' ' || db->dbPwd[0] <= ' ')) { /* Connect with DSN name only */ - if(chkSts(db, (char*)"Connect DSN", db->dbDbcH, - SQLConnect(db->dbDbcH, - (SQLCHAR*)db->dbDsn,strlen(db->dbDsn), - NULL, 0, - NULL, 0))) { - DEBUG_LOG("db",("SQLConnect DSN '%s' status %d; Failed!\n", - db->dbDsn,db->dbStatus)); - db->isopen = FALSE; /* Data Base is NOT connected */ - if(db->dbDbcH) { - SQLDisconnect( db->dbDbcH ); - SQLFreeHandle( SQL_HANDLE_DBC, db->dbDbcH); - db->dbDbcH = NULL; - } - if(db->dbEnvH) { - SQLFreeHandle( SQL_HANDLE_ENV, db->dbEnvH); - db->dbEnvH = NULL; - } - return; - } - } else { - if(db->dbDsn[0] <= ' ' - || db->dbUser[0] <= ' ' - || db->dbPwd[0] <= ' ') { - DEBUG_LOG("db",("~ERROR ODBC Connection is not defined\n")); - logSchemaEnvName (db, "_NAME"); - logSchemaEnvName (db, "_DSN"); - logSchemaEnvName (db, "_UID"); - db->dbStatus = -99; - db->isopen = FALSE; /* Data Base is NOT connected */ - if(db->dbDbcH) { - SQLDisconnect( db->dbDbcH ); - SQLFreeHandle( SQL_HANDLE_DBC, db->dbDbcH); - db->dbDbcH = NULL; - } - if(db->dbEnvH) { - SQLFreeHandle( SQL_HANDLE_ENV, db->dbEnvH); - db->dbEnvH = NULL; - } - return; - } - - if(chkSts(db, (char*)"Session Connect", db->dbDbcH, - SQLConnect(db->dbDbcH, - (SQLCHAR*)db->dbDsn,strlen(db->dbDsn), - (SQLCHAR*)db->dbUser,strlen(db->dbUser), - (SQLCHAR*)db->dbPwd, strlen(db->dbPwd)))) { - DEBUG_LOG("db",("SQLConnect status %d; Failed!\n",db->dbStatus)); - DEBUG_LOG("db",("DSN: %s, UID: %s, PWD: %s\n",db->dbDsn,db->dbUser,db->dbPwd)); - db->isopen = FALSE; /* Data Base is NOT connected */ - if(db->dbDbcH) { - SQLDisconnect( db->dbDbcH ); - SQLFreeHandle( SQL_HANDLE_DBC, db->dbDbcH); - db->dbDbcH = NULL; - } - if(db->dbEnvH) { - SQLFreeHandle( SQL_HANDLE_ENV, db->dbEnvH); - db->dbEnvH = NULL; - } - return; - } - } - if(db->dbStatus == -1017 - || db->dbStatus == 1017) { /* Invalid User/pass */ - DEBUG_LOG("db",(" %s: User %s, Pwd %s\n",db->dbType,db->dbUser,db->dbPwd)); - return; - } - if(db->dbStatus) { - DEBUG_LOG("db",("SessionBegin status %d; Failed!\n",db->dbStatus)); - DEBUG_LOG("db",("%s: User %s, Pwd %s\n",db->dbType,db->dbUser,db->dbPwd)); - return; - } - if(db->db2) { - DEBUG_LOG("db",("DB2 Connect: DSN: %s, User %s, Pwd %s\n", - db->dbDsn,db->dbUser,db->dbPwd)); - } - if(db->arrayFetch > 1) { - char amsg[40]; - if(db->arrayFetch > 1) - sprintf(amsg,"; Array fetch %d",db->arrayFetch); - else - strcpy(amsg,""); - DEBUG_LOG("db",("%s: Version %s %s\n", - db->dbType,"Experimental",amsg)); - } - - if((env=getSchemaEnvName(db,tmp,"_TRC",NULL)) != NULL) { - if(odbcStmt(db,(char*)"ALTER SESSION SET SQL_TRACE = TRUE")) - return; - } - if(db->oracle) { - /* The DMS Emulation code uses DECIMAL POINT internally */ - if(odbcStmt(db,(char*)"ALTER SESSION SET NLS_NUMERIC_CHARACTERS = '.,'")) { - return; - } - - /* Set The default format for handling DATE fields */ - if(db->dateFormat != NULL - && strlen(db->dateFormat) > 0) { - DEBUG_LOG("db",("NOTE: Default DATE field format is '%s'\n",db->dateFormat)); - sprintf(tmp,"ALTER SESSION SET NLS_DATE_FORMAT = '%s'",db->dateFormat); - if(odbcStmt(db,tmp)) { - return; - } - } - - } - - if(db->oracle) { - if(odbcStmt(db,(char*)"ALTER SESSION SET OPTIMIZER_MODE = FIRST_ROWS")) { - return; - } - } - - db->autocommit = FALSE; - db_join = 0; /* All connect steps completed */ - DEBUG_LOG("db",("%s successful connection\n",db->dbType)); - if(odbcStmt(db,(char*)"SELECT @@version")) { - return; - } else { - if (strcasestr(varFetch,"MariaDB")) { - db->mssql = FALSE; - db->db2 = FALSE; - db->mysql = TRUE; - db->mariadb = TRUE; - strcpy(db->dbType,"ODBC MariaDB"); - } else if (strcasestr(varFetch,"MySQL")) { - db->mssql = FALSE; - db->db2 = FALSE; - db->mysql = TRUE; - db->mariadb = FALSE; - strcpy(db->dbType,"ODBC MySQL"); - } else if (strcasestr(varFetch,"Microsoft SQL")) { - db->mssql = TRUE; - db->db2 = FALSE; - db->mysql = FALSE; - db->mariadb = FALSE; - db->dbStsNoTable = 4701; - db->dbVer = 2008; - if ((env = strcasestr(varFetch,"Server")) != NULL) { - env += 7; - if (isdigit(*env)) - db->dbVer = atoi(env); - } - snprintf(db->dbType,sizeof(db->dbType),"ODBC MSSQL %d",db->dbVer); - if (db->dbVer == 2012) { - if ((env = strcasestr(varFetch,"SQL Server 2012 (SP1)")) != NULL) { - db->mssqlnfu = TRUE; - } - } else if (db->dbVer < 2012) { - db->mssqlnfu = TRUE; - } - } else if (strcasestr(varFetch,"DB2")) { - db->mssql = FALSE; - db->db2 = TRUE; - db->mysql = FALSE; - db->mariadb = FALSE; - strcpy(db->dbType,"DB2"); - } - } - db->isopen = TRUE; - - /* Default to AUTO COMMIT ON */ - if (db->mysql) { - odbcStmt (db, (char*)"SET autocommit=1"); - } else { - if(chkSts(db,(char*)"AUTO COMMIT ON",db->dbDbcH, - SQLSetConnectAttr(db->dbDbcH,SQL_ATTR_AUTOCOMMIT, - (SQLPOINTER)SQL_AUTOCOMMIT_ON,SQL_IS_UINTEGER))) { - return; - } - } - DEBUG_LOG("db",("%s: AutoCommit is ON!\n",db->dbType)); - db->autocommit = TRUE; -} - -/* Delete file */ -static int -odbc_file_delete (cob_file_api *a, cob_file *f, char *filename) -{ - struct indexed_file *p; - char buff[COB_FILE_MAX+1]; - struct file_xfd *fx; - - DEBUG_LOG("db",("DELETE FILE %s\n",f->select_name)); - if (db_join) { /* Join DataBase, on first OPEN of INDEXED file */ - join_environment (a); - if (db_join < 0) { - return COB_STATUS_30_PERMANENT_ERROR; - } - } - if (f->file == NULL) { - fx = cob_load_xfd (f, NULL, sizeof(SQLLEN)); - if (fx == NULL) { - return COB_STATUS_30_PERMANENT_ERROR; - } - fx->gentable = a->setptr->cob_create_table; - p = cob_malloc (sizeof (struct indexed_file)); - f->file = p; - f->flag_file_lock = 0; - f->curkey = -1; - p->fx = fx; - } - p = f->file; - fx = p->fx; - snprintf(buff,sizeof(buff),"DROP TABLE %s",fx->tablename); - if (f->open_mode == COB_OPEN_CLOSED) { - odbc_close (a, f, 0); - } - DEBUG_LOG("db",("%s\n",buff)); - if (odbcStmt(db,buff) - && (db->dbStatus == db->dbStsNoTable - || db->dbStatus == 1042)) { - return 0; - } - if (db->dbStatus != db->dbStsOk) { - return COB_STATUS_30_PERMANENT_ERROR; - } - - return 0; -} - -/* OPEN INDEXED file */ -static int -odbc_open (cob_file_api *a, cob_file *f, char *filename, const int mode, const int sharing) -{ - struct indexed_file *p; - int i, k, ln; - char buff[COB_FILE_MAX+1]; -#ifdef COB_DEBUG_LOG - const char *optyp = "?"; -#endif - struct file_xfd *fx; - - fx = cob_load_xfd (f, NULL, sizeof(SQLLEN)); - if (fx == NULL) { - return COB_STATUS_30_PERMANENT_ERROR; - } - fx->gentable = a->setptr->cob_create_table; - if (db_join) { /* Join DataBase, on first OPEN of INDEXED file */ - join_environment (a); - if (db_join < 0) { - return COB_STATUS_30_PERMANENT_ERROR; - } - } -#ifdef COB_DEBUG_LOG - if (mode == COB_OPEN_INPUT) - optyp = "INPUT"; - else if (mode == COB_OPEN_I_O) - optyp = "IO"; - else if (mode == COB_OPEN_OUTPUT) - optyp = "OUTPUT"; - else - optyp = "EXTEND"; -#endif - - p = cob_malloc (sizeof (struct indexed_file)); - f->file = p; - f->flag_file_lock = 0; - f->curkey = -1; - p->startcond = -1; - p->fx = fx; - p->primekeylen = db_keylen (f, 0); - p->maxkeylen = p->primekeylen; - for (i=1; i < MAXNUMKEYS && i < f->nkeys; i++) { - ln = db_keylen (f, i); - if (ln < 0) - break; - if (ln > p->maxkeylen) - p->maxkeylen = ln; - } - - switch (mode) { - case COB_OPEN_OUTPUT: - snprintf(buff,sizeof(buff),"TRUNCATE TABLE %s",fx->tablename); - if (odbcStmt(db,buff) - && (db->dbStatus == db->dbStsNoTable - || db->dbStatus == 1042)) { - odbc_create_table (db, fx); - } - if (db->dbStatus != db->dbStsOk) { - return COB_STATUS_30_PERMANENT_ERROR; - } - break; - case COB_OPEN_I_O: - case COB_OPEN_INPUT: - case COB_OPEN_EXTEND: - snprintf(buff,sizeof(buff),"SELECT 1 FROM %s WHERE 1 = 0",fx->tablename); - if (odbcStmt(db,buff) - && (db->dbStatus == db->dbStsNoTable - || db->dbStatus == 1042)) { - odbc_create_table (db, fx); - if (db->dbStatus != db->dbStsOk) - return COB_STATUS_30_PERMANENT_ERROR; - } else if (db->dbStatus != db->dbStsNotFound) { - return COB_STATUS_30_PERMANENT_ERROR; - } - break; - } - - snprintf(buff,sizeof(buff),"SELECT MAX(rid_%s) FROM %s",fx->tablename,fx->tablename); - strcpy(varFetch,"0"); - if (mode != COB_OPEN_OUTPUT - && !odbcStmt(db,(char*)buff)) { - f->max_rec_num = atol (varFetch); - } - - if ((f->share_mode & COB_SHARE_NO_OTHER) - || (f->lock_mode & COB_FILE_EXCLUSIVE) ) { - p->lmode = LEXCLLOCK; - } else if ((f->lock_mode & COB_LOCK_AUTOMATIC) && mode != COB_OPEN_INPUT) { - p->lmode = LAUTOLOCK; - } else { - p->lmode = LMANULOCK; - } - - if (p->lmode == LEXCLLOCK) { - if(db->mysql) { - snprintf(buff,sizeof(buff),"LOCK TABLES %s %s",fx->tablename, - mode == COB_OPEN_INPUT?"READ":"WRITE"); - if(odbcStmt(db,buff)) - return COB_STATUS_30_PERMANENT_ERROR; - } - } - - f->open_mode = mode; - f->last_open_mode = mode; - f->flag_nonexistent = 0; - f->flag_end_of_file = 0; - f->flag_begin_of_file = 0; - p->savekey = cob_malloc ((size_t)(p->maxkeylen + 1)); - p->saverec = cob_malloc ((size_t)(f->record_max + 1)); - for (k=0; k < fx->nmap; k++) { - if (fx->map[k].cmd == XC_DATA - && fx->map[k].colname) { - fx->map[k].hostType = SQL_C_CHAR; - if (fx->map[k].dtfrm) { - fx->map[k].sqlType = SQL_DATE; - } else if (fx->map[k].type == COB_XFDT_FLOAT) { - if (fx->map[k].size == sizeof(double)) - fx->map[k].hostType = SQL_C_DOUBLE; - else - fx->map[k].hostType = SQL_C_FLOAT; - fx->map[k].sqlType = SQL_FLOAT; - fx->map[k].sqlColSize = fx->map[k].size; - } else if (fx->map[k].type == COB_XFDT_BIN) { - fx->map[k].sqlColSize = fx->map[k].size; - fx->map[k].hostType = SQL_C_BINARY; - fx->map[k].sqlType = SQL_BINARY; - } else if (fx->map[k].valnum) { - fx->map[k].sqlType = SQL_DECIMAL; - } else { - fx->map[k].sqlType = SQL_CHAR; - } - } - } - DEBUG_LOG("db",("OPEN %s %s\n",optyp,f->select_name)); - - return COB_STATUS_00_SUCCESS; -} - -/* Close the INDEXED file */ - -static int -odbc_close (cob_file_api *a, cob_file *f, const int opt) -{ - struct indexed_file *p; - struct file_xfd *fx; - int k; - - if (opt == COB_CLOSE_ABORT) { - odbc_rollback (a, f); - } else - if (db->updatesDone > 0) { - db->updatesDone = db->commitInterval + 1; /* Force COMMIT */ - odbc_commit (a, f); - } - p = f->file; - - if (p) { - if (p->fx) { - fx = p->fx; - odbc_free_stmt (&fx->insert); - odbc_free_stmt (&fx->delete); - odbc_free_stmt (&fx->update); - odbc_free_stmt (fx->start); - fx->start = NULL; - for (k=0; k < fx->nkeys; k++) { - odbc_free_stmt (&fx->key[k]->where_eq); - odbc_free_stmt (&fx->key[k]->where_ge); - odbc_free_stmt (&fx->key[k]->where_gt); - odbc_free_stmt (&fx->key[k]->where_le); - odbc_free_stmt (&fx->key[k]->where_lt); - odbc_free_stmt (&fx->key[k]->where_ne); - odbc_free_stmt (&fx->key[k]->where_fi); - odbc_free_stmt (&fx->key[k]->where_la); - } - cob_drop_xfd (fx); - } - cob_free (p); - } - f->file = NULL; - f->open_mode = COB_OPEN_CLOSED; - DEBUG_LOG("db",("CLOSE %s\n",f->select_name)); - - return COB_STATUS_00_SUCCESS; -} - - -/* START INDEXED file with positioning */ - -static int -odbc_start (cob_file_api *a, cob_file *f, const int cond, cob_field *key) -{ - int ky, klen, partlen, paramtype; - struct indexed_file *p; - struct file_xfd *fx; - COB_UNUSED (a); - - ky = cob_findkey (f, key, &klen, &partlen); - if (ky < 0) { - DEBUG_LOG("db",("Start key not found!\n")); - return COB_STATUS_30_PERMANENT_ERROR; - } - p = f->file; - fx = p->fx; - p->startcond = cond; - f->curkey = ky; - paramtype = SQL_BIND_NO; - - odbc_close_stmt (fx->start); - fx->start = NULL; - switch (cond) { - case COB_EQ: - case COB_NE: - fx->start = cob_sql_select (db, fx, ky, cond, 0, odbc_free_stmt); - paramtype = SQL_BIND_EQ; - break; - case COB_GE: - case COB_GT: - case COB_LE: - case COB_LT: - fx->start = cob_sql_select (db, fx, ky, cond, 0, odbc_free_stmt); - paramtype = SQL_BIND_WHERE; - break; - case COB_FI: - case COB_LA: - fx->start = cob_sql_select (db, fx, ky, cond, 0, odbc_free_stmt); - paramtype = SQL_BIND_NO; - break; - } - DEBUG_LOG("db",("Start %s index %d Bind %02X\n",f->select_name,ky,paramtype)); - cob_index_to_xfd (db, fx, f, ky); - odbc_setup_stmt (db, fx, fx->start, SQL_BIND_COLS|paramtype, ky); - if (fx->start->status) { - fx->start = NULL; - cob_sql_dump_data (db, fx); - return COB_STATUS_30_PERMANENT_ERROR; - } - cob_sql_dump_stmt (db, fx->start->text, FALSE); - if(chkSts(db,(char*)"Start",fx->start->handle, - SQLExecute(fx->start->handle))){ - return COB_STATUS_30_PERMANENT_ERROR; - } - - return COB_STATUS_00_SUCCESS; -} - -/* Random READ of the INDEXED file */ - -static int -odbc_read (cob_file_api *a, cob_file *f, cob_field *key, const int read_opts) -{ - struct indexed_file *p; - struct file_xfd *fx; - struct map_xfd *col; - int k, ky, pos, klen, partlen; - int ret = COB_STATUS_00_SUCCESS; - COB_UNUSED (a); - - p = f->file; - fx = p->fx; - if (fx->fileorg == COB_ORG_RELATIVE) { - ky = 0; - } else { - ky = cob_findkey (f, key, &klen, &partlen); - if (ky < 0) { - return COB_STATUS_30_PERMANENT_ERROR; - } - } - f->curkey = ky; - p->startcond = -1; - if (fx->start) - odbc_close_stmt (fx->start); - fx->start = cob_sql_select (db, fx, ky, COB_EQ, read_opts, odbc_free_stmt); - odbc_close_stmt (fx->start); - cob_index_to_xfd (db, fx, f, ky); - odbc_setup_stmt (db, fx, fx->start, SQL_BIND_COLS, 0); - if (fx->start->status) { - fx->start = NULL; - cob_sql_dump_data (db, fx); - return COB_STATUS_30_PERMANENT_ERROR; - } - odbc_set_nulls (db, fx); - pos = 0; - for (k=0; k < fx->key[ky]->ncols; k++) { - col = &fx->map[fx->key[ky]->col[k]]; - bindParam (db, fx, fx->start, col, ++pos); - } - if(chkSts(db,(char*)"Read Exec",fx->start->handle, - SQLExecute(fx->start->handle))){ - if (db->dbStatus == db->dbStsDeadLock) - return COB_STATUS_61_FILE_SHARING; - return COB_STATUS_30_PERMANENT_ERROR; - } - if(chkSts(db,(char*)"Read",fx->start->handle, SQLFetch(fx->start->handle))) { - DEBUG_LOG("db",("Read: %.40s...; Sts %d '%.5s'\n",fx->start->text, - db->dbStatus,db->odbcState)); - cob_sql_dump_stmt (db, fx->start->text, FALSE); - cob_sql_dump_index (db, fx, ky); - if (db->dbStatus == db->dbStsNotFound) - ret = COB_STATUS_23_KEY_NOT_EXISTS; - else if (db->dbStatus == db->dbStsDeadLock) - ret = COB_STATUS_52_DEAD_LOCK; - else - ret = COB_STATUS_30_PERMANENT_ERROR; - } else { - DEBUG_LOG("db",("Read: %s; OK\n",f->select_name)); - odbc_any_nulls (db, fx); - cob_sql_dump_data (db, fx); - cob_xfd_to_file (db, fx, f); - } - - return ret; -} - -/* Sequential READ of the INDEXED file */ - -static int -odbc_read_next (cob_file_api *a, cob_file *f, const int read_opts) -{ - struct indexed_file *p; - struct file_xfd *fx; - int ky; - int opts = (int)read_opts & COB_READ_MASK; - int ret = COB_STATUS_00_SUCCESS; - COB_UNUSED (a); - - if (f->open_mode == COB_OPEN_CLOSED) - return COB_STATUS_49_I_O_DENIED; - p = f->file; - fx = p->fx; - if (f->curkey < 0) { - f->curkey = 0; - cob_index_clear (db, fx, f, 0); - opts = COB_READ_FIRST; - } - ky = f->curkey; - switch (opts) { - default: - case COB_READ_NEXT: - if (p->startcond != COB_GT) { - fx->start = cob_sql_select (db, fx, ky, COB_GT, read_opts, odbc_free_stmt); - odbc_close_stmt (fx->start); - odbc_setup_stmt (db, fx, fx->start, SQL_BIND_COLS|SQL_BIND_WHERE, f->curkey); - if(chkSts(db,(char*)"Read Next Exec",fx->start->handle, - SQLExecute(fx->start->handle))){ - return COB_STATUS_30_PERMANENT_ERROR; - } - p->startcond = COB_GT; - } - if (fx->start - && !fx->start->isdesc) { - if(chkSts(db,(char*)"Read Next",fx->start->handle, SQLFetch(fx->start->handle))) { - DEBUG_LOG("db",("Read Next: %.50s; Sts %d\n",fx->start->text,db->dbStatus)); - if (db->dbStatus == db->dbStsNotFound) - ret = COB_STATUS_10_END_OF_FILE; - else - ret = COB_STATUS_30_PERMANENT_ERROR; - } else { - DEBUG_LOG("db",("Read Next: %s; OK\n",f->select_name)); - odbc_any_nulls (db, fx); - cob_xfd_to_file (db, fx, f); - } - } else { - ret = COB_STATUS_10_END_OF_FILE; - } - break; - case COB_READ_PREVIOUS: - if (p->startcond != COB_LT) { - fx->start = cob_sql_select (db, fx, ky, COB_LT, read_opts, odbc_free_stmt); - odbc_close_stmt (fx->start); - odbc_setup_stmt (db, fx, fx->start, SQL_BIND_COLS|SQL_BIND_WHERE, f->curkey); - if(chkSts(db,(char*)"Read Prev Exec",fx->start->handle, - SQLExecute(fx->start->handle))){ - return COB_STATUS_30_PERMANENT_ERROR; - } - p->startcond = COB_LT; - } - if (fx->start - && fx->start->isdesc) { - if(chkSts(db,(char*)"Read Prev",fx->start->handle, SQLFetch(fx->start->handle))) { - DEBUG_LOG("db",("Read Prev: %.50s; Sts %d\n",fx->start->text,db->dbStatus)); - if (db->dbStatus == db->dbStsNotFound) - ret = COB_STATUS_10_END_OF_FILE; - else - ret = COB_STATUS_30_PERMANENT_ERROR; - } else { - DEBUG_LOG("db",("Read Prev: %s; OK\n",f->select_name)); - odbc_any_nulls (db, fx); - cob_xfd_to_file (db, fx, f); - } - } else { - ret = COB_STATUS_10_END_OF_FILE; - } - break; - case COB_READ_FIRST: - fx->start = cob_sql_select (db, fx, ky, COB_FI, read_opts, odbc_free_stmt); - odbc_close_stmt (fx->start); - odbc_setup_stmt (db, fx, fx->start, SQL_BIND_COLS, 0); - if (fx->start->status) { - fx->start = NULL; - cob_sql_dump_data (db, fx); - return COB_STATUS_30_PERMANENT_ERROR; - } - p->startcond = COB_GT; - if(chkSts(db,(char*)"Exec First",fx->start->handle, - SQLExecute(fx->start->handle))){ - return COB_STATUS_30_PERMANENT_ERROR; - } - if(chkSts(db,(char*)"Read First",fx->start->handle, SQLFetch(fx->start->handle))) { - DEBUG_LOG("db",("Read First: %.50s; Sts %d\n",fx->start->text,db->dbStatus)); - if (db->dbStatus == db->dbStsNotFound) - ret = COB_STATUS_10_END_OF_FILE; - else - ret = COB_STATUS_30_PERMANENT_ERROR; - } else { - DEBUG_LOG("db",("Read First: %s; OK\n",f->select_name)); - odbc_any_nulls (db, fx); - cob_xfd_to_file (db, fx, f); - } - break; - case COB_READ_LAST: - fx->start = cob_sql_select (db, fx, ky, COB_LA, read_opts, odbc_free_stmt); - odbc_close_stmt (fx->start); - odbc_setup_stmt (db, fx, fx->start, SQL_BIND_COLS, 0); - if (fx->start->status) { - fx->start = NULL; - cob_sql_dump_data (db, fx); - return COB_STATUS_30_PERMANENT_ERROR; - } - if(chkSts(db,(char*)"Read Last",fx->start->handle, - SQLExecute(fx->start->handle))){ - return COB_STATUS_30_PERMANENT_ERROR; - } - p->startcond = COB_LT; - if(chkSts(db,(char*)"Read Last",fx->start->handle, SQLFetch(fx->start->handle))) { - DEBUG_LOG("db",("Read Last: %.50s; Sts %d\n",fx->start->text,db->dbStatus)); - if (db->dbStatus == db->dbStsNotFound) - ret = COB_STATUS_10_END_OF_FILE; - else - ret = COB_STATUS_30_PERMANENT_ERROR; - } else { - DEBUG_LOG("db",("Read Last: %s; OK\n",f->select_name)); - odbc_any_nulls (db, fx); - cob_xfd_to_file (db, fx, f); - } - break; - } - - return ret; -} - - -/* WRITE to the INDEXED file */ - -static int -odbc_write (cob_file_api *a, cob_file *f, const int opt) -{ - struct indexed_file *p; - struct file_xfd *fx; - int ret = COB_STATUS_00_SUCCESS; - COB_UNUSED (a); - - p = f->file; - fx = p->fx; - if (fx->insert.text == NULL) { - fx->insert.text = cob_sql_stmt (db, fx, (char*)"INSERT", 0, 0, 0); - } - - cob_file_to_xfd (db, fx, f); - - odbc_set_nulls (db, fx); - if (!fx->insert.preped) { - odbc_setup_stmt (db, fx, &fx->insert, SQL_BIND_PRMS, 0); - } - if(chkSts(db,(char*)"Exec INSERT",fx->insert.handle, - SQLExecute(fx->insert.handle))){ - if (db->dbStatus == db->dbStsDupKey) { - DEBUG_LOG("db",("%.60s Duplicate; Failed!\n",fx->insert.text)); - ret = COB_STATUS_22_KEY_EXISTS; - } else { - DEBUG_LOG("db",("SQLExecute %.40s status %d; Failed!\n",fx->insert.text,db->dbStatus)); - ret = COB_STATUS_30_PERMANENT_ERROR; - cob_sql_dump_data (db, fx); - } - return ret; - } - db->updatesDone++; - if (db->dbStatus != 0) { - DEBUG_LOG("db",("WRITE: %.40s... status %d; Not Good!\n",fx->insert.text,db->dbStatus)); - } else if (fx->fileorg == COB_ORG_RELATIVE) { - DEBUG_LOG("db",("WRITE: %.40s... Rec# %d; Good!\n",fx->insert.text,(int)f->cur_rec_num)); - } else { - DEBUG_LOG("db",("WRITE: %.40s... Good!\n",fx->insert.text)); - } - if (!db->autocommit) - odbc_commit (a, f); - - return ret; -} - - -/* DELETE record from the INDEXED file */ - -static int -odbc_delete (cob_file_api *a, cob_file *f) -{ - struct indexed_file *p; - struct file_xfd *fx; - int k, pos; - int ret = COB_STATUS_00_SUCCESS; - COB_UNUSED (a); - - if (f->open_mode == COB_OPEN_INPUT - || f->open_mode == COB_OPEN_CLOSED) - return COB_STATUS_49_I_O_DENIED; - p = f->file; - fx = p->fx; - if (fx->delete.text == NULL) { - fx->delete.text = cob_sql_stmt (db, fx, (char*)"DELETE", 0, 0, 0); - } - - cob_index_to_xfd (db, fx, f, 0); - - if (!fx->delete.preped) { - odbc_setup_stmt (db, fx, &fx->delete, SQL_BIND_NO, 0); - pos = 0; - for (k=0; k < fx->key[0]->ncols; k++) { - bindParam (db, fx, &fx->delete, &fx->map[fx->key[0]->col[k]], ++pos); - } - } - if(chkSts(db,(char*)"Exec DELETE",fx->delete.handle, - SQLExecute(fx->delete.handle))){ - DEBUG_LOG("db",("SQLExecute %.40s status %d; Failed!\n",fx->delete.text,db->dbStatus)); - if (db->dbStatus == db->dbStsNotFound) - ret = COB_STATUS_23_KEY_NOT_EXISTS; - else - ret = COB_STATUS_21_KEY_INVALID; - cob_sql_dump_data (db, fx); - return ret; - } - k = odbc_row_count (db, &fx->delete); - if (k == 0) - ret = COB_STATUS_23_KEY_NOT_EXISTS; - else if (k > 1) - ret = COB_STATUS_30_PERMANENT_ERROR; - db->updatesDone++; - DEBUG_LOG("db",("DELETE: %s status %d; %d deleted, return %02d\n",f->select_name, - db->dbStatus,k,ret)); - if (!db->autocommit) - odbc_commit (a, f); - - return ret; -} - -/* REWRITE record to the INDEXED file */ - -static int -odbc_rewrite (cob_file_api *a, cob_file *f, const int opt) -{ - struct indexed_file *p; - struct file_xfd *fx; - int k, pos; - int ret = COB_STATUS_00_SUCCESS; - COB_UNUSED (a); - - if (f->open_mode == COB_OPEN_INPUT - || f->open_mode == COB_OPEN_CLOSED) - return COB_STATUS_49_I_O_DENIED; - p = f->file; - fx = p->fx; - if (fx->update.text == NULL) { - fx->update.text = cob_sql_stmt (db, fx, (char*)"UPDATE", 0, 0, 0); - } - - cob_file_to_xfd (db, fx, f); - - odbc_set_nulls (db, fx); - if (!fx->update.preped) { - odbc_setup_stmt (db, fx, &fx->update, SQL_BIND_PRMS, 0); - pos = fx->update.bindpos; - for (k=0; k < fx->key[0]->ncols; k++) { - bindParam (db, fx, &fx->update, &fx->map[fx->key[0]->col[k]], ++pos); - } - } - if(chkSts(db,(char*)"Exec UPDATE",fx->update.handle, - SQLExecute(fx->update.handle))){ - if (db->dbStatus == db->dbStsDupKey) { - DEBUG_LOG("db",("%.60s Duplicate; Failed!\n",fx->update.text)); - ret = COB_STATUS_22_KEY_EXISTS; - } else { - DEBUG_LOG("db",("SQLExecute %.40s status %d; Failed!\n",fx->update.text,db->dbStatus)); - ret = COB_STATUS_30_PERMANENT_ERROR; - cob_sql_dump_data (db, fx); - } - return ret; - } - k = odbc_row_count (db, &fx->update); - if (k == 0) - ret = COB_STATUS_21_KEY_INVALID; - else if (k > 1) - ret = COB_STATUS_30_PERMANENT_ERROR; - db->updatesDone++; - DEBUG_LOG("db",("REWRITE: %s, status %d; %d updated, return %02d!\n",f->select_name, - db->dbStatus,k,ret)); - if (!db->autocommit) - odbc_commit (a, f); - - return ret; -} - - -static int -odbc_file_unlock (cob_file_api *a, cob_file *f) -{ - COB_UNUSED (a); - COB_UNUSED (f); - return 0; -} - -/* Call this routine when a new process has been forked */ -static int -odbc_fork (cob_file_api *a) -{ - COB_UNUSED (a); - return 0; -} - -static void -odbc_exit_fileio (cob_file_api *a) -{ - COB_UNUSED (a); -} - -void -cob_odbc_init_fileio (cob_file_api *a) -{ - a->io_funcs[COB_IO_ODBC] = (void*)&odbc_indexed_funcs; -} - -#endif diff -Nru gnucobol-4.0~early~20200606/libcob/fsqlxfd.c gnucobol-5/libcob/fsqlxfd.c --- gnucobol-4.0~early~20200606/libcob/fsqlxfd.c 2020-06-06 20:52:01.000000000 +0000 +++ gnucobol-5/libcob/fsqlxfd.c 1970-01-01 00:00:00.000000000 +0000 @@ -1,2448 +0,0 @@ -/* - Copyright (C) 2002-2012, 2014-2020 Free Software Foundation, Inc. - Written by Keisuke Nishida, Roger While, Simon Sobisch, Ron Norman - - This file is part of GnuCOBOL. - - The GnuCOBOL runtime library is free software: you can redistribute it - and/or modify it under the terms of the GNU Lesser General Public License - as published by the Free Software Foundation, either version 3 of the - License, or (at your option) any later version. - - GnuCOBOL is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU Lesser General Public License for more details. - - You should have received a copy of the GNU Lesser General Public License - along with GnuCOBOL. If not, see . -*/ - - -/* Force symbol exports */ -#define COB_LIB_EXPIMP -#include "fileio.h" - -#if defined(WITH_ODBC) || defined(WITH_OCI) || defined(WITH_DB) || defined(WITH_LMDB) -#include "defaults.h" -/* Routines in fsqlxfd.c common to all Database interfaces */ - -int -db_findkey (cob_file *f, cob_field *kf, int *fullkeylen, int *partlen) -{ - int k, part; - - *fullkeylen = *partlen = 0; - for (k = 0; k < (int)f->nkeys; ++k) { - if (f->keys[k].field - && f->keys[k].count_components <= 1 - && f->keys[k].field->data == kf->data) { - *fullkeylen = f->keys[k].field->size; - *partlen = kf->size; - return k; - } - } - for (k = 0; k < (int)(f->nkeys); ++k) { - if (f->keys[k].count_components > 1) { - if ( (f->keys[k].field - && f->keys[k].field->data == kf->data - && f->keys[k].field->size == kf->size) - || (f->keys[k].component[0]->data == kf->data)) { - for (part = 0; part < f->keys[k].count_components; part++) { - *fullkeylen += f->keys[k].component[part]->size; - } - if (f->keys[k].field && f->keys[k].field->data == kf->data) { - *partlen = kf->size; - } else { - *partlen = *fullkeylen; - } - return k; - } - } - } - return -1; -} - -/* Return total length of the key */ -int -db_keylen (cob_file *f, int idx) -{ - int totlen, part; - - if (idx < 0 || idx > (int)(f->nkeys)) { - return -1; - } - if (f->keys[idx].count_components > 0) { - totlen = 0; - for (part = 0; part < f->keys[idx].count_components; part++) { - totlen += f->keys[idx].component[part]->size; - } - return totlen; - } - return f->keys[idx].field->size; -} - -/* Save key for given index from 'record' into 'keyarea', - returns total length of the key */ -int -db_savekey (cob_file *f, unsigned char *keyarea, unsigned char *record, int idx) -{ - int totlen, part; - - if (f->keys[idx].count_components > 0) { - totlen = 0; - for (part = 0; part < f->keys[idx].count_components; part++) { - memcpy (keyarea + totlen, - record + (f->keys[idx].component[part]->data - f->record->data), - f->keys[idx].component[part]->size); - totlen += f->keys[idx].component[part]->size; - } - return totlen; - } - memcpy (keyarea, record + f->keys[idx].offset, f->keys[idx].field->size); - return f->keys[idx].field->size; -} - -/* Compare key for given index 'keyarea' to 'record'. - returns compare status */ -int -db_cmpkey (cob_file *f, unsigned char *keyarea, unsigned char *record, int idx, int partlen) -{ - int sts, part, totlen; - size_t cl; - - if (partlen <= 0) { - partlen = db_keylen(f, idx); - if (partlen <= 0) { - cob_runtime_error (_("invalid internal call of %s"), "db_cmpkey"); - cob_runtime_error (_("Please report this!")); - cob_stop_run (1); - } - } - if (f->keys[idx].count_components > 0) { - totlen = 0; - for (part = 0; part < f->keys[idx].count_components && partlen > 0; part++) { - cl = (size_t)partlen > f->keys[idx].component[part]->size - ? f->keys[idx].component[part]->size : (size_t)partlen; - sts = memcmp (keyarea + totlen, - record + (f->keys[idx].component[part]->data - f->record->data), - cl); - if (sts != 0) { - return sts; - } - totlen += f->keys[idx].component[part]->size; - partlen -= f->keys[idx].component[part]->size; - } - return 0; - } - cl = partlen > (int)(f->keys[idx].field->size) ? (int)(f->keys[idx].field->size) : partlen; - return memcmp (keyarea, record + f->keys[idx].offset, cl); -} - -#endif - -/* Routines common to both ODBC and OCI interfaces */ -#if defined(WITH_ODBC) || defined(WITH_OCI) - -#ifdef COB_DEBUG_LOG -static char * -hex_dump (unsigned char *in, int len, char *out) -{ - char *rtn = out; - int k; - if (len <= 0) { - strcpy(out,"e-m-p-t-y"); - return out; - } - while (len > 1 - && in[len-1] == 0x00) - len--; - for(k=0; k < len && isprint(in[k]); k++); - if (k == len) { - if (len < 40) { - sprintf(out,"'%.*s'",len,in); - } else { - sprintf(out,"'%.40s'...",in); - } - return out; - } - if (len > 30) len = 30; - strcpy(out,"0x"); - out += 2; - while (len > 0) { - sprintf(out,"%02X",*in); - len--; - out += 2; - in++; - } - return rtn; -} -#endif - -static char * -cob_get_strerror (void) -{ - static char msg[1024]; -#ifdef HAVE_STRERROR - strncpy (msg, strerror (errno), sizeof(msg) - 1); -#else - snprintf (msg, sizeof(msg) - 1, _("system error %d"), errno); -#endif - return msg; -} - -static char * -getNum(char *p, int *val) -{ - int v = 0; - if (*p == ',') p++; - while(isdigit (*p)) - v = v * 10 + (*p++ - '0'); - *val = v; - if (*p == ',') p++; - return p; -} - -static char * -getPosLen(char *p, unsigned char *pos, unsigned char *len) -{ - int v = 0; - if (*p == ',') p++; - while(isdigit (*p)) - v = v * 10 + (*p++ - '0'); - *pos = (unsigned char)v; - v = 0; - if (*p == ':') p++; - while(isdigit (*p)) - v = v * 10 + (*p++ - '0'); - *len = (unsigned char)v; - if (*p == ',') p++; - return p; -} - -static char * -getStr(char *p, char *str) -{ - char qt; - if (*p == '"' || *p == '\'') { - qt = *p++; - } else if (*p == ',') { - *str = 0; - p++; - return p; - } else { - qt = 1; - } - while(*p != qt && *p >= ' ') - *str++ = *p++; - *str = 0; - if (*p == qt) p++; - if (*p == ',') p++; - return p; -} - -static char * -getPrm(char *p, char *str) -{ - char qt; - if (*p == '"' || *p == '\'') { - qt = *p++; - } else if (*p == ',') { - *str = 0; - p++; - return p; - } else { - qt = ','; - } - while(*p != qt && *p >= ' ') - *str++ = *p++; - *str = 0; - if (*p == qt) p++; - if (*p == ',' && qt != ',') p++; - return p; -} - -static void -new_label (struct file_xfd *fx, int lbl) -{ - void *xlbl; - if (lbl < fx->nlbl) - return; - xlbl = cob_malloc (sizeof(int) * (lbl+1)); - if (fx->xlbl) { - memcpy (xlbl, fx->xlbl, sizeof(int) * fx->nlbl); - cob_free (fx->xlbl); - } - fx->xlbl = xlbl; - fx->nlbl = lbl+1; -} - -static struct map_xfd * -new_xfd (struct file_xfd *fx, int cmd) -{ - struct map_xfd *mx; - if (fx->map == NULL) { - mx = cob_malloc (sizeof(struct map_xfd)); - fx->nmap = 1; - fx->map = mx; - } else { - mx = cob_malloc (sizeof(struct map_xfd) * (fx->nmap + 1)); - memcpy (mx, fx->map, sizeof(struct map_xfd) * fx->nmap); - cob_free (fx->map); - fx->map = mx; - mx = &fx->map[fx->nmap]; - fx->nmap++; - } - mx->cmd = cmd; - return mx; -} - -static cob_pic_symbol * -bld_picture (cob_pic_symbol *pic, int sign, int digits, int scale) -{ - cob_pic_symbol *p = pic; - if (sign == 0 - && digits == 0 - && scale == 0) - return NULL; - if (sign > 0) { - p->symbol = '+'; - p->times_repeated = 1; - ++p; - } - if (scale > 0) { - if (digits - scale > 0) { - p->symbol = '9'; - p->times_repeated = digits - scale; - ++p; - } - - p->symbol = COB_MODULE_PTR->decimal_point; - p->times_repeated = 1; - ++p; - - p->symbol = '9'; - p->times_repeated = scale; - ++p; - } else { - p->symbol = '9'; - p->times_repeated = digits; - ++p; - } - if (sign < 0) { - p->symbol = '+'; - p->times_repeated = 1; - ++p; - } - p->symbol = '\0'; - return pic; -} - -static void -bld_fields (struct map_xfd *mx, cob_file *fl) -{ - int numsz; - if (fl->organization == COB_ORG_RELATIVE - && mx->level == 0) { - memcpy(&mx->recfld, fl->keys[0].field, sizeof(cob_field)); - memset(mx->sdata,0,mx->sqlsize); - if (mx->sqlsize > 13) - mx->sqlsize = 13; - mx->sqlattr.type = COB_TYPE_NUMERIC_DISPLAY; - mx->sqlattr.pic = bld_picture (mx->sqlpic, 0, 12, 0); - mx->sqlfld.size = mx->sqlsize-1; - mx->sqlfld.data = mx->sdata; - mx->sqlfld.attr = &mx->sqlattr; - mx->sqlattr.digits = 12; - mx->sqlattr.scale = 0; - mx->sqloutlen = (int)mx->sqlfld.size; - return; - } - mx->recfld.size = mx->size; - mx->recfld.data = fl->record->data + mx->offset; - mx->recfld.attr = &mx->recattr; - mx->recattr.digits = mx->digits; - mx->recattr.scale = mx->scale; - mx->sqlfld.size = mx->sqlsize-1; - mx->sqlfld.data = mx->sdata; - mx->sqlfld.attr = &mx->sqlattr; - mx->sqlattr.digits = mx->digits; - mx->sqlattr.scale = mx->scale; - switch (mx->type) { - case COB_XFDT_COMPS: - mx->recattr.type = COB_TYPE_NUMERIC_BINARY; - mx->recattr.flags = COB_FLAG_HAVE_SIGN; -#ifndef WORDS_BIGENDIAN - mx->recattr.flags |= COB_FLAG_BINARY_SWAP; -#endif - mx->sqlattr.type = mx->scale == 0 ? COB_TYPE_NUMERIC_DISPLAY : COB_TYPE_NUMERIC_EDITED; - mx->sqlattr.flags = COB_FLAG_HAVE_SIGN|COB_FLAG_SIGN_SEPARATE|COB_FLAG_SIGN_LEADING; - mx->sqlattr.pic = bld_picture (mx->sqlpic, 1, mx->digits, mx->scale); - break; - case COB_XFDT_COMPU: - mx->recattr.type = COB_TYPE_NUMERIC_BINARY; -#ifndef WORDS_BIGENDIAN - mx->recattr.flags |= COB_FLAG_BINARY_SWAP; -#endif - mx->sqlattr.type = mx->scale == 0 ? COB_TYPE_ALNUM : COB_TYPE_NUMERIC_EDITED; - mx->sqlattr.pic = mx->scale == 0 ? NULL : bld_picture (mx->sqlpic, 0, mx->digits, mx->scale); - break; - case COB_XFDT_COMPX: - mx->recattr.type = COB_TYPE_NUMERIC_BINARY; -#ifndef WORDS_BIGENDIAN - mx->recattr.flags |= COB_FLAG_BINARY_SWAP; -#endif - mx->sqlattr.type = mx->scale == 0 ? COB_TYPE_NUMERIC_DISPLAY : COB_TYPE_NUMERIC_EDITED; - break; - case COB_XFDT_COMP5S: - mx->recattr.type = COB_TYPE_NUMERIC_BINARY; - mx->recattr.flags = COB_FLAG_HAVE_SIGN|COB_FLAG_REAL_BINARY; - mx->sqlattr.type = mx->scale == 0 ? COB_TYPE_NUMERIC_DISPLAY : COB_TYPE_NUMERIC_EDITED; - mx->sqlattr.flags = COB_FLAG_HAVE_SIGN|COB_FLAG_SIGN_SEPARATE|COB_FLAG_SIGN_LEADING; - mx->sqlattr.pic = bld_picture (mx->sqlpic, 1, mx->digits, mx->scale); - break; - case COB_XFDT_COMP5U: - mx->recattr.type = COB_TYPE_NUMERIC_BINARY; - mx->recattr.flags = COB_FLAG_REAL_BINARY; - mx->sqlattr.type = mx->scale == 0 ? COB_TYPE_NUMERIC_DISPLAY : COB_TYPE_NUMERIC_EDITED; - mx->sqlattr.pic = bld_picture (mx->sqlpic, 0, mx->digits, mx->scale); - break; - case COB_XFDT_FLOAT: - mx->recattr.type = mx->size < 7 ? COB_TYPE_NUMERIC_FLOAT : COB_TYPE_NUMERIC_DOUBLE; - mx->sqlattr.type = COB_TYPE_NUMERIC_EDITED; - mx->sqlattr.flags = COB_FLAG_HAVE_SIGN|COB_FLAG_SIGN_SEPARATE|COB_FLAG_SIGN_LEADING; - mx->sqlattr.pic = bld_picture (mx->sqlpic, 1, mx->digits, mx->scale); - break; - case COB_XFDT_PACKS: - mx->recattr.type = COB_TYPE_NUMERIC_PACKED; - mx->recattr.flags = COB_FLAG_HAVE_SIGN; - mx->sqlattr.type = mx->scale == 0 ? COB_TYPE_NUMERIC_DISPLAY : COB_TYPE_NUMERIC_EDITED; - mx->sqlattr.flags = COB_FLAG_HAVE_SIGN|COB_FLAG_SIGN_SEPARATE|COB_FLAG_SIGN_LEADING; - mx->sqlattr.pic = bld_picture (mx->sqlpic, 1, mx->digits, mx->scale); - break; - case COB_XFDT_PACKU: - mx->recattr.type = COB_TYPE_NUMERIC_PACKED; - mx->recattr.flags = COB_FLAG_REAL_BINARY; - mx->sqlattr.type = mx->scale == 0 ? COB_TYPE_NUMERIC_DISPLAY : COB_TYPE_NUMERIC_EDITED; - mx->sqlattr.pic = bld_picture (mx->sqlpic, 0, mx->digits, mx->scale); - break; - case COB_XFDT_PICA: - case COB_XFDT_PICX: - case COB_XFDT_VARX: - mx->recattr.type = COB_TYPE_ALNUM; - mx->sqlattr.type = COB_TYPE_ALNUM; - break; - case COB_XFDT_PICN: - case COB_XFDT_PICW: - mx->recattr.type = COB_TYPE_NATIONAL; - mx->sqlattr.type = COB_TYPE_NATIONAL; - break; - case COB_XFDT_PIC9L: - mx->recattr.type = COB_TYPE_NUMERIC_DISPLAY; - mx->recattr.flags = COB_FLAG_HAVE_SIGN|COB_FLAG_SIGN_LEADING; - mx->sqlattr.type = mx->scale == 0 ? COB_TYPE_NUMERIC_DISPLAY : COB_TYPE_NUMERIC_EDITED; - mx->sqlattr.flags = COB_FLAG_HAVE_SIGN|COB_FLAG_SIGN_SEPARATE|COB_FLAG_SIGN_LEADING; - mx->sqlattr.pic = bld_picture (mx->sqlpic, 1, mx->digits, mx->scale); - break; - case COB_XFDT_PIC9LS: - mx->recattr.type = COB_TYPE_NUMERIC_DISPLAY; - mx->recattr.flags = COB_FLAG_HAVE_SIGN|COB_FLAG_SIGN_SEPARATE|COB_FLAG_SIGN_LEADING; - mx->sqlattr.type = mx->scale == 0 ? COB_TYPE_NUMERIC_DISPLAY : COB_TYPE_NUMERIC_EDITED; - mx->sqlattr.flags = COB_FLAG_HAVE_SIGN|COB_FLAG_SIGN_SEPARATE|COB_FLAG_SIGN_LEADING; - mx->sqlattr.pic = bld_picture (mx->sqlpic, 1, mx->digits, mx->scale); - break; - case COB_XFDT_PIC9T: - mx->recattr.type = COB_TYPE_NUMERIC_DISPLAY; - mx->recattr.flags = COB_FLAG_HAVE_SIGN|COB_FLAG_SIGN_SEPARATE; - mx->sqlattr.type = mx->scale == 0 ? COB_TYPE_NUMERIC_DISPLAY : COB_TYPE_NUMERIC_EDITED; - mx->sqlattr.flags = COB_FLAG_HAVE_SIGN|COB_FLAG_SIGN_SEPARATE|COB_FLAG_SIGN_LEADING; - mx->sqlattr.pic = bld_picture (mx->sqlpic, 1, mx->digits, mx->scale); - break; - case COB_XFDT_PIC9TS: - mx->recattr.type = COB_TYPE_NUMERIC_DISPLAY; - mx->recattr.flags = COB_FLAG_HAVE_SIGN|COB_FLAG_SIGN_SEPARATE; - mx->sqlattr.type = mx->scale == 0 ? COB_TYPE_NUMERIC_DISPLAY : COB_TYPE_NUMERIC_EDITED; - mx->sqlattr.flags = COB_FLAG_HAVE_SIGN|COB_FLAG_SIGN_SEPARATE|COB_FLAG_SIGN_LEADING; - mx->sqlattr.pic = bld_picture (mx->sqlpic, 1, mx->digits, mx->scale); - break; - case COB_XFDT_PIC9S: - mx->recattr.type = COB_TYPE_NUMERIC_DISPLAY; - mx->recattr.flags = COB_FLAG_HAVE_SIGN; - mx->sqlattr.type = mx->scale == 0 ? COB_TYPE_NUMERIC_DISPLAY : COB_TYPE_NUMERIC_EDITED; - mx->sqlattr.flags = COB_FLAG_HAVE_SIGN|COB_FLAG_SIGN_SEPARATE|COB_FLAG_SIGN_LEADING; - mx->sqlattr.pic = bld_picture (mx->sqlpic, 1, mx->digits, mx->scale); - break; - case COB_XFDT_PIC9U: - mx->recattr.type = COB_TYPE_NUMERIC_DISPLAY; - mx->recattr.flags = 0; - mx->sqlattr.type = mx->scale == 0 ? COB_TYPE_NUMERIC_DISPLAY : COB_TYPE_NUMERIC_EDITED; - mx->sqlattr.flags = 0; - mx->sqlattr.pic = bld_picture (mx->sqlpic, 0, mx->digits, mx->scale); - break; - } - if (mx->dtfrm) { - mx->sqlfld.size = mx->dtfrm->digits; - } else if (mx->digits > 0) { /* Set size of SQL numeric field exact */ - numsz = mx->digits; - if (mx->sqlattr.flags & COB_FLAG_HAVE_SIGN) - numsz++; - if (mx->scale != 0) - numsz++; - if (numsz < mx->sqlsize-1) - mx->sqlfld.size = numsz; - } - mx->sqloutlen = (int)mx->sqlfld.size; -} - -/* - * Evaluate the expression and return the next position in table - */ -#define MAXVAL 16 -static const char vop[10][5] = {".",">=",">","<=","<","=","!=","&&","||","!"}; -static int -eval_expr (struct file_xfd *fx, int pos) -{ - int kdata,col,rslt; - int val[MAXVAL]; - char buf[256]; - cob_field temp; - cob_field_attr attr; - COB_ATTR_INIT (COB_TYPE_NUMERIC_DISPLAY, 0, 0, 0, NULL); - temp.data = (unsigned char *)buf; - temp.attr = &attr; - for (kdata=0; kdata < MAXVAL; kdata++) - val[kdata] = 0; - kdata = 0; - while (fx->map[pos].cmd == XC_WHEN) { - if (fx->map[pos].opcode == XO_AND) { - kdata--; - val[kdata-1] = val[kdata] && val[kdata-1]; - } else if (fx->map[pos].opcode == XO_OR) { - kdata--; - val[kdata-1] = val[kdata] || val[kdata-1]; - } else if (fx->map[pos].opcode == XO_NOT) { - val[kdata-1] = !val[kdata-1]; - } else { - col = fx->map[pos].colpos; - temp.size = fx->map[col].sqlsize-1; - if (temp.size >= sizeof(buf)) - temp.size = sizeof(buf)-1; - memset(buf,0,temp.size+1); - if (fx->map[pos].valnum) { - COB_ATTR_INIT (COB_TYPE_NUMERIC_DISPLAY, 0, 0, 0, NULL); - cob_move (&fx->map[col].recfld, &temp); - rslt = atoi(fx->map[pos].value) - atoi(buf); - } else { - COB_ATTR_INIT (COB_TYPE_ALNUM, 0, 0, 0, NULL); - cob_move (&fx->map[col].recfld, &temp); - rslt = strcasecmp(fx->map[pos].value, buf); - } - if (rslt < 0) rslt = -1; - if (rslt > 0) rslt = 1; - switch (fx->map[pos].opcode) { - case XO_EQ: - if (rslt == 0) - val[kdata++] = TRUE; - else - val[kdata++] = FALSE; - break; - case XO_NE: - if (rslt != 0) - val[kdata++] = TRUE; - else - val[kdata++] = FALSE; - break; - case XO_GT: - if (rslt > 0) - val[kdata++] = TRUE; - else - val[kdata++] = FALSE; - break; - case XO_GE: - if (rslt >= 0) - val[kdata++] = TRUE; - else - val[kdata++] = FALSE; - break; - case XO_LT: - if (rslt < 0) - val[kdata++] = TRUE; - else - val[kdata++] = FALSE; - break; - case XO_LE: - if (rslt <= 0) - val[kdata++] = TRUE; - else - val[kdata++] = FALSE; - break; - default: - break; - } - } - - if (fx->map[pos].target > 0 - && kdata > 0 - && val[kdata-1]) { - rslt = fx->map[pos].target; /* Skip forward to target position */ - rslt = fx->xlbl[rslt]; - do { - pos++; - if (fx->map[pos].cmd == XC_DATA) - fx->map[pos].setnull = 1; - } while (pos < rslt); - return rslt; - } - if (fx->map[pos].target > 0) { - kdata = 0; - } - pos++; - } - return pos; -} - -static int -cob_find_xfd_col (struct file_xfd *fx, char *colname) -{ - int k; - for (k=0; k < fx->nmap; k++) { - if (fx->map[k].cmd == XC_DATA - && fx->map[k].colname - && strcasecmp (fx->map[k].colname, colname) == 0) - return k; - } - return -1; -} - -static int -getInt(char *data, int pos, int len) -{ - int val; - val = 0; - while(len-- > 0 - && (isdigit(data[pos]) || data[pos] == ' ')) { - if(data[pos] == ' ') { - val = (val * 10); - pos++; - } else { - val = (val * 10) + (data[pos++] - '0'); - } - } - return val; -} - -static void -putNum(char *data, int pos, int len, int val) -{ - char wrk[20]; - if(len <= 0) - return; - sprintf(wrk,"%0*d",len,val); - memcpy(data+pos,wrk,len); -} - -static short daysinmonth[] = { - 31, 28, 31, 30, 31, 30, - 31, 31, 30, 31, 30, 31 -}; -static int /* 1 if leap year, 0 otherwise */ -getDays( - short *days, /* Fill in array of 12 shorts with days in each month */ - int year) /* The year for which to compute leap and days per month */ -{ - int k,leap; - leap = ( year % 4 == 0 ) - && ( ( year % 100 != 0 ) || ( year % 400 == 0 ) ); - for(k=0; k < 12; k++) - days[k] = daysinmonth[k]; - days[1] += leap; - return leap; -} - -/* - Convert DISPLAY digits into SQL Internal date format -*/ -static int /* Return length of date text */ -convert_to_date( - struct db_state *db, - struct sql_date *df, /* Date format */ - char *datain, /* Display data from record */ - int inlen, /* Length of 'datain' */ - char *dataout, /* Output date in YYYY-MM-DD HH:MM:SS.hhh format */ - int outlen, /* Length of output area */ - int *dateOk) -{ - struct { - short year; - short month; - short day; - short hour; - short minute; - short second; - short hund; - } date; - int k,secsaftmid; - short days[12],cc; - int bDateBad = FALSE; - int bDateZero = TRUE; - int bDateNines = TRUE; - - for(k=0; k < inlen && isspace(datain[k]); k++); - while(k < inlen - && (bDateZero || bDateNines)) { - if(datain[k] == 0) { - k++; - if(k > 2) - break; - } - if(datain[k] != '0') { - bDateZero = FALSE; - } - if(datain[k] != '9') { - bDateNines = FALSE; - } - k++; - } - - memset(&date,0,sizeof(date)); - date.year = getInt(datain,df->yyPos,df->yyLen); - date.month = getInt(datain,df->mmPos,df->mmLen); - if (df->ddLen > 0) - date.day = getInt(datain,df->ddPos,df->ddLen); - else - date.day = 1; - if (df->ccLen > 0) { - cc = getInt(datain,df->ccPos,df->ccLen); - date.year = date.year + cc * 100; - } - if(date.year == 0 - && date.month == 0 - && date.day == 0) /* YYMMDD is all ZERO so assume date is ZERO */ - bDateZero = TRUE; - if(df->yyRule == '+') - date.year += df->yyAdj; - else if(df->yyRule == '%') - date.year += ((date.year < df->yyAdj) ? 2000 : 1900); - getDays(days,date.year); - if(df->ddLen > 2 - && !bDateZero - && !bDateNines) { /* Must be day of year */ - /* Convert day of year into MMDD */ - date.month = 1; - for(k=0; k < 12 && date.day > days[k]; k++) { - date.day -= days[k]; - date.month++; - } - } - if(df->hhLen > 0) { - date.hour = getInt(datain,df->hhPos,df->hhLen); - date.minute = getInt(datain,df->miPos,df->miLen); - date.second = getInt(datain,df->ssPos,df->ssLen); - if(date.hour > 23 - || date.minute > 59 - || date.second > 59) - bDateBad = TRUE; - } else if(df->ssLen > 4) { /* Seconds past Midnight */ - secsaftmid = getInt(datain,df->ssPos,df->ssLen); - date.hour = (secsaftmid / (60*60)); - secsaftmid = secsaftmid - (date.hour * (60*60)); - date.minute = secsaftmid / 60; - date.second = secsaftmid - (date.minute * 60); - } - if(date.month < 1 || date.month > 12) - bDateBad = TRUE; - if(date.day < 1 || date.day > days[date.month-1]) - bDateBad = TRUE; - if(bDateZero) { - if(db->mssql) - date.year = 1753; - else if(db->mysql) - date.year = 1000; - else - date.year = 1; - date.month = 1; - date.day = 1; - date.hour = date.minute = date.second = 0; - bDateBad = FALSE; - } else if(bDateNines) { - date.year = 9999; - date.month = 12; - date.day = 31; - date.hour = 23; - date.minute = 59; - date.second = 59; - bDateBad = FALSE; - } - if(db->isodbc - && bDateBad) { - if(date.hour > 23) - date.hour = 23; - if(date.minute > 59) - date.minute = 59; - if(date.second > 59) - date.second = 59; - if(date.month < 1) - date.month = 1; - if(date.month > 12) - date.month = 12; - if(date.day < 1) - date.day = 1; - if(date.day > days[date.month-1]) - date.day = days[date.month-1]; - } else if(bDateBad) { - if(date.month < 1) /* Fix Date for Oracle */ - date.month = 1; - if(date.month > 12) - date.month = 12; - if(date.day < 1) - date.day = 1; - if(date.day > days[date.month-1]) - date.day = days[date.month-1]; - } - *dateOk = !bDateBad; - if(db->oracle) { - if (df->hasTime && !df->hasDate) { - k = sprintf(dataout,"%02d%02d%02d", - date.hour,date.minute,date.second); - } else - if(outlen < 8) { - k = sprintf(dataout,"%02d%02d%02d",date.year%100,date.month,date.day); - } else if(outlen > 13 && df->hasTime) { - k = sprintf(dataout,"%04d%02d%02d%02d%02d%02d", - date.year,date.month,date.day, - date.hour,date.minute,date.second); - } else { - k = sprintf(dataout,"%04d%02d%02d",date.year,date.month,date.day); - } - } else { - if (df->hasTime && !df->hasDate) { - k = sprintf(dataout,"%02d:%02d:%02d.%03d", - date.hour,date.minute,date.second,date.hund); - } else - if(outlen > 11 && df->hasTime) { - k = sprintf(dataout,"%04d-%02d-%02d %02d:%02d:%02d.%03d", - date.year,date.month,date.day, - date.hour,date.minute,date.second,date.hund); - } else { - k = sprintf(dataout,"%04d-%02d-%02d",date.year,date.month,date.day); - } - } - return k; -} - -/* - Convert Date from SQL back into format used by application -*/ -static int -convert_from_date( - struct db_state *db, - struct sql_date *df, /* Date format */ - char *sqldate, /* DATE as returned from SQL */ - int inlen, /* length of the SQL date data */ - char *dataout, /* Output date in format defined by 'sql_date' */ - int outlen) /* Length of output area */ -{ - struct { - short year; - short month; - short day; - short hour; - short minute; - short second; - short hund; - } date; - int k,dlen,day,minyear,secsaftmid; - short days[12]; - char *pd,pdata[40]; - - if(db->mssql) - minyear = 1753; - else if(db->mysql) - minyear = 1000; - else - minyear = 1; - memset(&date,0,sizeof(date)); - pd = sqldate; - if(inlen >= sizeof(pdata)) - pd[sizeof(pdata)-1] = 0; - for(dlen=k=0; pd[k] != 0 && k < inlen; k++) { - if(isdigit(pd[k])) - pdata[dlen++] = pd[k]; - } - while(dlen < 8) - pdata[dlen++] = '0'; - pdata[dlen] = 0; - if(db->oracle) { - date.year = getInt(pdata,0,4); - date.month = getInt(pdata,4,2); - date.day = getInt(pdata,6,2); - if(dlen > 7) { - date.hour = getInt(pdata,8,2); - date.minute = getInt(pdata,10,2); - date.second = getInt(pdata,12,2); - } - } else { - date.year = getInt(sqldate,0,4); - date.month = getInt(sqldate,5,2); - date.day = getInt(sqldate,8,2); - if(dlen > 10) { - date.hour = getInt(sqldate,11,2); - date.minute = getInt(sqldate,14,2); - date.second = getInt(sqldate,17,2); - if(((char*)sqldate)[19] == '.') - date.hund = getInt(sqldate,20,3); - } - } - if(date.year == minyear - && date.month == 1 - && date.day == 1 - && date.hour == 0) { - memset(dataout,'0',outlen-1); - dataout[outlen] = 0; - return outlen-1; - } - if(date.year == 9999 - && date.month == 12 - && date.day == 31) { - memset(dataout,'9',outlen-1); - dataout[outlen] = 0; - return outlen-1; - } - if(df->yyRule == '+') { - date.year -= df->yyAdj; - } else if(df->yyRule == '#') { /* ER TDATE$ format */ - date.year -= df->yyAdj; - } else if(df->yyRule == '%') { - if(date.year >= 2000) - date.year -= 2000; - else if(date.year >= 1900) - date.year -= 1900; - } - memset(dataout,0,outlen); - if (df->yyLen == 2) - putNum(dataout,df->yyPos,df->yyLen,date.year%100); - else - putNum(dataout,df->yyPos,df->yyLen,date.year); - if (df->ccLen > 0) - putNum(dataout,df->ccPos,df->ccLen,date.year/100); - if(df->ddLen > 2) { /* Must be day of year */ - getDays(days,date.year); - /* Convert MMDD into day of year */ - day = 0; - for(k=1; k < date.month; k++) { - day += days[k-1]; - } - day += date.day; - putNum(dataout,df->ddPos,df->ddLen,day); - } else { - putNum(dataout,df->mmPos,df->mmLen,date.month); - putNum(dataout,df->ddPos,df->ddLen,date.day); - } - if(df->hhLen > 0) { - putNum(dataout,df->hhPos,df->hhLen,date.hour); - putNum(dataout,df->miPos,df->miLen,date.minute); - putNum(dataout,df->ssPos,df->ssLen,date.second); - } else if(df->ssLen > 4) { /* Seconds past midnight */ - secsaftmid = date.hour * (60*60) + date.minute * 60 + date.second; - putNum(dataout,df->ssPos,df->ssLen,secsaftmid); - } - return strlen(dataout); -} - -/* - * Read the 'file.xd' and create table of fields, etc - * 'indsize' is the size of the SQL Indicator field - */ -struct file_xfd * -cob_load_xfd (cob_file *fl, char *alt_name, int indsize) -{ - char xfdbuf[COB_NORMAL_BUFF],*sdir,*fname,*p,*mp; - char colname[80], tblname[80], asgname[256]; - char dups[4], sup[4], supchar[80]; - char opcode[16],tstval[48], commachr[8], decchr[8]; - int signopt; - int i,j,k,lbl,keyn,xfdver; - int ncols, lncols, lndata; - unsigned char supch, qt; - struct file_xfd *fx; - struct map_xfd *mx = NULL; - FILE *fi; - - xfdver = 1; - ncols = lncols = lndata = 0; - if (indsize < 4) - indsize = sizeof(long); - if (fl->xfdschema != NULL) - sdir = (char*)fl->xfdschema; - else if ((sdir = getenv("COB_SCHEMA_DIR")) == NULL) - sdir = (char*)COB_SCHEMA_DIR; - if (alt_name != NULL) { - fname = alt_name; - } else if(fl->xfdname != NULL - && fl->xfdname[0] > ' ') { - fname = (char*)fl->xfdname; - } else if (fl->assign) { - cob_field_to_string (fl->assign, asgname, (size_t)255); - if ((p = strrchr(asgname, SLASH_CHAR)) != NULL) - fname = p + 1; - else - fname = asgname; - } else { - fname = (char*)fl->select_name; - } - i = k = snprintf (xfdbuf,sizeof(xfdbuf)-4,"%s%s",sdir,SLASH_STR); - for(j=0; fname[j] != 0 && k < (sizeof(xfdbuf)-4); j++) { - if (fname[j] == '-') - xfdbuf[k] = '_'; - else if (isalnum(fname[j])) - xfdbuf[k++] = tolower(fname[j]); - } - xfdbuf[k] = 0; - strcpy(tblname,&xfdbuf[i]); - strcpy(&xfdbuf[k],".xd"); - fi = fopen (xfdbuf,"r"); - if (fi == NULL - && fname != (char*)fl->select_name) { - fname = (char*)fl->select_name; - k = i; - for(j=0; fname[j] != 0 && k < (sizeof(xfdbuf)-4); j++) { - if (fname[j] == '-') - xfdbuf[k] = '_'; - else if (isalnum(fname[j])) - xfdbuf[k++] = tolower(fname[j]); - } - xfdbuf[k] = 0; - strcpy(tblname,&xfdbuf[i]); - strcpy(&xfdbuf[k],".xd"); - fi = fopen (xfdbuf,"r"); - } - if (fi == NULL) { - cob_runtime_warning (_("Error '%s' opening '%s'"),cob_get_strerror (),xfdbuf); - return NULL; - } - fx = cob_malloc (sizeof (struct file_xfd)); - while(fgets (xfdbuf,sizeof(xfdbuf),fi) != NULL) { - if (xfdbuf[0] == '#' - || xfdbuf[0] == '*') - continue; - xfdbuf[sizeof(xfdbuf)-1] = 0; - for(k=strlen (xfdbuf); k > 0 - && (xfdbuf[k-1] == '\r' - || xfdbuf[k-1] == '\r' - || isspace (xfdbuf[k-1])); ) - xfdbuf[--k] = 0; - if (xfdbuf[0] == 'F') { /* Data field definition */ - mx = new_xfd (fx, XC_DATA); - p = getNum (&xfdbuf[2], &mx->offset); - p = getNum (p, &mx->size); - p = getNum (p, &mx->type); - p = getNum (p, &mx->sqlsize); - p = getNum (p, &mx->digits); - p = getNum (p, &mx->scale); - if (isdigit(*p)) { - p = getNum (p, &k); - mx->dtfrm = fx->date[k]; - } else if (*p == ',') { - p++; - } else { - p = getNum (p, &k); - } - if (mx->digits > 0) { - mx->valnum = TRUE; - mx->sqlColSize = mx->digits + 2; - if (mx->scale > 0) { - mx->sqlDecimals = mx->scale; - mx->sqlColSize++; - } - } else { - mx->valnum = FALSE; - mx->sqlColSize = mx->sqlsize; - } - p = getNum (p, &mx->level); - p = getStr (p, colname); - mx->colname = cob_strdup (colname); - mx->lncolname = strlen(colname); - if (mx->lncolname > fx->maxcolnmln) - fx->maxcolnmln = mx->lncolname; - ncols++; - lncols += mx->lncolname; - fx->lncols = lncols; - fx->ncols = ncols; - k = (mx->sqlsize + sizeof(long) + 4) / sizeof(long); - k = k * sizeof(long); - lndata += k; - continue; - } - if (xfdbuf[0] == 'L') { /* Define a new label */ - p = getNum (&xfdbuf[2], &lbl); - new_label (fx, lbl); - if (fx->map[fx->nmap-1].target == lbl - && fx->map[fx->nmap-1].cmd == XC_GOTO) { - fx->nmap--; /* remove useless GOTO */ - } else { - fx->xlbl[lbl] = fx->nmap; - } - continue; - } - if (xfdbuf[0] == 'G') { /* Goto a label */ - p = getNum (&xfdbuf[2], &lbl); - new_label (fx, lbl); - mx = new_xfd (fx, XC_GOTO); - mx->target = lbl; - continue; - } - if (xfdbuf[0] == 'C') { /* Condition to test */ - p = getNum (&xfdbuf[2], &lbl); - if (lbl > 0) - new_label (fx, lbl); - mx = new_xfd (fx, XC_WHEN); - mx->target = lbl; - k = strlen(p); - while (p[k-1] == '\r' - || p[k-1] == '\n' - || p[k-1] == ' ') - p[--k] = 0; - p = getPrm (p,opcode); - p = getPrm (p,colname); - supch = '\''; - mx->valnum = 0; - if (*p == '\'' || *p == '"') { - supch = *p; - } else if (isdigit(*p)) { - mx->valnum = 1; - } - p = getPrm (p,tstval); - if (colname[0] > ' ') { - mx->colname = cob_strdup (colname); - mx->lncolname = strlen(colname); - } - if (tstval[0] >= ' ') { - mx->value = cob_strdup (tstval); - mx->lnvalue = strlen(tstval); - } - if (strcmp(opcode,"!=") == 0) - mx->opcode = XO_NE; - else if (strcmp(opcode,"=") == 0) - mx->opcode = XO_EQ; - else if (strcmp(opcode,">=") == 0) - mx->opcode = XO_GE; - else if (strcmp(opcode,"<=") == 0) - mx->opcode = XO_LE; - else if (strcmp(opcode,"<") == 0) - mx->opcode = XO_LT; - else if (strcmp(opcode,">") == 0) - mx->opcode = XO_GT; - else if (strcmp(opcode,"!") == 0) - mx->opcode = XO_NOT; - else if (strcmp(opcode,"&&") == 0) - mx->opcode = XO_AND; - else if (strcmp(opcode,"||") == 0) - mx->opcode = XO_OR; - else - mx->opcode = XO_NULL; - continue; - } - if (xfdbuf[0] == 'K') { /* Key definition */ - p = getNum (&xfdbuf[2], &keyn); - if (keyn >= MAXNUMKEYS) { - cob_runtime_error (_("%s XFD has more than %d indexes!"), - fl->select_name,MAXNUMKEYS-1); - cob_stop_run (1); - } - if (keyn+1 > fx->nkeys) - fx->nkeys = keyn+1; - p = getPrm (p, dups); - p = getPrm (p, sup); - qt = *p; - p = getPrm (p, supchar); - if (memcmp(supchar,"0x",2) == 0) { - supch = (unsigned char) strtol (supchar, NULL, 16); - } else { - supch = supchar[0]; - } - if (fx->key[keyn] != NULL) { - cob_runtime_error (_("%s XFD has duplicate index %d !"), - fl->select_name,keyn); - cob_stop_run (1); - } - fx->key[keyn] = cob_malloc (sizeof (struct key_xfd)); - if (dups[0] == 'Y') - fx->key[keyn]->dups = TRUE; - else - fx->key[keyn]->dups = FALSE; - if (sup[0] == 'Y') - fx->key[keyn]->sup = TRUE; - else - fx->key[keyn]->sup = FALSE; - if (qt == '"') { - fx->key[keyn]->str_sup = (unsigned char*)cob_strdup (supchar); - } else { - fx->key[keyn]->supchar = supch; - } - do { - p = getPrm (p, colname); - if ((k = cob_find_xfd_col (fx, colname)) < 0) { - cob_runtime_error (_("%s XFD index %d has %s undefined!"), - fl->select_name,keyn,colname); - cob_stop_run (1); - } - fx->key[keyn]->col[fx->key[keyn]->ncols] = k; - fx->key[keyn]->ncols++; - fx->key[keyn]->lncols += fx->map[k].lncolname; - fx->map[k].notnull = TRUE; - fx->map[k].iskey = TRUE; - if (fx->key[keyn]->ncols >= MAXKEYCOLS) { - cob_runtime_error (_("%s XFD index %d has too many columns!"), - fl->select_name,keyn); - cob_stop_run (1); - } - } while(*p > ' '); - continue; - } - if (xfdbuf[0] == 'D') { /* Date format */ - struct sql_date *df; - p = getNum (&xfdbuf[2], &k); - if (k <= fx->ndate) { - df = cob_malloc (sizeof(struct sql_date)); - fx->date[k] = df; - p = getPrm (p, df->format); - p = getNum (p, &k); - df->digits = (unsigned char)k; - p = getNum (p, &k); - df->hasDate = (unsigned char)k; - p = getNum (p, &k); - df->hasTime = (unsigned char)k; - p = getPrm (p,opcode); - df->yyRule = (unsigned char)opcode[0]; - if (df->yyRule < ' ') - df->yyRule = ' '; - p = getNum (p, &k); - df->yyAdj = (short)k; - p = getPosLen (p, &df->yyPos,&df->yyLen); - p = getPosLen (p, &df->mmPos,&df->mmLen); - p = getPosLen (p, &df->ddPos,&df->ddLen); - p = getPosLen (p, &df->hhPos,&df->hhLen); - p = getPosLen (p, &df->miPos,&df->miLen); - p = getPosLen (p, &df->ssPos,&df->ssLen); - p = getPosLen (p, &df->ccPos,&df->ccLen); - } - continue; - } - if (xfdbuf[0] == 'H') { /* Header line */ - p = getNum (&xfdbuf[2], &xfdver); - p = getPrm (p, tblname); - p = getNum (p, &fx->ndate); - p = getPrm (p, commachr); - p = getPrm (p, decchr); - p = getNum (p, &signopt); - p = getNum (p, &fx->fileorg); - fx->date = cob_malloc (sizeof(void*) * (fx->ndate + 1)); - continue; - } - } - fx->tablename = cob_strdup (tblname); - fx->lnind = indsize; - fx->fl = fl; - /* - * Assign storage for SQL data and 'indicator' - */ - fx->sqlbf = cob_malloc (lndata + ((ncols + 2) * indsize)); - mp = (char*)&fx->sqlbf[lndata + indsize]; - j = 0; - for (i=0; i < fx->nmap; i++) { - if (fx->map[i].cmd == XC_DATA) { - k = (fx->map[i].sqlsize + sizeof(long) + 4) / sizeof(long); - k = (k * sizeof(long)); - fx->map[i].sdata = &fx->sqlbf[j]; - j += k; - memset(mp,0,indsize); - fx->map[i].ind = (void*)mp; - mp += indsize; - bld_fields (&fx->map[i],fl); - } else if (fx->map[i].cmd == XC_WHEN) { - if (fx->map[i].colname) { - if ((lbl = cob_find_xfd_col (fx, fx->map[i].colname)) < 0) { - cob_runtime_error (_("%s XFD index %d has %s undefined!"), - fl->select_name,keyn,colname); - cob_stop_run (1); - } - fx->map[i].colpos = lbl; - } - } - } - fclose(fi); - return fx; -} - -/* - * Read the 'file.ddl' and save CREATE TABLE/INDEX - */ -void -cob_load_ddl (struct db_state *db, struct file_xfd *fx) -{ - char xfdbuf[COB_NORMAL_BUFF],*sdir,*p; - int j,k, idx, ctsz, cisz; - FILE *fi; - - if (fx->create_table) - cob_free (fx->create_table); - fx->create_table = NULL; - if ((sdir = getenv("COB_SCHEMA_DIR")) == NULL) - sdir = (char*)COB_SCHEMA_DIR; - k = sprintf (xfdbuf, "%s%s%s.ddl",sdir,SLASH_STR,fx->tablename); - fi = fopen (xfdbuf,"r"); - if (fi == NULL - && fx->gentable) { - fi = fopen (xfdbuf,"w"); - cob_xfd_to_ddl (db, fx, fi) ; - fclose(fi); - fi = fopen (xfdbuf,"r"); - } - if (fi == NULL) { - cob_runtime_warning (_("Error '%s' opening '%s'"),cob_get_strerror (),xfdbuf); - return; - } - cisz = 128; - ctsz = 128; - idx = -1; - fx->create_table = cob_malloc (ctsz); - fx->lncreate = 0; - for (k=0; k < fx->nkeys; k++) { - if (fx->key[k]->create_index) - cob_free (fx->key[k]->create_index); - fx->key[k]->lncreate = 0; - fx->key[k]->create_index = cob_malloc (cisz); - } - while(fgets (xfdbuf,sizeof(xfdbuf),fi) != NULL) { - if (xfdbuf[0] == '#' - || xfdbuf[0] == '-') - continue; - xfdbuf[sizeof(xfdbuf)-1] = 0; - for(k=strlen (xfdbuf); k > 0 - && (xfdbuf[k-1] == '\r' - || xfdbuf[k-1] == '\r' - || isspace (xfdbuf[k-1])); ) - xfdbuf[--k] = 0; - for (k=0; isspace(xfdbuf[k]); k++); - for (j=0; xfdbuf[k] != 0; ) { - if (xfdbuf[k] == ' ' - && xfdbuf[k+1] == ' ') { - k++; - continue; - } - xfdbuf[j++] = xfdbuf[k++]; - } - xfdbuf[j] = 0; - if (strncasecmp(xfdbuf,"DROP ",5) == 0) - continue; - if (strncasecmp(xfdbuf,"CREATE TABLE ",13) == 0) { - idx = -1; - } else if (strncasecmp(xfdbuf,"CREATE UNIQUE INDEX ",20) == 0) { - p = &xfdbuf[20]; - if (strncasecmp (p, "pk_",3) == 0) - idx = 0; - else if (p[0] == 'k' && isdigit(p[1])) - idx = atoi(&p[1]); - } else if (strncasecmp(xfdbuf,"CREATE INDEX ",13) == 0) { - p = &xfdbuf[13]; - if (p[0] == 'k' && isdigit(p[1])) - idx = atoi(&p[1]); - } - if (idx == -1) { - if (fx->lncreate + j >= ctsz-2) { - fx->create_table = cob_realloc (fx->create_table, ctsz, ctsz + 256); - ctsz += 256; - } - if (db->isoci) { - if ((p=strcasestr(xfdbuf," BIGINT ")) != NULL) { - memcpy(p," INT ",8); - } - if ((p=strcasestr(xfdbuf," BINARY(")) != NULL) { - memcpy(p," RAW(",8); - } else - if ((p=strcasestr(xfdbuf," BINARY ")) != NULL) { - memcpy(p," RAW ",8); - } - } - strcpy(&fx->create_table[fx->lncreate], xfdbuf); - fx->lncreate += j; - if (fx->create_table[fx->lncreate-1] == ';') { - fx->create_table[fx->lncreate-1] = 0; - fx->create_table = cob_realloc (fx->create_table, ctsz, fx->lncreate + 2); - ctsz = fx->lncreate; - fx->lncreate--; - } - fx->lncreate = strlen(fx->create_table); - } else { - strcpy (&fx->key[idx]->create_index[fx->key[idx]->lncreate], xfdbuf); - fx->key[idx]->lncreate += j; - if (fx->key[idx]->create_index[fx->key[idx]->lncreate-1] == ';') { - fx->key[idx]->create_index[fx->key[idx]->lncreate-1] = 0; - fx->key[idx]->create_index = cob_realloc (fx->key[idx]->create_index, - cisz, fx->key[idx]->lncreate + 2); - fx->key[idx]->lncreate--; - } - } - } - fclose(fi); - return; -} - -void -cob_sql_dump_stmt (struct db_state *db, char *stmt, int doall) -{ -#ifndef COB_DEBUG_LOG - COB_UNUSED (db); - COB_UNUSED (stmt); - COB_UNUSED (doall); -#else - int j,k,len,frm; - len = strlen(stmt); - if (db->dbStatus != 0) - DEBUG_LOG("db",("DB Status %d : %s\n",db->dbStatus,db->odbcState)); - if (strncasecmp(stmt,"SELECT ",7) == 0) { - if (doall) { - for (frm=0; frm < len; frm++) - if(strncasecmp(&stmt[frm]," FROM ",6) == 0) - break; - frm++; - k = 0; - while ((frm - k) > 60) { - for(j=k+59; j > (k + 20) - && stmt[j] != ',' - && stmt[j] != ' '; j--); - DEBUG_LOG("db",("%.*s\n",j+1-k,&stmt[k])); - k = j + 1; - } - if (k < frm) - DEBUG_LOG("db",("%.*s\n",frm-k,&stmt[k])); - k = frm; - } else { - DEBUG_LOG("db",("%.60s %s\n",stmt,len>60?"...":"")); - for (k=50; k < len; k++) - if(strncasecmp(&stmt[k]," FROM ",6) == 0) - break; - k++; - } - while ((len - k) > 60) { - for(j=k+59; j > (k + 20) - && stmt[j] != ',' - && stmt[j] != ' '; j--); - DEBUG_LOG("db",("%.*s\n",j+1-k,&stmt[k])); - k = j + 1; - } - if (k < len) - DEBUG_LOG("db",("%s;\n",&stmt[k])); - } else { - if (doall) { - k = 0; - while ((len - k) > 60) { - for(j=k+59; j > (k + 20) - && stmt[j] != ',' - && stmt[j] != ' '; j--); - DEBUG_LOG("db",("%.*s\n",j+1-k,&stmt[k])); - k = j + 1; - } - if (k < len) - DEBUG_LOG("db",("%.*s;\n",len-k,&stmt[k])); - k = len; - } else { - DEBUG_LOG("db",("%.60s %s\n",stmt,len>60?"...":"")); - k = 60; - } - while ((len - k) > 60) { - for(j=k+59; j > (k + 20) - && stmt[j] != ',' - && stmt[j] != ' '; j--); - DEBUG_LOG("db",("%.*s\n",j+1-k,&stmt[k])); - k = j + 1; - } - if (k < len) - DEBUG_LOG("db",("%s;\n",&stmt[k])); - } -#endif -} - -void -cob_sql_dump_data ( - struct db_state *db, - struct file_xfd *fx) -{ -#ifndef COB_DEBUG_LOG - COB_UNUSED (db); - COB_UNUSED (fx); -#else - int k,pos,len; - char hexwrk[80]; - for (k=pos=0; k < fx->nmap; k++) { - if (fx->map[k].cmd == XC_DATA - && fx->map[k].colname) { - pos++; - len = fx->map[k].sqlinlen; - if (len <= 0) - len = strlen((char*)fx->map[k].sdata); - hex_dump( fx->map[k].sdata, len, hexwrk); - DEBUG_LOG("db",("Dump%3d: %-*s %s\n",pos, - fx->maxcolnmln,fx->map[k].colname, - fx->map[k].setnull?"NULL":hexwrk)); - } - } - return; -#endif -} - -void -cob_sql_dump_index ( - struct db_state *db, - struct file_xfd *fx, - int idx) -{ -#ifndef COB_DEBUG_LOG - COB_UNUSED (db); - COB_UNUSED (fx); - COB_UNUSED (idx); -#else - int i,k,len; - char hexwrk[80]; - for (i=0; i < fx->key[idx]->ncols; i++) { - k = fx->key[idx]->col[i]; - if (fx->map[k].cmd == XC_DATA - && fx->map[k].colname) { - len = fx->map[k].sqlinlen; - if (len <= 0) - len = strlen((char*)fx->map[k].sdata); - hex_dump( fx->map[k].sdata, len, hexwrk); - DEBUG_LOG("db",("Index %d Field %d: %-20s %s\n",idx,k,fx->map[k].colname, - fx->map[k].setnull?"NULL":hexwrk)); - } - } -#endif -} - -void -cob_dump_xfd (struct file_xfd *fx, FILE *fo) -{ - int k,j; - const char *op; - for (k=0; k < fx->nmap; k++) { - for (j=0; j < fx->nlbl; j++) { - if (k > 0 - && k == fx->xlbl[j]) { - fprintf(fo,"L,%d\n",j); - break; - } - } - switch (fx->map[k].cmd) { - case XC_GOTO: - fprintf(fo,"G,%d\n",fx->map[k].target); - break; - case XC_WHEN: - op = " ?? "; - switch (fx->map[k].opcode) { - case XO_GE: op = ">="; break; - case XO_LE: op = "<="; break; - case XO_GT: op = ">"; break; - case XO_LT: op = "<"; break; - case XO_NE: op = "!="; break; - case XO_EQ: op = "="; break; - case XO_AND: op = "&&"; break; - case XO_OR: op = "||"; break; - case XO_NOT: op = "!"; break; - case XO_NULL: op = " ? "; break; - } - if (fx->map[k].colname - && fx->map[k].colname[0] > ' ') { - fprintf(fo,"C,%d,%s %s ",fx->map[k].target,fx->map[k].colname,op); - if (fx->map[k].valnum) - fprintf(fo,"%s",fx->map[k].value); - else if (fx->map[k].value) - fprintf(fo,"'%s'",fx->map[k].value); - fprintf(fo,"\n"); - } else { - fprintf(fo,"C,%d,%s\n",fx->map[k].target,op); - } - break; - case XC_DATA: - fprintf(fo,"D,%04d,%04d",fx->map[k].offset,fx->map[k].size); - fprintf(fo,",%02d,%04d",fx->map[k].type,fx->map[k].sqlsize); - fprintf(fo,",%d,%d,",fx->map[k].digits,fx->map[k].scale); - if (fx->map[k].dtfrm) - fprintf(fo,"%s",fx->map[k].dtfrm->format); - fprintf(fo,",%02d,%s",fx->map[k].level,fx->map[k].colname); - fprintf(fo,"\n"); - break; - } - } -} - -/* - * Free all memory used - */ -void -cob_drop_xfd (struct file_xfd *fx) -{ - int k; - for (k=0; k < fx->nmap; k++) { - switch (fx->map[k].cmd) { - case XC_GOTO: - break; - case XC_WHEN: - if (fx->map[k].colname) - cob_free (fx->map[k].colname); - if (fx->map[k].value) - cob_free (fx->map[k].value); - break; - case XC_DATA: - if (fx->map[k].colname) - cob_free (fx->map[k].colname); - if (fx->map[k].value) - cob_free (fx->map[k].value); - break; - } - } - for (k=0; k <= fx->ndate; k++) { - if (fx->date[k] != NULL) - cob_free (fx->date[k]); - } - cob_free (fx->date); - if (fx->xlbl) - cob_free (fx->xlbl); - if (fx->map) - cob_free (fx->map); - if (fx->sqlbf) - cob_free (fx->sqlbf); - if (fx->insert.text) - cob_free (fx->insert.text); - if (fx->update.text) - cob_free (fx->update.text); - if (fx->delete.text) - cob_free (fx->delete.text); - if (fx->create_table) - cob_free (fx->create_table); - for(k=0; k < fx->nkeys; k++) { - if (fx->key[k]->create_index) - cob_free (fx->key[k]->create_index); - if (fx->key[k]->where_eq.text) - cob_free (fx->key[k]->where_eq.text); - if (fx->key[k]->where_ge.text) - cob_free (fx->key[k]->where_ge.text); - if (fx->key[k]->where_gt.text) - cob_free (fx->key[k]->where_gt.text); - if (fx->key[k]->where_le.text) - cob_free (fx->key[k]->where_le.text); - if (fx->key[k]->where_lt.text) - cob_free (fx->key[k]->where_lt.text); - cob_free (fx->key[k]); - } - cob_free (fx); -} - -/************************************************************************* - Try various combinations of schema name and suffix or ORACLE + SUFFIX - as an environment variable. Return the correct one -**************************************************************************/ -char * -getSchemaEnvName( - struct db_state *db, - char *envname, /* Resulting Env Name last matched */ - const char *suffix, - char *out) -{ - char *env; - int k; - char sch[48]; - if (db->dbSchema[0] <= ' ') { - if( (env = getenv("COB_SCHEMA_NAME")) != NULL) - snprintf(db->dbSchema,sizeof(db->dbSchema),"%s",env); - } - env = NULL; - if (out) - *out = 0; - if (db->dbSchema[0] > ' ') { - sprintf(envname,"%s%s",db->dbSchema,suffix); - if( (env = getenv(envname)) != NULL) - goto gotit; - - for(k=0; db->dbSchema[k] != 0; k++) { - sch[k] = db->dbSchema[k]; - if(sch[k] == '-') - sch[k] = '_'; - } - sch[k] = 0; - - sprintf(envname,"%s%s",sch,suffix); - if( (env = getenv(envname)) != NULL) - goto gotit; - } - - sprintf(envname,"%s%s","COB_SCHEMA",suffix); - if( (env = getenv(envname)) != NULL) - goto gotit; - - if (db->mysql) { - sprintf(envname,"%s%s","MYSQL",suffix); - if( (env = getenv(envname)) != NULL) { - if (out) - strcpy(out,env); - goto gotit; - } - } - if (db->oracle || db->isoci) { - sprintf(envname,"%s%s","ORACLE",suffix); - if( (env = getenv(envname)) != NULL) - goto gotit; - } - sprintf(envname,"%s%s","SQL",suffix); - if( (env = getenv(envname)) != NULL) - goto gotit; - - if (db->db2) { - sprintf(envname,"%s%s","DB2",suffix); - if( (env = getenv(envname)) != NULL) - goto gotit; - } - - if (db->isodbc) { - sprintf(envname,"%s%s","ODBC",suffix); - env = getenv(envname); - } - -gotit: - if( env != NULL) { - if (out) - strcpy(out,env); - } - return env; -} - -/************************************************************************* - Log the suffix env variable value -**************************************************************************/ -void -logSchemaEnvName( - struct db_state *db, - const char *suffix) -{ -#ifdef COB_DEBUG_LOG - char *env; - char envname[64]; - - if ((env=getSchemaEnvName (db, envname, suffix, NULL)) != NULL) { - DEBUG_LOG("db",("~%s is %s\n",envname,env)); - } else { - DEBUG_LOG("db",("~Env: xxxx%s is %s\n",suffix,"undefined!")); - } -#endif - return; -} - -static const char *condstr[9] = {"?","=","<","<=",">",">=","<>",">","<"}; - -static int -bld_where (struct db_state *db, struct file_xfd *fx, int idx, int cond, int pos, char *sbuf) -{ - int j,k,lparen; - char andstr[12], orstr[12]; - const char *fmt, *rel; - - if (db->isodbc) - fmt = "%s%s %s ?"; - else - fmt = "%s%s %s :%d"; - if (cond == COB_GE - || cond == COB_GT) - rel = ">"; - else - rel = "<"; - lparen = 0; - strcpy(andstr,"("); - strcpy(orstr," OR ("); - for (j=0; j < fx->key[idx]->ncols-1; j++) { - k = fx->key[idx]->col[j]; - lparen += 2; - pos += sprintf(&sbuf[pos],fmt,andstr,fx->map[k].colname,rel,j+1); - pos += sprintf(&sbuf[pos],fmt,orstr,fx->map[k].colname,"=",j+1); - strcpy(andstr," AND ("); - } - k = fx->key[idx]->col[j]; - pos += sprintf(&sbuf[pos],fmt,andstr,fx->map[k].colname,condstr[cond],j+1); - while (lparen >= 0) { - pos += sprintf(&sbuf[pos],")"); - lparen--; - } - return pos; -} - -/* - * Build SQL Statement and return as malloced string - */ -char * -cob_sql_stmt ( - struct db_state *db, - struct file_xfd *fx, - char *stmt, - int idx, - int cond, - int read_opts) -{ - char *sbuf,comma[8],rowcol[48], *op; - const char *fmt; - cob_file *f = fx->fl; - int bufsz,j,k,pos; - int lmode = FALSE; - int waitsecs = 0; - - if (idx >= fx->nkeys) { - cob_runtime_error (_("SQL Index %d incorrect: %d max!"),idx,fx->nkeys); - return NULL; - } - sbuf = NULL; - if (db->isodbc) - fmt = "%s%s %s ?"; - else - fmt = "%s%s %s :%d"; - k = 0; - sprintf(rowcol,"rid_%s",fx->tablename); - if (strncasecmp(stmt,"SELECT",6) == 0) { - if (f->retry_mode == COB_RETRY_SECONDS) { - if (f->retry_times > 0) - waitsecs = f->retry_seconds * f->retry_times; - else - waitsecs = f->retry_seconds; - } - if ((f->retry_mode & COB_RETRY_FOREVER)) { - waitsecs = 0; - } else - if ((f->retry_mode & COB_RETRY_SECONDS)) { - waitsecs = f->retry_seconds; - } else - if ((f->retry_mode & COB_RETRY_TIMES)) { - waitsecs = f->retry_times / COB_RETRY_PER_SECOND; - if (waitsecs <= 0) - waitsecs = 1; - } else - if ((f->retry_mode & COB_RETRY_NEVER)) { - waitsecs = -1; - } - if ((read_opts & COB_READ_LOCK) - || (read_opts & COB_READ_WAIT_LOCK)) { - lmode = TRUE; - } - if ((read_opts & COB_READ_IGNORE_LOCK) - || (read_opts & COB_READ_NO_LOCK) ) { - lmode = FALSE; - } - db->dbStatus = 0; - if (fx->select == NULL) { /* Build list of Column Names */ - bufsz = 8 + fx->lncols + fx->ncols; - sbuf = cob_malloc (bufsz + 1); - strcpy(comma,""); - pos = 0; - for (k=0; k < fx->nmap; k++) { - if (fx->map[k].cmd == XC_DATA - && fx->map[k].colname) { - pos += sprintf(&sbuf[pos],"%s%s",comma,fx->map[k].colname); - strcpy(comma,","); - } - } - fx->lnselect = pos; - fx->select = sbuf; - } - - if (fx->fileorg == COB_ORG_RELATIVE) { - bufsz = 16 + strlen(stmt) + fx->lnselect; - bufsz += strlen(rowcol) + 64; - } else { - bufsz = 16 + strlen(stmt) + fx->lnselect + (fx->key[idx]->lncols * 3); - bufsz += (fx->key[idx]->ncols * 20); - } - if (lmode) - bufsz += 32; - if (cond == COB_GT - || cond == COB_GE - || cond == COB_LT - || cond == COB_LE) - bufsz += (fx->key[idx]->ncols * 12); - sbuf = cob_malloc (bufsz + 1); - strcpy(comma,""); - pos = sprintf(sbuf,"%s %s FROM %s",stmt,fx->select,fx->tablename); - if (db->mssql) { - if (lmode - && db->mssqlnfu) - pos += sprintf(&sbuf[pos]," WITH (XLOCK, ROWLOCK)"); - if ((f->retry_mode & COB_ADVANCING_LOCK)) { - pos += sprintf(&sbuf[pos]," WITH (READPAST)"); - } else if (waitsecs > 0) { - } else if (waitsecs < 0) { - pos += sprintf(&sbuf[pos]," WITH (NOWAIT)"); - } - } - if (cond != COB_FI - && cond != COB_LA) - pos += sprintf(&sbuf[pos]," WHERE "); - strcpy(comma,""); - if (fx->fileorg == COB_ORG_RELATIVE) { - op = (char*)"="; - if (cond == COB_NE) - op = (char*)"<>"; - else if (cond == COB_GT) - op = (char*)">"; - else if (cond == COB_GE) - op = (char*)">="; - else if (cond == COB_LT) - op = (char*)"<"; - else if (cond == COB_LE) - op = (char*)"<="; - if (cond != COB_FI - && cond != COB_LA) - pos += sprintf(&sbuf[pos],fmt,comma,rowcol,op,1); - } else - if (cond == 0 - || cond == COB_EQ) { - for (j=0; j < fx->key[idx]->ncols; j++) { - k = fx->key[idx]->col[j]; - pos += sprintf(&sbuf[pos],fmt,comma,fx->map[k].colname,"=",j+1); - strcpy(comma," AND "); - } - } else if (cond == COB_NE) { - for (j=0; j < fx->key[idx]->ncols; j++) { - k = fx->key[idx]->col[j]; - pos += sprintf(&sbuf[pos],fmt,comma,fx->map[k].colname,"<>", j+1); - strcpy(comma," OR "); - } - } else if (cond != COB_FI - && cond != COB_LA) { - k = pos; - pos = bld_where (db, fx, idx, cond, pos, sbuf); - } - if (cond == COB_LT - || cond == COB_LE - || cond == COB_LA) - fmt = " DESC"; - else - fmt = ""; - pos += sprintf(&sbuf[pos]," ORDER BY "); - strcpy(comma,""); - if (fx->fileorg == COB_ORG_RELATIVE) { - pos += sprintf(&sbuf[pos],"%s%s",rowcol,fmt); - } else { - for (j=0; j < fx->key[idx]->ncols; j++) { - k = fx->key[idx]->col[j]; - pos += sprintf(&sbuf[pos],"%s%s%s",comma,fx->map[k].colname,fmt); - strcpy(comma,","); - } - } - if (lmode) { - if (!db->mssqlnfu) - pos += sprintf(&sbuf[pos]," FOR UPDATE"); - } - if (db->mysql) { - if ((f->retry_mode & COB_ADVANCING_LOCK)) { - if (!db->mariadb) - pos += sprintf(&sbuf[pos]," SKIP LOCKED"); - } else if (waitsecs > 0) { - if (db->mariadb) - pos += sprintf(&sbuf[pos]," WAIT %d",waitsecs); - } else if (waitsecs < 0) { - if (db->mariadb) - pos += sprintf(&sbuf[pos]," NOWAIT"); - } - } else if (db->isoci) { - if ((f->retry_mode & COB_ADVANCING_LOCK)) { - pos += sprintf(&sbuf[pos]," SKIP LOCKED"); - } else if (waitsecs > 0) { - pos += sprintf(&sbuf[pos]," WAIT %d",waitsecs); - } else if (waitsecs < 0) { - pos += sprintf(&sbuf[pos]," NOWAIT"); - } - } - DEBUG_TRACE("db",("Build %s %d Index %d\n",stmt,cond,idx)); - - } else if (strcasecmp(stmt,"INSERT") == 0) { - idx = 0; - bufsz = 32 + fx->lncols + fx->ncols * 4 + strlen(fx->tablename); - bufsz += fx->key[0]->lncols + fx->key[0]->ncols * 12; - sbuf = cob_malloc (bufsz + 1); - strcpy(comma,""); - if (db->isodbc) - fmt = "%s?"; - else - fmt = "%s:%d"; - pos = sprintf(sbuf,"INSERT INTO %s (",fx->tablename); - for (k=0; k < fx->nmap; k++) { - if (fx->map[k].cmd == XC_DATA - && fx->map[k].colname) { - pos += sprintf(&sbuf[pos],"%s%s",comma,fx->map[k].colname); - strcpy(comma,","); - } - } - pos += sprintf(&sbuf[pos],") VALUES ("); - strcpy(comma,""); - for (j=0; j < fx->ncols; j++) { - pos += sprintf(&sbuf[pos],fmt,comma,j+1); - strcpy(comma,","); - } - pos += sprintf(&sbuf[pos],")"); - - } else if (strcasecmp(stmt,"UPDATE") == 0) { - bufsz = 48 + fx->lncols + fx->ncols * 8 + strlen(fx->tablename); - sbuf = cob_malloc (bufsz + 1); - strcpy(comma,""); - pos = sprintf(sbuf,"UPDATE %s SET ",fx->tablename); - if (db->isodbc) - fmt = "%s%s %s ?"; - else - fmt = "%s%s %s :%d"; - j = 0; - for (k=0; k < fx->nmap; k++) { - if (fx->map[k].cmd == XC_DATA - && fx->map[k].colname) { - pos += sprintf(&sbuf[pos],fmt,comma,fx->map[k].colname,"=",++j); - strcpy(comma,","); - } - } - pos += sprintf(&sbuf[pos]," WHERE "); - strcpy(comma,""); - if (fx->fileorg == COB_ORG_RELATIVE) { - pos += sprintf(&sbuf[pos],fmt,comma,rowcol,"=",1); - } else { - for (j=0; j < fx->key[0]->ncols; j++) { - k = fx->key[0]->col[j]; - pos += sprintf(&sbuf[pos],fmt,comma,fx->map[k].colname,"=",j+1); - strcpy(comma," AND "); - } - } - - } else if (strcasecmp(stmt,"DELETE") == 0) { - bufsz = 32 + fx->lncols + fx->ncols * 4 + strlen(fx->tablename); - sbuf = cob_malloc (bufsz + 1); - strcpy(comma,""); - pos = sprintf(sbuf,"DELETE FROM %s ",fx->tablename); - pos += sprintf(&sbuf[pos],"WHERE "); - if (db->isodbc) - fmt = "%s%s %s ?"; - else - fmt = "%s%s %s :%d"; - strcpy(comma,""); - if (fx->fileorg == COB_ORG_RELATIVE) { - pos += sprintf(&sbuf[pos],fmt,comma,rowcol,"=",1); - } else { - for (j=0; j < fx->key[0]->ncols; j++) { - k = fx->key[0]->col[j]; - pos += sprintf(&sbuf[pos],fmt,comma,fx->map[k].colname,"=",j+1); - strcpy(comma," AND "); - } - } - } else { - cob_runtime_error (_("Unknown SQL statement: %.20s!"),stmt); - return NULL; - } - if (strncasecmp(stmt,"SELECT",6) == 0) { - /* Leave space for adding ' FOR UPDATE'; 11 bytes */ - sbuf = cob_realloc (sbuf, (size_t)bufsz, (size_t)pos+12); - } else if (bufsz > (pos+1)) { - sbuf = cob_realloc (sbuf, (size_t)bufsz, (size_t)pos+1); - } - sbuf[pos] = 0; - cob_sql_dump_stmt (db, sbuf, TRUE); - return sbuf; -} - -SQL_STMT * -cob_sql_select ( - struct db_state *db, - struct file_xfd *fx, - int ky, - int cond, - int read_opts, - void (*freeit)( SQL_STMT *)) -{ - SQL_STMT *s; - - if (cond == COB_EQ) - s = &fx->key[ky]->where_eq; - else if (cond == COB_GE) - s = &fx->key[ky]->where_ge; - else if (cond == COB_LE) - s = &fx->key[ky]->where_le; - else if (cond == COB_LT) - s = &fx->key[ky]->where_lt; - else if (cond == COB_GT) - s = &fx->key[ky]->where_gt; - else if (cond == COB_FI) - s = &fx->key[ky]->where_fi; - else if (cond == COB_LA) - s = &fx->key[ky]->where_la; - else if (cond == COB_NE) - s = &fx->key[ky]->where_ne; - else - return NULL; - - if (s->text == NULL) { - s->text = cob_sql_stmt (db, fx, (char*)"SELECT", ky, cond, read_opts); - } else if (s->readopts != read_opts) { - DEBUG_LOG ("db",("Free %d Statement\n",cond)); - freeit (s); - s->text = cob_sql_stmt (db, fx, (char*)"SELECT", ky, cond, read_opts); - } - s->readopts = read_opts; - if (cond == COB_LT - || cond == COB_LE - || cond == COB_LA) - s->isdesc = TRUE; - else - s->isdesc = FALSE; - return s; -} - -/* - * Copy data from File index fields to SQL data field(s) - */ -void -cob_index_to_xfd (struct db_state *db, struct file_xfd *fx, cob_file *fl, int idx) -{ - int i,k,nx,dl; - char sqlbuf[48]; - cob_field sqlwrk; - COB_UNUSED(db); - for (i=0; i < fx->key[idx]->ncols; i++) { - k = fx->key[idx]->col[i]; - if (fx->map[k].cmd == XC_DATA - && fx->map[k].colname) { - fx->map[k].setnull = 0; - fx->map[k].sqlfld.size = fx->map[k].sqloutlen; - memset (fx->map[k].sqlfld.data, 0, fx->map[k].sqlfld.size); - if (fx->map[k].dtfrm) { - memcpy(&sqlwrk,&fx->map[k].sqlfld,sizeof(cob_field)); - sqlwrk.data = (unsigned char *)sqlbuf; - sqlwrk.size = fx->map[k].dtfrm->digits; - cob_move (&fx->map[k].recfld, &sqlwrk); - sqlbuf[sqlwrk.size] = 0; - dl = convert_to_date (db, fx->map[k].dtfrm, (char*)sqlbuf, (int)sqlwrk.size, - (char*)fx->map[k].sqlfld.data, (int)fx->map[k].sqlfld.size, &nx); - fx->map[k].sqlfld.data[dl] = 0; - DEBUG_LOG("db",("%3d: Index %d date '%s' %s d:%d z:%d :%s\n",k,idx, - fx->map[k].dtfrm->format,fx->map[k].colname, - fx->map[k].sqlDecimals, fx->map[k].sqlColSize, nx?"Ok":"Bad Date")); - DEBUG_DUMP("db",fx->map[k].sqlfld.data,dl); - } else if (fx->map[k].type == COB_XFDT_FLOAT) { - memcpy (fx->map[k].sdata,fx->map[k].recfld.data,fx->map[k].size); - } else if (fx->map[k].type == COB_XFDT_BIN) { - memcpy (fx->map[k].sdata,fx->map[k].recfld.data,fx->map[k].size); - fx->map[k].sdata[fx->map[k].size] = 0; - } else { - cob_move (&fx->map[k].recfld, &fx->map[k].sqlfld); - fx->map[k].sqlfld.data[fx->map[k].sqlfld.size] = 0; - DEBUG_LOG("db",("%3d: Index %d %s type:%02d \n",k,idx, - fx->map[k].colname,fx->map[k].type)); - DEBUG_DUMP("db",fx->map[k].sqlfld.data,fx->map[k].sqlfld.size); - } - } - } -} - -/* - * Clear data from File index fields to SQL data field(s) - */ -void -cob_index_clear (struct db_state *db, struct file_xfd *fx, cob_file *fl, int idx) -{ - int i,k; - COB_UNUSED(db); - COB_UNUSED(fl); - for (i=0; i < fx->key[idx]->ncols; i++) { - k = fx->key[idx]->col[i]; - if (fx->map[k].cmd == XC_DATA - && fx->map[k].colname) { - fx->map[k].setnull = 0; - fx->map[k].sqlfld.size = fx->map[k].sqloutlen; - memset (fx->map[k].sqlfld.data, 0, fx->map[k].sqlfld.size); - } - } -} - -/* - * Copy data from File record area to SQL data field(s) - */ -void -cob_file_to_xfd (struct db_state *db, struct file_xfd *fx, cob_file *fl) -{ - int k,nx,dl; - char sqlbuf[48]; - cob_field sqlwrk; -#ifdef COB_DEBUG_LOG - char hexwrk[80]; -#endif - for (k=0; k < fx->nmap; ) { - if (fx->map[k].cmd == XC_DATA - && fx->map[k].colname) { - fx->map[k].setnull = 0; - fx->map[k].sqlfld.size = fx->map[k].sqloutlen; - memset (fx->map[k].sqlfld.data, 0, fx->map[k].sqlfld.size); - if (fx->map[k].dtfrm) { - memcpy(&sqlwrk,&fx->map[k].sqlfld,sizeof(cob_field)); - sqlwrk.data = (unsigned char *)sqlbuf; - sqlwrk.size = fx->map[k].dtfrm->digits; - cob_move (&fx->map[k].recfld, &sqlwrk); - sqlbuf[sqlwrk.size] = 0; - dl = convert_to_date (db, fx->map[k].dtfrm, (char*)sqlbuf, (int)sqlwrk.size, - (char*)fx->map[k].sqlfld.data, (int)fx->map[k].sqlfld.size, &nx); - fx->map[k].sqlfld.data[dl] = 0; -#ifdef COB_DEBUG_LOG - if (fx->map[k].type == COB_XFDT_PIC9L - || fx->map[k].type == COB_XFDT_PIC9LS - || fx->map[k].type == COB_XFDT_PIC9T - || fx->map[k].type == COB_XFDT_PIC9TS - || fx->map[k].type == COB_XFDT_PIC9S - || fx->map[k].type == COB_XFDT_PIC9U) { - sprintf(hexwrk,"'%.*s'",(int)fx->map[k].recfld.size,fx->map[k].recfld.data); - } else { - hex_dump( fx->map[k].recfld.data,(int)fx->map[k].recfld.size, hexwrk); - } - DEBUG_LOG("db",("%3d: Copy date '%s' %s ct:%02d ht:%d st:%d d:%d z:%d :%s\n",k, - fx->map[k].dtfrm->format,fx->map[k].colname, - fx->map[k].type, fx->map[k].hostType, fx->map[k].sqlType, - fx->map[k].sqlDecimals, fx->map[k].sqlColSize, - nx?"Ok":"Bad Date")); - DEBUG_LOG ("db",(" %s -> Temp:%.*s -> SQL:%.*s\n",hexwrk, - sqlwrk.size,sqlbuf, - fx->map[k].sqlsize,fx->map[k].sqlfld.data)); -#endif - } else if (fx->map[k].type == COB_XFDT_FLOAT) { - memcpy (fx->map[k].sdata,fx->map[k].recfld.data,fx->map[k].size); - } else if (fx->map[k].type == COB_XFDT_BIN) { - memcpy (fx->map[k].sdata,fx->map[k].recfld.data,fx->map[k].size); - fx->map[k].sdata[fx->map[k].size] = 0; - } else { - cob_move (&fx->map[k].recfld, &fx->map[k].sqlfld); - fx->map[k].sqlfld.data[fx->map[k].sqlfld.size] = 0; -#ifdef COB_DEBUG_LOG - DEBUG_LOG("db",("%3d: Copy %s type:%02d %dv%d ht:%d st:%d d:%d z:%d\n",k, - fx->map[k].colname,fx->map[k].type, - fx->map[k].digits,fx->map[k].scale, - fx->map[k].hostType, fx->map[k].sqlType, - fx->map[k].sqlDecimals, fx->map[k].sqlColSize)); - if (fx->map[k].type == COB_XFDT_PICA - || fx->map[k].type == COB_XFDT_PICX - || fx->map[k].type == COB_XFDT_VARX - || fx->map[k].type == COB_XFDT_PIC9L - || fx->map[k].type == COB_XFDT_PIC9LS - || fx->map[k].type == COB_XFDT_PIC9T - || fx->map[k].type == COB_XFDT_PIC9TS - || fx->map[k].type == COB_XFDT_PIC9U) { - DEBUG_LOG ("db",(" '%.*s'\n",(int)fx->map[k].recfld.size, - fx->map[k].recfld.data)); - } else { - DEBUG_DUMP("db",fx->map[k].recfld.data,fx->map[k].recfld.size); - DEBUG_DUMP("db",fx->map[k].sqlfld.data,fx->map[k].sqlfld.size); - } -#endif - } - k++; - - } else if (fx->map[k].cmd == XC_GOTO) { - nx = fx->xlbl[fx->map[k].target]; - do { - k++; - if (fx->map[k].cmd == XC_DATA) /* Field skipped are set NULL */ - fx->map[k].setnull = 1; - } while (k < nx); - fx->map[k].jumpto = k; - continue; - } else if (fx->map[k].cmd == XC_WHEN) { - nx = eval_expr (fx, k); - if (nx < k) - break; - k = nx; - } else { - k++; - } - } -} - -/* - * Copy data from SQL data field(s) to File Record area - */ -void -cob_xfd_to_file (struct db_state *db, struct file_xfd *fx, cob_file *fl) -{ - int k,nx; - char sqlbuf[48]; - cob_field sqlwrk; -#ifdef COB_DEBUG_LOG - char hexwrk[80]; -#endif - for (k=0; k < fx->nmap; ) { - if (fx->map[k].setnull) { - memset (fx->map[k].sqlfld.data, 0, fx->map[k].sqlfld.size); - k++; - continue; - } - if (fx->map[k].cmd == XC_DATA - && fx->map[k].colname) { - if (fx->map[k].dtfrm) { - memcpy(&sqlwrk,&fx->map[k].sqlfld,sizeof(cob_field)); - sqlwrk.data = (unsigned char *)sqlbuf; - sqlwrk.size = fx->map[k].dtfrm->digits; - cob_move (&fx->map[k].sqlfld, &sqlwrk); - sqlbuf[sqlwrk.size] = 0; - convert_from_date (db, fx->map[k].dtfrm, - (char*)fx->map[k].sqlfld.data, (int)fx->map[k].sqlfld.size, - (char*)sqlbuf, (int)sqlwrk.size); - cob_move (&sqlwrk, &fx->map[k].recfld); -#ifdef COB_DEBUG_LOG - DEBUG_LOG("db",("%3d: Read date '%s' %s type: %02d \n",k, - fx->map[k].dtfrm->format,fx->map[k].colname,fx->map[k].type)); - hex_dump( fx->map[k].recfld.data,fx->map[k].recfld.size, hexwrk); - DEBUG_LOG ("db",(" SQL:%.*s -> Temp:%.*s -> 0x%s\n", - fx->map[k].sqlsize,fx->map[k].sqlfld.data, - sqlwrk.size,sqlbuf,hexwrk)); -#endif - } else if (fx->map[k].type == COB_XFDT_FLOAT) { - memcpy (fx->map[k].recfld.data,fx->map[k].sdata,fx->map[k].size); - } else if (fx->map[k].type == COB_XFDT_BIN) { - memcpy (fx->map[k].recfld.data,fx->map[k].sdata,fx->map[k].size); - } else if (fx->map[k].digits > 0) { - fx->map[k].sqlfld.size = fx->map[k].sqlinlen; - cob_move (&fx->map[k].sqlfld, &fx->map[k].recfld); -#ifdef COB_DEBUG_LOG - if (fx->map[k].type == COB_XFDT_PIC9L - || fx->map[k].type == COB_XFDT_PIC9LS - || fx->map[k].type == COB_XFDT_PIC9T - || fx->map[k].type == COB_XFDT_PIC9TS - || fx->map[k].type == COB_XFDT_PIC9S - || fx->map[k].type == COB_XFDT_PIC9U) { - sprintf(hexwrk,"'%.*s'",(int)fx->map[k].recfld.size,fx->map[k].recfld.data); - } else { - hex_dump( fx->map[k].recfld.data,(int)fx->map[k].recfld.size, hexwrk); - } - DEBUG_LOG("db",("%3d: Read %s type: %02d %dv%d inlen:%d fldsz:%d\n",k, - fx->map[k].colname,fx->map[k].type, - fx->map[k].digits,fx->map[k].scale, - fx->map[k].sqlinlen,(int)fx->map[k].recfld.size)); - DEBUG_LOG ("db",(" SQL:%.*s -> %s\n", - fx->map[k].sqlinlen,fx->map[k].sqlfld.data, - hexwrk)); -#endif - } else { - fx->map[k].sqlfld.size = fx->map[k].sqlinlen; - cob_move (&fx->map[k].sqlfld, &fx->map[k].recfld); -#ifdef COB_DEBUG_LOG - DEBUG_LOG("db",("%3d: Read %s type: %02d len:%d\n",k, - fx->map[k].colname,fx->map[k].type, - fx->map[k].sqlinlen)); - if (fx->map[k].type == COB_XFDT_PICA - || fx->map[k].type == COB_XFDT_PICX - || fx->map[k].type == COB_XFDT_VARX) { - DEBUG_LOG ("db",(" '%.*s'\n",(int)fx->map[k].recfld.size, - fx->map[k].recfld.data)); - } else { - DEBUG_DUMP("db",fx->map[k].sqlfld.data,fx->map[k].sqlfld.size); - DEBUG_DUMP("db",fx->map[k].recfld.data,fx->map[k].recfld.size); - } -#endif - } - k++; - - } else if (fx->map[k].cmd == XC_GOTO) { - if (fx->map[k].jumpto > 0) { - k = fx->map[k].jumpto; - continue; - } - nx = fx->xlbl[fx->map[k].target]; - do { - k++; - } while (k < nx); - continue; - } else if (fx->map[k].cmd == XC_WHEN) { - nx = eval_expr (fx, k); - if (nx < k) - break; - k = nx; - } else { - k++; - } - } -} - -/* - * Create DDL from XFD - */ -void -cob_xfd_to_ddl (struct db_state *db, struct file_xfd *fx, FILE *fo) -{ - int k,nx,col; - char comma[8],idxname[48]; - fprintf(fo,"CREATE TABLE %s (",fx->tablename); - strcpy(comma,"\n"); - for (k=0; k < fx->nmap; k++) { - if (fx->map[k].cmd == XC_DATA - && fx->map[k].colname - && fx->map[k].level > 0) { - fprintf(fo,"%s%s ",comma,fx->map[k].colname); - strcpy(comma,",\n"); - if (fx->map[k].dtfrm) { - fprintf(fo,"DATE"); - } else if (fx->map[k].type == COB_XFDT_FLOAT) { - if (fx->map[k].size > 4) - fprintf(fo,"FLOAT(53)"); - else - fprintf(fo,"FLOAT(23)"); - } else if ( fx->map[k].type == COB_XFDT_PIC9L - || fx->map[k].type == COB_XFDT_PIC9LS - || fx->map[k].type == COB_XFDT_PIC9T - || fx->map[k].type == COB_XFDT_PIC9TS - || fx->map[k].type == COB_XFDT_PIC9S - || fx->map[k].type == COB_XFDT_COMP5S - || fx->map[k].type == COB_XFDT_COMP5U - || fx->map[k].type == COB_XFDT_COMPS - || fx->map[k].type == COB_XFDT_COMPU - || fx->map[k].type == COB_XFDT_COMPX - || fx->map[k].type == COB_XFDT_PACKS - || fx->map[k].type == COB_XFDT_PACKU - || fx->map[k].type == COB_XFDT_PIC9U) { - if (fx->map[k].scale > 0) - fprintf(fo,"DECIMAL(%d,%d)",fx->map[k].digits,fx->map[k].scale); - else - fprintf(fo,"DECIMAL(%d)",fx->map[k].digits); - } else if (fx->map[k].type == COB_XFDT_BIN) { - if (db->isoci) - fprintf(fo,"RAW(%d)",fx->map[k].size); - else - fprintf(fo,"BINARY(%d)",fx->map[k].size); - } else if (fx->map[k].type == COB_XFDT_VARX) { - fprintf(fo,"VARCHAR(%d)",fx->map[k].size); - } else { - fprintf(fo,"CHAR(%d)",fx->map[k].size); - } - if (fx->map[k].notnull) - fprintf(fo," NOT NULL"); - } - } - if (fx->fl - && fx->fl->organization == COB_ORG_RELATIVE) { - fprintf(fo,"%srid_%s %s PRIMARY KEY",comma,fx->tablename,db->isoci?"INT":"BIGINT"); - } - fprintf(fo,"\n);\n"); - - if (fx->fl - && fx->fl->organization == COB_ORG_INDEXED) { - for (nx=0; nx < fx->nkeys && fx->key[nx]; nx++) { - if(nx == 0) - sprintf(idxname,"pk_%s",fx->tablename); - else - sprintf(idxname,"k%d_%s",nx,fx->tablename); - fprintf(fo,"CREATE %sINDEX %s ON %s (", - fx->key[nx]->dups || fx->key[nx]->sup ? "" : "UNIQUE ", - idxname,fx->tablename); - strcpy(comma,""); - for(k=0; k < fx->key[nx]->ncols; k++) { - col = fx->key[nx]->col[k]; - fprintf(fo,"%s%s",comma,fx->map[col].colname); - strcpy(comma,","); - } - fprintf(fo,");\n"); - } - } -} -#endif diff -Nru gnucobol-4.0~early~20200606/libcob/intrinsic.c gnucobol-5/libcob/intrinsic.c --- gnucobol-4.0~early~20200606/libcob/intrinsic.c 2020-06-06 20:52:01.000000000 +0000 +++ gnucobol-5/libcob/intrinsic.c 1970-01-01 00:00:00.000000000 +0000 @@ -1,6802 +0,0 @@ -/* - Copyright (C) 2005-2012, 2014-2019 Free Software Foundation, Inc. - Written by Roger While, Simon Sobisch, Edward Hart, Brian Tiffin - - This file is part of GnuCOBOL. - - The GnuCOBOL runtime library is free software: you can redistribute it - and/or modify it under the terms of the GNU Lesser General Public License - as published by the Free Software Foundation, either version 3 of the - License, or (at your option) any later version. - - GnuCOBOL is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU Lesser General Public License for more details. - - You should have received a copy of the GNU Lesser General Public License - along with GnuCOBOL. If not, see . -*/ - - -#include - -#include -#include -#include -#include -#include -#include -#include -#include -#ifdef HAVE_SYS_TIME_H -#include -#endif -#include - -/* Note we include the Cygwin version of windows.h here */ -#if defined(_WIN32) || defined(__CYGWIN__) || defined(HAVE_LANGINFO_CODESET) -#define LOCTIME_BUFSIZE 128 - -#if defined(_WIN32) || defined(__CYGWIN__) -#undef HAVE_LANGINFO_CODESET -#define WIN32_LEAN_AND_MEAN -#include -#ifdef _WIN32 -#include -#endif -#endif - -#ifdef HAVE_LANGINFO_CODESET -#include -#endif -#endif - -#ifdef HAVE_LOCALE_H -#include -#endif - -/* Force symbol exports, include decimal definitions */ -#define COB_LIB_EXPIMP -#include "gmp.h" -#include "libcob.h" -#include "coblocal.h" - -/* Function prototypes */ -static cob_u32_t integer_of_date (const int, const int, const int); -static void get_iso_week (const int, int *, int *); - -/* Local variables */ - -static cob_global *cobglobptr; - -static const cob_field_attr const_alpha_attr = - {COB_TYPE_ALPHANUMERIC, 0, 0, 0, NULL}; - -/* Working fields */ -static cob_field *move_field; - -static cob_decimal d1; -static cob_decimal d2; -static cob_decimal d3; -static cob_decimal d4; -static cob_decimal d5; - -static mpz_t cob_mexp; -static mpz_t cob_mpzt; - -static mpf_t cob_mpft; -static mpf_t cob_mpft2; -static mpf_t cob_mpft_get; -static mpf_t cob_log_half; -static mpf_t cob_sqrt_two; -static mpf_t cob_pi; - - -/* Stack definitions for created fields */ - -struct calc_struct { - cob_field calc_field; - cob_field_attr calc_attr; - size_t calc_size; -}; - -static struct calc_struct *calc_base; -static cob_field *curr_field; -static cob_u32_t curr_entry; - -/* Constants for date/day calculations */ -static const int normal_days[] = - {0, 31, 59, 90, 120, 151, 181, 212, 243, 273, 304, 334, 365}; -static const int leap_days[] = - {0, 31, 60, 91, 121, 152, 182, 213, 244, 274, 305, 335, 366}; -static const int normal_month_days[] = - {0, 31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31}; -static const int leap_month_days[] = - {0, 31, 29, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31}; - - -#define COB_DATESTR_LEN 11 -#define COB_DATESTR_MAX (COB_DATESTR_LEN - 1) - -#define COB_TIMEDEC_MAX 9 - -#define COB_TIMESTR_LEN 26 /* including max decimal places */ -#define COB_TIMESTR_MAX (COB_TIMESTR_LEN - 1) - -#define COB_DATETIMESTR_LEN 37 -#define COB_DATETIMESTR_MAX (COB_DATETIMESTR_LEN - 1) - -/* Locale name to Locale ID table */ -#if defined(_WIN32) || defined(__CYGWIN__) - -struct winlocale { - const char *winlocalename; - const int winlocaleid; -}; - -static const struct winlocale wintable[] = -{ - { "af_ZA", 0x0436 }, - { "am_ET", 0x045e }, - { "ar_AE", 0x3801 }, - { "ar_BH", 0x3c01 }, - { "ar_DZ", 0x1401 }, - { "ar_EG", 0x0c01 }, - { "ar_IQ", 0x0801 }, - { "ar_JO", 0x2c01 }, - { "ar_KW", 0x3401 }, - { "ar_LB", 0x3001 }, - { "ar_LY", 0x1001 }, - { "ar_MA", 0x1801 }, - { "ar_OM", 0x2001 }, - { "ar_QA", 0x4001 }, - { "ar_SA", 0x0401 }, - { "ar_SY", 0x2801 }, - { "ar_TN", 0x1c01 }, - { "ar_YE", 0x2401 }, - { "arn_CL", 0x047a }, - { "as_IN", 0x044d }, - { "az_Cyrl_AZ", 0x082c }, - { "az_Latn_AZ", 0x042c }, - { "ba_RU", 0x046d }, - { "be_BY", 0x0423 }, - { "bg_BG", 0x0402 }, - { "bn_IN", 0x0445 }, - { "bo_BT", 0x0851 }, - { "bo_CN", 0x0451 }, - { "br_FR", 0x047e }, - { "bs_Cyrl_BA", 0x201a }, - { "bs_Latn_BA", 0x141a }, - { "ca_ES", 0x0403 }, - { "cs_CZ", 0x0405 }, - { "cy_GB", 0x0452 }, - { "da_DK", 0x0406 }, - { "de_AT", 0x0c07 }, - { "de_CH", 0x0807 }, - { "de_DE", 0x0407 }, - { "de_LI", 0x1407 }, - { "de_LU", 0x1007 }, - { "dsb_DE", 0x082e }, - { "dv_MV", 0x0465 }, - { "el_GR", 0x0408 }, - { "en_029", 0x2409 }, - { "en_AU", 0x0c09 }, - { "en_BZ", 0x2809 }, - { "en_CA", 0x1009 }, - { "en_GB", 0x0809 }, - { "en_IE", 0x1809 }, - { "en_IN", 0x4009 }, - { "en_JM", 0x2009 }, - { "en_MY", 0x4409 }, - { "en_NZ", 0x1409 }, - { "en_PH", 0x3409 }, - { "en_SG", 0x4809 }, - { "en_TT", 0x2c09 }, - { "en_US", 0x0409 }, - { "en_ZA", 0x1c09 }, - { "en_ZW", 0x3009 }, - { "es_AR", 0x2c0a }, - { "es_BO", 0x400a }, - { "es_CL", 0x340a }, - { "es_CO", 0x240a }, - { "es_CR", 0x140a }, - { "es_DO", 0x1c0a }, - { "es_EC", 0x300a }, - { "es_ES", 0x040a }, - { "es_GT", 0x100a }, - { "es_HN", 0x480a }, - { "es_MX", 0x080a }, - { "es_NI", 0x4c0a }, - { "es_PA", 0x180a }, - { "es_PE", 0x280a }, - { "es_PR", 0x500a }, - { "es_PY", 0x3c0a }, - { "es_SV", 0x440a }, - { "es_US", 0x540a }, - { "es_UY", 0x380a }, - { "es_VE", 0x200a }, - { "et_EE", 0x0425 }, - { "eu_ES", 0x042d }, - { "fa_IR", 0x0429 }, - { "fi_FI", 0x040b }, - { "fil_PH", 0x0464 }, - { "fo_FO", 0x0438 }, - { "fr_BE", 0x080c }, - { "fr_CA", 0x0c0c }, - { "fr_CH", 0x100c }, - { "fr_FR", 0x040c }, - { "fr_LU", 0x140c }, - { "fr_MC", 0x180c }, - { "fy_NL", 0x0462 }, - { "ga_IE", 0x083c }, - { "gbz_AF", 0x048c }, - { "gd", 0x043c }, - { "gl_ES", 0x0456 }, - { "gsw_FR", 0x0484 }, - { "gu_IN", 0x0447 }, - { "ha_Latn_NG", 0x0468 }, - { "he_IL", 0x040d }, - { "hi_IN", 0x0439 }, - { "hr_BA", 0x101a }, - { "hr_HR", 0x041a }, - { "hu_HU", 0x040e }, - { "hy_AM", 0x042b }, - { "id_ID", 0x0421 }, - { "ig_NG", 0x0470 }, - { "ii_CN", 0x0478 }, - { "is_IS", 0x040f }, - { "it_CH", 0x0810 }, - { "it_IT", 0x0410 }, - { "iu_Cans_CA", 0x045d }, - { "iu_Latn_CA", 0x085d }, - { "ja_JP", 0x0411 }, - { "ka_GE", 0x0437 }, - { "kh_KH", 0x0453 }, - { "kk_KZ", 0x043f }, - { "kl_GL", 0x046f }, - { "kn_IN", 0x044b }, - { "ko_KR", 0x0412 }, - { "kok_IN", 0x0457 }, - { "ky_KG", 0x0440 }, - { "lb_LU", 0x046e }, - { "lo_LA", 0x0454 }, - { "lt_LT", 0x0427 }, - { "lv_LV", 0x0426 }, - { "mi_NZ", 0x0481 }, - { "mk_MK", 0x042f }, - { "ml_IN", 0x044c }, - { "mn_Cyrl_MN", 0x0450 }, - { "mn_Mong_CN", 0x0850 }, - { "moh_CA", 0x047c }, - { "mr_IN", 0x044e }, - { "ms_BN", 0x083e }, - { "ms_MY", 0x043e }, - { "mt_MT", 0x043a }, - { "nb_NO", 0x0414 }, - { "ne_NP", 0x0461 }, - { "nl_BE", 0x0813 }, - { "nl_NL", 0x0413 }, - { "nn_NO", 0x0814 }, - { "ns_ZA", 0x046c }, - { "oc_FR", 0x0482 }, - { "or_IN", 0x0448 }, - { "pa_IN", 0x0446 }, - { "pl_PL", 0x0415 }, - { "ps_AF", 0x0463 }, - { "pt_BR", 0x0416 }, - { "pt_PT", 0x0816 }, - { "qut_GT", 0x0486 }, - { "quz_BO", 0x046b }, - { "quz_EC", 0x086b }, - { "quz_PE", 0x0c6b }, - { "rm_CH", 0x0417 }, - { "ro_MO", 0x0818 }, - { "ro_RO", 0x0418 }, - { "ru_MO", 0x0819 }, - { "ru_RU", 0x0419 }, - { "rw_RW", 0x0487 }, - { "sa_IN", 0x044f }, - { "sah_RU", 0x0485 }, - { "se_FI", 0x0c3b }, - { "se_NO", 0x043b }, - { "se_SE", 0x083b }, - { "si_LK", 0x045b }, - { "sk_SK", 0x041b }, - { "sl_SI", 0x0424 }, - { "sma_NO", 0x183b }, - { "sma_SE", 0x1c3b }, - { "smj_NO", 0x103b }, - { "smj_SE", 0x143b }, - { "smn_FI", 0x243b }, - { "sms_FI", 0x203b }, - { "sq_AL", 0x041c }, - { "sr_Cyrl_BA", 0x1c1a }, - { "sr_Cyrl_CS", 0x0c1a }, - { "sr_Latn_BA", 0x181a }, - { "sr_Latn_CS", 0x081a }, - { "st", 0x0430 }, - { "sv_FI", 0x081d }, - { "sv_SE", 0x041d }, - { "sw_KE", 0x0441 }, - { "syr_SY", 0x045a }, - { "ta_IN", 0x0449 }, - { "te_IN", 0x044a }, - { "tg_Cyrl_TJ", 0x0428 }, - { "th_TH", 0x041e }, - { "tk_TM", 0x0442 }, - { "tmz_Latn_DZ", 0x085f }, - { "tn_ZA", 0x0432 }, - { "tr_IN", 0x0820 }, - { "tr_TR", 0x041f }, - { "ts", 0x0431 }, - { "tt_RU", 0x0444 }, - { "ug_CN", 0x0480 }, - { "uk_UA", 0x0422 }, - { "ur_PK", 0x0420 }, - { "uz_Cyrl_UZ", 0x0843 }, - { "uz_Latn_UZ", 0x0443 }, - { "vi_VN", 0x042a }, - { "wen_DE", 0x042e }, - { "wo_SN", 0x0488 }, - { "xh_ZA", 0x0434 }, - { "yi", 0x043d }, - { "yo_NG", 0x046a }, - { "zh_CN", 0x0804 }, - { "zh_HK", 0x0c04 }, - { "zh_MO", 0x1404 }, - { "zh_SG", 0x1004 }, - { "zh_TW", 0x0404 }, - { "zu_ZA", 0x0435 } -}; - -#define WINLOCSIZE sizeof(wintable) / sizeof(struct winlocale) - -#endif - - -/* Pi - Next 3 digits 000 */ -static const char cob_pi_str[] = - "3.141592653589793238462643383279502884197169399375" - "10582097494459230781640628620899862803482534211706" - "79821480865132823066470938446095505822317253594081" - "28481117450284102701938521105559644622948954930381" - "96442881097566593344612847564823378678316527120190" - "91456485669234603486104543266482133936072602491412" - "73724587006606315588174881520920962829254091715364" - "36789259036001133053054882046652138414695194151160" - "94330572703657595919530921861173819326117931051185" - "48074462379962749567351885752724891227938183011949" - "12983367336244065664308602139494639522473719070217" - "98609437027705392171762931767523846748184676694051" - "32000568127145263560827785771342757789609173637178" - "72146844090122495343014654958537105079227968925892" - "35420199561121290219608640344181598136297747713099" - "60518707211349999998372978049951059731732816096318" - "59502445945534690830264252230825334468503526193118" - "817101"; -/* Sqrt 2 - Next 3 digits 001 */ -static const char cob_sqrt_two_str[] = - "1.414213562373095048801688724209698078569671875376" - "94807317667973799073247846210703885038753432764157" - "27350138462309122970249248360558507372126441214970" - "99935831413222665927505592755799950501152782060571" - "47010955997160597027453459686201472851741864088919" - "86095523292304843087143214508397626036279952514079" - "89687253396546331808829640620615258352395054745750" - "28775996172983557522033753185701135437460340849884" - "71603868999706990048150305440277903164542478230684" - "92936918621580578463111596668713013015618568987237" - "23528850926486124949771542183342042856860601468247" - "20771435854874155657069677653720226485447015858801" - "62075847492265722600208558446652145839889394437092" - "65918003113882464681570826301005948587040031864803" - "42194897278290641045072636881313739855256117322040" - "24509122770022694112757362728049573810896750401836" - "98683684507257993647290607629969413804756548237289" - "97180326802474420629269124859052181004459842150591" - "12024944134172853147810580360337107730918286931471" - "01711116839165817268894197587165821521282295184884" - "72089694633862891562882765952635140542267653239694" - "61751129160240871551013515045538128756005263146801" - "71274026539694702403005174953188629256313851881634" - "78"; -/* Log 0.5 - Next 3 digits 000 */ -static const char cob_log_half_str[] = - "-0.69314718055994530941723212145817656807550013436" - "02552541206800094933936219696947156058633269964186" - "87542001481020570685733685520235758130557032670751" - "63507596193072757082837143519030703862389167347112" - "33501153644979552391204751726815749320651555247341" - "39525882950453007095326366642654104239157814952043" - "74043038550080194417064167151864471283996817178454" - "69570262716310645461502572074024816377733896385506" - "95260668341137273873722928956493547025762652098859" - "69320196505855476470330679365443254763274495125040" - "60694381471046899465062201677204245245296126879465" - "46193165174681392672504103802546259656869144192871" - "60829380317271436778265487756648508567407764845146" - "44399404614226031930967354025744460703080960850474" - "86638523138181676751438667476647890881437141985494" - "23151997354880375165861275352916610007105355824987" - "94147295092931138971559982056543928717"; - -/* mpf_init2 length = ceil (log2 (10) * strlen (x)) */ -#define COB_PI_LEN 2820UL -#define COB_SQRT_TWO_LEN 3827UL -#define COB_LOG_HALF_LEN 2784UL - -#define RETURN_IF_NOT_ZERO(expr) \ - do { \ - int error_pos = (expr); \ - if (error_pos != 0) { \ - return error_pos; \ - } \ - } ONCE_COB - -/* Local functions */ - -static void -make_field_entry (cob_field *f) -{ - unsigned char *s; - struct calc_struct *calc_temp; - - calc_temp = calc_base + curr_entry; - curr_field = &calc_temp->calc_field; - if (f->size > calc_temp->calc_size) { - if (curr_field->data) { - cob_free (curr_field->data); - } - calc_temp->calc_size = f->size + 1; - s = cob_malloc (f->size + 1U); - } else { - s = curr_field->data; - memset (s, 0, f->size); - } - - *curr_field = *f; - calc_temp->calc_attr = *(f->attr); - curr_field->attr = &calc_temp->calc_attr; - - curr_field->data = s; - - if (++curr_entry >= COB_DEPTH_LEVEL) { - curr_entry = 0; - } -} - -static int -leap_year (const int year) -{ - return ((year % 4 == 0 && year % 100 != 0) || (year % 400 == 0)) ? 1 : 0; -} - -static int -comp_field (const void *m1, const void *m2) -{ - cob_field *f1; - cob_field *f2; - - f1 = *(cob_field **) m1; - f2 = *(cob_field **) m2; - return cob_cmp (f1, f2); -} - -/* Reference modification */ -static void -calc_ref_mod (cob_field *f, const int offset, const int length) -{ - size_t calcoff; - size_t size; - - if ((size_t)offset <= f->size) { - calcoff = (size_t)offset - 1; - size = f->size - calcoff; - if (length > 0 && (size_t)length < size) { - size = (size_t)length; - } - f->size = size; - if (calcoff > 0) { - memmove (f->data, f->data + calcoff, size); - } - } -} - -/* Decimal <-> Decimal */ - -static COB_INLINE COB_A_INLINE void -cob_decimal_set (cob_decimal *dst, const cob_decimal *src) -{ - mpz_set (dst->value, src->value); - dst->scale = src->scale; -} - -/* Trim trailing zeros in decimal places */ -static void -cob_trim_decimal (cob_decimal *d) -{ - if (!mpz_sgn (d->value)) { - /* Value is zero */ - d->scale = 0; - return; - } - for ( ; d->scale > 0; d->scale--) { - if (!mpz_divisible_ui_p (d->value, 10UL)) { - break; - } - mpz_tdiv_q_ui (d->value, d->value, 10UL); - } -} - -static void -cob_alloc_set_field_int (const int val) -{ - cob_u16_t attrsign; - cob_field_attr attr; - cob_field field; - - if (val < 0) { - attrsign = COB_FLAG_HAVE_SIGN; - } else { - attrsign = 0; - } - COB_ATTR_INIT (COB_TYPE_NUMERIC_BINARY, 9, - 0, attrsign, NULL); - COB_FIELD_INIT (4, NULL, &attr); - make_field_entry (&field); - memcpy (curr_field->data, &val, sizeof(int)); -} - -static void -cob_alloc_set_field_uint (const cob_u32_t val) -{ - cob_field_attr attr; - cob_field field; - - COB_ATTR_INIT (COB_TYPE_NUMERIC_BINARY, 10, - 0, 0, NULL); - COB_FIELD_INIT (4, NULL, &attr); - make_field_entry (&field); - memcpy (curr_field->data, &val, sizeof(cob_u32_t)); -} - -static void -cob_alloc_set_field_pretty (const cob_u32_t val) -{ - cob_field_attr attr; - cob_field field; - int sz; - char buff[32]; - - sz = sprintf(buff,"%d",val); - COB_ATTR_INIT (COB_TYPE_NUMERIC_DISPLAY, sz, 0, 0, NULL); - COB_FIELD_INIT (sz, NULL, &attr); - make_field_entry (&field); - memcpy (curr_field->data, buff, sz); -} - -static void -cob_alloc_field (cob_decimal *d) -{ - size_t bitnum; - size_t sign; - unsigned short attrsign; - short size, scale; - cob_field_attr attr; - cob_field field; - - if (unlikely (d->scale == COB_DECIMAL_NAN)) { - /* Check this */ - cob_set_exception (COB_EC_ARGUMENT_FUNCTION); - COB_ATTR_INIT (COB_TYPE_NUMERIC_BINARY, 9, - 0, 0, NULL); - COB_FIELD_INIT (4, NULL, &attr); - make_field_entry (&field); - return; - } - - if (mpz_sgn (d->value) < 0) { - attrsign = COB_FLAG_HAVE_SIGN; - sign = 1; - } else { - attrsign = 0; - sign = 0; - } - - cob_trim_decimal (d); - - bitnum = mpz_sizeinbase (d->value, 2); - if (bitnum < (33 - sign) && d->scale < 10) { - /* 4 bytes binary */ - COB_ATTR_INIT (COB_TYPE_NUMERIC_BINARY, 9, - (short)d->scale, attrsign, NULL); - COB_FIELD_INIT (4, NULL, &attr); - make_field_entry (&field); - } else if (bitnum < (65 - sign) && d->scale < 19) { - /* 8 bytes binary */ - COB_ATTR_INIT (COB_TYPE_NUMERIC_BINARY, 20, - (short)d->scale, attrsign, NULL); - COB_FIELD_INIT (8, NULL, &attr); - make_field_entry (&field); - } else { - /* Display decimal */ - size = (short)mpz_sizeinbase (d->value, 10); - if (d->scale > size) { - size = (short)d->scale; - } - scale = (short)d->scale; - COB_ATTR_INIT (COB_TYPE_NUMERIC_DISPLAY, size, - scale, attrsign, NULL); - COB_FIELD_INIT (size, NULL, &attr); - make_field_entry (&field); - } -} - -/* Common function for intrinsics MOD and REM */ - -static cob_field * -cob_mod_or_rem (cob_field *f1, cob_field *f2, const int func_is_rem) -{ - int sign; - - cobglobptr->cob_exception_code = 0; - cob_decimal_set_field (&d2, f1); - cob_decimal_set_field (&d3, f2); - - if (!mpz_sgn (d3.value)) { - /* function argument violation */ - cob_set_exception (COB_EC_ARGUMENT_FUNCTION); - cob_alloc_set_field_uint (0); - return curr_field; - } - - cob_decimal_div (&d2, &d3); - - /* Calculate integer / integer-part */ - if (d2.scale < 0) { - mpz_ui_pow_ui (cob_mexp, 10UL, (cob_uli_t)-d2.scale); - mpz_mul (d2.value, d2.value, cob_mexp); - } else if (d2.scale > 0) { - sign = mpz_sgn (d2.value); - mpz_ui_pow_ui (cob_mexp, 10UL, (cob_uli_t)d2.scale); - if (func_is_rem) { - /* REMAINDER function - INTEGER-PART */ - mpz_tdiv_q (d2.value, d2.value, cob_mexp); - } else { - /* MOD function - INTEGER */ - mpz_tdiv_qr (d2.value, cob_mpzt, d2.value, cob_mexp); - /* Check negative and has decimal places */ - if (sign < 0 && mpz_sgn (cob_mpzt)) { - mpz_sub_ui (d2.value, d2.value, 1UL); - } - } - } - d2.scale = 0; - - cob_decimal_set_field (&d1, f2); - cob_decimal_mul (&d2, &d1); - cob_decimal_set_field (&d1, f1); - cob_decimal_sub (&d1, &d2); - - cob_alloc_field (&d1); - (void)cob_decimal_get_field (&d1, curr_field, 0); - return curr_field; -} - -/* Validate NUMVAL-F item */ -/* sp = spaces */ -/* [sp][+|-][sp]{digits[.[digits]]|.digits}[sp][E[sp]{+|-}[sp]digits[sp]] */ - -static int -cob_check_numval_f (const cob_field *srcfield) -{ - unsigned char *p; - size_t plus_minus; - size_t digits; - size_t dec_seen; - size_t space_seen; - size_t e_seen; - size_t break_needed; - size_t exponent; - size_t e_plus_minus; - int n; - unsigned char dec_pt; - - if (!srcfield->size) { - return 1; - } - p = srcfield->data; - plus_minus = 0; - digits = 0; - dec_seen = 0; - space_seen = 0; - e_seen = 0; - break_needed = 0; - exponent = 0; - e_plus_minus = 0; - dec_pt = COB_MODULE_PTR->decimal_point; - - /* Check leading positions */ - for (n = 0; n < (int)srcfield->size; ++n, ++p) { - switch (*p) { - case '0': - case '1': - case '2': - case '3': - case '4': - case '5': - case '6': - case '7': - case '8': - case '9': - break_needed = 1; - break; - case ' ': - continue; - case '+': - case '-': - if (plus_minus) { - return n + 1; - } - plus_minus = 1; - continue; - case ',': - case '.': - if (*p != dec_pt) { - return n + 1; - } - break_needed = 1; - break; - default: - return n + 1; - } - if (break_needed) { - break; - } - } - - if (n == (int)srcfield->size) { - return n + 1; - } - - for (; n < (int)srcfield->size; ++n, ++p) { - switch (*p) { - case '0': - case '1': - case '2': - case '3': - case '4': - case '5': - case '6': - case '7': - case '8': - case '9': - if (e_seen) { - if (++exponent > 4 || !e_plus_minus) { - return n + 1; - } - } else if (++digits > COB_MAX_DIGITS || space_seen) { - return n + 1; - } - continue; - case ',': - case '.': - if (dec_seen || space_seen || e_seen) { - return n + 1; - } - if (*p == dec_pt) { - dec_seen = 1; - continue; - } - return n + 1; - case ' ': - space_seen = 1; - continue; - case 'E': - if (e_seen) { - return n + 1; - } - e_seen = 1; - continue; - case '+': - case '-': - if (e_seen) { - if (e_plus_minus) { - return n + 1; - } - e_plus_minus = 1; - } else { - if (plus_minus) { - return n + 1; - } - plus_minus = 1; - } - continue; - default: - return n + 1; - } - } - - if (!digits || (e_seen && !exponent)) { - return n + 1; - } - - return 0; -} - -/* Decimal <-> GMP float */ - -static void -cob_decimal_set_mpf (cob_decimal *d, const mpf_t src) -{ - char *p; - char *q; - cob_sli_t scale; - cob_sli_t len; - - if (!mpf_sgn (src)) { - mpz_set_ui (d->value, 0UL); - d->scale = 0; - return; - } - q = mpf_get_str (NULL, &scale, 10, (size_t)96, src); - p = q; - mpz_set_str (d->value, p, 10); - if (*p == '-') { - ++p; - } - len = (cob_sli_t)strlen (p); - cob_gmp_free (q); - len -= scale; - if (len >= 0) { - d->scale = len; - } else { - mpz_ui_pow_ui (cob_mexp, 10UL, (cob_uli_t)-len); - mpz_mul (d->value, d->value, cob_mexp); - d->scale = 0; - } -} - -static void -cob_decimal_get_mpf (mpf_t dst, const cob_decimal *d) -{ - cob_sli_t scale; - - mpf_set_z (dst, d->value); - scale = d->scale; - if (scale < 0) { - mpz_ui_pow_ui (cob_mexp, 10UL, (cob_uli_t)-scale); - mpf_set_z (cob_mpft_get, cob_mexp); - mpf_mul (dst, dst, cob_mpft_get); - } else if (scale > 0) { - mpz_ui_pow_ui (cob_mexp, 10UL, (cob_uli_t)scale); - mpf_set_z (cob_mpft_get, cob_mexp); - mpf_div (dst, dst, cob_mpft_get); - } -} - -/* Trigonometric formulae (formulas?) from Wikipedia */ - - -/* Exp function */ -/* e ^ x = {n = 0, ...} ( (x ^ n) / n! ) */ - -static void -cob_mpf_exp (mpf_t dst_val, const mpf_t src_val) -{ - mpf_t vf1, vf2, vf3; - mpf_t dst_temp; - cob_sli_t expon, i; - cob_uli_t n; - cob_u32_t is_negative; - - - mpf_init2 (dst_temp, COB_MPF_PREC); - - mpf_init2 (vf1, COB_MPF_PREC); - mpf_set (vf1, src_val); - mpf_init2 (vf2, COB_MPF_PREC); - mpf_set_ui (vf2, 1UL); - mpf_init2 (vf3, COB_MPF_PREC); - - mpf_set_ui (dst_temp, 1UL); - - if (mpf_sgn (vf1) < 0) { - mpf_neg (vf1, vf1); - is_negative = 1; - } else { - is_negative = 0; - } - - mpf_get_d_2exp (&expon, vf1); - if (expon > 0) { - mpf_div_2exp (vf1, vf1, (cob_uli_t)expon); - } - - n = 1; - do { - mpf_mul (vf2, vf2, vf1); - mpf_div_ui (vf2, vf2, (cob_uli_t)n); - mpf_set (vf3, dst_temp); - mpf_add (dst_temp, dst_temp, vf2); - ++n; - } while (!mpf_eq (vf3, dst_temp, COB_MPF_CUTOFF)); - - for (i = 0; i < expon; ++i) { - mpf_mul (dst_temp, dst_temp, dst_temp); - } - - if (is_negative) { - mpf_ui_div (dst_temp, 1UL, dst_temp); - } - - mpf_set (dst_val, dst_temp); - mpf_clear (dst_temp); - - mpf_clear (vf3); - mpf_clear (vf2); - mpf_clear (vf1); -} - -/* Log function */ -/* logn (x) = {n = 1, ...} ( ((1 - x) ^ n) / n ) */ - -static void -cob_mpf_log (mpf_t dst_val, const mpf_t src_val) -{ - mpf_t vf1, vf2, vf3, vf4; - mpf_t dst_temp; - cob_sli_t expon; - cob_uli_t n; - - - - if (mpf_sgn (src_val) <= 0 || !mpf_cmp_ui (src_val, 1UL)) { - mpf_set_ui (dst_val, 0UL); - return; - } - - mpf_init2 (dst_temp, COB_MPF_PREC); - - mpf_init2 (vf1, COB_MPF_PREC); - mpf_set (vf1, src_val); - mpf_init2 (vf2, COB_MPF_PREC); - mpf_init2 (vf3, COB_MPF_PREC); - mpf_set_si (vf3, -1L); - mpf_init2 (vf4, COB_MPF_PREC); - - mpf_set_ui (dst_temp, 0UL); - mpf_get_d_2exp (&expon, vf1); - if (expon != 0) { - mpf_set (dst_temp, cob_log_half); - if (expon > 0) { - mpf_mul_ui (dst_temp, dst_temp, (cob_uli_t)expon); - mpf_neg (dst_temp, dst_temp); - mpf_div_2exp (vf1, vf1, (cob_uli_t)expon); - } else { - mpf_mul_ui (dst_temp, dst_temp, (cob_uli_t)-expon); - mpf_mul_2exp (vf1, vf1, (cob_uli_t)-expon); - } - } - mpf_ui_sub (vf1, 1UL, vf1); - - n = 1; - do { - mpf_mul (vf3, vf3, vf1); - mpf_div_ui (vf2, vf3, n); - mpf_set (vf4, dst_temp); - mpf_add (dst_temp, dst_temp, vf2); - ++n; - } while (!mpf_eq (vf4, dst_temp, COB_MPF_CUTOFF)); - - mpf_set (dst_val, dst_temp); - mpf_clear (dst_temp); - - mpf_clear (vf4); - mpf_clear (vf3); - mpf_clear (vf2); - mpf_clear (vf1); -} - -/* Log10 function */ -/* log10 (x) = log (x) / log (10) */ - -static void -cob_mpf_log10 (mpf_t dst_val, const mpf_t src_val) -{ - mpf_t vf1; - mpf_t dst_temp; - - mpf_init2 (dst_temp, COB_MPF_PREC); - - mpf_init2 (vf1, COB_MPF_PREC); - - cob_mpf_log (dst_temp, src_val); - mpf_set_ui (vf1, 10UL); - cob_mpf_log (vf1, vf1); - mpf_div (dst_temp, dst_temp, vf1); - - mpf_set (dst_val, dst_temp); - mpf_clear (dst_temp); - - mpf_clear (vf1); -} - -/* Sin function */ -/* sin (x) = (reduce to pi/2) */ -/* {n = 0, ...} ( (-1 ^ n) * ( x ^ (2n + 1)) / (2n + 1) ) */ - -static void -cob_mpf_sin (mpf_t dst_val, const mpf_t src_val) -{ - mpf_t vf1, vf2, vf3, vf4, vf5; - mpf_t dst_temp; - cob_uli_t arcquad; - cob_uli_t n; - int sign; - - mpf_init2 (dst_temp, COB_MPF_PREC); - - mpf_init2 (vf1, COB_MPF_PREC); - mpf_init2 (vf2, COB_MPF_PREC); - mpf_init2 (vf3, COB_MPF_PREC); - mpf_init2 (vf4, COB_MPF_PREC); - mpf_init2 (vf5, COB_MPF_PREC); - sign = mpf_sgn (src_val); - - mpf_abs (vf4, src_val); - mpf_set (vf3, cob_pi); - mpf_div_2exp (vf3, vf3, 1UL); - mpf_div (vf1, vf4, vf3); - mpf_floor (vf4, vf1); - - if (mpf_cmp_ui (vf4, 4UL) >= 0) { - mpf_div_2exp (vf2, vf4, 2UL); - mpf_floor (vf2, vf2); - mpf_mul_2exp (vf2, vf2, 2UL); - mpf_sub (vf2, vf4, vf2); - } else { - mpf_set (vf2, vf4); - } - - arcquad = mpf_get_ui (vf2); - mpf_sub (vf2, vf1, vf4); - mpf_mul (vf4, vf3, vf2); - - if (arcquad > 1) { - sign = -sign; - } - if (arcquad & 1) { - mpf_sub (vf4, vf3, vf4); - } - - mpf_mul (vf3, vf4, vf4); - mpf_neg (vf3, vf3); - - n = 1; - mpf_set_ui (vf2, 1UL); - mpf_set_ui (dst_temp, 1UL); - - do { - ++n; - mpf_div_ui (vf2, vf2, n); - ++n; - mpf_div_ui (vf2, vf2, n); - mpf_mul (vf2, vf2, vf3); - mpf_set (vf5, dst_temp); - mpf_add (dst_temp, dst_temp, vf2); - } while (!mpf_eq (vf5, dst_temp, COB_MPF_PREC)); - - mpf_mul (dst_temp, dst_temp, vf4); - if (sign < 0) { - mpf_neg (dst_temp, dst_temp); - } - - mpf_set (dst_val, dst_temp); - mpf_clear (dst_temp); - - mpf_clear (vf5); - mpf_clear (vf4); - mpf_clear (vf3); - mpf_clear (vf2); - mpf_clear (vf1); -} - -/* Cos function */ -/* cos (x) = sin ((pi / 2) - x) */ - -static void -cob_mpf_cos (mpf_t dst_val, const mpf_t src_val) -{ - mpf_t vf1; - - mpf_init2 (vf1, COB_MPF_PREC); - - mpf_set (vf1, cob_pi); - mpf_div_2exp (vf1, vf1, 1UL); - mpf_sub (vf1, vf1, src_val); - cob_mpf_sin (dst_val, vf1); - - mpf_clear (vf1); -} - -/* Tan function */ -/* tan (x) = sin(x) / cos(x) */ - -static void -cob_mpf_tan (mpf_t dst_val, const mpf_t src_val) -{ - mpf_t vf1; - mpf_t vf2; - - mpf_init2 (vf1, COB_MPF_PREC); - mpf_init2 (vf2, COB_MPF_PREC); - - cob_mpf_sin (vf1, src_val); - cob_mpf_cos (vf2, src_val); - mpf_div (dst_val, vf1, vf2); - - mpf_clear (vf1); - mpf_clear (vf2); -} - -/* Atan function */ - -static void -cob_mpf_atan (mpf_t dst_val, const mpf_t src_val) -{ - mpf_t vf1, vf2, vf3, vf4; - mpf_t dst_temp; - cob_uli_t n; - - mpf_init2 (dst_temp, COB_MPF_PREC); - - mpf_init2 (vf1, COB_MPF_PREC); - mpf_init2 (vf2, COB_MPF_PREC); - mpf_init2 (vf3, COB_MPF_PREC); - mpf_init2 (vf4, COB_MPF_PREC); - - mpf_abs (vf1, src_val); - mpf_add_ui (vf3, cob_sqrt_two, 1UL); - - if (mpf_cmp (vf1, vf3) > 0) { - mpf_set (dst_temp, cob_pi); - mpf_div_2exp (dst_temp, dst_temp, 1UL); - mpf_ui_div (vf1, 1UL, vf1); - mpf_neg (vf1, vf1); - } else { - mpf_sub_ui (vf4, cob_sqrt_two, 1UL); - if (mpf_cmp (vf1, vf4) > 0) { - mpf_set (dst_temp, cob_pi); - mpf_div_2exp (dst_temp, dst_temp, 2UL); - mpf_sub_ui (vf3, vf1, 1UL); - mpf_add_ui (vf4, vf1, 1UL); - mpf_div (vf1, vf3, vf4); - } else { - mpf_set_ui (dst_temp, 0UL); - } - } - mpf_mul (vf2, vf1, vf1); - mpf_neg (vf2, vf2); - mpf_add (dst_temp, dst_temp, vf1); - - n = 1; - - do { - mpf_mul (vf1, vf1, vf2); - mpf_div_ui (vf3, vf1, 2UL * n + 1UL); - mpf_set (vf4, dst_temp); - mpf_add (dst_temp, dst_temp, vf3); - ++n; - } while (!mpf_eq (vf4, dst_temp, COB_MPF_PREC)); - - if (mpf_sgn (src_val) < 0) { - mpf_neg (dst_temp, dst_temp); - } - - mpf_set (dst_val, dst_temp); - mpf_clear (dst_temp); - - mpf_clear (vf4); - mpf_clear (vf3); - mpf_clear (vf2); - mpf_clear (vf1); -} - -/* Asin function */ -/* asin (x) = 2 * atan (x / (1 + sqrt (1 - (x ** 2)))) */ - -static void -cob_mpf_asin (mpf_t dst_val, const mpf_t src_val) -{ - mpf_t vf1, vf2; - mpf_t dst_temp; - - mpf_init2 (dst_temp, COB_MPF_PREC); - - if (!mpf_cmp_ui (src_val, 1UL) || !mpf_cmp_si (src_val, -1L)) { - mpf_set (dst_temp, cob_pi); - mpf_div_ui (dst_temp, dst_temp, 2UL); - if (mpf_sgn (src_val) < 0) { - mpf_neg (dst_temp, dst_temp); - } - mpf_set (dst_val, dst_temp); - mpf_clear (dst_temp); - return; - } - if (!mpz_sgn (src_val)) { - mpf_set_ui (dst_val, 0UL); - mpf_clear (dst_temp); - return; - } - - mpf_init2 (vf1, COB_MPF_PREC); - mpf_init2 (vf2, COB_MPF_PREC); - - mpf_mul (vf2, src_val, src_val); - mpf_ui_sub (vf2, 1UL, vf2); - mpf_sqrt (vf2, vf2); - - mpf_add_ui (vf2, vf2, 1UL); - - mpf_div (vf1, src_val, vf2); - cob_mpf_atan (dst_temp, vf1); - mpf_mul_ui (dst_temp, dst_temp, 2UL); - - mpf_set (dst_val, dst_temp); - mpf_clear (dst_temp); - - mpf_clear (vf2); - mpf_clear (vf1); -} - -/* Acos function */ -/* acos (x) = 2 * atan (sqrt (1 - (x ** 2)) / (1 + x)) */ - -static void -cob_mpf_acos (mpf_t dst_val, const mpf_t src_val) -{ - mpf_t vf1, vf2; - mpf_t dst_temp; - - mpf_init2 (dst_temp, COB_MPF_PREC); - - if (!mpf_sgn (src_val)) { - mpf_set (dst_temp, cob_pi); - mpf_div_ui (dst_temp, dst_temp, 2UL); - mpf_set (dst_val, dst_temp); - mpf_clear (dst_temp); - return; - } - if (!mpf_cmp_ui (src_val, 1UL)) { - mpf_set_ui (dst_val, 0UL); - mpf_clear (dst_temp); - return; - } - if (!mpf_cmp_si (src_val, -1L)) { - mpf_set (dst_val, cob_pi); - mpf_clear (dst_temp); - return; - } - - mpf_init2 (vf1, COB_MPF_PREC); - mpf_init2 (vf2, COB_MPF_PREC); - - mpf_add_ui (vf2, src_val, 1UL); - mpf_mul (vf1, src_val, src_val); - mpf_ui_sub (vf1, 1UL, vf1); - mpf_sqrt (vf1, vf1); - mpf_div (vf1, vf1, vf2); - cob_mpf_atan (dst_temp, vf1); - mpf_mul_ui (dst_temp, dst_temp, 2UL); - - mpf_set (dst_val, dst_temp); - mpf_clear (dst_temp); - - mpf_clear (vf2); - mpf_clear (vf1); -} - -/* SUBSTITUTE(-CASE) functions */ - -static size_t -get_substituted_size (cob_field *original, cob_field **matches, cob_field **reps, - const int numreps, - int (*cmp_func)(const void *, const void *, size_t)) -{ - unsigned char *match_begin = original->data; - size_t orig_size = original->size; - size_t calcsize = 0; - size_t cur_idx; - size_t found = 0; - int i; - - for (cur_idx = 0; cur_idx < orig_size; ) { - /* Try to find a match at this point */ - for (i = 0; i < numreps; ++i) { - /* If we overflow the string */ - if (cur_idx + matches[i]->size > orig_size) { - continue; - } - - /* If we find a match */ - if (!(*cmp_func) (match_begin, matches[i]->data, matches[i]->size)) { - /* Go past it */ - match_begin += matches[i]->size; - cur_idx += matches[i]->size; - /* Keep track how long new string will be */ - calcsize += reps[i]->size; - - found = 1; - break; - } - } - - if (found) { - found = 0; - } else { - /* Move forward one char */ - ++cur_idx; - ++match_begin; - ++calcsize; - } - } - - return calcsize; -} - -static void -substitute_matches (cob_field *original, cob_field **matches, cob_field **reps, - const int numreps, - int (*cmp_func)(const void *, const void *, size_t), - unsigned char *replaced_begin) -{ - unsigned char *match_begin = original->data; - size_t orig_size = original->size; - size_t cur_idx; - size_t found = 0; - int i; - - for (cur_idx = 0; cur_idx < orig_size; ) { - /* Try to find a match at this point. */ - for (i = 0; i < numreps; ++i) { - /* If we overrun */ - if (cur_idx + matches[i]->size > orig_size) { - continue; - } - - /* If we find a match */ - if (!(*cmp_func) (match_begin, matches[i]->data, matches[i]->size)) { - /* Write the replacement */ - memcpy (replaced_begin, reps[i]->data, reps[i]->size); - /* Move past the match/replacement */ - match_begin += matches[i]->size; - replaced_begin += reps[i]->size; - cur_idx += matches[i]->size; - - found = 1; - break; - } - } - - if (found) { - found = 0; - continue; - } else { - /* Add unmatched char to final string and move on one */ - ++cur_idx; - *replaced_begin++ = *match_begin++; - } - } -} - -static cob_field * -substitute (const int offset, const int length, const int params, - int (*cmp_func)(const void *, const void *, size_t), - va_list args) -{ - - cob_field *original; - cob_field **matches; - cob_field **reps; - int i; - size_t calcsize; - int numreps = params / 2; - cob_field field; - - matches = cob_malloc ((size_t)numreps * sizeof (cob_field *)); - reps = cob_malloc ((size_t)numreps * sizeof (cob_field *)); - - /* Extract args */ - original = va_arg (args, cob_field *); - for (i = 0; i < params - 1; ++i) { - if ((i % 2) == 0) { - matches[i / 2] = va_arg (args, cob_field *); - } else { - reps[i / 2] = va_arg (args, cob_field *); - } - } - - va_end (args); - - /* Perform substitution */ - - calcsize = get_substituted_size (original, matches, reps, numreps, cmp_func); - - COB_FIELD_INIT (0, NULL, &const_alpha_attr); - field.size = calcsize; - make_field_entry (&field); - - substitute_matches (original, matches, reps, numreps, cmp_func, curr_field->data); - - /* Output placed in curr_field */ - - cob_free (matches); - cob_free (reps); - - if (unlikely (offset > 0)) { - calc_ref_mod (curr_field, offset, length); - } - return curr_field; -} - -static int -int_strncasecmp (const void *s1, const void *s2, size_t n) -{ - return (int) strncasecmp (s1, s2, n); -} - -/* NUMVAL */ - -static int -in_last_n_chars (const cob_field *field, const size_t n, const unsigned int i) -{ - return i + n >= field->size; -} - -static int -at_cr_or_db (const cob_field *srcfield, const int pos) -{ - return memcmp (&srcfield->data[pos], "CR", (size_t)2) == 0 - || memcmp (&srcfield->data[pos], "DB", (size_t)2) == 0; -} - -enum numval_type { - NUMVAL, - NUMVAL_C -}; - -static cob_field * -numval (cob_field *srcfield, cob_field *currency, const enum numval_type type) -{ - unsigned char *final_buff = NULL; - unsigned char *currency_data = NULL; - size_t i; - int final_digits = 0; - int decimal_digits = 0; - int sign = 0; - int decimal_seen = 0; - unsigned char dec_pt = COB_MODULE_PTR->decimal_point; - unsigned char cur_symb = COB_MODULE_PTR->currency_symbol; - - /* Validate source field */ - if (cob_check_numval (srcfield, currency, type == NUMVAL_C, 0)) { - cob_set_exception (COB_EC_ARGUMENT_FUNCTION); - cob_alloc_set_field_uint (0); - return curr_field; - } - - final_buff = cob_malloc (srcfield->size + 1U); - if (currency && currency->size < srcfield->size) { - currency_data = currency->data; - } - - for (i = 0; i < srcfield->size; ++i) { - if (!in_last_n_chars (srcfield, 2, i) - && at_cr_or_db (srcfield, i)) { - sign = 1; - break; - } - - if (currency_data) { - /* FIXME: only do so if i has a reasonable size [or at least is < INT_MAX] - otherwise an overflow may occur - */ - if (!(in_last_n_chars (srcfield, currency->size, i)) - && !memcmp (&srcfield->data[i], currency_data, - currency->size)) { - i += (currency->size - 1); - continue; - } - } else if (type == NUMVAL_C && srcfield->data[i] == cur_symb) { - continue; - } - - if (srcfield->data[i] == ' ') { - continue; - } - if (srcfield->data[i] == '+') { - continue; - } - if (srcfield->data[i] == '-') { - sign = 1; - continue; - } - if (srcfield->data[i] == dec_pt) { - decimal_seen = 1; - continue; - } - if (srcfield->data[i] >= (unsigned char)'0' && - srcfield->data[i] <= (unsigned char)'9') { - if (decimal_seen) { - decimal_digits++; - } - final_buff[final_digits++] = srcfield->data[i]; - } - if (final_digits > COB_MAX_DIGITS) { - break; - } - } - - /* If srcfield is an empty string */ - if (!final_digits) { - final_buff[0] = '0'; - } - - mpz_set_str (d1.value, (char *)final_buff, 10); - cob_free (final_buff); - if (sign && mpz_sgn (d1.value)) { - mpz_neg (d1.value, d1.value); - } - d1.scale = decimal_digits; - cob_alloc_field (&d1); - (void)cob_decimal_get_field (&d1, curr_field, 0); - - return curr_field; -} - -/* Numeric functions */ - -static void -get_min_and_max_of_args (const int num_args, va_list args, cob_field **min, cob_field **max) -{ - int i; - cob_field *f; - - *min = va_arg (args, cob_field *); - *max = *min; - - for (i = 1; i < num_args; ++i) { - f = va_arg (args, cob_field *); - if (cob_cmp (f, *min) < 0) { - *min = f; - } - if (cob_cmp (f, *max) > 0) { - *max = f; - } - } -} - -/* Uses d1 and d2. Return value in d1. */ -static void -calc_mean_of_args (const int num_args, va_list args) -{ - int i; - cob_field *f; - - mpz_set_ui (d1.value, 0UL); - d1.scale = 0; - - for (i = 0; i < num_args; ++i) { - f = va_arg (args, cob_field *); - cob_decimal_set_field (&d2, f); - cob_decimal_add (&d1, &d2); - } - - mpz_set_ui (d2.value, (cob_uli_t)num_args); - d2.scale = 0; - cob_decimal_div (&d1, &d2); -} - -/* Return variance in d1. Uses d2, d3 and d4. */ -static void -calc_variance_of_args (const int n, va_list numbers, cob_decimal *mean) -{ - cob_field *f; - int i; - cob_decimal *difference = &d2; - cob_decimal *sum = &d3; - cob_decimal *num_numbers = &d4; - - if (n == 1) { - mpz_set_ui (d1.value, 0UL); - d1.scale = 0; - return; - } - - mpz_set_ui (sum->value, 0UL); - sum->scale = 0; - - /* Get the sum of the squares of the differences from the mean */ - /* i.e., Sum ((arg - mean)^2) */ - for (i = 0; i < n; ++i) { - f = va_arg (numbers, cob_field *); - - cob_decimal_set_field (difference, f); - cob_decimal_sub (difference, mean); - cob_decimal_mul (difference, difference); - cob_decimal_add (sum, difference); - } - - /* Divide sum by n */ - mpz_set_ui (num_numbers->value, (cob_uli_t)n); - num_numbers->scale = 0; - cob_decimal_div (sum, num_numbers); - - cob_decimal_set (&d1, sum); -} - -/* Date/time functions */ - -static void -get_interval_and_current_year_from_args (const int num_args, va_list args, - int * const interval, int * const current_year) -{ - cob_field *f; - time_t t; - struct tm *timeptr; - - if (num_args > 1) { - f = va_arg (args, cob_field *); - *interval = cob_get_int (f); - } else { - *interval = 50; - } - - if (num_args > 2) { - f = va_arg (args, cob_field *); - *current_year = cob_get_int (f); - } else { - t = time (NULL); - timeptr = localtime (&t); - *current_year = 1900 + timeptr->tm_year; - } -} - -/* Locale time */ - -#if defined(_WIN32) || defined(__CYGWIN__) || defined (HAVE_LANGINFO_CODESET) -#ifdef HAVE_LANGINFO_CODESET -static int -locale_time (const int hours, const int minutes, const int seconds, - cob_field *locale_field, char *buff) -{ - char *deflocale = NULL; - struct tm tstruct; - char buff2[LOCTIME_BUFSIZE] = { '\0' }; - char locale_buff[COB_SMALL_BUFF] = { '\0' }; - - /* Initialize tstruct to given time */ - memset ((void *)&tstruct, 0, sizeof(struct tm)); - tstruct.tm_hour = hours; - tstruct.tm_min = minutes; - tstruct.tm_sec = seconds; - - if (locale_field) { - if (locale_field->size >= COB_SMALL_BUFF) { - return 1; - } - cob_field_to_string (locale_field, locale_buff, - (size_t)COB_SMALL_MAX); - deflocale = locale_buff; - (void) setlocale (LC_TIME, deflocale); - } - - /* Get strftime format string for locale */ - memset (buff2, 0, LOCTIME_BUFSIZE); - snprintf(buff2, LOCTIME_BUFSIZE - 1, "%s", nl_langinfo(T_FMT)); - - /* Set locale if not done yet */ - if (deflocale) { - (void) setlocale (LC_ALL, cobglobptr->cob_locale); - } - - strftime (buff, LOCTIME_BUFSIZE, buff2, &tstruct); - - return 0; -} -#else -static int -locale_time (const int hours, const int minutes, const int seconds, - cob_field *locale_field, char *buff) -{ - size_t len; - unsigned char *p; - LCID localeid = LOCALE_USER_DEFAULT; - SYSTEMTIME syst; - char locale_buff[COB_SMALL_BUFF] = { '\0' }; - - /* Initialize syst with given time */ - memset ((void *)&syst, 0, sizeof(syst)); - syst.wHour = (WORD)hours; - syst.wMinute = (WORD)minutes; - syst.wSecond = (WORD)seconds; - - /* Get specified locale */ - if (locale_field) { - if (locale_field->size >= COB_SMALL_BUFF) { - return 1; - } - cob_field_to_string (locale_field, locale_buff, - COB_SMALL_MAX); - - /* Null-terminate last char of the locale string */ - for (p = (unsigned char *)locale_buff; *p; ++p) { - if (isalnum((int)*p) || *p == '_') { - continue; - } - break; - } - *p = 0; - - /* Find locale ID */ - for (len = 0; len < WINLOCSIZE; ++len) { - if (!strcmp(locale_buff, wintable[len].winlocalename)) { - localeid = wintable[len].winlocaleid; - break; - } - } - if (len == WINLOCSIZE) { - return 1; - } - } - - /* Get locale time */ - if (!GetTimeFormat (localeid, LOCALE_NOUSEROVERRIDE, &syst, NULL, buff, - LOCTIME_BUFSIZE)) { - return 1; - } - - return 0; -} -#endif -#endif - -/* offset and length are for reference modification */ -static void -cob_alloc_set_field_str (char *str, const int offset, const int length) -{ - const size_t str_len = strlen (str); - cob_field field; - - COB_FIELD_INIT (str_len, NULL, &const_alpha_attr); - make_field_entry (&field); - memcpy (curr_field->data, str, str_len); - - if (unlikely (offset > 0)) { - calc_ref_mod (curr_field, offset, length); - } -} - -static void -cob_alloc_set_field_spaces (const int n) -{ - cob_field field; - - COB_FIELD_INIT (n, NULL, &const_alpha_attr); - make_field_entry (&field); - memset (curr_field->data, ' ', (size_t)n); -} - -/* Date/time functions */ - -static int -days_in_year (const int year) -{ - return 365 + leap_year (year); -} - -static COB_INLINE COB_A_INLINE int -in_range (const int min, const int max, const int val) -{ - return min <= val && val <= max; -} - -static int -valid_integer_date (const int days) -{ - return in_range (1, 3067671, days); -} - -static int -valid_year (const int year) -{ - return in_range (1601, 9999, year); -} - -static int -valid_month (const int month) -{ - return in_range (1, 12, month); -} - -static int -valid_day_of_year (const int year, const int day) -{ - return in_range (1, days_in_year (year), day); -} - -static int -valid_day_of_month (const int year, const int month, const int day) -{ - if (leap_year (year)) { - return in_range (1, leap_month_days[month], day); - } else { - return in_range (1, normal_month_days[month], day); - } -} - -static int -max_week (int year) -{ - int first_day = integer_of_date (year, 1, 1); - int last_day = first_day + days_in_year (year) - 1; - int week; - - get_iso_week (last_day, &year, &week); - return week; -} - -/* 86400 = 60 * 60 * 24. We'll ignore leap seconds for now. */ -#define SECONDS_IN_DAY 86400 - -static int -valid_time (const int seconds_from_midnight) -{ - return in_range (0, SECONDS_IN_DAY, seconds_from_midnight); -} - -/* Uses d5. */ -static int -valid_decimal_time (cob_decimal *seconds_from_midnight) -{ - cob_decimal *seconds_in_day = &d5; - mpz_set_ui (seconds_in_day->value, (unsigned long) SECONDS_IN_DAY); - seconds_in_day->scale = 0; - - return cob_decimal_cmp (seconds_from_midnight, seconds_in_day) <= 0; -} - -#undef SECONDS_IN_DAY - -static int -valid_offset_time (const int offset) -{ - const int minutes_in_day = 1440; /* 60 * 24 */ - return abs (offset) < minutes_in_day; -} - -/* calculate date from days since 1601 */ -static void -date_of_integer (const int day_num, int *year, int *month, int *day) -{ - int days = day_num; - int baseyear = 1601; - int leapyear = 365; - int i; - - while (days > leapyear) { - days -= leapyear; - ++baseyear; - leapyear = days_in_year (baseyear); - } - for (i = 0; i < 13; ++i) { - if (leap_year (baseyear)) { - if (i && days <= leap_days[i]) { - days -= leap_days[i - 1]; - break; - } - } else { - if (i && days <= normal_days[i]) { - days -= normal_days[i - 1]; - break; - } - } - } - - *year = baseyear; - *month = i; - *day = days; -} - -/* set year and day-of-year from integer */ -static void -day_of_integer (const int day_num, int *year, int *day) -{ - int leapyear = 365; - int days = day_num; - - *year = 1601; - - while (days > leapyear) { - days -= leapyear; - ++*year; - leapyear = days_in_year (*year); - } - - *day = days; -} - -/* calculate number of days between 1601 and given year */ -static cob_u32_t -days_up_to_year (const int year) -{ - cob_u32_t totaldays = 0; - int baseyear = 1601; - - while (baseyear != year) { - totaldays += days_in_year (baseyear); - ++baseyear; - } - return totaldays; -} - -/* calculate number of days between 1601/01/01 and given date */ -static cob_u32_t -integer_of_date (const int year, const int month, const int days) -{ - cob_u32_t totaldays; - - totaldays = days_up_to_year (year); - - if (leap_year (year)) { - totaldays += leap_days[month - 1]; - } else { - totaldays += normal_days[month - 1]; - } - totaldays += days; - - return totaldays; -} - -/* calculate number of days between 1601/01/01 and given year + day-of-year */ -static cob_u32_t -integer_of_day (const int year, const int days) -{ - cob_u32_t totaldays; - - totaldays = days_up_to_year (year); - totaldays += days; - - return totaldays; -} - -enum formatted_time_extra { - EXTRA_NONE = 0, - EXTRA_Z, - EXTRA_OFFSET_TIME -}; - -struct time_format { - int with_colons; - int decimal_places; - enum formatted_time_extra extra; -}; - -/* Uses d2 */ -static void -seconds_from_formatted_time (const struct time_format format, const char *str, - cob_decimal *seconds_decimal) -{ - const char *scanf_str = format.with_colons ? "%2d:%2d:%2d" : "%2d%2d%2d"; - int hours; - int minutes; - int seconds; - int total_seconds; - int offset; - int end_of_decimal; - int unscaled_fraction = 0; - cob_decimal *fractional_seconds = &d2; - - /* LCOV_EXCL_START */ - if (unlikely (!sscanf (str, scanf_str, &hours, &minutes, &seconds))) { - cob_fatal_error (COB_FERROR_CODEGEN); - } - /* LCOV_EXCL_STOP */ - - total_seconds = (hours * 60 * 60) + (minutes * 60) + seconds; - - if (format.decimal_places != 0) { - offset = format.with_colons ? 9 : 7; - end_of_decimal = offset + format.decimal_places; - for (; offset != end_of_decimal; ++offset) { - unscaled_fraction = unscaled_fraction * 10 + COB_D2I (str[offset]); - } - - mpz_set_ui (fractional_seconds->value, unscaled_fraction); - fractional_seconds->scale = format.decimal_places; - - mpz_set_ui (seconds_decimal->value, total_seconds); - cob_decimal_add (seconds_decimal, fractional_seconds); - } else { - mpz_set_ui (seconds_decimal->value, total_seconds); - seconds_decimal->scale = 0; - } -} - -static int -valid_day_and_format (const int day, const char *format) -{ - return valid_integer_date (day) && cob_valid_date_format (format); -} - -static size_t -num_leading_nonspace (const char *str, const size_t str_len) -{ - size_t i; - - for (i = 0; i < str_len && !isspace ((int) str[i]); ++i); - return i; -} - -static void -format_as_yyyymmdd (const int day_num, const int with_hyphen, char *buff) -{ - int day_of_month; - int month; - int year; - const char *format_str; - - date_of_integer (day_num, &year, &month, &day_of_month); - - format_str = with_hyphen ? "%4.4d-%2.2d-%2.2d" : "%4.4d%2.2d%2.2d"; - sprintf (buff, format_str, year, month, day_of_month); -} - -static void -format_as_yyyyddd (const int day_num, const int with_hyphen, char *buff) -{ - int day_of_year; - int year; - const char *format_str; - - day_of_integer (day_num, &year, &day_of_year); - - format_str = with_hyphen ? "%4.4d-%3.3d" : "%4.4d%3.3d"; - sprintf (buff, format_str, year, day_of_year); -} - -/* 0 = Monday, ..., 6 = Sunday */ -static int -get_day_of_week (const int day_num) -{ - return (day_num - 1) % 7; -} - -static int -get_iso_week_one (const int day_num, const int day_of_year) -{ - int jan_4 = day_num - day_of_year + 4; - int day_of_week = get_day_of_week (jan_4); - int first_monday = jan_4 - day_of_week; - return first_monday; -} - -/* - * Derived from "Calculating the ISO week number for a date" by Julian M. - * Bucknall (https://www.boyet.com/articles/publishedarticles/calculatingtheisoweeknumb.html). - */ -static void -get_iso_week (const int day_num, int *year, int *week) -{ - int day_of_year; - int days_to_dec_29; - int dec_29; - int week_one; - - day_of_integer (day_num, year, &day_of_year); - - days_to_dec_29 = days_in_year (*year) - 2; - dec_29 = day_num - day_of_year + days_to_dec_29; - - if (day_num >= dec_29) { - /* If the day is (after) December 29, it may be in the first - week of the following year - */ - week_one = get_iso_week_one (day_num + days_in_year (*year), day_of_year); - if (day_num < week_one) { - week_one = get_iso_week_one (day_num, day_of_year); - } else { - ++*year; - } - } else { - week_one = get_iso_week_one (day_num, day_of_year); - - /* If the day is before December 29, it may be in the last week - of the previous year - */ - if (day_num < week_one) { - --*year; - week_one = get_iso_week_one (day_num - day_of_year, - days_in_year (*year)); - } - } - - *week = (day_num - week_one) / 7 + 1; -} - -static void -format_as_yyyywwwd (const int day_num, const int with_hyphen, char *buff) -{ - int ignored_day_of_year; - int week; - int year; - int day_of_week; - const char *format_str; - - day_of_integer (day_num, &year, &ignored_day_of_year); - get_iso_week (day_num, &year, &week); - day_of_week = get_day_of_week (day_num); - - format_str = with_hyphen ? "%4.4d-W%2.2d-%1.1d" : "%4.4dW%2.2d%1.1d"; - sprintf (buff, format_str, year, week, day_of_week + 1); -} - -enum days_format { - DAYS_MMDD, - DAYS_DDD, - DAYS_WWWD -}; - -struct date_format { - enum days_format days; - int with_hyphens; -}; - -static struct date_format -parse_date_format_string (const char *format_str) -{ - struct date_format format; - - if (!strcmp (format_str, "YYYYMMDD") || !strcmp (format_str, "YYYY-MM-DD")) { - format.days = DAYS_MMDD; - } else if (!strcmp (format_str, "YYYYDDD") || !strcmp (format_str, "YYYY-DDD")) { - format.days = DAYS_DDD; - } else { /* YYYYWwwD or YYYY-Www-D */ - format.days = DAYS_WWWD; - } - - format.with_hyphens = format_str[4] == '-'; - - return format; -} - -static void -format_date (const struct date_format format, const int days, char *buff) -{ - void (*formatting_func) (int, int, char *); - - if (format.days == DAYS_MMDD) { - formatting_func = &format_as_yyyymmdd; - } else if (format.days == DAYS_DDD) { - formatting_func = &format_as_yyyyddd; - } else { /* DAYS_WWWD */ - formatting_func = &format_as_yyyywwwd; - } - (*formatting_func) (days, format.with_hyphens, buff); -} - -/* Uses d5. */ -static void -get_fractional_seconds (cob_field *time, cob_decimal *fraction) -{ - int seconds; - cob_decimal *whole_seconds; - - - seconds = cob_get_int (time); - whole_seconds = &d5; - mpz_set_ui (whole_seconds->value, (unsigned long) seconds); - whole_seconds->scale = 0; - - cob_decimal_set_field (fraction, time); - cob_decimal_sub (fraction, whole_seconds); -} - -static unsigned int -decimal_places_for_seconds (const char *str, const unsigned int point_pos) -{ - unsigned int offset = point_pos; - int decimal_places = 0; - - while (str[++offset] == 's') { - ++decimal_places; - } - - return decimal_places; -} - -static int -rest_is_z (const char *str) -{ - return !strcmp (str, "Z"); -} - -static int -rest_is_offset_format (const char *str, const int with_colon) -{ - if (with_colon) { - return !strcmp (str, "+hh:mm"); - } else { - return !strcmp (str, "+hhmm"); - } -} - -/* - This function is needed because, on MinGW, (int) pow (10, 8) == 9999999, not - 10^8. This also occurs with other powers. See http://stackoverflow.com/q/9704195. -*/ -static unsigned int -int_pow (const unsigned int base, unsigned int power) -{ - unsigned int ret = 1; - - while (power > 0) { - ret *= base; - --power; - } - - return ret; -} - -static void -add_decimal_digits (int decimal_places, cob_decimal *second_fraction, - char *buff, ptrdiff_t *buff_pos) -{ - unsigned int scale = second_fraction->scale; - unsigned int power_of_ten; - unsigned int fraction = mpz_get_ui (second_fraction->value); - - /* Add decimal point */ - buff[*buff_pos] = COB_MODULE_PTR->decimal_point; - ++*buff_pos; - - /* Append decimal digits from second_fraction from left to right */ - while (scale != 0 && decimal_places != 0) { - --scale; - power_of_ten = int_pow (10, scale); - buff[*buff_pos] = (char) ('0' + (fraction / power_of_ten)); - - fraction %= power_of_ten; - ++*buff_pos; - --decimal_places; - } - - /* Set remaining digits to zero */ - if (decimal_places != 0) { - memset (buff + *buff_pos, (int)'0', decimal_places); - *buff_pos += decimal_places; - } -} - -static void -add_z (const ptrdiff_t buff_pos, char *buff) -{ - buff[buff_pos] = 'Z'; -} - -static void -add_offset_time (const int with_colon, int const *offset_time, - const ptrdiff_t buff_pos, char *buff) -{ - int hours; - int minutes; - const char *format_str; - char local_buff[13]; /* 13: make the compiler happy as "(un)signed short" *could* - have more digits than we "assume" */ - - if (offset_time) { - hours = *offset_time / 60; - minutes = abs (*offset_time) % 60; - - format_str = with_colon ? "%+2.2d:%2.2d" : "%+2.2d%2.2d"; - snprintf (local_buff, sizeof (local_buff), format_str, - (cob_s16_t) hours, - (cob_u16_t) minutes); - memcpy (buff + buff_pos, local_buff, (size_t)6); - } else { - snprintf (buff + buff_pos, (size_t)6, "00000"); - } -} - -static struct time_format -parse_time_format_string (const char *str) -{ - struct time_format format; - unsigned int offset; - - if (!strncmp (str, "hhmmss", 6)) { - format.with_colons = 0; - offset = 6; - } else { /* "hh:mm:ss" */ - format.with_colons = 1; - offset = 8; - } - - if (str[offset] == '.' || str[offset] == ',') { - format.decimal_places = decimal_places_for_seconds (str, offset); - offset += format.decimal_places + 1; - } else { - format.decimal_places = 0; - } - - if (strlen (str) > (size_t) offset) { - if (rest_is_z (str + offset)) { - format.extra = EXTRA_Z; - } else { /* the rest is the offset time */ - format.extra = EXTRA_OFFSET_TIME; - } - } else { - format.extra = EXTRA_NONE; - } - - return format; -} - -static int -format_time (const struct time_format format, int time, - cob_decimal *second_fraction, int *offset_time, char *buff) -{ - int hours; - int minutes; - int seconds; - int date_overflow = 0; - ptrdiff_t buff_pos; - const char *format_str; - - if (format.with_colons) { - format_str = "%2.2d:%2.2d:%2.2d"; - buff_pos = 8; - } else { - format_str = "%2.2d%2.2d%2.2d"; - buff_pos = 6; - } - - /* Duplication! */ - hours = time / 3600; - time %= 3600; - minutes = time / 60; - seconds = time % 60; - - if (format.extra == EXTRA_Z) { - if (offset_time == NULL) { - cob_set_exception (COB_EC_IMP_UTC_UNKNOWN); - return 0; - } - - hours -= *offset_time / 60; - minutes -= *offset_time % 60; - - /* Handle minute and hour overflow */ - if (minutes >= 60) { - minutes -= 60; - ++hours; - } else if (minutes < 0) { - minutes += 60; - --hours; - } - - if (hours >= 24) { - hours -= 24; - date_overflow = 1; - } else if (hours < 0) { - hours += 24; - date_overflow = -1; - } - } - - sprintf (buff, format_str, hours, minutes, seconds); - - if (format.decimal_places != 0) { - add_decimal_digits (format.decimal_places, second_fraction, - buff, &buff_pos); - } - - if (format.extra == EXTRA_Z) { - add_z (buff_pos, buff); - } else if (format.extra == EXTRA_OFFSET_TIME) { - add_offset_time (format.with_colons, offset_time, buff_pos, buff); - } - - return date_overflow; -} - -/* - Copies as many character as possible from before the first space - from f->data into out_str and add a null terminator to out_str. -*/ -static void -copy_data_to_null_terminated_str (cob_field *f, char * const out_str, - const size_t out_str_max) -{ - size_t chars_before_space = num_leading_nonspace ((char *)f->data, - f->size); - size_t length = cob_min_int (chars_before_space, out_str_max); - - strncpy (out_str, (char *)f->data, length); - out_str[length] = '\0'; -} - -static void -split_around_t (const char *str, char *first, char *second) -{ - int i; - size_t first_length; - size_t second_length; - - /* Find 'T' */ - for (i = 0; str[i] != '\0' && str[i] != 'T'; ++i); - - /* Copy everything before 'T' into first (if present) */ - if (i < COB_DATESTR_MAX) { - first_length = i; - } else { - first_length = COB_DATESTR_MAX; - } - if (first != NULL) { - strncpy (first, str, first_length); - first[first_length] = '\0'; - } - - /* If there is anything after 'T', copy it into second (if present) */ - if (second != NULL) { - if (strlen (str) - i == 0) { - second[0] = '\0'; - } else { - second_length = strlen (str) - i - 1U; - if (second_length > COB_TIMESTR_MAX) { - second_length = COB_TIMESTR_MAX;; - } - memcpy (second, str + i + 1U, second_length); - second[second_length] = '\0'; - } - } -} - -static int -try_get_valid_offset_time (cob_field *offset_time_field, int *offset_time) -{ - if (offset_time_field != NULL) { - *offset_time = cob_get_int (offset_time_field); - if (valid_offset_time (*offset_time)) { - return 0; - } - } else { - *offset_time = 0; - return 0; - } - - return 1; -} - -static int * -get_system_offset_time_ptr (int * const offset_time) -{ - struct cob_time current_time; - - current_time = cob_get_current_date_and_time (); - if (current_time.offset_known) { - *offset_time = current_time.utc_offset; - return offset_time; - } else { - return NULL; - } -} - -static int -test_char_cond (const int cond, int *offset) -{ - if (cond) { - ++(*offset); - return 0; - } else { - return *offset + 1; - } -} - -static int -test_char (const char wanted, const char *str, int *offset) -{ - return test_char_cond (wanted == str[*offset], offset); -} - -static COB_INLINE COB_A_INLINE int -test_digit (const unsigned char ch, int *offset) -{ - return test_char_cond (isdigit (ch), offset); -} - -static COB_INLINE COB_A_INLINE int -test_char_in_range (const char min, const char max, const char ch, int *offset) -{ - return test_char_cond (min <= ch && ch <= max, offset); -} - -static int test_millenium (const char *date, int *offset, int *millenium) -{ - RETURN_IF_NOT_ZERO (test_char_in_range ('1', '9', date[*offset], offset)); - - *millenium = COB_D2I (date[*offset - 1]); - return 0; -} - -static int -test_century (const char *date, int *offset, int *state) -{ - if (*state != 1) { - RETURN_IF_NOT_ZERO (test_digit (date[*offset], offset)); - } else { - RETURN_IF_NOT_ZERO (test_char_in_range ('6', '9', date[*offset], - offset)); - } - - *state = *state * 10 + COB_D2I (date[*offset - 1]); - return 0; -} - -static int -test_decade (const char *date, int *offset, int *state) -{ - RETURN_IF_NOT_ZERO (test_digit (date[*offset], offset)); - *state = *state * 10 + COB_D2I (date[*offset - 1]); - return 0; -} - -static int -test_unit_year (const char *date, int *offset, int *state) -{ - if (*state != 160) { - RETURN_IF_NOT_ZERO (test_digit (date[*offset], offset)); - } else { - RETURN_IF_NOT_ZERO (test_char_in_range ('1', '9', date[*offset], - offset)); - } - - *state = *state * 10 + COB_D2I (date[*offset - 1]); - return 0; -} - -static int -test_year (const char *date, int *offset, int *state) -{ - RETURN_IF_NOT_ZERO (test_millenium (date, offset, state)); - RETURN_IF_NOT_ZERO (test_century (date, offset, state)); - RETURN_IF_NOT_ZERO (test_decade (date, offset, state)); - RETURN_IF_NOT_ZERO (test_unit_year (date, offset, state)); - - return 0; -} - -static int -test_hyphen_presence (const int with_hyphens, const char *date, int *offset) -{ - return with_hyphens ? test_char ('-', date, offset) : 0; -} - -static int -test_month (const char *date, int *offset, int *month) -{ - int first_digit; - - /* Validate first digit */ - RETURN_IF_NOT_ZERO (test_char_cond (date[*offset] == '0' || date[*offset] == '1', - offset)); - first_digit = COB_D2I (date[*offset - 1]); - - /* Validate second digit */ - if (first_digit == 0) { - RETURN_IF_NOT_ZERO (test_char_in_range ('1', '9', date[*offset], - offset)); - } else { /* first digit == 1 */ - RETURN_IF_NOT_ZERO (test_char_in_range ('0', '2', date[*offset], - offset)); - } - - *month = first_digit * 10 + COB_D2I (date[*offset - 1]); - return 0; -} - -static int -test_day_of_month (const char *date, const int year, const int month, - int *offset) -{ - int days_in_month; - char max_first_digit; - char max_second_digit; - int first_digit; - - if (leap_year (year)) { - days_in_month = leap_month_days[month]; - } else { - days_in_month = normal_month_days[month]; - } - max_first_digit = '0' + (char) (days_in_month / 10); - max_second_digit = '0' + (char) (days_in_month % 10); - - /* Validate first digit */ - RETURN_IF_NOT_ZERO (test_char_in_range ('0', max_first_digit, - date[*offset], offset)); - first_digit = date[*offset - 1]; - - /* Validate second digit */ - if (first_digit == '0') { - RETURN_IF_NOT_ZERO (test_char_in_range ('1', '9', date[*offset], - offset)); - } else if (first_digit != max_first_digit) { - RETURN_IF_NOT_ZERO (test_digit (date[*offset], offset)); - } else { - RETURN_IF_NOT_ZERO (test_char_in_range ('0', max_second_digit, - date[*offset], offset)); - } - - return 0; -} - -static int -test_day_of_year (const char *date, const int year, int *offset) -{ - char max_last_digit; - int state; - - /* Validate first digit */ - /* Check day is not greater than 399 */ - RETURN_IF_NOT_ZERO (test_char_in_range ('0', '3', date[*offset], offset)); - state = COB_D2I (date[*offset - 1]); - - /* Validate second digit */ - if (state != 3) { - RETURN_IF_NOT_ZERO (test_digit (date[*offset], offset)); - } else { - /* Check day is not greater than 369 */ - RETURN_IF_NOT_ZERO (test_char_in_range ('0', '6', date[*offset], - offset)); - } - state = state * 10 + COB_D2I (date[*offset - 1]); - - /* Validate third digit */ - if (state == 0) { - RETURN_IF_NOT_ZERO (test_char_in_range ('1', '9', date[*offset], - offset)); - } else if (state != 36) { - RETURN_IF_NOT_ZERO (test_digit (date[*offset], offset)); - } else { - /* Check day is not greater than 366/365 */ - max_last_digit = leap_year (year) ? '6' : '5'; - RETURN_IF_NOT_ZERO (test_char_in_range ('0', max_last_digit, - date[*offset], offset)); - } - - return 0; -} - -static int -test_w_presence (const char *date, int *offset) -{ - return test_char ('W', date, offset); -} - -static int -test_week (const char *date, const int year, int *offset) -{ - int first_digit; - char max_last_digit; - - /* Validate first digit */ - RETURN_IF_NOT_ZERO (test_char_in_range ('0', '5', date[*offset], offset)); - first_digit = COB_D2I (date[*offset - 1]); - - /* Validate second digit */ - if (first_digit == 0) { - RETURN_IF_NOT_ZERO (test_char_in_range ('1', '9', date[*offset], - offset)); - } else if (first_digit != 5) { - RETURN_IF_NOT_ZERO (test_digit (date[*offset], offset)); - } else { - max_last_digit = max_week (year) == 53 ? '3' : '2'; - RETURN_IF_NOT_ZERO (test_char_in_range ('0', max_last_digit, - date[*offset], offset)); - } - - return 0; -} - -static int -test_day_of_week (const char *date, int *offset) -{ - RETURN_IF_NOT_ZERO (test_char_in_range ('1', '7', date[*offset], offset)); - return 0; -} - -static int -test_date_end (const struct date_format format, const char *date, const int year, int *offset) -{ - int month; - - if (format.days == DAYS_MMDD) { - RETURN_IF_NOT_ZERO (test_month (date, offset, &month)); - RETURN_IF_NOT_ZERO (test_hyphen_presence (format.with_hyphens, date, offset)); - RETURN_IF_NOT_ZERO (test_day_of_month (date, year, month, offset)); - } else if (format.days == DAYS_DDD) { - RETURN_IF_NOT_ZERO (test_day_of_year (date, year, offset)); - } else { /* DAYS_WWWD */ - RETURN_IF_NOT_ZERO (test_w_presence (date, offset)); - RETURN_IF_NOT_ZERO (test_week (date, year, offset)); - RETURN_IF_NOT_ZERO (test_hyphen_presence (format.with_hyphens, date, offset)); - RETURN_IF_NOT_ZERO (test_day_of_week (date, offset)); - } - - return 0; -} - -static int -test_no_trailing_junk (const char *str, int offset, int end_of_string) -{ - if (end_of_string) { - /* Allow trailing spaces at the end of strings */ - while (str[offset] != '\0') { - if (str[offset] != ' ') { - return offset + 1; - } - ++offset; - } - return 0; - } else { - return str[offset] == '\0' ? 0 : offset + 1; - } - -} - -static int -test_formatted_date (const struct date_format format, const char *date, - const int end_of_string) -{ - int offset = 0; - int year; - - RETURN_IF_NOT_ZERO (test_year (date, &offset, &year)); - RETURN_IF_NOT_ZERO (test_hyphen_presence (format.with_hyphens, date, &offset)); - RETURN_IF_NOT_ZERO (test_date_end (format, date, year, &offset)); - RETURN_IF_NOT_ZERO (test_no_trailing_junk (date, offset, end_of_string)); - return 0; -} - -static int -test_less_than_60 (const char *time, int *offset) -{ - RETURN_IF_NOT_ZERO (test_char_in_range ('0', '5', time[*offset], offset)); - RETURN_IF_NOT_ZERO (test_digit (time[*offset], offset)); - return 0; -} - -static int -test_hour (const char *time, int *offset) -{ - int first_digit; - - RETURN_IF_NOT_ZERO (test_char_in_range ('0', '2', time[*offset], offset)); - first_digit = COB_D2I (time[*offset - 1]); - - if (first_digit != 2) { - RETURN_IF_NOT_ZERO (test_digit (time[*offset], offset)); - } else { - RETURN_IF_NOT_ZERO (test_char_in_range ('0', '3', time[*offset], offset)); - } - - return 0; -} - -static int -test_minute (const char *time, int *offset) -{ - RETURN_IF_NOT_ZERO (test_less_than_60 (time, offset)); - return 0; -} - -static int -test_second (const char *time, int *offset) -{ - RETURN_IF_NOT_ZERO (test_less_than_60 (time, offset)); - return 0; -} - -static int -test_colon_presence (const int with_colons, const char *time, - int *offset) -{ - if (with_colons) { - RETURN_IF_NOT_ZERO (test_char (':', time, offset)); - } - - return 0; -} - -static int -test_decimal_places (const int num_decimal_places, const char decimal_point, - const char *time, int *offset) -{ - int i; - - if (num_decimal_places != 0) { - RETURN_IF_NOT_ZERO (test_char (decimal_point, time, offset)); - for (i = 0; i < num_decimal_places; ++i) { - RETURN_IF_NOT_ZERO (test_digit (time[*offset], offset)); - } - } - - return 0; -} - -static int -test_z_presence (const char *time, int *offset) -{ - return test_char ('Z', time, offset); -} - -static int -test_two_zeroes (const char *str, int *offset) -{ - RETURN_IF_NOT_ZERO (test_char ('0', str, offset)); - RETURN_IF_NOT_ZERO (test_char ('0', str, offset)); - return 0; -} - -static int -test_offset_time (const struct time_format format, const char *time, int *offset) -{ - if (time[*offset] == '+' || time[*offset] == '-') { - ++*offset; - RETURN_IF_NOT_ZERO (test_hour (time, offset)); - RETURN_IF_NOT_ZERO (test_colon_presence (format.with_colons, - time, offset)); - RETURN_IF_NOT_ZERO (test_minute (time, offset)); - } else if (time[*offset] == '0') { - ++*offset; - RETURN_IF_NOT_ZERO (test_two_zeroes (time, offset)); - RETURN_IF_NOT_ZERO (test_colon_presence (format.with_colons, - time, offset)); - RETURN_IF_NOT_ZERO (test_two_zeroes (time, offset)); - } else { - return *offset + 1; - } - - return 0; -} - -static int -test_time_end (const struct time_format format, const char *time, - int *offset) -{ - if (format.extra == EXTRA_Z) { - RETURN_IF_NOT_ZERO (test_z_presence (time, offset)); - } else if (format.extra == EXTRA_OFFSET_TIME) { - RETURN_IF_NOT_ZERO (test_offset_time (format, time, offset)); - } - - return 0; -} - -static int -test_formatted_time (const struct time_format format, const char *time, - const char decimal_point) -{ - int offset = 0; - - RETURN_IF_NOT_ZERO (test_hour (time, &offset)); - RETURN_IF_NOT_ZERO (test_colon_presence (format.with_colons, time, &offset)); - RETURN_IF_NOT_ZERO (test_minute (time, &offset)); - RETURN_IF_NOT_ZERO (test_colon_presence (format.with_colons, time, &offset)); - RETURN_IF_NOT_ZERO (test_second (time, &offset)); - RETURN_IF_NOT_ZERO (test_decimal_places (format.decimal_places, - decimal_point, time, &offset)); - RETURN_IF_NOT_ZERO (test_time_end (format, time, &offset)); - RETURN_IF_NOT_ZERO (test_no_trailing_junk (time, offset, 1)); - - return 0; -} - -#undef RETURN_IF_NOT_ZERO - -static cob_u32_t -integer_of_mmdd (const struct date_format format, const int year, - const char *final_part) -{ - const char *scanf_str = format.with_hyphens ? "%2d-%2d" : "%2d%2d"; - int month; - int day; - - /* LCOV_EXCL_START */ - if (unlikely (!sscanf (final_part, scanf_str, &month, &day))) { - cob_fatal_error (COB_FERROR_CODEGEN); - } - /* LCOV_EXCL_STOP */ - return integer_of_date (year, month, day); - -} - -static cob_u32_t -integer_of_ddd (const int year, const char *final_part) -{ - int day; - - /* LCOV_EXCL_START */ - if (unlikely (!sscanf (final_part, "%3d", &day))) { - cob_fatal_error (COB_FERROR_CODEGEN); - } - /* LCOV_EXCL_STOP */ - return integer_of_day (year, day); -} - -static cob_u32_t -integer_of_wwwd (const struct date_format format, const int year, - const char *final_part) -{ - int first_week_monday; - const char *scanf_str = format.with_hyphens ? "W%2d-%1d" : "W%2d%1d"; - int week; - int day_of_week; - cob_u32_t total_days = 0; - - first_week_monday = get_iso_week_one (days_up_to_year (year) + 1, 1); - /* LCOV_EXCL_START */ - if (unlikely (!sscanf (final_part, scanf_str, &week, &day_of_week))) { - cob_fatal_error (COB_FERROR_CODEGEN); - } - /* LCOV_EXCL_STOP */ - total_days = first_week_monday + ((week - 1) * 7) + day_of_week - 1; - - return total_days; -} - -static cob_u32_t -integer_of_formatted_date (const struct date_format format, - const char *formatted_date) -{ - int year; - int final_part_start = 4 + format.with_hyphens; - - /* LCOV_EXCL_START */ - if (unlikely (!sscanf (formatted_date, "%4d", &year))) { - cob_fatal_error (COB_FERROR_CODEGEN); - } - /* LCOV_EXCL_STOP */ - - if (format.days == DAYS_MMDD) { - return integer_of_mmdd (format, year, formatted_date + final_part_start); - } else if (format.days == DAYS_DDD) { - return integer_of_ddd (year, formatted_date + final_part_start); - } else { /* DAYS_WWWD */ - return integer_of_wwwd (format, year, formatted_date + final_part_start); - } - -} - -static void -format_datetime (const struct date_format date_fmt, - const struct time_format time_fmt, - const int days, - const int whole_seconds, - cob_decimal *fractional_seconds, - int *offset_time, - char *buff) -{ - int overflow; - char formatted_time[COB_TIMESTR_LEN] = { '\0' }; - char formatted_date[COB_DATESTR_LEN] = { '\0' }; - - overflow = format_time (time_fmt, whole_seconds, fractional_seconds, - offset_time, formatted_time); - format_date (date_fmt, days + overflow, formatted_date); - - sprintf (buff, "%sT%s", formatted_date, formatted_time); -} - -/* Uses d1 */ -static void -format_current_date (const struct date_format date_fmt, - const struct time_format time_fmt, - char *formatted_datetime) -{ - struct cob_time time = cob_get_current_date_and_time (); - int days - = integer_of_date (time.year, time.month, time.day_of_month); - int seconds_from_midnight - = time.hour * 60 * 60 + time.minute * 60 + time.second; - cob_decimal *fractional_second = &d1; - int *offset_time; - - mpz_set_ui (fractional_second->value, (unsigned long) time.nanosecond); - fractional_second->scale = 9; - - if (time.offset_known) { - offset_time = &time.utc_offset; - } else { - offset_time = NULL; - } - - format_datetime (date_fmt, time_fmt, days, seconds_from_midnight, - fractional_second, offset_time, formatted_datetime); -} - -static DECLNORET COB_A_NORETURN void -error_not_implemented (void) -{ - cob_set_exception (COB_EC_IMP_FEATURE_MISSING); - cob_fatal_error (COB_FERROR_FUNCTION); -} - -/* Global functions */ - -/* Return switch value as field */ - -cob_field * -cob_switch_value (const int id) -{ - cob_alloc_set_field_int (cob_get_switch (id)); - return curr_field; -} - -/* Decimal exponentiation function */ -/* x ^ z = e ^ (z * log(x)) */ - -void -cob_decimal_pow (cob_decimal *pd1, cob_decimal *pd2) -{ - cob_uli_t n; - int sign; - - if (unlikely (pd1->scale == COB_DECIMAL_NAN)) { - return; - } - if (unlikely (pd2->scale == COB_DECIMAL_NAN)) { - pd1->scale = COB_DECIMAL_NAN; - return; - } - - sign = mpz_sgn (pd1->value); - - if (!mpz_sgn (pd2->value)) { - /* Exponent is zero */ - if (!sign) { - /* 0 ^ 0 */ - cob_set_exception (COB_EC_SIZE_EXPONENTIATION); - } - mpz_set_ui (pd1->value, 1UL); - pd1->scale = 0; - return; - } - if (!sign) { - /* Value is zero */ - pd1->scale = 0; - return; - } - - cob_trim_decimal (pd2); - - if (sign < 0 && pd2->scale) { - /* Negative exponent and non-integer power */ - pd1->scale = COB_DECIMAL_NAN; - cob_set_exception (COB_EC_SIZE_EXPONENTIATION); - return; - } - - cob_trim_decimal (pd1); - - if (!pd2->scale) { - /* Integer power */ - if (!mpz_cmp_ui (pd2->value, 1UL)) { - /* Power is 1 */ - return; - } - if (mpz_sgn (pd2->value) < 0 && mpz_fits_slong_p (pd2->value)) { - /* Negative power */ - mpz_abs (pd2->value, pd2->value); - n = mpz_get_ui (pd2->value); - mpz_pow_ui (pd1->value, pd1->value, n); - if (pd1->scale) { - pd1->scale *= n; - cob_trim_decimal (pd1); - } - cob_decimal_set (pd2, pd1); - mpz_set_ui (pd1->value, 1UL), - pd1->scale = 0; - cob_decimal_div (pd1, pd2); - cob_trim_decimal (pd1); - return; - } - if (mpz_fits_ulong_p (pd2->value)) { - /* Positive power */ - n = mpz_get_ui (pd2->value); - mpz_pow_ui (pd1->value, pd1->value, n); - if (pd1->scale) { - pd1->scale *= n; - cob_trim_decimal (pd1); - } - return; - } - } - - if (sign < 0) { - mpz_abs (pd1->value, pd1->value); - } - cob_decimal_get_mpf (cob_mpft, pd1); - if (pd2->scale == 1 && !mpz_cmp_ui (pd2->value, 5UL)) { - /* Square root short cut */ - mpf_sqrt (cob_mpft2, cob_mpft); - } else { - cob_decimal_get_mpf (cob_mpft2, pd2); - cob_mpf_log (cob_mpft, cob_mpft); - mpf_mul (cob_mpft, cob_mpft, cob_mpft2); - cob_mpf_exp (cob_mpft2, cob_mpft); - } - cob_decimal_set_mpf (pd1, cob_mpft2); - if (sign < 0) { - mpz_neg (pd1->value, pd1->value); - } -} - -/* Indirect field get/put functions */ - -void -cob_put_indirect_field (cob_field *f) -{ - make_field_entry (f); - memcpy (curr_field->data, f->data, f->size); - move_field = curr_field; -} - -void -cob_get_indirect_field (cob_field *f) -{ - cob_move (move_field, f); -} - -/* Indirect move */ - -void -cob_decimal_move_temp (cob_field *src, cob_field *dst) -{ - short size, scale; - cob_field_attr attr; - cob_field field; - - cob_decimal_set_field (&d1, src); - cob_trim_decimal (&d1); - - size = (short)mpz_sizeinbase (d1.value, 10); - if (d1.scale > size) { - size = (short)d1.scale; - } - scale = (short)d1.scale; - COB_ATTR_INIT (COB_TYPE_NUMERIC_DISPLAY, size, - scale, COB_FLAG_HAVE_SIGN, NULL); - COB_FIELD_INIT (size, NULL, &attr); - make_field_entry (&field); - (void)cob_decimal_get_field (&d1, curr_field, 0); - cob_move (curr_field, dst); -} - -/* TEST-NUMVAL implementation */ - -/* Validate NUMVAL / NUMVAL-C item */ -/* [spaces][+|-][spaces]{digits[.[digits]]|.digits}[spaces] */ -/* [spaces]{digits[.[digits]]|.digits}[spaces][+|-|CR|DB][spaces] */ -int -cob_check_numval (const cob_field *srcfield, const cob_field *currency, - const int chkcurr, const int anycase) -{ - unsigned char *p; - unsigned char *begp; - unsigned char *endp; - size_t pos; - size_t plus_minus; - size_t digits; - size_t dec_seen; - size_t space_seen; - size_t break_needed; - size_t currcy_size; - int n; - unsigned char dec_pt; - unsigned char cur_symb; - - /* FIXME later: srcfield may be of category national... */ - - begp = NULL; - currcy_size = 0; - if (currency) { - endp = NULL; - p = currency->data; - for (pos = 0; pos < currency->size; pos++, p++) { - switch (*p) { - case '0': - case '1': - case '2': - case '3': - case '4': - case '5': - case '6': - case '7': - case '8': - case '9': - case '+': - case '-': - case '.': - case ',': - case '*': - return 1; - case ' ': - break; - default: - if (pos < currency->size - 1) { - if (!memcmp (p, "CR", (size_t)2)) { - return 1; - } - if (!memcmp (p, "DB", (size_t)2)) { - return 1; - } - } - if (!begp) { - begp = p; - } - endp = p; - break; - } - } - if (!begp) { - return 1; - } - currcy_size = endp - begp; - currcy_size++; - if (currcy_size >= srcfield->size) { - begp = NULL; - currcy_size = 0; - } - } else if (chkcurr) { - cur_symb = COB_MODULE_PTR->currency_symbol; - begp = &cur_symb; - currcy_size = 1; - } - - if (!srcfield->size) { - return 1; - } - - p = srcfield->data; - plus_minus = 0; - digits = 0; - dec_seen = 0; - space_seen = 0; - break_needed = 0; - dec_pt = COB_MODULE_PTR->decimal_point; - - /* Check leading positions */ - for (n = 0; n < (int)srcfield->size; ++n, ++p) { - switch (*p) { - case '0': - case '1': - case '2': - case '3': - case '4': - case '5': - case '6': - case '7': - case '8': - case '9': - break_needed = 1; - break; - case ' ': - continue; - case '+': - case '-': - if (plus_minus) { - return n + 1; - } - plus_minus = 1; - continue; - case ',': - case '.': - if (*p != dec_pt) { - return n + 1; - } - break_needed = 1; - break; - default: - if (begp && n < (int)(srcfield->size - currcy_size)) { - if (!memcmp (p, begp, currcy_size)) { - break; - } - } - return n + 1; - } - if (break_needed) { - break; - } - } - - if (n == (int)srcfield->size) { - return n + 1; - } - - for (; n < (int)srcfield->size; ++n, ++p) { - switch (*p) { - case '0': - case '1': - case '2': - case '3': - case '4': - case '5': - case '6': - case '7': - case '8': - case '9': - if (++digits > COB_MAX_DIGITS || space_seen) { - return n + 1; - } - continue; - case ',': - case '.': - if (dec_seen || space_seen) { - return n + 1; - } - if (*p == dec_pt) { - dec_seen = 1; - } else if (!chkcurr) { - return n + 1; - } - continue; - case ' ': - space_seen = 1; - continue; - case '+': - case '-': - if (plus_minus) { - return n + 1; - } - plus_minus = 1; - continue; - case 'c': - if (!anycase) { - return n + 1; - } - /* Fall through */ - case 'C': - if (plus_minus) { - return n + 1; - } - if (n < (int)srcfield->size - 1) { - if (*(p + 1) == 'R' || - (anycase && *(p + 1) == 'r')) { - plus_minus = 1; - p++; - n++; - continue; - } - } - return n + 2; - case 'd': - if (!anycase) { - return n + 1; - } - /* Fall through */ - case 'D': - if (plus_minus) { - return n + 1; - } - if (n < (int)srcfield->size - 1) { - if (*(p + 1) == 'B' || - (anycase && *(p + 1) == 'b')) { - plus_minus = 1; - p++; - n++; - continue; - } - } - return n + 2; - default: - return n + 1; - } - } - - if (!digits) { - return n + 1; - } - - return 0; -} - -/* Date/time format validation */ - -int -cob_valid_date_format (const char *format) -{ - return !strcmp (format, "YYYYMMDD") - || !strcmp (format, "YYYY-MM-DD") - || !strcmp (format, "YYYYDDD") - || !strcmp (format, "YYYY-DDD") - || !strcmp (format, "YYYYWwwD") - || !strcmp (format, "YYYY-Www-D"); -} - -int -cob_valid_time_format (const char *format, const char decimal_point) -{ - int with_colons; - unsigned int format_offset; - unsigned int decimal_places = 0; - - if (!strncmp (format, "hhmmss", 6)) { - with_colons = 0; - format_offset = 6; - } else if (!strncmp (format, "hh:mm:ss", 8)) { - with_colons = 1; - format_offset = 8; - } else { - return 0; - } - - /* Validate number of decimal places */ - if (format[format_offset] == decimal_point) { - decimal_places = decimal_places_for_seconds (format, format_offset); - format_offset += decimal_places + 1; - if (decimal_places == 0 - || decimal_places > COB_TIMEDEC_MAX) { - return 0; - } - } - - /* Check for trailing garbage */ - if (strlen (format) > (size_t) format_offset - && !rest_is_z (format + format_offset) - && !rest_is_offset_format (format + format_offset, with_colons)) { - return 0; - } - - return 1; -} - -int -cob_valid_datetime_format (const char *format, const char decimal_point) -{ - char date_format_str[COB_DATETIMESTR_LEN] = { '\0' }; - char time_format_str[COB_DATETIMESTR_LEN] = { '\0' }; - struct date_format date_format; - struct time_format time_format; - - split_around_t (format, date_format_str, time_format_str); - - if (!cob_valid_date_format (date_format_str) - || !cob_valid_time_format (time_format_str, decimal_point)) { - return 0; - } - - /* Check time and date formats match */ - date_format = parse_date_format_string (date_format_str); - time_format = parse_time_format_string (time_format_str); - if (date_format.with_hyphens != time_format.with_colons) { - return 0; - } - - return 1; -} - -/* Numeric expressions */ - -cob_field * -cob_intr_binop (cob_field *f1, const int op, cob_field *f2) -{ - cob_decimal_set_field (&d1, f1); - cob_decimal_set_field (&d2, f2); - switch (op) { - case '+': - cob_decimal_add (&d1, &d2); - break; - case '-': - cob_decimal_sub (&d1, &d2); - break; - case '*': - cob_decimal_mul (&d1, &d2); - break; - case '/': - cobglobptr->cob_exception_code = 0; - if (!mpz_sgn (d2.value)) { - /* Divide by zero */ - cob_set_exception (COB_EC_SIZE_ZERO_DIVIDE); - mpz_set_ui (d1.value, 0UL); - d1.scale = 0; - } else { - cob_decimal_div (&d1, &d2); - } - break; - case '^': - cob_decimal_pow (&d1, &d2); - break; - default: - break; - } - - cob_alloc_field (&d1); - (void)cob_decimal_get_field (&d1, curr_field, 0); - return curr_field; -} - -/* Intrinsics */ - -cob_field * -cob_intr_length (cob_field *srcfield) -{ - if (COB_MODULE_PTR->flag_pretty_display) { - if (COB_FIELD_IS_NATIONAL (srcfield)) { - cob_alloc_set_field_pretty ((cob_u32_t)srcfield->size / COB_NATIONAL_SIZE); - } else { - cob_alloc_set_field_pretty ((cob_u32_t)srcfield->size); - } - return curr_field; - } - - if (COB_FIELD_IS_NATIONAL (srcfield)) { - cob_alloc_set_field_uint ((cob_u32_t)srcfield->size / COB_NATIONAL_SIZE); - } else { - cob_alloc_set_field_uint ((cob_u32_t)srcfield->size); - } - return curr_field; -} - -cob_field * -cob_intr_byte_length (cob_field *srcfield) -{ - cob_alloc_set_field_uint ((cob_u32_t)srcfield->size); - return curr_field; -} - -cob_field * -cob_intr_integer (cob_field *srcfield) -{ - int sign; - - cob_decimal_set_field (&d1, srcfield); - /* Check scale */ - if (d1.scale < 0) { - mpz_ui_pow_ui (cob_mexp, 10UL, (cob_uli_t)-d1.scale); - mpz_mul (d1.value, d1.value, cob_mexp); - } else if (d1.scale > 0) { - sign = mpz_sgn (d1.value); - mpz_ui_pow_ui (cob_mexp, 10UL, (cob_uli_t)d1.scale); - mpz_tdiv_qr (d1.value, cob_mpzt, d1.value, cob_mexp); - /* Check negative and has decimal places */ - if (sign < 0 && mpz_sgn (cob_mpzt)) { - mpz_sub_ui (d1.value, d1.value, 1UL); - } - } - d1.scale = 0; - - cob_alloc_field (&d1); - (void)cob_decimal_get_field (&d1, curr_field, 0); - return curr_field; -} - -cob_field * -cob_intr_integer_part (cob_field *srcfield) -{ - cob_decimal_set_field (&d1, srcfield); - /* Check scale */ - if (d1.scale < 0) { - mpz_ui_pow_ui (cob_mexp, 10UL, (cob_uli_t)-d1.scale); - mpz_mul (d1.value, d1.value, cob_mexp); - } else if (d1.scale > 0) { - mpz_ui_pow_ui (cob_mexp, 10UL, (cob_uli_t)d1.scale); - mpz_tdiv_q (d1.value, d1.value, cob_mexp); - } - d1.scale = 0; - - cob_alloc_field (&d1); - (void)cob_decimal_get_field (&d1, curr_field, 0); - return curr_field; -} - -cob_field * -cob_intr_fraction_part (cob_field *srcfield) -{ - cob_decimal_set_field (&d1, srcfield); - /* Check scale */ - if (d1.scale > 0) { - mpz_ui_pow_ui (cob_mexp, 10UL, (cob_uli_t)d1.scale); - mpz_tdiv_r (d1.value, d1.value, cob_mexp); - } else { - /* No decimals */ - mpz_set_ui (d1.value, 0UL); - d1.scale = 0; - } - - cob_alloc_field (&d1); - (void)cob_decimal_get_field (&d1, curr_field, 0); - return curr_field; -} - -cob_field * -cob_intr_sign (cob_field *srcfield) -{ - cob_decimal_set_field (&d1, srcfield); - cob_alloc_set_field_int (mpz_sgn (d1.value)); - return curr_field; -} - -cob_field * -cob_intr_upper_case (const int offset, const int length, cob_field *srcfield) -{ - size_t i, size; - - make_field_entry (srcfield); - - size = srcfield->size; - for (i = 0; i < size; ++i) { - curr_field->data[i] = (cob_u8_t)toupper (srcfield->data[i]); - } - if (unlikely (offset > 0)) { - calc_ref_mod (curr_field, offset, length); - } - return curr_field; -} - -cob_field * -cob_intr_lower_case (const int offset, const int length, cob_field *srcfield) -{ - size_t i, size; - - make_field_entry (srcfield); - - size = srcfield->size; - for (i = 0; i < size; ++i) { - curr_field->data[i] = (cob_u8_t)tolower (srcfield->data[i]); - } - if (unlikely (offset > 0)) { - calc_ref_mod (curr_field, offset, length); - } - return curr_field; -} - -cob_field * -cob_intr_reverse (const int offset, const int length, cob_field *srcfield) -{ - size_t i, size; - - make_field_entry (srcfield); - - size = srcfield->size; - for (i = 0; i < size; ++i) { - curr_field->data[i] = srcfield->data[size - i - 1]; - } - if (unlikely (offset > 0)) { - calc_ref_mod (curr_field, offset, length); - } - return curr_field; -} - -cob_field * -cob_intr_module_date (void) -{ - cob_field_attr attr; - cob_field field; - char buff[16]; - - COB_ATTR_INIT (COB_TYPE_NUMERIC_DISPLAY, 8, 0, 0, NULL); - COB_FIELD_INIT (8, NULL, &attr); - make_field_entry (&field); - snprintf (buff, sizeof(buff), "%8.8u", COB_MODULE_PTR->module_date); - memcpy (curr_field->data, buff, (size_t)8); - return curr_field; -} - -cob_field * -cob_intr_module_time (void) -{ - cob_field_attr attr; - cob_field field; - char buff[8]; - - COB_ATTR_INIT (COB_TYPE_NUMERIC_DISPLAY, 6, 0, 0, NULL); - COB_FIELD_INIT (6, NULL, &attr); - make_field_entry (&field); - snprintf (buff, sizeof(buff), "%6.6u", COB_MODULE_PTR->module_time); - memcpy (curr_field->data, buff, (size_t)6); - return curr_field; -} - -cob_field * -cob_intr_module_id (void) -{ - size_t calcsize; - cob_field field; - - calcsize = strlen (COB_MODULE_PTR->module_name); - COB_FIELD_INIT (calcsize, NULL, &const_alpha_attr); - make_field_entry (&field); - memcpy (curr_field->data, COB_MODULE_PTR->module_name, calcsize); - return curr_field; -} - -cob_field * -cob_intr_module_caller_id (void) -{ - size_t calcsize; - cob_field field; - - if (!COB_MODULE_PTR->next) { - COB_FIELD_INIT (1, NULL, &const_alpha_attr); - make_field_entry (&field); - curr_field->size = 0; - curr_field->data[0] = ' '; - return curr_field; - } - calcsize = strlen (COB_MODULE_PTR->next->module_name); - COB_FIELD_INIT (calcsize, NULL, &const_alpha_attr); - make_field_entry (&field); - memcpy (curr_field->data, COB_MODULE_PTR->next->module_name, - calcsize); - return curr_field; -} - -cob_field * -cob_intr_module_formatted_date (void) -{ - size_t calcsize; - cob_field field; - - calcsize = strlen (COB_MODULE_PTR->module_formatted_date); - COB_FIELD_INIT (calcsize, NULL, &const_alpha_attr); - make_field_entry (&field); - memcpy (curr_field->data, COB_MODULE_PTR->module_formatted_date, - calcsize); - return curr_field; -} - -cob_field * -cob_intr_module_source (void) -{ - size_t calcsize; - cob_field field; - - calcsize = strlen (COB_MODULE_PTR->module_source); - COB_FIELD_INIT (calcsize, NULL, &const_alpha_attr); - make_field_entry (&field); - memcpy (curr_field->data, COB_MODULE_PTR->module_source, calcsize); - return curr_field; -} - -cob_field * -cob_intr_module_path (void) -{ - size_t calcsize; - cob_field field; - - if (!COB_MODULE_PTR->module_path || - !*(COB_MODULE_PTR->module_path)) { - COB_FIELD_INIT (1, NULL, &const_alpha_attr); - make_field_entry (&field); - curr_field->size = 0; - curr_field->data[0] = ' '; - return curr_field; - } - calcsize = strlen (*(COB_MODULE_PTR->module_path)); - COB_FIELD_INIT (calcsize, NULL, &const_alpha_attr); - make_field_entry (&field); - memcpy (curr_field->data, *(COB_MODULE_PTR->module_path), - calcsize); - return curr_field; -} - -cob_field * -cob_intr_concatenate (const int offset, const int length, - const int params, ...) -{ - cob_field **f; - unsigned char *p; - size_t calcsize; - int i; - cob_field field; - va_list args; - - f = cob_malloc ((size_t)params * sizeof (cob_field *)); - - va_start (args, params); - - /* Extract args / calculate size */ - calcsize = 0; - for (i = 0; i < params; ++i) { - f[i] = va_arg (args, cob_field *); - calcsize += f[i]->size; - } - va_end (args); - - COB_FIELD_INIT (calcsize, NULL, &const_alpha_attr); - make_field_entry (&field); - - p = curr_field->data; - for (i = 0; i < params; ++i) { - memcpy (p, f[i]->data, f[i]->size); - p += f[i]->size; - } - - if (unlikely (offset > 0)) { - calc_ref_mod (curr_field, offset, length); - } - cob_free (f); - return curr_field; -} - -cob_field * -cob_intr_substitute (const int offset, const int length, - const int params, ...) -{ - cob_field *ret; - va_list args; - - va_start (args, params); - ret = substitute (offset, length, params, &memcmp, args); - va_end (args); - - return ret; -} - -cob_field * -cob_intr_substitute_case (const int offset, const int length, - const int params, ...) -{ - cob_field *ret; - va_list args; - - va_start (args, params); - ret = substitute (offset, length, params, &int_strncasecmp, args); - va_end (args); - - return ret; -} - -cob_field * -cob_intr_trim (const int offset, const int length, - cob_field *srcfield, const int direction) -{ - unsigned char *begin; - unsigned char *end; - size_t i; - size_t size; - - make_field_entry (srcfield); - - for (i = 0; i < srcfield->size; ++i) { - if (srcfield->data[i] != ' ') { - break; - } - } - if (i == srcfield->size) { - curr_field->size = 0; - curr_field->data[0] = ' '; - return curr_field; - } - - begin = srcfield->data; - if (direction != 2) { - for (; *begin == ' '; ++begin) ; - } - end = srcfield->data + srcfield->size - 1; - if (direction != 1) { - for (; *end == ' '; end--) ; - } - - size = 0; - for (i = 0; begin <= end; ++begin, ++i) { - curr_field->data[i] = *begin; - ++size; - } - curr_field->size = size; - if (unlikely (offset > 0)) { - calc_ref_mod (curr_field, offset, length); - } - return curr_field; -} - -/* get variable length (at least 2) temporary field containing last file exception status + name */ -cob_field * -cob_intr_exception_file (void) -{ - size_t flen; - cob_field field; - - COB_FIELD_INIT (0, NULL, &const_alpha_attr); - /* check if last-exception is active and a file-exception */ - if (!cobglobptr->cob_error_file || - (!cob_last_exception_is (COB_EC_I_O))) { - field.size = 2; - make_field_entry (&field); - memcpy (curr_field->data, "00", (size_t)2); - } else { - flen = strlen (cobglobptr->cob_error_file->select_name); - field.size = flen + 2; - make_field_entry (&field); - memcpy (curr_field->data, - cobglobptr->cob_error_file->file_status, (size_t)2); - memcpy (&(curr_field->data[2]), - cobglobptr->cob_error_file->select_name, flen); - } - return curr_field; -} - -/* get variable length (at least 1) temporary field containing last exception location */ -cob_field * -cob_intr_exception_location (void) -{ - char *buff; - cob_field field; - - COB_FIELD_INIT (0, NULL, &const_alpha_attr); - /* check if last-exception is active and if LOCATION is available */ - if (!cobglobptr->last_exception_id) { - field.size = 1; - make_field_entry (&field); - *(curr_field->data) = ' '; - return curr_field; - } - buff = cob_malloc ((size_t)COB_SMALL_BUFF); - if (cobglobptr->last_exception_section && cobglobptr->last_exception_paragraph) { - snprintf (buff, (size_t)COB_SMALL_MAX, "%s; %s OF %s; %u", - cobglobptr->last_exception_id, - cobglobptr->last_exception_paragraph, - cobglobptr->last_exception_section, - cobglobptr->last_exception_line); - } else if (cobglobptr->last_exception_section) { - snprintf (buff, (size_t)COB_SMALL_MAX, "%s; %s; %u", - cobglobptr->last_exception_id, - cobglobptr->last_exception_section, - cobglobptr->last_exception_line); - } else if (cobglobptr->last_exception_paragraph) { - snprintf (buff, (size_t)COB_SMALL_MAX, "%s; %s; %u", - cobglobptr->last_exception_id, - cobglobptr->last_exception_paragraph, - cobglobptr->last_exception_line); - } else { - snprintf (buff, (size_t)COB_SMALL_MAX, "%s; ; %u", - cobglobptr->last_exception_id, - cobglobptr->last_exception_line); - } - buff[COB_SMALL_MAX] = 0; /* silence warnings */ - field.size = strlen (buff); - make_field_entry (&field); - memcpy (curr_field->data, buff, field.size); - cob_free (buff); - return curr_field; -} - -/* get x(31) temporary field containing last exception name */ -cob_field * -cob_intr_exception_status (void) -{ - const char *except_name; - cob_field field; - - COB_FIELD_INIT (31, NULL, &const_alpha_attr); - make_field_entry (&field); - - memset (curr_field->data, ' ', (size_t)31); - if (cob_get_last_exception_code() != 0) { - except_name = cob_get_last_exception_name (); - if (except_name == NULL) { - except_name = "EXCEPTION-OBJECT"; - } - memcpy (curr_field->data, except_name, strlen (except_name)); - } - return curr_field; -} - -/* get x(31) temporary field containing last exception statement */ -cob_field * -cob_intr_exception_statement (void) -{ - size_t flen; - cob_field field; - - COB_FIELD_INIT (31, NULL, &const_alpha_attr); - make_field_entry (&field); - - memset (curr_field->data, ' ', (size_t)31); - if (cobglobptr->last_exception_statement) { - flen = strlen (cobglobptr->last_exception_statement); - if (flen > 31) { - flen = 31; - } - memcpy (curr_field->data, cobglobptr->last_exception_statement, flen); - } - return curr_field; -} - -cob_field * -cob_intr_when_compiled (const int offset, const int length, cob_field *f) -{ - make_field_entry (f); - - memcpy (curr_field->data, f->data, f->size); - if (unlikely (offset > 0)) { - calc_ref_mod (curr_field, offset, length); - } - return curr_field; -} - -cob_field * -cob_intr_current_date (const int offset, const int length) -{ - cob_field field; - struct cob_time time; - char buff[22] = { '\0' }; - - COB_FIELD_INIT (21, NULL, &const_alpha_attr); - make_field_entry (&field); - - time = cob_get_current_date_and_time (); - - sprintf (buff, "%4.4d%2.2d%2.2d%2.2d%2.2d%2.2d%2.2d", - time.year, time.month, time.day_of_month, time.hour, - time.minute, time.second, (int) time.nanosecond / 10000000); - - add_offset_time (0, &time.utc_offset, 16, buff); - - memcpy (curr_field->data, buff, (size_t)21); - if (unlikely (offset > 0)) { - calc_ref_mod (curr_field, offset, length); - } - return curr_field; -} - -cob_field * -cob_intr_char (cob_field *srcfield) -{ - int i; - cob_field field; - - COB_FIELD_INIT (1, NULL, &const_alpha_attr); - make_field_entry (&field); - - i = cob_get_int (srcfield); - if (i < 1 || i > 256) { - *curr_field->data = 0; - } else { - *curr_field->data = (unsigned char)i - 1; - } - return curr_field; -} - -cob_field * -cob_intr_ord (cob_field *srcfield) -{ - cob_alloc_set_field_uint ((cob_u32_t)(*srcfield->data + 1U)); - return curr_field; -} - -cob_field * -cob_intr_stored_char_length (cob_field *srcfield) -{ - unsigned char *p; - cob_u32_t count; - - count = srcfield->size; - p = srcfield->data + srcfield->size - 1; - for (; count > 0; count--, p--) { - if (*p != ' ') { - break; - } - } - - cob_alloc_set_field_uint (count); - return curr_field; -} - -cob_field * -cob_intr_combined_datetime (cob_field *srcdays, cob_field *srctime) -{ - int srdays; - cob_decimal *combined_datetime; - cob_decimal *srtime; - cob_decimal *hundred_thousand; - - cobglobptr->cob_exception_code = 0; - - /* Validate and extract the value of srcdays */ - srdays = cob_get_int (srcdays); - if (!valid_integer_date (srdays)) { - goto invalid_args; - } - combined_datetime = &d1; - mpz_set_ui (combined_datetime->value, (unsigned long) srdays); - combined_datetime->scale = 0; - - /* Extract and validate the value of srctime */ - srtime = &d2; - cob_decimal_set_field (srtime, srctime); - if (!valid_decimal_time (srtime)) { - goto invalid_args; - } - - /* Set a decimal to 100 000. */ - hundred_thousand = &d3; - mpz_set_ui (hundred_thousand->value, 100000UL); - hundred_thousand->scale = 0; - - /* Combined datetime = date + (time / 100 000) */ - cob_decimal_div (srtime, hundred_thousand); - cob_decimal_add (combined_datetime, srtime); - - cob_alloc_field (combined_datetime); - (void) cob_decimal_get_field (combined_datetime, curr_field, 0); - goto end_of_func; - - invalid_args: - cob_set_exception (COB_EC_ARGUMENT_FUNCTION); - cob_alloc_set_field_uint (0); - - end_of_func: - return curr_field; -} - -cob_field * -cob_intr_date_of_integer (cob_field *srcdays) -{ - int days; - int month; - int year; - cob_field_attr attr; - cob_field field; - char buff[16]; - - COB_ATTR_INIT (COB_TYPE_NUMERIC_DISPLAY, 8, 0, 0, NULL); - COB_FIELD_INIT (8, NULL, &attr); - make_field_entry (&field); - - cobglobptr->cob_exception_code = 0; - /* Base 1601-01-01 */ - days = cob_get_int (srcdays); - if (!valid_integer_date (days)) { - cob_set_exception (COB_EC_ARGUMENT_FUNCTION); - memset (curr_field->data, (int)'0', (size_t)8); - return curr_field; - } - - date_of_integer (days, &year, &month, &days); - - snprintf (buff, (size_t)15, "%4.4d%2.2d%2.2d", year, month, days); - memcpy (curr_field->data, buff, (size_t)8); - return curr_field; -} - -cob_field * -cob_intr_day_of_integer (cob_field *srcdays) -{ - int days; - int baseyear; - cob_field_attr attr; - cob_field field; - char buff[13]; /* 13: make the compiler happy as "unsigned short" *could* - have more digits than we "assume" */ - - COB_ATTR_INIT (COB_TYPE_NUMERIC_DISPLAY, 7, 0, 0, NULL); - COB_FIELD_INIT (7, NULL, &attr); - make_field_entry (&field); - - cobglobptr->cob_exception_code = 0; - /* Base 1601-01-01 */ - days = cob_get_int (srcdays); - if (!valid_integer_date (days)) { - cob_set_exception (COB_EC_ARGUMENT_FUNCTION); - memset (curr_field->data, (int)'0', (size_t)7); - return curr_field; - } - - day_of_integer (days, &baseyear, &days); - snprintf (buff, sizeof (buff), "%4.4d%3.3d", - (cob_u16_t) baseyear, - (cob_u16_t) days); - - memcpy (curr_field->data, buff, (size_t)7); - return curr_field; -} - -cob_field * -cob_intr_integer_of_date (cob_field *srcfield) -{ - int indate; - int days; - int month; - int year; - - cobglobptr->cob_exception_code = 0; - /* Base 1601-01-01 */ - indate = cob_get_int (srcfield); - year = indate / 10000; - if (!valid_year (year)) { - cob_set_exception (COB_EC_ARGUMENT_FUNCTION); - cob_alloc_set_field_uint (0); - return curr_field; - } - indate %= 10000; - month = indate / 100; - if (!valid_month (month)) { - cob_set_exception (COB_EC_ARGUMENT_FUNCTION); - cob_alloc_set_field_uint (0); - return curr_field; - } - days = indate % 100; - if (!valid_day_of_month (year, month, days)) { - cob_set_exception (COB_EC_ARGUMENT_FUNCTION); - cob_alloc_set_field_uint (0); - return curr_field; - } - - cob_alloc_set_field_uint (integer_of_date (year, month, days)); - return curr_field; -} - -cob_field * -cob_intr_integer_of_day (cob_field *srcfield) -{ - int indate; - int days; - int year; - - cobglobptr->cob_exception_code = 0; - /* Base 1601-01-01 */ - indate = cob_get_int (srcfield); - year = indate / 1000; - if (!valid_year (year)) { - cob_set_exception (COB_EC_ARGUMENT_FUNCTION); - cob_alloc_set_field_uint (0); - return curr_field; - } - days = indate % 1000; - if (!valid_day_of_year (year, days)) { - cob_set_exception (COB_EC_ARGUMENT_FUNCTION); - cob_alloc_set_field_uint (0); - return curr_field; - } - - cob_alloc_set_field_uint (integer_of_day (year, days)); - return curr_field; -} - -cob_field * -cob_intr_test_date_yyyymmdd (cob_field *srcfield) -{ - int indate; - int days; - int month; - int year; - - /* Base 1601-01-01 */ - indate = cob_get_int (srcfield); - year = indate / 10000; - if (!valid_year (year)) { - cob_alloc_set_field_uint (1); - return curr_field; - } - indate %= 10000; - month = indate / 100; - if (!valid_month (month)) { - cob_alloc_set_field_uint (2); - return curr_field; - } - days = indate % 100; - if (!valid_day_of_month (year, month, days)) { - cob_alloc_set_field_uint (3); - return curr_field; - } - cob_alloc_set_field_uint (0); - return curr_field; -} - -cob_field * -cob_intr_test_day_yyyyddd (cob_field *srcfield) -{ - int indate; - int days; - int year; - - /* Base 1601-01-01 */ - indate = cob_get_int (srcfield); - year = indate / 1000; - if (!valid_year (year)) { - cob_alloc_set_field_uint (1); - return curr_field; - } - days = indate % 1000; - if (!valid_day_of_year (year, days)) { - cob_alloc_set_field_uint (2); - return curr_field; - } - cob_alloc_set_field_uint (0); - return curr_field; -} - -cob_field * -cob_intr_factorial (cob_field *srcfield) -{ - int srcval; - - cobglobptr->cob_exception_code = 0; - srcval = cob_get_int (srcfield); - d1.scale = 0; - if (srcval < 0) { - cob_set_exception (COB_EC_ARGUMENT_FUNCTION); - cob_alloc_set_field_uint (0); - return curr_field; - } else { - mpz_fac_ui (d1.value, (cob_uli_t)srcval); - } - - cob_alloc_field (&d1); - (void)cob_decimal_get_field (&d1, curr_field, 0); - return curr_field; -} - -cob_field * -cob_intr_e (void) -{ - mpf_set_ui (cob_mpft, 1UL); - cob_mpf_exp (cob_mpft, cob_mpft); - cob_decimal_set_mpf (&d1, cob_mpft); - cob_alloc_field (&d1); - (void)cob_decimal_get_field (&d1, curr_field, 0); - - return curr_field; -} - -cob_field * -cob_intr_pi (void) -{ - mpf_set (cob_mpft, cob_pi); - cob_decimal_set_mpf (&d1, cob_mpft); - cob_alloc_field (&d1); - (void)cob_decimal_get_field (&d1, curr_field, 0); - - return curr_field; -} - -cob_field * -cob_intr_exp (cob_field *srcfield) -{ - cob_decimal_set_field (&d1, srcfield); - - cobglobptr->cob_exception_code = 0; - - if (!mpz_sgn (d1.value)) { - /* Power is zero */ - cob_alloc_set_field_uint (1); - return curr_field; - } - - cob_decimal_get_mpf (cob_mpft, &d1); - cob_mpf_exp (cob_mpft, cob_mpft); - cob_decimal_set_mpf (&d1, cob_mpft); - cob_alloc_field (&d1); - (void)cob_decimal_get_field (&d1, curr_field, 0); - - return curr_field; -} - -cob_field * -cob_intr_exp10 (cob_field *srcfield) -{ - int sign; - - cob_decimal_set_field (&d1, srcfield); - - cobglobptr->cob_exception_code = 0; - - sign = mpz_sgn (d1.value); - if (!sign) { - /* Power is zero */ - cob_alloc_set_field_uint (1); - return curr_field; - } - - cob_trim_decimal (&d1); - - if (!d1.scale) { - /* Integer positive/negative powers */ - if (sign < 0 && mpz_fits_sint_p (d1.value)) { - mpz_abs (d1.value, d1.value); - d1.scale = mpz_get_si (d1.value); - mpz_set_ui (d1.value, 1UL); - cob_alloc_field (&d1); - (void)cob_decimal_get_field (&d1, curr_field, 0); - return curr_field; - } - if (sign > 0 && mpz_fits_ulong_p (d1.value)) { - mpz_ui_pow_ui (d1.value, 10UL, mpz_get_ui (d1.value)); - cob_alloc_field (&d1); - (void)cob_decimal_get_field (&d1, curr_field, 0); - return curr_field; - } - } - - mpz_set_ui (d2.value, 10UL); - d2.scale = 0; - cob_decimal_pow (&d2, &d1); - cob_alloc_field (&d2); - (void)cob_decimal_get_field (&d2, curr_field, 0); - - return curr_field; -} - -cob_field * -cob_intr_log (cob_field *srcfield) -{ - cob_decimal_set_field (&d1, srcfield); - - cobglobptr->cob_exception_code = 0; - if (mpz_sgn (d1.value) <= 0) { - cob_set_exception (COB_EC_ARGUMENT_FUNCTION); - cob_alloc_set_field_uint (0); - return curr_field; - } - - if (d1.scale) { - cob_trim_decimal (&d1); - } - - if (!d1.scale && !mpz_cmp_ui (d1.value, 1UL)) { - /* Log (1) = 0 */ - cob_alloc_set_field_uint (0); - return curr_field; - } - - cob_decimal_get_mpf (cob_mpft, &d1); - cob_mpf_log (cob_mpft, cob_mpft); - cob_decimal_set_mpf (&d1, cob_mpft); - cob_alloc_field (&d1); - (void)cob_decimal_get_field (&d1, curr_field, 0); - - return curr_field; -} - -cob_field * -cob_intr_log10 (cob_field *srcfield) -{ - cob_decimal_set_field (&d1, srcfield); - - cobglobptr->cob_exception_code = 0; - if (mpz_sgn (d1.value) <= 0) { - cob_set_exception (COB_EC_ARGUMENT_FUNCTION); - cob_alloc_set_field_uint (0); - return curr_field; - } - - if (d1.scale) { - cob_trim_decimal (&d1); - } - - if (!d1.scale && !mpz_cmp_ui (d1.value, 1UL)) { - /* Log10 (1) = 0 */ - cob_alloc_set_field_uint (0); - return curr_field; - } - - cob_decimal_get_mpf (cob_mpft, &d1); - cob_mpf_log10 (cob_mpft, cob_mpft); - cob_decimal_set_mpf (&d1, cob_mpft); - cob_alloc_field (&d1); - (void)cob_decimal_get_field (&d1, curr_field, 0); - - return curr_field; -} - -cob_field * -cob_intr_abs (cob_field *srcfield) -{ - cob_decimal_set_field (&d1, srcfield); - mpz_abs (d1.value, d1.value); - - make_field_entry (srcfield); - (void)cob_decimal_get_field (&d1, curr_field, 0); - return curr_field; -} - -cob_field * -cob_intr_acos (cob_field *srcfield) -{ - cob_decimal_set_field (&d1, srcfield); - - mpz_set (d4.value, d1.value); - mpz_set (d5.value, d1.value); - d4.scale = d1.scale; - d5.scale = d1.scale; - mpz_set_si (d2.value, -1L); - d2.scale = 0; - mpz_set_ui (d3.value, 1UL); - d3.scale = 0; - - cobglobptr->cob_exception_code = 0; - if (cob_decimal_cmp (&d4, &d2) < 0 || cob_decimal_cmp (&d5, &d3) > 0) { - cob_set_exception (COB_EC_ARGUMENT_FUNCTION); - cob_alloc_set_field_uint (0); - return curr_field; - } - - cob_decimal_get_mpf (cob_mpft, &d1); - cob_mpf_acos (cob_mpft, cob_mpft); - cob_decimal_set_mpf (&d1, cob_mpft); - cob_alloc_field (&d1); - (void)cob_decimal_get_field (&d1, curr_field, 0); - - return curr_field; -} - -cob_field * -cob_intr_asin (cob_field *srcfield) -{ - cob_decimal_set_field (&d1, srcfield); - - mpz_set (d4.value, d1.value); - mpz_set (d5.value, d1.value); - d4.scale = d1.scale; - d5.scale = d1.scale; - mpz_set_si (d2.value, -1L); - d2.scale = 0; - mpz_set_ui (d3.value, 1UL); - d3.scale = 0; - - cobglobptr->cob_exception_code = 0; - if (cob_decimal_cmp (&d4, &d2) < 0 || cob_decimal_cmp (&d5, &d3) > 0) { - cob_set_exception (COB_EC_ARGUMENT_FUNCTION); - cob_alloc_set_field_uint (0); - return curr_field; - } - - if (!mpz_sgn (d1.value)) { - /* Asin (0) = 0 */ - cob_alloc_set_field_uint (0); - return curr_field; - } - - cob_decimal_get_mpf (cob_mpft, &d1); - cob_mpf_asin (cob_mpft, cob_mpft); - cob_decimal_set_mpf (&d1, cob_mpft); - cob_alloc_field (&d1); - (void)cob_decimal_get_field (&d1, curr_field, 0); - - return curr_field; -} - -cob_field * -cob_intr_atan (cob_field *srcfield) -{ - cob_decimal_set_field (&d1, srcfield); - - cobglobptr->cob_exception_code = 0; - - if (!mpz_sgn (d1.value)) { - /* Atan (0) = 0 */ - cob_alloc_set_field_uint (0); - return curr_field; - } - - cob_decimal_get_mpf (cob_mpft, &d1); - cob_mpf_atan (cob_mpft, cob_mpft); - cob_decimal_set_mpf (&d1, cob_mpft); - cob_alloc_field (&d1); - (void)cob_decimal_get_field (&d1, curr_field, 0); - - return curr_field; -} - -cob_field * -cob_intr_cos (cob_field *srcfield) -{ - cob_decimal_set_field (&d1, srcfield); - - cobglobptr->cob_exception_code = 0; - - cob_decimal_get_mpf (cob_mpft, &d1); - cob_mpf_cos (cob_mpft, cob_mpft); - cob_decimal_set_mpf (&d1, cob_mpft); - cob_alloc_field (&d1); - (void)cob_decimal_get_field (&d1, curr_field, 0); - - return curr_field; -} - -cob_field * -cob_intr_sin (cob_field *srcfield) -{ - cob_decimal_set_field (&d1, srcfield); - - cobglobptr->cob_exception_code = 0; - - cob_decimal_get_mpf (cob_mpft, &d1); - cob_mpf_sin (cob_mpft, cob_mpft); - cob_decimal_set_mpf (&d1, cob_mpft); - cob_alloc_field (&d1); - (void)cob_decimal_get_field (&d1, curr_field, 0); - - return curr_field; -} - -cob_field * -cob_intr_tan (cob_field *srcfield) -{ - cob_decimal_set_field (&d1, srcfield); - - cobglobptr->cob_exception_code = 0; - - cob_decimal_get_mpf (cob_mpft, &d1); - cob_mpf_tan (cob_mpft, cob_mpft); - cob_decimal_set_mpf (&d1, cob_mpft); - cob_alloc_field (&d1); - (void)cob_decimal_get_field (&d1, curr_field, 0); - - return curr_field; -} - -cob_field * -cob_intr_sqrt (cob_field *srcfield) -{ - cob_decimal_set_field (&d1, srcfield); - - cobglobptr->cob_exception_code = 0; - if (mpz_sgn (d1.value) < 0) { - cob_set_exception (COB_EC_ARGUMENT_FUNCTION); - cob_alloc_set_field_uint (0); - return curr_field; - } - - mpz_set_ui (d2.value, 5UL); - d2.scale = 1; - cob_trim_decimal (&d1); - cob_decimal_pow (&d1, &d2); - - cob_alloc_field (&d1); - (void)cob_decimal_get_field (&d1, curr_field, 0); - - return curr_field; -} - -cob_field * -cob_intr_numval (cob_field *srcfield) -{ - return numval (srcfield, NULL, NUMVAL); -} - -cob_field * -cob_intr_numval_c (cob_field *srcfield, cob_field *currency) -{ - return numval (srcfield, currency, NUMVAL_C); -} - -cob_field * -cob_intr_numval_f (cob_field *srcfield) -{ - unsigned char *final_buff; - unsigned char *p; - size_t plus_minus; - size_t digits; - size_t decimal_digits; - size_t dec_seen; - size_t e_seen; - size_t exponent; - size_t e_plus_minus; - size_t n; - unsigned char dec_pt; - - /* Validate source field */ - if (cob_check_numval_f (srcfield)) { - cob_set_exception (COB_EC_ARGUMENT_FUNCTION); - cob_alloc_set_field_uint (0); - return curr_field; - } - - plus_minus = 0; - digits = 0; - decimal_digits = 0; - dec_seen = 0; - e_seen = 0; - exponent = 0; - e_plus_minus = 0; - dec_pt = COB_MODULE_PTR->decimal_point; - - final_buff = cob_malloc (srcfield->size + 1U); - p = srcfield->data; - for (n = 0; n < srcfield->size; ++n, ++p) { - switch (*p) { - case '0': - case '1': - case '2': - case '3': - case '4': - case '5': - case '6': - case '7': - case '8': - case '9': - if (e_seen) { - exponent *= 10; - exponent += (*p & 0x0F); - } else { - if (dec_seen) { - decimal_digits++; - } - final_buff[digits++] = *p; - } - continue; - case 'E': - e_seen = 1; - continue; - case '-': - if (e_seen) { - e_plus_minus = 1; - } else { - plus_minus = 1; - } - continue; - default: - if (*p == dec_pt) { - dec_seen = 1; - } - continue; - } - } - - if (!digits) { - final_buff[0] = '0'; - } - - mpz_set_str (d1.value, (char *)final_buff, 10); - cob_free (final_buff); - if (!mpz_sgn (d1.value)) { - /* Value is zero ; sign and exponent irrelevant */ - d1.scale = 0; - cob_alloc_field (&d1); - (void)cob_decimal_get_field (&d1, curr_field, 0); - return curr_field; - } - if (plus_minus) { - mpz_neg (d1.value, d1.value); - } - if (exponent) { - if (e_plus_minus) { - /* Negative exponent */ - d1.scale = decimal_digits + exponent; - } else { - /* Positive exponent */ - if (decimal_digits >= exponent) { - d1.scale = decimal_digits - exponent; - } else { - exponent -= decimal_digits; - mpz_ui_pow_ui (cob_mexp, 10UL, - (cob_uli_t)exponent); - mpz_mul (d1.value, d1.value, cob_mexp); - d1.scale = 0; - } - } - } else { - /* No exponent */ - d1.scale = decimal_digits; - } - - cob_alloc_field (&d1); - (void)cob_decimal_get_field (&d1, curr_field, 0); - - return curr_field; -} - -cob_field * -cob_intr_annuity (cob_field *srcfield1, cob_field *srcfield2) -{ - int sign; - - cob_decimal_set_field (&d1, srcfield1); - cob_decimal_set_field (&d2, srcfield2); - - /* P1 >= 0, P2 > 0 and integer */ - sign = mpz_sgn (d1.value); - if (sign < 0 || mpz_sgn (d2.value) <= 0 || d2.scale != 0) { - cob_set_exception (COB_EC_ARGUMENT_FUNCTION); - cob_alloc_set_field_uint (0); - return curr_field; - } - - if (!sign) { - mpz_set_ui (d1.value, 1UL); - d1.scale = 0; - cob_decimal_div (&d1, &d2); - cob_alloc_field (&d1); - (void)cob_decimal_get_field (&d1, curr_field, 0); - return curr_field; - } - - /* x = P1 / (1 - (1 + P1) ^ (-P2)) */ - mpz_neg (d2.value, d2.value); - - mpz_set (d3.value, d1.value); - d3.scale = d1.scale; - mpz_set_ui (d4.value, 1UL); - d4.scale = 0; - cob_decimal_add (&d3, &d4); - cob_trim_decimal (&d3); - cob_trim_decimal (&d2); - cob_decimal_pow (&d3, &d2); - mpz_set_ui (d4.value, 1UL); - d4.scale = 0; - cob_decimal_sub (&d4, &d3); - cob_trim_decimal (&d4); - cob_trim_decimal (&d1); - cob_decimal_div (&d1, &d4); - cob_alloc_field (&d1); - (void)cob_decimal_get_field (&d1, curr_field, 0); - return curr_field; -} - -cob_field * -cob_intr_sum (const int params, ...) -{ - cob_field *f; - va_list args; - int i; - - mpz_set_ui (d1.value, 0UL); - d1.scale = 0; - - va_start (args, params); - - for (i = 0; i < params; ++i) { - f = va_arg (args, cob_field *); - cob_decimal_set_field (&d2, f); - cob_decimal_add (&d1, &d2); - } - va_end (args); - - cob_alloc_field (&d1); - (void)cob_decimal_get_field (&d1, curr_field, 0); - return curr_field; -} - -cob_field * -cob_intr_ord_min (const int params, ...) -{ - cob_field *f; - cob_field *basef; - int i; - cob_u32_t ordmin; - va_list args; - - va_start (args, params); - - ordmin = 1; - basef = va_arg (args, cob_field *); - for (i = 1; i < params; ++i) { - f = va_arg (args, cob_field *); - if (cob_cmp (f, basef) < 0) { - basef = f; - ordmin = i + 1; - } - } - va_end (args); - - cob_alloc_set_field_uint (ordmin); - return curr_field; -} - -cob_field * -cob_intr_ord_max (const int params, ...) -{ - cob_field *f; - cob_field *basef; - cob_u32_t ordmax; - int i; - va_list args; - - va_start (args, params); - - ordmax = 1; - basef = va_arg (args, cob_field *); - for (i = 1; i < params; ++i) { - f = va_arg (args, cob_field *); - if (cob_cmp (f, basef) > 0) { - basef = f; - ordmax = i + 1; - } - } - va_end (args); - - cob_alloc_set_field_uint (ordmax); - return curr_field; -} - -cob_field * -cob_intr_min (const int params, ...) -{ - cob_field *f; - cob_field *basef; - va_list args; - int i; - - va_start (args, params); - - basef = va_arg (args, cob_field *); - for (i = 1; i < params; ++i) { - f = va_arg (args, cob_field *); - if (cob_cmp (f, basef) < 0) { - basef = f; - } - } - va_end (args); - - make_field_entry (basef); - memcpy (curr_field->data, basef->data, basef->size); - return curr_field; -} - -cob_field * -cob_intr_max (const int params, ...) -{ - cob_field *f; - cob_field *basef; - va_list args; - int i; - - va_start (args, params); - - basef = va_arg (args, cob_field *); - for (i = 1; i < params; ++i) { - f = va_arg (args, cob_field *); - if (cob_cmp (f, basef) > 0) { - basef = f; - } - } - va_end (args); - - make_field_entry (basef); - memcpy (curr_field->data, basef->data, basef->size); - return curr_field; -} - -cob_field * -cob_intr_midrange (const int params, ...) -{ - cob_field *basemin; - cob_field *basemax; - va_list args; - - va_start (args, params); - get_min_and_max_of_args (params, args, &basemin, &basemax); - va_end (args); - - /* Return (max + min) / 2 */ - cob_decimal_set_field (&d1, basemin); - cob_decimal_set_field (&d2, basemax); - cob_decimal_add (&d1, &d2); - mpz_set_ui (d2.value, 2UL); - d2.scale = 0; - cob_decimal_div (&d1, &d2); - - cob_alloc_field (&d1); - (void)cob_decimal_get_field (&d1, curr_field, 0); - return curr_field; -} - -cob_field * -cob_intr_median (const int params, ...) -{ - cob_field *f; - cob_field **field_alloc; - va_list args; - int i; - - va_start (args, params); - - f = va_arg (args, cob_field *); - if (params == 1) { - va_end (args); - make_field_entry (f); - memcpy (curr_field->data, f->data, f->size); - return curr_field; - } - - field_alloc = cob_malloc ((size_t)params * sizeof (cob_field *)); - field_alloc[0] = f; - - for (i = 1; i < params; ++i) { - field_alloc[i] = va_arg (args, cob_field *); - } - va_end (args); - - qsort (field_alloc, (size_t)params, (size_t)sizeof (cob_field *), - comp_field); - - i = params / 2; - if (params % 2) { - f = field_alloc[i]; - make_field_entry (f); - memcpy (curr_field->data, f->data, f->size); - } else { - cob_decimal_set_field (&d1, field_alloc[i-1]); - cob_decimal_set_field (&d2, field_alloc[i]); - cob_decimal_add (&d1, &d2); - mpz_set_ui (d2.value, 2UL); - d2.scale = 0; - cob_decimal_div (&d1, &d2); - cob_alloc_field (&d1); - (void)cob_decimal_get_field (&d1, curr_field, 0); - } - cob_free (field_alloc); - return curr_field; -} - -cob_field * -cob_intr_mean (const int params, ...) -{ - cob_field *f; - va_list args; - int i; - - va_start (args, params); - - if (params == 1) { - f = va_arg (args, cob_field *); - va_end (args); - make_field_entry (f); - memcpy (curr_field->data, f->data, f->size); - return curr_field; - } - - mpz_set_ui (d1.value, 0UL); - d1.scale = 0; - - for (i = 0; i < params; ++i) { - f = va_arg (args, cob_field *); - cob_decimal_set_field (&d2, f); - cob_decimal_add (&d1, &d2); - } - va_end (args); - - mpz_set_ui (d2.value, (cob_uli_t)params); - d2.scale = 0; - cob_decimal_div (&d1, &d2); - - cob_alloc_field (&d1); - (void)cob_decimal_get_field (&d1, curr_field, 0); - - return curr_field; -} - -cob_field * -cob_intr_mod (cob_field *srcfield1, cob_field *srcfield2) -{ - return cob_mod_or_rem (srcfield1, srcfield2, 0); -} - -cob_field * -cob_intr_range (const int params, ...) -{ - cob_field *basemin, *basemax; - va_list args; - - va_start (args, params); - get_min_and_max_of_args (params, args, &basemin, &basemax); - va_end (args); - - cob_decimal_set_field (&d1, basemax); - cob_decimal_set_field (&d2, basemin); - cob_decimal_sub (&d1, &d2); - - cob_alloc_field (&d1); - (void)cob_decimal_get_field (&d1, curr_field, 0); - return curr_field; -} - -cob_field * -cob_intr_rem (cob_field *srcfield1, cob_field *srcfield2) -{ - return cob_mod_or_rem (srcfield1, srcfield2, 1); -} - -cob_field * -cob_intr_random (const int params, ...) -{ - cob_field *f; - va_list args; - double val; - int seed; - int randnum; - cob_field_attr attr; - cob_field field; - - COB_ATTR_INIT (COB_TYPE_NUMERIC_DOUBLE, 20, 9, COB_FLAG_HAVE_SIGN, NULL); - COB_FIELD_INIT (sizeof(double), NULL, &attr); - va_start (args, params); - - if (params) { - f = va_arg (args, cob_field *); - seed = cob_get_int (f); - if (seed < 0) { - seed = 0; - } -#ifdef __CYGWIN__ - srandom ((unsigned int)seed); -#else - srand ((unsigned int)seed); -#endif - } - va_end (args); - -#ifdef __CYGWIN__ - randnum = (int)random (); -#else - randnum = rand (); -#endif - make_field_entry (&field); - val = (double)randnum / (double)RAND_MAX; - memcpy (curr_field->data, &val, sizeof(val)); - return curr_field; -} - -#define GET_VARIANCE(num_args, args) \ - do { \ - /* Get mean in d1 */ \ - va_start (args, num_args); \ - calc_mean_of_args (num_args, args); \ - va_end (args); \ - \ - cob_decimal_set (&d5, &d1); \ - \ - /* Get variance in d1 */ \ - va_start (args, num_args); \ - calc_variance_of_args (num_args, args, &d5); \ - va_end (args); \ - } ONCE_COB - -cob_field * -cob_intr_variance (const int num_args, ...) -{ - va_list args; - - GET_VARIANCE (num_args, args); - - cob_alloc_field (&d1); - (void)cob_decimal_get_field (&d1, curr_field, 0); - return curr_field; -} - -cob_field * -cob_intr_standard_deviation (const int num_args, ...) -{ - va_list args; - - GET_VARIANCE (num_args, args); - cob_trim_decimal (&d1); - - cobglobptr->cob_exception_code = 0; - - /* Take square root of variance */ - mpz_set_ui (d3.value, 5UL); - d3.scale = 1; - - cob_decimal_pow (&d1, &d3); - - cob_alloc_field (&d1); - (void)cob_decimal_get_field (&d1, curr_field, 0); - return curr_field; -} - -#undef GET_VARIANCE - -cob_field * -cob_intr_present_value (const int params, ...) -{ - cob_field *f; - va_list args; - int i; - - va_start (args, params); - - f = va_arg (args, cob_field *); - - cob_decimal_set_field (&d1, f); - mpz_set_ui (d2.value, 1UL); - d2.scale = 0; - cob_decimal_add (&d1, &d2); - - mpz_set_ui (d4.value, 0UL); - d4.scale = 0; - - for (i = 1; i < params; ++i) { - f = va_arg (args, cob_field *); - cob_decimal_set_field (&d2, f); - mpz_set (d3.value, d1.value); - d3.scale = d1.scale; - if (i > 1) { - mpz_pow_ui (d3.value, d3.value, (cob_uli_t)i); - d3.scale *= i; - } - cob_decimal_div (&d2, &d3); - cob_decimal_add (&d4, &d2); - } - va_end (args); - - cob_alloc_field (&d4); - (void)cob_decimal_get_field (&d4, curr_field, 0); - return curr_field; -} - -cob_field * -cob_intr_year_to_yyyy (const int params, ...) -{ - cob_field *f; - struct tm *timeptr; - va_list args; - time_t t; - int year; - int interval; - int current_year; - int maxyear; - - cobglobptr->cob_exception_code = 0; - va_start (args, params); - f = va_arg (args, cob_field *); - year = cob_get_int (f); - if (params > 1) { - f = va_arg (args, cob_field *); - interval = cob_get_int (f); - } else { - interval = 50; - } - if (params > 2) { - f = va_arg (args, cob_field *); - current_year = cob_get_int (f); - } else { - t = time (NULL); - timeptr = localtime (&t); - current_year = 1900 + timeptr->tm_year; - } - va_end (args); - - if (year < 0 || year > 99) { - cob_set_exception (COB_EC_ARGUMENT_FUNCTION); - cob_alloc_set_field_uint (0); - return curr_field; - } - if (!valid_year (current_year)) { - cob_set_exception (COB_EC_ARGUMENT_FUNCTION); - cob_alloc_set_field_uint (0); - return curr_field; - } - maxyear = current_year + interval; - if (maxyear < 1700 || maxyear > 9999) { - cob_set_exception (COB_EC_ARGUMENT_FUNCTION); - cob_alloc_set_field_uint (0); - return curr_field; - } - if (maxyear % 100 >= year) { - year += 100 * (maxyear / 100); - } else { - year += 100 * ((maxyear / 100) - 1); - } - cob_alloc_set_field_int (year); - return curr_field; -} - -cob_field * -cob_intr_date_to_yyyymmdd (const int params, ...) -{ - cob_field *f; - va_list args; - int year; - int mmdd; - int interval; - int current_year; - int maxyear; - - cobglobptr->cob_exception_code = 0; - - va_start (args, params); - - f = va_arg (args, cob_field *); - year = cob_get_int (f); - mmdd = year % 10000; - year /= 10000; - - get_interval_and_current_year_from_args (params, args, &interval, - ¤t_year); - - va_end (args); - - maxyear = current_year + interval; - /* The unusual year checks are as specified in the standard */ - if (year < 0 || year > 999999 - || !valid_year (current_year) - || (maxyear < 1700 || maxyear > 9999)) { - cob_set_exception (COB_EC_ARGUMENT_FUNCTION); - cob_alloc_set_field_uint (0); - return curr_field; - } - - if (maxyear % 100 >= year) { - year += 100 * (maxyear / 100); - } else { - year += 100 * ((maxyear / 100) - 1); - } - year *= 10000; - year += mmdd; - cob_alloc_set_field_int (year); - return curr_field; -} - -cob_field * -cob_intr_day_to_yyyyddd (const int params, ...) -{ - cob_field *f; - va_list args; - int year; - int days; - int interval; - int current_year; - int maxyear; - - cobglobptr->cob_exception_code = 0; - - va_start (args, params); - - f = va_arg (args, cob_field *); - year = cob_get_int (f); - days = year % 1000; - year /= 1000; - - get_interval_and_current_year_from_args (params, args, &interval, - ¤t_year); - - va_end (args); - - if (year < 0 || year > 999999) { - cob_set_exception (COB_EC_ARGUMENT_FUNCTION); - cob_alloc_set_field_uint (0); - return curr_field; - } - if (!valid_year (current_year)) { - cob_set_exception (COB_EC_ARGUMENT_FUNCTION); - cob_alloc_set_field_uint (0); - return curr_field; - } - maxyear = current_year + interval; - if (maxyear < 1700 || maxyear > 9999) { - cob_set_exception (COB_EC_ARGUMENT_FUNCTION); - cob_alloc_set_field_uint (0); - return curr_field; - } - if (maxyear % 100 >= year) { - year += 100 * (maxyear / 100); - } else { - year += 100 * ((maxyear / 100) - 1); - } - year *= 1000; - year += days; - cob_alloc_set_field_int (year); - return curr_field; -} - -cob_field * -cob_intr_seconds_past_midnight (void) -{ - struct tm *timeptr; - time_t t; - int seconds; - - t = time (NULL); - timeptr = localtime (&t); - /* Leap seconds ? */ - if (timeptr->tm_sec >= 60) { - timeptr->tm_sec = 59; - } - seconds = (timeptr->tm_hour * 3600) + (timeptr->tm_min * 60) + - timeptr->tm_sec; - cob_alloc_set_field_int (seconds); - return curr_field; -} - -cob_field * -cob_intr_seconds_from_formatted_time (cob_field *format_field, cob_field *time_field) -{ - size_t str_length; - char format_str[COB_DATETIMESTR_LEN] = { '\0' }; - const char decimal_point = COB_MODULE_PTR->decimal_point; - int is_datetime = 0; - char time_str[COB_DATETIMESTR_LEN] = { '\0' }; - struct time_format time_fmt; - cob_decimal *seconds = &d1; - - str_length = num_leading_nonspace ((char *) format_field->data, - format_field->size); - memcpy (format_str, format_field->data, str_length); - - cobglobptr->cob_exception_code = 0; - - /* Validate the format string */ - if (cob_valid_datetime_format (format_str, decimal_point)) { - is_datetime = 1; - } else if (!cob_valid_time_format (format_str, decimal_point)) { - goto invalid_args; - } - - /* Extract the time part of the strings */ - if (is_datetime) { - split_around_t (format_str, NULL, format_str); - split_around_t ((char *) time_field->data, NULL, time_str); - } else { - memcpy (time_str, time_field->data, str_length); - } - - /* Validate the formatted time */ - time_fmt = parse_time_format_string (format_str); - if (test_formatted_time (time_fmt, time_str, decimal_point) != 0) { - goto invalid_args; - } - - seconds_from_formatted_time (time_fmt, time_str, seconds); - - cob_alloc_field (seconds); - (void) cob_decimal_get_field (seconds, curr_field, 0); - - return curr_field; - - invalid_args: - cob_set_exception (COB_EC_ARGUMENT_FUNCTION); - cob_alloc_set_field_uint (0); - return curr_field; -} - -cob_field * -cob_intr_locale_date (const int offset, const int length, - cob_field *srcfield, cob_field *locale_field) -{ -#if defined(_WIN32) || defined(__CYGWIN__) || defined(HAVE_LANGINFO_CODESET) - size_t len; - int indate; - int days; - int month; - int year; -#ifdef HAVE_LANGINFO_CODESET - unsigned char *p; - char *deflocale = NULL; - struct tm tstruct; - char buff2[128]; -#else - unsigned char *p; - LCID localeid = LOCALE_USER_DEFAULT; - SYSTEMTIME syst; -#endif - char buff[128]; - char locale_buff[COB_SMALL_BUFF]; -#endif - - cobglobptr->cob_exception_code = 0; - -#if defined(_WIN32) || defined(__CYGWIN__) || defined(HAVE_LANGINFO_CODESET) - if (COB_FIELD_IS_NUMERIC (srcfield)) { - indate = cob_get_int (srcfield); - } else { - if (srcfield->size < 8) { - goto derror; - } - p = srcfield->data; - indate = 0; - for (len = 0; len < 8; ++len, ++p) { - if (isdigit (*p)) { - indate *= 10; - indate += (*p - '0'); - } else { - goto derror; - } - } - } - year = indate / 10000; - if (!valid_year (year)) { - goto derror; - } - indate %= 10000; - month = indate / 100; - if (!valid_month (month)) { - goto derror; - } - days = indate % 100; - if (!valid_day_of_month (year, month, days)) { - goto derror; - } -#ifdef HAVE_LANGINFO_CODESET - month--; - - memset ((void *)&tstruct, 0, sizeof(struct tm)); - tstruct.tm_year = year - 1900; - tstruct.tm_mon = month; - tstruct.tm_mday = days; - if (locale_field) { - if (locale_field->size >= COB_SMALL_BUFF) { - goto derror; - } - cob_field_to_string (locale_field, locale_buff, - (size_t)COB_SMALL_MAX); - deflocale = locale_buff; - (void) setlocale (LC_TIME, deflocale); - } - memset (buff2, 0, sizeof(buff2)); - snprintf(buff2, sizeof(buff2) - 1, "%s", nl_langinfo(D_FMT)); - if (deflocale) { - (void) setlocale (LC_ALL, cobglobptr->cob_locale); - } - strftime (buff, sizeof(buff), buff2, &tstruct); -#else - memset ((void *)&syst, 0, sizeof(syst)); - syst.wYear = (WORD)year; - syst.wMonth = (WORD)month; - syst.wDay = (WORD)days; - if (locale_field) { - if (locale_field->size >= COB_SMALL_BUFF) { - goto derror; - } - cob_field_to_string (locale_field, locale_buff, - COB_SMALL_MAX); - locale_buff[COB_SMALL_MAX] = 0; /* silence warnings */ - for (p = (unsigned char *)locale_buff; *p; ++p) { - if (isalnum(*p) || *p == '_') { - continue; - } - break; - } - *p = 0; - for (len = 0; len < WINLOCSIZE; ++len) { - if (!strcmp(locale_buff, wintable[len].winlocalename)) { - localeid = wintable[len].winlocaleid; - break; - } - } - if (len == WINLOCSIZE) { - goto derror; - } - } - if (!GetDateFormat (localeid, DATE_SHORTDATE, &syst, NULL, buff, sizeof(buff))) { - goto derror; - } -#endif - cob_alloc_set_field_str (buff, offset, length); - return curr_field; -derror: -#endif - cob_alloc_set_field_spaces (10); - cob_set_exception (COB_EC_ARGUMENT_FUNCTION); - return curr_field; -} - -cob_field * -cob_intr_locale_time (const int offset, const int length, - cob_field *srcfield, cob_field *locale_field) -{ -#if defined(_WIN32) || defined(__CYGWIN__) || defined(HAVE_LANGINFO_CODESET) - unsigned char *p; - size_t len; - int indate; - int hours; - int minutes; - int seconds; - char buff[LOCTIME_BUFSIZE] = { '\0' }; -#endif - - cobglobptr->cob_exception_code = 0; - -#if defined(_WIN32) || defined(__CYGWIN__) || defined(HAVE_LANGINFO_CODESET) - if (COB_FIELD_IS_NUMERIC (srcfield)) { - indate = cob_get_int (srcfield); - } else { - if (srcfield->size < 6) { - goto derror; - } - p = srcfield->data; - indate = 0; - for (len = 0; len < 6; ++len, ++p) { - if (isdigit (*p)) { - indate *= 10; - indate += (*p - '0'); - } else { - goto derror; - } - } - } - hours = indate / 10000; - if (hours < 0 || hours > 24) { - goto derror; - } - indate %= 10000; - minutes = indate / 100; - if (minutes < 0 || minutes > 59) { - goto derror; - } - seconds = indate % 100; - if (seconds < 0 || seconds > 59) { - goto derror; - } - - if (locale_time (hours, minutes, seconds, locale_field, buff)) { - goto derror; - } - - cob_alloc_set_field_str (buff, offset, length); - return curr_field; -derror: -#endif - cob_alloc_set_field_spaces (10); - cob_set_exception (COB_EC_ARGUMENT_FUNCTION); - return curr_field; -} - -cob_field * -cob_intr_lcl_time_from_secs (const int offset, const int length, - cob_field *srcfield, cob_field *locale_field) -{ -#if defined(_WIN32) || defined(__CYGWIN__) || defined(HAVE_LANGINFO_CODESET) - int indate; - int hours; - int minutes; - int seconds; - char buff[LOCTIME_BUFSIZE] = { '\0' }; -#endif - - cobglobptr->cob_exception_code = 0; - -#if defined(_WIN32) || defined(__CYGWIN__) || defined(HAVE_LANGINFO_CODESET) - if (COB_FIELD_IS_NUMERIC (srcfield)) { - indate = cob_get_int (srcfield); - } else { - goto derror; - } - if (!valid_time (indate)) { - goto derror; - } - hours = indate / 3600; - indate %= 3600; - minutes = indate / 60; - seconds = indate % 60; - - if (locale_time (hours, minutes, seconds, locale_field, buff)) { - goto derror; - } - - cob_alloc_set_field_str (buff, offset, length); - return curr_field; -derror: -#endif - cob_alloc_set_field_spaces (10); - cob_set_exception (COB_EC_ARGUMENT_FUNCTION); - return curr_field; -} - -cob_field * -cob_intr_mon_decimal_point (void) -{ -#ifdef HAVE_LOCALECONV - struct lconv *p; - size_t size; -#endif - cob_field field; - - COB_FIELD_INIT (0, NULL, &const_alpha_attr); - cobglobptr->cob_exception_code = 0; - -#ifdef HAVE_LOCALECONV - p = localeconv (); - size = strlen (p->mon_decimal_point); - if (size) { - field.size = size; - } else { - field.size = 1; - } - make_field_entry (&field); - if (size) { - memcpy (curr_field->data, p->mon_decimal_point, size); - } else { - curr_field->size = 0; - curr_field->data[0] = 0; - } -#else - field.size = 1; - make_field_entry (&field); - curr_field->data[0] = COB_MODULE_PTR->decimal_point; -#endif - return curr_field; -} - -cob_field * -cob_intr_num_decimal_point (void) -{ -#ifdef HAVE_LOCALECONV - struct lconv *p; - size_t size; -#endif - cob_field field; - - COB_FIELD_INIT (0, NULL, &const_alpha_attr); - cobglobptr->cob_exception_code = 0; - -#ifdef HAVE_LOCALECONV - p = localeconv (); - size = strlen (p->decimal_point); - if (size) { - field.size = size; - } else { - field.size = 1; - } - make_field_entry (&field); - if (size) { - memcpy (curr_field->data, p->decimal_point, size); - } else { - curr_field->size = 0; - curr_field->data[0] = 0; - } -#else - field.size = 1; - make_field_entry (&field); - curr_field->data[0] = COB_MODULE_PTR->decimal_point; -#endif - return curr_field; -} - -cob_field * -cob_intr_mon_thousands_sep (void) -{ -#ifdef HAVE_LOCALECONV - struct lconv *p; - size_t size; -#endif - cob_field field; - - COB_FIELD_INIT (0, NULL, &const_alpha_attr); - cobglobptr->cob_exception_code = 0; - -#ifdef HAVE_LOCALECONV - p = localeconv (); - size = strlen (p->mon_thousands_sep); - if (size) { - field.size = size; - } else { - field.size = 1; - } - make_field_entry (&field); - if (size) { - memcpy (curr_field->data, p->mon_thousands_sep, size); - } else { - curr_field->size = 0; - curr_field->data[0] = 0; - } -#else - field.size = 1; - make_field_entry (&field); - curr_field->data[0] = COB_MODULE_PTR->decimal_point; -#endif - return curr_field; -} - -cob_field * -cob_intr_num_thousands_sep (void) -{ -#ifdef HAVE_LOCALECONV - struct lconv *p; - size_t size; -#endif - cob_field field; - - COB_FIELD_INIT (0, NULL, &const_alpha_attr); - cobglobptr->cob_exception_code = 0; - -#ifdef HAVE_LOCALECONV - p = localeconv (); - size = strlen (p->thousands_sep); - if (size) { - field.size = size; - } else { - field.size = 1; - } - make_field_entry (&field); - if (size) { - memcpy (curr_field->data, p->thousands_sep, size); - } else { - curr_field->size = 0; - curr_field->data[0] = 0; - } -#else - field.size = 1; - make_field_entry (&field); - curr_field->data[0] = COB_MODULE_PTR->decimal_point; -#endif - return curr_field; -} - -cob_field * -cob_intr_currency_symbol (void) -{ -#ifdef HAVE_LOCALECONV - struct lconv *p; - size_t size; -#endif - cob_field field; - - COB_FIELD_INIT (0, NULL, &const_alpha_attr); - cobglobptr->cob_exception_code = 0; - -#ifdef HAVE_LOCALECONV - p = localeconv (); - size = strlen (p->currency_symbol); - if (size) { - field.size = size; - } else { - field.size = 1; - } - make_field_entry (&field); - if (size) { - memcpy (curr_field->data, p->currency_symbol, size); - } else { - curr_field->size = 0; - curr_field->data[0] = 0; - } -#else - field.size = 1; - make_field_entry (&field); - curr_field->data[0] = COB_MODULE_PTR->currency_symbol; -#endif - return curr_field; -} - -cob_field * -cob_intr_test_numval (cob_field *srcfield) -{ - cob_alloc_set_field_int (cob_check_numval (srcfield, NULL, 0, 0)); - return curr_field; -} - -cob_field * -cob_intr_test_numval_c (cob_field *srcfield, cob_field *currency) -{ - cob_alloc_set_field_int (cob_check_numval (srcfield, currency, 1, 0)); - return curr_field; -} - -cob_field * -cob_intr_test_numval_f (cob_field *srcfield) -{ - cob_alloc_set_field_int (cob_check_numval_f (srcfield)); - return curr_field; -} - -cob_field * -cob_intr_lowest_algebraic (cob_field *srcfield) -{ - cob_uli_t expo; - cob_field field; - - switch (COB_FIELD_TYPE (srcfield)) { - case COB_TYPE_ALPHANUMERIC: - case COB_TYPE_NATIONAL: - COB_FIELD_INIT (COB_FIELD_SIZE (srcfield), NULL, &const_alpha_attr); - make_field_entry (&field); - break; - - case COB_TYPE_ALPHANUMERIC_EDITED: - case COB_TYPE_NATIONAL_EDITED: - COB_FIELD_INIT (COB_FIELD_DIGITS (srcfield), NULL, &const_alpha_attr); - make_field_entry (&field); - break; - - case COB_TYPE_NUMERIC_BINARY: - if (!COB_FIELD_HAVE_SIGN (srcfield)) { - cob_alloc_set_field_uint (0); - break; - } - if (COB_FIELD_REAL_BINARY (srcfield) || - !COB_FIELD_BINARY_TRUNC (srcfield)) { - expo = (cob_uli_t)((COB_FIELD_SIZE (srcfield) * 8U) - 1U); - mpz_ui_pow_ui (d1.value, 2UL, expo); - mpz_neg (d1.value, d1.value); - d1.scale = COB_FIELD_SCALE (srcfield); - cob_alloc_field (&d1); - (void)cob_decimal_get_field (&d1, curr_field, 0); - break; - } - expo = (cob_uli_t)COB_FIELD_DIGITS (srcfield); - mpz_ui_pow_ui (d1.value, 10UL, expo); - mpz_sub_ui (d1.value, d1.value, 1UL); - mpz_neg (d1.value, d1.value); - d1.scale = COB_FIELD_SCALE (srcfield); - cob_alloc_field (&d1); - (void)cob_decimal_get_field (&d1, curr_field, 0); - break; - - case COB_TYPE_NUMERIC_FLOAT: - case COB_TYPE_NUMERIC_DOUBLE: - cob_set_exception (COB_EC_ARGUMENT_FUNCTION); - cob_alloc_set_field_uint (0); - break; - - case COB_TYPE_NUMERIC_DISPLAY: - case COB_TYPE_NUMERIC_PACKED: - case COB_TYPE_NUMERIC_EDITED: - if (!COB_FIELD_HAVE_SIGN (srcfield)) { - cob_alloc_set_field_uint (0); - break; - } - expo = (cob_uli_t)COB_FIELD_DIGITS (srcfield); - mpz_ui_pow_ui (d1.value, 10UL, expo); - mpz_sub_ui (d1.value, d1.value, 1UL); - mpz_neg (d1.value, d1.value); - d1.scale = COB_FIELD_SCALE (srcfield); - cob_alloc_field (&d1); - (void)cob_decimal_get_field (&d1, curr_field, 0); - break; - default: - cob_set_exception (COB_EC_ARGUMENT_FUNCTION); - cob_alloc_set_field_uint (0); - break; - } - return curr_field; -} - -cob_field * -cob_intr_highest_algebraic (cob_field *srcfield) -{ - cob_uli_t expo; - size_t size; - cob_field field; - - switch (COB_FIELD_TYPE (srcfield)) { - case COB_TYPE_ALPHANUMERIC: - case COB_TYPE_NATIONAL: - size = COB_FIELD_SIZE (srcfield); - COB_FIELD_INIT (size, NULL, &const_alpha_attr); - make_field_entry (&field); - memset (curr_field->data, 255, size); - break; - - case COB_TYPE_ALPHANUMERIC_EDITED: - case COB_TYPE_NATIONAL_EDITED: - size = COB_FIELD_DIGITS (srcfield); - COB_FIELD_INIT (size, NULL, &const_alpha_attr); - make_field_entry (&field); - memset (curr_field->data, 255, size); - break; - - case COB_TYPE_NUMERIC_BINARY: - if (COB_FIELD_REAL_BINARY (srcfield) || - !COB_FIELD_BINARY_TRUNC (srcfield)) { - expo = COB_FIELD_SIZE (srcfield) * 8U; - if (COB_FIELD_HAVE_SIGN (srcfield)) { - expo--; - } - mpz_ui_pow_ui (d1.value, 2UL, expo); - mpz_sub_ui (d1.value, d1.value, 1UL); - d1.scale = COB_FIELD_SCALE (srcfield); - cob_alloc_field (&d1); - (void)cob_decimal_get_field (&d1, curr_field, 0); - break; - } - expo = (cob_uli_t)COB_FIELD_DIGITS (srcfield); - mpz_ui_pow_ui (d1.value, 10UL, expo); - mpz_sub_ui (d1.value, d1.value, 1UL); - d1.scale = COB_FIELD_SCALE (srcfield); - cob_alloc_field (&d1); - (void)cob_decimal_get_field (&d1, curr_field, 0); - break; - - case COB_TYPE_NUMERIC_FLOAT: - case COB_TYPE_NUMERIC_DOUBLE: - cob_set_exception (COB_EC_ARGUMENT_FUNCTION); - cob_alloc_set_field_uint (0); - break; - - case COB_TYPE_NUMERIC_DISPLAY: - case COB_TYPE_NUMERIC_PACKED: - case COB_TYPE_NUMERIC_EDITED: - expo = (cob_uli_t)COB_FIELD_DIGITS (srcfield); - mpz_ui_pow_ui (d1.value, 10UL, expo); - mpz_sub_ui (d1.value, d1.value, 1UL); - d1.scale = COB_FIELD_SCALE (srcfield); - cob_alloc_field (&d1); - (void)cob_decimal_get_field (&d1, curr_field, 0); - break; - default: - cob_set_exception (COB_EC_ARGUMENT_FUNCTION); - cob_alloc_set_field_uint (0); - break; - } - return curr_field; -} - -cob_field * -cob_intr_locale_compare (const int params, ...) -{ - cob_field *f1; - cob_field *f2; - cob_field *locale_field; -#ifdef HAVE_STRCOLL - unsigned char *p; - unsigned char *p1; - unsigned char *p2; - char *deflocale; - size_t size; - size_t size2; - int ret; -#endif - cob_field field; - va_list args; - - cobglobptr->cob_exception_code = 0; - va_start (args, params); - f1 = va_arg (args, cob_field *); - f2 = va_arg (args, cob_field *); - if (params > 2) { - locale_field = va_arg (args, cob_field *); - } else { - locale_field = NULL; - } - va_end (args); - - COB_FIELD_INIT (1, NULL, &const_alpha_attr); - make_field_entry (&field); - -#ifdef HAVE_STRCOLL - deflocale = NULL; - - size = f1->size; - size2 = size; - for (p = f1->data + size - 1U; p != f1->data; --p) { - if (*p != ' ') { - break; - } - size2--; - } - p1 = cob_malloc (size2 + 1U); - memcpy (p1, f1->data, size2); - - size = f2->size; - size2 = size; - for (p = f2->data + size - 1U; p != f2->data; --p) { - if (*p != ' ') { - break; - } - size2--; - } - p2 = cob_malloc (size2 + 1U); - memcpy (p2, f2->data, size2); - - if (locale_field) { - if (!locale_field->size) { - goto derror; - } -#ifdef HAVE_SETLOCALE - deflocale = cob_malloc (locale_field->size + 1U); - cob_field_to_string (locale_field, deflocale, - (size_t)(locale_field->size + 1U)); - (void) setlocale (LC_COLLATE, deflocale); -#else - goto derror; -#endif - } - - ret = strcoll ((char *)p1, (char *)p2); - if (ret < 0) { - curr_field->data[0] = '<'; - } else if (ret > 0) { - curr_field->data[0] = '>'; - } else { - curr_field->data[0] = '='; - } - cob_free (p1); - cob_free (p2); - -#ifdef HAVE_SETLOCALE - if (deflocale) { - (void) setlocale (LC_ALL, cobglobptr->cob_locale); - cob_free (deflocale); - } -#endif - - return curr_field; - -derror: - cob_free (p1); - cob_free (p2); -#endif - curr_field->data[0] = ' '; - cob_set_exception (COB_EC_ARGUMENT_FUNCTION); - - return curr_field; -} - -cob_field * -cob_intr_formatted_date (const int offset, const int length, - cob_field *format_field, cob_field *days_field) -{ - cob_field field; - size_t field_length; - char format_str[COB_DATESTR_LEN] = { '\0' }; - int days; - struct date_format format; - char buff[COB_DATESTR_LEN] = { '\0' }; - - copy_data_to_null_terminated_str (format_field, format_str, - COB_DATESTR_MAX); - field_length = strlen (format_str); - - COB_FIELD_INIT (field_length, NULL, &const_alpha_attr); - make_field_entry (&field); - - cobglobptr->cob_exception_code = 0; - days = cob_get_int (days_field); - - if (!valid_day_and_format (days, format_str)) { - goto invalid_args; - } - - format = parse_date_format_string (format_str); - format_date (format, days, buff); - - memcpy (curr_field->data, buff, field_length); - goto end_of_func; - - invalid_args: - cob_set_exception (COB_EC_ARGUMENT_FUNCTION); - memset (curr_field->data, ' ', strlen (format_str)); - - end_of_func: - if (unlikely (offset > 0)) { - calc_ref_mod (curr_field, offset, length); - } - return curr_field; -} - -cob_field * -cob_intr_formatted_time (const int offset, const int length, - const int params, ...) -{ - va_list args; - cob_field *format_field; - cob_field *time_field; - cob_field *offset_time_field; - cob_field field; - size_t field_length; - char buff[COB_TIMESTR_LEN] = { '\0' }; - char format_str[COB_TIMESTR_LEN] = { '\0' }; - int whole_seconds; - cob_decimal *fractional_seconds; - int use_system_offset; - int offset_time; - int *offset_time_ptr; - struct time_format format; - - if (!(params == 3 || params == 4)) { - COB_FIELD_INIT (0, NULL, &const_alpha_attr); - make_field_entry (&field); - goto invalid_args; - } - - /* Get args */ - va_start (args, params); - - format_field = va_arg (args, cob_field *); - time_field = va_arg (args, cob_field *); - if (params == 4) { - offset_time_field = va_arg (args, cob_field *); - } else { - offset_time_field = NULL; - } - use_system_offset = va_arg (args, int); - - va_end (args); - - /* Initialise buffers */ - copy_data_to_null_terminated_str (format_field, format_str, - COB_TIMESTR_MAX); - field_length = strlen (format_str); - - COB_FIELD_INIT (field_length, NULL, &const_alpha_attr); - make_field_entry (&field); - - cobglobptr->cob_exception_code = 0; - - /* Extract and validate the times and time format */ - - whole_seconds = cob_get_int (time_field); - if (!valid_time (whole_seconds)) { - goto invalid_args; - } - - fractional_seconds = &d2; - get_fractional_seconds (time_field, fractional_seconds); - - if (!cob_valid_time_format (format_str, COB_MODULE_PTR->decimal_point)) { - goto invalid_args; - } - format = parse_time_format_string (format_str); - - if (use_system_offset) { - offset_time_ptr = get_system_offset_time_ptr (&offset_time); - } else { - if (try_get_valid_offset_time (offset_time_field, - &offset_time)) { - goto invalid_args; - } else { - offset_time_ptr = &offset_time; - } - } - - format_time (format, whole_seconds, fractional_seconds, offset_time_ptr, - buff); - - memcpy (curr_field->data, buff, field_length); - goto end_of_func; - - invalid_args: - cob_set_exception (COB_EC_ARGUMENT_FUNCTION); - memset (curr_field->data, ' ', strlen (format_str)); - - end_of_func: - if (unlikely (offset > 0)) { - calc_ref_mod (curr_field, offset, length); - } - return curr_field; -} - -cob_field * -cob_intr_formatted_datetime (const int offset, const int length, - const int params, ...) -{ - va_list args; - cob_field *fmt_field; - cob_field *days_field; - cob_field *time_field; - cob_field *offset_time_field; - cob_field field; - size_t field_length; - char fmt_str[COB_DATETIMESTR_LEN] = { '\0' }; - char date_fmt_str[COB_DATESTR_LEN] = { '\0' }; - char time_fmt_str[COB_TIMESTR_LEN] = { '\0' }; - struct date_format date_fmt; - struct time_format time_fmt; - int days; - int whole_seconds; - cob_decimal *fractional_seconds; - int use_system_offset; - int offset_time; - int *offset_time_ptr; - char buff[COB_DATETIMESTR_LEN] = { '\0' }; - - if (!(params == 4 || params == 5)) { - COB_FIELD_INIT (0, NULL, &const_alpha_attr); - make_field_entry (&field); - goto invalid_args; - } - - /* Get arguments */ - va_start (args, params); - - fmt_field = va_arg (args, cob_field *); - days_field = va_arg (args, cob_field *); - time_field = va_arg (args, cob_field *); - if (params == 5) { - offset_time_field = va_arg (args, cob_field *); - } else { - offset_time_field = NULL; - } - use_system_offset = va_arg (args, int); - - va_end (args); - - copy_data_to_null_terminated_str (fmt_field, fmt_str, - COB_DATETIMESTR_MAX); - field_length = strlen (fmt_str); - - COB_FIELD_INIT (field_length, NULL, &const_alpha_attr); - make_field_entry (&field); - - cobglobptr->cob_exception_code = 0; - - /* Validate the formats, dates and times */ - if (!cob_valid_datetime_format (fmt_str, COB_MODULE_PTR->decimal_point)) { - goto invalid_args; - } - - days = cob_get_int (days_field); - whole_seconds = cob_get_int (time_field); - - if (!valid_integer_date (days) || !valid_time (whole_seconds)) { - goto invalid_args; - } - - split_around_t (fmt_str, date_fmt_str, time_fmt_str); - - time_fmt = parse_time_format_string (time_fmt_str); - if (use_system_offset) { - offset_time_ptr = get_system_offset_time_ptr (&offset_time); - } else { - if (try_get_valid_offset_time (offset_time_field, - &offset_time)) { - goto invalid_args; - } else { - offset_time_ptr = &offset_time; - } - } - date_fmt = parse_date_format_string (date_fmt_str); - - /* Format */ - - fractional_seconds = &d1; - get_fractional_seconds (time_field, fractional_seconds); - - format_datetime (date_fmt, time_fmt, days, whole_seconds, - fractional_seconds, offset_time_ptr, buff); - - memcpy (curr_field->data, buff, (size_t) field_length); - goto end_of_func; - - invalid_args: - cob_set_exception (COB_EC_ARGUMENT_FUNCTION); - memset (curr_field->data, ' ', strlen (fmt_str)); - - end_of_func: - if (unlikely (offset > 0)) { - calc_ref_mod (curr_field, offset, length); - } - return curr_field; -} - - -cob_field * -cob_intr_test_formatted_datetime (cob_field *format_field, - cob_field *datetime_field) -{ - char datetime_format_str[COB_DATETIMESTR_LEN] = { '\0' }; - char date_format_str[COB_DATESTR_LEN] = { '\0' }; - char time_format_str[COB_TIMESTR_LEN] = { '\0' }; - int date_present; - int time_present; - char formatted_datetime[COB_DATETIMESTR_LEN] = { '\0' }; - char formatted_date[COB_DATESTR_LEN] = { '\0' }; - char formatted_time[COB_TIMESTR_LEN] = { '\0' }; - int time_part_offset; - int error_pos; - - cobglobptr->cob_exception_code = 0; - - /* Copy to null-terminated strings */ - copy_data_to_null_terminated_str (format_field, datetime_format_str, - COB_DATETIMESTR_MAX); - copy_data_to_null_terminated_str (datetime_field, formatted_datetime, - COB_DATETIMESTR_MAX); - - /* Check whether date or time is present. */ - if (cob_valid_date_format (datetime_format_str)) { - date_present = 1; - time_present = 0; - } else if (cob_valid_time_format (datetime_format_str, - COB_MODULE_PTR->decimal_point)) { - date_present = 0; - time_present = 1; - } else if (cob_valid_datetime_format (datetime_format_str, - COB_MODULE_PTR->decimal_point)) { - date_present = 1; - time_present = 1; - } else { - goto invalid_args; - } - - /* Move date/time to respective variables */ - if (date_present && time_present) { - split_around_t (datetime_format_str, date_format_str, time_format_str); - } else if (date_present) { - memcpy (date_format_str, datetime_format_str, COB_DATESTR_MAX); - date_format_str[COB_DATESTR_MAX] = 0; - } else { /* time_present */ - memcpy (time_format_str, datetime_format_str, COB_TIMESTR_MAX); - time_format_str[COB_TIMESTR_MAX] = 0; - } - - if (date_present && time_present) { - split_around_t (formatted_datetime, formatted_date, formatted_time); - } else if (date_present) { - memcpy (formatted_date, formatted_datetime, COB_DATESTR_MAX); - } else { /* time_present */ - memcpy (formatted_time, formatted_datetime, COB_TIMESTR_MAX); - } - /* silence warnings */ - formatted_date[COB_DATESTR_MAX] = formatted_time[COB_TIMESTR_MAX] = 0; - - /* Set time offset */ - if (date_present) { - time_part_offset = (int)strlen (formatted_date) + 1; - } else { - time_part_offset = 0; - } - - /* Parse and validate the formatted date/time */ - if (date_present) { - error_pos = test_formatted_date (parse_date_format_string (date_format_str), - formatted_date, !time_present); - if (error_pos != 0) { - cob_alloc_set_field_uint (error_pos); - goto end_of_func; - } - } - if (date_present && time_present - && formatted_datetime[strlen (formatted_date)] != 'T') { - cob_alloc_set_field_uint ((unsigned int)strlen (formatted_date) + 1U); - goto end_of_func; - } - if (time_present) { - error_pos = test_formatted_time (parse_time_format_string (time_format_str), - formatted_time, COB_MODULE_PTR->decimal_point); - if (error_pos != 0) { - cob_alloc_set_field_uint (time_part_offset + error_pos); - goto end_of_func; - } - } - - cob_alloc_set_field_uint (0); - goto end_of_func; - - invalid_args: - cob_set_exception (COB_EC_ARGUMENT_FUNCTION); - cob_alloc_set_field_uint (0); - - end_of_func: - return curr_field; -} - -cob_field * -cob_intr_integer_of_formatted_date (cob_field *format_field, - cob_field *date_field) -{ - char original_format_str[COB_DATETIMESTR_LEN] = { '\0' }; - char original_date_str[COB_DATETIMESTR_LEN] = { '\0' }; - char format_str[COB_DATESTR_LEN] = { '\0' }; - char date_str[COB_DATESTR_LEN] = { '\0' }; - int is_date; - struct date_format date_fmt; - - cobglobptr->cob_exception_code = 0; - - copy_data_to_null_terminated_str (format_field, original_format_str, - COB_DATETIMESTR_MAX); - copy_data_to_null_terminated_str (date_field, original_date_str, - COB_DATETIMESTR_MAX); - - /* Get date format string and parse it */ - is_date = cob_valid_date_format (original_format_str); - if (is_date) { - strcpy (format_str, original_format_str); - } else if (cob_valid_datetime_format (original_format_str, - COB_MODULE_PTR->decimal_point)) { /* Datetime */ - split_around_t (original_format_str, format_str, NULL); - } else { /* Invalid format string */ - goto invalid_args; - } - date_fmt = parse_date_format_string (format_str); - - /* Get formatted date and validate it */ - if (is_date) { - strcpy (date_str, original_date_str); - } else { /* Datetime */ - split_around_t (original_date_str, date_str, NULL); - } - if (test_formatted_date (date_fmt, date_str, 1) != 0) { - goto invalid_args; - } - - cob_alloc_set_field_uint (integer_of_formatted_date (date_fmt, date_str)); - goto end_of_func; - - invalid_args: - cob_set_exception (COB_EC_ARGUMENT_FUNCTION); - cob_alloc_set_field_uint (0); - - end_of_func: - return curr_field; -} - -cob_field * -cob_intr_formatted_current_date (const int offset, const int length, - cob_field *format_field) -{ - cob_field field; - char format_str[COB_DATETIMESTR_LEN] = { '\0' }; - size_t field_length; - char date_format_str[COB_DATESTR_LEN] = { '\0' }; - char time_format_str[COB_TIMESTR_LEN] = { '\0' }; - struct date_format date_fmt; - struct time_format time_fmt; - char formatted_date[COB_DATETIMESTR_LEN] = { '\0' }; - - copy_data_to_null_terminated_str (format_field, format_str, - COB_DATETIMESTR_MAX); - field_length = strlen (format_str); - - COB_FIELD_INIT (field_length, NULL, &const_alpha_attr); - make_field_entry (&field); - - cobglobptr->cob_exception_code = 0; - - /* Validate format */ - if (!cob_valid_datetime_format (format_str, COB_MODULE_PTR->decimal_point)) { - cob_set_exception (COB_EC_ARGUMENT_FUNCTION); - memset (curr_field->data, ' ', field_length); - goto end_of_func; - } - - /* Parse format */ - split_around_t (format_str, date_format_str, time_format_str); - date_fmt = parse_date_format_string (date_format_str); - time_fmt = parse_time_format_string (time_format_str); - - /* Format current date */ - format_current_date (date_fmt, time_fmt, formatted_date); - memcpy (curr_field->data, formatted_date, field_length); - - end_of_func: - if (unlikely (offset > 0)) { - calc_ref_mod (curr_field, offset, length); - } - return curr_field; -} - -/** - FUNCTION CONTENT-LENGTH(pointer). NUMERIC. - - Return the nul byte terminated "string" length of data - addressed by the given pointer. -**/ -cob_field * -cob_intr_content_length (cob_field *srcfield) -{ - unsigned char *pointed; - cob_u32_t val = 0; - - cob_set_exception (0); - if (srcfield) { - pointed = *((unsigned char **)srcfield->data); - } else { - pointed = NULL; - } - /* check if the pointer is set and does not point to NULL */ - if (pointed && *pointed) { - val = (cob_u32_t)strlen ((char *)pointed); - } else { - cob_set_exception (COB_EC_DATA_PTR_NULL); - } - cob_alloc_set_field_uint (val); - return curr_field; -} - -/** - FUNCTION CONTENT-OF (pointer, [len]). ALPHANUMERIC, ref-mod allowed. - - Retrieve the content of a pointer indirection. - Either for given length, or if omitted or 0, by NUL terminator scan. - If the source pointer is null, points to null or an empty string, - return a zero length space. -**/ -cob_field * -cob_intr_content_of (const int offset, const int length, const int params, ...) -{ - size_t size = 0; - unsigned char *pointed; - unsigned int request_len; - va_list args; - cob_field field; - cob_field *srcfield; - cob_field *lenfield; - - cob_set_exception (0); - - va_start (args, params); - srcfield = va_arg(args, cob_field *); - if (params > 1) { - lenfield = va_arg (args, cob_field *); - request_len = cob_get_int (lenfield); - } else { - request_len = 0; - } - va_end (args); - - if (srcfield) { - pointed = *((unsigned char **)srcfield->data); - } else { - pointed = NULL; - } - /* check if the pointer is set and does not point to NULL */ - if (pointed && *pointed) { - /* Fixed length (may include NUL) or C NUL terminated string */ - if (request_len != 0) { - size = request_len; - } else { - size = strlen ((char *)pointed); - } - if (size > COB_MAX_UNBOUNDED_SIZE) { - cob_set_exception (COB_EC_SIZE_TRUNCATION); - size = COB_MAX_UNBOUNDED_SIZE; - } - } else { - cob_set_exception (COB_EC_DATA_PTR_NULL); - size = 0; - } - if (size != 0) { - COB_FIELD_INIT (size, NULL, &const_alpha_attr); - make_field_entry (&field); - /* Testing for memory access permissions is canonically: */ - /* open fake pipe, use write and test for -1 and EFAULT */ - /* Not used here, performance hit versus programmer error */ - memcpy (curr_field->data, pointed, size); - } else { - COB_FIELD_INIT (1, NULL, &const_alpha_attr); - make_field_entry (&field); - curr_field->data[0] = ' '; - curr_field->size = 0; - } - if (unlikely(offset > 0)) { - calc_ref_mod (curr_field, offset, length); - } - return curr_field; -} - -/* RXWRXW - To be implemented */ - -cob_field * -cob_intr_boolean_of_integer (cob_field *f1, cob_field *f2) -{ - COB_UNUSED (f1); - COB_UNUSED (f2); - - error_not_implemented (); -} - -cob_field * -cob_intr_char_national (cob_field *srcfield) -{ - COB_UNUSED (srcfield); - - error_not_implemented (); -} - -cob_field * -cob_intr_display_of (const int offset, const int length, - const int params, ...) -{ - COB_UNUSED (offset); - COB_UNUSED (length); - COB_UNUSED (params); - - error_not_implemented (); -} - -cob_field * -cob_intr_exception_file_n (void) -{ - error_not_implemented (); -} - -cob_field * -cob_intr_exception_location_n (void) -{ - error_not_implemented (); -} - -cob_field * -cob_intr_integer_of_boolean (cob_field *srcfield) -{ - COB_UNUSED (srcfield); - - error_not_implemented (); -} - -cob_field * -cob_intr_national_of (const int offset, const int length, const int params, ...) -{ - COB_UNUSED (offset); - COB_UNUSED (length); - COB_UNUSED (params); - - error_not_implemented (); -} - -cob_field * -cob_intr_standard_compare (const int params, ...) -{ - COB_UNUSED (params); - - error_not_implemented (); -} - -/* Initialization/exit routines */ - -void -cob_exit_intrinsic (void) -{ - struct calc_struct *calc_temp; - cob_u32_t i; - - mpf_clear (cob_log_half); - mpf_clear (cob_sqrt_two); - mpf_clear (cob_pi); - - mpf_clear (cob_mpft_get); - mpf_clear (cob_mpft2); - mpf_clear (cob_mpft); - - mpz_clear (d5.value); - mpz_clear (d4.value); - mpz_clear (d3.value); - mpz_clear (d2.value); - mpz_clear (d1.value); - - mpz_clear (cob_mpzt); - mpz_clear (cob_mexp); - - if (calc_base) { - calc_temp = calc_base; - for (i = 0; i < COB_DEPTH_LEVEL; ++i, ++calc_temp) { - if (calc_temp->calc_field.data) { - cob_free (calc_temp->calc_field.data); - } - } - cob_free (calc_base); - } -} - -void -cob_init_intrinsic (cob_global *lptr) -{ - struct calc_struct *calc_temp; - cob_u32_t i; - - cobglobptr = lptr; - - move_field = NULL; - curr_entry = 0; - curr_field = NULL; - calc_base = cob_malloc (COB_DEPTH_LEVEL * sizeof(struct calc_struct)); - calc_temp = calc_base; - for (i = 0; i < COB_DEPTH_LEVEL; ++i, ++calc_temp) { - calc_temp->calc_field.data = cob_malloc ((size_t)256); - calc_temp->calc_field.size = 256; - calc_temp->calc_size = 256; - } - - mpz_init2 (cob_mexp, COB_MPZ_DEF); - mpz_init2 (cob_mpzt, COB_MPZ_DEF); - cob_decimal_init2 (&d1, 1536UL); - cob_decimal_init2 (&d2, 1536UL); - cob_decimal_init2 (&d3, 1536UL); - cob_decimal_init2 (&d4, 1536UL); - cob_decimal_init2 (&d5, 1536UL); - - mpf_init2 (cob_mpft, COB_MPF_PREC); - mpf_init2 (cob_mpft2, COB_MPF_PREC); - mpf_init2 (cob_mpft_get, COB_MPF_PREC); - - mpf_init2 (cob_pi, COB_PI_LEN); - mpf_set_str (cob_pi, cob_pi_str, 10); - - mpf_init2 (cob_sqrt_two, COB_SQRT_TWO_LEN); - mpf_set_str (cob_sqrt_two, cob_sqrt_two_str, 10); - - mpf_init2 (cob_log_half, COB_LOG_HALF_LEN); - mpf_set_str (cob_log_half, cob_log_half_str, 10); -} - -#undef COB_DATETIMESTR_LEN -#undef COB_TIMESTR_LEN -#undef COB_DATESTR_LEN diff -Nru gnucobol-4.0~early~20200606/libcob/libcobci.c gnucobol-5/libcob/libcobci.c --- gnucobol-4.0~early~20200606/libcob/libcobci.c 2020-06-06 20:52:01.000000000 +0000 +++ gnucobol-5/libcob/libcobci.c 1970-01-01 00:00:00.000000000 +0000 @@ -1,31 +0,0 @@ -/* - Copyright (C) 2002-2012, 2014-2019 Free Software Foundation, Inc. - Written by Keisuke Nishida, Roger While, Simon Sobisch, Ron Norman - - This file is part of GnuCOBOL. - - The GnuCOBOL runtime library is free software: you can redistribute it - and/or modify it under the terms of the GNU Lesser General Public License - as published by the Free Software Foundation, either version 3 of the - License, or (at your option) any later version. - - GnuCOBOL is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU Lesser General Public License for more details. - - You should have received a copy of the GNU Lesser General Public License - along with GnuCOBOL. If not, see . -*/ - -#ifndef _CONFIG_H -#include -#define _CONFIG_H -#endif -#if defined(WITH_MULTI_ISAM) -#define IS_ISAM_LIB 1 -#define FOR_CISAM - -#include "fisam.c" - -#endif diff -Nru gnucobol-4.0~early~20200606/libcob/libcobdi.c gnucobol-5/libcob/libcobdi.c --- gnucobol-4.0~early~20200606/libcob/libcobdi.c 2020-06-06 20:52:01.000000000 +0000 +++ gnucobol-5/libcob/libcobdi.c 1970-01-01 00:00:00.000000000 +0000 @@ -1,30 +0,0 @@ -/* - Copyright (C) 2002-2012, 2014-2019 Free Software Foundation, Inc. - Written by Keisuke Nishida, Roger While, Simon Sobisch, Ron Norman - - This file is part of GnuCOBOL. - - The GnuCOBOL runtime library is free software: you can redistribute it - and/or modify it under the terms of the GNU Lesser General Public License - as published by the Free Software Foundation, either version 3 of the - License, or (at your option) any later version. - - GnuCOBOL is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU Lesser General Public License for more details. - - You should have received a copy of the GNU Lesser General Public License - along with GnuCOBOL. If not, see . -*/ -#ifndef _CONFIG_H -#include -#define _CONFIG_H -#endif -#if defined(WITH_MULTI_ISAM) -#define IS_ISAM_LIB 1 -#define FOR_DISAM 1 - -#include "fisam.c" - -#endif diff -Nru gnucobol-4.0~early~20200606/libcob/libcobvb.c gnucobol-5/libcob/libcobvb.c --- gnucobol-4.0~early~20200606/libcob/libcobvb.c 2020-06-06 20:52:01.000000000 +0000 +++ gnucobol-5/libcob/libcobvb.c 1970-01-01 00:00:00.000000000 +0000 @@ -1,31 +0,0 @@ -/* - Copyright (C) 2002-2012, 2014-2019 Free Software Foundation, Inc. - Written by Keisuke Nishida, Roger While, Simon Sobisch, Ron Norman - - This file is part of GnuCOBOL. - - The GnuCOBOL runtime library is free software: you can redistribute it - and/or modify it under the terms of the GNU Lesser General Public License - as published by the Free Software Foundation, either version 3 of the - License, or (at your option) any later version. - - GnuCOBOL is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU Lesser General Public License for more details. - - You should have received a copy of the GNU Lesser General Public License - along with GnuCOBOL. If not, see . -*/ - -#ifndef _CONFIG_H -#include -#define _CONFIG_H -#endif -#if defined(WITH_MULTI_ISAM) -#define IS_ISAM_LIB 1 -#define FOR_VBISAM 1 - -#include "fisam.c" - -#endif diff -Nru gnucobol-4.0~early~20200606/libcob/Makefile.am gnucobol-5/libcob/Makefile.am --- gnucobol-4.0~early~20200606/libcob/Makefile.am 2020-06-06 20:52:01.000000000 +0000 +++ gnucobol-5/libcob/Makefile.am 1970-01-01 00:00:00.000000000 +0000 @@ -1,94 +0,0 @@ -# -# Makefile gnucobol/libcob -# -# Copyright (C) 2003-2012, 2014, 2017-2020 Free Software Foundation, Inc. -# Written by Keisuke Nishida, Roger While, Simon Sobisch -# -# This file is part of GnuCOBOL. -# -# The GnuCOBOL compiler is free software: you can redistribute it -# and/or modify it under the terms of the GNU General Public License -# as published by the Free Software Foundation, either version 3 of the -# License, or (at your option) any later version. -# -# GnuCOBOL is distributed in the hope that it will be useful, -# but WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -# GNU General Public License for more details. -# -# You should have received a copy of the GNU General Public License -# along with GnuCOBOL. If not, see . - -if COB_MAKE_CISAM_LIB -lib_ci = libcobci.la -libcobci_la_LIBADD = $(LIBCOB_CISAM) -else -lib_ci = -endif - -if COB_MAKE_DISAM_LIB -lib_di = libcobdi.la -libcobdi_la_LIBADD = $(LIBCOB_DISAM) -else -lib_di = -endif - -if COB_MAKE_VBISAM_LIB -lib_vb = libcobvb.la -libcobvb_la_LIBADD = $(LIBCOB_VBISAM) -else -lib_vb = -endif - -lib_LTLIBRARIES = libcob.la $(lib_ci) $(lib_di) $(lib_vb) -libcob_la_SOURCES = common.c move.c numeric.c strings.c \ - fileio.c fextfh.c fisam.c fbdb.c focextfh.c flmdb.c fodbc.c foci.c fsqlxfd.c \ - call.c intrinsic.c termio.c screenio.c reportio.c cobgetopt.c \ - mlio.c - -if LOCAL_CJSON -nodist_libcob_la_SOURCES = cJSON.c -DISTCLEANFILES = cJSON.c cJSON.h -endif - -#ToDo Man Page -#dist_man_MANS = libcob.3 -#COBCRUN = cobcrun$(EXEEXT) - -AM_CPPFLAGS = -I$(top_srcdir) $(LIBCOB_CPPFLAGS) -AM_CFLAGS = $(CODE_COVERAGE_CFLAGS) -libcob_la_LIBADD = $(LIBCOB_LIBS) $(CODE_COVERAGE_LIBS) -libcob_la_LDFLAGS = $(COB_FIX_LIBTOOL) -version-info 5:0:0 -no-undefined -AM_LDFLAGS = $(COB_FIX_LIB) - -EXTRA_DIST = coblocal.h system.def sysdefines.h fileio.h -pkgincludedir = $(includedir)/libcob -pkginclude_HEADERS = common.h cobgetopt.h exception.def - -# Add rules for code-coverage testing, as provided by AX_CODE_COVERAGE -@CODE_COVERAGE_RULES@ -CODE_COVERAGE_BRANCH_COVERAGE=1 -CODE_COVERAGE_LCOV_OPTIONS = --no-external - -#HELPSOURCES = $(top_srcdir)/bin/cobcrun.c $(top_srcdir)/configure.ac -#HELP2MAN_OPTS = --info-page=$(PACKAGE) -specialflag -#if MAKE_HAS_PREREQ_ONLY -#libcob.3: $(HELPSOURCES) | $(COBCRUN) -# "$(top_builddir)/pre-inst-env" $(HELP2MAN) --output=$@ $(HELP2MAN_OPTS) $(COBCRUN) -#else -#libcob.3: $(HELPSOURCES) -# "$(top_builddir)/pre-inst-env" $(HELP2MAN) --output=$@ $(HELP2MAN_OPTS) $(COBCRUN) -#endif - -install-data-hook: - rm -f $(DESTDIR)$(includedir)/libcob/byteswap.h - rm -f $(DESTDIR)$(includedir)/libcob/call.h - rm -f $(DESTDIR)$(includedir)/libcob/fileio.h - rm -f $(DESTDIR)$(includedir)/libcob/termio.h - rm -f $(DESTDIR)$(includedir)/libcob/screenio.h - rm -f $(DESTDIR)$(includedir)/libcob/move.h - rm -f $(DESTDIR)$(includedir)/libcob/numeric.h - rm -f $(DESTDIR)$(includedir)/libcob/strings.h - rm -f $(DESTDIR)$(includedir)/libcob/intrinsic.h - rm -f $(DESTDIR)$(includedir)/libcob/codegen.h - rm -f $(DESTDIR)$(includedir)/libcob/system.def diff -Nru gnucobol-4.0~early~20200606/libcob/Makefile.in gnucobol-5/libcob/Makefile.in --- gnucobol-4.0~early~20200606/libcob/Makefile.in 2020-06-06 20:56:36.000000000 +0000 +++ gnucobol-5/libcob/Makefile.in 1970-01-01 00:00:00.000000000 +0000 @@ -1,892 +0,0 @@ -# Makefile.in generated by automake 1.15.1 from Makefile.am. -# @configure_input@ - -# Copyright (C) 1994-2017 Free Software Foundation, Inc. - -# This Makefile.in is free software; the Free Software Foundation -# gives unlimited permission to copy and/or distribute it, -# with or without modifications, as long as this notice is preserved. - -# This program is distributed in the hope that it will be useful, -# but WITHOUT ANY WARRANTY, to the extent permitted by law; without -# even the implied warranty of MERCHANTABILITY or FITNESS FOR A -# PARTICULAR PURPOSE. - -@SET_MAKE@ - -# -# Makefile gnucobol/libcob -# -# Copyright (C) 2003-2012, 2014, 2017-2020 Free Software Foundation, Inc. -# Written by Keisuke Nishida, Roger While, Simon Sobisch -# -# This file is part of GnuCOBOL. -# -# The GnuCOBOL compiler is free software: you can redistribute it -# and/or modify it under the terms of the GNU General Public License -# as published by the Free Software Foundation, either version 3 of the -# License, or (at your option) any later version. -# -# GnuCOBOL is distributed in the hope that it will be useful, -# but WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -# GNU General Public License for more details. -# -# You should have received a copy of the GNU General Public License -# along with GnuCOBOL. If not, see . - - -VPATH = @srcdir@ -am__is_gnu_make = { \ - if test -z '$(MAKELEVEL)'; then \ - false; \ - elif test -n '$(MAKE_HOST)'; then \ - true; \ - elif test -n '$(MAKE_VERSION)' && test -n '$(CURDIR)'; then \ - true; \ - else \ - false; \ - fi; \ -} -am__make_running_with_option = \ - case $${target_option-} in \ - ?) ;; \ - *) echo "am__make_running_with_option: internal error: invalid" \ - "target option '$${target_option-}' specified" >&2; \ - exit 1;; \ - esac; \ - has_opt=no; \ - sane_makeflags=$$MAKEFLAGS; \ - if $(am__is_gnu_make); then \ - sane_makeflags=$$MFLAGS; \ - else \ - case $$MAKEFLAGS in \ - *\\[\ \ ]*) \ - bs=\\; \ - sane_makeflags=`printf '%s\n' "$$MAKEFLAGS" \ - | sed "s/$$bs$$bs[$$bs $$bs ]*//g"`;; \ - esac; \ - fi; \ - skip_next=no; \ - strip_trailopt () \ - { \ - flg=`printf '%s\n' "$$flg" | sed "s/$$1.*$$//"`; \ - }; \ - for flg in $$sane_makeflags; do \ - test $$skip_next = yes && { skip_next=no; continue; }; \ - case $$flg in \ - *=*|--*) continue;; \ - -*I) strip_trailopt 'I'; skip_next=yes;; \ - -*I?*) strip_trailopt 'I';; \ - -*O) strip_trailopt 'O'; skip_next=yes;; \ - -*O?*) strip_trailopt 'O';; \ - -*l) strip_trailopt 'l'; skip_next=yes;; \ - -*l?*) strip_trailopt 'l';; \ - -[dEDm]) skip_next=yes;; \ - -[JT]) skip_next=yes;; \ - esac; \ - case $$flg in \ - *$$target_option*) has_opt=yes; break;; \ - esac; \ - done; \ - test $$has_opt = yes -am__make_dryrun = (target_option=n; $(am__make_running_with_option)) -am__make_keepgoing = (target_option=k; $(am__make_running_with_option)) -pkgdatadir = $(datadir)/@PACKAGE@ -pkglibdir = $(libdir)/@PACKAGE@ -pkglibexecdir = $(libexecdir)/@PACKAGE@ -am__cd = CDPATH="$${ZSH_VERSION+.}$(PATH_SEPARATOR)" && cd -install_sh_DATA = $(install_sh) -c -m 644 -install_sh_PROGRAM = $(install_sh) -c -install_sh_SCRIPT = $(install_sh) -c -INSTALL_HEADER = $(INSTALL_DATA) -transform = $(program_transform_name) -NORMAL_INSTALL = : -PRE_INSTALL = : -POST_INSTALL = : -NORMAL_UNINSTALL = : -PRE_UNINSTALL = : -POST_UNINSTALL = : -build_triplet = @build@ -host_triplet = @host@ -subdir = libcob -ACLOCAL_M4 = $(top_srcdir)/aclocal.m4 -am__aclocal_m4_deps = $(top_srcdir)/m4/codeset.m4 \ - $(top_srcdir)/m4/gettext.m4 $(top_srcdir)/m4/iconv.m4 \ - $(top_srcdir)/m4/intlmacosx.m4 $(top_srcdir)/m4/lib-ld.m4 \ - $(top_srcdir)/m4/lib-link.m4 $(top_srcdir)/m4/lib-prefix.m4 \ - $(top_srcdir)/m4/libtool.m4 $(top_srcdir)/m4/ltoptions.m4 \ - $(top_srcdir)/m4/ltsugar.m4 $(top_srcdir)/m4/ltversion.m4 \ - $(top_srcdir)/m4/lt~obsolete.m4 \ - $(top_srcdir)/m4/m4_ax_check_define.m4 \ - $(top_srcdir)/m4/m4_ax_code_coverage.m4 \ - $(top_srcdir)/m4/nls.m4 $(top_srcdir)/m4/pkg.m4 \ - $(top_srcdir)/m4/po.m4 $(top_srcdir)/m4/progtest.m4 \ - $(top_srcdir)/configure.ac -am__configure_deps = $(am__aclocal_m4_deps) $(CONFIGURE_DEPENDENCIES) \ - $(ACLOCAL_M4) -DIST_COMMON = $(srcdir)/Makefile.am $(pkginclude_HEADERS) \ - $(am__DIST_COMMON) -mkinstalldirs = $(SHELL) $(top_srcdir)/build_aux/mkinstalldirs -CONFIG_HEADER = $(top_builddir)/config.h -CONFIG_CLEAN_FILES = -CONFIG_CLEAN_VPATH_FILES = -am__vpath_adj_setup = srcdirstrip=`echo "$(srcdir)" | sed 's|.|.|g'`; -am__vpath_adj = case $$p in \ - $(srcdir)/*) f=`echo "$$p" | sed "s|^$$srcdirstrip/||"`;; \ - *) f=$$p;; \ - esac; -am__strip_dir = f=`echo $$p | sed -e 's|^.*/||'`; -am__install_max = 40 -am__nobase_strip_setup = \ - srcdirstrip=`echo "$(srcdir)" | sed 's/[].[^$$\\*|]/\\\\&/g'` -am__nobase_strip = \ - for p in $$list; do echo "$$p"; done | sed -e "s|$$srcdirstrip/||" -am__nobase_list = $(am__nobase_strip_setup); \ - for p in $$list; do echo "$$p $$p"; done | \ - sed "s| $$srcdirstrip/| |;"' / .*\//!s/ .*/ ./; s,\( .*\)/[^/]*$$,\1,' | \ - $(AWK) 'BEGIN { files["."] = "" } { files[$$2] = files[$$2] " " $$1; \ - if (++n[$$2] == $(am__install_max)) \ - { print $$2, files[$$2]; n[$$2] = 0; files[$$2] = "" } } \ - END { for (dir in files) print dir, files[dir] }' -am__base_list = \ - sed '$$!N;$$!N;$$!N;$$!N;$$!N;$$!N;$$!N;s/\n/ /g' | \ - sed '$$!N;$$!N;$$!N;$$!N;s/\n/ /g' -am__uninstall_files_from_dir = { \ - test -z "$$files" \ - || { test ! -d "$$dir" && test ! -f "$$dir" && test ! -r "$$dir"; } \ - || { echo " ( cd '$$dir' && rm -f" $$files ")"; \ - $(am__cd) "$$dir" && rm -f $$files; }; \ - } -am__installdirs = "$(DESTDIR)$(libdir)" "$(DESTDIR)$(pkgincludedir)" -LTLIBRARIES = $(lib_LTLIBRARIES) -am__DEPENDENCIES_1 = -libcob_la_DEPENDENCIES = $(am__DEPENDENCIES_1) $(am__DEPENDENCIES_1) -am_libcob_la_OBJECTS = common.lo move.lo numeric.lo strings.lo \ - fileio.lo fextfh.lo fisam.lo fbdb.lo focextfh.lo flmdb.lo \ - fodbc.lo foci.lo fsqlxfd.lo call.lo intrinsic.lo termio.lo \ - screenio.lo reportio.lo cobgetopt.lo mlio.lo -@LOCAL_CJSON_TRUE@nodist_libcob_la_OBJECTS = cJSON.lo -libcob_la_OBJECTS = $(am_libcob_la_OBJECTS) \ - $(nodist_libcob_la_OBJECTS) -AM_V_lt = $(am__v_lt_@AM_V@) -am__v_lt_ = $(am__v_lt_@AM_DEFAULT_V@) -am__v_lt_0 = --silent -am__v_lt_1 = -libcob_la_LINK = $(LIBTOOL) $(AM_V_lt) --tag=CC $(AM_LIBTOOLFLAGS) \ - $(LIBTOOLFLAGS) --mode=link $(CCLD) $(AM_CFLAGS) $(CFLAGS) \ - $(libcob_la_LDFLAGS) $(LDFLAGS) -o $@ -@COB_MAKE_CISAM_LIB_TRUE@libcobci_la_DEPENDENCIES = \ -@COB_MAKE_CISAM_LIB_TRUE@ $(am__DEPENDENCIES_1) -libcobci_la_SOURCES = libcobci.c -libcobci_la_OBJECTS = libcobci.lo -@COB_MAKE_CISAM_LIB_TRUE@am_libcobci_la_rpath = -rpath $(libdir) -@COB_MAKE_DISAM_LIB_TRUE@libcobdi_la_DEPENDENCIES = \ -@COB_MAKE_DISAM_LIB_TRUE@ $(am__DEPENDENCIES_1) -libcobdi_la_SOURCES = libcobdi.c -libcobdi_la_OBJECTS = libcobdi.lo -@COB_MAKE_DISAM_LIB_TRUE@am_libcobdi_la_rpath = -rpath $(libdir) -@COB_MAKE_VBISAM_LIB_TRUE@libcobvb_la_DEPENDENCIES = \ -@COB_MAKE_VBISAM_LIB_TRUE@ $(am__DEPENDENCIES_1) -libcobvb_la_SOURCES = libcobvb.c -libcobvb_la_OBJECTS = libcobvb.lo -@COB_MAKE_VBISAM_LIB_TRUE@am_libcobvb_la_rpath = -rpath $(libdir) -AM_V_P = $(am__v_P_@AM_V@) -am__v_P_ = $(am__v_P_@AM_DEFAULT_V@) -am__v_P_0 = false -am__v_P_1 = : -AM_V_GEN = $(am__v_GEN_@AM_V@) -am__v_GEN_ = $(am__v_GEN_@AM_DEFAULT_V@) -am__v_GEN_0 = @echo " GEN " $@; -am__v_GEN_1 = -AM_V_at = $(am__v_at_@AM_V@) -am__v_at_ = $(am__v_at_@AM_DEFAULT_V@) -am__v_at_0 = @ -am__v_at_1 = -DEFAULT_INCLUDES = -I.@am__isrc@ -I$(top_builddir) -depcomp = $(SHELL) $(top_srcdir)/build_aux/depcomp -am__depfiles_maybe = depfiles -am__mv = mv -f -COMPILE = $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) \ - $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -LTCOMPILE = $(LIBTOOL) $(AM_V_lt) --tag=CC $(AM_LIBTOOLFLAGS) \ - $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) \ - $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) \ - $(AM_CFLAGS) $(CFLAGS) -AM_V_CC = $(am__v_CC_@AM_V@) -am__v_CC_ = $(am__v_CC_@AM_DEFAULT_V@) -am__v_CC_0 = @echo " CC " $@; -am__v_CC_1 = -CCLD = $(CC) -LINK = $(LIBTOOL) $(AM_V_lt) --tag=CC $(AM_LIBTOOLFLAGS) \ - $(LIBTOOLFLAGS) --mode=link $(CCLD) $(AM_CFLAGS) $(CFLAGS) \ - $(AM_LDFLAGS) $(LDFLAGS) -o $@ -AM_V_CCLD = $(am__v_CCLD_@AM_V@) -am__v_CCLD_ = $(am__v_CCLD_@AM_DEFAULT_V@) -am__v_CCLD_0 = @echo " CCLD " $@; -am__v_CCLD_1 = -SOURCES = $(libcob_la_SOURCES) $(nodist_libcob_la_SOURCES) libcobci.c \ - libcobdi.c libcobvb.c -DIST_SOURCES = $(libcob_la_SOURCES) libcobci.c libcobdi.c libcobvb.c -am__can_run_installinfo = \ - case $$AM_UPDATE_INFO_DIR in \ - n|no|NO) false;; \ - *) (install-info --version) >/dev/null 2>&1;; \ - esac -HEADERS = $(pkginclude_HEADERS) -am__tagged_files = $(HEADERS) $(SOURCES) $(TAGS_FILES) $(LISP) -# Read a list of newline-separated strings from the standard input, -# and print each of them once, without duplicates. Input order is -# *not* preserved. -am__uniquify_input = $(AWK) '\ - BEGIN { nonempty = 0; } \ - { items[$$0] = 1; nonempty = 1; } \ - END { if (nonempty) { for (i in items) print i; }; } \ -' -# Make sure the list of sources is unique. This is necessary because, -# e.g., the same source file might be shared among _SOURCES variables -# for different programs/libraries. -am__define_uniq_tagged_files = \ - list='$(am__tagged_files)'; \ - unique=`for i in $$list; do \ - if test -f "$$i"; then echo $$i; else echo $(srcdir)/$$i; fi; \ - done | $(am__uniquify_input)` -ETAGS = etags -CTAGS = ctags -am__DIST_COMMON = $(srcdir)/Makefile.in \ - $(top_srcdir)/build_aux/depcomp \ - $(top_srcdir)/build_aux/mkinstalldirs ChangeLog -DISTFILES = $(DIST_COMMON) $(DIST_SOURCES) $(TEXINFOS) $(EXTRA_DIST) -pkgincludedir = $(includedir)/libcob -ACLOCAL = @ACLOCAL@ -AMTAR = @AMTAR@ -AM_DEFAULT_VERBOSITY = @AM_DEFAULT_VERBOSITY@ -AR = @AR@ -AS = @AS@ -AUTOCONF = @AUTOCONF@ -AUTOHEADER = @AUTOHEADER@ -AUTOMAKE = @AUTOMAKE@ -AWK = @AWK@ -CC = @CC@ -CCDEPMODE = @CCDEPMODE@ -CFLAGS = @CFLAGS@ -CJSON_CFLAGS = @CJSON_CFLAGS@ -CJSON_LIBS = @CJSON_LIBS@ -COBC_LIBS = @COBC_LIBS@ -COB_BIGENDIAN = @COB_BIGENDIAN@ -COB_CC = @COB_CC@ -COB_CFLAGS = @COB_CFLAGS@ -COB_CONFIG_DIR = @COB_CONFIG_DIR@ -COB_COPY_DIR = @COB_COPY_DIR@ -COB_EXE_EXT = @COB_EXE_EXT@ -COB_EXPORT_DYN = @COB_EXPORT_DYN@ -COB_FIX_LIB = @COB_FIX_LIB@ -COB_FIX_LIBTOOL = @COB_FIX_LIBTOOL@ -COB_HAS_64_BIT_POINTER = @COB_HAS_64_BIT_POINTER@ -COB_HAS_BDB = @COB_HAS_BDB@ -COB_HAS_CISAM = @COB_HAS_CISAM@ -COB_HAS_CJSON = @COB_HAS_CJSON@ -COB_HAS_CURSES = @COB_HAS_CURSES@ -COB_HAS_DISAM = @COB_HAS_DISAM@ -COB_HAS_ISAM = @COB_HAS_ISAM@ -COB_HAS_LMDB = @COB_HAS_LMDB@ -COB_HAS_OCEXTFH = @COB_HAS_OCEXTFH@ -COB_HAS_OCI = @COB_HAS_OCI@ -COB_HAS_ODBC = @COB_HAS_ODBC@ -COB_HAS_VBISAM = @COB_HAS_VBISAM@ -COB_HAS_XML2 = @COB_HAS_XML2@ -COB_KEYWORD_INLINE = @COB_KEYWORD_INLINE@ -COB_LDFLAGS = @COB_LDFLAGS@ -COB_LIBRARY_PATH = @COB_LIBRARY_PATH@ -COB_LIBS = @COB_LIBS@ -COB_MODULE_EXT = @COB_MODULE_EXT@ -COB_OBJECT_EXT = @COB_OBJECT_EXT@ -COB_PATCH_LEVEL = @COB_PATCH_LEVEL@ -COB_PIC_FLAGS = @COB_PIC_FLAGS@ -COB_SCHEMA_DIR = @COB_SCHEMA_DIR@ -COB_SHARED_OPT = @COB_SHARED_OPT@ -CODE_COVERAGE_CFLAGS = @CODE_COVERAGE_CFLAGS@ -CODE_COVERAGE_CPPFLAGS = @CODE_COVERAGE_CPPFLAGS@ -CODE_COVERAGE_CXXFLAGS = @CODE_COVERAGE_CXXFLAGS@ -CODE_COVERAGE_ENABLED = @CODE_COVERAGE_ENABLED@ -CODE_COVERAGE_LDFLAGS = @CODE_COVERAGE_LDFLAGS@ -CODE_COVERAGE_LIBS = @CODE_COVERAGE_LIBS@ -CPP = @CPP@ -CPPFLAGS = @CPPFLAGS@ -CYGPATH_W = @CYGPATH_W@ -DEFS = @DEFS@ -DEPDIR = @DEPDIR@ -DIFF_FLAGS = @DIFF_FLAGS@ -DLLTOOL = @DLLTOOL@ -DSYMUTIL = @DSYMUTIL@ -DUMPBIN = @DUMPBIN@ -ECHO_C = @ECHO_C@ -ECHO_N = @ECHO_N@ -ECHO_T = @ECHO_T@ -EGREP = @EGREP@ -EXEEXT = @EXEEXT@ -FGREP = @FGREP@ -GCOV = @GCOV@ -GENHTML = @GENHTML@ -GETTEXT_MACRO_VERSION = @GETTEXT_MACRO_VERSION@ -GMSGFMT = @GMSGFMT@ -GMSGFMT_015 = @GMSGFMT_015@ -GREP = @GREP@ -HELP2MAN = @HELP2MAN@ -INSTALL = @INSTALL@ -INSTALL_DATA = @INSTALL_DATA@ -INSTALL_PROGRAM = @INSTALL_PROGRAM@ -INSTALL_SCRIPT = @INSTALL_SCRIPT@ -INSTALL_STRIP_PROGRAM = @INSTALL_STRIP_PROGRAM@ -INTLLIBS = @INTLLIBS@ -INTL_MACOSX_LIBS = @INTL_MACOSX_LIBS@ -LCOV = @LCOV@ -LD = @LD@ -LDFLAGS = @LDFLAGS@ -LEX = @LEX@ -LEXLIB = @LEXLIB@ -LEX_OUTPUT_ROOT = @LEX_OUTPUT_ROOT@ -LIBCOB_CISAM = @LIBCOB_CISAM@ -LIBCOB_CPPFLAGS = @LIBCOB_CPPFLAGS@ -LIBCOB_DISAM = @LIBCOB_DISAM@ -LIBCOB_LIBS = @LIBCOB_LIBS@ -LIBCOB_VBISAM = @LIBCOB_VBISAM@ -LIBICONV = @LIBICONV@ -LIBINTL = @LIBINTL@ -LIBOBJS = @LIBOBJS@ -LIBS = @LIBS@ -LIBTOOL = @LIBTOOL@ -LIPO = @LIPO@ -LN_S = @LN_S@ -LTLIBICONV = @LTLIBICONV@ -LTLIBINTL = @LTLIBINTL@ -LTLIBOBJS = @LTLIBOBJS@ -LT_SYS_LIBRARY_PATH = @LT_SYS_LIBRARY_PATH@ -MAKE = @MAKE@ -MAKEINFO = @MAKEINFO@ -MANIFEST_TOOL = @MANIFEST_TOOL@ -MKDIR_P = @MKDIR_P@ -MSGFMT = @MSGFMT@ -MSGFMT_015 = @MSGFMT_015@ -MSGMERGE = @MSGMERGE@ -NM = @NM@ -NMEDIT = @NMEDIT@ -OBJDUMP = @OBJDUMP@ -OBJEXT = @OBJEXT@ -ODBC_CFLAGS = @ODBC_CFLAGS@ -ODBC_LIBS = @ODBC_LIBS@ -OTOOL = @OTOOL@ -OTOOL64 = @OTOOL64@ -PACKAGE = @PACKAGE@ -PACKAGE_BUGREPORT = @PACKAGE_BUGREPORT@ -PACKAGE_NAME = @PACKAGE_NAME@ -PACKAGE_STRING = @PACKAGE_STRING@ -PACKAGE_TARNAME = @PACKAGE_TARNAME@ -PACKAGE_URL = @PACKAGE_URL@ -PACKAGE_VERSION = @PACKAGE_VERSION@ -PATH_SEPARATOR = @PATH_SEPARATOR@ -PKG_CONFIG = @PKG_CONFIG@ -PKG_CONFIG_LIBDIR = @PKG_CONFIG_LIBDIR@ -PKG_CONFIG_PATH = @PKG_CONFIG_PATH@ -POSUB = @POSUB@ -RANLIB = @RANLIB@ -SED = @SED@ -SET_MAKE = @SET_MAKE@ -SHELL = @SHELL@ -STRIP = @STRIP@ -USE_NLS = @USE_NLS@ -VERSION = @VERSION@ -XGETTEXT = @XGETTEXT@ -XGETTEXT_015 = @XGETTEXT_015@ -XGETTEXT_EXTRA_OPTIONS = @XGETTEXT_EXTRA_OPTIONS@ -XML2_CFLAGS = @XML2_CFLAGS@ -XML2_LIBS = @XML2_LIBS@ -YACC = @YACC@ -YFLAGS = @YFLAGS@ -abs_builddir = @abs_builddir@ -abs_srcdir = @abs_srcdir@ -abs_top_builddir = @abs_top_builddir@ -abs_top_srcdir = @abs_top_srcdir@ -ac_ct_AR = @ac_ct_AR@ -ac_ct_CC = @ac_ct_CC@ -ac_ct_DUMPBIN = @ac_ct_DUMPBIN@ -am__include = @am__include@ -am__leading_dot = @am__leading_dot@ -am__quote = @am__quote@ -am__tar = @am__tar@ -am__untar = @am__untar@ -bindir = @bindir@ -build = @build@ -build_alias = @build_alias@ -build_cpu = @build_cpu@ -build_os = @build_os@ -build_vendor = @build_vendor@ -builddir = @builddir@ -configured_make = @configured_make@ -datadir = @datadir@ -datarootdir = @datarootdir@ -docdir = @docdir@ -dvidir = @dvidir@ -exec_prefix = @exec_prefix@ -host = @host@ -host_alias = @host_alias@ -host_cpu = @host_cpu@ -host_os = @host_os@ -host_vendor = @host_vendor@ -htmldir = @htmldir@ -includedir = @includedir@ -infodir = @infodir@ -install_sh = @install_sh@ -libdir = @libdir@ -libexecdir = @libexecdir@ -localedir = @localedir@ -localstatedir = @localstatedir@ -mandir = @mandir@ -mkdir_p = @mkdir_p@ -oldincludedir = @oldincludedir@ -pdfdir = @pdfdir@ -prefix = @prefix@ -program_transform_name = @program_transform_name@ -psdir = @psdir@ -runstatedir = @runstatedir@ -sbindir = @sbindir@ -sharedstatedir = @sharedstatedir@ -srcdir = @srcdir@ -sysconfdir = @sysconfdir@ -target_alias = @target_alias@ -top_build_prefix = @top_build_prefix@ -top_builddir = @top_builddir@ -top_srcdir = @top_srcdir@ -xml2_config_found = @xml2_config_found@ -@COB_MAKE_CISAM_LIB_FALSE@lib_ci = -@COB_MAKE_CISAM_LIB_TRUE@lib_ci = libcobci.la -@COB_MAKE_CISAM_LIB_TRUE@libcobci_la_LIBADD = $(LIBCOB_CISAM) -@COB_MAKE_DISAM_LIB_FALSE@lib_di = -@COB_MAKE_DISAM_LIB_TRUE@lib_di = libcobdi.la -@COB_MAKE_DISAM_LIB_TRUE@libcobdi_la_LIBADD = $(LIBCOB_DISAM) -@COB_MAKE_VBISAM_LIB_FALSE@lib_vb = -@COB_MAKE_VBISAM_LIB_TRUE@lib_vb = libcobvb.la -@COB_MAKE_VBISAM_LIB_TRUE@libcobvb_la_LIBADD = $(LIBCOB_VBISAM) -lib_LTLIBRARIES = libcob.la $(lib_ci) $(lib_di) $(lib_vb) -libcob_la_SOURCES = common.c move.c numeric.c strings.c \ - fileio.c fextfh.c fisam.c fbdb.c focextfh.c flmdb.c fodbc.c foci.c fsqlxfd.c \ - call.c intrinsic.c termio.c screenio.c reportio.c cobgetopt.c \ - mlio.c - -@LOCAL_CJSON_TRUE@nodist_libcob_la_SOURCES = cJSON.c -@LOCAL_CJSON_TRUE@DISTCLEANFILES = cJSON.c cJSON.h - -#ToDo Man Page -#dist_man_MANS = libcob.3 -#COBCRUN = cobcrun$(EXEEXT) -AM_CPPFLAGS = -I$(top_srcdir) $(LIBCOB_CPPFLAGS) -AM_CFLAGS = $(CODE_COVERAGE_CFLAGS) -libcob_la_LIBADD = $(LIBCOB_LIBS) $(CODE_COVERAGE_LIBS) -libcob_la_LDFLAGS = $(COB_FIX_LIBTOOL) -version-info 5:0:0 -no-undefined -AM_LDFLAGS = $(COB_FIX_LIB) -EXTRA_DIST = coblocal.h system.def sysdefines.h fileio.h -pkginclude_HEADERS = common.h cobgetopt.h exception.def -CODE_COVERAGE_BRANCH_COVERAGE = 1 -CODE_COVERAGE_LCOV_OPTIONS = --no-external -all: all-am - -.SUFFIXES: -.SUFFIXES: .c .lo .o .obj -$(srcdir)/Makefile.in: $(srcdir)/Makefile.am $(am__configure_deps) - @for dep in $?; do \ - case '$(am__configure_deps)' in \ - *$$dep*) \ - ( cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh ) \ - && { if test -f $@; then exit 0; else break; fi; }; \ - exit 1;; \ - esac; \ - done; \ - echo ' cd $(top_srcdir) && $(AUTOMAKE) --gnu libcob/Makefile'; \ - $(am__cd) $(top_srcdir) && \ - $(AUTOMAKE) --gnu libcob/Makefile -Makefile: $(srcdir)/Makefile.in $(top_builddir)/config.status - @case '$?' in \ - *config.status*) \ - cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh;; \ - *) \ - echo ' cd $(top_builddir) && $(SHELL) ./config.status $(subdir)/$@ $(am__depfiles_maybe)'; \ - cd $(top_builddir) && $(SHELL) ./config.status $(subdir)/$@ $(am__depfiles_maybe);; \ - esac; - -$(top_builddir)/config.status: $(top_srcdir)/configure $(CONFIG_STATUS_DEPENDENCIES) - cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh - -$(top_srcdir)/configure: $(am__configure_deps) - cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh -$(ACLOCAL_M4): $(am__aclocal_m4_deps) - cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh -$(am__aclocal_m4_deps): - -install-libLTLIBRARIES: $(lib_LTLIBRARIES) - @$(NORMAL_INSTALL) - @list='$(lib_LTLIBRARIES)'; test -n "$(libdir)" || list=; \ - list2=; for p in $$list; do \ - if test -f $$p; then \ - list2="$$list2 $$p"; \ - else :; fi; \ - done; \ - test -z "$$list2" || { \ - echo " $(MKDIR_P) '$(DESTDIR)$(libdir)'"; \ - $(MKDIR_P) "$(DESTDIR)$(libdir)" || exit 1; \ - echo " $(LIBTOOL) $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=install $(INSTALL) $(INSTALL_STRIP_FLAG) $$list2 '$(DESTDIR)$(libdir)'"; \ - $(LIBTOOL) $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=install $(INSTALL) $(INSTALL_STRIP_FLAG) $$list2 "$(DESTDIR)$(libdir)"; \ - } - -uninstall-libLTLIBRARIES: - @$(NORMAL_UNINSTALL) - @list='$(lib_LTLIBRARIES)'; test -n "$(libdir)" || list=; \ - for p in $$list; do \ - $(am__strip_dir) \ - echo " $(LIBTOOL) $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=uninstall rm -f '$(DESTDIR)$(libdir)/$$f'"; \ - $(LIBTOOL) $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=uninstall rm -f "$(DESTDIR)$(libdir)/$$f"; \ - done - -clean-libLTLIBRARIES: - -test -z "$(lib_LTLIBRARIES)" || rm -f $(lib_LTLIBRARIES) - @list='$(lib_LTLIBRARIES)'; \ - locs=`for p in $$list; do echo $$p; done | \ - sed 's|^[^/]*$$|.|; s|/[^/]*$$||; s|$$|/so_locations|' | \ - sort -u`; \ - test -z "$$locs" || { \ - echo rm -f $${locs}; \ - rm -f $${locs}; \ - } - -libcob.la: $(libcob_la_OBJECTS) $(libcob_la_DEPENDENCIES) $(EXTRA_libcob_la_DEPENDENCIES) - $(AM_V_CCLD)$(libcob_la_LINK) -rpath $(libdir) $(libcob_la_OBJECTS) $(libcob_la_LIBADD) $(LIBS) - -libcobci.la: $(libcobci_la_OBJECTS) $(libcobci_la_DEPENDENCIES) $(EXTRA_libcobci_la_DEPENDENCIES) - $(AM_V_CCLD)$(LINK) $(am_libcobci_la_rpath) $(libcobci_la_OBJECTS) $(libcobci_la_LIBADD) $(LIBS) - -libcobdi.la: $(libcobdi_la_OBJECTS) $(libcobdi_la_DEPENDENCIES) $(EXTRA_libcobdi_la_DEPENDENCIES) - $(AM_V_CCLD)$(LINK) $(am_libcobdi_la_rpath) $(libcobdi_la_OBJECTS) $(libcobdi_la_LIBADD) $(LIBS) - -libcobvb.la: $(libcobvb_la_OBJECTS) $(libcobvb_la_DEPENDENCIES) $(EXTRA_libcobvb_la_DEPENDENCIES) - $(AM_V_CCLD)$(LINK) $(am_libcobvb_la_rpath) $(libcobvb_la_OBJECTS) $(libcobvb_la_LIBADD) $(LIBS) - -mostlyclean-compile: - -rm -f *.$(OBJEXT) - -distclean-compile: - -rm -f *.tab.c - -@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/cJSON.Plo@am__quote@ -@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/call.Plo@am__quote@ -@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/cobgetopt.Plo@am__quote@ -@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/common.Plo@am__quote@ -@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/fbdb.Plo@am__quote@ -@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/fextfh.Plo@am__quote@ -@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/fileio.Plo@am__quote@ -@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/fisam.Plo@am__quote@ -@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/flmdb.Plo@am__quote@ -@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/focextfh.Plo@am__quote@ -@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/foci.Plo@am__quote@ -@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/fodbc.Plo@am__quote@ -@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/fsqlxfd.Plo@am__quote@ -@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/intrinsic.Plo@am__quote@ -@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/libcobci.Plo@am__quote@ -@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/libcobdi.Plo@am__quote@ -@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/libcobvb.Plo@am__quote@ -@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/mlio.Plo@am__quote@ -@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/move.Plo@am__quote@ -@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/numeric.Plo@am__quote@ -@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/reportio.Plo@am__quote@ -@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/screenio.Plo@am__quote@ -@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/strings.Plo@am__quote@ -@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/termio.Plo@am__quote@ - -.c.o: -@am__fastdepCC_TRUE@ $(AM_V_CC)$(COMPILE) -MT $@ -MD -MP -MF $(DEPDIR)/$*.Tpo -c -o $@ $< -@am__fastdepCC_TRUE@ $(AM_V_at)$(am__mv) $(DEPDIR)/$*.Tpo $(DEPDIR)/$*.Po -@AMDEP_TRUE@@am__fastdepCC_FALSE@ $(AM_V_CC)source='$<' object='$@' libtool=no @AMDEPBACKSLASH@ -@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ -@am__fastdepCC_FALSE@ $(AM_V_CC@am__nodep@)$(COMPILE) -c -o $@ $< - -.c.obj: -@am__fastdepCC_TRUE@ $(AM_V_CC)$(COMPILE) -MT $@ -MD -MP -MF $(DEPDIR)/$*.Tpo -c -o $@ `$(CYGPATH_W) '$<'` -@am__fastdepCC_TRUE@ $(AM_V_at)$(am__mv) $(DEPDIR)/$*.Tpo $(DEPDIR)/$*.Po -@AMDEP_TRUE@@am__fastdepCC_FALSE@ $(AM_V_CC)source='$<' object='$@' libtool=no @AMDEPBACKSLASH@ -@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ -@am__fastdepCC_FALSE@ $(AM_V_CC@am__nodep@)$(COMPILE) -c -o $@ `$(CYGPATH_W) '$<'` - -.c.lo: -@am__fastdepCC_TRUE@ $(AM_V_CC)$(LTCOMPILE) -MT $@ -MD -MP -MF $(DEPDIR)/$*.Tpo -c -o $@ $< -@am__fastdepCC_TRUE@ $(AM_V_at)$(am__mv) $(DEPDIR)/$*.Tpo $(DEPDIR)/$*.Plo -@AMDEP_TRUE@@am__fastdepCC_FALSE@ $(AM_V_CC)source='$<' object='$@' libtool=yes @AMDEPBACKSLASH@ -@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ -@am__fastdepCC_FALSE@ $(AM_V_CC@am__nodep@)$(LTCOMPILE) -c -o $@ $< - -mostlyclean-libtool: - -rm -f *.lo - -clean-libtool: - -rm -rf .libs _libs -install-pkgincludeHEADERS: $(pkginclude_HEADERS) - @$(NORMAL_INSTALL) - @list='$(pkginclude_HEADERS)'; test -n "$(pkgincludedir)" || list=; \ - if test -n "$$list"; then \ - echo " $(MKDIR_P) '$(DESTDIR)$(pkgincludedir)'"; \ - $(MKDIR_P) "$(DESTDIR)$(pkgincludedir)" || exit 1; \ - fi; \ - for p in $$list; do \ - if test -f "$$p"; then d=; else d="$(srcdir)/"; fi; \ - echo "$$d$$p"; \ - done | $(am__base_list) | \ - while read files; do \ - echo " $(INSTALL_HEADER) $$files '$(DESTDIR)$(pkgincludedir)'"; \ - $(INSTALL_HEADER) $$files "$(DESTDIR)$(pkgincludedir)" || exit $$?; \ - done - -uninstall-pkgincludeHEADERS: - @$(NORMAL_UNINSTALL) - @list='$(pkginclude_HEADERS)'; test -n "$(pkgincludedir)" || list=; \ - files=`for p in $$list; do echo $$p; done | sed -e 's|^.*/||'`; \ - dir='$(DESTDIR)$(pkgincludedir)'; $(am__uninstall_files_from_dir) - -ID: $(am__tagged_files) - $(am__define_uniq_tagged_files); mkid -fID $$unique -tags: tags-am -TAGS: tags - -tags-am: $(TAGS_DEPENDENCIES) $(am__tagged_files) - set x; \ - here=`pwd`; \ - $(am__define_uniq_tagged_files); \ - shift; \ - if test -z "$(ETAGS_ARGS)$$*$$unique"; then :; else \ - test -n "$$unique" || unique=$$empty_fix; \ - if test $$# -gt 0; then \ - $(ETAGS) $(ETAGSFLAGS) $(AM_ETAGSFLAGS) $(ETAGS_ARGS) \ - "$$@" $$unique; \ - else \ - $(ETAGS) $(ETAGSFLAGS) $(AM_ETAGSFLAGS) $(ETAGS_ARGS) \ - $$unique; \ - fi; \ - fi -ctags: ctags-am - -CTAGS: ctags -ctags-am: $(TAGS_DEPENDENCIES) $(am__tagged_files) - $(am__define_uniq_tagged_files); \ - test -z "$(CTAGS_ARGS)$$unique" \ - || $(CTAGS) $(CTAGSFLAGS) $(AM_CTAGSFLAGS) $(CTAGS_ARGS) \ - $$unique - -GTAGS: - here=`$(am__cd) $(top_builddir) && pwd` \ - && $(am__cd) $(top_srcdir) \ - && gtags -i $(GTAGS_ARGS) "$$here" -cscopelist: cscopelist-am - -cscopelist-am: $(am__tagged_files) - list='$(am__tagged_files)'; \ - case "$(srcdir)" in \ - [\\/]* | ?:[\\/]*) sdir="$(srcdir)" ;; \ - *) sdir=$(subdir)/$(srcdir) ;; \ - esac; \ - for i in $$list; do \ - if test -f "$$i"; then \ - echo "$(subdir)/$$i"; \ - else \ - echo "$$sdir/$$i"; \ - fi; \ - done >> $(top_builddir)/cscope.files - -distclean-tags: - -rm -f TAGS ID GTAGS GRTAGS GSYMS GPATH tags - -distdir: $(DISTFILES) - @srcdirstrip=`echo "$(srcdir)" | sed 's/[].[^$$\\*]/\\\\&/g'`; \ - topsrcdirstrip=`echo "$(top_srcdir)" | sed 's/[].[^$$\\*]/\\\\&/g'`; \ - list='$(DISTFILES)'; \ - dist_files=`for file in $$list; do echo $$file; done | \ - sed -e "s|^$$srcdirstrip/||;t" \ - -e "s|^$$topsrcdirstrip/|$(top_builddir)/|;t"`; \ - case $$dist_files in \ - */*) $(MKDIR_P) `echo "$$dist_files" | \ - sed '/\//!d;s|^|$(distdir)/|;s,/[^/]*$$,,' | \ - sort -u` ;; \ - esac; \ - for file in $$dist_files; do \ - if test -f $$file || test -d $$file; then d=.; else d=$(srcdir); fi; \ - if test -d $$d/$$file; then \ - dir=`echo "/$$file" | sed -e 's,/[^/]*$$,,'`; \ - if test -d "$(distdir)/$$file"; then \ - find "$(distdir)/$$file" -type d ! -perm -700 -exec chmod u+rwx {} \;; \ - fi; \ - if test -d $(srcdir)/$$file && test $$d != $(srcdir); then \ - cp -fpR $(srcdir)/$$file "$(distdir)$$dir" || exit 1; \ - find "$(distdir)/$$file" -type d ! -perm -700 -exec chmod u+rwx {} \;; \ - fi; \ - cp -fpR $$d/$$file "$(distdir)$$dir" || exit 1; \ - else \ - test -f "$(distdir)/$$file" \ - || cp -p $$d/$$file "$(distdir)/$$file" \ - || exit 1; \ - fi; \ - done -check-am: all-am -check: check-am -all-am: Makefile $(LTLIBRARIES) $(HEADERS) -installdirs: - for dir in "$(DESTDIR)$(libdir)" "$(DESTDIR)$(pkgincludedir)"; do \ - test -z "$$dir" || $(MKDIR_P) "$$dir"; \ - done -install: install-am -install-exec: install-exec-am -install-data: install-data-am -uninstall: uninstall-am - -install-am: all-am - @$(MAKE) $(AM_MAKEFLAGS) install-exec-am install-data-am - -installcheck: installcheck-am -install-strip: - if test -z '$(STRIP)'; then \ - $(MAKE) $(AM_MAKEFLAGS) INSTALL_PROGRAM="$(INSTALL_STRIP_PROGRAM)" \ - install_sh_PROGRAM="$(INSTALL_STRIP_PROGRAM)" INSTALL_STRIP_FLAG=-s \ - install; \ - else \ - $(MAKE) $(AM_MAKEFLAGS) INSTALL_PROGRAM="$(INSTALL_STRIP_PROGRAM)" \ - install_sh_PROGRAM="$(INSTALL_STRIP_PROGRAM)" INSTALL_STRIP_FLAG=-s \ - "INSTALL_PROGRAM_ENV=STRIPPROG='$(STRIP)'" install; \ - fi -mostlyclean-generic: - -clean-generic: - -distclean-generic: - -test -z "$(CONFIG_CLEAN_FILES)" || rm -f $(CONFIG_CLEAN_FILES) - -test . = "$(srcdir)" || test -z "$(CONFIG_CLEAN_VPATH_FILES)" || rm -f $(CONFIG_CLEAN_VPATH_FILES) - -test -z "$(DISTCLEANFILES)" || rm -f $(DISTCLEANFILES) - -maintainer-clean-generic: - @echo "This command is intended for maintainers to use" - @echo "it deletes files that may require special tools to rebuild." -clean: clean-am - -clean-am: clean-generic clean-libLTLIBRARIES clean-libtool \ - mostlyclean-am - -distclean: distclean-am - -rm -rf ./$(DEPDIR) - -rm -f Makefile -distclean-am: clean-am distclean-compile distclean-generic \ - distclean-tags - -dvi: dvi-am - -dvi-am: - -html: html-am - -html-am: - -info: info-am - -info-am: - -install-data-am: install-pkgincludeHEADERS - @$(NORMAL_INSTALL) - $(MAKE) $(AM_MAKEFLAGS) install-data-hook -install-dvi: install-dvi-am - -install-dvi-am: - -install-exec-am: install-libLTLIBRARIES - -install-html: install-html-am - -install-html-am: - -install-info: install-info-am - -install-info-am: - -install-man: - -install-pdf: install-pdf-am - -install-pdf-am: - -install-ps: install-ps-am - -install-ps-am: - -installcheck-am: - -maintainer-clean: maintainer-clean-am - -rm -rf ./$(DEPDIR) - -rm -f Makefile -maintainer-clean-am: distclean-am maintainer-clean-generic - -mostlyclean: mostlyclean-am - -mostlyclean-am: mostlyclean-compile mostlyclean-generic \ - mostlyclean-libtool - -pdf: pdf-am - -pdf-am: - -ps: ps-am - -ps-am: - -uninstall-am: uninstall-libLTLIBRARIES uninstall-pkgincludeHEADERS - -.MAKE: install-am install-data-am install-strip - -.PHONY: CTAGS GTAGS TAGS all all-am check check-am clean clean-generic \ - clean-libLTLIBRARIES clean-libtool cscopelist-am ctags \ - ctags-am distclean distclean-compile distclean-generic \ - distclean-libtool distclean-tags distdir dvi dvi-am html \ - html-am info info-am install install-am install-data \ - install-data-am install-data-hook install-dvi install-dvi-am \ - install-exec install-exec-am install-html install-html-am \ - install-info install-info-am install-libLTLIBRARIES \ - install-man install-pdf install-pdf-am \ - install-pkgincludeHEADERS install-ps install-ps-am \ - install-strip installcheck installcheck-am installdirs \ - maintainer-clean maintainer-clean-generic mostlyclean \ - mostlyclean-compile mostlyclean-generic mostlyclean-libtool \ - pdf pdf-am ps ps-am tags tags-am uninstall uninstall-am \ - uninstall-libLTLIBRARIES uninstall-pkgincludeHEADERS - -.PRECIOUS: Makefile - - -# Add rules for code-coverage testing, as provided by AX_CODE_COVERAGE -@CODE_COVERAGE_RULES@ - -#HELPSOURCES = $(top_srcdir)/bin/cobcrun.c $(top_srcdir)/configure.ac -#HELP2MAN_OPTS = --info-page=$(PACKAGE) -specialflag -#if MAKE_HAS_PREREQ_ONLY -#libcob.3: $(HELPSOURCES) | $(COBCRUN) -# "$(top_builddir)/pre-inst-env" $(HELP2MAN) --output=$@ $(HELP2MAN_OPTS) $(COBCRUN) -#else -#libcob.3: $(HELPSOURCES) -# "$(top_builddir)/pre-inst-env" $(HELP2MAN) --output=$@ $(HELP2MAN_OPTS) $(COBCRUN) -#endif - -install-data-hook: - rm -f $(DESTDIR)$(includedir)/libcob/byteswap.h - rm -f $(DESTDIR)$(includedir)/libcob/call.h - rm -f $(DESTDIR)$(includedir)/libcob/fileio.h - rm -f $(DESTDIR)$(includedir)/libcob/termio.h - rm -f $(DESTDIR)$(includedir)/libcob/screenio.h - rm -f $(DESTDIR)$(includedir)/libcob/move.h - rm -f $(DESTDIR)$(includedir)/libcob/numeric.h - rm -f $(DESTDIR)$(includedir)/libcob/strings.h - rm -f $(DESTDIR)$(includedir)/libcob/intrinsic.h - rm -f $(DESTDIR)$(includedir)/libcob/codegen.h - rm -f $(DESTDIR)$(includedir)/libcob/system.def - -# Tell versions [3.59,3.63) of GNU make to not export all variables. -# Otherwise a system limit (for SysV at least) may be exceeded. -.NOEXPORT: diff -Nru gnucobol-4.0~early~20200606/libcob/mlio.c gnucobol-5/libcob/mlio.c --- gnucobol-4.0~early~20200606/libcob/mlio.c 2020-06-06 20:52:01.000000000 +0000 +++ gnucobol-5/libcob/mlio.c 1970-01-01 00:00:00.000000000 +0000 @@ -1,932 +0,0 @@ -/* - Copyright (C) 2018-2019 Free Software Foundation, Inc. - Written by Edward Hart, Simon Sobisch - - This file is part of GnuCOBOL. - - The GnuCOBOL runtime library is free software: you can redistribute it - and/or modify it under the terms of the GNU Lesser General Public License - as published by the Free Software Foundation, either version 3 of the - License, or (at your option) any later version. - - GnuCOBOL is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU Lesser General Public License for more details. - - You should have received a copy of the GNU Lesser General Public License - along with GnuCOBOL. If not, see . -*/ - - -#include - -#include -#include -#include -#include - -/* Force symbol exports */ -#define COB_LIB_EXPIMP -#include "libcob.h" -#include "coblocal.h" - -/* note: checked library instead of headers as those may not be usable! */ -#ifdef WITH_XML2 -#if !defined (HAVE_LIBXML_XMLVERSION_H) || \ - !defined (HAVE_LIBXML_XMLWRITER_H) || \ - !defined (HAVE_LIBXML_URI_H) -#error XML2 without necessary headers -#endif -#include -#include -#include -#endif - -#ifdef WITH_CJSON -#if defined HAVE_CJSON_CJSON_H -#include -#elif defined HAVE_CJSON_H -#include -#else -#error CJSON without necessary header -#endif -#endif - - -/* Local variables */ - -/* de facto standard error codes */ -enum xml_code_status { - XML_OUT_FIELD_TOO_SMALL = 400, - XML_INVALID_NAMESPACE = 416, - XML_INVALID_CHAR_REPLACED = 417, - XML_INVALID_NAMESPACE_PREFIX = 419, - XML_INTERNAL_ERROR = 600 -}; - -enum json_code_status { - JSON_OUT_FIELD_TOO_SMALL = 1, - JSON_INTERNAL_ERROR = 500 -}; - - -static cob_global *cobglobptr; - -/* Local functions */ - -#if WITH_XML2 || WITH_CJSON - -static void * -get_trimmed_data (const cob_field * const f, void * (*strndup_func)(const char *, size_t)) -{ - char *str = (char *) f->data; - size_t len = f->size; - - /* Trim leading/trailing spaces. If f is all spaces, leave one space. */ - if (COB_FIELD_JUSTIFIED (f)) { - for (; *str == ' ' && len > 1; ++str, --len); - } else { - for (; str[len - 1] == ' ' && len > 1; --len); - } - - return (*strndup_func)(str, len); -} - -static cob_pic_symbol * -get_pic_for_num_field (const size_t num_int_digits, const size_t num_dec_digits) -{ - size_t num_pic_symbols = (size_t)2 + (2 * !!num_dec_digits) + 1; - cob_pic_symbol *pic = cob_malloc (num_pic_symbols * sizeof (cob_pic_symbol)); - cob_pic_symbol *symbol = pic; - - symbol->symbol = '-'; - symbol->times_repeated = cob_max_int ((int) num_int_digits, 1); - ++symbol; - - symbol->symbol = '9'; - symbol->times_repeated = 1; - ++symbol; - - if (num_dec_digits) { - symbol->symbol = COB_MODULE_PTR->decimal_point; - symbol->times_repeated = 1; - ++symbol; - - symbol->symbol = '9'; - symbol->times_repeated = (int) num_dec_digits; - ++symbol; - } - - symbol->symbol = '\0'; - - return pic; -} - -static void * -get_num (cob_field * const f, void * (*strndup_func)(const char *, size_t)) -{ - size_t num_integer_digits - = cob_max_int (0, COB_FIELD_DIGITS (f) - COB_FIELD_SCALE (f)); - size_t num_decimal_digits - = cob_max_int (0, COB_FIELD_SCALE (f)); - cob_field_attr attr; - cob_field edited_field; - void *num; - - /* Initialize field attribute */ - attr.type = COB_TYPE_NUMERIC_EDITED; - attr.flags = COB_FLAG_JUSTIFIED; - attr.scale = COB_FIELD_SCALE (f); - attr.digits = COB_FIELD_DIGITS (f); - attr.pic = get_pic_for_num_field (num_integer_digits, - num_decimal_digits); - - /* Initialize field */ - edited_field.attr = &attr; - edited_field.size = cob_max_int (2, (int) num_integer_digits + 1); - if (num_decimal_digits) { - edited_field.size += 1 + num_decimal_digits; - } - edited_field.data = cob_malloc (edited_field.size); - - cob_move (f, &edited_field); - num = get_trimmed_data (&edited_field, strndup_func); - - cob_free (edited_field.data); - cob_free ((void *) edited_field.attr->pic); - - return num; - -} -#endif - -#if WITH_XML2 - -static void -set_xml_code (const unsigned int code) -{ - /* if the COBOL module never checks the code it isn't generated, - this also makes clear that we don't need to (and can't) set it */ - if (!COB_MODULE_PTR->xml_code) { - return; - } - cob_set_field_to_uint (COB_MODULE_PTR->xml_code, code); -} - -static int -is_all_spaces (const cob_field * const f) -{ - size_t i; - - for (i = 0; i < f->size; ++i) { - if (f->data[i] != ' ') { - return 0; - } - } - - return 1; -} - -static void * -xmlCharStrndup_void (const char *str, const size_t size) -{ - return (void *)xmlCharStrndup (str, size); -} - -static xmlChar * -get_trimmed_xml_data (const cob_field * const f) -{ - return (xmlChar *) get_trimmed_data (f, &xmlCharStrndup_void); -} - -/* Returns 1 if str contains invalid XML 1.0 chars, 0 otherwise. */ -static int -has_invalid_xml_char (const cob_field * const f) -{ - size_t i; - - /* Char ::= #x9 | #xA | #xD | [#x20-#xD7FF] | [#xE000-#xFFFD] | [#x10000-#x10FFFF] */ - /* TO-DO: This assumes the data is already in UTF-8! */ - for (i = 0; i < f->size; ++i) { - if (iscntrl (f->data[i]) - && f->data[i] != 0x09 - && f->data[i] != 0x0a - && f->data[i] != 0x0d) { - return 1; - } - } - - /* TO-DO: 2/3/4-byte characters. Will this need libicu? */ - - return 0; -} - -static int -is_valid_xml_name (const cob_field * const f) -{ - xmlChar *str; - xmlChar *c; - int ret; - - str = get_trimmed_xml_data (f); - - if (!cob_is_xml_namestartchar (f->data[0])) { - ret = 0; - goto end; - } - - for (c = str + 1; *c; ++c) { - if (!cob_is_xml_namechar (*c)) { - ret = 0; - goto end; - } - } - - ret = 1; - - end: - xmlFree (str); - return ret; -} - -static xmlChar * -get_xml_name (const cob_field * const f) -{ - xmlChar *name; - xmlChar *underscore; - xmlChar *name_with_underscore; - - name = get_trimmed_xml_data (f); - - if (name && !cob_is_xml_namestartchar (name[0])) { - underscore = xmlCharStrdup ("_"); - if (underscore) { - name_with_underscore = xmlStrcat (underscore, name); - } else { - name_with_underscore = NULL; - } - - xmlFree (name); - return name_with_underscore; - } else { - return name; - } -} - -#define IF_NEG_RETURN_ELSE_COUNT(func) \ - do { \ - int macro_status = (func); \ - if (macro_status < 0) { \ - return macro_status; \ - } else { \ - *count += macro_status; \ - } \ - } ONCE_COB - -static int -generate_xml_from_tree (xmlTextWriterPtr, cob_ml_tree *, xmlChar *, xmlChar *, - unsigned int *); - -static xmlChar * -get_name_with_hex_prefix (const cob_field * const name) -{ - xmlChar *hex_str; - xmlChar *x_name; - xmlChar *hex_name; - - /* - NB: hex_str must be allocated every time because xmlStrcat will - realloc hex_str. - */ - hex_str = xmlCharStrdup ("hex."); - - x_name = get_xml_name (name); - hex_name = xmlStrcat (hex_str, x_name); - xmlFree (x_name); - - return hex_name; -} - -static char -int_to_hex (const int n) -{ - if (n < 10) { - return '0' + n; - } else { - return 'a' + (n - 10); - } -} - -static xmlChar * -get_hex_xml_data (const cob_field * const f) -{ - xmlBufferPtr buff; - size_t i; - char hex_num[3] = { '\0' }; - xmlChar *hex_data; - - buff = xmlBufferCreate (); - if (!buff) { - return NULL; - } - - for (i = 0; i < f->size; ++i) { - hex_num[0] = int_to_hex (f->data[i] / 16); - hex_num[1] = int_to_hex (f->data[i] % 16); - xmlBufferWriteChar (buff, hex_num); - } - - hex_data = xmlStrdup (xmlBufferContent (buff)); - xmlBufferFree (buff); - - return hex_data; -} - -static int -generate_hex_attribute (xmlTextWriterPtr writer, cob_ml_attr *attr, unsigned int *count) -{ - xmlChar *hex_name; - xmlChar *value; - - hex_name = get_name_with_hex_prefix (attr->name); - value = get_hex_xml_data (attr->value); - IF_NEG_RETURN_ELSE_COUNT (xmlTextWriterWriteAttribute (writer, hex_name, value)); - xmlFree (hex_name); - xmlFree (value); - - return 0; -} - -static int -generate_normal_attribute (xmlTextWriterPtr writer, cob_ml_attr *attr, unsigned int *count) -{ - xmlChar *name; - xmlChar *value; - - name = get_xml_name (attr->name); - value = get_trimmed_xml_data (attr->value); - IF_NEG_RETURN_ELSE_COUNT (xmlTextWriterWriteAttribute (writer, name, value)); - xmlFree (name); - xmlFree (value); - - return 0; -} - -static int -generate_attributes (xmlTextWriterPtr writer, cob_ml_attr *attr, unsigned int *count) -{ - int status; - - for (; attr; attr = attr->sibling) { - if (attr->is_suppressed) { - continue; - } - - if (has_invalid_xml_char (attr->value)) { - set_xml_code (XML_INVALID_CHAR_REPLACED); - status = generate_hex_attribute (writer, attr, count); - } else { - status = generate_normal_attribute (writer, attr, count); - } - - if (status < 0) { - return status; - } - } - - return 0; -} - -static int -generate_hex_element (xmlTextWriterPtr writer, cob_ml_tree *tree, - xmlChar *x_ns, xmlChar *x_ns_prefix, unsigned int *count) -{ - xmlChar *hex_name; - int status; - xmlChar *hex_value; - - hex_name = get_name_with_hex_prefix (tree->name); - IF_NEG_RETURN_ELSE_COUNT (xmlTextWriterStartElementNS (writer, x_ns_prefix, - hex_name, x_ns)); - xmlFree (hex_name); - - status = generate_attributes (writer, tree->attrs, count); - if (status < 0) { - return status; - } - - hex_value = get_hex_xml_data (tree->content); - IF_NEG_RETURN_ELSE_COUNT (xmlTextWriterWriteString (writer, hex_value)); - xmlFree (hex_value); - - IF_NEG_RETURN_ELSE_COUNT (xmlTextWriterEndElement (writer)); - - return 0; -} - - -static xmlChar * -get_xml_num (cob_field * const f) -{ - return get_num (f, &xmlCharStrndup_void); -} - -static int -generate_content (xmlTextWriterPtr writer, cob_ml_tree *tree, unsigned int *count) -{ - cob_field *content = tree->content; - xmlChar *x_content; - - if (COB_FIELD_IS_FP (content)) { - /* TO-DO: Implement! */ - /* TO-DO: Stop compilation if float in field */ - cob_set_exception (COB_EC_IMP_FEATURE_MISSING); - cob_fatal_error (COB_FERROR_XML); - } else if (COB_FIELD_IS_NUMERIC (content)) { - x_content = get_xml_num (content); - } else { - x_content = get_trimmed_xml_data (content); - } - - IF_NEG_RETURN_ELSE_COUNT (xmlTextWriterWriteString (writer, x_content)); - xmlFree (x_content); - - return 0; -} - - -static int -generate_normal_element (xmlTextWriterPtr writer, cob_ml_tree *tree, - xmlChar *x_ns, xmlChar *x_ns_prefix, unsigned int *count) -{ - int status; - xmlChar *x_name; - cob_ml_tree *child; - - /* Start element */ - x_name = get_xml_name (tree->name); - IF_NEG_RETURN_ELSE_COUNT (xmlTextWriterStartElementNS (writer, x_ns_prefix, - x_name, x_ns)); - xmlFree (x_name); - - status = generate_attributes (writer, tree->attrs, count); - if (status < 0) { - return status; - } - - /* Output child elements or content. */ - if (tree->children) { - for (child = tree->children; child; child = child->sibling) { - /* - Note we only have a namespace attribute on the - outermost element. - */ - status = generate_xml_from_tree (writer, child, NULL, - x_ns_prefix, count); - if (status < 0) { - return status; - } - } - } else if (tree->content) { - status = generate_content (writer, tree, count); - if (status < 0) { - return status; - } - } - - /* Complete element */ - IF_NEG_RETURN_ELSE_COUNT (xmlTextWriterEndElement (writer)); - - return 0; -} - -static int -generate_element (xmlTextWriterPtr writer, cob_ml_tree *tree, - xmlChar *x_ns, xmlChar *x_ns_prefix, unsigned int *count) -{ - /* Check for invalid characters. */ - if (tree->content - && !COB_FIELD_IS_NUMERIC (tree->content) - && has_invalid_xml_char (tree->content)) { - set_xml_code (XML_INVALID_CHAR_REPLACED); - return generate_hex_element (writer, tree, x_ns, x_ns_prefix, - count); - } else { - return generate_normal_element (writer, tree, x_ns, - x_ns_prefix, count); - } -} - -static int -generate_xml_from_tree (xmlTextWriterPtr writer, cob_ml_tree *tree, - xmlChar *ns, xmlChar *ns_prefix, unsigned int *count) -{ - if (tree->is_suppressed) { - return 0; - } - - if (tree->name) { - return generate_element (writer, tree, ns, ns_prefix, count); - } else { - return generate_content (writer, tree, count); - } -} - -#undef IF_NEG_RETURN_ELSE_COUNT - -static void -set_xml_exception (const unsigned int code) -{ - cob_set_exception (COB_EC_XML_IMP); - set_xml_code (code); -} - -#endif - -#if WITH_CJSON - -static void -set_json_code (const unsigned int code) -{ - /* if the COBOL module never checks the code it isn't generated, - this also makes clear that we don't need to (and can't) set it */ - if (!COB_MODULE_PTR->json_code) { - return; - } - cob_set_field_to_uint (COB_MODULE_PTR->json_code, code); -} - -static void -set_json_exception (const unsigned int code) -{ - cob_set_exception (COB_EC_JSON_IMP); - set_json_code (code); -} - -static void * -json_strndup (const char *str, const size_t size) -{ - char *dup = cob_malloc (size + 1); - memcpy (dup, str, size); - return dup; -} - -static char * -get_trimmed_json_data (const cob_field * const f) -{ - return (char *) get_trimmed_data (f, &json_strndup); -} - -static char * -get_json_num (cob_field * const f) -{ - return (char *) get_num (f, &json_strndup); -} - -static int -generate_json_from_tree (cob_ml_tree *tree, cJSON *out) -{ - cob_ml_tree *child; - cJSON *children_json = NULL; - char *name = NULL; - char *content = NULL; - int status = 0; - - if (tree->is_suppressed) { - return 0; - } - - name = get_trimmed_json_data (tree->name); - if (tree->children) { - children_json = cJSON_CreateObject (); - for (child = tree->children; child; child = child->sibling) { - status = generate_json_from_tree (child, children_json); - if (status < 0) { - cJSON_Delete (children_json); - goto end; - } - } - cJSON_AddItemToObject (out, name, children_json); - } else if (tree->content) { - if (COB_FIELD_IS_FP (tree->content)) { - /* TO-DO: Implement! */ - /* TO-DO: Stop compilation if float in field */ - cob_set_exception (COB_EC_IMP_FEATURE_MISSING); - cob_fatal_error (COB_FERROR_JSON); - } else if (COB_FIELD_IS_NUMERIC (tree->content)) { - content = get_json_num (tree->content); - /* - We use AddRaw instead of AddNumber because a PIC 9(32) - may not be representable using the double AddNumber - uses internally. - */ - if (!cJSON_AddRawToObject (out, name, content)) { - status = -1; - goto end; - } - } else { - content = (char *) get_trimmed_json_data (tree->content); - if (!cJSON_AddStringToObject (out, name, content)) { - status = -1; - goto end; - } - } - } - - end: - if (content) { - cob_free (content); - } - if (name) { - cob_free (name); - } - return status; -} - -#endif - -/* Global functions */ - -int -cob_is_xml_namestartchar (const int c) -{ - /* - From XML 1.0 spec (https://www.w3.org/TR/xml/): - [4] NameStartChar ::= ":" | [A-Z] | "_" | [a-z] | [#xC0-#xD6] - | [#xD8-#xF6] | [#xF8-#x2FF] - | [#x370-#x37D] | [#x37F-#x1FFF] - | [#x200C-#x200D] | [#x2070-#x218F] - | [#x2C00-#x2FEF] | [#x3001-#xD7FF] - | [#xF900-#xFDCF] | [#xFDF0-#xFFFD] - | [#x10000-#xEFFFF] - [4a] NameChar ::= NameStartChar | "-" | "." | [0-9] | #xB7 - | [#x0300-#x036F] | [#x203F-#x2040] - */ - /* TO-DO: Deal with 2/3/4-byte chars. */ - return isalpha(c) || c == '_' - || (c >= 0xc0 && c <= 0xd6) - || (c >= 0xd8 && c <= 0xf6) - || (c >= 0xf8); -} - -int -cob_is_xml_namechar (const int c) -{ - /* TO-DO: Deal with 2/3/4-byte chars. */ - return cob_is_xml_namestartchar (c) || c == '-' || c == '.' || isdigit (c) - || c == 0xb7; -} - -/* - check if string is a valid URI - URI = scheme:[//authority]path[?query][#fragment] -*/ -int -cob_is_valid_uri (const char *str) -{ -#if WITH_XML2 - int is_valid; - xmlURIPtr p; - - p = xmlParseURI (str); - is_valid = !!p; - if (p) { - xmlFreeURI (p); - } - - return is_valid; -#else - /* scheme must start with lower-strase */ - if (!str || *str <= 'a' || *str >= 'z') return 0; - - /* scheme completes with ":" */ - str++; - while (*str && *str != ':') str++; - - /* check for "any scheme" with any path */ - if (*str == ':' && str[1]) return 1; - - return 0; -#endif -} - -#if WITH_XML2 - -void -cob_xml_generate (cob_field *out, cob_ml_tree *tree, cob_field *count, - const int with_xml_dec, cob_field *ns, cob_field *ns_prefix) -{ - xmlBufferPtr buff; - xmlTextWriterPtr writer = NULL; - int status; - unsigned int chars_written = 0; - xmlChar *x_ns = NULL; - xmlChar *x_ns_prefix = NULL; - int buff_len; - int copy_len; - int num_newlines = 0; - - set_xml_code (0); - - buff = xmlBufferCreate (); - if (buff == NULL) { - set_xml_exception (XML_INTERNAL_ERROR); - goto end; - } - - writer = xmlNewTextWriterMemory (buff, 0); - if (writer == NULL) { - goto end; - } - - if (with_xml_dec) { - /* TO-DO: Support encoding */ - status = xmlTextWriterStartDocument (writer, NULL, NULL, NULL); - if (status < 0) { - set_xml_exception (XML_INTERNAL_ERROR); - goto end; - } else { - chars_written += status; - } - } - - if (ns) { - if (is_all_spaces (ns)) { - x_ns = NULL; - } else if (has_invalid_xml_char (ns)) { - set_xml_exception (XML_INVALID_NAMESPACE); - goto end; - } else { - x_ns = get_trimmed_xml_data (ns); - if (!cob_is_valid_uri ((const char *) x_ns)) { - set_xml_exception (XML_INVALID_NAMESPACE); - goto end; - } - } - } - - if (ns_prefix) { - if (is_all_spaces (ns_prefix)) { - x_ns_prefix = NULL; - } else if (!is_valid_xml_name (ns_prefix)) { - set_xml_exception (XML_INVALID_NAMESPACE_PREFIX); - goto end; - } else { - x_ns_prefix = get_trimmed_xml_data (ns_prefix); - } - } - - status = generate_xml_from_tree (writer, tree, x_ns, x_ns_prefix, - &chars_written); - if (status < 0) { - set_xml_exception (XML_INTERNAL_ERROR); - goto end; - } - - status = xmlTextWriterEndDocument (writer); - if (status < 0) { - set_xml_exception (XML_INTERNAL_ERROR); - goto end; - } else { - chars_written += status; - } - - /* Copy generated tree to output field */ - buff_len = xmlBufferLength (buff); - copy_len = cob_min_int (buff_len, (int) out->size); - memcpy (out->data, xmlBufferContent (buff), copy_len); - memset (out->data + copy_len, ' ', out->size - copy_len); - /* Remove trailing newlines */ - for (; copy_len > 0 && out->data[copy_len - 1] == '\n'; --copy_len) { - out->data[copy_len - 1] = ' '; - --chars_written; - ++num_newlines; - } - /* Raise exception if output field is too small */ - if (buff_len - num_newlines > copy_len) { - set_xml_exception (XML_OUT_FIELD_TOO_SMALL); - goto end; - } - - end: - if (x_ns) { - xmlFree (x_ns); - } - if (x_ns_prefix) { - xmlFree (x_ns_prefix); - } - if (writer) { - xmlFreeTextWriter (writer); - } - if (buff) { - xmlBufferFree (buff); - } - if (count) { - cob_add_int (count, chars_written, 0); - } -} - -#else /* !WITH_XML2 */ - -void -cob_xml_generate (cob_field *out, cob_ml_tree *tree, cob_field *count, - const int with_xml_dec, cob_field *ns, cob_field *ns_prefix) -{ - COB_UNUSED (out); - COB_UNUSED (tree); - COB_UNUSED (count); - COB_UNUSED (with_xml_dec); - COB_UNUSED (ns); - COB_UNUSED (ns_prefix); -} - -#endif - -#if WITH_CJSON - -void -cob_json_generate (cob_field *out, cob_ml_tree *tree, cob_field *count) -{ - cJSON *json; - int status = 0; - char *printed_json; - unsigned int print_len = 0; - unsigned int copy_len; - int num_newlines = 0; - - set_json_code (0); - - json = cJSON_CreateObject (); - if (!json) { - set_json_exception (JSON_INTERNAL_ERROR); - goto end; - } - - status = generate_json_from_tree (tree, json); - if (status < 0) { - set_json_exception (JSON_INTERNAL_ERROR); - goto end; - } - - /* TO-DO: Set cJSON to use cob_free in InitHook? */ - printed_json = cJSON_PrintUnformatted (json); - if (!printed_json) { - set_json_exception (JSON_INTERNAL_ERROR); - goto end; - } - - /* TO-DO: Duplication! */ - print_len = strlen (printed_json); - copy_len = cob_min_int (print_len, (int) out->size); - memcpy (out->data, printed_json, copy_len); - memset (out->data + copy_len, ' ', out->size - copy_len); - /* Remove trailing newlines */ - for (; copy_len > 0 && out->data[copy_len - 1] == '\n'; --copy_len) { - out->data[copy_len - 1] = ' '; - --print_len; - ++num_newlines; - } - /* Raise exception if output field is too small */ - if (print_len - num_newlines > copy_len) { - set_json_exception (JSON_OUT_FIELD_TOO_SMALL); - goto end; - } - - end: - if (json) { - cJSON_Delete (json); - } - if (count && print_len) { - cob_add_int (count, print_len, 0); - } -} - -#else /* !WITH_CJSON */ - -void -cob_json_generate (cob_field *out, cob_ml_tree *tree, cob_field *count) -{ - COB_UNUSED (out); - COB_UNUSED (tree); - COB_UNUSED (count); -} - -#endif - -void -cob_init_mlio (cob_global * const g) -{ -#if WITH_XML2 - LIBXML_TEST_VERSION -#endif - cobglobptr = g; -} - -void -cob_exit_mlio (void) -{ -#if WITH_XML2 - xmlCleanupParser (); -#endif -} diff -Nru gnucobol-4.0~early~20200606/libcob/move.c gnucobol-5/libcob/move.c --- gnucobol-4.0~early~20200606/libcob/move.c 2020-06-06 20:52:01.000000000 +0000 +++ gnucobol-5/libcob/move.c 1970-01-01 00:00:00.000000000 +0000 @@ -1,2540 +0,0 @@ -/* - Copyright (C) 2002-2012, 2014-2019 Free Software Foundation, Inc. - Written by Keisuke Nishida, Roger While, Simon Sobisch, Ron Norman, - Edwart Hard - - This file is part of GnuCOBOL. - - The GnuCOBOL runtime library is free software: you can redistribute it - and/or modify it under the terms of the GNU Lesser General Public License - as published by the Free Software Foundation, either version 3 of the - License, or (at your option) any later version. - - GnuCOBOL is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU Lesser General Public License for more details. - - You should have received a copy of the GNU Lesser General Public License - along with GnuCOBOL. If not, see . -*/ - - -#include - -#include -#include -#include -#include -#include -#include -#include - -#ifdef HAVE_LOCALE_H -#include -#endif - -/* Force symbol exports */ -#define COB_LIB_EXPIMP -#include "libcob.h" -#include "coblocal.h" - -static cob_global *cobglobptr; -static cob_settings *cobsetptr; - -#if 0 /* RXWRXW local edit symbols */ -static unsigned int cob_locale_edit; -static unsigned char cob_lc_dec; -static unsigned char cob_lc_thou; -#endif - -static const cob_field_attr const_alpha_attr = - {COB_TYPE_ALPHANUMERIC, 0, 0, 0, NULL}; -static const cob_field_attr const_binll_attr = - {COB_TYPE_NUMERIC_BINARY, 20, 0, - COB_FLAG_HAVE_SIGN, NULL}; - -static const int cob_exp10[10] = { - 1, - 10, - 100, - 1000, - 10000, - 100000, - 1000000, - 10000000, - 100000000, - 1000000000 -}; - -static const cob_s64_t cob_exp10_ll[19] = { - COB_S64_C(1), - COB_S64_C(10), - COB_S64_C(100), - COB_S64_C(1000), - COB_S64_C(10000), - COB_S64_C(100000), - COB_S64_C(1000000), - COB_S64_C(10000000), - COB_S64_C(100000000), - COB_S64_C(1000000000), - COB_S64_C(10000000000), - COB_S64_C(100000000000), - COB_S64_C(1000000000000), - COB_S64_C(10000000000000), - COB_S64_C(100000000000000), - COB_S64_C(1000000000000000), - COB_S64_C(10000000000000000), - COB_S64_C(100000000000000000), - COB_S64_C(1000000000000000000) -}; - -static COB_INLINE COB_A_INLINE void -own_byte_memcpy (unsigned char *s1, const unsigned char *s2, size_t size) -{ - do { - *s1++ = *s2++; - } while (--size); -} - -static int -cob_packed_get_sign (const cob_field *f) -{ - unsigned char *p; - - if (!COB_FIELD_HAVE_SIGN (f)) { - return 0; - } - p = f->data + f->size - 1; - return ((*p & 0x0F) == 0x0D) ? -1 : 1; -} - -static void -store_common_region (cob_field *f, const unsigned char *data, - const size_t size, const int scale) -{ - const unsigned char *p; - unsigned char *q; - size_t csize; - size_t cinc; - int lf1 = -scale; - int lf2 = -COB_FIELD_SCALE (f); - int hf1 = (int) size + lf1; - int hf2 = (int) COB_FIELD_SIZE (f) + lf2; - int lcf; - int gcf; - - lcf = cob_max_int (lf1, lf2); - gcf = cob_min_int (hf1, hf2); - memset (COB_FIELD_DATA (f), '0', COB_FIELD_SIZE (f)); - if (gcf > lcf) { - csize = (size_t)gcf - lcf; - p = data + hf1 - gcf; - q = COB_FIELD_DATA (f) + hf2 - gcf; - for (cinc = 0; cinc < csize; ++cinc, ++p, ++q) { - if (unlikely (*p == ' ' || *p == 0)) { - *q = (unsigned char)'0'; - } else { - *q = *p; - } - } - } -} - -static COB_INLINE COB_A_INLINE cob_s64_t -cob_binary_mget_sint64 (const cob_field * const f) -{ - cob_s64_t n = 0; - size_t fsiz = 8U - f->size; - -#ifndef WORDS_BIGENDIAN - if (COB_FIELD_BINARY_SWAP (f)) { - if (COB_FIELD_HAVE_SIGN (f)) { - own_byte_memcpy ((unsigned char *)&n, f->data, f->size); - n = COB_BSWAP_64 (n); - /* Shift with sign */ - n >>= (cob_s64_t)8 * fsiz; - } else { - own_byte_memcpy (((unsigned char *)&n) + fsiz, f->data, f->size); - n = COB_BSWAP_64 (n); - } - } else { - if (COB_FIELD_HAVE_SIGN (f)) { - own_byte_memcpy (((unsigned char *)&n) + fsiz, f->data, f->size); - /* Shift with sign */ - n >>= (cob_s64_t)8 * fsiz; - } else { - own_byte_memcpy ((unsigned char *)&n, f->data, f->size); - } - } -#else /* WORDS_BIGENDIAN */ - if (COB_FIELD_HAVE_SIGN (f)) { - own_byte_memcpy ((unsigned char *)&n, f->data, f->size); - /* Shift with sign */ - n >>= 8 * fsiz; - } else { - own_byte_memcpy (((unsigned char *)&n) + fsiz, f->data, f->size); - } -#endif /* WORDS_BIGENDIAN */ - return n; -} - -static COB_INLINE COB_A_INLINE cob_u64_t -cob_binary_mget_uint64 (const cob_field * const f) -{ - cob_u64_t n = 0; - size_t fsiz = 8U - f->size; - -#ifndef WORDS_BIGENDIAN - if (COB_FIELD_BINARY_SWAP (f)) { - own_byte_memcpy (((unsigned char *)&n) + fsiz, f->data, f->size); - n = COB_BSWAP_64 (n); - } else { - own_byte_memcpy ((unsigned char *)&n, f->data, f->size); - } -#else /* WORDS_BIGENDIAN */ - own_byte_memcpy (((unsigned char *)&n) + fsiz, f->data, f->size); -#endif /* WORDS_BIGENDIAN */ - - return n; -} - -static COB_INLINE COB_A_INLINE void -cob_binary_mset_sint64 (cob_field *f, cob_s64_t n) -{ -#ifndef WORDS_BIGENDIAN - unsigned char *s; - - if (COB_FIELD_BINARY_SWAP (f)) { - n = COB_BSWAP_64 (n); - s = ((unsigned char *)&n) + 8 - f->size; - } else { - s = (unsigned char *)&n; - } - own_byte_memcpy (f->data, s, f->size); -#else /* WORDS_BIGENDIAN */ - own_byte_memcpy (f->data, ((unsigned char *)&n) + 8 - f->size, f->size); -#endif /* WORDS_BIGENDIAN */ -} - -static COB_INLINE COB_A_INLINE void -cob_binary_mset_uint64 (cob_field *f, cob_u64_t n) -{ -#ifndef WORDS_BIGENDIAN - unsigned char *s; - - if (COB_FIELD_BINARY_SWAP (f)) { - n = COB_BSWAP_64 (n); - s = ((unsigned char *)&n) + 8 - f->size; - } else { - s = (unsigned char *)&n; - } - own_byte_memcpy (f->data, s, f->size); -#else /* WORDS_BIGENDIAN */ - own_byte_memcpy (f->data, ((unsigned char *)&n) + 8 - f->size, f->size); -#endif /* WORDS_BIGENDIAN */ -} - -/* Display */ - -static void -cob_move_alphanum_to_display (cob_field *f1, cob_field *f2) -{ - unsigned char *p; - unsigned char *s1; - unsigned char *s2; - unsigned char *e1; - unsigned char *e2; - int sign; - int count; - int size; - unsigned char c; - unsigned char dec_pt; - unsigned char num_sep; - - /* Initialize */ - s1 = f1->data; - e1 = s1 + f1->size; - s2 = COB_FIELD_DATA (f2); - e2 = s2 + COB_FIELD_SIZE (f2); - memset (f2->data, '0', f2->size); - - /* Skip white spaces */ - for (; s1 < e1; ++s1) { - if (!isspace (*s1)) { - break; - } - } - - /* Check for sign */ - sign = 0; - if (s1 != e1) { - if (*s1 == '+' || *s1 == '-') { - sign = (*s1++ == '+') ? 1 : -1; - } - } - - dec_pt = COB_MODULE_PTR->decimal_point; - num_sep = COB_MODULE_PTR->numeric_separator; - - /* Count the number of digits before decimal point */ - count = 0; - for (p = s1; p < e1 && *p != dec_pt; ++p) { - if (isdigit (*p)) { - ++count; - } - } - - /* Find the start position */ - size = (int) COB_FIELD_SIZE (f2) - COB_FIELD_SCALE(f2); - if (count < size) { - s2 += size - count; - } else { - while (count-- > size) { - while (!isdigit (*s1++)) { - ; - } - } - } - - /* Move */ - count = 0; - for (; s1 < e1 && s2 < e2; ++s1) { - c = *s1; - if (isdigit (c)) { - *s2++ = c; - } else if (c == dec_pt) { - if (count++ > 0) { - goto error; - } - } else if (!(isspace (c) || c == num_sep)) { - goto error; - } - } - - COB_PUT_SIGN (f2, sign); - return; - -error: - memset (f2->data, '0', f2->size); - COB_PUT_SIGN (f2, 0); -} - -static void -cob_move_display_to_display (cob_field *f1, cob_field *f2) -{ - int sign; - - sign = COB_GET_SIGN (f1); - store_common_region (f2, COB_FIELD_DATA (f1), COB_FIELD_SIZE (f1), - COB_FIELD_SCALE (f1)); - - COB_PUT_SIGN (f1, sign); - COB_PUT_SIGN (f2, sign); -} - -static void -cob_move_display_to_alphanum (cob_field *f1, cob_field *f2) -{ - unsigned char *data1; - unsigned char *data2; - size_t size1; - size_t size2; - int sign; - int diff; - int zero_size; - - data1 = COB_FIELD_DATA (f1); - size1 = COB_FIELD_SIZE (f1); - sign = COB_GET_SIGN (f1); - if (unlikely (COB_FIELD_SCALE(f1) < 0)) { - /* Scaling */ - zero_size = (int)-COB_FIELD_SCALE(f1); - } else { - zero_size = 0; - } - data2 = f2->data; - size2 = f2->size; - if (unlikely (COB_FIELD_JUSTIFIED (f2))) { - /* Justified right */ - if (zero_size) { - /* Implied 0 ('P's) */ - zero_size = cob_min_int (zero_size, (int)size2); - size2 -= zero_size; - memset (data2 + size2, '0', (size_t) zero_size); - } - if (size2) { - diff = (int)(size2 - size1); - if (diff > 0) { - /* Padding */ - memset (data2, ' ', (size_t)diff); - data2 += diff; - size2 -= diff; - } - memmove (data2, data1 + size1 - size2, size2); - } - } else { - diff = (int)(size2 - size1); - if (diff < 0) { - memmove (data2, data1, size2); - } else { - memmove (data2, data1, size1); - if (zero_size) { - /* Implied 0 ('P's) */ - zero_size = cob_min_int (zero_size, diff); - memset (data2 + size1, '0', (size_t)zero_size); - diff -= zero_size; - } - if (diff) { - /* Padding */ - memset (data2 + size1 + zero_size, ' ', - (size_t)diff); - } - } - } - - COB_PUT_SIGN (f1, sign); -} - -static void -cob_move_alphanum_to_alphanum (cob_field *f1, cob_field *f2) -{ - unsigned char *data1; - unsigned char *data2; - size_t size1; - size_t size2; - - data1 = f1->data; - size1 = f1->size; - data2 = f2->data; - size2 = f2->size; - if (size1 >= size2) { - /* Move string with truncation */ - if (COB_FIELD_JUSTIFIED (f2)) { - memmove (data2, data1 + size1 - size2, size2); - } else { - memmove (data2, data1, size2); - } - } else { - /* Move string with padding */ - if (COB_FIELD_JUSTIFIED (f2)) { - memset (data2, ' ', size2 - size1); - memmove (data2 + size2 - size1, data1, size1); - } else { - memmove (data2, data1, size1); - memset (data2 + size1, ' ', size2 - size1); - } - } -} - -/* Packed decimal */ - -static void -cob_move_display_to_packed (cob_field *f1, cob_field *f2) -{ - unsigned char *data1; - unsigned char *data2; - unsigned char *p; - size_t digits1; - size_t digits2; - size_t i; - size_t offset; - int sign; - int scale1; - int scale2; - unsigned char n; - - sign = COB_GET_SIGN (f1); - data1 = COB_FIELD_DATA (f1); - digits1 = COB_FIELD_DIGITS (f1); - scale1 = COB_FIELD_SCALE (f1); - data2 = f2->data; - digits2 = COB_FIELD_DIGITS (f2); - scale2 = COB_FIELD_SCALE (f2); - - /* Pack string */ - memset (f2->data, 0, f2->size); - if (COB_FIELD_NO_SIGN_NIBBLE (f2)) { - offset = digits2 % 2; - } else { - offset = 1 - (digits2 % 2); - } - p = data1 + (digits1 - scale1) - (digits2 - scale2); - for (i = offset; i < digits2 + offset; ++i, ++p) { - n = (data1 <= p && p < data1 + digits1 && *p != ' ') ? - COB_D2I (*p) : 0; - if (i % 2 == 0) { - data2[i / 2] = n << 4; - } else { - data2[i / 2] |= n; - } - } - - COB_PUT_SIGN (f1, sign); - if (COB_FIELD_NO_SIGN_NIBBLE (f2)) { - return; - } - p = f2->data + f2->size - 1; - if (!COB_FIELD_HAVE_SIGN (f2)) { - *p = (*p & 0xF0) | 0x0F; - } else if (sign < 0) { - *p = (*p & 0xF0) | 0x0D; - } else { - *p = (*p & 0xF0) | 0x0C; - } -} - -static void -cob_move_packed_to_display (cob_field *f1, cob_field *f2) -{ - unsigned char *data; - size_t i; - size_t offset; - int sign; - unsigned char buff[256]; - - /* Unpack string */ - data = f1->data; - offset = COB_FIELD_DIGITS(f1) % 2; - if (COB_FIELD_NO_SIGN_NIBBLE (f1)) { - sign = 0; - } else { - sign = cob_packed_get_sign (f1); - offset = 1 - offset; - } - for (i = offset; i < COB_FIELD_DIGITS(f1) + offset; ++i) { - if (i % 2 == 0) { - buff[i - offset] = COB_I2D (data[i / 2] >> 4); - } else { - buff[i - offset] = COB_I2D (data[i / 2] & 0x0F); - } - } - - /* Store */ - store_common_region (f2, buff, (size_t)COB_FIELD_DIGITS (f1), - COB_FIELD_SCALE (f1)); - - COB_PUT_SIGN (f2, sign); -} - -/* Floating point */ - -static void -cob_move_fp_to_fp (cob_field *src, cob_field *dst) -{ - double dfp; - float ffp; - - if (COB_FIELD_TYPE (src) == COB_TYPE_NUMERIC_FLOAT) { - memmove ((void *)&ffp, src->data, sizeof(float)); - dfp = (double)ffp; - } else { - memmove ((void *)&dfp, src->data, sizeof(double)); - ffp = (float)dfp; - } - if (COB_FIELD_TYPE (dst) == COB_TYPE_NUMERIC_FLOAT) { - memmove (dst->data, (void *)&ffp, sizeof(float)); - } else { - memmove (dst->data, (void *)&dfp, sizeof(double)); - } -} - -/* Binary integer */ - - -static void -cob_move_binary_to_binary (cob_field *f1, cob_field *f2) -{ - union { - cob_u64_t uval; - cob_s64_t sval; - } ul64; - unsigned int sign; - - sign = 0; - if (COB_FIELD_HAVE_SIGN (f1)) { - ul64.sval = cob_binary_mget_sint64 (f1); - if (ul64.sval < 0) { - sign = 1; - } - if (COB_FIELD_BINARY_TRUNC (f2)) { - ul64.sval %= cob_exp10_ll[(int)COB_FIELD_DIGITS(f2)]; - } - } else { - ul64.uval = cob_binary_mget_uint64 (f1); - if (COB_FIELD_BINARY_TRUNC (f2)) { - ul64.uval %= cob_exp10_ll[(int)COB_FIELD_DIGITS(f2)]; - } - } - if (COB_FIELD_HAVE_SIGN (f2)) { - cob_binary_mset_sint64 (f2, ul64.sval); - } else { - if (sign) { - cob_binary_mset_uint64 (f2, (cob_u64_t)(-ul64.sval)); - } else { - cob_binary_mset_uint64 (f2, ul64.uval); - } - } -} - -static void -cob_move_display_to_binary (cob_field *f1, cob_field *f2) -{ - unsigned char *data1; - cob_u64_t val; - cob_s64_t val2; - size_t i, size; - size_t size1; - int sign; - - size1 = COB_FIELD_SIZE (f1); - data1 = COB_FIELD_DATA (f1); - sign = COB_GET_SIGN (f1); - /* Get value */ - val = 0; - size = size1 - COB_FIELD_SCALE(f1) + COB_FIELD_SCALE(f2); - for (i = 0; i < size; ++i) { - if (val) { - val *= 10; - } - if (i < size1) { - val += COB_D2I (data1[i]); - } - } - - if (COB_FIELD_BINARY_TRUNC (f2)) { - val %= cob_exp10_ll[(int)COB_FIELD_DIGITS(f2)]; - } - - if (COB_FIELD_HAVE_SIGN (f2)) { - /* Could this cast cause overflows? */ - val2 = (cob_s64_t)val; - if (sign < 0) { - val2 *= -1; - } - cob_binary_mset_sint64 (f2, val2); - } else { - cob_binary_mset_uint64 (f2, val); - } - - COB_PUT_SIGN (f1, sign); -} - -static void -cob_move_binary_to_display (cob_field *f1, cob_field *f2) -{ - cob_u64_t val; - cob_s64_t val2; - int i; - int sign; - char buff[32]; - - sign = 1; - /* Get value */ - if (COB_FIELD_HAVE_SIGN (f1)) { - val2 = cob_binary_mget_sint64 (f1); - if (val2 < 0) { - sign = -1; - val = (cob_u64_t)-val2; - } else { - val = (cob_u64_t)val2; - } - } else { - val = cob_binary_mget_uint64 (f1); - } - - /* Convert to string */ - i = 20; - while (val > 0) { - buff[--i] = (char) COB_I2D (val % 10); - val /= 10; - } - - /* Store */ - store_common_region (f2, (cob_u8_ptr)buff + i, (size_t)20 - i, - COB_FIELD_SCALE(f1)); - - COB_PUT_SIGN (f2, sign); -} - -/* Edited */ - -static void -cob_move_display_to_edited (cob_field *f1, cob_field *f2) -{ - const cob_pic_symbol *p; - unsigned char *min = COB_FIELD_DATA (f1); - unsigned char *max = min + COB_FIELD_SIZE (f1); - unsigned char *src; - unsigned char *dst = f2->data; - unsigned char *end = f2->data + f2->size; - unsigned char *decimal_point = NULL; - int sign = COB_GET_SIGN (f1); - int neg = (sign < 0) ? 1 : 0; - int count = 0; - int count_sign = 1; - int count_curr = 1; - int trailing_sign = 0; - int trailing_curr = 0; - int is_zero = 1; - int suppress_zero = 1; - int sign_first = 0; - int p_is_left = 0; - int repeat; - int n; - unsigned char pad = ' '; - unsigned char x; - unsigned char c; - unsigned char sign_symbol = 0; - unsigned char curr_symbol = 0; - unsigned char dec_symbol; - unsigned char currency = COB_MODULE_PTR->currency_symbol; - int floating_insertion = 0; - unsigned char *last_fixed_insertion_pos = NULL; - unsigned char last_fixed_insertion_char = '\0'; - - if (COB_MODULE_PTR->decimal_point == ',') { - dec_symbol = ','; - } else { - dec_symbol = '.'; - } - - /* Count the number of digit places before decimal point */ - /* - TO-DO: This is computed in cb_build_picture; add computed results to - cb_field and use those. - */ - for (p = COB_FIELD_PIC (f2); p && p->symbol; ++p) { - c = p->symbol; - repeat = p->times_repeated; - if (c == '9' || c == 'Z' || c == '*') { - count += repeat; - count_sign = 0; - count_curr = 0; - } else if (count_curr && c == currency) { - count += repeat; - } else if (count_sign && (c == '+' || c == '-')) { - count += repeat; - } else if (c == 'P') { - if (count == 0) { - p_is_left = 1; - break; - } else { - count += repeat; - count_sign = 0; - count_curr = 0; - } - } else if (c == 'V' || c == dec_symbol) { - break; - } - } - - src = max - COB_FIELD_SCALE(f1) - count; - if(COB_FIELD_PIC (f2) == NULL) { - /* There is no PIC present so assume all PIC 9s */ - n = f2->size; - src = max - n; - for (; n > 0; n--, ++dst) { - *dst = (min <= src && src < max) ? *src++ : (src++, '0'); - if (*dst != '0') { - is_zero = suppress_zero = 0; - } - suppress_zero = 0; - } - } - for (p = COB_FIELD_PIC (f2); p && p->symbol; ++p) { - c = p->symbol; - n = p->times_repeated; - for (; n > 0; n--, ++dst) { - switch (c) { - case '0': - case '/': - *dst = c; - break; - - case 'B': - *dst = suppress_zero ? pad : 'B'; - break; - - case 'P': - if (p_is_left) { - ++src; - --dst; - } - break; - - case '9': - *dst = (min <= src && src < max) ? *src++ : (src++, '0'); - if (*dst != '0') { - is_zero = suppress_zero = 0; - } - suppress_zero = 0; - trailing_sign = 1; - trailing_curr = 1; - break; - - case 'V': - --dst; - decimal_point = dst; - break; - - case '.': - case ',': - if (c == dec_symbol) { - *dst = dec_symbol; - decimal_point = dst; - } else { - if (suppress_zero) { - *dst = pad; - } else { - *dst = c; - } - } - break; - - case 'C': - case 'D': - end = dst; - /* Check negative and not zero */ - if (neg && !is_zero) { - if (c == 'C') { - memcpy (dst, "CR", (size_t)2); - } else { - memcpy (dst, "DB", (size_t)2); - } - } else { - memset (dst, ' ', (size_t)2); - } - dst++; - break; - - case 'Z': - case '*': - x = (min <= src && src < max) ? *src++ : (src++, '0'); - if (x != '0') { - is_zero = suppress_zero = 0; - } - pad = (c == '*') ? '*' : ' '; - *dst = suppress_zero ? pad : x; - trailing_sign = 1; - trailing_curr = 1; - break; - - case '+': - case '-': - x = (min <= src && src < max) ? *src++ : (src++, '0'); - if (x != '0') { - is_zero = suppress_zero = 0; - } - if (trailing_sign) { - /* Check negative and not zero */ - if (neg && !is_zero) { - *dst = '-'; - } else if (c == '+') { - *dst = '+'; - } else { - *dst = ' '; - } - --end; - } else if (dst == f2->data || suppress_zero) { - *dst = pad; - sign_symbol = c; - if (!curr_symbol) { - ++sign_first; - } - } else { - *dst = x; - } - - if (n > 1 || last_fixed_insertion_char == c) { - floating_insertion = 1; - } else if (!trailing_sign) { - if (last_fixed_insertion_pos) { - *last_fixed_insertion_pos = last_fixed_insertion_char; - } - last_fixed_insertion_pos = dst; - last_fixed_insertion_char = c; - } - break; - - default: - if (c == currency) { - x = (min <= src && src < max) ? *src++ : (src++, '0'); - if (x != '0') { - is_zero = suppress_zero = 0; - } - if (trailing_curr) { - *dst = currency; - --end; - } else if (dst == f2->data || suppress_zero) { - *dst = pad; - curr_symbol = currency; - } else { - *dst = x; - } - if (n > 1 || last_fixed_insertion_char == c) { - floating_insertion = 1; - } else if (!trailing_curr) { - if (last_fixed_insertion_pos) { - *last_fixed_insertion_pos = last_fixed_insertion_char; - } - last_fixed_insertion_pos = dst; - last_fixed_insertion_char = c; - } - break; - } - - *dst = '?'; /* Invalid PIC */ - } - } - } - - if (sign_symbol) { - /* Check negative and not zero */ - if (neg && !is_zero) { - sign_symbol = '-'; - } else if (sign_symbol != '+') { - sign_symbol = ' '; - } - } - - if (suppress_zero || (is_zero && COB_FIELD_BLANK_ZERO (f2))) { - /* All digits are zeros */ - if (pad == ' ' || COB_FIELD_BLANK_ZERO (f2)) { - memset (f2->data, ' ', f2->size); - } else { - for (dst = f2->data; dst < f2->data + f2->size; ++dst) { - if (*dst != dec_symbol) { - *dst = pad; - } - } - } - } else { - /* Put zero after the decimal point if necessary */ - if (decimal_point) { - for (dst = decimal_point + 1; dst < end; ++dst) { - switch (*dst) { - case '0': - case '1': - case '2': - case '3': - case '4': - case '5': - case '6': - case '7': - case '8': - case '9': - case ',': - case '+': - case '-': - case '/': - case 'B': - break; - default: - *dst = '0'; - } - } - } - - /* Put sign or currency symbol at the beginning */ - if (sign_symbol || curr_symbol) { - if (floating_insertion) { - for (dst = end - 1; dst > f2->data; --dst) { - if (*dst == ' ') { - break; - } - } - if (sign_symbol && curr_symbol) { - /* - Only one of $ and +/- can be floating - in any given picture, so the symbol - which comes after the other must be - the one which floats. - */ - if (sign_first) { - *dst = curr_symbol; - } else { - *dst = sign_symbol; - } - } else if (sign_symbol) { - *dst = sign_symbol; - } else { - *dst = curr_symbol; - } - } else { - if (last_fixed_insertion_char == currency) { - *last_fixed_insertion_pos = curr_symbol; - } else { /* + or - */ - *last_fixed_insertion_pos = sign_symbol; - } - } - } - - /* Replace all 'B's by pad */ - count = 0; - for (dst = f2->data; dst < end; ++dst) { - if (*dst == 'B') { - if (count == 0) { - *dst = pad; - } else { - *dst = ' '; - } - } else { - ++count; - } - } - } - - COB_PUT_SIGN (f1, sign); -} - -static void -cob_move_edited_to_display (cob_field *f1, cob_field *f2) -{ - unsigned char *p; - unsigned char *buff; - const cob_pic_symbol *pic_symbol; - size_t i; - int sign = 0; - int scale = 0; - int count = 0; - int have_point = 0; - int n; - unsigned char c; - unsigned char cp; - unsigned char dec_pt; - - dec_pt = COB_MODULE_PTR->decimal_point; - buff = cob_malloc (f1->size); - p = buff; - /* De-edit */ - for (i = 0; i < f1->size; ++i) { - cp = f1->data[i]; - switch (cp) { - case '0': - case '1': - case '2': - case '3': - case '4': - case '5': - case '6': - case '7': - case '8': - case '9': - *p++ = cp; - if (have_point) { - ++scale; - } - break; - case '.': - case ',': - if (cp == dec_pt) { - have_point = 1; - } - break; - case '-': - case 'C': - sign = -1; - break; - } - } - /* Count number of digit places after decimal point in case of 'V', 'P' */ - if (scale == 0) { - for (pic_symbol = COB_FIELD_PIC (f1); pic_symbol->symbol; ++pic_symbol) { - c = pic_symbol->symbol; - n = pic_symbol->times_repeated; - if (c == '9' || c == '0' || c == 'Z' || c == '*') { - if (have_point) { - scale += n; - } else { - count += n; - } - } else if (c == 'P') { - if (count == 0) { - have_point = 1; - scale += n; - } else { - scale -= n; - } - } else if (c == 'V') { - have_point = 1; - } - } - } - - /* Store */ - store_common_region (f2, buff, (size_t)(p - buff), scale); - - COB_PUT_SIGN (f2, sign); - cob_free (buff); -} - -static void -cob_move_alphanum_to_edited (cob_field *f1, cob_field *f2) -{ - const cob_pic_symbol *p; - unsigned char *max; - unsigned char *src; - unsigned char *dst; - int sign; - int n; - unsigned char c; - - sign = COB_GET_SIGN (f1); - src = COB_FIELD_DATA (f1); - max = src + COB_FIELD_SIZE (f1); - dst = f2->data; - for (p = COB_FIELD_PIC (f2); p->symbol; ++p) { - c = p->symbol; - n = p->times_repeated; - for (; n > 0; --n) { - switch (c) { - case 'A': - case 'X': - case '9': - *dst++ = (src < max) ? *src++ : ' '; - break; - case '0': - case '/': - *dst++ = c; - break; - case 'B': - *dst++ = ' '; - break; - default: - *dst++ = '?'; /* Invalid PIC */ - } - } - } - COB_PUT_SIGN (f1, sign); -} - -/* MOVE dispatcher */ - -static void -indirect_move (void (*func) (cob_field *src, cob_field *dst), - cob_field *src, cob_field *dst, - const size_t size, const int scale) -{ - cob_field temp; - cob_field_attr attr; - - COB_ATTR_INIT (COB_TYPE_NUMERIC_DISPLAY, (unsigned short) size, (short) scale, - COB_FLAG_HAVE_SIGN, NULL); - temp.size = size; - temp.data = cob_malloc (size); - temp.attr = &attr; - func (src, &temp); - cob_move (&temp, dst); - cob_free (temp.data); -} - -static void -cob_move_all (cob_field *src, cob_field *dst) -{ - unsigned char *p; - size_t i; - size_t digcount; - cob_field temp; - cob_field_attr attr; - - if (likely(COB_FIELD_IS_ALNUM(dst))) { - if (likely(src->size == 1)) { - memset (dst->data, src->data[0], dst->size); - } else { - digcount = src->size; - for (i = 0; i < dst->size; ++i) { - dst->data[i] = src->data[i % digcount]; - } - } - return; - } - COB_ATTR_INIT (COB_TYPE_ALPHANUMERIC, 0, 0, 0, NULL); - if (COB_FIELD_IS_NUMERIC(dst)) { - digcount = COB_MAX_DIGITS; - attr.type = COB_TYPE_NUMERIC_DISPLAY; - attr.digits = COB_MAX_DIGITS; - } else { - digcount = dst->size; - } - p = cob_malloc (digcount); - temp.size = digcount; - temp.data = p; - temp.attr = &attr; - if (likely(src->size == 1)) { - memset (p, src->data[0], digcount); - } else { - for (i = 0; i < digcount; ++i) { - p[i] = src->data[i % src->size]; - } - } - - cob_move (&temp, dst); - cob_free (p); -} - -/* - * Move data the same way as 'MVC' instruction on IBM works, - * left to right, byte by byte - */ -void -cob_move_ibm (void *dst, void *src, const int len) -{ - char *dest = dst; - char *srce = src; - int i; - for (i=0; i < len; i++) { - dest[i] = srce[i]; - } -} - -void -cob_move (cob_field *src, cob_field *dst) -{ - int opt; - cob_field temp; - unsigned char data[4]; - - if (src == dst) { - return; - } - if (dst->size == 0) { - return; - } - if (unlikely (src->size == 0)) { - temp.size = 1; - temp.data = data; - temp.attr = &const_alpha_attr; - data[0] = ' '; - data[1] = 0; - src = &temp; - } - if (COB_FIELD_TYPE (src) == COB_TYPE_ALPHANUMERIC_ALL) { - cob_move_all (src, dst); - return; - } - - /* Non-elementary move */ - if (COB_FIELD_TYPE (src) == COB_TYPE_GROUP - || COB_FIELD_TYPE (dst) == COB_TYPE_GROUP) { - cob_move_alphanum_to_alphanum (src, dst); - return; - } - - opt = 0; - if (COB_FIELD_TYPE (dst) == COB_TYPE_NUMERIC_BINARY) { - if (COB_FIELD_BINARY_TRUNC (dst) - && !COB_FIELD_REAL_BINARY (dst)) { - opt = COB_STORE_TRUNC_ON_OVERFLOW; - } - } - - /* Elementary move */ - switch (COB_FIELD_TYPE (src)) { - case COB_TYPE_NUMERIC_DISPLAY: - switch (COB_FIELD_TYPE (dst)) { - case COB_TYPE_NUMERIC_FLOAT: - case COB_TYPE_NUMERIC_DOUBLE: - case COB_TYPE_NUMERIC_L_DOUBLE: - case COB_TYPE_NUMERIC_FP_BIN32: - case COB_TYPE_NUMERIC_FP_BIN64: - case COB_TYPE_NUMERIC_FP_BIN128: - case COB_TYPE_NUMERIC_FP_DEC64: - case COB_TYPE_NUMERIC_FP_DEC128: - cob_decimal_setget_fld (src, dst, 0); - return; - case COB_TYPE_NUMERIC_DISPLAY: - cob_move_display_to_display (src, dst); - return; - case COB_TYPE_NUMERIC_PACKED: - cob_move_display_to_packed (src, dst); - return; - case COB_TYPE_NUMERIC_BINARY: - cob_move_display_to_binary (src, dst); - return; - case COB_TYPE_NUMERIC_EDITED: - cob_move_display_to_edited (src, dst); - return; - case COB_TYPE_ALPHANUMERIC_EDITED: - if (COB_FIELD_SCALE (src) < 0 - || COB_FIELD_SCALE (src) > COB_FIELD_DIGITS (src)) { - /* Expand P's */ - indirect_move (cob_move_display_to_display, src, dst, - (size_t)cob_max_int ((int)COB_FIELD_DIGITS(src), (int)COB_FIELD_SCALE(src)), - cob_max_int (0, (int)COB_FIELD_SCALE(src))); - return; - } else { - cob_move_alphanum_to_edited (src, dst); - return; - } - default: - cob_move_display_to_alphanum (src, dst); - return; - } - - case COB_TYPE_NUMERIC_PACKED: - switch (COB_FIELD_TYPE (dst)) { - case COB_TYPE_NUMERIC_DISPLAY: - cob_move_packed_to_display (src, dst); - return; - case COB_TYPE_NUMERIC_BINARY: - cob_decimal_setget_fld (src, dst, opt); - return; - case COB_TYPE_NUMERIC_PACKED: - case COB_TYPE_NUMERIC_DOUBLE: - case COB_TYPE_NUMERIC_FLOAT: - case COB_TYPE_NUMERIC_L_DOUBLE: - case COB_TYPE_NUMERIC_FP_BIN32: - case COB_TYPE_NUMERIC_FP_BIN64: - case COB_TYPE_NUMERIC_FP_BIN128: - case COB_TYPE_NUMERIC_FP_DEC64: - case COB_TYPE_NUMERIC_FP_DEC128: - cob_decimal_setget_fld (src, dst, 0); - return; - default: - indirect_move (cob_move_packed_to_display, src, dst, - (size_t)(COB_FIELD_DIGITS(src)), - COB_FIELD_SCALE(src)); - return; - } - - case COB_TYPE_NUMERIC_BINARY: - switch (COB_FIELD_TYPE (dst)) { - case COB_TYPE_NUMERIC_BINARY: - if (COB_FIELD_SCALE(src) == COB_FIELD_SCALE(dst)) { - cob_move_binary_to_binary (src, dst); - return; - } - cob_decimal_setget_fld (src, dst, opt); - return; - case COB_TYPE_NUMERIC_DISPLAY: - cob_move_binary_to_display (src, dst); - return; - case COB_TYPE_NUMERIC_PACKED: - case COB_TYPE_NUMERIC_DOUBLE: - case COB_TYPE_NUMERIC_FLOAT: - case COB_TYPE_NUMERIC_L_DOUBLE: - case COB_TYPE_NUMERIC_FP_BIN32: - case COB_TYPE_NUMERIC_FP_BIN64: - case COB_TYPE_NUMERIC_FP_BIN128: - case COB_TYPE_NUMERIC_FP_DEC64: - case COB_TYPE_NUMERIC_FP_DEC128: - cob_decimal_setget_fld (src, dst, 0); - return; - case COB_TYPE_NUMERIC_EDITED: - indirect_move (cob_move_binary_to_display, src, dst, - (size_t)COB_MAX_DIGITS, - COB_FIELD_SCALE(src)); - return; - default: - indirect_move (cob_move_binary_to_display, src, dst, - (size_t)(COB_FIELD_DIGITS(src)), - COB_FIELD_SCALE(src)); - return; - } - - case COB_TYPE_NUMERIC_EDITED: - switch (COB_FIELD_TYPE (dst)) { - case COB_TYPE_NUMERIC_DISPLAY: - cob_move_edited_to_display (src, dst); - return; - case COB_TYPE_NUMERIC_PACKED: - case COB_TYPE_NUMERIC_BINARY: - case COB_TYPE_NUMERIC_EDITED: - case COB_TYPE_NUMERIC_FLOAT: - case COB_TYPE_NUMERIC_DOUBLE: - case COB_TYPE_NUMERIC_L_DOUBLE: - case COB_TYPE_NUMERIC_FP_BIN32: - case COB_TYPE_NUMERIC_FP_BIN64: - case COB_TYPE_NUMERIC_FP_BIN128: - case COB_TYPE_NUMERIC_FP_DEC64: - case COB_TYPE_NUMERIC_FP_DEC128: - indirect_move (cob_move_edited_to_display, src, dst, - (size_t)(2 * COB_MAX_DIGITS), - COB_MAX_DIGITS); - return; - case COB_TYPE_ALPHANUMERIC_EDITED: - cob_move_alphanum_to_edited (src, dst); - return; - default: - cob_move_alphanum_to_alphanum (src, dst); - return; - } - - case COB_TYPE_NUMERIC_DOUBLE: - switch (COB_FIELD_TYPE (dst)) { - case COB_TYPE_NUMERIC_DOUBLE: - memmove (dst->data, src->data, sizeof(double)); - return; - case COB_TYPE_NUMERIC_FLOAT: - cob_move_fp_to_fp (src, dst); - return; - case COB_TYPE_NUMERIC_BINARY: - cob_decimal_setget_fld (src, dst, opt); - return; - case COB_TYPE_NUMERIC_PACKED: - case COB_TYPE_NUMERIC_DISPLAY: - case COB_TYPE_NUMERIC_L_DOUBLE: - case COB_TYPE_NUMERIC_FP_BIN32: - case COB_TYPE_NUMERIC_FP_BIN64: - case COB_TYPE_NUMERIC_FP_BIN128: - case COB_TYPE_NUMERIC_FP_DEC64: - case COB_TYPE_NUMERIC_FP_DEC128: - cob_decimal_setget_fld (src, dst, 0); - return; - default: - cob_decimal_move_temp (src, dst); - return; - } - - case COB_TYPE_NUMERIC_FLOAT: - switch (COB_FIELD_TYPE (dst)) { - case COB_TYPE_NUMERIC_FLOAT: - memmove (dst->data, src->data, sizeof(float)); - return; - case COB_TYPE_NUMERIC_DOUBLE: - cob_move_fp_to_fp (src, dst); - return; - case COB_TYPE_NUMERIC_BINARY: - cob_decimal_setget_fld (src, dst, opt); - return; - case COB_TYPE_NUMERIC_PACKED: - case COB_TYPE_NUMERIC_DISPLAY: - case COB_TYPE_NUMERIC_L_DOUBLE: - case COB_TYPE_NUMERIC_FP_BIN32: - case COB_TYPE_NUMERIC_FP_BIN64: - case COB_TYPE_NUMERIC_FP_BIN128: - case COB_TYPE_NUMERIC_FP_DEC64: - case COB_TYPE_NUMERIC_FP_DEC128: - cob_decimal_setget_fld (src, dst, 0); - return; - default: - cob_decimal_move_temp (src, dst); - return; - } - - case COB_TYPE_NUMERIC_FP_DEC64: - switch (COB_FIELD_TYPE (dst)) { - case COB_TYPE_NUMERIC_BINARY: - cob_decimal_setget_fld (src, dst, opt); - return; - case COB_TYPE_NUMERIC_FP_DEC64: - memmove (dst->data, src->data, (size_t)8); - return; - case COB_TYPE_NUMERIC_FLOAT: - case COB_TYPE_NUMERIC_DOUBLE: - case COB_TYPE_NUMERIC_PACKED: - case COB_TYPE_NUMERIC_DISPLAY: - case COB_TYPE_NUMERIC_L_DOUBLE: - case COB_TYPE_NUMERIC_FP_BIN32: - case COB_TYPE_NUMERIC_FP_BIN128: - case COB_TYPE_NUMERIC_FP_DEC128: - cob_decimal_setget_fld (src, dst, 0); - return; - default: - cob_decimal_move_temp (src, dst); - return; - } - case COB_TYPE_NUMERIC_FP_DEC128: - switch (COB_FIELD_TYPE (dst)) { - case COB_TYPE_NUMERIC_BINARY: - cob_decimal_setget_fld (src, dst, opt); - return; - case COB_TYPE_NUMERIC_FP_DEC128: - memmove (dst->data, src->data, (size_t)16); - return; - case COB_TYPE_NUMERIC_FLOAT: - case COB_TYPE_NUMERIC_DOUBLE: - case COB_TYPE_NUMERIC_PACKED: - case COB_TYPE_NUMERIC_DISPLAY: - case COB_TYPE_NUMERIC_L_DOUBLE: - case COB_TYPE_NUMERIC_FP_BIN32: - case COB_TYPE_NUMERIC_FP_BIN64: - case COB_TYPE_NUMERIC_FP_BIN128: - case COB_TYPE_NUMERIC_FP_DEC64: - cob_decimal_setget_fld (src, dst, 0); - return; - default: - cob_decimal_move_temp (src, dst); - return; - } - default: - switch (COB_FIELD_TYPE (dst)) { - case COB_TYPE_NUMERIC_DISPLAY: - cob_move_alphanum_to_display (src, dst); - return; - case COB_TYPE_NUMERIC_PACKED: - case COB_TYPE_NUMERIC_BINARY: - case COB_TYPE_NUMERIC_EDITED: - case COB_TYPE_NUMERIC_FLOAT: - case COB_TYPE_NUMERIC_DOUBLE: - case COB_TYPE_NUMERIC_L_DOUBLE: - case COB_TYPE_NUMERIC_FP_BIN32: - case COB_TYPE_NUMERIC_FP_BIN64: - case COB_TYPE_NUMERIC_FP_BIN128: - case COB_TYPE_NUMERIC_FP_DEC64: - case COB_TYPE_NUMERIC_FP_DEC128: - indirect_move (cob_move_alphanum_to_display, src, dst, - (size_t)(2* COB_MAX_DIGITS), - COB_MAX_DIGITS); - return; - case COB_TYPE_ALPHANUMERIC_EDITED: - cob_move_alphanum_to_edited (src, dst); - return; - default: - cob_move_alphanum_to_alphanum (src, dst); - return; - } - } -} - -/* - * Allocate storage as required and move data to dst field - * The storage for these LINKAGE fields is allocated from a - * single buffer pointed to by 'cob_module->param_buf' - * cob_module_free will release the memory - */ -void -cob_alloc_move (cob_field *src, cob_field *dst, const int nsize) -{ - unsigned int size; - int i, j, k, use, pos, npos; - unsigned char *buf; - cob_module *mod = COB_MODULE_PTR; - cob_field *f; - - if (src == NULL) { /* OMMITTED parameter */ - dst->data = NULL; - return; - } - - if (nsize > 0 - && (int)dst->size != nsize) { - dst->data = NULL; - dst->size = (size_t) nsize; - } - - if (dst->data == NULL) { - size = (dst->size + 7) / 8; - size = size * 8; - if (mod->param_buf == NULL) { - mod->param_buf_used = 0; - mod->param_buf_size = size + 8; - mod->param_buf = cob_cache_malloc (mod->param_buf_size); - } - if (mod->param_field == NULL) { - mod->param_num = 0; - mod->param_max = 2; - mod->param_field = cob_cache_malloc (mod->param_max * sizeof(void*)); - } - buf = NULL; - use = mod->param_buf_used; - for (i=j=0; i < mod->param_num; i++) { - if (mod->param_field[i]->data == NULL) { - if (i > 0 && j == 0) { - for (k=i; k < mod->param_num - && mod->param_field[k]->data == NULL; k++); - if (k == mod->param_num) { /* All remaining fields have NULL */ - j = 0; - break; - } - } - j++; - } - } - if (i > 0 && j == i) { /* No LINKAGE fields stored */ - mod->param_buf_used = 0; - j = 0; - } - - if (mod->param_buf_used + size > mod->param_buf_size) { /* Grow the buffer */ - buf = mod->param_buf; - mod->param_buf_size += (size + 8); - mod->param_buf = cob_cache_malloc (mod->param_buf_size); - } else if (i > 0 && j > 0) { /* Some unassigned fields so shuffle them up */ - buf = mod->param_buf; - mod->param_buf = cob_cache_malloc (mod->param_buf_size); - } - - if (buf != NULL) { - for (i=npos=0; i < mod->param_num; i++) { /* Adjust 'data' for new buffer */ - f = mod->param_field [i]; - if (f->data != NULL) { - pos = f->data - buf; - if (pos >= 0 - && pos < use) { /* Within previous buffer? */ - memcpy (&mod->param_buf[npos], f->data, f->size); - f->data = &mod->param_buf[npos]; - npos += ((f->size + 7) / 8) * 8; - } - } - } - cob_cache_free (buf); - } - for (i=0; i < mod->param_num; i++) { - if (mod->param_field[i] == dst) - break; - } - if (i >= mod->param_num) { /* Not in table, so add it */ - if (mod->param_num >= mod->param_max) { - mod->param_max += 2; - mod->param_field = cob_cache_realloc (mod->param_field, - mod->param_max * sizeof(void*)); - } - i = mod->param_num++; - mod->param_field[i] = dst; - } - - dst->data = &mod->param_buf[mod->param_buf_used]; - mod->param_buf_used += size; - } - - cob_move (src, dst); -} - -/* Convenience functions */ - -static int -cob_packed_get_int (cob_field *f1) -{ - unsigned char *data; - size_t i; - size_t offset; - int val = 0; - int sign; - - data = f1->data; - offset = COB_FIELD_DIGITS(f1) % 2; - if (COB_FIELD_NO_SIGN_NIBBLE (f1)) { - sign = 0; - } else { - sign = cob_packed_get_sign (f1); - offset = 1 - offset; - } - for (i = offset; i < COB_FIELD_DIGITS(f1) - COB_FIELD_SCALE(f1) + offset; ++i) { - val *= 10; - if (i % 2 == 0) { - val += data[i / 2] >> 4; - } else { - val += data[i / 2] & 0x0F; - } - } - if (sign < 0) { - val = -val; - } - return val; -} - -static cob_s64_t -cob_packed_get_long_long (cob_field *f1) -{ - unsigned char *data; - size_t i; - size_t offset; - size_t field_data; - cob_s64_t val = 0; - int sign; - - data = f1->data; - offset = COB_FIELD_DIGITS(f1) % 2; - if (COB_FIELD_NO_SIGN_NIBBLE (f1)) { - sign = 0; - } else { - sign = cob_packed_get_sign (f1); - offset = 1 - offset; - } - field_data = COB_FIELD_DIGITS(f1) - COB_FIELD_SCALE(f1); - for (i = offset; i < field_data + offset; ++i) { - val *= 10; - if (i % 2 == 0) { - val += data[i / 2] >> 4; - } else { - val += data[i / 2] & 0x0F; - } - } - if (sign < 0) { - val = -val; - } - return val; -} - -static int -cob_display_get_int (cob_field *f) -{ - unsigned char *data; - size_t size; - size_t i; - int val = 0; - int sign; - - size = COB_FIELD_SIZE (f); - data = COB_FIELD_DATA (f); - sign = COB_GET_SIGN (f); - /* Skip preceding zeros */ - for (i = 0; i < size; ++i) { - if (COB_D2I (data[i]) != 0) { - break; - } - } - - /* Get value */ - if (COB_FIELD_SCALE(f) < 0) { - for (; i < size; ++i) { - val = val * 10 + COB_D2I (data[i]); - } - val *= cob_exp10[(int)-COB_FIELD_SCALE(f)]; - } else { - size -= COB_FIELD_SCALE(f); - for (; i < size; ++i) { - val = val * 10 + COB_D2I (data[i]); - } - } - if (sign < 0) { - val = -val; - } - - COB_PUT_SIGN (f, sign); - return val; -} - -static cob_s64_t -cob_display_get_long_long (cob_field *f) -{ - unsigned char *data; - size_t size; - size_t i; - cob_s64_t val = 0; - int sign; - - size = COB_FIELD_SIZE (f); - data = COB_FIELD_DATA (f); - sign = COB_GET_SIGN (f); - /* Skip preceding zeros */ - for (i = 0; i < size; ++i) { - if (COB_D2I (data[i]) != 0) { - break; - } - } - - /* Get value */ - if (COB_FIELD_SCALE(f) < 0) { - for (; i < size; ++i) { - val = val * 10 + COB_D2I (data[i]); - } - val *= cob_exp10_ll[(int)-COB_FIELD_SCALE(f)]; - } else { - size -= COB_FIELD_SCALE(f); - for (; i < size; ++i) { - val = val * 10 + COB_D2I (data[i]); - } - } - if (sign < 0) { - val = -val; - } - - COB_PUT_SIGN (f, sign); - return val; -} - -void -cob_set_int (cob_field *f, const int n) -{ - cob_field temp; - cob_field_attr attr; - - COB_ATTR_INIT (COB_TYPE_NUMERIC_BINARY, 9, 0, - COB_FLAG_HAVE_SIGN | COB_FLAG_REAL_BINARY, NULL); - temp.size = 4; - temp.data = (unsigned char *)&n; - temp.attr = &attr; - cob_move (&temp, f); -} - -int -cob_get_int (cob_field *f) -{ - int n; - cob_s64_t val; - cob_field temp; - cob_field_attr attr; - - switch (COB_FIELD_TYPE (f)) { - case COB_TYPE_NUMERIC_DISPLAY: - return cob_display_get_int (f); - case COB_TYPE_NUMERIC_PACKED: - return cob_packed_get_int (f); - case COB_TYPE_NUMERIC_BINARY: - val = cob_binary_mget_sint64 (f); - for (n = COB_FIELD_SCALE (f); n > 0 && val; --n) { - val /= 10; - } - return (int)val; - default: - COB_ATTR_INIT (COB_TYPE_NUMERIC_BINARY, 9, 0, - COB_FLAG_HAVE_SIGN, NULL); - temp.size = 4; - temp.data = (unsigned char *)&n; - temp.attr = &attr; - cob_move (f, &temp); - return n; - } -} - -cob_s64_t -cob_get_llint (cob_field *f) -{ - cob_s64_t n; - int inc; - cob_field temp; - - switch (COB_FIELD_TYPE (f)) { - case COB_TYPE_NUMERIC_DISPLAY: - return cob_display_get_long_long (f); - case COB_TYPE_NUMERIC_PACKED: - return cob_packed_get_long_long (f); - case COB_TYPE_NUMERIC_BINARY: - n = cob_binary_mget_sint64 (f); - for (inc = COB_FIELD_SCALE (f); inc > 0 && n; --inc) { - n /= 10; - } - return n; - default: - temp.size = 8; - temp.data = (unsigned char *)&n; - temp.attr = &const_binll_attr; - cob_move (f, &temp); - return n; - } -} - -void -cob_set_llint (cob_field *f, cob_s64_t max, cob_s64_t n) -{ - cob_field temp; - cob_s64_t v; - temp.size = 8; - temp.attr = &const_binll_attr; - temp.data = (unsigned char *)&n; - if (n >= max - || n <= -max) { - cob_set_exception (COB_EC_SIZE_OVERFLOW); - if (COB_MODULE_PTR->flag_binary_truncate - && f->attr->type == COB_TYPE_NUMERIC_BINARY - && !COB_FIELD_REAL_BINARY (f)) { - v = n % max; - temp.data = (unsigned char *)&v; - } - } - cob_move (&temp, f); - return; -} - -void -cob_set_llcon (cob_field *f, cob_s64_t n) -{ - cob_field temp; - temp.size = 8; - temp.attr = &const_binll_attr; - temp.data = (unsigned char *)&n; - cob_move (&temp, f); - return; -} - -void -cob_init_move (cob_global *lptr, cob_settings *sptr) -{ - cobglobptr = lptr; - cobsetptr = sptr; -} - -/* - * Routines for C application code to access COBOL data follow - */ -void -cob_put_u64_compx (cob_u64_t val, void *mem, int len) -{ -#if !defined(WORDS_BIGENDIAN) - cob_u64_t ulong; -#endif - cob_u32_t uint; - cob_u16_t ushort; - -#ifdef WORDS_BIGENDIAN - switch (len) { - case sizeof(int): - uint = ((cob_u32_t)val); - memcpy (mem, ((cob_u8_t*)&uint), sizeof(int)); - return; - default: /* Assume 64 bit value */ - case sizeof(cob_s64_t): - memcpy (mem, ((cob_u8_t*)&val), sizeof(cob_s64_t)); - return; - case sizeof(short): - ushort = ((cob_u16_t)val); - memcpy (mem, ((cob_u8_t*)&ushort), sizeof(short)); - return; - case 1: - *((cob_u8_t*)mem) = ((cob_u8_t)val); - return; - case 3: - case 5: - case 6: - case 7: - memcpy (mem, ((cob_u8_t*)&val) + (sizeof(cob_s64_t) - len), len); - } -#else - switch (len) { - case sizeof(int): - uint = COB_BSWAP_32 ((cob_u32_t)val); - memcpy (mem, ((cob_u8_t*)&uint), sizeof(int)); - return; - default: /* Assume 64 bit value */ - case sizeof(cob_s64_t): - ulong = COB_BSWAP_64 ((cob_u64_t)val); - memcpy (mem, ((cob_u8_t*)&ulong), sizeof(cob_s64_t)); - return; - case sizeof(short): - ushort = COB_BSWAP_16 ((cob_u16_t)val); - memcpy (mem, ((cob_u8_t*)&ushort), sizeof(short)); - return; - case 1: - *((cob_u8_t*)mem) = ((cob_u8_t)val); - return; - case 3: - case 5: - case 6: - case 7: - ulong = COB_BSWAP_64 (val); - memcpy (mem, ((cob_u8_t*)&ulong) + (sizeof(cob_s64_t) - len), len); - } -#endif -} - -void -cob_put_u64_comp5 (cob_u64_t val, void *mem, int len) -{ - cob_u32_t uint; - cob_u16_t ushort; - switch (len) { - case sizeof(int): - uint = ((cob_u32_t)val); - memcpy (mem, ((cob_u8_t*)&uint), sizeof(int)); - return; - default: /* Assume 64 bit value */ - case sizeof(cob_s64_t): - memcpy (mem, ((cob_u8_t*)&val), sizeof(cob_s64_t)); - return; - case sizeof(short): - ushort = ((cob_u16_t)val); - memcpy (mem, ((cob_u8_t*)&ushort), sizeof(short)); - return; - case 1: - *((cob_u8_t*)mem) = ((cob_u8_t)val); - return; - case 3: - case 5: - case 6: - case 7: - break; - } -#if defined(WORDS_BIGENDIAN) - memcpy (mem, ((cob_u8_t*)&val) + (sizeof(cob_s64_t) - len), len); -#else - memcpy (mem, ((cob_u8_t*)&val), len); -#endif -} - -void -cob_put_s64_compx (cob_s64_t val, void *mem, int len) -{ -#if !defined(WORDS_BIGENDIAN) - cob_s64_t slong; -#endif - cob_s32_t sint; - cob_s16_t sshort; -#if defined(WORDS_BIGENDIAN) - switch (len) { - case sizeof(int): - sint = ((cob_s32_t)val); - memcpy(mem,((cob_u8_t*)&sint),sizeof(int)); - return; - default: /* Assume 64 bit value */ - case sizeof(cob_s64_t): - memcpy(mem,((cob_u8_t*)&val),sizeof(cob_s64_t)); - return; - case sizeof(short): - sshort = ((cob_s16_t)val); - memcpy(mem,((cob_u8_t*)&sshort),sizeof(short)); - return; - case 1: - *((cob_s8_t*)mem) = ((cob_s8_t)val); - return; - case 3: - case 5: - case 6: - case 7: - memcpy(mem,((cob_u8_t*)&val)+(sizeof(cob_s64_t)-len),len); - } -#else - switch (len) { - case sizeof(int): - sint = COB_BSWAP_32 ((cob_s32_t)val); - memcpy(mem,((cob_u8_t*)&sint),sizeof(int)); - return; - default: /* Assume 64 bit value */ - case sizeof(cob_s64_t): - slong = COB_BSWAP_64 ((cob_s64_t)val); - memcpy(mem,((cob_u8_t*)&slong),sizeof(cob_s64_t)); - return; - case sizeof(short): - sshort = COB_BSWAP_16 ((cob_s16_t)val); - memcpy(mem,((cob_u8_t*)&sshort),sizeof(short)); - return; - case 1: - *((cob_s8_t*)mem) = ((cob_s8_t)val); - return; - case 3: - case 5: - case 6: - case 7: - slong = COB_BSWAP_64 (val); - memcpy(mem,((cob_u8_t*)&slong)+(sizeof(cob_s64_t)-len),len); - } -#endif - return; -} - -void -cob_put_s64_comp5 (cob_s64_t val, void *mem, int len) -{ - cob_s32_t sint; - cob_s16_t sshort; - switch (len) { - case sizeof(int): - sint = ((cob_s32_t)val); - memcpy (mem, ((cob_u8_t*)&sint), sizeof(int)); - return; - default: /* Assume 64 bit value */ - case sizeof(cob_s64_t): - memcpy (mem, ((cob_u8_t*)&val), sizeof(cob_s64_t)); - return; - case sizeof(short): - sshort = ((cob_u16_t)val); - memcpy (mem, ((cob_u8_t*)&sshort), sizeof(short)); - return; - case 1: - *((cob_u8_t*)mem) = ((cob_u8_t)val); - return; - case 3: - case 5: - case 6: - case 7: - break; - } -#if defined(WORDS_BIGENDIAN) - memcpy (mem, ((cob_u8_t*)&val) + (sizeof(cob_s64_t) - len), len); -#else - memcpy (mem, ((cob_u8_t*)&val), len); -#endif -} - -cob_u64_t -cob_get_u64_compx (void *mem, int len) -{ - cob_u64_t ulong; - cob_u32_t uint; - cob_u16_t ushort; -#if defined(WORDS_BIGENDIAN) - switch (len) { - case sizeof(int): - memcpy (((cob_u8_t*)&uint), mem, sizeof(int)); - return uint; - default: /* Assume 64 bit value */ - case sizeof(cob_s64_t): - memcpy (((cob_u8_t*)&ulong), mem, sizeof(cob_s64_t)); - return ulong; - case sizeof(short): - memcpy (((cob_u8_t*)&ushort), mem, sizeof(short)); - return ushort; - case 1: - return *((cob_u8_t*)mem); - case 3: - case 5: - case 6: - case 7: - break; - } - ulong = 0; - memcpy (((cob_u8_t*)&ulong) + (sizeof(cob_s64_t) - len), mem, len); - return ulong; -#else - switch (len) { - case sizeof(int): - memcpy (((cob_u8_t*)&uint), mem, sizeof(int)); - return COB_BSWAP_32(uint); - default: /* Assume 64 bit value */ - case sizeof(cob_s64_t): - memcpy (((cob_u8_t*)&ulong), mem, sizeof(cob_s64_t)); - return COB_BSWAP_64(ulong); - case sizeof(short): - memcpy (((cob_u8_t*)&ushort), mem, sizeof(short)); - return COB_BSWAP_16(ushort); - case 1: - return (*(cob_u8_t*)mem); - case 3: - case 5: - case 6: - case 7: - break; - } - ulong = 0; - memcpy (((cob_u8_t*)&ulong) + (sizeof(cob_s64_t) - len), mem, len); - return COB_BSWAP_64(ulong); -#endif -} - -cob_u64_t -cob_get_u64_comp5 (void *mem, int len) -{ - cob_u64_t ulong; - cob_u32_t uint; - cob_u16_t ushort; - switch (len) { - case sizeof(int): - memcpy (((cob_u8_t*)&uint), mem, sizeof(int)); - return uint; - default: /* Assume 64 bit value */ - case sizeof(cob_s64_t): - memcpy (((cob_u8_t*)&ulong), mem, sizeof(cob_s64_t)); - return ulong; - case sizeof(short): - memcpy (((cob_u8_t*)&ushort), mem, sizeof(short)); - return ushort; - case 1: - return *((cob_u8_t*)mem); - case 3: - case 5: - case 6: - case 7: - break; - } - ulong = 0; -#if defined(WORDS_BIGENDIAN) - memcpy (((cob_u8_t*)&ulong) + (sizeof(cob_s64_t) - len), mem, len); -#else - memcpy (((cob_u8_t*)&ulong), mem, len); -#endif - return ulong; -} - -cob_s64_t -cob_get_s64_comp5 (void *mem, int len) -{ - cob_s64_t slong; - int sint; - short sshort; - switch (len) { - case sizeof(int): - memcpy (((void *)&sint), mem, sizeof(int)); - return sint; - default: /* Assume 64 bit value */ - case sizeof(cob_s64_t): - memcpy (((void*)&slong), mem, sizeof(cob_s64_t)); - return slong; - case sizeof(short): - memcpy (((void*)&sshort), mem, sizeof(short)); - return sshort; - case 1: - return *((signed char*)mem); - case 3: - case 5: - case 6: - case 7: - break; - } - slong = 0; -#if defined(WORDS_BIGENDIAN) - if (((cob_u8_t*)mem)[0] & 0x80) { /* Negative value */ - slong = -1; - } - memcpy (((cob_u8_t*)&slong) + (sizeof(cob_s64_t) - len), mem, len); -#else - if (((cob_u8_t*)mem)[len - 1] & 0x80) { /* Negative value; 2s complement */ - slong = -1; - } - memcpy (((void*)&slong), mem, len); -#endif - return slong; -} - -cob_s64_t -cob_get_s64_compx (void *mem, int len) -{ - cob_s64_t slong; - int sint; - short sshort; - -#if defined(WORDS_BIGENDIAN) - switch (len) { - case sizeof(int): - memcpy (((cob_u8_t*)&sint), mem, sizeof(int)); - return sint; - default: /* Assume 64 bit value */ - case sizeof(cob_s64_t): - memcpy (((cob_u8_t*)&slong), mem, sizeof(cob_s64_t)); - return slong; - case sizeof(short): - memcpy (((cob_u8_t*)&sshort), mem, sizeof(short)); - return sshort; - case 1: - return *((signed char*)mem); - case 3: - case 5: - case 6: - case 7: - break; - } - slong = 0; - if (((cob_u8_t*)mem)[0] & 0x80) { /* Negative value */ - slong = -1; - } - memcpy (((cob_u8_t*)&slong) + (sizeof(cob_s64_t) - len), mem, len); - return slong; -#else - switch (len) { - case sizeof(int): - memcpy (((cob_u8_t*)&sint), mem, sizeof(int)); - sint = COB_BSWAP_32(sint); - return (cob_s64_t)sint; - default: /* Assume 64 bit value */ - case sizeof(cob_s64_t): - memcpy (((cob_u8_t*)&slong), mem, sizeof(cob_s64_t)); - slong = COB_BSWAP_64(slong); - return (cob_s64_t)slong; - case sizeof(short): - memcpy (((cob_u8_t*)&sshort), mem, sizeof(short)); - sshort = COB_BSWAP_16(sshort); - return (cob_s64_t)(sshort); - case 1: - return (*(signed char*)mem); - case 3: - case 5: - case 6: - case 7: - break; - } - slong = 0; - if (((cob_u8_t*)mem)[0] & 0x80) { /* Negative value; 2s complement */ - slong = -1; - } - memcpy (((cob_u8_t*)&slong) + (sizeof(cob_s64_t) - len), mem, len); - return (cob_s64_t)COB_BSWAP_64 (slong); -#endif -} - -void -cob_put_s64_comp3 (cob_s64_t val, void *mem, int len) -{ - int sign, dig1, dig2; - cob_s64_t num; - cob_u8_t *p = mem; - - if (val < 0) { - num = -val; - sign = 0x0D; - } else { - num = val; - sign = 0x0C; - } - memset (mem, 0, len); - p[--len] = (cob_u8_t)((((num % 10) << 4) | sign) & 0xFF); - num /= 10; - while (num > 0 - && len-- > 0) { - dig1 = num % 10; - num = num / 10; - dig2 = num % 10; - num = num / 10; - p[len] = (cob_u8_t) ((dig2 << 4) | dig1); - } -} - -void -cob_put_u64_comp3 (cob_u64_t val, void *mem, int len) -{ - int dig1, dig2; - cob_u64_t num = val; - cob_u8_t *p = mem; - - memset (mem, 0, len); - p[--len] = (cob_u8_t)((((num % 10) << 4) | 0x0F) & 0xFF); - num = num / 10; - while (num > 0 - && len-- > 0) { - dig1 = num % 10; - num = num / 10; - dig2 = num % 10; - num = num / 10; - p[len] = (cob_u8_t) ((dig2 << 4) | dig1); - } -} - -cob_s64_t -cob_get_s64_comp3 (void *mem, int len) -{ - int sign, j; - cob_s64_t val = 0; - cob_u8_t *p = mem; - - if ((p[len - 1] & 0x0F) == 0x0D) { - sign = -1; - } else { - sign = 1; - } - for (j = 0; j < len - 1; j++) { - val = val * 10 + ((unsigned int)(p[j] & 0xf0) >> 4); - val = val * 10 + (p[j] & 0x0f); - } - val = val * 10 + ((unsigned int)(p[len - 1] & 0xf0) >> 4); - - return val * sign; -} - -cob_u64_t -cob_get_u64_comp3 (void *mem, int len) -{ - int j; - cob_u64_t val = 0; - cob_u8_t *p = mem; - - for (j = 0; j < len - 1; j++) { - val = val * 10 + ((unsigned int)(p[j] & 0xF0) >> 4); - val = val * 10 + (p[j] & 0x0F); - } - val = val * 10 + ((unsigned int)(p[len - 1] & 0xF0) >> 4); - - return val; -} - -void -cob_put_u64_comp6 (cob_u64_t val, void *mem, int len) -{ - int dig1, dig2; - cob_u64_t num = val; - cob_u8_t *p = mem; - - memset (mem, 0, len); - while (num > 0 - && len-- > 0) { - dig1 = num % 10; - num = num / 10; - dig2 = num % 10; - num = num / 10; - p[len] = (cob_u8_t) ((dig2 << 4) | dig1); - } -} - -cob_u64_t -cob_get_u64_comp6 (void *mem, int len) -{ - int j; - cob_u64_t val = 0; - cob_u8_t *p = mem; - - for (j = 0; j < len; j++) { - val = val * 10 + ((unsigned int)(p[j] & 0xF0) >> 4); - val = val * 10 + (p[j] & 0x0F); - } - - return val; -} - -/* note: the 11th position is only there to keep the analyzer happy ...*/ -static char ebcdic_pos[11] = "{ABCDEFGHI"; -static char ebcdic_neg[11] = "}JKLMNOPQR"; - -void -cob_put_s64_pic9 (cob_s64_t val, void *mem, int len) -{ - cob_s64_t num; - cob_u8_t *p = mem; - - if (!cobglobptr || !COB_MODULE_PTR) { - return; - } - - memset (mem, '0', len); - if (val < 0) { - num = -val; - if (COB_MODULE_PTR->ebcdic_sign) { - p[--len] = (cob_u8_t)ebcdic_neg[num % 10]; - } else { - p[--len] = (cob_u8_t)('0' + (num % 10)) | 0x40; - } - } else { - num = val; - if (COB_MODULE_PTR->ebcdic_sign) { - p[--len] = (cob_u8_t)ebcdic_pos[num % 10]; - } else { - p[--len] = (cob_u8_t)('0' + (num % 10)); - } - } - num = num / 10; - while (num > 0 - && len-- > 0) { - p[len] = (cob_u8_t) ('0' + num % 10); - num = num / 10; - } -} - -cob_s64_t -cob_get_s64_pic9 (void *mem, int len) -{ - cob_s64_t val = 0; - cob_u8_t *p = mem; - int sign = 1; - - while (len-- > 1) { - if (isdigit (*p)) { - val = val * 10 + (*p - '0'); - } else if (*p == '-') { - sign = -1; - } - p++; - } - if (isdigit (*p)) { - val = val * 10 + (*p - '0'); - } else if (*p == '-') { - sign = -1; - } else if (*p == '+') { - sign = 1; - } else if (COB_MODULE_PTR->ebcdic_sign) { - switch(*p) { - case '{': val = val * 10 + 0; sign = 1; break; - case 'A': val = val * 10 + 1; sign = 1; break; - case 'B': val = val * 10 + 2; sign = 1; break; - case 'C': val = val * 10 + 3; sign = 1; break; - case 'D': val = val * 10 + 4; sign = 1; break; - case 'E': val = val * 10 + 5; sign = 1; break; - case 'F': val = val * 10 + 6; sign = 1; break; - case 'G': val = val * 10 + 7; sign = 1; break; - case 'H': val = val * 10 + 8; sign = 1; break; - case 'I': val = val * 10 + 9; sign = 1; break; - case '}': val = val * 10 + 0; sign = -1; break; - case 'J': val = val * 10 + 1; sign = -1; break; - case 'K': val = val * 10 + 2; sign = -1; break; - case 'L': val = val * 10 + 3; sign = -1; break; - case 'M': val = val * 10 + 4; sign = -1; break; - case 'N': val = val * 10 + 5; sign = -1; break; - case 'O': val = val * 10 + 6; sign = -1; break; - case 'P': val = val * 10 + 7; sign = -1; break; - case 'Q': val = val * 10 + 8; sign = -1; break; - case 'R': val = val * 10 + 9; sign = -1; break; - } - } else if (isdigit (*p & 0x3F)) { - val = val * 10 + (*p & 0x0F); - if (*p & 0x40) { - sign = -1; - } - } - - return val * sign; -} - -void -cob_put_u64_pic9 (cob_u64_t val, void *mem, int len) -{ - cob_u64_t num = val; - cob_u8_t *p = mem; - - memset (mem, '0', len); - while (num > 0 - && len-- > 0) { - p[len] = (cob_u8_t) ('0' + num % 10); - num = num / 10; - } -} - -cob_u64_t -cob_get_u64_pic9 (void *mem, int len) -{ - cob_u64_t val = 0; - cob_u8_t *p = mem; - - while (len-- > 0) { - if (isdigit (*p)) { - val = val * 10 + (*p - '0'); - } - p++; - } - - return val; -} - -void -cob_put_comp1 (float val, void *mem) -{ - memcpy (mem, &val, sizeof(float)); -} -void -cob_put_comp2 (double val, void *mem) -{ - memcpy (mem, &val, sizeof(double)); -} -float -cob_get_comp1 (void *mem) -{ - float val; - memcpy (&val, mem, sizeof(float)); - return val; -} -double -cob_get_comp2 (void *mem) -{ - double val; - memcpy (&val, mem, sizeof(double)); - return val; -} - -void -cob_put_pointer (void *val, void *mem) -{ - memcpy (mem, &val, sizeof(void *)); -} - -char * -cob_get_picx (void *cbl_data, size_t len, void *char_field, size_t num_chars) -{ - size_t i; - cob_u8_t *p = cbl_data; - - for (i = len; i != 0 && (p[i - 1] == ' ' || p[i - 1] == 0); i--); - - if (char_field == NULL) { - num_chars = i + 1; - char_field = cob_malloc (num_chars); - } - - if (i > num_chars - 1) { - i = num_chars - 1; - } - - memcpy (char_field, cbl_data, i); - ((char*)char_field)[i] = 0; - return char_field; -} - -void -cob_put_picx( void *cbl_data, size_t len, void *string) -{ - size_t i, j; - cob_u8_t *p = cbl_data; - j = strlen ((char*)string); - if (j > len) { - j = len; - } - memcpy (cbl_data, string, j); - for (i = j; i < len; i++) { - p[i] = ' '; - } -} diff -Nru gnucobol-4.0~early~20200606/libcob/numeric.c gnucobol-5/libcob/numeric.c --- gnucobol-4.0~early~20200606/libcob/numeric.c 2020-06-06 20:52:01.000000000 +0000 +++ gnucobol-5/libcob/numeric.c 1970-01-01 00:00:00.000000000 +0000 @@ -1,2670 +0,0 @@ -/* - Copyright (C) 2001-2012, 2014-2019 Free Software Foundation, Inc. - Written by Keisuke Nishida, Roger While, Simon Sobisch, Ron Norman - - This file is part of GnuCOBOL. - - The GnuCOBOL runtime library is free software: you can redistribute it - and/or modify it under the terms of the GNU Lesser General Public License - as published by the Free Software Foundation, either version 3 of the - License, or (at your option) any later version. - - GnuCOBOL is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU Lesser General Public License for more details. - - You should have received a copy of the GNU Lesser General Public License - along with GnuCOBOL. If not, see . -*/ - - -#include - -#ifndef _GNU_SOURCE -#define _GNU_SOURCE 1 -#endif - -#include -#include -#include -#include -#include -#include -#include - -#include -#ifdef HAVE_FINITE_IEEEFP_H -#include -#endif - -#ifdef _WIN32 -#ifndef isnan -#define isnan(x) _isnan(x) -#endif -#endif - -#if !defined(isinf) -#if defined(_WIN32) -#define isinf(x) ((_fpclass(x) == _FPCLASS_PINF) || (_fpclass(x) == _FPCLASS_NINF)) -#else -#define isinf(x) (!ISFINITE(x)) -#endif -#endif - -/* Force symbol exports, include decimal definitions */ -#define COB_LIB_EXPIMP -#include "gmp.h" -#include "libcob.h" -#include "coblocal.h" - -#define DECIMAL_CHECK(d1,d2) \ - if (unlikely (d1->scale == COB_DECIMAL_NAN || \ - d2->scale == COB_DECIMAL_NAN)) { \ - d1->scale = COB_DECIMAL_NAN; \ - return; \ - } - -/* Local variables */ - -static cob_global *cobglobptr; - -static const unsigned char packed_bytes[] = { - 0x00, 0x01, 0x02, 0x03, 0x04, 0x05, 0x06, 0x07, 0x08, 0x09, - 0x10, 0x11, 0x12, 0x13, 0x14, 0x15, 0x16, 0x17, 0x18, 0x19, - 0x20, 0x21, 0x22, 0x23, 0x24, 0x25, 0x26, 0x27, 0x28, 0x29, - 0x30, 0x31, 0x32, 0x33, 0x34, 0x35, 0x36, 0x37, 0x38, 0x39, - 0x40, 0x41, 0x42, 0x43, 0x44, 0x45, 0x46, 0x47, 0x48, 0x49, - 0x50, 0x51, 0x52, 0x53, 0x54, 0x55, 0x56, 0x57, 0x58, 0x59, - 0x60, 0x61, 0x62, 0x63, 0x64, 0x65, 0x66, 0x67, 0x68, 0x69, - 0x70, 0x71, 0x72, 0x73, 0x74, 0x75, 0x76, 0x77, 0x78, 0x79, - 0x80, 0x81, 0x82, 0x83, 0x84, 0x85, 0x86, 0x87, 0x88, 0x89, - 0x90, 0x91, 0x92, 0x93, 0x94, 0x95, 0x96, 0x97, 0x98, 0x99 -}; - -static cob_decimal cob_d1; -static cob_decimal cob_d2; -static cob_decimal cob_d3; -static cob_decimal cob_d_remainder; - -static cob_decimal *cob_decimal_base; - -static mpz_t cob_mexp; -static mpz_t cob_mpzt; -static mpz_t cob_mpzt2; -static mpz_t cob_mpz_ten34m1; -static mpz_t cob_mpz_ten16m1; -static mpz_t cob_mpze10[COB_MAX_BINARY]; - -static mpf_t cob_mpft; -static mpf_t cob_mpft_get; - -static unsigned char packed_value[20]; -static cob_u64_t last_packed_val; -static int cob_not_finite = 0; - - -#ifdef COB_EXPERIMENTAL - -#if GMP_NAIL_BITS != 0 -#error NAILS not supported -#endif - -#define COB_MAX_LL COB_S64_C(9223372036854775807) - -static void -mpz_set_ull (mpz_ptr dest, const cob_u64_t val) -{ - size_t size; - - size = (val != 0); - dest->_mp_d[0] = val & GMP_NUMB_MASK; -#if GMP_LIMB_BITS < 64 - if (val > GMP_NUMB_MAX) { - dest->_mp_d[1] = val >> GMP_NUMB_BITS; - size = 2; - } -#endif - dest->_mp_size = size; -} - -static void -mpz_set_sll (mpz_ptr dest, const cob_s64_t val) -{ - cob_u64_t vtmp; - size_t size; - - vtmp = (cob_u64_t)(val >= 0 ? (cob_u64_t)val : -(cob_u64_t)val); - size = (vtmp != 0); - dest->_mp_d[0] = vtmp & GMP_NUMB_MASK; -#if GMP_LIMB_BITS < 64 - if (vtmp > GMP_NUMB_MAX) { - dest->_mp_d[1] = vtmp >> GMP_NUMB_BITS; - size = 2; - } -#endif - dest->_mp_size = (val >= 0) ? size : -size; -} - -static cob_u64_t -mpz_get_ull (const mpz_ptr src) -{ - size_t size; - - size = mpz_size (src); - if (!size) { - return 0; - } -#if GMP_LIMB_BITS > 32 - return (cob_u64_t)src->_mp_d[0]; -#else - if (size < 2) { - return (cob_u64_t)src->_mp_d[0]; - } - return (cob_u64_t)src->_mp_d[0] | - ((cob_u64_t)src->_mp_d[1] << GMP_NUMB_BITS); -#endif -} - -static cob_s64_t -mpz_get_sll (const mpz_ptr src) -{ - int size; - cob_u64_t vtmp; - - size = src->_mp_size; - if (!size) { - return 0; - } - vtmp = (cob_u64_t)src->_mp_d[0]; -#if GMP_LIMB_BITS < 64 - if (mpz_size (src) > 1) { - vtmp |= (cob_u64_t)src->_mp_d[1] << GMP_NUMB_BITS; - } -#endif - if (size > 0) { - return (cob_s64_t) vtmp & COB_MAX_LL; - } - return ~(((cob_s64_t) vtmp - 1LL) & COB_MAX_LL); -} - -#endif /* COB_EXPERIMENTAL */ - - -void -cob_gmp_free (void * ptr) { -/* mpir/gmp free functions */ -#ifdef HAVE_MP_GET_MEMORY_FUNCTIONS - void (*freefunc)(void *, size_t); - mp_get_memory_functions (NULL, NULL, &freefunc); - freefunc (ptr, strlen((char*) ptr) + 1); -#else - free (ptr); -#endif -} - -static COB_INLINE COB_A_INLINE void -num_byte_memcpy (unsigned char *s1, const unsigned char *s2, size_t size) -{ - do { - *s1++ = *s2++; - } while (--size); -} - -static COB_INLINE COB_A_INLINE cob_s64_t -cob_binary_get_sint64 (const cob_field * const f) -{ - cob_s64_t n = 0; - size_t fsiz = 8U - f->size; - -#ifndef WORDS_BIGENDIAN - if (COB_FIELD_BINARY_SWAP (f)) { - num_byte_memcpy ((unsigned char *)&n, f->data, f->size); - n = COB_BSWAP_64 (n); - /* Shift with sign */ - n >>= (cob_s64_t)8 * fsiz; - } else { - num_byte_memcpy (((unsigned char *)&n) + fsiz, f->data, f->size); - /* Shift with sign */ - n >>= (cob_s64_t)8 * fsiz; - } -#else /* WORDS_BIGENDIAN */ - num_byte_memcpy ((unsigned char *)&n, f->data, f->size); - /* Shift with sign */ - n >>= 8 * fsiz; -#endif /* WORDS_BIGENDIAN */ - - return n; -} - -static COB_INLINE COB_A_INLINE cob_u64_t -cob_binary_get_uint64 (const cob_field * const f) -{ - cob_u64_t n = 0; - size_t fsiz = 8U - f->size; - -#ifndef WORDS_BIGENDIAN - if (COB_FIELD_BINARY_SWAP (f)) { - num_byte_memcpy (((unsigned char *)&n) + fsiz, f->data, f->size); - n = COB_BSWAP_64 (n); - } else { - num_byte_memcpy ((unsigned char *)&n, f->data, f->size); - } -#else /* WORDS_BIGENDIAN */ - num_byte_memcpy (((unsigned char *)&n) + fsiz, f->data, f->size); -#endif /* WORDS_BIGENDIAN */ - - return n; -} - -static COB_INLINE COB_A_INLINE void -cob_binary_set_uint64 (cob_field *f, cob_u64_t n) -{ -#ifndef WORDS_BIGENDIAN - unsigned char *s; - - if (COB_FIELD_BINARY_SWAP (f)) { - n = COB_BSWAP_64 (n); - s = ((unsigned char *)&n) + 8 - f->size; - } else { - s = (unsigned char *)&n; - } - num_byte_memcpy (f->data, s, f->size); -#else /* WORDS_BIGENDIAN */ - num_byte_memcpy (f->data, ((unsigned char *)&n) + 8 - f->size, f->size); -#endif /* WORDS_BIGENDIAN */ -} - -static COB_INLINE COB_A_INLINE void -cob_binary_set_int64 (cob_field *f, cob_s64_t n) -{ -#ifndef WORDS_BIGENDIAN - unsigned char *s; - - if (COB_FIELD_BINARY_SWAP (f)) { - n = COB_BSWAP_64 (n); - s = ((unsigned char *)&n) + 8 - f->size; - } else { - s = (unsigned char *)&n; - } - num_byte_memcpy (f->data, s, f->size); -#else /* WORDS_BIGENDIAN */ - num_byte_memcpy (f->data, ((unsigned char *)&n) + 8 - f->size, f->size); -#endif /* WORDS_BIGENDIAN */ -} - -/* Decimal number */ - -void -cob_decimal_init2 (cob_decimal *d, const cob_uli_t initial_num_bits) -{ - mpz_init2 (d->value, initial_num_bits); - d->scale = 0; -} - -void -cob_decimal_init (cob_decimal *d) -{ - cob_decimal_init2 (d, COB_MPZ_DEF); -} - -void -cob_decimal_clear (cob_decimal *d) -{ - if (d) { - mpz_clear (d->value); - d->scale = 0; - } -} - -/** setting a decimal field from an unsigned binary long int */ -void -cob_decimal_set_ullint (cob_decimal *d, const cob_u64_t n) -{ -#ifdef COB_LI_IS_LL - mpz_set_ui (d->value, (cob_uli_t)n); -#else - mpz_set_ui (d->value, (cob_uli_t)(n >> 32)); - mpz_mul_2exp (d->value, d->value, 32); - mpz_add_ui (d->value, d->value, (cob_uli_t)(n & 0xFFFFFFFFU)); -#endif - d->scale = 0; -} - -/** setting a decimal field from a signed binary long int */ -void -cob_decimal_set_llint (cob_decimal *d, const cob_s64_t n) -{ -#ifdef COB_LI_IS_LL - mpz_set_si (d->value, (cob_sli_t)n); -#else - cob_u64_t uval; - cob_u32_t negative; - - negative = 0; - if (n < 0) { - negative = 1; - uval = (cob_u64_t)-n; - } else { - uval = (cob_u64_t)n; - } - mpz_set_ui (d->value, (cob_uli_t)(uval >> 32)); - mpz_mul_2exp (d->value, d->value, 32); - mpz_add_ui (d->value, d->value, (cob_uli_t)(uval & 0xFFFFFFFFU)); - if (negative) { - mpz_neg (d->value, d->value); - } -#endif - d->scale = 0; -} - -/* Decimal <-> Decimal */ - -static COB_INLINE COB_A_INLINE void -cob_decimal_set (cob_decimal *dst, const cob_decimal *src) -{ - mpz_set (dst->value, src->value); - dst->scale = src->scale; -} - -/* Decimal print */ -static void -cob_decimal_print (cob_decimal *d, FILE *fp) -{ - int scale, len; - char wrk[256]; - - if (unlikely (d->scale == COB_DECIMAL_NAN)) { - fprintf (fp, "(Nan)"); - return; - } - if (unlikely (d->scale == COB_DECIMAL_INF)) { - fprintf (fp, "(Inf)"); - return; - } - if (!mpz_sgn (d->value)) { - fprintf (fp, "0E0"); - return; - } - mpz_set (cob_mpzt2, d->value); - scale = d->scale; - for ( ; ; ) { - if (!mpz_divisible_ui_p (cob_mpzt2, 10UL)) { - break; - } - mpz_tdiv_q_ui (cob_mpzt2, cob_mpzt2, 10UL); - scale--; - } - len = gmp_sprintf (wrk, "%Zd", cob_mpzt2); - if (len > 0 - && scale > 0 - && scale < len) { - fprintf (fp, "%.*s%c%.*s",len-scale,wrk,'.',scale,wrk+len-scale); - } else if (scale == 0) { - fprintf (fp, "%s", wrk); - } else { - fprintf (fp, "%sE%d", wrk, -scale); - } -} - -/* d->value *= 10^n, d->scale += n */ -static void -shift_decimal (cob_decimal *d, const int n) -{ - if (n == 0) { - return; - } - if (n > 0) { - mpz_ui_pow_ui (cob_mexp, 10UL, (cob_uli_t)n); - mpz_mul (d->value, d->value, cob_mexp); - } else { - mpz_ui_pow_ui (cob_mexp, 10UL, (cob_uli_t)-n); - mpz_tdiv_q (d->value, d->value, cob_mexp); - } - d->scale += n; -} - -/* Align decimal */ -static void -align_decimal (cob_decimal *d1, cob_decimal *d2) -{ - if (d1->scale < d2->scale) { - shift_decimal (d1, d2->scale - d1->scale); - } else if (d1->scale > d2->scale) { - shift_decimal (d2, d1->scale - d2->scale); - } -} - -/* IEEE 754 floats */ - -static void -cob_decimal_adjust (cob_decimal *d, mpz_t max_value, int min_exp, int max_exp) -{ - if (mpz_cmpabs (d->value, max_value) > 0) { - /* Adjust by 100000000 to get close */ - while (mpz_cmpabs (d->value, max_value) > 0 - && mpz_divisible_ui_p (d->value, 100000000UL)) { - if (d->scale-8 < min_exp) - break; - mpz_tdiv_q_ui (d->value, d->value, 100000000UL); - d->scale -= 8; - } - /* Adjust by 1000 to get close */ - while (mpz_cmpabs (d->value, max_value) > 0 - && mpz_divisible_ui_p (d->value, 1000UL)) { - if (d->scale-3 < min_exp) - break; - mpz_tdiv_q_ui (d->value, d->value, 1000UL); - d->scale -= 3; - } - } - /* Remove trailing ZEROS */ - while (mpz_divisible_ui_p (d->value, 10UL) - || mpz_cmpabs (d->value, max_value) > 0) { - if (d->scale < min_exp) - break; - mpz_tdiv_q_ui (d->value, d->value, 10UL); - d->scale--; - } - if (mpz_cmpabs (d->value, max_value) > 0 - || d->scale < min_exp - || d->scale > max_exp) { - cob_set_exception (COB_EC_SIZE_OVERFLOW); - return; - } -} - -static int -cob_decimal_get_ieee64dec (cob_decimal *d, cob_field *f, const int opt) -{ - int sign; - cob_u64_t expo; - cob_u64_t data; - - sign = mpz_sgn (d->value); - if (!sign) { - memset (f->data, 0, (size_t)8); - return 0; - } - if (sign < 0) { - mpz_neg (d->value, d->value); - } - cob_decimal_adjust (d, cob_mpz_ten16m1, -369, 398); - if (mpz_cmpabs (d->value, cob_mpz_ten16m1) > 0) { - if (opt & COB_STORE_KEEP_ON_OVERFLOW) { - cob_set_exception (COB_EC_SIZE_OVERFLOW); - return cobglobptr->cob_exception_code; - } - for ( ; ; ) { - if (d->scale < -369) - break; - mpz_tdiv_q_ui (d->value, d->value, 10UL); - d->scale--; - if (mpz_cmpabs (d->value, cob_mpz_ten16m1) < 0) { - break; - } - } - } - if (d->scale < -369 || d->scale > 398) { - cob_set_exception (COB_EC_SIZE_OVERFLOW); - return cobglobptr->cob_exception_code; - } - expo = (cob_u64_t)398 - d->scale; - - data = 0; - mpz_export (&data, NULL, -1, (size_t)8, COB_MPZ_ENDIAN, (size_t)0, d->value); - /* Move in exponent */ - if (mpz_sizeinbase (d->value, 2) > 53U) { - data &= COB_64_SIGF_2; - data |= (expo << 51U) | COB_DEC_EXTEND; - } else { - data &= COB_64_SIGF_1; - data |= (expo << 53U); - } - if (sign < 0) { - data |= COB_DEC_SIGN; - } - memcpy (f->data, &data, (size_t)8); - return 0; -} - -static void -cob_decimal_set_ieee64dec (cob_decimal *d, const cob_field *f) -{ - cob_u64_t expo; - cob_u64_t sign; - cob_u64_t data; - - /* bit 0 : sign bit */ - /* bits 1 - 4 : combination field */ - /* combination = 15 (all bits set) is inf/nan */ - /* combination > 11 (bits 1100) is extended exponent */ - /* Exponent length - 10 bits */ - - memcpy (&data, f->data, sizeof(data)); - sign = data & COB_DEC_SIGN; - if (COB_64_IS_SPECIAL (data)) { - /* Inf / Nan */ - mpz_set_ui (d->value, 1UL); - d->scale = COB_DECIMAL_NAN; - return; - } - if (COB_64_IS_EXTEND (data)) { - expo = (data & COB_64_EXPO_2) >> 51U; - data &= COB_64_SIGF_2; - data |= COB_64_OR_EXTEND; - if (data > COB_U64_C(9999999999999999)) { - mpz_set_ui (d->value, 0UL); - d->scale = 0; - return; - } - } else { - expo = (data & COB_64_EXPO_1) >> 53U; - data &= COB_64_SIGF_1; - } - if (!data) { - /* Significand 0 */ - mpz_set_ui (d->value, 0UL); - d->scale = 0; - return; - } -#ifdef COB_LI_IS_LL - mpz_set_ui (d->value, data); -#else - mpz_set_ui (d->value, (cob_uli_t)(data >> 32)); - mpz_mul_2exp (d->value, d->value, 32); - mpz_add_ui (d->value, d->value, (cob_uli_t)(data & 0xFFFFFFFFU)); -#endif - - d->scale = (int)expo - 398; - if (d->scale > 0) { - mpz_ui_pow_ui (cob_mexp, 10UL, (cob_uli_t)d->scale); - mpz_mul (d->value, d->value, cob_mexp); - d->scale = 0; - } else if (d->scale < 0) { - d->scale = -(d->scale); - } - if (sign) { - mpz_neg (d->value, d->value); - } - if (d->scale < -369 || d->scale > 398) { - cob_set_exception (COB_EC_SIZE_OVERFLOW); - return; - } -} - -static int -cob_decimal_get_ieee128dec (cob_decimal *d, cob_field *f, const int opt) -{ - cob_u64_t expo; - cob_u64_t data[2]; - int sign; - - sign = mpz_sgn (d->value); - if (!sign) { - memset (f->data, 0, (size_t)16); - return 0; - } - if (sign < 0) { - mpz_neg (d->value, d->value); - } - cob_decimal_adjust (d, cob_mpz_ten34m1, -6111, 6176); - if (mpz_cmpabs (d->value, cob_mpz_ten34m1) > 0) { - if (opt & COB_STORE_KEEP_ON_OVERFLOW) { - cob_set_exception (COB_EC_SIZE_OVERFLOW); - return cobglobptr->cob_exception_code; - } - for ( ; ; ) { - if (d->scale < -6111) - break; - mpz_tdiv_q_ui (d->value, d->value, 10UL); - d->scale--; - if (mpz_cmpabs (d->value, cob_mpz_ten34m1) < 0) { - break; - } - } - } - if (d->scale < -6111 || d->scale > 6176) { - cob_set_exception (COB_EC_SIZE_OVERFLOW); - return cobglobptr->cob_exception_code; - } - expo = (cob_u64_t)6176 - d->scale; - - data[0] = 0; - data[1] = 0; - mpz_export (data, NULL, -1, (size_t)16, COB_MPZ_ENDIAN, (size_t)0, d->value); - /* Move in exponent */ - COB_128_MSW(data) &= COB_128_SIGF_1; - COB_128_MSW(data) |= (expo << 49U); - if (sign < 0) { - COB_128_MSW(data) |= COB_DEC_SIGN; - } - memcpy (f->data, data, (size_t)16); - return 0; -} - -static void -cob_decimal_set_ieee128dec (cob_decimal *d, const cob_field *f) -{ - cob_u64_t expo; - cob_u64_t sign; - cob_u64_t data[2]; - - /* bit 0 : sign bit */ - /* bits 1 - 4 : combination field */ - /* combination = 15 (all bits set) is inf/nan */ - /* combination > 11 (bits 1100) is extended exponent */ - /* Exponent length - 14 bits */ - - memcpy (data, f->data, sizeof(data)); - sign = COB_128_MSW(data) & COB_DEC_SIGN; - if (COB_128_IS_SPECIAL (data)) { - /* Inf / Nan */ - mpz_set_ui (d->value, 1UL); - d->scale = COB_DECIMAL_NAN; - return; - } - if (COB_128_IS_EXTEND (data)) { - expo = (COB_128_MSW(data) & COB_128_EXPO_2) >> 47U; - COB_128_MSW(data) &= COB_128_SIGF_2; - COB_128_MSW(data) |= COB_128_OR_EXTEND; - } else { - expo = (COB_128_MSW(data) & COB_128_EXPO_1) >> 49U; - COB_128_MSW(data) &= COB_128_SIGF_1; - } - if (!COB_128_MSW(data) && !COB_128_LSW(data)) { - /* Significand 0 */ - mpz_set_ui (d->value, 0UL); - d->scale = 0; - return; - } -#ifdef COB_LI_IS_LL - mpz_set_ui (d->value, COB_128_MSW(data)); - mpz_mul_2exp (d->value, d->value, 64UL); - mpz_add_ui (d->value, d->value, COB_128_LSW(data)); -#else - /* RXWRXW - Fixme */ - mpz_set_ui (d->value, (cob_uli_t)(COB_128_MSW(data) >> 32U)); - mpz_mul_2exp (d->value, d->value, 32UL); - mpz_add_ui (d->value, d->value, (cob_uli_t)(COB_128_MSW(data) & 0xFFFFFFFFU)); - mpz_mul_2exp (d->value, d->value, 32UL); - mpz_add_ui (d->value, d->value, (cob_uli_t)(COB_128_LSW(data) >> 32U)); - mpz_mul_2exp (d->value, d->value, 32UL); - mpz_add_ui (d->value, d->value, (cob_uli_t)(COB_128_LSW(data) & 0xFFFFFFFFU)); -#endif - - d->scale = (int)expo - 6176; - if (d->scale > 0) { - mpz_ui_pow_ui (cob_mexp, 10UL, (cob_uli_t)d->scale); - mpz_mul (d->value, d->value, cob_mexp); - d->scale = 0; - } else if (d->scale < 0) { - d->scale = -(d->scale); - } - if (sign) { - mpz_neg (d->value, d->value); - } - cob_decimal_adjust (d, cob_mpz_ten34m1, -6111, 6176); - if (mpz_cmpabs (d->value, cob_mpz_ten34m1) > 0) { - /* Non-canonical */ - cob_set_exception (COB_EC_SIZE_OVERFLOW); - mpz_set_ui (d->value, 0UL); - d->scale = 0; - return; - } -} - -/* Double */ - -static void -cob_decimal_set_double (cob_decimal *d, const double v) -{ - char *p; - char *q; - cob_u64_t t1; - cob_sli_t scale; - cob_sli_t len; - int sign; - union { - double d1; - cob_u64_t l1; - } ud; - - memset (&t1, ' ', sizeof(t1)); - ud.d1 = v; - if (ud.l1 == 0 || ud.l1 == t1 || !ISFINITE (v)) { - mpz_set_ui (d->value, 0UL); - d->scale = 0; - return; - } - - sign = 0; - mpf_set_d (cob_mpft, v); - - q = mpf_get_str (NULL, &scale, 10, (size_t)96, cob_mpft); - if (!*q) { - mpz_set_ui (d->value, 0UL); - d->scale = 0; - cob_gmp_free(q); - return; - } - p = q; - if (*p == '-') { - sign = 1; - ++p; - } - - mpz_set_str (d->value, p, 10); - - len = (cob_sli_t)strlen (p); - len -= scale; - if (len >= 0) { - d->scale = len; - } else { - mpz_ui_pow_ui (cob_mexp, 10UL, (cob_uli_t)-len); - mpz_mul (d->value, d->value, cob_mexp); - d->scale = 0; - } - - if (sign) { - mpz_neg (d->value, d->value); - } - cob_gmp_free(q); -} - -static double -cob_decimal_get_double (cob_decimal *d) -{ - double v; - cob_sli_t n; - - cob_not_finite = 0; - v = 0.0; - if (unlikely (mpz_size (d->value) == 0)) { - return v; - } - - mpf_set_z (cob_mpft, d->value); - - n = d->scale; - if (n < 0) { - mpz_ui_pow_ui (cob_mexp, 10UL, (cob_uli_t)-n); - mpf_set_z (cob_mpft_get, cob_mexp); - mpf_mul (cob_mpft, cob_mpft, cob_mpft_get); - } else if (n > 0) { - mpz_ui_pow_ui (cob_mexp, 10UL, (cob_uli_t)n); - mpf_set_z (cob_mpft_get, cob_mexp); - mpf_div (cob_mpft, cob_mpft, cob_mpft_get); - } - - v = mpf_get_d (cob_mpft); - if (!ISFINITE (v)) { - cob_not_finite = 1; - v = 0.0; - } - return v; -} - -/* PACKED-DECIMAL */ - -static int -cob_packed_get_sign (const cob_field *f) -{ - unsigned char *p; - - if (!COB_FIELD_HAVE_SIGN (f) || COB_FIELD_NO_SIGN_NIBBLE (f)) { - return 0; - } - p = f->data + f->size - 1; - return ((*p & 0x0FU) == 0x0DU) ? -1 : 1; -} - -#if 0 /* RXWRXW - Buggy */ -static void -cob_complement_packed (cob_field *f) -{ - unsigned char *p; - int ndigs; - int tval; - int carry = 0; - unsigned int msn; - - ndigs = COB_FIELD_DIGITS(f) - COB_FIELD_SCALE(f); - if (COB_FIELD_NO_SIGN_NIBBLE (f)) { - msn = COB_FIELD_SCALE(f) % 2; - } else { - msn = 1 - (COB_FIELD_SCALE(f) % 2); - } - - p = f->data + (ndigs / 2) - (1 - msn); - while (ndigs--) { - if (!msn) { - tval = *p & 0x0F; - } else { - tval = (*p & 0xF0) >> 4; - } - tval += carry; - if (tval > 0) { - carry = 1; - tval= 10 - tval; - } else { - carry = 0; - } - if (!msn) { - *p = (*p & 0xF0) | tval; - msn = 1; - } else { - *p = (*p & 0x0F) | (tval << 4); - msn = 0; - p--; - } - } -} - -static int -cob_add_packed (cob_field *f, int val, const int opt) -{ - unsigned char *p; - int sign; - int ndigs; - int tval; - int carry = 0; - unsigned int msn; - unsigned int subtr = 0; - unsigned int zeroes = 0; - unsigned int origdigs; - unsigned char savedata[256]; - - ndigs = COB_FIELD_DIGITS(f) - COB_FIELD_SCALE(f); - if (ndigs <= 0) { - return 0; - } - - if (opt & COB_STORE_KEEP_ON_OVERFLOW) { - memcpy (savedata, f->data, f->size); - } - - sign = cob_packed_get_sign (f); - - if (COB_FIELD_NO_SIGN_NIBBLE (f)) { - msn = COB_FIELD_SCALE(f) % 2; - } else { - msn = 1 - (COB_FIELD_SCALE(f) % 2); - } - - /* -x +v = -(x - v), -x -v = -(x + v) */ - if (sign < 0) { - val = -val; - } - if (val < 0) { - val = -val; - subtr = 1; - } - p = f->data + (ndigs / 2) - (1 - msn); - origdigs = ndigs; - while (ndigs--) { - if (val) { - carry += (val % 10); - val /= 10; - } - if (!msn) { - tval = *p & 0x0F; - } else { - tval = (*p & 0xF0) >> 4; - } - if (subtr) { - tval -= carry; - if (tval < 0) { - tval += 10; - carry = 1; - } else { - carry = 0; - } - } else { - tval += carry; - if (tval > 9) { - tval = (tval + 6) & 0x0F; - carry = 1; - } else { - carry = 0; - } - } - if (tval == 0) { - zeroes++; - } - if (!msn) { - *p = (*p & 0xF0) | tval; - msn = 1; - } else { - *p = (*p & 0x0F) | (tval << 4); - msn = 0; - p--; - } - } - if (sign) { - p = f->data + f->size - 1; - if (origdigs == zeroes) { - *p = (*p & 0xF0) | 0x0C; - } else if (subtr && carry) { - cob_complement_packed (f); - sign = -sign; - if (sign < 0) { - *p = (*p & 0xF0) | 0x0D; - } else { - *p = (*p & 0xF0) | 0x0C; - } - } - } else if (subtr && carry) { - cob_complement_packed (f); - } - if (opt && (carry || val)) { - /* Overflow */ - cob_set_exception (COB_EC_SIZE_OVERFLOW); - /* If we need to throw an exception */ - if (opt & COB_STORE_KEEP_ON_OVERFLOW) { - memcpy (f->data, savedata, f->size); - return cobglobptr->cob_exception_code; - } - } - return 0; -} -#endif - -void -cob_set_packed_zero (cob_field *f) -{ - memset (f->data, 0, f->size); - if (COB_FIELD_NO_SIGN_NIBBLE (f)) { - return; - } - if (!COB_FIELD_HAVE_SIGN (f)) { - *(f->data + f->size - 1) = 0x0F; - } else { - *(f->data + f->size - 1) = 0x0C; - } -} - -static void -cob_decimal_set_packed (cob_decimal *d, cob_field *f) -{ - unsigned char *p; - unsigned char *endp; - int digits; - int sign; - int nibtest; - unsigned int byteval; - unsigned int nonzero; - - p = f->data; - digits = COB_FIELD_DIGITS (f); -#if 0 /* RXWRXW - P Fix */ - if (digits > (f->size * 2) - 1) { - digits = (f->size * 2) - 1; - } -#endif - sign = cob_packed_get_sign (f); - - if (unlikely (COB_FIELD_NO_SIGN_NIBBLE (f))) { - endp = f->data + f->size; - nibtest = 1; - } else { - endp = f->data + f->size - 1; - nibtest = 0; - } - - byteval = 0; - if (digits % 2 == nibtest) { - byteval = *p & 0x0FU; - p++; - } - mpz_set_ui (d->value, (cob_uli_t)byteval); - nonzero = !!byteval; - - for (; p < endp; p++) { - if (nonzero) { - mpz_mul_ui (d->value, d->value, 100UL); - } - if (*p) { - mpz_add_ui (d->value, d->value, - ((cob_uli_t)(*p >> 4U) * 10U) + (*p & 0x0FU)); - nonzero = 1; - } - } - - if (!nibtest) { - if (nonzero) { - mpz_mul_ui (d->value, d->value, 10UL); - } - mpz_add_ui (d->value, d->value, (cob_uli_t)(*p >> 4U)); - } - - if (sign < 0) { - mpz_neg (d->value, d->value); - } - d->scale = COB_FIELD_SCALE(f); -} - -static int -cob_decimal_get_packed (cob_decimal *d, cob_field *f, const int opt) -{ - unsigned char *data; - unsigned char *p; - unsigned char *q; - char *mza; - size_t size; - size_t n; - size_t i; - int diff; - int sign; - int digits; - unsigned int x; - -#if 0 /* RXWRXW stack */ - char buff[1024]; -#endif - - /* Build string */ - sign = mpz_sgn (d->value); - if (!sign) { - /* Value is 0 */ - cob_set_packed_zero (f); - return 0; - } - if (sign < 0) { - mpz_abs (d->value, d->value); - } - -#if 0 /* RXWRXW stack */ - if (unlikely (mpz_sizeinbase (d->value, 10) > sizeof(buff) - 1)) { -#endif - mza = mpz_get_str (NULL, 10, d->value); -#if 0 /* RXWRXW stack */ - } else { - mza = buff; - (void)mpz_get_str (buff, 10, d->value); - } -#endif - size = strlen (mza); - - /* Store number */ - data = f->data; - digits = COB_FIELD_DIGITS (f); -#if 0 /* RXWRXW - P Fix */ - if (digits > (f->size * 2) - 1) { - digits = (f->size * 2) - 1; - } -#endif - q = (unsigned char *)mza; - diff = (int)(digits - size); - if (diff < 0) { - /* Overflow */ - cob_set_exception (COB_EC_SIZE_OVERFLOW); - - /* If the statement has SIZE ERROR - then throw an exception */ - if (opt & COB_STORE_KEEP_ON_OVERFLOW) { -#if 0 /* RXWRXW stack */ - if (unlikely (mza != buff)) { -#endif - cob_gmp_free(mza); - -#if 0 /* RXWRXW stack */ - } -#endif - return cobglobptr->cob_exception_code; - } - q += size - digits; - size = digits; - } - memset (data, 0, f->size); - if (COB_FIELD_NO_SIGN_NIBBLE (f)) { - p = data + ((digits - 1) / 2) - ((size - 1) / 2); - diff = (int)(size % 2); - } else { - p = data + (digits / 2) - (size / 2); - diff = 1 - (int)(size % 2); - } - for (i = diff, n = 0; i < size + diff; i++, n++) { - x = COB_D2I (q[n]); - if (i % 2 == 0) { - *p = (unsigned char) x << 4; - } else { - *p++ |= x; - } - } - -#if 0 /* RXWRXW stack */ - if (unlikely (mza != buff)) { -#endif - cob_gmp_free(mza); - -#if 0 /* RXWRXW stack */ - } -#endif - - if (COB_FIELD_NO_SIGN_NIBBLE (f)) { - return 0; - } - - p = f->data + f->size - 1; - if (!COB_FIELD_HAVE_SIGN (f)) { - *p = (*p & 0xF0U) | 0x0FU; - } else if (sign < 0) { - *p = (*p & 0xF0U) | 0x0DU; - } else { - *p = (*p & 0xF0U) | 0x0CU; - } - - return 0; -} - -void -cob_set_packed_int (cob_field *f, const int val) -{ - unsigned char *p; - size_t sign = 0; - cob_u32_t n; - - if (!val) { - cob_set_packed_zero (f); - return; - } - if (val < 0) { - n = (cob_u32_t)-val; - sign = 1; - } else { - n = (cob_u32_t)val; - } - memset (f->data, 0, f->size); - p = f->data + f->size - 1; - if (!COB_FIELD_NO_SIGN_NIBBLE (f)) { - *p = (n % 10) << 4; - if (!COB_FIELD_HAVE_SIGN (f)) { - *p |= 0x0FU; - } else if (sign) { - *p |= 0x0DU; - } else { - *p |= 0x0CU; - } - n /= 10; - p--; - } - for (; n && p >= f->data; n /= 100, p--) { - *p = packed_bytes[n % 100]; - } - if (COB_FIELD_NO_SIGN_NIBBLE (f)) { - if ((COB_FIELD_DIGITS(f) % 2) == 1) { - *(f->data) &= 0x0FU; - } - return; - } - if ((COB_FIELD_DIGITS(f) % 2) == 0) { - *(f->data) &= 0x0FU; - } -} - -/* DISPLAY */ - -static void -cob_decimal_set_display (cob_decimal *d, cob_field *f) -{ - unsigned char *data; - unsigned char *p; - size_t size; - int sign; - cob_uli_t n; - - data = COB_FIELD_DATA (f); - size = COB_FIELD_SIZE (f); - if (unlikely (*data == 255)) { - mpz_ui_pow_ui (d->value, 10UL, (cob_uli_t)size); - d->scale = COB_FIELD_SCALE(f); - return; - } - if (unlikely (*data == 0)) { - mpz_ui_pow_ui (d->value, 10UL, (cob_uli_t)size); - mpz_neg (d->value, d->value); - d->scale = COB_FIELD_SCALE(f); - return; - } - sign = COB_GET_SIGN (f); - /* Skip leading zeros (also invalid space/low-value) */ - while (size > 1 && (*data & 0x0FU) == 0) { - size--; - data++; - } - - /* Set value */ - n = 0; - -#ifdef COB_LI_IS_LL - if (size < 20) { -#else - if (size < 10) { -#endif - while (size--) { - if (n) { - n *= 10; - } - n += COB_D2I (*data); - data++; - } - mpz_set_ui (d->value, n); - } else { - p = cob_fast_malloc (size + 1U); - for (; n < size; ++n) { - p[n] = (data[n] & 0x0FU) + '0'; - } - p[size] = 0; - mpz_set_str (d->value, (char *)p, 10); - cob_free (p); - } - - /* Set sign and scale */ - if (sign < 0 && mpz_sgn (d->value)) { - mpz_neg (d->value, d->value); - } - d->scale = COB_FIELD_SCALE(f); - COB_PUT_SIGN (f, sign); -} - -static int -cob_decimal_get_display (cob_decimal *d, cob_field *f, const int opt) -{ - unsigned char *data; - char *p; - size_t size; - int diff; - int sign; - - data = COB_FIELD_DATA (f); - /* Build string */ - sign = mpz_sgn (d->value); - if (!sign) { - /* Value is 0 */ - memset (data, '0', COB_FIELD_SIZE (f)); - COB_PUT_SIGN (f, sign); - return 0; - } - if (sign < 0) { - mpz_abs (d->value, d->value); - } - p = mpz_get_str (NULL, 10, d->value); - size = strlen (p); - - /* Store number */ - diff = (int)(COB_FIELD_SIZE (f) - size); - if (unlikely (diff < 0)) { - /* Overflow */ - cob_set_exception (COB_EC_SIZE_OVERFLOW); - - /* If the statement has ON SIZE ERROR or NOT ON SIZE ERROR, - then throw an exception */ - if (opt & COB_STORE_KEEP_ON_OVERFLOW) { - cob_gmp_free(p); - return cobglobptr->cob_exception_code; - } - - /* Other size, truncate digits */ - memcpy (data, p - diff, COB_FIELD_SIZE (f)); - } else { - /* No overflow */ - memset (data, '0', (size_t)diff); - memcpy (data + diff, p, size); - } - - cob_gmp_free(p); - COB_PUT_SIGN (f, sign); - - return 0; -} - -/* BINARY */ - -static void -cob_decimal_set_binary (cob_decimal *d, cob_field *f) -{ -#ifdef COB_EXPERIMENTAL -#if 1 /* RXWRXW - set_usll */ - size_t size; - size_t sizeb; - size_t idx; - int order; - unsigned char buff[COB_MAX_BINARY + 1]; - - size = f->size; -#ifndef WORDS_BIGENDIAN - if (!COB_FIELD_BINARY_SWAP (f)) { - sizeb = size - 1; - order = -1; - } else { - sizeb = 0; - order = 1; - } -#else - sizeb = 0; - order = 1; -#endif - if (COB_FIELD_HAVE_SIGN (f) && (f->data[sizeb] & 0x80U)) { - for (idx = 0; idx < size; ++idx) { - buff[idx] = ~f->data[idx]; - } - mpz_import (d->value, 1, order, size, order, 0, buff); - mpz_com (d->value, d->value); - } else { - mpz_import (d->value, 1, order, size, order, 0, f->data); - } - -#else - if (COB_FIELD_HAVE_SIGN (f)) { - mpz_set_sll (d->value, cob_binary_get_sint64 (f)); - } else { - mpz_set_ull (d->value, cob_binary_get_uint64 (f)); - } -#endif - -#elif defined(COB_LI_IS_LL) - if (COB_FIELD_HAVE_SIGN (f)) { - mpz_set_si (d->value, cob_binary_get_sint64 (f)); - } else { - mpz_set_ui (d->value, cob_binary_get_uint64 (f)); - } -#else - cob_u64_t uval; - cob_s64_t val; - size_t negative; - - if (f->size <= 4) { - if (COB_FIELD_HAVE_SIGN (f)) { - mpz_set_si (d->value, (cob_sli_t)cob_binary_get_sint64 (f)); - } else { - mpz_set_ui (d->value, (cob_uli_t) cob_binary_get_uint64 (f)); - } - } else { - negative = 0; - if (COB_FIELD_HAVE_SIGN (f)) { - val = cob_binary_get_sint64 (f); - if (val < 0) { - negative = 1; - uval = (cob_u64_t)-val; - } else { - uval = (cob_u64_t)val; - } - } else { - uval = cob_binary_get_uint64 (f); - } - mpz_set_ui (d->value, (cob_uli_t)(uval >> 32)); - mpz_mul_2exp (d->value, d->value, 32); - mpz_add_ui (d->value, d->value, (cob_uli_t)(uval & 0xFFFFFFFFU)); - if (negative) { - mpz_neg (d->value, d->value); - } - } -#endif - d->scale = COB_FIELD_SCALE(f); -} - -static int -cob_decimal_get_binary (cob_decimal *d, cob_field *f, const int opt) -{ - size_t overflow; - size_t sign; - size_t bitnum; - size_t digits; - -#if !defined(COB_EXPERIMENTAL) && !defined(COB_LI_IS_LL) - cob_s64_t llval; - cob_u64_t ullval; - unsigned int lo; -#endif - - if (unlikely (mpz_size (d->value) == 0)) { - memset (f->data, 0, f->size); - return 0; - } - overflow = 0; - digits = COB_FIELD_DIGITS(f); - if (COB_FIELD_HAVE_SIGN (f)) { - sign = 1; - } else { - sign = 0; - if (mpz_sgn (d->value) < 0) { - mpz_abs (d->value, d->value); - } - } - bitnum = (f->size * 8) - sign; - if (unlikely (mpz_sizeinbase (d->value, 2) > bitnum)) { - if (opt & COB_STORE_KEEP_ON_OVERFLOW) { - goto overflow; - } - overflow = 1; - /* Check if truncation to PIC digits is needed */ - if (opt & COB_STORE_TRUNC_ON_OVERFLOW) { - mpz_tdiv_r (d->value, d->value, cob_mpze10[digits]); - } else { -#if 0 /* RXWRXW - Fdiv sign */ - mpz_fdiv_r_2exp (d->value, d->value, (f->size * 8) - sign); -#endif - mpz_fdiv_r_2exp (d->value, d->value, (f->size * 8)); - } - } else if (opt && COB_FIELD_BINARY_TRUNC (f)) { - if (mpz_cmpabs (d->value, cob_mpze10[digits]) >= 0) { - /* Overflow */ - if (opt & COB_STORE_KEEP_ON_OVERFLOW) { - goto overflow; - } - overflow = 1; - /* Check if truncation to PIC digits is needed */ - if (opt & COB_STORE_TRUNC_ON_OVERFLOW) { - mpz_tdiv_r (d->value, d->value, - cob_mpze10[digits]); - } else { - mpz_fdiv_r_2exp (d->value, d->value, (f->size * 8)); - } - } - } -#ifdef COB_LI_IS_LL - if (!sign || (overflow && !(opt & COB_STORE_TRUNC_ON_OVERFLOW))) { - cob_binary_set_uint64 (f, mpz_get_ui (d->value)); - } else { - cob_binary_set_int64 (f, mpz_get_si (d->value)); - } -#elif defined(COB_EXPERIMENTAL) - if (!sign || (overflow && !(opt & COB_STORE_TRUNC_ON_OVERFLOW))) { - cob_binary_set_uint64 (f, mpz_get_ull (d->value)); - } else { - cob_binary_set_int64 (f, mpz_get_sll (d->value)); - } -#else - if (f->size <= 4) { - if (!sign || (overflow && !(opt & COB_STORE_TRUNC_ON_OVERFLOW))) { - cob_binary_set_uint64 (f, (cob_u64_t)mpz_get_ui (d->value)); - } else { - cob_binary_set_int64 (f, (cob_s64_t)mpz_get_si (d->value)); - } - } else { - mpz_fdiv_r_2exp (cob_mpzt, d->value, 32); - mpz_fdiv_q_2exp (d->value, d->value, 32); - lo = mpz_get_ui (cob_mpzt); - - if (!sign || (overflow && !(opt & COB_STORE_TRUNC_ON_OVERFLOW))) { - ullval = mpz_get_ui (d->value); - ullval = (ullval << 32) | lo; - cob_binary_set_uint64 (f, ullval); - } else { - llval = mpz_get_si (d->value); - llval = (llval << 32) | lo; - cob_binary_set_int64 (f, llval); - } - } -#endif - if (!overflow) { - return 0; - } - -overflow: - cob_set_exception (COB_EC_SIZE_OVERFLOW); - return cobglobptr->cob_exception_code; -} - -/* General uint -> field */ - -void -cob_set_field_to_uint (cob_field *field, const cob_u32_t data) -{ - cob_decimal dec; - - mpz_init2 (dec.value, COB_MPZ_DEF); - mpz_set_ui (dec.value, data); - dec.scale = 0; - - cob_decimal_get_field (&dec, field, 0); - - mpz_clear (dec.value); -} - -/* General field */ - -void -cob_decimal_set_field (cob_decimal *dec, cob_field *field) -{ - union { - double dval; - float fval; - } uval; - - switch (COB_FIELD_TYPE (field)) { - case COB_TYPE_NUMERIC_BINARY: - cob_decimal_set_binary (dec, field); - break; - case COB_TYPE_NUMERIC_PACKED: - cob_decimal_set_packed (dec, field); - break; - case COB_TYPE_NUMERIC_FLOAT: - memcpy ((void *)&uval.fval, field->data, sizeof(float)); - cob_decimal_set_double (dec, (double)uval.fval); - break; - case COB_TYPE_NUMERIC_DOUBLE: - memcpy ((void *)&uval.dval, field->data, sizeof(double)); - cob_decimal_set_double (dec, uval.dval); - break; - case COB_TYPE_NUMERIC_FP_DEC64: - cob_decimal_set_ieee64dec (dec, field); - break; - case COB_TYPE_NUMERIC_FP_DEC128: - cob_decimal_set_ieee128dec (dec, field); - break; - default: - cob_decimal_set_display (dec, field); - break; - } -} - -void -cob_print_ieeedec (const cob_field *f, FILE *fp) -{ - union { - double dval; - float fval; - } uval; - - switch (COB_FIELD_TYPE (f)) { - case COB_TYPE_NUMERIC_FP_DEC64: - cob_decimal_set_ieee64dec (&cob_d3, f); - break; - case COB_TYPE_NUMERIC_FP_DEC128: - cob_decimal_set_ieee128dec (&cob_d3, f); - break; - case COB_TYPE_NUMERIC_FLOAT: - memcpy ((void *)&uval.fval, f->data, sizeof(float)); - cob_decimal_set_double (&cob_d3, (double)uval.fval); - break; - case COB_TYPE_NUMERIC_DOUBLE: - memcpy ((void *)&uval.dval, f->data, sizeof(double)); - cob_decimal_set_double (&cob_d3, uval.dval); - break; - default: - return; - } - cob_decimal_print (&cob_d3, fp); -} - -void -cob_print_realbin (const cob_field *f, FILE *fp, const int size) -{ - union { - cob_u64_t uval; - cob_s64_t val; - } llval; - - if (COB_FIELD_HAVE_SIGN (f)) { - llval.val = cob_binary_get_sint64 (f); - fprintf (fp, CB_FMT_PLLD, size, size, llval.val); - return; - } - llval.uval = cob_binary_get_uint64 (f); - fprintf (fp, CB_FMT_PLLU, size, size, llval.uval); -} - -static void -cob_decimal_do_round (cob_decimal *d, cob_field *f, const int opt) -{ - cob_uli_t adj; - int sign; - int scale; - - sign = mpz_sgn (d->value); - /* Returns 0 when value is 0 */ - if (!sign) { - return; - } - scale = COB_FIELD_SCALE(f); - if (scale >= d->scale) { - return; - } - - switch (opt & ~(COB_STORE_MASK)) { - case COB_STORE_TRUNCATION: - return; - case COB_STORE_PROHIBITED: - cob_set_exception (COB_EC_SIZE_TRUNCATION); - return; - case COB_STORE_AWAY_FROM_ZERO: - adj = d->scale - scale; - mpz_ui_pow_ui (cob_mpzt, 10UL, adj); - mpz_tdiv_r (cob_mpzt2, d->value, cob_mpzt); - if (mpz_sgn (cob_mpzt2)) { - /* Not exact number */ - if (sign < 0) { - mpz_sub (d->value, d->value, cob_mpzt); - } else { - mpz_add (d->value, d->value, cob_mpzt); - } - } - return; - case COB_STORE_NEAR_TOWARD_ZERO: - adj = d->scale - scale - 1; - mpz_ui_pow_ui (cob_mpzt, 10UL, adj); - mpz_mul_ui (cob_mpzt, cob_mpzt, 5UL); - mpz_tdiv_r (cob_mpzt2, d->value, cob_mpzt); - shift_decimal (d, scale - d->scale + 1); - if (!mpz_sgn (cob_mpzt2)) { - return; - } - if (sign > 0) { - mpz_add_ui (d->value, d->value, 5UL); - } else { - mpz_sub_ui (d->value, d->value, 5UL); - } - return; - case COB_STORE_TOWARD_GREATER: - adj = d->scale - scale; - mpz_ui_pow_ui (cob_mpzt, 10UL, adj); - mpz_tdiv_r (cob_mpzt2, d->value, cob_mpzt); - if (mpz_sgn (cob_mpzt2)) { - /* Not exact number */ - if (sign > 0) { - mpz_add (d->value, d->value, cob_mpzt); - } - } - return; - case COB_STORE_TOWARD_LESSER: - adj = d->scale - scale; - mpz_ui_pow_ui (cob_mpzt, 10UL, adj); - mpz_tdiv_r (cob_mpzt2, d->value, cob_mpzt); - if (mpz_sgn (cob_mpzt2)) { - /* Not exact number */ - if (sign < 0) { - mpz_sub (d->value, d->value, cob_mpzt); - } - } - return; - case COB_STORE_NEAR_EVEN: - adj = d->scale - scale - 1; - mpz_ui_pow_ui (cob_mpzt, 10UL, adj); - mpz_mul_ui (cob_mpzt, cob_mpzt, 5UL); - mpz_tdiv_r (cob_mpzt, d->value, cob_mpzt); - shift_decimal (d, scale - d->scale + 1); - if (!mpz_sgn (cob_mpzt)) { - adj = mpz_tdiv_ui (d->value, 100UL); - switch (adj) { - case 5: - case 25: - case 45: - case 65: - case 85: - return; - } - } - if (sign > 0) { - mpz_add_ui (d->value, d->value, 5UL); - } else { - mpz_sub_ui (d->value, d->value, 5UL); - } - return; - case COB_STORE_NEAR_AWAY_FROM_ZERO: - default: - shift_decimal (d, scale - d->scale + 1); - if (sign > 0) { - mpz_add_ui (d->value, d->value, 5UL); - } else { - mpz_sub_ui (d->value, d->value, 5UL); - } - return; - } -} - -int -cob_decimal_get_field (cob_decimal *d, cob_field *f, const int opt) -{ - cob_field temp; - cob_field_attr attr; - union { - double val; - float fval; - } uval; - - if (unlikely (d->scale == COB_DECIMAL_NAN)) { - if (!cobglobptr->cob_exception_code - || !cob_last_exception_is (COB_EC_SIZE_ZERO_DIVIDE)) { - cob_set_exception (COB_EC_SIZE_OVERFLOW); - } - return cobglobptr->cob_exception_code; - } - if (opt & COB_STORE_KEEP_ON_OVERFLOW) { - if (unlikely(d->scale == COB_DECIMAL_INF)) { - cob_set_exception (COB_EC_SIZE_OVERFLOW); - return cobglobptr->cob_exception_code; - } - } - - /* work copy */ - if (d != &cob_d1) { - mpz_set (cob_d1.value, d->value); - cob_d1.scale = d->scale; - d = &cob_d1; - } - - /* Rounding */ - if ((opt & COB_STORE_ROUND)) { - cob_decimal_do_round (d, f, opt); - } - if (!COB_FIELD_IS_FP(f)) { - /* Append or truncate decimal digits */ - shift_decimal (d, COB_FIELD_SCALE(f) - d->scale); - } - - /* Store number */ - switch (COB_FIELD_TYPE (f)) { - case COB_TYPE_NUMERIC_BINARY: - return cob_decimal_get_binary (d, f, opt); - case COB_TYPE_NUMERIC_DISPLAY: - return cob_decimal_get_display (d, f, opt); - case COB_TYPE_NUMERIC_PACKED: - return cob_decimal_get_packed (d, f, opt); - case COB_TYPE_NUMERIC_FLOAT: - uval.fval = (float) cob_decimal_get_double (d); - if ((opt & COB_STORE_KEEP_ON_OVERFLOW) - && (isinf (uval.fval) || isnan(uval.fval))) { - cob_set_exception (COB_EC_SIZE_OVERFLOW); - return cobglobptr->cob_exception_code; - } - if ((opt & COB_STORE_KEEP_ON_OVERFLOW) - && cob_not_finite) { - cob_set_exception (COB_EC_SIZE_OVERFLOW); - return cobglobptr->cob_exception_code; - } - memcpy (f->data, &uval.fval, sizeof (float)); - return 0; - case COB_TYPE_NUMERIC_DOUBLE: - uval.val = cob_decimal_get_double (d); - if ((opt & COB_STORE_KEEP_ON_OVERFLOW) - && (isinf (uval.val) || isnan(uval.val))) { - cob_set_exception (COB_EC_SIZE_OVERFLOW); - return cobglobptr->cob_exception_code; - } - if ((opt & COB_STORE_KEEP_ON_OVERFLOW) - && cob_not_finite) { - cob_set_exception (COB_EC_SIZE_OVERFLOW); - return cobglobptr->cob_exception_code; - } - memcpy (f->data, &uval.val, sizeof (double)); - return 0; - case COB_TYPE_NUMERIC_FP_DEC64: - return cob_decimal_get_ieee64dec (d, f, opt); - case COB_TYPE_NUMERIC_FP_DEC128: - return cob_decimal_get_ieee128dec (d, f, opt); - default: - break; - } - COB_ATTR_INIT (COB_TYPE_NUMERIC_DISPLAY, COB_FIELD_DIGITS(f), - COB_FIELD_SCALE(f), COB_FLAG_HAVE_SIGN, NULL); - temp.size = COB_FIELD_DIGITS(f); - temp.data = cob_malloc (COB_FIELD_DIGITS(f)); - temp.attr = &attr; - if (cob_decimal_get_display (d, &temp, opt) == 0) { - cob_move (&temp, f); - cob_free (temp.data); - return 0; - } - cob_free (temp.data); - return cobglobptr->cob_exception_code; -} - -/* Decimal arithmetic */ - -void -cob_decimal_add (cob_decimal *d1, cob_decimal *d2) -{ - DECIMAL_CHECK (d1, d2); - align_decimal (d1, d2); - mpz_add (d1->value, d1->value, d2->value); -} - -void -cob_decimal_sub (cob_decimal *d1, cob_decimal *d2) -{ - DECIMAL_CHECK (d1, d2); - align_decimal (d1, d2); - mpz_sub (d1->value, d1->value, d2->value); -} - -void -cob_decimal_mul (cob_decimal *d1, cob_decimal *d2) -{ - DECIMAL_CHECK (d1, d2); - d1->scale += d2->scale; - mpz_mul (d1->value, d1->value, d2->value); -} - -void -cob_decimal_div (cob_decimal *d1, cob_decimal *d2) -{ - DECIMAL_CHECK (d1, d2); - - /* Check for division by zero */ - if (unlikely (mpz_sgn (d2->value) == 0)) { - d1->scale = COB_DECIMAL_NAN; - - /* FIXME: we currently don't handle the fatal exception correct - fatal->abort. We only should set it when it *doesn't* happen - within a arithmetic statement with SIZE error phrase and must - execute the appropriate USE statement, if any before the abort - */ - - if (cobglobptr->cob_exception_code == -1) { - cob_set_exception (COB_EC_SIZE_ZERO_DIVIDE); - cob_fatal_error (COB_FERROR_DIV_ZERO); - } - - cob_set_exception (COB_EC_SIZE_ZERO_DIVIDE); - return; - } - if (unlikely (mpz_sgn (d1->value) == 0)) { - d1->scale = 0; - return; - } - d1->scale -= d2->scale; - shift_decimal (d1, COB_MAX_DIGITS + ((d1->scale < 0) ? -d1->scale : 0)); - mpz_tdiv_q (d1->value, d1->value, d2->value); -} - -int -cob_decimal_cmp (cob_decimal *d1, cob_decimal *d2) -{ - align_decimal (d1, d2); - return mpz_cmp (d1->value, d2->value); -} - -/* - * Shift 'd1' to have same scale as 'd2' - */ -void -cob_decimal_align (cob_decimal *d1, const int scale) -{ - if (d1->scale > scale) { - shift_decimal (d1, scale - d1->scale); - } else if (d1->scale < scale) { - shift_decimal (d1, d1->scale - scale); - } - return; -} - -/* Convenience functions */ - -void -cob_add (cob_field *f1, cob_field *f2, const int opt) -{ - cob_decimal_set_field (&cob_d1, f1); - cob_decimal_set_field (&cob_d2, f2); - cob_decimal_add (&cob_d1, &cob_d2); - (void)cob_decimal_get_field (&cob_d1, f1, opt); -} - -void -cob_sub (cob_field *f1, cob_field *f2, const int opt) -{ - cob_decimal_set_field (&cob_d1, f1); - cob_decimal_set_field (&cob_d2, f2); - cob_decimal_sub (&cob_d1, &cob_d2); - (void)cob_decimal_get_field (&cob_d1, f1, opt); -} - -void -cob_mul (cob_field *f1, cob_field *f2, const int opt) -{ - cob_decimal_set_field (&cob_d1, f1); - cob_decimal_set_field (&cob_d2, f2); - cob_decimal_mul (&cob_d1, &cob_d2); - (void)cob_decimal_get_field (&cob_d1, f1, opt); -} - -void -cob_div (cob_field *f1, cob_field *f2, const int opt) -{ - cob_decimal_set_field (&cob_d1, f1); - cob_decimal_set_field (&cob_d2, f2); - cob_decimal_div (&cob_d1, &cob_d2); - (void)cob_decimal_get_field (&cob_d1, f1, opt); -} - -void -cob_div_quotient (cob_field *dividend, cob_field *divisor, - cob_field *quotient, const int opt) -{ - /* Note that cob_div_quotient and cob_div_remainder must remain */ - /* separate because of COBOL rules. The quotient must be fully */ - /* evaluated before the remainder item is evaluated */ - /* e.g. DIVIDE A BY B GIVING Z REMAINDER FLD (Z). */ - - cob_decimal_set_field (&cob_d1, dividend); - cob_decimal_set_field (&cob_d2, divisor); - cob_decimal_set (&cob_d_remainder, &cob_d1); - - /* Compute quotient */ - cob_decimal_div (&cob_d1, &cob_d2); - /* Check divide by zero - Exception is set in cob_decimal_div */ - if (cob_d1.scale == COB_DECIMAL_NAN) { - /* Forces an early return from cob_div_remainder */ - cob_d_remainder.scale = COB_DECIMAL_NAN; - return; - } - - /* Set quotient */ - cob_decimal_set (&cob_d3, &cob_d1); - (void)cob_decimal_get_field (&cob_d1, quotient, opt); - - /* Truncate digits from the quotient */ - shift_decimal (&cob_d3, COB_FIELD_SCALE(quotient) - cob_d3.scale); - - /* Compute remainder */ - cob_decimal_mul (&cob_d3, &cob_d2); - cob_decimal_sub (&cob_d_remainder, &cob_d3); -} - -void -cob_div_remainder (cob_field *fld_remainder, const int opt) -{ - (void)cob_decimal_get_field (&cob_d_remainder, fld_remainder, opt); -} - -void -cob_decimal_setget_fld (cob_field *src, cob_field *dst, const int opt) -{ - cob_decimal_set_field (&cob_d1, src); - (void)cob_decimal_get_field (&cob_d1, dst, opt); -} - -#if 0 /* RXWRXW - Buggy */ - -/* Optimized arithmetic for DISPLAY */ - -static int -display_add_int (unsigned char *data, const size_t size, int n, const int opt) -{ - unsigned char *sp; - size_t carry = 0; - int i; - int is; - - sp = data + size; - while (n > 0) { - i = n % 10; - n /= 10; - - /* Check for overflow */ - if (unlikely (--sp < data)) { - return opt; - } - - /* Perform addition */ - is = (*sp & 0x0F) + i + carry; - if (is > 9) { - carry = 1; - *sp = '0' + ((is + 6) & 0x0F); - } else { - carry = 0; - *sp = '0' + is; - } - } - if (carry == 0) { - return 0; - } - - /* Carry up */ - while (--sp >= data) { - if ((*sp += 1) <= (unsigned char)'9') { - return 0; - } - *sp = '0'; - } - return opt; -} - -static int -display_sub_int (unsigned char *data, const size_t size, int n, const int opt) -{ - unsigned char *sp; - size_t carry = 0; - int i; - - COB_UNUSED (opt); - - sp = data + size; - while (n > 0) { - i = n % 10; - n /= 10; - - /* Check for overflow */ - if (unlikely (--sp < data)) { - return 1; - } - -#if 0 /* RXWRXW - Garbage check */ - /* Correct garbage */ - *sp = (unsigned char)('0' + (*sp & 0x0F)); -#endif - /* Perform subtraction */ - if ((*sp -= i + carry) < '0') { - carry = 1; - *sp += 10; - } else { - carry = 0; - } - } - if (carry == 0) { - return 0; - } - - /* Carry up */ - while (--sp >= data) { -#if 0 /* RXWRXW - Garbage check */ - /* Correct garbage */ - *sp = (unsigned char)('0' + (*sp & 0x0F)); -#endif - if ((*sp -= 1) >= (unsigned char)'0') { - return 0; - } - *sp = '9'; - } - return 1; -} - -static int -cob_display_add_int (cob_field *f, int n, const int opt) -{ - unsigned char *data; - size_t osize; - size_t size; - size_t i; - int scale; - int sign; - unsigned char tfield[256]; - - data = COB_FIELD_DATA (f); - size = COB_FIELD_SIZE (f); - osize = size; - if (opt & COB_STORE_KEEP_ON_OVERFLOW) { - memcpy (tfield, data, size); - } - scale = COB_FIELD_SCALE (f); - sign = COB_GET_SIGN (f); - /* -x +v = -(x - v), -x -v = -(x + v) */ - if (sign < 0) { - n = -n; - } - - if (unlikely (scale < 0)) { - /* PIC 9(n)P(m) */ - if (-scale < 10) { - /* Fix optimizer bug */ - while (scale) { - ++scale; - n /= 10; - } - } else { - n = 0; - } - scale = 0; - if (n == 0) { - return 0; - } - } else { - /* PIC 9(n)V9(m) */ - size -= scale; - if (!size) { - COB_PUT_SIGN (f, sign); - cob_set_exception (COB_EC_SIZE_OVERFLOW); - if (opt & COB_STORE_KEEP_ON_OVERFLOW) { - return cobglobptr->cob_exception_code; - } - return 0; - } - } - - if (n > 0) { - /* Add n to the field */ - if (display_add_int (data, size, n, opt) != 0) { - /* Overflow */ - COB_PUT_SIGN (f, sign); - cob_set_exception (COB_EC_SIZE_OVERFLOW); - /* If we need to restore */ - if (opt & COB_STORE_KEEP_ON_OVERFLOW) { - memcpy (data, tfield, osize); - return cobglobptr->cob_exception_code; - } - } - } else if (n < 0) { - /* Subtract n from the field */ - if (display_sub_int (data, size, -n, opt) != 0) { - for (i = 0; i < size; ++i) { - data[i] = COB_I2D (9 - COB_D2I (data[i])); - } - if (scale) { - for (i = size; i < size + scale; ++i) { - if (COB_D2I (data[i]) > 0) { - data[i] = COB_I2D (10 - COB_D2I (data[i])); - } - } - } else { - (void)display_add_int (data, size, 1, 0); - } - sign = -sign; - } - } - - COB_PUT_SIGN (f, sign); - return 0; -} -#endif /* Buggy */ - -int -cob_add_int (cob_field *f, const int n, const int opt) -{ - int scale; - int val; - - if (unlikely (n == 0)) { - return 0; - } -#if 0 /* RXWRXW - Buggy */ - if (COB_FIELD_TYPE (f) == COB_TYPE_NUMERIC_PACKED) { - return cob_add_packed (f, n, opt); - } else if (COB_FIELD_TYPE (f) == COB_TYPE_NUMERIC_DISPLAY) { - return cob_display_add_int (f, n, opt); - } -#endif - - /* Not optimized */ - cob_decimal_set_field (&cob_d1, f); - - if (COB_FIELD_TYPE (f) >= COB_TYPE_NUMERIC_FLOAT - && COB_FIELD_TYPE (f) <= COB_TYPE_NUMERIC_FP_BIN128) { - mpz_set_si (cob_d2.value, (cob_sli_t) n); - cob_d2.scale = 0; - cob_decimal_add (&cob_d1, &cob_d2); - return cob_decimal_get_field (&cob_d1, f, opt); - } - else { - scale = COB_FIELD_SCALE (f); - val = n; - if (unlikely (scale < 0)) { - /* PIC 9(n)P(m) */ - if (-scale < 10) { - while (scale++) { - val /= 10; - } - } else { - val = 0; - } - scale = 0; - if (!val) { - return 0; - } - } - mpz_set_si (cob_d2.value, (cob_sli_t)val); - cob_d2.scale = 0; - if (scale > 0) { - mpz_ui_pow_ui (cob_mexp, 10UL, (cob_uli_t)scale); - mpz_mul (cob_d2.value, cob_d2.value, cob_mexp); - cob_d2.scale = cob_d1.scale; - } - mpz_add (cob_d1.value, cob_d1.value, cob_d2.value); - return cob_decimal_get_field (&cob_d1, f, opt); - } -} - -int -cob_sub_int (cob_field *f, const int n, const int opt) -{ - return cob_add_int (f, -n, opt); -} - -int -cob_cmp_int (cob_field *f1, const int n) -{ - cob_decimal_set_field (&cob_d1, f1); - mpz_set_si (cob_d2.value, (cob_sli_t)n); - cob_d2.scale = 0; - return cob_decimal_cmp (&cob_d1, &cob_d2); -} - -int -cob_cmp_uint (cob_field *f1, const unsigned int n) -{ - cob_decimal_set_field (&cob_d1, f1); - mpz_set_ui (cob_d2.value, (cob_uli_t)n); - cob_d2.scale = 0; - return cob_decimal_cmp (&cob_d1, &cob_d2); -} - -int -cob_cmp_llint (cob_field *f1, const cob_s64_t n) -{ -#ifdef COB_LI_IS_LL - mpz_set_si (cob_d2.value, (cob_sli_t)n); -#else - cob_u64_t uval; - cob_u32_t negative; - - negative = 0; - if (n < 0) { - negative = 1; - uval = (cob_u64_t)-n; - } else { - uval = (cob_u64_t)n; - } - mpz_set_ui (cob_d2.value, (cob_uli_t)(uval >> 32)); - mpz_mul_2exp (cob_d2.value, cob_d2.value, 32); - mpz_add_ui (cob_d2.value, cob_d2.value, (cob_uli_t)(uval & 0xFFFFFFFFU)); - if (negative) { - mpz_neg (cob_d2.value, cob_d2.value); - } -#endif - - cob_d2.scale = 0; - cob_decimal_set_field (&cob_d1, f1); - return cob_decimal_cmp (&cob_d1, &cob_d2); -} - -#ifdef COB_FLOAT_DELTA -#define TOLERANCE (double) COB_FLOAT_DELTA -#else -#define TOLERANCE (double) 0.0000001 -#endif -#define FLOAT_EQ(x,y,t) (fabs(((x-y)/x)) < t) - -int -cob_cmp_float (cob_field *f1, cob_field *f2) -{ - double d1,d2; - float flt; - if(COB_FIELD_TYPE (f1) == COB_TYPE_NUMERIC_FLOAT) { - memcpy(&flt,f1->data,sizeof(float)); - d1 = flt; - } else if(COB_FIELD_TYPE (f1) == COB_TYPE_NUMERIC_DOUBLE) { - memcpy(&d1,f1->data,sizeof(double)); - } else { - cob_decimal_set_field (&cob_d1, f1); - d1 = cob_decimal_get_double(&cob_d1); - } - if(COB_FIELD_TYPE (f2) == COB_TYPE_NUMERIC_FLOAT) { - memcpy(&flt,f2->data,sizeof(float)); - d2 = flt; - } else if(COB_FIELD_TYPE (f2) == COB_TYPE_NUMERIC_DOUBLE) { - memcpy(&d2,f2->data,sizeof(double)); - } else { - cob_decimal_set_field (&cob_d1, f2); - d2 = cob_decimal_get_double(&cob_d1); - } - if(d1 == d2) - return 0; - if(d1 != 0.0 - && FLOAT_EQ(d1,d2,TOLERANCE)) - return 0; - if(d1 < d2) - return -1; - return 1; -} - -int -cob_numeric_cmp (cob_field *f1, cob_field *f2) -{ - if(COB_FIELD_TYPE (f1) == COB_TYPE_NUMERIC_FLOAT - || COB_FIELD_TYPE (f1) == COB_TYPE_NUMERIC_DOUBLE - || COB_FIELD_TYPE (f2) == COB_TYPE_NUMERIC_FLOAT - || COB_FIELD_TYPE (f2) == COB_TYPE_NUMERIC_DOUBLE) { - return cob_cmp_float (f1, f2); - } - cob_decimal_set_field (&cob_d1, f1); - cob_decimal_set_field (&cob_d2, f2); - return cob_decimal_cmp (&cob_d1, &cob_d2); -} - -int -cob_cmp_packed (cob_field *f, const cob_s64_t val) -{ - unsigned char *p; - cob_u64_t n; - size_t size; - size_t inc; - int sign; - unsigned char val1[20]; - - sign = cob_packed_get_sign (f); - /* Field positive, value negative */ - if (sign >= 0 && val < 0) { - return 1; - } - /* Field negative, value positive */ - if (sign < 0 && val >= 0) { - return -1; - } - /* Both positive or both negative */ - if (val < 0) { - n = (cob_u64_t)-val; - } else { - n = (cob_u64_t)val; - } - inc = 0; - p = f->data; - for (size = 0; size < 20; size++) { - if (size < 20 - f->size) { - val1[size] = 0; - } else { - val1[size] = p[inc++]; - } - } - if (COB_FIELD_NO_SIGN_NIBBLE (f)) { - if ((COB_FIELD_DIGITS(f) % 2) == 1) { - val1[20 - f->size] &= 0x0F; - } - } else { - val1[19] &= 0xF0; - if ((COB_FIELD_DIGITS(f) % 2) == 0) { - val1[20 - f->size] &= 0x0F; - } - } - if (n != last_packed_val) { - last_packed_val = n; - memset (packed_value, 0, sizeof(packed_value)); - if (n) { - p = &packed_value[19]; - if (!COB_FIELD_NO_SIGN_NIBBLE (f)) { - *p = (n % 10) << 4; - p--; - n /= 10; - } - for (; n;) { - size = n % 100; - *p = (unsigned char)((size % 10) | ((size / 10) << 4)); - n /= 100; - p--; - } - } - } - for (size = 0; size < 20; size++) { - if (val1[size] != packed_value[size]) { - if (sign < 0) { - return packed_value[size] - val1[size]; - } else { - return val1[size] - packed_value[size]; - } - } - } - return 0; -} - -/* Numeric Display compares */ - -#ifdef COB_EBCDIC_MACHINE -static unsigned int -cob_get_long_ascii_sign (const unsigned char *p, cob_s64_t *val) -{ - switch (*p) { - case 'p': - return 1; - case 'q': - *val += 1; - return 1; - case 'r': - *val += 2; - return 1; - case 's': - *val += 3; - return 1; - case 't': - *val += 4; - return 1; - case 'u': - *val += 5; - return 1; - case 'v': - *val += 6; - return 1; - case 'w': - *val += 7; - return 1; - case 'x': - *val += 8; - return 1; - case 'y': - *val += 9; - return 1; - } - return 0; -} -#endif - -static unsigned int -cob_get_long_ebcdic_sign (const unsigned char *p, cob_s64_t *val) -{ - switch (*p) { - case '{': - return 0; - case 'A': - *val += 1; - return 0; - case 'B': - *val += 2; - return 0; - case 'C': - *val += 3; - return 0; - case 'D': - *val += 4; - return 0; - case 'E': - *val += 5; - return 0; - case 'F': - *val += 6; - return 0; - case 'G': - *val += 7; - return 0; - case 'H': - *val += 8; - return 0; - case 'I': - *val += 9; - return 0; - case '}': - return 1; - case 'J': - *val += 1; - return 1; - case 'K': - *val += 2; - return 1; - case 'L': - *val += 3; - return 1; - case 'M': - *val += 4; - return 1; - case 'N': - *val += 5; - return 1; - case 'O': - *val += 6; - return 1; - case 'P': - *val += 7; - return 1; - case 'Q': - *val += 8; - return 1; - case 'R': - *val += 9; - return 1; - } - return 0; -} - -int -cob_cmp_numdisp (const unsigned char *data, const size_t size, - const cob_s64_t n, const cob_u32_t has_sign) -{ - const unsigned char *p; - cob_s64_t val = 0; - size_t inc; - - p = data; - if (!has_sign) { - if (unlikely (n < 0)) { - return 1; - } - for (inc = 0; inc < size; inc++, p++) { - val = (val * 10) + COB_D2I (*p); - } - return (val < n) ? -1 : (val > n); - } - for (inc = 0; inc < size - 1; inc++, p++) { - val = (val * 10) + COB_D2I (*p); - } - val *= 10; - if (*p >= (unsigned char)'0' && *p <= (unsigned char)'9') { - val += COB_D2I (*p); - } else { - if (unlikely (COB_MODULE_PTR->ebcdic_sign)) { - if (cob_get_long_ebcdic_sign (p, &val)) { - val = -val; - } - } else { -#ifdef COB_EBCDIC_MACHINE - if (cob_get_long_ascii_sign (p, &val)) { - val = -val; - } -#else - if (*p >= (unsigned char)'p' && *p <= (unsigned char)'y') { - val += (*p - (unsigned char)'p'); - val = -val; - } -#endif - } - } - return (val < n) ? -1 : (val > n); -} - -void -cob_decimal_alloc (const cob_u32_t params, ...) -{ - cob_decimal **dec; - cob_u32_t i; - va_list args; - - va_start (args, params); - for (i = 0; i < params; ++i) { - dec = va_arg (args, cob_decimal **); - *dec = cob_decimal_base + i; - } - va_end (args); -} - -void -cob_decimal_push (const cob_u32_t params, ...) -{ - cob_decimal **dec; - cob_u32_t i; - va_list args; - - va_start (args, params); - for (i = 0; i < params; ++i) { - dec = va_arg (args, cob_decimal **); - *dec = cob_malloc (sizeof(cob_decimal)); - cob_decimal_init (*dec); - } - va_end (args); -} - -void -cob_decimal_pop (const cob_u32_t params, ...) -{ - cob_decimal *dec; - cob_u32_t i; - va_list args; - - va_start (args, params); - for (i = 0; i < params; ++i) { - dec = va_arg (args, cob_decimal *); - mpz_clear (dec->value); - cob_free (dec); - } - va_end (args); -} - -/* Init/Exit routines */ - -void -cob_exit_numeric (void) -{ - cob_decimal *d1; - size_t i; - - if (cob_decimal_base) { - d1 = cob_decimal_base; - for (i = 0; i < COB_MAX_DEC_STRUCT; d1++, i++) { - mpz_clear (d1->value); - } - cob_free (cob_decimal_base); - } - - mpz_clear (cob_d_remainder.value); - - mpz_clear (cob_d3.value); - mpz_clear (cob_d2.value); - mpz_clear (cob_d1.value); - - mpz_clear (cob_mexp); - mpz_clear (cob_mpzt2); - mpz_clear (cob_mpzt); - - mpz_clear (cob_mpz_ten34m1); - mpz_clear (cob_mpz_ten16m1); - for (i = 0; i < COB_MAX_BINARY; i++) { - mpz_clear (cob_mpze10[i]); - } - - mpf_clear (cob_mpft_get); - mpf_clear (cob_mpft); -} - -void -cob_init_numeric (cob_global *lptr) -{ - cob_decimal *d1; - cob_u32_t i; - - cobglobptr = lptr; - - memset (packed_value, 0, sizeof(packed_value)); - last_packed_val = 0; - - mpf_init2 (cob_mpft, COB_MPF_PREC); - mpf_init2 (cob_mpft_get, COB_MPF_PREC); - - for (i = 0; i < COB_MAX_BINARY; i++) { - mpz_init2 (cob_mpze10[i], 128UL); - mpz_ui_pow_ui (cob_mpze10[i], 10UL, (cob_uli_t)i); - } - mpz_init_set (cob_mpz_ten16m1, cob_mpze10[16]); - mpz_sub_ui (cob_mpz_ten16m1, cob_mpz_ten16m1, 1UL); - mpz_init_set (cob_mpz_ten34m1, cob_mpze10[34]); - mpz_sub_ui (cob_mpz_ten34m1, cob_mpz_ten34m1, 1UL); - - mpz_init2 (cob_mpzt, COB_MPZ_DEF); - mpz_init2 (cob_mpzt2, COB_MPZ_DEF); - mpz_init2 (cob_mexp, COB_MPZ_DEF); - - cob_decimal_init (&cob_d1); - cob_decimal_init (&cob_d2); - cob_decimal_init (&cob_d3); - cob_decimal_init (&cob_d_remainder); - - cob_decimal_base = cob_malloc (COB_MAX_DEC_STRUCT * sizeof(cob_decimal)); - d1 = cob_decimal_base; - for (i = 0; i < COB_MAX_DEC_STRUCT; d1++, i++) { - cob_decimal_init (d1); - } -} diff -Nru gnucobol-4.0~early~20200606/libcob/reportio.c gnucobol-5/libcob/reportio.c --- gnucobol-4.0~early~20200606/libcob/reportio.c 2020-06-06 20:52:01.000000000 +0000 +++ gnucobol-5/libcob/reportio.c 1970-01-01 00:00:00.000000000 +0000 @@ -1,1835 +0,0 @@ -/* - Copyright (C) 2013-2019 Free Software Foundation, Inc. - Written by Ron Norman, Simon Sobisch - - This file is part of GnuCOBOL. - - The GnuCOBOL runtime library is free software: you can redistribute it - and/or modify it under the terms of the GNU Lesser General Public License - as published by the Free Software Foundation, either version 3 of the - License, or (at your option) any later version. - - GnuCOBOL is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU Lesser General Public License for more details. - - You should have received a copy of the GNU Lesser General Public License - along with GnuCOBOL. If not, see . -*/ - - -#include - -#include -#include -#include -#include -#include -#include - -/* Force symbol exports */ -#define COB_LIB_EXPIMP -#include "libcob.h" -#include "coblocal.h" - -#ifdef WORDS_BIGENDIAN -#define COB_MAYSWAP_16(x) ((unsigned short)(x)) -#define COB_MAYSWAP_32(x) ((unsigned int)(x)) -#else -#define COB_MAYSWAP_16(x) (COB_BSWAP_16((unsigned short)(x))) -#define COB_MAYSWAP_32(x) (COB_BSWAP_32((unsigned int)(x))) -#endif - -static cob_global *cobglobptr= NULL; -static cob_settings *cobsetptr= NULL; -static int bDidReportInit = 0; - -#ifndef TRUE -#define TRUE 1 -#endif -#ifndef FALSE -#define FALSE 0 -#endif - -#define ND1 COB_REPORT_HEADING|COB_REPORT_FOOTING|COB_REPORT_PAGE_HEADING|COB_REPORT_PAGE_FOOTING -#define ND2 COB_REPORT_CONTROL_HEADING|COB_REPORT_CONTROL_HEADING_FINAL -#define ND3 COB_REPORT_CONTROL_FOOTING|COB_REPORT_CONTROL_FOOTING_FINAL -#define NOTDETAIL(f) ( f & (ND1|ND2|ND3)) - -static int report_line_type(cob_report *r, cob_report_line *l, int type); - -static const cob_field_attr const_alpha_attr = - {COB_TYPE_ALPHANUMERIC, 0, 0, 0, NULL}; -static const cob_field_attr const_num_attr = - {COB_TYPE_NUMERIC, 0, 0, 0, NULL}; -#define MAX_ACTIVE_REPORTS 10 -static cob_report *active_reports[MAX_ACTIVE_REPORTS]; -/* - * Move "String" to 'dst' field - */ -static void -cob_str_move (cob_field *dst, unsigned char *src, const int size) -{ - cob_field temp; - - temp.size = size; - temp.data = src; - temp.attr = &const_alpha_attr; - cob_move (&temp, dst); -} - -/* - * Initialize data field - */ -static cob_field * -cob_field_init (cob_field *f) -{ - cob_field temp; - - if(f == NULL) - return NULL; - temp.size = 1; - if(COB_FIELD_IS_NUMERIC(f)) { - temp.data = (unsigned char*)"0"; /* MOVE ZERO to field */ - temp.attr = &const_num_attr; - } else { - temp.data = (unsigned char*)" "; /* MOVE SPACES to field */ - temp.attr = &const_alpha_attr; - } - cob_move (&temp, f); - return f; -} - - -/* - * Make a new field the same format as that given - */ -static cob_field * -cob_field_dup (cob_field *f, int incr) -{ - cob_field temp; - cob_field *fld = cob_malloc(sizeof(cob_field)); - size_t dsize = f->size + incr; - - fld->size = dsize; - fld->data = cob_malloc((size_t)(dsize < COB_MAX_DIGITS ? COB_MAX_DIGITS : dsize) + 1); - fld->attr = f->attr; - - temp.size = 1; - if (COB_FIELD_IS_NUMERIC (f)) { - temp.data = (unsigned char*)"0"; /* MOVE ZERO to new field */ - temp.attr = &const_num_attr; - } else { - temp.data = (unsigned char*)" "; /* MOVE SPACES to new field */ - temp.attr = &const_alpha_attr; - } - cob_move (&temp, fld); - return fld; -} - -/* - * Free a field created by cob_field_dup - */ -static void -cob_field_free (cob_field *f) -{ - if(f == NULL) - return; - if(f->data) - cob_free((void*)f->data); - cob_free((void*)f); - return ; -} - -/* - * Free control temp areas - */ -static void -free_control_fields (cob_report *r) -{ - cob_report_control *rc; - cob_report_control_ref *rr; - int k; - - for(rc = r->controls; rc; rc = rc->next) { - if(rc->val) { - cob_field_free(rc->val); - rc->val = NULL; - } - if(rc->sf) { - cob_field_free(rc->sf); - rc->sf = NULL; - } - rc->has_heading = FALSE; - rc->has_footing = FALSE; - for(rr = rc->control_ref; rr; rr = rr->next) { - if (rr->ref_line->flags & COB_REPORT_CONTROL_HEADING - || rr->ref_line->flags & COB_REPORT_CONTROL_HEADING_FINAL) - rc->has_heading = TRUE; - if (rr->ref_line->flags & COB_REPORT_CONTROL_FOOTING - || rr->ref_line->flags & COB_REPORT_CONTROL_FOOTING_FINAL) - rc->has_footing = TRUE; - } - } - for(k=0; k < MAX_ACTIVE_REPORTS; k++) { - if (active_reports[k] == r) { - active_reports[k] = NULL; - } - } -} - -/* - * Clear the 'group_indicate' flag for all fields - */ -static void -clear_group_indicate(cob_report_line *l) -{ - cob_report_field *f; - for(f=l->fields; f; f=f->next) { - f->group_indicate = FALSE; - } - if(l->child) - clear_group_indicate(l->child); - if(l->sister) - clear_group_indicate(l->sister); -} - -/* - * Clear the 'suppress' flag for all fields - */ -static void -clear_suppress(cob_report_line *l) -{ - cob_report_field *f; - l->suppress = FALSE; - for(f=l->fields; f; f=f->next) { - if((f->flags & COB_REPORT_GROUP_ITEM)) - continue; - f->suppress = FALSE; - } - if(l->child) - clear_suppress(l->child); - if(l->sister) - clear_suppress(l->sister); -} - -/* - * Return control field sequence value for given report line - * else return -1 - */ -static int -get_control_sequence(cob_report *r, cob_report_line *l) -{ - cob_report_control *c; - cob_report_control_ref *rr; - if(r->controls) { - for(c=r->controls; c; c = c->next) { - for(rr=c->control_ref; rr; rr=rr->next) { - if(rr->ref_line == l) { - return c->sequence; - } - } - } - } - return -1; -} - -/* - * If this line has NEXT GROUP .... then set info in report header - */ -static void -set_next_info(cob_report *r, cob_report_line *l) -{ - if(l->flags & COB_REPORT_NEXT_GROUP_LINE) { - r->next_value = l->next_group_line; - r->next_line = TRUE; - r->next_just_set = TRUE; - r->next_line_plus = FALSE; - DEBUG_LOG("rw",(" Save NEXT GROUP LINE %d\n",r->next_value)); - } - if(l->flags & COB_REPORT_NEXT_GROUP_PLUS) { - r->next_value = l->next_group_line; - r->next_line = FALSE; - r->next_line_plus = TRUE; - r->next_just_set = TRUE; - DEBUG_LOG("rw",(" Save NEXT GROUP PLUS %d\n",r->next_value)); - } - if(l->flags & COB_REPORT_NEXT_GROUP_PAGE) { - r->next_value = l->next_group_line; - r->next_line = FALSE; - r->next_page = TRUE; - r->next_just_set = TRUE; - DEBUG_LOG("rw",(" Save NEXT GROUP PAGE\n")); - } -} - -static cob_report_line * -get_print_line(cob_report_line *l) -{ - while(l - && l->fields == NULL - && l->child != NULL) - l = l->child; /* Find line with data fields */ - return l; -} - -/* - * Do any global initialization needed - */ -static void -reportInitialize() -{ - if(bDidReportInit) - return; - bDidReportInit = 1; -} - -/* - * Add Two Fields together giving Result - */ -static void -cob_add_fields(cob_field *op1, cob_field *op2, cob_field *rslt) -{ - cob_field_attr attr1, attr2; - char data1[30],data2[30]; - cob_field fld1,fld2; -#ifdef COB_DEBUG_LOG - char wrk[32]; -#endif - - /* Copy data to local PIC 9 DISPLAY fields */ - /* As cob_add does not handle NUMERIC_EDITED very well */ - fld1.size = op1->size; - attr1 = *op1->attr; - fld1.attr = &attr1; - attr1.type = COB_TYPE_NUMERIC_DISPLAY; - fld1.data = (unsigned char*)data1; - memset(data1,'0',fld1.size); - cob_move(op1, &fld1); - -#ifdef COB_DEBUG_LOG - if(DEBUG_ISON("rw")) { - cob_field_to_string(op1, wrk, sizeof(wrk)-1); - DEBUG_LOG("rw",(" Add '%s' ",wrk)); - } -#endif - - fld2.size = op2->size; - attr2 = *op2->attr; - fld2.attr = &attr2; - attr2.type = COB_TYPE_NUMERIC_DISPLAY; - fld2.data = (unsigned char*)data2; - memset(data2,'0',fld2.size); - cob_move(op2, &fld2); - -#ifdef COB_DEBUG_LOG - if(DEBUG_ISON("rw")) { - cob_field_to_string(op2, wrk, sizeof(wrk)-1); - DEBUG_LOG("rw",("TO '%s' ",wrk)); - } -#endif - - cob_add(&fld1,&fld2,0); - - cob_move(&fld1, rslt); /* Copy SUM back to result field */ - -#ifdef COB_DEBUG_LOG - if(DEBUG_ISON("rw")) { - cob_field_to_string(&fld1, wrk, sizeof(wrk)-1); - DEBUG_LOG("rw",("GIVING '%s' ",wrk)); - DEBUG_LOG("rw",(" PIC 9(%d)",rslt->attr->digits)); - if(rslt->attr->scale > 0) - DEBUG_LOG("rw",("V9(%d)",rslt->attr->scale)); - DEBUG_LOG("rw",("\n")); - } -#endif -} - -#ifdef COB_DEBUG_LOG -static void -dumpFlags(int flags, int ln, char *name) -{ - if (!DEBUG_ISON("rw")) { - return; - } - - if(name == NULL) - name = (char*)""; - if(flags & COB_REPORT_HEADING) DEBUG_LOG("rw",("REPORT HEADING ")); - if(flags & COB_REPORT_FOOTING) DEBUG_LOG("rw",("REPORT FOOTING ")); - if(flags & COB_REPORT_PAGE_HEADING) DEBUG_LOG("rw",("PAGE HEADING ")); - if(flags & COB_REPORT_PAGE_FOOTING) DEBUG_LOG("rw",("PAGE FOOTING ")); - if(flags & COB_REPORT_CONTROL_HEADING) DEBUG_LOG("rw",("CONTROL HEADING %s ",name)); - if(flags & COB_REPORT_CONTROL_HEADING_FINAL) DEBUG_LOG("rw",("CONTROL HEADING FINAL ")); - if(flags & COB_REPORT_CONTROL_FOOTING) { - if(flags & COB_REPORT_ALL) - DEBUG_LOG("rw",("CONTROL FOOTING %s ",name)); - else - DEBUG_LOG("rw",("CONTROL FOOTING ALL ")); - } - if(flags & COB_REPORT_CONTROL_FOOTING_FINAL) DEBUG_LOG("rw",("CONTROL FOOTING FINAL ")); - if(flags & COB_REPORT_DETAIL) DEBUG_LOG("rw",("DETAIL ")); - if(flags & COB_REPORT_LINE_PLUS) {if(ln > 0) DEBUG_LOG("rw",("LINE PLUS %d ",ln));} - else if(flags & COB_REPORT_LINE) DEBUG_LOG("rw",("LINE %d ",ln)); - if(flags & COB_REPORT_LINE_NEXT_PAGE) DEBUG_LOG("rw",("LINE NEXT PAGE ")); - if(flags & COB_REPORT_NEXT_PAGE) DEBUG_LOG("rw",("NEXT PAGE ")); - if(flags & COB_REPORT_GROUP_INDICATE) DEBUG_LOG("rw",("GROUP INDICATE ")); - if(flags & COB_REPORT_COLUMN_PLUS) DEBUG_LOG("rw",("COLUMN PLUS ")); - if(flags & COB_REPORT_RESET_FINAL) DEBUG_LOG("rw",("RESET FINAL ")); - if(flags & COB_REPORT_COLUMN_LEFT) DEBUG_LOG("rw",("LEFT ")); - if(flags & COB_REPORT_COLUMN_RIGHT) DEBUG_LOG("rw",("RIGHT ")); - if(flags & COB_REPORT_COLUMN_CENTER) DEBUG_LOG("rw",("CENTER ")); - if(flags & COB_REPORT_GROUP_ITEM) DEBUG_LOG("rw",("GROUP ")); - if(flags & COB_REPORT_PRESENT) { - if(flags & COB_REPORT_NEGATE) { - if(flags & COB_REPORT_BEFORE) { - DEBUG_LOG("rw",("ABSENT BEFORE ")); - } else { - DEBUG_LOG("rw",("ABSENT AFTER ")); - } - } else { - if(flags & COB_REPORT_BEFORE) { - DEBUG_LOG("rw",("PRESENT BEFORE ")); - } else { - DEBUG_LOG("rw",("PRESENT AFTER ")); - } - } - if(flags & COB_REPORT_PAGE) DEBUG_LOG("rw",("PAGE ")); - if(flags & COB_REPORT_ALL) DEBUG_LOG("rw",("ALL ")); - } - else if(flags & COB_REPORT_HAD_WHEN) DEBUG_LOG("rw",("WHEN ")); -} -#endif - -#ifdef COB_DEBUG_LOG -static void -reportDumpOneLine(const cob_report *r, cob_report_line *fl, int indent, int dumpdata) -{ - cob_report_field *rf; - cob_report_control *c; - cob_report_control_ref *rr; - cob_report_control *rc; - int sequence = -1; - char idnt[48], wrk[200]; - - if (!DEBUG_ISON("rw")) { - return; - } - sprintf(idnt,"%.*s",indent>30?30:indent,".................................."); - DEBUG_LOG("rw",("%s ",idnt)); - if (dumpdata) { - DEBUG_LOG("rw",("Line# %d of Page# %d; ",r->curr_line,r->curr_page)); - } - if (r->controls) { - for(c=r->controls; c; c = c->next) { - for(rr=c->control_ref; rr; rr=rr->next) { - if(rr->ref_line == fl) { - strcpy(wrk,c->name); - sequence = c->sequence; - break; - } - } - } - } - dumpFlags(fl->report_flags,fl->line,wrk); - if(fl->step_count) DEBUG_LOG("rw",("Step %3d ",fl->step_count)); - if(fl->suppress) DEBUG_LOG("rw",("Suppress Line ")); - if(fl->next_group_line) { - DEBUG_LOG("rw",("NEXT ",fl->next_group_line)); - if(fl->report_flags & COB_REPORT_NEXT_GROUP_LINE) DEBUG_LOG("rw",("GROUP LINE ")); - if(fl->report_flags & COB_REPORT_NEXT_GROUP_PLUS) DEBUG_LOG("rw",("GROUP PLUS ")); - if(fl->report_flags & COB_REPORT_NEXT_GROUP_PAGE) DEBUG_LOG("rw",("GROUP PAGE ")); - DEBUG_LOG("rw",("%d ",fl->next_group_line)); - } else { - if(fl->report_flags & COB_REPORT_NEXT_GROUP_PAGE) DEBUG_LOG("rw",("NEXT GROUP PAGE ")); - } - if(fl->control) { - cob_field_to_string(fl->control, wrk, sizeof(wrk)-1); - if(wrk[0] >= ' ') - DEBUG_LOG("rw",("Line Control %d is '%s' ",sequence,wrk)); - } - DEBUG_LOG("rw",("\n")); - if(!(fl->flags & COB_REPORT_DETAIL)) dumpdata = 1; - for(rf = fl->fields; rf; rf = rf->next) { - DEBUG_LOG("rw",("%s %02d Field ",idnt,rf->level)); - if(rf->line) DEBUG_LOG("rw",("Line %2d ",rf->line)); - if(rf->column) DEBUG_LOG("rw",("Col %3d ",rf->column)); - if(rf->step_count) DEBUG_LOG("rw",("Step %3d ",rf->step_count)); - if(rf->next_group_line) DEBUG_LOG("rw",("NextGrp %d ",rf->next_group_line)); - if(dumpdata) { - if(!(rf->flags & COB_REPORT_GROUP_ITEM)) { - if(rf->f) { - if(rf->litval) { - DEBUG_LOG("rw",(" \"%s\" ",rf->litval)); - } else { - cob_field_to_string(rf->f, wrk, sizeof(wrk)-1); - DEBUG_LOG("rw",(" '%s' ",wrk)); - } - } - } - if(rf->source - && cob_cmp(rf->f,rf->source) != 0) { - if(rf->source == r->page_counter) { - DEBUG_LOG("rw",("Source PAGE-COUNTER ")); - } else if(rf->source == r->line_counter) { - DEBUG_LOG("rw",("Source LINE-COUNTER ")); - } - } - if((rf->flags & COB_REPORT_PRESENT) - && !rf->present_now - && r->initiate_done) { - dumpFlags(rf->flags& ~(COB_REPORT_PRESENT|COB_REPORT_HAD_WHEN),rf->line,NULL); - if((rf->flags & COB_REPORT_NEGATE)) - DEBUG_LOG("rw",("ABSENT")); - else - DEBUG_LOG("rw",("Not PRESENT")); - } else - if((rf->flags & COB_REPORT_GROUP_ITEM) - && rf->suppress) { - dumpFlags(rf->flags& ~(COB_REPORT_GROUP_ITEM|COB_REPORT_HAD_WHEN),rf->line,NULL); - DEBUG_LOG("rw",("Suppress group")); - } else { - dumpFlags(rf->flags,rf->line,NULL); - } - if(rf->control - && (!(rf->flags & COB_REPORT_PRESENT) || rf->present_now || !r->initiate_done) ) { - strcpy(wrk,""); - for(rc = r->controls; rc; rc = rc->next) { - if(rc->f == rf->control) { - strcpy(wrk,rc->name); - break; - } - } - if(wrk[0] >= ' ') - DEBUG_LOG("rw",("Control %s ",wrk)); - } - } - if(!(rf->flags & COB_REPORT_GROUP_ITEM) - && rf->suppress) - DEBUG_LOG("rw",("Suppress field")); - DEBUG_LOG("rw",("\n")); - } -} -#endif - -#ifdef COB_DEBUG_LOG -/* - * Dump REPORT line and walk down tree - */ -static void -reportDumpLine(const cob_report *r, cob_report_line *fl, int indent) -{ - if(!DEBUG_ISON("rw")) - return; - reportDumpOneLine(r,fl,indent,0); - if(fl->child) - reportDumpLine(r,fl->child,indent+2); - if(fl->sister) - reportDumpLine(r,fl->sister,indent); -} -#endif - -#ifdef COB_DEBUG_LOG -/* - * Dump entire REPORT definition tables - */ -static void -reportDump(const cob_report *r, const char *msg) -{ - cob_report_control *c; - char wrk[80]; - - if (!DEBUG_ISON("rw")) { - return; - } - DEBUG_LOG("rw",("Dump of Report '%s' for %s\n",r->report_name,msg)); - if (r->report_file) { - DEBUG_LOG("rw",("Using File %s ",r->report_file->select_name)); - if(r->report_file->assign - && r->report_file->assign->data) { - DEBUG_LOG("rw",(" ASSIGNed to %s",r->report_file->assign->data)); - } - DEBUG_LOG("rw",(" Rcsz min %d max %d ",r->report_file->record_min,r->report_file->record_max)); -#if 0 - /* - * TODO: This needs more work. Cross check how fileio.c handles print files - * and exactly what operations should be used - */ - if(r->report_file->flag_select_features & COB_SELECT_LINAGE) { - DEBUG_LOG("rw",("has LINAGE")); - } else { - /* - * Create LINAGE clause fields for fileio.c so that - * the output file looks more like what Micro Focus would create - */ - cob_linage *lingptr; - if(r->report_file->linorkeyptr == NULL) { - r->report_file->linorkeyptr = cob_malloc(sizeof(cob_linage)); - lingptr = r->report_file->linorkeyptr; - lingptr->lin_top = r->def_heading; - lingptr->lin_bot = r->def_footing; - lingptr->linage = cob_field_dup(r->line_counter,0); - lingptr->linage_ctr = cob_field_dup(r->line_counter,0); - r->report_file->flag_select_features |= COB_SELECT_LINAGE; - } - DEBUG_LOG("rw",("had NO LINAGE!")); - } -#endif - DEBUG_LOG("rw",("\n")); - } - DEBUG_LOG("rw",("\n")); - DEBUG_LOG("rw",("Default Lines: %4d Columns: %4d\n",r->def_lines,r->def_cols)); - DEBUG_LOG("rw",(" Heading: %4d Footing: %4d\n",r->def_heading,r->def_footing)); - DEBUG_LOG("rw",(" Detail: %4d Control: %4d Last detail: %4d\n",r->def_first_detail, - r->def_last_control,r->def_last_detail)); - if((r->curr_page+r->curr_status+r->curr_line+r->curr_cols) > 0) { - DEBUG_LOG("rw",("Current Page: %4d Status: %4d\n",r->curr_page,r->curr_status)); - DEBUG_LOG("rw",(" Line: %4d Column: %4d\n",r->curr_line,r->curr_cols)); - } - DEBUG_LOG("rw",("\n")); - if(r->controls) { - for(c=r->controls; c; c = c->next) { - DEBUG_LOG("rw",(" Control %s ",c->name)); - if(c->f) { - cob_field_to_string(c->f, wrk, sizeof(wrk)-1); - if(wrk[0] >= ' ') - DEBUG_LOG("rw",("has '%s' ",wrk)); - } - if(c->val) { - cob_field_to_string(c->val, wrk, sizeof(wrk)-1); - if(wrk[0] >= ' ') - DEBUG_LOG("rw",("Value '%s' ",wrk)); - } - DEBUG_LOG("rw",("\n")); - } - } - reportDumpLine(r,r->first_line,0); - DEBUG_LOG("rw",("\n")); -} -#endif - -/* - * Verify that each LINE # is within PAGE LIMITS - */ -static void -limitCheckOneLine(cob_report *r, cob_report_line *fl) -{ - cob_report_field *rf; - - if((fl->line > 0 && r->def_lines > 0 && fl->line > r->def_lines)) { - cob_runtime_error (_("INITIATE %s LINE %d exceeds PAGE LIMIT %d"),r->report_name,fl->line,r->def_lines); - DEBUG_LOG("rw",("PAGE LIMITs is incorrect; LINE %d > LIMIT %d\n",fl->line,r->def_lines)); - cob_set_exception (COB_EC_REPORT_PAGE_LIMIT); - r->initiate_done = FALSE; - return; - } - if((fl->next_group_line > 0 && r->def_lines > 0 && fl->next_group_line > r->def_lines)) { - cob_runtime_error (_("INITIATE %s NEXT GROUP %d exceeds PAGE LIMIT"),r->report_name,fl->next_group_line); - DEBUG_LOG("rw",("PAGE LIMITs is incorrect; NEXT GROUP %d > LIMIT %d\n",fl->next_group_line,r->def_lines)); - cob_set_exception (COB_EC_REPORT_PAGE_LIMIT); - r->initiate_done = FALSE; - return; - } - for(rf = fl->fields; rf; rf = rf->next) { - if((rf->line && rf->line > r->def_lines)) { - cob_runtime_error (_("INITIATE %s LINE %d exceeds PAGE LIMIT"),r->report_name,rf->line); - DEBUG_LOG("rw",("PAGE LIMITs is incorrect; LINE %d > LIMIT %d\n",rf->line,r->def_lines)); - cob_set_exception (COB_EC_REPORT_PAGE_LIMIT); - r->initiate_done = FALSE; - return; - } - if((rf->next_group_line && rf->next_group_line > r->def_lines)) { - cob_runtime_error (_("INITIATE %s NEXT GROUP %d exceeds PAGE LIMIT"),r->report_name,rf->next_group_line); - DEBUG_LOG("rw",("PAGE LIMITs is incorrect; NEXT GROUP %d > LIMIT %d\n",rf->next_group_line,r->def_lines)); - cob_set_exception (COB_EC_REPORT_PAGE_LIMIT); - r->initiate_done = FALSE; - return; - } - } -} - -/* - * Verify that LINE # is within PAGE LIMITS - */ -static void -limitCheckLine(cob_report *r, cob_report_line *fl) -{ - limitCheckOneLine(r,fl); - if(fl->child) - limitCheckLine(r,fl->child); - if(fl->sister) - limitCheckLine(r,fl->sister); -} - -/* - * Verify that all LINE # are within PAGE LIMITS - */ -static void -limitCheck(cob_report *r) -{ - limitCheckLine(r,r->first_line); -} - -static void -saveLineCounter(cob_report *r) -{ - int ln = r->curr_line; - if(ln > r->def_lines) - ln = 0; - if(ln < 0) - ln = 0; - - cob_set_int(r->page_counter,r->curr_page); - cob_set_int(r->line_counter,ln); -} - -/* - * Search one LINE for Control field - */ -static void -line_control_one (cob_report *r, cob_report_line *l, cob_field *f) -{ - cob_report_field *rf; - cob_report_control *rc; - char fld[COB_MAX_WORDLEN + 1]; - if (l == NULL) - return; - for(rf = l->fields; rf; rf = rf->next) { - if(!(rf->flags & COB_REPORT_PRESENT)) - continue; - fld[0] = 0; - for (rc = r->controls; rc; rc = rc->next) { - if (rc->f == rf->control) { - strncpy (fld, rc->name, COB_MAX_WORDLEN); - fld[COB_MAX_WORDLEN] = 0; - break; - } - } - if(!(rf->flags & COB_REPORT_NEGATE) - && !rf->present_now) { - if(f == NULL) { /* New Page */ - DEBUG_LOG("rw",("PRESENT NOW: %s NEW PAGE\n",fld)); - if(rf->flags & COB_REPORT_PAGE) { /* PRESENT After New Page */ - rf->present_now = 1; - } - } else if(rf->control == f) { /* Control field changed */ - DEBUG_LOG("rw",("PRESENT NOW: %s control change\n",fld)); - rf->present_now = 1; - } - } else - if((rf->flags & COB_REPORT_NEGATE) - && rf->present_now) { - if(f == NULL) { /* New Page */ - DEBUG_LOG("rw",("ABSENT NOW: %s NEW PAGE\n",fld)); - if(rf->flags & COB_REPORT_PAGE) { /* PRESENT After New Page */ - rf->present_now = 0; - } - } else if(rf->control == f) { /* Control field changed */ - DEBUG_LOG("rw",("ABSENT NOW: %s control change\n",fld)); - rf->present_now = 0; - } - } - } -} - -/* - * Search Report for Control field - */ -static void -line_control_chg(cob_report *r, cob_report_line *l, cob_field *f) -{ - line_control_one(r,l,f); - if(l->child) - line_control_chg(r,l->child,f); - if(l->sister) - line_control_chg(r,l->sister,f); -} - -/* - * Write one line of report - */ -static void -write_rec(cob_report *r, int opt) -{ - cob_file *f = r->report_file; - int num = opt & COB_WRITE_MASK; - - if (f->record->size > (unsigned int)r->def_cols) /* Truncate line if needed */ - f->record->size = r->def_cols; - - if (r->code_is_present - && r->code_len > 0) { /* Insert CODE IS value */ - if (f->file) { - if (num > 1 - && (opt & COB_WRITE_LINES)) { - opt = (opt & ~COB_WRITE_MASK) | 1; - while (num > 0) { - fwrite(r->code_is, r->code_len, 1, (FILE*)f->file); - cob_write(f, f->record, opt, NULL, 0); - memset(f->record->data,' ',f->record->size); - num--; - } - } else { - fwrite(r->code_is, r->code_len, 1, (FILE*)f->file); - cob_write(f, f->record, opt, NULL, 0); - } - } - } else { - cob_write(f, f->record, opt, NULL, 0); - } -} - -/* - * Write the Page Footing - */ -static void -do_page_footing(cob_report *r) -{ - cob_file *f = r->report_file; - char *rec; - - if(r->in_page_footing) - return; - rec = (char *)f->record->data; - r->in_page_footing = TRUE; - report_line_type(r,r->first_line,COB_REPORT_PAGE_FOOTING); - memset(rec,' ',f->record_max); - if(r->curr_line < r->def_lines) { - write_rec(r, COB_WRITE_BEFORE|COB_WRITE_LINES|(r->def_lines-r->curr_line)); - r->curr_line = r->def_lines; - r->incr_line = FALSE; - } else { - r->curr_line = 1; - } - saveLineCounter(r); - r->first_detail = TRUE; - r->in_page_footing = FALSE; -} - -/* - * Write the Page Heading - */ -static void -do_page_heading(cob_report *r) -{ - cob_file *f = r->report_file; - char *rec; - int opt; - - if(r->in_page_heading) - return; - opt = COB_WRITE_BEFORE | COB_WRITE_LINES | 1; - rec = (char *)f->record->data; - memset(rec,' ',f->record_max); - if(!r->in_page_heading - && !r->first_generate - && r->def_lines > 0 - && r->def_heading > 0 - && r->curr_line <= r->def_lines - && r->curr_line > r->def_heading) { /* Skip to end of page */ - while(r->curr_line <= r->def_lines) { - write_rec(r, opt); - r->curr_line++; - } - if(r->curr_line > r->def_lines) /* Reset line to 1 */ - r->curr_line = 1; - saveLineCounter(r); - } - r->in_page_heading = TRUE; - if(!r->first_generate) { - r->curr_page++; - } - r->first_detail = FALSE; - while(r->curr_line < r->def_heading) { /* Skip to Heading position on page */ - write_rec(r, opt); - r->curr_line++; - saveLineCounter(r); - } - report_line_type(r,r->first_line,COB_REPORT_PAGE_HEADING); - memset(rec,' ',f->record_max); - while(r->curr_line < r->def_first_detail) { - write_rec(r, opt); - r->curr_line++; - saveLineCounter(r); - } - clear_group_indicate(r->first_line); - r->in_page_heading = FALSE; - line_control_chg(r, r->first_line, NULL); -} - -/* - * Format one field into print line - */ -static void -print_field(cob_report_field *rf, char *rec) -{ - char wrk[COB_SMALL_BUFF]; - size_t ln, k, i; - size_t dest_pos = (size_t)rf->column - 1; - - cob_field_to_string(rf->f, wrk, sizeof(wrk)-1); - wrk[COB_SMALL_MAX] = 0; /* keep analyzer happy */ - ln = strlen(wrk); - if(cobsetptr - && !cobsetptr->cob_col_just_lrc) { - /* Data justify is turned off, no adjustment */ - } else - if((rf->flags & COB_REPORT_COLUMN_RIGHT) - && ln < rf->f->size) { - dest_pos += rf->f->size - ln; - } else - if((rf->flags & COB_REPORT_COLUMN_CENTER)) { - for(k=0; k < rf->f->size && wrk[0] == ' ' && ln > 0; k++) { /* remove leading spaces */ - memmove(wrk,&wrk[1],ln); - ln--; - } - i = 1- (ln & 1); - if (ln < rf->f->size) { - dest_pos += (rf->f->size - ln - i) / 2; - } - } else - if((rf->flags & COB_REPORT_COLUMN_LEFT)) { - for(k=0; k < rf->f->size && wrk[0] == ' ' && ln > 0; k++) { /* remove leading spaces */ - memmove(wrk,&wrk[1],ln); - ln--; - } - } - memcpy (&rec[dest_pos], wrk, ln); -} - -/* - * GENERATE one report-line - */ -static void -report_line(cob_report *r, cob_report_line *l) -{ - cob_report_field *rf,*nrf,*prf; - cob_file *f = r->report_file; - char *rec,wrk[COB_SMALL_BUFF]; - int bChkLinePlus = FALSE; - int opt; - - opt = COB_WRITE_BEFORE | COB_WRITE_LINES | 1; - rec = (char *)f->record->data; - if(rec) { - memset(rec,' ',f->record_max); - memset(wrk,0,sizeof(wrk)); - if(r->curr_line > r->def_last_detail - && !r->in_report_footing - && !r->in_page_footing) { /* Page overflow */ - do_page_footing(r); - do_page_heading(r); - } - if(!r->next_just_set && r->next_line_plus) { - DEBUG_LOG("rw",(" Line# %d of Page# %d; ",r->curr_line,r->curr_page)); - DEBUG_LOG("rw",("Execute NEXT GROUP PLUS %d\n",r->next_value)); - opt = COB_WRITE_BEFORE | COB_WRITE_LINES | (r->next_value); - write_rec(r, opt); - r->curr_line += r->next_value; - r->next_line_plus = FALSE; - bChkLinePlus = TRUE; - } else - if(!r->next_just_set && r->next_line) { - DEBUG_LOG("rw",(" Line# %d of Page# %d; ",r->curr_line,r->curr_page)); - DEBUG_LOG("rw",("Execute NEXT GROUP LINE %d\n",r->next_value)); - r->next_line = FALSE; - if(r->curr_line > r->next_value) { - do_page_footing(r); - do_page_heading(r); - } - while(r->curr_line < r->next_value) { - write_rec(r, opt); - r->curr_line++; - } - bChkLinePlus = TRUE; - } else - if(!r->next_just_set && r->next_page) { - DEBUG_LOG("rw",(" Line# %d of Page# %d; ",r->curr_line,r->curr_page)); - DEBUG_LOG("rw",(" Execute NEXT GROUP PAGE\n")); - r->next_page = FALSE; - do_page_footing(r); - do_page_heading(r); - DEBUG_LOG("rw",(" Line# %d of Page# %d; after foot/head\n",r->curr_line,r->curr_page)); - } else - if( !(l->flags & COB_REPORT_LINE_PLUS) - && (l->flags & COB_REPORT_LINE)) { - if(r->curr_line > l->line) { - DEBUG_LOG("rw",(" Eject Page %d from line %d for Line %d\n",r->curr_page,r->curr_line,l->line)); - do_page_footing(r); - if(r->in_report_footing) { - r->curr_page++; /* Now on next page */ - r->curr_line = 1; - } else { - do_page_heading(r); - } - r->first_detail = FALSE; - } - while(r->curr_line < l->line) { - write_rec(r, opt); - r->curr_line++; - } - } else { - bChkLinePlus = TRUE; - } - - if(bChkLinePlus - && (l->flags & COB_REPORT_LINE_PLUS) - && l->line > 1) { - if(r->curr_line != r->def_first_detail - || r->def_first_detail == 0) { - opt = COB_WRITE_BEFORE | COB_WRITE_LINES | (l->line - 1); - write_rec(r, opt); - r->curr_line += l->line - 1; - } - } - bChkLinePlus = FALSE; - if(r->curr_line > r->def_last_detail - && !r->in_report_footing - && !r->in_page_heading - && !r->in_page_footing) { /* Page overflow */ - do_page_footing(r); - do_page_heading(r); - } - saveLineCounter(r); - if(l->fields == NULL) { - set_next_info(r,l); - return; - } - if(l->suppress) { -#ifdef COB_DEBUG_LOG - if(DEBUG_ISON("rw")) { - reportDumpOneLine(r,l,0,1); - DEBUG_LOG("rw",(" ^^^ Complete line Suppressed ^^^\n\n")); - } -#endif - set_next_info(r,l); - return; - } - - /* - * Copy fields to print line area - */ - for(rf = l->fields; rf; rf = rf->next) { - if((rf->flags & COB_REPORT_GROUP_ITEM)) { - if(rf->suppress) { - /* group item SUPPRESSed printing, so skip to next field */ - rf->suppress = FALSE; - prf = rf; - for(nrf = rf->next; nrf && nrf->level > rf->level; nrf = nrf->next) { - prf = nrf; - } - if(prf) { - rf = prf; /* Continue from here */ - continue; - } - break; /* No more so, end of print line */ - } - continue; /* Group items are not printed */ - } - if( (rf->flags & COB_REPORT_PRESENT) - && !rf->present_now) { - continue; - } - if(rf->suppress - || rf->group_indicate) { - if(rf->source) { /* Copy source field in */ - cob_field_to_string(rf->source, wrk, sizeof(wrk)-1); - } - continue; - } - if(rf->source) { /* Copy source field in */ - cob_move(rf->source,rf->f); - print_field(rf, rec); - } else if(rf->litval) { /* Refresh literal value */ - if(rf->f) { - cob_str_move(rf->f, (unsigned char*)rf->litval, rf->litlen); - } - memcpy(&rec[rf->column-1], rf->litval, rf->litlen); - } else if(rf->f) { - print_field(rf, rec); - } - if((rf->flags & COB_REPORT_GROUP_INDICATE)) { /* Suppress subsequent printings */ - rf->group_indicate = TRUE; - } - } - } -#ifdef COB_DEBUG_LOG - if(DEBUG_ISON("rw")) { - reportDumpOneLine(r,l,0,1); - for(opt = f->record_max; opt > 1 && rec[opt-1] == ' '; opt--); - DEBUG_LOG("rw",("%.*s\n\n",opt,rec)); - } -#endif - for(rf = l->fields; rf; rf = rf->next) { - rf->present_now = (rf->flags & COB_REPORT_NEGATE)?1:0; - } - if(rec) { - opt = COB_WRITE_BEFORE | COB_WRITE_LINES | 1; - write_rec(r, opt); - r->curr_line ++; - saveLineCounter(r); - } - - set_next_info(r,l); -} - -/* - * GENERATE one report-line - */ -static void -report_line_and(cob_report *r, cob_report_line *l, int type) -{ - if(l == NULL) - return; - if(l->fields == NULL - && l->child != NULL) { - if(l->flags & type) { - report_line(r,l); - if(l->child) { - report_line_type(r,l->child,COB_REPORT_LINE); - } - return; - } - l = l->child; - } - report_line_type(r,l,type); -} - -/* - * Find Report Line of given type - */ -static cob_report_line * -get_line_type(cob_report *r, cob_report_line *l, int type) -{ - cob_report_line *t; - if(l == NULL) - return NULL; - if(l->flags & type) { - return l; - } - if(l->child) - if ((t = get_line_type(r,l->child,type)) != NULL) - return t; - if(l->sister) - return get_line_type(r,l->sister,type); - return NULL; -} - - -/* - * GENERATE report-line(s) of type - */ -static int -report_line_type(cob_report *r, cob_report_line *l, int type) -{ - int curseq,sisseq; - if(l == NULL) - return 0; - if(l->flags & type) { - report_line(r,l); - if(l->child) { - report_line_type(r,l->child,COB_REPORT_LINE); - } - if(l->sister) { - if((type == COB_REPORT_CONTROL_FOOTING) - && (l->sister->flags & COB_REPORT_CONTROL_FOOTING)) { - curseq = get_control_sequence(r,l); - sisseq = get_control_sequence(r,l->sister); - if(curseq > 0 - && sisseq > 0 - && sisseq > curseq) { -#ifdef COB_DEBUG_LOG - reportDumpOneLine(r,l->sister,0,1); -#endif - return 1; - } - } - report_line_type(r,l->sister,type); - } - return 1; - } - if(l->child) - if(report_line_type(r,l->child,type)) - return 1; - if(l->sister) - return report_line_type(r,l->sister,type); - return 0; -} - -/* - * SUM all DETAIL counters - */ -static void -sum_all_detail(cob_report *r) -{ - cob_report_sum_ctr *sc; - cob_report_sum *rs; - int bHasSum = FALSE; - - /* - * Add up all SUM counter values - */ - for(sc = r->sum_counters; sc; sc = sc->next) { - for(rs = sc->sum; rs && !sc->subtotal; rs = rs->next) { - if(!bHasSum) { - bHasSum = TRUE; - DEBUG_LOG("rw",(" Do SUM detail counters:\n")); - } - DEBUG_LOG("rw",(" .. %-20s ",sc->name)); - cob_add_fields(sc->counter,rs->f,sc->counter); - } - } -} - -/* - * If the counter is part of another SUM then it is 'rolling forward' - */ -static void -sum_this_counter(cob_report *r, cob_field *counter) -{ - cob_report_sum_ctr *sc; - cob_report_sum *rs; - - for(sc = r->sum_counters; sc; sc = sc->next) { - for(rs = sc->sum; rs; rs = rs->next) { - if(rs->f == counter) { - DEBUG_LOG("rw",("SUM %s forward ",sc->name)); - for(rs = sc->sum; rs; rs = rs->next) { - cob_add_fields(sc->counter,rs->f,sc->counter); - } - break; - } - } - } -} - -/* - * ZERO counters for a given control level - */ -static void -zero_all_counters(cob_report *r, int flag, cob_report_line *l) -{ - cob_report_sum_ctr *sc; - cob_report_sum *rs; - cob_report_control *rc; - cob_report_control_ref *rr; - - l = get_print_line(l); - /* - * ZERO SUM counter - */ - for(sc = r->sum_counters; sc; sc = sc->next) { - for(rs = sc->sum; rs; rs = rs->next) { - if((flag & COB_REPORT_CONTROL_FOOTING_FINAL)) { - if(sc->control_final) { - DEBUG_LOG("rw",("ZERO SUM Counter %s for FOOTING FINAL\n",sc->name)); - cob_field_init(sc->counter); - } - } else if(sc->control) { - rc = sc->control; - for(rr = rc->control_ref; rr; rr=rr->next) { - if(rr->ref_line - && (rr->ref_line->flags & COB_REPORT_CONTROL_HEADING)) - continue; - if(rr->ref_line - && (rr->ref_line->flags & COB_REPORT_CONTROL_HEADING_FINAL)) - continue; - if(l != NULL - && l != get_print_line(rr->ref_line)) - continue; - if(rr->ref_line - && (rr->ref_line->flags & flag)) { - sum_this_counter(r,sc->counter); -#if defined(COB_DEBUG_LOG) - DEBUG_LOG("rw",("ZERO SUM counter %s for ",sc->name)); - dumpFlags(rr->ref_line->flags,0,(char*)rc->name); - DEBUG_LOG("rw",("\n")); -#endif - cob_field_init(sc->counter); - } - } - } - } - } -} - -/* - * Runtime starting up - */ -void -cob_init_reportio(cob_global *gptr, cob_settings *sptr) -{ - int k; - cobglobptr = gptr; - cobsetptr = sptr; - for(k=0; k < MAX_ACTIVE_REPORTS; k++) - active_reports[k] = NULL; -} - -/* - * Runtime exiting - */ -void -cob_exit_reportio() -{ - int k; - for(k=0; k < MAX_ACTIVE_REPORTS; k++) { - if(active_reports[k] != NULL) { - free_control_fields (active_reports[k]); - } - } -} - -/* - * INITIATE report - */ -void -cob_report_initiate(cob_report *r) -{ - cob_report_control *rc; - cob_report_control_ref *rr; - cob_report_sum_ctr *sc; - int k; - - reportInitialize(); - if(r->initiate_done) { - cob_runtime_error (_("INITIATE %s was already done"),r->report_name); - DEBUG_LOG("rw",("REPORT was already INITIATEd\n")); - cob_set_exception (COB_EC_REPORT_ACTIVE); - return; - } - if (r->def_lines > 9999) - r->def_lines = 9999; - if (r->def_cols > 999 - || r->def_cols < 1) - r->def_cols = 999; - if((r->def_first_detail > 0 && !(r->def_first_detail >= r->def_heading)) - || (r->def_last_detail > 0 && !(r->def_last_detail >= r->def_first_detail)) - || (r->def_footing > 0 && !(r->def_footing >= r->def_heading)) - || (r->def_footing > 0 && !(r->def_footing >= r->def_last_detail)) - || (r->def_lines > 0 && !(r->def_lines >= r->def_heading)) - || (r->def_lines > 0 && !(r->def_lines >= r->def_footing))) { - cob_runtime_error (_("INITIATE %s PAGE LIMIT problem"),r->report_name); -#if defined(COB_DEBUG_LOG) - DEBUG_LOG("rw",("PAGE LIMITs is incorrect\n")); - reportDump(r,"INITIATE"); -#endif - cob_set_exception (COB_EC_REPORT_PAGE_LIMIT); - return; - } - r->curr_page = 1; - r->curr_line = 0; - r->incr_line = TRUE; - saveLineCounter(r); -#if defined(COB_DEBUG_LOG) - reportDump(r,"INITIATE"); -#endif - r->initiate_done = TRUE; - limitCheck(r); - if(!r->initiate_done) /* Problem during LIMIT check */ - return; - r->first_detail = TRUE; - r->first_generate = TRUE; - r->next_value = 0; - r->next_line = 0; - r->next_line_plus = FALSE; - r->next_page = FALSE; - /* - * Allocate temp area for each control field - */ - for(rc = r->controls; rc; rc = rc->next) { - if(rc->val) { - cob_field_free(rc->val); - rc->val = NULL; - } - if(rc->sf) { - cob_field_free(rc->sf); - rc->sf = NULL; - } - rc->val = cob_field_dup(rc->f,0); - rc->sf = cob_field_dup(rc->f,0); - for(k=0; k < MAX_ACTIVE_REPORTS; k++) { - if (active_reports[k] == r) - break; - if (active_reports[k] == NULL) { - active_reports[k] = r; - break; - } - } - rc->has_heading = FALSE; - rc->has_footing = FALSE; - for(rr = rc->control_ref; rr; rr = rr->next) { - if(rr->ref_line->flags & COB_REPORT_CONTROL_HEADING) - rc->has_heading = TRUE; - if(rr->ref_line->flags & COB_REPORT_CONTROL_HEADING_FINAL) - rc->has_heading = TRUE; - if(rr->ref_line->flags & COB_REPORT_CONTROL_FOOTING) - rc->has_footing = TRUE; - if(rr->ref_line->flags & COB_REPORT_CONTROL_FOOTING_FINAL) - rc->has_footing = TRUE; - } - } - for(sc = r->sum_counters; sc; sc = sc->next) { - cob_field_init(sc->counter); - } -} - -/* - * TERMINATE report - */ -int -cob_report_terminate (cob_report *r, int ctl) -{ - cob_report_control *rc; - cob_report_control_ref *rr; - cob_report_line *pl; - - if (!r->initiate_done) { - DEBUG_LOG("rw",("INITIATE was never done!\n")); - cob_runtime_error (_("TERMINATE %s but no INITIATE was done"),r->report_name); - cob_set_exception (COB_EC_REPORT_INACTIVE); -#if 0 /* TODO: if not enabled: ignore, if enabled and PROPAGATE ON (or TRY) active: handle */ - return 0; -#else - cob_stop_run (1); -#endif - } - if (r->first_generate) { - DEBUG_LOG("rw",("No GENERATE was ever done!\n")); - return 0; - } - if (ctl > 0) { /* Continue Processing Footings from last point */ - for (rc = r->controls; rc; rc = rc->next) { - for (rr = rc->control_ref; rr; rr = rr->next) { - if (rr->ref_line->flags & COB_REPORT_CONTROL_FOOTING) { - pl = get_print_line(rr->ref_line); - if (rr->ref_line->use_decl == ctl) { - DEBUG_LOG("rw",(" Continue after Declaratives %d\n",ctl)); - goto PrintFooting; /* Continue Footings */ - } - if (pl != rr->ref_line - && pl->use_decl == ctl) { - DEBUG_LOG("rw",(" Continue after Declaratives %d\n",ctl)); - goto PrintFooting; /* Continue Footings */ - } - } - if (rr->ref_line->flags & COB_REPORT_CONTROL_FOOTING_FINAL) { - pl = get_print_line(rr->ref_line); - if (rr->ref_line->use_decl == ctl) { - DEBUG_LOG("rw",(" Continue after Declaratives %d\n",ctl)); - goto PrintFootingFinal; /* Continue Footings */ - } - if (pl != rr->ref_line - && pl->use_decl == ctl) { - DEBUG_LOG("rw",(" Continue after Declaratives %d\n",ctl)); - goto PrintFootingFinal; /* Continue Footings */ - } - } - if (rr->ref_line->flags & COB_REPORT_FOOTING) { - pl = get_print_line(rr->ref_line); - if (rr->ref_line->use_decl == ctl) { - DEBUG_LOG("rw",(" Continue after Declaratives %d\n",ctl)); - goto PrintReportFooting;/* Continue Footings */ - } - if (pl != rr->ref_line - && pl->use_decl == ctl) { - DEBUG_LOG("rw",(" Continue after Declaratives %d\n",ctl)); - goto PrintReportFooting;/* Continue Footings */ - } - } - } - } - DEBUG_LOG("rw",("Could not find Declarative %d\n",ctl)); - pl = get_line_type(r, r->first_line,COB_REPORT_CONTROL_FOOTING_FINAL); - if( pl - && pl->use_decl == ctl) { - DEBUG_LOG("rw",(" Continue after Final Declaratives %d\n",ctl)); - goto PrintFootingFinal; /* Continue Footings */ - } - pl = get_line_type(r, r->first_line,COB_REPORT_FOOTING); - if (pl - && pl->use_decl == ctl) { - DEBUG_LOG("rw",(" Continue after Report Declaratives %d\n",ctl)); - goto PrintReportFooting; /* Continue Footings */ - } - } else { - reportInitialize(); -#if defined(COB_DEBUG_LOG) - reportDump(r,"TERMINATE"); -#endif - /* Do CONTROL FOOTING breaks */ - for(rc = r->controls; rc; rc = rc->next) { - for(rr = rc->control_ref; rr; rr = rr->next) { - if(rr->ref_line->flags & COB_REPORT_CONTROL_FOOTING) { - if(rr->ref_line->use_decl) { - DEBUG_LOG("rw",(" Return for %s Footing Declaratives %d\n", - rc->name,rr->ref_line->use_decl)); - return rr->ref_line->use_decl; - } - pl = get_print_line(rr->ref_line); - if(pl != rr->ref_line - && pl->use_decl) { - DEBUG_LOG("rw",(" Return for %s Footing Declaratives %d.\n", - rc->name,pl->use_decl)); - return pl->use_decl; /* Back for DECLARATIVES */ - } -PrintFooting: - if(!rc->suppress) - report_line_and(r,rr->ref_line,COB_REPORT_CONTROL_FOOTING); - rc->suppress = FALSE; - zero_all_counters(r, COB_REPORT_CONTROL_FOOTING,pl); - } - } - } - - } - - /* Do CONTROL FOOTING FINAL */ - pl = get_line_type(r, r->first_line,COB_REPORT_CONTROL_FOOTING_FINAL); - if(pl) { - if(pl->use_decl) { - DEBUG_LOG("rw",(" Return for Footing Final Declaratives %d.\n", pl->use_decl)); - return pl->use_decl; /* Back for DECLARATIVES */ - } -PrintFootingFinal: - report_line_type(r,r->first_line,COB_REPORT_CONTROL_FOOTING_FINAL); - } - zero_all_counters(r, COB_REPORT_CONTROL_FOOTING_FINAL,NULL); - - do_page_footing(r); - - pl = get_line_type(r, r->first_line,COB_REPORT_FOOTING); - if(pl) { - if(pl->use_decl) { - DEBUG_LOG("rw",(" Return for Report Footing Declaratives %d.\n", pl->use_decl)); - return pl->use_decl; /* Back for DECLARATIVES */ - } -PrintReportFooting: - r->in_report_footing = TRUE; - report_line_type(r,r->first_line,COB_REPORT_FOOTING); - r->in_report_footing = FALSE; - } - - free_control_fields (r); - r->initiate_done = FALSE; - return 0; -} - -/* - * GENERATE report-line - */ -int -cob_report_generate (cob_report *r, cob_report_line *l, int ctl) -{ - cob_report_control *rc, *rp; - cob_report_control_ref *rr; - cob_report_line *pl; - int maxctl,ln,num,gengrp; -#if defined(COB_DEBUG_LOG) - char wrk[256]; -#endif - - reportInitialize(); - if (!r->initiate_done) { - cob_runtime_error (_("GENERATE %s but no INITIATE was done"),r->report_name); - cob_set_exception (COB_EC_REPORT_INACTIVE); -#if 0 /* TODO: if not enabled: ignore, if enabled and PROPAGATE ON (or TRY) active: handle */ - return 0; -#else - cob_stop_run (1); -#endif - } - - r->foot_next_page = FALSE; - DEBUG_LOG("rw",("~ Enter %sGENERATE with ctl == %d\n",r->first_generate?"first ":"",ctl)); - if (ctl > 0) { /* Continue Processing Footings from last point */ - for (rc = r->controls; rc; rc = rc->next) { - for (rr = rc->control_ref; rr; rr = rr->next) { - if (rr->ref_line->flags & COB_REPORT_CONTROL_FOOTING) { - pl = get_print_line(rr->ref_line); - if (rr->ref_line->use_decl == ctl) { - DEBUG_LOG("rw",(" Continue after Declaratives %d\n",ctl)); - goto PrintFooting; /* Continue Footings */ - } - if (pl != rr->ref_line - && pl->use_decl == ctl) { - DEBUG_LOG("rw",(" Continue after Declaratives %d\n",ctl)); - goto PrintFooting; /* Continue Footings */ - } - } - if (rr->ref_line->flags & COB_REPORT_CONTROL_HEADING) { - pl = get_print_line(rr->ref_line); - if (rr->ref_line->use_decl == ctl) { - DEBUG_LOG("rw",(" Continue after Declaratives %d\n",ctl)); - if(r->first_generate) - goto PrintFirstHeading; - goto PrintHeading; /* Continue Footings */ - } - if (pl != rr->ref_line - && pl->use_decl == ctl) { - DEBUG_LOG("rw",(" Continue after Declaratives %d\n",ctl)); - if (r->first_generate) { - goto PrintFirstHeading; - } - goto PrintHeading; /* Continue Headings */ - } - } - } - } - DEBUG_LOG("rw",("Could not find Declarative %d\n",ctl)); - } - - if (r->incr_line) { - r->incr_line = FALSE; - r->curr_line++; - saveLineCounter(r); - } - if (r->first_generate) { - /* - * First GENERATE of the report - */ - DEBUG_LOG("rw",("Process First GENERATE\n")); - report_line_type(r,r->first_line,COB_REPORT_HEADING); - do_page_heading(r); - /* do CONTROL Headings */ - for(rc = r->controls; rc; rc = rc->next) { - for(rr = rc->control_ref; rr; rr = rr->next) { - if(rr->ref_line->flags & COB_REPORT_CONTROL_HEADING) { - if(rr->ref_line->use_decl) { - DEBUG_LOG("rw",(" Return first %s Heading Declaratives %d\n", - rc->name,rr->ref_line->use_decl)); - return rr->ref_line->use_decl; - } - pl = get_print_line(rr->ref_line); - if(pl != rr->ref_line - && pl->use_decl) { - DEBUG_LOG("rw",(" Return first %s Heading Declaratives %d.\n", - rc->name,pl->use_decl)); - return pl->use_decl; /* Back for DECLARATIVES */ - } -PrintFirstHeading: - report_line_and(r,rr->ref_line,COB_REPORT_CONTROL_HEADING); - } - } - cob_move (rc->f,rc->val); /* Save current field data */ - rc->data_change = FALSE; - } - DEBUG_LOG("rw",("Finished First GENERATE\n")); - - } else { - - if(r->curr_line > r->def_last_detail) { /* Page overflow */ - do_page_footing(r); - r->curr_line = 1; - do_page_heading(r); - r->first_detail = FALSE; - } else - if(r->curr_line <= 1 - || r->first_detail) { - if(r->first_detail) { - r->curr_line = 1; - } - do_page_heading(r); - r->first_detail = FALSE; - } - - /* - * Check for FOOTINGs on other GENERATEs - */ - maxctl = 0; - for(rc = r->controls; rc; rc = rc->next) { - rc->data_change = (cob_cmp(rc->f,rc->val) != 0); - if(rc->data_change) { /* Data change, implies control break at lower levels */ -#if defined(COB_DEBUG_LOG) - DEBUG_LOG("rw",(" Control Break %s order %d changed from ", - rc->name,rc->sequence)); - cob_field_to_string(rc->val, wrk, sizeof(wrk)-1); - DEBUG_LOG("rw",("'%s' to ",wrk)); - cob_field_to_string(rc->f, wrk, sizeof(wrk)-1); - DEBUG_LOG("rw",("'%s'\n",wrk)); -#endif - cob_move(rc->f, rc->sf); /* Save new CONTROL value */ - cob_move(rc->val,rc->f); /* Prev value for FOOTING */ - if(rc->sequence > maxctl) - maxctl = rc->sequence; - - } - } - if(maxctl > 0) { - for(rp = r->controls; rp; rp = rp->next) { - if(rp->sequence < maxctl - && !rp->data_change) { - rp->data_change = TRUE; - DEBUG_LOG("rw",(" Control Break %s order %d also ...\n", - rp->name,rp->sequence)); - cob_move(rp->f, rp->sf); /* Save CONTROL value */ - cob_move(rp->val,rp->f); /* Prev value for FOOTING */ - } - } - } - - for(rc = r->controls; rc; rc = rc->next) { - if(rc->data_change) { /* Data change, Check for PRESENT WHEN control-id */ - line_control_chg(r, r->first_line, rc->f); - } - } - - for(rc = r->controls; rc; rc = rc->next) { - if(rc->data_change) { - for(rr = rc->control_ref; rr; rr = rr->next) { - if(rr->ref_line->flags & COB_REPORT_CONTROL_FOOTING) { - if(rr->ref_line->use_decl) { - DEBUG_LOG("rw",(" Return for %s Footing Declaratives %d\n", - rc->name,rr->ref_line->use_decl)); - return rr->ref_line->use_decl; - } - pl = get_print_line(rr->ref_line); - if(pl != rr->ref_line - && pl->use_decl) { - DEBUG_LOG("rw",(" Return for %s Footing Declaratives %d.\n", - rc->name,pl->use_decl)); - return pl->use_decl; /* Back for DECLARATIVES */ - } -PrintFooting: - if(!rc->suppress - && !rr->ref_line->suppress) - report_line_and(r,rr->ref_line,COB_REPORT_CONTROL_FOOTING); - rc->suppress = FALSE; - rr->ref_line->suppress = FALSE; - zero_all_counters(r, COB_REPORT_CONTROL_FOOTING,pl); - clear_group_indicate(r->first_line); - r->next_just_set = FALSE; - if(r->next_page) { - r->foot_next_page = TRUE; - r->next_page = FALSE; - } - } - } - cob_move(rc->sf,rc->f); /* Put new CONTROL value back */ - } - } - if(r->foot_next_page) { - DEBUG_LOG("rw",(" Line# %d of Page# %d; ",r->curr_line,r->curr_page)); - DEBUG_LOG("rw",(" Execute NEXT GROUP PAGE after footings\n")); - r->next_page = FALSE; - r->foot_next_page = FALSE; - do_page_footing(r); - do_page_heading(r); - } - /* - * Check for Control Headings - */ - for(rc = r->controls; rc; rc = rc->next) { - if(rc->data_change) { - for(rr = rc->control_ref; rr; rr = rr->next) { - if(rr->ref_line->flags & COB_REPORT_CONTROL_HEADING) { - if(rr->ref_line->use_decl) { - DEBUG_LOG("rw",(" Return for %s Heading Declaratives %d\n", - rc->name,rr->ref_line->use_decl)); - return rr->ref_line->use_decl; - } - pl = get_print_line(rr->ref_line); - if(pl != rr->ref_line - && pl->use_decl) { - DEBUG_LOG("rw",(" Return for %s Heading Declaratives %d.\n", - rc->name,pl->use_decl)); - return pl->use_decl; /* Back for DECLARATIVES */ - } -PrintHeading: - if(!rr->ref_line->suppress) - report_line_and(r,rr->ref_line,COB_REPORT_CONTROL_HEADING); - rr->ref_line->suppress = FALSE; - } - } - cob_move (rc->f,rc->val); /* Save current field data */ - } - rc->data_change = FALSE; - } - } - - sum_all_detail(r); /* SUM detail counters */ - if(l == NULL) { /* GENERATE */ - - } else if(l->suppress) { - l->suppress = FALSE; - } else { - gengrp = 0; - if(l->fields == NULL - && l->child != NULL - && l->child->sister != NULL) { - l = l->child; /* Multiple Detail Lines in group */ - gengrp = 1; - } - - num = ln = 0; - for(pl = l; pl; pl = pl->sister) { - if( NOTDETAIL(pl->flags) ) - break; - if((pl->flags & COB_REPORT_LINE_PLUS) - && pl->line > 1) { - ln += pl->line; - } - num++; - if(!gengrp) break; - } - if(num > 1 - && (r->curr_line + ln) > r->def_last_detail) { /* Page overflow */ - do_page_footing(r); - r->curr_line = 1; - do_page_heading(r); - r->first_detail = FALSE; - saveLineCounter(r); - } - - for(pl = l; pl; pl = pl->sister) { - if( NOTDETAIL(pl->flags) ) - break; - l = get_print_line(pl); /* Find line with data fields */ - if(!l->suppress) { - r->next_just_set = FALSE; - report_line(r,l); /* Generate this DETAIL line */ - } - l->suppress = FALSE; - if(!gengrp) break; - } - } - - /* - * Zero out SUM counters - */ - zero_all_counters(r, COB_REPORT_DETAIL, NULL); - clear_suppress(r->first_line); - r->first_generate = FALSE; - r->next_just_set = FALSE; - r->curr_line--; - r->incr_line = TRUE; - saveLineCounter(r); - return 0; -} - -/* - * SUPPRESS printing of this CONTROL level - */ -void -cob_report_suppress(cob_report *r, cob_report_line *l) -{ - cob_report_control *rc; - cob_report_control_ref *rr; - cob_report_line *pl; - - for(rc = r->controls; rc; rc = rc->next) { - for(rr = rc->control_ref; rr; rr = rr->next) { - if(rr->ref_line == l) { - rc->suppress = TRUE; - return; - } - pl = get_print_line(rr->ref_line); - if(pl == l) { - rc->suppress = TRUE; - return; - } - } - } - cob_runtime_error (_("could not find line to SUPPRESS in report %s"),r->report_name); -} diff -Nru gnucobol-4.0~early~20200606/libcob/screenio.c gnucobol-5/libcob/screenio.c --- gnucobol-4.0~early~20200606/libcob/screenio.c 2020-06-06 20:52:01.000000000 +0000 +++ gnucobol-5/libcob/screenio.c 1970-01-01 00:00:00.000000000 +0000 @@ -1,3595 +0,0 @@ -/* - Copyright (C) 2001-2012, 2014-2020 Free Software Foundation, Inc. - Written by Keisuke Nishida, Roger While, Simon Sobisch, Edward Hart - - This file is part of GnuCOBOL. - - The GnuCOBOL runtime library is free software: you can redistribute it - and/or modify it under the terms of the GNU Lesser General Public License - as published by the Free Software Foundation, either version 3 of the - License, or (at your option) any later version. - - GnuCOBOL is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU Lesser General Public License for more details. - - You should have received a copy of the GNU Lesser General Public License - along with GnuCOBOL. If not, see . -*/ - - -#include - -#include -#include -#include -#include -#include -#include -#include -#include -#ifdef HAVE_UNISTD_H -#include -#endif - -#ifdef HAVE_LOCALE_H -#include -#endif - -#ifdef _WIN32 -#include -#endif - -#include "sysdefines.h" - -#if defined (HAVE_NCURSESW_NCURSES_H) -#include -#elif defined (HAVE_NCURSESW_CURSES_H) -#include -#elif defined (HAVE_NCURSES_H) -#include -#elif defined (HAVE_NCURSES_NCURSES_H) -#include -#elif defined (HAVE_PDCURSES_H) -/* will internally define NCURSES_MOUSE_VERSION with - a recent version (for older version define manually): */ -#define PDC_NCMOUSE /* use ncurses compatible mouse API */ -#include -#elif defined (HAVE_CURSES_H) -#define PDC_NCMOUSE /* see comment above */ -#include -#ifndef PDC_MOUSE_MOVED -#undef PDC_NCMOUSE -#endif -#endif - -/* Force symbol exports */ -#define COB_LIB_EXPIMP -#include "libcob.h" -#include "coblocal.h" - -#ifdef HAVE_CURSES_FREEALL -extern void _nc_freeall (void); -#endif -#ifdef NCURSES_MOUSE_VERSION -static mmask_t cob_mask_accept; /* mask that is returned to COBOL ACCEPT */ -static mmask_t cob_mask_routine; /* mask that is returned to COBOL routines (reserved) */ -#if defined BUTTON5_PRESSED /* added in NCURSES_MOUSE_VERSION 2 */ -#define COB_HAS_MOUSEWHEEL 1 -#else -#undef COB_HAS_MOUSEWHEEL -#endif -#endif - -struct cob_inp_struct { - cob_screen *scr; - size_t up_index; - size_t down_index; - int this_y; - int this_x; -}; - -#define COB_INP_FLD_MAX 512U - -#define COB_INP_SIZE (COB_INP_FLD_MAX * sizeof(struct cob_inp_struct)) - -#define COB_CH_UL ((const chtype)'_') -#define COB_CH_SP ((const chtype)' ') -#define COB_CH_AS ((const chtype)'*') - -/* Local variables */ - -static cob_global *cobglobptr; -static cob_settings *cobsetptr; - -/* Local variables when screenio activated */ - -#ifdef WITH_EXTENDED_SCREENIO -static const cob_field_attr const_alpha_attr = - {COB_TYPE_ALPHANUMERIC, 0, 0, 0, NULL}; -static struct cob_inp_struct *cob_base_inp; -static size_t totl_index; -static size_t cob_has_color; -static int global_return; -static int cob_current_y; -static int cob_current_x; -static short fore_color /* "const" default foreground (pair 0 on init) */; -static short back_color /* "const" default background (pair 0 on init) */;; -static int origin_y; -static int origin_x; -static int display_cursor_y; -static int display_cursor_x; -static int accept_cursor_y; -static int accept_cursor_x; -static int pending_accept; -static int got_sys_char; -static unsigned int curr_setting_insert_mode = INT_MAX; -#ifdef NCURSES_MOUSE_VERSION -static int curr_setting_mouse_flags = INT_MAX; -#endif -#endif - -/* Local function prototypes when screenio activated */ - -#ifdef WITH_EXTENDED_SCREENIO -static void cob_screen_init (void); -#endif - -/* Local functions */ - -static void -cob_speaker_beep (void) -{ - int fd; - - fd = fileno (stdout); - if (fd >= 0) { - (void)write (fd, "\a", (size_t)1); - } -} - -static COB_INLINE COB_A_INLINE void -init_cob_screen_if_needed (void) -{ - if (!cobglobptr) { - cob_fatal_error (COB_FERROR_INITIALIZED); - } -#ifdef WITH_EXTENDED_SCREENIO - if (!cobglobptr->cob_screen_initialized) { - cob_screen_init (); - } -#endif -} - -#ifdef WITH_EXTENDED_SCREENIO - -static void -cob_beep (void) -{ - switch (COB_BEEP_VALUE) { - case 1: - (void)flash (); - return; - case 2: - cob_speaker_beep (); - return; - case 9: - return; - default: - (void)beep (); - return; - } -} - -static void -raise_ec_on_invalid_line_or_col (const int line, const int column) -{ - int max_y; - int max_x; - - getmaxyx (stdscr, max_y, max_x); - if (line < 0 || line >= max_y) { - cob_set_exception (COB_EC_SCREEN_LINE_NUMBER); - } - if (column < 0 || column >= max_x) { - cob_set_exception (COB_EC_SCREEN_STARTING_COLUMN); - } -} - -static int -cob_move_cursor (const int line, const int column) -{ - int status = move (line, column); - - if (status == ERR) { - raise_ec_on_invalid_line_or_col (line, column); - } - return status; -} - -void -cob_set_cursor_pos (int line, int column) -{ - init_cob_screen_if_needed (); - (void) move (line, column); -} - -static void -cob_move_to_beg_of_last_line (void) -{ - int max_y; - int max_x; - - getmaxyx (stdscr, max_y, max_x); - /* We don't need to check for exceptions here; it will always be fine */ - move (max_y, 0); - - COB_UNUSED (max_x); -} - -static short -cob_to_curses_color (cob_field *f, const short default_color) -{ - if (!f) { - return default_color; - } - switch (cob_get_int (f)) { - case COB_SCREEN_BLACK: - return COLOR_BLACK; - case COB_SCREEN_BLUE: - return COLOR_BLUE; - case COB_SCREEN_GREEN: - return COLOR_GREEN; - case COB_SCREEN_CYAN: - return COLOR_CYAN; - case COB_SCREEN_RED: - return COLOR_RED; - case COB_SCREEN_MAGENTA: - return COLOR_MAGENTA; - case COB_SCREEN_YELLOW: - return COLOR_YELLOW; - case COB_SCREEN_WHITE: - return COLOR_WHITE; - default: - return default_color; - } -} - -static short -cob_get_color_pair (const short fg_color, const short bg_color) -{ - /* default color (defined from terminal, read during init ) */ - if (fg_color == fore_color && bg_color == back_color) { - return 0; - } - /* reserved color "all black", defined during init */ - if (fg_color == 0 && bg_color == 0) { - return 1; - } - - { - short color_pair_number; - short fg_defined, bg_defined; - - for (color_pair_number = 2; color_pair_number < COLOR_PAIRS; color_pair_number++) { - - pair_content (color_pair_number, &fg_defined, &bg_defined); - - /* check if we've already defined this color pair */ - if (fg_defined == fg_color && bg_defined == bg_color) { - return color_pair_number; - } - - /* check if we found a spare pair, defined as requested */ - if (fg_defined == 0 && bg_defined == 0) { - init_pair (color_pair_number, fg_color, bg_color); - return color_pair_number; - } - } - } - - /* none left - return default */ - return 0; -} - -static int -cob_activate_color_pair (const short color_pair_number) -{ - int ret; - -#ifdef HAVE_COLOR_SET - ret = color_set (color_pair_number, NULL); -#else - ret = attrset (COLOR_PAIR(color_pair_number)); -#endif - bkgdset (COLOR_PAIR(color_pair_number)); - - return ret; -} - -enum screen_statement { - ACCEPT_STATEMENT, - DISPLAY_STATEMENT -}; - -static void -cob_screen_attr (cob_field *fgc, cob_field *bgc, const cob_flags_t attr, - const enum screen_statement stmt) -{ - int line; - int column; - chtype styles = A_NORMAL; - - attrset (A_NORMAL); - if (attr & COB_SCREEN_REVERSE) { - styles |= A_REVERSE; - } - if (attr & COB_SCREEN_HIGHLIGHT) { - styles |= A_BOLD; - } - if (attr & COB_SCREEN_LOWLIGHT) { - styles |= A_DIM; - } - if (attr & COB_SCREEN_BLINK) { - styles |= A_BLINK; - } - if (attr & COB_SCREEN_UNDERLINE) { - styles |= A_UNDERLINE; - } - if (styles) { - attron (styles); - } - if (cob_has_color) { - short fg_color; - short bg_color; - short color_pair_number; - fg_color = cob_to_curses_color (fgc, fore_color); - bg_color = cob_to_curses_color (bgc, back_color); - color_pair_number = cob_get_color_pair (fg_color, bg_color); - cob_activate_color_pair (color_pair_number); - } - /* BLANK SCREEN colors the whole screen. */ - if (attr & COB_SCREEN_BLANK_SCREEN) { - getyx (stdscr, line, column); - clear (); - cob_move_cursor (line, column); - } - - if (stmt == DISPLAY_STATEMENT) { - /* BLANK LINE colors the whole line. */ - if (attr & COB_SCREEN_BLANK_LINE) { - getyx (stdscr, line, column); - cob_move_cursor (line, 0); - clrtoeol (); - cob_move_cursor (line, column); - } - if (attr & COB_SCREEN_ERASE_EOL) { - clrtoeol (); - } - if (attr & COB_SCREEN_ERASE_EOS) { - clrtobot (); - } - } - if (attr & COB_SCREEN_BELL) { - cob_beep (); - } -} - -static void -cob_screen_init (void) -{ - if (cobglobptr->cob_screen_initialized) { - return; - } - - cob_base_inp = NULL; - totl_index = 0; - cob_has_color = 0; - global_return = 0; - cob_current_y = 0; - cob_current_x = 0; - fore_color = 0; - back_color = 0; - display_cursor_y = 0; - display_cursor_x = 0; - accept_cursor_y = 0; - accept_cursor_x = 0; - pending_accept = 0; - got_sys_char = 0; - - fflush (stdout); - fflush (stderr); - -#if 0 /* RXWRXW sigtin */ -#ifndef _WIN32 - /* If the process is backgrounded (running non interactively), */ - /* SIGTTIN or SIGTOU is emitted. If not caught, turns into a SIGSTP */ -#ifdef SIGTTIN - signal(SIGTTIN, SIG_IGN); -#endif -#ifdef SIGTTOU - signal(SIGTTOU, SIG_IGN); -#endif -#endif -#endif - -#if 0 /* RXWRXW - setlocale */ -#ifdef HAVE_SETLOCALE - if (cobglobptr->cob_locale_orig) { - setlocale (LC_ALL, cobglobptr->cob_locale_orig); - } - if (cobglobptr->cob_locale_ctype) { - setlocale (LC_CTYPE, cobglobptr->cob_locale_ctype); - } -#endif -#endif - - if (!initscr ()) { - cob_runtime_error (_("failed to initialize curses")); - /* FIXME: likely should raise an exception instead */ - cob_stop_run (1); - } - cobglobptr->cob_screen_initialized = 1; -#ifdef HAVE_USE_LEGACY_CODING - use_legacy_coding (2); -#endif - -#if 0 /* RXWRXW - setlocale */ -#ifdef HAVE_SETLOCALE - if (cobglobptr->cob_locale) { - setlocale (LC_ALL, cobglobptr->cob_locale); - setlocale (LC_CTYPE, "C"); - } -#endif -#endif - - cbreak (); - keypad (stdscr, 1); - nonl (); - noecho (); - if (has_colors ()) { - start_color (); - pair_content ((short)0, &fore_color, &back_color); - /* fix bad settings of the terminal on start */ - if (fore_color == back_color) { - if (fore_color == COLOR_BLACK) { - fore_color = COLOR_WHITE; - } else { - back_color = COLOR_BLACK; - } - init_pair ((short)0, fore_color, back_color); - } - if (COLOR_PAIRS) { - cob_has_color = 1; - /* explicit reserve pair 1 as all zero as we take this as "initialized" later on */ - init_pair ((short)1, 0, 0); -#ifdef HAVE_LIBPDCURSES - /* pdcurses sets *ALL* pairs to default fg/bg, while ncurses initialize the to zero - set all to zero here, allowing us to adjust them later */ - { - short color_pair_number; - - for (color_pair_number = 2; color_pair_number < COLOR_PAIRS; ++color_pair_number) { - init_pair (color_pair_number, 0, 0); - } - } -#endif - } - } - attrset (A_NORMAL); - getmaxyx (stdscr, COB_MAX_Y_COORD, COB_MAX_X_COORD); - - cob_settings_screenio (); - - /* Possible alternative definitions for ALT Keys */ -#ifndef ALT_DEL -# ifdef kDC3 -# define ALT_DEL kDC3 -# endif -#endif -#ifndef ALT_LEFT -# ifdef kLFT3 -# define ALT_LEFT kLFT3 -# endif -#endif -#ifndef ALT_RIGHT -# ifdef kRIT3 -# define ALT_RIGHT kRIT3 -# endif -#endif - - /* When still missing - self define the keys */ - /* note: if define_key is not available rhe user will have to manually - assign terminfo values for the control strings to the given - KEY_MAX + n / __KEY_MIN - n values */ - -#ifndef HAVE_DEFINE_KEY -#define define_key(x,y) /* do nothing */ -#endif - -#if defined (KEY_MAX) && KEY_MAX > 0 -#define COB_NEW_KEY(n) (KEY_MAX + n) -#elif defined (__KEY_MIN) && __KEY_MIN < 0 -#define COB_NEW_KEY(n) (__KEY_MIN - n) -#else -#ifdef HAVE_DEFINE_KEY -#error "Did not find a valid value for key definition. Please report this!" -#endif -#endif - -#ifdef COB_NEW_KEY -#ifndef ALT_DEL -#define ALT_DEL COB_NEW_KEY(1) - define_key("\033[3;3~", ALT_DEL); -#endif -#ifndef ALT_LEFT -#define ALT_LEFT COB_NEW_KEY(2) - define_key("\033[1;3D", ALT_LEFT); -#endif -#ifndef ALT_RIGHT -#define ALT_RIGHT COB_NEW_KEY(3) - define_key("\033[1;3C", ALT_RIGHT); -#endif -#else -#ifndef ALT_DEL -#define ALT_DEL KEY_SDC -#endif -#ifndef ALT_LEFT -#define ALT_LEFT KEY_SLEFT -#endif -#ifndef ALT_RIGHT -#define ALT_RIGHT KEY_ALEFT -#endif -#endif - -} - -static void -cob_convert_key (int *keyp, const cob_u32_t field_accept) -{ - /* Map key to KEY_xxx value */ - switch (*keyp) { - case '\n': - case '\r': - case '\004': - case '\032': - *keyp = KEY_ENTER; - break; - case '\t': - *keyp = KEY_STAB; - break; - case '\b': - case 0177: - *keyp = KEY_BACKSPACE; - break; - case KEY_EOL: - *keyp = ALT_DEL; - break; - case KEY_CLOSE: - *keyp = ALT_LEFT; - break; - case KEY_PREVIOUS: - *keyp = ALT_LEFT; - break; - -#ifdef KEY_A1 - /* A1, A3, C1, C3 are always present if A1 is defined */ - case KEY_A1: - *keyp = KEY_HOME; - break; - case KEY_A3: - *keyp = KEY_PPAGE; - break; - case KEY_C1: - *keyp = KEY_END; - break; - case KEY_C3: - *keyp = KEY_NPAGE; - break; - /* Any or all of A2, B1-3, C2 MAY be present */ - /* Note: B2 ignored */ -#ifdef KEY_A2 - case KEY_A2: - *keyp = KEY_UP; - break; -#endif -#ifdef KEY_B1 - case KEY_B1: - *keyp = KEY_LEFT; - break; -#endif -#ifdef KEY_B3 - case KEY_B3: - *keyp = KEY_RIGHT; - break; -#endif -#ifdef KEY_C2 - case KEY_C2: - *keyp = KEY_DOWN; - break; -#endif - -#if defined(__PDCURSES__) && defined(PADSLASH) - case PADSLASH: - *keyp = '/'; - break; - case PADSTAR: - *keyp = '*'; - break; - case PADMINUS: - *keyp = '-'; - break; - case PADPLUS: - *keyp = '+'; - break; - case PADENTER: - *keyp = KEY_ENTER; - break; -#ifdef PAD0 - case PAD0: - *keyp = KEY_IC; - break; - case PADSTOP: - *keyp = KEY_DC; - break; -#endif /* PAD0 */ -#endif /* __PDCURSES__ */ -#endif /* KEY_A1 */ - default: - break; - } - - /* Check if key should be ignored */ - switch (*keyp) { -#if 0 /* 2012/08/30 removed to allow Tab key in extended Accept */ - case KEY_STAB: - if (field_accept) { - *keyp = 0; - } - break; -#endif - case '\033': - if (!COB_EXTENDED_STATUS || !COB_USE_ESC) { - *keyp = 0; - } - break; - case KEY_PPAGE: - case KEY_NPAGE: - case KEY_PRINT: - if (!COB_EXTENDED_STATUS) { - *keyp = 0; - } - break; - case KEY_UP: - case KEY_DOWN: - if (field_accept && !COB_EXTENDED_STATUS) { - *keyp = 0; - } - break; - default: - break; - } -} - -static void -handle_status (const int fret) -{ - if (fret) { - cob_set_exception (COB_EC_IMP_ACCEPT); - } - COB_ACCEPT_STATUS = fret; - - if (COB_MODULE_PTR && COB_MODULE_PTR->crt_status) { - cob_field *status_field = COB_MODULE_PTR->crt_status; - if (COB_FIELD_IS_NUMERIC (status_field)) { - cob_set_int (status_field, fret); - } else { - char buff[23]; /* 10: make the compiler happy as "int" *could* - have more digits than we "assume" */ - sprintf (buff, "%4.4d", fret); - memcpy (status_field->data, buff, 4U); - } - } -} - -/* update field for the programs SPECIAL-NAMES CURSOR clause */ -static void -pass_cursor_to_program (void) -{ - if (COB_MODULE_PTR && COB_MODULE_PTR->cursor_pos) { - cob_field *cursor_field = COB_MODULE_PTR->cursor_pos; - int sline; - int scolumn; - getyx (stdscr, sline, scolumn); - sline++; scolumn++; /* zero-based in curses */ - if (COB_FIELD_IS_NUMERIC (cursor_field) && - COB_FIELD_TYPE (cursor_field) != COB_TYPE_NUMERIC_DISPLAY) { - sline *= 1000; - sline += scolumn; - cob_set_int (cursor_field, sline); - } else { - char buff[23]; /* 10: make the compiler happy as "int" *could* - have more digits than we "assume" */ - if (cursor_field->size < 6) { - sline *= 100; - sline += scolumn; - sprintf (buff, "%4.4d", sline); - memcpy (cursor_field->data, buff, 4U); - } else { - sline *= 1000; - sline += scolumn; - sprintf (buff, "%6.6d", sline); - memcpy (cursor_field->data, buff, 6U); - } - } - } -} -/* set given parameters to the programs SPECIAL-NAMES CURSOR clause or - -1 if not provided */ -static void -get_cursor_from_program (int *line, int *column) -{ - if (COB_MODULE_PTR && COB_MODULE_PTR->cursor_pos) { - cob_field *cursor_field = COB_MODULE_PTR->cursor_pos; - int cursor_pos; - if (COB_FIELD_IS_NUMERIC (cursor_field)) { - cursor_pos = cob_get_int (cursor_field); - } else { - char buff[32]; - int maxsize = cursor_field->size; - /* LCOV_EXCL_START */ - if (unlikely (maxsize != 4 && maxsize != 6)) { - cob_fatal_error (COB_FERROR_CODEGEN); - } - /* LCOV_EXCL_STOP */ - memcpy (buff, cursor_field->data, maxsize); - buff[maxsize + 1] = 0; - if (unlikely (!sscanf (buff, "%d", &cursor_pos))) { - cob_fatal_error (COB_FERROR_CODEGEN); - } - } - if (cursor_field->size == 4) { - *line = (cursor_pos / 100) - 1; - *column = (cursor_pos % 100) - 1; - } else { - *line = (cursor_pos / 1000) - 1; - *column = (cursor_pos % 1000) - 1; - } - } else { - *column = *line = -1; - } -} - -static void -raise_ec_on_truncation (const int item_size) -{ - int y; - int x; - int max_y; - int max_x; - - getyx (stdscr, y, x); - getmaxyx (stdscr, max_y, max_x); - - if (x + item_size - 1 > max_x) { - cob_set_exception (COB_EC_SCREEN_ITEM_TRUNCATED); - } - - COB_UNUSED (y); - COB_UNUSED (max_y); -} - -static void -cob_addnstr (const char *data, const int size) -{ - raise_ec_on_truncation (size); - addnstr (data, size); -} - -static void -cob_addch (const chtype c) -{ - raise_ec_on_truncation (1); - addch (c); -} - -/* Use only when raise_ec_on_truncation is called beforehand. */ -static void -cob_addch_no_trunc_check (const chtype c) -{ - addch (c); -} - -static void -cob_addnch (const int n, const chtype c) -{ - int count; - - raise_ec_on_truncation (n); - for (count = 0; count < n; count++) { - cob_addch_no_trunc_check (c); - } -} - -static int -is_first_screen_item (cob_screen *s) -{ - do { - if (s->prev) { - return 0; - } - s = s->parent; - } while (s); - - return 1; -} - -static cob_screen * -get_last_child (cob_screen * const s) -{ - cob_screen *child; - - for (child = s->child; child->next; child = child->next); - - if (child->child) { - return get_last_child (child); - } else { - return child; - } -} - -static cob_screen * -get_prev_screen_item (cob_screen * const s) -{ - if (s->prev) { - if (s->prev->child) { - return get_last_child (s->prev); - } else { - return s->prev; - } - } else if (s->parent) { - return s->parent; - } else { - return NULL; - } -} - - -#define UPDATE_CLAUSE_FUNC(clause_name_upper, clause_name_lower) \ - static void \ - update_##clause_name_lower (cob_screen *s, int * const count, \ - int * const found_clause) \ - { \ - if (s->attr & COB_SCREEN_##clause_name_upper##_PLUS) { \ - *count += cob_get_int (s->clause_name_lower); \ - } else if (s->attr & COB_SCREEN_##clause_name_upper##_MINUS) { \ - *count -= cob_get_int (s->clause_name_lower); \ - } else { \ - *count += cob_get_int (s->clause_name_lower) - 1; \ - *found_clause = 1; \ - } \ - } - -UPDATE_CLAUSE_FUNC (LINE, line) -UPDATE_CLAUSE_FUNC (COLUMN, column) - -#undef UPDATE_CLAUSE_FUNC - -static size_t -get_size (cob_screen *s) -{ - if (s->field) { - return s->field->size; - } else { /* s->value */ - return s->value->size; - } - -} -static void -get_screen_item_line_and_col (cob_screen * s, int * const line, - int * const col) -{ - int found_line = 0; - int found_col = 0; - int is_screen_to_display = 1; - int is_elementary; - - *line = 0; - *col = 0; - - /* - Determine the line/col by looking at the given item and then moving - backwards. - */ - for (; s; s = get_prev_screen_item (s)) { - if (s->line && !found_line) { - update_line (s, line, &found_line); - } - - if (!found_col) { - is_elementary = !s->child; - - if (!is_screen_to_display && is_elementary) { - *col += get_size (s) - 1; - } - - if (s->column) { - update_column (s, col, &found_col); - } - - if (s->line && !s->column) { - found_col = 1; - } - - if (!found_col && !s->column && is_elementary - && !is_first_screen_item (s)) { - /* - Note that group items are excluded; the - standard assumes COL + 1, unless otherwise - specified, on all screen items. This seems - silly on group items, hence why this - non-standard extension. - */ - ++(*col); - } - } - - is_screen_to_display = 0; - } - - *line += origin_y; - *col += origin_x; -} - -static void -cob_screen_puts (cob_screen *s, cob_field *f, const cob_u32_t is_input, - const enum screen_statement stmt) -{ - unsigned char *p; - size_t size; - int line; - int column; - chtype default_prompt_char; - - get_screen_item_line_and_col (s, &line, &column); - - /* Move to specified position */ - cob_move_cursor (line, column); - cob_current_y = line; - cob_current_x = column; -#if 0 /* RXWRXW - Attr */ - cob_screen_attr (s->foreg, s->backg, s->attr); -#endif - if (s->attr & COB_SCREEN_INPUT) { - cob_screen_attr (s->foreg, s->backg, s->attr, stmt); - if (s->prompt) { - default_prompt_char = s->prompt->data[0]; - } else { - default_prompt_char = COB_CH_UL; - } - p = f->data; - raise_ec_on_truncation (f->size); - for (size = 0; size < f->size; size++, p++) { - if (s->attr & COB_SCREEN_SECURE) { - cob_addch_no_trunc_check (COB_CH_AS); - } else if (*p <= ' ') { - cob_addch_no_trunc_check (default_prompt_char); - } else { - cob_addch_no_trunc_check ((const chtype)*p); - } - } - } else if (!is_input) { - cob_screen_attr (s->foreg, s->backg, s->attr, stmt); - cob_addnstr ((char *)f->data, (int)f->size); - } else { - column += (int)f->size; - cob_move_cursor (line, column); - } - - if (stmt == DISPLAY_STATEMENT) { - display_cursor_y = line; - display_cursor_x = column + f->size; - } else { /* ACCEPT_STATEMENT */ - accept_cursor_y = line; - accept_cursor_x = column + f->size; - } - - refresh (); -} - -static COB_INLINE COB_A_INLINE int -cob_field_is_numeric_or_numeric_edited (cob_field *field) -{ - return (COB_FIELD_IS_NUMERIC (field) - || COB_FIELD_TYPE (field) == COB_TYPE_NUMERIC_EDITED); -} - -static int -field_is_empty (cob_screen *s) -{ - unsigned char *data = s->field->data; - size_t size = s->field->size; - size_t i; - - for (i = 0; i < size; ++i) { - if (!isspace (data[i])) { - return 0; - } - } - - return 1; -} - -static int -field_is_zero (cob_screen *s) -{ - unsigned char *data = s->field->data; - size_t size = s->field->size; - size_t i; - unsigned char decimal_point = COB_MODULE_PTR->decimal_point; - - for (i = 0; i < size; ++i) { - if (!(isspace (data[i]) || data[i] == '0' - || data[i] == decimal_point)) { - return 0; - } - } - - return 1; -} - -static int -pic_has_zero_suppression (const cob_pic_symbol *pic) -{ - int i; - - for (i = 0; pic[i].symbol != '\0'; ++i) { - /* - NB: + and - are floating-insertion editing characters, not - zero-suppression ones. - */ - if (pic[i].symbol == 'Z' || pic[i].symbol == '*') { - return 1; - } - } - - return 0; -} - -static int -get_num_int_digits_for_no_zero_sup (const cob_pic_symbol *pic) -{ - int i; - int num_digits = 0; - char numeric_separator = COB_MODULE_PTR->numeric_separator; - - for (i = 0; pic[i].symbol != '\0'; ++i) { - if (pic[i].symbol == '9' - || pic[i].symbol == 'Z' - || pic[i].symbol == '*') { - num_digits += pic[i].times_repeated; - } else if (!(pic[i].symbol == numeric_separator - || pic[i].symbol == 'B' - || pic[i].symbol == '0' - || pic[i].symbol == '/') - && num_digits != 0) { - break; - } - } - - return num_digits; -} - -static int -field_is_zero_or_no_zero_suppression (cob_screen *s) -{ - const cob_pic_symbol *pic = COB_FIELD_PIC (s->field); - size_t i; - size_t size = COB_FIELD_SIZE (s->field); - unsigned char *data = COB_FIELD_DATA (s->field); - int num_integer_digits; - int num_digits_seen = 0; - - if (field_is_zero (s) || !pic_has_zero_suppression (pic)) { - return 1; - } - - num_integer_digits = get_num_int_digits_for_no_zero_sup (pic); - - /* - Verify there are sufficient non-zero digits before a decimal - point/the end to fill the integer part of the field. - */ - for (i = 0; i < size; ++i) { - if (isdigit (data[i])) { - if (data[i] != '0' || num_digits_seen != 0) { - ++num_digits_seen; - } - } else if (!isspace (data[i]) && num_digits_seen != 0) { - break; - } - } - - return num_digits_seen >= num_integer_digits; -} - -/* Assuming s->field is alphanumeric */ -static int -field_is_full (cob_screen *s) -{ - unsigned char *data = s->field->data; - size_t size = s->field->size; - - /* Per the standard, only the first and last chars need be non-space. */ - return !isspace (*data) && !isspace (*(data + size - 1)); -} - -static int -satisfied_full_clause (cob_screen *s) -{ - if (!(s->attr & COB_SCREEN_FULL)) { - return 1; - } - - if (COB_FIELD_IS_NUMERIC (s->field)) { - return !field_is_zero (s); - } else if (COB_FIELD_TYPE (s->field) == COB_TYPE_NUMERIC_EDITED) { - return field_is_zero_or_no_zero_suppression (s); - } else { /* field is alphanumeric */ - return field_is_full (s) || field_is_empty (s); - } -} - -static int -satisfied_required_clause (cob_screen *s) -{ - if (!(s->attr & COB_SCREEN_REQUIRED)) { - return 1; - } - - if (cob_field_is_numeric_or_numeric_edited (s->field)) { - return !field_is_zero (s); - } else { /* field is alphanumeric */ - return !field_is_empty (s); - } -} - -static int -valid_field_data (cob_field *field) -{ - int num_check; - - if (COB_FIELD_IS_NUMERIC (field)) { - return cob_check_numval (field, NULL, 0, 0) == 0; - } else if (field->attr->type == COB_TYPE_NUMERIC_EDITED) { - num_check = cob_check_numval (field, NULL, 1, 0); - /* test for all spaces which is valid in this case - and change to a one zero instead */ - if (num_check == (int)field->size + 1) { - field->data[0] = '0'; - return 1; - } - return cob_check_numval (field, NULL, 1, 0) == 0; - } else { - return 1; - } -} - -static void -refresh_field (cob_screen *s) -{ - int y; - int x; - - getyx (stdscr, y, x); - cob_screen_puts (s, s->field, cobsetptr->cob_legacy, ACCEPT_STATEMENT); - cob_move_cursor (y, x); -} - -static void -format_field (cob_screen *s) -{ - cob_field field; - size_t size = s->field->size; - unsigned char *data; - - /* - We copy the data into another field and move it back to format the - numeric data neatly, rather than re-implement that logic here. We - assume the data is valid. - */ - data = cob_malloc (size); - memcpy (data, s->field->data, size); - COB_FIELD_INIT (size, data, s->field->attr); - - if (COB_FIELD_IS_NUMERIC (s->field)) { - cob_move (cob_intr_numval (&field), s->field); - } else if (field.attr->type == COB_TYPE_NUMERIC_EDITED) { - cob_move (cob_intr_numval_c (&field, NULL), s->field); - } - - cob_free (data); - - refresh_field (s); -} - -/* Finalize field on leaving it: checks and conversions */ -static int -finalize_field_input (cob_screen *s) -{ - /* Only numeric types need to be validated and formatted. */ - if (cob_field_is_numeric_or_numeric_edited (s->field)) { - if (!valid_field_data (s->field)) { - return 1; - } - format_field (s); - } - - if (!satisfied_full_clause (s) || !satisfied_required_clause (s)) { - return 1; - } - - return 0; -} - -static int -finalize_all_fields (struct cob_inp_struct *sptr, const size_t total_idx) -{ - const struct cob_inp_struct *end = sptr + total_idx; - - for (; sptr < end; ++sptr) { - if (finalize_field_input (sptr->scr)) { - return 1; - } - } - - return 0; -} - - -/* If off turn on, if on turn off; - additional: switch between vertical bar cursor (on) and - square cursor (off) - note: the cursor change may has no - effect in all curses implementations / terminals */ -static void -cob_toggle_insert () -{ - if (COB_INSERT_MODE == 0) { - COB_INSERT_MODE = 1; /* on */ - } - else { - COB_INSERT_MODE = 0; /* off */ - } - cob_settings_screenio (); -} - -#define SET_FLD_AND_DATA_REFS(curr_index,structure,scrdef,sline,scolumn,right_pos,field_data) \ - structure = cob_base_inp + curr_index; \ - scrdef = structure->scr; \ - sline = structure->this_y; \ - scolumn = structure->this_x; \ - right_pos = scolumn + (int)scrdef->field->size - 1; \ - field_data = scrdef->field->data - -#define SET_FLD_REFS(curr_index,structure,scrdef,sline,scolumn,right_pos) \ - structure = cob_base_inp + curr_index; \ - scrdef = structure->scr; \ - sline = structure->this_y; \ - scolumn = structure->this_x; \ - right_pos = scolumn + (int)scrdef->field->size - 1 - -/* find field by position, returns index for field or -1 if not found */ -static int -find_field_by_pos (const int initial_curs, const int line, const int column) { - struct cob_inp_struct *sptr; - cob_screen *s; - int sline; - int scolumn; - int right_pos; - - size_t idx; - - for (idx = (size_t)initial_curs; idx < totl_index; idx++) { - SET_FLD_REFS (idx, sptr, s, sline, scolumn, right_pos); - if (line == sline - && column >= scolumn - && column <= right_pos) { - return idx; - } - } - return -1; -} - -#ifdef NCURSES_MOUSE_VERSION -static int -mouse_to_exception_code (mmask_t mask) { - int fret = -1; - - if (mask & BUTTON1_PRESSED) fret = 2041; - else if (mask & BUTTON1_CLICKED) fret = 2041; - else if (mask & BUTTON1_RELEASED) fret = 2042; - else if (mask & BUTTON1_DOUBLE_CLICKED) fret = 2043; - else if (mask & BUTTON1_TRIPLE_CLICKED) fret = 2043; - else if (mask & BUTTON2_PRESSED) fret = 2044; - else if (mask & BUTTON2_CLICKED) fret = 2044; - else if (mask & BUTTON2_RELEASED) fret = 2045; - else if (mask & BUTTON2_DOUBLE_CLICKED) fret = 2046; - else if (mask & BUTTON2_TRIPLE_CLICKED) fret = 2046; - else if (mask & BUTTON3_PRESSED) fret = 2047; - else if (mask & BUTTON3_CLICKED) fret = 2047; - else if (mask & BUTTON3_RELEASED) fret = 2048; - else if (mask & BUTTON3_DOUBLE_CLICKED) fret = 2049; - else if (mask & BUTTON3_TRIPLE_CLICKED) fret = 2049; -#if defined COB_HAS_MOUSEWHEEL - else if (mask & BUTTON4_PRESSED) fret = 2080; - else if (mask & BUTTON5_PRESSED) fret = 2081; -#endif - else fret = 2040; /* mouse-moved (assumed) */ - -#if defined COB_HAS_MOUSEWHEEL - if (mask & BUTTON_SHIFT) { - if (fret < 2080) { - fret += 10; - } else { - fret += 4; - } - } else if (mask & BUTTON_CTRL) { - if (fret < 2080) { - fret += 20; - } else { - fret += 8; - } - } else if (mask & BUTTON_ALT) { - if (fret < 2080) { - fret += 30; - } else { - fret += 12; - } - } -#else - if (mask & BUTTON_SHIFT) fret += 10; - else if (mask & BUTTON_CTRL) fret += 20; - else if (mask & BUTTON_ALT) fret += 12; -#endif - - return fret; -} -#endif - -static void -cob_screen_get_all (const int initial_curs, const int accept_timeout) -{ - size_t curr_index = (size_t)initial_curs; - struct cob_inp_struct *sptr; - cob_screen *s; - int sline; - int scolumn; - int right_pos; - unsigned char *p; - unsigned char *p2; - unsigned char move_char; - int keyp; - int cline; - int ccolumn; - int at_eof = 0; - int ungetched = 0; - int status; - int count; - chtype default_prompt_char; -#ifdef NCURSES_MOUSE_VERSION - MEVENT mevent; -#endif - - SET_FLD_AND_DATA_REFS (curr_index, sptr, s, sline, scolumn, right_pos, p); - - status = cob_move_cursor (sline, scolumn); - if (status != ERR) { - pending_accept = 0; - } - cob_screen_attr (s->foreg, s->backg, s->attr, ACCEPT_STATEMENT); - - /* position for the SPECIAL-NAMES CURSOR clause, if given */ - { - int cursor_clause_line; - int cursor_clause_col; - get_cursor_from_program (&cursor_clause_line, &cursor_clause_col); - if (cursor_clause_line > 0) { - int fld_index = find_field_by_pos (initial_curs, cursor_clause_line, cursor_clause_col); - if (fld_index >= 0) { - curr_index = fld_index; - SET_FLD_AND_DATA_REFS (curr_index, sptr, s, sline, scolumn, right_pos, p); - at_eof = 0; - cob_screen_attr (s->foreg, s->backg, s->attr, ACCEPT_STATEMENT); - cob_move_cursor (cursor_clause_line, cursor_clause_col); - } else { - /* note: COBOL 2002 states that in this case the CURSOR clause is ignored, - while MicroFocus and ACUCOBOL-GT day "the nearest field" */ - } - } - } - -#ifdef NCURSES_MOUSE_VERSION - /* prevent warnings about not intialized structure */ - memset (&mevent, 0, sizeof (MEVENT)); -#endif - - for (; ;) { - if (s->prompt) { - default_prompt_char = s->prompt->data[0]; - } else { - default_prompt_char = COB_CH_UL; - } - - refresh (); - errno = 0; - timeout (accept_timeout); - keyp = getch (); - - /* FIXME: modularize (cob_screen_get_all, field_accept) and - use identical handling of keys wherever possible */ - - if (keyp == ERR) { - global_return = 8001; - goto screen_return; - } - if (keyp > KEY_F0 && keyp < KEY_F(65)) { - global_return = 1000 + keyp - KEY_F0; - goto screen_return; - } - -#ifdef NCURSES_MOUSE_VERSION - /* get mouse event here, handle later */ - if (keyp == KEY_MOUSE) { - getmouse (&mevent); - /* in case of left double-click: - always translate to ENTER in SCREEN ACCEPT; - exception: user requested control of this */ - if (mevent.bstate & BUTTON1_DOUBLE_CLICKED - && !(cob_mask_accept & BUTTON1_DOUBLE_CLICKED)) { - keyp = KEY_ENTER; - } - } -#endif - - cob_convert_key (&keyp, 0); - if (keyp <= 0) { - (void)flushinp (); - cob_beep (); - continue; - } - - getyx (stdscr, cline, ccolumn); - - switch (keyp) { - case KEY_ENTER: - if (finalize_all_fields (cob_base_inp, totl_index)) { - cob_beep (); - continue; - } - goto screen_return; - case KEY_PPAGE: - global_return = 2001; - goto screen_return; - case KEY_NPAGE: - global_return = 2002; - goto screen_return; - case KEY_PRINT: - global_return = 2006; - goto screen_return; - case '\033': - global_return = 2005; - goto screen_return; - case KEY_STAB: - finalize_field_input (s); - - if (curr_index < totl_index - 1) { - curr_index++; - } else { - curr_index = 0; - } - SET_FLD_AND_DATA_REFS (curr_index, sptr, s, sline, scolumn, right_pos, p); - at_eof = 0; - cob_move_cursor (sline, scolumn); - cob_screen_attr (s->foreg, s->backg, s->attr, ACCEPT_STATEMENT); - continue; - case KEY_BTAB: - finalize_field_input (s); - - if (curr_index > 0) { - curr_index--; - } else { - curr_index = totl_index - 1; - } - SET_FLD_AND_DATA_REFS (curr_index, sptr, s, sline, scolumn, right_pos, p); - at_eof = 0; - if (ungetched) { - ungetched = 0; - p = s->field->data + right_pos; - cob_move_cursor (sline, right_pos); - } else { - p = s->field->data; - cob_move_cursor (sline, scolumn); - } - cob_screen_attr (s->foreg, s->backg, s->attr, ACCEPT_STATEMENT); - continue; - case KEY_UP: - finalize_field_input (s); - - curr_index = sptr->up_index; - SET_FLD_AND_DATA_REFS (curr_index, sptr, s, sline, scolumn, right_pos, p); - at_eof = 0; - cob_move_cursor (sline, scolumn); - cob_screen_attr (s->foreg, s->backg, s->attr, ACCEPT_STATEMENT); - continue; - case KEY_DOWN: - finalize_field_input (s); - - curr_index = sptr->down_index; - SET_FLD_AND_DATA_REFS (curr_index, sptr, s, sline, scolumn, right_pos, p); - at_eof = 0; - cob_move_cursor (sline, scolumn); - cob_screen_attr (s->foreg, s->backg, s->attr, ACCEPT_STATEMENT); - continue; - case KEY_HOME: - finalize_field_input (s); - - curr_index = 0; - SET_FLD_AND_DATA_REFS (curr_index, sptr, s, sline, scolumn, right_pos, p); - at_eof = 0; - cob_move_cursor (sline, scolumn); - cob_screen_attr (s->foreg, s->backg, s->attr, ACCEPT_STATEMENT); - continue; - case KEY_END: - finalize_field_input (s); - - curr_index = totl_index - 1; - SET_FLD_AND_DATA_REFS (curr_index, sptr, s, sline, scolumn, right_pos, p); - at_eof = 0; - cob_move_cursor (sline, scolumn); - cob_screen_attr (s->foreg, s->backg, s->attr, ACCEPT_STATEMENT); - continue; - case KEY_BACKSPACE: - /* Backspace key. */ - if ((int) ccolumn > scolumn) { - at_eof = 0; - /* Shift remainder left with cursor. */ - for (count = ccolumn; count < right_pos + 1; count++) { - /* Get character. */ - p2 = s->field->data + count - scolumn ; - move_char = *p2; - /* Move the character left. */ - p2 = s->field->data + count - scolumn - 1; - *p2 = move_char; - /* Update screen with moved character. */ - cob_move_cursor (cline, count - 1); - if (s->attr & COB_SCREEN_NO_ECHO) { - cob_addch (COB_CH_SP); - } else if (s->attr & COB_SCREEN_SECURE) { - cob_addch (COB_CH_AS); - } else if (move_char == ' ') { - cob_addch (default_prompt_char); - } else { - cob_addch (move_char); - } - } - /* Put space as the right most character. */ - p2 = s->field->data + s->field->size - 1; - if (COB_FIELD_IS_NUMERIC (s->field)) { - *p2 = '0'; - } else { - *p2 = ' '; - } - /* Add space to screen. */ - cob_move_cursor (cline, count - 1); - if (s->attr & COB_SCREEN_NO_ECHO) { - cob_addch (COB_CH_SP); - } else if (s->attr & COB_SCREEN_SECURE) { - cob_addch (COB_CH_AS); - } else if (*p2 == ' ') { - cob_addch (default_prompt_char); - } else { - cob_addch (*p2); - } - /* Move cursor left one from current. */ - ccolumn--; - cob_move_cursor (cline, ccolumn); - p--; - } else { - cob_beep (); - } - continue; - case KEY_LEFT: - if (ccolumn > scolumn) { - ccolumn--; - cob_move_cursor (cline, ccolumn); - p = s->field->data + ccolumn - scolumn; - } else { - ungetched = 1; - ungetch (KEY_BTAB); - } - continue; - case KEY_RIGHT: - if (ccolumn < right_pos) { - ccolumn++; - cob_move_cursor (cline, ccolumn); - p = s->field->data + ccolumn - scolumn; - } else { - ungetch ('\t'); - } - continue; - case KEY_IC: - /* Insert key toggle */ - cob_toggle_insert(); - continue; - case KEY_DC: - /* Delete key. */ - /* Delete character, move remainder left. */ - for (count = ccolumn; count < right_pos; count++) { - /* Get character one position to right. */ - p2 = s->field->data + count - scolumn + 1; - move_char = *p2; - /* Move the character left. */ - p2 = s->field->data + count - scolumn; - *p2 = move_char; - /* Update screen with moved character. */ - cob_move_cursor (cline, count); - if (s->attr & COB_SCREEN_NO_ECHO) { - cob_addch (COB_CH_SP); - } else if (s->attr & COB_SCREEN_SECURE) { - cob_addch (COB_CH_AS); - } else if (move_char == ' ') { - cob_addch (default_prompt_char); - } else { - cob_addch (move_char); - } - } - /* Put space as the right most character. */ - p2 = s->field->data + s->field->size - 1; - if (COB_FIELD_IS_NUMERIC (s->field)) { - *p2 = '0'; - } else { - *p2 = ' '; - } - /* Add space to screen. */ - cob_move_cursor (cline, count); - if (s->attr & COB_SCREEN_NO_ECHO) { - cob_addch (COB_CH_SP); - } else if (s->attr & COB_SCREEN_SECURE) { - cob_addch (COB_CH_AS); - } else { - if (*p2 == ' ') { - cob_addch (default_prompt_char); - } else { - cob_addch (*p2); - } - } - /* Put cursor back to original position. */ - cob_move_cursor (cline, ccolumn); - continue; - -#ifdef NCURSES_MOUSE_VERSION - case KEY_MOUSE: - { - int mline = mevent.y; - int mcolumn = mevent.x; - /* handle depending on state */ - if (mevent.bstate & BUTTON1_PRESSED - && COB_MOUSE_FLAGS & 1) { - int fld_index = -1; - /* if in current field, just move */ - if (mline == cline) { - if (mcolumn >= scolumn - && mcolumn <= right_pos) { - ccolumn = mcolumn; - cob_move_cursor (cline, ccolumn); - p = s->field->data + ccolumn - scolumn; - continue; - } - } - finalize_field_input (s); - - fld_index = find_field_by_pos (initial_curs, mline, mcolumn); - if (fld_index >= 0) { - curr_index = fld_index; - SET_FLD_AND_DATA_REFS (curr_index, sptr, s, sline, scolumn, right_pos, p); - at_eof = 0; - cob_screen_attr (s->foreg, s->backg, s->attr, ACCEPT_STATEMENT); - cob_move_cursor (mline, mcolumn); - continue; - } - } - mevent.bstate &= cob_mask_accept; - if (mevent.bstate != 0) { - global_return = mouse_to_exception_code (mevent.bstate); - cob_move_cursor (mline, mcolumn); // move cursor to pass position - goto screen_return; - } - continue; - } -#endif - default: - break; - } - - /* Handle printable character. */ -#if 0 /* FIXME: we can't handle anything > UCHAR_MAX here because of - *p = (unsigned char) keyp; - --> revise */ - if (keyp > 037 && keyp < (int)A_CHARTEXT) { -#else - if (keyp > 037 && keyp <= UCHAR_MAX) { -#endif - /* Numeric field check. */ - if (cob_field_is_numeric_or_numeric_edited (s->field)) { - if (keyp < '0' || keyp > '9') { - cob_beep (); - continue; - } - } - - /* Handle UPPER/LOWER. */ - if (s->attr & COB_SCREEN_UPPER) { - if (islower (keyp)) { - keyp = toupper (keyp); - } - } else if (s->attr & COB_SCREEN_LOWER) { - if (isupper (keyp)) { - keyp = tolower (keyp); - } - } - - /* Insert character, if requested. */ - if (COB_INSERT_MODE == 1) { - /* get last character in field */ - /* check and beep if field is already full, - ignore numeric fields for now */ - if (cob_field_is_numeric_or_numeric_edited (s->field)) { - p2 = (unsigned char *)" "; - } else { - p2 = s->field->data + right_pos - scolumn; - } - if (*p2 != ' ') { - cob_beep (); - continue; - } - /* Move remainder to the right. */ - for (count = right_pos; count > ccolumn; count--) { - /* Get character */ - p2 = s->field->data + count - scolumn - 1; - move_char = *p2; - /* Move character one right. */ - p2 = s->field->data + count - scolumn; - *p2 = move_char; - /* Update screen with moved character. */ - if ((int) count > scolumn) { - cob_move_cursor (cline, count); - if (move_char != ' ') { - if (s->attr & COB_SCREEN_NO_ECHO) { - cob_addch (COB_CH_SP); - } else if (s->attr & COB_SCREEN_SECURE) { - cob_addch (COB_CH_AS); - } else { - cob_addch (move_char); - } - } - } - } - cob_move_cursor (cline, ccolumn); - } - - /* actual storing the key */ - *p = (unsigned char) keyp; - - /* Display character or '*' if secure. */ - if (s->attr & COB_SCREEN_SECURE) { - cob_addch (COB_CH_AS); - } else if (s->attr & COB_SCREEN_NO_ECHO) { - cob_addch (COB_CH_SP); - } else { - cob_addch ((const chtype)keyp); - } - if (ccolumn == right_pos) { - /* Auto-skip at end of field. */ - if (s->attr & COB_SCREEN_AUTO) { - if (curr_index == totl_index - 1) { - goto screen_return; - } else { - ungetch ('\t'); - } - } - cob_move_cursor (cline, ccolumn); - /* check if we (still) are at last position and inform - user with a beep (after having processed his key) */ - if (at_eof) { - cob_beep (); - } else { - at_eof = 1; - } - } else { - p++; - } - continue; - } - (void)flushinp (); - cob_beep (); - } -screen_return: - refresh (); -} - -static int -compare_yx (const void *m1, const void *m2) -{ - const struct cob_inp_struct *s1; - const struct cob_inp_struct *s2; - - s1 = m1; - s2 = m2; - if (s1->this_y < s2->this_y) { - return -1; - } - if (s1->this_y > s2->this_y) { - return 1; - } - if (s1->this_x < s2->this_x) { - return -1; - } - if (s1->this_x > s2->this_x) { - return 1; - } - return 0; -} - -static void -cob_screen_moveyx (cob_screen *s) -{ - int y; - int x; - int line; - int column; - - if (s->line || s->column || - s->attr & (COB_SCREEN_LINE_PLUS | COB_SCREEN_LINE_MINUS | - COB_SCREEN_COLUMN_PLUS | COB_SCREEN_COLUMN_MINUS)) { - getyx (stdscr, y, x); - if (x < 0 || y < 0) { - /* not translated as "testing only" (should not happen) */ - cob_runtime_warning ("negative values from getyx"); - x = y = 0; - } - /* Column adjust */ - if (x != 0) { - x--; - } - if (!s->line) { - line = y; - } else { - line = origin_y + cob_get_int (s->line); - if (line < 0) { - line = y; - } - } - if (!s->column) { - column = x; - } else { - column = origin_x + cob_get_int (s->column); - if (column < 0) { - column = x; - } - } - if (s->attr & COB_SCREEN_LINE_PLUS) { - line = y + line; - } else if (s->attr & COB_SCREEN_LINE_MINUS) { - line = y - line; - } - if (s->attr & COB_SCREEN_COLUMN_PLUS) { - column = x + column; - } else if (s->attr & COB_SCREEN_COLUMN_MINUS) { - column = x - column; - } - - cob_move_cursor (line, column); - refresh (); - cob_current_y = line; - cob_current_x = column; - } -} - -static size_t -cob_prep_input (cob_screen *s) -{ - struct cob_inp_struct *sptr; - int n; - - switch (s->type) { - case COB_SCREEN_TYPE_GROUP: - cob_screen_moveyx (s); - for (s = s->child; s; s = s->next) { - cob_prep_input (s); - } - break; - case COB_SCREEN_TYPE_FIELD: - cob_screen_puts (s, s->field, cobsetptr->cob_legacy, - ACCEPT_STATEMENT); - if (s->attr & COB_SCREEN_INPUT) { - if (totl_index >= COB_INP_FLD_MAX) { - return 1; - } - sptr = cob_base_inp + totl_index; - sptr->scr = s; - sptr->this_y = cob_current_y; - sptr->this_x = cob_current_x; - totl_index++; - } - break; - case COB_SCREEN_TYPE_VALUE: - cob_screen_puts (s, s->value, cobsetptr->cob_legacy, - ACCEPT_STATEMENT); - if (s->occurs) { - for (n = 1; n < s->occurs; ++n) { - cob_screen_puts (s, s->value, cobsetptr->cob_legacy, - ACCEPT_STATEMENT); - } - } - break; - case COB_SCREEN_TYPE_ATTRIBUTE: -#if 0 /* RXWRXW - Attr */ - cob_screen_attr (s->foreg, s->backg, s->attr); -#endif - break; - default: - break; - } - return 0; -} - -static void -cob_screen_iterate (cob_screen *s) -{ - int n; - - switch (s->type) { - case COB_SCREEN_TYPE_GROUP: - cob_screen_moveyx (s); - for (s = s->child; s; s = s->next) { - cob_screen_iterate (s); - } - break; - case COB_SCREEN_TYPE_FIELD: - cob_screen_puts (s, s->field, 0, DISPLAY_STATEMENT); - break; - case COB_SCREEN_TYPE_VALUE: - cob_screen_puts (s, s->value, 0, DISPLAY_STATEMENT); - if (s->occurs) { - for (n = 1; n < s->occurs; ++n) { - cob_screen_puts (s, s->value, 0, - DISPLAY_STATEMENT); - } - } - break; - case COB_SCREEN_TYPE_ATTRIBUTE: - cob_screen_attr (s->foreg, s->backg, s->attr, - DISPLAY_STATEMENT); - break; - default: - break; - } -} - -static void -get_line_and_col_from_num (cob_field *pos, int *line, int *column) -{ - int pos_val = cob_get_int (pos); - int max_line_column; - - /* - This is used when only a LINE clause is specified, not an AT clause. - */ - if (pos->size < 4) { - *line = pos_val; - *column = 1; - return; - } - - if (pos->size == 4) { - max_line_column = 100; - } else if (pos->size == 6) { - max_line_column = 1000; - } else { - /* Throw an exception? EC-SCREEN-IMP-LINE-VAR-LENGTH? */ - max_line_column = 1; /* set to some value that don't crash */ - } - *line = (pos_val / max_line_column); - *column = (pos_val % max_line_column); -} - -static void -get_line_column (cob_field *fline, cob_field *fcol, int *line, int *col) -{ - if (fline == NULL) { - *line = 1; - } else { - *line = cob_get_int (fline); - } - - if (fcol == NULL) { - *col = 1; - } else { - *col = cob_get_int (fcol); - } -} - -static COB_INLINE COB_A_INLINE int -col_where_last_stmt_ended (const enum screen_statement stmt) -{ - return stmt == DISPLAY_STATEMENT ? display_cursor_x : accept_cursor_x; -} - -static COB_INLINE COB_A_INLINE int -line_where_last_stmt_ended (const enum screen_statement stmt) -{ - return stmt == DISPLAY_STATEMENT ? display_cursor_y : accept_cursor_y; -} - -static void -extract_line_and_col_vals (cob_field *line, cob_field *column, - const enum screen_statement stmt, - const int zero_line_col_allowed, - int *sline, int *scolumn) -{ - int cobol_line; - int cobol_col; - - if (column == NULL) { - if (line == NULL) { - *sline = 0; - *scolumn = 0; - return; - } else { - /* - line actually contains both the line and field - numbers. - */ - get_line_and_col_from_num (line, &cobol_line, - &cobol_col); - } - } else { - get_line_column (line, column, &cobol_line, &cobol_col); - } - - if (cobol_line == 0) { - if (cobol_col == 0) { - if (zero_line_col_allowed) { - *sline = line_where_last_stmt_ended (stmt); - *scolumn = col_where_last_stmt_ended (stmt); - } else { - cob_set_exception (COB_EC_SCREEN_LINE_NUMBER); - cob_set_exception (COB_EC_SCREEN_STARTING_COLUMN); - *sline = 0; - *scolumn = 0; - } - } else { - if (zero_line_col_allowed) { - *sline = line_where_last_stmt_ended (stmt) + 1; - } else { - cob_set_exception (COB_EC_SCREEN_LINE_NUMBER); - *sline = 0; - } - *scolumn = cobol_col - 1; - } - } else if (cobol_col == 0) { - *sline = cobol_line - 1; - if (zero_line_col_allowed) { - *scolumn = col_where_last_stmt_ended (stmt); - } else { - cob_set_exception (COB_EC_SCREEN_STARTING_COLUMN); - *scolumn = 0; - } - } else { - *sline = cobol_line - 1; - *scolumn = cobol_col - 1; - } - - /* TO-DO: If scolumn == max_x + 1, go to start of next line */ -} - -static void -screen_display (cob_screen *s, const int line, const int column) -{ - int status; - init_cob_screen_if_needed (); - - origin_y = line; - origin_x = column; - - status = cob_move_cursor (line, column); - if (status != ERR) { - pending_accept = 1; - } - cob_screen_iterate (s); - refresh (); -} - -static int -get_accept_timeout (cob_field *ftimeout) -{ - if (ftimeout) { - /* FIXME: the scale should come primarily from the module, - TODO: add scale field to module_ptr */ - return cob_get_int (ftimeout) * COB_TIMEOUT_SCALE; - } else { - return -1; - } -} - -static void -screen_accept (cob_screen *s, const int line, const int column, - cob_field *ftimeout) -{ - struct cob_inp_struct *sptr; - struct cob_inp_struct *sptr2; - size_t idx; - size_t n; - size_t posu; - size_t posd; - size_t prevy; - size_t firsty; - int starty; - int initial_curs; - int accept_timeout; - - init_cob_screen_if_needed (); - if (!cob_base_inp) { - cob_base_inp = cob_malloc (COB_INP_SIZE); - } else { - memset (cob_base_inp, 0, COB_INP_SIZE); - } - cobglobptr->cob_exception_code = 0; - cob_current_y = 0; - cob_current_x = 0; - totl_index = 0; - origin_y = line; - origin_x = column; - - cob_move_cursor (line, column); - - /* Prepare input fields */ - if (cob_prep_input (s)) { - pass_cursor_to_program (); - handle_status (9001); - return; - } - - /* No input field is an error */ - if (!totl_index) { - pass_cursor_to_program (); - handle_status (8000); - return; - } - - accept_timeout = get_accept_timeout (ftimeout); - - /* Sort input fields on line, column - --> breaks standard and other vendors compatiblilty "in the order defined" */ - qsort (cob_base_inp, totl_index, - sizeof(struct cob_inp_struct), compare_yx); - - posu = 0; - posd = 0; - prevy = 0; - firsty = 0; - sptr = cob_base_inp; - starty = sptr->this_y; - initial_curs = -1; - /* Set up array for Cursor UP/DOWN */ - for (n = 0; n < totl_index; n++) { - sptr = cob_base_inp + n; - if ((sptr->scr->attr & COB_SCREEN_INITIAL) && initial_curs < 0) { - initial_curs = (int)n; - } - if (sptr->this_y > starty) { - if (!firsty) { - firsty = n; - } - starty = sptr->this_y; - sptr2 = cob_base_inp + posd; - for (idx = posd; idx < n; idx++, sptr2++) { - sptr2->down_index = n; - } - posu = prevy; - prevy = n; - posd = n; - } - sptr->up_index = posu; - } - sptr = cob_base_inp; - for (n = 0; n < firsty; n++, sptr++) { - sptr->up_index = posd; - } - global_return = 0; - if (initial_curs < 0) { - initial_curs = 0; - } - cob_screen_get_all (initial_curs, accept_timeout); - pass_cursor_to_program (); - handle_status (global_return); -} - -static void -field_display (cob_field *f, const int line, const int column, cob_field *fgc, - cob_field *bgc, cob_field *fscroll, cob_field *size_is, - const cob_flags_t fattr) -{ - int sline; - int scolumn; - int size_display, fsize; - int status; - char fig_const; /* figurative constant character */ - - /* LCOV_EXCL_START */ - if (unlikely (!f)) { - cob_fatal_error(COB_FERROR_CODEGEN); - } - /* LCOV_EXCL_STOP */ - - origin_y = 0; - origin_x = 0; - - fsize = (int)f->size; - if (size_is) { - size_display = (unsigned int)cob_get_int (size_is); - /* SIZE ZERO is ignored */ - if (size_display == 0) { - size_display = fsize; - } - } else if (fattr & COB_SCREEN_NO_DISP) { - size_display = 0; - } else { - size_display = fsize; - } - - if (fscroll) { - sline = cob_get_int (fscroll); - if (fattr & COB_SCREEN_SCROLL_DOWN) { - sline = -sline; - } - scrollok (stdscr, 1); - scrl (sline); - scrollok (stdscr, 0); - refresh (); - } - - sline = line; - scolumn = column; - status = cob_move_cursor (sline, scolumn); - if (status != ERR) { - pending_accept = 1; - } - - cob_screen_attr (fgc, bgc, fattr, DISPLAY_STATEMENT); - if (!(fattr & COB_SCREEN_NO_DISP)) { - /* figurative constant and WITH SIZE repeats the literal */ - if (size_is - && f->attr->type == COB_TYPE_ALPHANUMERIC_ALL) { - if ((int)f->size == 1) { - fig_const = f->data[0]; - cob_addnch (size_display, fig_const); - } else { - int i; - for (i = 0; i < (size_display / fsize); ++i) { - cob_addnstr ((char *)f->data, fsize); - } - cob_addnstr ((char *)f->data, size_display % fsize); - } - } else { - cob_addnstr ((char *)f->data, cob_min_int (size_display, fsize)); - if (size_display > fsize) { - /* WITH SIZE larger than field displays trailing spaces */ - cob_addnch (size_display - fsize, COB_CH_SP); - } - } - } - - display_cursor_y = sline; - display_cursor_x = scolumn + size_display; - - if (fattr & COB_SCREEN_EMULATE_NL) { - if (++sline >= LINES) { - sline = 0; - } - cob_move_cursor (sline, 0); - } - refresh (); -} - -static void -field_accept (cob_field *f, const int sline, const int scolumn, cob_field *fgc, - cob_field *bgc, cob_field *fscroll, cob_field *ftimeout, - cob_field *prompt, cob_field *size_is, const cob_flags_t fattr) -{ - unsigned char *p; - unsigned char *p2; - size_t count; - int keyp; - int fret = 0; - int cline = 0; - size_t ccolumn = 0; - size_t right_pos; - int at_eof = 0; - unsigned char move_char; /* data shift character */ - int status; - chtype prompt_char; /* prompt character */ - chtype default_prompt_char; - size_t size_accept = 0; /* final size to accept */ - cob_field temp_field; -#if 0 /* RXWRXW - Screen update */ - cob_field char_temp; - unsigned char space_buff[4]; -#endif -#ifdef NCURSES_MOUSE_VERSION - MEVENT mevent; -#endif - - memset (COB_TERM_BUFF, ' ', (size_t)COB_MEDIUM_MAX); - temp_field.data = COB_TERM_BUFF; - temp_field.attr = &const_alpha_attr; -#if 0 /* RXWRXW - Screen update */ - char_temp.data = space_buff; - char_temp.attr = &const_alpha_attr; - char_temp.size = 1; - space_buff[0] = ' '; - space_buff[1] = 0; -#endif - - origin_y = 0; - origin_x = 0; -#ifdef NCURSES_MOUSE_VERSION - /* prevent warnings about not intialized structure */ - memset (&mevent, 0, sizeof (MEVENT)); -#endif - - /* Set the default prompt character */ - if (prompt) { - default_prompt_char = prompt->data[0]; - } else { - default_prompt_char = COB_CH_UL; - } - init_cob_screen_if_needed (); - - - if (fscroll) { - keyp = cob_get_int (fscroll); - if (fattr & COB_SCREEN_SCROLL_DOWN) { - keyp = -keyp; - } - scrollok (stdscr, 1); - scrl (keyp); - scrollok (stdscr, 0); - refresh (); - } - cobglobptr->cob_exception_code = 0; - - status = cob_move_cursor (sline, scolumn); - if (status != ERR) { - pending_accept = 0; - } - - cob_screen_attr (fgc, bgc, fattr, ACCEPT_STATEMENT); - - if (f) { - if (size_is) { - size_accept = cob_get_int (size_is); - /* SIZE ZERO is ignored */ - if (size_accept == 0) { - size_accept = (int)f->size; - } - } else { - size_accept = f->size; - } - - p = COB_TERM_BUFF; - temp_field.size = size_accept; - if (fattr & COB_SCREEN_UPDATE) { - cob_move (f, &temp_field); - } - - raise_ec_on_truncation (size_accept); - for (count = 0; count < (size_t) cob_min_int (size_accept, f->size); count++) { - if (fattr & COB_SCREEN_SECURE) { - cob_addch_no_trunc_check (COB_CH_AS); - } else if (fattr & COB_SCREEN_NO_ECHO) { - cob_addch_no_trunc_check (COB_CH_SP); - } else if (fattr & COB_SCREEN_UPDATE) { - cob_addch_no_trunc_check ((const chtype)*p++); - } else if (COB_FIELD_IS_NUMERIC (f)) { - cob_addch_no_trunc_check ('0'); - } else if (fattr & COB_SCREEN_PROMPT) { - cob_addch_no_trunc_check (default_prompt_char); - } else { - cob_addch_no_trunc_check (COB_CH_SP); - } - } - /* SIZE IS greater than field, blank out trailing screen */ - if (size_accept > (int)f->size) { - cob_addnch (size_accept - f->size, COB_CH_SP); - } - cob_move_cursor (sline, scolumn); -#if 0 /* RXWRXW - Screen update */ - if (!(fattr & COB_SCREEN_UPDATE)) { - if (cob_field_is_numeric_or_numeric_edited (f)) { - cob_set_int (f, 0); - } else { - cob_move (&char_temp, f); - } - } -#endif - - accept_cursor_y = sline; - accept_cursor_x = scolumn + size_accept; - - /* position for the SPECIAL-NAMES CURSOR clause, if given */ - { - int cursor_clause_line; - int cursor_clause_col; - get_cursor_from_program (&cursor_clause_line, &cursor_clause_col); - - if (cursor_clause_line == sline - && cursor_clause_col > scolumn - && cursor_clause_col < scolumn + (int)f->size) { - cob_move_cursor (cursor_clause_line, cursor_clause_col); - } - } - - right_pos = scolumn + size_accept - 1; - p = COB_TERM_BUFF; - } else { - right_pos = 0; - p = NULL; - } - count = 0; - - timeout (get_accept_timeout (ftimeout)); - - /* Get characters from keyboard, processing each one. */ - for (; ;) { - /* Show prompt characters. */ - if (f) { - /* Get current line, column. */ - getyx (stdscr, cline, ccolumn); - /* Trailing prompts. */ - if (fattr & COB_SCREEN_NO_ECHO) { - prompt_char = COB_CH_SP; - } else if (COB_FIELD_IS_NUMERIC (f)) { - prompt_char = '0'; - } else if (fattr & COB_SCREEN_PROMPT) { - prompt_char = default_prompt_char; - } else { - prompt_char = COB_CH_SP; - } - for (count = right_pos; (int)count > scolumn - 1; count--) { - /* Get character */ - p2 = COB_TERM_BUFF + count - scolumn; - move_char = *p2; - /* Field prompts. */ - if (COB_FIELD_IS_NUMERIC (f)) { - /* Numeric prompt zeros. */ - if (move_char == '0') { - cob_move_cursor (cline, count); - cob_addch (prompt_char); - } else { - /* Switch to remove prompts from within field. */ - if (fattr & COB_SCREEN_NO_ECHO) { - prompt_char = COB_CH_SP; - } else if (fattr & COB_SCREEN_SECURE) { - prompt_char = COB_CH_AS; - } else { - prompt_char = '0'; - } - } - } else { - /* Alpha prompts. */ - if (move_char == ' ') { - cob_move_cursor (cline, count); - cob_addch (prompt_char); - } else { - /* Switch to remove prompts from within field. */ - if (fattr & COB_SCREEN_NO_ECHO) { - prompt_char = COB_CH_SP; - } else if (fattr & COB_SCREEN_SECURE) { - prompt_char = COB_CH_AS; - } else { - prompt_char = COB_CH_SP; - } - } - } - } - /* Cursor to current column. */ - cob_move_cursor (cline, ccolumn); - /* Refresh screen. */ - refresh (); - } - errno = 0; - - /* Get a character. */ - keyp = getch (); - - /* Key error - time out. */ - if (keyp == ERR) { - fret = 8001; - goto field_return; - } - /* Return function keys F1 through F64 */ - if (keyp > KEY_F0 && keyp < KEY_F(65)) { - fret = 1000 + keyp - KEY_F0; - goto field_return; - } - - cob_convert_key (&keyp, 1U); - if (keyp <= 0) { - (void)flushinp (); - cob_beep (); - continue; - } - -#ifdef NCURSES_MOUSE_VERSION - /* get mouse event here, handle later */ - if (keyp == KEY_MOUSE) { - getmouse (&mevent); - /* in case of left double-click: - always translate to ENTER in SCREEN ACCEPT; - exception: user requested control of this */ - if (mevent.bstate & BUTTON1_DOUBLE_CLICKED - && !(cob_mask_accept & BUTTON1_DOUBLE_CLICKED)) { - keyp = KEY_ENTER; - } - } -#endif - - /* Return special keys */ - switch (keyp) { - case KEY_ENTER: - /* Enter. */ - goto field_return; - case KEY_PPAGE: - /* Page up. */ - fret = 2001; - goto field_return; - case KEY_NPAGE: - /* Page down. */ - fret = 2002; - goto field_return; - case KEY_UP: - /* Up arrow. */ - fret = 2003; - goto field_return; - case KEY_DOWN: - /* Down arrow. */ - fret = 2004; - goto field_return; - case KEY_PRINT: - /* Print key. */ - /* pdcurses not returning this ? */ - fret = 2006; - goto field_return; - case 033: - /* Escape key. */ - fret = 2005; - goto field_return; - case KEY_STAB: - /* Tab key. */ - fret = 2007; - goto field_return; - case KEY_BTAB: - /* Shift-Tab key, Back tab. */ - fret = 2008; - goto field_return; - default: - break; - } - - /* extension: ACCEPT OMITTED */ - if (unlikely (!f)) { - /* special keys for ACCEPT OMITTED */ - switch (keyp) { - case KEY_LEFT: - fret = 2009; - goto field_return; - case KEY_RIGHT: - fret = 2010; - goto field_return; - case KEY_IC: - /* Insert key. */ - fret = 2011; - goto field_return; - case KEY_DC: - /* Delete key. */ - fret = 2012; - goto field_return; - case KEY_BACKSPACE: - /* Backspace key. */ - fret = 2013; - goto field_return; - case KEY_HOME: - /* Home key. */ - fret = 2014; - goto field_return; - case KEY_END: - /* End key. */ - fret = 2015; - goto field_return; -#ifdef NCURSES_MOUSE_VERSION - case KEY_MOUSE: - { - int mline = mevent.y; - int mcolumn = mevent.x; - mevent.bstate &= cob_mask_accept; - if (mevent.bstate != 0) { - fret = mouse_to_exception_code (mevent.bstate); - cob_move_cursor (mline, mcolumn); // move cursor to pass position - goto field_return; - } - } -#endif - default: - (void)flushinp (); - cob_beep (); - continue; - } - } - - /* Positioning keys */ - switch (keyp) { - case KEY_BACKSPACE: - /* Backspace key. */ - if ((int) ccolumn > scolumn) { - /* Shift remainder left with cursor. */ - for (count = ccolumn; count < right_pos + 1; count++) { - /* Get character. */ - p2 = COB_TERM_BUFF + count - scolumn ; - move_char = *p2; - /* Move the character left. */ - p2 = COB_TERM_BUFF + count - scolumn - 1; - *p2 = move_char; - /* Update screen with moved character. */ - cob_move_cursor (cline, count - 1); - if (fattr & COB_SCREEN_NO_ECHO) { - cob_addch (COB_CH_SP); - } else if (fattr & COB_SCREEN_SECURE) { - cob_addch (COB_CH_AS); - } else { - cob_addch (move_char); - } - } - /* Put space as the right most character. */ - p2 = COB_TERM_BUFF + size_accept - 1; - if (fattr & COB_SCREEN_NO_ECHO) { - *p2 = COB_CH_SP; - } else if (COB_FIELD_IS_NUMERIC (f)) { - *p2 = '0'; - } else { - *p2 = COB_CH_SP; - } - /* Move cursor left one from current. */ - ccolumn--; - cob_move_cursor (cline, ccolumn); - p--; - } else { - cob_beep (); - } - at_eof = 0; - continue; - case KEY_HOME: - /* HOME key. */ - /* Prepare for empty field. */ - move_char = ' '; - /* Find non-blank character left to right. */ - for (count = scolumn; count <= right_pos; count++) { - /* Get character. */ - p2 = COB_TERM_BUFF + count - scolumn; - move_char = *p2; - /* Stop at beginning non-blank character. */ - if (move_char != ' ') { - break; - } - } - /* Empty field. */ - if (move_char == ' ') { - count = ccolumn; - } - /* Toggle between start of characters or start of field. */ - if (count != ccolumn) { - /* Cursor to start of characters. */ - ccolumn = count; - cob_move_cursor (cline, ccolumn); - p = COB_TERM_BUFF + ccolumn - scolumn; - } else { - /* Cursor to start of field. */ - cob_move_cursor (sline, scolumn); - p = COB_TERM_BUFF; - } - /* Reset */ - at_eof = 0; - continue; - case KEY_END: - /* END key. */ - /* Prepare for empty field. */ - move_char = ' '; - /* Find non-blank character right to left. */ - for (count = right_pos; (int) count >= scolumn; count--) { - /* Get character. */ - p2 = COB_TERM_BUFF + count - scolumn; - move_char = *p2; - /* Stop at ending non-blank character. */ - if (move_char != ' ') { - break; - } - } - /* Empty field. */ - if (move_char == ' ') { - count = ccolumn; - } else { - /* Cursor to first blank after ending character. */ - if (count != right_pos) { - count++; - } - } - /* Toggle between end of characters or end of field. */ - if (count != ccolumn) { - /* Cursor after end character. */ - ccolumn = count; - cob_move_cursor (cline, ccolumn); - p = COB_TERM_BUFF + ccolumn - scolumn; - } else { - /* Cursor to end of size of field */ - cob_move_cursor (sline, right_pos); - p = COB_TERM_BUFF + size_accept - 1; - } - /* Reset */ - at_eof = 0; - continue; - case KEY_LEFT: - case ALT_LEFT: - /* Left-arrow KEY_LEFT auto-skip. */ - /* Alt-left-arrow ALT_LEFT no auto-skip. */ - at_eof = 0; - if ((int) ccolumn > scolumn) { - ccolumn--; - cob_move_cursor (cline, ccolumn); - p = COB_TERM_BUFF + ccolumn - scolumn; - continue; - } - /* End of field, auto-skip, return left-arrow. */ - if (fattr & COB_SCREEN_AUTO && keyp == KEY_LEFT) { - fret = 2009; - goto field_return; - } - cob_beep (); - continue; - case KEY_RIGHT: - case ALT_RIGHT: - /* Right-arrow KEY_RIGHT auto-skip. */ - /* Alt-right-arrow ALT_RIGHT no auto-skip. */ - if (ccolumn < right_pos) { - ccolumn++; - cob_move_cursor (cline, ccolumn); - p = COB_TERM_BUFF + ccolumn - scolumn; - continue; - } - /* End of field, auto-skip, return right-arrow. */ - if (fattr & COB_SCREEN_AUTO && keyp == KEY_RIGHT) { - fret = 2010; - goto field_return; - } - cob_beep (); - continue; - case KEY_IC: - /* Insert key toggle */ - cob_toggle_insert (); - continue; - case KEY_DC: - /* Delete key. */ - /* Delete character, move remainder left. */ - for (count = ccolumn; count < right_pos; count++) { - /* Get character one position to right. */ - p2 = COB_TERM_BUFF + count - scolumn + 1; - move_char = *p2; - /* Move the character left. */ - p2 = COB_TERM_BUFF + count - scolumn; - *p2 = move_char; - /* Update screen with moved character. */ - cob_move_cursor (cline, count); - if (fattr & COB_SCREEN_NO_ECHO) { - cob_addch (COB_CH_SP); - } else if (fattr & COB_SCREEN_SECURE) { - cob_addch (COB_CH_AS); - } else { - cob_addch (move_char); - } - } - /* Put space as the right most character. */ - p2 = COB_TERM_BUFF + size_accept - 1; - if (fattr & COB_SCREEN_NO_ECHO) { - *p2 = COB_CH_SP; - } else if (COB_FIELD_IS_NUMERIC (f)) { - *p2 = '0'; - } else { - *p2 = COB_CH_SP; - } - /* Put cursor back to original position. */ - cob_move_cursor (cline, ccolumn); - continue; - case ALT_DEL: - /* Alt-Delete key, erase cursor to end of field. */ - for (count = ccolumn; count <= right_pos; count++) { - /* Character position. */ - p2 = COB_TERM_BUFF + count - scolumn; - /* Blank character. */ - if (fattr & COB_FIELD_IS_NUMERIC (f)) { - move_char = '0'; - } else { - move_char = COB_CH_SP; - } - *p2 = move_char; - /* Update screen with blank character. */ - cob_move_cursor (cline, count); - if (fattr & COB_SCREEN_NO_ECHO) { - cob_addch (COB_CH_SP); - } else if (fattr & COB_SCREEN_SECURE) { - cob_addch (COB_CH_AS); - } else { - cob_addch (move_char); - } - } - /* Put cursor back to original position. */ - cob_move_cursor (cline, ccolumn); - continue; - -#ifdef NCURSES_MOUSE_VERSION - case KEY_MOUSE: - { - int mline = mevent.y; - int mcolumn = mevent.x; - /* handle depending on state */ - if (mevent.bstate & BUTTON1_PRESSED - && COB_MOUSE_FLAGS & 1) { - /* if in current field, just move */ - if (mline == cline) { - if (mcolumn >= scolumn - && mcolumn <= (int)right_pos) { - ccolumn = mcolumn; - cob_move_cursor (cline, ccolumn); - p = COB_TERM_BUFF + ccolumn - scolumn; - continue; - } - } - /* CHECKME: shouldn't we have a finalize here? */ - } - mevent.bstate &= cob_mask_accept; - if (mevent.bstate != 0) { - fret = mouse_to_exception_code (mevent.bstate); - cob_move_cursor (mline, mcolumn); // move cursor to pass position - goto field_return; - } - continue; - } -#endif - default: - break; - } - - /* Handle printable character. */ -#if 0 /* FIXME: we can't handle anything > UCHAR_MAX here because of - *p = (unsigned char) keyp; - --> revise */ - if (keyp > 037 && keyp < (int)A_CHARTEXT) { -#else - if (keyp > 037 && keyp <= UCHAR_MAX) { -#endif - /* Numeric field check. */ - if (cob_field_is_numeric_or_numeric_edited (f)) { - if (keyp < '0' || keyp > '9') { - cob_beep (); - continue; - } - } - - /* Handle UPPER/LOWER. */ - if (fattr & COB_SCREEN_UPPER) { - if (islower (keyp)) { - keyp = toupper (keyp); - } - } else if (fattr & COB_SCREEN_LOWER) { - if (isupper (keyp)) { - keyp = tolower (keyp); - } - } - - /* Insert character, if requested. */ - if (COB_INSERT_MODE == 1 - && size_accept > 1) { - /* get last character in field */ - /* check and beep if field is already full, - ignore numeric fields for now */ - if (cob_field_is_numeric_or_numeric_edited (f)) { - p2 = (unsigned char *)" "; - } else { - p2 = COB_TERM_BUFF + right_pos - scolumn; - } - if (*p2 != ' ') { - cob_beep (); - continue; - } - /* Move remainder to the right. */ - for (count = right_pos; count > ccolumn; count--) { - /* Get character */ - p2 = COB_TERM_BUFF + count - scolumn - 1; - move_char = *p2; - /* Move character one right. */ - p2 = COB_TERM_BUFF + count - scolumn; - *p2 = move_char; - /* Update screen with moved character. */ - if ((int) count > scolumn) { - cob_move_cursor (cline, count); - if (move_char != ' ') { - if (fattr & COB_SCREEN_NO_ECHO) { - cob_addch (COB_CH_SP); - } else if (fattr & COB_SCREEN_SECURE) { - cob_addch (COB_CH_AS); - } else { - cob_addch (move_char); - } - } - } - } - cob_move_cursor (cline, ccolumn); - } - - /* actual storing the key */ - *p = (unsigned char)keyp; - - count = 1; - /* Display character or '*' if secure. */ - if (fattr & COB_SCREEN_SECURE) { - cob_addch (COB_CH_AS); - } else if (fattr & COB_SCREEN_NO_ECHO) { - cob_addch (COB_CH_SP); - } else { - cob_addch ((const chtype)keyp); - } - if (ccolumn == right_pos) { - /* Auto-skip at end of field. */ - if (fattr & COB_SCREEN_AUTO) { - break; - } - cob_move_cursor (cline, ccolumn); - /* check if we (still) are at last position and inform - user with a beep (after having processed his key) */ - if (at_eof) { - cob_beep (); - } else { - at_eof = 1; - } - } else { - p++; - } - continue; - } - (void)flushinp (); - cob_beep (); - } - field_return: - pass_cursor_to_program (); - handle_status (fret); - if (f) { - cob_move (&temp_field, f); - cob_move_cursor (sline, right_pos + 1); - } - refresh (); -} - -static void -field_accept_from_curpos (cob_field *f, cob_field *fgc, - cob_field *bgc, cob_field *fscroll, cob_field *ftimeout, - cob_field *prompt, cob_field *size_is, const cob_flags_t fattr) -{ - int cline; - size_t ccolumn; - - /* Get current line, column. */ - getyx (stdscr, cline, ccolumn); - - /* accept field */ - field_accept (f, cline, ccolumn, fgc, bgc, fscroll, ftimeout, prompt, size_is, fattr); -} - -static void -field_display_at_curpos (cob_field *f, - cob_field *fgc, cob_field *bgc, cob_field *fscroll, - cob_field *size_is, const cob_flags_t fattr) -{ - int cline; - size_t ccolumn; - - /* Get current line, column. */ - getyx (stdscr, cline, ccolumn); - - field_display (f, cline, ccolumn, fgc, bgc, fscroll, size_is, fattr); -} - -/* Global functions */ - -void -cob_screen_display (cob_screen *s, cob_field *line, cob_field *column, - const int zero_line_col_allowed) -{ - int sline; - int scolumn; - - extract_line_and_col_vals (line, column, DISPLAY_STATEMENT, - zero_line_col_allowed, &sline, &scolumn); - screen_display (s, sline, scolumn); -} -void -cob_screen_accept (cob_screen *s, cob_field *line, cob_field *column, - cob_field *ftimeout, const int zero_line_col_allowed) -{ - int sline; - int scolumn; - - extract_line_and_col_vals (line, column, ACCEPT_STATEMENT, - zero_line_col_allowed, &sline, &scolumn); - screen_accept (s, sline, scolumn, ftimeout); -} - -void -cob_field_display (cob_field *f, cob_field *line, cob_field *column, - cob_field *fgc, cob_field *bgc, cob_field *fscroll, - cob_field *size_is, const cob_flags_t fattr) -{ - int sline; - int scolumn; - - init_cob_screen_if_needed (); - /* - LINE/COL 0 is always allowed as it is impossible to specify it in the - standard format (DISPLAY ... UPON CRT) and all implementations of the - extended screen format (DISPLAY ... WITH UNDERLINE, HIGHLIGHT, etc.) - require it. - */ - extract_line_and_col_vals (line, column, DISPLAY_STATEMENT, 1, &sline, - &scolumn); - field_display (f, sline, scolumn, fgc, bgc, fscroll, size_is, fattr); -} - -void -cob_field_accept (cob_field *f, cob_field *line, cob_field *column, - cob_field *fgc, cob_field *bgc, cob_field *fscroll, - cob_field *ftimeout, cob_field *prompt, cob_field *size_is, - const cob_flags_t fattr) -{ - int sline; - int scolumn; - - /* See above comment in cob_field_display. */ - extract_line_and_col_vals (line, column, ACCEPT_STATEMENT, 1, &sline, - &scolumn); - field_accept (f, sline, scolumn, fgc, bgc, fscroll, ftimeout, prompt, - size_is, fattr); -} - -int -cob_sys_clear_screen (void) -{ - init_cob_screen_if_needed (); - - clear (); - refresh (); - cob_current_y = 0; - cob_current_x = 0; - return 0; -} - -void -cob_screen_set_mode (const cob_u32_t smode) -{ - init_cob_screen_if_needed (); - - if (!smode) { - refresh (); - def_prog_mode (); - endwin (); - } else { - reset_prog_mode (); - refresh (); - } -} - -/* display a C string without auto-newline */ -int -cob_display_text (const char *text) -{ - cob_field field; - cob_field_attr attr; - - init_cob_screen_if_needed (); - - if (text[0] == 0) return 0; - - COB_FIELD_INIT (strlen (text), (unsigned char *)text, &attr); - COB_ATTR_INIT (COB_TYPE_ALPHANUMERIC, 0, 0, 0, NULL); - - field_display_at_curpos (&field, NULL, NULL, NULL, NULL, 0); - - return 0; -} - -/* C: get a char x'01' thru x'255' or keyboard status > 1000 (or 0) - without any prompt */ -int -cob_get_char (void) -{ - cob_field field; - char c = ' '; - cob_field_attr attr; - - init_cob_screen_if_needed (); - - COB_FIELD_INIT (1, (unsigned char *)&c, &attr); - COB_ATTR_INIT (COB_TYPE_ALPHANUMERIC, 0, 0, 0, NULL); - - field_accept_from_curpos (&field, NULL, NULL, NULL, NULL, NULL, NULL, - COB_SCREEN_AUTO | COB_SCREEN_NO_ECHO); - - /* CHECKME: MF docs are not clear: should this return 0 ? */ - if (c == ' ') { - return COB_ACCEPT_STATUS; -#if EOF != -1 - } else if (c == EOF) { - return -1; -#endif - } else { - return c; - } -} - -/* get a C string with given max-length - returns keyboard status */ -int -cob_get_text (char *text, int size) -{ - cob_field field; - cob_field_attr attr; - - init_cob_screen_if_needed (); - - if (size > 0) { - COB_FIELD_INIT (size, (unsigned char *)text, &attr); - COB_ATTR_INIT (COB_TYPE_ALPHANUMERIC, 0, 0, 0, NULL); - field_accept_from_curpos (&field, NULL, NULL, NULL, NULL, NULL, NULL, 0); - } else { - field_accept (NULL, 0, 0, NULL, NULL, NULL, NULL, NULL, NULL, 0); - } - - return COB_ACCEPT_STATUS; -} - -/* display a formatted C string without auto-newline */ -int -cob_display_formatted_text (const char *fmt, ...) -{ - int size; - cob_field field; - cob_field_attr attr; - va_list ap; - char buff [COB_NORMAL_BUFF]; - - init_cob_screen_if_needed (); - - va_start (ap, fmt); - size = vsnprintf (buff, COB_NORMAL_BUFF, fmt, ap); - va_end (ap); - - if (size < 0) { - return -1; - } - - if (buff[0] == 0) { - return 0; - } - - field.size = cob_min_int (size, COB_NORMAL_MAX); - field.data = (unsigned char *)&buff; - COB_ATTR_INIT (COB_TYPE_ALPHANUMERIC, 0, 0, 0, NULL); - field.attr = &attr; - - field_display_at_curpos (&field, NULL, NULL, NULL, NULL, 0); - - return 0; -} - -void -cob_exit_screen (void) -{ - cob_flags_t flags; - char exit_msg[COB_MINI_BUFF]; - - if (!cobglobptr) { - return; - } - if (cobglobptr->cob_screen_initialized) { - if (pending_accept && cobsetptr->cob_exit_wait) { - /* FIXME: we likely should position to the last line since last cleanup before: - DISPLAY AT 1010 DISPLAY AT 0909 GOBACK overrides first DISPLAY */ - if (cobsetptr->cob_exit_msg[0] != 0) { - snprintf (exit_msg, COB_MINI_BUFF, "\n%s ", cobsetptr->cob_exit_msg); - cob_display_text (exit_msg); - } else { - cob_display_text (" "); - } - flags = COB_SCREEN_NO_ECHO; - field_accept_from_curpos (NULL, NULL, NULL, NULL, NULL, NULL, NULL, flags); - } - cobglobptr->cob_screen_initialized = 0; - clear (); - cob_move_to_beg_of_last_line (); - delwin (stdscr); - endwin (); -#ifdef HAVE_CURSES_FREEALL - _nc_freeall (); -#endif - if (cob_base_inp) { - cob_free (cob_base_inp); - cob_base_inp = NULL; - } - } - COB_ACCEPT_STATUS = 0; -} - -#else /* WITH_EXTENDED_SCREENIO */ - -void -cob_exit_screen (void) -{ -} - -void -cob_field_display (cob_field *f, cob_field *line, cob_field *column, - cob_field *fgc, cob_field *bgc, cob_field *fscroll, - cob_field *size_is, const cob_flags_t fattr) -{ - COB_UNUSED (f); - COB_UNUSED (line); - COB_UNUSED (column); - COB_UNUSED (fgc); - COB_UNUSED (bgc); - COB_UNUSED (fscroll); - COB_UNUSED (size_is); - COB_UNUSED (fattr); -} - -void -cob_field_accept (cob_field *f, cob_field *line, cob_field *column, - cob_field *fgc, cob_field *bgc, cob_field *fscroll, - cob_field *ftimeout, cob_field *prompt, - cob_field *size_is, const cob_flags_t fattr) -{ - COB_UNUSED (f); - COB_UNUSED (line); - COB_UNUSED (column); - COB_UNUSED (fgc); - COB_UNUSED (bgc); - COB_UNUSED (fscroll); - COB_UNUSED (ftimeout); - COB_UNUSED (prompt); - COB_UNUSED (size_is); - COB_UNUSED (fattr); -} - -void -cob_screen_display (cob_screen *s, cob_field *line, cob_field *column, - const int zero_line_col_allowed) -{ - COB_UNUSED (s); - COB_UNUSED (line); - COB_UNUSED (column); - COB_UNUSED (zero_line_col_allowed); -} - -void -cob_screen_accept (cob_screen *s, cob_field *line, - cob_field *column, cob_field *ftimeout, - const int zero_line_col_allowed) -{ - COB_UNUSED (s); - COB_UNUSED (line); - COB_UNUSED (column); - COB_UNUSED (ftimeout); - COB_UNUSED (zero_line_col_allowed); -} - -void -cob_screen_set_mode (const cob_u32_t smode) -{ - COB_UNUSED (smode); -} - -int -cob_sys_clear_screen (void) -{ - return 0; -} - -#endif /* WITH_EXTENDED_SCREENIO */ - -void -cob_screen_line_col (cob_field *f, const int l_or_c) -{ - init_cob_screen_if_needed (); -#ifdef WITH_EXTENDED_SCREENIO - if (!l_or_c) { - cob_set_int (f, (int)LINES); - } else { - cob_set_int (f, (int)COLS); - } -#else - if (!l_or_c) { - cob_set_int (f, 24); - } else { - cob_set_int (f, 80); - } -#endif -} - -int -cob_sys_sound_bell (void) -{ - if (COB_BEEP_VALUE == 9) { - return 0; - } -#ifdef WITH_EXTENDED_SCREENIO - if (!cobglobptr->cob_screen_initialized && - COB_BEEP_VALUE != 2) { - cob_screen_init (); - } - cob_beep (); -#else - cob_speaker_beep (); -#endif - return 0; -} - -void -cob_accept_escape_key (cob_field *f) -{ - cob_set_int (f, COB_ACCEPT_STATUS); -} - -/* get CurSoR position on screen */ -int -cob_sys_get_csr_pos (unsigned char *fld) -{ -#ifdef WITH_EXTENDED_SCREENIO - int cline; - int ccol; -#endif - - COB_CHK_PARMS (CBL_GET_CSR_POS, 1); - init_cob_screen_if_needed (); - -#ifdef WITH_EXTENDED_SCREENIO - getyx (stdscr, cline, ccol); - fld[0] = (unsigned char)cline; - fld[1] = (unsigned char)ccol; - -#else - fld[0] = 1U; - fld[1] = 1U; -#endif - return 0; -} - -/* COBOL: get a char (or x'00' for function keys) - call a second time when getting x'00' leads to the function keys - 1001-1199 as x'01' - x'C7', 2001 - 2055 as x'C9' - x'FF' - No implementation of MF function tables so far. -*/ -int -cob_sys_get_char (unsigned char *fld) -{ -#ifdef WITH_EXTENDED_SCREENIO - int ret; -#endif - - COB_CHK_PARMS (CBL_READ_KBD_CHAR, 1); - /* note: screen init done in called cob_get_char */ - -#ifdef WITH_EXTENDED_SCREENIO - if (!got_sys_char) { - ret = cob_get_char (); - if (ret > 255) { - *fld = 0; - got_sys_char = 1; - } else { - *fld = (unsigned char) ret; - } - } else { - got_sys_char = 0; - if (COB_ACCEPT_STATUS == 0) { - return cob_sys_get_char (fld); - } else if (COB_ACCEPT_STATUS > 1000 && COB_ACCEPT_STATUS < 1201) { - *fld = (unsigned char) (COB_ACCEPT_STATUS - 1000); - } else if (COB_ACCEPT_STATUS > 2000 && COB_ACCEPT_STATUS < 2056) { - *fld = (unsigned char) (COB_ACCEPT_STATUS - 1800); - } else { - return -1; - } - } -#else - COB_UNUSED (fld); -#endif - return 0; -} - -/* set CurSoR position on screen */ -int -cob_sys_set_csr_pos (unsigned char *fld) -{ -#ifdef WITH_EXTENDED_SCREENIO - int cline; - int ccol; -#endif - - COB_CHK_PARMS (CBL_SET_CSR_POS, 1); - init_cob_screen_if_needed (); - -#ifdef WITH_EXTENDED_SCREENIO - cline = fld[0]; - ccol= fld[1]; - return move (cline, ccol); -#else - COB_UNUSED (fld); - return 0; -#endif -} - -/* get current screen size */ -int -cob_sys_get_scr_size (unsigned char *line, unsigned char *col) -{ - COB_CHK_PARMS (CBL_GET_SCR_SIZE, 2); - init_cob_screen_if_needed (); - -#ifdef WITH_EXTENDED_SCREENIO - *line = (unsigned char)LINES; - *col = (unsigned char)COLS; -#else - *line = 24U; - *col = 80U; -#endif - return 0; -} - -int -cob_get_scr_cols (void) -{ - init_cob_screen_if_needed(); -#ifdef WITH_EXTENDED_SCREENIO - return (int)COLS; -#else - return 80; -#endif -} - -int -cob_get_scr_lines (void) -{ - init_cob_screen_if_needed(); -#ifdef WITH_EXTENDED_SCREENIO - return (int)LINES; -#else - return 24; -#endif -} - -/* check and handle adjustments to settings concerning screenio */ -void -cob_settings_screenio (void) -{ -#ifdef WITH_EXTENDED_SCREENIO - if (!cobglobptr || !cobglobptr->cob_screen_initialized) { - return; - } - - /* Extended ACCEPT status returns */ - if (cobsetptr->cob_extended_status == 0) { - cobsetptr->cob_use_esc = 0; - } - - if (curr_setting_insert_mode != COB_INSERT_MODE) { - /* Depending on insert mode set vertical bar cursor (on) - or square cursor (off) - note: the cursor change may has no - effect in all curses implementations / terminals */ - if (COB_INSERT_MODE == 0) { - (void)curs_set (2); /* set square cursor */ - } else { - (void)curs_set (1); /* set vertical bar cursor */ - } - curr_setting_insert_mode = COB_INSERT_MODE; - } - -#ifdef HAVE_MOUSEINTERVAL - mouseinterval (COB_MOUSE_INTERVAL); -#endif -#ifdef NCURSES_MOUSE_VERSION - if ((int)curr_setting_mouse_flags != (int)COB_MOUSE_FLAGS) { - mmask_t mask_applied = cob_mask_routine; - if (COB_MOUSE_FLAGS) { - /* COB_MOUSE_FLAGS & 1 --> auto-handling active - note: currently missing in the accept handling: - click+drag within a field to mark it (should be - done in general when the SHIFT key + cursor is - used) [shown by reverse-video those positions] - and by delete remove the marked characters, - by typing removing them before adding the new ones - remove marker when positioning key is used or - mouse click into any field occurs */ - if (COB_MOUSE_FLAGS & 1) { - mask_applied |= BUTTON1_PRESSED - /* note: not done by ACUCOBOL (ENTER translation): */ - | BUTTON1_DOUBLE_CLICKED - ; - } - if (COB_MOUSE_FLAGS & 2) { - cob_mask_accept |= BUTTON1_PRESSED; - } - if (COB_MOUSE_FLAGS & 4) { - cob_mask_accept |= BUTTON1_RELEASED; - } - if (COB_MOUSE_FLAGS & 8) { - cob_mask_accept |= BUTTON1_DOUBLE_CLICKED; - } - if (COB_MOUSE_FLAGS & 16) { - cob_mask_accept |= BUTTON2_PRESSED; - } - if (COB_MOUSE_FLAGS & 32) { - cob_mask_accept |= BUTTON2_RELEASED; - } - if (COB_MOUSE_FLAGS & 64) { - cob_mask_accept |= BUTTON2_DOUBLE_CLICKED; - } - if (COB_MOUSE_FLAGS & 128) { - cob_mask_accept |= BUTTON3_PRESSED; - } - if (COB_MOUSE_FLAGS & 256) { - cob_mask_accept |= BUTTON3_RELEASED; - } - if (COB_MOUSE_FLAGS & 512) { - cob_mask_accept |= BUTTON3_DOUBLE_CLICKED; - } - if (COB_MOUSE_FLAGS & 1024) { - cob_mask_accept |= REPORT_MOUSE_POSITION; - } - /* 2048 cursor shape, seems irrelevant - 16384 all windows, - only relevant when adding multiple windows */ - mask_applied |= cob_mask_accept; - } - mousemask (mask_applied, NULL); - curr_setting_mouse_flags = COB_MOUSE_FLAGS; - } -#endif -#endif -} - - -void -cob_init_screenio (cob_global *lptr, cob_settings *sptr) -{ - cobglobptr = lptr; - cobsetptr = sptr; - if (!cobsetptr->cob_exit_msg || !cobsetptr->cob_exit_msg[0]) { - cobsetptr->cob_exit_msg = cob_strdup (_("end of program, please press a key to exit")); - } - - cob_settings_screenio (); -} diff -Nru gnucobol-4.0~early~20200606/libcob/strings.c gnucobol-5/libcob/strings.c --- gnucobol-4.0~early~20200606/libcob/strings.c 2020-06-06 20:52:01.000000000 +0000 +++ gnucobol-5/libcob/strings.c 1970-01-01 00:00:00.000000000 +0000 @@ -1,661 +0,0 @@ -/* - Copyright (C) 2002-2014, 2016-2019 Free Software Foundation, Inc. - Written by Keisuke Nishida, Roger While, Edward Hart, Simon Sobisch - - This file is part of GnuCOBOL. - - The GnuCOBOL runtime library is free software: you can redistribute it - and/or modify it under the terms of the GNU Lesser General Public License - as published by the Free Software Foundation, either version 3 of the - License, or (at your option) any later version. - - GnuCOBOL is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU Lesser General Public License for more details. - - You should have received a copy of the GNU Lesser General Public License - along with GnuCOBOL. If not, see . -*/ - - -#include - -#include -#include -#include -#include -#include -#include -#include - -/* Force symbol exports */ -#define COB_LIB_EXPIMP -#include "libcob.h" -#include "coblocal.h" - -#define INSPECT_ALL 0 -#define INSPECT_LEADING 1 -#define INSPECT_FIRST 2 -#define INSPECT_TRAILING 3 - -#define DLM_DEFAULT_NUM 8U - -struct dlm_struct { - cob_field uns_dlm; - cob_u32_t uns_all; -}; - -/* Local variables */ - -static cob_global *cobglobptr = NULL; - -static const cob_field_attr const_alpha_attr = - {COB_TYPE_ALPHANUMERIC, 0, 0, 0, NULL}; -static const cob_field_attr const_strall_attr = - {COB_TYPE_ALPHANUMERIC_ALL, 0, 0, 0, NULL}; - -static cob_field *inspect_var; -static unsigned char *inspect_data; -static unsigned char *inspect_start; -static unsigned char *inspect_end; -static signed int *inspect_mark; /* note: we use signed int here instead of char - as we currently set / check -1 as an - alternative to the actual unsigned char *data */ -static size_t inspect_mark_size; -static size_t inspect_size; -static cob_u32_t inspect_replacing; -static int inspect_sign; -static cob_field inspect_var_copy; - -static cob_field *string_dst; -static cob_field *string_ptr; -static cob_field *string_dlm; -static cob_field string_dst_copy; -static cob_field string_ptr_copy; -static cob_field string_dlm_copy; -static int string_offset; - -static struct dlm_struct *dlm_list; -static cob_field *unstring_src; -static cob_field *unstring_ptr; -static size_t dlm_list_size; -static cob_field unstring_src_copy; -static cob_field unstring_ptr_copy; -static int unstring_offset; -static int unstring_count; -static int unstring_ndlms; - -static unsigned char *figurative_ptr; -static size_t figurative_size; - -static cob_field alpha_fld; -static cob_field str_cob_low; - -/* Local functions */ - -static void -cob_str_memcpy (cob_field *dst, unsigned char *src, const int size) -{ - cob_field temp; - - temp.size = size; - temp.data = src; - temp.attr = &const_alpha_attr; - cob_move (&temp, dst); -} - -static void -alloc_figurative (const cob_field *f1, const cob_field *f2) -{ - - unsigned char *s; - size_t size1; - size_t size2; - size_t n; - - size2 = f2->size; - if (size2 > figurative_size) { - if (figurative_ptr) { - cob_free (figurative_ptr); - } - figurative_ptr = cob_malloc (size2); - figurative_size = size2; - } - size1 = 0; - s = figurative_ptr; - for (n = 0; n < size2; ++n, ++s) { - *s = f1->data[size1]; - size1++; - if (size1 >= f1->size) { - size1 = 0; - } - } - alpha_fld.size = size2; - alpha_fld.data = figurative_ptr; -} - -static void -inspect_common (cob_field *f1, cob_field *f2, const int type) -{ - int *mark; - size_t n = 0; - size_t j; - int i; - int len; - - if (unlikely (!f1)) { - f1 = &str_cob_low; - } - if (unlikely (!f2)) { - f2 = &str_cob_low; - } - - if (inspect_replacing && f1->size != f2->size) { - if (COB_FIELD_TYPE (f1) == COB_TYPE_ALPHANUMERIC_ALL) { - alloc_figurative (f1, f2); - f1 = &alpha_fld; - } else { - cob_set_exception (COB_EC_RANGE_INSPECT_SIZE); - return; - } - } - - mark = &inspect_mark[inspect_start - inspect_data]; - len = (int)(inspect_end - inspect_start); - if (type == INSPECT_TRAILING) { - for (i = len - (int)f2->size; i >= 0; --i) { - /* Find matching substring */ - if (memcmp (inspect_start + i, f2->data, f2->size) == 0) { - /* Check if it is already marked */ - for (j = 0; j < f2->size; ++j) { - if (mark[i + j] != -1) { - break; - } - } - /* If not, mark and count it */ - if (j == f2->size) { - for (j = 0; j < f2->size; ++j) { - mark[i + j] = inspect_replacing ? f1->data[j] : 1; - } - i -= f2->size - 1; - n++; - } - } else { - break; - } - } - } else { - for (i = 0; i < (int)(len - f2->size + 1); ++i) { - /* Find matching substring */ - if (memcmp (inspect_start + i, f2->data, f2->size) == 0) { - /* Check if it is already marked */ - for (j = 0; j < f2->size; ++j) { - if (mark[i + j] != -1) { - break; - } - } - /* If not, mark and count it */ - if (j == f2->size) { - for (j = 0; j < f2->size; ++j) { - mark[i + j] = inspect_replacing ? f1->data[j] : 1; - } - i += f2->size - 1; - n++; - if (type == INSPECT_FIRST) { - break; - } - } - } else if (type == INSPECT_LEADING) { - break; - } - } - } - - if (n > 0 && !inspect_replacing) { - cob_add_int (f1, (int) n, 0); - } -} - -/* Global functions */ - -/* INSPECT */ - -void -cob_inspect_init (cob_field *var, const cob_u32_t replacing) -{ - size_t i; - size_t digcount; - - if (unlikely (COB_FIELD_IS_NUMDISP (var))) { - inspect_var_copy = *var; - inspect_var = &inspect_var_copy; - inspect_sign = COB_GET_SIGN (var); - } else { - inspect_var = NULL; - } - inspect_size = COB_FIELD_SIZE (var); - inspect_data = COB_FIELD_DATA (var); - inspect_replacing = replacing; - inspect_start = NULL; - inspect_end = NULL; - digcount = inspect_size * sizeof (int); - if (digcount > inspect_mark_size) { - if (inspect_mark) { - cob_free (inspect_mark); - } - inspect_mark = cob_fast_malloc (digcount); - inspect_mark_size = digcount; - } - for (i = 0; i < inspect_size; ++i) { - inspect_mark[i] = -1; - } - cobglobptr->cob_exception_code = 0; -} - -void -cob_inspect_start (void) -{ - inspect_start = inspect_data; - inspect_end = inspect_data + inspect_size; -} - -void -cob_inspect_before (const cob_field *str) -{ - unsigned char *p; - - for (p = inspect_start; p < inspect_end - str->size + 1; ++p) { - if (memcmp (p, str->data, str->size) == 0) { - inspect_end = p; - return; - } - } -} - -void -cob_inspect_after (const cob_field *str) -{ - unsigned char *p; - - for (p = inspect_start; p < inspect_end - str->size + 1; ++p) { - if (memcmp (p, str->data, str->size) == 0) { - inspect_start = p + str->size; - return; - } - } - inspect_start = inspect_end; -} - -void -cob_inspect_characters (cob_field *f1) -{ - int *mark; - int i; - int n; - int len; - - mark = &inspect_mark[inspect_start - inspect_data]; - len = (int)(inspect_end - inspect_start); - if (inspect_replacing) { - /* INSPECT REPLACING CHARACTERS f1 */ - for (i = 0; i < len; ++i) { - if (mark[i] == -1) { - mark[i] = f1->data[0]; - } - } - } else { - /* INSPECT TALLYING f1 CHARACTERS */ - n = 0; - for (i = 0; i < len; ++i) { - if (mark[i] == -1) { - mark[i] = 1; - n++; - } - } - if (n > 0) { - cob_add_int (f1, n, 0); - } - } -} - -void -cob_inspect_all (cob_field *f1, cob_field *f2) -{ - inspect_common (f1, f2, INSPECT_ALL); -} - -void -cob_inspect_leading (cob_field *f1, cob_field *f2) -{ - inspect_common (f1, f2, INSPECT_LEADING); -} - -void -cob_inspect_first (cob_field *f1, cob_field *f2) -{ - inspect_common (f1, f2, INSPECT_FIRST); -} - -void -cob_inspect_trailing (cob_field *f1, cob_field *f2) -{ - inspect_common (f1, f2, INSPECT_TRAILING); -} - -void -cob_inspect_converting (const cob_field *f1, const cob_field *f2) -{ - size_t i; - size_t j; - size_t len; - - if (unlikely (!f1)) { - f1 = &str_cob_low; - } - if (unlikely (!f2)) { - f2 = &str_cob_low; - } - if (f1->size != f2->size) { - if (COB_FIELD_TYPE (f2) == COB_TYPE_ALPHANUMERIC_ALL) { - alloc_figurative (f2, f1); - f2 = &alpha_fld; - } else { - cob_set_exception (COB_EC_RANGE_INSPECT_SIZE); - return; - } - } - - len = (size_t)(inspect_end - inspect_start); - for (j = 0; j < f1->size; ++j) { - for (i = 0; i < len; ++i) { - if (inspect_mark[i] == -1 && - inspect_start[i] == f1->data[j]) { - inspect_start[i] = f2->data[j]; - inspect_mark[i] = 1; - } - } - } -} - -void -cob_inspect_finish (void) -{ - size_t i; - - if (inspect_replacing) { - for (i = 0; i < inspect_size; ++i) { - if (inspect_mark[i] != -1) { - inspect_data[i] = (unsigned char)inspect_mark[i]; - } - } - } - - if (unlikely (inspect_var)) { - COB_PUT_SIGN (inspect_var, inspect_sign); - } -} - -/* STRING */ - -void -cob_string_init (cob_field *dst, cob_field *ptr) -{ - string_dst_copy = *dst; - string_dst = &string_dst_copy; - string_ptr = NULL; - if (ptr) { - string_ptr_copy = *ptr; - string_ptr = &string_ptr_copy; - } - string_offset = 0; - cobglobptr->cob_exception_code = 0; - - if (string_ptr) { - string_offset = cob_get_int (string_ptr) - 1; - if (string_offset < 0 || - string_offset >= (int)string_dst->size) { - cob_set_exception (COB_EC_OVERFLOW_STRING); - } - } -} - -void -cob_string_delimited (cob_field *dlm) -{ - string_dlm = NULL; - if (dlm) { - string_dlm_copy = *dlm; - string_dlm = &string_dlm_copy; - } -} - -void -cob_string_append (cob_field *src) -{ - size_t src_size; - int i; - int size; - - if (cobglobptr->cob_exception_code) { - return; - } - - src_size = src->size; - if (!src_size) { - return; - } - if (string_dlm) { - size = (int)(src_size - string_dlm->size + 1); - for (i = 0; i < size; ++i) { - if (memcmp (src->data + i, string_dlm->data, - string_dlm->size) == 0) { - src_size = i; - break; - } - } - } - - if (src_size <= string_dst->size - string_offset) { - memcpy (string_dst->data + string_offset, src->data, src_size); - string_offset += (int) src_size; - } else { - size = (int)(string_dst->size - string_offset); - memcpy (string_dst->data + string_offset, src->data, (size_t)size); - string_offset += size; - cob_set_exception (COB_EC_OVERFLOW_STRING); - } -} - -void -cob_string_finish (void) -{ - if (string_ptr) { - cob_set_int (string_ptr, string_offset + 1); - } -} - -/* UNSTRING */ - -void -cob_unstring_init (cob_field *src, cob_field *ptr, const size_t num_dlm) -{ - unstring_src_copy = *src; - unstring_src = &unstring_src_copy; - unstring_ptr = NULL; - if (ptr) { - unstring_ptr_copy = *ptr; - unstring_ptr = &unstring_ptr_copy; - } - - unstring_offset = 0; - unstring_count = 0; - unstring_ndlms = 0; - cobglobptr->cob_exception_code = 0; - if (num_dlm > dlm_list_size) { - cob_free (dlm_list); - dlm_list = cob_malloc (num_dlm * sizeof(struct dlm_struct)); - dlm_list_size = num_dlm; - } - - if (unstring_ptr) { - unstring_offset = cob_get_int (unstring_ptr) - 1; - if (unstring_offset < 0 || unstring_offset >= (int)unstring_src->size) { - cob_set_exception (COB_EC_OVERFLOW_UNSTRING); - } - } -} - -void -cob_unstring_delimited (cob_field *dlm, const cob_u32_t all) -{ - dlm_list[unstring_ndlms].uns_dlm = *dlm; - dlm_list[unstring_ndlms].uns_all = all; - unstring_ndlms++; -} - -void -cob_unstring_into (cob_field *dst, cob_field *dlm, cob_field *cnt) -{ - unsigned char *p; - unsigned char *dp; - unsigned char *s; - unsigned char *dlm_data; - unsigned char *start; - size_t dlm_size = 0; - int i; - int srsize; - int dlsize; - int match_size = 0; - int brkpt = 0; - - if (cobglobptr->cob_exception_code) { - return; - } - - if (unstring_offset >= (int)unstring_src->size) { - return; - } - - start = unstring_src->data + unstring_offset; - dlm_data = NULL; - if (unstring_ndlms == 0) { - match_size = cob_min_int ((int)COB_FIELD_SIZE (dst), - (int)unstring_src->size - unstring_offset); - cob_str_memcpy (dst, start, match_size); - unstring_offset += match_size; - } else { - srsize = (int) unstring_src->size; - s = unstring_src->data + srsize; - for (p = start; p < s; ++p) { - for (i = 0; i < unstring_ndlms; ++i) { - dlsize = (int) dlm_list[i].uns_dlm.size; - dp = dlm_list[i].uns_dlm.data; - if (p + dlsize > s) { - continue; - } - if (!memcmp (p, dp, (size_t)dlsize)) { /* delimiter equal */ - match_size = (int)(p - start); /* count in */ - cob_str_memcpy (dst, start, match_size); /* into */ - unstring_offset += match_size + dlsize; /* with pointer */ - dlm_data = dp; - dlm_size = dlsize; - if (dlm_list[i].uns_all) { /* delimited by all */ - for (p += dlsize ; p < s; p += dlsize) { - if (p + dlsize > s) { - break; - } - if (memcmp (p, dp, (size_t)dlsize)) { - break; - } - unstring_offset += dlsize; - } - } - brkpt = 1; - break; - } - } - if (brkpt) { - break; - } - } - if (!brkpt) { - /* No match */ - match_size = (int)(unstring_src->size - unstring_offset); - cob_str_memcpy (dst, start, match_size); - unstring_offset = (int) unstring_src->size; - dlm_data = NULL; - } - } - unstring_count++; - - if (dlm) { - if (dlm_data) { - cob_str_memcpy (dlm, dlm_data, (int) dlm_size); - } else if (COB_FIELD_IS_NUMERIC (dlm)) { - cob_set_int (dlm, 0); - } else { - memset (dlm->data, ' ', dlm->size); - } - } - - if (cnt) { - cob_set_int (cnt, match_size); - } -} - -void -cob_unstring_tallying (cob_field *f) -{ - cob_add_int (f, unstring_count, 0); -} - -void -cob_unstring_finish (void) -{ - if (unstring_offset < (int)unstring_src->size) { - cob_set_exception (COB_EC_OVERFLOW_UNSTRING); - } - - if (unstring_ptr) { - cob_set_int (unstring_ptr, unstring_offset + 1); - } -} - -/* Initialization/Termination */ - -void -cob_exit_strings (void) -{ - if (inspect_mark) { - cob_free (inspect_mark); - inspect_mark = NULL; - } - if (dlm_list) { - cob_free (dlm_list); - dlm_list = NULL; - } - if (figurative_ptr) { - cob_free (figurative_ptr); - figurative_ptr = NULL; - } - figurative_size = 0; -} - -void -cob_init_strings (cob_global *lptr) -{ - cobglobptr = lptr; - inspect_mark = cob_malloc ((size_t)COB_NORMAL_BUFF); - dlm_list = cob_malloc (DLM_DEFAULT_NUM * sizeof(struct dlm_struct)); - inspect_mark_size = COB_NORMAL_BUFF; - dlm_list_size = DLM_DEFAULT_NUM; - figurative_ptr = NULL; - figurative_size = 0; - alpha_fld.size = 0; - alpha_fld.data = NULL; - alpha_fld.attr = &const_alpha_attr; - str_cob_low.size = 1; - str_cob_low.data = (cob_u8_ptr)"\0"; - str_cob_low.attr = &const_strall_attr; -} diff -Nru gnucobol-4.0~early~20200606/libcob/sysdefines.h gnucobol-5/libcob/sysdefines.h --- gnucobol-4.0~early~20200606/libcob/sysdefines.h 2020-06-06 20:52:01.000000000 +0000 +++ gnucobol-5/libcob/sysdefines.h 1970-01-01 00:00:00.000000000 +0000 @@ -1,306 +0,0 @@ -/* - Copyright (C) 2002-2012, 2014-2020 Free Software Foundation, Inc. - Written by Keisuke Nishida, Roger While, Simon Sobisch, Ron Norman, - Edward Hart - - This file is part of GnuCOBOL. - - The GnuCOBOL runtime library is free software: you can redistribute it - and/or modify it under the terms of the GNU Lesser General Public License - as published by the Free Software Foundation, either version 3 of the - License, or (at your option) any later version. - - GnuCOBOL is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU Lesser General Public License for more details. - - You should have received a copy of the GNU Lesser General Public License - along with GnuCOBOL. If not, see . -*/ - -#ifndef COB_SYSDEFINE_H -#define COB_SYSDEFINE_H - -/* -* This header is the place to test for the platform -* and/or C compiler then set required #define values -*/ - -/* Stringify macros */ -#define CB_STRINGIFY(s) #s -#define CB_XSTRINGIFY(s) CB_STRINGIFY(s) -#define CB_XRANGE(min,max) CB_XSTRINGIFY(min) ".." CB_XSTRINGIFY(max) - -/* C version info */ -#ifdef __VERSION__ -#if ! defined (_MSC_VER) -#if defined (__MINGW32__) -#define GC_C_VERSION_PRF "(MinGW) " -#elif defined (__DJGPP__) -#define GC_C_VERSION_PRF "(DJGPP) " -#elif defined (__ORANGEC__) -#define GC_C_VERSION_PRF "(OrangeC) " -#else -#define GC_C_VERSION_PRF "" -#endif -#elif defined (__c2__) -#define GC_C_VERSION_PRF "(Microsoft C2) " -#elif defined (__llvm__) -#define GC_C_VERSION_PRF "(LLVM / MSC) " -#else -#define GC_C_VERSION_PRF "(Microsoft) " -#endif -#define GC_C_VERSION CB_XSTRINGIFY(__VERSION__) - -#elif defined(__xlc__) -#define GC_C_VERSION_PRF "(IBM XL C/C++) " -#define GC_C_VERSION CB_XSTRINGIFY(__xlc__) - -#elif defined(__SUNPRO_C) -#define GC_C_VERSION_PRF "(Sun C) " -#define GC_C_VERSION CB_XSTRINGIFY(__SUNPRO_C) - -#elif defined(_MSC_VER) -#define GC_C_VERSION_PRF "(Microsoft) " -#define GC_C_VERSION CB_XSTRINGIFY(_MSC_VER) - -#elif defined(__BORLANDC__) -#define GC_C_VERSION_PRF "(Borland) " -#define GC_C_VERSION CB_XSTRINGIFY(__BORLANDC__) - -#elif defined(__WATCOMC__) -#define GC_C_VERSION_PRF "(Watcom) " -#define GC_C_VERSION CB_XSTRINGIFY(__WATCOMC__) - -#elif defined(__INTEL_COMPILER) -#define GC_C_VERSION_PRF "(Intel) " -#define GC_C_VERSION CB_XSTRINGIFY(__INTEL_COMPILER) - -#elif defined(__TINYC__) -#define GC_C_VERSION_PRF "(Tiny C) " -#define GC_C_VERSION CB_XSTRINGIFY(__TINYC__) - -#elif defined(__HP_cc) -#define GC_C_VERSION_PRF "(HP aC++/ANSI C) " -#define GC_C_VERSION CB_XSTRINGIFY(__HP_cc) - -#elif defined(__hpux) || defined(_HPUX_SOURCE) -#if defined(__ia64) -#define GC_C_VERSION_PRF "(HPUX IA64) " -#else -#define GC_C_VERSION_PRF "(HPUX PA-RISC) " -#endif -#define GC_C_VERSION " C" - -#else -#define GC_C_VERSION_PRF "" -#define GC_C_VERSION _("unknown") -#endif - - -/* C compiler optimization flags */ -#ifdef _MSC_VER -#define CB_COPT_0 " /Od" -#define CB_COPT_1 " /O1" -#define CB_COPT_2 " /O2" -#define CB_COPT_3 " /Ox" -#define CB_COPT_S " /Os" - -#elif defined(__BORLANDC__) -#define CB_COPT_0 " -O" -#define CB_COPT_1 " -O" /* optimize jumps only*/ -#define CB_COPT_2 " -O2" /* optimize for speed */ -#define CB_COPT_3 " -O2" /* CHECKME: is -O03 available? */ -#define CB_COPT_S " -O1" /* optimize for size */ - -#elif defined(__hpux) && !defined(__GNUC__) -#define CB_COPT_0 " +O0" -#define CB_COPT_1 " +O1" -#define CB_COPT_2 " +O2" -#define CB_COPT_3 " +O3" -#define CB_COPT_S " +Osize" /* CHECKME: may not available on old versions */ - -#elif defined(__WATCOMC__) -#define CB_COPT_0 " -od" -#define CB_COPT_1 " -ot" -#define CB_COPT_2 " -ox" -#define CB_COPT_3 " -ox -oh" -#define CB_COPT_S " -os" - -#elif defined(__ORANGEC__) -#define CB_COPT_0 " -O-" -#define CB_COPT_1 "" -#define CB_COPT_2 "" -#define CB_COPT_3 "" -#define CB_COPT_S "" - -#elif defined(__SUNPRO_C) -#define CB_COPT_0 " -xO1" /* CHECKME: is -xO0 available? */ -#define CB_COPT_1 " -xO1" -#define CB_COPT_2 " -xO2" -#define CB_COPT_3 " -xO2" /* CHECKME: Oracle docs are confusing, is -xO3 working? */ -#define CB_COPT_S " -xO1 -xspace" - -#elif defined(__xlc__) -#define CB_COPT_0 " -O0" -#define CB_COPT_1 " -O" -#define CB_COPT_2 " -O2" -#define CB_COPT_3 " -O3" -#define CB_COPT_S " -O" - -#else -#define CB_COPT_0 " -O0" -#define CB_COPT_1 " -O" -#define CB_COPT_2 " -O2" -#define CB_COPT_3 " -O3" -#define CB_COPT_S " -Os" -#endif - -/* Define how C compiler aligns data */ -#ifdef HAVE_ATTRIBUTE_ALIGNED -#define COB_ALIGN " __attribute__((aligned))" -#define COB_ALIGN_KNOWN - -#else - -#if defined(_WIN32) -#define COB_ALIGN_ATTR_8 "" -#define COB_ALIGN_DECL_8 "__declspec(align(8)) " -#define COB_ALIGN_KNOWN - -#elif defined(__arm__) -#define COB_ALIGN_ATTR_8 " __align(8)" -#define COB_ALIGN_DECL_8 "" -#define COB_ALIGN_KNOWN - -#elif defined(__SUNPRO_C) -/* Insert #pragma align 8 (varname) */ -#define COB_ALIGN_PRAGMA_8 -#define COB_ALIGN_ATTR_8 "" -#define COB_ALIGN_DECL_8 "" -#define COB_ALIGN_KNOWN - -#else -#define COB_ALIGN_ATTR_8 "" -#define COB_ALIGN_DECL_8 "" -#endif - -#endif - -#if defined (COB_NON_ALIGNED) - /* allow explicit check of generated code - * and to skip this part in checks of undefined behavior */ - /* Some DEC Alphas can only load shorts at 4-byte aligned addresses */ - #ifdef __alpha - #define COB_SHORT_BORK - #endif - #define COB_NO_UNALIGNED_ATTRIBUTE - -#elif !defined(__i386__) && !defined(__x86_64__) && !defined(__powerpc__) && !defined(__powerpc64__) && !defined(__ppc__) && !defined(__amd64__) && !defined(__s390__) - #define COB_NON_ALIGNED - /* Some DEC Alphas can only load shorts at 4-byte aligned addresses */ - #ifdef __alpha - #define COB_SHORT_BORK - #endif - #if defined(_MSC_VER) - #define COB_ALLOW_UNALIGNED - #define COB_NO_UNALIGNED_ATTRIBUTE - #endif -#else - #if defined(__i386__) || defined(__x86_64__) || defined(__powerpc__) - #define COB_ALLOW_UNALIGNED - #elif !defined(__hpux) && !defined(_HPUX_SOURCE) && !defined(__SUNPRO_C) && !defined(__s390__) - #define COB_ALLOW_UNALIGNED - #endif - #if !defined(__powerpc__) - #define COB_NO_UNALIGNED_ATTRIBUTE - #endif -#endif - -/* Max size of a single 'static char' allowed by C compiler */ -#if defined(__GNUC__) -#define COB_MAX_CHAR_SIZE 2000000000 -#else -#define COB_MAX_CHAR_SIZE 2000000 -#endif -/* Define filename & path charcteristics */ -#if defined(_MSC_VER) || defined(__ORANGEC__) || defined(__WATCOMC__) || \ - defined(__BORLANDC__) || defined(__MINGW32__) || defined (__DJGPP__) -#define PATHSEP_CHAR (char) ';' -#define PATHSEP_STR (char *) ";" -#else -#define PATHSEP_CHAR (char) ':' -#define PATHSEP_STR (char *) ":" -#endif - -#ifndef _WIN32 /* note: needs to be \ for MinGW, needed for cobc -j */ -#define SLASH_CHAR (char) '/' -#define SLASH_STR (char *) "/" -#else -#define SLASH_CHAR (char) '\\' -#define SLASH_STR (char *) "\\" -#endif - -#ifdef __DJGPP__ -#define HAVE_8DOT3_FILENAMES -#endif - -/* - * Mapping of COBOL Numeric to an SQL DATE - * (used in cobc/sqlxfdgen.c and libcob/fsqlxfd.c) - */ -struct sql_date { - unsigned char digits; /* Total number of digits */ - unsigned char hasDate; /* Some part of YYMMDD is present */ - unsigned char hasTime; /* Some part of HHMISS is present */ - char yyRule; /* Rule code for adjusting Year */ - /* '+': real year := yy + yyAdj */ - /* '%': real year := yy pivot value yyAdj */ - short yyAdj; /* Value to adjust year by */ - unsigned char ccLen; /* length of Century */ - unsigned char ccPos; /* position of Century */ - unsigned char yyLen; /* length of Year */ - unsigned char yyPos; /* position of year */ - unsigned char mmLen; /* length of Month */ - unsigned char mmPos; /* position of Month */ - unsigned char ddLen; /* length of Day */ - unsigned char ddPos; /* position of Day */ - unsigned char hhLen; /* length of Hour */ - unsigned char hhPos; /* position of Hour */ - unsigned char miLen; /* length of Minute */ - unsigned char miPos; /* position of Minute */ - unsigned char ssLen; /* length of Seconds */ - unsigned char ssPos; /* position of Seconds */ - unsigned char huLen; /* length of Hundredths of Second */ - unsigned char huPos; /* position of Hundredths of Second */ - char format[32]; /* Date format string; Used for date conversion */ -}; - -/* End compiler stuff */ - -/* EBCDIC determination */ - -#if ' ' == 0x40 -#define COB_EBCDIC_MACHINE -#elif defined(COB_EBCDIC_MACHINE) -#undef COB_EBCDIC_MACHINE -#endif - -#if defined (HAVE_NCURSESW_NCURSES_H) \ - || defined (HAVE_NCURSESW_CURSES_H) \ - || defined (HAVE_NCURSES_H) \ - || defined (HAVE_NCURSES_NCURSES_H) \ - || defined (HAVE_PDCURSES_H) \ - || defined (HAVE_CURSES_H) -#define WITH_EXTENDED_SCREENIO -#endif - -#if defined(WITH_INDEX_EXTFH) || defined(WITH_CISAM) || defined(WITH_DISAM) \ - || defined(WITH_VBISAM) || defined(WITH_DB) || defined(WITH_LMDB) \ - || defined(WITH_ODBC) || defined(WITH_OCI) -#define HAS_WITH_INDEXED -#endif - -/* End of COB_SYSDEFINE_H */ -#endif diff -Nru gnucobol-4.0~early~20200606/libcob/system.def gnucobol-5/libcob/system.def --- gnucobol-4.0~early~20200606/libcob/system.def 2020-06-06 20:52:01.000000000 +0000 +++ gnucobol-5/libcob/system.def 1970-01-01 00:00:00.000000000 +0000 @@ -1,90 +0,0 @@ -/* - Copyright (C) 2006-2012, 2014, 2016-2019 Free Software Foundation, Inc. - Written by Roger While, Simon Sobisch, Ron Norman - - This file is part of GnuCOBOL. - - The GnuCOBOL runtime library is free software: you can redistribute it - and/or modify it under the terms of the GNU Lesser General Public License - as published by the Free Software Foundation, either version 3 of the - License, or (at your option) any later version. - - GnuCOBOL is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU Lesser General Public License for more details. - - You should have received a copy of the GNU Lesser General Public License - along with GnuCOBOL. If not, see . -*/ - - -/* COB_SYSTEM_GEN (external name, number of arguments min, max, internal name) */ - -COB_SYSTEM_GEN ("SYSTEM", 1, 1, cob_sys_system) - -COB_SYSTEM_GEN ("CBL_AND", 3, 3, cob_sys_and) -COB_SYSTEM_GEN ("CBL_ALARM_SOUND", 0, 0, cob_sys_sound_bell) -COB_SYSTEM_GEN ("CBL_BELL_SOUND", 0, 0, cob_sys_sound_bell) -COB_SYSTEM_GEN ("CBL_CHANGE_DIR", 1, 1, cob_sys_change_dir) -COB_SYSTEM_GEN ("CBL_CHECK_FILE_EXIST", 2, 2, cob_sys_check_file_exist) -COB_SYSTEM_GEN ("CBL_CLOSE_FILE", 1, 1, cob_sys_close_file) -COB_SYSTEM_GEN ("CBL_COPY_FILE", 2, 2, cob_sys_copy_file) -COB_SYSTEM_GEN ("CBL_CREATE_DIR", 1, 1, cob_sys_create_dir) -COB_SYSTEM_GEN ("CBL_CREATE_FILE", 5, 5, cob_sys_create_file) -COB_SYSTEM_GEN ("CBL_DELETE_DIR", 1, 1, cob_sys_delete_dir) -COB_SYSTEM_GEN ("CBL_DELETE_FILE", 1, 1, cob_sys_delete_file) -COB_SYSTEM_GEN ("CBL_EQ", 3, 3, cob_sys_eq) -COB_SYSTEM_GEN ("CBL_ERROR_PROC", 2, 2, cob_sys_error_proc) -COB_SYSTEM_GEN ("CBL_EXIT_PROC", 2, 2, cob_sys_exit_proc) -COB_SYSTEM_GEN ("CBL_FLUSH_FILE", 1, 1, cob_sys_flush_file) -COB_SYSTEM_GEN ("CBL_GET_CSR_POS", 1, 1, cob_sys_get_csr_pos) -COB_SYSTEM_GEN ("CBL_GET_CURRENT_DIR", 3, 3, cob_sys_get_current_dir) -COB_SYSTEM_GEN ("CBL_GET_SCR_SIZE", 2, 2, cob_sys_get_scr_size) -COB_SYSTEM_GEN ("CBL_IMP", 3, 3, cob_sys_imp) -COB_SYSTEM_GEN ("CBL_NIMP", 3, 3, cob_sys_nimp) -COB_SYSTEM_GEN ("CBL_NOR", 3, 3, cob_sys_nor) -COB_SYSTEM_GEN ("CBL_NOT", 2, 2, cob_sys_not) -COB_SYSTEM_GEN ("CBL_OPEN_FILE", 5, 5, cob_sys_open_file) -COB_SYSTEM_GEN ("CBL_OR", 3, 3, cob_sys_or) -COB_SYSTEM_GEN ("CBL_READ_FILE", 5, 5, cob_sys_read_file) -COB_SYSTEM_GEN ("CBL_READ_KBD_CHAR", 1, 1, cob_sys_get_char) -COB_SYSTEM_GEN ("CBL_RENAME_FILE", 2, 2, cob_sys_rename_file) -COB_SYSTEM_GEN ("CBL_SET_CSR_POS", 1, 1, cob_sys_set_csr_pos) -COB_SYSTEM_GEN ("CBL_TOLOWER", 2, 2, cob_sys_tolower) -COB_SYSTEM_GEN ("CBL_TOUPPER", 2, 2, cob_sys_toupper) -COB_SYSTEM_GEN ("CBL_WRITE_FILE", 5, 5, cob_sys_write_file) -COB_SYSTEM_GEN ("CBL_XOR", 3, 3, cob_sys_xor) - -COB_SYSTEM_GEN ("CBL_GC_FORK", 0, 0, cob_sys_fork) -COB_SYSTEM_GEN ("CBL_GC_GETOPT", 6, 6, cob_sys_getopt_long_long) -COB_SYSTEM_GEN ("CBL_GC_HOSTED", 2, 2, cob_sys_hosted) -COB_SYSTEM_GEN ("CBL_GC_NANOSLEEP", 1, 1, cob_sys_oc_nanosleep) -COB_SYSTEM_GEN ("CBL_GC_PRINTABLE", 1, 2, cob_sys_printable) -COB_SYSTEM_GEN ("CBL_GC_WAITPID", 1, 1, cob_sys_waitpid) -COB_SYSTEM_GEN ("CBL_OC_GETOPT", 6, 6, cob_sys_getopt_long_long) -COB_SYSTEM_GEN ("CBL_OC_HOSTED", 2, 2, cob_sys_hosted) -COB_SYSTEM_GEN ("CBL_OC_NANOSLEEP", 1, 1, cob_sys_oc_nanosleep) - -COB_SYSTEM_GEN ("C$CALLEDBY", 1, 1, cob_sys_calledby) -COB_SYSTEM_GEN ("C$CHDIR", 2, 2, cob_sys_chdir) -COB_SYSTEM_GEN ("C$COPY", 3, 3, cob_sys_copyfile) -COB_SYSTEM_GEN ("C$DELETE", 2, 2, cob_sys_file_delete) -COB_SYSTEM_GEN ("C$FILEINFO", 2, 2, cob_sys_file_info) -COB_SYSTEM_GEN ("C$GETPID", 0, 0, cob_sys_getpid) -COB_SYSTEM_GEN ("C$JUSTIFY", 1, 2, cob_sys_justify) -COB_SYSTEM_GEN ("C$MAKEDIR", 1, 1, cob_sys_mkdir) -COB_SYSTEM_GEN ("C$NARG", 1, 1, cob_sys_return_args) -COB_SYSTEM_GEN ("C$PARAMSIZE", 1, 1, cob_sys_parameter_size) -COB_SYSTEM_GEN ("C$PRINTABLE", 1, 2, cob_sys_printable) /* OC extension !!! */ -COB_SYSTEM_GEN ("C$SLEEP", 1, 1, cob_sys_sleep) -COB_SYSTEM_GEN ("C$TOLOWER", 2, 2, cob_sys_tolower) -COB_SYSTEM_GEN ("C$TOUPPER", 2, 2, cob_sys_toupper) - -COB_SYSTEM_GEN ("EXTFH", 2, 2, cob_sys_extfh) - -COB_SYSTEM_GEN ("\x91", 3, 3, cob_sys_x91) -COB_SYSTEM_GEN ("\xE4", 0, 0, cob_sys_clear_screen) -COB_SYSTEM_GEN ("\xE5", 0, 0, cob_sys_sound_bell) -COB_SYSTEM_GEN ("\xF4", 2, 2, cob_sys_xf4) -COB_SYSTEM_GEN ("\xF5", 2, 2, cob_sys_xf5) diff -Nru gnucobol-4.0~early~20200606/libcob/termio.c gnucobol-5/libcob/termio.c --- gnucobol-4.0~early~20200606/libcob/termio.c 2020-06-06 20:52:01.000000000 +0000 +++ gnucobol-5/libcob/termio.c 1970-01-01 00:00:00.000000000 +0000 @@ -1,750 +0,0 @@ -/* - Copyright (C) 2001-2012, 2014-2019 Free Software Foundation, Inc. - Written by Keisuke Nishida, Roger While, Simon Sobisch, Edward Hart - - This file is part of GnuCOBOL. - - The GnuCOBOL runtime library is free software: you can redistribute it - and/or modify it under the terms of the GNU Lesser General Public License - as published by the Free Software Foundation, either version 3 of the - License, or (at your option) any later version. - - GnuCOBOL is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU Lesser General Public License for more details. - - You should have received a copy of the GNU Lesser General Public License - along with GnuCOBOL. If not, see . -*/ - - -#include - -#include -#include -#include -#include -#include -#include -#include -#ifdef HAVE_UNISTD_H -#include -#endif -#include - -/* Force symbol exports */ -#define COB_LIB_EXPIMP -#include "libcob.h" -#include "coblocal.h" - -/* Local variables */ - -static cob_global *cobglobptr = NULL; -static cob_settings *cobsetptr = NULL; - -static char no_syspunch_error_raised = 0; - -static const unsigned short bin_digits[] = - { 1, 3, 5, 8, 10, 13, 15, 17, 20 }; - -static const cob_field_attr const_alpha_attr = - {COB_TYPE_ALPHANUMERIC, 0, 0, 0, NULL}; - -/* DISPLAY */ - -static void -display_numeric (cob_field *f, FILE *fp) -{ - int i; - unsigned short digits; - signed short scale; - int size; - cob_field_attr attr; - cob_field temp; - - digits = COB_FIELD_DIGITS (f); - scale = COB_FIELD_SCALE (f); - size = digits + (COB_FIELD_HAVE_SIGN (f) ? 1 : 0); - if (size >= COB_MEDIUM_MAX) { - fputs (_("(Not representable)"), fp); - return; - } - COB_ATTR_INIT (COB_TYPE_NUMERIC_DISPLAY, digits, scale, 0, NULL); - temp.size = size; - temp.data = COB_TERM_BUFF; - temp.attr = &attr; - if (COB_FIELD_HAVE_SIGN (f)) { - attr.flags = COB_FLAG_HAVE_SIGN | COB_FLAG_SIGN_SEPARATE; - if (COB_FIELD_SIGN_LEADING (f) || - COB_FIELD_TYPE (f) != COB_TYPE_NUMERIC_DISPLAY) { - attr.flags |= COB_FLAG_SIGN_LEADING; - } - } - - cob_move (f, &temp); - for (i = 0; i < size; ++i) { - putc (temp.data[i], fp); - } -} - -static void -pretty_display_numeric (cob_field *f, FILE *fp) -{ - cob_pic_symbol *p; - unsigned char *q = COB_TERM_BUFF; - int i; - unsigned short digits = COB_FIELD_DIGITS (f); - signed short scale = COB_FIELD_SCALE (f); - int size = digits + !!COB_FIELD_HAVE_SIGN (f) + !!scale; - cob_field_attr attr; - cob_field temp; - cob_pic_symbol pic[6] = {{ '\0' }}; - - - if (size > COB_MEDIUM_MAX) { - fputs (_("(Not representable)"), fp); - return; - } - temp.size = size; - temp.data = q; - temp.attr = &attr; - COB_ATTR_INIT (COB_TYPE_NUMERIC_EDITED, digits, scale, 0, - (const cob_pic_symbol *)pic); - p = pic; - - if (COB_FIELD_HAVE_SIGN (f)) { - if (COB_FIELD_SIGN_SEPARATE (f) - && !COB_FIELD_SIGN_LEADING(f)) { - /* done later */ - } else { - p->symbol = '+'; - p->times_repeated = 1; - ++p; - } - } - if (scale > 0) { - if (digits - scale > 0) { - p->symbol = '9'; - p->times_repeated = digits - scale; - ++p; - } - - p->symbol = COB_MODULE_PTR->decimal_point; - p->times_repeated = 1; - ++p; - - p->symbol = '9'; - p->times_repeated = scale; - ++p; - } else { - p->symbol = '9'; - p->times_repeated = digits; - ++p; - } - if (COB_FIELD_HAVE_SIGN (f)) { - if (COB_FIELD_SIGN_SEPARATE (f) - && !COB_FIELD_SIGN_LEADING(f)) { - p->symbol = '+'; - p->times_repeated = 1; - ++p; - } - } - p->symbol = '\0'; - - cob_move (f, &temp); - for (i = 0; i < size; ++i) { - if(q[i] != 0) - putc (q[i], fp); - } -} - -static void -display_alnum (cob_field *f, FILE *fp) -{ - size_t i; - - for (i = 0; i < f->size; ++i) { - putc (f->data[i], fp); - } -} - -/* Check for alternate styles of Not A Number and convert to just NaN - and removes the leading zero from the Exponent - note: not all environments provide display of negative /quiet NaN, - some write data as 2.1212121E+37 while other use 2.1212121E+037 */ -static void -clean_double (char *wrk) -{ - char *pos = strrchr (wrk, 'E'); - - if (pos) { - pos += 2; /* skip E+ */ - if (pos[0] == '0') { - memmove (pos, pos + 1, strlen (pos)); - } - return; - } - - if (strcmp(wrk,"-NAN") == 0 - || strcmp(wrk,"-NaNQ") == 0 - || strcmp(wrk,"-NaN") == 0 - || strcmp(wrk,"NAN") == 0 - || strcmp(wrk,"NaNQ") == 0) { - strcpy(wrk,"NaN"); - } -} - -static void -display_common (cob_field *f, FILE *fp) -{ - unsigned char *p; - union { - double f1doub; - float f1float; - } un; - int n; - char wrk[48]; -#if 0 /* RXWRXW - Print bin */ - cob_field temp; - cob_field_attr attr; -#endif - - if (f->size == 0) { - return; - } - switch (COB_FIELD_TYPE (f)) { - case COB_TYPE_NUMERIC_DOUBLE: - memcpy (&un.f1doub, f->data, sizeof (double)); - sprintf (wrk, "%-.16G", un.f1doub); - clean_double (wrk); - fprintf (fp, "%s", wrk); - return; - case COB_TYPE_NUMERIC_FLOAT: - memcpy (&un.f1float, f->data, sizeof (float)); - sprintf (wrk, "%-.8G", (double)un.f1float); - clean_double (wrk); - fprintf (fp, "%s", wrk); - return; - case COB_TYPE_NUMERIC_FP_DEC64: - case COB_TYPE_NUMERIC_FP_DEC128: - cob_print_ieeedec (f, fp); - return; - default: - break; - } - if (COB_FIELD_IS_POINTER (f)) { - fprintf (fp, "0x"); -#ifdef WORDS_BIGENDIAN - p = f->data; - for (n = 0; n < sizeof(void *); ++n, ++p) { -#else - p = f->data + sizeof(void *) - 1; - for (n = sizeof(void *) - 1; n >= 0; --n, --p) { -#endif - fprintf (fp, "%x%x", *p >> 4, *p & 0xF); - } - return; - } else if (COB_FIELD_REAL_BINARY(f) || - (COB_FIELD_TYPE(f) == COB_TYPE_NUMERIC_BINARY && - !COB_MODULE_PTR->flag_pretty_display)) { - cob_print_realbin (f, fp, bin_digits[f->size]); - return; -#if 0 /* RXWRXW - print bin */ - } else if (COB_FIELD_TYPE(f) == COB_TYPE_NUMERIC_BINARY && - !COB_MODULE_PTR->flag_pretty_display) { - attr = *f->attr; - temp = *f; - attr.digits = bin_digits[f->size]; - temp.attr = &attr; - display_numeric (&temp, fp); - return; -#endif - } else if (COB_FIELD_IS_NUMERIC (f)) { - if (COB_MODULE_PTR->flag_pretty_display) { - pretty_display_numeric (f, fp); - } else { - display_numeric (f, fp); - } - return; - } - display_alnum (f, fp); -} - -void -cob_display (const int to_device, const int newline, const int varcnt, ...) -{ - FILE *fp; - cob_field *f; - int i; - int nlattr, close_fp, pclose_fp; - cob_u32_t disp_redirect; - va_list args; - const char *mode; - - disp_redirect = 0; - pclose_fp = close_fp = 0; - - /* display to device ? */ - if (to_device == 2) { /* PRINTER */ - /* display to external specified print file handle */ - if (cobsetptr->cob_display_print_file) { - fp = cobsetptr->cob_display_print_file; - /* display to configured print file */ - } else if (cobsetptr->cob_display_print_filename != NULL) { - if (!cobsetptr->cob_unix_lf) { - mode = "a"; - } else { - mode = "ab"; - } - fp = fopen (cobsetptr->cob_display_print_filename, mode); - if (fp == NULL) { - fp = stderr; - } else { - close_fp = 1; - } -#ifdef HAVE_POPEN - /* display to configured print command (piped) */ - } else if (cobsetptr->cob_display_print_pipe != NULL) { - if (!cobsetptr->cob_unix_lf) { - mode = "w"; - } else { - /* Note: this doesn't seem to help with pipes :-( */ - mode = "wb"; - } - fp = popen (cobsetptr->cob_display_print_pipe, mode); - if (fp == NULL) { - fp = stderr; - } else { - pclose_fp = 1; - } -#endif - /* fallback: display to the defined SYSOUT */ - } else { - fp = stdout; - if (cobglobptr->cob_screen_initialized) { - if (!COB_DISP_TO_STDERR) { - disp_redirect = 1; - } else { - fp = stderr; - } - } - } - } else if (to_device == 1) { /* SYSERR */ - fp = stderr; - } else if (to_device == 3) { /* SYSPCH */ - /* open if not available but specified */ - if (!cobsetptr->cob_display_punch_file - && cobsetptr->cob_display_punch_filename != NULL) { - if (!cobsetptr->cob_unix_lf) { - mode = "w"; - } else { - /* Note: this doesn't seem to help with pipes :-( */ - mode = "wb"; - } - fp = fopen (cobsetptr->cob_display_punch_filename, mode); - if (fp == NULL) { - cob_runtime_warning (_("cannot open %s (=%s)"), - "COB_DISPLAY_PUNCH_FILE", cobsetptr->cob_display_punch_filename); - cob_free (cobsetptr->cob_display_punch_filename); - cobsetptr->cob_display_punch_filename = NULL; - } else { - cobsetptr->cob_display_punch_file = fp; - } - } - /* display to already opened punch file */ - if (cobsetptr->cob_display_punch_file) { - fp = cobsetptr->cob_display_punch_file; - } else { - cob_set_exception (COB_EC_IMP_DISPLAY); /* come back to this later... */ - if (!no_syspunch_error_raised) { - no_syspunch_error_raised = 1; - cob_runtime_warning (_("COB_DISPLAY_PUNCH_FILE is invalid, output to SYSPUNCH skipped")); - } - return; - } - } else { /* general (SYSOUT) */ - fp = stdout; - if (cobglobptr->cob_screen_initialized) { - if (!COB_DISP_TO_STDERR) { - disp_redirect = 1; - } else { - fp = stderr; - } - } - } - - nlattr = newline ? COB_SCREEN_EMULATE_NL : 0; - va_start (args, varcnt); - for (i = 0; i < varcnt; ++i) { - f = va_arg (args, cob_field *); - if (unlikely (disp_redirect)) { - cob_field_display (f, NULL, NULL, NULL, NULL, - NULL, NULL, nlattr); - } else { - display_common (f, fp); - } - } - va_end (args); - - if (newline && !disp_redirect) { - putc ('\n', fp); - fflush (fp); - } -#ifdef HAVE_POPEN - if (pclose_fp) { - pclose (fp); - } -#endif - if (close_fp) { - fclose (fp); - } -} - -static int -is_field_display (cob_field *f) -{ - size_t i; - for (i = 0; i < f->size; i++) { - if (f->data[i] < ' ' - || f->data[i] > 0x7F) - return 0; - } - return 1; -} - -static void -display_alnum_dump (cob_field *f, FILE *fp, unsigned int indent, unsigned int max_width) -{ - unsigned int i, j, pos, lowv, highv, spacev, printv, delv, len, colsize; - char wrk[200]; - - lowv = highv = spacev = printv = delv = 0; - colsize = max_width - indent - 2; - for (i = 0; i < f->size; i++) { - if (f->data[i] == 0x00) { - lowv++; - delv++; - } else if (f->data[i] == 0xFF) { - highv++; - } else if (f->data[i] == ' ') { - spacev++; - printv++; - } else if (f->data[i] >= ' ' - && f->data[i] <= 0x7F - && isprint(f->data[i])) { - printv++; - } else if (f->data[i] == '\b' - || f->data[i] == '\f' - || f->data[i] == '\n' - || f->data[i] == '\r' - || f->data[i] == '\t') { - delv++; - } - } - for (len = f->size; len > 0 && f->data[len-1] == ' '; len--); - - if (spacev == f->size) { - fprintf(fp,"ALL SPACES"); - return; - } - if (lowv == f->size) { - fprintf(fp,"ALL LOW-VALUES"); - return; - } - if (highv == f->size) { - fprintf(fp,"ALL HIGH-VALUES"); - return; - } - - if (lowv > 0 - && (lowv+printv) == f->size) { - for (len = f->size; len > 0 && f->data[len-1] == 0x00; len--); - if ((len+lowv) == f->size) { - for (i=0; len > colsize; i+=colsize,len-=colsize) { - fprintf(fp,"'%.*s'\n%*s",colsize,&f->data[i],indent," "); - } - if (len <= colsize) { - fprintf(fp,"'%.*s'",len,&f->data[i]); - } - fprintf(fp,"\n%*s trailing LOW-VALUES",indent-8," "); - return; - } - } - - if (printv == f->size) { - for (i=0; len > colsize; i+=colsize,len-=colsize) { - fprintf (fp, "'%.*s'\n%*s", colsize, &f->data[i], indent, " "); - } - if (len <= colsize) { - fprintf (fp, "'%.*s'", len, &f->data[i]); - return; - } - } - - if ((delv + printv) == f->size) { - for (i = 0; i < f->size; ) { - for (j=0; j < colsize && i < f->size; j++,i++) { - if (f->data[i] == '\0') - fprintf(fp,"\\0"), j++; - else if (f->data[i] == '\\') - fprintf(fp,"\\\\"), j++; - else if (f->data[i] == '\r') - fprintf(fp,"\\r"), j++; - else if (f->data[i] == '\n') - fprintf(fp,"\\n"), j++; - else if (f->data[i] == '\t') - fprintf(fp,"\\t"), j++; - else if (f->data[i] == '\b') - fprintf(fp,"\\b"), j++; - else if (f->data[i] == '\f') - fprintf(fp,"\\f"), j++; - else - fprintf(fp,"%c",f->data[i]); - } - if (i < f->size) { - fprintf (fp, "\n%*s%5u : ", indent - 8, " ", i + 1); - } - } - return; - } - - if (colsize > sizeof (wrk) - 1) { - colsize = sizeof (wrk) - 1; - } - if (colsize > 9) { - colsize = colsize / 9; - colsize = colsize * 9; - } - - for (i = 0; i < f->size; ) { - wrk[0] = 0; - pos = i + 1; - for (j=0; j < colsize && i < f->size; j+=2,i++) { - if (f->data[i] >= ' ' - && f->data[i] <= 0x7F) { - fprintf(fp," %c",f->data[i]); - sprintf (&wrk[j],"%02X",f->data[i]); - } else { - fprintf(fp," "); - sprintf (&wrk[j],"%02X",f->data[i]); - } - if ((j+2) < colsize - && ((i+1) % 4) == 0 - && (i+1) < f->size) { - fprintf(fp," "); - j++; - wrk[j+1] = ' '; - wrk[j+2] = 0; - } - } - fprintf (fp, "\n%*s%5u x %s", indent-8, " ", pos, wrk); - if (i < f->size) { - fprintf (fp, "\n%*s", indent, " "); - } - } -} - -static int dump_null_adrs = 0; -/* Display field for DUMP purposes */ -void -cob_dump_field (const int level, const char *name, - cob_field *fa, const int offset, const int indexes, ...) -{ - FILE *fp; - char vname[COB_MAX_WORDLEN + 1 + COB_MAX_SUBSCRIPTS * 4 + 1]; - char lvlwrk[16]; - va_list ap; - int idx, subscript, size, adjust, indent; - cob_field f[1]; - - fp = cob_get_dump_file (); - - if (level < 0) { /* Special directive */ - if (level == -1) { - fprintf(fp, "\n%s\n**********************\n",name); - dump_null_adrs = 0; - } else - if (level == -2 - && name != NULL) { - cob_file *fl = (cob_file*)name; - if (fl->open_mode == COB_OPEN_CLOSED) - fprintf(fp," File is CLOSED\n"); - else if (fl->open_mode == COB_OPEN_LOCKED) - fprintf(fp," File is LOCKED\n"); - else - fprintf(fp," File is OPEN\n"); - fprintf(fp, " FILE STATUS '%.2s'\n",fl->file_status); - } - } else { - strncpy (vname, name, (size_t)COB_MAX_WORDLEN); - vname[COB_MAX_WORDLEN] = 0; - memcpy (f, fa, sizeof (cob_field)); - adjust = offset; - va_start (ap, indexes); - if (indexes > 0) { - strcat (vname," ("); - for (idx = 1; idx <= indexes; idx++) { - subscript = va_arg (ap, int); - size = va_arg (ap, int); - adjust = adjust + (subscript * size); - if (idx > 1) { - strcat (vname,","); - } - sprintf(&vname[strlen(vname)],"%d",subscript+1); - } - strcat (vname,")"); - } - f->data += adjust; - if (level == 77 - && f->data != NULL) - dump_null_adrs = 0; - if (level == 77 - || level == 1) { - indent = 0; - sprintf(lvlwrk,"%02d",level); - } else { - indent = level / 2; - if (indent > 7) - indent = 7; - sprintf(lvlwrk,"%*s%02d",indent," ",level); - } - if (f->attr->type == COB_TYPE_GROUP) { - strcat(vname,"."); - if (f->data == NULL) { - dump_null_adrs = 1; - fprintf(fp, "%-10s%-30s address\n",lvlwrk,vname); - } else { - fprintf(fp, "%-10s%s\n",lvlwrk,vname); - dump_null_adrs = 0; - } - } else if (dump_null_adrs) { - /* Skip printing as Group had no address */ - } else { - fprintf(fp, "%-10s%-30s ",lvlwrk,vname); - if (strlen(vname) > 30) - fprintf(fp,"\n%-*s",41," "); - if (f->data == NULL) { - fprintf(fp," address"); - } else if (!is_field_display(f) - && (f->attr->type == COB_TYPE_NUMERIC_EDITED - || f->attr->type == COB_TYPE_NUMERIC_DISPLAY)) { - display_alnum_dump (f, fp, 41, cobsetptr->cob_dump_width); - } else if (f->attr->type == COB_TYPE_ALPHANUMERIC - || f->attr->type == COB_TYPE_ALPHANUMERIC_EDITED - || f->size > 39) { - display_alnum_dump (f, fp, 41, cobsetptr->cob_dump_width); - } else { - fprintf(fp," "); - display_common (f, fp); - } - fprintf(fp,"\n"); - } - } - va_end (ap); -} - -void -cob_print_field (FILE *fp, cob_field *f, int indent, int width) -{ - if (f->data == NULL) { - fprintf(fp," address"); - } else if (!is_field_display(f) - && (f->attr->type == COB_TYPE_NUMERIC_EDITED - || f->attr->type == COB_TYPE_NUMERIC_DISPLAY)) { - display_alnum_dump (f, fp, indent, width); - } else if (f->attr->type == COB_TYPE_ALPHANUMERIC - || f->attr->type == COB_TYPE_ALPHANUMERIC_EDITED - || f->attr->type == COB_TYPE_GROUP - || f->size > 39) { - display_alnum_dump (f, fp, indent, width); - } else { - fprintf(fp," "); - display_common (f, fp); - } - fprintf(fp,"\n"); -} - -/* ACCEPT */ - -void -cob_accept (cob_field *f) -{ - unsigned char *p; - size_t size; - int ipchr; - cob_field temp; - - if (cobglobptr->cob_screen_initialized) { - cob_field_accept (f, NULL, NULL, NULL, NULL, - NULL, NULL, NULL, NULL, - COB_SCREEN_PROMPT); - return; - } - if (COB_MODULE_PTR->crt_status) { - if (COB_FIELD_IS_NUMERIC (COB_MODULE_PTR->crt_status)) { - cob_set_int (COB_MODULE_PTR->crt_status, 0); - } else { - memset (COB_MODULE_PTR->crt_status->data, '0', (size_t)4); - } - } - /* extension: ACCEPT OMITTED */ - if (unlikely (!f)) { - for (; ; ) { - ipchr = getchar (); - if (ipchr == '\n' || ipchr == EOF) { - break; - } else if (ipchr == 03) { - cob_raise (2); - } - } - return; - } - p = COB_TERM_BUFF; - temp.data = p; - temp.attr = &const_alpha_attr; - size = 0; - /* Read a line */ - for (; size < COB_MEDIUM_MAX; ) { - ipchr = getchar (); - if (unlikely (ipchr == EOF)) { - cob_set_exception (COB_EC_IMP_ACCEPT); - if (!size) { - size = 1; - p[0] = ' '; - p[1] = 0; - } - break; - } else if (ipchr == 03) { - cob_raise (2); - } else if (ipchr == '\n') { - break; - } - p[size++] = (char) ipchr; - } - temp.size = size; - if (COB_FIELD_TYPE(f) == COB_TYPE_NUMERIC_DISPLAY) { - if (temp.size > f->size) { - temp.size = f->size; - } - } - cob_move (&temp, f); -} - -/* - * Move numeric value into working field with tailing NULs - * Then 'pretty_display_numeric' will skip outputing the NULs - */ -void -cob_field_int_display (cob_field *i, cob_field *f) -{ - memset(f->data,0,f->size); - sprintf((char *)(f->data),"%d",*(int *)i->data); -} - -void -cob_init_termio (cob_global *lptr, cob_settings *sptr) -{ - cobglobptr = lptr; - cobsetptr = sptr; -} diff -Nru gnucobol-4.0~early~20200606/libcob.h gnucobol-5/libcob.h --- gnucobol-4.0~early~20200606/libcob.h 2020-06-06 20:52:02.000000000 +0000 +++ gnucobol-5/libcob.h 1970-01-01 00:00:00.000000000 +0000 @@ -1,35 +0,0 @@ -/* - Copyright (C) 2002-2012, 2019 Free Software Foundation, Inc. - Written by Keisuke Nishida, Roger While, Simon Sobisch - - This file is part of GnuCOBOL. - - The GnuCOBOL runtime library is free software: you can redistribute it - and/or modify it under the terms of the GNU Lesser General Public License - as published by the Free Software Foundation, either version 3 of the - License, or (at your option) any later version. - - GnuCOBOL is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU Lesser General Public License for more details. - - You should have received a copy of the GNU Lesser General Public License - along with GnuCOBOL. If not, see . -*/ - - -#ifndef COB_LIBCOB_H -#define COB_LIBCOB_H - -#ifdef __cplusplus -extern "C" { -#endif - -#include - -#ifdef __cplusplus -} -#endif - -#endif /* COB_LIBCOB_H_ */ diff -Nru gnucobol-4.0~early~20200606/m4/codeset.m4 gnucobol-5/m4/codeset.m4 --- gnucobol-4.0~early~20200606/m4/codeset.m4 2020-06-06 20:56:36.000000000 +0000 +++ gnucobol-5/m4/codeset.m4 1970-01-01 00:00:00.000000000 +0000 @@ -1,23 +0,0 @@ -# codeset.m4 serial 5 (gettext-0.18.2) -dnl Copyright (C) 2000-2002, 2006, 2008-2014 Free Software Foundation, Inc. -dnl This file is free software; the Free Software Foundation -dnl gives unlimited permission to copy and/or distribute it, -dnl with or without modifications, as long as this notice is preserved. - -dnl From Bruno Haible. - -AC_DEFUN([AM_LANGINFO_CODESET], -[ - AC_CACHE_CHECK([for nl_langinfo and CODESET], [am_cv_langinfo_codeset], - [AC_LINK_IFELSE( - [AC_LANG_PROGRAM( - [[#include ]], - [[char* cs = nl_langinfo(CODESET); return !cs;]])], - [am_cv_langinfo_codeset=yes], - [am_cv_langinfo_codeset=no]) - ]) - if test $am_cv_langinfo_codeset = yes; then - AC_DEFINE([HAVE_LANGINFO_CODESET], [1], - [Define if you have and nl_langinfo(CODESET).]) - fi -]) diff -Nru gnucobol-4.0~early~20200606/m4/gettext.m4 gnucobol-5/m4/gettext.m4 --- gnucobol-4.0~early~20200606/m4/gettext.m4 2020-06-06 20:56:36.000000000 +0000 +++ gnucobol-5/m4/gettext.m4 1970-01-01 00:00:00.000000000 +0000 @@ -1,420 +0,0 @@ -# gettext.m4 serial 68 (gettext-0.19.8) -dnl Copyright (C) 1995-2014, 2016 Free Software Foundation, Inc. -dnl This file is free software; the Free Software Foundation -dnl gives unlimited permission to copy and/or distribute it, -dnl with or without modifications, as long as this notice is preserved. -dnl -dnl This file can be used in projects which are not available under -dnl the GNU General Public License or the GNU Library General Public -dnl License but which still want to provide support for the GNU gettext -dnl functionality. -dnl Please note that the actual code of the GNU gettext library is covered -dnl by the GNU Library General Public License, and the rest of the GNU -dnl gettext package is covered by the GNU General Public License. -dnl They are *not* in the public domain. - -dnl Authors: -dnl Ulrich Drepper , 1995-2000. -dnl Bruno Haible , 2000-2006, 2008-2010. - -dnl Macro to add for using GNU gettext. - -dnl Usage: AM_GNU_GETTEXT([INTLSYMBOL], [NEEDSYMBOL], [INTLDIR]). -dnl INTLSYMBOL can be one of 'external', 'no-libtool', 'use-libtool'. The -dnl default (if it is not specified or empty) is 'no-libtool'. -dnl INTLSYMBOL should be 'external' for packages with no intl directory, -dnl and 'no-libtool' or 'use-libtool' for packages with an intl directory. -dnl If INTLSYMBOL is 'use-libtool', then a libtool library -dnl $(top_builddir)/intl/libintl.la will be created (shared and/or static, -dnl depending on --{enable,disable}-{shared,static} and on the presence of -dnl AM-DISABLE-SHARED). If INTLSYMBOL is 'no-libtool', a static library -dnl $(top_builddir)/intl/libintl.a will be created. -dnl If NEEDSYMBOL is specified and is 'need-ngettext', then GNU gettext -dnl implementations (in libc or libintl) without the ngettext() function -dnl will be ignored. If NEEDSYMBOL is specified and is -dnl 'need-formatstring-macros', then GNU gettext implementations that don't -dnl support the ISO C 99 formatstring macros will be ignored. -dnl INTLDIR is used to find the intl libraries. If empty, -dnl the value '$(top_builddir)/intl/' is used. -dnl -dnl The result of the configuration is one of three cases: -dnl 1) GNU gettext, as included in the intl subdirectory, will be compiled -dnl and used. -dnl Catalog format: GNU --> install in $(datadir) -dnl Catalog extension: .mo after installation, .gmo in source tree -dnl 2) GNU gettext has been found in the system's C library. -dnl Catalog format: GNU --> install in $(datadir) -dnl Catalog extension: .mo after installation, .gmo in source tree -dnl 3) No internationalization, always use English msgid. -dnl Catalog format: none -dnl Catalog extension: none -dnl If INTLSYMBOL is 'external', only cases 2 and 3 can occur. -dnl The use of .gmo is historical (it was needed to avoid overwriting the -dnl GNU format catalogs when building on a platform with an X/Open gettext), -dnl but we keep it in order not to force irrelevant filename changes on the -dnl maintainers. -dnl -AC_DEFUN([AM_GNU_GETTEXT], -[ - dnl Argument checking. - ifelse([$1], [], , [ifelse([$1], [external], , [ifelse([$1], [no-libtool], , [ifelse([$1], [use-libtool], , - [errprint([ERROR: invalid first argument to AM_GNU_GETTEXT -])])])])]) - ifelse(ifelse([$1], [], [old])[]ifelse([$1], [no-libtool], [old]), [old], - [AC_DIAGNOSE([obsolete], [Use of AM_GNU_GETTEXT without [external] argument is deprecated.])]) - ifelse([$2], [], , [ifelse([$2], [need-ngettext], , [ifelse([$2], [need-formatstring-macros], , - [errprint([ERROR: invalid second argument to AM_GNU_GETTEXT -])])])]) - define([gt_included_intl], - ifelse([$1], [external], - ifdef([AM_GNU_GETTEXT_][INTL_SUBDIR], [yes], [no]), - [yes])) - define([gt_libtool_suffix_prefix], ifelse([$1], [use-libtool], [l], [])) - gt_NEEDS_INIT - AM_GNU_GETTEXT_NEED([$2]) - - AC_REQUIRE([AM_PO_SUBDIRS])dnl - ifelse(gt_included_intl, yes, [ - AC_REQUIRE([AM_INTL_SUBDIR])dnl - ]) - - dnl Prerequisites of AC_LIB_LINKFLAGS_BODY. - AC_REQUIRE([AC_LIB_PREPARE_PREFIX]) - AC_REQUIRE([AC_LIB_RPATH]) - - dnl Sometimes libintl requires libiconv, so first search for libiconv. - dnl Ideally we would do this search only after the - dnl if test "$USE_NLS" = "yes"; then - dnl if { eval "gt_val=\$$gt_func_gnugettext_libc"; test "$gt_val" != "yes"; }; then - dnl tests. But if configure.in invokes AM_ICONV after AM_GNU_GETTEXT - dnl the configure script would need to contain the same shell code - dnl again, outside any 'if'. There are two solutions: - dnl - Invoke AM_ICONV_LINKFLAGS_BODY here, outside any 'if'. - dnl - Control the expansions in more detail using AC_PROVIDE_IFELSE. - dnl Since AC_PROVIDE_IFELSE is only in autoconf >= 2.52 and not - dnl documented, we avoid it. - ifelse(gt_included_intl, yes, , [ - AC_REQUIRE([AM_ICONV_LINKFLAGS_BODY]) - ]) - - dnl Sometimes, on Mac OS X, libintl requires linking with CoreFoundation. - gt_INTL_MACOSX - - dnl Set USE_NLS. - AC_REQUIRE([AM_NLS]) - - ifelse(gt_included_intl, yes, [ - BUILD_INCLUDED_LIBINTL=no - USE_INCLUDED_LIBINTL=no - ]) - LIBINTL= - LTLIBINTL= - POSUB= - - dnl Add a version number to the cache macros. - case " $gt_needs " in - *" need-formatstring-macros "*) gt_api_version=3 ;; - *" need-ngettext "*) gt_api_version=2 ;; - *) gt_api_version=1 ;; - esac - gt_func_gnugettext_libc="gt_cv_func_gnugettext${gt_api_version}_libc" - gt_func_gnugettext_libintl="gt_cv_func_gnugettext${gt_api_version}_libintl" - - dnl If we use NLS figure out what method - if test "$USE_NLS" = "yes"; then - gt_use_preinstalled_gnugettext=no - ifelse(gt_included_intl, yes, [ - AC_MSG_CHECKING([whether included gettext is requested]) - AC_ARG_WITH([included-gettext], - [ --with-included-gettext use the GNU gettext library included here], - nls_cv_force_use_gnu_gettext=$withval, - nls_cv_force_use_gnu_gettext=no) - AC_MSG_RESULT([$nls_cv_force_use_gnu_gettext]) - - nls_cv_use_gnu_gettext="$nls_cv_force_use_gnu_gettext" - if test "$nls_cv_force_use_gnu_gettext" != "yes"; then - ]) - dnl User does not insist on using GNU NLS library. Figure out what - dnl to use. If GNU gettext is available we use this. Else we have - dnl to fall back to GNU NLS library. - - if test $gt_api_version -ge 3; then - gt_revision_test_code=' -#ifndef __GNU_GETTEXT_SUPPORTED_REVISION -#define __GNU_GETTEXT_SUPPORTED_REVISION(major) ((major) == 0 ? 0 : -1) -#endif -changequote(,)dnl -typedef int array [2 * (__GNU_GETTEXT_SUPPORTED_REVISION(0) >= 1) - 1]; -changequote([,])dnl -' - else - gt_revision_test_code= - fi - if test $gt_api_version -ge 2; then - gt_expression_test_code=' + * ngettext ("", "", 0)' - else - gt_expression_test_code= - fi - - AC_CACHE_CHECK([for GNU gettext in libc], [$gt_func_gnugettext_libc], - [AC_LINK_IFELSE( - [AC_LANG_PROGRAM( - [[ -#include -#ifndef __GNU_GETTEXT_SUPPORTED_REVISION -extern int _nl_msg_cat_cntr; -extern int *_nl_domain_bindings; -#define __GNU_GETTEXT_SYMBOL_EXPRESSION (_nl_msg_cat_cntr + *_nl_domain_bindings) -#else -#define __GNU_GETTEXT_SYMBOL_EXPRESSION 0 -#endif -$gt_revision_test_code - ]], - [[ -bindtextdomain ("", ""); -return * gettext ("")$gt_expression_test_code + __GNU_GETTEXT_SYMBOL_EXPRESSION - ]])], - [eval "$gt_func_gnugettext_libc=yes"], - [eval "$gt_func_gnugettext_libc=no"])]) - - if { eval "gt_val=\$$gt_func_gnugettext_libc"; test "$gt_val" != "yes"; }; then - dnl Sometimes libintl requires libiconv, so first search for libiconv. - ifelse(gt_included_intl, yes, , [ - AM_ICONV_LINK - ]) - dnl Search for libintl and define LIBINTL, LTLIBINTL and INCINTL - dnl accordingly. Don't use AC_LIB_LINKFLAGS_BODY([intl],[iconv]) - dnl because that would add "-liconv" to LIBINTL and LTLIBINTL - dnl even if libiconv doesn't exist. - AC_LIB_LINKFLAGS_BODY([intl]) - AC_CACHE_CHECK([for GNU gettext in libintl], - [$gt_func_gnugettext_libintl], - [gt_save_CPPFLAGS="$CPPFLAGS" - CPPFLAGS="$CPPFLAGS $INCINTL" - gt_save_LIBS="$LIBS" - LIBS="$LIBS $LIBINTL" - dnl Now see whether libintl exists and does not depend on libiconv. - AC_LINK_IFELSE( - [AC_LANG_PROGRAM( - [[ -#include -#ifndef __GNU_GETTEXT_SUPPORTED_REVISION -extern int _nl_msg_cat_cntr; -extern -#ifdef __cplusplus -"C" -#endif -const char *_nl_expand_alias (const char *); -#define __GNU_GETTEXT_SYMBOL_EXPRESSION (_nl_msg_cat_cntr + *_nl_expand_alias ("")) -#else -#define __GNU_GETTEXT_SYMBOL_EXPRESSION 0 -#endif -$gt_revision_test_code - ]], - [[ -bindtextdomain ("", ""); -return * gettext ("")$gt_expression_test_code + __GNU_GETTEXT_SYMBOL_EXPRESSION - ]])], - [eval "$gt_func_gnugettext_libintl=yes"], - [eval "$gt_func_gnugettext_libintl=no"]) - dnl Now see whether libintl exists and depends on libiconv. - if { eval "gt_val=\$$gt_func_gnugettext_libintl"; test "$gt_val" != yes; } && test -n "$LIBICONV"; then - LIBS="$LIBS $LIBICONV" - AC_LINK_IFELSE( - [AC_LANG_PROGRAM( - [[ -#include -#ifndef __GNU_GETTEXT_SUPPORTED_REVISION -extern int _nl_msg_cat_cntr; -extern -#ifdef __cplusplus -"C" -#endif -const char *_nl_expand_alias (const char *); -#define __GNU_GETTEXT_SYMBOL_EXPRESSION (_nl_msg_cat_cntr + *_nl_expand_alias ("")) -#else -#define __GNU_GETTEXT_SYMBOL_EXPRESSION 0 -#endif -$gt_revision_test_code - ]], - [[ -bindtextdomain ("", ""); -return * gettext ("")$gt_expression_test_code + __GNU_GETTEXT_SYMBOL_EXPRESSION - ]])], - [LIBINTL="$LIBINTL $LIBICONV" - LTLIBINTL="$LTLIBINTL $LTLIBICONV" - eval "$gt_func_gnugettext_libintl=yes" - ]) - fi - CPPFLAGS="$gt_save_CPPFLAGS" - LIBS="$gt_save_LIBS"]) - fi - - dnl If an already present or preinstalled GNU gettext() is found, - dnl use it. But if this macro is used in GNU gettext, and GNU - dnl gettext is already preinstalled in libintl, we update this - dnl libintl. (Cf. the install rule in intl/Makefile.in.) - if { eval "gt_val=\$$gt_func_gnugettext_libc"; test "$gt_val" = "yes"; } \ - || { { eval "gt_val=\$$gt_func_gnugettext_libintl"; test "$gt_val" = "yes"; } \ - && test "$PACKAGE" != gettext-runtime \ - && test "$PACKAGE" != gettext-tools; }; then - gt_use_preinstalled_gnugettext=yes - else - dnl Reset the values set by searching for libintl. - LIBINTL= - LTLIBINTL= - INCINTL= - fi - - ifelse(gt_included_intl, yes, [ - if test "$gt_use_preinstalled_gnugettext" != "yes"; then - dnl GNU gettext is not found in the C library. - dnl Fall back on included GNU gettext library. - nls_cv_use_gnu_gettext=yes - fi - fi - - if test "$nls_cv_use_gnu_gettext" = "yes"; then - dnl Mark actions used to generate GNU NLS library. - BUILD_INCLUDED_LIBINTL=yes - USE_INCLUDED_LIBINTL=yes - LIBINTL="ifelse([$3],[],\${top_builddir}/intl,[$3])/libintl.[]gt_libtool_suffix_prefix[]a $LIBICONV $LIBTHREAD" - LTLIBINTL="ifelse([$3],[],\${top_builddir}/intl,[$3])/libintl.[]gt_libtool_suffix_prefix[]a $LTLIBICONV $LTLIBTHREAD" - LIBS=`echo " $LIBS " | sed -e 's/ -lintl / /' -e 's/^ //' -e 's/ $//'` - fi - - CATOBJEXT= - if test "$gt_use_preinstalled_gnugettext" = "yes" \ - || test "$nls_cv_use_gnu_gettext" = "yes"; then - dnl Mark actions to use GNU gettext tools. - CATOBJEXT=.gmo - fi - ]) - - if test -n "$INTL_MACOSX_LIBS"; then - if test "$gt_use_preinstalled_gnugettext" = "yes" \ - || test "$nls_cv_use_gnu_gettext" = "yes"; then - dnl Some extra flags are needed during linking. - LIBINTL="$LIBINTL $INTL_MACOSX_LIBS" - LTLIBINTL="$LTLIBINTL $INTL_MACOSX_LIBS" - fi - fi - - if test "$gt_use_preinstalled_gnugettext" = "yes" \ - || test "$nls_cv_use_gnu_gettext" = "yes"; then - AC_DEFINE([ENABLE_NLS], [1], - [Define to 1 if translation of program messages to the user's native language - is requested.]) - else - USE_NLS=no - fi - fi - - AC_MSG_CHECKING([whether to use NLS]) - AC_MSG_RESULT([$USE_NLS]) - if test "$USE_NLS" = "yes"; then - AC_MSG_CHECKING([where the gettext function comes from]) - if test "$gt_use_preinstalled_gnugettext" = "yes"; then - if { eval "gt_val=\$$gt_func_gnugettext_libintl"; test "$gt_val" = "yes"; }; then - gt_source="external libintl" - else - gt_source="libc" - fi - else - gt_source="included intl directory" - fi - AC_MSG_RESULT([$gt_source]) - fi - - if test "$USE_NLS" = "yes"; then - - if test "$gt_use_preinstalled_gnugettext" = "yes"; then - if { eval "gt_val=\$$gt_func_gnugettext_libintl"; test "$gt_val" = "yes"; }; then - AC_MSG_CHECKING([how to link with libintl]) - AC_MSG_RESULT([$LIBINTL]) - AC_LIB_APPENDTOVAR([CPPFLAGS], [$INCINTL]) - fi - - dnl For backward compatibility. Some packages may be using this. - AC_DEFINE([HAVE_GETTEXT], [1], - [Define if the GNU gettext() function is already present or preinstalled.]) - AC_DEFINE([HAVE_DCGETTEXT], [1], - [Define if the GNU dcgettext() function is already present or preinstalled.]) - fi - - dnl We need to process the po/ directory. - POSUB=po - fi - - ifelse(gt_included_intl, yes, [ - dnl If this is used in GNU gettext we have to set BUILD_INCLUDED_LIBINTL - dnl to 'yes' because some of the testsuite requires it. - if test "$PACKAGE" = gettext-runtime || test "$PACKAGE" = gettext-tools; then - BUILD_INCLUDED_LIBINTL=yes - fi - - dnl Make all variables we use known to autoconf. - AC_SUBST([BUILD_INCLUDED_LIBINTL]) - AC_SUBST([USE_INCLUDED_LIBINTL]) - AC_SUBST([CATOBJEXT]) - - dnl For backward compatibility. Some configure.ins may be using this. - nls_cv_header_intl= - nls_cv_header_libgt= - - dnl For backward compatibility. Some Makefiles may be using this. - DATADIRNAME=share - AC_SUBST([DATADIRNAME]) - - dnl For backward compatibility. Some Makefiles may be using this. - INSTOBJEXT=.mo - AC_SUBST([INSTOBJEXT]) - - dnl For backward compatibility. Some Makefiles may be using this. - GENCAT=gencat - AC_SUBST([GENCAT]) - - dnl For backward compatibility. Some Makefiles may be using this. - INTLOBJS= - if test "$USE_INCLUDED_LIBINTL" = yes; then - INTLOBJS="\$(GETTOBJS)" - fi - AC_SUBST([INTLOBJS]) - - dnl Enable libtool support if the surrounding package wishes it. - INTL_LIBTOOL_SUFFIX_PREFIX=gt_libtool_suffix_prefix - AC_SUBST([INTL_LIBTOOL_SUFFIX_PREFIX]) - ]) - - dnl For backward compatibility. Some Makefiles may be using this. - INTLLIBS="$LIBINTL" - AC_SUBST([INTLLIBS]) - - dnl Make all documented variables known to autoconf. - AC_SUBST([LIBINTL]) - AC_SUBST([LTLIBINTL]) - AC_SUBST([POSUB]) -]) - - -dnl gt_NEEDS_INIT ensures that the gt_needs variable is initialized. -m4_define([gt_NEEDS_INIT], -[ - m4_divert_text([DEFAULTS], [gt_needs=]) - m4_define([gt_NEEDS_INIT], []) -]) - - -dnl Usage: AM_GNU_GETTEXT_NEED([NEEDSYMBOL]) -AC_DEFUN([AM_GNU_GETTEXT_NEED], -[ - m4_divert_text([INIT_PREPARE], [gt_needs="$gt_needs $1"]) -]) - - -dnl Usage: AM_GNU_GETTEXT_VERSION([gettext-version]) -AC_DEFUN([AM_GNU_GETTEXT_VERSION], []) - - -dnl Usage: AM_GNU_GETTEXT_REQUIRE_VERSION([gettext-version]) -AC_DEFUN([AM_GNU_GETTEXT_REQUIRE_VERSION], []) diff -Nru gnucobol-4.0~early~20200606/m4/iconv.m4 gnucobol-5/m4/iconv.m4 --- gnucobol-4.0~early~20200606/m4/iconv.m4 2020-06-06 20:56:36.000000000 +0000 +++ gnucobol-5/m4/iconv.m4 1970-01-01 00:00:00.000000000 +0000 @@ -1,271 +0,0 @@ -# iconv.m4 serial 19 (gettext-0.18.2) -dnl Copyright (C) 2000-2002, 2007-2014, 2016 Free Software Foundation, Inc. -dnl This file is free software; the Free Software Foundation -dnl gives unlimited permission to copy and/or distribute it, -dnl with or without modifications, as long as this notice is preserved. - -dnl From Bruno Haible. - -AC_DEFUN([AM_ICONV_LINKFLAGS_BODY], -[ - dnl Prerequisites of AC_LIB_LINKFLAGS_BODY. - AC_REQUIRE([AC_LIB_PREPARE_PREFIX]) - AC_REQUIRE([AC_LIB_RPATH]) - - dnl Search for libiconv and define LIBICONV, LTLIBICONV and INCICONV - dnl accordingly. - AC_LIB_LINKFLAGS_BODY([iconv]) -]) - -AC_DEFUN([AM_ICONV_LINK], -[ - dnl Some systems have iconv in libc, some have it in libiconv (OSF/1 and - dnl those with the standalone portable GNU libiconv installed). - AC_REQUIRE([AC_CANONICAL_HOST]) dnl for cross-compiles - - dnl Search for libiconv and define LIBICONV, LTLIBICONV and INCICONV - dnl accordingly. - AC_REQUIRE([AM_ICONV_LINKFLAGS_BODY]) - - dnl Add $INCICONV to CPPFLAGS before performing the following checks, - dnl because if the user has installed libiconv and not disabled its use - dnl via --without-libiconv-prefix, he wants to use it. The first - dnl AC_LINK_IFELSE will then fail, the second AC_LINK_IFELSE will succeed. - am_save_CPPFLAGS="$CPPFLAGS" - AC_LIB_APPENDTOVAR([CPPFLAGS], [$INCICONV]) - - AC_CACHE_CHECK([for iconv], [am_cv_func_iconv], [ - am_cv_func_iconv="no, consider installing GNU libiconv" - am_cv_lib_iconv=no - AC_LINK_IFELSE( - [AC_LANG_PROGRAM( - [[ -#include -#include - ]], - [[iconv_t cd = iconv_open("",""); - iconv(cd,NULL,NULL,NULL,NULL); - iconv_close(cd);]])], - [am_cv_func_iconv=yes]) - if test "$am_cv_func_iconv" != yes; then - am_save_LIBS="$LIBS" - LIBS="$LIBS $LIBICONV" - AC_LINK_IFELSE( - [AC_LANG_PROGRAM( - [[ -#include -#include - ]], - [[iconv_t cd = iconv_open("",""); - iconv(cd,NULL,NULL,NULL,NULL); - iconv_close(cd);]])], - [am_cv_lib_iconv=yes] - [am_cv_func_iconv=yes]) - LIBS="$am_save_LIBS" - fi - ]) - if test "$am_cv_func_iconv" = yes; then - AC_CACHE_CHECK([for working iconv], [am_cv_func_iconv_works], [ - dnl This tests against bugs in AIX 5.1, AIX 6.1..7.1, HP-UX 11.11, - dnl Solaris 10. - am_save_LIBS="$LIBS" - if test $am_cv_lib_iconv = yes; then - LIBS="$LIBS $LIBICONV" - fi - am_cv_func_iconv_works=no - for ac_iconv_const in '' 'const'; do - AC_RUN_IFELSE( - [AC_LANG_PROGRAM( - [[ -#include -#include - -#ifndef ICONV_CONST -# define ICONV_CONST $ac_iconv_const -#endif - ]], - [[int result = 0; - /* Test against AIX 5.1 bug: Failures are not distinguishable from successful - returns. */ - { - iconv_t cd_utf8_to_88591 = iconv_open ("ISO8859-1", "UTF-8"); - if (cd_utf8_to_88591 != (iconv_t)(-1)) - { - static ICONV_CONST char input[] = "\342\202\254"; /* EURO SIGN */ - char buf[10]; - ICONV_CONST char *inptr = input; - size_t inbytesleft = strlen (input); - char *outptr = buf; - size_t outbytesleft = sizeof (buf); - size_t res = iconv (cd_utf8_to_88591, - &inptr, &inbytesleft, - &outptr, &outbytesleft); - if (res == 0) - result |= 1; - iconv_close (cd_utf8_to_88591); - } - } - /* Test against Solaris 10 bug: Failures are not distinguishable from - successful returns. */ - { - iconv_t cd_ascii_to_88591 = iconv_open ("ISO8859-1", "646"); - if (cd_ascii_to_88591 != (iconv_t)(-1)) - { - static ICONV_CONST char input[] = "\263"; - char buf[10]; - ICONV_CONST char *inptr = input; - size_t inbytesleft = strlen (input); - char *outptr = buf; - size_t outbytesleft = sizeof (buf); - size_t res = iconv (cd_ascii_to_88591, - &inptr, &inbytesleft, - &outptr, &outbytesleft); - if (res == 0) - result |= 2; - iconv_close (cd_ascii_to_88591); - } - } - /* Test against AIX 6.1..7.1 bug: Buffer overrun. */ - { - iconv_t cd_88591_to_utf8 = iconv_open ("UTF-8", "ISO-8859-1"); - if (cd_88591_to_utf8 != (iconv_t)(-1)) - { - static ICONV_CONST char input[] = "\304"; - static char buf[2] = { (char)0xDE, (char)0xAD }; - ICONV_CONST char *inptr = input; - size_t inbytesleft = 1; - char *outptr = buf; - size_t outbytesleft = 1; - size_t res = iconv (cd_88591_to_utf8, - &inptr, &inbytesleft, - &outptr, &outbytesleft); - if (res != (size_t)(-1) || outptr - buf > 1 || buf[1] != (char)0xAD) - result |= 4; - iconv_close (cd_88591_to_utf8); - } - } -#if 0 /* This bug could be worked around by the caller. */ - /* Test against HP-UX 11.11 bug: Positive return value instead of 0. */ - { - iconv_t cd_88591_to_utf8 = iconv_open ("utf8", "iso88591"); - if (cd_88591_to_utf8 != (iconv_t)(-1)) - { - static ICONV_CONST char input[] = "\304rger mit b\366sen B\374bchen ohne Augenma\337"; - char buf[50]; - ICONV_CONST char *inptr = input; - size_t inbytesleft = strlen (input); - char *outptr = buf; - size_t outbytesleft = sizeof (buf); - size_t res = iconv (cd_88591_to_utf8, - &inptr, &inbytesleft, - &outptr, &outbytesleft); - if ((int)res > 0) - result |= 8; - iconv_close (cd_88591_to_utf8); - } - } -#endif - /* Test against HP-UX 11.11 bug: No converter from EUC-JP to UTF-8 is - provided. */ - if (/* Try standardized names. */ - iconv_open ("UTF-8", "EUC-JP") == (iconv_t)(-1) - /* Try IRIX, OSF/1 names. */ - && iconv_open ("UTF-8", "eucJP") == (iconv_t)(-1) - /* Try AIX names. */ - && iconv_open ("UTF-8", "IBM-eucJP") == (iconv_t)(-1) - /* Try HP-UX names. */ - && iconv_open ("utf8", "eucJP") == (iconv_t)(-1)) - result |= 16; - return result; -]])], - [am_cv_func_iconv_works=yes], , - [case "$host_os" in - aix* | hpux*) am_cv_func_iconv_works="guessing no" ;; - *) am_cv_func_iconv_works="guessing yes" ;; - esac]) - test "$am_cv_func_iconv_works" = no || break - done - LIBS="$am_save_LIBS" - ]) - case "$am_cv_func_iconv_works" in - *no) am_func_iconv=no am_cv_lib_iconv=no ;; - *) am_func_iconv=yes ;; - esac - else - am_func_iconv=no am_cv_lib_iconv=no - fi - if test "$am_func_iconv" = yes; then - AC_DEFINE([HAVE_ICONV], [1], - [Define if you have the iconv() function and it works.]) - fi - if test "$am_cv_lib_iconv" = yes; then - AC_MSG_CHECKING([how to link with libiconv]) - AC_MSG_RESULT([$LIBICONV]) - else - dnl If $LIBICONV didn't lead to a usable library, we don't need $INCICONV - dnl either. - CPPFLAGS="$am_save_CPPFLAGS" - LIBICONV= - LTLIBICONV= - fi - AC_SUBST([LIBICONV]) - AC_SUBST([LTLIBICONV]) -]) - -dnl Define AM_ICONV using AC_DEFUN_ONCE for Autoconf >= 2.64, in order to -dnl avoid warnings like -dnl "warning: AC_REQUIRE: `AM_ICONV' was expanded before it was required". -dnl This is tricky because of the way 'aclocal' is implemented: -dnl - It requires defining an auxiliary macro whose name ends in AC_DEFUN. -dnl Otherwise aclocal's initial scan pass would miss the macro definition. -dnl - It requires a line break inside the AC_DEFUN_ONCE and AC_DEFUN expansions. -dnl Otherwise aclocal would emit many "Use of uninitialized value $1" -dnl warnings. -m4_define([gl_iconv_AC_DEFUN], - m4_version_prereq([2.64], - [[AC_DEFUN_ONCE( - [$1], [$2])]], - [m4_ifdef([gl_00GNULIB], - [[AC_DEFUN_ONCE( - [$1], [$2])]], - [[AC_DEFUN( - [$1], [$2])]])])) -gl_iconv_AC_DEFUN([AM_ICONV], -[ - AM_ICONV_LINK - if test "$am_cv_func_iconv" = yes; then - AC_MSG_CHECKING([for iconv declaration]) - AC_CACHE_VAL([am_cv_proto_iconv], [ - AC_COMPILE_IFELSE( - [AC_LANG_PROGRAM( - [[ -#include -#include -extern -#ifdef __cplusplus -"C" -#endif -#if defined(__STDC__) || defined(_MSC_VER) || defined(__cplusplus) -size_t iconv (iconv_t cd, char * *inbuf, size_t *inbytesleft, char * *outbuf, size_t *outbytesleft); -#else -size_t iconv(); -#endif - ]], - [[]])], - [am_cv_proto_iconv_arg1=""], - [am_cv_proto_iconv_arg1="const"]) - am_cv_proto_iconv="extern size_t iconv (iconv_t cd, $am_cv_proto_iconv_arg1 char * *inbuf, size_t *inbytesleft, char * *outbuf, size_t *outbytesleft);"]) - am_cv_proto_iconv=`echo "[$]am_cv_proto_iconv" | tr -s ' ' | sed -e 's/( /(/'` - AC_MSG_RESULT([ - $am_cv_proto_iconv]) - AC_DEFINE_UNQUOTED([ICONV_CONST], [$am_cv_proto_iconv_arg1], - [Define as const if the declaration of iconv() needs const.]) - dnl Also substitute ICONV_CONST in the gnulib generated . - m4_ifdef([gl_ICONV_H_DEFAULTS], - [AC_REQUIRE([gl_ICONV_H_DEFAULTS]) - if test -n "$am_cv_proto_iconv_arg1"; then - ICONV_CONST="const" - fi - ]) - fi -]) diff -Nru gnucobol-4.0~early~20200606/m4/intlmacosx.m4 gnucobol-5/m4/intlmacosx.m4 --- gnucobol-4.0~early~20200606/m4/intlmacosx.m4 2020-06-06 20:56:36.000000000 +0000 +++ gnucobol-5/m4/intlmacosx.m4 1970-01-01 00:00:00.000000000 +0000 @@ -1,56 +0,0 @@ -# intlmacosx.m4 serial 5 (gettext-0.18.2) -dnl Copyright (C) 2004-2014 Free Software Foundation, Inc. -dnl This file is free software; the Free Software Foundation -dnl gives unlimited permission to copy and/or distribute it, -dnl with or without modifications, as long as this notice is preserved. -dnl -dnl This file can can be used in projects which are not available under -dnl the GNU General Public License or the GNU Library General Public -dnl License but which still want to provide support for the GNU gettext -dnl functionality. -dnl Please note that the actual code of the GNU gettext library is covered -dnl by the GNU Library General Public License, and the rest of the GNU -dnl gettext package package is covered by the GNU General Public License. -dnl They are *not* in the public domain. - -dnl Checks for special options needed on Mac OS X. -dnl Defines INTL_MACOSX_LIBS. -AC_DEFUN([gt_INTL_MACOSX], -[ - dnl Check for API introduced in Mac OS X 10.2. - AC_CACHE_CHECK([for CFPreferencesCopyAppValue], - [gt_cv_func_CFPreferencesCopyAppValue], - [gt_save_LIBS="$LIBS" - LIBS="$LIBS -Wl,-framework -Wl,CoreFoundation" - AC_LINK_IFELSE( - [AC_LANG_PROGRAM( - [[#include ]], - [[CFPreferencesCopyAppValue(NULL, NULL)]])], - [gt_cv_func_CFPreferencesCopyAppValue=yes], - [gt_cv_func_CFPreferencesCopyAppValue=no]) - LIBS="$gt_save_LIBS"]) - if test $gt_cv_func_CFPreferencesCopyAppValue = yes; then - AC_DEFINE([HAVE_CFPREFERENCESCOPYAPPVALUE], [1], - [Define to 1 if you have the Mac OS X function CFPreferencesCopyAppValue in the CoreFoundation framework.]) - fi - dnl Check for API introduced in Mac OS X 10.3. - AC_CACHE_CHECK([for CFLocaleCopyCurrent], [gt_cv_func_CFLocaleCopyCurrent], - [gt_save_LIBS="$LIBS" - LIBS="$LIBS -Wl,-framework -Wl,CoreFoundation" - AC_LINK_IFELSE( - [AC_LANG_PROGRAM( - [[#include ]], - [[CFLocaleCopyCurrent();]])], - [gt_cv_func_CFLocaleCopyCurrent=yes], - [gt_cv_func_CFLocaleCopyCurrent=no]) - LIBS="$gt_save_LIBS"]) - if test $gt_cv_func_CFLocaleCopyCurrent = yes; then - AC_DEFINE([HAVE_CFLOCALECOPYCURRENT], [1], - [Define to 1 if you have the Mac OS X function CFLocaleCopyCurrent in the CoreFoundation framework.]) - fi - INTL_MACOSX_LIBS= - if test $gt_cv_func_CFPreferencesCopyAppValue = yes || test $gt_cv_func_CFLocaleCopyCurrent = yes; then - INTL_MACOSX_LIBS="-Wl,-framework -Wl,CoreFoundation" - fi - AC_SUBST([INTL_MACOSX_LIBS]) -]) diff -Nru gnucobol-4.0~early~20200606/m4/lib-ld.m4 gnucobol-5/m4/lib-ld.m4 --- gnucobol-4.0~early~20200606/m4/lib-ld.m4 2020-06-06 20:56:36.000000000 +0000 +++ gnucobol-5/m4/lib-ld.m4 1970-01-01 00:00:00.000000000 +0000 @@ -1,119 +0,0 @@ -# lib-ld.m4 serial 6 -dnl Copyright (C) 1996-2003, 2009-2016 Free Software Foundation, Inc. -dnl This file is free software; the Free Software Foundation -dnl gives unlimited permission to copy and/or distribute it, -dnl with or without modifications, as long as this notice is preserved. - -dnl Subroutines of libtool.m4, -dnl with replacements s/_*LT_PATH/AC_LIB_PROG/ and s/lt_/acl_/ to avoid -dnl collision with libtool.m4. - -dnl From libtool-2.4. Sets the variable with_gnu_ld to yes or no. -AC_DEFUN([AC_LIB_PROG_LD_GNU], -[AC_CACHE_CHECK([if the linker ($LD) is GNU ld], [acl_cv_prog_gnu_ld], -[# I'd rather use --version here, but apparently some GNU lds only accept -v. -case `$LD -v 2>&1 /dev/null 2>&1 \ - && { (PATH='/bin:/bin'; FPATH=$PATH; sh -c :) >/dev/null 2>&1 \ - || PATH_SEPARATOR=';' - } -fi - -ac_prog=ld -if test "$GCC" = yes; then - # Check if gcc -print-prog-name=ld gives a path. - AC_MSG_CHECKING([for ld used by $CC]) - case $host in - *-*-mingw*) - # gcc leaves a trailing carriage return which upsets mingw - ac_prog=`($CC -print-prog-name=ld) 2>&5 | tr -d '\015'` ;; - *) - ac_prog=`($CC -print-prog-name=ld) 2>&5` ;; - esac - case $ac_prog in - # Accept absolute paths. - [[\\/]]* | ?:[[\\/]]*) - re_direlt='/[[^/]][[^/]]*/\.\./' - # Canonicalize the pathname of ld - ac_prog=`echo "$ac_prog"| sed 's%\\\\%/%g'` - while echo "$ac_prog" | grep "$re_direlt" > /dev/null 2>&1; do - ac_prog=`echo $ac_prog| sed "s%$re_direlt%/%"` - done - test -z "$LD" && LD="$ac_prog" - ;; - "") - # If it fails, then pretend we aren't using GCC. - ac_prog=ld - ;; - *) - # If it is relative, then search for the first ld in PATH. - with_gnu_ld=unknown - ;; - esac -elif test "$with_gnu_ld" = yes; then - AC_MSG_CHECKING([for GNU ld]) -else - AC_MSG_CHECKING([for non-GNU ld]) -fi -AC_CACHE_VAL([acl_cv_path_LD], -[if test -z "$LD"; then - acl_save_ifs="$IFS"; IFS=$PATH_SEPARATOR - for ac_dir in $PATH; do - IFS="$acl_save_ifs" - test -z "$ac_dir" && ac_dir=. - if test -f "$ac_dir/$ac_prog" || test -f "$ac_dir/$ac_prog$ac_exeext"; then - acl_cv_path_LD="$ac_dir/$ac_prog" - # Check to see if the program is GNU ld. I'd rather use --version, - # but apparently some variants of GNU ld only accept -v. - # Break only if it was the GNU/non-GNU ld that we prefer. - case `"$acl_cv_path_LD" -v 2>&1 = 1.10 to complain if config.rpath is missing. - m4_ifdef([AC_REQUIRE_AUX_FILE], [AC_REQUIRE_AUX_FILE([config.rpath])]) - AC_REQUIRE([AC_PROG_CC]) dnl we use $CC, $GCC, $LDFLAGS - AC_REQUIRE([AC_LIB_PROG_LD]) dnl we use $LD, $with_gnu_ld - AC_REQUIRE([AC_CANONICAL_HOST]) dnl we use $host - AC_REQUIRE([AC_CONFIG_AUX_DIR_DEFAULT]) dnl we use $ac_aux_dir - AC_CACHE_CHECK([for shared library run path origin], [acl_cv_rpath], [ - CC="$CC" GCC="$GCC" LDFLAGS="$LDFLAGS" LD="$LD" with_gnu_ld="$with_gnu_ld" \ - ${CONFIG_SHELL-/bin/sh} "$ac_aux_dir/config.rpath" "$host" > conftest.sh - . ./conftest.sh - rm -f ./conftest.sh - acl_cv_rpath=done - ]) - wl="$acl_cv_wl" - acl_libext="$acl_cv_libext" - acl_shlibext="$acl_cv_shlibext" - acl_libname_spec="$acl_cv_libname_spec" - acl_library_names_spec="$acl_cv_library_names_spec" - acl_hardcode_libdir_flag_spec="$acl_cv_hardcode_libdir_flag_spec" - acl_hardcode_libdir_separator="$acl_cv_hardcode_libdir_separator" - acl_hardcode_direct="$acl_cv_hardcode_direct" - acl_hardcode_minus_L="$acl_cv_hardcode_minus_L" - dnl Determine whether the user wants rpath handling at all. - AC_ARG_ENABLE([rpath], - [ --disable-rpath do not hardcode runtime library paths], - :, enable_rpath=yes) -]) - -dnl AC_LIB_FROMPACKAGE(name, package) -dnl declares that libname comes from the given package. The configure file -dnl will then not have a --with-libname-prefix option but a -dnl --with-package-prefix option. Several libraries can come from the same -dnl package. This declaration must occur before an AC_LIB_LINKFLAGS or similar -dnl macro call that searches for libname. -AC_DEFUN([AC_LIB_FROMPACKAGE], -[ - pushdef([NAME],[m4_translit([$1],[abcdefghijklmnopqrstuvwxyz./+-], - [ABCDEFGHIJKLMNOPQRSTUVWXYZ____])]) - define([acl_frompackage_]NAME, [$2]) - popdef([NAME]) - pushdef([PACK],[$2]) - pushdef([PACKUP],[m4_translit(PACK,[abcdefghijklmnopqrstuvwxyz./+-], - [ABCDEFGHIJKLMNOPQRSTUVWXYZ____])]) - define([acl_libsinpackage_]PACKUP, - m4_ifdef([acl_libsinpackage_]PACKUP, [m4_defn([acl_libsinpackage_]PACKUP)[, ]],)[lib$1]) - popdef([PACKUP]) - popdef([PACK]) -]) - -dnl AC_LIB_LINKFLAGS_BODY(name [, dependencies]) searches for libname and -dnl the libraries corresponding to explicit and implicit dependencies. -dnl Sets the LIB${NAME}, LTLIB${NAME} and INC${NAME} variables. -dnl Also, sets the LIB${NAME}_PREFIX variable to nonempty if libname was found -dnl in ${LIB${NAME}_PREFIX}/$acl_libdirstem. -AC_DEFUN([AC_LIB_LINKFLAGS_BODY], -[ - AC_REQUIRE([AC_LIB_PREPARE_MULTILIB]) - pushdef([NAME],[m4_translit([$1],[abcdefghijklmnopqrstuvwxyz./+-], - [ABCDEFGHIJKLMNOPQRSTUVWXYZ____])]) - pushdef([PACK],[m4_ifdef([acl_frompackage_]NAME, [acl_frompackage_]NAME, lib[$1])]) - pushdef([PACKUP],[m4_translit(PACK,[abcdefghijklmnopqrstuvwxyz./+-], - [ABCDEFGHIJKLMNOPQRSTUVWXYZ____])]) - pushdef([PACKLIBS],[m4_ifdef([acl_frompackage_]NAME, [acl_libsinpackage_]PACKUP, lib[$1])]) - dnl Autoconf >= 2.61 supports dots in --with options. - pushdef([P_A_C_K],[m4_if(m4_version_compare(m4_defn([m4_PACKAGE_VERSION]),[2.61]),[-1],[m4_translit(PACK,[.],[_])],PACK)]) - dnl By default, look in $includedir and $libdir. - use_additional=yes - AC_LIB_WITH_FINAL_PREFIX([ - eval additional_includedir=\"$includedir\" - eval additional_libdir=\"$libdir\" - ]) - AC_ARG_WITH(P_A_C_K[-prefix], -[[ --with-]]P_A_C_K[[-prefix[=DIR] search for ]PACKLIBS[ in DIR/include and DIR/lib - --without-]]P_A_C_K[[-prefix don't search for ]PACKLIBS[ in includedir and libdir]], -[ - if test "X$withval" = "Xno"; then - use_additional=no - else - if test "X$withval" = "X"; then - AC_LIB_WITH_FINAL_PREFIX([ - eval additional_includedir=\"$includedir\" - eval additional_libdir=\"$libdir\" - ]) - else - additional_includedir="$withval/include" - additional_libdir="$withval/$acl_libdirstem" - if test "$acl_libdirstem2" != "$acl_libdirstem" \ - && ! test -d "$withval/$acl_libdirstem"; then - additional_libdir="$withval/$acl_libdirstem2" - fi - fi - fi -]) - dnl Search the library and its dependencies in $additional_libdir and - dnl $LDFLAGS. Using breadth-first-seach. - LIB[]NAME= - LTLIB[]NAME= - INC[]NAME= - LIB[]NAME[]_PREFIX= - dnl HAVE_LIB${NAME} is an indicator that LIB${NAME}, LTLIB${NAME} have been - dnl computed. So it has to be reset here. - HAVE_LIB[]NAME= - rpathdirs= - ltrpathdirs= - names_already_handled= - names_next_round='$1 $2' - while test -n "$names_next_round"; do - names_this_round="$names_next_round" - names_next_round= - for name in $names_this_round; do - already_handled= - for n in $names_already_handled; do - if test "$n" = "$name"; then - already_handled=yes - break - fi - done - if test -z "$already_handled"; then - names_already_handled="$names_already_handled $name" - dnl See if it was already located by an earlier AC_LIB_LINKFLAGS - dnl or AC_LIB_HAVE_LINKFLAGS call. - uppername=`echo "$name" | sed -e 'y|abcdefghijklmnopqrstuvwxyz./+-|ABCDEFGHIJKLMNOPQRSTUVWXYZ____|'` - eval value=\"\$HAVE_LIB$uppername\" - if test -n "$value"; then - if test "$value" = yes; then - eval value=\"\$LIB$uppername\" - test -z "$value" || LIB[]NAME="${LIB[]NAME}${LIB[]NAME:+ }$value" - eval value=\"\$LTLIB$uppername\" - test -z "$value" || LTLIB[]NAME="${LTLIB[]NAME}${LTLIB[]NAME:+ }$value" - else - dnl An earlier call to AC_LIB_HAVE_LINKFLAGS has determined - dnl that this library doesn't exist. So just drop it. - : - fi - else - dnl Search the library lib$name in $additional_libdir and $LDFLAGS - dnl and the already constructed $LIBNAME/$LTLIBNAME. - found_dir= - found_la= - found_so= - found_a= - eval libname=\"$acl_libname_spec\" # typically: libname=lib$name - if test -n "$acl_shlibext"; then - shrext=".$acl_shlibext" # typically: shrext=.so - else - shrext= - fi - if test $use_additional = yes; then - dir="$additional_libdir" - dnl The same code as in the loop below: - dnl First look for a shared library. - if test -n "$acl_shlibext"; then - if test -f "$dir/$libname$shrext"; then - found_dir="$dir" - found_so="$dir/$libname$shrext" - else - if test "$acl_library_names_spec" = '$libname$shrext$versuffix'; then - ver=`(cd "$dir" && \ - for f in "$libname$shrext".*; do echo "$f"; done \ - | sed -e "s,^$libname$shrext\\\\.,," \ - | sort -t '.' -n -r -k1,1 -k2,2 -k3,3 -k4,4 -k5,5 \ - | sed 1q ) 2>/dev/null` - if test -n "$ver" && test -f "$dir/$libname$shrext.$ver"; then - found_dir="$dir" - found_so="$dir/$libname$shrext.$ver" - fi - else - eval library_names=\"$acl_library_names_spec\" - for f in $library_names; do - if test -f "$dir/$f"; then - found_dir="$dir" - found_so="$dir/$f" - break - fi - done - fi - fi - fi - dnl Then look for a static library. - if test "X$found_dir" = "X"; then - if test -f "$dir/$libname.$acl_libext"; then - found_dir="$dir" - found_a="$dir/$libname.$acl_libext" - fi - fi - if test "X$found_dir" != "X"; then - if test -f "$dir/$libname.la"; then - found_la="$dir/$libname.la" - fi - fi - fi - if test "X$found_dir" = "X"; then - for x in $LDFLAGS $LTLIB[]NAME; do - AC_LIB_WITH_FINAL_PREFIX([eval x=\"$x\"]) - case "$x" in - -L*) - dir=`echo "X$x" | sed -e 's/^X-L//'` - dnl First look for a shared library. - if test -n "$acl_shlibext"; then - if test -f "$dir/$libname$shrext"; then - found_dir="$dir" - found_so="$dir/$libname$shrext" - else - if test "$acl_library_names_spec" = '$libname$shrext$versuffix'; then - ver=`(cd "$dir" && \ - for f in "$libname$shrext".*; do echo "$f"; done \ - | sed -e "s,^$libname$shrext\\\\.,," \ - | sort -t '.' -n -r -k1,1 -k2,2 -k3,3 -k4,4 -k5,5 \ - | sed 1q ) 2>/dev/null` - if test -n "$ver" && test -f "$dir/$libname$shrext.$ver"; then - found_dir="$dir" - found_so="$dir/$libname$shrext.$ver" - fi - else - eval library_names=\"$acl_library_names_spec\" - for f in $library_names; do - if test -f "$dir/$f"; then - found_dir="$dir" - found_so="$dir/$f" - break - fi - done - fi - fi - fi - dnl Then look for a static library. - if test "X$found_dir" = "X"; then - if test -f "$dir/$libname.$acl_libext"; then - found_dir="$dir" - found_a="$dir/$libname.$acl_libext" - fi - fi - if test "X$found_dir" != "X"; then - if test -f "$dir/$libname.la"; then - found_la="$dir/$libname.la" - fi - fi - ;; - esac - if test "X$found_dir" != "X"; then - break - fi - done - fi - if test "X$found_dir" != "X"; then - dnl Found the library. - LTLIB[]NAME="${LTLIB[]NAME}${LTLIB[]NAME:+ }-L$found_dir -l$name" - if test "X$found_so" != "X"; then - dnl Linking with a shared library. We attempt to hardcode its - dnl directory into the executable's runpath, unless it's the - dnl standard /usr/lib. - if test "$enable_rpath" = no \ - || test "X$found_dir" = "X/usr/$acl_libdirstem" \ - || test "X$found_dir" = "X/usr/$acl_libdirstem2"; then - dnl No hardcoding is needed. - LIB[]NAME="${LIB[]NAME}${LIB[]NAME:+ }$found_so" - else - dnl Use an explicit option to hardcode DIR into the resulting - dnl binary. - dnl Potentially add DIR to ltrpathdirs. - dnl The ltrpathdirs will be appended to $LTLIBNAME at the end. - haveit= - for x in $ltrpathdirs; do - if test "X$x" = "X$found_dir"; then - haveit=yes - break - fi - done - if test -z "$haveit"; then - ltrpathdirs="$ltrpathdirs $found_dir" - fi - dnl The hardcoding into $LIBNAME is system dependent. - if test "$acl_hardcode_direct" = yes; then - dnl Using DIR/libNAME.so during linking hardcodes DIR into the - dnl resulting binary. - LIB[]NAME="${LIB[]NAME}${LIB[]NAME:+ }$found_so" - else - if test -n "$acl_hardcode_libdir_flag_spec" && test "$acl_hardcode_minus_L" = no; then - dnl Use an explicit option to hardcode DIR into the resulting - dnl binary. - LIB[]NAME="${LIB[]NAME}${LIB[]NAME:+ }$found_so" - dnl Potentially add DIR to rpathdirs. - dnl The rpathdirs will be appended to $LIBNAME at the end. - haveit= - for x in $rpathdirs; do - if test "X$x" = "X$found_dir"; then - haveit=yes - break - fi - done - if test -z "$haveit"; then - rpathdirs="$rpathdirs $found_dir" - fi - else - dnl Rely on "-L$found_dir". - dnl But don't add it if it's already contained in the LDFLAGS - dnl or the already constructed $LIBNAME - haveit= - for x in $LDFLAGS $LIB[]NAME; do - AC_LIB_WITH_FINAL_PREFIX([eval x=\"$x\"]) - if test "X$x" = "X-L$found_dir"; then - haveit=yes - break - fi - done - if test -z "$haveit"; then - LIB[]NAME="${LIB[]NAME}${LIB[]NAME:+ }-L$found_dir" - fi - if test "$acl_hardcode_minus_L" != no; then - dnl FIXME: Not sure whether we should use - dnl "-L$found_dir -l$name" or "-L$found_dir $found_so" - dnl here. - LIB[]NAME="${LIB[]NAME}${LIB[]NAME:+ }$found_so" - else - dnl We cannot use $acl_hardcode_runpath_var and LD_RUN_PATH - dnl here, because this doesn't fit in flags passed to the - dnl compiler. So give up. No hardcoding. This affects only - dnl very old systems. - dnl FIXME: Not sure whether we should use - dnl "-L$found_dir -l$name" or "-L$found_dir $found_so" - dnl here. - LIB[]NAME="${LIB[]NAME}${LIB[]NAME:+ }-l$name" - fi - fi - fi - fi - else - if test "X$found_a" != "X"; then - dnl Linking with a static library. - LIB[]NAME="${LIB[]NAME}${LIB[]NAME:+ }$found_a" - else - dnl We shouldn't come here, but anyway it's good to have a - dnl fallback. - LIB[]NAME="${LIB[]NAME}${LIB[]NAME:+ }-L$found_dir -l$name" - fi - fi - dnl Assume the include files are nearby. - additional_includedir= - case "$found_dir" in - */$acl_libdirstem | */$acl_libdirstem/) - basedir=`echo "X$found_dir" | sed -e 's,^X,,' -e "s,/$acl_libdirstem/"'*$,,'` - if test "$name" = '$1'; then - LIB[]NAME[]_PREFIX="$basedir" - fi - additional_includedir="$basedir/include" - ;; - */$acl_libdirstem2 | */$acl_libdirstem2/) - basedir=`echo "X$found_dir" | sed -e 's,^X,,' -e "s,/$acl_libdirstem2/"'*$,,'` - if test "$name" = '$1'; then - LIB[]NAME[]_PREFIX="$basedir" - fi - additional_includedir="$basedir/include" - ;; - esac - if test "X$additional_includedir" != "X"; then - dnl Potentially add $additional_includedir to $INCNAME. - dnl But don't add it - dnl 1. if it's the standard /usr/include, - dnl 2. if it's /usr/local/include and we are using GCC on Linux, - dnl 3. if it's already present in $CPPFLAGS or the already - dnl constructed $INCNAME, - dnl 4. if it doesn't exist as a directory. - if test "X$additional_includedir" != "X/usr/include"; then - haveit= - if test "X$additional_includedir" = "X/usr/local/include"; then - if test -n "$GCC"; then - case $host_os in - linux* | gnu* | k*bsd*-gnu) haveit=yes;; - esac - fi - fi - if test -z "$haveit"; then - for x in $CPPFLAGS $INC[]NAME; do - AC_LIB_WITH_FINAL_PREFIX([eval x=\"$x\"]) - if test "X$x" = "X-I$additional_includedir"; then - haveit=yes - break - fi - done - if test -z "$haveit"; then - if test -d "$additional_includedir"; then - dnl Really add $additional_includedir to $INCNAME. - INC[]NAME="${INC[]NAME}${INC[]NAME:+ }-I$additional_includedir" - fi - fi - fi - fi - fi - dnl Look for dependencies. - if test -n "$found_la"; then - dnl Read the .la file. It defines the variables - dnl dlname, library_names, old_library, dependency_libs, current, - dnl age, revision, installed, dlopen, dlpreopen, libdir. - save_libdir="$libdir" - case "$found_la" in - */* | *\\*) . "$found_la" ;; - *) . "./$found_la" ;; - esac - libdir="$save_libdir" - dnl We use only dependency_libs. - for dep in $dependency_libs; do - case "$dep" in - -L*) - additional_libdir=`echo "X$dep" | sed -e 's/^X-L//'` - dnl Potentially add $additional_libdir to $LIBNAME and $LTLIBNAME. - dnl But don't add it - dnl 1. if it's the standard /usr/lib, - dnl 2. if it's /usr/local/lib and we are using GCC on Linux, - dnl 3. if it's already present in $LDFLAGS or the already - dnl constructed $LIBNAME, - dnl 4. if it doesn't exist as a directory. - if test "X$additional_libdir" != "X/usr/$acl_libdirstem" \ - && test "X$additional_libdir" != "X/usr/$acl_libdirstem2"; then - haveit= - if test "X$additional_libdir" = "X/usr/local/$acl_libdirstem" \ - || test "X$additional_libdir" = "X/usr/local/$acl_libdirstem2"; then - if test -n "$GCC"; then - case $host_os in - linux* | gnu* | k*bsd*-gnu) haveit=yes;; - esac - fi - fi - if test -z "$haveit"; then - haveit= - for x in $LDFLAGS $LIB[]NAME; do - AC_LIB_WITH_FINAL_PREFIX([eval x=\"$x\"]) - if test "X$x" = "X-L$additional_libdir"; then - haveit=yes - break - fi - done - if test -z "$haveit"; then - if test -d "$additional_libdir"; then - dnl Really add $additional_libdir to $LIBNAME. - LIB[]NAME="${LIB[]NAME}${LIB[]NAME:+ }-L$additional_libdir" - fi - fi - haveit= - for x in $LDFLAGS $LTLIB[]NAME; do - AC_LIB_WITH_FINAL_PREFIX([eval x=\"$x\"]) - if test "X$x" = "X-L$additional_libdir"; then - haveit=yes - break - fi - done - if test -z "$haveit"; then - if test -d "$additional_libdir"; then - dnl Really add $additional_libdir to $LTLIBNAME. - LTLIB[]NAME="${LTLIB[]NAME}${LTLIB[]NAME:+ }-L$additional_libdir" - fi - fi - fi - fi - ;; - -R*) - dir=`echo "X$dep" | sed -e 's/^X-R//'` - if test "$enable_rpath" != no; then - dnl Potentially add DIR to rpathdirs. - dnl The rpathdirs will be appended to $LIBNAME at the end. - haveit= - for x in $rpathdirs; do - if test "X$x" = "X$dir"; then - haveit=yes - break - fi - done - if test -z "$haveit"; then - rpathdirs="$rpathdirs $dir" - fi - dnl Potentially add DIR to ltrpathdirs. - dnl The ltrpathdirs will be appended to $LTLIBNAME at the end. - haveit= - for x in $ltrpathdirs; do - if test "X$x" = "X$dir"; then - haveit=yes - break - fi - done - if test -z "$haveit"; then - ltrpathdirs="$ltrpathdirs $dir" - fi - fi - ;; - -l*) - dnl Handle this in the next round. - names_next_round="$names_next_round "`echo "X$dep" | sed -e 's/^X-l//'` - ;; - *.la) - dnl Handle this in the next round. Throw away the .la's - dnl directory; it is already contained in a preceding -L - dnl option. - names_next_round="$names_next_round "`echo "X$dep" | sed -e 's,^X.*/,,' -e 's,^lib,,' -e 's,\.la$,,'` - ;; - *) - dnl Most likely an immediate library name. - LIB[]NAME="${LIB[]NAME}${LIB[]NAME:+ }$dep" - LTLIB[]NAME="${LTLIB[]NAME}${LTLIB[]NAME:+ }$dep" - ;; - esac - done - fi - else - dnl Didn't find the library; assume it is in the system directories - dnl known to the linker and runtime loader. (All the system - dnl directories known to the linker should also be known to the - dnl runtime loader, otherwise the system is severely misconfigured.) - LIB[]NAME="${LIB[]NAME}${LIB[]NAME:+ }-l$name" - LTLIB[]NAME="${LTLIB[]NAME}${LTLIB[]NAME:+ }-l$name" - fi - fi - fi - done - done - if test "X$rpathdirs" != "X"; then - if test -n "$acl_hardcode_libdir_separator"; then - dnl Weird platform: only the last -rpath option counts, the user must - dnl pass all path elements in one option. We can arrange that for a - dnl single library, but not when more than one $LIBNAMEs are used. - alldirs= - for found_dir in $rpathdirs; do - alldirs="${alldirs}${alldirs:+$acl_hardcode_libdir_separator}$found_dir" - done - dnl Note: acl_hardcode_libdir_flag_spec uses $libdir and $wl. - acl_save_libdir="$libdir" - libdir="$alldirs" - eval flag=\"$acl_hardcode_libdir_flag_spec\" - libdir="$acl_save_libdir" - LIB[]NAME="${LIB[]NAME}${LIB[]NAME:+ }$flag" - else - dnl The -rpath options are cumulative. - for found_dir in $rpathdirs; do - acl_save_libdir="$libdir" - libdir="$found_dir" - eval flag=\"$acl_hardcode_libdir_flag_spec\" - libdir="$acl_save_libdir" - LIB[]NAME="${LIB[]NAME}${LIB[]NAME:+ }$flag" - done - fi - fi - if test "X$ltrpathdirs" != "X"; then - dnl When using libtool, the option that works for both libraries and - dnl executables is -R. The -R options are cumulative. - for found_dir in $ltrpathdirs; do - LTLIB[]NAME="${LTLIB[]NAME}${LTLIB[]NAME:+ }-R$found_dir" - done - fi - popdef([P_A_C_K]) - popdef([PACKLIBS]) - popdef([PACKUP]) - popdef([PACK]) - popdef([NAME]) -]) - -dnl AC_LIB_APPENDTOVAR(VAR, CONTENTS) appends the elements of CONTENTS to VAR, -dnl unless already present in VAR. -dnl Works only for CPPFLAGS, not for LIB* variables because that sometimes -dnl contains two or three consecutive elements that belong together. -AC_DEFUN([AC_LIB_APPENDTOVAR], -[ - for element in [$2]; do - haveit= - for x in $[$1]; do - AC_LIB_WITH_FINAL_PREFIX([eval x=\"$x\"]) - if test "X$x" = "X$element"; then - haveit=yes - break - fi - done - if test -z "$haveit"; then - [$1]="${[$1]}${[$1]:+ }$element" - fi - done -]) - -dnl For those cases where a variable contains several -L and -l options -dnl referring to unknown libraries and directories, this macro determines the -dnl necessary additional linker options for the runtime path. -dnl AC_LIB_LINKFLAGS_FROM_LIBS([LDADDVAR], [LIBSVALUE], [USE-LIBTOOL]) -dnl sets LDADDVAR to linker options needed together with LIBSVALUE. -dnl If USE-LIBTOOL evaluates to non-empty, linking with libtool is assumed, -dnl otherwise linking without libtool is assumed. -AC_DEFUN([AC_LIB_LINKFLAGS_FROM_LIBS], -[ - AC_REQUIRE([AC_LIB_RPATH]) - AC_REQUIRE([AC_LIB_PREPARE_MULTILIB]) - $1= - if test "$enable_rpath" != no; then - if test -n "$acl_hardcode_libdir_flag_spec" && test "$acl_hardcode_minus_L" = no; then - dnl Use an explicit option to hardcode directories into the resulting - dnl binary. - rpathdirs= - next= - for opt in $2; do - if test -n "$next"; then - dir="$next" - dnl No need to hardcode the standard /usr/lib. - if test "X$dir" != "X/usr/$acl_libdirstem" \ - && test "X$dir" != "X/usr/$acl_libdirstem2"; then - rpathdirs="$rpathdirs $dir" - fi - next= - else - case $opt in - -L) next=yes ;; - -L*) dir=`echo "X$opt" | sed -e 's,^X-L,,'` - dnl No need to hardcode the standard /usr/lib. - if test "X$dir" != "X/usr/$acl_libdirstem" \ - && test "X$dir" != "X/usr/$acl_libdirstem2"; then - rpathdirs="$rpathdirs $dir" - fi - next= ;; - *) next= ;; - esac - fi - done - if test "X$rpathdirs" != "X"; then - if test -n ""$3""; then - dnl libtool is used for linking. Use -R options. - for dir in $rpathdirs; do - $1="${$1}${$1:+ }-R$dir" - done - else - dnl The linker is used for linking directly. - if test -n "$acl_hardcode_libdir_separator"; then - dnl Weird platform: only the last -rpath option counts, the user - dnl must pass all path elements in one option. - alldirs= - for dir in $rpathdirs; do - alldirs="${alldirs}${alldirs:+$acl_hardcode_libdir_separator}$dir" - done - acl_save_libdir="$libdir" - libdir="$alldirs" - eval flag=\"$acl_hardcode_libdir_flag_spec\" - libdir="$acl_save_libdir" - $1="$flag" - else - dnl The -rpath options are cumulative. - for dir in $rpathdirs; do - acl_save_libdir="$libdir" - libdir="$dir" - eval flag=\"$acl_hardcode_libdir_flag_spec\" - libdir="$acl_save_libdir" - $1="${$1}${$1:+ }$flag" - done - fi - fi - fi - fi - fi - AC_SUBST([$1]) -]) diff -Nru gnucobol-4.0~early~20200606/m4/lib-prefix.m4 gnucobol-5/m4/lib-prefix.m4 --- gnucobol-4.0~early~20200606/m4/lib-prefix.m4 2020-06-06 20:56:36.000000000 +0000 +++ gnucobol-5/m4/lib-prefix.m4 1970-01-01 00:00:00.000000000 +0000 @@ -1,224 +0,0 @@ -# lib-prefix.m4 serial 7 (gettext-0.18) -dnl Copyright (C) 2001-2005, 2008-2016 Free Software Foundation, Inc. -dnl This file is free software; the Free Software Foundation -dnl gives unlimited permission to copy and/or distribute it, -dnl with or without modifications, as long as this notice is preserved. - -dnl From Bruno Haible. - -dnl AC_LIB_ARG_WITH is synonymous to AC_ARG_WITH in autoconf-2.13, and -dnl similar to AC_ARG_WITH in autoconf 2.52...2.57 except that is doesn't -dnl require excessive bracketing. -ifdef([AC_HELP_STRING], -[AC_DEFUN([AC_LIB_ARG_WITH], [AC_ARG_WITH([$1],[[$2]],[$3],[$4])])], -[AC_DEFUN([AC_][LIB_ARG_WITH], [AC_ARG_WITH([$1],[$2],[$3],[$4])])]) - -dnl AC_LIB_PREFIX adds to the CPPFLAGS and LDFLAGS the flags that are needed -dnl to access previously installed libraries. The basic assumption is that -dnl a user will want packages to use other packages he previously installed -dnl with the same --prefix option. -dnl This macro is not needed if only AC_LIB_LINKFLAGS is used to locate -dnl libraries, but is otherwise very convenient. -AC_DEFUN([AC_LIB_PREFIX], -[ - AC_BEFORE([$0], [AC_LIB_LINKFLAGS]) - AC_REQUIRE([AC_PROG_CC]) - AC_REQUIRE([AC_CANONICAL_HOST]) - AC_REQUIRE([AC_LIB_PREPARE_MULTILIB]) - AC_REQUIRE([AC_LIB_PREPARE_PREFIX]) - dnl By default, look in $includedir and $libdir. - use_additional=yes - AC_LIB_WITH_FINAL_PREFIX([ - eval additional_includedir=\"$includedir\" - eval additional_libdir=\"$libdir\" - ]) - AC_LIB_ARG_WITH([lib-prefix], -[ --with-lib-prefix[=DIR] search for libraries in DIR/include and DIR/lib - --without-lib-prefix don't search for libraries in includedir and libdir], -[ - if test "X$withval" = "Xno"; then - use_additional=no - else - if test "X$withval" = "X"; then - AC_LIB_WITH_FINAL_PREFIX([ - eval additional_includedir=\"$includedir\" - eval additional_libdir=\"$libdir\" - ]) - else - additional_includedir="$withval/include" - additional_libdir="$withval/$acl_libdirstem" - fi - fi -]) - if test $use_additional = yes; then - dnl Potentially add $additional_includedir to $CPPFLAGS. - dnl But don't add it - dnl 1. if it's the standard /usr/include, - dnl 2. if it's already present in $CPPFLAGS, - dnl 3. if it's /usr/local/include and we are using GCC on Linux, - dnl 4. if it doesn't exist as a directory. - if test "X$additional_includedir" != "X/usr/include"; then - haveit= - for x in $CPPFLAGS; do - AC_LIB_WITH_FINAL_PREFIX([eval x=\"$x\"]) - if test "X$x" = "X-I$additional_includedir"; then - haveit=yes - break - fi - done - if test -z "$haveit"; then - if test "X$additional_includedir" = "X/usr/local/include"; then - if test -n "$GCC"; then - case $host_os in - linux* | gnu* | k*bsd*-gnu) haveit=yes;; - esac - fi - fi - if test -z "$haveit"; then - if test -d "$additional_includedir"; then - dnl Really add $additional_includedir to $CPPFLAGS. - CPPFLAGS="${CPPFLAGS}${CPPFLAGS:+ }-I$additional_includedir" - fi - fi - fi - fi - dnl Potentially add $additional_libdir to $LDFLAGS. - dnl But don't add it - dnl 1. if it's the standard /usr/lib, - dnl 2. if it's already present in $LDFLAGS, - dnl 3. if it's /usr/local/lib and we are using GCC on Linux, - dnl 4. if it doesn't exist as a directory. - if test "X$additional_libdir" != "X/usr/$acl_libdirstem"; then - haveit= - for x in $LDFLAGS; do - AC_LIB_WITH_FINAL_PREFIX([eval x=\"$x\"]) - if test "X$x" = "X-L$additional_libdir"; then - haveit=yes - break - fi - done - if test -z "$haveit"; then - if test "X$additional_libdir" = "X/usr/local/$acl_libdirstem"; then - if test -n "$GCC"; then - case $host_os in - linux*) haveit=yes;; - esac - fi - fi - if test -z "$haveit"; then - if test -d "$additional_libdir"; then - dnl Really add $additional_libdir to $LDFLAGS. - LDFLAGS="${LDFLAGS}${LDFLAGS:+ }-L$additional_libdir" - fi - fi - fi - fi - fi -]) - -dnl AC_LIB_PREPARE_PREFIX creates variables acl_final_prefix, -dnl acl_final_exec_prefix, containing the values to which $prefix and -dnl $exec_prefix will expand at the end of the configure script. -AC_DEFUN([AC_LIB_PREPARE_PREFIX], -[ - dnl Unfortunately, prefix and exec_prefix get only finally determined - dnl at the end of configure. - if test "X$prefix" = "XNONE"; then - acl_final_prefix="$ac_default_prefix" - else - acl_final_prefix="$prefix" - fi - if test "X$exec_prefix" = "XNONE"; then - acl_final_exec_prefix='${prefix}' - else - acl_final_exec_prefix="$exec_prefix" - fi - acl_save_prefix="$prefix" - prefix="$acl_final_prefix" - eval acl_final_exec_prefix=\"$acl_final_exec_prefix\" - prefix="$acl_save_prefix" -]) - -dnl AC_LIB_WITH_FINAL_PREFIX([statement]) evaluates statement, with the -dnl variables prefix and exec_prefix bound to the values they will have -dnl at the end of the configure script. -AC_DEFUN([AC_LIB_WITH_FINAL_PREFIX], -[ - acl_save_prefix="$prefix" - prefix="$acl_final_prefix" - acl_save_exec_prefix="$exec_prefix" - exec_prefix="$acl_final_exec_prefix" - $1 - exec_prefix="$acl_save_exec_prefix" - prefix="$acl_save_prefix" -]) - -dnl AC_LIB_PREPARE_MULTILIB creates -dnl - a variable acl_libdirstem, containing the basename of the libdir, either -dnl "lib" or "lib64" or "lib/64", -dnl - a variable acl_libdirstem2, as a secondary possible value for -dnl acl_libdirstem, either the same as acl_libdirstem or "lib/sparcv9" or -dnl "lib/amd64". -AC_DEFUN([AC_LIB_PREPARE_MULTILIB], -[ - dnl There is no formal standard regarding lib and lib64. - dnl On glibc systems, the current practice is that on a system supporting - dnl 32-bit and 64-bit instruction sets or ABIs, 64-bit libraries go under - dnl $prefix/lib64 and 32-bit libraries go under $prefix/lib. We determine - dnl the compiler's default mode by looking at the compiler's library search - dnl path. If at least one of its elements ends in /lib64 or points to a - dnl directory whose absolute pathname ends in /lib64, we assume a 64-bit ABI. - dnl Otherwise we use the default, namely "lib". - dnl On Solaris systems, the current practice is that on a system supporting - dnl 32-bit and 64-bit instruction sets or ABIs, 64-bit libraries go under - dnl $prefix/lib/64 (which is a symlink to either $prefix/lib/sparcv9 or - dnl $prefix/lib/amd64) and 32-bit libraries go under $prefix/lib. - AC_REQUIRE([AC_CANONICAL_HOST]) - acl_libdirstem=lib - acl_libdirstem2= - case "$host_os" in - solaris*) - dnl See Solaris 10 Software Developer Collection > Solaris 64-bit Developer's Guide > The Development Environment - dnl . - dnl "Portable Makefiles should refer to any library directories using the 64 symbolic link." - dnl But we want to recognize the sparcv9 or amd64 subdirectory also if the - dnl symlink is missing, so we set acl_libdirstem2 too. - AC_CACHE_CHECK([for 64-bit host], [gl_cv_solaris_64bit], - [AC_EGREP_CPP([sixtyfour bits], [ -#ifdef _LP64 -sixtyfour bits -#endif - ], [gl_cv_solaris_64bit=yes], [gl_cv_solaris_64bit=no]) - ]) - if test $gl_cv_solaris_64bit = yes; then - acl_libdirstem=lib/64 - case "$host_cpu" in - sparc*) acl_libdirstem2=lib/sparcv9 ;; - i*86 | x86_64) acl_libdirstem2=lib/amd64 ;; - esac - fi - ;; - *) - searchpath=`(LC_ALL=C $CC -print-search-dirs) 2>/dev/null | sed -n -e 's,^libraries: ,,p' | sed -e 's,^=,,'` - if test -n "$searchpath"; then - acl_save_IFS="${IFS= }"; IFS=":" - for searchdir in $searchpath; do - if test -d "$searchdir"; then - case "$searchdir" in - */lib64/ | */lib64 ) acl_libdirstem=lib64 ;; - */../ | */.. ) - # Better ignore directories of this form. They are misleading. - ;; - *) searchdir=`cd "$searchdir" && pwd` - case "$searchdir" in - */lib64 ) acl_libdirstem=lib64 ;; - esac ;; - esac - fi - done - IFS="$acl_save_IFS" - fi - ;; - esac - test -n "$acl_libdirstem2" || acl_libdirstem2="$acl_libdirstem" -]) diff -Nru gnucobol-4.0~early~20200606/m4/libtool.m4 gnucobol-5/m4/libtool.m4 --- gnucobol-4.0~early~20200606/m4/libtool.m4 2020-06-06 20:56:36.000000000 +0000 +++ gnucobol-5/m4/libtool.m4 1970-01-01 00:00:00.000000000 +0000 @@ -1,8369 +0,0 @@ -# libtool.m4 - Configure libtool for the host system. -*-Autoconf-*- -# -# Copyright (C) 1996-2001, 2003-2015 Free Software Foundation, Inc. -# Written by Gordon Matzigkeit, 1996 -# -# This file is free software; the Free Software Foundation gives -# unlimited permission to copy and/or distribute it, with or without -# modifications, as long as this notice is preserved. - -m4_define([_LT_COPYING], [dnl -# Copyright (C) 2014 Free Software Foundation, Inc. -# This is free software; see the source for copying conditions. There is NO -# warranty; not even for MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. - -# GNU Libtool is free software; you can redistribute it and/or modify -# it under the terms of the GNU General Public License as published by -# the Free Software Foundation; either version 2 of of the License, or -# (at your option) any later version. -# -# As a special exception to the GNU General Public License, if you -# distribute this file as part of a program or library that is built -# using GNU Libtool, you may include this file under the same -# distribution terms that you use for the rest of that program. -# -# GNU Libtool is distributed in the hope that it will be useful, but -# WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -# GNU General Public License for more details. -# -# You should have received a copy of the GNU General Public License -# along with this program. If not, see . -]) - -# serial 58 LT_INIT - - -# LT_PREREQ(VERSION) -# ------------------ -# Complain and exit if this libtool version is less that VERSION. -m4_defun([LT_PREREQ], -[m4_if(m4_version_compare(m4_defn([LT_PACKAGE_VERSION]), [$1]), -1, - [m4_default([$3], - [m4_fatal([Libtool version $1 or higher is required], - 63)])], - [$2])]) - - -# _LT_CHECK_BUILDDIR -# ------------------ -# Complain if the absolute build directory name contains unusual characters -m4_defun([_LT_CHECK_BUILDDIR], -[case `pwd` in - *\ * | *\ *) - AC_MSG_WARN([Libtool does not cope well with whitespace in `pwd`]) ;; -esac -]) - - -# LT_INIT([OPTIONS]) -# ------------------ -AC_DEFUN([LT_INIT], -[AC_PREREQ([2.62])dnl We use AC_PATH_PROGS_FEATURE_CHECK -AC_REQUIRE([AC_CONFIG_AUX_DIR_DEFAULT])dnl -AC_BEFORE([$0], [LT_LANG])dnl -AC_BEFORE([$0], [LT_OUTPUT])dnl -AC_BEFORE([$0], [LTDL_INIT])dnl -m4_require([_LT_CHECK_BUILDDIR])dnl - -dnl Autoconf doesn't catch unexpanded LT_ macros by default: -m4_pattern_forbid([^_?LT_[A-Z_]+$])dnl -m4_pattern_allow([^(_LT_EOF|LT_DLGLOBAL|LT_DLLAZY_OR_NOW|LT_MULTI_MODULE)$])dnl -dnl aclocal doesn't pull ltoptions.m4, ltsugar.m4, or ltversion.m4 -dnl unless we require an AC_DEFUNed macro: -AC_REQUIRE([LTOPTIONS_VERSION])dnl -AC_REQUIRE([LTSUGAR_VERSION])dnl -AC_REQUIRE([LTVERSION_VERSION])dnl -AC_REQUIRE([LTOBSOLETE_VERSION])dnl -m4_require([_LT_PROG_LTMAIN])dnl - -_LT_SHELL_INIT([SHELL=${CONFIG_SHELL-/bin/sh}]) - -dnl Parse OPTIONS -_LT_SET_OPTIONS([$0], [$1]) - -# This can be used to rebuild libtool when needed -LIBTOOL_DEPS=$ltmain - -# Always use our own libtool. -LIBTOOL='$(SHELL) $(top_builddir)/libtool' -AC_SUBST(LIBTOOL)dnl - -_LT_SETUP - -# Only expand once: -m4_define([LT_INIT]) -])# LT_INIT - -# Old names: -AU_ALIAS([AC_PROG_LIBTOOL], [LT_INIT]) -AU_ALIAS([AM_PROG_LIBTOOL], [LT_INIT]) -dnl aclocal-1.4 backwards compatibility: -dnl AC_DEFUN([AC_PROG_LIBTOOL], []) -dnl AC_DEFUN([AM_PROG_LIBTOOL], []) - - -# _LT_PREPARE_CC_BASENAME -# ----------------------- -m4_defun([_LT_PREPARE_CC_BASENAME], [ -# Calculate cc_basename. Skip known compiler wrappers and cross-prefix. -func_cc_basename () -{ - for cc_temp in @S|@*""; do - case $cc_temp in - compile | *[[\\/]]compile | ccache | *[[\\/]]ccache ) ;; - distcc | *[[\\/]]distcc | purify | *[[\\/]]purify ) ;; - \-*) ;; - *) break;; - esac - done - func_cc_basename_result=`$ECHO "$cc_temp" | $SED "s%.*/%%; s%^$host_alias-%%"` -} -])# _LT_PREPARE_CC_BASENAME - - -# _LT_CC_BASENAME(CC) -# ------------------- -# It would be clearer to call AC_REQUIREs from _LT_PREPARE_CC_BASENAME, -# but that macro is also expanded into generated libtool script, which -# arranges for $SED and $ECHO to be set by different means. -m4_defun([_LT_CC_BASENAME], -[m4_require([_LT_PREPARE_CC_BASENAME])dnl -AC_REQUIRE([_LT_DECL_SED])dnl -AC_REQUIRE([_LT_PROG_ECHO_BACKSLASH])dnl -func_cc_basename $1 -cc_basename=$func_cc_basename_result -]) - - -# _LT_FILEUTILS_DEFAULTS -# ---------------------- -# It is okay to use these file commands and assume they have been set -# sensibly after 'm4_require([_LT_FILEUTILS_DEFAULTS])'. -m4_defun([_LT_FILEUTILS_DEFAULTS], -[: ${CP="cp -f"} -: ${MV="mv -f"} -: ${RM="rm -f"} -])# _LT_FILEUTILS_DEFAULTS - - -# _LT_SETUP -# --------- -m4_defun([_LT_SETUP], -[AC_REQUIRE([AC_CANONICAL_HOST])dnl -AC_REQUIRE([AC_CANONICAL_BUILD])dnl -AC_REQUIRE([_LT_PREPARE_SED_QUOTE_VARS])dnl -AC_REQUIRE([_LT_PROG_ECHO_BACKSLASH])dnl - -_LT_DECL([], [PATH_SEPARATOR], [1], [The PATH separator for the build system])dnl -dnl -_LT_DECL([], [host_alias], [0], [The host system])dnl -_LT_DECL([], [host], [0])dnl -_LT_DECL([], [host_os], [0])dnl -dnl -_LT_DECL([], [build_alias], [0], [The build system])dnl -_LT_DECL([], [build], [0])dnl -_LT_DECL([], [build_os], [0])dnl -dnl -AC_REQUIRE([AC_PROG_CC])dnl -AC_REQUIRE([LT_PATH_LD])dnl -AC_REQUIRE([LT_PATH_NM])dnl -dnl -AC_REQUIRE([AC_PROG_LN_S])dnl -test -z "$LN_S" && LN_S="ln -s" -_LT_DECL([], [LN_S], [1], [Whether we need soft or hard links])dnl -dnl -AC_REQUIRE([LT_CMD_MAX_LEN])dnl -_LT_DECL([objext], [ac_objext], [0], [Object file suffix (normally "o")])dnl -_LT_DECL([], [exeext], [0], [Executable file suffix (normally "")])dnl -dnl -m4_require([_LT_FILEUTILS_DEFAULTS])dnl -m4_require([_LT_CHECK_SHELL_FEATURES])dnl -m4_require([_LT_PATH_CONVERSION_FUNCTIONS])dnl -m4_require([_LT_CMD_RELOAD])dnl -m4_require([_LT_CHECK_MAGIC_METHOD])dnl -m4_require([_LT_CHECK_SHAREDLIB_FROM_LINKLIB])dnl -m4_require([_LT_CMD_OLD_ARCHIVE])dnl -m4_require([_LT_CMD_GLOBAL_SYMBOLS])dnl -m4_require([_LT_WITH_SYSROOT])dnl -m4_require([_LT_CMD_TRUNCATE])dnl - -_LT_CONFIG_LIBTOOL_INIT([ -# See if we are running on zsh, and set the options that allow our -# commands through without removal of \ escapes INIT. -if test -n "\${ZSH_VERSION+set}"; then - setopt NO_GLOB_SUBST -fi -]) -if test -n "${ZSH_VERSION+set}"; then - setopt NO_GLOB_SUBST -fi - -_LT_CHECK_OBJDIR - -m4_require([_LT_TAG_COMPILER])dnl - -case $host_os in -aix3*) - # AIX sometimes has problems with the GCC collect2 program. For some - # reason, if we set the COLLECT_NAMES environment variable, the problems - # vanish in a puff of smoke. - if test set != "${COLLECT_NAMES+set}"; then - COLLECT_NAMES= - export COLLECT_NAMES - fi - ;; -esac - -# Global variables: -ofile=libtool -can_build_shared=yes - -# All known linkers require a '.a' archive for static linking (except MSVC, -# which needs '.lib'). -libext=a - -with_gnu_ld=$lt_cv_prog_gnu_ld - -old_CC=$CC -old_CFLAGS=$CFLAGS - -# Set sane defaults for various variables -test -z "$CC" && CC=cc -test -z "$LTCC" && LTCC=$CC -test -z "$LTCFLAGS" && LTCFLAGS=$CFLAGS -test -z "$LD" && LD=ld -test -z "$ac_objext" && ac_objext=o - -_LT_CC_BASENAME([$compiler]) - -# Only perform the check for file, if the check method requires it -test -z "$MAGIC_CMD" && MAGIC_CMD=file -case $deplibs_check_method in -file_magic*) - if test "$file_magic_cmd" = '$MAGIC_CMD'; then - _LT_PATH_MAGIC - fi - ;; -esac - -# Use C for the default configuration in the libtool script -LT_SUPPORTED_TAG([CC]) -_LT_LANG_C_CONFIG -_LT_LANG_DEFAULT_CONFIG -_LT_CONFIG_COMMANDS -])# _LT_SETUP - - -# _LT_PREPARE_SED_QUOTE_VARS -# -------------------------- -# Define a few sed substitution that help us do robust quoting. -m4_defun([_LT_PREPARE_SED_QUOTE_VARS], -[# Backslashify metacharacters that are still active within -# double-quoted strings. -sed_quote_subst='s/\([["`$\\]]\)/\\\1/g' - -# Same as above, but do not quote variable references. -double_quote_subst='s/\([["`\\]]\)/\\\1/g' - -# Sed substitution to delay expansion of an escaped shell variable in a -# double_quote_subst'ed string. -delay_variable_subst='s/\\\\\\\\\\\$/\\\\\\$/g' - -# Sed substitution to delay expansion of an escaped single quote. -delay_single_quote_subst='s/'\''/'\'\\\\\\\'\''/g' - -# Sed substitution to avoid accidental globbing in evaled expressions -no_glob_subst='s/\*/\\\*/g' -]) - -# _LT_PROG_LTMAIN -# --------------- -# Note that this code is called both from 'configure', and 'config.status' -# now that we use AC_CONFIG_COMMANDS to generate libtool. Notably, -# 'config.status' has no value for ac_aux_dir unless we are using Automake, -# so we pass a copy along to make sure it has a sensible value anyway. -m4_defun([_LT_PROG_LTMAIN], -[m4_ifdef([AC_REQUIRE_AUX_FILE], [AC_REQUIRE_AUX_FILE([ltmain.sh])])dnl -_LT_CONFIG_LIBTOOL_INIT([ac_aux_dir='$ac_aux_dir']) -ltmain=$ac_aux_dir/ltmain.sh -])# _LT_PROG_LTMAIN - - -## ------------------------------------- ## -## Accumulate code for creating libtool. ## -## ------------------------------------- ## - -# So that we can recreate a full libtool script including additional -# tags, we accumulate the chunks of code to send to AC_CONFIG_COMMANDS -# in macros and then make a single call at the end using the 'libtool' -# label. - - -# _LT_CONFIG_LIBTOOL_INIT([INIT-COMMANDS]) -# ---------------------------------------- -# Register INIT-COMMANDS to be passed to AC_CONFIG_COMMANDS later. -m4_define([_LT_CONFIG_LIBTOOL_INIT], -[m4_ifval([$1], - [m4_append([_LT_OUTPUT_LIBTOOL_INIT], - [$1 -])])]) - -# Initialize. -m4_define([_LT_OUTPUT_LIBTOOL_INIT]) - - -# _LT_CONFIG_LIBTOOL([COMMANDS]) -# ------------------------------ -# Register COMMANDS to be passed to AC_CONFIG_COMMANDS later. -m4_define([_LT_CONFIG_LIBTOOL], -[m4_ifval([$1], - [m4_append([_LT_OUTPUT_LIBTOOL_COMMANDS], - [$1 -])])]) - -# Initialize. -m4_define([_LT_OUTPUT_LIBTOOL_COMMANDS]) - - -# _LT_CONFIG_SAVE_COMMANDS([COMMANDS], [INIT_COMMANDS]) -# ----------------------------------------------------- -m4_defun([_LT_CONFIG_SAVE_COMMANDS], -[_LT_CONFIG_LIBTOOL([$1]) -_LT_CONFIG_LIBTOOL_INIT([$2]) -]) - - -# _LT_FORMAT_COMMENT([COMMENT]) -# ----------------------------- -# Add leading comment marks to the start of each line, and a trailing -# full-stop to the whole comment if one is not present already. -m4_define([_LT_FORMAT_COMMENT], -[m4_ifval([$1], [ -m4_bpatsubst([m4_bpatsubst([$1], [^ *], [# ])], - [['`$\]], [\\\&])]m4_bmatch([$1], [[!?.]$], [], [.]) -)]) - - - -## ------------------------ ## -## FIXME: Eliminate VARNAME ## -## ------------------------ ## - - -# _LT_DECL([CONFIGNAME], VARNAME, VALUE, [DESCRIPTION], [IS-TAGGED?]) -# ------------------------------------------------------------------- -# CONFIGNAME is the name given to the value in the libtool script. -# VARNAME is the (base) name used in the configure script. -# VALUE may be 0, 1 or 2 for a computed quote escaped value based on -# VARNAME. Any other value will be used directly. -m4_define([_LT_DECL], -[lt_if_append_uniq([lt_decl_varnames], [$2], [, ], - [lt_dict_add_subkey([lt_decl_dict], [$2], [libtool_name], - [m4_ifval([$1], [$1], [$2])]) - lt_dict_add_subkey([lt_decl_dict], [$2], [value], [$3]) - m4_ifval([$4], - [lt_dict_add_subkey([lt_decl_dict], [$2], [description], [$4])]) - lt_dict_add_subkey([lt_decl_dict], [$2], - [tagged?], [m4_ifval([$5], [yes], [no])])]) -]) - - -# _LT_TAGDECL([CONFIGNAME], VARNAME, VALUE, [DESCRIPTION]) -# -------------------------------------------------------- -m4_define([_LT_TAGDECL], [_LT_DECL([$1], [$2], [$3], [$4], [yes])]) - - -# lt_decl_tag_varnames([SEPARATOR], [VARNAME1...]) -# ------------------------------------------------ -m4_define([lt_decl_tag_varnames], -[_lt_decl_filter([tagged?], [yes], $@)]) - - -# _lt_decl_filter(SUBKEY, VALUE, [SEPARATOR], [VARNAME1..]) -# --------------------------------------------------------- -m4_define([_lt_decl_filter], -[m4_case([$#], - [0], [m4_fatal([$0: too few arguments: $#])], - [1], [m4_fatal([$0: too few arguments: $#: $1])], - [2], [lt_dict_filter([lt_decl_dict], [$1], [$2], [], lt_decl_varnames)], - [3], [lt_dict_filter([lt_decl_dict], [$1], [$2], [$3], lt_decl_varnames)], - [lt_dict_filter([lt_decl_dict], $@)])[]dnl -]) - - -# lt_decl_quote_varnames([SEPARATOR], [VARNAME1...]) -# -------------------------------------------------- -m4_define([lt_decl_quote_varnames], -[_lt_decl_filter([value], [1], $@)]) - - -# lt_decl_dquote_varnames([SEPARATOR], [VARNAME1...]) -# --------------------------------------------------- -m4_define([lt_decl_dquote_varnames], -[_lt_decl_filter([value], [2], $@)]) - - -# lt_decl_varnames_tagged([SEPARATOR], [VARNAME1...]) -# --------------------------------------------------- -m4_define([lt_decl_varnames_tagged], -[m4_assert([$# <= 2])dnl -_$0(m4_quote(m4_default([$1], [[, ]])), - m4_ifval([$2], [[$2]], [m4_dquote(lt_decl_tag_varnames)]), - m4_split(m4_normalize(m4_quote(_LT_TAGS)), [ ]))]) -m4_define([_lt_decl_varnames_tagged], -[m4_ifval([$3], [lt_combine([$1], [$2], [_], $3)])]) - - -# lt_decl_all_varnames([SEPARATOR], [VARNAME1...]) -# ------------------------------------------------ -m4_define([lt_decl_all_varnames], -[_$0(m4_quote(m4_default([$1], [[, ]])), - m4_if([$2], [], - m4_quote(lt_decl_varnames), - m4_quote(m4_shift($@))))[]dnl -]) -m4_define([_lt_decl_all_varnames], -[lt_join($@, lt_decl_varnames_tagged([$1], - lt_decl_tag_varnames([[, ]], m4_shift($@))))dnl -]) - - -# _LT_CONFIG_STATUS_DECLARE([VARNAME]) -# ------------------------------------ -# Quote a variable value, and forward it to 'config.status' so that its -# declaration there will have the same value as in 'configure'. VARNAME -# must have a single quote delimited value for this to work. -m4_define([_LT_CONFIG_STATUS_DECLARE], -[$1='`$ECHO "$][$1" | $SED "$delay_single_quote_subst"`']) - - -# _LT_CONFIG_STATUS_DECLARATIONS -# ------------------------------ -# We delimit libtool config variables with single quotes, so when -# we write them to config.status, we have to be sure to quote all -# embedded single quotes properly. In configure, this macro expands -# each variable declared with _LT_DECL (and _LT_TAGDECL) into: -# -# ='`$ECHO "$" | $SED "$delay_single_quote_subst"`' -m4_defun([_LT_CONFIG_STATUS_DECLARATIONS], -[m4_foreach([_lt_var], m4_quote(lt_decl_all_varnames), - [m4_n([_LT_CONFIG_STATUS_DECLARE(_lt_var)])])]) - - -# _LT_LIBTOOL_TAGS -# ---------------- -# Output comment and list of tags supported by the script -m4_defun([_LT_LIBTOOL_TAGS], -[_LT_FORMAT_COMMENT([The names of the tagged configurations supported by this script])dnl -available_tags='_LT_TAGS'dnl -]) - - -# _LT_LIBTOOL_DECLARE(VARNAME, [TAG]) -# ----------------------------------- -# Extract the dictionary values for VARNAME (optionally with TAG) and -# expand to a commented shell variable setting: -# -# # Some comment about what VAR is for. -# visible_name=$lt_internal_name -m4_define([_LT_LIBTOOL_DECLARE], -[_LT_FORMAT_COMMENT(m4_quote(lt_dict_fetch([lt_decl_dict], [$1], - [description])))[]dnl -m4_pushdef([_libtool_name], - m4_quote(lt_dict_fetch([lt_decl_dict], [$1], [libtool_name])))[]dnl -m4_case(m4_quote(lt_dict_fetch([lt_decl_dict], [$1], [value])), - [0], [_libtool_name=[$]$1], - [1], [_libtool_name=$lt_[]$1], - [2], [_libtool_name=$lt_[]$1], - [_libtool_name=lt_dict_fetch([lt_decl_dict], [$1], [value])])[]dnl -m4_ifval([$2], [_$2])[]m4_popdef([_libtool_name])[]dnl -]) - - -# _LT_LIBTOOL_CONFIG_VARS -# ----------------------- -# Produce commented declarations of non-tagged libtool config variables -# suitable for insertion in the LIBTOOL CONFIG section of the 'libtool' -# script. Tagged libtool config variables (even for the LIBTOOL CONFIG -# section) are produced by _LT_LIBTOOL_TAG_VARS. -m4_defun([_LT_LIBTOOL_CONFIG_VARS], -[m4_foreach([_lt_var], - m4_quote(_lt_decl_filter([tagged?], [no], [], lt_decl_varnames)), - [m4_n([_LT_LIBTOOL_DECLARE(_lt_var)])])]) - - -# _LT_LIBTOOL_TAG_VARS(TAG) -# ------------------------- -m4_define([_LT_LIBTOOL_TAG_VARS], -[m4_foreach([_lt_var], m4_quote(lt_decl_tag_varnames), - [m4_n([_LT_LIBTOOL_DECLARE(_lt_var, [$1])])])]) - - -# _LT_TAGVAR(VARNAME, [TAGNAME]) -# ------------------------------ -m4_define([_LT_TAGVAR], [m4_ifval([$2], [$1_$2], [$1])]) - - -# _LT_CONFIG_COMMANDS -# ------------------- -# Send accumulated output to $CONFIG_STATUS. Thanks to the lists of -# variables for single and double quote escaping we saved from calls -# to _LT_DECL, we can put quote escaped variables declarations -# into 'config.status', and then the shell code to quote escape them in -# for loops in 'config.status'. Finally, any additional code accumulated -# from calls to _LT_CONFIG_LIBTOOL_INIT is expanded. -m4_defun([_LT_CONFIG_COMMANDS], -[AC_PROVIDE_IFELSE([LT_OUTPUT], - dnl If the libtool generation code has been placed in $CONFIG_LT, - dnl instead of duplicating it all over again into config.status, - dnl then we will have config.status run $CONFIG_LT later, so it - dnl needs to know what name is stored there: - [AC_CONFIG_COMMANDS([libtool], - [$SHELL $CONFIG_LT || AS_EXIT(1)], [CONFIG_LT='$CONFIG_LT'])], - dnl If the libtool generation code is destined for config.status, - dnl expand the accumulated commands and init code now: - [AC_CONFIG_COMMANDS([libtool], - [_LT_OUTPUT_LIBTOOL_COMMANDS], [_LT_OUTPUT_LIBTOOL_COMMANDS_INIT])]) -])#_LT_CONFIG_COMMANDS - - -# Initialize. -m4_define([_LT_OUTPUT_LIBTOOL_COMMANDS_INIT], -[ - -# The HP-UX ksh and POSIX shell print the target directory to stdout -# if CDPATH is set. -(unset CDPATH) >/dev/null 2>&1 && unset CDPATH - -sed_quote_subst='$sed_quote_subst' -double_quote_subst='$double_quote_subst' -delay_variable_subst='$delay_variable_subst' -_LT_CONFIG_STATUS_DECLARATIONS -LTCC='$LTCC' -LTCFLAGS='$LTCFLAGS' -compiler='$compiler_DEFAULT' - -# A function that is used when there is no print builtin or printf. -func_fallback_echo () -{ - eval 'cat <<_LTECHO_EOF -\$[]1 -_LTECHO_EOF' -} - -# Quote evaled strings. -for var in lt_decl_all_varnames([[ \ -]], lt_decl_quote_varnames); do - case \`eval \\\\\$ECHO \\\\""\\\\\$\$var"\\\\"\` in - *[[\\\\\\\`\\"\\\$]]*) - eval "lt_\$var=\\\\\\"\\\`\\\$ECHO \\"\\\$\$var\\" | \\\$SED \\"\\\$sed_quote_subst\\"\\\`\\\\\\"" ## exclude from sc_prohibit_nested_quotes - ;; - *) - eval "lt_\$var=\\\\\\"\\\$\$var\\\\\\"" - ;; - esac -done - -# Double-quote double-evaled strings. -for var in lt_decl_all_varnames([[ \ -]], lt_decl_dquote_varnames); do - case \`eval \\\\\$ECHO \\\\""\\\\\$\$var"\\\\"\` in - *[[\\\\\\\`\\"\\\$]]*) - eval "lt_\$var=\\\\\\"\\\`\\\$ECHO \\"\\\$\$var\\" | \\\$SED -e \\"\\\$double_quote_subst\\" -e \\"\\\$sed_quote_subst\\" -e \\"\\\$delay_variable_subst\\"\\\`\\\\\\"" ## exclude from sc_prohibit_nested_quotes - ;; - *) - eval "lt_\$var=\\\\\\"\\\$\$var\\\\\\"" - ;; - esac -done - -_LT_OUTPUT_LIBTOOL_INIT -]) - -# _LT_GENERATED_FILE_INIT(FILE, [COMMENT]) -# ------------------------------------ -# Generate a child script FILE with all initialization necessary to -# reuse the environment learned by the parent script, and make the -# file executable. If COMMENT is supplied, it is inserted after the -# '#!' sequence but before initialization text begins. After this -# macro, additional text can be appended to FILE to form the body of -# the child script. The macro ends with non-zero status if the -# file could not be fully written (such as if the disk is full). -m4_ifdef([AS_INIT_GENERATED], -[m4_defun([_LT_GENERATED_FILE_INIT],[AS_INIT_GENERATED($@)])], -[m4_defun([_LT_GENERATED_FILE_INIT], -[m4_require([AS_PREPARE])]dnl -[m4_pushdef([AS_MESSAGE_LOG_FD])]dnl -[lt_write_fail=0 -cat >$1 <<_ASEOF || lt_write_fail=1 -#! $SHELL -# Generated by $as_me. -$2 -SHELL=\${CONFIG_SHELL-$SHELL} -export SHELL -_ASEOF -cat >>$1 <<\_ASEOF || lt_write_fail=1 -AS_SHELL_SANITIZE -_AS_PREPARE -exec AS_MESSAGE_FD>&1 -_ASEOF -test 0 = "$lt_write_fail" && chmod +x $1[]dnl -m4_popdef([AS_MESSAGE_LOG_FD])])])# _LT_GENERATED_FILE_INIT - -# LT_OUTPUT -# --------- -# This macro allows early generation of the libtool script (before -# AC_OUTPUT is called), incase it is used in configure for compilation -# tests. -AC_DEFUN([LT_OUTPUT], -[: ${CONFIG_LT=./config.lt} -AC_MSG_NOTICE([creating $CONFIG_LT]) -_LT_GENERATED_FILE_INIT(["$CONFIG_LT"], -[# Run this file to recreate a libtool stub with the current configuration.]) - -cat >>"$CONFIG_LT" <<\_LTEOF -lt_cl_silent=false -exec AS_MESSAGE_LOG_FD>>config.log -{ - echo - AS_BOX([Running $as_me.]) -} >&AS_MESSAGE_LOG_FD - -lt_cl_help="\ -'$as_me' creates a local libtool stub from the current configuration, -for use in further configure time tests before the real libtool is -generated. - -Usage: $[0] [[OPTIONS]] - - -h, --help print this help, then exit - -V, --version print version number, then exit - -q, --quiet do not print progress messages - -d, --debug don't remove temporary files - -Report bugs to ." - -lt_cl_version="\ -m4_ifset([AC_PACKAGE_NAME], [AC_PACKAGE_NAME ])config.lt[]dnl -m4_ifset([AC_PACKAGE_VERSION], [ AC_PACKAGE_VERSION]) -configured by $[0], generated by m4_PACKAGE_STRING. - -Copyright (C) 2011 Free Software Foundation, Inc. -This config.lt script is free software; the Free Software Foundation -gives unlimited permision to copy, distribute and modify it." - -while test 0 != $[#] -do - case $[1] in - --version | --v* | -V ) - echo "$lt_cl_version"; exit 0 ;; - --help | --h* | -h ) - echo "$lt_cl_help"; exit 0 ;; - --debug | --d* | -d ) - debug=: ;; - --quiet | --q* | --silent | --s* | -q ) - lt_cl_silent=: ;; - - -*) AC_MSG_ERROR([unrecognized option: $[1] -Try '$[0] --help' for more information.]) ;; - - *) AC_MSG_ERROR([unrecognized argument: $[1] -Try '$[0] --help' for more information.]) ;; - esac - shift -done - -if $lt_cl_silent; then - exec AS_MESSAGE_FD>/dev/null -fi -_LTEOF - -cat >>"$CONFIG_LT" <<_LTEOF -_LT_OUTPUT_LIBTOOL_COMMANDS_INIT -_LTEOF - -cat >>"$CONFIG_LT" <<\_LTEOF -AC_MSG_NOTICE([creating $ofile]) -_LT_OUTPUT_LIBTOOL_COMMANDS -AS_EXIT(0) -_LTEOF -chmod +x "$CONFIG_LT" - -# configure is writing to config.log, but config.lt does its own redirection, -# appending to config.log, which fails on DOS, as config.log is still kept -# open by configure. Here we exec the FD to /dev/null, effectively closing -# config.log, so it can be properly (re)opened and appended to by config.lt. -lt_cl_success=: -test yes = "$silent" && - lt_config_lt_args="$lt_config_lt_args --quiet" -exec AS_MESSAGE_LOG_FD>/dev/null -$SHELL "$CONFIG_LT" $lt_config_lt_args || lt_cl_success=false -exec AS_MESSAGE_LOG_FD>>config.log -$lt_cl_success || AS_EXIT(1) -])# LT_OUTPUT - - -# _LT_CONFIG(TAG) -# --------------- -# If TAG is the built-in tag, create an initial libtool script with a -# default configuration from the untagged config vars. Otherwise add code -# to config.status for appending the configuration named by TAG from the -# matching tagged config vars. -m4_defun([_LT_CONFIG], -[m4_require([_LT_FILEUTILS_DEFAULTS])dnl -_LT_CONFIG_SAVE_COMMANDS([ - m4_define([_LT_TAG], m4_if([$1], [], [C], [$1]))dnl - m4_if(_LT_TAG, [C], [ - # See if we are running on zsh, and set the options that allow our - # commands through without removal of \ escapes. - if test -n "${ZSH_VERSION+set}"; then - setopt NO_GLOB_SUBST - fi - - cfgfile=${ofile}T - trap "$RM \"$cfgfile\"; exit 1" 1 2 15 - $RM "$cfgfile" - - cat <<_LT_EOF >> "$cfgfile" -#! $SHELL -# Generated automatically by $as_me ($PACKAGE) $VERSION -# Libtool was configured on host `(hostname || uname -n) 2>/dev/null | sed 1q`: -# NOTE: Changes made to this file will be lost: look at ltmain.sh. - -# Provide generalized library-building support services. -# Written by Gordon Matzigkeit, 1996 - -_LT_COPYING -_LT_LIBTOOL_TAGS - -# Configured defaults for sys_lib_dlsearch_path munging. -: \${LT_SYS_LIBRARY_PATH="$configure_time_lt_sys_library_path"} - -# ### BEGIN LIBTOOL CONFIG -_LT_LIBTOOL_CONFIG_VARS -_LT_LIBTOOL_TAG_VARS -# ### END LIBTOOL CONFIG - -_LT_EOF - - cat <<'_LT_EOF' >> "$cfgfile" - -# ### BEGIN FUNCTIONS SHARED WITH CONFIGURE - -_LT_PREPARE_MUNGE_PATH_LIST -_LT_PREPARE_CC_BASENAME - -# ### END FUNCTIONS SHARED WITH CONFIGURE - -_LT_EOF - - case $host_os in - aix3*) - cat <<\_LT_EOF >> "$cfgfile" -# AIX sometimes has problems with the GCC collect2 program. For some -# reason, if we set the COLLECT_NAMES environment variable, the problems -# vanish in a puff of smoke. -if test set != "${COLLECT_NAMES+set}"; then - COLLECT_NAMES= - export COLLECT_NAMES -fi -_LT_EOF - ;; - esac - - _LT_PROG_LTMAIN - - # We use sed instead of cat because bash on DJGPP gets confused if - # if finds mixed CR/LF and LF-only lines. Since sed operates in - # text mode, it properly converts lines to CR/LF. This bash problem - # is reportedly fixed, but why not run on old versions too? - sed '$q' "$ltmain" >> "$cfgfile" \ - || (rm -f "$cfgfile"; exit 1) - - mv -f "$cfgfile" "$ofile" || - (rm -f "$ofile" && cp "$cfgfile" "$ofile" && rm -f "$cfgfile") - chmod +x "$ofile" -], -[cat <<_LT_EOF >> "$ofile" - -dnl Unfortunately we have to use $1 here, since _LT_TAG is not expanded -dnl in a comment (ie after a #). -# ### BEGIN LIBTOOL TAG CONFIG: $1 -_LT_LIBTOOL_TAG_VARS(_LT_TAG) -# ### END LIBTOOL TAG CONFIG: $1 -_LT_EOF -])dnl /m4_if -], -[m4_if([$1], [], [ - PACKAGE='$PACKAGE' - VERSION='$VERSION' - RM='$RM' - ofile='$ofile'], []) -])dnl /_LT_CONFIG_SAVE_COMMANDS -])# _LT_CONFIG - - -# LT_SUPPORTED_TAG(TAG) -# --------------------- -# Trace this macro to discover what tags are supported by the libtool -# --tag option, using: -# autoconf --trace 'LT_SUPPORTED_TAG:$1' -AC_DEFUN([LT_SUPPORTED_TAG], []) - - -# C support is built-in for now -m4_define([_LT_LANG_C_enabled], []) -m4_define([_LT_TAGS], []) - - -# LT_LANG(LANG) -# ------------- -# Enable libtool support for the given language if not already enabled. -AC_DEFUN([LT_LANG], -[AC_BEFORE([$0], [LT_OUTPUT])dnl -m4_case([$1], - [C], [_LT_LANG(C)], - [C++], [_LT_LANG(CXX)], - [Go], [_LT_LANG(GO)], - [Java], [_LT_LANG(GCJ)], - [Fortran 77], [_LT_LANG(F77)], - [Fortran], [_LT_LANG(FC)], - [Windows Resource], [_LT_LANG(RC)], - [m4_ifdef([_LT_LANG_]$1[_CONFIG], - [_LT_LANG($1)], - [m4_fatal([$0: unsupported language: "$1"])])])dnl -])# LT_LANG - - -# _LT_LANG(LANGNAME) -# ------------------ -m4_defun([_LT_LANG], -[m4_ifdef([_LT_LANG_]$1[_enabled], [], - [LT_SUPPORTED_TAG([$1])dnl - m4_append([_LT_TAGS], [$1 ])dnl - m4_define([_LT_LANG_]$1[_enabled], [])dnl - _LT_LANG_$1_CONFIG($1)])dnl -])# _LT_LANG - - -m4_ifndef([AC_PROG_GO], [ -############################################################ -# NOTE: This macro has been submitted for inclusion into # -# GNU Autoconf as AC_PROG_GO. When it is available in # -# a released version of Autoconf we should remove this # -# macro and use it instead. # -############################################################ -m4_defun([AC_PROG_GO], -[AC_LANG_PUSH(Go)dnl -AC_ARG_VAR([GOC], [Go compiler command])dnl -AC_ARG_VAR([GOFLAGS], [Go compiler flags])dnl -_AC_ARG_VAR_LDFLAGS()dnl -AC_CHECK_TOOL(GOC, gccgo) -if test -z "$GOC"; then - if test -n "$ac_tool_prefix"; then - AC_CHECK_PROG(GOC, [${ac_tool_prefix}gccgo], [${ac_tool_prefix}gccgo]) - fi -fi -if test -z "$GOC"; then - AC_CHECK_PROG(GOC, gccgo, gccgo, false) -fi -])#m4_defun -])#m4_ifndef - - -# _LT_LANG_DEFAULT_CONFIG -# ----------------------- -m4_defun([_LT_LANG_DEFAULT_CONFIG], -[AC_PROVIDE_IFELSE([AC_PROG_CXX], - [LT_LANG(CXX)], - [m4_define([AC_PROG_CXX], defn([AC_PROG_CXX])[LT_LANG(CXX)])]) - -AC_PROVIDE_IFELSE([AC_PROG_F77], - [LT_LANG(F77)], - [m4_define([AC_PROG_F77], defn([AC_PROG_F77])[LT_LANG(F77)])]) - -AC_PROVIDE_IFELSE([AC_PROG_FC], - [LT_LANG(FC)], - [m4_define([AC_PROG_FC], defn([AC_PROG_FC])[LT_LANG(FC)])]) - -dnl The call to [A][M_PROG_GCJ] is quoted like that to stop aclocal -dnl pulling things in needlessly. -AC_PROVIDE_IFELSE([AC_PROG_GCJ], - [LT_LANG(GCJ)], - [AC_PROVIDE_IFELSE([A][M_PROG_GCJ], - [LT_LANG(GCJ)], - [AC_PROVIDE_IFELSE([LT_PROG_GCJ], - [LT_LANG(GCJ)], - [m4_ifdef([AC_PROG_GCJ], - [m4_define([AC_PROG_GCJ], defn([AC_PROG_GCJ])[LT_LANG(GCJ)])]) - m4_ifdef([A][M_PROG_GCJ], - [m4_define([A][M_PROG_GCJ], defn([A][M_PROG_GCJ])[LT_LANG(GCJ)])]) - m4_ifdef([LT_PROG_GCJ], - [m4_define([LT_PROG_GCJ], defn([LT_PROG_GCJ])[LT_LANG(GCJ)])])])])]) - -AC_PROVIDE_IFELSE([AC_PROG_GO], - [LT_LANG(GO)], - [m4_define([AC_PROG_GO], defn([AC_PROG_GO])[LT_LANG(GO)])]) - -AC_PROVIDE_IFELSE([LT_PROG_RC], - [LT_LANG(RC)], - [m4_define([LT_PROG_RC], defn([LT_PROG_RC])[LT_LANG(RC)])]) -])# _LT_LANG_DEFAULT_CONFIG - -# Obsolete macros: -AU_DEFUN([AC_LIBTOOL_CXX], [LT_LANG(C++)]) -AU_DEFUN([AC_LIBTOOL_F77], [LT_LANG(Fortran 77)]) -AU_DEFUN([AC_LIBTOOL_FC], [LT_LANG(Fortran)]) -AU_DEFUN([AC_LIBTOOL_GCJ], [LT_LANG(Java)]) -AU_DEFUN([AC_LIBTOOL_RC], [LT_LANG(Windows Resource)]) -dnl aclocal-1.4 backwards compatibility: -dnl AC_DEFUN([AC_LIBTOOL_CXX], []) -dnl AC_DEFUN([AC_LIBTOOL_F77], []) -dnl AC_DEFUN([AC_LIBTOOL_FC], []) -dnl AC_DEFUN([AC_LIBTOOL_GCJ], []) -dnl AC_DEFUN([AC_LIBTOOL_RC], []) - - -# _LT_TAG_COMPILER -# ---------------- -m4_defun([_LT_TAG_COMPILER], -[AC_REQUIRE([AC_PROG_CC])dnl - -_LT_DECL([LTCC], [CC], [1], [A C compiler])dnl -_LT_DECL([LTCFLAGS], [CFLAGS], [1], [LTCC compiler flags])dnl -_LT_TAGDECL([CC], [compiler], [1], [A language specific compiler])dnl -_LT_TAGDECL([with_gcc], [GCC], [0], [Is the compiler the GNU compiler?])dnl - -# If no C compiler was specified, use CC. -LTCC=${LTCC-"$CC"} - -# If no C compiler flags were specified, use CFLAGS. -LTCFLAGS=${LTCFLAGS-"$CFLAGS"} - -# Allow CC to be a program name with arguments. -compiler=$CC -])# _LT_TAG_COMPILER - - -# _LT_COMPILER_BOILERPLATE -# ------------------------ -# Check for compiler boilerplate output or warnings with -# the simple compiler test code. -m4_defun([_LT_COMPILER_BOILERPLATE], -[m4_require([_LT_DECL_SED])dnl -ac_outfile=conftest.$ac_objext -echo "$lt_simple_compile_test_code" >conftest.$ac_ext -eval "$ac_compile" 2>&1 >/dev/null | $SED '/^$/d; /^ *+/d' >conftest.err -_lt_compiler_boilerplate=`cat conftest.err` -$RM conftest* -])# _LT_COMPILER_BOILERPLATE - - -# _LT_LINKER_BOILERPLATE -# ---------------------- -# Check for linker boilerplate output or warnings with -# the simple link test code. -m4_defun([_LT_LINKER_BOILERPLATE], -[m4_require([_LT_DECL_SED])dnl -ac_outfile=conftest.$ac_objext -echo "$lt_simple_link_test_code" >conftest.$ac_ext -eval "$ac_link" 2>&1 >/dev/null | $SED '/^$/d; /^ *+/d' >conftest.err -_lt_linker_boilerplate=`cat conftest.err` -$RM -r conftest* -])# _LT_LINKER_BOILERPLATE - -# _LT_REQUIRED_DARWIN_CHECKS -# ------------------------- -m4_defun_once([_LT_REQUIRED_DARWIN_CHECKS],[ - case $host_os in - rhapsody* | darwin*) - AC_CHECK_TOOL([DSYMUTIL], [dsymutil], [:]) - AC_CHECK_TOOL([NMEDIT], [nmedit], [:]) - AC_CHECK_TOOL([LIPO], [lipo], [:]) - AC_CHECK_TOOL([OTOOL], [otool], [:]) - AC_CHECK_TOOL([OTOOL64], [otool64], [:]) - _LT_DECL([], [DSYMUTIL], [1], - [Tool to manipulate archived DWARF debug symbol files on Mac OS X]) - _LT_DECL([], [NMEDIT], [1], - [Tool to change global to local symbols on Mac OS X]) - _LT_DECL([], [LIPO], [1], - [Tool to manipulate fat objects and archives on Mac OS X]) - _LT_DECL([], [OTOOL], [1], - [ldd/readelf like tool for Mach-O binaries on Mac OS X]) - _LT_DECL([], [OTOOL64], [1], - [ldd/readelf like tool for 64 bit Mach-O binaries on Mac OS X 10.4]) - - AC_CACHE_CHECK([for -single_module linker flag],[lt_cv_apple_cc_single_mod], - [lt_cv_apple_cc_single_mod=no - if test -z "$LT_MULTI_MODULE"; then - # By default we will add the -single_module flag. You can override - # by either setting the environment variable LT_MULTI_MODULE - # non-empty at configure time, or by adding -multi_module to the - # link flags. - rm -rf libconftest.dylib* - echo "int foo(void){return 1;}" > conftest.c - echo "$LTCC $LTCFLAGS $LDFLAGS -o libconftest.dylib \ --dynamiclib -Wl,-single_module conftest.c" >&AS_MESSAGE_LOG_FD - $LTCC $LTCFLAGS $LDFLAGS -o libconftest.dylib \ - -dynamiclib -Wl,-single_module conftest.c 2>conftest.err - _lt_result=$? - # If there is a non-empty error log, and "single_module" - # appears in it, assume the flag caused a linker warning - if test -s conftest.err && $GREP single_module conftest.err; then - cat conftest.err >&AS_MESSAGE_LOG_FD - # Otherwise, if the output was created with a 0 exit code from - # the compiler, it worked. - elif test -f libconftest.dylib && test 0 = "$_lt_result"; then - lt_cv_apple_cc_single_mod=yes - else - cat conftest.err >&AS_MESSAGE_LOG_FD - fi - rm -rf libconftest.dylib* - rm -f conftest.* - fi]) - - AC_CACHE_CHECK([for -exported_symbols_list linker flag], - [lt_cv_ld_exported_symbols_list], - [lt_cv_ld_exported_symbols_list=no - save_LDFLAGS=$LDFLAGS - echo "_main" > conftest.sym - LDFLAGS="$LDFLAGS -Wl,-exported_symbols_list,conftest.sym" - AC_LINK_IFELSE([AC_LANG_PROGRAM([],[])], - [lt_cv_ld_exported_symbols_list=yes], - [lt_cv_ld_exported_symbols_list=no]) - LDFLAGS=$save_LDFLAGS - ]) - - AC_CACHE_CHECK([for -force_load linker flag],[lt_cv_ld_force_load], - [lt_cv_ld_force_load=no - cat > conftest.c << _LT_EOF -int forced_loaded() { return 2;} -_LT_EOF - echo "$LTCC $LTCFLAGS -c -o conftest.o conftest.c" >&AS_MESSAGE_LOG_FD - $LTCC $LTCFLAGS -c -o conftest.o conftest.c 2>&AS_MESSAGE_LOG_FD - echo "$AR cru libconftest.a conftest.o" >&AS_MESSAGE_LOG_FD - $AR cru libconftest.a conftest.o 2>&AS_MESSAGE_LOG_FD - echo "$RANLIB libconftest.a" >&AS_MESSAGE_LOG_FD - $RANLIB libconftest.a 2>&AS_MESSAGE_LOG_FD - cat > conftest.c << _LT_EOF -int main() { return 0;} -_LT_EOF - echo "$LTCC $LTCFLAGS $LDFLAGS -o conftest conftest.c -Wl,-force_load,./libconftest.a" >&AS_MESSAGE_LOG_FD - $LTCC $LTCFLAGS $LDFLAGS -o conftest conftest.c -Wl,-force_load,./libconftest.a 2>conftest.err - _lt_result=$? - if test -s conftest.err && $GREP force_load conftest.err; then - cat conftest.err >&AS_MESSAGE_LOG_FD - elif test -f conftest && test 0 = "$_lt_result" && $GREP forced_load conftest >/dev/null 2>&1; then - lt_cv_ld_force_load=yes - else - cat conftest.err >&AS_MESSAGE_LOG_FD - fi - rm -f conftest.err libconftest.a conftest conftest.c - rm -rf conftest.dSYM - ]) - case $host_os in - rhapsody* | darwin1.[[012]]) - _lt_dar_allow_undefined='$wl-undefined ${wl}suppress' ;; - darwin1.*) - _lt_dar_allow_undefined='$wl-flat_namespace $wl-undefined ${wl}suppress' ;; - darwin*) # darwin 5.x on - # if running on 10.5 or later, the deployment target defaults - # to the OS version, if on x86, and 10.4, the deployment - # target defaults to 10.4. Don't you love it? - case ${MACOSX_DEPLOYMENT_TARGET-10.0},$host in - 10.0,*86*-darwin8*|10.0,*-darwin[[91]]*) - _lt_dar_allow_undefined='$wl-undefined ${wl}dynamic_lookup' ;; - 10.[[012]][[,.]]*) - _lt_dar_allow_undefined='$wl-flat_namespace $wl-undefined ${wl}suppress' ;; - 10.*) - _lt_dar_allow_undefined='$wl-undefined ${wl}dynamic_lookup' ;; - esac - ;; - esac - if test yes = "$lt_cv_apple_cc_single_mod"; then - _lt_dar_single_mod='$single_module' - fi - if test yes = "$lt_cv_ld_exported_symbols_list"; then - _lt_dar_export_syms=' $wl-exported_symbols_list,$output_objdir/$libname-symbols.expsym' - else - _lt_dar_export_syms='~$NMEDIT -s $output_objdir/$libname-symbols.expsym $lib' - fi - if test : != "$DSYMUTIL" && test no = "$lt_cv_ld_force_load"; then - _lt_dsymutil='~$DSYMUTIL $lib || :' - else - _lt_dsymutil= - fi - ;; - esac -]) - - -# _LT_DARWIN_LINKER_FEATURES([TAG]) -# --------------------------------- -# Checks for linker and compiler features on darwin -m4_defun([_LT_DARWIN_LINKER_FEATURES], -[ - m4_require([_LT_REQUIRED_DARWIN_CHECKS]) - _LT_TAGVAR(archive_cmds_need_lc, $1)=no - _LT_TAGVAR(hardcode_direct, $1)=no - _LT_TAGVAR(hardcode_automatic, $1)=yes - _LT_TAGVAR(hardcode_shlibpath_var, $1)=unsupported - if test yes = "$lt_cv_ld_force_load"; then - _LT_TAGVAR(whole_archive_flag_spec, $1)='`for conv in $convenience\"\"; do test -n \"$conv\" && new_convenience=\"$new_convenience $wl-force_load,$conv\"; done; func_echo_all \"$new_convenience\"`' - m4_case([$1], [F77], [_LT_TAGVAR(compiler_needs_object, $1)=yes], - [FC], [_LT_TAGVAR(compiler_needs_object, $1)=yes]) - else - _LT_TAGVAR(whole_archive_flag_spec, $1)='' - fi - _LT_TAGVAR(link_all_deplibs, $1)=yes - _LT_TAGVAR(allow_undefined_flag, $1)=$_lt_dar_allow_undefined - case $cc_basename in - ifort*|nagfor*) _lt_dar_can_shared=yes ;; - *) _lt_dar_can_shared=$GCC ;; - esac - if test yes = "$_lt_dar_can_shared"; then - output_verbose_link_cmd=func_echo_all - _LT_TAGVAR(archive_cmds, $1)="\$CC -dynamiclib \$allow_undefined_flag -o \$lib \$libobjs \$deplibs \$compiler_flags -install_name \$rpath/\$soname \$verstring $_lt_dar_single_mod$_lt_dsymutil" - _LT_TAGVAR(module_cmds, $1)="\$CC \$allow_undefined_flag -o \$lib -bundle \$libobjs \$deplibs \$compiler_flags$_lt_dsymutil" - _LT_TAGVAR(archive_expsym_cmds, $1)="sed 's|^|_|' < \$export_symbols > \$output_objdir/\$libname-symbols.expsym~\$CC -dynamiclib \$allow_undefined_flag -o \$lib \$libobjs \$deplibs \$compiler_flags -install_name \$rpath/\$soname \$verstring $_lt_dar_single_mod$_lt_dar_export_syms$_lt_dsymutil" - _LT_TAGVAR(module_expsym_cmds, $1)="sed -e 's|^|_|' < \$export_symbols > \$output_objdir/\$libname-symbols.expsym~\$CC \$allow_undefined_flag -o \$lib -bundle \$libobjs \$deplibs \$compiler_flags$_lt_dar_export_syms$_lt_dsymutil" - m4_if([$1], [CXX], -[ if test yes != "$lt_cv_apple_cc_single_mod"; then - _LT_TAGVAR(archive_cmds, $1)="\$CC -r -keep_private_externs -nostdlib -o \$lib-master.o \$libobjs~\$CC -dynamiclib \$allow_undefined_flag -o \$lib \$lib-master.o \$deplibs \$compiler_flags -install_name \$rpath/\$soname \$verstring$_lt_dsymutil" - _LT_TAGVAR(archive_expsym_cmds, $1)="sed 's|^|_|' < \$export_symbols > \$output_objdir/\$libname-symbols.expsym~\$CC -r -keep_private_externs -nostdlib -o \$lib-master.o \$libobjs~\$CC -dynamiclib \$allow_undefined_flag -o \$lib \$lib-master.o \$deplibs \$compiler_flags -install_name \$rpath/\$soname \$verstring$_lt_dar_export_syms$_lt_dsymutil" - fi -],[]) - else - _LT_TAGVAR(ld_shlibs, $1)=no - fi -]) - -# _LT_SYS_MODULE_PATH_AIX([TAGNAME]) -# ---------------------------------- -# Links a minimal program and checks the executable -# for the system default hardcoded library path. In most cases, -# this is /usr/lib:/lib, but when the MPI compilers are used -# the location of the communication and MPI libs are included too. -# If we don't find anything, use the default library path according -# to the aix ld manual. -# Store the results from the different compilers for each TAGNAME. -# Allow to override them for all tags through lt_cv_aix_libpath. -m4_defun([_LT_SYS_MODULE_PATH_AIX], -[m4_require([_LT_DECL_SED])dnl -if test set = "${lt_cv_aix_libpath+set}"; then - aix_libpath=$lt_cv_aix_libpath -else - AC_CACHE_VAL([_LT_TAGVAR([lt_cv_aix_libpath_], [$1])], - [AC_LINK_IFELSE([AC_LANG_PROGRAM],[ - lt_aix_libpath_sed='[ - /Import File Strings/,/^$/ { - /^0/ { - s/^0 *\([^ ]*\) *$/\1/ - p - } - }]' - _LT_TAGVAR([lt_cv_aix_libpath_], [$1])=`dump -H conftest$ac_exeext 2>/dev/null | $SED -n -e "$lt_aix_libpath_sed"` - # Check for a 64-bit object if we didn't find anything. - if test -z "$_LT_TAGVAR([lt_cv_aix_libpath_], [$1])"; then - _LT_TAGVAR([lt_cv_aix_libpath_], [$1])=`dump -HX64 conftest$ac_exeext 2>/dev/null | $SED -n -e "$lt_aix_libpath_sed"` - fi],[]) - if test -z "$_LT_TAGVAR([lt_cv_aix_libpath_], [$1])"; then - _LT_TAGVAR([lt_cv_aix_libpath_], [$1])=/usr/lib:/lib - fi - ]) - aix_libpath=$_LT_TAGVAR([lt_cv_aix_libpath_], [$1]) -fi -])# _LT_SYS_MODULE_PATH_AIX - - -# _LT_SHELL_INIT(ARG) -# ------------------- -m4_define([_LT_SHELL_INIT], -[m4_divert_text([M4SH-INIT], [$1 -])])# _LT_SHELL_INIT - - - -# _LT_PROG_ECHO_BACKSLASH -# ----------------------- -# Find how we can fake an echo command that does not interpret backslash. -# In particular, with Autoconf 2.60 or later we add some code to the start -# of the generated configure script that will find a shell with a builtin -# printf (that we can use as an echo command). -m4_defun([_LT_PROG_ECHO_BACKSLASH], -[ECHO='\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\' -ECHO=$ECHO$ECHO$ECHO$ECHO$ECHO -ECHO=$ECHO$ECHO$ECHO$ECHO$ECHO$ECHO - -AC_MSG_CHECKING([how to print strings]) -# Test print first, because it will be a builtin if present. -if test "X`( print -r -- -n ) 2>/dev/null`" = X-n && \ - test "X`print -r -- $ECHO 2>/dev/null`" = "X$ECHO"; then - ECHO='print -r --' -elif test "X`printf %s $ECHO 2>/dev/null`" = "X$ECHO"; then - ECHO='printf %s\n' -else - # Use this function as a fallback that always works. - func_fallback_echo () - { - eval 'cat <<_LTECHO_EOF -$[]1 -_LTECHO_EOF' - } - ECHO='func_fallback_echo' -fi - -# func_echo_all arg... -# Invoke $ECHO with all args, space-separated. -func_echo_all () -{ - $ECHO "$*" -} - -case $ECHO in - printf*) AC_MSG_RESULT([printf]) ;; - print*) AC_MSG_RESULT([print -r]) ;; - *) AC_MSG_RESULT([cat]) ;; -esac - -m4_ifdef([_AS_DETECT_SUGGESTED], -[_AS_DETECT_SUGGESTED([ - test -n "${ZSH_VERSION+set}${BASH_VERSION+set}" || ( - ECHO='\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\' - ECHO=$ECHO$ECHO$ECHO$ECHO$ECHO - ECHO=$ECHO$ECHO$ECHO$ECHO$ECHO$ECHO - PATH=/empty FPATH=/empty; export PATH FPATH - test "X`printf %s $ECHO`" = "X$ECHO" \ - || test "X`print -r -- $ECHO`" = "X$ECHO" )])]) - -_LT_DECL([], [SHELL], [1], [Shell to use when invoking shell scripts]) -_LT_DECL([], [ECHO], [1], [An echo program that protects backslashes]) -])# _LT_PROG_ECHO_BACKSLASH - - -# _LT_WITH_SYSROOT -# ---------------- -AC_DEFUN([_LT_WITH_SYSROOT], -[AC_MSG_CHECKING([for sysroot]) -AC_ARG_WITH([sysroot], -[AS_HELP_STRING([--with-sysroot@<:@=DIR@:>@], - [Search for dependent libraries within DIR (or the compiler's sysroot - if not specified).])], -[], [with_sysroot=no]) - -dnl lt_sysroot will always be passed unquoted. We quote it here -dnl in case the user passed a directory name. -lt_sysroot= -case $with_sysroot in #( - yes) - if test yes = "$GCC"; then - lt_sysroot=`$CC --print-sysroot 2>/dev/null` - fi - ;; #( - /*) - lt_sysroot=`echo "$with_sysroot" | sed -e "$sed_quote_subst"` - ;; #( - no|'') - ;; #( - *) - AC_MSG_RESULT([$with_sysroot]) - AC_MSG_ERROR([The sysroot must be an absolute path.]) - ;; -esac - - AC_MSG_RESULT([${lt_sysroot:-no}]) -_LT_DECL([], [lt_sysroot], [0], [The root where to search for ]dnl -[dependent libraries, and where our libraries should be installed.])]) - -# _LT_ENABLE_LOCK -# --------------- -m4_defun([_LT_ENABLE_LOCK], -[AC_ARG_ENABLE([libtool-lock], - [AS_HELP_STRING([--disable-libtool-lock], - [avoid locking (might break parallel builds)])]) -test no = "$enable_libtool_lock" || enable_libtool_lock=yes - -# Some flags need to be propagated to the compiler or linker for good -# libtool support. -case $host in -ia64-*-hpux*) - # Find out what ABI is being produced by ac_compile, and set mode - # options accordingly. - echo 'int i;' > conftest.$ac_ext - if AC_TRY_EVAL(ac_compile); then - case `/usr/bin/file conftest.$ac_objext` in - *ELF-32*) - HPUX_IA64_MODE=32 - ;; - *ELF-64*) - HPUX_IA64_MODE=64 - ;; - esac - fi - rm -rf conftest* - ;; -*-*-irix6*) - # Find out what ABI is being produced by ac_compile, and set linker - # options accordingly. - echo '[#]line '$LINENO' "configure"' > conftest.$ac_ext - if AC_TRY_EVAL(ac_compile); then - if test yes = "$lt_cv_prog_gnu_ld"; then - case `/usr/bin/file conftest.$ac_objext` in - *32-bit*) - LD="${LD-ld} -melf32bsmip" - ;; - *N32*) - LD="${LD-ld} -melf32bmipn32" - ;; - *64-bit*) - LD="${LD-ld} -melf64bmip" - ;; - esac - else - case `/usr/bin/file conftest.$ac_objext` in - *32-bit*) - LD="${LD-ld} -32" - ;; - *N32*) - LD="${LD-ld} -n32" - ;; - *64-bit*) - LD="${LD-ld} -64" - ;; - esac - fi - fi - rm -rf conftest* - ;; - -mips64*-*linux*) - # Find out what ABI is being produced by ac_compile, and set linker - # options accordingly. - echo '[#]line '$LINENO' "configure"' > conftest.$ac_ext - if AC_TRY_EVAL(ac_compile); then - emul=elf - case `/usr/bin/file conftest.$ac_objext` in - *32-bit*) - emul="${emul}32" - ;; - *64-bit*) - emul="${emul}64" - ;; - esac - case `/usr/bin/file conftest.$ac_objext` in - *MSB*) - emul="${emul}btsmip" - ;; - *LSB*) - emul="${emul}ltsmip" - ;; - esac - case `/usr/bin/file conftest.$ac_objext` in - *N32*) - emul="${emul}n32" - ;; - esac - LD="${LD-ld} -m $emul" - fi - rm -rf conftest* - ;; - -x86_64-*kfreebsd*-gnu|x86_64-*linux*|powerpc*-*linux*| \ -s390*-*linux*|s390*-*tpf*|sparc*-*linux*) - # Find out what ABI is being produced by ac_compile, and set linker - # options accordingly. Note that the listed cases only cover the - # situations where additional linker options are needed (such as when - # doing 32-bit compilation for a host where ld defaults to 64-bit, or - # vice versa); the common cases where no linker options are needed do - # not appear in the list. - echo 'int i;' > conftest.$ac_ext - if AC_TRY_EVAL(ac_compile); then - case `/usr/bin/file conftest.o` in - *32-bit*) - case $host in - x86_64-*kfreebsd*-gnu) - LD="${LD-ld} -m elf_i386_fbsd" - ;; - x86_64-*linux*) - case `/usr/bin/file conftest.o` in - *x86-64*) - LD="${LD-ld} -m elf32_x86_64" - ;; - *) - LD="${LD-ld} -m elf_i386" - ;; - esac - ;; - powerpc64le-*linux*) - LD="${LD-ld} -m elf32lppclinux" - ;; - powerpc64-*linux*) - LD="${LD-ld} -m elf32ppclinux" - ;; - s390x-*linux*) - LD="${LD-ld} -m elf_s390" - ;; - sparc64-*linux*) - LD="${LD-ld} -m elf32_sparc" - ;; - esac - ;; - *64-bit*) - case $host in - x86_64-*kfreebsd*-gnu) - LD="${LD-ld} -m elf_x86_64_fbsd" - ;; - x86_64-*linux*) - LD="${LD-ld} -m elf_x86_64" - ;; - powerpcle-*linux*) - LD="${LD-ld} -m elf64lppc" - ;; - powerpc-*linux*) - LD="${LD-ld} -m elf64ppc" - ;; - s390*-*linux*|s390*-*tpf*) - LD="${LD-ld} -m elf64_s390" - ;; - sparc*-*linux*) - LD="${LD-ld} -m elf64_sparc" - ;; - esac - ;; - esac - fi - rm -rf conftest* - ;; - -*-*-sco3.2v5*) - # On SCO OpenServer 5, we need -belf to get full-featured binaries. - SAVE_CFLAGS=$CFLAGS - CFLAGS="$CFLAGS -belf" - AC_CACHE_CHECK([whether the C compiler needs -belf], lt_cv_cc_needs_belf, - [AC_LANG_PUSH(C) - AC_LINK_IFELSE([AC_LANG_PROGRAM([[]],[[]])],[lt_cv_cc_needs_belf=yes],[lt_cv_cc_needs_belf=no]) - AC_LANG_POP]) - if test yes != "$lt_cv_cc_needs_belf"; then - # this is probably gcc 2.8.0, egcs 1.0 or newer; no need for -belf - CFLAGS=$SAVE_CFLAGS - fi - ;; -*-*solaris*) - # Find out what ABI is being produced by ac_compile, and set linker - # options accordingly. - echo 'int i;' > conftest.$ac_ext - if AC_TRY_EVAL(ac_compile); then - case `/usr/bin/file conftest.o` in - *64-bit*) - case $lt_cv_prog_gnu_ld in - yes*) - case $host in - i?86-*-solaris*|x86_64-*-solaris*) - LD="${LD-ld} -m elf_x86_64" - ;; - sparc*-*-solaris*) - LD="${LD-ld} -m elf64_sparc" - ;; - esac - # GNU ld 2.21 introduced _sol2 emulations. Use them if available. - if ${LD-ld} -V | grep _sol2 >/dev/null 2>&1; then - LD=${LD-ld}_sol2 - fi - ;; - *) - if ${LD-ld} -64 -r -o conftest2.o conftest.o >/dev/null 2>&1; then - LD="${LD-ld} -64" - fi - ;; - esac - ;; - esac - fi - rm -rf conftest* - ;; -esac - -need_locks=$enable_libtool_lock -])# _LT_ENABLE_LOCK - - -# _LT_PROG_AR -# ----------- -m4_defun([_LT_PROG_AR], -[AC_CHECK_TOOLS(AR, [ar], false) -: ${AR=ar} -: ${AR_FLAGS=cru} -_LT_DECL([], [AR], [1], [The archiver]) -_LT_DECL([], [AR_FLAGS], [1], [Flags to create an archive]) - -AC_CACHE_CHECK([for archiver @FILE support], [lt_cv_ar_at_file], - [lt_cv_ar_at_file=no - AC_COMPILE_IFELSE([AC_LANG_PROGRAM], - [echo conftest.$ac_objext > conftest.lst - lt_ar_try='$AR $AR_FLAGS libconftest.a @conftest.lst >&AS_MESSAGE_LOG_FD' - AC_TRY_EVAL([lt_ar_try]) - if test 0 -eq "$ac_status"; then - # Ensure the archiver fails upon bogus file names. - rm -f conftest.$ac_objext libconftest.a - AC_TRY_EVAL([lt_ar_try]) - if test 0 -ne "$ac_status"; then - lt_cv_ar_at_file=@ - fi - fi - rm -f conftest.* libconftest.a - ]) - ]) - -if test no = "$lt_cv_ar_at_file"; then - archiver_list_spec= -else - archiver_list_spec=$lt_cv_ar_at_file -fi -_LT_DECL([], [archiver_list_spec], [1], - [How to feed a file listing to the archiver]) -])# _LT_PROG_AR - - -# _LT_CMD_OLD_ARCHIVE -# ------------------- -m4_defun([_LT_CMD_OLD_ARCHIVE], -[_LT_PROG_AR - -AC_CHECK_TOOL(STRIP, strip, :) -test -z "$STRIP" && STRIP=: -_LT_DECL([], [STRIP], [1], [A symbol stripping program]) - -AC_CHECK_TOOL(RANLIB, ranlib, :) -test -z "$RANLIB" && RANLIB=: -_LT_DECL([], [RANLIB], [1], - [Commands used to install an old-style archive]) - -# Determine commands to create old-style static archives. -old_archive_cmds='$AR $AR_FLAGS $oldlib$oldobjs' -old_postinstall_cmds='chmod 644 $oldlib' -old_postuninstall_cmds= - -if test -n "$RANLIB"; then - case $host_os in - bitrig* | openbsd*) - old_postinstall_cmds="$old_postinstall_cmds~\$RANLIB -t \$tool_oldlib" - ;; - *) - old_postinstall_cmds="$old_postinstall_cmds~\$RANLIB \$tool_oldlib" - ;; - esac - old_archive_cmds="$old_archive_cmds~\$RANLIB \$tool_oldlib" -fi - -case $host_os in - darwin*) - lock_old_archive_extraction=yes ;; - *) - lock_old_archive_extraction=no ;; -esac -_LT_DECL([], [old_postinstall_cmds], [2]) -_LT_DECL([], [old_postuninstall_cmds], [2]) -_LT_TAGDECL([], [old_archive_cmds], [2], - [Commands used to build an old-style archive]) -_LT_DECL([], [lock_old_archive_extraction], [0], - [Whether to use a lock for old archive extraction]) -])# _LT_CMD_OLD_ARCHIVE - - -# _LT_COMPILER_OPTION(MESSAGE, VARIABLE-NAME, FLAGS, -# [OUTPUT-FILE], [ACTION-SUCCESS], [ACTION-FAILURE]) -# ---------------------------------------------------------------- -# Check whether the given compiler option works -AC_DEFUN([_LT_COMPILER_OPTION], -[m4_require([_LT_FILEUTILS_DEFAULTS])dnl -m4_require([_LT_DECL_SED])dnl -AC_CACHE_CHECK([$1], [$2], - [$2=no - m4_if([$4], , [ac_outfile=conftest.$ac_objext], [ac_outfile=$4]) - echo "$lt_simple_compile_test_code" > conftest.$ac_ext - lt_compiler_flag="$3" ## exclude from sc_useless_quotes_in_assignment - # Insert the option either (1) after the last *FLAGS variable, or - # (2) before a word containing "conftest.", or (3) at the end. - # Note that $ac_compile itself does not contain backslashes and begins - # with a dollar sign (not a hyphen), so the echo should work correctly. - # The option is referenced via a variable to avoid confusing sed. - lt_compile=`echo "$ac_compile" | $SED \ - -e 's:.*FLAGS}\{0,1\} :&$lt_compiler_flag :; t' \ - -e 's: [[^ ]]*conftest\.: $lt_compiler_flag&:; t' \ - -e 's:$: $lt_compiler_flag:'` - (eval echo "\"\$as_me:$LINENO: $lt_compile\"" >&AS_MESSAGE_LOG_FD) - (eval "$lt_compile" 2>conftest.err) - ac_status=$? - cat conftest.err >&AS_MESSAGE_LOG_FD - echo "$as_me:$LINENO: \$? = $ac_status" >&AS_MESSAGE_LOG_FD - if (exit $ac_status) && test -s "$ac_outfile"; then - # The compiler can only warn and ignore the option if not recognized - # So say no if there are warnings other than the usual output. - $ECHO "$_lt_compiler_boilerplate" | $SED '/^$/d' >conftest.exp - $SED '/^$/d; /^ *+/d' conftest.err >conftest.er2 - if test ! -s conftest.er2 || diff conftest.exp conftest.er2 >/dev/null; then - $2=yes - fi - fi - $RM conftest* -]) - -if test yes = "[$]$2"; then - m4_if([$5], , :, [$5]) -else - m4_if([$6], , :, [$6]) -fi -])# _LT_COMPILER_OPTION - -# Old name: -AU_ALIAS([AC_LIBTOOL_COMPILER_OPTION], [_LT_COMPILER_OPTION]) -dnl aclocal-1.4 backwards compatibility: -dnl AC_DEFUN([AC_LIBTOOL_COMPILER_OPTION], []) - - -# _LT_LINKER_OPTION(MESSAGE, VARIABLE-NAME, FLAGS, -# [ACTION-SUCCESS], [ACTION-FAILURE]) -# ---------------------------------------------------- -# Check whether the given linker option works -AC_DEFUN([_LT_LINKER_OPTION], -[m4_require([_LT_FILEUTILS_DEFAULTS])dnl -m4_require([_LT_DECL_SED])dnl -AC_CACHE_CHECK([$1], [$2], - [$2=no - save_LDFLAGS=$LDFLAGS - LDFLAGS="$LDFLAGS $3" - echo "$lt_simple_link_test_code" > conftest.$ac_ext - if (eval $ac_link 2>conftest.err) && test -s conftest$ac_exeext; then - # The linker can only warn and ignore the option if not recognized - # So say no if there are warnings - if test -s conftest.err; then - # Append any errors to the config.log. - cat conftest.err 1>&AS_MESSAGE_LOG_FD - $ECHO "$_lt_linker_boilerplate" | $SED '/^$/d' > conftest.exp - $SED '/^$/d; /^ *+/d' conftest.err >conftest.er2 - if diff conftest.exp conftest.er2 >/dev/null; then - $2=yes - fi - else - $2=yes - fi - fi - $RM -r conftest* - LDFLAGS=$save_LDFLAGS -]) - -if test yes = "[$]$2"; then - m4_if([$4], , :, [$4]) -else - m4_if([$5], , :, [$5]) -fi -])# _LT_LINKER_OPTION - -# Old name: -AU_ALIAS([AC_LIBTOOL_LINKER_OPTION], [_LT_LINKER_OPTION]) -dnl aclocal-1.4 backwards compatibility: -dnl AC_DEFUN([AC_LIBTOOL_LINKER_OPTION], []) - - -# LT_CMD_MAX_LEN -#--------------- -AC_DEFUN([LT_CMD_MAX_LEN], -[AC_REQUIRE([AC_CANONICAL_HOST])dnl -# find the maximum length of command line arguments -AC_MSG_CHECKING([the maximum length of command line arguments]) -AC_CACHE_VAL([lt_cv_sys_max_cmd_len], [dnl - i=0 - teststring=ABCD - - case $build_os in - msdosdjgpp*) - # On DJGPP, this test can blow up pretty badly due to problems in libc - # (any single argument exceeding 2000 bytes causes a buffer overrun - # during glob expansion). Even if it were fixed, the result of this - # check would be larger than it should be. - lt_cv_sys_max_cmd_len=12288; # 12K is about right - ;; - - gnu*) - # Under GNU Hurd, this test is not required because there is - # no limit to the length of command line arguments. - # Libtool will interpret -1 as no limit whatsoever - lt_cv_sys_max_cmd_len=-1; - ;; - - cygwin* | mingw* | cegcc*) - # On Win9x/ME, this test blows up -- it succeeds, but takes - # about 5 minutes as the teststring grows exponentially. - # Worse, since 9x/ME are not pre-emptively multitasking, - # you end up with a "frozen" computer, even though with patience - # the test eventually succeeds (with a max line length of 256k). - # Instead, let's just punt: use the minimum linelength reported by - # all of the supported platforms: 8192 (on NT/2K/XP). - lt_cv_sys_max_cmd_len=8192; - ;; - - mint*) - # On MiNT this can take a long time and run out of memory. - lt_cv_sys_max_cmd_len=8192; - ;; - - amigaos*) - # On AmigaOS with pdksh, this test takes hours, literally. - # So we just punt and use a minimum line length of 8192. - lt_cv_sys_max_cmd_len=8192; - ;; - - bitrig* | darwin* | dragonfly* | freebsd* | netbsd* | openbsd*) - # This has been around since 386BSD, at least. Likely further. - if test -x /sbin/sysctl; then - lt_cv_sys_max_cmd_len=`/sbin/sysctl -n kern.argmax` - elif test -x /usr/sbin/sysctl; then - lt_cv_sys_max_cmd_len=`/usr/sbin/sysctl -n kern.argmax` - else - lt_cv_sys_max_cmd_len=65536 # usable default for all BSDs - fi - # And add a safety zone - lt_cv_sys_max_cmd_len=`expr $lt_cv_sys_max_cmd_len \/ 4` - lt_cv_sys_max_cmd_len=`expr $lt_cv_sys_max_cmd_len \* 3` - ;; - - interix*) - # We know the value 262144 and hardcode it with a safety zone (like BSD) - lt_cv_sys_max_cmd_len=196608 - ;; - - os2*) - # The test takes a long time on OS/2. - lt_cv_sys_max_cmd_len=8192 - ;; - - osf*) - # Dr. Hans Ekkehard Plesser reports seeing a kernel panic running configure - # due to this test when exec_disable_arg_limit is 1 on Tru64. It is not - # nice to cause kernel panics so lets avoid the loop below. - # First set a reasonable default. - lt_cv_sys_max_cmd_len=16384 - # - if test -x /sbin/sysconfig; then - case `/sbin/sysconfig -q proc exec_disable_arg_limit` in - *1*) lt_cv_sys_max_cmd_len=-1 ;; - esac - fi - ;; - sco3.2v5*) - lt_cv_sys_max_cmd_len=102400 - ;; - sysv5* | sco5v6* | sysv4.2uw2*) - kargmax=`grep ARG_MAX /etc/conf/cf.d/stune 2>/dev/null` - if test -n "$kargmax"; then - lt_cv_sys_max_cmd_len=`echo $kargmax | sed 's/.*[[ ]]//'` - else - lt_cv_sys_max_cmd_len=32768 - fi - ;; - *) - lt_cv_sys_max_cmd_len=`(getconf ARG_MAX) 2> /dev/null` - if test -n "$lt_cv_sys_max_cmd_len" && \ - test undefined != "$lt_cv_sys_max_cmd_len"; then - lt_cv_sys_max_cmd_len=`expr $lt_cv_sys_max_cmd_len \/ 4` - lt_cv_sys_max_cmd_len=`expr $lt_cv_sys_max_cmd_len \* 3` - else - # Make teststring a little bigger before we do anything with it. - # a 1K string should be a reasonable start. - for i in 1 2 3 4 5 6 7 8; do - teststring=$teststring$teststring - done - SHELL=${SHELL-${CONFIG_SHELL-/bin/sh}} - # If test is not a shell built-in, we'll probably end up computing a - # maximum length that is only half of the actual maximum length, but - # we can't tell. - while { test X`env echo "$teststring$teststring" 2>/dev/null` \ - = "X$teststring$teststring"; } >/dev/null 2>&1 && - test 17 != "$i" # 1/2 MB should be enough - do - i=`expr $i + 1` - teststring=$teststring$teststring - done - # Only check the string length outside the loop. - lt_cv_sys_max_cmd_len=`expr "X$teststring" : ".*" 2>&1` - teststring= - # Add a significant safety factor because C++ compilers can tack on - # massive amounts of additional arguments before passing them to the - # linker. It appears as though 1/2 is a usable value. - lt_cv_sys_max_cmd_len=`expr $lt_cv_sys_max_cmd_len \/ 2` - fi - ;; - esac -]) -if test -n "$lt_cv_sys_max_cmd_len"; then - AC_MSG_RESULT($lt_cv_sys_max_cmd_len) -else - AC_MSG_RESULT(none) -fi -max_cmd_len=$lt_cv_sys_max_cmd_len -_LT_DECL([], [max_cmd_len], [0], - [What is the maximum length of a command?]) -])# LT_CMD_MAX_LEN - -# Old name: -AU_ALIAS([AC_LIBTOOL_SYS_MAX_CMD_LEN], [LT_CMD_MAX_LEN]) -dnl aclocal-1.4 backwards compatibility: -dnl AC_DEFUN([AC_LIBTOOL_SYS_MAX_CMD_LEN], []) - - -# _LT_HEADER_DLFCN -# ---------------- -m4_defun([_LT_HEADER_DLFCN], -[AC_CHECK_HEADERS([dlfcn.h], [], [], [AC_INCLUDES_DEFAULT])dnl -])# _LT_HEADER_DLFCN - - -# _LT_TRY_DLOPEN_SELF (ACTION-IF-TRUE, ACTION-IF-TRUE-W-USCORE, -# ACTION-IF-FALSE, ACTION-IF-CROSS-COMPILING) -# ---------------------------------------------------------------- -m4_defun([_LT_TRY_DLOPEN_SELF], -[m4_require([_LT_HEADER_DLFCN])dnl -if test yes = "$cross_compiling"; then : - [$4] -else - lt_dlunknown=0; lt_dlno_uscore=1; lt_dlneed_uscore=2 - lt_status=$lt_dlunknown - cat > conftest.$ac_ext <<_LT_EOF -[#line $LINENO "configure" -#include "confdefs.h" - -#if HAVE_DLFCN_H -#include -#endif - -#include - -#ifdef RTLD_GLOBAL -# define LT_DLGLOBAL RTLD_GLOBAL -#else -# ifdef DL_GLOBAL -# define LT_DLGLOBAL DL_GLOBAL -# else -# define LT_DLGLOBAL 0 -# endif -#endif - -/* We may have to define LT_DLLAZY_OR_NOW in the command line if we - find out it does not work in some platform. */ -#ifndef LT_DLLAZY_OR_NOW -# ifdef RTLD_LAZY -# define LT_DLLAZY_OR_NOW RTLD_LAZY -# else -# ifdef DL_LAZY -# define LT_DLLAZY_OR_NOW DL_LAZY -# else -# ifdef RTLD_NOW -# define LT_DLLAZY_OR_NOW RTLD_NOW -# else -# ifdef DL_NOW -# define LT_DLLAZY_OR_NOW DL_NOW -# else -# define LT_DLLAZY_OR_NOW 0 -# endif -# endif -# endif -# endif -#endif - -/* When -fvisibility=hidden is used, assume the code has been annotated - correspondingly for the symbols needed. */ -#if defined __GNUC__ && (((__GNUC__ == 3) && (__GNUC_MINOR__ >= 3)) || (__GNUC__ > 3)) -int fnord () __attribute__((visibility("default"))); -#endif - -int fnord () { return 42; } -int main () -{ - void *self = dlopen (0, LT_DLGLOBAL|LT_DLLAZY_OR_NOW); - int status = $lt_dlunknown; - - if (self) - { - if (dlsym (self,"fnord")) status = $lt_dlno_uscore; - else - { - if (dlsym( self,"_fnord")) status = $lt_dlneed_uscore; - else puts (dlerror ()); - } - /* dlclose (self); */ - } - else - puts (dlerror ()); - - return status; -}] -_LT_EOF - if AC_TRY_EVAL(ac_link) && test -s "conftest$ac_exeext" 2>/dev/null; then - (./conftest; exit; ) >&AS_MESSAGE_LOG_FD 2>/dev/null - lt_status=$? - case x$lt_status in - x$lt_dlno_uscore) $1 ;; - x$lt_dlneed_uscore) $2 ;; - x$lt_dlunknown|x*) $3 ;; - esac - else : - # compilation failed - $3 - fi -fi -rm -fr conftest* -])# _LT_TRY_DLOPEN_SELF - - -# LT_SYS_DLOPEN_SELF -# ------------------ -AC_DEFUN([LT_SYS_DLOPEN_SELF], -[m4_require([_LT_HEADER_DLFCN])dnl -if test yes != "$enable_dlopen"; then - enable_dlopen=unknown - enable_dlopen_self=unknown - enable_dlopen_self_static=unknown -else - lt_cv_dlopen=no - lt_cv_dlopen_libs= - - case $host_os in - beos*) - lt_cv_dlopen=load_add_on - lt_cv_dlopen_libs= - lt_cv_dlopen_self=yes - ;; - - mingw* | pw32* | cegcc*) - lt_cv_dlopen=LoadLibrary - lt_cv_dlopen_libs= - ;; - - cygwin*) - lt_cv_dlopen=dlopen - lt_cv_dlopen_libs= - ;; - - darwin*) - # if libdl is installed we need to link against it - AC_CHECK_LIB([dl], [dlopen], - [lt_cv_dlopen=dlopen lt_cv_dlopen_libs=-ldl],[ - lt_cv_dlopen=dyld - lt_cv_dlopen_libs= - lt_cv_dlopen_self=yes - ]) - ;; - - tpf*) - # Don't try to run any link tests for TPF. We know it's impossible - # because TPF is a cross-compiler, and we know how we open DSOs. - lt_cv_dlopen=dlopen - lt_cv_dlopen_libs= - lt_cv_dlopen_self=no - ;; - - *) - AC_CHECK_FUNC([shl_load], - [lt_cv_dlopen=shl_load], - [AC_CHECK_LIB([dld], [shl_load], - [lt_cv_dlopen=shl_load lt_cv_dlopen_libs=-ldld], - [AC_CHECK_FUNC([dlopen], - [lt_cv_dlopen=dlopen], - [AC_CHECK_LIB([dl], [dlopen], - [lt_cv_dlopen=dlopen lt_cv_dlopen_libs=-ldl], - [AC_CHECK_LIB([svld], [dlopen], - [lt_cv_dlopen=dlopen lt_cv_dlopen_libs=-lsvld], - [AC_CHECK_LIB([dld], [dld_link], - [lt_cv_dlopen=dld_link lt_cv_dlopen_libs=-ldld]) - ]) - ]) - ]) - ]) - ]) - ;; - esac - - if test no = "$lt_cv_dlopen"; then - enable_dlopen=no - else - enable_dlopen=yes - fi - - case $lt_cv_dlopen in - dlopen) - save_CPPFLAGS=$CPPFLAGS - test yes = "$ac_cv_header_dlfcn_h" && CPPFLAGS="$CPPFLAGS -DHAVE_DLFCN_H" - - save_LDFLAGS=$LDFLAGS - wl=$lt_prog_compiler_wl eval LDFLAGS=\"\$LDFLAGS $export_dynamic_flag_spec\" - - save_LIBS=$LIBS - LIBS="$lt_cv_dlopen_libs $LIBS" - - AC_CACHE_CHECK([whether a program can dlopen itself], - lt_cv_dlopen_self, [dnl - _LT_TRY_DLOPEN_SELF( - lt_cv_dlopen_self=yes, lt_cv_dlopen_self=yes, - lt_cv_dlopen_self=no, lt_cv_dlopen_self=cross) - ]) - - if test yes = "$lt_cv_dlopen_self"; then - wl=$lt_prog_compiler_wl eval LDFLAGS=\"\$LDFLAGS $lt_prog_compiler_static\" - AC_CACHE_CHECK([whether a statically linked program can dlopen itself], - lt_cv_dlopen_self_static, [dnl - _LT_TRY_DLOPEN_SELF( - lt_cv_dlopen_self_static=yes, lt_cv_dlopen_self_static=yes, - lt_cv_dlopen_self_static=no, lt_cv_dlopen_self_static=cross) - ]) - fi - - CPPFLAGS=$save_CPPFLAGS - LDFLAGS=$save_LDFLAGS - LIBS=$save_LIBS - ;; - esac - - case $lt_cv_dlopen_self in - yes|no) enable_dlopen_self=$lt_cv_dlopen_self ;; - *) enable_dlopen_self=unknown ;; - esac - - case $lt_cv_dlopen_self_static in - yes|no) enable_dlopen_self_static=$lt_cv_dlopen_self_static ;; - *) enable_dlopen_self_static=unknown ;; - esac -fi -_LT_DECL([dlopen_support], [enable_dlopen], [0], - [Whether dlopen is supported]) -_LT_DECL([dlopen_self], [enable_dlopen_self], [0], - [Whether dlopen of programs is supported]) -_LT_DECL([dlopen_self_static], [enable_dlopen_self_static], [0], - [Whether dlopen of statically linked programs is supported]) -])# LT_SYS_DLOPEN_SELF - -# Old name: -AU_ALIAS([AC_LIBTOOL_DLOPEN_SELF], [LT_SYS_DLOPEN_SELF]) -dnl aclocal-1.4 backwards compatibility: -dnl AC_DEFUN([AC_LIBTOOL_DLOPEN_SELF], []) - - -# _LT_COMPILER_C_O([TAGNAME]) -# --------------------------- -# Check to see if options -c and -o are simultaneously supported by compiler. -# This macro does not hard code the compiler like AC_PROG_CC_C_O. -m4_defun([_LT_COMPILER_C_O], -[m4_require([_LT_DECL_SED])dnl -m4_require([_LT_FILEUTILS_DEFAULTS])dnl -m4_require([_LT_TAG_COMPILER])dnl -AC_CACHE_CHECK([if $compiler supports -c -o file.$ac_objext], - [_LT_TAGVAR(lt_cv_prog_compiler_c_o, $1)], - [_LT_TAGVAR(lt_cv_prog_compiler_c_o, $1)=no - $RM -r conftest 2>/dev/null - mkdir conftest - cd conftest - mkdir out - echo "$lt_simple_compile_test_code" > conftest.$ac_ext - - lt_compiler_flag="-o out/conftest2.$ac_objext" - # Insert the option either (1) after the last *FLAGS variable, or - # (2) before a word containing "conftest.", or (3) at the end. - # Note that $ac_compile itself does not contain backslashes and begins - # with a dollar sign (not a hyphen), so the echo should work correctly. - lt_compile=`echo "$ac_compile" | $SED \ - -e 's:.*FLAGS}\{0,1\} :&$lt_compiler_flag :; t' \ - -e 's: [[^ ]]*conftest\.: $lt_compiler_flag&:; t' \ - -e 's:$: $lt_compiler_flag:'` - (eval echo "\"\$as_me:$LINENO: $lt_compile\"" >&AS_MESSAGE_LOG_FD) - (eval "$lt_compile" 2>out/conftest.err) - ac_status=$? - cat out/conftest.err >&AS_MESSAGE_LOG_FD - echo "$as_me:$LINENO: \$? = $ac_status" >&AS_MESSAGE_LOG_FD - if (exit $ac_status) && test -s out/conftest2.$ac_objext - then - # The compiler can only warn and ignore the option if not recognized - # So say no if there are warnings - $ECHO "$_lt_compiler_boilerplate" | $SED '/^$/d' > out/conftest.exp - $SED '/^$/d; /^ *+/d' out/conftest.err >out/conftest.er2 - if test ! -s out/conftest.er2 || diff out/conftest.exp out/conftest.er2 >/dev/null; then - _LT_TAGVAR(lt_cv_prog_compiler_c_o, $1)=yes - fi - fi - chmod u+w . 2>&AS_MESSAGE_LOG_FD - $RM conftest* - # SGI C++ compiler will create directory out/ii_files/ for - # template instantiation - test -d out/ii_files && $RM out/ii_files/* && rmdir out/ii_files - $RM out/* && rmdir out - cd .. - $RM -r conftest - $RM conftest* -]) -_LT_TAGDECL([compiler_c_o], [lt_cv_prog_compiler_c_o], [1], - [Does compiler simultaneously support -c and -o options?]) -])# _LT_COMPILER_C_O - - -# _LT_COMPILER_FILE_LOCKS([TAGNAME]) -# ---------------------------------- -# Check to see if we can do hard links to lock some files if needed -m4_defun([_LT_COMPILER_FILE_LOCKS], -[m4_require([_LT_ENABLE_LOCK])dnl -m4_require([_LT_FILEUTILS_DEFAULTS])dnl -_LT_COMPILER_C_O([$1]) - -hard_links=nottested -if test no = "$_LT_TAGVAR(lt_cv_prog_compiler_c_o, $1)" && test no != "$need_locks"; then - # do not overwrite the value of need_locks provided by the user - AC_MSG_CHECKING([if we can lock with hard links]) - hard_links=yes - $RM conftest* - ln conftest.a conftest.b 2>/dev/null && hard_links=no - touch conftest.a - ln conftest.a conftest.b 2>&5 || hard_links=no - ln conftest.a conftest.b 2>/dev/null && hard_links=no - AC_MSG_RESULT([$hard_links]) - if test no = "$hard_links"; then - AC_MSG_WARN(['$CC' does not support '-c -o', so 'make -j' may be unsafe]) - need_locks=warn - fi -else - need_locks=no -fi -_LT_DECL([], [need_locks], [1], [Must we lock files when doing compilation?]) -])# _LT_COMPILER_FILE_LOCKS - - -# _LT_CHECK_OBJDIR -# ---------------- -m4_defun([_LT_CHECK_OBJDIR], -[AC_CACHE_CHECK([for objdir], [lt_cv_objdir], -[rm -f .libs 2>/dev/null -mkdir .libs 2>/dev/null -if test -d .libs; then - lt_cv_objdir=.libs -else - # MS-DOS does not allow filenames that begin with a dot. - lt_cv_objdir=_libs -fi -rmdir .libs 2>/dev/null]) -objdir=$lt_cv_objdir -_LT_DECL([], [objdir], [0], - [The name of the directory that contains temporary libtool files])dnl -m4_pattern_allow([LT_OBJDIR])dnl -AC_DEFINE_UNQUOTED([LT_OBJDIR], "$lt_cv_objdir/", - [Define to the sub-directory where libtool stores uninstalled libraries.]) -])# _LT_CHECK_OBJDIR - - -# _LT_LINKER_HARDCODE_LIBPATH([TAGNAME]) -# -------------------------------------- -# Check hardcoding attributes. -m4_defun([_LT_LINKER_HARDCODE_LIBPATH], -[AC_MSG_CHECKING([how to hardcode library paths into programs]) -_LT_TAGVAR(hardcode_action, $1)= -if test -n "$_LT_TAGVAR(hardcode_libdir_flag_spec, $1)" || - test -n "$_LT_TAGVAR(runpath_var, $1)" || - test yes = "$_LT_TAGVAR(hardcode_automatic, $1)"; then - - # We can hardcode non-existent directories. - if test no != "$_LT_TAGVAR(hardcode_direct, $1)" && - # If the only mechanism to avoid hardcoding is shlibpath_var, we - # have to relink, otherwise we might link with an installed library - # when we should be linking with a yet-to-be-installed one - ## test no != "$_LT_TAGVAR(hardcode_shlibpath_var, $1)" && - test no != "$_LT_TAGVAR(hardcode_minus_L, $1)"; then - # Linking always hardcodes the temporary library directory. - _LT_TAGVAR(hardcode_action, $1)=relink - else - # We can link without hardcoding, and we can hardcode nonexisting dirs. - _LT_TAGVAR(hardcode_action, $1)=immediate - fi -else - # We cannot hardcode anything, or else we can only hardcode existing - # directories. - _LT_TAGVAR(hardcode_action, $1)=unsupported -fi -AC_MSG_RESULT([$_LT_TAGVAR(hardcode_action, $1)]) - -if test relink = "$_LT_TAGVAR(hardcode_action, $1)" || - test yes = "$_LT_TAGVAR(inherit_rpath, $1)"; then - # Fast installation is not supported - enable_fast_install=no -elif test yes = "$shlibpath_overrides_runpath" || - test no = "$enable_shared"; then - # Fast installation is not necessary - enable_fast_install=needless -fi -_LT_TAGDECL([], [hardcode_action], [0], - [How to hardcode a shared library path into an executable]) -])# _LT_LINKER_HARDCODE_LIBPATH - - -# _LT_CMD_STRIPLIB -# ---------------- -m4_defun([_LT_CMD_STRIPLIB], -[m4_require([_LT_DECL_EGREP]) -striplib= -old_striplib= -AC_MSG_CHECKING([whether stripping libraries is possible]) -if test -n "$STRIP" && $STRIP -V 2>&1 | $GREP "GNU strip" >/dev/null; then - test -z "$old_striplib" && old_striplib="$STRIP --strip-debug" - test -z "$striplib" && striplib="$STRIP --strip-unneeded" - AC_MSG_RESULT([yes]) -else -# FIXME - insert some real tests, host_os isn't really good enough - case $host_os in - darwin*) - if test -n "$STRIP"; then - striplib="$STRIP -x" - old_striplib="$STRIP -S" - AC_MSG_RESULT([yes]) - else - AC_MSG_RESULT([no]) - fi - ;; - *) - AC_MSG_RESULT([no]) - ;; - esac -fi -_LT_DECL([], [old_striplib], [1], [Commands to strip libraries]) -_LT_DECL([], [striplib], [1]) -])# _LT_CMD_STRIPLIB - - -# _LT_PREPARE_MUNGE_PATH_LIST -# --------------------------- -# Make sure func_munge_path_list() is defined correctly. -m4_defun([_LT_PREPARE_MUNGE_PATH_LIST], -[[# func_munge_path_list VARIABLE PATH -# ----------------------------------- -# VARIABLE is name of variable containing _space_ separated list of -# directories to be munged by the contents of PATH, which is string -# having a format: -# "DIR[:DIR]:" -# string "DIR[ DIR]" will be prepended to VARIABLE -# ":DIR[:DIR]" -# string "DIR[ DIR]" will be appended to VARIABLE -# "DIRP[:DIRP]::[DIRA:]DIRA" -# string "DIRP[ DIRP]" will be prepended to VARIABLE and string -# "DIRA[ DIRA]" will be appended to VARIABLE -# "DIR[:DIR]" -# VARIABLE will be replaced by "DIR[ DIR]" -func_munge_path_list () -{ - case x@S|@2 in - x) - ;; - *:) - eval @S|@1=\"`$ECHO @S|@2 | $SED 's/:/ /g'` \@S|@@S|@1\" - ;; - x:*) - eval @S|@1=\"\@S|@@S|@1 `$ECHO @S|@2 | $SED 's/:/ /g'`\" - ;; - *::*) - eval @S|@1=\"\@S|@@S|@1\ `$ECHO @S|@2 | $SED -e 's/.*:://' -e 's/:/ /g'`\" - eval @S|@1=\"`$ECHO @S|@2 | $SED -e 's/::.*//' -e 's/:/ /g'`\ \@S|@@S|@1\" - ;; - *) - eval @S|@1=\"`$ECHO @S|@2 | $SED 's/:/ /g'`\" - ;; - esac -} -]])# _LT_PREPARE_PATH_LIST - - -# _LT_SYS_DYNAMIC_LINKER([TAG]) -# ----------------------------- -# PORTME Fill in your ld.so characteristics -m4_defun([_LT_SYS_DYNAMIC_LINKER], -[AC_REQUIRE([AC_CANONICAL_HOST])dnl -m4_require([_LT_DECL_EGREP])dnl -m4_require([_LT_FILEUTILS_DEFAULTS])dnl -m4_require([_LT_DECL_OBJDUMP])dnl -m4_require([_LT_DECL_SED])dnl -m4_require([_LT_CHECK_SHELL_FEATURES])dnl -m4_require([_LT_PREPARE_MUNGE_PATH_LIST])dnl -AC_MSG_CHECKING([dynamic linker characteristics]) -m4_if([$1], - [], [ -if test yes = "$GCC"; then - case $host_os in - darwin*) lt_awk_arg='/^libraries:/,/LR/' ;; - *) lt_awk_arg='/^libraries:/' ;; - esac - case $host_os in - mingw* | cegcc*) lt_sed_strip_eq='s|=\([[A-Za-z]]:\)|\1|g' ;; - *) lt_sed_strip_eq='s|=/|/|g' ;; - esac - lt_search_path_spec=`$CC -print-search-dirs | awk $lt_awk_arg | $SED -e "s/^libraries://" -e $lt_sed_strip_eq` - case $lt_search_path_spec in - *\;*) - # if the path contains ";" then we assume it to be the separator - # otherwise default to the standard path separator (i.e. ":") - it is - # assumed that no part of a normal pathname contains ";" but that should - # okay in the real world where ";" in dirpaths is itself problematic. - lt_search_path_spec=`$ECHO "$lt_search_path_spec" | $SED 's/;/ /g'` - ;; - *) - lt_search_path_spec=`$ECHO "$lt_search_path_spec" | $SED "s/$PATH_SEPARATOR/ /g"` - ;; - esac - # Ok, now we have the path, separated by spaces, we can step through it - # and add multilib dir if necessary... - lt_tmp_lt_search_path_spec= - lt_multi_os_dir=/`$CC $CPPFLAGS $CFLAGS $LDFLAGS -print-multi-os-directory 2>/dev/null` - # ...but if some path component already ends with the multilib dir we assume - # that all is fine and trust -print-search-dirs as is (GCC 4.2? or newer). - case "$lt_multi_os_dir; $lt_search_path_spec " in - "/; "* | "/.; "* | "/./; "* | *"$lt_multi_os_dir "* | *"$lt_multi_os_dir/ "*) - lt_multi_os_dir= - ;; - esac - for lt_sys_path in $lt_search_path_spec; do - if test -d "$lt_sys_path$lt_multi_os_dir"; then - lt_tmp_lt_search_path_spec="$lt_tmp_lt_search_path_spec $lt_sys_path$lt_multi_os_dir" - elif test -n "$lt_multi_os_dir"; then - test -d "$lt_sys_path" && \ - lt_tmp_lt_search_path_spec="$lt_tmp_lt_search_path_spec $lt_sys_path" - fi - done - lt_search_path_spec=`$ECHO "$lt_tmp_lt_search_path_spec" | awk ' -BEGIN {RS = " "; FS = "/|\n";} { - lt_foo = ""; - lt_count = 0; - for (lt_i = NF; lt_i > 0; lt_i--) { - if ($lt_i != "" && $lt_i != ".") { - if ($lt_i == "..") { - lt_count++; - } else { - if (lt_count == 0) { - lt_foo = "/" $lt_i lt_foo; - } else { - lt_count--; - } - } - } - } - if (lt_foo != "") { lt_freq[[lt_foo]]++; } - if (lt_freq[[lt_foo]] == 1) { print lt_foo; } -}'` - # AWK program above erroneously prepends '/' to C:/dos/paths - # for these hosts. - case $host_os in - mingw* | cegcc*) lt_search_path_spec=`$ECHO "$lt_search_path_spec" |\ - $SED 's|/\([[A-Za-z]]:\)|\1|g'` ;; - esac - sys_lib_search_path_spec=`$ECHO "$lt_search_path_spec" | $lt_NL2SP` -else - sys_lib_search_path_spec="/lib /usr/lib /usr/local/lib" -fi]) -library_names_spec= -libname_spec='lib$name' -soname_spec= -shrext_cmds=.so -postinstall_cmds= -postuninstall_cmds= -finish_cmds= -finish_eval= -shlibpath_var= -shlibpath_overrides_runpath=unknown -version_type=none -dynamic_linker="$host_os ld.so" -sys_lib_dlsearch_path_spec="/lib /usr/lib" -need_lib_prefix=unknown -hardcode_into_libs=no - -# when you set need_version to no, make sure it does not cause -set_version -# flags to be left without arguments -need_version=unknown - -AC_ARG_VAR([LT_SYS_LIBRARY_PATH], -[User-defined run-time library search path.]) - -case $host_os in -aix3*) - version_type=linux # correct to gnu/linux during the next big refactor - library_names_spec='$libname$release$shared_ext$versuffix $libname.a' - shlibpath_var=LIBPATH - - # AIX 3 has no versioning support, so we append a major version to the name. - soname_spec='$libname$release$shared_ext$major' - ;; - -aix[[4-9]]*) - version_type=linux # correct to gnu/linux during the next big refactor - need_lib_prefix=no - need_version=no - hardcode_into_libs=yes - if test ia64 = "$host_cpu"; then - # AIX 5 supports IA64 - library_names_spec='$libname$release$shared_ext$major $libname$release$shared_ext$versuffix $libname$shared_ext' - shlibpath_var=LD_LIBRARY_PATH - else - # With GCC up to 2.95.x, collect2 would create an import file - # for dependence libraries. The import file would start with - # the line '#! .'. This would cause the generated library to - # depend on '.', always an invalid library. This was fixed in - # development snapshots of GCC prior to 3.0. - case $host_os in - aix4 | aix4.[[01]] | aix4.[[01]].*) - if { echo '#if __GNUC__ > 2 || (__GNUC__ == 2 && __GNUC_MINOR__ >= 97)' - echo ' yes ' - echo '#endif'; } | $CC -E - | $GREP yes > /dev/null; then - : - else - can_build_shared=no - fi - ;; - esac - # Using Import Files as archive members, it is possible to support - # filename-based versioning of shared library archives on AIX. While - # this would work for both with and without runtime linking, it will - # prevent static linking of such archives. So we do filename-based - # shared library versioning with .so extension only, which is used - # when both runtime linking and shared linking is enabled. - # Unfortunately, runtime linking may impact performance, so we do - # not want this to be the default eventually. Also, we use the - # versioned .so libs for executables only if there is the -brtl - # linker flag in LDFLAGS as well, or --with-aix-soname=svr4 only. - # To allow for filename-based versioning support, we need to create - # libNAME.so.V as an archive file, containing: - # *) an Import File, referring to the versioned filename of the - # archive as well as the shared archive member, telling the - # bitwidth (32 or 64) of that shared object, and providing the - # list of exported symbols of that shared object, eventually - # decorated with the 'weak' keyword - # *) the shared object with the F_LOADONLY flag set, to really avoid - # it being seen by the linker. - # At run time we better use the real file rather than another symlink, - # but for link time we create the symlink libNAME.so -> libNAME.so.V - - case $with_aix_soname,$aix_use_runtimelinking in - # AIX (on Power*) has no versioning support, so currently we cannot hardcode correct - # soname into executable. Probably we can add versioning support to - # collect2, so additional links can be useful in future. - aix,yes) # traditional libtool - dynamic_linker='AIX unversionable lib.so' - # If using run time linking (on AIX 4.2 or later) use lib.so - # instead of lib.a to let people know that these are not - # typical AIX shared libraries. - library_names_spec='$libname$release$shared_ext$versuffix $libname$release$shared_ext$major $libname$shared_ext' - ;; - aix,no) # traditional AIX only - dynamic_linker='AIX lib.a[(]lib.so.V[)]' - # We preserve .a as extension for shared libraries through AIX4.2 - # and later when we are not doing run time linking. - library_names_spec='$libname$release.a $libname.a' - soname_spec='$libname$release$shared_ext$major' - ;; - svr4,*) # full svr4 only - dynamic_linker="AIX lib.so.V[(]$shared_archive_member_spec.o[)]" - library_names_spec='$libname$release$shared_ext$major $libname$shared_ext' - # We do not specify a path in Import Files, so LIBPATH fires. - shlibpath_overrides_runpath=yes - ;; - *,yes) # both, prefer svr4 - dynamic_linker="AIX lib.so.V[(]$shared_archive_member_spec.o[)], lib.a[(]lib.so.V[)]" - library_names_spec='$libname$release$shared_ext$major $libname$shared_ext' - # unpreferred sharedlib libNAME.a needs extra handling - postinstall_cmds='test -n "$linkname" || linkname="$realname"~func_stripname "" ".so" "$linkname"~$install_shared_prog "$dir/$func_stripname_result.$libext" "$destdir/$func_stripname_result.$libext"~test -z "$tstripme" || test -z "$striplib" || $striplib "$destdir/$func_stripname_result.$libext"' - postuninstall_cmds='for n in $library_names $old_library; do :; done~func_stripname "" ".so" "$n"~test "$func_stripname_result" = "$n" || func_append rmfiles " $odir/$func_stripname_result.$libext"' - # We do not specify a path in Import Files, so LIBPATH fires. - shlibpath_overrides_runpath=yes - ;; - *,no) # both, prefer aix - dynamic_linker="AIX lib.a[(]lib.so.V[)], lib.so.V[(]$shared_archive_member_spec.o[)]" - library_names_spec='$libname$release.a $libname.a' - soname_spec='$libname$release$shared_ext$major' - # unpreferred sharedlib libNAME.so.V and symlink libNAME.so need extra handling - postinstall_cmds='test -z "$dlname" || $install_shared_prog $dir/$dlname $destdir/$dlname~test -z "$tstripme" || test -z "$striplib" || $striplib $destdir/$dlname~test -n "$linkname" || linkname=$realname~func_stripname "" ".a" "$linkname"~(cd "$destdir" && $LN_S -f $dlname $func_stripname_result.so)' - postuninstall_cmds='test -z "$dlname" || func_append rmfiles " $odir/$dlname"~for n in $old_library $library_names; do :; done~func_stripname "" ".a" "$n"~func_append rmfiles " $odir/$func_stripname_result.so"' - ;; - esac - shlibpath_var=LIBPATH - fi - ;; - -amigaos*) - case $host_cpu in - powerpc) - # Since July 2007 AmigaOS4 officially supports .so libraries. - # When compiling the executable, add -use-dynld -Lsobjs: to the compileline. - library_names_spec='$libname$release$shared_ext$versuffix $libname$release$shared_ext$major $libname$shared_ext' - ;; - m68k) - library_names_spec='$libname.ixlibrary $libname.a' - # Create ${libname}_ixlibrary.a entries in /sys/libs. - finish_eval='for lib in `ls $libdir/*.ixlibrary 2>/dev/null`; do libname=`func_echo_all "$lib" | $SED '\''s%^.*/\([[^/]]*\)\.ixlibrary$%\1%'\''`; $RM /sys/libs/${libname}_ixlibrary.a; $show "cd /sys/libs && $LN_S $lib ${libname}_ixlibrary.a"; cd /sys/libs && $LN_S $lib ${libname}_ixlibrary.a || exit 1; done' - ;; - esac - ;; - -beos*) - library_names_spec='$libname$shared_ext' - dynamic_linker="$host_os ld.so" - shlibpath_var=LIBRARY_PATH - ;; - -bsdi[[45]]*) - version_type=linux # correct to gnu/linux during the next big refactor - need_version=no - library_names_spec='$libname$release$shared_ext$versuffix $libname$release$shared_ext$major $libname$shared_ext' - soname_spec='$libname$release$shared_ext$major' - finish_cmds='PATH="\$PATH:/sbin" ldconfig $libdir' - shlibpath_var=LD_LIBRARY_PATH - sys_lib_search_path_spec="/shlib /usr/lib /usr/X11/lib /usr/contrib/lib /lib /usr/local/lib" - sys_lib_dlsearch_path_spec="/shlib /usr/lib /usr/local/lib" - # the default ld.so.conf also contains /usr/contrib/lib and - # /usr/X11R6/lib (/usr/X11 is a link to /usr/X11R6), but let us allow - # libtool to hard-code these into programs - ;; - -cygwin* | mingw* | pw32* | cegcc*) - version_type=windows - shrext_cmds=.dll - need_version=no - need_lib_prefix=no - - case $GCC,$cc_basename in - yes,*) - # gcc - library_names_spec='$libname.dll.a' - # DLL is installed to $(libdir)/../bin by postinstall_cmds - postinstall_cmds='base_file=`basename \$file`~ - dlpath=`$SHELL 2>&1 -c '\''. $dir/'\''\$base_file'\''i; echo \$dlname'\''`~ - dldir=$destdir/`dirname \$dlpath`~ - test -d \$dldir || mkdir -p \$dldir~ - $install_prog $dir/$dlname \$dldir/$dlname~ - chmod a+x \$dldir/$dlname~ - if test -n '\''$stripme'\'' && test -n '\''$striplib'\''; then - eval '\''$striplib \$dldir/$dlname'\'' || exit \$?; - fi' - postuninstall_cmds='dldll=`$SHELL 2>&1 -c '\''. $file; echo \$dlname'\''`~ - dlpath=$dir/\$dldll~ - $RM \$dlpath' - shlibpath_overrides_runpath=yes - - case $host_os in - cygwin*) - # Cygwin DLLs use 'cyg' prefix rather than 'lib' - soname_spec='`echo $libname | sed -e 's/^lib/cyg/'``echo $release | $SED -e 's/[[.]]/-/g'`$versuffix$shared_ext' -m4_if([$1], [],[ - sys_lib_search_path_spec="$sys_lib_search_path_spec /usr/lib/w32api"]) - ;; - mingw* | cegcc*) - # MinGW DLLs use traditional 'lib' prefix - soname_spec='$libname`echo $release | $SED -e 's/[[.]]/-/g'`$versuffix$shared_ext' - ;; - pw32*) - # pw32 DLLs use 'pw' prefix rather than 'lib' - library_names_spec='`echo $libname | sed -e 's/^lib/pw/'``echo $release | $SED -e 's/[[.]]/-/g'`$versuffix$shared_ext' - ;; - esac - dynamic_linker='Win32 ld.exe' - ;; - - *,cl*) - # Native MSVC - libname_spec='$name' - soname_spec='$libname`echo $release | $SED -e 's/[[.]]/-/g'`$versuffix$shared_ext' - library_names_spec='$libname.dll.lib' - - case $build_os in - mingw*) - sys_lib_search_path_spec= - lt_save_ifs=$IFS - IFS=';' - for lt_path in $LIB - do - IFS=$lt_save_ifs - # Let DOS variable expansion print the short 8.3 style file name. - lt_path=`cd "$lt_path" 2>/dev/null && cmd //C "for %i in (".") do @echo %~si"` - sys_lib_search_path_spec="$sys_lib_search_path_spec $lt_path" - done - IFS=$lt_save_ifs - # Convert to MSYS style. - sys_lib_search_path_spec=`$ECHO "$sys_lib_search_path_spec" | sed -e 's|\\\\|/|g' -e 's| \\([[a-zA-Z]]\\):| /\\1|g' -e 's|^ ||'` - ;; - cygwin*) - # Convert to unix form, then to dos form, then back to unix form - # but this time dos style (no spaces!) so that the unix form looks - # like /cygdrive/c/PROGRA~1:/cygdr... - sys_lib_search_path_spec=`cygpath --path --unix "$LIB"` - sys_lib_search_path_spec=`cygpath --path --dos "$sys_lib_search_path_spec" 2>/dev/null` - sys_lib_search_path_spec=`cygpath --path --unix "$sys_lib_search_path_spec" | $SED -e "s/$PATH_SEPARATOR/ /g"` - ;; - *) - sys_lib_search_path_spec=$LIB - if $ECHO "$sys_lib_search_path_spec" | [$GREP ';[c-zC-Z]:/' >/dev/null]; then - # It is most probably a Windows format PATH. - sys_lib_search_path_spec=`$ECHO "$sys_lib_search_path_spec" | $SED -e 's/;/ /g'` - else - sys_lib_search_path_spec=`$ECHO "$sys_lib_search_path_spec" | $SED -e "s/$PATH_SEPARATOR/ /g"` - fi - # FIXME: find the short name or the path components, as spaces are - # common. (e.g. "Program Files" -> "PROGRA~1") - ;; - esac - - # DLL is installed to $(libdir)/../bin by postinstall_cmds - postinstall_cmds='base_file=`basename \$file`~ - dlpath=`$SHELL 2>&1 -c '\''. $dir/'\''\$base_file'\''i; echo \$dlname'\''`~ - dldir=$destdir/`dirname \$dlpath`~ - test -d \$dldir || mkdir -p \$dldir~ - $install_prog $dir/$dlname \$dldir/$dlname' - postuninstall_cmds='dldll=`$SHELL 2>&1 -c '\''. $file; echo \$dlname'\''`~ - dlpath=$dir/\$dldll~ - $RM \$dlpath' - shlibpath_overrides_runpath=yes - dynamic_linker='Win32 link.exe' - ;; - - *) - # Assume MSVC wrapper - library_names_spec='$libname`echo $release | $SED -e 's/[[.]]/-/g'`$versuffix$shared_ext $libname.lib' - dynamic_linker='Win32 ld.exe' - ;; - esac - # FIXME: first we should search . and the directory the executable is in - shlibpath_var=PATH - ;; - -darwin* | rhapsody*) - dynamic_linker="$host_os dyld" - version_type=darwin - need_lib_prefix=no - need_version=no - library_names_spec='$libname$release$major$shared_ext $libname$shared_ext' - soname_spec='$libname$release$major$shared_ext' - shlibpath_overrides_runpath=yes - shlibpath_var=DYLD_LIBRARY_PATH - shrext_cmds='`test .$module = .yes && echo .so || echo .dylib`' -m4_if([$1], [],[ - sys_lib_search_path_spec="$sys_lib_search_path_spec /usr/local/lib"]) - sys_lib_dlsearch_path_spec='/usr/local/lib /lib /usr/lib' - ;; - -dgux*) - version_type=linux # correct to gnu/linux during the next big refactor - need_lib_prefix=no - need_version=no - library_names_spec='$libname$release$shared_ext$versuffix $libname$release$shared_ext$major $libname$shared_ext' - soname_spec='$libname$release$shared_ext$major' - shlibpath_var=LD_LIBRARY_PATH - ;; - -freebsd* | dragonfly*) - # DragonFly does not have aout. When/if they implement a new - # versioning mechanism, adjust this. - if test -x /usr/bin/objformat; then - objformat=`/usr/bin/objformat` - else - case $host_os in - freebsd[[23]].*) objformat=aout ;; - *) objformat=elf ;; - esac - fi - version_type=freebsd-$objformat - case $version_type in - freebsd-elf*) - library_names_spec='$libname$release$shared_ext$versuffix $libname$release$shared_ext$major $libname$shared_ext' - soname_spec='$libname$release$shared_ext$major' - need_version=no - need_lib_prefix=no - ;; - freebsd-*) - library_names_spec='$libname$release$shared_ext$versuffix $libname$shared_ext$versuffix' - need_version=yes - ;; - esac - shlibpath_var=LD_LIBRARY_PATH - case $host_os in - freebsd2.*) - shlibpath_overrides_runpath=yes - ;; - freebsd3.[[01]]* | freebsdelf3.[[01]]*) - shlibpath_overrides_runpath=yes - hardcode_into_libs=yes - ;; - freebsd3.[[2-9]]* | freebsdelf3.[[2-9]]* | \ - freebsd4.[[0-5]] | freebsdelf4.[[0-5]] | freebsd4.1.1 | freebsdelf4.1.1) - shlibpath_overrides_runpath=no - hardcode_into_libs=yes - ;; - *) # from 4.6 on, and DragonFly - shlibpath_overrides_runpath=yes - hardcode_into_libs=yes - ;; - esac - ;; - -haiku*) - version_type=linux # correct to gnu/linux during the next big refactor - need_lib_prefix=no - need_version=no - dynamic_linker="$host_os runtime_loader" - library_names_spec='$libname$release$shared_ext$versuffix $libname$release$shared_ext$major $libname$shared_ext' - soname_spec='$libname$release$shared_ext$major' - shlibpath_var=LIBRARY_PATH - shlibpath_overrides_runpath=no - sys_lib_dlsearch_path_spec='/boot/home/config/lib /boot/common/lib /boot/system/lib' - hardcode_into_libs=yes - ;; - -hpux9* | hpux10* | hpux11*) - # Give a soname corresponding to the major version so that dld.sl refuses to - # link against other versions. - version_type=sunos - need_lib_prefix=no - need_version=no - case $host_cpu in - ia64*) - shrext_cmds='.so' - hardcode_into_libs=yes - dynamic_linker="$host_os dld.so" - shlibpath_var=LD_LIBRARY_PATH - shlibpath_overrides_runpath=yes # Unless +noenvvar is specified. - library_names_spec='$libname$release$shared_ext$versuffix $libname$release$shared_ext$major $libname$shared_ext' - soname_spec='$libname$release$shared_ext$major' - if test 32 = "$HPUX_IA64_MODE"; then - sys_lib_search_path_spec="/usr/lib/hpux32 /usr/local/lib/hpux32 /usr/local/lib" - sys_lib_dlsearch_path_spec=/usr/lib/hpux32 - else - sys_lib_search_path_spec="/usr/lib/hpux64 /usr/local/lib/hpux64" - sys_lib_dlsearch_path_spec=/usr/lib/hpux64 - fi - ;; - hppa*64*) - shrext_cmds='.sl' - hardcode_into_libs=yes - dynamic_linker="$host_os dld.sl" - shlibpath_var=LD_LIBRARY_PATH # How should we handle SHLIB_PATH - shlibpath_overrides_runpath=yes # Unless +noenvvar is specified. - library_names_spec='$libname$release$shared_ext$versuffix $libname$release$shared_ext$major $libname$shared_ext' - soname_spec='$libname$release$shared_ext$major' - sys_lib_search_path_spec="/usr/lib/pa20_64 /usr/ccs/lib/pa20_64" - sys_lib_dlsearch_path_spec=$sys_lib_search_path_spec - ;; - *) - shrext_cmds='.sl' - dynamic_linker="$host_os dld.sl" - shlibpath_var=SHLIB_PATH - shlibpath_overrides_runpath=no # +s is required to enable SHLIB_PATH - library_names_spec='$libname$release$shared_ext$versuffix $libname$release$shared_ext$major $libname$shared_ext' - soname_spec='$libname$release$shared_ext$major' - ;; - esac - # HP-UX runs *really* slowly unless shared libraries are mode 555, ... - postinstall_cmds='chmod 555 $lib' - # or fails outright, so override atomically: - install_override_mode=555 - ;; - -interix[[3-9]]*) - version_type=linux # correct to gnu/linux during the next big refactor - need_lib_prefix=no - need_version=no - library_names_spec='$libname$release$shared_ext$versuffix $libname$release$shared_ext$major $libname$shared_ext' - soname_spec='$libname$release$shared_ext$major' - dynamic_linker='Interix 3.x ld.so.1 (PE, like ELF)' - shlibpath_var=LD_LIBRARY_PATH - shlibpath_overrides_runpath=no - hardcode_into_libs=yes - ;; - -irix5* | irix6* | nonstopux*) - case $host_os in - nonstopux*) version_type=nonstopux ;; - *) - if test yes = "$lt_cv_prog_gnu_ld"; then - version_type=linux # correct to gnu/linux during the next big refactor - else - version_type=irix - fi ;; - esac - need_lib_prefix=no - need_version=no - soname_spec='$libname$release$shared_ext$major' - library_names_spec='$libname$release$shared_ext$versuffix $libname$release$shared_ext$major $libname$release$shared_ext $libname$shared_ext' - case $host_os in - irix5* | nonstopux*) - libsuff= shlibsuff= - ;; - *) - case $LD in # libtool.m4 will add one of these switches to LD - *-32|*"-32 "|*-melf32bsmip|*"-melf32bsmip ") - libsuff= shlibsuff= libmagic=32-bit;; - *-n32|*"-n32 "|*-melf32bmipn32|*"-melf32bmipn32 ") - libsuff=32 shlibsuff=N32 libmagic=N32;; - *-64|*"-64 "|*-melf64bmip|*"-melf64bmip ") - libsuff=64 shlibsuff=64 libmagic=64-bit;; - *) libsuff= shlibsuff= libmagic=never-match;; - esac - ;; - esac - shlibpath_var=LD_LIBRARY${shlibsuff}_PATH - shlibpath_overrides_runpath=no - sys_lib_search_path_spec="/usr/lib$libsuff /lib$libsuff /usr/local/lib$libsuff" - sys_lib_dlsearch_path_spec="/usr/lib$libsuff /lib$libsuff" - hardcode_into_libs=yes - ;; - -# No shared lib support for Linux oldld, aout, or coff. -linux*oldld* | linux*aout* | linux*coff*) - dynamic_linker=no - ;; - -linux*android*) - version_type=none # Android doesn't support versioned libraries. - need_lib_prefix=no - need_version=no - library_names_spec='$libname$release$shared_ext' - soname_spec='$libname$release$shared_ext' - finish_cmds= - shlibpath_var=LD_LIBRARY_PATH - shlibpath_overrides_runpath=yes - - # This implies no fast_install, which is unacceptable. - # Some rework will be needed to allow for fast_install - # before this can be enabled. - hardcode_into_libs=yes - - dynamic_linker='Android linker' - # Don't embed -rpath directories since the linker doesn't support them. - _LT_TAGVAR(hardcode_libdir_flag_spec, $1)='-L$libdir' - ;; - -# This must be glibc/ELF. -linux* | k*bsd*-gnu | kopensolaris*-gnu | gnu*) - version_type=linux # correct to gnu/linux during the next big refactor - need_lib_prefix=no - need_version=no - library_names_spec='$libname$release$shared_ext$versuffix $libname$release$shared_ext$major $libname$shared_ext' - soname_spec='$libname$release$shared_ext$major' - finish_cmds='PATH="\$PATH:/sbin" ldconfig -n $libdir' - shlibpath_var=LD_LIBRARY_PATH - shlibpath_overrides_runpath=no - - # Some binutils ld are patched to set DT_RUNPATH - AC_CACHE_VAL([lt_cv_shlibpath_overrides_runpath], - [lt_cv_shlibpath_overrides_runpath=no - save_LDFLAGS=$LDFLAGS - save_libdir=$libdir - eval "libdir=/foo; wl=\"$_LT_TAGVAR(lt_prog_compiler_wl, $1)\"; \ - LDFLAGS=\"\$LDFLAGS $_LT_TAGVAR(hardcode_libdir_flag_spec, $1)\"" - AC_LINK_IFELSE([AC_LANG_PROGRAM([],[])], - [AS_IF([ ($OBJDUMP -p conftest$ac_exeext) 2>/dev/null | grep "RUNPATH.*$libdir" >/dev/null], - [lt_cv_shlibpath_overrides_runpath=yes])]) - LDFLAGS=$save_LDFLAGS - libdir=$save_libdir - ]) - shlibpath_overrides_runpath=$lt_cv_shlibpath_overrides_runpath - - # This implies no fast_install, which is unacceptable. - # Some rework will be needed to allow for fast_install - # before this can be enabled. - hardcode_into_libs=yes - - # Ideally, we could use ldconfig to report *all* directores which are - # searched for libraries, however this is still not possible. Aside from not - # being certain /sbin/ldconfig is available, command - # 'ldconfig -N -X -v | grep ^/' on 64bit Fedora does not report /usr/lib64, - # even though it is searched at run-time. Try to do the best guess by - # appending ld.so.conf contents (and includes) to the search path. - if test -f /etc/ld.so.conf; then - lt_ld_extra=`awk '/^include / { system(sprintf("cd /etc; cat %s 2>/dev/null", \[$]2)); skip = 1; } { if (!skip) print \[$]0; skip = 0; }' < /etc/ld.so.conf | $SED -e 's/#.*//;/^[ ]*hwcap[ ]/d;s/[:, ]/ /g;s/=[^=]*$//;s/=[^= ]* / /g;s/"//g;/^$/d' | tr '\n' ' '` - sys_lib_dlsearch_path_spec="/lib /usr/lib $lt_ld_extra" - fi - - # We used to test for /lib/ld.so.1 and disable shared libraries on - # powerpc, because MkLinux only supported shared libraries with the - # GNU dynamic linker. Since this was broken with cross compilers, - # most powerpc-linux boxes support dynamic linking these days and - # people can always --disable-shared, the test was removed, and we - # assume the GNU/Linux dynamic linker is in use. - dynamic_linker='GNU/Linux ld.so' - ;; - -netbsd*) - version_type=sunos - need_lib_prefix=no - need_version=no - if echo __ELF__ | $CC -E - | $GREP __ELF__ >/dev/null; then - library_names_spec='$libname$release$shared_ext$versuffix $libname$shared_ext$versuffix' - finish_cmds='PATH="\$PATH:/sbin" ldconfig -m $libdir' - dynamic_linker='NetBSD (a.out) ld.so' - else - library_names_spec='$libname$release$shared_ext$versuffix $libname$release$shared_ext$major $libname$shared_ext' - soname_spec='$libname$release$shared_ext$major' - dynamic_linker='NetBSD ld.elf_so' - fi - shlibpath_var=LD_LIBRARY_PATH - shlibpath_overrides_runpath=yes - hardcode_into_libs=yes - ;; - -newsos6) - version_type=linux # correct to gnu/linux during the next big refactor - library_names_spec='$libname$release$shared_ext$versuffix $libname$release$shared_ext$major $libname$shared_ext' - shlibpath_var=LD_LIBRARY_PATH - shlibpath_overrides_runpath=yes - ;; - -*nto* | *qnx*) - version_type=qnx - need_lib_prefix=no - need_version=no - library_names_spec='$libname$release$shared_ext$versuffix $libname$release$shared_ext$major $libname$shared_ext' - soname_spec='$libname$release$shared_ext$major' - shlibpath_var=LD_LIBRARY_PATH - shlibpath_overrides_runpath=no - hardcode_into_libs=yes - dynamic_linker='ldqnx.so' - ;; - -openbsd* | bitrig*) - version_type=sunos - sys_lib_dlsearch_path_spec=/usr/lib - need_lib_prefix=no - if test -z "`echo __ELF__ | $CC -E - | $GREP __ELF__`"; then - need_version=no - else - need_version=yes - fi - library_names_spec='$libname$release$shared_ext$versuffix $libname$shared_ext$versuffix' - finish_cmds='PATH="\$PATH:/sbin" ldconfig -m $libdir' - shlibpath_var=LD_LIBRARY_PATH - shlibpath_overrides_runpath=yes - ;; - -os2*) - libname_spec='$name' - version_type=windows - shrext_cmds=.dll - need_version=no - need_lib_prefix=no - # OS/2 can only load a DLL with a base name of 8 characters or less. - soname_spec='`test -n "$os2dllname" && libname="$os2dllname"; - v=$($ECHO $release$versuffix | tr -d .-); - n=$($ECHO $libname | cut -b -$((8 - ${#v})) | tr . _); - $ECHO $n$v`$shared_ext' - library_names_spec='${libname}_dll.$libext' - dynamic_linker='OS/2 ld.exe' - shlibpath_var=BEGINLIBPATH - sys_lib_search_path_spec="/lib /usr/lib /usr/local/lib" - sys_lib_dlsearch_path_spec=$sys_lib_search_path_spec - postinstall_cmds='base_file=`basename \$file`~ - dlpath=`$SHELL 2>&1 -c '\''. $dir/'\''\$base_file'\''i; $ECHO \$dlname'\''`~ - dldir=$destdir/`dirname \$dlpath`~ - test -d \$dldir || mkdir -p \$dldir~ - $install_prog $dir/$dlname \$dldir/$dlname~ - chmod a+x \$dldir/$dlname~ - if test -n '\''$stripme'\'' && test -n '\''$striplib'\''; then - eval '\''$striplib \$dldir/$dlname'\'' || exit \$?; - fi' - postuninstall_cmds='dldll=`$SHELL 2>&1 -c '\''. $file; $ECHO \$dlname'\''`~ - dlpath=$dir/\$dldll~ - $RM \$dlpath' - ;; - -osf3* | osf4* | osf5*) - version_type=osf - need_lib_prefix=no - need_version=no - soname_spec='$libname$release$shared_ext$major' - library_names_spec='$libname$release$shared_ext$versuffix $libname$release$shared_ext$major $libname$shared_ext' - shlibpath_var=LD_LIBRARY_PATH - sys_lib_search_path_spec="/usr/shlib /usr/ccs/lib /usr/lib/cmplrs/cc /usr/lib /usr/local/lib /var/shlib" - sys_lib_dlsearch_path_spec=$sys_lib_search_path_spec - ;; - -rdos*) - dynamic_linker=no - ;; - -solaris*) - version_type=linux # correct to gnu/linux during the next big refactor - need_lib_prefix=no - need_version=no - library_names_spec='$libname$release$shared_ext$versuffix $libname$release$shared_ext$major $libname$shared_ext' - soname_spec='$libname$release$shared_ext$major' - shlibpath_var=LD_LIBRARY_PATH - shlibpath_overrides_runpath=yes - hardcode_into_libs=yes - # ldd complains unless libraries are executable - postinstall_cmds='chmod +x $lib' - ;; - -sunos4*) - version_type=sunos - library_names_spec='$libname$release$shared_ext$versuffix $libname$shared_ext$versuffix' - finish_cmds='PATH="\$PATH:/usr/etc" ldconfig $libdir' - shlibpath_var=LD_LIBRARY_PATH - shlibpath_overrides_runpath=yes - if test yes = "$with_gnu_ld"; then - need_lib_prefix=no - fi - need_version=yes - ;; - -sysv4 | sysv4.3*) - version_type=linux # correct to gnu/linux during the next big refactor - library_names_spec='$libname$release$shared_ext$versuffix $libname$release$shared_ext$major $libname$shared_ext' - soname_spec='$libname$release$shared_ext$major' - shlibpath_var=LD_LIBRARY_PATH - case $host_vendor in - sni) - shlibpath_overrides_runpath=no - need_lib_prefix=no - runpath_var=LD_RUN_PATH - ;; - siemens) - need_lib_prefix=no - ;; - motorola) - need_lib_prefix=no - need_version=no - shlibpath_overrides_runpath=no - sys_lib_search_path_spec='/lib /usr/lib /usr/ccs/lib' - ;; - esac - ;; - -sysv4*MP*) - if test -d /usr/nec; then - version_type=linux # correct to gnu/linux during the next big refactor - library_names_spec='$libname$shared_ext.$versuffix $libname$shared_ext.$major $libname$shared_ext' - soname_spec='$libname$shared_ext.$major' - shlibpath_var=LD_LIBRARY_PATH - fi - ;; - -sysv5* | sco3.2v5* | sco5v6* | unixware* | OpenUNIX* | sysv4*uw2*) - version_type=sco - need_lib_prefix=no - need_version=no - library_names_spec='$libname$release$shared_ext$versuffix $libname$release$shared_ext $libname$shared_ext' - soname_spec='$libname$release$shared_ext$major' - shlibpath_var=LD_LIBRARY_PATH - shlibpath_overrides_runpath=yes - hardcode_into_libs=yes - if test yes = "$with_gnu_ld"; then - sys_lib_search_path_spec='/usr/local/lib /usr/gnu/lib /usr/ccs/lib /usr/lib /lib' - else - sys_lib_search_path_spec='/usr/ccs/lib /usr/lib' - case $host_os in - sco3.2v5*) - sys_lib_search_path_spec="$sys_lib_search_path_spec /lib" - ;; - esac - fi - sys_lib_dlsearch_path_spec='/usr/lib' - ;; - -tpf*) - # TPF is a cross-target only. Preferred cross-host = GNU/Linux. - version_type=linux # correct to gnu/linux during the next big refactor - need_lib_prefix=no - need_version=no - library_names_spec='$libname$release$shared_ext$versuffix $libname$release$shared_ext$major $libname$shared_ext' - shlibpath_var=LD_LIBRARY_PATH - shlibpath_overrides_runpath=no - hardcode_into_libs=yes - ;; - -uts4*) - version_type=linux # correct to gnu/linux during the next big refactor - library_names_spec='$libname$release$shared_ext$versuffix $libname$release$shared_ext$major $libname$shared_ext' - soname_spec='$libname$release$shared_ext$major' - shlibpath_var=LD_LIBRARY_PATH - ;; - -*) - dynamic_linker=no - ;; -esac -AC_MSG_RESULT([$dynamic_linker]) -test no = "$dynamic_linker" && can_build_shared=no - -variables_saved_for_relink="PATH $shlibpath_var $runpath_var" -if test yes = "$GCC"; then - variables_saved_for_relink="$variables_saved_for_relink GCC_EXEC_PREFIX COMPILER_PATH LIBRARY_PATH" -fi - -if test set = "${lt_cv_sys_lib_search_path_spec+set}"; then - sys_lib_search_path_spec=$lt_cv_sys_lib_search_path_spec -fi - -if test set = "${lt_cv_sys_lib_dlsearch_path_spec+set}"; then - sys_lib_dlsearch_path_spec=$lt_cv_sys_lib_dlsearch_path_spec -fi - -# remember unaugmented sys_lib_dlsearch_path content for libtool script decls... -configure_time_dlsearch_path=$sys_lib_dlsearch_path_spec - -# ... but it needs LT_SYS_LIBRARY_PATH munging for other configure-time code -func_munge_path_list sys_lib_dlsearch_path_spec "$LT_SYS_LIBRARY_PATH" - -# to be used as default LT_SYS_LIBRARY_PATH value in generated libtool -configure_time_lt_sys_library_path=$LT_SYS_LIBRARY_PATH - -_LT_DECL([], [variables_saved_for_relink], [1], - [Variables whose values should be saved in libtool wrapper scripts and - restored at link time]) -_LT_DECL([], [need_lib_prefix], [0], - [Do we need the "lib" prefix for modules?]) -_LT_DECL([], [need_version], [0], [Do we need a version for libraries?]) -_LT_DECL([], [version_type], [0], [Library versioning type]) -_LT_DECL([], [runpath_var], [0], [Shared library runtime path variable]) -_LT_DECL([], [shlibpath_var], [0],[Shared library path variable]) -_LT_DECL([], [shlibpath_overrides_runpath], [0], - [Is shlibpath searched before the hard-coded library search path?]) -_LT_DECL([], [libname_spec], [1], [Format of library name prefix]) -_LT_DECL([], [library_names_spec], [1], - [[List of archive names. First name is the real one, the rest are links. - The last name is the one that the linker finds with -lNAME]]) -_LT_DECL([], [soname_spec], [1], - [[The coded name of the library, if different from the real name]]) -_LT_DECL([], [install_override_mode], [1], - [Permission mode override for installation of shared libraries]) -_LT_DECL([], [postinstall_cmds], [2], - [Command to use after installation of a shared archive]) -_LT_DECL([], [postuninstall_cmds], [2], - [Command to use after uninstallation of a shared archive]) -_LT_DECL([], [finish_cmds], [2], - [Commands used to finish a libtool library installation in a directory]) -_LT_DECL([], [finish_eval], [1], - [[As "finish_cmds", except a single script fragment to be evaled but - not shown]]) -_LT_DECL([], [hardcode_into_libs], [0], - [Whether we should hardcode library paths into libraries]) -_LT_DECL([], [sys_lib_search_path_spec], [2], - [Compile-time system search path for libraries]) -_LT_DECL([sys_lib_dlsearch_path_spec], [configure_time_dlsearch_path], [2], - [Detected run-time system search path for libraries]) -_LT_DECL([], [configure_time_lt_sys_library_path], [2], - [Explicit LT_SYS_LIBRARY_PATH set during ./configure time]) -])# _LT_SYS_DYNAMIC_LINKER - - -# _LT_PATH_TOOL_PREFIX(TOOL) -# -------------------------- -# find a file program that can recognize shared library -AC_DEFUN([_LT_PATH_TOOL_PREFIX], -[m4_require([_LT_DECL_EGREP])dnl -AC_MSG_CHECKING([for $1]) -AC_CACHE_VAL(lt_cv_path_MAGIC_CMD, -[case $MAGIC_CMD in -[[\\/*] | ?:[\\/]*]) - lt_cv_path_MAGIC_CMD=$MAGIC_CMD # Let the user override the test with a path. - ;; -*) - lt_save_MAGIC_CMD=$MAGIC_CMD - lt_save_ifs=$IFS; IFS=$PATH_SEPARATOR -dnl $ac_dummy forces splitting on constant user-supplied paths. -dnl POSIX.2 word splitting is done only on the output of word expansions, -dnl not every word. This closes a longstanding sh security hole. - ac_dummy="m4_if([$2], , $PATH, [$2])" - for ac_dir in $ac_dummy; do - IFS=$lt_save_ifs - test -z "$ac_dir" && ac_dir=. - if test -f "$ac_dir/$1"; then - lt_cv_path_MAGIC_CMD=$ac_dir/"$1" - if test -n "$file_magic_test_file"; then - case $deplibs_check_method in - "file_magic "*) - file_magic_regex=`expr "$deplibs_check_method" : "file_magic \(.*\)"` - MAGIC_CMD=$lt_cv_path_MAGIC_CMD - if eval $file_magic_cmd \$file_magic_test_file 2> /dev/null | - $EGREP "$file_magic_regex" > /dev/null; then - : - else - cat <<_LT_EOF 1>&2 - -*** Warning: the command libtool uses to detect shared libraries, -*** $file_magic_cmd, produces output that libtool cannot recognize. -*** The result is that libtool may fail to recognize shared libraries -*** as such. This will affect the creation of libtool libraries that -*** depend on shared libraries, but programs linked with such libtool -*** libraries will work regardless of this problem. Nevertheless, you -*** may want to report the problem to your system manager and/or to -*** bug-libtool@gnu.org - -_LT_EOF - fi ;; - esac - fi - break - fi - done - IFS=$lt_save_ifs - MAGIC_CMD=$lt_save_MAGIC_CMD - ;; -esac]) -MAGIC_CMD=$lt_cv_path_MAGIC_CMD -if test -n "$MAGIC_CMD"; then - AC_MSG_RESULT($MAGIC_CMD) -else - AC_MSG_RESULT(no) -fi -_LT_DECL([], [MAGIC_CMD], [0], - [Used to examine libraries when file_magic_cmd begins with "file"])dnl -])# _LT_PATH_TOOL_PREFIX - -# Old name: -AU_ALIAS([AC_PATH_TOOL_PREFIX], [_LT_PATH_TOOL_PREFIX]) -dnl aclocal-1.4 backwards compatibility: -dnl AC_DEFUN([AC_PATH_TOOL_PREFIX], []) - - -# _LT_PATH_MAGIC -# -------------- -# find a file program that can recognize a shared library -m4_defun([_LT_PATH_MAGIC], -[_LT_PATH_TOOL_PREFIX(${ac_tool_prefix}file, /usr/bin$PATH_SEPARATOR$PATH) -if test -z "$lt_cv_path_MAGIC_CMD"; then - if test -n "$ac_tool_prefix"; then - _LT_PATH_TOOL_PREFIX(file, /usr/bin$PATH_SEPARATOR$PATH) - else - MAGIC_CMD=: - fi -fi -])# _LT_PATH_MAGIC - - -# LT_PATH_LD -# ---------- -# find the pathname to the GNU or non-GNU linker -AC_DEFUN([LT_PATH_LD], -[AC_REQUIRE([AC_PROG_CC])dnl -AC_REQUIRE([AC_CANONICAL_HOST])dnl -AC_REQUIRE([AC_CANONICAL_BUILD])dnl -m4_require([_LT_DECL_SED])dnl -m4_require([_LT_DECL_EGREP])dnl -m4_require([_LT_PROG_ECHO_BACKSLASH])dnl - -AC_ARG_WITH([gnu-ld], - [AS_HELP_STRING([--with-gnu-ld], - [assume the C compiler uses GNU ld @<:@default=no@:>@])], - [test no = "$withval" || with_gnu_ld=yes], - [with_gnu_ld=no])dnl - -ac_prog=ld -if test yes = "$GCC"; then - # Check if gcc -print-prog-name=ld gives a path. - AC_MSG_CHECKING([for ld used by $CC]) - case $host in - *-*-mingw*) - # gcc leaves a trailing carriage return, which upsets mingw - ac_prog=`($CC -print-prog-name=ld) 2>&5 | tr -d '\015'` ;; - *) - ac_prog=`($CC -print-prog-name=ld) 2>&5` ;; - esac - case $ac_prog in - # Accept absolute paths. - [[\\/]]* | ?:[[\\/]]*) - re_direlt='/[[^/]][[^/]]*/\.\./' - # Canonicalize the pathname of ld - ac_prog=`$ECHO "$ac_prog"| $SED 's%\\\\%/%g'` - while $ECHO "$ac_prog" | $GREP "$re_direlt" > /dev/null 2>&1; do - ac_prog=`$ECHO $ac_prog| $SED "s%$re_direlt%/%"` - done - test -z "$LD" && LD=$ac_prog - ;; - "") - # If it fails, then pretend we aren't using GCC. - ac_prog=ld - ;; - *) - # If it is relative, then search for the first ld in PATH. - with_gnu_ld=unknown - ;; - esac -elif test yes = "$with_gnu_ld"; then - AC_MSG_CHECKING([for GNU ld]) -else - AC_MSG_CHECKING([for non-GNU ld]) -fi -AC_CACHE_VAL(lt_cv_path_LD, -[if test -z "$LD"; then - lt_save_ifs=$IFS; IFS=$PATH_SEPARATOR - for ac_dir in $PATH; do - IFS=$lt_save_ifs - test -z "$ac_dir" && ac_dir=. - if test -f "$ac_dir/$ac_prog" || test -f "$ac_dir/$ac_prog$ac_exeext"; then - lt_cv_path_LD=$ac_dir/$ac_prog - # Check to see if the program is GNU ld. I'd rather use --version, - # but apparently some variants of GNU ld only accept -v. - # Break only if it was the GNU/non-GNU ld that we prefer. - case `"$lt_cv_path_LD" -v 2>&1 &1 conftest.i -cat conftest.i conftest.i >conftest2.i -: ${lt_DD:=$DD} -AC_PATH_PROGS_FEATURE_CHECK([lt_DD], [dd], -[if "$ac_path_lt_DD" bs=32 count=1 conftest.out 2>/dev/null; then - cmp -s conftest.i conftest.out \ - && ac_cv_path_lt_DD="$ac_path_lt_DD" ac_path_lt_DD_found=: -fi]) -rm -f conftest.i conftest2.i conftest.out]) -])# _LT_PATH_DD - - -# _LT_CMD_TRUNCATE -# ---------------- -# find command to truncate a binary pipe -m4_defun([_LT_CMD_TRUNCATE], -[m4_require([_LT_PATH_DD]) -AC_CACHE_CHECK([how to truncate binary pipes], [lt_cv_truncate_bin], -[printf 0123456789abcdef0123456789abcdef >conftest.i -cat conftest.i conftest.i >conftest2.i -lt_cv_truncate_bin= -if "$ac_cv_path_lt_DD" bs=32 count=1 conftest.out 2>/dev/null; then - cmp -s conftest.i conftest.out \ - && lt_cv_truncate_bin="$ac_cv_path_lt_DD bs=4096 count=1" -fi -rm -f conftest.i conftest2.i conftest.out -test -z "$lt_cv_truncate_bin" && lt_cv_truncate_bin="$SED -e 4q"]) -_LT_DECL([lt_truncate_bin], [lt_cv_truncate_bin], [1], - [Command to truncate a binary pipe]) -])# _LT_CMD_TRUNCATE - - -# _LT_CHECK_MAGIC_METHOD -# ---------------------- -# how to check for library dependencies -# -- PORTME fill in with the dynamic library characteristics -m4_defun([_LT_CHECK_MAGIC_METHOD], -[m4_require([_LT_DECL_EGREP]) -m4_require([_LT_DECL_OBJDUMP]) -AC_CACHE_CHECK([how to recognize dependent libraries], -lt_cv_deplibs_check_method, -[lt_cv_file_magic_cmd='$MAGIC_CMD' -lt_cv_file_magic_test_file= -lt_cv_deplibs_check_method='unknown' -# Need to set the preceding variable on all platforms that support -# interlibrary dependencies. -# 'none' -- dependencies not supported. -# 'unknown' -- same as none, but documents that we really don't know. -# 'pass_all' -- all dependencies passed with no checks. -# 'test_compile' -- check by making test program. -# 'file_magic [[regex]]' -- check by looking for files in library path -# that responds to the $file_magic_cmd with a given extended regex. -# If you have 'file' or equivalent on your system and you're not sure -# whether 'pass_all' will *always* work, you probably want this one. - -case $host_os in -aix[[4-9]]*) - lt_cv_deplibs_check_method=pass_all - ;; - -beos*) - lt_cv_deplibs_check_method=pass_all - ;; - -bsdi[[45]]*) - lt_cv_deplibs_check_method='file_magic ELF [[0-9]][[0-9]]*-bit [[ML]]SB (shared object|dynamic lib)' - lt_cv_file_magic_cmd='/usr/bin/file -L' - lt_cv_file_magic_test_file=/shlib/libc.so - ;; - -cygwin*) - # func_win32_libid is a shell function defined in ltmain.sh - lt_cv_deplibs_check_method='file_magic ^x86 archive import|^x86 DLL' - lt_cv_file_magic_cmd='func_win32_libid' - ;; - -mingw* | pw32*) - # Base MSYS/MinGW do not provide the 'file' command needed by - # func_win32_libid shell function, so use a weaker test based on 'objdump', - # unless we find 'file', for example because we are cross-compiling. - if ( file / ) >/dev/null 2>&1; then - lt_cv_deplibs_check_method='file_magic ^x86 archive import|^x86 DLL' - lt_cv_file_magic_cmd='func_win32_libid' - else - # Keep this pattern in sync with the one in func_win32_libid. - lt_cv_deplibs_check_method='file_magic file format (pei*-i386(.*architecture: i386)?|pe-arm-wince|pe-x86-64)' - lt_cv_file_magic_cmd='$OBJDUMP -f' - fi - ;; - -cegcc*) - # use the weaker test based on 'objdump'. See mingw*. - lt_cv_deplibs_check_method='file_magic file format pe-arm-.*little(.*architecture: arm)?' - lt_cv_file_magic_cmd='$OBJDUMP -f' - ;; - -darwin* | rhapsody*) - lt_cv_deplibs_check_method=pass_all - ;; - -freebsd* | dragonfly*) - if echo __ELF__ | $CC -E - | $GREP __ELF__ > /dev/null; then - case $host_cpu in - i*86 ) - # Not sure whether the presence of OpenBSD here was a mistake. - # Let's accept both of them until this is cleared up. - lt_cv_deplibs_check_method='file_magic (FreeBSD|OpenBSD|DragonFly)/i[[3-9]]86 (compact )?demand paged shared library' - lt_cv_file_magic_cmd=/usr/bin/file - lt_cv_file_magic_test_file=`echo /usr/lib/libc.so.*` - ;; - esac - else - lt_cv_deplibs_check_method=pass_all - fi - ;; - -haiku*) - lt_cv_deplibs_check_method=pass_all - ;; - -hpux10.20* | hpux11*) - lt_cv_file_magic_cmd=/usr/bin/file - case $host_cpu in - ia64*) - lt_cv_deplibs_check_method='file_magic (s[[0-9]][[0-9]][[0-9]]|ELF-[[0-9]][[0-9]]) shared object file - IA64' - lt_cv_file_magic_test_file=/usr/lib/hpux32/libc.so - ;; - hppa*64*) - [lt_cv_deplibs_check_method='file_magic (s[0-9][0-9][0-9]|ELF[ -][0-9][0-9])(-bit)?( [LM]SB)? shared object( file)?[, -]* PA-RISC [0-9]\.[0-9]'] - lt_cv_file_magic_test_file=/usr/lib/pa20_64/libc.sl - ;; - *) - lt_cv_deplibs_check_method='file_magic (s[[0-9]][[0-9]][[0-9]]|PA-RISC[[0-9]]\.[[0-9]]) shared library' - lt_cv_file_magic_test_file=/usr/lib/libc.sl - ;; - esac - ;; - -interix[[3-9]]*) - # PIC code is broken on Interix 3.x, that's why |\.a not |_pic\.a here - lt_cv_deplibs_check_method='match_pattern /lib[[^/]]+(\.so|\.a)$' - ;; - -irix5* | irix6* | nonstopux*) - case $LD in - *-32|*"-32 ") libmagic=32-bit;; - *-n32|*"-n32 ") libmagic=N32;; - *-64|*"-64 ") libmagic=64-bit;; - *) libmagic=never-match;; - esac - lt_cv_deplibs_check_method=pass_all - ;; - -# This must be glibc/ELF. -linux* | k*bsd*-gnu | kopensolaris*-gnu | gnu*) - lt_cv_deplibs_check_method=pass_all - ;; - -netbsd*) - if echo __ELF__ | $CC -E - | $GREP __ELF__ > /dev/null; then - lt_cv_deplibs_check_method='match_pattern /lib[[^/]]+(\.so\.[[0-9]]+\.[[0-9]]+|_pic\.a)$' - else - lt_cv_deplibs_check_method='match_pattern /lib[[^/]]+(\.so|_pic\.a)$' - fi - ;; - -newos6*) - lt_cv_deplibs_check_method='file_magic ELF [[0-9]][[0-9]]*-bit [[ML]]SB (executable|dynamic lib)' - lt_cv_file_magic_cmd=/usr/bin/file - lt_cv_file_magic_test_file=/usr/lib/libnls.so - ;; - -*nto* | *qnx*) - lt_cv_deplibs_check_method=pass_all - ;; - -openbsd* | bitrig*) - if test -z "`echo __ELF__ | $CC -E - | $GREP __ELF__`"; then - lt_cv_deplibs_check_method='match_pattern /lib[[^/]]+(\.so\.[[0-9]]+\.[[0-9]]+|\.so|_pic\.a)$' - else - lt_cv_deplibs_check_method='match_pattern /lib[[^/]]+(\.so\.[[0-9]]+\.[[0-9]]+|_pic\.a)$' - fi - ;; - -osf3* | osf4* | osf5*) - lt_cv_deplibs_check_method=pass_all - ;; - -rdos*) - lt_cv_deplibs_check_method=pass_all - ;; - -solaris*) - lt_cv_deplibs_check_method=pass_all - ;; - -sysv5* | sco3.2v5* | sco5v6* | unixware* | OpenUNIX* | sysv4*uw2*) - lt_cv_deplibs_check_method=pass_all - ;; - -sysv4 | sysv4.3*) - case $host_vendor in - motorola) - lt_cv_deplibs_check_method='file_magic ELF [[0-9]][[0-9]]*-bit [[ML]]SB (shared object|dynamic lib) M[[0-9]][[0-9]]* Version [[0-9]]' - lt_cv_file_magic_test_file=`echo /usr/lib/libc.so*` - ;; - ncr) - lt_cv_deplibs_check_method=pass_all - ;; - sequent) - lt_cv_file_magic_cmd='/bin/file' - lt_cv_deplibs_check_method='file_magic ELF [[0-9]][[0-9]]*-bit [[LM]]SB (shared object|dynamic lib )' - ;; - sni) - lt_cv_file_magic_cmd='/bin/file' - lt_cv_deplibs_check_method="file_magic ELF [[0-9]][[0-9]]*-bit [[LM]]SB dynamic lib" - lt_cv_file_magic_test_file=/lib/libc.so - ;; - siemens) - lt_cv_deplibs_check_method=pass_all - ;; - pc) - lt_cv_deplibs_check_method=pass_all - ;; - esac - ;; - -tpf*) - lt_cv_deplibs_check_method=pass_all - ;; -os2*) - lt_cv_deplibs_check_method=pass_all - ;; -esac -]) - -file_magic_glob= -want_nocaseglob=no -if test "$build" = "$host"; then - case $host_os in - mingw* | pw32*) - if ( shopt | grep nocaseglob ) >/dev/null 2>&1; then - want_nocaseglob=yes - else - file_magic_glob=`echo aAbBcCdDeEfFgGhHiIjJkKlLmMnNoOpPqQrRsStTuUvVwWxXyYzZ | $SED -e "s/\(..\)/s\/[[\1]]\/[[\1]]\/g;/g"` - fi - ;; - esac -fi - -file_magic_cmd=$lt_cv_file_magic_cmd -deplibs_check_method=$lt_cv_deplibs_check_method -test -z "$deplibs_check_method" && deplibs_check_method=unknown - -_LT_DECL([], [deplibs_check_method], [1], - [Method to check whether dependent libraries are shared objects]) -_LT_DECL([], [file_magic_cmd], [1], - [Command to use when deplibs_check_method = "file_magic"]) -_LT_DECL([], [file_magic_glob], [1], - [How to find potential files when deplibs_check_method = "file_magic"]) -_LT_DECL([], [want_nocaseglob], [1], - [Find potential files using nocaseglob when deplibs_check_method = "file_magic"]) -])# _LT_CHECK_MAGIC_METHOD - - -# LT_PATH_NM -# ---------- -# find the pathname to a BSD- or MS-compatible name lister -AC_DEFUN([LT_PATH_NM], -[AC_REQUIRE([AC_PROG_CC])dnl -AC_CACHE_CHECK([for BSD- or MS-compatible name lister (nm)], lt_cv_path_NM, -[if test -n "$NM"; then - # Let the user override the test. - lt_cv_path_NM=$NM -else - lt_nm_to_check=${ac_tool_prefix}nm - if test -n "$ac_tool_prefix" && test "$build" = "$host"; then - lt_nm_to_check="$lt_nm_to_check nm" - fi - for lt_tmp_nm in $lt_nm_to_check; do - lt_save_ifs=$IFS; IFS=$PATH_SEPARATOR - for ac_dir in $PATH /usr/ccs/bin/elf /usr/ccs/bin /usr/ucb /bin; do - IFS=$lt_save_ifs - test -z "$ac_dir" && ac_dir=. - tmp_nm=$ac_dir/$lt_tmp_nm - if test -f "$tmp_nm" || test -f "$tmp_nm$ac_exeext"; then - # Check to see if the nm accepts a BSD-compat flag. - # Adding the 'sed 1q' prevents false positives on HP-UX, which says: - # nm: unknown option "B" ignored - # Tru64's nm complains that /dev/null is an invalid object file - # MSYS converts /dev/null to NUL, MinGW nm treats NUL as empty - case $build_os in - mingw*) lt_bad_file=conftest.nm/nofile ;; - *) lt_bad_file=/dev/null ;; - esac - case `"$tmp_nm" -B $lt_bad_file 2>&1 | sed '1q'` in - *$lt_bad_file* | *'Invalid file or object type'*) - lt_cv_path_NM="$tmp_nm -B" - break 2 - ;; - *) - case `"$tmp_nm" -p /dev/null 2>&1 | sed '1q'` in - */dev/null*) - lt_cv_path_NM="$tmp_nm -p" - break 2 - ;; - *) - lt_cv_path_NM=${lt_cv_path_NM="$tmp_nm"} # keep the first match, but - continue # so that we can try to find one that supports BSD flags - ;; - esac - ;; - esac - fi - done - IFS=$lt_save_ifs - done - : ${lt_cv_path_NM=no} -fi]) -if test no != "$lt_cv_path_NM"; then - NM=$lt_cv_path_NM -else - # Didn't find any BSD compatible name lister, look for dumpbin. - if test -n "$DUMPBIN"; then : - # Let the user override the test. - else - AC_CHECK_TOOLS(DUMPBIN, [dumpbin "link -dump"], :) - case `$DUMPBIN -symbols -headers /dev/null 2>&1 | sed '1q'` in - *COFF*) - DUMPBIN="$DUMPBIN -symbols -headers" - ;; - *) - DUMPBIN=: - ;; - esac - fi - AC_SUBST([DUMPBIN]) - if test : != "$DUMPBIN"; then - NM=$DUMPBIN - fi -fi -test -z "$NM" && NM=nm -AC_SUBST([NM]) -_LT_DECL([], [NM], [1], [A BSD- or MS-compatible name lister])dnl - -AC_CACHE_CHECK([the name lister ($NM) interface], [lt_cv_nm_interface], - [lt_cv_nm_interface="BSD nm" - echo "int some_variable = 0;" > conftest.$ac_ext - (eval echo "\"\$as_me:$LINENO: $ac_compile\"" >&AS_MESSAGE_LOG_FD) - (eval "$ac_compile" 2>conftest.err) - cat conftest.err >&AS_MESSAGE_LOG_FD - (eval echo "\"\$as_me:$LINENO: $NM \\\"conftest.$ac_objext\\\"\"" >&AS_MESSAGE_LOG_FD) - (eval "$NM \"conftest.$ac_objext\"" 2>conftest.err > conftest.out) - cat conftest.err >&AS_MESSAGE_LOG_FD - (eval echo "\"\$as_me:$LINENO: output\"" >&AS_MESSAGE_LOG_FD) - cat conftest.out >&AS_MESSAGE_LOG_FD - if $GREP 'External.*some_variable' conftest.out > /dev/null; then - lt_cv_nm_interface="MS dumpbin" - fi - rm -f conftest*]) -])# LT_PATH_NM - -# Old names: -AU_ALIAS([AM_PROG_NM], [LT_PATH_NM]) -AU_ALIAS([AC_PROG_NM], [LT_PATH_NM]) -dnl aclocal-1.4 backwards compatibility: -dnl AC_DEFUN([AM_PROG_NM], []) -dnl AC_DEFUN([AC_PROG_NM], []) - -# _LT_CHECK_SHAREDLIB_FROM_LINKLIB -# -------------------------------- -# how to determine the name of the shared library -# associated with a specific link library. -# -- PORTME fill in with the dynamic library characteristics -m4_defun([_LT_CHECK_SHAREDLIB_FROM_LINKLIB], -[m4_require([_LT_DECL_EGREP]) -m4_require([_LT_DECL_OBJDUMP]) -m4_require([_LT_DECL_DLLTOOL]) -AC_CACHE_CHECK([how to associate runtime and link libraries], -lt_cv_sharedlib_from_linklib_cmd, -[lt_cv_sharedlib_from_linklib_cmd='unknown' - -case $host_os in -cygwin* | mingw* | pw32* | cegcc*) - # two different shell functions defined in ltmain.sh; - # decide which one to use based on capabilities of $DLLTOOL - case `$DLLTOOL --help 2>&1` in - *--identify-strict*) - lt_cv_sharedlib_from_linklib_cmd=func_cygming_dll_for_implib - ;; - *) - lt_cv_sharedlib_from_linklib_cmd=func_cygming_dll_for_implib_fallback - ;; - esac - ;; -*) - # fallback: assume linklib IS sharedlib - lt_cv_sharedlib_from_linklib_cmd=$ECHO - ;; -esac -]) -sharedlib_from_linklib_cmd=$lt_cv_sharedlib_from_linklib_cmd -test -z "$sharedlib_from_linklib_cmd" && sharedlib_from_linklib_cmd=$ECHO - -_LT_DECL([], [sharedlib_from_linklib_cmd], [1], - [Command to associate shared and link libraries]) -])# _LT_CHECK_SHAREDLIB_FROM_LINKLIB - - -# _LT_PATH_MANIFEST_TOOL -# ---------------------- -# locate the manifest tool -m4_defun([_LT_PATH_MANIFEST_TOOL], -[AC_CHECK_TOOL(MANIFEST_TOOL, mt, :) -test -z "$MANIFEST_TOOL" && MANIFEST_TOOL=mt -AC_CACHE_CHECK([if $MANIFEST_TOOL is a manifest tool], [lt_cv_path_mainfest_tool], - [lt_cv_path_mainfest_tool=no - echo "$as_me:$LINENO: $MANIFEST_TOOL '-?'" >&AS_MESSAGE_LOG_FD - $MANIFEST_TOOL '-?' 2>conftest.err > conftest.out - cat conftest.err >&AS_MESSAGE_LOG_FD - if $GREP 'Manifest Tool' conftest.out > /dev/null; then - lt_cv_path_mainfest_tool=yes - fi - rm -f conftest*]) -if test yes != "$lt_cv_path_mainfest_tool"; then - MANIFEST_TOOL=: -fi -_LT_DECL([], [MANIFEST_TOOL], [1], [Manifest tool])dnl -])# _LT_PATH_MANIFEST_TOOL - - -# _LT_DLL_DEF_P([FILE]) -# --------------------- -# True iff FILE is a Windows DLL '.def' file. -# Keep in sync with func_dll_def_p in the libtool script -AC_DEFUN([_LT_DLL_DEF_P], -[dnl - test DEF = "`$SED -n dnl - -e '\''s/^[[ ]]*//'\'' dnl Strip leading whitespace - -e '\''/^\(;.*\)*$/d'\'' dnl Delete empty lines and comments - -e '\''s/^\(EXPORTS\|LIBRARY\)\([[ ]].*\)*$/DEF/p'\'' dnl - -e q dnl Only consider the first "real" line - $1`" dnl -])# _LT_DLL_DEF_P - - -# LT_LIB_M -# -------- -# check for math library -AC_DEFUN([LT_LIB_M], -[AC_REQUIRE([AC_CANONICAL_HOST])dnl -LIBM= -case $host in -*-*-beos* | *-*-cegcc* | *-*-cygwin* | *-*-haiku* | *-*-pw32* | *-*-darwin*) - # These system don't have libm, or don't need it - ;; -*-ncr-sysv4.3*) - AC_CHECK_LIB(mw, _mwvalidcheckl, LIBM=-lmw) - AC_CHECK_LIB(m, cos, LIBM="$LIBM -lm") - ;; -*) - AC_CHECK_LIB(m, cos, LIBM=-lm) - ;; -esac -AC_SUBST([LIBM]) -])# LT_LIB_M - -# Old name: -AU_ALIAS([AC_CHECK_LIBM], [LT_LIB_M]) -dnl aclocal-1.4 backwards compatibility: -dnl AC_DEFUN([AC_CHECK_LIBM], []) - - -# _LT_COMPILER_NO_RTTI([TAGNAME]) -# ------------------------------- -m4_defun([_LT_COMPILER_NO_RTTI], -[m4_require([_LT_TAG_COMPILER])dnl - -_LT_TAGVAR(lt_prog_compiler_no_builtin_flag, $1)= - -if test yes = "$GCC"; then - case $cc_basename in - nvcc*) - _LT_TAGVAR(lt_prog_compiler_no_builtin_flag, $1)=' -Xcompiler -fno-builtin' ;; - *) - _LT_TAGVAR(lt_prog_compiler_no_builtin_flag, $1)=' -fno-builtin' ;; - esac - - _LT_COMPILER_OPTION([if $compiler supports -fno-rtti -fno-exceptions], - lt_cv_prog_compiler_rtti_exceptions, - [-fno-rtti -fno-exceptions], [], - [_LT_TAGVAR(lt_prog_compiler_no_builtin_flag, $1)="$_LT_TAGVAR(lt_prog_compiler_no_builtin_flag, $1) -fno-rtti -fno-exceptions"]) -fi -_LT_TAGDECL([no_builtin_flag], [lt_prog_compiler_no_builtin_flag], [1], - [Compiler flag to turn off builtin functions]) -])# _LT_COMPILER_NO_RTTI - - -# _LT_CMD_GLOBAL_SYMBOLS -# ---------------------- -m4_defun([_LT_CMD_GLOBAL_SYMBOLS], -[AC_REQUIRE([AC_CANONICAL_HOST])dnl -AC_REQUIRE([AC_PROG_CC])dnl -AC_REQUIRE([AC_PROG_AWK])dnl -AC_REQUIRE([LT_PATH_NM])dnl -AC_REQUIRE([LT_PATH_LD])dnl -m4_require([_LT_DECL_SED])dnl -m4_require([_LT_DECL_EGREP])dnl -m4_require([_LT_TAG_COMPILER])dnl - -# Check for command to grab the raw symbol name followed by C symbol from nm. -AC_MSG_CHECKING([command to parse $NM output from $compiler object]) -AC_CACHE_VAL([lt_cv_sys_global_symbol_pipe], -[ -# These are sane defaults that work on at least a few old systems. -# [They come from Ultrix. What could be older than Ultrix?!! ;)] - -# Character class describing NM global symbol codes. -symcode='[[BCDEGRST]]' - -# Regexp to match symbols that can be accessed directly from C. -sympat='\([[_A-Za-z]][[_A-Za-z0-9]]*\)' - -# Define system-specific variables. -case $host_os in -aix*) - symcode='[[BCDT]]' - ;; -cygwin* | mingw* | pw32* | cegcc*) - symcode='[[ABCDGISTW]]' - ;; -hpux*) - if test ia64 = "$host_cpu"; then - symcode='[[ABCDEGRST]]' - fi - ;; -irix* | nonstopux*) - symcode='[[BCDEGRST]]' - ;; -osf*) - symcode='[[BCDEGQRST]]' - ;; -solaris*) - symcode='[[BDRT]]' - ;; -sco3.2v5*) - symcode='[[DT]]' - ;; -sysv4.2uw2*) - symcode='[[DT]]' - ;; -sysv5* | sco5v6* | unixware* | OpenUNIX*) - symcode='[[ABDT]]' - ;; -sysv4) - symcode='[[DFNSTU]]' - ;; -esac - -# If we're using GNU nm, then use its standard symbol codes. -case `$NM -V 2>&1` in -*GNU* | *'with BFD'*) - symcode='[[ABCDGIRSTW]]' ;; -esac - -if test "$lt_cv_nm_interface" = "MS dumpbin"; then - # Gets list of data symbols to import. - lt_cv_sys_global_symbol_to_import="sed -n -e 's/^I .* \(.*\)$/\1/p'" - # Adjust the below global symbol transforms to fixup imported variables. - lt_cdecl_hook=" -e 's/^I .* \(.*\)$/extern __declspec(dllimport) char \1;/p'" - lt_c_name_hook=" -e 's/^I .* \(.*\)$/ {\"\1\", (void *) 0},/p'" - lt_c_name_lib_hook="\ - -e 's/^I .* \(lib.*\)$/ {\"\1\", (void *) 0},/p'\ - -e 's/^I .* \(.*\)$/ {\"lib\1\", (void *) 0},/p'" -else - # Disable hooks by default. - lt_cv_sys_global_symbol_to_import= - lt_cdecl_hook= - lt_c_name_hook= - lt_c_name_lib_hook= -fi - -# Transform an extracted symbol line into a proper C declaration. -# Some systems (esp. on ia64) link data and code symbols differently, -# so use this general approach. -lt_cv_sys_global_symbol_to_cdecl="sed -n"\ -$lt_cdecl_hook\ -" -e 's/^T .* \(.*\)$/extern int \1();/p'"\ -" -e 's/^$symcode$symcode* .* \(.*\)$/extern char \1;/p'" - -# Transform an extracted symbol line into symbol name and symbol address -lt_cv_sys_global_symbol_to_c_name_address="sed -n"\ -$lt_c_name_hook\ -" -e 's/^: \(.*\) .*$/ {\"\1\", (void *) 0},/p'"\ -" -e 's/^$symcode$symcode* .* \(.*\)$/ {\"\1\", (void *) \&\1},/p'" - -# Transform an extracted symbol line into symbol name with lib prefix and -# symbol address. -lt_cv_sys_global_symbol_to_c_name_address_lib_prefix="sed -n"\ -$lt_c_name_lib_hook\ -" -e 's/^: \(.*\) .*$/ {\"\1\", (void *) 0},/p'"\ -" -e 's/^$symcode$symcode* .* \(lib.*\)$/ {\"\1\", (void *) \&\1},/p'"\ -" -e 's/^$symcode$symcode* .* \(.*\)$/ {\"lib\1\", (void *) \&\1},/p'" - -# Handle CRLF in mingw tool chain -opt_cr= -case $build_os in -mingw*) - opt_cr=`$ECHO 'x\{0,1\}' | tr x '\015'` # option cr in regexp - ;; -esac - -# Try without a prefix underscore, then with it. -for ac_symprfx in "" "_"; do - - # Transform symcode, sympat, and symprfx into a raw symbol and a C symbol. - symxfrm="\\1 $ac_symprfx\\2 \\2" - - # Write the raw and C identifiers. - if test "$lt_cv_nm_interface" = "MS dumpbin"; then - # Fake it for dumpbin and say T for any non-static function, - # D for any global variable and I for any imported variable. - # Also find C++ and __fastcall symbols from MSVC++, - # which start with @ or ?. - lt_cv_sys_global_symbol_pipe="$AWK ['"\ -" {last_section=section; section=\$ 3};"\ -" /^COFF SYMBOL TABLE/{for(i in hide) delete hide[i]};"\ -" /Section length .*#relocs.*(pick any)/{hide[last_section]=1};"\ -" /^ *Symbol name *: /{split(\$ 0,sn,\":\"); si=substr(sn[2],2)};"\ -" /^ *Type *: code/{print \"T\",si,substr(si,length(prfx))};"\ -" /^ *Type *: data/{print \"I\",si,substr(si,length(prfx))};"\ -" \$ 0!~/External *\|/{next};"\ -" / 0+ UNDEF /{next}; / UNDEF \([^|]\)*()/{next};"\ -" {if(hide[section]) next};"\ -" {f=\"D\"}; \$ 0~/\(\).*\|/{f=\"T\"};"\ -" {split(\$ 0,a,/\||\r/); split(a[2],s)};"\ -" s[1]~/^[@?]/{print f,s[1],s[1]; next};"\ -" s[1]~prfx {split(s[1],t,\"@\"); print f,t[1],substr(t[1],length(prfx))}"\ -" ' prfx=^$ac_symprfx]" - else - lt_cv_sys_global_symbol_pipe="sed -n -e 's/^.*[[ ]]\($symcode$symcode*\)[[ ]][[ ]]*$ac_symprfx$sympat$opt_cr$/$symxfrm/p'" - fi - lt_cv_sys_global_symbol_pipe="$lt_cv_sys_global_symbol_pipe | sed '/ __gnu_lto/d'" - - # Check to see that the pipe works correctly. - pipe_works=no - - rm -f conftest* - cat > conftest.$ac_ext <<_LT_EOF -#ifdef __cplusplus -extern "C" { -#endif -char nm_test_var; -void nm_test_func(void); -void nm_test_func(void){} -#ifdef __cplusplus -} -#endif -int main(){nm_test_var='a';nm_test_func();return(0);} -_LT_EOF - - if AC_TRY_EVAL(ac_compile); then - # Now try to grab the symbols. - nlist=conftest.nm - if AC_TRY_EVAL(NM conftest.$ac_objext \| "$lt_cv_sys_global_symbol_pipe" \> $nlist) && test -s "$nlist"; then - # Try sorting and uniquifying the output. - if sort "$nlist" | uniq > "$nlist"T; then - mv -f "$nlist"T "$nlist" - else - rm -f "$nlist"T - fi - - # Make sure that we snagged all the symbols we need. - if $GREP ' nm_test_var$' "$nlist" >/dev/null; then - if $GREP ' nm_test_func$' "$nlist" >/dev/null; then - cat <<_LT_EOF > conftest.$ac_ext -/* Keep this code in sync between libtool.m4, ltmain, lt_system.h, and tests. */ -#if defined _WIN32 || defined __CYGWIN__ || defined _WIN32_WCE -/* DATA imports from DLLs on WIN32 can't be const, because runtime - relocations are performed -- see ld's documentation on pseudo-relocs. */ -# define LT@&t@_DLSYM_CONST -#elif defined __osf__ -/* This system does not cope well with relocations in const data. */ -# define LT@&t@_DLSYM_CONST -#else -# define LT@&t@_DLSYM_CONST const -#endif - -#ifdef __cplusplus -extern "C" { -#endif - -_LT_EOF - # Now generate the symbol file. - eval "$lt_cv_sys_global_symbol_to_cdecl"' < "$nlist" | $GREP -v main >> conftest.$ac_ext' - - cat <<_LT_EOF >> conftest.$ac_ext - -/* The mapping between symbol names and symbols. */ -LT@&t@_DLSYM_CONST struct { - const char *name; - void *address; -} -lt__PROGRAM__LTX_preloaded_symbols[[]] = -{ - { "@PROGRAM@", (void *) 0 }, -_LT_EOF - $SED "s/^$symcode$symcode* .* \(.*\)$/ {\"\1\", (void *) \&\1},/" < "$nlist" | $GREP -v main >> conftest.$ac_ext - cat <<\_LT_EOF >> conftest.$ac_ext - {0, (void *) 0} -}; - -/* This works around a problem in FreeBSD linker */ -#ifdef FREEBSD_WORKAROUND -static const void *lt_preloaded_setup() { - return lt__PROGRAM__LTX_preloaded_symbols; -} -#endif - -#ifdef __cplusplus -} -#endif -_LT_EOF - # Now try linking the two files. - mv conftest.$ac_objext conftstm.$ac_objext - lt_globsym_save_LIBS=$LIBS - lt_globsym_save_CFLAGS=$CFLAGS - LIBS=conftstm.$ac_objext - CFLAGS="$CFLAGS$_LT_TAGVAR(lt_prog_compiler_no_builtin_flag, $1)" - if AC_TRY_EVAL(ac_link) && test -s conftest$ac_exeext; then - pipe_works=yes - fi - LIBS=$lt_globsym_save_LIBS - CFLAGS=$lt_globsym_save_CFLAGS - else - echo "cannot find nm_test_func in $nlist" >&AS_MESSAGE_LOG_FD - fi - else - echo "cannot find nm_test_var in $nlist" >&AS_MESSAGE_LOG_FD - fi - else - echo "cannot run $lt_cv_sys_global_symbol_pipe" >&AS_MESSAGE_LOG_FD - fi - else - echo "$progname: failed program was:" >&AS_MESSAGE_LOG_FD - cat conftest.$ac_ext >&5 - fi - rm -rf conftest* conftst* - - # Do not use the global_symbol_pipe unless it works. - if test yes = "$pipe_works"; then - break - else - lt_cv_sys_global_symbol_pipe= - fi -done -]) -if test -z "$lt_cv_sys_global_symbol_pipe"; then - lt_cv_sys_global_symbol_to_cdecl= -fi -if test -z "$lt_cv_sys_global_symbol_pipe$lt_cv_sys_global_symbol_to_cdecl"; then - AC_MSG_RESULT(failed) -else - AC_MSG_RESULT(ok) -fi - -# Response file support. -if test "$lt_cv_nm_interface" = "MS dumpbin"; then - nm_file_list_spec='@' -elif $NM --help 2>/dev/null | grep '[[@]]FILE' >/dev/null; then - nm_file_list_spec='@' -fi - -_LT_DECL([global_symbol_pipe], [lt_cv_sys_global_symbol_pipe], [1], - [Take the output of nm and produce a listing of raw symbols and C names]) -_LT_DECL([global_symbol_to_cdecl], [lt_cv_sys_global_symbol_to_cdecl], [1], - [Transform the output of nm in a proper C declaration]) -_LT_DECL([global_symbol_to_import], [lt_cv_sys_global_symbol_to_import], [1], - [Transform the output of nm into a list of symbols to manually relocate]) -_LT_DECL([global_symbol_to_c_name_address], - [lt_cv_sys_global_symbol_to_c_name_address], [1], - [Transform the output of nm in a C name address pair]) -_LT_DECL([global_symbol_to_c_name_address_lib_prefix], - [lt_cv_sys_global_symbol_to_c_name_address_lib_prefix], [1], - [Transform the output of nm in a C name address pair when lib prefix is needed]) -_LT_DECL([nm_interface], [lt_cv_nm_interface], [1], - [The name lister interface]) -_LT_DECL([], [nm_file_list_spec], [1], - [Specify filename containing input files for $NM]) -]) # _LT_CMD_GLOBAL_SYMBOLS - - -# _LT_COMPILER_PIC([TAGNAME]) -# --------------------------- -m4_defun([_LT_COMPILER_PIC], -[m4_require([_LT_TAG_COMPILER])dnl -_LT_TAGVAR(lt_prog_compiler_wl, $1)= -_LT_TAGVAR(lt_prog_compiler_pic, $1)= -_LT_TAGVAR(lt_prog_compiler_static, $1)= - -m4_if([$1], [CXX], [ - # C++ specific cases for pic, static, wl, etc. - if test yes = "$GXX"; then - _LT_TAGVAR(lt_prog_compiler_wl, $1)='-Wl,' - _LT_TAGVAR(lt_prog_compiler_static, $1)='-static' - - case $host_os in - aix*) - # All AIX code is PIC. - if test ia64 = "$host_cpu"; then - # AIX 5 now supports IA64 processor - _LT_TAGVAR(lt_prog_compiler_static, $1)='-Bstatic' - fi - _LT_TAGVAR(lt_prog_compiler_pic, $1)='-fPIC' - ;; - - amigaos*) - case $host_cpu in - powerpc) - # see comment about AmigaOS4 .so support - _LT_TAGVAR(lt_prog_compiler_pic, $1)='-fPIC' - ;; - m68k) - # FIXME: we need at least 68020 code to build shared libraries, but - # adding the '-m68020' flag to GCC prevents building anything better, - # like '-m68040'. - _LT_TAGVAR(lt_prog_compiler_pic, $1)='-m68020 -resident32 -malways-restore-a4' - ;; - esac - ;; - - beos* | irix5* | irix6* | nonstopux* | osf3* | osf4* | osf5*) - # PIC is the default for these OSes. - ;; - mingw* | cygwin* | os2* | pw32* | cegcc*) - # This hack is so that the source file can tell whether it is being - # built for inclusion in a dll (and should export symbols for example). - # Although the cygwin gcc ignores -fPIC, still need this for old-style - # (--disable-auto-import) libraries - m4_if([$1], [GCJ], [], - [_LT_TAGVAR(lt_prog_compiler_pic, $1)='-DDLL_EXPORT']) - case $host_os in - os2*) - _LT_TAGVAR(lt_prog_compiler_static, $1)='$wl-static' - ;; - esac - ;; - darwin* | rhapsody*) - # PIC is the default on this platform - # Common symbols not allowed in MH_DYLIB files - _LT_TAGVAR(lt_prog_compiler_pic, $1)='-fno-common' - ;; - *djgpp*) - # DJGPP does not support shared libraries at all - _LT_TAGVAR(lt_prog_compiler_pic, $1)= - ;; - haiku*) - # PIC is the default for Haiku. - # The "-static" flag exists, but is broken. - _LT_TAGVAR(lt_prog_compiler_static, $1)= - ;; - interix[[3-9]]*) - # Interix 3.x gcc -fpic/-fPIC options generate broken code. - # Instead, we relocate shared libraries at runtime. - ;; - sysv4*MP*) - if test -d /usr/nec; then - _LT_TAGVAR(lt_prog_compiler_pic, $1)=-Kconform_pic - fi - ;; - hpux*) - # PIC is the default for 64-bit PA HP-UX, but not for 32-bit - # PA HP-UX. On IA64 HP-UX, PIC is the default but the pic flag - # sets the default TLS model and affects inlining. - case $host_cpu in - hppa*64*) - ;; - *) - _LT_TAGVAR(lt_prog_compiler_pic, $1)='-fPIC' - ;; - esac - ;; - *qnx* | *nto*) - # QNX uses GNU C++, but need to define -shared option too, otherwise - # it will coredump. - _LT_TAGVAR(lt_prog_compiler_pic, $1)='-fPIC -shared' - ;; - *) - _LT_TAGVAR(lt_prog_compiler_pic, $1)='-fPIC' - ;; - esac - else - case $host_os in - aix[[4-9]]*) - # All AIX code is PIC. - if test ia64 = "$host_cpu"; then - # AIX 5 now supports IA64 processor - _LT_TAGVAR(lt_prog_compiler_static, $1)='-Bstatic' - else - _LT_TAGVAR(lt_prog_compiler_static, $1)='-bnso -bI:/lib/syscalls.exp' - fi - ;; - chorus*) - case $cc_basename in - cxch68*) - # Green Hills C++ Compiler - # _LT_TAGVAR(lt_prog_compiler_static, $1)="--no_auto_instantiation -u __main -u __premain -u _abort -r $COOL_DIR/lib/libOrb.a $MVME_DIR/lib/CC/libC.a $MVME_DIR/lib/classix/libcx.s.a" - ;; - esac - ;; - mingw* | cygwin* | os2* | pw32* | cegcc*) - # This hack is so that the source file can tell whether it is being - # built for inclusion in a dll (and should export symbols for example). - m4_if([$1], [GCJ], [], - [_LT_TAGVAR(lt_prog_compiler_pic, $1)='-DDLL_EXPORT']) - ;; - dgux*) - case $cc_basename in - ec++*) - _LT_TAGVAR(lt_prog_compiler_pic, $1)='-KPIC' - ;; - ghcx*) - # Green Hills C++ Compiler - _LT_TAGVAR(lt_prog_compiler_pic, $1)='-pic' - ;; - *) - ;; - esac - ;; - freebsd* | dragonfly*) - # FreeBSD uses GNU C++ - ;; - hpux9* | hpux10* | hpux11*) - case $cc_basename in - CC*) - _LT_TAGVAR(lt_prog_compiler_wl, $1)='-Wl,' - _LT_TAGVAR(lt_prog_compiler_static, $1)='$wl-a ${wl}archive' - if test ia64 != "$host_cpu"; then - _LT_TAGVAR(lt_prog_compiler_pic, $1)='+Z' - fi - ;; - aCC*) - _LT_TAGVAR(lt_prog_compiler_wl, $1)='-Wl,' - _LT_TAGVAR(lt_prog_compiler_static, $1)='$wl-a ${wl}archive' - case $host_cpu in - hppa*64*|ia64*) - # +Z the default - ;; - *) - _LT_TAGVAR(lt_prog_compiler_pic, $1)='+Z' - ;; - esac - ;; - *) - ;; - esac - ;; - interix*) - # This is c89, which is MS Visual C++ (no shared libs) - # Anyone wants to do a port? - ;; - irix5* | irix6* | nonstopux*) - case $cc_basename in - CC*) - _LT_TAGVAR(lt_prog_compiler_wl, $1)='-Wl,' - _LT_TAGVAR(lt_prog_compiler_static, $1)='-non_shared' - # CC pic flag -KPIC is the default. - ;; - *) - ;; - esac - ;; - linux* | k*bsd*-gnu | kopensolaris*-gnu | gnu*) - case $cc_basename in - KCC*) - # KAI C++ Compiler - _LT_TAGVAR(lt_prog_compiler_wl, $1)='--backend -Wl,' - _LT_TAGVAR(lt_prog_compiler_pic, $1)='-fPIC' - ;; - ecpc* ) - # old Intel C++ for x86_64, which still supported -KPIC. - _LT_TAGVAR(lt_prog_compiler_wl, $1)='-Wl,' - _LT_TAGVAR(lt_prog_compiler_pic, $1)='-KPIC' - _LT_TAGVAR(lt_prog_compiler_static, $1)='-static' - ;; - icpc* ) - # Intel C++, used to be incompatible with GCC. - # ICC 10 doesn't accept -KPIC any more. - _LT_TAGVAR(lt_prog_compiler_wl, $1)='-Wl,' - _LT_TAGVAR(lt_prog_compiler_pic, $1)='-fPIC' - _LT_TAGVAR(lt_prog_compiler_static, $1)='-static' - ;; - pgCC* | pgcpp*) - # Portland Group C++ compiler - _LT_TAGVAR(lt_prog_compiler_wl, $1)='-Wl,' - _LT_TAGVAR(lt_prog_compiler_pic, $1)='-fpic' - _LT_TAGVAR(lt_prog_compiler_static, $1)='-Bstatic' - ;; - cxx*) - # Compaq C++ - # Make sure the PIC flag is empty. It appears that all Alpha - # Linux and Compaq Tru64 Unix objects are PIC. - _LT_TAGVAR(lt_prog_compiler_pic, $1)= - _LT_TAGVAR(lt_prog_compiler_static, $1)='-non_shared' - ;; - xlc* | xlC* | bgxl[[cC]]* | mpixl[[cC]]*) - # IBM XL 8.0, 9.0 on PPC and BlueGene - _LT_TAGVAR(lt_prog_compiler_wl, $1)='-Wl,' - _LT_TAGVAR(lt_prog_compiler_pic, $1)='-qpic' - _LT_TAGVAR(lt_prog_compiler_static, $1)='-qstaticlink' - ;; - *) - case `$CC -V 2>&1 | sed 5q` in - *Sun\ C*) - # Sun C++ 5.9 - _LT_TAGVAR(lt_prog_compiler_pic, $1)='-KPIC' - _LT_TAGVAR(lt_prog_compiler_static, $1)='-Bstatic' - _LT_TAGVAR(lt_prog_compiler_wl, $1)='-Qoption ld ' - ;; - esac - ;; - esac - ;; - lynxos*) - ;; - m88k*) - ;; - mvs*) - case $cc_basename in - cxx*) - _LT_TAGVAR(lt_prog_compiler_pic, $1)='-W c,exportall' - ;; - *) - ;; - esac - ;; - netbsd*) - ;; - *qnx* | *nto*) - # QNX uses GNU C++, but need to define -shared option too, otherwise - # it will coredump. - _LT_TAGVAR(lt_prog_compiler_pic, $1)='-fPIC -shared' - ;; - osf3* | osf4* | osf5*) - case $cc_basename in - KCC*) - _LT_TAGVAR(lt_prog_compiler_wl, $1)='--backend -Wl,' - ;; - RCC*) - # Rational C++ 2.4.1 - _LT_TAGVAR(lt_prog_compiler_pic, $1)='-pic' - ;; - cxx*) - # Digital/Compaq C++ - _LT_TAGVAR(lt_prog_compiler_wl, $1)='-Wl,' - # Make sure the PIC flag is empty. It appears that all Alpha - # Linux and Compaq Tru64 Unix objects are PIC. - _LT_TAGVAR(lt_prog_compiler_pic, $1)= - _LT_TAGVAR(lt_prog_compiler_static, $1)='-non_shared' - ;; - *) - ;; - esac - ;; - psos*) - ;; - solaris*) - case $cc_basename in - CC* | sunCC*) - # Sun C++ 4.2, 5.x and Centerline C++ - _LT_TAGVAR(lt_prog_compiler_pic, $1)='-KPIC' - _LT_TAGVAR(lt_prog_compiler_static, $1)='-Bstatic' - _LT_TAGVAR(lt_prog_compiler_wl, $1)='-Qoption ld ' - ;; - gcx*) - # Green Hills C++ Compiler - _LT_TAGVAR(lt_prog_compiler_pic, $1)='-PIC' - ;; - *) - ;; - esac - ;; - sunos4*) - case $cc_basename in - CC*) - # Sun C++ 4.x - _LT_TAGVAR(lt_prog_compiler_pic, $1)='-pic' - _LT_TAGVAR(lt_prog_compiler_static, $1)='-Bstatic' - ;; - lcc*) - # Lucid - _LT_TAGVAR(lt_prog_compiler_pic, $1)='-pic' - ;; - *) - ;; - esac - ;; - sysv5* | unixware* | sco3.2v5* | sco5v6* | OpenUNIX*) - case $cc_basename in - CC*) - _LT_TAGVAR(lt_prog_compiler_wl, $1)='-Wl,' - _LT_TAGVAR(lt_prog_compiler_pic, $1)='-KPIC' - _LT_TAGVAR(lt_prog_compiler_static, $1)='-Bstatic' - ;; - esac - ;; - tandem*) - case $cc_basename in - NCC*) - # NonStop-UX NCC 3.20 - _LT_TAGVAR(lt_prog_compiler_pic, $1)='-KPIC' - ;; - *) - ;; - esac - ;; - vxworks*) - ;; - *) - _LT_TAGVAR(lt_prog_compiler_can_build_shared, $1)=no - ;; - esac - fi -], -[ - if test yes = "$GCC"; then - _LT_TAGVAR(lt_prog_compiler_wl, $1)='-Wl,' - _LT_TAGVAR(lt_prog_compiler_static, $1)='-static' - - case $host_os in - aix*) - # All AIX code is PIC. - if test ia64 = "$host_cpu"; then - # AIX 5 now supports IA64 processor - _LT_TAGVAR(lt_prog_compiler_static, $1)='-Bstatic' - fi - _LT_TAGVAR(lt_prog_compiler_pic, $1)='-fPIC' - ;; - - amigaos*) - case $host_cpu in - powerpc) - # see comment about AmigaOS4 .so support - _LT_TAGVAR(lt_prog_compiler_pic, $1)='-fPIC' - ;; - m68k) - # FIXME: we need at least 68020 code to build shared libraries, but - # adding the '-m68020' flag to GCC prevents building anything better, - # like '-m68040'. - _LT_TAGVAR(lt_prog_compiler_pic, $1)='-m68020 -resident32 -malways-restore-a4' - ;; - esac - ;; - - beos* | irix5* | irix6* | nonstopux* | osf3* | osf4* | osf5*) - # PIC is the default for these OSes. - ;; - - mingw* | cygwin* | pw32* | os2* | cegcc*) - # This hack is so that the source file can tell whether it is being - # built for inclusion in a dll (and should export symbols for example). - # Although the cygwin gcc ignores -fPIC, still need this for old-style - # (--disable-auto-import) libraries - m4_if([$1], [GCJ], [], - [_LT_TAGVAR(lt_prog_compiler_pic, $1)='-DDLL_EXPORT']) - case $host_os in - os2*) - _LT_TAGVAR(lt_prog_compiler_static, $1)='$wl-static' - ;; - esac - ;; - - darwin* | rhapsody*) - # PIC is the default on this platform - # Common symbols not allowed in MH_DYLIB files - _LT_TAGVAR(lt_prog_compiler_pic, $1)='-fno-common' - ;; - - haiku*) - # PIC is the default for Haiku. - # The "-static" flag exists, but is broken. - _LT_TAGVAR(lt_prog_compiler_static, $1)= - ;; - - hpux*) - # PIC is the default for 64-bit PA HP-UX, but not for 32-bit - # PA HP-UX. On IA64 HP-UX, PIC is the default but the pic flag - # sets the default TLS model and affects inlining. - case $host_cpu in - hppa*64*) - # +Z the default - ;; - *) - _LT_TAGVAR(lt_prog_compiler_pic, $1)='-fPIC' - ;; - esac - ;; - - interix[[3-9]]*) - # Interix 3.x gcc -fpic/-fPIC options generate broken code. - # Instead, we relocate shared libraries at runtime. - ;; - - msdosdjgpp*) - # Just because we use GCC doesn't mean we suddenly get shared libraries - # on systems that don't support them. - _LT_TAGVAR(lt_prog_compiler_can_build_shared, $1)=no - enable_shared=no - ;; - - *nto* | *qnx*) - # QNX uses GNU C++, but need to define -shared option too, otherwise - # it will coredump. - _LT_TAGVAR(lt_prog_compiler_pic, $1)='-fPIC -shared' - ;; - - sysv4*MP*) - if test -d /usr/nec; then - _LT_TAGVAR(lt_prog_compiler_pic, $1)=-Kconform_pic - fi - ;; - - *) - _LT_TAGVAR(lt_prog_compiler_pic, $1)='-fPIC' - ;; - esac - - case $cc_basename in - nvcc*) # Cuda Compiler Driver 2.2 - _LT_TAGVAR(lt_prog_compiler_wl, $1)='-Xlinker ' - if test -n "$_LT_TAGVAR(lt_prog_compiler_pic, $1)"; then - _LT_TAGVAR(lt_prog_compiler_pic, $1)="-Xcompiler $_LT_TAGVAR(lt_prog_compiler_pic, $1)" - fi - ;; - esac - else - # PORTME Check for flag to pass linker flags through the system compiler. - case $host_os in - aix*) - _LT_TAGVAR(lt_prog_compiler_wl, $1)='-Wl,' - if test ia64 = "$host_cpu"; then - # AIX 5 now supports IA64 processor - _LT_TAGVAR(lt_prog_compiler_static, $1)='-Bstatic' - else - _LT_TAGVAR(lt_prog_compiler_static, $1)='-bnso -bI:/lib/syscalls.exp' - fi - ;; - - darwin* | rhapsody*) - # PIC is the default on this platform - # Common symbols not allowed in MH_DYLIB files - _LT_TAGVAR(lt_prog_compiler_pic, $1)='-fno-common' - case $cc_basename in - nagfor*) - # NAG Fortran compiler - _LT_TAGVAR(lt_prog_compiler_wl, $1)='-Wl,-Wl,,' - _LT_TAGVAR(lt_prog_compiler_pic, $1)='-PIC' - _LT_TAGVAR(lt_prog_compiler_static, $1)='-Bstatic' - ;; - esac - ;; - - mingw* | cygwin* | pw32* | os2* | cegcc*) - # This hack is so that the source file can tell whether it is being - # built for inclusion in a dll (and should export symbols for example). - m4_if([$1], [GCJ], [], - [_LT_TAGVAR(lt_prog_compiler_pic, $1)='-DDLL_EXPORT']) - case $host_os in - os2*) - _LT_TAGVAR(lt_prog_compiler_static, $1)='$wl-static' - ;; - esac - ;; - - hpux9* | hpux10* | hpux11*) - _LT_TAGVAR(lt_prog_compiler_wl, $1)='-Wl,' - # PIC is the default for IA64 HP-UX and 64-bit HP-UX, but - # not for PA HP-UX. - case $host_cpu in - hppa*64*|ia64*) - # +Z the default - ;; - *) - _LT_TAGVAR(lt_prog_compiler_pic, $1)='+Z' - ;; - esac - # Is there a better lt_prog_compiler_static that works with the bundled CC? - _LT_TAGVAR(lt_prog_compiler_static, $1)='$wl-a ${wl}archive' - ;; - - irix5* | irix6* | nonstopux*) - _LT_TAGVAR(lt_prog_compiler_wl, $1)='-Wl,' - # PIC (with -KPIC) is the default. - _LT_TAGVAR(lt_prog_compiler_static, $1)='-non_shared' - ;; - - linux* | k*bsd*-gnu | kopensolaris*-gnu | gnu*) - case $cc_basename in - # old Intel for x86_64, which still supported -KPIC. - ecc*) - _LT_TAGVAR(lt_prog_compiler_wl, $1)='-Wl,' - _LT_TAGVAR(lt_prog_compiler_pic, $1)='-KPIC' - _LT_TAGVAR(lt_prog_compiler_static, $1)='-static' - ;; - # icc used to be incompatible with GCC. - # ICC 10 doesn't accept -KPIC any more. - icc* | ifort*) - _LT_TAGVAR(lt_prog_compiler_wl, $1)='-Wl,' - _LT_TAGVAR(lt_prog_compiler_pic, $1)='-fPIC' - _LT_TAGVAR(lt_prog_compiler_static, $1)='-static' - ;; - # Lahey Fortran 8.1. - lf95*) - _LT_TAGVAR(lt_prog_compiler_wl, $1)='-Wl,' - _LT_TAGVAR(lt_prog_compiler_pic, $1)='--shared' - _LT_TAGVAR(lt_prog_compiler_static, $1)='--static' - ;; - nagfor*) - # NAG Fortran compiler - _LT_TAGVAR(lt_prog_compiler_wl, $1)='-Wl,-Wl,,' - _LT_TAGVAR(lt_prog_compiler_pic, $1)='-PIC' - _LT_TAGVAR(lt_prog_compiler_static, $1)='-Bstatic' - ;; - tcc*) - # Fabrice Bellard et al's Tiny C Compiler - _LT_TAGVAR(lt_prog_compiler_wl, $1)='-Wl,' - _LT_TAGVAR(lt_prog_compiler_pic, $1)='-fPIC' - _LT_TAGVAR(lt_prog_compiler_static, $1)='-static' - ;; - pgcc* | pgf77* | pgf90* | pgf95* | pgfortran*) - # Portland Group compilers (*not* the Pentium gcc compiler, - # which looks to be a dead project) - _LT_TAGVAR(lt_prog_compiler_wl, $1)='-Wl,' - _LT_TAGVAR(lt_prog_compiler_pic, $1)='-fpic' - _LT_TAGVAR(lt_prog_compiler_static, $1)='-Bstatic' - ;; - ccc*) - _LT_TAGVAR(lt_prog_compiler_wl, $1)='-Wl,' - # All Alpha code is PIC. - _LT_TAGVAR(lt_prog_compiler_static, $1)='-non_shared' - ;; - xl* | bgxl* | bgf* | mpixl*) - # IBM XL C 8.0/Fortran 10.1, 11.1 on PPC and BlueGene - _LT_TAGVAR(lt_prog_compiler_wl, $1)='-Wl,' - _LT_TAGVAR(lt_prog_compiler_pic, $1)='-qpic' - _LT_TAGVAR(lt_prog_compiler_static, $1)='-qstaticlink' - ;; - *) - case `$CC -V 2>&1 | sed 5q` in - *Sun\ Ceres\ Fortran* | *Sun*Fortran*\ [[1-7]].* | *Sun*Fortran*\ 8.[[0-3]]*) - # Sun Fortran 8.3 passes all unrecognized flags to the linker - _LT_TAGVAR(lt_prog_compiler_pic, $1)='-KPIC' - _LT_TAGVAR(lt_prog_compiler_static, $1)='-Bstatic' - _LT_TAGVAR(lt_prog_compiler_wl, $1)='' - ;; - *Sun\ F* | *Sun*Fortran*) - _LT_TAGVAR(lt_prog_compiler_pic, $1)='-KPIC' - _LT_TAGVAR(lt_prog_compiler_static, $1)='-Bstatic' - _LT_TAGVAR(lt_prog_compiler_wl, $1)='-Qoption ld ' - ;; - *Sun\ C*) - # Sun C 5.9 - _LT_TAGVAR(lt_prog_compiler_pic, $1)='-KPIC' - _LT_TAGVAR(lt_prog_compiler_static, $1)='-Bstatic' - _LT_TAGVAR(lt_prog_compiler_wl, $1)='-Wl,' - ;; - *Intel*\ [[CF]]*Compiler*) - _LT_TAGVAR(lt_prog_compiler_wl, $1)='-Wl,' - _LT_TAGVAR(lt_prog_compiler_pic, $1)='-fPIC' - _LT_TAGVAR(lt_prog_compiler_static, $1)='-static' - ;; - *Portland\ Group*) - _LT_TAGVAR(lt_prog_compiler_wl, $1)='-Wl,' - _LT_TAGVAR(lt_prog_compiler_pic, $1)='-fpic' - _LT_TAGVAR(lt_prog_compiler_static, $1)='-Bstatic' - ;; - esac - ;; - esac - ;; - - newsos6) - _LT_TAGVAR(lt_prog_compiler_pic, $1)='-KPIC' - _LT_TAGVAR(lt_prog_compiler_static, $1)='-Bstatic' - ;; - - *nto* | *qnx*) - # QNX uses GNU C++, but need to define -shared option too, otherwise - # it will coredump. - _LT_TAGVAR(lt_prog_compiler_pic, $1)='-fPIC -shared' - ;; - - osf3* | osf4* | osf5*) - _LT_TAGVAR(lt_prog_compiler_wl, $1)='-Wl,' - # All OSF/1 code is PIC. - _LT_TAGVAR(lt_prog_compiler_static, $1)='-non_shared' - ;; - - rdos*) - _LT_TAGVAR(lt_prog_compiler_static, $1)='-non_shared' - ;; - - solaris*) - _LT_TAGVAR(lt_prog_compiler_pic, $1)='-KPIC' - _LT_TAGVAR(lt_prog_compiler_static, $1)='-Bstatic' - case $cc_basename in - f77* | f90* | f95* | sunf77* | sunf90* | sunf95*) - _LT_TAGVAR(lt_prog_compiler_wl, $1)='-Qoption ld ';; - *) - _LT_TAGVAR(lt_prog_compiler_wl, $1)='-Wl,';; - esac - ;; - - sunos4*) - _LT_TAGVAR(lt_prog_compiler_wl, $1)='-Qoption ld ' - _LT_TAGVAR(lt_prog_compiler_pic, $1)='-PIC' - _LT_TAGVAR(lt_prog_compiler_static, $1)='-Bstatic' - ;; - - sysv4 | sysv4.2uw2* | sysv4.3*) - _LT_TAGVAR(lt_prog_compiler_wl, $1)='-Wl,' - _LT_TAGVAR(lt_prog_compiler_pic, $1)='-KPIC' - _LT_TAGVAR(lt_prog_compiler_static, $1)='-Bstatic' - ;; - - sysv4*MP*) - if test -d /usr/nec; then - _LT_TAGVAR(lt_prog_compiler_pic, $1)='-Kconform_pic' - _LT_TAGVAR(lt_prog_compiler_static, $1)='-Bstatic' - fi - ;; - - sysv5* | unixware* | sco3.2v5* | sco5v6* | OpenUNIX*) - _LT_TAGVAR(lt_prog_compiler_wl, $1)='-Wl,' - _LT_TAGVAR(lt_prog_compiler_pic, $1)='-KPIC' - _LT_TAGVAR(lt_prog_compiler_static, $1)='-Bstatic' - ;; - - unicos*) - _LT_TAGVAR(lt_prog_compiler_wl, $1)='-Wl,' - _LT_TAGVAR(lt_prog_compiler_can_build_shared, $1)=no - ;; - - uts4*) - _LT_TAGVAR(lt_prog_compiler_pic, $1)='-pic' - _LT_TAGVAR(lt_prog_compiler_static, $1)='-Bstatic' - ;; - - *) - _LT_TAGVAR(lt_prog_compiler_can_build_shared, $1)=no - ;; - esac - fi -]) -case $host_os in - # For platforms that do not support PIC, -DPIC is meaningless: - *djgpp*) - _LT_TAGVAR(lt_prog_compiler_pic, $1)= - ;; - *) - _LT_TAGVAR(lt_prog_compiler_pic, $1)="$_LT_TAGVAR(lt_prog_compiler_pic, $1)@&t@m4_if([$1],[],[ -DPIC],[m4_if([$1],[CXX],[ -DPIC],[])])" - ;; -esac - -AC_CACHE_CHECK([for $compiler option to produce PIC], - [_LT_TAGVAR(lt_cv_prog_compiler_pic, $1)], - [_LT_TAGVAR(lt_cv_prog_compiler_pic, $1)=$_LT_TAGVAR(lt_prog_compiler_pic, $1)]) -_LT_TAGVAR(lt_prog_compiler_pic, $1)=$_LT_TAGVAR(lt_cv_prog_compiler_pic, $1) - -# -# Check to make sure the PIC flag actually works. -# -if test -n "$_LT_TAGVAR(lt_prog_compiler_pic, $1)"; then - _LT_COMPILER_OPTION([if $compiler PIC flag $_LT_TAGVAR(lt_prog_compiler_pic, $1) works], - [_LT_TAGVAR(lt_cv_prog_compiler_pic_works, $1)], - [$_LT_TAGVAR(lt_prog_compiler_pic, $1)@&t@m4_if([$1],[],[ -DPIC],[m4_if([$1],[CXX],[ -DPIC],[])])], [], - [case $_LT_TAGVAR(lt_prog_compiler_pic, $1) in - "" | " "*) ;; - *) _LT_TAGVAR(lt_prog_compiler_pic, $1)=" $_LT_TAGVAR(lt_prog_compiler_pic, $1)" ;; - esac], - [_LT_TAGVAR(lt_prog_compiler_pic, $1)= - _LT_TAGVAR(lt_prog_compiler_can_build_shared, $1)=no]) -fi -_LT_TAGDECL([pic_flag], [lt_prog_compiler_pic], [1], - [Additional compiler flags for building library objects]) - -_LT_TAGDECL([wl], [lt_prog_compiler_wl], [1], - [How to pass a linker flag through the compiler]) -# -# Check to make sure the static flag actually works. -# -wl=$_LT_TAGVAR(lt_prog_compiler_wl, $1) eval lt_tmp_static_flag=\"$_LT_TAGVAR(lt_prog_compiler_static, $1)\" -_LT_LINKER_OPTION([if $compiler static flag $lt_tmp_static_flag works], - _LT_TAGVAR(lt_cv_prog_compiler_static_works, $1), - $lt_tmp_static_flag, - [], - [_LT_TAGVAR(lt_prog_compiler_static, $1)=]) -_LT_TAGDECL([link_static_flag], [lt_prog_compiler_static], [1], - [Compiler flag to prevent dynamic linking]) -])# _LT_COMPILER_PIC - - -# _LT_LINKER_SHLIBS([TAGNAME]) -# ---------------------------- -# See if the linker supports building shared libraries. -m4_defun([_LT_LINKER_SHLIBS], -[AC_REQUIRE([LT_PATH_LD])dnl -AC_REQUIRE([LT_PATH_NM])dnl -m4_require([_LT_PATH_MANIFEST_TOOL])dnl -m4_require([_LT_FILEUTILS_DEFAULTS])dnl -m4_require([_LT_DECL_EGREP])dnl -m4_require([_LT_DECL_SED])dnl -m4_require([_LT_CMD_GLOBAL_SYMBOLS])dnl -m4_require([_LT_TAG_COMPILER])dnl -AC_MSG_CHECKING([whether the $compiler linker ($LD) supports shared libraries]) -m4_if([$1], [CXX], [ - _LT_TAGVAR(export_symbols_cmds, $1)='$NM $libobjs $convenience | $global_symbol_pipe | $SED '\''s/.* //'\'' | sort | uniq > $export_symbols' - _LT_TAGVAR(exclude_expsyms, $1)=['_GLOBAL_OFFSET_TABLE_|_GLOBAL__F[ID]_.*'] - case $host_os in - aix[[4-9]]*) - # If we're using GNU nm, then we don't want the "-C" option. - # -C means demangle to GNU nm, but means don't demangle to AIX nm. - # Without the "-l" option, or with the "-B" option, AIX nm treats - # weak defined symbols like other global defined symbols, whereas - # GNU nm marks them as "W". - # While the 'weak' keyword is ignored in the Export File, we need - # it in the Import File for the 'aix-soname' feature, so we have - # to replace the "-B" option with "-P" for AIX nm. - if $NM -V 2>&1 | $GREP 'GNU' > /dev/null; then - _LT_TAGVAR(export_symbols_cmds, $1)='$NM -Bpg $libobjs $convenience | awk '\''{ if (((\$ 2 == "T") || (\$ 2 == "D") || (\$ 2 == "B") || (\$ 2 == "W")) && ([substr](\$ 3,1,1) != ".")) { if (\$ 2 == "W") { print \$ 3 " weak" } else { print \$ 3 } } }'\'' | sort -u > $export_symbols' - else - _LT_TAGVAR(export_symbols_cmds, $1)='`func_echo_all $NM | $SED -e '\''s/B\([[^B]]*\)$/P\1/'\''` -PCpgl $libobjs $convenience | awk '\''{ if (((\$ 2 == "T") || (\$ 2 == "D") || (\$ 2 == "B") || (\$ 2 == "W") || (\$ 2 == "V") || (\$ 2 == "Z")) && ([substr](\$ 1,1,1) != ".")) { if ((\$ 2 == "W") || (\$ 2 == "V") || (\$ 2 == "Z")) { print \$ 1 " weak" } else { print \$ 1 } } }'\'' | sort -u > $export_symbols' - fi - ;; - pw32*) - _LT_TAGVAR(export_symbols_cmds, $1)=$ltdll_cmds - ;; - cygwin* | mingw* | cegcc*) - case $cc_basename in - cl*) - _LT_TAGVAR(exclude_expsyms, $1)='_NULL_IMPORT_DESCRIPTOR|_IMPORT_DESCRIPTOR_.*' - ;; - *) - _LT_TAGVAR(export_symbols_cmds, $1)='$NM $libobjs $convenience | $global_symbol_pipe | $SED -e '\''/^[[BCDGRS]][[ ]]/s/.*[[ ]]\([[^ ]]*\)/\1 DATA/;s/^.*[[ ]]__nm__\([[^ ]]*\)[[ ]][[^ ]]*/\1 DATA/;/^I[[ ]]/d;/^[[AITW]][[ ]]/s/.* //'\'' | sort | uniq > $export_symbols' - _LT_TAGVAR(exclude_expsyms, $1)=['[_]+GLOBAL_OFFSET_TABLE_|[_]+GLOBAL__[FID]_.*|[_]+head_[A-Za-z0-9_]+_dll|[A-Za-z0-9_]+_dll_iname'] - ;; - esac - ;; - *) - _LT_TAGVAR(export_symbols_cmds, $1)='$NM $libobjs $convenience | $global_symbol_pipe | $SED '\''s/.* //'\'' | sort | uniq > $export_symbols' - ;; - esac -], [ - runpath_var= - _LT_TAGVAR(allow_undefined_flag, $1)= - _LT_TAGVAR(always_export_symbols, $1)=no - _LT_TAGVAR(archive_cmds, $1)= - _LT_TAGVAR(archive_expsym_cmds, $1)= - _LT_TAGVAR(compiler_needs_object, $1)=no - _LT_TAGVAR(enable_shared_with_static_runtimes, $1)=no - _LT_TAGVAR(export_dynamic_flag_spec, $1)= - _LT_TAGVAR(export_symbols_cmds, $1)='$NM $libobjs $convenience | $global_symbol_pipe | $SED '\''s/.* //'\'' | sort | uniq > $export_symbols' - _LT_TAGVAR(hardcode_automatic, $1)=no - _LT_TAGVAR(hardcode_direct, $1)=no - _LT_TAGVAR(hardcode_direct_absolute, $1)=no - _LT_TAGVAR(hardcode_libdir_flag_spec, $1)= - _LT_TAGVAR(hardcode_libdir_separator, $1)= - _LT_TAGVAR(hardcode_minus_L, $1)=no - _LT_TAGVAR(hardcode_shlibpath_var, $1)=unsupported - _LT_TAGVAR(inherit_rpath, $1)=no - _LT_TAGVAR(link_all_deplibs, $1)=unknown - _LT_TAGVAR(module_cmds, $1)= - _LT_TAGVAR(module_expsym_cmds, $1)= - _LT_TAGVAR(old_archive_from_new_cmds, $1)= - _LT_TAGVAR(old_archive_from_expsyms_cmds, $1)= - _LT_TAGVAR(thread_safe_flag_spec, $1)= - _LT_TAGVAR(whole_archive_flag_spec, $1)= - # include_expsyms should be a list of space-separated symbols to be *always* - # included in the symbol list - _LT_TAGVAR(include_expsyms, $1)= - # exclude_expsyms can be an extended regexp of symbols to exclude - # it will be wrapped by ' (' and ')$', so one must not match beginning or - # end of line. Example: 'a|bc|.*d.*' will exclude the symbols 'a' and 'bc', - # as well as any symbol that contains 'd'. - _LT_TAGVAR(exclude_expsyms, $1)=['_GLOBAL_OFFSET_TABLE_|_GLOBAL__F[ID]_.*'] - # Although _GLOBAL_OFFSET_TABLE_ is a valid symbol C name, most a.out - # platforms (ab)use it in PIC code, but their linkers get confused if - # the symbol is explicitly referenced. Since portable code cannot - # rely on this symbol name, it's probably fine to never include it in - # preloaded symbol tables. - # Exclude shared library initialization/finalization symbols. -dnl Note also adjust exclude_expsyms for C++ above. - extract_expsyms_cmds= - - case $host_os in - cygwin* | mingw* | pw32* | cegcc*) - # FIXME: the MSVC++ port hasn't been tested in a loooong time - # When not using gcc, we currently assume that we are using - # Microsoft Visual C++. - if test yes != "$GCC"; then - with_gnu_ld=no - fi - ;; - interix*) - # we just hope/assume this is gcc and not c89 (= MSVC++) - with_gnu_ld=yes - ;; - openbsd* | bitrig*) - with_gnu_ld=no - ;; - esac - - _LT_TAGVAR(ld_shlibs, $1)=yes - - # On some targets, GNU ld is compatible enough with the native linker - # that we're better off using the native interface for both. - lt_use_gnu_ld_interface=no - if test yes = "$with_gnu_ld"; then - case $host_os in - aix*) - # The AIX port of GNU ld has always aspired to compatibility - # with the native linker. However, as the warning in the GNU ld - # block says, versions before 2.19.5* couldn't really create working - # shared libraries, regardless of the interface used. - case `$LD -v 2>&1` in - *\ \(GNU\ Binutils\)\ 2.19.5*) ;; - *\ \(GNU\ Binutils\)\ 2.[[2-9]]*) ;; - *\ \(GNU\ Binutils\)\ [[3-9]]*) ;; - *) - lt_use_gnu_ld_interface=yes - ;; - esac - ;; - *) - lt_use_gnu_ld_interface=yes - ;; - esac - fi - - if test yes = "$lt_use_gnu_ld_interface"; then - # If archive_cmds runs LD, not CC, wlarc should be empty - wlarc='$wl' - - # Set some defaults for GNU ld with shared library support. These - # are reset later if shared libraries are not supported. Putting them - # here allows them to be overridden if necessary. - runpath_var=LD_RUN_PATH - _LT_TAGVAR(hardcode_libdir_flag_spec, $1)='$wl-rpath $wl$libdir' - _LT_TAGVAR(export_dynamic_flag_spec, $1)='$wl--export-dynamic' - # ancient GNU ld didn't support --whole-archive et. al. - if $LD --help 2>&1 | $GREP 'no-whole-archive' > /dev/null; then - _LT_TAGVAR(whole_archive_flag_spec, $1)=$wlarc'--whole-archive$convenience '$wlarc'--no-whole-archive' - else - _LT_TAGVAR(whole_archive_flag_spec, $1)= - fi - supports_anon_versioning=no - case `$LD -v | $SED -e 's/([^)]\+)\s\+//' 2>&1` in - *GNU\ gold*) supports_anon_versioning=yes ;; - *\ [[01]].* | *\ 2.[[0-9]].* | *\ 2.10.*) ;; # catch versions < 2.11 - *\ 2.11.93.0.2\ *) supports_anon_versioning=yes ;; # RH7.3 ... - *\ 2.11.92.0.12\ *) supports_anon_versioning=yes ;; # Mandrake 8.2 ... - *\ 2.11.*) ;; # other 2.11 versions - *) supports_anon_versioning=yes ;; - esac - - # See if GNU ld supports shared libraries. - case $host_os in - aix[[3-9]]*) - # On AIX/PPC, the GNU linker is very broken - if test ia64 != "$host_cpu"; then - _LT_TAGVAR(ld_shlibs, $1)=no - cat <<_LT_EOF 1>&2 - -*** Warning: the GNU linker, at least up to release 2.19, is reported -*** to be unable to reliably create shared libraries on AIX. -*** Therefore, libtool is disabling shared libraries support. If you -*** really care for shared libraries, you may want to install binutils -*** 2.20 or above, or modify your PATH so that a non-GNU linker is found. -*** You will then need to restart the configuration process. - -_LT_EOF - fi - ;; - - amigaos*) - case $host_cpu in - powerpc) - # see comment about AmigaOS4 .so support - _LT_TAGVAR(archive_cmds, $1)='$CC -shared $libobjs $deplibs $compiler_flags $wl-soname $wl$soname -o $lib' - _LT_TAGVAR(archive_expsym_cmds, $1)='' - ;; - m68k) - _LT_TAGVAR(archive_cmds, $1)='$RM $output_objdir/a2ixlibrary.data~$ECHO "#define NAME $libname" > $output_objdir/a2ixlibrary.data~$ECHO "#define LIBRARY_ID 1" >> $output_objdir/a2ixlibrary.data~$ECHO "#define VERSION $major" >> $output_objdir/a2ixlibrary.data~$ECHO "#define REVISION $revision" >> $output_objdir/a2ixlibrary.data~$AR $AR_FLAGS $lib $libobjs~$RANLIB $lib~(cd $output_objdir && a2ixlibrary -32)' - _LT_TAGVAR(hardcode_libdir_flag_spec, $1)='-L$libdir' - _LT_TAGVAR(hardcode_minus_L, $1)=yes - ;; - esac - ;; - - beos*) - if $LD --help 2>&1 | $GREP ': supported targets:.* elf' > /dev/null; then - _LT_TAGVAR(allow_undefined_flag, $1)=unsupported - # Joseph Beckenbach says some releases of gcc - # support --undefined. This deserves some investigation. FIXME - _LT_TAGVAR(archive_cmds, $1)='$CC -nostart $libobjs $deplibs $compiler_flags $wl-soname $wl$soname -o $lib' - else - _LT_TAGVAR(ld_shlibs, $1)=no - fi - ;; - - cygwin* | mingw* | pw32* | cegcc*) - # _LT_TAGVAR(hardcode_libdir_flag_spec, $1) is actually meaningless, - # as there is no search path for DLLs. - _LT_TAGVAR(hardcode_libdir_flag_spec, $1)='-L$libdir' - _LT_TAGVAR(export_dynamic_flag_spec, $1)='$wl--export-all-symbols' - _LT_TAGVAR(allow_undefined_flag, $1)=unsupported - _LT_TAGVAR(always_export_symbols, $1)=no - _LT_TAGVAR(enable_shared_with_static_runtimes, $1)=yes - _LT_TAGVAR(export_symbols_cmds, $1)='$NM $libobjs $convenience | $global_symbol_pipe | $SED -e '\''/^[[BCDGRS]][[ ]]/s/.*[[ ]]\([[^ ]]*\)/\1 DATA/;s/^.*[[ ]]__nm__\([[^ ]]*\)[[ ]][[^ ]]*/\1 DATA/;/^I[[ ]]/d;/^[[AITW]][[ ]]/s/.* //'\'' | sort | uniq > $export_symbols' - _LT_TAGVAR(exclude_expsyms, $1)=['[_]+GLOBAL_OFFSET_TABLE_|[_]+GLOBAL__[FID]_.*|[_]+head_[A-Za-z0-9_]+_dll|[A-Za-z0-9_]+_dll_iname'] - - if $LD --help 2>&1 | $GREP 'auto-import' > /dev/null; then - _LT_TAGVAR(archive_cmds, $1)='$CC -shared $libobjs $deplibs $compiler_flags -o $output_objdir/$soname $wl--enable-auto-image-base -Xlinker --out-implib -Xlinker $lib' - # If the export-symbols file already is a .def file, use it as - # is; otherwise, prepend EXPORTS... - _LT_TAGVAR(archive_expsym_cmds, $1)='if _LT_DLL_DEF_P([$export_symbols]); then - cp $export_symbols $output_objdir/$soname.def; - else - echo EXPORTS > $output_objdir/$soname.def; - cat $export_symbols >> $output_objdir/$soname.def; - fi~ - $CC -shared $output_objdir/$soname.def $libobjs $deplibs $compiler_flags -o $output_objdir/$soname $wl--enable-auto-image-base -Xlinker --out-implib -Xlinker $lib' - else - _LT_TAGVAR(ld_shlibs, $1)=no - fi - ;; - - haiku*) - _LT_TAGVAR(archive_cmds, $1)='$CC -shared $libobjs $deplibs $compiler_flags $wl-soname $wl$soname -o $lib' - _LT_TAGVAR(link_all_deplibs, $1)=yes - ;; - - os2*) - _LT_TAGVAR(hardcode_libdir_flag_spec, $1)='-L$libdir' - _LT_TAGVAR(hardcode_minus_L, $1)=yes - _LT_TAGVAR(allow_undefined_flag, $1)=unsupported - shrext_cmds=.dll - _LT_TAGVAR(archive_cmds, $1)='$ECHO "LIBRARY ${soname%$shared_ext} INITINSTANCE TERMINSTANCE" > $output_objdir/$libname.def~ - $ECHO "DESCRIPTION \"$libname\"" >> $output_objdir/$libname.def~ - $ECHO "DATA MULTIPLE NONSHARED" >> $output_objdir/$libname.def~ - $ECHO EXPORTS >> $output_objdir/$libname.def~ - emxexp $libobjs | $SED /"_DLL_InitTerm"/d >> $output_objdir/$libname.def~ - $CC -Zdll -Zcrtdll -o $output_objdir/$soname $libobjs $deplibs $compiler_flags $output_objdir/$libname.def~ - emximp -o $lib $output_objdir/$libname.def' - _LT_TAGVAR(archive_expsym_cmds, $1)='$ECHO "LIBRARY ${soname%$shared_ext} INITINSTANCE TERMINSTANCE" > $output_objdir/$libname.def~ - $ECHO "DESCRIPTION \"$libname\"" >> $output_objdir/$libname.def~ - $ECHO "DATA MULTIPLE NONSHARED" >> $output_objdir/$libname.def~ - $ECHO EXPORTS >> $output_objdir/$libname.def~ - prefix_cmds="$SED"~ - if test EXPORTS = "`$SED 1q $export_symbols`"; then - prefix_cmds="$prefix_cmds -e 1d"; - fi~ - prefix_cmds="$prefix_cmds -e \"s/^\(.*\)$/_\1/g\""~ - cat $export_symbols | $prefix_cmds >> $output_objdir/$libname.def~ - $CC -Zdll -Zcrtdll -o $output_objdir/$soname $libobjs $deplibs $compiler_flags $output_objdir/$libname.def~ - emximp -o $lib $output_objdir/$libname.def' - _LT_TAGVAR(old_archive_From_new_cmds, $1)='emximp -o $output_objdir/${libname}_dll.a $output_objdir/$libname.def' - _LT_TAGVAR(enable_shared_with_static_runtimes, $1)=yes - ;; - - interix[[3-9]]*) - _LT_TAGVAR(hardcode_direct, $1)=no - _LT_TAGVAR(hardcode_shlibpath_var, $1)=no - _LT_TAGVAR(hardcode_libdir_flag_spec, $1)='$wl-rpath,$libdir' - _LT_TAGVAR(export_dynamic_flag_spec, $1)='$wl-E' - # Hack: On Interix 3.x, we cannot compile PIC because of a broken gcc. - # Instead, shared libraries are loaded at an image base (0x10000000 by - # default) and relocated if they conflict, which is a slow very memory - # consuming and fragmenting process. To avoid this, we pick a random, - # 256 KiB-aligned image base between 0x50000000 and 0x6FFC0000 at link - # time. Moving up from 0x10000000 also allows more sbrk(2) space. - _LT_TAGVAR(archive_cmds, $1)='$CC -shared $pic_flag $libobjs $deplibs $compiler_flags $wl-h,$soname $wl--image-base,`expr ${RANDOM-$$} % 4096 / 2 \* 262144 + 1342177280` -o $lib' - _LT_TAGVAR(archive_expsym_cmds, $1)='sed "s|^|_|" $export_symbols >$output_objdir/$soname.expsym~$CC -shared $pic_flag $libobjs $deplibs $compiler_flags $wl-h,$soname $wl--retain-symbols-file,$output_objdir/$soname.expsym $wl--image-base,`expr ${RANDOM-$$} % 4096 / 2 \* 262144 + 1342177280` -o $lib' - ;; - - gnu* | linux* | tpf* | k*bsd*-gnu | kopensolaris*-gnu) - tmp_diet=no - if test linux-dietlibc = "$host_os"; then - case $cc_basename in - diet\ *) tmp_diet=yes;; # linux-dietlibc with static linking (!diet-dyn) - esac - fi - if $LD --help 2>&1 | $EGREP ': supported targets:.* elf' > /dev/null \ - && test no = "$tmp_diet" - then - tmp_addflag=' $pic_flag' - tmp_sharedflag='-shared' - case $cc_basename,$host_cpu in - pgcc*) # Portland Group C compiler - _LT_TAGVAR(whole_archive_flag_spec, $1)='$wl--whole-archive`for conv in $convenience\"\"; do test -n \"$conv\" && new_convenience=\"$new_convenience,$conv\"; done; func_echo_all \"$new_convenience\"` $wl--no-whole-archive' - tmp_addflag=' $pic_flag' - ;; - pgf77* | pgf90* | pgf95* | pgfortran*) - # Portland Group f77 and f90 compilers - _LT_TAGVAR(whole_archive_flag_spec, $1)='$wl--whole-archive`for conv in $convenience\"\"; do test -n \"$conv\" && new_convenience=\"$new_convenience,$conv\"; done; func_echo_all \"$new_convenience\"` $wl--no-whole-archive' - tmp_addflag=' $pic_flag -Mnomain' ;; - ecc*,ia64* | icc*,ia64*) # Intel C compiler on ia64 - tmp_addflag=' -i_dynamic' ;; - efc*,ia64* | ifort*,ia64*) # Intel Fortran compiler on ia64 - tmp_addflag=' -i_dynamic -nofor_main' ;; - ifc* | ifort*) # Intel Fortran compiler - tmp_addflag=' -nofor_main' ;; - lf95*) # Lahey Fortran 8.1 - _LT_TAGVAR(whole_archive_flag_spec, $1)= - tmp_sharedflag='--shared' ;; - nagfor*) # NAGFOR 5.3 - tmp_sharedflag='-Wl,-shared' ;; - xl[[cC]]* | bgxl[[cC]]* | mpixl[[cC]]*) # IBM XL C 8.0 on PPC (deal with xlf below) - tmp_sharedflag='-qmkshrobj' - tmp_addflag= ;; - nvcc*) # Cuda Compiler Driver 2.2 - _LT_TAGVAR(whole_archive_flag_spec, $1)='$wl--whole-archive`for conv in $convenience\"\"; do test -n \"$conv\" && new_convenience=\"$new_convenience,$conv\"; done; func_echo_all \"$new_convenience\"` $wl--no-whole-archive' - _LT_TAGVAR(compiler_needs_object, $1)=yes - ;; - esac - case `$CC -V 2>&1 | sed 5q` in - *Sun\ C*) # Sun C 5.9 - _LT_TAGVAR(whole_archive_flag_spec, $1)='$wl--whole-archive`new_convenience=; for conv in $convenience\"\"; do test -z \"$conv\" || new_convenience=\"$new_convenience,$conv\"; done; func_echo_all \"$new_convenience\"` $wl--no-whole-archive' - _LT_TAGVAR(compiler_needs_object, $1)=yes - tmp_sharedflag='-G' ;; - *Sun\ F*) # Sun Fortran 8.3 - tmp_sharedflag='-G' ;; - esac - _LT_TAGVAR(archive_cmds, $1)='$CC '"$tmp_sharedflag""$tmp_addflag"' $libobjs $deplibs $compiler_flags $wl-soname $wl$soname -o $lib' - - if test yes = "$supports_anon_versioning"; then - _LT_TAGVAR(archive_expsym_cmds, $1)='echo "{ global:" > $output_objdir/$libname.ver~ - cat $export_symbols | sed -e "s/\(.*\)/\1;/" >> $output_objdir/$libname.ver~ - echo "local: *; };" >> $output_objdir/$libname.ver~ - $CC '"$tmp_sharedflag""$tmp_addflag"' $libobjs $deplibs $compiler_flags $wl-soname $wl$soname $wl-version-script $wl$output_objdir/$libname.ver -o $lib' - fi - - case $cc_basename in - tcc*) - _LT_TAGVAR(export_dynamic_flag_spec, $1)='-rdynamic' - ;; - xlf* | bgf* | bgxlf* | mpixlf*) - # IBM XL Fortran 10.1 on PPC cannot create shared libs itself - _LT_TAGVAR(whole_archive_flag_spec, $1)='--whole-archive$convenience --no-whole-archive' - _LT_TAGVAR(hardcode_libdir_flag_spec, $1)='$wl-rpath $wl$libdir' - _LT_TAGVAR(archive_cmds, $1)='$LD -shared $libobjs $deplibs $linker_flags -soname $soname -o $lib' - if test yes = "$supports_anon_versioning"; then - _LT_TAGVAR(archive_expsym_cmds, $1)='echo "{ global:" > $output_objdir/$libname.ver~ - cat $export_symbols | sed -e "s/\(.*\)/\1;/" >> $output_objdir/$libname.ver~ - echo "local: *; };" >> $output_objdir/$libname.ver~ - $LD -shared $libobjs $deplibs $linker_flags -soname $soname -version-script $output_objdir/$libname.ver -o $lib' - fi - ;; - esac - else - _LT_TAGVAR(ld_shlibs, $1)=no - fi - ;; - - netbsd*) - if echo __ELF__ | $CC -E - | $GREP __ELF__ >/dev/null; then - _LT_TAGVAR(archive_cmds, $1)='$LD -Bshareable $libobjs $deplibs $linker_flags -o $lib' - wlarc= - else - _LT_TAGVAR(archive_cmds, $1)='$CC -shared $pic_flag $libobjs $deplibs $compiler_flags $wl-soname $wl$soname -o $lib' - _LT_TAGVAR(archive_expsym_cmds, $1)='$CC -shared $pic_flag $libobjs $deplibs $compiler_flags $wl-soname $wl$soname $wl-retain-symbols-file $wl$export_symbols -o $lib' - fi - ;; - - solaris*) - if $LD -v 2>&1 | $GREP 'BFD 2\.8' > /dev/null; then - _LT_TAGVAR(ld_shlibs, $1)=no - cat <<_LT_EOF 1>&2 - -*** Warning: The releases 2.8.* of the GNU linker cannot reliably -*** create shared libraries on Solaris systems. Therefore, libtool -*** is disabling shared libraries support. We urge you to upgrade GNU -*** binutils to release 2.9.1 or newer. Another option is to modify -*** your PATH or compiler configuration so that the native linker is -*** used, and then restart. - -_LT_EOF - elif $LD --help 2>&1 | $GREP ': supported targets:.* elf' > /dev/null; then - _LT_TAGVAR(archive_cmds, $1)='$CC -shared $pic_flag $libobjs $deplibs $compiler_flags $wl-soname $wl$soname -o $lib' - _LT_TAGVAR(archive_expsym_cmds, $1)='$CC -shared $pic_flag $libobjs $deplibs $compiler_flags $wl-soname $wl$soname $wl-retain-symbols-file $wl$export_symbols -o $lib' - else - _LT_TAGVAR(ld_shlibs, $1)=no - fi - ;; - - sysv5* | sco3.2v5* | sco5v6* | unixware* | OpenUNIX*) - case `$LD -v 2>&1` in - *\ [[01]].* | *\ 2.[[0-9]].* | *\ 2.1[[0-5]].*) - _LT_TAGVAR(ld_shlibs, $1)=no - cat <<_LT_EOF 1>&2 - -*** Warning: Releases of the GNU linker prior to 2.16.91.0.3 cannot -*** reliably create shared libraries on SCO systems. Therefore, libtool -*** is disabling shared libraries support. We urge you to upgrade GNU -*** binutils to release 2.16.91.0.3 or newer. Another option is to modify -*** your PATH or compiler configuration so that the native linker is -*** used, and then restart. - -_LT_EOF - ;; - *) - # For security reasons, it is highly recommended that you always - # use absolute paths for naming shared libraries, and exclude the - # DT_RUNPATH tag from executables and libraries. But doing so - # requires that you compile everything twice, which is a pain. - if $LD --help 2>&1 | $GREP ': supported targets:.* elf' > /dev/null; then - _LT_TAGVAR(hardcode_libdir_flag_spec, $1)='$wl-rpath $wl$libdir' - _LT_TAGVAR(archive_cmds, $1)='$CC -shared $libobjs $deplibs $compiler_flags $wl-soname $wl$soname -o $lib' - _LT_TAGVAR(archive_expsym_cmds, $1)='$CC -shared $libobjs $deplibs $compiler_flags $wl-soname $wl$soname $wl-retain-symbols-file $wl$export_symbols -o $lib' - else - _LT_TAGVAR(ld_shlibs, $1)=no - fi - ;; - esac - ;; - - sunos4*) - _LT_TAGVAR(archive_cmds, $1)='$LD -assert pure-text -Bshareable -o $lib $libobjs $deplibs $linker_flags' - wlarc= - _LT_TAGVAR(hardcode_direct, $1)=yes - _LT_TAGVAR(hardcode_shlibpath_var, $1)=no - ;; - - *) - if $LD --help 2>&1 | $GREP ': supported targets:.* elf' > /dev/null; then - _LT_TAGVAR(archive_cmds, $1)='$CC -shared $pic_flag $libobjs $deplibs $compiler_flags $wl-soname $wl$soname -o $lib' - _LT_TAGVAR(archive_expsym_cmds, $1)='$CC -shared $pic_flag $libobjs $deplibs $compiler_flags $wl-soname $wl$soname $wl-retain-symbols-file $wl$export_symbols -o $lib' - else - _LT_TAGVAR(ld_shlibs, $1)=no - fi - ;; - esac - - if test no = "$_LT_TAGVAR(ld_shlibs, $1)"; then - runpath_var= - _LT_TAGVAR(hardcode_libdir_flag_spec, $1)= - _LT_TAGVAR(export_dynamic_flag_spec, $1)= - _LT_TAGVAR(whole_archive_flag_spec, $1)= - fi - else - # PORTME fill in a description of your system's linker (not GNU ld) - case $host_os in - aix3*) - _LT_TAGVAR(allow_undefined_flag, $1)=unsupported - _LT_TAGVAR(always_export_symbols, $1)=yes - _LT_TAGVAR(archive_expsym_cmds, $1)='$LD -o $output_objdir/$soname $libobjs $deplibs $linker_flags -bE:$export_symbols -T512 -H512 -bM:SRE~$AR $AR_FLAGS $lib $output_objdir/$soname' - # Note: this linker hardcodes the directories in LIBPATH if there - # are no directories specified by -L. - _LT_TAGVAR(hardcode_minus_L, $1)=yes - if test yes = "$GCC" && test -z "$lt_prog_compiler_static"; then - # Neither direct hardcoding nor static linking is supported with a - # broken collect2. - _LT_TAGVAR(hardcode_direct, $1)=unsupported - fi - ;; - - aix[[4-9]]*) - if test ia64 = "$host_cpu"; then - # On IA64, the linker does run time linking by default, so we don't - # have to do anything special. - aix_use_runtimelinking=no - exp_sym_flag='-Bexport' - no_entry_flag= - else - # If we're using GNU nm, then we don't want the "-C" option. - # -C means demangle to GNU nm, but means don't demangle to AIX nm. - # Without the "-l" option, or with the "-B" option, AIX nm treats - # weak defined symbols like other global defined symbols, whereas - # GNU nm marks them as "W". - # While the 'weak' keyword is ignored in the Export File, we need - # it in the Import File for the 'aix-soname' feature, so we have - # to replace the "-B" option with "-P" for AIX nm. - if $NM -V 2>&1 | $GREP 'GNU' > /dev/null; then - _LT_TAGVAR(export_symbols_cmds, $1)='$NM -Bpg $libobjs $convenience | awk '\''{ if (((\$ 2 == "T") || (\$ 2 == "D") || (\$ 2 == "B") || (\$ 2 == "W")) && ([substr](\$ 3,1,1) != ".")) { if (\$ 2 == "W") { print \$ 3 " weak" } else { print \$ 3 } } }'\'' | sort -u > $export_symbols' - else - _LT_TAGVAR(export_symbols_cmds, $1)='`func_echo_all $NM | $SED -e '\''s/B\([[^B]]*\)$/P\1/'\''` -PCpgl $libobjs $convenience | awk '\''{ if (((\$ 2 == "T") || (\$ 2 == "D") || (\$ 2 == "B") || (\$ 2 == "W") || (\$ 2 == "V") || (\$ 2 == "Z")) && ([substr](\$ 1,1,1) != ".")) { if ((\$ 2 == "W") || (\$ 2 == "V") || (\$ 2 == "Z")) { print \$ 1 " weak" } else { print \$ 1 } } }'\'' | sort -u > $export_symbols' - fi - aix_use_runtimelinking=no - - # Test if we are trying to use run time linking or normal - # AIX style linking. If -brtl is somewhere in LDFLAGS, we - # have runtime linking enabled, and use it for executables. - # For shared libraries, we enable/disable runtime linking - # depending on the kind of the shared library created - - # when "with_aix_soname,aix_use_runtimelinking" is: - # "aix,no" lib.a(lib.so.V) shared, rtl:no, for executables - # "aix,yes" lib.so shared, rtl:yes, for executables - # lib.a static archive - # "both,no" lib.so.V(shr.o) shared, rtl:yes - # lib.a(lib.so.V) shared, rtl:no, for executables - # "both,yes" lib.so.V(shr.o) shared, rtl:yes, for executables - # lib.a(lib.so.V) shared, rtl:no - # "svr4,*" lib.so.V(shr.o) shared, rtl:yes, for executables - # lib.a static archive - case $host_os in aix4.[[23]]|aix4.[[23]].*|aix[[5-9]]*) - for ld_flag in $LDFLAGS; do - if (test x-brtl = "x$ld_flag" || test x-Wl,-brtl = "x$ld_flag"); then - aix_use_runtimelinking=yes - break - fi - done - if test svr4,no = "$with_aix_soname,$aix_use_runtimelinking"; then - # With aix-soname=svr4, we create the lib.so.V shared archives only, - # so we don't have lib.a shared libs to link our executables. - # We have to force runtime linking in this case. - aix_use_runtimelinking=yes - LDFLAGS="$LDFLAGS -Wl,-brtl" - fi - ;; - esac - - exp_sym_flag='-bexport' - no_entry_flag='-bnoentry' - fi - - # When large executables or shared objects are built, AIX ld can - # have problems creating the table of contents. If linking a library - # or program results in "error TOC overflow" add -mminimal-toc to - # CXXFLAGS/CFLAGS for g++/gcc. In the cases where that is not - # enough to fix the problem, add -Wl,-bbigtoc to LDFLAGS. - - _LT_TAGVAR(archive_cmds, $1)='' - _LT_TAGVAR(hardcode_direct, $1)=yes - _LT_TAGVAR(hardcode_direct_absolute, $1)=yes - _LT_TAGVAR(hardcode_libdir_separator, $1)=':' - _LT_TAGVAR(link_all_deplibs, $1)=yes - _LT_TAGVAR(file_list_spec, $1)='$wl-f,' - case $with_aix_soname,$aix_use_runtimelinking in - aix,*) ;; # traditional, no import file - svr4,* | *,yes) # use import file - # The Import File defines what to hardcode. - _LT_TAGVAR(hardcode_direct, $1)=no - _LT_TAGVAR(hardcode_direct_absolute, $1)=no - ;; - esac - - if test yes = "$GCC"; then - case $host_os in aix4.[[012]]|aix4.[[012]].*) - # We only want to do this on AIX 4.2 and lower, the check - # below for broken collect2 doesn't work under 4.3+ - collect2name=`$CC -print-prog-name=collect2` - if test -f "$collect2name" && - strings "$collect2name" | $GREP resolve_lib_name >/dev/null - then - # We have reworked collect2 - : - else - # We have old collect2 - _LT_TAGVAR(hardcode_direct, $1)=unsupported - # It fails to find uninstalled libraries when the uninstalled - # path is not listed in the libpath. Setting hardcode_minus_L - # to unsupported forces relinking - _LT_TAGVAR(hardcode_minus_L, $1)=yes - _LT_TAGVAR(hardcode_libdir_flag_spec, $1)='-L$libdir' - _LT_TAGVAR(hardcode_libdir_separator, $1)= - fi - ;; - esac - shared_flag='-shared' - if test yes = "$aix_use_runtimelinking"; then - shared_flag="$shared_flag "'$wl-G' - fi - # Need to ensure runtime linking is disabled for the traditional - # shared library, or the linker may eventually find shared libraries - # /with/ Import File - we do not want to mix them. - shared_flag_aix='-shared' - shared_flag_svr4='-shared $wl-G' - else - # not using gcc - if test ia64 = "$host_cpu"; then - # VisualAge C++, Version 5.5 for AIX 5L for IA-64, Beta 3 Release - # chokes on -Wl,-G. The following line is correct: - shared_flag='-G' - else - if test yes = "$aix_use_runtimelinking"; then - shared_flag='$wl-G' - else - shared_flag='$wl-bM:SRE' - fi - shared_flag_aix='$wl-bM:SRE' - shared_flag_svr4='$wl-G' - fi - fi - - _LT_TAGVAR(export_dynamic_flag_spec, $1)='$wl-bexpall' - # It seems that -bexpall does not export symbols beginning with - # underscore (_), so it is better to generate a list of symbols to export. - _LT_TAGVAR(always_export_symbols, $1)=yes - if test aix,yes = "$with_aix_soname,$aix_use_runtimelinking"; then - # Warning - without using the other runtime loading flags (-brtl), - # -berok will link without error, but may produce a broken library. - _LT_TAGVAR(allow_undefined_flag, $1)='-berok' - # Determine the default libpath from the value encoded in an - # empty executable. - _LT_SYS_MODULE_PATH_AIX([$1]) - _LT_TAGVAR(hardcode_libdir_flag_spec, $1)='$wl-blibpath:$libdir:'"$aix_libpath" - _LT_TAGVAR(archive_expsym_cmds, $1)='$CC -o $output_objdir/$soname $libobjs $deplibs $wl'$no_entry_flag' $compiler_flags `if test -n "$allow_undefined_flag"; then func_echo_all "$wl$allow_undefined_flag"; else :; fi` $wl'$exp_sym_flag:\$export_symbols' '$shared_flag - else - if test ia64 = "$host_cpu"; then - _LT_TAGVAR(hardcode_libdir_flag_spec, $1)='$wl-R $libdir:/usr/lib:/lib' - _LT_TAGVAR(allow_undefined_flag, $1)="-z nodefs" - _LT_TAGVAR(archive_expsym_cmds, $1)="\$CC $shared_flag"' -o $output_objdir/$soname $libobjs $deplibs '"\$wl$no_entry_flag"' $compiler_flags $wl$allow_undefined_flag '"\$wl$exp_sym_flag:\$export_symbols" - else - # Determine the default libpath from the value encoded in an - # empty executable. - _LT_SYS_MODULE_PATH_AIX([$1]) - _LT_TAGVAR(hardcode_libdir_flag_spec, $1)='$wl-blibpath:$libdir:'"$aix_libpath" - # Warning - without using the other run time loading flags, - # -berok will link without error, but may produce a broken library. - _LT_TAGVAR(no_undefined_flag, $1)=' $wl-bernotok' - _LT_TAGVAR(allow_undefined_flag, $1)=' $wl-berok' - if test yes = "$with_gnu_ld"; then - # We only use this code for GNU lds that support --whole-archive. - _LT_TAGVAR(whole_archive_flag_spec, $1)='$wl--whole-archive$convenience $wl--no-whole-archive' - else - # Exported symbols can be pulled into shared objects from archives - _LT_TAGVAR(whole_archive_flag_spec, $1)='$convenience' - fi - _LT_TAGVAR(archive_cmds_need_lc, $1)=yes - _LT_TAGVAR(archive_expsym_cmds, $1)='$RM -r $output_objdir/$realname.d~$MKDIR $output_objdir/$realname.d' - # -brtl affects multiple linker settings, -berok does not and is overridden later - compiler_flags_filtered='`func_echo_all "$compiler_flags " | $SED -e "s%-brtl\\([[, ]]\\)%-berok\\1%g"`' - if test svr4 != "$with_aix_soname"; then - # This is similar to how AIX traditionally builds its shared libraries. - _LT_TAGVAR(archive_expsym_cmds, $1)="$_LT_TAGVAR(archive_expsym_cmds, $1)"'~$CC '$shared_flag_aix' -o $output_objdir/$realname.d/$soname $libobjs $deplibs $wl-bnoentry '$compiler_flags_filtered'$wl-bE:$export_symbols$allow_undefined_flag~$AR $AR_FLAGS $output_objdir/$libname$release.a $output_objdir/$realname.d/$soname' - fi - if test aix != "$with_aix_soname"; then - _LT_TAGVAR(archive_expsym_cmds, $1)="$_LT_TAGVAR(archive_expsym_cmds, $1)"'~$CC '$shared_flag_svr4' -o $output_objdir/$realname.d/$shared_archive_member_spec.o $libobjs $deplibs $wl-bnoentry '$compiler_flags_filtered'$wl-bE:$export_symbols$allow_undefined_flag~$STRIP -e $output_objdir/$realname.d/$shared_archive_member_spec.o~( func_echo_all "#! $soname($shared_archive_member_spec.o)"; if test shr_64 = "$shared_archive_member_spec"; then func_echo_all "# 64"; else func_echo_all "# 32"; fi; cat $export_symbols ) > $output_objdir/$realname.d/$shared_archive_member_spec.imp~$AR $AR_FLAGS $output_objdir/$soname $output_objdir/$realname.d/$shared_archive_member_spec.o $output_objdir/$realname.d/$shared_archive_member_spec.imp' - else - # used by -dlpreopen to get the symbols - _LT_TAGVAR(archive_expsym_cmds, $1)="$_LT_TAGVAR(archive_expsym_cmds, $1)"'~$MV $output_objdir/$realname.d/$soname $output_objdir' - fi - _LT_TAGVAR(archive_expsym_cmds, $1)="$_LT_TAGVAR(archive_expsym_cmds, $1)"'~$RM -r $output_objdir/$realname.d' - fi - fi - ;; - - amigaos*) - case $host_cpu in - powerpc) - # see comment about AmigaOS4 .so support - _LT_TAGVAR(archive_cmds, $1)='$CC -shared $libobjs $deplibs $compiler_flags $wl-soname $wl$soname -o $lib' - _LT_TAGVAR(archive_expsym_cmds, $1)='' - ;; - m68k) - _LT_TAGVAR(archive_cmds, $1)='$RM $output_objdir/a2ixlibrary.data~$ECHO "#define NAME $libname" > $output_objdir/a2ixlibrary.data~$ECHO "#define LIBRARY_ID 1" >> $output_objdir/a2ixlibrary.data~$ECHO "#define VERSION $major" >> $output_objdir/a2ixlibrary.data~$ECHO "#define REVISION $revision" >> $output_objdir/a2ixlibrary.data~$AR $AR_FLAGS $lib $libobjs~$RANLIB $lib~(cd $output_objdir && a2ixlibrary -32)' - _LT_TAGVAR(hardcode_libdir_flag_spec, $1)='-L$libdir' - _LT_TAGVAR(hardcode_minus_L, $1)=yes - ;; - esac - ;; - - bsdi[[45]]*) - _LT_TAGVAR(export_dynamic_flag_spec, $1)=-rdynamic - ;; - - cygwin* | mingw* | pw32* | cegcc*) - # When not using gcc, we currently assume that we are using - # Microsoft Visual C++. - # hardcode_libdir_flag_spec is actually meaningless, as there is - # no search path for DLLs. - case $cc_basename in - cl*) - # Native MSVC - _LT_TAGVAR(hardcode_libdir_flag_spec, $1)=' ' - _LT_TAGVAR(allow_undefined_flag, $1)=unsupported - _LT_TAGVAR(always_export_symbols, $1)=yes - _LT_TAGVAR(file_list_spec, $1)='@' - # Tell ltmain to make .lib files, not .a files. - libext=lib - # Tell ltmain to make .dll files, not .so files. - shrext_cmds=.dll - # FIXME: Setting linknames here is a bad hack. - _LT_TAGVAR(archive_cmds, $1)='$CC -o $output_objdir/$soname $libobjs $compiler_flags $deplibs -Wl,-DLL,-IMPLIB:"$tool_output_objdir$libname.dll.lib"~linknames=' - _LT_TAGVAR(archive_expsym_cmds, $1)='if _LT_DLL_DEF_P([$export_symbols]); then - cp "$export_symbols" "$output_objdir/$soname.def"; - echo "$tool_output_objdir$soname.def" > "$output_objdir/$soname.exp"; - else - $SED -e '\''s/^/-link -EXPORT:/'\'' < $export_symbols > $output_objdir/$soname.exp; - fi~ - $CC -o $tool_output_objdir$soname $libobjs $compiler_flags $deplibs "@$tool_output_objdir$soname.exp" -Wl,-DLL,-IMPLIB:"$tool_output_objdir$libname.dll.lib"~ - linknames=' - # The linker will not automatically build a static lib if we build a DLL. - # _LT_TAGVAR(old_archive_from_new_cmds, $1)='true' - _LT_TAGVAR(enable_shared_with_static_runtimes, $1)=yes - _LT_TAGVAR(exclude_expsyms, $1)='_NULL_IMPORT_DESCRIPTOR|_IMPORT_DESCRIPTOR_.*' - _LT_TAGVAR(export_symbols_cmds, $1)='$NM $libobjs $convenience | $global_symbol_pipe | $SED -e '\''/^[[BCDGRS]][[ ]]/s/.*[[ ]]\([[^ ]]*\)/\1,DATA/'\'' | $SED -e '\''/^[[AITW]][[ ]]/s/.*[[ ]]//'\'' | sort | uniq > $export_symbols' - # Don't use ranlib - _LT_TAGVAR(old_postinstall_cmds, $1)='chmod 644 $oldlib' - _LT_TAGVAR(postlink_cmds, $1)='lt_outputfile="@OUTPUT@"~ - lt_tool_outputfile="@TOOL_OUTPUT@"~ - case $lt_outputfile in - *.exe|*.EXE) ;; - *) - lt_outputfile=$lt_outputfile.exe - lt_tool_outputfile=$lt_tool_outputfile.exe - ;; - esac~ - if test : != "$MANIFEST_TOOL" && test -f "$lt_outputfile.manifest"; then - $MANIFEST_TOOL -manifest "$lt_tool_outputfile.manifest" -outputresource:"$lt_tool_outputfile" || exit 1; - $RM "$lt_outputfile.manifest"; - fi' - ;; - *) - # Assume MSVC wrapper - _LT_TAGVAR(hardcode_libdir_flag_spec, $1)=' ' - _LT_TAGVAR(allow_undefined_flag, $1)=unsupported - # Tell ltmain to make .lib files, not .a files. - libext=lib - # Tell ltmain to make .dll files, not .so files. - shrext_cmds=.dll - # FIXME: Setting linknames here is a bad hack. - _LT_TAGVAR(archive_cmds, $1)='$CC -o $lib $libobjs $compiler_flags `func_echo_all "$deplibs" | $SED '\''s/ -lc$//'\''` -link -dll~linknames=' - # The linker will automatically build a .lib file if we build a DLL. - _LT_TAGVAR(old_archive_from_new_cmds, $1)='true' - # FIXME: Should let the user specify the lib program. - _LT_TAGVAR(old_archive_cmds, $1)='lib -OUT:$oldlib$oldobjs$old_deplibs' - _LT_TAGVAR(enable_shared_with_static_runtimes, $1)=yes - ;; - esac - ;; - - darwin* | rhapsody*) - _LT_DARWIN_LINKER_FEATURES($1) - ;; - - dgux*) - _LT_TAGVAR(archive_cmds, $1)='$LD -G -h $soname -o $lib $libobjs $deplibs $linker_flags' - _LT_TAGVAR(hardcode_libdir_flag_spec, $1)='-L$libdir' - _LT_TAGVAR(hardcode_shlibpath_var, $1)=no - ;; - - # FreeBSD 2.2.[012] allows us to include c++rt0.o to get C++ constructor - # support. Future versions do this automatically, but an explicit c++rt0.o - # does not break anything, and helps significantly (at the cost of a little - # extra space). - freebsd2.2*) - _LT_TAGVAR(archive_cmds, $1)='$LD -Bshareable -o $lib $libobjs $deplibs $linker_flags /usr/lib/c++rt0.o' - _LT_TAGVAR(hardcode_libdir_flag_spec, $1)='-R$libdir' - _LT_TAGVAR(hardcode_direct, $1)=yes - _LT_TAGVAR(hardcode_shlibpath_var, $1)=no - ;; - - # Unfortunately, older versions of FreeBSD 2 do not have this feature. - freebsd2.*) - _LT_TAGVAR(archive_cmds, $1)='$LD -Bshareable -o $lib $libobjs $deplibs $linker_flags' - _LT_TAGVAR(hardcode_direct, $1)=yes - _LT_TAGVAR(hardcode_minus_L, $1)=yes - _LT_TAGVAR(hardcode_shlibpath_var, $1)=no - ;; - - # FreeBSD 3 and greater uses gcc -shared to do shared libraries. - freebsd* | dragonfly*) - _LT_TAGVAR(archive_cmds, $1)='$CC -shared $pic_flag -o $lib $libobjs $deplibs $compiler_flags' - _LT_TAGVAR(hardcode_libdir_flag_spec, $1)='-R$libdir' - _LT_TAGVAR(hardcode_direct, $1)=yes - _LT_TAGVAR(hardcode_shlibpath_var, $1)=no - ;; - - hpux9*) - if test yes = "$GCC"; then - _LT_TAGVAR(archive_cmds, $1)='$RM $output_objdir/$soname~$CC -shared $pic_flag $wl+b $wl$install_libdir -o $output_objdir/$soname $libobjs $deplibs $compiler_flags~test "x$output_objdir/$soname" = "x$lib" || mv $output_objdir/$soname $lib' - else - _LT_TAGVAR(archive_cmds, $1)='$RM $output_objdir/$soname~$LD -b +b $install_libdir -o $output_objdir/$soname $libobjs $deplibs $linker_flags~test "x$output_objdir/$soname" = "x$lib" || mv $output_objdir/$soname $lib' - fi - _LT_TAGVAR(hardcode_libdir_flag_spec, $1)='$wl+b $wl$libdir' - _LT_TAGVAR(hardcode_libdir_separator, $1)=: - _LT_TAGVAR(hardcode_direct, $1)=yes - - # hardcode_minus_L: Not really in the search PATH, - # but as the default location of the library. - _LT_TAGVAR(hardcode_minus_L, $1)=yes - _LT_TAGVAR(export_dynamic_flag_spec, $1)='$wl-E' - ;; - - hpux10*) - if test yes,no = "$GCC,$with_gnu_ld"; then - _LT_TAGVAR(archive_cmds, $1)='$CC -shared $pic_flag $wl+h $wl$soname $wl+b $wl$install_libdir -o $lib $libobjs $deplibs $compiler_flags' - else - _LT_TAGVAR(archive_cmds, $1)='$LD -b +h $soname +b $install_libdir -o $lib $libobjs $deplibs $linker_flags' - fi - if test no = "$with_gnu_ld"; then - _LT_TAGVAR(hardcode_libdir_flag_spec, $1)='$wl+b $wl$libdir' - _LT_TAGVAR(hardcode_libdir_separator, $1)=: - _LT_TAGVAR(hardcode_direct, $1)=yes - _LT_TAGVAR(hardcode_direct_absolute, $1)=yes - _LT_TAGVAR(export_dynamic_flag_spec, $1)='$wl-E' - # hardcode_minus_L: Not really in the search PATH, - # but as the default location of the library. - _LT_TAGVAR(hardcode_minus_L, $1)=yes - fi - ;; - - hpux11*) - if test yes,no = "$GCC,$with_gnu_ld"; then - case $host_cpu in - hppa*64*) - _LT_TAGVAR(archive_cmds, $1)='$CC -shared $wl+h $wl$soname -o $lib $libobjs $deplibs $compiler_flags' - ;; - ia64*) - _LT_TAGVAR(archive_cmds, $1)='$CC -shared $pic_flag $wl+h $wl$soname $wl+nodefaultrpath -o $lib $libobjs $deplibs $compiler_flags' - ;; - *) - _LT_TAGVAR(archive_cmds, $1)='$CC -shared $pic_flag $wl+h $wl$soname $wl+b $wl$install_libdir -o $lib $libobjs $deplibs $compiler_flags' - ;; - esac - else - case $host_cpu in - hppa*64*) - _LT_TAGVAR(archive_cmds, $1)='$CC -b $wl+h $wl$soname -o $lib $libobjs $deplibs $compiler_flags' - ;; - ia64*) - _LT_TAGVAR(archive_cmds, $1)='$CC -b $wl+h $wl$soname $wl+nodefaultrpath -o $lib $libobjs $deplibs $compiler_flags' - ;; - *) - m4_if($1, [], [ - # Older versions of the 11.00 compiler do not understand -b yet - # (HP92453-01 A.11.01.20 doesn't, HP92453-01 B.11.X.35175-35176.GP does) - _LT_LINKER_OPTION([if $CC understands -b], - _LT_TAGVAR(lt_cv_prog_compiler__b, $1), [-b], - [_LT_TAGVAR(archive_cmds, $1)='$CC -b $wl+h $wl$soname $wl+b $wl$install_libdir -o $lib $libobjs $deplibs $compiler_flags'], - [_LT_TAGVAR(archive_cmds, $1)='$LD -b +h $soname +b $install_libdir -o $lib $libobjs $deplibs $linker_flags'])], - [_LT_TAGVAR(archive_cmds, $1)='$CC -b $wl+h $wl$soname $wl+b $wl$install_libdir -o $lib $libobjs $deplibs $compiler_flags']) - ;; - esac - fi - if test no = "$with_gnu_ld"; then - _LT_TAGVAR(hardcode_libdir_flag_spec, $1)='$wl+b $wl$libdir' - _LT_TAGVAR(hardcode_libdir_separator, $1)=: - - case $host_cpu in - hppa*64*|ia64*) - _LT_TAGVAR(hardcode_direct, $1)=no - _LT_TAGVAR(hardcode_shlibpath_var, $1)=no - ;; - *) - _LT_TAGVAR(hardcode_direct, $1)=yes - _LT_TAGVAR(hardcode_direct_absolute, $1)=yes - _LT_TAGVAR(export_dynamic_flag_spec, $1)='$wl-E' - - # hardcode_minus_L: Not really in the search PATH, - # but as the default location of the library. - _LT_TAGVAR(hardcode_minus_L, $1)=yes - ;; - esac - fi - ;; - - irix5* | irix6* | nonstopux*) - if test yes = "$GCC"; then - _LT_TAGVAR(archive_cmds, $1)='$CC -shared $pic_flag $libobjs $deplibs $compiler_flags $wl-soname $wl$soname `test -n "$verstring" && func_echo_all "$wl-set_version $wl$verstring"` $wl-update_registry $wl$output_objdir/so_locations -o $lib' - # Try to use the -exported_symbol ld option, if it does not - # work, assume that -exports_file does not work either and - # implicitly export all symbols. - # This should be the same for all languages, so no per-tag cache variable. - AC_CACHE_CHECK([whether the $host_os linker accepts -exported_symbol], - [lt_cv_irix_exported_symbol], - [save_LDFLAGS=$LDFLAGS - LDFLAGS="$LDFLAGS -shared $wl-exported_symbol ${wl}foo $wl-update_registry $wl/dev/null" - AC_LINK_IFELSE( - [AC_LANG_SOURCE( - [AC_LANG_CASE([C], [[int foo (void) { return 0; }]], - [C++], [[int foo (void) { return 0; }]], - [Fortran 77], [[ - subroutine foo - end]], - [Fortran], [[ - subroutine foo - end]])])], - [lt_cv_irix_exported_symbol=yes], - [lt_cv_irix_exported_symbol=no]) - LDFLAGS=$save_LDFLAGS]) - if test yes = "$lt_cv_irix_exported_symbol"; then - _LT_TAGVAR(archive_expsym_cmds, $1)='$CC -shared $pic_flag $libobjs $deplibs $compiler_flags $wl-soname $wl$soname `test -n "$verstring" && func_echo_all "$wl-set_version $wl$verstring"` $wl-update_registry $wl$output_objdir/so_locations $wl-exports_file $wl$export_symbols -o $lib' - fi - else - _LT_TAGVAR(archive_cmds, $1)='$CC -shared $libobjs $deplibs $compiler_flags -soname $soname `test -n "$verstring" && func_echo_all "-set_version $verstring"` -update_registry $output_objdir/so_locations -o $lib' - _LT_TAGVAR(archive_expsym_cmds, $1)='$CC -shared $libobjs $deplibs $compiler_flags -soname $soname `test -n "$verstring" && func_echo_all "-set_version $verstring"` -update_registry $output_objdir/so_locations -exports_file $export_symbols -o $lib' - fi - _LT_TAGVAR(archive_cmds_need_lc, $1)='no' - _LT_TAGVAR(hardcode_libdir_flag_spec, $1)='$wl-rpath $wl$libdir' - _LT_TAGVAR(hardcode_libdir_separator, $1)=: - _LT_TAGVAR(inherit_rpath, $1)=yes - _LT_TAGVAR(link_all_deplibs, $1)=yes - ;; - - linux*) - case $cc_basename in - tcc*) - # Fabrice Bellard et al's Tiny C Compiler - _LT_TAGVAR(ld_shlibs, $1)=yes - _LT_TAGVAR(archive_cmds, $1)='$CC -shared $pic_flag -o $lib $libobjs $deplibs $compiler_flags' - ;; - esac - ;; - - netbsd*) - if echo __ELF__ | $CC -E - | $GREP __ELF__ >/dev/null; then - _LT_TAGVAR(archive_cmds, $1)='$LD -Bshareable -o $lib $libobjs $deplibs $linker_flags' # a.out - else - _LT_TAGVAR(archive_cmds, $1)='$LD -shared -o $lib $libobjs $deplibs $linker_flags' # ELF - fi - _LT_TAGVAR(hardcode_libdir_flag_spec, $1)='-R$libdir' - _LT_TAGVAR(hardcode_direct, $1)=yes - _LT_TAGVAR(hardcode_shlibpath_var, $1)=no - ;; - - newsos6) - _LT_TAGVAR(archive_cmds, $1)='$LD -G -h $soname -o $lib $libobjs $deplibs $linker_flags' - _LT_TAGVAR(hardcode_direct, $1)=yes - _LT_TAGVAR(hardcode_libdir_flag_spec, $1)='$wl-rpath $wl$libdir' - _LT_TAGVAR(hardcode_libdir_separator, $1)=: - _LT_TAGVAR(hardcode_shlibpath_var, $1)=no - ;; - - *nto* | *qnx*) - ;; - - openbsd* | bitrig*) - if test -f /usr/libexec/ld.so; then - _LT_TAGVAR(hardcode_direct, $1)=yes - _LT_TAGVAR(hardcode_shlibpath_var, $1)=no - _LT_TAGVAR(hardcode_direct_absolute, $1)=yes - if test -z "`echo __ELF__ | $CC -E - | $GREP __ELF__`"; then - _LT_TAGVAR(archive_cmds, $1)='$CC -shared $pic_flag -o $lib $libobjs $deplibs $compiler_flags' - _LT_TAGVAR(archive_expsym_cmds, $1)='$CC -shared $pic_flag -o $lib $libobjs $deplibs $compiler_flags $wl-retain-symbols-file,$export_symbols' - _LT_TAGVAR(hardcode_libdir_flag_spec, $1)='$wl-rpath,$libdir' - _LT_TAGVAR(export_dynamic_flag_spec, $1)='$wl-E' - else - _LT_TAGVAR(archive_cmds, $1)='$CC -shared $pic_flag -o $lib $libobjs $deplibs $compiler_flags' - _LT_TAGVAR(hardcode_libdir_flag_spec, $1)='$wl-rpath,$libdir' - fi - else - _LT_TAGVAR(ld_shlibs, $1)=no - fi - ;; - - os2*) - _LT_TAGVAR(hardcode_libdir_flag_spec, $1)='-L$libdir' - _LT_TAGVAR(hardcode_minus_L, $1)=yes - _LT_TAGVAR(allow_undefined_flag, $1)=unsupported - shrext_cmds=.dll - _LT_TAGVAR(archive_cmds, $1)='$ECHO "LIBRARY ${soname%$shared_ext} INITINSTANCE TERMINSTANCE" > $output_objdir/$libname.def~ - $ECHO "DESCRIPTION \"$libname\"" >> $output_objdir/$libname.def~ - $ECHO "DATA MULTIPLE NONSHARED" >> $output_objdir/$libname.def~ - $ECHO EXPORTS >> $output_objdir/$libname.def~ - emxexp $libobjs | $SED /"_DLL_InitTerm"/d >> $output_objdir/$libname.def~ - $CC -Zdll -Zcrtdll -o $output_objdir/$soname $libobjs $deplibs $compiler_flags $output_objdir/$libname.def~ - emximp -o $lib $output_objdir/$libname.def' - _LT_TAGVAR(archive_expsym_cmds, $1)='$ECHO "LIBRARY ${soname%$shared_ext} INITINSTANCE TERMINSTANCE" > $output_objdir/$libname.def~ - $ECHO "DESCRIPTION \"$libname\"" >> $output_objdir/$libname.def~ - $ECHO "DATA MULTIPLE NONSHARED" >> $output_objdir/$libname.def~ - $ECHO EXPORTS >> $output_objdir/$libname.def~ - prefix_cmds="$SED"~ - if test EXPORTS = "`$SED 1q $export_symbols`"; then - prefix_cmds="$prefix_cmds -e 1d"; - fi~ - prefix_cmds="$prefix_cmds -e \"s/^\(.*\)$/_\1/g\""~ - cat $export_symbols | $prefix_cmds >> $output_objdir/$libname.def~ - $CC -Zdll -Zcrtdll -o $output_objdir/$soname $libobjs $deplibs $compiler_flags $output_objdir/$libname.def~ - emximp -o $lib $output_objdir/$libname.def' - _LT_TAGVAR(old_archive_From_new_cmds, $1)='emximp -o $output_objdir/${libname}_dll.a $output_objdir/$libname.def' - _LT_TAGVAR(enable_shared_with_static_runtimes, $1)=yes - ;; - - osf3*) - if test yes = "$GCC"; then - _LT_TAGVAR(allow_undefined_flag, $1)=' $wl-expect_unresolved $wl\*' - _LT_TAGVAR(archive_cmds, $1)='$CC -shared$allow_undefined_flag $libobjs $deplibs $compiler_flags $wl-soname $wl$soname `test -n "$verstring" && func_echo_all "$wl-set_version $wl$verstring"` $wl-update_registry $wl$output_objdir/so_locations -o $lib' - else - _LT_TAGVAR(allow_undefined_flag, $1)=' -expect_unresolved \*' - _LT_TAGVAR(archive_cmds, $1)='$CC -shared$allow_undefined_flag $libobjs $deplibs $compiler_flags -soname $soname `test -n "$verstring" && func_echo_all "-set_version $verstring"` -update_registry $output_objdir/so_locations -o $lib' - fi - _LT_TAGVAR(archive_cmds_need_lc, $1)='no' - _LT_TAGVAR(hardcode_libdir_flag_spec, $1)='$wl-rpath $wl$libdir' - _LT_TAGVAR(hardcode_libdir_separator, $1)=: - ;; - - osf4* | osf5*) # as osf3* with the addition of -msym flag - if test yes = "$GCC"; then - _LT_TAGVAR(allow_undefined_flag, $1)=' $wl-expect_unresolved $wl\*' - _LT_TAGVAR(archive_cmds, $1)='$CC -shared$allow_undefined_flag $pic_flag $libobjs $deplibs $compiler_flags $wl-msym $wl-soname $wl$soname `test -n "$verstring" && func_echo_all "$wl-set_version $wl$verstring"` $wl-update_registry $wl$output_objdir/so_locations -o $lib' - _LT_TAGVAR(hardcode_libdir_flag_spec, $1)='$wl-rpath $wl$libdir' - else - _LT_TAGVAR(allow_undefined_flag, $1)=' -expect_unresolved \*' - _LT_TAGVAR(archive_cmds, $1)='$CC -shared$allow_undefined_flag $libobjs $deplibs $compiler_flags -msym -soname $soname `test -n "$verstring" && func_echo_all "-set_version $verstring"` -update_registry $output_objdir/so_locations -o $lib' - _LT_TAGVAR(archive_expsym_cmds, $1)='for i in `cat $export_symbols`; do printf "%s %s\\n" -exported_symbol "\$i" >> $lib.exp; done; printf "%s\\n" "-hidden">> $lib.exp~ - $CC -shared$allow_undefined_flag $wl-input $wl$lib.exp $compiler_flags $libobjs $deplibs -soname $soname `test -n "$verstring" && $ECHO "-set_version $verstring"` -update_registry $output_objdir/so_locations -o $lib~$RM $lib.exp' - - # Both c and cxx compiler support -rpath directly - _LT_TAGVAR(hardcode_libdir_flag_spec, $1)='-rpath $libdir' - fi - _LT_TAGVAR(archive_cmds_need_lc, $1)='no' - _LT_TAGVAR(hardcode_libdir_separator, $1)=: - ;; - - solaris*) - _LT_TAGVAR(no_undefined_flag, $1)=' -z defs' - if test yes = "$GCC"; then - wlarc='$wl' - _LT_TAGVAR(archive_cmds, $1)='$CC -shared $pic_flag $wl-z ${wl}text $wl-h $wl$soname -o $lib $libobjs $deplibs $compiler_flags' - _LT_TAGVAR(archive_expsym_cmds, $1)='echo "{ global:" > $lib.exp~cat $export_symbols | $SED -e "s/\(.*\)/\1;/" >> $lib.exp~echo "local: *; };" >> $lib.exp~ - $CC -shared $pic_flag $wl-z ${wl}text $wl-M $wl$lib.exp $wl-h $wl$soname -o $lib $libobjs $deplibs $compiler_flags~$RM $lib.exp' - else - case `$CC -V 2>&1` in - *"Compilers 5.0"*) - wlarc='' - _LT_TAGVAR(archive_cmds, $1)='$LD -G$allow_undefined_flag -h $soname -o $lib $libobjs $deplibs $linker_flags' - _LT_TAGVAR(archive_expsym_cmds, $1)='echo "{ global:" > $lib.exp~cat $export_symbols | $SED -e "s/\(.*\)/\1;/" >> $lib.exp~echo "local: *; };" >> $lib.exp~ - $LD -G$allow_undefined_flag -M $lib.exp -h $soname -o $lib $libobjs $deplibs $linker_flags~$RM $lib.exp' - ;; - *) - wlarc='$wl' - _LT_TAGVAR(archive_cmds, $1)='$CC -G$allow_undefined_flag -h $soname -o $lib $libobjs $deplibs $compiler_flags' - _LT_TAGVAR(archive_expsym_cmds, $1)='echo "{ global:" > $lib.exp~cat $export_symbols | $SED -e "s/\(.*\)/\1;/" >> $lib.exp~echo "local: *; };" >> $lib.exp~ - $CC -G$allow_undefined_flag -M $lib.exp -h $soname -o $lib $libobjs $deplibs $compiler_flags~$RM $lib.exp' - ;; - esac - fi - _LT_TAGVAR(hardcode_libdir_flag_spec, $1)='-R$libdir' - _LT_TAGVAR(hardcode_shlibpath_var, $1)=no - case $host_os in - solaris2.[[0-5]] | solaris2.[[0-5]].*) ;; - *) - # The compiler driver will combine and reorder linker options, - # but understands '-z linker_flag'. GCC discards it without '$wl', - # but is careful enough not to reorder. - # Supported since Solaris 2.6 (maybe 2.5.1?) - if test yes = "$GCC"; then - _LT_TAGVAR(whole_archive_flag_spec, $1)='$wl-z ${wl}allextract$convenience $wl-z ${wl}defaultextract' - else - _LT_TAGVAR(whole_archive_flag_spec, $1)='-z allextract$convenience -z defaultextract' - fi - ;; - esac - _LT_TAGVAR(link_all_deplibs, $1)=yes - ;; - - sunos4*) - if test sequent = "$host_vendor"; then - # Use $CC to link under sequent, because it throws in some extra .o - # files that make .init and .fini sections work. - _LT_TAGVAR(archive_cmds, $1)='$CC -G $wl-h $soname -o $lib $libobjs $deplibs $compiler_flags' - else - _LT_TAGVAR(archive_cmds, $1)='$LD -assert pure-text -Bstatic -o $lib $libobjs $deplibs $linker_flags' - fi - _LT_TAGVAR(hardcode_libdir_flag_spec, $1)='-L$libdir' - _LT_TAGVAR(hardcode_direct, $1)=yes - _LT_TAGVAR(hardcode_minus_L, $1)=yes - _LT_TAGVAR(hardcode_shlibpath_var, $1)=no - ;; - - sysv4) - case $host_vendor in - sni) - _LT_TAGVAR(archive_cmds, $1)='$LD -G -h $soname -o $lib $libobjs $deplibs $linker_flags' - _LT_TAGVAR(hardcode_direct, $1)=yes # is this really true??? - ;; - siemens) - ## LD is ld it makes a PLAMLIB - ## CC just makes a GrossModule. - _LT_TAGVAR(archive_cmds, $1)='$LD -G -o $lib $libobjs $deplibs $linker_flags' - _LT_TAGVAR(reload_cmds, $1)='$CC -r -o $output$reload_objs' - _LT_TAGVAR(hardcode_direct, $1)=no - ;; - motorola) - _LT_TAGVAR(archive_cmds, $1)='$LD -G -h $soname -o $lib $libobjs $deplibs $linker_flags' - _LT_TAGVAR(hardcode_direct, $1)=no #Motorola manual says yes, but my tests say they lie - ;; - esac - runpath_var='LD_RUN_PATH' - _LT_TAGVAR(hardcode_shlibpath_var, $1)=no - ;; - - sysv4.3*) - _LT_TAGVAR(archive_cmds, $1)='$LD -G -h $soname -o $lib $libobjs $deplibs $linker_flags' - _LT_TAGVAR(hardcode_shlibpath_var, $1)=no - _LT_TAGVAR(export_dynamic_flag_spec, $1)='-Bexport' - ;; - - sysv4*MP*) - if test -d /usr/nec; then - _LT_TAGVAR(archive_cmds, $1)='$LD -G -h $soname -o $lib $libobjs $deplibs $linker_flags' - _LT_TAGVAR(hardcode_shlibpath_var, $1)=no - runpath_var=LD_RUN_PATH - hardcode_runpath_var=yes - _LT_TAGVAR(ld_shlibs, $1)=yes - fi - ;; - - sysv4*uw2* | sysv5OpenUNIX* | sysv5UnixWare7.[[01]].[[10]]* | unixware7* | sco3.2v5.0.[[024]]*) - _LT_TAGVAR(no_undefined_flag, $1)='$wl-z,text' - _LT_TAGVAR(archive_cmds_need_lc, $1)=no - _LT_TAGVAR(hardcode_shlibpath_var, $1)=no - runpath_var='LD_RUN_PATH' - - if test yes = "$GCC"; then - _LT_TAGVAR(archive_cmds, $1)='$CC -shared $wl-h,$soname -o $lib $libobjs $deplibs $compiler_flags' - _LT_TAGVAR(archive_expsym_cmds, $1)='$CC -shared $wl-Bexport:$export_symbols $wl-h,$soname -o $lib $libobjs $deplibs $compiler_flags' - else - _LT_TAGVAR(archive_cmds, $1)='$CC -G $wl-h,$soname -o $lib $libobjs $deplibs $compiler_flags' - _LT_TAGVAR(archive_expsym_cmds, $1)='$CC -G $wl-Bexport:$export_symbols $wl-h,$soname -o $lib $libobjs $deplibs $compiler_flags' - fi - ;; - - sysv5* | sco3.2v5* | sco5v6*) - # Note: We CANNOT use -z defs as we might desire, because we do not - # link with -lc, and that would cause any symbols used from libc to - # always be unresolved, which means just about no library would - # ever link correctly. If we're not using GNU ld we use -z text - # though, which does catch some bad symbols but isn't as heavy-handed - # as -z defs. - _LT_TAGVAR(no_undefined_flag, $1)='$wl-z,text' - _LT_TAGVAR(allow_undefined_flag, $1)='$wl-z,nodefs' - _LT_TAGVAR(archive_cmds_need_lc, $1)=no - _LT_TAGVAR(hardcode_shlibpath_var, $1)=no - _LT_TAGVAR(hardcode_libdir_flag_spec, $1)='$wl-R,$libdir' - _LT_TAGVAR(hardcode_libdir_separator, $1)=':' - _LT_TAGVAR(link_all_deplibs, $1)=yes - _LT_TAGVAR(export_dynamic_flag_spec, $1)='$wl-Bexport' - runpath_var='LD_RUN_PATH' - - if test yes = "$GCC"; then - _LT_TAGVAR(archive_cmds, $1)='$CC -shared $wl-h,$soname -o $lib $libobjs $deplibs $compiler_flags' - _LT_TAGVAR(archive_expsym_cmds, $1)='$CC -shared $wl-Bexport:$export_symbols $wl-h,$soname -o $lib $libobjs $deplibs $compiler_flags' - else - _LT_TAGVAR(archive_cmds, $1)='$CC -G $wl-h,$soname -o $lib $libobjs $deplibs $compiler_flags' - _LT_TAGVAR(archive_expsym_cmds, $1)='$CC -G $wl-Bexport:$export_symbols $wl-h,$soname -o $lib $libobjs $deplibs $compiler_flags' - fi - ;; - - uts4*) - _LT_TAGVAR(archive_cmds, $1)='$LD -G -h $soname -o $lib $libobjs $deplibs $linker_flags' - _LT_TAGVAR(hardcode_libdir_flag_spec, $1)='-L$libdir' - _LT_TAGVAR(hardcode_shlibpath_var, $1)=no - ;; - - *) - _LT_TAGVAR(ld_shlibs, $1)=no - ;; - esac - - if test sni = "$host_vendor"; then - case $host in - sysv4 | sysv4.2uw2* | sysv4.3* | sysv5*) - _LT_TAGVAR(export_dynamic_flag_spec, $1)='$wl-Blargedynsym' - ;; - esac - fi - fi -]) -AC_MSG_RESULT([$_LT_TAGVAR(ld_shlibs, $1)]) -test no = "$_LT_TAGVAR(ld_shlibs, $1)" && can_build_shared=no - -_LT_TAGVAR(with_gnu_ld, $1)=$with_gnu_ld - -_LT_DECL([], [libext], [0], [Old archive suffix (normally "a")])dnl -_LT_DECL([], [shrext_cmds], [1], [Shared library suffix (normally ".so")])dnl -_LT_DECL([], [extract_expsyms_cmds], [2], - [The commands to extract the exported symbol list from a shared archive]) - -# -# Do we need to explicitly link libc? -# -case "x$_LT_TAGVAR(archive_cmds_need_lc, $1)" in -x|xyes) - # Assume -lc should be added - _LT_TAGVAR(archive_cmds_need_lc, $1)=yes - - if test yes,yes = "$GCC,$enable_shared"; then - case $_LT_TAGVAR(archive_cmds, $1) in - *'~'*) - # FIXME: we may have to deal with multi-command sequences. - ;; - '$CC '*) - # Test whether the compiler implicitly links with -lc since on some - # systems, -lgcc has to come before -lc. If gcc already passes -lc - # to ld, don't add -lc before -lgcc. - AC_CACHE_CHECK([whether -lc should be explicitly linked in], - [lt_cv_]_LT_TAGVAR(archive_cmds_need_lc, $1), - [$RM conftest* - echo "$lt_simple_compile_test_code" > conftest.$ac_ext - - if AC_TRY_EVAL(ac_compile) 2>conftest.err; then - soname=conftest - lib=conftest - libobjs=conftest.$ac_objext - deplibs= - wl=$_LT_TAGVAR(lt_prog_compiler_wl, $1) - pic_flag=$_LT_TAGVAR(lt_prog_compiler_pic, $1) - compiler_flags=-v - linker_flags=-v - verstring= - output_objdir=. - libname=conftest - lt_save_allow_undefined_flag=$_LT_TAGVAR(allow_undefined_flag, $1) - _LT_TAGVAR(allow_undefined_flag, $1)= - if AC_TRY_EVAL(_LT_TAGVAR(archive_cmds, $1) 2\>\&1 \| $GREP \" -lc \" \>/dev/null 2\>\&1) - then - lt_cv_[]_LT_TAGVAR(archive_cmds_need_lc, $1)=no - else - lt_cv_[]_LT_TAGVAR(archive_cmds_need_lc, $1)=yes - fi - _LT_TAGVAR(allow_undefined_flag, $1)=$lt_save_allow_undefined_flag - else - cat conftest.err 1>&5 - fi - $RM conftest* - ]) - _LT_TAGVAR(archive_cmds_need_lc, $1)=$lt_cv_[]_LT_TAGVAR(archive_cmds_need_lc, $1) - ;; - esac - fi - ;; -esac - -_LT_TAGDECL([build_libtool_need_lc], [archive_cmds_need_lc], [0], - [Whether or not to add -lc for building shared libraries]) -_LT_TAGDECL([allow_libtool_libs_with_static_runtimes], - [enable_shared_with_static_runtimes], [0], - [Whether or not to disallow shared libs when runtime libs are static]) -_LT_TAGDECL([], [export_dynamic_flag_spec], [1], - [Compiler flag to allow reflexive dlopens]) -_LT_TAGDECL([], [whole_archive_flag_spec], [1], - [Compiler flag to generate shared objects directly from archives]) -_LT_TAGDECL([], [compiler_needs_object], [1], - [Whether the compiler copes with passing no objects directly]) -_LT_TAGDECL([], [old_archive_from_new_cmds], [2], - [Create an old-style archive from a shared archive]) -_LT_TAGDECL([], [old_archive_from_expsyms_cmds], [2], - [Create a temporary old-style archive to link instead of a shared archive]) -_LT_TAGDECL([], [archive_cmds], [2], [Commands used to build a shared archive]) -_LT_TAGDECL([], [archive_expsym_cmds], [2]) -_LT_TAGDECL([], [module_cmds], [2], - [Commands used to build a loadable module if different from building - a shared archive.]) -_LT_TAGDECL([], [module_expsym_cmds], [2]) -_LT_TAGDECL([], [with_gnu_ld], [1], - [Whether we are building with GNU ld or not]) -_LT_TAGDECL([], [allow_undefined_flag], [1], - [Flag that allows shared libraries with undefined symbols to be built]) -_LT_TAGDECL([], [no_undefined_flag], [1], - [Flag that enforces no undefined symbols]) -_LT_TAGDECL([], [hardcode_libdir_flag_spec], [1], - [Flag to hardcode $libdir into a binary during linking. - This must work even if $libdir does not exist]) -_LT_TAGDECL([], [hardcode_libdir_separator], [1], - [Whether we need a single "-rpath" flag with a separated argument]) -_LT_TAGDECL([], [hardcode_direct], [0], - [Set to "yes" if using DIR/libNAME$shared_ext during linking hardcodes - DIR into the resulting binary]) -_LT_TAGDECL([], [hardcode_direct_absolute], [0], - [Set to "yes" if using DIR/libNAME$shared_ext during linking hardcodes - DIR into the resulting binary and the resulting library dependency is - "absolute", i.e impossible to change by setting $shlibpath_var if the - library is relocated]) -_LT_TAGDECL([], [hardcode_minus_L], [0], - [Set to "yes" if using the -LDIR flag during linking hardcodes DIR - into the resulting binary]) -_LT_TAGDECL([], [hardcode_shlibpath_var], [0], - [Set to "yes" if using SHLIBPATH_VAR=DIR during linking hardcodes DIR - into the resulting binary]) -_LT_TAGDECL([], [hardcode_automatic], [0], - [Set to "yes" if building a shared library automatically hardcodes DIR - into the library and all subsequent libraries and executables linked - against it]) -_LT_TAGDECL([], [inherit_rpath], [0], - [Set to yes if linker adds runtime paths of dependent libraries - to runtime path list]) -_LT_TAGDECL([], [link_all_deplibs], [0], - [Whether libtool must link a program against all its dependency libraries]) -_LT_TAGDECL([], [always_export_symbols], [0], - [Set to "yes" if exported symbols are required]) -_LT_TAGDECL([], [export_symbols_cmds], [2], - [The commands to list exported symbols]) -_LT_TAGDECL([], [exclude_expsyms], [1], - [Symbols that should not be listed in the preloaded symbols]) -_LT_TAGDECL([], [include_expsyms], [1], - [Symbols that must always be exported]) -_LT_TAGDECL([], [prelink_cmds], [2], - [Commands necessary for linking programs (against libraries) with templates]) -_LT_TAGDECL([], [postlink_cmds], [2], - [Commands necessary for finishing linking programs]) -_LT_TAGDECL([], [file_list_spec], [1], - [Specify filename containing input files]) -dnl FIXME: Not yet implemented -dnl _LT_TAGDECL([], [thread_safe_flag_spec], [1], -dnl [Compiler flag to generate thread safe objects]) -])# _LT_LINKER_SHLIBS - - -# _LT_LANG_C_CONFIG([TAG]) -# ------------------------ -# Ensure that the configuration variables for a C compiler are suitably -# defined. These variables are subsequently used by _LT_CONFIG to write -# the compiler configuration to 'libtool'. -m4_defun([_LT_LANG_C_CONFIG], -[m4_require([_LT_DECL_EGREP])dnl -lt_save_CC=$CC -AC_LANG_PUSH(C) - -# Source file extension for C test sources. -ac_ext=c - -# Object file extension for compiled C test sources. -objext=o -_LT_TAGVAR(objext, $1)=$objext - -# Code to be used in simple compile tests -lt_simple_compile_test_code="int some_variable = 0;" - -# Code to be used in simple link tests -lt_simple_link_test_code='int main(){return(0);}' - -_LT_TAG_COMPILER -# Save the default compiler, since it gets overwritten when the other -# tags are being tested, and _LT_TAGVAR(compiler, []) is a NOP. -compiler_DEFAULT=$CC - -# save warnings/boilerplate of simple test code -_LT_COMPILER_BOILERPLATE -_LT_LINKER_BOILERPLATE - -## CAVEAT EMPTOR: -## There is no encapsulation within the following macros, do not change -## the running order or otherwise move them around unless you know exactly -## what you are doing... -if test -n "$compiler"; then - _LT_COMPILER_NO_RTTI($1) - _LT_COMPILER_PIC($1) - _LT_COMPILER_C_O($1) - _LT_COMPILER_FILE_LOCKS($1) - _LT_LINKER_SHLIBS($1) - _LT_SYS_DYNAMIC_LINKER($1) - _LT_LINKER_HARDCODE_LIBPATH($1) - LT_SYS_DLOPEN_SELF - _LT_CMD_STRIPLIB - - # Report what library types will actually be built - AC_MSG_CHECKING([if libtool supports shared libraries]) - AC_MSG_RESULT([$can_build_shared]) - - AC_MSG_CHECKING([whether to build shared libraries]) - test no = "$can_build_shared" && enable_shared=no - - # On AIX, shared libraries and static libraries use the same namespace, and - # are all built from PIC. - case $host_os in - aix3*) - test yes = "$enable_shared" && enable_static=no - if test -n "$RANLIB"; then - archive_cmds="$archive_cmds~\$RANLIB \$lib" - postinstall_cmds='$RANLIB $lib' - fi - ;; - - aix[[4-9]]*) - if test ia64 != "$host_cpu"; then - case $enable_shared,$with_aix_soname,$aix_use_runtimelinking in - yes,aix,yes) ;; # shared object as lib.so file only - yes,svr4,*) ;; # shared object as lib.so archive member only - yes,*) enable_static=no ;; # shared object in lib.a archive as well - esac - fi - ;; - esac - AC_MSG_RESULT([$enable_shared]) - - AC_MSG_CHECKING([whether to build static libraries]) - # Make sure either enable_shared or enable_static is yes. - test yes = "$enable_shared" || enable_static=yes - AC_MSG_RESULT([$enable_static]) - - _LT_CONFIG($1) -fi -AC_LANG_POP -CC=$lt_save_CC -])# _LT_LANG_C_CONFIG - - -# _LT_LANG_CXX_CONFIG([TAG]) -# -------------------------- -# Ensure that the configuration variables for a C++ compiler are suitably -# defined. These variables are subsequently used by _LT_CONFIG to write -# the compiler configuration to 'libtool'. -m4_defun([_LT_LANG_CXX_CONFIG], -[m4_require([_LT_FILEUTILS_DEFAULTS])dnl -m4_require([_LT_DECL_EGREP])dnl -m4_require([_LT_PATH_MANIFEST_TOOL])dnl -if test -n "$CXX" && ( test no != "$CXX" && - ( (test g++ = "$CXX" && `g++ -v >/dev/null 2>&1` ) || - (test g++ != "$CXX"))); then - AC_PROG_CXXCPP -else - _lt_caught_CXX_error=yes -fi - -AC_LANG_PUSH(C++) -_LT_TAGVAR(archive_cmds_need_lc, $1)=no -_LT_TAGVAR(allow_undefined_flag, $1)= -_LT_TAGVAR(always_export_symbols, $1)=no -_LT_TAGVAR(archive_expsym_cmds, $1)= -_LT_TAGVAR(compiler_needs_object, $1)=no -_LT_TAGVAR(export_dynamic_flag_spec, $1)= -_LT_TAGVAR(hardcode_direct, $1)=no -_LT_TAGVAR(hardcode_direct_absolute, $1)=no -_LT_TAGVAR(hardcode_libdir_flag_spec, $1)= -_LT_TAGVAR(hardcode_libdir_separator, $1)= -_LT_TAGVAR(hardcode_minus_L, $1)=no -_LT_TAGVAR(hardcode_shlibpath_var, $1)=unsupported -_LT_TAGVAR(hardcode_automatic, $1)=no -_LT_TAGVAR(inherit_rpath, $1)=no -_LT_TAGVAR(module_cmds, $1)= -_LT_TAGVAR(module_expsym_cmds, $1)= -_LT_TAGVAR(link_all_deplibs, $1)=unknown -_LT_TAGVAR(old_archive_cmds, $1)=$old_archive_cmds -_LT_TAGVAR(reload_flag, $1)=$reload_flag -_LT_TAGVAR(reload_cmds, $1)=$reload_cmds -_LT_TAGVAR(no_undefined_flag, $1)= -_LT_TAGVAR(whole_archive_flag_spec, $1)= -_LT_TAGVAR(enable_shared_with_static_runtimes, $1)=no - -# Source file extension for C++ test sources. -ac_ext=cpp - -# Object file extension for compiled C++ test sources. -objext=o -_LT_TAGVAR(objext, $1)=$objext - -# No sense in running all these tests if we already determined that -# the CXX compiler isn't working. Some variables (like enable_shared) -# are currently assumed to apply to all compilers on this platform, -# and will be corrupted by setting them based on a non-working compiler. -if test yes != "$_lt_caught_CXX_error"; then - # Code to be used in simple compile tests - lt_simple_compile_test_code="int some_variable = 0;" - - # Code to be used in simple link tests - lt_simple_link_test_code='int main(int, char *[[]]) { return(0); }' - - # ltmain only uses $CC for tagged configurations so make sure $CC is set. - _LT_TAG_COMPILER - - # save warnings/boilerplate of simple test code - _LT_COMPILER_BOILERPLATE - _LT_LINKER_BOILERPLATE - - # Allow CC to be a program name with arguments. - lt_save_CC=$CC - lt_save_CFLAGS=$CFLAGS - lt_save_LD=$LD - lt_save_GCC=$GCC - GCC=$GXX - lt_save_with_gnu_ld=$with_gnu_ld - lt_save_path_LD=$lt_cv_path_LD - if test -n "${lt_cv_prog_gnu_ldcxx+set}"; then - lt_cv_prog_gnu_ld=$lt_cv_prog_gnu_ldcxx - else - $as_unset lt_cv_prog_gnu_ld - fi - if test -n "${lt_cv_path_LDCXX+set}"; then - lt_cv_path_LD=$lt_cv_path_LDCXX - else - $as_unset lt_cv_path_LD - fi - test -z "${LDCXX+set}" || LD=$LDCXX - CC=${CXX-"c++"} - CFLAGS=$CXXFLAGS - compiler=$CC - _LT_TAGVAR(compiler, $1)=$CC - _LT_CC_BASENAME([$compiler]) - - if test -n "$compiler"; then - # We don't want -fno-exception when compiling C++ code, so set the - # no_builtin_flag separately - if test yes = "$GXX"; then - _LT_TAGVAR(lt_prog_compiler_no_builtin_flag, $1)=' -fno-builtin' - else - _LT_TAGVAR(lt_prog_compiler_no_builtin_flag, $1)= - fi - - if test yes = "$GXX"; then - # Set up default GNU C++ configuration - - LT_PATH_LD - - # Check if GNU C++ uses GNU ld as the underlying linker, since the - # archiving commands below assume that GNU ld is being used. - if test yes = "$with_gnu_ld"; then - _LT_TAGVAR(archive_cmds, $1)='$CC $pic_flag -shared -nostdlib $predep_objects $libobjs $deplibs $postdep_objects $compiler_flags $wl-soname $wl$soname -o $lib' - _LT_TAGVAR(archive_expsym_cmds, $1)='$CC $pic_flag -shared -nostdlib $predep_objects $libobjs $deplibs $postdep_objects $compiler_flags $wl-soname $wl$soname $wl-retain-symbols-file $wl$export_symbols -o $lib' - - _LT_TAGVAR(hardcode_libdir_flag_spec, $1)='$wl-rpath $wl$libdir' - _LT_TAGVAR(export_dynamic_flag_spec, $1)='$wl--export-dynamic' - - # If archive_cmds runs LD, not CC, wlarc should be empty - # XXX I think wlarc can be eliminated in ltcf-cxx, but I need to - # investigate it a little bit more. (MM) - wlarc='$wl' - - # ancient GNU ld didn't support --whole-archive et. al. - if eval "`$CC -print-prog-name=ld` --help 2>&1" | - $GREP 'no-whole-archive' > /dev/null; then - _LT_TAGVAR(whole_archive_flag_spec, $1)=$wlarc'--whole-archive$convenience '$wlarc'--no-whole-archive' - else - _LT_TAGVAR(whole_archive_flag_spec, $1)= - fi - else - with_gnu_ld=no - wlarc= - - # A generic and very simple default shared library creation - # command for GNU C++ for the case where it uses the native - # linker, instead of GNU ld. If possible, this setting should - # overridden to take advantage of the native linker features on - # the platform it is being used on. - _LT_TAGVAR(archive_cmds, $1)='$CC -shared -nostdlib $predep_objects $libobjs $deplibs $postdep_objects $compiler_flags -o $lib' - fi - - # Commands to make compiler produce verbose output that lists - # what "hidden" libraries, object files and flags are used when - # linking a shared library. - output_verbose_link_cmd='$CC -shared $CFLAGS -v conftest.$objext 2>&1 | $GREP -v "^Configured with:" | $GREP "\-L"' - - else - GXX=no - with_gnu_ld=no - wlarc= - fi - - # PORTME: fill in a description of your system's C++ link characteristics - AC_MSG_CHECKING([whether the $compiler linker ($LD) supports shared libraries]) - _LT_TAGVAR(ld_shlibs, $1)=yes - case $host_os in - aix3*) - # FIXME: insert proper C++ library support - _LT_TAGVAR(ld_shlibs, $1)=no - ;; - aix[[4-9]]*) - if test ia64 = "$host_cpu"; then - # On IA64, the linker does run time linking by default, so we don't - # have to do anything special. - aix_use_runtimelinking=no - exp_sym_flag='-Bexport' - no_entry_flag= - else - aix_use_runtimelinking=no - - # Test if we are trying to use run time linking or normal - # AIX style linking. If -brtl is somewhere in LDFLAGS, we - # have runtime linking enabled, and use it for executables. - # For shared libraries, we enable/disable runtime linking - # depending on the kind of the shared library created - - # when "with_aix_soname,aix_use_runtimelinking" is: - # "aix,no" lib.a(lib.so.V) shared, rtl:no, for executables - # "aix,yes" lib.so shared, rtl:yes, for executables - # lib.a static archive - # "both,no" lib.so.V(shr.o) shared, rtl:yes - # lib.a(lib.so.V) shared, rtl:no, for executables - # "both,yes" lib.so.V(shr.o) shared, rtl:yes, for executables - # lib.a(lib.so.V) shared, rtl:no - # "svr4,*" lib.so.V(shr.o) shared, rtl:yes, for executables - # lib.a static archive - case $host_os in aix4.[[23]]|aix4.[[23]].*|aix[[5-9]]*) - for ld_flag in $LDFLAGS; do - case $ld_flag in - *-brtl*) - aix_use_runtimelinking=yes - break - ;; - esac - done - if test svr4,no = "$with_aix_soname,$aix_use_runtimelinking"; then - # With aix-soname=svr4, we create the lib.so.V shared archives only, - # so we don't have lib.a shared libs to link our executables. - # We have to force runtime linking in this case. - aix_use_runtimelinking=yes - LDFLAGS="$LDFLAGS -Wl,-brtl" - fi - ;; - esac - - exp_sym_flag='-bexport' - no_entry_flag='-bnoentry' - fi - - # When large executables or shared objects are built, AIX ld can - # have problems creating the table of contents. If linking a library - # or program results in "error TOC overflow" add -mminimal-toc to - # CXXFLAGS/CFLAGS for g++/gcc. In the cases where that is not - # enough to fix the problem, add -Wl,-bbigtoc to LDFLAGS. - - _LT_TAGVAR(archive_cmds, $1)='' - _LT_TAGVAR(hardcode_direct, $1)=yes - _LT_TAGVAR(hardcode_direct_absolute, $1)=yes - _LT_TAGVAR(hardcode_libdir_separator, $1)=':' - _LT_TAGVAR(link_all_deplibs, $1)=yes - _LT_TAGVAR(file_list_spec, $1)='$wl-f,' - case $with_aix_soname,$aix_use_runtimelinking in - aix,*) ;; # no import file - svr4,* | *,yes) # use import file - # The Import File defines what to hardcode. - _LT_TAGVAR(hardcode_direct, $1)=no - _LT_TAGVAR(hardcode_direct_absolute, $1)=no - ;; - esac - - if test yes = "$GXX"; then - case $host_os in aix4.[[012]]|aix4.[[012]].*) - # We only want to do this on AIX 4.2 and lower, the check - # below for broken collect2 doesn't work under 4.3+ - collect2name=`$CC -print-prog-name=collect2` - if test -f "$collect2name" && - strings "$collect2name" | $GREP resolve_lib_name >/dev/null - then - # We have reworked collect2 - : - else - # We have old collect2 - _LT_TAGVAR(hardcode_direct, $1)=unsupported - # It fails to find uninstalled libraries when the uninstalled - # path is not listed in the libpath. Setting hardcode_minus_L - # to unsupported forces relinking - _LT_TAGVAR(hardcode_minus_L, $1)=yes - _LT_TAGVAR(hardcode_libdir_flag_spec, $1)='-L$libdir' - _LT_TAGVAR(hardcode_libdir_separator, $1)= - fi - esac - shared_flag='-shared' - if test yes = "$aix_use_runtimelinking"; then - shared_flag=$shared_flag' $wl-G' - fi - # Need to ensure runtime linking is disabled for the traditional - # shared library, or the linker may eventually find shared libraries - # /with/ Import File - we do not want to mix them. - shared_flag_aix='-shared' - shared_flag_svr4='-shared $wl-G' - else - # not using gcc - if test ia64 = "$host_cpu"; then - # VisualAge C++, Version 5.5 for AIX 5L for IA-64, Beta 3 Release - # chokes on -Wl,-G. The following line is correct: - shared_flag='-G' - else - if test yes = "$aix_use_runtimelinking"; then - shared_flag='$wl-G' - else - shared_flag='$wl-bM:SRE' - fi - shared_flag_aix='$wl-bM:SRE' - shared_flag_svr4='$wl-G' - fi - fi - - _LT_TAGVAR(export_dynamic_flag_spec, $1)='$wl-bexpall' - # It seems that -bexpall does not export symbols beginning with - # underscore (_), so it is better to generate a list of symbols to - # export. - _LT_TAGVAR(always_export_symbols, $1)=yes - if test aix,yes = "$with_aix_soname,$aix_use_runtimelinking"; then - # Warning - without using the other runtime loading flags (-brtl), - # -berok will link without error, but may produce a broken library. - # The "-G" linker flag allows undefined symbols. - _LT_TAGVAR(no_undefined_flag, $1)='-bernotok' - # Determine the default libpath from the value encoded in an empty - # executable. - _LT_SYS_MODULE_PATH_AIX([$1]) - _LT_TAGVAR(hardcode_libdir_flag_spec, $1)='$wl-blibpath:$libdir:'"$aix_libpath" - - _LT_TAGVAR(archive_expsym_cmds, $1)='$CC -o $output_objdir/$soname $libobjs $deplibs $wl'$no_entry_flag' $compiler_flags `if test -n "$allow_undefined_flag"; then func_echo_all "$wl$allow_undefined_flag"; else :; fi` $wl'$exp_sym_flag:\$export_symbols' '$shared_flag - else - if test ia64 = "$host_cpu"; then - _LT_TAGVAR(hardcode_libdir_flag_spec, $1)='$wl-R $libdir:/usr/lib:/lib' - _LT_TAGVAR(allow_undefined_flag, $1)="-z nodefs" - _LT_TAGVAR(archive_expsym_cmds, $1)="\$CC $shared_flag"' -o $output_objdir/$soname $libobjs $deplibs '"\$wl$no_entry_flag"' $compiler_flags $wl$allow_undefined_flag '"\$wl$exp_sym_flag:\$export_symbols" - else - # Determine the default libpath from the value encoded in an - # empty executable. - _LT_SYS_MODULE_PATH_AIX([$1]) - _LT_TAGVAR(hardcode_libdir_flag_spec, $1)='$wl-blibpath:$libdir:'"$aix_libpath" - # Warning - without using the other run time loading flags, - # -berok will link without error, but may produce a broken library. - _LT_TAGVAR(no_undefined_flag, $1)=' $wl-bernotok' - _LT_TAGVAR(allow_undefined_flag, $1)=' $wl-berok' - if test yes = "$with_gnu_ld"; then - # We only use this code for GNU lds that support --whole-archive. - _LT_TAGVAR(whole_archive_flag_spec, $1)='$wl--whole-archive$convenience $wl--no-whole-archive' - else - # Exported symbols can be pulled into shared objects from archives - _LT_TAGVAR(whole_archive_flag_spec, $1)='$convenience' - fi - _LT_TAGVAR(archive_cmds_need_lc, $1)=yes - _LT_TAGVAR(archive_expsym_cmds, $1)='$RM -r $output_objdir/$realname.d~$MKDIR $output_objdir/$realname.d' - # -brtl affects multiple linker settings, -berok does not and is overridden later - compiler_flags_filtered='`func_echo_all "$compiler_flags " | $SED -e "s%-brtl\\([[, ]]\\)%-berok\\1%g"`' - if test svr4 != "$with_aix_soname"; then - # This is similar to how AIX traditionally builds its shared - # libraries. Need -bnortl late, we may have -brtl in LDFLAGS. - _LT_TAGVAR(archive_expsym_cmds, $1)="$_LT_TAGVAR(archive_expsym_cmds, $1)"'~$CC '$shared_flag_aix' -o $output_objdir/$realname.d/$soname $libobjs $deplibs $wl-bnoentry '$compiler_flags_filtered'$wl-bE:$export_symbols$allow_undefined_flag~$AR $AR_FLAGS $output_objdir/$libname$release.a $output_objdir/$realname.d/$soname' - fi - if test aix != "$with_aix_soname"; then - _LT_TAGVAR(archive_expsym_cmds, $1)="$_LT_TAGVAR(archive_expsym_cmds, $1)"'~$CC '$shared_flag_svr4' -o $output_objdir/$realname.d/$shared_archive_member_spec.o $libobjs $deplibs $wl-bnoentry '$compiler_flags_filtered'$wl-bE:$export_symbols$allow_undefined_flag~$STRIP -e $output_objdir/$realname.d/$shared_archive_member_spec.o~( func_echo_all "#! $soname($shared_archive_member_spec.o)"; if test shr_64 = "$shared_archive_member_spec"; then func_echo_all "# 64"; else func_echo_all "# 32"; fi; cat $export_symbols ) > $output_objdir/$realname.d/$shared_archive_member_spec.imp~$AR $AR_FLAGS $output_objdir/$soname $output_objdir/$realname.d/$shared_archive_member_spec.o $output_objdir/$realname.d/$shared_archive_member_spec.imp' - else - # used by -dlpreopen to get the symbols - _LT_TAGVAR(archive_expsym_cmds, $1)="$_LT_TAGVAR(archive_expsym_cmds, $1)"'~$MV $output_objdir/$realname.d/$soname $output_objdir' - fi - _LT_TAGVAR(archive_expsym_cmds, $1)="$_LT_TAGVAR(archive_expsym_cmds, $1)"'~$RM -r $output_objdir/$realname.d' - fi - fi - ;; - - beos*) - if $LD --help 2>&1 | $GREP ': supported targets:.* elf' > /dev/null; then - _LT_TAGVAR(allow_undefined_flag, $1)=unsupported - # Joseph Beckenbach says some releases of gcc - # support --undefined. This deserves some investigation. FIXME - _LT_TAGVAR(archive_cmds, $1)='$CC -nostart $libobjs $deplibs $compiler_flags $wl-soname $wl$soname -o $lib' - else - _LT_TAGVAR(ld_shlibs, $1)=no - fi - ;; - - chorus*) - case $cc_basename in - *) - # FIXME: insert proper C++ library support - _LT_TAGVAR(ld_shlibs, $1)=no - ;; - esac - ;; - - cygwin* | mingw* | pw32* | cegcc*) - case $GXX,$cc_basename in - ,cl* | no,cl*) - # Native MSVC - # hardcode_libdir_flag_spec is actually meaningless, as there is - # no search path for DLLs. - _LT_TAGVAR(hardcode_libdir_flag_spec, $1)=' ' - _LT_TAGVAR(allow_undefined_flag, $1)=unsupported - _LT_TAGVAR(always_export_symbols, $1)=yes - _LT_TAGVAR(file_list_spec, $1)='@' - # Tell ltmain to make .lib files, not .a files. - libext=lib - # Tell ltmain to make .dll files, not .so files. - shrext_cmds=.dll - # FIXME: Setting linknames here is a bad hack. - _LT_TAGVAR(archive_cmds, $1)='$CC -o $output_objdir/$soname $libobjs $compiler_flags $deplibs -Wl,-DLL,-IMPLIB:"$tool_output_objdir$libname.dll.lib"~linknames=' - _LT_TAGVAR(archive_expsym_cmds, $1)='if _LT_DLL_DEF_P([$export_symbols]); then - cp "$export_symbols" "$output_objdir/$soname.def"; - echo "$tool_output_objdir$soname.def" > "$output_objdir/$soname.exp"; - else - $SED -e '\''s/^/-link -EXPORT:/'\'' < $export_symbols > $output_objdir/$soname.exp; - fi~ - $CC -o $tool_output_objdir$soname $libobjs $compiler_flags $deplibs "@$tool_output_objdir$soname.exp" -Wl,-DLL,-IMPLIB:"$tool_output_objdir$libname.dll.lib"~ - linknames=' - # The linker will not automatically build a static lib if we build a DLL. - # _LT_TAGVAR(old_archive_from_new_cmds, $1)='true' - _LT_TAGVAR(enable_shared_with_static_runtimes, $1)=yes - # Don't use ranlib - _LT_TAGVAR(old_postinstall_cmds, $1)='chmod 644 $oldlib' - _LT_TAGVAR(postlink_cmds, $1)='lt_outputfile="@OUTPUT@"~ - lt_tool_outputfile="@TOOL_OUTPUT@"~ - case $lt_outputfile in - *.exe|*.EXE) ;; - *) - lt_outputfile=$lt_outputfile.exe - lt_tool_outputfile=$lt_tool_outputfile.exe - ;; - esac~ - func_to_tool_file "$lt_outputfile"~ - if test : != "$MANIFEST_TOOL" && test -f "$lt_outputfile.manifest"; then - $MANIFEST_TOOL -manifest "$lt_tool_outputfile.manifest" -outputresource:"$lt_tool_outputfile" || exit 1; - $RM "$lt_outputfile.manifest"; - fi' - ;; - *) - # g++ - # _LT_TAGVAR(hardcode_libdir_flag_spec, $1) is actually meaningless, - # as there is no search path for DLLs. - _LT_TAGVAR(hardcode_libdir_flag_spec, $1)='-L$libdir' - _LT_TAGVAR(export_dynamic_flag_spec, $1)='$wl--export-all-symbols' - _LT_TAGVAR(allow_undefined_flag, $1)=unsupported - _LT_TAGVAR(always_export_symbols, $1)=no - _LT_TAGVAR(enable_shared_with_static_runtimes, $1)=yes - - if $LD --help 2>&1 | $GREP 'auto-import' > /dev/null; then - _LT_TAGVAR(archive_cmds, $1)='$CC -shared -nostdlib $predep_objects $libobjs $deplibs $postdep_objects $compiler_flags -o $output_objdir/$soname $wl--enable-auto-image-base -Xlinker --out-implib -Xlinker $lib' - # If the export-symbols file already is a .def file, use it as - # is; otherwise, prepend EXPORTS... - _LT_TAGVAR(archive_expsym_cmds, $1)='if _LT_DLL_DEF_P([$export_symbols]); then - cp $export_symbols $output_objdir/$soname.def; - else - echo EXPORTS > $output_objdir/$soname.def; - cat $export_symbols >> $output_objdir/$soname.def; - fi~ - $CC -shared -nostdlib $output_objdir/$soname.def $predep_objects $libobjs $deplibs $postdep_objects $compiler_flags -o $output_objdir/$soname $wl--enable-auto-image-base -Xlinker --out-implib -Xlinker $lib' - else - _LT_TAGVAR(ld_shlibs, $1)=no - fi - ;; - esac - ;; - darwin* | rhapsody*) - _LT_DARWIN_LINKER_FEATURES($1) - ;; - - os2*) - _LT_TAGVAR(hardcode_libdir_flag_spec, $1)='-L$libdir' - _LT_TAGVAR(hardcode_minus_L, $1)=yes - _LT_TAGVAR(allow_undefined_flag, $1)=unsupported - shrext_cmds=.dll - _LT_TAGVAR(archive_cmds, $1)='$ECHO "LIBRARY ${soname%$shared_ext} INITINSTANCE TERMINSTANCE" > $output_objdir/$libname.def~ - $ECHO "DESCRIPTION \"$libname\"" >> $output_objdir/$libname.def~ - $ECHO "DATA MULTIPLE NONSHARED" >> $output_objdir/$libname.def~ - $ECHO EXPORTS >> $output_objdir/$libname.def~ - emxexp $libobjs | $SED /"_DLL_InitTerm"/d >> $output_objdir/$libname.def~ - $CC -Zdll -Zcrtdll -o $output_objdir/$soname $libobjs $deplibs $compiler_flags $output_objdir/$libname.def~ - emximp -o $lib $output_objdir/$libname.def' - _LT_TAGVAR(archive_expsym_cmds, $1)='$ECHO "LIBRARY ${soname%$shared_ext} INITINSTANCE TERMINSTANCE" > $output_objdir/$libname.def~ - $ECHO "DESCRIPTION \"$libname\"" >> $output_objdir/$libname.def~ - $ECHO "DATA MULTIPLE NONSHARED" >> $output_objdir/$libname.def~ - $ECHO EXPORTS >> $output_objdir/$libname.def~ - prefix_cmds="$SED"~ - if test EXPORTS = "`$SED 1q $export_symbols`"; then - prefix_cmds="$prefix_cmds -e 1d"; - fi~ - prefix_cmds="$prefix_cmds -e \"s/^\(.*\)$/_\1/g\""~ - cat $export_symbols | $prefix_cmds >> $output_objdir/$libname.def~ - $CC -Zdll -Zcrtdll -o $output_objdir/$soname $libobjs $deplibs $compiler_flags $output_objdir/$libname.def~ - emximp -o $lib $output_objdir/$libname.def' - _LT_TAGVAR(old_archive_From_new_cmds, $1)='emximp -o $output_objdir/${libname}_dll.a $output_objdir/$libname.def' - _LT_TAGVAR(enable_shared_with_static_runtimes, $1)=yes - ;; - - dgux*) - case $cc_basename in - ec++*) - # FIXME: insert proper C++ library support - _LT_TAGVAR(ld_shlibs, $1)=no - ;; - ghcx*) - # Green Hills C++ Compiler - # FIXME: insert proper C++ library support - _LT_TAGVAR(ld_shlibs, $1)=no - ;; - *) - # FIXME: insert proper C++ library support - _LT_TAGVAR(ld_shlibs, $1)=no - ;; - esac - ;; - - freebsd2.*) - # C++ shared libraries reported to be fairly broken before - # switch to ELF - _LT_TAGVAR(ld_shlibs, $1)=no - ;; - - freebsd-elf*) - _LT_TAGVAR(archive_cmds_need_lc, $1)=no - ;; - - freebsd* | dragonfly*) - # FreeBSD 3 and later use GNU C++ and GNU ld with standard ELF - # conventions - _LT_TAGVAR(ld_shlibs, $1)=yes - ;; - - haiku*) - _LT_TAGVAR(archive_cmds, $1)='$CC -shared $libobjs $deplibs $compiler_flags $wl-soname $wl$soname -o $lib' - _LT_TAGVAR(link_all_deplibs, $1)=yes - ;; - - hpux9*) - _LT_TAGVAR(hardcode_libdir_flag_spec, $1)='$wl+b $wl$libdir' - _LT_TAGVAR(hardcode_libdir_separator, $1)=: - _LT_TAGVAR(export_dynamic_flag_spec, $1)='$wl-E' - _LT_TAGVAR(hardcode_direct, $1)=yes - _LT_TAGVAR(hardcode_minus_L, $1)=yes # Not in the search PATH, - # but as the default - # location of the library. - - case $cc_basename in - CC*) - # FIXME: insert proper C++ library support - _LT_TAGVAR(ld_shlibs, $1)=no - ;; - aCC*) - _LT_TAGVAR(archive_cmds, $1)='$RM $output_objdir/$soname~$CC -b $wl+b $wl$install_libdir -o $output_objdir/$soname $predep_objects $libobjs $deplibs $postdep_objects $compiler_flags~test "x$output_objdir/$soname" = "x$lib" || mv $output_objdir/$soname $lib' - # Commands to make compiler produce verbose output that lists - # what "hidden" libraries, object files and flags are used when - # linking a shared library. - # - # There doesn't appear to be a way to prevent this compiler from - # explicitly linking system object files so we need to strip them - # from the output so that they don't get included in the library - # dependencies. - output_verbose_link_cmd='templist=`($CC -b $CFLAGS -v conftest.$objext 2>&1) | $EGREP "\-L"`; list= ; for z in $templist; do case $z in conftest.$objext) list="$list $z";; *.$objext);; *) list="$list $z";;esac; done; func_echo_all "$list"' - ;; - *) - if test yes = "$GXX"; then - _LT_TAGVAR(archive_cmds, $1)='$RM $output_objdir/$soname~$CC -shared -nostdlib $pic_flag $wl+b $wl$install_libdir -o $output_objdir/$soname $predep_objects $libobjs $deplibs $postdep_objects $compiler_flags~test "x$output_objdir/$soname" = "x$lib" || mv $output_objdir/$soname $lib' - else - # FIXME: insert proper C++ library support - _LT_TAGVAR(ld_shlibs, $1)=no - fi - ;; - esac - ;; - - hpux10*|hpux11*) - if test no = "$with_gnu_ld"; then - _LT_TAGVAR(hardcode_libdir_flag_spec, $1)='$wl+b $wl$libdir' - _LT_TAGVAR(hardcode_libdir_separator, $1)=: - - case $host_cpu in - hppa*64*|ia64*) - ;; - *) - _LT_TAGVAR(export_dynamic_flag_spec, $1)='$wl-E' - ;; - esac - fi - case $host_cpu in - hppa*64*|ia64*) - _LT_TAGVAR(hardcode_direct, $1)=no - _LT_TAGVAR(hardcode_shlibpath_var, $1)=no - ;; - *) - _LT_TAGVAR(hardcode_direct, $1)=yes - _LT_TAGVAR(hardcode_direct_absolute, $1)=yes - _LT_TAGVAR(hardcode_minus_L, $1)=yes # Not in the search PATH, - # but as the default - # location of the library. - ;; - esac - - case $cc_basename in - CC*) - # FIXME: insert proper C++ library support - _LT_TAGVAR(ld_shlibs, $1)=no - ;; - aCC*) - case $host_cpu in - hppa*64*) - _LT_TAGVAR(archive_cmds, $1)='$CC -b $wl+h $wl$soname -o $lib $predep_objects $libobjs $deplibs $postdep_objects $compiler_flags' - ;; - ia64*) - _LT_TAGVAR(archive_cmds, $1)='$CC -b $wl+h $wl$soname $wl+nodefaultrpath -o $lib $predep_objects $libobjs $deplibs $postdep_objects $compiler_flags' - ;; - *) - _LT_TAGVAR(archive_cmds, $1)='$CC -b $wl+h $wl$soname $wl+b $wl$install_libdir -o $lib $predep_objects $libobjs $deplibs $postdep_objects $compiler_flags' - ;; - esac - # Commands to make compiler produce verbose output that lists - # what "hidden" libraries, object files and flags are used when - # linking a shared library. - # - # There doesn't appear to be a way to prevent this compiler from - # explicitly linking system object files so we need to strip them - # from the output so that they don't get included in the library - # dependencies. - output_verbose_link_cmd='templist=`($CC -b $CFLAGS -v conftest.$objext 2>&1) | $GREP "\-L"`; list= ; for z in $templist; do case $z in conftest.$objext) list="$list $z";; *.$objext);; *) list="$list $z";;esac; done; func_echo_all "$list"' - ;; - *) - if test yes = "$GXX"; then - if test no = "$with_gnu_ld"; then - case $host_cpu in - hppa*64*) - _LT_TAGVAR(archive_cmds, $1)='$CC -shared -nostdlib -fPIC $wl+h $wl$soname -o $lib $predep_objects $libobjs $deplibs $postdep_objects $compiler_flags' - ;; - ia64*) - _LT_TAGVAR(archive_cmds, $1)='$CC -shared -nostdlib $pic_flag $wl+h $wl$soname $wl+nodefaultrpath -o $lib $predep_objects $libobjs $deplibs $postdep_objects $compiler_flags' - ;; - *) - _LT_TAGVAR(archive_cmds, $1)='$CC -shared -nostdlib $pic_flag $wl+h $wl$soname $wl+b $wl$install_libdir -o $lib $predep_objects $libobjs $deplibs $postdep_objects $compiler_flags' - ;; - esac - fi - else - # FIXME: insert proper C++ library support - _LT_TAGVAR(ld_shlibs, $1)=no - fi - ;; - esac - ;; - - interix[[3-9]]*) - _LT_TAGVAR(hardcode_direct, $1)=no - _LT_TAGVAR(hardcode_shlibpath_var, $1)=no - _LT_TAGVAR(hardcode_libdir_flag_spec, $1)='$wl-rpath,$libdir' - _LT_TAGVAR(export_dynamic_flag_spec, $1)='$wl-E' - # Hack: On Interix 3.x, we cannot compile PIC because of a broken gcc. - # Instead, shared libraries are loaded at an image base (0x10000000 by - # default) and relocated if they conflict, which is a slow very memory - # consuming and fragmenting process. To avoid this, we pick a random, - # 256 KiB-aligned image base between 0x50000000 and 0x6FFC0000 at link - # time. Moving up from 0x10000000 also allows more sbrk(2) space. - _LT_TAGVAR(archive_cmds, $1)='$CC -shared $pic_flag $libobjs $deplibs $compiler_flags $wl-h,$soname $wl--image-base,`expr ${RANDOM-$$} % 4096 / 2 \* 262144 + 1342177280` -o $lib' - _LT_TAGVAR(archive_expsym_cmds, $1)='sed "s|^|_|" $export_symbols >$output_objdir/$soname.expsym~$CC -shared $pic_flag $libobjs $deplibs $compiler_flags $wl-h,$soname $wl--retain-symbols-file,$output_objdir/$soname.expsym $wl--image-base,`expr ${RANDOM-$$} % 4096 / 2 \* 262144 + 1342177280` -o $lib' - ;; - irix5* | irix6*) - case $cc_basename in - CC*) - # SGI C++ - _LT_TAGVAR(archive_cmds, $1)='$CC -shared -all -multigot $predep_objects $libobjs $deplibs $postdep_objects $compiler_flags -soname $soname `test -n "$verstring" && func_echo_all "-set_version $verstring"` -update_registry $output_objdir/so_locations -o $lib' - - # Archives containing C++ object files must be created using - # "CC -ar", where "CC" is the IRIX C++ compiler. This is - # necessary to make sure instantiated templates are included - # in the archive. - _LT_TAGVAR(old_archive_cmds, $1)='$CC -ar -WR,-u -o $oldlib $oldobjs' - ;; - *) - if test yes = "$GXX"; then - if test no = "$with_gnu_ld"; then - _LT_TAGVAR(archive_cmds, $1)='$CC -shared $pic_flag -nostdlib $predep_objects $libobjs $deplibs $postdep_objects $compiler_flags $wl-soname $wl$soname `test -n "$verstring" && func_echo_all "$wl-set_version $wl$verstring"` $wl-update_registry $wl$output_objdir/so_locations -o $lib' - else - _LT_TAGVAR(archive_cmds, $1)='$CC -shared $pic_flag -nostdlib $predep_objects $libobjs $deplibs $postdep_objects $compiler_flags $wl-soname $wl$soname `test -n "$verstring" && func_echo_all "$wl-set_version $wl$verstring"` -o $lib' - fi - fi - _LT_TAGVAR(link_all_deplibs, $1)=yes - ;; - esac - _LT_TAGVAR(hardcode_libdir_flag_spec, $1)='$wl-rpath $wl$libdir' - _LT_TAGVAR(hardcode_libdir_separator, $1)=: - _LT_TAGVAR(inherit_rpath, $1)=yes - ;; - - linux* | k*bsd*-gnu | kopensolaris*-gnu | gnu*) - case $cc_basename in - KCC*) - # Kuck and Associates, Inc. (KAI) C++ Compiler - - # KCC will only create a shared library if the output file - # ends with ".so" (or ".sl" for HP-UX), so rename the library - # to its proper name (with version) after linking. - _LT_TAGVAR(archive_cmds, $1)='tempext=`echo $shared_ext | $SED -e '\''s/\([[^()0-9A-Za-z{}]]\)/\\\\\1/g'\''`; templib=`echo $lib | $SED -e "s/\$tempext\..*/.so/"`; $CC $predep_objects $libobjs $deplibs $postdep_objects $compiler_flags --soname $soname -o \$templib; mv \$templib $lib' - _LT_TAGVAR(archive_expsym_cmds, $1)='tempext=`echo $shared_ext | $SED -e '\''s/\([[^()0-9A-Za-z{}]]\)/\\\\\1/g'\''`; templib=`echo $lib | $SED -e "s/\$tempext\..*/.so/"`; $CC $predep_objects $libobjs $deplibs $postdep_objects $compiler_flags --soname $soname -o \$templib $wl-retain-symbols-file,$export_symbols; mv \$templib $lib' - # Commands to make compiler produce verbose output that lists - # what "hidden" libraries, object files and flags are used when - # linking a shared library. - # - # There doesn't appear to be a way to prevent this compiler from - # explicitly linking system object files so we need to strip them - # from the output so that they don't get included in the library - # dependencies. - output_verbose_link_cmd='templist=`$CC $CFLAGS -v conftest.$objext -o libconftest$shared_ext 2>&1 | $GREP "ld"`; rm -f libconftest$shared_ext; list= ; for z in $templist; do case $z in conftest.$objext) list="$list $z";; *.$objext);; *) list="$list $z";;esac; done; func_echo_all "$list"' - - _LT_TAGVAR(hardcode_libdir_flag_spec, $1)='$wl-rpath,$libdir' - _LT_TAGVAR(export_dynamic_flag_spec, $1)='$wl--export-dynamic' - - # Archives containing C++ object files must be created using - # "CC -Bstatic", where "CC" is the KAI C++ compiler. - _LT_TAGVAR(old_archive_cmds, $1)='$CC -Bstatic -o $oldlib $oldobjs' - ;; - icpc* | ecpc* ) - # Intel C++ - with_gnu_ld=yes - # version 8.0 and above of icpc choke on multiply defined symbols - # if we add $predep_objects and $postdep_objects, however 7.1 and - # earlier do not add the objects themselves. - case `$CC -V 2>&1` in - *"Version 7."*) - _LT_TAGVAR(archive_cmds, $1)='$CC -shared $predep_objects $libobjs $deplibs $postdep_objects $compiler_flags $wl-soname $wl$soname -o $lib' - _LT_TAGVAR(archive_expsym_cmds, $1)='$CC -shared $predep_objects $libobjs $deplibs $postdep_objects $compiler_flags $wl-soname $wl$soname $wl-retain-symbols-file $wl$export_symbols -o $lib' - ;; - *) # Version 8.0 or newer - tmp_idyn= - case $host_cpu in - ia64*) tmp_idyn=' -i_dynamic';; - esac - _LT_TAGVAR(archive_cmds, $1)='$CC -shared'"$tmp_idyn"' $libobjs $deplibs $compiler_flags $wl-soname $wl$soname -o $lib' - _LT_TAGVAR(archive_expsym_cmds, $1)='$CC -shared'"$tmp_idyn"' $libobjs $deplibs $compiler_flags $wl-soname $wl$soname $wl-retain-symbols-file $wl$export_symbols -o $lib' - ;; - esac - _LT_TAGVAR(archive_cmds_need_lc, $1)=no - _LT_TAGVAR(hardcode_libdir_flag_spec, $1)='$wl-rpath,$libdir' - _LT_TAGVAR(export_dynamic_flag_spec, $1)='$wl--export-dynamic' - _LT_TAGVAR(whole_archive_flag_spec, $1)='$wl--whole-archive$convenience $wl--no-whole-archive' - ;; - pgCC* | pgcpp*) - # Portland Group C++ compiler - case `$CC -V` in - *pgCC\ [[1-5]].* | *pgcpp\ [[1-5]].*) - _LT_TAGVAR(prelink_cmds, $1)='tpldir=Template.dir~ - rm -rf $tpldir~ - $CC --prelink_objects --instantiation_dir $tpldir $objs $libobjs $compile_deplibs~ - compile_command="$compile_command `find $tpldir -name \*.o | sort | $NL2SP`"' - _LT_TAGVAR(old_archive_cmds, $1)='tpldir=Template.dir~ - rm -rf $tpldir~ - $CC --prelink_objects --instantiation_dir $tpldir $oldobjs$old_deplibs~ - $AR $AR_FLAGS $oldlib$oldobjs$old_deplibs `find $tpldir -name \*.o | sort | $NL2SP`~ - $RANLIB $oldlib' - _LT_TAGVAR(archive_cmds, $1)='tpldir=Template.dir~ - rm -rf $tpldir~ - $CC --prelink_objects --instantiation_dir $tpldir $predep_objects $libobjs $deplibs $convenience $postdep_objects~ - $CC -shared $pic_flag $predep_objects $libobjs $deplibs `find $tpldir -name \*.o | sort | $NL2SP` $postdep_objects $compiler_flags $wl-soname $wl$soname -o $lib' - _LT_TAGVAR(archive_expsym_cmds, $1)='tpldir=Template.dir~ - rm -rf $tpldir~ - $CC --prelink_objects --instantiation_dir $tpldir $predep_objects $libobjs $deplibs $convenience $postdep_objects~ - $CC -shared $pic_flag $predep_objects $libobjs $deplibs `find $tpldir -name \*.o | sort | $NL2SP` $postdep_objects $compiler_flags $wl-soname $wl$soname $wl-retain-symbols-file $wl$export_symbols -o $lib' - ;; - *) # Version 6 and above use weak symbols - _LT_TAGVAR(archive_cmds, $1)='$CC -shared $pic_flag $predep_objects $libobjs $deplibs $postdep_objects $compiler_flags $wl-soname $wl$soname -o $lib' - _LT_TAGVAR(archive_expsym_cmds, $1)='$CC -shared $pic_flag $predep_objects $libobjs $deplibs $postdep_objects $compiler_flags $wl-soname $wl$soname $wl-retain-symbols-file $wl$export_symbols -o $lib' - ;; - esac - - _LT_TAGVAR(hardcode_libdir_flag_spec, $1)='$wl--rpath $wl$libdir' - _LT_TAGVAR(export_dynamic_flag_spec, $1)='$wl--export-dynamic' - _LT_TAGVAR(whole_archive_flag_spec, $1)='$wl--whole-archive`for conv in $convenience\"\"; do test -n \"$conv\" && new_convenience=\"$new_convenience,$conv\"; done; func_echo_all \"$new_convenience\"` $wl--no-whole-archive' - ;; - cxx*) - # Compaq C++ - _LT_TAGVAR(archive_cmds, $1)='$CC -shared $predep_objects $libobjs $deplibs $postdep_objects $compiler_flags $wl-soname $wl$soname -o $lib' - _LT_TAGVAR(archive_expsym_cmds, $1)='$CC -shared $predep_objects $libobjs $deplibs $postdep_objects $compiler_flags $wl-soname $wl$soname -o $lib $wl-retain-symbols-file $wl$export_symbols' - - runpath_var=LD_RUN_PATH - _LT_TAGVAR(hardcode_libdir_flag_spec, $1)='-rpath $libdir' - _LT_TAGVAR(hardcode_libdir_separator, $1)=: - - # Commands to make compiler produce verbose output that lists - # what "hidden" libraries, object files and flags are used when - # linking a shared library. - # - # There doesn't appear to be a way to prevent this compiler from - # explicitly linking system object files so we need to strip them - # from the output so that they don't get included in the library - # dependencies. - output_verbose_link_cmd='templist=`$CC -shared $CFLAGS -v conftest.$objext 2>&1 | $GREP "ld"`; templist=`func_echo_all "$templist" | $SED "s/\(^.*ld.*\)\( .*ld .*$\)/\1/"`; list= ; for z in $templist; do case $z in conftest.$objext) list="$list $z";; *.$objext);; *) list="$list $z";;esac; done; func_echo_all "X$list" | $Xsed' - ;; - xl* | mpixl* | bgxl*) - # IBM XL 8.0 on PPC, with GNU ld - _LT_TAGVAR(hardcode_libdir_flag_spec, $1)='$wl-rpath $wl$libdir' - _LT_TAGVAR(export_dynamic_flag_spec, $1)='$wl--export-dynamic' - _LT_TAGVAR(archive_cmds, $1)='$CC -qmkshrobj $libobjs $deplibs $compiler_flags $wl-soname $wl$soname -o $lib' - if test yes = "$supports_anon_versioning"; then - _LT_TAGVAR(archive_expsym_cmds, $1)='echo "{ global:" > $output_objdir/$libname.ver~ - cat $export_symbols | sed -e "s/\(.*\)/\1;/" >> $output_objdir/$libname.ver~ - echo "local: *; };" >> $output_objdir/$libname.ver~ - $CC -qmkshrobj $libobjs $deplibs $compiler_flags $wl-soname $wl$soname $wl-version-script $wl$output_objdir/$libname.ver -o $lib' - fi - ;; - *) - case `$CC -V 2>&1 | sed 5q` in - *Sun\ C*) - # Sun C++ 5.9 - _LT_TAGVAR(no_undefined_flag, $1)=' -zdefs' - _LT_TAGVAR(archive_cmds, $1)='$CC -G$allow_undefined_flag -h$soname -o $lib $predep_objects $libobjs $deplibs $postdep_objects $compiler_flags' - _LT_TAGVAR(archive_expsym_cmds, $1)='$CC -G$allow_undefined_flag -h$soname -o $lib $predep_objects $libobjs $deplibs $postdep_objects $compiler_flags $wl-retain-symbols-file $wl$export_symbols' - _LT_TAGVAR(hardcode_libdir_flag_spec, $1)='-R$libdir' - _LT_TAGVAR(whole_archive_flag_spec, $1)='$wl--whole-archive`new_convenience=; for conv in $convenience\"\"; do test -z \"$conv\" || new_convenience=\"$new_convenience,$conv\"; done; func_echo_all \"$new_convenience\"` $wl--no-whole-archive' - _LT_TAGVAR(compiler_needs_object, $1)=yes - - # Not sure whether something based on - # $CC $CFLAGS -v conftest.$objext -o libconftest$shared_ext 2>&1 - # would be better. - output_verbose_link_cmd='func_echo_all' - - # Archives containing C++ object files must be created using - # "CC -xar", where "CC" is the Sun C++ compiler. This is - # necessary to make sure instantiated templates are included - # in the archive. - _LT_TAGVAR(old_archive_cmds, $1)='$CC -xar -o $oldlib $oldobjs' - ;; - esac - ;; - esac - ;; - - lynxos*) - # FIXME: insert proper C++ library support - _LT_TAGVAR(ld_shlibs, $1)=no - ;; - - m88k*) - # FIXME: insert proper C++ library support - _LT_TAGVAR(ld_shlibs, $1)=no - ;; - - mvs*) - case $cc_basename in - cxx*) - # FIXME: insert proper C++ library support - _LT_TAGVAR(ld_shlibs, $1)=no - ;; - *) - # FIXME: insert proper C++ library support - _LT_TAGVAR(ld_shlibs, $1)=no - ;; - esac - ;; - - netbsd*) - if echo __ELF__ | $CC -E - | $GREP __ELF__ >/dev/null; then - _LT_TAGVAR(archive_cmds, $1)='$LD -Bshareable -o $lib $predep_objects $libobjs $deplibs $postdep_objects $linker_flags' - wlarc= - _LT_TAGVAR(hardcode_libdir_flag_spec, $1)='-R$libdir' - _LT_TAGVAR(hardcode_direct, $1)=yes - _LT_TAGVAR(hardcode_shlibpath_var, $1)=no - fi - # Workaround some broken pre-1.5 toolchains - output_verbose_link_cmd='$CC -shared $CFLAGS -v conftest.$objext 2>&1 | $GREP conftest.$objext | $SED -e "s:-lgcc -lc -lgcc::"' - ;; - - *nto* | *qnx*) - _LT_TAGVAR(ld_shlibs, $1)=yes - ;; - - openbsd* | bitrig*) - if test -f /usr/libexec/ld.so; then - _LT_TAGVAR(hardcode_direct, $1)=yes - _LT_TAGVAR(hardcode_shlibpath_var, $1)=no - _LT_TAGVAR(hardcode_direct_absolute, $1)=yes - _LT_TAGVAR(archive_cmds, $1)='$CC -shared $pic_flag $predep_objects $libobjs $deplibs $postdep_objects $compiler_flags -o $lib' - _LT_TAGVAR(hardcode_libdir_flag_spec, $1)='$wl-rpath,$libdir' - if test -z "`echo __ELF__ | $CC -E - | grep __ELF__`"; then - _LT_TAGVAR(archive_expsym_cmds, $1)='$CC -shared $pic_flag $predep_objects $libobjs $deplibs $postdep_objects $compiler_flags $wl-retain-symbols-file,$export_symbols -o $lib' - _LT_TAGVAR(export_dynamic_flag_spec, $1)='$wl-E' - _LT_TAGVAR(whole_archive_flag_spec, $1)=$wlarc'--whole-archive$convenience '$wlarc'--no-whole-archive' - fi - output_verbose_link_cmd=func_echo_all - else - _LT_TAGVAR(ld_shlibs, $1)=no - fi - ;; - - osf3* | osf4* | osf5*) - case $cc_basename in - KCC*) - # Kuck and Associates, Inc. (KAI) C++ Compiler - - # KCC will only create a shared library if the output file - # ends with ".so" (or ".sl" for HP-UX), so rename the library - # to its proper name (with version) after linking. - _LT_TAGVAR(archive_cmds, $1)='tempext=`echo $shared_ext | $SED -e '\''s/\([[^()0-9A-Za-z{}]]\)/\\\\\1/g'\''`; templib=`echo "$lib" | $SED -e "s/\$tempext\..*/.so/"`; $CC $predep_objects $libobjs $deplibs $postdep_objects $compiler_flags --soname $soname -o \$templib; mv \$templib $lib' - - _LT_TAGVAR(hardcode_libdir_flag_spec, $1)='$wl-rpath,$libdir' - _LT_TAGVAR(hardcode_libdir_separator, $1)=: - - # Archives containing C++ object files must be created using - # the KAI C++ compiler. - case $host in - osf3*) _LT_TAGVAR(old_archive_cmds, $1)='$CC -Bstatic -o $oldlib $oldobjs' ;; - *) _LT_TAGVAR(old_archive_cmds, $1)='$CC -o $oldlib $oldobjs' ;; - esac - ;; - RCC*) - # Rational C++ 2.4.1 - # FIXME: insert proper C++ library support - _LT_TAGVAR(ld_shlibs, $1)=no - ;; - cxx*) - case $host in - osf3*) - _LT_TAGVAR(allow_undefined_flag, $1)=' $wl-expect_unresolved $wl\*' - _LT_TAGVAR(archive_cmds, $1)='$CC -shared$allow_undefined_flag $predep_objects $libobjs $deplibs $postdep_objects $compiler_flags $wl-soname $soname `test -n "$verstring" && func_echo_all "$wl-set_version $verstring"` -update_registry $output_objdir/so_locations -o $lib' - _LT_TAGVAR(hardcode_libdir_flag_spec, $1)='$wl-rpath $wl$libdir' - ;; - *) - _LT_TAGVAR(allow_undefined_flag, $1)=' -expect_unresolved \*' - _LT_TAGVAR(archive_cmds, $1)='$CC -shared$allow_undefined_flag $predep_objects $libobjs $deplibs $postdep_objects $compiler_flags -msym -soname $soname `test -n "$verstring" && func_echo_all "-set_version $verstring"` -update_registry $output_objdir/so_locations -o $lib' - _LT_TAGVAR(archive_expsym_cmds, $1)='for i in `cat $export_symbols`; do printf "%s %s\\n" -exported_symbol "\$i" >> $lib.exp; done~ - echo "-hidden">> $lib.exp~ - $CC -shared$allow_undefined_flag $predep_objects $libobjs $deplibs $postdep_objects $compiler_flags -msym -soname $soname $wl-input $wl$lib.exp `test -n "$verstring" && $ECHO "-set_version $verstring"` -update_registry $output_objdir/so_locations -o $lib~ - $RM $lib.exp' - _LT_TAGVAR(hardcode_libdir_flag_spec, $1)='-rpath $libdir' - ;; - esac - - _LT_TAGVAR(hardcode_libdir_separator, $1)=: - - # Commands to make compiler produce verbose output that lists - # what "hidden" libraries, object files and flags are used when - # linking a shared library. - # - # There doesn't appear to be a way to prevent this compiler from - # explicitly linking system object files so we need to strip them - # from the output so that they don't get included in the library - # dependencies. - output_verbose_link_cmd='templist=`$CC -shared $CFLAGS -v conftest.$objext 2>&1 | $GREP "ld" | $GREP -v "ld:"`; templist=`func_echo_all "$templist" | $SED "s/\(^.*ld.*\)\( .*ld.*$\)/\1/"`; list= ; for z in $templist; do case $z in conftest.$objext) list="$list $z";; *.$objext);; *) list="$list $z";;esac; done; func_echo_all "$list"' - ;; - *) - if test yes,no = "$GXX,$with_gnu_ld"; then - _LT_TAGVAR(allow_undefined_flag, $1)=' $wl-expect_unresolved $wl\*' - case $host in - osf3*) - _LT_TAGVAR(archive_cmds, $1)='$CC -shared -nostdlib $allow_undefined_flag $predep_objects $libobjs $deplibs $postdep_objects $compiler_flags $wl-soname $wl$soname `test -n "$verstring" && func_echo_all "$wl-set_version $wl$verstring"` $wl-update_registry $wl$output_objdir/so_locations -o $lib' - ;; - *) - _LT_TAGVAR(archive_cmds, $1)='$CC -shared $pic_flag -nostdlib $allow_undefined_flag $predep_objects $libobjs $deplibs $postdep_objects $compiler_flags $wl-msym $wl-soname $wl$soname `test -n "$verstring" && func_echo_all "$wl-set_version $wl$verstring"` $wl-update_registry $wl$output_objdir/so_locations -o $lib' - ;; - esac - - _LT_TAGVAR(hardcode_libdir_flag_spec, $1)='$wl-rpath $wl$libdir' - _LT_TAGVAR(hardcode_libdir_separator, $1)=: - - # Commands to make compiler produce verbose output that lists - # what "hidden" libraries, object files and flags are used when - # linking a shared library. - output_verbose_link_cmd='$CC -shared $CFLAGS -v conftest.$objext 2>&1 | $GREP -v "^Configured with:" | $GREP "\-L"' - - else - # FIXME: insert proper C++ library support - _LT_TAGVAR(ld_shlibs, $1)=no - fi - ;; - esac - ;; - - psos*) - # FIXME: insert proper C++ library support - _LT_TAGVAR(ld_shlibs, $1)=no - ;; - - sunos4*) - case $cc_basename in - CC*) - # Sun C++ 4.x - # FIXME: insert proper C++ library support - _LT_TAGVAR(ld_shlibs, $1)=no - ;; - lcc*) - # Lucid - # FIXME: insert proper C++ library support - _LT_TAGVAR(ld_shlibs, $1)=no - ;; - *) - # FIXME: insert proper C++ library support - _LT_TAGVAR(ld_shlibs, $1)=no - ;; - esac - ;; - - solaris*) - case $cc_basename in - CC* | sunCC*) - # Sun C++ 4.2, 5.x and Centerline C++ - _LT_TAGVAR(archive_cmds_need_lc,$1)=yes - _LT_TAGVAR(no_undefined_flag, $1)=' -zdefs' - _LT_TAGVAR(archive_cmds, $1)='$CC -G$allow_undefined_flag -h$soname -o $lib $predep_objects $libobjs $deplibs $postdep_objects $compiler_flags' - _LT_TAGVAR(archive_expsym_cmds, $1)='echo "{ global:" > $lib.exp~cat $export_symbols | $SED -e "s/\(.*\)/\1;/" >> $lib.exp~echo "local: *; };" >> $lib.exp~ - $CC -G$allow_undefined_flag $wl-M $wl$lib.exp -h$soname -o $lib $predep_objects $libobjs $deplibs $postdep_objects $compiler_flags~$RM $lib.exp' - - _LT_TAGVAR(hardcode_libdir_flag_spec, $1)='-R$libdir' - _LT_TAGVAR(hardcode_shlibpath_var, $1)=no - case $host_os in - solaris2.[[0-5]] | solaris2.[[0-5]].*) ;; - *) - # The compiler driver will combine and reorder linker options, - # but understands '-z linker_flag'. - # Supported since Solaris 2.6 (maybe 2.5.1?) - _LT_TAGVAR(whole_archive_flag_spec, $1)='-z allextract$convenience -z defaultextract' - ;; - esac - _LT_TAGVAR(link_all_deplibs, $1)=yes - - output_verbose_link_cmd='func_echo_all' - - # Archives containing C++ object files must be created using - # "CC -xar", where "CC" is the Sun C++ compiler. This is - # necessary to make sure instantiated templates are included - # in the archive. - _LT_TAGVAR(old_archive_cmds, $1)='$CC -xar -o $oldlib $oldobjs' - ;; - gcx*) - # Green Hills C++ Compiler - _LT_TAGVAR(archive_cmds, $1)='$CC -shared $predep_objects $libobjs $deplibs $postdep_objects $compiler_flags $wl-h $wl$soname -o $lib' - - # The C++ compiler must be used to create the archive. - _LT_TAGVAR(old_archive_cmds, $1)='$CC $LDFLAGS -archive -o $oldlib $oldobjs' - ;; - *) - # GNU C++ compiler with Solaris linker - if test yes,no = "$GXX,$with_gnu_ld"; then - _LT_TAGVAR(no_undefined_flag, $1)=' $wl-z ${wl}defs' - if $CC --version | $GREP -v '^2\.7' > /dev/null; then - _LT_TAGVAR(archive_cmds, $1)='$CC -shared $pic_flag -nostdlib $predep_objects $libobjs $deplibs $postdep_objects $compiler_flags $wl-h $wl$soname -o $lib' - _LT_TAGVAR(archive_expsym_cmds, $1)='echo "{ global:" > $lib.exp~cat $export_symbols | $SED -e "s/\(.*\)/\1;/" >> $lib.exp~echo "local: *; };" >> $lib.exp~ - $CC -shared $pic_flag -nostdlib $wl-M $wl$lib.exp $wl-h $wl$soname -o $lib $predep_objects $libobjs $deplibs $postdep_objects $compiler_flags~$RM $lib.exp' - - # Commands to make compiler produce verbose output that lists - # what "hidden" libraries, object files and flags are used when - # linking a shared library. - output_verbose_link_cmd='$CC -shared $CFLAGS -v conftest.$objext 2>&1 | $GREP -v "^Configured with:" | $GREP "\-L"' - else - # g++ 2.7 appears to require '-G' NOT '-shared' on this - # platform. - _LT_TAGVAR(archive_cmds, $1)='$CC -G -nostdlib $predep_objects $libobjs $deplibs $postdep_objects $compiler_flags $wl-h $wl$soname -o $lib' - _LT_TAGVAR(archive_expsym_cmds, $1)='echo "{ global:" > $lib.exp~cat $export_symbols | $SED -e "s/\(.*\)/\1;/" >> $lib.exp~echo "local: *; };" >> $lib.exp~ - $CC -G -nostdlib $wl-M $wl$lib.exp $wl-h $wl$soname -o $lib $predep_objects $libobjs $deplibs $postdep_objects $compiler_flags~$RM $lib.exp' - - # Commands to make compiler produce verbose output that lists - # what "hidden" libraries, object files and flags are used when - # linking a shared library. - output_verbose_link_cmd='$CC -G $CFLAGS -v conftest.$objext 2>&1 | $GREP -v "^Configured with:" | $GREP "\-L"' - fi - - _LT_TAGVAR(hardcode_libdir_flag_spec, $1)='$wl-R $wl$libdir' - case $host_os in - solaris2.[[0-5]] | solaris2.[[0-5]].*) ;; - *) - _LT_TAGVAR(whole_archive_flag_spec, $1)='$wl-z ${wl}allextract$convenience $wl-z ${wl}defaultextract' - ;; - esac - fi - ;; - esac - ;; - - sysv4*uw2* | sysv5OpenUNIX* | sysv5UnixWare7.[[01]].[[10]]* | unixware7* | sco3.2v5.0.[[024]]*) - _LT_TAGVAR(no_undefined_flag, $1)='$wl-z,text' - _LT_TAGVAR(archive_cmds_need_lc, $1)=no - _LT_TAGVAR(hardcode_shlibpath_var, $1)=no - runpath_var='LD_RUN_PATH' - - case $cc_basename in - CC*) - _LT_TAGVAR(archive_cmds, $1)='$CC -G $wl-h,$soname -o $lib $libobjs $deplibs $compiler_flags' - _LT_TAGVAR(archive_expsym_cmds, $1)='$CC -G $wl-Bexport:$export_symbols $wl-h,$soname -o $lib $libobjs $deplibs $compiler_flags' - ;; - *) - _LT_TAGVAR(archive_cmds, $1)='$CC -shared $wl-h,$soname -o $lib $libobjs $deplibs $compiler_flags' - _LT_TAGVAR(archive_expsym_cmds, $1)='$CC -shared $wl-Bexport:$export_symbols $wl-h,$soname -o $lib $libobjs $deplibs $compiler_flags' - ;; - esac - ;; - - sysv5* | sco3.2v5* | sco5v6*) - # Note: We CANNOT use -z defs as we might desire, because we do not - # link with -lc, and that would cause any symbols used from libc to - # always be unresolved, which means just about no library would - # ever link correctly. If we're not using GNU ld we use -z text - # though, which does catch some bad symbols but isn't as heavy-handed - # as -z defs. - _LT_TAGVAR(no_undefined_flag, $1)='$wl-z,text' - _LT_TAGVAR(allow_undefined_flag, $1)='$wl-z,nodefs' - _LT_TAGVAR(archive_cmds_need_lc, $1)=no - _LT_TAGVAR(hardcode_shlibpath_var, $1)=no - _LT_TAGVAR(hardcode_libdir_flag_spec, $1)='$wl-R,$libdir' - _LT_TAGVAR(hardcode_libdir_separator, $1)=':' - _LT_TAGVAR(link_all_deplibs, $1)=yes - _LT_TAGVAR(export_dynamic_flag_spec, $1)='$wl-Bexport' - runpath_var='LD_RUN_PATH' - - case $cc_basename in - CC*) - _LT_TAGVAR(archive_cmds, $1)='$CC -G $wl-h,$soname -o $lib $libobjs $deplibs $compiler_flags' - _LT_TAGVAR(archive_expsym_cmds, $1)='$CC -G $wl-Bexport:$export_symbols $wl-h,$soname -o $lib $libobjs $deplibs $compiler_flags' - _LT_TAGVAR(old_archive_cmds, $1)='$CC -Tprelink_objects $oldobjs~ - '"$_LT_TAGVAR(old_archive_cmds, $1)" - _LT_TAGVAR(reload_cmds, $1)='$CC -Tprelink_objects $reload_objs~ - '"$_LT_TAGVAR(reload_cmds, $1)" - ;; - *) - _LT_TAGVAR(archive_cmds, $1)='$CC -shared $wl-h,$soname -o $lib $libobjs $deplibs $compiler_flags' - _LT_TAGVAR(archive_expsym_cmds, $1)='$CC -shared $wl-Bexport:$export_symbols $wl-h,$soname -o $lib $libobjs $deplibs $compiler_flags' - ;; - esac - ;; - - tandem*) - case $cc_basename in - NCC*) - # NonStop-UX NCC 3.20 - # FIXME: insert proper C++ library support - _LT_TAGVAR(ld_shlibs, $1)=no - ;; - *) - # FIXME: insert proper C++ library support - _LT_TAGVAR(ld_shlibs, $1)=no - ;; - esac - ;; - - vxworks*) - # FIXME: insert proper C++ library support - _LT_TAGVAR(ld_shlibs, $1)=no - ;; - - *) - # FIXME: insert proper C++ library support - _LT_TAGVAR(ld_shlibs, $1)=no - ;; - esac - - AC_MSG_RESULT([$_LT_TAGVAR(ld_shlibs, $1)]) - test no = "$_LT_TAGVAR(ld_shlibs, $1)" && can_build_shared=no - - _LT_TAGVAR(GCC, $1)=$GXX - _LT_TAGVAR(LD, $1)=$LD - - ## CAVEAT EMPTOR: - ## There is no encapsulation within the following macros, do not change - ## the running order or otherwise move them around unless you know exactly - ## what you are doing... - _LT_SYS_HIDDEN_LIBDEPS($1) - _LT_COMPILER_PIC($1) - _LT_COMPILER_C_O($1) - _LT_COMPILER_FILE_LOCKS($1) - _LT_LINKER_SHLIBS($1) - _LT_SYS_DYNAMIC_LINKER($1) - _LT_LINKER_HARDCODE_LIBPATH($1) - - _LT_CONFIG($1) - fi # test -n "$compiler" - - CC=$lt_save_CC - CFLAGS=$lt_save_CFLAGS - LDCXX=$LD - LD=$lt_save_LD - GCC=$lt_save_GCC - with_gnu_ld=$lt_save_with_gnu_ld - lt_cv_path_LDCXX=$lt_cv_path_LD - lt_cv_path_LD=$lt_save_path_LD - lt_cv_prog_gnu_ldcxx=$lt_cv_prog_gnu_ld - lt_cv_prog_gnu_ld=$lt_save_with_gnu_ld -fi # test yes != "$_lt_caught_CXX_error" - -AC_LANG_POP -])# _LT_LANG_CXX_CONFIG - - -# _LT_FUNC_STRIPNAME_CNF -# ---------------------- -# func_stripname_cnf prefix suffix name -# strip PREFIX and SUFFIX off of NAME. -# PREFIX and SUFFIX must not contain globbing or regex special -# characters, hashes, percent signs, but SUFFIX may contain a leading -# dot (in which case that matches only a dot). -# -# This function is identical to the (non-XSI) version of func_stripname, -# except this one can be used by m4 code that may be executed by configure, -# rather than the libtool script. -m4_defun([_LT_FUNC_STRIPNAME_CNF],[dnl -AC_REQUIRE([_LT_DECL_SED]) -AC_REQUIRE([_LT_PROG_ECHO_BACKSLASH]) -func_stripname_cnf () -{ - case @S|@2 in - .*) func_stripname_result=`$ECHO "@S|@3" | $SED "s%^@S|@1%%; s%\\\\@S|@2\$%%"`;; - *) func_stripname_result=`$ECHO "@S|@3" | $SED "s%^@S|@1%%; s%@S|@2\$%%"`;; - esac -} # func_stripname_cnf -])# _LT_FUNC_STRIPNAME_CNF - - -# _LT_SYS_HIDDEN_LIBDEPS([TAGNAME]) -# --------------------------------- -# Figure out "hidden" library dependencies from verbose -# compiler output when linking a shared library. -# Parse the compiler output and extract the necessary -# objects, libraries and library flags. -m4_defun([_LT_SYS_HIDDEN_LIBDEPS], -[m4_require([_LT_FILEUTILS_DEFAULTS])dnl -AC_REQUIRE([_LT_FUNC_STRIPNAME_CNF])dnl -# Dependencies to place before and after the object being linked: -_LT_TAGVAR(predep_objects, $1)= -_LT_TAGVAR(postdep_objects, $1)= -_LT_TAGVAR(predeps, $1)= -_LT_TAGVAR(postdeps, $1)= -_LT_TAGVAR(compiler_lib_search_path, $1)= - -dnl we can't use the lt_simple_compile_test_code here, -dnl because it contains code intended for an executable, -dnl not a library. It's possible we should let each -dnl tag define a new lt_????_link_test_code variable, -dnl but it's only used here... -m4_if([$1], [], [cat > conftest.$ac_ext <<_LT_EOF -int a; -void foo (void) { a = 0; } -_LT_EOF -], [$1], [CXX], [cat > conftest.$ac_ext <<_LT_EOF -class Foo -{ -public: - Foo (void) { a = 0; } -private: - int a; -}; -_LT_EOF -], [$1], [F77], [cat > conftest.$ac_ext <<_LT_EOF - subroutine foo - implicit none - integer*4 a - a=0 - return - end -_LT_EOF -], [$1], [FC], [cat > conftest.$ac_ext <<_LT_EOF - subroutine foo - implicit none - integer a - a=0 - return - end -_LT_EOF -], [$1], [GCJ], [cat > conftest.$ac_ext <<_LT_EOF -public class foo { - private int a; - public void bar (void) { - a = 0; - } -}; -_LT_EOF -], [$1], [GO], [cat > conftest.$ac_ext <<_LT_EOF -package foo -func foo() { -} -_LT_EOF -]) - -_lt_libdeps_save_CFLAGS=$CFLAGS -case "$CC $CFLAGS " in #( -*\ -flto*\ *) CFLAGS="$CFLAGS -fno-lto" ;; -*\ -fwhopr*\ *) CFLAGS="$CFLAGS -fno-whopr" ;; -*\ -fuse-linker-plugin*\ *) CFLAGS="$CFLAGS -fno-use-linker-plugin" ;; -esac - -dnl Parse the compiler output and extract the necessary -dnl objects, libraries and library flags. -if AC_TRY_EVAL(ac_compile); then - # Parse the compiler output and extract the necessary - # objects, libraries and library flags. - - # Sentinel used to keep track of whether or not we are before - # the conftest object file. - pre_test_object_deps_done=no - - for p in `eval "$output_verbose_link_cmd"`; do - case $prev$p in - - -L* | -R* | -l*) - # Some compilers place space between "-{L,R}" and the path. - # Remove the space. - if test x-L = "$p" || - test x-R = "$p"; then - prev=$p - continue - fi - - # Expand the sysroot to ease extracting the directories later. - if test -z "$prev"; then - case $p in - -L*) func_stripname_cnf '-L' '' "$p"; prev=-L; p=$func_stripname_result ;; - -R*) func_stripname_cnf '-R' '' "$p"; prev=-R; p=$func_stripname_result ;; - -l*) func_stripname_cnf '-l' '' "$p"; prev=-l; p=$func_stripname_result ;; - esac - fi - case $p in - =*) func_stripname_cnf '=' '' "$p"; p=$lt_sysroot$func_stripname_result ;; - esac - if test no = "$pre_test_object_deps_done"; then - case $prev in - -L | -R) - # Internal compiler library paths should come after those - # provided the user. The postdeps already come after the - # user supplied libs so there is no need to process them. - if test -z "$_LT_TAGVAR(compiler_lib_search_path, $1)"; then - _LT_TAGVAR(compiler_lib_search_path, $1)=$prev$p - else - _LT_TAGVAR(compiler_lib_search_path, $1)="${_LT_TAGVAR(compiler_lib_search_path, $1)} $prev$p" - fi - ;; - # The "-l" case would never come before the object being - # linked, so don't bother handling this case. - esac - else - if test -z "$_LT_TAGVAR(postdeps, $1)"; then - _LT_TAGVAR(postdeps, $1)=$prev$p - else - _LT_TAGVAR(postdeps, $1)="${_LT_TAGVAR(postdeps, $1)} $prev$p" - fi - fi - prev= - ;; - - *.lto.$objext) ;; # Ignore GCC LTO objects - *.$objext) - # This assumes that the test object file only shows up - # once in the compiler output. - if test "$p" = "conftest.$objext"; then - pre_test_object_deps_done=yes - continue - fi - - if test no = "$pre_test_object_deps_done"; then - if test -z "$_LT_TAGVAR(predep_objects, $1)"; then - _LT_TAGVAR(predep_objects, $1)=$p - else - _LT_TAGVAR(predep_objects, $1)="$_LT_TAGVAR(predep_objects, $1) $p" - fi - else - if test -z "$_LT_TAGVAR(postdep_objects, $1)"; then - _LT_TAGVAR(postdep_objects, $1)=$p - else - _LT_TAGVAR(postdep_objects, $1)="$_LT_TAGVAR(postdep_objects, $1) $p" - fi - fi - ;; - - *) ;; # Ignore the rest. - - esac - done - - # Clean up. - rm -f a.out a.exe -else - echo "libtool.m4: error: problem compiling $1 test program" -fi - -$RM -f confest.$objext -CFLAGS=$_lt_libdeps_save_CFLAGS - -# PORTME: override above test on systems where it is broken -m4_if([$1], [CXX], -[case $host_os in -interix[[3-9]]*) - # Interix 3.5 installs completely hosed .la files for C++, so rather than - # hack all around it, let's just trust "g++" to DTRT. - _LT_TAGVAR(predep_objects,$1)= - _LT_TAGVAR(postdep_objects,$1)= - _LT_TAGVAR(postdeps,$1)= - ;; -esac -]) - -case " $_LT_TAGVAR(postdeps, $1) " in -*" -lc "*) _LT_TAGVAR(archive_cmds_need_lc, $1)=no ;; -esac - _LT_TAGVAR(compiler_lib_search_dirs, $1)= -if test -n "${_LT_TAGVAR(compiler_lib_search_path, $1)}"; then - _LT_TAGVAR(compiler_lib_search_dirs, $1)=`echo " ${_LT_TAGVAR(compiler_lib_search_path, $1)}" | $SED -e 's! -L! !g' -e 's!^ !!'` -fi -_LT_TAGDECL([], [compiler_lib_search_dirs], [1], - [The directories searched by this compiler when creating a shared library]) -_LT_TAGDECL([], [predep_objects], [1], - [Dependencies to place before and after the objects being linked to - create a shared library]) -_LT_TAGDECL([], [postdep_objects], [1]) -_LT_TAGDECL([], [predeps], [1]) -_LT_TAGDECL([], [postdeps], [1]) -_LT_TAGDECL([], [compiler_lib_search_path], [1], - [The library search path used internally by the compiler when linking - a shared library]) -])# _LT_SYS_HIDDEN_LIBDEPS - - -# _LT_LANG_F77_CONFIG([TAG]) -# -------------------------- -# Ensure that the configuration variables for a Fortran 77 compiler are -# suitably defined. These variables are subsequently used by _LT_CONFIG -# to write the compiler configuration to 'libtool'. -m4_defun([_LT_LANG_F77_CONFIG], -[AC_LANG_PUSH(Fortran 77) -if test -z "$F77" || test no = "$F77"; then - _lt_disable_F77=yes -fi - -_LT_TAGVAR(archive_cmds_need_lc, $1)=no -_LT_TAGVAR(allow_undefined_flag, $1)= -_LT_TAGVAR(always_export_symbols, $1)=no -_LT_TAGVAR(archive_expsym_cmds, $1)= -_LT_TAGVAR(export_dynamic_flag_spec, $1)= -_LT_TAGVAR(hardcode_direct, $1)=no -_LT_TAGVAR(hardcode_direct_absolute, $1)=no -_LT_TAGVAR(hardcode_libdir_flag_spec, $1)= -_LT_TAGVAR(hardcode_libdir_separator, $1)= -_LT_TAGVAR(hardcode_minus_L, $1)=no -_LT_TAGVAR(hardcode_automatic, $1)=no -_LT_TAGVAR(inherit_rpath, $1)=no -_LT_TAGVAR(module_cmds, $1)= -_LT_TAGVAR(module_expsym_cmds, $1)= -_LT_TAGVAR(link_all_deplibs, $1)=unknown -_LT_TAGVAR(old_archive_cmds, $1)=$old_archive_cmds -_LT_TAGVAR(reload_flag, $1)=$reload_flag -_LT_TAGVAR(reload_cmds, $1)=$reload_cmds -_LT_TAGVAR(no_undefined_flag, $1)= -_LT_TAGVAR(whole_archive_flag_spec, $1)= -_LT_TAGVAR(enable_shared_with_static_runtimes, $1)=no - -# Source file extension for f77 test sources. -ac_ext=f - -# Object file extension for compiled f77 test sources. -objext=o -_LT_TAGVAR(objext, $1)=$objext - -# No sense in running all these tests if we already determined that -# the F77 compiler isn't working. Some variables (like enable_shared) -# are currently assumed to apply to all compilers on this platform, -# and will be corrupted by setting them based on a non-working compiler. -if test yes != "$_lt_disable_F77"; then - # Code to be used in simple compile tests - lt_simple_compile_test_code="\ - subroutine t - return - end -" - - # Code to be used in simple link tests - lt_simple_link_test_code="\ - program t - end -" - - # ltmain only uses $CC for tagged configurations so make sure $CC is set. - _LT_TAG_COMPILER - - # save warnings/boilerplate of simple test code - _LT_COMPILER_BOILERPLATE - _LT_LINKER_BOILERPLATE - - # Allow CC to be a program name with arguments. - lt_save_CC=$CC - lt_save_GCC=$GCC - lt_save_CFLAGS=$CFLAGS - CC=${F77-"f77"} - CFLAGS=$FFLAGS - compiler=$CC - _LT_TAGVAR(compiler, $1)=$CC - _LT_CC_BASENAME([$compiler]) - GCC=$G77 - if test -n "$compiler"; then - AC_MSG_CHECKING([if libtool supports shared libraries]) - AC_MSG_RESULT([$can_build_shared]) - - AC_MSG_CHECKING([whether to build shared libraries]) - test no = "$can_build_shared" && enable_shared=no - - # On AIX, shared libraries and static libraries use the same namespace, and - # are all built from PIC. - case $host_os in - aix3*) - test yes = "$enable_shared" && enable_static=no - if test -n "$RANLIB"; then - archive_cmds="$archive_cmds~\$RANLIB \$lib" - postinstall_cmds='$RANLIB $lib' - fi - ;; - aix[[4-9]]*) - if test ia64 != "$host_cpu"; then - case $enable_shared,$with_aix_soname,$aix_use_runtimelinking in - yes,aix,yes) ;; # shared object as lib.so file only - yes,svr4,*) ;; # shared object as lib.so archive member only - yes,*) enable_static=no ;; # shared object in lib.a archive as well - esac - fi - ;; - esac - AC_MSG_RESULT([$enable_shared]) - - AC_MSG_CHECKING([whether to build static libraries]) - # Make sure either enable_shared or enable_static is yes. - test yes = "$enable_shared" || enable_static=yes - AC_MSG_RESULT([$enable_static]) - - _LT_TAGVAR(GCC, $1)=$G77 - _LT_TAGVAR(LD, $1)=$LD - - ## CAVEAT EMPTOR: - ## There is no encapsulation within the following macros, do not change - ## the running order or otherwise move them around unless you know exactly - ## what you are doing... - _LT_COMPILER_PIC($1) - _LT_COMPILER_C_O($1) - _LT_COMPILER_FILE_LOCKS($1) - _LT_LINKER_SHLIBS($1) - _LT_SYS_DYNAMIC_LINKER($1) - _LT_LINKER_HARDCODE_LIBPATH($1) - - _LT_CONFIG($1) - fi # test -n "$compiler" - - GCC=$lt_save_GCC - CC=$lt_save_CC - CFLAGS=$lt_save_CFLAGS -fi # test yes != "$_lt_disable_F77" - -AC_LANG_POP -])# _LT_LANG_F77_CONFIG - - -# _LT_LANG_FC_CONFIG([TAG]) -# ------------------------- -# Ensure that the configuration variables for a Fortran compiler are -# suitably defined. These variables are subsequently used by _LT_CONFIG -# to write the compiler configuration to 'libtool'. -m4_defun([_LT_LANG_FC_CONFIG], -[AC_LANG_PUSH(Fortran) - -if test -z "$FC" || test no = "$FC"; then - _lt_disable_FC=yes -fi - -_LT_TAGVAR(archive_cmds_need_lc, $1)=no -_LT_TAGVAR(allow_undefined_flag, $1)= -_LT_TAGVAR(always_export_symbols, $1)=no -_LT_TAGVAR(archive_expsym_cmds, $1)= -_LT_TAGVAR(export_dynamic_flag_spec, $1)= -_LT_TAGVAR(hardcode_direct, $1)=no -_LT_TAGVAR(hardcode_direct_absolute, $1)=no -_LT_TAGVAR(hardcode_libdir_flag_spec, $1)= -_LT_TAGVAR(hardcode_libdir_separator, $1)= -_LT_TAGVAR(hardcode_minus_L, $1)=no -_LT_TAGVAR(hardcode_automatic, $1)=no -_LT_TAGVAR(inherit_rpath, $1)=no -_LT_TAGVAR(module_cmds, $1)= -_LT_TAGVAR(module_expsym_cmds, $1)= -_LT_TAGVAR(link_all_deplibs, $1)=unknown -_LT_TAGVAR(old_archive_cmds, $1)=$old_archive_cmds -_LT_TAGVAR(reload_flag, $1)=$reload_flag -_LT_TAGVAR(reload_cmds, $1)=$reload_cmds -_LT_TAGVAR(no_undefined_flag, $1)= -_LT_TAGVAR(whole_archive_flag_spec, $1)= -_LT_TAGVAR(enable_shared_with_static_runtimes, $1)=no - -# Source file extension for fc test sources. -ac_ext=${ac_fc_srcext-f} - -# Object file extension for compiled fc test sources. -objext=o -_LT_TAGVAR(objext, $1)=$objext - -# No sense in running all these tests if we already determined that -# the FC compiler isn't working. Some variables (like enable_shared) -# are currently assumed to apply to all compilers on this platform, -# and will be corrupted by setting them based on a non-working compiler. -if test yes != "$_lt_disable_FC"; then - # Code to be used in simple compile tests - lt_simple_compile_test_code="\ - subroutine t - return - end -" - - # Code to be used in simple link tests - lt_simple_link_test_code="\ - program t - end -" - - # ltmain only uses $CC for tagged configurations so make sure $CC is set. - _LT_TAG_COMPILER - - # save warnings/boilerplate of simple test code - _LT_COMPILER_BOILERPLATE - _LT_LINKER_BOILERPLATE - - # Allow CC to be a program name with arguments. - lt_save_CC=$CC - lt_save_GCC=$GCC - lt_save_CFLAGS=$CFLAGS - CC=${FC-"f95"} - CFLAGS=$FCFLAGS - compiler=$CC - GCC=$ac_cv_fc_compiler_gnu - - _LT_TAGVAR(compiler, $1)=$CC - _LT_CC_BASENAME([$compiler]) - - if test -n "$compiler"; then - AC_MSG_CHECKING([if libtool supports shared libraries]) - AC_MSG_RESULT([$can_build_shared]) - - AC_MSG_CHECKING([whether to build shared libraries]) - test no = "$can_build_shared" && enable_shared=no - - # On AIX, shared libraries and static libraries use the same namespace, and - # are all built from PIC. - case $host_os in - aix3*) - test yes = "$enable_shared" && enable_static=no - if test -n "$RANLIB"; then - archive_cmds="$archive_cmds~\$RANLIB \$lib" - postinstall_cmds='$RANLIB $lib' - fi - ;; - aix[[4-9]]*) - if test ia64 != "$host_cpu"; then - case $enable_shared,$with_aix_soname,$aix_use_runtimelinking in - yes,aix,yes) ;; # shared object as lib.so file only - yes,svr4,*) ;; # shared object as lib.so archive member only - yes,*) enable_static=no ;; # shared object in lib.a archive as well - esac - fi - ;; - esac - AC_MSG_RESULT([$enable_shared]) - - AC_MSG_CHECKING([whether to build static libraries]) - # Make sure either enable_shared or enable_static is yes. - test yes = "$enable_shared" || enable_static=yes - AC_MSG_RESULT([$enable_static]) - - _LT_TAGVAR(GCC, $1)=$ac_cv_fc_compiler_gnu - _LT_TAGVAR(LD, $1)=$LD - - ## CAVEAT EMPTOR: - ## There is no encapsulation within the following macros, do not change - ## the running order or otherwise move them around unless you know exactly - ## what you are doing... - _LT_SYS_HIDDEN_LIBDEPS($1) - _LT_COMPILER_PIC($1) - _LT_COMPILER_C_O($1) - _LT_COMPILER_FILE_LOCKS($1) - _LT_LINKER_SHLIBS($1) - _LT_SYS_DYNAMIC_LINKER($1) - _LT_LINKER_HARDCODE_LIBPATH($1) - - _LT_CONFIG($1) - fi # test -n "$compiler" - - GCC=$lt_save_GCC - CC=$lt_save_CC - CFLAGS=$lt_save_CFLAGS -fi # test yes != "$_lt_disable_FC" - -AC_LANG_POP -])# _LT_LANG_FC_CONFIG - - -# _LT_LANG_GCJ_CONFIG([TAG]) -# -------------------------- -# Ensure that the configuration variables for the GNU Java Compiler compiler -# are suitably defined. These variables are subsequently used by _LT_CONFIG -# to write the compiler configuration to 'libtool'. -m4_defun([_LT_LANG_GCJ_CONFIG], -[AC_REQUIRE([LT_PROG_GCJ])dnl -AC_LANG_SAVE - -# Source file extension for Java test sources. -ac_ext=java - -# Object file extension for compiled Java test sources. -objext=o -_LT_TAGVAR(objext, $1)=$objext - -# Code to be used in simple compile tests -lt_simple_compile_test_code="class foo {}" - -# Code to be used in simple link tests -lt_simple_link_test_code='public class conftest { public static void main(String[[]] argv) {}; }' - -# ltmain only uses $CC for tagged configurations so make sure $CC is set. -_LT_TAG_COMPILER - -# save warnings/boilerplate of simple test code -_LT_COMPILER_BOILERPLATE -_LT_LINKER_BOILERPLATE - -# Allow CC to be a program name with arguments. -lt_save_CC=$CC -lt_save_CFLAGS=$CFLAGS -lt_save_GCC=$GCC -GCC=yes -CC=${GCJ-"gcj"} -CFLAGS=$GCJFLAGS -compiler=$CC -_LT_TAGVAR(compiler, $1)=$CC -_LT_TAGVAR(LD, $1)=$LD -_LT_CC_BASENAME([$compiler]) - -# GCJ did not exist at the time GCC didn't implicitly link libc in. -_LT_TAGVAR(archive_cmds_need_lc, $1)=no - -_LT_TAGVAR(old_archive_cmds, $1)=$old_archive_cmds -_LT_TAGVAR(reload_flag, $1)=$reload_flag -_LT_TAGVAR(reload_cmds, $1)=$reload_cmds - -## CAVEAT EMPTOR: -## There is no encapsulation within the following macros, do not change -## the running order or otherwise move them around unless you know exactly -## what you are doing... -if test -n "$compiler"; then - _LT_COMPILER_NO_RTTI($1) - _LT_COMPILER_PIC($1) - _LT_COMPILER_C_O($1) - _LT_COMPILER_FILE_LOCKS($1) - _LT_LINKER_SHLIBS($1) - _LT_LINKER_HARDCODE_LIBPATH($1) - - _LT_CONFIG($1) -fi - -AC_LANG_RESTORE - -GCC=$lt_save_GCC -CC=$lt_save_CC -CFLAGS=$lt_save_CFLAGS -])# _LT_LANG_GCJ_CONFIG - - -# _LT_LANG_GO_CONFIG([TAG]) -# -------------------------- -# Ensure that the configuration variables for the GNU Go compiler -# are suitably defined. These variables are subsequently used by _LT_CONFIG -# to write the compiler configuration to 'libtool'. -m4_defun([_LT_LANG_GO_CONFIG], -[AC_REQUIRE([LT_PROG_GO])dnl -AC_LANG_SAVE - -# Source file extension for Go test sources. -ac_ext=go - -# Object file extension for compiled Go test sources. -objext=o -_LT_TAGVAR(objext, $1)=$objext - -# Code to be used in simple compile tests -lt_simple_compile_test_code="package main; func main() { }" - -# Code to be used in simple link tests -lt_simple_link_test_code='package main; func main() { }' - -# ltmain only uses $CC for tagged configurations so make sure $CC is set. -_LT_TAG_COMPILER - -# save warnings/boilerplate of simple test code -_LT_COMPILER_BOILERPLATE -_LT_LINKER_BOILERPLATE - -# Allow CC to be a program name with arguments. -lt_save_CC=$CC -lt_save_CFLAGS=$CFLAGS -lt_save_GCC=$GCC -GCC=yes -CC=${GOC-"gccgo"} -CFLAGS=$GOFLAGS -compiler=$CC -_LT_TAGVAR(compiler, $1)=$CC -_LT_TAGVAR(LD, $1)=$LD -_LT_CC_BASENAME([$compiler]) - -# Go did not exist at the time GCC didn't implicitly link libc in. -_LT_TAGVAR(archive_cmds_need_lc, $1)=no - -_LT_TAGVAR(old_archive_cmds, $1)=$old_archive_cmds -_LT_TAGVAR(reload_flag, $1)=$reload_flag -_LT_TAGVAR(reload_cmds, $1)=$reload_cmds - -## CAVEAT EMPTOR: -## There is no encapsulation within the following macros, do not change -## the running order or otherwise move them around unless you know exactly -## what you are doing... -if test -n "$compiler"; then - _LT_COMPILER_NO_RTTI($1) - _LT_COMPILER_PIC($1) - _LT_COMPILER_C_O($1) - _LT_COMPILER_FILE_LOCKS($1) - _LT_LINKER_SHLIBS($1) - _LT_LINKER_HARDCODE_LIBPATH($1) - - _LT_CONFIG($1) -fi - -AC_LANG_RESTORE - -GCC=$lt_save_GCC -CC=$lt_save_CC -CFLAGS=$lt_save_CFLAGS -])# _LT_LANG_GO_CONFIG - - -# _LT_LANG_RC_CONFIG([TAG]) -# ------------------------- -# Ensure that the configuration variables for the Windows resource compiler -# are suitably defined. These variables are subsequently used by _LT_CONFIG -# to write the compiler configuration to 'libtool'. -m4_defun([_LT_LANG_RC_CONFIG], -[AC_REQUIRE([LT_PROG_RC])dnl -AC_LANG_SAVE - -# Source file extension for RC test sources. -ac_ext=rc - -# Object file extension for compiled RC test sources. -objext=o -_LT_TAGVAR(objext, $1)=$objext - -# Code to be used in simple compile tests -lt_simple_compile_test_code='sample MENU { MENUITEM "&Soup", 100, CHECKED }' - -# Code to be used in simple link tests -lt_simple_link_test_code=$lt_simple_compile_test_code - -# ltmain only uses $CC for tagged configurations so make sure $CC is set. -_LT_TAG_COMPILER - -# save warnings/boilerplate of simple test code -_LT_COMPILER_BOILERPLATE -_LT_LINKER_BOILERPLATE - -# Allow CC to be a program name with arguments. -lt_save_CC=$CC -lt_save_CFLAGS=$CFLAGS -lt_save_GCC=$GCC -GCC= -CC=${RC-"windres"} -CFLAGS= -compiler=$CC -_LT_TAGVAR(compiler, $1)=$CC -_LT_CC_BASENAME([$compiler]) -_LT_TAGVAR(lt_cv_prog_compiler_c_o, $1)=yes - -if test -n "$compiler"; then - : - _LT_CONFIG($1) -fi - -GCC=$lt_save_GCC -AC_LANG_RESTORE -CC=$lt_save_CC -CFLAGS=$lt_save_CFLAGS -])# _LT_LANG_RC_CONFIG - - -# LT_PROG_GCJ -# ----------- -AC_DEFUN([LT_PROG_GCJ], -[m4_ifdef([AC_PROG_GCJ], [AC_PROG_GCJ], - [m4_ifdef([A][M_PROG_GCJ], [A][M_PROG_GCJ], - [AC_CHECK_TOOL(GCJ, gcj,) - test set = "${GCJFLAGS+set}" || GCJFLAGS="-g -O2" - AC_SUBST(GCJFLAGS)])])[]dnl -]) - -# Old name: -AU_ALIAS([LT_AC_PROG_GCJ], [LT_PROG_GCJ]) -dnl aclocal-1.4 backwards compatibility: -dnl AC_DEFUN([LT_AC_PROG_GCJ], []) - - -# LT_PROG_GO -# ---------- -AC_DEFUN([LT_PROG_GO], -[AC_CHECK_TOOL(GOC, gccgo,) -]) - - -# LT_PROG_RC -# ---------- -AC_DEFUN([LT_PROG_RC], -[AC_CHECK_TOOL(RC, windres,) -]) - -# Old name: -AU_ALIAS([LT_AC_PROG_RC], [LT_PROG_RC]) -dnl aclocal-1.4 backwards compatibility: -dnl AC_DEFUN([LT_AC_PROG_RC], []) - - -# _LT_DECL_EGREP -# -------------- -# If we don't have a new enough Autoconf to choose the best grep -# available, choose the one first in the user's PATH. -m4_defun([_LT_DECL_EGREP], -[AC_REQUIRE([AC_PROG_EGREP])dnl -AC_REQUIRE([AC_PROG_FGREP])dnl -test -z "$GREP" && GREP=grep -_LT_DECL([], [GREP], [1], [A grep program that handles long lines]) -_LT_DECL([], [EGREP], [1], [An ERE matcher]) -_LT_DECL([], [FGREP], [1], [A literal string matcher]) -dnl Non-bleeding-edge autoconf doesn't subst GREP, so do it here too -AC_SUBST([GREP]) -]) - - -# _LT_DECL_OBJDUMP -# -------------- -# If we don't have a new enough Autoconf to choose the best objdump -# available, choose the one first in the user's PATH. -m4_defun([_LT_DECL_OBJDUMP], -[AC_CHECK_TOOL(OBJDUMP, objdump, false) -test -z "$OBJDUMP" && OBJDUMP=objdump -_LT_DECL([], [OBJDUMP], [1], [An object symbol dumper]) -AC_SUBST([OBJDUMP]) -]) - -# _LT_DECL_DLLTOOL -# ---------------- -# Ensure DLLTOOL variable is set. -m4_defun([_LT_DECL_DLLTOOL], -[AC_CHECK_TOOL(DLLTOOL, dlltool, false) -test -z "$DLLTOOL" && DLLTOOL=dlltool -_LT_DECL([], [DLLTOOL], [1], [DLL creation program]) -AC_SUBST([DLLTOOL]) -]) - -# _LT_DECL_SED -# ------------ -# Check for a fully-functional sed program, that truncates -# as few characters as possible. Prefer GNU sed if found. -m4_defun([_LT_DECL_SED], -[AC_PROG_SED -test -z "$SED" && SED=sed -Xsed="$SED -e 1s/^X//" -_LT_DECL([], [SED], [1], [A sed program that does not truncate output]) -_LT_DECL([], [Xsed], ["\$SED -e 1s/^X//"], - [Sed that helps us avoid accidentally triggering echo(1) options like -n]) -])# _LT_DECL_SED - -m4_ifndef([AC_PROG_SED], [ -############################################################ -# NOTE: This macro has been submitted for inclusion into # -# GNU Autoconf as AC_PROG_SED. When it is available in # -# a released version of Autoconf we should remove this # -# macro and use it instead. # -############################################################ - -m4_defun([AC_PROG_SED], -[AC_MSG_CHECKING([for a sed that does not truncate output]) -AC_CACHE_VAL(lt_cv_path_SED, -[# Loop through the user's path and test for sed and gsed. -# Then use that list of sed's as ones to test for truncation. -as_save_IFS=$IFS; IFS=$PATH_SEPARATOR -for as_dir in $PATH -do - IFS=$as_save_IFS - test -z "$as_dir" && as_dir=. - for lt_ac_prog in sed gsed; do - for ac_exec_ext in '' $ac_executable_extensions; do - if $as_executable_p "$as_dir/$lt_ac_prog$ac_exec_ext"; then - lt_ac_sed_list="$lt_ac_sed_list $as_dir/$lt_ac_prog$ac_exec_ext" - fi - done - done -done -IFS=$as_save_IFS -lt_ac_max=0 -lt_ac_count=0 -# Add /usr/xpg4/bin/sed as it is typically found on Solaris -# along with /bin/sed that truncates output. -for lt_ac_sed in $lt_ac_sed_list /usr/xpg4/bin/sed; do - test ! -f "$lt_ac_sed" && continue - cat /dev/null > conftest.in - lt_ac_count=0 - echo $ECHO_N "0123456789$ECHO_C" >conftest.in - # Check for GNU sed and select it if it is found. - if "$lt_ac_sed" --version 2>&1 < /dev/null | grep 'GNU' > /dev/null; then - lt_cv_path_SED=$lt_ac_sed - break - fi - while true; do - cat conftest.in conftest.in >conftest.tmp - mv conftest.tmp conftest.in - cp conftest.in conftest.nl - echo >>conftest.nl - $lt_ac_sed -e 's/a$//' < conftest.nl >conftest.out || break - cmp -s conftest.out conftest.nl || break - # 10000 chars as input seems more than enough - test 10 -lt "$lt_ac_count" && break - lt_ac_count=`expr $lt_ac_count + 1` - if test "$lt_ac_count" -gt "$lt_ac_max"; then - lt_ac_max=$lt_ac_count - lt_cv_path_SED=$lt_ac_sed - fi - done -done -]) -SED=$lt_cv_path_SED -AC_SUBST([SED]) -AC_MSG_RESULT([$SED]) -])#AC_PROG_SED -])#m4_ifndef - -# Old name: -AU_ALIAS([LT_AC_PROG_SED], [AC_PROG_SED]) -dnl aclocal-1.4 backwards compatibility: -dnl AC_DEFUN([LT_AC_PROG_SED], []) - - -# _LT_CHECK_SHELL_FEATURES -# ------------------------ -# Find out whether the shell is Bourne or XSI compatible, -# or has some other useful features. -m4_defun([_LT_CHECK_SHELL_FEATURES], -[if ( (MAIL=60; unset MAIL) || exit) >/dev/null 2>&1; then - lt_unset=unset -else - lt_unset=false -fi -_LT_DECL([], [lt_unset], [0], [whether the shell understands "unset"])dnl - -# test EBCDIC or ASCII -case `echo X|tr X '\101'` in - A) # ASCII based system - # \n is not interpreted correctly by Solaris 8 /usr/ucb/tr - lt_SP2NL='tr \040 \012' - lt_NL2SP='tr \015\012 \040\040' - ;; - *) # EBCDIC based system - lt_SP2NL='tr \100 \n' - lt_NL2SP='tr \r\n \100\100' - ;; -esac -_LT_DECL([SP2NL], [lt_SP2NL], [1], [turn spaces into newlines])dnl -_LT_DECL([NL2SP], [lt_NL2SP], [1], [turn newlines into spaces])dnl -])# _LT_CHECK_SHELL_FEATURES - - -# _LT_PATH_CONVERSION_FUNCTIONS -# ----------------------------- -# Determine what file name conversion functions should be used by -# func_to_host_file (and, implicitly, by func_to_host_path). These are needed -# for certain cross-compile configurations and native mingw. -m4_defun([_LT_PATH_CONVERSION_FUNCTIONS], -[AC_REQUIRE([AC_CANONICAL_HOST])dnl -AC_REQUIRE([AC_CANONICAL_BUILD])dnl -AC_MSG_CHECKING([how to convert $build file names to $host format]) -AC_CACHE_VAL(lt_cv_to_host_file_cmd, -[case $host in - *-*-mingw* ) - case $build in - *-*-mingw* ) # actually msys - lt_cv_to_host_file_cmd=func_convert_file_msys_to_w32 - ;; - *-*-cygwin* ) - lt_cv_to_host_file_cmd=func_convert_file_cygwin_to_w32 - ;; - * ) # otherwise, assume *nix - lt_cv_to_host_file_cmd=func_convert_file_nix_to_w32 - ;; - esac - ;; - *-*-cygwin* ) - case $build in - *-*-mingw* ) # actually msys - lt_cv_to_host_file_cmd=func_convert_file_msys_to_cygwin - ;; - *-*-cygwin* ) - lt_cv_to_host_file_cmd=func_convert_file_noop - ;; - * ) # otherwise, assume *nix - lt_cv_to_host_file_cmd=func_convert_file_nix_to_cygwin - ;; - esac - ;; - * ) # unhandled hosts (and "normal" native builds) - lt_cv_to_host_file_cmd=func_convert_file_noop - ;; -esac -]) -to_host_file_cmd=$lt_cv_to_host_file_cmd -AC_MSG_RESULT([$lt_cv_to_host_file_cmd]) -_LT_DECL([to_host_file_cmd], [lt_cv_to_host_file_cmd], - [0], [convert $build file names to $host format])dnl - -AC_MSG_CHECKING([how to convert $build file names to toolchain format]) -AC_CACHE_VAL(lt_cv_to_tool_file_cmd, -[#assume ordinary cross tools, or native build. -lt_cv_to_tool_file_cmd=func_convert_file_noop -case $host in - *-*-mingw* ) - case $build in - *-*-mingw* ) # actually msys - lt_cv_to_tool_file_cmd=func_convert_file_msys_to_w32 - ;; - esac - ;; -esac -]) -to_tool_file_cmd=$lt_cv_to_tool_file_cmd -AC_MSG_RESULT([$lt_cv_to_tool_file_cmd]) -_LT_DECL([to_tool_file_cmd], [lt_cv_to_tool_file_cmd], - [0], [convert $build files to toolchain format])dnl -])# _LT_PATH_CONVERSION_FUNCTIONS diff -Nru gnucobol-4.0~early~20200606/m4/lt~obsolete.m4 gnucobol-5/m4/lt~obsolete.m4 --- gnucobol-4.0~early~20200606/m4/lt~obsolete.m4 2020-06-06 20:56:36.000000000 +0000 +++ gnucobol-5/m4/lt~obsolete.m4 1970-01-01 00:00:00.000000000 +0000 @@ -1,99 +0,0 @@ -# lt~obsolete.m4 -- aclocal satisfying obsolete definitions. -*-Autoconf-*- -# -# Copyright (C) 2004-2005, 2007, 2009, 2011-2015 Free Software -# Foundation, Inc. -# Written by Scott James Remnant, 2004. -# -# This file is free software; the Free Software Foundation gives -# unlimited permission to copy and/or distribute it, with or without -# modifications, as long as this notice is preserved. - -# serial 5 lt~obsolete.m4 - -# These exist entirely to fool aclocal when bootstrapping libtool. -# -# In the past libtool.m4 has provided macros via AC_DEFUN (or AU_DEFUN), -# which have later been changed to m4_define as they aren't part of the -# exported API, or moved to Autoconf or Automake where they belong. -# -# The trouble is, aclocal is a bit thick. It'll see the old AC_DEFUN -# in /usr/share/aclocal/libtool.m4 and remember it, then when it sees us -# using a macro with the same name in our local m4/libtool.m4 it'll -# pull the old libtool.m4 in (it doesn't see our shiny new m4_define -# and doesn't know about Autoconf macros at all.) -# -# So we provide this file, which has a silly filename so it's always -# included after everything else. This provides aclocal with the -# AC_DEFUNs it wants, but when m4 processes it, it doesn't do anything -# because those macros already exist, or will be overwritten later. -# We use AC_DEFUN over AU_DEFUN for compatibility with aclocal-1.6. -# -# Anytime we withdraw an AC_DEFUN or AU_DEFUN, remember to add it here. -# Yes, that means every name once taken will need to remain here until -# we give up compatibility with versions before 1.7, at which point -# we need to keep only those names which we still refer to. - -# This is to help aclocal find these macros, as it can't see m4_define. -AC_DEFUN([LTOBSOLETE_VERSION], [m4_if([1])]) - -m4_ifndef([AC_LIBTOOL_LINKER_OPTION], [AC_DEFUN([AC_LIBTOOL_LINKER_OPTION])]) -m4_ifndef([AC_PROG_EGREP], [AC_DEFUN([AC_PROG_EGREP])]) -m4_ifndef([_LT_AC_PROG_ECHO_BACKSLASH], [AC_DEFUN([_LT_AC_PROG_ECHO_BACKSLASH])]) -m4_ifndef([_LT_AC_SHELL_INIT], [AC_DEFUN([_LT_AC_SHELL_INIT])]) -m4_ifndef([_LT_AC_SYS_LIBPATH_AIX], [AC_DEFUN([_LT_AC_SYS_LIBPATH_AIX])]) -m4_ifndef([_LT_PROG_LTMAIN], [AC_DEFUN([_LT_PROG_LTMAIN])]) -m4_ifndef([_LT_AC_TAGVAR], [AC_DEFUN([_LT_AC_TAGVAR])]) -m4_ifndef([AC_LTDL_ENABLE_INSTALL], [AC_DEFUN([AC_LTDL_ENABLE_INSTALL])]) -m4_ifndef([AC_LTDL_PREOPEN], [AC_DEFUN([AC_LTDL_PREOPEN])]) -m4_ifndef([_LT_AC_SYS_COMPILER], [AC_DEFUN([_LT_AC_SYS_COMPILER])]) -m4_ifndef([_LT_AC_LOCK], [AC_DEFUN([_LT_AC_LOCK])]) -m4_ifndef([AC_LIBTOOL_SYS_OLD_ARCHIVE], [AC_DEFUN([AC_LIBTOOL_SYS_OLD_ARCHIVE])]) -m4_ifndef([_LT_AC_TRY_DLOPEN_SELF], [AC_DEFUN([_LT_AC_TRY_DLOPEN_SELF])]) -m4_ifndef([AC_LIBTOOL_PROG_CC_C_O], [AC_DEFUN([AC_LIBTOOL_PROG_CC_C_O])]) -m4_ifndef([AC_LIBTOOL_SYS_HARD_LINK_LOCKS], [AC_DEFUN([AC_LIBTOOL_SYS_HARD_LINK_LOCKS])]) -m4_ifndef([AC_LIBTOOL_OBJDIR], [AC_DEFUN([AC_LIBTOOL_OBJDIR])]) -m4_ifndef([AC_LTDL_OBJDIR], [AC_DEFUN([AC_LTDL_OBJDIR])]) -m4_ifndef([AC_LIBTOOL_PROG_LD_HARDCODE_LIBPATH], [AC_DEFUN([AC_LIBTOOL_PROG_LD_HARDCODE_LIBPATH])]) -m4_ifndef([AC_LIBTOOL_SYS_LIB_STRIP], [AC_DEFUN([AC_LIBTOOL_SYS_LIB_STRIP])]) -m4_ifndef([AC_PATH_MAGIC], [AC_DEFUN([AC_PATH_MAGIC])]) -m4_ifndef([AC_PROG_LD_GNU], [AC_DEFUN([AC_PROG_LD_GNU])]) -m4_ifndef([AC_PROG_LD_RELOAD_FLAG], [AC_DEFUN([AC_PROG_LD_RELOAD_FLAG])]) -m4_ifndef([AC_DEPLIBS_CHECK_METHOD], [AC_DEFUN([AC_DEPLIBS_CHECK_METHOD])]) -m4_ifndef([AC_LIBTOOL_PROG_COMPILER_NO_RTTI], [AC_DEFUN([AC_LIBTOOL_PROG_COMPILER_NO_RTTI])]) -m4_ifndef([AC_LIBTOOL_SYS_GLOBAL_SYMBOL_PIPE], [AC_DEFUN([AC_LIBTOOL_SYS_GLOBAL_SYMBOL_PIPE])]) -m4_ifndef([AC_LIBTOOL_PROG_COMPILER_PIC], [AC_DEFUN([AC_LIBTOOL_PROG_COMPILER_PIC])]) -m4_ifndef([AC_LIBTOOL_PROG_LD_SHLIBS], [AC_DEFUN([AC_LIBTOOL_PROG_LD_SHLIBS])]) -m4_ifndef([AC_LIBTOOL_POSTDEP_PREDEP], [AC_DEFUN([AC_LIBTOOL_POSTDEP_PREDEP])]) -m4_ifndef([LT_AC_PROG_EGREP], [AC_DEFUN([LT_AC_PROG_EGREP])]) -m4_ifndef([LT_AC_PROG_SED], [AC_DEFUN([LT_AC_PROG_SED])]) -m4_ifndef([_LT_CC_BASENAME], [AC_DEFUN([_LT_CC_BASENAME])]) -m4_ifndef([_LT_COMPILER_BOILERPLATE], [AC_DEFUN([_LT_COMPILER_BOILERPLATE])]) -m4_ifndef([_LT_LINKER_BOILERPLATE], [AC_DEFUN([_LT_LINKER_BOILERPLATE])]) -m4_ifndef([_AC_PROG_LIBTOOL], [AC_DEFUN([_AC_PROG_LIBTOOL])]) -m4_ifndef([AC_LIBTOOL_SETUP], [AC_DEFUN([AC_LIBTOOL_SETUP])]) -m4_ifndef([_LT_AC_CHECK_DLFCN], [AC_DEFUN([_LT_AC_CHECK_DLFCN])]) -m4_ifndef([AC_LIBTOOL_SYS_DYNAMIC_LINKER], [AC_DEFUN([AC_LIBTOOL_SYS_DYNAMIC_LINKER])]) -m4_ifndef([_LT_AC_TAGCONFIG], [AC_DEFUN([_LT_AC_TAGCONFIG])]) -m4_ifndef([AC_DISABLE_FAST_INSTALL], [AC_DEFUN([AC_DISABLE_FAST_INSTALL])]) -m4_ifndef([_LT_AC_LANG_CXX], [AC_DEFUN([_LT_AC_LANG_CXX])]) -m4_ifndef([_LT_AC_LANG_F77], [AC_DEFUN([_LT_AC_LANG_F77])]) -m4_ifndef([_LT_AC_LANG_GCJ], [AC_DEFUN([_LT_AC_LANG_GCJ])]) -m4_ifndef([AC_LIBTOOL_LANG_C_CONFIG], [AC_DEFUN([AC_LIBTOOL_LANG_C_CONFIG])]) -m4_ifndef([_LT_AC_LANG_C_CONFIG], [AC_DEFUN([_LT_AC_LANG_C_CONFIG])]) -m4_ifndef([AC_LIBTOOL_LANG_CXX_CONFIG], [AC_DEFUN([AC_LIBTOOL_LANG_CXX_CONFIG])]) -m4_ifndef([_LT_AC_LANG_CXX_CONFIG], [AC_DEFUN([_LT_AC_LANG_CXX_CONFIG])]) -m4_ifndef([AC_LIBTOOL_LANG_F77_CONFIG], [AC_DEFUN([AC_LIBTOOL_LANG_F77_CONFIG])]) -m4_ifndef([_LT_AC_LANG_F77_CONFIG], [AC_DEFUN([_LT_AC_LANG_F77_CONFIG])]) -m4_ifndef([AC_LIBTOOL_LANG_GCJ_CONFIG], [AC_DEFUN([AC_LIBTOOL_LANG_GCJ_CONFIG])]) -m4_ifndef([_LT_AC_LANG_GCJ_CONFIG], [AC_DEFUN([_LT_AC_LANG_GCJ_CONFIG])]) -m4_ifndef([AC_LIBTOOL_LANG_RC_CONFIG], [AC_DEFUN([AC_LIBTOOL_LANG_RC_CONFIG])]) -m4_ifndef([_LT_AC_LANG_RC_CONFIG], [AC_DEFUN([_LT_AC_LANG_RC_CONFIG])]) -m4_ifndef([AC_LIBTOOL_CONFIG], [AC_DEFUN([AC_LIBTOOL_CONFIG])]) -m4_ifndef([_LT_AC_FILE_LTDLL_C], [AC_DEFUN([_LT_AC_FILE_LTDLL_C])]) -m4_ifndef([_LT_REQUIRED_DARWIN_CHECKS], [AC_DEFUN([_LT_REQUIRED_DARWIN_CHECKS])]) -m4_ifndef([_LT_AC_PROG_CXXCPP], [AC_DEFUN([_LT_AC_PROG_CXXCPP])]) -m4_ifndef([_LT_PREPARE_SED_QUOTE_VARS], [AC_DEFUN([_LT_PREPARE_SED_QUOTE_VARS])]) -m4_ifndef([_LT_PROG_ECHO_BACKSLASH], [AC_DEFUN([_LT_PROG_ECHO_BACKSLASH])]) -m4_ifndef([_LT_PROG_F77], [AC_DEFUN([_LT_PROG_F77])]) -m4_ifndef([_LT_PROG_FC], [AC_DEFUN([_LT_PROG_FC])]) -m4_ifndef([_LT_PROG_CXX], [AC_DEFUN([_LT_PROG_CXX])]) diff -Nru gnucobol-4.0~early~20200606/m4/ltoptions.m4 gnucobol-5/m4/ltoptions.m4 --- gnucobol-4.0~early~20200606/m4/ltoptions.m4 2020-06-06 20:56:36.000000000 +0000 +++ gnucobol-5/m4/ltoptions.m4 1970-01-01 00:00:00.000000000 +0000 @@ -1,437 +0,0 @@ -# Helper functions for option handling. -*- Autoconf -*- -# -# Copyright (C) 2004-2005, 2007-2009, 2011-2015 Free Software -# Foundation, Inc. -# Written by Gary V. Vaughan, 2004 -# -# This file is free software; the Free Software Foundation gives -# unlimited permission to copy and/or distribute it, with or without -# modifications, as long as this notice is preserved. - -# serial 8 ltoptions.m4 - -# This is to help aclocal find these macros, as it can't see m4_define. -AC_DEFUN([LTOPTIONS_VERSION], [m4_if([1])]) - - -# _LT_MANGLE_OPTION(MACRO-NAME, OPTION-NAME) -# ------------------------------------------ -m4_define([_LT_MANGLE_OPTION], -[[_LT_OPTION_]m4_bpatsubst($1__$2, [[^a-zA-Z0-9_]], [_])]) - - -# _LT_SET_OPTION(MACRO-NAME, OPTION-NAME) -# --------------------------------------- -# Set option OPTION-NAME for macro MACRO-NAME, and if there is a -# matching handler defined, dispatch to it. Other OPTION-NAMEs are -# saved as a flag. -m4_define([_LT_SET_OPTION], -[m4_define(_LT_MANGLE_OPTION([$1], [$2]))dnl -m4_ifdef(_LT_MANGLE_DEFUN([$1], [$2]), - _LT_MANGLE_DEFUN([$1], [$2]), - [m4_warning([Unknown $1 option '$2'])])[]dnl -]) - - -# _LT_IF_OPTION(MACRO-NAME, OPTION-NAME, IF-SET, [IF-NOT-SET]) -# ------------------------------------------------------------ -# Execute IF-SET if OPTION is set, IF-NOT-SET otherwise. -m4_define([_LT_IF_OPTION], -[m4_ifdef(_LT_MANGLE_OPTION([$1], [$2]), [$3], [$4])]) - - -# _LT_UNLESS_OPTIONS(MACRO-NAME, OPTION-LIST, IF-NOT-SET) -# ------------------------------------------------------- -# Execute IF-NOT-SET unless all options in OPTION-LIST for MACRO-NAME -# are set. -m4_define([_LT_UNLESS_OPTIONS], -[m4_foreach([_LT_Option], m4_split(m4_normalize([$2])), - [m4_ifdef(_LT_MANGLE_OPTION([$1], _LT_Option), - [m4_define([$0_found])])])[]dnl -m4_ifdef([$0_found], [m4_undefine([$0_found])], [$3 -])[]dnl -]) - - -# _LT_SET_OPTIONS(MACRO-NAME, OPTION-LIST) -# ---------------------------------------- -# OPTION-LIST is a space-separated list of Libtool options associated -# with MACRO-NAME. If any OPTION has a matching handler declared with -# LT_OPTION_DEFINE, dispatch to that macro; otherwise complain about -# the unknown option and exit. -m4_defun([_LT_SET_OPTIONS], -[# Set options -m4_foreach([_LT_Option], m4_split(m4_normalize([$2])), - [_LT_SET_OPTION([$1], _LT_Option)]) - -m4_if([$1],[LT_INIT],[ - dnl - dnl Simply set some default values (i.e off) if boolean options were not - dnl specified: - _LT_UNLESS_OPTIONS([LT_INIT], [dlopen], [enable_dlopen=no - ]) - _LT_UNLESS_OPTIONS([LT_INIT], [win32-dll], [enable_win32_dll=no - ]) - dnl - dnl If no reference was made to various pairs of opposing options, then - dnl we run the default mode handler for the pair. For example, if neither - dnl 'shared' nor 'disable-shared' was passed, we enable building of shared - dnl archives by default: - _LT_UNLESS_OPTIONS([LT_INIT], [shared disable-shared], [_LT_ENABLE_SHARED]) - _LT_UNLESS_OPTIONS([LT_INIT], [static disable-static], [_LT_ENABLE_STATIC]) - _LT_UNLESS_OPTIONS([LT_INIT], [pic-only no-pic], [_LT_WITH_PIC]) - _LT_UNLESS_OPTIONS([LT_INIT], [fast-install disable-fast-install], - [_LT_ENABLE_FAST_INSTALL]) - _LT_UNLESS_OPTIONS([LT_INIT], [aix-soname=aix aix-soname=both aix-soname=svr4], - [_LT_WITH_AIX_SONAME([aix])]) - ]) -])# _LT_SET_OPTIONS - - -## --------------------------------- ## -## Macros to handle LT_INIT options. ## -## --------------------------------- ## - -# _LT_MANGLE_DEFUN(MACRO-NAME, OPTION-NAME) -# ----------------------------------------- -m4_define([_LT_MANGLE_DEFUN], -[[_LT_OPTION_DEFUN_]m4_bpatsubst(m4_toupper([$1__$2]), [[^A-Z0-9_]], [_])]) - - -# LT_OPTION_DEFINE(MACRO-NAME, OPTION-NAME, CODE) -# ----------------------------------------------- -m4_define([LT_OPTION_DEFINE], -[m4_define(_LT_MANGLE_DEFUN([$1], [$2]), [$3])[]dnl -])# LT_OPTION_DEFINE - - -# dlopen -# ------ -LT_OPTION_DEFINE([LT_INIT], [dlopen], [enable_dlopen=yes -]) - -AU_DEFUN([AC_LIBTOOL_DLOPEN], -[_LT_SET_OPTION([LT_INIT], [dlopen]) -AC_DIAGNOSE([obsolete], -[$0: Remove this warning and the call to _LT_SET_OPTION when you -put the 'dlopen' option into LT_INIT's first parameter.]) -]) - -dnl aclocal-1.4 backwards compatibility: -dnl AC_DEFUN([AC_LIBTOOL_DLOPEN], []) - - -# win32-dll -# --------- -# Declare package support for building win32 dll's. -LT_OPTION_DEFINE([LT_INIT], [win32-dll], -[enable_win32_dll=yes - -case $host in -*-*-cygwin* | *-*-mingw* | *-*-pw32* | *-*-cegcc*) - AC_CHECK_TOOL(AS, as, false) - AC_CHECK_TOOL(DLLTOOL, dlltool, false) - AC_CHECK_TOOL(OBJDUMP, objdump, false) - ;; -esac - -test -z "$AS" && AS=as -_LT_DECL([], [AS], [1], [Assembler program])dnl - -test -z "$DLLTOOL" && DLLTOOL=dlltool -_LT_DECL([], [DLLTOOL], [1], [DLL creation program])dnl - -test -z "$OBJDUMP" && OBJDUMP=objdump -_LT_DECL([], [OBJDUMP], [1], [Object dumper program])dnl -])# win32-dll - -AU_DEFUN([AC_LIBTOOL_WIN32_DLL], -[AC_REQUIRE([AC_CANONICAL_HOST])dnl -_LT_SET_OPTION([LT_INIT], [win32-dll]) -AC_DIAGNOSE([obsolete], -[$0: Remove this warning and the call to _LT_SET_OPTION when you -put the 'win32-dll' option into LT_INIT's first parameter.]) -]) - -dnl aclocal-1.4 backwards compatibility: -dnl AC_DEFUN([AC_LIBTOOL_WIN32_DLL], []) - - -# _LT_ENABLE_SHARED([DEFAULT]) -# ---------------------------- -# implement the --enable-shared flag, and supports the 'shared' and -# 'disable-shared' LT_INIT options. -# DEFAULT is either 'yes' or 'no'. If omitted, it defaults to 'yes'. -m4_define([_LT_ENABLE_SHARED], -[m4_define([_LT_ENABLE_SHARED_DEFAULT], [m4_if($1, no, no, yes)])dnl -AC_ARG_ENABLE([shared], - [AS_HELP_STRING([--enable-shared@<:@=PKGS@:>@], - [build shared libraries @<:@default=]_LT_ENABLE_SHARED_DEFAULT[@:>@])], - [p=${PACKAGE-default} - case $enableval in - yes) enable_shared=yes ;; - no) enable_shared=no ;; - *) - enable_shared=no - # Look at the argument we got. We use all the common list separators. - lt_save_ifs=$IFS; IFS=$IFS$PATH_SEPARATOR, - for pkg in $enableval; do - IFS=$lt_save_ifs - if test "X$pkg" = "X$p"; then - enable_shared=yes - fi - done - IFS=$lt_save_ifs - ;; - esac], - [enable_shared=]_LT_ENABLE_SHARED_DEFAULT) - - _LT_DECL([build_libtool_libs], [enable_shared], [0], - [Whether or not to build shared libraries]) -])# _LT_ENABLE_SHARED - -LT_OPTION_DEFINE([LT_INIT], [shared], [_LT_ENABLE_SHARED([yes])]) -LT_OPTION_DEFINE([LT_INIT], [disable-shared], [_LT_ENABLE_SHARED([no])]) - -# Old names: -AC_DEFUN([AC_ENABLE_SHARED], -[_LT_SET_OPTION([LT_INIT], m4_if([$1], [no], [disable-])[shared]) -]) - -AC_DEFUN([AC_DISABLE_SHARED], -[_LT_SET_OPTION([LT_INIT], [disable-shared]) -]) - -AU_DEFUN([AM_ENABLE_SHARED], [AC_ENABLE_SHARED($@)]) -AU_DEFUN([AM_DISABLE_SHARED], [AC_DISABLE_SHARED($@)]) - -dnl aclocal-1.4 backwards compatibility: -dnl AC_DEFUN([AM_ENABLE_SHARED], []) -dnl AC_DEFUN([AM_DISABLE_SHARED], []) - - - -# _LT_ENABLE_STATIC([DEFAULT]) -# ---------------------------- -# implement the --enable-static flag, and support the 'static' and -# 'disable-static' LT_INIT options. -# DEFAULT is either 'yes' or 'no'. If omitted, it defaults to 'yes'. -m4_define([_LT_ENABLE_STATIC], -[m4_define([_LT_ENABLE_STATIC_DEFAULT], [m4_if($1, no, no, yes)])dnl -AC_ARG_ENABLE([static], - [AS_HELP_STRING([--enable-static@<:@=PKGS@:>@], - [build static libraries @<:@default=]_LT_ENABLE_STATIC_DEFAULT[@:>@])], - [p=${PACKAGE-default} - case $enableval in - yes) enable_static=yes ;; - no) enable_static=no ;; - *) - enable_static=no - # Look at the argument we got. We use all the common list separators. - lt_save_ifs=$IFS; IFS=$IFS$PATH_SEPARATOR, - for pkg in $enableval; do - IFS=$lt_save_ifs - if test "X$pkg" = "X$p"; then - enable_static=yes - fi - done - IFS=$lt_save_ifs - ;; - esac], - [enable_static=]_LT_ENABLE_STATIC_DEFAULT) - - _LT_DECL([build_old_libs], [enable_static], [0], - [Whether or not to build static libraries]) -])# _LT_ENABLE_STATIC - -LT_OPTION_DEFINE([LT_INIT], [static], [_LT_ENABLE_STATIC([yes])]) -LT_OPTION_DEFINE([LT_INIT], [disable-static], [_LT_ENABLE_STATIC([no])]) - -# Old names: -AC_DEFUN([AC_ENABLE_STATIC], -[_LT_SET_OPTION([LT_INIT], m4_if([$1], [no], [disable-])[static]) -]) - -AC_DEFUN([AC_DISABLE_STATIC], -[_LT_SET_OPTION([LT_INIT], [disable-static]) -]) - -AU_DEFUN([AM_ENABLE_STATIC], [AC_ENABLE_STATIC($@)]) -AU_DEFUN([AM_DISABLE_STATIC], [AC_DISABLE_STATIC($@)]) - -dnl aclocal-1.4 backwards compatibility: -dnl AC_DEFUN([AM_ENABLE_STATIC], []) -dnl AC_DEFUN([AM_DISABLE_STATIC], []) - - - -# _LT_ENABLE_FAST_INSTALL([DEFAULT]) -# ---------------------------------- -# implement the --enable-fast-install flag, and support the 'fast-install' -# and 'disable-fast-install' LT_INIT options. -# DEFAULT is either 'yes' or 'no'. If omitted, it defaults to 'yes'. -m4_define([_LT_ENABLE_FAST_INSTALL], -[m4_define([_LT_ENABLE_FAST_INSTALL_DEFAULT], [m4_if($1, no, no, yes)])dnl -AC_ARG_ENABLE([fast-install], - [AS_HELP_STRING([--enable-fast-install@<:@=PKGS@:>@], - [optimize for fast installation @<:@default=]_LT_ENABLE_FAST_INSTALL_DEFAULT[@:>@])], - [p=${PACKAGE-default} - case $enableval in - yes) enable_fast_install=yes ;; - no) enable_fast_install=no ;; - *) - enable_fast_install=no - # Look at the argument we got. We use all the common list separators. - lt_save_ifs=$IFS; IFS=$IFS$PATH_SEPARATOR, - for pkg in $enableval; do - IFS=$lt_save_ifs - if test "X$pkg" = "X$p"; then - enable_fast_install=yes - fi - done - IFS=$lt_save_ifs - ;; - esac], - [enable_fast_install=]_LT_ENABLE_FAST_INSTALL_DEFAULT) - -_LT_DECL([fast_install], [enable_fast_install], [0], - [Whether or not to optimize for fast installation])dnl -])# _LT_ENABLE_FAST_INSTALL - -LT_OPTION_DEFINE([LT_INIT], [fast-install], [_LT_ENABLE_FAST_INSTALL([yes])]) -LT_OPTION_DEFINE([LT_INIT], [disable-fast-install], [_LT_ENABLE_FAST_INSTALL([no])]) - -# Old names: -AU_DEFUN([AC_ENABLE_FAST_INSTALL], -[_LT_SET_OPTION([LT_INIT], m4_if([$1], [no], [disable-])[fast-install]) -AC_DIAGNOSE([obsolete], -[$0: Remove this warning and the call to _LT_SET_OPTION when you put -the 'fast-install' option into LT_INIT's first parameter.]) -]) - -AU_DEFUN([AC_DISABLE_FAST_INSTALL], -[_LT_SET_OPTION([LT_INIT], [disable-fast-install]) -AC_DIAGNOSE([obsolete], -[$0: Remove this warning and the call to _LT_SET_OPTION when you put -the 'disable-fast-install' option into LT_INIT's first parameter.]) -]) - -dnl aclocal-1.4 backwards compatibility: -dnl AC_DEFUN([AC_ENABLE_FAST_INSTALL], []) -dnl AC_DEFUN([AM_DISABLE_FAST_INSTALL], []) - - -# _LT_WITH_AIX_SONAME([DEFAULT]) -# ---------------------------------- -# implement the --with-aix-soname flag, and support the `aix-soname=aix' -# and `aix-soname=both' and `aix-soname=svr4' LT_INIT options. DEFAULT -# is either `aix', `both' or `svr4'. If omitted, it defaults to `aix'. -m4_define([_LT_WITH_AIX_SONAME], -[m4_define([_LT_WITH_AIX_SONAME_DEFAULT], [m4_if($1, svr4, svr4, m4_if($1, both, both, aix))])dnl -shared_archive_member_spec= -case $host,$enable_shared in -power*-*-aix[[5-9]]*,yes) - AC_MSG_CHECKING([which variant of shared library versioning to provide]) - AC_ARG_WITH([aix-soname], - [AS_HELP_STRING([--with-aix-soname=aix|svr4|both], - [shared library versioning (aka "SONAME") variant to provide on AIX, @<:@default=]_LT_WITH_AIX_SONAME_DEFAULT[@:>@.])], - [case $withval in - aix|svr4|both) - ;; - *) - AC_MSG_ERROR([Unknown argument to --with-aix-soname]) - ;; - esac - lt_cv_with_aix_soname=$with_aix_soname], - [AC_CACHE_VAL([lt_cv_with_aix_soname], - [lt_cv_with_aix_soname=]_LT_WITH_AIX_SONAME_DEFAULT) - with_aix_soname=$lt_cv_with_aix_soname]) - AC_MSG_RESULT([$with_aix_soname]) - if test aix != "$with_aix_soname"; then - # For the AIX way of multilib, we name the shared archive member - # based on the bitwidth used, traditionally 'shr.o' or 'shr_64.o', - # and 'shr.imp' or 'shr_64.imp', respectively, for the Import File. - # Even when GNU compilers ignore OBJECT_MODE but need '-maix64' flag, - # the AIX toolchain works better with OBJECT_MODE set (default 32). - if test 64 = "${OBJECT_MODE-32}"; then - shared_archive_member_spec=shr_64 - else - shared_archive_member_spec=shr - fi - fi - ;; -*) - with_aix_soname=aix - ;; -esac - -_LT_DECL([], [shared_archive_member_spec], [0], - [Shared archive member basename, for filename based shared library versioning on AIX])dnl -])# _LT_WITH_AIX_SONAME - -LT_OPTION_DEFINE([LT_INIT], [aix-soname=aix], [_LT_WITH_AIX_SONAME([aix])]) -LT_OPTION_DEFINE([LT_INIT], [aix-soname=both], [_LT_WITH_AIX_SONAME([both])]) -LT_OPTION_DEFINE([LT_INIT], [aix-soname=svr4], [_LT_WITH_AIX_SONAME([svr4])]) - - -# _LT_WITH_PIC([MODE]) -# -------------------- -# implement the --with-pic flag, and support the 'pic-only' and 'no-pic' -# LT_INIT options. -# MODE is either 'yes' or 'no'. If omitted, it defaults to 'both'. -m4_define([_LT_WITH_PIC], -[AC_ARG_WITH([pic], - [AS_HELP_STRING([--with-pic@<:@=PKGS@:>@], - [try to use only PIC/non-PIC objects @<:@default=use both@:>@])], - [lt_p=${PACKAGE-default} - case $withval in - yes|no) pic_mode=$withval ;; - *) - pic_mode=default - # Look at the argument we got. We use all the common list separators. - lt_save_ifs=$IFS; IFS=$IFS$PATH_SEPARATOR, - for lt_pkg in $withval; do - IFS=$lt_save_ifs - if test "X$lt_pkg" = "X$lt_p"; then - pic_mode=yes - fi - done - IFS=$lt_save_ifs - ;; - esac], - [pic_mode=m4_default([$1], [default])]) - -_LT_DECL([], [pic_mode], [0], [What type of objects to build])dnl -])# _LT_WITH_PIC - -LT_OPTION_DEFINE([LT_INIT], [pic-only], [_LT_WITH_PIC([yes])]) -LT_OPTION_DEFINE([LT_INIT], [no-pic], [_LT_WITH_PIC([no])]) - -# Old name: -AU_DEFUN([AC_LIBTOOL_PICMODE], -[_LT_SET_OPTION([LT_INIT], [pic-only]) -AC_DIAGNOSE([obsolete], -[$0: Remove this warning and the call to _LT_SET_OPTION when you -put the 'pic-only' option into LT_INIT's first parameter.]) -]) - -dnl aclocal-1.4 backwards compatibility: -dnl AC_DEFUN([AC_LIBTOOL_PICMODE], []) - -## ----------------- ## -## LTDL_INIT Options ## -## ----------------- ## - -m4_define([_LTDL_MODE], []) -LT_OPTION_DEFINE([LTDL_INIT], [nonrecursive], - [m4_define([_LTDL_MODE], [nonrecursive])]) -LT_OPTION_DEFINE([LTDL_INIT], [recursive], - [m4_define([_LTDL_MODE], [recursive])]) -LT_OPTION_DEFINE([LTDL_INIT], [subproject], - [m4_define([_LTDL_MODE], [subproject])]) - -m4_define([_LTDL_TYPE], []) -LT_OPTION_DEFINE([LTDL_INIT], [installable], - [m4_define([_LTDL_TYPE], [installable])]) -LT_OPTION_DEFINE([LTDL_INIT], [convenience], - [m4_define([_LTDL_TYPE], [convenience])]) diff -Nru gnucobol-4.0~early~20200606/m4/ltsugar.m4 gnucobol-5/m4/ltsugar.m4 --- gnucobol-4.0~early~20200606/m4/ltsugar.m4 2020-06-06 20:56:36.000000000 +0000 +++ gnucobol-5/m4/ltsugar.m4 1970-01-01 00:00:00.000000000 +0000 @@ -1,124 +0,0 @@ -# ltsugar.m4 -- libtool m4 base layer. -*-Autoconf-*- -# -# Copyright (C) 2004-2005, 2007-2008, 2011-2015 Free Software -# Foundation, Inc. -# Written by Gary V. Vaughan, 2004 -# -# This file is free software; the Free Software Foundation gives -# unlimited permission to copy and/or distribute it, with or without -# modifications, as long as this notice is preserved. - -# serial 6 ltsugar.m4 - -# This is to help aclocal find these macros, as it can't see m4_define. -AC_DEFUN([LTSUGAR_VERSION], [m4_if([0.1])]) - - -# lt_join(SEP, ARG1, [ARG2...]) -# ----------------------------- -# Produce ARG1SEPARG2...SEPARGn, omitting [] arguments and their -# associated separator. -# Needed until we can rely on m4_join from Autoconf 2.62, since all earlier -# versions in m4sugar had bugs. -m4_define([lt_join], -[m4_if([$#], [1], [], - [$#], [2], [[$2]], - [m4_if([$2], [], [], [[$2]_])$0([$1], m4_shift(m4_shift($@)))])]) -m4_define([_lt_join], -[m4_if([$#$2], [2], [], - [m4_if([$2], [], [], [[$1$2]])$0([$1], m4_shift(m4_shift($@)))])]) - - -# lt_car(LIST) -# lt_cdr(LIST) -# ------------ -# Manipulate m4 lists. -# These macros are necessary as long as will still need to support -# Autoconf-2.59, which quotes differently. -m4_define([lt_car], [[$1]]) -m4_define([lt_cdr], -[m4_if([$#], 0, [m4_fatal([$0: cannot be called without arguments])], - [$#], 1, [], - [m4_dquote(m4_shift($@))])]) -m4_define([lt_unquote], $1) - - -# lt_append(MACRO-NAME, STRING, [SEPARATOR]) -# ------------------------------------------ -# Redefine MACRO-NAME to hold its former content plus 'SEPARATOR''STRING'. -# Note that neither SEPARATOR nor STRING are expanded; they are appended -# to MACRO-NAME as is (leaving the expansion for when MACRO-NAME is invoked). -# No SEPARATOR is output if MACRO-NAME was previously undefined (different -# than defined and empty). -# -# This macro is needed until we can rely on Autoconf 2.62, since earlier -# versions of m4sugar mistakenly expanded SEPARATOR but not STRING. -m4_define([lt_append], -[m4_define([$1], - m4_ifdef([$1], [m4_defn([$1])[$3]])[$2])]) - - - -# lt_combine(SEP, PREFIX-LIST, INFIX, SUFFIX1, [SUFFIX2...]) -# ---------------------------------------------------------- -# Produce a SEP delimited list of all paired combinations of elements of -# PREFIX-LIST with SUFFIX1 through SUFFIXn. Each element of the list -# has the form PREFIXmINFIXSUFFIXn. -# Needed until we can rely on m4_combine added in Autoconf 2.62. -m4_define([lt_combine], -[m4_if(m4_eval([$# > 3]), [1], - [m4_pushdef([_Lt_sep], [m4_define([_Lt_sep], m4_defn([lt_car]))])]]dnl -[[m4_foreach([_Lt_prefix], [$2], - [m4_foreach([_Lt_suffix], - ]m4_dquote(m4_dquote(m4_shift(m4_shift(m4_shift($@)))))[, - [_Lt_sep([$1])[]m4_defn([_Lt_prefix])[$3]m4_defn([_Lt_suffix])])])])]) - - -# lt_if_append_uniq(MACRO-NAME, VARNAME, [SEPARATOR], [UNIQ], [NOT-UNIQ]) -# ----------------------------------------------------------------------- -# Iff MACRO-NAME does not yet contain VARNAME, then append it (delimited -# by SEPARATOR if supplied) and expand UNIQ, else NOT-UNIQ. -m4_define([lt_if_append_uniq], -[m4_ifdef([$1], - [m4_if(m4_index([$3]m4_defn([$1])[$3], [$3$2$3]), [-1], - [lt_append([$1], [$2], [$3])$4], - [$5])], - [lt_append([$1], [$2], [$3])$4])]) - - -# lt_dict_add(DICT, KEY, VALUE) -# ----------------------------- -m4_define([lt_dict_add], -[m4_define([$1($2)], [$3])]) - - -# lt_dict_add_subkey(DICT, KEY, SUBKEY, VALUE) -# -------------------------------------------- -m4_define([lt_dict_add_subkey], -[m4_define([$1($2:$3)], [$4])]) - - -# lt_dict_fetch(DICT, KEY, [SUBKEY]) -# ---------------------------------- -m4_define([lt_dict_fetch], -[m4_ifval([$3], - m4_ifdef([$1($2:$3)], [m4_defn([$1($2:$3)])]), - m4_ifdef([$1($2)], [m4_defn([$1($2)])]))]) - - -# lt_if_dict_fetch(DICT, KEY, [SUBKEY], VALUE, IF-TRUE, [IF-FALSE]) -# ----------------------------------------------------------------- -m4_define([lt_if_dict_fetch], -[m4_if(lt_dict_fetch([$1], [$2], [$3]), [$4], - [$5], - [$6])]) - - -# lt_dict_filter(DICT, [SUBKEY], VALUE, [SEPARATOR], KEY, [...]) -# -------------------------------------------------------------- -m4_define([lt_dict_filter], -[m4_if([$5], [], [], - [lt_join(m4_quote(m4_default([$4], [[, ]])), - lt_unquote(m4_split(m4_normalize(m4_foreach(_Lt_key, lt_car([m4_shiftn(4, $@)]), - [lt_if_dict_fetch([$1], _Lt_key, [$2], [$3], [_Lt_key ])])))))])[]dnl -]) diff -Nru gnucobol-4.0~early~20200606/m4/ltversion.m4 gnucobol-5/m4/ltversion.m4 --- gnucobol-4.0~early~20200606/m4/ltversion.m4 2020-06-06 20:56:36.000000000 +0000 +++ gnucobol-5/m4/ltversion.m4 1970-01-01 00:00:00.000000000 +0000 @@ -1,23 +0,0 @@ -# ltversion.m4 -- version numbers -*- Autoconf -*- -# -# Copyright (C) 2004, 2011-2015 Free Software Foundation, Inc. -# Written by Scott James Remnant, 2004 -# -# This file is free software; the Free Software Foundation gives -# unlimited permission to copy and/or distribute it, with or without -# modifications, as long as this notice is preserved. - -# @configure_input@ - -# serial 4179 ltversion.m4 -# This file is part of GNU Libtool - -m4_define([LT_PACKAGE_VERSION], [2.4.6]) -m4_define([LT_PACKAGE_REVISION], [2.4.6]) - -AC_DEFUN([LTVERSION_VERSION], -[macro_version='2.4.6' -macro_revision='2.4.6' -_LT_DECL(, macro_version, 0, [Which release of libtool.m4 was used?]) -_LT_DECL(, macro_revision, 0) -]) diff -Nru gnucobol-4.0~early~20200606/m4/m4_ax_check_define.m4 gnucobol-5/m4/m4_ax_check_define.m4 --- gnucobol-4.0~early~20200606/m4/m4_ax_check_define.m4 2020-06-06 20:56:36.000000000 +0000 +++ gnucobol-5/m4/m4_ax_check_define.m4 1970-01-01 00:00:00.000000000 +0000 @@ -1,73 +0,0 @@ -# =========================================================================== -# https://www.gnu.org/software/autoconf-archive/ax_check_define.html -# =========================================================================== -# -# SYNOPSIS -# -# AC_CHECK_DEFINE([symbol], [ACTION-IF-FOUND], [ACTION-IF-NOT]) -# AX_CHECK_DEFINE([includes],[symbol], [ACTION-IF-FOUND], [ACTION-IF-NOT]) -# -# DESCRIPTION -# -# Complements AC_CHECK_FUNC but it does not check for a function but for a -# define to exist. Consider a usage like: -# -# AC_CHECK_DEFINE(__STRICT_ANSI__, CFLAGS="$CFLAGS -D_XOPEN_SOURCE=500") -# -# LICENSE -# -# Copyright (c) 2008 Guido U. Draheim -# -# Copying and distribution of this file, with or without modification, are -# permitted in any medium without royalty provided the copyright notice -# and this notice are preserved. This file is offered as-is, without any -# warranty. - -#serial 11 - -AU_ALIAS([AC_CHECK_DEFINED], [AC_CHECK_DEFINE]) -AC_DEFUN([AC_CHECK_DEFINE],[ -AS_VAR_PUSHDEF([ac_var],[ac_cv_defined_$1])dnl -AC_CACHE_CHECK([for $1 defined], ac_var, -AC_COMPILE_IFELSE([AC_LANG_PROGRAM([[]], [[ - #ifdef $1 - int ok; - (void)ok; - #else - choke me - #endif -]])],[AS_VAR_SET(ac_var, yes)],[AS_VAR_SET(ac_var, no)])) -AS_IF([test AS_VAR_GET(ac_var) != "no"], [$2], [$3])dnl -AS_VAR_POPDEF([ac_var])dnl -]) - -AU_ALIAS([AX_CHECK_DEFINED], [AX_CHECK_DEFINE]) -AC_DEFUN([AX_CHECK_DEFINE],[ -AS_VAR_PUSHDEF([ac_var],[ac_cv_defined_$2_$1])dnl -AC_CACHE_CHECK([for $2 defined in $1], ac_var, -AC_COMPILE_IFELSE([AC_LANG_PROGRAM([[#include <$1>]], [[ - #ifdef $2 - int ok; - (void)ok; - #else - choke me - #endif -]])],[AS_VAR_SET(ac_var, yes)],[AS_VAR_SET(ac_var, no)])) -AS_IF([test AS_VAR_GET(ac_var) != "no"], [$3], [$4])dnl -AS_VAR_POPDEF([ac_var])dnl -]) - -AC_DEFUN([AX_CHECK_FUNC], -[AS_VAR_PUSHDEF([ac_var], [ac_cv_func_$2])dnl -AC_CACHE_CHECK([for $2], ac_var, -dnl AC_LANG_FUNC_LINK_TRY -[AC_LINK_IFELSE([AC_LANG_PROGRAM([$1 - #undef $2 - char $2 ();],[ - char (*f) () = $2; - return f != $2; ])], - [AS_VAR_SET(ac_var, yes)], - [AS_VAR_SET(ac_var, no)])]) -AS_IF([test AS_VAR_GET(ac_var) = yes], [$3], [$4])dnl -AS_VAR_POPDEF([ac_var])dnl -])# AC_CHECK_FUNC diff -Nru gnucobol-4.0~early~20200606/m4/m4_ax_code_coverage.m4 gnucobol-5/m4/m4_ax_code_coverage.m4 --- gnucobol-4.0~early~20200606/m4/m4_ax_code_coverage.m4 2020-06-06 20:56:36.000000000 +0000 +++ gnucobol-5/m4/m4_ax_code_coverage.m4 1970-01-01 00:00:00.000000000 +0000 @@ -1,264 +0,0 @@ -# =========================================================================== -# https://www.gnu.org/software/autoconf-archive/ax_code_coverage.html -# =========================================================================== -# -# SYNOPSIS -# -# AX_CODE_COVERAGE() -# -# DESCRIPTION -# -# Defines CODE_COVERAGE_CPPFLAGS, CODE_COVERAGE_CFLAGS, -# CODE_COVERAGE_CXXFLAGS and CODE_COVERAGE_LIBS which should be included -# in the CPPFLAGS, CFLAGS CXXFLAGS and LIBS/LIBADD variables of every -# build target (program or library) which should be built with code -# coverage support. Also defines CODE_COVERAGE_RULES which should be -# substituted in your Makefile; and $enable_code_coverage which can be -# used in subsequent configure output. CODE_COVERAGE_ENABLED is defined -# and substituted, and corresponds to the value of the -# --enable-code-coverage option, which defaults to being disabled. -# -# Test also for gcov program and create GCOV variable that could be -# substituted. -# -# Note that all optimization flags in CFLAGS must be disabled when code -# coverage is enabled. -# -# Usage example: -# -# configure.ac: -# -# AX_CODE_COVERAGE -# -# Makefile.am: -# -# @CODE_COVERAGE_RULES@ -# my_program_LIBS = ... $(CODE_COVERAGE_LIBS) ... -# my_program_CPPFLAGS = ... $(CODE_COVERAGE_CPPFLAGS) ... -# my_program_CFLAGS = ... $(CODE_COVERAGE_CFLAGS) ... -# my_program_CXXFLAGS = ... $(CODE_COVERAGE_CXXFLAGS) ... -# -# This results in a "check-code-coverage" rule being added to any -# Makefile.am which includes "@CODE_COVERAGE_RULES@" (assuming the module -# has been configured with --enable-code-coverage). Running `make -# check-code-coverage` in that directory will run the module's test suite -# (`make check`) and build a code coverage report detailing the code which -# was touched, then print the URI for the report. -# -# In earlier versions of this macro, CODE_COVERAGE_LDFLAGS was defined -# instead of CODE_COVERAGE_LIBS. They are both still defined, but use of -# CODE_COVERAGE_LIBS is preferred for clarity; CODE_COVERAGE_LDFLAGS is -# deprecated. They have the same value. -# -# This code was derived from Makefile.decl in GLib, originally licenced -# under LGPLv2.1+. -# -# LICENSE -# -# Copyright (c) 2012, 2016 Philip Withnall -# Copyright (c) 2012 Xan Lopez -# Copyright (c) 2012 Christian Persch -# Copyright (c) 2012 Paolo Borelli -# Copyright (c) 2012 Dan Winship -# Copyright (c) 2015 Bastien ROUCARIES -# -# This library is free software; you can redistribute it and/or modify it -# under the terms of the GNU Lesser General Public License as published by -# the Free Software Foundation; either version 2.1 of the License, or (at -# your option) any later version. -# -# This library is distributed in the hope that it will be useful, but -# WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser -# General Public License for more details. -# -# You should have received a copy of the GNU Lesser General Public License -# along with this program. If not, see . - -#serial 24 - -AC_DEFUN([AX_CODE_COVERAGE],[ - dnl Check for --enable-code-coverage - AC_REQUIRE([AC_PROG_SED]) - - # allow to override gcov location - AC_ARG_WITH([gcov], - [AS_HELP_STRING([--with-gcov[=GCOV]], [use given GCOV for coverage (GCOV=gcov).])], - [_AX_CODE_COVERAGE_GCOV_PROG_WITH=$with_gcov], - [_AX_CODE_COVERAGE_GCOV_PROG_WITH=gcov]) - - AC_MSG_CHECKING([whether to build with code coverage support]) - AC_ARG_ENABLE([code-coverage], - AS_HELP_STRING([--enable-code-coverage], - [Whether to enable code coverage support]),, - enable_code_coverage=no) - - AM_CONDITIONAL([CODE_COVERAGE_ENABLED], [test x$enable_code_coverage = xyes]) - AC_SUBST([CODE_COVERAGE_ENABLED], [$enable_code_coverage]) - AC_MSG_RESULT($enable_code_coverage) - - AS_IF([ test "$enable_code_coverage" = "yes" ], [ - # check for gcov - AC_CHECK_TOOL([GCOV], - [$_AX_CODE_COVERAGE_GCOV_PROG_WITH], - [:]) - AS_IF([test "X$GCOV" = "X:"], - [AC_MSG_ERROR([gcov is needed to do coverage])]) - AC_SUBST([GCOV]) - - dnl Check if gcc is being used - AS_IF([ test "$GCC" = "no" ], [ - AC_MSG_ERROR([not compiling with gcc, which is required for gcov code coverage]) - ]) - - AC_CHECK_PROG([LCOV], [lcov], [lcov]) - AC_CHECK_PROG([GENHTML], [genhtml], [genhtml]) - - AS_IF([ test -z "$LCOV" ], [ - AC_MSG_ERROR([To enable code coverage reporting you must have lcov installed]) - ]) - - AS_IF([ test -z "$GENHTML" ], [ - AC_MSG_ERROR([Could not find genhtml from the lcov package]) - ]) - - dnl Build the code coverage flags - dnl Define CODE_COVERAGE_LDFLAGS for backwards compatibility - CODE_COVERAGE_CPPFLAGS="-DNDEBUG" - CODE_COVERAGE_CFLAGS="-O0 -g -fprofile-arcs -ftest-coverage" - CODE_COVERAGE_CXXFLAGS="-O0 -g -fprofile-arcs -ftest-coverage" - CODE_COVERAGE_LIBS="-lgcov" - CODE_COVERAGE_LDFLAGS="$CODE_COVERAGE_LIBS" - - AC_SUBST([CODE_COVERAGE_CPPFLAGS]) - AC_SUBST([CODE_COVERAGE_CFLAGS]) - AC_SUBST([CODE_COVERAGE_CXXFLAGS]) - AC_SUBST([CODE_COVERAGE_LIBS]) - AC_SUBST([CODE_COVERAGE_LDFLAGS]) - - [CODE_COVERAGE_RULES_CHECK=' - -$(A''M_V_at)$(MAKE) $(AM_MAKEFLAGS) -k check - $(A''M_V_at)$(MAKE) $(AM_MAKEFLAGS) code-coverage-capture -'] - [CODE_COVERAGE_RULES_CAPTURE=' - $(code_coverage_v_lcov_cap)$(LCOV) $(code_coverage_quiet) $(addprefix --directory ,$(CODE_COVERAGE_DIRECTORY)) --capture --output-file "$(CODE_COVERAGE_OUTPUT_FILE).tmp" --test-name "$(call code_coverage_sanitize,$(PACKAGE_NAME)-$(PACKAGE_VERSION))" --no-checksum --compat-libtool $(CODE_COVERAGE_LCOV_SHOPTS) $(CODE_COVERAGE_LCOV_OPTIONS) - $(code_coverage_v_lcov_ign)$(LCOV) $(code_coverage_quiet) $(addprefix --directory ,$(CODE_COVERAGE_DIRECTORY)) --remove "$(CODE_COVERAGE_OUTPUT_FILE).tmp" "/tmp/*" $(CODE_COVERAGE_IGNORE_PATTERN) --output-file "$(CODE_COVERAGE_OUTPUT_FILE)" $(CODE_COVERAGE_LCOV_SHOPTS) $(CODE_COVERAGE_LCOV_RMOPTS) - -@rm -f $(CODE_COVERAGE_OUTPUT_FILE).tmp - $(code_coverage_v_genhtml)LANG=C $(GENHTML) $(code_coverage_quiet) $(addprefix --prefix ,$(CODE_COVERAGE_DIRECTORY)) --output-directory "$(CODE_COVERAGE_OUTPUT_DIRECTORY)" --title "$(PACKAGE_NAME)-$(PACKAGE_VERSION) Code Coverage" --legend --show-details "$(CODE_COVERAGE_OUTPUT_FILE)" $(CODE_COVERAGE_GENHTML_OPTIONS) - @echo "file://$(abs_builddir)/$(CODE_COVERAGE_OUTPUT_DIRECTORY)/index.html" -'] - [CODE_COVERAGE_RULES_CLEAN=' -clean: code-coverage-clean -distclean: code-coverage-clean -code-coverage-clean: - -$(LCOV) --directory $(top_builddir) -z - -rm -rf $(CODE_COVERAGE_OUTPUT_FILE) $(CODE_COVERAGE_OUTPUT_FILE).tmp $(CODE_COVERAGE_OUTPUT_DIRECTORY) - -find . \( -name "*.gcda" -o -name "*.gcno" -o -name "*.gcov" \) -delete -'] - ], [ - [CODE_COVERAGE_RULES_CHECK=' - @echo "Need to reconfigure with --enable-code-coverage" -'] - CODE_COVERAGE_RULES_CAPTURE="$CODE_COVERAGE_RULES_CHECK" - CODE_COVERAGE_RULES_CLEAN='' - ]) - -[CODE_COVERAGE_RULES=' -# Code coverage -# -# Optional: -# - CODE_COVERAGE_DIRECTORY: Top-level directory for code coverage reporting. -# Multiple directories may be specified, separated by whitespace. -# (Default: $(top_builddir)) -# - CODE_COVERAGE_OUTPUT_FILE: Filename and path for the .info file generated -# by lcov for code coverage. (Default: -# $(PACKAGE_NAME)-$(PACKAGE_VERSION)-coverage.info) -# - CODE_COVERAGE_OUTPUT_DIRECTORY: Directory for generated code coverage -# reports to be created. (Default: -# $(PACKAGE_NAME)-$(PACKAGE_VERSION)-coverage) -# - CODE_COVERAGE_BRANCH_COVERAGE: Set to 1 to enforce branch coverage, -# set to 0 to disable it and leave empty to stay with the default. -# (Default: empty) -# - CODE_COVERAGE_LCOV_SHOPTS_DEFAULT: Extra options shared between both lcov -# instances. (Default: based on $CODE_COVERAGE_BRANCH_COVERAGE) -# - CODE_COVERAGE_LCOV_SHOPTS: Extra options to shared between both lcov -# instances. (Default: $CODE_COVERAGE_LCOV_SHOPTS_DEFAULT) -# - CODE_COVERAGE_LCOV_OPTIONS_GCOVPATH: --gcov-tool pathtogcov -# - CODE_COVERAGE_LCOV_OPTIONS_DEFAULT: Extra options to pass to the -# collecting lcov instance. (Default: $CODE_COVERAGE_LCOV_OPTIONS_GCOVPATH) -# - CODE_COVERAGE_LCOV_OPTIONS: Extra options to pass to the collecting lcov -# instance. (Default: $CODE_COVERAGE_LCOV_OPTIONS_DEFAULT) -# - CODE_COVERAGE_LCOV_RMOPTS_DEFAULT: Extra options to pass to the filtering -# lcov instance. (Default: empty) -# - CODE_COVERAGE_LCOV_RMOPTS: Extra options to pass to the filtering lcov -# instance. (Default: $CODE_COVERAGE_LCOV_RMOPTS_DEFAULT) -# - CODE_COVERAGE_GENHTML_OPTIONS_DEFAULT: Extra options to pass to the -# genhtml instance. (Default: based on $CODE_COVERAGE_BRANCH_COVERAGE) -# - CODE_COVERAGE_GENHTML_OPTIONS: Extra options to pass to the genhtml -# instance. (Default: $CODE_COVERAGE_GENHTML_OPTIONS_DEFAULT) -# - CODE_COVERAGE_IGNORE_PATTERN: Extra glob pattern of files to ignore -# -# The generated report will be titled using the $(PACKAGE_NAME) and -# $(PACKAGE_VERSION). In order to add the current git hash to the title, -# use the git-version-gen script, available online. - -# Optional variables -CODE_COVERAGE_DIRECTORY ?= $(top_builddir) -CODE_COVERAGE_OUTPUT_FILE ?= $(PACKAGE_NAME)-$(PACKAGE_VERSION)-coverage.info -CODE_COVERAGE_OUTPUT_DIRECTORY ?= $(PACKAGE_NAME)-$(PACKAGE_VERSION)-coverage -CODE_COVERAGE_BRANCH_COVERAGE ?= -CODE_COVERAGE_LCOV_SHOPTS_DEFAULT ?= $(if $(CODE_COVERAGE_BRANCH_COVERAGE),\ ---rc lcov_branch_coverage=$(CODE_COVERAGE_BRANCH_COVERAGE)) -CODE_COVERAGE_LCOV_SHOPTS ?= $(CODE_COVERAGE_LCOV_SHOPTS_DEFAULT) -CODE_COVERAGE_LCOV_OPTIONS_GCOVPATH ?= --gcov-tool "$(GCOV)" -CODE_COVERAGE_LCOV_OPTIONS_DEFAULT ?= $(CODE_COVERAGE_LCOV_OPTIONS_GCOVPATH) -CODE_COVERAGE_LCOV_OPTIONS ?= $(CODE_COVERAGE_LCOV_OPTIONS_DEFAULT) -CODE_COVERAGE_LCOV_RMOPTS_DEFAULT ?= -CODE_COVERAGE_LCOV_RMOPTS ?= $(CODE_COVERAGE_LCOV_RMOPTS_DEFAULT) -CODE_COVERAGE_GENHTML_OPTIONS_DEFAULT ?=\ -$(if $(CODE_COVERAGE_BRANCH_COVERAGE),\ ---rc genhtml_branch_coverage=$(CODE_COVERAGE_BRANCH_COVERAGE)) -CODE_COVERAGE_GENHTML_OPTIONS ?= $(CODE_COVERAGE_GENHTML_OPTIONS_DEFAULT) -CODE_COVERAGE_IGNORE_PATTERN ?= - -code_coverage_v_lcov_cap = $(code_coverage_v_lcov_cap_$(V)) -code_coverage_v_lcov_cap_ = $(code_coverage_v_lcov_cap_$(AM_DEFAULT_VERBOSITY)) -code_coverage_v_lcov_cap_0 = @echo " LCOV --capture"\ - $(CODE_COVERAGE_OUTPUT_FILE); -code_coverage_v_lcov_ign = $(code_coverage_v_lcov_ign_$(V)) -code_coverage_v_lcov_ign_ = $(code_coverage_v_lcov_ign_$(AM_DEFAULT_VERBOSITY)) -code_coverage_v_lcov_ign_0 = @echo " LCOV --remove /tmp/*"\ - $(CODE_COVERAGE_IGNORE_PATTERN); -code_coverage_v_genhtml = $(code_coverage_v_genhtml_$(V)) -code_coverage_v_genhtml_ = $(code_coverage_v_genhtml_$(AM_DEFAULT_VERBOSITY)) -code_coverage_v_genhtml_0 = @echo " GEN " $(CODE_COVERAGE_OUTPUT_DIRECTORY); -code_coverage_quiet = $(code_coverage_quiet_$(V)) -code_coverage_quiet_ = $(code_coverage_quiet_$(AM_DEFAULT_VERBOSITY)) -code_coverage_quiet_0 = --quiet - -# sanitizes the test-name: replaces with underscores: dashes and dots -code_coverage_sanitize = $(subst -,_,$(subst .,_,$(1))) - -# Use recursive makes in order to ignore errors during check -check-code-coverage:'"$CODE_COVERAGE_RULES_CHECK"' - -# Capture code coverage data -code-coverage-capture: code-coverage-capture-hook'"$CODE_COVERAGE_RULES_CAPTURE"' - -# Hook rule executed before code-coverage-capture, overridable by the user -code-coverage-capture-hook: - -'"$CODE_COVERAGE_RULES_CLEAN"' - -GITIGNOREFILES ?= -GITIGNOREFILES += $(CODE_COVERAGE_OUTPUT_FILE) $(CODE_COVERAGE_OUTPUT_DIRECTORY) - -A''M_DISTCHECK_CONFIGURE_FLAGS ?= -A''M_DISTCHECK_CONFIGURE_FLAGS += --disable-code-coverage - -.PHONY: check-code-coverage code-coverage-capture code-coverage-capture-hook code-coverage-clean -'] - - AC_SUBST([CODE_COVERAGE_RULES]) - m4_ifdef([_AM_SUBST_NOTMAKE], [_AM_SUBST_NOTMAKE([CODE_COVERAGE_RULES])]) -]) diff -Nru gnucobol-4.0~early~20200606/m4/nls.m4 gnucobol-5/m4/nls.m4 --- gnucobol-4.0~early~20200606/m4/nls.m4 2020-06-06 20:56:36.000000000 +0000 +++ gnucobol-5/m4/nls.m4 1970-01-01 00:00:00.000000000 +0000 @@ -1,32 +0,0 @@ -# nls.m4 serial 5 (gettext-0.18) -dnl Copyright (C) 1995-2003, 2005-2006, 2008-2014, 2016 Free Software -dnl Foundation, Inc. -dnl This file is free software; the Free Software Foundation -dnl gives unlimited permission to copy and/or distribute it, -dnl with or without modifications, as long as this notice is preserved. -dnl -dnl This file can be used in projects which are not available under -dnl the GNU General Public License or the GNU Library General Public -dnl License but which still want to provide support for the GNU gettext -dnl functionality. -dnl Please note that the actual code of the GNU gettext library is covered -dnl by the GNU Library General Public License, and the rest of the GNU -dnl gettext package is covered by the GNU General Public License. -dnl They are *not* in the public domain. - -dnl Authors: -dnl Ulrich Drepper , 1995-2000. -dnl Bruno Haible , 2000-2003. - -AC_PREREQ([2.50]) - -AC_DEFUN([AM_NLS], -[ - AC_MSG_CHECKING([whether NLS is requested]) - dnl Default is enabled NLS - AC_ARG_ENABLE([nls], - [ --disable-nls do not use Native Language Support], - USE_NLS=$enableval, USE_NLS=yes) - AC_MSG_RESULT([$USE_NLS]) - AC_SUBST([USE_NLS]) -]) diff -Nru gnucobol-4.0~early~20200606/m4/pkg.m4 gnucobol-5/m4/pkg.m4 --- gnucobol-4.0~early~20200606/m4/pkg.m4 2020-06-06 20:56:36.000000000 +0000 +++ gnucobol-5/m4/pkg.m4 1970-01-01 00:00:00.000000000 +0000 @@ -1,275 +0,0 @@ -# pkg.m4 - Macros to locate and utilise pkg-config. -*- Autoconf -*- -# serial 12 (pkg-config-0.29.2) - -dnl Copyright © 2004 Scott James Remnant . -dnl Copyright © 2012-2015 Dan Nicholson -dnl -dnl This program is free software; you can redistribute it and/or modify -dnl it under the terms of the GNU General Public License as published by -dnl the Free Software Foundation; either version 2 of the License, or -dnl (at your option) any later version. -dnl -dnl This program is distributed in the hope that it will be useful, but -dnl WITHOUT ANY WARRANTY; without even the implied warranty of -dnl MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU -dnl General Public License for more details. -dnl -dnl You should have received a copy of the GNU General Public License -dnl along with this program; if not, write to the Free Software -dnl Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA -dnl 02111-1307, USA. -dnl -dnl As a special exception to the GNU General Public License, if you -dnl distribute this file as part of a program that contains a -dnl configuration script generated by Autoconf, you may include it under -dnl the same distribution terms that you use for the rest of that -dnl program. - -dnl PKG_PREREQ(MIN-VERSION) -dnl ----------------------- -dnl Since: 0.29 -dnl -dnl Verify that the version of the pkg-config macros are at least -dnl MIN-VERSION. Unlike PKG_PROG_PKG_CONFIG, which checks the user's -dnl installed version of pkg-config, this checks the developer's version -dnl of pkg.m4 when generating configure. -dnl -dnl To ensure that this macro is defined, also add: -dnl m4_ifndef([PKG_PREREQ], -dnl [m4_fatal([must install pkg-config 0.29 or later before running autoconf/autogen])]) -dnl -dnl See the "Since" comment for each macro you use to see what version -dnl of the macros you require. -m4_defun([PKG_PREREQ], -[m4_define([PKG_MACROS_VERSION], [0.29.2]) -m4_if(m4_version_compare(PKG_MACROS_VERSION, [$1]), -1, - [m4_fatal([pkg.m4 version $1 or higher is required but ]PKG_MACROS_VERSION[ found])]) -])dnl PKG_PREREQ - -dnl PKG_PROG_PKG_CONFIG([MIN-VERSION]) -dnl ---------------------------------- -dnl Since: 0.16 -dnl -dnl Search for the pkg-config tool and set the PKG_CONFIG variable to -dnl first found in the path. Checks that the version of pkg-config found -dnl is at least MIN-VERSION. If MIN-VERSION is not specified, 0.9.0 is -dnl used since that's the first version where most current features of -dnl pkg-config existed. -AC_DEFUN([PKG_PROG_PKG_CONFIG], -[m4_pattern_forbid([^_?PKG_[A-Z_]+$]) -m4_pattern_allow([^PKG_CONFIG(_(PATH|LIBDIR|SYSROOT_DIR|ALLOW_SYSTEM_(CFLAGS|LIBS)))?$]) -m4_pattern_allow([^PKG_CONFIG_(DISABLE_UNINSTALLED|TOP_BUILD_DIR|DEBUG_SPEW)$]) -AC_ARG_VAR([PKG_CONFIG], [path to pkg-config utility]) -AC_ARG_VAR([PKG_CONFIG_PATH], [directories to add to pkg-config's search path]) -AC_ARG_VAR([PKG_CONFIG_LIBDIR], [path overriding pkg-config's built-in search path]) - -if test "x$ac_cv_env_PKG_CONFIG_set" != "xset"; then - AC_PATH_TOOL([PKG_CONFIG], [pkg-config]) -fi -if test -n "$PKG_CONFIG"; then - _pkg_min_version=m4_default([$1], [0.9.0]) - AC_MSG_CHECKING([pkg-config is at least version $_pkg_min_version]) - if $PKG_CONFIG --atleast-pkgconfig-version $_pkg_min_version; then - AC_MSG_RESULT([yes]) - else - AC_MSG_RESULT([no]) - PKG_CONFIG="" - fi -fi[]dnl -])dnl PKG_PROG_PKG_CONFIG - -dnl PKG_CHECK_EXISTS(MODULES, [ACTION-IF-FOUND], [ACTION-IF-NOT-FOUND]) -dnl ------------------------------------------------------------------- -dnl Since: 0.18 -dnl -dnl Check to see whether a particular set of modules exists. Similar to -dnl PKG_CHECK_MODULES(), but does not set variables or print errors. -dnl -dnl Please remember that m4 expands AC_REQUIRE([PKG_PROG_PKG_CONFIG]) -dnl only at the first occurence in configure.ac, so if the first place -dnl it's called might be skipped (such as if it is within an "if", you -dnl have to call PKG_CHECK_EXISTS manually -AC_DEFUN([PKG_CHECK_EXISTS], -[AC_REQUIRE([PKG_PROG_PKG_CONFIG])dnl -if test -n "$PKG_CONFIG" && \ - AC_RUN_LOG([$PKG_CONFIG --exists --print-errors "$1"]); then - m4_default([$2], [:]) -m4_ifvaln([$3], [else - $3])dnl -fi]) - -dnl _PKG_CONFIG([VARIABLE], [COMMAND], [MODULES]) -dnl --------------------------------------------- -dnl Internal wrapper calling pkg-config via PKG_CONFIG and setting -dnl pkg_failed based on the result. -m4_define([_PKG_CONFIG], -[if test -n "$$1"; then - pkg_cv_[]$1="$$1" - elif test -n "$PKG_CONFIG"; then - PKG_CHECK_EXISTS([$3], - [pkg_cv_[]$1=`$PKG_CONFIG --[]$2 "$3" 2>/dev/null` - test "x$?" != "x0" && pkg_failed=yes ], - [pkg_failed=yes]) - else - pkg_failed=untried -fi[]dnl -])dnl _PKG_CONFIG - -dnl _PKG_SHORT_ERRORS_SUPPORTED -dnl --------------------------- -dnl Internal check to see if pkg-config supports short errors. -AC_DEFUN([_PKG_SHORT_ERRORS_SUPPORTED], -[AC_REQUIRE([PKG_PROG_PKG_CONFIG]) -if $PKG_CONFIG --atleast-pkgconfig-version 0.20; then - _pkg_short_errors_supported=yes -else - _pkg_short_errors_supported=no -fi[]dnl -])dnl _PKG_SHORT_ERRORS_SUPPORTED - - -dnl PKG_CHECK_MODULES(VARIABLE-PREFIX, MODULES, [ACTION-IF-FOUND], -dnl [ACTION-IF-NOT-FOUND]) -dnl -------------------------------------------------------------- -dnl Since: 0.4.0 -dnl -dnl Note that if there is a possibility the first call to -dnl PKG_CHECK_MODULES might not happen, you should be sure to include an -dnl explicit call to PKG_PROG_PKG_CONFIG in your configure.ac -AC_DEFUN([PKG_CHECK_MODULES], -[AC_REQUIRE([PKG_PROG_PKG_CONFIG])dnl -AC_ARG_VAR([$1][_CFLAGS], [C compiler flags for $1, overriding pkg-config])dnl -AC_ARG_VAR([$1][_LIBS], [linker flags for $1, overriding pkg-config])dnl - -pkg_failed=no -AC_MSG_CHECKING([for $2]) - -_PKG_CONFIG([$1][_CFLAGS], [cflags], [$2]) -_PKG_CONFIG([$1][_LIBS], [libs], [$2]) - -m4_define([_PKG_TEXT], [Alternatively, you may set the environment variables $1[]_CFLAGS -and $1[]_LIBS to avoid the need to call pkg-config. -See the pkg-config man page for more details.]) - -if test $pkg_failed = yes; then - AC_MSG_RESULT([no]) - _PKG_SHORT_ERRORS_SUPPORTED - if test $_pkg_short_errors_supported = yes; then - $1[]_PKG_ERRORS=`$PKG_CONFIG --short-errors --print-errors --cflags --libs "$2" 2>&1` - else - $1[]_PKG_ERRORS=`$PKG_CONFIG --print-errors --cflags --libs "$2" 2>&1` - fi - # Put the nasty error message in config.log where it belongs - echo "$$1[]_PKG_ERRORS" >&AS_MESSAGE_LOG_FD - - m4_default([$4], [AC_MSG_ERROR( -[Package requirements ($2) were not met: - -$$1_PKG_ERRORS - -Consider adjusting the PKG_CONFIG_PATH environment variable if you -installed software in a non-standard prefix. - -_PKG_TEXT])[]dnl - ]) -elif test $pkg_failed = untried; then - AC_MSG_RESULT([no]) - m4_default([$4], [AC_MSG_FAILURE( -[The pkg-config script could not be found or is too old. Make sure it -is in your PATH or set the PKG_CONFIG environment variable to the full -path to pkg-config. - -_PKG_TEXT - -To get pkg-config, see .])[]dnl - ]) -else - $1[]_CFLAGS=$pkg_cv_[]$1[]_CFLAGS - $1[]_LIBS=$pkg_cv_[]$1[]_LIBS - AC_MSG_RESULT([yes]) - $3 -fi[]dnl -])dnl PKG_CHECK_MODULES - - -dnl PKG_CHECK_MODULES_STATIC(VARIABLE-PREFIX, MODULES, [ACTION-IF-FOUND], -dnl [ACTION-IF-NOT-FOUND]) -dnl --------------------------------------------------------------------- -dnl Since: 0.29 -dnl -dnl Checks for existence of MODULES and gathers its build flags with -dnl static libraries enabled. Sets VARIABLE-PREFIX_CFLAGS from --cflags -dnl and VARIABLE-PREFIX_LIBS from --libs. -dnl -dnl Note that if there is a possibility the first call to -dnl PKG_CHECK_MODULES_STATIC might not happen, you should be sure to -dnl include an explicit call to PKG_PROG_PKG_CONFIG in your -dnl configure.ac. -AC_DEFUN([PKG_CHECK_MODULES_STATIC], -[AC_REQUIRE([PKG_PROG_PKG_CONFIG])dnl -_save_PKG_CONFIG=$PKG_CONFIG -PKG_CONFIG="$PKG_CONFIG --static" -PKG_CHECK_MODULES($@) -PKG_CONFIG=$_save_PKG_CONFIG[]dnl -])dnl PKG_CHECK_MODULES_STATIC - - -dnl PKG_INSTALLDIR([DIRECTORY]) -dnl ------------------------- -dnl Since: 0.27 -dnl -dnl Substitutes the variable pkgconfigdir as the location where a module -dnl should install pkg-config .pc files. By default the directory is -dnl $libdir/pkgconfig, but the default can be changed by passing -dnl DIRECTORY. The user can override through the --with-pkgconfigdir -dnl parameter. -AC_DEFUN([PKG_INSTALLDIR], -[m4_pushdef([pkg_default], [m4_default([$1], ['${libdir}/pkgconfig'])]) -m4_pushdef([pkg_description], - [pkg-config installation directory @<:@]pkg_default[@:>@]) -AC_ARG_WITH([pkgconfigdir], - [AS_HELP_STRING([--with-pkgconfigdir], pkg_description)],, - [with_pkgconfigdir=]pkg_default) -AC_SUBST([pkgconfigdir], [$with_pkgconfigdir]) -m4_popdef([pkg_default]) -m4_popdef([pkg_description]) -])dnl PKG_INSTALLDIR - - -dnl PKG_NOARCH_INSTALLDIR([DIRECTORY]) -dnl -------------------------------- -dnl Since: 0.27 -dnl -dnl Substitutes the variable noarch_pkgconfigdir as the location where a -dnl module should install arch-independent pkg-config .pc files. By -dnl default the directory is $datadir/pkgconfig, but the default can be -dnl changed by passing DIRECTORY. The user can override through the -dnl --with-noarch-pkgconfigdir parameter. -AC_DEFUN([PKG_NOARCH_INSTALLDIR], -[m4_pushdef([pkg_default], [m4_default([$1], ['${datadir}/pkgconfig'])]) -m4_pushdef([pkg_description], - [pkg-config arch-independent installation directory @<:@]pkg_default[@:>@]) -AC_ARG_WITH([noarch-pkgconfigdir], - [AS_HELP_STRING([--with-noarch-pkgconfigdir], pkg_description)],, - [with_noarch_pkgconfigdir=]pkg_default) -AC_SUBST([noarch_pkgconfigdir], [$with_noarch_pkgconfigdir]) -m4_popdef([pkg_default]) -m4_popdef([pkg_description]) -])dnl PKG_NOARCH_INSTALLDIR - - -dnl PKG_CHECK_VAR(VARIABLE, MODULE, CONFIG-VARIABLE, -dnl [ACTION-IF-FOUND], [ACTION-IF-NOT-FOUND]) -dnl ------------------------------------------- -dnl Since: 0.28 -dnl -dnl Retrieves the value of the pkg-config variable for the given module. -AC_DEFUN([PKG_CHECK_VAR], -[AC_REQUIRE([PKG_PROG_PKG_CONFIG])dnl -AC_ARG_VAR([$1], [value of $3 for $2, overriding pkg-config])dnl - -_PKG_CONFIG([$1], [variable="][$3]["], [$2]) -AS_VAR_COPY([$1], [pkg_cv_][$1]) - -AS_VAR_IF([$1], [""], [$5], [$4])dnl -])dnl PKG_CHECK_VAR diff -Nru gnucobol-4.0~early~20200606/m4/po.m4 gnucobol-5/m4/po.m4 --- gnucobol-4.0~early~20200606/m4/po.m4 2020-06-06 20:56:36.000000000 +0000 +++ gnucobol-5/m4/po.m4 1970-01-01 00:00:00.000000000 +0000 @@ -1,453 +0,0 @@ -# po.m4 serial 24 (gettext-0.19) -dnl Copyright (C) 1995-2014, 2016 Free Software Foundation, Inc. -dnl This file is free software; the Free Software Foundation -dnl gives unlimited permission to copy and/or distribute it, -dnl with or without modifications, as long as this notice is preserved. -dnl -dnl This file can be used in projects which are not available under -dnl the GNU General Public License or the GNU Library General Public -dnl License but which still want to provide support for the GNU gettext -dnl functionality. -dnl Please note that the actual code of the GNU gettext library is covered -dnl by the GNU Library General Public License, and the rest of the GNU -dnl gettext package is covered by the GNU General Public License. -dnl They are *not* in the public domain. - -dnl Authors: -dnl Ulrich Drepper , 1995-2000. -dnl Bruno Haible , 2000-2003. - -AC_PREREQ([2.60]) - -dnl Checks for all prerequisites of the po subdirectory. -AC_DEFUN([AM_PO_SUBDIRS], -[ - AC_REQUIRE([AC_PROG_MAKE_SET])dnl - AC_REQUIRE([AC_PROG_INSTALL])dnl - AC_REQUIRE([AC_PROG_MKDIR_P])dnl - AC_REQUIRE([AC_PROG_SED])dnl - AC_REQUIRE([AM_NLS])dnl - - dnl Release version of the gettext macros. This is used to ensure that - dnl the gettext macros and po/Makefile.in.in are in sync. - AC_SUBST([GETTEXT_MACRO_VERSION], [0.19]) - - dnl Perform the following tests also if --disable-nls has been given, - dnl because they are needed for "make dist" to work. - - dnl Search for GNU msgfmt in the PATH. - dnl The first test excludes Solaris msgfmt and early GNU msgfmt versions. - dnl The second test excludes FreeBSD msgfmt. - AM_PATH_PROG_WITH_TEST(MSGFMT, msgfmt, - [$ac_dir/$ac_word --statistics /dev/null >&]AS_MESSAGE_LOG_FD[ 2>&1 && - (if $ac_dir/$ac_word --statistics /dev/null 2>&1 >/dev/null | grep usage >/dev/null; then exit 1; else exit 0; fi)], - :) - AC_PATH_PROG([GMSGFMT], [gmsgfmt], [$MSGFMT]) - - dnl Test whether it is GNU msgfmt >= 0.15. -changequote(,)dnl - case `$MSGFMT --version | sed 1q | sed -e 's,^[^0-9]*,,'` in - '' | 0.[0-9] | 0.[0-9].* | 0.1[0-4] | 0.1[0-4].*) MSGFMT_015=: ;; - *) MSGFMT_015=$MSGFMT ;; - esac -changequote([,])dnl - AC_SUBST([MSGFMT_015]) -changequote(,)dnl - case `$GMSGFMT --version | sed 1q | sed -e 's,^[^0-9]*,,'` in - '' | 0.[0-9] | 0.[0-9].* | 0.1[0-4] | 0.1[0-4].*) GMSGFMT_015=: ;; - *) GMSGFMT_015=$GMSGFMT ;; - esac -changequote([,])dnl - AC_SUBST([GMSGFMT_015]) - - dnl Search for GNU xgettext 0.12 or newer in the PATH. - dnl The first test excludes Solaris xgettext and early GNU xgettext versions. - dnl The second test excludes FreeBSD xgettext. - AM_PATH_PROG_WITH_TEST(XGETTEXT, xgettext, - [$ac_dir/$ac_word --omit-header --copyright-holder= --msgid-bugs-address= /dev/null >&]AS_MESSAGE_LOG_FD[ 2>&1 && - (if $ac_dir/$ac_word --omit-header --copyright-holder= --msgid-bugs-address= /dev/null 2>&1 >/dev/null | grep usage >/dev/null; then exit 1; else exit 0; fi)], - :) - dnl Remove leftover from FreeBSD xgettext call. - rm -f messages.po - - dnl Test whether it is GNU xgettext >= 0.15. -changequote(,)dnl - case `$XGETTEXT --version | sed 1q | sed -e 's,^[^0-9]*,,'` in - '' | 0.[0-9] | 0.[0-9].* | 0.1[0-4] | 0.1[0-4].*) XGETTEXT_015=: ;; - *) XGETTEXT_015=$XGETTEXT ;; - esac -changequote([,])dnl - AC_SUBST([XGETTEXT_015]) - - dnl Search for GNU msgmerge 0.11 or newer in the PATH. - AM_PATH_PROG_WITH_TEST(MSGMERGE, msgmerge, - [$ac_dir/$ac_word --update -q /dev/null /dev/null >&]AS_MESSAGE_LOG_FD[ 2>&1], :) - - dnl Installation directories. - dnl Autoconf >= 2.60 defines localedir. For older versions of autoconf, we - dnl have to define it here, so that it can be used in po/Makefile. - test -n "$localedir" || localedir='${datadir}/locale' - AC_SUBST([localedir]) - - dnl Support for AM_XGETTEXT_OPTION. - test -n "${XGETTEXT_EXTRA_OPTIONS+set}" || XGETTEXT_EXTRA_OPTIONS= - AC_SUBST([XGETTEXT_EXTRA_OPTIONS]) - - AC_CONFIG_COMMANDS([po-directories], [[ - for ac_file in $CONFIG_FILES; do - # Support "outfile[:infile[:infile...]]" - case "$ac_file" in - *:*) ac_file=`echo "$ac_file"|sed 's%:.*%%'` ;; - esac - # PO directories have a Makefile.in generated from Makefile.in.in. - case "$ac_file" in */Makefile.in) - # Adjust a relative srcdir. - ac_dir=`echo "$ac_file"|sed 's%/[^/][^/]*$%%'` - ac_dir_suffix=/`echo "$ac_dir"|sed 's%^\./%%'` - ac_dots=`echo "$ac_dir_suffix"|sed 's%/[^/]*%../%g'` - # In autoconf-2.13 it is called $ac_given_srcdir. - # In autoconf-2.50 it is called $srcdir. - test -n "$ac_given_srcdir" || ac_given_srcdir="$srcdir" - case "$ac_given_srcdir" in - .) top_srcdir=`echo $ac_dots|sed 's%/$%%'` ;; - /*) top_srcdir="$ac_given_srcdir" ;; - *) top_srcdir="$ac_dots$ac_given_srcdir" ;; - esac - # Treat a directory as a PO directory if and only if it has a - # POTFILES.in file. This allows packages to have multiple PO - # directories under different names or in different locations. - if test -f "$ac_given_srcdir/$ac_dir/POTFILES.in"; then - rm -f "$ac_dir/POTFILES" - test -n "$as_me" && echo "$as_me: creating $ac_dir/POTFILES" || echo "creating $ac_dir/POTFILES" - gt_tab=`printf '\t'` - cat "$ac_given_srcdir/$ac_dir/POTFILES.in" | sed -e "/^#/d" -e "/^[ ${gt_tab}]*\$/d" -e "s,.*, $top_srcdir/& \\\\," | sed -e "\$s/\(.*\) \\\\/\1/" > "$ac_dir/POTFILES" - POMAKEFILEDEPS="POTFILES.in" - # ALL_LINGUAS, POFILES, UPDATEPOFILES, DUMMYPOFILES, GMOFILES depend - # on $ac_dir but don't depend on user-specified configuration - # parameters. - if test -f "$ac_given_srcdir/$ac_dir/LINGUAS"; then - # The LINGUAS file contains the set of available languages. - if test -n "$OBSOLETE_ALL_LINGUAS"; then - test -n "$as_me" && echo "$as_me: setting ALL_LINGUAS in configure.in is obsolete" || echo "setting ALL_LINGUAS in configure.in is obsolete" - fi - ALL_LINGUAS_=`sed -e "/^#/d" -e "s/#.*//" "$ac_given_srcdir/$ac_dir/LINGUAS"` - # Hide the ALL_LINGUAS assignment from automake < 1.5. - eval 'ALL_LINGUAS''=$ALL_LINGUAS_' - POMAKEFILEDEPS="$POMAKEFILEDEPS LINGUAS" - else - # The set of available languages was given in configure.in. - # Hide the ALL_LINGUAS assignment from automake < 1.5. - eval 'ALL_LINGUAS''=$OBSOLETE_ALL_LINGUAS' - fi - # Compute POFILES - # as $(foreach lang, $(ALL_LINGUAS), $(srcdir)/$(lang).po) - # Compute UPDATEPOFILES - # as $(foreach lang, $(ALL_LINGUAS), $(lang).po-update) - # Compute DUMMYPOFILES - # as $(foreach lang, $(ALL_LINGUAS), $(lang).nop) - # Compute GMOFILES - # as $(foreach lang, $(ALL_LINGUAS), $(srcdir)/$(lang).gmo) - case "$ac_given_srcdir" in - .) srcdirpre= ;; - *) srcdirpre='$(srcdir)/' ;; - esac - POFILES= - UPDATEPOFILES= - DUMMYPOFILES= - GMOFILES= - for lang in $ALL_LINGUAS; do - POFILES="$POFILES $srcdirpre$lang.po" - UPDATEPOFILES="$UPDATEPOFILES $lang.po-update" - DUMMYPOFILES="$DUMMYPOFILES $lang.nop" - GMOFILES="$GMOFILES $srcdirpre$lang.gmo" - done - # CATALOGS depends on both $ac_dir and the user's LINGUAS - # environment variable. - INST_LINGUAS= - if test -n "$ALL_LINGUAS"; then - for presentlang in $ALL_LINGUAS; do - useit=no - if test "%UNSET%" != "$LINGUAS"; then - desiredlanguages="$LINGUAS" - else - desiredlanguages="$ALL_LINGUAS" - fi - for desiredlang in $desiredlanguages; do - # Use the presentlang catalog if desiredlang is - # a. equal to presentlang, or - # b. a variant of presentlang (because in this case, - # presentlang can be used as a fallback for messages - # which are not translated in the desiredlang catalog). - case "$desiredlang" in - "$presentlang"*) useit=yes;; - esac - done - if test $useit = yes; then - INST_LINGUAS="$INST_LINGUAS $presentlang" - fi - done - fi - CATALOGS= - if test -n "$INST_LINGUAS"; then - for lang in $INST_LINGUAS; do - CATALOGS="$CATALOGS $lang.gmo" - done - fi - test -n "$as_me" && echo "$as_me: creating $ac_dir/Makefile" || echo "creating $ac_dir/Makefile" - sed -e "/^POTFILES =/r $ac_dir/POTFILES" -e "/^# Makevars/r $ac_given_srcdir/$ac_dir/Makevars" -e "s|@POFILES@|$POFILES|g" -e "s|@UPDATEPOFILES@|$UPDATEPOFILES|g" -e "s|@DUMMYPOFILES@|$DUMMYPOFILES|g" -e "s|@GMOFILES@|$GMOFILES|g" -e "s|@CATALOGS@|$CATALOGS|g" -e "s|@POMAKEFILEDEPS@|$POMAKEFILEDEPS|g" "$ac_dir/Makefile.in" > "$ac_dir/Makefile" - for f in "$ac_given_srcdir/$ac_dir"/Rules-*; do - if test -f "$f"; then - case "$f" in - *.orig | *.bak | *~) ;; - *) cat "$f" >> "$ac_dir/Makefile" ;; - esac - fi - done - fi - ;; - esac - done]], - [# Capture the value of obsolete ALL_LINGUAS because we need it to compute - # POFILES, UPDATEPOFILES, DUMMYPOFILES, GMOFILES, CATALOGS. But hide it - # from automake < 1.5. - eval 'OBSOLETE_ALL_LINGUAS''="$ALL_LINGUAS"' - # Capture the value of LINGUAS because we need it to compute CATALOGS. - LINGUAS="${LINGUAS-%UNSET%}" - ]) -]) - -dnl Postprocesses a Makefile in a directory containing PO files. -AC_DEFUN([AM_POSTPROCESS_PO_MAKEFILE], -[ - # When this code is run, in config.status, two variables have already been - # set: - # - OBSOLETE_ALL_LINGUAS is the value of LINGUAS set in configure.in, - # - LINGUAS is the value of the environment variable LINGUAS at configure - # time. - -changequote(,)dnl - # Adjust a relative srcdir. - ac_dir=`echo "$ac_file"|sed 's%/[^/][^/]*$%%'` - ac_dir_suffix=/`echo "$ac_dir"|sed 's%^\./%%'` - ac_dots=`echo "$ac_dir_suffix"|sed 's%/[^/]*%../%g'` - # In autoconf-2.13 it is called $ac_given_srcdir. - # In autoconf-2.50 it is called $srcdir. - test -n "$ac_given_srcdir" || ac_given_srcdir="$srcdir" - case "$ac_given_srcdir" in - .) top_srcdir=`echo $ac_dots|sed 's%/$%%'` ;; - /*) top_srcdir="$ac_given_srcdir" ;; - *) top_srcdir="$ac_dots$ac_given_srcdir" ;; - esac - - # Find a way to echo strings without interpreting backslash. - if test "X`(echo '\t') 2>/dev/null`" = 'X\t'; then - gt_echo='echo' - else - if test "X`(printf '%s\n' '\t') 2>/dev/null`" = 'X\t'; then - gt_echo='printf %s\n' - else - echo_func () { - cat < "$ac_file.tmp" - tab=`printf '\t'` - if grep -l '@TCLCATALOGS@' "$ac_file" > /dev/null; then - # Add dependencies that cannot be formulated as a simple suffix rule. - for lang in $ALL_LINGUAS; do - frobbedlang=`echo $lang | sed -e 's/\..*$//' -e 'y/ABCDEFGHIJKLMNOPQRSTUVWXYZ/abcdefghijklmnopqrstuvwxyz/'` - cat >> "$ac_file.tmp" < /dev/null; then - # Add dependencies that cannot be formulated as a simple suffix rule. - for lang in $ALL_LINGUAS; do - frobbedlang=`echo $lang | sed -e 's/_/-/g' -e 's/^sr-CS/sr-SP/' -e 's/@latin$/-Latn/' -e 's/@cyrillic$/-Cyrl/' -e 's/^sr-SP$/sr-SP-Latn/' -e 's/^uz-UZ$/uz-UZ-Latn/'` - cat >> "$ac_file.tmp" <> "$ac_file.tmp" <, 1996. - -AC_PREREQ([2.50]) - -# Search path for a program which passes the given test. - -dnl AM_PATH_PROG_WITH_TEST(VARIABLE, PROG-TO-CHECK-FOR, -dnl TEST-PERFORMED-ON-FOUND_PROGRAM [, VALUE-IF-NOT-FOUND [, PATH]]) -AC_DEFUN([AM_PATH_PROG_WITH_TEST], -[ -# Prepare PATH_SEPARATOR. -# The user is always right. -if test "${PATH_SEPARATOR+set}" != set; then - # Determine PATH_SEPARATOR by trying to find /bin/sh in a PATH which - # contains only /bin. Note that ksh looks also at the FPATH variable, - # so we have to set that as well for the test. - PATH_SEPARATOR=: - (PATH='/bin;/bin'; FPATH=$PATH; sh -c :) >/dev/null 2>&1 \ - && { (PATH='/bin:/bin'; FPATH=$PATH; sh -c :) >/dev/null 2>&1 \ - || PATH_SEPARATOR=';' - } -fi - -# Find out how to test for executable files. Don't use a zero-byte file, -# as systems may use methods other than mode bits to determine executability. -cat >conf$$.file <<_ASEOF -#! /bin/sh -exit 0 -_ASEOF -chmod +x conf$$.file -if test -x conf$$.file >/dev/null 2>&1; then - ac_executable_p="test -x" -else - ac_executable_p="test -f" -fi -rm -f conf$$.file - -# Extract the first word of "$2", so it can be a program name with args. -set dummy $2; ac_word=[$]2 -AC_MSG_CHECKING([for $ac_word]) -AC_CACHE_VAL([ac_cv_path_$1], -[case "[$]$1" in - [[\\/]]* | ?:[[\\/]]*) - ac_cv_path_$1="[$]$1" # Let the user override the test with a path. - ;; - *) - ac_save_IFS="$IFS"; IFS=$PATH_SEPARATOR - for ac_dir in ifelse([$5], , $PATH, [$5]); do - IFS="$ac_save_IFS" - test -z "$ac_dir" && ac_dir=. - for ac_exec_ext in '' $ac_executable_extensions; do - if $ac_executable_p "$ac_dir/$ac_word$ac_exec_ext"; then - echo "$as_me: trying $ac_dir/$ac_word..." >&AS_MESSAGE_LOG_FD - if [$3]; then - ac_cv_path_$1="$ac_dir/$ac_word$ac_exec_ext" - break 2 - fi - fi - done - done - IFS="$ac_save_IFS" -dnl If no 4th arg is given, leave the cache variable unset, -dnl so AC_PATH_PROGS will keep looking. -ifelse([$4], , , [ test -z "[$]ac_cv_path_$1" && ac_cv_path_$1="$4" -])dnl - ;; -esac])dnl -$1="$ac_cv_path_$1" -if test ifelse([$4], , [-n "[$]$1"], ["[$]$1" != "$4"]); then - AC_MSG_RESULT([$][$1]) -else - AC_MSG_RESULT([no]) -fi -AC_SUBST([$1])dnl -]) diff -Nru gnucobol-4.0~early~20200606/Makefile.am gnucobol-5/Makefile.am --- gnucobol-4.0~early~20200606/Makefile.am 2020-06-06 20:52:02.000000000 +0000 +++ gnucobol-5/Makefile.am 1970-01-01 00:00:00.000000000 +0000 @@ -1,129 +0,0 @@ -# -# Makefile gnucobol -# -# Copyright (C) 2003-2012, 2014-2020 Free Software Foundation, Inc. -# Written by Keisuke Nishida, Roger While, Simon Sobisch -# -# This file is part of GnuCOBOL. -# -# The GnuCOBOL compiler is free software: you can redistribute it -# and/or modify it under the terms of the GNU General Public License -# as published by the Free Software Foundation, either version 3 of the -# License, or (at your option) any later version. -# -# GnuCOBOL is distributed in the hope that it will be useful, -# but WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -# GNU General Public License for more details. -# -# You should have received a copy of the GNU General Public License -# along with GnuCOBOL. If not, see . - -include_HEADERS = libcob.h - -SUBDIRS = . lib libcob bin cobc config copy po doc extras tests - -all: tarstamp.h defaults.h - -ACLOCAL_AMFLAGS = -I m4 --install -BUILT_SOURCES = defaults.h -DISTCLEANFILES = $(BUILT_SOURCES) -# CLEANFILES = $(bin_SCRIPTS) -dist_noinst_SCRIPTS = autogen.sh build_aux/bootstrap po/update_linguas.sh \ - build_aux/create_win_dist.sh build_aux/create_mingw_bindist.sh \ - doc/cobcinfo.sh - -# wrapper for the build environment -noinst_SCRIPTS = pre-inst-env - -EXTRA_DIST = gnucobol.spec - -# add rules for code-coverage testing, as defined by AX_CODE_COVERAGE -CODE_COVERAGE_BRANCH_COVERAGE=1 -@CODE_COVERAGE_RULES@ - -# files shipped with the package that should be 755'ed: -FILES_TO_BE_EXECUTABLE = $(dist_noinst_SCRIPTS) \ - configure tests/testsuite tests/listings-sed.sh \ - build_aux/config.guess build_aux/config.sub build_aux/config.rpath \ - build_aux/depcomp build_aux/install-sh build_aux/ltmain.sh build_aux/mdate-sh \ - build_aux/missing build_aux/mkinstalldirs build_aux/ylwrap - -tarstamps = $(top_distdir)/tarstamp.h tarstamp.h - -# all parts but tarstamp.h should not be necessary... -dist-hook: - rm -f $(top_distdir)/tarstamp.h - $(MAKE) $(AM_MAKEFLAGS) $(top_distdir)/tarstamp.h -# fix access to cater for bad version control use / copy / read-only file system - find $(top_distdir) -type d -print | xargs chmod 755 # otherwise directories have 777 - find $(top_distdir) -type f -print | xargs chmod 644 # otherwise files are unchanged but with u+r -# because of the global file change, adjust here again - cd $(top_distdir) && chmod 755 $(FILES_TO_BE_EXECUTABLE) -# fix timestamps to cater for bad version control use / copy - touch $(top_distdir)/m4/*.m4 - touch $(top_distdir)/aclocal.m4 - touch $(top_distdir)/Makefile.in - touch $(top_distdir)/*/Makefile.in - touch $(top_distdir)/*/*/Makefile.in - touch $(top_distdir)/configure - touch $(top_distdir)/config.h.in - touch $(top_distdir)/doc/stamp-vti -# touch $(top_distdir)/cobc/ppparse.c -# touch $(top_distdir)/cobc/parser.c -# touch $(top_distdir)/cobc/pplex.c -# touch $(top_distdir)/cobc/scanner.c -# $(top_distdir)/doc/cobcinfo.sh "fixtimestamps" -# touch $(top_distdir)/libcob/libcob.3 -# touch $(top_distdir)/bin/cobcrun.1 -# touch $(top_distdir)/cobc/cobc.1 - -# Create dist_win manually (dist-zip would have the same content as dist-gzip) -distwindir = $(distdir)_win -distwin: distdir $(top_srcdir)/build_windows $(top_srcdir)/build_aux/create_win_dist.sh - EXTSRCDIR=$(srcdir) EXTDISTDIR=$(distdir) EXTWINDISTDIR=$(distwindir) $(top_srcdir)/build_aux/create_win_dist.sh - -distwin-zip: distwin - rm -f "$(distwindir).zip" - zip -rq "$(distwindir).zip" "$(distwindir)" - -defaults.h: Makefile.am $(top_builddir)/config.status - @echo "Creating $@..." - @{ \ - echo "/* Automatically generated by Makefile */"; \ - echo "#define COB_CC \"$(COB_CC)\""; \ - echo "#define COB_CFLAGS \"$(COB_CFLAGS)\""; \ - echo "#define COB_LDFLAGS \"$(COB_LDFLAGS)\""; \ - echo "#define COB_LIBS \"$(COB_LIBS)\""; \ - echo "#define COB_CONFIG_DIR \"$(COB_CONFIG_DIR)\""; \ - echo "#define COB_COPY_DIR \"$(COB_COPY_DIR)\""; \ - echo "#define COB_SCHEMA_DIR \"$(COB_SCHEMA_DIR)\""; \ - echo "#define COB_LIBRARY_PATH \"$(COB_LIBRARY_PATH)\""; \ - echo "#define COB_BLD_CC \"$(CC)\""; \ - echo "#define COB_BLD_CPPFLAGS \"$(CPPFLAGS)\""; \ - echo "#define COB_BLD_CFLAGS \"$(CFLAGS)\""; \ - echo "#define COB_BLD_LD \"$(LD)\""; \ - echo "#define COB_BLD_LDFLAGS \"$(LDFLAGS)\""; \ - echo "#define COB_BLD_BUILD \"$(build)\""; \ - echo "#define LOCALEDIR \"$(localedir)\""; \ - } > defaults.h - -$(tarstamps): - @echo "Creating $@..." - @{ \ - echo "#define COB_TAR_DATE \"`LC_ALL=C date -u +'%b %d %Y %T'` UTC\""; \ - echo "#define COB_NUM_TAR_DATE ` LC_ALL=C date -u +'%Y%m%d'`"; \ - echo "#define COB_NUM_TAR_TIME ` LC_ALL=C date -u +'%H%M%S'`"; \ - } > $@ - - -# targets that are only logical targets and should always be executed -.PHONY: test checkall checkmanual - -test: all - cd tests && $(MAKE) $(AM_MAKEFLAGS) test -checkmanual: all - cd tests && $(MAKE) $(AM_MAKEFLAGS) checkmanual - -checkall: check test - diff -Nru gnucobol-4.0~early~20200606/Makefile.in gnucobol-5/Makefile.in --- gnucobol-4.0~early~20200606/Makefile.in 2020-06-06 20:56:36.000000000 +0000 +++ gnucobol-5/Makefile.in 1970-01-01 00:00:00.000000000 +0000 @@ -1,1105 +0,0 @@ -# Makefile.in generated by automake 1.15.1 from Makefile.am. -# @configure_input@ - -# Copyright (C) 1994-2017 Free Software Foundation, Inc. - -# This Makefile.in is free software; the Free Software Foundation -# gives unlimited permission to copy and/or distribute it, -# with or without modifications, as long as this notice is preserved. - -# This program is distributed in the hope that it will be useful, -# but WITHOUT ANY WARRANTY, to the extent permitted by law; without -# even the implied warranty of MERCHANTABILITY or FITNESS FOR A -# PARTICULAR PURPOSE. - -@SET_MAKE@ - -# -# Makefile gnucobol -# -# Copyright (C) 2003-2012, 2014-2020 Free Software Foundation, Inc. -# Written by Keisuke Nishida, Roger While, Simon Sobisch -# -# This file is part of GnuCOBOL. -# -# The GnuCOBOL compiler is free software: you can redistribute it -# and/or modify it under the terms of the GNU General Public License -# as published by the Free Software Foundation, either version 3 of the -# License, or (at your option) any later version. -# -# GnuCOBOL is distributed in the hope that it will be useful, -# but WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -# GNU General Public License for more details. -# -# You should have received a copy of the GNU General Public License -# along with GnuCOBOL. If not, see . - - -VPATH = @srcdir@ -am__is_gnu_make = { \ - if test -z '$(MAKELEVEL)'; then \ - false; \ - elif test -n '$(MAKE_HOST)'; then \ - true; \ - elif test -n '$(MAKE_VERSION)' && test -n '$(CURDIR)'; then \ - true; \ - else \ - false; \ - fi; \ -} -am__make_running_with_option = \ - case $${target_option-} in \ - ?) ;; \ - *) echo "am__make_running_with_option: internal error: invalid" \ - "target option '$${target_option-}' specified" >&2; \ - exit 1;; \ - esac; \ - has_opt=no; \ - sane_makeflags=$$MAKEFLAGS; \ - if $(am__is_gnu_make); then \ - sane_makeflags=$$MFLAGS; \ - else \ - case $$MAKEFLAGS in \ - *\\[\ \ ]*) \ - bs=\\; \ - sane_makeflags=`printf '%s\n' "$$MAKEFLAGS" \ - | sed "s/$$bs$$bs[$$bs $$bs ]*//g"`;; \ - esac; \ - fi; \ - skip_next=no; \ - strip_trailopt () \ - { \ - flg=`printf '%s\n' "$$flg" | sed "s/$$1.*$$//"`; \ - }; \ - for flg in $$sane_makeflags; do \ - test $$skip_next = yes && { skip_next=no; continue; }; \ - case $$flg in \ - *=*|--*) continue;; \ - -*I) strip_trailopt 'I'; skip_next=yes;; \ - -*I?*) strip_trailopt 'I';; \ - -*O) strip_trailopt 'O'; skip_next=yes;; \ - -*O?*) strip_trailopt 'O';; \ - -*l) strip_trailopt 'l'; skip_next=yes;; \ - -*l?*) strip_trailopt 'l';; \ - -[dEDm]) skip_next=yes;; \ - -[JT]) skip_next=yes;; \ - esac; \ - case $$flg in \ - *$$target_option*) has_opt=yes; break;; \ - esac; \ - done; \ - test $$has_opt = yes -am__make_dryrun = (target_option=n; $(am__make_running_with_option)) -am__make_keepgoing = (target_option=k; $(am__make_running_with_option)) -pkgdatadir = $(datadir)/@PACKAGE@ -pkgincludedir = $(includedir)/@PACKAGE@ -pkglibdir = $(libdir)/@PACKAGE@ -pkglibexecdir = $(libexecdir)/@PACKAGE@ -am__cd = CDPATH="$${ZSH_VERSION+.}$(PATH_SEPARATOR)" && cd -install_sh_DATA = $(install_sh) -c -m 644 -install_sh_PROGRAM = $(install_sh) -c -install_sh_SCRIPT = $(install_sh) -c -INSTALL_HEADER = $(INSTALL_DATA) -transform = $(program_transform_name) -NORMAL_INSTALL = : -PRE_INSTALL = : -POST_INSTALL = : -NORMAL_UNINSTALL = : -PRE_UNINSTALL = : -POST_UNINSTALL = : -build_triplet = @build@ -host_triplet = @host@ -subdir = . -ACLOCAL_M4 = $(top_srcdir)/aclocal.m4 -am__aclocal_m4_deps = $(top_srcdir)/m4/codeset.m4 \ - $(top_srcdir)/m4/gettext.m4 $(top_srcdir)/m4/iconv.m4 \ - $(top_srcdir)/m4/intlmacosx.m4 $(top_srcdir)/m4/lib-ld.m4 \ - $(top_srcdir)/m4/lib-link.m4 $(top_srcdir)/m4/lib-prefix.m4 \ - $(top_srcdir)/m4/libtool.m4 $(top_srcdir)/m4/ltoptions.m4 \ - $(top_srcdir)/m4/ltsugar.m4 $(top_srcdir)/m4/ltversion.m4 \ - $(top_srcdir)/m4/lt~obsolete.m4 \ - $(top_srcdir)/m4/m4_ax_check_define.m4 \ - $(top_srcdir)/m4/m4_ax_code_coverage.m4 \ - $(top_srcdir)/m4/nls.m4 $(top_srcdir)/m4/pkg.m4 \ - $(top_srcdir)/m4/po.m4 $(top_srcdir)/m4/progtest.m4 \ - $(top_srcdir)/configure.ac -am__configure_deps = $(am__aclocal_m4_deps) $(CONFIGURE_DEPENDENCIES) \ - $(ACLOCAL_M4) -DIST_COMMON = $(srcdir)/Makefile.am $(top_srcdir)/configure \ - $(am__configure_deps) $(dist_noinst_SCRIPTS) \ - $(include_HEADERS) $(am__DIST_COMMON) -am__CONFIG_DISTCLEAN_FILES = config.status config.cache config.log \ - configure.lineno config.status.lineno -mkinstalldirs = $(SHELL) $(top_srcdir)/build_aux/mkinstalldirs -CONFIG_HEADER = config.h -CONFIG_CLEAN_FILES = pre-inst-env -CONFIG_CLEAN_VPATH_FILES = -SCRIPTS = $(dist_noinst_SCRIPTS) $(noinst_SCRIPTS) -AM_V_P = $(am__v_P_@AM_V@) -am__v_P_ = $(am__v_P_@AM_DEFAULT_V@) -am__v_P_0 = false -am__v_P_1 = : -AM_V_GEN = $(am__v_GEN_@AM_V@) -am__v_GEN_ = $(am__v_GEN_@AM_DEFAULT_V@) -am__v_GEN_0 = @echo " GEN " $@; -am__v_GEN_1 = -AM_V_at = $(am__v_at_@AM_V@) -am__v_at_ = $(am__v_at_@AM_DEFAULT_V@) -am__v_at_0 = @ -am__v_at_1 = -SOURCES = -DIST_SOURCES = -RECURSIVE_TARGETS = all-recursive check-recursive cscopelist-recursive \ - ctags-recursive dvi-recursive html-recursive info-recursive \ - install-data-recursive install-dvi-recursive \ - install-exec-recursive install-html-recursive \ - install-info-recursive install-pdf-recursive \ - install-ps-recursive install-recursive installcheck-recursive \ - installdirs-recursive pdf-recursive ps-recursive \ - tags-recursive uninstall-recursive -am__can_run_installinfo = \ - case $$AM_UPDATE_INFO_DIR in \ - n|no|NO) false;; \ - *) (install-info --version) >/dev/null 2>&1;; \ - esac -am__vpath_adj_setup = srcdirstrip=`echo "$(srcdir)" | sed 's|.|.|g'`; -am__vpath_adj = case $$p in \ - $(srcdir)/*) f=`echo "$$p" | sed "s|^$$srcdirstrip/||"`;; \ - *) f=$$p;; \ - esac; -am__strip_dir = f=`echo $$p | sed -e 's|^.*/||'`; -am__install_max = 40 -am__nobase_strip_setup = \ - srcdirstrip=`echo "$(srcdir)" | sed 's/[].[^$$\\*|]/\\\\&/g'` -am__nobase_strip = \ - for p in $$list; do echo "$$p"; done | sed -e "s|$$srcdirstrip/||" -am__nobase_list = $(am__nobase_strip_setup); \ - for p in $$list; do echo "$$p $$p"; done | \ - sed "s| $$srcdirstrip/| |;"' / .*\//!s/ .*/ ./; s,\( .*\)/[^/]*$$,\1,' | \ - $(AWK) 'BEGIN { files["."] = "" } { files[$$2] = files[$$2] " " $$1; \ - if (++n[$$2] == $(am__install_max)) \ - { print $$2, files[$$2]; n[$$2] = 0; files[$$2] = "" } } \ - END { for (dir in files) print dir, files[dir] }' -am__base_list = \ - sed '$$!N;$$!N;$$!N;$$!N;$$!N;$$!N;$$!N;s/\n/ /g' | \ - sed '$$!N;$$!N;$$!N;$$!N;s/\n/ /g' -am__uninstall_files_from_dir = { \ - test -z "$$files" \ - || { test ! -d "$$dir" && test ! -f "$$dir" && test ! -r "$$dir"; } \ - || { echo " ( cd '$$dir' && rm -f" $$files ")"; \ - $(am__cd) "$$dir" && rm -f $$files; }; \ - } -am__installdirs = "$(DESTDIR)$(includedir)" -HEADERS = $(include_HEADERS) -RECURSIVE_CLEAN_TARGETS = mostlyclean-recursive clean-recursive \ - distclean-recursive maintainer-clean-recursive -am__recursive_targets = \ - $(RECURSIVE_TARGETS) \ - $(RECURSIVE_CLEAN_TARGETS) \ - $(am__extra_recursive_targets) -AM_RECURSIVE_TARGETS = $(am__recursive_targets:-recursive=) TAGS CTAGS \ - cscope distdir dist dist-all distcheck -am__tagged_files = $(HEADERS) $(SOURCES) $(TAGS_FILES) \ - $(LISP)config.h.in -# Read a list of newline-separated strings from the standard input, -# and print each of them once, without duplicates. Input order is -# *not* preserved. -am__uniquify_input = $(AWK) '\ - BEGIN { nonempty = 0; } \ - { items[$$0] = 1; nonempty = 1; } \ - END { if (nonempty) { for (i in items) print i; }; } \ -' -# Make sure the list of sources is unique. This is necessary because, -# e.g., the same source file might be shared among _SOURCES variables -# for different programs/libraries. -am__define_uniq_tagged_files = \ - list='$(am__tagged_files)'; \ - unique=`for i in $$list; do \ - if test -f "$$i"; then echo $$i; else echo $(srcdir)/$$i; fi; \ - done | $(am__uniquify_input)` -ETAGS = etags -CTAGS = ctags -CSCOPE = cscope -DIST_SUBDIRS = $(SUBDIRS) -am__DIST_COMMON = $(srcdir)/Makefile.in $(srcdir)/config.h.in \ - $(top_srcdir)/build_aux/compile \ - $(top_srcdir)/build_aux/config.guess \ - $(top_srcdir)/build_aux/config.rpath \ - $(top_srcdir)/build_aux/config.sub \ - $(top_srcdir)/build_aux/install-sh \ - $(top_srcdir)/build_aux/ltmain.sh \ - $(top_srcdir)/build_aux/missing \ - $(top_srcdir)/build_aux/mkinstalldirs \ - $(top_srcdir)/build_aux/pre-inst-env.in ABOUT-NLS AUTHORS \ - COPYING COPYING.DOC COPYING.LESSER ChangeLog INSTALL NEWS \ - README THANKS TODO build_aux/ChangeLog build_aux/compile \ - build_aux/config.guess build_aux/config.rpath \ - build_aux/config.sub build_aux/depcomp build_aux/install-sh \ - build_aux/ltmain.sh build_aux/mdate-sh build_aux/missing \ - build_aux/mkinstalldirs build_aux/texinfo.tex build_aux/ylwrap -DISTFILES = $(DIST_COMMON) $(DIST_SOURCES) $(TEXINFOS) $(EXTRA_DIST) -distdir = $(PACKAGE)-$(VERSION) -top_distdir = $(distdir) -am__remove_distdir = \ - if test -d "$(distdir)"; then \ - find "$(distdir)" -type d ! -perm -200 -exec chmod u+w {} ';' \ - && rm -rf "$(distdir)" \ - || { sleep 5 && rm -rf "$(distdir)"; }; \ - else :; fi -am__post_remove_distdir = $(am__remove_distdir) -am__relativize = \ - dir0=`pwd`; \ - sed_first='s,^\([^/]*\)/.*$$,\1,'; \ - sed_rest='s,^[^/]*/*,,'; \ - sed_last='s,^.*/\([^/]*\)$$,\1,'; \ - sed_butlast='s,/*[^/]*$$,,'; \ - while test -n "$$dir1"; do \ - first=`echo "$$dir1" | sed -e "$$sed_first"`; \ - if test "$$first" != "."; then \ - if test "$$first" = ".."; then \ - dir2=`echo "$$dir0" | sed -e "$$sed_last"`/"$$dir2"; \ - dir0=`echo "$$dir0" | sed -e "$$sed_butlast"`; \ - else \ - first2=`echo "$$dir2" | sed -e "$$sed_first"`; \ - if test "$$first2" = "$$first"; then \ - dir2=`echo "$$dir2" | sed -e "$$sed_rest"`; \ - else \ - dir2="../$$dir2"; \ - fi; \ - dir0="$$dir0"/"$$first"; \ - fi; \ - fi; \ - dir1=`echo "$$dir1" | sed -e "$$sed_rest"`; \ - done; \ - reldir="$$dir2" -DIST_ARCHIVES = $(distdir).tar.gz $(distdir).tar.bz2 $(distdir).tar.lz \ - $(distdir).tar.xz -GZIP_ENV = --best -DIST_TARGETS = dist-lzip dist-xz dist-bzip2 dist-gzip -distuninstallcheck_listfiles = find . -type f -print -am__distuninstallcheck_listfiles = $(distuninstallcheck_listfiles) \ - | sed 's|^\./|$(prefix)/|' | grep -v '$(infodir)/dir$$' -distcleancheck_listfiles = find . -type f -print -ACLOCAL = @ACLOCAL@ -AMTAR = @AMTAR@ -AM_DEFAULT_VERBOSITY = @AM_DEFAULT_VERBOSITY@ -AR = @AR@ -AS = @AS@ -AUTOCONF = @AUTOCONF@ -AUTOHEADER = @AUTOHEADER@ -AUTOMAKE = @AUTOMAKE@ -AWK = @AWK@ -CC = @CC@ -CCDEPMODE = @CCDEPMODE@ -CFLAGS = @CFLAGS@ -CJSON_CFLAGS = @CJSON_CFLAGS@ -CJSON_LIBS = @CJSON_LIBS@ -COBC_LIBS = @COBC_LIBS@ -COB_BIGENDIAN = @COB_BIGENDIAN@ -COB_CC = @COB_CC@ -COB_CFLAGS = @COB_CFLAGS@ -COB_CONFIG_DIR = @COB_CONFIG_DIR@ -COB_COPY_DIR = @COB_COPY_DIR@ -COB_EXE_EXT = @COB_EXE_EXT@ -COB_EXPORT_DYN = @COB_EXPORT_DYN@ -COB_FIX_LIB = @COB_FIX_LIB@ -COB_FIX_LIBTOOL = @COB_FIX_LIBTOOL@ -COB_HAS_64_BIT_POINTER = @COB_HAS_64_BIT_POINTER@ -COB_HAS_BDB = @COB_HAS_BDB@ -COB_HAS_CISAM = @COB_HAS_CISAM@ -COB_HAS_CJSON = @COB_HAS_CJSON@ -COB_HAS_CURSES = @COB_HAS_CURSES@ -COB_HAS_DISAM = @COB_HAS_DISAM@ -COB_HAS_ISAM = @COB_HAS_ISAM@ -COB_HAS_LMDB = @COB_HAS_LMDB@ -COB_HAS_OCEXTFH = @COB_HAS_OCEXTFH@ -COB_HAS_OCI = @COB_HAS_OCI@ -COB_HAS_ODBC = @COB_HAS_ODBC@ -COB_HAS_VBISAM = @COB_HAS_VBISAM@ -COB_HAS_XML2 = @COB_HAS_XML2@ -COB_KEYWORD_INLINE = @COB_KEYWORD_INLINE@ -COB_LDFLAGS = @COB_LDFLAGS@ -COB_LIBRARY_PATH = @COB_LIBRARY_PATH@ -COB_LIBS = @COB_LIBS@ -COB_MODULE_EXT = @COB_MODULE_EXT@ -COB_OBJECT_EXT = @COB_OBJECT_EXT@ -COB_PATCH_LEVEL = @COB_PATCH_LEVEL@ -COB_PIC_FLAGS = @COB_PIC_FLAGS@ -COB_SCHEMA_DIR = @COB_SCHEMA_DIR@ -COB_SHARED_OPT = @COB_SHARED_OPT@ -CODE_COVERAGE_CFLAGS = @CODE_COVERAGE_CFLAGS@ -CODE_COVERAGE_CPPFLAGS = @CODE_COVERAGE_CPPFLAGS@ -CODE_COVERAGE_CXXFLAGS = @CODE_COVERAGE_CXXFLAGS@ -CODE_COVERAGE_ENABLED = @CODE_COVERAGE_ENABLED@ -CODE_COVERAGE_LDFLAGS = @CODE_COVERAGE_LDFLAGS@ -CODE_COVERAGE_LIBS = @CODE_COVERAGE_LIBS@ -CPP = @CPP@ -CPPFLAGS = @CPPFLAGS@ -CYGPATH_W = @CYGPATH_W@ -DEFS = @DEFS@ -DEPDIR = @DEPDIR@ -DIFF_FLAGS = @DIFF_FLAGS@ -DLLTOOL = @DLLTOOL@ -DSYMUTIL = @DSYMUTIL@ -DUMPBIN = @DUMPBIN@ -ECHO_C = @ECHO_C@ -ECHO_N = @ECHO_N@ -ECHO_T = @ECHO_T@ -EGREP = @EGREP@ -EXEEXT = @EXEEXT@ -FGREP = @FGREP@ -GCOV = @GCOV@ -GENHTML = @GENHTML@ -GETTEXT_MACRO_VERSION = @GETTEXT_MACRO_VERSION@ -GMSGFMT = @GMSGFMT@ -GMSGFMT_015 = @GMSGFMT_015@ -GREP = @GREP@ -HELP2MAN = @HELP2MAN@ -INSTALL = @INSTALL@ -INSTALL_DATA = @INSTALL_DATA@ -INSTALL_PROGRAM = @INSTALL_PROGRAM@ -INSTALL_SCRIPT = @INSTALL_SCRIPT@ -INSTALL_STRIP_PROGRAM = @INSTALL_STRIP_PROGRAM@ -INTLLIBS = @INTLLIBS@ -INTL_MACOSX_LIBS = @INTL_MACOSX_LIBS@ -LCOV = @LCOV@ -LD = @LD@ -LDFLAGS = @LDFLAGS@ -LEX = @LEX@ -LEXLIB = @LEXLIB@ -LEX_OUTPUT_ROOT = @LEX_OUTPUT_ROOT@ -LIBCOB_CISAM = @LIBCOB_CISAM@ -LIBCOB_CPPFLAGS = @LIBCOB_CPPFLAGS@ -LIBCOB_DISAM = @LIBCOB_DISAM@ -LIBCOB_LIBS = @LIBCOB_LIBS@ -LIBCOB_VBISAM = @LIBCOB_VBISAM@ -LIBICONV = @LIBICONV@ -LIBINTL = @LIBINTL@ -LIBOBJS = @LIBOBJS@ -LIBS = @LIBS@ -LIBTOOL = @LIBTOOL@ -LIPO = @LIPO@ -LN_S = @LN_S@ -LTLIBICONV = @LTLIBICONV@ -LTLIBINTL = @LTLIBINTL@ -LTLIBOBJS = @LTLIBOBJS@ -LT_SYS_LIBRARY_PATH = @LT_SYS_LIBRARY_PATH@ -MAKE = @MAKE@ -MAKEINFO = @MAKEINFO@ -MANIFEST_TOOL = @MANIFEST_TOOL@ -MKDIR_P = @MKDIR_P@ -MSGFMT = @MSGFMT@ -MSGFMT_015 = @MSGFMT_015@ -MSGMERGE = @MSGMERGE@ -NM = @NM@ -NMEDIT = @NMEDIT@ -OBJDUMP = @OBJDUMP@ -OBJEXT = @OBJEXT@ -ODBC_CFLAGS = @ODBC_CFLAGS@ -ODBC_LIBS = @ODBC_LIBS@ -OTOOL = @OTOOL@ -OTOOL64 = @OTOOL64@ -PACKAGE = @PACKAGE@ -PACKAGE_BUGREPORT = @PACKAGE_BUGREPORT@ -PACKAGE_NAME = @PACKAGE_NAME@ -PACKAGE_STRING = @PACKAGE_STRING@ -PACKAGE_TARNAME = @PACKAGE_TARNAME@ -PACKAGE_URL = @PACKAGE_URL@ -PACKAGE_VERSION = @PACKAGE_VERSION@ -PATH_SEPARATOR = @PATH_SEPARATOR@ -PKG_CONFIG = @PKG_CONFIG@ -PKG_CONFIG_LIBDIR = @PKG_CONFIG_LIBDIR@ -PKG_CONFIG_PATH = @PKG_CONFIG_PATH@ -POSUB = @POSUB@ -RANLIB = @RANLIB@ -SED = @SED@ -SET_MAKE = @SET_MAKE@ -SHELL = @SHELL@ -STRIP = @STRIP@ -USE_NLS = @USE_NLS@ -VERSION = @VERSION@ -XGETTEXT = @XGETTEXT@ -XGETTEXT_015 = @XGETTEXT_015@ -XGETTEXT_EXTRA_OPTIONS = @XGETTEXT_EXTRA_OPTIONS@ -XML2_CFLAGS = @XML2_CFLAGS@ -XML2_LIBS = @XML2_LIBS@ -YACC = @YACC@ -YFLAGS = @YFLAGS@ -abs_builddir = @abs_builddir@ -abs_srcdir = @abs_srcdir@ -abs_top_builddir = @abs_top_builddir@ -abs_top_srcdir = @abs_top_srcdir@ -ac_ct_AR = @ac_ct_AR@ -ac_ct_CC = @ac_ct_CC@ -ac_ct_DUMPBIN = @ac_ct_DUMPBIN@ -am__include = @am__include@ -am__leading_dot = @am__leading_dot@ -am__quote = @am__quote@ -am__tar = @am__tar@ -am__untar = @am__untar@ -bindir = @bindir@ -build = @build@ -build_alias = @build_alias@ -build_cpu = @build_cpu@ -build_os = @build_os@ -build_vendor = @build_vendor@ -builddir = @builddir@ -configured_make = @configured_make@ -datadir = @datadir@ -datarootdir = @datarootdir@ -docdir = @docdir@ -dvidir = @dvidir@ -exec_prefix = @exec_prefix@ -host = @host@ -host_alias = @host_alias@ -host_cpu = @host_cpu@ -host_os = @host_os@ -host_vendor = @host_vendor@ -htmldir = @htmldir@ -includedir = @includedir@ -infodir = @infodir@ -install_sh = @install_sh@ -libdir = @libdir@ -libexecdir = @libexecdir@ -localedir = @localedir@ -localstatedir = @localstatedir@ -mandir = @mandir@ -mkdir_p = @mkdir_p@ -oldincludedir = @oldincludedir@ -pdfdir = @pdfdir@ -prefix = @prefix@ -program_transform_name = @program_transform_name@ -psdir = @psdir@ -runstatedir = @runstatedir@ -sbindir = @sbindir@ -sharedstatedir = @sharedstatedir@ -srcdir = @srcdir@ -sysconfdir = @sysconfdir@ -target_alias = @target_alias@ -top_build_prefix = @top_build_prefix@ -top_builddir = @top_builddir@ -top_srcdir = @top_srcdir@ -xml2_config_found = @xml2_config_found@ -include_HEADERS = libcob.h -SUBDIRS = . lib libcob bin cobc config copy po doc extras tests -ACLOCAL_AMFLAGS = -I m4 --install -BUILT_SOURCES = defaults.h -DISTCLEANFILES = $(BUILT_SOURCES) -# CLEANFILES = $(bin_SCRIPTS) -dist_noinst_SCRIPTS = autogen.sh build_aux/bootstrap po/update_linguas.sh \ - build_aux/create_win_dist.sh build_aux/create_mingw_bindist.sh \ - doc/cobcinfo.sh - - -# wrapper for the build environment -noinst_SCRIPTS = pre-inst-env -EXTRA_DIST = gnucobol.spec - -# add rules for code-coverage testing, as defined by AX_CODE_COVERAGE -CODE_COVERAGE_BRANCH_COVERAGE = 1 - -# files shipped with the package that should be 755'ed: -FILES_TO_BE_EXECUTABLE = $(dist_noinst_SCRIPTS) \ - configure tests/testsuite tests/listings-sed.sh \ - build_aux/config.guess build_aux/config.sub build_aux/config.rpath \ - build_aux/depcomp build_aux/install-sh build_aux/ltmain.sh build_aux/mdate-sh \ - build_aux/missing build_aux/mkinstalldirs build_aux/ylwrap - -tarstamps = $(top_distdir)/tarstamp.h tarstamp.h -# touch $(top_distdir)/cobc/ppparse.c -# touch $(top_distdir)/cobc/parser.c -# touch $(top_distdir)/cobc/pplex.c -# touch $(top_distdir)/cobc/scanner.c -# $(top_distdir)/doc/cobcinfo.sh "fixtimestamps" -# touch $(top_distdir)/libcob/libcob.3 -# touch $(top_distdir)/bin/cobcrun.1 -# touch $(top_distdir)/cobc/cobc.1 - -# Create dist_win manually (dist-zip would have the same content as dist-gzip) -distwindir = $(distdir)_win -all: $(BUILT_SOURCES) config.h - $(MAKE) $(AM_MAKEFLAGS) all-recursive - -.SUFFIXES: -am--refresh: Makefile - @: -$(srcdir)/Makefile.in: $(srcdir)/Makefile.am $(am__configure_deps) - @for dep in $?; do \ - case '$(am__configure_deps)' in \ - *$$dep*) \ - echo ' cd $(srcdir) && $(AUTOMAKE) --gnu'; \ - $(am__cd) $(srcdir) && $(AUTOMAKE) --gnu \ - && exit 0; \ - exit 1;; \ - esac; \ - done; \ - echo ' cd $(top_srcdir) && $(AUTOMAKE) --gnu Makefile'; \ - $(am__cd) $(top_srcdir) && \ - $(AUTOMAKE) --gnu Makefile -Makefile: $(srcdir)/Makefile.in $(top_builddir)/config.status - @case '$?' in \ - *config.status*) \ - echo ' $(SHELL) ./config.status'; \ - $(SHELL) ./config.status;; \ - *) \ - echo ' cd $(top_builddir) && $(SHELL) ./config.status $@ $(am__depfiles_maybe)'; \ - cd $(top_builddir) && $(SHELL) ./config.status $@ $(am__depfiles_maybe);; \ - esac; - -$(top_builddir)/config.status: $(top_srcdir)/configure $(CONFIG_STATUS_DEPENDENCIES) - $(SHELL) ./config.status --recheck - -$(top_srcdir)/configure: $(am__configure_deps) - $(am__cd) $(srcdir) && $(AUTOCONF) -$(ACLOCAL_M4): $(am__aclocal_m4_deps) - $(am__cd) $(srcdir) && $(ACLOCAL) $(ACLOCAL_AMFLAGS) -$(am__aclocal_m4_deps): - -config.h: stamp-h1 - @test -f $@ || rm -f stamp-h1 - @test -f $@ || $(MAKE) $(AM_MAKEFLAGS) stamp-h1 - -stamp-h1: $(srcdir)/config.h.in $(top_builddir)/config.status - @rm -f stamp-h1 - cd $(top_builddir) && $(SHELL) ./config.status config.h -$(srcdir)/config.h.in: $(am__configure_deps) - ($(am__cd) $(top_srcdir) && $(AUTOHEADER)) - rm -f stamp-h1 - touch $@ - -distclean-hdr: - -rm -f config.h stamp-h1 -pre-inst-env: $(top_builddir)/config.status $(top_srcdir)/build_aux/pre-inst-env.in - cd $(top_builddir) && $(SHELL) ./config.status $@ - -mostlyclean-libtool: - -rm -f *.lo - -clean-libtool: - -rm -rf .libs _libs - -distclean-libtool: - -rm -f libtool config.lt -install-includeHEADERS: $(include_HEADERS) - @$(NORMAL_INSTALL) - @list='$(include_HEADERS)'; test -n "$(includedir)" || list=; \ - if test -n "$$list"; then \ - echo " $(MKDIR_P) '$(DESTDIR)$(includedir)'"; \ - $(MKDIR_P) "$(DESTDIR)$(includedir)" || exit 1; \ - fi; \ - for p in $$list; do \ - if test -f "$$p"; then d=; else d="$(srcdir)/"; fi; \ - echo "$$d$$p"; \ - done | $(am__base_list) | \ - while read files; do \ - echo " $(INSTALL_HEADER) $$files '$(DESTDIR)$(includedir)'"; \ - $(INSTALL_HEADER) $$files "$(DESTDIR)$(includedir)" || exit $$?; \ - done - -uninstall-includeHEADERS: - @$(NORMAL_UNINSTALL) - @list='$(include_HEADERS)'; test -n "$(includedir)" || list=; \ - files=`for p in $$list; do echo $$p; done | sed -e 's|^.*/||'`; \ - dir='$(DESTDIR)$(includedir)'; $(am__uninstall_files_from_dir) - -# This directory's subdirectories are mostly independent; you can cd -# into them and run 'make' without going through this Makefile. -# To change the values of 'make' variables: instead of editing Makefiles, -# (1) if the variable is set in 'config.status', edit 'config.status' -# (which will cause the Makefiles to be regenerated when you run 'make'); -# (2) otherwise, pass the desired values on the 'make' command line. -$(am__recursive_targets): - @fail=; \ - if $(am__make_keepgoing); then \ - failcom='fail=yes'; \ - else \ - failcom='exit 1'; \ - fi; \ - dot_seen=no; \ - target=`echo $@ | sed s/-recursive//`; \ - case "$@" in \ - distclean-* | maintainer-clean-*) list='$(DIST_SUBDIRS)' ;; \ - *) list='$(SUBDIRS)' ;; \ - esac; \ - for subdir in $$list; do \ - echo "Making $$target in $$subdir"; \ - if test "$$subdir" = "."; then \ - dot_seen=yes; \ - local_target="$$target-am"; \ - else \ - local_target="$$target"; \ - fi; \ - ($(am__cd) $$subdir && $(MAKE) $(AM_MAKEFLAGS) $$local_target) \ - || eval $$failcom; \ - done; \ - if test "$$dot_seen" = "no"; then \ - $(MAKE) $(AM_MAKEFLAGS) "$$target-am" || exit 1; \ - fi; test -z "$$fail" - -ID: $(am__tagged_files) - $(am__define_uniq_tagged_files); mkid -fID $$unique -tags: tags-recursive -TAGS: tags - -tags-am: $(TAGS_DEPENDENCIES) $(am__tagged_files) - set x; \ - here=`pwd`; \ - if ($(ETAGS) --etags-include --version) >/dev/null 2>&1; then \ - include_option=--etags-include; \ - empty_fix=.; \ - else \ - include_option=--include; \ - empty_fix=; \ - fi; \ - list='$(SUBDIRS)'; for subdir in $$list; do \ - if test "$$subdir" = .; then :; else \ - test ! -f $$subdir/TAGS || \ - set "$$@" "$$include_option=$$here/$$subdir/TAGS"; \ - fi; \ - done; \ - $(am__define_uniq_tagged_files); \ - shift; \ - if test -z "$(ETAGS_ARGS)$$*$$unique"; then :; else \ - test -n "$$unique" || unique=$$empty_fix; \ - if test $$# -gt 0; then \ - $(ETAGS) $(ETAGSFLAGS) $(AM_ETAGSFLAGS) $(ETAGS_ARGS) \ - "$$@" $$unique; \ - else \ - $(ETAGS) $(ETAGSFLAGS) $(AM_ETAGSFLAGS) $(ETAGS_ARGS) \ - $$unique; \ - fi; \ - fi -ctags: ctags-recursive - -CTAGS: ctags -ctags-am: $(TAGS_DEPENDENCIES) $(am__tagged_files) - $(am__define_uniq_tagged_files); \ - test -z "$(CTAGS_ARGS)$$unique" \ - || $(CTAGS) $(CTAGSFLAGS) $(AM_CTAGSFLAGS) $(CTAGS_ARGS) \ - $$unique - -GTAGS: - here=`$(am__cd) $(top_builddir) && pwd` \ - && $(am__cd) $(top_srcdir) \ - && gtags -i $(GTAGS_ARGS) "$$here" -cscope: cscope.files - test ! -s cscope.files \ - || $(CSCOPE) -b -q $(AM_CSCOPEFLAGS) $(CSCOPEFLAGS) -i cscope.files $(CSCOPE_ARGS) -clean-cscope: - -rm -f cscope.files -cscope.files: clean-cscope cscopelist -cscopelist: cscopelist-recursive - -cscopelist-am: $(am__tagged_files) - list='$(am__tagged_files)'; \ - case "$(srcdir)" in \ - [\\/]* | ?:[\\/]*) sdir="$(srcdir)" ;; \ - *) sdir=$(subdir)/$(srcdir) ;; \ - esac; \ - for i in $$list; do \ - if test -f "$$i"; then \ - echo "$(subdir)/$$i"; \ - else \ - echo "$$sdir/$$i"; \ - fi; \ - done >> $(top_builddir)/cscope.files - -distclean-tags: - -rm -f TAGS ID GTAGS GRTAGS GSYMS GPATH tags - -rm -f cscope.out cscope.in.out cscope.po.out cscope.files - -distdir: $(DISTFILES) - $(am__remove_distdir) - test -d "$(distdir)" || mkdir "$(distdir)" - @srcdirstrip=`echo "$(srcdir)" | sed 's/[].[^$$\\*]/\\\\&/g'`; \ - topsrcdirstrip=`echo "$(top_srcdir)" | sed 's/[].[^$$\\*]/\\\\&/g'`; \ - list='$(DISTFILES)'; \ - dist_files=`for file in $$list; do echo $$file; done | \ - sed -e "s|^$$srcdirstrip/||;t" \ - -e "s|^$$topsrcdirstrip/|$(top_builddir)/|;t"`; \ - case $$dist_files in \ - */*) $(MKDIR_P) `echo "$$dist_files" | \ - sed '/\//!d;s|^|$(distdir)/|;s,/[^/]*$$,,' | \ - sort -u` ;; \ - esac; \ - for file in $$dist_files; do \ - if test -f $$file || test -d $$file; then d=.; else d=$(srcdir); fi; \ - if test -d $$d/$$file; then \ - dir=`echo "/$$file" | sed -e 's,/[^/]*$$,,'`; \ - if test -d "$(distdir)/$$file"; then \ - find "$(distdir)/$$file" -type d ! -perm -700 -exec chmod u+rwx {} \;; \ - fi; \ - if test -d $(srcdir)/$$file && test $$d != $(srcdir); then \ - cp -fpR $(srcdir)/$$file "$(distdir)$$dir" || exit 1; \ - find "$(distdir)/$$file" -type d ! -perm -700 -exec chmod u+rwx {} \;; \ - fi; \ - cp -fpR $$d/$$file "$(distdir)$$dir" || exit 1; \ - else \ - test -f "$(distdir)/$$file" \ - || cp -p $$d/$$file "$(distdir)/$$file" \ - || exit 1; \ - fi; \ - done - @list='$(DIST_SUBDIRS)'; for subdir in $$list; do \ - if test "$$subdir" = .; then :; else \ - $(am__make_dryrun) \ - || test -d "$(distdir)/$$subdir" \ - || $(MKDIR_P) "$(distdir)/$$subdir" \ - || exit 1; \ - dir1=$$subdir; dir2="$(distdir)/$$subdir"; \ - $(am__relativize); \ - new_distdir=$$reldir; \ - dir1=$$subdir; dir2="$(top_distdir)"; \ - $(am__relativize); \ - new_top_distdir=$$reldir; \ - echo " (cd $$subdir && $(MAKE) $(AM_MAKEFLAGS) top_distdir="$$new_top_distdir" distdir="$$new_distdir" \\"; \ - echo " am__remove_distdir=: am__skip_length_check=: am__skip_mode_fix=: distdir)"; \ - ($(am__cd) $$subdir && \ - $(MAKE) $(AM_MAKEFLAGS) \ - top_distdir="$$new_top_distdir" \ - distdir="$$new_distdir" \ - am__remove_distdir=: \ - am__skip_length_check=: \ - am__skip_mode_fix=: \ - distdir) \ - || exit 1; \ - fi; \ - done - $(MAKE) $(AM_MAKEFLAGS) \ - top_distdir="$(top_distdir)" distdir="$(distdir)" \ - dist-hook - -test -n "$(am__skip_mode_fix)" \ - || find "$(distdir)" -type d ! -perm -755 \ - -exec chmod u+rwx,go+rx {} \; -o \ - ! -type d ! -perm -444 -links 1 -exec chmod a+r {} \; -o \ - ! -type d ! -perm -400 -exec chmod a+r {} \; -o \ - ! -type d ! -perm -444 -exec $(install_sh) -c -m a+r {} {} \; \ - || chmod -R a+r "$(distdir)" -dist-gzip: distdir - tardir=$(distdir) && $(am__tar) | eval GZIP= gzip $(GZIP_ENV) -c >$(distdir).tar.gz - $(am__post_remove_distdir) -dist-bzip2: distdir - tardir=$(distdir) && $(am__tar) | BZIP2=$${BZIP2--9} bzip2 -c >$(distdir).tar.bz2 - $(am__post_remove_distdir) -dist-lzip: distdir - tardir=$(distdir) && $(am__tar) | lzip -c $${LZIP_OPT--9} >$(distdir).tar.lz - $(am__post_remove_distdir) -dist-xz: distdir - tardir=$(distdir) && $(am__tar) | XZ_OPT=$${XZ_OPT--e} xz -c >$(distdir).tar.xz - $(am__post_remove_distdir) - -dist-tarZ: distdir - @echo WARNING: "Support for distribution archives compressed with" \ - "legacy program 'compress' is deprecated." >&2 - @echo WARNING: "It will be removed altogether in Automake 2.0" >&2 - tardir=$(distdir) && $(am__tar) | compress -c >$(distdir).tar.Z - $(am__post_remove_distdir) - -dist-shar: distdir - @echo WARNING: "Support for shar distribution archives is" \ - "deprecated." >&2 - @echo WARNING: "It will be removed altogether in Automake 2.0" >&2 - shar $(distdir) | eval GZIP= gzip $(GZIP_ENV) -c >$(distdir).shar.gz - $(am__post_remove_distdir) - -dist-zip: distdir - -rm -f $(distdir).zip - zip -rq $(distdir).zip $(distdir) - $(am__post_remove_distdir) - -dist dist-all: - $(MAKE) $(AM_MAKEFLAGS) $(DIST_TARGETS) am__post_remove_distdir='@:' - $(am__post_remove_distdir) - -# This target untars the dist file and tries a VPATH configuration. Then -# it guarantees that the distribution is self-contained by making another -# tarfile. -distcheck: dist - case '$(DIST_ARCHIVES)' in \ - *.tar.gz*) \ - eval GZIP= gzip $(GZIP_ENV) -dc $(distdir).tar.gz | $(am__untar) ;;\ - *.tar.bz2*) \ - bzip2 -dc $(distdir).tar.bz2 | $(am__untar) ;;\ - *.tar.lz*) \ - lzip -dc $(distdir).tar.lz | $(am__untar) ;;\ - *.tar.xz*) \ - xz -dc $(distdir).tar.xz | $(am__untar) ;;\ - *.tar.Z*) \ - uncompress -c $(distdir).tar.Z | $(am__untar) ;;\ - *.shar.gz*) \ - eval GZIP= gzip $(GZIP_ENV) -dc $(distdir).shar.gz | unshar ;;\ - *.zip*) \ - unzip $(distdir).zip ;;\ - esac - chmod -R a-w $(distdir) - chmod u+w $(distdir) - mkdir $(distdir)/_build $(distdir)/_build/sub $(distdir)/_inst - chmod a-w $(distdir) - test -d $(distdir)/_build || exit 0; \ - dc_install_base=`$(am__cd) $(distdir)/_inst && pwd | sed -e 's,^[^:\\/]:[\\/],/,'` \ - && dc_destdir="$${TMPDIR-/tmp}/am-dc-$$$$/" \ - && am__cwd=`pwd` \ - && $(am__cd) $(distdir)/_build/sub \ - && ../../configure \ - $(AM_DISTCHECK_CONFIGURE_FLAGS) \ - $(DISTCHECK_CONFIGURE_FLAGS) \ - --srcdir=../.. --prefix="$$dc_install_base" \ - && $(MAKE) $(AM_MAKEFLAGS) \ - && $(MAKE) $(AM_MAKEFLAGS) dvi \ - && $(MAKE) $(AM_MAKEFLAGS) check \ - && $(MAKE) $(AM_MAKEFLAGS) install \ - && $(MAKE) $(AM_MAKEFLAGS) installcheck \ - && $(MAKE) $(AM_MAKEFLAGS) uninstall \ - && $(MAKE) $(AM_MAKEFLAGS) distuninstallcheck_dir="$$dc_install_base" \ - distuninstallcheck \ - && chmod -R a-w "$$dc_install_base" \ - && ({ \ - (cd ../.. && umask 077 && mkdir "$$dc_destdir") \ - && $(MAKE) $(AM_MAKEFLAGS) DESTDIR="$$dc_destdir" install \ - && $(MAKE) $(AM_MAKEFLAGS) DESTDIR="$$dc_destdir" uninstall \ - && $(MAKE) $(AM_MAKEFLAGS) DESTDIR="$$dc_destdir" \ - distuninstallcheck_dir="$$dc_destdir" distuninstallcheck; \ - } || { rm -rf "$$dc_destdir"; exit 1; }) \ - && rm -rf "$$dc_destdir" \ - && $(MAKE) $(AM_MAKEFLAGS) dist \ - && rm -rf $(DIST_ARCHIVES) \ - && $(MAKE) $(AM_MAKEFLAGS) distcleancheck \ - && cd "$$am__cwd" \ - || exit 1 - $(am__post_remove_distdir) - @(echo "$(distdir) archives ready for distribution: "; \ - list='$(DIST_ARCHIVES)'; for i in $$list; do echo $$i; done) | \ - sed -e 1h -e 1s/./=/g -e 1p -e 1x -e '$$p' -e '$$x' -distuninstallcheck: - @test -n '$(distuninstallcheck_dir)' || { \ - echo 'ERROR: trying to run $@ with an empty' \ - '$$(distuninstallcheck_dir)' >&2; \ - exit 1; \ - }; \ - $(am__cd) '$(distuninstallcheck_dir)' || { \ - echo 'ERROR: cannot chdir into $(distuninstallcheck_dir)' >&2; \ - exit 1; \ - }; \ - test `$(am__distuninstallcheck_listfiles) | wc -l` -eq 0 \ - || { echo "ERROR: files left after uninstall:" ; \ - if test -n "$(DESTDIR)"; then \ - echo " (check DESTDIR support)"; \ - fi ; \ - $(distuninstallcheck_listfiles) ; \ - exit 1; } >&2 -distcleancheck: distclean - @if test '$(srcdir)' = . ; then \ - echo "ERROR: distcleancheck can only run from a VPATH build" ; \ - exit 1 ; \ - fi - @test `$(distcleancheck_listfiles) | wc -l` -eq 0 \ - || { echo "ERROR: files left in build directory after distclean:" ; \ - $(distcleancheck_listfiles) ; \ - exit 1; } >&2 -check-am: all-am -check: $(BUILT_SOURCES) - $(MAKE) $(AM_MAKEFLAGS) check-recursive -all-am: Makefile $(SCRIPTS) $(HEADERS) config.h -installdirs: installdirs-recursive -installdirs-am: - for dir in "$(DESTDIR)$(includedir)"; do \ - test -z "$$dir" || $(MKDIR_P) "$$dir"; \ - done -install: $(BUILT_SOURCES) - $(MAKE) $(AM_MAKEFLAGS) install-recursive -install-exec: install-exec-recursive -install-data: install-data-recursive -uninstall: uninstall-recursive - -install-am: all-am - @$(MAKE) $(AM_MAKEFLAGS) install-exec-am install-data-am - -installcheck: installcheck-recursive -install-strip: - if test -z '$(STRIP)'; then \ - $(MAKE) $(AM_MAKEFLAGS) INSTALL_PROGRAM="$(INSTALL_STRIP_PROGRAM)" \ - install_sh_PROGRAM="$(INSTALL_STRIP_PROGRAM)" INSTALL_STRIP_FLAG=-s \ - install; \ - else \ - $(MAKE) $(AM_MAKEFLAGS) INSTALL_PROGRAM="$(INSTALL_STRIP_PROGRAM)" \ - install_sh_PROGRAM="$(INSTALL_STRIP_PROGRAM)" INSTALL_STRIP_FLAG=-s \ - "INSTALL_PROGRAM_ENV=STRIPPROG='$(STRIP)'" install; \ - fi -mostlyclean-generic: - -clean-generic: - -distclean-generic: - -test -z "$(CONFIG_CLEAN_FILES)" || rm -f $(CONFIG_CLEAN_FILES) - -test . = "$(srcdir)" || test -z "$(CONFIG_CLEAN_VPATH_FILES)" || rm -f $(CONFIG_CLEAN_VPATH_FILES) - -test -z "$(DISTCLEANFILES)" || rm -f $(DISTCLEANFILES) - -maintainer-clean-generic: - @echo "This command is intended for maintainers to use" - @echo "it deletes files that may require special tools to rebuild." - -test -z "$(BUILT_SOURCES)" || rm -f $(BUILT_SOURCES) -clean: clean-recursive - -clean-am: clean-generic clean-libtool mostlyclean-am - -distclean: distclean-recursive - -rm -f $(am__CONFIG_DISTCLEAN_FILES) - -rm -f Makefile -distclean-am: clean-am distclean-generic distclean-hdr \ - distclean-libtool distclean-tags - -dvi: dvi-recursive - -dvi-am: - -html: html-recursive - -html-am: - -info: info-recursive - -info-am: - -install-data-am: install-includeHEADERS - -install-dvi: install-dvi-recursive - -install-dvi-am: - -install-exec-am: - -install-html: install-html-recursive - -install-html-am: - -install-info: install-info-recursive - -install-info-am: - -install-man: - -install-pdf: install-pdf-recursive - -install-pdf-am: - -install-ps: install-ps-recursive - -install-ps-am: - -installcheck-am: - -maintainer-clean: maintainer-clean-recursive - -rm -f $(am__CONFIG_DISTCLEAN_FILES) - -rm -rf $(top_srcdir)/autom4te.cache - -rm -f Makefile -maintainer-clean-am: distclean-am maintainer-clean-generic - -mostlyclean: mostlyclean-recursive - -mostlyclean-am: mostlyclean-generic mostlyclean-libtool - -pdf: pdf-recursive - -pdf-am: - -ps: ps-recursive - -ps-am: - -uninstall-am: uninstall-includeHEADERS - -.MAKE: $(am__recursive_targets) all check install install-am \ - install-strip - -.PHONY: $(am__recursive_targets) CTAGS GTAGS TAGS all all-am \ - am--refresh check check-am clean clean-cscope clean-generic \ - clean-libtool cscope cscopelist-am ctags ctags-am dist \ - dist-all dist-bzip2 dist-gzip dist-hook dist-lzip dist-shar \ - dist-tarZ dist-xz dist-zip distcheck distclean \ - distclean-generic distclean-hdr distclean-libtool \ - distclean-tags distcleancheck distdir distuninstallcheck dvi \ - dvi-am html html-am info info-am install install-am \ - install-data install-data-am install-dvi install-dvi-am \ - install-exec install-exec-am install-html install-html-am \ - install-includeHEADERS install-info install-info-am \ - install-man install-pdf install-pdf-am install-ps \ - install-ps-am install-strip installcheck installcheck-am \ - installdirs installdirs-am maintainer-clean \ - maintainer-clean-generic mostlyclean mostlyclean-generic \ - mostlyclean-libtool pdf pdf-am ps ps-am tags tags-am uninstall \ - uninstall-am uninstall-includeHEADERS - -.PRECIOUS: Makefile - - -all: tarstamp.h defaults.h -@CODE_COVERAGE_RULES@ - -# all parts but tarstamp.h should not be necessary... -dist-hook: - rm -f $(top_distdir)/tarstamp.h - $(MAKE) $(AM_MAKEFLAGS) $(top_distdir)/tarstamp.h -# fix access to cater for bad version control use / copy / read-only file system - find $(top_distdir) -type d -print | xargs chmod 755 # otherwise directories have 777 - find $(top_distdir) -type f -print | xargs chmod 644 # otherwise files are unchanged but with u+r -# because of the global file change, adjust here again - cd $(top_distdir) && chmod 755 $(FILES_TO_BE_EXECUTABLE) -# fix timestamps to cater for bad version control use / copy - touch $(top_distdir)/m4/*.m4 - touch $(top_distdir)/aclocal.m4 - touch $(top_distdir)/Makefile.in - touch $(top_distdir)/*/Makefile.in - touch $(top_distdir)/*/*/Makefile.in - touch $(top_distdir)/configure - touch $(top_distdir)/config.h.in - touch $(top_distdir)/doc/stamp-vti -distwin: distdir $(top_srcdir)/build_windows $(top_srcdir)/build_aux/create_win_dist.sh - EXTSRCDIR=$(srcdir) EXTDISTDIR=$(distdir) EXTWINDISTDIR=$(distwindir) $(top_srcdir)/build_aux/create_win_dist.sh - -distwin-zip: distwin - rm -f "$(distwindir).zip" - zip -rq "$(distwindir).zip" "$(distwindir)" - -defaults.h: Makefile.am $(top_builddir)/config.status - @echo "Creating $@..." - @{ \ - echo "/* Automatically generated by Makefile */"; \ - echo "#define COB_CC \"$(COB_CC)\""; \ - echo "#define COB_CFLAGS \"$(COB_CFLAGS)\""; \ - echo "#define COB_LDFLAGS \"$(COB_LDFLAGS)\""; \ - echo "#define COB_LIBS \"$(COB_LIBS)\""; \ - echo "#define COB_CONFIG_DIR \"$(COB_CONFIG_DIR)\""; \ - echo "#define COB_COPY_DIR \"$(COB_COPY_DIR)\""; \ - echo "#define COB_SCHEMA_DIR \"$(COB_SCHEMA_DIR)\""; \ - echo "#define COB_LIBRARY_PATH \"$(COB_LIBRARY_PATH)\""; \ - echo "#define COB_BLD_CC \"$(CC)\""; \ - echo "#define COB_BLD_CPPFLAGS \"$(CPPFLAGS)\""; \ - echo "#define COB_BLD_CFLAGS \"$(CFLAGS)\""; \ - echo "#define COB_BLD_LD \"$(LD)\""; \ - echo "#define COB_BLD_LDFLAGS \"$(LDFLAGS)\""; \ - echo "#define COB_BLD_BUILD \"$(build)\""; \ - echo "#define LOCALEDIR \"$(localedir)\""; \ - } > defaults.h - -$(tarstamps): - @echo "Creating $@..." - @{ \ - echo "#define COB_TAR_DATE \"`LC_ALL=C date -u +'%b %d %Y %T'` UTC\""; \ - echo "#define COB_NUM_TAR_DATE ` LC_ALL=C date -u +'%Y%m%d'`"; \ - echo "#define COB_NUM_TAR_TIME ` LC_ALL=C date -u +'%H%M%S'`"; \ - } > $@ - -# targets that are only logical targets and should always be executed -.PHONY: test checkall checkmanual - -test: all - cd tests && $(MAKE) $(AM_MAKEFLAGS) test -checkmanual: all - cd tests && $(MAKE) $(AM_MAKEFLAGS) checkmanual - -checkall: check test - -# Tell versions [3.59,3.63) of GNU make to not export all variables. -# Otherwise a system limit (for SysV at least) may be exceeded. -.NOEXPORT: diff -Nru gnucobol-4.0~early~20200606/NEWS gnucobol-5/NEWS --- gnucobol-4.0~early~20200606/NEWS 2020-06-06 20:52:02.000000000 +0000 +++ gnucobol-5/NEWS 1970-01-01 00:00:00.000000000 +0000 @@ -1,879 +0,0 @@ -NEWS - user visible changes -*- outline -*- - - GnuCOBOL development (currently as 4.0-early-dev) - - *** this version has no backward compatibility to modules created with - a previous version; the internal library-number was therefore increased - (libcob-5 instead of libcob-4). - - *** anything may still change during development of this version, - including incompatible changes *** - -* New GnuCOBOL features - -** file handling: added backends for ODBC and OCI, along with new directory - COB_SCHEMA_DIR containing the necessary internal schema files to match the - indexed file definition to the database table - -* internal change: fileio splitted - -* The old OpenCOBOL EXTFH interface built in via --with-seqra-extfh -* and --with-index-extfh is obsolete and will be removed in the -* next major release - -* many internal changes, possibly changing some defaults - - - GnuCOBOL 3.1-rc1/final to be released (in June 2019) - -* New GnuCOBOL features - -** file handling: added support for [RE]WRITE FILE file FROM source - -** XML GENERATE statement - (note: runtime support needs additional library libxml2) - -** JSON GENERATE statement - (note: runtime support needs additional library cJSON) - -** CONTINUE AFTER statement (COBOL 202x) implemented, also handle fractions - of seconds in C$SLEEP now - -** Improved support for different compiler extensions (ACUCOBOL, IBM, - Fujitsu, MicroFocus COBOL, Microsoft COBOL, RM/COBOL and more) - -** file handling: include support for a callable EXTFH interface also provided - by several compilers including Micro Focus - This allows users to insert an external file handler while retaining - all of the normal COBOL I/O functions with a possible callback to libcob. - To have the compiled program call `yourfh()` for file I/O use: - `cobc -fcallfh=yourfh` - In turn `yourfh()` may call `EXTFH()` to use I/O functions from GnuCOBOL. - The external file handler can also be directly invoked from COBOL, too, - using `CALL "EXTFH"`. - ** Note: Not all flags contained in the FCD3 are handled already ** - -** screen i/o: initial mouse support (for details see runtime.cfg), - use of CURSOR clause in SPECIAL-NAMES for positioning on ACCEPT - - -* Removed functions - -** SCREEN SECTION, REPORT-WRITER module: removed non-standard extension - "LINE / COL signed-integer" (inadvertently available since 2.2/3.0rc1); - which will now raise an error "unsigned integer expected"; - if used replace by standard "LINE / COL +/- integer" - - -* Changed cobc options: - - CHECKME - -* Changes in the COBOL runtime (libcob) - -** Messages from the COBOL runtime are also translated now (if installed). - To prevent this disable translations in general with using the configure - option --disable-nls (or by deactivating ENABLE_NLS in config.h). - -** libcob.h does no longer auto-include gmp.h (behavior since 2.x), if you link - against libcob and need cob_decimal include it yourself before - otherwise you - do not need it in your include path any more - - -* New build features - -** Running the internal tests by make check now fails if the testsuite has any - unexpected result. - -** The modules and test programs in the NIST COBOL-85 test suite (tests/cobol85) - may now be build and/or tested and/or the test results checked separately. - You now may also run the tests with a previous installed version of GnuCOBOL - (or a version specified by a manual temporary setup). - For details see tests/cobol85/README. - -** To adjust configure to use libxml2 you may use the new variables XML2_CFLAGS - and XML2_LIBS. If unset configure will use pkg-config / xml2-config. - -** To adjust configure to use libcjson you may use the new variables CJSON_CFLAGS - and CJSON_LIBS. If unset configure will use pkg-config. - -** new configure options --with-xml2 / -without-xml2 to explicit force/disable - XML runtime support, otherwise it will be included if found as working - -** new configure options --with-cjson / -without-cjson to explicit force/disable - JSON runtime support, otherwise it will be included if found as working - Note: As a special case you may built-in cJSON by putting its source in - a sub-directory cJSON. If there is no working cJSON in the system or explicit - specified by --with-cjson=local this version will be compiled into libcob. - -** Any time after `make` you can call `pre-inst-env` script to use the still- - uninstalled binaries. Samples: - pre-inst-env cobc -xj prog.cob - pre-inst-env cobcrun -M prog start - pre-inst-env may also be called without parameters to start a new shell - session with the environment adjusted to use the uninstalled version. - - -* Too much bug fixes to list here (please check ChangeLogs for full details). - -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ - - GnuCOBOL 3.0-rc1 released (20180422) - -* New GnuCOBOL features - -** REPORTWRITER module added - -** INDEXED file handling: added support for sparse and split keys - -** file handling: added support for [RE]WRITE FILE file FROM source - -** DISPLAY ... UPON PRINTER may be redirected to an external command - (new runtime configuration COB_DISPLAY_PRINT_PIPE) or appended to a file - (new runtime configuration COB_DISPLAY_PRINT_FILE, which takes precedence) - -** XML GENERATE statement - (note: runtime support needs additional library libxml2) - -** JSON GENERATE statement - (note: runtime support needs additional library cJSON) - -** Improved support for different compiler extensions (ACUCOBOL, IBM, - Fujitsu, MicroFocus COBOL, Microsoft COBOL, RM/COBOL and more) - -** Parser support for many features of different compilers, for example - PIC 1 / USAGE BIT, ACUCOBOL extensions for graphical controls - VALIDATE statement and much more. - Most of them will be fully implemented in a later version... - -** Option to dump (partial) data of modules on abort. - Use new cobc option -fdump= to prepare the module and optional - use new runtime configuration options COB_DUMP_FILE and COB_DUMP_WIDTH - to adjust the dump. - -** C interface: new functions cob_set_runtime_option / cob_get_runtime_option - to set/get special runtime options (currently FILE * for trace and printer - output) or to reload the runtime configuration after changing environment - -** file handling: include support for a callable EXTFH interface also provided - by several compilers including Micro Focus - This allows users to insert an external file handler while retaining - all of the normal COBOL I/O functions with a possible callback to libcob. - To have the compiled program call `yourfh()` for file I/O use: - `cobc -fcallfh=yourfh` - In turn `yourfh()` may call `EXTFH()` to use I/O functions from GnuCOBOL. - The external file handler can also be directly invoked from COBOL, too, - using `CALL "EXTFH"`. - ** Note: Not all flags contained in the FCD3 are handled already ** - - -* Changed cobc options: - -** The option -debug (runtime checks) no longer implies -ftrace (option to - trace program flow of the generated module with COB_SET_TRACE). - You may specify -ftrace[all] along -debug if you want to use this feature. - -** The option -E (preprocess file) does not imply an output file any more. - If no output file is explicit specified with -o filename.i the output will - be written to stdout (behavior of versions 1.1 is restored). - Requesting output to stdout explicit by using a dash as output name is - also possible. - -** Changed options for listing: - The option -tsymbols was replaced by -ftsymbols and therefore can now also - be explicit deactivated by specifying -fno-tsymbols. - New options for suppressing (or explicit requesting) parts of the listing: - -fno-theader suppress all headers from listing while keeping page breaks - -fno-tmessages suppress warning and error summary from listing - -fno-tsource suppress actual source from listing (for example to only - produce the cross-reference) - -** The option -fif-cutoff (option to change generated C sources to use - a label + goto for nested if/else) was deactivated to allow the C compiler - to fully control the program flow. - ** Please report if you have a need for this option as it will be ** - ** removed permanently in the next release of GnuCOBOL otherwise. ** - - -* Changes in the COBOL runtime (libcob) - -** updated exception handling, GnuCOBOL now only cleans raised exceptions when - requested by SET LAST EXCEPTION TO OFF - -** The standard-format for program tracing was changed and is now adjustable - by the runtime configuration option COB_TRACE_FORMAT. - -* New build features - -** New test suite for manual tests (especially SCREEN I/O), - run with `make checkmanual`. - Note: You may want to adjust the test runner tests/run_prog_manual.sh which - defaults to xterm in GUI environments and screen in terminal environments. - -** new configure option --enable-debug-log to allow *internal* tracing - of GnuCOBOL (intended for developers of GnuCOBOL only) - -* Too much bug fixes to list here (please check ChangeLogs for full details). - -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ - - GnuCOBOL 2.2 released (20170906) - -* Move to GPL/LGPL 3 - -* New GnuCOBOL features (too much to list) - -** User Defined Functions, FUNCTION-ID. - -** New intrinsic functions - - ABSOLUTE-VALUE alias for ABS - CURRENCY-SYMBOL CURRENCY-SYMBOL of the current program - FORMATTED-CURRENT-DATE ISO 8601 datetime function - FORMATTED-DATE ISO 8601 datetime function - FORMATTED-DATETIME ISO 8601 datetime function - FORMATTED-TIME ISO 8601 datetime function - TEST-FORMATTED-DATETIME ISO 8601 datetime function - INTEGER-OF-FORMATTED-DATE date to integer - HIGHEST-ALGEBRAIC now implemented - LOWEST-ALGEBRAIC now implemented - LOCALE-COMPARE now implemented - NUMVAL-F now implemented - TEST-NUMVAL now implemented - TEST-NUMVAL-C now implemented - TEST-NUMVAL-F now implemented - LENGTH-AN alias for BYTE-LENGTH - MODULE-CALLER-ID return the name of the caller - MODULE-DATE current module: compilation date - MODULE-TIME current module: compilation time - MODULE-FORMATTED-DATE current module: formatted datetime - MODULE-ID current module: PROGRAM-ID - MODULE-PATH current module: path on compile time - MODULE-SOURCE current module: name on compile time - MONETARY-DECIMAL-POINT LOCALE based fiscal decimal point - MONETARY-THOUSANDS-SEPARATOR LOCALE based fiscal visual grouping separator - - Note: - The functions that are actually available as intrinsic functions depend - on the -std used. Function names that aren't marked as intrinsic functions - by the current -std can be used freely as user defined words or - even as user defined functions. - -** New system functions - - C$CALLEDBY return the name of the caller - CBL_GC_FORK fork current process (not on Windows) - CBL_GC_WAITPID wait for process to end - CBL_GC_GETOPT (CBL_OC_GETOPT) command line option parser for COBOL - CBL_GC_PRINTABLE (C$PRINTABLE) check if character is printable - CBL_GC_HOSTED (CBL_OC_HOSTED) provides access to C extern variables, - like stdin, errno - CBL_GC_NANOSLEEP CBL_OC_NANOSLEEP - CBL_GET_SCR_SIZE get current terminal size - if any - CBL_READ_KBD_CHAR get character from terminal - CBL_SET_CSR_POS set current position on terminal - x'E4' clear terminal screen - x'E5' ring the bell - -** full support of ANSI 85 debugging module: - USE FOR DEBUGGING declarative procedures (only part of the generation if - WITH DEBUGGING MODE is active during compilation) and special register: - 01 DEBUG-ITEM. - 02 DEBUG-LINE PIC X(6). - 02 FILLER PIC X VALUE SPACE. - 02 DEBUG-NAME PIC X(30). - 02 FILLER PIC X VALUE SPACE. - 02 DEBUG-SUB-1 PIC S9(4). - 02 FILLER PIC X VALUE SPACE - 02 DEBUG-SUB-2 PIC S9(4). - 02 FILLER PIC X VALUE SPACE. - 02 DEBUG-SUB-3 PIC S9(4). - 02 FILLER PIC X VALUE SPACE. - 02 DEBUG-CONTENTS PIC X(n). - With "n" being at least 30, size is increased if USE FOR DEBUGGING identifier - is used and the identifier has a longer size. - Note: COB_SET_DEBUG activates the specified debugging sections at runtime - -** many new / extended COBOL statements from COBOL2002/2014 and extensions - from different COBOL dialects - -** more SWITCHes: from SWITCH-01 to SWITCH-36 and its variants from many - COBOL dialects - -** more IEEE numeric types added, FLOAT-DECIMAL-16, FLOAT-DECIMAL-34, etc - -** more literal types added, numeric boolean etc. - -** most of the COBOL 2014 spec Compiler Directive Facility is in - -** optional: stricter syntax checks - -** Optimization: in cases where the condition in IF/WHEN is resolved down - to TRUE or FALSE at compile time cobc doesn't emit any code - -** refactored and extended compiler and runtime messages with available - translations (currently to Spanish, Portuguese and Dutch, partial to German) - -** screen IO: many extended ACCEPT DISPLAY and SCREEN SECTION changes - -** Direct call interface for C: - CALL-CONVENTION for CALLs and PROCEDURE DIVISION - ENTRY-CONVENTION for PROCEDURE DIVISION and ENTRY statement - SIZE of parameters specified for CALL ... BY VALUE - RETURN NOTHING for calling void functions - RETURN ADDRESS OF VAR for calling functions returning a pointer - PROCEDURE DIVISION RETURNING OMITTED -> callable as void function - -** Much, much more! - - -* New cobc options: - -** New -std options: - - cobol2014 COBOL 2014 Standard - xopen X/Open COBOL Standard - mf-strict Micro Focus COBOL compatibility - strict - ibm-strict IBM COBOL compatibility - strict - ibm-strict MVS/VM COBOL compatibility - strict - acu ACUCOBOL-GT compatibility - acu-strict ACUCOBOL-GT compatibility - strict - bs2000 BS2000 COBOL compatibility (back again) - bs2000-strict BS2000 COBOL compatibility - strict - rm RM-COBOL compatibility - rm-strict RM-COBOL compatibility - strict - - Note: - The GnuCOBOL compiler tries to limit both the feature-set and reserved words - to the specified compiler when the "strict" dialects are used. - COBOL sources compiled with these dialects are therefore likely to compile - with the specified compiler and vice versa: sources that were compiled on - the specified compiler should compile without any issues with GnuCOBOL. - - With the "non-strict" dialects GnuCOBOL will activate the complete - feature-set where it doesn't directly conflict with the specified dialect, - including reserved words and GnuCOBOL specific extensions. - COBOL sources compiled with these dialects therefore may work only - with GnuCOBOL. COBOL sources may need a change because of rich feature-set - and reserved words in GnuCOBOL, otherwise offending words may be removed - by `-fno-reserved=word`. - COBOL-85, X/Open COBOL, COBOL 2002 and COBOL 2014 are always "strict". - -** New listing options: - - -t listing, -T wide listing, --tlines=lines, lines per page of listing - -Xref - - Note: -P, generate preprocessor listing, is still available (and improved) - -** All compiler configuration flags may be set on command line - to override a specific setting of the current -std, see cobc --help - -** All warnings can be explicit enabled/disabled or even marked as error, - see cobc --help, examples: - -Wunreachable warn about likely unreachable statements - -Wno-dialect do not warn about dialect specific issues - -Werror treat all warnings as errors - -Werror= treat specified as error - -** Options for the C compiler/linker: - -K , compile entry point as static (resolve at link time) - -A, add options to C compile phase - -Q, add options to C link phase - -** Miscellaneous - -i -info, display build/environment - -D define symbol for Compiler Directive Facility - -j -job=args, run job after compile - input filename of '-' reads source from standard in - For more: see cobc --help - -* Changed cobc options: - -** The option -ffunctions-all (allow use of intrinsic functions without - FUNCTION keyword) was replaced by -fintrinsics=ALL. - -fintrinsics allows to also specify that only specific functions may - be used without the FUNCTION keyword. - The preferred option is to not use these cobc options at all but to - specify this within the COBOL code (CONFIGURATION SECTION. REPOSITORY.) - - -* New cobcrun options: - - -i -info, display build/environment - -r -runtime-config, display runtime configuration - -c -config, set runtime config from file - -M -module, set path/module name when looking for entry - - -* New build features - - make test downloads NIST testsuite if necessary - now usable with parallel builds (make -j4 test) - make checkall runs both the internal an NIST testsuite - -** testsuite defaults to coloured output - -** Windows(tm) Visual Studio build support files added, - options to validate the software generated with VS against both test suites - -** removed maintainer mode - if files need a rebuild because of a change - they are always rebuild - -** help2man, bison and flex are checked during configure, - if they need to be invoked and are missing a useful error message is given - -** All files created by GnuCOBOL runtime use the same file permission settings - now: COB_FILE_MODE which was changed to 0666 - -** The maximum number of fields passed via CALL changed from hard-wired 64 fields - to a configuration option (defaulting to 192, current max. 252) - -** changed unix package name from "gnu-cobol" to "gnucobol" - -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ - - GnuCOBOL 1.1 released (20140118) - -* Change unix package name to gnu-cobol, and project to GnuCOBOL -* list of changes see - https://open-cobol.sourceforge.io/faq/ - #what-are-the-differences-between-opencobol-1-1-and-gnucobol-1-1 - -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ - - OpenCOBOL 1.1 released (20090206) - -* Note: was tagged as pre-release and later on as full version - -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ - - OpenCOBOL 1.0 released - -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ - - Changes in OpenCOBOL 0.33 - -* New compile option '-x'. This causes the compiler to produce an - executable program. '-fmain' is deprecated. - -* Remove long option --verbose. Use '-v' for verbosity. Problem is - with getopt_long_only which does not like eg. -mv - -* New conformity option -std=bs2000. - -* FUNCTION is implemented. See cobc/reserved.c for a list of what is - implemented. - -* Nested programs are partially supported. - -* LINAGE is implemented. - -* EXTERNAL on FD is implemented. - -* SAME RECORD AREA is implemented. - -* New config variables - - "perform-osvs", "sticky-linkage". These are - activated for -std=ibm and -std=mvs. - "relax-level-hierarchy". Allows mismatched data - description level numbers. Activated for - -std=mf, ibm, mvs and bs2000. - -* Support for non-gcc compilers. - -* Large file support, system dynamic loading and Berkeley DB inclusion - are default for the configure. - ie. ./configure assumes --with-db --with-lfs64 --with-dl - -* New configure option --with-patch-level= - Default is 0. - -* At run time, version checking is done. ie. When executing/loading - Cobol programs, the version (eg. 0.33) and the patch level (eg. 0) - are checked against the OC library version/patch level. - -* Libtool is not required for systems that support native dynamic - loading. This includes GNU/Linux, Cygwin and MingW amongst others. - -* Note to developers : See README for required software versions. - -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ - - Changes in OpenCOBOL 0.32 - -* Stability update - See individual ChangeLogs - -* New internal register - NUMBER-OF-CALL-PARAMETERS - -* New config variables - larger-redefines-ok, relaxed-syntax-check - -* Powerpc changes - We now pass all OC and Cobol85 tests - -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ - - Changes in OpenCOBOL 0.31 - -* Stability update - See individual ChangeLogs - -* New driver program - "cobcrun" - This allows all application programs to be compiled as - modules and driven by "cobcrun" similar to MF's "cobrun". - Syntax - cobcrun [Arguments to program "MAINPROG"] - As "cobcrun" is linked with the static version of OpenCOBOL - libraries, it is easier to maintain concurrent versions on the - same system. - -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ - - Changes in OpenCOBOL 0.30 - -* Installation changes - -** No longer use readline. - -** No longer use run-time configuration file (libcob.conf) - -** libdb is now optional. -Use the new configure option --with-db1 to link with libdb1. -Use the new configure option --with-db to link with libdb. -Otherwise, libdb will not be linked, and indexed files and -SORT/MERGE statements will not work. - -*** New subdirectory `config' will be installed under -$prefix/share/gnucobol. - -** Compatibility changes - -*** New -std options: - - default used when you omit -std - cobol85 COBOL 85 Standard - cobol2002 COBOL 2002 Standard - ibm IBM COBOL compatibility - mf Micro Focus COBOL compatibility - v023 OpenCOBOL 0.23 compatibility - -*** Compile-time options can be stored in a "config" file. -See config/default.conf for details. - -*** Binary data items are now big endian. -The config option `binary-byteorder' controls this. - -*** Numeric sign of USAGE DISPLAY items has been changed as follows: - - Positive: 0123456789 Negative: pqrstuvwxy - -The config option `display-sign' controls this. - -*** Data items defined in the working-storage section are -initialized at the beginning of program by default. -The config option `auto-initialize' controls this. - -*** SORT statement now creates a temporary file in /tmp for sorting -and removes it after sorting. - -** Feature changes - -*** COPY statements try to complement the following file extensions: -.CBL, .COB, .cbl, or .cob. - -*** COPY / REPLACE statements are reimplemented for better replacement. - -*** SPECIAL-NAMES. FORMFEED IS ... - -*** ALPHABET ... IS EBCDIC. - -*** EXTERNAL clause. - -*** SHARING clause. - -*** USAGE COMP-5 and COMP-X. - -*** USAGE POINTER and ADDRESS OF operator. - -*** LENGTH OF operator. - -*** PROCEDURE DIVISION USING BY REFERENCE/CONTENT/VALUE. - -*** DISPLAY ... ENVIRONMENT-NAME. ACCEPT ... ENVIRONMENT-VALUE. - -*** COLLATING SEQUENCE in the SORT and MERGE statements. - -*** EXIT PERFORM [CYCLE] statement. - -*** SORT table. - -*** OPEN ... WITH NO REWIND / WITH LOCK recognized, though not working. - -*** Literal concatenation (the `&' operator). - -** Compiler changes - -*** New compiler environment variable TMPDIR. - -*** New compiler environment variable COB_LDFLAGS. - -*** The runtime environment variable COB_CONFIG_FILE has been removed. - -*** New runtime environment variable COB_DYNAMIC_RELOADING. - -*** New compiler option `--list-reserved', which list all reserved words. - -*** New compiler option `-conf', which specifies the config file. - -*** New compiler option `-ext', which specifies the copy file extension. - -*** The compiler option `-O' now does C level optimization. - -*** New compiler option `-O2', which does further C level optimization. - -*** New compiler option `-L' and `-l', which are passed to the C compiler. - -*** New compiler option `-ftrace', which display section names at run time. - -*** New compiler option `-fsyntax-only', which does syntax error check -only without any output. - -*** New compiler option `-fstatic-call', which is equivalent to `-static'. - -*** New compiler option `-fdebugging-line', which enables debugging lines. - -*** New compiler option `-fsource-location', which includes source location -in the output. - -*** New compiler option `-fline-directive', which includes line directive -in the output. - -*** New compiler option `-fruntime-inlining', which is the replacement -of obsolete options `-finline-move' and `-finline-get-int'. - -*** New compiler option `-w', which inhibits warnings. - -*** New compiler option `-Wredefinition', which warns redefined names. - -*** The compiler options `-static' and `-dynamic' are obsolete. - -*** The compiler option `-column' removed. - -** Many improvement for compatibility. - -** Many many bug fixes. - -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ - -* Changes in OpenCOBOL 0.23 - -** Installation changes - -*** We use the GNU MP library again. - -** Run-time library changes - -*** `cob_resolve' now search the main program for the module name. - -** Bug fixes - -*** Duplicate use of intermediate field variables. - -*** fseek issues on the MinGW environment. - -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ - -* Changes in OpenCOBOL 0.22 - -** Installation changes - -*** We no longer depend on the GNU MP library. - -Decimal arithmetic is done by using `long long'. - -** Compiler changes - -*** Alphabet-name has been implemented. - -*** Variable-length table has been implemented. - -*** De-editing (move numeric-edited to numeric) has been implemented. - -** Bug fixes - -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ - -* Changes in OpenCOBOL 0.21 - -** Installation changes - -*** New configure argument --with-lfs64. - -** Compiler changes - -*** New option -std, which specifies which COBOL standard to use. - -Currently the following standards are available: - - gnu GnuCOBOL (default) - cobol85 COBOL 85 - cobol2002 COBOL 2002 - mvs IBM COBOL for MVS & VM - -*** New option -O, which enables some optimization. - -*** New option -debug, which enables run-time error checking. - -*** New option -Wobsolete, which reports obsolete features. - -*** New option -Warchaic, which reports archaic features. - -*** -Wnext-sentence has been removed. Use -Warchaic instead. - -*** -fdebugging-line has been removed. - -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ - -* Changes in OpenCOBOL 0.20 - -** cobpp has been integrated into cobc. - -Now cobc is the only binary program. - -** cobc now generates an executable without `-main' flag. - -`-main' has been renamed to `-fmain', which is turned on -by default if none of -E, -C, -S, -c, or -m is given. - -** The default source format is now the fixed form. - -The format will not be detected automatically. You need -to use SOURCE FORMAT compiler directive as described below. -This conforms to the COBOL 2002 standard. - -** Compiler directive "SOURCE FORMAT" is now supported. - -Put the following line at the beginning of file if you -want to use the free-form: - - >>SOURCE FORMAT IS FREE - -** Option `-semi-fixed' has been removed. - -If you want to expand the program text area over 72 columns, -use the option `-column' instead. - -** New option `-column', which specifies the end of program text area. - -** New option `-T', which specifies the tab width. - -** New warning options: - - -Wall Enable all warnings - -Wcolumn-overflow Warn any text after column 72 - -Wconstant Warn inconsistent constant - -Wparentheses Warn lacks of parentheses around AND within OR - -Wnext-sentence Warn uses of NEXT SENTENCE - -Wimplicit-terminator Warn lacks of scope terminator (END-XXX) - -Wstrict-typing Warn type mismatch strictly - -** Option `debug' has been renamed to `-fdebugging-line'. - -** USAGE PACKED-DECIMAL is now supported. - -** Improved error checking. - -** Additional testsuite entries. - -** Bug fixes. - -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ - -* Changes in OpenCOBOL 0.12 - -** Improved compile-time error check. - -** Additional testsuite entries. - -** Bug fixes. - -* Changes in OpenCOBOL 0.11 - -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ - -** Part of run-time library interface has been redesigned. - -** Bug fixes. - -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ - -* Changes in OpenCOBOL 0.10 - -** Autoconf 2.57, Automake 1.7.2, Libtool 1.4.3, and Gettext 0.11.5 -are used for packaging. - -** New file cob.pc, which is used by pkg-config script. - -** libcob.conf is now installed under sysconfdir (i.e., $(PREFIX)/etc). -The default value of COB_CONFIG_FILE has been changed appropriately. - -** The directory `tests' includes new testsuites. -"make check" will run the tests. - -** We use db1 again instead of db2 or db3. - -** New option -semi-fixed. - -** New option -Wtrailing-line. - -** CALL statements now accept CONTENT LENGTH OF clause. - -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ - -* Changes in OpenCOBOL 0.9.7 - -** The default value of COB_CONFIG_FILE has been changed to -"$PREFIX/etc/gnucobol/libcob.conf". - -** SORT and MERGE statements have been impelemented. - -** Preliminary implementation of SCREEN SECTION. - -** Many bug fixes and improvements. - -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ - -* Changes in OpenCOBOL 0.9.6 - -** cobc now requires `-main' flag to build an executable from a COBOL file. - -Without -main, cobc does not generate a main function. -See manual for details. - -** Run-time configuration file: libcob.conf - -The environment variable `COB_CONFIG_FILE' specifies the file name -(default: "${prefix}/share/gnucobol/libcob.conf"). - -** Use gettext for international messages. - -** Include the test suite in subdir `testsuite'. - -** Many bug fixes and improvements. - -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ - -* Changes in OpenCOBOL 0.9.5 - -** Support Berkeley DB 2.0. - -** Many bug fixes. - -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ - -* Changes in OpenCOBOL 0.9.4 - -** OpenCOBOL now requires Berkeley DB 3.0 or later. - -** File I/O routine (libcob/fileio.c) has been reimplemented. - -** New NIST Test Suite modules: SM, IC, SQ, RL, IX. - -** Many bug fixes. diff -Nru gnucobol-4.0~early~20200606/po/boldquot.sed gnucobol-5/po/boldquot.sed --- gnucobol-4.0~early~20200606/po/boldquot.sed 2020-06-06 20:52:02.000000000 +0000 +++ gnucobol-5/po/boldquot.sed 1970-01-01 00:00:00.000000000 +0000 @@ -1,10 +0,0 @@ -s/"\([^"]*\)"/“\1â€/g -s/`\([^`']*\)'/‘\1’/g -s/ '\([^`']*\)' / ‘\1’ /g -s/ '\([^`']*\)'$/ ‘\1’/g -s/^'\([^`']*\)' /‘\1’ /g -s/“â€/""/g -s/“/“/g -s/â€/â€/g -s/‘/‘/g -s/’/’/g diff -Nru gnucobol-4.0~early~20200606/po/ChangeLog gnucobol-5/po/ChangeLog --- gnucobol-4.0~early~20200606/po/ChangeLog 2020-06-06 20:52:02.000000000 +0000 +++ gnucobol-5/po/ChangeLog 1970-01-01 00:00:00.000000000 +0000 @@ -1,84 +0,0 @@ - -2018-03-05 Simon Sobisch - - * POTFILES.in: Changed bison/flex generated sources back to the real - sources as the "not a real string" errors are now fixed by correct - escaping in the used expressions and translators may only have the - VCS checkout, not the complete tarball - -2018-02-18 Simon Sobisch - - * general: updated translations from TP - * gnucobol.pot: recreated by running `make update-po` - -2017-12-05 Simon Sobisch - - * update_linguas.sh: only include en@quot and en@boldquot in LINGUAS once - * sv.po: added Swedish (translated by Sebastian Rasmussen) - -2017-09-06 Simon Sobisch - - * update_linguas.sh: always include the generated en@boldquot - en@quot in LINGUAS on recreation - * general: updated translations from TP - * de.po: added German (translated by Simon Sobisch and Mario Blättermann) - * gnucobol.pot: recreated by running `make update-po` - -2017-08-08 Simon Sobisch - - * update_linguas.sh: auto-add new translations received from TP - to svn; only run make if a Makefile actually exists - -2017-05-09 Simon Sobisch - - * pt.po: added Portuguese (translated by Mario Matos) - -2016-12-05 Simon Sobisch - - * update_linguas.sh: added shell for updating the translations - before a release, used version from nano-project as template - * Makevars: set DIST_DEPENDS_ON_UPDATE_PO to no - * en.translate: removed - -2016-11-05 gettextize - - * Makefile.in.in: Upgrade to gettext-0.19.8.1. - * Rules-quot: Upgrade to gettext-0.19.8.1. - -2016-08-12 Simon Sobisch - - * Makevars: added --no-wrap to MSGMERGE_OPTIONS (upon request of TP) - * POTFILES.in: Changed bison/flex sources to the generated sources - (same strings but no "looks like a string, but isn't one") - -2015-03-06 gettextize - - * Makefile.in.in: Upgrade to gettext-0.19.4. - * Rules-quot: Upgrade to gettext-0.19.4. - -2014-01-20 Simon Sobisch - - * gettext extra message catalogs en@quot and en@boldquot added - -2013-10-11 Simon Sobisch - - * nl.po: added Dutch (translated by Ed Borchert and Ronald Heirbaut) - -2011-06-14 Simon Sobisch - - * es.po: added Spanish (translated by Randy Coman) - -2010-06-28 Roger While - - * MARK - Version 2.0 - * Move to GPL/LGPL 3 - -2002-05-29 Keisuke Nishida - - * ja.po: New file. - - -Copyright 2002,2010,2011,2014-2018 Free Software Foundation, Inc. - -Copying and distribution of this file, with or without modification, are -permitted provided the copyright notice and this notice are preserved. Binary files /tmp/tmp8r0303vl/MzBWgGBJBM/gnucobol-4.0~early~20200606/po/de.gmo and /tmp/tmp8r0303vl/cieYbammgl/gnucobol-5/po/de.gmo differ diff -Nru gnucobol-4.0~early~20200606/po/de.po gnucobol-5/po/de.po --- gnucobol-4.0~early~20200606/po/de.po 2020-06-06 20:53:00.000000000 +0000 +++ gnucobol-5/po/de.po 1970-01-01 00:00:00.000000000 +0000 @@ -1,5966 +0,0 @@ -# German translations for GNU Cobol package -# Copyright (C) 2017 Free Software Foundation, Inc. -# This file is distributed under the same license as the gnucobol package. -# Simon Sobisch , 2013. -# Mario Blättermann , 2017. -# Roland Illig , 2019. -# -msgid "" -msgstr "" -"Project-Id-Version: gnucobol-2.2-rc1\n" -"Report-Msgid-Bugs-To: gnucobol-messages@gnu.org\n" -"POT-Creation-Date: 2020-06-06 20:52+0000\n" -"PO-Revision-Date: 2019-05-12 15:44+0200\n" -"Last-Translator: Roland Illig \n" -"Language-Team: German \n" -"Language: de\n" -"MIME-Version: 1.0\n" -"Content-Type: text/plain; charset=utf-8\n" -"Content-Transfer-Encoding: 8bit\n" -"X-Bugs: Report translation errors to the Language-Team address.\n" -"X-Poedit-Basepath: ..\n" -"X-Generator: Poedit 2.2.1\n" - -#: cobc/cobc.c:117 -#, c-format -msgid "invalid parameter: %s" -msgstr "Ungültiger Parameter: %s" - -#: cobc/cobc.c:826 -msgid "too many errors" -msgstr "zu viele Fehler" - -#: cobc/cobc.c:838 -#, fuzzy -msgid "internal compiler error" -msgstr "%s: %d: Interner Compiler-Fehler" - -#: cobc/cobc.c:904 cobc/cobc.c:991 cobc/cobc.c:1051 cobc/cobc.c:1127 -#: cobc/cobc.c:1167 cobc/cobc.c:1243 -#, c-format -msgid "cannot allocate %d bytes of memory" -msgstr "Nicht möglich, %d Bytes Arbeitsspeicher bereitzustellen" - -#: cobc/cobc.c:917 cobc/cobc.c:933 cobc/cobc.c:953 cobc/cobc.c:1011 -#: cobc/cobc.c:1029 cobc/cobc.c:1147 cobc/cobc.c:1262 cobc/cobc.c:1279 -#: cobc/field.c:2008 libcob/common.c:7121 -#, c-format -msgid "call to %s with NULL pointer" -msgstr "Aufruf von %s mit NULL-Zeiger" - -#: cobc/cobc.c:974 -#, c-format -msgid "cannot reallocate %d bytes of memory" -msgstr "Nicht möglich, %d Bytes Arbeitsspeicher neu bereitzustellen" - -#: cobc/cobc.c:1068 cobc/cobc.c:1184 -msgid "attempt to reallocate non-allocated memory" -msgstr "Versuch, nicht bereitgestellten Arbeitsspeicher neu bereitzustellen" - -#: cobc/cobc.c:1101 cobc/cobc.c:1217 -#, c-format -msgid "call to %s with invalid pointer, as it is missing in list" -msgstr "Aufruf von %s mit ungültigem Zeiger, da er in der Liste fehlt" - -#: cobc/cobc.c:1390 -#, fuzzy, c-format -msgid "assuming literal for unquoted '%s'" -msgstr "Warnung - Assuming Literal für unquoted '%s'" - -#: cobc/cobc.c:1437 -#, fuzzy -msgid " - length exceeds maximum" -msgstr "PROGRAM Name überschreitet 31 Zeichen" - -#: cobc/cobc.c:1441 -msgid " - name cannot be empty" -msgstr "" - -#: cobc/cobc.c:1444 -msgid " - name cannot begin with space or underscore" -msgstr " - Name darf nicht mit einem Leerzeichen oder Unterstrich beginnen" - -#: cobc/cobc.c:1447 -msgid " - name cannot begin with 'cob_' or 'COB_'" -msgstr " - Name darf nicht mit »cob_« oder »COB_« beginnen" - -#: cobc/cobc.c:1450 -msgid " - name duplicates a 'C' keyword" -msgstr " - Name entspricht einem »C«-Schlüsselwort" - -#: cobc/cobc.c:1453 -msgid " - name cannot contain a directory separator" -msgstr " - Name darf kein Pfad-Trennzeichen enthalten" - -#: cobc/cobc.c:1462 -#, c-format -msgid "invalid file base name '%s'%s" -msgstr "Ungültiger Basisname »%s«%s" - -#: cobc/cobc.c:1466 -#, c-format -msgid "invalid ENTRY '%s'%s" -msgstr "Ungültiger ENTRY »%s«%s" - -#: cobc/cobc.c:1469 -#, c-format -msgid "invalid PROGRAM-ID '%s'%s" -msgstr "Ungültige PROGRAM-ID »%s«%s" - -#: cobc/cobc.c:1596 cobc/cobc.c:8151 -#, fuzzy -msgid "please check environment variables as noted above" -msgstr "Umgebungsvariablen" - -#: cobc/cobc.c:1608 cobc/error.c:254 cobc/error.c:274 cobc/error.c:505 -#: cobc/error.c:528 -msgid "error: " -msgstr "Fehler: " - -#: cobc/cobc.c:1631 -#, c-format -msgid "duplicate DEFINE '%s' - ignored" -msgstr "doppeltes DEFINE »%s« – ignoriert" - -#: cobc/cobc.c:1683 -#, c-format -msgid "environment variable '%s' is '%s'; should not contain '%c'" -msgstr "Umgebungsvariable »%s« ist »%s«; sollte kein »%c« enthalten" - -#: cobc/cobc.c:1712 -msgid "parameter buffer size exceeded" -msgstr "Parameter-Buffer überschritten" - -#: cobc/cobc.c:1752 -#, c-format -msgid "warning: could not move temporary file to %s" -msgstr "Warnung: Temporäre Datei konnte nicht nach %s verschoben werden" - -#: cobc/cobc.c:1957 cobc/cobc.c:1960 cobc/parser.y:803 cobc/reserved.c:3807 -#: libcob/common.c:761 libcob/common.c:1805 libcob/common.c:2002 -#: libcob/common.c:6325 libcob/common.c:7495 libcob/common.c:8025 -#: libcob/common.c:8104 -msgid "unknown" -msgstr "Unbekannt" - -#: cobc/cobc.c:1963 -#, c-format -msgid "aborting codegen for %s (%s: %s)" -msgstr "Codegenerierung für %s wird abgebrochen (%s:%s)" - -#: cobc/cobc.c:1966 -#, c-format -msgid "aborting compile of %s at line %d (%s: %s)" -msgstr "Compilieren von %s wird in Zeile %d abgebrochen (%s:%s)" - -#: cobc/cobc.c:1970 -msgid "aborting" -msgstr "Abbruch" - -#: cobc/cobc.c:1993 cobc/cobc.c:2028 libcob/common.c:7086 bin/cobcrun.c:342 -msgid "Please report this!" -msgstr "Bitte melden Sie das!" - -#: cobc/cobc.c:2046 bin/cobcrun.c:106 -#, fuzzy -msgid "License GPLv3+: GNU GPL version 3 or later " -msgstr "Lizenz GPLv3+: GNU GPL Version 3 oder neuer " - -#: cobc/cobc.c:2047 libcob/common.c:7316 bin/cobcrun.c:107 -msgid "" -"This is free software; see the source for copying conditions. There is NO\n" -"warranty; not even for MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE." -msgstr "" -"Dies ist freie Software; die Kopierbedingungen stehen in den Quellen. Es gibt\n" -"KEINE Garantie; auch nicht für MARKTGÄNGIGKEIT oder FÃœR SPEZIELLE ZWECKE." - -#: cobc/cobc.c:2049 libcob/common.c:7318 bin/cobcrun.c:109 -#, c-format -msgid "Written by %s\n" -msgstr "Geschrieben von %s\n" - -#. TRANSLATORS: This msgid is indented as the "Packaged" msgid, %s expands to date and time -#: cobc/cobc.c:2050 cobc/cobc.c:2063 libcob/common.c:7321 bin/cobcrun.c:110 -#, c-format -msgid "Built %s" -msgstr "Erstellt %s" - -#. TRANSLATORS: This msgid is indented as the "Built" msgid, %s expands to date and time -#: cobc/cobc.c:2052 cobc/cobc.c:2065 libcob/common.c:7324 bin/cobcrun.c:112 -#, c-format -msgid "Packaged %s" -msgstr "Gepackt %s" - -#: cobc/cobc.c:2054 cobc/cobc.c:2067 -#, c-format -msgid "C version %s%s" -msgstr "C-Version %s%s" - -#: cobc/cobc.c:2080 -msgid "executing:" -msgstr "Wird ausgeführt:" - -#: cobc/cobc.c:2082 -msgid "to be executed:" -msgstr "zum Ausführen:" - -#: cobc/cobc.c:2120 cobc/cobc.c:2121 libcob/common.c:5815 libcob/common.c:5816 -#: libcob/common.c:5847 libcob/common.c:5848 -msgid "env" -msgstr "Umg." - -#: cobc/cobc.c:2156 libcob/common.c:7351 -msgid "build information" -msgstr "Build-Informationen" - -#: cobc/cobc.c:2157 libcob/common.c:7352 -msgid "build environment" -msgstr "Build-Umgebung" - -#: cobc/cobc.c:2167 libcob/common.c:7363 -msgid "GnuCOBOL information" -msgstr "GnuCOBOL-Information" - -#: cobc/cobc.c:2212 libcob/common.c:6366 libcob/common.c:7386 -#: libcob/common.c:7486 libcob/common.c:7493 -msgid "yes" -msgstr "ja" - -#: cobc/cobc.c:2214 libcob/common.c:6368 libcob/common.c:7388 -#: libcob/common.c:7488 -msgid "no" -msgstr "nein" - -#: cobc/cobc.c:2218 libcob/common.c:7392 -msgid "8 bytes" -msgstr "8 Bytes" - -#: cobc/cobc.c:2220 libcob/common.c:7394 -msgid "4 bytes" -msgstr "4 Bytes" - -#: cobc/cobc.c:2224 cobc/cobc.c:2226 libcob/common.c:7398 libcob/common.c:7400 -msgid "endianness" -msgstr "" - -#: cobc/cobc.c:2224 libcob/common.c:7398 -msgid "big-endian" -msgstr "" - -#: cobc/cobc.c:2226 libcob/common.c:7400 -msgid "little-endian" -msgstr "" - -#: cobc/cobc.c:2230 cobc/cobc.c:2232 libcob/common.c:7404 libcob/common.c:7406 -msgid "native character set" -msgstr "" - -#: cobc/cobc.c:2230 libcob/common.c:7404 -msgid "EBCDIC" -msgstr "" - -#: cobc/cobc.c:2232 libcob/common.c:7406 -msgid "ASCII" -msgstr "" - -#: cobc/cobc.c:2235 libcob/common.c:7410 libcob/common.c:7476 -msgid "extended screen I/O" -msgstr "Erweiterte Bildschirm-Ein-/Ausgabe" - -#: cobc/cobc.c:2238 libcob/common.c:7502 -#, fuzzy -msgid "variable file format" -msgstr "Variablenformat" - -#: cobc/cobc.c:2244 cobc/cobc.c:2246 libcob/common.c:7508 libcob/common.c:7510 -#, fuzzy -msgid "sequential file handler" -msgstr "Sequenzieller Handler" - -#: cobc/cobc.c:2246 libcob/common.c:7510 -msgid "built-in" -msgstr "eingebaut" - -#: cobc/cobc.c:2254 cobc/cobc.c:2260 cobc/cobc.c:2262 cobc/cobc.c:2269 -#: cobc/cobc.c:2271 cobc/cobc.c:2275 cobc/cobc.c:2278 cobc/cobc.c:2282 -#: cobc/cobc.c:2284 cobc/cobc.c:2289 cobc/cobc.c:2291 cobc/cobc.c:2298 -#: cobc/cobc.c:2300 cobc/cobc.c:2307 libcob/common.c:7516 libcob/common.c:7527 -#: libcob/common.c:7533 libcob/common.c:7535 libcob/common.c:7539 -#: libcob/common.c:7542 libcob/common.c:7546 libcob/common.c:7548 -#: libcob/common.c:7553 libcob/common.c:7555 libcob/common.c:7562 -#: libcob/common.c:7564 libcob/common.c:7571 -#, fuzzy -msgid "indexed file handler" -msgstr "Sequenzieller Handler" - -#: cobc/cobc.c:2304 libcob/common.c:7568 -msgid "default indexed handler" -msgstr "" - -#: cobc/cobc.c:2307 cobc/cobc.c:2319 cobc/cobc.c:2325 libcob/common.c:7381 -#: libcob/common.c:7498 libcob/common.c:7571 libcob/common.c:7611 -#: libcob/common.c:7625 -msgid "disabled" -msgstr "Deaktiviert" - -#: cobc/cobc.c:2311 cobc/cobc.c:2313 libcob/common.c:7594 libcob/common.c:7596 -msgid "mathematical library" -msgstr "Mathematische Bibliothek" - -#: cobc/cobc.c:2317 cobc/cobc.c:2319 libcob/common.c:7605 libcob/common.c:7611 -msgid "XML library" -msgstr "" - -#: cobc/cobc.c:2323 cobc/cobc.c:2325 libcob/common.c:7623 libcob/common.c:7625 -msgid "JSON library" -msgstr "" - -#: cobc/cobc.c:2332 -msgid "only one of options 'E', 'S', 'C', 'c' may be specified" -msgstr "Nur eine der Optionen »E«, »S«, »C« oder »c« kann angegeben werden" - -#: cobc/cobc.c:2338 -msgid "only one of options 'm', 'x', 'b' may be specified" -msgstr "Nur eine der Optionen »m«, »x« oder »b« kann angegeben werden" - -#: cobc/cobc.c:2367 -#, c-format -msgid "-fdump= requires one of 'ALL', 'FD', 'WS', 'LS', 'RD', 'FD', 'SC' not '%s'" -msgstr "" - -#: cobc/cobc.c:2392 -#, c-format -msgid "'%s' is not an intrinsic function" -msgstr "»%s« ist keine intrinsische Funktion" - -#: cobc/cobc.c:2434 cobc/cobc.c:7516 cobc/cobc.c:7630 cobc/codegen.c:3796 -#: cobc/codegen.c:3905 cobc/codegen.c:5221 cobc/codegen.c:12426 cobc/tree.c:789 -#: cobc/tree.c:1221 cobc/tree.c:4101 cobc/tree.c:4648 cobc/tree.c:4891 -#: cobc/typeck.c:3294 cobc/typeck.c:7812 cobc/typeck.c:7847 cobc/typeck.c:8660 -#: cobc/typeck.c:11261 cobc/typeck.c:11329 cobc/typeck.c:11397 -#: cobc/typeck.c:11681 cobc/typeck.c:11724 -#, c-format -msgid "call to '%s' with invalid parameter '%s'" -msgstr "Aufruf von »%s« mit ungültigem Parameter »%s«" - -#: cobc/cobc.c:2737 -msgid "loading standard configuration file 'default.conf'" -msgstr "Standard-Konfigurationsdatei »default.conf« wird geladen" - -#: cobc/cobc.c:2871 -msgid "invalid output file name" -msgstr "Ungültiger Ausgabename" - -#: cobc/cobc.c:2971 -#, c-format -msgid "warning: '%s' is not a directory, defaulting to current directory" -msgstr "Warnung: »%s« ist kein Verzeichnis, aktuelles Verzeichnis wird verwendet" - -#: cobc/cobc.c:2998 -#, c-format -msgid "warning: %d lines per listing page specified, using %d" -msgstr "" - -#: cobc/cobc.c:3048 -#, c-format -msgid "warning: assuming '%s' is a DEFINE - did you intend to use -debug?" -msgstr "Warnung: »%s« wird als DEFINE angenommen, sollte -debug verwendet werden?" - -#: cobc/cobc.c:3315 -#, c-format -msgid "unknown warning option '%s'" -msgstr "" - -#: cobc/cobc.c:3367 -#, c-format -msgid "%s option requires a listing file" -msgstr "%s: Option erfordert eine Listendatei" - -#: cobc/cobc.c:3374 -msgid "output to stdout only valid for preprocess" -msgstr "" - -#: cobc/cobc.c:3466 -msgid "all runtime checks are enabled" -msgstr "" - -#: cobc/cobc.c:3572 -msgid "only one stdin input allowed" -msgstr "" - -#: cobc/cobc.c:3582 -#, c-format -msgid "invalid file name parameter (length > %d)" -msgstr "Ungültiger Dateinamensparameter (Länge > %d)" - -#: cobc/cobc.c:3807 -msgid "nothing for -j to run" -msgstr "" - -#: cobc/cobc.c:3883 cobc/cobc.c:4071 cobc/cobc.c:4130 cobc/cobc.c:4158 -#: cobc/cobc.c:4247 cobc/cobc.c:4306 cobc/cobc.c:4430 cobc/cobc.c:4469 -#: cobc/cobc.c:6993 -msgid "return status:" -msgstr "Rückgabestatus:" - -#: cobc/cobc.c:4361 -msgid "preprocessing:" -msgstr "Aufbereitung:" - -#: cobc/cobc.c:4435 -msgid "'cobxref' execution unsuccessful" -msgstr "Ausführung von »cobxref« nicht erfolgreich" - -#: cobc/cobc.c:4438 -#, c-format -msgid "check that 'cobxref' is in %s" -msgstr "Ãœberprüfen Sie, ob »cobxref« in %s enthalten ist" - -#: cobc/cobc.c:4440 -msgid "no listing produced" -msgstr "Es wurde kein Listing erzeugt" - -#: cobc/cobc.c:5328 cobc/cobc.c:5367 -msgid "No fields defined." -msgstr "" - -#: cobc/cobc.c:5387 -msgid "No labels defined." -msgstr "" - -#: cobc/cobc.c:5409 -msgid "Error/Warning summary:" -msgstr "" - -#: cobc/cobc.c:5453 -msgid "0 warnings in compilation group" -msgstr "" - -#: cobc/cobc.c:5457 -msgid "1 warning in compilation group" -msgstr "" - -#: cobc/cobc.c:5461 -#, c-format -msgid "%d warnings in compilation group" -msgstr "" - -#: cobc/cobc.c:5467 -msgid "0 errors in compilation group" -msgstr "" - -#: cobc/cobc.c:5471 -msgid "1 error in compilation group" -msgstr "" - -#: cobc/cobc.c:5475 -#, c-format -msgid "%d errors in compilation group" -msgstr "" - -#: cobc/cobc.c:5481 -#, c-format -msgid "Too many errors in compilation group: %d maximum errors" -msgstr "" - -#: cobc/cobc.c:6050 -#, c-format -msgid "%s: %d: Too many continuation lines" -msgstr "" - -#: cobc/cobc.c:6972 -msgid "parsing:" -msgstr "Analyse:" - -#: cobc/cobc.c:7034 -msgid "translating:" -msgstr "Ãœbersetzung:" - -#: cobc/cobc.c:8157 -msgid "no input files" -msgstr "Keine Eingabedateien" - -#: cobc/cobc.c:8186 -#, c-format -msgid "%s option invalid in this combination" -msgstr "Die Option %s ist in dieser Kombination ungültig" - -#: cobc/cobc.c:8227 -msgid "command line:" -msgstr "Befehlszeile:" - -#: cobc/codegen.c:973 cobc/codegen.c:4487 cobc/codegen.c:11093 -msgid "unexpected CONSTANT item" -msgstr "Unerwartetes CONSTANT-Element" - -#: cobc/codegen.c:1188 cobc/codegen.c:1196 cobc/codegen.c:1291 -#: cobc/codegen.c:1603 cobc/codegen.c:2202 cobc/codegen.c:3212 -#: cobc/codegen.c:3455 cobc/codegen.c:3988 cobc/codegen.c:4454 -#: cobc/codegen.c:7902 cobc/codegen.c:8507 cobc/codegen.c:10298 -#: cobc/field.c:817 cobc/scanner.l:2104 cobc/tree.c:611 cobc/tree.c:3728 -#: cobc/typeck.c:5015 cobc/typeck.c:8662 cobc/typeck.c:9657 -#, c-format -msgid "unexpected tree tag: %d" -msgstr "Unerwartete Kennzeichnungsmarke im Baum: %d" - -#: cobc/codegen.c:2999 cobc/codegen.c:3295 cobc/codegen.c:8125 cobc/tree.c:1243 -#, fuzzy, c-format -msgid "unexpected cast type: %d" -msgstr "Unerwartete Typumwandlung %d" - -#: cobc/codegen.c:3725 cobc/codegen.c:4434 -#, c-format -msgid "internal statement stack depth exceeded: %d" -msgstr "" - -#: cobc/codegen.c:3798 -#, c-format -msgid "%s is not a field" -msgstr "" - -#: cobc/codegen.c:4186 cobc/codegen.c:4279 -#, c-format -msgid "unexpected function: %s" -msgstr "Unerwartete Funktion: %s" - -#: cobc/codegen.c:4270 -#, fuzzy, c-format -msgid "unexpected operator: %c" -msgstr "Unerwarteter Operator: %d" - -#: cobc/codegen.c:5043 -#, c-format -msgid "unexpected tree category: %d" -msgstr "Unerwartete Baum-Kategorie: %d" - -#: cobc/codegen.c:5438 cobc/codegen.c:5465 cobc/codegen.c:5662 -#: cobc/codegen.c:5694 -#, c-format -msgid "unexpected size: %d" -msgstr "Unerwartete Größe: %d" - -#: cobc/codegen.c:7254 -#, c-format -msgid "No ENTRY FOR GO TO '%s'" -msgstr "" - -#: cobc/codegen.c:7475 cobc/codegen.c:7725 -#, c-format -msgid "unexpected handler type: %d" -msgstr "Unerwartete Handler-Typ: %d" - -#: cobc/codegen.c:7823 -msgid "unexpected error_node parameter" -msgstr "Unerwarteter error_node-Parameter" - -#: cobc/codegen.c:8146 -#, c-format -msgid "unexpected tree type: %d" -msgstr "Unerwarteter Baum-Typ: %d" - -#: cobc/codegen.c:8703 cobc/typeck.c:6511 cobc/typeck.c:12940 -#: cobc/typeck.c:12984 -#, fuzzy, c-format -msgid "compiler is not configured to support %s" -msgstr "Die Laufzeitumgebung ist für diese Operation nicht konfiguriert" - -#: cobc/codegen.c:9128 -msgid "Nested OCCURS in report" -msgstr "" - -#: cobc/codeoptim.c:2762 -#, c-format -msgid "unexpected optimization value: %d" -msgstr "Unerwarteter Wert für die Optimierung: %d" - -#: cobc/config.c:162 libcob/common.c:6786 libcob/common.c:6800 -#: libcob/common.c:7242 -#, c-format -msgid "invalid value '%s' for configuration tag '%s'" -msgstr "Unerwarteter Wert »%s« für Konfigurationseintrag »%s«" - -#: cobc/config.c:165 libcob/common.c:6093 libcob/common.c:6209 -#, c-format -msgid "should be one of the following values: %s" -msgstr "" - -#: cobc/config.c:167 -msgid "must be numeric" -msgstr "muss numerisch sein" - -#: cobc/config.c:169 libcob/common.c:6191 -#, c-format -msgid "maximum value: %lu" -msgstr "Maximalwert: %lu" - -#: cobc/config.c:171 -#, c-format -msgid "minimum value: %d" -msgstr "Minimalwert: %d" - -#: cobc/config.c:203 -#, c-format -msgid "unsupported value '%s' for configuration tag '%s'" -msgstr "Nicht unterstützter Wert »%s« für Konfigurationseintrag »%s«" - -#: cobc/config.c:311 cobc/pplex.l:977 libcob/common.c:6702 -msgid "recursive inclusion" -msgstr "" - -#: cobc/config.c:386 libcob/common.c:6753 -#, fuzzy -msgid "configuration file was included here" -msgstr "Ungültige Konfiguration '%s'" - -#: cobc/config.c:415 -#, c-format -msgid "The previous loaded configuration '%s' will be discarded." -msgstr "" - -#: cobc/config.c:449 -msgid "missing definitions:" -msgstr "Fehlende Definitionen:" - -#: cobc/config.c:451 -#, c-format -msgid "\tno definition of '%s'" -msgstr "\tFehlende Definition von »%s«" - -#: cobc/config.c:512 -#, c-format -msgid "invalid configuration tag '%s'" -msgstr "Ungültiger Konfigurationseintrag »%s«" - -#: cobc/config.c:525 libcob/common.c:6509 libcob/common.c:6592 -#: libcob/common.c:6620 -#, c-format -msgid "unknown configuration tag '%s'" -msgstr "Unbekannter Konfigurationseintrag »%s«" - -#: cobc/config.c:549 -#, c-format -msgid "invalid configuration tag '%s' in word-list" -msgstr "" - -#: cobc/config.c:608 -#, c-format -msgid "Could not access word list for '%s'" -msgstr "" - -#: cobc/error.c:87 -#, fuzzy, c-format -msgid "in section '%s':" -msgstr "Im Abschnitt" - -#: cobc/error.c:98 -#, fuzzy, c-format -msgid "in paragraph '%s':" -msgstr "Im Absatz" - -#: cobc/error.c:121 libcob/common.c:7252 -msgid "configuration error:" -msgstr "Konfigurationsfehler:" - -#: cobc/error.c:134 libcob/common.c:673 -#, c-format -msgid "system error %d" -msgstr "Systemfehler %d" - -#: cobc/error.c:231 cobc/error.c:323 cobc/error.c:478 -msgid "error [-Werror]: " -msgstr "" - -#: cobc/error.c:231 cobc/error.c:323 cobc/error.c:478 cobc/error.c:505 -#: libcob/common.c:6881 libcob/common.c:6906 -#, c-format -msgid "warning: " -msgstr "Warnung: " - -#: cobc/error.c:274 cobc/error.c:528 -msgid "error (ignored): " -msgstr "" - -#: cobc/error.c:364 cobc/error.c:380 cobc/error.c:563 cobc/error.c:584 -#, c-format -msgid "%s used" -msgstr "%s belegt" - -#: cobc/error.c:367 cobc/error.c:566 -#, c-format -msgid "%s is archaic in %s" -msgstr "%s ist veraltet in %s" - -#: cobc/error.c:371 cobc/error.c:570 -#, c-format -msgid "%s is obsolete in %s" -msgstr "%s ist obsolet in %s" - -#: cobc/error.c:377 cobc/error.c:576 cobc/parser.y:5186 cobc/parser.y:5325 -#, c-format -msgid "%s ignored" -msgstr "%s ignoriert" - -#: cobc/error.c:383 cobc/error.c:586 -#, c-format -msgid "%s does not conform to %s" -msgstr "%s entspricht nicht %s" - -#: cobc/error.c:399 -msgid "configuration warning:" -msgstr "Konfigurationswarnung:" - -#: cobc/error.c:621 cobc/error.c:640 -#, c-format -msgid "redefinition of '%s'" -msgstr "Neudefinition von »%s«" - -#: cobc/error.c:628 cobc/error.c:653 -#, c-format -msgid "'%s' previously defined here" -msgstr "»%s« wurde zuvor hier definiert" - -#: cobc/error.c:677 cobc/error.c:684 -#, c-format -msgid "'%s' is not defined" -msgstr "»%s« ist nicht definiert" - -#: cobc/error.c:680 -#, c-format -msgid "'%s' cannot be used here" -msgstr "»%s« kann hier nicht verwendet werden" - -#: cobc/error.c:682 cobc/parser.y:7009 -#, c-format -msgid "'%s' is not defined, but is a reserved word in another dialect" -msgstr "»%s« ist nicht definiert, aber in einem anderen Dialekt ein reserviertes Wort" - -#: cobc/error.c:716 -#, c-format -msgid "'%s' is ambiguous; needs qualification" -msgstr "»%s« ist mehrdeutig; erfordert Eingrenzung" - -#: cobc/error.c:746 cobc/parser.y:16748 -#, c-format -msgid "'%s' defined here" -msgstr "»%s« ist hier definiert" - -#: cobc/error.c:757 -#, c-format -msgid "fatal error: %s" -msgstr "Schwerwiegender Fehler: %s" - -#: cobc/error.c:765 -#, c-format -msgid "group item '%s' cannot have %s clause" -msgstr "Gruppeneintrag »%s« kann keine %s-Klausel haben" - -#: cobc/error.c:779 -#, fuzzy, c-format -msgid "constant item '%s' requires a %s clause" -msgstr "Konstante '%s' benötigte eine %s Klausel" - -#: cobc/error.c:781 -#, fuzzy, c-format -msgid "level %02d item '%s' requires a %s clause" -msgstr "Konstante '%s' benötigte eine %s Klausel" - -#: cobc/error.c:795 -#, c-format -msgid "constant item '%s' can only have a %s clause" -msgstr "Konstante »%s« kann nur eine %s-Klausel haben" - -#: cobc/error.c:797 -#, c-format -msgid "level %02d item '%s' can only have a %s clause" -msgstr "" - -#: cobc/field.c:131 -msgid "constant expression has Divide by ZERO" -msgstr "" - -#: cobc/field.c:187 cobc/field.c:324 cobc/field.c:332 -msgid "missing right parenthesis" -msgstr "Rechte Klammer fehlt" - -#: cobc/field.c:216 -#, c-format -msgid "expression stack overflow at %d entries for operation '%c'" -msgstr "" - -#: cobc/field.c:257 -#, c-format -msgid "expression stack overflow at %d entries" -msgstr "" - -#: cobc/field.c:274 -msgid "missing left parenthesis" -msgstr "Linke Klammer fehlt" - -#: cobc/field.c:315 -#, c-format -msgid "invalid operator '%s' in expression" -msgstr "Ungültiger Operator »%s« im Ausdruck" - -#: cobc/field.c:334 -#, c-format -msgid "'%c' operator misplaced" -msgstr "" - -#: cobc/field.c:395 -#, c-format -msgid "invalid level number '%s'" -msgstr "Ungültige Stufennummer »%s«" - -#: cobc/field.c:454 -#, fuzzy -msgid "entry following SAME AS may not be subordinate to it" -msgstr "END PROGRAM '%s' ist unterschiedlich zur PROGRAM-ID '%s'" - -#: cobc/field.c:459 cobc/field.c:496 -msgid "level number must begin with 01 or 77" -msgstr "Stufennummer muss mit 01 oder 77 beginnen" - -#: cobc/field.c:541 cobc/field.c:557 -#, c-format -msgid "no previous data item of level %02d" -msgstr "Kein bisheriges Datenelement der Stufe %02d" - -#: cobc/field.c:599 -#, c-format -msgid "'%s' cannot be qualified here" -msgstr "" - -#: cobc/field.c:605 -#, c-format -msgid "'%s' cannot be subscripted here" -msgstr "" - -#: cobc/field.c:617 -#, c-format -msgid "'%s' is not defined in '%s'" -msgstr "»%s« ist nicht in »%s« definiert" - -#: cobc/field.c:638 -msgid "level number of REDEFINES entries must be identical" -msgstr "Stufennummern für REDEFINES-Einträge müssen übereinstimmen" - -#: cobc/field.c:643 -#, c-format -msgid "'%s' is not the original definition" -msgstr "»%s« ist nicht die ursprüngliche Definition" - -#: cobc/field.c:758 -#, c-format -msgid "PICTURE clause not compatible with USAGE %s" -msgstr "PICTURE-Klausel nicht kompatibel mit USAGE-Angabe %s" - -#: cobc/field.c:855 cobc/field.c:930 cobc/field.c:941 -#, c-format -msgid "PICTURE clause required for '%s'" -msgstr "PICTURE-Klausel notwendig für »%s«" - -#: cobc/field.c:937 -#, c-format -msgid "a non-numeric literal is expected for '%s'" -msgstr "Ein nicht-numerisches Literal wird für »%s« erwartet" - -#: cobc/field.c:949 -#, fuzzy, c-format -msgid "defining implicit picture size %d for '%s'" -msgstr "Definiere implizite Picture-Größer %d für '%s'" - -#: cobc/field.c:969 -#, c-format -msgid "'%s' ANY LENGTH only allowed in LINKAGE" -msgstr "»%s« ANY LENGTH nur in LINKAGE zulässig" - -#: cobc/field.c:973 -#, c-format -msgid "'%s' ANY LENGTH must be 01 level" -msgstr "»%s« ANY LENGTH muss auf Level 01 sein" - -#: cobc/field.c:977 -#, c-format -msgid "'%s' ANY LENGTH cannot be BASED/EXTERNAL" -msgstr "»%s« ANY LENGTH kann nicht als BASED/EXTERNAL deklariert sein" - -#: cobc/field.c:982 cobc/field.c:1010 -#, c-format -msgid "'%s' ANY LENGTH has invalid definition" -msgstr "»%s« ANY LENGTH hat eine ungültige Definition" - -#: cobc/field.c:993 -#, c-format -msgid "'%s' ANY NUMERIC must be PIC 9" -msgstr "" - -#: cobc/field.c:998 -#, fuzzy, c-format -msgid "'%s' ANY LENGTH must be PIC X or PIC N" -msgstr "»%s« ANY LENGTH muss auf Level 01 sein" - -#: cobc/field.c:1008 -#, c-format -msgid "'%s' ANY NUMERIC has invalid definition" -msgstr "" - -#: cobc/field.c:1026 -#, c-format -msgid "'%s' EXTERNAL must be specified at 01/77 level" -msgstr "»%s« EXTERNAL muss auf der Stufennummer 01/77 angegeben werden" - -#: cobc/field.c:1030 -#, c-format -msgid "'%s' EXTERNAL can only be specified in WORKING-STORAGE section" -msgstr "»%s« EXTERNAL kann nur im Abschnitt WORKING-STORAGE angegeben werden" - -#: cobc/field.c:1034 -#, c-format -msgid "'%s' EXTERNAL and BASED are mutually exclusive" -msgstr "»%s« EXTERNAL und BASED schließen sich gegenseitig aus" - -#: cobc/field.c:1037 -#, c-format -msgid "'%s' EXTERNAL not allowed with REDEFINES" -msgstr "»%s« EXTERNAL ist mit REDEFINES nicht zulässig" - -#: cobc/field.c:1049 -#, c-format -msgid "'%s' BASED not allowed here" -msgstr "»%s« BASED hier nicht zulässig" - -#: cobc/field.c:1052 -#, c-format -msgid "'%s' BASED not allowed with REDEFINES" -msgstr "»%s« BASED nicht zulässig mit REDEFINES" - -#: cobc/field.c:1055 -#, c-format -msgid "'%s' BASED only allowed at the 01 and 77 levels" -msgstr "»%s« BASED nur auf den Stufennumern 01 und 77 zulässig" - -#: cobc/field.c:1067 -#, fuzzy, c-format -msgid "level %02d item '%s' cannot have a %s clause" -msgstr "'%s' kann keine PICTURE Klausel haben" - -#: cobc/field.c:1082 -#, c-format -msgid "'%s' cannot have the OCCURS clause due to '%s'" -msgstr "" - -#: cobc/field.c:1101 -#, c-format -msgid "the original definition '%s' should not have OCCURS clause" -msgstr "Die ursprüngliche Definition »%s« sollte keine OCCURS-Klausel aufweisen" - -#: cobc/field.c:1108 -msgid "REDEFINES must follow the original definition" -msgstr "REDEFINES muss der ursprünglichen Definition folgen" - -#: cobc/field.c:1115 -#, c-format -msgid "'%s' cannot be variable length" -msgstr "»%s« kann keine variable Länge aufweisen" - -#: cobc/field.c:1118 -#, fuzzy, c-format -msgid "the original definition '%s' cannot be variable length" -msgstr "Die ursprüngliche Definition '%s' kann keine variable Länge aufweisen" - -#: cobc/field.c:1142 -#, c-format -msgid "SCREEN group item '%s' has invalid clause" -msgstr "" - -#: cobc/field.c:1223 -#, fuzzy, c-format -msgid "%s USAGE %s incompatible with %s USAGE %s" -msgstr "PICTURE-Klausel nicht kompatibel mit USAGE-Angabe %s" - -#: cobc/field.c:1302 -#, c-format -msgid "'%s' cannot have PICTURE clause" -msgstr "»%s« kann keine PICTURE-Klausel haben" - -#: cobc/field.c:1318 cobc/field.c:1328 -#, fuzzy, c-format -msgid "%s item '%s' should be USAGE DISPLAY" -msgstr "'%s' ist nicht in der LINKAGE SECTION enthalten" - -#: cobc/field.c:1351 -#, c-format -msgid "'%s' COMP-6 with sign - changing to COMP-3" -msgstr "»%s« COMP-6 mit Vorzeichen - Umwandlung in COMP-3" - -#: cobc/field.c:1377 -msgid "elementary items with SIGN clause must have S in PICTURE" -msgstr "" - -#: cobc/field.c:1380 -msgid "elementary items with SIGN clause must be USAGE DISPLAY or NATIONAL" -msgstr "" - -#: cobc/field.c:1397 -#, c-format -msgid "'%s' cannot have JUSTIFIED RIGHT" -msgstr "»%s« kann nicht das Attribut JUSTIFIED RIGHT haben" - -#: cobc/field.c:1410 -#, fuzzy, c-format -msgid "'%s' cannot have S in PICTURE string and BLANK WHEN ZERO" -msgstr "'%s' kann nicht das Attribut BLANK WHEN ZERO haben" - -#: cobc/field.c:1415 -#, c-format -msgid "'%s' cannot have BLANK WHEN ZERO without being USAGE DISPLAY or NATIONAL" -msgstr "" - -#: cobc/field.c:1426 -#, fuzzy, c-format -msgid "'%s' cannot have * in PICTURE string and BLANK WHEN ZERO" -msgstr "'%s' kann nicht das Attribut BLANK WHEN ZERO haben" - -#: cobc/field.c:1433 -#, fuzzy, c-format -msgid "'%s' is not numeric, so cannot have BLANK WHEN ZERO" -msgstr "'%s' kann nicht das Attribut BLANK WHEN ZERO haben" - -#: cobc/field.c:1446 -msgid "only level 88 items may have multiple values" -msgstr "Nur Elemente der Stufe 88 dürfen mehrere Werte haben" - -#: cobc/field.c:1454 cobc/field.c:1458 -#, fuzzy, c-format -msgid "initial VALUE clause ignored for %s item '%s'" -msgstr "%s-Klausel wird für Datei »%s« benötigt" - -#: cobc/field.c:1471 -msgid "FULL has no effect on numeric items; you may want REQUIRED or PIC Z" -msgstr "" - -#: cobc/field.c:1499 -msgid "VALUE may not contain a figurative constant" -msgstr "" - -#: cobc/field.c:1507 -#, fuzzy -msgid "cannot specify both FULL and JUSTIFIED" -msgstr "%s und %s können nicht gleichzeitig angegeben werden" - -#: cobc/field.c:1519 -#, c-format -msgid "'%s' has FROM, TO or USING without PIC; PIC will be implied" -msgstr "" - -#: cobc/field.c:1533 -#, c-format -msgid "'%s' has numeric VALUE without PIC; PIC will be implied" -msgstr "" - -#: cobc/field.c:1548 -#, c-format -msgid "'%s' cannot have PIC without FROM, TO, USING or numeric VALUE" -msgstr "" - -#: cobc/field.c:1560 -#, c-format -msgid "'%s' needs a PIC, FROM, TO, USING, VALUE, BELL, BLANK or ERASE clause" -msgstr "" - -#: cobc/field.c:1574 -#, fuzzy -msgid "cannot specify both PIC and VALUE" -msgstr "%s und %s können nicht gleichzeitig angegeben werden" - -#: cobc/field.c:1582 -msgid "cannot have PIC without FROM, TO or USING" -msgstr "" - -#: cobc/field.c:1591 -msgid "cannot have FROM, TO or USING without PIC" -msgstr "" - -#: cobc/field.c:1600 -#, fuzzy -msgid "VALUE item may not be numeric" -msgstr "Element INITIALIZED TO ist nicht alphanumerisch" - -#: cobc/field.c:1616 -#, c-format -msgid "'%s' needs a PIC, COL, LINE, VALUE, BELL or BLANK clause" -msgstr "" - -#: cobc/field.c:1647 -msgid "cannot use AUTO, FULL, PROMPT, REQUIRED or SECURE on elementary item without TO or USING" -msgstr "" - -#: cobc/field.c:1654 -msgid "cannot use BLANK WHEN ZERO, JUSTIFIED, OCCURS or SIGN on item without FROM, TO or USING" -msgstr "" - -#: cobc/field.c:1674 -msgid "cannot use AUTO, FULL, REQUIRED or SECURE on elementary item without FROM, TO or USING" -msgstr "" - -#: cobc/field.c:1679 -msgid "cannot use BLANK WHEN ZERO, JUSTIFIED or SIGN without FROM, TO or USING" -msgstr "" - -#: cobc/field.c:1697 -#, fuzzy -msgid "cannot have BLANK WHEN ZERO without PIC" -msgstr "'%s' kann nicht das Attribut BLANK WHEN ZERO haben" - -#: cobc/field.c:1700 -#, fuzzy -msgid "cannot have JUSTIFIED without PIC" -msgstr "»%s« kann nicht das Attribut JUSTIFIED RIGHT haben" - -#: cobc/field.c:1720 -msgid "cannot have AUTO without FROM, TO or USING" -msgstr "" - -#: cobc/field.c:1725 -msgid "cannot use FULL or REQUIRED on item without TO or USING" -msgstr "" - -#: cobc/field.c:1732 -msgid "SECURE can be used with TO only" -msgstr "" - -#: cobc/field.c:1734 -#, fuzzy -msgid "SECURE must be used with TO" -msgstr "Zuerst muss ein READ erfolgen" - -#: cobc/field.c:1753 -#, fuzzy, c-format -msgid "'%s' does nothing" -msgstr "»%s« ist nicht definiert" - -#: cobc/field.c:1797 -#, fuzzy -msgid "BLANK ZERO not compatible with USAGE" -msgstr "PICTURE-Klausel nicht kompatibel mit USAGE-Angabe %s" - -#: cobc/field.c:1800 -#, fuzzy -msgid "SIGN clause not compatible with USAGE" -msgstr "PICTURE-Klausel nicht kompatibel mit USAGE-Angabe %s" - -#: cobc/field.c:1977 -#, fuzzy, c-format -msgid "'%s' PICTURE clause not compatible with USAGE" -msgstr "PICTURE-Klausel nicht kompatibel mit USAGE-Angabe %s" - -#: cobc/field.c:2027 -#, fuzzy, c-format -msgid "'%s' 77 level is not allowed here" -msgstr "»%s« Level 77 hier nicht erlaubt" - -#: cobc/field.c:2424 -msgid "OCCURS and multi COLUMNs is not allowed" -msgstr "" - -#: cobc/field.c:2452 -#, fuzzy, c-format -msgid "duplicate LINE %d ignored" -msgstr "doppeltes DEFINE »%s« – ignoriert" - -#: cobc/field.c:2469 -#, c-format -msgid "ignoring SYNCHRONIZED for group item '%s'" -msgstr "" - -#: cobc/field.c:2485 cobc/field.c:2498 cobc/field.c:2778 cobc/field.c:2781 -#, c-format -msgid "size of '%s' larger than size of '%s'" -msgstr "Größe von »%s« überschreitet die Größe von »%s«" - -#: cobc/field.c:2638 cobc/field.c:2703 -#, c-format -msgid "'%s' cannot be larger than %d bytes" -msgstr "»%s« kann nicht größer als %d Bytes sein" - -#: cobc/field.c:2676 cobc/field.c:2684 -#, c-format -msgid "'%s' binary field cannot be larger than %d digits" -msgstr "»%s« Als Binary deklariertes Element kann nicht größer als %d Ziffern sein" - -#: cobc/field.c:2764 cobc/field.c:3216 -#, c-format -msgid "unexpected USAGE: %d" -msgstr "Unerwartete USAGE-Angabe: %d" - -#: cobc/field.c:2876 -msgid "literal type does not match numeric data type" -msgstr "Typ des Literals stimmt nicht mit dem numerischen Datentypen überein" - -#: cobc/field.c:2953 -#, c-format -msgid "THRU item '%s' may not come before '%s'" -msgstr "" - -#: cobc/field.c:2976 -#, c-format -msgid "RENAMES cannot start/end at the OCCURS item '%s'" -msgstr "" - -#: cobc/field.c:2984 -#, c-format -msgid "cannot use RENAMES on part of the table '%s'" -msgstr "" - -#: cobc/field.c:3022 -#, c-format -msgid "RENAMES may not contain '%s' as it is a pointer or object reference" -msgstr "" - -#: cobc/field.c:3027 -#, c-format -msgid "RENAMES may not contain '%s' as it is an OCCURS DEPENDING table" -msgstr "" - -#: cobc/field.c:3049 -msgid "RENAMES of 01-, 66- and 77-level items" -msgstr "" - -#: cobc/field.c:3051 -msgid "RENAMES may not reference a level 88" -msgstr "" - -#: cobc/field.c:3075 -#, c-format -msgid "'%s' must immediately follow the record '%s'" -msgstr "" - -#: cobc/field.c:3083 -#, fuzzy, c-format -msgid "THRU item must be different to '%s'" -msgstr "END PROGRAM '%s' ist unterschiedlich zur PROGRAM-ID '%s'" - -#: cobc/field.c:3089 -#, c-format -msgid "'%s' and '%s' must be in the same record" -msgstr "" - -#: cobc/field.c:3100 -#, fuzzy, c-format -msgid "THRU item '%s' may not be subordinate to '%s'" -msgstr "END PROGRAM '%s' ist unterschiedlich zur PROGRAM-ID '%s'" - -#: cobc/flag.def:40 -msgid "" -" -fstack-size=\tdefine PERFORM stack size\n" -" * default: 255" -msgstr "" - -#: cobc/flag.def:44 -msgid "" -" -fsign=[ASCII|EBCDIC]\tdefine display sign representation\n" -" * default: machine native" -msgstr "" - -#: cobc/flag.def:48 -msgid "" -" -ffold-copy=[UPPER|LOWER]\tfold COPY subject to value\n" -" * default: no transformation" -msgstr "" - -#: cobc/flag.def:52 -msgid "" -" -ffold-call=[UPPER|LOWER]\tfold PROGRAM-ID, CALL, CANCEL subject to value\n" -" * default: no transformation" -msgstr "" - -#: cobc/flag.def:56 -msgid "" -" -fdefaultbyte=\tinitialize fields without VALUE to value\n" -" * decimal 0..255 or any quoted character\n" -" * default: initialize to picture" -msgstr "" - -#: cobc/flag.def:61 -msgid "" -" -fmax-errors=\tmaximum number of errors to report before\n" -" compilation is aborted\n" -" * default: 128" -msgstr "" - -#: cobc/flag.def:68 -msgid "" -" -fintrinsics=[ALL|intrinsic function name(,name,...)]\n" -" intrinsics to be used without FUNCTION keyword" -msgstr "" - -#: cobc/flag.def:72 -msgid "" -" -fdump= dump data fields on abort, may be\n" -" a combination of: ALL, WS, LS, RD, FD, SC" -msgstr "" - -#: cobc/flag.def:76 -msgid "" -" -fcallfh= use external provided EXTFH interface module\n" -" for I/O" -msgstr "" - -#: cobc/flag.def:80 -msgid "" -" -fsqldb= which Database is used, may be\n" -" MySQL, MSSQL, Oracle10, Oracle11, Oracle12" -msgstr "" - -#: cobc/flag.def:84 -msgid " -fsqlschema= define database schema name" -msgstr "" - -#: cobc/flag.def:91 -msgid "" -" -fno-recursive-check disable check of recursive program call;\n" -" effectively compiling as RECURSIVE program" -msgstr "" - -#: cobc/flag.def:95 -#, fuzzy -msgid "" -" -fwinmain generate WinMain instead of main when compiling\n" -" as executable" -msgstr "" -" -i, -info Compilerinformation (Bauen/Umgebung) anzeigen\n" -" und Programm beenden" - -#: cobc/flag.def:99 -#, fuzzy -msgid " -fcomputed-goto generate computed goto C statements" -msgstr "Erzeuge berechnete goto C statements" - -#: cobc/flag.def:102 -msgid " -falternate-ebcdic use restricted ASCII to EBCDIC translate" -msgstr "" - -#: cobc/flag.def:105 -msgid " -fextra-brace generate extra braces in C source" -msgstr "" - -#: cobc/flag.def:108 -msgid " -fgen-c-line-directives\tgenerate source location directives in C code" -msgstr "" - -#: cobc/flag.def:111 -msgid " -fgen-c-labels generate extra labels in C sources" -msgstr "" - -#: cobc/flag.def:114 -msgid " -fcorrect-numeric attempt correction of invalid numeric display items" -msgstr "" - -#: cobc/flag.def:117 -msgid " -fstack-on-heap PERFORM stack allocated on heap" -msgstr "" - -#: cobc/flag.def:120 -msgid " -ffast-math Disables emitting faster arithmetic logic" -msgstr "" - -#: cobc/flag.def:125 -msgid "" -" -fno-remove-unreachable\tdisable remove of unreachable code\n" -" * turned off by -g" -msgstr "" - -#: cobc/flag.def:129 -msgid " -finline-intrinsic\twhen possible resolve intrinsic FUNCTIONs at compile time" -msgstr "" - -#: cobc/flag.def:132 -#, fuzzy -msgid "" -" -ftrace generate trace code\n" -" * scope: executed SECTION/PARAGRAPH" -msgstr "" -" -Xref Querverweis mittels »cobxref« generieren\n" -" (»cobxref« von V. Coen muss sich im Pfad befinden)" - -#: cobc/flag.def:136 -msgid "" -" -ftraceall generate trace code\n" -" * scope: executed SECTION/PARAGRAPH/STATEMENTS\n" -" * turned on by -debug" -msgstr "" - -#: cobc/flag.def:141 -msgid " -fsyntax-only syntax error checking only; don't emit any output" -msgstr "" - -#: cobc/flag.def:144 -msgid "" -" -fdebugging-line enable debugging lines\n" -" * 'D' in indicator column or floating >>D" -msgstr "" - -#: cobc/flag.def:148 -msgid "" -" -fsource-location generate source location code\n" -" * turned on by -debug/-g/-ftraceall" -msgstr "" - -#: cobc/flag.def:152 -msgid " -fimplicit-init automatic initialization of the COBOL runtime system" -msgstr "" - -#: cobc/flag.def:155 -msgid "" -" -fstack-check PERFORM stack checking\n" -" * turned on by -debug or -g" -msgstr "" - -#: cobc/flag.def:159 -msgid "" -" -fwrite-after use AFTER 1 for WRITE of LINE SEQUENTIAL\n" -" * default: BEFORE 1" -msgstr "" - -#: cobc/flag.def:163 -msgid "" -" -fmfcomment '*' or '/' in column 1 treated as comment\n" -" * FIXED format only" -msgstr "" - -#: cobc/flag.def:167 -msgid "" -" -facucomment '$' in indicator area treated as '*',\n" -" '|' treated as floating comment" -msgstr "" - -#: cobc/flag.def:171 -msgid "" -" -fnotrunc allow numeric field overflow\n" -" * non-ANSI behaviour" -msgstr "" - -#: cobc/flag.def:175 -msgid "" -" -fodoslide adjust items following OCCURS DEPENDING\n" -" * implies -fcomplex-odo" -msgstr "" - -#: cobc/flag.def:179 -msgid "" -" -fsingle-quote use a single quote (apostrophe) for QUOTE\n" -" * default: double quote" -msgstr "" - -#: cobc/flag.def:189 -msgid "" -" -foptional-file treat all files as OPTIONAL\n" -" * unless NOT OPTIONAL specified" -msgstr "" - -#: cobc/flag.def:193 -#, fuzzy -msgid " -fstatic-call output static function calls for the CALL statement" -msgstr "Statische Funktionsaufrufe für das CALL Statement ausgeben" - -#: cobc/flag.def:196 -msgid "" -" -fno-gen-c-decl-static-call\tdisable generation of C function declations\n" -" for subroutines with static CALL" -msgstr "" - -#: cobc/flag.def:200 -msgid " -fmf-files Sequential & Relative files will match Micro Focus format" -msgstr "" - -#: cobc/flag.def:203 -msgid "" -" -fno-theaders suppress all headers and output of compilation\n" -" options from listing while keeping page breaks" -msgstr "" - -#: cobc/flag.def:207 -#, fuzzy -msgid " -fno-tsource suppress source from listing" -msgstr " -F, -free verwendet freies Quellformat" - -#: cobc/flag.def:210 -msgid " -fno-tmessages suppress warning and error summary from listing" -msgstr "" - -#: cobc/flag.def:213 -#, fuzzy -msgid " -ftsymbols specify symbols in listing" -msgstr " --tsymbols Symbole für Listing angeben" - -#: cobc/parser.y:283 cobc/parser.y:317 -#, c-format -msgid "unreachable statement '%s'" -msgstr "" - -#: cobc/parser.y:410 cobc/parser.y:703 -#, c-format -msgid "'%s' is not in LINKAGE SECTION" -msgstr "»%s« ist nicht im LINKAGE-Abschnitt enthalten" - -#: cobc/parser.y:413 cobc/typeck.c:3705 -#, fuzzy, c-format -msgid "'%s' cannot be BASED/EXTERNAL" -msgstr "'%s' kann nicht als BASED/EXTERNAL deklariert werden" - -#: cobc/parser.y:418 -#, c-format -msgid "'%s' is not in WORKING-STORAGE SECTION" -msgstr "»%s« ist nicht im WORKING-STORAGE-Abschnitt enthalten" - -#: cobc/parser.y:425 cobc/typeck.c:3702 -#, c-format -msgid "'%s' not level 01 or 77" -msgstr "»%s« nicht auf Stufennummer 01 oder 77" - -#: cobc/parser.y:428 cobc/parser.y:443 cobc/typeck.c:3708 -#, c-format -msgid "'%s' REDEFINES field not allowed here" -msgstr "»%s« Feld mit REDEFINES-Angabe hier nicht erlaubt" - -#: cobc/parser.y:456 -#, c-format -msgid "'%s' USING item duplicates RETURNING item" -msgstr "" - -#: cobc/parser.y:466 -#, c-format -msgid "ENTRY '%s' duplicated" -msgstr "ENTRY »%s« doppelt vergeben" - -#: cobc/parser.y:502 -#, fuzzy, c-format -msgid "ENTRY FOR GO TO '%s' duplicated" -msgstr "ENTRY »%s« doppelt vergeben" - -#: cobc/parser.y:518 -#, c-format -msgid "maximum nested program depth exceeded (%d)" -msgstr "" - -#: cobc/parser.y:544 cobc/parser.y:571 -#, c-format -msgid "%s statement not terminated by %s" -msgstr "" - -#: cobc/parser.y:574 -#, c-format -msgid "%s statement not terminated" -msgstr "" - -#: cobc/parser.y:638 -msgid "USE statement invalid for SORT file" -msgstr "" - -#: cobc/parser.y:665 cobc/parser.y:667 -#, c-format -msgid "duplicate %s clause" -msgstr "Doppelte %s-Klausel" - -#: cobc/parser.y:685 -#, c-format -msgid "Cannot specify %s without number of lines on page" -msgstr "" - -#: cobc/parser.y:695 -#, c-format -msgid "maximum OCCURS depth exceeded (%d)" -msgstr "" - -#: cobc/parser.y:709 cobc/parser.y:711 cobc/parser.y:6808 cobc/parser.y:6811 -#: cobc/parser.y:6813 cobc/parser.y:6815 cobc/parser.y:6850 cobc/parser.y:7573 -#: cobc/parser.y:7575 cobc/parser.y:7577 cobc/parser.y:7579 cobc/parser.y:7625 -#: cobc/parser.y:7634 cobc/parser.y:9548 cobc/parser.y:10994 -#: cobc/parser.y:12370 cobc/parser.y:13552 -#, c-format -msgid "%s and %s are mutually exclusive" -msgstr "%s und %s schließen sich gegenseitig aus" - -#: cobc/parser.y:725 cobc/parser.y:729 -msgid "TO phrase without DEPENDING phrase" -msgstr "" - -#: cobc/parser.y:726 -msgid "maximum number of occurrences assumed to be exact number" -msgstr "" - -#: cobc/parser.y:733 cobc/parser.y:7355 -msgid "OCCURS TO must be greater than OCCURS FROM" -msgstr "" - -#: cobc/parser.y:742 -#, fuzzy -msgid "OCCURS DEPENDING ON without TO phrase" -msgstr "OCCURS DEPENDING ON »%s« außerhalb des gültigen Bereichs: %d" - -#: cobc/parser.y:808 -#, c-format -msgid "%s header missing - assumed" -msgstr "" - -#: cobc/parser.y:810 -#, c-format -msgid "%s header missing" -msgstr "" - -#: cobc/parser.y:942 -#, fuzzy, c-format -msgid "duplicate %s" -msgstr "Doppelte %s-Klausel" - -#: cobc/parser.y:944 -#, c-format -msgid "%s incorrectly after %s" -msgstr "" - -#: cobc/parser.y:1046 -#, c-format -msgid "redefinition of program name '%s'" -msgstr "Neudefinition von Programmname »%s«" - -#: cobc/parser.y:1050 -#, c-format -msgid "redefinition of program ID '%s'" -msgstr "Neudefinition der Programm-ID »%s«" - -#: cobc/parser.y:1082 -#, c-format -msgid "FUNCTION '%s' has no PROCEDURE DIVISION" -msgstr "" - -#: cobc/parser.y:1188 -msgid "functions may not be defined within a program/function" -msgstr "" - -#: cobc/parser.y:1238 -#, fuzzy, c-format -msgid "END FUNCTION '%s' is different from FUNCTION-ID '%s'" -msgstr "END FUNCTION '%s' ist unterschiedlich zur FUNCTION-ID '%s'" - -#: cobc/parser.y:1252 -#, fuzzy, c-format -msgid "END PROGRAM '%s' is different from PROGRAM-ID '%s'" -msgstr "END PROGRAM '%s' ist unterschiedlich zur PROGRAM-ID '%s'" - -#: cobc/parser.y:1301 -#, fuzzy -msgid "currency symbol must be one character long" -msgstr "»%s« CURSOR muss 4 oder 6 Zeichen lang sein" - -#: cobc/parser.y:1358 -#, fuzzy, c-format -msgid "invalid character '%c' in currency symbol" -msgstr "Ungültiger Operator »%s« im Ausdruck" - -#: cobc/parser.y:1374 -msgid "prototype has same name as current function and will be ignored" -msgstr "" - -#: cobc/parser.y:1401 -#, c-format -msgid "duplicate REPOSITORY entries for '%s' do not match" -msgstr "" - -#: cobc/parser.y:1405 -#, c-format -msgid "duplicate REPOSITORY entry for '%s'" -msgstr "" - -#: cobc/parser.y:1470 -#, c-format -msgid "ORGANIZATION %s is incompatible with RECORD DELIMITER" -msgstr "" - -#: cobc/parser.y:1502 -#, c-format -msgid "illegal combination of %s with other clauses" -msgstr "" - -#: cobc/parser.y:1517 cobc/parser.y:1520 cobc/parser.y:1551 -#, c-format -msgid "cannot specify both %s and %s" -msgstr "%s und %s können nicht gleichzeitig angegeben werden" - -#: cobc/parser.y:1548 -#, c-format -msgid "cannot specify both %s and %s; %s is ignored" -msgstr "%s und %s können nicht gleichzeitig angegeben werden; %s wird ignoriert" - -#: cobc/parser.y:1720 -msgid "FOR phrase cannot immediately follow ALL/LEADING/TRAILING" -msgstr "" - -#: cobc/parser.y:1722 -msgid "missing CHARACTERS/ALL/LEADING/TRAILING phrase after FOR phrase" -msgstr "" - -#: cobc/parser.y:1729 -msgid "missing value between ALL/LEADING/TRAILING words" -msgstr "" - -#: cobc/parser.y:1734 -msgid "missing FOR phrase before CHARACTERS/ALL/LEADING/TRAILING phrase" -msgstr "" - -#: cobc/parser.y:1741 -msgid "missing ALL/LEADING/TRAILING before value" -msgstr "" - -#: cobc/parser.y:1796 -msgid "use of condition-name in place of data-name" -msgstr "" - -#: cobc/parser.y:1800 cobc/parser.y:6753 cobc/typeck.c:665 -#, fuzzy, c-format -msgid "condition-name not allowed here: '%s'" -msgstr "Element mit Stufe 88 hier nicht zulässig" - -#: cobc/parser.y:1827 -msgid "cannot specify NO ADVANCING in screen DISPLAY" -msgstr "" - -#: cobc/parser.y:1899 cobc/parser.y:1916 -msgid "non-standard DISPLAY" -msgstr "" - -#: cobc/parser.y:1903 -msgid "screens may only be displayed on CRT" -msgstr "" - -#: cobc/parser.y:1908 cobc/parser.y:1951 -msgid "cannot mix screens and fields in the same DISPLAY statement" -msgstr "" - -#: cobc/parser.y:1912 -msgid "screen clauses may only be used for DISPLAY on CRT" -msgstr "" - -#: cobc/parser.y:1957 -msgid "ambiguous DISPLAY; put items to display on device in separate DISPLAY" -msgstr "" - -#: cobc/parser.y:1973 -#, c-format -msgid "%s is not an alphanumeric literal" -msgstr "»%s« ist kein alphanumerisches Literal" - -#: cobc/parser.y:1975 -#, fuzzy, c-format -msgid "'%s' is not USAGE DISPLAY" -msgstr "'%s' ist nicht in der LINKAGE SECTION enthalten" - -#: cobc/parser.y:1990 cobc/typeck.c:8481 -#, c-format -msgid "invalid target for %s" -msgstr "Ungültiges Ziel für %s" - -#: cobc/parser.y:1997 cobc/parser.y:6747 -#, fuzzy -msgid "SCREEN item cannot be used here" -msgstr "»%s« kann hier nicht verwendet werden" - -#: cobc/parser.y:1999 -#, fuzzy -msgid "RENAMES item may not be used here" -msgstr "Eine Konstante darf hier nicht verwendet werden – »%s«" - -#: cobc/parser.y:2001 cobc/typeck.c:2333 cobc/typeck.c:2429 -msgid "ANY LENGTH item not allowed here" -msgstr "Element ANY LENGTH hier nicht zulässig" - -#: cobc/parser.y:2005 -#, c-format -msgid "item '%s' has wrong class for VALIDATE" -msgstr "" - -#: cobc/parser.y:2014 -msgid "WHEN clause must follow EVERY clause" -msgstr "" - -#: cobc/parser.y:2096 cobc/parser.y:17197 -#, fuzzy -msgid "non-zero value expected" -msgstr "Ganzzahlwert erwartet" - -#: cobc/parser.y:2102 cobc/tree.c:4352 -#, c-format -msgid "RECORD size (IDX) exceeds maximum allowed (%d)" -msgstr "" - -#: cobc/parser.y:2106 cobc/tree.c:4355 -#, c-format -msgid "RECORD size exceeds maximum allowed (%d)" -msgstr "" - -#: cobc/parser.y:2111 -msgid "RECORD clause invalid" -msgstr "" - -#: cobc/parser.y:3188 -msgid "multiple PROGRAM-ID's without matching END PROGRAM" -msgstr "" - -#: cobc/parser.y:3191 -msgid "executable requested but no program found" -msgstr "" - -#: cobc/parser.y:3408 cobc/parser.y:3417 -msgid "COMMON may only be used in a contained program" -msgstr "" - -#: cobc/parser.y:3426 cobc/parser.y:3458 -msgid "CALL prototypes" -msgstr "" - -#: cobc/parser.y:3607 cobc/parser.y:3884 cobc/parser.y:3928 cobc/parser.y:4036 -#: cobc/parser.y:4223 cobc/parser.y:4319 cobc/parser.y:4360 cobc/parser.y:4431 -#: cobc/parser.y:4452 cobc/parser.y:4531 cobc/parser.y:4550 cobc/parser.y:4566 -#: cobc/parser.y:4584 cobc/parser.y:4602 cobc/parser.y:4619 cobc/parser.y:4637 -#: cobc/parser.y:6868 cobc/parser.y:7694 -#, c-format -msgid "%s not allowed in nested programs" -msgstr "" - -#: cobc/parser.y:3761 -msgid "segment-number must be in range of values 1 to 49" -msgstr "" - -#: cobc/parser.y:3773 -msgid "duplicate CLASSIFICATION clause" -msgstr "Doppelte CLASSIFICATION-Klausel" - -#: cobc/parser.y:3849 -msgid "PROGRAM phrase" -msgstr "" - -#: cobc/parser.y:3944 cobc/parser.y:3955 cobc/parser.y:4271 -#, c-format -msgid "invalid %s clause" -msgstr "Ungültige %s-Klausel" - -#: cobc/parser.y:4386 cobc/parser.y:4390 -msgid "CLASS literal with THRU must have size 1" -msgstr "" - -#: cobc/parser.y:4417 -#, fuzzy -msgid "CLASS IS integer IN alphabet-name" -msgstr "»%s« ist kein Bezeichner eines Alphabets" - -#: cobc/parser.y:4464 -msgid "separate currency symbol and currency string" -msgstr "" - -#: cobc/parser.y:4497 -#, c-format -msgid "invalid CURRENCY SIGN '%s'" -msgstr "Ungültiges CURRENCY SIGN »%s«" - -#: cobc/parser.y:4715 -msgid "cannot use RELATIVE KEY clause on INDEXED files" -msgstr "" - -#: cobc/parser.y:4719 -msgid "cannot use RECORD KEY clause on RELATIVE files" -msgstr "" - -#: cobc/parser.y:4793 -msgid "EXTERNAL/DYNAMIC cannot be used with literals" -msgstr "" - -#: cobc/parser.y:4813 -msgid "EXTERNAL/DYNAMIC cannot be used with USING/VARYING" -msgstr "" - -#: cobc/parser.y:4824 -msgid "EXTERNAL/DYNAMIC cannot be used with DISK FROM" -msgstr "" - -#: cobc/parser.y:4826 -msgid "ASSIGN DISK FROM" -msgstr "" - -#: cobc/parser.y:4942 -msgid "ASSIGN EXTERNAL/DYNAMIC" -msgstr "" - -#: cobc/parser.y:5165 -#, c-format -msgid "'%s' is not an alphabet-name" -msgstr "»%s« ist kein Bezeichner eines Alphabets" - -#: cobc/parser.y:5254 -#, c-format -msgid "%s only valid with ORGANIZATION %s" -msgstr "" - -#: cobc/parser.y:5321 cobc/parser.y:5344 -#, c-format -msgid "RECORD DELIMITER %s only allowed with SEQUENTIAL files" -msgstr "" - -#: cobc/parser.y:5323 cobc/parser.y:5336 cobc/parser.y:5348 cobc/parser.y:5358 -msgid "RECORD DELIMITER clause" -msgstr "" - -#: cobc/parser.y:5332 -#, c-format -msgid "RECORD DELIMITER %s only allowed with (LINE) SEQUENTIAL files" -msgstr "" - -#: cobc/parser.y:5337 -msgid "LINE-SEQUENTIAL phrase" -msgstr "" - -#: cobc/parser.y:5349 -msgid "BINARY-SEQUENTIAL phrase" -msgstr "" - -#: cobc/parser.y:5357 -msgid "RECORD DELIMITER clause only allowed with (LINE) SEQUENTIAL files" -msgstr "" - -#: cobc/parser.y:5360 -#, c-format -msgid "RECORD DELIMITER %s not recognized; will be ignored" -msgstr "" - -#: cobc/parser.y:5398 -msgid "DUPLICATES for primary keys" -msgstr "" - -#: cobc/parser.y:5637 -msgid "DOS/VS APPLY phrase" -msgstr "" - -#: cobc/parser.y:5752 -msgid "RECORD description missing or invalid" -msgstr "" - -#: cobc/parser.y:5778 -#, fuzzy, c-format -msgid "duplicate file description for %s" -msgstr "Doppelte Werte in Klasse »%s«" - -#: cobc/parser.y:5811 cobc/parser.y:5821 -msgid "file cannot have both EXTERNAL and GLOBAL clauses" -msgstr "" - -#: cobc/parser.y:5825 cobc/parser.y:6414 cobc/parser.y:6853 cobc/parser.y:12363 -#: cobc/parser.y:15305 -#, c-format -msgid "%s is invalid in a user FUNCTION" -msgstr "" - -#: cobc/parser.y:5863 cobc/parser.y:5872 -msgid "RECORD clause ignored for LINE SEQUENTIAL" -msgstr "" - -#: cobc/parser.y:5964 -msgid "LINAGE clause with wrong file type" -msgstr "" - -#: cobc/parser.y:6026 -msgid "RECORDING MODE U or S can only be used with RECORD SEQUENTIAL files" -msgstr "" - -#: cobc/parser.y:6059 -#, c-format -msgid "ignoring CODE-SET '%s'" -msgstr "Angabe CODE-SET »%s« wird ignoriert" - -#: cobc/parser.y:6070 -msgid "CODE-SET clause invalid for file type" -msgstr "" - -#: cobc/parser.y:6092 -msgid "REPORT clause with wrong file type" -msgstr "" - -#: cobc/parser.y:6170 -msgid "CD record missing" -msgstr "" - -#: cobc/parser.y:6601 -msgid "CONSTANT item not at 01 level" -msgstr "CONSTANT ist nicht auf Stufe 01" - -#: cobc/parser.y:6721 -#, fuzzy -msgid "REDEFINES clause not following entry-name" -msgstr "REDEFINES muss der ursprünglichen Definition folgen" - -#: cobc/parser.y:6743 -msgid "SAME AS clause" -msgstr "" - -#: cobc/parser.y:6750 -#, fuzzy -msgid "REPORT item cannot be used here" -msgstr "»%s« kann hier nicht verwendet werden" - -#: cobc/parser.y:6757 -#, fuzzy -msgid "elementary item expected" -msgstr "Ganzzahlwert erwartet" - -#: cobc/parser.y:6764 -msgid "SAME AS item may not reference itself" -msgstr "" - -#: cobc/parser.y:6771 -#, fuzzy -msgid "SAME AS item may not be subordinate to any item with USAGE clause" -msgstr "END PROGRAM '%s' ist unterschiedlich zur PROGRAM-ID '%s'" - -#: cobc/parser.y:6773 -#, fuzzy -msgid "SAME AS item may not be subordinate to any item with SIGN clause" -msgstr "END PROGRAM '%s' ist unterschiedlich zur PROGRAM-ID '%s'" - -#: cobc/parser.y:6801 cobc/parser.y:6855 cobc/parser.y:7567 cobc/parser.y:7650 -#: cobc/parser.y:7674 -#, c-format -msgid "%s not allowed here" -msgstr "%s hier nicht zulässig" - -#: cobc/parser.y:6803 cobc/parser.y:6845 cobc/parser.y:7569 -#, c-format -msgid "%s only allowed at 01/77 level" -msgstr "%s nur auf den Stufen 01 und 77 zulässig" - -#: cobc/parser.y:6805 cobc/parser.y:6847 cobc/parser.y:7571 cobc/parser.y:7654 -#: cobc/parser.y:7676 -#, c-format -msgid "%s requires a data name" -msgstr "%s benötigt Angabe eines Datennamens" - -#: cobc/parser.y:6958 -msgid "a locale-format PICTURE string must only consist of '9', '.', '+', 'Z' and the currency-sign" -msgstr "" - -#: cobc/parser.y:6992 cobc/typeck.c:3658 -#, fuzzy, c-format -msgid "'%s' is not a locale-name" -msgstr "»%s« ist kein Locale-Name" - -#: cobc/parser.y:7007 -#, fuzzy, c-format -msgid "'%s' is not a valid USAGE" -msgstr "»%s« ist kein Feld" - -#: cobc/parser.y:7012 -#, fuzzy, c-format -msgid "unknown USAGE: %s" -msgstr "Unbekannter Fehler: %d" - -#: cobc/parser.y:7149 -#, c-format -msgid "unknown HANDLE type: %s" -msgstr "" - -#: cobc/parser.y:7406 cobc/parser.y:7408 -msgid "INDEXED should follow ASCENDING/DESCENDING" -msgstr "" - -#: cobc/parser.y:7526 -msgid "SYNCHRONIZED clause" -msgstr "" - -#: cobc/parser.y:7529 -msgid "LEFT/RIGHT phrases in SYNCHRONIZED clause" -msgstr "" - -#: cobc/parser.y:7612 -msgid "FALSE clause only allowed for 88 level" -msgstr "" - -#: cobc/parser.y:7652 -#, fuzzy, c-format -msgid "%s only allowed at 01 level" -msgstr "%s nur auf den Stufen 01 und 77 zulässig" - -#: cobc/parser.y:7656 cobc/parser.y:7678 -#, c-format -msgid "%s and %s combination not allowed" -msgstr "" - -#: cobc/parser.y:7787 -msgid "GLOBAL is not allowed with RD" -msgstr "" - -#: cobc/parser.y:8321 -msgid "PLUS is not recommended with LEFT, RIGHT or CENTER" -msgstr "" - -#: cobc/parser.y:8323 -msgid "PLUS is not allowed with LEFT, RIGHT or CENTER" -msgstr "" - -#: cobc/parser.y:8360 cobc/parser.y:8390 -msgid "PLUS is ignored on first field of line" -msgstr "" - -#: cobc/parser.y:8398 -msgid "invalid COLUMN integer; must be > 0" -msgstr "" - -#: cobc/parser.y:8400 -msgid "COLUMN numbers should increase" -msgstr "" - -#: cobc/parser.y:8499 cobc/parser.y:8555 -msgid "INITIAL specified on non-input field" -msgstr "" - -#: cobc/parser.y:8511 cobc/parser.y:8567 -msgid "relative LINE/COLUMN clause required with OCCURS" -msgstr "" - -#: cobc/parser.y:8669 cobc/parser.y:8673 -msgid "screen positions from data-item" -msgstr "" - -#: cobc/parser.y:9498 -msgid "OCCURS screen items" -msgstr "" - -#: cobc/parser.y:9510 -msgid "GLOBAL screen items" -msgstr "" - -#: cobc/parser.y:9554 -msgid "overriding convention specified in ENTRY-CONVENTION" -msgstr "" - -#: cobc/parser.y:9566 -msgid "executable program requested but PROCEDURE/ENTRY has USING clause" -msgstr "" - -#: cobc/parser.y:9636 cobc/parser.y:9653 cobc/parser.y:11184 -#, fuzzy, c-format -msgid "number of arguments exceeds maximum %d" -msgstr "Ungültige Anzahl an Argumenten beim Aufruf von '%s'" - -#: cobc/parser.y:9645 -msgid "CHAINING invalid in user FUNCTION" -msgstr "" - -#: cobc/parser.y:9692 cobc/parser.y:11261 cobc/parser.y:11270 -#, c-format -msgid "%s not allowed in CHAINED programs" -msgstr "%s ist in CHAINED-Programmen nicht erlaubt" - -#: cobc/parser.y:9704 cobc/parser.y:9712 cobc/parser.y:9720 cobc/parser.y:9741 -msgid "SIZE only allowed for BY VALUE items" -msgstr "" - -#: cobc/parser.y:9743 cobc/parser.y:9760 -msgid "invalid value for SIZE" -msgstr "Ungültiger Wert für SIZE" - -#: cobc/parser.y:9775 -msgid "MEMORY SIZE phrase in CALL statement" -msgstr "" - -#: cobc/parser.y:9787 -msgid "OPTIONAL only allowed for BY REFERENCE items" -msgstr "" - -#: cobc/parser.y:9799 -msgid "RETURNING clause is required for a FUNCTION" -msgstr "" - -#: cobc/parser.y:9805 -msgid "RETURNING clause cannot be OMITTED for main program" -msgstr "" - -#: cobc/parser.y:9808 -msgid "RETURNING clause cannot be OMITTED for a FUNCTION" -msgstr "" - -#: cobc/parser.y:9821 -msgid "RETURNING item is not defined in LINKAGE SECTION" -msgstr "" - -#: cobc/parser.y:9823 -msgid "RETURNING item must have level 01" -msgstr "" - -#: cobc/parser.y:9825 -msgid "RETURNING item should not have OCCURS" -msgstr "" - -#: cobc/parser.y:9829 -msgid "function RETURNING item may not be ANY LENGTH" -msgstr "" - -#: cobc/parser.y:10017 -#, c-format -msgid "'%s' is not a statement" -msgstr "»%s« ist keine Anweisung" - -#: cobc/parser.y:10019 -#, c-format -msgid "unknown statement '%s'; it may exist in another dialect" -msgstr "Unbekannte Anweisung »%s«; könnte in anderem Dialekt vorhanden sein" - -#: cobc/parser.y:10022 -#, c-format -msgid "unknown statement '%s'" -msgstr "Unbekannte Anweisung »%s«" - -#: cobc/parser.y:10039 -msgid "section segments" -msgstr "" - -#: cobc/parser.y:10041 -msgid "SECTION segment-number must be less than or equal to 99" -msgstr "" - -#: cobc/parser.y:10044 -msgid "SECTION segment-number in DECLARATIVES must be less than 50" -msgstr "" - -#: cobc/parser.y:10052 -msgid "SECTION segment within DECLARATIVES" -msgstr "" - -#: cobc/parser.y:10240 cobc/parser.y:10375 -msgid "non-standard ACCEPT" -msgstr "" - -#: cobc/parser.y:10252 -msgid "PROMPT clause" -msgstr "" - -#: cobc/parser.y:10256 -msgid "SIZE IS clause" -msgstr "" - -#: cobc/parser.y:10471 cobc/parser.y:10763 -msgid "TIME-OUT or BEFORE TIME clauses" -msgstr "" - -#: cobc/parser.y:10497 cobc/parser.y:10513 cobc/parser.y:10528 -msgid "AT screen-location" -msgstr "" - -#: cobc/parser.y:10529 -msgid "LINE or COLUMN" -msgstr "LINE oder COLUMN" - -#: cobc/parser.y:10893 -msgid "ALLOCATE CHARACTERS requires RETURNING clause" -msgstr "" - -#: cobc/parser.y:10908 cobc/parser.y:12168 -#, fuzzy, c-format -msgid "ignoring %s phrase" -msgstr "Vorzeichen wird ignoriert" - -#: cobc/parser.y:10910 -msgid "addressing mode should be either 24 or 31 bit" -msgstr "" - -#: cobc/parser.y:10982 -msgid "recursive program call - assuming RECURSIVE attribute" -msgstr "" - -#: cobc/parser.y:11001 -msgid "STATIC CALL convention ignored because of ON EXCEPTION" -msgstr "" - -#: cobc/parser.y:11010 -msgid "ON EXCEPTION ignored because of STATIC CALL" -msgstr "" - -#: cobc/parser.y:11111 cobc/typeck.c:12209 -#, fuzzy -msgid "invalid mnemonic name" -msgstr "Ungültige Konfiguration '%s'" - -#: cobc/parser.y:11131 cobc/parser.y:11428 -msgid "CALL/CANCEL with program-prototype-name" -msgstr "" - -#: cobc/parser.y:11135 -msgid "id/literal ignored, using prototype name" -msgstr "" - -#: cobc/parser.y:11141 -msgid "NESTED phrase is only valid with literal" -msgstr "" - -#: cobc/parser.y:11202 -msgid "OMITTED only allowed when arguments are passed BY REFERENCE" -msgstr "" - -#: cobc/parser.y:11226 -msgid "invalid file name reference" -msgstr "Ungültiger Dateinamensreferenz" - -#: cobc/parser.y:11234 -#, c-format -msgid "BY CONTENT assumed for alphanumeric item '%s'" -msgstr "" - -#: cobc/parser.y:11239 -#, c-format -msgid "BY CONTENT assumed for national item '%s'" -msgstr "" - -#: cobc/parser.y:11302 -msgid "RETURNING item must have level 01 or 77" -msgstr "" - -#: cobc/parser.y:11306 -msgid "RETURNING item must be a LINKAGE SECTION item or have BASED clause" -msgstr "" - -#: cobc/parser.y:11340 cobc/parser.y:15972 cobc/parser.y:16027 -#: cobc/parser.y:16071 cobc/parser.y:16115 -msgid "NOT EXCEPTION before EXCEPTION" -msgstr "NOT EXCEPTION vor EXCEPTION" - -#: cobc/parser.y:12041 -#, c-format -msgid "HANDLE must be a %s HANDLE" -msgstr "" - -#: cobc/parser.y:12053 -msgid "HANDLE must be a generic HANDLE" -msgstr "" - -#: cobc/parser.y:12130 -#, c-format -msgid "HANDLE clause invalid for %s" -msgstr "" - -#: cobc/parser.y:12361 cobc/parser.y:15495 -#, c-format -msgid "%s is invalid in nested program" -msgstr "" - -#: cobc/parser.y:12399 cobc/parser.y:12440 cobc/parser.y:12451 -#: cobc/parser.y:12462 -#, c-format -msgid "maximum evaluate depth exceeded (%d)" -msgstr "" - -#: cobc/parser.y:12503 cobc/parser.y:12513 -msgid "WHEN without imperative statement" -msgstr "" - -#: cobc/parser.y:12531 cobc/parser.y:12541 -msgid "WHEN OTHER without imperative statement" -msgstr "" - -#: cobc/parser.y:12621 -msgid "invalid THROUGH usage" -msgstr "" - -#: cobc/parser.y:12700 -msgid "EXIT PROGRAM is not allowed within a USE GLOBAL procedure" -msgstr "" - -#: cobc/parser.y:12704 -#, fuzzy -msgid "EXIT PROGRAM not allowed within a FUNCTION" -msgstr "'%s' EXTERNAL nicht zulässig mit REDEFINES" - -#: cobc/parser.y:12713 cobc/parser.y:12926 -msgid "RETURNING/GIVING not allowed for non-returning runtime elements" -msgstr "" - -#: cobc/parser.y:12725 -msgid "EXIT FUNCTION is not allowed within a USE GLOBAL procedure" -msgstr "" - -#: cobc/parser.y:12729 -msgid "EXIT FUNCTION only allowed within a FUNCTION" -msgstr "" - -#: cobc/parser.y:12743 cobc/parser.y:12766 -msgid "EXIT PERFORM is only valid with inline PERFORM" -msgstr "" - -#: cobc/parser.y:12788 -msgid "EXIT SECTION is only valid with an active SECTION" -msgstr "" - -#: cobc/parser.y:12809 -msgid "EXIT PARAGRAPH is only valid with an active PARAGRAPH" -msgstr "" - -#: cobc/parser.y:12956 -msgid "IF without imperative statement" -msgstr "" - -#: cobc/parser.y:13173 -msgid "TALLYING clause is incomplete" -msgstr "" - -#: cobc/parser.y:13289 -msgid "INSPECT missing ALL/FIRST/LEADING/TRAILING" -msgstr "" - -#: cobc/parser.y:13407 -msgid "JSON PARSE" -msgstr "" - -#: cobc/parser.y:13552 -msgid "LOCK clauses" -msgstr "" - -#: cobc/parser.y:13717 -msgid "inline PERFORM without imperative statement" -msgstr "" - -#: cobc/parser.y:13838 cobc/parser.y:13846 cobc/parser.y:13854 -#, c-format -msgid "PERFORM VARYING '%s' (line %d of %s) is not a numeric field" -msgstr "" - -#: cobc/parser.y:13870 -msgid "PERFORM VARYING without BY phrase" -msgstr "" - -#: cobc/parser.y:13910 -#, fuzzy, c-format -msgid "'%s' is not an object-reference" -msgstr "»%s« ist keine Ganzzahl" - -#: cobc/parser.y:13951 cobc/typeck.c:10958 cobc/typeck.c:12100 -msgid "LOCK clause invalid with file LOCK AUTOMATIC" -msgstr "" - -#: cobc/parser.y:13956 -msgid "KEY clause invalid with this file type" -msgstr "" - -#: cobc/parser.y:13961 cobc/typeck.c:10954 cobc/typeck.c:12096 -msgid "INVALID KEY clause invalid with this file type" -msgstr "" - -#: cobc/parser.y:14591 -msgid "file sort requires KEY phrase" -msgstr "" - -#: cobc/parser.y:14615 -msgid "table SORT requires KEY phrase" -msgstr "" - -#: cobc/parser.y:14677 -msgid "file sort requires USING or INPUT PROCEDURE" -msgstr "" - -#: cobc/parser.y:14684 -msgid "USING invalid with table SORT" -msgstr "" - -#: cobc/parser.y:14694 -msgid "INPUT PROCEDURE invalid with table SORT" -msgstr "" - -#: cobc/parser.y:14696 -msgid "INPUT PROCEDURE invalid with MERGE" -msgstr "" - -#: cobc/parser.y:14709 -msgid "file sort requires GIVING or OUTPUT PROCEDURE" -msgstr "" - -#: cobc/parser.y:14716 -msgid "GIVING invalid with table SORT" -msgstr "" - -#: cobc/parser.y:14726 -msgid "OUTPUT PROCEDURE invalid with table SORT" -msgstr "" - -#: cobc/parser.y:14753 -msgid "SIZE/LENGTH invalid here" -msgstr "SIZE/LENGTH ist hier unzulässig" - -#: cobc/parser.y:14806 -msgid "NOT EQUAL condition not allowed on START statement" -msgstr "" - -#: cobc/parser.y:14872 -#, c-format -msgid "%s is replaced by %s" -msgstr "" - -#: cobc/parser.y:14925 -msgid "STOP literal" -msgstr "" - -#: cobc/parser.y:14929 -msgid "STOP identifier" -msgstr "" - -#: cobc/parser.y:15066 -msgid "SUPPRESS statement must be within DECLARATIVES" -msgstr "" - -#: cobc/parser.y:15140 -msgid "UNLOCK invalid for SORT files" -msgstr "" - -#: cobc/parser.y:15276 cobc/parser.y:15355 -msgid "USE statement must be within DECLARATIVES" -msgstr "" - -#: cobc/parser.y:15278 -msgid "SECTION header missing before USE statement" -msgstr "" - -#: cobc/parser.y:15357 -msgid "USE DEBUGGING not supported in contained program" -msgstr "" - -#: cobc/parser.y:15405 cobc/parser.y:15414 cobc/parser.y:15432 -#: cobc/parser.y:15468 cobc/typeck.c:3792 -#, fuzzy, c-format -msgid "duplicate DEBUGGING target: '%s'" -msgstr "doppeltes DEFINE »%s« – ignoriert" - -#: cobc/parser.y:15430 -#, fuzzy -msgid "constant item cannot be used here" -msgstr "Eine Konstante darf hier nicht verwendet werden – »%s«" - -#: cobc/parser.y:15456 -msgid "duplicate USE DEBUGGING ON ALL PROCEDURES" -msgstr "" - -#: cobc/parser.y:15528 -#, fuzzy, c-format -msgid "'%s' is not a report group" -msgstr "'%s' ist kein Report-Name" - -#: cobc/parser.y:15710 -msgid "ENCODING clause must come before XML-DECLARATION" -msgstr "" - -#: cobc/parser.y:15712 -msgid "ENCODING clause must come before ATTRIBUTES" -msgstr "" - -#: cobc/parser.y:15715 -msgid "XML GENERATE ENCODING clause" -msgstr "" - -#: cobc/parser.y:15722 -msgid "XML-DECLARATION clause must come before ATTRIBUTES" -msgstr "" - -#: cobc/parser.y:15725 -msgid "XML GENERATE XML-DECLARATION clause" -msgstr "" - -#: cobc/parser.y:15731 -msgid "XML GENERATE WITH ATTRIBUTES clause" -msgstr "" - -#: cobc/parser.y:15744 -msgid "XML GENERATE NAMESPACE clause" -msgstr "" - -#: cobc/parser.y:15768 -msgid "XML GENERATE NAME OF clause" -msgstr "" - -#: cobc/parser.y:15799 -msgid "XML GENERATE TYPE OF clause" -msgstr "" - -#: cobc/parser.y:15840 -msgid "XML GENERATE SUPPRESS clause" -msgstr "" - -#: cobc/parser.y:15914 -msgid "XML PARSE" -msgstr "" - -#: cobc/parser.y:15955 cobc/parser.y:16633 cobc/parser.y:16729 -#: cobc/parser.y:16815 -#, c-format -msgid "'%s' is not a file name" -msgstr "»%s« ist kein Dateiname" - -#: cobc/parser.y:16161 -msgid "NOT SIZE ERROR before SIZE ERROR" -msgstr "" - -#: cobc/parser.y:16207 -msgid "NOT OVERFLOW before OVERFLOW" -msgstr "" - -#: cobc/parser.y:16306 -msgid "NOT AT END-OF-PAGE before AT END-OF-PAGE" -msgstr "" - -#: cobc/parser.y:16356 -msgid "NOT INVALID KEY before INVALID KEY" -msgstr "" - -#: cobc/parser.y:16619 -msgid "LINAGE-COUNTER must be qualified here" -msgstr "" - -#: cobc/parser.y:16622 -msgid "invalid LINAGE-COUNTER usage" -msgstr "" - -#: cobc/parser.y:16643 -msgid "LINE-COUNTER must be qualified here" -msgstr "" - -#: cobc/parser.y:16647 -msgid "invalid LINE-COUNTER usage" -msgstr "" - -#: cobc/parser.y:16658 cobc/parser.y:16683 -#, fuzzy, c-format -msgid "'%s' is not a report name" -msgstr "'%s' ist kein Report-Name" - -#: cobc/parser.y:16668 -msgid "PAGE-COUNTER must be qualified here" -msgstr "" - -#: cobc/parser.y:16672 -msgid "invalid PAGE-COUNTER usage" -msgstr "" - -#: cobc/parser.y:16719 cobc/typeck.c:10919 cobc/typeck.c:11004 -#: cobc/typeck.c:12064 -#, fuzzy, c-format -msgid "%s requires a record name as subject" -msgstr "CALL von %s benötigt %d Parameter" - -#: cobc/parser.y:16746 -#, c-format -msgid "'%s' not indexed" -msgstr "»%s« ist nicht indiziert" - -#: cobc/parser.y:16772 cobc/parser.y:16797 -#, c-format -msgid "multiple reference to '%s' " -msgstr "Mehrfachreferenz auf »%s« " - -#: cobc/parser.y:16827 -#, c-format -msgid "'%s' is not a CD name" -msgstr "»%s« ist kein CD-Name" - -#: cobc/parser.y:16841 -#, fuzzy, c-format -msgid "'%s' is not a valid report name" -msgstr "'%s' ist kein Report-Name" - -#: cobc/parser.y:17092 -msgid "invalid mnemonic identifier" -msgstr "" - -#: cobc/parser.y:17172 -#, fuzzy -msgid "a numeric literal is expected here" -msgstr "Ein nicht-numerisches Literal wird für »%s« erwartet" - -#: cobc/parser.y:17184 cobc/parser.y:17886 -#, fuzzy -msgid "a non-numeric literal is expected here" -msgstr "Ein nicht-numerisches Literal wird für »%s« erwartet" - -#: cobc/parser.y:17357 cobc/typeck.c:6116 cobc/typeck.c:6123 -#, c-format -msgid "'%s' is not numeric" -msgstr "»%s« ist nicht numerisch" - -#: cobc/parser.y:17373 -#, c-format -msgid "'%s' is not a field or file" -msgstr "»%s« ist weder Feld noch Datei" - -#: cobc/parser.y:17393 cobc/parser.y:17411 -#, c-format -msgid "'%s' is not a field" -msgstr "»%s« ist kein Feld" - -#: cobc/parser.y:17533 -#, fuzzy, c-format -msgid "'%s' is not a field or alphabet" -msgstr "»%s« ist weder Feld noch Datei" - -#: cobc/parser.y:17559 -#, fuzzy -msgid "a subscripted data-item cannot be used here" -msgstr "»%s« kann hier nicht verwendet werden" - -#: cobc/parser.y:17609 -#, fuzzy -msgid "unsigned integer value expected" -msgstr "Ganzzahlwert erwartet" - -#: cobc/parser.y:17621 cobc/parser.y:17625 cobc/parser.y:17675 -msgid "integer value expected" -msgstr "Ganzzahlwert erwartet" - -#: cobc/parser.y:17630 -msgid "invalid symbolic integer" -msgstr "Ungültige symbolische Ganzzahl" - -#: cobc/parser.y:17646 cobc/parser.y:17650 -msgid "unsigned positive integer value expected" -msgstr "" - -#: cobc/parser.y:17679 -msgid "invalid CLASS value" -msgstr "Ungültiger Wert für CLASS" - -#: cobc/parser.y:17767 -msgid "PHYSICAL argument for LENGTH functions" -msgstr "" - -#: cobc/parser.y:17938 cobc/parser.y:17955 -msgid "cannot specify offset and SYSTEM-OFFSET at the same time" -msgstr "" - -#: cobc/pplex.l:223 cobc/pplex.l:1739 -msgid "debugging indicator" -msgstr "" - -#: cobc/pplex.l:300 -msgid "ignoring empty directive" -msgstr "" - -#: cobc/pplex.l:310 cobc/pplex.l:369 -#, c-format -msgid "ignoring invalid directive: '%s'" -msgstr "Ungültige Anweisung wird ignoriert: »%s«" - -#: cobc/pplex.l:317 -msgid "ignoring invalid directive" -msgstr "" - -#: cobc/pplex.l:324 -msgid "VCS directive" -msgstr "" - -#: cobc/pplex.l:377 cobc/pplex.l:392 -msgid "spurious '$' detected - ignored" -msgstr "" - -#: cobc/pplex.l:386 -#, fuzzy, c-format -msgid "ignoring unknown directive: '%s'" -msgstr "Ungültige Anweisung wird ignoriert: »%s«" - -#: cobc/pplex.l:398 -msgid "PROCESS statement ignored" -msgstr "" - -#: cobc/pplex.l:864 -msgid "IF/ELIF/ELSE directive without matching END-IF" -msgstr "" - -#: cobc/pplex.l:981 -#, fuzzy -msgid "file was included here" -msgstr "Ungültige Konfiguration '%s'" - -#: cobc/pplex.l:1186 -#, fuzzy, c-format -msgid "directive nest depth exceeded: %d" -msgstr "'%s' nicht implementiert" - -#: cobc/pplex.l:1204 -msgid "ELSE directive without matching IF/ELIF" -msgstr "" - -#: cobc/pplex.l:1220 -msgid "END-IF directive without matching IF/ELIF/ELSE" -msgstr "" - -#: cobc/pplex.l:1236 -msgid "ELIF directive without matching IF/ELIF" -msgstr "" - -#: cobc/pplex.l:1258 -#, fuzzy, c-format -msgid "invalid internal case: %u" -msgstr "Ungültiger Typ für '%s'" - -#: cobc/pplex.l:1395 -msgid "buffer overrun - too many continuation lines" -msgstr "" - -#: cobc/pplex.l:1485 cobc/pplex.l:1494 -msgid "line not terminated by a newline" -msgstr "Zeile wird nicht durch Zeilenvorschub beendet" - -#: cobc/pplex.l:1488 cobc/pplex.l:1497 -#, c-format -msgid "source text exceeds %d bytes, will be truncated" -msgstr "Quelltextgröße überschreitet %d Bytes, wird gekürzt" - -#: cobc/pplex.l:1516 -msgid "version control conflict marker in file" -msgstr "" - -#: cobc/pplex.l:1727 -#, fuzzy -msgid "invalid continuation in comment entry" -msgstr "Ungültige Konfiguration '%s'" - -#: cobc/pplex.l:1732 -msgid "continuation of COBOL words" -msgstr "" - -#: cobc/pplex.l:1752 -#, c-format -msgid "invalid indicator '%c' at column 7" -msgstr "" - -#: cobc/pplex.l:1800 cobc/pplex.l:1811 -#, fuzzy -msgid "invalid line continuation" -msgstr "Die Option -o ist in dieser Kombination ungültig" - -#: cobc/pplex.l:1819 -msgid "continuation character expected" -msgstr "" - -#: cobc/pplex.l:1885 -#, c-format -msgid "source text after program-text area (column %d)" -msgstr "" - -#: cobc/ppparse.y:225 -msgid "directive comparison on different types" -msgstr "" - -#: cobc/ppparse.y:293 -#, c-format -msgid "duplicate DEFINE directive '%s'" -msgstr "" - -#: cobc/ppparse.y:300 cobc/ppparse.y:310 -msgid "invalid constant in DEFINE directive" -msgstr "" - -#: cobc/ppparse.y:408 -#, c-format -msgid "compiler flag '%s' unknown" -msgstr "" - -#: cobc/ppparse.y:454 -#, fuzzy, c-format -msgid "invalid %s directive option '%s'" -msgstr "Ungültige Anweisung wird ignoriert: »%s«" - -#: cobc/ppparse.y:667 -msgid "*CONTROL statement" -msgstr "" - -#: cobc/ppparse.y:933 cobc/ppparse.y:1004 cobc/ppparse.y:1141 -#, c-format -msgid "invalid %s directive" -msgstr "" - -#: cobc/ppparse.y:1043 -msgid "LEAP-SECOND ON directive" -msgstr "" - -#: cobc/ppparse.y:1051 -msgid "TURN directive" -msgstr "" - -#: cobc/ppparse.y:1133 cobc/ppparse.y:1158 -msgid "invalid constant" -msgstr "Ungültige Konstante" - -#: cobc/reserved.c:3797 -msgid "device name" -msgstr "Gerätename" - -#: cobc/reserved.c:3800 -msgid "switch name" -msgstr "" - -#: cobc/reserved.c:3803 -msgid "feature name" -msgstr "" - -#: cobc/reserved.c:3902 -#, c-format -msgid "reserved word must have less than %d characters" -msgstr "Reservierte Wörter müssen weniger als %d Zeichen haben" - -#: cobc/reserved.c:3921 -msgid "ignored asterisk at end of alias target" -msgstr "" - -#: cobc/reserved.c:3984 -#, c-format -msgid "alias target '%s' is not a default reserved word" -msgstr "" - -#: cobc/reserved.c:4447 -#, c-format -msgid "invalid system-name '%s'" -msgstr "Ungültiger Systemname »%s«" - -#: cobc/reserved.c:4584 -#, c-format -msgid "'%s' is a reserved word, but isn't supported" -msgstr "»%s« ist ein reserviertes Wort, wird aber nicht unterstützt" - -#: cobc/reserved.c:4689 -#, c-format -msgid "intrinsic function %s is unknown" -msgstr "" - -#: cobc/reserved.c:4717 -msgid "Intrinsic Function" -msgstr "Intrinsische Funktion" - -#: cobc/reserved.c:4717 cobc/reserved.c:4897 cobc/reserved.c:5034 -msgid "Implemented" -msgstr "Implementiert" - -#: cobc/reserved.c:4717 cobc/typeck.c:1022 -msgid "Parameters" -msgstr "Parameter" - -#: cobc/reserved.c:4721 cobc/reserved.c:4901 cobc/reserved.c:5048 -msgid "Yes" -msgstr "Ja" - -#: cobc/reserved.c:4724 cobc/reserved.c:4904 cobc/reserved.c:5054 -msgid "No" -msgstr "Nein" - -#: cobc/reserved.c:4730 -msgid "Unlimited" -msgstr "Unbegrenzt" - -#: cobc/reserved.c:4804 -#, c-format -msgid "special register %s is unknown, needs a definition" -msgstr "" - -#: cobc/reserved.c:4810 -#, c-format -msgid "special register %s is unknown" -msgstr "" - -#: cobc/reserved.c:4897 -msgid "Internal registers" -msgstr "" - -#: cobc/reserved.c:4897 -msgid "Definition" -msgstr "Definition" - -#: cobc/reserved.c:4985 -#, fuzzy, c-format -msgid "unknown system-name '%s'" -msgstr "Unbekannte Anweisung »%s«" - -#: cobc/reserved.c:5011 -msgid "System names" -msgstr "" - -#: cobc/reserved.c:5034 -msgid "Reserved Words" -msgstr "Reservierte Wörter" - -#: cobc/reserved.c:5046 -msgid "Yes (Context sensitive)" -msgstr "Ja (kontextabhängig)" - -#: cobc/reserved.c:5052 -msgid "No (Context sensitive)" -msgstr "Nein (kontextabhängig)" - -#: cobc/reserved.c:5081 -msgid "Extra (obsolete) context sensitive words" -msgstr "" - -#: cobc/scanner.l:265 cobc/scanner.l:2288 -#, fuzzy, c-format -msgid "'%s' is not a default reserved word, so cannot be aliased" -msgstr "»%s« ist nicht definiert, aber in einem anderen Dialekt ein reserviertes Wort" - -#: cobc/scanner.l:268 -#, fuzzy, c-format -msgid "'%s' is not a reserved word; you may want ADDSYN or OVERRIDE instead" -msgstr "»%s« ist ein reserviertes Wort, wird aber nicht unterstützt" - -#: cobc/scanner.l:988 -#, c-format -msgid "a constant may not be used here - '%s'" -msgstr "Eine Konstante darf hier nicht verwendet werden – »%s«" - -#: cobc/scanner.l:1043 -msgid "ignoring redundant ." -msgstr "" - -#: cobc/scanner.l:1101 -#, c-format -msgid "invalid symbol '%s' - skipping word" -msgstr "Ungültiges Symbol »%s« – Wort wird übersprungen" - -#: cobc/scanner.l:1191 -#, fuzzy -msgid "invalid national literal" -msgstr "Ungültiger Typ für '%s'" - -#: cobc/scanner.l:1202 cobc/tree.c:2531 -#, c-format -msgid "invalid literal: '%s'" -msgstr "Ungültiges Literal: »%s«" - -#: cobc/scanner.l:1204 -#, c-format -msgid "invalid hexadecimal literal: '%s'" -msgstr "Ungültiges hexadezimales Literal: »%s«" - -#: cobc/scanner.l:1206 cobc/tree.c:1613 -#, c-format -msgid "invalid numeric literal: '%s'" -msgstr "Ungültiges numerisches Literal: »%s«" - -#: cobc/scanner.l:1208 -#, c-format -msgid "invalid floating-point literal: '%s'" -msgstr "Ungültiges Gleitkomma-Literal: »%s«" - -#: cobc/scanner.l:1210 -#, c-format -msgid "invalid %s literal: '%s'" -msgstr "Ungültiges %s-Literal: »%s«" - -#: cobc/scanner.l:1261 -#, c-format -msgid "literal length exceeds %d characters" -msgstr "Länge des Literals überschreitet %d Zeichen" - -#: cobc/scanner.l:1277 cobc/scanner.l:1326 cobc/scanner.l:1620 -#, fuzzy -msgid "zero-length literal" -msgstr "Numerisches boolesches Literal" - -#: cobc/scanner.l:1280 -msgid "national literal has zero length; a SPACE will be assumed" -msgstr "" - -#: cobc/scanner.l:1281 -msgid "alphanumeric literal has zero length; a SPACE will be assumed" -msgstr "" - -#: cobc/scanner.l:1293 cobc/scanner.l:1294 cobc/scanner.l:1298 -#: cobc/scanner.l:1365 -#, fuzzy -msgid "national literal" -msgstr "Ungültiger Typ für '%s'" - -#: cobc/scanner.l:1297 -#, fuzzy -msgid "national-character literal" -msgstr "Ungültiger Typ für '%s'" - -#: cobc/scanner.l:1330 -msgid "hexadecimal literal has zero length; X'00' will be assumed" -msgstr "" - -#: cobc/scanner.l:1349 -#, fuzzy -msgid "hexadecimal-boolean literal" -msgstr "Numerisches Literal ist negativ" - -#: cobc/scanner.l:1356 cobc/scanner.l:1370 cobc/scanner.l:1485 -#: cobc/scanner.l:1544 cobc/scanner.l:1642 cobc/scanner.l:1711 cobc/tree.c:2532 -#, fuzzy, c-format -msgid "literal length %d exceeds %d characters" -msgstr "PROGRAM Name überschreitet 31 Zeichen" - -#: cobc/scanner.l:1362 -#, fuzzy -msgid "hexadecimal-national literal" -msgstr "Ungültiger Typ für '%s'" - -#: cobc/scanner.l:1393 cobc/scanner.l:1425 cobc/scanner.l:1560 -#: cobc/scanner.l:1656 cobc/scanner.l:1721 -#, c-format -msgid "literal contains invalid character '%c'" -msgstr "Literal enthält ungültiges Zeichen »%c«" - -#: cobc/scanner.l:1449 -#, c-format -msgid "literal does not have an even number of digits" -msgstr "" - -#: cobc/scanner.l:1492 -#, fuzzy, c-format -msgid "%s literals must contain at least one character" -msgstr "Literal enthält ungültiges Zeichen »%c«" - -#: cobc/scanner.l:1527 cobc/scanner.l:1628 cobc/scanner.l:1702 -msgid "ACUCOBOL numeric literal" -msgstr "" - -#: cobc/scanner.l:1537 -#, fuzzy -msgid "H literals must contain at least one character" -msgstr "Literal enthält ungültiges Zeichen »%c«" - -#: cobc/scanner.l:1575 cobc/scanner.l:1667 cobc/scanner.l:1732 -#, c-format -msgid "literal exceeds limit %u" -msgstr "Literal übersteigt die Größenbeschränkung %u" - -#: cobc/scanner.l:1616 -msgid "numeric boolean literal" -msgstr "Numerisches boolesches Literal" - -#: cobc/scanner.l:1622 -msgid "Boolean literal has zero length; B'0' will be assumed" -msgstr "" - -#: cobc/scanner.l:1698 -msgid "HP COBOL octal literal" -msgstr "" - -#: cobc/scanner.l:1810 cobc/tree.c:1624 -#, fuzzy, c-format -msgid "literal length %d exceeds maximum of %d digits" -msgstr "PROGRAM Name überschreitet 31 Zeichen" - -#: cobc/scanner.l:1816 cobc/tree.c:1629 -#, fuzzy, c-format -msgid "literal length %d exceeds %d digits" -msgstr "PROGRAM Name überschreitet 31 Zeichen" - -#: cobc/scanner.l:1928 cobc/tree.c:3513 -#, fuzzy, c-format -msgid "significand has more than %d digits" -msgstr "Exponent hat mehr als 4 Stellen" - -#: cobc/scanner.l:1933 -#, c-format -msgid "exponent has decimal point" -msgstr "" - -#: cobc/scanner.l:1939 cobc/tree.c:3521 -#, c-format -msgid "exponent has more than 4 digits" -msgstr "Exponent hat mehr als 4 Stellen" - -#: cobc/scanner.l:1969 -#, c-format -msgid "exponent not between -6143 and 6144" -msgstr "" - -#: cobc/scanner.l:1978 -#, c-format -msgid "significand of 0 must be positive" -msgstr "" - -#: cobc/scanner.l:1983 -#, c-format -msgid "exponent of 0 must be 0" -msgstr "Exponent von 0 muss 0 sein" - -#: cobc/scanner.l:1988 -#, c-format -msgid "exponent of 0 must be positive" -msgstr "Exponent von 0 muss positiv sein" - -#: cobc/scanner.l:2170 -#, c-format -msgid "invalid CONSTANT: %s" -msgstr "Ungültiges CONSTANT: %s" - -#: cobc/scanner.l:2180 -#, c-format -msgid "invalid alphanumeric CONSTANT: %s" -msgstr "Ungültige alphanumerisches CONSTANT: %s" - -#: cobc/scanner.l:2184 -#, c-format -msgid "empty alphanumeric CONSTANT: %s" -msgstr "Leeres alphanumerisches CONSTANT: %s" - -#: cobc/scanner.l:2201 cobc/scanner.l:2209 cobc/scanner.l:2214 -#, c-format -msgid "invalid numeric CONSTANT: %s" -msgstr "Ungültiges numerisches CONSTANT: %s" - -#: cobc/scanner.l:2291 -#, c-format -msgid "'%s' is already reserved; you may want MAKESYN instead" -msgstr "" - -#: cobc/tree.c:341 -#, c-format -msgid "%s clause is required for file '%s'" -msgstr "%s-Klausel wird für Datei »%s« benötigt" - -#: cobc/tree.c:345 -#, c-format -msgid "%s clause is invalid for file '%s' (file type)" -msgstr "%s-Klausel ist für Datei »%s« unzulässig (Dateityp)" - -#: cobc/tree.c:349 -#, c-format -msgid "%s clause is invalid for file '%s'" -msgstr "%s-Klausel ist für Datei »%s« unzulässig" - -#: cobc/tree.c:376 -#, c-format -msgid "FOR item '%s' is a record" -msgstr "" - -#: cobc/tree.c:385 -#, fuzzy, c-format -msgid "FOR item '%s' is in different record to '%s'" -msgstr "END PROGRAM '%s' ist unterschiedlich zur PROGRAM-ID '%s'" - -#: cobc/tree.c:394 -#, c-format -msgid "FOR item '%s' is not in a record associated with '%s'" -msgstr "" - -#: cobc/tree.c:477 -msgid "internal error node" -msgstr "" - -#: cobc/tree.c:479 -msgid "unknown constant" -msgstr "Unbekannte Konstante" - -#: cobc/tree.c:639 -#, c-format -msgid "FUNCTION %s has invalid/not supported arguments - tag %d" -msgstr "" - -#: cobc/tree.c:760 -#, c-format -msgid "invalid date/time function: '%d'" -msgstr "Ungültiger Datum-/Zeit-Funktion: »%d«" - -#: cobc/tree.c:798 -#, c-format -msgid "FUNCTION '%s' has invalid date/time format" -msgstr "" - -#: cobc/tree.c:805 -#, c-format -msgid "FUNCTION '%s' has format in variable" -msgstr "" - -#: cobc/tree.c:1186 -#, fuzzy, c-format -msgid "literal '%s'" -msgstr "Ungültiges Literal: »%s«" - -#: cobc/tree.c:1315 -#, c-format -msgid "unknown tree tag: %d, category: %d" -msgstr "" - -#: cobc/tree.c:1405 -#, c-format -msgid "unexpected numeric USAGE: %d" -msgstr "Unerwartete numerische USAGE-Angabe: %d" - -#: cobc/tree.c:1419 -#, c-format -msgid "unexpected category: %d" -msgstr "Unerwartete Kategorie: %d" - -#: cobc/tree.c:1678 cobc/tree.c:1690 cobc/tree.c:1752 cobc/tree.c:1802 -#, c-format -msgid "numeric literal '%s' exceeds limit '%s'" -msgstr "Numerisches Literal »%s« übersteigt die Größenbeschränkung »%s«" - -#: cobc/tree.c:2387 -msgid "invalid LOCALE literal" -msgstr "Ungültiges LOCALE-Literal" - -#: cobc/tree.c:2512 -msgid "only literals with the same category can be concatenated" -msgstr "" - -#: cobc/tree.c:2519 -msgid "only alphanumeric, national or boolean literals may be concatenated" -msgstr "" - -#: cobc/tree.c:2791 -msgid "B, 0 or /" -msgstr "" - -#: cobc/tree.c:2805 -msgid "the sign of the floating-point exponent" -msgstr "" - -#: cobc/tree.c:2807 -msgid "a leading +/- sign" -msgstr "" - -#: cobc/tree.c:2809 -msgid "a trailing +/- sign" -msgstr "" - -#: cobc/tree.c:2811 -msgid "CR or DB" -msgstr "" - -#: cobc/tree.c:2813 -msgid "a leading currency symbol" -msgstr "" - -#: cobc/tree.c:2815 -msgid "a trailing currency symbol" -msgstr "" - -#: cobc/tree.c:2817 -msgid "a Z or * which is before the decimal point" -msgstr "" - -#: cobc/tree.c:2819 -msgid "a Z or * which is after the decimal point" -msgstr "" - -#: cobc/tree.c:2821 -msgid "a floating +/- string which is before the decimal point" -msgstr "" - -#: cobc/tree.c:2823 -msgid "a floating +/- string which is after the decimal point" -msgstr "" - -#: cobc/tree.c:2825 -msgid "a floating currency symbol string which is before the decimal point" -msgstr "" - -#: cobc/tree.c:2827 -msgid "a floating currency symbol string which is after the decimal point" -msgstr "" - -#: cobc/tree.c:2831 -msgid "A or X" -msgstr "" - -#: cobc/tree.c:2837 -msgid "a P which is before the decimal point" -msgstr "" - -#: cobc/tree.c:2839 -msgid "a P which is after the decimal point" -msgstr "" - -#: cobc/tree.c:2860 cobc/tree.c:3267 -#, c-format -msgid "%s may only occur once in a PICTURE string" -msgstr "" - -#: cobc/tree.c:2862 cobc/tree.c:3219 -#, c-format -msgid "%s cannot follow %s" -msgstr "%s kann nicht auf %s folgen" - -#: cobc/tree.c:2865 -msgid "invalid PICTURE string detected" -msgstr "Ungültige PICTURE-Zeichenkette festgestellt" - -#: cobc/tree.c:2976 -msgid "number or constant in parentheses is not an unsigned integer" -msgstr "" - -#: cobc/tree.c:2985 -msgid "only up to 9 significant digits are permitted within parentheses" -msgstr "" - -#: cobc/tree.c:2991 -msgid "number or constant in parentheses must be greater than zero" -msgstr "" - -#: cobc/tree.c:3002 -msgid "parentheses must be preceded by a picture symbol" -msgstr "" - -#: cobc/tree.c:3032 -msgid "unbalanced parentheses" -msgstr "" - -#: cobc/tree.c:3040 -msgid "parentheses must contain an unsigned integer" -msgstr "" - -#: cobc/tree.c:3078 -#, c-format -msgid "'%s' is not a constant-name" -msgstr "»%s« ist kein Konstantenname" - -#: cobc/tree.c:3085 -#, c-format -msgid "'%s' is not a numeric literal" -msgstr "»%s« ist kein numerisches Literal" - -#: cobc/tree.c:3089 -#, c-format -msgid "'%s' is not an integer" -msgstr "»%s« ist keine Ganzzahl" - -#: cobc/tree.c:3093 -#, c-format -msgid "'%s' is not unsigned" -msgstr "»%s« ist nicht vorzeichenlos" - -#: cobc/tree.c:3149 -msgid "missing PICTURE string" -msgstr "" - -#: cobc/tree.c:3178 -msgid "C must be followed by R" -msgstr "" - -#: cobc/tree.c:3181 -msgid "D must be followed by B" -msgstr "" - -#: cobc/tree.c:3195 cobc/tree.c:3264 cobc/tree.c:3290 cobc/tree.c:3401 -msgid "uncommon parentheses" -msgstr "" - -#: cobc/tree.c:3219 -msgid "exponent" -msgstr "" - -#: cobc/tree.c:3272 -msgid "S must be at start of PICTURE string" -msgstr "" - -#: cobc/tree.c:3328 -msgid "P must be at start or end of PICTURE string" -msgstr "" - -#: cobc/tree.c:3358 -msgid "cannot have both Z and * in PICTURE string" -msgstr "" - -#: cobc/tree.c:3436 -#, c-format -msgid "invalid PICTURE character '%c'" -msgstr "" - -#: cobc/tree.c:3466 -#, c-format -msgid "PICTURE string may not contain more than %d characters; contains %d characters" -msgstr "" - -#: cobc/tree.c:3471 -msgid "PICTURE string must contain at least one of the set A, N, X, Z, 1, 9 and *; or at least two of the set +, - and the currency symbol" -msgstr "" - -#: cobc/tree.c:3498 -#, c-format -msgid "numeric field cannot be larger than %d digits" -msgstr "Numerisches Feld kann nicht mehr als %d Stellen haben" - -#: cobc/tree.c:3954 cobc/tree.c:3967 -#, c-format -msgid "no DETAIL line defined in report %s" -msgstr "" - -#: cobc/tree.c:3969 -msgid "PAGE LIMIT FIRST DETAIL should be >= HEADING" -msgstr "" - -#: cobc/tree.c:3972 -msgid "PAGE LIMIT FOOTING should be >= HEADING" -msgstr "" - -#: cobc/tree.c:3974 -msgid "PAGE LIMIT LAST DETAIL should be >= FIRST DETAIL" -msgstr "" - -#: cobc/tree.c:3976 -msgid "PAGE LIMIT FOOTING should be >= LAST DETAIL" -msgstr "" - -#: cobc/tree.c:3978 -msgid "PAGE LIMIT LINES should be >= FOOTING" -msgstr "" - -#: cobc/tree.c:4162 -#, c-format -msgid "maximum keys (%d/%d) exceeded for file '%s'" -msgstr "" - -#: cobc/tree.c:4226 cobc/tree.c:4249 -#, c-format -msgid "invalid KEY item '%s', not in file '%s'" -msgstr "Ungültiger KEY-Eintrag »%s«, nicht in Datei »%s«" - -#: cobc/tree.c:4260 -#, c-format -msgid "minimal record length %d can not hold the key item '%s'; needs to be at least %d" -msgstr "" - -#: cobc/tree.c:4296 -#, fuzzy, c-format -msgid "missing file description for %s" -msgstr "Fehlende Definitionen:" - -#: cobc/tree.c:4328 -#, c-format -msgid "size of record '%s' (%d) smaller than minimum of file '%s' (%d)" -msgstr "" - -#: cobc/tree.c:4331 cobc/tree.c:4348 -msgid "file size adjusted" -msgstr "" - -#: cobc/tree.c:4343 -#, c-format -msgid "size of record '%s' (%d) larger than maximum of file '%s' (%d)" -msgstr "" - -#: cobc/tree.c:4386 -#, c-format -msgid "file '%s': RECORD VARYING specified without limits, but implied limits are equal" -msgstr "" - -#: cobc/tree.c:4393 -#, c-format -msgid "file '%s': record size (IDX) %d exceeds maximum allowed (%d)" -msgstr "" - -#: cobc/tree.c:4397 -#, c-format -msgid "file '%s': record size %d exceeds maximum allowed (%d)" -msgstr "" - -#: cobc/tree.c:4404 -msgid "RECORD DELIMITER clause on file with fixed-length records" -msgstr "" - -#: cobc/tree.c:4965 -#, fuzzy, c-format -msgid "literal '%.38s' is longer than '%s'" -msgstr "Größe von »%s« überschreitet die Größe von »%s«" - -#: cobc/tree.c:4969 -#, c-format -msgid "literal '%.38s' is longer than reference-modification of '%s'" -msgstr "" - -#: cobc/tree.c:4994 -#, c-format -msgid "literal '%s' is alphanumeric but '%s' is numeric" -msgstr "" - -#: cobc/tree.c:5036 -#, c-format -msgid "literal '%s' has more decimals than '%s'" -msgstr "" - -#: cobc/tree.c:5078 -#, c-format -msgid "literal '%s' has more digits than '%s'" -msgstr "" - -#: cobc/tree.c:5118 cobc/tree.c:5142 -#, fuzzy, c-format -msgid "unsigned '%s' may not be %s %s" -msgstr "END PROGRAM '%s' ist unterschiedlich zur PROGRAM-ID '%s'" - -#: cobc/tree.c:5128 cobc/tree.c:5151 -#, c-format -msgid "unsigned '%s' may always be %s %s" -msgstr "" - -#: cobc/tree.c:5184 cobc/tree.c:5209 -#, fuzzy, c-format -msgid "'%s' may not be %s %s" -msgstr "»%s« kann hier nicht verwendet werden" - -#: cobc/tree.c:5195 cobc/tree.c:5220 -#, c-format -msgid "'%s' may always be %s %s" -msgstr "" - -#: cobc/tree.c:5355 -msgid "divide by constant ZERO" -msgstr "" - -#: cobc/tree.c:5404 cobc/tree.c:5409 cobc/tree.c:5630 cobc/tree.c:5670 -#: cobc/typeck.c:4476 cobc/typeck.c:4484 cobc/typeck.c:4491 cobc/typeck.c:5561 -#: cobc/typeck.c:5706 -msgid "invalid expression" -msgstr "Ungültiger Ausdruck" - -#: cobc/tree.c:5627 -#, fuzzy, c-format -msgid "invalid expression: %s %s %s" -msgstr "Ungültiger Ausdruck" - -#: cobc/tree.c:5675 -#, c-format -msgid "unexpected operator: %d" -msgstr "Unerwarteter Operator: %d" - -#: cobc/tree.c:5685 -#, c-format -msgid "expression '%.38s' %s '%.38s' is always TRUE" -msgstr "" - -#: cobc/tree.c:5691 -msgid "expression is always TRUE" -msgstr "" - -#: cobc/tree.c:5703 -#, c-format -msgid "expression '%.38s' %s '%.38s' is always FALSE" -msgstr "" - -#: cobc/tree.c:5709 -msgid "expression is always FALSE" -msgstr "Ausdruck ist immer FALSE" - -#: cobc/tree.c:6024 -msgid "PERFORM FOREVER since UNTIL is always FALSE" -msgstr "" - -#: cobc/tree.c:6028 -msgid "PERFORM ONCE since UNTIL is always TRUE" -msgstr "" - -#: cobc/tree.c:6031 -msgid "PERFORM NEVER since UNTIL is always TRUE" -msgstr "" - -#: cobc/tree.c:6132 -#, fuzzy, c-format -msgid "no definition/prototype seen for FUNCTION '%s'" -msgstr "Fehlende Definition von '%s'" - -#: cobc/tree.c:6134 -#, fuzzy, c-format -msgid "no definition/prototype seen for PROGRAM '%s'" -msgstr "Fehlende Definition von '%s'" - -#: cobc/tree.c:6143 -#, fuzzy, c-format -msgid "no definition/prototype seen for FUNCTION with external name '%s'" -msgstr "Fehlende Definition von '%s'" - -#: cobc/tree.c:6145 -#, fuzzy, c-format -msgid "no definition/prototype seen for PROGRAM with external name '%s'" -msgstr "Fehlende Definition von '%s'" - -#: cobc/tree.c:6237 -#, fuzzy, c-format -msgid "FUNCTION %s has invalid argument" -msgstr "FUNCTION »%s« ist nicht implementiert" - -#: cobc/tree.c:6239 -#, c-format -msgid "either all arguments or none should be if type %s" -msgstr "" - -#: cobc/tree.c:6271 cobc/tree.c:6277 cobc/tree.c:6319 cobc/tree.c:6324 -#, c-format -msgid "FUNCTION '%s' has invalid reference modification" -msgstr "" - -#: cobc/tree.c:6288 cobc/tree.c:6730 -#, c-format -msgid "FUNCTION '%s' unknown" -msgstr "FUNCTION »%s« ist unbekannt" - -#: cobc/tree.c:6292 -#, c-format -msgid "FUNCTION '%s' is not implemented" -msgstr "FUNCTION »%s« ist nicht implementiert" - -#: cobc/tree.c:6299 cobc/tree.c:6306 cobc/tree.c:6714 -#, c-format -msgid "FUNCTION '%s' has wrong number of arguments" -msgstr "" - -#: cobc/tree.c:6313 -#, c-format -msgid "FUNCTION '%s' cannot have reference modification" -msgstr "" - -#: cobc/tree.c:6572 cobc/tree.c:6646 cobc/tree.c:6652 cobc/tree.c:6660 -#: cobc/tree.c:6668 -#, fuzzy, c-format -msgid "FUNCTION '%s' has invalid argument" -msgstr "FUNCTION »%s« ist nicht implementiert" - -#: cobc/tree.c:6720 -#, fuzzy, c-format -msgid "FUNCTION '%s' has invalid first argument" -msgstr "FUNCTION »%s« ist nicht implementiert" - -#: cobc/typeck.c:686 -#, fuzzy, c-format -msgid "%s item not allowed here: '%s'" -msgstr "%s hier nicht zulässig" - -#: cobc/typeck.c:728 -#, c-format -msgid "'%s' is not a group name" -msgstr "»%s« ist kein Gruppenname" - -#: cobc/typeck.c:753 -#, c-format -msgid "'%s' is not a numeric name" -msgstr "»%s« ist kein numerischer Name" - -#: cobc/typeck.c:782 -#, fuzzy, c-format -msgid "'%s' is not a numeric or numeric-edited name" -msgstr "'%s' ist kein Report-Name" - -#: cobc/typeck.c:835 -#, fuzzy, c-format -msgid "'%s' is Alpha, instead of a numeric value" -msgstr "»%s« ist kein numerischer Wert" - -#: cobc/typeck.c:838 -#, fuzzy, c-format -msgid "'%s' is Alpha Edited, instead of a numeric value" -msgstr "»%s« ist kein numerischer Wert" - -#: cobc/typeck.c:851 -#, c-format -msgid "'%s' is not a numeric value" -msgstr "»%s« ist kein numerischer Wert" - -#: cobc/typeck.c:901 -#, c-format -msgid "'%s' is not an integer value" -msgstr "" - -#: cobc/typeck.c:905 -msgid "positive numeric integer is required here" -msgstr "" - -#: cobc/typeck.c:1022 -msgid "System routine" -msgstr "Systemroutine" - -#: cobc/typeck.c:1638 libcob/call.c:1069 -#, c-format -msgid "'%s' literal includes leading spaces which are omitted" -msgstr "" - -#: cobc/typeck.c:1642 -#, c-format -msgid "'%s' literal includes trailing spaces which are omitted" -msgstr "" - -#: cobc/typeck.c:1709 -msgid "ON/OFF usage requires a SWITCH name" -msgstr "" - -#: cobc/typeck.c:1727 -#, c-format -msgid "word length exceeds maximum of %d characters: '%s'" -msgstr "Wortlänge überschreitet das Maximum von %d Zeichen: »%s«" - -#: cobc/typeck.c:1730 cobc/typeck.c:1733 -#, c-format -msgid "word length exceeds %d characters: '%s'" -msgstr "Wortlänge überschreitet %d Zeichen: »%s«" - -#: cobc/typeck.c:1810 -#, fuzzy, c-format -msgid "ASSIGN %s interpreted as '%s'" -msgstr "ASSIGN wird als %s interpretiert" - -#: cobc/typeck.c:1900 cobc/typeck.c:2067 -#, c-format -msgid "subscript missing for '%s' - defaulting to 1" -msgstr "" - -#: cobc/typeck.c:1913 cobc/typeck.c:1992 -#, c-format -msgid "'%s' cannot be reference modified" -msgstr "" - -#: cobc/typeck.c:1923 cobc/typeck.c:1988 cobc/typeck.c:2256 -#, c-format -msgid "'%s' cannot be subscripted" -msgstr "" - -#: cobc/typeck.c:1927 cobc/typeck.c:2260 -#, fuzzy, c-format -msgid "'%s' requires one subscript" -msgstr "CALL von %s benötigt %d Parameter" - -#: cobc/typeck.c:1930 cobc/typeck.c:2263 -#, c-format -msgid "'%s' requires %d subscripts" -msgstr "" - -#. TRANSLATORS: This msgid is used when a variable name -#. or label is referenced in a compiler message. -#: cobc/typeck.c:1946 -#, c-format -msgid "'%s'" -msgstr "" - -#: cobc/typeck.c:1948 -#, c-format -msgid "'%s' (accessed by '%s')" -msgstr "" - -#: cobc/typeck.c:2051 -#, c-format -msgid "'%s' has no OCCURS clause" -msgstr "" - -#: cobc/typeck.c:2108 libcob/common.c:3114 -#, fuzzy, c-format -msgid "subscript of '%s' out of bounds: %d" -msgstr "Index von '%s' außerhalb des gültigen Bereichs: %d" - -#: cobc/typeck.c:2162 cobc/typeck.c:2172 -msgid "offset must be greater than zero" -msgstr "" - -#: cobc/typeck.c:2167 cobc/typeck.c:2185 cobc/typeck.c:2204 -msgid "length must be greater than zero" -msgstr "" - -#: cobc/typeck.c:2175 cobc/typeck.c:2178 libcob/common.c:3136 -#, fuzzy, c-format -msgid "offset of '%s' out of bounds: %d" -msgstr "Startposition von '%s' außerhalb des gültigen Bereichs: %d" - -#: cobc/typeck.c:2189 cobc/typeck.c:2193 cobc/typeck.c:2207 cobc/typeck.c:2211 -#: libcob/common.c:3149 -#, c-format -msgid "length of '%s' out of bounds: %d" -msgstr "Länge von »%s« außerhalb des gültigen Bereichs: %d" - -#: cobc/typeck.c:2323 cobc/typeck.c:2407 -#, fuzzy -msgid "reference modification not allowed here" -msgstr "Element mit Stufe 88 hier nicht zulässig" - -#: cobc/typeck.c:2337 cobc/typeck.c:2433 -msgid "88 level item not allowed here" -msgstr "Element mit Stufe 88 hier nicht zulässig" - -#: cobc/typeck.c:2342 -#, c-format -msgid "LENGTH OF '%s' not allowed outside of Procedure Division" -msgstr "" - -#: cobc/typeck.c:2346 cobc/typeck.c:2437 cobc/typeck.c:2445 cobc/typeck.c:2512 -#, fuzzy -msgid "variable length item not allowed here" -msgstr "Element mit variabler Länge hier nicht zulässig" - -#: cobc/typeck.c:2375 -#, c-format -msgid "'%s' has not been DEFINEd" -msgstr "" - -#: cobc/typeck.c:2411 -msgid "only field names allowed here" -msgstr "" - -#: cobc/typeck.c:2422 -#, c-format -msgid "VALUE of '%s': %s target '%s' is invalid" -msgstr "" - -#: cobc/typeck.c:2424 cobc/typeck.c:2494 -msgid "target must be in FILE SECTION or LINKAGE SECTION or have the EXTERNAL clause" -msgstr "" - -#: cobc/typeck.c:2480 cobc/typeck.c:2493 -#, c-format -msgid "VALUE of '%s': %s target is invalid" -msgstr "" - -#: cobc/typeck.c:2482 -msgid "no previous data-item found" -msgstr "" - -#: cobc/typeck.c:2667 -#, c-format -msgid "'%s' is not an alphabet name" -msgstr "»%s« ist kein Bezeichner eines Alphabets" - -#: cobc/typeck.c:2931 -#, fuzzy, c-format -msgid "duplicate character values in alphabet '%s': %s" -msgstr "Doppeltes Zeichen in Alphabet '%s'" - -#: cobc/typeck.c:2936 -#, c-format -msgid "invalid character values in alphabet '%s', starting at position %d" -msgstr "Ungültige Zeichenwerte in Alphabet »%s«, Beginn bei Position %d" - -#: cobc/typeck.c:2990 -msgid "invalid ALPHABET name" -msgstr "Ungültiger Bezeichner für ALPHABET" - -#: cobc/typeck.c:3054 -#, fuzzy, c-format -msgid "duplicate character values in class '%s'" -msgstr "Doppelte Werte in Klasse »%s«" - -#: cobc/typeck.c:3072 -#, c-format -msgid "'%s' is not a locale name" -msgstr "»%s« ist kein Locale-Name" - -#: cobc/typeck.c:3206 -msgid "invalid RECORD DEPENDING item" -msgstr "" - -#: cobc/typeck.c:3211 -msgid "RECORD DEPENDING must reference a data-item" -msgstr "" - -#: cobc/typeck.c:3234 -#, c-format -msgid "RECORD DEPENDING item '%s' should be defined in WORKING-STORAGE, LOCAL-STORAGE or LINKAGE SECTION" -msgstr "" - -#: cobc/typeck.c:3247 -#, fuzzy, c-format -msgid "file %s: RELATIVE KEY %s is not numeric" -msgstr "Wert in AT-Klausel ist nicht numerisch" - -#: cobc/typeck.c:3256 -#, c-format -msgid "file %s: RELATIVE KEY %s must be integer" -msgstr "" - -#: cobc/typeck.c:3261 -#, c-format -msgid "file %s: RELATIVE KEY %s must be unsigned" -msgstr "" - -#: cobc/typeck.c:3268 -#, c-format -msgid "file %s: RELATIVE KEY %s cannot have OCCURS" -msgstr "" - -#: cobc/typeck.c:3274 -#, c-format -msgid "RELATIVE KEY %s cannot be in file record belonging to %s" -msgstr "" - -#: cobc/typeck.c:3283 -#, c-format -msgid "file %s: RELATIVE KEY %s declared outside WORKING-STORAGE" -msgstr "" - -#: cobc/typeck.c:3306 cobc/typeck.c:7184 -#, c-format -msgid "'%s' is not a valid data name" -msgstr "" - -#: cobc/typeck.c:3313 -#, c-format -msgid "CRT STATUS item '%s' should be defined in WORKING-STORAGE or LOCAL-STORAGE" -msgstr "" - -#: cobc/typeck.c:3319 -#, fuzzy, c-format -msgid "'%s' CRT STATUS must have at least 4 digits" -msgstr "'%s' CRT STATUS muss 4 Zeichen lang sein" - -#: cobc/typeck.c:3325 -#, fuzzy, c-format -msgid "'%s' CRT STATUS must be 4 characters long" -msgstr "'%s' CRT STATUS muss 4 Zeichen lang sein" - -#: cobc/typeck.c:3341 -#, fuzzy, c-format -msgid "variable '%s' will be implicitly defined" -msgstr "»%s« wird implizit definiert" - -#: cobc/typeck.c:3375 cobc/typeck.c:3438 -msgid "ASSIGN variable" -msgstr "" - -#: cobc/typeck.c:3443 -#, c-format -msgid "ASSIGN data item '%s' is invalid" -msgstr "" - -#: cobc/typeck.c:3507 -#, c-format -msgid "'%s' CURSOR must be 4 or 6 characters long" -msgstr "»%s« CURSOR muss 4 oder 6 Zeichen lang sein" - -#: cobc/typeck.c:3557 cobc/typeck.c:3561 -#, fuzzy, c-format -msgid "%s does not have a fixed location" -msgstr "»%s« ist weder Feld noch Datei" - -#: cobc/typeck.c:3573 -#, fuzzy, c-format -msgid "'%s' cannot have nested OCCURS DEPENDING" -msgstr "»%s« kann nicht mit OCCURS DEPENDING definiert werden" - -#: cobc/typeck.c:3587 -#, fuzzy, c-format -msgid "'%s' OCCURS DEPENDING ON field item invalid here" -msgstr "»%s« Feld mit REDEFINES-Angabe hier nicht erlaubt" - -#: cobc/typeck.c:3595 -#, fuzzy, c-format -msgid "'%s' cannot have OCCURS DEPENDING because of '%s'" -msgstr "»%s« kann nicht mit OCCURS DEPENDING definiert werden" - -#: cobc/typeck.c:3607 -#, c-format -msgid "'%s' OCCURS DEPENDING ON item must have GLOBAL attribute" -msgstr "" - -#: cobc/typeck.c:3621 -#, c-format -msgid "PASSWORD '%s' for EXTERNAL file '%s' must have EXTERNAL attribute" -msgstr "" - -#: cobc/typeck.c:3644 -#, c-format -msgid "file %s: ASSIGN %s declared outside WORKING-STORAGE" -msgstr "" - -#: cobc/typeck.c:3674 -#, c-format -msgid "duplicate APPLY COMMIT target: '%s'" -msgstr "" - -#: cobc/typeck.c:3688 -msgid "APPLY COMMIT statement invalid for SORT file" -msgstr "" - -#: cobc/typeck.c:3691 -msgid "APPLY COMMIT statement invalid for REPORT file" -msgstr "" - -#: cobc/typeck.c:3698 -#, c-format -msgid "APPLY COMMIT item '%s' should be defined in WORKING-STORAGE or LOCAL-STORAGE" -msgstr "" - -#: cobc/typeck.c:3712 -#, fuzzy, c-format -msgid "item not allowed here: '%s'" -msgstr "%s hier nicht zulässig" - -#: cobc/typeck.c:3725 -#, fuzzy, c-format -msgid "%s may not be subscripted" -msgstr "CALL von %s benötigt %d Parameter" - -#: cobc/typeck.c:3729 -#, c-format -msgid "%s may not be reference modified" -msgstr "" - -#: cobc/typeck.c:3789 -#, c-format -msgid "DEBUGGING target invalid: '%s'" -msgstr "" - -#: cobc/typeck.c:3795 -#, c-format -msgid "DEBUGGING target already specified with ALL PROCEDURES: '%s'" -msgstr "" - -#: cobc/typeck.c:3815 -msgid "DEBUGGING target" -msgstr "" - -#: cobc/typeck.c:3822 -#, c-format -msgid "'%s' is not a valid DEBUGGING target" -msgstr "" - -#: cobc/typeck.c:3860 cobc/typeck.c:3865 -#, c-format -msgid "'%s' is not in DECLARATIVES" -msgstr "»%s« ist nicht in den DECLARATIVES" - -#: cobc/typeck.c:3877 -#, c-format -msgid "invalid reference to '%s' (in DECLARATIVES)" -msgstr "Ungültige Referenz auf »%s« (In DECLARATIVES)" - -#: cobc/typeck.c:3886 -#, fuzzy, c-format -msgid "'%s' is not a procedure name" -msgstr "'%s' ist kein Report-Name" - -#: cobc/typeck.c:3948 -#, c-format -msgid "LINKAGE item '%s' is not a PROCEDURE USING parameter" -msgstr "" - -#: cobc/typeck.c:4001 -#, c-format -msgid "'%s' is not an alterable paragraph" -msgstr "" - -#: cobc/typeck.c:4604 cobc/typeck.c:4608 -#, c-format -msgid "suggest parentheses around %s within %s" -msgstr "" - -#: cobc/typeck.c:4616 -#, fuzzy -msgid "invalid conditional expression" -msgstr "Ungültiger Ausdruck" - -#: cobc/typeck.c:4726 -#, c-format -msgid "internal decimal structure size exceeded: %d" -msgstr "" - -#: cobc/typeck.c:4729 -msgid "Try to minimize the number of parentheses or split into multiple computations." -msgstr "" - -#: cobc/typeck.c:4753 -#, c-format -msgid "more than %d nested expressions" -msgstr "" - -#: cobc/typeck.c:4795 -msgid "precision of result may change with arithmetic-osvs" -msgstr "" - -#: cobc/typeck.c:4851 -#, c-format -msgid "unexpected operation: %c (%d)" -msgstr "Unerwartete Operation: %c (%d)" - -#: cobc/typeck.c:4856 -#, c-format -msgid "%s operator may be misplaced" -msgstr "" - -#: cobc/typeck.c:4926 -msgid "unexpected constant expansion" -msgstr "Unerwartete Konstantenerweiterung" - -#: cobc/typeck.c:5747 -#, c-format -msgid "more than %d nested conditions" -msgstr "" - -#: cobc/typeck.c:6104 cobc/typeck.c:6180 -msgid "no CORRESPONDING items found" -msgstr "" - -#: cobc/typeck.c:6252 -msgid "no items to ACCEPT found" -msgstr "" - -#: cobc/typeck.c:6302 -#, fuzzy -msgid "no items to DISPLAY found" -msgstr "Ungültiger Typ für DISPLAY-Operand" - -#: cobc/typeck.c:6421 -msgid "cannot specify figurative constant ZERO in AT clause" -msgstr "" - -#: cobc/typeck.c:6425 -msgid "value in AT clause is not numeric" -msgstr "Wert in AT-Klausel ist nicht numerisch" - -#: cobc/typeck.c:6431 -msgid "value in AT clause must have 4 or 6 digits" -msgstr "Wert in AT-Klausel muss 4- oder 6-stellig sein" - -#: cobc/typeck.c:6553 -msgid "invalid PROMPT literal" -msgstr "Ungültiges PROMPT-Literal" - -#: cobc/typeck.c:6558 -msgid "invalid PROMPT identifier" -msgstr "" - -#: cobc/typeck.c:6848 -#, c-format -msgid "'%s' is not an input device" -msgstr "»%s« ist kein Eingabegerät" - -#: cobc/typeck.c:6878 cobc/typeck.c:8016 -#, c-format -msgid "'%s' is not defined in SPECIAL-NAMES" -msgstr "»%s« ist nicht unter SPECIAL-NAMES definiert" - -#: cobc/typeck.c:6883 -#, c-format -msgid "invalid input device '%s'" -msgstr "Ungültiges Eingabegerät »%s«" - -#: cobc/typeck.c:6888 cobc/typeck.c:8020 -#, c-format -msgid "unknown device '%s'; it may exist in another dialect" -msgstr "" - -#: cobc/typeck.c:6891 cobc/typeck.c:8023 -#, c-format -msgid "unknown device '%s'; not defined in SPECIAL-NAMES" -msgstr "Unbekanntes Gerät »%s«; ist nicht unter SPECIAL-NAMES definiert" - -#: cobc/typeck.c:6915 -msgid "target of ALLOCATE is not a BASED item" -msgstr "Ziel von ALLOCATE ist kein BASED-Element" - -#: cobc/typeck.c:6926 -msgid "target of RETURNING is not a data pointer" -msgstr "Ziel von RETURNING ist kein Datenzeiger" - -#: cobc/typeck.c:6936 cobc/typeck.c:7342 -msgid "amount must be specified as a numeric expression" -msgstr "" - -#: cobc/typeck.c:6949 -msgid "INITIALIZED TO item is not alphanumeric" -msgstr "Element INITIALIZED TO ist nicht alphanumerisch" - -#: cobc/typeck.c:7019 -msgid "only alphanumeric FUNCTION types are allowed here" -msgstr "Hier sind nur alphanumerische FUNCTION-Typen zulässig" - -#: cobc/typeck.c:7027 -msgid "invalid RETURNING field" -msgstr "" - -#: cobc/typeck.c:7046 -msgid "STDCALL not available on this platform" -msgstr "STDCALL auf dieser Plattform nicht verfügbar" - -#: cobc/typeck.c:7050 -msgid "STDCALL used on 64-bit Windows platform" -msgstr "STDCALL auf 64-bit Plattform verwendet" - -#: cobc/typeck.c:7055 -msgid "STATIC CALL convention requires a literal program name" -msgstr "" - -#: cobc/typeck.c:7060 cobc/typeck.c:10632 cobc/typeck.c:11539 -#: cobc/typeck.c:11903 -msgid "HANDLE must be either a generic or a THREAD HANDLE" -msgstr "" - -#: cobc/typeck.c:7078 -msgid "numeric literal is negative" -msgstr "Numerisches Literal ist negativ" - -#: cobc/typeck.c:7157 -msgid "numeric literal exceeds size limits" -msgstr "Numerisches Literal übersteigt die Größenbeschränkung" - -#: cobc/typeck.c:7175 -#, fuzzy, c-format -msgid "figurative constant %s invalid here" -msgstr "Literal enthält ungültiges Zeichen »%c«" - -#: cobc/typeck.c:7190 -#, c-format -msgid "'%s' ANY LENGTH item not passed BY REFERENCE" -msgstr "" - -#: cobc/typeck.c:7198 -#, c-format -msgid "'%s' is not a 01 or 77 level item" -msgstr "»%s« ist kein Element auf der Stufe 01 oder 77" - -#: cobc/typeck.c:7228 cobc/typeck.c:7233 -#, c-format -msgid "wrong number of CALL parameters for '%s', %d given, %d expected" -msgstr "" - -#: cobc/typeck.c:7300 cobc/typeck.c:7374 cobc/typeck.c:7378 cobc/typeck.c:7382 -#: cobc/typeck.c:7412 cobc/typeck.c:10591 cobc/typeck.c:10755 -#: cobc/typeck.c:10944 cobc/typeck.c:10948 cobc/typeck.c:11844 -#: cobc/typeck.c:12087 cobc/typeck.c:12090 -#, c-format -msgid "%s not allowed on %s files" -msgstr "%s nicht zulässig für %s Dateien" - -#: cobc/typeck.c:7336 -msgid "AFTER phrase in CONTINUE statement" -msgstr "" - -#: cobc/typeck.c:7478 -msgid "positions cannot be specified for main windows" -msgstr "" - -#: cobc/typeck.c:7488 cobc/typeck.c:7491 cobc/typeck.c:7508 -msgid "HANDLE must be either a generic or a WINDOW HANDLE or X(10)" -msgstr "" - -#: cobc/typeck.c:7617 -#, c-format -msgid "'%s' is an invalid type for DISPLAY operand" -msgstr "»%s« ist als Typ für DISPLAY-Operand unzulässig" - -#: cobc/typeck.c:7622 -msgid "invalid type for DISPLAY operand" -msgstr "Ungültiger Typ für DISPLAY-Operand" - -#: cobc/typeck.c:7973 cobc/typeck.c:8006 -#, c-format -msgid "'%s' is not an output device" -msgstr "»%s« ist kein Ausgabegerät" - -#: cobc/typeck.c:8109 -msgid "invalid use of 88 level in WHEN expression" -msgstr "" - -#: cobc/typeck.c:8165 -msgid "wrong number of WHEN parameters" -msgstr "Ungültige Anzahl an WHEN-Parametern" - -#: cobc/typeck.c:8244 cobc/typeck.c:8256 -#, c-format -msgid "target %d of FREE is not a BASED data item" -msgstr "Ziel %d von FREE ist kein BASED-Datenelement" - -#: cobc/typeck.c:8262 -#, c-format -msgid "target %d of FREE must be a data pointer" -msgstr "Ziel %d von FREE muss ein Datenzeiger sein" - -#: cobc/typeck.c:8276 -msgid "GO TO without procedure-name" -msgstr "" - -#: cobc/typeck.c:8286 -msgid "GO TO with multiple procedure-names" -msgstr "" - -#: cobc/typeck.c:8308 -msgid "GO TO ENTRY with multiple entry-names" -msgstr "" - -#: cobc/typeck.c:8367 -msgid "invalid INITIALIZE statement" -msgstr "Ungültige INITIALIZE-Anweisung" - -#: cobc/typeck.c:8443 cobc/typeck.c:8446 -#, c-format -msgid "%s operands differ in size" -msgstr "" - -#: cobc/typeck.c:8476 -#, c-format -msgid "unexpected clause %d" -msgstr "Unerwartete Klausel %d" - -#: cobc/typeck.c:8545 cobc/typeck.c:8556 cobc/typeck.c:8567 cobc/typeck.c:8578 -#, c-format -msgid "data name expected before %s" -msgstr "Datenname vor %s erwartet" - -#: cobc/typeck.c:8588 -#, c-format -msgid "ALL, LEADING or TRAILING expected before '%s'" -msgstr "" - -#: cobc/typeck.c:8598 -msgid "operand has wrong size" -msgstr "" - -#: cobc/typeck.c:8669 -#, c-format -msgid "internal register '%s' defined as BINARY-LONG" -msgstr "Internes Register »%s« ist als BINARY-LONG definiert" - -#: cobc/typeck.c:8672 cobc/typeck.c:8675 cobc/typeck.c:8678 cobc/typeck.c:8681 -#: cobc/typeck.c:8684 cobc/typeck.c:8687 cobc/typeck.c:8690 cobc/typeck.c:8693 -#: cobc/typeck.c:8696 -#, c-format -msgid "'%s' defined here as USAGE %s" -msgstr "" - -#: cobc/typeck.c:8699 -#, c-format -msgid "'%s' defined here as PIC %s" -msgstr "" - -#: cobc/typeck.c:8702 -#, c-format -msgid "'%s' defined here as a group of length %d" -msgstr "" - -#: cobc/typeck.c:8741 -#, c-format -msgid "value is %s" -msgstr "" - -#: cobc/typeck.c:8745 -#, c-format -msgid "value size is %d" -msgstr "" - -#: cobc/typeck.c:9022 -msgid "invalid destination for MOVE" -msgstr "Ungültiges Ziel für MOVE" - -#: cobc/typeck.c:9057 -msgid "MOVE of figurative constant SPACE to numeric item" -msgstr "" - -#: cobc/typeck.c:9072 -msgid "MOVE of figurative constant QUOTE to numeric item" -msgstr "" - -#: cobc/typeck.c:9077 cobc/typeck.c:9089 -msgid "MOVE of figurative constant to numeric item" -msgstr "" - -#: cobc/typeck.c:9151 -msgid "numeric literal in VALUE clause of numeric-edited item" -msgstr "" - -#: cobc/typeck.c:9176 -msgid "numeric move to ALPHABETIC" -msgstr "" - -#: cobc/typeck.c:9188 -msgid "data item not signed" -msgstr "" - -#: cobc/typeck.c:9191 -msgid "ignoring sign" -msgstr "Vorzeichen wird ignoriert" - -#: cobc/typeck.c:9503 -msgid "overlapping MOVE may occur and produce unpredictable results" -msgstr "" - -#: cobc/typeck.c:9510 -msgid "overlapping MOVE may produce unpredictable results" -msgstr "" - -#: cobc/typeck.c:9643 -msgid "invalid source for MOVE" -msgstr "Ungültige Quelle für MOVE" - -#: cobc/typeck.c:9666 -msgid "source is non-numeric - substituting zero" -msgstr "" - -#: cobc/typeck.c:9672 cobc/typeck.c:9683 -msgid "invalid VALUE clause" -msgstr "Ungültige VALUE-Klausel" - -#: cobc/typeck.c:9675 cobc/typeck.c:11480 cobc/typeck.c:11485 -#: cobc/typeck.c:11512 cobc/typeck.c:11517 -msgid "invalid SET statement" -msgstr "Ungültige SET-Anweisung" - -#: cobc/typeck.c:9677 -msgid "invalid MOVE statement" -msgstr "Ungültige MOVE-Anweisung" - -#: cobc/typeck.c:9684 -msgid "literal exceeds data size" -msgstr "Literal übersteigt die Datengröße" - -#: cobc/typeck.c:9688 -msgid "numeric literal exceeds data size" -msgstr "Numerisches Literal übersteigt die Datengröße" - -#: cobc/typeck.c:9697 -msgid "MOVE of non-integer to alphanumeric" -msgstr "" - -#: cobc/typeck.c:9703 -msgid "numeric value is expected" -msgstr "Numerischer Wert wird erwartet" - -#: cobc/typeck.c:9708 -msgid "alphanumeric value is expected" -msgstr "Alphanumerischer Wert wird erwartet" - -#: cobc/typeck.c:9713 -msgid "value does not fit the picture string" -msgstr "" - -#: cobc/typeck.c:9719 -msgid "value size exceeds data size" -msgstr "" - -#: cobc/typeck.c:9724 -msgid "sending field larger than receiving field" -msgstr "" - -#: cobc/typeck.c:9729 -msgid "some digits may be truncated" -msgstr "" - -#: cobc/typeck.c:10515 -#, c-format -msgid "invalid MOVE target: %s" -msgstr "Ungültiges Ziel für MOVE: %s" - -#: cobc/typeck.c:10768 -msgid "READ PREVIOUS not allowed for this file type" -msgstr "" - -#: cobc/typeck.c:10776 -msgid "KEY ignored with sequential READ" -msgstr "" - -#: cobc/typeck.c:10872 -msgid "figurative constants not allowed in FROM clause" -msgstr "" - -#: cobc/typeck.c:10879 -msgid "literal in FROM clause must be alphanumeric, national or boolean" -msgstr "" - -#: cobc/typeck.c:10902 cobc/typeck.c:12047 -#, c-format -msgid "%s FILE requires a FROM clause" -msgstr "" - -#: cobc/typeck.c:10924 cobc/typeck.c:11010 cobc/typeck.c:12069 -#, c-format -msgid "%s subject does not refer to a record name" -msgstr "" - -#: cobc/typeck.c:11016 -msgid "RELEASE not allowed on this record item" -msgstr "" - -#: cobc/typeck.c:11097 cobc/typeck.c:11118 cobc/typeck.c:11125 -msgid "invalid SEARCH ALL condition" -msgstr "Ungültige Bedingung für SEARCH ALL" - -#: cobc/typeck.c:11237 cobc/typeck.c:11241 -msgid "SET targets must be PROGRAM-POINTER" -msgstr "Ziel des SET muss ein PROGRAM-POINTER sein" - -#: cobc/typeck.c:11268 cobc/typeck.c:11335 cobc/typeck.c:11403 -#, c-format -msgid "cannot change address of '%s', which is not level 1 or 77" -msgstr "" - -#: cobc/typeck.c:11272 cobc/typeck.c:11339 cobc/typeck.c:11407 -#, c-format -msgid "cannot change address of '%s', which is not BASED or a LINKAGE item" -msgstr "" - -#: cobc/typeck.c:11291 -#, c-format -msgid "SET target '%s' is not numeric, an INDEX or a POINTER" -msgstr "" - -#: cobc/typeck.c:11360 -#, fuzzy, c-format -msgid "SET target '%s' is not a POINTER for FCD" -msgstr "Ziel des SET muss ein PROGRAM-POINTER sein" - -#: cobc/typeck.c:11428 -#, c-format -msgid "SET target '%s' is not a POINTER for FCD-KEYDEF" -msgstr "" - -#: cobc/typeck.c:11521 -msgid "field does not have a FALSE clause" -msgstr "Feld hat keine FALSE-Klausel" - -#: cobc/typeck.c:11552 -msgid "THREAD-priority must be between 1 and 32767" -msgstr "" - -#: cobc/typeck.c:11572 -msgid "SET ATTRIBUTE requires a screen item as subject" -msgstr "" - -#: cobc/typeck.c:11578 -msgid "SET ATTRIBUTE subject does not refer to a screen item" -msgstr "" - -#: cobc/typeck.c:11629 -msgid "invalid SORT filename" -msgstr "Ungültiger SORT-Dateiname" - -#: cobc/typeck.c:11689 -msgid "invalid SORT USING parameter" -msgstr "Ungültiger Parameter SORT USING" - -#: cobc/typeck.c:11718 -msgid "invalid SORT GIVING parameter" -msgstr "Ungültiger Parameter SORT GIVING" - -#: cobc/typeck.c:11772 cobc/typeck.c:11799 cobc/typeck.c:11819 -#, fuzzy -msgid "invalid key item" -msgstr "Ungültiger Parameter %s" - -#: cobc/typeck.c:11849 -msgid "LENGTH/SIZE clause only allowed on INDEXED files" -msgstr "" - -#: cobc/typeck.c:11854 -msgid "START not allowed with ACCESS MODE RANDOM" -msgstr "" - -#: cobc/typeck.c:12103 -msgid "LOCK clause invalid here" -msgstr "LOCk-Klausel ist hier unzulässig" - -#: cobc/typeck.c:12365 -msgid "data item is not part of a report" -msgstr "" - -#: cobc/typeck.c:12385 -msgid "improper use of SUPPRESS PRINTING" -msgstr "" - -#: cobc/typeck.c:12400 -#, fuzzy, c-format -msgid "%s must be alphanumeric or national" -msgstr "»%s« ist kein alphanumerisches Literal" - -#: cobc/typeck.c:12411 -#, c-format -msgid "%s may not be a figurative constant" -msgstr "" - -#: cobc/typeck.c:12438 -#, c-format -msgid "%s must be a child of the input record" -msgstr "" - -#: cobc/typeck.c:12464 -#, c-format -msgid "%s may not be an ignored item in JSON/XML GENERATE" -msgstr "" - -#: cobc/typeck.c:12475 -#, fuzzy, c-format -msgid "%s must be elementary" -msgstr "muss numerisch sein" - -#: cobc/typeck.c:12487 -#, fuzzy, c-format -msgid "%s must be USAGE DISPLAY or NATIONAL" -msgstr "'%s' ist nicht in der LINKAGE SECTION enthalten" - -#: cobc/typeck.c:12501 -#, fuzzy, c-format -msgid "%s must be an integer" -msgstr "»%s« ist keine Ganzzahl" - -#: cobc/typeck.c:12517 cobc/typeck.c:12523 -msgid "JSON/XML GENERATE receiving item" -msgstr "" - -#: cobc/typeck.c:12520 -msgid "JSON/XML GENERATE receiving item may not have JUSTIFIED clause" -msgstr "" - -#: cobc/typeck.c:12608 -msgid "JSON/XML GENERATE input record may not be reference modified" -msgstr "" - -#: cobc/typeck.c:12614 -msgid "JSON/XML GENERATE input record may not have RENAMES clause" -msgstr "" - -#: cobc/typeck.c:12619 -#, c-format -msgid "all the children of '%s' are ignored in JSON/XML GENERATE" -msgstr "" - -#: cobc/typeck.c:12626 -msgid "JSON/XML GENERATE input record has subrecords with non-unique names" -msgstr "" - -#: cobc/typeck.c:12631 -msgid "floating-point items in JSON/XML GENERATE" -msgstr "" - -#: cobc/typeck.c:12635 -msgid "OCCURS items in JSON/XML GENERATE" -msgstr "" - -#: cobc/typeck.c:12660 -msgid "COUNT IN item must be numeric and an integer" -msgstr "" - -#: cobc/typeck.c:12665 -msgid "COUNT IN item must be an integer" -msgstr "" - -#: cobc/typeck.c:12668 -msgid "COUNT IN item may not have PICTURE with P in it" -msgstr "" - -#: cobc/typeck.c:12711 -msgid "NAMESPACE must be a valid URI" -msgstr "" - -#: cobc/typeck.c:12755 -msgid "NAMESPACE-PREFIX must be a valid XML name" -msgstr "" - -#: cobc/typeck.c:12780 cobc/typeck.c:12787 -msgid "NAME OF item" -msgstr "" - -#: cobc/typeck.c:12784 -msgid "NAME OF item must be the input record or a child of it" -msgstr "" - -#: cobc/typeck.c:12791 -msgid "NAME OF name must be a valid XML name" -msgstr "" - -#: cobc/typeck.c:12817 cobc/typeck.c:12818 cobc/typeck.c:12821 -#: cobc/typeck.c:12825 -msgid "TYPE OF item" -msgstr "" - -#: cobc/typeck.c:12843 -msgid "SUPPRESS WHEN SPACE item" -msgstr "" - -#: cobc/typeck.c:12846 -msgid "SUPPRESS WHEN LOW-VALUE item" -msgstr "" - -#: cobc/typeck.c:12848 -msgid "SUPPRESS WHEN HIGH-VALUE item" -msgstr "" - -#: cobc/typeck.c:12877 cobc/typeck.c:12885 cobc/typeck.c:12889 -msgid "SUPPRESS item" -msgstr "" - -#: cobc/typeck.c:12881 -msgid "SUPPRESS item with WHEN clause" -msgstr "" - -#: cobc/typeck.c:12958 -msgid "WITH ATTRIBUTES specified, but no attributes can be generated" -msgstr "" - -#: cobc/warning.def:34 -#, fuzzy -msgid " -Wextra additional warnings only raised with -W or -Wall" -msgstr " -Werror fasst alle Warnungen als Fehler auf" - -#: cobc/warning.def:37 -msgid " -Wno-unfinished do not warn if unfinished features are used" -msgstr "" - -#: cobc/warning.def:40 -msgid " -Wno-pending do not warn if pending features are mentioned" -msgstr "" - -#: cobc/warning.def:43 -msgid " -Wobsolete warn if obsolete features are used" -msgstr "" - -#: cobc/warning.def:46 -msgid " -Warchaic warn if archaic features are used" -msgstr "" - -#: cobc/warning.def:49 -msgid " -Wredefinition warn about incompatible redefinition of data items" -msgstr "" - -#: cobc/warning.def:52 -msgid " -Wtruncate warn about field truncation from constant assignments" -msgstr "" - -#: cobc/warning.def:55 -msgid " -Wpossible-truncate warn about possible field truncation" -msgstr "" - -#: cobc/warning.def:58 -msgid " -Woverlap warn about overlapping MOVE of items" -msgstr "" - -#: cobc/warning.def:61 -msgid " -Wpossible-overlap warn about MOVE of items that may overlap depending on variables" -msgstr "" - -#: cobc/warning.def:64 -msgid " -Wparentheses warn about lack of parentheses around AND within OR" -msgstr "" - -#: cobc/warning.def:67 -msgid " -Wstrict-typing warn strictly about type mismatch" -msgstr "" - -#: cobc/warning.def:70 -#, fuzzy -msgid " -Wimplicit-define warn about implicitly defined data items" -msgstr "'%s' wird implizit definiert" - -#: cobc/warning.def:73 -msgid " -Wcorresponding warn about CORRESPONDING with no matching items" -msgstr "" - -#: cobc/warning.def:76 -msgid " -Winitial-value warn if initial VALUE clause is ignored" -msgstr "" - -#: cobc/warning.def:79 -msgid " -Wprototypes warn about missing FUNCTION prototypes/definitions" -msgstr "" - -#: cobc/warning.def:82 -msgid " -Warithmetic-osvs warn if arithmetic expression precision has changed" -msgstr "" - -#: cobc/warning.def:85 -msgid " -Wcall-params warn about non 01/77 items for CALL parameters" -msgstr "" - -#: cobc/warning.def:88 -msgid " -Wconstant-expression warn about expressions that always resolve to true/false" -msgstr "" - -#: cobc/warning.def:91 -msgid " -Wcolumn-overflow warn about text after program-text area, FIXED format" -msgstr "" - -#: cobc/warning.def:94 -msgid " -Wterminator warn about lack of scope terminator END-XXX" -msgstr "" - -#: cobc/warning.def:97 -msgid " -Wlinkage warn about dangling LINKAGE items" -msgstr "" - -#: cobc/warning.def:100 -msgid " -Wunreachable warn about likely unreachable statements" -msgstr "" - -#: cobc/warning.def:103 -msgid " -Wno-dialect do not warn about dialect specific issues" -msgstr "" - -#: cobc/warning.def:106 -#, fuzzy -msgid " -Wothers do not warn about different issues" -msgstr " -Werror fasst alle Warnungen als Fehler auf" - -#: cobc/warning.def:109 -msgid " -Wno-unsupported do not warn if runtime does not support a feature used" -msgstr "" - -#: libcob/call.c:87 -#, c-format -msgid "LoadLibrary/GetProcAddress error %d" -msgstr "LoadLibrary/GetProcAddress-Fehler %d" - -#: libcob/call.c:939 -msgid "indeterminable error in resolve of COBOL CALL" -msgstr "" - -#: libcob/call.c:1022 -#, c-format -msgid "user-defined FUNCTION '%s' not found" -msgstr "Benutzerdefinierte FUNCTION »%s« nicht gefunden" - -#: libcob/call.c:1129 libcob/call.c:1208 libcob/call.c:1326 libcob/call.c:1354 -#, c-format -msgid "NULL parameter passed to '%s'" -msgstr "Aufruf von »%s« mit Parameter NULL" - -#: libcob/call.c:1204 -#, fuzzy, c-format -msgid "invalid number of arguments passed to '%s'" -msgstr "Ungültige Anzahl an Argumenten beim Aufruf von '%s'" - -#: libcob/call.c:1330 -msgid "multiple call to 'cob_setjmp'" -msgstr "" - -#: libcob/call.c:1358 -msgid "call to 'cob_longjmp' with no prior 'cob_setjmp'" -msgstr "Aufruf von »cob_longjmp« ohne vorherigen Aufruf von »cob_setjmp«" - -#: libcob/call.c:1592 libcob/call.c:1633 libcob/call.c:1646 -#: libcob/common.c:7081 -msgid "cob_init() has not been called" -msgstr "Fehlender Aufruf von cob_init()" - -#: libcob/call.c:1598 -#, c-format -msgid "parameter %d is not within range of %d" -msgstr "" - -#: libcob/call.c:1604 -#, fuzzy, c-format -msgid "parameter %d is NULL" -msgstr "Aufruf von '%s' mit Parameter NULL" - -#: libcob/call.c:1859 libcob/call.c:1916 -#, c-format -msgid "attempt to over-write constant parameter %d with " -msgstr "" - -#: libcob/call.c:1965 -#, c-format -msgid "attempt to over-write constant parameter %d with '%s'" -msgstr "" - -#: libcob/cobgetopt.c:497 -#, c-format -msgid "%s: option '%s' is ambiguous; possibilities:" -msgstr "%s: Option »%s« ist mehrdeutig, Möglichkeiten:" - -#: libcob/cobgetopt.c:538 -#, c-format -msgid "%s: option '--%s' doesn't allow an argument" -msgstr "%s: Option »--%s« erlaubt kein Argument" - -#: libcob/cobgetopt.c:545 -#, c-format -msgid "%s: option '%c%s' doesn't allow an argument" -msgstr "%s: Option »%c%s« erlaubt kein Argument" - -#: libcob/cobgetopt.c:565 -#, c-format -msgid "%s: option '--%s' requires an argument" -msgstr "%s: Option »--%s« erfordert ein Argument" - -#: libcob/cobgetopt.c:597 -#, c-format -msgid "%s: unrecognized option '--%s'" -msgstr "%s: Unbekannte Option »--%s«" - -#: libcob/cobgetopt.c:604 -#, c-format -msgid "%s: unrecognized option '%c%s'" -msgstr "%s: Unbekannte Option »%c%s«" - -#: libcob/cobgetopt.c:633 -#, c-format -msgid "%s: invalid option -- %c" -msgstr "%s: Ungültige Option -- %c" - -#: libcob/cobgetopt.c:664 libcob/cobgetopt.c:805 -#, c-format -msgid "%s: option requires an argument -- %c" -msgstr "%s: Option erfordert ein Argument -- %c" - -#: libcob/cobgetopt.c:714 -#, c-format -msgid "%s: option '-W %s' is ambiguous" -msgstr "%s: Option »-W %s« ist mehrdeutig" - -#: libcob/cobgetopt.c:736 -#, c-format -msgid "%s: option '-W %s' doesn't allow an argument" -msgstr "%s: Option »-W %s« erlaubt kein Argument" - -#: libcob/cobgetopt.c:754 -#, c-format -msgid "%s: option '%s' requires an argument" -msgstr "%s: Option »%s« erfordert ein Argument" - -#: libcob/common.c:793 -#, c-format -msgid "attempt to reference unallocated memory" -msgstr "Versuch auf nicht bereitgestellten Arbeitsspeicher zuzugreifen" - -#: libcob/common.c:798 -#, c-format -msgid "bus error" -msgstr "" - -#: libcob/common.c:803 -#, c-format -msgid "fatal arithmetic error" -msgstr "" - -#: libcob/common.c:807 -#, c-format -msgid "caught signal" -msgstr "Signal abgefangen" - -#: libcob/common.c:811 -#, c-format -msgid "signal %s" -msgstr "Signal %s" - -#: libcob/common.c:817 -#, c-format -msgid "abnormal termination - file contents may be incorrect" -msgstr "" - -#: libcob/common.c:2049 -msgid "NULL field" -msgstr "" - -#: libcob/common.c:2059 -msgid "field with NULL address" -msgstr "" - -#: libcob/common.c:2345 -#, fuzzy -msgid "version mismatch" -msgstr "Fehler: Versionsnummern stimmen nicht überein" - -#: libcob/common.c:2346 libcob/common.c:2348 -#, fuzzy, c-format -msgid "%s has version %s.%d" -msgstr "%s hat die Version/das Patchlevel %s/%d" - -#: libcob/common.c:2358 -#, fuzzy, c-format -msgid "CALL to %s requires %d arguments" -msgstr "CALL von %s benötigt %d Parameter" - -#: libcob/common.c:2980 -#, fuzzy, c-format -msgid "BASED/LINKAGE item %s has NULL address" -msgstr "BASED/LINKAGE Element '%s' hat die Speicheradresse NULL" - -#: libcob/common.c:2992 libcob/common.c:2995 -#, c-format -msgid "LINKAGE item %s not passed by caller" -msgstr "" - -#: libcob/common.c:3081 -#, fuzzy, c-format -msgid "'%s' (Type: %s) not numeric: '%s'" -msgstr "»%s« ist nicht numerisch: »%s«" - -#: libcob/common.c:3096 -#, c-format -msgid "OCCURS DEPENDING ON '%s' out of bounds: %d" -msgstr "OCCURS DEPENDING ON »%s« außerhalb des gültigen Bereichs: %d" - -#: libcob/common.c:3099 libcob/common.c:3120 -#, c-format -msgid "maximum subscript for '%s': %d" -msgstr "" - -#: libcob/common.c:3101 -#, c-format -msgid "minimum subscript for '%s': %d" -msgstr "" - -#: libcob/common.c:3117 -#, c-format -msgid "current maximum subscript for '%s': %d" -msgstr "" - -#: libcob/common.c:3139 -#, fuzzy, c-format -msgid "offset of '%s' out of bounds: %d, maximum: %d" -msgstr "Startposition von '%s' außerhalb des gültigen Bereichs: %d" - -#: libcob/common.c:3152 -#, fuzzy, c-format -msgid "length of '%s' out of bounds: %d, maximum: %d" -msgstr "Länge von »%s« außerhalb des gültigen Bereichs: %d" - -#: libcob/common.c:3161 -#, fuzzy, c-format -msgid "length of '%s' out of bounds: %d, starting at: %d, maximum: %d" -msgstr "Länge von »%s« außerhalb des gültigen Bereichs: %d" - -#: libcob/common.c:3176 libcob/common.c:3181 -#, c-format -msgid "EXTERNAL item '%s' previously allocated with size %d, requested size is %d" -msgstr "" - -#: libcob/common.c:3682 -#, c-format -msgid "COB_CURRENT_DATE '%s' is invalid" -msgstr "" - -#: libcob/common.c:4585 -#, c-format -msgid "parameter to SYSTEM call is larger than %d characters" -msgstr "Parameter für SYSTEM-Aufruf ist länger als %d Zeichen" - -#: libcob/common.c:5195 -#, c-format -msgid "error '%s' during CBL_GC_FORK" -msgstr "" - -#: libcob/common.c:5200 libcob/common.c:5297 -#, c-format -msgid "'%s' is not supported on this platform" -msgstr "»%s« ist auf dieser Plattform nicht verfügbar" - -#: libcob/common.c:5226 -#, c-format -msgid "error '%s' for P%d during CBL_GC_WAITPID" -msgstr "" - -#: libcob/common.c:5418 -msgid "Call to CBL_GC_GETOPT with wrong longoption size." -msgstr "" - -#: libcob/common.c:5423 -msgid "Call to CBL_GC_GETOPT with missing longind." -msgstr "" - -#: libcob/common.c:5837 libcob/common.c:5858 libcob/common.c:5871 -#: libcob/common.c:7785 -#, fuzzy, c-format -msgid "(default)" -msgstr " (Standard)" - -#: libcob/common.c:6119 libcob/common.c:6138 -msgid "should be unsigned" -msgstr "" - -#: libcob/common.c:6127 libcob/common.c:6176 -#, fuzzy -msgid "should be numeric" -msgstr "muss numerisch sein" - -#: libcob/common.c:6185 -#, c-format -msgid "minimum value: %lu" -msgstr "" - -#: libcob/common.c:6236 libcob/common.c:6787 libcob/common.c:6801 -#, c-format -msgid "should not contain '%c'" -msgstr "" - -#: libcob/common.c:6316 libcob/common.c:6384 libcob/common.c:6393 -#: libcob/common.c:6401 -#, c-format -msgid "not set" -msgstr "" - -#: libcob/common.c:6376 libcob/common.c:6379 libcob/common.c:6382 -#, fuzzy, c-format -msgid "set by %s" -msgstr "Geschrieben von %s\n" - -#: libcob/common.c:6516 -#, c-format -msgid "WARNING - '%s' without a value - ignored!" -msgstr "" - -#: libcob/common.c:6519 -#, c-format -msgid "'%s' without a value!" -msgstr "»%s« ohne Wertangabe!" - -#: libcob/common.c:6545 -#, c-format -msgid "WARNING - '%s %s' without a value - ignored!" -msgstr "" - -#: libcob/common.c:7034 -#, fuzzy -msgid "error" -msgstr "Fehler: " - -#: libcob/common.c:7064 -msgid "attempt to CANCEL active program" -msgstr "Versuch CANCEL auf ein aktives Programm durchzuführen" - -#: libcob/common.c:7091 -msgid "CALL of program with CHAINING clause" -msgstr "" - -#: libcob/common.c:7095 -msgid "stack overflow, possible PERFORM depth exceeded" -msgstr "" - -#: libcob/common.c:7100 -msgid "invalid entry/exit in GLOBAL USE procedure" -msgstr "" - -#: libcob/common.c:7105 -msgid "unable to allocate memory" -msgstr "Arbeitsspeicher kann nicht bereitgestellt werden" - -#: libcob/common.c:7110 -#, fuzzy -msgid "invalid entry into module" -msgstr "Kann Modul nicht finden" - -#: libcob/common.c:7115 -#, c-format -msgid "recursive CALL from %s to %s which is NOT RECURSIVE" -msgstr "" - -#: libcob/common.c:7125 -msgid "divide by ZERO" -msgstr "" - -#: libcob/common.c:7132 -msgid "end of file" -msgstr "Dateiende" - -#: libcob/common.c:7135 -msgid "key out of range" -msgstr "" - -#: libcob/common.c:7138 -msgid "key order not ascending" -msgstr "" - -#: libcob/common.c:7141 -msgid "record key already exists" -msgstr "" - -#: libcob/common.c:7144 -#, fuzzy -msgid "record key does not exist" -msgstr "Datei existiert nicht" - -#: libcob/common.c:7147 -msgid "permanent file error" -msgstr "Permanenter Dateifehler" - -#: libcob/common.c:7150 -#, fuzzy -msgid "inconsistant file name" -msgstr "Ungültiger Name der Konfigurationsdatei" - -#: libcob/common.c:7153 -msgid "file does not exist" -msgstr "Datei existiert nicht" - -#: libcob/common.c:7156 -msgid "permission denied" -msgstr "Zugriff verweigert" - -#: libcob/common.c:7159 -msgid "file already open" -msgstr "Datei wurde bereits geöffnet" - -#: libcob/common.c:7162 -msgid "file not open" -msgstr "Datei wurde noch nicht geöffnet" - -#: libcob/common.c:7165 -msgid "READ must be executed first" -msgstr "Zuerst muss ein READ erfolgen" - -#: libcob/common.c:7168 -msgid "record overflow" -msgstr "" - -#: libcob/common.c:7171 -#, fuzzy -msgid "READ after unsuccessful READ/START" -msgstr "READ nach fehlgeschlagenem READ/START" - -#: libcob/common.c:7174 -msgid "READ/START not allowed, file not open for input" -msgstr "READ/START nicht erlaubt, Datei ist nicht für Eingabe offen" - -#: libcob/common.c:7177 -msgid "WRITE not allowed, file not open for output" -msgstr "" - -#: libcob/common.c:7180 -msgid "DELETE/REWRITE not allowed, file not open for I-O" -msgstr "DELETE/REWRITE nicht erlaubt, Datei ist nicht für Ein-/Ausgabe offen" - -#: libcob/common.c:7183 -msgid "record locked by another file connector" -msgstr "Datensatz durch einen anderen Datei-Konnektor gesperrt" - -#: libcob/common.c:7186 -msgid "LINAGE values invalid" -msgstr "Angabe für LINAGE ist ungültig" - -#: libcob/common.c:7189 -msgid "file sharing conflict" -msgstr "Konflikt beim gemeinsamen Dateizugriff" - -#: libcob/common.c:7193 -msgid "runtime library is not configured for this operation" -msgstr "Die Laufzeitumgebung ist für diese Operation nicht konfiguriert" - -#: libcob/common.c:7198 -msgid "unknown file error" -msgstr "Unbekannter Dateifehler" - -#: libcob/common.c:7205 -#, fuzzy, c-format -msgid "%s (status = %02d) for file %s" -msgstr "%s (Status = %02d) Datei: »%s«" - -#: libcob/common.c:7208 -#, fuzzy, c-format -msgid "%s (status = %02d) for file %s on %s" -msgstr "%s (Status = %02d) Datei: »%s«" - -#: libcob/common.c:7215 -msgid "attempt to use non-implemented function" -msgstr "Versuch, eine nicht implementierte Funktion zu benutzen" - -#: libcob/common.c:7218 -#, fuzzy -msgid "attempt to use non-implemented XML I/O" -msgstr "Versuch, eine nicht implementierte Funktion zu benutzen" - -#: libcob/common.c:7221 -#, fuzzy -msgid "attempt to use non-implemented JSON I/O" -msgstr "Versuch, eine nicht implementierte Funktion zu benutzen" - -#: libcob/common.c:7268 -msgid "environment variables" -msgstr "Umgebungsvariablen" - -#: libcob/common.c:7315 -msgid "License LGPLv3+: GNU LGPL version 3 or later " -msgstr "" - -#: libcob/common.c:7372 libcob/common.c:7374 -msgid "dynamic loading" -msgstr "" - -#: libcob/common.c:7379 -msgid "enabled" -msgstr "Aktiviert" - -#: libcob/common.c:7460 libcob/common.c:7577 libcob/common.c:7586 -#: libcob/common.c:7603 libcob/common.c:7618 -#, fuzzy, c-format -msgid "%s, version %d.%d.%d" -msgstr "C-Version %s%s" - -#: libcob/common.c:7462 libcob/common.c:7579 libcob/common.c:7588 -#: libcob/common.c:7620 -#, c-format -msgid "%s, version %d.%d.%d (compiled with %d.%d)" -msgstr "" - -#: libcob/common.c:7465 -#, fuzzy, c-format -msgid "%s, version %s" -msgstr "C-Version %s%s" - -#: libcob/common.c:7486 libcob/common.c:7488 libcob/common.c:7493 -#: libcob/common.c:7495 libcob/common.c:7498 -#, fuzzy -msgid "mouse support" -msgstr "" - -#: libcob/common.c:7636 -msgid "CALL configuration" -msgstr "CALL-Konfiguration" - -#: libcob/common.c:7637 -msgid "File I/O configuration" -msgstr "Konfiguration der Datei-Ein-/Ausgabe" - -#: libcob/common.c:7638 -msgid "Screen I/O configuration" -msgstr "Konfiguration der Bildschirm-Ein-/Ausgabe" - -#: libcob/common.c:7639 -msgid "Miscellaneous" -msgstr "Diverses" - -#: libcob/common.c:7640 -msgid "System configuration" -msgstr "Systemkonfiguration" - -#: libcob/common.c:7644 -msgid "runtime configuration" -msgstr "Konfiguration der Laufzeitumgebung" - -#: libcob/common.c:7646 -msgid "via" -msgstr "" - -#: libcob/common.c:7719 libcob/common.c:7747 -msgid "... removed from environment" -msgstr "… aus der Umgebung entfernt" - -#: libcob/common.c:7773 libcob/common.c:7775 -#, c-format -msgid "(set by %s)" -msgstr "" - -#: libcob/common.c:7783 -#, c-format -msgid "(reset)" -msgstr "" - -#: libcob/common.c:8167 libcob/common.c:8286 -#, c-format -msgid "%s called with unknown option: %d" -msgstr "" - -#: libcob/common.c:8239 -#, c-format -msgid "Module dump due to %s\n" -msgstr "" - -#: libcob/common.c:8243 -#, c-format -msgid " Last statement of %s was Line %d of %s\n" -msgstr "" - -#: libcob/common.c:8249 -#, c-format -msgid " Last statement of %s unknown\n" -msgstr "" - -#: libcob/common.c:8259 -#, c-format -msgid "Dump Program-Id %s from %s compiled %s\n" -msgstr "" - -#: libcob/fileio.c:287 -#, c-format -msgid "ERROR I/O routine %s is not present" -msgstr "" - -#: libcob/fileio.c:1365 -#, c-format -msgid "I/O routine %s is not present for %s" -msgstr "" - -#: libcob/fileio.c:1404 -#, c-format -msgid "I/O routine %s is not known for %s" -msgstr "" - -#: libcob/fileio.c:2599 -#, c-format -msgid "ERROR FILE %s has record size %d exceeds %d in program" -msgstr "" - -#: libcob/fileio.c:2967 libcob/fileio.c:2974 -#, c-format -msgid "ERROR FILE %s opening pipe" -msgstr "" - -#: libcob/fileio.c:4979 -#, c-format -msgid "ERROR FILE %s does not match current version; Recompile the program" -msgstr "" - -#: libcob/fileio.c:5034 -#, c-format -msgid "ERROR FILE %s has ASSIGN field is NULL" -msgstr "" - -#: libcob/fileio.c:5707 -#, c-format -msgid "call to CBL_OPEN_FILE with wrong access mode: %d" -msgstr "" - -#: libcob/fileio.c:5756 -#, c-format -msgid "call to CBL_CREATE_FILE with wrong file_lock: %d" -msgstr "" - -#: libcob/fileio.c:5759 -#, c-format -msgid "call to CBL_CREATE_FILE with wrong file_dev: %d" -msgstr "" - -#: libcob/fileio.c:5955 libcob/fileio.c:6215 -#, c-format -msgid "'%s' - File detail area is too short" -msgstr "»%s« - Bereich für Dateiinformationen ist zu klein" - -#: libcob/fileio.c:6437 -msgid "SORT is unable to acquire temporary file" -msgstr "SORT kann keine temporäre Datei erstellen" - -#: libcob/fileio.c:7057 -#, fuzzy, c-format -msgid "implicit CLOSE of %s" -msgstr "Implizites CLOSE von %s (»%s«)" - -#: libcob/fileio.c:7165 -#, c-format -msgid "C-ISAM library %s is not present" -msgstr "" - -#: libcob/fileio.c:7173 -#, c-format -msgid "D-ISAM library %s is not present" -msgstr "" - -#: libcob/fileio.c:7181 -#, c-format -msgid "VB-ISAM library %s is not present" -msgstr "" - -#: libcob/screenio.c:429 -msgid "failed to initialize curses" -msgstr "Fehler bei der Initialisierung von curses" - -#: libcob/screenio.c:3591 -msgid "end of program, please press a key to exit" -msgstr "" - -#: libcob/termio.c:70 libcob/termio.c:106 -msgid "(Not representable)" -msgstr "(nicht darstellbar)" - -#: libcob/termio.c:347 -#, fuzzy, c-format -msgid "cannot open %s (=%s)" -msgstr "%s und %s können nicht gleichzeitig angegeben werden" - -#: libcob/termio.c:362 -msgid "COB_DISPLAY_PUNCH_FILE is invalid, output to SYSPUNCH skipped" -msgstr "" - -#: bin/cobcrun.c:122 -msgid "GnuCOBOL module loader" -msgstr "" - -#: bin/cobcrun.c:124 -#, c-format -msgid "Usage: %s [options] PROGRAM [parameter ...]" -msgstr "Aufruf: %s [Optionen] PROGRAMM [Parameter …]" - -#: bin/cobcrun.c:126 -#, c-format -msgid " or: %s options" -msgstr " oder : %s Optionen" - -#: bin/cobcrun.c:129 -msgid "Options:" -msgstr "Optionen:" - -#: bin/cobcrun.c:130 -msgid " -h, -help display this help and exit" -msgstr " -h, -help zeigt diese Hilfe an und beendet das Programm" - -#: bin/cobcrun.c:131 -msgid " -V, -version display cobcrun and runtime version and exit" -msgstr " -V, -version zeigt Versionsinformation an und beendet das Programm" - -#: bin/cobcrun.c:132 -msgid " -i, -info display runtime information (build/environment)" -msgstr " -i, -info zeigt Compilerinformation an (Build/Umgebung)" - -#: bin/cobcrun.c:134 -msgid " -q, -brief reduced displays" -msgstr "" - -#: bin/cobcrun.c:136 -msgid " -c , -config= set runtime configuration from " -msgstr " -c , -config= setzt die Laufzeitkonfiguration aus " - -#: bin/cobcrun.c:137 -#, fuzzy -msgid "" -" -r, -runtime-config display current runtime configuration\n" -" (value and origin for all settings)" -msgstr "" -" -r, -runtime-conf zeigt die aktuelle Laufzeitkonfiguration an\n" -" (Wert und Ursprung für alle Einstellungen)" - -#: bin/cobcrun.c:139 -msgid "" -" -M , -module= set entry point module name and/or load path\n" -" where -M module prepends any directory to the\n" -" dynamic link loader library search path\n" -" and any basename to the module preload list\n" -" (COB_LIBRARY_PATH and/or COB_PRELOAD)" -msgstr "" - -#: bin/cobcrun.c:145 -#, c-format -msgid "" -"Report bugs to: %s\n" -"or (preferably) use the issue tracker via the home page." -msgstr "" -"Melden Sie Fehler an: %s\n" -"oder (noch besser) verwenden Sie das Ticketsystem auf der Homepage." - -#: bin/cobcrun.c:148 -#, fuzzy -msgid "GnuCOBOL home page: " -msgstr "Homepage von GnuCOBOL: " - -#: bin/cobcrun.c:149 -#, fuzzy -msgid "General help using GNU software: " -msgstr "Allgemeine Hilfe zur Verwendung von GNU-Software: " - -#: bin/cobcrun.c:274 -msgid "invalid configuration file name" -msgstr "Ungültiger Name der Konfigurationsdatei" - -#: bin/cobcrun.c:325 -#, fuzzy, c-format -msgid "invalid module argument '%s'" -msgstr "Ungültiges Modul-Argument" - -#: bin/cobcrun.c:377 -#, c-format -msgid "%s: missing PROGRAM name" -msgstr "" - -#: bin/cobcrun.c:379 -#, c-format -msgid "Try '%s --help' for more information." -msgstr "" - -#: bin/cobcrun.c:387 -#, fuzzy, c-format -msgid "%s: PROGRAM name exceeds %d characters" -msgstr "PROGRAM Name überschreitet 31 Zeichen" - -#~ msgid "%s: %d: invalid cast from '%s' type %s to type %s" -#~ msgstr "%s: %d: Ungültige Umwandlung vom Typ »%s« %s zum Typ %s" - -#~ msgid " - length is < 1 or > 31" -#~ msgstr " - Länge ist < 1 oder > 31" - -#~ msgid "unknown name error '%s'%s" -#~ msgstr "Unbekannter Fehler zum Bezeichner »%s«%s" - -#~ msgid "ISAM handler" -#~ msgstr "ISAM-Handler" - -#~ msgid "- NOT set with -Wall" -#~ msgstr "- Nicht mit -Wall gesetzt" - -#~ msgid "default" -#~ msgstr "(Standard)" - -#~ msgid "GnuCOBOL compiler for most COBOL dialects with lots of extensions" -#~ msgstr "GnuCOBOL-Compiler für die meisten COBOL-Dialekte mit zahlreichen Erweiterungen" - -#~ msgid "Usage: %s [options]... file..." -#~ msgstr "Aufruf: %s [Optionen] Datei …" - -#~ msgid " -h, -help display this help and exit" -#~ msgstr " -h, -help zeigt diese Hilfe an und beendet das Programm" - -#~ msgid " -V, -version display compiler version and exit" -#~ msgstr " -V, -version zeigt die Version des Compilers an" - -#~ msgid "" -#~ " -v, -verbose display compiler version and the commands\n" -#~ " invoked by the compiler" -#~ msgstr "" -#~ " -v, -verbose Compilerversion und vom Compiler ausgeführte\n" -#~ " Befehle anzeigen" - -#~ msgid "" -#~ " -vv, -verbose=2 like -v but additional pass verbose option\n" -#~ " to assembler/compiler" -#~ msgstr "" -#~ " -vv, -verbose=2 wie -v, aber zusätzlich die geschwätzig-Option\n" -#~ " an den Assembler/Compiler weiterreichen" - -#~ msgid "" -#~ " -vvv, -verbose=3 like -vv but additional pass verbose option\n" -#~ " to linker" -#~ msgstr "" -#~ " -vvv, -verbose=3 wie -vv, aber zusätzlich die geschwätzig-Option\n" -#~ " an den Linker weiterreichen" - -#~ msgid " -q, -brief reduced displays, commands invoked not shown" -#~ msgstr "" -#~ " -v zeigt aufgerufene Befehle nicht an,\n" -#~ " für eingeschränkte Bildschirme" - -#~ msgid " -### like -v but commands not executed" -#~ msgstr " -### wie -v, aber die Befehle werden nicht ausgeführt" - -#~ msgid " -x build an executable program" -#~ msgstr " -x erstellt ein ausführbares Programm" - -#~ msgid " -m build a dynamically loadable module (default)" -#~ msgstr " -m erstellt ein dynamisch ladbares Modul (Standard)" - -#~ msgid " -j [], -job[=]\trun program after build, passing " -#~ msgstr "" -#~ " -j [], -job[=]\tNach dem Bauen das Programm ausführen\n" -#~ "\tund dabei als Argumente übergeben" - -#~ msgid "" -#~ " -std= warnings/features for a specific dialect\n" -#~ " can be one of:\n" -#~ " default, cobol2014, cobol2002, cobol85, xopen,\n" -#~ " ibm-strict, ibm, mvs-strict, mvs,\n" -#~ " mf-strict, mf, bs2000-strict, bs2000,\n" -#~ " acu-strict, acu, rm-strict, rm;\n" -#~ " see configuration files in directory config" -#~ msgstr "" -#~ " -std= Warnungen/Features für einen bestimmten\n" -#~ " Dialekt auswählen, dabei kann \n" -#~ " einer von diesen sein:\n" -#~ " default, cobol2014, cobol2002, cobol85, xopen,\n" -#~ " ibm-strict, ibm, mvs-strict, mvs,\n" -#~ " mf-strict, mf, bs2000-strict, bs2000,\n" -#~ " acu-strict, acu, rm-strict, rm;\n" -#~ " siehe die Konfigurationsdateien im Verzeichnis\n" -#~ " »config«" - -#, fuzzy -#~ msgid " -fixed use fixed source format (default)" -#~ msgstr " -fixed Benutze fixed source format (Standard)" - -#~ msgid " -O, -O2, -O3, -Os enable optimization" -#~ msgstr " -O, -O2, -O3, -Os aktiviert die Optimierung" - -#, fuzzy -#~ msgid " -g enable C compiler debug / stack check / trace" -#~ msgstr " -g C Compiler Debugginginformationen / Stapelprüfungen / Traceinformationen aktivieren" - -#~ msgid " -d, -debug enable all run-time error checking" -#~ msgstr " -debug aktiviert alle Laufzeitprüfungen" - -#~ msgid " -o place the output into " -#~ msgstr " -o schreibt die Ausgabe in " - -#~ msgid "" -#~ " -b combine all input files into a single\n" -#~ " dynamically loadable module" -#~ msgstr "" -#~ " -b kombiniere alle Eingabedateien in ein\n" -#~ " einziges dynamisch ladbares Modul" - -#, fuzzy -#~ msgid " -E preprocess only; do not compile or link" -#~ msgstr " -E Nur Präprozessor, kein Compiler oder Binder" - -#~ msgid " -C translation only; convert COBOL to C" -#~ msgstr " -C übersetzt nur von COBOL nach C" - -#~ msgid " -S compile only; output assembly file" -#~ msgstr " -S kompiliert nur, assembliert oder linkt aber nicht" - -#~ msgid " -c compile and assemble, but do not link" -#~ msgstr " -c kompiliert und assembliert nur, linkt aber nicht" - -#~ msgid " -T generate and place a wide program listing into " -#~ msgstr " -T breites Programmlisting generieren und in ablegen" - -#~ msgid " -t generate and place a program listing into " -#~ msgstr " -t Programmlisting generieren und in ablegen" - -#~ msgid " --tlines= specify lines per page in listing, default = 55" -#~ msgstr " --tlines= Anzahl der Zeilen pro Listingseite angeben, Vorgabe ist 55" - -#~ msgid " -P[=] generate preprocessed program listing (.lst)" -#~ msgstr " -P[=] vorverarbeitetes Programmlisting (.lst) generieren" - -#~ msgid " -Xref specify cross reference in listing" -#~ msgstr " -Xref Querverweise in Listing angeben" - -#, fuzzy -#~ msgid " -I add to copy/include search path" -#~ msgstr " -I Das zum Suchpfad für Copy (COBOL) und Includes (C) hinzufügen" - -#~ msgid " -L add to library search path" -#~ msgstr " -L fügt das zum Suchpfad für Bibliotheken hinzu" - -#~ msgid " -l link the library " -#~ msgstr " -l linkt die Bibliothek " - -#~ msgid " -A add to the C compile phase" -#~ msgstr " -A fügt die zum Aufruf des C-Compilers hinzu" - -#~ msgid " -Q add to the C link phase" -#~ msgstr " -Q fügt die zum Aufruf des C-Linkers hinzu" - -#~ msgid " -D define for COBOL compilation" -#~ msgstr " -D für das Compilieren von COBOL angeben" - -#~ msgid " -K generate CALL to as static" -#~ msgstr " -K CALL zum als statischen Aufruf generieren" - -#~ msgid " -conf= user-defined dialect configuration; see -std" -#~ msgstr "" -#~ " -conf= Benutzerdefinierte Konfiguration eines COBOL-Dialektes;\n" -#~ " siehe -std" - -#~ msgid " -list-reserved display reserved words" -#~ msgstr " -list-reserved zeigt reservierte Wörter an" - -#~ msgid " -list-intrinsics display intrinsic functions" -#~ msgstr " -list-intrinsics zeigt intrinsische Funktionen an" - -#~ msgid " -list-mnemonics display mnemonic names" -#~ msgstr " -list-mnemonics zeigt mnemonische Namen an" - -#~ msgid " -list-system display system routines" -#~ msgstr " -list-system zeigt Systemroutinen an" - -#~ msgid "" -#~ " -save-temps[=] save intermediate files\n" -#~ " - default: current directory" -#~ msgstr "" -#~ " -save-temps[=] speichert temporäre Dateien\n" -#~ " Standard : aktuelles Verzeichnis" - -#, fuzzy -#~ msgid " -ext add file extension for resolving COPY" -#~ msgstr " -ext Weitere Standard-Dateiendung hinzufügen" - -#~ msgid " -W enable all warnings" -#~ msgstr " -W schaltet alle Warnungen ein" - -#~ msgid " -Wall enable most warnings (all except as noted below)" -#~ msgstr " -Wall schaltet alle Warnungen mit Ausnahmen wie folgt ein" - -#~ msgid " -Wno- disable warning enabled by -W or -Wall" -#~ msgstr " -Wno- Warnung ausschalten, die mit -W oder -Wall eingeschaltet wurde" - -#~ msgid " -Werror= treat specified as error" -#~ msgstr " -Werror= die angegebene als Fehler behandeln" - -#~ msgid "" -#~ msgstr "" - -#~ msgid "where is one of the following:" -#~ msgstr "wobei eins von diesen ist:" - -#~ msgid "word to be taken out of the reserved words list" -#~ msgstr "Wort, das aus der Liste der reservierten Wörter entfernt wird" - -#~ msgid "" -#~ msgstr "" - -#~ msgid "word to be added to reserved words list" -#~ msgstr "das Wort, das zur Liste der reservierten Wörter hinzugefügt wird" - -#~ msgid "word to be added to reserved words list as alias" -#~ msgstr "das Wort, das als Alias zur Liste der reservierten Wörter hinzugefügt wird" - -#~ msgid ":" -#~ msgstr ":" - -#~ msgid "invalid option detected" -#~ msgstr "Ungültige Option festgestellt" - -#~ msgid "unknown option ignored:\t%s" -#~ msgstr "Ungültige Option ignoriert:\t%s" - -#~ msgid "Invalid type for '%s'" -#~ msgstr "Ungültiger Typ für »%s«" - -#~ msgid "invalid type for '%s'" -#~ msgstr "Ungültiger Typ für »%s«" - -#, fuzzy -#~ msgid "constant item '%s' cannot have a %s clause" -#~ msgstr "Konstante '%s' benötigte eine %s Klausel" - -#, fuzzy -#~ msgid "define cutoff depth for IF statements" -#~ msgstr "Erzeuge berechnete goto C statements" - -#~ msgid "no transformation" -#~ msgstr "Keine Umwandlung" - -#, fuzzy -#~ msgid "initialize to picture" -#~ msgstr "Fehler bei der Initialisierung von curses" - -#, fuzzy -#~ msgid "check recursive program call" -#~ msgstr "Rekursive Programmaufrufe prüfen" - -#, fuzzy -#~ msgid "PICTURE SYMBOL for CURRENCY must be one character long" -#~ msgstr "'%s' CURSOR muss 4 oder 6 Zeichen lang sein" - -#~ msgid "invalid character '%c' in PICTURE SYMBOL for CURRENCY" -#~ msgstr "Ungültiges Zeichen »%c« in PICTURE SYMBOL für CURRENCY" - -#, fuzzy -#~ msgid "88-level cannot be used here" -#~ msgstr "Element mit Stufe 88 hier nicht zulässig" - -#~ msgid "CURRENCY SIGN other than '$'" -#~ msgstr "CURRENCY SIGN ist kein »$«" - -#~ msgid "ignoring CONVERSION" -#~ msgstr "CONVERSION wird ignoriert" - -#~ msgid "%s is not implemented" -#~ msgstr "%s ist nicht implementiert" - -#~ msgid "invalid target for DEBUGGING ALL" -#~ msgstr "Ungültiges Ziel für DEBUGGING ALL" - -#~ msgid "cannot find the UTC offset on this system" -#~ msgstr "Zeitversatz dieses Systems zur Weltzeit (UTC) kann nicht ermittelt werden" - -#, fuzzy -#~ msgid "invalid literal cast" -#~ msgstr "Ungültiger Typ für '%s'" - -#, fuzzy -#~ msgid "no definition/prototype seen for function '%s'" -#~ msgstr "Fehlende Definition von '%s'" - -#, fuzzy -#~ msgid "no definition/prototype seen for function with external name '%s'" -#~ msgstr "Fehlende Definition von '%s'" - -#~ msgid "cannot find module" -#~ msgstr "Modul kann nicht gefunden werden" - -#~ msgid "cannot find entry point" -#~ msgstr "Einstiegspunkt kann nicht gefunden werden" - -#~ msgid "libcob has version/patch level %s/%d" -#~ msgstr "libcob hat die Version/das Patchlevel %s/%d" - -#~ msgid "codegen error - Please report this!" -#~ msgstr "Fehler in codegen – Bitte melden Sie diesen Fehler" - -#~ msgid "EXTFH" -#~ msgstr "EXTFH" - -#~ msgid "BDB error: %s" -#~ msgstr "BDB-Fehler: %s" - -#~ msgid "BDB error: %s %s" -#~ msgstr "BDB-Fehler: %s %s" - -#~ msgid "cannot join BDB environment (%s), error: %d %s" -#~ msgstr "BDB-Umgebung kann nicht gestartet werden (%s), Fehler: %d %s" - -#~ msgid "problem with setenv %s: %d" -#~ msgstr "Problem mit setenv %s: %d" Binary files /tmp/tmp8r0303vl/MzBWgGBJBM/gnucobol-4.0~early~20200606/po/en@boldquot.gmo and /tmp/tmp8r0303vl/cieYbammgl/gnucobol-5/po/en@boldquot.gmo differ diff -Nru gnucobol-4.0~early~20200606/po/en@boldquot.header gnucobol-5/po/en@boldquot.header --- gnucobol-4.0~early~20200606/po/en@boldquot.header 2020-06-06 20:52:02.000000000 +0000 +++ gnucobol-5/po/en@boldquot.header 1970-01-01 00:00:00.000000000 +0000 @@ -1,25 +0,0 @@ -# All this catalog "translates" are quotation characters. -# The msgids must be ASCII and therefore cannot contain real quotation -# characters, only substitutes like grave accent (0x60), apostrophe (0x27) -# and double quote (0x22). These substitutes look strange; see -# http://www.cl.cam.ac.uk/~mgk25/ucs/quotes.html -# -# This catalog translates grave accent (0x60) and apostrophe (0x27) to -# left single quotation mark (U+2018) and right single quotation mark (U+2019). -# It also translates pairs of apostrophe (0x27) to -# left single quotation mark (U+2018) and right single quotation mark (U+2019) -# and pairs of quotation mark (0x22) to -# left double quotation mark (U+201C) and right double quotation mark (U+201D). -# -# When output to an UTF-8 terminal, the quotation characters appear perfectly. -# When output to an ISO-8859-1 terminal, the single quotation marks are -# transliterated to apostrophes (by iconv in glibc 2.2 or newer) or to -# grave/acute accent (by libiconv), and the double quotation marks are -# transliterated to 0x22. -# When output to an ASCII terminal, the single quotation marks are -# transliterated to apostrophes, and the double quotation marks are -# transliterated to 0x22. -# -# This catalog furthermore displays the text between the quotation marks in -# bold face, assuming the VT100/XTerm escape sequences. -# diff -Nru gnucobol-4.0~early~20200606/po/en@boldquot.po gnucobol-5/po/en@boldquot.po --- gnucobol-4.0~early~20200606/po/en@boldquot.po 2020-06-06 20:53:00.000000000 +0000 +++ gnucobol-5/po/en@boldquot.po 1970-01-01 00:00:00.000000000 +0000 @@ -1,5653 +0,0 @@ -# English translations for gnucobol package. -# Copyright (C) 2020 Free Software Foundation, Inc. -# This file is distributed under the same license as the gnucobol package. -# Automatically generated, 2020. -# -# All this catalog "translates" are quotation characters. -# The msgids must be ASCII and therefore cannot contain real quotation -# characters, only substitutes like grave accent (0x60), apostrophe (0x27) -# and double quote (0x22). These substitutes look strange; see -# http://www.cl.cam.ac.uk/~mgk25/ucs/quotes.html -# -# This catalog translates grave accent (0x60) and apostrophe (0x27) to -# left single quotation mark (U+2018) and right single quotation mark (U+2019). -# It also translates pairs of apostrophe (0x27) to -# left single quotation mark (U+2018) and right single quotation mark (U+2019) -# and pairs of quotation mark (0x22) to -# left double quotation mark (U+201C) and right double quotation mark (U+201D). -# -# When output to an UTF-8 terminal, the quotation characters appear perfectly. -# When output to an ISO-8859-1 terminal, the single quotation marks are -# transliterated to apostrophes (by iconv in glibc 2.2 or newer) or to -# grave/acute accent (by libiconv), and the double quotation marks are -# transliterated to 0x22. -# When output to an ASCII terminal, the single quotation marks are -# transliterated to apostrophes, and the double quotation marks are -# transliterated to 0x22. -# -# This catalog furthermore displays the text between the quotation marks in -# bold face, assuming the VT100/XTerm escape sequences. -# -msgid "" -msgstr "" -"Project-Id-Version: gnucobol 4.0-early-dev\n" -"Report-Msgid-Bugs-To: gnucobol-messages@gnu.org\n" -"POT-Creation-Date: 2020-06-06 20:52+0000\n" -"PO-Revision-Date: 2020-06-06 20:52+0000\n" -"Last-Translator: Automatically generated\n" -"Language-Team: none\n" -"Language: en@boldquot\n" -"MIME-Version: 1.0\n" -"Content-Type: text/plain; charset=UTF-8\n" -"Content-Transfer-Encoding: 8bit\n" -"Plural-Forms: nplurals=2; plural=(n != 1);\n" - -#: cobc/cobc.c:117 -#, c-format -msgid "invalid parameter: %s" -msgstr "invalid parameter: %s" - -#: cobc/cobc.c:826 -msgid "too many errors" -msgstr "too many errors" - -#: cobc/cobc.c:838 -msgid "internal compiler error" -msgstr "internal compiler error" - -#: cobc/cobc.c:904 cobc/cobc.c:991 cobc/cobc.c:1051 cobc/cobc.c:1127 -#: cobc/cobc.c:1167 cobc/cobc.c:1243 -#, c-format -msgid "cannot allocate %d bytes of memory" -msgstr "cannot allocate %d bytes of memory" - -#: cobc/cobc.c:917 cobc/cobc.c:933 cobc/cobc.c:953 cobc/cobc.c:1011 -#: cobc/cobc.c:1029 cobc/cobc.c:1147 cobc/cobc.c:1262 cobc/cobc.c:1279 -#: cobc/field.c:2008 libcob/common.c:7121 -#, c-format -msgid "call to %s with NULL pointer" -msgstr "call to %s with NULL pointer" - -#: cobc/cobc.c:974 -#, c-format -msgid "cannot reallocate %d bytes of memory" -msgstr "cannot reallocate %d bytes of memory" - -#: cobc/cobc.c:1068 cobc/cobc.c:1184 -msgid "attempt to reallocate non-allocated memory" -msgstr "attempt to reallocate non-allocated memory" - -#: cobc/cobc.c:1101 cobc/cobc.c:1217 -#, c-format -msgid "call to %s with invalid pointer, as it is missing in list" -msgstr "call to %s with invalid pointer, as it is missing in list" - -#: cobc/cobc.c:1390 -#, c-format -msgid "assuming literal for unquoted '%s'" -msgstr "assuming literal for unquoted ‘%s’" - -#: cobc/cobc.c:1437 -msgid " - length exceeds maximum" -msgstr " - length exceeds maximum" - -#: cobc/cobc.c:1441 -msgid " - name cannot be empty" -msgstr " - name cannot be empty" - -#: cobc/cobc.c:1444 -msgid " - name cannot begin with space or underscore" -msgstr " - name cannot begin with space or underscore" - -#: cobc/cobc.c:1447 -msgid " - name cannot begin with 'cob_' or 'COB_'" -msgstr " - name cannot begin with ‘cob_’ or ‘COB_’" - -#: cobc/cobc.c:1450 -msgid " - name duplicates a 'C' keyword" -msgstr " - name duplicates a ‘C’ keyword" - -#: cobc/cobc.c:1453 -msgid " - name cannot contain a directory separator" -msgstr " - name cannot contain a directory separator" - -#: cobc/cobc.c:1462 -#, c-format -msgid "invalid file base name '%s'%s" -msgstr "invalid file base name '%s'%s" - -#: cobc/cobc.c:1466 -#, c-format -msgid "invalid ENTRY '%s'%s" -msgstr "invalid ENTRY '%s'%s" - -#: cobc/cobc.c:1469 -#, c-format -msgid "invalid PROGRAM-ID '%s'%s" -msgstr "invalid PROGRAM-ID '%s'%s" - -#: cobc/cobc.c:1596 cobc/cobc.c:8151 -msgid "please check environment variables as noted above" -msgstr "please check environment variables as noted above" - -#: cobc/cobc.c:1608 cobc/error.c:254 cobc/error.c:274 cobc/error.c:505 -#: cobc/error.c:528 -msgid "error: " -msgstr "error: " - -#: cobc/cobc.c:1631 -#, c-format -msgid "duplicate DEFINE '%s' - ignored" -msgstr "duplicate DEFINE ‘%s’ - ignored" - -#: cobc/cobc.c:1683 -#, c-format -msgid "environment variable '%s' is '%s'; should not contain '%c'" -msgstr "environment variable ‘%s’ is '%s'; should not contain ‘%c’" - -#: cobc/cobc.c:1712 -msgid "parameter buffer size exceeded" -msgstr "parameter buffer size exceeded" - -#: cobc/cobc.c:1752 -#, c-format -msgid "warning: could not move temporary file to %s" -msgstr "warning: could not move temporary file to %s" - -#: cobc/cobc.c:1957 cobc/cobc.c:1960 cobc/parser.y:803 cobc/reserved.c:3807 -#: libcob/common.c:761 libcob/common.c:1805 libcob/common.c:2002 -#: libcob/common.c:6325 libcob/common.c:7495 libcob/common.c:8025 -#: libcob/common.c:8104 -msgid "unknown" -msgstr "unknown" - -#: cobc/cobc.c:1963 -#, c-format -msgid "aborting codegen for %s (%s: %s)" -msgstr "aborting codegen for %s (%s: %s)" - -#: cobc/cobc.c:1966 -#, c-format -msgid "aborting compile of %s at line %d (%s: %s)" -msgstr "aborting compile of %s at line %d (%s: %s)" - -#: cobc/cobc.c:1970 -msgid "aborting" -msgstr "aborting" - -#: cobc/cobc.c:1993 cobc/cobc.c:2028 libcob/common.c:7086 bin/cobcrun.c:342 -msgid "Please report this!" -msgstr "Please report this!" - -#: cobc/cobc.c:2046 bin/cobcrun.c:106 -msgid "License GPLv3+: GNU GPL version 3 or later " -msgstr "License GPLv3+: GNU GPL version 3 or later " - -#: cobc/cobc.c:2047 libcob/common.c:7316 bin/cobcrun.c:107 -msgid "" -"This is free software; see the source for copying conditions. There is NO\n" -"warranty; not even for MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE." -msgstr "" -"This is free software; see the source for copying conditions. There is NO\n" -"warranty; not even for MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE." - -#: cobc/cobc.c:2049 libcob/common.c:7318 bin/cobcrun.c:109 -#, c-format -msgid "Written by %s\n" -msgstr "Written by %s\n" - -#. TRANSLATORS: This msgid is indented as the "Packaged" msgid, %s expands to date and time -#: cobc/cobc.c:2050 cobc/cobc.c:2063 libcob/common.c:7321 bin/cobcrun.c:110 -#, c-format -msgid "Built %s" -msgstr "Built %s" - -#. TRANSLATORS: This msgid is indented as the "Built" msgid, %s expands to date and time -#: cobc/cobc.c:2052 cobc/cobc.c:2065 libcob/common.c:7324 bin/cobcrun.c:112 -#, c-format -msgid "Packaged %s" -msgstr "Packaged %s" - -#: cobc/cobc.c:2054 cobc/cobc.c:2067 -#, c-format -msgid "C version %s%s" -msgstr "C version %s%s" - -#: cobc/cobc.c:2080 -msgid "executing:" -msgstr "executing:" - -#: cobc/cobc.c:2082 -msgid "to be executed:" -msgstr "to be executed:" - -#: cobc/cobc.c:2120 cobc/cobc.c:2121 libcob/common.c:5815 libcob/common.c:5816 -#: libcob/common.c:5847 libcob/common.c:5848 -msgid "env" -msgstr "env" - -#: cobc/cobc.c:2156 libcob/common.c:7351 -msgid "build information" -msgstr "build information" - -#: cobc/cobc.c:2157 libcob/common.c:7352 -msgid "build environment" -msgstr "build environment" - -#: cobc/cobc.c:2167 libcob/common.c:7363 -msgid "GnuCOBOL information" -msgstr "GnuCOBOL information" - -#: cobc/cobc.c:2212 libcob/common.c:6366 libcob/common.c:7386 -#: libcob/common.c:7486 libcob/common.c:7493 -msgid "yes" -msgstr "yes" - -#: cobc/cobc.c:2214 libcob/common.c:6368 libcob/common.c:7388 -#: libcob/common.c:7488 -msgid "no" -msgstr "no" - -#: cobc/cobc.c:2218 libcob/common.c:7392 -msgid "8 bytes" -msgstr "8 bytes" - -#: cobc/cobc.c:2220 libcob/common.c:7394 -msgid "4 bytes" -msgstr "4 bytes" - -#: cobc/cobc.c:2224 cobc/cobc.c:2226 libcob/common.c:7398 libcob/common.c:7400 -msgid "endianness" -msgstr "endianness" - -#: cobc/cobc.c:2224 libcob/common.c:7398 -msgid "big-endian" -msgstr "big-endian" - -#: cobc/cobc.c:2226 libcob/common.c:7400 -msgid "little-endian" -msgstr "little-endian" - -#: cobc/cobc.c:2230 cobc/cobc.c:2232 libcob/common.c:7404 libcob/common.c:7406 -msgid "native character set" -msgstr "native character set" - -#: cobc/cobc.c:2230 libcob/common.c:7404 -msgid "EBCDIC" -msgstr "EBCDIC" - -#: cobc/cobc.c:2232 libcob/common.c:7406 -msgid "ASCII" -msgstr "ASCII" - -#: cobc/cobc.c:2235 libcob/common.c:7410 libcob/common.c:7476 -msgid "extended screen I/O" -msgstr "extended screen I/O" - -#: cobc/cobc.c:2238 libcob/common.c:7502 -msgid "variable file format" -msgstr "variable file format" - -#: cobc/cobc.c:2244 cobc/cobc.c:2246 libcob/common.c:7508 libcob/common.c:7510 -msgid "sequential file handler" -msgstr "sequential file handler" - -#: cobc/cobc.c:2246 libcob/common.c:7510 -msgid "built-in" -msgstr "built-in" - -#: cobc/cobc.c:2254 cobc/cobc.c:2260 cobc/cobc.c:2262 cobc/cobc.c:2269 -#: cobc/cobc.c:2271 cobc/cobc.c:2275 cobc/cobc.c:2278 cobc/cobc.c:2282 -#: cobc/cobc.c:2284 cobc/cobc.c:2289 cobc/cobc.c:2291 cobc/cobc.c:2298 -#: cobc/cobc.c:2300 cobc/cobc.c:2307 libcob/common.c:7516 libcob/common.c:7527 -#: libcob/common.c:7533 libcob/common.c:7535 libcob/common.c:7539 -#: libcob/common.c:7542 libcob/common.c:7546 libcob/common.c:7548 -#: libcob/common.c:7553 libcob/common.c:7555 libcob/common.c:7562 -#: libcob/common.c:7564 libcob/common.c:7571 -msgid "indexed file handler" -msgstr "indexed file handler" - -#: cobc/cobc.c:2304 libcob/common.c:7568 -msgid "default indexed handler" -msgstr "default indexed handler" - -#: cobc/cobc.c:2307 cobc/cobc.c:2319 cobc/cobc.c:2325 libcob/common.c:7381 -#: libcob/common.c:7498 libcob/common.c:7571 libcob/common.c:7611 -#: libcob/common.c:7625 -msgid "disabled" -msgstr "disabled" - -#: cobc/cobc.c:2311 cobc/cobc.c:2313 libcob/common.c:7594 libcob/common.c:7596 -msgid "mathematical library" -msgstr "mathematical library" - -#: cobc/cobc.c:2317 cobc/cobc.c:2319 libcob/common.c:7605 libcob/common.c:7611 -msgid "XML library" -msgstr "XML library" - -#: cobc/cobc.c:2323 cobc/cobc.c:2325 libcob/common.c:7623 libcob/common.c:7625 -msgid "JSON library" -msgstr "JSON library" - -#: cobc/cobc.c:2332 -msgid "only one of options 'E', 'S', 'C', 'c' may be specified" -msgstr "only one of options 'E', 'S', 'C', ‘c’ may be specified" - -#: cobc/cobc.c:2338 -msgid "only one of options 'm', 'x', 'b' may be specified" -msgstr "only one of options 'm', 'x', ‘b’ may be specified" - -#: cobc/cobc.c:2367 -#, c-format -msgid "-fdump= requires one of 'ALL', 'FD', 'WS', 'LS', 'RD', 'FD', 'SC' not '%s'" -msgstr "-fdump= requires one of 'ALL', 'FD', 'WS', 'LS', 'RD', 'FD', ‘SC’ not ‘%s’" - -#: cobc/cobc.c:2392 -#, c-format -msgid "'%s' is not an intrinsic function" -msgstr "‘%s’ is not an intrinsic function" - -#: cobc/cobc.c:2434 cobc/cobc.c:7516 cobc/cobc.c:7630 cobc/codegen.c:3796 -#: cobc/codegen.c:3905 cobc/codegen.c:5221 cobc/codegen.c:12426 cobc/tree.c:789 -#: cobc/tree.c:1221 cobc/tree.c:4101 cobc/tree.c:4648 cobc/tree.c:4891 -#: cobc/typeck.c:3294 cobc/typeck.c:7812 cobc/typeck.c:7847 cobc/typeck.c:8660 -#: cobc/typeck.c:11261 cobc/typeck.c:11329 cobc/typeck.c:11397 -#: cobc/typeck.c:11681 cobc/typeck.c:11724 -#, c-format -msgid "call to '%s' with invalid parameter '%s'" -msgstr "call to ‘%s’ with invalid parameter ‘%s’" - -#: cobc/cobc.c:2737 -msgid "loading standard configuration file 'default.conf'" -msgstr "loading standard configuration file ‘default.conf’" - -#: cobc/cobc.c:2871 -msgid "invalid output file name" -msgstr "invalid output file name" - -#: cobc/cobc.c:2971 -#, c-format -msgid "warning: '%s' is not a directory, defaulting to current directory" -msgstr "warning: ‘%s’ is not a directory, defaulting to current directory" - -#: cobc/cobc.c:2998 -#, c-format -msgid "warning: %d lines per listing page specified, using %d" -msgstr "warning: %d lines per listing page specified, using %d" - -#: cobc/cobc.c:3048 -#, c-format -msgid "warning: assuming '%s' is a DEFINE - did you intend to use -debug?" -msgstr "warning: assuming ‘%s’ is a DEFINE - did you intend to use -debug?" - -#: cobc/cobc.c:3315 -#, c-format -msgid "unknown warning option '%s'" -msgstr "unknown warning option ‘%s’" - -#: cobc/cobc.c:3367 -#, c-format -msgid "%s option requires a listing file" -msgstr "%s option requires a listing file" - -#: cobc/cobc.c:3374 -msgid "output to stdout only valid for preprocess" -msgstr "output to stdout only valid for preprocess" - -#: cobc/cobc.c:3466 -msgid "all runtime checks are enabled" -msgstr "all runtime checks are enabled" - -#: cobc/cobc.c:3572 -msgid "only one stdin input allowed" -msgstr "only one stdin input allowed" - -#: cobc/cobc.c:3582 -#, c-format -msgid "invalid file name parameter (length > %d)" -msgstr "invalid file name parameter (length > %d)" - -#: cobc/cobc.c:3807 -msgid "nothing for -j to run" -msgstr "nothing for -j to run" - -#: cobc/cobc.c:3883 cobc/cobc.c:4071 cobc/cobc.c:4130 cobc/cobc.c:4158 -#: cobc/cobc.c:4247 cobc/cobc.c:4306 cobc/cobc.c:4430 cobc/cobc.c:4469 -#: cobc/cobc.c:6993 -msgid "return status:" -msgstr "return status:" - -#: cobc/cobc.c:4361 -msgid "preprocessing:" -msgstr "preprocessing:" - -#: cobc/cobc.c:4435 -msgid "'cobxref' execution unsuccessful" -msgstr "‘cobxref’ execution unsuccessful" - -#: cobc/cobc.c:4438 -#, c-format -msgid "check that 'cobxref' is in %s" -msgstr "check that ‘cobxref’ is in %s" - -#: cobc/cobc.c:4440 -msgid "no listing produced" -msgstr "no listing produced" - -#: cobc/cobc.c:5328 cobc/cobc.c:5367 -msgid "No fields defined." -msgstr "No fields defined." - -#: cobc/cobc.c:5387 -msgid "No labels defined." -msgstr "No labels defined." - -#: cobc/cobc.c:5409 -msgid "Error/Warning summary:" -msgstr "Error/Warning summary:" - -#: cobc/cobc.c:5453 -msgid "0 warnings in compilation group" -msgstr "0 warnings in compilation group" - -#: cobc/cobc.c:5457 -msgid "1 warning in compilation group" -msgstr "1 warning in compilation group" - -#: cobc/cobc.c:5461 -#, c-format -msgid "%d warnings in compilation group" -msgstr "%d warnings in compilation group" - -#: cobc/cobc.c:5467 -msgid "0 errors in compilation group" -msgstr "0 errors in compilation group" - -#: cobc/cobc.c:5471 -msgid "1 error in compilation group" -msgstr "1 error in compilation group" - -#: cobc/cobc.c:5475 -#, c-format -msgid "%d errors in compilation group" -msgstr "%d errors in compilation group" - -#: cobc/cobc.c:5481 -#, c-format -msgid "Too many errors in compilation group: %d maximum errors" -msgstr "Too many errors in compilation group: %d maximum errors" - -#: cobc/cobc.c:6050 -#, c-format -msgid "%s: %d: Too many continuation lines" -msgstr "%s: %d: Too many continuation lines" - -#: cobc/cobc.c:6972 -msgid "parsing:" -msgstr "parsing:" - -#: cobc/cobc.c:7034 -msgid "translating:" -msgstr "translating:" - -#: cobc/cobc.c:8157 -msgid "no input files" -msgstr "no input files" - -#: cobc/cobc.c:8186 -#, c-format -msgid "%s option invalid in this combination" -msgstr "%s option invalid in this combination" - -#: cobc/cobc.c:8227 -msgid "command line:" -msgstr "command line:" - -#: cobc/codegen.c:973 cobc/codegen.c:4487 cobc/codegen.c:11093 -msgid "unexpected CONSTANT item" -msgstr "unexpected CONSTANT item" - -#: cobc/codegen.c:1188 cobc/codegen.c:1196 cobc/codegen.c:1291 -#: cobc/codegen.c:1603 cobc/codegen.c:2202 cobc/codegen.c:3212 -#: cobc/codegen.c:3455 cobc/codegen.c:3988 cobc/codegen.c:4454 -#: cobc/codegen.c:7902 cobc/codegen.c:8507 cobc/codegen.c:10298 -#: cobc/field.c:817 cobc/scanner.l:2104 cobc/tree.c:611 cobc/tree.c:3728 -#: cobc/typeck.c:5015 cobc/typeck.c:8662 cobc/typeck.c:9657 -#, c-format -msgid "unexpected tree tag: %d" -msgstr "unexpected tree tag: %d" - -#: cobc/codegen.c:2999 cobc/codegen.c:3295 cobc/codegen.c:8125 cobc/tree.c:1243 -#, c-format -msgid "unexpected cast type: %d" -msgstr "unexpected cast type: %d" - -#: cobc/codegen.c:3725 cobc/codegen.c:4434 -#, c-format -msgid "internal statement stack depth exceeded: %d" -msgstr "internal statement stack depth exceeded: %d" - -#: cobc/codegen.c:3798 -#, c-format -msgid "%s is not a field" -msgstr "%s is not a field" - -#: cobc/codegen.c:4186 cobc/codegen.c:4279 -#, c-format -msgid "unexpected function: %s" -msgstr "unexpected function: %s" - -#: cobc/codegen.c:4270 -#, c-format -msgid "unexpected operator: %c" -msgstr "unexpected operator: %c" - -#: cobc/codegen.c:5043 -#, c-format -msgid "unexpected tree category: %d" -msgstr "unexpected tree category: %d" - -#: cobc/codegen.c:5438 cobc/codegen.c:5465 cobc/codegen.c:5662 -#: cobc/codegen.c:5694 -#, c-format -msgid "unexpected size: %d" -msgstr "unexpected size: %d" - -#: cobc/codegen.c:7254 -#, c-format -msgid "No ENTRY FOR GO TO '%s'" -msgstr "No ENTRY FOR GO TO ‘%s’" - -#: cobc/codegen.c:7475 cobc/codegen.c:7725 -#, c-format -msgid "unexpected handler type: %d" -msgstr "unexpected handler type: %d" - -#: cobc/codegen.c:7823 -msgid "unexpected error_node parameter" -msgstr "unexpected error_node parameter" - -#: cobc/codegen.c:8146 -#, c-format -msgid "unexpected tree type: %d" -msgstr "unexpected tree type: %d" - -#: cobc/codegen.c:8703 cobc/typeck.c:6511 cobc/typeck.c:12940 -#: cobc/typeck.c:12984 -#, c-format -msgid "compiler is not configured to support %s" -msgstr "compiler is not configured to support %s" - -#: cobc/codegen.c:9128 -msgid "Nested OCCURS in report" -msgstr "Nested OCCURS in report" - -#: cobc/codeoptim.c:2762 -#, c-format -msgid "unexpected optimization value: %d" -msgstr "unexpected optimization value: %d" - -#: cobc/config.c:162 libcob/common.c:6786 libcob/common.c:6800 -#: libcob/common.c:7242 -#, c-format -msgid "invalid value '%s' for configuration tag '%s'" -msgstr "invalid value ‘%s’ for configuration tag ‘%s’" - -#: cobc/config.c:165 libcob/common.c:6093 libcob/common.c:6209 -#, c-format -msgid "should be one of the following values: %s" -msgstr "should be one of the following values: %s" - -#: cobc/config.c:167 -msgid "must be numeric" -msgstr "must be numeric" - -#: cobc/config.c:169 libcob/common.c:6191 -#, c-format -msgid "maximum value: %lu" -msgstr "maximum value: %lu" - -#: cobc/config.c:171 -#, c-format -msgid "minimum value: %d" -msgstr "minimum value: %d" - -#: cobc/config.c:203 -#, c-format -msgid "unsupported value '%s' for configuration tag '%s'" -msgstr "unsupported value ‘%s’ for configuration tag ‘%s’" - -#: cobc/config.c:311 cobc/pplex.l:977 libcob/common.c:6702 -msgid "recursive inclusion" -msgstr "recursive inclusion" - -#: cobc/config.c:386 libcob/common.c:6753 -msgid "configuration file was included here" -msgstr "configuration file was included here" - -#: cobc/config.c:415 -#, c-format -msgid "The previous loaded configuration '%s' will be discarded." -msgstr "The previous loaded configuration ‘%s’ will be discarded." - -#: cobc/config.c:449 -msgid "missing definitions:" -msgstr "missing definitions:" - -#: cobc/config.c:451 -#, c-format -msgid "\tno definition of '%s'" -msgstr "\tno definition of ‘%s’" - -#: cobc/config.c:512 -#, c-format -msgid "invalid configuration tag '%s'" -msgstr "invalid configuration tag ‘%s’" - -#: cobc/config.c:525 libcob/common.c:6509 libcob/common.c:6592 -#: libcob/common.c:6620 -#, c-format -msgid "unknown configuration tag '%s'" -msgstr "unknown configuration tag ‘%s’" - -#: cobc/config.c:549 -#, c-format -msgid "invalid configuration tag '%s' in word-list" -msgstr "invalid configuration tag ‘%s’ in word-list" - -#: cobc/config.c:608 -#, c-format -msgid "Could not access word list for '%s'" -msgstr "Could not access word list for ‘%s’" - -#: cobc/error.c:87 -#, c-format -msgid "in section '%s':" -msgstr "in section '%s':" - -#: cobc/error.c:98 -#, c-format -msgid "in paragraph '%s':" -msgstr "in paragraph '%s':" - -#: cobc/error.c:121 libcob/common.c:7252 -msgid "configuration error:" -msgstr "configuration error:" - -#: cobc/error.c:134 libcob/common.c:673 -#, c-format -msgid "system error %d" -msgstr "system error %d" - -#: cobc/error.c:231 cobc/error.c:323 cobc/error.c:478 -msgid "error [-Werror]: " -msgstr "error [-Werror]: " - -#: cobc/error.c:231 cobc/error.c:323 cobc/error.c:478 cobc/error.c:505 -#: libcob/common.c:6881 libcob/common.c:6906 -#, c-format -msgid "warning: " -msgstr "warning: " - -#: cobc/error.c:274 cobc/error.c:528 -msgid "error (ignored): " -msgstr "error (ignored): " - -#: cobc/error.c:364 cobc/error.c:380 cobc/error.c:563 cobc/error.c:584 -#, c-format -msgid "%s used" -msgstr "%s used" - -#: cobc/error.c:367 cobc/error.c:566 -#, c-format -msgid "%s is archaic in %s" -msgstr "%s is archaic in %s" - -#: cobc/error.c:371 cobc/error.c:570 -#, c-format -msgid "%s is obsolete in %s" -msgstr "%s is obsolete in %s" - -#: cobc/error.c:377 cobc/error.c:576 cobc/parser.y:5186 cobc/parser.y:5325 -#, c-format -msgid "%s ignored" -msgstr "%s ignored" - -#: cobc/error.c:383 cobc/error.c:586 -#, c-format -msgid "%s does not conform to %s" -msgstr "%s does not conform to %s" - -#: cobc/error.c:399 -msgid "configuration warning:" -msgstr "configuration warning:" - -#: cobc/error.c:621 cobc/error.c:640 -#, c-format -msgid "redefinition of '%s'" -msgstr "redefinition of ‘%s’" - -#: cobc/error.c:628 cobc/error.c:653 -#, c-format -msgid "'%s' previously defined here" -msgstr "‘%s’ previously defined here" - -#: cobc/error.c:677 cobc/error.c:684 -#, c-format -msgid "'%s' is not defined" -msgstr "‘%s’ is not defined" - -#: cobc/error.c:680 -#, c-format -msgid "'%s' cannot be used here" -msgstr "‘%s’ cannot be used here" - -#: cobc/error.c:682 cobc/parser.y:7009 -#, c-format -msgid "'%s' is not defined, but is a reserved word in another dialect" -msgstr "‘%s’ is not defined, but is a reserved word in another dialect" - -#: cobc/error.c:716 -#, c-format -msgid "'%s' is ambiguous; needs qualification" -msgstr "‘%s’ is ambiguous; needs qualification" - -#: cobc/error.c:746 cobc/parser.y:16748 -#, c-format -msgid "'%s' defined here" -msgstr "‘%s’ defined here" - -#: cobc/error.c:757 -#, c-format -msgid "fatal error: %s" -msgstr "fatal error: %s" - -#: cobc/error.c:765 -#, c-format -msgid "group item '%s' cannot have %s clause" -msgstr "group item ‘%s’ cannot have %s clause" - -#: cobc/error.c:779 -#, c-format -msgid "constant item '%s' requires a %s clause" -msgstr "constant item ‘%s’ requires a %s clause" - -#: cobc/error.c:781 -#, c-format -msgid "level %02d item '%s' requires a %s clause" -msgstr "level %02d item ‘%s’ requires a %s clause" - -#: cobc/error.c:795 -#, c-format -msgid "constant item '%s' can only have a %s clause" -msgstr "constant item ‘%s’ can only have a %s clause" - -#: cobc/error.c:797 -#, c-format -msgid "level %02d item '%s' can only have a %s clause" -msgstr "level %02d item ‘%s’ can only have a %s clause" - -#: cobc/field.c:131 -msgid "constant expression has Divide by ZERO" -msgstr "constant expression has Divide by ZERO" - -#: cobc/field.c:187 cobc/field.c:324 cobc/field.c:332 -msgid "missing right parenthesis" -msgstr "missing right parenthesis" - -#: cobc/field.c:216 -#, c-format -msgid "expression stack overflow at %d entries for operation '%c'" -msgstr "expression stack overflow at %d entries for operation ‘%c’" - -#: cobc/field.c:257 -#, c-format -msgid "expression stack overflow at %d entries" -msgstr "expression stack overflow at %d entries" - -#: cobc/field.c:274 -msgid "missing left parenthesis" -msgstr "missing left parenthesis" - -#: cobc/field.c:315 -#, c-format -msgid "invalid operator '%s' in expression" -msgstr "invalid operator ‘%s’ in expression" - -#: cobc/field.c:334 -#, c-format -msgid "'%c' operator misplaced" -msgstr "‘%c’ operator misplaced" - -#: cobc/field.c:395 -#, c-format -msgid "invalid level number '%s'" -msgstr "invalid level number ‘%s’" - -#: cobc/field.c:454 -msgid "entry following SAME AS may not be subordinate to it" -msgstr "entry following SAME AS may not be subordinate to it" - -#: cobc/field.c:459 cobc/field.c:496 -msgid "level number must begin with 01 or 77" -msgstr "level number must begin with 01 or 77" - -#: cobc/field.c:541 cobc/field.c:557 -#, c-format -msgid "no previous data item of level %02d" -msgstr "no previous data item of level %02d" - -#: cobc/field.c:599 -#, c-format -msgid "'%s' cannot be qualified here" -msgstr "‘%s’ cannot be qualified here" - -#: cobc/field.c:605 -#, c-format -msgid "'%s' cannot be subscripted here" -msgstr "‘%s’ cannot be subscripted here" - -#: cobc/field.c:617 -#, c-format -msgid "'%s' is not defined in '%s'" -msgstr "‘%s’ is not defined in ‘%s’" - -#: cobc/field.c:638 -msgid "level number of REDEFINES entries must be identical" -msgstr "level number of REDEFINES entries must be identical" - -#: cobc/field.c:643 -#, c-format -msgid "'%s' is not the original definition" -msgstr "‘%s’ is not the original definition" - -#: cobc/field.c:758 -#, c-format -msgid "PICTURE clause not compatible with USAGE %s" -msgstr "PICTURE clause not compatible with USAGE %s" - -#: cobc/field.c:855 cobc/field.c:930 cobc/field.c:941 -#, c-format -msgid "PICTURE clause required for '%s'" -msgstr "PICTURE clause required for ‘%s’" - -#: cobc/field.c:937 -#, c-format -msgid "a non-numeric literal is expected for '%s'" -msgstr "a non-numeric literal is expected for ‘%s’" - -#: cobc/field.c:949 -#, c-format -msgid "defining implicit picture size %d for '%s'" -msgstr "defining implicit picture size %d for ‘%s’" - -#: cobc/field.c:969 -#, c-format -msgid "'%s' ANY LENGTH only allowed in LINKAGE" -msgstr "‘%s’ ANY LENGTH only allowed in LINKAGE" - -#: cobc/field.c:973 -#, c-format -msgid "'%s' ANY LENGTH must be 01 level" -msgstr "‘%s’ ANY LENGTH must be 01 level" - -#: cobc/field.c:977 -#, c-format -msgid "'%s' ANY LENGTH cannot be BASED/EXTERNAL" -msgstr "‘%s’ ANY LENGTH cannot be BASED/EXTERNAL" - -#: cobc/field.c:982 cobc/field.c:1010 -#, c-format -msgid "'%s' ANY LENGTH has invalid definition" -msgstr "‘%s’ ANY LENGTH has invalid definition" - -#: cobc/field.c:993 -#, c-format -msgid "'%s' ANY NUMERIC must be PIC 9" -msgstr "‘%s’ ANY NUMERIC must be PIC 9" - -#: cobc/field.c:998 -#, c-format -msgid "'%s' ANY LENGTH must be PIC X or PIC N" -msgstr "‘%s’ ANY LENGTH must be PIC X or PIC N" - -#: cobc/field.c:1008 -#, c-format -msgid "'%s' ANY NUMERIC has invalid definition" -msgstr "‘%s’ ANY NUMERIC has invalid definition" - -#: cobc/field.c:1026 -#, c-format -msgid "'%s' EXTERNAL must be specified at 01/77 level" -msgstr "‘%s’ EXTERNAL must be specified at 01/77 level" - -#: cobc/field.c:1030 -#, c-format -msgid "'%s' EXTERNAL can only be specified in WORKING-STORAGE section" -msgstr "‘%s’ EXTERNAL can only be specified in WORKING-STORAGE section" - -#: cobc/field.c:1034 -#, c-format -msgid "'%s' EXTERNAL and BASED are mutually exclusive" -msgstr "‘%s’ EXTERNAL and BASED are mutually exclusive" - -#: cobc/field.c:1037 -#, c-format -msgid "'%s' EXTERNAL not allowed with REDEFINES" -msgstr "‘%s’ EXTERNAL not allowed with REDEFINES" - -#: cobc/field.c:1049 -#, c-format -msgid "'%s' BASED not allowed here" -msgstr "‘%s’ BASED not allowed here" - -#: cobc/field.c:1052 -#, c-format -msgid "'%s' BASED not allowed with REDEFINES" -msgstr "‘%s’ BASED not allowed with REDEFINES" - -#: cobc/field.c:1055 -#, c-format -msgid "'%s' BASED only allowed at the 01 and 77 levels" -msgstr "‘%s’ BASED only allowed at the 01 and 77 levels" - -#: cobc/field.c:1067 -#, c-format -msgid "level %02d item '%s' cannot have a %s clause" -msgstr "level %02d item ‘%s’ cannot have a %s clause" - -#: cobc/field.c:1082 -#, c-format -msgid "'%s' cannot have the OCCURS clause due to '%s'" -msgstr "‘%s’ cannot have the OCCURS clause due to ‘%s’" - -#: cobc/field.c:1101 -#, c-format -msgid "the original definition '%s' should not have OCCURS clause" -msgstr "the original definition ‘%s’ should not have OCCURS clause" - -#: cobc/field.c:1108 -msgid "REDEFINES must follow the original definition" -msgstr "REDEFINES must follow the original definition" - -#: cobc/field.c:1115 -#, c-format -msgid "'%s' cannot be variable length" -msgstr "‘%s’ cannot be variable length" - -#: cobc/field.c:1118 -#, c-format -msgid "the original definition '%s' cannot be variable length" -msgstr "the original definition ‘%s’ cannot be variable length" - -#: cobc/field.c:1142 -#, c-format -msgid "SCREEN group item '%s' has invalid clause" -msgstr "SCREEN group item ‘%s’ has invalid clause" - -#: cobc/field.c:1223 -#, c-format -msgid "%s USAGE %s incompatible with %s USAGE %s" -msgstr "%s USAGE %s incompatible with %s USAGE %s" - -#: cobc/field.c:1302 -#, c-format -msgid "'%s' cannot have PICTURE clause" -msgstr "‘%s’ cannot have PICTURE clause" - -#: cobc/field.c:1318 cobc/field.c:1328 -#, c-format -msgid "%s item '%s' should be USAGE DISPLAY" -msgstr "%s item ‘%s’ should be USAGE DISPLAY" - -#: cobc/field.c:1351 -#, c-format -msgid "'%s' COMP-6 with sign - changing to COMP-3" -msgstr "‘%s’ COMP-6 with sign - changing to COMP-3" - -#: cobc/field.c:1377 -msgid "elementary items with SIGN clause must have S in PICTURE" -msgstr "elementary items with SIGN clause must have S in PICTURE" - -#: cobc/field.c:1380 -msgid "elementary items with SIGN clause must be USAGE DISPLAY or NATIONAL" -msgstr "elementary items with SIGN clause must be USAGE DISPLAY or NATIONAL" - -#: cobc/field.c:1397 -#, c-format -msgid "'%s' cannot have JUSTIFIED RIGHT" -msgstr "‘%s’ cannot have JUSTIFIED RIGHT" - -#: cobc/field.c:1410 -#, c-format -msgid "'%s' cannot have S in PICTURE string and BLANK WHEN ZERO" -msgstr "‘%s’ cannot have S in PICTURE string and BLANK WHEN ZERO" - -#: cobc/field.c:1415 -#, c-format -msgid "'%s' cannot have BLANK WHEN ZERO without being USAGE DISPLAY or NATIONAL" -msgstr "‘%s’ cannot have BLANK WHEN ZERO without being USAGE DISPLAY or NATIONAL" - -#: cobc/field.c:1426 -#, c-format -msgid "'%s' cannot have * in PICTURE string and BLANK WHEN ZERO" -msgstr "‘%s’ cannot have * in PICTURE string and BLANK WHEN ZERO" - -#: cobc/field.c:1433 -#, c-format -msgid "'%s' is not numeric, so cannot have BLANK WHEN ZERO" -msgstr "‘%s’ is not numeric, so cannot have BLANK WHEN ZERO" - -#: cobc/field.c:1446 -msgid "only level 88 items may have multiple values" -msgstr "only level 88 items may have multiple values" - -#: cobc/field.c:1454 cobc/field.c:1458 -#, c-format -msgid "initial VALUE clause ignored for %s item '%s'" -msgstr "initial VALUE clause ignored for %s item ‘%s’" - -#: cobc/field.c:1471 -msgid "FULL has no effect on numeric items; you may want REQUIRED or PIC Z" -msgstr "FULL has no effect on numeric items; you may want REQUIRED or PIC Z" - -#: cobc/field.c:1499 -msgid "VALUE may not contain a figurative constant" -msgstr "VALUE may not contain a figurative constant" - -#: cobc/field.c:1507 -msgid "cannot specify both FULL and JUSTIFIED" -msgstr "cannot specify both FULL and JUSTIFIED" - -#: cobc/field.c:1519 -#, c-format -msgid "'%s' has FROM, TO or USING without PIC; PIC will be implied" -msgstr "‘%s’ has FROM, TO or USING without PIC; PIC will be implied" - -#: cobc/field.c:1533 -#, c-format -msgid "'%s' has numeric VALUE without PIC; PIC will be implied" -msgstr "‘%s’ has numeric VALUE without PIC; PIC will be implied" - -#: cobc/field.c:1548 -#, c-format -msgid "'%s' cannot have PIC without FROM, TO, USING or numeric VALUE" -msgstr "‘%s’ cannot have PIC without FROM, TO, USING or numeric VALUE" - -#: cobc/field.c:1560 -#, c-format -msgid "'%s' needs a PIC, FROM, TO, USING, VALUE, BELL, BLANK or ERASE clause" -msgstr "‘%s’ needs a PIC, FROM, TO, USING, VALUE, BELL, BLANK or ERASE clause" - -#: cobc/field.c:1574 -msgid "cannot specify both PIC and VALUE" -msgstr "cannot specify both PIC and VALUE" - -#: cobc/field.c:1582 -msgid "cannot have PIC without FROM, TO or USING" -msgstr "cannot have PIC without FROM, TO or USING" - -#: cobc/field.c:1591 -msgid "cannot have FROM, TO or USING without PIC" -msgstr "cannot have FROM, TO or USING without PIC" - -#: cobc/field.c:1600 -msgid "VALUE item may not be numeric" -msgstr "VALUE item may not be numeric" - -#: cobc/field.c:1616 -#, c-format -msgid "'%s' needs a PIC, COL, LINE, VALUE, BELL or BLANK clause" -msgstr "‘%s’ needs a PIC, COL, LINE, VALUE, BELL or BLANK clause" - -#: cobc/field.c:1647 -msgid "cannot use AUTO, FULL, PROMPT, REQUIRED or SECURE on elementary item without TO or USING" -msgstr "cannot use AUTO, FULL, PROMPT, REQUIRED or SECURE on elementary item without TO or USING" - -#: cobc/field.c:1654 -msgid "cannot use BLANK WHEN ZERO, JUSTIFIED, OCCURS or SIGN on item without FROM, TO or USING" -msgstr "cannot use BLANK WHEN ZERO, JUSTIFIED, OCCURS or SIGN on item without FROM, TO or USING" - -#: cobc/field.c:1674 -msgid "cannot use AUTO, FULL, REQUIRED or SECURE on elementary item without FROM, TO or USING" -msgstr "cannot use AUTO, FULL, REQUIRED or SECURE on elementary item without FROM, TO or USING" - -#: cobc/field.c:1679 -msgid "cannot use BLANK WHEN ZERO, JUSTIFIED or SIGN without FROM, TO or USING" -msgstr "cannot use BLANK WHEN ZERO, JUSTIFIED or SIGN without FROM, TO or USING" - -#: cobc/field.c:1697 -msgid "cannot have BLANK WHEN ZERO without PIC" -msgstr "cannot have BLANK WHEN ZERO without PIC" - -#: cobc/field.c:1700 -msgid "cannot have JUSTIFIED without PIC" -msgstr "cannot have JUSTIFIED without PIC" - -#: cobc/field.c:1720 -msgid "cannot have AUTO without FROM, TO or USING" -msgstr "cannot have AUTO without FROM, TO or USING" - -#: cobc/field.c:1725 -msgid "cannot use FULL or REQUIRED on item without TO or USING" -msgstr "cannot use FULL or REQUIRED on item without TO or USING" - -#: cobc/field.c:1732 -msgid "SECURE can be used with TO only" -msgstr "SECURE can be used with TO only" - -#: cobc/field.c:1734 -msgid "SECURE must be used with TO" -msgstr "SECURE must be used with TO" - -#: cobc/field.c:1753 -#, c-format -msgid "'%s' does nothing" -msgstr "‘%s’ does nothing" - -#: cobc/field.c:1797 -msgid "BLANK ZERO not compatible with USAGE" -msgstr "BLANK ZERO not compatible with USAGE" - -#: cobc/field.c:1800 -msgid "SIGN clause not compatible with USAGE" -msgstr "SIGN clause not compatible with USAGE" - -#: cobc/field.c:1977 -#, c-format -msgid "'%s' PICTURE clause not compatible with USAGE" -msgstr "‘%s’ PICTURE clause not compatible with USAGE" - -#: cobc/field.c:2027 -#, c-format -msgid "'%s' 77 level is not allowed here" -msgstr "‘%s’ 77 level is not allowed here" - -#: cobc/field.c:2424 -msgid "OCCURS and multi COLUMNs is not allowed" -msgstr "OCCURS and multi COLUMNs is not allowed" - -#: cobc/field.c:2452 -#, c-format -msgid "duplicate LINE %d ignored" -msgstr "duplicate LINE %d ignored" - -#: cobc/field.c:2469 -#, c-format -msgid "ignoring SYNCHRONIZED for group item '%s'" -msgstr "ignoring SYNCHRONIZED for group item ‘%s’" - -#: cobc/field.c:2485 cobc/field.c:2498 cobc/field.c:2778 cobc/field.c:2781 -#, c-format -msgid "size of '%s' larger than size of '%s'" -msgstr "size of ‘%s’ larger than size of ‘%s’" - -#: cobc/field.c:2638 cobc/field.c:2703 -#, c-format -msgid "'%s' cannot be larger than %d bytes" -msgstr "‘%s’ cannot be larger than %d bytes" - -#: cobc/field.c:2676 cobc/field.c:2684 -#, c-format -msgid "'%s' binary field cannot be larger than %d digits" -msgstr "‘%s’ binary field cannot be larger than %d digits" - -#: cobc/field.c:2764 cobc/field.c:3216 -#, c-format -msgid "unexpected USAGE: %d" -msgstr "unexpected USAGE: %d" - -#: cobc/field.c:2876 -msgid "literal type does not match numeric data type" -msgstr "literal type does not match numeric data type" - -#: cobc/field.c:2953 -#, c-format -msgid "THRU item '%s' may not come before '%s'" -msgstr "THRU item ‘%s’ may not come before ‘%s’" - -#: cobc/field.c:2976 -#, c-format -msgid "RENAMES cannot start/end at the OCCURS item '%s'" -msgstr "RENAMES cannot start/end at the OCCURS item ‘%s’" - -#: cobc/field.c:2984 -#, c-format -msgid "cannot use RENAMES on part of the table '%s'" -msgstr "cannot use RENAMES on part of the table ‘%s’" - -#: cobc/field.c:3022 -#, c-format -msgid "RENAMES may not contain '%s' as it is a pointer or object reference" -msgstr "RENAMES may not contain ‘%s’ as it is a pointer or object reference" - -#: cobc/field.c:3027 -#, c-format -msgid "RENAMES may not contain '%s' as it is an OCCURS DEPENDING table" -msgstr "RENAMES may not contain ‘%s’ as it is an OCCURS DEPENDING table" - -#: cobc/field.c:3049 -msgid "RENAMES of 01-, 66- and 77-level items" -msgstr "RENAMES of 01-, 66- and 77-level items" - -#: cobc/field.c:3051 -msgid "RENAMES may not reference a level 88" -msgstr "RENAMES may not reference a level 88" - -#: cobc/field.c:3075 -#, c-format -msgid "'%s' must immediately follow the record '%s'" -msgstr "‘%s’ must immediately follow the record ‘%s’" - -#: cobc/field.c:3083 -#, c-format -msgid "THRU item must be different to '%s'" -msgstr "THRU item must be different to ‘%s’" - -#: cobc/field.c:3089 -#, c-format -msgid "'%s' and '%s' must be in the same record" -msgstr "‘%s’ and ‘%s’ must be in the same record" - -#: cobc/field.c:3100 -#, c-format -msgid "THRU item '%s' may not be subordinate to '%s'" -msgstr "THRU item ‘%s’ may not be subordinate to ‘%s’" - -#: cobc/flag.def:40 -msgid "" -" -fstack-size=\tdefine PERFORM stack size\n" -" * default: 255" -msgstr "" -" -fstack-size=\tdefine PERFORM stack size\n" -" * default: 255" - -#: cobc/flag.def:44 -msgid "" -" -fsign=[ASCII|EBCDIC]\tdefine display sign representation\n" -" * default: machine native" -msgstr "" -" -fsign=[ASCII|EBCDIC]\tdefine display sign representation\n" -" * default: machine native" - -#: cobc/flag.def:48 -msgid "" -" -ffold-copy=[UPPER|LOWER]\tfold COPY subject to value\n" -" * default: no transformation" -msgstr "" -" -ffold-copy=[UPPER|LOWER]\tfold COPY subject to value\n" -" * default: no transformation" - -#: cobc/flag.def:52 -msgid "" -" -ffold-call=[UPPER|LOWER]\tfold PROGRAM-ID, CALL, CANCEL subject to value\n" -" * default: no transformation" -msgstr "" -" -ffold-call=[UPPER|LOWER]\tfold PROGRAM-ID, CALL, CANCEL subject to value\n" -" * default: no transformation" - -#: cobc/flag.def:56 -msgid "" -" -fdefaultbyte=\tinitialize fields without VALUE to value\n" -" * decimal 0..255 or any quoted character\n" -" * default: initialize to picture" -msgstr "" -" -fdefaultbyte=\tinitialize fields without VALUE to value\n" -" * decimal 0..255 or any quoted character\n" -" * default: initialize to picture" - -#: cobc/flag.def:61 -msgid "" -" -fmax-errors=\tmaximum number of errors to report before\n" -" compilation is aborted\n" -" * default: 128" -msgstr "" -" -fmax-errors=\tmaximum number of errors to report before\n" -" compilation is aborted\n" -" * default: 128" - -#: cobc/flag.def:68 -msgid "" -" -fintrinsics=[ALL|intrinsic function name(,name,...)]\n" -" intrinsics to be used without FUNCTION keyword" -msgstr "" -" -fintrinsics=[ALL|intrinsic function name(,name,...)]\n" -" intrinsics to be used without FUNCTION keyword" - -#: cobc/flag.def:72 -msgid "" -" -fdump= dump data fields on abort, may be\n" -" a combination of: ALL, WS, LS, RD, FD, SC" -msgstr "" -" -fdump= dump data fields on abort, may be\n" -" a combination of: ALL, WS, LS, RD, FD, SC" - -#: cobc/flag.def:76 -msgid "" -" -fcallfh= use external provided EXTFH interface module\n" -" for I/O" -msgstr "" -" -fcallfh= use external provided EXTFH interface module\n" -" for I/O" - -#: cobc/flag.def:80 -msgid "" -" -fsqldb= which Database is used, may be\n" -" MySQL, MSSQL, Oracle10, Oracle11, Oracle12" -msgstr "" -" -fsqldb= which Database is used, may be\n" -" MySQL, MSSQL, Oracle10, Oracle11, Oracle12" - -#: cobc/flag.def:84 -msgid " -fsqlschema= define database schema name" -msgstr " -fsqlschema= define database schema name" - -#: cobc/flag.def:91 -msgid "" -" -fno-recursive-check disable check of recursive program call;\n" -" effectively compiling as RECURSIVE program" -msgstr "" -" -fno-recursive-check disable check of recursive program call;\n" -" effectively compiling as RECURSIVE program" - -#: cobc/flag.def:95 -msgid "" -" -fwinmain generate WinMain instead of main when compiling\n" -" as executable" -msgstr "" -" -fwinmain generate WinMain instead of main when compiling\n" -" as executable" - -#: cobc/flag.def:99 -msgid " -fcomputed-goto generate computed goto C statements" -msgstr " -fcomputed-goto generate computed goto C statements" - -#: cobc/flag.def:102 -msgid " -falternate-ebcdic use restricted ASCII to EBCDIC translate" -msgstr " -falternate-ebcdic use restricted ASCII to EBCDIC translate" - -#: cobc/flag.def:105 -msgid " -fextra-brace generate extra braces in C source" -msgstr " -fextra-brace generate extra braces in C source" - -#: cobc/flag.def:108 -msgid " -fgen-c-line-directives\tgenerate source location directives in C code" -msgstr " -fgen-c-line-directives\tgenerate source location directives in C code" - -#: cobc/flag.def:111 -msgid " -fgen-c-labels generate extra labels in C sources" -msgstr " -fgen-c-labels generate extra labels in C sources" - -#: cobc/flag.def:114 -msgid " -fcorrect-numeric attempt correction of invalid numeric display items" -msgstr " -fcorrect-numeric attempt correction of invalid numeric display items" - -#: cobc/flag.def:117 -msgid " -fstack-on-heap PERFORM stack allocated on heap" -msgstr " -fstack-on-heap PERFORM stack allocated on heap" - -#: cobc/flag.def:120 -msgid " -ffast-math Disables emitting faster arithmetic logic" -msgstr " -ffast-math Disables emitting faster arithmetic logic" - -#: cobc/flag.def:125 -msgid "" -" -fno-remove-unreachable\tdisable remove of unreachable code\n" -" * turned off by -g" -msgstr "" -" -fno-remove-unreachable\tdisable remove of unreachable code\n" -" * turned off by -g" - -#: cobc/flag.def:129 -msgid " -finline-intrinsic\twhen possible resolve intrinsic FUNCTIONs at compile time" -msgstr " -finline-intrinsic\twhen possible resolve intrinsic FUNCTIONs at compile time" - -#: cobc/flag.def:132 -msgid "" -" -ftrace generate trace code\n" -" * scope: executed SECTION/PARAGRAPH" -msgstr "" -" -ftrace generate trace code\n" -" * scope: executed SECTION/PARAGRAPH" - -#: cobc/flag.def:136 -msgid "" -" -ftraceall generate trace code\n" -" * scope: executed SECTION/PARAGRAPH/STATEMENTS\n" -" * turned on by -debug" -msgstr "" -" -ftraceall generate trace code\n" -" * scope: executed SECTION/PARAGRAPH/STATEMENTS\n" -" * turned on by -debug" - -#: cobc/flag.def:141 -msgid " -fsyntax-only syntax error checking only; don't emit any output" -msgstr " -fsyntax-only syntax error checking only; don't emit any output" - -#: cobc/flag.def:144 -msgid "" -" -fdebugging-line enable debugging lines\n" -" * 'D' in indicator column or floating >>D" -msgstr "" -" -fdebugging-line enable debugging lines\n" -" * ‘D’ in indicator column or floating >>D" - -#: cobc/flag.def:148 -msgid "" -" -fsource-location generate source location code\n" -" * turned on by -debug/-g/-ftraceall" -msgstr "" -" -fsource-location generate source location code\n" -" * turned on by -debug/-g/-ftraceall" - -#: cobc/flag.def:152 -msgid " -fimplicit-init automatic initialization of the COBOL runtime system" -msgstr " -fimplicit-init automatic initialization of the COBOL runtime system" - -#: cobc/flag.def:155 -msgid "" -" -fstack-check PERFORM stack checking\n" -" * turned on by -debug or -g" -msgstr "" -" -fstack-check PERFORM stack checking\n" -" * turned on by -debug or -g" - -#: cobc/flag.def:159 -msgid "" -" -fwrite-after use AFTER 1 for WRITE of LINE SEQUENTIAL\n" -" * default: BEFORE 1" -msgstr "" -" -fwrite-after use AFTER 1 for WRITE of LINE SEQUENTIAL\n" -" * default: BEFORE 1" - -#: cobc/flag.def:163 -msgid "" -" -fmfcomment '*' or '/' in column 1 treated as comment\n" -" * FIXED format only" -msgstr "" -" -fmfcomment ‘*’ or ‘/’ in column 1 treated as comment\n" -" * FIXED format only" - -#: cobc/flag.def:167 -msgid "" -" -facucomment '$' in indicator area treated as '*',\n" -" '|' treated as floating comment" -msgstr "" -" -facucomment ‘$’ in indicator area treated as '*',\n" -" ‘|’ treated as floating comment" - -#: cobc/flag.def:171 -msgid "" -" -fnotrunc allow numeric field overflow\n" -" * non-ANSI behaviour" -msgstr "" -" -fnotrunc allow numeric field overflow\n" -" * non-ANSI behaviour" - -#: cobc/flag.def:175 -msgid "" -" -fodoslide adjust items following OCCURS DEPENDING\n" -" * implies -fcomplex-odo" -msgstr "" -" -fodoslide adjust items following OCCURS DEPENDING\n" -" * implies -fcomplex-odo" - -#: cobc/flag.def:179 -msgid "" -" -fsingle-quote use a single quote (apostrophe) for QUOTE\n" -" * default: double quote" -msgstr "" -" -fsingle-quote use a single quote (apostrophe) for QUOTE\n" -" * default: double quote" - -#: cobc/flag.def:189 -msgid "" -" -foptional-file treat all files as OPTIONAL\n" -" * unless NOT OPTIONAL specified" -msgstr "" -" -foptional-file treat all files as OPTIONAL\n" -" * unless NOT OPTIONAL specified" - -#: cobc/flag.def:193 -msgid " -fstatic-call output static function calls for the CALL statement" -msgstr " -fstatic-call output static function calls for the CALL statement" - -#: cobc/flag.def:196 -msgid "" -" -fno-gen-c-decl-static-call\tdisable generation of C function declations\n" -" for subroutines with static CALL" -msgstr "" -" -fno-gen-c-decl-static-call\tdisable generation of C function declations\n" -" for subroutines with static CALL" - -#: cobc/flag.def:200 -msgid " -fmf-files Sequential & Relative files will match Micro Focus format" -msgstr " -fmf-files Sequential & Relative files will match Micro Focus format" - -#: cobc/flag.def:203 -msgid "" -" -fno-theaders suppress all headers and output of compilation\n" -" options from listing while keeping page breaks" -msgstr "" -" -fno-theaders suppress all headers and output of compilation\n" -" options from listing while keeping page breaks" - -#: cobc/flag.def:207 -msgid " -fno-tsource suppress source from listing" -msgstr " -fno-tsource suppress source from listing" - -#: cobc/flag.def:210 -msgid " -fno-tmessages suppress warning and error summary from listing" -msgstr " -fno-tmessages suppress warning and error summary from listing" - -#: cobc/flag.def:213 -msgid " -ftsymbols specify symbols in listing" -msgstr " -ftsymbols specify symbols in listing" - -#: cobc/parser.y:283 cobc/parser.y:317 -#, c-format -msgid "unreachable statement '%s'" -msgstr "unreachable statement ‘%s’" - -#: cobc/parser.y:410 cobc/parser.y:703 -#, c-format -msgid "'%s' is not in LINKAGE SECTION" -msgstr "‘%s’ is not in LINKAGE SECTION" - -#: cobc/parser.y:413 cobc/typeck.c:3705 -#, c-format -msgid "'%s' cannot be BASED/EXTERNAL" -msgstr "‘%s’ cannot be BASED/EXTERNAL" - -#: cobc/parser.y:418 -#, c-format -msgid "'%s' is not in WORKING-STORAGE SECTION" -msgstr "‘%s’ is not in WORKING-STORAGE SECTION" - -#: cobc/parser.y:425 cobc/typeck.c:3702 -#, c-format -msgid "'%s' not level 01 or 77" -msgstr "‘%s’ not level 01 or 77" - -#: cobc/parser.y:428 cobc/parser.y:443 cobc/typeck.c:3708 -#, c-format -msgid "'%s' REDEFINES field not allowed here" -msgstr "‘%s’ REDEFINES field not allowed here" - -#: cobc/parser.y:456 -#, c-format -msgid "'%s' USING item duplicates RETURNING item" -msgstr "‘%s’ USING item duplicates RETURNING item" - -#: cobc/parser.y:466 -#, c-format -msgid "ENTRY '%s' duplicated" -msgstr "ENTRY ‘%s’ duplicated" - -#: cobc/parser.y:502 -#, c-format -msgid "ENTRY FOR GO TO '%s' duplicated" -msgstr "ENTRY FOR GO TO ‘%s’ duplicated" - -#: cobc/parser.y:518 -#, c-format -msgid "maximum nested program depth exceeded (%d)" -msgstr "maximum nested program depth exceeded (%d)" - -#: cobc/parser.y:544 cobc/parser.y:571 -#, c-format -msgid "%s statement not terminated by %s" -msgstr "%s statement not terminated by %s" - -#: cobc/parser.y:574 -#, c-format -msgid "%s statement not terminated" -msgstr "%s statement not terminated" - -#: cobc/parser.y:638 -msgid "USE statement invalid for SORT file" -msgstr "USE statement invalid for SORT file" - -#: cobc/parser.y:665 cobc/parser.y:667 -#, c-format -msgid "duplicate %s clause" -msgstr "duplicate %s clause" - -#: cobc/parser.y:685 -#, c-format -msgid "Cannot specify %s without number of lines on page" -msgstr "Cannot specify %s without number of lines on page" - -#: cobc/parser.y:695 -#, c-format -msgid "maximum OCCURS depth exceeded (%d)" -msgstr "maximum OCCURS depth exceeded (%d)" - -#: cobc/parser.y:709 cobc/parser.y:711 cobc/parser.y:6808 cobc/parser.y:6811 -#: cobc/parser.y:6813 cobc/parser.y:6815 cobc/parser.y:6850 cobc/parser.y:7573 -#: cobc/parser.y:7575 cobc/parser.y:7577 cobc/parser.y:7579 cobc/parser.y:7625 -#: cobc/parser.y:7634 cobc/parser.y:9548 cobc/parser.y:10994 -#: cobc/parser.y:12370 cobc/parser.y:13552 -#, c-format -msgid "%s and %s are mutually exclusive" -msgstr "%s and %s are mutually exclusive" - -#: cobc/parser.y:725 cobc/parser.y:729 -msgid "TO phrase without DEPENDING phrase" -msgstr "TO phrase without DEPENDING phrase" - -#: cobc/parser.y:726 -msgid "maximum number of occurrences assumed to be exact number" -msgstr "maximum number of occurrences assumed to be exact number" - -#: cobc/parser.y:733 cobc/parser.y:7355 -msgid "OCCURS TO must be greater than OCCURS FROM" -msgstr "OCCURS TO must be greater than OCCURS FROM" - -#: cobc/parser.y:742 -msgid "OCCURS DEPENDING ON without TO phrase" -msgstr "OCCURS DEPENDING ON without TO phrase" - -#: cobc/parser.y:808 -#, c-format -msgid "%s header missing - assumed" -msgstr "%s header missing - assumed" - -#: cobc/parser.y:810 -#, c-format -msgid "%s header missing" -msgstr "%s header missing" - -#: cobc/parser.y:942 -#, c-format -msgid "duplicate %s" -msgstr "duplicate %s" - -#: cobc/parser.y:944 -#, c-format -msgid "%s incorrectly after %s" -msgstr "%s incorrectly after %s" - -#: cobc/parser.y:1046 -#, c-format -msgid "redefinition of program name '%s'" -msgstr "redefinition of program name ‘%s’" - -#: cobc/parser.y:1050 -#, c-format -msgid "redefinition of program ID '%s'" -msgstr "redefinition of program ID ‘%s’" - -#: cobc/parser.y:1082 -#, c-format -msgid "FUNCTION '%s' has no PROCEDURE DIVISION" -msgstr "FUNCTION ‘%s’ has no PROCEDURE DIVISION" - -#: cobc/parser.y:1188 -msgid "functions may not be defined within a program/function" -msgstr "functions may not be defined within a program/function" - -#: cobc/parser.y:1238 -#, c-format -msgid "END FUNCTION '%s' is different from FUNCTION-ID '%s'" -msgstr "END FUNCTION ‘%s’ is different from FUNCTION-ID ‘%s’" - -#: cobc/parser.y:1252 -#, c-format -msgid "END PROGRAM '%s' is different from PROGRAM-ID '%s'" -msgstr "END PROGRAM ‘%s’ is different from PROGRAM-ID ‘%s’" - -#: cobc/parser.y:1301 -msgid "currency symbol must be one character long" -msgstr "currency symbol must be one character long" - -#: cobc/parser.y:1358 -#, c-format -msgid "invalid character '%c' in currency symbol" -msgstr "invalid character ‘%c’ in currency symbol" - -#: cobc/parser.y:1374 -msgid "prototype has same name as current function and will be ignored" -msgstr "prototype has same name as current function and will be ignored" - -#: cobc/parser.y:1401 -#, c-format -msgid "duplicate REPOSITORY entries for '%s' do not match" -msgstr "duplicate REPOSITORY entries for ‘%s’ do not match" - -#: cobc/parser.y:1405 -#, c-format -msgid "duplicate REPOSITORY entry for '%s'" -msgstr "duplicate REPOSITORY entry for ‘%s’" - -#: cobc/parser.y:1470 -#, c-format -msgid "ORGANIZATION %s is incompatible with RECORD DELIMITER" -msgstr "ORGANIZATION %s is incompatible with RECORD DELIMITER" - -#: cobc/parser.y:1502 -#, c-format -msgid "illegal combination of %s with other clauses" -msgstr "illegal combination of %s with other clauses" - -#: cobc/parser.y:1517 cobc/parser.y:1520 cobc/parser.y:1551 -#, c-format -msgid "cannot specify both %s and %s" -msgstr "cannot specify both %s and %s" - -#: cobc/parser.y:1548 -#, c-format -msgid "cannot specify both %s and %s; %s is ignored" -msgstr "cannot specify both %s and %s; %s is ignored" - -#: cobc/parser.y:1720 -msgid "FOR phrase cannot immediately follow ALL/LEADING/TRAILING" -msgstr "FOR phrase cannot immediately follow ALL/LEADING/TRAILING" - -#: cobc/parser.y:1722 -msgid "missing CHARACTERS/ALL/LEADING/TRAILING phrase after FOR phrase" -msgstr "missing CHARACTERS/ALL/LEADING/TRAILING phrase after FOR phrase" - -#: cobc/parser.y:1729 -msgid "missing value between ALL/LEADING/TRAILING words" -msgstr "missing value between ALL/LEADING/TRAILING words" - -#: cobc/parser.y:1734 -msgid "missing FOR phrase before CHARACTERS/ALL/LEADING/TRAILING phrase" -msgstr "missing FOR phrase before CHARACTERS/ALL/LEADING/TRAILING phrase" - -#: cobc/parser.y:1741 -msgid "missing ALL/LEADING/TRAILING before value" -msgstr "missing ALL/LEADING/TRAILING before value" - -#: cobc/parser.y:1796 -msgid "use of condition-name in place of data-name" -msgstr "use of condition-name in place of data-name" - -#: cobc/parser.y:1800 cobc/parser.y:6753 cobc/typeck.c:665 -#, c-format -msgid "condition-name not allowed here: '%s'" -msgstr "condition-name not allowed here: ‘%s’" - -#: cobc/parser.y:1827 -msgid "cannot specify NO ADVANCING in screen DISPLAY" -msgstr "cannot specify NO ADVANCING in screen DISPLAY" - -#: cobc/parser.y:1899 cobc/parser.y:1916 -msgid "non-standard DISPLAY" -msgstr "non-standard DISPLAY" - -#: cobc/parser.y:1903 -msgid "screens may only be displayed on CRT" -msgstr "screens may only be displayed on CRT" - -#: cobc/parser.y:1908 cobc/parser.y:1951 -msgid "cannot mix screens and fields in the same DISPLAY statement" -msgstr "cannot mix screens and fields in the same DISPLAY statement" - -#: cobc/parser.y:1912 -msgid "screen clauses may only be used for DISPLAY on CRT" -msgstr "screen clauses may only be used for DISPLAY on CRT" - -#: cobc/parser.y:1957 -msgid "ambiguous DISPLAY; put items to display on device in separate DISPLAY" -msgstr "ambiguous DISPLAY; put items to display on device in separate DISPLAY" - -#: cobc/parser.y:1973 -#, c-format -msgid "%s is not an alphanumeric literal" -msgstr "%s is not an alphanumeric literal" - -#: cobc/parser.y:1975 -#, c-format -msgid "'%s' is not USAGE DISPLAY" -msgstr "‘%s’ is not USAGE DISPLAY" - -#: cobc/parser.y:1990 cobc/typeck.c:8481 -#, c-format -msgid "invalid target for %s" -msgstr "invalid target for %s" - -#: cobc/parser.y:1997 cobc/parser.y:6747 -msgid "SCREEN item cannot be used here" -msgstr "SCREEN item cannot be used here" - -#: cobc/parser.y:1999 -msgid "RENAMES item may not be used here" -msgstr "RENAMES item may not be used here" - -#: cobc/parser.y:2001 cobc/typeck.c:2333 cobc/typeck.c:2429 -msgid "ANY LENGTH item not allowed here" -msgstr "ANY LENGTH item not allowed here" - -#: cobc/parser.y:2005 -#, c-format -msgid "item '%s' has wrong class for VALIDATE" -msgstr "item ‘%s’ has wrong class for VALIDATE" - -#: cobc/parser.y:2014 -msgid "WHEN clause must follow EVERY clause" -msgstr "WHEN clause must follow EVERY clause" - -#: cobc/parser.y:2096 cobc/parser.y:17197 -msgid "non-zero value expected" -msgstr "non-zero value expected" - -#: cobc/parser.y:2102 cobc/tree.c:4352 -#, c-format -msgid "RECORD size (IDX) exceeds maximum allowed (%d)" -msgstr "RECORD size (IDX) exceeds maximum allowed (%d)" - -#: cobc/parser.y:2106 cobc/tree.c:4355 -#, c-format -msgid "RECORD size exceeds maximum allowed (%d)" -msgstr "RECORD size exceeds maximum allowed (%d)" - -#: cobc/parser.y:2111 -msgid "RECORD clause invalid" -msgstr "RECORD clause invalid" - -#: cobc/parser.y:3188 -msgid "multiple PROGRAM-ID's without matching END PROGRAM" -msgstr "multiple PROGRAM-ID's without matching END PROGRAM" - -#: cobc/parser.y:3191 -msgid "executable requested but no program found" -msgstr "executable requested but no program found" - -#: cobc/parser.y:3408 cobc/parser.y:3417 -msgid "COMMON may only be used in a contained program" -msgstr "COMMON may only be used in a contained program" - -#: cobc/parser.y:3426 cobc/parser.y:3458 -msgid "CALL prototypes" -msgstr "CALL prototypes" - -#: cobc/parser.y:3607 cobc/parser.y:3884 cobc/parser.y:3928 cobc/parser.y:4036 -#: cobc/parser.y:4223 cobc/parser.y:4319 cobc/parser.y:4360 cobc/parser.y:4431 -#: cobc/parser.y:4452 cobc/parser.y:4531 cobc/parser.y:4550 cobc/parser.y:4566 -#: cobc/parser.y:4584 cobc/parser.y:4602 cobc/parser.y:4619 cobc/parser.y:4637 -#: cobc/parser.y:6868 cobc/parser.y:7694 -#, c-format -msgid "%s not allowed in nested programs" -msgstr "%s not allowed in nested programs" - -#: cobc/parser.y:3761 -msgid "segment-number must be in range of values 1 to 49" -msgstr "segment-number must be in range of values 1 to 49" - -#: cobc/parser.y:3773 -msgid "duplicate CLASSIFICATION clause" -msgstr "duplicate CLASSIFICATION clause" - -#: cobc/parser.y:3849 -msgid "PROGRAM phrase" -msgstr "PROGRAM phrase" - -#: cobc/parser.y:3944 cobc/parser.y:3955 cobc/parser.y:4271 -#, c-format -msgid "invalid %s clause" -msgstr "invalid %s clause" - -#: cobc/parser.y:4386 cobc/parser.y:4390 -msgid "CLASS literal with THRU must have size 1" -msgstr "CLASS literal with THRU must have size 1" - -#: cobc/parser.y:4417 -msgid "CLASS IS integer IN alphabet-name" -msgstr "CLASS IS integer IN alphabet-name" - -#: cobc/parser.y:4464 -msgid "separate currency symbol and currency string" -msgstr "separate currency symbol and currency string" - -#: cobc/parser.y:4497 -#, c-format -msgid "invalid CURRENCY SIGN '%s'" -msgstr "invalid CURRENCY SIGN ‘%s’" - -#: cobc/parser.y:4715 -msgid "cannot use RELATIVE KEY clause on INDEXED files" -msgstr "cannot use RELATIVE KEY clause on INDEXED files" - -#: cobc/parser.y:4719 -msgid "cannot use RECORD KEY clause on RELATIVE files" -msgstr "cannot use RECORD KEY clause on RELATIVE files" - -#: cobc/parser.y:4793 -msgid "EXTERNAL/DYNAMIC cannot be used with literals" -msgstr "EXTERNAL/DYNAMIC cannot be used with literals" - -#: cobc/parser.y:4813 -msgid "EXTERNAL/DYNAMIC cannot be used with USING/VARYING" -msgstr "EXTERNAL/DYNAMIC cannot be used with USING/VARYING" - -#: cobc/parser.y:4824 -msgid "EXTERNAL/DYNAMIC cannot be used with DISK FROM" -msgstr "EXTERNAL/DYNAMIC cannot be used with DISK FROM" - -#: cobc/parser.y:4826 -msgid "ASSIGN DISK FROM" -msgstr "ASSIGN DISK FROM" - -#: cobc/parser.y:4942 -msgid "ASSIGN EXTERNAL/DYNAMIC" -msgstr "ASSIGN EXTERNAL/DYNAMIC" - -#: cobc/parser.y:5165 -#, c-format -msgid "'%s' is not an alphabet-name" -msgstr "‘%s’ is not an alphabet-name" - -#: cobc/parser.y:5254 -#, c-format -msgid "%s only valid with ORGANIZATION %s" -msgstr "%s only valid with ORGANIZATION %s" - -#: cobc/parser.y:5321 cobc/parser.y:5344 -#, c-format -msgid "RECORD DELIMITER %s only allowed with SEQUENTIAL files" -msgstr "RECORD DELIMITER %s only allowed with SEQUENTIAL files" - -#: cobc/parser.y:5323 cobc/parser.y:5336 cobc/parser.y:5348 cobc/parser.y:5358 -msgid "RECORD DELIMITER clause" -msgstr "RECORD DELIMITER clause" - -#: cobc/parser.y:5332 -#, c-format -msgid "RECORD DELIMITER %s only allowed with (LINE) SEQUENTIAL files" -msgstr "RECORD DELIMITER %s only allowed with (LINE) SEQUENTIAL files" - -#: cobc/parser.y:5337 -msgid "LINE-SEQUENTIAL phrase" -msgstr "LINE-SEQUENTIAL phrase" - -#: cobc/parser.y:5349 -msgid "BINARY-SEQUENTIAL phrase" -msgstr "BINARY-SEQUENTIAL phrase" - -#: cobc/parser.y:5357 -msgid "RECORD DELIMITER clause only allowed with (LINE) SEQUENTIAL files" -msgstr "RECORD DELIMITER clause only allowed with (LINE) SEQUENTIAL files" - -#: cobc/parser.y:5360 -#, c-format -msgid "RECORD DELIMITER %s not recognized; will be ignored" -msgstr "RECORD DELIMITER %s not recognized; will be ignored" - -#: cobc/parser.y:5398 -msgid "DUPLICATES for primary keys" -msgstr "DUPLICATES for primary keys" - -#: cobc/parser.y:5637 -msgid "DOS/VS APPLY phrase" -msgstr "DOS/VS APPLY phrase" - -#: cobc/parser.y:5752 -msgid "RECORD description missing or invalid" -msgstr "RECORD description missing or invalid" - -#: cobc/parser.y:5778 -#, c-format -msgid "duplicate file description for %s" -msgstr "duplicate file description for %s" - -#: cobc/parser.y:5811 cobc/parser.y:5821 -msgid "file cannot have both EXTERNAL and GLOBAL clauses" -msgstr "file cannot have both EXTERNAL and GLOBAL clauses" - -#: cobc/parser.y:5825 cobc/parser.y:6414 cobc/parser.y:6853 cobc/parser.y:12363 -#: cobc/parser.y:15305 -#, c-format -msgid "%s is invalid in a user FUNCTION" -msgstr "%s is invalid in a user FUNCTION" - -#: cobc/parser.y:5863 cobc/parser.y:5872 -msgid "RECORD clause ignored for LINE SEQUENTIAL" -msgstr "RECORD clause ignored for LINE SEQUENTIAL" - -#: cobc/parser.y:5964 -msgid "LINAGE clause with wrong file type" -msgstr "LINAGE clause with wrong file type" - -#: cobc/parser.y:6026 -msgid "RECORDING MODE U or S can only be used with RECORD SEQUENTIAL files" -msgstr "RECORDING MODE U or S can only be used with RECORD SEQUENTIAL files" - -#: cobc/parser.y:6059 -#, c-format -msgid "ignoring CODE-SET '%s'" -msgstr "ignoring CODE-SET ‘%s’" - -#: cobc/parser.y:6070 -msgid "CODE-SET clause invalid for file type" -msgstr "CODE-SET clause invalid for file type" - -#: cobc/parser.y:6092 -msgid "REPORT clause with wrong file type" -msgstr "REPORT clause with wrong file type" - -#: cobc/parser.y:6170 -msgid "CD record missing" -msgstr "CD record missing" - -#: cobc/parser.y:6601 -msgid "CONSTANT item not at 01 level" -msgstr "CONSTANT item not at 01 level" - -#: cobc/parser.y:6721 -msgid "REDEFINES clause not following entry-name" -msgstr "REDEFINES clause not following entry-name" - -#: cobc/parser.y:6743 -msgid "SAME AS clause" -msgstr "SAME AS clause" - -#: cobc/parser.y:6750 -msgid "REPORT item cannot be used here" -msgstr "REPORT item cannot be used here" - -#: cobc/parser.y:6757 -msgid "elementary item expected" -msgstr "elementary item expected" - -#: cobc/parser.y:6764 -msgid "SAME AS item may not reference itself" -msgstr "SAME AS item may not reference itself" - -#: cobc/parser.y:6771 -msgid "SAME AS item may not be subordinate to any item with USAGE clause" -msgstr "SAME AS item may not be subordinate to any item with USAGE clause" - -#: cobc/parser.y:6773 -msgid "SAME AS item may not be subordinate to any item with SIGN clause" -msgstr "SAME AS item may not be subordinate to any item with SIGN clause" - -#: cobc/parser.y:6801 cobc/parser.y:6855 cobc/parser.y:7567 cobc/parser.y:7650 -#: cobc/parser.y:7674 -#, c-format -msgid "%s not allowed here" -msgstr "%s not allowed here" - -#: cobc/parser.y:6803 cobc/parser.y:6845 cobc/parser.y:7569 -#, c-format -msgid "%s only allowed at 01/77 level" -msgstr "%s only allowed at 01/77 level" - -#: cobc/parser.y:6805 cobc/parser.y:6847 cobc/parser.y:7571 cobc/parser.y:7654 -#: cobc/parser.y:7676 -#, c-format -msgid "%s requires a data name" -msgstr "%s requires a data name" - -#: cobc/parser.y:6958 -msgid "a locale-format PICTURE string must only consist of '9', '.', '+', 'Z' and the currency-sign" -msgstr "a locale-format PICTURE string must only consist of '9', '.', '+', ‘Z’ and the currency-sign" - -#: cobc/parser.y:6992 cobc/typeck.c:3658 -#, c-format -msgid "'%s' is not a locale-name" -msgstr "‘%s’ is not a locale-name" - -#: cobc/parser.y:7007 -#, c-format -msgid "'%s' is not a valid USAGE" -msgstr "‘%s’ is not a valid USAGE" - -#: cobc/parser.y:7012 -#, c-format -msgid "unknown USAGE: %s" -msgstr "unknown USAGE: %s" - -#: cobc/parser.y:7149 -#, c-format -msgid "unknown HANDLE type: %s" -msgstr "unknown HANDLE type: %s" - -#: cobc/parser.y:7406 cobc/parser.y:7408 -msgid "INDEXED should follow ASCENDING/DESCENDING" -msgstr "INDEXED should follow ASCENDING/DESCENDING" - -#: cobc/parser.y:7526 -msgid "SYNCHRONIZED clause" -msgstr "SYNCHRONIZED clause" - -#: cobc/parser.y:7529 -msgid "LEFT/RIGHT phrases in SYNCHRONIZED clause" -msgstr "LEFT/RIGHT phrases in SYNCHRONIZED clause" - -#: cobc/parser.y:7612 -msgid "FALSE clause only allowed for 88 level" -msgstr "FALSE clause only allowed for 88 level" - -#: cobc/parser.y:7652 -#, c-format -msgid "%s only allowed at 01 level" -msgstr "%s only allowed at 01 level" - -#: cobc/parser.y:7656 cobc/parser.y:7678 -#, c-format -msgid "%s and %s combination not allowed" -msgstr "%s and %s combination not allowed" - -#: cobc/parser.y:7787 -msgid "GLOBAL is not allowed with RD" -msgstr "GLOBAL is not allowed with RD" - -#: cobc/parser.y:8321 -msgid "PLUS is not recommended with LEFT, RIGHT or CENTER" -msgstr "PLUS is not recommended with LEFT, RIGHT or CENTER" - -#: cobc/parser.y:8323 -msgid "PLUS is not allowed with LEFT, RIGHT or CENTER" -msgstr "PLUS is not allowed with LEFT, RIGHT or CENTER" - -#: cobc/parser.y:8360 cobc/parser.y:8390 -msgid "PLUS is ignored on first field of line" -msgstr "PLUS is ignored on first field of line" - -#: cobc/parser.y:8398 -msgid "invalid COLUMN integer; must be > 0" -msgstr "invalid COLUMN integer; must be > 0" - -#: cobc/parser.y:8400 -msgid "COLUMN numbers should increase" -msgstr "COLUMN numbers should increase" - -#: cobc/parser.y:8499 cobc/parser.y:8555 -msgid "INITIAL specified on non-input field" -msgstr "INITIAL specified on non-input field" - -#: cobc/parser.y:8511 cobc/parser.y:8567 -msgid "relative LINE/COLUMN clause required with OCCURS" -msgstr "relative LINE/COLUMN clause required with OCCURS" - -#: cobc/parser.y:8669 cobc/parser.y:8673 -msgid "screen positions from data-item" -msgstr "screen positions from data-item" - -#: cobc/parser.y:9498 -msgid "OCCURS screen items" -msgstr "OCCURS screen items" - -#: cobc/parser.y:9510 -msgid "GLOBAL screen items" -msgstr "GLOBAL screen items" - -#: cobc/parser.y:9554 -msgid "overriding convention specified in ENTRY-CONVENTION" -msgstr "overriding convention specified in ENTRY-CONVENTION" - -#: cobc/parser.y:9566 -msgid "executable program requested but PROCEDURE/ENTRY has USING clause" -msgstr "executable program requested but PROCEDURE/ENTRY has USING clause" - -#: cobc/parser.y:9636 cobc/parser.y:9653 cobc/parser.y:11184 -#, c-format -msgid "number of arguments exceeds maximum %d" -msgstr "number of arguments exceeds maximum %d" - -#: cobc/parser.y:9645 -msgid "CHAINING invalid in user FUNCTION" -msgstr "CHAINING invalid in user FUNCTION" - -#: cobc/parser.y:9692 cobc/parser.y:11261 cobc/parser.y:11270 -#, c-format -msgid "%s not allowed in CHAINED programs" -msgstr "%s not allowed in CHAINED programs" - -#: cobc/parser.y:9704 cobc/parser.y:9712 cobc/parser.y:9720 cobc/parser.y:9741 -msgid "SIZE only allowed for BY VALUE items" -msgstr "SIZE only allowed for BY VALUE items" - -#: cobc/parser.y:9743 cobc/parser.y:9760 -msgid "invalid value for SIZE" -msgstr "invalid value for SIZE" - -#: cobc/parser.y:9775 -msgid "MEMORY SIZE phrase in CALL statement" -msgstr "MEMORY SIZE phrase in CALL statement" - -#: cobc/parser.y:9787 -msgid "OPTIONAL only allowed for BY REFERENCE items" -msgstr "OPTIONAL only allowed for BY REFERENCE items" - -#: cobc/parser.y:9799 -msgid "RETURNING clause is required for a FUNCTION" -msgstr "RETURNING clause is required for a FUNCTION" - -#: cobc/parser.y:9805 -msgid "RETURNING clause cannot be OMITTED for main program" -msgstr "RETURNING clause cannot be OMITTED for main program" - -#: cobc/parser.y:9808 -msgid "RETURNING clause cannot be OMITTED for a FUNCTION" -msgstr "RETURNING clause cannot be OMITTED for a FUNCTION" - -#: cobc/parser.y:9821 -msgid "RETURNING item is not defined in LINKAGE SECTION" -msgstr "RETURNING item is not defined in LINKAGE SECTION" - -#: cobc/parser.y:9823 -msgid "RETURNING item must have level 01" -msgstr "RETURNING item must have level 01" - -#: cobc/parser.y:9825 -msgid "RETURNING item should not have OCCURS" -msgstr "RETURNING item should not have OCCURS" - -#: cobc/parser.y:9829 -msgid "function RETURNING item may not be ANY LENGTH" -msgstr "function RETURNING item may not be ANY LENGTH" - -#: cobc/parser.y:10017 -#, c-format -msgid "'%s' is not a statement" -msgstr "‘%s’ is not a statement" - -#: cobc/parser.y:10019 -#, c-format -msgid "unknown statement '%s'; it may exist in another dialect" -msgstr "unknown statement '%s'; it may exist in another dialect" - -#: cobc/parser.y:10022 -#, c-format -msgid "unknown statement '%s'" -msgstr "unknown statement ‘%s’" - -#: cobc/parser.y:10039 -msgid "section segments" -msgstr "section segments" - -#: cobc/parser.y:10041 -msgid "SECTION segment-number must be less than or equal to 99" -msgstr "SECTION segment-number must be less than or equal to 99" - -#: cobc/parser.y:10044 -msgid "SECTION segment-number in DECLARATIVES must be less than 50" -msgstr "SECTION segment-number in DECLARATIVES must be less than 50" - -#: cobc/parser.y:10052 -msgid "SECTION segment within DECLARATIVES" -msgstr "SECTION segment within DECLARATIVES" - -#: cobc/parser.y:10240 cobc/parser.y:10375 -msgid "non-standard ACCEPT" -msgstr "non-standard ACCEPT" - -#: cobc/parser.y:10252 -msgid "PROMPT clause" -msgstr "PROMPT clause" - -#: cobc/parser.y:10256 -msgid "SIZE IS clause" -msgstr "SIZE IS clause" - -#: cobc/parser.y:10471 cobc/parser.y:10763 -msgid "TIME-OUT or BEFORE TIME clauses" -msgstr "TIME-OUT or BEFORE TIME clauses" - -#: cobc/parser.y:10497 cobc/parser.y:10513 cobc/parser.y:10528 -msgid "AT screen-location" -msgstr "AT screen-location" - -#: cobc/parser.y:10529 -msgid "LINE or COLUMN" -msgstr "LINE or COLUMN" - -#: cobc/parser.y:10893 -msgid "ALLOCATE CHARACTERS requires RETURNING clause" -msgstr "ALLOCATE CHARACTERS requires RETURNING clause" - -#: cobc/parser.y:10908 cobc/parser.y:12168 -#, c-format -msgid "ignoring %s phrase" -msgstr "ignoring %s phrase" - -#: cobc/parser.y:10910 -msgid "addressing mode should be either 24 or 31 bit" -msgstr "addressing mode should be either 24 or 31 bit" - -#: cobc/parser.y:10982 -msgid "recursive program call - assuming RECURSIVE attribute" -msgstr "recursive program call - assuming RECURSIVE attribute" - -#: cobc/parser.y:11001 -msgid "STATIC CALL convention ignored because of ON EXCEPTION" -msgstr "STATIC CALL convention ignored because of ON EXCEPTION" - -#: cobc/parser.y:11010 -msgid "ON EXCEPTION ignored because of STATIC CALL" -msgstr "ON EXCEPTION ignored because of STATIC CALL" - -#: cobc/parser.y:11111 cobc/typeck.c:12209 -msgid "invalid mnemonic name" -msgstr "invalid mnemonic name" - -#: cobc/parser.y:11131 cobc/parser.y:11428 -msgid "CALL/CANCEL with program-prototype-name" -msgstr "CALL/CANCEL with program-prototype-name" - -#: cobc/parser.y:11135 -msgid "id/literal ignored, using prototype name" -msgstr "id/literal ignored, using prototype name" - -#: cobc/parser.y:11141 -msgid "NESTED phrase is only valid with literal" -msgstr "NESTED phrase is only valid with literal" - -#: cobc/parser.y:11202 -msgid "OMITTED only allowed when arguments are passed BY REFERENCE" -msgstr "OMITTED only allowed when arguments are passed BY REFERENCE" - -#: cobc/parser.y:11226 -msgid "invalid file name reference" -msgstr "invalid file name reference" - -#: cobc/parser.y:11234 -#, c-format -msgid "BY CONTENT assumed for alphanumeric item '%s'" -msgstr "BY CONTENT assumed for alphanumeric item ‘%s’" - -#: cobc/parser.y:11239 -#, c-format -msgid "BY CONTENT assumed for national item '%s'" -msgstr "BY CONTENT assumed for national item ‘%s’" - -#: cobc/parser.y:11302 -msgid "RETURNING item must have level 01 or 77" -msgstr "RETURNING item must have level 01 or 77" - -#: cobc/parser.y:11306 -msgid "RETURNING item must be a LINKAGE SECTION item or have BASED clause" -msgstr "RETURNING item must be a LINKAGE SECTION item or have BASED clause" - -#: cobc/parser.y:11340 cobc/parser.y:15972 cobc/parser.y:16027 -#: cobc/parser.y:16071 cobc/parser.y:16115 -msgid "NOT EXCEPTION before EXCEPTION" -msgstr "NOT EXCEPTION before EXCEPTION" - -#: cobc/parser.y:12041 -#, c-format -msgid "HANDLE must be a %s HANDLE" -msgstr "HANDLE must be a %s HANDLE" - -#: cobc/parser.y:12053 -msgid "HANDLE must be a generic HANDLE" -msgstr "HANDLE must be a generic HANDLE" - -#: cobc/parser.y:12130 -#, c-format -msgid "HANDLE clause invalid for %s" -msgstr "HANDLE clause invalid for %s" - -#: cobc/parser.y:12361 cobc/parser.y:15495 -#, c-format -msgid "%s is invalid in nested program" -msgstr "%s is invalid in nested program" - -#: cobc/parser.y:12399 cobc/parser.y:12440 cobc/parser.y:12451 -#: cobc/parser.y:12462 -#, c-format -msgid "maximum evaluate depth exceeded (%d)" -msgstr "maximum evaluate depth exceeded (%d)" - -#: cobc/parser.y:12503 cobc/parser.y:12513 -msgid "WHEN without imperative statement" -msgstr "WHEN without imperative statement" - -#: cobc/parser.y:12531 cobc/parser.y:12541 -msgid "WHEN OTHER without imperative statement" -msgstr "WHEN OTHER without imperative statement" - -#: cobc/parser.y:12621 -msgid "invalid THROUGH usage" -msgstr "invalid THROUGH usage" - -#: cobc/parser.y:12700 -msgid "EXIT PROGRAM is not allowed within a USE GLOBAL procedure" -msgstr "EXIT PROGRAM is not allowed within a USE GLOBAL procedure" - -#: cobc/parser.y:12704 -msgid "EXIT PROGRAM not allowed within a FUNCTION" -msgstr "EXIT PROGRAM not allowed within a FUNCTION" - -#: cobc/parser.y:12713 cobc/parser.y:12926 -msgid "RETURNING/GIVING not allowed for non-returning runtime elements" -msgstr "RETURNING/GIVING not allowed for non-returning runtime elements" - -#: cobc/parser.y:12725 -msgid "EXIT FUNCTION is not allowed within a USE GLOBAL procedure" -msgstr "EXIT FUNCTION is not allowed within a USE GLOBAL procedure" - -#: cobc/parser.y:12729 -msgid "EXIT FUNCTION only allowed within a FUNCTION" -msgstr "EXIT FUNCTION only allowed within a FUNCTION" - -#: cobc/parser.y:12743 cobc/parser.y:12766 -msgid "EXIT PERFORM is only valid with inline PERFORM" -msgstr "EXIT PERFORM is only valid with inline PERFORM" - -#: cobc/parser.y:12788 -msgid "EXIT SECTION is only valid with an active SECTION" -msgstr "EXIT SECTION is only valid with an active SECTION" - -#: cobc/parser.y:12809 -msgid "EXIT PARAGRAPH is only valid with an active PARAGRAPH" -msgstr "EXIT PARAGRAPH is only valid with an active PARAGRAPH" - -#: cobc/parser.y:12956 -msgid "IF without imperative statement" -msgstr "IF without imperative statement" - -#: cobc/parser.y:13173 -msgid "TALLYING clause is incomplete" -msgstr "TALLYING clause is incomplete" - -#: cobc/parser.y:13289 -msgid "INSPECT missing ALL/FIRST/LEADING/TRAILING" -msgstr "INSPECT missing ALL/FIRST/LEADING/TRAILING" - -#: cobc/parser.y:13407 -msgid "JSON PARSE" -msgstr "JSON PARSE" - -#: cobc/parser.y:13552 -msgid "LOCK clauses" -msgstr "LOCK clauses" - -#: cobc/parser.y:13717 -msgid "inline PERFORM without imperative statement" -msgstr "inline PERFORM without imperative statement" - -#: cobc/parser.y:13838 cobc/parser.y:13846 cobc/parser.y:13854 -#, c-format -msgid "PERFORM VARYING '%s' (line %d of %s) is not a numeric field" -msgstr "PERFORM VARYING ‘%s’ (line %d of %s) is not a numeric field" - -#: cobc/parser.y:13870 -msgid "PERFORM VARYING without BY phrase" -msgstr "PERFORM VARYING without BY phrase" - -#: cobc/parser.y:13910 -#, c-format -msgid "'%s' is not an object-reference" -msgstr "‘%s’ is not an object-reference" - -#: cobc/parser.y:13951 cobc/typeck.c:10958 cobc/typeck.c:12100 -msgid "LOCK clause invalid with file LOCK AUTOMATIC" -msgstr "LOCK clause invalid with file LOCK AUTOMATIC" - -#: cobc/parser.y:13956 -msgid "KEY clause invalid with this file type" -msgstr "KEY clause invalid with this file type" - -#: cobc/parser.y:13961 cobc/typeck.c:10954 cobc/typeck.c:12096 -msgid "INVALID KEY clause invalid with this file type" -msgstr "INVALID KEY clause invalid with this file type" - -#: cobc/parser.y:14591 -msgid "file sort requires KEY phrase" -msgstr "file sort requires KEY phrase" - -#: cobc/parser.y:14615 -msgid "table SORT requires KEY phrase" -msgstr "table SORT requires KEY phrase" - -#: cobc/parser.y:14677 -msgid "file sort requires USING or INPUT PROCEDURE" -msgstr "file sort requires USING or INPUT PROCEDURE" - -#: cobc/parser.y:14684 -msgid "USING invalid with table SORT" -msgstr "USING invalid with table SORT" - -#: cobc/parser.y:14694 -msgid "INPUT PROCEDURE invalid with table SORT" -msgstr "INPUT PROCEDURE invalid with table SORT" - -#: cobc/parser.y:14696 -msgid "INPUT PROCEDURE invalid with MERGE" -msgstr "INPUT PROCEDURE invalid with MERGE" - -#: cobc/parser.y:14709 -msgid "file sort requires GIVING or OUTPUT PROCEDURE" -msgstr "file sort requires GIVING or OUTPUT PROCEDURE" - -#: cobc/parser.y:14716 -msgid "GIVING invalid with table SORT" -msgstr "GIVING invalid with table SORT" - -#: cobc/parser.y:14726 -msgid "OUTPUT PROCEDURE invalid with table SORT" -msgstr "OUTPUT PROCEDURE invalid with table SORT" - -#: cobc/parser.y:14753 -msgid "SIZE/LENGTH invalid here" -msgstr "SIZE/LENGTH invalid here" - -#: cobc/parser.y:14806 -msgid "NOT EQUAL condition not allowed on START statement" -msgstr "NOT EQUAL condition not allowed on START statement" - -#: cobc/parser.y:14872 -#, c-format -msgid "%s is replaced by %s" -msgstr "%s is replaced by %s" - -#: cobc/parser.y:14925 -msgid "STOP literal" -msgstr "STOP literal" - -#: cobc/parser.y:14929 -msgid "STOP identifier" -msgstr "STOP identifier" - -#: cobc/parser.y:15066 -msgid "SUPPRESS statement must be within DECLARATIVES" -msgstr "SUPPRESS statement must be within DECLARATIVES" - -#: cobc/parser.y:15140 -msgid "UNLOCK invalid for SORT files" -msgstr "UNLOCK invalid for SORT files" - -#: cobc/parser.y:15276 cobc/parser.y:15355 -msgid "USE statement must be within DECLARATIVES" -msgstr "USE statement must be within DECLARATIVES" - -#: cobc/parser.y:15278 -msgid "SECTION header missing before USE statement" -msgstr "SECTION header missing before USE statement" - -#: cobc/parser.y:15357 -msgid "USE DEBUGGING not supported in contained program" -msgstr "USE DEBUGGING not supported in contained program" - -#: cobc/parser.y:15405 cobc/parser.y:15414 cobc/parser.y:15432 -#: cobc/parser.y:15468 cobc/typeck.c:3792 -#, c-format -msgid "duplicate DEBUGGING target: '%s'" -msgstr "duplicate DEBUGGING target: ‘%s’" - -#: cobc/parser.y:15430 -msgid "constant item cannot be used here" -msgstr "constant item cannot be used here" - -#: cobc/parser.y:15456 -msgid "duplicate USE DEBUGGING ON ALL PROCEDURES" -msgstr "duplicate USE DEBUGGING ON ALL PROCEDURES" - -#: cobc/parser.y:15528 -#, c-format -msgid "'%s' is not a report group" -msgstr "‘%s’ is not a report group" - -#: cobc/parser.y:15710 -msgid "ENCODING clause must come before XML-DECLARATION" -msgstr "ENCODING clause must come before XML-DECLARATION" - -#: cobc/parser.y:15712 -msgid "ENCODING clause must come before ATTRIBUTES" -msgstr "ENCODING clause must come before ATTRIBUTES" - -#: cobc/parser.y:15715 -msgid "XML GENERATE ENCODING clause" -msgstr "XML GENERATE ENCODING clause" - -#: cobc/parser.y:15722 -msgid "XML-DECLARATION clause must come before ATTRIBUTES" -msgstr "XML-DECLARATION clause must come before ATTRIBUTES" - -#: cobc/parser.y:15725 -msgid "XML GENERATE XML-DECLARATION clause" -msgstr "XML GENERATE XML-DECLARATION clause" - -#: cobc/parser.y:15731 -msgid "XML GENERATE WITH ATTRIBUTES clause" -msgstr "XML GENERATE WITH ATTRIBUTES clause" - -#: cobc/parser.y:15744 -msgid "XML GENERATE NAMESPACE clause" -msgstr "XML GENERATE NAMESPACE clause" - -#: cobc/parser.y:15768 -msgid "XML GENERATE NAME OF clause" -msgstr "XML GENERATE NAME OF clause" - -#: cobc/parser.y:15799 -msgid "XML GENERATE TYPE OF clause" -msgstr "XML GENERATE TYPE OF clause" - -#: cobc/parser.y:15840 -msgid "XML GENERATE SUPPRESS clause" -msgstr "XML GENERATE SUPPRESS clause" - -#: cobc/parser.y:15914 -msgid "XML PARSE" -msgstr "XML PARSE" - -#: cobc/parser.y:15955 cobc/parser.y:16633 cobc/parser.y:16729 -#: cobc/parser.y:16815 -#, c-format -msgid "'%s' is not a file name" -msgstr "‘%s’ is not a file name" - -#: cobc/parser.y:16161 -msgid "NOT SIZE ERROR before SIZE ERROR" -msgstr "NOT SIZE ERROR before SIZE ERROR" - -#: cobc/parser.y:16207 -msgid "NOT OVERFLOW before OVERFLOW" -msgstr "NOT OVERFLOW before OVERFLOW" - -#: cobc/parser.y:16306 -msgid "NOT AT END-OF-PAGE before AT END-OF-PAGE" -msgstr "NOT AT END-OF-PAGE before AT END-OF-PAGE" - -#: cobc/parser.y:16356 -msgid "NOT INVALID KEY before INVALID KEY" -msgstr "NOT INVALID KEY before INVALID KEY" - -#: cobc/parser.y:16619 -msgid "LINAGE-COUNTER must be qualified here" -msgstr "LINAGE-COUNTER must be qualified here" - -#: cobc/parser.y:16622 -msgid "invalid LINAGE-COUNTER usage" -msgstr "invalid LINAGE-COUNTER usage" - -#: cobc/parser.y:16643 -msgid "LINE-COUNTER must be qualified here" -msgstr "LINE-COUNTER must be qualified here" - -#: cobc/parser.y:16647 -msgid "invalid LINE-COUNTER usage" -msgstr "invalid LINE-COUNTER usage" - -#: cobc/parser.y:16658 cobc/parser.y:16683 -#, c-format -msgid "'%s' is not a report name" -msgstr "‘%s’ is not a report name" - -#: cobc/parser.y:16668 -msgid "PAGE-COUNTER must be qualified here" -msgstr "PAGE-COUNTER must be qualified here" - -#: cobc/parser.y:16672 -msgid "invalid PAGE-COUNTER usage" -msgstr "invalid PAGE-COUNTER usage" - -#: cobc/parser.y:16719 cobc/typeck.c:10919 cobc/typeck.c:11004 -#: cobc/typeck.c:12064 -#, c-format -msgid "%s requires a record name as subject" -msgstr "%s requires a record name as subject" - -#: cobc/parser.y:16746 -#, c-format -msgid "'%s' not indexed" -msgstr "‘%s’ not indexed" - -#: cobc/parser.y:16772 cobc/parser.y:16797 -#, c-format -msgid "multiple reference to '%s' " -msgstr "multiple reference to ‘%s’ " - -#: cobc/parser.y:16827 -#, c-format -msgid "'%s' is not a CD name" -msgstr "‘%s’ is not a CD name" - -#: cobc/parser.y:16841 -#, c-format -msgid "'%s' is not a valid report name" -msgstr "‘%s’ is not a valid report name" - -#: cobc/parser.y:17092 -msgid "invalid mnemonic identifier" -msgstr "invalid mnemonic identifier" - -#: cobc/parser.y:17172 -msgid "a numeric literal is expected here" -msgstr "a numeric literal is expected here" - -#: cobc/parser.y:17184 cobc/parser.y:17886 -msgid "a non-numeric literal is expected here" -msgstr "a non-numeric literal is expected here" - -#: cobc/parser.y:17357 cobc/typeck.c:6116 cobc/typeck.c:6123 -#, c-format -msgid "'%s' is not numeric" -msgstr "‘%s’ is not numeric" - -#: cobc/parser.y:17373 -#, c-format -msgid "'%s' is not a field or file" -msgstr "‘%s’ is not a field or file" - -#: cobc/parser.y:17393 cobc/parser.y:17411 -#, c-format -msgid "'%s' is not a field" -msgstr "‘%s’ is not a field" - -#: cobc/parser.y:17533 -#, c-format -msgid "'%s' is not a field or alphabet" -msgstr "‘%s’ is not a field or alphabet" - -#: cobc/parser.y:17559 -msgid "a subscripted data-item cannot be used here" -msgstr "a subscripted data-item cannot be used here" - -#: cobc/parser.y:17609 -msgid "unsigned integer value expected" -msgstr "unsigned integer value expected" - -#: cobc/parser.y:17621 cobc/parser.y:17625 cobc/parser.y:17675 -msgid "integer value expected" -msgstr "integer value expected" - -#: cobc/parser.y:17630 -msgid "invalid symbolic integer" -msgstr "invalid symbolic integer" - -#: cobc/parser.y:17646 cobc/parser.y:17650 -msgid "unsigned positive integer value expected" -msgstr "unsigned positive integer value expected" - -#: cobc/parser.y:17679 -msgid "invalid CLASS value" -msgstr "invalid CLASS value" - -#: cobc/parser.y:17767 -msgid "PHYSICAL argument for LENGTH functions" -msgstr "PHYSICAL argument for LENGTH functions" - -#: cobc/parser.y:17938 cobc/parser.y:17955 -msgid "cannot specify offset and SYSTEM-OFFSET at the same time" -msgstr "cannot specify offset and SYSTEM-OFFSET at the same time" - -#: cobc/pplex.l:223 cobc/pplex.l:1739 -msgid "debugging indicator" -msgstr "debugging indicator" - -#: cobc/pplex.l:300 -msgid "ignoring empty directive" -msgstr "ignoring empty directive" - -#: cobc/pplex.l:310 cobc/pplex.l:369 -#, c-format -msgid "ignoring invalid directive: '%s'" -msgstr "ignoring invalid directive: ‘%s’" - -#: cobc/pplex.l:317 -msgid "ignoring invalid directive" -msgstr "ignoring invalid directive" - -#: cobc/pplex.l:324 -msgid "VCS directive" -msgstr "VCS directive" - -#: cobc/pplex.l:377 cobc/pplex.l:392 -msgid "spurious '$' detected - ignored" -msgstr "spurious ‘$’ detected - ignored" - -#: cobc/pplex.l:386 -#, c-format -msgid "ignoring unknown directive: '%s'" -msgstr "ignoring unknown directive: ‘%s’" - -#: cobc/pplex.l:398 -msgid "PROCESS statement ignored" -msgstr "PROCESS statement ignored" - -#: cobc/pplex.l:864 -msgid "IF/ELIF/ELSE directive without matching END-IF" -msgstr "IF/ELIF/ELSE directive without matching END-IF" - -#: cobc/pplex.l:981 -msgid "file was included here" -msgstr "file was included here" - -#: cobc/pplex.l:1186 -#, c-format -msgid "directive nest depth exceeded: %d" -msgstr "directive nest depth exceeded: %d" - -#: cobc/pplex.l:1204 -msgid "ELSE directive without matching IF/ELIF" -msgstr "ELSE directive without matching IF/ELIF" - -#: cobc/pplex.l:1220 -msgid "END-IF directive without matching IF/ELIF/ELSE" -msgstr "END-IF directive without matching IF/ELIF/ELSE" - -#: cobc/pplex.l:1236 -msgid "ELIF directive without matching IF/ELIF" -msgstr "ELIF directive without matching IF/ELIF" - -#: cobc/pplex.l:1258 -#, c-format -msgid "invalid internal case: %u" -msgstr "invalid internal case: %u" - -#: cobc/pplex.l:1395 -msgid "buffer overrun - too many continuation lines" -msgstr "buffer overrun - too many continuation lines" - -#: cobc/pplex.l:1485 cobc/pplex.l:1494 -msgid "line not terminated by a newline" -msgstr "line not terminated by a newline" - -#: cobc/pplex.l:1488 cobc/pplex.l:1497 -#, c-format -msgid "source text exceeds %d bytes, will be truncated" -msgstr "source text exceeds %d bytes, will be truncated" - -#: cobc/pplex.l:1516 -msgid "version control conflict marker in file" -msgstr "version control conflict marker in file" - -#: cobc/pplex.l:1727 -msgid "invalid continuation in comment entry" -msgstr "invalid continuation in comment entry" - -#: cobc/pplex.l:1732 -msgid "continuation of COBOL words" -msgstr "continuation of COBOL words" - -#: cobc/pplex.l:1752 -#, c-format -msgid "invalid indicator '%c' at column 7" -msgstr "invalid indicator ‘%c’ at column 7" - -#: cobc/pplex.l:1800 cobc/pplex.l:1811 -msgid "invalid line continuation" -msgstr "invalid line continuation" - -#: cobc/pplex.l:1819 -msgid "continuation character expected" -msgstr "continuation character expected" - -#: cobc/pplex.l:1885 -#, c-format -msgid "source text after program-text area (column %d)" -msgstr "source text after program-text area (column %d)" - -#: cobc/ppparse.y:225 -msgid "directive comparison on different types" -msgstr "directive comparison on different types" - -#: cobc/ppparse.y:293 -#, c-format -msgid "duplicate DEFINE directive '%s'" -msgstr "duplicate DEFINE directive ‘%s’" - -#: cobc/ppparse.y:300 cobc/ppparse.y:310 -msgid "invalid constant in DEFINE directive" -msgstr "invalid constant in DEFINE directive" - -#: cobc/ppparse.y:408 -#, c-format -msgid "compiler flag '%s' unknown" -msgstr "compiler flag ‘%s’ unknown" - -#: cobc/ppparse.y:454 -#, c-format -msgid "invalid %s directive option '%s'" -msgstr "invalid %s directive option ‘%s’" - -#: cobc/ppparse.y:667 -msgid "*CONTROL statement" -msgstr "*CONTROL statement" - -#: cobc/ppparse.y:933 cobc/ppparse.y:1004 cobc/ppparse.y:1141 -#, c-format -msgid "invalid %s directive" -msgstr "invalid %s directive" - -#: cobc/ppparse.y:1043 -msgid "LEAP-SECOND ON directive" -msgstr "LEAP-SECOND ON directive" - -#: cobc/ppparse.y:1051 -msgid "TURN directive" -msgstr "TURN directive" - -#: cobc/ppparse.y:1133 cobc/ppparse.y:1158 -msgid "invalid constant" -msgstr "invalid constant" - -#: cobc/reserved.c:3797 -msgid "device name" -msgstr "device name" - -#: cobc/reserved.c:3800 -msgid "switch name" -msgstr "switch name" - -#: cobc/reserved.c:3803 -msgid "feature name" -msgstr "feature name" - -#: cobc/reserved.c:3902 -#, c-format -msgid "reserved word must have less than %d characters" -msgstr "reserved word must have less than %d characters" - -#: cobc/reserved.c:3921 -msgid "ignored asterisk at end of alias target" -msgstr "ignored asterisk at end of alias target" - -#: cobc/reserved.c:3984 -#, c-format -msgid "alias target '%s' is not a default reserved word" -msgstr "alias target ‘%s’ is not a default reserved word" - -#: cobc/reserved.c:4447 -#, c-format -msgid "invalid system-name '%s'" -msgstr "invalid system-name ‘%s’" - -#: cobc/reserved.c:4584 -#, c-format -msgid "'%s' is a reserved word, but isn't supported" -msgstr "‘%s’ is a reserved word, but isn't supported" - -#: cobc/reserved.c:4689 -#, c-format -msgid "intrinsic function %s is unknown" -msgstr "intrinsic function %s is unknown" - -#: cobc/reserved.c:4717 -msgid "Intrinsic Function" -msgstr "Intrinsic Function" - -#: cobc/reserved.c:4717 cobc/reserved.c:4897 cobc/reserved.c:5034 -msgid "Implemented" -msgstr "Implemented" - -#: cobc/reserved.c:4717 cobc/typeck.c:1022 -msgid "Parameters" -msgstr "Parameters" - -#: cobc/reserved.c:4721 cobc/reserved.c:4901 cobc/reserved.c:5048 -msgid "Yes" -msgstr "Yes" - -#: cobc/reserved.c:4724 cobc/reserved.c:4904 cobc/reserved.c:5054 -msgid "No" -msgstr "No" - -#: cobc/reserved.c:4730 -msgid "Unlimited" -msgstr "Unlimited" - -#: cobc/reserved.c:4804 -#, c-format -msgid "special register %s is unknown, needs a definition" -msgstr "special register %s is unknown, needs a definition" - -#: cobc/reserved.c:4810 -#, c-format -msgid "special register %s is unknown" -msgstr "special register %s is unknown" - -#: cobc/reserved.c:4897 -msgid "Internal registers" -msgstr "Internal registers" - -#: cobc/reserved.c:4897 -msgid "Definition" -msgstr "Definition" - -#: cobc/reserved.c:4985 -#, c-format -msgid "unknown system-name '%s'" -msgstr "unknown system-name ‘%s’" - -#: cobc/reserved.c:5011 -msgid "System names" -msgstr "System names" - -#: cobc/reserved.c:5034 -msgid "Reserved Words" -msgstr "Reserved Words" - -#: cobc/reserved.c:5046 -msgid "Yes (Context sensitive)" -msgstr "Yes (Context sensitive)" - -#: cobc/reserved.c:5052 -msgid "No (Context sensitive)" -msgstr "No (Context sensitive)" - -#: cobc/reserved.c:5081 -msgid "Extra (obsolete) context sensitive words" -msgstr "Extra (obsolete) context sensitive words" - -#: cobc/scanner.l:265 cobc/scanner.l:2288 -#, c-format -msgid "'%s' is not a default reserved word, so cannot be aliased" -msgstr "‘%s’ is not a default reserved word, so cannot be aliased" - -#: cobc/scanner.l:268 -#, c-format -msgid "'%s' is not a reserved word; you may want ADDSYN or OVERRIDE instead" -msgstr "‘%s’ is not a reserved word; you may want ADDSYN or OVERRIDE instead" - -#: cobc/scanner.l:988 -#, c-format -msgid "a constant may not be used here - '%s'" -msgstr "a constant may not be used here - ‘%s’" - -#: cobc/scanner.l:1043 -msgid "ignoring redundant ." -msgstr "ignoring redundant ." - -#: cobc/scanner.l:1101 -#, c-format -msgid "invalid symbol '%s' - skipping word" -msgstr "invalid symbol ‘%s’ - skipping word" - -#: cobc/scanner.l:1191 -msgid "invalid national literal" -msgstr "invalid national literal" - -#: cobc/scanner.l:1202 cobc/tree.c:2531 -#, c-format -msgid "invalid literal: '%s'" -msgstr "invalid literal: ‘%s’" - -#: cobc/scanner.l:1204 -#, c-format -msgid "invalid hexadecimal literal: '%s'" -msgstr "invalid hexadecimal literal: ‘%s’" - -#: cobc/scanner.l:1206 cobc/tree.c:1613 -#, c-format -msgid "invalid numeric literal: '%s'" -msgstr "invalid numeric literal: ‘%s’" - -#: cobc/scanner.l:1208 -#, c-format -msgid "invalid floating-point literal: '%s'" -msgstr "invalid floating-point literal: ‘%s’" - -#: cobc/scanner.l:1210 -#, c-format -msgid "invalid %s literal: '%s'" -msgstr "invalid %s literal: ‘%s’" - -#: cobc/scanner.l:1261 -#, c-format -msgid "literal length exceeds %d characters" -msgstr "literal length exceeds %d characters" - -#: cobc/scanner.l:1277 cobc/scanner.l:1326 cobc/scanner.l:1620 -msgid "zero-length literal" -msgstr "zero-length literal" - -#: cobc/scanner.l:1280 -msgid "national literal has zero length; a SPACE will be assumed" -msgstr "national literal has zero length; a SPACE will be assumed" - -#: cobc/scanner.l:1281 -msgid "alphanumeric literal has zero length; a SPACE will be assumed" -msgstr "alphanumeric literal has zero length; a SPACE will be assumed" - -#: cobc/scanner.l:1293 cobc/scanner.l:1294 cobc/scanner.l:1298 -#: cobc/scanner.l:1365 -msgid "national literal" -msgstr "national literal" - -#: cobc/scanner.l:1297 -msgid "national-character literal" -msgstr "national-character literal" - -#: cobc/scanner.l:1330 -msgid "hexadecimal literal has zero length; X'00' will be assumed" -msgstr "hexadecimal literal has zero length; X'00' will be assumed" - -#: cobc/scanner.l:1349 -msgid "hexadecimal-boolean literal" -msgstr "hexadecimal-boolean literal" - -#: cobc/scanner.l:1356 cobc/scanner.l:1370 cobc/scanner.l:1485 -#: cobc/scanner.l:1544 cobc/scanner.l:1642 cobc/scanner.l:1711 cobc/tree.c:2532 -#, c-format -msgid "literal length %d exceeds %d characters" -msgstr "literal length %d exceeds %d characters" - -#: cobc/scanner.l:1362 -msgid "hexadecimal-national literal" -msgstr "hexadecimal-national literal" - -#: cobc/scanner.l:1393 cobc/scanner.l:1425 cobc/scanner.l:1560 -#: cobc/scanner.l:1656 cobc/scanner.l:1721 -#, c-format -msgid "literal contains invalid character '%c'" -msgstr "literal contains invalid character ‘%c’" - -#: cobc/scanner.l:1449 -#, c-format -msgid "literal does not have an even number of digits" -msgstr "literal does not have an even number of digits" - -#: cobc/scanner.l:1492 -#, c-format -msgid "%s literals must contain at least one character" -msgstr "%s literals must contain at least one character" - -#: cobc/scanner.l:1527 cobc/scanner.l:1628 cobc/scanner.l:1702 -msgid "ACUCOBOL numeric literal" -msgstr "ACUCOBOL numeric literal" - -#: cobc/scanner.l:1537 -msgid "H literals must contain at least one character" -msgstr "H literals must contain at least one character" - -#: cobc/scanner.l:1575 cobc/scanner.l:1667 cobc/scanner.l:1732 -#, c-format -msgid "literal exceeds limit %u" -msgstr "literal exceeds limit %u" - -#: cobc/scanner.l:1616 -msgid "numeric boolean literal" -msgstr "numeric boolean literal" - -#: cobc/scanner.l:1622 -msgid "Boolean literal has zero length; B'0' will be assumed" -msgstr "Boolean literal has zero length; B'0' will be assumed" - -#: cobc/scanner.l:1698 -msgid "HP COBOL octal literal" -msgstr "HP COBOL octal literal" - -#: cobc/scanner.l:1810 cobc/tree.c:1624 -#, c-format -msgid "literal length %d exceeds maximum of %d digits" -msgstr "literal length %d exceeds maximum of %d digits" - -#: cobc/scanner.l:1816 cobc/tree.c:1629 -#, c-format -msgid "literal length %d exceeds %d digits" -msgstr "literal length %d exceeds %d digits" - -#: cobc/scanner.l:1928 cobc/tree.c:3513 -#, c-format -msgid "significand has more than %d digits" -msgstr "significand has more than %d digits" - -#: cobc/scanner.l:1933 -#, c-format -msgid "exponent has decimal point" -msgstr "exponent has decimal point" - -#: cobc/scanner.l:1939 cobc/tree.c:3521 -#, c-format -msgid "exponent has more than 4 digits" -msgstr "exponent has more than 4 digits" - -#: cobc/scanner.l:1969 -#, c-format -msgid "exponent not between -6143 and 6144" -msgstr "exponent not between -6143 and 6144" - -#: cobc/scanner.l:1978 -#, c-format -msgid "significand of 0 must be positive" -msgstr "significand of 0 must be positive" - -#: cobc/scanner.l:1983 -#, c-format -msgid "exponent of 0 must be 0" -msgstr "exponent of 0 must be 0" - -#: cobc/scanner.l:1988 -#, c-format -msgid "exponent of 0 must be positive" -msgstr "exponent of 0 must be positive" - -#: cobc/scanner.l:2170 -#, c-format -msgid "invalid CONSTANT: %s" -msgstr "invalid CONSTANT: %s" - -#: cobc/scanner.l:2180 -#, c-format -msgid "invalid alphanumeric CONSTANT: %s" -msgstr "invalid alphanumeric CONSTANT: %s" - -#: cobc/scanner.l:2184 -#, c-format -msgid "empty alphanumeric CONSTANT: %s" -msgstr "empty alphanumeric CONSTANT: %s" - -#: cobc/scanner.l:2201 cobc/scanner.l:2209 cobc/scanner.l:2214 -#, c-format -msgid "invalid numeric CONSTANT: %s" -msgstr "invalid numeric CONSTANT: %s" - -#: cobc/scanner.l:2291 -#, c-format -msgid "'%s' is already reserved; you may want MAKESYN instead" -msgstr "‘%s’ is already reserved; you may want MAKESYN instead" - -#: cobc/tree.c:341 -#, c-format -msgid "%s clause is required for file '%s'" -msgstr "%s clause is required for file ‘%s’" - -#: cobc/tree.c:345 -#, c-format -msgid "%s clause is invalid for file '%s' (file type)" -msgstr "%s clause is invalid for file ‘%s’ (file type)" - -#: cobc/tree.c:349 -#, c-format -msgid "%s clause is invalid for file '%s'" -msgstr "%s clause is invalid for file ‘%s’" - -#: cobc/tree.c:376 -#, c-format -msgid "FOR item '%s' is a record" -msgstr "FOR item ‘%s’ is a record" - -#: cobc/tree.c:385 -#, c-format -msgid "FOR item '%s' is in different record to '%s'" -msgstr "FOR item ‘%s’ is in different record to ‘%s’" - -#: cobc/tree.c:394 -#, c-format -msgid "FOR item '%s' is not in a record associated with '%s'" -msgstr "FOR item ‘%s’ is not in a record associated with ‘%s’" - -#: cobc/tree.c:477 -msgid "internal error node" -msgstr "internal error node" - -#: cobc/tree.c:479 -msgid "unknown constant" -msgstr "unknown constant" - -#: cobc/tree.c:639 -#, c-format -msgid "FUNCTION %s has invalid/not supported arguments - tag %d" -msgstr "FUNCTION %s has invalid/not supported arguments - tag %d" - -#: cobc/tree.c:760 -#, c-format -msgid "invalid date/time function: '%d'" -msgstr "invalid date/time function: ‘%d’" - -#: cobc/tree.c:798 -#, c-format -msgid "FUNCTION '%s' has invalid date/time format" -msgstr "FUNCTION ‘%s’ has invalid date/time format" - -#: cobc/tree.c:805 -#, c-format -msgid "FUNCTION '%s' has format in variable" -msgstr "FUNCTION ‘%s’ has format in variable" - -#: cobc/tree.c:1186 -#, c-format -msgid "literal '%s'" -msgstr "literal ‘%s’" - -#: cobc/tree.c:1315 -#, c-format -msgid "unknown tree tag: %d, category: %d" -msgstr "unknown tree tag: %d, category: %d" - -#: cobc/tree.c:1405 -#, c-format -msgid "unexpected numeric USAGE: %d" -msgstr "unexpected numeric USAGE: %d" - -#: cobc/tree.c:1419 -#, c-format -msgid "unexpected category: %d" -msgstr "unexpected category: %d" - -#: cobc/tree.c:1678 cobc/tree.c:1690 cobc/tree.c:1752 cobc/tree.c:1802 -#, c-format -msgid "numeric literal '%s' exceeds limit '%s'" -msgstr "numeric literal ‘%s’ exceeds limit ‘%s’" - -#: cobc/tree.c:2387 -msgid "invalid LOCALE literal" -msgstr "invalid LOCALE literal" - -#: cobc/tree.c:2512 -msgid "only literals with the same category can be concatenated" -msgstr "only literals with the same category can be concatenated" - -#: cobc/tree.c:2519 -msgid "only alphanumeric, national or boolean literals may be concatenated" -msgstr "only alphanumeric, national or boolean literals may be concatenated" - -#: cobc/tree.c:2791 -msgid "B, 0 or /" -msgstr "B, 0 or /" - -#: cobc/tree.c:2805 -msgid "the sign of the floating-point exponent" -msgstr "the sign of the floating-point exponent" - -#: cobc/tree.c:2807 -msgid "a leading +/- sign" -msgstr "a leading +/- sign" - -#: cobc/tree.c:2809 -msgid "a trailing +/- sign" -msgstr "a trailing +/- sign" - -#: cobc/tree.c:2811 -msgid "CR or DB" -msgstr "CR or DB" - -#: cobc/tree.c:2813 -msgid "a leading currency symbol" -msgstr "a leading currency symbol" - -#: cobc/tree.c:2815 -msgid "a trailing currency symbol" -msgstr "a trailing currency symbol" - -#: cobc/tree.c:2817 -msgid "a Z or * which is before the decimal point" -msgstr "a Z or * which is before the decimal point" - -#: cobc/tree.c:2819 -msgid "a Z or * which is after the decimal point" -msgstr "a Z or * which is after the decimal point" - -#: cobc/tree.c:2821 -msgid "a floating +/- string which is before the decimal point" -msgstr "a floating +/- string which is before the decimal point" - -#: cobc/tree.c:2823 -msgid "a floating +/- string which is after the decimal point" -msgstr "a floating +/- string which is after the decimal point" - -#: cobc/tree.c:2825 -msgid "a floating currency symbol string which is before the decimal point" -msgstr "a floating currency symbol string which is before the decimal point" - -#: cobc/tree.c:2827 -msgid "a floating currency symbol string which is after the decimal point" -msgstr "a floating currency symbol string which is after the decimal point" - -#: cobc/tree.c:2831 -msgid "A or X" -msgstr "A or X" - -#: cobc/tree.c:2837 -msgid "a P which is before the decimal point" -msgstr "a P which is before the decimal point" - -#: cobc/tree.c:2839 -msgid "a P which is after the decimal point" -msgstr "a P which is after the decimal point" - -#: cobc/tree.c:2860 cobc/tree.c:3267 -#, c-format -msgid "%s may only occur once in a PICTURE string" -msgstr "%s may only occur once in a PICTURE string" - -#: cobc/tree.c:2862 cobc/tree.c:3219 -#, c-format -msgid "%s cannot follow %s" -msgstr "%s cannot follow %s" - -#: cobc/tree.c:2865 -msgid "invalid PICTURE string detected" -msgstr "invalid PICTURE string detected" - -#: cobc/tree.c:2976 -msgid "number or constant in parentheses is not an unsigned integer" -msgstr "number or constant in parentheses is not an unsigned integer" - -#: cobc/tree.c:2985 -msgid "only up to 9 significant digits are permitted within parentheses" -msgstr "only up to 9 significant digits are permitted within parentheses" - -#: cobc/tree.c:2991 -msgid "number or constant in parentheses must be greater than zero" -msgstr "number or constant in parentheses must be greater than zero" - -#: cobc/tree.c:3002 -msgid "parentheses must be preceded by a picture symbol" -msgstr "parentheses must be preceded by a picture symbol" - -#: cobc/tree.c:3032 -msgid "unbalanced parentheses" -msgstr "unbalanced parentheses" - -#: cobc/tree.c:3040 -msgid "parentheses must contain an unsigned integer" -msgstr "parentheses must contain an unsigned integer" - -#: cobc/tree.c:3078 -#, c-format -msgid "'%s' is not a constant-name" -msgstr "‘%s’ is not a constant-name" - -#: cobc/tree.c:3085 -#, c-format -msgid "'%s' is not a numeric literal" -msgstr "‘%s’ is not a numeric literal" - -#: cobc/tree.c:3089 -#, c-format -msgid "'%s' is not an integer" -msgstr "‘%s’ is not an integer" - -#: cobc/tree.c:3093 -#, c-format -msgid "'%s' is not unsigned" -msgstr "‘%s’ is not unsigned" - -#: cobc/tree.c:3149 -msgid "missing PICTURE string" -msgstr "missing PICTURE string" - -#: cobc/tree.c:3178 -msgid "C must be followed by R" -msgstr "C must be followed by R" - -#: cobc/tree.c:3181 -msgid "D must be followed by B" -msgstr "D must be followed by B" - -#: cobc/tree.c:3195 cobc/tree.c:3264 cobc/tree.c:3290 cobc/tree.c:3401 -msgid "uncommon parentheses" -msgstr "uncommon parentheses" - -#: cobc/tree.c:3219 -msgid "exponent" -msgstr "exponent" - -#: cobc/tree.c:3272 -msgid "S must be at start of PICTURE string" -msgstr "S must be at start of PICTURE string" - -#: cobc/tree.c:3328 -msgid "P must be at start or end of PICTURE string" -msgstr "P must be at start or end of PICTURE string" - -#: cobc/tree.c:3358 -msgid "cannot have both Z and * in PICTURE string" -msgstr "cannot have both Z and * in PICTURE string" - -#: cobc/tree.c:3436 -#, c-format -msgid "invalid PICTURE character '%c'" -msgstr "invalid PICTURE character ‘%c’" - -#: cobc/tree.c:3466 -#, c-format -msgid "PICTURE string may not contain more than %d characters; contains %d characters" -msgstr "PICTURE string may not contain more than %d characters; contains %d characters" - -#: cobc/tree.c:3471 -msgid "PICTURE string must contain at least one of the set A, N, X, Z, 1, 9 and *; or at least two of the set +, - and the currency symbol" -msgstr "PICTURE string must contain at least one of the set A, N, X, Z, 1, 9 and *; or at least two of the set +, - and the currency symbol" - -#: cobc/tree.c:3498 -#, c-format -msgid "numeric field cannot be larger than %d digits" -msgstr "numeric field cannot be larger than %d digits" - -#: cobc/tree.c:3954 cobc/tree.c:3967 -#, c-format -msgid "no DETAIL line defined in report %s" -msgstr "no DETAIL line defined in report %s" - -#: cobc/tree.c:3969 -msgid "PAGE LIMIT FIRST DETAIL should be >= HEADING" -msgstr "PAGE LIMIT FIRST DETAIL should be >= HEADING" - -#: cobc/tree.c:3972 -msgid "PAGE LIMIT FOOTING should be >= HEADING" -msgstr "PAGE LIMIT FOOTING should be >= HEADING" - -#: cobc/tree.c:3974 -msgid "PAGE LIMIT LAST DETAIL should be >= FIRST DETAIL" -msgstr "PAGE LIMIT LAST DETAIL should be >= FIRST DETAIL" - -#: cobc/tree.c:3976 -msgid "PAGE LIMIT FOOTING should be >= LAST DETAIL" -msgstr "PAGE LIMIT FOOTING should be >= LAST DETAIL" - -#: cobc/tree.c:3978 -msgid "PAGE LIMIT LINES should be >= FOOTING" -msgstr "PAGE LIMIT LINES should be >= FOOTING" - -#: cobc/tree.c:4162 -#, c-format -msgid "maximum keys (%d/%d) exceeded for file '%s'" -msgstr "maximum keys (%d/%d) exceeded for file ‘%s’" - -#: cobc/tree.c:4226 cobc/tree.c:4249 -#, c-format -msgid "invalid KEY item '%s', not in file '%s'" -msgstr "invalid KEY item '%s', not in file ‘%s’" - -#: cobc/tree.c:4260 -#, c-format -msgid "minimal record length %d can not hold the key item '%s'; needs to be at least %d" -msgstr "minimal record length %d can not hold the key item '%s'; needs to be at least %d" - -#: cobc/tree.c:4296 -#, c-format -msgid "missing file description for %s" -msgstr "missing file description for %s" - -#: cobc/tree.c:4328 -#, c-format -msgid "size of record '%s' (%d) smaller than minimum of file '%s' (%d)" -msgstr "size of record ‘%s’ (%d) smaller than minimum of file ‘%s’ (%d)" - -#: cobc/tree.c:4331 cobc/tree.c:4348 -msgid "file size adjusted" -msgstr "file size adjusted" - -#: cobc/tree.c:4343 -#, c-format -msgid "size of record '%s' (%d) larger than maximum of file '%s' (%d)" -msgstr "size of record ‘%s’ (%d) larger than maximum of file ‘%s’ (%d)" - -#: cobc/tree.c:4386 -#, c-format -msgid "file '%s': RECORD VARYING specified without limits, but implied limits are equal" -msgstr "file '%s': RECORD VARYING specified without limits, but implied limits are equal" - -#: cobc/tree.c:4393 -#, c-format -msgid "file '%s': record size (IDX) %d exceeds maximum allowed (%d)" -msgstr "file '%s': record size (IDX) %d exceeds maximum allowed (%d)" - -#: cobc/tree.c:4397 -#, c-format -msgid "file '%s': record size %d exceeds maximum allowed (%d)" -msgstr "file '%s': record size %d exceeds maximum allowed (%d)" - -#: cobc/tree.c:4404 -msgid "RECORD DELIMITER clause on file with fixed-length records" -msgstr "RECORD DELIMITER clause on file with fixed-length records" - -#: cobc/tree.c:4965 -#, c-format -msgid "literal '%.38s' is longer than '%s'" -msgstr "literal ‘%.38s’ is longer than ‘%s’" - -#: cobc/tree.c:4969 -#, c-format -msgid "literal '%.38s' is longer than reference-modification of '%s'" -msgstr "literal ‘%.38s’ is longer than reference-modification of ‘%s’" - -#: cobc/tree.c:4994 -#, c-format -msgid "literal '%s' is alphanumeric but '%s' is numeric" -msgstr "literal ‘%s’ is alphanumeric but ‘%s’ is numeric" - -#: cobc/tree.c:5036 -#, c-format -msgid "literal '%s' has more decimals than '%s'" -msgstr "literal ‘%s’ has more decimals than ‘%s’" - -#: cobc/tree.c:5078 -#, c-format -msgid "literal '%s' has more digits than '%s'" -msgstr "literal ‘%s’ has more digits than ‘%s’" - -#: cobc/tree.c:5118 cobc/tree.c:5142 -#, c-format -msgid "unsigned '%s' may not be %s %s" -msgstr "unsigned ‘%s’ may not be %s %s" - -#: cobc/tree.c:5128 cobc/tree.c:5151 -#, c-format -msgid "unsigned '%s' may always be %s %s" -msgstr "unsigned ‘%s’ may always be %s %s" - -#: cobc/tree.c:5184 cobc/tree.c:5209 -#, c-format -msgid "'%s' may not be %s %s" -msgstr "‘%s’ may not be %s %s" - -#: cobc/tree.c:5195 cobc/tree.c:5220 -#, c-format -msgid "'%s' may always be %s %s" -msgstr "‘%s’ may always be %s %s" - -#: cobc/tree.c:5355 -msgid "divide by constant ZERO" -msgstr "divide by constant ZERO" - -#: cobc/tree.c:5404 cobc/tree.c:5409 cobc/tree.c:5630 cobc/tree.c:5670 -#: cobc/typeck.c:4476 cobc/typeck.c:4484 cobc/typeck.c:4491 cobc/typeck.c:5561 -#: cobc/typeck.c:5706 -msgid "invalid expression" -msgstr "invalid expression" - -#: cobc/tree.c:5627 -#, c-format -msgid "invalid expression: %s %s %s" -msgstr "invalid expression: %s %s %s" - -#: cobc/tree.c:5675 -#, c-format -msgid "unexpected operator: %d" -msgstr "unexpected operator: %d" - -#: cobc/tree.c:5685 -#, c-format -msgid "expression '%.38s' %s '%.38s' is always TRUE" -msgstr "expression ‘%.38s’ %s ‘%.38s’ is always TRUE" - -#: cobc/tree.c:5691 -msgid "expression is always TRUE" -msgstr "expression is always TRUE" - -#: cobc/tree.c:5703 -#, c-format -msgid "expression '%.38s' %s '%.38s' is always FALSE" -msgstr "expression ‘%.38s’ %s ‘%.38s’ is always FALSE" - -#: cobc/tree.c:5709 -msgid "expression is always FALSE" -msgstr "expression is always FALSE" - -#: cobc/tree.c:6024 -msgid "PERFORM FOREVER since UNTIL is always FALSE" -msgstr "PERFORM FOREVER since UNTIL is always FALSE" - -#: cobc/tree.c:6028 -msgid "PERFORM ONCE since UNTIL is always TRUE" -msgstr "PERFORM ONCE since UNTIL is always TRUE" - -#: cobc/tree.c:6031 -msgid "PERFORM NEVER since UNTIL is always TRUE" -msgstr "PERFORM NEVER since UNTIL is always TRUE" - -#: cobc/tree.c:6132 -#, c-format -msgid "no definition/prototype seen for FUNCTION '%s'" -msgstr "no definition/prototype seen for FUNCTION ‘%s’" - -#: cobc/tree.c:6134 -#, c-format -msgid "no definition/prototype seen for PROGRAM '%s'" -msgstr "no definition/prototype seen for PROGRAM ‘%s’" - -#: cobc/tree.c:6143 -#, c-format -msgid "no definition/prototype seen for FUNCTION with external name '%s'" -msgstr "no definition/prototype seen for FUNCTION with external name ‘%s’" - -#: cobc/tree.c:6145 -#, c-format -msgid "no definition/prototype seen for PROGRAM with external name '%s'" -msgstr "no definition/prototype seen for PROGRAM with external name ‘%s’" - -#: cobc/tree.c:6237 -#, c-format -msgid "FUNCTION %s has invalid argument" -msgstr "FUNCTION %s has invalid argument" - -#: cobc/tree.c:6239 -#, c-format -msgid "either all arguments or none should be if type %s" -msgstr "either all arguments or none should be if type %s" - -#: cobc/tree.c:6271 cobc/tree.c:6277 cobc/tree.c:6319 cobc/tree.c:6324 -#, c-format -msgid "FUNCTION '%s' has invalid reference modification" -msgstr "FUNCTION ‘%s’ has invalid reference modification" - -#: cobc/tree.c:6288 cobc/tree.c:6730 -#, c-format -msgid "FUNCTION '%s' unknown" -msgstr "FUNCTION ‘%s’ unknown" - -#: cobc/tree.c:6292 -#, c-format -msgid "FUNCTION '%s' is not implemented" -msgstr "FUNCTION ‘%s’ is not implemented" - -#: cobc/tree.c:6299 cobc/tree.c:6306 cobc/tree.c:6714 -#, c-format -msgid "FUNCTION '%s' has wrong number of arguments" -msgstr "FUNCTION ‘%s’ has wrong number of arguments" - -#: cobc/tree.c:6313 -#, c-format -msgid "FUNCTION '%s' cannot have reference modification" -msgstr "FUNCTION ‘%s’ cannot have reference modification" - -#: cobc/tree.c:6572 cobc/tree.c:6646 cobc/tree.c:6652 cobc/tree.c:6660 -#: cobc/tree.c:6668 -#, c-format -msgid "FUNCTION '%s' has invalid argument" -msgstr "FUNCTION ‘%s’ has invalid argument" - -#: cobc/tree.c:6720 -#, c-format -msgid "FUNCTION '%s' has invalid first argument" -msgstr "FUNCTION ‘%s’ has invalid first argument" - -#: cobc/typeck.c:686 -#, c-format -msgid "%s item not allowed here: '%s'" -msgstr "%s item not allowed here: ‘%s’" - -#: cobc/typeck.c:728 -#, c-format -msgid "'%s' is not a group name" -msgstr "‘%s’ is not a group name" - -#: cobc/typeck.c:753 -#, c-format -msgid "'%s' is not a numeric name" -msgstr "‘%s’ is not a numeric name" - -#: cobc/typeck.c:782 -#, c-format -msgid "'%s' is not a numeric or numeric-edited name" -msgstr "‘%s’ is not a numeric or numeric-edited name" - -#: cobc/typeck.c:835 -#, c-format -msgid "'%s' is Alpha, instead of a numeric value" -msgstr "‘%s’ is Alpha, instead of a numeric value" - -#: cobc/typeck.c:838 -#, c-format -msgid "'%s' is Alpha Edited, instead of a numeric value" -msgstr "‘%s’ is Alpha Edited, instead of a numeric value" - -#: cobc/typeck.c:851 -#, c-format -msgid "'%s' is not a numeric value" -msgstr "‘%s’ is not a numeric value" - -#: cobc/typeck.c:901 -#, c-format -msgid "'%s' is not an integer value" -msgstr "‘%s’ is not an integer value" - -#: cobc/typeck.c:905 -msgid "positive numeric integer is required here" -msgstr "positive numeric integer is required here" - -#: cobc/typeck.c:1022 -msgid "System routine" -msgstr "System routine" - -#: cobc/typeck.c:1638 libcob/call.c:1069 -#, c-format -msgid "'%s' literal includes leading spaces which are omitted" -msgstr "‘%s’ literal includes leading spaces which are omitted" - -#: cobc/typeck.c:1642 -#, c-format -msgid "'%s' literal includes trailing spaces which are omitted" -msgstr "‘%s’ literal includes trailing spaces which are omitted" - -#: cobc/typeck.c:1709 -msgid "ON/OFF usage requires a SWITCH name" -msgstr "ON/OFF usage requires a SWITCH name" - -#: cobc/typeck.c:1727 -#, c-format -msgid "word length exceeds maximum of %d characters: '%s'" -msgstr "word length exceeds maximum of %d characters: ‘%s’" - -#: cobc/typeck.c:1730 cobc/typeck.c:1733 -#, c-format -msgid "word length exceeds %d characters: '%s'" -msgstr "word length exceeds %d characters: ‘%s’" - -#: cobc/typeck.c:1810 -#, c-format -msgid "ASSIGN %s interpreted as '%s'" -msgstr "ASSIGN %s interpreted as ‘%s’" - -#: cobc/typeck.c:1900 cobc/typeck.c:2067 -#, c-format -msgid "subscript missing for '%s' - defaulting to 1" -msgstr "subscript missing for ‘%s’ - defaulting to 1" - -#: cobc/typeck.c:1913 cobc/typeck.c:1992 -#, c-format -msgid "'%s' cannot be reference modified" -msgstr "‘%s’ cannot be reference modified" - -#: cobc/typeck.c:1923 cobc/typeck.c:1988 cobc/typeck.c:2256 -#, c-format -msgid "'%s' cannot be subscripted" -msgstr "‘%s’ cannot be subscripted" - -#: cobc/typeck.c:1927 cobc/typeck.c:2260 -#, c-format -msgid "'%s' requires one subscript" -msgstr "‘%s’ requires one subscript" - -#: cobc/typeck.c:1930 cobc/typeck.c:2263 -#, c-format -msgid "'%s' requires %d subscripts" -msgstr "‘%s’ requires %d subscripts" - -#. TRANSLATORS: This msgid is used when a variable name -#. or label is referenced in a compiler message. -#: cobc/typeck.c:1946 -#, c-format -msgid "'%s'" -msgstr "'%s'" - -#: cobc/typeck.c:1948 -#, c-format -msgid "'%s' (accessed by '%s')" -msgstr "‘%s’ (accessed by '%s')" - -#: cobc/typeck.c:2051 -#, c-format -msgid "'%s' has no OCCURS clause" -msgstr "‘%s’ has no OCCURS clause" - -#: cobc/typeck.c:2108 libcob/common.c:3114 -#, c-format -msgid "subscript of '%s' out of bounds: %d" -msgstr "subscript of ‘%s’ out of bounds: %d" - -#: cobc/typeck.c:2162 cobc/typeck.c:2172 -msgid "offset must be greater than zero" -msgstr "offset must be greater than zero" - -#: cobc/typeck.c:2167 cobc/typeck.c:2185 cobc/typeck.c:2204 -msgid "length must be greater than zero" -msgstr "length must be greater than zero" - -#: cobc/typeck.c:2175 cobc/typeck.c:2178 libcob/common.c:3136 -#, c-format -msgid "offset of '%s' out of bounds: %d" -msgstr "offset of ‘%s’ out of bounds: %d" - -#: cobc/typeck.c:2189 cobc/typeck.c:2193 cobc/typeck.c:2207 cobc/typeck.c:2211 -#: libcob/common.c:3149 -#, c-format -msgid "length of '%s' out of bounds: %d" -msgstr "length of ‘%s’ out of bounds: %d" - -#: cobc/typeck.c:2323 cobc/typeck.c:2407 -msgid "reference modification not allowed here" -msgstr "reference modification not allowed here" - -#: cobc/typeck.c:2337 cobc/typeck.c:2433 -msgid "88 level item not allowed here" -msgstr "88 level item not allowed here" - -#: cobc/typeck.c:2342 -#, c-format -msgid "LENGTH OF '%s' not allowed outside of Procedure Division" -msgstr "LENGTH OF ‘%s’ not allowed outside of Procedure Division" - -#: cobc/typeck.c:2346 cobc/typeck.c:2437 cobc/typeck.c:2445 cobc/typeck.c:2512 -msgid "variable length item not allowed here" -msgstr "variable length item not allowed here" - -#: cobc/typeck.c:2375 -#, c-format -msgid "'%s' has not been DEFINEd" -msgstr "‘%s’ has not been DEFINEd" - -#: cobc/typeck.c:2411 -msgid "only field names allowed here" -msgstr "only field names allowed here" - -#: cobc/typeck.c:2422 -#, c-format -msgid "VALUE of '%s': %s target '%s' is invalid" -msgstr "VALUE of '%s': %s target ‘%s’ is invalid" - -#: cobc/typeck.c:2424 cobc/typeck.c:2494 -msgid "target must be in FILE SECTION or LINKAGE SECTION or have the EXTERNAL clause" -msgstr "target must be in FILE SECTION or LINKAGE SECTION or have the EXTERNAL clause" - -#: cobc/typeck.c:2480 cobc/typeck.c:2493 -#, c-format -msgid "VALUE of '%s': %s target is invalid" -msgstr "VALUE of '%s': %s target is invalid" - -#: cobc/typeck.c:2482 -msgid "no previous data-item found" -msgstr "no previous data-item found" - -#: cobc/typeck.c:2667 -#, c-format -msgid "'%s' is not an alphabet name" -msgstr "‘%s’ is not an alphabet name" - -#: cobc/typeck.c:2931 -#, c-format -msgid "duplicate character values in alphabet '%s': %s" -msgstr "duplicate character values in alphabet '%s': %s" - -#: cobc/typeck.c:2936 -#, c-format -msgid "invalid character values in alphabet '%s', starting at position %d" -msgstr "invalid character values in alphabet '%s', starting at position %d" - -#: cobc/typeck.c:2990 -msgid "invalid ALPHABET name" -msgstr "invalid ALPHABET name" - -#: cobc/typeck.c:3054 -#, c-format -msgid "duplicate character values in class '%s'" -msgstr "duplicate character values in class ‘%s’" - -#: cobc/typeck.c:3072 -#, c-format -msgid "'%s' is not a locale name" -msgstr "‘%s’ is not a locale name" - -#: cobc/typeck.c:3206 -msgid "invalid RECORD DEPENDING item" -msgstr "invalid RECORD DEPENDING item" - -#: cobc/typeck.c:3211 -msgid "RECORD DEPENDING must reference a data-item" -msgstr "RECORD DEPENDING must reference a data-item" - -#: cobc/typeck.c:3234 -#, c-format -msgid "RECORD DEPENDING item '%s' should be defined in WORKING-STORAGE, LOCAL-STORAGE or LINKAGE SECTION" -msgstr "RECORD DEPENDING item ‘%s’ should be defined in WORKING-STORAGE, LOCAL-STORAGE or LINKAGE SECTION" - -#: cobc/typeck.c:3247 -#, c-format -msgid "file %s: RELATIVE KEY %s is not numeric" -msgstr "file %s: RELATIVE KEY %s is not numeric" - -#: cobc/typeck.c:3256 -#, c-format -msgid "file %s: RELATIVE KEY %s must be integer" -msgstr "file %s: RELATIVE KEY %s must be integer" - -#: cobc/typeck.c:3261 -#, c-format -msgid "file %s: RELATIVE KEY %s must be unsigned" -msgstr "file %s: RELATIVE KEY %s must be unsigned" - -#: cobc/typeck.c:3268 -#, c-format -msgid "file %s: RELATIVE KEY %s cannot have OCCURS" -msgstr "file %s: RELATIVE KEY %s cannot have OCCURS" - -#: cobc/typeck.c:3274 -#, c-format -msgid "RELATIVE KEY %s cannot be in file record belonging to %s" -msgstr "RELATIVE KEY %s cannot be in file record belonging to %s" - -#: cobc/typeck.c:3283 -#, c-format -msgid "file %s: RELATIVE KEY %s declared outside WORKING-STORAGE" -msgstr "file %s: RELATIVE KEY %s declared outside WORKING-STORAGE" - -#: cobc/typeck.c:3306 cobc/typeck.c:7184 -#, c-format -msgid "'%s' is not a valid data name" -msgstr "‘%s’ is not a valid data name" - -#: cobc/typeck.c:3313 -#, c-format -msgid "CRT STATUS item '%s' should be defined in WORKING-STORAGE or LOCAL-STORAGE" -msgstr "CRT STATUS item ‘%s’ should be defined in WORKING-STORAGE or LOCAL-STORAGE" - -#: cobc/typeck.c:3319 -#, c-format -msgid "'%s' CRT STATUS must have at least 4 digits" -msgstr "‘%s’ CRT STATUS must have at least 4 digits" - -#: cobc/typeck.c:3325 -#, c-format -msgid "'%s' CRT STATUS must be 4 characters long" -msgstr "‘%s’ CRT STATUS must be 4 characters long" - -#: cobc/typeck.c:3341 -#, c-format -msgid "variable '%s' will be implicitly defined" -msgstr "variable ‘%s’ will be implicitly defined" - -#: cobc/typeck.c:3375 cobc/typeck.c:3438 -msgid "ASSIGN variable" -msgstr "ASSIGN variable" - -#: cobc/typeck.c:3443 -#, c-format -msgid "ASSIGN data item '%s' is invalid" -msgstr "ASSIGN data item ‘%s’ is invalid" - -#: cobc/typeck.c:3507 -#, c-format -msgid "'%s' CURSOR must be 4 or 6 characters long" -msgstr "‘%s’ CURSOR must be 4 or 6 characters long" - -#: cobc/typeck.c:3557 cobc/typeck.c:3561 -#, c-format -msgid "%s does not have a fixed location" -msgstr "%s does not have a fixed location" - -#: cobc/typeck.c:3573 -#, c-format -msgid "'%s' cannot have nested OCCURS DEPENDING" -msgstr "‘%s’ cannot have nested OCCURS DEPENDING" - -#: cobc/typeck.c:3587 -#, c-format -msgid "'%s' OCCURS DEPENDING ON field item invalid here" -msgstr "‘%s’ OCCURS DEPENDING ON field item invalid here" - -#: cobc/typeck.c:3595 -#, c-format -msgid "'%s' cannot have OCCURS DEPENDING because of '%s'" -msgstr "‘%s’ cannot have OCCURS DEPENDING because of ‘%s’" - -#: cobc/typeck.c:3607 -#, c-format -msgid "'%s' OCCURS DEPENDING ON item must have GLOBAL attribute" -msgstr "‘%s’ OCCURS DEPENDING ON item must have GLOBAL attribute" - -#: cobc/typeck.c:3621 -#, c-format -msgid "PASSWORD '%s' for EXTERNAL file '%s' must have EXTERNAL attribute" -msgstr "PASSWORD ‘%s’ for EXTERNAL file ‘%s’ must have EXTERNAL attribute" - -#: cobc/typeck.c:3644 -#, c-format -msgid "file %s: ASSIGN %s declared outside WORKING-STORAGE" -msgstr "file %s: ASSIGN %s declared outside WORKING-STORAGE" - -#: cobc/typeck.c:3674 -#, c-format -msgid "duplicate APPLY COMMIT target: '%s'" -msgstr "duplicate APPLY COMMIT target: ‘%s’" - -#: cobc/typeck.c:3688 -msgid "APPLY COMMIT statement invalid for SORT file" -msgstr "APPLY COMMIT statement invalid for SORT file" - -#: cobc/typeck.c:3691 -msgid "APPLY COMMIT statement invalid for REPORT file" -msgstr "APPLY COMMIT statement invalid for REPORT file" - -#: cobc/typeck.c:3698 -#, c-format -msgid "APPLY COMMIT item '%s' should be defined in WORKING-STORAGE or LOCAL-STORAGE" -msgstr "APPLY COMMIT item ‘%s’ should be defined in WORKING-STORAGE or LOCAL-STORAGE" - -#: cobc/typeck.c:3712 -#, c-format -msgid "item not allowed here: '%s'" -msgstr "item not allowed here: ‘%s’" - -#: cobc/typeck.c:3725 -#, c-format -msgid "%s may not be subscripted" -msgstr "%s may not be subscripted" - -#: cobc/typeck.c:3729 -#, c-format -msgid "%s may not be reference modified" -msgstr "%s may not be reference modified" - -#: cobc/typeck.c:3789 -#, c-format -msgid "DEBUGGING target invalid: '%s'" -msgstr "DEBUGGING target invalid: ‘%s’" - -#: cobc/typeck.c:3795 -#, c-format -msgid "DEBUGGING target already specified with ALL PROCEDURES: '%s'" -msgstr "DEBUGGING target already specified with ALL PROCEDURES: ‘%s’" - -#: cobc/typeck.c:3815 -msgid "DEBUGGING target" -msgstr "DEBUGGING target" - -#: cobc/typeck.c:3822 -#, c-format -msgid "'%s' is not a valid DEBUGGING target" -msgstr "‘%s’ is not a valid DEBUGGING target" - -#: cobc/typeck.c:3860 cobc/typeck.c:3865 -#, c-format -msgid "'%s' is not in DECLARATIVES" -msgstr "‘%s’ is not in DECLARATIVES" - -#: cobc/typeck.c:3877 -#, c-format -msgid "invalid reference to '%s' (in DECLARATIVES)" -msgstr "invalid reference to ‘%s’ (in DECLARATIVES)" - -#: cobc/typeck.c:3886 -#, c-format -msgid "'%s' is not a procedure name" -msgstr "‘%s’ is not a procedure name" - -#: cobc/typeck.c:3948 -#, c-format -msgid "LINKAGE item '%s' is not a PROCEDURE USING parameter" -msgstr "LINKAGE item ‘%s’ is not a PROCEDURE USING parameter" - -#: cobc/typeck.c:4001 -#, c-format -msgid "'%s' is not an alterable paragraph" -msgstr "‘%s’ is not an alterable paragraph" - -#: cobc/typeck.c:4604 cobc/typeck.c:4608 -#, c-format -msgid "suggest parentheses around %s within %s" -msgstr "suggest parentheses around %s within %s" - -#: cobc/typeck.c:4616 -msgid "invalid conditional expression" -msgstr "invalid conditional expression" - -#: cobc/typeck.c:4726 -#, c-format -msgid "internal decimal structure size exceeded: %d" -msgstr "internal decimal structure size exceeded: %d" - -#: cobc/typeck.c:4729 -msgid "Try to minimize the number of parentheses or split into multiple computations." -msgstr "Try to minimize the number of parentheses or split into multiple computations." - -#: cobc/typeck.c:4753 -#, c-format -msgid "more than %d nested expressions" -msgstr "more than %d nested expressions" - -#: cobc/typeck.c:4795 -msgid "precision of result may change with arithmetic-osvs" -msgstr "precision of result may change with arithmetic-osvs" - -#: cobc/typeck.c:4851 -#, c-format -msgid "unexpected operation: %c (%d)" -msgstr "unexpected operation: %c (%d)" - -#: cobc/typeck.c:4856 -#, c-format -msgid "%s operator may be misplaced" -msgstr "%s operator may be misplaced" - -#: cobc/typeck.c:4926 -msgid "unexpected constant expansion" -msgstr "unexpected constant expansion" - -#: cobc/typeck.c:5747 -#, c-format -msgid "more than %d nested conditions" -msgstr "more than %d nested conditions" - -#: cobc/typeck.c:6104 cobc/typeck.c:6180 -msgid "no CORRESPONDING items found" -msgstr "no CORRESPONDING items found" - -#: cobc/typeck.c:6252 -msgid "no items to ACCEPT found" -msgstr "no items to ACCEPT found" - -#: cobc/typeck.c:6302 -msgid "no items to DISPLAY found" -msgstr "no items to DISPLAY found" - -#: cobc/typeck.c:6421 -msgid "cannot specify figurative constant ZERO in AT clause" -msgstr "cannot specify figurative constant ZERO in AT clause" - -#: cobc/typeck.c:6425 -msgid "value in AT clause is not numeric" -msgstr "value in AT clause is not numeric" - -#: cobc/typeck.c:6431 -msgid "value in AT clause must have 4 or 6 digits" -msgstr "value in AT clause must have 4 or 6 digits" - -#: cobc/typeck.c:6553 -msgid "invalid PROMPT literal" -msgstr "invalid PROMPT literal" - -#: cobc/typeck.c:6558 -msgid "invalid PROMPT identifier" -msgstr "invalid PROMPT identifier" - -#: cobc/typeck.c:6848 -#, c-format -msgid "'%s' is not an input device" -msgstr "‘%s’ is not an input device" - -#: cobc/typeck.c:6878 cobc/typeck.c:8016 -#, c-format -msgid "'%s' is not defined in SPECIAL-NAMES" -msgstr "‘%s’ is not defined in SPECIAL-NAMES" - -#: cobc/typeck.c:6883 -#, c-format -msgid "invalid input device '%s'" -msgstr "invalid input device ‘%s’" - -#: cobc/typeck.c:6888 cobc/typeck.c:8020 -#, c-format -msgid "unknown device '%s'; it may exist in another dialect" -msgstr "unknown device '%s'; it may exist in another dialect" - -#: cobc/typeck.c:6891 cobc/typeck.c:8023 -#, c-format -msgid "unknown device '%s'; not defined in SPECIAL-NAMES" -msgstr "unknown device '%s'; not defined in SPECIAL-NAMES" - -#: cobc/typeck.c:6915 -msgid "target of ALLOCATE is not a BASED item" -msgstr "target of ALLOCATE is not a BASED item" - -#: cobc/typeck.c:6926 -msgid "target of RETURNING is not a data pointer" -msgstr "target of RETURNING is not a data pointer" - -#: cobc/typeck.c:6936 cobc/typeck.c:7342 -msgid "amount must be specified as a numeric expression" -msgstr "amount must be specified as a numeric expression" - -#: cobc/typeck.c:6949 -msgid "INITIALIZED TO item is not alphanumeric" -msgstr "INITIALIZED TO item is not alphanumeric" - -#: cobc/typeck.c:7019 -msgid "only alphanumeric FUNCTION types are allowed here" -msgstr "only alphanumeric FUNCTION types are allowed here" - -#: cobc/typeck.c:7027 -msgid "invalid RETURNING field" -msgstr "invalid RETURNING field" - -#: cobc/typeck.c:7046 -msgid "STDCALL not available on this platform" -msgstr "STDCALL not available on this platform" - -#: cobc/typeck.c:7050 -msgid "STDCALL used on 64-bit Windows platform" -msgstr "STDCALL used on 64-bit Windows platform" - -#: cobc/typeck.c:7055 -msgid "STATIC CALL convention requires a literal program name" -msgstr "STATIC CALL convention requires a literal program name" - -#: cobc/typeck.c:7060 cobc/typeck.c:10632 cobc/typeck.c:11539 -#: cobc/typeck.c:11903 -msgid "HANDLE must be either a generic or a THREAD HANDLE" -msgstr "HANDLE must be either a generic or a THREAD HANDLE" - -#: cobc/typeck.c:7078 -msgid "numeric literal is negative" -msgstr "numeric literal is negative" - -#: cobc/typeck.c:7157 -msgid "numeric literal exceeds size limits" -msgstr "numeric literal exceeds size limits" - -#: cobc/typeck.c:7175 -#, c-format -msgid "figurative constant %s invalid here" -msgstr "figurative constant %s invalid here" - -#: cobc/typeck.c:7190 -#, c-format -msgid "'%s' ANY LENGTH item not passed BY REFERENCE" -msgstr "‘%s’ ANY LENGTH item not passed BY REFERENCE" - -#: cobc/typeck.c:7198 -#, c-format -msgid "'%s' is not a 01 or 77 level item" -msgstr "‘%s’ is not a 01 or 77 level item" - -#: cobc/typeck.c:7228 cobc/typeck.c:7233 -#, c-format -msgid "wrong number of CALL parameters for '%s', %d given, %d expected" -msgstr "wrong number of CALL parameters for '%s', %d given, %d expected" - -#: cobc/typeck.c:7300 cobc/typeck.c:7374 cobc/typeck.c:7378 cobc/typeck.c:7382 -#: cobc/typeck.c:7412 cobc/typeck.c:10591 cobc/typeck.c:10755 -#: cobc/typeck.c:10944 cobc/typeck.c:10948 cobc/typeck.c:11844 -#: cobc/typeck.c:12087 cobc/typeck.c:12090 -#, c-format -msgid "%s not allowed on %s files" -msgstr "%s not allowed on %s files" - -#: cobc/typeck.c:7336 -msgid "AFTER phrase in CONTINUE statement" -msgstr "AFTER phrase in CONTINUE statement" - -#: cobc/typeck.c:7478 -msgid "positions cannot be specified for main windows" -msgstr "positions cannot be specified for main windows" - -#: cobc/typeck.c:7488 cobc/typeck.c:7491 cobc/typeck.c:7508 -msgid "HANDLE must be either a generic or a WINDOW HANDLE or X(10)" -msgstr "HANDLE must be either a generic or a WINDOW HANDLE or X(10)" - -#: cobc/typeck.c:7617 -#, c-format -msgid "'%s' is an invalid type for DISPLAY operand" -msgstr "‘%s’ is an invalid type for DISPLAY operand" - -#: cobc/typeck.c:7622 -msgid "invalid type for DISPLAY operand" -msgstr "invalid type for DISPLAY operand" - -#: cobc/typeck.c:7973 cobc/typeck.c:8006 -#, c-format -msgid "'%s' is not an output device" -msgstr "‘%s’ is not an output device" - -#: cobc/typeck.c:8109 -msgid "invalid use of 88 level in WHEN expression" -msgstr "invalid use of 88 level in WHEN expression" - -#: cobc/typeck.c:8165 -msgid "wrong number of WHEN parameters" -msgstr "wrong number of WHEN parameters" - -#: cobc/typeck.c:8244 cobc/typeck.c:8256 -#, c-format -msgid "target %d of FREE is not a BASED data item" -msgstr "target %d of FREE is not a BASED data item" - -#: cobc/typeck.c:8262 -#, c-format -msgid "target %d of FREE must be a data pointer" -msgstr "target %d of FREE must be a data pointer" - -#: cobc/typeck.c:8276 -msgid "GO TO without procedure-name" -msgstr "GO TO without procedure-name" - -#: cobc/typeck.c:8286 -msgid "GO TO with multiple procedure-names" -msgstr "GO TO with multiple procedure-names" - -#: cobc/typeck.c:8308 -msgid "GO TO ENTRY with multiple entry-names" -msgstr "GO TO ENTRY with multiple entry-names" - -#: cobc/typeck.c:8367 -msgid "invalid INITIALIZE statement" -msgstr "invalid INITIALIZE statement" - -#: cobc/typeck.c:8443 cobc/typeck.c:8446 -#, c-format -msgid "%s operands differ in size" -msgstr "%s operands differ in size" - -#: cobc/typeck.c:8476 -#, c-format -msgid "unexpected clause %d" -msgstr "unexpected clause %d" - -#: cobc/typeck.c:8545 cobc/typeck.c:8556 cobc/typeck.c:8567 cobc/typeck.c:8578 -#, c-format -msgid "data name expected before %s" -msgstr "data name expected before %s" - -#: cobc/typeck.c:8588 -#, c-format -msgid "ALL, LEADING or TRAILING expected before '%s'" -msgstr "ALL, LEADING or TRAILING expected before ‘%s’" - -#: cobc/typeck.c:8598 -msgid "operand has wrong size" -msgstr "operand has wrong size" - -#: cobc/typeck.c:8669 -#, c-format -msgid "internal register '%s' defined as BINARY-LONG" -msgstr "internal register ‘%s’ defined as BINARY-LONG" - -#: cobc/typeck.c:8672 cobc/typeck.c:8675 cobc/typeck.c:8678 cobc/typeck.c:8681 -#: cobc/typeck.c:8684 cobc/typeck.c:8687 cobc/typeck.c:8690 cobc/typeck.c:8693 -#: cobc/typeck.c:8696 -#, c-format -msgid "'%s' defined here as USAGE %s" -msgstr "‘%s’ defined here as USAGE %s" - -#: cobc/typeck.c:8699 -#, c-format -msgid "'%s' defined here as PIC %s" -msgstr "‘%s’ defined here as PIC %s" - -#: cobc/typeck.c:8702 -#, c-format -msgid "'%s' defined here as a group of length %d" -msgstr "‘%s’ defined here as a group of length %d" - -#: cobc/typeck.c:8741 -#, c-format -msgid "value is %s" -msgstr "value is %s" - -#: cobc/typeck.c:8745 -#, c-format -msgid "value size is %d" -msgstr "value size is %d" - -#: cobc/typeck.c:9022 -msgid "invalid destination for MOVE" -msgstr "invalid destination for MOVE" - -#: cobc/typeck.c:9057 -msgid "MOVE of figurative constant SPACE to numeric item" -msgstr "MOVE of figurative constant SPACE to numeric item" - -#: cobc/typeck.c:9072 -msgid "MOVE of figurative constant QUOTE to numeric item" -msgstr "MOVE of figurative constant QUOTE to numeric item" - -#: cobc/typeck.c:9077 cobc/typeck.c:9089 -msgid "MOVE of figurative constant to numeric item" -msgstr "MOVE of figurative constant to numeric item" - -#: cobc/typeck.c:9151 -msgid "numeric literal in VALUE clause of numeric-edited item" -msgstr "numeric literal in VALUE clause of numeric-edited item" - -#: cobc/typeck.c:9176 -msgid "numeric move to ALPHABETIC" -msgstr "numeric move to ALPHABETIC" - -#: cobc/typeck.c:9188 -msgid "data item not signed" -msgstr "data item not signed" - -#: cobc/typeck.c:9191 -msgid "ignoring sign" -msgstr "ignoring sign" - -#: cobc/typeck.c:9503 -msgid "overlapping MOVE may occur and produce unpredictable results" -msgstr "overlapping MOVE may occur and produce unpredictable results" - -#: cobc/typeck.c:9510 -msgid "overlapping MOVE may produce unpredictable results" -msgstr "overlapping MOVE may produce unpredictable results" - -#: cobc/typeck.c:9643 -msgid "invalid source for MOVE" -msgstr "invalid source for MOVE" - -#: cobc/typeck.c:9666 -msgid "source is non-numeric - substituting zero" -msgstr "source is non-numeric - substituting zero" - -#: cobc/typeck.c:9672 cobc/typeck.c:9683 -msgid "invalid VALUE clause" -msgstr "invalid VALUE clause" - -#: cobc/typeck.c:9675 cobc/typeck.c:11480 cobc/typeck.c:11485 -#: cobc/typeck.c:11512 cobc/typeck.c:11517 -msgid "invalid SET statement" -msgstr "invalid SET statement" - -#: cobc/typeck.c:9677 -msgid "invalid MOVE statement" -msgstr "invalid MOVE statement" - -#: cobc/typeck.c:9684 -msgid "literal exceeds data size" -msgstr "literal exceeds data size" - -#: cobc/typeck.c:9688 -msgid "numeric literal exceeds data size" -msgstr "numeric literal exceeds data size" - -#: cobc/typeck.c:9697 -msgid "MOVE of non-integer to alphanumeric" -msgstr "MOVE of non-integer to alphanumeric" - -#: cobc/typeck.c:9703 -msgid "numeric value is expected" -msgstr "numeric value is expected" - -#: cobc/typeck.c:9708 -msgid "alphanumeric value is expected" -msgstr "alphanumeric value is expected" - -#: cobc/typeck.c:9713 -msgid "value does not fit the picture string" -msgstr "value does not fit the picture string" - -#: cobc/typeck.c:9719 -msgid "value size exceeds data size" -msgstr "value size exceeds data size" - -#: cobc/typeck.c:9724 -msgid "sending field larger than receiving field" -msgstr "sending field larger than receiving field" - -#: cobc/typeck.c:9729 -msgid "some digits may be truncated" -msgstr "some digits may be truncated" - -#: cobc/typeck.c:10515 -#, c-format -msgid "invalid MOVE target: %s" -msgstr "invalid MOVE target: %s" - -#: cobc/typeck.c:10768 -msgid "READ PREVIOUS not allowed for this file type" -msgstr "READ PREVIOUS not allowed for this file type" - -#: cobc/typeck.c:10776 -msgid "KEY ignored with sequential READ" -msgstr "KEY ignored with sequential READ" - -#: cobc/typeck.c:10872 -msgid "figurative constants not allowed in FROM clause" -msgstr "figurative constants not allowed in FROM clause" - -#: cobc/typeck.c:10879 -msgid "literal in FROM clause must be alphanumeric, national or boolean" -msgstr "literal in FROM clause must be alphanumeric, national or boolean" - -#: cobc/typeck.c:10902 cobc/typeck.c:12047 -#, c-format -msgid "%s FILE requires a FROM clause" -msgstr "%s FILE requires a FROM clause" - -#: cobc/typeck.c:10924 cobc/typeck.c:11010 cobc/typeck.c:12069 -#, c-format -msgid "%s subject does not refer to a record name" -msgstr "%s subject does not refer to a record name" - -#: cobc/typeck.c:11016 -msgid "RELEASE not allowed on this record item" -msgstr "RELEASE not allowed on this record item" - -#: cobc/typeck.c:11097 cobc/typeck.c:11118 cobc/typeck.c:11125 -msgid "invalid SEARCH ALL condition" -msgstr "invalid SEARCH ALL condition" - -#: cobc/typeck.c:11237 cobc/typeck.c:11241 -msgid "SET targets must be PROGRAM-POINTER" -msgstr "SET targets must be PROGRAM-POINTER" - -#: cobc/typeck.c:11268 cobc/typeck.c:11335 cobc/typeck.c:11403 -#, c-format -msgid "cannot change address of '%s', which is not level 1 or 77" -msgstr "cannot change address of '%s', which is not level 1 or 77" - -#: cobc/typeck.c:11272 cobc/typeck.c:11339 cobc/typeck.c:11407 -#, c-format -msgid "cannot change address of '%s', which is not BASED or a LINKAGE item" -msgstr "cannot change address of '%s', which is not BASED or a LINKAGE item" - -#: cobc/typeck.c:11291 -#, c-format -msgid "SET target '%s' is not numeric, an INDEX or a POINTER" -msgstr "SET target ‘%s’ is not numeric, an INDEX or a POINTER" - -#: cobc/typeck.c:11360 -#, c-format -msgid "SET target '%s' is not a POINTER for FCD" -msgstr "SET target ‘%s’ is not a POINTER for FCD" - -#: cobc/typeck.c:11428 -#, c-format -msgid "SET target '%s' is not a POINTER for FCD-KEYDEF" -msgstr "SET target ‘%s’ is not a POINTER for FCD-KEYDEF" - -#: cobc/typeck.c:11521 -msgid "field does not have a FALSE clause" -msgstr "field does not have a FALSE clause" - -#: cobc/typeck.c:11552 -msgid "THREAD-priority must be between 1 and 32767" -msgstr "THREAD-priority must be between 1 and 32767" - -#: cobc/typeck.c:11572 -msgid "SET ATTRIBUTE requires a screen item as subject" -msgstr "SET ATTRIBUTE requires a screen item as subject" - -#: cobc/typeck.c:11578 -msgid "SET ATTRIBUTE subject does not refer to a screen item" -msgstr "SET ATTRIBUTE subject does not refer to a screen item" - -#: cobc/typeck.c:11629 -msgid "invalid SORT filename" -msgstr "invalid SORT filename" - -#: cobc/typeck.c:11689 -msgid "invalid SORT USING parameter" -msgstr "invalid SORT USING parameter" - -#: cobc/typeck.c:11718 -msgid "invalid SORT GIVING parameter" -msgstr "invalid SORT GIVING parameter" - -#: cobc/typeck.c:11772 cobc/typeck.c:11799 cobc/typeck.c:11819 -msgid "invalid key item" -msgstr "invalid key item" - -#: cobc/typeck.c:11849 -msgid "LENGTH/SIZE clause only allowed on INDEXED files" -msgstr "LENGTH/SIZE clause only allowed on INDEXED files" - -#: cobc/typeck.c:11854 -msgid "START not allowed with ACCESS MODE RANDOM" -msgstr "START not allowed with ACCESS MODE RANDOM" - -#: cobc/typeck.c:12103 -msgid "LOCK clause invalid here" -msgstr "LOCK clause invalid here" - -#: cobc/typeck.c:12365 -msgid "data item is not part of a report" -msgstr "data item is not part of a report" - -#: cobc/typeck.c:12385 -msgid "improper use of SUPPRESS PRINTING" -msgstr "improper use of SUPPRESS PRINTING" - -#: cobc/typeck.c:12400 -#, c-format -msgid "%s must be alphanumeric or national" -msgstr "%s must be alphanumeric or national" - -#: cobc/typeck.c:12411 -#, c-format -msgid "%s may not be a figurative constant" -msgstr "%s may not be a figurative constant" - -#: cobc/typeck.c:12438 -#, c-format -msgid "%s must be a child of the input record" -msgstr "%s must be a child of the input record" - -#: cobc/typeck.c:12464 -#, c-format -msgid "%s may not be an ignored item in JSON/XML GENERATE" -msgstr "%s may not be an ignored item in JSON/XML GENERATE" - -#: cobc/typeck.c:12475 -#, c-format -msgid "%s must be elementary" -msgstr "%s must be elementary" - -#: cobc/typeck.c:12487 -#, c-format -msgid "%s must be USAGE DISPLAY or NATIONAL" -msgstr "%s must be USAGE DISPLAY or NATIONAL" - -#: cobc/typeck.c:12501 -#, c-format -msgid "%s must be an integer" -msgstr "%s must be an integer" - -#: cobc/typeck.c:12517 cobc/typeck.c:12523 -msgid "JSON/XML GENERATE receiving item" -msgstr "JSON/XML GENERATE receiving item" - -#: cobc/typeck.c:12520 -msgid "JSON/XML GENERATE receiving item may not have JUSTIFIED clause" -msgstr "JSON/XML GENERATE receiving item may not have JUSTIFIED clause" - -#: cobc/typeck.c:12608 -msgid "JSON/XML GENERATE input record may not be reference modified" -msgstr "JSON/XML GENERATE input record may not be reference modified" - -#: cobc/typeck.c:12614 -msgid "JSON/XML GENERATE input record may not have RENAMES clause" -msgstr "JSON/XML GENERATE input record may not have RENAMES clause" - -#: cobc/typeck.c:12619 -#, c-format -msgid "all the children of '%s' are ignored in JSON/XML GENERATE" -msgstr "all the children of ‘%s’ are ignored in JSON/XML GENERATE" - -#: cobc/typeck.c:12626 -msgid "JSON/XML GENERATE input record has subrecords with non-unique names" -msgstr "JSON/XML GENERATE input record has subrecords with non-unique names" - -#: cobc/typeck.c:12631 -msgid "floating-point items in JSON/XML GENERATE" -msgstr "floating-point items in JSON/XML GENERATE" - -#: cobc/typeck.c:12635 -msgid "OCCURS items in JSON/XML GENERATE" -msgstr "OCCURS items in JSON/XML GENERATE" - -#: cobc/typeck.c:12660 -msgid "COUNT IN item must be numeric and an integer" -msgstr "COUNT IN item must be numeric and an integer" - -#: cobc/typeck.c:12665 -msgid "COUNT IN item must be an integer" -msgstr "COUNT IN item must be an integer" - -#: cobc/typeck.c:12668 -msgid "COUNT IN item may not have PICTURE with P in it" -msgstr "COUNT IN item may not have PICTURE with P in it" - -#: cobc/typeck.c:12711 -msgid "NAMESPACE must be a valid URI" -msgstr "NAMESPACE must be a valid URI" - -#: cobc/typeck.c:12755 -msgid "NAMESPACE-PREFIX must be a valid XML name" -msgstr "NAMESPACE-PREFIX must be a valid XML name" - -#: cobc/typeck.c:12780 cobc/typeck.c:12787 -msgid "NAME OF item" -msgstr "NAME OF item" - -#: cobc/typeck.c:12784 -msgid "NAME OF item must be the input record or a child of it" -msgstr "NAME OF item must be the input record or a child of it" - -#: cobc/typeck.c:12791 -msgid "NAME OF name must be a valid XML name" -msgstr "NAME OF name must be a valid XML name" - -#: cobc/typeck.c:12817 cobc/typeck.c:12818 cobc/typeck.c:12821 -#: cobc/typeck.c:12825 -msgid "TYPE OF item" -msgstr "TYPE OF item" - -#: cobc/typeck.c:12843 -msgid "SUPPRESS WHEN SPACE item" -msgstr "SUPPRESS WHEN SPACE item" - -#: cobc/typeck.c:12846 -msgid "SUPPRESS WHEN LOW-VALUE item" -msgstr "SUPPRESS WHEN LOW-VALUE item" - -#: cobc/typeck.c:12848 -msgid "SUPPRESS WHEN HIGH-VALUE item" -msgstr "SUPPRESS WHEN HIGH-VALUE item" - -#: cobc/typeck.c:12877 cobc/typeck.c:12885 cobc/typeck.c:12889 -msgid "SUPPRESS item" -msgstr "SUPPRESS item" - -#: cobc/typeck.c:12881 -msgid "SUPPRESS item with WHEN clause" -msgstr "SUPPRESS item with WHEN clause" - -#: cobc/typeck.c:12958 -msgid "WITH ATTRIBUTES specified, but no attributes can be generated" -msgstr "WITH ATTRIBUTES specified, but no attributes can be generated" - -#: cobc/warning.def:34 -msgid " -Wextra additional warnings only raised with -W or -Wall" -msgstr " -Wextra additional warnings only raised with -W or -Wall" - -#: cobc/warning.def:37 -msgid " -Wno-unfinished do not warn if unfinished features are used" -msgstr " -Wno-unfinished do not warn if unfinished features are used" - -#: cobc/warning.def:40 -msgid " -Wno-pending do not warn if pending features are mentioned" -msgstr " -Wno-pending do not warn if pending features are mentioned" - -#: cobc/warning.def:43 -msgid " -Wobsolete warn if obsolete features are used" -msgstr " -Wobsolete warn if obsolete features are used" - -#: cobc/warning.def:46 -msgid " -Warchaic warn if archaic features are used" -msgstr " -Warchaic warn if archaic features are used" - -#: cobc/warning.def:49 -msgid " -Wredefinition warn about incompatible redefinition of data items" -msgstr " -Wredefinition warn about incompatible redefinition of data items" - -#: cobc/warning.def:52 -msgid " -Wtruncate warn about field truncation from constant assignments" -msgstr " -Wtruncate warn about field truncation from constant assignments" - -#: cobc/warning.def:55 -msgid " -Wpossible-truncate warn about possible field truncation" -msgstr " -Wpossible-truncate warn about possible field truncation" - -#: cobc/warning.def:58 -msgid " -Woverlap warn about overlapping MOVE of items" -msgstr " -Woverlap warn about overlapping MOVE of items" - -#: cobc/warning.def:61 -msgid " -Wpossible-overlap warn about MOVE of items that may overlap depending on variables" -msgstr " -Wpossible-overlap warn about MOVE of items that may overlap depending on variables" - -#: cobc/warning.def:64 -msgid " -Wparentheses warn about lack of parentheses around AND within OR" -msgstr " -Wparentheses warn about lack of parentheses around AND within OR" - -#: cobc/warning.def:67 -msgid " -Wstrict-typing warn strictly about type mismatch" -msgstr " -Wstrict-typing warn strictly about type mismatch" - -#: cobc/warning.def:70 -msgid " -Wimplicit-define warn about implicitly defined data items" -msgstr " -Wimplicit-define warn about implicitly defined data items" - -#: cobc/warning.def:73 -msgid " -Wcorresponding warn about CORRESPONDING with no matching items" -msgstr " -Wcorresponding warn about CORRESPONDING with no matching items" - -#: cobc/warning.def:76 -msgid " -Winitial-value warn if initial VALUE clause is ignored" -msgstr " -Winitial-value warn if initial VALUE clause is ignored" - -#: cobc/warning.def:79 -msgid " -Wprototypes warn about missing FUNCTION prototypes/definitions" -msgstr " -Wprototypes warn about missing FUNCTION prototypes/definitions" - -#: cobc/warning.def:82 -msgid " -Warithmetic-osvs warn if arithmetic expression precision has changed" -msgstr " -Warithmetic-osvs warn if arithmetic expression precision has changed" - -#: cobc/warning.def:85 -msgid " -Wcall-params warn about non 01/77 items for CALL parameters" -msgstr " -Wcall-params warn about non 01/77 items for CALL parameters" - -#: cobc/warning.def:88 -msgid " -Wconstant-expression warn about expressions that always resolve to true/false" -msgstr " -Wconstant-expression warn about expressions that always resolve to true/false" - -#: cobc/warning.def:91 -msgid " -Wcolumn-overflow warn about text after program-text area, FIXED format" -msgstr " -Wcolumn-overflow warn about text after program-text area, FIXED format" - -#: cobc/warning.def:94 -msgid " -Wterminator warn about lack of scope terminator END-XXX" -msgstr " -Wterminator warn about lack of scope terminator END-XXX" - -#: cobc/warning.def:97 -msgid " -Wlinkage warn about dangling LINKAGE items" -msgstr " -Wlinkage warn about dangling LINKAGE items" - -#: cobc/warning.def:100 -msgid " -Wunreachable warn about likely unreachable statements" -msgstr " -Wunreachable warn about likely unreachable statements" - -#: cobc/warning.def:103 -msgid " -Wno-dialect do not warn about dialect specific issues" -msgstr " -Wno-dialect do not warn about dialect specific issues" - -#: cobc/warning.def:106 -msgid " -Wothers do not warn about different issues" -msgstr " -Wothers do not warn about different issues" - -#: cobc/warning.def:109 -msgid " -Wno-unsupported do not warn if runtime does not support a feature used" -msgstr " -Wno-unsupported do not warn if runtime does not support a feature used" - -#: libcob/call.c:87 -#, c-format -msgid "LoadLibrary/GetProcAddress error %d" -msgstr "LoadLibrary/GetProcAddress error %d" - -#: libcob/call.c:939 -msgid "indeterminable error in resolve of COBOL CALL" -msgstr "indeterminable error in resolve of COBOL CALL" - -#: libcob/call.c:1022 -#, c-format -msgid "user-defined FUNCTION '%s' not found" -msgstr "user-defined FUNCTION ‘%s’ not found" - -#: libcob/call.c:1129 libcob/call.c:1208 libcob/call.c:1326 libcob/call.c:1354 -#, c-format -msgid "NULL parameter passed to '%s'" -msgstr "NULL parameter passed to ‘%s’" - -#: libcob/call.c:1204 -#, c-format -msgid "invalid number of arguments passed to '%s'" -msgstr "invalid number of arguments passed to ‘%s’" - -#: libcob/call.c:1330 -msgid "multiple call to 'cob_setjmp'" -msgstr "multiple call to ‘cob_setjmp’" - -#: libcob/call.c:1358 -msgid "call to 'cob_longjmp' with no prior 'cob_setjmp'" -msgstr "call to ‘cob_longjmp’ with no prior ‘cob_setjmp’" - -#: libcob/call.c:1592 libcob/call.c:1633 libcob/call.c:1646 -#: libcob/common.c:7081 -msgid "cob_init() has not been called" -msgstr "cob_init() has not been called" - -#: libcob/call.c:1598 -#, c-format -msgid "parameter %d is not within range of %d" -msgstr "parameter %d is not within range of %d" - -#: libcob/call.c:1604 -#, c-format -msgid "parameter %d is NULL" -msgstr "parameter %d is NULL" - -#: libcob/call.c:1859 libcob/call.c:1916 -#, c-format -msgid "attempt to over-write constant parameter %d with " -msgstr "attempt to over-write constant parameter %d with " - -#: libcob/call.c:1965 -#, c-format -msgid "attempt to over-write constant parameter %d with '%s'" -msgstr "attempt to over-write constant parameter %d with ‘%s’" - -#: libcob/cobgetopt.c:497 -#, c-format -msgid "%s: option '%s' is ambiguous; possibilities:" -msgstr "%s: option ‘%s’ is ambiguous; possibilities:" - -#: libcob/cobgetopt.c:538 -#, c-format -msgid "%s: option '--%s' doesn't allow an argument" -msgstr "%s: option ‘--%s’ doesn't allow an argument" - -#: libcob/cobgetopt.c:545 -#, c-format -msgid "%s: option '%c%s' doesn't allow an argument" -msgstr "%s: option ‘%c%s’ doesn't allow an argument" - -#: libcob/cobgetopt.c:565 -#, c-format -msgid "%s: option '--%s' requires an argument" -msgstr "%s: option ‘--%s’ requires an argument" - -#: libcob/cobgetopt.c:597 -#, c-format -msgid "%s: unrecognized option '--%s'" -msgstr "%s: unrecognized option ‘--%s’" - -#: libcob/cobgetopt.c:604 -#, c-format -msgid "%s: unrecognized option '%c%s'" -msgstr "%s: unrecognized option ‘%c%s’" - -#: libcob/cobgetopt.c:633 -#, c-format -msgid "%s: invalid option -- %c" -msgstr "%s: invalid option -- %c" - -#: libcob/cobgetopt.c:664 libcob/cobgetopt.c:805 -#, c-format -msgid "%s: option requires an argument -- %c" -msgstr "%s: option requires an argument -- %c" - -#: libcob/cobgetopt.c:714 -#, c-format -msgid "%s: option '-W %s' is ambiguous" -msgstr "%s: option ‘-W %s’ is ambiguous" - -#: libcob/cobgetopt.c:736 -#, c-format -msgid "%s: option '-W %s' doesn't allow an argument" -msgstr "%s: option ‘-W %s’ doesn't allow an argument" - -#: libcob/cobgetopt.c:754 -#, c-format -msgid "%s: option '%s' requires an argument" -msgstr "%s: option ‘%s’ requires an argument" - -#: libcob/common.c:793 -#, c-format -msgid "attempt to reference unallocated memory" -msgstr "attempt to reference unallocated memory" - -#: libcob/common.c:798 -#, c-format -msgid "bus error" -msgstr "bus error" - -#: libcob/common.c:803 -#, c-format -msgid "fatal arithmetic error" -msgstr "fatal arithmetic error" - -#: libcob/common.c:807 -#, c-format -msgid "caught signal" -msgstr "caught signal" - -#: libcob/common.c:811 -#, c-format -msgid "signal %s" -msgstr "signal %s" - -#: libcob/common.c:817 -#, c-format -msgid "abnormal termination - file contents may be incorrect" -msgstr "abnormal termination - file contents may be incorrect" - -#: libcob/common.c:2049 -msgid "NULL field" -msgstr "NULL field" - -#: libcob/common.c:2059 -msgid "field with NULL address" -msgstr "field with NULL address" - -#: libcob/common.c:2345 -msgid "version mismatch" -msgstr "version mismatch" - -#: libcob/common.c:2346 libcob/common.c:2348 -#, c-format -msgid "%s has version %s.%d" -msgstr "%s has version %s.%d" - -#: libcob/common.c:2358 -#, c-format -msgid "CALL to %s requires %d arguments" -msgstr "CALL to %s requires %d arguments" - -#: libcob/common.c:2980 -#, c-format -msgid "BASED/LINKAGE item %s has NULL address" -msgstr "BASED/LINKAGE item %s has NULL address" - -#: libcob/common.c:2992 libcob/common.c:2995 -#, c-format -msgid "LINKAGE item %s not passed by caller" -msgstr "LINKAGE item %s not passed by caller" - -#: libcob/common.c:3081 -#, c-format -msgid "'%s' (Type: %s) not numeric: '%s'" -msgstr "‘%s’ (Type: %s) not numeric: ‘%s’" - -#: libcob/common.c:3096 -#, c-format -msgid "OCCURS DEPENDING ON '%s' out of bounds: %d" -msgstr "OCCURS DEPENDING ON ‘%s’ out of bounds: %d" - -#: libcob/common.c:3099 libcob/common.c:3120 -#, c-format -msgid "maximum subscript for '%s': %d" -msgstr "maximum subscript for '%s': %d" - -#: libcob/common.c:3101 -#, c-format -msgid "minimum subscript for '%s': %d" -msgstr "minimum subscript for '%s': %d" - -#: libcob/common.c:3117 -#, c-format -msgid "current maximum subscript for '%s': %d" -msgstr "current maximum subscript for '%s': %d" - -#: libcob/common.c:3139 -#, c-format -msgid "offset of '%s' out of bounds: %d, maximum: %d" -msgstr "offset of ‘%s’ out of bounds: %d, maximum: %d" - -#: libcob/common.c:3152 -#, c-format -msgid "length of '%s' out of bounds: %d, maximum: %d" -msgstr "length of ‘%s’ out of bounds: %d, maximum: %d" - -#: libcob/common.c:3161 -#, c-format -msgid "length of '%s' out of bounds: %d, starting at: %d, maximum: %d" -msgstr "length of ‘%s’ out of bounds: %d, starting at: %d, maximum: %d" - -#: libcob/common.c:3176 libcob/common.c:3181 -#, c-format -msgid "EXTERNAL item '%s' previously allocated with size %d, requested size is %d" -msgstr "EXTERNAL item ‘%s’ previously allocated with size %d, requested size is %d" - -#: libcob/common.c:3682 -#, c-format -msgid "COB_CURRENT_DATE '%s' is invalid" -msgstr "COB_CURRENT_DATE ‘%s’ is invalid" - -#: libcob/common.c:4585 -#, c-format -msgid "parameter to SYSTEM call is larger than %d characters" -msgstr "parameter to SYSTEM call is larger than %d characters" - -#: libcob/common.c:5195 -#, c-format -msgid "error '%s' during CBL_GC_FORK" -msgstr "error ‘%s’ during CBL_GC_FORK" - -#: libcob/common.c:5200 libcob/common.c:5297 -#, c-format -msgid "'%s' is not supported on this platform" -msgstr "‘%s’ is not supported on this platform" - -#: libcob/common.c:5226 -#, c-format -msgid "error '%s' for P%d during CBL_GC_WAITPID" -msgstr "error ‘%s’ for P%d during CBL_GC_WAITPID" - -#: libcob/common.c:5418 -msgid "Call to CBL_GC_GETOPT with wrong longoption size." -msgstr "Call to CBL_GC_GETOPT with wrong longoption size." - -#: libcob/common.c:5423 -msgid "Call to CBL_GC_GETOPT with missing longind." -msgstr "Call to CBL_GC_GETOPT with missing longind." - -#: libcob/common.c:5837 libcob/common.c:5858 libcob/common.c:5871 -#: libcob/common.c:7785 -#, c-format -msgid "(default)" -msgstr "(default)" - -#: libcob/common.c:6119 libcob/common.c:6138 -msgid "should be unsigned" -msgstr "should be unsigned" - -#: libcob/common.c:6127 libcob/common.c:6176 -msgid "should be numeric" -msgstr "should be numeric" - -#: libcob/common.c:6185 -#, c-format -msgid "minimum value: %lu" -msgstr "minimum value: %lu" - -#: libcob/common.c:6236 libcob/common.c:6787 libcob/common.c:6801 -#, c-format -msgid "should not contain '%c'" -msgstr "should not contain ‘%c’" - -#: libcob/common.c:6316 libcob/common.c:6384 libcob/common.c:6393 -#: libcob/common.c:6401 -#, c-format -msgid "not set" -msgstr "not set" - -#: libcob/common.c:6376 libcob/common.c:6379 libcob/common.c:6382 -#, c-format -msgid "set by %s" -msgstr "set by %s" - -#: libcob/common.c:6516 -#, c-format -msgid "WARNING - '%s' without a value - ignored!" -msgstr "WARNING - ‘%s’ without a value - ignored!" - -#: libcob/common.c:6519 -#, c-format -msgid "'%s' without a value!" -msgstr "‘%s’ without a value!" - -#: libcob/common.c:6545 -#, c-format -msgid "WARNING - '%s %s' without a value - ignored!" -msgstr "WARNING - ‘%s %s’ without a value - ignored!" - -#: libcob/common.c:7034 -msgid "error" -msgstr "error" - -#: libcob/common.c:7064 -msgid "attempt to CANCEL active program" -msgstr "attempt to CANCEL active program" - -#: libcob/common.c:7091 -msgid "CALL of program with CHAINING clause" -msgstr "CALL of program with CHAINING clause" - -#: libcob/common.c:7095 -msgid "stack overflow, possible PERFORM depth exceeded" -msgstr "stack overflow, possible PERFORM depth exceeded" - -#: libcob/common.c:7100 -msgid "invalid entry/exit in GLOBAL USE procedure" -msgstr "invalid entry/exit in GLOBAL USE procedure" - -#: libcob/common.c:7105 -msgid "unable to allocate memory" -msgstr "unable to allocate memory" - -#: libcob/common.c:7110 -msgid "invalid entry into module" -msgstr "invalid entry into module" - -#: libcob/common.c:7115 -#, c-format -msgid "recursive CALL from %s to %s which is NOT RECURSIVE" -msgstr "recursive CALL from %s to %s which is NOT RECURSIVE" - -#: libcob/common.c:7125 -msgid "divide by ZERO" -msgstr "divide by ZERO" - -#: libcob/common.c:7132 -msgid "end of file" -msgstr "end of file" - -#: libcob/common.c:7135 -msgid "key out of range" -msgstr "key out of range" - -#: libcob/common.c:7138 -msgid "key order not ascending" -msgstr "key order not ascending" - -#: libcob/common.c:7141 -msgid "record key already exists" -msgstr "record key already exists" - -#: libcob/common.c:7144 -msgid "record key does not exist" -msgstr "record key does not exist" - -#: libcob/common.c:7147 -msgid "permanent file error" -msgstr "permanent file error" - -#: libcob/common.c:7150 -msgid "inconsistant file name" -msgstr "inconsistant file name" - -#: libcob/common.c:7153 -msgid "file does not exist" -msgstr "file does not exist" - -#: libcob/common.c:7156 -msgid "permission denied" -msgstr "permission denied" - -#: libcob/common.c:7159 -msgid "file already open" -msgstr "file already open" - -#: libcob/common.c:7162 -msgid "file not open" -msgstr "file not open" - -#: libcob/common.c:7165 -msgid "READ must be executed first" -msgstr "READ must be executed first" - -#: libcob/common.c:7168 -msgid "record overflow" -msgstr "record overflow" - -#: libcob/common.c:7171 -msgid "READ after unsuccessful READ/START" -msgstr "READ after unsuccessful READ/START" - -#: libcob/common.c:7174 -msgid "READ/START not allowed, file not open for input" -msgstr "READ/START not allowed, file not open for input" - -#: libcob/common.c:7177 -msgid "WRITE not allowed, file not open for output" -msgstr "WRITE not allowed, file not open for output" - -#: libcob/common.c:7180 -msgid "DELETE/REWRITE not allowed, file not open for I-O" -msgstr "DELETE/REWRITE not allowed, file not open for I-O" - -#: libcob/common.c:7183 -msgid "record locked by another file connector" -msgstr "record locked by another file connector" - -#: libcob/common.c:7186 -msgid "LINAGE values invalid" -msgstr "LINAGE values invalid" - -#: libcob/common.c:7189 -msgid "file sharing conflict" -msgstr "file sharing conflict" - -#: libcob/common.c:7193 -msgid "runtime library is not configured for this operation" -msgstr "runtime library is not configured for this operation" - -#: libcob/common.c:7198 -msgid "unknown file error" -msgstr "unknown file error" - -#: libcob/common.c:7205 -#, c-format -msgid "%s (status = %02d) for file %s" -msgstr "%s (status = %02d) for file %s" - -#: libcob/common.c:7208 -#, c-format -msgid "%s (status = %02d) for file %s on %s" -msgstr "%s (status = %02d) for file %s on %s" - -#: libcob/common.c:7215 -msgid "attempt to use non-implemented function" -msgstr "attempt to use non-implemented function" - -#: libcob/common.c:7218 -msgid "attempt to use non-implemented XML I/O" -msgstr "attempt to use non-implemented XML I/O" - -#: libcob/common.c:7221 -msgid "attempt to use non-implemented JSON I/O" -msgstr "attempt to use non-implemented JSON I/O" - -#: libcob/common.c:7268 -msgid "environment variables" -msgstr "environment variables" - -#: libcob/common.c:7315 -msgid "License LGPLv3+: GNU LGPL version 3 or later " -msgstr "License LGPLv3+: GNU LGPL version 3 or later " - -#: libcob/common.c:7372 libcob/common.c:7374 -msgid "dynamic loading" -msgstr "dynamic loading" - -#: libcob/common.c:7379 -msgid "enabled" -msgstr "enabled" - -#: libcob/common.c:7460 libcob/common.c:7577 libcob/common.c:7586 -#: libcob/common.c:7603 libcob/common.c:7618 -#, c-format -msgid "%s, version %d.%d.%d" -msgstr "%s, version %d.%d.%d" - -#: libcob/common.c:7462 libcob/common.c:7579 libcob/common.c:7588 -#: libcob/common.c:7620 -#, c-format -msgid "%s, version %d.%d.%d (compiled with %d.%d)" -msgstr "%s, version %d.%d.%d (compiled with %d.%d)" - -#: libcob/common.c:7465 -#, c-format -msgid "%s, version %s" -msgstr "%s, version %s" - -#: libcob/common.c:7486 libcob/common.c:7488 libcob/common.c:7493 -#: libcob/common.c:7495 libcob/common.c:7498 -msgid "mouse support" -msgstr "mouse support" - -#: libcob/common.c:7636 -msgid "CALL configuration" -msgstr "CALL configuration" - -#: libcob/common.c:7637 -msgid "File I/O configuration" -msgstr "File I/O configuration" - -#: libcob/common.c:7638 -msgid "Screen I/O configuration" -msgstr "Screen I/O configuration" - -#: libcob/common.c:7639 -msgid "Miscellaneous" -msgstr "Miscellaneous" - -#: libcob/common.c:7640 -msgid "System configuration" -msgstr "System configuration" - -#: libcob/common.c:7644 -msgid "runtime configuration" -msgstr "runtime configuration" - -#: libcob/common.c:7646 -msgid "via" -msgstr "via" - -#: libcob/common.c:7719 libcob/common.c:7747 -msgid "... removed from environment" -msgstr "... removed from environment" - -#: libcob/common.c:7773 libcob/common.c:7775 -#, c-format -msgid "(set by %s)" -msgstr "(set by %s)" - -#: libcob/common.c:7783 -#, c-format -msgid "(reset)" -msgstr "(reset)" - -#: libcob/common.c:8167 libcob/common.c:8286 -#, c-format -msgid "%s called with unknown option: %d" -msgstr "%s called with unknown option: %d" - -#: libcob/common.c:8239 -#, c-format -msgid "Module dump due to %s\n" -msgstr "Module dump due to %s\n" - -#: libcob/common.c:8243 -#, c-format -msgid " Last statement of %s was Line %d of %s\n" -msgstr " Last statement of %s was Line %d of %s\n" - -#: libcob/common.c:8249 -#, c-format -msgid " Last statement of %s unknown\n" -msgstr " Last statement of %s unknown\n" - -#: libcob/common.c:8259 -#, c-format -msgid "Dump Program-Id %s from %s compiled %s\n" -msgstr "Dump Program-Id %s from %s compiled %s\n" - -#: libcob/fileio.c:287 -#, c-format -msgid "ERROR I/O routine %s is not present" -msgstr "ERROR I/O routine %s is not present" - -#: libcob/fileio.c:1365 -#, c-format -msgid "I/O routine %s is not present for %s" -msgstr "I/O routine %s is not present for %s" - -#: libcob/fileio.c:1404 -#, c-format -msgid "I/O routine %s is not known for %s" -msgstr "I/O routine %s is not known for %s" - -#: libcob/fileio.c:2599 -#, c-format -msgid "ERROR FILE %s has record size %d exceeds %d in program" -msgstr "ERROR FILE %s has record size %d exceeds %d in program" - -#: libcob/fileio.c:2967 libcob/fileio.c:2974 -#, c-format -msgid "ERROR FILE %s opening pipe" -msgstr "ERROR FILE %s opening pipe" - -#: libcob/fileio.c:4979 -#, c-format -msgid "ERROR FILE %s does not match current version; Recompile the program" -msgstr "ERROR FILE %s does not match current version; Recompile the program" - -#: libcob/fileio.c:5034 -#, c-format -msgid "ERROR FILE %s has ASSIGN field is NULL" -msgstr "ERROR FILE %s has ASSIGN field is NULL" - -#: libcob/fileio.c:5707 -#, c-format -msgid "call to CBL_OPEN_FILE with wrong access mode: %d" -msgstr "call to CBL_OPEN_FILE with wrong access mode: %d" - -#: libcob/fileio.c:5756 -#, c-format -msgid "call to CBL_CREATE_FILE with wrong file_lock: %d" -msgstr "call to CBL_CREATE_FILE with wrong file_lock: %d" - -#: libcob/fileio.c:5759 -#, c-format -msgid "call to CBL_CREATE_FILE with wrong file_dev: %d" -msgstr "call to CBL_CREATE_FILE with wrong file_dev: %d" - -#: libcob/fileio.c:5955 libcob/fileio.c:6215 -#, c-format -msgid "'%s' - File detail area is too short" -msgstr "‘%s’ - File detail area is too short" - -#: libcob/fileio.c:6437 -msgid "SORT is unable to acquire temporary file" -msgstr "SORT is unable to acquire temporary file" - -#: libcob/fileio.c:7057 -#, c-format -msgid "implicit CLOSE of %s" -msgstr "implicit CLOSE of %s" - -#: libcob/fileio.c:7165 -#, c-format -msgid "C-ISAM library %s is not present" -msgstr "C-ISAM library %s is not present" - -#: libcob/fileio.c:7173 -#, c-format -msgid "D-ISAM library %s is not present" -msgstr "D-ISAM library %s is not present" - -#: libcob/fileio.c:7181 -#, c-format -msgid "VB-ISAM library %s is not present" -msgstr "VB-ISAM library %s is not present" - -#: libcob/screenio.c:429 -msgid "failed to initialize curses" -msgstr "failed to initialize curses" - -#: libcob/screenio.c:3591 -msgid "end of program, please press a key to exit" -msgstr "end of program, please press a key to exit" - -#: libcob/termio.c:70 libcob/termio.c:106 -msgid "(Not representable)" -msgstr "(Not representable)" - -#: libcob/termio.c:347 -#, c-format -msgid "cannot open %s (=%s)" -msgstr "cannot open %s (=%s)" - -#: libcob/termio.c:362 -msgid "COB_DISPLAY_PUNCH_FILE is invalid, output to SYSPUNCH skipped" -msgstr "COB_DISPLAY_PUNCH_FILE is invalid, output to SYSPUNCH skipped" - -#: bin/cobcrun.c:122 -msgid "GnuCOBOL module loader" -msgstr "GnuCOBOL module loader" - -#: bin/cobcrun.c:124 -#, c-format -msgid "Usage: %s [options] PROGRAM [parameter ...]" -msgstr "Usage: %s [options] PROGRAM [parameter ...]" - -#: bin/cobcrun.c:126 -#, c-format -msgid " or: %s options" -msgstr " or: %s options" - -#: bin/cobcrun.c:129 -msgid "Options:" -msgstr "Options:" - -#: bin/cobcrun.c:130 -msgid " -h, -help display this help and exit" -msgstr " -h, -help display this help and exit" - -#: bin/cobcrun.c:131 -msgid " -V, -version display cobcrun and runtime version and exit" -msgstr " -V, -version display cobcrun and runtime version and exit" - -#: bin/cobcrun.c:132 -msgid " -i, -info display runtime information (build/environment)" -msgstr " -i, -info display runtime information (build/environment)" - -#: bin/cobcrun.c:134 -msgid " -q, -brief reduced displays" -msgstr " -q, -brief reduced displays" - -#: bin/cobcrun.c:136 -msgid " -c , -config= set runtime configuration from " -msgstr " -c , -config= set runtime configuration from " - -#: bin/cobcrun.c:137 -msgid "" -" -r, -runtime-config display current runtime configuration\n" -" (value and origin for all settings)" -msgstr "" -" -r, -runtime-config display current runtime configuration\n" -" (value and origin for all settings)" - -#: bin/cobcrun.c:139 -msgid "" -" -M , -module= set entry point module name and/or load path\n" -" where -M module prepends any directory to the\n" -" dynamic link loader library search path\n" -" and any basename to the module preload list\n" -" (COB_LIBRARY_PATH and/or COB_PRELOAD)" -msgstr "" -" -M , -module= set entry point module name and/or load path\n" -" where -M module prepends any directory to the\n" -" dynamic link loader library search path\n" -" and any basename to the module preload list\n" -" (COB_LIBRARY_PATH and/or COB_PRELOAD)" - -#: bin/cobcrun.c:145 -#, c-format -msgid "" -"Report bugs to: %s\n" -"or (preferably) use the issue tracker via the home page." -msgstr "" -"Report bugs to: %s\n" -"or (preferably) use the issue tracker via the home page." - -#: bin/cobcrun.c:148 -msgid "GnuCOBOL home page: " -msgstr "GnuCOBOL home page: " - -#: bin/cobcrun.c:149 -msgid "General help using GNU software: " -msgstr "General help using GNU software: " - -#: bin/cobcrun.c:274 -msgid "invalid configuration file name" -msgstr "invalid configuration file name" - -#: bin/cobcrun.c:325 -#, c-format -msgid "invalid module argument '%s'" -msgstr "invalid module argument ‘%s’" - -#: bin/cobcrun.c:377 -#, c-format -msgid "%s: missing PROGRAM name" -msgstr "%s: missing PROGRAM name" - -#: bin/cobcrun.c:379 -#, c-format -msgid "Try '%s --help' for more information." -msgstr "Try ‘%s --help’ for more information." - -#: bin/cobcrun.c:387 -#, c-format -msgid "%s: PROGRAM name exceeds %d characters" -msgstr "%s: PROGRAM name exceeds %d characters" Binary files /tmp/tmp8r0303vl/MzBWgGBJBM/gnucobol-4.0~early~20200606/po/en@quot.gmo and /tmp/tmp8r0303vl/cieYbammgl/gnucobol-5/po/en@quot.gmo differ diff -Nru gnucobol-4.0~early~20200606/po/en@quot.header gnucobol-5/po/en@quot.header --- gnucobol-4.0~early~20200606/po/en@quot.header 2020-06-06 20:52:02.000000000 +0000 +++ gnucobol-5/po/en@quot.header 1970-01-01 00:00:00.000000000 +0000 @@ -1,22 +0,0 @@ -# All this catalog "translates" are quotation characters. -# The msgids must be ASCII and therefore cannot contain real quotation -# characters, only substitutes like grave accent (0x60), apostrophe (0x27) -# and double quote (0x22). These substitutes look strange; see -# http://www.cl.cam.ac.uk/~mgk25/ucs/quotes.html -# -# This catalog translates grave accent (0x60) and apostrophe (0x27) to -# left single quotation mark (U+2018) and right single quotation mark (U+2019). -# It also translates pairs of apostrophe (0x27) to -# left single quotation mark (U+2018) and right single quotation mark (U+2019) -# and pairs of quotation mark (0x22) to -# left double quotation mark (U+201C) and right double quotation mark (U+201D). -# -# When output to an UTF-8 terminal, the quotation characters appear perfectly. -# When output to an ISO-8859-1 terminal, the single quotation marks are -# transliterated to apostrophes (by iconv in glibc 2.2 or newer) or to -# grave/acute accent (by libiconv), and the double quotation marks are -# transliterated to 0x22. -# When output to an ASCII terminal, the single quotation marks are -# transliterated to apostrophes, and the double quotation marks are -# transliterated to 0x22. -# diff -Nru gnucobol-4.0~early~20200606/po/en@quot.po gnucobol-5/po/en@quot.po --- gnucobol-4.0~early~20200606/po/en@quot.po 2020-06-06 20:53:00.000000000 +0000 +++ gnucobol-5/po/en@quot.po 1970-01-01 00:00:00.000000000 +0000 @@ -1,5650 +0,0 @@ -# English translations for gnucobol package. -# Copyright (C) 2020 Free Software Foundation, Inc. -# This file is distributed under the same license as the gnucobol package. -# Automatically generated, 2020. -# -# All this catalog "translates" are quotation characters. -# The msgids must be ASCII and therefore cannot contain real quotation -# characters, only substitutes like grave accent (0x60), apostrophe (0x27) -# and double quote (0x22). These substitutes look strange; see -# http://www.cl.cam.ac.uk/~mgk25/ucs/quotes.html -# -# This catalog translates grave accent (0x60) and apostrophe (0x27) to -# left single quotation mark (U+2018) and right single quotation mark (U+2019). -# It also translates pairs of apostrophe (0x27) to -# left single quotation mark (U+2018) and right single quotation mark (U+2019) -# and pairs of quotation mark (0x22) to -# left double quotation mark (U+201C) and right double quotation mark (U+201D). -# -# When output to an UTF-8 terminal, the quotation characters appear perfectly. -# When output to an ISO-8859-1 terminal, the single quotation marks are -# transliterated to apostrophes (by iconv in glibc 2.2 or newer) or to -# grave/acute accent (by libiconv), and the double quotation marks are -# transliterated to 0x22. -# When output to an ASCII terminal, the single quotation marks are -# transliterated to apostrophes, and the double quotation marks are -# transliterated to 0x22. -# -msgid "" -msgstr "" -"Project-Id-Version: gnucobol 4.0-early-dev\n" -"Report-Msgid-Bugs-To: gnucobol-messages@gnu.org\n" -"POT-Creation-Date: 2020-06-06 20:52+0000\n" -"PO-Revision-Date: 2020-06-06 20:52+0000\n" -"Last-Translator: Automatically generated\n" -"Language-Team: none\n" -"Language: en@quot\n" -"MIME-Version: 1.0\n" -"Content-Type: text/plain; charset=UTF-8\n" -"Content-Transfer-Encoding: 8bit\n" -"Plural-Forms: nplurals=2; plural=(n != 1);\n" - -#: cobc/cobc.c:117 -#, c-format -msgid "invalid parameter: %s" -msgstr "invalid parameter: %s" - -#: cobc/cobc.c:826 -msgid "too many errors" -msgstr "too many errors" - -#: cobc/cobc.c:838 -msgid "internal compiler error" -msgstr "internal compiler error" - -#: cobc/cobc.c:904 cobc/cobc.c:991 cobc/cobc.c:1051 cobc/cobc.c:1127 -#: cobc/cobc.c:1167 cobc/cobc.c:1243 -#, c-format -msgid "cannot allocate %d bytes of memory" -msgstr "cannot allocate %d bytes of memory" - -#: cobc/cobc.c:917 cobc/cobc.c:933 cobc/cobc.c:953 cobc/cobc.c:1011 -#: cobc/cobc.c:1029 cobc/cobc.c:1147 cobc/cobc.c:1262 cobc/cobc.c:1279 -#: cobc/field.c:2008 libcob/common.c:7121 -#, c-format -msgid "call to %s with NULL pointer" -msgstr "call to %s with NULL pointer" - -#: cobc/cobc.c:974 -#, c-format -msgid "cannot reallocate %d bytes of memory" -msgstr "cannot reallocate %d bytes of memory" - -#: cobc/cobc.c:1068 cobc/cobc.c:1184 -msgid "attempt to reallocate non-allocated memory" -msgstr "attempt to reallocate non-allocated memory" - -#: cobc/cobc.c:1101 cobc/cobc.c:1217 -#, c-format -msgid "call to %s with invalid pointer, as it is missing in list" -msgstr "call to %s with invalid pointer, as it is missing in list" - -#: cobc/cobc.c:1390 -#, c-format -msgid "assuming literal for unquoted '%s'" -msgstr "assuming literal for unquoted ‘%s’" - -#: cobc/cobc.c:1437 -msgid " - length exceeds maximum" -msgstr " - length exceeds maximum" - -#: cobc/cobc.c:1441 -msgid " - name cannot be empty" -msgstr " - name cannot be empty" - -#: cobc/cobc.c:1444 -msgid " - name cannot begin with space or underscore" -msgstr " - name cannot begin with space or underscore" - -#: cobc/cobc.c:1447 -msgid " - name cannot begin with 'cob_' or 'COB_'" -msgstr " - name cannot begin with ‘cob_’ or ‘COB_’" - -#: cobc/cobc.c:1450 -msgid " - name duplicates a 'C' keyword" -msgstr " - name duplicates a ‘C’ keyword" - -#: cobc/cobc.c:1453 -msgid " - name cannot contain a directory separator" -msgstr " - name cannot contain a directory separator" - -#: cobc/cobc.c:1462 -#, c-format -msgid "invalid file base name '%s'%s" -msgstr "invalid file base name '%s'%s" - -#: cobc/cobc.c:1466 -#, c-format -msgid "invalid ENTRY '%s'%s" -msgstr "invalid ENTRY '%s'%s" - -#: cobc/cobc.c:1469 -#, c-format -msgid "invalid PROGRAM-ID '%s'%s" -msgstr "invalid PROGRAM-ID '%s'%s" - -#: cobc/cobc.c:1596 cobc/cobc.c:8151 -msgid "please check environment variables as noted above" -msgstr "please check environment variables as noted above" - -#: cobc/cobc.c:1608 cobc/error.c:254 cobc/error.c:274 cobc/error.c:505 -#: cobc/error.c:528 -msgid "error: " -msgstr "error: " - -#: cobc/cobc.c:1631 -#, c-format -msgid "duplicate DEFINE '%s' - ignored" -msgstr "duplicate DEFINE ‘%s’ - ignored" - -#: cobc/cobc.c:1683 -#, c-format -msgid "environment variable '%s' is '%s'; should not contain '%c'" -msgstr "environment variable ‘%s’ is '%s'; should not contain ‘%c’" - -#: cobc/cobc.c:1712 -msgid "parameter buffer size exceeded" -msgstr "parameter buffer size exceeded" - -#: cobc/cobc.c:1752 -#, c-format -msgid "warning: could not move temporary file to %s" -msgstr "warning: could not move temporary file to %s" - -#: cobc/cobc.c:1957 cobc/cobc.c:1960 cobc/parser.y:803 cobc/reserved.c:3807 -#: libcob/common.c:761 libcob/common.c:1805 libcob/common.c:2002 -#: libcob/common.c:6325 libcob/common.c:7495 libcob/common.c:8025 -#: libcob/common.c:8104 -msgid "unknown" -msgstr "unknown" - -#: cobc/cobc.c:1963 -#, c-format -msgid "aborting codegen for %s (%s: %s)" -msgstr "aborting codegen for %s (%s: %s)" - -#: cobc/cobc.c:1966 -#, c-format -msgid "aborting compile of %s at line %d (%s: %s)" -msgstr "aborting compile of %s at line %d (%s: %s)" - -#: cobc/cobc.c:1970 -msgid "aborting" -msgstr "aborting" - -#: cobc/cobc.c:1993 cobc/cobc.c:2028 libcob/common.c:7086 bin/cobcrun.c:342 -msgid "Please report this!" -msgstr "Please report this!" - -#: cobc/cobc.c:2046 bin/cobcrun.c:106 -msgid "License GPLv3+: GNU GPL version 3 or later " -msgstr "License GPLv3+: GNU GPL version 3 or later " - -#: cobc/cobc.c:2047 libcob/common.c:7316 bin/cobcrun.c:107 -msgid "" -"This is free software; see the source for copying conditions. There is NO\n" -"warranty; not even for MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE." -msgstr "" -"This is free software; see the source for copying conditions. There is NO\n" -"warranty; not even for MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE." - -#: cobc/cobc.c:2049 libcob/common.c:7318 bin/cobcrun.c:109 -#, c-format -msgid "Written by %s\n" -msgstr "Written by %s\n" - -#. TRANSLATORS: This msgid is indented as the "Packaged" msgid, %s expands to date and time -#: cobc/cobc.c:2050 cobc/cobc.c:2063 libcob/common.c:7321 bin/cobcrun.c:110 -#, c-format -msgid "Built %s" -msgstr "Built %s" - -#. TRANSLATORS: This msgid is indented as the "Built" msgid, %s expands to date and time -#: cobc/cobc.c:2052 cobc/cobc.c:2065 libcob/common.c:7324 bin/cobcrun.c:112 -#, c-format -msgid "Packaged %s" -msgstr "Packaged %s" - -#: cobc/cobc.c:2054 cobc/cobc.c:2067 -#, c-format -msgid "C version %s%s" -msgstr "C version %s%s" - -#: cobc/cobc.c:2080 -msgid "executing:" -msgstr "executing:" - -#: cobc/cobc.c:2082 -msgid "to be executed:" -msgstr "to be executed:" - -#: cobc/cobc.c:2120 cobc/cobc.c:2121 libcob/common.c:5815 libcob/common.c:5816 -#: libcob/common.c:5847 libcob/common.c:5848 -msgid "env" -msgstr "env" - -#: cobc/cobc.c:2156 libcob/common.c:7351 -msgid "build information" -msgstr "build information" - -#: cobc/cobc.c:2157 libcob/common.c:7352 -msgid "build environment" -msgstr "build environment" - -#: cobc/cobc.c:2167 libcob/common.c:7363 -msgid "GnuCOBOL information" -msgstr "GnuCOBOL information" - -#: cobc/cobc.c:2212 libcob/common.c:6366 libcob/common.c:7386 -#: libcob/common.c:7486 libcob/common.c:7493 -msgid "yes" -msgstr "yes" - -#: cobc/cobc.c:2214 libcob/common.c:6368 libcob/common.c:7388 -#: libcob/common.c:7488 -msgid "no" -msgstr "no" - -#: cobc/cobc.c:2218 libcob/common.c:7392 -msgid "8 bytes" -msgstr "8 bytes" - -#: cobc/cobc.c:2220 libcob/common.c:7394 -msgid "4 bytes" -msgstr "4 bytes" - -#: cobc/cobc.c:2224 cobc/cobc.c:2226 libcob/common.c:7398 libcob/common.c:7400 -msgid "endianness" -msgstr "endianness" - -#: cobc/cobc.c:2224 libcob/common.c:7398 -msgid "big-endian" -msgstr "big-endian" - -#: cobc/cobc.c:2226 libcob/common.c:7400 -msgid "little-endian" -msgstr "little-endian" - -#: cobc/cobc.c:2230 cobc/cobc.c:2232 libcob/common.c:7404 libcob/common.c:7406 -msgid "native character set" -msgstr "native character set" - -#: cobc/cobc.c:2230 libcob/common.c:7404 -msgid "EBCDIC" -msgstr "EBCDIC" - -#: cobc/cobc.c:2232 libcob/common.c:7406 -msgid "ASCII" -msgstr "ASCII" - -#: cobc/cobc.c:2235 libcob/common.c:7410 libcob/common.c:7476 -msgid "extended screen I/O" -msgstr "extended screen I/O" - -#: cobc/cobc.c:2238 libcob/common.c:7502 -msgid "variable file format" -msgstr "variable file format" - -#: cobc/cobc.c:2244 cobc/cobc.c:2246 libcob/common.c:7508 libcob/common.c:7510 -msgid "sequential file handler" -msgstr "sequential file handler" - -#: cobc/cobc.c:2246 libcob/common.c:7510 -msgid "built-in" -msgstr "built-in" - -#: cobc/cobc.c:2254 cobc/cobc.c:2260 cobc/cobc.c:2262 cobc/cobc.c:2269 -#: cobc/cobc.c:2271 cobc/cobc.c:2275 cobc/cobc.c:2278 cobc/cobc.c:2282 -#: cobc/cobc.c:2284 cobc/cobc.c:2289 cobc/cobc.c:2291 cobc/cobc.c:2298 -#: cobc/cobc.c:2300 cobc/cobc.c:2307 libcob/common.c:7516 libcob/common.c:7527 -#: libcob/common.c:7533 libcob/common.c:7535 libcob/common.c:7539 -#: libcob/common.c:7542 libcob/common.c:7546 libcob/common.c:7548 -#: libcob/common.c:7553 libcob/common.c:7555 libcob/common.c:7562 -#: libcob/common.c:7564 libcob/common.c:7571 -msgid "indexed file handler" -msgstr "indexed file handler" - -#: cobc/cobc.c:2304 libcob/common.c:7568 -msgid "default indexed handler" -msgstr "default indexed handler" - -#: cobc/cobc.c:2307 cobc/cobc.c:2319 cobc/cobc.c:2325 libcob/common.c:7381 -#: libcob/common.c:7498 libcob/common.c:7571 libcob/common.c:7611 -#: libcob/common.c:7625 -msgid "disabled" -msgstr "disabled" - -#: cobc/cobc.c:2311 cobc/cobc.c:2313 libcob/common.c:7594 libcob/common.c:7596 -msgid "mathematical library" -msgstr "mathematical library" - -#: cobc/cobc.c:2317 cobc/cobc.c:2319 libcob/common.c:7605 libcob/common.c:7611 -msgid "XML library" -msgstr "XML library" - -#: cobc/cobc.c:2323 cobc/cobc.c:2325 libcob/common.c:7623 libcob/common.c:7625 -msgid "JSON library" -msgstr "JSON library" - -#: cobc/cobc.c:2332 -msgid "only one of options 'E', 'S', 'C', 'c' may be specified" -msgstr "only one of options 'E', 'S', 'C', ‘c’ may be specified" - -#: cobc/cobc.c:2338 -msgid "only one of options 'm', 'x', 'b' may be specified" -msgstr "only one of options 'm', 'x', ‘b’ may be specified" - -#: cobc/cobc.c:2367 -#, c-format -msgid "-fdump= requires one of 'ALL', 'FD', 'WS', 'LS', 'RD', 'FD', 'SC' not '%s'" -msgstr "-fdump= requires one of 'ALL', 'FD', 'WS', 'LS', 'RD', 'FD', ‘SC’ not ‘%s’" - -#: cobc/cobc.c:2392 -#, c-format -msgid "'%s' is not an intrinsic function" -msgstr "‘%s’ is not an intrinsic function" - -#: cobc/cobc.c:2434 cobc/cobc.c:7516 cobc/cobc.c:7630 cobc/codegen.c:3796 -#: cobc/codegen.c:3905 cobc/codegen.c:5221 cobc/codegen.c:12426 cobc/tree.c:789 -#: cobc/tree.c:1221 cobc/tree.c:4101 cobc/tree.c:4648 cobc/tree.c:4891 -#: cobc/typeck.c:3294 cobc/typeck.c:7812 cobc/typeck.c:7847 cobc/typeck.c:8660 -#: cobc/typeck.c:11261 cobc/typeck.c:11329 cobc/typeck.c:11397 -#: cobc/typeck.c:11681 cobc/typeck.c:11724 -#, c-format -msgid "call to '%s' with invalid parameter '%s'" -msgstr "call to ‘%s’ with invalid parameter ‘%s’" - -#: cobc/cobc.c:2737 -msgid "loading standard configuration file 'default.conf'" -msgstr "loading standard configuration file ‘default.conf’" - -#: cobc/cobc.c:2871 -msgid "invalid output file name" -msgstr "invalid output file name" - -#: cobc/cobc.c:2971 -#, c-format -msgid "warning: '%s' is not a directory, defaulting to current directory" -msgstr "warning: ‘%s’ is not a directory, defaulting to current directory" - -#: cobc/cobc.c:2998 -#, c-format -msgid "warning: %d lines per listing page specified, using %d" -msgstr "warning: %d lines per listing page specified, using %d" - -#: cobc/cobc.c:3048 -#, c-format -msgid "warning: assuming '%s' is a DEFINE - did you intend to use -debug?" -msgstr "warning: assuming ‘%s’ is a DEFINE - did you intend to use -debug?" - -#: cobc/cobc.c:3315 -#, c-format -msgid "unknown warning option '%s'" -msgstr "unknown warning option ‘%s’" - -#: cobc/cobc.c:3367 -#, c-format -msgid "%s option requires a listing file" -msgstr "%s option requires a listing file" - -#: cobc/cobc.c:3374 -msgid "output to stdout only valid for preprocess" -msgstr "output to stdout only valid for preprocess" - -#: cobc/cobc.c:3466 -msgid "all runtime checks are enabled" -msgstr "all runtime checks are enabled" - -#: cobc/cobc.c:3572 -msgid "only one stdin input allowed" -msgstr "only one stdin input allowed" - -#: cobc/cobc.c:3582 -#, c-format -msgid "invalid file name parameter (length > %d)" -msgstr "invalid file name parameter (length > %d)" - -#: cobc/cobc.c:3807 -msgid "nothing for -j to run" -msgstr "nothing for -j to run" - -#: cobc/cobc.c:3883 cobc/cobc.c:4071 cobc/cobc.c:4130 cobc/cobc.c:4158 -#: cobc/cobc.c:4247 cobc/cobc.c:4306 cobc/cobc.c:4430 cobc/cobc.c:4469 -#: cobc/cobc.c:6993 -msgid "return status:" -msgstr "return status:" - -#: cobc/cobc.c:4361 -msgid "preprocessing:" -msgstr "preprocessing:" - -#: cobc/cobc.c:4435 -msgid "'cobxref' execution unsuccessful" -msgstr "‘cobxref’ execution unsuccessful" - -#: cobc/cobc.c:4438 -#, c-format -msgid "check that 'cobxref' is in %s" -msgstr "check that ‘cobxref’ is in %s" - -#: cobc/cobc.c:4440 -msgid "no listing produced" -msgstr "no listing produced" - -#: cobc/cobc.c:5328 cobc/cobc.c:5367 -msgid "No fields defined." -msgstr "No fields defined." - -#: cobc/cobc.c:5387 -msgid "No labels defined." -msgstr "No labels defined." - -#: cobc/cobc.c:5409 -msgid "Error/Warning summary:" -msgstr "Error/Warning summary:" - -#: cobc/cobc.c:5453 -msgid "0 warnings in compilation group" -msgstr "0 warnings in compilation group" - -#: cobc/cobc.c:5457 -msgid "1 warning in compilation group" -msgstr "1 warning in compilation group" - -#: cobc/cobc.c:5461 -#, c-format -msgid "%d warnings in compilation group" -msgstr "%d warnings in compilation group" - -#: cobc/cobc.c:5467 -msgid "0 errors in compilation group" -msgstr "0 errors in compilation group" - -#: cobc/cobc.c:5471 -msgid "1 error in compilation group" -msgstr "1 error in compilation group" - -#: cobc/cobc.c:5475 -#, c-format -msgid "%d errors in compilation group" -msgstr "%d errors in compilation group" - -#: cobc/cobc.c:5481 -#, c-format -msgid "Too many errors in compilation group: %d maximum errors" -msgstr "Too many errors in compilation group: %d maximum errors" - -#: cobc/cobc.c:6050 -#, c-format -msgid "%s: %d: Too many continuation lines" -msgstr "%s: %d: Too many continuation lines" - -#: cobc/cobc.c:6972 -msgid "parsing:" -msgstr "parsing:" - -#: cobc/cobc.c:7034 -msgid "translating:" -msgstr "translating:" - -#: cobc/cobc.c:8157 -msgid "no input files" -msgstr "no input files" - -#: cobc/cobc.c:8186 -#, c-format -msgid "%s option invalid in this combination" -msgstr "%s option invalid in this combination" - -#: cobc/cobc.c:8227 -msgid "command line:" -msgstr "command line:" - -#: cobc/codegen.c:973 cobc/codegen.c:4487 cobc/codegen.c:11093 -msgid "unexpected CONSTANT item" -msgstr "unexpected CONSTANT item" - -#: cobc/codegen.c:1188 cobc/codegen.c:1196 cobc/codegen.c:1291 -#: cobc/codegen.c:1603 cobc/codegen.c:2202 cobc/codegen.c:3212 -#: cobc/codegen.c:3455 cobc/codegen.c:3988 cobc/codegen.c:4454 -#: cobc/codegen.c:7902 cobc/codegen.c:8507 cobc/codegen.c:10298 -#: cobc/field.c:817 cobc/scanner.l:2104 cobc/tree.c:611 cobc/tree.c:3728 -#: cobc/typeck.c:5015 cobc/typeck.c:8662 cobc/typeck.c:9657 -#, c-format -msgid "unexpected tree tag: %d" -msgstr "unexpected tree tag: %d" - -#: cobc/codegen.c:2999 cobc/codegen.c:3295 cobc/codegen.c:8125 cobc/tree.c:1243 -#, c-format -msgid "unexpected cast type: %d" -msgstr "unexpected cast type: %d" - -#: cobc/codegen.c:3725 cobc/codegen.c:4434 -#, c-format -msgid "internal statement stack depth exceeded: %d" -msgstr "internal statement stack depth exceeded: %d" - -#: cobc/codegen.c:3798 -#, c-format -msgid "%s is not a field" -msgstr "%s is not a field" - -#: cobc/codegen.c:4186 cobc/codegen.c:4279 -#, c-format -msgid "unexpected function: %s" -msgstr "unexpected function: %s" - -#: cobc/codegen.c:4270 -#, c-format -msgid "unexpected operator: %c" -msgstr "unexpected operator: %c" - -#: cobc/codegen.c:5043 -#, c-format -msgid "unexpected tree category: %d" -msgstr "unexpected tree category: %d" - -#: cobc/codegen.c:5438 cobc/codegen.c:5465 cobc/codegen.c:5662 -#: cobc/codegen.c:5694 -#, c-format -msgid "unexpected size: %d" -msgstr "unexpected size: %d" - -#: cobc/codegen.c:7254 -#, c-format -msgid "No ENTRY FOR GO TO '%s'" -msgstr "No ENTRY FOR GO TO ‘%s’" - -#: cobc/codegen.c:7475 cobc/codegen.c:7725 -#, c-format -msgid "unexpected handler type: %d" -msgstr "unexpected handler type: %d" - -#: cobc/codegen.c:7823 -msgid "unexpected error_node parameter" -msgstr "unexpected error_node parameter" - -#: cobc/codegen.c:8146 -#, c-format -msgid "unexpected tree type: %d" -msgstr "unexpected tree type: %d" - -#: cobc/codegen.c:8703 cobc/typeck.c:6511 cobc/typeck.c:12940 -#: cobc/typeck.c:12984 -#, c-format -msgid "compiler is not configured to support %s" -msgstr "compiler is not configured to support %s" - -#: cobc/codegen.c:9128 -msgid "Nested OCCURS in report" -msgstr "Nested OCCURS in report" - -#: cobc/codeoptim.c:2762 -#, c-format -msgid "unexpected optimization value: %d" -msgstr "unexpected optimization value: %d" - -#: cobc/config.c:162 libcob/common.c:6786 libcob/common.c:6800 -#: libcob/common.c:7242 -#, c-format -msgid "invalid value '%s' for configuration tag '%s'" -msgstr "invalid value ‘%s’ for configuration tag ‘%s’" - -#: cobc/config.c:165 libcob/common.c:6093 libcob/common.c:6209 -#, c-format -msgid "should be one of the following values: %s" -msgstr "should be one of the following values: %s" - -#: cobc/config.c:167 -msgid "must be numeric" -msgstr "must be numeric" - -#: cobc/config.c:169 libcob/common.c:6191 -#, c-format -msgid "maximum value: %lu" -msgstr "maximum value: %lu" - -#: cobc/config.c:171 -#, c-format -msgid "minimum value: %d" -msgstr "minimum value: %d" - -#: cobc/config.c:203 -#, c-format -msgid "unsupported value '%s' for configuration tag '%s'" -msgstr "unsupported value ‘%s’ for configuration tag ‘%s’" - -#: cobc/config.c:311 cobc/pplex.l:977 libcob/common.c:6702 -msgid "recursive inclusion" -msgstr "recursive inclusion" - -#: cobc/config.c:386 libcob/common.c:6753 -msgid "configuration file was included here" -msgstr "configuration file was included here" - -#: cobc/config.c:415 -#, c-format -msgid "The previous loaded configuration '%s' will be discarded." -msgstr "The previous loaded configuration ‘%s’ will be discarded." - -#: cobc/config.c:449 -msgid "missing definitions:" -msgstr "missing definitions:" - -#: cobc/config.c:451 -#, c-format -msgid "\tno definition of '%s'" -msgstr "\tno definition of ‘%s’" - -#: cobc/config.c:512 -#, c-format -msgid "invalid configuration tag '%s'" -msgstr "invalid configuration tag ‘%s’" - -#: cobc/config.c:525 libcob/common.c:6509 libcob/common.c:6592 -#: libcob/common.c:6620 -#, c-format -msgid "unknown configuration tag '%s'" -msgstr "unknown configuration tag ‘%s’" - -#: cobc/config.c:549 -#, c-format -msgid "invalid configuration tag '%s' in word-list" -msgstr "invalid configuration tag ‘%s’ in word-list" - -#: cobc/config.c:608 -#, c-format -msgid "Could not access word list for '%s'" -msgstr "Could not access word list for ‘%s’" - -#: cobc/error.c:87 -#, c-format -msgid "in section '%s':" -msgstr "in section '%s':" - -#: cobc/error.c:98 -#, c-format -msgid "in paragraph '%s':" -msgstr "in paragraph '%s':" - -#: cobc/error.c:121 libcob/common.c:7252 -msgid "configuration error:" -msgstr "configuration error:" - -#: cobc/error.c:134 libcob/common.c:673 -#, c-format -msgid "system error %d" -msgstr "system error %d" - -#: cobc/error.c:231 cobc/error.c:323 cobc/error.c:478 -msgid "error [-Werror]: " -msgstr "error [-Werror]: " - -#: cobc/error.c:231 cobc/error.c:323 cobc/error.c:478 cobc/error.c:505 -#: libcob/common.c:6881 libcob/common.c:6906 -#, c-format -msgid "warning: " -msgstr "warning: " - -#: cobc/error.c:274 cobc/error.c:528 -msgid "error (ignored): " -msgstr "error (ignored): " - -#: cobc/error.c:364 cobc/error.c:380 cobc/error.c:563 cobc/error.c:584 -#, c-format -msgid "%s used" -msgstr "%s used" - -#: cobc/error.c:367 cobc/error.c:566 -#, c-format -msgid "%s is archaic in %s" -msgstr "%s is archaic in %s" - -#: cobc/error.c:371 cobc/error.c:570 -#, c-format -msgid "%s is obsolete in %s" -msgstr "%s is obsolete in %s" - -#: cobc/error.c:377 cobc/error.c:576 cobc/parser.y:5186 cobc/parser.y:5325 -#, c-format -msgid "%s ignored" -msgstr "%s ignored" - -#: cobc/error.c:383 cobc/error.c:586 -#, c-format -msgid "%s does not conform to %s" -msgstr "%s does not conform to %s" - -#: cobc/error.c:399 -msgid "configuration warning:" -msgstr "configuration warning:" - -#: cobc/error.c:621 cobc/error.c:640 -#, c-format -msgid "redefinition of '%s'" -msgstr "redefinition of ‘%s’" - -#: cobc/error.c:628 cobc/error.c:653 -#, c-format -msgid "'%s' previously defined here" -msgstr "‘%s’ previously defined here" - -#: cobc/error.c:677 cobc/error.c:684 -#, c-format -msgid "'%s' is not defined" -msgstr "‘%s’ is not defined" - -#: cobc/error.c:680 -#, c-format -msgid "'%s' cannot be used here" -msgstr "‘%s’ cannot be used here" - -#: cobc/error.c:682 cobc/parser.y:7009 -#, c-format -msgid "'%s' is not defined, but is a reserved word in another dialect" -msgstr "‘%s’ is not defined, but is a reserved word in another dialect" - -#: cobc/error.c:716 -#, c-format -msgid "'%s' is ambiguous; needs qualification" -msgstr "‘%s’ is ambiguous; needs qualification" - -#: cobc/error.c:746 cobc/parser.y:16748 -#, c-format -msgid "'%s' defined here" -msgstr "‘%s’ defined here" - -#: cobc/error.c:757 -#, c-format -msgid "fatal error: %s" -msgstr "fatal error: %s" - -#: cobc/error.c:765 -#, c-format -msgid "group item '%s' cannot have %s clause" -msgstr "group item ‘%s’ cannot have %s clause" - -#: cobc/error.c:779 -#, c-format -msgid "constant item '%s' requires a %s clause" -msgstr "constant item ‘%s’ requires a %s clause" - -#: cobc/error.c:781 -#, c-format -msgid "level %02d item '%s' requires a %s clause" -msgstr "level %02d item ‘%s’ requires a %s clause" - -#: cobc/error.c:795 -#, c-format -msgid "constant item '%s' can only have a %s clause" -msgstr "constant item ‘%s’ can only have a %s clause" - -#: cobc/error.c:797 -#, c-format -msgid "level %02d item '%s' can only have a %s clause" -msgstr "level %02d item ‘%s’ can only have a %s clause" - -#: cobc/field.c:131 -msgid "constant expression has Divide by ZERO" -msgstr "constant expression has Divide by ZERO" - -#: cobc/field.c:187 cobc/field.c:324 cobc/field.c:332 -msgid "missing right parenthesis" -msgstr "missing right parenthesis" - -#: cobc/field.c:216 -#, c-format -msgid "expression stack overflow at %d entries for operation '%c'" -msgstr "expression stack overflow at %d entries for operation ‘%c’" - -#: cobc/field.c:257 -#, c-format -msgid "expression stack overflow at %d entries" -msgstr "expression stack overflow at %d entries" - -#: cobc/field.c:274 -msgid "missing left parenthesis" -msgstr "missing left parenthesis" - -#: cobc/field.c:315 -#, c-format -msgid "invalid operator '%s' in expression" -msgstr "invalid operator ‘%s’ in expression" - -#: cobc/field.c:334 -#, c-format -msgid "'%c' operator misplaced" -msgstr "‘%c’ operator misplaced" - -#: cobc/field.c:395 -#, c-format -msgid "invalid level number '%s'" -msgstr "invalid level number ‘%s’" - -#: cobc/field.c:454 -msgid "entry following SAME AS may not be subordinate to it" -msgstr "entry following SAME AS may not be subordinate to it" - -#: cobc/field.c:459 cobc/field.c:496 -msgid "level number must begin with 01 or 77" -msgstr "level number must begin with 01 or 77" - -#: cobc/field.c:541 cobc/field.c:557 -#, c-format -msgid "no previous data item of level %02d" -msgstr "no previous data item of level %02d" - -#: cobc/field.c:599 -#, c-format -msgid "'%s' cannot be qualified here" -msgstr "‘%s’ cannot be qualified here" - -#: cobc/field.c:605 -#, c-format -msgid "'%s' cannot be subscripted here" -msgstr "‘%s’ cannot be subscripted here" - -#: cobc/field.c:617 -#, c-format -msgid "'%s' is not defined in '%s'" -msgstr "‘%s’ is not defined in ‘%s’" - -#: cobc/field.c:638 -msgid "level number of REDEFINES entries must be identical" -msgstr "level number of REDEFINES entries must be identical" - -#: cobc/field.c:643 -#, c-format -msgid "'%s' is not the original definition" -msgstr "‘%s’ is not the original definition" - -#: cobc/field.c:758 -#, c-format -msgid "PICTURE clause not compatible with USAGE %s" -msgstr "PICTURE clause not compatible with USAGE %s" - -#: cobc/field.c:855 cobc/field.c:930 cobc/field.c:941 -#, c-format -msgid "PICTURE clause required for '%s'" -msgstr "PICTURE clause required for ‘%s’" - -#: cobc/field.c:937 -#, c-format -msgid "a non-numeric literal is expected for '%s'" -msgstr "a non-numeric literal is expected for ‘%s’" - -#: cobc/field.c:949 -#, c-format -msgid "defining implicit picture size %d for '%s'" -msgstr "defining implicit picture size %d for ‘%s’" - -#: cobc/field.c:969 -#, c-format -msgid "'%s' ANY LENGTH only allowed in LINKAGE" -msgstr "‘%s’ ANY LENGTH only allowed in LINKAGE" - -#: cobc/field.c:973 -#, c-format -msgid "'%s' ANY LENGTH must be 01 level" -msgstr "‘%s’ ANY LENGTH must be 01 level" - -#: cobc/field.c:977 -#, c-format -msgid "'%s' ANY LENGTH cannot be BASED/EXTERNAL" -msgstr "‘%s’ ANY LENGTH cannot be BASED/EXTERNAL" - -#: cobc/field.c:982 cobc/field.c:1010 -#, c-format -msgid "'%s' ANY LENGTH has invalid definition" -msgstr "‘%s’ ANY LENGTH has invalid definition" - -#: cobc/field.c:993 -#, c-format -msgid "'%s' ANY NUMERIC must be PIC 9" -msgstr "‘%s’ ANY NUMERIC must be PIC 9" - -#: cobc/field.c:998 -#, c-format -msgid "'%s' ANY LENGTH must be PIC X or PIC N" -msgstr "‘%s’ ANY LENGTH must be PIC X or PIC N" - -#: cobc/field.c:1008 -#, c-format -msgid "'%s' ANY NUMERIC has invalid definition" -msgstr "‘%s’ ANY NUMERIC has invalid definition" - -#: cobc/field.c:1026 -#, c-format -msgid "'%s' EXTERNAL must be specified at 01/77 level" -msgstr "‘%s’ EXTERNAL must be specified at 01/77 level" - -#: cobc/field.c:1030 -#, c-format -msgid "'%s' EXTERNAL can only be specified in WORKING-STORAGE section" -msgstr "‘%s’ EXTERNAL can only be specified in WORKING-STORAGE section" - -#: cobc/field.c:1034 -#, c-format -msgid "'%s' EXTERNAL and BASED are mutually exclusive" -msgstr "‘%s’ EXTERNAL and BASED are mutually exclusive" - -#: cobc/field.c:1037 -#, c-format -msgid "'%s' EXTERNAL not allowed with REDEFINES" -msgstr "‘%s’ EXTERNAL not allowed with REDEFINES" - -#: cobc/field.c:1049 -#, c-format -msgid "'%s' BASED not allowed here" -msgstr "‘%s’ BASED not allowed here" - -#: cobc/field.c:1052 -#, c-format -msgid "'%s' BASED not allowed with REDEFINES" -msgstr "‘%s’ BASED not allowed with REDEFINES" - -#: cobc/field.c:1055 -#, c-format -msgid "'%s' BASED only allowed at the 01 and 77 levels" -msgstr "‘%s’ BASED only allowed at the 01 and 77 levels" - -#: cobc/field.c:1067 -#, c-format -msgid "level %02d item '%s' cannot have a %s clause" -msgstr "level %02d item ‘%s’ cannot have a %s clause" - -#: cobc/field.c:1082 -#, c-format -msgid "'%s' cannot have the OCCURS clause due to '%s'" -msgstr "‘%s’ cannot have the OCCURS clause due to ‘%s’" - -#: cobc/field.c:1101 -#, c-format -msgid "the original definition '%s' should not have OCCURS clause" -msgstr "the original definition ‘%s’ should not have OCCURS clause" - -#: cobc/field.c:1108 -msgid "REDEFINES must follow the original definition" -msgstr "REDEFINES must follow the original definition" - -#: cobc/field.c:1115 -#, c-format -msgid "'%s' cannot be variable length" -msgstr "‘%s’ cannot be variable length" - -#: cobc/field.c:1118 -#, c-format -msgid "the original definition '%s' cannot be variable length" -msgstr "the original definition ‘%s’ cannot be variable length" - -#: cobc/field.c:1142 -#, c-format -msgid "SCREEN group item '%s' has invalid clause" -msgstr "SCREEN group item ‘%s’ has invalid clause" - -#: cobc/field.c:1223 -#, c-format -msgid "%s USAGE %s incompatible with %s USAGE %s" -msgstr "%s USAGE %s incompatible with %s USAGE %s" - -#: cobc/field.c:1302 -#, c-format -msgid "'%s' cannot have PICTURE clause" -msgstr "‘%s’ cannot have PICTURE clause" - -#: cobc/field.c:1318 cobc/field.c:1328 -#, c-format -msgid "%s item '%s' should be USAGE DISPLAY" -msgstr "%s item ‘%s’ should be USAGE DISPLAY" - -#: cobc/field.c:1351 -#, c-format -msgid "'%s' COMP-6 with sign - changing to COMP-3" -msgstr "‘%s’ COMP-6 with sign - changing to COMP-3" - -#: cobc/field.c:1377 -msgid "elementary items with SIGN clause must have S in PICTURE" -msgstr "elementary items with SIGN clause must have S in PICTURE" - -#: cobc/field.c:1380 -msgid "elementary items with SIGN clause must be USAGE DISPLAY or NATIONAL" -msgstr "elementary items with SIGN clause must be USAGE DISPLAY or NATIONAL" - -#: cobc/field.c:1397 -#, c-format -msgid "'%s' cannot have JUSTIFIED RIGHT" -msgstr "‘%s’ cannot have JUSTIFIED RIGHT" - -#: cobc/field.c:1410 -#, c-format -msgid "'%s' cannot have S in PICTURE string and BLANK WHEN ZERO" -msgstr "‘%s’ cannot have S in PICTURE string and BLANK WHEN ZERO" - -#: cobc/field.c:1415 -#, c-format -msgid "'%s' cannot have BLANK WHEN ZERO without being USAGE DISPLAY or NATIONAL" -msgstr "‘%s’ cannot have BLANK WHEN ZERO without being USAGE DISPLAY or NATIONAL" - -#: cobc/field.c:1426 -#, c-format -msgid "'%s' cannot have * in PICTURE string and BLANK WHEN ZERO" -msgstr "‘%s’ cannot have * in PICTURE string and BLANK WHEN ZERO" - -#: cobc/field.c:1433 -#, c-format -msgid "'%s' is not numeric, so cannot have BLANK WHEN ZERO" -msgstr "‘%s’ is not numeric, so cannot have BLANK WHEN ZERO" - -#: cobc/field.c:1446 -msgid "only level 88 items may have multiple values" -msgstr "only level 88 items may have multiple values" - -#: cobc/field.c:1454 cobc/field.c:1458 -#, c-format -msgid "initial VALUE clause ignored for %s item '%s'" -msgstr "initial VALUE clause ignored for %s item ‘%s’" - -#: cobc/field.c:1471 -msgid "FULL has no effect on numeric items; you may want REQUIRED or PIC Z" -msgstr "FULL has no effect on numeric items; you may want REQUIRED or PIC Z" - -#: cobc/field.c:1499 -msgid "VALUE may not contain a figurative constant" -msgstr "VALUE may not contain a figurative constant" - -#: cobc/field.c:1507 -msgid "cannot specify both FULL and JUSTIFIED" -msgstr "cannot specify both FULL and JUSTIFIED" - -#: cobc/field.c:1519 -#, c-format -msgid "'%s' has FROM, TO or USING without PIC; PIC will be implied" -msgstr "‘%s’ has FROM, TO or USING without PIC; PIC will be implied" - -#: cobc/field.c:1533 -#, c-format -msgid "'%s' has numeric VALUE without PIC; PIC will be implied" -msgstr "‘%s’ has numeric VALUE without PIC; PIC will be implied" - -#: cobc/field.c:1548 -#, c-format -msgid "'%s' cannot have PIC without FROM, TO, USING or numeric VALUE" -msgstr "‘%s’ cannot have PIC without FROM, TO, USING or numeric VALUE" - -#: cobc/field.c:1560 -#, c-format -msgid "'%s' needs a PIC, FROM, TO, USING, VALUE, BELL, BLANK or ERASE clause" -msgstr "‘%s’ needs a PIC, FROM, TO, USING, VALUE, BELL, BLANK or ERASE clause" - -#: cobc/field.c:1574 -msgid "cannot specify both PIC and VALUE" -msgstr "cannot specify both PIC and VALUE" - -#: cobc/field.c:1582 -msgid "cannot have PIC without FROM, TO or USING" -msgstr "cannot have PIC without FROM, TO or USING" - -#: cobc/field.c:1591 -msgid "cannot have FROM, TO or USING without PIC" -msgstr "cannot have FROM, TO or USING without PIC" - -#: cobc/field.c:1600 -msgid "VALUE item may not be numeric" -msgstr "VALUE item may not be numeric" - -#: cobc/field.c:1616 -#, c-format -msgid "'%s' needs a PIC, COL, LINE, VALUE, BELL or BLANK clause" -msgstr "‘%s’ needs a PIC, COL, LINE, VALUE, BELL or BLANK clause" - -#: cobc/field.c:1647 -msgid "cannot use AUTO, FULL, PROMPT, REQUIRED or SECURE on elementary item without TO or USING" -msgstr "cannot use AUTO, FULL, PROMPT, REQUIRED or SECURE on elementary item without TO or USING" - -#: cobc/field.c:1654 -msgid "cannot use BLANK WHEN ZERO, JUSTIFIED, OCCURS or SIGN on item without FROM, TO or USING" -msgstr "cannot use BLANK WHEN ZERO, JUSTIFIED, OCCURS or SIGN on item without FROM, TO or USING" - -#: cobc/field.c:1674 -msgid "cannot use AUTO, FULL, REQUIRED or SECURE on elementary item without FROM, TO or USING" -msgstr "cannot use AUTO, FULL, REQUIRED or SECURE on elementary item without FROM, TO or USING" - -#: cobc/field.c:1679 -msgid "cannot use BLANK WHEN ZERO, JUSTIFIED or SIGN without FROM, TO or USING" -msgstr "cannot use BLANK WHEN ZERO, JUSTIFIED or SIGN without FROM, TO or USING" - -#: cobc/field.c:1697 -msgid "cannot have BLANK WHEN ZERO without PIC" -msgstr "cannot have BLANK WHEN ZERO without PIC" - -#: cobc/field.c:1700 -msgid "cannot have JUSTIFIED without PIC" -msgstr "cannot have JUSTIFIED without PIC" - -#: cobc/field.c:1720 -msgid "cannot have AUTO without FROM, TO or USING" -msgstr "cannot have AUTO without FROM, TO or USING" - -#: cobc/field.c:1725 -msgid "cannot use FULL or REQUIRED on item without TO or USING" -msgstr "cannot use FULL or REQUIRED on item without TO or USING" - -#: cobc/field.c:1732 -msgid "SECURE can be used with TO only" -msgstr "SECURE can be used with TO only" - -#: cobc/field.c:1734 -msgid "SECURE must be used with TO" -msgstr "SECURE must be used with TO" - -#: cobc/field.c:1753 -#, c-format -msgid "'%s' does nothing" -msgstr "‘%s’ does nothing" - -#: cobc/field.c:1797 -msgid "BLANK ZERO not compatible with USAGE" -msgstr "BLANK ZERO not compatible with USAGE" - -#: cobc/field.c:1800 -msgid "SIGN clause not compatible with USAGE" -msgstr "SIGN clause not compatible with USAGE" - -#: cobc/field.c:1977 -#, c-format -msgid "'%s' PICTURE clause not compatible with USAGE" -msgstr "‘%s’ PICTURE clause not compatible with USAGE" - -#: cobc/field.c:2027 -#, c-format -msgid "'%s' 77 level is not allowed here" -msgstr "‘%s’ 77 level is not allowed here" - -#: cobc/field.c:2424 -msgid "OCCURS and multi COLUMNs is not allowed" -msgstr "OCCURS and multi COLUMNs is not allowed" - -#: cobc/field.c:2452 -#, c-format -msgid "duplicate LINE %d ignored" -msgstr "duplicate LINE %d ignored" - -#: cobc/field.c:2469 -#, c-format -msgid "ignoring SYNCHRONIZED for group item '%s'" -msgstr "ignoring SYNCHRONIZED for group item ‘%s’" - -#: cobc/field.c:2485 cobc/field.c:2498 cobc/field.c:2778 cobc/field.c:2781 -#, c-format -msgid "size of '%s' larger than size of '%s'" -msgstr "size of ‘%s’ larger than size of ‘%s’" - -#: cobc/field.c:2638 cobc/field.c:2703 -#, c-format -msgid "'%s' cannot be larger than %d bytes" -msgstr "‘%s’ cannot be larger than %d bytes" - -#: cobc/field.c:2676 cobc/field.c:2684 -#, c-format -msgid "'%s' binary field cannot be larger than %d digits" -msgstr "‘%s’ binary field cannot be larger than %d digits" - -#: cobc/field.c:2764 cobc/field.c:3216 -#, c-format -msgid "unexpected USAGE: %d" -msgstr "unexpected USAGE: %d" - -#: cobc/field.c:2876 -msgid "literal type does not match numeric data type" -msgstr "literal type does not match numeric data type" - -#: cobc/field.c:2953 -#, c-format -msgid "THRU item '%s' may not come before '%s'" -msgstr "THRU item ‘%s’ may not come before ‘%s’" - -#: cobc/field.c:2976 -#, c-format -msgid "RENAMES cannot start/end at the OCCURS item '%s'" -msgstr "RENAMES cannot start/end at the OCCURS item ‘%s’" - -#: cobc/field.c:2984 -#, c-format -msgid "cannot use RENAMES on part of the table '%s'" -msgstr "cannot use RENAMES on part of the table ‘%s’" - -#: cobc/field.c:3022 -#, c-format -msgid "RENAMES may not contain '%s' as it is a pointer or object reference" -msgstr "RENAMES may not contain ‘%s’ as it is a pointer or object reference" - -#: cobc/field.c:3027 -#, c-format -msgid "RENAMES may not contain '%s' as it is an OCCURS DEPENDING table" -msgstr "RENAMES may not contain ‘%s’ as it is an OCCURS DEPENDING table" - -#: cobc/field.c:3049 -msgid "RENAMES of 01-, 66- and 77-level items" -msgstr "RENAMES of 01-, 66- and 77-level items" - -#: cobc/field.c:3051 -msgid "RENAMES may not reference a level 88" -msgstr "RENAMES may not reference a level 88" - -#: cobc/field.c:3075 -#, c-format -msgid "'%s' must immediately follow the record '%s'" -msgstr "‘%s’ must immediately follow the record ‘%s’" - -#: cobc/field.c:3083 -#, c-format -msgid "THRU item must be different to '%s'" -msgstr "THRU item must be different to ‘%s’" - -#: cobc/field.c:3089 -#, c-format -msgid "'%s' and '%s' must be in the same record" -msgstr "‘%s’ and ‘%s’ must be in the same record" - -#: cobc/field.c:3100 -#, c-format -msgid "THRU item '%s' may not be subordinate to '%s'" -msgstr "THRU item ‘%s’ may not be subordinate to ‘%s’" - -#: cobc/flag.def:40 -msgid "" -" -fstack-size=\tdefine PERFORM stack size\n" -" * default: 255" -msgstr "" -" -fstack-size=\tdefine PERFORM stack size\n" -" * default: 255" - -#: cobc/flag.def:44 -msgid "" -" -fsign=[ASCII|EBCDIC]\tdefine display sign representation\n" -" * default: machine native" -msgstr "" -" -fsign=[ASCII|EBCDIC]\tdefine display sign representation\n" -" * default: machine native" - -#: cobc/flag.def:48 -msgid "" -" -ffold-copy=[UPPER|LOWER]\tfold COPY subject to value\n" -" * default: no transformation" -msgstr "" -" -ffold-copy=[UPPER|LOWER]\tfold COPY subject to value\n" -" * default: no transformation" - -#: cobc/flag.def:52 -msgid "" -" -ffold-call=[UPPER|LOWER]\tfold PROGRAM-ID, CALL, CANCEL subject to value\n" -" * default: no transformation" -msgstr "" -" -ffold-call=[UPPER|LOWER]\tfold PROGRAM-ID, CALL, CANCEL subject to value\n" -" * default: no transformation" - -#: cobc/flag.def:56 -msgid "" -" -fdefaultbyte=\tinitialize fields without VALUE to value\n" -" * decimal 0..255 or any quoted character\n" -" * default: initialize to picture" -msgstr "" -" -fdefaultbyte=\tinitialize fields without VALUE to value\n" -" * decimal 0..255 or any quoted character\n" -" * default: initialize to picture" - -#: cobc/flag.def:61 -msgid "" -" -fmax-errors=\tmaximum number of errors to report before\n" -" compilation is aborted\n" -" * default: 128" -msgstr "" -" -fmax-errors=\tmaximum number of errors to report before\n" -" compilation is aborted\n" -" * default: 128" - -#: cobc/flag.def:68 -msgid "" -" -fintrinsics=[ALL|intrinsic function name(,name,...)]\n" -" intrinsics to be used without FUNCTION keyword" -msgstr "" -" -fintrinsics=[ALL|intrinsic function name(,name,...)]\n" -" intrinsics to be used without FUNCTION keyword" - -#: cobc/flag.def:72 -msgid "" -" -fdump= dump data fields on abort, may be\n" -" a combination of: ALL, WS, LS, RD, FD, SC" -msgstr "" -" -fdump= dump data fields on abort, may be\n" -" a combination of: ALL, WS, LS, RD, FD, SC" - -#: cobc/flag.def:76 -msgid "" -" -fcallfh= use external provided EXTFH interface module\n" -" for I/O" -msgstr "" -" -fcallfh= use external provided EXTFH interface module\n" -" for I/O" - -#: cobc/flag.def:80 -msgid "" -" -fsqldb= which Database is used, may be\n" -" MySQL, MSSQL, Oracle10, Oracle11, Oracle12" -msgstr "" -" -fsqldb= which Database is used, may be\n" -" MySQL, MSSQL, Oracle10, Oracle11, Oracle12" - -#: cobc/flag.def:84 -msgid " -fsqlschema= define database schema name" -msgstr " -fsqlschema= define database schema name" - -#: cobc/flag.def:91 -msgid "" -" -fno-recursive-check disable check of recursive program call;\n" -" effectively compiling as RECURSIVE program" -msgstr "" -" -fno-recursive-check disable check of recursive program call;\n" -" effectively compiling as RECURSIVE program" - -#: cobc/flag.def:95 -msgid "" -" -fwinmain generate WinMain instead of main when compiling\n" -" as executable" -msgstr "" -" -fwinmain generate WinMain instead of main when compiling\n" -" as executable" - -#: cobc/flag.def:99 -msgid " -fcomputed-goto generate computed goto C statements" -msgstr " -fcomputed-goto generate computed goto C statements" - -#: cobc/flag.def:102 -msgid " -falternate-ebcdic use restricted ASCII to EBCDIC translate" -msgstr " -falternate-ebcdic use restricted ASCII to EBCDIC translate" - -#: cobc/flag.def:105 -msgid " -fextra-brace generate extra braces in C source" -msgstr " -fextra-brace generate extra braces in C source" - -#: cobc/flag.def:108 -msgid " -fgen-c-line-directives\tgenerate source location directives in C code" -msgstr " -fgen-c-line-directives\tgenerate source location directives in C code" - -#: cobc/flag.def:111 -msgid " -fgen-c-labels generate extra labels in C sources" -msgstr " -fgen-c-labels generate extra labels in C sources" - -#: cobc/flag.def:114 -msgid " -fcorrect-numeric attempt correction of invalid numeric display items" -msgstr " -fcorrect-numeric attempt correction of invalid numeric display items" - -#: cobc/flag.def:117 -msgid " -fstack-on-heap PERFORM stack allocated on heap" -msgstr " -fstack-on-heap PERFORM stack allocated on heap" - -#: cobc/flag.def:120 -msgid " -ffast-math Disables emitting faster arithmetic logic" -msgstr " -ffast-math Disables emitting faster arithmetic logic" - -#: cobc/flag.def:125 -msgid "" -" -fno-remove-unreachable\tdisable remove of unreachable code\n" -" * turned off by -g" -msgstr "" -" -fno-remove-unreachable\tdisable remove of unreachable code\n" -" * turned off by -g" - -#: cobc/flag.def:129 -msgid " -finline-intrinsic\twhen possible resolve intrinsic FUNCTIONs at compile time" -msgstr " -finline-intrinsic\twhen possible resolve intrinsic FUNCTIONs at compile time" - -#: cobc/flag.def:132 -msgid "" -" -ftrace generate trace code\n" -" * scope: executed SECTION/PARAGRAPH" -msgstr "" -" -ftrace generate trace code\n" -" * scope: executed SECTION/PARAGRAPH" - -#: cobc/flag.def:136 -msgid "" -" -ftraceall generate trace code\n" -" * scope: executed SECTION/PARAGRAPH/STATEMENTS\n" -" * turned on by -debug" -msgstr "" -" -ftraceall generate trace code\n" -" * scope: executed SECTION/PARAGRAPH/STATEMENTS\n" -" * turned on by -debug" - -#: cobc/flag.def:141 -msgid " -fsyntax-only syntax error checking only; don't emit any output" -msgstr " -fsyntax-only syntax error checking only; don't emit any output" - -#: cobc/flag.def:144 -msgid "" -" -fdebugging-line enable debugging lines\n" -" * 'D' in indicator column or floating >>D" -msgstr "" -" -fdebugging-line enable debugging lines\n" -" * ‘D’ in indicator column or floating >>D" - -#: cobc/flag.def:148 -msgid "" -" -fsource-location generate source location code\n" -" * turned on by -debug/-g/-ftraceall" -msgstr "" -" -fsource-location generate source location code\n" -" * turned on by -debug/-g/-ftraceall" - -#: cobc/flag.def:152 -msgid " -fimplicit-init automatic initialization of the COBOL runtime system" -msgstr " -fimplicit-init automatic initialization of the COBOL runtime system" - -#: cobc/flag.def:155 -msgid "" -" -fstack-check PERFORM stack checking\n" -" * turned on by -debug or -g" -msgstr "" -" -fstack-check PERFORM stack checking\n" -" * turned on by -debug or -g" - -#: cobc/flag.def:159 -msgid "" -" -fwrite-after use AFTER 1 for WRITE of LINE SEQUENTIAL\n" -" * default: BEFORE 1" -msgstr "" -" -fwrite-after use AFTER 1 for WRITE of LINE SEQUENTIAL\n" -" * default: BEFORE 1" - -#: cobc/flag.def:163 -msgid "" -" -fmfcomment '*' or '/' in column 1 treated as comment\n" -" * FIXED format only" -msgstr "" -" -fmfcomment ‘*’ or ‘/’ in column 1 treated as comment\n" -" * FIXED format only" - -#: cobc/flag.def:167 -msgid "" -" -facucomment '$' in indicator area treated as '*',\n" -" '|' treated as floating comment" -msgstr "" -" -facucomment ‘$’ in indicator area treated as '*',\n" -" ‘|’ treated as floating comment" - -#: cobc/flag.def:171 -msgid "" -" -fnotrunc allow numeric field overflow\n" -" * non-ANSI behaviour" -msgstr "" -" -fnotrunc allow numeric field overflow\n" -" * non-ANSI behaviour" - -#: cobc/flag.def:175 -msgid "" -" -fodoslide adjust items following OCCURS DEPENDING\n" -" * implies -fcomplex-odo" -msgstr "" -" -fodoslide adjust items following OCCURS DEPENDING\n" -" * implies -fcomplex-odo" - -#: cobc/flag.def:179 -msgid "" -" -fsingle-quote use a single quote (apostrophe) for QUOTE\n" -" * default: double quote" -msgstr "" -" -fsingle-quote use a single quote (apostrophe) for QUOTE\n" -" * default: double quote" - -#: cobc/flag.def:189 -msgid "" -" -foptional-file treat all files as OPTIONAL\n" -" * unless NOT OPTIONAL specified" -msgstr "" -" -foptional-file treat all files as OPTIONAL\n" -" * unless NOT OPTIONAL specified" - -#: cobc/flag.def:193 -msgid " -fstatic-call output static function calls for the CALL statement" -msgstr " -fstatic-call output static function calls for the CALL statement" - -#: cobc/flag.def:196 -msgid "" -" -fno-gen-c-decl-static-call\tdisable generation of C function declations\n" -" for subroutines with static CALL" -msgstr "" -" -fno-gen-c-decl-static-call\tdisable generation of C function declations\n" -" for subroutines with static CALL" - -#: cobc/flag.def:200 -msgid " -fmf-files Sequential & Relative files will match Micro Focus format" -msgstr " -fmf-files Sequential & Relative files will match Micro Focus format" - -#: cobc/flag.def:203 -msgid "" -" -fno-theaders suppress all headers and output of compilation\n" -" options from listing while keeping page breaks" -msgstr "" -" -fno-theaders suppress all headers and output of compilation\n" -" options from listing while keeping page breaks" - -#: cobc/flag.def:207 -msgid " -fno-tsource suppress source from listing" -msgstr " -fno-tsource suppress source from listing" - -#: cobc/flag.def:210 -msgid " -fno-tmessages suppress warning and error summary from listing" -msgstr " -fno-tmessages suppress warning and error summary from listing" - -#: cobc/flag.def:213 -msgid " -ftsymbols specify symbols in listing" -msgstr " -ftsymbols specify symbols in listing" - -#: cobc/parser.y:283 cobc/parser.y:317 -#, c-format -msgid "unreachable statement '%s'" -msgstr "unreachable statement ‘%s’" - -#: cobc/parser.y:410 cobc/parser.y:703 -#, c-format -msgid "'%s' is not in LINKAGE SECTION" -msgstr "‘%s’ is not in LINKAGE SECTION" - -#: cobc/parser.y:413 cobc/typeck.c:3705 -#, c-format -msgid "'%s' cannot be BASED/EXTERNAL" -msgstr "‘%s’ cannot be BASED/EXTERNAL" - -#: cobc/parser.y:418 -#, c-format -msgid "'%s' is not in WORKING-STORAGE SECTION" -msgstr "‘%s’ is not in WORKING-STORAGE SECTION" - -#: cobc/parser.y:425 cobc/typeck.c:3702 -#, c-format -msgid "'%s' not level 01 or 77" -msgstr "‘%s’ not level 01 or 77" - -#: cobc/parser.y:428 cobc/parser.y:443 cobc/typeck.c:3708 -#, c-format -msgid "'%s' REDEFINES field not allowed here" -msgstr "‘%s’ REDEFINES field not allowed here" - -#: cobc/parser.y:456 -#, c-format -msgid "'%s' USING item duplicates RETURNING item" -msgstr "‘%s’ USING item duplicates RETURNING item" - -#: cobc/parser.y:466 -#, c-format -msgid "ENTRY '%s' duplicated" -msgstr "ENTRY ‘%s’ duplicated" - -#: cobc/parser.y:502 -#, c-format -msgid "ENTRY FOR GO TO '%s' duplicated" -msgstr "ENTRY FOR GO TO ‘%s’ duplicated" - -#: cobc/parser.y:518 -#, c-format -msgid "maximum nested program depth exceeded (%d)" -msgstr "maximum nested program depth exceeded (%d)" - -#: cobc/parser.y:544 cobc/parser.y:571 -#, c-format -msgid "%s statement not terminated by %s" -msgstr "%s statement not terminated by %s" - -#: cobc/parser.y:574 -#, c-format -msgid "%s statement not terminated" -msgstr "%s statement not terminated" - -#: cobc/parser.y:638 -msgid "USE statement invalid for SORT file" -msgstr "USE statement invalid for SORT file" - -#: cobc/parser.y:665 cobc/parser.y:667 -#, c-format -msgid "duplicate %s clause" -msgstr "duplicate %s clause" - -#: cobc/parser.y:685 -#, c-format -msgid "Cannot specify %s without number of lines on page" -msgstr "Cannot specify %s without number of lines on page" - -#: cobc/parser.y:695 -#, c-format -msgid "maximum OCCURS depth exceeded (%d)" -msgstr "maximum OCCURS depth exceeded (%d)" - -#: cobc/parser.y:709 cobc/parser.y:711 cobc/parser.y:6808 cobc/parser.y:6811 -#: cobc/parser.y:6813 cobc/parser.y:6815 cobc/parser.y:6850 cobc/parser.y:7573 -#: cobc/parser.y:7575 cobc/parser.y:7577 cobc/parser.y:7579 cobc/parser.y:7625 -#: cobc/parser.y:7634 cobc/parser.y:9548 cobc/parser.y:10994 -#: cobc/parser.y:12370 cobc/parser.y:13552 -#, c-format -msgid "%s and %s are mutually exclusive" -msgstr "%s and %s are mutually exclusive" - -#: cobc/parser.y:725 cobc/parser.y:729 -msgid "TO phrase without DEPENDING phrase" -msgstr "TO phrase without DEPENDING phrase" - -#: cobc/parser.y:726 -msgid "maximum number of occurrences assumed to be exact number" -msgstr "maximum number of occurrences assumed to be exact number" - -#: cobc/parser.y:733 cobc/parser.y:7355 -msgid "OCCURS TO must be greater than OCCURS FROM" -msgstr "OCCURS TO must be greater than OCCURS FROM" - -#: cobc/parser.y:742 -msgid "OCCURS DEPENDING ON without TO phrase" -msgstr "OCCURS DEPENDING ON without TO phrase" - -#: cobc/parser.y:808 -#, c-format -msgid "%s header missing - assumed" -msgstr "%s header missing - assumed" - -#: cobc/parser.y:810 -#, c-format -msgid "%s header missing" -msgstr "%s header missing" - -#: cobc/parser.y:942 -#, c-format -msgid "duplicate %s" -msgstr "duplicate %s" - -#: cobc/parser.y:944 -#, c-format -msgid "%s incorrectly after %s" -msgstr "%s incorrectly after %s" - -#: cobc/parser.y:1046 -#, c-format -msgid "redefinition of program name '%s'" -msgstr "redefinition of program name ‘%s’" - -#: cobc/parser.y:1050 -#, c-format -msgid "redefinition of program ID '%s'" -msgstr "redefinition of program ID ‘%s’" - -#: cobc/parser.y:1082 -#, c-format -msgid "FUNCTION '%s' has no PROCEDURE DIVISION" -msgstr "FUNCTION ‘%s’ has no PROCEDURE DIVISION" - -#: cobc/parser.y:1188 -msgid "functions may not be defined within a program/function" -msgstr "functions may not be defined within a program/function" - -#: cobc/parser.y:1238 -#, c-format -msgid "END FUNCTION '%s' is different from FUNCTION-ID '%s'" -msgstr "END FUNCTION ‘%s’ is different from FUNCTION-ID ‘%s’" - -#: cobc/parser.y:1252 -#, c-format -msgid "END PROGRAM '%s' is different from PROGRAM-ID '%s'" -msgstr "END PROGRAM ‘%s’ is different from PROGRAM-ID ‘%s’" - -#: cobc/parser.y:1301 -msgid "currency symbol must be one character long" -msgstr "currency symbol must be one character long" - -#: cobc/parser.y:1358 -#, c-format -msgid "invalid character '%c' in currency symbol" -msgstr "invalid character ‘%c’ in currency symbol" - -#: cobc/parser.y:1374 -msgid "prototype has same name as current function and will be ignored" -msgstr "prototype has same name as current function and will be ignored" - -#: cobc/parser.y:1401 -#, c-format -msgid "duplicate REPOSITORY entries for '%s' do not match" -msgstr "duplicate REPOSITORY entries for ‘%s’ do not match" - -#: cobc/parser.y:1405 -#, c-format -msgid "duplicate REPOSITORY entry for '%s'" -msgstr "duplicate REPOSITORY entry for ‘%s’" - -#: cobc/parser.y:1470 -#, c-format -msgid "ORGANIZATION %s is incompatible with RECORD DELIMITER" -msgstr "ORGANIZATION %s is incompatible with RECORD DELIMITER" - -#: cobc/parser.y:1502 -#, c-format -msgid "illegal combination of %s with other clauses" -msgstr "illegal combination of %s with other clauses" - -#: cobc/parser.y:1517 cobc/parser.y:1520 cobc/parser.y:1551 -#, c-format -msgid "cannot specify both %s and %s" -msgstr "cannot specify both %s and %s" - -#: cobc/parser.y:1548 -#, c-format -msgid "cannot specify both %s and %s; %s is ignored" -msgstr "cannot specify both %s and %s; %s is ignored" - -#: cobc/parser.y:1720 -msgid "FOR phrase cannot immediately follow ALL/LEADING/TRAILING" -msgstr "FOR phrase cannot immediately follow ALL/LEADING/TRAILING" - -#: cobc/parser.y:1722 -msgid "missing CHARACTERS/ALL/LEADING/TRAILING phrase after FOR phrase" -msgstr "missing CHARACTERS/ALL/LEADING/TRAILING phrase after FOR phrase" - -#: cobc/parser.y:1729 -msgid "missing value between ALL/LEADING/TRAILING words" -msgstr "missing value between ALL/LEADING/TRAILING words" - -#: cobc/parser.y:1734 -msgid "missing FOR phrase before CHARACTERS/ALL/LEADING/TRAILING phrase" -msgstr "missing FOR phrase before CHARACTERS/ALL/LEADING/TRAILING phrase" - -#: cobc/parser.y:1741 -msgid "missing ALL/LEADING/TRAILING before value" -msgstr "missing ALL/LEADING/TRAILING before value" - -#: cobc/parser.y:1796 -msgid "use of condition-name in place of data-name" -msgstr "use of condition-name in place of data-name" - -#: cobc/parser.y:1800 cobc/parser.y:6753 cobc/typeck.c:665 -#, c-format -msgid "condition-name not allowed here: '%s'" -msgstr "condition-name not allowed here: ‘%s’" - -#: cobc/parser.y:1827 -msgid "cannot specify NO ADVANCING in screen DISPLAY" -msgstr "cannot specify NO ADVANCING in screen DISPLAY" - -#: cobc/parser.y:1899 cobc/parser.y:1916 -msgid "non-standard DISPLAY" -msgstr "non-standard DISPLAY" - -#: cobc/parser.y:1903 -msgid "screens may only be displayed on CRT" -msgstr "screens may only be displayed on CRT" - -#: cobc/parser.y:1908 cobc/parser.y:1951 -msgid "cannot mix screens and fields in the same DISPLAY statement" -msgstr "cannot mix screens and fields in the same DISPLAY statement" - -#: cobc/parser.y:1912 -msgid "screen clauses may only be used for DISPLAY on CRT" -msgstr "screen clauses may only be used for DISPLAY on CRT" - -#: cobc/parser.y:1957 -msgid "ambiguous DISPLAY; put items to display on device in separate DISPLAY" -msgstr "ambiguous DISPLAY; put items to display on device in separate DISPLAY" - -#: cobc/parser.y:1973 -#, c-format -msgid "%s is not an alphanumeric literal" -msgstr "%s is not an alphanumeric literal" - -#: cobc/parser.y:1975 -#, c-format -msgid "'%s' is not USAGE DISPLAY" -msgstr "‘%s’ is not USAGE DISPLAY" - -#: cobc/parser.y:1990 cobc/typeck.c:8481 -#, c-format -msgid "invalid target for %s" -msgstr "invalid target for %s" - -#: cobc/parser.y:1997 cobc/parser.y:6747 -msgid "SCREEN item cannot be used here" -msgstr "SCREEN item cannot be used here" - -#: cobc/parser.y:1999 -msgid "RENAMES item may not be used here" -msgstr "RENAMES item may not be used here" - -#: cobc/parser.y:2001 cobc/typeck.c:2333 cobc/typeck.c:2429 -msgid "ANY LENGTH item not allowed here" -msgstr "ANY LENGTH item not allowed here" - -#: cobc/parser.y:2005 -#, c-format -msgid "item '%s' has wrong class for VALIDATE" -msgstr "item ‘%s’ has wrong class for VALIDATE" - -#: cobc/parser.y:2014 -msgid "WHEN clause must follow EVERY clause" -msgstr "WHEN clause must follow EVERY clause" - -#: cobc/parser.y:2096 cobc/parser.y:17197 -msgid "non-zero value expected" -msgstr "non-zero value expected" - -#: cobc/parser.y:2102 cobc/tree.c:4352 -#, c-format -msgid "RECORD size (IDX) exceeds maximum allowed (%d)" -msgstr "RECORD size (IDX) exceeds maximum allowed (%d)" - -#: cobc/parser.y:2106 cobc/tree.c:4355 -#, c-format -msgid "RECORD size exceeds maximum allowed (%d)" -msgstr "RECORD size exceeds maximum allowed (%d)" - -#: cobc/parser.y:2111 -msgid "RECORD clause invalid" -msgstr "RECORD clause invalid" - -#: cobc/parser.y:3188 -msgid "multiple PROGRAM-ID's without matching END PROGRAM" -msgstr "multiple PROGRAM-ID's without matching END PROGRAM" - -#: cobc/parser.y:3191 -msgid "executable requested but no program found" -msgstr "executable requested but no program found" - -#: cobc/parser.y:3408 cobc/parser.y:3417 -msgid "COMMON may only be used in a contained program" -msgstr "COMMON may only be used in a contained program" - -#: cobc/parser.y:3426 cobc/parser.y:3458 -msgid "CALL prototypes" -msgstr "CALL prototypes" - -#: cobc/parser.y:3607 cobc/parser.y:3884 cobc/parser.y:3928 cobc/parser.y:4036 -#: cobc/parser.y:4223 cobc/parser.y:4319 cobc/parser.y:4360 cobc/parser.y:4431 -#: cobc/parser.y:4452 cobc/parser.y:4531 cobc/parser.y:4550 cobc/parser.y:4566 -#: cobc/parser.y:4584 cobc/parser.y:4602 cobc/parser.y:4619 cobc/parser.y:4637 -#: cobc/parser.y:6868 cobc/parser.y:7694 -#, c-format -msgid "%s not allowed in nested programs" -msgstr "%s not allowed in nested programs" - -#: cobc/parser.y:3761 -msgid "segment-number must be in range of values 1 to 49" -msgstr "segment-number must be in range of values 1 to 49" - -#: cobc/parser.y:3773 -msgid "duplicate CLASSIFICATION clause" -msgstr "duplicate CLASSIFICATION clause" - -#: cobc/parser.y:3849 -msgid "PROGRAM phrase" -msgstr "PROGRAM phrase" - -#: cobc/parser.y:3944 cobc/parser.y:3955 cobc/parser.y:4271 -#, c-format -msgid "invalid %s clause" -msgstr "invalid %s clause" - -#: cobc/parser.y:4386 cobc/parser.y:4390 -msgid "CLASS literal with THRU must have size 1" -msgstr "CLASS literal with THRU must have size 1" - -#: cobc/parser.y:4417 -msgid "CLASS IS integer IN alphabet-name" -msgstr "CLASS IS integer IN alphabet-name" - -#: cobc/parser.y:4464 -msgid "separate currency symbol and currency string" -msgstr "separate currency symbol and currency string" - -#: cobc/parser.y:4497 -#, c-format -msgid "invalid CURRENCY SIGN '%s'" -msgstr "invalid CURRENCY SIGN ‘%s’" - -#: cobc/parser.y:4715 -msgid "cannot use RELATIVE KEY clause on INDEXED files" -msgstr "cannot use RELATIVE KEY clause on INDEXED files" - -#: cobc/parser.y:4719 -msgid "cannot use RECORD KEY clause on RELATIVE files" -msgstr "cannot use RECORD KEY clause on RELATIVE files" - -#: cobc/parser.y:4793 -msgid "EXTERNAL/DYNAMIC cannot be used with literals" -msgstr "EXTERNAL/DYNAMIC cannot be used with literals" - -#: cobc/parser.y:4813 -msgid "EXTERNAL/DYNAMIC cannot be used with USING/VARYING" -msgstr "EXTERNAL/DYNAMIC cannot be used with USING/VARYING" - -#: cobc/parser.y:4824 -msgid "EXTERNAL/DYNAMIC cannot be used with DISK FROM" -msgstr "EXTERNAL/DYNAMIC cannot be used with DISK FROM" - -#: cobc/parser.y:4826 -msgid "ASSIGN DISK FROM" -msgstr "ASSIGN DISK FROM" - -#: cobc/parser.y:4942 -msgid "ASSIGN EXTERNAL/DYNAMIC" -msgstr "ASSIGN EXTERNAL/DYNAMIC" - -#: cobc/parser.y:5165 -#, c-format -msgid "'%s' is not an alphabet-name" -msgstr "‘%s’ is not an alphabet-name" - -#: cobc/parser.y:5254 -#, c-format -msgid "%s only valid with ORGANIZATION %s" -msgstr "%s only valid with ORGANIZATION %s" - -#: cobc/parser.y:5321 cobc/parser.y:5344 -#, c-format -msgid "RECORD DELIMITER %s only allowed with SEQUENTIAL files" -msgstr "RECORD DELIMITER %s only allowed with SEQUENTIAL files" - -#: cobc/parser.y:5323 cobc/parser.y:5336 cobc/parser.y:5348 cobc/parser.y:5358 -msgid "RECORD DELIMITER clause" -msgstr "RECORD DELIMITER clause" - -#: cobc/parser.y:5332 -#, c-format -msgid "RECORD DELIMITER %s only allowed with (LINE) SEQUENTIAL files" -msgstr "RECORD DELIMITER %s only allowed with (LINE) SEQUENTIAL files" - -#: cobc/parser.y:5337 -msgid "LINE-SEQUENTIAL phrase" -msgstr "LINE-SEQUENTIAL phrase" - -#: cobc/parser.y:5349 -msgid "BINARY-SEQUENTIAL phrase" -msgstr "BINARY-SEQUENTIAL phrase" - -#: cobc/parser.y:5357 -msgid "RECORD DELIMITER clause only allowed with (LINE) SEQUENTIAL files" -msgstr "RECORD DELIMITER clause only allowed with (LINE) SEQUENTIAL files" - -#: cobc/parser.y:5360 -#, c-format -msgid "RECORD DELIMITER %s not recognized; will be ignored" -msgstr "RECORD DELIMITER %s not recognized; will be ignored" - -#: cobc/parser.y:5398 -msgid "DUPLICATES for primary keys" -msgstr "DUPLICATES for primary keys" - -#: cobc/parser.y:5637 -msgid "DOS/VS APPLY phrase" -msgstr "DOS/VS APPLY phrase" - -#: cobc/parser.y:5752 -msgid "RECORD description missing or invalid" -msgstr "RECORD description missing or invalid" - -#: cobc/parser.y:5778 -#, c-format -msgid "duplicate file description for %s" -msgstr "duplicate file description for %s" - -#: cobc/parser.y:5811 cobc/parser.y:5821 -msgid "file cannot have both EXTERNAL and GLOBAL clauses" -msgstr "file cannot have both EXTERNAL and GLOBAL clauses" - -#: cobc/parser.y:5825 cobc/parser.y:6414 cobc/parser.y:6853 cobc/parser.y:12363 -#: cobc/parser.y:15305 -#, c-format -msgid "%s is invalid in a user FUNCTION" -msgstr "%s is invalid in a user FUNCTION" - -#: cobc/parser.y:5863 cobc/parser.y:5872 -msgid "RECORD clause ignored for LINE SEQUENTIAL" -msgstr "RECORD clause ignored for LINE SEQUENTIAL" - -#: cobc/parser.y:5964 -msgid "LINAGE clause with wrong file type" -msgstr "LINAGE clause with wrong file type" - -#: cobc/parser.y:6026 -msgid "RECORDING MODE U or S can only be used with RECORD SEQUENTIAL files" -msgstr "RECORDING MODE U or S can only be used with RECORD SEQUENTIAL files" - -#: cobc/parser.y:6059 -#, c-format -msgid "ignoring CODE-SET '%s'" -msgstr "ignoring CODE-SET ‘%s’" - -#: cobc/parser.y:6070 -msgid "CODE-SET clause invalid for file type" -msgstr "CODE-SET clause invalid for file type" - -#: cobc/parser.y:6092 -msgid "REPORT clause with wrong file type" -msgstr "REPORT clause with wrong file type" - -#: cobc/parser.y:6170 -msgid "CD record missing" -msgstr "CD record missing" - -#: cobc/parser.y:6601 -msgid "CONSTANT item not at 01 level" -msgstr "CONSTANT item not at 01 level" - -#: cobc/parser.y:6721 -msgid "REDEFINES clause not following entry-name" -msgstr "REDEFINES clause not following entry-name" - -#: cobc/parser.y:6743 -msgid "SAME AS clause" -msgstr "SAME AS clause" - -#: cobc/parser.y:6750 -msgid "REPORT item cannot be used here" -msgstr "REPORT item cannot be used here" - -#: cobc/parser.y:6757 -msgid "elementary item expected" -msgstr "elementary item expected" - -#: cobc/parser.y:6764 -msgid "SAME AS item may not reference itself" -msgstr "SAME AS item may not reference itself" - -#: cobc/parser.y:6771 -msgid "SAME AS item may not be subordinate to any item with USAGE clause" -msgstr "SAME AS item may not be subordinate to any item with USAGE clause" - -#: cobc/parser.y:6773 -msgid "SAME AS item may not be subordinate to any item with SIGN clause" -msgstr "SAME AS item may not be subordinate to any item with SIGN clause" - -#: cobc/parser.y:6801 cobc/parser.y:6855 cobc/parser.y:7567 cobc/parser.y:7650 -#: cobc/parser.y:7674 -#, c-format -msgid "%s not allowed here" -msgstr "%s not allowed here" - -#: cobc/parser.y:6803 cobc/parser.y:6845 cobc/parser.y:7569 -#, c-format -msgid "%s only allowed at 01/77 level" -msgstr "%s only allowed at 01/77 level" - -#: cobc/parser.y:6805 cobc/parser.y:6847 cobc/parser.y:7571 cobc/parser.y:7654 -#: cobc/parser.y:7676 -#, c-format -msgid "%s requires a data name" -msgstr "%s requires a data name" - -#: cobc/parser.y:6958 -msgid "a locale-format PICTURE string must only consist of '9', '.', '+', 'Z' and the currency-sign" -msgstr "a locale-format PICTURE string must only consist of '9', '.', '+', ‘Z’ and the currency-sign" - -#: cobc/parser.y:6992 cobc/typeck.c:3658 -#, c-format -msgid "'%s' is not a locale-name" -msgstr "‘%s’ is not a locale-name" - -#: cobc/parser.y:7007 -#, c-format -msgid "'%s' is not a valid USAGE" -msgstr "‘%s’ is not a valid USAGE" - -#: cobc/parser.y:7012 -#, c-format -msgid "unknown USAGE: %s" -msgstr "unknown USAGE: %s" - -#: cobc/parser.y:7149 -#, c-format -msgid "unknown HANDLE type: %s" -msgstr "unknown HANDLE type: %s" - -#: cobc/parser.y:7406 cobc/parser.y:7408 -msgid "INDEXED should follow ASCENDING/DESCENDING" -msgstr "INDEXED should follow ASCENDING/DESCENDING" - -#: cobc/parser.y:7526 -msgid "SYNCHRONIZED clause" -msgstr "SYNCHRONIZED clause" - -#: cobc/parser.y:7529 -msgid "LEFT/RIGHT phrases in SYNCHRONIZED clause" -msgstr "LEFT/RIGHT phrases in SYNCHRONIZED clause" - -#: cobc/parser.y:7612 -msgid "FALSE clause only allowed for 88 level" -msgstr "FALSE clause only allowed for 88 level" - -#: cobc/parser.y:7652 -#, c-format -msgid "%s only allowed at 01 level" -msgstr "%s only allowed at 01 level" - -#: cobc/parser.y:7656 cobc/parser.y:7678 -#, c-format -msgid "%s and %s combination not allowed" -msgstr "%s and %s combination not allowed" - -#: cobc/parser.y:7787 -msgid "GLOBAL is not allowed with RD" -msgstr "GLOBAL is not allowed with RD" - -#: cobc/parser.y:8321 -msgid "PLUS is not recommended with LEFT, RIGHT or CENTER" -msgstr "PLUS is not recommended with LEFT, RIGHT or CENTER" - -#: cobc/parser.y:8323 -msgid "PLUS is not allowed with LEFT, RIGHT or CENTER" -msgstr "PLUS is not allowed with LEFT, RIGHT or CENTER" - -#: cobc/parser.y:8360 cobc/parser.y:8390 -msgid "PLUS is ignored on first field of line" -msgstr "PLUS is ignored on first field of line" - -#: cobc/parser.y:8398 -msgid "invalid COLUMN integer; must be > 0" -msgstr "invalid COLUMN integer; must be > 0" - -#: cobc/parser.y:8400 -msgid "COLUMN numbers should increase" -msgstr "COLUMN numbers should increase" - -#: cobc/parser.y:8499 cobc/parser.y:8555 -msgid "INITIAL specified on non-input field" -msgstr "INITIAL specified on non-input field" - -#: cobc/parser.y:8511 cobc/parser.y:8567 -msgid "relative LINE/COLUMN clause required with OCCURS" -msgstr "relative LINE/COLUMN clause required with OCCURS" - -#: cobc/parser.y:8669 cobc/parser.y:8673 -msgid "screen positions from data-item" -msgstr "screen positions from data-item" - -#: cobc/parser.y:9498 -msgid "OCCURS screen items" -msgstr "OCCURS screen items" - -#: cobc/parser.y:9510 -msgid "GLOBAL screen items" -msgstr "GLOBAL screen items" - -#: cobc/parser.y:9554 -msgid "overriding convention specified in ENTRY-CONVENTION" -msgstr "overriding convention specified in ENTRY-CONVENTION" - -#: cobc/parser.y:9566 -msgid "executable program requested but PROCEDURE/ENTRY has USING clause" -msgstr "executable program requested but PROCEDURE/ENTRY has USING clause" - -#: cobc/parser.y:9636 cobc/parser.y:9653 cobc/parser.y:11184 -#, c-format -msgid "number of arguments exceeds maximum %d" -msgstr "number of arguments exceeds maximum %d" - -#: cobc/parser.y:9645 -msgid "CHAINING invalid in user FUNCTION" -msgstr "CHAINING invalid in user FUNCTION" - -#: cobc/parser.y:9692 cobc/parser.y:11261 cobc/parser.y:11270 -#, c-format -msgid "%s not allowed in CHAINED programs" -msgstr "%s not allowed in CHAINED programs" - -#: cobc/parser.y:9704 cobc/parser.y:9712 cobc/parser.y:9720 cobc/parser.y:9741 -msgid "SIZE only allowed for BY VALUE items" -msgstr "SIZE only allowed for BY VALUE items" - -#: cobc/parser.y:9743 cobc/parser.y:9760 -msgid "invalid value for SIZE" -msgstr "invalid value for SIZE" - -#: cobc/parser.y:9775 -msgid "MEMORY SIZE phrase in CALL statement" -msgstr "MEMORY SIZE phrase in CALL statement" - -#: cobc/parser.y:9787 -msgid "OPTIONAL only allowed for BY REFERENCE items" -msgstr "OPTIONAL only allowed for BY REFERENCE items" - -#: cobc/parser.y:9799 -msgid "RETURNING clause is required for a FUNCTION" -msgstr "RETURNING clause is required for a FUNCTION" - -#: cobc/parser.y:9805 -msgid "RETURNING clause cannot be OMITTED for main program" -msgstr "RETURNING clause cannot be OMITTED for main program" - -#: cobc/parser.y:9808 -msgid "RETURNING clause cannot be OMITTED for a FUNCTION" -msgstr "RETURNING clause cannot be OMITTED for a FUNCTION" - -#: cobc/parser.y:9821 -msgid "RETURNING item is not defined in LINKAGE SECTION" -msgstr "RETURNING item is not defined in LINKAGE SECTION" - -#: cobc/parser.y:9823 -msgid "RETURNING item must have level 01" -msgstr "RETURNING item must have level 01" - -#: cobc/parser.y:9825 -msgid "RETURNING item should not have OCCURS" -msgstr "RETURNING item should not have OCCURS" - -#: cobc/parser.y:9829 -msgid "function RETURNING item may not be ANY LENGTH" -msgstr "function RETURNING item may not be ANY LENGTH" - -#: cobc/parser.y:10017 -#, c-format -msgid "'%s' is not a statement" -msgstr "‘%s’ is not a statement" - -#: cobc/parser.y:10019 -#, c-format -msgid "unknown statement '%s'; it may exist in another dialect" -msgstr "unknown statement '%s'; it may exist in another dialect" - -#: cobc/parser.y:10022 -#, c-format -msgid "unknown statement '%s'" -msgstr "unknown statement ‘%s’" - -#: cobc/parser.y:10039 -msgid "section segments" -msgstr "section segments" - -#: cobc/parser.y:10041 -msgid "SECTION segment-number must be less than or equal to 99" -msgstr "SECTION segment-number must be less than or equal to 99" - -#: cobc/parser.y:10044 -msgid "SECTION segment-number in DECLARATIVES must be less than 50" -msgstr "SECTION segment-number in DECLARATIVES must be less than 50" - -#: cobc/parser.y:10052 -msgid "SECTION segment within DECLARATIVES" -msgstr "SECTION segment within DECLARATIVES" - -#: cobc/parser.y:10240 cobc/parser.y:10375 -msgid "non-standard ACCEPT" -msgstr "non-standard ACCEPT" - -#: cobc/parser.y:10252 -msgid "PROMPT clause" -msgstr "PROMPT clause" - -#: cobc/parser.y:10256 -msgid "SIZE IS clause" -msgstr "SIZE IS clause" - -#: cobc/parser.y:10471 cobc/parser.y:10763 -msgid "TIME-OUT or BEFORE TIME clauses" -msgstr "TIME-OUT or BEFORE TIME clauses" - -#: cobc/parser.y:10497 cobc/parser.y:10513 cobc/parser.y:10528 -msgid "AT screen-location" -msgstr "AT screen-location" - -#: cobc/parser.y:10529 -msgid "LINE or COLUMN" -msgstr "LINE or COLUMN" - -#: cobc/parser.y:10893 -msgid "ALLOCATE CHARACTERS requires RETURNING clause" -msgstr "ALLOCATE CHARACTERS requires RETURNING clause" - -#: cobc/parser.y:10908 cobc/parser.y:12168 -#, c-format -msgid "ignoring %s phrase" -msgstr "ignoring %s phrase" - -#: cobc/parser.y:10910 -msgid "addressing mode should be either 24 or 31 bit" -msgstr "addressing mode should be either 24 or 31 bit" - -#: cobc/parser.y:10982 -msgid "recursive program call - assuming RECURSIVE attribute" -msgstr "recursive program call - assuming RECURSIVE attribute" - -#: cobc/parser.y:11001 -msgid "STATIC CALL convention ignored because of ON EXCEPTION" -msgstr "STATIC CALL convention ignored because of ON EXCEPTION" - -#: cobc/parser.y:11010 -msgid "ON EXCEPTION ignored because of STATIC CALL" -msgstr "ON EXCEPTION ignored because of STATIC CALL" - -#: cobc/parser.y:11111 cobc/typeck.c:12209 -msgid "invalid mnemonic name" -msgstr "invalid mnemonic name" - -#: cobc/parser.y:11131 cobc/parser.y:11428 -msgid "CALL/CANCEL with program-prototype-name" -msgstr "CALL/CANCEL with program-prototype-name" - -#: cobc/parser.y:11135 -msgid "id/literal ignored, using prototype name" -msgstr "id/literal ignored, using prototype name" - -#: cobc/parser.y:11141 -msgid "NESTED phrase is only valid with literal" -msgstr "NESTED phrase is only valid with literal" - -#: cobc/parser.y:11202 -msgid "OMITTED only allowed when arguments are passed BY REFERENCE" -msgstr "OMITTED only allowed when arguments are passed BY REFERENCE" - -#: cobc/parser.y:11226 -msgid "invalid file name reference" -msgstr "invalid file name reference" - -#: cobc/parser.y:11234 -#, c-format -msgid "BY CONTENT assumed for alphanumeric item '%s'" -msgstr "BY CONTENT assumed for alphanumeric item ‘%s’" - -#: cobc/parser.y:11239 -#, c-format -msgid "BY CONTENT assumed for national item '%s'" -msgstr "BY CONTENT assumed for national item ‘%s’" - -#: cobc/parser.y:11302 -msgid "RETURNING item must have level 01 or 77" -msgstr "RETURNING item must have level 01 or 77" - -#: cobc/parser.y:11306 -msgid "RETURNING item must be a LINKAGE SECTION item or have BASED clause" -msgstr "RETURNING item must be a LINKAGE SECTION item or have BASED clause" - -#: cobc/parser.y:11340 cobc/parser.y:15972 cobc/parser.y:16027 -#: cobc/parser.y:16071 cobc/parser.y:16115 -msgid "NOT EXCEPTION before EXCEPTION" -msgstr "NOT EXCEPTION before EXCEPTION" - -#: cobc/parser.y:12041 -#, c-format -msgid "HANDLE must be a %s HANDLE" -msgstr "HANDLE must be a %s HANDLE" - -#: cobc/parser.y:12053 -msgid "HANDLE must be a generic HANDLE" -msgstr "HANDLE must be a generic HANDLE" - -#: cobc/parser.y:12130 -#, c-format -msgid "HANDLE clause invalid for %s" -msgstr "HANDLE clause invalid for %s" - -#: cobc/parser.y:12361 cobc/parser.y:15495 -#, c-format -msgid "%s is invalid in nested program" -msgstr "%s is invalid in nested program" - -#: cobc/parser.y:12399 cobc/parser.y:12440 cobc/parser.y:12451 -#: cobc/parser.y:12462 -#, c-format -msgid "maximum evaluate depth exceeded (%d)" -msgstr "maximum evaluate depth exceeded (%d)" - -#: cobc/parser.y:12503 cobc/parser.y:12513 -msgid "WHEN without imperative statement" -msgstr "WHEN without imperative statement" - -#: cobc/parser.y:12531 cobc/parser.y:12541 -msgid "WHEN OTHER without imperative statement" -msgstr "WHEN OTHER without imperative statement" - -#: cobc/parser.y:12621 -msgid "invalid THROUGH usage" -msgstr "invalid THROUGH usage" - -#: cobc/parser.y:12700 -msgid "EXIT PROGRAM is not allowed within a USE GLOBAL procedure" -msgstr "EXIT PROGRAM is not allowed within a USE GLOBAL procedure" - -#: cobc/parser.y:12704 -msgid "EXIT PROGRAM not allowed within a FUNCTION" -msgstr "EXIT PROGRAM not allowed within a FUNCTION" - -#: cobc/parser.y:12713 cobc/parser.y:12926 -msgid "RETURNING/GIVING not allowed for non-returning runtime elements" -msgstr "RETURNING/GIVING not allowed for non-returning runtime elements" - -#: cobc/parser.y:12725 -msgid "EXIT FUNCTION is not allowed within a USE GLOBAL procedure" -msgstr "EXIT FUNCTION is not allowed within a USE GLOBAL procedure" - -#: cobc/parser.y:12729 -msgid "EXIT FUNCTION only allowed within a FUNCTION" -msgstr "EXIT FUNCTION only allowed within a FUNCTION" - -#: cobc/parser.y:12743 cobc/parser.y:12766 -msgid "EXIT PERFORM is only valid with inline PERFORM" -msgstr "EXIT PERFORM is only valid with inline PERFORM" - -#: cobc/parser.y:12788 -msgid "EXIT SECTION is only valid with an active SECTION" -msgstr "EXIT SECTION is only valid with an active SECTION" - -#: cobc/parser.y:12809 -msgid "EXIT PARAGRAPH is only valid with an active PARAGRAPH" -msgstr "EXIT PARAGRAPH is only valid with an active PARAGRAPH" - -#: cobc/parser.y:12956 -msgid "IF without imperative statement" -msgstr "IF without imperative statement" - -#: cobc/parser.y:13173 -msgid "TALLYING clause is incomplete" -msgstr "TALLYING clause is incomplete" - -#: cobc/parser.y:13289 -msgid "INSPECT missing ALL/FIRST/LEADING/TRAILING" -msgstr "INSPECT missing ALL/FIRST/LEADING/TRAILING" - -#: cobc/parser.y:13407 -msgid "JSON PARSE" -msgstr "JSON PARSE" - -#: cobc/parser.y:13552 -msgid "LOCK clauses" -msgstr "LOCK clauses" - -#: cobc/parser.y:13717 -msgid "inline PERFORM without imperative statement" -msgstr "inline PERFORM without imperative statement" - -#: cobc/parser.y:13838 cobc/parser.y:13846 cobc/parser.y:13854 -#, c-format -msgid "PERFORM VARYING '%s' (line %d of %s) is not a numeric field" -msgstr "PERFORM VARYING ‘%s’ (line %d of %s) is not a numeric field" - -#: cobc/parser.y:13870 -msgid "PERFORM VARYING without BY phrase" -msgstr "PERFORM VARYING without BY phrase" - -#: cobc/parser.y:13910 -#, c-format -msgid "'%s' is not an object-reference" -msgstr "‘%s’ is not an object-reference" - -#: cobc/parser.y:13951 cobc/typeck.c:10958 cobc/typeck.c:12100 -msgid "LOCK clause invalid with file LOCK AUTOMATIC" -msgstr "LOCK clause invalid with file LOCK AUTOMATIC" - -#: cobc/parser.y:13956 -msgid "KEY clause invalid with this file type" -msgstr "KEY clause invalid with this file type" - -#: cobc/parser.y:13961 cobc/typeck.c:10954 cobc/typeck.c:12096 -msgid "INVALID KEY clause invalid with this file type" -msgstr "INVALID KEY clause invalid with this file type" - -#: cobc/parser.y:14591 -msgid "file sort requires KEY phrase" -msgstr "file sort requires KEY phrase" - -#: cobc/parser.y:14615 -msgid "table SORT requires KEY phrase" -msgstr "table SORT requires KEY phrase" - -#: cobc/parser.y:14677 -msgid "file sort requires USING or INPUT PROCEDURE" -msgstr "file sort requires USING or INPUT PROCEDURE" - -#: cobc/parser.y:14684 -msgid "USING invalid with table SORT" -msgstr "USING invalid with table SORT" - -#: cobc/parser.y:14694 -msgid "INPUT PROCEDURE invalid with table SORT" -msgstr "INPUT PROCEDURE invalid with table SORT" - -#: cobc/parser.y:14696 -msgid "INPUT PROCEDURE invalid with MERGE" -msgstr "INPUT PROCEDURE invalid with MERGE" - -#: cobc/parser.y:14709 -msgid "file sort requires GIVING or OUTPUT PROCEDURE" -msgstr "file sort requires GIVING or OUTPUT PROCEDURE" - -#: cobc/parser.y:14716 -msgid "GIVING invalid with table SORT" -msgstr "GIVING invalid with table SORT" - -#: cobc/parser.y:14726 -msgid "OUTPUT PROCEDURE invalid with table SORT" -msgstr "OUTPUT PROCEDURE invalid with table SORT" - -#: cobc/parser.y:14753 -msgid "SIZE/LENGTH invalid here" -msgstr "SIZE/LENGTH invalid here" - -#: cobc/parser.y:14806 -msgid "NOT EQUAL condition not allowed on START statement" -msgstr "NOT EQUAL condition not allowed on START statement" - -#: cobc/parser.y:14872 -#, c-format -msgid "%s is replaced by %s" -msgstr "%s is replaced by %s" - -#: cobc/parser.y:14925 -msgid "STOP literal" -msgstr "STOP literal" - -#: cobc/parser.y:14929 -msgid "STOP identifier" -msgstr "STOP identifier" - -#: cobc/parser.y:15066 -msgid "SUPPRESS statement must be within DECLARATIVES" -msgstr "SUPPRESS statement must be within DECLARATIVES" - -#: cobc/parser.y:15140 -msgid "UNLOCK invalid for SORT files" -msgstr "UNLOCK invalid for SORT files" - -#: cobc/parser.y:15276 cobc/parser.y:15355 -msgid "USE statement must be within DECLARATIVES" -msgstr "USE statement must be within DECLARATIVES" - -#: cobc/parser.y:15278 -msgid "SECTION header missing before USE statement" -msgstr "SECTION header missing before USE statement" - -#: cobc/parser.y:15357 -msgid "USE DEBUGGING not supported in contained program" -msgstr "USE DEBUGGING not supported in contained program" - -#: cobc/parser.y:15405 cobc/parser.y:15414 cobc/parser.y:15432 -#: cobc/parser.y:15468 cobc/typeck.c:3792 -#, c-format -msgid "duplicate DEBUGGING target: '%s'" -msgstr "duplicate DEBUGGING target: ‘%s’" - -#: cobc/parser.y:15430 -msgid "constant item cannot be used here" -msgstr "constant item cannot be used here" - -#: cobc/parser.y:15456 -msgid "duplicate USE DEBUGGING ON ALL PROCEDURES" -msgstr "duplicate USE DEBUGGING ON ALL PROCEDURES" - -#: cobc/parser.y:15528 -#, c-format -msgid "'%s' is not a report group" -msgstr "‘%s’ is not a report group" - -#: cobc/parser.y:15710 -msgid "ENCODING clause must come before XML-DECLARATION" -msgstr "ENCODING clause must come before XML-DECLARATION" - -#: cobc/parser.y:15712 -msgid "ENCODING clause must come before ATTRIBUTES" -msgstr "ENCODING clause must come before ATTRIBUTES" - -#: cobc/parser.y:15715 -msgid "XML GENERATE ENCODING clause" -msgstr "XML GENERATE ENCODING clause" - -#: cobc/parser.y:15722 -msgid "XML-DECLARATION clause must come before ATTRIBUTES" -msgstr "XML-DECLARATION clause must come before ATTRIBUTES" - -#: cobc/parser.y:15725 -msgid "XML GENERATE XML-DECLARATION clause" -msgstr "XML GENERATE XML-DECLARATION clause" - -#: cobc/parser.y:15731 -msgid "XML GENERATE WITH ATTRIBUTES clause" -msgstr "XML GENERATE WITH ATTRIBUTES clause" - -#: cobc/parser.y:15744 -msgid "XML GENERATE NAMESPACE clause" -msgstr "XML GENERATE NAMESPACE clause" - -#: cobc/parser.y:15768 -msgid "XML GENERATE NAME OF clause" -msgstr "XML GENERATE NAME OF clause" - -#: cobc/parser.y:15799 -msgid "XML GENERATE TYPE OF clause" -msgstr "XML GENERATE TYPE OF clause" - -#: cobc/parser.y:15840 -msgid "XML GENERATE SUPPRESS clause" -msgstr "XML GENERATE SUPPRESS clause" - -#: cobc/parser.y:15914 -msgid "XML PARSE" -msgstr "XML PARSE" - -#: cobc/parser.y:15955 cobc/parser.y:16633 cobc/parser.y:16729 -#: cobc/parser.y:16815 -#, c-format -msgid "'%s' is not a file name" -msgstr "‘%s’ is not a file name" - -#: cobc/parser.y:16161 -msgid "NOT SIZE ERROR before SIZE ERROR" -msgstr "NOT SIZE ERROR before SIZE ERROR" - -#: cobc/parser.y:16207 -msgid "NOT OVERFLOW before OVERFLOW" -msgstr "NOT OVERFLOW before OVERFLOW" - -#: cobc/parser.y:16306 -msgid "NOT AT END-OF-PAGE before AT END-OF-PAGE" -msgstr "NOT AT END-OF-PAGE before AT END-OF-PAGE" - -#: cobc/parser.y:16356 -msgid "NOT INVALID KEY before INVALID KEY" -msgstr "NOT INVALID KEY before INVALID KEY" - -#: cobc/parser.y:16619 -msgid "LINAGE-COUNTER must be qualified here" -msgstr "LINAGE-COUNTER must be qualified here" - -#: cobc/parser.y:16622 -msgid "invalid LINAGE-COUNTER usage" -msgstr "invalid LINAGE-COUNTER usage" - -#: cobc/parser.y:16643 -msgid "LINE-COUNTER must be qualified here" -msgstr "LINE-COUNTER must be qualified here" - -#: cobc/parser.y:16647 -msgid "invalid LINE-COUNTER usage" -msgstr "invalid LINE-COUNTER usage" - -#: cobc/parser.y:16658 cobc/parser.y:16683 -#, c-format -msgid "'%s' is not a report name" -msgstr "‘%s’ is not a report name" - -#: cobc/parser.y:16668 -msgid "PAGE-COUNTER must be qualified here" -msgstr "PAGE-COUNTER must be qualified here" - -#: cobc/parser.y:16672 -msgid "invalid PAGE-COUNTER usage" -msgstr "invalid PAGE-COUNTER usage" - -#: cobc/parser.y:16719 cobc/typeck.c:10919 cobc/typeck.c:11004 -#: cobc/typeck.c:12064 -#, c-format -msgid "%s requires a record name as subject" -msgstr "%s requires a record name as subject" - -#: cobc/parser.y:16746 -#, c-format -msgid "'%s' not indexed" -msgstr "‘%s’ not indexed" - -#: cobc/parser.y:16772 cobc/parser.y:16797 -#, c-format -msgid "multiple reference to '%s' " -msgstr "multiple reference to ‘%s’ " - -#: cobc/parser.y:16827 -#, c-format -msgid "'%s' is not a CD name" -msgstr "‘%s’ is not a CD name" - -#: cobc/parser.y:16841 -#, c-format -msgid "'%s' is not a valid report name" -msgstr "‘%s’ is not a valid report name" - -#: cobc/parser.y:17092 -msgid "invalid mnemonic identifier" -msgstr "invalid mnemonic identifier" - -#: cobc/parser.y:17172 -msgid "a numeric literal is expected here" -msgstr "a numeric literal is expected here" - -#: cobc/parser.y:17184 cobc/parser.y:17886 -msgid "a non-numeric literal is expected here" -msgstr "a non-numeric literal is expected here" - -#: cobc/parser.y:17357 cobc/typeck.c:6116 cobc/typeck.c:6123 -#, c-format -msgid "'%s' is not numeric" -msgstr "‘%s’ is not numeric" - -#: cobc/parser.y:17373 -#, c-format -msgid "'%s' is not a field or file" -msgstr "‘%s’ is not a field or file" - -#: cobc/parser.y:17393 cobc/parser.y:17411 -#, c-format -msgid "'%s' is not a field" -msgstr "‘%s’ is not a field" - -#: cobc/parser.y:17533 -#, c-format -msgid "'%s' is not a field or alphabet" -msgstr "‘%s’ is not a field or alphabet" - -#: cobc/parser.y:17559 -msgid "a subscripted data-item cannot be used here" -msgstr "a subscripted data-item cannot be used here" - -#: cobc/parser.y:17609 -msgid "unsigned integer value expected" -msgstr "unsigned integer value expected" - -#: cobc/parser.y:17621 cobc/parser.y:17625 cobc/parser.y:17675 -msgid "integer value expected" -msgstr "integer value expected" - -#: cobc/parser.y:17630 -msgid "invalid symbolic integer" -msgstr "invalid symbolic integer" - -#: cobc/parser.y:17646 cobc/parser.y:17650 -msgid "unsigned positive integer value expected" -msgstr "unsigned positive integer value expected" - -#: cobc/parser.y:17679 -msgid "invalid CLASS value" -msgstr "invalid CLASS value" - -#: cobc/parser.y:17767 -msgid "PHYSICAL argument for LENGTH functions" -msgstr "PHYSICAL argument for LENGTH functions" - -#: cobc/parser.y:17938 cobc/parser.y:17955 -msgid "cannot specify offset and SYSTEM-OFFSET at the same time" -msgstr "cannot specify offset and SYSTEM-OFFSET at the same time" - -#: cobc/pplex.l:223 cobc/pplex.l:1739 -msgid "debugging indicator" -msgstr "debugging indicator" - -#: cobc/pplex.l:300 -msgid "ignoring empty directive" -msgstr "ignoring empty directive" - -#: cobc/pplex.l:310 cobc/pplex.l:369 -#, c-format -msgid "ignoring invalid directive: '%s'" -msgstr "ignoring invalid directive: ‘%s’" - -#: cobc/pplex.l:317 -msgid "ignoring invalid directive" -msgstr "ignoring invalid directive" - -#: cobc/pplex.l:324 -msgid "VCS directive" -msgstr "VCS directive" - -#: cobc/pplex.l:377 cobc/pplex.l:392 -msgid "spurious '$' detected - ignored" -msgstr "spurious ‘$’ detected - ignored" - -#: cobc/pplex.l:386 -#, c-format -msgid "ignoring unknown directive: '%s'" -msgstr "ignoring unknown directive: ‘%s’" - -#: cobc/pplex.l:398 -msgid "PROCESS statement ignored" -msgstr "PROCESS statement ignored" - -#: cobc/pplex.l:864 -msgid "IF/ELIF/ELSE directive without matching END-IF" -msgstr "IF/ELIF/ELSE directive without matching END-IF" - -#: cobc/pplex.l:981 -msgid "file was included here" -msgstr "file was included here" - -#: cobc/pplex.l:1186 -#, c-format -msgid "directive nest depth exceeded: %d" -msgstr "directive nest depth exceeded: %d" - -#: cobc/pplex.l:1204 -msgid "ELSE directive without matching IF/ELIF" -msgstr "ELSE directive without matching IF/ELIF" - -#: cobc/pplex.l:1220 -msgid "END-IF directive without matching IF/ELIF/ELSE" -msgstr "END-IF directive without matching IF/ELIF/ELSE" - -#: cobc/pplex.l:1236 -msgid "ELIF directive without matching IF/ELIF" -msgstr "ELIF directive without matching IF/ELIF" - -#: cobc/pplex.l:1258 -#, c-format -msgid "invalid internal case: %u" -msgstr "invalid internal case: %u" - -#: cobc/pplex.l:1395 -msgid "buffer overrun - too many continuation lines" -msgstr "buffer overrun - too many continuation lines" - -#: cobc/pplex.l:1485 cobc/pplex.l:1494 -msgid "line not terminated by a newline" -msgstr "line not terminated by a newline" - -#: cobc/pplex.l:1488 cobc/pplex.l:1497 -#, c-format -msgid "source text exceeds %d bytes, will be truncated" -msgstr "source text exceeds %d bytes, will be truncated" - -#: cobc/pplex.l:1516 -msgid "version control conflict marker in file" -msgstr "version control conflict marker in file" - -#: cobc/pplex.l:1727 -msgid "invalid continuation in comment entry" -msgstr "invalid continuation in comment entry" - -#: cobc/pplex.l:1732 -msgid "continuation of COBOL words" -msgstr "continuation of COBOL words" - -#: cobc/pplex.l:1752 -#, c-format -msgid "invalid indicator '%c' at column 7" -msgstr "invalid indicator ‘%c’ at column 7" - -#: cobc/pplex.l:1800 cobc/pplex.l:1811 -msgid "invalid line continuation" -msgstr "invalid line continuation" - -#: cobc/pplex.l:1819 -msgid "continuation character expected" -msgstr "continuation character expected" - -#: cobc/pplex.l:1885 -#, c-format -msgid "source text after program-text area (column %d)" -msgstr "source text after program-text area (column %d)" - -#: cobc/ppparse.y:225 -msgid "directive comparison on different types" -msgstr "directive comparison on different types" - -#: cobc/ppparse.y:293 -#, c-format -msgid "duplicate DEFINE directive '%s'" -msgstr "duplicate DEFINE directive ‘%s’" - -#: cobc/ppparse.y:300 cobc/ppparse.y:310 -msgid "invalid constant in DEFINE directive" -msgstr "invalid constant in DEFINE directive" - -#: cobc/ppparse.y:408 -#, c-format -msgid "compiler flag '%s' unknown" -msgstr "compiler flag ‘%s’ unknown" - -#: cobc/ppparse.y:454 -#, c-format -msgid "invalid %s directive option '%s'" -msgstr "invalid %s directive option ‘%s’" - -#: cobc/ppparse.y:667 -msgid "*CONTROL statement" -msgstr "*CONTROL statement" - -#: cobc/ppparse.y:933 cobc/ppparse.y:1004 cobc/ppparse.y:1141 -#, c-format -msgid "invalid %s directive" -msgstr "invalid %s directive" - -#: cobc/ppparse.y:1043 -msgid "LEAP-SECOND ON directive" -msgstr "LEAP-SECOND ON directive" - -#: cobc/ppparse.y:1051 -msgid "TURN directive" -msgstr "TURN directive" - -#: cobc/ppparse.y:1133 cobc/ppparse.y:1158 -msgid "invalid constant" -msgstr "invalid constant" - -#: cobc/reserved.c:3797 -msgid "device name" -msgstr "device name" - -#: cobc/reserved.c:3800 -msgid "switch name" -msgstr "switch name" - -#: cobc/reserved.c:3803 -msgid "feature name" -msgstr "feature name" - -#: cobc/reserved.c:3902 -#, c-format -msgid "reserved word must have less than %d characters" -msgstr "reserved word must have less than %d characters" - -#: cobc/reserved.c:3921 -msgid "ignored asterisk at end of alias target" -msgstr "ignored asterisk at end of alias target" - -#: cobc/reserved.c:3984 -#, c-format -msgid "alias target '%s' is not a default reserved word" -msgstr "alias target ‘%s’ is not a default reserved word" - -#: cobc/reserved.c:4447 -#, c-format -msgid "invalid system-name '%s'" -msgstr "invalid system-name ‘%s’" - -#: cobc/reserved.c:4584 -#, c-format -msgid "'%s' is a reserved word, but isn't supported" -msgstr "‘%s’ is a reserved word, but isn't supported" - -#: cobc/reserved.c:4689 -#, c-format -msgid "intrinsic function %s is unknown" -msgstr "intrinsic function %s is unknown" - -#: cobc/reserved.c:4717 -msgid "Intrinsic Function" -msgstr "Intrinsic Function" - -#: cobc/reserved.c:4717 cobc/reserved.c:4897 cobc/reserved.c:5034 -msgid "Implemented" -msgstr "Implemented" - -#: cobc/reserved.c:4717 cobc/typeck.c:1022 -msgid "Parameters" -msgstr "Parameters" - -#: cobc/reserved.c:4721 cobc/reserved.c:4901 cobc/reserved.c:5048 -msgid "Yes" -msgstr "Yes" - -#: cobc/reserved.c:4724 cobc/reserved.c:4904 cobc/reserved.c:5054 -msgid "No" -msgstr "No" - -#: cobc/reserved.c:4730 -msgid "Unlimited" -msgstr "Unlimited" - -#: cobc/reserved.c:4804 -#, c-format -msgid "special register %s is unknown, needs a definition" -msgstr "special register %s is unknown, needs a definition" - -#: cobc/reserved.c:4810 -#, c-format -msgid "special register %s is unknown" -msgstr "special register %s is unknown" - -#: cobc/reserved.c:4897 -msgid "Internal registers" -msgstr "Internal registers" - -#: cobc/reserved.c:4897 -msgid "Definition" -msgstr "Definition" - -#: cobc/reserved.c:4985 -#, c-format -msgid "unknown system-name '%s'" -msgstr "unknown system-name ‘%s’" - -#: cobc/reserved.c:5011 -msgid "System names" -msgstr "System names" - -#: cobc/reserved.c:5034 -msgid "Reserved Words" -msgstr "Reserved Words" - -#: cobc/reserved.c:5046 -msgid "Yes (Context sensitive)" -msgstr "Yes (Context sensitive)" - -#: cobc/reserved.c:5052 -msgid "No (Context sensitive)" -msgstr "No (Context sensitive)" - -#: cobc/reserved.c:5081 -msgid "Extra (obsolete) context sensitive words" -msgstr "Extra (obsolete) context sensitive words" - -#: cobc/scanner.l:265 cobc/scanner.l:2288 -#, c-format -msgid "'%s' is not a default reserved word, so cannot be aliased" -msgstr "‘%s’ is not a default reserved word, so cannot be aliased" - -#: cobc/scanner.l:268 -#, c-format -msgid "'%s' is not a reserved word; you may want ADDSYN or OVERRIDE instead" -msgstr "‘%s’ is not a reserved word; you may want ADDSYN or OVERRIDE instead" - -#: cobc/scanner.l:988 -#, c-format -msgid "a constant may not be used here - '%s'" -msgstr "a constant may not be used here - ‘%s’" - -#: cobc/scanner.l:1043 -msgid "ignoring redundant ." -msgstr "ignoring redundant ." - -#: cobc/scanner.l:1101 -#, c-format -msgid "invalid symbol '%s' - skipping word" -msgstr "invalid symbol ‘%s’ - skipping word" - -#: cobc/scanner.l:1191 -msgid "invalid national literal" -msgstr "invalid national literal" - -#: cobc/scanner.l:1202 cobc/tree.c:2531 -#, c-format -msgid "invalid literal: '%s'" -msgstr "invalid literal: ‘%s’" - -#: cobc/scanner.l:1204 -#, c-format -msgid "invalid hexadecimal literal: '%s'" -msgstr "invalid hexadecimal literal: ‘%s’" - -#: cobc/scanner.l:1206 cobc/tree.c:1613 -#, c-format -msgid "invalid numeric literal: '%s'" -msgstr "invalid numeric literal: ‘%s’" - -#: cobc/scanner.l:1208 -#, c-format -msgid "invalid floating-point literal: '%s'" -msgstr "invalid floating-point literal: ‘%s’" - -#: cobc/scanner.l:1210 -#, c-format -msgid "invalid %s literal: '%s'" -msgstr "invalid %s literal: ‘%s’" - -#: cobc/scanner.l:1261 -#, c-format -msgid "literal length exceeds %d characters" -msgstr "literal length exceeds %d characters" - -#: cobc/scanner.l:1277 cobc/scanner.l:1326 cobc/scanner.l:1620 -msgid "zero-length literal" -msgstr "zero-length literal" - -#: cobc/scanner.l:1280 -msgid "national literal has zero length; a SPACE will be assumed" -msgstr "national literal has zero length; a SPACE will be assumed" - -#: cobc/scanner.l:1281 -msgid "alphanumeric literal has zero length; a SPACE will be assumed" -msgstr "alphanumeric literal has zero length; a SPACE will be assumed" - -#: cobc/scanner.l:1293 cobc/scanner.l:1294 cobc/scanner.l:1298 -#: cobc/scanner.l:1365 -msgid "national literal" -msgstr "national literal" - -#: cobc/scanner.l:1297 -msgid "national-character literal" -msgstr "national-character literal" - -#: cobc/scanner.l:1330 -msgid "hexadecimal literal has zero length; X'00' will be assumed" -msgstr "hexadecimal literal has zero length; X'00' will be assumed" - -#: cobc/scanner.l:1349 -msgid "hexadecimal-boolean literal" -msgstr "hexadecimal-boolean literal" - -#: cobc/scanner.l:1356 cobc/scanner.l:1370 cobc/scanner.l:1485 -#: cobc/scanner.l:1544 cobc/scanner.l:1642 cobc/scanner.l:1711 cobc/tree.c:2532 -#, c-format -msgid "literal length %d exceeds %d characters" -msgstr "literal length %d exceeds %d characters" - -#: cobc/scanner.l:1362 -msgid "hexadecimal-national literal" -msgstr "hexadecimal-national literal" - -#: cobc/scanner.l:1393 cobc/scanner.l:1425 cobc/scanner.l:1560 -#: cobc/scanner.l:1656 cobc/scanner.l:1721 -#, c-format -msgid "literal contains invalid character '%c'" -msgstr "literal contains invalid character ‘%c’" - -#: cobc/scanner.l:1449 -#, c-format -msgid "literal does not have an even number of digits" -msgstr "literal does not have an even number of digits" - -#: cobc/scanner.l:1492 -#, c-format -msgid "%s literals must contain at least one character" -msgstr "%s literals must contain at least one character" - -#: cobc/scanner.l:1527 cobc/scanner.l:1628 cobc/scanner.l:1702 -msgid "ACUCOBOL numeric literal" -msgstr "ACUCOBOL numeric literal" - -#: cobc/scanner.l:1537 -msgid "H literals must contain at least one character" -msgstr "H literals must contain at least one character" - -#: cobc/scanner.l:1575 cobc/scanner.l:1667 cobc/scanner.l:1732 -#, c-format -msgid "literal exceeds limit %u" -msgstr "literal exceeds limit %u" - -#: cobc/scanner.l:1616 -msgid "numeric boolean literal" -msgstr "numeric boolean literal" - -#: cobc/scanner.l:1622 -msgid "Boolean literal has zero length; B'0' will be assumed" -msgstr "Boolean literal has zero length; B'0' will be assumed" - -#: cobc/scanner.l:1698 -msgid "HP COBOL octal literal" -msgstr "HP COBOL octal literal" - -#: cobc/scanner.l:1810 cobc/tree.c:1624 -#, c-format -msgid "literal length %d exceeds maximum of %d digits" -msgstr "literal length %d exceeds maximum of %d digits" - -#: cobc/scanner.l:1816 cobc/tree.c:1629 -#, c-format -msgid "literal length %d exceeds %d digits" -msgstr "literal length %d exceeds %d digits" - -#: cobc/scanner.l:1928 cobc/tree.c:3513 -#, c-format -msgid "significand has more than %d digits" -msgstr "significand has more than %d digits" - -#: cobc/scanner.l:1933 -#, c-format -msgid "exponent has decimal point" -msgstr "exponent has decimal point" - -#: cobc/scanner.l:1939 cobc/tree.c:3521 -#, c-format -msgid "exponent has more than 4 digits" -msgstr "exponent has more than 4 digits" - -#: cobc/scanner.l:1969 -#, c-format -msgid "exponent not between -6143 and 6144" -msgstr "exponent not between -6143 and 6144" - -#: cobc/scanner.l:1978 -#, c-format -msgid "significand of 0 must be positive" -msgstr "significand of 0 must be positive" - -#: cobc/scanner.l:1983 -#, c-format -msgid "exponent of 0 must be 0" -msgstr "exponent of 0 must be 0" - -#: cobc/scanner.l:1988 -#, c-format -msgid "exponent of 0 must be positive" -msgstr "exponent of 0 must be positive" - -#: cobc/scanner.l:2170 -#, c-format -msgid "invalid CONSTANT: %s" -msgstr "invalid CONSTANT: %s" - -#: cobc/scanner.l:2180 -#, c-format -msgid "invalid alphanumeric CONSTANT: %s" -msgstr "invalid alphanumeric CONSTANT: %s" - -#: cobc/scanner.l:2184 -#, c-format -msgid "empty alphanumeric CONSTANT: %s" -msgstr "empty alphanumeric CONSTANT: %s" - -#: cobc/scanner.l:2201 cobc/scanner.l:2209 cobc/scanner.l:2214 -#, c-format -msgid "invalid numeric CONSTANT: %s" -msgstr "invalid numeric CONSTANT: %s" - -#: cobc/scanner.l:2291 -#, c-format -msgid "'%s' is already reserved; you may want MAKESYN instead" -msgstr "‘%s’ is already reserved; you may want MAKESYN instead" - -#: cobc/tree.c:341 -#, c-format -msgid "%s clause is required for file '%s'" -msgstr "%s clause is required for file ‘%s’" - -#: cobc/tree.c:345 -#, c-format -msgid "%s clause is invalid for file '%s' (file type)" -msgstr "%s clause is invalid for file ‘%s’ (file type)" - -#: cobc/tree.c:349 -#, c-format -msgid "%s clause is invalid for file '%s'" -msgstr "%s clause is invalid for file ‘%s’" - -#: cobc/tree.c:376 -#, c-format -msgid "FOR item '%s' is a record" -msgstr "FOR item ‘%s’ is a record" - -#: cobc/tree.c:385 -#, c-format -msgid "FOR item '%s' is in different record to '%s'" -msgstr "FOR item ‘%s’ is in different record to ‘%s’" - -#: cobc/tree.c:394 -#, c-format -msgid "FOR item '%s' is not in a record associated with '%s'" -msgstr "FOR item ‘%s’ is not in a record associated with ‘%s’" - -#: cobc/tree.c:477 -msgid "internal error node" -msgstr "internal error node" - -#: cobc/tree.c:479 -msgid "unknown constant" -msgstr "unknown constant" - -#: cobc/tree.c:639 -#, c-format -msgid "FUNCTION %s has invalid/not supported arguments - tag %d" -msgstr "FUNCTION %s has invalid/not supported arguments - tag %d" - -#: cobc/tree.c:760 -#, c-format -msgid "invalid date/time function: '%d'" -msgstr "invalid date/time function: ‘%d’" - -#: cobc/tree.c:798 -#, c-format -msgid "FUNCTION '%s' has invalid date/time format" -msgstr "FUNCTION ‘%s’ has invalid date/time format" - -#: cobc/tree.c:805 -#, c-format -msgid "FUNCTION '%s' has format in variable" -msgstr "FUNCTION ‘%s’ has format in variable" - -#: cobc/tree.c:1186 -#, c-format -msgid "literal '%s'" -msgstr "literal ‘%s’" - -#: cobc/tree.c:1315 -#, c-format -msgid "unknown tree tag: %d, category: %d" -msgstr "unknown tree tag: %d, category: %d" - -#: cobc/tree.c:1405 -#, c-format -msgid "unexpected numeric USAGE: %d" -msgstr "unexpected numeric USAGE: %d" - -#: cobc/tree.c:1419 -#, c-format -msgid "unexpected category: %d" -msgstr "unexpected category: %d" - -#: cobc/tree.c:1678 cobc/tree.c:1690 cobc/tree.c:1752 cobc/tree.c:1802 -#, c-format -msgid "numeric literal '%s' exceeds limit '%s'" -msgstr "numeric literal ‘%s’ exceeds limit ‘%s’" - -#: cobc/tree.c:2387 -msgid "invalid LOCALE literal" -msgstr "invalid LOCALE literal" - -#: cobc/tree.c:2512 -msgid "only literals with the same category can be concatenated" -msgstr "only literals with the same category can be concatenated" - -#: cobc/tree.c:2519 -msgid "only alphanumeric, national or boolean literals may be concatenated" -msgstr "only alphanumeric, national or boolean literals may be concatenated" - -#: cobc/tree.c:2791 -msgid "B, 0 or /" -msgstr "B, 0 or /" - -#: cobc/tree.c:2805 -msgid "the sign of the floating-point exponent" -msgstr "the sign of the floating-point exponent" - -#: cobc/tree.c:2807 -msgid "a leading +/- sign" -msgstr "a leading +/- sign" - -#: cobc/tree.c:2809 -msgid "a trailing +/- sign" -msgstr "a trailing +/- sign" - -#: cobc/tree.c:2811 -msgid "CR or DB" -msgstr "CR or DB" - -#: cobc/tree.c:2813 -msgid "a leading currency symbol" -msgstr "a leading currency symbol" - -#: cobc/tree.c:2815 -msgid "a trailing currency symbol" -msgstr "a trailing currency symbol" - -#: cobc/tree.c:2817 -msgid "a Z or * which is before the decimal point" -msgstr "a Z or * which is before the decimal point" - -#: cobc/tree.c:2819 -msgid "a Z or * which is after the decimal point" -msgstr "a Z or * which is after the decimal point" - -#: cobc/tree.c:2821 -msgid "a floating +/- string which is before the decimal point" -msgstr "a floating +/- string which is before the decimal point" - -#: cobc/tree.c:2823 -msgid "a floating +/- string which is after the decimal point" -msgstr "a floating +/- string which is after the decimal point" - -#: cobc/tree.c:2825 -msgid "a floating currency symbol string which is before the decimal point" -msgstr "a floating currency symbol string which is before the decimal point" - -#: cobc/tree.c:2827 -msgid "a floating currency symbol string which is after the decimal point" -msgstr "a floating currency symbol string which is after the decimal point" - -#: cobc/tree.c:2831 -msgid "A or X" -msgstr "A or X" - -#: cobc/tree.c:2837 -msgid "a P which is before the decimal point" -msgstr "a P which is before the decimal point" - -#: cobc/tree.c:2839 -msgid "a P which is after the decimal point" -msgstr "a P which is after the decimal point" - -#: cobc/tree.c:2860 cobc/tree.c:3267 -#, c-format -msgid "%s may only occur once in a PICTURE string" -msgstr "%s may only occur once in a PICTURE string" - -#: cobc/tree.c:2862 cobc/tree.c:3219 -#, c-format -msgid "%s cannot follow %s" -msgstr "%s cannot follow %s" - -#: cobc/tree.c:2865 -msgid "invalid PICTURE string detected" -msgstr "invalid PICTURE string detected" - -#: cobc/tree.c:2976 -msgid "number or constant in parentheses is not an unsigned integer" -msgstr "number or constant in parentheses is not an unsigned integer" - -#: cobc/tree.c:2985 -msgid "only up to 9 significant digits are permitted within parentheses" -msgstr "only up to 9 significant digits are permitted within parentheses" - -#: cobc/tree.c:2991 -msgid "number or constant in parentheses must be greater than zero" -msgstr "number or constant in parentheses must be greater than zero" - -#: cobc/tree.c:3002 -msgid "parentheses must be preceded by a picture symbol" -msgstr "parentheses must be preceded by a picture symbol" - -#: cobc/tree.c:3032 -msgid "unbalanced parentheses" -msgstr "unbalanced parentheses" - -#: cobc/tree.c:3040 -msgid "parentheses must contain an unsigned integer" -msgstr "parentheses must contain an unsigned integer" - -#: cobc/tree.c:3078 -#, c-format -msgid "'%s' is not a constant-name" -msgstr "‘%s’ is not a constant-name" - -#: cobc/tree.c:3085 -#, c-format -msgid "'%s' is not a numeric literal" -msgstr "‘%s’ is not a numeric literal" - -#: cobc/tree.c:3089 -#, c-format -msgid "'%s' is not an integer" -msgstr "‘%s’ is not an integer" - -#: cobc/tree.c:3093 -#, c-format -msgid "'%s' is not unsigned" -msgstr "‘%s’ is not unsigned" - -#: cobc/tree.c:3149 -msgid "missing PICTURE string" -msgstr "missing PICTURE string" - -#: cobc/tree.c:3178 -msgid "C must be followed by R" -msgstr "C must be followed by R" - -#: cobc/tree.c:3181 -msgid "D must be followed by B" -msgstr "D must be followed by B" - -#: cobc/tree.c:3195 cobc/tree.c:3264 cobc/tree.c:3290 cobc/tree.c:3401 -msgid "uncommon parentheses" -msgstr "uncommon parentheses" - -#: cobc/tree.c:3219 -msgid "exponent" -msgstr "exponent" - -#: cobc/tree.c:3272 -msgid "S must be at start of PICTURE string" -msgstr "S must be at start of PICTURE string" - -#: cobc/tree.c:3328 -msgid "P must be at start or end of PICTURE string" -msgstr "P must be at start or end of PICTURE string" - -#: cobc/tree.c:3358 -msgid "cannot have both Z and * in PICTURE string" -msgstr "cannot have both Z and * in PICTURE string" - -#: cobc/tree.c:3436 -#, c-format -msgid "invalid PICTURE character '%c'" -msgstr "invalid PICTURE character ‘%c’" - -#: cobc/tree.c:3466 -#, c-format -msgid "PICTURE string may not contain more than %d characters; contains %d characters" -msgstr "PICTURE string may not contain more than %d characters; contains %d characters" - -#: cobc/tree.c:3471 -msgid "PICTURE string must contain at least one of the set A, N, X, Z, 1, 9 and *; or at least two of the set +, - and the currency symbol" -msgstr "PICTURE string must contain at least one of the set A, N, X, Z, 1, 9 and *; or at least two of the set +, - and the currency symbol" - -#: cobc/tree.c:3498 -#, c-format -msgid "numeric field cannot be larger than %d digits" -msgstr "numeric field cannot be larger than %d digits" - -#: cobc/tree.c:3954 cobc/tree.c:3967 -#, c-format -msgid "no DETAIL line defined in report %s" -msgstr "no DETAIL line defined in report %s" - -#: cobc/tree.c:3969 -msgid "PAGE LIMIT FIRST DETAIL should be >= HEADING" -msgstr "PAGE LIMIT FIRST DETAIL should be >= HEADING" - -#: cobc/tree.c:3972 -msgid "PAGE LIMIT FOOTING should be >= HEADING" -msgstr "PAGE LIMIT FOOTING should be >= HEADING" - -#: cobc/tree.c:3974 -msgid "PAGE LIMIT LAST DETAIL should be >= FIRST DETAIL" -msgstr "PAGE LIMIT LAST DETAIL should be >= FIRST DETAIL" - -#: cobc/tree.c:3976 -msgid "PAGE LIMIT FOOTING should be >= LAST DETAIL" -msgstr "PAGE LIMIT FOOTING should be >= LAST DETAIL" - -#: cobc/tree.c:3978 -msgid "PAGE LIMIT LINES should be >= FOOTING" -msgstr "PAGE LIMIT LINES should be >= FOOTING" - -#: cobc/tree.c:4162 -#, c-format -msgid "maximum keys (%d/%d) exceeded for file '%s'" -msgstr "maximum keys (%d/%d) exceeded for file ‘%s’" - -#: cobc/tree.c:4226 cobc/tree.c:4249 -#, c-format -msgid "invalid KEY item '%s', not in file '%s'" -msgstr "invalid KEY item '%s', not in file ‘%s’" - -#: cobc/tree.c:4260 -#, c-format -msgid "minimal record length %d can not hold the key item '%s'; needs to be at least %d" -msgstr "minimal record length %d can not hold the key item '%s'; needs to be at least %d" - -#: cobc/tree.c:4296 -#, c-format -msgid "missing file description for %s" -msgstr "missing file description for %s" - -#: cobc/tree.c:4328 -#, c-format -msgid "size of record '%s' (%d) smaller than minimum of file '%s' (%d)" -msgstr "size of record ‘%s’ (%d) smaller than minimum of file ‘%s’ (%d)" - -#: cobc/tree.c:4331 cobc/tree.c:4348 -msgid "file size adjusted" -msgstr "file size adjusted" - -#: cobc/tree.c:4343 -#, c-format -msgid "size of record '%s' (%d) larger than maximum of file '%s' (%d)" -msgstr "size of record ‘%s’ (%d) larger than maximum of file ‘%s’ (%d)" - -#: cobc/tree.c:4386 -#, c-format -msgid "file '%s': RECORD VARYING specified without limits, but implied limits are equal" -msgstr "file '%s': RECORD VARYING specified without limits, but implied limits are equal" - -#: cobc/tree.c:4393 -#, c-format -msgid "file '%s': record size (IDX) %d exceeds maximum allowed (%d)" -msgstr "file '%s': record size (IDX) %d exceeds maximum allowed (%d)" - -#: cobc/tree.c:4397 -#, c-format -msgid "file '%s': record size %d exceeds maximum allowed (%d)" -msgstr "file '%s': record size %d exceeds maximum allowed (%d)" - -#: cobc/tree.c:4404 -msgid "RECORD DELIMITER clause on file with fixed-length records" -msgstr "RECORD DELIMITER clause on file with fixed-length records" - -#: cobc/tree.c:4965 -#, c-format -msgid "literal '%.38s' is longer than '%s'" -msgstr "literal ‘%.38s’ is longer than ‘%s’" - -#: cobc/tree.c:4969 -#, c-format -msgid "literal '%.38s' is longer than reference-modification of '%s'" -msgstr "literal ‘%.38s’ is longer than reference-modification of ‘%s’" - -#: cobc/tree.c:4994 -#, c-format -msgid "literal '%s' is alphanumeric but '%s' is numeric" -msgstr "literal ‘%s’ is alphanumeric but ‘%s’ is numeric" - -#: cobc/tree.c:5036 -#, c-format -msgid "literal '%s' has more decimals than '%s'" -msgstr "literal ‘%s’ has more decimals than ‘%s’" - -#: cobc/tree.c:5078 -#, c-format -msgid "literal '%s' has more digits than '%s'" -msgstr "literal ‘%s’ has more digits than ‘%s’" - -#: cobc/tree.c:5118 cobc/tree.c:5142 -#, c-format -msgid "unsigned '%s' may not be %s %s" -msgstr "unsigned ‘%s’ may not be %s %s" - -#: cobc/tree.c:5128 cobc/tree.c:5151 -#, c-format -msgid "unsigned '%s' may always be %s %s" -msgstr "unsigned ‘%s’ may always be %s %s" - -#: cobc/tree.c:5184 cobc/tree.c:5209 -#, c-format -msgid "'%s' may not be %s %s" -msgstr "‘%s’ may not be %s %s" - -#: cobc/tree.c:5195 cobc/tree.c:5220 -#, c-format -msgid "'%s' may always be %s %s" -msgstr "‘%s’ may always be %s %s" - -#: cobc/tree.c:5355 -msgid "divide by constant ZERO" -msgstr "divide by constant ZERO" - -#: cobc/tree.c:5404 cobc/tree.c:5409 cobc/tree.c:5630 cobc/tree.c:5670 -#: cobc/typeck.c:4476 cobc/typeck.c:4484 cobc/typeck.c:4491 cobc/typeck.c:5561 -#: cobc/typeck.c:5706 -msgid "invalid expression" -msgstr "invalid expression" - -#: cobc/tree.c:5627 -#, c-format -msgid "invalid expression: %s %s %s" -msgstr "invalid expression: %s %s %s" - -#: cobc/tree.c:5675 -#, c-format -msgid "unexpected operator: %d" -msgstr "unexpected operator: %d" - -#: cobc/tree.c:5685 -#, c-format -msgid "expression '%.38s' %s '%.38s' is always TRUE" -msgstr "expression ‘%.38s’ %s ‘%.38s’ is always TRUE" - -#: cobc/tree.c:5691 -msgid "expression is always TRUE" -msgstr "expression is always TRUE" - -#: cobc/tree.c:5703 -#, c-format -msgid "expression '%.38s' %s '%.38s' is always FALSE" -msgstr "expression ‘%.38s’ %s ‘%.38s’ is always FALSE" - -#: cobc/tree.c:5709 -msgid "expression is always FALSE" -msgstr "expression is always FALSE" - -#: cobc/tree.c:6024 -msgid "PERFORM FOREVER since UNTIL is always FALSE" -msgstr "PERFORM FOREVER since UNTIL is always FALSE" - -#: cobc/tree.c:6028 -msgid "PERFORM ONCE since UNTIL is always TRUE" -msgstr "PERFORM ONCE since UNTIL is always TRUE" - -#: cobc/tree.c:6031 -msgid "PERFORM NEVER since UNTIL is always TRUE" -msgstr "PERFORM NEVER since UNTIL is always TRUE" - -#: cobc/tree.c:6132 -#, c-format -msgid "no definition/prototype seen for FUNCTION '%s'" -msgstr "no definition/prototype seen for FUNCTION ‘%s’" - -#: cobc/tree.c:6134 -#, c-format -msgid "no definition/prototype seen for PROGRAM '%s'" -msgstr "no definition/prototype seen for PROGRAM ‘%s’" - -#: cobc/tree.c:6143 -#, c-format -msgid "no definition/prototype seen for FUNCTION with external name '%s'" -msgstr "no definition/prototype seen for FUNCTION with external name ‘%s’" - -#: cobc/tree.c:6145 -#, c-format -msgid "no definition/prototype seen for PROGRAM with external name '%s'" -msgstr "no definition/prototype seen for PROGRAM with external name ‘%s’" - -#: cobc/tree.c:6237 -#, c-format -msgid "FUNCTION %s has invalid argument" -msgstr "FUNCTION %s has invalid argument" - -#: cobc/tree.c:6239 -#, c-format -msgid "either all arguments or none should be if type %s" -msgstr "either all arguments or none should be if type %s" - -#: cobc/tree.c:6271 cobc/tree.c:6277 cobc/tree.c:6319 cobc/tree.c:6324 -#, c-format -msgid "FUNCTION '%s' has invalid reference modification" -msgstr "FUNCTION ‘%s’ has invalid reference modification" - -#: cobc/tree.c:6288 cobc/tree.c:6730 -#, c-format -msgid "FUNCTION '%s' unknown" -msgstr "FUNCTION ‘%s’ unknown" - -#: cobc/tree.c:6292 -#, c-format -msgid "FUNCTION '%s' is not implemented" -msgstr "FUNCTION ‘%s’ is not implemented" - -#: cobc/tree.c:6299 cobc/tree.c:6306 cobc/tree.c:6714 -#, c-format -msgid "FUNCTION '%s' has wrong number of arguments" -msgstr "FUNCTION ‘%s’ has wrong number of arguments" - -#: cobc/tree.c:6313 -#, c-format -msgid "FUNCTION '%s' cannot have reference modification" -msgstr "FUNCTION ‘%s’ cannot have reference modification" - -#: cobc/tree.c:6572 cobc/tree.c:6646 cobc/tree.c:6652 cobc/tree.c:6660 -#: cobc/tree.c:6668 -#, c-format -msgid "FUNCTION '%s' has invalid argument" -msgstr "FUNCTION ‘%s’ has invalid argument" - -#: cobc/tree.c:6720 -#, c-format -msgid "FUNCTION '%s' has invalid first argument" -msgstr "FUNCTION ‘%s’ has invalid first argument" - -#: cobc/typeck.c:686 -#, c-format -msgid "%s item not allowed here: '%s'" -msgstr "%s item not allowed here: ‘%s’" - -#: cobc/typeck.c:728 -#, c-format -msgid "'%s' is not a group name" -msgstr "‘%s’ is not a group name" - -#: cobc/typeck.c:753 -#, c-format -msgid "'%s' is not a numeric name" -msgstr "‘%s’ is not a numeric name" - -#: cobc/typeck.c:782 -#, c-format -msgid "'%s' is not a numeric or numeric-edited name" -msgstr "‘%s’ is not a numeric or numeric-edited name" - -#: cobc/typeck.c:835 -#, c-format -msgid "'%s' is Alpha, instead of a numeric value" -msgstr "‘%s’ is Alpha, instead of a numeric value" - -#: cobc/typeck.c:838 -#, c-format -msgid "'%s' is Alpha Edited, instead of a numeric value" -msgstr "‘%s’ is Alpha Edited, instead of a numeric value" - -#: cobc/typeck.c:851 -#, c-format -msgid "'%s' is not a numeric value" -msgstr "‘%s’ is not a numeric value" - -#: cobc/typeck.c:901 -#, c-format -msgid "'%s' is not an integer value" -msgstr "‘%s’ is not an integer value" - -#: cobc/typeck.c:905 -msgid "positive numeric integer is required here" -msgstr "positive numeric integer is required here" - -#: cobc/typeck.c:1022 -msgid "System routine" -msgstr "System routine" - -#: cobc/typeck.c:1638 libcob/call.c:1069 -#, c-format -msgid "'%s' literal includes leading spaces which are omitted" -msgstr "‘%s’ literal includes leading spaces which are omitted" - -#: cobc/typeck.c:1642 -#, c-format -msgid "'%s' literal includes trailing spaces which are omitted" -msgstr "‘%s’ literal includes trailing spaces which are omitted" - -#: cobc/typeck.c:1709 -msgid "ON/OFF usage requires a SWITCH name" -msgstr "ON/OFF usage requires a SWITCH name" - -#: cobc/typeck.c:1727 -#, c-format -msgid "word length exceeds maximum of %d characters: '%s'" -msgstr "word length exceeds maximum of %d characters: ‘%s’" - -#: cobc/typeck.c:1730 cobc/typeck.c:1733 -#, c-format -msgid "word length exceeds %d characters: '%s'" -msgstr "word length exceeds %d characters: ‘%s’" - -#: cobc/typeck.c:1810 -#, c-format -msgid "ASSIGN %s interpreted as '%s'" -msgstr "ASSIGN %s interpreted as ‘%s’" - -#: cobc/typeck.c:1900 cobc/typeck.c:2067 -#, c-format -msgid "subscript missing for '%s' - defaulting to 1" -msgstr "subscript missing for ‘%s’ - defaulting to 1" - -#: cobc/typeck.c:1913 cobc/typeck.c:1992 -#, c-format -msgid "'%s' cannot be reference modified" -msgstr "‘%s’ cannot be reference modified" - -#: cobc/typeck.c:1923 cobc/typeck.c:1988 cobc/typeck.c:2256 -#, c-format -msgid "'%s' cannot be subscripted" -msgstr "‘%s’ cannot be subscripted" - -#: cobc/typeck.c:1927 cobc/typeck.c:2260 -#, c-format -msgid "'%s' requires one subscript" -msgstr "‘%s’ requires one subscript" - -#: cobc/typeck.c:1930 cobc/typeck.c:2263 -#, c-format -msgid "'%s' requires %d subscripts" -msgstr "‘%s’ requires %d subscripts" - -#. TRANSLATORS: This msgid is used when a variable name -#. or label is referenced in a compiler message. -#: cobc/typeck.c:1946 -#, c-format -msgid "'%s'" -msgstr "'%s'" - -#: cobc/typeck.c:1948 -#, c-format -msgid "'%s' (accessed by '%s')" -msgstr "‘%s’ (accessed by '%s')" - -#: cobc/typeck.c:2051 -#, c-format -msgid "'%s' has no OCCURS clause" -msgstr "‘%s’ has no OCCURS clause" - -#: cobc/typeck.c:2108 libcob/common.c:3114 -#, c-format -msgid "subscript of '%s' out of bounds: %d" -msgstr "subscript of ‘%s’ out of bounds: %d" - -#: cobc/typeck.c:2162 cobc/typeck.c:2172 -msgid "offset must be greater than zero" -msgstr "offset must be greater than zero" - -#: cobc/typeck.c:2167 cobc/typeck.c:2185 cobc/typeck.c:2204 -msgid "length must be greater than zero" -msgstr "length must be greater than zero" - -#: cobc/typeck.c:2175 cobc/typeck.c:2178 libcob/common.c:3136 -#, c-format -msgid "offset of '%s' out of bounds: %d" -msgstr "offset of ‘%s’ out of bounds: %d" - -#: cobc/typeck.c:2189 cobc/typeck.c:2193 cobc/typeck.c:2207 cobc/typeck.c:2211 -#: libcob/common.c:3149 -#, c-format -msgid "length of '%s' out of bounds: %d" -msgstr "length of ‘%s’ out of bounds: %d" - -#: cobc/typeck.c:2323 cobc/typeck.c:2407 -msgid "reference modification not allowed here" -msgstr "reference modification not allowed here" - -#: cobc/typeck.c:2337 cobc/typeck.c:2433 -msgid "88 level item not allowed here" -msgstr "88 level item not allowed here" - -#: cobc/typeck.c:2342 -#, c-format -msgid "LENGTH OF '%s' not allowed outside of Procedure Division" -msgstr "LENGTH OF ‘%s’ not allowed outside of Procedure Division" - -#: cobc/typeck.c:2346 cobc/typeck.c:2437 cobc/typeck.c:2445 cobc/typeck.c:2512 -msgid "variable length item not allowed here" -msgstr "variable length item not allowed here" - -#: cobc/typeck.c:2375 -#, c-format -msgid "'%s' has not been DEFINEd" -msgstr "‘%s’ has not been DEFINEd" - -#: cobc/typeck.c:2411 -msgid "only field names allowed here" -msgstr "only field names allowed here" - -#: cobc/typeck.c:2422 -#, c-format -msgid "VALUE of '%s': %s target '%s' is invalid" -msgstr "VALUE of '%s': %s target ‘%s’ is invalid" - -#: cobc/typeck.c:2424 cobc/typeck.c:2494 -msgid "target must be in FILE SECTION or LINKAGE SECTION or have the EXTERNAL clause" -msgstr "target must be in FILE SECTION or LINKAGE SECTION or have the EXTERNAL clause" - -#: cobc/typeck.c:2480 cobc/typeck.c:2493 -#, c-format -msgid "VALUE of '%s': %s target is invalid" -msgstr "VALUE of '%s': %s target is invalid" - -#: cobc/typeck.c:2482 -msgid "no previous data-item found" -msgstr "no previous data-item found" - -#: cobc/typeck.c:2667 -#, c-format -msgid "'%s' is not an alphabet name" -msgstr "‘%s’ is not an alphabet name" - -#: cobc/typeck.c:2931 -#, c-format -msgid "duplicate character values in alphabet '%s': %s" -msgstr "duplicate character values in alphabet '%s': %s" - -#: cobc/typeck.c:2936 -#, c-format -msgid "invalid character values in alphabet '%s', starting at position %d" -msgstr "invalid character values in alphabet '%s', starting at position %d" - -#: cobc/typeck.c:2990 -msgid "invalid ALPHABET name" -msgstr "invalid ALPHABET name" - -#: cobc/typeck.c:3054 -#, c-format -msgid "duplicate character values in class '%s'" -msgstr "duplicate character values in class ‘%s’" - -#: cobc/typeck.c:3072 -#, c-format -msgid "'%s' is not a locale name" -msgstr "‘%s’ is not a locale name" - -#: cobc/typeck.c:3206 -msgid "invalid RECORD DEPENDING item" -msgstr "invalid RECORD DEPENDING item" - -#: cobc/typeck.c:3211 -msgid "RECORD DEPENDING must reference a data-item" -msgstr "RECORD DEPENDING must reference a data-item" - -#: cobc/typeck.c:3234 -#, c-format -msgid "RECORD DEPENDING item '%s' should be defined in WORKING-STORAGE, LOCAL-STORAGE or LINKAGE SECTION" -msgstr "RECORD DEPENDING item ‘%s’ should be defined in WORKING-STORAGE, LOCAL-STORAGE or LINKAGE SECTION" - -#: cobc/typeck.c:3247 -#, c-format -msgid "file %s: RELATIVE KEY %s is not numeric" -msgstr "file %s: RELATIVE KEY %s is not numeric" - -#: cobc/typeck.c:3256 -#, c-format -msgid "file %s: RELATIVE KEY %s must be integer" -msgstr "file %s: RELATIVE KEY %s must be integer" - -#: cobc/typeck.c:3261 -#, c-format -msgid "file %s: RELATIVE KEY %s must be unsigned" -msgstr "file %s: RELATIVE KEY %s must be unsigned" - -#: cobc/typeck.c:3268 -#, c-format -msgid "file %s: RELATIVE KEY %s cannot have OCCURS" -msgstr "file %s: RELATIVE KEY %s cannot have OCCURS" - -#: cobc/typeck.c:3274 -#, c-format -msgid "RELATIVE KEY %s cannot be in file record belonging to %s" -msgstr "RELATIVE KEY %s cannot be in file record belonging to %s" - -#: cobc/typeck.c:3283 -#, c-format -msgid "file %s: RELATIVE KEY %s declared outside WORKING-STORAGE" -msgstr "file %s: RELATIVE KEY %s declared outside WORKING-STORAGE" - -#: cobc/typeck.c:3306 cobc/typeck.c:7184 -#, c-format -msgid "'%s' is not a valid data name" -msgstr "‘%s’ is not a valid data name" - -#: cobc/typeck.c:3313 -#, c-format -msgid "CRT STATUS item '%s' should be defined in WORKING-STORAGE or LOCAL-STORAGE" -msgstr "CRT STATUS item ‘%s’ should be defined in WORKING-STORAGE or LOCAL-STORAGE" - -#: cobc/typeck.c:3319 -#, c-format -msgid "'%s' CRT STATUS must have at least 4 digits" -msgstr "‘%s’ CRT STATUS must have at least 4 digits" - -#: cobc/typeck.c:3325 -#, c-format -msgid "'%s' CRT STATUS must be 4 characters long" -msgstr "‘%s’ CRT STATUS must be 4 characters long" - -#: cobc/typeck.c:3341 -#, c-format -msgid "variable '%s' will be implicitly defined" -msgstr "variable ‘%s’ will be implicitly defined" - -#: cobc/typeck.c:3375 cobc/typeck.c:3438 -msgid "ASSIGN variable" -msgstr "ASSIGN variable" - -#: cobc/typeck.c:3443 -#, c-format -msgid "ASSIGN data item '%s' is invalid" -msgstr "ASSIGN data item ‘%s’ is invalid" - -#: cobc/typeck.c:3507 -#, c-format -msgid "'%s' CURSOR must be 4 or 6 characters long" -msgstr "‘%s’ CURSOR must be 4 or 6 characters long" - -#: cobc/typeck.c:3557 cobc/typeck.c:3561 -#, c-format -msgid "%s does not have a fixed location" -msgstr "%s does not have a fixed location" - -#: cobc/typeck.c:3573 -#, c-format -msgid "'%s' cannot have nested OCCURS DEPENDING" -msgstr "‘%s’ cannot have nested OCCURS DEPENDING" - -#: cobc/typeck.c:3587 -#, c-format -msgid "'%s' OCCURS DEPENDING ON field item invalid here" -msgstr "‘%s’ OCCURS DEPENDING ON field item invalid here" - -#: cobc/typeck.c:3595 -#, c-format -msgid "'%s' cannot have OCCURS DEPENDING because of '%s'" -msgstr "‘%s’ cannot have OCCURS DEPENDING because of ‘%s’" - -#: cobc/typeck.c:3607 -#, c-format -msgid "'%s' OCCURS DEPENDING ON item must have GLOBAL attribute" -msgstr "‘%s’ OCCURS DEPENDING ON item must have GLOBAL attribute" - -#: cobc/typeck.c:3621 -#, c-format -msgid "PASSWORD '%s' for EXTERNAL file '%s' must have EXTERNAL attribute" -msgstr "PASSWORD ‘%s’ for EXTERNAL file ‘%s’ must have EXTERNAL attribute" - -#: cobc/typeck.c:3644 -#, c-format -msgid "file %s: ASSIGN %s declared outside WORKING-STORAGE" -msgstr "file %s: ASSIGN %s declared outside WORKING-STORAGE" - -#: cobc/typeck.c:3674 -#, c-format -msgid "duplicate APPLY COMMIT target: '%s'" -msgstr "duplicate APPLY COMMIT target: ‘%s’" - -#: cobc/typeck.c:3688 -msgid "APPLY COMMIT statement invalid for SORT file" -msgstr "APPLY COMMIT statement invalid for SORT file" - -#: cobc/typeck.c:3691 -msgid "APPLY COMMIT statement invalid for REPORT file" -msgstr "APPLY COMMIT statement invalid for REPORT file" - -#: cobc/typeck.c:3698 -#, c-format -msgid "APPLY COMMIT item '%s' should be defined in WORKING-STORAGE or LOCAL-STORAGE" -msgstr "APPLY COMMIT item ‘%s’ should be defined in WORKING-STORAGE or LOCAL-STORAGE" - -#: cobc/typeck.c:3712 -#, c-format -msgid "item not allowed here: '%s'" -msgstr "item not allowed here: ‘%s’" - -#: cobc/typeck.c:3725 -#, c-format -msgid "%s may not be subscripted" -msgstr "%s may not be subscripted" - -#: cobc/typeck.c:3729 -#, c-format -msgid "%s may not be reference modified" -msgstr "%s may not be reference modified" - -#: cobc/typeck.c:3789 -#, c-format -msgid "DEBUGGING target invalid: '%s'" -msgstr "DEBUGGING target invalid: ‘%s’" - -#: cobc/typeck.c:3795 -#, c-format -msgid "DEBUGGING target already specified with ALL PROCEDURES: '%s'" -msgstr "DEBUGGING target already specified with ALL PROCEDURES: ‘%s’" - -#: cobc/typeck.c:3815 -msgid "DEBUGGING target" -msgstr "DEBUGGING target" - -#: cobc/typeck.c:3822 -#, c-format -msgid "'%s' is not a valid DEBUGGING target" -msgstr "‘%s’ is not a valid DEBUGGING target" - -#: cobc/typeck.c:3860 cobc/typeck.c:3865 -#, c-format -msgid "'%s' is not in DECLARATIVES" -msgstr "‘%s’ is not in DECLARATIVES" - -#: cobc/typeck.c:3877 -#, c-format -msgid "invalid reference to '%s' (in DECLARATIVES)" -msgstr "invalid reference to ‘%s’ (in DECLARATIVES)" - -#: cobc/typeck.c:3886 -#, c-format -msgid "'%s' is not a procedure name" -msgstr "‘%s’ is not a procedure name" - -#: cobc/typeck.c:3948 -#, c-format -msgid "LINKAGE item '%s' is not a PROCEDURE USING parameter" -msgstr "LINKAGE item ‘%s’ is not a PROCEDURE USING parameter" - -#: cobc/typeck.c:4001 -#, c-format -msgid "'%s' is not an alterable paragraph" -msgstr "‘%s’ is not an alterable paragraph" - -#: cobc/typeck.c:4604 cobc/typeck.c:4608 -#, c-format -msgid "suggest parentheses around %s within %s" -msgstr "suggest parentheses around %s within %s" - -#: cobc/typeck.c:4616 -msgid "invalid conditional expression" -msgstr "invalid conditional expression" - -#: cobc/typeck.c:4726 -#, c-format -msgid "internal decimal structure size exceeded: %d" -msgstr "internal decimal structure size exceeded: %d" - -#: cobc/typeck.c:4729 -msgid "Try to minimize the number of parentheses or split into multiple computations." -msgstr "Try to minimize the number of parentheses or split into multiple computations." - -#: cobc/typeck.c:4753 -#, c-format -msgid "more than %d nested expressions" -msgstr "more than %d nested expressions" - -#: cobc/typeck.c:4795 -msgid "precision of result may change with arithmetic-osvs" -msgstr "precision of result may change with arithmetic-osvs" - -#: cobc/typeck.c:4851 -#, c-format -msgid "unexpected operation: %c (%d)" -msgstr "unexpected operation: %c (%d)" - -#: cobc/typeck.c:4856 -#, c-format -msgid "%s operator may be misplaced" -msgstr "%s operator may be misplaced" - -#: cobc/typeck.c:4926 -msgid "unexpected constant expansion" -msgstr "unexpected constant expansion" - -#: cobc/typeck.c:5747 -#, c-format -msgid "more than %d nested conditions" -msgstr "more than %d nested conditions" - -#: cobc/typeck.c:6104 cobc/typeck.c:6180 -msgid "no CORRESPONDING items found" -msgstr "no CORRESPONDING items found" - -#: cobc/typeck.c:6252 -msgid "no items to ACCEPT found" -msgstr "no items to ACCEPT found" - -#: cobc/typeck.c:6302 -msgid "no items to DISPLAY found" -msgstr "no items to DISPLAY found" - -#: cobc/typeck.c:6421 -msgid "cannot specify figurative constant ZERO in AT clause" -msgstr "cannot specify figurative constant ZERO in AT clause" - -#: cobc/typeck.c:6425 -msgid "value in AT clause is not numeric" -msgstr "value in AT clause is not numeric" - -#: cobc/typeck.c:6431 -msgid "value in AT clause must have 4 or 6 digits" -msgstr "value in AT clause must have 4 or 6 digits" - -#: cobc/typeck.c:6553 -msgid "invalid PROMPT literal" -msgstr "invalid PROMPT literal" - -#: cobc/typeck.c:6558 -msgid "invalid PROMPT identifier" -msgstr "invalid PROMPT identifier" - -#: cobc/typeck.c:6848 -#, c-format -msgid "'%s' is not an input device" -msgstr "‘%s’ is not an input device" - -#: cobc/typeck.c:6878 cobc/typeck.c:8016 -#, c-format -msgid "'%s' is not defined in SPECIAL-NAMES" -msgstr "‘%s’ is not defined in SPECIAL-NAMES" - -#: cobc/typeck.c:6883 -#, c-format -msgid "invalid input device '%s'" -msgstr "invalid input device ‘%s’" - -#: cobc/typeck.c:6888 cobc/typeck.c:8020 -#, c-format -msgid "unknown device '%s'; it may exist in another dialect" -msgstr "unknown device '%s'; it may exist in another dialect" - -#: cobc/typeck.c:6891 cobc/typeck.c:8023 -#, c-format -msgid "unknown device '%s'; not defined in SPECIAL-NAMES" -msgstr "unknown device '%s'; not defined in SPECIAL-NAMES" - -#: cobc/typeck.c:6915 -msgid "target of ALLOCATE is not a BASED item" -msgstr "target of ALLOCATE is not a BASED item" - -#: cobc/typeck.c:6926 -msgid "target of RETURNING is not a data pointer" -msgstr "target of RETURNING is not a data pointer" - -#: cobc/typeck.c:6936 cobc/typeck.c:7342 -msgid "amount must be specified as a numeric expression" -msgstr "amount must be specified as a numeric expression" - -#: cobc/typeck.c:6949 -msgid "INITIALIZED TO item is not alphanumeric" -msgstr "INITIALIZED TO item is not alphanumeric" - -#: cobc/typeck.c:7019 -msgid "only alphanumeric FUNCTION types are allowed here" -msgstr "only alphanumeric FUNCTION types are allowed here" - -#: cobc/typeck.c:7027 -msgid "invalid RETURNING field" -msgstr "invalid RETURNING field" - -#: cobc/typeck.c:7046 -msgid "STDCALL not available on this platform" -msgstr "STDCALL not available on this platform" - -#: cobc/typeck.c:7050 -msgid "STDCALL used on 64-bit Windows platform" -msgstr "STDCALL used on 64-bit Windows platform" - -#: cobc/typeck.c:7055 -msgid "STATIC CALL convention requires a literal program name" -msgstr "STATIC CALL convention requires a literal program name" - -#: cobc/typeck.c:7060 cobc/typeck.c:10632 cobc/typeck.c:11539 -#: cobc/typeck.c:11903 -msgid "HANDLE must be either a generic or a THREAD HANDLE" -msgstr "HANDLE must be either a generic or a THREAD HANDLE" - -#: cobc/typeck.c:7078 -msgid "numeric literal is negative" -msgstr "numeric literal is negative" - -#: cobc/typeck.c:7157 -msgid "numeric literal exceeds size limits" -msgstr "numeric literal exceeds size limits" - -#: cobc/typeck.c:7175 -#, c-format -msgid "figurative constant %s invalid here" -msgstr "figurative constant %s invalid here" - -#: cobc/typeck.c:7190 -#, c-format -msgid "'%s' ANY LENGTH item not passed BY REFERENCE" -msgstr "‘%s’ ANY LENGTH item not passed BY REFERENCE" - -#: cobc/typeck.c:7198 -#, c-format -msgid "'%s' is not a 01 or 77 level item" -msgstr "‘%s’ is not a 01 or 77 level item" - -#: cobc/typeck.c:7228 cobc/typeck.c:7233 -#, c-format -msgid "wrong number of CALL parameters for '%s', %d given, %d expected" -msgstr "wrong number of CALL parameters for '%s', %d given, %d expected" - -#: cobc/typeck.c:7300 cobc/typeck.c:7374 cobc/typeck.c:7378 cobc/typeck.c:7382 -#: cobc/typeck.c:7412 cobc/typeck.c:10591 cobc/typeck.c:10755 -#: cobc/typeck.c:10944 cobc/typeck.c:10948 cobc/typeck.c:11844 -#: cobc/typeck.c:12087 cobc/typeck.c:12090 -#, c-format -msgid "%s not allowed on %s files" -msgstr "%s not allowed on %s files" - -#: cobc/typeck.c:7336 -msgid "AFTER phrase in CONTINUE statement" -msgstr "AFTER phrase in CONTINUE statement" - -#: cobc/typeck.c:7478 -msgid "positions cannot be specified for main windows" -msgstr "positions cannot be specified for main windows" - -#: cobc/typeck.c:7488 cobc/typeck.c:7491 cobc/typeck.c:7508 -msgid "HANDLE must be either a generic or a WINDOW HANDLE or X(10)" -msgstr "HANDLE must be either a generic or a WINDOW HANDLE or X(10)" - -#: cobc/typeck.c:7617 -#, c-format -msgid "'%s' is an invalid type for DISPLAY operand" -msgstr "‘%s’ is an invalid type for DISPLAY operand" - -#: cobc/typeck.c:7622 -msgid "invalid type for DISPLAY operand" -msgstr "invalid type for DISPLAY operand" - -#: cobc/typeck.c:7973 cobc/typeck.c:8006 -#, c-format -msgid "'%s' is not an output device" -msgstr "‘%s’ is not an output device" - -#: cobc/typeck.c:8109 -msgid "invalid use of 88 level in WHEN expression" -msgstr "invalid use of 88 level in WHEN expression" - -#: cobc/typeck.c:8165 -msgid "wrong number of WHEN parameters" -msgstr "wrong number of WHEN parameters" - -#: cobc/typeck.c:8244 cobc/typeck.c:8256 -#, c-format -msgid "target %d of FREE is not a BASED data item" -msgstr "target %d of FREE is not a BASED data item" - -#: cobc/typeck.c:8262 -#, c-format -msgid "target %d of FREE must be a data pointer" -msgstr "target %d of FREE must be a data pointer" - -#: cobc/typeck.c:8276 -msgid "GO TO without procedure-name" -msgstr "GO TO without procedure-name" - -#: cobc/typeck.c:8286 -msgid "GO TO with multiple procedure-names" -msgstr "GO TO with multiple procedure-names" - -#: cobc/typeck.c:8308 -msgid "GO TO ENTRY with multiple entry-names" -msgstr "GO TO ENTRY with multiple entry-names" - -#: cobc/typeck.c:8367 -msgid "invalid INITIALIZE statement" -msgstr "invalid INITIALIZE statement" - -#: cobc/typeck.c:8443 cobc/typeck.c:8446 -#, c-format -msgid "%s operands differ in size" -msgstr "%s operands differ in size" - -#: cobc/typeck.c:8476 -#, c-format -msgid "unexpected clause %d" -msgstr "unexpected clause %d" - -#: cobc/typeck.c:8545 cobc/typeck.c:8556 cobc/typeck.c:8567 cobc/typeck.c:8578 -#, c-format -msgid "data name expected before %s" -msgstr "data name expected before %s" - -#: cobc/typeck.c:8588 -#, c-format -msgid "ALL, LEADING or TRAILING expected before '%s'" -msgstr "ALL, LEADING or TRAILING expected before ‘%s’" - -#: cobc/typeck.c:8598 -msgid "operand has wrong size" -msgstr "operand has wrong size" - -#: cobc/typeck.c:8669 -#, c-format -msgid "internal register '%s' defined as BINARY-LONG" -msgstr "internal register ‘%s’ defined as BINARY-LONG" - -#: cobc/typeck.c:8672 cobc/typeck.c:8675 cobc/typeck.c:8678 cobc/typeck.c:8681 -#: cobc/typeck.c:8684 cobc/typeck.c:8687 cobc/typeck.c:8690 cobc/typeck.c:8693 -#: cobc/typeck.c:8696 -#, c-format -msgid "'%s' defined here as USAGE %s" -msgstr "‘%s’ defined here as USAGE %s" - -#: cobc/typeck.c:8699 -#, c-format -msgid "'%s' defined here as PIC %s" -msgstr "‘%s’ defined here as PIC %s" - -#: cobc/typeck.c:8702 -#, c-format -msgid "'%s' defined here as a group of length %d" -msgstr "‘%s’ defined here as a group of length %d" - -#: cobc/typeck.c:8741 -#, c-format -msgid "value is %s" -msgstr "value is %s" - -#: cobc/typeck.c:8745 -#, c-format -msgid "value size is %d" -msgstr "value size is %d" - -#: cobc/typeck.c:9022 -msgid "invalid destination for MOVE" -msgstr "invalid destination for MOVE" - -#: cobc/typeck.c:9057 -msgid "MOVE of figurative constant SPACE to numeric item" -msgstr "MOVE of figurative constant SPACE to numeric item" - -#: cobc/typeck.c:9072 -msgid "MOVE of figurative constant QUOTE to numeric item" -msgstr "MOVE of figurative constant QUOTE to numeric item" - -#: cobc/typeck.c:9077 cobc/typeck.c:9089 -msgid "MOVE of figurative constant to numeric item" -msgstr "MOVE of figurative constant to numeric item" - -#: cobc/typeck.c:9151 -msgid "numeric literal in VALUE clause of numeric-edited item" -msgstr "numeric literal in VALUE clause of numeric-edited item" - -#: cobc/typeck.c:9176 -msgid "numeric move to ALPHABETIC" -msgstr "numeric move to ALPHABETIC" - -#: cobc/typeck.c:9188 -msgid "data item not signed" -msgstr "data item not signed" - -#: cobc/typeck.c:9191 -msgid "ignoring sign" -msgstr "ignoring sign" - -#: cobc/typeck.c:9503 -msgid "overlapping MOVE may occur and produce unpredictable results" -msgstr "overlapping MOVE may occur and produce unpredictable results" - -#: cobc/typeck.c:9510 -msgid "overlapping MOVE may produce unpredictable results" -msgstr "overlapping MOVE may produce unpredictable results" - -#: cobc/typeck.c:9643 -msgid "invalid source for MOVE" -msgstr "invalid source for MOVE" - -#: cobc/typeck.c:9666 -msgid "source is non-numeric - substituting zero" -msgstr "source is non-numeric - substituting zero" - -#: cobc/typeck.c:9672 cobc/typeck.c:9683 -msgid "invalid VALUE clause" -msgstr "invalid VALUE clause" - -#: cobc/typeck.c:9675 cobc/typeck.c:11480 cobc/typeck.c:11485 -#: cobc/typeck.c:11512 cobc/typeck.c:11517 -msgid "invalid SET statement" -msgstr "invalid SET statement" - -#: cobc/typeck.c:9677 -msgid "invalid MOVE statement" -msgstr "invalid MOVE statement" - -#: cobc/typeck.c:9684 -msgid "literal exceeds data size" -msgstr "literal exceeds data size" - -#: cobc/typeck.c:9688 -msgid "numeric literal exceeds data size" -msgstr "numeric literal exceeds data size" - -#: cobc/typeck.c:9697 -msgid "MOVE of non-integer to alphanumeric" -msgstr "MOVE of non-integer to alphanumeric" - -#: cobc/typeck.c:9703 -msgid "numeric value is expected" -msgstr "numeric value is expected" - -#: cobc/typeck.c:9708 -msgid "alphanumeric value is expected" -msgstr "alphanumeric value is expected" - -#: cobc/typeck.c:9713 -msgid "value does not fit the picture string" -msgstr "value does not fit the picture string" - -#: cobc/typeck.c:9719 -msgid "value size exceeds data size" -msgstr "value size exceeds data size" - -#: cobc/typeck.c:9724 -msgid "sending field larger than receiving field" -msgstr "sending field larger than receiving field" - -#: cobc/typeck.c:9729 -msgid "some digits may be truncated" -msgstr "some digits may be truncated" - -#: cobc/typeck.c:10515 -#, c-format -msgid "invalid MOVE target: %s" -msgstr "invalid MOVE target: %s" - -#: cobc/typeck.c:10768 -msgid "READ PREVIOUS not allowed for this file type" -msgstr "READ PREVIOUS not allowed for this file type" - -#: cobc/typeck.c:10776 -msgid "KEY ignored with sequential READ" -msgstr "KEY ignored with sequential READ" - -#: cobc/typeck.c:10872 -msgid "figurative constants not allowed in FROM clause" -msgstr "figurative constants not allowed in FROM clause" - -#: cobc/typeck.c:10879 -msgid "literal in FROM clause must be alphanumeric, national or boolean" -msgstr "literal in FROM clause must be alphanumeric, national or boolean" - -#: cobc/typeck.c:10902 cobc/typeck.c:12047 -#, c-format -msgid "%s FILE requires a FROM clause" -msgstr "%s FILE requires a FROM clause" - -#: cobc/typeck.c:10924 cobc/typeck.c:11010 cobc/typeck.c:12069 -#, c-format -msgid "%s subject does not refer to a record name" -msgstr "%s subject does not refer to a record name" - -#: cobc/typeck.c:11016 -msgid "RELEASE not allowed on this record item" -msgstr "RELEASE not allowed on this record item" - -#: cobc/typeck.c:11097 cobc/typeck.c:11118 cobc/typeck.c:11125 -msgid "invalid SEARCH ALL condition" -msgstr "invalid SEARCH ALL condition" - -#: cobc/typeck.c:11237 cobc/typeck.c:11241 -msgid "SET targets must be PROGRAM-POINTER" -msgstr "SET targets must be PROGRAM-POINTER" - -#: cobc/typeck.c:11268 cobc/typeck.c:11335 cobc/typeck.c:11403 -#, c-format -msgid "cannot change address of '%s', which is not level 1 or 77" -msgstr "cannot change address of '%s', which is not level 1 or 77" - -#: cobc/typeck.c:11272 cobc/typeck.c:11339 cobc/typeck.c:11407 -#, c-format -msgid "cannot change address of '%s', which is not BASED or a LINKAGE item" -msgstr "cannot change address of '%s', which is not BASED or a LINKAGE item" - -#: cobc/typeck.c:11291 -#, c-format -msgid "SET target '%s' is not numeric, an INDEX or a POINTER" -msgstr "SET target ‘%s’ is not numeric, an INDEX or a POINTER" - -#: cobc/typeck.c:11360 -#, c-format -msgid "SET target '%s' is not a POINTER for FCD" -msgstr "SET target ‘%s’ is not a POINTER for FCD" - -#: cobc/typeck.c:11428 -#, c-format -msgid "SET target '%s' is not a POINTER for FCD-KEYDEF" -msgstr "SET target ‘%s’ is not a POINTER for FCD-KEYDEF" - -#: cobc/typeck.c:11521 -msgid "field does not have a FALSE clause" -msgstr "field does not have a FALSE clause" - -#: cobc/typeck.c:11552 -msgid "THREAD-priority must be between 1 and 32767" -msgstr "THREAD-priority must be between 1 and 32767" - -#: cobc/typeck.c:11572 -msgid "SET ATTRIBUTE requires a screen item as subject" -msgstr "SET ATTRIBUTE requires a screen item as subject" - -#: cobc/typeck.c:11578 -msgid "SET ATTRIBUTE subject does not refer to a screen item" -msgstr "SET ATTRIBUTE subject does not refer to a screen item" - -#: cobc/typeck.c:11629 -msgid "invalid SORT filename" -msgstr "invalid SORT filename" - -#: cobc/typeck.c:11689 -msgid "invalid SORT USING parameter" -msgstr "invalid SORT USING parameter" - -#: cobc/typeck.c:11718 -msgid "invalid SORT GIVING parameter" -msgstr "invalid SORT GIVING parameter" - -#: cobc/typeck.c:11772 cobc/typeck.c:11799 cobc/typeck.c:11819 -msgid "invalid key item" -msgstr "invalid key item" - -#: cobc/typeck.c:11849 -msgid "LENGTH/SIZE clause only allowed on INDEXED files" -msgstr "LENGTH/SIZE clause only allowed on INDEXED files" - -#: cobc/typeck.c:11854 -msgid "START not allowed with ACCESS MODE RANDOM" -msgstr "START not allowed with ACCESS MODE RANDOM" - -#: cobc/typeck.c:12103 -msgid "LOCK clause invalid here" -msgstr "LOCK clause invalid here" - -#: cobc/typeck.c:12365 -msgid "data item is not part of a report" -msgstr "data item is not part of a report" - -#: cobc/typeck.c:12385 -msgid "improper use of SUPPRESS PRINTING" -msgstr "improper use of SUPPRESS PRINTING" - -#: cobc/typeck.c:12400 -#, c-format -msgid "%s must be alphanumeric or national" -msgstr "%s must be alphanumeric or national" - -#: cobc/typeck.c:12411 -#, c-format -msgid "%s may not be a figurative constant" -msgstr "%s may not be a figurative constant" - -#: cobc/typeck.c:12438 -#, c-format -msgid "%s must be a child of the input record" -msgstr "%s must be a child of the input record" - -#: cobc/typeck.c:12464 -#, c-format -msgid "%s may not be an ignored item in JSON/XML GENERATE" -msgstr "%s may not be an ignored item in JSON/XML GENERATE" - -#: cobc/typeck.c:12475 -#, c-format -msgid "%s must be elementary" -msgstr "%s must be elementary" - -#: cobc/typeck.c:12487 -#, c-format -msgid "%s must be USAGE DISPLAY or NATIONAL" -msgstr "%s must be USAGE DISPLAY or NATIONAL" - -#: cobc/typeck.c:12501 -#, c-format -msgid "%s must be an integer" -msgstr "%s must be an integer" - -#: cobc/typeck.c:12517 cobc/typeck.c:12523 -msgid "JSON/XML GENERATE receiving item" -msgstr "JSON/XML GENERATE receiving item" - -#: cobc/typeck.c:12520 -msgid "JSON/XML GENERATE receiving item may not have JUSTIFIED clause" -msgstr "JSON/XML GENERATE receiving item may not have JUSTIFIED clause" - -#: cobc/typeck.c:12608 -msgid "JSON/XML GENERATE input record may not be reference modified" -msgstr "JSON/XML GENERATE input record may not be reference modified" - -#: cobc/typeck.c:12614 -msgid "JSON/XML GENERATE input record may not have RENAMES clause" -msgstr "JSON/XML GENERATE input record may not have RENAMES clause" - -#: cobc/typeck.c:12619 -#, c-format -msgid "all the children of '%s' are ignored in JSON/XML GENERATE" -msgstr "all the children of ‘%s’ are ignored in JSON/XML GENERATE" - -#: cobc/typeck.c:12626 -msgid "JSON/XML GENERATE input record has subrecords with non-unique names" -msgstr "JSON/XML GENERATE input record has subrecords with non-unique names" - -#: cobc/typeck.c:12631 -msgid "floating-point items in JSON/XML GENERATE" -msgstr "floating-point items in JSON/XML GENERATE" - -#: cobc/typeck.c:12635 -msgid "OCCURS items in JSON/XML GENERATE" -msgstr "OCCURS items in JSON/XML GENERATE" - -#: cobc/typeck.c:12660 -msgid "COUNT IN item must be numeric and an integer" -msgstr "COUNT IN item must be numeric and an integer" - -#: cobc/typeck.c:12665 -msgid "COUNT IN item must be an integer" -msgstr "COUNT IN item must be an integer" - -#: cobc/typeck.c:12668 -msgid "COUNT IN item may not have PICTURE with P in it" -msgstr "COUNT IN item may not have PICTURE with P in it" - -#: cobc/typeck.c:12711 -msgid "NAMESPACE must be a valid URI" -msgstr "NAMESPACE must be a valid URI" - -#: cobc/typeck.c:12755 -msgid "NAMESPACE-PREFIX must be a valid XML name" -msgstr "NAMESPACE-PREFIX must be a valid XML name" - -#: cobc/typeck.c:12780 cobc/typeck.c:12787 -msgid "NAME OF item" -msgstr "NAME OF item" - -#: cobc/typeck.c:12784 -msgid "NAME OF item must be the input record or a child of it" -msgstr "NAME OF item must be the input record or a child of it" - -#: cobc/typeck.c:12791 -msgid "NAME OF name must be a valid XML name" -msgstr "NAME OF name must be a valid XML name" - -#: cobc/typeck.c:12817 cobc/typeck.c:12818 cobc/typeck.c:12821 -#: cobc/typeck.c:12825 -msgid "TYPE OF item" -msgstr "TYPE OF item" - -#: cobc/typeck.c:12843 -msgid "SUPPRESS WHEN SPACE item" -msgstr "SUPPRESS WHEN SPACE item" - -#: cobc/typeck.c:12846 -msgid "SUPPRESS WHEN LOW-VALUE item" -msgstr "SUPPRESS WHEN LOW-VALUE item" - -#: cobc/typeck.c:12848 -msgid "SUPPRESS WHEN HIGH-VALUE item" -msgstr "SUPPRESS WHEN HIGH-VALUE item" - -#: cobc/typeck.c:12877 cobc/typeck.c:12885 cobc/typeck.c:12889 -msgid "SUPPRESS item" -msgstr "SUPPRESS item" - -#: cobc/typeck.c:12881 -msgid "SUPPRESS item with WHEN clause" -msgstr "SUPPRESS item with WHEN clause" - -#: cobc/typeck.c:12958 -msgid "WITH ATTRIBUTES specified, but no attributes can be generated" -msgstr "WITH ATTRIBUTES specified, but no attributes can be generated" - -#: cobc/warning.def:34 -msgid " -Wextra additional warnings only raised with -W or -Wall" -msgstr " -Wextra additional warnings only raised with -W or -Wall" - -#: cobc/warning.def:37 -msgid " -Wno-unfinished do not warn if unfinished features are used" -msgstr " -Wno-unfinished do not warn if unfinished features are used" - -#: cobc/warning.def:40 -msgid " -Wno-pending do not warn if pending features are mentioned" -msgstr " -Wno-pending do not warn if pending features are mentioned" - -#: cobc/warning.def:43 -msgid " -Wobsolete warn if obsolete features are used" -msgstr " -Wobsolete warn if obsolete features are used" - -#: cobc/warning.def:46 -msgid " -Warchaic warn if archaic features are used" -msgstr " -Warchaic warn if archaic features are used" - -#: cobc/warning.def:49 -msgid " -Wredefinition warn about incompatible redefinition of data items" -msgstr " -Wredefinition warn about incompatible redefinition of data items" - -#: cobc/warning.def:52 -msgid " -Wtruncate warn about field truncation from constant assignments" -msgstr " -Wtruncate warn about field truncation from constant assignments" - -#: cobc/warning.def:55 -msgid " -Wpossible-truncate warn about possible field truncation" -msgstr " -Wpossible-truncate warn about possible field truncation" - -#: cobc/warning.def:58 -msgid " -Woverlap warn about overlapping MOVE of items" -msgstr " -Woverlap warn about overlapping MOVE of items" - -#: cobc/warning.def:61 -msgid " -Wpossible-overlap warn about MOVE of items that may overlap depending on variables" -msgstr " -Wpossible-overlap warn about MOVE of items that may overlap depending on variables" - -#: cobc/warning.def:64 -msgid " -Wparentheses warn about lack of parentheses around AND within OR" -msgstr " -Wparentheses warn about lack of parentheses around AND within OR" - -#: cobc/warning.def:67 -msgid " -Wstrict-typing warn strictly about type mismatch" -msgstr " -Wstrict-typing warn strictly about type mismatch" - -#: cobc/warning.def:70 -msgid " -Wimplicit-define warn about implicitly defined data items" -msgstr " -Wimplicit-define warn about implicitly defined data items" - -#: cobc/warning.def:73 -msgid " -Wcorresponding warn about CORRESPONDING with no matching items" -msgstr " -Wcorresponding warn about CORRESPONDING with no matching items" - -#: cobc/warning.def:76 -msgid " -Winitial-value warn if initial VALUE clause is ignored" -msgstr " -Winitial-value warn if initial VALUE clause is ignored" - -#: cobc/warning.def:79 -msgid " -Wprototypes warn about missing FUNCTION prototypes/definitions" -msgstr " -Wprototypes warn about missing FUNCTION prototypes/definitions" - -#: cobc/warning.def:82 -msgid " -Warithmetic-osvs warn if arithmetic expression precision has changed" -msgstr " -Warithmetic-osvs warn if arithmetic expression precision has changed" - -#: cobc/warning.def:85 -msgid " -Wcall-params warn about non 01/77 items for CALL parameters" -msgstr " -Wcall-params warn about non 01/77 items for CALL parameters" - -#: cobc/warning.def:88 -msgid " -Wconstant-expression warn about expressions that always resolve to true/false" -msgstr " -Wconstant-expression warn about expressions that always resolve to true/false" - -#: cobc/warning.def:91 -msgid " -Wcolumn-overflow warn about text after program-text area, FIXED format" -msgstr " -Wcolumn-overflow warn about text after program-text area, FIXED format" - -#: cobc/warning.def:94 -msgid " -Wterminator warn about lack of scope terminator END-XXX" -msgstr " -Wterminator warn about lack of scope terminator END-XXX" - -#: cobc/warning.def:97 -msgid " -Wlinkage warn about dangling LINKAGE items" -msgstr " -Wlinkage warn about dangling LINKAGE items" - -#: cobc/warning.def:100 -msgid " -Wunreachable warn about likely unreachable statements" -msgstr " -Wunreachable warn about likely unreachable statements" - -#: cobc/warning.def:103 -msgid " -Wno-dialect do not warn about dialect specific issues" -msgstr " -Wno-dialect do not warn about dialect specific issues" - -#: cobc/warning.def:106 -msgid " -Wothers do not warn about different issues" -msgstr " -Wothers do not warn about different issues" - -#: cobc/warning.def:109 -msgid " -Wno-unsupported do not warn if runtime does not support a feature used" -msgstr " -Wno-unsupported do not warn if runtime does not support a feature used" - -#: libcob/call.c:87 -#, c-format -msgid "LoadLibrary/GetProcAddress error %d" -msgstr "LoadLibrary/GetProcAddress error %d" - -#: libcob/call.c:939 -msgid "indeterminable error in resolve of COBOL CALL" -msgstr "indeterminable error in resolve of COBOL CALL" - -#: libcob/call.c:1022 -#, c-format -msgid "user-defined FUNCTION '%s' not found" -msgstr "user-defined FUNCTION ‘%s’ not found" - -#: libcob/call.c:1129 libcob/call.c:1208 libcob/call.c:1326 libcob/call.c:1354 -#, c-format -msgid "NULL parameter passed to '%s'" -msgstr "NULL parameter passed to ‘%s’" - -#: libcob/call.c:1204 -#, c-format -msgid "invalid number of arguments passed to '%s'" -msgstr "invalid number of arguments passed to ‘%s’" - -#: libcob/call.c:1330 -msgid "multiple call to 'cob_setjmp'" -msgstr "multiple call to ‘cob_setjmp’" - -#: libcob/call.c:1358 -msgid "call to 'cob_longjmp' with no prior 'cob_setjmp'" -msgstr "call to ‘cob_longjmp’ with no prior ‘cob_setjmp’" - -#: libcob/call.c:1592 libcob/call.c:1633 libcob/call.c:1646 -#: libcob/common.c:7081 -msgid "cob_init() has not been called" -msgstr "cob_init() has not been called" - -#: libcob/call.c:1598 -#, c-format -msgid "parameter %d is not within range of %d" -msgstr "parameter %d is not within range of %d" - -#: libcob/call.c:1604 -#, c-format -msgid "parameter %d is NULL" -msgstr "parameter %d is NULL" - -#: libcob/call.c:1859 libcob/call.c:1916 -#, c-format -msgid "attempt to over-write constant parameter %d with " -msgstr "attempt to over-write constant parameter %d with " - -#: libcob/call.c:1965 -#, c-format -msgid "attempt to over-write constant parameter %d with '%s'" -msgstr "attempt to over-write constant parameter %d with ‘%s’" - -#: libcob/cobgetopt.c:497 -#, c-format -msgid "%s: option '%s' is ambiguous; possibilities:" -msgstr "%s: option ‘%s’ is ambiguous; possibilities:" - -#: libcob/cobgetopt.c:538 -#, c-format -msgid "%s: option '--%s' doesn't allow an argument" -msgstr "%s: option ‘--%s’ doesn't allow an argument" - -#: libcob/cobgetopt.c:545 -#, c-format -msgid "%s: option '%c%s' doesn't allow an argument" -msgstr "%s: option ‘%c%s’ doesn't allow an argument" - -#: libcob/cobgetopt.c:565 -#, c-format -msgid "%s: option '--%s' requires an argument" -msgstr "%s: option ‘--%s’ requires an argument" - -#: libcob/cobgetopt.c:597 -#, c-format -msgid "%s: unrecognized option '--%s'" -msgstr "%s: unrecognized option ‘--%s’" - -#: libcob/cobgetopt.c:604 -#, c-format -msgid "%s: unrecognized option '%c%s'" -msgstr "%s: unrecognized option ‘%c%s’" - -#: libcob/cobgetopt.c:633 -#, c-format -msgid "%s: invalid option -- %c" -msgstr "%s: invalid option -- %c" - -#: libcob/cobgetopt.c:664 libcob/cobgetopt.c:805 -#, c-format -msgid "%s: option requires an argument -- %c" -msgstr "%s: option requires an argument -- %c" - -#: libcob/cobgetopt.c:714 -#, c-format -msgid "%s: option '-W %s' is ambiguous" -msgstr "%s: option ‘-W %s’ is ambiguous" - -#: libcob/cobgetopt.c:736 -#, c-format -msgid "%s: option '-W %s' doesn't allow an argument" -msgstr "%s: option ‘-W %s’ doesn't allow an argument" - -#: libcob/cobgetopt.c:754 -#, c-format -msgid "%s: option '%s' requires an argument" -msgstr "%s: option ‘%s’ requires an argument" - -#: libcob/common.c:793 -#, c-format -msgid "attempt to reference unallocated memory" -msgstr "attempt to reference unallocated memory" - -#: libcob/common.c:798 -#, c-format -msgid "bus error" -msgstr "bus error" - -#: libcob/common.c:803 -#, c-format -msgid "fatal arithmetic error" -msgstr "fatal arithmetic error" - -#: libcob/common.c:807 -#, c-format -msgid "caught signal" -msgstr "caught signal" - -#: libcob/common.c:811 -#, c-format -msgid "signal %s" -msgstr "signal %s" - -#: libcob/common.c:817 -#, c-format -msgid "abnormal termination - file contents may be incorrect" -msgstr "abnormal termination - file contents may be incorrect" - -#: libcob/common.c:2049 -msgid "NULL field" -msgstr "NULL field" - -#: libcob/common.c:2059 -msgid "field with NULL address" -msgstr "field with NULL address" - -#: libcob/common.c:2345 -msgid "version mismatch" -msgstr "version mismatch" - -#: libcob/common.c:2346 libcob/common.c:2348 -#, c-format -msgid "%s has version %s.%d" -msgstr "%s has version %s.%d" - -#: libcob/common.c:2358 -#, c-format -msgid "CALL to %s requires %d arguments" -msgstr "CALL to %s requires %d arguments" - -#: libcob/common.c:2980 -#, c-format -msgid "BASED/LINKAGE item %s has NULL address" -msgstr "BASED/LINKAGE item %s has NULL address" - -#: libcob/common.c:2992 libcob/common.c:2995 -#, c-format -msgid "LINKAGE item %s not passed by caller" -msgstr "LINKAGE item %s not passed by caller" - -#: libcob/common.c:3081 -#, c-format -msgid "'%s' (Type: %s) not numeric: '%s'" -msgstr "‘%s’ (Type: %s) not numeric: ‘%s’" - -#: libcob/common.c:3096 -#, c-format -msgid "OCCURS DEPENDING ON '%s' out of bounds: %d" -msgstr "OCCURS DEPENDING ON ‘%s’ out of bounds: %d" - -#: libcob/common.c:3099 libcob/common.c:3120 -#, c-format -msgid "maximum subscript for '%s': %d" -msgstr "maximum subscript for '%s': %d" - -#: libcob/common.c:3101 -#, c-format -msgid "minimum subscript for '%s': %d" -msgstr "minimum subscript for '%s': %d" - -#: libcob/common.c:3117 -#, c-format -msgid "current maximum subscript for '%s': %d" -msgstr "current maximum subscript for '%s': %d" - -#: libcob/common.c:3139 -#, c-format -msgid "offset of '%s' out of bounds: %d, maximum: %d" -msgstr "offset of ‘%s’ out of bounds: %d, maximum: %d" - -#: libcob/common.c:3152 -#, c-format -msgid "length of '%s' out of bounds: %d, maximum: %d" -msgstr "length of ‘%s’ out of bounds: %d, maximum: %d" - -#: libcob/common.c:3161 -#, c-format -msgid "length of '%s' out of bounds: %d, starting at: %d, maximum: %d" -msgstr "length of ‘%s’ out of bounds: %d, starting at: %d, maximum: %d" - -#: libcob/common.c:3176 libcob/common.c:3181 -#, c-format -msgid "EXTERNAL item '%s' previously allocated with size %d, requested size is %d" -msgstr "EXTERNAL item ‘%s’ previously allocated with size %d, requested size is %d" - -#: libcob/common.c:3682 -#, c-format -msgid "COB_CURRENT_DATE '%s' is invalid" -msgstr "COB_CURRENT_DATE ‘%s’ is invalid" - -#: libcob/common.c:4585 -#, c-format -msgid "parameter to SYSTEM call is larger than %d characters" -msgstr "parameter to SYSTEM call is larger than %d characters" - -#: libcob/common.c:5195 -#, c-format -msgid "error '%s' during CBL_GC_FORK" -msgstr "error ‘%s’ during CBL_GC_FORK" - -#: libcob/common.c:5200 libcob/common.c:5297 -#, c-format -msgid "'%s' is not supported on this platform" -msgstr "‘%s’ is not supported on this platform" - -#: libcob/common.c:5226 -#, c-format -msgid "error '%s' for P%d during CBL_GC_WAITPID" -msgstr "error ‘%s’ for P%d during CBL_GC_WAITPID" - -#: libcob/common.c:5418 -msgid "Call to CBL_GC_GETOPT with wrong longoption size." -msgstr "Call to CBL_GC_GETOPT with wrong longoption size." - -#: libcob/common.c:5423 -msgid "Call to CBL_GC_GETOPT with missing longind." -msgstr "Call to CBL_GC_GETOPT with missing longind." - -#: libcob/common.c:5837 libcob/common.c:5858 libcob/common.c:5871 -#: libcob/common.c:7785 -#, c-format -msgid "(default)" -msgstr "(default)" - -#: libcob/common.c:6119 libcob/common.c:6138 -msgid "should be unsigned" -msgstr "should be unsigned" - -#: libcob/common.c:6127 libcob/common.c:6176 -msgid "should be numeric" -msgstr "should be numeric" - -#: libcob/common.c:6185 -#, c-format -msgid "minimum value: %lu" -msgstr "minimum value: %lu" - -#: libcob/common.c:6236 libcob/common.c:6787 libcob/common.c:6801 -#, c-format -msgid "should not contain '%c'" -msgstr "should not contain ‘%c’" - -#: libcob/common.c:6316 libcob/common.c:6384 libcob/common.c:6393 -#: libcob/common.c:6401 -#, c-format -msgid "not set" -msgstr "not set" - -#: libcob/common.c:6376 libcob/common.c:6379 libcob/common.c:6382 -#, c-format -msgid "set by %s" -msgstr "set by %s" - -#: libcob/common.c:6516 -#, c-format -msgid "WARNING - '%s' without a value - ignored!" -msgstr "WARNING - ‘%s’ without a value - ignored!" - -#: libcob/common.c:6519 -#, c-format -msgid "'%s' without a value!" -msgstr "‘%s’ without a value!" - -#: libcob/common.c:6545 -#, c-format -msgid "WARNING - '%s %s' without a value - ignored!" -msgstr "WARNING - ‘%s %s’ without a value - ignored!" - -#: libcob/common.c:7034 -msgid "error" -msgstr "error" - -#: libcob/common.c:7064 -msgid "attempt to CANCEL active program" -msgstr "attempt to CANCEL active program" - -#: libcob/common.c:7091 -msgid "CALL of program with CHAINING clause" -msgstr "CALL of program with CHAINING clause" - -#: libcob/common.c:7095 -msgid "stack overflow, possible PERFORM depth exceeded" -msgstr "stack overflow, possible PERFORM depth exceeded" - -#: libcob/common.c:7100 -msgid "invalid entry/exit in GLOBAL USE procedure" -msgstr "invalid entry/exit in GLOBAL USE procedure" - -#: libcob/common.c:7105 -msgid "unable to allocate memory" -msgstr "unable to allocate memory" - -#: libcob/common.c:7110 -msgid "invalid entry into module" -msgstr "invalid entry into module" - -#: libcob/common.c:7115 -#, c-format -msgid "recursive CALL from %s to %s which is NOT RECURSIVE" -msgstr "recursive CALL from %s to %s which is NOT RECURSIVE" - -#: libcob/common.c:7125 -msgid "divide by ZERO" -msgstr "divide by ZERO" - -#: libcob/common.c:7132 -msgid "end of file" -msgstr "end of file" - -#: libcob/common.c:7135 -msgid "key out of range" -msgstr "key out of range" - -#: libcob/common.c:7138 -msgid "key order not ascending" -msgstr "key order not ascending" - -#: libcob/common.c:7141 -msgid "record key already exists" -msgstr "record key already exists" - -#: libcob/common.c:7144 -msgid "record key does not exist" -msgstr "record key does not exist" - -#: libcob/common.c:7147 -msgid "permanent file error" -msgstr "permanent file error" - -#: libcob/common.c:7150 -msgid "inconsistant file name" -msgstr "inconsistant file name" - -#: libcob/common.c:7153 -msgid "file does not exist" -msgstr "file does not exist" - -#: libcob/common.c:7156 -msgid "permission denied" -msgstr "permission denied" - -#: libcob/common.c:7159 -msgid "file already open" -msgstr "file already open" - -#: libcob/common.c:7162 -msgid "file not open" -msgstr "file not open" - -#: libcob/common.c:7165 -msgid "READ must be executed first" -msgstr "READ must be executed first" - -#: libcob/common.c:7168 -msgid "record overflow" -msgstr "record overflow" - -#: libcob/common.c:7171 -msgid "READ after unsuccessful READ/START" -msgstr "READ after unsuccessful READ/START" - -#: libcob/common.c:7174 -msgid "READ/START not allowed, file not open for input" -msgstr "READ/START not allowed, file not open for input" - -#: libcob/common.c:7177 -msgid "WRITE not allowed, file not open for output" -msgstr "WRITE not allowed, file not open for output" - -#: libcob/common.c:7180 -msgid "DELETE/REWRITE not allowed, file not open for I-O" -msgstr "DELETE/REWRITE not allowed, file not open for I-O" - -#: libcob/common.c:7183 -msgid "record locked by another file connector" -msgstr "record locked by another file connector" - -#: libcob/common.c:7186 -msgid "LINAGE values invalid" -msgstr "LINAGE values invalid" - -#: libcob/common.c:7189 -msgid "file sharing conflict" -msgstr "file sharing conflict" - -#: libcob/common.c:7193 -msgid "runtime library is not configured for this operation" -msgstr "runtime library is not configured for this operation" - -#: libcob/common.c:7198 -msgid "unknown file error" -msgstr "unknown file error" - -#: libcob/common.c:7205 -#, c-format -msgid "%s (status = %02d) for file %s" -msgstr "%s (status = %02d) for file %s" - -#: libcob/common.c:7208 -#, c-format -msgid "%s (status = %02d) for file %s on %s" -msgstr "%s (status = %02d) for file %s on %s" - -#: libcob/common.c:7215 -msgid "attempt to use non-implemented function" -msgstr "attempt to use non-implemented function" - -#: libcob/common.c:7218 -msgid "attempt to use non-implemented XML I/O" -msgstr "attempt to use non-implemented XML I/O" - -#: libcob/common.c:7221 -msgid "attempt to use non-implemented JSON I/O" -msgstr "attempt to use non-implemented JSON I/O" - -#: libcob/common.c:7268 -msgid "environment variables" -msgstr "environment variables" - -#: libcob/common.c:7315 -msgid "License LGPLv3+: GNU LGPL version 3 or later " -msgstr "License LGPLv3+: GNU LGPL version 3 or later " - -#: libcob/common.c:7372 libcob/common.c:7374 -msgid "dynamic loading" -msgstr "dynamic loading" - -#: libcob/common.c:7379 -msgid "enabled" -msgstr "enabled" - -#: libcob/common.c:7460 libcob/common.c:7577 libcob/common.c:7586 -#: libcob/common.c:7603 libcob/common.c:7618 -#, c-format -msgid "%s, version %d.%d.%d" -msgstr "%s, version %d.%d.%d" - -#: libcob/common.c:7462 libcob/common.c:7579 libcob/common.c:7588 -#: libcob/common.c:7620 -#, c-format -msgid "%s, version %d.%d.%d (compiled with %d.%d)" -msgstr "%s, version %d.%d.%d (compiled with %d.%d)" - -#: libcob/common.c:7465 -#, c-format -msgid "%s, version %s" -msgstr "%s, version %s" - -#: libcob/common.c:7486 libcob/common.c:7488 libcob/common.c:7493 -#: libcob/common.c:7495 libcob/common.c:7498 -msgid "mouse support" -msgstr "mouse support" - -#: libcob/common.c:7636 -msgid "CALL configuration" -msgstr "CALL configuration" - -#: libcob/common.c:7637 -msgid "File I/O configuration" -msgstr "File I/O configuration" - -#: libcob/common.c:7638 -msgid "Screen I/O configuration" -msgstr "Screen I/O configuration" - -#: libcob/common.c:7639 -msgid "Miscellaneous" -msgstr "Miscellaneous" - -#: libcob/common.c:7640 -msgid "System configuration" -msgstr "System configuration" - -#: libcob/common.c:7644 -msgid "runtime configuration" -msgstr "runtime configuration" - -#: libcob/common.c:7646 -msgid "via" -msgstr "via" - -#: libcob/common.c:7719 libcob/common.c:7747 -msgid "... removed from environment" -msgstr "... removed from environment" - -#: libcob/common.c:7773 libcob/common.c:7775 -#, c-format -msgid "(set by %s)" -msgstr "(set by %s)" - -#: libcob/common.c:7783 -#, c-format -msgid "(reset)" -msgstr "(reset)" - -#: libcob/common.c:8167 libcob/common.c:8286 -#, c-format -msgid "%s called with unknown option: %d" -msgstr "%s called with unknown option: %d" - -#: libcob/common.c:8239 -#, c-format -msgid "Module dump due to %s\n" -msgstr "Module dump due to %s\n" - -#: libcob/common.c:8243 -#, c-format -msgid " Last statement of %s was Line %d of %s\n" -msgstr " Last statement of %s was Line %d of %s\n" - -#: libcob/common.c:8249 -#, c-format -msgid " Last statement of %s unknown\n" -msgstr " Last statement of %s unknown\n" - -#: libcob/common.c:8259 -#, c-format -msgid "Dump Program-Id %s from %s compiled %s\n" -msgstr "Dump Program-Id %s from %s compiled %s\n" - -#: libcob/fileio.c:287 -#, c-format -msgid "ERROR I/O routine %s is not present" -msgstr "ERROR I/O routine %s is not present" - -#: libcob/fileio.c:1365 -#, c-format -msgid "I/O routine %s is not present for %s" -msgstr "I/O routine %s is not present for %s" - -#: libcob/fileio.c:1404 -#, c-format -msgid "I/O routine %s is not known for %s" -msgstr "I/O routine %s is not known for %s" - -#: libcob/fileio.c:2599 -#, c-format -msgid "ERROR FILE %s has record size %d exceeds %d in program" -msgstr "ERROR FILE %s has record size %d exceeds %d in program" - -#: libcob/fileio.c:2967 libcob/fileio.c:2974 -#, c-format -msgid "ERROR FILE %s opening pipe" -msgstr "ERROR FILE %s opening pipe" - -#: libcob/fileio.c:4979 -#, c-format -msgid "ERROR FILE %s does not match current version; Recompile the program" -msgstr "ERROR FILE %s does not match current version; Recompile the program" - -#: libcob/fileio.c:5034 -#, c-format -msgid "ERROR FILE %s has ASSIGN field is NULL" -msgstr "ERROR FILE %s has ASSIGN field is NULL" - -#: libcob/fileio.c:5707 -#, c-format -msgid "call to CBL_OPEN_FILE with wrong access mode: %d" -msgstr "call to CBL_OPEN_FILE with wrong access mode: %d" - -#: libcob/fileio.c:5756 -#, c-format -msgid "call to CBL_CREATE_FILE with wrong file_lock: %d" -msgstr "call to CBL_CREATE_FILE with wrong file_lock: %d" - -#: libcob/fileio.c:5759 -#, c-format -msgid "call to CBL_CREATE_FILE with wrong file_dev: %d" -msgstr "call to CBL_CREATE_FILE with wrong file_dev: %d" - -#: libcob/fileio.c:5955 libcob/fileio.c:6215 -#, c-format -msgid "'%s' - File detail area is too short" -msgstr "‘%s’ - File detail area is too short" - -#: libcob/fileio.c:6437 -msgid "SORT is unable to acquire temporary file" -msgstr "SORT is unable to acquire temporary file" - -#: libcob/fileio.c:7057 -#, c-format -msgid "implicit CLOSE of %s" -msgstr "implicit CLOSE of %s" - -#: libcob/fileio.c:7165 -#, c-format -msgid "C-ISAM library %s is not present" -msgstr "C-ISAM library %s is not present" - -#: libcob/fileio.c:7173 -#, c-format -msgid "D-ISAM library %s is not present" -msgstr "D-ISAM library %s is not present" - -#: libcob/fileio.c:7181 -#, c-format -msgid "VB-ISAM library %s is not present" -msgstr "VB-ISAM library %s is not present" - -#: libcob/screenio.c:429 -msgid "failed to initialize curses" -msgstr "failed to initialize curses" - -#: libcob/screenio.c:3591 -msgid "end of program, please press a key to exit" -msgstr "end of program, please press a key to exit" - -#: libcob/termio.c:70 libcob/termio.c:106 -msgid "(Not representable)" -msgstr "(Not representable)" - -#: libcob/termio.c:347 -#, c-format -msgid "cannot open %s (=%s)" -msgstr "cannot open %s (=%s)" - -#: libcob/termio.c:362 -msgid "COB_DISPLAY_PUNCH_FILE is invalid, output to SYSPUNCH skipped" -msgstr "COB_DISPLAY_PUNCH_FILE is invalid, output to SYSPUNCH skipped" - -#: bin/cobcrun.c:122 -msgid "GnuCOBOL module loader" -msgstr "GnuCOBOL module loader" - -#: bin/cobcrun.c:124 -#, c-format -msgid "Usage: %s [options] PROGRAM [parameter ...]" -msgstr "Usage: %s [options] PROGRAM [parameter ...]" - -#: bin/cobcrun.c:126 -#, c-format -msgid " or: %s options" -msgstr " or: %s options" - -#: bin/cobcrun.c:129 -msgid "Options:" -msgstr "Options:" - -#: bin/cobcrun.c:130 -msgid " -h, -help display this help and exit" -msgstr " -h, -help display this help and exit" - -#: bin/cobcrun.c:131 -msgid " -V, -version display cobcrun and runtime version and exit" -msgstr " -V, -version display cobcrun and runtime version and exit" - -#: bin/cobcrun.c:132 -msgid " -i, -info display runtime information (build/environment)" -msgstr " -i, -info display runtime information (build/environment)" - -#: bin/cobcrun.c:134 -msgid " -q, -brief reduced displays" -msgstr " -q, -brief reduced displays" - -#: bin/cobcrun.c:136 -msgid " -c , -config= set runtime configuration from " -msgstr " -c , -config= set runtime configuration from " - -#: bin/cobcrun.c:137 -msgid "" -" -r, -runtime-config display current runtime configuration\n" -" (value and origin for all settings)" -msgstr "" -" -r, -runtime-config display current runtime configuration\n" -" (value and origin for all settings)" - -#: bin/cobcrun.c:139 -msgid "" -" -M , -module= set entry point module name and/or load path\n" -" where -M module prepends any directory to the\n" -" dynamic link loader library search path\n" -" and any basename to the module preload list\n" -" (COB_LIBRARY_PATH and/or COB_PRELOAD)" -msgstr "" -" -M , -module= set entry point module name and/or load path\n" -" where -M module prepends any directory to the\n" -" dynamic link loader library search path\n" -" and any basename to the module preload list\n" -" (COB_LIBRARY_PATH and/or COB_PRELOAD)" - -#: bin/cobcrun.c:145 -#, c-format -msgid "" -"Report bugs to: %s\n" -"or (preferably) use the issue tracker via the home page." -msgstr "" -"Report bugs to: %s\n" -"or (preferably) use the issue tracker via the home page." - -#: bin/cobcrun.c:148 -msgid "GnuCOBOL home page: " -msgstr "GnuCOBOL home page: " - -#: bin/cobcrun.c:149 -msgid "General help using GNU software: " -msgstr "General help using GNU software: " - -#: bin/cobcrun.c:274 -msgid "invalid configuration file name" -msgstr "invalid configuration file name" - -#: bin/cobcrun.c:325 -#, c-format -msgid "invalid module argument '%s'" -msgstr "invalid module argument ‘%s’" - -#: bin/cobcrun.c:377 -#, c-format -msgid "%s: missing PROGRAM name" -msgstr "%s: missing PROGRAM name" - -#: bin/cobcrun.c:379 -#, c-format -msgid "Try '%s --help' for more information." -msgstr "Try ‘%s --help’ for more information." - -#: bin/cobcrun.c:387 -#, c-format -msgid "%s: PROGRAM name exceeds %d characters" -msgstr "%s: PROGRAM name exceeds %d characters" Binary files /tmp/tmp8r0303vl/MzBWgGBJBM/gnucobol-4.0~early~20200606/po/es.gmo and /tmp/tmp8r0303vl/cieYbammgl/gnucobol-5/po/es.gmo differ diff -Nru gnucobol-4.0~early~20200606/po/es.po gnucobol-5/po/es.po --- gnucobol-4.0~early~20200606/po/es.po 2020-06-06 20:53:00.000000000 +0000 +++ gnucobol-5/po/es.po 1970-01-01 00:00:00.000000000 +0000 @@ -1,6174 +0,0 @@ -# Spanish translations for GnuCOBOL package. -# Copyright (C) 2017 Free Software Foundation, Inc. -# This file is distributed under the same license as the GnuCOBOL package. -# Francisco Javier Serrador , 2018. -# Randy Coman , 2011, 2014. -msgid "" -msgstr "" -"Project-Id-Version: gnucobol 2.2-rc1\n" -"Report-Msgid-Bugs-To: gnucobol-messages@gnu.org\n" -"POT-Creation-Date: 2020-06-06 20:52+0000\n" -"PO-Revision-Date: 2018-03-20 08:41+0200\n" -"Last-Translator: Francisco Javier Serrador \n" -"Language-Team: Spanish \n" -"Language: es\n" -"MIME-Version: 1.0\n" -"Content-Type: text/plain; charset=UTF-8\n" -"Content-Transfer-Encoding: 8bit\n" -"X-Bugs: Report translation errors to the Language-Team address.\n" -"Plural-Forms: nplurals=2; plural=(n != 1);\n" -"X-Generator: Virtaal 0.7.1\n" - -#: cobc/cobc.c:117 -#, c-format -msgid "invalid parameter: %s" -msgstr "parámetro no válido: %s" - -#: cobc/cobc.c:826 -msgid "too many errors" -msgstr "demasiados errores" - -#: cobc/cobc.c:838 -#, fuzzy -msgid "internal compiler error" -msgstr "%s:%d: error interno de compilador" - -#: cobc/cobc.c:904 cobc/cobc.c:991 cobc/cobc.c:1051 cobc/cobc.c:1127 -#: cobc/cobc.c:1167 cobc/cobc.c:1243 -#, c-format -msgid "cannot allocate %d bytes of memory" -msgstr "no puede asignar %d bytes de memoria" - -#: cobc/cobc.c:917 cobc/cobc.c:933 cobc/cobc.c:953 cobc/cobc.c:1011 -#: cobc/cobc.c:1029 cobc/cobc.c:1147 cobc/cobc.c:1262 cobc/cobc.c:1279 -#: cobc/field.c:2008 libcob/common.c:7121 -#, c-format -msgid "call to %s with NULL pointer" -msgstr "llama a %s con puntero NULL" - -#: cobc/cobc.c:974 -#, c-format -msgid "cannot reallocate %d bytes of memory" -msgstr "no puede reasignar %d bytes de memoria" - -#: cobc/cobc.c:1068 cobc/cobc.c:1184 -msgid "attempt to reallocate non-allocated memory" -msgstr "trata reasignar memoria no asignada" - -#: cobc/cobc.c:1101 cobc/cobc.c:1217 -#, c-format -msgid "call to %s with invalid pointer, as it is missing in list" -msgstr "llamada a %s con puntero inválido, como es ausente en lista" - -#: cobc/cobc.c:1390 -#, c-format -msgid "assuming literal for unquoted '%s'" -msgstr "asumiendo literal para no entrecomillado «%s»" - -#: cobc/cobc.c:1437 -#, fuzzy -msgid " - length exceeds maximum" -msgstr "longitud literal %d excede máximo de %d dígitos" - -#: cobc/cobc.c:1441 -msgid " - name cannot be empty" -msgstr "" - -#: cobc/cobc.c:1444 -msgid " - name cannot begin with space or underscore" -msgstr " - nombre no puede comenzar con espacio o guión bajo" - -#: cobc/cobc.c:1447 -msgid " - name cannot begin with 'cob_' or 'COB_'" -msgstr " - nombre no puede comenzar con 'cob_' o 'COB_'" - -#: cobc/cobc.c:1450 -msgid " - name duplicates a 'C' keyword" -msgstr " - nombre duplica una palabra 'C' clave" - -#: cobc/cobc.c:1453 -msgid " - name cannot contain a directory separator" -msgstr " - nombre no puede contener un separador de directorio" - -#: cobc/cobc.c:1462 -#, c-format -msgid "invalid file base name '%s'%s" -msgstr "nombre de base de fichero no válido '%s'%s" - -#: cobc/cobc.c:1466 -#, c-format -msgid "invalid ENTRY '%s'%s" -msgstr "invalida ENTRY '%s'%s" - -#: cobc/cobc.c:1469 -#, c-format -msgid "invalid PROGRAM-ID '%s'%s" -msgstr "invalida PROGRAM_ID '%s'%s" - -#: cobc/cobc.c:1596 cobc/cobc.c:8151 -#, fuzzy -msgid "please check environment variables as noted above" -msgstr "variables de entorno" - -#: cobc/cobc.c:1608 cobc/error.c:254 cobc/error.c:274 cobc/error.c:505 -#: cobc/error.c:528 -msgid "error: " -msgstr "error: " - -#: cobc/cobc.c:1631 -#, c-format -msgid "duplicate DEFINE '%s' - ignored" -msgstr "duplica DEFINE «%s» - ignorado" - -#: cobc/cobc.c:1683 -#, c-format -msgid "environment variable '%s' is '%s'; should not contain '%c'" -msgstr "variable de entorno «%s» es «%s»; debería no contener «%c»" - -#: cobc/cobc.c:1712 -msgid "parameter buffer size exceeded" -msgstr "tamaño de búfer paramétrico excedido" - -#: cobc/cobc.c:1752 -#, c-format -msgid "warning: could not move temporary file to %s" -msgstr "advertencia: no pudo mover fichero temporal a %s" - -#: cobc/cobc.c:1957 cobc/cobc.c:1960 cobc/parser.y:803 cobc/reserved.c:3807 -#: libcob/common.c:761 libcob/common.c:1805 libcob/common.c:2002 -#: libcob/common.c:6325 libcob/common.c:7495 libcob/common.c:8025 -#: libcob/common.c:8104 -msgid "unknown" -msgstr "desconocido" - -#: cobc/cobc.c:1963 -#, c-format -msgid "aborting codegen for %s (%s: %s)" -msgstr "se aborta generador de código codegen para %s (%s: %s)" - -#: cobc/cobc.c:1966 -#, c-format -msgid "aborting compile of %s at line %d (%s: %s)" -msgstr "abortando compilación de %s en línea %d (%s: %s)" - -#: cobc/cobc.c:1970 -msgid "aborting" -msgstr "abortando" - -#: cobc/cobc.c:1993 cobc/cobc.c:2028 libcob/common.c:7086 bin/cobcrun.c:342 -msgid "Please report this!" -msgstr "¡Por favor boletine esto!" - -#: cobc/cobc.c:2046 bin/cobcrun.c:106 -#, fuzzy -msgid "License GPLv3+: GNU GPL version 3 or later " -msgstr "License GPLv3+: GNU GPL versión 3 o posterior " - -#: cobc/cobc.c:2047 libcob/common.c:7316 bin/cobcrun.c:107 -msgid "" -"This is free software; see the source for copying conditions. There is NO\n" -"warranty; not even for MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE." -msgstr "" -"Esto es software libre; vea la fuente para condiciones de copia. NO hay ninguna\n" -" garantía; ni siquiera para COMERCIALIZACIÓN o UTILIZACIÓN PARA UN PROPÓSITO PARTICULAR." - -#: cobc/cobc.c:2049 libcob/common.c:7318 bin/cobcrun.c:109 -#, c-format -msgid "Written by %s\n" -msgstr "Escrito por %s\n" - -#. TRANSLATORS: This msgid is indented as the "Packaged" msgid, %s expands to date and time -#: cobc/cobc.c:2050 cobc/cobc.c:2063 libcob/common.c:7321 bin/cobcrun.c:110 -#, c-format -msgid "Built %s" -msgstr "Compilado %s" - -#. TRANSLATORS: This msgid is indented as the "Built" msgid, %s expands to date and time -#: cobc/cobc.c:2052 cobc/cobc.c:2065 libcob/common.c:7324 bin/cobcrun.c:112 -#, c-format -msgid "Packaged %s" -msgstr "Empaquetado %s" - -#: cobc/cobc.c:2054 cobc/cobc.c:2067 -#, c-format -msgid "C version %s%s" -msgstr "Versión C %s%s" - -#: cobc/cobc.c:2080 -msgid "executing:" -msgstr "ejecutando:" - -#: cobc/cobc.c:2082 -msgid "to be executed:" -msgstr "para ser ejecutada:" - -#: cobc/cobc.c:2120 cobc/cobc.c:2121 libcob/common.c:5815 libcob/common.c:5816 -#: libcob/common.c:5847 libcob/common.c:5848 -msgid "env" -msgstr "env" - -#: cobc/cobc.c:2156 libcob/common.c:7351 -msgid "build information" -msgstr "información de compilación" - -#: cobc/cobc.c:2157 libcob/common.c:7352 -msgid "build environment" -msgstr "ambiente de compilación" - -#: cobc/cobc.c:2167 libcob/common.c:7363 -msgid "GnuCOBOL information" -msgstr "Información de GnuCOBOL" - -#: cobc/cobc.c:2212 libcob/common.c:6366 libcob/common.c:7386 -#: libcob/common.c:7486 libcob/common.c:7493 -msgid "yes" -msgstr "sí" - -#: cobc/cobc.c:2214 libcob/common.c:6368 libcob/common.c:7388 -#: libcob/common.c:7488 -msgid "no" -msgstr "no" - -#: cobc/cobc.c:2218 libcob/common.c:7392 -msgid "8 bytes" -msgstr "8 bytes" - -#: cobc/cobc.c:2220 libcob/common.c:7394 -msgid "4 bytes" -msgstr "4 bytes" - -#: cobc/cobc.c:2224 cobc/cobc.c:2226 libcob/common.c:7398 libcob/common.c:7400 -msgid "endianness" -msgstr "" - -#: cobc/cobc.c:2224 libcob/common.c:7398 -msgid "big-endian" -msgstr "" - -#: cobc/cobc.c:2226 libcob/common.c:7400 -msgid "little-endian" -msgstr "" - -#: cobc/cobc.c:2230 cobc/cobc.c:2232 libcob/common.c:7404 libcob/common.c:7406 -#, fuzzy -msgid "native character set" -msgstr "continuación de carácter esperado" - -#: cobc/cobc.c:2230 libcob/common.c:7404 -msgid "EBCDIC" -msgstr "" - -#: cobc/cobc.c:2232 libcob/common.c:7406 -msgid "ASCII" -msgstr "" - -#: cobc/cobc.c:2235 libcob/common.c:7410 libcob/common.c:7476 -msgid "extended screen I/O" -msgstr "extensión de E/S de pantalla" - -#: cobc/cobc.c:2238 libcob/common.c:7502 -#, fuzzy -msgid "variable file format" -msgstr "formato variable" - -#: cobc/cobc.c:2244 cobc/cobc.c:2246 libcob/common.c:7508 libcob/common.c:7510 -#, fuzzy -msgid "sequential file handler" -msgstr "manipulador secuencial" - -#: cobc/cobc.c:2246 libcob/common.c:7510 -msgid "built-in" -msgstr "compilado" - -#: cobc/cobc.c:2254 cobc/cobc.c:2260 cobc/cobc.c:2262 cobc/cobc.c:2269 -#: cobc/cobc.c:2271 cobc/cobc.c:2275 cobc/cobc.c:2278 cobc/cobc.c:2282 -#: cobc/cobc.c:2284 cobc/cobc.c:2289 cobc/cobc.c:2291 cobc/cobc.c:2298 -#: cobc/cobc.c:2300 cobc/cobc.c:2307 libcob/common.c:7516 libcob/common.c:7527 -#: libcob/common.c:7533 libcob/common.c:7535 libcob/common.c:7539 -#: libcob/common.c:7542 libcob/common.c:7546 libcob/common.c:7548 -#: libcob/common.c:7553 libcob/common.c:7555 libcob/common.c:7562 -#: libcob/common.c:7564 libcob/common.c:7571 -#, fuzzy -msgid "indexed file handler" -msgstr "manipulador secuencial" - -#: cobc/cobc.c:2304 libcob/common.c:7568 -msgid "default indexed handler" -msgstr "" - -#: cobc/cobc.c:2307 cobc/cobc.c:2319 cobc/cobc.c:2325 libcob/common.c:7381 -#: libcob/common.c:7498 libcob/common.c:7571 libcob/common.c:7611 -#: libcob/common.c:7625 -msgid "disabled" -msgstr "desactivado" - -#: cobc/cobc.c:2311 cobc/cobc.c:2313 libcob/common.c:7594 libcob/common.c:7596 -msgid "mathematical library" -msgstr "biblioteca matemática" - -#: cobc/cobc.c:2317 cobc/cobc.c:2319 libcob/common.c:7605 libcob/common.c:7611 -msgid "XML library" -msgstr "" - -#: cobc/cobc.c:2323 cobc/cobc.c:2325 libcob/common.c:7623 libcob/common.c:7625 -msgid "JSON library" -msgstr "" - -#: cobc/cobc.c:2332 -msgid "only one of options 'E', 'S', 'C', 'c' may be specified" -msgstr "solo una de las opciones 'E', 'S', 'C', 'c' quizá está especificada" - -#: cobc/cobc.c:2338 -msgid "only one of options 'm', 'x', 'b' may be specified" -msgstr "solo una de las opciones 'm', 'x', 'b' quizá está especificada" - -#: cobc/cobc.c:2367 -#, c-format -msgid "-fdump= requires one of 'ALL', 'FD', 'WS', 'LS', 'RD', 'FD', 'SC' not '%s'" -msgstr "" - -#: cobc/cobc.c:2392 -#, c-format -msgid "'%s' is not an intrinsic function" -msgstr "«%s» no es una función intrínseca" - -#: cobc/cobc.c:2434 cobc/cobc.c:7516 cobc/cobc.c:7630 cobc/codegen.c:3796 -#: cobc/codegen.c:3905 cobc/codegen.c:5221 cobc/codegen.c:12426 cobc/tree.c:789 -#: cobc/tree.c:1221 cobc/tree.c:4101 cobc/tree.c:4648 cobc/tree.c:4891 -#: cobc/typeck.c:3294 cobc/typeck.c:7812 cobc/typeck.c:7847 cobc/typeck.c:8660 -#: cobc/typeck.c:11261 cobc/typeck.c:11329 cobc/typeck.c:11397 -#: cobc/typeck.c:11681 cobc/typeck.c:11724 -#, c-format -msgid "call to '%s' with invalid parameter '%s'" -msgstr "llama a «%s» con parámetro no válido «%s»" - -#: cobc/cobc.c:2737 -msgid "loading standard configuration file 'default.conf'" -msgstr "cargando fichero común de configuración «default.conf»" - -#: cobc/cobc.c:2871 -msgid "invalid output file name" -msgstr "nombre del fichero de salida inválido" - -#: cobc/cobc.c:2971 -#, c-format -msgid "warning: '%s' is not a directory, defaulting to current directory" -msgstr "advertencia: «%s» no es un directorio, predeterminando al directorio actual" - -#: cobc/cobc.c:2998 -#, c-format -msgid "warning: %d lines per listing page specified, using %d" -msgstr "" - -#: cobc/cobc.c:3048 -#, c-format -msgid "warning: assuming '%s' is a DEFINE - did you intend to use -debug?" -msgstr "advertencia: asumiendo «%s» es un DEFINE - ¿intentaba emplear depurar con -debug?" - -#: cobc/cobc.c:3315 -#, c-format -msgid "unknown warning option '%s'" -msgstr "opción de aviso desconocido «%s»" - -#: cobc/cobc.c:3367 -#, c-format -msgid "%s option requires a listing file" -msgstr "opción %s requiere un fichero listado" - -#: cobc/cobc.c:3374 -msgid "output to stdout only valid for preprocess" -msgstr "" - -#: cobc/cobc.c:3466 -msgid "all runtime checks are enabled" -msgstr "toda comprobación de tiempo de ejecución está activada" - -#: cobc/cobc.c:3572 -msgid "only one stdin input allowed" -msgstr "solo una entrada stdin permitida" - -#: cobc/cobc.c:3582 -#, c-format -msgid "invalid file name parameter (length > %d)" -msgstr "parámetro de nombre del fichero no válido (longitud > %d)" - -#: cobc/cobc.c:3807 -msgid "nothing for -j to run" -msgstr "no hay nada para -j para ejecutar" - -#: cobc/cobc.c:3883 cobc/cobc.c:4071 cobc/cobc.c:4130 cobc/cobc.c:4158 -#: cobc/cobc.c:4247 cobc/cobc.c:4306 cobc/cobc.c:4430 cobc/cobc.c:4469 -#: cobc/cobc.c:6993 -msgid "return status:" -msgstr "estado devuelto:" - -#: cobc/cobc.c:4361 -msgid "preprocessing:" -msgstr "preprocesando:" - -#: cobc/cobc.c:4435 -msgid "'cobxref' execution unsuccessful" -msgstr "'cobxref' ejecutado incorrectamente" - -#: cobc/cobc.c:4438 -#, c-format -msgid "check that 'cobxref' is in %s" -msgstr "comprueba que 'cobxref' está dentro de %s" - -#: cobc/cobc.c:4440 -msgid "no listing produced" -msgstr "ningún listado producido" - -#: cobc/cobc.c:5328 cobc/cobc.c:5367 -msgid "No fields defined." -msgstr "Ningún campo definido." - -#: cobc/cobc.c:5387 -msgid "No labels defined." -msgstr "Sin etiquetas definidas." - -#: cobc/cobc.c:5409 -msgid "Error/Warning summary:" -msgstr "Resumen de Error/Advertencias:" - -#: cobc/cobc.c:5453 -msgid "0 warnings in compilation group" -msgstr "0 advertencias dentro del grupo de compilación" - -#: cobc/cobc.c:5457 -msgid "1 warning in compilation group" -msgstr "1 advertencia dentro del grupo de compilación" - -#: cobc/cobc.c:5461 -#, c-format -msgid "%d warnings in compilation group" -msgstr "%d advertencias dentro del grupo de compilación" - -#: cobc/cobc.c:5467 -msgid "0 errors in compilation group" -msgstr "0 errores en el grupo de compilación" - -#: cobc/cobc.c:5471 -msgid "1 error in compilation group" -msgstr "1 error en grupo de compilación" - -#: cobc/cobc.c:5475 -#, c-format -msgid "%d errors in compilation group" -msgstr "%d errores dentro del grupo de compilación" - -#: cobc/cobc.c:5481 -#, c-format -msgid "Too many errors in compilation group: %d maximum errors" -msgstr "Demasiados errores dentro del grupo de compilación: %d errores máximos" - -#: cobc/cobc.c:6050 -#, c-format -msgid "%s: %d: Too many continuation lines" -msgstr "%s: %d: demasiadas líneas continuadas" - -#: cobc/cobc.c:6972 -msgid "parsing:" -msgstr "analizando:" - -#: cobc/cobc.c:7034 -msgid "translating:" -msgstr "traduciendo:" - -#: cobc/cobc.c:8157 -msgid "no input files" -msgstr "sin fichero entrante" - -#: cobc/cobc.c:8186 -#, c-format -msgid "%s option invalid in this combination" -msgstr "opción %s no válida con esta combinación" - -#: cobc/cobc.c:8227 -msgid "command line:" -msgstr "línea de órdenes:" - -#: cobc/codegen.c:973 cobc/codegen.c:4487 cobc/codegen.c:11093 -msgid "unexpected CONSTANT item" -msgstr "ítem CONSTANT inesperado" - -#: cobc/codegen.c:1188 cobc/codegen.c:1196 cobc/codegen.c:1291 -#: cobc/codegen.c:1603 cobc/codegen.c:2202 cobc/codegen.c:3212 -#: cobc/codegen.c:3455 cobc/codegen.c:3988 cobc/codegen.c:4454 -#: cobc/codegen.c:7902 cobc/codegen.c:8507 cobc/codegen.c:10298 -#: cobc/field.c:817 cobc/scanner.l:2104 cobc/tree.c:611 cobc/tree.c:3728 -#: cobc/typeck.c:5015 cobc/typeck.c:8662 cobc/typeck.c:9657 -#, c-format -msgid "unexpected tree tag: %d" -msgstr "etiqueta de árbol inesperada: %d" - -#: cobc/codegen.c:2999 cobc/codegen.c:3295 cobc/codegen.c:8125 cobc/tree.c:1243 -#, c-format -msgid "unexpected cast type: %d" -msgstr "tipo de molde inesperado: %d" - -#: cobc/codegen.c:3725 cobc/codegen.c:4434 -#, c-format -msgid "internal statement stack depth exceeded: %d" -msgstr "profundidad excedida en pila interna de declaración: %d" - -#: cobc/codegen.c:3798 -#, c-format -msgid "%s is not a field" -msgstr "%s no es un campo" - -#: cobc/codegen.c:4186 cobc/codegen.c:4279 -#, c-format -msgid "unexpected function: %s" -msgstr "función inesperada: %s" - -#: cobc/codegen.c:4270 -#, fuzzy, c-format -msgid "unexpected operator: %c" -msgstr "operador inesperado: %d" - -#: cobc/codegen.c:5043 -#, c-format -msgid "unexpected tree category: %d" -msgstr "categoría de árbol inesperada: %d" - -#: cobc/codegen.c:5438 cobc/codegen.c:5465 cobc/codegen.c:5662 -#: cobc/codegen.c:5694 -#, c-format -msgid "unexpected size: %d" -msgstr "tamaño inesperado: %d" - -#: cobc/codegen.c:7254 -#, c-format -msgid "No ENTRY FOR GO TO '%s'" -msgstr "" - -#: cobc/codegen.c:7475 cobc/codegen.c:7725 -#, c-format -msgid "unexpected handler type: %d" -msgstr "etiqueta de manipulador inesperada: %d" - -#: cobc/codegen.c:7823 -msgid "unexpected error_node parameter" -msgstr "parámetro error_node inesperado" - -#: cobc/codegen.c:8146 -#, c-format -msgid "unexpected tree type: %d" -msgstr "tipo de árbol inesperado: %d" - -#: cobc/codegen.c:8703 cobc/typeck.c:6511 cobc/typeck.c:12940 -#: cobc/typeck.c:12984 -#, fuzzy, c-format -msgid "compiler is not configured to support %s" -msgstr "biblioteca de tiempo de ejecución no está configurado para esta operación" - -#: cobc/codegen.c:9128 -msgid "Nested OCCURS in report" -msgstr "" - -#: cobc/codeoptim.c:2762 -#, c-format -msgid "unexpected optimization value: %d" -msgstr "valor de optimización no esperada: %d" - -#: cobc/config.c:162 libcob/common.c:6786 libcob/common.c:6800 -#: libcob/common.c:7242 -#, c-format -msgid "invalid value '%s' for configuration tag '%s'" -msgstr "valor «%s» no válido para la etiqueta de configuración «%s»" - -#: cobc/config.c:165 libcob/common.c:6093 libcob/common.c:6209 -#, c-format -msgid "should be one of the following values: %s" -msgstr "debería ser uno de los valores siguientes: %s" - -#: cobc/config.c:167 -msgid "must be numeric" -msgstr "debe ser numérico" - -#: cobc/config.c:169 libcob/common.c:6191 -#, c-format -msgid "maximum value: %lu" -msgstr "valor máximo: %lu" - -#: cobc/config.c:171 -#, c-format -msgid "minimum value: %d" -msgstr "valor mínimo: %d" - -#: cobc/config.c:203 -#, c-format -msgid "unsupported value '%s' for configuration tag '%s'" -msgstr "valor «%s» no compatible para etiquetado de configuración «%s»" - -#: cobc/config.c:311 cobc/pplex.l:977 libcob/common.c:6702 -msgid "recursive inclusion" -msgstr "inclusión recursiva" - -#: cobc/config.c:386 libcob/common.c:6753 -msgid "configuration file was included here" -msgstr "fichero de configuración incluido aquí" - -#: cobc/config.c:415 -#, c-format -msgid "The previous loaded configuration '%s' will be discarded." -msgstr "La previa configuración cargada «%s» será descartada." - -#: cobc/config.c:449 -msgid "missing definitions:" -msgstr "definiciones ausentes:" - -#: cobc/config.c:451 -#, c-format -msgid "\tno definition of '%s'" -msgstr "\tsin definición de «%s»" - -#: cobc/config.c:512 -#, c-format -msgid "invalid configuration tag '%s'" -msgstr "etiquetado de configuración inválido «%s»" - -#: cobc/config.c:525 libcob/common.c:6509 libcob/common.c:6592 -#: libcob/common.c:6620 -#, c-format -msgid "unknown configuration tag '%s'" -msgstr "etiqueta de configuración desconocida «%s»" - -#: cobc/config.c:549 -#, c-format -msgid "invalid configuration tag '%s' in word-list" -msgstr "etiquetado de configuración inválido «%s» en listado de palabras" - -#: cobc/config.c:608 -#, c-format -msgid "Could not access word list for '%s'" -msgstr "No se pudo acceder a listado de palabras para «%s»" - -#: cobc/error.c:87 -#, fuzzy, c-format -msgid "in section '%s':" -msgstr "dentro de sección" - -#: cobc/error.c:98 -#, fuzzy, c-format -msgid "in paragraph '%s':" -msgstr "dentro de párrafo" - -#: cobc/error.c:121 libcob/common.c:7252 -msgid "configuration error:" -msgstr "error de configuración:" - -#: cobc/error.c:134 libcob/common.c:673 -#, c-format -msgid "system error %d" -msgstr "error de sistema %d" - -#: cobc/error.c:231 cobc/error.c:323 cobc/error.c:478 -msgid "error [-Werror]: " -msgstr "error [-Werror]: " - -#: cobc/error.c:231 cobc/error.c:323 cobc/error.c:478 cobc/error.c:505 -#: libcob/common.c:6881 libcob/common.c:6906 -#, c-format -msgid "warning: " -msgstr "aviso: " - -#: cobc/error.c:274 cobc/error.c:528 -msgid "error (ignored): " -msgstr "error (ignorado): " - -#: cobc/error.c:364 cobc/error.c:380 cobc/error.c:563 cobc/error.c:584 -#, c-format -msgid "%s used" -msgstr "%s empleado" - -#: cobc/error.c:367 cobc/error.c:566 -#, c-format -msgid "%s is archaic in %s" -msgstr "%s es arcaico en %s" - -#: cobc/error.c:371 cobc/error.c:570 -#, c-format -msgid "%s is obsolete in %s" -msgstr "%s es obsoleto en %s" - -#: cobc/error.c:377 cobc/error.c:576 cobc/parser.y:5186 cobc/parser.y:5325 -#, c-format -msgid "%s ignored" -msgstr "%s ignorado" - -#: cobc/error.c:383 cobc/error.c:586 -#, c-format -msgid "%s does not conform to %s" -msgstr "%s no es conforme a %s" - -#: cobc/error.c:399 -msgid "configuration warning:" -msgstr "advertencia de configuración:" - -#: cobc/error.c:621 cobc/error.c:640 -#, c-format -msgid "redefinition of '%s'" -msgstr "redefinición de «%s»" - -#: cobc/error.c:628 cobc/error.c:653 -#, c-format -msgid "'%s' previously defined here" -msgstr "«%s» previamente definidos aquí" - -#: cobc/error.c:677 cobc/error.c:684 -#, c-format -msgid "'%s' is not defined" -msgstr "%s no está definido" - -#: cobc/error.c:680 -#, c-format -msgid "'%s' cannot be used here" -msgstr "«%s» no puede ser empleado aquí" - -#: cobc/error.c:682 cobc/parser.y:7009 -#, c-format -msgid "'%s' is not defined, but is a reserved word in another dialect" -msgstr "'%s' no está definido, pero es una palabra reservada en otro dialecto" - -#: cobc/error.c:716 -#, c-format -msgid "'%s' is ambiguous; needs qualification" -msgstr "«%s» es ambiguo; necesita cualificación" - -#: cobc/error.c:746 cobc/parser.y:16748 -#, c-format -msgid "'%s' defined here" -msgstr "«%s» definido aquí" - -#: cobc/error.c:757 -#, c-format -msgid "fatal error: %s" -msgstr "error fatal: %s" - -#: cobc/error.c:765 -#, c-format -msgid "group item '%s' cannot have %s clause" -msgstr "ítem de grupo «%s» no puede tener clausula %s" - -#: cobc/error.c:779 -#, c-format -msgid "constant item '%s' requires a %s clause" -msgstr "ítem constante %s requiere una cláusula %s" - -#: cobc/error.c:781 -#, c-format -msgid "level %02d item '%s' requires a %s clause" -msgstr "nivel %02d de ítem «%s» requiere una cláusula %s" - -#: cobc/error.c:795 -#, c-format -msgid "constant item '%s' can only have a %s clause" -msgstr "ítem constante «%s» solo puede tener una cláusula %s" - -#: cobc/error.c:797 -#, c-format -msgid "level %02d item '%s' can only have a %s clause" -msgstr "nivel %02d de ítem «%s» solo puede tener una cláusula %s" - -#: cobc/field.c:131 -#, fuzzy -msgid "constant expression has Divide by ZERO" -msgstr "Expresión contante tiene División entre CERO" - -#: cobc/field.c:187 cobc/field.c:324 cobc/field.c:332 -msgid "missing right parenthesis" -msgstr "paréntesis derecho ausente" - -#: cobc/field.c:216 -#, c-format -msgid "expression stack overflow at %d entries for operation '%c'" -msgstr "" - -#: cobc/field.c:257 -#, c-format -msgid "expression stack overflow at %d entries" -msgstr "" - -#: cobc/field.c:274 -msgid "missing left parenthesis" -msgstr "paréntesis izquierdo ausente" - -#: cobc/field.c:315 -#, c-format -msgid "invalid operator '%s' in expression" -msgstr "operador inválido «%s» dentro de expresión" - -#: cobc/field.c:334 -#, c-format -msgid "'%c' operator misplaced" -msgstr "operador «%c» mal ubicado" - -#: cobc/field.c:395 -#, c-format -msgid "invalid level number '%s'" -msgstr "número de nivel inválido «%s»" - -#: cobc/field.c:454 -#, fuzzy -msgid "entry following SAME AS may not be subordinate to it" -msgstr "Ãtem THRU «%s» quizá no es subordinado a «%s»" - -#: cobc/field.c:459 cobc/field.c:496 -msgid "level number must begin with 01 or 77" -msgstr "nivel numérico debe comenzar con 01 o 77" - -#: cobc/field.c:541 cobc/field.c:557 -#, c-format -msgid "no previous data item of level %02d" -msgstr "ningún ítem de datos previamente de nivel %02d" - -#: cobc/field.c:599 -#, c-format -msgid "'%s' cannot be qualified here" -msgstr "«%s» no puede ser calificado aquí" - -#: cobc/field.c:605 -#, c-format -msgid "'%s' cannot be subscripted here" -msgstr "«%s» no puede ser subíndice aquí" - -#: cobc/field.c:617 -#, c-format -msgid "'%s' is not defined in '%s'" -msgstr "«%s» no esta definido en «%s»" - -#: cobc/field.c:638 -msgid "level number of REDEFINES entries must be identical" -msgstr "número de nivel de entradas REDEFINES deben ser idénticas" - -#: cobc/field.c:643 -#, c-format -msgid "'%s' is not the original definition" -msgstr "'%s' no es la definición original" - -#: cobc/field.c:758 -#, c-format -msgid "PICTURE clause not compatible with USAGE %s" -msgstr "PICTURE clausurada no compatible con UTILIZACIÓN %s" - -#: cobc/field.c:855 cobc/field.c:930 cobc/field.c:941 -#, c-format -msgid "PICTURE clause required for '%s'" -msgstr "PICTURE clausurada requerida para «%s»" - -#: cobc/field.c:937 -#, c-format -msgid "a non-numeric literal is expected for '%s'" -msgstr "un literal no numérico está esperado para «%s»" - -#: cobc/field.c:949 -#, c-format -msgid "defining implicit picture size %d for '%s'" -msgstr "definiendo tamaño implícito de dibujo %d para «%s»" - -#: cobc/field.c:969 -#, c-format -msgid "'%s' ANY LENGTH only allowed in LINKAGE" -msgstr "«%s» cualquier longitud CUALQUIER LONGITUD solamente permitido en ENLACE" - -#: cobc/field.c:973 -#, c-format -msgid "'%s' ANY LENGTH must be 01 level" -msgstr "«%s» ANY LENGTH debe ser nivel 01" - -#: cobc/field.c:977 -#, c-format -msgid "'%s' ANY LENGTH cannot be BASED/EXTERNAL" -msgstr "«%s» ANY LENGTH no puede ser BASED/EXTERNAL" - -#: cobc/field.c:982 cobc/field.c:1010 -#, c-format -msgid "'%s' ANY LENGTH has invalid definition" -msgstr "«%s» ANY LENGTH tiene definición no válida" - -#: cobc/field.c:993 -#, c-format -msgid "'%s' ANY NUMERIC must be PIC 9" -msgstr "«%s» ANY NUMERIC debe ser PIC 9" - -#: cobc/field.c:998 -#, fuzzy, c-format -msgid "'%s' ANY LENGTH must be PIC X or PIC N" -msgstr "«%s» ANY LENGTH debe ser PIC X o PIC A" - -#: cobc/field.c:1008 -#, c-format -msgid "'%s' ANY NUMERIC has invalid definition" -msgstr "«%s» ANY LENGTH tiene definición inválida" - -#: cobc/field.c:1026 -#, c-format -msgid "'%s' EXTERNAL must be specified at 01/77 level" -msgstr "«%s» EXTERNAL se debe que especificar a nivel 01/77" - -#: cobc/field.c:1030 -#, c-format -msgid "'%s' EXTERNAL can only be specified in WORKING-STORAGE section" -msgstr "«%s» EXTERNAL solo puede ser especificado en sección WORKING-STORAGE" - -#: cobc/field.c:1034 -#, c-format -msgid "'%s' EXTERNAL and BASED are mutually exclusive" -msgstr "«%s» EXTERNAL y BASED son mutuamente excluyentes" - -#: cobc/field.c:1037 -#, c-format -msgid "'%s' EXTERNAL not allowed with REDEFINES" -msgstr "«%s» EXTERNAL no permitida con REDEFINES" - -#: cobc/field.c:1049 -#, c-format -msgid "'%s' BASED not allowed here" -msgstr "«%s» BASED no se permite aquí" - -#: cobc/field.c:1052 -#, c-format -msgid "'%s' BASED not allowed with REDEFINES" -msgstr "«%s» BASED no permitido con REDEFINES" - -#: cobc/field.c:1055 -#, c-format -msgid "'%s' BASED only allowed at the 01 and 77 levels" -msgstr "«%s» BASED solamente se permite a los niveles 01 y 77" - -#: cobc/field.c:1067 -#, c-format -msgid "level %02d item '%s' cannot have a %s clause" -msgstr "ítem de nivel %02d «%s» no puede tener una cláusula %s" - -#: cobc/field.c:1082 -#, c-format -msgid "'%s' cannot have the OCCURS clause due to '%s'" -msgstr "«%s» no puede tener la cláusula OCURRS debido a «%s»" - -#: cobc/field.c:1101 -#, c-format -msgid "the original definition '%s' should not have OCCURS clause" -msgstr "la definición original «%s» no debería tener cláusula OCURRS" - -#: cobc/field.c:1108 -msgid "REDEFINES must follow the original definition" -msgstr "REDEFINES debe seguir la definición original" - -#: cobc/field.c:1115 -#, c-format -msgid "'%s' cannot be variable length" -msgstr "«%s» no puede ser de longitud variable" - -#: cobc/field.c:1118 -#, c-format -msgid "the original definition '%s' cannot be variable length" -msgstr "la definición original «%s» no puede ser de longitud variable" - -#: cobc/field.c:1142 -#, c-format -msgid "SCREEN group item '%s' has invalid clause" -msgstr "PANTALLA de grupo ítem «%s» tiene clausula inválida" - -#: cobc/field.c:1223 -#, fuzzy, c-format -msgid "%s USAGE %s incompatible with %s USAGE %s" -msgstr "PICTURE clausurada no compatible con UTILIZACIÓN %s" - -#: cobc/field.c:1302 -#, c-format -msgid "'%s' cannot have PICTURE clause" -msgstr "«%s» no puede tener cláusula de PICTURE" - -#: cobc/field.c:1318 cobc/field.c:1328 -#, fuzzy, c-format -msgid "%s item '%s' should be USAGE DISPLAY" -msgstr "«%s» no es USAGE DISPLAY" - -#: cobc/field.c:1351 -#, c-format -msgid "'%s' COMP-6 with sign - changing to COMP-3" -msgstr "«%s» COMP-6 con signo - modificando a COMP-3" - -#: cobc/field.c:1377 -msgid "elementary items with SIGN clause must have S in PICTURE" -msgstr "ítemes elementariamente con SIGNO cláusula debe tener S en PICTURE" - -#: cobc/field.c:1380 -msgid "elementary items with SIGN clause must be USAGE DISPLAY or NATIONAL" -msgstr "ítemes elementarios con cláusula SIGN debe ser USAGE DISPLAY o NATIONAL" - -#: cobc/field.c:1397 -#, c-format -msgid "'%s' cannot have JUSTIFIED RIGHT" -msgstr "«%s» no se puede tener JUSTIFIED RIGHT" - -#: cobc/field.c:1410 -#, c-format -msgid "'%s' cannot have S in PICTURE string and BLANK WHEN ZERO" -msgstr "«%s» no se puede tener S dentro de cadena PICTURE y BLANL WHEN ZERO" - -#: cobc/field.c:1415 -#, c-format -msgid "'%s' cannot have BLANK WHEN ZERO without being USAGE DISPLAY or NATIONAL" -msgstr "«%s» no pude mostrar NEGRO CUANDO CERO sin haber PANTALLA DE USO o NACIONAL" - -#: cobc/field.c:1426 -#, c-format -msgid "'%s' cannot have * in PICTURE string and BLANK WHEN ZERO" -msgstr "«%s» no puede tener * dentro de cadena PICTURE y BLANK WHEN ZERO" - -#: cobc/field.c:1433 -#, c-format -msgid "'%s' is not numeric, so cannot have BLANK WHEN ZERO" -msgstr "«%s» no es numérico, por lo que no puede tener BLANK WHEN ZERO" - -#: cobc/field.c:1446 -msgid "only level 88 items may have multiple values" -msgstr "solamente ítem de nivel 88 quizá pueda tener valores múltiples" - -#: cobc/field.c:1454 cobc/field.c:1458 -#, fuzzy, c-format -msgid "initial VALUE clause ignored for %s item '%s'" -msgstr "cláusula inicial de VALUE ignorada para ítem %s" - -#: cobc/field.c:1471 -msgid "FULL has no effect on numeric items; you may want REQUIRED or PIC Z" -msgstr "" - -#: cobc/field.c:1499 -msgid "VALUE may not contain a figurative constant" -msgstr "" - -#: cobc/field.c:1507 -#, fuzzy -msgid "cannot specify both FULL and JUSTIFIED" -msgstr "no puede especificar ambos %s y %s" - -#: cobc/field.c:1519 -#, c-format -msgid "'%s' has FROM, TO or USING without PIC; PIC will be implied" -msgstr "" - -#: cobc/field.c:1533 -#, c-format -msgid "'%s' has numeric VALUE without PIC; PIC will be implied" -msgstr "" - -#: cobc/field.c:1548 -#, c-format -msgid "'%s' cannot have PIC without FROM, TO, USING or numeric VALUE" -msgstr "" - -#: cobc/field.c:1560 -#, c-format -msgid "'%s' needs a PIC, FROM, TO, USING, VALUE, BELL, BLANK or ERASE clause" -msgstr "" - -#: cobc/field.c:1574 -#, fuzzy -msgid "cannot specify both PIC and VALUE" -msgstr "no puede especificar ambos %s y %s" - -#: cobc/field.c:1582 -msgid "cannot have PIC without FROM, TO or USING" -msgstr "" - -#: cobc/field.c:1591 -msgid "cannot have FROM, TO or USING without PIC" -msgstr "" - -#: cobc/field.c:1600 -#, fuzzy -msgid "VALUE item may not be numeric" -msgstr "Ãtem INITIALIZED TO no es alfanumérico" - -#: cobc/field.c:1616 -#, c-format -msgid "'%s' needs a PIC, COL, LINE, VALUE, BELL or BLANK clause" -msgstr "" - -#: cobc/field.c:1647 -msgid "cannot use AUTO, FULL, PROMPT, REQUIRED or SECURE on elementary item without TO or USING" -msgstr "" - -#: cobc/field.c:1654 -msgid "cannot use BLANK WHEN ZERO, JUSTIFIED, OCCURS or SIGN on item without FROM, TO or USING" -msgstr "" - -#: cobc/field.c:1674 -msgid "cannot use AUTO, FULL, REQUIRED or SECURE on elementary item without FROM, TO or USING" -msgstr "" - -#: cobc/field.c:1679 -msgid "cannot use BLANK WHEN ZERO, JUSTIFIED or SIGN without FROM, TO or USING" -msgstr "" - -#: cobc/field.c:1697 -#, fuzzy -msgid "cannot have BLANK WHEN ZERO without PIC" -msgstr "«%s» no pude mostrar NEGRO CUANDO CERO sin haber PANTALLA DE USO o NACIONAL" - -#: cobc/field.c:1700 -#, fuzzy -msgid "cannot have JUSTIFIED without PIC" -msgstr "«%s» no se puede tener JUSTIFIED RIGHT" - -#: cobc/field.c:1720 -msgid "cannot have AUTO without FROM, TO or USING" -msgstr "" - -#: cobc/field.c:1725 -msgid "cannot use FULL or REQUIRED on item without TO or USING" -msgstr "" - -#: cobc/field.c:1732 -msgid "SECURE can be used with TO only" -msgstr "" - -#: cobc/field.c:1734 -#, fuzzy -msgid "SECURE must be used with TO" -msgstr "READ debe ser ejecutada primero" - -#: cobc/field.c:1753 -#, fuzzy, c-format -msgid "'%s' does nothing" -msgstr "%s no está definido" - -#: cobc/field.c:1797 -#, fuzzy -msgid "BLANK ZERO not compatible with USAGE" -msgstr "PICTURE clausurada no compatible con UTILIZACIÓN %s" - -#: cobc/field.c:1800 -#, fuzzy -msgid "SIGN clause not compatible with USAGE" -msgstr "PICTURE clausurada no compatible con UTILIZACIÓN %s" - -#: cobc/field.c:1977 -#, fuzzy, c-format -msgid "'%s' PICTURE clause not compatible with USAGE" -msgstr "PICTURE clausurada no compatible con UTILIZACIÓN %s" - -#: cobc/field.c:2027 -#, fuzzy, c-format -msgid "'%s' 77 level is not allowed here" -msgstr "«%s» nivel 77 no se permite aquí" - -#: cobc/field.c:2424 -msgid "OCCURS and multi COLUMNs is not allowed" -msgstr "" - -#: cobc/field.c:2452 -#, fuzzy, c-format -msgid "duplicate LINE %d ignored" -msgstr "duplica DEFINE «%s» - ignorado" - -#: cobc/field.c:2469 -#, c-format -msgid "ignoring SYNCHRONIZED for group item '%s'" -msgstr "ignorando SINCRONIZADO para la ítem del grupo «%s»" - -#: cobc/field.c:2485 cobc/field.c:2498 cobc/field.c:2778 cobc/field.c:2781 -#, c-format -msgid "size of '%s' larger than size of '%s'" -msgstr "tamaño de «%s» mayor que el tamaño de «%s»" - -#: cobc/field.c:2638 cobc/field.c:2703 -#, c-format -msgid "'%s' cannot be larger than %d bytes" -msgstr "«%s» no puede ser mayor de %d bytes" - -#: cobc/field.c:2676 cobc/field.c:2684 -#, c-format -msgid "'%s' binary field cannot be larger than %d digits" -msgstr "«%s» campo binario no puede ser mayor de %d dígitos" - -#: cobc/field.c:2764 cobc/field.c:3216 -#, c-format -msgid "unexpected USAGE: %d" -msgstr "no esperaba EMPLEO: %d" - -#: cobc/field.c:2876 -msgid "literal type does not match numeric data type" -msgstr "tipo literal no coincide con el tipo de datos numérico" - -#: cobc/field.c:2953 -#, c-format -msgid "THRU item '%s' may not come before '%s'" -msgstr "Ãtem THRU «%s» quizá no viene antes de «%s»" - -#: cobc/field.c:2976 -#, c-format -msgid "RENAMES cannot start/end at the OCCURS item '%s'" -msgstr "RENAMES no puede inidiar/terminar en el ítem OCCURS «%s»" - -#: cobc/field.c:2984 -#, c-format -msgid "cannot use RENAMES on part of the table '%s'" -msgstr "no puede emplear RENOMBADOS en parte de la tabla «%s»" - -#: cobc/field.c:3022 -#, c-format -msgid "RENAMES may not contain '%s' as it is a pointer or object reference" -msgstr "RENAMES quizá no contienen «%s» como es una referencia a puntero u objeto" - -#: cobc/field.c:3027 -#, c-format -msgid "RENAMES may not contain '%s' as it is an OCCURS DEPENDING table" -msgstr "RENAMES quizá no contienen «%s» como sea una distribución OCCURS DEPENDING" - -#: cobc/field.c:3049 -msgid "RENAMES of 01-, 66- and 77-level items" -msgstr "RENOMBRA ítemes de 01-, 66- y 77-nivel" - -#: cobc/field.c:3051 -msgid "RENAMES may not reference a level 88" -msgstr "RENOMBRA quizá no referencia un nivel 88" - -#: cobc/field.c:3075 -#, c-format -msgid "'%s' must immediately follow the record '%s'" -msgstr "«%s» deben inmediatamente seguir al mismo registro «%s»" - -#: cobc/field.c:3083 -#, c-format -msgid "THRU item must be different to '%s'" -msgstr "Ãtem THRU debe ser diferente a «%s»" - -#: cobc/field.c:3089 -#, c-format -msgid "'%s' and '%s' must be in the same record" -msgstr "«%s» y «%s» deben estar dentro del mismo registro" - -#: cobc/field.c:3100 -#, c-format -msgid "THRU item '%s' may not be subordinate to '%s'" -msgstr "Ãtem THRU «%s» quizá no es subordinado a «%s»" - -#: cobc/flag.def:40 -msgid "" -" -fstack-size=\tdefine PERFORM stack size\n" -" * default: 255" -msgstr "" - -#: cobc/flag.def:44 -msgid "" -" -fsign=[ASCII|EBCDIC]\tdefine display sign representation\n" -" * default: machine native" -msgstr "" - -#: cobc/flag.def:48 -msgid "" -" -ffold-copy=[UPPER|LOWER]\tfold COPY subject to value\n" -" * default: no transformation" -msgstr "" - -#: cobc/flag.def:52 -msgid "" -" -ffold-call=[UPPER|LOWER]\tfold PROGRAM-ID, CALL, CANCEL subject to value\n" -" * default: no transformation" -msgstr "" - -#: cobc/flag.def:56 -msgid "" -" -fdefaultbyte=\tinitialize fields without VALUE to value\n" -" * decimal 0..255 or any quoted character\n" -" * default: initialize to picture" -msgstr "" - -#: cobc/flag.def:61 -msgid "" -" -fmax-errors=\tmaximum number of errors to report before\n" -" compilation is aborted\n" -" * default: 128" -msgstr "" - -#: cobc/flag.def:68 -msgid "" -" -fintrinsics=[ALL|intrinsic function name(,name,...)]\n" -" intrinsics to be used without FUNCTION keyword" -msgstr "" - -#: cobc/flag.def:72 -msgid "" -" -fdump= dump data fields on abort, may be\n" -" a combination of: ALL, WS, LS, RD, FD, SC" -msgstr "" - -#: cobc/flag.def:76 -msgid "" -" -fcallfh= use external provided EXTFH interface module\n" -" for I/O" -msgstr "" - -#: cobc/flag.def:80 -msgid "" -" -fsqldb= which Database is used, may be\n" -" MySQL, MSSQL, Oracle10, Oracle11, Oracle12" -msgstr "" - -#: cobc/flag.def:84 -msgid " -fsqlschema= define database schema name" -msgstr "" - -#: cobc/flag.def:91 -msgid "" -" -fno-recursive-check disable check of recursive program call;\n" -" effectively compiling as RECURSIVE program" -msgstr "" - -#: cobc/flag.def:95 -#, fuzzy -msgid "" -" -fwinmain generate WinMain instead of main when compiling\n" -" as executable" -msgstr "genera WinMain en vez de principal cuando compila como ejecutable" - -#: cobc/flag.def:99 -#, fuzzy -msgid " -fcomputed-goto generate computed goto C statements" -msgstr "generar declaraciones computadas goto en C" - -#: cobc/flag.def:102 -#, fuzzy -msgid " -falternate-ebcdic use restricted ASCII to EBCDIC translate" -msgstr "emplea un ASCII restringido para traducir EBCDIC" - -#: cobc/flag.def:105 -msgid " -fextra-brace generate extra braces in C source" -msgstr "" - -#: cobc/flag.def:108 -msgid " -fgen-c-line-directives\tgenerate source location directives in C code" -msgstr "" - -#: cobc/flag.def:111 -msgid " -fgen-c-labels generate extra labels in C sources" -msgstr "" - -#: cobc/flag.def:114 -#, fuzzy -msgid " -fcorrect-numeric attempt correction of invalid numeric display items" -msgstr "intentar corrección de los elementos numéricos mostrados inválidos" - -#: cobc/flag.def:117 -#, fuzzy -msgid " -fstack-on-heap PERFORM stack allocated on heap" -msgstr "Pila PERFORM asignada sobre cabecera" - -#: cobc/flag.def:120 -msgid " -ffast-math Disables emitting faster arithmetic logic" -msgstr "" - -#: cobc/flag.def:125 -msgid "" -" -fno-remove-unreachable\tdisable remove of unreachable code\n" -" * turned off by -g" -msgstr "" - -#: cobc/flag.def:129 -msgid " -finline-intrinsic\twhen possible resolve intrinsic FUNCTIONs at compile time" -msgstr "" - -#: cobc/flag.def:132 -#, fuzzy -msgid "" -" -ftrace generate trace code\n" -" * scope: executed SECTION/PARAGRAPH" -msgstr "" -" -Xref genera referencia cruzada mediante 'cobxref'\n" -" (V. Coen's 'cobxref' debe estar en el camino)" - -#: cobc/flag.def:136 -#, fuzzy -msgid "" -" -ftraceall generate trace code\n" -" * scope: executed SECTION/PARAGRAPH/STATEMENTS\n" -" * turned on by -debug" -msgstr "" -"generar código de traza\n" -"\t\t\t- ejecutado SECTION/PARAGRAPH/STATEMENTS\n" -"\t\t\t- activado por -debug" - -#: cobc/flag.def:141 -#, fuzzy -msgid " -fsyntax-only syntax error checking only; don't emit any output" -msgstr "solamente comprobando error sintáctico; no emite ningún resultado" - -#: cobc/flag.def:144 -#, fuzzy -msgid "" -" -fdebugging-line enable debugging lines\n" -" * 'D' in indicator column or floating >>D" -msgstr "" -"activa la depuración de lineas\n" -"\t\t\t- ‘D’ en la columna de indicador o flotante >>D" - -#: cobc/flag.def:148 -#, fuzzy -msgid "" -" -fsource-location generate source location code\n" -" * turned on by -debug/-g/-ftraceall" -msgstr "" -"generar la ubicación del código de fuente\n" -"\t\t\t- activado por -debug/-g/-ftraceall" - -#: cobc/flag.def:152 -#, fuzzy -msgid " -fimplicit-init automatic initialization of the COBOL runtime system" -msgstr "inicialización automática del sistema de ejecución COBOL" - -#: cobc/flag.def:155 -#, fuzzy -msgid "" -" -fstack-check PERFORM stack checking\n" -" * turned on by -debug or -g" -msgstr "" -"PERFORM revisa pila\n" -" \t\t\t- activado por -debug o -g" - -#: cobc/flag.def:159 -#, fuzzy -msgid "" -" -fwrite-after use AFTER 1 for WRITE of LINE SEQUENTIAL\n" -" * default: BEFORE 1" -msgstr "" -"utiliza AFTER 1 para WRITE de LINE SEQUENTIAL\n" -"\t\t\t- por defecto : BEFORE 1" - -#: cobc/flag.def:163 -#, fuzzy -msgid "" -" -fmfcomment '*' or '/' in column 1 treated as comment\n" -" * FIXED format only" -msgstr "" -"‘*’ o ‘/’ dentro de columna 1 tratada como comentario\n" -"\t\t\t- unicamente en formato FIXED" - -#: cobc/flag.def:167 -#, fuzzy -msgid "" -" -facucomment '$' in indicator area treated as '*',\n" -" '|' treated as floating comment" -msgstr "" -"'$' en área indicadora tratada como '*',\n" -" '|' tratada como comentario flotante" - -#: cobc/flag.def:171 -#, fuzzy -msgid "" -" -fnotrunc allow numeric field overflow\n" -" * non-ANSI behaviour" -msgstr "" -"permite desbordamiento del campo numérico\n" -"\t\t\t- comportamiento no ANSI" - -#: cobc/flag.def:175 -msgid "" -" -fodoslide adjust items following OCCURS DEPENDING\n" -" * implies -fcomplex-odo" -msgstr "" - -#: cobc/flag.def:179 -#, fuzzy -msgid "" -" -fsingle-quote use a single quote (apostrophe) for QUOTE\n" -" * default: double quote" -msgstr "" -"emplea una comilla (apóstrofe) para QUOTE\n" -"\t\t\t- por defecto: doble comilla" - -#: cobc/flag.def:189 -#, fuzzy -msgid "" -" -foptional-file treat all files as OPTIONAL\n" -" * unless NOT OPTIONAL specified" -msgstr "" -"trata todos los ficheros como OPTIONAL\n" -"\t\t\t- a menos que se especifique NOT OPTIONAL" - -#: cobc/flag.def:193 -#, fuzzy -msgid " -fstatic-call output static function calls for the CALL statement" -msgstr "llamadas de función estática de salida para la sentencia CALL" - -#: cobc/flag.def:196 -#, fuzzy -msgid "" -" -fno-gen-c-decl-static-call\tdisable generation of C function declations\n" -" for subroutines with static CALL" -msgstr "desactiva generación de declaraciones de función C para subrutinas con llamada CALL estática" - -#: cobc/flag.def:200 -msgid " -fmf-files Sequential & Relative files will match Micro Focus format" -msgstr "" - -#: cobc/flag.def:203 -msgid "" -" -fno-theaders suppress all headers and output of compilation\n" -" options from listing while keeping page breaks" -msgstr "" - -#: cobc/flag.def:207 -#, fuzzy -msgid " -fno-tsource suppress source from listing" -msgstr " -F, -free emplear formato de origen libre" - -#: cobc/flag.def:210 -msgid " -fno-tmessages suppress warning and error summary from listing" -msgstr "" - -#: cobc/flag.def:213 -#, fuzzy -msgid " -ftsymbols specify symbols in listing" -msgstr " --tsymbols\t\tespecifica símbolos dentro de listado" - -#: cobc/parser.y:283 cobc/parser.y:317 -#, c-format -msgid "unreachable statement '%s'" -msgstr "estado no alcanzable «%s»" - -#: cobc/parser.y:410 cobc/parser.y:703 -#, c-format -msgid "'%s' is not in LINKAGE SECTION" -msgstr "«%s» no esta en LINKAGE SECTION" - -#: cobc/parser.y:413 cobc/typeck.c:3705 -#, c-format -msgid "'%s' cannot be BASED/EXTERNAL" -msgstr "«%s» no puede ser BASED/EXTERNAL" - -#: cobc/parser.y:418 -#, c-format -msgid "'%s' is not in WORKING-STORAGE SECTION" -msgstr "«%s» no esta en la WORKING-STORAGE SECTION" - -#: cobc/parser.y:425 cobc/typeck.c:3702 -#, c-format -msgid "'%s' not level 01 or 77" -msgstr "«%s» no nivel 01 o 77" - -#: cobc/parser.y:428 cobc/parser.y:443 cobc/typeck.c:3708 -#, c-format -msgid "'%s' REDEFINES field not allowed here" -msgstr "«%s» Campo de REDEFINES no se permite aquí" - -#: cobc/parser.y:456 -#, c-format -msgid "'%s' USING item duplicates RETURNING item" -msgstr "«%s» ítem usando USING duplica ítem de retorno DEVOLVIENDO" - -#: cobc/parser.y:466 -#, c-format -msgid "ENTRY '%s' duplicated" -msgstr "ENTRY «%s» duplicado" - -#: cobc/parser.y:502 -#, fuzzy, c-format -msgid "ENTRY FOR GO TO '%s' duplicated" -msgstr "ENTRY «%s» duplicado" - -#: cobc/parser.y:518 -#, c-format -msgid "maximum nested program depth exceeded (%d)" -msgstr "profundidad máxima excedida para programa anidados (%d)" - -#: cobc/parser.y:544 cobc/parser.y:571 -#, c-format -msgid "%s statement not terminated by %s" -msgstr "%s declaración no terminada por %s" - -#: cobc/parser.y:574 -#, c-format -msgid "%s statement not terminated" -msgstr "declaración %s no terminada" - -#: cobc/parser.y:638 -msgid "USE statement invalid for SORT file" -msgstr "Declaracion USE no válida con fichero SORT" - -#: cobc/parser.y:665 cobc/parser.y:667 -#, c-format -msgid "duplicate %s clause" -msgstr "cláusula duplicada %s" - -#: cobc/parser.y:685 -#, c-format -msgid "Cannot specify %s without number of lines on page" -msgstr "" - -#: cobc/parser.y:695 -#, c-format -msgid "maximum OCCURS depth exceeded (%d)" -msgstr "máxima profundidad excedida para OCURRS (%d)" - -#: cobc/parser.y:709 cobc/parser.y:711 cobc/parser.y:6808 cobc/parser.y:6811 -#: cobc/parser.y:6813 cobc/parser.y:6815 cobc/parser.y:6850 cobc/parser.y:7573 -#: cobc/parser.y:7575 cobc/parser.y:7577 cobc/parser.y:7579 cobc/parser.y:7625 -#: cobc/parser.y:7634 cobc/parser.y:9548 cobc/parser.y:10994 -#: cobc/parser.y:12370 cobc/parser.y:13552 -#, c-format -msgid "%s and %s are mutually exclusive" -msgstr "%s y %s son mutuamente excluyentes" - -#: cobc/parser.y:725 cobc/parser.y:729 -msgid "TO phrase without DEPENDING phrase" -msgstr "PARA frase sin frase DEPENDIENTE" - -#: cobc/parser.y:726 -#, fuzzy -msgid "maximum number of occurrences assumed to be exact number" -msgstr "número máximo de ocurrencias asumidas a ser número exacto" - -#: cobc/parser.y:733 cobc/parser.y:7355 -msgid "OCCURS TO must be greater than OCCURS FROM" -msgstr "OCURRE PARA debe ser mayor que OCURRE DESDE" - -#: cobc/parser.y:742 -#, fuzzy -msgid "OCCURS DEPENDING ON without TO phrase" -msgstr "ODO sin frase TO" - -#: cobc/parser.y:808 -#, c-format -msgid "%s header missing - assumed" -msgstr "%s encabezado ausente - asumido" - -#: cobc/parser.y:810 -#, c-format -msgid "%s header missing" -msgstr "%s encabezado ausente" - -#: cobc/parser.y:942 -#, fuzzy, c-format -msgid "duplicate %s" -msgstr "cláusula duplicada %s" - -#: cobc/parser.y:944 -#, c-format -msgid "%s incorrectly after %s" -msgstr "" - -#: cobc/parser.y:1046 -#, c-format -msgid "redefinition of program name '%s'" -msgstr "redefinición de nombre del programa '%s'" - -#: cobc/parser.y:1050 -#, c-format -msgid "redefinition of program ID '%s'" -msgstr "redefinición de ID programa «%s»" - -#: cobc/parser.y:1082 -#, c-format -msgid "FUNCTION '%s' has no PROCEDURE DIVISION" -msgstr "FUNCTION «%s» no tiene ningún PROCEDURE DIVISION" - -#: cobc/parser.y:1188 -msgid "functions may not be defined within a program/function" -msgstr "funciones quizá no son definidas dentro de un programa/función" - -#: cobc/parser.y:1238 -#, c-format -msgid "END FUNCTION '%s' is different from FUNCTION-ID '%s'" -msgstr "END FUNCTION «%s» es diferente desde FUNCTION-ID «%s»" - -#: cobc/parser.y:1252 -#, c-format -msgid "END PROGRAM '%s' is different from PROGRAM-ID '%s'" -msgstr "END PROGRAM «%s» es diferente del PROGRAM-ID «%s»" - -#: cobc/parser.y:1301 -#, fuzzy -msgid "currency symbol must be one character long" -msgstr "«%s» CURSOR no es de 4 o 6 caracteres de longitud" - -#: cobc/parser.y:1358 -#, fuzzy, c-format -msgid "invalid character '%c' in currency symbol" -msgstr "un símbolo monetario trasero" - -#: cobc/parser.y:1374 -msgid "prototype has same name as current function and will be ignored" -msgstr "prototipo tiene el mismo nombre como función actual y será ignorada" - -#: cobc/parser.y:1401 -#, c-format -msgid "duplicate REPOSITORY entries for '%s' do not match" -msgstr "duplicación de asientos de REPOSITORIO para «%s» no coincide" - -#: cobc/parser.y:1405 -#, c-format -msgid "duplicate REPOSITORY entry for '%s'" -msgstr "duplica asiento REPOSITORIO para «%s»" - -#: cobc/parser.y:1470 -#, c-format -msgid "ORGANIZATION %s is incompatible with RECORD DELIMITER" -msgstr "" - -#: cobc/parser.y:1502 -#, c-format -msgid "illegal combination of %s with other clauses" -msgstr "" - -#: cobc/parser.y:1517 cobc/parser.y:1520 cobc/parser.y:1551 -#, c-format -msgid "cannot specify both %s and %s" -msgstr "no puede especificar ambos %s y %s" - -#: cobc/parser.y:1548 -#, c-format -msgid "cannot specify both %s and %s; %s is ignored" -msgstr "no puede especificar ambos %s y %s; %s es ignorado" - -#: cobc/parser.y:1720 -msgid "FOR phrase cannot immediately follow ALL/LEADING/TRAILING" -msgstr "PARA frase no puede seguir inmediatamente TODO/FRENTE/COLA" - -#: cobc/parser.y:1722 -msgid "missing CHARACTERS/ALL/LEADING/TRAILING phrase after FOR phrase" -msgstr "faltando frase CARÃCTER/TODO/FRENTE/COLA tras frase PARA" - -#: cobc/parser.y:1729 -#, fuzzy -msgid "missing value between ALL/LEADING/TRAILING words" -msgstr "faltando valor entre palabras CARACTERES/TODO/CABECERA/COLA" - -#: cobc/parser.y:1734 -msgid "missing FOR phrase before CHARACTERS/ALL/LEADING/TRAILING phrase" -msgstr "faltando frase PARA antes de frase CARACTERES/TODO/CABECERA/COLA" - -#: cobc/parser.y:1741 -msgid "missing ALL/LEADING/TRAILING before value" -msgstr "falta ALL/LEADING/TRAILING antes de valor" - -#: cobc/parser.y:1796 -msgid "use of condition-name in place of data-name" -msgstr "" - -#: cobc/parser.y:1800 cobc/parser.y:6753 cobc/typeck.c:665 -#, fuzzy, c-format -msgid "condition-name not allowed here: '%s'" -msgstr "modificación referencial no permitida aquí" - -#: cobc/parser.y:1827 -msgid "cannot specify NO ADVANCING in screen DISPLAY" -msgstr "no puede especificar NO ADVANCING en pantalla DISPLAY" - -#: cobc/parser.y:1899 cobc/parser.y:1916 -msgid "non-standard DISPLAY" -msgstr "no común DISPLAY" - -#: cobc/parser.y:1903 -msgid "screens may only be displayed on CRT" -msgstr "pantalla quizá solo son enseñadas en CRT" - -#: cobc/parser.y:1908 cobc/parser.y:1951 -msgid "cannot mix screens and fields in the same DISPLAY statement" -msgstr "no puede mezclar pantallas y campos en la misma declaración VISOR" - -#: cobc/parser.y:1912 -msgid "screen clauses may only be used for DISPLAY on CRT" -msgstr "cláusulas apantallada quizá solo se emplea para VISTAS en CRT " - -#: cobc/parser.y:1957 -msgid "ambiguous DISPLAY; put items to display on device in separate DISPLAY" -msgstr "PANTALL ambigua; pero ítemes para pantalla en dispositivo en PANTALA separada" - -#: cobc/parser.y:1973 -#, c-format -msgid "%s is not an alphanumeric literal" -msgstr "%s no es un literal alfanumérico" - -#: cobc/parser.y:1975 -#, c-format -msgid "'%s' is not USAGE DISPLAY" -msgstr "«%s» no es USAGE DISPLAY" - -#: cobc/parser.y:1990 cobc/typeck.c:8481 -#, c-format -msgid "invalid target for %s" -msgstr "invalida objetivo para %s" - -#: cobc/parser.y:1997 cobc/parser.y:6747 -#, fuzzy -msgid "SCREEN item cannot be used here" -msgstr "«%s» no puede ser empleado aquí" - -#: cobc/parser.y:1999 -#, fuzzy -msgid "RENAMES item may not be used here" -msgstr "una constante quizá no está utilizada aquí - «%s»" - -#: cobc/parser.y:2001 cobc/typeck.c:2333 cobc/typeck.c:2429 -msgid "ANY LENGTH item not allowed here" -msgstr "Elemento ANY LENGTH no permitido aquí" - -#: cobc/parser.y:2005 -#, c-format -msgid "item '%s' has wrong class for VALIDATE" -msgstr "" - -#: cobc/parser.y:2014 -#, fuzzy -msgid "WHEN clause must follow EVERY clause" -msgstr "Cláusula de REDEFINES debe seguir nombre de entrada" - -#: cobc/parser.y:2096 cobc/parser.y:17197 -#, fuzzy -msgid "non-zero value expected" -msgstr "valor entero esperado" - -#: cobc/parser.y:2102 cobc/tree.c:4352 -#, fuzzy, c-format -msgid "RECORD size (IDX) exceeds maximum allowed (%d)" -msgstr "RECORD de tamaño excede el máximo permitido (%d)" - -#: cobc/parser.y:2106 cobc/tree.c:4355 -#, c-format -msgid "RECORD size exceeds maximum allowed (%d)" -msgstr "RECORD de tamaño excede el máximo permitido (%d)" - -#: cobc/parser.y:2111 -msgid "RECORD clause invalid" -msgstr "RECORD de cláusula no válido" - -#: cobc/parser.y:3188 -msgid "multiple PROGRAM-ID's without matching END PROGRAM" -msgstr "múltiples PROGRAM-ID sin coincidencia de END PROGRAM" - -#: cobc/parser.y:3191 -msgid "executable requested but no program found" -msgstr "ejecutable solicitado pero ningún programa encontrado" - -#: cobc/parser.y:3408 cobc/parser.y:3417 -msgid "COMMON may only be used in a contained program" -msgstr "COMÚN quizá solo es utilizado dentro de un programa contenido" - -#: cobc/parser.y:3426 cobc/parser.y:3458 -msgid "CALL prototypes" -msgstr "Prototipos CALL" - -#: cobc/parser.y:3607 cobc/parser.y:3884 cobc/parser.y:3928 cobc/parser.y:4036 -#: cobc/parser.y:4223 cobc/parser.y:4319 cobc/parser.y:4360 cobc/parser.y:4431 -#: cobc/parser.y:4452 cobc/parser.y:4531 cobc/parser.y:4550 cobc/parser.y:4566 -#: cobc/parser.y:4584 cobc/parser.y:4602 cobc/parser.y:4619 cobc/parser.y:4637 -#: cobc/parser.y:6868 cobc/parser.y:7694 -#, c-format -msgid "%s not allowed in nested programs" -msgstr "%s no esta permitido en programas anidados" - -#: cobc/parser.y:3761 -msgid "segment-number must be in range of values 1 to 49" -msgstr "segmento-número debe estar dentro del rango de valores de 1 a 49" - -#: cobc/parser.y:3773 -msgid "duplicate CLASSIFICATION clause" -msgstr "duplica cláusula CLASSIFICATION" - -#: cobc/parser.y:3849 -msgid "PROGRAM phrase" -msgstr "PROGRAMA de frase" - -#: cobc/parser.y:3944 cobc/parser.y:3955 cobc/parser.y:4271 -#, c-format -msgid "invalid %s clause" -msgstr "cláusula %s es inválida" - -#: cobc/parser.y:4386 cobc/parser.y:4390 -msgid "CLASS literal with THRU must have size 1" -msgstr "CLASS literal con THRU debe tener un tamaño de 1" - -#: cobc/parser.y:4417 -#, fuzzy -msgid "CLASS IS integer IN alphabet-name" -msgstr "«%s» no es un nombre alfabético" - -#: cobc/parser.y:4464 -msgid "separate currency symbol and currency string" -msgstr "" - -#: cobc/parser.y:4497 -#, c-format -msgid "invalid CURRENCY SIGN '%s'" -msgstr "invalida SIGNO MONETARIO «%s»" - -#: cobc/parser.y:4715 -msgid "cannot use RELATIVE KEY clause on INDEXED files" -msgstr "" - -#: cobc/parser.y:4719 -msgid "cannot use RECORD KEY clause on RELATIVE files" -msgstr "" - -#: cobc/parser.y:4793 -msgid "EXTERNAL/DYNAMIC cannot be used with literals" -msgstr "" - -#: cobc/parser.y:4813 -msgid "EXTERNAL/DYNAMIC cannot be used with USING/VARYING" -msgstr "" - -#: cobc/parser.y:4824 -msgid "EXTERNAL/DYNAMIC cannot be used with DISK FROM" -msgstr "" - -#: cobc/parser.y:4826 -msgid "ASSIGN DISK FROM" -msgstr "" - -#: cobc/parser.y:4942 -msgid "ASSIGN EXTERNAL/DYNAMIC" -msgstr "" - -#: cobc/parser.y:5165 -#, c-format -msgid "'%s' is not an alphabet-name" -msgstr "«%s» no es un nombre alfabético" - -#: cobc/parser.y:5254 -#, c-format -msgid "%s only valid with ORGANIZATION %s" -msgstr "" - -#: cobc/parser.y:5321 cobc/parser.y:5344 -#, fuzzy, c-format -msgid "RECORD DELIMITER %s only allowed with SEQUENTIAL files" -msgstr "MODO DE RECORDATORIO U o S puede solo ser empleado con ficheros REGISTRO SECUENCIAL" - -#: cobc/parser.y:5323 cobc/parser.y:5336 cobc/parser.y:5348 cobc/parser.y:5358 -#, fuzzy -msgid "RECORD DELIMITER clause" -msgstr "Cláusula PROMPT" - -#: cobc/parser.y:5332 -#, fuzzy, c-format -msgid "RECORD DELIMITER %s only allowed with (LINE) SEQUENTIAL files" -msgstr "MODO DE RECORDATORIO U o S puede solo ser empleado con ficheros REGISTRO SECUENCIAL" - -#: cobc/parser.y:5337 -msgid "LINE-SEQUENTIAL phrase" -msgstr "" - -#: cobc/parser.y:5349 -msgid "BINARY-SEQUENTIAL phrase" -msgstr "" - -#: cobc/parser.y:5357 -#, fuzzy -msgid "RECORD DELIMITER clause only allowed with (LINE) SEQUENTIAL files" -msgstr "MODO DE RECORDATORIO U o S puede solo ser empleado con ficheros REGISTRO SECUENCIAL" - -#: cobc/parser.y:5360 -#, c-format -msgid "RECORD DELIMITER %s not recognized; will be ignored" -msgstr "" - -#: cobc/parser.y:5398 -msgid "DUPLICATES for primary keys" -msgstr "" - -#: cobc/parser.y:5637 -msgid "DOS/VS APPLY phrase" -msgstr "" - -#: cobc/parser.y:5752 -msgid "RECORD description missing or invalid" -msgstr "RECORD descrito faltante o no válido" - -#: cobc/parser.y:5778 -#, fuzzy, c-format -msgid "duplicate file description for %s" -msgstr "valores duplicados en clase '%s'" - -#: cobc/parser.y:5811 cobc/parser.y:5821 -msgid "file cannot have both EXTERNAL and GLOBAL clauses" -msgstr "fichero no puede tener ambas cláusulas EXTERNAL y GLOBAL" - -#: cobc/parser.y:5825 cobc/parser.y:6414 cobc/parser.y:6853 cobc/parser.y:12363 -#: cobc/parser.y:15305 -#, c-format -msgid "%s is invalid in a user FUNCTION" -msgstr "%s es no válido en una FUNCIÓN de usuario" - -#: cobc/parser.y:5863 cobc/parser.y:5872 -msgid "RECORD clause ignored for LINE SEQUENTIAL" -msgstr "RECORD de cláusula ignorado para LINE SEQUENTIAL" - -#: cobc/parser.y:5964 -msgid "LINAGE clause with wrong file type" -msgstr "LINAGE de cláusula con tipo de fichero equivocado" - -#: cobc/parser.y:6026 -msgid "RECORDING MODE U or S can only be used with RECORD SEQUENTIAL files" -msgstr "MODO DE RECORDATORIO U o S puede solo ser empleado con ficheros REGISTRO SECUENCIAL" - -#: cobc/parser.y:6059 -#, c-format -msgid "ignoring CODE-SET '%s'" -msgstr "ignorando CODE-SET «%s»" - -#: cobc/parser.y:6070 -msgid "CODE-SET clause invalid for file type" -msgstr "CODE-SET de cláusula invalidada por tipo de fichero" - -#: cobc/parser.y:6092 -msgid "REPORT clause with wrong file type" -msgstr "REPORT clausura con el tipo de fichero equivocado" - -#: cobc/parser.y:6170 -msgid "CD record missing" -msgstr "CD registrado ausente" - -#: cobc/parser.y:6601 -msgid "CONSTANT item not at 01 level" -msgstr "Ãtem CONSTANTE no en el nivel 01" - -#: cobc/parser.y:6721 -#, fuzzy -msgid "REDEFINES clause not following entry-name" -msgstr "Cláusula de REDEFINES debe seguir nombre de entrada" - -#: cobc/parser.y:6743 -#, fuzzy -msgid "SAME AS clause" -msgstr "TAMAÑO de cláusula" - -#: cobc/parser.y:6750 -#, fuzzy -msgid "REPORT item cannot be used here" -msgstr "«%s» no puede ser empleado aquí" - -#: cobc/parser.y:6757 -#, fuzzy -msgid "elementary item expected" -msgstr "valor entero esperado" - -#: cobc/parser.y:6764 -#, fuzzy -msgid "SAME AS item may not reference itself" -msgstr "RENOMBRA quizá no referencia un nivel 88" - -#: cobc/parser.y:6771 -#, fuzzy -msgid "SAME AS item may not be subordinate to any item with USAGE clause" -msgstr "Ãtem THRU «%s» quizá no es subordinado a «%s»" - -#: cobc/parser.y:6773 -#, fuzzy -msgid "SAME AS item may not be subordinate to any item with SIGN clause" -msgstr "Ãtem THRU «%s» quizá no es subordinado a «%s»" - -#: cobc/parser.y:6801 cobc/parser.y:6855 cobc/parser.y:7567 cobc/parser.y:7650 -#: cobc/parser.y:7674 -#, c-format -msgid "%s not allowed here" -msgstr "%s no se permite aquí" - -#: cobc/parser.y:6803 cobc/parser.y:6845 cobc/parser.y:7569 -#, c-format -msgid "%s only allowed at 01/77 level" -msgstr "%s solamente permitido a nivel 01/77" - -#: cobc/parser.y:6805 cobc/parser.y:6847 cobc/parser.y:7571 cobc/parser.y:7654 -#: cobc/parser.y:7676 -#, c-format -msgid "%s requires a data name" -msgstr "%s requiere un nombre de datos" - -#: cobc/parser.y:6958 -msgid "a locale-format PICTURE string must only consist of '9', '.', '+', 'Z' and the currency-sign" -msgstr "" - -#: cobc/parser.y:6992 cobc/typeck.c:3658 -#, fuzzy, c-format -msgid "'%s' is not a locale-name" -msgstr "«%s» no es un nombre local" - -#: cobc/parser.y:7007 -#, fuzzy, c-format -msgid "'%s' is not a valid USAGE" -msgstr "«%s» no es un nombre válido de datos" - -#: cobc/parser.y:7012 -#, fuzzy, c-format -msgid "unknown USAGE: %s" -msgstr "fallo desconocido: %d" - -#: cobc/parser.y:7149 -#, c-format -msgid "unknown HANDLE type: %s" -msgstr "" - -#: cobc/parser.y:7406 cobc/parser.y:7408 -msgid "INDEXED should follow ASCENDING/DESCENDING" -msgstr "INDEXED debería seguir ASCENDIENTE/DESCENDIENTE" - -#: cobc/parser.y:7526 -#, fuzzy -msgid "SYNCHRONIZED clause" -msgstr "TAMAÑO de cláusula" - -#: cobc/parser.y:7529 -msgid "LEFT/RIGHT phrases in SYNCHRONIZED clause" -msgstr "" - -#: cobc/parser.y:7612 -msgid "FALSE clause only allowed for 88 level" -msgstr "FALSE de cláusula solo se permite para nivel 88" - -#: cobc/parser.y:7652 -#, fuzzy, c-format -msgid "%s only allowed at 01 level" -msgstr "%s solamente permitido a nivel 01/77" - -#: cobc/parser.y:7656 cobc/parser.y:7678 -#, c-format -msgid "%s and %s combination not allowed" -msgstr "" - -#: cobc/parser.y:7787 -msgid "GLOBAL is not allowed with RD" -msgstr "GLOBAL no se permite con RD" - -#: cobc/parser.y:8321 -msgid "PLUS is not recommended with LEFT, RIGHT or CENTER" -msgstr "" - -#: cobc/parser.y:8323 -#, fuzzy -msgid "PLUS is not allowed with LEFT, RIGHT or CENTER" -msgstr "GLOBAL no se permite con RD" - -#: cobc/parser.y:8360 cobc/parser.y:8390 -msgid "PLUS is ignored on first field of line" -msgstr "" - -#: cobc/parser.y:8398 -msgid "invalid COLUMN integer; must be > 0" -msgstr "" - -#: cobc/parser.y:8400 -msgid "COLUMN numbers should increase" -msgstr "" - -#: cobc/parser.y:8499 cobc/parser.y:8555 -msgid "INITIAL specified on non-input field" -msgstr "INITIAL especificado en campo no de entrada" - -#: cobc/parser.y:8511 cobc/parser.y:8567 -msgid "relative LINE/COLUMN clause required with OCCURS" -msgstr "clálusula LÃNEA/COLUMNA relativa requerida con OCURRENCIAS" - -#: cobc/parser.y:8669 cobc/parser.y:8673 -msgid "screen positions from data-item" -msgstr "" - -#: cobc/parser.y:9498 -#, fuzzy -msgid "OCCURS screen items" -msgstr "GLOBAL de elementos de pantalla" - -#: cobc/parser.y:9510 -msgid "GLOBAL screen items" -msgstr "GLOBAL de elementos de pantalla" - -#: cobc/parser.y:9554 -msgid "overriding convention specified in ENTRY-CONVENTION" -msgstr "sobrevalorando convención especificada en ENTRY-CONVENTION" - -#: cobc/parser.y:9566 -msgid "executable program requested but PROCEDURE/ENTRY has USING clause" -msgstr "programa ejecutable requerido pero PROCEDURE/ENTRY tiene cláusula USING" - -#: cobc/parser.y:9636 cobc/parser.y:9653 cobc/parser.y:11184 -#, fuzzy, c-format -msgid "number of arguments exceeds maximum %d" -msgstr "número de parámetros excede el máximo %d" - -#: cobc/parser.y:9645 -msgid "CHAINING invalid in user FUNCTION" -msgstr "CHAINING no válido en FUNCTION de usuario" - -#: cobc/parser.y:9692 cobc/parser.y:11261 cobc/parser.y:11270 -#, c-format -msgid "%s not allowed in CHAINED programs" -msgstr "%s no es permitido en programa CHAINED" - -#: cobc/parser.y:9704 cobc/parser.y:9712 cobc/parser.y:9720 cobc/parser.y:9741 -msgid "SIZE only allowed for BY VALUE items" -msgstr "SIZE solamente permitido para elementos BY VALUE" - -#: cobc/parser.y:9743 cobc/parser.y:9760 -msgid "invalid value for SIZE" -msgstr "valor inválido para TAMAÑO" - -#: cobc/parser.y:9775 -msgid "MEMORY SIZE phrase in CALL statement" -msgstr "" - -#: cobc/parser.y:9787 -msgid "OPTIONAL only allowed for BY REFERENCE items" -msgstr "OPTIONAL solo permitido para elementos BY REFERENCE" - -#: cobc/parser.y:9799 -msgid "RETURNING clause is required for a FUNCTION" -msgstr "DEVOLVIENDO cláusula es requerida para una FUNCTION" - -#: cobc/parser.y:9805 -msgid "RETURNING clause cannot be OMITTED for main program" -msgstr "DEVOLVIENDO cláusula no puede ser OMITIDA para programa principal" - -#: cobc/parser.y:9808 -msgid "RETURNING clause cannot be OMITTED for a FUNCTION" -msgstr "DEVOLVIENDO cláusula no puede ser OMITIDA para una FUNCTION" - -#: cobc/parser.y:9821 -msgid "RETURNING item is not defined in LINKAGE SECTION" -msgstr "DEVOLVIENDO ítem no está definido en LINKAGE SECTION" - -#: cobc/parser.y:9823 -msgid "RETURNING item must have level 01" -msgstr "DEVOLVIENDO ítem debe de tener un nivel 01" - -#: cobc/parser.y:9825 -msgid "RETURNING item should not have OCCURS" -msgstr "DEVOLVIENDO ítem no debería tomar OCURRENCIAS" - -#: cobc/parser.y:9829 -msgid "function RETURNING item may not be ANY LENGTH" -msgstr "función RETORNANDO ítem quizá no es CUALQUIER LONGITUD" - -#: cobc/parser.y:10017 -#, c-format -msgid "'%s' is not a statement" -msgstr "«%s» no es una sentencia" - -#: cobc/parser.y:10019 -#, c-format -msgid "unknown statement '%s'; it may exist in another dialect" -msgstr "declaración «%s» desconocida; quizá existe en otro dialecto" - -#: cobc/parser.y:10022 -#, c-format -msgid "unknown statement '%s'" -msgstr "sentencia desconocida «%s»" - -#: cobc/parser.y:10039 -msgid "section segments" -msgstr "" - -#: cobc/parser.y:10041 -msgid "SECTION segment-number must be less than or equal to 99" -msgstr "Número-segmento SECCIÓN debe ser menor que o igual a 99" - -#: cobc/parser.y:10044 -msgid "SECTION segment-number in DECLARATIVES must be less than 50" -msgstr "Número-segmento SECTION dentro de DECLARATIVES deben ser menos de 50" - -#: cobc/parser.y:10052 -msgid "SECTION segment within DECLARATIVES" -msgstr "Segmento SECTION dentro de DECLARATIVES" - -#: cobc/parser.y:10240 cobc/parser.y:10375 -msgid "non-standard ACCEPT" -msgstr "no común para ACEPCIÓN" - -#: cobc/parser.y:10252 -msgid "PROMPT clause" -msgstr "Cláusula PROMPT" - -#: cobc/parser.y:10256 -msgid "SIZE IS clause" -msgstr "TAMAÑO de cláusula" - -#: cobc/parser.y:10471 cobc/parser.y:10763 -msgid "TIME-OUT or BEFORE TIME clauses" -msgstr "Cláusulas TIME-OUT o BEFORE TIME" - -#: cobc/parser.y:10497 cobc/parser.y:10513 cobc/parser.y:10528 -msgid "AT screen-location" -msgstr "AT de ubicación-pantalla" - -#: cobc/parser.y:10529 -msgid "LINE or COLUMN" -msgstr "LÃNEA o COLUMNA" - -#: cobc/parser.y:10893 -msgid "ALLOCATE CHARACTERS requires RETURNING clause" -msgstr "ALLOCATE CHARACTERS requiere cláusula DEVOLVIENDO" - -#: cobc/parser.y:10908 cobc/parser.y:12168 -#, fuzzy, c-format -msgid "ignoring %s phrase" -msgstr "ignorando signo" - -#: cobc/parser.y:10910 -msgid "addressing mode should be either 24 or 31 bit" -msgstr "" - -#: cobc/parser.y:10982 -msgid "recursive program call - assuming RECURSIVE attribute" -msgstr "llamada de programa recursivo - asumiendo atributo RECURSIVO" - -#: cobc/parser.y:11001 -msgid "STATIC CALL convention ignored because of ON EXCEPTION" -msgstr "" - -#: cobc/parser.y:11010 -msgid "ON EXCEPTION ignored because of STATIC CALL" -msgstr "" - -#: cobc/parser.y:11111 cobc/typeck.c:12209 -msgid "invalid mnemonic name" -msgstr "nombre mnemónico inválido" - -#: cobc/parser.y:11131 cobc/parser.y:11428 -msgid "CALL/CANCEL with program-prototype-name" -msgstr "CALL/CANCEL con program-prototype-name" - -#: cobc/parser.y:11135 -msgid "id/literal ignored, using prototype name" -msgstr "id/literal ignorado, utilizando nombre prototipado" - -#: cobc/parser.y:11141 -msgid "NESTED phrase is only valid with literal" -msgstr "ANIDACIÓN de frase es solo válida con literal" - -#: cobc/parser.y:11202 -#, fuzzy -msgid "OMITTED only allowed when arguments are passed BY REFERENCE" -msgstr "OMITIDO solo permitido cuando parámetros son pasados POR REFERENCIA" - -#: cobc/parser.y:11226 -msgid "invalid file name reference" -msgstr "referencia del nombre de fichero inválido" - -#: cobc/parser.y:11234 -#, fuzzy, c-format -msgid "BY CONTENT assumed for alphanumeric item '%s'" -msgstr "BY CONTENT asumido para elementos alfanuméricos" - -#: cobc/parser.y:11239 -#, fuzzy, c-format -msgid "BY CONTENT assumed for national item '%s'" -msgstr "BY CONTENT asumido para elementos alfanuméricos" - -#: cobc/parser.y:11302 -msgid "RETURNING item must have level 01 or 77" -msgstr "DEVOLVIENDO ítem debe tener un nivel 01 o 77" - -#: cobc/parser.y:11306 -msgid "RETURNING item must be a LINKAGE SECTION item or have BASED clause" -msgstr "DEVOLVIENDO ítem debe ser un ítem de LINKAGE SECTION o tener cláusula BASED" - -#: cobc/parser.y:11340 cobc/parser.y:15972 cobc/parser.y:16027 -#: cobc/parser.y:16071 cobc/parser.y:16115 -msgid "NOT EXCEPTION before EXCEPTION" -msgstr "SIN EXCEPCIÓN tras EXCEPCIÓN" - -#: cobc/parser.y:12041 -#, fuzzy, c-format -msgid "HANDLE must be a %s HANDLE" -msgstr "HANDLE debe ser o un manipulador genérico o un THREAD HANDLE" - -#: cobc/parser.y:12053 -#, fuzzy -msgid "HANDLE must be a generic HANDLE" -msgstr "HANDLE debe ser o un manipulador genérico o un THREAD HANDLE" - -#: cobc/parser.y:12130 -#, c-format -msgid "HANDLE clause invalid for %s" -msgstr "HANDLE de cláusula inválida para %s" - -#: cobc/parser.y:12361 cobc/parser.y:15495 -#, c-format -msgid "%s is invalid in nested program" -msgstr "%s es no válido dentro de programas anidados" - -#: cobc/parser.y:12399 cobc/parser.y:12440 cobc/parser.y:12451 -#: cobc/parser.y:12462 -#, c-format -msgid "maximum evaluate depth exceeded (%d)" -msgstr "profundidad de evaluación máxima excedida (%d)" - -#: cobc/parser.y:12503 cobc/parser.y:12513 -msgid "WHEN without imperative statement" -msgstr "" - -#: cobc/parser.y:12531 cobc/parser.y:12541 -msgid "WHEN OTHER without imperative statement" -msgstr "" - -#: cobc/parser.y:12621 -msgid "invalid THROUGH usage" -msgstr "inválido A TRAVÉS DE utilización" - -#: cobc/parser.y:12700 -msgid "EXIT PROGRAM is not allowed within a USE GLOBAL procedure" -msgstr "SALIR PROGRAMA no está permitido dentro de procedimiento de USE GLOBAL" - -#: cobc/parser.y:12704 -msgid "EXIT PROGRAM not allowed within a FUNCTION" -msgstr "SALIR PROGRAMA no está permitido dentro de una FUNCIÓN" - -#: cobc/parser.y:12713 cobc/parser.y:12926 -#, fuzzy -msgid "RETURNING/GIVING not allowed for non-returning runtime elements" -msgstr "RETORNANDO/DANDO no permitido para fuentes no devueltas" - -#: cobc/parser.y:12725 -msgid "EXIT FUNCTION is not allowed within a USE GLOBAL procedure" -msgstr "EXIT FUNCTION no es permitido dentro de procedimiento de USE GLOBAL" - -#: cobc/parser.y:12729 -msgid "EXIT FUNCTION only allowed within a FUNCTION" -msgstr "EXIT FUNCTION solamente permitido dentro de una FUNCTION" - -#: cobc/parser.y:12743 cobc/parser.y:12766 -msgid "EXIT PERFORM is only valid with inline PERFORM" -msgstr "EXIT PERFORM es solamente válido con PERFORM aliniada" - -#: cobc/parser.y:12788 -msgid "EXIT SECTION is only valid with an active SECTION" -msgstr "SALIR SECCIÓN es solamente válido dentro de SECCIÓN activa" - -#: cobc/parser.y:12809 -msgid "EXIT PARAGRAPH is only valid with an active PARAGRAPH" -msgstr "EXIT PARAGRAPH es solamente válido dentro de PARAGRAPH activo" - -#: cobc/parser.y:12956 -msgid "IF without imperative statement" -msgstr "" - -#: cobc/parser.y:13173 -msgid "TALLYING clause is incomplete" -msgstr "TALLYING de cláusula está incompleta" - -#: cobc/parser.y:13289 -msgid "INSPECT missing ALL/FIRST/LEADING/TRAILING" -msgstr "INSPECCIÓN ausente TODO/TIRADOR/ARRASTRE" - -#: cobc/parser.y:13407 -msgid "JSON PARSE" -msgstr "" - -#: cobc/parser.y:13552 -msgid "LOCK clauses" -msgstr "CANDADO de cláusula" - -#: cobc/parser.y:13717 -msgid "inline PERFORM without imperative statement" -msgstr "" - -#: cobc/parser.y:13838 cobc/parser.y:13846 cobc/parser.y:13854 -#, c-format -msgid "PERFORM VARYING '%s' (line %d of %s) is not a numeric field" -msgstr "" - -#: cobc/parser.y:13870 -#, fuzzy -msgid "PERFORM VARYING without BY phrase" -msgstr "ODO sin frase TO" - -#: cobc/parser.y:13910 -#, fuzzy, c-format -msgid "'%s' is not an object-reference" -msgstr "«%s» no es un entero" - -#: cobc/parser.y:13951 cobc/typeck.c:10958 cobc/typeck.c:12100 -msgid "LOCK clause invalid with file LOCK AUTOMATIC" -msgstr "CANDADO de cláusula no válida con fichero CANDADO AUTOMÃTICO" - -#: cobc/parser.y:13956 -msgid "KEY clause invalid with this file type" -msgstr "LLAVE de cláusula no válida con este tipo de fichero" - -#: cobc/parser.y:13961 cobc/typeck.c:10954 cobc/typeck.c:12096 -msgid "INVALID KEY clause invalid with this file type" -msgstr "INVALID KEY de cláusula no válida con este tipo de fichero" - -#: cobc/parser.y:14591 -msgid "file sort requires KEY phrase" -msgstr "ordenación de fichero requiere frase KEY" - -#: cobc/parser.y:14615 -#, fuzzy -msgid "table SORT requires KEY phrase" -msgstr "ordenación de fichero requiere frase KEY" - -#: cobc/parser.y:14677 -msgid "file sort requires USING or INPUT PROCEDURE" -msgstr "ordenación de fichero requiere USING o INPUT PROCEDURE" - -#: cobc/parser.y:14684 -msgid "USING invalid with table SORT" -msgstr "USING no válido con tabla de SORT" - -#: cobc/parser.y:14694 -msgid "INPUT PROCEDURE invalid with table SORT" -msgstr "INPUT PROCEDURE no válido con tabla de SORT" - -#: cobc/parser.y:14696 -msgid "INPUT PROCEDURE invalid with MERGE" -msgstr "INPUT PROCEDURE no válido con MERGE" - -#: cobc/parser.y:14709 -msgid "file sort requires GIVING or OUTPUT PROCEDURE" -msgstr "ordenación de fichero requiere GIVING o OUTPUT PROCEDURE" - -#: cobc/parser.y:14716 -msgid "GIVING invalid with table SORT" -msgstr "DEVOLUCIÓN inválido con tabla SORT" - -#: cobc/parser.y:14726 -msgid "OUTPUT PROCEDURE invalid with table SORT" -msgstr "OUTPUT PROCEDURE no válido con tabla de SORT" - -#: cobc/parser.y:14753 -msgid "SIZE/LENGTH invalid here" -msgstr "SIZE/LENGTH no válido aquí" - -#: cobc/parser.y:14806 -msgid "NOT EQUAL condition not allowed on START statement" -msgstr "NO IGUAL condicionada no permitida sobre declaración INICIAL" - -#: cobc/parser.y:14872 -#, c-format -msgid "%s is replaced by %s" -msgstr "%s es sustituido por %s" - -#: cobc/parser.y:14925 -msgid "STOP literal" -msgstr "DETENCIÓN literal" - -#: cobc/parser.y:14929 -msgid "STOP identifier" -msgstr "DETENCIÓN de identificador" - -#: cobc/parser.y:15066 -msgid "SUPPRESS statement must be within DECLARATIVES" -msgstr "Declaración SUPRIMIDA debe estar dentro de DECLARATIVAS" - -#: cobc/parser.y:15140 -msgid "UNLOCK invalid for SORT files" -msgstr "DESBLOQUEO no válido en ficheros SORT" - -#: cobc/parser.y:15276 cobc/parser.y:15355 -msgid "USE statement must be within DECLARATIVES" -msgstr "Declaración de USE debe de estar dentro de DECLARATIVOS" - -#: cobc/parser.y:15278 -msgid "SECTION header missing before USE statement" -msgstr "SECTION de cabecera ausente antes de declaración de USE" - -#: cobc/parser.y:15357 -msgid "USE DEBUGGING not supported in contained program" -msgstr "USE DEBUGGING no apoyado en contenidos del programa" - -#: cobc/parser.y:15405 cobc/parser.y:15414 cobc/parser.y:15432 -#: cobc/parser.y:15468 cobc/typeck.c:3792 -#, fuzzy, c-format -msgid "duplicate DEBUGGING target: '%s'" -msgstr "directiva DEFINE duplicada «%s»" - -#: cobc/parser.y:15430 -#, fuzzy -msgid "constant item cannot be used here" -msgstr "una constante quizá no está utilizada aquí - «%s»" - -#: cobc/parser.y:15456 -msgid "duplicate USE DEBUGGING ON ALL PROCEDURES" -msgstr "duplicado EMPLEAR DEPURACIÓN EN TODOS LOS PROCEDIMIENTOS" - -#: cobc/parser.y:15528 -#, fuzzy, c-format -msgid "'%s' is not a report group" -msgstr "«%s» no es un nombre de boletín" - -#: cobc/parser.y:15710 -msgid "ENCODING clause must come before XML-DECLARATION" -msgstr "" - -#: cobc/parser.y:15712 -msgid "ENCODING clause must come before ATTRIBUTES" -msgstr "" - -#: cobc/parser.y:15715 -msgid "XML GENERATE ENCODING clause" -msgstr "" - -#: cobc/parser.y:15722 -msgid "XML-DECLARATION clause must come before ATTRIBUTES" -msgstr "" - -#: cobc/parser.y:15725 -msgid "XML GENERATE XML-DECLARATION clause" -msgstr "" - -#: cobc/parser.y:15731 -msgid "XML GENERATE WITH ATTRIBUTES clause" -msgstr "" - -#: cobc/parser.y:15744 -msgid "XML GENERATE NAMESPACE clause" -msgstr "" - -#: cobc/parser.y:15768 -msgid "XML GENERATE NAME OF clause" -msgstr "" - -#: cobc/parser.y:15799 -msgid "XML GENERATE TYPE OF clause" -msgstr "" - -#: cobc/parser.y:15840 -msgid "XML GENERATE SUPPRESS clause" -msgstr "" - -#: cobc/parser.y:15914 -msgid "XML PARSE" -msgstr "" - -#: cobc/parser.y:15955 cobc/parser.y:16633 cobc/parser.y:16729 -#: cobc/parser.y:16815 -#, c-format -msgid "'%s' is not a file name" -msgstr "«%s» no es nombre de fichero" - -#: cobc/parser.y:16161 -msgid "NOT SIZE ERROR before SIZE ERROR" -msgstr "SIN TAMAÑO ERRÓNEO antes de TAMAÑO ERRÓNEO" - -#: cobc/parser.y:16207 -msgid "NOT OVERFLOW before OVERFLOW" -msgstr "NO DESBORDADO antes de DESBORDAMIENTO" - -#: cobc/parser.y:16306 -msgid "NOT AT END-OF-PAGE before AT END-OF-PAGE" -msgstr "NO A FIN-DE-PÃGINA antes que A FIN-DE-PÃGINA" - -#: cobc/parser.y:16356 -msgid "NOT INVALID KEY before INVALID KEY" -msgstr "CLAVE NO INVÃLIDA antes de CLAVE INVÃLIDA" - -#: cobc/parser.y:16619 -msgid "LINAGE-COUNTER must be qualified here" -msgstr "LINAGE-COUNTER debe ser calificado aquí" - -#: cobc/parser.y:16622 -msgid "invalid LINAGE-COUNTER usage" -msgstr "empleo no válido de LINAGE-COUNTER" - -#: cobc/parser.y:16643 -msgid "LINE-COUNTER must be qualified here" -msgstr "LINE-COUNTER debe ser calificado aquí" - -#: cobc/parser.y:16647 -msgid "invalid LINE-COUNTER usage" -msgstr "empleo no válido de LINE-COUNTER" - -#: cobc/parser.y:16658 cobc/parser.y:16683 -#, c-format -msgid "'%s' is not a report name" -msgstr "«%s» no es un nombre de boletín" - -#: cobc/parser.y:16668 -msgid "PAGE-COUNTER must be qualified here" -msgstr "CONTADOR-PAGINADO debe ser cualificado aquí" - -#: cobc/parser.y:16672 -msgid "invalid PAGE-COUNTER usage" -msgstr "empleo no válido de PAGE-COUNTER" - -#: cobc/parser.y:16719 cobc/typeck.c:10919 cobc/typeck.c:11004 -#: cobc/typeck.c:12064 -#, c-format -msgid "%s requires a record name as subject" -msgstr "%s requiere un nombre de registro como sujeto" - -#: cobc/parser.y:16746 -#, c-format -msgid "'%s' not indexed" -msgstr "«%s» no indexado" - -#: cobc/parser.y:16772 cobc/parser.y:16797 -#, c-format -msgid "multiple reference to '%s' " -msgstr "múltiples referencias para «%s» " - -#: cobc/parser.y:16827 -#, c-format -msgid "'%s' is not a CD name" -msgstr "«%s» no es nombre de CD" - -#: cobc/parser.y:16841 -#, fuzzy, c-format -msgid "'%s' is not a valid report name" -msgstr "«%s» no es un nombre de boletín" - -#: cobc/parser.y:17092 -msgid "invalid mnemonic identifier" -msgstr "identificador mnemónico inválido" - -#: cobc/parser.y:17172 -#, fuzzy -msgid "a numeric literal is expected here" -msgstr "un literal no numérico está esperado para «%s»" - -#: cobc/parser.y:17184 cobc/parser.y:17886 -#, fuzzy -msgid "a non-numeric literal is expected here" -msgstr "un literal no numérico está esperado para «%s»" - -#: cobc/parser.y:17357 cobc/typeck.c:6116 cobc/typeck.c:6123 -#, c-format -msgid "'%s' is not numeric" -msgstr "«%s» no es numérico" - -#: cobc/parser.y:17373 -#, c-format -msgid "'%s' is not a field or file" -msgstr "«%s» no es campo o fichero" - -#: cobc/parser.y:17393 cobc/parser.y:17411 -#, c-format -msgid "'%s' is not a field" -msgstr "%s no es un campo" - -#: cobc/parser.y:17533 -#, fuzzy, c-format -msgid "'%s' is not a field or alphabet" -msgstr "«%s» no es campo o fichero" - -#: cobc/parser.y:17559 -#, fuzzy -msgid "a subscripted data-item cannot be used here" -msgstr "«%s» no puede ser empleado aquí" - -#: cobc/parser.y:17609 -#, fuzzy -msgid "unsigned integer value expected" -msgstr "esperado valor positivo sin signo" - -#: cobc/parser.y:17621 cobc/parser.y:17625 cobc/parser.y:17675 -msgid "integer value expected" -msgstr "valor entero esperado" - -#: cobc/parser.y:17630 -msgid "invalid symbolic integer" -msgstr "entero simbólico inválido" - -#: cobc/parser.y:17646 cobc/parser.y:17650 -msgid "unsigned positive integer value expected" -msgstr "esperado valor positivo sin signo" - -#: cobc/parser.y:17679 -msgid "invalid CLASS value" -msgstr "valor CLASS inválido" - -#: cobc/parser.y:17767 -msgid "PHYSICAL argument for LENGTH functions" -msgstr "" - -#: cobc/parser.y:17938 cobc/parser.y:17955 -msgid "cannot specify offset and SYSTEM-OFFSET at the same time" -msgstr "no puede especificar desplazamiento y DESPLAZAMIENTO-SISTEMA al mismo tiempo" - -#: cobc/pplex.l:223 cobc/pplex.l:1739 -msgid "debugging indicator" -msgstr "depurando indicador" - -#: cobc/pplex.l:300 -msgid "ignoring empty directive" -msgstr "ignorando directiva vacía" - -#: cobc/pplex.l:310 cobc/pplex.l:369 -#, c-format -msgid "ignoring invalid directive: '%s'" -msgstr "ignorando directiva inválida: «%s»" - -#: cobc/pplex.l:317 -msgid "ignoring invalid directive" -msgstr "ignorando directiva inválida" - -#: cobc/pplex.l:324 -msgid "VCS directive" -msgstr "Directiva VCS" - -#: cobc/pplex.l:377 cobc/pplex.l:392 -msgid "spurious '$' detected - ignored" -msgstr "'$' espurio detectado - ignorado" - -#: cobc/pplex.l:386 -#, fuzzy, c-format -msgid "ignoring unknown directive: '%s'" -msgstr "ignorando directiva inválida: «%s»" - -#: cobc/pplex.l:398 -msgid "PROCESS statement ignored" -msgstr "Declaración de PROCESS ignorado" - -#: cobc/pplex.l:864 -msgid "IF/ELIF/ELSE directive without matching END-IF" -msgstr "Directiva IF/ELIF/ELSE sin END-IF acompañado" - -#: cobc/pplex.l:981 -#, fuzzy -msgid "file was included here" -msgstr "fichero de configuración incluido aquí" - -#: cobc/pplex.l:1186 -#, c-format -msgid "directive nest depth exceeded: %d" -msgstr "profundidad excedida del nido directivo: %d" - -#: cobc/pplex.l:1204 -msgid "ELSE directive without matching IF/ELIF" -msgstr "Directiva ELSE sin IF/ELIF acompañados" - -#: cobc/pplex.l:1220 -msgid "END-IF directive without matching IF/ELIF/ELSE" -msgstr "Directiva END-IF sin IF/ELIF/ELSE acompañados" - -#: cobc/pplex.l:1236 -msgid "ELIF directive without matching IF/ELIF" -msgstr "Directiva ELIF sin IF/ELIF acompañados" - -#: cobc/pplex.l:1258 -#, c-format -msgid "invalid internal case: %u" -msgstr "caso interno invalido: %u" - -#: cobc/pplex.l:1395 -msgid "buffer overrun - too many continuation lines" -msgstr "desbordamiento de búfer - demasiadas líneas continuadas" - -#: cobc/pplex.l:1485 cobc/pplex.l:1494 -msgid "line not terminated by a newline" -msgstr "línea no terminado por una línea nueva" - -#: cobc/pplex.l:1488 cobc/pplex.l:1497 -#, c-format -msgid "source text exceeds %d bytes, will be truncated" -msgstr "texto origen excede %d bytes, será truncado" - -#: cobc/pplex.l:1516 -msgid "version control conflict marker in file" -msgstr "" - -#: cobc/pplex.l:1727 -msgid "invalid continuation in comment entry" -msgstr "continuación inválida dentro de registro comentado" - -#: cobc/pplex.l:1732 -msgid "continuation of COBOL words" -msgstr "continuación de palabras COBOL" - -#: cobc/pplex.l:1752 -#, c-format -msgid "invalid indicator '%c' at column 7" -msgstr "indicador «%c» inválido en columna 7" - -#: cobc/pplex.l:1800 cobc/pplex.l:1811 -msgid "invalid line continuation" -msgstr "continuación de línea inválida" - -#: cobc/pplex.l:1819 -msgid "continuation character expected" -msgstr "continuación de carácter esperado" - -#: cobc/pplex.l:1885 -#, c-format -msgid "source text after program-text area (column %d)" -msgstr "texto origen tras área de texto-programa (columna %d)" - -#: cobc/ppparse.y:225 -msgid "directive comparison on different types" -msgstr "directriz comparativa sobre tipos diferentes" - -#: cobc/ppparse.y:293 -#, c-format -msgid "duplicate DEFINE directive '%s'" -msgstr "directiva DEFINE duplicada «%s»" - -#: cobc/ppparse.y:300 cobc/ppparse.y:310 -msgid "invalid constant in DEFINE directive" -msgstr "constante invalida dentro de directiva DEFINE" - -#: cobc/ppparse.y:408 -#, c-format -msgid "compiler flag '%s' unknown" -msgstr "" - -#: cobc/ppparse.y:454 -#, fuzzy, c-format -msgid "invalid %s directive option '%s'" -msgstr "invalida %s directiva" - -#: cobc/ppparse.y:667 -msgid "*CONTROL statement" -msgstr "*CONTROL sentencia" - -#: cobc/ppparse.y:933 cobc/ppparse.y:1004 cobc/ppparse.y:1141 -#, c-format -msgid "invalid %s directive" -msgstr "invalida %s directiva" - -#: cobc/ppparse.y:1043 -msgid "LEAP-SECOND ON directive" -msgstr "LEAP-SECOND ON de directiva" - -#: cobc/ppparse.y:1051 -msgid "TURN directive" -msgstr "TURN directiva" - -#: cobc/ppparse.y:1133 cobc/ppparse.y:1158 -msgid "invalid constant" -msgstr "constante inválida" - -#: cobc/reserved.c:3797 -msgid "device name" -msgstr "nombre de disponitivo" - -#: cobc/reserved.c:3800 -msgid "switch name" -msgstr "nombre intercambiado" - -#: cobc/reserved.c:3803 -msgid "feature name" -msgstr "nombre de característica" - -#: cobc/reserved.c:3902 -#, c-format -msgid "reserved word must have less than %d characters" -msgstr "palabra reservada debe tener menos que %d caracteres" - -#: cobc/reserved.c:3921 -msgid "ignored asterisk at end of alias target" -msgstr "ignorado asterisco al final de alias objetivo" - -#: cobc/reserved.c:3984 -#, c-format -msgid "alias target '%s' is not a default reserved word" -msgstr "objetivo alias «%s» no es una palabra reservada predeterminada" - -#: cobc/reserved.c:4447 -#, c-format -msgid "invalid system-name '%s'" -msgstr "nombre-módulo inválido «%s»" - -#: cobc/reserved.c:4584 -#, c-format -msgid "'%s' is a reserved word, but isn't supported" -msgstr "«%s» es una palabra reservada, pero no es compatible" - -#: cobc/reserved.c:4689 -#, c-format -msgid "intrinsic function %s is unknown" -msgstr "función %s intrínseca no es conocida" - -#: cobc/reserved.c:4717 -msgid "Intrinsic Function" -msgstr "Función Intrínseca" - -#: cobc/reserved.c:4717 cobc/reserved.c:4897 cobc/reserved.c:5034 -msgid "Implemented" -msgstr "Implementado" - -#: cobc/reserved.c:4717 cobc/typeck.c:1022 -msgid "Parameters" -msgstr "Parámetros" - -#: cobc/reserved.c:4721 cobc/reserved.c:4901 cobc/reserved.c:5048 -msgid "Yes" -msgstr "Sí" - -#: cobc/reserved.c:4724 cobc/reserved.c:4904 cobc/reserved.c:5054 -msgid "No" -msgstr "No" - -#: cobc/reserved.c:4730 -msgid "Unlimited" -msgstr "Ilimitado" - -#: cobc/reserved.c:4804 -#, fuzzy, c-format -msgid "special register %s is unknown, needs a definition" -msgstr "registro especial %s es desconocido, requiere una definición" - -#: cobc/reserved.c:4810 -#, c-format -msgid "special register %s is unknown" -msgstr "registro especial %s es desconocido" - -#: cobc/reserved.c:4897 -msgid "Internal registers" -msgstr "Registros internos" - -#: cobc/reserved.c:4897 -msgid "Definition" -msgstr "Definición" - -#: cobc/reserved.c:4985 -#, fuzzy, c-format -msgid "unknown system-name '%s'" -msgstr "sentencia desconocida «%s»" - -#: cobc/reserved.c:5011 -msgid "System names" -msgstr "Nombres del sistema" - -#: cobc/reserved.c:5034 -msgid "Reserved Words" -msgstr "Palabras Reservadas" - -#: cobc/reserved.c:5046 -msgid "Yes (Context sensitive)" -msgstr "Sí (Contexto distingue mayúsculas)" - -#: cobc/reserved.c:5052 -msgid "No (Context sensitive)" -msgstr "No (Contexto distinguible de mayúsculas)" - -#: cobc/reserved.c:5081 -msgid "Extra (obsolete) context sensitive words" -msgstr "Contexto adicional (obsoleto) distingue mayúsculas" - -#: cobc/scanner.l:265 cobc/scanner.l:2288 -#, fuzzy, c-format -msgid "'%s' is not a default reserved word, so cannot be aliased" -msgstr "'%s' no está definido, pero es una palabra reservada en otro dialecto" - -#: cobc/scanner.l:268 -#, fuzzy, c-format -msgid "'%s' is not a reserved word; you may want ADDSYN or OVERRIDE instead" -msgstr "«%s» es una palabra reservada, pero no es compatible" - -#: cobc/scanner.l:988 -#, c-format -msgid "a constant may not be used here - '%s'" -msgstr "una constante quizá no está utilizada aquí - «%s»" - -#: cobc/scanner.l:1043 -msgid "ignoring redundant ." -msgstr "ignorando redundante ." - -#: cobc/scanner.l:1101 -#, c-format -msgid "invalid symbol '%s' - skipping word" -msgstr "símbolo no válido: «%s» - omitiendo palabra" - -#: cobc/scanner.l:1191 -msgid "invalid national literal" -msgstr "nacional literal inválido" - -#: cobc/scanner.l:1202 cobc/tree.c:2531 -#, c-format -msgid "invalid literal: '%s'" -msgstr "invalida literal: «%s»" - -#: cobc/scanner.l:1204 -#, c-format -msgid "invalid hexadecimal literal: '%s'" -msgstr "invalida literal hexadecimal: «%s»" - -#: cobc/scanner.l:1206 cobc/tree.c:1613 -#, c-format -msgid "invalid numeric literal: '%s'" -msgstr "invalida literal numérico: «%s»" - -#: cobc/scanner.l:1208 -#, c-format -msgid "invalid floating-point literal: '%s'" -msgstr "coma flotante literal no válida: «%s»" - -#: cobc/scanner.l:1210 -#, c-format -msgid "invalid %s literal: '%s'" -msgstr "invalida %s literal; «%s»" - -#: cobc/scanner.l:1261 -#, c-format -msgid "literal length exceeds %d characters" -msgstr "longitud literal excede %d caracteres" - -#: cobc/scanner.l:1277 cobc/scanner.l:1326 cobc/scanner.l:1620 -#, fuzzy -msgid "zero-length literal" -msgstr "numérico booleano literal" - -#: cobc/scanner.l:1280 -#, fuzzy -msgid "national literal has zero length; a SPACE will be assumed" -msgstr "literal alfanumérica tiene longitud de cero; un ESPACIO será asumido" - -#: cobc/scanner.l:1281 -msgid "alphanumeric literal has zero length; a SPACE will be assumed" -msgstr "literal alfanumérica tiene longitud de cero; un ESPACIO será asumido" - -#: cobc/scanner.l:1293 cobc/scanner.l:1294 cobc/scanner.l:1298 -#: cobc/scanner.l:1365 -msgid "national literal" -msgstr "literal nacinal" - -#: cobc/scanner.l:1297 -#, fuzzy -msgid "national-character literal" -msgstr "literal nacinal" - -#: cobc/scanner.l:1330 -#, fuzzy -msgid "hexadecimal literal has zero length; X'00' will be assumed" -msgstr "literal alfanumérica tiene longitud de cero; un ESPACIO será asumido" - -#: cobc/scanner.l:1349 -msgid "hexadecimal-boolean literal" -msgstr "booleana-hexadecimal literal" - -#: cobc/scanner.l:1356 cobc/scanner.l:1370 cobc/scanner.l:1485 -#: cobc/scanner.l:1544 cobc/scanner.l:1642 cobc/scanner.l:1711 cobc/tree.c:2532 -#, c-format -msgid "literal length %d exceeds %d characters" -msgstr "longitud literal %d excede %d caracteres" - -#: cobc/scanner.l:1362 -msgid "hexadecimal-national literal" -msgstr "nacional-hexadecimal literal" - -#: cobc/scanner.l:1393 cobc/scanner.l:1425 cobc/scanner.l:1560 -#: cobc/scanner.l:1656 cobc/scanner.l:1721 -#, c-format -msgid "literal contains invalid character '%c'" -msgstr "literal contiene carácter no válido «%c»" - -#: cobc/scanner.l:1449 -#, c-format -msgid "literal does not have an even number of digits" -msgstr "literal no tiene un número par de elementos" - -#: cobc/scanner.l:1492 -#, fuzzy, c-format -msgid "%s literals must contain at least one character" -msgstr "literal contiene carácter no válido «%c»" - -#: cobc/scanner.l:1527 cobc/scanner.l:1628 cobc/scanner.l:1702 -msgid "ACUCOBOL numeric literal" -msgstr "ACUCOBOL numérico literal" - -#: cobc/scanner.l:1537 -#, fuzzy -msgid "H literals must contain at least one character" -msgstr "literal contiene carácter no válido «%c»" - -#: cobc/scanner.l:1575 cobc/scanner.l:1667 cobc/scanner.l:1732 -#, c-format -msgid "literal exceeds limit %u" -msgstr "literal excede límite %u" - -#: cobc/scanner.l:1616 -msgid "numeric boolean literal" -msgstr "numérico booleano literal" - -#: cobc/scanner.l:1622 -#, fuzzy -msgid "Boolean literal has zero length; B'0' will be assumed" -msgstr "literal alfanumérica tiene longitud de cero; un ESPACIO será asumido" - -#: cobc/scanner.l:1698 -#, fuzzy -msgid "HP COBOL octal literal" -msgstr "ACUCOBOL numérico literal" - -#: cobc/scanner.l:1810 cobc/tree.c:1624 -#, c-format -msgid "literal length %d exceeds maximum of %d digits" -msgstr "longitud literal %d excede máximo de %d dígitos" - -#: cobc/scanner.l:1816 cobc/tree.c:1629 -#, c-format -msgid "literal length %d exceeds %d digits" -msgstr "longitud literal %d excede %d dígitos" - -#: cobc/scanner.l:1928 cobc/tree.c:3513 -#, fuzzy, c-format -msgid "significand has more than %d digits" -msgstr "significación tiene más de 34 dígitos" - -#: cobc/scanner.l:1933 -#, c-format -msgid "exponent has decimal point" -msgstr "exponente tiene coma decimal" - -#: cobc/scanner.l:1939 cobc/tree.c:3521 -#, c-format -msgid "exponent has more than 4 digits" -msgstr "exponente tiene más que 4 dígitos" - -#: cobc/scanner.l:1969 -#, fuzzy, c-format -msgid "exponent not between -6143 and 6144" -msgstr "exponente no entre -78 y 76" - -#: cobc/scanner.l:1978 -#, c-format -msgid "significand of 0 must be positive" -msgstr "significante de 0 debe ser positivo" - -#: cobc/scanner.l:1983 -#, c-format -msgid "exponent of 0 must be 0" -msgstr "exponente de 0 debe ser 0" - -#: cobc/scanner.l:1988 -#, c-format -msgid "exponent of 0 must be positive" -msgstr "exponente a 0 debe ser positivo" - -#: cobc/scanner.l:2170 -#, c-format -msgid "invalid CONSTANT: %s" -msgstr "invalida CONSTANTE: %s" - -#: cobc/scanner.l:2180 -#, c-format -msgid "invalid alphanumeric CONSTANT: %s" -msgstr "invalida CONSTANTE alfanumérica: %s" - -#: cobc/scanner.l:2184 -#, c-format -msgid "empty alphanumeric CONSTANT: %s" -msgstr "vacía alfanumérico CONSTANTE: %s" - -#: cobc/scanner.l:2201 cobc/scanner.l:2209 cobc/scanner.l:2214 -#, c-format -msgid "invalid numeric CONSTANT: %s" -msgstr "numérico CONSTANTE inválido: %s" - -#: cobc/scanner.l:2291 -#, c-format -msgid "'%s' is already reserved; you may want MAKESYN instead" -msgstr "" - -#: cobc/tree.c:341 -#, c-format -msgid "%s clause is required for file '%s'" -msgstr "Cláusula %s es requerida para el fichero «%s»" - -#: cobc/tree.c:345 -#, c-format -msgid "%s clause is invalid for file '%s' (file type)" -msgstr "Cláusula %s es no válida para un fichero «%s» (tipo de fichero)" - -#: cobc/tree.c:349 -#, c-format -msgid "%s clause is invalid for file '%s'" -msgstr "Cláusula %s es no válida para fichero «%s»" - -#: cobc/tree.c:376 -#, c-format -msgid "FOR item '%s' is a record" -msgstr "Ãtem FOR «%s» es un registro" - -#: cobc/tree.c:385 -#, c-format -msgid "FOR item '%s' is in different record to '%s'" -msgstr "Ãtem FOR «%s» está dentro de registro diferente a «%s»" - -#: cobc/tree.c:394 -#, c-format -msgid "FOR item '%s' is not in a record associated with '%s'" -msgstr "Ãtem FOR «%s» no está dentro de registro asociado con «%s»" - -#: cobc/tree.c:477 -msgid "internal error node" -msgstr "nodo error interno" - -#: cobc/tree.c:479 -msgid "unknown constant" -msgstr "constante desconocido" - -#: cobc/tree.c:639 -#, fuzzy, c-format -msgid "FUNCTION %s has invalid/not supported arguments - tag %d" -msgstr "FUNCTION %s tiene argumentos inválidos/no compatibles - Tag %d" - -#: cobc/tree.c:760 -#, c-format -msgid "invalid date/time function: '%d'" -msgstr "función fecha/hora inválida: «%d»" - -#: cobc/tree.c:798 -#, c-format -msgid "FUNCTION '%s' has invalid date/time format" -msgstr "FUNCTION «%s» tiene formato no válido de fecha/hora" - -#: cobc/tree.c:805 -#, c-format -msgid "FUNCTION '%s' has format in variable" -msgstr "FUNCTION «%s» tiene formato dentro de variable" - -#: cobc/tree.c:1186 -#, fuzzy, c-format -msgid "literal '%s'" -msgstr "invalida literal: «%s»" - -#: cobc/tree.c:1315 -#, c-format -msgid "unknown tree tag: %d, category: %d" -msgstr "etiqueta de árbol desconocida: %d, categoría: %d" - -#: cobc/tree.c:1405 -#, c-format -msgid "unexpected numeric USAGE: %d" -msgstr "inesperada UTILIZACIÓN numérica: %d" - -#: cobc/tree.c:1419 -#, c-format -msgid "unexpected category: %d" -msgstr "categoría inesperada: %d" - -#: cobc/tree.c:1678 cobc/tree.c:1690 cobc/tree.c:1752 cobc/tree.c:1802 -#, c-format -msgid "numeric literal '%s' exceeds limit '%s'" -msgstr "literal numérico |%s» excede límite «%s»" - -#: cobc/tree.c:2387 -msgid "invalid LOCALE literal" -msgstr "invalida LOCALE literal" - -#: cobc/tree.c:2512 -msgid "only literals with the same category can be concatenated" -msgstr "solo literales con misma categoría puede ser concatenado" - -#: cobc/tree.c:2519 -#, fuzzy -msgid "only alphanumeric, national or boolean literals may be concatenated" -msgstr "solo alfanuméricos, nacionales o booleanos literales quizá son concatenados" - -#: cobc/tree.c:2791 -msgid "B, 0 or /" -msgstr "B, 0 o /" - -#: cobc/tree.c:2805 -msgid "the sign of the floating-point exponent" -msgstr "el signo del exponente a coma flotante" - -#: cobc/tree.c:2807 -msgid "a leading +/- sign" -msgstr "un signo +/- delantero" - -#: cobc/tree.c:2809 -msgid "a trailing +/- sign" -msgstr "un signo +/- trasero" - -#: cobc/tree.c:2811 -msgid "CR or DB" -msgstr "CR o DB" - -#: cobc/tree.c:2813 -msgid "a leading currency symbol" -msgstr "un símbolo monetario trasero" - -#: cobc/tree.c:2815 -msgid "a trailing currency symbol" -msgstr "un símbolo monetario trasero" - -#: cobc/tree.c:2817 -msgid "a Z or * which is before the decimal point" -msgstr "una Z o * la cual está después de la coma decimal" - -#: cobc/tree.c:2819 -msgid "a Z or * which is after the decimal point" -msgstr "una Z o * la cual está tras la coma decimal" - -#: cobc/tree.c:2821 -msgid "a floating +/- string which is before the decimal point" -msgstr "una cadena flotante +/- la cual está antes de la coma decimal" - -#: cobc/tree.c:2823 -msgid "a floating +/- string which is after the decimal point" -msgstr "una cadena de reales +/- los cuáles están tras la coma decimal" - -#: cobc/tree.c:2825 -msgid "a floating currency symbol string which is before the decimal point" -msgstr "una cadena simbólica monetaria flotante la cual está después de la coma decimal" - -#: cobc/tree.c:2827 -msgid "a floating currency symbol string which is after the decimal point" -msgstr "una cadena simbólica monetaria flotante la cual está tras la coma decimal" - -#: cobc/tree.c:2831 -msgid "A or X" -msgstr "A o X" - -#: cobc/tree.c:2837 -msgid "a P which is before the decimal point" -msgstr "una P la cual está después de la coma decimal" - -#: cobc/tree.c:2839 -msgid "a P which is after the decimal point" -msgstr "una P la cual está tras la coma decimal" - -#: cobc/tree.c:2860 cobc/tree.c:3267 -#, c-format -msgid "%s may only occur once in a PICTURE string" -msgstr "%s quizá solo ocurre una vez dentro de una cadena PICTURE" - -#: cobc/tree.c:2862 cobc/tree.c:3219 -#, c-format -msgid "%s cannot follow %s" -msgstr "%s no se continuar %s" - -#: cobc/tree.c:2865 -msgid "invalid PICTURE string detected" -msgstr "cadena textual PICTURE inválida detectada" - -#: cobc/tree.c:2976 -msgid "number or constant in parentheses is not an unsigned integer" -msgstr "números o constantes entre paréntesis no es un entero sin signo" - -#: cobc/tree.c:2985 -msgid "only up to 9 significant digits are permitted within parentheses" -msgstr "solo superior a 9 dígitos significantes están permitidos entre paréntesis" - -#: cobc/tree.c:2991 -msgid "number or constant in parentheses must be greater than zero" -msgstr "número o contante en paréntesis debe ser mayor que cero" - -#: cobc/tree.c:3002 -msgid "parentheses must be preceded by a picture symbol" -msgstr "" - -#: cobc/tree.c:3032 -msgid "unbalanced parentheses" -msgstr "paréntesis desequilibrados" - -#: cobc/tree.c:3040 -#, fuzzy -msgid "parentheses must contain an unsigned integer" -msgstr "paréntesis deben contener (un nombre-constante definido como) un entero positiv" - -#: cobc/tree.c:3078 -#, c-format -msgid "'%s' is not a constant-name" -msgstr "«%s» no es nombre de constante" - -#: cobc/tree.c:3085 -#, c-format -msgid "'%s' is not a numeric literal" -msgstr "«%s» no es un literal numérico" - -#: cobc/tree.c:3089 -#, c-format -msgid "'%s' is not an integer" -msgstr "«%s» no es un entero" - -#: cobc/tree.c:3093 -#, c-format -msgid "'%s' is not unsigned" -msgstr "«%s» no es asignada" - -#: cobc/tree.c:3149 -msgid "missing PICTURE string" -msgstr "cadena PICTURE ausente" - -#: cobc/tree.c:3178 -msgid "C must be followed by R" -msgstr "C debe ser seguido por R" - -#: cobc/tree.c:3181 -msgid "D must be followed by B" -msgstr "D debe ser seguido por B" - -#: cobc/tree.c:3195 cobc/tree.c:3264 cobc/tree.c:3290 cobc/tree.c:3401 -#, fuzzy -msgid "uncommon parentheses" -msgstr "paréntesis desequilibrados" - -#: cobc/tree.c:3219 -msgid "exponent" -msgstr "" - -#: cobc/tree.c:3272 -msgid "S must be at start of PICTURE string" -msgstr "S debe estar al inicio de la cadena PICTURE" - -#: cobc/tree.c:3328 -msgid "P must be at start or end of PICTURE string" -msgstr "P debe estar en inicio o final de cadena PICTURE" - -#: cobc/tree.c:3358 -msgid "cannot have both Z and * in PICTURE string" -msgstr "no puede tener ambos Z y * dentro de cadena PICTURE" - -#: cobc/tree.c:3436 -#, c-format -msgid "invalid PICTURE character '%c'" -msgstr "carácter PICTURE no válido «%c»" - -#: cobc/tree.c:3466 -#, c-format -msgid "PICTURE string may not contain more than %d characters; contains %d characters" -msgstr "cadena PICTURE quizá no contiene más de %d caracteres; contiene %d caracteres" - -#: cobc/tree.c:3471 -msgid "PICTURE string must contain at least one of the set A, N, X, Z, 1, 9 and *; or at least two of the set +, - and the currency symbol" -msgstr "cadena PICTURA debe contener al menos uno de los conjuntos A, N, X, Z, 1, 9 y *; o al menos dos del conjunto +, - y el símbolo monetario" - -#: cobc/tree.c:3498 -#, c-format -msgid "numeric field cannot be larger than %d digits" -msgstr "campo numérico no puede ser mayor de %d dígitos" - -#: cobc/tree.c:3954 cobc/tree.c:3967 -#, c-format -msgid "no DETAIL line defined in report %s" -msgstr "" - -#: cobc/tree.c:3969 -msgid "PAGE LIMIT FIRST DETAIL should be >= HEADING" -msgstr "" - -#: cobc/tree.c:3972 -msgid "PAGE LIMIT FOOTING should be >= HEADING" -msgstr "" - -#: cobc/tree.c:3974 -msgid "PAGE LIMIT LAST DETAIL should be >= FIRST DETAIL" -msgstr "" - -#: cobc/tree.c:3976 -msgid "PAGE LIMIT FOOTING should be >= LAST DETAIL" -msgstr "" - -#: cobc/tree.c:3978 -msgid "PAGE LIMIT LINES should be >= FOOTING" -msgstr "" - -#: cobc/tree.c:4162 -#, c-format -msgid "maximum keys (%d/%d) exceeded for file '%s'" -msgstr "" - -#: cobc/tree.c:4226 cobc/tree.c:4249 -#, c-format -msgid "invalid KEY item '%s', not in file '%s'" -msgstr "ítem KEY «%s» inválido, no dentro del fichero «%s»" - -#: cobc/tree.c:4260 -#, c-format -msgid "minimal record length %d can not hold the key item '%s'; needs to be at least %d" -msgstr "longitud de registro mínimo %d puede mantener el elemento clave «%s»; requiere ser al menos %d " - -#: cobc/tree.c:4296 -#, fuzzy, c-format -msgid "missing file description for %s" -msgstr "definiciones ausentes:" - -#: cobc/tree.c:4328 -#, c-format -msgid "size of record '%s' (%d) smaller than minimum of file '%s' (%d)" -msgstr "tamaño de registro «%s» (%d) más pequeño que el mínimo del fichero «%s» (%d)" - -#: cobc/tree.c:4331 cobc/tree.c:4348 -msgid "file size adjusted" -msgstr "" - -#: cobc/tree.c:4343 -#, c-format -msgid "size of record '%s' (%d) larger than maximum of file '%s' (%d)" -msgstr "tamaño de registro «%s» (%d) más largo que el máximo de fichero «%s» (%d)" - -#: cobc/tree.c:4386 -#, c-format -msgid "file '%s': RECORD VARYING specified without limits, but implied limits are equal" -msgstr "" - -#: cobc/tree.c:4393 -#, c-format -msgid "file '%s': record size (IDX) %d exceeds maximum allowed (%d)" -msgstr "fichero «%s»: tamaño de registro (IDX) %d excede el máximo permitido (%d)" - -#: cobc/tree.c:4397 -#, c-format -msgid "file '%s': record size %d exceeds maximum allowed (%d)" -msgstr "fichero «%s»: tamaño de registro %d excede el máximo permitido (%d)" - -#: cobc/tree.c:4404 -msgid "RECORD DELIMITER clause on file with fixed-length records" -msgstr "" - -#: cobc/tree.c:4965 -#, fuzzy, c-format -msgid "literal '%.38s' is longer than '%s'" -msgstr "literal es más largo que campo" - -#: cobc/tree.c:4969 -#, c-format -msgid "literal '%.38s' is longer than reference-modification of '%s'" -msgstr "" - -#: cobc/tree.c:4994 -#, c-format -msgid "literal '%s' is alphanumeric but '%s' is numeric" -msgstr "" - -#: cobc/tree.c:5036 -#, c-format -msgid "literal '%s' has more decimals than '%s'" -msgstr "" - -#: cobc/tree.c:5078 -#, c-format -msgid "literal '%s' has more digits than '%s'" -msgstr "" - -#: cobc/tree.c:5118 cobc/tree.c:5142 -#, fuzzy, c-format -msgid "unsigned '%s' may not be %s %s" -msgstr "Ãtem THRU «%s» quizá no es subordinado a «%s»" - -#: cobc/tree.c:5128 cobc/tree.c:5151 -#, c-format -msgid "unsigned '%s' may always be %s %s" -msgstr "" - -#: cobc/tree.c:5184 cobc/tree.c:5209 -#, fuzzy, c-format -msgid "'%s' may not be %s %s" -msgstr "«%s» no puede ser empleado aquí" - -#: cobc/tree.c:5195 cobc/tree.c:5220 -#, c-format -msgid "'%s' may always be %s %s" -msgstr "" - -#: cobc/tree.c:5355 -msgid "divide by constant ZERO" -msgstr "divide entre constante CERO" - -#: cobc/tree.c:5404 cobc/tree.c:5409 cobc/tree.c:5630 cobc/tree.c:5670 -#: cobc/typeck.c:4476 cobc/typeck.c:4484 cobc/typeck.c:4491 cobc/typeck.c:5561 -#: cobc/typeck.c:5706 -msgid "invalid expression" -msgstr "expresión no válida" - -#: cobc/tree.c:5627 -#, fuzzy, c-format -msgid "invalid expression: %s %s %s" -msgstr "expresión no válida" - -#: cobc/tree.c:5675 -#, c-format -msgid "unexpected operator: %d" -msgstr "operador inesperado: %d" - -#: cobc/tree.c:5685 -#, c-format -msgid "expression '%.38s' %s '%.38s' is always TRUE" -msgstr "expresión '%.38s' %s '%.38s' siempre es TRUE" - -#: cobc/tree.c:5691 -msgid "expression is always TRUE" -msgstr "expresión es siempre VERDADERA" - -#: cobc/tree.c:5703 -#, c-format -msgid "expression '%.38s' %s '%.38s' is always FALSE" -msgstr "expresión '%.38s' %s '%.38s' siempre es FALSA" - -#: cobc/tree.c:5709 -msgid "expression is always FALSE" -msgstr "expresión es siempre FALSA" - -#: cobc/tree.c:6024 -msgid "PERFORM FOREVER since UNTIL is always FALSE" -msgstr "PERFORM FOREVER desde UNTIL siempre es FALSE" - -#: cobc/tree.c:6028 -msgid "PERFORM ONCE since UNTIL is always TRUE" -msgstr "PERFORM ONCE desde UNTIL siempre es TRUE" - -#: cobc/tree.c:6031 -msgid "PERFORM NEVER since UNTIL is always TRUE" -msgstr "PERFORM NEVER desde UNTIL siempre es TRUE" - -#: cobc/tree.c:6132 -#, fuzzy, c-format -msgid "no definition/prototype seen for FUNCTION '%s'" -msgstr "sin definición/prototipo visto para programa «%s»" - -#: cobc/tree.c:6134 -#, fuzzy, c-format -msgid "no definition/prototype seen for PROGRAM '%s'" -msgstr "sin definición/prototipo visto para programa «%s»" - -#: cobc/tree.c:6143 -#, fuzzy, c-format -msgid "no definition/prototype seen for FUNCTION with external name '%s'" -msgstr "ninguna definición/prototipo visto para programa con nombre externo «%s»" - -#: cobc/tree.c:6145 -#, fuzzy, c-format -msgid "no definition/prototype seen for PROGRAM with external name '%s'" -msgstr "ninguna definición/prototipo visto para programa con nombre externo «%s»" - -#: cobc/tree.c:6237 -#, fuzzy, c-format -msgid "FUNCTION %s has invalid argument" -msgstr "FUNCTION «%s» tiene parámetro no válido" - -#: cobc/tree.c:6239 -#, c-format -msgid "either all arguments or none should be if type %s" -msgstr "" - -#: cobc/tree.c:6271 cobc/tree.c:6277 cobc/tree.c:6319 cobc/tree.c:6324 -#, c-format -msgid "FUNCTION '%s' has invalid reference modification" -msgstr "FUNCTION «%s» tiene modificación por referencia no válida" - -#: cobc/tree.c:6288 cobc/tree.c:6730 -#, c-format -msgid "FUNCTION '%s' unknown" -msgstr "FUNCTION «%s» desconocida" - -#: cobc/tree.c:6292 -#, c-format -msgid "FUNCTION '%s' is not implemented" -msgstr "FUNCTION «%s» no está implementada" - -#: cobc/tree.c:6299 cobc/tree.c:6306 cobc/tree.c:6714 -#, c-format -msgid "FUNCTION '%s' has wrong number of arguments" -msgstr "FUNCTION «%s» tiene el número incorrecto de argumentos" - -#: cobc/tree.c:6313 -#, c-format -msgid "FUNCTION '%s' cannot have reference modification" -msgstr "FUNCTION «%s» no puede tener la modificación por referencia" - -#: cobc/tree.c:6572 cobc/tree.c:6646 cobc/tree.c:6652 cobc/tree.c:6660 -#: cobc/tree.c:6668 -#, fuzzy, c-format -msgid "FUNCTION '%s' has invalid argument" -msgstr "FUNCTION «%s» tiene parámetro no válido" - -#: cobc/tree.c:6720 -#, fuzzy, c-format -msgid "FUNCTION '%s' has invalid first argument" -msgstr "FUNCTION «%s» tiene primer parámetro no válido" - -#: cobc/typeck.c:686 -#, fuzzy, c-format -msgid "%s item not allowed here: '%s'" -msgstr "%s no se permite aquí" - -#: cobc/typeck.c:728 -#, c-format -msgid "'%s' is not a group name" -msgstr "«%s» no es nombre de grupo" - -#: cobc/typeck.c:753 -#, c-format -msgid "'%s' is not a numeric name" -msgstr "«%s» no es un nombre numérico" - -#: cobc/typeck.c:782 -#, c-format -msgid "'%s' is not a numeric or numeric-edited name" -msgstr "«%s» no es nombre numérico o editado-numérico" - -#: cobc/typeck.c:835 -#, fuzzy, c-format -msgid "'%s' is Alpha, instead of a numeric value" -msgstr "«%s» no es un valor numérico" - -#: cobc/typeck.c:838 -#, fuzzy, c-format -msgid "'%s' is Alpha Edited, instead of a numeric value" -msgstr "«%s» no es un valor numérico" - -#: cobc/typeck.c:851 -#, c-format -msgid "'%s' is not a numeric value" -msgstr "«%s» no es un valor numérico" - -#: cobc/typeck.c:901 -#, c-format -msgid "'%s' is not an integer value" -msgstr "«%s» no es un valor entero" - -#: cobc/typeck.c:905 -msgid "positive numeric integer is required here" -msgstr "numérico entero positivo está requerido aquí" - -#: cobc/typeck.c:1022 -msgid "System routine" -msgstr "Rutina de sistema" - -#: cobc/typeck.c:1638 libcob/call.c:1069 -#, c-format -msgid "'%s' literal includes leading spaces which are omitted" -msgstr "«%s» literal incluye llevar espacios las cuales son omitidas" - -#: cobc/typeck.c:1642 -#, c-format -msgid "'%s' literal includes trailing spaces which are omitted" -msgstr "«%s» literal incluye llevar espacios las cuales son omitidas" - -#: cobc/typeck.c:1709 -msgid "ON/OFF usage requires a SWITCH name" -msgstr "Uso de ON/OFF requiere el nombre de un SWITCH" - -#: cobc/typeck.c:1727 -#, c-format -msgid "word length exceeds maximum of %d characters: '%s'" -msgstr "longitud de palabra excede el máximo de %d caracteres: «%s»" - -#: cobc/typeck.c:1730 cobc/typeck.c:1733 -#, c-format -msgid "word length exceeds %d characters: '%s'" -msgstr "longitud de palabra excede los %d caracteres: «%s»" - -#: cobc/typeck.c:1810 -#, fuzzy, c-format -msgid "ASSIGN %s interpreted as '%s'" -msgstr "ASSIGN interpretarse en el %s" - -#: cobc/typeck.c:1900 cobc/typeck.c:2067 -#, c-format -msgid "subscript missing for '%s' - defaulting to 1" -msgstr "subíndice faltante para «%s» - por defecto a 1" - -#: cobc/typeck.c:1913 cobc/typeck.c:1992 -#, c-format -msgid "'%s' cannot be reference modified" -msgstr "«%s» no puede ser modificado por referencia" - -#: cobc/typeck.c:1923 cobc/typeck.c:1988 cobc/typeck.c:2256 -#, c-format -msgid "'%s' cannot be subscripted" -msgstr "«%s» no puede ser subíndice" - -#: cobc/typeck.c:1927 cobc/typeck.c:2260 -#, c-format -msgid "'%s' requires one subscript" -msgstr "«%s» requiere un subíndice" - -#: cobc/typeck.c:1930 cobc/typeck.c:2263 -#, c-format -msgid "'%s' requires %d subscripts" -msgstr "«%s» requiere %d subíndices" - -#. TRANSLATORS: This msgid is used when a variable name -#. or label is referenced in a compiler message. -#: cobc/typeck.c:1946 -#, c-format -msgid "'%s'" -msgstr "" - -#: cobc/typeck.c:1948 -#, c-format -msgid "'%s' (accessed by '%s')" -msgstr "«%s» a (accedido por «%s»)" - -#: cobc/typeck.c:2051 -#, c-format -msgid "'%s' has no OCCURS clause" -msgstr "«%s» no tiene cláusula de OCCURS" - -#: cobc/typeck.c:2108 libcob/common.c:3114 -#, c-format -msgid "subscript of '%s' out of bounds: %d" -msgstr "subescritura de «%s» fuera de límites: %d" - -#: cobc/typeck.c:2162 cobc/typeck.c:2172 -#, fuzzy -msgid "offset must be greater than zero" -msgstr "número o contante en paréntesis debe ser mayor que cero" - -#: cobc/typeck.c:2167 cobc/typeck.c:2185 cobc/typeck.c:2204 -#, fuzzy -msgid "length must be greater than zero" -msgstr "número o contante en paréntesis debe ser mayor que cero" - -#: cobc/typeck.c:2175 cobc/typeck.c:2178 libcob/common.c:3136 -#, c-format -msgid "offset of '%s' out of bounds: %d" -msgstr "desplazamiento de «%s» fuera de límite: %d" - -#: cobc/typeck.c:2189 cobc/typeck.c:2193 cobc/typeck.c:2207 cobc/typeck.c:2211 -#: libcob/common.c:3149 -#, c-format -msgid "length of '%s' out of bounds: %d" -msgstr "longitud de «%s» fuera de límites: %d" - -#: cobc/typeck.c:2323 cobc/typeck.c:2407 -msgid "reference modification not allowed here" -msgstr "modificación referencial no permitida aquí" - -#: cobc/typeck.c:2337 cobc/typeck.c:2433 -msgid "88 level item not allowed here" -msgstr "Ãtem del nivel 88 no es permitido aquí" - -#: cobc/typeck.c:2342 -#, c-format -msgid "LENGTH OF '%s' not allowed outside of Procedure Division" -msgstr "" - -#: cobc/typeck.c:2346 cobc/typeck.c:2437 cobc/typeck.c:2445 cobc/typeck.c:2512 -msgid "variable length item not allowed here" -msgstr "ítem de longitud variable no permitido aquí" - -#: cobc/typeck.c:2375 -#, c-format -msgid "'%s' has not been DEFINEd" -msgstr "«%s» no ha sido definido" - -#: cobc/typeck.c:2411 -msgid "only field names allowed here" -msgstr "solo nombres de campo permitidos aquí" - -#: cobc/typeck.c:2422 -#, c-format -msgid "VALUE of '%s': %s target '%s' is invalid" -msgstr "VALOR de «%s»: %s objetivo «%s» no es válido" - -#: cobc/typeck.c:2424 cobc/typeck.c:2494 -msgid "target must be in FILE SECTION or LINKAGE SECTION or have the EXTERNAL clause" -msgstr "objetivo debe estar en SECCIÓN FICHEO o SECCIÓN ENLACE o tener la cláusula EXTERNA" - -#: cobc/typeck.c:2480 cobc/typeck.c:2493 -#, c-format -msgid "VALUE of '%s': %s target is invalid" -msgstr "VALOR de «%s»: objetivo %s no es válido" - -#: cobc/typeck.c:2482 -msgid "no previous data-item found" -msgstr "ningún ítem-datos previo encontrado" - -#: cobc/typeck.c:2667 -#, c-format -msgid "'%s' is not an alphabet name" -msgstr "«%s» no es un nombre de alfabeto" - -#: cobc/typeck.c:2931 -#, c-format -msgid "duplicate character values in alphabet '%s': %s" -msgstr "duplica valores de carácter en alfabeto «%s»: %s" - -#: cobc/typeck.c:2936 -#, c-format -msgid "invalid character values in alphabet '%s', starting at position %d" -msgstr "valores de carácter inválidos en alfabeto «%s», iniciando en posición %d" - -#: cobc/typeck.c:2990 -msgid "invalid ALPHABET name" -msgstr "nombre ALFABÉTICO inválido" - -#: cobc/typeck.c:3054 -#, fuzzy, c-format -msgid "duplicate character values in class '%s'" -msgstr "valores duplicados en clase '%s'" - -#: cobc/typeck.c:3072 -#, c-format -msgid "'%s' is not a locale name" -msgstr "«%s» no es un nombre local" - -#: cobc/typeck.c:3206 -msgid "invalid RECORD DEPENDING item" -msgstr "invalida ítem RECORD DEPENDING" - -#: cobc/typeck.c:3211 -msgid "RECORD DEPENDING must reference a data-item" -msgstr "DEPENDENCIA REGISTRO debe referirse a ítem-dato" - -#: cobc/typeck.c:3234 -#, c-format -msgid "RECORD DEPENDING item '%s' should be defined in WORKING-STORAGE, LOCAL-STORAGE or LINKAGE SECTION" -msgstr "Ãtem RECORD DEPENDING «%s» debería estar definido dentro de sección WORKING-STORAGE, LOCAL-STORAGE O LINKAGE SECTION" - -#: cobc/typeck.c:3247 -#, fuzzy, c-format -msgid "file %s: RELATIVE KEY %s is not numeric" -msgstr "valor dentro de cláusula AT no es numérico" - -#: cobc/typeck.c:3256 -#, c-format -msgid "file %s: RELATIVE KEY %s must be integer" -msgstr "" - -#: cobc/typeck.c:3261 -#, c-format -msgid "file %s: RELATIVE KEY %s must be unsigned" -msgstr "" - -#: cobc/typeck.c:3268 -#, c-format -msgid "file %s: RELATIVE KEY %s cannot have OCCURS" -msgstr "" - -#: cobc/typeck.c:3274 -#, c-format -msgid "RELATIVE KEY %s cannot be in file record belonging to %s" -msgstr "" - -#: cobc/typeck.c:3283 -#, c-format -msgid "file %s: RELATIVE KEY %s declared outside WORKING-STORAGE" -msgstr "" - -#: cobc/typeck.c:3306 cobc/typeck.c:7184 -#, c-format -msgid "'%s' is not a valid data name" -msgstr "«%s» no es un nombre válido de datos" - -#: cobc/typeck.c:3313 -#, fuzzy, c-format -msgid "CRT STATUS item '%s' should be defined in WORKING-STORAGE or LOCAL-STORAGE" -msgstr "Ãtem RECORD DEPENDING «%s» debería estar definido dentro de sección WORKING-STORAGE, LOCAL-STORAGE O LINKAGE SECTION" - -#: cobc/typeck.c:3319 -#, fuzzy, c-format -msgid "'%s' CRT STATUS must have at least 4 digits" -msgstr "«%s» CRT STATUS debe ser de 4 caracteres de longitud" - -#: cobc/typeck.c:3325 -#, c-format -msgid "'%s' CRT STATUS must be 4 characters long" -msgstr "«%s» CRT STATUS debe ser de 4 caracteres de longitud" - -#: cobc/typeck.c:3341 -#, fuzzy, c-format -msgid "variable '%s' will be implicitly defined" -msgstr "«%s» será definido de forma implícita" - -#: cobc/typeck.c:3375 cobc/typeck.c:3438 -msgid "ASSIGN variable" -msgstr "" - -#: cobc/typeck.c:3443 -#, fuzzy, c-format -msgid "ASSIGN data item '%s' is invalid" -msgstr "ASSIGN elementos de datos «%s» no válido" - -#: cobc/typeck.c:3507 -#, c-format -msgid "'%s' CURSOR must be 4 or 6 characters long" -msgstr "«%s» CURSOR no es de 4 o 6 caracteres de longitud" - -#: cobc/typeck.c:3557 cobc/typeck.c:3561 -#, fuzzy, c-format -msgid "%s does not have a fixed location" -msgstr "%s no es un campo" - -#: cobc/typeck.c:3573 -#, fuzzy, c-format -msgid "'%s' cannot have nested OCCURS DEPENDING" -msgstr "«%s» no puede tener OCURRS DEPENDING" - -#: cobc/typeck.c:3587 -#, fuzzy, c-format -msgid "'%s' OCCURS DEPENDING ON field item invalid here" -msgstr "«%s» ítem de campo ODO no válido aquí" - -#: cobc/typeck.c:3595 -#, fuzzy, c-format -msgid "'%s' cannot have OCCURS DEPENDING because of '%s'" -msgstr "«%s» no puede tener OCURRS DEPENDING" - -#: cobc/typeck.c:3607 -#, fuzzy, c-format -msgid "'%s' OCCURS DEPENDING ON item must have GLOBAL attribute" -msgstr "«%s» ítem ODO debe tener atributo GLOBAL" - -#: cobc/typeck.c:3621 -#, c-format -msgid "PASSWORD '%s' for EXTERNAL file '%s' must have EXTERNAL attribute" -msgstr "" - -#: cobc/typeck.c:3644 -#, c-format -msgid "file %s: ASSIGN %s declared outside WORKING-STORAGE" -msgstr "" - -#: cobc/typeck.c:3674 -#, fuzzy, c-format -msgid "duplicate APPLY COMMIT target: '%s'" -msgstr "duplica asiento REPOSITORIO para «%s»" - -#: cobc/typeck.c:3688 -#, fuzzy -msgid "APPLY COMMIT statement invalid for SORT file" -msgstr "Declaracion USE no válida con fichero SORT" - -#: cobc/typeck.c:3691 -#, fuzzy -msgid "APPLY COMMIT statement invalid for REPORT file" -msgstr "Declaracion USE no válida con fichero SORT" - -#: cobc/typeck.c:3698 -#, fuzzy, c-format -msgid "APPLY COMMIT item '%s' should be defined in WORKING-STORAGE or LOCAL-STORAGE" -msgstr "Ãtem RECORD DEPENDING «%s» debería estar definido dentro de sección WORKING-STORAGE, LOCAL-STORAGE O LINKAGE SECTION" - -#: cobc/typeck.c:3712 -#, fuzzy, c-format -msgid "item not allowed here: '%s'" -msgstr "%s no se permite aquí" - -#: cobc/typeck.c:3725 -#, fuzzy, c-format -msgid "%s may not be subscripted" -msgstr "«%s» no puede ser subíndice" - -#: cobc/typeck.c:3729 -#, fuzzy, c-format -msgid "%s may not be reference modified" -msgstr "«%s» no puede ser modificado por referencia" - -#: cobc/typeck.c:3789 -#, c-format -msgid "DEBUGGING target invalid: '%s'" -msgstr "DEBUGGING de objetivo inválido: «%s»" - -#: cobc/typeck.c:3795 -#, fuzzy, c-format -msgid "DEBUGGING target already specified with ALL PROCEDURES: '%s'" -msgstr "DEBUGGING objetivo inválido con ALL PROCEDURES: «%s»" - -#: cobc/typeck.c:3815 -#, fuzzy -msgid "DEBUGGING target" -msgstr "DEBUGGING de objetivo inválido: «%s»" - -#: cobc/typeck.c:3822 -#, c-format -msgid "'%s' is not a valid DEBUGGING target" -msgstr "«%s» no es un objetivo válido de DEBUGGING" - -#: cobc/typeck.c:3860 cobc/typeck.c:3865 -#, c-format -msgid "'%s' is not in DECLARATIVES" -msgstr "«%s» no se encuentra en DECLARATIVES" - -#: cobc/typeck.c:3877 -#, c-format -msgid "invalid reference to '%s' (in DECLARATIVES)" -msgstr "invalida referencia a «%s» (en DECLARATIVAS)" - -#: cobc/typeck.c:3886 -#, c-format -msgid "'%s' is not a procedure name" -msgstr "«%s» no es el nombre de un procedimiento" - -#: cobc/typeck.c:3948 -#, c-format -msgid "LINKAGE item '%s' is not a PROCEDURE USING parameter" -msgstr "Ãtem «%s» LINKAGE no es un parámetro PROCEDURE USING" - -#: cobc/typeck.c:4001 -#, c-format -msgid "'%s' is not an alterable paragraph" -msgstr "«%s» no es un párrafo modificable" - -#: cobc/typeck.c:4604 cobc/typeck.c:4608 -#, c-format -msgid "suggest parentheses around %s within %s" -msgstr "sugiere paréntesis alrededor de %s dentro de %s" - -#: cobc/typeck.c:4616 -#, fuzzy -msgid "invalid conditional expression" -msgstr "expresión no válida" - -#: cobc/typeck.c:4726 -#, c-format -msgid "internal decimal structure size exceeded: %d" -msgstr "tamaño de estructura decimal interna excedido: %d" - -#: cobc/typeck.c:4729 -msgid "Try to minimize the number of parentheses or split into multiple computations." -msgstr "Intenta minimizar el número de paréntess o divide en múltiples cálculos." - -#: cobc/typeck.c:4753 -#, fuzzy, c-format -msgid "more than %d nested expressions" -msgstr "más que %d condiciones anidadas" - -#: cobc/typeck.c:4795 -msgid "precision of result may change with arithmetic-osvs" -msgstr "precisión de resultado quizá cambia con aritmética-osvs" - -#: cobc/typeck.c:4851 -#, c-format -msgid "unexpected operation: %c (%d)" -msgstr "operación no esperada: %c (%d)" - -#: cobc/typeck.c:4856 -#, c-format -msgid "%s operator may be misplaced" -msgstr "operador %s quizá desubicado" - -#: cobc/typeck.c:4926 -msgid "unexpected constant expansion" -msgstr "expansión constante inesperada" - -#: cobc/typeck.c:5747 -#, c-format -msgid "more than %d nested conditions" -msgstr "más que %d condiciones anidadas" - -#: cobc/typeck.c:6104 cobc/typeck.c:6180 -msgid "no CORRESPONDING items found" -msgstr "ningún ítem CORRESPONDING encontrado" - -#: cobc/typeck.c:6252 -msgid "no items to ACCEPT found" -msgstr "" - -#: cobc/typeck.c:6302 -#, fuzzy -msgid "no items to DISPLAY found" -msgstr "tipo no válido para operando DISPLAY" - -#: cobc/typeck.c:6421 -msgid "cannot specify figurative constant ZERO in AT clause" -msgstr "no puedo especificar constante CERO figurativa dentro de cláusula AT" - -#: cobc/typeck.c:6425 -msgid "value in AT clause is not numeric" -msgstr "valor dentro de cláusula AT no es numérico" - -#: cobc/typeck.c:6431 -msgid "value in AT clause must have 4 or 6 digits" -msgstr "valor dentro de cláusula AT debe tener 4 o 6 dígitos" - -#: cobc/typeck.c:6553 -msgid "invalid PROMPT literal" -msgstr "invalida PROMPT literal" - -#: cobc/typeck.c:6558 -msgid "invalid PROMPT identifier" -msgstr "invalida idientificador PROMPT" - -#: cobc/typeck.c:6848 -#, c-format -msgid "'%s' is not an input device" -msgstr "«%s» no es un dispositivo de entrada" - -#: cobc/typeck.c:6878 cobc/typeck.c:8016 -#, c-format -msgid "'%s' is not defined in SPECIAL-NAMES" -msgstr "«%s» no esta definido en SPECIAL-NAMES" - -#: cobc/typeck.c:6883 -#, c-format -msgid "invalid input device '%s'" -msgstr "invalida dispositivo de entrada «%s»" - -#: cobc/typeck.c:6888 cobc/typeck.c:8020 -#, c-format -msgid "unknown device '%s'; it may exist in another dialect" -msgstr "dispositivo «%s» desconocida; quizá existe en otro dialecto" - -#: cobc/typeck.c:6891 cobc/typeck.c:8023 -#, c-format -msgid "unknown device '%s'; not defined in SPECIAL-NAMES" -msgstr "dispositivo desconocido «%s»; no definido en SPECIAL-NAMES" - -#: cobc/typeck.c:6915 -msgid "target of ALLOCATE is not a BASED item" -msgstr "objetivo de ALLOCATE no es un ítem BASED" - -#: cobc/typeck.c:6926 -msgid "target of RETURNING is not a data pointer" -msgstr "objetivo de DEVOLVIENDO no es un puntero de datos" - -#: cobc/typeck.c:6936 cobc/typeck.c:7342 -msgid "amount must be specified as a numeric expression" -msgstr "" - -#: cobc/typeck.c:6949 -msgid "INITIALIZED TO item is not alphanumeric" -msgstr "Ãtem INITIALIZED TO no es alfanumérico" - -#: cobc/typeck.c:7019 -msgid "only alphanumeric FUNCTION types are allowed here" -msgstr "solamente tipos FUNCTION alfanuméricos son permitidos aquí" - -#: cobc/typeck.c:7027 -msgid "invalid RETURNING field" -msgstr "campo DEVOLVIENDO inválido" - -#: cobc/typeck.c:7046 -msgid "STDCALL not available on this platform" -msgstr "STDCALL no disponible en esta plataforma" - -#: cobc/typeck.c:7050 -msgid "STDCALL used on 64-bit Windows platform" -msgstr "STDCALL utilizado en plataforma Windows de 64 bit" - -#: cobc/typeck.c:7055 -msgid "STATIC CALL convention requires a literal program name" -msgstr "Convención STATIC CALL requiere un nombre literal de programa" - -#: cobc/typeck.c:7060 cobc/typeck.c:10632 cobc/typeck.c:11539 -#: cobc/typeck.c:11903 -msgid "HANDLE must be either a generic or a THREAD HANDLE" -msgstr "HANDLE debe ser o un manipulador genérico o un THREAD HANDLE" - -#: cobc/typeck.c:7078 -msgid "numeric literal is negative" -msgstr "literal numérico es negativo" - -#: cobc/typeck.c:7157 -msgid "numeric literal exceeds size limits" -msgstr "literal numérico excede límites del tamaño" - -#: cobc/typeck.c:7175 -#, fuzzy, c-format -msgid "figurative constant %s invalid here" -msgstr "constante figurativa inválido aquí" - -#: cobc/typeck.c:7190 -#, c-format -msgid "'%s' ANY LENGTH item not passed BY REFERENCE" -msgstr "«%s» Ãtem de ANY LENGTH no pasó BY REFERENCE" - -#: cobc/typeck.c:7198 -#, c-format -msgid "'%s' is not a 01 or 77 level item" -msgstr "«%s» no es un ítem de nivel 01 o 77" - -#: cobc/typeck.c:7228 cobc/typeck.c:7233 -#, c-format -msgid "wrong number of CALL parameters for '%s', %d given, %d expected" -msgstr "número equivocado de parámetros en CALL para «%s», dados %d, esperados %d" - -#: cobc/typeck.c:7300 cobc/typeck.c:7374 cobc/typeck.c:7378 cobc/typeck.c:7382 -#: cobc/typeck.c:7412 cobc/typeck.c:10591 cobc/typeck.c:10755 -#: cobc/typeck.c:10944 cobc/typeck.c:10948 cobc/typeck.c:11844 -#: cobc/typeck.c:12087 cobc/typeck.c:12090 -#, c-format -msgid "%s not allowed on %s files" -msgstr "%s no permitida en ficheros de %s" - -#: cobc/typeck.c:7336 -msgid "AFTER phrase in CONTINUE statement" -msgstr "" - -#: cobc/typeck.c:7478 -msgid "positions cannot be specified for main windows" -msgstr "posiciones no pueden ser especificadas para ventanas principales" - -#: cobc/typeck.c:7488 cobc/typeck.c:7491 cobc/typeck.c:7508 -#, fuzzy -msgid "HANDLE must be either a generic or a WINDOW HANDLE or X(10)" -msgstr "HANDLE debe ser o un genérico o un WINDOW HANDLE" - -#: cobc/typeck.c:7617 -#, c-format -msgid "'%s' is an invalid type for DISPLAY operand" -msgstr "«%s» es un tipo no válido de operando DISPLAY" - -#: cobc/typeck.c:7622 -msgid "invalid type for DISPLAY operand" -msgstr "tipo no válido para operando DISPLAY" - -#: cobc/typeck.c:7973 cobc/typeck.c:8006 -#, c-format -msgid "'%s' is not an output device" -msgstr "«%s» no es un dispositivo de salida" - -#: cobc/typeck.c:8109 -msgid "invalid use of 88 level in WHEN expression" -msgstr "empleo inválido de nivel 88 dentro de expresión WHEN" - -#: cobc/typeck.c:8165 -msgid "wrong number of WHEN parameters" -msgstr "número equivocado de parámetros WHEN" - -#: cobc/typeck.c:8244 cobc/typeck.c:8256 -#, c-format -msgid "target %d of FREE is not a BASED data item" -msgstr "objetivo %d de FREE no es un ítem de datos BASED" - -#: cobc/typeck.c:8262 -#, c-format -msgid "target %d of FREE must be a data pointer" -msgstr "objetivo %d de FREE debe ser un puntero de datos" - -#: cobc/typeck.c:8276 -msgid "GO TO without procedure-name" -msgstr "GO TO con múltiples nombres-procedimiento" - -#: cobc/typeck.c:8286 -msgid "GO TO with multiple procedure-names" -msgstr "GO TO con multiples nombres-procedimiento" - -#: cobc/typeck.c:8308 -#, fuzzy -msgid "GO TO ENTRY with multiple entry-names" -msgstr "GO TO con multiples nombres-procedimiento" - -#: cobc/typeck.c:8367 -msgid "invalid INITIALIZE statement" -msgstr "estado INICIALIZAR inválido" - -#: cobc/typeck.c:8443 cobc/typeck.c:8446 -#, c-format -msgid "%s operands differ in size" -msgstr "%s operandos difieren en tamaño" - -#: cobc/typeck.c:8476 -#, c-format -msgid "unexpected clause %d" -msgstr "cláusula inesperada %d" - -#: cobc/typeck.c:8545 cobc/typeck.c:8556 cobc/typeck.c:8567 cobc/typeck.c:8578 -#, c-format -msgid "data name expected before %s" -msgstr "nombre de datos esperado antes de %s" - -#: cobc/typeck.c:8588 -#, c-format -msgid "ALL, LEADING or TRAILING expected before '%s'" -msgstr "ALL, LEADING o TRAILING esperado antes de «%s»" - -#: cobc/typeck.c:8598 -msgid "operand has wrong size" -msgstr "operando tiene tamaño equivocado" - -#: cobc/typeck.c:8669 -#, c-format -msgid "internal register '%s' defined as BINARY-LONG" -msgstr "registro internos «%s» definido como BINARY-LONG" - -#: cobc/typeck.c:8672 cobc/typeck.c:8675 cobc/typeck.c:8678 cobc/typeck.c:8681 -#: cobc/typeck.c:8684 cobc/typeck.c:8687 cobc/typeck.c:8690 cobc/typeck.c:8693 -#: cobc/typeck.c:8696 -#, c-format -msgid "'%s' defined here as USAGE %s" -msgstr "«%s» definido aquí como USAGE %s" - -#: cobc/typeck.c:8699 -#, c-format -msgid "'%s' defined here as PIC %s" -msgstr "«%s» definido aquí como PIC %s" - -#: cobc/typeck.c:8702 -#, c-format -msgid "'%s' defined here as a group of length %d" -msgstr "«%s» definido aquí como un grupo de longitud %d" - -#: cobc/typeck.c:8741 -#, c-format -msgid "value is %s" -msgstr "" - -#: cobc/typeck.c:8745 -#, fuzzy, c-format -msgid "value size is %d" -msgstr "tamaño de valor excede tamaño de datos" - -#: cobc/typeck.c:9022 -msgid "invalid destination for MOVE" -msgstr "invalida destino para MOVE" - -#: cobc/typeck.c:9057 -#, fuzzy -msgid "MOVE of figurative constant SPACE to numeric item" -msgstr "MOVE de constante figurativa a ítem numérico" - -#: cobc/typeck.c:9072 -msgid "MOVE of figurative constant QUOTE to numeric item" -msgstr "MOVE de constante QUOTE figurativa a ítem numérico" - -#: cobc/typeck.c:9077 cobc/typeck.c:9089 -msgid "MOVE of figurative constant to numeric item" -msgstr "MOVE de constante figurativa a ítem numérico" - -#: cobc/typeck.c:9151 -msgid "numeric literal in VALUE clause of numeric-edited item" -msgstr "literal numérico dentro de cláusula VALOR de ítem editado-numérico" - -#: cobc/typeck.c:9176 -msgid "numeric move to ALPHABETIC" -msgstr "movimiento numérico a ALFABÉTICO" - -#: cobc/typeck.c:9188 -msgid "data item not signed" -msgstr "ítem de dato sin signo" - -#: cobc/typeck.c:9191 -msgid "ignoring sign" -msgstr "ignorando signo" - -#: cobc/typeck.c:9503 -msgid "overlapping MOVE may occur and produce unpredictable results" -msgstr "sobreponiendo MOVE quizá ocurre y produce resultados impredecibles" - -#: cobc/typeck.c:9510 -msgid "overlapping MOVE may produce unpredictable results" -msgstr "sobreposicionando MOVE quizá produce resultados impredecibles" - -#: cobc/typeck.c:9643 -msgid "invalid source for MOVE" -msgstr "invalida origen para MOVE" - -#: cobc/typeck.c:9666 -msgid "source is non-numeric - substituting zero" -msgstr "" - -#: cobc/typeck.c:9672 cobc/typeck.c:9683 -msgid "invalid VALUE clause" -msgstr "invalida cláusula VALUE" - -#: cobc/typeck.c:9675 cobc/typeck.c:11480 cobc/typeck.c:11485 -#: cobc/typeck.c:11512 cobc/typeck.c:11517 -msgid "invalid SET statement" -msgstr "invalida sentencia SET" - -#: cobc/typeck.c:9677 -msgid "invalid MOVE statement" -msgstr "invalida sentencia MOVE" - -#: cobc/typeck.c:9684 -msgid "literal exceeds data size" -msgstr "literal excede tamaño de datos" - -#: cobc/typeck.c:9688 -msgid "numeric literal exceeds data size" -msgstr "literal numérico excede tamaño de dato" - -#: cobc/typeck.c:9697 -msgid "MOVE of non-integer to alphanumeric" -msgstr "MOVE de no entero a alfanumérico" - -#: cobc/typeck.c:9703 -msgid "numeric value is expected" -msgstr "valor numérico está esperado" - -#: cobc/typeck.c:9708 -msgid "alphanumeric value is expected" -msgstr "valor alfanumérico es esperado" - -#: cobc/typeck.c:9713 -msgid "value does not fit the picture string" -msgstr "valor no se ajusta a la cadena de dibujo" - -#: cobc/typeck.c:9719 -msgid "value size exceeds data size" -msgstr "tamaño de valor excede tamaño de datos" - -#: cobc/typeck.c:9724 -msgid "sending field larger than receiving field" -msgstr "enviando campo más largo que el campo recibido" - -#: cobc/typeck.c:9729 -msgid "some digits may be truncated" -msgstr "algunos dígitos quizá son truncados" - -#: cobc/typeck.c:10515 -#, c-format -msgid "invalid MOVE target: %s" -msgstr "invalida objetivo MOVE: %s" - -#: cobc/typeck.c:10768 -msgid "READ PREVIOUS not allowed for this file type" -msgstr "READ PREVIOUS no permitido para este tipo de fichero" - -#: cobc/typeck.c:10776 -msgid "KEY ignored with sequential READ" -msgstr "KEY ignorado con READ secuencial" - -#: cobc/typeck.c:10872 -#, fuzzy -msgid "figurative constants not allowed in FROM clause" -msgstr "constante figurativa inválido aquí" - -#: cobc/typeck.c:10879 -msgid "literal in FROM clause must be alphanumeric, national or boolean" -msgstr "" - -#: cobc/typeck.c:10902 cobc/typeck.c:12047 -#, c-format -msgid "%s FILE requires a FROM clause" -msgstr "FICHERO %s requiere una cláusula FROM" - -#: cobc/typeck.c:10924 cobc/typeck.c:11010 cobc/typeck.c:12069 -#, c-format -msgid "%s subject does not refer to a record name" -msgstr "Sujeto a %s no hace referencia a un nombre de registro" - -#: cobc/typeck.c:11016 -msgid "RELEASE not allowed on this record item" -msgstr "RELEASE no permitido en este ítem de registro" - -#: cobc/typeck.c:11097 cobc/typeck.c:11118 cobc/typeck.c:11125 -msgid "invalid SEARCH ALL condition" -msgstr "invalida condición SEARCH ALL" - -#: cobc/typeck.c:11237 cobc/typeck.c:11241 -msgid "SET targets must be PROGRAM-POINTER" -msgstr "SET objetivo debe ser PROGRAM-POINTER" - -#: cobc/typeck.c:11268 cobc/typeck.c:11335 cobc/typeck.c:11403 -#, c-format -msgid "cannot change address of '%s', which is not level 1 or 77" -msgstr "no puede modificar dirección de «%s», la cual no es nivel 1 o 77" - -#: cobc/typeck.c:11272 cobc/typeck.c:11339 cobc/typeck.c:11407 -#, fuzzy, c-format -msgid "cannot change address of '%s', which is not BASED or a LINKAGE item" -msgstr "no puede cambiar dirección de «%s», la cual no está BASADA o un ítem enlazado" - -#: cobc/typeck.c:11291 -#, fuzzy, c-format -msgid "SET target '%s' is not numeric, an INDEX or a POINTER" -msgstr "ESTABLECER objetivo «%s» no es numérico, un índice o un puntero" - -#: cobc/typeck.c:11360 -#, fuzzy, c-format -msgid "SET target '%s' is not a POINTER for FCD" -msgstr "ESTABLECER objetivo «%s» no es numérico, un índice o un puntero" - -#: cobc/typeck.c:11428 -#, c-format -msgid "SET target '%s' is not a POINTER for FCD-KEYDEF" -msgstr "" - -#: cobc/typeck.c:11521 -msgid "field does not have a FALSE clause" -msgstr "campo no tiene una cláusula FALSE" - -#: cobc/typeck.c:11552 -msgid "THREAD-priority must be between 1 and 32767" -msgstr "HILO-prioridad debe estar entre 1 y 32767" - -#: cobc/typeck.c:11572 -msgid "SET ATTRIBUTE requires a screen item as subject" -msgstr "SET ATTRIBUTE requiere un ítem de pantalla como sujeto" - -#: cobc/typeck.c:11578 -msgid "SET ATTRIBUTE subject does not refer to a screen item" -msgstr "SET ATTRIBUTE sujeto no refiere a un ítem de pantalla" - -#: cobc/typeck.c:11629 -msgid "invalid SORT filename" -msgstr "invalida nombre de fichero SORT" - -#: cobc/typeck.c:11689 -msgid "invalid SORT USING parameter" -msgstr "invalida parámetro SORT USING" - -#: cobc/typeck.c:11718 -msgid "invalid SORT GIVING parameter" -msgstr "invalida parámetro SORT GIVING" - -#: cobc/typeck.c:11772 cobc/typeck.c:11799 cobc/typeck.c:11819 -msgid "invalid key item" -msgstr "ítem clave inválido" - -#: cobc/typeck.c:11849 -msgid "LENGTH/SIZE clause only allowed on INDEXED files" -msgstr "LONGITUD/TAMAÑO clausurado solamente permitido en ficheros INDEXADO" - -#: cobc/typeck.c:11854 -msgid "START not allowed with ACCESS MODE RANDOM" -msgstr "INICIO no es permitido con MODO DE ACCESO ALEATORIO" - -#: cobc/typeck.c:12103 -msgid "LOCK clause invalid here" -msgstr "CANDADO clausurado no valida aquí" - -#: cobc/typeck.c:12365 -msgid "data item is not part of a report" -msgstr "" - -#: cobc/typeck.c:12385 -msgid "improper use of SUPPRESS PRINTING" -msgstr "" - -#: cobc/typeck.c:12400 -#, fuzzy, c-format -msgid "%s must be alphanumeric or national" -msgstr "%s no es un literal alfanumérico" - -#: cobc/typeck.c:12411 -#, c-format -msgid "%s may not be a figurative constant" -msgstr "" - -#: cobc/typeck.c:12438 -#, fuzzy, c-format -msgid "%s must be a child of the input record" -msgstr "«%s» y «%s» deben estar dentro del mismo registro" - -#: cobc/typeck.c:12464 -#, c-format -msgid "%s may not be an ignored item in JSON/XML GENERATE" -msgstr "" - -#: cobc/typeck.c:12475 -#, fuzzy, c-format -msgid "%s must be elementary" -msgstr "debe ser numérico" - -#: cobc/typeck.c:12487 -#, fuzzy, c-format -msgid "%s must be USAGE DISPLAY or NATIONAL" -msgstr "ítemes elementarios con cláusula SIGN debe ser USAGE DISPLAY o NATIONAL" - -#: cobc/typeck.c:12501 -#, fuzzy, c-format -msgid "%s must be an integer" -msgstr "«%s» no es un entero" - -#: cobc/typeck.c:12517 cobc/typeck.c:12523 -msgid "JSON/XML GENERATE receiving item" -msgstr "" - -#: cobc/typeck.c:12520 -msgid "JSON/XML GENERATE receiving item may not have JUSTIFIED clause" -msgstr "" - -#: cobc/typeck.c:12608 -#, fuzzy -msgid "JSON/XML GENERATE input record may not be reference modified" -msgstr "«%s» no puede ser modificado por referencia" - -#: cobc/typeck.c:12614 -msgid "JSON/XML GENERATE input record may not have RENAMES clause" -msgstr "" - -#: cobc/typeck.c:12619 -#, c-format -msgid "all the children of '%s' are ignored in JSON/XML GENERATE" -msgstr "" - -#: cobc/typeck.c:12626 -msgid "JSON/XML GENERATE input record has subrecords with non-unique names" -msgstr "" - -#: cobc/typeck.c:12631 -msgid "floating-point items in JSON/XML GENERATE" -msgstr "" - -#: cobc/typeck.c:12635 -msgid "OCCURS items in JSON/XML GENERATE" -msgstr "" - -#: cobc/typeck.c:12660 -msgid "COUNT IN item must be numeric and an integer" -msgstr "" - -#: cobc/typeck.c:12665 -msgid "COUNT IN item must be an integer" -msgstr "" - -#: cobc/typeck.c:12668 -msgid "COUNT IN item may not have PICTURE with P in it" -msgstr "" - -#: cobc/typeck.c:12711 -msgid "NAMESPACE must be a valid URI" -msgstr "" - -#: cobc/typeck.c:12755 -msgid "NAMESPACE-PREFIX must be a valid XML name" -msgstr "" - -#: cobc/typeck.c:12780 cobc/typeck.c:12787 -msgid "NAME OF item" -msgstr "" - -#: cobc/typeck.c:12784 -msgid "NAME OF item must be the input record or a child of it" -msgstr "" - -#: cobc/typeck.c:12791 -msgid "NAME OF name must be a valid XML name" -msgstr "" - -#: cobc/typeck.c:12817 cobc/typeck.c:12818 cobc/typeck.c:12821 -#: cobc/typeck.c:12825 -msgid "TYPE OF item" -msgstr "" - -#: cobc/typeck.c:12843 -msgid "SUPPRESS WHEN SPACE item" -msgstr "" - -#: cobc/typeck.c:12846 -msgid "SUPPRESS WHEN LOW-VALUE item" -msgstr "" - -#: cobc/typeck.c:12848 -msgid "SUPPRESS WHEN HIGH-VALUE item" -msgstr "" - -#: cobc/typeck.c:12877 cobc/typeck.c:12885 cobc/typeck.c:12889 -msgid "SUPPRESS item" -msgstr "" - -#: cobc/typeck.c:12881 -msgid "SUPPRESS item with WHEN clause" -msgstr "" - -#: cobc/typeck.c:12958 -msgid "WITH ATTRIBUTES specified, but no attributes can be generated" -msgstr "" - -#: cobc/warning.def:34 -#, fuzzy -msgid " -Wextra additional warnings only raised with -W or -Wall" -msgstr " -Werror trata todas las advertencias como errores" - -#: cobc/warning.def:37 -#, fuzzy -msgid " -Wno-unfinished do not warn if unfinished features are used" -msgstr "no advierte si no finalizó características son utilizadas" - -#: cobc/warning.def:40 -#, fuzzy -msgid " -Wno-pending do not warn if pending features are mentioned" -msgstr "no advierte si características pendientes son mencionadas" - -#: cobc/warning.def:43 -#, fuzzy -msgid " -Wobsolete warn if obsolete features are used" -msgstr "advierte si se usan características obsoletas" - -#: cobc/warning.def:46 -#, fuzzy -msgid " -Warchaic warn if archaic features are used" -msgstr "advierte si características arcaicas son utilizadas" - -#: cobc/warning.def:49 -#, fuzzy -msgid " -Wredefinition warn about incompatible redefinition of data items" -msgstr "advierte redefinición incompatible de ítemes de datos" - -#: cobc/warning.def:52 -#, fuzzy -msgid " -Wtruncate warn about field truncation from constant assignments" -msgstr "advierte truncación de campo desde asignaciones constantes" - -#: cobc/warning.def:55 -#, fuzzy -msgid " -Wpossible-truncate warn about possible field truncation" -msgstr "advierte posible truncado de campo" - -#: cobc/warning.def:58 -#, fuzzy -msgid " -Woverlap warn about overlapping MOVE of items" -msgstr "advierte ítemes MOVE sobrepuestos" - -#: cobc/warning.def:61 -#, fuzzy -msgid " -Wpossible-overlap warn about MOVE of items that may overlap depending on variables" -msgstr "adverte ítem MOVE que quizá cubre dependiendo de variables" - -#: cobc/warning.def:64 -#, fuzzy -msgid " -Wparentheses warn about lack of parentheses around AND within OR" -msgstr "aviso faltante de paréntesis alrededor de Y dentro de O" - -#: cobc/warning.def:67 -msgid " -Wstrict-typing warn strictly about type mismatch" -msgstr "" - -#: cobc/warning.def:70 -#, fuzzy -msgid " -Wimplicit-define warn about implicitly defined data items" -msgstr "advierte ítemes de datos definidos implícitamente" - -#: cobc/warning.def:73 -#, fuzzy -msgid " -Wcorresponding warn about CORRESPONDING with no matching items" -msgstr "advierte CORRESPONDIENDO con ítemes no coincidentes" - -#: cobc/warning.def:76 -#, fuzzy -msgid " -Winitial-value warn if initial VALUE clause is ignored" -msgstr "advierte cláusula de VALOR inicial ignorada" - -#: cobc/warning.def:79 -#, fuzzy -msgid " -Wprototypes warn about missing FUNCTION prototypes/definitions" -msgstr "advierte prototipos/definiciones de FUNCIÓN" - -#: cobc/warning.def:82 -#, fuzzy -msgid " -Warithmetic-osvs warn if arithmetic expression precision has changed" -msgstr "advierte si preción de expresión aritmética ha modificado" - -#: cobc/warning.def:85 -#, fuzzy -msgid " -Wcall-params warn about non 01/77 items for CALL parameters" -msgstr "advierte elementos no 01/77 para CALL parametrizados" - -#: cobc/warning.def:88 -#, fuzzy -msgid " -Wconstant-expression warn about expressions that always resolve to true/false" -msgstr "advierte expresiones que siempre resuelven a verdad/falsa" - -#: cobc/warning.def:91 -#, fuzzy -msgid " -Wcolumn-overflow warn about text after program-text area, FIXED format" -msgstr "advierte texto tras área de texto programado, formato FIJADO" - -#: cobc/warning.def:94 -#, fuzzy -msgid " -Wterminator warn about lack of scope terminator END-XXX" -msgstr "advierte falta de alcance de terminador END-XXX" - -#: cobc/warning.def:97 -#, fuzzy -msgid " -Wlinkage warn about dangling LINKAGE items" -msgstr "advierte elementos LINKAGE colgados" - -#: cobc/warning.def:100 -msgid " -Wunreachable warn about likely unreachable statements" -msgstr "" - -#: cobc/warning.def:103 -msgid " -Wno-dialect do not warn about dialect specific issues" -msgstr "" - -#: cobc/warning.def:106 -#, fuzzy -msgid " -Wothers do not warn about different issues" -msgstr " -Werror trata todas las advertencias como errores" - -#: cobc/warning.def:109 -msgid " -Wno-unsupported do not warn if runtime does not support a feature used" -msgstr "" - -#: libcob/call.c:87 -#, c-format -msgid "LoadLibrary/GetProcAddress error %d" -msgstr "LoadLibrary/GetProcAddress error %d" - -#: libcob/call.c:939 -msgid "indeterminable error in resolve of COBOL CALL" -msgstr "error indeterminable dentro de resolución de LLAMADA COBOL" - -#: libcob/call.c:1022 -#, c-format -msgid "user-defined FUNCTION '%s' not found" -msgstr "definición de FUNCIÓN usuaria «%s» no encontrada" - -#: libcob/call.c:1129 libcob/call.c:1208 libcob/call.c:1326 libcob/call.c:1354 -#, c-format -msgid "NULL parameter passed to '%s'" -msgstr "Parámetro NULO pasado a «%s»" - -#: libcob/call.c:1204 -#, c-format -msgid "invalid number of arguments passed to '%s'" -msgstr "número inválido de argumentos pasados a «%s»" - -#: libcob/call.c:1330 -msgid "multiple call to 'cob_setjmp'" -msgstr "múltiples llamadas a 'cob_setjmp'" - -#: libcob/call.c:1358 -msgid "call to 'cob_longjmp' with no prior 'cob_setjmp'" -msgstr "llamada a ‘cob_longjmp’ con ninguna proridad ‘cob_setjmp’" - -#: libcob/call.c:1592 libcob/call.c:1633 libcob/call.c:1646 -#: libcob/common.c:7081 -msgid "cob_init() has not been called" -msgstr "cob_init() no ha sido llamado" - -#: libcob/call.c:1598 -#, fuzzy, c-format -msgid "parameter %d is not within range of %d" -msgstr "%s: parámetro %d no está dentro del rango de %d" - -#: libcob/call.c:1604 -#, fuzzy, c-format -msgid "parameter %d is NULL" -msgstr "%s: parámetro %d es NULL" - -#: libcob/call.c:1859 libcob/call.c:1916 -#, fuzzy, c-format -msgid "attempt to over-write constant parameter %d with " -msgstr "%s: intente sobrescribir parámetro contante %d con " - -#: libcob/call.c:1965 -#, fuzzy, c-format -msgid "attempt to over-write constant parameter %d with '%s'" -msgstr "%s: intente sobrescribir parámetro contante %d con «%s»" - -#: libcob/cobgetopt.c:497 -#, c-format -msgid "%s: option '%s' is ambiguous; possibilities:" -msgstr "%s: opción «%s» es ambigua; posibilidades:" - -#: libcob/cobgetopt.c:538 -#, c-format -msgid "%s: option '--%s' doesn't allow an argument" -msgstr "%s: opción '--%s' no admite un argumento" - -#: libcob/cobgetopt.c:545 -#, c-format -msgid "%s: option '%c%s' doesn't allow an argument" -msgstr "%s: opción '%c%s' no admite un argumento" - -#: libcob/cobgetopt.c:565 -#, c-format -msgid "%s: option '--%s' requires an argument" -msgstr "%s: opción '--%s' requiere un argumento" - -#: libcob/cobgetopt.c:597 -#, c-format -msgid "%s: unrecognized option '--%s'" -msgstr "%s: opción no reconocida '--%s'" - -#: libcob/cobgetopt.c:604 -#, c-format -msgid "%s: unrecognized option '%c%s'" -msgstr "%s: opción no reconocida '%c%s'" - -#: libcob/cobgetopt.c:633 -#, c-format -msgid "%s: invalid option -- %c" -msgstr "%s: opción no válida -- %c" - -#: libcob/cobgetopt.c:664 libcob/cobgetopt.c:805 -#, c-format -msgid "%s: option requires an argument -- %c" -msgstr "%s: la opción requiere un argumento -- %c" - -#: libcob/cobgetopt.c:714 -#, c-format -msgid "%s: option '-W %s' is ambiguous" -msgstr "%s: opción '-W %s' es ambigua" - -#: libcob/cobgetopt.c:736 -#, c-format -msgid "%s: option '-W %s' doesn't allow an argument" -msgstr "%s: opción '-W %s' no admite un argumento" - -#: libcob/cobgetopt.c:754 -#, c-format -msgid "%s: option '%s' requires an argument" -msgstr "%s: la opción «%s» requiere un argumento" - -#: libcob/common.c:793 -#, c-format -msgid "attempt to reference unallocated memory" -msgstr "trata referenciar memoria no asignada" - -#: libcob/common.c:798 -#, c-format -msgid "bus error" -msgstr "error de bus" - -#: libcob/common.c:803 -#, c-format -msgid "fatal arithmetic error" -msgstr "" - -#: libcob/common.c:807 -#, c-format -msgid "caught signal" -msgstr "señal obtenida" - -#: libcob/common.c:811 -#, c-format -msgid "signal %s" -msgstr "señal %s" - -#: libcob/common.c:817 -#, c-format -msgid "abnormal termination - file contents may be incorrect" -msgstr "terminación anormal - contenidos de fichero quizá son incorrectos" - -#: libcob/common.c:2049 -msgid "NULL field" -msgstr "" - -#: libcob/common.c:2059 -msgid "field with NULL address" -msgstr "" - -#: libcob/common.c:2345 -#, fuzzy -msgid "version mismatch" -msgstr "error: versión no coincide" - -#: libcob/common.c:2346 libcob/common.c:2348 -#, fuzzy, c-format -msgid "%s has version %s.%d" -msgstr "%s tiene versión/nivel de parche %s/%d" - -#: libcob/common.c:2358 -#, fuzzy, c-format -msgid "CALL to %s requires %d arguments" -msgstr "CALL para %s requiere %d parámetros" - -#: libcob/common.c:2980 -#, c-format -msgid "BASED/LINKAGE item %s has NULL address" -msgstr "BASED/LINKAGE ítem %s tiene dirección NULA" - -#: libcob/common.c:2992 libcob/common.c:2995 -#, c-format -msgid "LINKAGE item %s not passed by caller" -msgstr "LINKAGE %s de ítem no pasado por llamador" - -#: libcob/common.c:3081 -#, fuzzy, c-format -msgid "'%s' (Type: %s) not numeric: '%s'" -msgstr "«%s» no es numerico: «%s»" - -#: libcob/common.c:3096 -#, c-format -msgid "OCCURS DEPENDING ON '%s' out of bounds: %d" -msgstr "OCCURS DEPENDING ON «%s» fuera de límites: %d" - -#: libcob/common.c:3099 libcob/common.c:3120 -#, c-format -msgid "maximum subscript for '%s': %d" -msgstr "subcadena máxima para «%s»: %d" - -#: libcob/common.c:3101 -#, c-format -msgid "minimum subscript for '%s': %d" -msgstr "subscript mínimo para «%s»: %d" - -#: libcob/common.c:3117 -#, c-format -msgid "current maximum subscript for '%s': %d" -msgstr "subcadena máxima actual para «%s»: %d" - -#: libcob/common.c:3139 -#, fuzzy, c-format -msgid "offset of '%s' out of bounds: %d, maximum: %d" -msgstr "desplazamiento de «%s» fuera de límite: %d" - -#: libcob/common.c:3152 -#, fuzzy, c-format -msgid "length of '%s' out of bounds: %d, maximum: %d" -msgstr "longitud de «%s» fuera de límites: %d" - -#: libcob/common.c:3161 -#, fuzzy, c-format -msgid "length of '%s' out of bounds: %d, starting at: %d, maximum: %d" -msgstr "longitud de «%s» fuera de límites: %d" - -#: libcob/common.c:3176 libcob/common.c:3181 -#, c-format -msgid "EXTERNAL item '%s' previously allocated with size %d, requested size is %d" -msgstr "Ãtem EXTERNAL «%s» previamente asignado con tamaño %d, tamaño pedido es %d" - -#: libcob/common.c:3682 -#, c-format -msgid "COB_CURRENT_DATE '%s' is invalid" -msgstr "COB_CURRENT_DATE «%s» es inválido" - -#: libcob/common.c:4585 -#, c-format -msgid "parameter to SYSTEM call is larger than %d characters" -msgstr "parámetro para llamada SYSTEM es mayor de %d caracteres" - -#: libcob/common.c:5195 -#, fuzzy, c-format -msgid "error '%s' during CBL_GC_FORK" -msgstr "Error «%s» durante CBL_GC_FORK" - -#: libcob/common.c:5200 libcob/common.c:5297 -#, c-format -msgid "'%s' is not supported on this platform" -msgstr "«%s» no es compatible en esta plataforma" - -#: libcob/common.c:5226 -#, c-format -msgid "error '%s' for P%d during CBL_GC_WAITPID" -msgstr "error «%s» para P%d durante CBL_GC_WAITID" - -#: libcob/common.c:5418 -msgid "Call to CBL_GC_GETOPT with wrong longoption size." -msgstr "Llama a CBL_GC_GETOPT con tamaño longoption equivocado." - -#: libcob/common.c:5423 -msgid "Call to CBL_GC_GETOPT with missing longind." -msgstr "Llama a CBL_GC_GETOPT con longind ausente." - -#: libcob/common.c:5837 libcob/common.c:5858 libcob/common.c:5871 -#: libcob/common.c:7785 -#, fuzzy, c-format -msgid "(default)" -msgstr " (predeterminado)" - -#: libcob/common.c:6119 libcob/common.c:6138 -msgid "should be unsigned" -msgstr "" - -#: libcob/common.c:6127 libcob/common.c:6176 -#, fuzzy -msgid "should be numeric" -msgstr "debe ser numérico" - -#: libcob/common.c:6185 -#, c-format -msgid "minimum value: %lu" -msgstr "valor mínimo: %lu" - -#: libcob/common.c:6236 libcob/common.c:6787 libcob/common.c:6801 -#, c-format -msgid "should not contain '%c'" -msgstr "debería no contener «%c»" - -#: libcob/common.c:6316 libcob/common.c:6384 libcob/common.c:6393 -#: libcob/common.c:6401 -#, c-format -msgid "not set" -msgstr "" - -#: libcob/common.c:6376 libcob/common.c:6379 libcob/common.c:6382 -#, fuzzy, c-format -msgid "set by %s" -msgstr " (establecer para %s)" - -#: libcob/common.c:6516 -#, c-format -msgid "WARNING - '%s' without a value - ignored!" -msgstr "CUIDADO - «%s» sin un valor - ¡ignorado!" - -#: libcob/common.c:6519 -#, c-format -msgid "'%s' without a value!" -msgstr "¡«%s» sin un valor!" - -#: libcob/common.c:6545 -#, c-format -msgid "WARNING - '%s %s' without a value - ignored!" -msgstr "CUIDADO - «%s %s» sin un valor - ¡ignorado!" - -#: libcob/common.c:7034 -#, fuzzy -msgid "error" -msgstr "error: " - -#: libcob/common.c:7064 -msgid "attempt to CANCEL active program" -msgstr "intento CANCELAR programa activo" - -#: libcob/common.c:7091 -msgid "CALL of program with CHAINING clause" -msgstr "CALL de programa con cláusula CHAINING" - -#: libcob/common.c:7095 -msgid "stack overflow, possible PERFORM depth exceeded" -msgstr "desbordamiento de pila, posible profundidad excedida de PERFORM" - -#: libcob/common.c:7100 -msgid "invalid entry/exit in GLOBAL USE procedure" -msgstr "invalida registro/salida en procedimiento GLOBAL USE" - -#: libcob/common.c:7105 -msgid "unable to allocate memory" -msgstr "incapaz de asignar memoria" - -#: libcob/common.c:7110 -msgid "invalid entry into module" -msgstr "registro inválido dentro del módulo" - -#: libcob/common.c:7115 -#, c-format -msgid "recursive CALL from %s to %s which is NOT RECURSIVE" -msgstr "" - -#: libcob/common.c:7125 -#, fuzzy -msgid "divide by ZERO" -msgstr "divide entre constante CERO" - -#: libcob/common.c:7132 -msgid "end of file" -msgstr "final del fichero" - -#: libcob/common.c:7135 -msgid "key out of range" -msgstr "clave fuera de rango" - -#: libcob/common.c:7138 -msgid "key order not ascending" -msgstr "orden de clave no es ascendente" - -#: libcob/common.c:7141 -msgid "record key already exists" -msgstr "clave de registro ya existe" - -#: libcob/common.c:7144 -msgid "record key does not exist" -msgstr "clave de registro no existe" - -#: libcob/common.c:7147 -msgid "permanent file error" -msgstr "error permanente de fichero" - -#: libcob/common.c:7150 -#, fuzzy -msgid "inconsistant file name" -msgstr "configuración del nombre de fichero inválido" - -#: libcob/common.c:7153 -msgid "file does not exist" -msgstr "fichero no existente" - -#: libcob/common.c:7156 -msgid "permission denied" -msgstr "permiso denegado" - -#: libcob/common.c:7159 -msgid "file already open" -msgstr "fichero ya abierto" - -#: libcob/common.c:7162 -msgid "file not open" -msgstr "fichero no abierto" - -#: libcob/common.c:7165 -msgid "READ must be executed first" -msgstr "READ debe ser ejecutada primero" - -#: libcob/common.c:7168 -msgid "record overflow" -msgstr "desbordamiento de registro" - -#: libcob/common.c:7171 -#, fuzzy -msgid "READ after unsuccessful READ/START" -msgstr "READ tras READ/START no obtenido" - -#: libcob/common.c:7174 -msgid "READ/START not allowed, file not open for input" -msgstr "READ/START no son permitidos, fichero no abierto para entrada" - -#: libcob/common.c:7177 -msgid "WRITE not allowed, file not open for output" -msgstr "ESCRITURA no permitida, fichero no abierto para salida" - -#: libcob/common.c:7180 -msgid "DELETE/REWRITE not allowed, file not open for I-O" -msgstr "DELETE/REWRITE no permitidos, fichero no abre para E/S" - -#: libcob/common.c:7183 -msgid "record locked by another file connector" -msgstr "registro bloqueado por otro conector de fichero" - -#: libcob/common.c:7186 -msgid "LINAGE values invalid" -msgstr "LINAGE de valores no válidos" - -#: libcob/common.c:7189 -msgid "file sharing conflict" -msgstr "conflicto de compartición de fichero" - -#: libcob/common.c:7193 -msgid "runtime library is not configured for this operation" -msgstr "biblioteca de tiempo de ejecución no está configurado para esta operación" - -#: libcob/common.c:7198 -msgid "unknown file error" -msgstr "error de fichero desconocido" - -#: libcob/common.c:7205 -#, fuzzy, c-format -msgid "%s (status = %02d) for file %s" -msgstr "%s (estado = %02d) fichero: «%s»" - -#: libcob/common.c:7208 -#, fuzzy, c-format -msgid "%s (status = %02d) for file %s on %s" -msgstr "%s (estado = %02d) fichero: «%s»" - -#: libcob/common.c:7215 -msgid "attempt to use non-implemented function" -msgstr "intento de usar función no implementada" - -#: libcob/common.c:7218 -#, fuzzy -msgid "attempt to use non-implemented XML I/O" -msgstr "intento de usar función no implementada" - -#: libcob/common.c:7221 -#, fuzzy -msgid "attempt to use non-implemented JSON I/O" -msgstr "intento de usar función no implementada" - -#: libcob/common.c:7268 -msgid "environment variables" -msgstr "variables de entorno" - -#: libcob/common.c:7315 -msgid "License LGPLv3+: GNU LGPL version 3 or later " -msgstr "Licencia LGPLv3+: GNU LGPL versión 3 o posterior " - -#: libcob/common.c:7372 libcob/common.c:7374 -msgid "dynamic loading" -msgstr "carga dinámica" - -#: libcob/common.c:7379 -msgid "enabled" -msgstr "activado" - -#: libcob/common.c:7460 libcob/common.c:7577 libcob/common.c:7586 -#: libcob/common.c:7603 libcob/common.c:7618 -#, fuzzy, c-format -msgid "%s, version %d.%d.%d" -msgstr "Versión C %s%s" - -#: libcob/common.c:7462 libcob/common.c:7579 libcob/common.c:7588 -#: libcob/common.c:7620 -#, c-format -msgid "%s, version %d.%d.%d (compiled with %d.%d)" -msgstr "" - -#: libcob/common.c:7465 -#, fuzzy, c-format -msgid "%s, version %s" -msgstr "Versión C %s%s" - -#: libcob/common.c:7486 libcob/common.c:7488 libcob/common.c:7493 -#: libcob/common.c:7495 libcob/common.c:7498 -#, fuzzy -msgid "mouse support" -msgstr "" - -#: libcob/common.c:7636 -msgid "CALL configuration" -msgstr "Configuración de CALL" - -#: libcob/common.c:7637 -msgid "File I/O configuration" -msgstr "Configuración de fichero de E/S" - -#: libcob/common.c:7638 -msgid "Screen I/O configuration" -msgstr "Configuración de E/S de pantalla" - -#: libcob/common.c:7639 -msgid "Miscellaneous" -msgstr "Varias" - -#: libcob/common.c:7640 -msgid "System configuration" -msgstr "Configuración del sistema" - -#: libcob/common.c:7644 -msgid "runtime configuration" -msgstr "configuración de tiempo de ejecución" - -#: libcob/common.c:7646 -msgid "via" -msgstr "via" - -#: libcob/common.c:7719 libcob/common.c:7747 -msgid "... removed from environment" -msgstr "… quitado desde entorno" - -#: libcob/common.c:7773 libcob/common.c:7775 -#, fuzzy, c-format -msgid "(set by %s)" -msgstr " (establecer para %s)" - -#: libcob/common.c:7783 -#, fuzzy, c-format -msgid "(reset)" -msgstr " (restablecer)" - -#: libcob/common.c:8167 libcob/common.c:8286 -#, c-format -msgid "%s called with unknown option: %d" -msgstr "" - -#: libcob/common.c:8239 -#, c-format -msgid "Module dump due to %s\n" -msgstr "" - -#: libcob/common.c:8243 -#, fuzzy, c-format -msgid " Last statement of %s was Line %d of %s\n" -msgstr "%s declaración no terminada por %s" - -#: libcob/common.c:8249 -#, fuzzy, c-format -msgid " Last statement of %s unknown\n" -msgstr "nombre del sistema %s es desconocido" - -#: libcob/common.c:8259 -#, c-format -msgid "Dump Program-Id %s from %s compiled %s\n" -msgstr "" - -#: libcob/fileio.c:287 -#, c-format -msgid "ERROR I/O routine %s is not present" -msgstr "" - -#: libcob/fileio.c:1365 -#, c-format -msgid "I/O routine %s is not present for %s" -msgstr "" - -#: libcob/fileio.c:1404 -#, c-format -msgid "I/O routine %s is not known for %s" -msgstr "" - -#: libcob/fileio.c:2599 -#, c-format -msgid "ERROR FILE %s has record size %d exceeds %d in program" -msgstr "" - -#: libcob/fileio.c:2967 libcob/fileio.c:2974 -#, c-format -msgid "ERROR FILE %s opening pipe" -msgstr "" - -#: libcob/fileio.c:4979 -#, c-format -msgid "ERROR FILE %s does not match current version; Recompile the program" -msgstr "" - -#: libcob/fileio.c:5034 -#, c-format -msgid "ERROR FILE %s has ASSIGN field is NULL" -msgstr "" - -#: libcob/fileio.c:5707 -#, c-format -msgid "call to CBL_OPEN_FILE with wrong access mode: %d" -msgstr "llama a CBL_OPEN_FILE con modo de acceso equivocado: %d" - -#: libcob/fileio.c:5756 -#, c-format -msgid "call to CBL_CREATE_FILE with wrong file_lock: %d" -msgstr "llama a CBL_CREATE_FILE con fichero file_lock equivocado: %d" - -#: libcob/fileio.c:5759 -#, c-format -msgid "call to CBL_CREATE_FILE with wrong file_dev: %d" -msgstr "llama a CBL_CREATE_FILE con fichero equivocado file_dev: %d" - -#: libcob/fileio.c:5955 libcob/fileio.c:6215 -#, c-format -msgid "'%s' - File detail area is too short" -msgstr "«%s» - de detalle de fichero es demasiada corta" - -#: libcob/fileio.c:6437 -msgid "SORT is unable to acquire temporary file" -msgstr "SORT es incapaz para obtener fichero temporalmente" - -#: libcob/fileio.c:7057 -#, fuzzy, c-format -msgid "implicit CLOSE of %s" -msgstr "implicita cierre CLOSE de %s ('%s')" - -#: libcob/fileio.c:7165 -#, c-format -msgid "C-ISAM library %s is not present" -msgstr "" - -#: libcob/fileio.c:7173 -#, c-format -msgid "D-ISAM library %s is not present" -msgstr "" - -#: libcob/fileio.c:7181 -#, c-format -msgid "VB-ISAM library %s is not present" -msgstr "" - -#: libcob/screenio.c:429 -msgid "failed to initialize curses" -msgstr "fallado al inicializar cursores" - -#: libcob/screenio.c:3591 -msgid "end of program, please press a key to exit" -msgstr "final de programa, presione una tecla para salir" - -#: libcob/termio.c:70 libcob/termio.c:106 -msgid "(Not representable)" -msgstr "(No representable)" - -#: libcob/termio.c:347 -#, fuzzy, c-format -msgid "cannot open %s (=%s)" -msgstr "no puede especificar ambos %s y %s" - -#: libcob/termio.c:362 -msgid "COB_DISPLAY_PUNCH_FILE is invalid, output to SYSPUNCH skipped" -msgstr "" - -#: bin/cobcrun.c:122 -msgid "GnuCOBOL module loader" -msgstr "" - -#: bin/cobcrun.c:124 -#, c-format -msgid "Usage: %s [options] PROGRAM [parameter ...]" -msgstr "Modo de empleo: %s [opciones] PROGRAMA [parámetro ...]" - -#: bin/cobcrun.c:126 -#, c-format -msgid " or: %s options" -msgstr " o: %s opciones" - -#: bin/cobcrun.c:129 -msgid "Options:" -msgstr "Opciones:" - -#: bin/cobcrun.c:130 -msgid " -h, -help display this help and exit" -msgstr " -h, -help enseña esta ayuda y termina" - -#: bin/cobcrun.c:131 -msgid " -V, -version display cobcrun and runtime version and exit" -msgstr " -V, -version enseña versión del ejecutor cobcrun y tiempo de ejecución y termina" - -#: bin/cobcrun.c:132 -msgid " -i, -info display runtime information (build/environment)" -msgstr " -i, -info enseña la información de tiempo de ejecución (compilador/entorno)" - -#: bin/cobcrun.c:134 -msgid " -q, -brief reduced displays" -msgstr " -q, -brief pantallas reducidas" - -#: bin/cobcrun.c:136 -msgid " -c , -config= set runtime configuration from " -msgstr " -c , config= establece configuración de tiempo de ejecución desde " - -#: bin/cobcrun.c:137 -#, fuzzy -msgid "" -" -r, -runtime-config display current runtime configuration\n" -" (value and origin for all settings)" -msgstr "" -" -r, -runtime-conf enseña la configuración del tiempo de ejecución\n" -" (valor y origen para todas opciones)" - -#: bin/cobcrun.c:139 -msgid "" -" -M , -module= set entry point module name and/or load path\n" -" where -M module prepends any directory to the\n" -" dynamic link loader library search path\n" -" and any basename to the module preload list\n" -" (COB_LIBRARY_PATH and/or COB_PRELOAD)" -msgstr "" -" -M , -module= establece nombre del módulo de punto de asiento\n" -"\t\t\t\ty/o ruta de carga donde módulo -M prepende cualquier\n" -"\t\t\t\tdirectorio para el enlace ruta de búsqueda de biblioteca\n" -"\t\t\t\tcargada enlazada dinámica y cualquier nombre de base a\n" -"\t\t\t\tla lista de precarga (COB_LIBRARY_PATH y/o COB_PRELOAD)" - -#: bin/cobcrun.c:145 -#, c-format -msgid "" -"Report bugs to: %s\n" -"or (preferably) use the issue tracker via the home page." -msgstr "" -"Boletine defectos a: %s\n" -"o (preferiblemene) utilice el seguimiento por resolución vía la página inicial." - -#: bin/cobcrun.c:148 -#, fuzzy -msgid "GnuCOBOL home page: " -msgstr "Página inicial de GnuCOBOL: " - -#: bin/cobcrun.c:149 -#, fuzzy -msgid "General help using GNU software: " -msgstr "Ayuda general utilizando software GNU: " - -#: bin/cobcrun.c:274 -msgid "invalid configuration file name" -msgstr "configuración del nombre de fichero inválido" - -#: bin/cobcrun.c:325 -#, fuzzy, c-format -msgid "invalid module argument '%s'" -msgstr "argumento modular no válido" - -#: bin/cobcrun.c:377 -#, c-format -msgid "%s: missing PROGRAM name" -msgstr "" - -#: bin/cobcrun.c:379 -#, c-format -msgid "Try '%s --help' for more information." -msgstr "" - -#: bin/cobcrun.c:387 -#, fuzzy, c-format -msgid "%s: PROGRAM name exceeds %d characters" -msgstr "Nombre de PROGRAM excede 31 caracteres" - -#~ msgid "%s: %d: invalid cast from '%s' type %s to type %s" -#~ msgstr "%s: %d: molde no válido desde «%s» tipo %s para tipo %s" - -#~ msgid " - length is < 1 or > 31" -#~ msgstr " - longitud es < 1 o > 31" - -#~ msgid "unknown name error '%s'%s" -#~ msgstr "nombre del error desconocido '%s'%s" - -#~ msgid "ISAM handler" -#~ msgstr "Manipulador ISAM" - -#~ msgid "- NOT set with -Wall" -#~ msgstr "- NO esta definido con -Wall" - -#~ msgid "- ALWAYS active" -#~ msgstr "- SIEMPRE activar" - -#~ msgid "default" -#~ msgstr "predeterminado" - -#~ msgid "GnuCOBOL compiler for most COBOL dialects with lots of extensions" -#~ msgstr "Compilador GnuCOBOL para muchos dialectos COBOL con lotes de extensiones" - -#~ msgid "Usage: %s [options]... file..." -#~ msgstr "Modo de empleo: %s [opciones]... fichero..." - -#~ msgid " -h, -help display this help and exit" -#~ msgstr " -h, -help enseña esta ayuda y sale" - -#~ msgid " -V, -version display compiler version and exit" -#~ msgstr " -V, -version enseña la versión del compilador y sale" - -#~ msgid "" -#~ " -i, -info display compiler information (build/environment)\n" -#~ " and exit" -#~ msgstr "" -#~ " -i, -info enseña información del compilador (compliar/entorno)\n" -#~ " y sale" - -#~ msgid "" -#~ " -v, -verbose display compiler version and the commands\n" -#~ " invoked by the compiler" -#~ msgstr "" -#~ " -v, -verbose enseña versión del compilador y las órdenes\n" -#~ " invocadas por el compilador" - -#~ msgid "" -#~ " -vv, -verbose=2 like -v but additional pass verbose option\n" -#~ " to assembler/compiler" -#~ msgstr "" -#~ " -vv, -verbose=2 como -v pero opción de paso detallado opcional\n" -#~ " a ensamblador/compilador" - -#~ msgid "" -#~ " -vvv, -verbose=3 like -vv but additional pass verbose option\n" -#~ " to linker" -#~ msgstr "" -#~ " -vvv, -verbose=3 como -vv pero opción de paso detallado adicional\n" -#~ " a enlazador" - -#~ msgid " -q, -brief reduced displays, commands invoked not shown" -#~ msgstr " -q, -brief pantallas reducidas, órdenes invocadas no mostradas" - -#~ msgid " -### like -v but commands not executed" -#~ msgstr " -### como -v pero órdenes no ejecutadas" - -#~ msgid " -x build an executable program" -#~ msgstr " -x compila un programa ejecutable" - -#~ msgid " -m build a dynamically loadable module (default)" -#~ msgstr " -m compila un módulo de carga dinámicamente (predet.)" - -#~ msgid " -j [], -job[=]\trun program after build, passing " -#~ msgstr " -j [], -job[=]\tejecuta un programa tras compilación, pasando " - -#~ msgid "" -#~ " -std= warnings/features for a specific dialect\n" -#~ " can be one of:\n" -#~ " default, cobol2014, cobol2002, cobol85, xopen,\n" -#~ " ibm-strict, ibm, mvs-strict, mvs,\n" -#~ " mf-strict, mf, bs2000-strict, bs2000,\n" -#~ " acu-strict, acu, rm-strict, rm;\n" -#~ " see configuration files in directory config" -#~ msgstr "" -#~ " -std= avisos/características para un dialecto escecífico\n" -#~ " puede ser uno de:\n" -#~ " predeterminado, cobol2014, cobol2002, cobol85,\n" -#~ " xopen, ibm-strict, ibm, mvs-strict, mvs,\n" -#~ " mf-strict, mf, bs2000-strict, bs2000,\n" -#~ " acu-strict, acu, rm-strict, rm;\n" -#~ " vea ficheros de configuración en el directorio de\n" -#~ " configuración" - -#~ msgid " -fixed use fixed source format (default)" -#~ msgstr " -fixed emplear formato de origen fijo (predeterminado)" - -#~ msgid " -O, -O2, -O3, -Os enable optimization" -#~ msgstr " -O, -O2, -O3, -Os optimización activada" - -#~ msgid " -g enable C compiler debug / stack check / trace" -#~ msgstr " -g activa depuración de compilador C / compilación de pila / traza" - -#~ msgid " -d, -debug enable all run-time error checking" -#~ msgstr " -d, -debug permite todas las comprobaciones de error en tiempo de ejecución" - -#~ msgid " -o place the output into " -#~ msgstr " -o lugar de salida al " - -#~ msgid "" -#~ " -b combine all input files into a single\n" -#~ " dynamically loadable module" -#~ msgstr "" -#~ " -b combinar todos los ficheros de entrada en un solo\n" -#~ " módulo dinámicamente cargable" - -#~ msgid " -E preprocess only; do not compile or link" -#~ msgstr " -E preprocesar solamente; no compilar o enlazar" - -#~ msgid " -C translation only; convert COBOL to C" -#~ msgstr " -C traducción solamente; convertir COBOL a C" - -#~ msgid " -S compile only; output assembly file" -#~ msgstr " -S compilar solamente; salida de fichero ensamblado" - -#~ msgid " -c compile and assemble, but do not link" -#~ msgstr " -c compila y ensambla, pero no enlaza" - -#~ msgid " -T generate and place a wide program listing into " -#~ msgstr " -T genera y ubica un programa ancho listando dentro de " - -#~ msgid " -t generate and place a program listing into " -#~ msgstr " -t \t\tgenera y ubica un programa listando dentro de " - -#~ msgid " --tlines= specify lines per page in listing, default = 55" -#~ msgstr " --tlines= líneas especificas por página en lista, predeterminada = 55" - -#~ msgid " -P[=] generate preprocessed program listing (.lst)" -#~ msgstr " -P(=) genera listado de programa preprocesado (.lst)" - -#~ msgid " -Xref specify cross reference in listing" -#~ msgstr " -Xref especifica referencia cruzada en listado" - -#~ msgid " -I add to copy/include search path" -#~ msgstr " -I añade para copiar/incluir ruta de búsqueda" - -#~ msgid " -L add to library search path" -#~ msgstr " -L añade el a ruta de búsqueda de biblioteca" - -#~ msgid " -l link the library " -#~ msgstr " -l enlaza la biblioteca " - -#~ msgid " -A add to the C compile phase" -#~ msgstr " -A añade a la fase de compilador C" - -#~ msgid " -Q add to the C link phase" -#~ msgstr " -Q añade a la frase de enlace C" - -#~ msgid " -D define for COBOL compilation" -#~ msgstr " -D define para compilación COBOL" - -#~ msgid " -K generate CALL to as static" -#~ msgstr " -K generar CALL a como estática" - -#~ msgid " -conf= user-defined dialect configuration; see -std" -#~ msgstr " -conf= configuración de dialecto definido por usuario; vea -std" - -#~ msgid " -list-reserved display reserved words" -#~ msgstr " -list-reserved enseña palabras reservadas" - -#~ msgid " -list-intrinsics display intrinsic functions" -#~ msgstr " -list-intrinsics enseña funciones intrínsecas" - -#~ msgid " -list-mnemonics display mnemonic names" -#~ msgstr " -list-mnemonics enseña nombres mnemónicos" - -#~ msgid " -list-system display system routines" -#~ msgstr " -list-system enseña rutinas del sistema" - -#~ msgid "" -#~ " -save-temps[=] save intermediate files\n" -#~ " - default: current directory" -#~ msgstr "" -#~ " -save-temps[=] guarda ficheros intermedios\n" -#~ " - predeterminado: directorio actual" - -#~ msgid " -ext add file extension for resolving COPY" -#~ msgstr " -ext añade extensión de fichero para resolver COPY" - -#~ msgid " -W enable all warnings" -#~ msgstr " -W activa todas las advertencias" - -#~ msgid " -Wall enable most warnings (all except as noted below)" -#~ msgstr " -Wall activar la mayoría de las advertencias (todas excepto como se anotaron debajo)" - -#~ msgid " -Wno- disable warning enabled by -W or -Wall" -#~ msgstr " -Wno- desactiva advertencias activadas por -W o -Wall" - -#~ msgid " -Werror= treat specified as error" -#~ msgstr " -Werror= tratar especificado como error" - -#~ msgid "" -#~ msgstr "" - -#~ msgid "where is one of the following:" -#~ msgstr "donde es uno de lo siguiente:" - -#~ msgid "word to be taken out of the reserved words list" -#~ msgstr "palabra para ser tomada fuera de la lista de palabras reservadas" - -#~ msgid "" -#~ msgstr "" - -#~ msgid "word to be added to reserved words list" -#~ msgstr "palabra a ser añadida para listado de palabras reservadas" - -#~ msgid "word to be added to reserved words list as alias" -#~ msgstr "palabra a ser añadida para listado de palabras reservadas como alias" - -#~ msgid ":" -#~ msgstr ":" - -#~ msgid "invalid parameter -std=%s" -#~ msgstr "parámetro no válido -std=%s" - -#~ msgid "invalid option detected" -#~ msgstr "opción no válida detectada" - -#~ msgid "unknown option ignored:\t%s" -#~ msgstr "opción desconocida ignorada:\t%s" - -#~ msgid "Invalid type for '%s'" -#~ msgstr "Tipo no válido para «%s»" - -#~ msgid "invalid type for '%s'" -#~ msgstr "tipo no válido para «%s»" - -#~ msgid "constant item '%s' cannot have a %s clause" -#~ msgstr "ítem constante «%s» no puede tener la cláusula %s" - -#~ msgid "define PERFORM stack size" -#~ msgstr "define tamaño de pila PERFORM" - -#~ msgid "" -#~ msgstr "" - -#~ msgid "define cutoff depth for IF statements" -#~ msgstr "define profundidad de corte para sentencias IF" - -#~ msgid "define display sign representation" -#~ msgstr "define representación de signo enseñada" - -#~ msgid "machine native" -#~ msgstr "máquina nativa" - -#~ msgid "fold COPY subject to value" -#~ msgstr "carpeta COPIA sujeto a valor" - -#~ msgid "no transformation" -#~ msgstr "sin transformación" - -#~ msgid "fold PROGRAM-ID, CALL, CANCEL subject to value" -#~ msgstr "carpeta de asuntos PROGRAM-ID, CALL, CANCEL a valor" - -#~ msgid "initialize fields without VALUE to decimal value" -#~ msgstr "inicializar campos sin VALUE a valor decimal" - -#~ msgid "0..255 or any quoted character" -#~ msgstr "0..255 o cualquier carácter de entrecomillado" - -#~ msgid "initialize to picture" -#~ msgstr "inicializa a dibujo" - -#~ msgid "maximum number of errors to report" -#~ msgstr "número máximo de errores para boletinar" - -#~ msgid "intrinsics to be used without FUNCTION keyword" -#~ msgstr "intrínsecas para ser empleadas sin palabras clave de FUNCTION" - -#~ msgid "[ALL|intrinsic function name(,name,...)]" -#~ msgstr "[TODO|función intrínseca nombre(,nombre,...)]" - -#~ msgid "generate extra braces in generated C code" -#~ msgstr "genera corchetes adicionales en el código C generado" - -#~ msgid "" -#~ "generate trace code\n" -#~ "\t\t\t- executed SECTION/PARAGRAPH" -#~ msgstr "" -#~ "generar código de traza\n" -#~ "\t\t\t- ejecutado SECTION/PARAGRAPH" - -#~ msgid "" -#~ "adjust items following OCCURS DEPENDING\n" -#~ "\t\t\t- requires implicit/explicit relaxed syntax" -#~ msgstr "" -#~ "ajusta elementos seguidos de OCCURS DEPENDING\n" -#~ "\t\t\t- requiere sintaxis relajada implícita/explicita" - -#~ msgid "check recursive program call" -#~ msgstr "comprobar llamada de programa recursiva" - -#~ msgid "" -#~ "relax syntax checking\n" -#~ "\t\t\t- e.g. REDEFINES position" -#~ msgstr "" -#~ "comprobación relajada de sintaxis\n" -#~ "\t\t\t- p. e. posición REDEFINES" - -#~ msgid "PICTURE SYMBOL for CURRENCY must be one character long" -#~ msgstr "PICTURE SYMBOL para CURRENCY debe ser un carácter long" - -#~ msgid "invalid character '%c' in PICTURE SYMBOL for CURRENCY" -#~ msgstr "carácter inválido «%c» en SÃMBOLO PINTURA para MONEDA" - -#~ msgid "88-level cannot be used here" -#~ msgstr "nivel-88 no puede ser utilizado aquí" - -#~ msgid "incorrect order of CONFIGURATION SECTION paragraphs" -#~ msgstr "orden incorracta de parágrados CONFIGURACIÓN SECCIONAL" - -#~ msgid "incorrect order of SOURCE- and OBJECT-COMPUTER paragraphs" -#~ msgstr "orden incorrecta de parágrafos ORIGEN- y OBJETO-COMPUTADOR" - -#~ msgid "CURRENCY SIGN longer than one character" -#~ msgstr "SIGNO MONETARIO más largo que un carácter" - -#~ msgid "CURRENCY SIGN other than '$'" -#~ msgstr "SIGNO MONETARIO distinto de '$'" - -#~ msgid "RECORD description invalid with REPORT" -#~ msgstr "RECORD descrito no válido con REPORT" - -#~ msgid "COMMUNICATION SECTION" -#~ msgstr "SECCIÓN DE COMUNICACIÓN" - -#~ msgid "REDEFINES clause should follow entry-name" -#~ msgstr "Cláusula de REDEFINES debería seguir nombre de entrada" - -#~ msgid "ANY LENGTH items may only be BY REFERENCE formal parameters" -#~ msgstr "Elementos ANY LENGTH quizá solo está por parámetros formales referenciado por BY REFERENCE" - -#~ msgid "parameters passed BY VALUE" -#~ msgstr "parámetro pasado POR VALOR" - -#~ msgid "ignoring CONVERSION" -#~ msgstr "ignorando CONVERSIÓN" - -#~ msgid "%s is not implemented" -#~ msgstr "%s no está implementado" - -#~ msgid "table SORT without keys" -#~ msgstr "tabla SORT sin claves" - -#~ msgid "invalid target for DEBUGGING ALL" -#~ msgstr "objetivo inválido para DEBUGGING ALL" - -#~ msgid "non-negative integer value expected" -#~ msgstr "valor entero no negativo esperado" - -#~ msgid "'LENGTH OF' phrase" -#~ msgstr "duración 'LENGTH OF' de frase" - -#~ msgid "cannot find the UTC offset on this system" -#~ msgstr "no puede encontrar el desplazamiento UTC en este sistema" - -#~ msgid "invalid literal cast" -#~ msgstr "cast literal inválido" - -#~ msgid "only one set of parentheses is permitted" -#~ msgstr "solo un conjunto de paréntesos está permitido" - -#~ msgid "no definition/prototype seen for function '%s'" -#~ msgstr "sin aparecer definición/prototipo para función «%s»" - -#~ msgid "no definition/prototype seen for function with external name '%s'" -#~ msgstr "sin aparecer definición/prototipo para función con nombre externo «%s»" - -#~ msgid "invalid use of 88 level item" -#~ msgstr "modo de empleo de ítem no válido de nivel 88" - -#~ msgid "reference to item containing nested ODO" -#~ msgstr "referencia a ítem conteniendo ODO anidado" - -#~ msgid "invalid use of HANDLE item" -#~ msgstr "modo de empleo inválido de ítem de MANIPULADOR" - -#~ msgid "Variable length item not allowed here" -#~ msgstr "Ãtem de longitud variable no permitido aquí" - -#~ msgid "the CHARACTERS field of ALLOCATE must be numeric" -#~ msgstr "el campo CHARACTERS de ALLOCATE debe ser numérico" - -#~ msgid "HANDLE must be either a generic or a WINDOW handle" -#~ msgstr "HANDLE debe ser o un manipulador genérico o un WINDOW" - -#~ msgid "warn type mismatch strictly" -#~ msgstr "advierte tipo incoincidente estrictamente" - -#~ msgid "warn unreachable statements" -#~ msgstr "advierte sentencias no alcanzables" - -#~ msgid "cannot find module" -#~ msgstr "no puede encontrar módulo" - -#~ msgid "cannot find entry point" -#~ msgstr "no puede encontrar punto de registro" - -#~ msgid "%s: COBOL runtime is not initialized" -#~ msgstr "%s: tiempo de ejecución COBOL no está inicializado" - -#~ msgid "%s COBOL runtime is not initialized" -#~ msgstr "%s tiempo de ejecución COBOL no está inicializado" - -#~ msgid "%s: attempt to over-write constant param %d" -#~ msgstr "%s: intente sobrescribir parámetro contante %d" - -#~ msgid "cob_sig_handler caught not handled signal: %d" -#~ msgstr "cob_sig_handler no obtuvo ninguna señal: %d" - -#~ msgid "libcob has version/patch level %s/%d" -#~ msgstr "libcob tiene versión/nivel de parche %s/%d" - -#~ msgid "malloc error" -#~ msgstr "error malloc" - -#~ msgid "codegen error - Please report this!" -#~ msgstr "generación de código errónea - ¡por favor boletine ésto!" - -#~ msgid "invalid recursive COBOL CALL to '%s'" -#~ msgstr "inválido COBOL CALL recursivo para «%s»" - -#~ msgid "EXTFH" -#~ msgstr "EXTFH" - -#~ msgid "BDB error: %s" -#~ msgstr "Error BDB: %s" - -#~ msgid "BDB error: %s %s" -#~ msgstr "Error BDB: %s %s" - -#~ msgid "cannot join BDB environment (%s), error: %d %s" -#~ msgstr "no puede unir a entorno BDB (%s), error: %d %s" - -#~ msgid "COBOL driver program for GnuCOBOL modules" -#~ msgstr "Programa controlador COBOL para módulos de GnuCOBOL" - -#~ msgid "problem with setenv %s: %d" -#~ msgstr "problema con establecer entorno setenv %s:%d" Binary files /tmp/tmp8r0303vl/MzBWgGBJBM/gnucobol-4.0~early~20200606/po/fr.gmo and /tmp/tmp8r0303vl/cieYbammgl/gnucobol-5/po/fr.gmo differ diff -Nru gnucobol-4.0~early~20200606/po/fr.po gnucobol-5/po/fr.po --- gnucobol-4.0~early~20200606/po/fr.po 2020-06-06 20:53:00.000000000 +0000 +++ gnucobol-5/po/fr.po 1970-01-01 00:00:00.000000000 +0000 @@ -1,6176 +0,0 @@ -# French translation of gnucobol -# Copyright (C) 2020 Free Software Foundation, Inc. -# This file is distributed under the same license as the gnucobol package. -# -# Frédéric Marchal , 2019. -msgid "" -msgstr "" -"Project-Id-Version: gnucobol 2.2-rc1\n" -"Report-Msgid-Bugs-To: gnucobol-messages@gnu.org\n" -"POT-Creation-Date: 2020-06-06 20:52+0000\n" -"PO-Revision-Date: 2020-01-03 19:41+0100\n" -"Last-Translator: Frédéric Marchal \n" -"Language-Team: French \n" -"Language: fr\n" -"MIME-Version: 1.0\n" -"Content-Type: text/plain; charset=UTF-8\n" -"Content-Transfer-Encoding: 8bit\n" -"X-Bugs: Report translation errors to the Language-Team address.\n" -"Plural-Forms: nplurals=2; plural=(n >= 2);\n" - -#: cobc/cobc.c:117 -#, c-format -msgid "invalid parameter: %s" -msgstr "paramètre invalide : %s" - -#: cobc/cobc.c:826 -msgid "too many errors" -msgstr "trop d'erreurs" - -#: cobc/cobc.c:838 -#, fuzzy -msgid "internal compiler error" -msgstr "%s: %d: erreur interne du compilateur" - -#: cobc/cobc.c:904 cobc/cobc.c:991 cobc/cobc.c:1051 cobc/cobc.c:1127 -#: cobc/cobc.c:1167 cobc/cobc.c:1243 -#, c-format -msgid "cannot allocate %d bytes of memory" -msgstr "impossible d'allouer %d octets de mémoire" - -#: cobc/cobc.c:917 cobc/cobc.c:933 cobc/cobc.c:953 cobc/cobc.c:1011 -#: cobc/cobc.c:1029 cobc/cobc.c:1147 cobc/cobc.c:1262 cobc/cobc.c:1279 -#: cobc/field.c:2008 libcob/common.c:7121 -#, c-format -msgid "call to %s with NULL pointer" -msgstr "appel à %s avec un pointeur NULL" - -#: cobc/cobc.c:974 -#, c-format -msgid "cannot reallocate %d bytes of memory" -msgstr "impossible de ré-allouer %d octets de mémoire" - -#: cobc/cobc.c:1068 cobc/cobc.c:1184 -msgid "attempt to reallocate non-allocated memory" -msgstr "tentative de ré-allouer une mémoire non allouée" - -#: cobc/cobc.c:1101 cobc/cobc.c:1217 -#, c-format -msgid "call to %s with invalid pointer, as it is missing in list" -msgstr "appel à %s avec un pointeur invalide, comme il est manquant dans la liste" - -#: cobc/cobc.c:1390 -#, c-format -msgid "assuming literal for unquoted '%s'" -msgstr "suppose un littéral pour « %s » sans guillemets" - -#: cobc/cobc.c:1437 -#, fuzzy -msgid " - length exceeds maximum" -msgstr "la longueur %d du littéral dépasse le maximum de %d chiffres" - -#: cobc/cobc.c:1441 -msgid " - name cannot be empty" -msgstr "" - -#: cobc/cobc.c:1444 -msgid " - name cannot begin with space or underscore" -msgstr " - le nom ne peut pas débuter avec un espace ou un souligné" - -#: cobc/cobc.c:1447 -msgid " - name cannot begin with 'cob_' or 'COB_'" -msgstr " - le nom ne peut pas débuter avec « cob_ » ou « COB_ »" - -#: cobc/cobc.c:1450 -msgid " - name duplicates a 'C' keyword" -msgstr " - le nom duplique un mot clé « C »" - -#: cobc/cobc.c:1453 -msgid " - name cannot contain a directory separator" -msgstr " - le nom ne peut pas contenir un séparateur de répertoire" - -#: cobc/cobc.c:1462 -#, c-format -msgid "invalid file base name '%s'%s" -msgstr "nom de base du fichier invalide « %s »%s" - -#: cobc/cobc.c:1466 -#, c-format -msgid "invalid ENTRY '%s'%s" -msgstr "ENTRY invalide « %s »%s" - -#: cobc/cobc.c:1469 -#, c-format -msgid "invalid PROGRAM-ID '%s'%s" -msgstr "PROGRAM-ID invalide « %s »%s" - -#: cobc/cobc.c:1596 cobc/cobc.c:8151 -#, fuzzy -msgid "please check environment variables as noted above" -msgstr "variables d'environnement" - -#: cobc/cobc.c:1608 cobc/error.c:254 cobc/error.c:274 cobc/error.c:505 -#: cobc/error.c:528 -msgid "error: " -msgstr "erreur : " - -#: cobc/cobc.c:1631 -#, c-format -msgid "duplicate DEFINE '%s' - ignored" -msgstr "DEFINE « %s » dupliqué – ignoré" - -#: cobc/cobc.c:1683 -#, c-format -msgid "environment variable '%s' is '%s'; should not contain '%c'" -msgstr "la variable d'environnement « %s » est « %s »; elle ne devrait pas contenir « %c »" - -#: cobc/cobc.c:1712 -msgid "parameter buffer size exceeded" -msgstr "taille du tampon de paramètre dépassée" - -#: cobc/cobc.c:1752 -#, c-format -msgid "warning: could not move temporary file to %s" -msgstr "avertissement : le fichier temporaire n'a pas su être déplacé vers %s" - -#: cobc/cobc.c:1957 cobc/cobc.c:1960 cobc/parser.y:803 cobc/reserved.c:3807 -#: libcob/common.c:761 libcob/common.c:1805 libcob/common.c:2002 -#: libcob/common.c:6325 libcob/common.c:7495 libcob/common.c:8025 -#: libcob/common.c:8104 -msgid "unknown" -msgstr "inconnu" - -#: cobc/cobc.c:1963 -#, c-format -msgid "aborting codegen for %s (%s: %s)" -msgstr "interruption de codegen pour %s (%s: %s)" - -#: cobc/cobc.c:1966 -#, c-format -msgid "aborting compile of %s at line %d (%s: %s)" -msgstr "interruption de la compilation de %s à la ligne %d (%s: %s)" - -#: cobc/cobc.c:1970 -msgid "aborting" -msgstr "interruption" - -#: cobc/cobc.c:1993 cobc/cobc.c:2028 libcob/common.c:7086 bin/cobcrun.c:342 -msgid "Please report this!" -msgstr "Merci de signaler ceci !" - -#: cobc/cobc.c:2046 bin/cobcrun.c:106 -#, fuzzy -msgid "License GPLv3+: GNU GPL version 3 or later " -msgstr "Licence GPLv3+ : GNU GPL version 3 ou ultérieure " - -#: cobc/cobc.c:2047 libcob/common.c:7316 bin/cobcrun.c:107 -msgid "" -"This is free software; see the source for copying conditions. There is NO\n" -"warranty; not even for MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE." -msgstr "" -"Ceci est un logiciel libre; consultez les sources pour les conditions de copie.\n" -"Il n'y a AUCUNE garantie; pas même pour la COMMERCIALISATION ou l'ADÉQUATION À UN\n" -"BESOIN PARTICULIER." - -#: cobc/cobc.c:2049 libcob/common.c:7318 bin/cobcrun.c:109 -#, c-format -msgid "Written by %s\n" -msgstr "Écrit par %s\n" - -#. TRANSLATORS: This msgid is indented as the "Packaged" msgid, %s expands to date and time -#: cobc/cobc.c:2050 cobc/cobc.c:2063 libcob/common.c:7321 bin/cobcrun.c:110 -#, c-format -msgid "Built %s" -msgstr "Compilé %s" - -#. TRANSLATORS: This msgid is indented as the "Built" msgid, %s expands to date and time -#: cobc/cobc.c:2052 cobc/cobc.c:2065 libcob/common.c:7324 bin/cobcrun.c:112 -#, c-format -msgid "Packaged %s" -msgstr "Empaqueté %s" - -#: cobc/cobc.c:2054 cobc/cobc.c:2067 -#, c-format -msgid "C version %s%s" -msgstr "Version C %s%s" - -#: cobc/cobc.c:2080 -msgid "executing:" -msgstr "exécution :" - -#: cobc/cobc.c:2082 -msgid "to be executed:" -msgstr "à exécuter :" - -#: cobc/cobc.c:2120 cobc/cobc.c:2121 libcob/common.c:5815 libcob/common.c:5816 -#: libcob/common.c:5847 libcob/common.c:5848 -msgid "env" -msgstr "env" - -#: cobc/cobc.c:2156 libcob/common.c:7351 -msgid "build information" -msgstr "information de compilation" - -#: cobc/cobc.c:2157 libcob/common.c:7352 -msgid "build environment" -msgstr "environnement de compilation" - -#: cobc/cobc.c:2167 libcob/common.c:7363 -msgid "GnuCOBOL information" -msgstr "information GnuCOBOL" - -#: cobc/cobc.c:2212 libcob/common.c:6366 libcob/common.c:7386 -#: libcob/common.c:7486 libcob/common.c:7493 -msgid "yes" -msgstr "oui" - -#: cobc/cobc.c:2214 libcob/common.c:6368 libcob/common.c:7388 -#: libcob/common.c:7488 -msgid "no" -msgstr "non" - -#: cobc/cobc.c:2218 libcob/common.c:7392 -msgid "8 bytes" -msgstr "8 octets" - -#: cobc/cobc.c:2220 libcob/common.c:7394 -msgid "4 bytes" -msgstr "4 octets" - -#: cobc/cobc.c:2224 cobc/cobc.c:2226 libcob/common.c:7398 libcob/common.c:7400 -msgid "endianness" -msgstr "" - -#: cobc/cobc.c:2224 libcob/common.c:7398 -msgid "big-endian" -msgstr "" - -#: cobc/cobc.c:2226 libcob/common.c:7400 -msgid "little-endian" -msgstr "" - -#: cobc/cobc.c:2230 cobc/cobc.c:2232 libcob/common.c:7404 libcob/common.c:7406 -#, fuzzy -msgid "native character set" -msgstr "caractère de continuation attendu" - -#: cobc/cobc.c:2230 libcob/common.c:7404 -msgid "EBCDIC" -msgstr "" - -#: cobc/cobc.c:2232 libcob/common.c:7406 -msgid "ASCII" -msgstr "" - -#: cobc/cobc.c:2235 libcob/common.c:7410 libcob/common.c:7476 -msgid "extended screen I/O" -msgstr "E/S écran étendue" - -#: cobc/cobc.c:2238 libcob/common.c:7502 -#, fuzzy -msgid "variable file format" -msgstr "format variable" - -#: cobc/cobc.c:2244 cobc/cobc.c:2246 libcob/common.c:7508 libcob/common.c:7510 -#, fuzzy -msgid "sequential file handler" -msgstr "gestionnaire séquentiel" - -#: cobc/cobc.c:2246 libcob/common.c:7510 -msgid "built-in" -msgstr "intégré" - -#: cobc/cobc.c:2254 cobc/cobc.c:2260 cobc/cobc.c:2262 cobc/cobc.c:2269 -#: cobc/cobc.c:2271 cobc/cobc.c:2275 cobc/cobc.c:2278 cobc/cobc.c:2282 -#: cobc/cobc.c:2284 cobc/cobc.c:2289 cobc/cobc.c:2291 cobc/cobc.c:2298 -#: cobc/cobc.c:2300 cobc/cobc.c:2307 libcob/common.c:7516 libcob/common.c:7527 -#: libcob/common.c:7533 libcob/common.c:7535 libcob/common.c:7539 -#: libcob/common.c:7542 libcob/common.c:7546 libcob/common.c:7548 -#: libcob/common.c:7553 libcob/common.c:7555 libcob/common.c:7562 -#: libcob/common.c:7564 libcob/common.c:7571 -#, fuzzy -msgid "indexed file handler" -msgstr "gestionnaire séquentiel" - -#: cobc/cobc.c:2304 libcob/common.c:7568 -msgid "default indexed handler" -msgstr "" - -#: cobc/cobc.c:2307 cobc/cobc.c:2319 cobc/cobc.c:2325 libcob/common.c:7381 -#: libcob/common.c:7498 libcob/common.c:7571 libcob/common.c:7611 -#: libcob/common.c:7625 -msgid "disabled" -msgstr "désactivé" - -#: cobc/cobc.c:2311 cobc/cobc.c:2313 libcob/common.c:7594 libcob/common.c:7596 -msgid "mathematical library" -msgstr "bibliothèque mathématique" - -#: cobc/cobc.c:2317 cobc/cobc.c:2319 libcob/common.c:7605 libcob/common.c:7611 -msgid "XML library" -msgstr "" - -#: cobc/cobc.c:2323 cobc/cobc.c:2325 libcob/common.c:7623 libcob/common.c:7625 -msgid "JSON library" -msgstr "" - -#: cobc/cobc.c:2332 -msgid "only one of options 'E', 'S', 'C', 'c' may be specified" -msgstr "seule une des options « E », « S », « C », « c » peut être spécifiée" - -#: cobc/cobc.c:2338 -msgid "only one of options 'm', 'x', 'b' may be specified" -msgstr "seule une des options « m », « x », « b » peut être spécifiée" - -#: cobc/cobc.c:2367 -#, c-format -msgid "-fdump= requires one of 'ALL', 'FD', 'WS', 'LS', 'RD', 'FD', 'SC' not '%s'" -msgstr "" - -#: cobc/cobc.c:2392 -#, c-format -msgid "'%s' is not an intrinsic function" -msgstr "« %s » n'est pas une fonction intrinsèque" - -#: cobc/cobc.c:2434 cobc/cobc.c:7516 cobc/cobc.c:7630 cobc/codegen.c:3796 -#: cobc/codegen.c:3905 cobc/codegen.c:5221 cobc/codegen.c:12426 cobc/tree.c:789 -#: cobc/tree.c:1221 cobc/tree.c:4101 cobc/tree.c:4648 cobc/tree.c:4891 -#: cobc/typeck.c:3294 cobc/typeck.c:7812 cobc/typeck.c:7847 cobc/typeck.c:8660 -#: cobc/typeck.c:11261 cobc/typeck.c:11329 cobc/typeck.c:11397 -#: cobc/typeck.c:11681 cobc/typeck.c:11724 -#, c-format -msgid "call to '%s' with invalid parameter '%s'" -msgstr "appel à « %s » avec un paramètre « %s » invalide" - -#: cobc/cobc.c:2737 -msgid "loading standard configuration file 'default.conf'" -msgstr "chargement du fichier de configuration standard « default.conf »" - -#: cobc/cobc.c:2871 -msgid "invalid output file name" -msgstr "nom de fichier de sortie invalide" - -#: cobc/cobc.c:2971 -#, c-format -msgid "warning: '%s' is not a directory, defaulting to current directory" -msgstr "avertissement : « %s » n'est pas un répertoire, utilisation du répertoire courant par défaut" - -#: cobc/cobc.c:2998 -#, c-format -msgid "warning: %d lines per listing page specified, using %d" -msgstr "" - -#: cobc/cobc.c:3048 -#, c-format -msgid "warning: assuming '%s' is a DEFINE - did you intend to use -debug?" -msgstr "avertissement : je présume que « %s » est un DEFINE – aviez-vous l'intention d'utiliser -debug ?" - -#: cobc/cobc.c:3315 -#, c-format -msgid "unknown warning option '%s'" -msgstr "option d'avertissement « %s » inconnue" - -#: cobc/cobc.c:3367 -#, c-format -msgid "%s option requires a listing file" -msgstr "l'option %s requiert un fichier de listing" - -#: cobc/cobc.c:3374 -msgid "output to stdout only valid for preprocess" -msgstr "" - -#: cobc/cobc.c:3466 -msgid "all runtime checks are enabled" -msgstr "tous les contrôles à l'exécution sont activés" - -#: cobc/cobc.c:3572 -msgid "only one stdin input allowed" -msgstr "seulement une entrée stdin autorisée" - -#: cobc/cobc.c:3582 -#, c-format -msgid "invalid file name parameter (length > %d)" -msgstr "paramètre de nom de fichier invalide (longueur > %d)" - -#: cobc/cobc.c:3807 -msgid "nothing for -j to run" -msgstr "rien à exécuter par -j" - -#: cobc/cobc.c:3883 cobc/cobc.c:4071 cobc/cobc.c:4130 cobc/cobc.c:4158 -#: cobc/cobc.c:4247 cobc/cobc.c:4306 cobc/cobc.c:4430 cobc/cobc.c:4469 -#: cobc/cobc.c:6993 -msgid "return status:" -msgstr "statut de retour :" - -#: cobc/cobc.c:4361 -msgid "preprocessing:" -msgstr "pré-traitement :" - -#: cobc/cobc.c:4435 -msgid "'cobxref' execution unsuccessful" -msgstr "exécution de « cobxref » infructueuse" - -#: cobc/cobc.c:4438 -#, c-format -msgid "check that 'cobxref' is in %s" -msgstr "vérifiez que « cobxref » est dans %s" - -#: cobc/cobc.c:4440 -msgid "no listing produced" -msgstr "aucun listing produit" - -#: cobc/cobc.c:5328 cobc/cobc.c:5367 -msgid "No fields defined." -msgstr "Aucun champ défini." - -#: cobc/cobc.c:5387 -msgid "No labels defined." -msgstr "Aucune étiquette définie." - -#: cobc/cobc.c:5409 -msgid "Error/Warning summary:" -msgstr "Résumé des erreurs/avertissements :" - -#: cobc/cobc.c:5453 -msgid "0 warnings in compilation group" -msgstr "0 avertissement dans le groupe de compilation" - -#: cobc/cobc.c:5457 -msgid "1 warning in compilation group" -msgstr "1 avertissement dans le groupe de compilation" - -#: cobc/cobc.c:5461 -#, c-format -msgid "%d warnings in compilation group" -msgstr "%d avertissements dans le groupe de compilation" - -#: cobc/cobc.c:5467 -msgid "0 errors in compilation group" -msgstr "0 erreur dans le groupe de compilation" - -#: cobc/cobc.c:5471 -msgid "1 error in compilation group" -msgstr "1 erreur dans le groupe de compilation" - -#: cobc/cobc.c:5475 -#, c-format -msgid "%d errors in compilation group" -msgstr "%d erreurs dans le groupe de compilation" - -#: cobc/cobc.c:5481 -#, c-format -msgid "Too many errors in compilation group: %d maximum errors" -msgstr "Trop d'erreurs dans le groupe de compilation : %d erreurs maximum" - -#: cobc/cobc.c:6050 -#, c-format -msgid "%s: %d: Too many continuation lines" -msgstr "%s: %d: Trop de lignes de continuation" - -#: cobc/cobc.c:6972 -msgid "parsing:" -msgstr "analyse :" - -#: cobc/cobc.c:7034 -msgid "translating:" -msgstr "traduction :" - -#: cobc/cobc.c:8157 -msgid "no input files" -msgstr "pas de fichier d'entrée" - -#: cobc/cobc.c:8186 -#, c-format -msgid "%s option invalid in this combination" -msgstr "l'option %s est invalide dans cette combinaison" - -#: cobc/cobc.c:8227 -msgid "command line:" -msgstr "ligne de commande :" - -#: cobc/codegen.c:973 cobc/codegen.c:4487 cobc/codegen.c:11093 -msgid "unexpected CONSTANT item" -msgstr "élément CONSTANT inattendu" - -#: cobc/codegen.c:1188 cobc/codegen.c:1196 cobc/codegen.c:1291 -#: cobc/codegen.c:1603 cobc/codegen.c:2202 cobc/codegen.c:3212 -#: cobc/codegen.c:3455 cobc/codegen.c:3988 cobc/codegen.c:4454 -#: cobc/codegen.c:7902 cobc/codegen.c:8507 cobc/codegen.c:10298 -#: cobc/field.c:817 cobc/scanner.l:2104 cobc/tree.c:611 cobc/tree.c:3728 -#: cobc/typeck.c:5015 cobc/typeck.c:8662 cobc/typeck.c:9657 -#, c-format -msgid "unexpected tree tag: %d" -msgstr "balise d'arbre inattendue : %d" - -#: cobc/codegen.c:2999 cobc/codegen.c:3295 cobc/codegen.c:8125 cobc/tree.c:1243 -#, c-format -msgid "unexpected cast type: %d" -msgstr "type de transtypage inattendu : %d" - -#: cobc/codegen.c:3725 cobc/codegen.c:4434 -#, c-format -msgid "internal statement stack depth exceeded: %d" -msgstr "dépassement de la profondeur de la pile des instructions internes : %d" - -#: cobc/codegen.c:3798 -#, c-format -msgid "%s is not a field" -msgstr "%s n'est pas un champ" - -#: cobc/codegen.c:4186 cobc/codegen.c:4279 -#, c-format -msgid "unexpected function: %s" -msgstr "fonction inattendue : %s" - -#: cobc/codegen.c:4270 -#, fuzzy, c-format -msgid "unexpected operator: %c" -msgstr "opérateur inattendu : %d" - -#: cobc/codegen.c:5043 -#, c-format -msgid "unexpected tree category: %d" -msgstr "catégorie d'arbre inattendue : %d" - -#: cobc/codegen.c:5438 cobc/codegen.c:5465 cobc/codegen.c:5662 -#: cobc/codegen.c:5694 -#, c-format -msgid "unexpected size: %d" -msgstr "taille inattendue : %d" - -#: cobc/codegen.c:7254 -#, c-format -msgid "No ENTRY FOR GO TO '%s'" -msgstr "" - -#: cobc/codegen.c:7475 cobc/codegen.c:7725 -#, c-format -msgid "unexpected handler type: %d" -msgstr "type de gestionnaire inattendu : %d" - -#: cobc/codegen.c:7823 -msgid "unexpected error_node parameter" -msgstr "paramètre error_node inattendu" - -#: cobc/codegen.c:8146 -#, c-format -msgid "unexpected tree type: %d" -msgstr "type d'arbre inattendu : %d" - -#: cobc/codegen.c:8703 cobc/typeck.c:6511 cobc/typeck.c:12940 -#: cobc/typeck.c:12984 -#, fuzzy, c-format -msgid "compiler is not configured to support %s" -msgstr "la bibliothèque d'exécution n'est pas configurée pour cette opération" - -#: cobc/codegen.c:9128 -msgid "Nested OCCURS in report" -msgstr "" - -#: cobc/codeoptim.c:2762 -#, c-format -msgid "unexpected optimization value: %d" -msgstr "valeur d'optimisation inattendue : %d" - -#: cobc/config.c:162 libcob/common.c:6786 libcob/common.c:6800 -#: libcob/common.c:7242 -#, c-format -msgid "invalid value '%s' for configuration tag '%s'" -msgstr "valeur « %s » invalide pour la balise de configuration « %s »" - -#: cobc/config.c:165 libcob/common.c:6093 libcob/common.c:6209 -#, c-format -msgid "should be one of the following values: %s" -msgstr "elle devrait être l'une des valeurs suivantes : %s" - -#: cobc/config.c:167 -msgid "must be numeric" -msgstr "doit être numérique" - -#: cobc/config.c:169 libcob/common.c:6191 -#, c-format -msgid "maximum value: %lu" -msgstr "valeur maximale : %lu" - -#: cobc/config.c:171 -#, c-format -msgid "minimum value: %d" -msgstr "valeur minimale : %d" - -#: cobc/config.c:203 -#, c-format -msgid "unsupported value '%s' for configuration tag '%s'" -msgstr "valeur « %s » non supportée pour la balise de configuration « %s »" - -#: cobc/config.c:311 cobc/pplex.l:977 libcob/common.c:6702 -msgid "recursive inclusion" -msgstr "inclusion récursive" - -#: cobc/config.c:386 libcob/common.c:6753 -msgid "configuration file was included here" -msgstr "le fichier de configuration a été inclus ici" - -#: cobc/config.c:415 -#, c-format -msgid "The previous loaded configuration '%s' will be discarded." -msgstr "La configuration « %s » précédemment chargée sera abandonnée." - -#: cobc/config.c:449 -msgid "missing definitions:" -msgstr "définitions manquantes :" - -#: cobc/config.c:451 -#, c-format -msgid "\tno definition of '%s'" -msgstr "\tpas de définition de « %s »" - -#: cobc/config.c:512 -#, c-format -msgid "invalid configuration tag '%s'" -msgstr "balise de configuration « %s » invalide" - -#: cobc/config.c:525 libcob/common.c:6509 libcob/common.c:6592 -#: libcob/common.c:6620 -#, c-format -msgid "unknown configuration tag '%s'" -msgstr "balise de configuration « %s » inconnue" - -#: cobc/config.c:549 -#, c-format -msgid "invalid configuration tag '%s' in word-list" -msgstr "balise de configuration « %s » invalide dans la liste de mots" - -#: cobc/config.c:608 -#, c-format -msgid "Could not access word list for '%s'" -msgstr "Impossible d'accéder la liste de mots pour « %s »" - -#: cobc/error.c:87 -#, fuzzy, c-format -msgid "in section '%s':" -msgstr "dans la section" - -#: cobc/error.c:98 -#, fuzzy, c-format -msgid "in paragraph '%s':" -msgstr "dans le paragraphe" - -#: cobc/error.c:121 libcob/common.c:7252 -msgid "configuration error:" -msgstr "erreur de configuration :" - -#: cobc/error.c:134 libcob/common.c:673 -#, c-format -msgid "system error %d" -msgstr "erreur système %d" - -#: cobc/error.c:231 cobc/error.c:323 cobc/error.c:478 -msgid "error [-Werror]: " -msgstr "erreur [-Werror] : " - -#: cobc/error.c:231 cobc/error.c:323 cobc/error.c:478 cobc/error.c:505 -#: libcob/common.c:6881 libcob/common.c:6906 -#, c-format -msgid "warning: " -msgstr "avertissement : " - -#: cobc/error.c:274 cobc/error.c:528 -msgid "error (ignored): " -msgstr "erreur (ignorée) : " - -#: cobc/error.c:364 cobc/error.c:380 cobc/error.c:563 cobc/error.c:584 -#, c-format -msgid "%s used" -msgstr "%s utilisé" - -#: cobc/error.c:367 cobc/error.c:566 -#, c-format -msgid "%s is archaic in %s" -msgstr "%s est archaïque dans %s" - -#: cobc/error.c:371 cobc/error.c:570 -#, c-format -msgid "%s is obsolete in %s" -msgstr "%s est obsolète dans %s" - -#: cobc/error.c:377 cobc/error.c:576 cobc/parser.y:5186 cobc/parser.y:5325 -#, c-format -msgid "%s ignored" -msgstr "%s ignoré" - -#: cobc/error.c:383 cobc/error.c:586 -#, c-format -msgid "%s does not conform to %s" -msgstr "%s n'est pas conforme à %s" - -#: cobc/error.c:399 -msgid "configuration warning:" -msgstr "avertissement de configuration :" - -#: cobc/error.c:621 cobc/error.c:640 -#, c-format -msgid "redefinition of '%s'" -msgstr "redéfinition de « %s »" - -#: cobc/error.c:628 cobc/error.c:653 -#, c-format -msgid "'%s' previously defined here" -msgstr "« %s » précédemment défini ici" - -#: cobc/error.c:677 cobc/error.c:684 -#, c-format -msgid "'%s' is not defined" -msgstr "« %s » n'est pas défini" - -#: cobc/error.c:680 -#, c-format -msgid "'%s' cannot be used here" -msgstr "« %s » ne peut pas être utilisé ici" - -#: cobc/error.c:682 cobc/parser.y:7009 -#, c-format -msgid "'%s' is not defined, but is a reserved word in another dialect" -msgstr "« %s » n'est pas défini mais est un mot réservé d'un autre dialecte" - -#: cobc/error.c:716 -#, c-format -msgid "'%s' is ambiguous; needs qualification" -msgstr "« %s » est ambigu; qualification requise" - -#: cobc/error.c:746 cobc/parser.y:16748 -#, c-format -msgid "'%s' defined here" -msgstr "« %s » défini ici" - -#: cobc/error.c:757 -#, c-format -msgid "fatal error: %s" -msgstr "erreur fatale : %s" - -#: cobc/error.c:765 -#, c-format -msgid "group item '%s' cannot have %s clause" -msgstr "l'élément de groupe « %s » ne peut pas avoir de clause %s" - -#: cobc/error.c:779 -#, c-format -msgid "constant item '%s' requires a %s clause" -msgstr "l'élément constant « %s » requière une clause %s" - -#: cobc/error.c:781 -#, c-format -msgid "level %02d item '%s' requires a %s clause" -msgstr "l'élément de niveau %02d « %s » requière une clause %s" - -#: cobc/error.c:795 -#, c-format -msgid "constant item '%s' can only have a %s clause" -msgstr "l'élément constant « %s » peut uniquement avoir une clause %s" - -#: cobc/error.c:797 -#, c-format -msgid "level %02d item '%s' can only have a %s clause" -msgstr "l'élément de niveau %02d « %s » peut uniquement avoir une clause %s" - -#: cobc/field.c:131 -#, fuzzy -msgid "constant expression has Divide by ZERO" -msgstr "L'expression constante a une division par ZÉRO" - -#: cobc/field.c:187 cobc/field.c:324 cobc/field.c:332 -msgid "missing right parenthesis" -msgstr "parenthèse droite manquante" - -#: cobc/field.c:216 -#, c-format -msgid "expression stack overflow at %d entries for operation '%c'" -msgstr "" - -#: cobc/field.c:257 -#, c-format -msgid "expression stack overflow at %d entries" -msgstr "" - -#: cobc/field.c:274 -msgid "missing left parenthesis" -msgstr "parenthèse gauche manquante" - -#: cobc/field.c:315 -#, c-format -msgid "invalid operator '%s' in expression" -msgstr "opérateur « %s » invalide dans l'expression" - -#: cobc/field.c:334 -#, c-format -msgid "'%c' operator misplaced" -msgstr "opérateur « %c » mal placé" - -#: cobc/field.c:395 -#, c-format -msgid "invalid level number '%s'" -msgstr "numéro de niveau « %s » invalide" - -#: cobc/field.c:454 -#, fuzzy -msgid "entry following SAME AS may not be subordinate to it" -msgstr "l'élément THRU « %s » ne peut pas être subordonné à « %s »" - -#: cobc/field.c:459 cobc/field.c:496 -msgid "level number must begin with 01 or 77" -msgstr "le numéro de niveau doit commencer par 01 ou 77" - -#: cobc/field.c:541 cobc/field.c:557 -#, c-format -msgid "no previous data item of level %02d" -msgstr "pas d'élément de donnée de niveau %02d précédent" - -#: cobc/field.c:599 -#, c-format -msgid "'%s' cannot be qualified here" -msgstr "« %s » ne peut pas être qualifié ici" - -#: cobc/field.c:605 -#, c-format -msgid "'%s' cannot be subscripted here" -msgstr "« %s » ne peut pas avoir d'indice ici" - -#: cobc/field.c:617 -#, c-format -msgid "'%s' is not defined in '%s'" -msgstr "« %s » n'est pas défini dans « %s »" - -#: cobc/field.c:638 -msgid "level number of REDEFINES entries must be identical" -msgstr "le numéro de niveau des entrées REDEFINES doit être identique" - -#: cobc/field.c:643 -#, c-format -msgid "'%s' is not the original definition" -msgstr "« %s » n'est pas la définition originale" - -#: cobc/field.c:758 -#, c-format -msgid "PICTURE clause not compatible with USAGE %s" -msgstr "la clause PICTURE n'est pas compatible avec USAGE %s" - -#: cobc/field.c:855 cobc/field.c:930 cobc/field.c:941 -#, c-format -msgid "PICTURE clause required for '%s'" -msgstr "clause PICTURE requise pour « %s »" - -#: cobc/field.c:937 -#, c-format -msgid "a non-numeric literal is expected for '%s'" -msgstr "un littéral non numérique est attendu pour « %s »" - -#: cobc/field.c:949 -#, c-format -msgid "defining implicit picture size %d for '%s'" -msgstr "définition implicite de la taille de l'image %d pour « %s »" - -#: cobc/field.c:969 -#, c-format -msgid "'%s' ANY LENGTH only allowed in LINKAGE" -msgstr "« %s » ANY LENGTH uniquement autorisé dans LINKAGE" - -#: cobc/field.c:973 -#, c-format -msgid "'%s' ANY LENGTH must be 01 level" -msgstr "« %s » ANY LENGTH doit être niveau 01" - -#: cobc/field.c:977 -#, c-format -msgid "'%s' ANY LENGTH cannot be BASED/EXTERNAL" -msgstr "« %s » ANY LENGTH ne peut pas être BASED/EXTERNAL" - -#: cobc/field.c:982 cobc/field.c:1010 -#, c-format -msgid "'%s' ANY LENGTH has invalid definition" -msgstr "« %s » ANY LENGTH a une définition invalide" - -#: cobc/field.c:993 -#, c-format -msgid "'%s' ANY NUMERIC must be PIC 9" -msgstr "« %s » ANY NUMERIC doit être PIC 9" - -#: cobc/field.c:998 -#, fuzzy, c-format -msgid "'%s' ANY LENGTH must be PIC X or PIC N" -msgstr "« %s » ANY LENGTH doit être PIC X ou PIC A" - -#: cobc/field.c:1008 -#, c-format -msgid "'%s' ANY NUMERIC has invalid definition" -msgstr "« %s » ANY NUMERIC a une définition invalide" - -#: cobc/field.c:1026 -#, c-format -msgid "'%s' EXTERNAL must be specified at 01/77 level" -msgstr "« %s » EXTERNAL doit être spécifié au niveau 01/77" - -#: cobc/field.c:1030 -#, c-format -msgid "'%s' EXTERNAL can only be specified in WORKING-STORAGE section" -msgstr "« %s » EXTERNAL peut uniquement être spécifié dans une section WORKING-STORAGE" - -#: cobc/field.c:1034 -#, c-format -msgid "'%s' EXTERNAL and BASED are mutually exclusive" -msgstr "« %s » EXTERNAL et BASED sont mutuellement exclusifs" - -#: cobc/field.c:1037 -#, c-format -msgid "'%s' EXTERNAL not allowed with REDEFINES" -msgstr "« %s » EXTERNAL pas permis avec REDEFINES" - -#: cobc/field.c:1049 -#, c-format -msgid "'%s' BASED not allowed here" -msgstr "« %s » BASED pas permis ici" - -#: cobc/field.c:1052 -#, c-format -msgid "'%s' BASED not allowed with REDEFINES" -msgstr "« %s » BASED pas permis avec REDEFINED" - -#: cobc/field.c:1055 -#, c-format -msgid "'%s' BASED only allowed at the 01 and 77 levels" -msgstr "« %s » BASED uniquement permis aux niveaux 01 et 77" - -#: cobc/field.c:1067 -#, c-format -msgid "level %02d item '%s' cannot have a %s clause" -msgstr "l'élément de niveau %02d « %s » ne peut pas avoir une clause %s" - -#: cobc/field.c:1082 -#, c-format -msgid "'%s' cannot have the OCCURS clause due to '%s'" -msgstr "« %s » ne peut pas avoir la clause OCCURS à cause de « %s »" - -#: cobc/field.c:1101 -#, c-format -msgid "the original definition '%s' should not have OCCURS clause" -msgstr "la définition originale « %s » ne devrait pas avoir de clause OCCURS" - -#: cobc/field.c:1108 -msgid "REDEFINES must follow the original definition" -msgstr "REDEFINES doit suivre la définition originale" - -#: cobc/field.c:1115 -#, c-format -msgid "'%s' cannot be variable length" -msgstr "« %s » ne peut pas être de longueur variable" - -#: cobc/field.c:1118 -#, c-format -msgid "the original definition '%s' cannot be variable length" -msgstr "la définition originale « %s » ne peut pas être de longueur variable" - -#: cobc/field.c:1142 -#, c-format -msgid "SCREEN group item '%s' has invalid clause" -msgstr "l'élément de groupe SCREEN « %s » a une clause invalide" - -#: cobc/field.c:1223 -#, fuzzy, c-format -msgid "%s USAGE %s incompatible with %s USAGE %s" -msgstr "la clause PICTURE n'est pas compatible avec USAGE %s" - -#: cobc/field.c:1302 -#, c-format -msgid "'%s' cannot have PICTURE clause" -msgstr "« %s » ne peut pas avoir de clause PICTURE" - -#: cobc/field.c:1318 cobc/field.c:1328 -#, fuzzy, c-format -msgid "%s item '%s' should be USAGE DISPLAY" -msgstr "« %s » n'est pas USAGE DISPLAY" - -#: cobc/field.c:1351 -#, c-format -msgid "'%s' COMP-6 with sign - changing to COMP-3" -msgstr "« %s » COMP-6 avec signe – changé en COMP-3" - -#: cobc/field.c:1377 -msgid "elementary items with SIGN clause must have S in PICTURE" -msgstr "les éléments élémentaires avec la clause SIGN doivent avoir S dans PICTURE" - -#: cobc/field.c:1380 -msgid "elementary items with SIGN clause must be USAGE DISPLAY or NATIONAL" -msgstr "les éléments élémentaires avec la clause SIGN doivent être USAGE DISPLAY ou NATIONAL" - -#: cobc/field.c:1397 -#, c-format -msgid "'%s' cannot have JUSTIFIED RIGHT" -msgstr "« %s » ne peut pas avoir JUSTIFIED RIGHT" - -#: cobc/field.c:1410 -#, c-format -msgid "'%s' cannot have S in PICTURE string and BLANK WHEN ZERO" -msgstr "« %s » ne peut pas avoir S dans la chaîne PICTURE et BLANK WHEN ZERO" - -#: cobc/field.c:1415 -#, c-format -msgid "'%s' cannot have BLANK WHEN ZERO without being USAGE DISPLAY or NATIONAL" -msgstr "« %s » ne peut pas avoir BLANK WHEN ZERO sans être USAGE DISPLAY ou NATIONAL" - -#: cobc/field.c:1426 -#, c-format -msgid "'%s' cannot have * in PICTURE string and BLANK WHEN ZERO" -msgstr "« %s » ne peut pas avoir * dans la chaîne PICTURE et BLANK WHEN ZERO" - -#: cobc/field.c:1433 -#, c-format -msgid "'%s' is not numeric, so cannot have BLANK WHEN ZERO" -msgstr "« %s » n'est pas numérique, il ne peut donc pas avoir BLANK WHEN ZERO" - -#: cobc/field.c:1446 -msgid "only level 88 items may have multiple values" -msgstr "seuls les éléments de niveau 88 peuvent avoir plusieurs valeurs" - -#: cobc/field.c:1454 cobc/field.c:1458 -#, fuzzy, c-format -msgid "initial VALUE clause ignored for %s item '%s'" -msgstr "la clause de valeur initiale est ignorée pour les éléments %s" - -#: cobc/field.c:1471 -msgid "FULL has no effect on numeric items; you may want REQUIRED or PIC Z" -msgstr "" - -#: cobc/field.c:1499 -msgid "VALUE may not contain a figurative constant" -msgstr "" - -#: cobc/field.c:1507 -#, fuzzy -msgid "cannot specify both FULL and JUSTIFIED" -msgstr "ne peut spécifier à la fois %s et %s" - -#: cobc/field.c:1519 -#, c-format -msgid "'%s' has FROM, TO or USING without PIC; PIC will be implied" -msgstr "" - -#: cobc/field.c:1533 -#, c-format -msgid "'%s' has numeric VALUE without PIC; PIC will be implied" -msgstr "" - -#: cobc/field.c:1548 -#, c-format -msgid "'%s' cannot have PIC without FROM, TO, USING or numeric VALUE" -msgstr "" - -#: cobc/field.c:1560 -#, c-format -msgid "'%s' needs a PIC, FROM, TO, USING, VALUE, BELL, BLANK or ERASE clause" -msgstr "" - -#: cobc/field.c:1574 -#, fuzzy -msgid "cannot specify both PIC and VALUE" -msgstr "ne peut spécifier à la fois %s et %s" - -#: cobc/field.c:1582 -msgid "cannot have PIC without FROM, TO or USING" -msgstr "" - -#: cobc/field.c:1591 -msgid "cannot have FROM, TO or USING without PIC" -msgstr "" - -#: cobc/field.c:1600 -#, fuzzy -msgid "VALUE item may not be numeric" -msgstr "l'élément de INITIALIZED TO n'est pas alphanumérique" - -#: cobc/field.c:1616 -#, c-format -msgid "'%s' needs a PIC, COL, LINE, VALUE, BELL or BLANK clause" -msgstr "" - -#: cobc/field.c:1647 -msgid "cannot use AUTO, FULL, PROMPT, REQUIRED or SECURE on elementary item without TO or USING" -msgstr "" - -#: cobc/field.c:1654 -msgid "cannot use BLANK WHEN ZERO, JUSTIFIED, OCCURS or SIGN on item without FROM, TO or USING" -msgstr "" - -#: cobc/field.c:1674 -msgid "cannot use AUTO, FULL, REQUIRED or SECURE on elementary item without FROM, TO or USING" -msgstr "" - -#: cobc/field.c:1679 -msgid "cannot use BLANK WHEN ZERO, JUSTIFIED or SIGN without FROM, TO or USING" -msgstr "" - -#: cobc/field.c:1697 -#, fuzzy -msgid "cannot have BLANK WHEN ZERO without PIC" -msgstr "« %s » ne peut pas avoir BLANK WHEN ZERO sans être USAGE DISPLAY ou NATIONAL" - -#: cobc/field.c:1700 -#, fuzzy -msgid "cannot have JUSTIFIED without PIC" -msgstr "« %s » ne peut pas avoir JUSTIFIED RIGHT" - -#: cobc/field.c:1720 -msgid "cannot have AUTO without FROM, TO or USING" -msgstr "" - -#: cobc/field.c:1725 -msgid "cannot use FULL or REQUIRED on item without TO or USING" -msgstr "" - -#: cobc/field.c:1732 -msgid "SECURE can be used with TO only" -msgstr "" - -#: cobc/field.c:1734 -#, fuzzy -msgid "SECURE must be used with TO" -msgstr "READ doit être exécuté en premier" - -#: cobc/field.c:1753 -#, fuzzy, c-format -msgid "'%s' does nothing" -msgstr "« %s » n'est pas défini" - -#: cobc/field.c:1797 -#, fuzzy -msgid "BLANK ZERO not compatible with USAGE" -msgstr "la clause PICTURE n'est pas compatible avec USAGE %s" - -#: cobc/field.c:1800 -#, fuzzy -msgid "SIGN clause not compatible with USAGE" -msgstr "la clause PICTURE n'est pas compatible avec USAGE %s" - -#: cobc/field.c:1977 -#, fuzzy, c-format -msgid "'%s' PICTURE clause not compatible with USAGE" -msgstr "la clause PICTURE n'est pas compatible avec USAGE %s" - -#: cobc/field.c:2027 -#, fuzzy, c-format -msgid "'%s' 77 level is not allowed here" -msgstr "« %s » niveau 77 pas permis ici" - -#: cobc/field.c:2424 -msgid "OCCURS and multi COLUMNs is not allowed" -msgstr "" - -#: cobc/field.c:2452 -#, fuzzy, c-format -msgid "duplicate LINE %d ignored" -msgstr "DEFINE « %s » dupliqué – ignoré" - -#: cobc/field.c:2469 -#, c-format -msgid "ignoring SYNCHRONIZED for group item '%s'" -msgstr "ignore SYNCHRONIZED pour les élément de groupe « %s »" - -#: cobc/field.c:2485 cobc/field.c:2498 cobc/field.c:2778 cobc/field.c:2781 -#, c-format -msgid "size of '%s' larger than size of '%s'" -msgstr "taille de « %s » plus grande que la taille de « %s »" - -#: cobc/field.c:2638 cobc/field.c:2703 -#, c-format -msgid "'%s' cannot be larger than %d bytes" -msgstr "« %s » ne peut pas être plus grand que %d octets" - -#: cobc/field.c:2676 cobc/field.c:2684 -#, c-format -msgid "'%s' binary field cannot be larger than %d digits" -msgstr "le champ binaire « %s » ne peut pas être plus grand que %d chiffres" - -#: cobc/field.c:2764 cobc/field.c:3216 -#, c-format -msgid "unexpected USAGE: %d" -msgstr "USAGE inattendu : %d" - -#: cobc/field.c:2876 -msgid "literal type does not match numeric data type" -msgstr "le type littéral ne correspond pas au type de donnée numérique" - -#: cobc/field.c:2953 -#, c-format -msgid "THRU item '%s' may not come before '%s'" -msgstr "l'élément THRU « %s » ne peut pas arriver avant « %s »" - -#: cobc/field.c:2976 -#, c-format -msgid "RENAMES cannot start/end at the OCCURS item '%s'" -msgstr "RENAMES ne peuvent pas commencer/terminer à l'élément OCCURS « %s »" - -#: cobc/field.c:2984 -#, c-format -msgid "cannot use RENAMES on part of the table '%s'" -msgstr "ne peut utiliser RENAMES sur une partie de la table « %s »" - -#: cobc/field.c:3022 -#, c-format -msgid "RENAMES may not contain '%s' as it is a pointer or object reference" -msgstr "RENAMES ne peut pas contenir « %s » car il est un pointeur ou une référence à un objet" - -#: cobc/field.c:3027 -#, c-format -msgid "RENAMES may not contain '%s' as it is an OCCURS DEPENDING table" -msgstr "RENAMES ne peut pas contenir « %s » car il est dans une table OCCURS DEPENDING" - -#: cobc/field.c:3049 -msgid "RENAMES of 01-, 66- and 77-level items" -msgstr "RENAMES des éléments de niveau 01, 66 et 77" - -#: cobc/field.c:3051 -msgid "RENAMES may not reference a level 88" -msgstr "RENAMES ne peut pas faire référence au niveau 88" - -#: cobc/field.c:3075 -#, c-format -msgid "'%s' must immediately follow the record '%s'" -msgstr "« %s » doit suivre immédiatement l'enregistrement « %s »" - -#: cobc/field.c:3083 -#, c-format -msgid "THRU item must be different to '%s'" -msgstr "l'élément THRU doit être différent de « %s »" - -#: cobc/field.c:3089 -#, c-format -msgid "'%s' and '%s' must be in the same record" -msgstr "« %s » et « %s » doivent être dans le même enregistrement" - -#: cobc/field.c:3100 -#, c-format -msgid "THRU item '%s' may not be subordinate to '%s'" -msgstr "l'élément THRU « %s » ne peut pas être subordonné à « %s »" - -#: cobc/flag.def:40 -msgid "" -" -fstack-size=\tdefine PERFORM stack size\n" -" * default: 255" -msgstr "" - -#: cobc/flag.def:44 -msgid "" -" -fsign=[ASCII|EBCDIC]\tdefine display sign representation\n" -" * default: machine native" -msgstr "" - -#: cobc/flag.def:48 -msgid "" -" -ffold-copy=[UPPER|LOWER]\tfold COPY subject to value\n" -" * default: no transformation" -msgstr "" - -#: cobc/flag.def:52 -msgid "" -" -ffold-call=[UPPER|LOWER]\tfold PROGRAM-ID, CALL, CANCEL subject to value\n" -" * default: no transformation" -msgstr "" - -#: cobc/flag.def:56 -msgid "" -" -fdefaultbyte=\tinitialize fields without VALUE to value\n" -" * decimal 0..255 or any quoted character\n" -" * default: initialize to picture" -msgstr "" - -#: cobc/flag.def:61 -msgid "" -" -fmax-errors=\tmaximum number of errors to report before\n" -" compilation is aborted\n" -" * default: 128" -msgstr "" - -#: cobc/flag.def:68 -msgid "" -" -fintrinsics=[ALL|intrinsic function name(,name,...)]\n" -" intrinsics to be used without FUNCTION keyword" -msgstr "" - -#: cobc/flag.def:72 -msgid "" -" -fdump= dump data fields on abort, may be\n" -" a combination of: ALL, WS, LS, RD, FD, SC" -msgstr "" - -#: cobc/flag.def:76 -msgid "" -" -fcallfh= use external provided EXTFH interface module\n" -" for I/O" -msgstr "" - -#: cobc/flag.def:80 -msgid "" -" -fsqldb= which Database is used, may be\n" -" MySQL, MSSQL, Oracle10, Oracle11, Oracle12" -msgstr "" - -#: cobc/flag.def:84 -msgid " -fsqlschema= define database schema name" -msgstr "" - -#: cobc/flag.def:91 -msgid "" -" -fno-recursive-check disable check of recursive program call;\n" -" effectively compiling as RECURSIVE program" -msgstr "" - -#: cobc/flag.def:95 -#, fuzzy -msgid "" -" -fwinmain generate WinMain instead of main when compiling\n" -" as executable" -msgstr "générer WinMain au lieu de main lors de la compilation d'un exécutable" - -#: cobc/flag.def:99 -#, fuzzy -msgid " -fcomputed-goto generate computed goto C statements" -msgstr "générer des instructions C goto calculées" - -#: cobc/flag.def:102 -#, fuzzy -msgid " -falternate-ebcdic use restricted ASCII to EBCDIC translate" -msgstr "utiliser une traduction restreinte de ASCII vers EBCDIC" - -#: cobc/flag.def:105 -msgid " -fextra-brace generate extra braces in C source" -msgstr "" - -#: cobc/flag.def:108 -msgid " -fgen-c-line-directives\tgenerate source location directives in C code" -msgstr "" - -#: cobc/flag.def:111 -msgid " -fgen-c-labels generate extra labels in C sources" -msgstr "" - -#: cobc/flag.def:114 -#, fuzzy -msgid " -fcorrect-numeric attempt correction of invalid numeric display items" -msgstr "tenter de corriger les éléments d'affichage numériques invalides" - -#: cobc/flag.def:117 -#, fuzzy -msgid " -fstack-on-heap PERFORM stack allocated on heap" -msgstr "appliquer PERFORM d'une pile allouée sur le tas" - -#: cobc/flag.def:120 -msgid " -ffast-math Disables emitting faster arithmetic logic" -msgstr "" - -#: cobc/flag.def:125 -msgid "" -" -fno-remove-unreachable\tdisable remove of unreachable code\n" -" * turned off by -g" -msgstr "" - -#: cobc/flag.def:129 -msgid " -finline-intrinsic\twhen possible resolve intrinsic FUNCTIONs at compile time" -msgstr "" - -#: cobc/flag.def:132 -#, fuzzy -msgid "" -" -ftrace generate trace code\n" -" * scope: executed SECTION/PARAGRAPH" -msgstr "" -" -Xref générer la référence croisée via « cobxref »\n" -" (« cobxref » de V. Coen doit être dans le path)" - -#: cobc/flag.def:136 -#, fuzzy -msgid "" -" -ftraceall generate trace code\n" -" * scope: executed SECTION/PARAGRAPH/STATEMENTS\n" -" * turned on by -debug" -msgstr "" -"générer le code de trace\n" -"\t\t\t- SECTION/PARAGRAPH/STATEMENTS exécuté\n" -"\t\t\t- activé par -debug" - -#: cobc/flag.def:141 -#, fuzzy -msgid " -fsyntax-only syntax error checking only; don't emit any output" -msgstr "uniquement vérifier les erreurs de syntaxe; ne pas générer de sortie" - -#: cobc/flag.def:144 -#, fuzzy -msgid "" -" -fdebugging-line enable debugging lines\n" -" * 'D' in indicator column or floating >>D" -msgstr "" -"activer les lignes de débogage\n" -"\t\t\t- « D » dans la colonne indicateur ou >>D flottant" - -#: cobc/flag.def:148 -#, fuzzy -msgid "" -" -fsource-location generate source location code\n" -" * turned on by -debug/-g/-ftraceall" -msgstr "" -"générer le code de localisation des sources\n" -"\t\t\t- activé par -debug/-g/-ftraceall" - -#: cobc/flag.def:152 -#, fuzzy -msgid " -fimplicit-init automatic initialization of the COBOL runtime system" -msgstr "initialisation automatique du système d'exécution COBOL" - -#: cobc/flag.def:155 -#, fuzzy -msgid "" -" -fstack-check PERFORM stack checking\n" -" * turned on by -debug or -g" -msgstr "" -"vérification de pile PERFORM\n" -"\t\t\t- activé par -debug ou -g" - -#: cobc/flag.def:159 -#, fuzzy -msgid "" -" -fwrite-after use AFTER 1 for WRITE of LINE SEQUENTIAL\n" -" * default: BEFORE 1" -msgstr "" -"utiliser AFTER 1 pour WRITE de LINE SEQUENTIAL\n" -"\t\t\t- défaut: AFTER 1" - -#: cobc/flag.def:163 -#, fuzzy -msgid "" -" -fmfcomment '*' or '/' in column 1 treated as comment\n" -" * FIXED format only" -msgstr "" -"« * » ou « / » dans la colonne 1 est traité comme commentaire\n" -"\t\t\t- format FIXED uniquement" - -#: cobc/flag.def:167 -#, fuzzy -msgid "" -" -facucomment '$' in indicator area treated as '*',\n" -" '|' treated as floating comment" -msgstr "" -"« $ » dans la zone indicateur est traité comme « * »,\n" -"\t\t\t« | » traité comme commentaire flottant" - -#: cobc/flag.def:171 -#, fuzzy -msgid "" -" -fnotrunc allow numeric field overflow\n" -" * non-ANSI behaviour" -msgstr "" -"autoriser le débordement de champ numérique\n" -"\t\t\t- comportement non-ANSI" - -#: cobc/flag.def:175 -msgid "" -" -fodoslide adjust items following OCCURS DEPENDING\n" -" * implies -fcomplex-odo" -msgstr "" - -#: cobc/flag.def:179 -#, fuzzy -msgid "" -" -fsingle-quote use a single quote (apostrophe) for QUOTE\n" -" * default: double quote" -msgstr "" -"utilise une apostrophe pour QUOTE\n" -"\t\t\t- défaut: guillemet" - -#: cobc/flag.def:189 -#, fuzzy -msgid "" -" -foptional-file treat all files as OPTIONAL\n" -" * unless NOT OPTIONAL specified" -msgstr "" -"traiter tous les fichiers comme OPTIONAL\n" -"\t\t\t- à moins que NOT OPTIONAL soit spécifié" - -#: cobc/flag.def:193 -#, fuzzy -msgid " -fstatic-call output static function calls for the CALL statement" -msgstr "sortir les appels de fonctions statiques pour l'instruction CALL" - -#: cobc/flag.def:196 -#, fuzzy -msgid "" -" -fno-gen-c-decl-static-call\tdisable generation of C function declations\n" -" for subroutines with static CALL" -msgstr "désactiver la génération des déclarations de fonctions C pour les sous-routines sans CALL statique" - -#: cobc/flag.def:200 -msgid " -fmf-files Sequential & Relative files will match Micro Focus format" -msgstr "" - -#: cobc/flag.def:203 -msgid "" -" -fno-theaders suppress all headers and output of compilation\n" -" options from listing while keeping page breaks" -msgstr "" - -#: cobc/flag.def:207 -#, fuzzy -msgid " -fno-tsource suppress source from listing" -msgstr " -F, -free utiliser le format source libre" - -#: cobc/flag.def:210 -msgid " -fno-tmessages suppress warning and error summary from listing" -msgstr "" - -#: cobc/flag.def:213 -#, fuzzy -msgid " -ftsymbols specify symbols in listing" -msgstr " --tsymbols spécifie les symboles dans le listing" - -#: cobc/parser.y:283 cobc/parser.y:317 -#, c-format -msgid "unreachable statement '%s'" -msgstr "instruction inatteignable « %s »" - -#: cobc/parser.y:410 cobc/parser.y:703 -#, c-format -msgid "'%s' is not in LINKAGE SECTION" -msgstr "« %s » n'est pas dans LINKAGE SECTION" - -#: cobc/parser.y:413 cobc/typeck.c:3705 -#, c-format -msgid "'%s' cannot be BASED/EXTERNAL" -msgstr "« %s » ne peut pas être BASED/EXTERNAL" - -#: cobc/parser.y:418 -#, c-format -msgid "'%s' is not in WORKING-STORAGE SECTION" -msgstr "« %s » n'est pas dans une section WORKING-STORAGE" - -#: cobc/parser.y:425 cobc/typeck.c:3702 -#, c-format -msgid "'%s' not level 01 or 77" -msgstr "« %s » n'est pas de niveau 01 ou 77" - -#: cobc/parser.y:428 cobc/parser.y:443 cobc/typeck.c:3708 -#, c-format -msgid "'%s' REDEFINES field not allowed here" -msgstr "le champs REDEFINES « %s » n'est pas permis ici" - -#: cobc/parser.y:456 -#, c-format -msgid "'%s' USING item duplicates RETURNING item" -msgstr "l'élément USING « %s » duplique l'élément RETURNING" - -#: cobc/parser.y:466 -#, c-format -msgid "ENTRY '%s' duplicated" -msgstr "ENTRY « %s » dupliqué" - -#: cobc/parser.y:502 -#, fuzzy, c-format -msgid "ENTRY FOR GO TO '%s' duplicated" -msgstr "ENTRY « %s » dupliqué" - -#: cobc/parser.y:518 -#, c-format -msgid "maximum nested program depth exceeded (%d)" -msgstr "profondeur maximale de programme imbriqué dépassée (%d)" - -#: cobc/parser.y:544 cobc/parser.y:571 -#, c-format -msgid "%s statement not terminated by %s" -msgstr "instruction %s pas terminée par %s" - -#: cobc/parser.y:574 -#, c-format -msgid "%s statement not terminated" -msgstr "instruction %s pas terminée" - -#: cobc/parser.y:638 -msgid "USE statement invalid for SORT file" -msgstr "instruction USE invalide pour le fichier SORT" - -#: cobc/parser.y:665 cobc/parser.y:667 -#, c-format -msgid "duplicate %s clause" -msgstr "clause %s dupliquée" - -#: cobc/parser.y:685 -#, c-format -msgid "Cannot specify %s without number of lines on page" -msgstr "" - -#: cobc/parser.y:695 -#, c-format -msgid "maximum OCCURS depth exceeded (%d)" -msgstr "profondeur maximale de OCCURS dépassée (%d)" - -#: cobc/parser.y:709 cobc/parser.y:711 cobc/parser.y:6808 cobc/parser.y:6811 -#: cobc/parser.y:6813 cobc/parser.y:6815 cobc/parser.y:6850 cobc/parser.y:7573 -#: cobc/parser.y:7575 cobc/parser.y:7577 cobc/parser.y:7579 cobc/parser.y:7625 -#: cobc/parser.y:7634 cobc/parser.y:9548 cobc/parser.y:10994 -#: cobc/parser.y:12370 cobc/parser.y:13552 -#, c-format -msgid "%s and %s are mutually exclusive" -msgstr "%s et %s sont mutuellement exclusifs" - -#: cobc/parser.y:725 cobc/parser.y:729 -msgid "TO phrase without DEPENDING phrase" -msgstr "phrase TO sans phrase DEPENDING" - -#: cobc/parser.y:726 -#, fuzzy -msgid "maximum number of occurrences assumed to be exact number" -msgstr "le nombre maximum d'occurrences est supposé être un nombre exact" - -#: cobc/parser.y:733 cobc/parser.y:7355 -msgid "OCCURS TO must be greater than OCCURS FROM" -msgstr "OCCURS TO doit être plus grand que OCCURS FROM" - -#: cobc/parser.y:742 -#, fuzzy -msgid "OCCURS DEPENDING ON without TO phrase" -msgstr "ODO sans phrase TO" - -#: cobc/parser.y:808 -#, c-format -msgid "%s header missing - assumed" -msgstr "en-tête %s manquant - présumé" - -#: cobc/parser.y:810 -#, c-format -msgid "%s header missing" -msgstr "en-tête %s manquant" - -#: cobc/parser.y:942 -#, fuzzy, c-format -msgid "duplicate %s" -msgstr "clause %s dupliquée" - -#: cobc/parser.y:944 -#, c-format -msgid "%s incorrectly after %s" -msgstr "" - -#: cobc/parser.y:1046 -#, c-format -msgid "redefinition of program name '%s'" -msgstr "redéfinition du nom du programme « %s »" - -#: cobc/parser.y:1050 -#, c-format -msgid "redefinition of program ID '%s'" -msgstr "redéfinition du ID du programme « %s »" - -#: cobc/parser.y:1082 -#, c-format -msgid "FUNCTION '%s' has no PROCEDURE DIVISION" -msgstr "FUNCTION « %s » n'a pas de PROCEDURE DIVISION" - -#: cobc/parser.y:1188 -msgid "functions may not be defined within a program/function" -msgstr "les fonctions ne peuvent pas être définies dans un programme/fonction" - -#: cobc/parser.y:1238 -#, c-format -msgid "END FUNCTION '%s' is different from FUNCTION-ID '%s'" -msgstr "END FUNCTION « %s » est différent de FUNCTION-ID « %s »" - -#: cobc/parser.y:1252 -#, c-format -msgid "END PROGRAM '%s' is different from PROGRAM-ID '%s'" -msgstr "END PROGRAM « %s » est différent de PROGRAM-ID « %s »" - -#: cobc/parser.y:1301 -#, fuzzy -msgid "currency symbol must be one character long" -msgstr "le CURSOR « %s » doit avoir une longueur de 4 ou 6 caractères" - -#: cobc/parser.y:1358 -#, fuzzy, c-format -msgid "invalid character '%c' in currency symbol" -msgstr "un symbole monétaire à la fin" - -#: cobc/parser.y:1374 -msgid "prototype has same name as current function and will be ignored" -msgstr "le prototype a le même nom que la fonction courante et sera ignoré" - -#: cobc/parser.y:1401 -#, c-format -msgid "duplicate REPOSITORY entries for '%s' do not match" -msgstr "les entrées REPOSITORY dupliquées pour « %s » ne correspondent pas" - -#: cobc/parser.y:1405 -#, c-format -msgid "duplicate REPOSITORY entry for '%s'" -msgstr "entrée REPOSITORY dupliquée pour « %s »" - -#: cobc/parser.y:1470 -#, c-format -msgid "ORGANIZATION %s is incompatible with RECORD DELIMITER" -msgstr "" - -#: cobc/parser.y:1502 -#, c-format -msgid "illegal combination of %s with other clauses" -msgstr "" - -#: cobc/parser.y:1517 cobc/parser.y:1520 cobc/parser.y:1551 -#, c-format -msgid "cannot specify both %s and %s" -msgstr "ne peut spécifier à la fois %s et %s" - -#: cobc/parser.y:1548 -#, c-format -msgid "cannot specify both %s and %s; %s is ignored" -msgstr "ne peut spécifier à la fois %s et %s; %s est ignoré" - -#: cobc/parser.y:1720 -msgid "FOR phrase cannot immediately follow ALL/LEADING/TRAILING" -msgstr "la phrase FOR ne peut pas suivre immédiatement ALL/LEADING/TRAILING" - -#: cobc/parser.y:1722 -msgid "missing CHARACTERS/ALL/LEADING/TRAILING phrase after FOR phrase" -msgstr "phrase CHARACTERS/ALL/LEADING/TRAILING manquante après une phrase FOR" - -#: cobc/parser.y:1729 -#, fuzzy -msgid "missing value between ALL/LEADING/TRAILING words" -msgstr "valeur manquante entre les mots CHARACTERS/ALL/LEADING/TRAILING" - -#: cobc/parser.y:1734 -msgid "missing FOR phrase before CHARACTERS/ALL/LEADING/TRAILING phrase" -msgstr "phrase FOR manquante avant la phrase CHARACTERS/ALL/LEADING/TRAILING" - -#: cobc/parser.y:1741 -msgid "missing ALL/LEADING/TRAILING before value" -msgstr "ALL/LEADING/TRAILING manquant avant la valeur" - -#: cobc/parser.y:1796 -msgid "use of condition-name in place of data-name" -msgstr "" - -#: cobc/parser.y:1800 cobc/parser.y:6753 cobc/typeck.c:665 -#, fuzzy, c-format -msgid "condition-name not allowed here: '%s'" -msgstr "modification de référence pas permise ici" - -#: cobc/parser.y:1827 -msgid "cannot specify NO ADVANCING in screen DISPLAY" -msgstr "ne peut spécifier NO ADVANCING dans l'écran DISPLAY" - -#: cobc/parser.y:1899 cobc/parser.y:1916 -msgid "non-standard DISPLAY" -msgstr "DISPLAY non standard" - -# CRT est un tube cathodique mais cela n'existe plus depuis longtemps au moment où je traduits ce texte. -# CRT est un mot clé historique du language dans ce contexte. -#: cobc/parser.y:1903 -msgid "screens may only be displayed on CRT" -msgstr "les écrans peuvent uniquement être affichés sur CRT" - -#: cobc/parser.y:1908 cobc/parser.y:1951 -msgid "cannot mix screens and fields in the same DISPLAY statement" -msgstr "ne peut mélanger les écrans et les champs dans la même instruction DISPLAY" - -#: cobc/parser.y:1912 -msgid "screen clauses may only be used for DISPLAY on CRT" -msgstr "les instructions écran peuvent uniquement être utilisées avec DISPLAY sur CRT" - -#: cobc/parser.y:1957 -msgid "ambiguous DISPLAY; put items to display on device in separate DISPLAY" -msgstr "DISPLAY ambigu; mettez les éléments à afficher sur le périphérique dans des DISPLAY séparés" - -#: cobc/parser.y:1973 -#, c-format -msgid "%s is not an alphanumeric literal" -msgstr "%s n'est pas un littéral alphanumérique" - -#: cobc/parser.y:1975 -#, c-format -msgid "'%s' is not USAGE DISPLAY" -msgstr "« %s » n'est pas USAGE DISPLAY" - -#: cobc/parser.y:1990 cobc/typeck.c:8481 -#, c-format -msgid "invalid target for %s" -msgstr "cible invalide pour %s" - -#: cobc/parser.y:1997 cobc/parser.y:6747 -#, fuzzy -msgid "SCREEN item cannot be used here" -msgstr "« %s » ne peut pas être utilisé ici" - -#: cobc/parser.y:1999 -#, fuzzy -msgid "RENAMES item may not be used here" -msgstr "une constante ne peut pas être utilisée ici – « %s »" - -#: cobc/parser.y:2001 cobc/typeck.c:2333 cobc/typeck.c:2429 -msgid "ANY LENGTH item not allowed here" -msgstr "élément ANY LENGTH pas permis ici" - -#: cobc/parser.y:2005 -#, c-format -msgid "item '%s' has wrong class for VALIDATE" -msgstr "" - -#: cobc/parser.y:2014 -#, fuzzy -msgid "WHEN clause must follow EVERY clause" -msgstr "la clause REDEFINES doit suivre le nom d'entrée" - -#: cobc/parser.y:2096 cobc/parser.y:17197 -#, fuzzy -msgid "non-zero value expected" -msgstr "valeur entière attendue" - -#: cobc/parser.y:2102 cobc/tree.c:4352 -#, fuzzy, c-format -msgid "RECORD size (IDX) exceeds maximum allowed (%d)" -msgstr "la taille de RECORD excède le maximum autorisé (%d)" - -#: cobc/parser.y:2106 cobc/tree.c:4355 -#, c-format -msgid "RECORD size exceeds maximum allowed (%d)" -msgstr "la taille de RECORD excède le maximum autorisé (%d)" - -#: cobc/parser.y:2111 -msgid "RECORD clause invalid" -msgstr "clause RECORD invalide" - -#: cobc/parser.y:3188 -msgid "multiple PROGRAM-ID's without matching END PROGRAM" -msgstr "plusieurs PROGRAM-ID sans END PROGRAM correspondant" - -#: cobc/parser.y:3191 -msgid "executable requested but no program found" -msgstr "exécutable demandé mais pas de programme trouvé" - -#: cobc/parser.y:3408 cobc/parser.y:3417 -msgid "COMMON may only be used in a contained program" -msgstr "COMMON peut uniquement être utilisé dans un programme contenu" - -#: cobc/parser.y:3426 cobc/parser.y:3458 -msgid "CALL prototypes" -msgstr "prototypes CALL" - -#: cobc/parser.y:3607 cobc/parser.y:3884 cobc/parser.y:3928 cobc/parser.y:4036 -#: cobc/parser.y:4223 cobc/parser.y:4319 cobc/parser.y:4360 cobc/parser.y:4431 -#: cobc/parser.y:4452 cobc/parser.y:4531 cobc/parser.y:4550 cobc/parser.y:4566 -#: cobc/parser.y:4584 cobc/parser.y:4602 cobc/parser.y:4619 cobc/parser.y:4637 -#: cobc/parser.y:6868 cobc/parser.y:7694 -#, c-format -msgid "%s not allowed in nested programs" -msgstr "%s pas permis dans des programmes imbriqués" - -#: cobc/parser.y:3761 -msgid "segment-number must be in range of values 1 to 49" -msgstr "segment-number doit être dans l'intervalle de valeurs 1 à 49" - -#: cobc/parser.y:3773 -msgid "duplicate CLASSIFICATION clause" -msgstr "clause CLASSIFICATION dupliquée" - -#: cobc/parser.y:3849 -msgid "PROGRAM phrase" -msgstr "phrase PROGRAM" - -#: cobc/parser.y:3944 cobc/parser.y:3955 cobc/parser.y:4271 -#, c-format -msgid "invalid %s clause" -msgstr "clause %s invalide" - -#: cobc/parser.y:4386 cobc/parser.y:4390 -msgid "CLASS literal with THRU must have size 1" -msgstr "un littéral CLASS avec THRU doit avoir une taille 1" - -#: cobc/parser.y:4417 -#, fuzzy -msgid "CLASS IS integer IN alphabet-name" -msgstr "« %s » n'est pas un nom alphabet" - -#: cobc/parser.y:4464 -msgid "separate currency symbol and currency string" -msgstr "" - -#: cobc/parser.y:4497 -#, c-format -msgid "invalid CURRENCY SIGN '%s'" -msgstr "CURRENCY SIGN « %s » invalide" - -#: cobc/parser.y:4715 -msgid "cannot use RELATIVE KEY clause on INDEXED files" -msgstr "" - -#: cobc/parser.y:4719 -msgid "cannot use RECORD KEY clause on RELATIVE files" -msgstr "" - -#: cobc/parser.y:4793 -msgid "EXTERNAL/DYNAMIC cannot be used with literals" -msgstr "" - -#: cobc/parser.y:4813 -msgid "EXTERNAL/DYNAMIC cannot be used with USING/VARYING" -msgstr "" - -#: cobc/parser.y:4824 -msgid "EXTERNAL/DYNAMIC cannot be used with DISK FROM" -msgstr "" - -#: cobc/parser.y:4826 -msgid "ASSIGN DISK FROM" -msgstr "" - -#: cobc/parser.y:4942 -msgid "ASSIGN EXTERNAL/DYNAMIC" -msgstr "" - -#: cobc/parser.y:5165 -#, c-format -msgid "'%s' is not an alphabet-name" -msgstr "« %s » n'est pas un nom alphabet" - -#: cobc/parser.y:5254 -#, c-format -msgid "%s only valid with ORGANIZATION %s" -msgstr "" - -#: cobc/parser.y:5321 cobc/parser.y:5344 -#, fuzzy, c-format -msgid "RECORD DELIMITER %s only allowed with SEQUENTIAL files" -msgstr "RECORDING MODE U ou S peuvent uniquement être utilisés avec les fichiers RECORD SEQUENTIAL" - -#: cobc/parser.y:5323 cobc/parser.y:5336 cobc/parser.y:5348 cobc/parser.y:5358 -#, fuzzy -msgid "RECORD DELIMITER clause" -msgstr "clause PROMPT" - -#: cobc/parser.y:5332 -#, fuzzy, c-format -msgid "RECORD DELIMITER %s only allowed with (LINE) SEQUENTIAL files" -msgstr "RECORDING MODE U ou S peuvent uniquement être utilisés avec les fichiers RECORD SEQUENTIAL" - -#: cobc/parser.y:5337 -msgid "LINE-SEQUENTIAL phrase" -msgstr "" - -#: cobc/parser.y:5349 -msgid "BINARY-SEQUENTIAL phrase" -msgstr "" - -#: cobc/parser.y:5357 -#, fuzzy -msgid "RECORD DELIMITER clause only allowed with (LINE) SEQUENTIAL files" -msgstr "RECORDING MODE U ou S peuvent uniquement être utilisés avec les fichiers RECORD SEQUENTIAL" - -#: cobc/parser.y:5360 -#, c-format -msgid "RECORD DELIMITER %s not recognized; will be ignored" -msgstr "" - -#: cobc/parser.y:5398 -msgid "DUPLICATES for primary keys" -msgstr "" - -#: cobc/parser.y:5637 -msgid "DOS/VS APPLY phrase" -msgstr "" - -#: cobc/parser.y:5752 -msgid "RECORD description missing or invalid" -msgstr "description RECORD manquante ou invalide" - -#: cobc/parser.y:5778 -#, fuzzy, c-format -msgid "duplicate file description for %s" -msgstr "valeurs dupliquées dans la classe « %s »" - -#: cobc/parser.y:5811 cobc/parser.y:5821 -msgid "file cannot have both EXTERNAL and GLOBAL clauses" -msgstr "un fichier ne peut pas avoir en même temps les clauses EXTERNAL et GLOBAL" - -#: cobc/parser.y:5825 cobc/parser.y:6414 cobc/parser.y:6853 cobc/parser.y:12363 -#: cobc/parser.y:15305 -#, c-format -msgid "%s is invalid in a user FUNCTION" -msgstr "%s est invalide dans une FUNCTION utilisateur" - -#: cobc/parser.y:5863 cobc/parser.y:5872 -msgid "RECORD clause ignored for LINE SEQUENTIAL" -msgstr "clause RECORD ignorée pour LINE SEQUENTIAL" - -#: cobc/parser.y:5964 -msgid "LINAGE clause with wrong file type" -msgstr "clause LINAGE avec un mauvais type de fichier" - -#: cobc/parser.y:6026 -msgid "RECORDING MODE U or S can only be used with RECORD SEQUENTIAL files" -msgstr "RECORDING MODE U ou S peuvent uniquement être utilisés avec les fichiers RECORD SEQUENTIAL" - -#: cobc/parser.y:6059 -#, c-format -msgid "ignoring CODE-SET '%s'" -msgstr "ignore CODE-SET « %s »" - -#: cobc/parser.y:6070 -msgid "CODE-SET clause invalid for file type" -msgstr "clause CODE-SET invalide pour le type de fichier" - -#: cobc/parser.y:6092 -msgid "REPORT clause with wrong file type" -msgstr "clause REPORT avec le mauvais type de fichier" - -#: cobc/parser.y:6170 -msgid "CD record missing" -msgstr "enregistrement CD manquant" - -#: cobc/parser.y:6601 -msgid "CONSTANT item not at 01 level" -msgstr "élément CONSTANT pas au niveau 01" - -#: cobc/parser.y:6721 -#, fuzzy -msgid "REDEFINES clause not following entry-name" -msgstr "la clause REDEFINES doit suivre le nom d'entrée" - -#: cobc/parser.y:6743 -#, fuzzy -msgid "SAME AS clause" -msgstr "clause SIZE IS" - -#: cobc/parser.y:6750 -#, fuzzy -msgid "REPORT item cannot be used here" -msgstr "« %s » ne peut pas être utilisé ici" - -#: cobc/parser.y:6757 -#, fuzzy -msgid "elementary item expected" -msgstr "valeur entière attendue" - -#: cobc/parser.y:6764 -#, fuzzy -msgid "SAME AS item may not reference itself" -msgstr "RENAMES ne peut pas faire référence au niveau 88" - -#: cobc/parser.y:6771 -#, fuzzy -msgid "SAME AS item may not be subordinate to any item with USAGE clause" -msgstr "l'élément THRU « %s » ne peut pas être subordonné à « %s »" - -#: cobc/parser.y:6773 -#, fuzzy -msgid "SAME AS item may not be subordinate to any item with SIGN clause" -msgstr "l'élément THRU « %s » ne peut pas être subordonné à « %s »" - -#: cobc/parser.y:6801 cobc/parser.y:6855 cobc/parser.y:7567 cobc/parser.y:7650 -#: cobc/parser.y:7674 -#, c-format -msgid "%s not allowed here" -msgstr "%s pas permis ici" - -#: cobc/parser.y:6803 cobc/parser.y:6845 cobc/parser.y:7569 -#, c-format -msgid "%s only allowed at 01/77 level" -msgstr "%s uniquement autorisé au niveau 01/77" - -#: cobc/parser.y:6805 cobc/parser.y:6847 cobc/parser.y:7571 cobc/parser.y:7654 -#: cobc/parser.y:7676 -#, c-format -msgid "%s requires a data name" -msgstr "%s requiert un nom de donnée" - -#: cobc/parser.y:6958 -msgid "a locale-format PICTURE string must only consist of '9', '.', '+', 'Z' and the currency-sign" -msgstr "" - -#: cobc/parser.y:6992 cobc/typeck.c:3658 -#, fuzzy, c-format -msgid "'%s' is not a locale-name" -msgstr "« %s » n'est pas un nom d'environnement linguistique" - -#: cobc/parser.y:7007 -#, fuzzy, c-format -msgid "'%s' is not a valid USAGE" -msgstr "« %s » n'est pas un nom de donnée valide" - -#: cobc/parser.y:7012 -#, fuzzy, c-format -msgid "unknown USAGE: %s" -msgstr "erreur inconnue : %d" - -#: cobc/parser.y:7149 -#, c-format -msgid "unknown HANDLE type: %s" -msgstr "" - -#: cobc/parser.y:7406 cobc/parser.y:7408 -msgid "INDEXED should follow ASCENDING/DESCENDING" -msgstr "INDEXED devrait suivre ASCENDING/DESCENDING" - -#: cobc/parser.y:7526 -#, fuzzy -msgid "SYNCHRONIZED clause" -msgstr "clause SIZE IS" - -#: cobc/parser.y:7529 -msgid "LEFT/RIGHT phrases in SYNCHRONIZED clause" -msgstr "" - -#: cobc/parser.y:7612 -msgid "FALSE clause only allowed for 88 level" -msgstr "clause FALSE uniquement permise au niveau 88" - -#: cobc/parser.y:7652 -#, fuzzy, c-format -msgid "%s only allowed at 01 level" -msgstr "%s uniquement autorisé au niveau 01/77" - -#: cobc/parser.y:7656 cobc/parser.y:7678 -#, c-format -msgid "%s and %s combination not allowed" -msgstr "" - -#: cobc/parser.y:7787 -msgid "GLOBAL is not allowed with RD" -msgstr "GLOBAL n'est pas permis avec RD" - -#: cobc/parser.y:8321 -msgid "PLUS is not recommended with LEFT, RIGHT or CENTER" -msgstr "" - -#: cobc/parser.y:8323 -#, fuzzy -msgid "PLUS is not allowed with LEFT, RIGHT or CENTER" -msgstr "GLOBAL n'est pas permis avec RD" - -#: cobc/parser.y:8360 cobc/parser.y:8390 -msgid "PLUS is ignored on first field of line" -msgstr "" - -#: cobc/parser.y:8398 -msgid "invalid COLUMN integer; must be > 0" -msgstr "" - -#: cobc/parser.y:8400 -msgid "COLUMN numbers should increase" -msgstr "" - -#: cobc/parser.y:8499 cobc/parser.y:8555 -msgid "INITIAL specified on non-input field" -msgstr "INITIAL spécifié sur un champ qui n'est pas une entrée" - -#: cobc/parser.y:8511 cobc/parser.y:8567 -msgid "relative LINE/COLUMN clause required with OCCURS" -msgstr "clause LINE/COLUMN relative requise avec OCCURS" - -#: cobc/parser.y:8669 cobc/parser.y:8673 -msgid "screen positions from data-item" -msgstr "" - -#: cobc/parser.y:9498 -#, fuzzy -msgid "OCCURS screen items" -msgstr "éléments d'écran GLOBAL" - -#: cobc/parser.y:9510 -msgid "GLOBAL screen items" -msgstr "éléments d'écran GLOBAL" - -#: cobc/parser.y:9554 -msgid "overriding convention specified in ENTRY-CONVENTION" -msgstr "outrepasse la convention spécifiée dans ENTRY-CONVENTION" - -#: cobc/parser.y:9566 -msgid "executable program requested but PROCEDURE/ENTRY has USING clause" -msgstr "programme exécutable demandé mais PROCEDURE/ENTRY a la clause USING" - -#: cobc/parser.y:9636 cobc/parser.y:9653 cobc/parser.y:11184 -#, fuzzy, c-format -msgid "number of arguments exceeds maximum %d" -msgstr "le nombre de paramètres dépasse le maximum %d" - -#: cobc/parser.y:9645 -msgid "CHAINING invalid in user FUNCTION" -msgstr "CHAINING invalide dans une FUNCTION utilisateur" - -#: cobc/parser.y:9692 cobc/parser.y:11261 cobc/parser.y:11270 -#, c-format -msgid "%s not allowed in CHAINED programs" -msgstr "%s pas permis dans des programmes CHAINED" - -#: cobc/parser.y:9704 cobc/parser.y:9712 cobc/parser.y:9720 cobc/parser.y:9741 -msgid "SIZE only allowed for BY VALUE items" -msgstr "SIZE uniquement permis pour les éléments BY VALUE" - -#: cobc/parser.y:9743 cobc/parser.y:9760 -msgid "invalid value for SIZE" -msgstr "valeur invalide pour SIZE" - -#: cobc/parser.y:9775 -msgid "MEMORY SIZE phrase in CALL statement" -msgstr "" - -#: cobc/parser.y:9787 -msgid "OPTIONAL only allowed for BY REFERENCE items" -msgstr "OPTIONAL uniquement permis pour les éléments BY REFERENCE" - -#: cobc/parser.y:9799 -msgid "RETURNING clause is required for a FUNCTION" -msgstr "la clause RETURNING est requise pour une FUNCTION" - -#: cobc/parser.y:9805 -msgid "RETURNING clause cannot be OMITTED for main program" -msgstr "la clause RETURNING ne peut pas être OMITTED pour le programme principal" - -#: cobc/parser.y:9808 -msgid "RETURNING clause cannot be OMITTED for a FUNCTION" -msgstr "la clause RETURNING ne peut pas être OMITTED pour une FUNCTION" - -#: cobc/parser.y:9821 -msgid "RETURNING item is not defined in LINKAGE SECTION" -msgstr "RETURNING avec un élément n'est pas défini dans LINKAGE SECTION" - -#: cobc/parser.y:9823 -msgid "RETURNING item must have level 01" -msgstr "RETURNING un élément doit avoir le niveau 01" - -#: cobc/parser.y:9825 -msgid "RETURNING item should not have OCCURS" -msgstr "RETURNING un élément ne devrait pas avoir OCCURS" - -#: cobc/parser.y:9829 -msgid "function RETURNING item may not be ANY LENGTH" -msgstr "une fonction avec RETURNING d'un élément ne peut pas être ANY LENGTH" - -#: cobc/parser.y:10017 -#, c-format -msgid "'%s' is not a statement" -msgstr "« %s » n'est pas une instruction" - -#: cobc/parser.y:10019 -#, c-format -msgid "unknown statement '%s'; it may exist in another dialect" -msgstr "instruction « %s » inconnue; elle peut exister dans un autre dialecte" - -#: cobc/parser.y:10022 -#, c-format -msgid "unknown statement '%s'" -msgstr "instruction « %s » inconnue" - -#: cobc/parser.y:10039 -msgid "section segments" -msgstr "" - -#: cobc/parser.y:10041 -msgid "SECTION segment-number must be less than or equal to 99" -msgstr "le numéro de segment de SECTION doit être inférieur ou égal à 99" - -#: cobc/parser.y:10044 -msgid "SECTION segment-number in DECLARATIVES must be less than 50" -msgstr "le numéro de segment dans SECTION dans DECLARATIVES doit être inférieur à 50" - -#: cobc/parser.y:10052 -msgid "SECTION segment within DECLARATIVES" -msgstr "segment SECTION dans DECLARATIVES" - -#: cobc/parser.y:10240 cobc/parser.y:10375 -msgid "non-standard ACCEPT" -msgstr "ACCEPT non standard" - -#: cobc/parser.y:10252 -msgid "PROMPT clause" -msgstr "clause PROMPT" - -#: cobc/parser.y:10256 -msgid "SIZE IS clause" -msgstr "clause SIZE IS" - -#: cobc/parser.y:10471 cobc/parser.y:10763 -msgid "TIME-OUT or BEFORE TIME clauses" -msgstr "clauses TIME-OUT ou BEFORE TIME" - -#: cobc/parser.y:10497 cobc/parser.y:10513 cobc/parser.y:10528 -msgid "AT screen-location" -msgstr "emplacement d'écran AT" - -#: cobc/parser.y:10529 -msgid "LINE or COLUMN" -msgstr "LINE ou COLUMN" - -#: cobc/parser.y:10893 -msgid "ALLOCATE CHARACTERS requires RETURNING clause" -msgstr "ALLOCATE CHARACTERS requiert une clause RETURNING" - -#: cobc/parser.y:10908 cobc/parser.y:12168 -#, fuzzy, c-format -msgid "ignoring %s phrase" -msgstr "le signe est ignoré" - -#: cobc/parser.y:10910 -msgid "addressing mode should be either 24 or 31 bit" -msgstr "" - -#: cobc/parser.y:10982 -msgid "recursive program call - assuming RECURSIVE attribute" -msgstr "appel de programme récursif – suppose l'attribut RECURSIVE" - -#: cobc/parser.y:11001 -msgid "STATIC CALL convention ignored because of ON EXCEPTION" -msgstr "" - -#: cobc/parser.y:11010 -msgid "ON EXCEPTION ignored because of STATIC CALL" -msgstr "" - -#: cobc/parser.y:11111 cobc/typeck.c:12209 -msgid "invalid mnemonic name" -msgstr "nom de mnémonique invalide" - -#: cobc/parser.y:11131 cobc/parser.y:11428 -msgid "CALL/CANCEL with program-prototype-name" -msgstr "CALL/CANCEL avec un nom de prototype de programme" - -#: cobc/parser.y:11135 -msgid "id/literal ignored, using prototype name" -msgstr "id/littéral ignoré, utilisation du nom de prototype" - -#: cobc/parser.y:11141 -msgid "NESTED phrase is only valid with literal" -msgstr "phrase NESTED est uniquement valide dans un littéral" - -#: cobc/parser.y:11202 -#, fuzzy -msgid "OMITTED only allowed when arguments are passed BY REFERENCE" -msgstr "OMITTED uniquement permis quand les paramètres sont passés BY REFERENCE" - -#: cobc/parser.y:11226 -msgid "invalid file name reference" -msgstr "référence de nom de fichier invalide" - -#: cobc/parser.y:11234 -#, fuzzy, c-format -msgid "BY CONTENT assumed for alphanumeric item '%s'" -msgstr "BY CONTENT supposé pour un élément alphanumérique" - -#: cobc/parser.y:11239 -#, fuzzy, c-format -msgid "BY CONTENT assumed for national item '%s'" -msgstr "BY CONTENT supposé pour un élément alphanumérique" - -#: cobc/parser.y:11302 -msgid "RETURNING item must have level 01 or 77" -msgstr "un élément avec RETURNING doit avoir le niveau 01 ou 77" - -#: cobc/parser.y:11306 -msgid "RETURNING item must be a LINKAGE SECTION item or have BASED clause" -msgstr "un élément avec RETURNING doit être un élément de LINKAGE SECTION ou avoir une clause BASED" - -#: cobc/parser.y:11340 cobc/parser.y:15972 cobc/parser.y:16027 -#: cobc/parser.y:16071 cobc/parser.y:16115 -msgid "NOT EXCEPTION before EXCEPTION" -msgstr "NOT EXCEPTION avant EXCEPTION" - -#: cobc/parser.y:12041 -#, fuzzy, c-format -msgid "HANDLE must be a %s HANDLE" -msgstr "HANDLE doit soit être un générique ou soit un THREAD HANDLE" - -#: cobc/parser.y:12053 -#, fuzzy -msgid "HANDLE must be a generic HANDLE" -msgstr "HANDLE doit soit être un générique ou soit un THREAD HANDLE" - -#: cobc/parser.y:12130 -#, c-format -msgid "HANDLE clause invalid for %s" -msgstr "clause HANDLE invalide pour %s" - -#: cobc/parser.y:12361 cobc/parser.y:15495 -#, c-format -msgid "%s is invalid in nested program" -msgstr "%s est invalide dans un programme imbriqué" - -#: cobc/parser.y:12399 cobc/parser.y:12440 cobc/parser.y:12451 -#: cobc/parser.y:12462 -#, c-format -msgid "maximum evaluate depth exceeded (%d)" -msgstr "profondeur évaluée maximum dépassée (%d)" - -#: cobc/parser.y:12503 cobc/parser.y:12513 -msgid "WHEN without imperative statement" -msgstr "" - -#: cobc/parser.y:12531 cobc/parser.y:12541 -msgid "WHEN OTHER without imperative statement" -msgstr "" - -#: cobc/parser.y:12621 -msgid "invalid THROUGH usage" -msgstr "utilisation de THROUGH invalide" - -#: cobc/parser.y:12700 -msgid "EXIT PROGRAM is not allowed within a USE GLOBAL procedure" -msgstr "EXIT PROGRAM n'est pas permis dans une procédure USE GLOBAL" - -#: cobc/parser.y:12704 -msgid "EXIT PROGRAM not allowed within a FUNCTION" -msgstr "EXIT PROGRAM n'est pas permis dans une FUNCTION" - -#: cobc/parser.y:12713 cobc/parser.y:12926 -#, fuzzy -msgid "RETURNING/GIVING not allowed for non-returning runtime elements" -msgstr "RETURNING/GIVING pas permis dans des sources qui ne retournent pas" - -#: cobc/parser.y:12725 -msgid "EXIT FUNCTION is not allowed within a USE GLOBAL procedure" -msgstr "EXIT FUNCTION n'est pas permis dans une procédure USE GLOBAL" - -#: cobc/parser.y:12729 -msgid "EXIT FUNCTION only allowed within a FUNCTION" -msgstr "EXIT FUNCTION uniquement permis dans une FUNCTION" - -#: cobc/parser.y:12743 cobc/parser.y:12766 -msgid "EXIT PERFORM is only valid with inline PERFORM" -msgstr "EXIT PERFORM est uniquement valide dans un PERFORM en ligne" - -#: cobc/parser.y:12788 -msgid "EXIT SECTION is only valid with an active SECTION" -msgstr "EXIT SECTION est uniquement valide dans une SECTION active" - -#: cobc/parser.y:12809 -msgid "EXIT PARAGRAPH is only valid with an active PARAGRAPH" -msgstr "EXIT PARAGRAPH est uniquement valide dans un PARAGRAPH actif" - -#: cobc/parser.y:12956 -msgid "IF without imperative statement" -msgstr "" - -#: cobc/parser.y:13173 -msgid "TALLYING clause is incomplete" -msgstr "la clause TALLYING est incomplète" - -#: cobc/parser.y:13289 -msgid "INSPECT missing ALL/FIRST/LEADING/TRAILING" -msgstr "il manque ALL/FIRST/LEADING/TRAILING dans INSPECT" - -#: cobc/parser.y:13407 -msgid "JSON PARSE" -msgstr "" - -#: cobc/parser.y:13552 -msgid "LOCK clauses" -msgstr "clauses LOCK" - -#: cobc/parser.y:13717 -msgid "inline PERFORM without imperative statement" -msgstr "" - -#: cobc/parser.y:13838 cobc/parser.y:13846 cobc/parser.y:13854 -#, c-format -msgid "PERFORM VARYING '%s' (line %d of %s) is not a numeric field" -msgstr "" - -#: cobc/parser.y:13870 -#, fuzzy -msgid "PERFORM VARYING without BY phrase" -msgstr "ODO sans phrase TO" - -#: cobc/parser.y:13910 -#, fuzzy, c-format -msgid "'%s' is not an object-reference" -msgstr "« %s » n'est pas un entier" - -#: cobc/parser.y:13951 cobc/typeck.c:10958 cobc/typeck.c:12100 -msgid "LOCK clause invalid with file LOCK AUTOMATIC" -msgstr "clause LOCK invalide avec un fichier LOCK AUTOMATIC" - -#: cobc/parser.y:13956 -msgid "KEY clause invalid with this file type" -msgstr "clause KEY invalide dans ce type de fichier" - -#: cobc/parser.y:13961 cobc/typeck.c:10954 cobc/typeck.c:12096 -msgid "INVALID KEY clause invalid with this file type" -msgstr "clause INVALID KEY invalide avec ce type de fichier" - -#: cobc/parser.y:14591 -msgid "file sort requires KEY phrase" -msgstr "le tri du fichier requiert la phrase KEY" - -#: cobc/parser.y:14615 -#, fuzzy -msgid "table SORT requires KEY phrase" -msgstr "le tri du fichier requiert la phrase KEY" - -#: cobc/parser.y:14677 -msgid "file sort requires USING or INPUT PROCEDURE" -msgstr "le tri d'un fichier requiert USING ou INPUT PROCEDURE" - -#: cobc/parser.y:14684 -msgid "USING invalid with table SORT" -msgstr "USING invalide avec SORT sur une table" - -#: cobc/parser.y:14694 -msgid "INPUT PROCEDURE invalid with table SORT" -msgstr "INPUT PROCEDURE invalide avec SORT sur une table" - -#: cobc/parser.y:14696 -msgid "INPUT PROCEDURE invalid with MERGE" -msgstr "INPUT PROCEDURE invalide avec MERGE" - -#: cobc/parser.y:14709 -msgid "file sort requires GIVING or OUTPUT PROCEDURE" -msgstr "le tri d'un fichier requiert GIVING ou OUTPUT PROCEDURE" - -#: cobc/parser.y:14716 -msgid "GIVING invalid with table SORT" -msgstr "GIVING invalide avec SORT sur une table" - -#: cobc/parser.y:14726 -msgid "OUTPUT PROCEDURE invalid with table SORT" -msgstr "OUTPUT PROCEDURE invalide avec SORT sur une table" - -#: cobc/parser.y:14753 -msgid "SIZE/LENGTH invalid here" -msgstr "SIZE/LENGTH invalide ici" - -#: cobc/parser.y:14806 -msgid "NOT EQUAL condition not allowed on START statement" -msgstr "condition NOT EQUAL pas permise sur une instruction START" - -#: cobc/parser.y:14872 -#, c-format -msgid "%s is replaced by %s" -msgstr "%s est remplacé par %s" - -#: cobc/parser.y:14925 -msgid "STOP literal" -msgstr "littéral STOP" - -#: cobc/parser.y:14929 -msgid "STOP identifier" -msgstr "identificateur STOP" - -#: cobc/parser.y:15066 -msgid "SUPPRESS statement must be within DECLARATIVES" -msgstr "une instruction SUPPRESS doit être entre DECLARATIVES" - -#: cobc/parser.y:15140 -msgid "UNLOCK invalid for SORT files" -msgstr "UNLOCK invalide pour des fichiers avec SORT" - -#: cobc/parser.y:15276 cobc/parser.y:15355 -msgid "USE statement must be within DECLARATIVES" -msgstr "l'instruction USE doit être entre DECLARATIVES" - -#: cobc/parser.y:15278 -msgid "SECTION header missing before USE statement" -msgstr "en-tête de SECTION manquant avant l'instruction USE" - -#: cobc/parser.y:15357 -msgid "USE DEBUGGING not supported in contained program" -msgstr "USE DEBUGGING pas supporté dans le programme contenu" - -#: cobc/parser.y:15405 cobc/parser.y:15414 cobc/parser.y:15432 -#: cobc/parser.y:15468 cobc/typeck.c:3792 -#, fuzzy, c-format -msgid "duplicate DEBUGGING target: '%s'" -msgstr "directive DEFINE « %s » dupliquée" - -#: cobc/parser.y:15430 -#, fuzzy -msgid "constant item cannot be used here" -msgstr "une constante ne peut pas être utilisée ici – « %s »" - -#: cobc/parser.y:15456 -msgid "duplicate USE DEBUGGING ON ALL PROCEDURES" -msgstr "USE DEBUGGING ON ALL PROCEDURES dupliqué" - -#: cobc/parser.y:15528 -#, fuzzy, c-format -msgid "'%s' is not a report group" -msgstr "« %s » n'est pas un nom de rapport" - -#: cobc/parser.y:15710 -msgid "ENCODING clause must come before XML-DECLARATION" -msgstr "" - -#: cobc/parser.y:15712 -msgid "ENCODING clause must come before ATTRIBUTES" -msgstr "" - -#: cobc/parser.y:15715 -msgid "XML GENERATE ENCODING clause" -msgstr "" - -#: cobc/parser.y:15722 -msgid "XML-DECLARATION clause must come before ATTRIBUTES" -msgstr "" - -#: cobc/parser.y:15725 -msgid "XML GENERATE XML-DECLARATION clause" -msgstr "" - -#: cobc/parser.y:15731 -msgid "XML GENERATE WITH ATTRIBUTES clause" -msgstr "" - -#: cobc/parser.y:15744 -msgid "XML GENERATE NAMESPACE clause" -msgstr "" - -#: cobc/parser.y:15768 -msgid "XML GENERATE NAME OF clause" -msgstr "" - -#: cobc/parser.y:15799 -msgid "XML GENERATE TYPE OF clause" -msgstr "" - -#: cobc/parser.y:15840 -msgid "XML GENERATE SUPPRESS clause" -msgstr "" - -#: cobc/parser.y:15914 -msgid "XML PARSE" -msgstr "" - -#: cobc/parser.y:15955 cobc/parser.y:16633 cobc/parser.y:16729 -#: cobc/parser.y:16815 -#, c-format -msgid "'%s' is not a file name" -msgstr "« %s » n'est pas un nom de fichier" - -#: cobc/parser.y:16161 -msgid "NOT SIZE ERROR before SIZE ERROR" -msgstr "NOT SIZE ERROR avant SIZE ERROR" - -#: cobc/parser.y:16207 -msgid "NOT OVERFLOW before OVERFLOW" -msgstr "NOT OVERFLOW avant OVERFLOW" - -#: cobc/parser.y:16306 -msgid "NOT AT END-OF-PAGE before AT END-OF-PAGE" -msgstr "NOT AT END-OF-PAGE avant AT END-OF-PAGE" - -#: cobc/parser.y:16356 -msgid "NOT INVALID KEY before INVALID KEY" -msgstr "NOT INVALID KEY avant INVALID KEY" - -#: cobc/parser.y:16619 -msgid "LINAGE-COUNTER must be qualified here" -msgstr "LINAGE-COUNTER doit être qualifié ici" - -#: cobc/parser.y:16622 -msgid "invalid LINAGE-COUNTER usage" -msgstr "utilisation de LINAGE-COUNTER invalide" - -#: cobc/parser.y:16643 -msgid "LINE-COUNTER must be qualified here" -msgstr "LINE-COUNTER doit être qualifié ici" - -#: cobc/parser.y:16647 -msgid "invalid LINE-COUNTER usage" -msgstr "utilisation de LINE-COUNTER invalide" - -#: cobc/parser.y:16658 cobc/parser.y:16683 -#, c-format -msgid "'%s' is not a report name" -msgstr "« %s » n'est pas un nom de rapport" - -#: cobc/parser.y:16668 -msgid "PAGE-COUNTER must be qualified here" -msgstr "PAGE-COUNTER doit être qualifié ici" - -#: cobc/parser.y:16672 -msgid "invalid PAGE-COUNTER usage" -msgstr "utilisation de PAGE-COUNTER invalide" - -#: cobc/parser.y:16719 cobc/typeck.c:10919 cobc/typeck.c:11004 -#: cobc/typeck.c:12064 -#, c-format -msgid "%s requires a record name as subject" -msgstr "%s requiert un nom d'enregistrement comme sujet" - -#: cobc/parser.y:16746 -#, c-format -msgid "'%s' not indexed" -msgstr "« %s » pas indexé" - -#: cobc/parser.y:16772 cobc/parser.y:16797 -#, c-format -msgid "multiple reference to '%s' " -msgstr "références multiples à « %s » " - -#: cobc/parser.y:16827 -#, c-format -msgid "'%s' is not a CD name" -msgstr "« %s » n'est pas un nom CD" - -#: cobc/parser.y:16841 -#, fuzzy, c-format -msgid "'%s' is not a valid report name" -msgstr "« %s » n'est pas un nom de rapport" - -#: cobc/parser.y:17092 -msgid "invalid mnemonic identifier" -msgstr "identificateur de mnémonique invalide" - -#: cobc/parser.y:17172 -#, fuzzy -msgid "a numeric literal is expected here" -msgstr "un littéral non numérique est attendu pour « %s »" - -#: cobc/parser.y:17184 cobc/parser.y:17886 -#, fuzzy -msgid "a non-numeric literal is expected here" -msgstr "un littéral non numérique est attendu pour « %s »" - -#: cobc/parser.y:17357 cobc/typeck.c:6116 cobc/typeck.c:6123 -#, c-format -msgid "'%s' is not numeric" -msgstr "« %s » n'est pas numérique" - -#: cobc/parser.y:17373 -#, c-format -msgid "'%s' is not a field or file" -msgstr "« %s » n'est pas un champ ou un fichier" - -#: cobc/parser.y:17393 cobc/parser.y:17411 -#, c-format -msgid "'%s' is not a field" -msgstr "« %s » n'est pas un champ" - -#: cobc/parser.y:17533 -#, fuzzy, c-format -msgid "'%s' is not a field or alphabet" -msgstr "« %s » n'est pas un champ ou un fichier" - -#: cobc/parser.y:17559 -#, fuzzy -msgid "a subscripted data-item cannot be used here" -msgstr "« %s » ne peut pas être utilisé ici" - -#: cobc/parser.y:17609 -#, fuzzy -msgid "unsigned integer value expected" -msgstr "valeur entière positive non signée attendue" - -#: cobc/parser.y:17621 cobc/parser.y:17625 cobc/parser.y:17675 -msgid "integer value expected" -msgstr "valeur entière attendue" - -#: cobc/parser.y:17630 -msgid "invalid symbolic integer" -msgstr "entier symbolique invalide" - -#: cobc/parser.y:17646 cobc/parser.y:17650 -msgid "unsigned positive integer value expected" -msgstr "valeur entière positive non signée attendue" - -#: cobc/parser.y:17679 -msgid "invalid CLASS value" -msgstr "valeur CLASS invalide" - -#: cobc/parser.y:17767 -msgid "PHYSICAL argument for LENGTH functions" -msgstr "" - -#: cobc/parser.y:17938 cobc/parser.y:17955 -msgid "cannot specify offset and SYSTEM-OFFSET at the same time" -msgstr "ne peut spécifier le décalage et SYSTEM-OFFSET en même temps" - -#: cobc/pplex.l:223 cobc/pplex.l:1739 -msgid "debugging indicator" -msgstr "indicateur de débogage" - -#: cobc/pplex.l:300 -msgid "ignoring empty directive" -msgstr "directive vide ignorée" - -#: cobc/pplex.l:310 cobc/pplex.l:369 -#, c-format -msgid "ignoring invalid directive: '%s'" -msgstr "directive invalide ignorée : « %s »" - -#: cobc/pplex.l:317 -msgid "ignoring invalid directive" -msgstr "directive invalide ignorée" - -#: cobc/pplex.l:324 -msgid "VCS directive" -msgstr "directive VCS" - -#: cobc/pplex.l:377 cobc/pplex.l:392 -msgid "spurious '$' detected - ignored" -msgstr "« $ » inattendu détecté – ignoré" - -#: cobc/pplex.l:386 -#, fuzzy, c-format -msgid "ignoring unknown directive: '%s'" -msgstr "directive invalide ignorée : « %s »" - -#: cobc/pplex.l:398 -msgid "PROCESS statement ignored" -msgstr "instruction PROCESS ignorée" - -#: cobc/pplex.l:864 -msgid "IF/ELIF/ELSE directive without matching END-IF" -msgstr "directive IF/ELIF/ELSE sans END-IF correspondant" - -#: cobc/pplex.l:981 -#, fuzzy -msgid "file was included here" -msgstr "le fichier de configuration a été inclus ici" - -#: cobc/pplex.l:1186 -#, c-format -msgid "directive nest depth exceeded: %d" -msgstr "profondeur d'imbrication des directives dépassée : %d" - -#: cobc/pplex.l:1204 -msgid "ELSE directive without matching IF/ELIF" -msgstr "directive ELSE sans IF/ELIF correspondant" - -#: cobc/pplex.l:1220 -msgid "END-IF directive without matching IF/ELIF/ELSE" -msgstr "directive END-IF sans IF/ELIF/ELSE correspondant" - -#: cobc/pplex.l:1236 -msgid "ELIF directive without matching IF/ELIF" -msgstr "directive ELIF sans IF/ELIF correspondant" - -#: cobc/pplex.l:1258 -#, c-format -msgid "invalid internal case: %u" -msgstr "cas interne invalide : %u" - -#: cobc/pplex.l:1395 -msgid "buffer overrun - too many continuation lines" -msgstr "débordement du tampon – trop de lignes de continuation" - -#: cobc/pplex.l:1485 cobc/pplex.l:1494 -msgid "line not terminated by a newline" -msgstr "ligne pas terminée par un saut de ligne" - -#: cobc/pplex.l:1488 cobc/pplex.l:1497 -#, c-format -msgid "source text exceeds %d bytes, will be truncated" -msgstr "le texte source dépasse %d octets, il sera tronqué" - -#: cobc/pplex.l:1516 -msgid "version control conflict marker in file" -msgstr "" - -#: cobc/pplex.l:1727 -msgid "invalid continuation in comment entry" -msgstr "continuation invalide dans une entrée commentaire" - -#: cobc/pplex.l:1732 -msgid "continuation of COBOL words" -msgstr "continuation des mots COBOL" - -#: cobc/pplex.l:1752 -#, c-format -msgid "invalid indicator '%c' at column 7" -msgstr "indicateur « %c » invalide à la colonne 7" - -#: cobc/pplex.l:1800 cobc/pplex.l:1811 -msgid "invalid line continuation" -msgstr "continuation de ligne invalide" - -#: cobc/pplex.l:1819 -msgid "continuation character expected" -msgstr "caractère de continuation attendu" - -#: cobc/pplex.l:1885 -#, c-format -msgid "source text after program-text area (column %d)" -msgstr "texte source après la zone de texte de programme (colonne %d)" - -#: cobc/ppparse.y:225 -msgid "directive comparison on different types" -msgstr "comparaison de directive sur des types différents" - -#: cobc/ppparse.y:293 -#, c-format -msgid "duplicate DEFINE directive '%s'" -msgstr "directive DEFINE « %s » dupliquée" - -#: cobc/ppparse.y:300 cobc/ppparse.y:310 -msgid "invalid constant in DEFINE directive" -msgstr "constante invalide dans la directive DEFINE" - -#: cobc/ppparse.y:408 -#, c-format -msgid "compiler flag '%s' unknown" -msgstr "" - -#: cobc/ppparse.y:454 -#, fuzzy, c-format -msgid "invalid %s directive option '%s'" -msgstr "directive %s invalide" - -#: cobc/ppparse.y:667 -msgid "*CONTROL statement" -msgstr "instruction CONTROL" - -#: cobc/ppparse.y:933 cobc/ppparse.y:1004 cobc/ppparse.y:1141 -#, c-format -msgid "invalid %s directive" -msgstr "directive %s invalide" - -#: cobc/ppparse.y:1043 -msgid "LEAP-SECOND ON directive" -msgstr "directive LEAP-SECOND ON" - -#: cobc/ppparse.y:1051 -msgid "TURN directive" -msgstr "directive TURN" - -#: cobc/ppparse.y:1133 cobc/ppparse.y:1158 -msgid "invalid constant" -msgstr "constante invalide" - -#: cobc/reserved.c:3797 -msgid "device name" -msgstr "nom de périphérique" - -#: cobc/reserved.c:3800 -msgid "switch name" -msgstr "nom de commutateur" - -#: cobc/reserved.c:3803 -msgid "feature name" -msgstr "nom de fonctionnalité" - -#: cobc/reserved.c:3902 -#, c-format -msgid "reserved word must have less than %d characters" -msgstr "les mots réservés doivent avoir moins de %d caractères" - -#: cobc/reserved.c:3921 -msgid "ignored asterisk at end of alias target" -msgstr "astérisque ignoré à la fin de la cible du synonyme" - -#: cobc/reserved.c:3984 -#, c-format -msgid "alias target '%s' is not a default reserved word" -msgstr "la cible du synonyme « %s » n'est pas un mot réservé par défaut" - -#: cobc/reserved.c:4447 -#, c-format -msgid "invalid system-name '%s'" -msgstr "non système « %s » invalide" - -#: cobc/reserved.c:4584 -#, c-format -msgid "'%s' is a reserved word, but isn't supported" -msgstr "« %s » est un mot réservé mais n'est pas supporté" - -#: cobc/reserved.c:4689 -#, c-format -msgid "intrinsic function %s is unknown" -msgstr "la fonction intrinsèque %s est inconnue" - -#: cobc/reserved.c:4717 -msgid "Intrinsic Function" -msgstr "Fonction Intrinsèque" - -#: cobc/reserved.c:4717 cobc/reserved.c:4897 cobc/reserved.c:5034 -msgid "Implemented" -msgstr "Implémenté" - -#: cobc/reserved.c:4717 cobc/typeck.c:1022 -msgid "Parameters" -msgstr "Paramètres" - -#: cobc/reserved.c:4721 cobc/reserved.c:4901 cobc/reserved.c:5048 -msgid "Yes" -msgstr "Oui" - -#: cobc/reserved.c:4724 cobc/reserved.c:4904 cobc/reserved.c:5054 -msgid "No" -msgstr "Non" - -#: cobc/reserved.c:4730 -msgid "Unlimited" -msgstr "Illimité" - -#: cobc/reserved.c:4804 -#, fuzzy, c-format -msgid "special register %s is unknown, needs a definition" -msgstr "le registre spécial %s est inconnu, on a besoin d'une définition" - -#: cobc/reserved.c:4810 -#, c-format -msgid "special register %s is unknown" -msgstr "le registre spécial %s est inconnu" - -#: cobc/reserved.c:4897 -msgid "Internal registers" -msgstr "Registres internes" - -#: cobc/reserved.c:4897 -msgid "Definition" -msgstr "Définition" - -#: cobc/reserved.c:4985 -#, fuzzy, c-format -msgid "unknown system-name '%s'" -msgstr "instruction « %s » inconnue" - -#: cobc/reserved.c:5011 -msgid "System names" -msgstr "Noms systèmes" - -#: cobc/reserved.c:5034 -msgid "Reserved Words" -msgstr "Mots Réservés" - -#: cobc/reserved.c:5046 -msgid "Yes (Context sensitive)" -msgstr "Oui (Sensible au contexte)" - -#: cobc/reserved.c:5052 -msgid "No (Context sensitive)" -msgstr "Non (Sensible au contexte)" - -#: cobc/reserved.c:5081 -msgid "Extra (obsolete) context sensitive words" -msgstr "Mots sensibles au contexte supplémentaire (obsolète)" - -#: cobc/scanner.l:265 cobc/scanner.l:2288 -#, fuzzy, c-format -msgid "'%s' is not a default reserved word, so cannot be aliased" -msgstr "« %s » n'est pas défini mais est un mot réservé d'un autre dialecte" - -#: cobc/scanner.l:268 -#, fuzzy, c-format -msgid "'%s' is not a reserved word; you may want ADDSYN or OVERRIDE instead" -msgstr "« %s » est un mot réservé mais n'est pas supporté" - -#: cobc/scanner.l:988 -#, c-format -msgid "a constant may not be used here - '%s'" -msgstr "une constante ne peut pas être utilisée ici – « %s »" - -#: cobc/scanner.l:1043 -msgid "ignoring redundant ." -msgstr "ignore le redondant ." - -#: cobc/scanner.l:1101 -#, c-format -msgid "invalid symbol '%s' - skipping word" -msgstr "symbole « %s » invalide – passe outre le mot" - -#: cobc/scanner.l:1191 -msgid "invalid national literal" -msgstr "littéral national invalide" - -#: cobc/scanner.l:1202 cobc/tree.c:2531 -#, c-format -msgid "invalid literal: '%s'" -msgstr "littéral invalide : « %s »" - -#: cobc/scanner.l:1204 -#, c-format -msgid "invalid hexadecimal literal: '%s'" -msgstr "littéral hexadécimal invalide : « %s »" - -#: cobc/scanner.l:1206 cobc/tree.c:1613 -#, c-format -msgid "invalid numeric literal: '%s'" -msgstr "littéral numérique invalide : « %s »" - -#: cobc/scanner.l:1208 -#, c-format -msgid "invalid floating-point literal: '%s'" -msgstr "littéral en virgule flottante invalide : « %s »" - -#: cobc/scanner.l:1210 -#, c-format -msgid "invalid %s literal: '%s'" -msgstr "littéral %s invalide : « %s »" - -#: cobc/scanner.l:1261 -#, c-format -msgid "literal length exceeds %d characters" -msgstr "la longueur du littéral dépasse %d caractères" - -#: cobc/scanner.l:1277 cobc/scanner.l:1326 cobc/scanner.l:1620 -#, fuzzy -msgid "zero-length literal" -msgstr "littéral booléen numérique" - -#: cobc/scanner.l:1280 -#, fuzzy -msgid "national literal has zero length; a SPACE will be assumed" -msgstr "le littéral alphanumérique a une longueur nulle; une ESPACE est supposée" - -#: cobc/scanner.l:1281 -msgid "alphanumeric literal has zero length; a SPACE will be assumed" -msgstr "le littéral alphanumérique a une longueur nulle; une ESPACE est supposée" - -#: cobc/scanner.l:1293 cobc/scanner.l:1294 cobc/scanner.l:1298 -#: cobc/scanner.l:1365 -msgid "national literal" -msgstr "littéral national" - -#: cobc/scanner.l:1297 -#, fuzzy -msgid "national-character literal" -msgstr "littéral national" - -#: cobc/scanner.l:1330 -#, fuzzy -msgid "hexadecimal literal has zero length; X'00' will be assumed" -msgstr "le littéral alphanumérique a une longueur nulle; une ESPACE est supposée" - -#: cobc/scanner.l:1349 -msgid "hexadecimal-boolean literal" -msgstr "littéral booléen-hexadécimal" - -#: cobc/scanner.l:1356 cobc/scanner.l:1370 cobc/scanner.l:1485 -#: cobc/scanner.l:1544 cobc/scanner.l:1642 cobc/scanner.l:1711 cobc/tree.c:2532 -#, c-format -msgid "literal length %d exceeds %d characters" -msgstr "la longueur %d du littéral dépasse %d caractères" - -#: cobc/scanner.l:1362 -msgid "hexadecimal-national literal" -msgstr "littéral hexadécimal-national" - -#: cobc/scanner.l:1393 cobc/scanner.l:1425 cobc/scanner.l:1560 -#: cobc/scanner.l:1656 cobc/scanner.l:1721 -#, c-format -msgid "literal contains invalid character '%c'" -msgstr "le littéral contient le caractère invalide « %c »" - -#: cobc/scanner.l:1449 -#, c-format -msgid "literal does not have an even number of digits" -msgstr "le littéral n'a pas un nombre paire de chiffres" - -#: cobc/scanner.l:1492 -#, fuzzy, c-format -msgid "%s literals must contain at least one character" -msgstr "le littéral contient le caractère invalide « %c »" - -#: cobc/scanner.l:1527 cobc/scanner.l:1628 cobc/scanner.l:1702 -msgid "ACUCOBOL numeric literal" -msgstr "littéral numérique ACUCOBOL" - -#: cobc/scanner.l:1537 -#, fuzzy -msgid "H literals must contain at least one character" -msgstr "le littéral contient le caractère invalide « %c »" - -#: cobc/scanner.l:1575 cobc/scanner.l:1667 cobc/scanner.l:1732 -#, c-format -msgid "literal exceeds limit %u" -msgstr "le littéral dépasse la limite %u" - -#: cobc/scanner.l:1616 -msgid "numeric boolean literal" -msgstr "littéral booléen numérique" - -#: cobc/scanner.l:1622 -#, fuzzy -msgid "Boolean literal has zero length; B'0' will be assumed" -msgstr "le littéral alphanumérique a une longueur nulle; une ESPACE est supposée" - -#: cobc/scanner.l:1698 -#, fuzzy -msgid "HP COBOL octal literal" -msgstr "littéral numérique ACUCOBOL" - -#: cobc/scanner.l:1810 cobc/tree.c:1624 -#, c-format -msgid "literal length %d exceeds maximum of %d digits" -msgstr "la longueur %d du littéral dépasse le maximum de %d chiffres" - -#: cobc/scanner.l:1816 cobc/tree.c:1629 -#, c-format -msgid "literal length %d exceeds %d digits" -msgstr "la longueur %d du littéral dépasse %d chiffres" - -#: cobc/scanner.l:1928 cobc/tree.c:3513 -#, fuzzy, c-format -msgid "significand has more than %d digits" -msgstr "la mantisse a plus de 34 chiffres" - -#: cobc/scanner.l:1933 -#, c-format -msgid "exponent has decimal point" -msgstr "l'exposant a un point décimal" - -#: cobc/scanner.l:1939 cobc/tree.c:3521 -#, c-format -msgid "exponent has more than 4 digits" -msgstr "l'exposant a plus de 4 chiffres" - -#: cobc/scanner.l:1969 -#, fuzzy, c-format -msgid "exponent not between -6143 and 6144" -msgstr "l'exposant n'est pas entre -78 et 76" - -#: cobc/scanner.l:1978 -#, c-format -msgid "significand of 0 must be positive" -msgstr "la mantisse de zéro doit être positive" - -#: cobc/scanner.l:1983 -#, c-format -msgid "exponent of 0 must be 0" -msgstr "l'exposant de 0 doit être 0" - -#: cobc/scanner.l:1988 -#, c-format -msgid "exponent of 0 must be positive" -msgstr "l'exposant de 0 doit être positif" - -#: cobc/scanner.l:2170 -#, c-format -msgid "invalid CONSTANT: %s" -msgstr "CONSTANT invalide : %s" - -#: cobc/scanner.l:2180 -#, c-format -msgid "invalid alphanumeric CONSTANT: %s" -msgstr "CONSTANT alphanumérique invalide : %s" - -#: cobc/scanner.l:2184 -#, c-format -msgid "empty alphanumeric CONSTANT: %s" -msgstr "CONSTANT alphanumérique vide : %s" - -#: cobc/scanner.l:2201 cobc/scanner.l:2209 cobc/scanner.l:2214 -#, c-format -msgid "invalid numeric CONSTANT: %s" -msgstr "CONSTANT numérique invalide : %s" - -#: cobc/scanner.l:2291 -#, c-format -msgid "'%s' is already reserved; you may want MAKESYN instead" -msgstr "" - -#: cobc/tree.c:341 -#, c-format -msgid "%s clause is required for file '%s'" -msgstr "la clause %s est requise pour le fichier « %s »" - -#: cobc/tree.c:345 -#, c-format -msgid "%s clause is invalid for file '%s' (file type)" -msgstr "la clause %s est invalide pour le fichier « %s » (type fichier)" - -#: cobc/tree.c:349 -#, c-format -msgid "%s clause is invalid for file '%s'" -msgstr "la clause %s est invalide pour le fichier « %s »" - -#: cobc/tree.c:376 -#, c-format -msgid "FOR item '%s' is a record" -msgstr "élément FOR « %s » dans un enregistrement" - -#: cobc/tree.c:385 -#, c-format -msgid "FOR item '%s' is in different record to '%s'" -msgstr "l'élément FOR « %s » est dans un enregistrement différent de « %s »" - -#: cobc/tree.c:394 -#, c-format -msgid "FOR item '%s' is not in a record associated with '%s'" -msgstr "l'élément FOR « %s » n'est pas un enregistrement associé avec « %s »" - -#: cobc/tree.c:477 -msgid "internal error node" -msgstr "nÅ“ud d'erreur interne" - -#: cobc/tree.c:479 -msgid "unknown constant" -msgstr "constante inconnue" - -#: cobc/tree.c:639 -#, fuzzy, c-format -msgid "FUNCTION %s has invalid/not supported arguments - tag %d" -msgstr "FUNCTION %s a des arguments invalides ou non supportés – Balise %d" - -#: cobc/tree.c:760 -#, c-format -msgid "invalid date/time function: '%d'" -msgstr "fonction date/heure invalide : « %d »" - -#: cobc/tree.c:798 -#, c-format -msgid "FUNCTION '%s' has invalid date/time format" -msgstr "FUNCTION « %s » a un format date/heure invalide" - -#: cobc/tree.c:805 -#, c-format -msgid "FUNCTION '%s' has format in variable" -msgstr "FUNCTION « %s » a un format dans un variable" - -#: cobc/tree.c:1186 -#, fuzzy, c-format -msgid "literal '%s'" -msgstr "littéral invalide : « %s »" - -#: cobc/tree.c:1315 -#, c-format -msgid "unknown tree tag: %d, category: %d" -msgstr "balise d'arbre inconnue : %d, catégorie : %d" - -#: cobc/tree.c:1405 -#, c-format -msgid "unexpected numeric USAGE: %d" -msgstr "USAGE numérique inattendu : %d" - -#: cobc/tree.c:1419 -#, c-format -msgid "unexpected category: %d" -msgstr "catégorie inattendue : %d" - -#: cobc/tree.c:1678 cobc/tree.c:1690 cobc/tree.c:1752 cobc/tree.c:1802 -#, c-format -msgid "numeric literal '%s' exceeds limit '%s'" -msgstr "le littéral numérique « %s » dépasse la limite « %s »" - -#: cobc/tree.c:2387 -msgid "invalid LOCALE literal" -msgstr "littéral LOCALE invalide" - -#: cobc/tree.c:2512 -msgid "only literals with the same category can be concatenated" -msgstr "seuls des littéraux avec la même catégorie peuvent être concaténés" - -#: cobc/tree.c:2519 -#, fuzzy -msgid "only alphanumeric, national or boolean literals may be concatenated" -msgstr "seuls des littéraux alphanumériques, nationaux ou booléens peuvent être concaténés" - -#: cobc/tree.c:2791 -msgid "B, 0 or /" -msgstr "B, 0 ou /" - -#: cobc/tree.c:2805 -msgid "the sign of the floating-point exponent" -msgstr "le signe de l'exposant en virgule flottante" - -#: cobc/tree.c:2807 -msgid "a leading +/- sign" -msgstr "un signe +/- au début" - -#: cobc/tree.c:2809 -msgid "a trailing +/- sign" -msgstr "un signe +/- à la fin" - -#: cobc/tree.c:2811 -msgid "CR or DB" -msgstr "CR ou DB" - -#: cobc/tree.c:2813 -msgid "a leading currency symbol" -msgstr "un symbole monétaire au début" - -#: cobc/tree.c:2815 -msgid "a trailing currency symbol" -msgstr "un symbole monétaire à la fin" - -#: cobc/tree.c:2817 -msgid "a Z or * which is before the decimal point" -msgstr "un Z ou * qui est avant le point décimal" - -#: cobc/tree.c:2819 -msgid "a Z or * which is after the decimal point" -msgstr "un Z ou * qui est après le point décimal" - -#: cobc/tree.c:2821 -msgid "a floating +/- string which is before the decimal point" -msgstr "une chaîne +/- flottante qui est avant le point décimal" - -#: cobc/tree.c:2823 -msgid "a floating +/- string which is after the decimal point" -msgstr "une chaîne +/- flottante qui est après le point décimal" - -#: cobc/tree.c:2825 -msgid "a floating currency symbol string which is before the decimal point" -msgstr "une chaîne du symbole de la devise monétaire qui est avant le point décimal" - -#: cobc/tree.c:2827 -msgid "a floating currency symbol string which is after the decimal point" -msgstr "une chaîne du symbole de la devise monétaire qui est après le point décimal" - -#: cobc/tree.c:2831 -msgid "A or X" -msgstr "A ou X" - -#: cobc/tree.c:2837 -msgid "a P which is before the decimal point" -msgstr "un P qui est avant le point décimal" - -#: cobc/tree.c:2839 -msgid "a P which is after the decimal point" -msgstr "un P qui est après le point décimal" - -#: cobc/tree.c:2860 cobc/tree.c:3267 -#, c-format -msgid "%s may only occur once in a PICTURE string" -msgstr "%s peut apparaître une seule fois dans la chaîne de PICTURE" - -#: cobc/tree.c:2862 cobc/tree.c:3219 -#, c-format -msgid "%s cannot follow %s" -msgstr "%s ne peut pas suivre %s" - -#: cobc/tree.c:2865 -msgid "invalid PICTURE string detected" -msgstr "une chaîne PICTURE invalide a été détectée" - -#: cobc/tree.c:2976 -msgid "number or constant in parentheses is not an unsigned integer" -msgstr "le nombre ou la constante entre parenthèses n'est pas un entier non signé" - -#: cobc/tree.c:2985 -msgid "only up to 9 significant digits are permitted within parentheses" -msgstr "au maximum 9 chiffres significatifs sont permis entre parenthèses" - -#: cobc/tree.c:2991 -msgid "number or constant in parentheses must be greater than zero" -msgstr "le nombre ou la constante entre parenthèses doit être plus grand que zéro" - -#: cobc/tree.c:3002 -msgid "parentheses must be preceded by a picture symbol" -msgstr "" - -#: cobc/tree.c:3032 -msgid "unbalanced parentheses" -msgstr "parenthèses déséquilibrées" - -#: cobc/tree.c:3040 -#, fuzzy -msgid "parentheses must contain an unsigned integer" -msgstr "les parenthèses doivent contenir (un nom de constant défini comme) un entier positif" - -#: cobc/tree.c:3078 -#, c-format -msgid "'%s' is not a constant-name" -msgstr "« %s » n'est pas un nom constant" - -#: cobc/tree.c:3085 -#, c-format -msgid "'%s' is not a numeric literal" -msgstr "« %s » n'est pas un littéral numérique" - -#: cobc/tree.c:3089 -#, c-format -msgid "'%s' is not an integer" -msgstr "« %s » n'est pas un entier" - -#: cobc/tree.c:3093 -#, c-format -msgid "'%s' is not unsigned" -msgstr "« %s » n'est pas non signé" - -#: cobc/tree.c:3149 -msgid "missing PICTURE string" -msgstr "chaîne PICTURE manquante" - -#: cobc/tree.c:3178 -msgid "C must be followed by R" -msgstr "C doit être suivi par R" - -#: cobc/tree.c:3181 -msgid "D must be followed by B" -msgstr "D doit être suivi par B" - -#: cobc/tree.c:3195 cobc/tree.c:3264 cobc/tree.c:3290 cobc/tree.c:3401 -#, fuzzy -msgid "uncommon parentheses" -msgstr "parenthèses déséquilibrées" - -#: cobc/tree.c:3219 -msgid "exponent" -msgstr "" - -#: cobc/tree.c:3272 -msgid "S must be at start of PICTURE string" -msgstr "S doit être au début de la chaîne de PICTURE" - -#: cobc/tree.c:3328 -msgid "P must be at start or end of PICTURE string" -msgstr "P doit être au début ou à la fin de la chaîne de PICTURE" - -#: cobc/tree.c:3358 -msgid "cannot have both Z and * in PICTURE string" -msgstr "Z et * ne peuvent pas être tous les deux dans la chaîne de PICTURE" - -#: cobc/tree.c:3436 -#, c-format -msgid "invalid PICTURE character '%c'" -msgstr "le caractère « %c » est invalide dans PICTURE" - -#: cobc/tree.c:3466 -#, c-format -msgid "PICTURE string may not contain more than %d characters; contains %d characters" -msgstr "la chaîne de PICTURE ne peut pas contenir plus de %d caractères; elle contient %d caractères" - -#: cobc/tree.c:3471 -msgid "PICTURE string must contain at least one of the set A, N, X, Z, 1, 9 and *; or at least two of the set +, - and the currency symbol" -msgstr "la chaîne de PICTURE doit contenir au moins un parmi l'ensemble A, N, X, Z, 1, 9 et * ou au moins deux de l'ensemble +, - et le symbole monétaire" - -#: cobc/tree.c:3498 -#, c-format -msgid "numeric field cannot be larger than %d digits" -msgstr "le champ numérique ne peut pas être plus grand que %d chiffres" - -#: cobc/tree.c:3954 cobc/tree.c:3967 -#, c-format -msgid "no DETAIL line defined in report %s" -msgstr "" - -#: cobc/tree.c:3969 -msgid "PAGE LIMIT FIRST DETAIL should be >= HEADING" -msgstr "" - -#: cobc/tree.c:3972 -msgid "PAGE LIMIT FOOTING should be >= HEADING" -msgstr "" - -#: cobc/tree.c:3974 -msgid "PAGE LIMIT LAST DETAIL should be >= FIRST DETAIL" -msgstr "" - -#: cobc/tree.c:3976 -msgid "PAGE LIMIT FOOTING should be >= LAST DETAIL" -msgstr "" - -#: cobc/tree.c:3978 -msgid "PAGE LIMIT LINES should be >= FOOTING" -msgstr "" - -#: cobc/tree.c:4162 -#, c-format -msgid "maximum keys (%d/%d) exceeded for file '%s'" -msgstr "" - -#: cobc/tree.c:4226 cobc/tree.c:4249 -#, c-format -msgid "invalid KEY item '%s', not in file '%s'" -msgstr "élément KEY « %s » invalide, pas dans le fichier « %s »" - -#: cobc/tree.c:4260 -#, c-format -msgid "minimal record length %d can not hold the key item '%s'; needs to be at least %d" -msgstr "la longueur minimale %d de l'enregistrement ne sait pas contenir l'élément clé « %s »; au moins %d est nécessaire" - -#: cobc/tree.c:4296 -#, fuzzy, c-format -msgid "missing file description for %s" -msgstr "définitions manquantes :" - -#: cobc/tree.c:4328 -#, c-format -msgid "size of record '%s' (%d) smaller than minimum of file '%s' (%d)" -msgstr "la taille de l'enregistrement « %s » (%d) est plus petit que le minimum du fichier « %s » (%d)" - -#: cobc/tree.c:4331 cobc/tree.c:4348 -msgid "file size adjusted" -msgstr "" - -#: cobc/tree.c:4343 -#, c-format -msgid "size of record '%s' (%d) larger than maximum of file '%s' (%d)" -msgstr "la taille de l'enregistrement « %s » (%d) est plus grand que le maximum du fichier « %s » (%d)" - -#: cobc/tree.c:4386 -#, c-format -msgid "file '%s': RECORD VARYING specified without limits, but implied limits are equal" -msgstr "" - -#: cobc/tree.c:4393 -#, c-format -msgid "file '%s': record size (IDX) %d exceeds maximum allowed (%d)" -msgstr "fichier « %s » : la taille %d de l'enregistrement (IDX) dépasse le maximum autorisé (%d)" - -#: cobc/tree.c:4397 -#, c-format -msgid "file '%s': record size %d exceeds maximum allowed (%d)" -msgstr "fichier « %s » : la taille %d de l'enregistrement dépasse le maximum autorisé (%d)" - -#: cobc/tree.c:4404 -msgid "RECORD DELIMITER clause on file with fixed-length records" -msgstr "" - -#: cobc/tree.c:4965 -#, fuzzy, c-format -msgid "literal '%.38s' is longer than '%s'" -msgstr "le littéral est plus grand que le champ" - -#: cobc/tree.c:4969 -#, c-format -msgid "literal '%.38s' is longer than reference-modification of '%s'" -msgstr "" - -#: cobc/tree.c:4994 -#, c-format -msgid "literal '%s' is alphanumeric but '%s' is numeric" -msgstr "" - -#: cobc/tree.c:5036 -#, c-format -msgid "literal '%s' has more decimals than '%s'" -msgstr "" - -#: cobc/tree.c:5078 -#, c-format -msgid "literal '%s' has more digits than '%s'" -msgstr "" - -#: cobc/tree.c:5118 cobc/tree.c:5142 -#, fuzzy, c-format -msgid "unsigned '%s' may not be %s %s" -msgstr "l'élément THRU « %s » ne peut pas être subordonné à « %s »" - -#: cobc/tree.c:5128 cobc/tree.c:5151 -#, c-format -msgid "unsigned '%s' may always be %s %s" -msgstr "" - -#: cobc/tree.c:5184 cobc/tree.c:5209 -#, fuzzy, c-format -msgid "'%s' may not be %s %s" -msgstr "« %s » ne peut pas être utilisé ici" - -#: cobc/tree.c:5195 cobc/tree.c:5220 -#, c-format -msgid "'%s' may always be %s %s" -msgstr "" - -#: cobc/tree.c:5355 -msgid "divide by constant ZERO" -msgstr "division par la constante ZÉRO" - -#: cobc/tree.c:5404 cobc/tree.c:5409 cobc/tree.c:5630 cobc/tree.c:5670 -#: cobc/typeck.c:4476 cobc/typeck.c:4484 cobc/typeck.c:4491 cobc/typeck.c:5561 -#: cobc/typeck.c:5706 -msgid "invalid expression" -msgstr "expression invalide" - -#: cobc/tree.c:5627 -#, fuzzy, c-format -msgid "invalid expression: %s %s %s" -msgstr "expression invalide" - -#: cobc/tree.c:5675 -#, c-format -msgid "unexpected operator: %d" -msgstr "opérateur inattendu : %d" - -#: cobc/tree.c:5685 -#, c-format -msgid "expression '%.38s' %s '%.38s' is always TRUE" -msgstr "l'expression '%.38s' %s '%.38s' est toujours VRAIE" - -#: cobc/tree.c:5691 -msgid "expression is always TRUE" -msgstr "l'expression est toujours VRAIE" - -#: cobc/tree.c:5703 -#, c-format -msgid "expression '%.38s' %s '%.38s' is always FALSE" -msgstr "l'expression '%.38s' %s '%.38s' est toujours FAUSSE" - -#: cobc/tree.c:5709 -msgid "expression is always FALSE" -msgstr "l'expression est toujours FAUSSE" - -#: cobc/tree.c:6024 -msgid "PERFORM FOREVER since UNTIL is always FALSE" -msgstr "PERFORM FOREVER depuis UNTIL est toujours FAUX" - -#: cobc/tree.c:6028 -msgid "PERFORM ONCE since UNTIL is always TRUE" -msgstr "PERFORM ONCE depuis UNTIL est toujours VRAI" - -#: cobc/tree.c:6031 -msgid "PERFORM NEVER since UNTIL is always TRUE" -msgstr "PERFORM NEVER depuis UNTIL est toujours VRAI" - -#: cobc/tree.c:6132 -#, fuzzy, c-format -msgid "no definition/prototype seen for FUNCTION '%s'" -msgstr "pas de définition/prototype vu pour le programme « %s »" - -#: cobc/tree.c:6134 -#, fuzzy, c-format -msgid "no definition/prototype seen for PROGRAM '%s'" -msgstr "pas de définition/prototype vu pour le programme « %s »" - -#: cobc/tree.c:6143 -#, fuzzy, c-format -msgid "no definition/prototype seen for FUNCTION with external name '%s'" -msgstr "pas de définition/prototype vu pour le programme avec le nom externe « %s »" - -#: cobc/tree.c:6145 -#, fuzzy, c-format -msgid "no definition/prototype seen for PROGRAM with external name '%s'" -msgstr "pas de définition/prototype vu pour le programme avec le nom externe « %s »" - -#: cobc/tree.c:6237 -#, fuzzy, c-format -msgid "FUNCTION %s has invalid argument" -msgstr "FUNCTION « %s » a un paramètre invalide" - -#: cobc/tree.c:6239 -#, c-format -msgid "either all arguments or none should be if type %s" -msgstr "" - -#: cobc/tree.c:6271 cobc/tree.c:6277 cobc/tree.c:6319 cobc/tree.c:6324 -#, c-format -msgid "FUNCTION '%s' has invalid reference modification" -msgstr "FUNCTION « %s » a une modification de référence invalide" - -#: cobc/tree.c:6288 cobc/tree.c:6730 -#, c-format -msgid "FUNCTION '%s' unknown" -msgstr "FUNCTION « %s » inconnue" - -#: cobc/tree.c:6292 -#, c-format -msgid "FUNCTION '%s' is not implemented" -msgstr "FUNCTION « %s » n'est pas implémentée" - -#: cobc/tree.c:6299 cobc/tree.c:6306 cobc/tree.c:6714 -#, c-format -msgid "FUNCTION '%s' has wrong number of arguments" -msgstr "FUNCTION « %s » a le mauvais nombre d'arguments" - -#: cobc/tree.c:6313 -#, c-format -msgid "FUNCTION '%s' cannot have reference modification" -msgstr "FUNCTION « %s » ne peut pas avoir de modification de référence" - -#: cobc/tree.c:6572 cobc/tree.c:6646 cobc/tree.c:6652 cobc/tree.c:6660 -#: cobc/tree.c:6668 -#, fuzzy, c-format -msgid "FUNCTION '%s' has invalid argument" -msgstr "FUNCTION « %s » a un paramètre invalide" - -#: cobc/tree.c:6720 -#, fuzzy, c-format -msgid "FUNCTION '%s' has invalid first argument" -msgstr "FUNCTION « %s » a un premier paramètre invalide" - -#: cobc/typeck.c:686 -#, fuzzy, c-format -msgid "%s item not allowed here: '%s'" -msgstr "%s pas permis ici" - -#: cobc/typeck.c:728 -#, c-format -msgid "'%s' is not a group name" -msgstr "« %s » n'est pas un nom de groupe" - -#: cobc/typeck.c:753 -#, c-format -msgid "'%s' is not a numeric name" -msgstr "« %s » n'est pas un nom numérique" - -#: cobc/typeck.c:782 -#, c-format -msgid "'%s' is not a numeric or numeric-edited name" -msgstr "« %s » n'est pas un nom numérique ou édité numérique" - -#: cobc/typeck.c:835 -#, fuzzy, c-format -msgid "'%s' is Alpha, instead of a numeric value" -msgstr "« %s » n'est pas une valeur numérique" - -#: cobc/typeck.c:838 -#, fuzzy, c-format -msgid "'%s' is Alpha Edited, instead of a numeric value" -msgstr "« %s » n'est pas une valeur numérique" - -#: cobc/typeck.c:851 -#, c-format -msgid "'%s' is not a numeric value" -msgstr "« %s » n'est pas une valeur numérique" - -#: cobc/typeck.c:901 -#, c-format -msgid "'%s' is not an integer value" -msgstr "« %s » n'est pas une valeur entière" - -#: cobc/typeck.c:905 -msgid "positive numeric integer is required here" -msgstr "un entier numérique positif est requis ici" - -#: cobc/typeck.c:1022 -msgid "System routine" -msgstr "Routine système" - -#: cobc/typeck.c:1638 libcob/call.c:1069 -#, c-format -msgid "'%s' literal includes leading spaces which are omitted" -msgstr "le littéral « %s » inclut des espaces au début qui sont omis" - -#: cobc/typeck.c:1642 -#, c-format -msgid "'%s' literal includes trailing spaces which are omitted" -msgstr "le littéral « %s » inclut des espaces de fin qui sont omis" - -#: cobc/typeck.c:1709 -msgid "ON/OFF usage requires a SWITCH name" -msgstr "l'utilisation de ON/OFF requiert un nom SWITCH" - -#: cobc/typeck.c:1727 -#, c-format -msgid "word length exceeds maximum of %d characters: '%s'" -msgstr "la longueur du mot dépasse le maximum de %d caractères : « %s »" - -#: cobc/typeck.c:1730 cobc/typeck.c:1733 -#, c-format -msgid "word length exceeds %d characters: '%s'" -msgstr "la longueur du mot dépasse %d caractères : « %s »" - -#: cobc/typeck.c:1810 -#, fuzzy, c-format -msgid "ASSIGN %s interpreted as '%s'" -msgstr "ASSIGN interprété comme %s" - -#: cobc/typeck.c:1900 cobc/typeck.c:2067 -#, c-format -msgid "subscript missing for '%s' - defaulting to 1" -msgstr "indice manquant pour « %s » – 1 utilisé par défaut" - -#: cobc/typeck.c:1913 cobc/typeck.c:1992 -#, c-format -msgid "'%s' cannot be reference modified" -msgstr "« %s » ne peut pas être modifié par référence" - -#: cobc/typeck.c:1923 cobc/typeck.c:1988 cobc/typeck.c:2256 -#, c-format -msgid "'%s' cannot be subscripted" -msgstr "« %s » ne peut pas être utilisé avec un indice" - -#: cobc/typeck.c:1927 cobc/typeck.c:2260 -#, c-format -msgid "'%s' requires one subscript" -msgstr "« %s » requiert un indice" - -#: cobc/typeck.c:1930 cobc/typeck.c:2263 -#, c-format -msgid "'%s' requires %d subscripts" -msgstr "« %s » requiert %d indices" - -#. TRANSLATORS: This msgid is used when a variable name -#. or label is referenced in a compiler message. -#: cobc/typeck.c:1946 -#, c-format -msgid "'%s'" -msgstr "" - -#: cobc/typeck.c:1948 -#, c-format -msgid "'%s' (accessed by '%s')" -msgstr "« %s » (accédé par « %s »)" - -#: cobc/typeck.c:2051 -#, c-format -msgid "'%s' has no OCCURS clause" -msgstr "« %s » n'a pas de clause OCCURS" - -#: cobc/typeck.c:2108 libcob/common.c:3114 -#, c-format -msgid "subscript of '%s' out of bounds: %d" -msgstr "l'indice de « %s » est hors limites : %d" - -#: cobc/typeck.c:2162 cobc/typeck.c:2172 -#, fuzzy -msgid "offset must be greater than zero" -msgstr "le nombre ou la constante entre parenthèses doit être plus grand que zéro" - -#: cobc/typeck.c:2167 cobc/typeck.c:2185 cobc/typeck.c:2204 -#, fuzzy -msgid "length must be greater than zero" -msgstr "le nombre ou la constante entre parenthèses doit être plus grand que zéro" - -#: cobc/typeck.c:2175 cobc/typeck.c:2178 libcob/common.c:3136 -#, c-format -msgid "offset of '%s' out of bounds: %d" -msgstr "le décalage de « %s » est hors limites : %d" - -#: cobc/typeck.c:2189 cobc/typeck.c:2193 cobc/typeck.c:2207 cobc/typeck.c:2211 -#: libcob/common.c:3149 -#, c-format -msgid "length of '%s' out of bounds: %d" -msgstr "la longueur de « %s » est hors limites : %d" - -#: cobc/typeck.c:2323 cobc/typeck.c:2407 -msgid "reference modification not allowed here" -msgstr "modification de référence pas permise ici" - -#: cobc/typeck.c:2337 cobc/typeck.c:2433 -msgid "88 level item not allowed here" -msgstr "élément de niveau 88 pas permis ici" - -#: cobc/typeck.c:2342 -#, c-format -msgid "LENGTH OF '%s' not allowed outside of Procedure Division" -msgstr "" - -#: cobc/typeck.c:2346 cobc/typeck.c:2437 cobc/typeck.c:2445 cobc/typeck.c:2512 -msgid "variable length item not allowed here" -msgstr "élément de longueur variable pas permis ici" - -#: cobc/typeck.c:2375 -#, c-format -msgid "'%s' has not been DEFINEd" -msgstr "« %s » n'a pas été défini avec DEFINE" - -#: cobc/typeck.c:2411 -msgid "only field names allowed here" -msgstr "seuls des noms de champs sont permis ici" - -#: cobc/typeck.c:2422 -#, c-format -msgid "VALUE of '%s': %s target '%s' is invalid" -msgstr "VALUE de « %s » : la cible %s de « %s » est invalide" - -#: cobc/typeck.c:2424 cobc/typeck.c:2494 -msgid "target must be in FILE SECTION or LINKAGE SECTION or have the EXTERNAL clause" -msgstr "la cible doit être dans FILE SECTION ou LINKAGE SECTION ou avoir la clause EXTERNAL" - -#: cobc/typeck.c:2480 cobc/typeck.c:2493 -#, c-format -msgid "VALUE of '%s': %s target is invalid" -msgstr "VALUE de « %s » : la cible %s est invalide" - -#: cobc/typeck.c:2482 -msgid "no previous data-item found" -msgstr "aucun élément de type données précédent trouvé" - -#: cobc/typeck.c:2667 -#, c-format -msgid "'%s' is not an alphabet name" -msgstr "« %s » n'est pas un nom d'alphabet" - -#: cobc/typeck.c:2931 -#, c-format -msgid "duplicate character values in alphabet '%s': %s" -msgstr "valeurs de caractères dupliquées dans l'alphabet « %s » : %s" - -#: cobc/typeck.c:2936 -#, c-format -msgid "invalid character values in alphabet '%s', starting at position %d" -msgstr "valeurs de caractères invalides dans l'alphabet « %s », en commençant à la position %d" - -#: cobc/typeck.c:2990 -msgid "invalid ALPHABET name" -msgstr "nom d'alphabet invalide" - -#: cobc/typeck.c:3054 -#, fuzzy, c-format -msgid "duplicate character values in class '%s'" -msgstr "valeurs dupliquées dans la classe « %s »" - -#: cobc/typeck.c:3072 -#, c-format -msgid "'%s' is not a locale name" -msgstr "« %s » n'est pas un nom d'environnement linguistique" - -#: cobc/typeck.c:3206 -msgid "invalid RECORD DEPENDING item" -msgstr "élément RECORD DEPENDING invalide" - -#: cobc/typeck.c:3211 -msgid "RECORD DEPENDING must reference a data-item" -msgstr "RECORD DEPENDING doit faire référence à un élément de type donnée" - -#: cobc/typeck.c:3234 -#, c-format -msgid "RECORD DEPENDING item '%s' should be defined in WORKING-STORAGE, LOCAL-STORAGE or LINKAGE SECTION" -msgstr "l'élément RECORD DEPENDING « %s » devrait être défini dans WORKING-STORAGE, LOCAL-STORAGE ou LINKAGE SECTION" - -#: cobc/typeck.c:3247 -#, fuzzy, c-format -msgid "file %s: RELATIVE KEY %s is not numeric" -msgstr "la valeur dans la clause AT n'est pas numérique" - -#: cobc/typeck.c:3256 -#, c-format -msgid "file %s: RELATIVE KEY %s must be integer" -msgstr "" - -#: cobc/typeck.c:3261 -#, c-format -msgid "file %s: RELATIVE KEY %s must be unsigned" -msgstr "" - -#: cobc/typeck.c:3268 -#, c-format -msgid "file %s: RELATIVE KEY %s cannot have OCCURS" -msgstr "" - -#: cobc/typeck.c:3274 -#, c-format -msgid "RELATIVE KEY %s cannot be in file record belonging to %s" -msgstr "" - -#: cobc/typeck.c:3283 -#, c-format -msgid "file %s: RELATIVE KEY %s declared outside WORKING-STORAGE" -msgstr "" - -#: cobc/typeck.c:3306 cobc/typeck.c:7184 -#, c-format -msgid "'%s' is not a valid data name" -msgstr "« %s » n'est pas un nom de donnée valide" - -#: cobc/typeck.c:3313 -#, fuzzy, c-format -msgid "CRT STATUS item '%s' should be defined in WORKING-STORAGE or LOCAL-STORAGE" -msgstr "l'élément RECORD DEPENDING « %s » devrait être défini dans WORKING-STORAGE, LOCAL-STORAGE ou LINKAGE SECTION" - -#: cobc/typeck.c:3319 -#, fuzzy, c-format -msgid "'%s' CRT STATUS must have at least 4 digits" -msgstr "le CRT STATUS « %s » doit avoir une longueur de 4 caractères" - -#: cobc/typeck.c:3325 -#, c-format -msgid "'%s' CRT STATUS must be 4 characters long" -msgstr "le CRT STATUS « %s » doit avoir une longueur de 4 caractères" - -#: cobc/typeck.c:3341 -#, fuzzy, c-format -msgid "variable '%s' will be implicitly defined" -msgstr "« %s » sera défini implicitement" - -#: cobc/typeck.c:3375 cobc/typeck.c:3438 -msgid "ASSIGN variable" -msgstr "" - -#: cobc/typeck.c:3443 -#, fuzzy, c-format -msgid "ASSIGN data item '%s' is invalid" -msgstr "l'élément de donnée « %s » de ASSIGN est invalide" - -#: cobc/typeck.c:3507 -#, c-format -msgid "'%s' CURSOR must be 4 or 6 characters long" -msgstr "le CURSOR « %s » doit avoir une longueur de 4 ou 6 caractères" - -#: cobc/typeck.c:3557 cobc/typeck.c:3561 -#, fuzzy, c-format -msgid "%s does not have a fixed location" -msgstr "%s n'est pas un champ" - -#: cobc/typeck.c:3573 -#, fuzzy, c-format -msgid "'%s' cannot have nested OCCURS DEPENDING" -msgstr "« %s » ne peut pas avoir OCCURS DEPENDING" - -#: cobc/typeck.c:3587 -#, fuzzy, c-format -msgid "'%s' OCCURS DEPENDING ON field item invalid here" -msgstr "l'élément du champ ODO « %s » est invalide ici" - -#: cobc/typeck.c:3595 -#, fuzzy, c-format -msgid "'%s' cannot have OCCURS DEPENDING because of '%s'" -msgstr "« %s » ne peut pas avoir OCCURS DEPENDING" - -#: cobc/typeck.c:3607 -#, fuzzy, c-format -msgid "'%s' OCCURS DEPENDING ON item must have GLOBAL attribute" -msgstr "l'élément ODO « %s » doit avoir l'attribut GLOBAL" - -#: cobc/typeck.c:3621 -#, c-format -msgid "PASSWORD '%s' for EXTERNAL file '%s' must have EXTERNAL attribute" -msgstr "" - -#: cobc/typeck.c:3644 -#, c-format -msgid "file %s: ASSIGN %s declared outside WORKING-STORAGE" -msgstr "" - -#: cobc/typeck.c:3674 -#, fuzzy, c-format -msgid "duplicate APPLY COMMIT target: '%s'" -msgstr "entrée REPOSITORY dupliquée pour « %s »" - -#: cobc/typeck.c:3688 -#, fuzzy -msgid "APPLY COMMIT statement invalid for SORT file" -msgstr "instruction USE invalide pour le fichier SORT" - -#: cobc/typeck.c:3691 -#, fuzzy -msgid "APPLY COMMIT statement invalid for REPORT file" -msgstr "instruction USE invalide pour le fichier SORT" - -#: cobc/typeck.c:3698 -#, fuzzy, c-format -msgid "APPLY COMMIT item '%s' should be defined in WORKING-STORAGE or LOCAL-STORAGE" -msgstr "l'élément RECORD DEPENDING « %s » devrait être défini dans WORKING-STORAGE, LOCAL-STORAGE ou LINKAGE SECTION" - -#: cobc/typeck.c:3712 -#, fuzzy, c-format -msgid "item not allowed here: '%s'" -msgstr "%s pas permis ici" - -#: cobc/typeck.c:3725 -#, fuzzy, c-format -msgid "%s may not be subscripted" -msgstr "« %s » ne peut pas être utilisé avec un indice" - -#: cobc/typeck.c:3729 -#, fuzzy, c-format -msgid "%s may not be reference modified" -msgstr "« %s » ne peut pas être modifié par référence" - -#: cobc/typeck.c:3789 -#, c-format -msgid "DEBUGGING target invalid: '%s'" -msgstr "la cible de DEBUGGING est invalide : « %s »" - -#: cobc/typeck.c:3795 -#, fuzzy, c-format -msgid "DEBUGGING target already specified with ALL PROCEDURES: '%s'" -msgstr "la cible de DEBUGGING est invalide avec ALL PROCEDURES : « %s »" - -#: cobc/typeck.c:3815 -#, fuzzy -msgid "DEBUGGING target" -msgstr "la cible de DEBUGGING est invalide : « %s »" - -#: cobc/typeck.c:3822 -#, c-format -msgid "'%s' is not a valid DEBUGGING target" -msgstr "« %s » n'est pas une cible valide pour DEBUGGING" - -#: cobc/typeck.c:3860 cobc/typeck.c:3865 -#, c-format -msgid "'%s' is not in DECLARATIVES" -msgstr "« %s » n'est pas dans DECLARATIVES" - -#: cobc/typeck.c:3877 -#, c-format -msgid "invalid reference to '%s' (in DECLARATIVES)" -msgstr "référence invalide à « %s » (dans DECLARATIVES)" - -#: cobc/typeck.c:3886 -#, c-format -msgid "'%s' is not a procedure name" -msgstr "« %s » n'est pas un nom de procédure" - -#: cobc/typeck.c:3948 -#, c-format -msgid "LINKAGE item '%s' is not a PROCEDURE USING parameter" -msgstr "l'élément LINKAGE « %s » n'est pas un paramètre de PROCEDURE USING" - -#: cobc/typeck.c:4001 -#, c-format -msgid "'%s' is not an alterable paragraph" -msgstr "« %s » n'est pas une paragraphe altérable" - -#: cobc/typeck.c:4604 cobc/typeck.c:4608 -#, c-format -msgid "suggest parentheses around %s within %s" -msgstr "parenthèses suggérées autour de %s dans %s" - -#: cobc/typeck.c:4616 -#, fuzzy -msgid "invalid conditional expression" -msgstr "expression invalide" - -#: cobc/typeck.c:4726 -#, c-format -msgid "internal decimal structure size exceeded: %d" -msgstr "la taille de la structure décimale interne est dépassée : %d" - -#: cobc/typeck.c:4729 -msgid "Try to minimize the number of parentheses or split into multiple computations." -msgstr "Essayez de minimiser le nombre de parenthèses ou scindez le en plusieurs calculs" - -#: cobc/typeck.c:4753 -#, fuzzy, c-format -msgid "more than %d nested expressions" -msgstr "plus de %d conditions imbriquées" - -#: cobc/typeck.c:4795 -msgid "precision of result may change with arithmetic-osvs" -msgstr "la précision du résultat pourrait changer avec l'arithmétique osvs" - -#: cobc/typeck.c:4851 -#, c-format -msgid "unexpected operation: %c (%d)" -msgstr "opération inattendue : %c (%d)" - -#: cobc/typeck.c:4856 -#, c-format -msgid "%s operator may be misplaced" -msgstr "l'opérateur %s est peut-être mal placé" - -#: cobc/typeck.c:4926 -msgid "unexpected constant expansion" -msgstr "expansion de constante inattendue" - -#: cobc/typeck.c:5747 -#, c-format -msgid "more than %d nested conditions" -msgstr "plus de %d conditions imbriquées" - -#: cobc/typeck.c:6104 cobc/typeck.c:6180 -msgid "no CORRESPONDING items found" -msgstr "pas d'éléments dans CORRESPONDING trouvés" - -#: cobc/typeck.c:6252 -msgid "no items to ACCEPT found" -msgstr "" - -#: cobc/typeck.c:6302 -#, fuzzy -msgid "no items to DISPLAY found" -msgstr "type invalide pour l'opérande DISPLAY" - -#: cobc/typeck.c:6421 -msgid "cannot specify figurative constant ZERO in AT clause" -msgstr "impossible de spécifier la constante ZÉRO figurative dans la clause AT" - -#: cobc/typeck.c:6425 -msgid "value in AT clause is not numeric" -msgstr "la valeur dans la clause AT n'est pas numérique" - -#: cobc/typeck.c:6431 -msgid "value in AT clause must have 4 or 6 digits" -msgstr "la valeur dans la clause AT doit avoir 4 ou 6 chiffres" - -#: cobc/typeck.c:6553 -msgid "invalid PROMPT literal" -msgstr "littéral PROMPT invalide" - -#: cobc/typeck.c:6558 -msgid "invalid PROMPT identifier" -msgstr "identificateur PROMPT invalide" - -#: cobc/typeck.c:6848 -#, c-format -msgid "'%s' is not an input device" -msgstr "« %s » n'est pas un périphérique d'entrée" - -#: cobc/typeck.c:6878 cobc/typeck.c:8016 -#, c-format -msgid "'%s' is not defined in SPECIAL-NAMES" -msgstr "« %s » n'est pas défini dans SPECIAL-NAMES" - -#: cobc/typeck.c:6883 -#, c-format -msgid "invalid input device '%s'" -msgstr "périphérique d'entrée « %s » invalide" - -#: cobc/typeck.c:6888 cobc/typeck.c:8020 -#, c-format -msgid "unknown device '%s'; it may exist in another dialect" -msgstr "périphérique « %s » inconnu; il peut exister dans un autre dialecte" - -#: cobc/typeck.c:6891 cobc/typeck.c:8023 -#, c-format -msgid "unknown device '%s'; not defined in SPECIAL-NAMES" -msgstr "périphérique « %s » inconnu; pas défini dans SPECIAL-NAMES" - -#: cobc/typeck.c:6915 -msgid "target of ALLOCATE is not a BASED item" -msgstr "la cible de ALLOCATE n'est pas un élément BASED" - -#: cobc/typeck.c:6926 -msgid "target of RETURNING is not a data pointer" -msgstr "la cible de RETURNING n'est pas un pointeur de données" - -#: cobc/typeck.c:6936 cobc/typeck.c:7342 -msgid "amount must be specified as a numeric expression" -msgstr "" - -#: cobc/typeck.c:6949 -msgid "INITIALIZED TO item is not alphanumeric" -msgstr "l'élément de INITIALIZED TO n'est pas alphanumérique" - -#: cobc/typeck.c:7019 -msgid "only alphanumeric FUNCTION types are allowed here" -msgstr "seuls des types de FUNCTION alphanumériques sont autorisés ici" - -#: cobc/typeck.c:7027 -msgid "invalid RETURNING field" -msgstr "champ RETURNING invalide" - -#: cobc/typeck.c:7046 -msgid "STDCALL not available on this platform" -msgstr "STDCALL pas disponible sur cette plateforme" - -#: cobc/typeck.c:7050 -msgid "STDCALL used on 64-bit Windows platform" -msgstr "STDCALL utilisé sur la plateforme Windows 64 bits" - -#: cobc/typeck.c:7055 -msgid "STATIC CALL convention requires a literal program name" -msgstr "la convention STATIC CALL requiert un nom de programme littéral" - -#: cobc/typeck.c:7060 cobc/typeck.c:10632 cobc/typeck.c:11539 -#: cobc/typeck.c:11903 -msgid "HANDLE must be either a generic or a THREAD HANDLE" -msgstr "HANDLE doit soit être un générique ou soit un THREAD HANDLE" - -#: cobc/typeck.c:7078 -msgid "numeric literal is negative" -msgstr "le littéral numérique est négatif" - -#: cobc/typeck.c:7157 -msgid "numeric literal exceeds size limits" -msgstr "le littéral numérique dépasse les limites de la taille" - -#: cobc/typeck.c:7175 -#, fuzzy, c-format -msgid "figurative constant %s invalid here" -msgstr "constante figurative invalide ici" - -#: cobc/typeck.c:7190 -#, c-format -msgid "'%s' ANY LENGTH item not passed BY REFERENCE" -msgstr "l'élément « %s » ANY LENGTH n'est pas passé BY REFERENCE" - -#: cobc/typeck.c:7198 -#, c-format -msgid "'%s' is not a 01 or 77 level item" -msgstr "« %s » n'est pas un élément de niveau 01 ou 77" - -#: cobc/typeck.c:7228 cobc/typeck.c:7233 -#, c-format -msgid "wrong number of CALL parameters for '%s', %d given, %d expected" -msgstr "mauvais nombre de paramètres dans CALL pour « %s », %d donnés, %d attendus" - -#: cobc/typeck.c:7300 cobc/typeck.c:7374 cobc/typeck.c:7378 cobc/typeck.c:7382 -#: cobc/typeck.c:7412 cobc/typeck.c:10591 cobc/typeck.c:10755 -#: cobc/typeck.c:10944 cobc/typeck.c:10948 cobc/typeck.c:11844 -#: cobc/typeck.c:12087 cobc/typeck.c:12090 -#, c-format -msgid "%s not allowed on %s files" -msgstr "%s n'est pas permis sur les fichiers %s" - -#: cobc/typeck.c:7336 -msgid "AFTER phrase in CONTINUE statement" -msgstr "" - -#: cobc/typeck.c:7478 -msgid "positions cannot be specified for main windows" -msgstr "les positions ne peuvent pas être spécifiées pour les fenêtres principales" - -#: cobc/typeck.c:7488 cobc/typeck.c:7491 cobc/typeck.c:7508 -#, fuzzy -msgid "HANDLE must be either a generic or a WINDOW HANDLE or X(10)" -msgstr "HANDLE doit soit être un générique ou soit un WINDOW HANDLE" - -#: cobc/typeck.c:7617 -#, c-format -msgid "'%s' is an invalid type for DISPLAY operand" -msgstr "« %s » est un type invalide pour l'opérande DISPLAY" - -#: cobc/typeck.c:7622 -msgid "invalid type for DISPLAY operand" -msgstr "type invalide pour l'opérande DISPLAY" - -#: cobc/typeck.c:7973 cobc/typeck.c:8006 -#, c-format -msgid "'%s' is not an output device" -msgstr "« %s » n'est pas un périphérique de sortie" - -#: cobc/typeck.c:8109 -msgid "invalid use of 88 level in WHEN expression" -msgstr "utilisation invalide du niveau 88 dans l'expression WHEN" - -#: cobc/typeck.c:8165 -msgid "wrong number of WHEN parameters" -msgstr "mauvais nombre de paramètres à WHEN" - -#: cobc/typeck.c:8244 cobc/typeck.c:8256 -#, c-format -msgid "target %d of FREE is not a BASED data item" -msgstr "la cible %d de FREE n'est pas un élément de donnée BASED" - -#: cobc/typeck.c:8262 -#, c-format -msgid "target %d of FREE must be a data pointer" -msgstr "la cible %d de FREE doit être un pointeur de donnée" - -#: cobc/typeck.c:8276 -msgid "GO TO without procedure-name" -msgstr "GO TO sans nom de procédure" - -#: cobc/typeck.c:8286 -msgid "GO TO with multiple procedure-names" -msgstr "GO TO avec plusieurs noms de procédures" - -#: cobc/typeck.c:8308 -#, fuzzy -msgid "GO TO ENTRY with multiple entry-names" -msgstr "GO TO avec plusieurs noms de procédures" - -#: cobc/typeck.c:8367 -msgid "invalid INITIALIZE statement" -msgstr "instruction INITIALIZE invalide" - -#: cobc/typeck.c:8443 cobc/typeck.c:8446 -#, c-format -msgid "%s operands differ in size" -msgstr "les opérandes de %s diffèrent dans leurs tailles" - -#: cobc/typeck.c:8476 -#, c-format -msgid "unexpected clause %d" -msgstr "clause %d inattendue" - -#: cobc/typeck.c:8545 cobc/typeck.c:8556 cobc/typeck.c:8567 cobc/typeck.c:8578 -#, c-format -msgid "data name expected before %s" -msgstr "nom de donnée attendu avant %s" - -#: cobc/typeck.c:8588 -#, c-format -msgid "ALL, LEADING or TRAILING expected before '%s'" -msgstr "ALL, LEADING ou TRAILING attendu avant « %s »" - -#: cobc/typeck.c:8598 -msgid "operand has wrong size" -msgstr "l'opérande a la mauvaise taille" - -#: cobc/typeck.c:8669 -#, c-format -msgid "internal register '%s' defined as BINARY-LONG" -msgstr "le registre interne « %s » est défini comme BINARY-LONG" - -#: cobc/typeck.c:8672 cobc/typeck.c:8675 cobc/typeck.c:8678 cobc/typeck.c:8681 -#: cobc/typeck.c:8684 cobc/typeck.c:8687 cobc/typeck.c:8690 cobc/typeck.c:8693 -#: cobc/typeck.c:8696 -#, c-format -msgid "'%s' defined here as USAGE %s" -msgstr "« %s » défini ici comme USAGE %s" - -#: cobc/typeck.c:8699 -#, c-format -msgid "'%s' defined here as PIC %s" -msgstr "« %s » défini ici comme PIC %s" - -#: cobc/typeck.c:8702 -#, c-format -msgid "'%s' defined here as a group of length %d" -msgstr "« %s » défini ici comme un groupe de longueur %d" - -#: cobc/typeck.c:8741 -#, c-format -msgid "value is %s" -msgstr "" - -#: cobc/typeck.c:8745 -#, fuzzy, c-format -msgid "value size is %d" -msgstr "la taille de la valeur dépasse la taille de la donnée" - -#: cobc/typeck.c:9022 -msgid "invalid destination for MOVE" -msgstr "destination invalide pour MOVE" - -#: cobc/typeck.c:9057 -#, fuzzy -msgid "MOVE of figurative constant SPACE to numeric item" -msgstr "MOVE d'une constante figurative vers un élément numérique" - -#: cobc/typeck.c:9072 -msgid "MOVE of figurative constant QUOTE to numeric item" -msgstr "MOVE de la constante figurative QUOTE vers un élément numérique" - -#: cobc/typeck.c:9077 cobc/typeck.c:9089 -msgid "MOVE of figurative constant to numeric item" -msgstr "MOVE d'une constante figurative vers un élément numérique" - -#: cobc/typeck.c:9151 -msgid "numeric literal in VALUE clause of numeric-edited item" -msgstr "littéral numérique dans la clause VALUE de l'élément édité numérique" - -#: cobc/typeck.c:9176 -msgid "numeric move to ALPHABETIC" -msgstr "déplacement numérique vers ALPHABETIC" - -#: cobc/typeck.c:9188 -msgid "data item not signed" -msgstr "élément de donnée pas signé" - -#: cobc/typeck.c:9191 -msgid "ignoring sign" -msgstr "le signe est ignoré" - -#: cobc/typeck.c:9503 -msgid "overlapping MOVE may occur and produce unpredictable results" -msgstr "un recouvrement dû à MOVE peut avoir lieu et produire un résultat imprévisible" - -#: cobc/typeck.c:9510 -msgid "overlapping MOVE may produce unpredictable results" -msgstr "un recouvrement dû à MOVE peut produire un résultat imprévisible" - -#: cobc/typeck.c:9643 -msgid "invalid source for MOVE" -msgstr "source invalide pour MOVE" - -#: cobc/typeck.c:9666 -msgid "source is non-numeric - substituting zero" -msgstr "" - -#: cobc/typeck.c:9672 cobc/typeck.c:9683 -msgid "invalid VALUE clause" -msgstr "clause VALUE invalide" - -#: cobc/typeck.c:9675 cobc/typeck.c:11480 cobc/typeck.c:11485 -#: cobc/typeck.c:11512 cobc/typeck.c:11517 -msgid "invalid SET statement" -msgstr "instruction SET invalide" - -#: cobc/typeck.c:9677 -msgid "invalid MOVE statement" -msgstr "instruction MOVE invalide" - -#: cobc/typeck.c:9684 -msgid "literal exceeds data size" -msgstr "le littéral dépasse la taille des données" - -#: cobc/typeck.c:9688 -msgid "numeric literal exceeds data size" -msgstr "le littéral numérique dépasse la taille des données" - -#: cobc/typeck.c:9697 -msgid "MOVE of non-integer to alphanumeric" -msgstr "MOVE d'un non entier vers un alphanumérique" - -#: cobc/typeck.c:9703 -msgid "numeric value is expected" -msgstr "une valeur numérique est attendue" - -#: cobc/typeck.c:9708 -msgid "alphanumeric value is expected" -msgstr "une valeur alphanumérique est attendue" - -#: cobc/typeck.c:9713 -msgid "value does not fit the picture string" -msgstr "la valeur ne tient pas dans la chaîne de l'image" - -#: cobc/typeck.c:9719 -msgid "value size exceeds data size" -msgstr "la taille de la valeur dépasse la taille de la donnée" - -#: cobc/typeck.c:9724 -msgid "sending field larger than receiving field" -msgstr "le champ d'envoi est plus grand que le champ de réception" - -#: cobc/typeck.c:9729 -msgid "some digits may be truncated" -msgstr "certains chiffres peuvent être tronqués" - -#: cobc/typeck.c:10515 -#, c-format -msgid "invalid MOVE target: %s" -msgstr "cible MOVE invalide : %s" - -#: cobc/typeck.c:10768 -msgid "READ PREVIOUS not allowed for this file type" -msgstr "READ PREVIOUS n'est pas permis pour ce type de fichier" - -#: cobc/typeck.c:10776 -msgid "KEY ignored with sequential READ" -msgstr "KEY ignoré avec un READ séquentiel" - -#: cobc/typeck.c:10872 -#, fuzzy -msgid "figurative constants not allowed in FROM clause" -msgstr "constante figurative invalide ici" - -#: cobc/typeck.c:10879 -msgid "literal in FROM clause must be alphanumeric, national or boolean" -msgstr "" - -#: cobc/typeck.c:10902 cobc/typeck.c:12047 -#, c-format -msgid "%s FILE requires a FROM clause" -msgstr "FILE %s requiert une clause FROM" - -#: cobc/typeck.c:10924 cobc/typeck.c:11010 cobc/typeck.c:12069 -#, c-format -msgid "%s subject does not refer to a record name" -msgstr "le sujet %s ne fait pas référence à un nom d'enregistrement" - -#: cobc/typeck.c:11016 -msgid "RELEASE not allowed on this record item" -msgstr "RELEASE n'est pas permis sur cet élément d'enregistrement" - -#: cobc/typeck.c:11097 cobc/typeck.c:11118 cobc/typeck.c:11125 -msgid "invalid SEARCH ALL condition" -msgstr "condition SEARCH ALL invalide" - -#: cobc/typeck.c:11237 cobc/typeck.c:11241 -msgid "SET targets must be PROGRAM-POINTER" -msgstr "les cibles de SET doivent être des PROGRAM-POINTER" - -#: cobc/typeck.c:11268 cobc/typeck.c:11335 cobc/typeck.c:11403 -#, c-format -msgid "cannot change address of '%s', which is not level 1 or 77" -msgstr "impossible de changer l'adresse de « %s » qui n'est pas de niveau 1 ou 77" - -#: cobc/typeck.c:11272 cobc/typeck.c:11339 cobc/typeck.c:11407 -#, fuzzy, c-format -msgid "cannot change address of '%s', which is not BASED or a LINKAGE item" -msgstr "impossible de changer l'adresse de « %s » qui n'est pas BASED ni un élément de liaison" - -#: cobc/typeck.c:11291 -#, fuzzy, c-format -msgid "SET target '%s' is not numeric, an INDEX or a POINTER" -msgstr "la cible « %s » de SET n'est pas numérique, un index ou un pointeur" - -#: cobc/typeck.c:11360 -#, fuzzy, c-format -msgid "SET target '%s' is not a POINTER for FCD" -msgstr "la cible « %s » de SET n'est pas numérique, un index ou un pointeur" - -#: cobc/typeck.c:11428 -#, c-format -msgid "SET target '%s' is not a POINTER for FCD-KEYDEF" -msgstr "" - -#: cobc/typeck.c:11521 -msgid "field does not have a FALSE clause" -msgstr "le champ n'a pas une clause FALSE" - -#: cobc/typeck.c:11552 -msgid "THREAD-priority must be between 1 and 32767" -msgstr "la priorité de THREAD doit être entre 1 et 32767" - -#: cobc/typeck.c:11572 -msgid "SET ATTRIBUTE requires a screen item as subject" -msgstr "SET ATTRIBUTE requiert un élément écran comme sujet" - -#: cobc/typeck.c:11578 -msgid "SET ATTRIBUTE subject does not refer to a screen item" -msgstr "le sujet de SET ATTRIBUTE ne fait pas référence à un élément écran" - -#: cobc/typeck.c:11629 -msgid "invalid SORT filename" -msgstr "nom de fichier SORT invalide" - -#: cobc/typeck.c:11689 -msgid "invalid SORT USING parameter" -msgstr "paramètre SORT USING invalide" - -#: cobc/typeck.c:11718 -msgid "invalid SORT GIVING parameter" -msgstr "paramètre SORT GIVING invalide" - -#: cobc/typeck.c:11772 cobc/typeck.c:11799 cobc/typeck.c:11819 -msgid "invalid key item" -msgstr "élément de clé invalide" - -#: cobc/typeck.c:11849 -msgid "LENGTH/SIZE clause only allowed on INDEXED files" -msgstr "clause LENGTH/SIZE uniquement autorisée sur des fichiers INDEXED" - -#: cobc/typeck.c:11854 -msgid "START not allowed with ACCESS MODE RANDOM" -msgstr "START n'est pas permis avec ACCESS MODE RANDOM" - -#: cobc/typeck.c:12103 -msgid "LOCK clause invalid here" -msgstr "clause LOCK invalide ici" - -#: cobc/typeck.c:12365 -msgid "data item is not part of a report" -msgstr "" - -#: cobc/typeck.c:12385 -msgid "improper use of SUPPRESS PRINTING" -msgstr "" - -#: cobc/typeck.c:12400 -#, fuzzy, c-format -msgid "%s must be alphanumeric or national" -msgstr "%s n'est pas un littéral alphanumérique" - -#: cobc/typeck.c:12411 -#, c-format -msgid "%s may not be a figurative constant" -msgstr "" - -#: cobc/typeck.c:12438 -#, fuzzy, c-format -msgid "%s must be a child of the input record" -msgstr "« %s » et « %s » doivent être dans le même enregistrement" - -#: cobc/typeck.c:12464 -#, c-format -msgid "%s may not be an ignored item in JSON/XML GENERATE" -msgstr "" - -#: cobc/typeck.c:12475 -#, fuzzy, c-format -msgid "%s must be elementary" -msgstr "doit être numérique" - -#: cobc/typeck.c:12487 -#, fuzzy, c-format -msgid "%s must be USAGE DISPLAY or NATIONAL" -msgstr "les éléments élémentaires avec la clause SIGN doivent être USAGE DISPLAY ou NATIONAL" - -#: cobc/typeck.c:12501 -#, fuzzy, c-format -msgid "%s must be an integer" -msgstr "« %s » n'est pas un entier" - -#: cobc/typeck.c:12517 cobc/typeck.c:12523 -msgid "JSON/XML GENERATE receiving item" -msgstr "" - -#: cobc/typeck.c:12520 -msgid "JSON/XML GENERATE receiving item may not have JUSTIFIED clause" -msgstr "" - -#: cobc/typeck.c:12608 -#, fuzzy -msgid "JSON/XML GENERATE input record may not be reference modified" -msgstr "« %s » ne peut pas être modifié par référence" - -#: cobc/typeck.c:12614 -msgid "JSON/XML GENERATE input record may not have RENAMES clause" -msgstr "" - -#: cobc/typeck.c:12619 -#, c-format -msgid "all the children of '%s' are ignored in JSON/XML GENERATE" -msgstr "" - -#: cobc/typeck.c:12626 -msgid "JSON/XML GENERATE input record has subrecords with non-unique names" -msgstr "" - -#: cobc/typeck.c:12631 -msgid "floating-point items in JSON/XML GENERATE" -msgstr "" - -#: cobc/typeck.c:12635 -msgid "OCCURS items in JSON/XML GENERATE" -msgstr "" - -#: cobc/typeck.c:12660 -msgid "COUNT IN item must be numeric and an integer" -msgstr "" - -#: cobc/typeck.c:12665 -msgid "COUNT IN item must be an integer" -msgstr "" - -#: cobc/typeck.c:12668 -msgid "COUNT IN item may not have PICTURE with P in it" -msgstr "" - -#: cobc/typeck.c:12711 -msgid "NAMESPACE must be a valid URI" -msgstr "" - -#: cobc/typeck.c:12755 -msgid "NAMESPACE-PREFIX must be a valid XML name" -msgstr "" - -#: cobc/typeck.c:12780 cobc/typeck.c:12787 -msgid "NAME OF item" -msgstr "" - -#: cobc/typeck.c:12784 -msgid "NAME OF item must be the input record or a child of it" -msgstr "" - -#: cobc/typeck.c:12791 -msgid "NAME OF name must be a valid XML name" -msgstr "" - -#: cobc/typeck.c:12817 cobc/typeck.c:12818 cobc/typeck.c:12821 -#: cobc/typeck.c:12825 -msgid "TYPE OF item" -msgstr "" - -#: cobc/typeck.c:12843 -msgid "SUPPRESS WHEN SPACE item" -msgstr "" - -#: cobc/typeck.c:12846 -msgid "SUPPRESS WHEN LOW-VALUE item" -msgstr "" - -#: cobc/typeck.c:12848 -msgid "SUPPRESS WHEN HIGH-VALUE item" -msgstr "" - -#: cobc/typeck.c:12877 cobc/typeck.c:12885 cobc/typeck.c:12889 -msgid "SUPPRESS item" -msgstr "" - -#: cobc/typeck.c:12881 -msgid "SUPPRESS item with WHEN clause" -msgstr "" - -#: cobc/typeck.c:12958 -msgid "WITH ATTRIBUTES specified, but no attributes can be generated" -msgstr "" - -#: cobc/warning.def:34 -#, fuzzy -msgid " -Wextra additional warnings only raised with -W or -Wall" -msgstr " -Werror traiter tous les avertissements comme des erreurs" - -#: cobc/warning.def:37 -#, fuzzy -msgid " -Wno-unfinished do not warn if unfinished features are used" -msgstr "ne pas avertir si des fonctionnalités incomplètes sont utilisées" - -#: cobc/warning.def:40 -#, fuzzy -msgid " -Wno-pending do not warn if pending features are mentioned" -msgstr "ne pas avertir si des fonctionnalités en attentes sont mentionnées" - -#: cobc/warning.def:43 -#, fuzzy -msgid " -Wobsolete warn if obsolete features are used" -msgstr "avertir si des fonctionnalités obsolètes sont utilisées" - -#: cobc/warning.def:46 -#, fuzzy -msgid " -Warchaic warn if archaic features are used" -msgstr "avertir si des fonctionnalités archaïques sont utilisées" - -#: cobc/warning.def:49 -#, fuzzy -msgid " -Wredefinition warn about incompatible redefinition of data items" -msgstr "avertir au sujet de redéfinitions incompatibles des éléments de données" - -#: cobc/warning.def:52 -#, fuzzy -msgid " -Wtruncate warn about field truncation from constant assignments" -msgstr "avertir au sujet des affectations de constantes qui sont tronquées" - -#: cobc/warning.def:55 -#, fuzzy -msgid " -Wpossible-truncate warn about possible field truncation" -msgstr "avertir au sujet de champs qui pourraient être tronqués" - -#: cobc/warning.def:58 -#, fuzzy -msgid " -Woverlap warn about overlapping MOVE of items" -msgstr "avertir au sujet des éléments subissant un MOVE avec recouvrement" - -#: cobc/warning.def:61 -#, fuzzy -msgid " -Wpossible-overlap warn about MOVE of items that may overlap depending on variables" -msgstr "avertir au sujet d'éléments manipulés avec MOVE qui peuvent avoir un recouvrement dépendant des variables" - -#: cobc/warning.def:64 -#, fuzzy -msgid " -Wparentheses warn about lack of parentheses around AND within OR" -msgstr "avertir si il manque des parenthèses autours de AND à l'intérieur de OR" - -#: cobc/warning.def:67 -msgid " -Wstrict-typing warn strictly about type mismatch" -msgstr "" - -#: cobc/warning.def:70 -#, fuzzy -msgid " -Wimplicit-define warn about implicitly defined data items" -msgstr "avertir au sujet des éléments de données définis implicitement" - -#: cobc/warning.def:73 -#, fuzzy -msgid " -Wcorresponding warn about CORRESPONDING with no matching items" -msgstr "avertir au sujet de CORRESPONDIG sans éléments correspondants" - -#: cobc/warning.def:76 -#, fuzzy -msgid " -Winitial-value warn if initial VALUE clause is ignored" -msgstr "avertir quand la clause Initial VALUE est ignorée" - -#: cobc/warning.def:79 -#, fuzzy -msgid " -Wprototypes warn about missing FUNCTION prototypes/definitions" -msgstr "avertir quand les prototypes/définitions des FUNCTION sont manquants" - -#: cobc/warning.def:82 -#, fuzzy -msgid " -Warithmetic-osvs warn if arithmetic expression precision has changed" -msgstr "avertir si la précision de l'expression arithmétique a changé" - -#: cobc/warning.def:85 -#, fuzzy -msgid " -Wcall-params warn about non 01/77 items for CALL parameters" -msgstr "avertir sur les éléments 01/77 pour les paramètres de CALL" - -#: cobc/warning.def:88 -#, fuzzy -msgid " -Wconstant-expression warn about expressions that always resolve to true/false" -msgstr "avertir au sujet des expressions qui aboutissent toujours à vrai/faux" - -#: cobc/warning.def:91 -#, fuzzy -msgid " -Wcolumn-overflow warn about text after program-text area, FIXED format" -msgstr "avertir si un texte est après la zone de texte programme, format FIXED" - -#: cobc/warning.def:94 -#, fuzzy -msgid " -Wterminator warn about lack of scope terminator END-XXX" -msgstr "avertir quand il manque un terminateur de portée END-XXX" - -#: cobc/warning.def:97 -#, fuzzy -msgid " -Wlinkage warn about dangling LINKAGE items" -msgstr "avertir au sujet des éléments LINKAGE ballants" - -#: cobc/warning.def:100 -msgid " -Wunreachable warn about likely unreachable statements" -msgstr "" - -#: cobc/warning.def:103 -msgid " -Wno-dialect do not warn about dialect specific issues" -msgstr "" - -#: cobc/warning.def:106 -#, fuzzy -msgid " -Wothers do not warn about different issues" -msgstr " -Werror traiter tous les avertissements comme des erreurs" - -#: cobc/warning.def:109 -msgid " -Wno-unsupported do not warn if runtime does not support a feature used" -msgstr "" - -#: libcob/call.c:87 -#, c-format -msgid "LoadLibrary/GetProcAddress error %d" -msgstr "erreur %d dans LoadLibrary/GetProcAddress" - -#: libcob/call.c:939 -msgid "indeterminable error in resolve of COBOL CALL" -msgstr "erreur indéterminée dans la résolution de CALL du COBOL" - -#: libcob/call.c:1022 -#, c-format -msgid "user-defined FUNCTION '%s' not found" -msgstr "FUNCTION « %s » définie par l'utilisateur n'est pas trouvée" - -#: libcob/call.c:1129 libcob/call.c:1208 libcob/call.c:1326 libcob/call.c:1354 -#, c-format -msgid "NULL parameter passed to '%s'" -msgstr "paramètre NULL passé à « %s »" - -#: libcob/call.c:1204 -#, c-format -msgid "invalid number of arguments passed to '%s'" -msgstr "nombre de paramètres invalide passés à « %s »" - -#: libcob/call.c:1330 -msgid "multiple call to 'cob_setjmp'" -msgstr "appels multiples à « cob_setjmp »" - -#: libcob/call.c:1358 -msgid "call to 'cob_longjmp' with no prior 'cob_setjmp'" -msgstr "appel à « cob_longjmp » sans « cob_setjmp » précédent" - -#: libcob/call.c:1592 libcob/call.c:1633 libcob/call.c:1646 -#: libcob/common.c:7081 -msgid "cob_init() has not been called" -msgstr "cob_init() n'a pas été appelé" - -#: libcob/call.c:1598 -#, fuzzy, c-format -msgid "parameter %d is not within range of %d" -msgstr "%s: le paramètre %d n'est pas dans la plage de %d" - -#: libcob/call.c:1604 -#, fuzzy, c-format -msgid "parameter %d is NULL" -msgstr "%s: le paramètre %d est NULL" - -#: libcob/call.c:1859 libcob/call.c:1916 -#, fuzzy, c-format -msgid "attempt to over-write constant parameter %d with " -msgstr "%s: tentative d'écraser le paramètre constant %d avec " - -#: libcob/call.c:1965 -#, fuzzy, c-format -msgid "attempt to over-write constant parameter %d with '%s'" -msgstr "%s: tentative d'écraser le paramètre constant %d avec « %s »" - -#: libcob/cobgetopt.c:497 -#, c-format -msgid "%s: option '%s' is ambiguous; possibilities:" -msgstr "%s: l'option « %s » est ambigüe; les possibilités :" - -#: libcob/cobgetopt.c:538 -#, c-format -msgid "%s: option '--%s' doesn't allow an argument" -msgstr "%s: l'option « --%s » n'accepte pas d'argument" - -#: libcob/cobgetopt.c:545 -#, c-format -msgid "%s: option '%c%s' doesn't allow an argument" -msgstr "%s: l'option « %c%s » n'accepte pas d'argument" - -#: libcob/cobgetopt.c:565 -#, c-format -msgid "%s: option '--%s' requires an argument" -msgstr "%s: l'option « --%s » requiert un argument" - -#: libcob/cobgetopt.c:597 -#, c-format -msgid "%s: unrecognized option '--%s'" -msgstr "%s: option « --%s » non reconnue" - -#: libcob/cobgetopt.c:604 -#, c-format -msgid "%s: unrecognized option '%c%s'" -msgstr "%s: option « %c%s » non reconnue" - -#: libcob/cobgetopt.c:633 -#, c-format -msgid "%s: invalid option -- %c" -msgstr "%s: option invalide -- %c" - -#: libcob/cobgetopt.c:664 libcob/cobgetopt.c:805 -#, c-format -msgid "%s: option requires an argument -- %c" -msgstr "%s: l'option requiert un argument -- %c" - -#: libcob/cobgetopt.c:714 -#, c-format -msgid "%s: option '-W %s' is ambiguous" -msgstr "%s: l'option « -W %s » est ambigüe" - -#: libcob/cobgetopt.c:736 -#, c-format -msgid "%s: option '-W %s' doesn't allow an argument" -msgstr "%s: l'option « -W %s » n'accepte pas d'argument" - -#: libcob/cobgetopt.c:754 -#, c-format -msgid "%s: option '%s' requires an argument" -msgstr "%s: l'option « %s » exige un argument" - -#: libcob/common.c:793 -#, c-format -msgid "attempt to reference unallocated memory" -msgstr "tentative de référencer une mémoire non allouée" - -#: libcob/common.c:798 -#, c-format -msgid "bus error" -msgstr "erreur de bus" - -#: libcob/common.c:803 -#, c-format -msgid "fatal arithmetic error" -msgstr "" - -#: libcob/common.c:807 -#, c-format -msgid "caught signal" -msgstr "signal intercepté" - -#: libcob/common.c:811 -#, c-format -msgid "signal %s" -msgstr "signal %s" - -#: libcob/common.c:817 -#, c-format -msgid "abnormal termination - file contents may be incorrect" -msgstr "fin anormale – le contenu du fichier peut être incorrect" - -#: libcob/common.c:2049 -msgid "NULL field" -msgstr "" - -#: libcob/common.c:2059 -msgid "field with NULL address" -msgstr "" - -#: libcob/common.c:2345 -#, fuzzy -msgid "version mismatch" -msgstr "erreur : désaccord de version" - -#: libcob/common.c:2346 libcob/common.c:2348 -#, fuzzy, c-format -msgid "%s has version %s.%d" -msgstr "%s a la version/correctif %s/%d" - -#: libcob/common.c:2358 -#, fuzzy, c-format -msgid "CALL to %s requires %d arguments" -msgstr "CALL à %s requiert %d paramètres" - -#: libcob/common.c:2980 -#, c-format -msgid "BASED/LINKAGE item %s has NULL address" -msgstr "l'élément %s BASED/LINKAGE a une adresse NULL" - -#: libcob/common.c:2992 libcob/common.c:2995 -#, c-format -msgid "LINKAGE item %s not passed by caller" -msgstr "l'élément LINKAGE %s n'est pas passé par l'appelant" - -#: libcob/common.c:3081 -#, fuzzy, c-format -msgid "'%s' (Type: %s) not numeric: '%s'" -msgstr "« %s » pas numérique : « %s »" - -#: libcob/common.c:3096 -#, c-format -msgid "OCCURS DEPENDING ON '%s' out of bounds: %d" -msgstr "OCCURS DEPENDING ON « %s » hors limites : %d" - -#: libcob/common.c:3099 libcob/common.c:3120 -#, c-format -msgid "maximum subscript for '%s': %d" -msgstr "indice maximum pour « %s » : %d" - -#: libcob/common.c:3101 -#, c-format -msgid "minimum subscript for '%s': %d" -msgstr "indice minimum pour « %s » : %d" - -#: libcob/common.c:3117 -#, c-format -msgid "current maximum subscript for '%s': %d" -msgstr "indice maximum actuel pour « %s » : %d" - -#: libcob/common.c:3139 -#, fuzzy, c-format -msgid "offset of '%s' out of bounds: %d, maximum: %d" -msgstr "le décalage de « %s » est hors limites : %d" - -#: libcob/common.c:3152 -#, fuzzy, c-format -msgid "length of '%s' out of bounds: %d, maximum: %d" -msgstr "la longueur de « %s » est hors limites : %d" - -#: libcob/common.c:3161 -#, fuzzy, c-format -msgid "length of '%s' out of bounds: %d, starting at: %d, maximum: %d" -msgstr "la longueur de « %s » est hors limites : %d" - -#: libcob/common.c:3176 libcob/common.c:3181 -#, c-format -msgid "EXTERNAL item '%s' previously allocated with size %d, requested size is %d" -msgstr "l'élément EXTERNAL « %s » précédemment alloué avec la taille %d, la taille demandée est %d" - -#: libcob/common.c:3682 -#, c-format -msgid "COB_CURRENT_DATE '%s' is invalid" -msgstr "COB_CURRENT_DATE « %s » est invalide" - -#: libcob/common.c:4585 -#, c-format -msgid "parameter to SYSTEM call is larger than %d characters" -msgstr "le paramètre à l'appel SYSTEM est plus grand que %d caractères" - -#: libcob/common.c:5195 -#, fuzzy, c-format -msgid "error '%s' during CBL_GC_FORK" -msgstr "Erreur « %s » durant CBL_GC_FORK" - -#: libcob/common.c:5200 libcob/common.c:5297 -#, c-format -msgid "'%s' is not supported on this platform" -msgstr "« %s » n'est pas supporté sur cette plateforme" - -#: libcob/common.c:5226 -#, c-format -msgid "error '%s' for P%d during CBL_GC_WAITPID" -msgstr "erreur « %s » pour P%d durant CBL_GC_WAITPID" - -#: libcob/common.c:5418 -msgid "Call to CBL_GC_GETOPT with wrong longoption size." -msgstr "Appel à CBL_GC_GETOPT avec la mauvaise taille de longoption." - -#: libcob/common.c:5423 -msgid "Call to CBL_GC_GETOPT with missing longind." -msgstr "Appel à CBL_GC_GETOPT avec longind manquant." - -#: libcob/common.c:5837 libcob/common.c:5858 libcob/common.c:5871 -#: libcob/common.c:7785 -#, fuzzy, c-format -msgid "(default)" -msgstr " (défaut)" - -#: libcob/common.c:6119 libcob/common.c:6138 -msgid "should be unsigned" -msgstr "" - -#: libcob/common.c:6127 libcob/common.c:6176 -#, fuzzy -msgid "should be numeric" -msgstr "doit être numérique" - -#: libcob/common.c:6185 -#, c-format -msgid "minimum value: %lu" -msgstr "valeur minimum : %lu" - -#: libcob/common.c:6236 libcob/common.c:6787 libcob/common.c:6801 -#, c-format -msgid "should not contain '%c'" -msgstr "ne devrait pas contenir « %c »" - -#: libcob/common.c:6316 libcob/common.c:6384 libcob/common.c:6393 -#: libcob/common.c:6401 -#, c-format -msgid "not set" -msgstr "" - -#: libcob/common.c:6376 libcob/common.c:6379 libcob/common.c:6382 -#, fuzzy, c-format -msgid "set by %s" -msgstr " (défini par %s)" - -#: libcob/common.c:6516 -#, c-format -msgid "WARNING - '%s' without a value - ignored!" -msgstr "AVERTISSEMENT – « %s » sans valeur – ignoré !" - -#: libcob/common.c:6519 -#, c-format -msgid "'%s' without a value!" -msgstr "« %s » sans valeur !" - -#: libcob/common.c:6545 -#, c-format -msgid "WARNING - '%s %s' without a value - ignored!" -msgstr "AVERTISSEMENT – « %s %s » sans valeur – ignoré !" - -#: libcob/common.c:7034 -#, fuzzy -msgid "error" -msgstr "erreur : " - -#: libcob/common.c:7064 -msgid "attempt to CANCEL active program" -msgstr "tentative d'utiliser CANCEL sur le programme actif" - -#: libcob/common.c:7091 -msgid "CALL of program with CHAINING clause" -msgstr "CALL au programme avec la clause CHAINING" - -#: libcob/common.c:7095 -msgid "stack overflow, possible PERFORM depth exceeded" -msgstr "débordement de pile, la profondeur PERFORM est peut-être dépassée" - -#: libcob/common.c:7100 -msgid "invalid entry/exit in GLOBAL USE procedure" -msgstr "entrée/sortie invalide dans la procédure GLOBAL USE" - -#: libcob/common.c:7105 -msgid "unable to allocate memory" -msgstr "impossible d'allouer la mémoire" - -#: libcob/common.c:7110 -msgid "invalid entry into module" -msgstr "entrée invalide dans le module" - -#: libcob/common.c:7115 -#, c-format -msgid "recursive CALL from %s to %s which is NOT RECURSIVE" -msgstr "" - -#: libcob/common.c:7125 -#, fuzzy -msgid "divide by ZERO" -msgstr "division par la constante ZÉRO" - -#: libcob/common.c:7132 -msgid "end of file" -msgstr "fin du fichier" - -#: libcob/common.c:7135 -msgid "key out of range" -msgstr "clé hors limite" - -#: libcob/common.c:7138 -msgid "key order not ascending" -msgstr "l'ordre de la clé n'est pas croissant" - -#: libcob/common.c:7141 -msgid "record key already exists" -msgstr "la clé d'enregistrement existe déjà" - -#: libcob/common.c:7144 -msgid "record key does not exist" -msgstr "la clé d'enregistrement n'existe pas" - -#: libcob/common.c:7147 -msgid "permanent file error" -msgstr "erreur de fichier permanente" - -#: libcob/common.c:7150 -#, fuzzy -msgid "inconsistant file name" -msgstr "nom de fichier de configuration invalide" - -#: libcob/common.c:7153 -msgid "file does not exist" -msgstr "le fichier n'existe pas" - -#: libcob/common.c:7156 -msgid "permission denied" -msgstr "permission refusée" - -#: libcob/common.c:7159 -msgid "file already open" -msgstr "le fichier est déjà ouvert" - -#: libcob/common.c:7162 -msgid "file not open" -msgstr "fichier pas ouvert" - -#: libcob/common.c:7165 -msgid "READ must be executed first" -msgstr "READ doit être exécuté en premier" - -#: libcob/common.c:7168 -msgid "record overflow" -msgstr "débordement de l'enregistrement" - -#: libcob/common.c:7171 -#, fuzzy -msgid "READ after unsuccessful READ/START" -msgstr "READ après un READ/START infructueux" - -#: libcob/common.c:7174 -msgid "READ/START not allowed, file not open for input" -msgstr "READ/START pas permis, fichier pas ouvert en lecture" - -#: libcob/common.c:7177 -msgid "WRITE not allowed, file not open for output" -msgstr "WRITE pas permis, fichier pas ouvert en écriture" - -#: libcob/common.c:7180 -msgid "DELETE/REWRITE not allowed, file not open for I-O" -msgstr "DELETE/REWRITE pas permis, fichier pas ouvert pour E-S" - -#: libcob/common.c:7183 -msgid "record locked by another file connector" -msgstr "enregistrement verrouillé par un autre connecteur de fichier" - -#: libcob/common.c:7186 -msgid "LINAGE values invalid" -msgstr "valeurs LINAGE invalides" - -#: libcob/common.c:7189 -msgid "file sharing conflict" -msgstr "confit de partage de fichier" - -#: libcob/common.c:7193 -msgid "runtime library is not configured for this operation" -msgstr "la bibliothèque d'exécution n'est pas configurée pour cette opération" - -#: libcob/common.c:7198 -msgid "unknown file error" -msgstr "erreur de fichier inconnue" - -#: libcob/common.c:7205 -#, fuzzy, c-format -msgid "%s (status = %02d) for file %s" -msgstr "%s (statut = %02d) fichier: « %s »" - -#: libcob/common.c:7208 -#, fuzzy, c-format -msgid "%s (status = %02d) for file %s on %s" -msgstr "%s (statut = %02d) fichier: « %s »" - -#: libcob/common.c:7215 -msgid "attempt to use non-implemented function" -msgstr "tentative d'utiliser une fonction non implémentée" - -#: libcob/common.c:7218 -#, fuzzy -msgid "attempt to use non-implemented XML I/O" -msgstr "tentative d'utiliser une fonction non implémentée" - -#: libcob/common.c:7221 -#, fuzzy -msgid "attempt to use non-implemented JSON I/O" -msgstr "tentative d'utiliser une fonction non implémentée" - -#: libcob/common.c:7268 -msgid "environment variables" -msgstr "variables d'environnement" - -#: libcob/common.c:7315 -msgid "License LGPLv3+: GNU LGPL version 3 or later " -msgstr "Licence LGPLv3+ : GNU LGPL version 3 ou ultérieure " - -#: libcob/common.c:7372 libcob/common.c:7374 -msgid "dynamic loading" -msgstr "chargement dynamique" - -#: libcob/common.c:7379 -msgid "enabled" -msgstr "activé" - -#: libcob/common.c:7460 libcob/common.c:7577 libcob/common.c:7586 -#: libcob/common.c:7603 libcob/common.c:7618 -#, fuzzy, c-format -msgid "%s, version %d.%d.%d" -msgstr "Version C %s%s" - -#: libcob/common.c:7462 libcob/common.c:7579 libcob/common.c:7588 -#: libcob/common.c:7620 -#, c-format -msgid "%s, version %d.%d.%d (compiled with %d.%d)" -msgstr "" - -#: libcob/common.c:7465 -#, fuzzy, c-format -msgid "%s, version %s" -msgstr "Version C %s%s" - -#: libcob/common.c:7486 libcob/common.c:7488 libcob/common.c:7493 -#: libcob/common.c:7495 libcob/common.c:7498 -#, fuzzy -msgid "mouse support" -msgstr "" - -#: libcob/common.c:7636 -msgid "CALL configuration" -msgstr "Configuration CALL" - -#: libcob/common.c:7637 -msgid "File I/O configuration" -msgstr "Configuration E/S fichier" - -#: libcob/common.c:7638 -msgid "Screen I/O configuration" -msgstr "Configuration E/S écran" - -#: libcob/common.c:7639 -msgid "Miscellaneous" -msgstr "Divers" - -#: libcob/common.c:7640 -msgid "System configuration" -msgstr "Configuration système" - -#: libcob/common.c:7644 -msgid "runtime configuration" -msgstr "configuration de l'exécution" - -#: libcob/common.c:7646 -msgid "via" -msgstr "via" - -#: libcob/common.c:7719 libcob/common.c:7747 -msgid "... removed from environment" -msgstr "... retiré de l'environnement" - -#: libcob/common.c:7773 libcob/common.c:7775 -#, fuzzy, c-format -msgid "(set by %s)" -msgstr " (défini par %s)" - -#: libcob/common.c:7783 -#, fuzzy, c-format -msgid "(reset)" -msgstr " (réinitialisé)" - -#: libcob/common.c:8167 libcob/common.c:8286 -#, c-format -msgid "%s called with unknown option: %d" -msgstr "" - -#: libcob/common.c:8239 -#, c-format -msgid "Module dump due to %s\n" -msgstr "" - -#: libcob/common.c:8243 -#, fuzzy, c-format -msgid " Last statement of %s was Line %d of %s\n" -msgstr "instruction %s pas terminée par %s" - -#: libcob/common.c:8249 -#, fuzzy, c-format -msgid " Last statement of %s unknown\n" -msgstr "le nom système %s est inconnu" - -#: libcob/common.c:8259 -#, c-format -msgid "Dump Program-Id %s from %s compiled %s\n" -msgstr "" - -#: libcob/fileio.c:287 -#, c-format -msgid "ERROR I/O routine %s is not present" -msgstr "" - -#: libcob/fileio.c:1365 -#, c-format -msgid "I/O routine %s is not present for %s" -msgstr "" - -#: libcob/fileio.c:1404 -#, c-format -msgid "I/O routine %s is not known for %s" -msgstr "" - -#: libcob/fileio.c:2599 -#, c-format -msgid "ERROR FILE %s has record size %d exceeds %d in program" -msgstr "" - -#: libcob/fileio.c:2967 libcob/fileio.c:2974 -#, c-format -msgid "ERROR FILE %s opening pipe" -msgstr "" - -#: libcob/fileio.c:4979 -#, c-format -msgid "ERROR FILE %s does not match current version; Recompile the program" -msgstr "" - -#: libcob/fileio.c:5034 -#, c-format -msgid "ERROR FILE %s has ASSIGN field is NULL" -msgstr "" - -#: libcob/fileio.c:5707 -#, c-format -msgid "call to CBL_OPEN_FILE with wrong access mode: %d" -msgstr "appel à CBL_OPEN_FILE avec le mauvais mode d'accès : %d" - -#: libcob/fileio.c:5756 -#, c-format -msgid "call to CBL_CREATE_FILE with wrong file_lock: %d" -msgstr "appel à CBL_CREATE_FILE avec le mauvais file_lock : %d" - -#: libcob/fileio.c:5759 -#, c-format -msgid "call to CBL_CREATE_FILE with wrong file_dev: %d" -msgstr "appel à CBL_CREATE_FILE avec le mauvais file_dev : %d" - -#: libcob/fileio.c:5955 libcob/fileio.c:6215 -#, c-format -msgid "'%s' - File detail area is too short" -msgstr "« %s » – La zone des détails du fichier est trop courte" - -#: libcob/fileio.c:6437 -msgid "SORT is unable to acquire temporary file" -msgstr "SORT est incapable d'acquérir un fichier temporaire" - -#: libcob/fileio.c:7057 -#, fuzzy, c-format -msgid "implicit CLOSE of %s" -msgstr "CLOSE implicite de %s (« %s »)" - -#: libcob/fileio.c:7165 -#, c-format -msgid "C-ISAM library %s is not present" -msgstr "" - -#: libcob/fileio.c:7173 -#, c-format -msgid "D-ISAM library %s is not present" -msgstr "" - -#: libcob/fileio.c:7181 -#, c-format -msgid "VB-ISAM library %s is not present" -msgstr "" - -#: libcob/screenio.c:429 -msgid "failed to initialize curses" -msgstr "échec de l'initialisation de curses" - -#: libcob/screenio.c:3591 -msgid "end of program, please press a key to exit" -msgstr "fin du programme, appuyez sur une touche pour sortir" - -#: libcob/termio.c:70 libcob/termio.c:106 -msgid "(Not representable)" -msgstr "(Pas représentable)" - -#: libcob/termio.c:347 -#, fuzzy, c-format -msgid "cannot open %s (=%s)" -msgstr "ne peut spécifier à la fois %s et %s" - -#: libcob/termio.c:362 -msgid "COB_DISPLAY_PUNCH_FILE is invalid, output to SYSPUNCH skipped" -msgstr "" - -#: bin/cobcrun.c:122 -msgid "GnuCOBOL module loader" -msgstr "" - -#: bin/cobcrun.c:124 -#, c-format -msgid "Usage: %s [options] PROGRAM [parameter ...]" -msgstr "Usage : %s [options] PROGRAMME [paramètres …]" - -#: bin/cobcrun.c:126 -#, c-format -msgid " or: %s options" -msgstr " ou : %s options" - -#: bin/cobcrun.c:129 -msgid "Options:" -msgstr "Options :" - -#: bin/cobcrun.c:130 -msgid " -h, -help display this help and exit" -msgstr " -h, -help afficher cette aide et terminer" - -#: bin/cobcrun.c:131 -msgid " -V, -version display cobcrun and runtime version and exit" -msgstr " -V, -version afficher la version de cobcrun et du runtime et terminer" - -#: bin/cobcrun.c:132 -msgid " -i, -info display runtime information (build/environment)" -msgstr " -i, -info afficher les informations d'exécution (compilation/environnement" - -#: bin/cobcrun.c:134 -msgid " -q, -brief reduced displays" -msgstr " -q, -brief réduire l'affichage" - -#: bin/cobcrun.c:136 -msgid " -c , -config= set runtime configuration from " -msgstr " -c , -config= définir la configuration de l'exécution depuis " - -#: bin/cobcrun.c:137 -#, fuzzy -msgid "" -" -r, -runtime-config display current runtime configuration\n" -" (value and origin for all settings)" -msgstr "" -" -r, -runtime-conf afficher la configuration d'exécution actuelle\n" -" (valeur et origine de chaque paramètre)" - -#: bin/cobcrun.c:139 -msgid "" -" -M , -module= set entry point module name and/or load path\n" -" where -M module prepends any directory to the\n" -" dynamic link loader library search path\n" -" and any basename to the module preload list\n" -" (COB_LIBRARY_PATH and/or COB_PRELOAD)" -msgstr "" -" -M , -module= définir le nom du point d'entrée du module ou du chemin de chargement\n" -" où -M module ajoute tout répertoire au chemin de recherche\n" -" de la bibliothèque de chargement dynamique et tout nom de\n" -" base à la liste de modules préchargés\n" -" (COB_LIBRARY_PATH ou COB_PRELOAD)" - -#: bin/cobcrun.c:145 -#, c-format -msgid "" -"Report bugs to: %s\n" -"or (preferably) use the issue tracker via the home page." -msgstr "" -"Signalez les erreurs à : %s\n" -"ou (de préférence) utilisez le suivi d'erreurs via la page d'accueil." - -#: bin/cobcrun.c:148 -#, fuzzy -msgid "GnuCOBOL home page: " -msgstr "Page d'accueil de GnuCOBOL : " - -#: bin/cobcrun.c:149 -#, fuzzy -msgid "General help using GNU software: " -msgstr "Aide générale sur l'utilisation de logiciel GNU: " - -#: bin/cobcrun.c:274 -msgid "invalid configuration file name" -msgstr "nom de fichier de configuration invalide" - -#: bin/cobcrun.c:325 -#, fuzzy, c-format -msgid "invalid module argument '%s'" -msgstr "argument de module invalide" - -#: bin/cobcrun.c:377 -#, c-format -msgid "%s: missing PROGRAM name" -msgstr "" - -#: bin/cobcrun.c:379 -#, c-format -msgid "Try '%s --help' for more information." -msgstr "" - -#: bin/cobcrun.c:387 -#, fuzzy, c-format -msgid "%s: PROGRAM name exceeds %d characters" -msgstr "le nom de PROGRAM dépasse 31 caractères" - -#~ msgid "%s: %d: invalid cast from '%s' type %s to type %s" -#~ msgstr "%s: %d: transtypage invalide de « %s » du type %s vers le type %s" - -#~ msgid " - length is < 1 or > 31" -#~ msgstr " - longueur est < 1 ou > 31" - -#~ msgid "unknown name error '%s'%s" -#~ msgstr "erreur de nom inconnu « %s »%s" - -#~ msgid "ISAM handler" -#~ msgstr "gestionnaire ISAM" - -#~ msgid "- NOT set with -Wall" -#~ msgstr "- PAS défini avec -Wall" - -#~ msgid "- ALWAYS active" -#~ msgstr "- TOUJOURS actif" - -#~ msgid "default" -#~ msgstr "défaut" - -#~ msgid "GnuCOBOL compiler for most COBOL dialects with lots of extensions" -#~ msgstr "Compilateur GnuCOBOL pour la plupart des dialectes COBOL avec beaucoup d'extensions" - -#~ msgid "Usage: %s [options]... file..." -#~ msgstr "Usage : %s [options]… fichier…" - -#~ msgid " -h, -help display this help and exit" -#~ msgstr " -h, -help afficher cette aide et terminer" - -#~ msgid " -V, -version display compiler version and exit" -#~ msgstr " -V, -version afficher la version du compilateur et terminer" - -#~ msgid "" -#~ " -i, -info display compiler information (build/environment)\n" -#~ " and exit" -#~ msgstr "" -#~ " -i, -info afficher les informations du compilateur (compilation/environnement)\n" -#~ " et terminer" - -#~ msgid "" -#~ " -v, -verbose display compiler version and the commands\n" -#~ " invoked by the compiler" -#~ msgstr "" -#~ " -v, -verbose afficher la version du compilateur et les\n" -#~ " commandes invoquées par le compilateur" - -#~ msgid "" -#~ " -vv, -verbose=2 like -v but additional pass verbose option\n" -#~ " to assembler/compiler" -#~ msgstr "" -#~ " -vv, -verbose=2 comme -v mais passe en plus l'option verbeuse\n" -#~ " à l'assembleur/compilateur" - -#~ msgid "" -#~ " -vvv, -verbose=3 like -vv but additional pass verbose option\n" -#~ " to linker" -#~ msgstr "" -#~ " -vvv, -verbose=3 comme -vv mais passe en plus l'option verbeuse\n" -#~ " à l'éditeur de liens" - -#~ msgid " -q, -brief reduced displays, commands invoked not shown" -#~ msgstr " -q, -brief affichage réduit, commandes appelées pas montrées" - -#~ msgid " -### like -v but commands not executed" -#~ msgstr " -### comme -v mais les commandes ne sont pas exécutées" - -#~ msgid " -x build an executable program" -#~ msgstr " -x compiler un programme exécutable" - -#~ msgid " -m build a dynamically loadable module (default)" -#~ msgstr " -m compiler un module chargé dynamiquement (défaut)" - -#~ msgid " -j [], -job[=]\trun program after build, passing " -#~ msgstr " -j [], -job[=]\texécuter le programme après la compilation en lui passant " - -#~ msgid "" -#~ " -std= warnings/features for a specific dialect\n" -#~ " can be one of:\n" -#~ " default, cobol2014, cobol2002, cobol85, xopen,\n" -#~ " ibm-strict, ibm, mvs-strict, mvs,\n" -#~ " mf-strict, mf, bs2000-strict, bs2000,\n" -#~ " acu-strict, acu, rm-strict, rm;\n" -#~ " see configuration files in directory config" -#~ msgstr "" -#~ " -std= avertissements/fonctionnalités pour un dialecte spécifique\n" -#~ " peut prendre une des valeurs :\n" -#~ " default, cobol2014, cobol2002, cobol85, xopen,\n" -#~ " ibm-strict, ibm, mvs-strict, mvs,\n" -#~ " mf-strict, mf, bs2000-strict, bs2000,\n" -#~ " acu-strict, acu, rm-strict, rm;\n" -#~ " voyez les fichiers de configuration dans le répertoire de configuration" - -#~ msgid " -fixed use fixed source format (default)" -#~ msgstr " -fixed utiliser le format source fixe (défaut)" - -#~ msgid " -O, -O2, -O3, -Os enable optimization" -#~ msgstr " -O, -O2, -O3, -Os activer l'optimisation" - -#~ msgid " -g enable C compiler debug / stack check / trace" -#~ msgstr " -g activer le débogage / contrôle de pile / trace du compilateur C" - -#~ msgid " -d, -debug enable all run-time error checking" -#~ msgstr " -d, -debug activer tous les contrôles d'erreurs à l'exécution" - -#~ msgid " -o place the output into " -#~ msgstr " -o placer la sortie dans " - -#~ msgid "" -#~ " -b combine all input files into a single\n" -#~ " dynamically loadable module" -#~ msgstr "" -#~ " -b combiner tous les fichiers en entrée en un\n" -#~ " seul module chargé dynamiquement" - -#~ msgid " -E preprocess only; do not compile or link" -#~ msgstr " -E pré-traitement uniquement; ne pas compiler ni éditer les liens" - -#~ msgid " -C translation only; convert COBOL to C" -#~ msgstr " -C traduire uniquement; converti COBOL en C" - -#~ msgid " -S compile only; output assembly file" -#~ msgstr " -S compiler uniquement; sort un fichier assembleur" - -#~ msgid " -c compile and assemble, but do not link" -#~ msgstr " -c compiler et assembler mais ne pas éditer les liens" - -#~ msgid " -T generate and place a wide program listing into " -#~ msgstr " -T générer et placer un listing large du programme dans " - -#~ msgid " -t generate and place a program listing into " -#~ msgstr " -t générer et placer un listing du programme dans " - -#~ msgid " --tlines= specify lines per page in listing, default = 55" -#~ msgstr " --tlines= spécifier les lignes par page dans un listing, défaut = 55" - -#~ msgid " -P[=] generate preprocessed program listing (.lst)" -#~ msgstr " -P[=] générer le listing du programme pré-traité (.lst)" - -#~ msgid " -Xref specify cross reference in listing" -#~ msgstr " -Xref spécifier la référence croisée dans le listing" - -#~ msgid " -I add to copy/include search path" -#~ msgstr " -I ajouter au chemin de recherche des copies/inclusions" - -#~ msgid " -L add to library search path" -#~ msgstr " -L ajouter au chemin de recherche des bibliothèques" - -#~ msgid " -l link the library " -#~ msgstr " -l lier la bibliothèque " - -#~ msgid " -A add to the C compile phase" -#~ msgstr " -A ajouter à la phase de compilation C" - -#~ msgid " -Q add to the C link phase" -#~ msgstr " -Q ajouter à la phase d'édition de liens C" - -#~ msgid " -D define for COBOL compilation" -#~ msgstr " -D définir pour la compilation COBOL" - -#~ msgid " -K generate CALL to as static" -#~ msgstr " -K générer CALL à comme statique" - -#~ msgid " -conf= user-defined dialect configuration; see -std" -#~ msgstr " -conf= configuration du dialecte définie par l'utilisateur; voyez -std" - -#~ msgid " -list-reserved display reserved words" -#~ msgstr " -list-reserved afficher les mots réservés" - -#~ msgid " -list-intrinsics display intrinsic functions" -#~ msgstr " -list-intrinsics afficher les fonctions intrinsèques" - -#~ msgid " -list-mnemonics display mnemonic names" -#~ msgstr " -list-mnemonics afficher les noms des mnémoniques" - -#~ msgid " -list-system display system routines" -#~ msgstr " -list-system afficher les routines systèmes" - -#~ msgid "" -#~ " -save-temps[=] save intermediate files\n" -#~ " - default: current directory" -#~ msgstr "" -#~ " -save-temps[=] enregistrer les fichiers intermédiaires\n" -#~ " - défaut : répertoire courant" - -#~ msgid " -ext add file extension for resolving COPY" -#~ msgstr " -ext ajouter l'extension de fichier pour résoudre COPY" - -#~ msgid " -W enable all warnings" -#~ msgstr " -W activer tous les avertissements" - -#~ msgid " -Wall enable most warnings (all except as noted below)" -#~ msgstr " -Wall activer la plupart des avertissements (tous sauf ceux notés ci-dessous)" - -#~ msgid " -Wno- disable warning enabled by -W or -Wall" -#~ msgstr " -Wno- désactiver l'avertissement activé par -W ou -Wall" - -#~ msgid " -Werror= treat specified as error" -#~ msgstr " -Werror= traiter l'avertissement spécifié comme une erreur" - -#~ msgid "" -#~ msgstr "" - -#~ msgid "where is one of the following:" -#~ msgstr "où est l'un de cette liste :" - -#~ msgid "word to be taken out of the reserved words list" -#~ msgstr "mot à enlever de la liste des mots réservés" - -#~ msgid "" -#~ msgstr "" - -#~ msgid "word to be added to reserved words list" -#~ msgstr "mot à ajouter à la liste des mots réservés" - -#~ msgid "word to be added to reserved words list as alias" -#~ msgstr "mot à ajouter comme synonyme à la liste des mots réservés" - -#~ msgid ":" -#~ msgstr ":" - -#~ msgid "invalid parameter -std=%s" -#~ msgstr "paramètre invalide -std=%s" - -#~ msgid "invalid option detected" -#~ msgstr "option invalide détectée" - -#~ msgid "unknown option ignored:\t%s" -#~ msgstr "option inconnue ignorée :\t%s" - -#~ msgid "Invalid type for '%s'" -#~ msgstr "Type invalide pour « %s »" - -#~ msgid "invalid type for '%s'" -#~ msgstr "type invalide pour « %s »" - -#~ msgid "constant item '%s' cannot have a %s clause" -#~ msgstr "l'élément constant « %s » ne peut pas avoir une clause %s" - -#~ msgid "define PERFORM stack size" -#~ msgstr "définir la taille de la pile PERFORM" - -#~ msgid "" -#~ msgstr "" - -#~ msgid "define cutoff depth for IF statements" -#~ msgstr "définir le chemin de coupure pour les instructions IF" - -#~ msgid "define display sign representation" -#~ msgstr "afficher la représentation d'affichage du signe" - -#~ msgid "machine native" -#~ msgstr "natif machine" - -#~ msgid "fold COPY subject to value" -#~ msgstr "incorporer le sujet de COPY à la valeur" - -#~ msgid "no transformation" -#~ msgstr "pas de transformation" - -#~ msgid "fold PROGRAM-ID, CALL, CANCEL subject to value" -#~ msgstr "incorporer le sujet de PROGRAM-ID, CALL, CANCEL à la valeur" - -#~ msgid "initialize fields without VALUE to decimal value" -#~ msgstr "initialiser les champs sans VALUE à une valeur décimale" - -#~ msgid "0..255 or any quoted character" -#~ msgstr "0..255 ou tout caractère sans guillemet" - -#~ msgid "initialize to picture" -#~ msgstr "initialiser à l'image" - -#~ msgid "maximum number of errors to report" -#~ msgstr "nombre maximum d'erreurs à signaler" - -#~ msgid "intrinsics to be used without FUNCTION keyword" -#~ msgstr "intrinsèques à utiliser sans mot-clé FUNCTION" - -#~ msgid "[ALL|intrinsic function name(,name,...)]" -#~ msgstr "[ALL|nom de fonction intrinsèque(,nom,…)]" - -#~ msgid "generate extra braces in generated C code" -#~ msgstr "générer des accolades supplémentaires dans le code C généré" - -#~ msgid "" -#~ "generate trace code\n" -#~ "\t\t\t- executed SECTION/PARAGRAPH" -#~ msgstr "" -#~ "générer le code de trace\n" -#~ "\t\t\t- SECTION/PARAGRAPH exécuté" - -#~ msgid "" -#~ "adjust items following OCCURS DEPENDING\n" -#~ "\t\t\t- requires implicit/explicit relaxed syntax" -#~ msgstr "" -#~ "ajuster les éléments suivants OCCURS DEPENDING\n" -#~ "\t\t\t- requière la syntaxe relaxée implicite/explicite" - -#~ msgid "check recursive program call" -#~ msgstr "vérifier l'appel récursif du programme" - -#~ msgid "" -#~ "relax syntax checking\n" -#~ "\t\t\t- e.g. REDEFINES position" -#~ msgstr "" -#~ "relaxer la vérification de la syntaxe\n" -#~ "\t\t\t- c-à-d la position de REDEFINES" - -#~ msgid "PICTURE SYMBOL for CURRENCY must be one character long" -#~ msgstr "PICTURE SYMBOL pour CURRENCY doit avoir une longueur de un caractère" - -#~ msgid "invalid character '%c' in PICTURE SYMBOL for CURRENCY" -#~ msgstr "caractère « %c » invalide dans PICTURE SYMBOL pour CURRENCY" - -#~ msgid "88-level cannot be used here" -#~ msgstr "niveau 88 ne peut pas être utilisé ici" - -#~ msgid "incorrect order of CONFIGURATION SECTION paragraphs" -#~ msgstr "ordre incorrect des paragraphes de CONFIGURATION SECTION" - -#~ msgid "incorrect order of SOURCE- and OBJECT-COMPUTER paragraphs" -#~ msgstr "ordre incorrect des paragraphes SOURCE- et OBJECT-COMPUTER" - -#~ msgid "CURRENCY SIGN longer than one character" -#~ msgstr "CURRENCY SIGN plus long que un caractère" - -#~ msgid "CURRENCY SIGN other than '$'" -#~ msgstr "CURRENCY SIGN autre que « $ »" - -#~ msgid "RECORD description invalid with REPORT" -#~ msgstr "description RECORD invalide avec REPORT" - -#~ msgid "COMMUNICATION SECTION" -#~ msgstr "COMMUNICATION SECTION" - -#~ msgid "REDEFINES clause should follow entry-name" -#~ msgstr "la clause REDEFINES devrait suivre le nom d'entrée" - -#~ msgid "ANY LENGTH items may only be BY REFERENCE formal parameters" -#~ msgstr "les éléments ANY LENGTH peuvent uniquement être des paramètres formels BY REFERENCE" - -#~ msgid "parameters passed BY VALUE" -#~ msgstr "paramètres passés BY VALUE" - -#~ msgid "ignoring CONVERSION" -#~ msgstr "ignore CONVERSION" - -#~ msgid "%s is not implemented" -#~ msgstr "%s n'est pas implémenté" - -#~ msgid "table SORT without keys" -#~ msgstr "SORT de table sans clé" - -#~ msgid "invalid target for DEBUGGING ALL" -#~ msgstr "cible invalide pour DEBUGGING ALL" - -#~ msgid "non-negative integer value expected" -#~ msgstr "valeur entière non négative attendue" - -#~ msgid "'LENGTH OF' phrase" -#~ msgstr "phrase « LENGTH OF »" - -#~ msgid "cannot find the UTC offset on this system" -#~ msgstr "impossible de déterminer le fuseau horaire UTC de ce système" - -#~ msgid "invalid literal cast" -#~ msgstr "transtypage littéral invalide" - -#~ msgid "only one set of parentheses is permitted" -#~ msgstr "seulement un jeu de parenthèses sont permises" - -#~ msgid "no definition/prototype seen for function '%s'" -#~ msgstr "pas de définition/prototype vu pour la fonction « %s »" - -#~ msgid "no definition/prototype seen for function with external name '%s'" -#~ msgstr "pas de définition/prototype vu pour la fonction avec le nom externe « %s »" - -#~ msgid "invalid use of 88 level item" -#~ msgstr "utilisation invalide d'un élément au niveau 88" - -#~ msgid "reference to item containing nested ODO" -#~ msgstr "référence à un élément contenant un ODO imbriqué" - -#~ msgid "invalid use of HANDLE item" -#~ msgstr "utilisation invalide d'un élément HANDLE" - -#~ msgid "Variable length item not allowed here" -#~ msgstr "Un élément de longueur variable n'est pas permis ici" - -#~ msgid "the CHARACTERS field of ALLOCATE must be numeric" -#~ msgstr "le champs de CHARACTERS de ALLOCATE doit être numérique" - -# "handle": on dirait une erreur dans les majuscules par rapport au message précédent -#~ msgid "HANDLE must be either a generic or a WINDOW handle" -#~ msgstr "HANDLE doit soit être un générique ou soit un gestionnaire WINDOW" - -#~ msgid "warn type mismatch strictly" -#~ msgstr "avertir si le type ne correspond pas strictement" - -#~ msgid "warn unreachable statements" -#~ msgstr "avertir au sujet des instructions inatteignable" - -#~ msgid "cannot find module" -#~ msgstr "impossible de trouver le module" - -#~ msgid "cannot find entry point" -#~ msgstr "impossible de trouver le point d'entrée" - -#~ msgid "%s: COBOL runtime is not initialized" -#~ msgstr "%s: l'environnement d'exécution COBOL n'est pas initialisé" - -#~ msgid "%s COBOL runtime is not initialized" -#~ msgstr "%s l'environnement d'exécution COBOL n'est pas initialisé" - -#~ msgid "%s: attempt to over-write constant param %d" -#~ msgstr "%s: tentative d'écraser le paramètre constant %d" - -#~ msgid "cob_sig_handler caught not handled signal: %d" -#~ msgstr "cob_sig_handler a intercepté un signal non géré: %d" - -#~ msgid "libcob has version/patch level %s/%d" -#~ msgstr "libcob a la version/correctif %s/%d" - -#~ msgid "malloc error" -#~ msgstr "erreur de malloc" - -#~ msgid "codegen error - Please report this!" -#~ msgstr "erreur codegen – Merci de le signaler !" - -#~ msgid "invalid recursive COBOL CALL to '%s'" -#~ msgstr "CALL récursif de COBOL invalide à « %s »" - -#~ msgid "EXTFH" -#~ msgstr "EXTFH" - -#~ msgid "BDB error: %s" -#~ msgstr "erreur BDB : %s" - -#~ msgid "BDB error: %s %s" -#~ msgstr "erreur BDB : %s %s" - -#~ msgid "cannot join BDB environment (%s), error: %d %s" -#~ msgstr "impossible de joindre l'environnement BDB (%s), erreur : %d %s" - -#~ msgid "COBOL driver program for GnuCOBOL modules" -#~ msgstr "Programme pilote COBOL pour les modules GnuCOBOL" - -#~ msgid "problem with setenv %s: %d" -#~ msgstr "problème avec setenv %s: %d" diff -Nru gnucobol-4.0~early~20200606/po/gnucobol.pot gnucobol-5/po/gnucobol.pot --- gnucobol-4.0~early~20200606/po/gnucobol.pot 2020-06-06 20:52:58.000000000 +0000 +++ gnucobol-5/po/gnucobol.pot 1970-01-01 00:00:00.000000000 +0000 @@ -1,5618 +0,0 @@ -# SOME DESCRIPTIVE TITLE. -# Copyright (C) YEAR Free Software Foundation, Inc. -# This file is distributed under the same license as the gnucobol package. -# FIRST AUTHOR , YEAR. -# -#, fuzzy -msgid "" -msgstr "" -"Project-Id-Version: gnucobol 4.0-early-dev\n" -"Report-Msgid-Bugs-To: gnucobol-messages@gnu.org\n" -"POT-Creation-Date: 2020-06-06 20:52+0000\n" -"PO-Revision-Date: YEAR-MO-DA HO:MI+ZONE\n" -"Last-Translator: FULL NAME \n" -"Language-Team: LANGUAGE \n" -"Language: \n" -"MIME-Version: 1.0\n" -"Content-Type: text/plain; charset=CHARSET\n" -"Content-Transfer-Encoding: 8bit\n" - -#: cobc/cobc.c:117 -#, c-format -msgid "invalid parameter: %s" -msgstr "" - -#: cobc/cobc.c:826 -msgid "too many errors" -msgstr "" - -#: cobc/cobc.c:838 -msgid "internal compiler error" -msgstr "" - -#: cobc/cobc.c:904 cobc/cobc.c:991 cobc/cobc.c:1051 cobc/cobc.c:1127 -#: cobc/cobc.c:1167 cobc/cobc.c:1243 -#, c-format -msgid "cannot allocate %d bytes of memory" -msgstr "" - -#: cobc/cobc.c:917 cobc/cobc.c:933 cobc/cobc.c:953 cobc/cobc.c:1011 -#: cobc/cobc.c:1029 cobc/cobc.c:1147 cobc/cobc.c:1262 cobc/cobc.c:1279 -#: cobc/field.c:2008 libcob/common.c:7121 -#, c-format -msgid "call to %s with NULL pointer" -msgstr "" - -#: cobc/cobc.c:974 -#, c-format -msgid "cannot reallocate %d bytes of memory" -msgstr "" - -#: cobc/cobc.c:1068 cobc/cobc.c:1184 -msgid "attempt to reallocate non-allocated memory" -msgstr "" - -#: cobc/cobc.c:1101 cobc/cobc.c:1217 -#, c-format -msgid "call to %s with invalid pointer, as it is missing in list" -msgstr "" - -#: cobc/cobc.c:1390 -#, c-format -msgid "assuming literal for unquoted '%s'" -msgstr "" - -#: cobc/cobc.c:1437 -msgid " - length exceeds maximum" -msgstr "" - -#: cobc/cobc.c:1441 -msgid " - name cannot be empty" -msgstr "" - -#: cobc/cobc.c:1444 -msgid " - name cannot begin with space or underscore" -msgstr "" - -#: cobc/cobc.c:1447 -msgid " - name cannot begin with 'cob_' or 'COB_'" -msgstr "" - -#: cobc/cobc.c:1450 -msgid " - name duplicates a 'C' keyword" -msgstr "" - -#: cobc/cobc.c:1453 -msgid " - name cannot contain a directory separator" -msgstr "" - -#: cobc/cobc.c:1462 -#, c-format -msgid "invalid file base name '%s'%s" -msgstr "" - -#: cobc/cobc.c:1466 -#, c-format -msgid "invalid ENTRY '%s'%s" -msgstr "" - -#: cobc/cobc.c:1469 -#, c-format -msgid "invalid PROGRAM-ID '%s'%s" -msgstr "" - -#: cobc/cobc.c:1596 cobc/cobc.c:8151 -msgid "please check environment variables as noted above" -msgstr "" - -#: cobc/cobc.c:1608 cobc/error.c:254 cobc/error.c:274 cobc/error.c:505 -#: cobc/error.c:528 -msgid "error: " -msgstr "" - -#: cobc/cobc.c:1631 -#, c-format -msgid "duplicate DEFINE '%s' - ignored" -msgstr "" - -#: cobc/cobc.c:1683 -#, c-format -msgid "environment variable '%s' is '%s'; should not contain '%c'" -msgstr "" - -#: cobc/cobc.c:1712 -msgid "parameter buffer size exceeded" -msgstr "" - -#: cobc/cobc.c:1752 -#, c-format -msgid "warning: could not move temporary file to %s" -msgstr "" - -#: cobc/cobc.c:1957 cobc/cobc.c:1960 cobc/parser.y:803 cobc/reserved.c:3807 -#: libcob/common.c:761 libcob/common.c:1805 libcob/common.c:2002 -#: libcob/common.c:6325 libcob/common.c:7495 libcob/common.c:8025 -#: libcob/common.c:8104 -msgid "unknown" -msgstr "" - -#: cobc/cobc.c:1963 -#, c-format -msgid "aborting codegen for %s (%s: %s)" -msgstr "" - -#: cobc/cobc.c:1966 -#, c-format -msgid "aborting compile of %s at line %d (%s: %s)" -msgstr "" - -#: cobc/cobc.c:1970 -msgid "aborting" -msgstr "" - -#: cobc/cobc.c:1993 cobc/cobc.c:2028 libcob/common.c:7086 bin/cobcrun.c:342 -msgid "Please report this!" -msgstr "" - -#: cobc/cobc.c:2046 bin/cobcrun.c:106 -msgid "" -"License GPLv3+: GNU GPL version 3 or later " -msgstr "" - -#: cobc/cobc.c:2047 libcob/common.c:7316 bin/cobcrun.c:107 -msgid "" -"This is free software; see the source for copying conditions. There is NO\n" -"warranty; not even for MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE." -msgstr "" - -#: cobc/cobc.c:2049 libcob/common.c:7318 bin/cobcrun.c:109 -#, c-format -msgid "Written by %s\n" -msgstr "" - -#. TRANSLATORS: This msgid is indented as the "Packaged" msgid, %s expands to date and time -#: cobc/cobc.c:2050 cobc/cobc.c:2063 libcob/common.c:7321 bin/cobcrun.c:110 -#, c-format -msgid "Built %s" -msgstr "" - -#. TRANSLATORS: This msgid is indented as the "Built" msgid, %s expands to date and time -#: cobc/cobc.c:2052 cobc/cobc.c:2065 libcob/common.c:7324 bin/cobcrun.c:112 -#, c-format -msgid "Packaged %s" -msgstr "" - -#: cobc/cobc.c:2054 cobc/cobc.c:2067 -#, c-format -msgid "C version %s%s" -msgstr "" - -#: cobc/cobc.c:2080 -msgid "executing:" -msgstr "" - -#: cobc/cobc.c:2082 -msgid "to be executed:" -msgstr "" - -#: cobc/cobc.c:2120 cobc/cobc.c:2121 libcob/common.c:5815 libcob/common.c:5816 -#: libcob/common.c:5847 libcob/common.c:5848 -msgid "env" -msgstr "" - -#: cobc/cobc.c:2156 libcob/common.c:7351 -msgid "build information" -msgstr "" - -#: cobc/cobc.c:2157 libcob/common.c:7352 -msgid "build environment" -msgstr "" - -#: cobc/cobc.c:2167 libcob/common.c:7363 -msgid "GnuCOBOL information" -msgstr "" - -#: cobc/cobc.c:2212 libcob/common.c:6366 libcob/common.c:7386 -#: libcob/common.c:7486 libcob/common.c:7493 -msgid "yes" -msgstr "" - -#: cobc/cobc.c:2214 libcob/common.c:6368 libcob/common.c:7388 -#: libcob/common.c:7488 -msgid "no" -msgstr "" - -#: cobc/cobc.c:2218 libcob/common.c:7392 -msgid "8 bytes" -msgstr "" - -#: cobc/cobc.c:2220 libcob/common.c:7394 -msgid "4 bytes" -msgstr "" - -#: cobc/cobc.c:2224 cobc/cobc.c:2226 libcob/common.c:7398 libcob/common.c:7400 -msgid "endianness" -msgstr "" - -#: cobc/cobc.c:2224 libcob/common.c:7398 -msgid "big-endian" -msgstr "" - -#: cobc/cobc.c:2226 libcob/common.c:7400 -msgid "little-endian" -msgstr "" - -#: cobc/cobc.c:2230 cobc/cobc.c:2232 libcob/common.c:7404 libcob/common.c:7406 -msgid "native character set" -msgstr "" - -#: cobc/cobc.c:2230 libcob/common.c:7404 -msgid "EBCDIC" -msgstr "" - -#: cobc/cobc.c:2232 libcob/common.c:7406 -msgid "ASCII" -msgstr "" - -#: cobc/cobc.c:2235 libcob/common.c:7410 libcob/common.c:7476 -msgid "extended screen I/O" -msgstr "" - -#: cobc/cobc.c:2238 libcob/common.c:7502 -msgid "variable file format" -msgstr "" - -#: cobc/cobc.c:2244 cobc/cobc.c:2246 libcob/common.c:7508 libcob/common.c:7510 -msgid "sequential file handler" -msgstr "" - -#: cobc/cobc.c:2246 libcob/common.c:7510 -msgid "built-in" -msgstr "" - -#: cobc/cobc.c:2254 cobc/cobc.c:2260 cobc/cobc.c:2262 cobc/cobc.c:2269 -#: cobc/cobc.c:2271 cobc/cobc.c:2275 cobc/cobc.c:2278 cobc/cobc.c:2282 -#: cobc/cobc.c:2284 cobc/cobc.c:2289 cobc/cobc.c:2291 cobc/cobc.c:2298 -#: cobc/cobc.c:2300 cobc/cobc.c:2307 libcob/common.c:7516 libcob/common.c:7527 -#: libcob/common.c:7533 libcob/common.c:7535 libcob/common.c:7539 -#: libcob/common.c:7542 libcob/common.c:7546 libcob/common.c:7548 -#: libcob/common.c:7553 libcob/common.c:7555 libcob/common.c:7562 -#: libcob/common.c:7564 libcob/common.c:7571 -msgid "indexed file handler" -msgstr "" - -#: cobc/cobc.c:2304 libcob/common.c:7568 -msgid "default indexed handler" -msgstr "" - -#: cobc/cobc.c:2307 cobc/cobc.c:2319 cobc/cobc.c:2325 libcob/common.c:7381 -#: libcob/common.c:7498 libcob/common.c:7571 libcob/common.c:7611 -#: libcob/common.c:7625 -msgid "disabled" -msgstr "" - -#: cobc/cobc.c:2311 cobc/cobc.c:2313 libcob/common.c:7594 libcob/common.c:7596 -msgid "mathematical library" -msgstr "" - -#: cobc/cobc.c:2317 cobc/cobc.c:2319 libcob/common.c:7605 libcob/common.c:7611 -msgid "XML library" -msgstr "" - -#: cobc/cobc.c:2323 cobc/cobc.c:2325 libcob/common.c:7623 libcob/common.c:7625 -msgid "JSON library" -msgstr "" - -#: cobc/cobc.c:2332 -msgid "only one of options 'E', 'S', 'C', 'c' may be specified" -msgstr "" - -#: cobc/cobc.c:2338 -msgid "only one of options 'm', 'x', 'b' may be specified" -msgstr "" - -#: cobc/cobc.c:2367 -#, c-format -msgid "" -"-fdump= requires one of 'ALL', 'FD', 'WS', 'LS', 'RD', 'FD', 'SC' not '%s'" -msgstr "" - -#: cobc/cobc.c:2392 -#, c-format -msgid "'%s' is not an intrinsic function" -msgstr "" - -#: cobc/cobc.c:2434 cobc/cobc.c:7516 cobc/cobc.c:7630 cobc/codegen.c:3796 -#: cobc/codegen.c:3905 cobc/codegen.c:5221 cobc/codegen.c:12426 cobc/tree.c:789 -#: cobc/tree.c:1221 cobc/tree.c:4101 cobc/tree.c:4648 cobc/tree.c:4891 -#: cobc/typeck.c:3294 cobc/typeck.c:7812 cobc/typeck.c:7847 cobc/typeck.c:8660 -#: cobc/typeck.c:11261 cobc/typeck.c:11329 cobc/typeck.c:11397 -#: cobc/typeck.c:11681 cobc/typeck.c:11724 -#, c-format -msgid "call to '%s' with invalid parameter '%s'" -msgstr "" - -#: cobc/cobc.c:2737 -msgid "loading standard configuration file 'default.conf'" -msgstr "" - -#: cobc/cobc.c:2871 -msgid "invalid output file name" -msgstr "" - -#: cobc/cobc.c:2971 -#, c-format -msgid "warning: '%s' is not a directory, defaulting to current directory" -msgstr "" - -#: cobc/cobc.c:2998 -#, c-format -msgid "warning: %d lines per listing page specified, using %d" -msgstr "" - -#: cobc/cobc.c:3048 -#, c-format -msgid "warning: assuming '%s' is a DEFINE - did you intend to use -debug?" -msgstr "" - -#: cobc/cobc.c:3315 -#, c-format -msgid "unknown warning option '%s'" -msgstr "" - -#: cobc/cobc.c:3367 -#, c-format -msgid "%s option requires a listing file" -msgstr "" - -#: cobc/cobc.c:3374 -msgid "output to stdout only valid for preprocess" -msgstr "" - -#: cobc/cobc.c:3466 -msgid "all runtime checks are enabled" -msgstr "" - -#: cobc/cobc.c:3572 -msgid "only one stdin input allowed" -msgstr "" - -#: cobc/cobc.c:3582 -#, c-format -msgid "invalid file name parameter (length > %d)" -msgstr "" - -#: cobc/cobc.c:3807 -msgid "nothing for -j to run" -msgstr "" - -#: cobc/cobc.c:3883 cobc/cobc.c:4071 cobc/cobc.c:4130 cobc/cobc.c:4158 -#: cobc/cobc.c:4247 cobc/cobc.c:4306 cobc/cobc.c:4430 cobc/cobc.c:4469 -#: cobc/cobc.c:6993 -msgid "return status:" -msgstr "" - -#: cobc/cobc.c:4361 -msgid "preprocessing:" -msgstr "" - -#: cobc/cobc.c:4435 -msgid "'cobxref' execution unsuccessful" -msgstr "" - -#: cobc/cobc.c:4438 -#, c-format -msgid "check that 'cobxref' is in %s" -msgstr "" - -#: cobc/cobc.c:4440 -msgid "no listing produced" -msgstr "" - -#: cobc/cobc.c:5328 cobc/cobc.c:5367 -msgid "No fields defined." -msgstr "" - -#: cobc/cobc.c:5387 -msgid "No labels defined." -msgstr "" - -#: cobc/cobc.c:5409 -msgid "Error/Warning summary:" -msgstr "" - -#: cobc/cobc.c:5453 -msgid "0 warnings in compilation group" -msgstr "" - -#: cobc/cobc.c:5457 -msgid "1 warning in compilation group" -msgstr "" - -#: cobc/cobc.c:5461 -#, c-format -msgid "%d warnings in compilation group" -msgstr "" - -#: cobc/cobc.c:5467 -msgid "0 errors in compilation group" -msgstr "" - -#: cobc/cobc.c:5471 -msgid "1 error in compilation group" -msgstr "" - -#: cobc/cobc.c:5475 -#, c-format -msgid "%d errors in compilation group" -msgstr "" - -#: cobc/cobc.c:5481 -#, c-format -msgid "Too many errors in compilation group: %d maximum errors" -msgstr "" - -#: cobc/cobc.c:6050 -#, c-format -msgid "%s: %d: Too many continuation lines" -msgstr "" - -#: cobc/cobc.c:6972 -msgid "parsing:" -msgstr "" - -#: cobc/cobc.c:7034 -msgid "translating:" -msgstr "" - -#: cobc/cobc.c:8157 -msgid "no input files" -msgstr "" - -#: cobc/cobc.c:8186 -#, c-format -msgid "%s option invalid in this combination" -msgstr "" - -#: cobc/cobc.c:8227 -msgid "command line:" -msgstr "" - -#: cobc/codegen.c:973 cobc/codegen.c:4487 cobc/codegen.c:11093 -msgid "unexpected CONSTANT item" -msgstr "" - -#: cobc/codegen.c:1188 cobc/codegen.c:1196 cobc/codegen.c:1291 -#: cobc/codegen.c:1603 cobc/codegen.c:2202 cobc/codegen.c:3212 -#: cobc/codegen.c:3455 cobc/codegen.c:3988 cobc/codegen.c:4454 -#: cobc/codegen.c:7902 cobc/codegen.c:8507 cobc/codegen.c:10298 -#: cobc/field.c:817 cobc/scanner.l:2104 cobc/tree.c:611 cobc/tree.c:3728 -#: cobc/typeck.c:5015 cobc/typeck.c:8662 cobc/typeck.c:9657 -#, c-format -msgid "unexpected tree tag: %d" -msgstr "" - -#: cobc/codegen.c:2999 cobc/codegen.c:3295 cobc/codegen.c:8125 cobc/tree.c:1243 -#, c-format -msgid "unexpected cast type: %d" -msgstr "" - -#: cobc/codegen.c:3725 cobc/codegen.c:4434 -#, c-format -msgid "internal statement stack depth exceeded: %d" -msgstr "" - -#: cobc/codegen.c:3798 -#, c-format -msgid "%s is not a field" -msgstr "" - -#: cobc/codegen.c:4186 cobc/codegen.c:4279 -#, c-format -msgid "unexpected function: %s" -msgstr "" - -#: cobc/codegen.c:4270 -#, c-format -msgid "unexpected operator: %c" -msgstr "" - -#: cobc/codegen.c:5043 -#, c-format -msgid "unexpected tree category: %d" -msgstr "" - -#: cobc/codegen.c:5438 cobc/codegen.c:5465 cobc/codegen.c:5662 -#: cobc/codegen.c:5694 -#, c-format -msgid "unexpected size: %d" -msgstr "" - -#: cobc/codegen.c:7254 -#, c-format -msgid "No ENTRY FOR GO TO '%s'" -msgstr "" - -#: cobc/codegen.c:7475 cobc/codegen.c:7725 -#, c-format -msgid "unexpected handler type: %d" -msgstr "" - -#: cobc/codegen.c:7823 -msgid "unexpected error_node parameter" -msgstr "" - -#: cobc/codegen.c:8146 -#, c-format -msgid "unexpected tree type: %d" -msgstr "" - -#: cobc/codegen.c:8703 cobc/typeck.c:6511 cobc/typeck.c:12940 -#: cobc/typeck.c:12984 -#, c-format -msgid "compiler is not configured to support %s" -msgstr "" - -#: cobc/codegen.c:9128 -msgid "Nested OCCURS in report" -msgstr "" - -#: cobc/codeoptim.c:2762 -#, c-format -msgid "unexpected optimization value: %d" -msgstr "" - -#: cobc/config.c:162 libcob/common.c:6786 libcob/common.c:6800 -#: libcob/common.c:7242 -#, c-format -msgid "invalid value '%s' for configuration tag '%s'" -msgstr "" - -#: cobc/config.c:165 libcob/common.c:6093 libcob/common.c:6209 -#, c-format -msgid "should be one of the following values: %s" -msgstr "" - -#: cobc/config.c:167 -msgid "must be numeric" -msgstr "" - -#: cobc/config.c:169 libcob/common.c:6191 -#, c-format -msgid "maximum value: %lu" -msgstr "" - -#: cobc/config.c:171 -#, c-format -msgid "minimum value: %d" -msgstr "" - -#: cobc/config.c:203 -#, c-format -msgid "unsupported value '%s' for configuration tag '%s'" -msgstr "" - -#: cobc/config.c:311 cobc/pplex.l:977 libcob/common.c:6702 -msgid "recursive inclusion" -msgstr "" - -#: cobc/config.c:386 libcob/common.c:6753 -msgid "configuration file was included here" -msgstr "" - -#: cobc/config.c:415 -#, c-format -msgid "The previous loaded configuration '%s' will be discarded." -msgstr "" - -#: cobc/config.c:449 -msgid "missing definitions:" -msgstr "" - -#: cobc/config.c:451 -#, c-format -msgid "\tno definition of '%s'" -msgstr "" - -#: cobc/config.c:512 -#, c-format -msgid "invalid configuration tag '%s'" -msgstr "" - -#: cobc/config.c:525 libcob/common.c:6509 libcob/common.c:6592 -#: libcob/common.c:6620 -#, c-format -msgid "unknown configuration tag '%s'" -msgstr "" - -#: cobc/config.c:549 -#, c-format -msgid "invalid configuration tag '%s' in word-list" -msgstr "" - -#: cobc/config.c:608 -#, c-format -msgid "Could not access word list for '%s'" -msgstr "" - -#: cobc/error.c:87 -#, c-format -msgid "in section '%s':" -msgstr "" - -#: cobc/error.c:98 -#, c-format -msgid "in paragraph '%s':" -msgstr "" - -#: cobc/error.c:121 libcob/common.c:7252 -msgid "configuration error:" -msgstr "" - -#: cobc/error.c:134 libcob/common.c:673 -#, c-format -msgid "system error %d" -msgstr "" - -#: cobc/error.c:231 cobc/error.c:323 cobc/error.c:478 -msgid "error [-Werror]: " -msgstr "" - -#: cobc/error.c:231 cobc/error.c:323 cobc/error.c:478 cobc/error.c:505 -#: libcob/common.c:6881 libcob/common.c:6906 -#, c-format -msgid "warning: " -msgstr "" - -#: cobc/error.c:274 cobc/error.c:528 -msgid "error (ignored): " -msgstr "" - -#: cobc/error.c:364 cobc/error.c:380 cobc/error.c:563 cobc/error.c:584 -#, c-format -msgid "%s used" -msgstr "" - -#: cobc/error.c:367 cobc/error.c:566 -#, c-format -msgid "%s is archaic in %s" -msgstr "" - -#: cobc/error.c:371 cobc/error.c:570 -#, c-format -msgid "%s is obsolete in %s" -msgstr "" - -#: cobc/error.c:377 cobc/error.c:576 cobc/parser.y:5186 cobc/parser.y:5325 -#, c-format -msgid "%s ignored" -msgstr "" - -#: cobc/error.c:383 cobc/error.c:586 -#, c-format -msgid "%s does not conform to %s" -msgstr "" - -#: cobc/error.c:399 -msgid "configuration warning:" -msgstr "" - -#: cobc/error.c:621 cobc/error.c:640 -#, c-format -msgid "redefinition of '%s'" -msgstr "" - -#: cobc/error.c:628 cobc/error.c:653 -#, c-format -msgid "'%s' previously defined here" -msgstr "" - -#: cobc/error.c:677 cobc/error.c:684 -#, c-format -msgid "'%s' is not defined" -msgstr "" - -#: cobc/error.c:680 -#, c-format -msgid "'%s' cannot be used here" -msgstr "" - -#: cobc/error.c:682 cobc/parser.y:7009 -#, c-format -msgid "'%s' is not defined, but is a reserved word in another dialect" -msgstr "" - -#: cobc/error.c:716 -#, c-format -msgid "'%s' is ambiguous; needs qualification" -msgstr "" - -#: cobc/error.c:746 cobc/parser.y:16748 -#, c-format -msgid "'%s' defined here" -msgstr "" - -#: cobc/error.c:757 -#, c-format -msgid "fatal error: %s" -msgstr "" - -#: cobc/error.c:765 -#, c-format -msgid "group item '%s' cannot have %s clause" -msgstr "" - -#: cobc/error.c:779 -#, c-format -msgid "constant item '%s' requires a %s clause" -msgstr "" - -#: cobc/error.c:781 -#, c-format -msgid "level %02d item '%s' requires a %s clause" -msgstr "" - -#: cobc/error.c:795 -#, c-format -msgid "constant item '%s' can only have a %s clause" -msgstr "" - -#: cobc/error.c:797 -#, c-format -msgid "level %02d item '%s' can only have a %s clause" -msgstr "" - -#: cobc/field.c:131 -msgid "constant expression has Divide by ZERO" -msgstr "" - -#: cobc/field.c:187 cobc/field.c:324 cobc/field.c:332 -msgid "missing right parenthesis" -msgstr "" - -#: cobc/field.c:216 -#, c-format -msgid "expression stack overflow at %d entries for operation '%c'" -msgstr "" - -#: cobc/field.c:257 -#, c-format -msgid "expression stack overflow at %d entries" -msgstr "" - -#: cobc/field.c:274 -msgid "missing left parenthesis" -msgstr "" - -#: cobc/field.c:315 -#, c-format -msgid "invalid operator '%s' in expression" -msgstr "" - -#: cobc/field.c:334 -#, c-format -msgid "'%c' operator misplaced" -msgstr "" - -#: cobc/field.c:395 -#, c-format -msgid "invalid level number '%s'" -msgstr "" - -#: cobc/field.c:454 -msgid "entry following SAME AS may not be subordinate to it" -msgstr "" - -#: cobc/field.c:459 cobc/field.c:496 -msgid "level number must begin with 01 or 77" -msgstr "" - -#: cobc/field.c:541 cobc/field.c:557 -#, c-format -msgid "no previous data item of level %02d" -msgstr "" - -#: cobc/field.c:599 -#, c-format -msgid "'%s' cannot be qualified here" -msgstr "" - -#: cobc/field.c:605 -#, c-format -msgid "'%s' cannot be subscripted here" -msgstr "" - -#: cobc/field.c:617 -#, c-format -msgid "'%s' is not defined in '%s'" -msgstr "" - -#: cobc/field.c:638 -msgid "level number of REDEFINES entries must be identical" -msgstr "" - -#: cobc/field.c:643 -#, c-format -msgid "'%s' is not the original definition" -msgstr "" - -#: cobc/field.c:758 -#, c-format -msgid "PICTURE clause not compatible with USAGE %s" -msgstr "" - -#: cobc/field.c:855 cobc/field.c:930 cobc/field.c:941 -#, c-format -msgid "PICTURE clause required for '%s'" -msgstr "" - -#: cobc/field.c:937 -#, c-format -msgid "a non-numeric literal is expected for '%s'" -msgstr "" - -#: cobc/field.c:949 -#, c-format -msgid "defining implicit picture size %d for '%s'" -msgstr "" - -#: cobc/field.c:969 -#, c-format -msgid "'%s' ANY LENGTH only allowed in LINKAGE" -msgstr "" - -#: cobc/field.c:973 -#, c-format -msgid "'%s' ANY LENGTH must be 01 level" -msgstr "" - -#: cobc/field.c:977 -#, c-format -msgid "'%s' ANY LENGTH cannot be BASED/EXTERNAL" -msgstr "" - -#: cobc/field.c:982 cobc/field.c:1010 -#, c-format -msgid "'%s' ANY LENGTH has invalid definition" -msgstr "" - -#: cobc/field.c:993 -#, c-format -msgid "'%s' ANY NUMERIC must be PIC 9" -msgstr "" - -#: cobc/field.c:998 -#, c-format -msgid "'%s' ANY LENGTH must be PIC X or PIC N" -msgstr "" - -#: cobc/field.c:1008 -#, c-format -msgid "'%s' ANY NUMERIC has invalid definition" -msgstr "" - -#: cobc/field.c:1026 -#, c-format -msgid "'%s' EXTERNAL must be specified at 01/77 level" -msgstr "" - -#: cobc/field.c:1030 -#, c-format -msgid "'%s' EXTERNAL can only be specified in WORKING-STORAGE section" -msgstr "" - -#: cobc/field.c:1034 -#, c-format -msgid "'%s' EXTERNAL and BASED are mutually exclusive" -msgstr "" - -#: cobc/field.c:1037 -#, c-format -msgid "'%s' EXTERNAL not allowed with REDEFINES" -msgstr "" - -#: cobc/field.c:1049 -#, c-format -msgid "'%s' BASED not allowed here" -msgstr "" - -#: cobc/field.c:1052 -#, c-format -msgid "'%s' BASED not allowed with REDEFINES" -msgstr "" - -#: cobc/field.c:1055 -#, c-format -msgid "'%s' BASED only allowed at the 01 and 77 levels" -msgstr "" - -#: cobc/field.c:1067 -#, c-format -msgid "level %02d item '%s' cannot have a %s clause" -msgstr "" - -#: cobc/field.c:1082 -#, c-format -msgid "'%s' cannot have the OCCURS clause due to '%s'" -msgstr "" - -#: cobc/field.c:1101 -#, c-format -msgid "the original definition '%s' should not have OCCURS clause" -msgstr "" - -#: cobc/field.c:1108 -msgid "REDEFINES must follow the original definition" -msgstr "" - -#: cobc/field.c:1115 -#, c-format -msgid "'%s' cannot be variable length" -msgstr "" - -#: cobc/field.c:1118 -#, c-format -msgid "the original definition '%s' cannot be variable length" -msgstr "" - -#: cobc/field.c:1142 -#, c-format -msgid "SCREEN group item '%s' has invalid clause" -msgstr "" - -#: cobc/field.c:1223 -#, c-format -msgid "%s USAGE %s incompatible with %s USAGE %s" -msgstr "" - -#: cobc/field.c:1302 -#, c-format -msgid "'%s' cannot have PICTURE clause" -msgstr "" - -#: cobc/field.c:1318 cobc/field.c:1328 -#, c-format -msgid "%s item '%s' should be USAGE DISPLAY" -msgstr "" - -#: cobc/field.c:1351 -#, c-format -msgid "'%s' COMP-6 with sign - changing to COMP-3" -msgstr "" - -#: cobc/field.c:1377 -msgid "elementary items with SIGN clause must have S in PICTURE" -msgstr "" - -#: cobc/field.c:1380 -msgid "elementary items with SIGN clause must be USAGE DISPLAY or NATIONAL" -msgstr "" - -#: cobc/field.c:1397 -#, c-format -msgid "'%s' cannot have JUSTIFIED RIGHT" -msgstr "" - -#: cobc/field.c:1410 -#, c-format -msgid "'%s' cannot have S in PICTURE string and BLANK WHEN ZERO" -msgstr "" - -#: cobc/field.c:1415 -#, c-format -msgid "" -"'%s' cannot have BLANK WHEN ZERO without being USAGE DISPLAY or NATIONAL" -msgstr "" - -#: cobc/field.c:1426 -#, c-format -msgid "'%s' cannot have * in PICTURE string and BLANK WHEN ZERO" -msgstr "" - -#: cobc/field.c:1433 -#, c-format -msgid "'%s' is not numeric, so cannot have BLANK WHEN ZERO" -msgstr "" - -#: cobc/field.c:1446 -msgid "only level 88 items may have multiple values" -msgstr "" - -#: cobc/field.c:1454 cobc/field.c:1458 -#, c-format -msgid "initial VALUE clause ignored for %s item '%s'" -msgstr "" - -#: cobc/field.c:1471 -msgid "FULL has no effect on numeric items; you may want REQUIRED or PIC Z" -msgstr "" - -#: cobc/field.c:1499 -msgid "VALUE may not contain a figurative constant" -msgstr "" - -#: cobc/field.c:1507 -msgid "cannot specify both FULL and JUSTIFIED" -msgstr "" - -#: cobc/field.c:1519 -#, c-format -msgid "'%s' has FROM, TO or USING without PIC; PIC will be implied" -msgstr "" - -#: cobc/field.c:1533 -#, c-format -msgid "'%s' has numeric VALUE without PIC; PIC will be implied" -msgstr "" - -#: cobc/field.c:1548 -#, c-format -msgid "'%s' cannot have PIC without FROM, TO, USING or numeric VALUE" -msgstr "" - -#: cobc/field.c:1560 -#, c-format -msgid "'%s' needs a PIC, FROM, TO, USING, VALUE, BELL, BLANK or ERASE clause" -msgstr "" - -#: cobc/field.c:1574 -msgid "cannot specify both PIC and VALUE" -msgstr "" - -#: cobc/field.c:1582 -msgid "cannot have PIC without FROM, TO or USING" -msgstr "" - -#: cobc/field.c:1591 -msgid "cannot have FROM, TO or USING without PIC" -msgstr "" - -#: cobc/field.c:1600 -msgid "VALUE item may not be numeric" -msgstr "" - -#: cobc/field.c:1616 -#, c-format -msgid "'%s' needs a PIC, COL, LINE, VALUE, BELL or BLANK clause" -msgstr "" - -#: cobc/field.c:1647 -msgid "" -"cannot use AUTO, FULL, PROMPT, REQUIRED or SECURE on elementary item without " -"TO or USING" -msgstr "" - -#: cobc/field.c:1654 -msgid "" -"cannot use BLANK WHEN ZERO, JUSTIFIED, OCCURS or SIGN on item without FROM, " -"TO or USING" -msgstr "" - -#: cobc/field.c:1674 -msgid "" -"cannot use AUTO, FULL, REQUIRED or SECURE on elementary item without FROM, " -"TO or USING" -msgstr "" - -#: cobc/field.c:1679 -msgid "cannot use BLANK WHEN ZERO, JUSTIFIED or SIGN without FROM, TO or USING" -msgstr "" - -#: cobc/field.c:1697 -msgid "cannot have BLANK WHEN ZERO without PIC" -msgstr "" - -#: cobc/field.c:1700 -msgid "cannot have JUSTIFIED without PIC" -msgstr "" - -#: cobc/field.c:1720 -msgid "cannot have AUTO without FROM, TO or USING" -msgstr "" - -#: cobc/field.c:1725 -msgid "cannot use FULL or REQUIRED on item without TO or USING" -msgstr "" - -#: cobc/field.c:1732 -msgid "SECURE can be used with TO only" -msgstr "" - -#: cobc/field.c:1734 -msgid "SECURE must be used with TO" -msgstr "" - -#: cobc/field.c:1753 -#, c-format -msgid "'%s' does nothing" -msgstr "" - -#: cobc/field.c:1797 -msgid "BLANK ZERO not compatible with USAGE" -msgstr "" - -#: cobc/field.c:1800 -msgid "SIGN clause not compatible with USAGE" -msgstr "" - -#: cobc/field.c:1977 -#, c-format -msgid "'%s' PICTURE clause not compatible with USAGE" -msgstr "" - -#: cobc/field.c:2027 -#, c-format -msgid "'%s' 77 level is not allowed here" -msgstr "" - -#: cobc/field.c:2424 -msgid "OCCURS and multi COLUMNs is not allowed" -msgstr "" - -#: cobc/field.c:2452 -#, c-format -msgid "duplicate LINE %d ignored" -msgstr "" - -#: cobc/field.c:2469 -#, c-format -msgid "ignoring SYNCHRONIZED for group item '%s'" -msgstr "" - -#: cobc/field.c:2485 cobc/field.c:2498 cobc/field.c:2778 cobc/field.c:2781 -#, c-format -msgid "size of '%s' larger than size of '%s'" -msgstr "" - -#: cobc/field.c:2638 cobc/field.c:2703 -#, c-format -msgid "'%s' cannot be larger than %d bytes" -msgstr "" - -#: cobc/field.c:2676 cobc/field.c:2684 -#, c-format -msgid "'%s' binary field cannot be larger than %d digits" -msgstr "" - -#: cobc/field.c:2764 cobc/field.c:3216 -#, c-format -msgid "unexpected USAGE: %d" -msgstr "" - -#: cobc/field.c:2876 -msgid "literal type does not match numeric data type" -msgstr "" - -#: cobc/field.c:2953 -#, c-format -msgid "THRU item '%s' may not come before '%s'" -msgstr "" - -#: cobc/field.c:2976 -#, c-format -msgid "RENAMES cannot start/end at the OCCURS item '%s'" -msgstr "" - -#: cobc/field.c:2984 -#, c-format -msgid "cannot use RENAMES on part of the table '%s'" -msgstr "" - -#: cobc/field.c:3022 -#, c-format -msgid "RENAMES may not contain '%s' as it is a pointer or object reference" -msgstr "" - -#: cobc/field.c:3027 -#, c-format -msgid "RENAMES may not contain '%s' as it is an OCCURS DEPENDING table" -msgstr "" - -#: cobc/field.c:3049 -msgid "RENAMES of 01-, 66- and 77-level items" -msgstr "" - -#: cobc/field.c:3051 -msgid "RENAMES may not reference a level 88" -msgstr "" - -#: cobc/field.c:3075 -#, c-format -msgid "'%s' must immediately follow the record '%s'" -msgstr "" - -#: cobc/field.c:3083 -#, c-format -msgid "THRU item must be different to '%s'" -msgstr "" - -#: cobc/field.c:3089 -#, c-format -msgid "'%s' and '%s' must be in the same record" -msgstr "" - -#: cobc/field.c:3100 -#, c-format -msgid "THRU item '%s' may not be subordinate to '%s'" -msgstr "" - -#: cobc/flag.def:40 -msgid "" -" -fstack-size=\tdefine PERFORM stack size\n" -" * default: 255" -msgstr "" - -#: cobc/flag.def:44 -msgid "" -" -fsign=[ASCII|EBCDIC]\tdefine display sign representation\n" -" * default: machine native" -msgstr "" - -#: cobc/flag.def:48 -msgid "" -" -ffold-copy=[UPPER|LOWER]\tfold COPY subject to value\n" -" * default: no transformation" -msgstr "" - -#: cobc/flag.def:52 -msgid "" -" -ffold-call=[UPPER|LOWER]\tfold PROGRAM-ID, CALL, CANCEL subject to value\n" -" * default: no transformation" -msgstr "" - -#: cobc/flag.def:56 -msgid "" -" -fdefaultbyte=\tinitialize fields without VALUE to value\n" -" * decimal 0..255 or any quoted character\n" -" * default: initialize to picture" -msgstr "" - -#: cobc/flag.def:61 -msgid "" -" -fmax-errors=\tmaximum number of errors to report before\n" -" compilation is aborted\n" -" * default: 128" -msgstr "" - -#: cobc/flag.def:68 -msgid "" -" -fintrinsics=[ALL|intrinsic function name(,name,...)]\n" -" intrinsics to be used without FUNCTION keyword" -msgstr "" - -#: cobc/flag.def:72 -msgid "" -" -fdump= dump data fields on abort, may be\n" -" a combination of: ALL, WS, LS, RD, FD, SC" -msgstr "" - -#: cobc/flag.def:76 -msgid "" -" -fcallfh= use external provided EXTFH interface module\n" -" for I/O" -msgstr "" - -#: cobc/flag.def:80 -msgid "" -" -fsqldb= which Database is used, may be\n" -" MySQL, MSSQL, Oracle10, Oracle11, Oracle12" -msgstr "" - -#: cobc/flag.def:84 -msgid " -fsqlschema= define database schema name" -msgstr "" - -#: cobc/flag.def:91 -msgid "" -" -fno-recursive-check disable check of recursive program call;\n" -" effectively compiling as RECURSIVE program" -msgstr "" - -#: cobc/flag.def:95 -msgid "" -" -fwinmain generate WinMain instead of main when compiling\n" -" as executable" -msgstr "" - -#: cobc/flag.def:99 -msgid " -fcomputed-goto generate computed goto C statements" -msgstr "" - -#: cobc/flag.def:102 -msgid " -falternate-ebcdic use restricted ASCII to EBCDIC translate" -msgstr "" - -#: cobc/flag.def:105 -msgid " -fextra-brace generate extra braces in C source" -msgstr "" - -#: cobc/flag.def:108 -msgid "" -" -fgen-c-line-directives\tgenerate source location directives in C code" -msgstr "" - -#: cobc/flag.def:111 -msgid " -fgen-c-labels generate extra labels in C sources" -msgstr "" - -#: cobc/flag.def:114 -msgid "" -" -fcorrect-numeric attempt correction of invalid numeric display items" -msgstr "" - -#: cobc/flag.def:117 -msgid " -fstack-on-heap PERFORM stack allocated on heap" -msgstr "" - -#: cobc/flag.def:120 -msgid " -ffast-math Disables emitting faster arithmetic logic" -msgstr "" - -#: cobc/flag.def:125 -msgid "" -" -fno-remove-unreachable\tdisable remove of unreachable code\n" -" * turned off by -g" -msgstr "" - -#: cobc/flag.def:129 -msgid "" -" -finline-intrinsic\twhen possible resolve intrinsic FUNCTIONs at compile " -"time" -msgstr "" - -#: cobc/flag.def:132 -msgid "" -" -ftrace generate trace code\n" -" * scope: executed SECTION/PARAGRAPH" -msgstr "" - -#: cobc/flag.def:136 -msgid "" -" -ftraceall generate trace code\n" -" * scope: executed SECTION/PARAGRAPH/STATEMENTS\n" -" * turned on by -debug" -msgstr "" - -#: cobc/flag.def:141 -msgid "" -" -fsyntax-only syntax error checking only; don't emit any output" -msgstr "" - -#: cobc/flag.def:144 -msgid "" -" -fdebugging-line enable debugging lines\n" -" * 'D' in indicator column or floating >>D" -msgstr "" - -#: cobc/flag.def:148 -msgid "" -" -fsource-location generate source location code\n" -" * turned on by -debug/-g/-ftraceall" -msgstr "" - -#: cobc/flag.def:152 -msgid "" -" -fimplicit-init automatic initialization of the COBOL runtime system" -msgstr "" - -#: cobc/flag.def:155 -msgid "" -" -fstack-check PERFORM stack checking\n" -" * turned on by -debug or -g" -msgstr "" - -#: cobc/flag.def:159 -msgid "" -" -fwrite-after use AFTER 1 for WRITE of LINE SEQUENTIAL\n" -" * default: BEFORE 1" -msgstr "" - -#: cobc/flag.def:163 -msgid "" -" -fmfcomment '*' or '/' in column 1 treated as comment\n" -" * FIXED format only" -msgstr "" - -#: cobc/flag.def:167 -msgid "" -" -facucomment '$' in indicator area treated as '*',\n" -" '|' treated as floating comment" -msgstr "" - -#: cobc/flag.def:171 -msgid "" -" -fnotrunc allow numeric field overflow\n" -" * non-ANSI behaviour" -msgstr "" - -#: cobc/flag.def:175 -msgid "" -" -fodoslide adjust items following OCCURS DEPENDING\n" -" * implies -fcomplex-odo" -msgstr "" - -#: cobc/flag.def:179 -msgid "" -" -fsingle-quote use a single quote (apostrophe) for QUOTE\n" -" * default: double quote" -msgstr "" - -#: cobc/flag.def:189 -msgid "" -" -foptional-file treat all files as OPTIONAL\n" -" * unless NOT OPTIONAL specified" -msgstr "" - -#: cobc/flag.def:193 -msgid "" -" -fstatic-call output static function calls for the CALL statement" -msgstr "" - -#: cobc/flag.def:196 -msgid "" -" -fno-gen-c-decl-static-call\tdisable generation of C function declations\n" -" for subroutines with static CALL" -msgstr "" - -#: cobc/flag.def:200 -msgid "" -" -fmf-files Sequential & Relative files will match Micro Focus " -"format" -msgstr "" - -#: cobc/flag.def:203 -msgid "" -" -fno-theaders suppress all headers and output of compilation\n" -" options from listing while keeping page breaks" -msgstr "" - -#: cobc/flag.def:207 -msgid " -fno-tsource suppress source from listing" -msgstr "" - -#: cobc/flag.def:210 -msgid " -fno-tmessages suppress warning and error summary from listing" -msgstr "" - -#: cobc/flag.def:213 -msgid " -ftsymbols specify symbols in listing" -msgstr "" - -#: cobc/parser.y:283 cobc/parser.y:317 -#, c-format -msgid "unreachable statement '%s'" -msgstr "" - -#: cobc/parser.y:410 cobc/parser.y:703 -#, c-format -msgid "'%s' is not in LINKAGE SECTION" -msgstr "" - -#: cobc/parser.y:413 cobc/typeck.c:3705 -#, c-format -msgid "'%s' cannot be BASED/EXTERNAL" -msgstr "" - -#: cobc/parser.y:418 -#, c-format -msgid "'%s' is not in WORKING-STORAGE SECTION" -msgstr "" - -#: cobc/parser.y:425 cobc/typeck.c:3702 -#, c-format -msgid "'%s' not level 01 or 77" -msgstr "" - -#: cobc/parser.y:428 cobc/parser.y:443 cobc/typeck.c:3708 -#, c-format -msgid "'%s' REDEFINES field not allowed here" -msgstr "" - -#: cobc/parser.y:456 -#, c-format -msgid "'%s' USING item duplicates RETURNING item" -msgstr "" - -#: cobc/parser.y:466 -#, c-format -msgid "ENTRY '%s' duplicated" -msgstr "" - -#: cobc/parser.y:502 -#, c-format -msgid "ENTRY FOR GO TO '%s' duplicated" -msgstr "" - -#: cobc/parser.y:518 -#, c-format -msgid "maximum nested program depth exceeded (%d)" -msgstr "" - -#: cobc/parser.y:544 cobc/parser.y:571 -#, c-format -msgid "%s statement not terminated by %s" -msgstr "" - -#: cobc/parser.y:574 -#, c-format -msgid "%s statement not terminated" -msgstr "" - -#: cobc/parser.y:638 -msgid "USE statement invalid for SORT file" -msgstr "" - -#: cobc/parser.y:665 cobc/parser.y:667 -#, c-format -msgid "duplicate %s clause" -msgstr "" - -#: cobc/parser.y:685 -#, c-format -msgid "Cannot specify %s without number of lines on page" -msgstr "" - -#: cobc/parser.y:695 -#, c-format -msgid "maximum OCCURS depth exceeded (%d)" -msgstr "" - -#: cobc/parser.y:709 cobc/parser.y:711 cobc/parser.y:6808 cobc/parser.y:6811 -#: cobc/parser.y:6813 cobc/parser.y:6815 cobc/parser.y:6850 cobc/parser.y:7573 -#: cobc/parser.y:7575 cobc/parser.y:7577 cobc/parser.y:7579 cobc/parser.y:7625 -#: cobc/parser.y:7634 cobc/parser.y:9548 cobc/parser.y:10994 -#: cobc/parser.y:12370 cobc/parser.y:13552 -#, c-format -msgid "%s and %s are mutually exclusive" -msgstr "" - -#: cobc/parser.y:725 cobc/parser.y:729 -msgid "TO phrase without DEPENDING phrase" -msgstr "" - -#: cobc/parser.y:726 -msgid "maximum number of occurrences assumed to be exact number" -msgstr "" - -#: cobc/parser.y:733 cobc/parser.y:7355 -msgid "OCCURS TO must be greater than OCCURS FROM" -msgstr "" - -#: cobc/parser.y:742 -msgid "OCCURS DEPENDING ON without TO phrase" -msgstr "" - -#: cobc/parser.y:808 -#, c-format -msgid "%s header missing - assumed" -msgstr "" - -#: cobc/parser.y:810 -#, c-format -msgid "%s header missing" -msgstr "" - -#: cobc/parser.y:942 -#, c-format -msgid "duplicate %s" -msgstr "" - -#: cobc/parser.y:944 -#, c-format -msgid "%s incorrectly after %s" -msgstr "" - -#: cobc/parser.y:1046 -#, c-format -msgid "redefinition of program name '%s'" -msgstr "" - -#: cobc/parser.y:1050 -#, c-format -msgid "redefinition of program ID '%s'" -msgstr "" - -#: cobc/parser.y:1082 -#, c-format -msgid "FUNCTION '%s' has no PROCEDURE DIVISION" -msgstr "" - -#: cobc/parser.y:1188 -msgid "functions may not be defined within a program/function" -msgstr "" - -#: cobc/parser.y:1238 -#, c-format -msgid "END FUNCTION '%s' is different from FUNCTION-ID '%s'" -msgstr "" - -#: cobc/parser.y:1252 -#, c-format -msgid "END PROGRAM '%s' is different from PROGRAM-ID '%s'" -msgstr "" - -#: cobc/parser.y:1301 -msgid "currency symbol must be one character long" -msgstr "" - -#: cobc/parser.y:1358 -#, c-format -msgid "invalid character '%c' in currency symbol" -msgstr "" - -#: cobc/parser.y:1374 -msgid "prototype has same name as current function and will be ignored" -msgstr "" - -#: cobc/parser.y:1401 -#, c-format -msgid "duplicate REPOSITORY entries for '%s' do not match" -msgstr "" - -#: cobc/parser.y:1405 -#, c-format -msgid "duplicate REPOSITORY entry for '%s'" -msgstr "" - -#: cobc/parser.y:1470 -#, c-format -msgid "ORGANIZATION %s is incompatible with RECORD DELIMITER" -msgstr "" - -#: cobc/parser.y:1502 -#, c-format -msgid "illegal combination of %s with other clauses" -msgstr "" - -#: cobc/parser.y:1517 cobc/parser.y:1520 cobc/parser.y:1551 -#, c-format -msgid "cannot specify both %s and %s" -msgstr "" - -#: cobc/parser.y:1548 -#, c-format -msgid "cannot specify both %s and %s; %s is ignored" -msgstr "" - -#: cobc/parser.y:1720 -msgid "FOR phrase cannot immediately follow ALL/LEADING/TRAILING" -msgstr "" - -#: cobc/parser.y:1722 -msgid "missing CHARACTERS/ALL/LEADING/TRAILING phrase after FOR phrase" -msgstr "" - -#: cobc/parser.y:1729 -msgid "missing value between ALL/LEADING/TRAILING words" -msgstr "" - -#: cobc/parser.y:1734 -msgid "missing FOR phrase before CHARACTERS/ALL/LEADING/TRAILING phrase" -msgstr "" - -#: cobc/parser.y:1741 -msgid "missing ALL/LEADING/TRAILING before value" -msgstr "" - -#: cobc/parser.y:1796 -msgid "use of condition-name in place of data-name" -msgstr "" - -#: cobc/parser.y:1800 cobc/parser.y:6753 cobc/typeck.c:665 -#, c-format -msgid "condition-name not allowed here: '%s'" -msgstr "" - -#: cobc/parser.y:1827 -msgid "cannot specify NO ADVANCING in screen DISPLAY" -msgstr "" - -#: cobc/parser.y:1899 cobc/parser.y:1916 -msgid "non-standard DISPLAY" -msgstr "" - -#: cobc/parser.y:1903 -msgid "screens may only be displayed on CRT" -msgstr "" - -#: cobc/parser.y:1908 cobc/parser.y:1951 -msgid "cannot mix screens and fields in the same DISPLAY statement" -msgstr "" - -#: cobc/parser.y:1912 -msgid "screen clauses may only be used for DISPLAY on CRT" -msgstr "" - -#: cobc/parser.y:1957 -msgid "ambiguous DISPLAY; put items to display on device in separate DISPLAY" -msgstr "" - -#: cobc/parser.y:1973 -#, c-format -msgid "%s is not an alphanumeric literal" -msgstr "" - -#: cobc/parser.y:1975 -#, c-format -msgid "'%s' is not USAGE DISPLAY" -msgstr "" - -#: cobc/parser.y:1990 cobc/typeck.c:8481 -#, c-format -msgid "invalid target for %s" -msgstr "" - -#: cobc/parser.y:1997 cobc/parser.y:6747 -msgid "SCREEN item cannot be used here" -msgstr "" - -#: cobc/parser.y:1999 -msgid "RENAMES item may not be used here" -msgstr "" - -#: cobc/parser.y:2001 cobc/typeck.c:2333 cobc/typeck.c:2429 -msgid "ANY LENGTH item not allowed here" -msgstr "" - -#: cobc/parser.y:2005 -#, c-format -msgid "item '%s' has wrong class for VALIDATE" -msgstr "" - -#: cobc/parser.y:2014 -msgid "WHEN clause must follow EVERY clause" -msgstr "" - -#: cobc/parser.y:2096 cobc/parser.y:17197 -msgid "non-zero value expected" -msgstr "" - -#: cobc/parser.y:2102 cobc/tree.c:4352 -#, c-format -msgid "RECORD size (IDX) exceeds maximum allowed (%d)" -msgstr "" - -#: cobc/parser.y:2106 cobc/tree.c:4355 -#, c-format -msgid "RECORD size exceeds maximum allowed (%d)" -msgstr "" - -#: cobc/parser.y:2111 -msgid "RECORD clause invalid" -msgstr "" - -#: cobc/parser.y:3188 -msgid "multiple PROGRAM-ID's without matching END PROGRAM" -msgstr "" - -#: cobc/parser.y:3191 -msgid "executable requested but no program found" -msgstr "" - -#: cobc/parser.y:3408 cobc/parser.y:3417 -msgid "COMMON may only be used in a contained program" -msgstr "" - -#: cobc/parser.y:3426 cobc/parser.y:3458 -msgid "CALL prototypes" -msgstr "" - -#: cobc/parser.y:3607 cobc/parser.y:3884 cobc/parser.y:3928 cobc/parser.y:4036 -#: cobc/parser.y:4223 cobc/parser.y:4319 cobc/parser.y:4360 cobc/parser.y:4431 -#: cobc/parser.y:4452 cobc/parser.y:4531 cobc/parser.y:4550 cobc/parser.y:4566 -#: cobc/parser.y:4584 cobc/parser.y:4602 cobc/parser.y:4619 cobc/parser.y:4637 -#: cobc/parser.y:6868 cobc/parser.y:7694 -#, c-format -msgid "%s not allowed in nested programs" -msgstr "" - -#: cobc/parser.y:3761 -msgid "segment-number must be in range of values 1 to 49" -msgstr "" - -#: cobc/parser.y:3773 -msgid "duplicate CLASSIFICATION clause" -msgstr "" - -#: cobc/parser.y:3849 -msgid "PROGRAM phrase" -msgstr "" - -#: cobc/parser.y:3944 cobc/parser.y:3955 cobc/parser.y:4271 -#, c-format -msgid "invalid %s clause" -msgstr "" - -#: cobc/parser.y:4386 cobc/parser.y:4390 -msgid "CLASS literal with THRU must have size 1" -msgstr "" - -#: cobc/parser.y:4417 -msgid "CLASS IS integer IN alphabet-name" -msgstr "" - -#: cobc/parser.y:4464 -msgid "separate currency symbol and currency string" -msgstr "" - -#: cobc/parser.y:4497 -#, c-format -msgid "invalid CURRENCY SIGN '%s'" -msgstr "" - -#: cobc/parser.y:4715 -msgid "cannot use RELATIVE KEY clause on INDEXED files" -msgstr "" - -#: cobc/parser.y:4719 -msgid "cannot use RECORD KEY clause on RELATIVE files" -msgstr "" - -#: cobc/parser.y:4793 -msgid "EXTERNAL/DYNAMIC cannot be used with literals" -msgstr "" - -#: cobc/parser.y:4813 -msgid "EXTERNAL/DYNAMIC cannot be used with USING/VARYING" -msgstr "" - -#: cobc/parser.y:4824 -msgid "EXTERNAL/DYNAMIC cannot be used with DISK FROM" -msgstr "" - -#: cobc/parser.y:4826 -msgid "ASSIGN DISK FROM" -msgstr "" - -#: cobc/parser.y:4942 -msgid "ASSIGN EXTERNAL/DYNAMIC" -msgstr "" - -#: cobc/parser.y:5165 -#, c-format -msgid "'%s' is not an alphabet-name" -msgstr "" - -#: cobc/parser.y:5254 -#, c-format -msgid "%s only valid with ORGANIZATION %s" -msgstr "" - -#: cobc/parser.y:5321 cobc/parser.y:5344 -#, c-format -msgid "RECORD DELIMITER %s only allowed with SEQUENTIAL files" -msgstr "" - -#: cobc/parser.y:5323 cobc/parser.y:5336 cobc/parser.y:5348 cobc/parser.y:5358 -msgid "RECORD DELIMITER clause" -msgstr "" - -#: cobc/parser.y:5332 -#, c-format -msgid "RECORD DELIMITER %s only allowed with (LINE) SEQUENTIAL files" -msgstr "" - -#: cobc/parser.y:5337 -msgid "LINE-SEQUENTIAL phrase" -msgstr "" - -#: cobc/parser.y:5349 -msgid "BINARY-SEQUENTIAL phrase" -msgstr "" - -#: cobc/parser.y:5357 -msgid "RECORD DELIMITER clause only allowed with (LINE) SEQUENTIAL files" -msgstr "" - -#: cobc/parser.y:5360 -#, c-format -msgid "RECORD DELIMITER %s not recognized; will be ignored" -msgstr "" - -#: cobc/parser.y:5398 -msgid "DUPLICATES for primary keys" -msgstr "" - -#: cobc/parser.y:5637 -msgid "DOS/VS APPLY phrase" -msgstr "" - -#: cobc/parser.y:5752 -msgid "RECORD description missing or invalid" -msgstr "" - -#: cobc/parser.y:5778 -#, c-format -msgid "duplicate file description for %s" -msgstr "" - -#: cobc/parser.y:5811 cobc/parser.y:5821 -msgid "file cannot have both EXTERNAL and GLOBAL clauses" -msgstr "" - -#: cobc/parser.y:5825 cobc/parser.y:6414 cobc/parser.y:6853 cobc/parser.y:12363 -#: cobc/parser.y:15305 -#, c-format -msgid "%s is invalid in a user FUNCTION" -msgstr "" - -#: cobc/parser.y:5863 cobc/parser.y:5872 -msgid "RECORD clause ignored for LINE SEQUENTIAL" -msgstr "" - -#: cobc/parser.y:5964 -msgid "LINAGE clause with wrong file type" -msgstr "" - -#: cobc/parser.y:6026 -msgid "RECORDING MODE U or S can only be used with RECORD SEQUENTIAL files" -msgstr "" - -#: cobc/parser.y:6059 -#, c-format -msgid "ignoring CODE-SET '%s'" -msgstr "" - -#: cobc/parser.y:6070 -msgid "CODE-SET clause invalid for file type" -msgstr "" - -#: cobc/parser.y:6092 -msgid "REPORT clause with wrong file type" -msgstr "" - -#: cobc/parser.y:6170 -msgid "CD record missing" -msgstr "" - -#: cobc/parser.y:6601 -msgid "CONSTANT item not at 01 level" -msgstr "" - -#: cobc/parser.y:6721 -msgid "REDEFINES clause not following entry-name" -msgstr "" - -#: cobc/parser.y:6743 -msgid "SAME AS clause" -msgstr "" - -#: cobc/parser.y:6750 -msgid "REPORT item cannot be used here" -msgstr "" - -#: cobc/parser.y:6757 -msgid "elementary item expected" -msgstr "" - -#: cobc/parser.y:6764 -msgid "SAME AS item may not reference itself" -msgstr "" - -#: cobc/parser.y:6771 -msgid "SAME AS item may not be subordinate to any item with USAGE clause" -msgstr "" - -#: cobc/parser.y:6773 -msgid "SAME AS item may not be subordinate to any item with SIGN clause" -msgstr "" - -#: cobc/parser.y:6801 cobc/parser.y:6855 cobc/parser.y:7567 cobc/parser.y:7650 -#: cobc/parser.y:7674 -#, c-format -msgid "%s not allowed here" -msgstr "" - -#: cobc/parser.y:6803 cobc/parser.y:6845 cobc/parser.y:7569 -#, c-format -msgid "%s only allowed at 01/77 level" -msgstr "" - -#: cobc/parser.y:6805 cobc/parser.y:6847 cobc/parser.y:7571 cobc/parser.y:7654 -#: cobc/parser.y:7676 -#, c-format -msgid "%s requires a data name" -msgstr "" - -#: cobc/parser.y:6958 -msgid "" -"a locale-format PICTURE string must only consist of '9', '.', '+', 'Z' and " -"the currency-sign" -msgstr "" - -#: cobc/parser.y:6992 cobc/typeck.c:3658 -#, c-format -msgid "'%s' is not a locale-name" -msgstr "" - -#: cobc/parser.y:7007 -#, c-format -msgid "'%s' is not a valid USAGE" -msgstr "" - -#: cobc/parser.y:7012 -#, c-format -msgid "unknown USAGE: %s" -msgstr "" - -#: cobc/parser.y:7149 -#, c-format -msgid "unknown HANDLE type: %s" -msgstr "" - -#: cobc/parser.y:7406 cobc/parser.y:7408 -msgid "INDEXED should follow ASCENDING/DESCENDING" -msgstr "" - -#: cobc/parser.y:7526 -msgid "SYNCHRONIZED clause" -msgstr "" - -#: cobc/parser.y:7529 -msgid "LEFT/RIGHT phrases in SYNCHRONIZED clause" -msgstr "" - -#: cobc/parser.y:7612 -msgid "FALSE clause only allowed for 88 level" -msgstr "" - -#: cobc/parser.y:7652 -#, c-format -msgid "%s only allowed at 01 level" -msgstr "" - -#: cobc/parser.y:7656 cobc/parser.y:7678 -#, c-format -msgid "%s and %s combination not allowed" -msgstr "" - -#: cobc/parser.y:7787 -msgid "GLOBAL is not allowed with RD" -msgstr "" - -#: cobc/parser.y:8321 -msgid "PLUS is not recommended with LEFT, RIGHT or CENTER" -msgstr "" - -#: cobc/parser.y:8323 -msgid "PLUS is not allowed with LEFT, RIGHT or CENTER" -msgstr "" - -#: cobc/parser.y:8360 cobc/parser.y:8390 -msgid "PLUS is ignored on first field of line" -msgstr "" - -#: cobc/parser.y:8398 -msgid "invalid COLUMN integer; must be > 0" -msgstr "" - -#: cobc/parser.y:8400 -msgid "COLUMN numbers should increase" -msgstr "" - -#: cobc/parser.y:8499 cobc/parser.y:8555 -msgid "INITIAL specified on non-input field" -msgstr "" - -#: cobc/parser.y:8511 cobc/parser.y:8567 -msgid "relative LINE/COLUMN clause required with OCCURS" -msgstr "" - -#: cobc/parser.y:8669 cobc/parser.y:8673 -msgid "screen positions from data-item" -msgstr "" - -#: cobc/parser.y:9498 -msgid "OCCURS screen items" -msgstr "" - -#: cobc/parser.y:9510 -msgid "GLOBAL screen items" -msgstr "" - -#: cobc/parser.y:9554 -msgid "overriding convention specified in ENTRY-CONVENTION" -msgstr "" - -#: cobc/parser.y:9566 -msgid "executable program requested but PROCEDURE/ENTRY has USING clause" -msgstr "" - -#: cobc/parser.y:9636 cobc/parser.y:9653 cobc/parser.y:11184 -#, c-format -msgid "number of arguments exceeds maximum %d" -msgstr "" - -#: cobc/parser.y:9645 -msgid "CHAINING invalid in user FUNCTION" -msgstr "" - -#: cobc/parser.y:9692 cobc/parser.y:11261 cobc/parser.y:11270 -#, c-format -msgid "%s not allowed in CHAINED programs" -msgstr "" - -#: cobc/parser.y:9704 cobc/parser.y:9712 cobc/parser.y:9720 cobc/parser.y:9741 -msgid "SIZE only allowed for BY VALUE items" -msgstr "" - -#: cobc/parser.y:9743 cobc/parser.y:9760 -msgid "invalid value for SIZE" -msgstr "" - -#: cobc/parser.y:9775 -msgid "MEMORY SIZE phrase in CALL statement" -msgstr "" - -#: cobc/parser.y:9787 -msgid "OPTIONAL only allowed for BY REFERENCE items" -msgstr "" - -#: cobc/parser.y:9799 -msgid "RETURNING clause is required for a FUNCTION" -msgstr "" - -#: cobc/parser.y:9805 -msgid "RETURNING clause cannot be OMITTED for main program" -msgstr "" - -#: cobc/parser.y:9808 -msgid "RETURNING clause cannot be OMITTED for a FUNCTION" -msgstr "" - -#: cobc/parser.y:9821 -msgid "RETURNING item is not defined in LINKAGE SECTION" -msgstr "" - -#: cobc/parser.y:9823 -msgid "RETURNING item must have level 01" -msgstr "" - -#: cobc/parser.y:9825 -msgid "RETURNING item should not have OCCURS" -msgstr "" - -#: cobc/parser.y:9829 -msgid "function RETURNING item may not be ANY LENGTH" -msgstr "" - -#: cobc/parser.y:10017 -#, c-format -msgid "'%s' is not a statement" -msgstr "" - -#: cobc/parser.y:10019 -#, c-format -msgid "unknown statement '%s'; it may exist in another dialect" -msgstr "" - -#: cobc/parser.y:10022 -#, c-format -msgid "unknown statement '%s'" -msgstr "" - -#: cobc/parser.y:10039 -msgid "section segments" -msgstr "" - -#: cobc/parser.y:10041 -msgid "SECTION segment-number must be less than or equal to 99" -msgstr "" - -#: cobc/parser.y:10044 -msgid "SECTION segment-number in DECLARATIVES must be less than 50" -msgstr "" - -#: cobc/parser.y:10052 -msgid "SECTION segment within DECLARATIVES" -msgstr "" - -#: cobc/parser.y:10240 cobc/parser.y:10375 -msgid "non-standard ACCEPT" -msgstr "" - -#: cobc/parser.y:10252 -msgid "PROMPT clause" -msgstr "" - -#: cobc/parser.y:10256 -msgid "SIZE IS clause" -msgstr "" - -#: cobc/parser.y:10471 cobc/parser.y:10763 -msgid "TIME-OUT or BEFORE TIME clauses" -msgstr "" - -#: cobc/parser.y:10497 cobc/parser.y:10513 cobc/parser.y:10528 -msgid "AT screen-location" -msgstr "" - -#: cobc/parser.y:10529 -msgid "LINE or COLUMN" -msgstr "" - -#: cobc/parser.y:10893 -msgid "ALLOCATE CHARACTERS requires RETURNING clause" -msgstr "" - -#: cobc/parser.y:10908 cobc/parser.y:12168 -#, c-format -msgid "ignoring %s phrase" -msgstr "" - -#: cobc/parser.y:10910 -msgid "addressing mode should be either 24 or 31 bit" -msgstr "" - -#: cobc/parser.y:10982 -msgid "recursive program call - assuming RECURSIVE attribute" -msgstr "" - -#: cobc/parser.y:11001 -msgid "STATIC CALL convention ignored because of ON EXCEPTION" -msgstr "" - -#: cobc/parser.y:11010 -msgid "ON EXCEPTION ignored because of STATIC CALL" -msgstr "" - -#: cobc/parser.y:11111 cobc/typeck.c:12209 -msgid "invalid mnemonic name" -msgstr "" - -#: cobc/parser.y:11131 cobc/parser.y:11428 -msgid "CALL/CANCEL with program-prototype-name" -msgstr "" - -#: cobc/parser.y:11135 -msgid "id/literal ignored, using prototype name" -msgstr "" - -#: cobc/parser.y:11141 -msgid "NESTED phrase is only valid with literal" -msgstr "" - -#: cobc/parser.y:11202 -msgid "OMITTED only allowed when arguments are passed BY REFERENCE" -msgstr "" - -#: cobc/parser.y:11226 -msgid "invalid file name reference" -msgstr "" - -#: cobc/parser.y:11234 -#, c-format -msgid "BY CONTENT assumed for alphanumeric item '%s'" -msgstr "" - -#: cobc/parser.y:11239 -#, c-format -msgid "BY CONTENT assumed for national item '%s'" -msgstr "" - -#: cobc/parser.y:11302 -msgid "RETURNING item must have level 01 or 77" -msgstr "" - -#: cobc/parser.y:11306 -msgid "RETURNING item must be a LINKAGE SECTION item or have BASED clause" -msgstr "" - -#: cobc/parser.y:11340 cobc/parser.y:15972 cobc/parser.y:16027 -#: cobc/parser.y:16071 cobc/parser.y:16115 -msgid "NOT EXCEPTION before EXCEPTION" -msgstr "" - -#: cobc/parser.y:12041 -#, c-format -msgid "HANDLE must be a %s HANDLE" -msgstr "" - -#: cobc/parser.y:12053 -msgid "HANDLE must be a generic HANDLE" -msgstr "" - -#: cobc/parser.y:12130 -#, c-format -msgid "HANDLE clause invalid for %s" -msgstr "" - -#: cobc/parser.y:12361 cobc/parser.y:15495 -#, c-format -msgid "%s is invalid in nested program" -msgstr "" - -#: cobc/parser.y:12399 cobc/parser.y:12440 cobc/parser.y:12451 -#: cobc/parser.y:12462 -#, c-format -msgid "maximum evaluate depth exceeded (%d)" -msgstr "" - -#: cobc/parser.y:12503 cobc/parser.y:12513 -msgid "WHEN without imperative statement" -msgstr "" - -#: cobc/parser.y:12531 cobc/parser.y:12541 -msgid "WHEN OTHER without imperative statement" -msgstr "" - -#: cobc/parser.y:12621 -msgid "invalid THROUGH usage" -msgstr "" - -#: cobc/parser.y:12700 -msgid "EXIT PROGRAM is not allowed within a USE GLOBAL procedure" -msgstr "" - -#: cobc/parser.y:12704 -msgid "EXIT PROGRAM not allowed within a FUNCTION" -msgstr "" - -#: cobc/parser.y:12713 cobc/parser.y:12926 -msgid "RETURNING/GIVING not allowed for non-returning runtime elements" -msgstr "" - -#: cobc/parser.y:12725 -msgid "EXIT FUNCTION is not allowed within a USE GLOBAL procedure" -msgstr "" - -#: cobc/parser.y:12729 -msgid "EXIT FUNCTION only allowed within a FUNCTION" -msgstr "" - -#: cobc/parser.y:12743 cobc/parser.y:12766 -msgid "EXIT PERFORM is only valid with inline PERFORM" -msgstr "" - -#: cobc/parser.y:12788 -msgid "EXIT SECTION is only valid with an active SECTION" -msgstr "" - -#: cobc/parser.y:12809 -msgid "EXIT PARAGRAPH is only valid with an active PARAGRAPH" -msgstr "" - -#: cobc/parser.y:12956 -msgid "IF without imperative statement" -msgstr "" - -#: cobc/parser.y:13173 -msgid "TALLYING clause is incomplete" -msgstr "" - -#: cobc/parser.y:13289 -msgid "INSPECT missing ALL/FIRST/LEADING/TRAILING" -msgstr "" - -#: cobc/parser.y:13407 -msgid "JSON PARSE" -msgstr "" - -#: cobc/parser.y:13552 -msgid "LOCK clauses" -msgstr "" - -#: cobc/parser.y:13717 -msgid "inline PERFORM without imperative statement" -msgstr "" - -#: cobc/parser.y:13838 cobc/parser.y:13846 cobc/parser.y:13854 -#, c-format -msgid "PERFORM VARYING '%s' (line %d of %s) is not a numeric field" -msgstr "" - -#: cobc/parser.y:13870 -msgid "PERFORM VARYING without BY phrase" -msgstr "" - -#: cobc/parser.y:13910 -#, c-format -msgid "'%s' is not an object-reference" -msgstr "" - -#: cobc/parser.y:13951 cobc/typeck.c:10958 cobc/typeck.c:12100 -msgid "LOCK clause invalid with file LOCK AUTOMATIC" -msgstr "" - -#: cobc/parser.y:13956 -msgid "KEY clause invalid with this file type" -msgstr "" - -#: cobc/parser.y:13961 cobc/typeck.c:10954 cobc/typeck.c:12096 -msgid "INVALID KEY clause invalid with this file type" -msgstr "" - -#: cobc/parser.y:14591 -msgid "file sort requires KEY phrase" -msgstr "" - -#: cobc/parser.y:14615 -msgid "table SORT requires KEY phrase" -msgstr "" - -#: cobc/parser.y:14677 -msgid "file sort requires USING or INPUT PROCEDURE" -msgstr "" - -#: cobc/parser.y:14684 -msgid "USING invalid with table SORT" -msgstr "" - -#: cobc/parser.y:14694 -msgid "INPUT PROCEDURE invalid with table SORT" -msgstr "" - -#: cobc/parser.y:14696 -msgid "INPUT PROCEDURE invalid with MERGE" -msgstr "" - -#: cobc/parser.y:14709 -msgid "file sort requires GIVING or OUTPUT PROCEDURE" -msgstr "" - -#: cobc/parser.y:14716 -msgid "GIVING invalid with table SORT" -msgstr "" - -#: cobc/parser.y:14726 -msgid "OUTPUT PROCEDURE invalid with table SORT" -msgstr "" - -#: cobc/parser.y:14753 -msgid "SIZE/LENGTH invalid here" -msgstr "" - -#: cobc/parser.y:14806 -msgid "NOT EQUAL condition not allowed on START statement" -msgstr "" - -#: cobc/parser.y:14872 -#, c-format -msgid "%s is replaced by %s" -msgstr "" - -#: cobc/parser.y:14925 -msgid "STOP literal" -msgstr "" - -#: cobc/parser.y:14929 -msgid "STOP identifier" -msgstr "" - -#: cobc/parser.y:15066 -msgid "SUPPRESS statement must be within DECLARATIVES" -msgstr "" - -#: cobc/parser.y:15140 -msgid "UNLOCK invalid for SORT files" -msgstr "" - -#: cobc/parser.y:15276 cobc/parser.y:15355 -msgid "USE statement must be within DECLARATIVES" -msgstr "" - -#: cobc/parser.y:15278 -msgid "SECTION header missing before USE statement" -msgstr "" - -#: cobc/parser.y:15357 -msgid "USE DEBUGGING not supported in contained program" -msgstr "" - -#: cobc/parser.y:15405 cobc/parser.y:15414 cobc/parser.y:15432 -#: cobc/parser.y:15468 cobc/typeck.c:3792 -#, c-format -msgid "duplicate DEBUGGING target: '%s'" -msgstr "" - -#: cobc/parser.y:15430 -msgid "constant item cannot be used here" -msgstr "" - -#: cobc/parser.y:15456 -msgid "duplicate USE DEBUGGING ON ALL PROCEDURES" -msgstr "" - -#: cobc/parser.y:15528 -#, c-format -msgid "'%s' is not a report group" -msgstr "" - -#: cobc/parser.y:15710 -msgid "ENCODING clause must come before XML-DECLARATION" -msgstr "" - -#: cobc/parser.y:15712 -msgid "ENCODING clause must come before ATTRIBUTES" -msgstr "" - -#: cobc/parser.y:15715 -msgid "XML GENERATE ENCODING clause" -msgstr "" - -#: cobc/parser.y:15722 -msgid "XML-DECLARATION clause must come before ATTRIBUTES" -msgstr "" - -#: cobc/parser.y:15725 -msgid "XML GENERATE XML-DECLARATION clause" -msgstr "" - -#: cobc/parser.y:15731 -msgid "XML GENERATE WITH ATTRIBUTES clause" -msgstr "" - -#: cobc/parser.y:15744 -msgid "XML GENERATE NAMESPACE clause" -msgstr "" - -#: cobc/parser.y:15768 -msgid "XML GENERATE NAME OF clause" -msgstr "" - -#: cobc/parser.y:15799 -msgid "XML GENERATE TYPE OF clause" -msgstr "" - -#: cobc/parser.y:15840 -msgid "XML GENERATE SUPPRESS clause" -msgstr "" - -#: cobc/parser.y:15914 -msgid "XML PARSE" -msgstr "" - -#: cobc/parser.y:15955 cobc/parser.y:16633 cobc/parser.y:16729 -#: cobc/parser.y:16815 -#, c-format -msgid "'%s' is not a file name" -msgstr "" - -#: cobc/parser.y:16161 -msgid "NOT SIZE ERROR before SIZE ERROR" -msgstr "" - -#: cobc/parser.y:16207 -msgid "NOT OVERFLOW before OVERFLOW" -msgstr "" - -#: cobc/parser.y:16306 -msgid "NOT AT END-OF-PAGE before AT END-OF-PAGE" -msgstr "" - -#: cobc/parser.y:16356 -msgid "NOT INVALID KEY before INVALID KEY" -msgstr "" - -#: cobc/parser.y:16619 -msgid "LINAGE-COUNTER must be qualified here" -msgstr "" - -#: cobc/parser.y:16622 -msgid "invalid LINAGE-COUNTER usage" -msgstr "" - -#: cobc/parser.y:16643 -msgid "LINE-COUNTER must be qualified here" -msgstr "" - -#: cobc/parser.y:16647 -msgid "invalid LINE-COUNTER usage" -msgstr "" - -#: cobc/parser.y:16658 cobc/parser.y:16683 -#, c-format -msgid "'%s' is not a report name" -msgstr "" - -#: cobc/parser.y:16668 -msgid "PAGE-COUNTER must be qualified here" -msgstr "" - -#: cobc/parser.y:16672 -msgid "invalid PAGE-COUNTER usage" -msgstr "" - -#: cobc/parser.y:16719 cobc/typeck.c:10919 cobc/typeck.c:11004 -#: cobc/typeck.c:12064 -#, c-format -msgid "%s requires a record name as subject" -msgstr "" - -#: cobc/parser.y:16746 -#, c-format -msgid "'%s' not indexed" -msgstr "" - -#: cobc/parser.y:16772 cobc/parser.y:16797 -#, c-format -msgid "multiple reference to '%s' " -msgstr "" - -#: cobc/parser.y:16827 -#, c-format -msgid "'%s' is not a CD name" -msgstr "" - -#: cobc/parser.y:16841 -#, c-format -msgid "'%s' is not a valid report name" -msgstr "" - -#: cobc/parser.y:17092 -msgid "invalid mnemonic identifier" -msgstr "" - -#: cobc/parser.y:17172 -msgid "a numeric literal is expected here" -msgstr "" - -#: cobc/parser.y:17184 cobc/parser.y:17886 -msgid "a non-numeric literal is expected here" -msgstr "" - -#: cobc/parser.y:17357 cobc/typeck.c:6116 cobc/typeck.c:6123 -#, c-format -msgid "'%s' is not numeric" -msgstr "" - -#: cobc/parser.y:17373 -#, c-format -msgid "'%s' is not a field or file" -msgstr "" - -#: cobc/parser.y:17393 cobc/parser.y:17411 -#, c-format -msgid "'%s' is not a field" -msgstr "" - -#: cobc/parser.y:17533 -#, c-format -msgid "'%s' is not a field or alphabet" -msgstr "" - -#: cobc/parser.y:17559 -msgid "a subscripted data-item cannot be used here" -msgstr "" - -#: cobc/parser.y:17609 -msgid "unsigned integer value expected" -msgstr "" - -#: cobc/parser.y:17621 cobc/parser.y:17625 cobc/parser.y:17675 -msgid "integer value expected" -msgstr "" - -#: cobc/parser.y:17630 -msgid "invalid symbolic integer" -msgstr "" - -#: cobc/parser.y:17646 cobc/parser.y:17650 -msgid "unsigned positive integer value expected" -msgstr "" - -#: cobc/parser.y:17679 -msgid "invalid CLASS value" -msgstr "" - -#: cobc/parser.y:17767 -msgid "PHYSICAL argument for LENGTH functions" -msgstr "" - -#: cobc/parser.y:17938 cobc/parser.y:17955 -msgid "cannot specify offset and SYSTEM-OFFSET at the same time" -msgstr "" - -#: cobc/pplex.l:223 cobc/pplex.l:1739 -msgid "debugging indicator" -msgstr "" - -#: cobc/pplex.l:300 -msgid "ignoring empty directive" -msgstr "" - -#: cobc/pplex.l:310 cobc/pplex.l:369 -#, c-format -msgid "ignoring invalid directive: '%s'" -msgstr "" - -#: cobc/pplex.l:317 -msgid "ignoring invalid directive" -msgstr "" - -#: cobc/pplex.l:324 -msgid "VCS directive" -msgstr "" - -#: cobc/pplex.l:377 cobc/pplex.l:392 -msgid "spurious '$' detected - ignored" -msgstr "" - -#: cobc/pplex.l:386 -#, c-format -msgid "ignoring unknown directive: '%s'" -msgstr "" - -#: cobc/pplex.l:398 -msgid "PROCESS statement ignored" -msgstr "" - -#: cobc/pplex.l:864 -msgid "IF/ELIF/ELSE directive without matching END-IF" -msgstr "" - -#: cobc/pplex.l:981 -msgid "file was included here" -msgstr "" - -#: cobc/pplex.l:1186 -#, c-format -msgid "directive nest depth exceeded: %d" -msgstr "" - -#: cobc/pplex.l:1204 -msgid "ELSE directive without matching IF/ELIF" -msgstr "" - -#: cobc/pplex.l:1220 -msgid "END-IF directive without matching IF/ELIF/ELSE" -msgstr "" - -#: cobc/pplex.l:1236 -msgid "ELIF directive without matching IF/ELIF" -msgstr "" - -#: cobc/pplex.l:1258 -#, c-format -msgid "invalid internal case: %u" -msgstr "" - -#: cobc/pplex.l:1395 -msgid "buffer overrun - too many continuation lines" -msgstr "" - -#: cobc/pplex.l:1485 cobc/pplex.l:1494 -msgid "line not terminated by a newline" -msgstr "" - -#: cobc/pplex.l:1488 cobc/pplex.l:1497 -#, c-format -msgid "source text exceeds %d bytes, will be truncated" -msgstr "" - -#: cobc/pplex.l:1516 -msgid "version control conflict marker in file" -msgstr "" - -#: cobc/pplex.l:1727 -msgid "invalid continuation in comment entry" -msgstr "" - -#: cobc/pplex.l:1732 -msgid "continuation of COBOL words" -msgstr "" - -#: cobc/pplex.l:1752 -#, c-format -msgid "invalid indicator '%c' at column 7" -msgstr "" - -#: cobc/pplex.l:1800 cobc/pplex.l:1811 -msgid "invalid line continuation" -msgstr "" - -#: cobc/pplex.l:1819 -msgid "continuation character expected" -msgstr "" - -#: cobc/pplex.l:1885 -#, c-format -msgid "source text after program-text area (column %d)" -msgstr "" - -#: cobc/ppparse.y:225 -msgid "directive comparison on different types" -msgstr "" - -#: cobc/ppparse.y:293 -#, c-format -msgid "duplicate DEFINE directive '%s'" -msgstr "" - -#: cobc/ppparse.y:300 cobc/ppparse.y:310 -msgid "invalid constant in DEFINE directive" -msgstr "" - -#: cobc/ppparse.y:408 -#, c-format -msgid "compiler flag '%s' unknown" -msgstr "" - -#: cobc/ppparse.y:454 -#, c-format -msgid "invalid %s directive option '%s'" -msgstr "" - -#: cobc/ppparse.y:667 -msgid "*CONTROL statement" -msgstr "" - -#: cobc/ppparse.y:933 cobc/ppparse.y:1004 cobc/ppparse.y:1141 -#, c-format -msgid "invalid %s directive" -msgstr "" - -#: cobc/ppparse.y:1043 -msgid "LEAP-SECOND ON directive" -msgstr "" - -#: cobc/ppparse.y:1051 -msgid "TURN directive" -msgstr "" - -#: cobc/ppparse.y:1133 cobc/ppparse.y:1158 -msgid "invalid constant" -msgstr "" - -#: cobc/reserved.c:3797 -msgid "device name" -msgstr "" - -#: cobc/reserved.c:3800 -msgid "switch name" -msgstr "" - -#: cobc/reserved.c:3803 -msgid "feature name" -msgstr "" - -#: cobc/reserved.c:3902 -#, c-format -msgid "reserved word must have less than %d characters" -msgstr "" - -#: cobc/reserved.c:3921 -msgid "ignored asterisk at end of alias target" -msgstr "" - -#: cobc/reserved.c:3984 -#, c-format -msgid "alias target '%s' is not a default reserved word" -msgstr "" - -#: cobc/reserved.c:4447 -#, c-format -msgid "invalid system-name '%s'" -msgstr "" - -#: cobc/reserved.c:4584 -#, c-format -msgid "'%s' is a reserved word, but isn't supported" -msgstr "" - -#: cobc/reserved.c:4689 -#, c-format -msgid "intrinsic function %s is unknown" -msgstr "" - -#: cobc/reserved.c:4717 -msgid "Intrinsic Function" -msgstr "" - -#: cobc/reserved.c:4717 cobc/reserved.c:4897 cobc/reserved.c:5034 -msgid "Implemented" -msgstr "" - -#: cobc/reserved.c:4717 cobc/typeck.c:1022 -msgid "Parameters" -msgstr "" - -#: cobc/reserved.c:4721 cobc/reserved.c:4901 cobc/reserved.c:5048 -msgid "Yes" -msgstr "" - -#: cobc/reserved.c:4724 cobc/reserved.c:4904 cobc/reserved.c:5054 -msgid "No" -msgstr "" - -#: cobc/reserved.c:4730 -msgid "Unlimited" -msgstr "" - -#: cobc/reserved.c:4804 -#, c-format -msgid "special register %s is unknown, needs a definition" -msgstr "" - -#: cobc/reserved.c:4810 -#, c-format -msgid "special register %s is unknown" -msgstr "" - -#: cobc/reserved.c:4897 -msgid "Internal registers" -msgstr "" - -#: cobc/reserved.c:4897 -msgid "Definition" -msgstr "" - -#: cobc/reserved.c:4985 -#, c-format -msgid "unknown system-name '%s'" -msgstr "" - -#: cobc/reserved.c:5011 -msgid "System names" -msgstr "" - -#: cobc/reserved.c:5034 -msgid "Reserved Words" -msgstr "" - -#: cobc/reserved.c:5046 -msgid "Yes (Context sensitive)" -msgstr "" - -#: cobc/reserved.c:5052 -msgid "No (Context sensitive)" -msgstr "" - -#: cobc/reserved.c:5081 -msgid "Extra (obsolete) context sensitive words" -msgstr "" - -#: cobc/scanner.l:265 cobc/scanner.l:2288 -#, c-format -msgid "'%s' is not a default reserved word, so cannot be aliased" -msgstr "" - -#: cobc/scanner.l:268 -#, c-format -msgid "'%s' is not a reserved word; you may want ADDSYN or OVERRIDE instead" -msgstr "" - -#: cobc/scanner.l:988 -#, c-format -msgid "a constant may not be used here - '%s'" -msgstr "" - -#: cobc/scanner.l:1043 -msgid "ignoring redundant ." -msgstr "" - -#: cobc/scanner.l:1101 -#, c-format -msgid "invalid symbol '%s' - skipping word" -msgstr "" - -#: cobc/scanner.l:1191 -msgid "invalid national literal" -msgstr "" - -#: cobc/scanner.l:1202 cobc/tree.c:2531 -#, c-format -msgid "invalid literal: '%s'" -msgstr "" - -#: cobc/scanner.l:1204 -#, c-format -msgid "invalid hexadecimal literal: '%s'" -msgstr "" - -#: cobc/scanner.l:1206 cobc/tree.c:1613 -#, c-format -msgid "invalid numeric literal: '%s'" -msgstr "" - -#: cobc/scanner.l:1208 -#, c-format -msgid "invalid floating-point literal: '%s'" -msgstr "" - -#: cobc/scanner.l:1210 -#, c-format -msgid "invalid %s literal: '%s'" -msgstr "" - -#: cobc/scanner.l:1261 -#, c-format -msgid "literal length exceeds %d characters" -msgstr "" - -#: cobc/scanner.l:1277 cobc/scanner.l:1326 cobc/scanner.l:1620 -msgid "zero-length literal" -msgstr "" - -#: cobc/scanner.l:1280 -msgid "national literal has zero length; a SPACE will be assumed" -msgstr "" - -#: cobc/scanner.l:1281 -msgid "alphanumeric literal has zero length; a SPACE will be assumed" -msgstr "" - -#: cobc/scanner.l:1293 cobc/scanner.l:1294 cobc/scanner.l:1298 -#: cobc/scanner.l:1365 -msgid "national literal" -msgstr "" - -#: cobc/scanner.l:1297 -msgid "national-character literal" -msgstr "" - -#: cobc/scanner.l:1330 -msgid "hexadecimal literal has zero length; X'00' will be assumed" -msgstr "" - -#: cobc/scanner.l:1349 -msgid "hexadecimal-boolean literal" -msgstr "" - -#: cobc/scanner.l:1356 cobc/scanner.l:1370 cobc/scanner.l:1485 -#: cobc/scanner.l:1544 cobc/scanner.l:1642 cobc/scanner.l:1711 cobc/tree.c:2532 -#, c-format -msgid "literal length %d exceeds %d characters" -msgstr "" - -#: cobc/scanner.l:1362 -msgid "hexadecimal-national literal" -msgstr "" - -#: cobc/scanner.l:1393 cobc/scanner.l:1425 cobc/scanner.l:1560 -#: cobc/scanner.l:1656 cobc/scanner.l:1721 -#, c-format -msgid "literal contains invalid character '%c'" -msgstr "" - -#: cobc/scanner.l:1449 -#, c-format -msgid "literal does not have an even number of digits" -msgstr "" - -#: cobc/scanner.l:1492 -#, c-format -msgid "%s literals must contain at least one character" -msgstr "" - -#: cobc/scanner.l:1527 cobc/scanner.l:1628 cobc/scanner.l:1702 -msgid "ACUCOBOL numeric literal" -msgstr "" - -#: cobc/scanner.l:1537 -msgid "H literals must contain at least one character" -msgstr "" - -#: cobc/scanner.l:1575 cobc/scanner.l:1667 cobc/scanner.l:1732 -#, c-format -msgid "literal exceeds limit %u" -msgstr "" - -#: cobc/scanner.l:1616 -msgid "numeric boolean literal" -msgstr "" - -#: cobc/scanner.l:1622 -msgid "Boolean literal has zero length; B'0' will be assumed" -msgstr "" - -#: cobc/scanner.l:1698 -msgid "HP COBOL octal literal" -msgstr "" - -#: cobc/scanner.l:1810 cobc/tree.c:1624 -#, c-format -msgid "literal length %d exceeds maximum of %d digits" -msgstr "" - -#: cobc/scanner.l:1816 cobc/tree.c:1629 -#, c-format -msgid "literal length %d exceeds %d digits" -msgstr "" - -#: cobc/scanner.l:1928 cobc/tree.c:3513 -#, c-format -msgid "significand has more than %d digits" -msgstr "" - -#: cobc/scanner.l:1933 -#, c-format -msgid "exponent has decimal point" -msgstr "" - -#: cobc/scanner.l:1939 cobc/tree.c:3521 -#, c-format -msgid "exponent has more than 4 digits" -msgstr "" - -#: cobc/scanner.l:1969 -#, c-format -msgid "exponent not between -6143 and 6144" -msgstr "" - -#: cobc/scanner.l:1978 -#, c-format -msgid "significand of 0 must be positive" -msgstr "" - -#: cobc/scanner.l:1983 -#, c-format -msgid "exponent of 0 must be 0" -msgstr "" - -#: cobc/scanner.l:1988 -#, c-format -msgid "exponent of 0 must be positive" -msgstr "" - -#: cobc/scanner.l:2170 -#, c-format -msgid "invalid CONSTANT: %s" -msgstr "" - -#: cobc/scanner.l:2180 -#, c-format -msgid "invalid alphanumeric CONSTANT: %s" -msgstr "" - -#: cobc/scanner.l:2184 -#, c-format -msgid "empty alphanumeric CONSTANT: %s" -msgstr "" - -#: cobc/scanner.l:2201 cobc/scanner.l:2209 cobc/scanner.l:2214 -#, c-format -msgid "invalid numeric CONSTANT: %s" -msgstr "" - -#: cobc/scanner.l:2291 -#, c-format -msgid "'%s' is already reserved; you may want MAKESYN instead" -msgstr "" - -#: cobc/tree.c:341 -#, c-format -msgid "%s clause is required for file '%s'" -msgstr "" - -#: cobc/tree.c:345 -#, c-format -msgid "%s clause is invalid for file '%s' (file type)" -msgstr "" - -#: cobc/tree.c:349 -#, c-format -msgid "%s clause is invalid for file '%s'" -msgstr "" - -#: cobc/tree.c:376 -#, c-format -msgid "FOR item '%s' is a record" -msgstr "" - -#: cobc/tree.c:385 -#, c-format -msgid "FOR item '%s' is in different record to '%s'" -msgstr "" - -#: cobc/tree.c:394 -#, c-format -msgid "FOR item '%s' is not in a record associated with '%s'" -msgstr "" - -#: cobc/tree.c:477 -msgid "internal error node" -msgstr "" - -#: cobc/tree.c:479 -msgid "unknown constant" -msgstr "" - -#: cobc/tree.c:639 -#, c-format -msgid "FUNCTION %s has invalid/not supported arguments - tag %d" -msgstr "" - -#: cobc/tree.c:760 -#, c-format -msgid "invalid date/time function: '%d'" -msgstr "" - -#: cobc/tree.c:798 -#, c-format -msgid "FUNCTION '%s' has invalid date/time format" -msgstr "" - -#: cobc/tree.c:805 -#, c-format -msgid "FUNCTION '%s' has format in variable" -msgstr "" - -#: cobc/tree.c:1186 -#, c-format -msgid "literal '%s'" -msgstr "" - -#: cobc/tree.c:1315 -#, c-format -msgid "unknown tree tag: %d, category: %d" -msgstr "" - -#: cobc/tree.c:1405 -#, c-format -msgid "unexpected numeric USAGE: %d" -msgstr "" - -#: cobc/tree.c:1419 -#, c-format -msgid "unexpected category: %d" -msgstr "" - -#: cobc/tree.c:1678 cobc/tree.c:1690 cobc/tree.c:1752 cobc/tree.c:1802 -#, c-format -msgid "numeric literal '%s' exceeds limit '%s'" -msgstr "" - -#: cobc/tree.c:2387 -msgid "invalid LOCALE literal" -msgstr "" - -#: cobc/tree.c:2512 -msgid "only literals with the same category can be concatenated" -msgstr "" - -#: cobc/tree.c:2519 -msgid "only alphanumeric, national or boolean literals may be concatenated" -msgstr "" - -#: cobc/tree.c:2791 -msgid "B, 0 or /" -msgstr "" - -#: cobc/tree.c:2805 -msgid "the sign of the floating-point exponent" -msgstr "" - -#: cobc/tree.c:2807 -msgid "a leading +/- sign" -msgstr "" - -#: cobc/tree.c:2809 -msgid "a trailing +/- sign" -msgstr "" - -#: cobc/tree.c:2811 -msgid "CR or DB" -msgstr "" - -#: cobc/tree.c:2813 -msgid "a leading currency symbol" -msgstr "" - -#: cobc/tree.c:2815 -msgid "a trailing currency symbol" -msgstr "" - -#: cobc/tree.c:2817 -msgid "a Z or * which is before the decimal point" -msgstr "" - -#: cobc/tree.c:2819 -msgid "a Z or * which is after the decimal point" -msgstr "" - -#: cobc/tree.c:2821 -msgid "a floating +/- string which is before the decimal point" -msgstr "" - -#: cobc/tree.c:2823 -msgid "a floating +/- string which is after the decimal point" -msgstr "" - -#: cobc/tree.c:2825 -msgid "a floating currency symbol string which is before the decimal point" -msgstr "" - -#: cobc/tree.c:2827 -msgid "a floating currency symbol string which is after the decimal point" -msgstr "" - -#: cobc/tree.c:2831 -msgid "A or X" -msgstr "" - -#: cobc/tree.c:2837 -msgid "a P which is before the decimal point" -msgstr "" - -#: cobc/tree.c:2839 -msgid "a P which is after the decimal point" -msgstr "" - -#: cobc/tree.c:2860 cobc/tree.c:3267 -#, c-format -msgid "%s may only occur once in a PICTURE string" -msgstr "" - -#: cobc/tree.c:2862 cobc/tree.c:3219 -#, c-format -msgid "%s cannot follow %s" -msgstr "" - -#: cobc/tree.c:2865 -msgid "invalid PICTURE string detected" -msgstr "" - -#: cobc/tree.c:2976 -msgid "number or constant in parentheses is not an unsigned integer" -msgstr "" - -#: cobc/tree.c:2985 -msgid "only up to 9 significant digits are permitted within parentheses" -msgstr "" - -#: cobc/tree.c:2991 -msgid "number or constant in parentheses must be greater than zero" -msgstr "" - -#: cobc/tree.c:3002 -msgid "parentheses must be preceded by a picture symbol" -msgstr "" - -#: cobc/tree.c:3032 -msgid "unbalanced parentheses" -msgstr "" - -#: cobc/tree.c:3040 -msgid "parentheses must contain an unsigned integer" -msgstr "" - -#: cobc/tree.c:3078 -#, c-format -msgid "'%s' is not a constant-name" -msgstr "" - -#: cobc/tree.c:3085 -#, c-format -msgid "'%s' is not a numeric literal" -msgstr "" - -#: cobc/tree.c:3089 -#, c-format -msgid "'%s' is not an integer" -msgstr "" - -#: cobc/tree.c:3093 -#, c-format -msgid "'%s' is not unsigned" -msgstr "" - -#: cobc/tree.c:3149 -msgid "missing PICTURE string" -msgstr "" - -#: cobc/tree.c:3178 -msgid "C must be followed by R" -msgstr "" - -#: cobc/tree.c:3181 -msgid "D must be followed by B" -msgstr "" - -#: cobc/tree.c:3195 cobc/tree.c:3264 cobc/tree.c:3290 cobc/tree.c:3401 -msgid "uncommon parentheses" -msgstr "" - -#: cobc/tree.c:3219 -msgid "exponent" -msgstr "" - -#: cobc/tree.c:3272 -msgid "S must be at start of PICTURE string" -msgstr "" - -#: cobc/tree.c:3328 -msgid "P must be at start or end of PICTURE string" -msgstr "" - -#: cobc/tree.c:3358 -msgid "cannot have both Z and * in PICTURE string" -msgstr "" - -#: cobc/tree.c:3436 -#, c-format -msgid "invalid PICTURE character '%c'" -msgstr "" - -#: cobc/tree.c:3466 -#, c-format -msgid "" -"PICTURE string may not contain more than %d characters; contains %d " -"characters" -msgstr "" - -#: cobc/tree.c:3471 -msgid "" -"PICTURE string must contain at least one of the set A, N, X, Z, 1, 9 and *; " -"or at least two of the set +, - and the currency symbol" -msgstr "" - -#: cobc/tree.c:3498 -#, c-format -msgid "numeric field cannot be larger than %d digits" -msgstr "" - -#: cobc/tree.c:3954 cobc/tree.c:3967 -#, c-format -msgid "no DETAIL line defined in report %s" -msgstr "" - -#: cobc/tree.c:3969 -msgid "PAGE LIMIT FIRST DETAIL should be >= HEADING" -msgstr "" - -#: cobc/tree.c:3972 -msgid "PAGE LIMIT FOOTING should be >= HEADING" -msgstr "" - -#: cobc/tree.c:3974 -msgid "PAGE LIMIT LAST DETAIL should be >= FIRST DETAIL" -msgstr "" - -#: cobc/tree.c:3976 -msgid "PAGE LIMIT FOOTING should be >= LAST DETAIL" -msgstr "" - -#: cobc/tree.c:3978 -msgid "PAGE LIMIT LINES should be >= FOOTING" -msgstr "" - -#: cobc/tree.c:4162 -#, c-format -msgid "maximum keys (%d/%d) exceeded for file '%s'" -msgstr "" - -#: cobc/tree.c:4226 cobc/tree.c:4249 -#, c-format -msgid "invalid KEY item '%s', not in file '%s'" -msgstr "" - -#: cobc/tree.c:4260 -#, c-format -msgid "" -"minimal record length %d can not hold the key item '%s'; needs to be at " -"least %d" -msgstr "" - -#: cobc/tree.c:4296 -#, c-format -msgid "missing file description for %s" -msgstr "" - -#: cobc/tree.c:4328 -#, c-format -msgid "size of record '%s' (%d) smaller than minimum of file '%s' (%d)" -msgstr "" - -#: cobc/tree.c:4331 cobc/tree.c:4348 -msgid "file size adjusted" -msgstr "" - -#: cobc/tree.c:4343 -#, c-format -msgid "size of record '%s' (%d) larger than maximum of file '%s' (%d)" -msgstr "" - -#: cobc/tree.c:4386 -#, c-format -msgid "" -"file '%s': RECORD VARYING specified without limits, but implied limits are " -"equal" -msgstr "" - -#: cobc/tree.c:4393 -#, c-format -msgid "file '%s': record size (IDX) %d exceeds maximum allowed (%d)" -msgstr "" - -#: cobc/tree.c:4397 -#, c-format -msgid "file '%s': record size %d exceeds maximum allowed (%d)" -msgstr "" - -#: cobc/tree.c:4404 -msgid "RECORD DELIMITER clause on file with fixed-length records" -msgstr "" - -#: cobc/tree.c:4965 -#, c-format -msgid "literal '%.38s' is longer than '%s'" -msgstr "" - -#: cobc/tree.c:4969 -#, c-format -msgid "literal '%.38s' is longer than reference-modification of '%s'" -msgstr "" - -#: cobc/tree.c:4994 -#, c-format -msgid "literal '%s' is alphanumeric but '%s' is numeric" -msgstr "" - -#: cobc/tree.c:5036 -#, c-format -msgid "literal '%s' has more decimals than '%s'" -msgstr "" - -#: cobc/tree.c:5078 -#, c-format -msgid "literal '%s' has more digits than '%s'" -msgstr "" - -#: cobc/tree.c:5118 cobc/tree.c:5142 -#, c-format -msgid "unsigned '%s' may not be %s %s" -msgstr "" - -#: cobc/tree.c:5128 cobc/tree.c:5151 -#, c-format -msgid "unsigned '%s' may always be %s %s" -msgstr "" - -#: cobc/tree.c:5184 cobc/tree.c:5209 -#, c-format -msgid "'%s' may not be %s %s" -msgstr "" - -#: cobc/tree.c:5195 cobc/tree.c:5220 -#, c-format -msgid "'%s' may always be %s %s" -msgstr "" - -#: cobc/tree.c:5355 -msgid "divide by constant ZERO" -msgstr "" - -#: cobc/tree.c:5404 cobc/tree.c:5409 cobc/tree.c:5630 cobc/tree.c:5670 -#: cobc/typeck.c:4476 cobc/typeck.c:4484 cobc/typeck.c:4491 cobc/typeck.c:5561 -#: cobc/typeck.c:5706 -msgid "invalid expression" -msgstr "" - -#: cobc/tree.c:5627 -#, c-format -msgid "invalid expression: %s %s %s" -msgstr "" - -#: cobc/tree.c:5675 -#, c-format -msgid "unexpected operator: %d" -msgstr "" - -#: cobc/tree.c:5685 -#, c-format -msgid "expression '%.38s' %s '%.38s' is always TRUE" -msgstr "" - -#: cobc/tree.c:5691 -msgid "expression is always TRUE" -msgstr "" - -#: cobc/tree.c:5703 -#, c-format -msgid "expression '%.38s' %s '%.38s' is always FALSE" -msgstr "" - -#: cobc/tree.c:5709 -msgid "expression is always FALSE" -msgstr "" - -#: cobc/tree.c:6024 -msgid "PERFORM FOREVER since UNTIL is always FALSE" -msgstr "" - -#: cobc/tree.c:6028 -msgid "PERFORM ONCE since UNTIL is always TRUE" -msgstr "" - -#: cobc/tree.c:6031 -msgid "PERFORM NEVER since UNTIL is always TRUE" -msgstr "" - -#: cobc/tree.c:6132 -#, c-format -msgid "no definition/prototype seen for FUNCTION '%s'" -msgstr "" - -#: cobc/tree.c:6134 -#, c-format -msgid "no definition/prototype seen for PROGRAM '%s'" -msgstr "" - -#: cobc/tree.c:6143 -#, c-format -msgid "no definition/prototype seen for FUNCTION with external name '%s'" -msgstr "" - -#: cobc/tree.c:6145 -#, c-format -msgid "no definition/prototype seen for PROGRAM with external name '%s'" -msgstr "" - -#: cobc/tree.c:6237 -#, c-format -msgid "FUNCTION %s has invalid argument" -msgstr "" - -#: cobc/tree.c:6239 -#, c-format -msgid "either all arguments or none should be if type %s" -msgstr "" - -#: cobc/tree.c:6271 cobc/tree.c:6277 cobc/tree.c:6319 cobc/tree.c:6324 -#, c-format -msgid "FUNCTION '%s' has invalid reference modification" -msgstr "" - -#: cobc/tree.c:6288 cobc/tree.c:6730 -#, c-format -msgid "FUNCTION '%s' unknown" -msgstr "" - -#: cobc/tree.c:6292 -#, c-format -msgid "FUNCTION '%s' is not implemented" -msgstr "" - -#: cobc/tree.c:6299 cobc/tree.c:6306 cobc/tree.c:6714 -#, c-format -msgid "FUNCTION '%s' has wrong number of arguments" -msgstr "" - -#: cobc/tree.c:6313 -#, c-format -msgid "FUNCTION '%s' cannot have reference modification" -msgstr "" - -#: cobc/tree.c:6572 cobc/tree.c:6646 cobc/tree.c:6652 cobc/tree.c:6660 -#: cobc/tree.c:6668 -#, c-format -msgid "FUNCTION '%s' has invalid argument" -msgstr "" - -#: cobc/tree.c:6720 -#, c-format -msgid "FUNCTION '%s' has invalid first argument" -msgstr "" - -#: cobc/typeck.c:686 -#, c-format -msgid "%s item not allowed here: '%s'" -msgstr "" - -#: cobc/typeck.c:728 -#, c-format -msgid "'%s' is not a group name" -msgstr "" - -#: cobc/typeck.c:753 -#, c-format -msgid "'%s' is not a numeric name" -msgstr "" - -#: cobc/typeck.c:782 -#, c-format -msgid "'%s' is not a numeric or numeric-edited name" -msgstr "" - -#: cobc/typeck.c:835 -#, c-format -msgid "'%s' is Alpha, instead of a numeric value" -msgstr "" - -#: cobc/typeck.c:838 -#, c-format -msgid "'%s' is Alpha Edited, instead of a numeric value" -msgstr "" - -#: cobc/typeck.c:851 -#, c-format -msgid "'%s' is not a numeric value" -msgstr "" - -#: cobc/typeck.c:901 -#, c-format -msgid "'%s' is not an integer value" -msgstr "" - -#: cobc/typeck.c:905 -msgid "positive numeric integer is required here" -msgstr "" - -#: cobc/typeck.c:1022 -msgid "System routine" -msgstr "" - -#: cobc/typeck.c:1638 libcob/call.c:1069 -#, c-format -msgid "'%s' literal includes leading spaces which are omitted" -msgstr "" - -#: cobc/typeck.c:1642 -#, c-format -msgid "'%s' literal includes trailing spaces which are omitted" -msgstr "" - -#: cobc/typeck.c:1709 -msgid "ON/OFF usage requires a SWITCH name" -msgstr "" - -#: cobc/typeck.c:1727 -#, c-format -msgid "word length exceeds maximum of %d characters: '%s'" -msgstr "" - -#: cobc/typeck.c:1730 cobc/typeck.c:1733 -#, c-format -msgid "word length exceeds %d characters: '%s'" -msgstr "" - -#: cobc/typeck.c:1810 -#, c-format -msgid "ASSIGN %s interpreted as '%s'" -msgstr "" - -#: cobc/typeck.c:1900 cobc/typeck.c:2067 -#, c-format -msgid "subscript missing for '%s' - defaulting to 1" -msgstr "" - -#: cobc/typeck.c:1913 cobc/typeck.c:1992 -#, c-format -msgid "'%s' cannot be reference modified" -msgstr "" - -#: cobc/typeck.c:1923 cobc/typeck.c:1988 cobc/typeck.c:2256 -#, c-format -msgid "'%s' cannot be subscripted" -msgstr "" - -#: cobc/typeck.c:1927 cobc/typeck.c:2260 -#, c-format -msgid "'%s' requires one subscript" -msgstr "" - -#: cobc/typeck.c:1930 cobc/typeck.c:2263 -#, c-format -msgid "'%s' requires %d subscripts" -msgstr "" - -#. TRANSLATORS: This msgid is used when a variable name -#. or label is referenced in a compiler message. -#: cobc/typeck.c:1946 -#, c-format -msgid "'%s'" -msgstr "" - -#: cobc/typeck.c:1948 -#, c-format -msgid "'%s' (accessed by '%s')" -msgstr "" - -#: cobc/typeck.c:2051 -#, c-format -msgid "'%s' has no OCCURS clause" -msgstr "" - -#: cobc/typeck.c:2108 libcob/common.c:3114 -#, c-format -msgid "subscript of '%s' out of bounds: %d" -msgstr "" - -#: cobc/typeck.c:2162 cobc/typeck.c:2172 -msgid "offset must be greater than zero" -msgstr "" - -#: cobc/typeck.c:2167 cobc/typeck.c:2185 cobc/typeck.c:2204 -msgid "length must be greater than zero" -msgstr "" - -#: cobc/typeck.c:2175 cobc/typeck.c:2178 libcob/common.c:3136 -#, c-format -msgid "offset of '%s' out of bounds: %d" -msgstr "" - -#: cobc/typeck.c:2189 cobc/typeck.c:2193 cobc/typeck.c:2207 cobc/typeck.c:2211 -#: libcob/common.c:3149 -#, c-format -msgid "length of '%s' out of bounds: %d" -msgstr "" - -#: cobc/typeck.c:2323 cobc/typeck.c:2407 -msgid "reference modification not allowed here" -msgstr "" - -#: cobc/typeck.c:2337 cobc/typeck.c:2433 -msgid "88 level item not allowed here" -msgstr "" - -#: cobc/typeck.c:2342 -#, c-format -msgid "LENGTH OF '%s' not allowed outside of Procedure Division" -msgstr "" - -#: cobc/typeck.c:2346 cobc/typeck.c:2437 cobc/typeck.c:2445 cobc/typeck.c:2512 -msgid "variable length item not allowed here" -msgstr "" - -#: cobc/typeck.c:2375 -#, c-format -msgid "'%s' has not been DEFINEd" -msgstr "" - -#: cobc/typeck.c:2411 -msgid "only field names allowed here" -msgstr "" - -#: cobc/typeck.c:2422 -#, c-format -msgid "VALUE of '%s': %s target '%s' is invalid" -msgstr "" - -#: cobc/typeck.c:2424 cobc/typeck.c:2494 -msgid "" -"target must be in FILE SECTION or LINKAGE SECTION or have the EXTERNAL clause" -msgstr "" - -#: cobc/typeck.c:2480 cobc/typeck.c:2493 -#, c-format -msgid "VALUE of '%s': %s target is invalid" -msgstr "" - -#: cobc/typeck.c:2482 -msgid "no previous data-item found" -msgstr "" - -#: cobc/typeck.c:2667 -#, c-format -msgid "'%s' is not an alphabet name" -msgstr "" - -#: cobc/typeck.c:2931 -#, c-format -msgid "duplicate character values in alphabet '%s': %s" -msgstr "" - -#: cobc/typeck.c:2936 -#, c-format -msgid "invalid character values in alphabet '%s', starting at position %d" -msgstr "" - -#: cobc/typeck.c:2990 -msgid "invalid ALPHABET name" -msgstr "" - -#: cobc/typeck.c:3054 -#, c-format -msgid "duplicate character values in class '%s'" -msgstr "" - -#: cobc/typeck.c:3072 -#, c-format -msgid "'%s' is not a locale name" -msgstr "" - -#: cobc/typeck.c:3206 -msgid "invalid RECORD DEPENDING item" -msgstr "" - -#: cobc/typeck.c:3211 -msgid "RECORD DEPENDING must reference a data-item" -msgstr "" - -#: cobc/typeck.c:3234 -#, c-format -msgid "" -"RECORD DEPENDING item '%s' should be defined in WORKING-STORAGE, LOCAL-" -"STORAGE or LINKAGE SECTION" -msgstr "" - -#: cobc/typeck.c:3247 -#, c-format -msgid "file %s: RELATIVE KEY %s is not numeric" -msgstr "" - -#: cobc/typeck.c:3256 -#, c-format -msgid "file %s: RELATIVE KEY %s must be integer" -msgstr "" - -#: cobc/typeck.c:3261 -#, c-format -msgid "file %s: RELATIVE KEY %s must be unsigned" -msgstr "" - -#: cobc/typeck.c:3268 -#, c-format -msgid "file %s: RELATIVE KEY %s cannot have OCCURS" -msgstr "" - -#: cobc/typeck.c:3274 -#, c-format -msgid "RELATIVE KEY %s cannot be in file record belonging to %s" -msgstr "" - -#: cobc/typeck.c:3283 -#, c-format -msgid "file %s: RELATIVE KEY %s declared outside WORKING-STORAGE" -msgstr "" - -#: cobc/typeck.c:3306 cobc/typeck.c:7184 -#, c-format -msgid "'%s' is not a valid data name" -msgstr "" - -#: cobc/typeck.c:3313 -#, c-format -msgid "" -"CRT STATUS item '%s' should be defined in WORKING-STORAGE or LOCAL-STORAGE" -msgstr "" - -#: cobc/typeck.c:3319 -#, c-format -msgid "'%s' CRT STATUS must have at least 4 digits" -msgstr "" - -#: cobc/typeck.c:3325 -#, c-format -msgid "'%s' CRT STATUS must be 4 characters long" -msgstr "" - -#: cobc/typeck.c:3341 -#, c-format -msgid "variable '%s' will be implicitly defined" -msgstr "" - -#: cobc/typeck.c:3375 cobc/typeck.c:3438 -msgid "ASSIGN variable" -msgstr "" - -#: cobc/typeck.c:3443 -#, c-format -msgid "ASSIGN data item '%s' is invalid" -msgstr "" - -#: cobc/typeck.c:3507 -#, c-format -msgid "'%s' CURSOR must be 4 or 6 characters long" -msgstr "" - -#: cobc/typeck.c:3557 cobc/typeck.c:3561 -#, c-format -msgid "%s does not have a fixed location" -msgstr "" - -#: cobc/typeck.c:3573 -#, c-format -msgid "'%s' cannot have nested OCCURS DEPENDING" -msgstr "" - -#: cobc/typeck.c:3587 -#, c-format -msgid "'%s' OCCURS DEPENDING ON field item invalid here" -msgstr "" - -#: cobc/typeck.c:3595 -#, c-format -msgid "'%s' cannot have OCCURS DEPENDING because of '%s'" -msgstr "" - -#: cobc/typeck.c:3607 -#, c-format -msgid "'%s' OCCURS DEPENDING ON item must have GLOBAL attribute" -msgstr "" - -#: cobc/typeck.c:3621 -#, c-format -msgid "PASSWORD '%s' for EXTERNAL file '%s' must have EXTERNAL attribute" -msgstr "" - -#: cobc/typeck.c:3644 -#, c-format -msgid "file %s: ASSIGN %s declared outside WORKING-STORAGE" -msgstr "" - -#: cobc/typeck.c:3674 -#, c-format -msgid "duplicate APPLY COMMIT target: '%s'" -msgstr "" - -#: cobc/typeck.c:3688 -msgid "APPLY COMMIT statement invalid for SORT file" -msgstr "" - -#: cobc/typeck.c:3691 -msgid "APPLY COMMIT statement invalid for REPORT file" -msgstr "" - -#: cobc/typeck.c:3698 -#, c-format -msgid "" -"APPLY COMMIT item '%s' should be defined in WORKING-STORAGE or LOCAL-STORAGE" -msgstr "" - -#: cobc/typeck.c:3712 -#, c-format -msgid "item not allowed here: '%s'" -msgstr "" - -#: cobc/typeck.c:3725 -#, c-format -msgid "%s may not be subscripted" -msgstr "" - -#: cobc/typeck.c:3729 -#, c-format -msgid "%s may not be reference modified" -msgstr "" - -#: cobc/typeck.c:3789 -#, c-format -msgid "DEBUGGING target invalid: '%s'" -msgstr "" - -#: cobc/typeck.c:3795 -#, c-format -msgid "DEBUGGING target already specified with ALL PROCEDURES: '%s'" -msgstr "" - -#: cobc/typeck.c:3815 -msgid "DEBUGGING target" -msgstr "" - -#: cobc/typeck.c:3822 -#, c-format -msgid "'%s' is not a valid DEBUGGING target" -msgstr "" - -#: cobc/typeck.c:3860 cobc/typeck.c:3865 -#, c-format -msgid "'%s' is not in DECLARATIVES" -msgstr "" - -#: cobc/typeck.c:3877 -#, c-format -msgid "invalid reference to '%s' (in DECLARATIVES)" -msgstr "" - -#: cobc/typeck.c:3886 -#, c-format -msgid "'%s' is not a procedure name" -msgstr "" - -#: cobc/typeck.c:3948 -#, c-format -msgid "LINKAGE item '%s' is not a PROCEDURE USING parameter" -msgstr "" - -#: cobc/typeck.c:4001 -#, c-format -msgid "'%s' is not an alterable paragraph" -msgstr "" - -#: cobc/typeck.c:4604 cobc/typeck.c:4608 -#, c-format -msgid "suggest parentheses around %s within %s" -msgstr "" - -#: cobc/typeck.c:4616 -msgid "invalid conditional expression" -msgstr "" - -#: cobc/typeck.c:4726 -#, c-format -msgid "internal decimal structure size exceeded: %d" -msgstr "" - -#: cobc/typeck.c:4729 -msgid "" -"Try to minimize the number of parentheses or split into multiple " -"computations." -msgstr "" - -#: cobc/typeck.c:4753 -#, c-format -msgid "more than %d nested expressions" -msgstr "" - -#: cobc/typeck.c:4795 -msgid "precision of result may change with arithmetic-osvs" -msgstr "" - -#: cobc/typeck.c:4851 -#, c-format -msgid "unexpected operation: %c (%d)" -msgstr "" - -#: cobc/typeck.c:4856 -#, c-format -msgid "%s operator may be misplaced" -msgstr "" - -#: cobc/typeck.c:4926 -msgid "unexpected constant expansion" -msgstr "" - -#: cobc/typeck.c:5747 -#, c-format -msgid "more than %d nested conditions" -msgstr "" - -#: cobc/typeck.c:6104 cobc/typeck.c:6180 -msgid "no CORRESPONDING items found" -msgstr "" - -#: cobc/typeck.c:6252 -msgid "no items to ACCEPT found" -msgstr "" - -#: cobc/typeck.c:6302 -msgid "no items to DISPLAY found" -msgstr "" - -#: cobc/typeck.c:6421 -msgid "cannot specify figurative constant ZERO in AT clause" -msgstr "" - -#: cobc/typeck.c:6425 -msgid "value in AT clause is not numeric" -msgstr "" - -#: cobc/typeck.c:6431 -msgid "value in AT clause must have 4 or 6 digits" -msgstr "" - -#: cobc/typeck.c:6553 -msgid "invalid PROMPT literal" -msgstr "" - -#: cobc/typeck.c:6558 -msgid "invalid PROMPT identifier" -msgstr "" - -#: cobc/typeck.c:6848 -#, c-format -msgid "'%s' is not an input device" -msgstr "" - -#: cobc/typeck.c:6878 cobc/typeck.c:8016 -#, c-format -msgid "'%s' is not defined in SPECIAL-NAMES" -msgstr "" - -#: cobc/typeck.c:6883 -#, c-format -msgid "invalid input device '%s'" -msgstr "" - -#: cobc/typeck.c:6888 cobc/typeck.c:8020 -#, c-format -msgid "unknown device '%s'; it may exist in another dialect" -msgstr "" - -#: cobc/typeck.c:6891 cobc/typeck.c:8023 -#, c-format -msgid "unknown device '%s'; not defined in SPECIAL-NAMES" -msgstr "" - -#: cobc/typeck.c:6915 -msgid "target of ALLOCATE is not a BASED item" -msgstr "" - -#: cobc/typeck.c:6926 -msgid "target of RETURNING is not a data pointer" -msgstr "" - -#: cobc/typeck.c:6936 cobc/typeck.c:7342 -msgid "amount must be specified as a numeric expression" -msgstr "" - -#: cobc/typeck.c:6949 -msgid "INITIALIZED TO item is not alphanumeric" -msgstr "" - -#: cobc/typeck.c:7019 -msgid "only alphanumeric FUNCTION types are allowed here" -msgstr "" - -#: cobc/typeck.c:7027 -msgid "invalid RETURNING field" -msgstr "" - -#: cobc/typeck.c:7046 -msgid "STDCALL not available on this platform" -msgstr "" - -#: cobc/typeck.c:7050 -msgid "STDCALL used on 64-bit Windows platform" -msgstr "" - -#: cobc/typeck.c:7055 -msgid "STATIC CALL convention requires a literal program name" -msgstr "" - -#: cobc/typeck.c:7060 cobc/typeck.c:10632 cobc/typeck.c:11539 -#: cobc/typeck.c:11903 -msgid "HANDLE must be either a generic or a THREAD HANDLE" -msgstr "" - -#: cobc/typeck.c:7078 -msgid "numeric literal is negative" -msgstr "" - -#: cobc/typeck.c:7157 -msgid "numeric literal exceeds size limits" -msgstr "" - -#: cobc/typeck.c:7175 -#, c-format -msgid "figurative constant %s invalid here" -msgstr "" - -#: cobc/typeck.c:7190 -#, c-format -msgid "'%s' ANY LENGTH item not passed BY REFERENCE" -msgstr "" - -#: cobc/typeck.c:7198 -#, c-format -msgid "'%s' is not a 01 or 77 level item" -msgstr "" - -#: cobc/typeck.c:7228 cobc/typeck.c:7233 -#, c-format -msgid "wrong number of CALL parameters for '%s', %d given, %d expected" -msgstr "" - -#: cobc/typeck.c:7300 cobc/typeck.c:7374 cobc/typeck.c:7378 cobc/typeck.c:7382 -#: cobc/typeck.c:7412 cobc/typeck.c:10591 cobc/typeck.c:10755 -#: cobc/typeck.c:10944 cobc/typeck.c:10948 cobc/typeck.c:11844 -#: cobc/typeck.c:12087 cobc/typeck.c:12090 -#, c-format -msgid "%s not allowed on %s files" -msgstr "" - -#: cobc/typeck.c:7336 -msgid "AFTER phrase in CONTINUE statement" -msgstr "" - -#: cobc/typeck.c:7478 -msgid "positions cannot be specified for main windows" -msgstr "" - -#: cobc/typeck.c:7488 cobc/typeck.c:7491 cobc/typeck.c:7508 -msgid "HANDLE must be either a generic or a WINDOW HANDLE or X(10)" -msgstr "" - -#: cobc/typeck.c:7617 -#, c-format -msgid "'%s' is an invalid type for DISPLAY operand" -msgstr "" - -#: cobc/typeck.c:7622 -msgid "invalid type for DISPLAY operand" -msgstr "" - -#: cobc/typeck.c:7973 cobc/typeck.c:8006 -#, c-format -msgid "'%s' is not an output device" -msgstr "" - -#: cobc/typeck.c:8109 -msgid "invalid use of 88 level in WHEN expression" -msgstr "" - -#: cobc/typeck.c:8165 -msgid "wrong number of WHEN parameters" -msgstr "" - -#: cobc/typeck.c:8244 cobc/typeck.c:8256 -#, c-format -msgid "target %d of FREE is not a BASED data item" -msgstr "" - -#: cobc/typeck.c:8262 -#, c-format -msgid "target %d of FREE must be a data pointer" -msgstr "" - -#: cobc/typeck.c:8276 -msgid "GO TO without procedure-name" -msgstr "" - -#: cobc/typeck.c:8286 -msgid "GO TO with multiple procedure-names" -msgstr "" - -#: cobc/typeck.c:8308 -msgid "GO TO ENTRY with multiple entry-names" -msgstr "" - -#: cobc/typeck.c:8367 -msgid "invalid INITIALIZE statement" -msgstr "" - -#: cobc/typeck.c:8443 cobc/typeck.c:8446 -#, c-format -msgid "%s operands differ in size" -msgstr "" - -#: cobc/typeck.c:8476 -#, c-format -msgid "unexpected clause %d" -msgstr "" - -#: cobc/typeck.c:8545 cobc/typeck.c:8556 cobc/typeck.c:8567 cobc/typeck.c:8578 -#, c-format -msgid "data name expected before %s" -msgstr "" - -#: cobc/typeck.c:8588 -#, c-format -msgid "ALL, LEADING or TRAILING expected before '%s'" -msgstr "" - -#: cobc/typeck.c:8598 -msgid "operand has wrong size" -msgstr "" - -#: cobc/typeck.c:8669 -#, c-format -msgid "internal register '%s' defined as BINARY-LONG" -msgstr "" - -#: cobc/typeck.c:8672 cobc/typeck.c:8675 cobc/typeck.c:8678 cobc/typeck.c:8681 -#: cobc/typeck.c:8684 cobc/typeck.c:8687 cobc/typeck.c:8690 cobc/typeck.c:8693 -#: cobc/typeck.c:8696 -#, c-format -msgid "'%s' defined here as USAGE %s" -msgstr "" - -#: cobc/typeck.c:8699 -#, c-format -msgid "'%s' defined here as PIC %s" -msgstr "" - -#: cobc/typeck.c:8702 -#, c-format -msgid "'%s' defined here as a group of length %d" -msgstr "" - -#: cobc/typeck.c:8741 -#, c-format -msgid "value is %s" -msgstr "" - -#: cobc/typeck.c:8745 -#, c-format -msgid "value size is %d" -msgstr "" - -#: cobc/typeck.c:9022 -msgid "invalid destination for MOVE" -msgstr "" - -#: cobc/typeck.c:9057 -msgid "MOVE of figurative constant SPACE to numeric item" -msgstr "" - -#: cobc/typeck.c:9072 -msgid "MOVE of figurative constant QUOTE to numeric item" -msgstr "" - -#: cobc/typeck.c:9077 cobc/typeck.c:9089 -msgid "MOVE of figurative constant to numeric item" -msgstr "" - -#: cobc/typeck.c:9151 -msgid "numeric literal in VALUE clause of numeric-edited item" -msgstr "" - -#: cobc/typeck.c:9176 -msgid "numeric move to ALPHABETIC" -msgstr "" - -#: cobc/typeck.c:9188 -msgid "data item not signed" -msgstr "" - -#: cobc/typeck.c:9191 -msgid "ignoring sign" -msgstr "" - -#: cobc/typeck.c:9503 -msgid "overlapping MOVE may occur and produce unpredictable results" -msgstr "" - -#: cobc/typeck.c:9510 -msgid "overlapping MOVE may produce unpredictable results" -msgstr "" - -#: cobc/typeck.c:9643 -msgid "invalid source for MOVE" -msgstr "" - -#: cobc/typeck.c:9666 -msgid "source is non-numeric - substituting zero" -msgstr "" - -#: cobc/typeck.c:9672 cobc/typeck.c:9683 -msgid "invalid VALUE clause" -msgstr "" - -#: cobc/typeck.c:9675 cobc/typeck.c:11480 cobc/typeck.c:11485 -#: cobc/typeck.c:11512 cobc/typeck.c:11517 -msgid "invalid SET statement" -msgstr "" - -#: cobc/typeck.c:9677 -msgid "invalid MOVE statement" -msgstr "" - -#: cobc/typeck.c:9684 -msgid "literal exceeds data size" -msgstr "" - -#: cobc/typeck.c:9688 -msgid "numeric literal exceeds data size" -msgstr "" - -#: cobc/typeck.c:9697 -msgid "MOVE of non-integer to alphanumeric" -msgstr "" - -#: cobc/typeck.c:9703 -msgid "numeric value is expected" -msgstr "" - -#: cobc/typeck.c:9708 -msgid "alphanumeric value is expected" -msgstr "" - -#: cobc/typeck.c:9713 -msgid "value does not fit the picture string" -msgstr "" - -#: cobc/typeck.c:9719 -msgid "value size exceeds data size" -msgstr "" - -#: cobc/typeck.c:9724 -msgid "sending field larger than receiving field" -msgstr "" - -#: cobc/typeck.c:9729 -msgid "some digits may be truncated" -msgstr "" - -#: cobc/typeck.c:10515 -#, c-format -msgid "invalid MOVE target: %s" -msgstr "" - -#: cobc/typeck.c:10768 -msgid "READ PREVIOUS not allowed for this file type" -msgstr "" - -#: cobc/typeck.c:10776 -msgid "KEY ignored with sequential READ" -msgstr "" - -#: cobc/typeck.c:10872 -msgid "figurative constants not allowed in FROM clause" -msgstr "" - -#: cobc/typeck.c:10879 -msgid "literal in FROM clause must be alphanumeric, national or boolean" -msgstr "" - -#: cobc/typeck.c:10902 cobc/typeck.c:12047 -#, c-format -msgid "%s FILE requires a FROM clause" -msgstr "" - -#: cobc/typeck.c:10924 cobc/typeck.c:11010 cobc/typeck.c:12069 -#, c-format -msgid "%s subject does not refer to a record name" -msgstr "" - -#: cobc/typeck.c:11016 -msgid "RELEASE not allowed on this record item" -msgstr "" - -#: cobc/typeck.c:11097 cobc/typeck.c:11118 cobc/typeck.c:11125 -msgid "invalid SEARCH ALL condition" -msgstr "" - -#: cobc/typeck.c:11237 cobc/typeck.c:11241 -msgid "SET targets must be PROGRAM-POINTER" -msgstr "" - -#: cobc/typeck.c:11268 cobc/typeck.c:11335 cobc/typeck.c:11403 -#, c-format -msgid "cannot change address of '%s', which is not level 1 or 77" -msgstr "" - -#: cobc/typeck.c:11272 cobc/typeck.c:11339 cobc/typeck.c:11407 -#, c-format -msgid "cannot change address of '%s', which is not BASED or a LINKAGE item" -msgstr "" - -#: cobc/typeck.c:11291 -#, c-format -msgid "SET target '%s' is not numeric, an INDEX or a POINTER" -msgstr "" - -#: cobc/typeck.c:11360 -#, c-format -msgid "SET target '%s' is not a POINTER for FCD" -msgstr "" - -#: cobc/typeck.c:11428 -#, c-format -msgid "SET target '%s' is not a POINTER for FCD-KEYDEF" -msgstr "" - -#: cobc/typeck.c:11521 -msgid "field does not have a FALSE clause" -msgstr "" - -#: cobc/typeck.c:11552 -msgid "THREAD-priority must be between 1 and 32767" -msgstr "" - -#: cobc/typeck.c:11572 -msgid "SET ATTRIBUTE requires a screen item as subject" -msgstr "" - -#: cobc/typeck.c:11578 -msgid "SET ATTRIBUTE subject does not refer to a screen item" -msgstr "" - -#: cobc/typeck.c:11629 -msgid "invalid SORT filename" -msgstr "" - -#: cobc/typeck.c:11689 -msgid "invalid SORT USING parameter" -msgstr "" - -#: cobc/typeck.c:11718 -msgid "invalid SORT GIVING parameter" -msgstr "" - -#: cobc/typeck.c:11772 cobc/typeck.c:11799 cobc/typeck.c:11819 -msgid "invalid key item" -msgstr "" - -#: cobc/typeck.c:11849 -msgid "LENGTH/SIZE clause only allowed on INDEXED files" -msgstr "" - -#: cobc/typeck.c:11854 -msgid "START not allowed with ACCESS MODE RANDOM" -msgstr "" - -#: cobc/typeck.c:12103 -msgid "LOCK clause invalid here" -msgstr "" - -#: cobc/typeck.c:12365 -msgid "data item is not part of a report" -msgstr "" - -#: cobc/typeck.c:12385 -msgid "improper use of SUPPRESS PRINTING" -msgstr "" - -#: cobc/typeck.c:12400 -#, c-format -msgid "%s must be alphanumeric or national" -msgstr "" - -#: cobc/typeck.c:12411 -#, c-format -msgid "%s may not be a figurative constant" -msgstr "" - -#: cobc/typeck.c:12438 -#, c-format -msgid "%s must be a child of the input record" -msgstr "" - -#: cobc/typeck.c:12464 -#, c-format -msgid "%s may not be an ignored item in JSON/XML GENERATE" -msgstr "" - -#: cobc/typeck.c:12475 -#, c-format -msgid "%s must be elementary" -msgstr "" - -#: cobc/typeck.c:12487 -#, c-format -msgid "%s must be USAGE DISPLAY or NATIONAL" -msgstr "" - -#: cobc/typeck.c:12501 -#, c-format -msgid "%s must be an integer" -msgstr "" - -#: cobc/typeck.c:12517 cobc/typeck.c:12523 -msgid "JSON/XML GENERATE receiving item" -msgstr "" - -#: cobc/typeck.c:12520 -msgid "JSON/XML GENERATE receiving item may not have JUSTIFIED clause" -msgstr "" - -#: cobc/typeck.c:12608 -msgid "JSON/XML GENERATE input record may not be reference modified" -msgstr "" - -#: cobc/typeck.c:12614 -msgid "JSON/XML GENERATE input record may not have RENAMES clause" -msgstr "" - -#: cobc/typeck.c:12619 -#, c-format -msgid "all the children of '%s' are ignored in JSON/XML GENERATE" -msgstr "" - -#: cobc/typeck.c:12626 -msgid "JSON/XML GENERATE input record has subrecords with non-unique names" -msgstr "" - -#: cobc/typeck.c:12631 -msgid "floating-point items in JSON/XML GENERATE" -msgstr "" - -#: cobc/typeck.c:12635 -msgid "OCCURS items in JSON/XML GENERATE" -msgstr "" - -#: cobc/typeck.c:12660 -msgid "COUNT IN item must be numeric and an integer" -msgstr "" - -#: cobc/typeck.c:12665 -msgid "COUNT IN item must be an integer" -msgstr "" - -#: cobc/typeck.c:12668 -msgid "COUNT IN item may not have PICTURE with P in it" -msgstr "" - -#: cobc/typeck.c:12711 -msgid "NAMESPACE must be a valid URI" -msgstr "" - -#: cobc/typeck.c:12755 -msgid "NAMESPACE-PREFIX must be a valid XML name" -msgstr "" - -#: cobc/typeck.c:12780 cobc/typeck.c:12787 -msgid "NAME OF item" -msgstr "" - -#: cobc/typeck.c:12784 -msgid "NAME OF item must be the input record or a child of it" -msgstr "" - -#: cobc/typeck.c:12791 -msgid "NAME OF name must be a valid XML name" -msgstr "" - -#: cobc/typeck.c:12817 cobc/typeck.c:12818 cobc/typeck.c:12821 -#: cobc/typeck.c:12825 -msgid "TYPE OF item" -msgstr "" - -#: cobc/typeck.c:12843 -msgid "SUPPRESS WHEN SPACE item" -msgstr "" - -#: cobc/typeck.c:12846 -msgid "SUPPRESS WHEN LOW-VALUE item" -msgstr "" - -#: cobc/typeck.c:12848 -msgid "SUPPRESS WHEN HIGH-VALUE item" -msgstr "" - -#: cobc/typeck.c:12877 cobc/typeck.c:12885 cobc/typeck.c:12889 -msgid "SUPPRESS item" -msgstr "" - -#: cobc/typeck.c:12881 -msgid "SUPPRESS item with WHEN clause" -msgstr "" - -#: cobc/typeck.c:12958 -msgid "WITH ATTRIBUTES specified, but no attributes can be generated" -msgstr "" - -#: cobc/warning.def:34 -msgid "" -" -Wextra additional warnings only raised with -W or -Wall" -msgstr "" - -#: cobc/warning.def:37 -msgid " -Wno-unfinished do not warn if unfinished features are used" -msgstr "" - -#: cobc/warning.def:40 -msgid " -Wno-pending do not warn if pending features are mentioned" -msgstr "" - -#: cobc/warning.def:43 -msgid " -Wobsolete warn if obsolete features are used" -msgstr "" - -#: cobc/warning.def:46 -msgid " -Warchaic warn if archaic features are used" -msgstr "" - -#: cobc/warning.def:49 -msgid "" -" -Wredefinition warn about incompatible redefinition of data items" -msgstr "" - -#: cobc/warning.def:52 -msgid "" -" -Wtruncate warn about field truncation from constant assignments" -msgstr "" - -#: cobc/warning.def:55 -msgid " -Wpossible-truncate warn about possible field truncation" -msgstr "" - -#: cobc/warning.def:58 -msgid " -Woverlap warn about overlapping MOVE of items" -msgstr "" - -#: cobc/warning.def:61 -msgid "" -" -Wpossible-overlap warn about MOVE of items that may overlap depending " -"on variables" -msgstr "" - -#: cobc/warning.def:64 -msgid "" -" -Wparentheses warn about lack of parentheses around AND within OR" -msgstr "" - -#: cobc/warning.def:67 -msgid " -Wstrict-typing warn strictly about type mismatch" -msgstr "" - -#: cobc/warning.def:70 -msgid " -Wimplicit-define warn about implicitly defined data items" -msgstr "" - -#: cobc/warning.def:73 -msgid " -Wcorresponding warn about CORRESPONDING with no matching items" -msgstr "" - -#: cobc/warning.def:76 -msgid " -Winitial-value warn if initial VALUE clause is ignored" -msgstr "" - -#: cobc/warning.def:79 -msgid "" -" -Wprototypes warn about missing FUNCTION prototypes/definitions" -msgstr "" - -#: cobc/warning.def:82 -msgid "" -" -Warithmetic-osvs warn if arithmetic expression precision has changed" -msgstr "" - -#: cobc/warning.def:85 -msgid " -Wcall-params warn about non 01/77 items for CALL parameters" -msgstr "" - -#: cobc/warning.def:88 -msgid "" -" -Wconstant-expression warn about expressions that always resolve to true/" -"false" -msgstr "" - -#: cobc/warning.def:91 -msgid "" -" -Wcolumn-overflow warn about text after program-text area, FIXED format" -msgstr "" - -#: cobc/warning.def:94 -msgid " -Wterminator warn about lack of scope terminator END-XXX" -msgstr "" - -#: cobc/warning.def:97 -msgid " -Wlinkage warn about dangling LINKAGE items" -msgstr "" - -#: cobc/warning.def:100 -msgid " -Wunreachable warn about likely unreachable statements" -msgstr "" - -#: cobc/warning.def:103 -msgid " -Wno-dialect do not warn about dialect specific issues" -msgstr "" - -#: cobc/warning.def:106 -msgid " -Wothers do not warn about different issues" -msgstr "" - -#: cobc/warning.def:109 -msgid "" -" -Wno-unsupported do not warn if runtime does not support a feature " -"used" -msgstr "" - -#: libcob/call.c:87 -#, c-format -msgid "LoadLibrary/GetProcAddress error %d" -msgstr "" - -#: libcob/call.c:939 -msgid "indeterminable error in resolve of COBOL CALL" -msgstr "" - -#: libcob/call.c:1022 -#, c-format -msgid "user-defined FUNCTION '%s' not found" -msgstr "" - -#: libcob/call.c:1129 libcob/call.c:1208 libcob/call.c:1326 libcob/call.c:1354 -#, c-format -msgid "NULL parameter passed to '%s'" -msgstr "" - -#: libcob/call.c:1204 -#, c-format -msgid "invalid number of arguments passed to '%s'" -msgstr "" - -#: libcob/call.c:1330 -msgid "multiple call to 'cob_setjmp'" -msgstr "" - -#: libcob/call.c:1358 -msgid "call to 'cob_longjmp' with no prior 'cob_setjmp'" -msgstr "" - -#: libcob/call.c:1592 libcob/call.c:1633 libcob/call.c:1646 -#: libcob/common.c:7081 -msgid "cob_init() has not been called" -msgstr "" - -#: libcob/call.c:1598 -#, c-format -msgid "parameter %d is not within range of %d" -msgstr "" - -#: libcob/call.c:1604 -#, c-format -msgid "parameter %d is NULL" -msgstr "" - -#: libcob/call.c:1859 libcob/call.c:1916 -#, c-format -msgid "attempt to over-write constant parameter %d with " -msgstr "" - -#: libcob/call.c:1965 -#, c-format -msgid "attempt to over-write constant parameter %d with '%s'" -msgstr "" - -#: libcob/cobgetopt.c:497 -#, c-format -msgid "%s: option '%s' is ambiguous; possibilities:" -msgstr "" - -#: libcob/cobgetopt.c:538 -#, c-format -msgid "%s: option '--%s' doesn't allow an argument" -msgstr "" - -#: libcob/cobgetopt.c:545 -#, c-format -msgid "%s: option '%c%s' doesn't allow an argument" -msgstr "" - -#: libcob/cobgetopt.c:565 -#, c-format -msgid "%s: option '--%s' requires an argument" -msgstr "" - -#: libcob/cobgetopt.c:597 -#, c-format -msgid "%s: unrecognized option '--%s'" -msgstr "" - -#: libcob/cobgetopt.c:604 -#, c-format -msgid "%s: unrecognized option '%c%s'" -msgstr "" - -#: libcob/cobgetopt.c:633 -#, c-format -msgid "%s: invalid option -- %c" -msgstr "" - -#: libcob/cobgetopt.c:664 libcob/cobgetopt.c:805 -#, c-format -msgid "%s: option requires an argument -- %c" -msgstr "" - -#: libcob/cobgetopt.c:714 -#, c-format -msgid "%s: option '-W %s' is ambiguous" -msgstr "" - -#: libcob/cobgetopt.c:736 -#, c-format -msgid "%s: option '-W %s' doesn't allow an argument" -msgstr "" - -#: libcob/cobgetopt.c:754 -#, c-format -msgid "%s: option '%s' requires an argument" -msgstr "" - -#: libcob/common.c:793 -#, c-format -msgid "attempt to reference unallocated memory" -msgstr "" - -#: libcob/common.c:798 -#, c-format -msgid "bus error" -msgstr "" - -#: libcob/common.c:803 -#, c-format -msgid "fatal arithmetic error" -msgstr "" - -#: libcob/common.c:807 -#, c-format -msgid "caught signal" -msgstr "" - -#: libcob/common.c:811 -#, c-format -msgid "signal %s" -msgstr "" - -#: libcob/common.c:817 -#, c-format -msgid "abnormal termination - file contents may be incorrect" -msgstr "" - -#: libcob/common.c:2049 -msgid "NULL field" -msgstr "" - -#: libcob/common.c:2059 -msgid "field with NULL address" -msgstr "" - -#: libcob/common.c:2345 -msgid "version mismatch" -msgstr "" - -#: libcob/common.c:2346 libcob/common.c:2348 -#, c-format -msgid "%s has version %s.%d" -msgstr "" - -#: libcob/common.c:2358 -#, c-format -msgid "CALL to %s requires %d arguments" -msgstr "" - -#: libcob/common.c:2980 -#, c-format -msgid "BASED/LINKAGE item %s has NULL address" -msgstr "" - -#: libcob/common.c:2992 libcob/common.c:2995 -#, c-format -msgid "LINKAGE item %s not passed by caller" -msgstr "" - -#: libcob/common.c:3081 -#, c-format -msgid "'%s' (Type: %s) not numeric: '%s'" -msgstr "" - -#: libcob/common.c:3096 -#, c-format -msgid "OCCURS DEPENDING ON '%s' out of bounds: %d" -msgstr "" - -#: libcob/common.c:3099 libcob/common.c:3120 -#, c-format -msgid "maximum subscript for '%s': %d" -msgstr "" - -#: libcob/common.c:3101 -#, c-format -msgid "minimum subscript for '%s': %d" -msgstr "" - -#: libcob/common.c:3117 -#, c-format -msgid "current maximum subscript for '%s': %d" -msgstr "" - -#: libcob/common.c:3139 -#, c-format -msgid "offset of '%s' out of bounds: %d, maximum: %d" -msgstr "" - -#: libcob/common.c:3152 -#, c-format -msgid "length of '%s' out of bounds: %d, maximum: %d" -msgstr "" - -#: libcob/common.c:3161 -#, c-format -msgid "length of '%s' out of bounds: %d, starting at: %d, maximum: %d" -msgstr "" - -#: libcob/common.c:3176 libcob/common.c:3181 -#, c-format -msgid "" -"EXTERNAL item '%s' previously allocated with size %d, requested size is %d" -msgstr "" - -#: libcob/common.c:3682 -#, c-format -msgid "COB_CURRENT_DATE '%s' is invalid" -msgstr "" - -#: libcob/common.c:4585 -#, c-format -msgid "parameter to SYSTEM call is larger than %d characters" -msgstr "" - -#: libcob/common.c:5195 -#, c-format -msgid "error '%s' during CBL_GC_FORK" -msgstr "" - -#: libcob/common.c:5200 libcob/common.c:5297 -#, c-format -msgid "'%s' is not supported on this platform" -msgstr "" - -#: libcob/common.c:5226 -#, c-format -msgid "error '%s' for P%d during CBL_GC_WAITPID" -msgstr "" - -#: libcob/common.c:5418 -msgid "Call to CBL_GC_GETOPT with wrong longoption size." -msgstr "" - -#: libcob/common.c:5423 -msgid "Call to CBL_GC_GETOPT with missing longind." -msgstr "" - -#: libcob/common.c:5837 libcob/common.c:5858 libcob/common.c:5871 -#: libcob/common.c:7785 -#, c-format -msgid "(default)" -msgstr "" - -#: libcob/common.c:6119 libcob/common.c:6138 -msgid "should be unsigned" -msgstr "" - -#: libcob/common.c:6127 libcob/common.c:6176 -msgid "should be numeric" -msgstr "" - -#: libcob/common.c:6185 -#, c-format -msgid "minimum value: %lu" -msgstr "" - -#: libcob/common.c:6236 libcob/common.c:6787 libcob/common.c:6801 -#, c-format -msgid "should not contain '%c'" -msgstr "" - -#: libcob/common.c:6316 libcob/common.c:6384 libcob/common.c:6393 -#: libcob/common.c:6401 -#, c-format -msgid "not set" -msgstr "" - -#: libcob/common.c:6376 libcob/common.c:6379 libcob/common.c:6382 -#, c-format -msgid "set by %s" -msgstr "" - -#: libcob/common.c:6516 -#, c-format -msgid "WARNING - '%s' without a value - ignored!" -msgstr "" - -#: libcob/common.c:6519 -#, c-format -msgid "'%s' without a value!" -msgstr "" - -#: libcob/common.c:6545 -#, c-format -msgid "WARNING - '%s %s' without a value - ignored!" -msgstr "" - -#: libcob/common.c:7034 -msgid "error" -msgstr "" - -#: libcob/common.c:7064 -msgid "attempt to CANCEL active program" -msgstr "" - -#: libcob/common.c:7091 -msgid "CALL of program with CHAINING clause" -msgstr "" - -#: libcob/common.c:7095 -msgid "stack overflow, possible PERFORM depth exceeded" -msgstr "" - -#: libcob/common.c:7100 -msgid "invalid entry/exit in GLOBAL USE procedure" -msgstr "" - -#: libcob/common.c:7105 -msgid "unable to allocate memory" -msgstr "" - -#: libcob/common.c:7110 -msgid "invalid entry into module" -msgstr "" - -#: libcob/common.c:7115 -#, c-format -msgid "recursive CALL from %s to %s which is NOT RECURSIVE" -msgstr "" - -#: libcob/common.c:7125 -msgid "divide by ZERO" -msgstr "" - -#: libcob/common.c:7132 -msgid "end of file" -msgstr "" - -#: libcob/common.c:7135 -msgid "key out of range" -msgstr "" - -#: libcob/common.c:7138 -msgid "key order not ascending" -msgstr "" - -#: libcob/common.c:7141 -msgid "record key already exists" -msgstr "" - -#: libcob/common.c:7144 -msgid "record key does not exist" -msgstr "" - -#: libcob/common.c:7147 -msgid "permanent file error" -msgstr "" - -#: libcob/common.c:7150 -msgid "inconsistant file name" -msgstr "" - -#: libcob/common.c:7153 -msgid "file does not exist" -msgstr "" - -#: libcob/common.c:7156 -msgid "permission denied" -msgstr "" - -#: libcob/common.c:7159 -msgid "file already open" -msgstr "" - -#: libcob/common.c:7162 -msgid "file not open" -msgstr "" - -#: libcob/common.c:7165 -msgid "READ must be executed first" -msgstr "" - -#: libcob/common.c:7168 -msgid "record overflow" -msgstr "" - -#: libcob/common.c:7171 -msgid "READ after unsuccessful READ/START" -msgstr "" - -#: libcob/common.c:7174 -msgid "READ/START not allowed, file not open for input" -msgstr "" - -#: libcob/common.c:7177 -msgid "WRITE not allowed, file not open for output" -msgstr "" - -#: libcob/common.c:7180 -msgid "DELETE/REWRITE not allowed, file not open for I-O" -msgstr "" - -#: libcob/common.c:7183 -msgid "record locked by another file connector" -msgstr "" - -#: libcob/common.c:7186 -msgid "LINAGE values invalid" -msgstr "" - -#: libcob/common.c:7189 -msgid "file sharing conflict" -msgstr "" - -#: libcob/common.c:7193 -msgid "runtime library is not configured for this operation" -msgstr "" - -#: libcob/common.c:7198 -msgid "unknown file error" -msgstr "" - -#: libcob/common.c:7205 -#, c-format -msgid "%s (status = %02d) for file %s" -msgstr "" - -#: libcob/common.c:7208 -#, c-format -msgid "%s (status = %02d) for file %s on %s" -msgstr "" - -#: libcob/common.c:7215 -msgid "attempt to use non-implemented function" -msgstr "" - -#: libcob/common.c:7218 -msgid "attempt to use non-implemented XML I/O" -msgstr "" - -#: libcob/common.c:7221 -msgid "attempt to use non-implemented JSON I/O" -msgstr "" - -#: libcob/common.c:7268 -msgid "environment variables" -msgstr "" - -#: libcob/common.c:7315 -msgid "" -"License LGPLv3+: GNU LGPL version 3 or later " -msgstr "" - -#: libcob/common.c:7372 libcob/common.c:7374 -msgid "dynamic loading" -msgstr "" - -#: libcob/common.c:7379 -msgid "enabled" -msgstr "" - -#: libcob/common.c:7460 libcob/common.c:7577 libcob/common.c:7586 -#: libcob/common.c:7603 libcob/common.c:7618 -#, c-format -msgid "%s, version %d.%d.%d" -msgstr "" - -#: libcob/common.c:7462 libcob/common.c:7579 libcob/common.c:7588 -#: libcob/common.c:7620 -#, c-format -msgid "%s, version %d.%d.%d (compiled with %d.%d)" -msgstr "" - -#: libcob/common.c:7465 -#, c-format -msgid "%s, version %s" -msgstr "" - -#: libcob/common.c:7486 libcob/common.c:7488 libcob/common.c:7493 -#: libcob/common.c:7495 libcob/common.c:7498 -msgid "mouse support" -msgstr "" - -#: libcob/common.c:7636 -msgid "CALL configuration" -msgstr "" - -#: libcob/common.c:7637 -msgid "File I/O configuration" -msgstr "" - -#: libcob/common.c:7638 -msgid "Screen I/O configuration" -msgstr "" - -#: libcob/common.c:7639 -msgid "Miscellaneous" -msgstr "" - -#: libcob/common.c:7640 -msgid "System configuration" -msgstr "" - -#: libcob/common.c:7644 -msgid "runtime configuration" -msgstr "" - -#: libcob/common.c:7646 -msgid "via" -msgstr "" - -#: libcob/common.c:7719 libcob/common.c:7747 -msgid "... removed from environment" -msgstr "" - -#: libcob/common.c:7773 libcob/common.c:7775 -#, c-format -msgid "(set by %s)" -msgstr "" - -#: libcob/common.c:7783 -#, c-format -msgid "(reset)" -msgstr "" - -#: libcob/common.c:8167 libcob/common.c:8286 -#, c-format -msgid "%s called with unknown option: %d" -msgstr "" - -#: libcob/common.c:8239 -#, c-format -msgid "Module dump due to %s\n" -msgstr "" - -#: libcob/common.c:8243 -#, c-format -msgid " Last statement of %s was Line %d of %s\n" -msgstr "" - -#: libcob/common.c:8249 -#, c-format -msgid " Last statement of %s unknown\n" -msgstr "" - -#: libcob/common.c:8259 -#, c-format -msgid "Dump Program-Id %s from %s compiled %s\n" -msgstr "" - -#: libcob/fileio.c:287 -#, c-format -msgid "ERROR I/O routine %s is not present" -msgstr "" - -#: libcob/fileio.c:1365 -#, c-format -msgid "I/O routine %s is not present for %s" -msgstr "" - -#: libcob/fileio.c:1404 -#, c-format -msgid "I/O routine %s is not known for %s" -msgstr "" - -#: libcob/fileio.c:2599 -#, c-format -msgid "ERROR FILE %s has record size %d exceeds %d in program" -msgstr "" - -#: libcob/fileio.c:2967 libcob/fileio.c:2974 -#, c-format -msgid "ERROR FILE %s opening pipe" -msgstr "" - -#: libcob/fileio.c:4979 -#, c-format -msgid "ERROR FILE %s does not match current version; Recompile the program" -msgstr "" - -#: libcob/fileio.c:5034 -#, c-format -msgid "ERROR FILE %s has ASSIGN field is NULL" -msgstr "" - -#: libcob/fileio.c:5707 -#, c-format -msgid "call to CBL_OPEN_FILE with wrong access mode: %d" -msgstr "" - -#: libcob/fileio.c:5756 -#, c-format -msgid "call to CBL_CREATE_FILE with wrong file_lock: %d" -msgstr "" - -#: libcob/fileio.c:5759 -#, c-format -msgid "call to CBL_CREATE_FILE with wrong file_dev: %d" -msgstr "" - -#: libcob/fileio.c:5955 libcob/fileio.c:6215 -#, c-format -msgid "'%s' - File detail area is too short" -msgstr "" - -#: libcob/fileio.c:6437 -msgid "SORT is unable to acquire temporary file" -msgstr "" - -#: libcob/fileio.c:7057 -#, c-format -msgid "implicit CLOSE of %s" -msgstr "" - -#: libcob/fileio.c:7165 -#, c-format -msgid "C-ISAM library %s is not present" -msgstr "" - -#: libcob/fileio.c:7173 -#, c-format -msgid "D-ISAM library %s is not present" -msgstr "" - -#: libcob/fileio.c:7181 -#, c-format -msgid "VB-ISAM library %s is not present" -msgstr "" - -#: libcob/screenio.c:429 -msgid "failed to initialize curses" -msgstr "" - -#: libcob/screenio.c:3591 -msgid "end of program, please press a key to exit" -msgstr "" - -#: libcob/termio.c:70 libcob/termio.c:106 -msgid "(Not representable)" -msgstr "" - -#: libcob/termio.c:347 -#, c-format -msgid "cannot open %s (=%s)" -msgstr "" - -#: libcob/termio.c:362 -msgid "COB_DISPLAY_PUNCH_FILE is invalid, output to SYSPUNCH skipped" -msgstr "" - -#: bin/cobcrun.c:122 -msgid "GnuCOBOL module loader" -msgstr "" - -#: bin/cobcrun.c:124 -#, c-format -msgid "Usage: %s [options] PROGRAM [parameter ...]" -msgstr "" - -#: bin/cobcrun.c:126 -#, c-format -msgid " or: %s options" -msgstr "" - -#: bin/cobcrun.c:129 -msgid "Options:" -msgstr "" - -#: bin/cobcrun.c:130 -msgid " -h, -help display this help and exit" -msgstr "" - -#: bin/cobcrun.c:131 -msgid "" -" -V, -version display cobcrun and runtime version and exit" -msgstr "" - -#: bin/cobcrun.c:132 -msgid "" -" -i, -info display runtime information (build/" -"environment)" -msgstr "" - -#: bin/cobcrun.c:134 -msgid " -q, -brief reduced displays" -msgstr "" - -#: bin/cobcrun.c:136 -msgid " -c , -config= set runtime configuration from " -msgstr "" - -#: bin/cobcrun.c:137 -msgid "" -" -r, -runtime-config display current runtime configuration\n" -" (value and origin for all settings)" -msgstr "" - -#: bin/cobcrun.c:139 -msgid "" -" -M , -module= set entry point module name and/or load " -"path\n" -" where -M module prepends any directory to " -"the\n" -" dynamic link loader library search path\n" -" and any basename to the module preload " -"list\n" -" (COB_LIBRARY_PATH and/or COB_PRELOAD)" -msgstr "" - -#: bin/cobcrun.c:145 -#, c-format -msgid "" -"Report bugs to: %s\n" -"or (preferably) use the issue tracker via the home page." -msgstr "" - -#: bin/cobcrun.c:148 -msgid "GnuCOBOL home page: " -msgstr "" - -#: bin/cobcrun.c:149 -msgid "General help using GNU software: " -msgstr "" - -#: bin/cobcrun.c:274 -msgid "invalid configuration file name" -msgstr "" - -#: bin/cobcrun.c:325 -#, c-format -msgid "invalid module argument '%s'" -msgstr "" - -#: bin/cobcrun.c:377 -#, c-format -msgid "%s: missing PROGRAM name" -msgstr "" - -#: bin/cobcrun.c:379 -#, c-format -msgid "Try '%s --help' for more information." -msgstr "" - -#: bin/cobcrun.c:387 -#, c-format -msgid "%s: PROGRAM name exceeds %d characters" -msgstr "" diff -Nru gnucobol-4.0~early~20200606/po/insert-header.sin gnucobol-5/po/insert-header.sin --- gnucobol-4.0~early~20200606/po/insert-header.sin 2020-06-06 20:52:02.000000000 +0000 +++ gnucobol-5/po/insert-header.sin 1970-01-01 00:00:00.000000000 +0000 @@ -1,23 +0,0 @@ -# Sed script that inserts the file called HEADER before the header entry. -# -# At each occurrence of a line starting with "msgid ", we execute the following -# commands. At the first occurrence, insert the file. At the following -# occurrences, do nothing. The distinction between the first and the following -# occurrences is achieved by looking at the hold space. -/^msgid /{ -x -# Test if the hold space is empty. -s/m/m/ -ta -# Yes it was empty. First occurrence. Read the file. -r HEADER -# Output the file's contents by reading the next line. But don't lose the -# current line while doing this. -g -N -bb -:a -# The hold space was nonempty. Following occurrences. Do nothing. -x -:b -} Binary files /tmp/tmp8r0303vl/MzBWgGBJBM/gnucobol-4.0~early~20200606/po/it.gmo and /tmp/tmp8r0303vl/cieYbammgl/gnucobol-5/po/it.gmo differ diff -Nru gnucobol-4.0~early~20200606/po/it.po gnucobol-5/po/it.po --- gnucobol-4.0~early~20200606/po/it.po 2020-06-06 20:53:00.000000000 +0000 +++ gnucobol-5/po/it.po 1970-01-01 00:00:00.000000000 +0000 @@ -1,5615 +0,0 @@ -# Italian translations for GNU Cobol package -# Copyright (C) 2017 Free Software Foundation, Inc. -# This file is distributed under the same license as the gnucobol package. -# Sebastiano Pistore , 2017. -# -msgid "" -msgstr "" -"Project-Id-Version: gnucobol 2.2-rc1\n" -"Report-Msgid-Bugs-To: gnucobol-messages@gnu.org\n" -"POT-Creation-Date: 2020-06-06 20:52+0000\n" -"PO-Revision-Date: 2017-07-28 09:43+0200\n" -"Last-Translator: Sebastiano Pistore \n" -"Language-Team: Italian \n" -"Language: it\n" -"MIME-Version: 1.0\n" -"Content-Type: text/plain; charset=UTF-8\n" -"Content-Transfer-Encoding: 8bit\n" -"X-Bugs: Report translation errors to the Language-Team address.\n" -"X-Generator: Poedit 2.0.2\n" -"Plural-Forms: nplurals=2; plural=(n != 1);\n" - -#: cobc/cobc.c:117 -#, c-format -msgid "invalid parameter: %s" -msgstr "parametro non valido: %s" - -#: cobc/cobc.c:826 -msgid "too many errors" -msgstr "troppi errori" - -#: cobc/cobc.c:838 -#, fuzzy -msgid "internal compiler error" -msgstr "%s: %d: errore interno del compilatore" - -#: cobc/cobc.c:904 cobc/cobc.c:991 cobc/cobc.c:1051 cobc/cobc.c:1127 -#: cobc/cobc.c:1167 cobc/cobc.c:1243 -#, c-format -msgid "cannot allocate %d bytes of memory" -msgstr "non può riallocare %d byte di memoria" - -#: cobc/cobc.c:917 cobc/cobc.c:933 cobc/cobc.c:953 cobc/cobc.c:1011 -#: cobc/cobc.c:1029 cobc/cobc.c:1147 cobc/cobc.c:1262 cobc/cobc.c:1279 -#: cobc/field.c:2008 libcob/common.c:7121 -#, c-format -msgid "call to %s with NULL pointer" -msgstr "chiamata a %s con puntatore NULL" - -#: cobc/cobc.c:974 -#, c-format -msgid "cannot reallocate %d bytes of memory" -msgstr "non può riallocare %d byte di memoria" - -#: cobc/cobc.c:1068 cobc/cobc.c:1184 -msgid "attempt to reallocate non-allocated memory" -msgstr "" - -#: cobc/cobc.c:1101 cobc/cobc.c:1217 -#, c-format -msgid "call to %s with invalid pointer, as it is missing in list" -msgstr "" - -#: cobc/cobc.c:1390 -#, c-format -msgid "assuming literal for unquoted '%s'" -msgstr "" - -#: cobc/cobc.c:1437 -msgid " - length exceeds maximum" -msgstr "" - -#: cobc/cobc.c:1441 -msgid " - name cannot be empty" -msgstr "" - -#: cobc/cobc.c:1444 -msgid " - name cannot begin with space or underscore" -msgstr " - il nome non può iniziare con spazio o underscore" - -#: cobc/cobc.c:1447 -msgid " - name cannot begin with 'cob_' or 'COB_'" -msgstr " - il nome non può iniziare con 'cob_' oppure 'COB_'" - -#: cobc/cobc.c:1450 -msgid " - name duplicates a 'C' keyword" -msgstr " - il nome duplica una parola chiave del 'C'" - -#: cobc/cobc.c:1453 -msgid " - name cannot contain a directory separator" -msgstr " - il nome non può contenere separatori di directory" - -#: cobc/cobc.c:1462 -#, c-format -msgid "invalid file base name '%s'%s" -msgstr "" - -#: cobc/cobc.c:1466 -#, c-format -msgid "invalid ENTRY '%s'%s" -msgstr "" - -#: cobc/cobc.c:1469 -#, c-format -msgid "invalid PROGRAM-ID '%s'%s" -msgstr "PROGRAM-ID non valido '%s'%s" - -#: cobc/cobc.c:1596 cobc/cobc.c:8151 -msgid "please check environment variables as noted above" -msgstr "" - -#: cobc/cobc.c:1608 cobc/error.c:254 cobc/error.c:274 cobc/error.c:505 -#: cobc/error.c:528 -msgid "error: " -msgstr "errore: " - -#: cobc/cobc.c:1631 -#, c-format -msgid "duplicate DEFINE '%s' - ignored" -msgstr "" - -#: cobc/cobc.c:1683 -#, c-format -msgid "environment variable '%s' is '%s'; should not contain '%c'" -msgstr "" - -#: cobc/cobc.c:1712 -msgid "parameter buffer size exceeded" -msgstr "" - -#: cobc/cobc.c:1752 -#, c-format -msgid "warning: could not move temporary file to %s" -msgstr "" - -#: cobc/cobc.c:1957 cobc/cobc.c:1960 cobc/parser.y:803 cobc/reserved.c:3807 -#: libcob/common.c:761 libcob/common.c:1805 libcob/common.c:2002 -#: libcob/common.c:6325 libcob/common.c:7495 libcob/common.c:8025 -#: libcob/common.c:8104 -msgid "unknown" -msgstr "sconosciuto" - -#: cobc/cobc.c:1963 -#, c-format -msgid "aborting codegen for %s (%s: %s)" -msgstr "" - -#: cobc/cobc.c:1966 -#, c-format -msgid "aborting compile of %s at line %d (%s: %s)" -msgstr "" - -#: cobc/cobc.c:1970 -msgid "aborting" -msgstr "annullamento" - -#: cobc/cobc.c:1993 cobc/cobc.c:2028 libcob/common.c:7086 bin/cobcrun.c:342 -msgid "Please report this!" -msgstr "Per cortesia segnalare questo comportamento del software!" - -#: cobc/cobc.c:2046 bin/cobcrun.c:106 -#, fuzzy -msgid "License GPLv3+: GNU GPL version 3 or later " -msgstr "Licenza GPLv3+: GNU GPL versione 3 o successive " - -#: cobc/cobc.c:2047 libcob/common.c:7316 bin/cobcrun.c:107 -msgid "" -"This is free software; see the source for copying conditions. There is NO\n" -"warranty; not even for MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE." -msgstr "" - -#: cobc/cobc.c:2049 libcob/common.c:7318 bin/cobcrun.c:109 -#, c-format -msgid "Written by %s\n" -msgstr "Scritto da %s\n" - -#. TRANSLATORS: This msgid is indented as the "Packaged" msgid, %s expands to date and time -#: cobc/cobc.c:2050 cobc/cobc.c:2063 libcob/common.c:7321 bin/cobcrun.c:110 -#, c-format -msgid "Built %s" -msgstr "" - -#. TRANSLATORS: This msgid is indented as the "Built" msgid, %s expands to date and time -#: cobc/cobc.c:2052 cobc/cobc.c:2065 libcob/common.c:7324 bin/cobcrun.c:112 -#, c-format -msgid "Packaged %s" -msgstr "" - -#: cobc/cobc.c:2054 cobc/cobc.c:2067 -#, c-format -msgid "C version %s%s" -msgstr "La versione di C è %s%s" - -#: cobc/cobc.c:2080 -msgid "executing:" -msgstr "esecuzione:" - -#: cobc/cobc.c:2082 -msgid "to be executed:" -msgstr "" - -#: cobc/cobc.c:2120 cobc/cobc.c:2121 libcob/common.c:5815 libcob/common.c:5816 -#: libcob/common.c:5847 libcob/common.c:5848 -msgid "env" -msgstr "env" - -#: cobc/cobc.c:2156 libcob/common.c:7351 -msgid "build information" -msgstr "informazioni sulla compilazione" - -#: cobc/cobc.c:2157 libcob/common.c:7352 -msgid "build environment" -msgstr "ambiente di compilazione" - -#: cobc/cobc.c:2167 libcob/common.c:7363 -msgid "GnuCOBOL information" -msgstr "Informazioni su GnuCOBOL" - -#: cobc/cobc.c:2212 libcob/common.c:6366 libcob/common.c:7386 -#: libcob/common.c:7486 libcob/common.c:7493 -msgid "yes" -msgstr "sì" - -#: cobc/cobc.c:2214 libcob/common.c:6368 libcob/common.c:7388 -#: libcob/common.c:7488 -msgid "no" -msgstr "no" - -#: cobc/cobc.c:2218 libcob/common.c:7392 -msgid "8 bytes" -msgstr "8 byte" - -#: cobc/cobc.c:2220 libcob/common.c:7394 -msgid "4 bytes" -msgstr "4 byte" - -#: cobc/cobc.c:2224 cobc/cobc.c:2226 libcob/common.c:7398 libcob/common.c:7400 -msgid "endianness" -msgstr "" - -#: cobc/cobc.c:2224 libcob/common.c:7398 -msgid "big-endian" -msgstr "" - -#: cobc/cobc.c:2226 libcob/common.c:7400 -msgid "little-endian" -msgstr "" - -#: cobc/cobc.c:2230 cobc/cobc.c:2232 libcob/common.c:7404 libcob/common.c:7406 -msgid "native character set" -msgstr "" - -#: cobc/cobc.c:2230 libcob/common.c:7404 -msgid "EBCDIC" -msgstr "" - -#: cobc/cobc.c:2232 libcob/common.c:7406 -msgid "ASCII" -msgstr "" - -#: cobc/cobc.c:2235 libcob/common.c:7410 libcob/common.c:7476 -msgid "extended screen I/O" -msgstr "" - -#: cobc/cobc.c:2238 libcob/common.c:7502 -#, fuzzy -msgid "variable file format" -msgstr "formato variabile" - -#: cobc/cobc.c:2244 cobc/cobc.c:2246 libcob/common.c:7508 libcob/common.c:7510 -msgid "sequential file handler" -msgstr "" - -#: cobc/cobc.c:2246 libcob/common.c:7510 -msgid "built-in" -msgstr "" - -#: cobc/cobc.c:2254 cobc/cobc.c:2260 cobc/cobc.c:2262 cobc/cobc.c:2269 -#: cobc/cobc.c:2271 cobc/cobc.c:2275 cobc/cobc.c:2278 cobc/cobc.c:2282 -#: cobc/cobc.c:2284 cobc/cobc.c:2289 cobc/cobc.c:2291 cobc/cobc.c:2298 -#: cobc/cobc.c:2300 cobc/cobc.c:2307 libcob/common.c:7516 libcob/common.c:7527 -#: libcob/common.c:7533 libcob/common.c:7535 libcob/common.c:7539 -#: libcob/common.c:7542 libcob/common.c:7546 libcob/common.c:7548 -#: libcob/common.c:7553 libcob/common.c:7555 libcob/common.c:7562 -#: libcob/common.c:7564 libcob/common.c:7571 -msgid "indexed file handler" -msgstr "" - -#: cobc/cobc.c:2304 libcob/common.c:7568 -msgid "default indexed handler" -msgstr "" - -#: cobc/cobc.c:2307 cobc/cobc.c:2319 cobc/cobc.c:2325 libcob/common.c:7381 -#: libcob/common.c:7498 libcob/common.c:7571 libcob/common.c:7611 -#: libcob/common.c:7625 -msgid "disabled" -msgstr "disattivato" - -#: cobc/cobc.c:2311 cobc/cobc.c:2313 libcob/common.c:7594 libcob/common.c:7596 -msgid "mathematical library" -msgstr "libreria matematica" - -#: cobc/cobc.c:2317 cobc/cobc.c:2319 libcob/common.c:7605 libcob/common.c:7611 -msgid "XML library" -msgstr "" - -#: cobc/cobc.c:2323 cobc/cobc.c:2325 libcob/common.c:7623 libcob/common.c:7625 -msgid "JSON library" -msgstr "" - -#: cobc/cobc.c:2332 -msgid "only one of options 'E', 'S', 'C', 'c' may be specified" -msgstr "" - -#: cobc/cobc.c:2338 -msgid "only one of options 'm', 'x', 'b' may be specified" -msgstr "" - -#: cobc/cobc.c:2367 -#, c-format -msgid "-fdump= requires one of 'ALL', 'FD', 'WS', 'LS', 'RD', 'FD', 'SC' not '%s'" -msgstr "" - -#: cobc/cobc.c:2392 -#, c-format -msgid "'%s' is not an intrinsic function" -msgstr "" - -#: cobc/cobc.c:2434 cobc/cobc.c:7516 cobc/cobc.c:7630 cobc/codegen.c:3796 -#: cobc/codegen.c:3905 cobc/codegen.c:5221 cobc/codegen.c:12426 cobc/tree.c:789 -#: cobc/tree.c:1221 cobc/tree.c:4101 cobc/tree.c:4648 cobc/tree.c:4891 -#: cobc/typeck.c:3294 cobc/typeck.c:7812 cobc/typeck.c:7847 cobc/typeck.c:8660 -#: cobc/typeck.c:11261 cobc/typeck.c:11329 cobc/typeck.c:11397 -#: cobc/typeck.c:11681 cobc/typeck.c:11724 -#, c-format -msgid "call to '%s' with invalid parameter '%s'" -msgstr "" - -#: cobc/cobc.c:2737 -msgid "loading standard configuration file 'default.conf'" -msgstr "" - -#: cobc/cobc.c:2871 -msgid "invalid output file name" -msgstr "" - -#: cobc/cobc.c:2971 -#, c-format -msgid "warning: '%s' is not a directory, defaulting to current directory" -msgstr "" - -#: cobc/cobc.c:2998 -#, c-format -msgid "warning: %d lines per listing page specified, using %d" -msgstr "" - -#: cobc/cobc.c:3048 -#, c-format -msgid "warning: assuming '%s' is a DEFINE - did you intend to use -debug?" -msgstr "" - -#: cobc/cobc.c:3315 -#, c-format -msgid "unknown warning option '%s'" -msgstr "" - -#: cobc/cobc.c:3367 -#, c-format -msgid "%s option requires a listing file" -msgstr "" - -#: cobc/cobc.c:3374 -msgid "output to stdout only valid for preprocess" -msgstr "" - -#: cobc/cobc.c:3466 -msgid "all runtime checks are enabled" -msgstr "" - -#: cobc/cobc.c:3572 -msgid "only one stdin input allowed" -msgstr "" - -#: cobc/cobc.c:3582 -#, c-format -msgid "invalid file name parameter (length > %d)" -msgstr "" - -#: cobc/cobc.c:3807 -msgid "nothing for -j to run" -msgstr "" - -#: cobc/cobc.c:3883 cobc/cobc.c:4071 cobc/cobc.c:4130 cobc/cobc.c:4158 -#: cobc/cobc.c:4247 cobc/cobc.c:4306 cobc/cobc.c:4430 cobc/cobc.c:4469 -#: cobc/cobc.c:6993 -msgid "return status:" -msgstr "" - -#: cobc/cobc.c:4361 -msgid "preprocessing:" -msgstr "preprocessing:" - -#: cobc/cobc.c:4435 -msgid "'cobxref' execution unsuccessful" -msgstr "" - -#: cobc/cobc.c:4438 -#, c-format -msgid "check that 'cobxref' is in %s" -msgstr "" - -#: cobc/cobc.c:4440 -msgid "no listing produced" -msgstr "" - -#: cobc/cobc.c:5328 cobc/cobc.c:5367 -msgid "No fields defined." -msgstr "" - -#: cobc/cobc.c:5387 -msgid "No labels defined." -msgstr "" - -#: cobc/cobc.c:5409 -msgid "Error/Warning summary:" -msgstr "" - -#: cobc/cobc.c:5453 -msgid "0 warnings in compilation group" -msgstr "" - -#: cobc/cobc.c:5457 -msgid "1 warning in compilation group" -msgstr "" - -#: cobc/cobc.c:5461 -#, c-format -msgid "%d warnings in compilation group" -msgstr "" - -#: cobc/cobc.c:5467 -msgid "0 errors in compilation group" -msgstr "" - -#: cobc/cobc.c:5471 -msgid "1 error in compilation group" -msgstr "" - -#: cobc/cobc.c:5475 -#, c-format -msgid "%d errors in compilation group" -msgstr "" - -#: cobc/cobc.c:5481 -#, c-format -msgid "Too many errors in compilation group: %d maximum errors" -msgstr "" - -#: cobc/cobc.c:6050 -#, c-format -msgid "%s: %d: Too many continuation lines" -msgstr "" - -#: cobc/cobc.c:6972 -msgid "parsing:" -msgstr "" - -#: cobc/cobc.c:7034 -msgid "translating:" -msgstr "" - -#: cobc/cobc.c:8157 -msgid "no input files" -msgstr "" - -#: cobc/cobc.c:8186 -#, c-format -msgid "%s option invalid in this combination" -msgstr "" - -#: cobc/cobc.c:8227 -msgid "command line:" -msgstr "linea di comando:" - -#: cobc/codegen.c:973 cobc/codegen.c:4487 cobc/codegen.c:11093 -msgid "unexpected CONSTANT item" -msgstr "" - -#: cobc/codegen.c:1188 cobc/codegen.c:1196 cobc/codegen.c:1291 -#: cobc/codegen.c:1603 cobc/codegen.c:2202 cobc/codegen.c:3212 -#: cobc/codegen.c:3455 cobc/codegen.c:3988 cobc/codegen.c:4454 -#: cobc/codegen.c:7902 cobc/codegen.c:8507 cobc/codegen.c:10298 -#: cobc/field.c:817 cobc/scanner.l:2104 cobc/tree.c:611 cobc/tree.c:3728 -#: cobc/typeck.c:5015 cobc/typeck.c:8662 cobc/typeck.c:9657 -#, c-format -msgid "unexpected tree tag: %d" -msgstr "" - -#: cobc/codegen.c:2999 cobc/codegen.c:3295 cobc/codegen.c:8125 cobc/tree.c:1243 -#, c-format -msgid "unexpected cast type: %d" -msgstr "" - -#: cobc/codegen.c:3725 cobc/codegen.c:4434 -#, c-format -msgid "internal statement stack depth exceeded: %d" -msgstr "" - -#: cobc/codegen.c:3798 -#, c-format -msgid "%s is not a field" -msgstr "" - -#: cobc/codegen.c:4186 cobc/codegen.c:4279 -#, c-format -msgid "unexpected function: %s" -msgstr "" - -#: cobc/codegen.c:4270 -#, c-format -msgid "unexpected operator: %c" -msgstr "" - -#: cobc/codegen.c:5043 -#, c-format -msgid "unexpected tree category: %d" -msgstr "" - -#: cobc/codegen.c:5438 cobc/codegen.c:5465 cobc/codegen.c:5662 -#: cobc/codegen.c:5694 -#, c-format -msgid "unexpected size: %d" -msgstr "" - -#: cobc/codegen.c:7254 -#, c-format -msgid "No ENTRY FOR GO TO '%s'" -msgstr "" - -#: cobc/codegen.c:7475 cobc/codegen.c:7725 -#, c-format -msgid "unexpected handler type: %d" -msgstr "" - -#: cobc/codegen.c:7823 -msgid "unexpected error_node parameter" -msgstr "" - -#: cobc/codegen.c:8146 -#, c-format -msgid "unexpected tree type: %d" -msgstr "" - -#: cobc/codegen.c:8703 cobc/typeck.c:6511 cobc/typeck.c:12940 -#: cobc/typeck.c:12984 -#, c-format -msgid "compiler is not configured to support %s" -msgstr "" - -#: cobc/codegen.c:9128 -msgid "Nested OCCURS in report" -msgstr "" - -#: cobc/codeoptim.c:2762 -#, c-format -msgid "unexpected optimization value: %d" -msgstr "" - -#: cobc/config.c:162 libcob/common.c:6786 libcob/common.c:6800 -#: libcob/common.c:7242 -#, c-format -msgid "invalid value '%s' for configuration tag '%s'" -msgstr "" - -#: cobc/config.c:165 libcob/common.c:6093 libcob/common.c:6209 -#, c-format -msgid "should be one of the following values: %s" -msgstr "" - -#: cobc/config.c:167 -msgid "must be numeric" -msgstr "deve essere un numero" - -#: cobc/config.c:169 libcob/common.c:6191 -#, c-format -msgid "maximum value: %lu" -msgstr "" - -#: cobc/config.c:171 -#, c-format -msgid "minimum value: %d" -msgstr "" - -#: cobc/config.c:203 -#, c-format -msgid "unsupported value '%s' for configuration tag '%s'" -msgstr "" - -#: cobc/config.c:311 cobc/pplex.l:977 libcob/common.c:6702 -msgid "recursive inclusion" -msgstr "" - -#: cobc/config.c:386 libcob/common.c:6753 -msgid "configuration file was included here" -msgstr "" - -#: cobc/config.c:415 -#, c-format -msgid "The previous loaded configuration '%s' will be discarded." -msgstr "" - -#: cobc/config.c:449 -msgid "missing definitions:" -msgstr "definizioni mancanti:" - -#: cobc/config.c:451 -#, c-format -msgid "\tno definition of '%s'" -msgstr "" - -#: cobc/config.c:512 -#, c-format -msgid "invalid configuration tag '%s'" -msgstr "" - -#: cobc/config.c:525 libcob/common.c:6509 libcob/common.c:6592 -#: libcob/common.c:6620 -#, c-format -msgid "unknown configuration tag '%s'" -msgstr "" - -#: cobc/config.c:549 -#, c-format -msgid "invalid configuration tag '%s' in word-list" -msgstr "" - -#: cobc/config.c:608 -#, c-format -msgid "Could not access word list for '%s'" -msgstr "" - -#: cobc/error.c:87 -#, c-format -msgid "in section '%s':" -msgstr "" - -#: cobc/error.c:98 -#, c-format -msgid "in paragraph '%s':" -msgstr "" - -#: cobc/error.c:121 libcob/common.c:7252 -msgid "configuration error:" -msgstr "" - -#: cobc/error.c:134 libcob/common.c:673 -#, c-format -msgid "system error %d" -msgstr "" - -#: cobc/error.c:231 cobc/error.c:323 cobc/error.c:478 -msgid "error [-Werror]: " -msgstr "" - -#: cobc/error.c:231 cobc/error.c:323 cobc/error.c:478 cobc/error.c:505 -#: libcob/common.c:6881 libcob/common.c:6906 -#, c-format -msgid "warning: " -msgstr "warning: " - -#: cobc/error.c:274 cobc/error.c:528 -msgid "error (ignored): " -msgstr "" - -#: cobc/error.c:364 cobc/error.c:380 cobc/error.c:563 cobc/error.c:584 -#, c-format -msgid "%s used" -msgstr "" - -#: cobc/error.c:367 cobc/error.c:566 -#, c-format -msgid "%s is archaic in %s" -msgstr "" - -#: cobc/error.c:371 cobc/error.c:570 -#, c-format -msgid "%s is obsolete in %s" -msgstr "%s è obsoleto in %s" - -#: cobc/error.c:377 cobc/error.c:576 cobc/parser.y:5186 cobc/parser.y:5325 -#, c-format -msgid "%s ignored" -msgstr "" - -#: cobc/error.c:383 cobc/error.c:586 -#, c-format -msgid "%s does not conform to %s" -msgstr "" - -#: cobc/error.c:399 -msgid "configuration warning:" -msgstr "" - -#: cobc/error.c:621 cobc/error.c:640 -#, c-format -msgid "redefinition of '%s'" -msgstr "" - -#: cobc/error.c:628 cobc/error.c:653 -#, c-format -msgid "'%s' previously defined here" -msgstr "" - -#: cobc/error.c:677 cobc/error.c:684 -#, c-format -msgid "'%s' is not defined" -msgstr "" - -#: cobc/error.c:680 -#, c-format -msgid "'%s' cannot be used here" -msgstr "" - -#: cobc/error.c:682 cobc/parser.y:7009 -#, c-format -msgid "'%s' is not defined, but is a reserved word in another dialect" -msgstr "" - -#: cobc/error.c:716 -#, c-format -msgid "'%s' is ambiguous; needs qualification" -msgstr "" - -#: cobc/error.c:746 cobc/parser.y:16748 -#, c-format -msgid "'%s' defined here" -msgstr "" - -#: cobc/error.c:757 -#, c-format -msgid "fatal error: %s" -msgstr "errore irreversibile: %s" - -#: cobc/error.c:765 -#, c-format -msgid "group item '%s' cannot have %s clause" -msgstr "" - -#: cobc/error.c:779 -#, c-format -msgid "constant item '%s' requires a %s clause" -msgstr "" - -#: cobc/error.c:781 -#, c-format -msgid "level %02d item '%s' requires a %s clause" -msgstr "" - -#: cobc/error.c:795 -#, c-format -msgid "constant item '%s' can only have a %s clause" -msgstr "" - -#: cobc/error.c:797 -#, c-format -msgid "level %02d item '%s' can only have a %s clause" -msgstr "" - -#: cobc/field.c:131 -msgid "constant expression has Divide by ZERO" -msgstr "" - -#: cobc/field.c:187 cobc/field.c:324 cobc/field.c:332 -msgid "missing right parenthesis" -msgstr "parentesi destra mancante" - -#: cobc/field.c:216 -#, c-format -msgid "expression stack overflow at %d entries for operation '%c'" -msgstr "" - -#: cobc/field.c:257 -#, c-format -msgid "expression stack overflow at %d entries" -msgstr "" - -#: cobc/field.c:274 -msgid "missing left parenthesis" -msgstr "parentesi sinistra mancante" - -#: cobc/field.c:315 -#, c-format -msgid "invalid operator '%s' in expression" -msgstr "" - -#: cobc/field.c:334 -#, c-format -msgid "'%c' operator misplaced" -msgstr "" - -#: cobc/field.c:395 -#, c-format -msgid "invalid level number '%s'" -msgstr "" - -#: cobc/field.c:454 -msgid "entry following SAME AS may not be subordinate to it" -msgstr "" - -#: cobc/field.c:459 cobc/field.c:496 -msgid "level number must begin with 01 or 77" -msgstr "" - -#: cobc/field.c:541 cobc/field.c:557 -#, c-format -msgid "no previous data item of level %02d" -msgstr "" - -#: cobc/field.c:599 -#, c-format -msgid "'%s' cannot be qualified here" -msgstr "" - -#: cobc/field.c:605 -#, c-format -msgid "'%s' cannot be subscripted here" -msgstr "" - -#: cobc/field.c:617 -#, c-format -msgid "'%s' is not defined in '%s'" -msgstr "" - -#: cobc/field.c:638 -msgid "level number of REDEFINES entries must be identical" -msgstr "" - -#: cobc/field.c:643 -#, c-format -msgid "'%s' is not the original definition" -msgstr "" - -#: cobc/field.c:758 -#, c-format -msgid "PICTURE clause not compatible with USAGE %s" -msgstr "" - -#: cobc/field.c:855 cobc/field.c:930 cobc/field.c:941 -#, c-format -msgid "PICTURE clause required for '%s'" -msgstr "" - -#: cobc/field.c:937 -#, c-format -msgid "a non-numeric literal is expected for '%s'" -msgstr "" - -#: cobc/field.c:949 -#, c-format -msgid "defining implicit picture size %d for '%s'" -msgstr "" - -#: cobc/field.c:969 -#, c-format -msgid "'%s' ANY LENGTH only allowed in LINKAGE" -msgstr "" - -#: cobc/field.c:973 -#, c-format -msgid "'%s' ANY LENGTH must be 01 level" -msgstr "" - -#: cobc/field.c:977 -#, c-format -msgid "'%s' ANY LENGTH cannot be BASED/EXTERNAL" -msgstr "" - -#: cobc/field.c:982 cobc/field.c:1010 -#, c-format -msgid "'%s' ANY LENGTH has invalid definition" -msgstr "" - -#: cobc/field.c:993 -#, c-format -msgid "'%s' ANY NUMERIC must be PIC 9" -msgstr "" - -#: cobc/field.c:998 -#, c-format -msgid "'%s' ANY LENGTH must be PIC X or PIC N" -msgstr "" - -#: cobc/field.c:1008 -#, c-format -msgid "'%s' ANY NUMERIC has invalid definition" -msgstr "" - -#: cobc/field.c:1026 -#, c-format -msgid "'%s' EXTERNAL must be specified at 01/77 level" -msgstr "" - -#: cobc/field.c:1030 -#, c-format -msgid "'%s' EXTERNAL can only be specified in WORKING-STORAGE section" -msgstr "" - -#: cobc/field.c:1034 -#, c-format -msgid "'%s' EXTERNAL and BASED are mutually exclusive" -msgstr "" - -#: cobc/field.c:1037 -#, c-format -msgid "'%s' EXTERNAL not allowed with REDEFINES" -msgstr "" - -#: cobc/field.c:1049 -#, c-format -msgid "'%s' BASED not allowed here" -msgstr "" - -#: cobc/field.c:1052 -#, c-format -msgid "'%s' BASED not allowed with REDEFINES" -msgstr "" - -#: cobc/field.c:1055 -#, c-format -msgid "'%s' BASED only allowed at the 01 and 77 levels" -msgstr "" - -#: cobc/field.c:1067 -#, c-format -msgid "level %02d item '%s' cannot have a %s clause" -msgstr "" - -#: cobc/field.c:1082 -#, c-format -msgid "'%s' cannot have the OCCURS clause due to '%s'" -msgstr "" - -#: cobc/field.c:1101 -#, c-format -msgid "the original definition '%s' should not have OCCURS clause" -msgstr "" - -#: cobc/field.c:1108 -msgid "REDEFINES must follow the original definition" -msgstr "" - -#: cobc/field.c:1115 -#, c-format -msgid "'%s' cannot be variable length" -msgstr "" - -#: cobc/field.c:1118 -#, c-format -msgid "the original definition '%s' cannot be variable length" -msgstr "" - -#: cobc/field.c:1142 -#, c-format -msgid "SCREEN group item '%s' has invalid clause" -msgstr "" - -#: cobc/field.c:1223 -#, c-format -msgid "%s USAGE %s incompatible with %s USAGE %s" -msgstr "" - -#: cobc/field.c:1302 -#, c-format -msgid "'%s' cannot have PICTURE clause" -msgstr "" - -#: cobc/field.c:1318 cobc/field.c:1328 -#, c-format -msgid "%s item '%s' should be USAGE DISPLAY" -msgstr "" - -#: cobc/field.c:1351 -#, c-format -msgid "'%s' COMP-6 with sign - changing to COMP-3" -msgstr "" - -#: cobc/field.c:1377 -msgid "elementary items with SIGN clause must have S in PICTURE" -msgstr "" - -#: cobc/field.c:1380 -msgid "elementary items with SIGN clause must be USAGE DISPLAY or NATIONAL" -msgstr "" - -#: cobc/field.c:1397 -#, c-format -msgid "'%s' cannot have JUSTIFIED RIGHT" -msgstr "" - -#: cobc/field.c:1410 -#, c-format -msgid "'%s' cannot have S in PICTURE string and BLANK WHEN ZERO" -msgstr "" - -#: cobc/field.c:1415 -#, c-format -msgid "'%s' cannot have BLANK WHEN ZERO without being USAGE DISPLAY or NATIONAL" -msgstr "" - -#: cobc/field.c:1426 -#, c-format -msgid "'%s' cannot have * in PICTURE string and BLANK WHEN ZERO" -msgstr "" - -#: cobc/field.c:1433 -#, c-format -msgid "'%s' is not numeric, so cannot have BLANK WHEN ZERO" -msgstr "" - -#: cobc/field.c:1446 -msgid "only level 88 items may have multiple values" -msgstr "" - -#: cobc/field.c:1454 cobc/field.c:1458 -#, c-format -msgid "initial VALUE clause ignored for %s item '%s'" -msgstr "" - -#: cobc/field.c:1471 -msgid "FULL has no effect on numeric items; you may want REQUIRED or PIC Z" -msgstr "" - -#: cobc/field.c:1499 -msgid "VALUE may not contain a figurative constant" -msgstr "" - -#: cobc/field.c:1507 -msgid "cannot specify both FULL and JUSTIFIED" -msgstr "" - -#: cobc/field.c:1519 -#, c-format -msgid "'%s' has FROM, TO or USING without PIC; PIC will be implied" -msgstr "" - -#: cobc/field.c:1533 -#, c-format -msgid "'%s' has numeric VALUE without PIC; PIC will be implied" -msgstr "" - -#: cobc/field.c:1548 -#, c-format -msgid "'%s' cannot have PIC without FROM, TO, USING or numeric VALUE" -msgstr "" - -#: cobc/field.c:1560 -#, c-format -msgid "'%s' needs a PIC, FROM, TO, USING, VALUE, BELL, BLANK or ERASE clause" -msgstr "" - -#: cobc/field.c:1574 -msgid "cannot specify both PIC and VALUE" -msgstr "" - -#: cobc/field.c:1582 -msgid "cannot have PIC without FROM, TO or USING" -msgstr "" - -#: cobc/field.c:1591 -msgid "cannot have FROM, TO or USING without PIC" -msgstr "" - -#: cobc/field.c:1600 -msgid "VALUE item may not be numeric" -msgstr "" - -#: cobc/field.c:1616 -#, c-format -msgid "'%s' needs a PIC, COL, LINE, VALUE, BELL or BLANK clause" -msgstr "" - -#: cobc/field.c:1647 -msgid "cannot use AUTO, FULL, PROMPT, REQUIRED or SECURE on elementary item without TO or USING" -msgstr "" - -#: cobc/field.c:1654 -msgid "cannot use BLANK WHEN ZERO, JUSTIFIED, OCCURS or SIGN on item without FROM, TO or USING" -msgstr "" - -#: cobc/field.c:1674 -msgid "cannot use AUTO, FULL, REQUIRED or SECURE on elementary item without FROM, TO or USING" -msgstr "" - -#: cobc/field.c:1679 -msgid "cannot use BLANK WHEN ZERO, JUSTIFIED or SIGN without FROM, TO or USING" -msgstr "" - -#: cobc/field.c:1697 -msgid "cannot have BLANK WHEN ZERO without PIC" -msgstr "" - -#: cobc/field.c:1700 -msgid "cannot have JUSTIFIED without PIC" -msgstr "" - -#: cobc/field.c:1720 -msgid "cannot have AUTO without FROM, TO or USING" -msgstr "" - -#: cobc/field.c:1725 -msgid "cannot use FULL or REQUIRED on item without TO or USING" -msgstr "" - -#: cobc/field.c:1732 -msgid "SECURE can be used with TO only" -msgstr "" - -#: cobc/field.c:1734 -msgid "SECURE must be used with TO" -msgstr "" - -#: cobc/field.c:1753 -#, fuzzy, c-format -msgid "'%s' does nothing" -msgstr "'%s' non è un integer" - -#: cobc/field.c:1797 -msgid "BLANK ZERO not compatible with USAGE" -msgstr "" - -#: cobc/field.c:1800 -msgid "SIGN clause not compatible with USAGE" -msgstr "" - -#: cobc/field.c:1977 -#, c-format -msgid "'%s' PICTURE clause not compatible with USAGE" -msgstr "" - -#: cobc/field.c:2027 -#, c-format -msgid "'%s' 77 level is not allowed here" -msgstr "" - -#: cobc/field.c:2424 -msgid "OCCURS and multi COLUMNs is not allowed" -msgstr "" - -#: cobc/field.c:2452 -#, c-format -msgid "duplicate LINE %d ignored" -msgstr "" - -#: cobc/field.c:2469 -#, c-format -msgid "ignoring SYNCHRONIZED for group item '%s'" -msgstr "" - -#: cobc/field.c:2485 cobc/field.c:2498 cobc/field.c:2778 cobc/field.c:2781 -#, c-format -msgid "size of '%s' larger than size of '%s'" -msgstr "" - -#: cobc/field.c:2638 cobc/field.c:2703 -#, c-format -msgid "'%s' cannot be larger than %d bytes" -msgstr "" - -#: cobc/field.c:2676 cobc/field.c:2684 -#, c-format -msgid "'%s' binary field cannot be larger than %d digits" -msgstr "" - -#: cobc/field.c:2764 cobc/field.c:3216 -#, c-format -msgid "unexpected USAGE: %d" -msgstr "" - -#: cobc/field.c:2876 -msgid "literal type does not match numeric data type" -msgstr "" - -#: cobc/field.c:2953 -#, c-format -msgid "THRU item '%s' may not come before '%s'" -msgstr "" - -#: cobc/field.c:2976 -#, c-format -msgid "RENAMES cannot start/end at the OCCURS item '%s'" -msgstr "" - -#: cobc/field.c:2984 -#, c-format -msgid "cannot use RENAMES on part of the table '%s'" -msgstr "" - -#: cobc/field.c:3022 -#, c-format -msgid "RENAMES may not contain '%s' as it is a pointer or object reference" -msgstr "" - -#: cobc/field.c:3027 -#, c-format -msgid "RENAMES may not contain '%s' as it is an OCCURS DEPENDING table" -msgstr "" - -#: cobc/field.c:3049 -msgid "RENAMES of 01-, 66- and 77-level items" -msgstr "" - -#: cobc/field.c:3051 -msgid "RENAMES may not reference a level 88" -msgstr "" - -#: cobc/field.c:3075 -#, c-format -msgid "'%s' must immediately follow the record '%s'" -msgstr "" - -#: cobc/field.c:3083 -#, c-format -msgid "THRU item must be different to '%s'" -msgstr "" - -#: cobc/field.c:3089 -#, c-format -msgid "'%s' and '%s' must be in the same record" -msgstr "" - -#: cobc/field.c:3100 -#, c-format -msgid "THRU item '%s' may not be subordinate to '%s'" -msgstr "" - -#: cobc/flag.def:40 -msgid "" -" -fstack-size=\tdefine PERFORM stack size\n" -" * default: 255" -msgstr "" - -#: cobc/flag.def:44 -msgid "" -" -fsign=[ASCII|EBCDIC]\tdefine display sign representation\n" -" * default: machine native" -msgstr "" - -#: cobc/flag.def:48 -msgid "" -" -ffold-copy=[UPPER|LOWER]\tfold COPY subject to value\n" -" * default: no transformation" -msgstr "" - -#: cobc/flag.def:52 -msgid "" -" -ffold-call=[UPPER|LOWER]\tfold PROGRAM-ID, CALL, CANCEL subject to value\n" -" * default: no transformation" -msgstr "" - -#: cobc/flag.def:56 -msgid "" -" -fdefaultbyte=\tinitialize fields without VALUE to value\n" -" * decimal 0..255 or any quoted character\n" -" * default: initialize to picture" -msgstr "" - -#: cobc/flag.def:61 -msgid "" -" -fmax-errors=\tmaximum number of errors to report before\n" -" compilation is aborted\n" -" * default: 128" -msgstr "" - -#: cobc/flag.def:68 -msgid "" -" -fintrinsics=[ALL|intrinsic function name(,name,...)]\n" -" intrinsics to be used without FUNCTION keyword" -msgstr "" - -#: cobc/flag.def:72 -msgid "" -" -fdump= dump data fields on abort, may be\n" -" a combination of: ALL, WS, LS, RD, FD, SC" -msgstr "" - -#: cobc/flag.def:76 -msgid "" -" -fcallfh= use external provided EXTFH interface module\n" -" for I/O" -msgstr "" - -#: cobc/flag.def:80 -msgid "" -" -fsqldb= which Database is used, may be\n" -" MySQL, MSSQL, Oracle10, Oracle11, Oracle12" -msgstr "" - -#: cobc/flag.def:84 -msgid " -fsqlschema= define database schema name" -msgstr "" - -#: cobc/flag.def:91 -msgid "" -" -fno-recursive-check disable check of recursive program call;\n" -" effectively compiling as RECURSIVE program" -msgstr "" - -#: cobc/flag.def:95 -msgid "" -" -fwinmain generate WinMain instead of main when compiling\n" -" as executable" -msgstr "" - -#: cobc/flag.def:99 -msgid " -fcomputed-goto generate computed goto C statements" -msgstr "" - -#: cobc/flag.def:102 -msgid " -falternate-ebcdic use restricted ASCII to EBCDIC translate" -msgstr "" - -#: cobc/flag.def:105 -msgid " -fextra-brace generate extra braces in C source" -msgstr "" - -#: cobc/flag.def:108 -msgid " -fgen-c-line-directives\tgenerate source location directives in C code" -msgstr "" - -#: cobc/flag.def:111 -msgid " -fgen-c-labels generate extra labels in C sources" -msgstr "" - -#: cobc/flag.def:114 -msgid " -fcorrect-numeric attempt correction of invalid numeric display items" -msgstr "" - -#: cobc/flag.def:117 -msgid " -fstack-on-heap PERFORM stack allocated on heap" -msgstr "" - -#: cobc/flag.def:120 -msgid " -ffast-math Disables emitting faster arithmetic logic" -msgstr "" - -#: cobc/flag.def:125 -msgid "" -" -fno-remove-unreachable\tdisable remove of unreachable code\n" -" * turned off by -g" -msgstr "" - -#: cobc/flag.def:129 -msgid " -finline-intrinsic\twhen possible resolve intrinsic FUNCTIONs at compile time" -msgstr "" - -#: cobc/flag.def:132 -msgid "" -" -ftrace generate trace code\n" -" * scope: executed SECTION/PARAGRAPH" -msgstr "" - -#: cobc/flag.def:136 -msgid "" -" -ftraceall generate trace code\n" -" * scope: executed SECTION/PARAGRAPH/STATEMENTS\n" -" * turned on by -debug" -msgstr "" - -#: cobc/flag.def:141 -msgid " -fsyntax-only syntax error checking only; don't emit any output" -msgstr "" - -#: cobc/flag.def:144 -msgid "" -" -fdebugging-line enable debugging lines\n" -" * 'D' in indicator column or floating >>D" -msgstr "" - -#: cobc/flag.def:148 -msgid "" -" -fsource-location generate source location code\n" -" * turned on by -debug/-g/-ftraceall" -msgstr "" - -#: cobc/flag.def:152 -msgid " -fimplicit-init automatic initialization of the COBOL runtime system" -msgstr "" - -#: cobc/flag.def:155 -msgid "" -" -fstack-check PERFORM stack checking\n" -" * turned on by -debug or -g" -msgstr "" - -#: cobc/flag.def:159 -msgid "" -" -fwrite-after use AFTER 1 for WRITE of LINE SEQUENTIAL\n" -" * default: BEFORE 1" -msgstr "" - -#: cobc/flag.def:163 -msgid "" -" -fmfcomment '*' or '/' in column 1 treated as comment\n" -" * FIXED format only" -msgstr "" - -#: cobc/flag.def:167 -msgid "" -" -facucomment '$' in indicator area treated as '*',\n" -" '|' treated as floating comment" -msgstr "" - -#: cobc/flag.def:171 -msgid "" -" -fnotrunc allow numeric field overflow\n" -" * non-ANSI behaviour" -msgstr "" - -#: cobc/flag.def:175 -msgid "" -" -fodoslide adjust items following OCCURS DEPENDING\n" -" * implies -fcomplex-odo" -msgstr "" - -#: cobc/flag.def:179 -msgid "" -" -fsingle-quote use a single quote (apostrophe) for QUOTE\n" -" * default: double quote" -msgstr "" - -#: cobc/flag.def:189 -msgid "" -" -foptional-file treat all files as OPTIONAL\n" -" * unless NOT OPTIONAL specified" -msgstr "" - -#: cobc/flag.def:193 -msgid " -fstatic-call output static function calls for the CALL statement" -msgstr "" - -#: cobc/flag.def:196 -msgid "" -" -fno-gen-c-decl-static-call\tdisable generation of C function declations\n" -" for subroutines with static CALL" -msgstr "" - -#: cobc/flag.def:200 -msgid " -fmf-files Sequential & Relative files will match Micro Focus format" -msgstr "" - -#: cobc/flag.def:203 -msgid "" -" -fno-theaders suppress all headers and output of compilation\n" -" options from listing while keeping page breaks" -msgstr "" - -#: cobc/flag.def:207 -msgid " -fno-tsource suppress source from listing" -msgstr "" - -#: cobc/flag.def:210 -msgid " -fno-tmessages suppress warning and error summary from listing" -msgstr "" - -#: cobc/flag.def:213 -msgid " -ftsymbols specify symbols in listing" -msgstr "" - -#: cobc/parser.y:283 cobc/parser.y:317 -#, c-format -msgid "unreachable statement '%s'" -msgstr "" - -#: cobc/parser.y:410 cobc/parser.y:703 -#, c-format -msgid "'%s' is not in LINKAGE SECTION" -msgstr "" - -#: cobc/parser.y:413 cobc/typeck.c:3705 -#, c-format -msgid "'%s' cannot be BASED/EXTERNAL" -msgstr "" - -#: cobc/parser.y:418 -#, c-format -msgid "'%s' is not in WORKING-STORAGE SECTION" -msgstr "" - -#: cobc/parser.y:425 cobc/typeck.c:3702 -#, c-format -msgid "'%s' not level 01 or 77" -msgstr "" - -#: cobc/parser.y:428 cobc/parser.y:443 cobc/typeck.c:3708 -#, c-format -msgid "'%s' REDEFINES field not allowed here" -msgstr "" - -#: cobc/parser.y:456 -#, c-format -msgid "'%s' USING item duplicates RETURNING item" -msgstr "" - -#: cobc/parser.y:466 -#, c-format -msgid "ENTRY '%s' duplicated" -msgstr "" - -#: cobc/parser.y:502 -#, c-format -msgid "ENTRY FOR GO TO '%s' duplicated" -msgstr "" - -#: cobc/parser.y:518 -#, c-format -msgid "maximum nested program depth exceeded (%d)" -msgstr "" - -#: cobc/parser.y:544 cobc/parser.y:571 -#, c-format -msgid "%s statement not terminated by %s" -msgstr "" - -#: cobc/parser.y:574 -#, c-format -msgid "%s statement not terminated" -msgstr "" - -#: cobc/parser.y:638 -msgid "USE statement invalid for SORT file" -msgstr "" - -#: cobc/parser.y:665 cobc/parser.y:667 -#, c-format -msgid "duplicate %s clause" -msgstr "" - -#: cobc/parser.y:685 -#, c-format -msgid "Cannot specify %s without number of lines on page" -msgstr "" - -#: cobc/parser.y:695 -#, c-format -msgid "maximum OCCURS depth exceeded (%d)" -msgstr "" - -#: cobc/parser.y:709 cobc/parser.y:711 cobc/parser.y:6808 cobc/parser.y:6811 -#: cobc/parser.y:6813 cobc/parser.y:6815 cobc/parser.y:6850 cobc/parser.y:7573 -#: cobc/parser.y:7575 cobc/parser.y:7577 cobc/parser.y:7579 cobc/parser.y:7625 -#: cobc/parser.y:7634 cobc/parser.y:9548 cobc/parser.y:10994 -#: cobc/parser.y:12370 cobc/parser.y:13552 -#, c-format -msgid "%s and %s are mutually exclusive" -msgstr "" - -#: cobc/parser.y:725 cobc/parser.y:729 -msgid "TO phrase without DEPENDING phrase" -msgstr "" - -#: cobc/parser.y:726 -msgid "maximum number of occurrences assumed to be exact number" -msgstr "" - -#: cobc/parser.y:733 cobc/parser.y:7355 -msgid "OCCURS TO must be greater than OCCURS FROM" -msgstr "" - -#: cobc/parser.y:742 -msgid "OCCURS DEPENDING ON without TO phrase" -msgstr "" - -#: cobc/parser.y:808 -#, c-format -msgid "%s header missing - assumed" -msgstr "" - -#: cobc/parser.y:810 -#, c-format -msgid "%s header missing" -msgstr "" - -#: cobc/parser.y:942 -#, c-format -msgid "duplicate %s" -msgstr "" - -#: cobc/parser.y:944 -#, c-format -msgid "%s incorrectly after %s" -msgstr "" - -#: cobc/parser.y:1046 -#, c-format -msgid "redefinition of program name '%s'" -msgstr "" - -#: cobc/parser.y:1050 -#, c-format -msgid "redefinition of program ID '%s'" -msgstr "" - -#: cobc/parser.y:1082 -#, c-format -msgid "FUNCTION '%s' has no PROCEDURE DIVISION" -msgstr "" - -#: cobc/parser.y:1188 -msgid "functions may not be defined within a program/function" -msgstr "" - -#: cobc/parser.y:1238 -#, c-format -msgid "END FUNCTION '%s' is different from FUNCTION-ID '%s'" -msgstr "" - -#: cobc/parser.y:1252 -#, c-format -msgid "END PROGRAM '%s' is different from PROGRAM-ID '%s'" -msgstr "" - -#: cobc/parser.y:1301 -msgid "currency symbol must be one character long" -msgstr "" - -#: cobc/parser.y:1358 -#, c-format -msgid "invalid character '%c' in currency symbol" -msgstr "" - -#: cobc/parser.y:1374 -msgid "prototype has same name as current function and will be ignored" -msgstr "" - -#: cobc/parser.y:1401 -#, c-format -msgid "duplicate REPOSITORY entries for '%s' do not match" -msgstr "" - -#: cobc/parser.y:1405 -#, c-format -msgid "duplicate REPOSITORY entry for '%s'" -msgstr "" - -#: cobc/parser.y:1470 -#, c-format -msgid "ORGANIZATION %s is incompatible with RECORD DELIMITER" -msgstr "" - -#: cobc/parser.y:1502 -#, c-format -msgid "illegal combination of %s with other clauses" -msgstr "" - -#: cobc/parser.y:1517 cobc/parser.y:1520 cobc/parser.y:1551 -#, c-format -msgid "cannot specify both %s and %s" -msgstr "" - -#: cobc/parser.y:1548 -#, c-format -msgid "cannot specify both %s and %s; %s is ignored" -msgstr "" - -#: cobc/parser.y:1720 -msgid "FOR phrase cannot immediately follow ALL/LEADING/TRAILING" -msgstr "" - -#: cobc/parser.y:1722 -msgid "missing CHARACTERS/ALL/LEADING/TRAILING phrase after FOR phrase" -msgstr "" - -#: cobc/parser.y:1729 -msgid "missing value between ALL/LEADING/TRAILING words" -msgstr "" - -#: cobc/parser.y:1734 -msgid "missing FOR phrase before CHARACTERS/ALL/LEADING/TRAILING phrase" -msgstr "" - -#: cobc/parser.y:1741 -msgid "missing ALL/LEADING/TRAILING before value" -msgstr "" - -#: cobc/parser.y:1796 -msgid "use of condition-name in place of data-name" -msgstr "" - -#: cobc/parser.y:1800 cobc/parser.y:6753 cobc/typeck.c:665 -#, c-format -msgid "condition-name not allowed here: '%s'" -msgstr "" - -#: cobc/parser.y:1827 -msgid "cannot specify NO ADVANCING in screen DISPLAY" -msgstr "" - -#: cobc/parser.y:1899 cobc/parser.y:1916 -msgid "non-standard DISPLAY" -msgstr "" - -#: cobc/parser.y:1903 -msgid "screens may only be displayed on CRT" -msgstr "" - -#: cobc/parser.y:1908 cobc/parser.y:1951 -msgid "cannot mix screens and fields in the same DISPLAY statement" -msgstr "" - -#: cobc/parser.y:1912 -msgid "screen clauses may only be used for DISPLAY on CRT" -msgstr "" - -#: cobc/parser.y:1957 -msgid "ambiguous DISPLAY; put items to display on device in separate DISPLAY" -msgstr "" - -#: cobc/parser.y:1973 -#, c-format -msgid "%s is not an alphanumeric literal" -msgstr "" - -#: cobc/parser.y:1975 -#, c-format -msgid "'%s' is not USAGE DISPLAY" -msgstr "" - -#: cobc/parser.y:1990 cobc/typeck.c:8481 -#, c-format -msgid "invalid target for %s" -msgstr "" - -#: cobc/parser.y:1997 cobc/parser.y:6747 -msgid "SCREEN item cannot be used here" -msgstr "" - -#: cobc/parser.y:1999 -msgid "RENAMES item may not be used here" -msgstr "" - -#: cobc/parser.y:2001 cobc/typeck.c:2333 cobc/typeck.c:2429 -msgid "ANY LENGTH item not allowed here" -msgstr "" - -#: cobc/parser.y:2005 -#, c-format -msgid "item '%s' has wrong class for VALIDATE" -msgstr "" - -#: cobc/parser.y:2014 -msgid "WHEN clause must follow EVERY clause" -msgstr "" - -#: cobc/parser.y:2096 cobc/parser.y:17197 -msgid "non-zero value expected" -msgstr "" - -#: cobc/parser.y:2102 cobc/tree.c:4352 -#, c-format -msgid "RECORD size (IDX) exceeds maximum allowed (%d)" -msgstr "" - -#: cobc/parser.y:2106 cobc/tree.c:4355 -#, c-format -msgid "RECORD size exceeds maximum allowed (%d)" -msgstr "" - -#: cobc/parser.y:2111 -msgid "RECORD clause invalid" -msgstr "" - -#: cobc/parser.y:3188 -msgid "multiple PROGRAM-ID's without matching END PROGRAM" -msgstr "" - -#: cobc/parser.y:3191 -msgid "executable requested but no program found" -msgstr "" - -#: cobc/parser.y:3408 cobc/parser.y:3417 -msgid "COMMON may only be used in a contained program" -msgstr "" - -#: cobc/parser.y:3426 cobc/parser.y:3458 -msgid "CALL prototypes" -msgstr "" - -#: cobc/parser.y:3607 cobc/parser.y:3884 cobc/parser.y:3928 cobc/parser.y:4036 -#: cobc/parser.y:4223 cobc/parser.y:4319 cobc/parser.y:4360 cobc/parser.y:4431 -#: cobc/parser.y:4452 cobc/parser.y:4531 cobc/parser.y:4550 cobc/parser.y:4566 -#: cobc/parser.y:4584 cobc/parser.y:4602 cobc/parser.y:4619 cobc/parser.y:4637 -#: cobc/parser.y:6868 cobc/parser.y:7694 -#, c-format -msgid "%s not allowed in nested programs" -msgstr "" - -#: cobc/parser.y:3761 -msgid "segment-number must be in range of values 1 to 49" -msgstr "" - -#: cobc/parser.y:3773 -msgid "duplicate CLASSIFICATION clause" -msgstr "" - -#: cobc/parser.y:3849 -msgid "PROGRAM phrase" -msgstr "" - -#: cobc/parser.y:3944 cobc/parser.y:3955 cobc/parser.y:4271 -#, c-format -msgid "invalid %s clause" -msgstr "clausola %s non valida" - -#: cobc/parser.y:4386 cobc/parser.y:4390 -msgid "CLASS literal with THRU must have size 1" -msgstr "" - -#: cobc/parser.y:4417 -msgid "CLASS IS integer IN alphabet-name" -msgstr "" - -#: cobc/parser.y:4464 -msgid "separate currency symbol and currency string" -msgstr "" - -#: cobc/parser.y:4497 -#, c-format -msgid "invalid CURRENCY SIGN '%s'" -msgstr "CURRENCY SIGN non valido '%s'" - -#: cobc/parser.y:4715 -msgid "cannot use RELATIVE KEY clause on INDEXED files" -msgstr "" - -#: cobc/parser.y:4719 -msgid "cannot use RECORD KEY clause on RELATIVE files" -msgstr "" - -#: cobc/parser.y:4793 -msgid "EXTERNAL/DYNAMIC cannot be used with literals" -msgstr "" - -#: cobc/parser.y:4813 -msgid "EXTERNAL/DYNAMIC cannot be used with USING/VARYING" -msgstr "" - -#: cobc/parser.y:4824 -msgid "EXTERNAL/DYNAMIC cannot be used with DISK FROM" -msgstr "" - -#: cobc/parser.y:4826 -msgid "ASSIGN DISK FROM" -msgstr "" - -#: cobc/parser.y:4942 -msgid "ASSIGN EXTERNAL/DYNAMIC" -msgstr "" - -#: cobc/parser.y:5165 -#, c-format -msgid "'%s' is not an alphabet-name" -msgstr "" - -#: cobc/parser.y:5254 -#, c-format -msgid "%s only valid with ORGANIZATION %s" -msgstr "" - -#: cobc/parser.y:5321 cobc/parser.y:5344 -#, c-format -msgid "RECORD DELIMITER %s only allowed with SEQUENTIAL files" -msgstr "" - -#: cobc/parser.y:5323 cobc/parser.y:5336 cobc/parser.y:5348 cobc/parser.y:5358 -msgid "RECORD DELIMITER clause" -msgstr "" - -#: cobc/parser.y:5332 -#, c-format -msgid "RECORD DELIMITER %s only allowed with (LINE) SEQUENTIAL files" -msgstr "" - -#: cobc/parser.y:5337 -msgid "LINE-SEQUENTIAL phrase" -msgstr "" - -#: cobc/parser.y:5349 -msgid "BINARY-SEQUENTIAL phrase" -msgstr "" - -#: cobc/parser.y:5357 -msgid "RECORD DELIMITER clause only allowed with (LINE) SEQUENTIAL files" -msgstr "" - -#: cobc/parser.y:5360 -#, c-format -msgid "RECORD DELIMITER %s not recognized; will be ignored" -msgstr "" - -#: cobc/parser.y:5398 -msgid "DUPLICATES for primary keys" -msgstr "" - -#: cobc/parser.y:5637 -msgid "DOS/VS APPLY phrase" -msgstr "" - -#: cobc/parser.y:5752 -msgid "RECORD description missing or invalid" -msgstr "" - -#: cobc/parser.y:5778 -#, c-format -msgid "duplicate file description for %s" -msgstr "" - -#: cobc/parser.y:5811 cobc/parser.y:5821 -msgid "file cannot have both EXTERNAL and GLOBAL clauses" -msgstr "" - -#: cobc/parser.y:5825 cobc/parser.y:6414 cobc/parser.y:6853 cobc/parser.y:12363 -#: cobc/parser.y:15305 -#, c-format -msgid "%s is invalid in a user FUNCTION" -msgstr "" - -#: cobc/parser.y:5863 cobc/parser.y:5872 -msgid "RECORD clause ignored for LINE SEQUENTIAL" -msgstr "" - -#: cobc/parser.y:5964 -msgid "LINAGE clause with wrong file type" -msgstr "" - -#: cobc/parser.y:6026 -msgid "RECORDING MODE U or S can only be used with RECORD SEQUENTIAL files" -msgstr "" - -#: cobc/parser.y:6059 -#, c-format -msgid "ignoring CODE-SET '%s'" -msgstr "" - -#: cobc/parser.y:6070 -msgid "CODE-SET clause invalid for file type" -msgstr "" - -#: cobc/parser.y:6092 -msgid "REPORT clause with wrong file type" -msgstr "" - -#: cobc/parser.y:6170 -msgid "CD record missing" -msgstr "" - -#: cobc/parser.y:6601 -msgid "CONSTANT item not at 01 level" -msgstr "" - -#: cobc/parser.y:6721 -msgid "REDEFINES clause not following entry-name" -msgstr "" - -#: cobc/parser.y:6743 -msgid "SAME AS clause" -msgstr "" - -#: cobc/parser.y:6750 -msgid "REPORT item cannot be used here" -msgstr "" - -#: cobc/parser.y:6757 -msgid "elementary item expected" -msgstr "" - -#: cobc/parser.y:6764 -msgid "SAME AS item may not reference itself" -msgstr "" - -#: cobc/parser.y:6771 -msgid "SAME AS item may not be subordinate to any item with USAGE clause" -msgstr "" - -#: cobc/parser.y:6773 -msgid "SAME AS item may not be subordinate to any item with SIGN clause" -msgstr "" - -#: cobc/parser.y:6801 cobc/parser.y:6855 cobc/parser.y:7567 cobc/parser.y:7650 -#: cobc/parser.y:7674 -#, c-format -msgid "%s not allowed here" -msgstr "" - -#: cobc/parser.y:6803 cobc/parser.y:6845 cobc/parser.y:7569 -#, c-format -msgid "%s only allowed at 01/77 level" -msgstr "" - -#: cobc/parser.y:6805 cobc/parser.y:6847 cobc/parser.y:7571 cobc/parser.y:7654 -#: cobc/parser.y:7676 -#, c-format -msgid "%s requires a data name" -msgstr "" - -#: cobc/parser.y:6958 -msgid "a locale-format PICTURE string must only consist of '9', '.', '+', 'Z' and the currency-sign" -msgstr "" - -#: cobc/parser.y:6992 cobc/typeck.c:3658 -#, fuzzy, c-format -msgid "'%s' is not a locale-name" -msgstr "'%s' non è una definizione" - -#: cobc/parser.y:7007 -#, fuzzy, c-format -msgid "'%s' is not a valid USAGE" -msgstr "'%s' non è un integer" - -#: cobc/parser.y:7012 -#, c-format -msgid "unknown USAGE: %s" -msgstr "" - -#: cobc/parser.y:7149 -#, c-format -msgid "unknown HANDLE type: %s" -msgstr "" - -#: cobc/parser.y:7406 cobc/parser.y:7408 -msgid "INDEXED should follow ASCENDING/DESCENDING" -msgstr "" - -#: cobc/parser.y:7526 -msgid "SYNCHRONIZED clause" -msgstr "" - -#: cobc/parser.y:7529 -msgid "LEFT/RIGHT phrases in SYNCHRONIZED clause" -msgstr "" - -#: cobc/parser.y:7612 -msgid "FALSE clause only allowed for 88 level" -msgstr "" - -#: cobc/parser.y:7652 -#, c-format -msgid "%s only allowed at 01 level" -msgstr "" - -#: cobc/parser.y:7656 cobc/parser.y:7678 -#, c-format -msgid "%s and %s combination not allowed" -msgstr "" - -#: cobc/parser.y:7787 -msgid "GLOBAL is not allowed with RD" -msgstr "" - -#: cobc/parser.y:8321 -msgid "PLUS is not recommended with LEFT, RIGHT or CENTER" -msgstr "" - -#: cobc/parser.y:8323 -msgid "PLUS is not allowed with LEFT, RIGHT or CENTER" -msgstr "" - -#: cobc/parser.y:8360 cobc/parser.y:8390 -msgid "PLUS is ignored on first field of line" -msgstr "" - -#: cobc/parser.y:8398 -msgid "invalid COLUMN integer; must be > 0" -msgstr "" - -#: cobc/parser.y:8400 -msgid "COLUMN numbers should increase" -msgstr "" - -#: cobc/parser.y:8499 cobc/parser.y:8555 -msgid "INITIAL specified on non-input field" -msgstr "" - -#: cobc/parser.y:8511 cobc/parser.y:8567 -msgid "relative LINE/COLUMN clause required with OCCURS" -msgstr "" - -#: cobc/parser.y:8669 cobc/parser.y:8673 -msgid "screen positions from data-item" -msgstr "" - -#: cobc/parser.y:9498 -msgid "OCCURS screen items" -msgstr "" - -#: cobc/parser.y:9510 -msgid "GLOBAL screen items" -msgstr "" - -#: cobc/parser.y:9554 -msgid "overriding convention specified in ENTRY-CONVENTION" -msgstr "" - -#: cobc/parser.y:9566 -msgid "executable program requested but PROCEDURE/ENTRY has USING clause" -msgstr "" - -#: cobc/parser.y:9636 cobc/parser.y:9653 cobc/parser.y:11184 -#, c-format -msgid "number of arguments exceeds maximum %d" -msgstr "" - -#: cobc/parser.y:9645 -msgid "CHAINING invalid in user FUNCTION" -msgstr "" - -#: cobc/parser.y:9692 cobc/parser.y:11261 cobc/parser.y:11270 -#, c-format -msgid "%s not allowed in CHAINED programs" -msgstr "" - -#: cobc/parser.y:9704 cobc/parser.y:9712 cobc/parser.y:9720 cobc/parser.y:9741 -msgid "SIZE only allowed for BY VALUE items" -msgstr "" - -#: cobc/parser.y:9743 cobc/parser.y:9760 -msgid "invalid value for SIZE" -msgstr "" - -#: cobc/parser.y:9775 -msgid "MEMORY SIZE phrase in CALL statement" -msgstr "" - -#: cobc/parser.y:9787 -msgid "OPTIONAL only allowed for BY REFERENCE items" -msgstr "" - -#: cobc/parser.y:9799 -msgid "RETURNING clause is required for a FUNCTION" -msgstr "" - -#: cobc/parser.y:9805 -msgid "RETURNING clause cannot be OMITTED for main program" -msgstr "" - -#: cobc/parser.y:9808 -msgid "RETURNING clause cannot be OMITTED for a FUNCTION" -msgstr "" - -#: cobc/parser.y:9821 -msgid "RETURNING item is not defined in LINKAGE SECTION" -msgstr "" - -#: cobc/parser.y:9823 -msgid "RETURNING item must have level 01" -msgstr "" - -#: cobc/parser.y:9825 -msgid "RETURNING item should not have OCCURS" -msgstr "" - -#: cobc/parser.y:9829 -msgid "function RETURNING item may not be ANY LENGTH" -msgstr "" - -#: cobc/parser.y:10017 -#, c-format -msgid "'%s' is not a statement" -msgstr "'%s' non è una definizione" - -#: cobc/parser.y:10019 -#, c-format -msgid "unknown statement '%s'; it may exist in another dialect" -msgstr "" - -#: cobc/parser.y:10022 -#, c-format -msgid "unknown statement '%s'" -msgstr "" - -#: cobc/parser.y:10039 -msgid "section segments" -msgstr "" - -#: cobc/parser.y:10041 -msgid "SECTION segment-number must be less than or equal to 99" -msgstr "" - -#: cobc/parser.y:10044 -msgid "SECTION segment-number in DECLARATIVES must be less than 50" -msgstr "" - -#: cobc/parser.y:10052 -msgid "SECTION segment within DECLARATIVES" -msgstr "" - -#: cobc/parser.y:10240 cobc/parser.y:10375 -msgid "non-standard ACCEPT" -msgstr "" - -#: cobc/parser.y:10252 -msgid "PROMPT clause" -msgstr "" - -#: cobc/parser.y:10256 -msgid "SIZE IS clause" -msgstr "" - -#: cobc/parser.y:10471 cobc/parser.y:10763 -msgid "TIME-OUT or BEFORE TIME clauses" -msgstr "" - -#: cobc/parser.y:10497 cobc/parser.y:10513 cobc/parser.y:10528 -msgid "AT screen-location" -msgstr "" - -#: cobc/parser.y:10529 -msgid "LINE or COLUMN" -msgstr "" - -#: cobc/parser.y:10893 -msgid "ALLOCATE CHARACTERS requires RETURNING clause" -msgstr "" - -#: cobc/parser.y:10908 cobc/parser.y:12168 -#, c-format -msgid "ignoring %s phrase" -msgstr "" - -#: cobc/parser.y:10910 -msgid "addressing mode should be either 24 or 31 bit" -msgstr "" - -#: cobc/parser.y:10982 -msgid "recursive program call - assuming RECURSIVE attribute" -msgstr "" - -#: cobc/parser.y:11001 -msgid "STATIC CALL convention ignored because of ON EXCEPTION" -msgstr "" - -#: cobc/parser.y:11010 -msgid "ON EXCEPTION ignored because of STATIC CALL" -msgstr "" - -#: cobc/parser.y:11111 cobc/typeck.c:12209 -msgid "invalid mnemonic name" -msgstr "" - -#: cobc/parser.y:11131 cobc/parser.y:11428 -msgid "CALL/CANCEL with program-prototype-name" -msgstr "" - -#: cobc/parser.y:11135 -msgid "id/literal ignored, using prototype name" -msgstr "" - -#: cobc/parser.y:11141 -msgid "NESTED phrase is only valid with literal" -msgstr "" - -#: cobc/parser.y:11202 -msgid "OMITTED only allowed when arguments are passed BY REFERENCE" -msgstr "" - -#: cobc/parser.y:11226 -msgid "invalid file name reference" -msgstr "" - -#: cobc/parser.y:11234 -#, c-format -msgid "BY CONTENT assumed for alphanumeric item '%s'" -msgstr "" - -#: cobc/parser.y:11239 -#, c-format -msgid "BY CONTENT assumed for national item '%s'" -msgstr "" - -#: cobc/parser.y:11302 -msgid "RETURNING item must have level 01 or 77" -msgstr "" - -#: cobc/parser.y:11306 -msgid "RETURNING item must be a LINKAGE SECTION item or have BASED clause" -msgstr "" - -#: cobc/parser.y:11340 cobc/parser.y:15972 cobc/parser.y:16027 -#: cobc/parser.y:16071 cobc/parser.y:16115 -msgid "NOT EXCEPTION before EXCEPTION" -msgstr "" - -#: cobc/parser.y:12041 -#, c-format -msgid "HANDLE must be a %s HANDLE" -msgstr "" - -#: cobc/parser.y:12053 -msgid "HANDLE must be a generic HANDLE" -msgstr "" - -#: cobc/parser.y:12130 -#, c-format -msgid "HANDLE clause invalid for %s" -msgstr "" - -#: cobc/parser.y:12361 cobc/parser.y:15495 -#, c-format -msgid "%s is invalid in nested program" -msgstr "" - -#: cobc/parser.y:12399 cobc/parser.y:12440 cobc/parser.y:12451 -#: cobc/parser.y:12462 -#, c-format -msgid "maximum evaluate depth exceeded (%d)" -msgstr "" - -#: cobc/parser.y:12503 cobc/parser.y:12513 -msgid "WHEN without imperative statement" -msgstr "" - -#: cobc/parser.y:12531 cobc/parser.y:12541 -msgid "WHEN OTHER without imperative statement" -msgstr "" - -#: cobc/parser.y:12621 -msgid "invalid THROUGH usage" -msgstr "" - -#: cobc/parser.y:12700 -msgid "EXIT PROGRAM is not allowed within a USE GLOBAL procedure" -msgstr "" - -#: cobc/parser.y:12704 -msgid "EXIT PROGRAM not allowed within a FUNCTION" -msgstr "" - -#: cobc/parser.y:12713 cobc/parser.y:12926 -msgid "RETURNING/GIVING not allowed for non-returning runtime elements" -msgstr "" - -#: cobc/parser.y:12725 -msgid "EXIT FUNCTION is not allowed within a USE GLOBAL procedure" -msgstr "" - -#: cobc/parser.y:12729 -msgid "EXIT FUNCTION only allowed within a FUNCTION" -msgstr "" - -#: cobc/parser.y:12743 cobc/parser.y:12766 -msgid "EXIT PERFORM is only valid with inline PERFORM" -msgstr "" - -#: cobc/parser.y:12788 -msgid "EXIT SECTION is only valid with an active SECTION" -msgstr "" - -#: cobc/parser.y:12809 -msgid "EXIT PARAGRAPH is only valid with an active PARAGRAPH" -msgstr "" - -#: cobc/parser.y:12956 -msgid "IF without imperative statement" -msgstr "" - -#: cobc/parser.y:13173 -msgid "TALLYING clause is incomplete" -msgstr "" - -#: cobc/parser.y:13289 -msgid "INSPECT missing ALL/FIRST/LEADING/TRAILING" -msgstr "" - -#: cobc/parser.y:13407 -msgid "JSON PARSE" -msgstr "" - -#: cobc/parser.y:13552 -msgid "LOCK clauses" -msgstr "" - -#: cobc/parser.y:13717 -msgid "inline PERFORM without imperative statement" -msgstr "" - -#: cobc/parser.y:13838 cobc/parser.y:13846 cobc/parser.y:13854 -#, c-format -msgid "PERFORM VARYING '%s' (line %d of %s) is not a numeric field" -msgstr "" - -#: cobc/parser.y:13870 -msgid "PERFORM VARYING without BY phrase" -msgstr "" - -#: cobc/parser.y:13910 -#, fuzzy, c-format -msgid "'%s' is not an object-reference" -msgstr "'%s' non è un integer" - -#: cobc/parser.y:13951 cobc/typeck.c:10958 cobc/typeck.c:12100 -msgid "LOCK clause invalid with file LOCK AUTOMATIC" -msgstr "" - -#: cobc/parser.y:13956 -msgid "KEY clause invalid with this file type" -msgstr "" - -#: cobc/parser.y:13961 cobc/typeck.c:10954 cobc/typeck.c:12096 -msgid "INVALID KEY clause invalid with this file type" -msgstr "" - -#: cobc/parser.y:14591 -msgid "file sort requires KEY phrase" -msgstr "" - -#: cobc/parser.y:14615 -msgid "table SORT requires KEY phrase" -msgstr "" - -#: cobc/parser.y:14677 -msgid "file sort requires USING or INPUT PROCEDURE" -msgstr "" - -#: cobc/parser.y:14684 -msgid "USING invalid with table SORT" -msgstr "" - -#: cobc/parser.y:14694 -msgid "INPUT PROCEDURE invalid with table SORT" -msgstr "" - -#: cobc/parser.y:14696 -msgid "INPUT PROCEDURE invalid with MERGE" -msgstr "" - -#: cobc/parser.y:14709 -msgid "file sort requires GIVING or OUTPUT PROCEDURE" -msgstr "" - -#: cobc/parser.y:14716 -msgid "GIVING invalid with table SORT" -msgstr "" - -#: cobc/parser.y:14726 -msgid "OUTPUT PROCEDURE invalid with table SORT" -msgstr "" - -#: cobc/parser.y:14753 -msgid "SIZE/LENGTH invalid here" -msgstr "" - -#: cobc/parser.y:14806 -msgid "NOT EQUAL condition not allowed on START statement" -msgstr "" - -#: cobc/parser.y:14872 -#, c-format -msgid "%s is replaced by %s" -msgstr "" - -#: cobc/parser.y:14925 -msgid "STOP literal" -msgstr "" - -#: cobc/parser.y:14929 -msgid "STOP identifier" -msgstr "" - -#: cobc/parser.y:15066 -msgid "SUPPRESS statement must be within DECLARATIVES" -msgstr "" - -#: cobc/parser.y:15140 -msgid "UNLOCK invalid for SORT files" -msgstr "" - -#: cobc/parser.y:15276 cobc/parser.y:15355 -msgid "USE statement must be within DECLARATIVES" -msgstr "" - -#: cobc/parser.y:15278 -msgid "SECTION header missing before USE statement" -msgstr "" - -#: cobc/parser.y:15357 -msgid "USE DEBUGGING not supported in contained program" -msgstr "" - -#: cobc/parser.y:15405 cobc/parser.y:15414 cobc/parser.y:15432 -#: cobc/parser.y:15468 cobc/typeck.c:3792 -#, c-format -msgid "duplicate DEBUGGING target: '%s'" -msgstr "" - -#: cobc/parser.y:15430 -msgid "constant item cannot be used here" -msgstr "" - -#: cobc/parser.y:15456 -msgid "duplicate USE DEBUGGING ON ALL PROCEDURES" -msgstr "" - -#: cobc/parser.y:15528 -#, fuzzy, c-format -msgid "'%s' is not a report group" -msgstr "'%s' non è un integer" - -#: cobc/parser.y:15710 -msgid "ENCODING clause must come before XML-DECLARATION" -msgstr "" - -#: cobc/parser.y:15712 -msgid "ENCODING clause must come before ATTRIBUTES" -msgstr "" - -#: cobc/parser.y:15715 -msgid "XML GENERATE ENCODING clause" -msgstr "" - -#: cobc/parser.y:15722 -msgid "XML-DECLARATION clause must come before ATTRIBUTES" -msgstr "" - -#: cobc/parser.y:15725 -msgid "XML GENERATE XML-DECLARATION clause" -msgstr "" - -#: cobc/parser.y:15731 -msgid "XML GENERATE WITH ATTRIBUTES clause" -msgstr "" - -#: cobc/parser.y:15744 -msgid "XML GENERATE NAMESPACE clause" -msgstr "" - -#: cobc/parser.y:15768 -msgid "XML GENERATE NAME OF clause" -msgstr "" - -#: cobc/parser.y:15799 -msgid "XML GENERATE TYPE OF clause" -msgstr "" - -#: cobc/parser.y:15840 -msgid "XML GENERATE SUPPRESS clause" -msgstr "" - -#: cobc/parser.y:15914 -msgid "XML PARSE" -msgstr "" - -#: cobc/parser.y:15955 cobc/parser.y:16633 cobc/parser.y:16729 -#: cobc/parser.y:16815 -#, c-format -msgid "'%s' is not a file name" -msgstr "" - -#: cobc/parser.y:16161 -msgid "NOT SIZE ERROR before SIZE ERROR" -msgstr "" - -#: cobc/parser.y:16207 -msgid "NOT OVERFLOW before OVERFLOW" -msgstr "" - -#: cobc/parser.y:16306 -msgid "NOT AT END-OF-PAGE before AT END-OF-PAGE" -msgstr "" - -#: cobc/parser.y:16356 -msgid "NOT INVALID KEY before INVALID KEY" -msgstr "" - -#: cobc/parser.y:16619 -msgid "LINAGE-COUNTER must be qualified here" -msgstr "" - -#: cobc/parser.y:16622 -msgid "invalid LINAGE-COUNTER usage" -msgstr "" - -#: cobc/parser.y:16643 -msgid "LINE-COUNTER must be qualified here" -msgstr "" - -#: cobc/parser.y:16647 -msgid "invalid LINE-COUNTER usage" -msgstr "" - -#: cobc/parser.y:16658 cobc/parser.y:16683 -#, c-format -msgid "'%s' is not a report name" -msgstr "" - -#: cobc/parser.y:16668 -msgid "PAGE-COUNTER must be qualified here" -msgstr "" - -#: cobc/parser.y:16672 -msgid "invalid PAGE-COUNTER usage" -msgstr "" - -#: cobc/parser.y:16719 cobc/typeck.c:10919 cobc/typeck.c:11004 -#: cobc/typeck.c:12064 -#, c-format -msgid "%s requires a record name as subject" -msgstr "" - -#: cobc/parser.y:16746 -#, c-format -msgid "'%s' not indexed" -msgstr "" - -#: cobc/parser.y:16772 cobc/parser.y:16797 -#, c-format -msgid "multiple reference to '%s' " -msgstr "" - -#: cobc/parser.y:16827 -#, c-format -msgid "'%s' is not a CD name" -msgstr "" - -#: cobc/parser.y:16841 -#, fuzzy, c-format -msgid "'%s' is not a valid report name" -msgstr "'%s' non è una definizione" - -#: cobc/parser.y:17092 -msgid "invalid mnemonic identifier" -msgstr "" - -#: cobc/parser.y:17172 -msgid "a numeric literal is expected here" -msgstr "" - -#: cobc/parser.y:17184 cobc/parser.y:17886 -msgid "a non-numeric literal is expected here" -msgstr "" - -#: cobc/parser.y:17357 cobc/typeck.c:6116 cobc/typeck.c:6123 -#, c-format -msgid "'%s' is not numeric" -msgstr "'%s' non è un numero" - -#: cobc/parser.y:17373 -#, c-format -msgid "'%s' is not a field or file" -msgstr "" - -#: cobc/parser.y:17393 cobc/parser.y:17411 -#, c-format -msgid "'%s' is not a field" -msgstr "" - -#: cobc/parser.y:17533 -#, fuzzy, c-format -msgid "'%s' is not a field or alphabet" -msgstr "'%s' non è un integer" - -#: cobc/parser.y:17559 -msgid "a subscripted data-item cannot be used here" -msgstr "" - -#: cobc/parser.y:17609 -msgid "unsigned integer value expected" -msgstr "" - -#: cobc/parser.y:17621 cobc/parser.y:17625 cobc/parser.y:17675 -msgid "integer value expected" -msgstr "" - -#: cobc/parser.y:17630 -msgid "invalid symbolic integer" -msgstr "" - -#: cobc/parser.y:17646 cobc/parser.y:17650 -msgid "unsigned positive integer value expected" -msgstr "" - -#: cobc/parser.y:17679 -msgid "invalid CLASS value" -msgstr "" - -#: cobc/parser.y:17767 -msgid "PHYSICAL argument for LENGTH functions" -msgstr "" - -#: cobc/parser.y:17938 cobc/parser.y:17955 -msgid "cannot specify offset and SYSTEM-OFFSET at the same time" -msgstr "" - -#: cobc/pplex.l:223 cobc/pplex.l:1739 -msgid "debugging indicator" -msgstr "" - -#: cobc/pplex.l:300 -msgid "ignoring empty directive" -msgstr "" - -#: cobc/pplex.l:310 cobc/pplex.l:369 -#, c-format -msgid "ignoring invalid directive: '%s'" -msgstr "" - -#: cobc/pplex.l:317 -msgid "ignoring invalid directive" -msgstr "" - -#: cobc/pplex.l:324 -msgid "VCS directive" -msgstr "" - -#: cobc/pplex.l:377 cobc/pplex.l:392 -msgid "spurious '$' detected - ignored" -msgstr "" - -#: cobc/pplex.l:386 -#, c-format -msgid "ignoring unknown directive: '%s'" -msgstr "" - -#: cobc/pplex.l:398 -msgid "PROCESS statement ignored" -msgstr "" - -#: cobc/pplex.l:864 -msgid "IF/ELIF/ELSE directive without matching END-IF" -msgstr "" - -#: cobc/pplex.l:981 -msgid "file was included here" -msgstr "" - -#: cobc/pplex.l:1186 -#, c-format -msgid "directive nest depth exceeded: %d" -msgstr "" - -#: cobc/pplex.l:1204 -msgid "ELSE directive without matching IF/ELIF" -msgstr "" - -#: cobc/pplex.l:1220 -msgid "END-IF directive without matching IF/ELIF/ELSE" -msgstr "" - -#: cobc/pplex.l:1236 -msgid "ELIF directive without matching IF/ELIF" -msgstr "" - -#: cobc/pplex.l:1258 -#, c-format -msgid "invalid internal case: %u" -msgstr "" - -#: cobc/pplex.l:1395 -msgid "buffer overrun - too many continuation lines" -msgstr "" - -#: cobc/pplex.l:1485 cobc/pplex.l:1494 -msgid "line not terminated by a newline" -msgstr "" - -#: cobc/pplex.l:1488 cobc/pplex.l:1497 -#, c-format -msgid "source text exceeds %d bytes, will be truncated" -msgstr "" - -#: cobc/pplex.l:1516 -msgid "version control conflict marker in file" -msgstr "" - -#: cobc/pplex.l:1727 -msgid "invalid continuation in comment entry" -msgstr "" - -#: cobc/pplex.l:1732 -msgid "continuation of COBOL words" -msgstr "" - -#: cobc/pplex.l:1752 -#, c-format -msgid "invalid indicator '%c' at column 7" -msgstr "" - -#: cobc/pplex.l:1800 cobc/pplex.l:1811 -msgid "invalid line continuation" -msgstr "" - -#: cobc/pplex.l:1819 -msgid "continuation character expected" -msgstr "" - -#: cobc/pplex.l:1885 -#, c-format -msgid "source text after program-text area (column %d)" -msgstr "" - -#: cobc/ppparse.y:225 -msgid "directive comparison on different types" -msgstr "" - -#: cobc/ppparse.y:293 -#, c-format -msgid "duplicate DEFINE directive '%s'" -msgstr "" - -#: cobc/ppparse.y:300 cobc/ppparse.y:310 -msgid "invalid constant in DEFINE directive" -msgstr "" - -#: cobc/ppparse.y:408 -#, c-format -msgid "compiler flag '%s' unknown" -msgstr "" - -#: cobc/ppparse.y:454 -#, c-format -msgid "invalid %s directive option '%s'" -msgstr "" - -#: cobc/ppparse.y:667 -msgid "*CONTROL statement" -msgstr "" - -#: cobc/ppparse.y:933 cobc/ppparse.y:1004 cobc/ppparse.y:1141 -#, c-format -msgid "invalid %s directive" -msgstr "" - -#: cobc/ppparse.y:1043 -msgid "LEAP-SECOND ON directive" -msgstr "" - -#: cobc/ppparse.y:1051 -msgid "TURN directive" -msgstr "" - -#: cobc/ppparse.y:1133 cobc/ppparse.y:1158 -msgid "invalid constant" -msgstr "costante non valida" - -#: cobc/reserved.c:3797 -msgid "device name" -msgstr "nome dispositivo" - -#: cobc/reserved.c:3800 -msgid "switch name" -msgstr "" - -#: cobc/reserved.c:3803 -msgid "feature name" -msgstr "" - -#: cobc/reserved.c:3902 -#, c-format -msgid "reserved word must have less than %d characters" -msgstr "" - -#: cobc/reserved.c:3921 -msgid "ignored asterisk at end of alias target" -msgstr "" - -#: cobc/reserved.c:3984 -#, c-format -msgid "alias target '%s' is not a default reserved word" -msgstr "" - -#: cobc/reserved.c:4447 -#, c-format -msgid "invalid system-name '%s'" -msgstr "" - -#: cobc/reserved.c:4584 -#, c-format -msgid "'%s' is a reserved word, but isn't supported" -msgstr "" - -#: cobc/reserved.c:4689 -#, c-format -msgid "intrinsic function %s is unknown" -msgstr "" - -#: cobc/reserved.c:4717 -msgid "Intrinsic Function" -msgstr "Funzione intrinseca" - -#: cobc/reserved.c:4717 cobc/reserved.c:4897 cobc/reserved.c:5034 -msgid "Implemented" -msgstr "" - -#: cobc/reserved.c:4717 cobc/typeck.c:1022 -msgid "Parameters" -msgstr "Parametri" - -#: cobc/reserved.c:4721 cobc/reserved.c:4901 cobc/reserved.c:5048 -msgid "Yes" -msgstr "Sì" - -#: cobc/reserved.c:4724 cobc/reserved.c:4904 cobc/reserved.c:5054 -msgid "No" -msgstr "No" - -#: cobc/reserved.c:4730 -msgid "Unlimited" -msgstr "" - -#: cobc/reserved.c:4804 -#, c-format -msgid "special register %s is unknown, needs a definition" -msgstr "" - -#: cobc/reserved.c:4810 -#, c-format -msgid "special register %s is unknown" -msgstr "" - -#: cobc/reserved.c:4897 -msgid "Internal registers" -msgstr "Registri interni" - -#: cobc/reserved.c:4897 -msgid "Definition" -msgstr "Definizione" - -#: cobc/reserved.c:4985 -#, c-format -msgid "unknown system-name '%s'" -msgstr "" - -#: cobc/reserved.c:5011 -msgid "System names" -msgstr "" - -#: cobc/reserved.c:5034 -msgid "Reserved Words" -msgstr "" - -#: cobc/reserved.c:5046 -msgid "Yes (Context sensitive)" -msgstr "" - -#: cobc/reserved.c:5052 -msgid "No (Context sensitive)" -msgstr "" - -#: cobc/reserved.c:5081 -msgid "Extra (obsolete) context sensitive words" -msgstr "" - -#: cobc/scanner.l:265 cobc/scanner.l:2288 -#, c-format -msgid "'%s' is not a default reserved word, so cannot be aliased" -msgstr "" - -#: cobc/scanner.l:268 -#, c-format -msgid "'%s' is not a reserved word; you may want ADDSYN or OVERRIDE instead" -msgstr "" - -#: cobc/scanner.l:988 -#, c-format -msgid "a constant may not be used here - '%s'" -msgstr "" - -#: cobc/scanner.l:1043 -msgid "ignoring redundant ." -msgstr "" - -#: cobc/scanner.l:1101 -#, c-format -msgid "invalid symbol '%s' - skipping word" -msgstr "" - -#: cobc/scanner.l:1191 -msgid "invalid national literal" -msgstr "" - -#: cobc/scanner.l:1202 cobc/tree.c:2531 -#, c-format -msgid "invalid literal: '%s'" -msgstr "" - -#: cobc/scanner.l:1204 -#, c-format -msgid "invalid hexadecimal literal: '%s'" -msgstr "" - -#: cobc/scanner.l:1206 cobc/tree.c:1613 -#, c-format -msgid "invalid numeric literal: '%s'" -msgstr "" - -#: cobc/scanner.l:1208 -#, c-format -msgid "invalid floating-point literal: '%s'" -msgstr "" - -#: cobc/scanner.l:1210 -#, c-format -msgid "invalid %s literal: '%s'" -msgstr "" - -#: cobc/scanner.l:1261 -#, c-format -msgid "literal length exceeds %d characters" -msgstr "" - -#: cobc/scanner.l:1277 cobc/scanner.l:1326 cobc/scanner.l:1620 -msgid "zero-length literal" -msgstr "" - -#: cobc/scanner.l:1280 -msgid "national literal has zero length; a SPACE will be assumed" -msgstr "" - -#: cobc/scanner.l:1281 -msgid "alphanumeric literal has zero length; a SPACE will be assumed" -msgstr "" - -#: cobc/scanner.l:1293 cobc/scanner.l:1294 cobc/scanner.l:1298 -#: cobc/scanner.l:1365 -msgid "national literal" -msgstr "" - -#: cobc/scanner.l:1297 -msgid "national-character literal" -msgstr "" - -#: cobc/scanner.l:1330 -msgid "hexadecimal literal has zero length; X'00' will be assumed" -msgstr "" - -#: cobc/scanner.l:1349 -msgid "hexadecimal-boolean literal" -msgstr "" - -#: cobc/scanner.l:1356 cobc/scanner.l:1370 cobc/scanner.l:1485 -#: cobc/scanner.l:1544 cobc/scanner.l:1642 cobc/scanner.l:1711 cobc/tree.c:2532 -#, c-format -msgid "literal length %d exceeds %d characters" -msgstr "" - -#: cobc/scanner.l:1362 -msgid "hexadecimal-national literal" -msgstr "" - -#: cobc/scanner.l:1393 cobc/scanner.l:1425 cobc/scanner.l:1560 -#: cobc/scanner.l:1656 cobc/scanner.l:1721 -#, c-format -msgid "literal contains invalid character '%c'" -msgstr "" - -#: cobc/scanner.l:1449 -#, c-format -msgid "literal does not have an even number of digits" -msgstr "" - -#: cobc/scanner.l:1492 -#, c-format -msgid "%s literals must contain at least one character" -msgstr "" - -#: cobc/scanner.l:1527 cobc/scanner.l:1628 cobc/scanner.l:1702 -msgid "ACUCOBOL numeric literal" -msgstr "" - -#: cobc/scanner.l:1537 -msgid "H literals must contain at least one character" -msgstr "" - -#: cobc/scanner.l:1575 cobc/scanner.l:1667 cobc/scanner.l:1732 -#, c-format -msgid "literal exceeds limit %u" -msgstr "" - -#: cobc/scanner.l:1616 -msgid "numeric boolean literal" -msgstr "" - -#: cobc/scanner.l:1622 -msgid "Boolean literal has zero length; B'0' will be assumed" -msgstr "" - -#: cobc/scanner.l:1698 -msgid "HP COBOL octal literal" -msgstr "" - -#: cobc/scanner.l:1810 cobc/tree.c:1624 -#, c-format -msgid "literal length %d exceeds maximum of %d digits" -msgstr "" - -#: cobc/scanner.l:1816 cobc/tree.c:1629 -#, c-format -msgid "literal length %d exceeds %d digits" -msgstr "" - -#: cobc/scanner.l:1928 cobc/tree.c:3513 -#, c-format -msgid "significand has more than %d digits" -msgstr "" - -#: cobc/scanner.l:1933 -#, c-format -msgid "exponent has decimal point" -msgstr "" - -#: cobc/scanner.l:1939 cobc/tree.c:3521 -#, c-format -msgid "exponent has more than 4 digits" -msgstr "" - -#: cobc/scanner.l:1969 -#, c-format -msgid "exponent not between -6143 and 6144" -msgstr "" - -#: cobc/scanner.l:1978 -#, c-format -msgid "significand of 0 must be positive" -msgstr "" - -#: cobc/scanner.l:1983 -#, c-format -msgid "exponent of 0 must be 0" -msgstr "" - -#: cobc/scanner.l:1988 -#, c-format -msgid "exponent of 0 must be positive" -msgstr "" - -#: cobc/scanner.l:2170 -#, c-format -msgid "invalid CONSTANT: %s" -msgstr "" - -#: cobc/scanner.l:2180 -#, c-format -msgid "invalid alphanumeric CONSTANT: %s" -msgstr "" - -#: cobc/scanner.l:2184 -#, c-format -msgid "empty alphanumeric CONSTANT: %s" -msgstr "" - -#: cobc/scanner.l:2201 cobc/scanner.l:2209 cobc/scanner.l:2214 -#, c-format -msgid "invalid numeric CONSTANT: %s" -msgstr "" - -#: cobc/scanner.l:2291 -#, c-format -msgid "'%s' is already reserved; you may want MAKESYN instead" -msgstr "" - -#: cobc/tree.c:341 -#, c-format -msgid "%s clause is required for file '%s'" -msgstr "" - -#: cobc/tree.c:345 -#, c-format -msgid "%s clause is invalid for file '%s' (file type)" -msgstr "" - -#: cobc/tree.c:349 -#, c-format -msgid "%s clause is invalid for file '%s'" -msgstr "" - -#: cobc/tree.c:376 -#, c-format -msgid "FOR item '%s' is a record" -msgstr "" - -#: cobc/tree.c:385 -#, c-format -msgid "FOR item '%s' is in different record to '%s'" -msgstr "" - -#: cobc/tree.c:394 -#, c-format -msgid "FOR item '%s' is not in a record associated with '%s'" -msgstr "" - -#: cobc/tree.c:477 -msgid "internal error node" -msgstr "" - -#: cobc/tree.c:479 -msgid "unknown constant" -msgstr "costante sconosciuta" - -#: cobc/tree.c:639 -#, c-format -msgid "FUNCTION %s has invalid/not supported arguments - tag %d" -msgstr "" - -#: cobc/tree.c:760 -#, c-format -msgid "invalid date/time function: '%d'" -msgstr "" - -#: cobc/tree.c:798 -#, c-format -msgid "FUNCTION '%s' has invalid date/time format" -msgstr "" - -#: cobc/tree.c:805 -#, c-format -msgid "FUNCTION '%s' has format in variable" -msgstr "" - -#: cobc/tree.c:1186 -#, c-format -msgid "literal '%s'" -msgstr "" - -#: cobc/tree.c:1315 -#, c-format -msgid "unknown tree tag: %d, category: %d" -msgstr "" - -#: cobc/tree.c:1405 -#, c-format -msgid "unexpected numeric USAGE: %d" -msgstr "" - -#: cobc/tree.c:1419 -#, c-format -msgid "unexpected category: %d" -msgstr "" - -#: cobc/tree.c:1678 cobc/tree.c:1690 cobc/tree.c:1752 cobc/tree.c:1802 -#, c-format -msgid "numeric literal '%s' exceeds limit '%s'" -msgstr "" - -#: cobc/tree.c:2387 -msgid "invalid LOCALE literal" -msgstr "" - -#: cobc/tree.c:2512 -msgid "only literals with the same category can be concatenated" -msgstr "" - -#: cobc/tree.c:2519 -msgid "only alphanumeric, national or boolean literals may be concatenated" -msgstr "" - -#: cobc/tree.c:2791 -msgid "B, 0 or /" -msgstr "" - -#: cobc/tree.c:2805 -msgid "the sign of the floating-point exponent" -msgstr "" - -#: cobc/tree.c:2807 -msgid "a leading +/- sign" -msgstr "" - -#: cobc/tree.c:2809 -msgid "a trailing +/- sign" -msgstr "" - -#: cobc/tree.c:2811 -msgid "CR or DB" -msgstr "" - -#: cobc/tree.c:2813 -msgid "a leading currency symbol" -msgstr "" - -#: cobc/tree.c:2815 -msgid "a trailing currency symbol" -msgstr "" - -#: cobc/tree.c:2817 -msgid "a Z or * which is before the decimal point" -msgstr "" - -#: cobc/tree.c:2819 -msgid "a Z or * which is after the decimal point" -msgstr "" - -#: cobc/tree.c:2821 -msgid "a floating +/- string which is before the decimal point" -msgstr "" - -#: cobc/tree.c:2823 -msgid "a floating +/- string which is after the decimal point" -msgstr "" - -#: cobc/tree.c:2825 -msgid "a floating currency symbol string which is before the decimal point" -msgstr "" - -#: cobc/tree.c:2827 -msgid "a floating currency symbol string which is after the decimal point" -msgstr "" - -#: cobc/tree.c:2831 -msgid "A or X" -msgstr "" - -#: cobc/tree.c:2837 -msgid "a P which is before the decimal point" -msgstr "" - -#: cobc/tree.c:2839 -msgid "a P which is after the decimal point" -msgstr "" - -#: cobc/tree.c:2860 cobc/tree.c:3267 -#, c-format -msgid "%s may only occur once in a PICTURE string" -msgstr "" - -#: cobc/tree.c:2862 cobc/tree.c:3219 -#, c-format -msgid "%s cannot follow %s" -msgstr "" - -#: cobc/tree.c:2865 -msgid "invalid PICTURE string detected" -msgstr "" - -#: cobc/tree.c:2976 -msgid "number or constant in parentheses is not an unsigned integer" -msgstr "" - -#: cobc/tree.c:2985 -msgid "only up to 9 significant digits are permitted within parentheses" -msgstr "" - -#: cobc/tree.c:2991 -msgid "number or constant in parentheses must be greater than zero" -msgstr "" - -#: cobc/tree.c:3002 -msgid "parentheses must be preceded by a picture symbol" -msgstr "" - -#: cobc/tree.c:3032 -msgid "unbalanced parentheses" -msgstr "" - -#: cobc/tree.c:3040 -msgid "parentheses must contain an unsigned integer" -msgstr "" - -#: cobc/tree.c:3078 -#, c-format -msgid "'%s' is not a constant-name" -msgstr "" - -#: cobc/tree.c:3085 -#, c-format -msgid "'%s' is not a numeric literal" -msgstr "" - -#: cobc/tree.c:3089 -#, c-format -msgid "'%s' is not an integer" -msgstr "'%s' non è un integer" - -#: cobc/tree.c:3093 -#, c-format -msgid "'%s' is not unsigned" -msgstr "" - -#: cobc/tree.c:3149 -msgid "missing PICTURE string" -msgstr "" - -#: cobc/tree.c:3178 -msgid "C must be followed by R" -msgstr "" - -#: cobc/tree.c:3181 -msgid "D must be followed by B" -msgstr "" - -#: cobc/tree.c:3195 cobc/tree.c:3264 cobc/tree.c:3290 cobc/tree.c:3401 -msgid "uncommon parentheses" -msgstr "" - -#: cobc/tree.c:3219 -msgid "exponent" -msgstr "" - -#: cobc/tree.c:3272 -msgid "S must be at start of PICTURE string" -msgstr "" - -#: cobc/tree.c:3328 -msgid "P must be at start or end of PICTURE string" -msgstr "" - -#: cobc/tree.c:3358 -msgid "cannot have both Z and * in PICTURE string" -msgstr "" - -#: cobc/tree.c:3436 -#, c-format -msgid "invalid PICTURE character '%c'" -msgstr "" - -#: cobc/tree.c:3466 -#, c-format -msgid "PICTURE string may not contain more than %d characters; contains %d characters" -msgstr "" - -#: cobc/tree.c:3471 -msgid "PICTURE string must contain at least one of the set A, N, X, Z, 1, 9 and *; or at least two of the set +, - and the currency symbol" -msgstr "" - -#: cobc/tree.c:3498 -#, c-format -msgid "numeric field cannot be larger than %d digits" -msgstr "" - -#: cobc/tree.c:3954 cobc/tree.c:3967 -#, c-format -msgid "no DETAIL line defined in report %s" -msgstr "" - -#: cobc/tree.c:3969 -msgid "PAGE LIMIT FIRST DETAIL should be >= HEADING" -msgstr "" - -#: cobc/tree.c:3972 -msgid "PAGE LIMIT FOOTING should be >= HEADING" -msgstr "" - -#: cobc/tree.c:3974 -msgid "PAGE LIMIT LAST DETAIL should be >= FIRST DETAIL" -msgstr "" - -#: cobc/tree.c:3976 -msgid "PAGE LIMIT FOOTING should be >= LAST DETAIL" -msgstr "" - -#: cobc/tree.c:3978 -msgid "PAGE LIMIT LINES should be >= FOOTING" -msgstr "" - -#: cobc/tree.c:4162 -#, c-format -msgid "maximum keys (%d/%d) exceeded for file '%s'" -msgstr "" - -#: cobc/tree.c:4226 cobc/tree.c:4249 -#, c-format -msgid "invalid KEY item '%s', not in file '%s'" -msgstr "" - -#: cobc/tree.c:4260 -#, c-format -msgid "minimal record length %d can not hold the key item '%s'; needs to be at least %d" -msgstr "" - -#: cobc/tree.c:4296 -#, fuzzy, c-format -msgid "missing file description for %s" -msgstr "definizioni mancanti:" - -#: cobc/tree.c:4328 -#, c-format -msgid "size of record '%s' (%d) smaller than minimum of file '%s' (%d)" -msgstr "" - -#: cobc/tree.c:4331 cobc/tree.c:4348 -msgid "file size adjusted" -msgstr "" - -#: cobc/tree.c:4343 -#, c-format -msgid "size of record '%s' (%d) larger than maximum of file '%s' (%d)" -msgstr "" - -#: cobc/tree.c:4386 -#, c-format -msgid "file '%s': RECORD VARYING specified without limits, but implied limits are equal" -msgstr "" - -#: cobc/tree.c:4393 -#, c-format -msgid "file '%s': record size (IDX) %d exceeds maximum allowed (%d)" -msgstr "" - -#: cobc/tree.c:4397 -#, c-format -msgid "file '%s': record size %d exceeds maximum allowed (%d)" -msgstr "" - -#: cobc/tree.c:4404 -msgid "RECORD DELIMITER clause on file with fixed-length records" -msgstr "" - -#: cobc/tree.c:4965 -#, c-format -msgid "literal '%.38s' is longer than '%s'" -msgstr "" - -#: cobc/tree.c:4969 -#, c-format -msgid "literal '%.38s' is longer than reference-modification of '%s'" -msgstr "" - -#: cobc/tree.c:4994 -#, c-format -msgid "literal '%s' is alphanumeric but '%s' is numeric" -msgstr "" - -#: cobc/tree.c:5036 -#, c-format -msgid "literal '%s' has more decimals than '%s'" -msgstr "" - -#: cobc/tree.c:5078 -#, c-format -msgid "literal '%s' has more digits than '%s'" -msgstr "" - -#: cobc/tree.c:5118 cobc/tree.c:5142 -#, c-format -msgid "unsigned '%s' may not be %s %s" -msgstr "" - -#: cobc/tree.c:5128 cobc/tree.c:5151 -#, c-format -msgid "unsigned '%s' may always be %s %s" -msgstr "" - -#: cobc/tree.c:5184 cobc/tree.c:5209 -#, c-format -msgid "'%s' may not be %s %s" -msgstr "" - -#: cobc/tree.c:5195 cobc/tree.c:5220 -#, c-format -msgid "'%s' may always be %s %s" -msgstr "" - -#: cobc/tree.c:5355 -msgid "divide by constant ZERO" -msgstr "" - -#: cobc/tree.c:5404 cobc/tree.c:5409 cobc/tree.c:5630 cobc/tree.c:5670 -#: cobc/typeck.c:4476 cobc/typeck.c:4484 cobc/typeck.c:4491 cobc/typeck.c:5561 -#: cobc/typeck.c:5706 -msgid "invalid expression" -msgstr "espressione non valida" - -#: cobc/tree.c:5627 -#, fuzzy, c-format -msgid "invalid expression: %s %s %s" -msgstr "espressione non valida" - -#: cobc/tree.c:5675 -#, c-format -msgid "unexpected operator: %d" -msgstr "" - -#: cobc/tree.c:5685 -#, c-format -msgid "expression '%.38s' %s '%.38s' is always TRUE" -msgstr "" - -#: cobc/tree.c:5691 -msgid "expression is always TRUE" -msgstr "" - -#: cobc/tree.c:5703 -#, c-format -msgid "expression '%.38s' %s '%.38s' is always FALSE" -msgstr "" - -#: cobc/tree.c:5709 -msgid "expression is always FALSE" -msgstr "" - -#: cobc/tree.c:6024 -msgid "PERFORM FOREVER since UNTIL is always FALSE" -msgstr "" - -#: cobc/tree.c:6028 -msgid "PERFORM ONCE since UNTIL is always TRUE" -msgstr "" - -#: cobc/tree.c:6031 -msgid "PERFORM NEVER since UNTIL is always TRUE" -msgstr "" - -#: cobc/tree.c:6132 -#, c-format -msgid "no definition/prototype seen for FUNCTION '%s'" -msgstr "" - -#: cobc/tree.c:6134 -#, c-format -msgid "no definition/prototype seen for PROGRAM '%s'" -msgstr "" - -#: cobc/tree.c:6143 -#, c-format -msgid "no definition/prototype seen for FUNCTION with external name '%s'" -msgstr "" - -#: cobc/tree.c:6145 -#, c-format -msgid "no definition/prototype seen for PROGRAM with external name '%s'" -msgstr "" - -#: cobc/tree.c:6237 -#, fuzzy, c-format -msgid "FUNCTION %s has invalid argument" -msgstr "FUNCTION '%s' non implementata" - -#: cobc/tree.c:6239 -#, c-format -msgid "either all arguments or none should be if type %s" -msgstr "" - -#: cobc/tree.c:6271 cobc/tree.c:6277 cobc/tree.c:6319 cobc/tree.c:6324 -#, c-format -msgid "FUNCTION '%s' has invalid reference modification" -msgstr "" - -#: cobc/tree.c:6288 cobc/tree.c:6730 -#, c-format -msgid "FUNCTION '%s' unknown" -msgstr "FUNCTION '%s' sconosciuta" - -#: cobc/tree.c:6292 -#, c-format -msgid "FUNCTION '%s' is not implemented" -msgstr "FUNCTION '%s' non implementata" - -#: cobc/tree.c:6299 cobc/tree.c:6306 cobc/tree.c:6714 -#, c-format -msgid "FUNCTION '%s' has wrong number of arguments" -msgstr "" - -#: cobc/tree.c:6313 -#, c-format -msgid "FUNCTION '%s' cannot have reference modification" -msgstr "" - -#: cobc/tree.c:6572 cobc/tree.c:6646 cobc/tree.c:6652 cobc/tree.c:6660 -#: cobc/tree.c:6668 -#, fuzzy, c-format -msgid "FUNCTION '%s' has invalid argument" -msgstr "FUNCTION '%s' non implementata" - -#: cobc/tree.c:6720 -#, fuzzy, c-format -msgid "FUNCTION '%s' has invalid first argument" -msgstr "FUNCTION '%s' non implementata" - -#: cobc/typeck.c:686 -#, c-format -msgid "%s item not allowed here: '%s'" -msgstr "" - -#: cobc/typeck.c:728 -#, c-format -msgid "'%s' is not a group name" -msgstr "" - -#: cobc/typeck.c:753 -#, c-format -msgid "'%s' is not a numeric name" -msgstr "" - -#: cobc/typeck.c:782 -#, c-format -msgid "'%s' is not a numeric or numeric-edited name" -msgstr "" - -#: cobc/typeck.c:835 -#, fuzzy, c-format -msgid "'%s' is Alpha, instead of a numeric value" -msgstr "'%s' non è un numero" - -#: cobc/typeck.c:838 -#, c-format -msgid "'%s' is Alpha Edited, instead of a numeric value" -msgstr "" - -#: cobc/typeck.c:851 -#, c-format -msgid "'%s' is not a numeric value" -msgstr "" - -#: cobc/typeck.c:901 -#, c-format -msgid "'%s' is not an integer value" -msgstr "" - -#: cobc/typeck.c:905 -msgid "positive numeric integer is required here" -msgstr "" - -#: cobc/typeck.c:1022 -msgid "System routine" -msgstr "Routine di sistema" - -#: cobc/typeck.c:1638 libcob/call.c:1069 -#, c-format -msgid "'%s' literal includes leading spaces which are omitted" -msgstr "" - -#: cobc/typeck.c:1642 -#, c-format -msgid "'%s' literal includes trailing spaces which are omitted" -msgstr "" - -#: cobc/typeck.c:1709 -msgid "ON/OFF usage requires a SWITCH name" -msgstr "" - -#: cobc/typeck.c:1727 -#, c-format -msgid "word length exceeds maximum of %d characters: '%s'" -msgstr "" - -#: cobc/typeck.c:1730 cobc/typeck.c:1733 -#, c-format -msgid "word length exceeds %d characters: '%s'" -msgstr "" - -#: cobc/typeck.c:1810 -#, c-format -msgid "ASSIGN %s interpreted as '%s'" -msgstr "" - -#: cobc/typeck.c:1900 cobc/typeck.c:2067 -#, c-format -msgid "subscript missing for '%s' - defaulting to 1" -msgstr "" - -#: cobc/typeck.c:1913 cobc/typeck.c:1992 -#, c-format -msgid "'%s' cannot be reference modified" -msgstr "" - -#: cobc/typeck.c:1923 cobc/typeck.c:1988 cobc/typeck.c:2256 -#, c-format -msgid "'%s' cannot be subscripted" -msgstr "" - -#: cobc/typeck.c:1927 cobc/typeck.c:2260 -#, c-format -msgid "'%s' requires one subscript" -msgstr "" - -#: cobc/typeck.c:1930 cobc/typeck.c:2263 -#, c-format -msgid "'%s' requires %d subscripts" -msgstr "" - -#. TRANSLATORS: This msgid is used when a variable name -#. or label is referenced in a compiler message. -#: cobc/typeck.c:1946 -#, c-format -msgid "'%s'" -msgstr "" - -#: cobc/typeck.c:1948 -#, c-format -msgid "'%s' (accessed by '%s')" -msgstr "" - -#: cobc/typeck.c:2051 -#, c-format -msgid "'%s' has no OCCURS clause" -msgstr "" - -#: cobc/typeck.c:2108 libcob/common.c:3114 -#, c-format -msgid "subscript of '%s' out of bounds: %d" -msgstr "" - -#: cobc/typeck.c:2162 cobc/typeck.c:2172 -msgid "offset must be greater than zero" -msgstr "" - -#: cobc/typeck.c:2167 cobc/typeck.c:2185 cobc/typeck.c:2204 -msgid "length must be greater than zero" -msgstr "" - -#: cobc/typeck.c:2175 cobc/typeck.c:2178 libcob/common.c:3136 -#, c-format -msgid "offset of '%s' out of bounds: %d" -msgstr "" - -#: cobc/typeck.c:2189 cobc/typeck.c:2193 cobc/typeck.c:2207 cobc/typeck.c:2211 -#: libcob/common.c:3149 -#, c-format -msgid "length of '%s' out of bounds: %d" -msgstr "" - -#: cobc/typeck.c:2323 cobc/typeck.c:2407 -msgid "reference modification not allowed here" -msgstr "" - -#: cobc/typeck.c:2337 cobc/typeck.c:2433 -msgid "88 level item not allowed here" -msgstr "" - -#: cobc/typeck.c:2342 -#, c-format -msgid "LENGTH OF '%s' not allowed outside of Procedure Division" -msgstr "" - -#: cobc/typeck.c:2346 cobc/typeck.c:2437 cobc/typeck.c:2445 cobc/typeck.c:2512 -msgid "variable length item not allowed here" -msgstr "" - -#: cobc/typeck.c:2375 -#, c-format -msgid "'%s' has not been DEFINEd" -msgstr "" - -#: cobc/typeck.c:2411 -msgid "only field names allowed here" -msgstr "" - -#: cobc/typeck.c:2422 -#, c-format -msgid "VALUE of '%s': %s target '%s' is invalid" -msgstr "" - -#: cobc/typeck.c:2424 cobc/typeck.c:2494 -msgid "target must be in FILE SECTION or LINKAGE SECTION or have the EXTERNAL clause" -msgstr "" - -#: cobc/typeck.c:2480 cobc/typeck.c:2493 -#, c-format -msgid "VALUE of '%s': %s target is invalid" -msgstr "" - -#: cobc/typeck.c:2482 -msgid "no previous data-item found" -msgstr "" - -#: cobc/typeck.c:2667 -#, c-format -msgid "'%s' is not an alphabet name" -msgstr "" - -#: cobc/typeck.c:2931 -#, c-format -msgid "duplicate character values in alphabet '%s': %s" -msgstr "" - -#: cobc/typeck.c:2936 -#, c-format -msgid "invalid character values in alphabet '%s', starting at position %d" -msgstr "" - -#: cobc/typeck.c:2990 -msgid "invalid ALPHABET name" -msgstr "" - -#: cobc/typeck.c:3054 -#, c-format -msgid "duplicate character values in class '%s'" -msgstr "" - -#: cobc/typeck.c:3072 -#, c-format -msgid "'%s' is not a locale name" -msgstr "" - -#: cobc/typeck.c:3206 -msgid "invalid RECORD DEPENDING item" -msgstr "" - -#: cobc/typeck.c:3211 -msgid "RECORD DEPENDING must reference a data-item" -msgstr "" - -#: cobc/typeck.c:3234 -#, c-format -msgid "RECORD DEPENDING item '%s' should be defined in WORKING-STORAGE, LOCAL-STORAGE or LINKAGE SECTION" -msgstr "" - -#: cobc/typeck.c:3247 -#, c-format -msgid "file %s: RELATIVE KEY %s is not numeric" -msgstr "" - -#: cobc/typeck.c:3256 -#, c-format -msgid "file %s: RELATIVE KEY %s must be integer" -msgstr "" - -#: cobc/typeck.c:3261 -#, c-format -msgid "file %s: RELATIVE KEY %s must be unsigned" -msgstr "" - -#: cobc/typeck.c:3268 -#, c-format -msgid "file %s: RELATIVE KEY %s cannot have OCCURS" -msgstr "" - -#: cobc/typeck.c:3274 -#, c-format -msgid "RELATIVE KEY %s cannot be in file record belonging to %s" -msgstr "" - -#: cobc/typeck.c:3283 -#, c-format -msgid "file %s: RELATIVE KEY %s declared outside WORKING-STORAGE" -msgstr "" - -#: cobc/typeck.c:3306 cobc/typeck.c:7184 -#, c-format -msgid "'%s' is not a valid data name" -msgstr "" - -#: cobc/typeck.c:3313 -#, c-format -msgid "CRT STATUS item '%s' should be defined in WORKING-STORAGE or LOCAL-STORAGE" -msgstr "" - -#: cobc/typeck.c:3319 -#, c-format -msgid "'%s' CRT STATUS must have at least 4 digits" -msgstr "" - -#: cobc/typeck.c:3325 -#, c-format -msgid "'%s' CRT STATUS must be 4 characters long" -msgstr "" - -#: cobc/typeck.c:3341 -#, c-format -msgid "variable '%s' will be implicitly defined" -msgstr "" - -#: cobc/typeck.c:3375 cobc/typeck.c:3438 -msgid "ASSIGN variable" -msgstr "" - -#: cobc/typeck.c:3443 -#, c-format -msgid "ASSIGN data item '%s' is invalid" -msgstr "" - -#: cobc/typeck.c:3507 -#, c-format -msgid "'%s' CURSOR must be 4 or 6 characters long" -msgstr "" - -#: cobc/typeck.c:3557 cobc/typeck.c:3561 -#, c-format -msgid "%s does not have a fixed location" -msgstr "" - -#: cobc/typeck.c:3573 -#, c-format -msgid "'%s' cannot have nested OCCURS DEPENDING" -msgstr "" - -#: cobc/typeck.c:3587 -#, c-format -msgid "'%s' OCCURS DEPENDING ON field item invalid here" -msgstr "" - -#: cobc/typeck.c:3595 -#, c-format -msgid "'%s' cannot have OCCURS DEPENDING because of '%s'" -msgstr "" - -#: cobc/typeck.c:3607 -#, c-format -msgid "'%s' OCCURS DEPENDING ON item must have GLOBAL attribute" -msgstr "" - -#: cobc/typeck.c:3621 -#, c-format -msgid "PASSWORD '%s' for EXTERNAL file '%s' must have EXTERNAL attribute" -msgstr "" - -#: cobc/typeck.c:3644 -#, c-format -msgid "file %s: ASSIGN %s declared outside WORKING-STORAGE" -msgstr "" - -#: cobc/typeck.c:3674 -#, c-format -msgid "duplicate APPLY COMMIT target: '%s'" -msgstr "" - -#: cobc/typeck.c:3688 -msgid "APPLY COMMIT statement invalid for SORT file" -msgstr "" - -#: cobc/typeck.c:3691 -msgid "APPLY COMMIT statement invalid for REPORT file" -msgstr "" - -#: cobc/typeck.c:3698 -#, c-format -msgid "APPLY COMMIT item '%s' should be defined in WORKING-STORAGE or LOCAL-STORAGE" -msgstr "" - -#: cobc/typeck.c:3712 -#, c-format -msgid "item not allowed here: '%s'" -msgstr "" - -#: cobc/typeck.c:3725 -#, c-format -msgid "%s may not be subscripted" -msgstr "" - -#: cobc/typeck.c:3729 -#, c-format -msgid "%s may not be reference modified" -msgstr "" - -#: cobc/typeck.c:3789 -#, c-format -msgid "DEBUGGING target invalid: '%s'" -msgstr "" - -#: cobc/typeck.c:3795 -#, c-format -msgid "DEBUGGING target already specified with ALL PROCEDURES: '%s'" -msgstr "" - -#: cobc/typeck.c:3815 -msgid "DEBUGGING target" -msgstr "" - -#: cobc/typeck.c:3822 -#, c-format -msgid "'%s' is not a valid DEBUGGING target" -msgstr "" - -#: cobc/typeck.c:3860 cobc/typeck.c:3865 -#, c-format -msgid "'%s' is not in DECLARATIVES" -msgstr "" - -#: cobc/typeck.c:3877 -#, c-format -msgid "invalid reference to '%s' (in DECLARATIVES)" -msgstr "" - -#: cobc/typeck.c:3886 -#, c-format -msgid "'%s' is not a procedure name" -msgstr "" - -#: cobc/typeck.c:3948 -#, c-format -msgid "LINKAGE item '%s' is not a PROCEDURE USING parameter" -msgstr "" - -#: cobc/typeck.c:4001 -#, c-format -msgid "'%s' is not an alterable paragraph" -msgstr "" - -#: cobc/typeck.c:4604 cobc/typeck.c:4608 -#, c-format -msgid "suggest parentheses around %s within %s" -msgstr "" - -#: cobc/typeck.c:4616 -#, fuzzy -msgid "invalid conditional expression" -msgstr "espressione non valida" - -#: cobc/typeck.c:4726 -#, c-format -msgid "internal decimal structure size exceeded: %d" -msgstr "" - -#: cobc/typeck.c:4729 -msgid "Try to minimize the number of parentheses or split into multiple computations." -msgstr "" - -#: cobc/typeck.c:4753 -#, c-format -msgid "more than %d nested expressions" -msgstr "" - -#: cobc/typeck.c:4795 -msgid "precision of result may change with arithmetic-osvs" -msgstr "" - -#: cobc/typeck.c:4851 -#, c-format -msgid "unexpected operation: %c (%d)" -msgstr "" - -#: cobc/typeck.c:4856 -#, c-format -msgid "%s operator may be misplaced" -msgstr "" - -#: cobc/typeck.c:4926 -msgid "unexpected constant expansion" -msgstr "" - -#: cobc/typeck.c:5747 -#, c-format -msgid "more than %d nested conditions" -msgstr "" - -#: cobc/typeck.c:6104 cobc/typeck.c:6180 -msgid "no CORRESPONDING items found" -msgstr "" - -#: cobc/typeck.c:6252 -msgid "no items to ACCEPT found" -msgstr "" - -#: cobc/typeck.c:6302 -msgid "no items to DISPLAY found" -msgstr "" - -#: cobc/typeck.c:6421 -msgid "cannot specify figurative constant ZERO in AT clause" -msgstr "" - -#: cobc/typeck.c:6425 -msgid "value in AT clause is not numeric" -msgstr "" - -#: cobc/typeck.c:6431 -msgid "value in AT clause must have 4 or 6 digits" -msgstr "" - -#: cobc/typeck.c:6553 -msgid "invalid PROMPT literal" -msgstr "" - -#: cobc/typeck.c:6558 -msgid "invalid PROMPT identifier" -msgstr "" - -#: cobc/typeck.c:6848 -#, c-format -msgid "'%s' is not an input device" -msgstr "" - -#: cobc/typeck.c:6878 cobc/typeck.c:8016 -#, c-format -msgid "'%s' is not defined in SPECIAL-NAMES" -msgstr "" - -#: cobc/typeck.c:6883 -#, c-format -msgid "invalid input device '%s'" -msgstr "" - -#: cobc/typeck.c:6888 cobc/typeck.c:8020 -#, c-format -msgid "unknown device '%s'; it may exist in another dialect" -msgstr "" - -#: cobc/typeck.c:6891 cobc/typeck.c:8023 -#, c-format -msgid "unknown device '%s'; not defined in SPECIAL-NAMES" -msgstr "" - -#: cobc/typeck.c:6915 -msgid "target of ALLOCATE is not a BASED item" -msgstr "" - -#: cobc/typeck.c:6926 -msgid "target of RETURNING is not a data pointer" -msgstr "" - -#: cobc/typeck.c:6936 cobc/typeck.c:7342 -msgid "amount must be specified as a numeric expression" -msgstr "" - -#: cobc/typeck.c:6949 -msgid "INITIALIZED TO item is not alphanumeric" -msgstr "" - -#: cobc/typeck.c:7019 -msgid "only alphanumeric FUNCTION types are allowed here" -msgstr "" - -#: cobc/typeck.c:7027 -msgid "invalid RETURNING field" -msgstr "" - -#: cobc/typeck.c:7046 -msgid "STDCALL not available on this platform" -msgstr "" - -#: cobc/typeck.c:7050 -msgid "STDCALL used on 64-bit Windows platform" -msgstr "" - -#: cobc/typeck.c:7055 -msgid "STATIC CALL convention requires a literal program name" -msgstr "" - -#: cobc/typeck.c:7060 cobc/typeck.c:10632 cobc/typeck.c:11539 -#: cobc/typeck.c:11903 -msgid "HANDLE must be either a generic or a THREAD HANDLE" -msgstr "" - -#: cobc/typeck.c:7078 -msgid "numeric literal is negative" -msgstr "" - -#: cobc/typeck.c:7157 -msgid "numeric literal exceeds size limits" -msgstr "" - -#: cobc/typeck.c:7175 -#, c-format -msgid "figurative constant %s invalid here" -msgstr "" - -#: cobc/typeck.c:7190 -#, c-format -msgid "'%s' ANY LENGTH item not passed BY REFERENCE" -msgstr "" - -#: cobc/typeck.c:7198 -#, c-format -msgid "'%s' is not a 01 or 77 level item" -msgstr "" - -#: cobc/typeck.c:7228 cobc/typeck.c:7233 -#, c-format -msgid "wrong number of CALL parameters for '%s', %d given, %d expected" -msgstr "" - -#: cobc/typeck.c:7300 cobc/typeck.c:7374 cobc/typeck.c:7378 cobc/typeck.c:7382 -#: cobc/typeck.c:7412 cobc/typeck.c:10591 cobc/typeck.c:10755 -#: cobc/typeck.c:10944 cobc/typeck.c:10948 cobc/typeck.c:11844 -#: cobc/typeck.c:12087 cobc/typeck.c:12090 -#, c-format -msgid "%s not allowed on %s files" -msgstr "" - -#: cobc/typeck.c:7336 -msgid "AFTER phrase in CONTINUE statement" -msgstr "" - -#: cobc/typeck.c:7478 -msgid "positions cannot be specified for main windows" -msgstr "" - -#: cobc/typeck.c:7488 cobc/typeck.c:7491 cobc/typeck.c:7508 -msgid "HANDLE must be either a generic or a WINDOW HANDLE or X(10)" -msgstr "" - -#: cobc/typeck.c:7617 -#, c-format -msgid "'%s' is an invalid type for DISPLAY operand" -msgstr "" - -#: cobc/typeck.c:7622 -msgid "invalid type for DISPLAY operand" -msgstr "" - -#: cobc/typeck.c:7973 cobc/typeck.c:8006 -#, c-format -msgid "'%s' is not an output device" -msgstr "" - -#: cobc/typeck.c:8109 -msgid "invalid use of 88 level in WHEN expression" -msgstr "" - -#: cobc/typeck.c:8165 -msgid "wrong number of WHEN parameters" -msgstr "" - -#: cobc/typeck.c:8244 cobc/typeck.c:8256 -#, c-format -msgid "target %d of FREE is not a BASED data item" -msgstr "" - -#: cobc/typeck.c:8262 -#, c-format -msgid "target %d of FREE must be a data pointer" -msgstr "" - -#: cobc/typeck.c:8276 -msgid "GO TO without procedure-name" -msgstr "" - -#: cobc/typeck.c:8286 -msgid "GO TO with multiple procedure-names" -msgstr "" - -#: cobc/typeck.c:8308 -msgid "GO TO ENTRY with multiple entry-names" -msgstr "" - -#: cobc/typeck.c:8367 -msgid "invalid INITIALIZE statement" -msgstr "" - -#: cobc/typeck.c:8443 cobc/typeck.c:8446 -#, c-format -msgid "%s operands differ in size" -msgstr "" - -#: cobc/typeck.c:8476 -#, c-format -msgid "unexpected clause %d" -msgstr "" - -#: cobc/typeck.c:8545 cobc/typeck.c:8556 cobc/typeck.c:8567 cobc/typeck.c:8578 -#, c-format -msgid "data name expected before %s" -msgstr "" - -#: cobc/typeck.c:8588 -#, c-format -msgid "ALL, LEADING or TRAILING expected before '%s'" -msgstr "" - -#: cobc/typeck.c:8598 -msgid "operand has wrong size" -msgstr "" - -#: cobc/typeck.c:8669 -#, c-format -msgid "internal register '%s' defined as BINARY-LONG" -msgstr "" - -#: cobc/typeck.c:8672 cobc/typeck.c:8675 cobc/typeck.c:8678 cobc/typeck.c:8681 -#: cobc/typeck.c:8684 cobc/typeck.c:8687 cobc/typeck.c:8690 cobc/typeck.c:8693 -#: cobc/typeck.c:8696 -#, c-format -msgid "'%s' defined here as USAGE %s" -msgstr "" - -#: cobc/typeck.c:8699 -#, c-format -msgid "'%s' defined here as PIC %s" -msgstr "" - -#: cobc/typeck.c:8702 -#, c-format -msgid "'%s' defined here as a group of length %d" -msgstr "" - -#: cobc/typeck.c:8741 -#, c-format -msgid "value is %s" -msgstr "" - -#: cobc/typeck.c:8745 -#, c-format -msgid "value size is %d" -msgstr "" - -#: cobc/typeck.c:9022 -msgid "invalid destination for MOVE" -msgstr "" - -#: cobc/typeck.c:9057 -msgid "MOVE of figurative constant SPACE to numeric item" -msgstr "" - -#: cobc/typeck.c:9072 -msgid "MOVE of figurative constant QUOTE to numeric item" -msgstr "" - -#: cobc/typeck.c:9077 cobc/typeck.c:9089 -msgid "MOVE of figurative constant to numeric item" -msgstr "" - -#: cobc/typeck.c:9151 -msgid "numeric literal in VALUE clause of numeric-edited item" -msgstr "" - -#: cobc/typeck.c:9176 -msgid "numeric move to ALPHABETIC" -msgstr "" - -#: cobc/typeck.c:9188 -msgid "data item not signed" -msgstr "" - -#: cobc/typeck.c:9191 -msgid "ignoring sign" -msgstr "" - -#: cobc/typeck.c:9503 -msgid "overlapping MOVE may occur and produce unpredictable results" -msgstr "" - -#: cobc/typeck.c:9510 -msgid "overlapping MOVE may produce unpredictable results" -msgstr "" - -#: cobc/typeck.c:9643 -msgid "invalid source for MOVE" -msgstr "" - -#: cobc/typeck.c:9666 -msgid "source is non-numeric - substituting zero" -msgstr "" - -#: cobc/typeck.c:9672 cobc/typeck.c:9683 -msgid "invalid VALUE clause" -msgstr "" - -#: cobc/typeck.c:9675 cobc/typeck.c:11480 cobc/typeck.c:11485 -#: cobc/typeck.c:11512 cobc/typeck.c:11517 -msgid "invalid SET statement" -msgstr "" - -#: cobc/typeck.c:9677 -msgid "invalid MOVE statement" -msgstr "" - -#: cobc/typeck.c:9684 -msgid "literal exceeds data size" -msgstr "" - -#: cobc/typeck.c:9688 -msgid "numeric literal exceeds data size" -msgstr "" - -#: cobc/typeck.c:9697 -msgid "MOVE of non-integer to alphanumeric" -msgstr "" - -#: cobc/typeck.c:9703 -msgid "numeric value is expected" -msgstr "" - -#: cobc/typeck.c:9708 -msgid "alphanumeric value is expected" -msgstr "" - -#: cobc/typeck.c:9713 -msgid "value does not fit the picture string" -msgstr "" - -#: cobc/typeck.c:9719 -msgid "value size exceeds data size" -msgstr "" - -#: cobc/typeck.c:9724 -msgid "sending field larger than receiving field" -msgstr "" - -#: cobc/typeck.c:9729 -msgid "some digits may be truncated" -msgstr "" - -#: cobc/typeck.c:10515 -#, c-format -msgid "invalid MOVE target: %s" -msgstr "" - -#: cobc/typeck.c:10768 -msgid "READ PREVIOUS not allowed for this file type" -msgstr "" - -#: cobc/typeck.c:10776 -msgid "KEY ignored with sequential READ" -msgstr "" - -#: cobc/typeck.c:10872 -msgid "figurative constants not allowed in FROM clause" -msgstr "" - -#: cobc/typeck.c:10879 -msgid "literal in FROM clause must be alphanumeric, national or boolean" -msgstr "" - -#: cobc/typeck.c:10902 cobc/typeck.c:12047 -#, c-format -msgid "%s FILE requires a FROM clause" -msgstr "" - -#: cobc/typeck.c:10924 cobc/typeck.c:11010 cobc/typeck.c:12069 -#, c-format -msgid "%s subject does not refer to a record name" -msgstr "" - -#: cobc/typeck.c:11016 -msgid "RELEASE not allowed on this record item" -msgstr "" - -#: cobc/typeck.c:11097 cobc/typeck.c:11118 cobc/typeck.c:11125 -msgid "invalid SEARCH ALL condition" -msgstr "" - -#: cobc/typeck.c:11237 cobc/typeck.c:11241 -msgid "SET targets must be PROGRAM-POINTER" -msgstr "" - -#: cobc/typeck.c:11268 cobc/typeck.c:11335 cobc/typeck.c:11403 -#, c-format -msgid "cannot change address of '%s', which is not level 1 or 77" -msgstr "" - -#: cobc/typeck.c:11272 cobc/typeck.c:11339 cobc/typeck.c:11407 -#, c-format -msgid "cannot change address of '%s', which is not BASED or a LINKAGE item" -msgstr "" - -#: cobc/typeck.c:11291 -#, c-format -msgid "SET target '%s' is not numeric, an INDEX or a POINTER" -msgstr "" - -#: cobc/typeck.c:11360 -#, c-format -msgid "SET target '%s' is not a POINTER for FCD" -msgstr "" - -#: cobc/typeck.c:11428 -#, c-format -msgid "SET target '%s' is not a POINTER for FCD-KEYDEF" -msgstr "" - -#: cobc/typeck.c:11521 -msgid "field does not have a FALSE clause" -msgstr "" - -#: cobc/typeck.c:11552 -msgid "THREAD-priority must be between 1 and 32767" -msgstr "" - -#: cobc/typeck.c:11572 -msgid "SET ATTRIBUTE requires a screen item as subject" -msgstr "" - -#: cobc/typeck.c:11578 -msgid "SET ATTRIBUTE subject does not refer to a screen item" -msgstr "" - -#: cobc/typeck.c:11629 -msgid "invalid SORT filename" -msgstr "" - -#: cobc/typeck.c:11689 -msgid "invalid SORT USING parameter" -msgstr "" - -#: cobc/typeck.c:11718 -msgid "invalid SORT GIVING parameter" -msgstr "" - -#: cobc/typeck.c:11772 cobc/typeck.c:11799 cobc/typeck.c:11819 -msgid "invalid key item" -msgstr "" - -#: cobc/typeck.c:11849 -msgid "LENGTH/SIZE clause only allowed on INDEXED files" -msgstr "" - -#: cobc/typeck.c:11854 -msgid "START not allowed with ACCESS MODE RANDOM" -msgstr "" - -#: cobc/typeck.c:12103 -msgid "LOCK clause invalid here" -msgstr "" - -#: cobc/typeck.c:12365 -msgid "data item is not part of a report" -msgstr "" - -#: cobc/typeck.c:12385 -msgid "improper use of SUPPRESS PRINTING" -msgstr "" - -#: cobc/typeck.c:12400 -#, fuzzy, c-format -msgid "%s must be alphanumeric or national" -msgstr "deve essere un numero" - -#: cobc/typeck.c:12411 -#, c-format -msgid "%s may not be a figurative constant" -msgstr "" - -#: cobc/typeck.c:12438 -#, c-format -msgid "%s must be a child of the input record" -msgstr "" - -#: cobc/typeck.c:12464 -#, c-format -msgid "%s may not be an ignored item in JSON/XML GENERATE" -msgstr "" - -#: cobc/typeck.c:12475 -#, fuzzy, c-format -msgid "%s must be elementary" -msgstr "deve essere un numero" - -#: cobc/typeck.c:12487 -#, c-format -msgid "%s must be USAGE DISPLAY or NATIONAL" -msgstr "" - -#: cobc/typeck.c:12501 -#, fuzzy, c-format -msgid "%s must be an integer" -msgstr "'%s' non è un integer" - -#: cobc/typeck.c:12517 cobc/typeck.c:12523 -msgid "JSON/XML GENERATE receiving item" -msgstr "" - -#: cobc/typeck.c:12520 -msgid "JSON/XML GENERATE receiving item may not have JUSTIFIED clause" -msgstr "" - -#: cobc/typeck.c:12608 -msgid "JSON/XML GENERATE input record may not be reference modified" -msgstr "" - -#: cobc/typeck.c:12614 -msgid "JSON/XML GENERATE input record may not have RENAMES clause" -msgstr "" - -#: cobc/typeck.c:12619 -#, c-format -msgid "all the children of '%s' are ignored in JSON/XML GENERATE" -msgstr "" - -#: cobc/typeck.c:12626 -msgid "JSON/XML GENERATE input record has subrecords with non-unique names" -msgstr "" - -#: cobc/typeck.c:12631 -msgid "floating-point items in JSON/XML GENERATE" -msgstr "" - -#: cobc/typeck.c:12635 -msgid "OCCURS items in JSON/XML GENERATE" -msgstr "" - -#: cobc/typeck.c:12660 -msgid "COUNT IN item must be numeric and an integer" -msgstr "" - -#: cobc/typeck.c:12665 -msgid "COUNT IN item must be an integer" -msgstr "" - -#: cobc/typeck.c:12668 -msgid "COUNT IN item may not have PICTURE with P in it" -msgstr "" - -#: cobc/typeck.c:12711 -msgid "NAMESPACE must be a valid URI" -msgstr "" - -#: cobc/typeck.c:12755 -msgid "NAMESPACE-PREFIX must be a valid XML name" -msgstr "" - -#: cobc/typeck.c:12780 cobc/typeck.c:12787 -msgid "NAME OF item" -msgstr "" - -#: cobc/typeck.c:12784 -msgid "NAME OF item must be the input record or a child of it" -msgstr "" - -#: cobc/typeck.c:12791 -msgid "NAME OF name must be a valid XML name" -msgstr "" - -#: cobc/typeck.c:12817 cobc/typeck.c:12818 cobc/typeck.c:12821 -#: cobc/typeck.c:12825 -msgid "TYPE OF item" -msgstr "" - -#: cobc/typeck.c:12843 -msgid "SUPPRESS WHEN SPACE item" -msgstr "" - -#: cobc/typeck.c:12846 -msgid "SUPPRESS WHEN LOW-VALUE item" -msgstr "" - -#: cobc/typeck.c:12848 -msgid "SUPPRESS WHEN HIGH-VALUE item" -msgstr "" - -#: cobc/typeck.c:12877 cobc/typeck.c:12885 cobc/typeck.c:12889 -msgid "SUPPRESS item" -msgstr "" - -#: cobc/typeck.c:12881 -msgid "SUPPRESS item with WHEN clause" -msgstr "" - -#: cobc/typeck.c:12958 -msgid "WITH ATTRIBUTES specified, but no attributes can be generated" -msgstr "" - -#: cobc/warning.def:34 -#, fuzzy -msgid " -Wextra additional warnings only raised with -W or -Wall" -msgstr " -Werror tratta i warning come se fossero errori" - -#: cobc/warning.def:37 -msgid " -Wno-unfinished do not warn if unfinished features are used" -msgstr "" - -#: cobc/warning.def:40 -msgid " -Wno-pending do not warn if pending features are mentioned" -msgstr "" - -#: cobc/warning.def:43 -msgid " -Wobsolete warn if obsolete features are used" -msgstr "" - -#: cobc/warning.def:46 -msgid " -Warchaic warn if archaic features are used" -msgstr "" - -#: cobc/warning.def:49 -msgid " -Wredefinition warn about incompatible redefinition of data items" -msgstr "" - -#: cobc/warning.def:52 -msgid " -Wtruncate warn about field truncation from constant assignments" -msgstr "" - -#: cobc/warning.def:55 -msgid " -Wpossible-truncate warn about possible field truncation" -msgstr "" - -#: cobc/warning.def:58 -msgid " -Woverlap warn about overlapping MOVE of items" -msgstr "" - -#: cobc/warning.def:61 -msgid " -Wpossible-overlap warn about MOVE of items that may overlap depending on variables" -msgstr "" - -#: cobc/warning.def:64 -msgid " -Wparentheses warn about lack of parentheses around AND within OR" -msgstr "" - -#: cobc/warning.def:67 -msgid " -Wstrict-typing warn strictly about type mismatch" -msgstr "" - -#: cobc/warning.def:70 -msgid " -Wimplicit-define warn about implicitly defined data items" -msgstr "" - -#: cobc/warning.def:73 -msgid " -Wcorresponding warn about CORRESPONDING with no matching items" -msgstr "" - -#: cobc/warning.def:76 -msgid " -Winitial-value warn if initial VALUE clause is ignored" -msgstr "" - -#: cobc/warning.def:79 -msgid " -Wprototypes warn about missing FUNCTION prototypes/definitions" -msgstr "" - -#: cobc/warning.def:82 -msgid " -Warithmetic-osvs warn if arithmetic expression precision has changed" -msgstr "" - -#: cobc/warning.def:85 -msgid " -Wcall-params warn about non 01/77 items for CALL parameters" -msgstr "" - -#: cobc/warning.def:88 -msgid " -Wconstant-expression warn about expressions that always resolve to true/false" -msgstr "" - -#: cobc/warning.def:91 -msgid " -Wcolumn-overflow warn about text after program-text area, FIXED format" -msgstr "" - -#: cobc/warning.def:94 -msgid " -Wterminator warn about lack of scope terminator END-XXX" -msgstr "" - -#: cobc/warning.def:97 -msgid " -Wlinkage warn about dangling LINKAGE items" -msgstr "" - -#: cobc/warning.def:100 -msgid " -Wunreachable warn about likely unreachable statements" -msgstr "" - -#: cobc/warning.def:103 -msgid " -Wno-dialect do not warn about dialect specific issues" -msgstr "" - -#: cobc/warning.def:106 -#, fuzzy -msgid " -Wothers do not warn about different issues" -msgstr " -Werror tratta i warning come se fossero errori" - -#: cobc/warning.def:109 -msgid " -Wno-unsupported do not warn if runtime does not support a feature used" -msgstr "" - -#: libcob/call.c:87 -#, c-format -msgid "LoadLibrary/GetProcAddress error %d" -msgstr "" - -#: libcob/call.c:939 -msgid "indeterminable error in resolve of COBOL CALL" -msgstr "" - -#: libcob/call.c:1022 -#, c-format -msgid "user-defined FUNCTION '%s' not found" -msgstr "" - -#: libcob/call.c:1129 libcob/call.c:1208 libcob/call.c:1326 libcob/call.c:1354 -#, c-format -msgid "NULL parameter passed to '%s'" -msgstr "" - -#: libcob/call.c:1204 -#, c-format -msgid "invalid number of arguments passed to '%s'" -msgstr "" - -#: libcob/call.c:1330 -msgid "multiple call to 'cob_setjmp'" -msgstr "" - -#: libcob/call.c:1358 -msgid "call to 'cob_longjmp' with no prior 'cob_setjmp'" -msgstr "" - -#: libcob/call.c:1592 libcob/call.c:1633 libcob/call.c:1646 -#: libcob/common.c:7081 -msgid "cob_init() has not been called" -msgstr "" - -#: libcob/call.c:1598 -#, c-format -msgid "parameter %d is not within range of %d" -msgstr "" - -#: libcob/call.c:1604 -#, fuzzy, c-format -msgid "parameter %d is NULL" -msgstr "Parametri" - -#: libcob/call.c:1859 libcob/call.c:1916 -#, c-format -msgid "attempt to over-write constant parameter %d with " -msgstr "" - -#: libcob/call.c:1965 -#, c-format -msgid "attempt to over-write constant parameter %d with '%s'" -msgstr "" - -#: libcob/cobgetopt.c:497 -#, c-format -msgid "%s: option '%s' is ambiguous; possibilities:" -msgstr "" - -#: libcob/cobgetopt.c:538 -#, c-format -msgid "%s: option '--%s' doesn't allow an argument" -msgstr "" - -#: libcob/cobgetopt.c:545 -#, c-format -msgid "%s: option '%c%s' doesn't allow an argument" -msgstr "" - -#: libcob/cobgetopt.c:565 -#, c-format -msgid "%s: option '--%s' requires an argument" -msgstr "" - -#: libcob/cobgetopt.c:597 -#, c-format -msgid "%s: unrecognized option '--%s'" -msgstr "" - -#: libcob/cobgetopt.c:604 -#, c-format -msgid "%s: unrecognized option '%c%s'" -msgstr "" - -#: libcob/cobgetopt.c:633 -#, c-format -msgid "%s: invalid option -- %c" -msgstr "" - -#: libcob/cobgetopt.c:664 libcob/cobgetopt.c:805 -#, c-format -msgid "%s: option requires an argument -- %c" -msgstr "" - -#: libcob/cobgetopt.c:714 -#, c-format -msgid "%s: option '-W %s' is ambiguous" -msgstr "" - -#: libcob/cobgetopt.c:736 -#, c-format -msgid "%s: option '-W %s' doesn't allow an argument" -msgstr "" - -#: libcob/cobgetopt.c:754 -#, c-format -msgid "%s: option '%s' requires an argument" -msgstr "" - -#: libcob/common.c:793 -#, c-format -msgid "attempt to reference unallocated memory" -msgstr "" - -#: libcob/common.c:798 -#, c-format -msgid "bus error" -msgstr "" - -#: libcob/common.c:803 -#, c-format -msgid "fatal arithmetic error" -msgstr "" - -#: libcob/common.c:807 -#, c-format -msgid "caught signal" -msgstr "" - -#: libcob/common.c:811 -#, c-format -msgid "signal %s" -msgstr "" - -#: libcob/common.c:817 -#, c-format -msgid "abnormal termination - file contents may be incorrect" -msgstr "" - -#: libcob/common.c:2049 -msgid "NULL field" -msgstr "" - -#: libcob/common.c:2059 -msgid "field with NULL address" -msgstr "" - -#: libcob/common.c:2345 -#, fuzzy -msgid "version mismatch" -msgstr "La versione di C è %s%s" - -#: libcob/common.c:2346 libcob/common.c:2348 -#, fuzzy, c-format -msgid "%s has version %s.%d" -msgstr "La versione di C è %s%s" - -#: libcob/common.c:2358 -#, c-format -msgid "CALL to %s requires %d arguments" -msgstr "" - -#: libcob/common.c:2980 -#, c-format -msgid "BASED/LINKAGE item %s has NULL address" -msgstr "" - -#: libcob/common.c:2992 libcob/common.c:2995 -#, c-format -msgid "LINKAGE item %s not passed by caller" -msgstr "" - -#: libcob/common.c:3081 -#, fuzzy, c-format -msgid "'%s' (Type: %s) not numeric: '%s'" -msgstr "'%s' non è un numero" - -#: libcob/common.c:3096 -#, c-format -msgid "OCCURS DEPENDING ON '%s' out of bounds: %d" -msgstr "" - -#: libcob/common.c:3099 libcob/common.c:3120 -#, c-format -msgid "maximum subscript for '%s': %d" -msgstr "" - -#: libcob/common.c:3101 -#, c-format -msgid "minimum subscript for '%s': %d" -msgstr "" - -#: libcob/common.c:3117 -#, c-format -msgid "current maximum subscript for '%s': %d" -msgstr "" - -#: libcob/common.c:3139 -#, c-format -msgid "offset of '%s' out of bounds: %d, maximum: %d" -msgstr "" - -#: libcob/common.c:3152 -#, c-format -msgid "length of '%s' out of bounds: %d, maximum: %d" -msgstr "" - -#: libcob/common.c:3161 -#, c-format -msgid "length of '%s' out of bounds: %d, starting at: %d, maximum: %d" -msgstr "" - -#: libcob/common.c:3176 libcob/common.c:3181 -#, c-format -msgid "EXTERNAL item '%s' previously allocated with size %d, requested size is %d" -msgstr "" - -#: libcob/common.c:3682 -#, c-format -msgid "COB_CURRENT_DATE '%s' is invalid" -msgstr "" - -#: libcob/common.c:4585 -#, c-format -msgid "parameter to SYSTEM call is larger than %d characters" -msgstr "" - -#: libcob/common.c:5195 -#, c-format -msgid "error '%s' during CBL_GC_FORK" -msgstr "" - -#: libcob/common.c:5200 libcob/common.c:5297 -#, c-format -msgid "'%s' is not supported on this platform" -msgstr "" - -#: libcob/common.c:5226 -#, c-format -msgid "error '%s' for P%d during CBL_GC_WAITPID" -msgstr "" - -#: libcob/common.c:5418 -msgid "Call to CBL_GC_GETOPT with wrong longoption size." -msgstr "" - -#: libcob/common.c:5423 -msgid "Call to CBL_GC_GETOPT with missing longind." -msgstr "" - -#: libcob/common.c:5837 libcob/common.c:5858 libcob/common.c:5871 -#: libcob/common.c:7785 -#, fuzzy, c-format -msgid "(default)" -msgstr " (default)" - -#: libcob/common.c:6119 libcob/common.c:6138 -msgid "should be unsigned" -msgstr "" - -#: libcob/common.c:6127 libcob/common.c:6176 -#, fuzzy -msgid "should be numeric" -msgstr "deve essere un numero" - -#: libcob/common.c:6185 -#, c-format -msgid "minimum value: %lu" -msgstr "" - -#: libcob/common.c:6236 libcob/common.c:6787 libcob/common.c:6801 -#, c-format -msgid "should not contain '%c'" -msgstr "" - -#: libcob/common.c:6316 libcob/common.c:6384 libcob/common.c:6393 -#: libcob/common.c:6401 -#, c-format -msgid "not set" -msgstr "" - -#: libcob/common.c:6376 libcob/common.c:6379 libcob/common.c:6382 -#, fuzzy, c-format -msgid "set by %s" -msgstr "Scritto da %s\n" - -#: libcob/common.c:6516 -#, c-format -msgid "WARNING - '%s' without a value - ignored!" -msgstr "" - -#: libcob/common.c:6519 -#, c-format -msgid "'%s' without a value!" -msgstr "" - -#: libcob/common.c:6545 -#, c-format -msgid "WARNING - '%s %s' without a value - ignored!" -msgstr "" - -#: libcob/common.c:7034 -#, fuzzy -msgid "error" -msgstr "errore: " - -#: libcob/common.c:7064 -msgid "attempt to CANCEL active program" -msgstr "" - -#: libcob/common.c:7091 -msgid "CALL of program with CHAINING clause" -msgstr "" - -#: libcob/common.c:7095 -msgid "stack overflow, possible PERFORM depth exceeded" -msgstr "" - -#: libcob/common.c:7100 -msgid "invalid entry/exit in GLOBAL USE procedure" -msgstr "" - -#: libcob/common.c:7105 -msgid "unable to allocate memory" -msgstr "impossibile allocare memoria" - -#: libcob/common.c:7110 -msgid "invalid entry into module" -msgstr "" - -#: libcob/common.c:7115 -#, c-format -msgid "recursive CALL from %s to %s which is NOT RECURSIVE" -msgstr "" - -#: libcob/common.c:7125 -msgid "divide by ZERO" -msgstr "" - -#: libcob/common.c:7132 -msgid "end of file" -msgstr "" - -#: libcob/common.c:7135 -msgid "key out of range" -msgstr "" - -#: libcob/common.c:7138 -msgid "key order not ascending" -msgstr "" - -#: libcob/common.c:7141 -msgid "record key already exists" -msgstr "" - -#: libcob/common.c:7144 -msgid "record key does not exist" -msgstr "" - -#: libcob/common.c:7147 -msgid "permanent file error" -msgstr "" - -#: libcob/common.c:7150 -msgid "inconsistant file name" -msgstr "" - -#: libcob/common.c:7153 -msgid "file does not exist" -msgstr "" - -#: libcob/common.c:7156 -msgid "permission denied" -msgstr "permesso negato" - -#: libcob/common.c:7159 -msgid "file already open" -msgstr "file già aperto" - -#: libcob/common.c:7162 -msgid "file not open" -msgstr "file non aperto" - -#: libcob/common.c:7165 -msgid "READ must be executed first" -msgstr "" - -#: libcob/common.c:7168 -msgid "record overflow" -msgstr "" - -#: libcob/common.c:7171 -msgid "READ after unsuccessful READ/START" -msgstr "" - -#: libcob/common.c:7174 -msgid "READ/START not allowed, file not open for input" -msgstr "" - -#: libcob/common.c:7177 -msgid "WRITE not allowed, file not open for output" -msgstr "" - -#: libcob/common.c:7180 -msgid "DELETE/REWRITE not allowed, file not open for I-O" -msgstr "" - -#: libcob/common.c:7183 -msgid "record locked by another file connector" -msgstr "" - -#: libcob/common.c:7186 -msgid "LINAGE values invalid" -msgstr "" - -#: libcob/common.c:7189 -msgid "file sharing conflict" -msgstr "" - -#: libcob/common.c:7193 -msgid "runtime library is not configured for this operation" -msgstr "" - -#: libcob/common.c:7198 -msgid "unknown file error" -msgstr "" - -#: libcob/common.c:7205 -#, c-format -msgid "%s (status = %02d) for file %s" -msgstr "" - -#: libcob/common.c:7208 -#, c-format -msgid "%s (status = %02d) for file %s on %s" -msgstr "" - -#: libcob/common.c:7215 -msgid "attempt to use non-implemented function" -msgstr "" - -#: libcob/common.c:7218 -msgid "attempt to use non-implemented XML I/O" -msgstr "" - -#: libcob/common.c:7221 -msgid "attempt to use non-implemented JSON I/O" -msgstr "" - -#: libcob/common.c:7268 -msgid "environment variables" -msgstr "" - -#: libcob/common.c:7315 -msgid "License LGPLv3+: GNU LGPL version 3 or later " -msgstr "Licenza GPLv3+: GNU GPL versione 3 o successive " - -#: libcob/common.c:7372 libcob/common.c:7374 -msgid "dynamic loading" -msgstr "caricamento dinamico" - -#: libcob/common.c:7379 -msgid "enabled" -msgstr "abilitato" - -#: libcob/common.c:7460 libcob/common.c:7577 libcob/common.c:7586 -#: libcob/common.c:7603 libcob/common.c:7618 -#, fuzzy, c-format -msgid "%s, version %d.%d.%d" -msgstr "La versione di C è %s%s" - -#: libcob/common.c:7462 libcob/common.c:7579 libcob/common.c:7588 -#: libcob/common.c:7620 -#, c-format -msgid "%s, version %d.%d.%d (compiled with %d.%d)" -msgstr "" - -#: libcob/common.c:7465 -#, fuzzy, c-format -msgid "%s, version %s" -msgstr "La versione di C è %s%s" - -#: libcob/common.c:7486 libcob/common.c:7488 libcob/common.c:7493 -#: libcob/common.c:7495 libcob/common.c:7498 -#, fuzzy -msgid "mouse support" -msgstr "" - -#: libcob/common.c:7636 -msgid "CALL configuration" -msgstr "Configurazione CALL" - -#: libcob/common.c:7637 -msgid "File I/O configuration" -msgstr "Configurazione I/O file" - -#: libcob/common.c:7638 -msgid "Screen I/O configuration" -msgstr "Configurazione I/O schermo" - -#: libcob/common.c:7639 -msgid "Miscellaneous" -msgstr "Varie" - -#: libcob/common.c:7640 -msgid "System configuration" -msgstr "Configurazione sistema" - -#: libcob/common.c:7644 -msgid "runtime configuration" -msgstr "" - -#: libcob/common.c:7646 -msgid "via" -msgstr "" - -#: libcob/common.c:7719 libcob/common.c:7747 -msgid "... removed from environment" -msgstr "" - -#: libcob/common.c:7773 libcob/common.c:7775 -#, c-format -msgid "(set by %s)" -msgstr "" - -#: libcob/common.c:7783 -#, fuzzy, c-format -msgid "(reset)" -msgstr " (reset)" - -#: libcob/common.c:8167 libcob/common.c:8286 -#, c-format -msgid "%s called with unknown option: %d" -msgstr "" - -#: libcob/common.c:8239 -#, c-format -msgid "Module dump due to %s\n" -msgstr "" - -#: libcob/common.c:8243 -#, c-format -msgid " Last statement of %s was Line %d of %s\n" -msgstr "" - -#: libcob/common.c:8249 -#, c-format -msgid " Last statement of %s unknown\n" -msgstr "" - -#: libcob/common.c:8259 -#, c-format -msgid "Dump Program-Id %s from %s compiled %s\n" -msgstr "" - -#: libcob/fileio.c:287 -#, c-format -msgid "ERROR I/O routine %s is not present" -msgstr "" - -#: libcob/fileio.c:1365 -#, c-format -msgid "I/O routine %s is not present for %s" -msgstr "" - -#: libcob/fileio.c:1404 -#, c-format -msgid "I/O routine %s is not known for %s" -msgstr "" - -#: libcob/fileio.c:2599 -#, c-format -msgid "ERROR FILE %s has record size %d exceeds %d in program" -msgstr "" - -#: libcob/fileio.c:2967 libcob/fileio.c:2974 -#, c-format -msgid "ERROR FILE %s opening pipe" -msgstr "" - -#: libcob/fileio.c:4979 -#, c-format -msgid "ERROR FILE %s does not match current version; Recompile the program" -msgstr "" - -#: libcob/fileio.c:5034 -#, c-format -msgid "ERROR FILE %s has ASSIGN field is NULL" -msgstr "" - -#: libcob/fileio.c:5707 -#, c-format -msgid "call to CBL_OPEN_FILE with wrong access mode: %d" -msgstr "" - -#: libcob/fileio.c:5756 -#, c-format -msgid "call to CBL_CREATE_FILE with wrong file_lock: %d" -msgstr "" - -#: libcob/fileio.c:5759 -#, c-format -msgid "call to CBL_CREATE_FILE with wrong file_dev: %d" -msgstr "" - -#: libcob/fileio.c:5955 libcob/fileio.c:6215 -#, c-format -msgid "'%s' - File detail area is too short" -msgstr "" - -#: libcob/fileio.c:6437 -msgid "SORT is unable to acquire temporary file" -msgstr "" - -#: libcob/fileio.c:7057 -#, c-format -msgid "implicit CLOSE of %s" -msgstr "" - -#: libcob/fileio.c:7165 -#, c-format -msgid "C-ISAM library %s is not present" -msgstr "" - -#: libcob/fileio.c:7173 -#, c-format -msgid "D-ISAM library %s is not present" -msgstr "" - -#: libcob/fileio.c:7181 -#, c-format -msgid "VB-ISAM library %s is not present" -msgstr "" - -#: libcob/screenio.c:429 -msgid "failed to initialize curses" -msgstr "" - -#: libcob/screenio.c:3591 -msgid "end of program, please press a key to exit" -msgstr "programma terminato, premere un tasto per uscire" - -#: libcob/termio.c:70 libcob/termio.c:106 -msgid "(Not representable)" -msgstr "(Non rappresentabile)" - -#: libcob/termio.c:347 -#, c-format -msgid "cannot open %s (=%s)" -msgstr "" - -#: libcob/termio.c:362 -msgid "COB_DISPLAY_PUNCH_FILE is invalid, output to SYSPUNCH skipped" -msgstr "" - -#: bin/cobcrun.c:122 -msgid "GnuCOBOL module loader" -msgstr "" - -#: bin/cobcrun.c:124 -#, c-format -msgid "Usage: %s [options] PROGRAM [parameter ...]" -msgstr "" - -#: bin/cobcrun.c:126 -#, c-format -msgid " or: %s options" -msgstr "" - -#: bin/cobcrun.c:129 -msgid "Options:" -msgstr "Opzioni:" - -#: bin/cobcrun.c:130 -msgid " -h, -help display this help and exit" -msgstr "" - -#: bin/cobcrun.c:131 -msgid " -V, -version display cobcrun and runtime version and exit" -msgstr "" - -#: bin/cobcrun.c:132 -msgid " -i, -info display runtime information (build/environment)" -msgstr "" - -#: bin/cobcrun.c:134 -msgid " -q, -brief reduced displays" -msgstr "" - -#: bin/cobcrun.c:136 -msgid " -c , -config= set runtime configuration from " -msgstr "" - -#: bin/cobcrun.c:137 -msgid "" -" -r, -runtime-config display current runtime configuration\n" -" (value and origin for all settings)" -msgstr "" - -#: bin/cobcrun.c:139 -msgid "" -" -M , -module= set entry point module name and/or load path\n" -" where -M module prepends any directory to the\n" -" dynamic link loader library search path\n" -" and any basename to the module preload list\n" -" (COB_LIBRARY_PATH and/or COB_PRELOAD)" -msgstr "" - -#: bin/cobcrun.c:145 -#, c-format -msgid "" -"Report bugs to: %s\n" -"or (preferably) use the issue tracker via the home page." -msgstr "" - -#: bin/cobcrun.c:148 -#, fuzzy -msgid "GnuCOBOL home page: " -msgstr "Homepage di GnuCOBOL: " - -#: bin/cobcrun.c:149 -msgid "General help using GNU software: " -msgstr "" - -#: bin/cobcrun.c:274 -msgid "invalid configuration file name" -msgstr "" - -#: bin/cobcrun.c:325 -#, fuzzy, c-format -msgid "invalid module argument '%s'" -msgstr "parametro non valido: %s" - -#: bin/cobcrun.c:377 -#, c-format -msgid "%s: missing PROGRAM name" -msgstr "" - -#: bin/cobcrun.c:379 -#, c-format -msgid "Try '%s --help' for more information." -msgstr "" - -#: bin/cobcrun.c:387 -#, c-format -msgid "%s: PROGRAM name exceeds %d characters" -msgstr "" - -#~ msgid " - length is < 1 or > 31" -#~ msgstr " - lunghezza < 1 oppure > 31" - -#~ msgid "default" -#~ msgstr "default" - -#~ msgid " -V, -version display compiler version and exit" -#~ msgstr " -V, -version visualizza la versione del compilatore e poi esce" - -#~ msgid " -O, -O2, -O3, -Os enable optimization" -#~ msgstr " -O, -O2, -O3, -Os abilita ottimizzazione" - -#~ msgid " -C translation only; convert COBOL to C" -#~ msgstr " -C solo traduzione; conversione da COBOL in C" - -#~ msgid " -S compile only; output assembly file" -#~ msgstr " -S solo compilazione; in output un file assembly" - -#~ msgid " -c compile and assemble, but do not link" -#~ msgstr " -c compilare ed assemblare, ma non fare il linking" - -#~ msgid " -list-reserved display reserved words" -#~ msgstr " -list-reserved mostra le keyword riservate" - -#~ msgid " -W enable all warnings" -#~ msgstr " -W attiva tutti i warning" - -#~ msgid "" -#~ msgstr "" - -#~ msgid "" -#~ msgstr "" - -#~ msgid ":" -#~ msgstr ":" - -#~ msgid "" -#~ msgstr "" - -#~ msgid "%s is not implemented" -#~ msgstr "%s non è implementato" Binary files /tmp/tmp8r0303vl/MzBWgGBJBM/gnucobol-4.0~early~20200606/po/ja.gmo and /tmp/tmp8r0303vl/cieYbammgl/gnucobol-5/po/ja.gmo differ diff -Nru gnucobol-4.0~early~20200606/po/ja.po gnucobol-5/po/ja.po --- gnucobol-4.0~early~20200606/po/ja.po 2020-06-06 20:53:00.000000000 +0000 +++ gnucobol-5/po/ja.po 1970-01-01 00:00:00.000000000 +0000 @@ -1,6288 +0,0 @@ -# Japanese translations for GnuCOBOL package -# Copyright (C) 2002-2009 Free Software Foundation, Inc. -# This file is distributed under the same license as the GnuCOBOL package. -# Keisuke Nishida , 2002. -# -msgid "" -msgstr "" -"Project-Id-Version: OpenCOBOL 0.13\n" -"Report-Msgid-Bugs-To: gnucobol-messages@gnu.org\n" -"POT-Creation-Date: 2020-06-06 20:52+0000\n" -"PO-Revision-Date: 2004-08-01 23:55+0900\n" -"Last-Translator: Keisuke Nishida \n" -"Language-Team: Japanese \n" -"Language: ja\n" -"MIME-Version: 1.0\n" -"Content-Type: text/plain; charset=EUC-JP\n" -"Content-Transfer-Encoding: 8bit\n" -"Plural-Forms: nplurals=1; plural=0;\n" -"X-Poedit-Language: Japanese\n" - -#: cobc/cobc.c:117 -#, fuzzy, c-format -msgid "invalid parameter: %s" -msgstr "ÉÔÅö¤Ê MOVE ʸ¤Ç¤¹" - -#: cobc/cobc.c:826 -msgid "too many errors" -msgstr "" - -#: cobc/cobc.c:838 -#, fuzzy -msgid "internal compiler error" -msgstr "±Ê³¥Õ¥¡¥¤¥ë¥¨¥é¡¼¤Ç¤¹" - -#: cobc/cobc.c:904 cobc/cobc.c:991 cobc/cobc.c:1051 cobc/cobc.c:1127 -#: cobc/cobc.c:1167 cobc/cobc.c:1243 -#, c-format -msgid "cannot allocate %d bytes of memory" -msgstr "" - -#: cobc/cobc.c:917 cobc/cobc.c:933 cobc/cobc.c:953 cobc/cobc.c:1011 -#: cobc/cobc.c:1029 cobc/cobc.c:1147 cobc/cobc.c:1262 cobc/cobc.c:1279 -#: cobc/field.c:2008 libcob/common.c:7121 -#, c-format -msgid "call to %s with NULL pointer" -msgstr "" - -#: cobc/cobc.c:974 -#, c-format -msgid "cannot reallocate %d bytes of memory" -msgstr "" - -#: cobc/cobc.c:1068 cobc/cobc.c:1184 -msgid "attempt to reallocate non-allocated memory" -msgstr "" - -#: cobc/cobc.c:1101 cobc/cobc.c:1217 -#, c-format -msgid "call to %s with invalid pointer, as it is missing in list" -msgstr "" - -#: cobc/cobc.c:1390 -#, c-format -msgid "assuming literal for unquoted '%s'" -msgstr "" - -#: cobc/cobc.c:1437 -#, fuzzy -msgid " - length exceeds maximum" -msgstr "ÃͤÎÂ礭¤µ¤¬¹àÌܤÎÂ礭¤µ¤ò±Û¤¨¤Æ¤¤¤Þ¤¹" - -#: cobc/cobc.c:1441 -msgid " - name cannot be empty" -msgstr "" - -#: cobc/cobc.c:1444 -msgid " - name cannot begin with space or underscore" -msgstr "" - -#: cobc/cobc.c:1447 -msgid " - name cannot begin with 'cob_' or 'COB_'" -msgstr "" - -#: cobc/cobc.c:1450 -msgid " - name duplicates a 'C' keyword" -msgstr "" - -#: cobc/cobc.c:1453 -msgid " - name cannot contain a directory separator" -msgstr "" - -#: cobc/cobc.c:1462 -#, fuzzy, c-format -msgid "invalid file base name '%s'%s" -msgstr "ÉÔÅö¤Ê¥ì¥Ù¥ëÈÖ¹æ¤Ç¤¹ `%s'" - -#: cobc/cobc.c:1466 -#, fuzzy, c-format -msgid "invalid ENTRY '%s'%s" -msgstr "ÉÔÅö¤Ê X Äê¿ô¤Ç¤¹: %s" - -#: cobc/cobc.c:1469 -#, fuzzy, c-format -msgid "invalid PROGRAM-ID '%s'%s" -msgstr "`%s' ¤Ï½¤¾þ½ÐÍè¤Þ¤»¤ó" - -#: cobc/cobc.c:1596 cobc/cobc.c:8151 -msgid "please check environment variables as noted above" -msgstr "" - -#: cobc/cobc.c:1608 cobc/error.c:254 cobc/error.c:274 cobc/error.c:505 -#: cobc/error.c:528 -msgid "error: " -msgstr "" - -#: cobc/cobc.c:1631 -#, fuzzy, c-format -msgid "duplicate DEFINE '%s' - ignored" -msgstr "ÉÔÅö¤Ê¥ì¥Ù¥ëÈÖ¹æ¤Ç¤¹ `%s'" - -#: cobc/cobc.c:1683 -#, c-format -msgid "environment variable '%s' is '%s'; should not contain '%c'" -msgstr "" - -#: cobc/cobc.c:1712 -msgid "parameter buffer size exceeded" -msgstr "" - -#: cobc/cobc.c:1752 -#, c-format -msgid "warning: could not move temporary file to %s" -msgstr "" - -#: cobc/cobc.c:1957 cobc/cobc.c:1960 cobc/parser.y:803 cobc/reserved.c:3807 -#: libcob/common.c:761 libcob/common.c:1805 libcob/common.c:2002 -#: libcob/common.c:6325 libcob/common.c:7495 libcob/common.c:8025 -#: libcob/common.c:8104 -msgid "unknown" -msgstr "" - -#: cobc/cobc.c:1963 -#, c-format -msgid "aborting codegen for %s (%s: %s)" -msgstr "" - -#: cobc/cobc.c:1966 -#, c-format -msgid "aborting compile of %s at line %d (%s: %s)" -msgstr "" - -#: cobc/cobc.c:1970 -msgid "aborting" -msgstr "" - -#: cobc/cobc.c:1993 cobc/cobc.c:2028 libcob/common.c:7086 bin/cobcrun.c:342 -msgid "Please report this!" -msgstr "" - -#: cobc/cobc.c:2046 bin/cobcrun.c:106 -msgid "License GPLv3+: GNU GPL version 3 or later " -msgstr "" - -#: cobc/cobc.c:2047 libcob/common.c:7316 bin/cobcrun.c:107 -msgid "" -"This is free software; see the source for copying conditions. There is NO\n" -"warranty; not even for MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE." -msgstr "" - -#: cobc/cobc.c:2049 libcob/common.c:7318 bin/cobcrun.c:109 -#, c-format -msgid "Written by %s\n" -msgstr "" - -#. TRANSLATORS: This msgid is indented as the "Packaged" msgid, %s expands to date and time -#: cobc/cobc.c:2050 cobc/cobc.c:2063 libcob/common.c:7321 bin/cobcrun.c:110 -#, c-format -msgid "Built %s" -msgstr "" - -#. TRANSLATORS: This msgid is indented as the "Built" msgid, %s expands to date and time -#: cobc/cobc.c:2052 cobc/cobc.c:2065 libcob/common.c:7324 bin/cobcrun.c:112 -#, c-format -msgid "Packaged %s" -msgstr "" - -#: cobc/cobc.c:2054 cobc/cobc.c:2067 -#, c-format -msgid "C version %s%s" -msgstr "" - -#: cobc/cobc.c:2080 -msgid "executing:" -msgstr "" - -#: cobc/cobc.c:2082 -#, fuzzy -msgid "to be executed:" -msgstr "READ ¤òÀè¤Ë¼Â¹Ô¤·¤Ê¤±¤ì¤Ð¤Ê¤ê¤Þ¤»¤ó" - -#: cobc/cobc.c:2120 cobc/cobc.c:2121 libcob/common.c:5815 libcob/common.c:5816 -#: libcob/common.c:5847 libcob/common.c:5848 -msgid "env" -msgstr "" - -#: cobc/cobc.c:2156 libcob/common.c:7351 -msgid "build information" -msgstr "" - -#: cobc/cobc.c:2157 libcob/common.c:7352 -msgid "build environment" -msgstr "" - -#: cobc/cobc.c:2167 libcob/common.c:7363 -msgid "GnuCOBOL information" -msgstr "" - -#: cobc/cobc.c:2212 libcob/common.c:6366 libcob/common.c:7386 -#: libcob/common.c:7486 libcob/common.c:7493 -msgid "yes" -msgstr "" - -#: cobc/cobc.c:2214 libcob/common.c:6368 libcob/common.c:7388 -#: libcob/common.c:7488 -msgid "no" -msgstr "" - -#: cobc/cobc.c:2218 libcob/common.c:7392 -msgid "8 bytes" -msgstr "" - -#: cobc/cobc.c:2220 libcob/common.c:7394 -msgid "4 bytes" -msgstr "" - -#: cobc/cobc.c:2224 cobc/cobc.c:2226 libcob/common.c:7398 libcob/common.c:7400 -msgid "endianness" -msgstr "" - -#: cobc/cobc.c:2224 libcob/common.c:7398 -msgid "big-endian" -msgstr "" - -#: cobc/cobc.c:2226 libcob/common.c:7400 -msgid "little-endian" -msgstr "" - -#: cobc/cobc.c:2230 cobc/cobc.c:2232 libcob/common.c:7404 libcob/common.c:7406 -msgid "native character set" -msgstr "" - -#: cobc/cobc.c:2230 libcob/common.c:7404 -msgid "EBCDIC" -msgstr "" - -#: cobc/cobc.c:2232 libcob/common.c:7406 -msgid "ASCII" -msgstr "" - -#: cobc/cobc.c:2235 libcob/common.c:7410 libcob/common.c:7476 -msgid "extended screen I/O" -msgstr "" - -#: cobc/cobc.c:2238 libcob/common.c:7502 -msgid "variable file format" -msgstr "" - -#: cobc/cobc.c:2244 cobc/cobc.c:2246 libcob/common.c:7508 libcob/common.c:7510 -msgid "sequential file handler" -msgstr "" - -#: cobc/cobc.c:2246 libcob/common.c:7510 -msgid "built-in" -msgstr "" - -#: cobc/cobc.c:2254 cobc/cobc.c:2260 cobc/cobc.c:2262 cobc/cobc.c:2269 -#: cobc/cobc.c:2271 cobc/cobc.c:2275 cobc/cobc.c:2278 cobc/cobc.c:2282 -#: cobc/cobc.c:2284 cobc/cobc.c:2289 cobc/cobc.c:2291 cobc/cobc.c:2298 -#: cobc/cobc.c:2300 cobc/cobc.c:2307 libcob/common.c:7516 libcob/common.c:7527 -#: libcob/common.c:7533 libcob/common.c:7535 libcob/common.c:7539 -#: libcob/common.c:7542 libcob/common.c:7546 libcob/common.c:7548 -#: libcob/common.c:7553 libcob/common.c:7555 libcob/common.c:7562 -#: libcob/common.c:7564 libcob/common.c:7571 -msgid "indexed file handler" -msgstr "" - -#: cobc/cobc.c:2304 libcob/common.c:7568 -#, fuzzy -msgid "default indexed handler" -msgstr "¤Ï¤³¤³¤ÇÄêµÁ¤µ¤ì¤Þ¤·¤¿" - -#: cobc/cobc.c:2307 cobc/cobc.c:2319 cobc/cobc.c:2325 libcob/common.c:7381 -#: libcob/common.c:7498 libcob/common.c:7571 libcob/common.c:7611 -#: libcob/common.c:7625 -msgid "disabled" -msgstr "" - -#: cobc/cobc.c:2311 cobc/cobc.c:2313 libcob/common.c:7594 libcob/common.c:7596 -msgid "mathematical library" -msgstr "" - -#: cobc/cobc.c:2317 cobc/cobc.c:2319 libcob/common.c:7605 libcob/common.c:7611 -msgid "XML library" -msgstr "" - -#: cobc/cobc.c:2323 cobc/cobc.c:2325 libcob/common.c:7623 libcob/common.c:7625 -msgid "JSON library" -msgstr "" - -#: cobc/cobc.c:2332 -msgid "only one of options 'E', 'S', 'C', 'c' may be specified" -msgstr "" - -#: cobc/cobc.c:2338 -msgid "only one of options 'm', 'x', 'b' may be specified" -msgstr "" - -#: cobc/cobc.c:2367 -#, c-format -msgid "-fdump= requires one of 'ALL', 'FD', 'WS', 'LS', 'RD', 'FD', 'SC' not '%s'" -msgstr "" - -#: cobc/cobc.c:2392 -#, fuzzy, c-format -msgid "'%s' is not an intrinsic function" -msgstr "`%s' ¤ÏÀ°¿ô¤Ç¤Ï¤¢¤ê¤Þ¤»¤ó" - -#: cobc/cobc.c:2434 cobc/cobc.c:7516 cobc/cobc.c:7630 cobc/codegen.c:3796 -#: cobc/codegen.c:3905 cobc/codegen.c:5221 cobc/codegen.c:12426 cobc/tree.c:789 -#: cobc/tree.c:1221 cobc/tree.c:4101 cobc/tree.c:4648 cobc/tree.c:4891 -#: cobc/typeck.c:3294 cobc/typeck.c:7812 cobc/typeck.c:7847 cobc/typeck.c:8660 -#: cobc/typeck.c:11261 cobc/typeck.c:11329 cobc/typeck.c:11397 -#: cobc/typeck.c:11681 cobc/typeck.c:11724 -#, fuzzy, c-format -msgid "call to '%s' with invalid parameter '%s'" -msgstr "`%s' ¤ÏÉôʬ»²¾È¤Ç¤­¤Þ¤»¤ó" - -#: cobc/cobc.c:2737 -#, fuzzy -msgid "loading standard configuration file 'default.conf'" -msgstr "ÉÔÅö¤Ê¹ÔÏ¢·ë¤Ç¤¹" - -#: cobc/cobc.c:2871 -#, fuzzy -msgid "invalid output file name" -msgstr "ÉÔÅö¤ÊÆþÎÏ¥¹¥È¥ê¡¼¥à¤Ç¤¹" - -#: cobc/cobc.c:2971 -#, c-format -msgid "warning: '%s' is not a directory, defaulting to current directory" -msgstr "" - -#: cobc/cobc.c:2998 -#, c-format -msgid "warning: %d lines per listing page specified, using %d" -msgstr "" - -#: cobc/cobc.c:3048 -#, c-format -msgid "warning: assuming '%s' is a DEFINE - did you intend to use -debug?" -msgstr "" - -#: cobc/cobc.c:3315 -#, fuzzy, c-format -msgid "unknown warning option '%s'" -msgstr "¤½¤Î¤è¤¦¤Êʸ¤Ï¤¢¤ê¤Þ¤»¤ó `%s'" - -#: cobc/cobc.c:3367 -#, fuzzy, c-format -msgid "%s option requires a listing file" -msgstr "`%s' ¤Ï %d ¤Ä¤Îź»ú¤òɬÍפȤ·¤Þ¤¹" - -#: cobc/cobc.c:3374 -msgid "output to stdout only valid for preprocess" -msgstr "" - -#: cobc/cobc.c:3466 -msgid "all runtime checks are enabled" -msgstr "" - -#: cobc/cobc.c:3572 -msgid "only one stdin input allowed" -msgstr "" - -#: cobc/cobc.c:3582 -#, fuzzy, c-format -msgid "invalid file name parameter (length > %d)" -msgstr "ÉÔÅö¤Ê VALUE ¶ç¤Ç¤¹" - -#: cobc/cobc.c:3807 -msgid "nothing for -j to run" -msgstr "" - -#: cobc/cobc.c:3883 cobc/cobc.c:4071 cobc/cobc.c:4130 cobc/cobc.c:4158 -#: cobc/cobc.c:4247 cobc/cobc.c:4306 cobc/cobc.c:4430 cobc/cobc.c:4469 -#: cobc/cobc.c:6993 -msgid "return status:" -msgstr "" - -#: cobc/cobc.c:4361 -msgid "preprocessing:" -msgstr "" - -#: cobc/cobc.c:4435 -msgid "'cobxref' execution unsuccessful" -msgstr "" - -#: cobc/cobc.c:4438 -#, c-format -msgid "check that 'cobxref' is in %s" -msgstr "" - -#: cobc/cobc.c:4440 -msgid "no listing produced" -msgstr "" - -#: cobc/cobc.c:5328 cobc/cobc.c:5367 -msgid "No fields defined." -msgstr "" - -#: cobc/cobc.c:5387 -msgid "No labels defined." -msgstr "" - -#: cobc/cobc.c:5409 -msgid "Error/Warning summary:" -msgstr "" - -#: cobc/cobc.c:5453 -msgid "0 warnings in compilation group" -msgstr "" - -#: cobc/cobc.c:5457 -msgid "1 warning in compilation group" -msgstr "" - -#: cobc/cobc.c:5461 -#, c-format -msgid "%d warnings in compilation group" -msgstr "" - -#: cobc/cobc.c:5467 -msgid "0 errors in compilation group" -msgstr "" - -#: cobc/cobc.c:5471 -msgid "1 error in compilation group" -msgstr "" - -#: cobc/cobc.c:5475 -#, c-format -msgid "%d errors in compilation group" -msgstr "" - -#: cobc/cobc.c:5481 -#, c-format -msgid "Too many errors in compilation group: %d maximum errors" -msgstr "" - -#: cobc/cobc.c:6050 -#, c-format -msgid "%s: %d: Too many continuation lines" -msgstr "" - -#: cobc/cobc.c:6972 -msgid "parsing:" -msgstr "" - -#: cobc/cobc.c:7034 -msgid "translating:" -msgstr "" - -#: cobc/cobc.c:8157 -msgid "no input files" -msgstr "" - -#: cobc/cobc.c:8186 -#, fuzzy, c-format -msgid "%s option invalid in this combination" -msgstr "ÉÔÅö¤Ê¹ÔÏ¢·ë¤Ç¤¹" - -#: cobc/cobc.c:8227 -msgid "command line:" -msgstr "" - -#: cobc/codegen.c:973 cobc/codegen.c:4487 cobc/codegen.c:11093 -#, fuzzy -msgid "unexpected CONSTANT item" -msgstr "ÉÔÅö¤Ê¿ô»úÄê¿ô¤Ç¤¹" - -#: cobc/codegen.c:1188 cobc/codegen.c:1196 cobc/codegen.c:1291 -#: cobc/codegen.c:1603 cobc/codegen.c:2202 cobc/codegen.c:3212 -#: cobc/codegen.c:3455 cobc/codegen.c:3988 cobc/codegen.c:4454 -#: cobc/codegen.c:7902 cobc/codegen.c:8507 cobc/codegen.c:10298 -#: cobc/field.c:817 cobc/scanner.l:2104 cobc/tree.c:611 cobc/tree.c:3728 -#: cobc/typeck.c:5015 cobc/typeck.c:8662 cobc/typeck.c:9657 -#, fuzzy, c-format -msgid "unexpected tree tag: %d" -msgstr "ÉÔÅö¤Ê¿ô»úÄê¿ô¤Ç¤¹" - -#: cobc/codegen.c:2999 cobc/codegen.c:3295 cobc/codegen.c:8125 cobc/tree.c:1243 -#, fuzzy, c-format -msgid "unexpected cast type: %d" -msgstr "ÉÔÅö¤Ê¿ô»úÄê¿ô¤Ç¤¹" - -#: cobc/codegen.c:3725 cobc/codegen.c:4434 -#, c-format -msgid "internal statement stack depth exceeded: %d" -msgstr "" - -#: cobc/codegen.c:3798 -#, fuzzy, c-format -msgid "%s is not a field" -msgstr "%s ¤Ï̤ÄêµÁ¤Ç¤¹" - -#: cobc/codegen.c:4186 cobc/codegen.c:4279 -#, fuzzy, c-format -msgid "unexpected function: %s" -msgstr "ÉÔÅö¤Ê¿ô»úÄê¿ô¤Ç¤¹" - -#: cobc/codegen.c:4270 -#, fuzzy, c-format -msgid "unexpected operator: %c" -msgstr "ÉÔÅö¤Ê¿ô»úÄê¿ô¤Ç¤¹" - -#: cobc/codegen.c:5043 -#, fuzzy, c-format -msgid "unexpected tree category: %d" -msgstr "ÉÔÅö¤Ê¿ô»úÄê¿ô¤Ç¤¹" - -#: cobc/codegen.c:5438 cobc/codegen.c:5465 cobc/codegen.c:5662 -#: cobc/codegen.c:5694 -#, fuzzy, c-format -msgid "unexpected size: %d" -msgstr "ÉÔÅö¤Ê¿ô»úÄê¿ô¤Ç¤¹" - -#: cobc/codegen.c:7254 -#, c-format -msgid "No ENTRY FOR GO TO '%s'" -msgstr "" - -#: cobc/codegen.c:7475 cobc/codegen.c:7725 -#, fuzzy, c-format -msgid "unexpected handler type: %d" -msgstr "ÉÔÅö¤Ê¿ô»úÄê¿ô¤Ç¤¹" - -#: cobc/codegen.c:7823 -msgid "unexpected error_node parameter" -msgstr "" - -#: cobc/codegen.c:8146 -#, fuzzy, c-format -msgid "unexpected tree type: %d" -msgstr "ÉÔÅö¤Ê¿ô»úÄê¿ô¤Ç¤¹" - -#: cobc/codegen.c:8703 cobc/typeck.c:6511 cobc/typeck.c:12940 -#: cobc/typeck.c:12984 -#, c-format -msgid "compiler is not configured to support %s" -msgstr "" - -#: cobc/codegen.c:9128 -msgid "Nested OCCURS in report" -msgstr "" - -#: cobc/codeoptim.c:2762 -#, fuzzy, c-format -msgid "unexpected optimization value: %d" -msgstr "ÉÔÅö¤Ê¿ô»úÄê¿ô¤Ç¤¹" - -#: cobc/config.c:162 libcob/common.c:6786 libcob/common.c:6800 -#: libcob/common.c:7242 -#, fuzzy, c-format -msgid "invalid value '%s' for configuration tag '%s'" -msgstr "%s: Àá `%s':\n" - -#: cobc/config.c:165 libcob/common.c:6093 libcob/common.c:6209 -#, c-format -msgid "should be one of the following values: %s" -msgstr "" - -#: cobc/config.c:167 -msgid "must be numeric" -msgstr "" - -#: cobc/config.c:169 libcob/common.c:6191 -#, c-format -msgid "maximum value: %lu" -msgstr "" - -#: cobc/config.c:171 -#, c-format -msgid "minimum value: %d" -msgstr "" - -#: cobc/config.c:203 -#, fuzzy, c-format -msgid "unsupported value '%s' for configuration tag '%s'" -msgstr "%s: Àá `%s':\n" - -#: cobc/config.c:311 cobc/pplex.l:977 libcob/common.c:6702 -msgid "recursive inclusion" -msgstr "" - -#: cobc/config.c:386 libcob/common.c:6753 -#, fuzzy -msgid "configuration file was included here" -msgstr "ÉÔÅö¤Ê¹ÔÏ¢·ë¤Ç¤¹" - -#: cobc/config.c:415 -#, c-format -msgid "The previous loaded configuration '%s' will be discarded." -msgstr "" - -#: cobc/config.c:449 -msgid "missing definitions:" -msgstr "" - -#: cobc/config.c:451 -#, fuzzy, c-format -msgid "\tno definition of '%s'" -msgstr "`%s' ¤¬ºÆÄêµÁ¤µ¤ì¤Æ¤¤¤Þ¤¹" - -#: cobc/config.c:512 -#, fuzzy, c-format -msgid "invalid configuration tag '%s'" -msgstr "ÉÔÅö¤Ê¹ÔÏ¢·ë¤Ç¤¹" - -#: cobc/config.c:525 libcob/common.c:6509 libcob/common.c:6592 -#: libcob/common.c:6620 -#, fuzzy, c-format -msgid "unknown configuration tag '%s'" -msgstr "¤½¤Î¤è¤¦¤Êʸ¤Ï¤¢¤ê¤Þ¤»¤ó `%s'" - -#: cobc/config.c:549 -#, fuzzy, c-format -msgid "invalid configuration tag '%s' in word-list" -msgstr "ÉÔÅö¤Ê¹ÔÏ¢·ë¤Ç¤¹" - -#: cobc/config.c:608 -#, c-format -msgid "Could not access word list for '%s'" -msgstr "" - -#: cobc/error.c:87 -#, fuzzy, c-format -msgid "in section '%s':" -msgstr "%s: Àá `%s':\n" - -#: cobc/error.c:98 -#, fuzzy, c-format -msgid "in paragraph '%s':" -msgstr "%s: ÃÊÍî `%s':\n" - -#: cobc/error.c:121 libcob/common.c:7252 -msgid "configuration error:" -msgstr "" - -#: cobc/error.c:134 libcob/common.c:673 -#, c-format -msgid "system error %d" -msgstr "" - -#: cobc/error.c:231 cobc/error.c:323 cobc/error.c:478 -msgid "error [-Werror]: " -msgstr "" - -#: cobc/error.c:231 cobc/error.c:323 cobc/error.c:478 cobc/error.c:505 -#: libcob/common.c:6881 libcob/common.c:6906 -#, c-format -msgid "warning: " -msgstr "" - -#: cobc/error.c:274 cobc/error.c:528 -msgid "error (ignored): " -msgstr "" - -#: cobc/error.c:364 cobc/error.c:380 cobc/error.c:563 cobc/error.c:584 -#, c-format -msgid "%s used" -msgstr "" - -#: cobc/error.c:367 cobc/error.c:566 -#, c-format -msgid "%s is archaic in %s" -msgstr "%s ¤Ï %s ¤Ç¤Ï¸Å¤¤»ÅÍͤǤ¹" - -#: cobc/error.c:371 cobc/error.c:570 -#, c-format -msgid "%s is obsolete in %s" -msgstr "%s ¤Ï %s ¤Ç¤ÏÇÑÍ×ÁǤǤ¹" - -#: cobc/error.c:377 cobc/error.c:576 cobc/parser.y:5186 cobc/parser.y:5325 -#, c-format -msgid "%s ignored" -msgstr "%s ¤ò̵»ë¤·¤Þ¤¹" - -#: cobc/error.c:383 cobc/error.c:586 -#, fuzzy, c-format -msgid "%s does not conform to %s" -msgstr "%s ¤Ï %s ¤Ë½àµò¤·¤Æ¤¤¤Þ¤»¤ó" - -#: cobc/error.c:399 -#, fuzzy -msgid "configuration warning:" -msgstr "ÉÔÅö¤Ê¹ÔÏ¢·ë¤Ç¤¹" - -#: cobc/error.c:621 cobc/error.c:640 -#, fuzzy, c-format -msgid "redefinition of '%s'" -msgstr "`%s' ¤¬ºÆÄêµÁ¤µ¤ì¤Æ¤¤¤Þ¤¹" - -#: cobc/error.c:628 cobc/error.c:653 -#, fuzzy, c-format -msgid "'%s' previously defined here" -msgstr "`%s' ¤Ï¤³¤³¤ÇÄêµÁ¤µ¤ì¤Þ¤·¤¿" - -#: cobc/error.c:677 cobc/error.c:684 -#, fuzzy, c-format -msgid "'%s' is not defined" -msgstr "%s ¤Ï̤ÄêµÁ¤Ç¤¹" - -#: cobc/error.c:680 -#, fuzzy, c-format -msgid "'%s' cannot be used here" -msgstr "`%s' ¤Ïź»úÉÕ¤±½ÐÍè¤Þ¤»¤ó" - -#: cobc/error.c:682 cobc/parser.y:7009 -#, c-format -msgid "'%s' is not defined, but is a reserved word in another dialect" -msgstr "" - -#: cobc/error.c:716 -#, fuzzy, c-format -msgid "'%s' is ambiguous; needs qualification" -msgstr "%s ¤Ï¿½ÅÄêµÁ¤µ¤ì¤Æ¤¤¤Þ¤¹¡£°ì°Õ¤Ë½¤¾þ¤·¤Æ²¼¤µ¤¤" - -#: cobc/error.c:746 cobc/parser.y:16748 -#, fuzzy, c-format -msgid "'%s' defined here" -msgstr "`%s' ¤Ï¤³¤³¤ÇÄêµÁ¤µ¤ì¤Þ¤·¤¿" - -#: cobc/error.c:757 -#, c-format -msgid "fatal error: %s" -msgstr "" - -#: cobc/error.c:765 -#, fuzzy, c-format -msgid "group item '%s' cannot have %s clause" -msgstr "¥°¥ë¡¼¥×¹àÌÜ `%s' ¤Ï %s ¶ç¤ò»ý¤Ä¤³¤È¤¬½ÐÍè¤Þ¤»¤ó" - -#: cobc/error.c:779 -#, fuzzy, c-format -msgid "constant item '%s' requires a %s clause" -msgstr "¥ì¥Ù¥ë %02d ¹àÌÜ `%s' ¤Ë¤Ï %s ¶ç¤¬É¬ÍפǤ¹" - -#: cobc/error.c:781 -#, fuzzy, c-format -msgid "level %02d item '%s' requires a %s clause" -msgstr "¥ì¥Ù¥ë %02d ¹àÌÜ `%s' ¤Ë¤Ï %s ¶ç¤¬É¬ÍפǤ¹" - -#: cobc/error.c:795 -#, fuzzy, c-format -msgid "constant item '%s' can only have a %s clause" -msgstr "¥ì¥Ù¥ë %02d ¹àÌÜ `%s' ¤Ï %s ¶ç¤ò»ý¤Ä¤³¤È¤¬½ÐÍè¤Þ¤»¤ó" - -#: cobc/error.c:797 -#, fuzzy, c-format -msgid "level %02d item '%s' can only have a %s clause" -msgstr "¥ì¥Ù¥ë %02d ¹àÌÜ `%s' ¤Ï %s ¶ç¤ò»ý¤Ä¤³¤È¤¬½ÐÍè¤Þ¤»¤ó" - -#: cobc/field.c:131 -msgid "constant expression has Divide by ZERO" -msgstr "" - -#: cobc/field.c:187 cobc/field.c:324 cobc/field.c:332 -msgid "missing right parenthesis" -msgstr "" - -#: cobc/field.c:216 -#, c-format -msgid "expression stack overflow at %d entries for operation '%c'" -msgstr "" - -#: cobc/field.c:257 -#, c-format -msgid "expression stack overflow at %d entries" -msgstr "" - -#: cobc/field.c:274 -msgid "missing left parenthesis" -msgstr "" - -#: cobc/field.c:315 -#, fuzzy, c-format -msgid "invalid operator '%s' in expression" -msgstr "ÉÔÅö¤Ê¼°¤Ç¤¹" - -#: cobc/field.c:334 -#, c-format -msgid "'%c' operator misplaced" -msgstr "" - -#: cobc/field.c:395 -#, fuzzy, c-format -msgid "invalid level number '%s'" -msgstr "ÉÔÅö¤Ê¥ì¥Ù¥ëÈÖ¹æ¤Ç¤¹ `%s'" - -#: cobc/field.c:454 -msgid "entry following SAME AS may not be subordinate to it" -msgstr "" - -#: cobc/field.c:459 cobc/field.c:496 -#, fuzzy -msgid "level number must begin with 01 or 77" -msgstr "¥ì¥Ù¥ëÈÖ¹æ¤Ï 01 ¤« 77 ¤Ç»Ï¤Þ¤é¤Ê¤±¤ì¤Ð¤Ê¤ê¤Þ¤»¤ó" - -#: cobc/field.c:541 cobc/field.c:557 -#, fuzzy, c-format -msgid "no previous data item of level %02d" -msgstr "¥ì¥Ù¥ë %02d ¤Î¥Ç¡¼¥¿¹àÌܤ¬Á°¤Ë¤¢¤ê¤Þ¤»¤ó" - -#: cobc/field.c:599 -#, fuzzy, c-format -msgid "'%s' cannot be qualified here" -msgstr "`%s' ¤Ï½¤¾þ½ÐÍè¤Þ¤»¤ó" - -#: cobc/field.c:605 -#, fuzzy, c-format -msgid "'%s' cannot be subscripted here" -msgstr "`%s' ¤Ïź»úÉÕ¤±½ÐÍè¤Þ¤»¤ó" - -#: cobc/field.c:617 -#, fuzzy, c-format -msgid "'%s' is not defined in '%s'" -msgstr "`%s' ¤Ï `%s' ¤ÎÃæ¤ÇÄêµÁ¤µ¤ì¤Æ¤¤¤Þ¤»¤ó" - -#: cobc/field.c:638 -#, fuzzy -msgid "level number of REDEFINES entries must be identical" -msgstr "REDEFINES ¶ç¤Î¹àÌܤÏƱ¤¸¥ì¥Ù¥ëÈÖ¹æ¤Ç¤Ê¤±¤ì¤Ð¤Ê¤ê¤Þ¤»¤ó" - -#: cobc/field.c:643 -#, fuzzy, c-format -msgid "'%s' is not the original definition" -msgstr "`%s' ¤ÏºÇ½é¤ÎÄêµÁ¤Ç¤Ï¤¢¤ê¤Þ¤»¤ó" - -#: cobc/field.c:758 -#, c-format -msgid "PICTURE clause not compatible with USAGE %s" -msgstr "" - -#: cobc/field.c:855 cobc/field.c:930 cobc/field.c:941 -#, fuzzy, c-format -msgid "PICTURE clause required for '%s'" -msgstr "`%s' ¤Ë¤Ï PICTURE ¶ç¤¬É¬ÍפǤ¹" - -#: cobc/field.c:937 -#, fuzzy, c-format -msgid "a non-numeric literal is expected for '%s'" -msgstr "ʸ»úÎó¤¬É¬ÍפǤ¹" - -#: cobc/field.c:949 -#, c-format -msgid "defining implicit picture size %d for '%s'" -msgstr "" - -#: cobc/field.c:969 -#, c-format -msgid "'%s' ANY LENGTH only allowed in LINKAGE" -msgstr "" - -#: cobc/field.c:973 -#, c-format -msgid "'%s' ANY LENGTH must be 01 level" -msgstr "" - -#: cobc/field.c:977 -#, fuzzy, c-format -msgid "'%s' ANY LENGTH cannot be BASED/EXTERNAL" -msgstr "`%s' ¤Ï BLANK WHEN ZERO ¤ò»ý¤Ä¤³¤È¤¬½ÐÍè¤Þ¤»¤ó" - -#: cobc/field.c:982 cobc/field.c:1010 -#, fuzzy, c-format -msgid "'%s' ANY LENGTH has invalid definition" -msgstr "`%s' ¤ÏºÇ½é¤ÎÄêµÁ¤Ç¤Ï¤¢¤ê¤Þ¤»¤ó" - -#: cobc/field.c:993 -#, fuzzy, c-format -msgid "'%s' ANY NUMERIC must be PIC 9" -msgstr "`%s' ¤Ï OCCURS DEPENDING ¤ò»ý¤Ä¤³¤È¤¬½ÐÍè¤Þ¤»¤ó" - -#: cobc/field.c:998 -#, fuzzy, c-format -msgid "'%s' ANY LENGTH must be PIC X or PIC N" -msgstr "`%s' ¤Ï OCCURS DEPENDING ¤ò»ý¤Ä¤³¤È¤¬½ÐÍè¤Þ¤»¤ó" - -#: cobc/field.c:1008 -#, fuzzy, c-format -msgid "'%s' ANY NUMERIC has invalid definition" -msgstr "`%s' ¤ÏºÇ½é¤ÎÄêµÁ¤Ç¤Ï¤¢¤ê¤Þ¤»¤ó" - -#: cobc/field.c:1026 -#, c-format -msgid "'%s' EXTERNAL must be specified at 01/77 level" -msgstr "" - -#: cobc/field.c:1030 -#, c-format -msgid "'%s' EXTERNAL can only be specified in WORKING-STORAGE section" -msgstr "" - -#: cobc/field.c:1034 -#, c-format -msgid "'%s' EXTERNAL and BASED are mutually exclusive" -msgstr "" - -#: cobc/field.c:1037 -#, c-format -msgid "'%s' EXTERNAL not allowed with REDEFINES" -msgstr "" - -#: cobc/field.c:1049 -#, fuzzy, c-format -msgid "'%s' BASED not allowed here" -msgstr "`%s' ¤Ï½¤¾þ½ÐÍè¤Þ¤»¤ó" - -#: cobc/field.c:1052 -#, c-format -msgid "'%s' BASED not allowed with REDEFINES" -msgstr "" - -#: cobc/field.c:1055 -#, fuzzy, c-format -msgid "'%s' BASED only allowed at the 01 and 77 levels" -msgstr "`%s' ¤Ï½¤¾þ½ÐÍè¤Þ¤»¤ó" - -#: cobc/field.c:1067 -#, fuzzy, c-format -msgid "level %02d item '%s' cannot have a %s clause" -msgstr "¥ì¥Ù¥ë %02d ¹àÌÜ `%s' ¤Ï %s ¶ç¤ò»ý¤Ä¤³¤È¤¬½ÐÍè¤Þ¤»¤ó" - -#: cobc/field.c:1082 -#, fuzzy, c-format -msgid "'%s' cannot have the OCCURS clause due to '%s'" -msgstr "`%s' ¤Ï `%s' ¤Î¤¿¤á OCCURS ¶ç¤ò»ý¤Ä¤³¤È¤¬½ÐÍè¤Þ¤»¤ó" - -#: cobc/field.c:1101 -#, fuzzy, c-format -msgid "the original definition '%s' should not have OCCURS clause" -msgstr "`%s' ¤Î¸µ¤ÎÄêµÁ¤Ë¤Ï OCCURS ¤òÉÕ¤±¤Æ¤Ï¤Ê¤ê¤Þ¤»¤ó" - -#: cobc/field.c:1108 -msgid "REDEFINES must follow the original definition" -msgstr "REDEFINES ¶ç¤Ï»²¾È¸µ¤Î¹àÌܤÎľ¸å¤Ë¤Ê¤±¤ì¤Ð¤Ê¤ê¤Þ¤»¤ó" - -#: cobc/field.c:1115 -#, fuzzy, c-format -msgid "'%s' cannot be variable length" -msgstr "`%s' ¤Ï²ÄÊÑĹ¤Ë½ÐÍè¤Þ¤»¤ó" - -#: cobc/field.c:1118 -#, fuzzy, c-format -msgid "the original definition '%s' cannot be variable length" -msgstr "`%s' ¤Î¸µ¤ÎÄêµÁ¤Ï²ÄÊÑŤǤ¢¤Ã¤Æ¤Ï¤Ê¤ê¤Þ¤»¤ó" - -#: cobc/field.c:1142 -#, fuzzy, c-format -msgid "SCREEN group item '%s' has invalid clause" -msgstr "¥°¥ë¡¼¥×¹àÌÜ `%s' ¤Ï %s ¶ç¤ò»ý¤Ä¤³¤È¤¬½ÐÍè¤Þ¤»¤ó" - -#: cobc/field.c:1223 -#, c-format -msgid "%s USAGE %s incompatible with %s USAGE %s" -msgstr "" - -#: cobc/field.c:1302 -#, fuzzy, c-format -msgid "'%s' cannot have PICTURE clause" -msgstr "`%s' ¤Ï PICTURE ¶ç¤ò»ý¤Ä¤³¤È¤¬½ÐÍè¤Þ¤»¤ó" - -#: cobc/field.c:1318 cobc/field.c:1328 -#, fuzzy, c-format -msgid "%s item '%s' should be USAGE DISPLAY" -msgstr "`%s' ¤Ï SPECIAL-NAMES ¤ÇÄêµÁ¤µ¤ì¤Æ¤¤¤Þ¤»¤ó" - -#: cobc/field.c:1351 -#, c-format -msgid "'%s' COMP-6 with sign - changing to COMP-3" -msgstr "" - -#: cobc/field.c:1377 -msgid "elementary items with SIGN clause must have S in PICTURE" -msgstr "" - -#: cobc/field.c:1380 -msgid "elementary items with SIGN clause must be USAGE DISPLAY or NATIONAL" -msgstr "" - -#: cobc/field.c:1397 -#, fuzzy, c-format -msgid "'%s' cannot have JUSTIFIED RIGHT" -msgstr "`%s' ¤Ï JUSTIFIED RIGHT ¤ò»ý¤Ä¤³¤È¤¬½ÐÍè¤Þ¤»¤ó" - -#: cobc/field.c:1410 -#, fuzzy, c-format -msgid "'%s' cannot have S in PICTURE string and BLANK WHEN ZERO" -msgstr "`%s' ¤Ï BLANK WHEN ZERO ¤ò»ý¤Ä¤³¤È¤¬½ÐÍè¤Þ¤»¤ó" - -#: cobc/field.c:1415 -#, c-format -msgid "'%s' cannot have BLANK WHEN ZERO without being USAGE DISPLAY or NATIONAL" -msgstr "" - -#: cobc/field.c:1426 -#, fuzzy, c-format -msgid "'%s' cannot have * in PICTURE string and BLANK WHEN ZERO" -msgstr "`%s' ¤Ï BLANK WHEN ZERO ¤ò»ý¤Ä¤³¤È¤¬½ÐÍè¤Þ¤»¤ó" - -#: cobc/field.c:1433 -#, fuzzy, c-format -msgid "'%s' is not numeric, so cannot have BLANK WHEN ZERO" -msgstr "`%s' ¤Ï BLANK WHEN ZERO ¤ò»ý¤Ä¤³¤È¤¬½ÐÍè¤Þ¤»¤ó" - -#: cobc/field.c:1446 -#, fuzzy -msgid "only level 88 items may have multiple values" -msgstr "Ê£¿ô¤ÎÃͤϥì¥Ù¥ë 88 ¹àÌܤΤߤ˵ö¤µ¤ì¤Þ¤¹" - -#: cobc/field.c:1454 cobc/field.c:1458 -#, fuzzy, c-format -msgid "initial VALUE clause ignored for %s item '%s'" -msgstr "ÉÔÅö¤Ê VALUE ¶ç¤Ç¤¹" - -#: cobc/field.c:1471 -msgid "FULL has no effect on numeric items; you may want REQUIRED or PIC Z" -msgstr "" - -#: cobc/field.c:1499 -msgid "VALUE may not contain a figurative constant" -msgstr "" - -#: cobc/field.c:1507 -msgid "cannot specify both FULL and JUSTIFIED" -msgstr "" - -#: cobc/field.c:1519 -#, c-format -msgid "'%s' has FROM, TO or USING without PIC; PIC will be implied" -msgstr "" - -#: cobc/field.c:1533 -#, c-format -msgid "'%s' has numeric VALUE without PIC; PIC will be implied" -msgstr "" - -#: cobc/field.c:1548 -#, c-format -msgid "'%s' cannot have PIC without FROM, TO, USING or numeric VALUE" -msgstr "" - -#: cobc/field.c:1560 -#, c-format -msgid "'%s' needs a PIC, FROM, TO, USING, VALUE, BELL, BLANK or ERASE clause" -msgstr "" - -#: cobc/field.c:1574 -msgid "cannot specify both PIC and VALUE" -msgstr "" - -#: cobc/field.c:1582 -msgid "cannot have PIC without FROM, TO or USING" -msgstr "" - -#: cobc/field.c:1591 -msgid "cannot have FROM, TO or USING without PIC" -msgstr "" - -#: cobc/field.c:1600 -msgid "VALUE item may not be numeric" -msgstr "" - -#: cobc/field.c:1616 -#, c-format -msgid "'%s' needs a PIC, COL, LINE, VALUE, BELL or BLANK clause" -msgstr "" - -#: cobc/field.c:1647 -msgid "cannot use AUTO, FULL, PROMPT, REQUIRED or SECURE on elementary item without TO or USING" -msgstr "" - -#: cobc/field.c:1654 -msgid "cannot use BLANK WHEN ZERO, JUSTIFIED, OCCURS or SIGN on item without FROM, TO or USING" -msgstr "" - -#: cobc/field.c:1674 -msgid "cannot use AUTO, FULL, REQUIRED or SECURE on elementary item without FROM, TO or USING" -msgstr "" - -#: cobc/field.c:1679 -msgid "cannot use BLANK WHEN ZERO, JUSTIFIED or SIGN without FROM, TO or USING" -msgstr "" - -#: cobc/field.c:1697 -#, fuzzy -msgid "cannot have BLANK WHEN ZERO without PIC" -msgstr "`%s' ¤Ï BLANK WHEN ZERO ¤ò»ý¤Ä¤³¤È¤¬½ÐÍè¤Þ¤»¤ó" - -#: cobc/field.c:1700 -#, fuzzy -msgid "cannot have JUSTIFIED without PIC" -msgstr "`%s' ¤Ï JUSTIFIED RIGHT ¤ò»ý¤Ä¤³¤È¤¬½ÐÍè¤Þ¤»¤ó" - -#: cobc/field.c:1720 -msgid "cannot have AUTO without FROM, TO or USING" -msgstr "" - -#: cobc/field.c:1725 -msgid "cannot use FULL or REQUIRED on item without TO or USING" -msgstr "" - -#: cobc/field.c:1732 -msgid "SECURE can be used with TO only" -msgstr "" - -#: cobc/field.c:1734 -#, fuzzy -msgid "SECURE must be used with TO" -msgstr "READ ¤òÀè¤Ë¼Â¹Ô¤·¤Ê¤±¤ì¤Ð¤Ê¤ê¤Þ¤»¤ó" - -#: cobc/field.c:1753 -#, fuzzy, c-format -msgid "'%s' does nothing" -msgstr "%s ¤Ï̤ÄêµÁ¤Ç¤¹" - -#: cobc/field.c:1797 -msgid "BLANK ZERO not compatible with USAGE" -msgstr "" - -#: cobc/field.c:1800 -msgid "SIGN clause not compatible with USAGE" -msgstr "" - -#: cobc/field.c:1977 -#, c-format -msgid "'%s' PICTURE clause not compatible with USAGE" -msgstr "" - -#: cobc/field.c:2027 -#, fuzzy, c-format -msgid "'%s' 77 level is not allowed here" -msgstr "`%s' ¤Ï½¤¾þ½ÐÍè¤Þ¤»¤ó" - -#: cobc/field.c:2424 -msgid "OCCURS and multi COLUMNs is not allowed" -msgstr "" - -#: cobc/field.c:2452 -#, fuzzy, c-format -msgid "duplicate LINE %d ignored" -msgstr "ÉÔÅö¤Ê¥ì¥Ù¥ëÈÖ¹æ¤Ç¤¹ `%s'" - -#: cobc/field.c:2469 -#, c-format -msgid "ignoring SYNCHRONIZED for group item '%s'" -msgstr "" - -#: cobc/field.c:2485 cobc/field.c:2498 cobc/field.c:2778 cobc/field.c:2781 -#, fuzzy, c-format -msgid "size of '%s' larger than size of '%s'" -msgstr "`%s' ¤Î¥µ¥¤¥º¤¬ `%s' ¤Î¥µ¥¤¥º¤ò±Û¤¨¤Æ¤¤¤Þ¤¹" - -#: cobc/field.c:2638 cobc/field.c:2703 -#, fuzzy, c-format -msgid "'%s' cannot be larger than %d bytes" -msgstr "18 ·å¤ò±Û¤¨¤ë¿ô»ú¹àÌܤϵö¤µ¤ì¤Þ¤»¤ó" - -#: cobc/field.c:2676 cobc/field.c:2684 -#, fuzzy, c-format -msgid "'%s' binary field cannot be larger than %d digits" -msgstr "18 ·å¤ò±Û¤¨¤ë¿ô»ú¹àÌܤϵö¤µ¤ì¤Þ¤»¤ó" - -#: cobc/field.c:2764 cobc/field.c:3216 -#, fuzzy, c-format -msgid "unexpected USAGE: %d" -msgstr "ÉÔÅö¤Ê¿ô»úÄê¿ô¤Ç¤¹" - -#: cobc/field.c:2876 -msgid "literal type does not match numeric data type" -msgstr "" - -#: cobc/field.c:2953 -#, c-format -msgid "THRU item '%s' may not come before '%s'" -msgstr "" - -#: cobc/field.c:2976 -#, c-format -msgid "RENAMES cannot start/end at the OCCURS item '%s'" -msgstr "" - -#: cobc/field.c:2984 -#, c-format -msgid "cannot use RENAMES on part of the table '%s'" -msgstr "" - -#: cobc/field.c:3022 -#, c-format -msgid "RENAMES may not contain '%s' as it is a pointer or object reference" -msgstr "" - -#: cobc/field.c:3027 -#, c-format -msgid "RENAMES may not contain '%s' as it is an OCCURS DEPENDING table" -msgstr "" - -#: cobc/field.c:3049 -msgid "RENAMES of 01-, 66- and 77-level items" -msgstr "" - -#: cobc/field.c:3051 -msgid "RENAMES may not reference a level 88" -msgstr "" - -#: cobc/field.c:3075 -#, c-format -msgid "'%s' must immediately follow the record '%s'" -msgstr "" - -#: cobc/field.c:3083 -#, c-format -msgid "THRU item must be different to '%s'" -msgstr "" - -#: cobc/field.c:3089 -#, c-format -msgid "'%s' and '%s' must be in the same record" -msgstr "" - -#: cobc/field.c:3100 -#, c-format -msgid "THRU item '%s' may not be subordinate to '%s'" -msgstr "" - -#: cobc/flag.def:40 -msgid "" -" -fstack-size=\tdefine PERFORM stack size\n" -" * default: 255" -msgstr "" - -#: cobc/flag.def:44 -msgid "" -" -fsign=[ASCII|EBCDIC]\tdefine display sign representation\n" -" * default: machine native" -msgstr "" - -#: cobc/flag.def:48 -msgid "" -" -ffold-copy=[UPPER|LOWER]\tfold COPY subject to value\n" -" * default: no transformation" -msgstr "" - -#: cobc/flag.def:52 -msgid "" -" -ffold-call=[UPPER|LOWER]\tfold PROGRAM-ID, CALL, CANCEL subject to value\n" -" * default: no transformation" -msgstr "" - -#: cobc/flag.def:56 -msgid "" -" -fdefaultbyte=\tinitialize fields without VALUE to value\n" -" * decimal 0..255 or any quoted character\n" -" * default: initialize to picture" -msgstr "" - -#: cobc/flag.def:61 -msgid "" -" -fmax-errors=\tmaximum number of errors to report before\n" -" compilation is aborted\n" -" * default: 128" -msgstr "" - -#: cobc/flag.def:68 -msgid "" -" -fintrinsics=[ALL|intrinsic function name(,name,...)]\n" -" intrinsics to be used without FUNCTION keyword" -msgstr "" - -#: cobc/flag.def:72 -msgid "" -" -fdump= dump data fields on abort, may be\n" -" a combination of: ALL, WS, LS, RD, FD, SC" -msgstr "" - -#: cobc/flag.def:76 -msgid "" -" -fcallfh= use external provided EXTFH interface module\n" -" for I/O" -msgstr "" - -#: cobc/flag.def:80 -msgid "" -" -fsqldb= which Database is used, may be\n" -" MySQL, MSSQL, Oracle10, Oracle11, Oracle12" -msgstr "" - -#: cobc/flag.def:84 -msgid " -fsqlschema= define database schema name" -msgstr "" - -#: cobc/flag.def:91 -msgid "" -" -fno-recursive-check disable check of recursive program call;\n" -" effectively compiling as RECURSIVE program" -msgstr "" - -#: cobc/flag.def:95 -msgid "" -" -fwinmain generate WinMain instead of main when compiling\n" -" as executable" -msgstr "" - -#: cobc/flag.def:99 -msgid " -fcomputed-goto generate computed goto C statements" -msgstr "" - -#: cobc/flag.def:102 -msgid " -falternate-ebcdic use restricted ASCII to EBCDIC translate" -msgstr "" - -#: cobc/flag.def:105 -msgid " -fextra-brace generate extra braces in C source" -msgstr "" - -#: cobc/flag.def:108 -msgid " -fgen-c-line-directives\tgenerate source location directives in C code" -msgstr "" - -#: cobc/flag.def:111 -msgid " -fgen-c-labels generate extra labels in C sources" -msgstr "" - -#: cobc/flag.def:114 -msgid " -fcorrect-numeric attempt correction of invalid numeric display items" -msgstr "" - -#: cobc/flag.def:117 -msgid " -fstack-on-heap PERFORM stack allocated on heap" -msgstr "" - -#: cobc/flag.def:120 -msgid " -ffast-math Disables emitting faster arithmetic logic" -msgstr "" - -#: cobc/flag.def:125 -msgid "" -" -fno-remove-unreachable\tdisable remove of unreachable code\n" -" * turned off by -g" -msgstr "" - -#: cobc/flag.def:129 -msgid " -finline-intrinsic\twhen possible resolve intrinsic FUNCTIONs at compile time" -msgstr "" - -#: cobc/flag.def:132 -msgid "" -" -ftrace generate trace code\n" -" * scope: executed SECTION/PARAGRAPH" -msgstr "" - -#: cobc/flag.def:136 -msgid "" -" -ftraceall generate trace code\n" -" * scope: executed SECTION/PARAGRAPH/STATEMENTS\n" -" * turned on by -debug" -msgstr "" - -#: cobc/flag.def:141 -#, fuzzy -msgid " -fsyntax-only syntax error checking only; don't emit any output" -msgstr "ʸˡ¥Á¥§¥Ã¥¯¤Î¤ß¡£²¿¤â½ÐÎϤ·¤Ê¤¤" - -#: cobc/flag.def:144 -#, fuzzy -msgid "" -" -fdebugging-line enable debugging lines\n" -" * 'D' in indicator column or floating >>D" -msgstr "¥Ç¥Ð¥Ã¥°¹Ô¤òÍ­¸ú¤Ë¤¹¤ë" - -#: cobc/flag.def:148 -msgid "" -" -fsource-location generate source location code\n" -" * turned on by -debug/-g/-ftraceall" -msgstr "" - -#: cobc/flag.def:152 -msgid " -fimplicit-init automatic initialization of the COBOL runtime system" -msgstr "" - -#: cobc/flag.def:155 -msgid "" -" -fstack-check PERFORM stack checking\n" -" * turned on by -debug or -g" -msgstr "" - -#: cobc/flag.def:159 -msgid "" -" -fwrite-after use AFTER 1 for WRITE of LINE SEQUENTIAL\n" -" * default: BEFORE 1" -msgstr "" - -#: cobc/flag.def:163 -msgid "" -" -fmfcomment '*' or '/' in column 1 treated as comment\n" -" * FIXED format only" -msgstr "" - -#: cobc/flag.def:167 -msgid "" -" -facucomment '$' in indicator area treated as '*',\n" -" '|' treated as floating comment" -msgstr "" - -#: cobc/flag.def:171 -msgid "" -" -fnotrunc allow numeric field overflow\n" -" * non-ANSI behaviour" -msgstr "" - -#: cobc/flag.def:175 -msgid "" -" -fodoslide adjust items following OCCURS DEPENDING\n" -" * implies -fcomplex-odo" -msgstr "" - -#: cobc/flag.def:179 -msgid "" -" -fsingle-quote use a single quote (apostrophe) for QUOTE\n" -" * default: double quote" -msgstr "" - -#: cobc/flag.def:189 -msgid "" -" -foptional-file treat all files as OPTIONAL\n" -" * unless NOT OPTIONAL specified" -msgstr "" - -#: cobc/flag.def:193 -#, fuzzy -msgid " -fstatic-call output static function calls for the CALL statement" -msgstr "CALL ʸ¤ÇÀÅŪ´Ø¿ô¸Æ¤Ó½Ð¤·¤ò¹Ô¤Ê¤¦" - -#: cobc/flag.def:196 -msgid "" -" -fno-gen-c-decl-static-call\tdisable generation of C function declations\n" -" for subroutines with static CALL" -msgstr "" - -#: cobc/flag.def:200 -msgid " -fmf-files Sequential & Relative files will match Micro Focus format" -msgstr "" - -#: cobc/flag.def:203 -msgid "" -" -fno-theaders suppress all headers and output of compilation\n" -" options from listing while keeping page breaks" -msgstr "" - -#: cobc/flag.def:207 -msgid " -fno-tsource suppress source from listing" -msgstr "" - -#: cobc/flag.def:210 -msgid " -fno-tmessages suppress warning and error summary from listing" -msgstr "" - -#: cobc/flag.def:213 -msgid " -ftsymbols specify symbols in listing" -msgstr "" - -#: cobc/parser.y:283 cobc/parser.y:317 -#, fuzzy, c-format -msgid "unreachable statement '%s'" -msgstr "ÉÔÅö¤Ê MOVE ʸ¤Ç¤¹" - -#: cobc/parser.y:410 cobc/parser.y:703 -#, c-format -msgid "'%s' is not in LINKAGE SECTION" -msgstr "" - -#: cobc/parser.y:413 cobc/typeck.c:3705 -#, fuzzy, c-format -msgid "'%s' cannot be BASED/EXTERNAL" -msgstr "`%s' ¤Ï BLANK WHEN ZERO ¤ò»ý¤Ä¤³¤È¤¬½ÐÍè¤Þ¤»¤ó" - -#: cobc/parser.y:418 -#, c-format -msgid "'%s' is not in WORKING-STORAGE SECTION" -msgstr "" - -#: cobc/parser.y:425 cobc/typeck.c:3702 -#, fuzzy, c-format -msgid "'%s' not level 01 or 77" -msgstr "`%s' ¤Ï¥ì¥Ù¥ë 01 ¤« 77 ¤Ç¤Ê¤±¤ì¤Ð¤Ê¤ê¤Þ¤»¤ó" - -#: cobc/parser.y:428 cobc/parser.y:443 cobc/typeck.c:3708 -#, c-format -msgid "'%s' REDEFINES field not allowed here" -msgstr "" - -#: cobc/parser.y:456 -#, c-format -msgid "'%s' USING item duplicates RETURNING item" -msgstr "" - -#: cobc/parser.y:466 -#, c-format -msgid "ENTRY '%s' duplicated" -msgstr "" - -#: cobc/parser.y:502 -#, c-format -msgid "ENTRY FOR GO TO '%s' duplicated" -msgstr "" - -#: cobc/parser.y:518 -#, c-format -msgid "maximum nested program depth exceeded (%d)" -msgstr "" - -#: cobc/parser.y:544 cobc/parser.y:571 -#, fuzzy, c-format -msgid "%s statement not terminated by %s" -msgstr "%s ʸ¤¬ END-%s ¤Ç½ª¤ï¤Ã¤Æ¤¤¤Þ¤»¤ó" - -#: cobc/parser.y:574 -#, fuzzy, c-format -msgid "%s statement not terminated" -msgstr "%s ʸ¤¬ END-%s ¤Ç½ª¤ï¤Ã¤Æ¤¤¤Þ¤»¤ó" - -#: cobc/parser.y:638 -msgid "USE statement invalid for SORT file" -msgstr "" - -#: cobc/parser.y:665 cobc/parser.y:667 -#, fuzzy, c-format -msgid "duplicate %s clause" -msgstr "ÉÔÅö¤Ê¥ì¥Ù¥ëÈÖ¹æ¤Ç¤¹ `%s'" - -#: cobc/parser.y:685 -#, c-format -msgid "Cannot specify %s without number of lines on page" -msgstr "" - -#: cobc/parser.y:695 -#, c-format -msgid "maximum OCCURS depth exceeded (%d)" -msgstr "" - -#: cobc/parser.y:709 cobc/parser.y:711 cobc/parser.y:6808 cobc/parser.y:6811 -#: cobc/parser.y:6813 cobc/parser.y:6815 cobc/parser.y:6850 cobc/parser.y:7573 -#: cobc/parser.y:7575 cobc/parser.y:7577 cobc/parser.y:7579 cobc/parser.y:7625 -#: cobc/parser.y:7634 cobc/parser.y:9548 cobc/parser.y:10994 -#: cobc/parser.y:12370 cobc/parser.y:13552 -#, c-format -msgid "%s and %s are mutually exclusive" -msgstr "" - -#: cobc/parser.y:725 cobc/parser.y:729 -msgid "TO phrase without DEPENDING phrase" -msgstr "" - -#: cobc/parser.y:726 -msgid "maximum number of occurrences assumed to be exact number" -msgstr "" - -#: cobc/parser.y:733 cobc/parser.y:7355 -msgid "OCCURS TO must be greater than OCCURS FROM" -msgstr "" - -#: cobc/parser.y:742 -#, fuzzy -msgid "OCCURS DEPENDING ON without TO phrase" -msgstr "GO TO ¤ËÊ£¿ô¤Î¼ê³¤­Ì¾¤¬»ØÄꤵ¤ì¤Æ¤¤¤Þ¤¹" - -#: cobc/parser.y:808 -#, c-format -msgid "%s header missing - assumed" -msgstr "" - -#: cobc/parser.y:810 -#, c-format -msgid "%s header missing" -msgstr "" - -#: cobc/parser.y:942 -#, fuzzy, c-format -msgid "duplicate %s" -msgstr "ÉÔÅö¤Ê¥ì¥Ù¥ëÈÖ¹æ¤Ç¤¹ `%s'" - -#: cobc/parser.y:944 -#, c-format -msgid "%s incorrectly after %s" -msgstr "" - -#: cobc/parser.y:1046 -#, fuzzy, c-format -msgid "redefinition of program name '%s'" -msgstr "`%s' ¤¬ºÆÄêµÁ¤µ¤ì¤Æ¤¤¤Þ¤¹" - -#: cobc/parser.y:1050 -#, fuzzy, c-format -msgid "redefinition of program ID '%s'" -msgstr "`%s' ¤¬ºÆÄêµÁ¤µ¤ì¤Æ¤¤¤Þ¤¹" - -#: cobc/parser.y:1082 -#, c-format -msgid "FUNCTION '%s' has no PROCEDURE DIVISION" -msgstr "" - -#: cobc/parser.y:1188 -msgid "functions may not be defined within a program/function" -msgstr "" - -#: cobc/parser.y:1238 -#, c-format -msgid "END FUNCTION '%s' is different from FUNCTION-ID '%s'" -msgstr "" - -#: cobc/parser.y:1252 -#, c-format -msgid "END PROGRAM '%s' is different from PROGRAM-ID '%s'" -msgstr "" - -#: cobc/parser.y:1301 -msgid "currency symbol must be one character long" -msgstr "" - -#: cobc/parser.y:1358 -#, fuzzy, c-format -msgid "invalid character '%c' in currency symbol" -msgstr "ÉÔÅö¤Ê¼°¤Ç¤¹" - -#: cobc/parser.y:1374 -msgid "prototype has same name as current function and will be ignored" -msgstr "" - -#: cobc/parser.y:1401 -#, c-format -msgid "duplicate REPOSITORY entries for '%s' do not match" -msgstr "" - -#: cobc/parser.y:1405 -#, c-format -msgid "duplicate REPOSITORY entry for '%s'" -msgstr "" - -#: cobc/parser.y:1470 -#, c-format -msgid "ORGANIZATION %s is incompatible with RECORD DELIMITER" -msgstr "" - -#: cobc/parser.y:1502 -#, c-format -msgid "illegal combination of %s with other clauses" -msgstr "" - -#: cobc/parser.y:1517 cobc/parser.y:1520 cobc/parser.y:1551 -#, c-format -msgid "cannot specify both %s and %s" -msgstr "" - -#: cobc/parser.y:1548 -#, c-format -msgid "cannot specify both %s and %s; %s is ignored" -msgstr "" - -#: cobc/parser.y:1720 -msgid "FOR phrase cannot immediately follow ALL/LEADING/TRAILING" -msgstr "" - -#: cobc/parser.y:1722 -msgid "missing CHARACTERS/ALL/LEADING/TRAILING phrase after FOR phrase" -msgstr "" - -#: cobc/parser.y:1729 -#, fuzzy -msgid "missing value between ALL/LEADING/TRAILING words" -msgstr "`%s' ¤ÎÁ°¤Ë ALL ¤Þ¤¿¤Ï LEADING¤¬É¬ÍפǤ¹" - -#: cobc/parser.y:1734 -msgid "missing FOR phrase before CHARACTERS/ALL/LEADING/TRAILING phrase" -msgstr "" - -#: cobc/parser.y:1741 -#, fuzzy -msgid "missing ALL/LEADING/TRAILING before value" -msgstr "`%s' ¤ÎÁ°¤Ë ALL ¤Þ¤¿¤Ï LEADING¤¬É¬ÍפǤ¹" - -#: cobc/parser.y:1796 -msgid "use of condition-name in place of data-name" -msgstr "" - -#: cobc/parser.y:1800 cobc/parser.y:6753 cobc/typeck.c:665 -#, fuzzy, c-format -msgid "condition-name not allowed here: '%s'" -msgstr "`%s' ¤Ï½¤¾þ½ÐÍè¤Þ¤»¤ó" - -#: cobc/parser.y:1827 -msgid "cannot specify NO ADVANCING in screen DISPLAY" -msgstr "" - -#: cobc/parser.y:1899 cobc/parser.y:1916 -msgid "non-standard DISPLAY" -msgstr "" - -#: cobc/parser.y:1903 -msgid "screens may only be displayed on CRT" -msgstr "" - -#: cobc/parser.y:1908 cobc/parser.y:1951 -msgid "cannot mix screens and fields in the same DISPLAY statement" -msgstr "" - -#: cobc/parser.y:1912 -msgid "screen clauses may only be used for DISPLAY on CRT" -msgstr "" - -#: cobc/parser.y:1957 -msgid "ambiguous DISPLAY; put items to display on device in separate DISPLAY" -msgstr "" - -#: cobc/parser.y:1973 -#, fuzzy, c-format -msgid "%s is not an alphanumeric literal" -msgstr "`%s' ¤Ï¿ôÃͤǤϤ¢¤ê¤Þ¤»¤ó" - -#: cobc/parser.y:1975 -#, fuzzy, c-format -msgid "'%s' is not USAGE DISPLAY" -msgstr "`%s' ¤Ï SPECIAL-NAMES ¤ÇÄêµÁ¤µ¤ì¤Æ¤¤¤Þ¤»¤ó" - -#: cobc/parser.y:1990 cobc/typeck.c:8481 -#, fuzzy, c-format -msgid "invalid target for %s" -msgstr "%s: Àá `%s':\n" - -#: cobc/parser.y:1997 cobc/parser.y:6747 -#, fuzzy -msgid "SCREEN item cannot be used here" -msgstr "`%s' ¤Ïź»úÉÕ¤±½ÐÍè¤Þ¤»¤ó" - -#: cobc/parser.y:1999 -#, fuzzy -msgid "RENAMES item may not be used here" -msgstr "`%s' ¤Ïź»úÉÕ¤±½ÐÍè¤Þ¤»¤ó" - -#: cobc/parser.y:2001 cobc/typeck.c:2333 cobc/typeck.c:2429 -#, fuzzy -msgid "ANY LENGTH item not allowed here" -msgstr "`%s' ¤Ï½¤¾þ½ÐÍè¤Þ¤»¤ó" - -#: cobc/parser.y:2005 -#, c-format -msgid "item '%s' has wrong class for VALIDATE" -msgstr "" - -#: cobc/parser.y:2014 -#, fuzzy -msgid "WHEN clause must follow EVERY clause" -msgstr "REDEFINES ¶ç¤Ï¹àÌÜ̾¤Îľ¸å¤Ë¤Ê¤±¤ì¤Ð¤Ê¤ê¤Þ¤»¤ó" - -#: cobc/parser.y:2096 cobc/parser.y:17197 -#, fuzzy -msgid "non-zero value expected" -msgstr "¿ôÃͤ¬É¬ÍפǤ¹" - -#: cobc/parser.y:2102 cobc/tree.c:4352 -#, fuzzy, c-format -msgid "RECORD size (IDX) exceeds maximum allowed (%d)" -msgstr "¥ì¥³¡¼¥ÉŤ¬Ã»¤«²á¤®¤Þ¤¹ `%s'" - -#: cobc/parser.y:2106 cobc/tree.c:4355 -#, fuzzy, c-format -msgid "RECORD size exceeds maximum allowed (%d)" -msgstr "¥ì¥³¡¼¥ÉŤ¬Ã»¤«²á¤®¤Þ¤¹ `%s'" - -#: cobc/parser.y:2111 -#, fuzzy -msgid "RECORD clause invalid" -msgstr "`%s' ¤Ï½¤¾þ½ÐÍè¤Þ¤»¤ó" - -#: cobc/parser.y:3188 -msgid "multiple PROGRAM-ID's without matching END PROGRAM" -msgstr "" - -#: cobc/parser.y:3191 -msgid "executable requested but no program found" -msgstr "" - -#: cobc/parser.y:3408 cobc/parser.y:3417 -msgid "COMMON may only be used in a contained program" -msgstr "" - -#: cobc/parser.y:3426 cobc/parser.y:3458 -msgid "CALL prototypes" -msgstr "" - -#: cobc/parser.y:3607 cobc/parser.y:3884 cobc/parser.y:3928 cobc/parser.y:4036 -#: cobc/parser.y:4223 cobc/parser.y:4319 cobc/parser.y:4360 cobc/parser.y:4431 -#: cobc/parser.y:4452 cobc/parser.y:4531 cobc/parser.y:4550 cobc/parser.y:4566 -#: cobc/parser.y:4584 cobc/parser.y:4602 cobc/parser.y:4619 cobc/parser.y:4637 -#: cobc/parser.y:6868 cobc/parser.y:7694 -#, fuzzy, c-format -msgid "%s not allowed in nested programs" -msgstr "`%s' ¤Ï½¤¾þ½ÐÍè¤Þ¤»¤ó" - -#: cobc/parser.y:3761 -msgid "segment-number must be in range of values 1 to 49" -msgstr "" - -#: cobc/parser.y:3773 -#, fuzzy -msgid "duplicate CLASSIFICATION clause" -msgstr "ÉÔÅö¤Ê¥ì¥Ù¥ëÈÖ¹æ¤Ç¤¹ `%s'" - -#: cobc/parser.y:3849 -msgid "PROGRAM phrase" -msgstr "" - -#: cobc/parser.y:3944 cobc/parser.y:3955 cobc/parser.y:4271 -#, fuzzy, c-format -msgid "invalid %s clause" -msgstr "ÉÔÅö¤Ê VALUE ¶ç¤Ç¤¹" - -#: cobc/parser.y:4386 cobc/parser.y:4390 -msgid "CLASS literal with THRU must have size 1" -msgstr "" - -#: cobc/parser.y:4417 -#, fuzzy -msgid "CLASS IS integer IN alphabet-name" -msgstr "`%s' ¤Ï¥¢¥ë¥Õ¥¡¥Ù¥Ã¥È̾¤Ç¤Ï¤¢¤ê¤Þ¤»¤ó" - -#: cobc/parser.y:4464 -msgid "separate currency symbol and currency string" -msgstr "" - -#: cobc/parser.y:4497 -#, fuzzy, c-format -msgid "invalid CURRENCY SIGN '%s'" -msgstr "ÉÔÅö¤Ê X Äê¿ô¤Ç¤¹: %s" - -#: cobc/parser.y:4715 -msgid "cannot use RELATIVE KEY clause on INDEXED files" -msgstr "" - -#: cobc/parser.y:4719 -msgid "cannot use RECORD KEY clause on RELATIVE files" -msgstr "" - -#: cobc/parser.y:4793 -msgid "EXTERNAL/DYNAMIC cannot be used with literals" -msgstr "" - -#: cobc/parser.y:4813 -msgid "EXTERNAL/DYNAMIC cannot be used with USING/VARYING" -msgstr "" - -#: cobc/parser.y:4824 -msgid "EXTERNAL/DYNAMIC cannot be used with DISK FROM" -msgstr "" - -#: cobc/parser.y:4826 -msgid "ASSIGN DISK FROM" -msgstr "" - -#: cobc/parser.y:4942 -msgid "ASSIGN EXTERNAL/DYNAMIC" -msgstr "" - -#: cobc/parser.y:5165 -#, fuzzy, c-format -msgid "'%s' is not an alphabet-name" -msgstr "`%s' ¤Ï¥¢¥ë¥Õ¥¡¥Ù¥Ã¥È̾¤Ç¤Ï¤¢¤ê¤Þ¤»¤ó" - -#: cobc/parser.y:5254 -#, c-format -msgid "%s only valid with ORGANIZATION %s" -msgstr "" - -#: cobc/parser.y:5321 cobc/parser.y:5344 -#, c-format -msgid "RECORD DELIMITER %s only allowed with SEQUENTIAL files" -msgstr "" - -#: cobc/parser.y:5323 cobc/parser.y:5336 cobc/parser.y:5348 cobc/parser.y:5358 -#, fuzzy -msgid "RECORD DELIMITER clause" -msgstr "`%s' ¤Ï½¤¾þ½ÐÍè¤Þ¤»¤ó" - -#: cobc/parser.y:5332 -#, c-format -msgid "RECORD DELIMITER %s only allowed with (LINE) SEQUENTIAL files" -msgstr "" - -#: cobc/parser.y:5337 -msgid "LINE-SEQUENTIAL phrase" -msgstr "" - -#: cobc/parser.y:5349 -msgid "BINARY-SEQUENTIAL phrase" -msgstr "" - -#: cobc/parser.y:5357 -msgid "RECORD DELIMITER clause only allowed with (LINE) SEQUENTIAL files" -msgstr "" - -#: cobc/parser.y:5360 -#, c-format -msgid "RECORD DELIMITER %s not recognized; will be ignored" -msgstr "" - -#: cobc/parser.y:5398 -msgid "DUPLICATES for primary keys" -msgstr "" - -#: cobc/parser.y:5637 -msgid "DOS/VS APPLY phrase" -msgstr "" - -#: cobc/parser.y:5752 -msgid "RECORD description missing or invalid" -msgstr "" - -#: cobc/parser.y:5778 -#, fuzzy, c-format -msgid "duplicate file description for %s" -msgstr "ÉÔÅö¤Ê¥ì¥Ù¥ëÈÖ¹æ¤Ç¤¹ `%s'" - -#: cobc/parser.y:5811 cobc/parser.y:5821 -msgid "file cannot have both EXTERNAL and GLOBAL clauses" -msgstr "" - -#: cobc/parser.y:5825 cobc/parser.y:6414 cobc/parser.y:6853 cobc/parser.y:12363 -#: cobc/parser.y:15305 -#, c-format -msgid "%s is invalid in a user FUNCTION" -msgstr "" - -#: cobc/parser.y:5863 cobc/parser.y:5872 -msgid "RECORD clause ignored for LINE SEQUENTIAL" -msgstr "" - -#: cobc/parser.y:5964 -msgid "LINAGE clause with wrong file type" -msgstr "" - -#: cobc/parser.y:6026 -msgid "RECORDING MODE U or S can only be used with RECORD SEQUENTIAL files" -msgstr "" - -#: cobc/parser.y:6059 -#, c-format -msgid "ignoring CODE-SET '%s'" -msgstr "" - -#: cobc/parser.y:6070 -#, fuzzy -msgid "CODE-SET clause invalid for file type" -msgstr "`%s' ¤Ï½¤¾þ½ÐÍè¤Þ¤»¤ó" - -#: cobc/parser.y:6092 -#, fuzzy -msgid "REPORT clause with wrong file type" -msgstr "`%s' ¤Ï½¤¾þ½ÐÍè¤Þ¤»¤ó" - -#: cobc/parser.y:6170 -msgid "CD record missing" -msgstr "" - -#: cobc/parser.y:6601 -msgid "CONSTANT item not at 01 level" -msgstr "" - -#: cobc/parser.y:6721 -#, fuzzy -msgid "REDEFINES clause not following entry-name" -msgstr "REDEFINES ¶ç¤Ï¹àÌÜ̾¤Îľ¸å¤Ë¤Ê¤±¤ì¤Ð¤Ê¤ê¤Þ¤»¤ó" - -#: cobc/parser.y:6743 -msgid "SAME AS clause" -msgstr "" - -#: cobc/parser.y:6750 -#, fuzzy -msgid "REPORT item cannot be used here" -msgstr "`%s' ¤Ïź»úÉÕ¤±½ÐÍè¤Þ¤»¤ó" - -#: cobc/parser.y:6757 -#, fuzzy -msgid "elementary item expected" -msgstr "¿ôÃͤ¬É¬ÍפǤ¹" - -#: cobc/parser.y:6764 -msgid "SAME AS item may not reference itself" -msgstr "" - -#: cobc/parser.y:6771 -msgid "SAME AS item may not be subordinate to any item with USAGE clause" -msgstr "" - -#: cobc/parser.y:6773 -msgid "SAME AS item may not be subordinate to any item with SIGN clause" -msgstr "" - -#: cobc/parser.y:6801 cobc/parser.y:6855 cobc/parser.y:7567 cobc/parser.y:7650 -#: cobc/parser.y:7674 -#, fuzzy, c-format -msgid "%s not allowed here" -msgstr "`%s' ¤Ï½¤¾þ½ÐÍè¤Þ¤»¤ó" - -#: cobc/parser.y:6803 cobc/parser.y:6845 cobc/parser.y:7569 -#, fuzzy, c-format -msgid "%s only allowed at 01/77 level" -msgstr "`%s' ¤Ï½¤¾þ½ÐÍè¤Þ¤»¤ó" - -#: cobc/parser.y:6805 cobc/parser.y:6847 cobc/parser.y:7571 cobc/parser.y:7654 -#: cobc/parser.y:7676 -#, fuzzy, c-format -msgid "%s requires a data name" -msgstr "`%s' ¤Ï¥¢¥ë¥Õ¥¡¥Ù¥Ã¥È̾¤Ç¤Ï¤¢¤ê¤Þ¤»¤ó" - -#: cobc/parser.y:6958 -msgid "a locale-format PICTURE string must only consist of '9', '.', '+', 'Z' and the currency-sign" -msgstr "" - -#: cobc/parser.y:6992 cobc/typeck.c:3658 -#, fuzzy, c-format -msgid "'%s' is not a locale-name" -msgstr "`%s' ¤Ï¥Õ¥¡¥¤¥ë̾¤Ç¤Ï¤¢¤ê¤Þ¤»¤ó" - -#: cobc/parser.y:7007 -#, fuzzy, c-format -msgid "'%s' is not a valid USAGE" -msgstr "`%s' ¤Ï¥¢¥ë¥Õ¥¡¥Ù¥Ã¥È̾¤Ç¤Ï¤¢¤ê¤Þ¤»¤ó" - -#: cobc/parser.y:7012 -#, fuzzy, c-format -msgid "unknown USAGE: %s" -msgstr "¸¶°øÉÔÌÀ¤Î¥Õ¥¡¥¤¥ë¥¨¥é¡¼¤Ç¤¹" - -#: cobc/parser.y:7149 -#, c-format -msgid "unknown HANDLE type: %s" -msgstr "" - -#: cobc/parser.y:7406 cobc/parser.y:7408 -msgid "INDEXED should follow ASCENDING/DESCENDING" -msgstr "" - -#: cobc/parser.y:7526 -msgid "SYNCHRONIZED clause" -msgstr "" - -#: cobc/parser.y:7529 -msgid "LEFT/RIGHT phrases in SYNCHRONIZED clause" -msgstr "" - -#: cobc/parser.y:7612 -msgid "FALSE clause only allowed for 88 level" -msgstr "" - -#: cobc/parser.y:7652 -#, fuzzy, c-format -msgid "%s only allowed at 01 level" -msgstr "`%s' ¤Ï½¤¾þ½ÐÍè¤Þ¤»¤ó" - -#: cobc/parser.y:7656 cobc/parser.y:7678 -#, c-format -msgid "%s and %s combination not allowed" -msgstr "" - -#: cobc/parser.y:7787 -#, fuzzy -msgid "GLOBAL is not allowed with RD" -msgstr "`%s' ¤Ï½¤¾þ½ÐÍè¤Þ¤»¤ó" - -#: cobc/parser.y:8321 -msgid "PLUS is not recommended with LEFT, RIGHT or CENTER" -msgstr "" - -#: cobc/parser.y:8323 -#, fuzzy -msgid "PLUS is not allowed with LEFT, RIGHT or CENTER" -msgstr "`%s' ¤Ï½¤¾þ½ÐÍè¤Þ¤»¤ó" - -#: cobc/parser.y:8360 cobc/parser.y:8390 -msgid "PLUS is ignored on first field of line" -msgstr "" - -#: cobc/parser.y:8398 -msgid "invalid COLUMN integer; must be > 0" -msgstr "" - -#: cobc/parser.y:8400 -msgid "COLUMN numbers should increase" -msgstr "" - -#: cobc/parser.y:8499 cobc/parser.y:8555 -msgid "INITIAL specified on non-input field" -msgstr "" - -#: cobc/parser.y:8511 cobc/parser.y:8567 -msgid "relative LINE/COLUMN clause required with OCCURS" -msgstr "" - -#: cobc/parser.y:8669 cobc/parser.y:8673 -msgid "screen positions from data-item" -msgstr "" - -#: cobc/parser.y:9498 -#, fuzzy -msgid "OCCURS screen items" -msgstr "`%s' ¤Ï½¤¾þ½ÐÍè¤Þ¤»¤ó" - -#: cobc/parser.y:9510 -#, fuzzy -msgid "GLOBAL screen items" -msgstr "`%s' ¤Ï½¤¾þ½ÐÍè¤Þ¤»¤ó" - -#: cobc/parser.y:9554 -msgid "overriding convention specified in ENTRY-CONVENTION" -msgstr "" - -#: cobc/parser.y:9566 -msgid "executable program requested but PROCEDURE/ENTRY has USING clause" -msgstr "" - -#: cobc/parser.y:9636 cobc/parser.y:9653 cobc/parser.y:11184 -#, fuzzy, c-format -msgid "number of arguments exceeds maximum %d" -msgstr "ÃͤÎÂ礭¤µ¤¬¹àÌܤÎÂ礭¤µ¤ò±Û¤¨¤Æ¤¤¤Þ¤¹" - -#: cobc/parser.y:9645 -msgid "CHAINING invalid in user FUNCTION" -msgstr "" - -#: cobc/parser.y:9692 cobc/parser.y:11261 cobc/parser.y:11270 -#, fuzzy, c-format -msgid "%s not allowed in CHAINED programs" -msgstr "`%s' ¤Ï½¤¾þ½ÐÍè¤Þ¤»¤ó" - -#: cobc/parser.y:9704 cobc/parser.y:9712 cobc/parser.y:9720 cobc/parser.y:9741 -msgid "SIZE only allowed for BY VALUE items" -msgstr "" - -#: cobc/parser.y:9743 cobc/parser.y:9760 -#, fuzzy -msgid "invalid value for SIZE" -msgstr "ÉÔÅö¤Ê¹ÔÏ¢·ë¤Ç¤¹" - -#: cobc/parser.y:9775 -msgid "MEMORY SIZE phrase in CALL statement" -msgstr "" - -#: cobc/parser.y:9787 -msgid "OPTIONAL only allowed for BY REFERENCE items" -msgstr "" - -#: cobc/parser.y:9799 -#, fuzzy -msgid "RETURNING clause is required for a FUNCTION" -msgstr "%s ¶ç¤¬¥Õ¥¡¥¤¥ë `%s' ¤ËɬÍפǤ¹" - -#: cobc/parser.y:9805 -msgid "RETURNING clause cannot be OMITTED for main program" -msgstr "" - -#: cobc/parser.y:9808 -#, fuzzy -msgid "RETURNING clause cannot be OMITTED for a FUNCTION" -msgstr "%s ¶ç¤¬¥Õ¥¡¥¤¥ë `%s' ¤ËɬÍפǤ¹" - -#: cobc/parser.y:9821 -msgid "RETURNING item is not defined in LINKAGE SECTION" -msgstr "" - -#: cobc/parser.y:9823 -msgid "RETURNING item must have level 01" -msgstr "" - -#: cobc/parser.y:9825 -#, fuzzy -msgid "RETURNING item should not have OCCURS" -msgstr "`%s' ¤Î¸µ¤ÎÄêµÁ¤Ë¤Ï OCCURS ¤òÉÕ¤±¤Æ¤Ï¤Ê¤ê¤Þ¤»¤ó" - -#: cobc/parser.y:9829 -msgid "function RETURNING item may not be ANY LENGTH" -msgstr "" - -#: cobc/parser.y:10017 -#, fuzzy, c-format -msgid "'%s' is not a statement" -msgstr "`%s' ¤Ï¥Õ¥¡¥¤¥ë̾¤Ç¤Ï¤¢¤ê¤Þ¤»¤ó" - -#: cobc/parser.y:10019 -#, c-format -msgid "unknown statement '%s'; it may exist in another dialect" -msgstr "" - -#: cobc/parser.y:10022 -#, fuzzy, c-format -msgid "unknown statement '%s'" -msgstr "¤½¤Î¤è¤¦¤Êʸ¤Ï¤¢¤ê¤Þ¤»¤ó `%s'" - -#: cobc/parser.y:10039 -msgid "section segments" -msgstr "" - -#: cobc/parser.y:10041 -msgid "SECTION segment-number must be less than or equal to 99" -msgstr "" - -#: cobc/parser.y:10044 -msgid "SECTION segment-number in DECLARATIVES must be less than 50" -msgstr "" - -#: cobc/parser.y:10052 -#, fuzzy -msgid "SECTION segment within DECLARATIVES" -msgstr "`%s' ¤Ï SPECIAL-NAMES ¤ÇÄêµÁ¤µ¤ì¤Æ¤¤¤Þ¤»¤ó" - -#: cobc/parser.y:10240 cobc/parser.y:10375 -msgid "non-standard ACCEPT" -msgstr "" - -#: cobc/parser.y:10252 -#, fuzzy -msgid "PROMPT clause" -msgstr "`%s' ¤Ï½¤¾þ½ÐÍè¤Þ¤»¤ó" - -#: cobc/parser.y:10256 -msgid "SIZE IS clause" -msgstr "" - -#: cobc/parser.y:10471 cobc/parser.y:10763 -msgid "TIME-OUT or BEFORE TIME clauses" -msgstr "" - -#: cobc/parser.y:10497 cobc/parser.y:10513 cobc/parser.y:10528 -msgid "AT screen-location" -msgstr "" - -#: cobc/parser.y:10529 -msgid "LINE or COLUMN" -msgstr "" - -#: cobc/parser.y:10893 -msgid "ALLOCATE CHARACTERS requires RETURNING clause" -msgstr "" - -#: cobc/parser.y:10908 cobc/parser.y:12168 -#, fuzzy, c-format -msgid "ignoring %s phrase" -msgstr "¥Þ¥¤¥Ê¥¹Éä¹æ¤Ï̵»ë¤µ¤ì¤Þ¤¹" - -#: cobc/parser.y:10910 -msgid "addressing mode should be either 24 or 31 bit" -msgstr "" - -#: cobc/parser.y:10982 -msgid "recursive program call - assuming RECURSIVE attribute" -msgstr "" - -#: cobc/parser.y:11001 -msgid "STATIC CALL convention ignored because of ON EXCEPTION" -msgstr "" - -#: cobc/parser.y:11010 -msgid "ON EXCEPTION ignored because of STATIC CALL" -msgstr "" - -#: cobc/parser.y:11111 cobc/typeck.c:12209 -#, fuzzy -msgid "invalid mnemonic name" -msgstr "ÉÔÅö¤Ê¥Ë¡¼¥â¥Ë¥Ã¥¯¤Ç¤¹" - -#: cobc/parser.y:11131 cobc/parser.y:11428 -msgid "CALL/CANCEL with program-prototype-name" -msgstr "" - -#: cobc/parser.y:11135 -msgid "id/literal ignored, using prototype name" -msgstr "" - -#: cobc/parser.y:11141 -msgid "NESTED phrase is only valid with literal" -msgstr "" - -#: cobc/parser.y:11202 -msgid "OMITTED only allowed when arguments are passed BY REFERENCE" -msgstr "" - -#: cobc/parser.y:11226 -#, fuzzy -msgid "invalid file name reference" -msgstr "ÉÔÅö¤Ê VALUE ¶ç¤Ç¤¹" - -#: cobc/parser.y:11234 -#, c-format -msgid "BY CONTENT assumed for alphanumeric item '%s'" -msgstr "" - -#: cobc/parser.y:11239 -#, c-format -msgid "BY CONTENT assumed for national item '%s'" -msgstr "" - -#: cobc/parser.y:11302 -msgid "RETURNING item must have level 01 or 77" -msgstr "" - -#: cobc/parser.y:11306 -msgid "RETURNING item must be a LINKAGE SECTION item or have BASED clause" -msgstr "" - -#: cobc/parser.y:11340 cobc/parser.y:15972 cobc/parser.y:16027 -#: cobc/parser.y:16071 cobc/parser.y:16115 -msgid "NOT EXCEPTION before EXCEPTION" -msgstr "" - -#: cobc/parser.y:12041 -#, c-format -msgid "HANDLE must be a %s HANDLE" -msgstr "" - -#: cobc/parser.y:12053 -msgid "HANDLE must be a generic HANDLE" -msgstr "" - -#: cobc/parser.y:12130 -#, fuzzy, c-format -msgid "HANDLE clause invalid for %s" -msgstr "%s ¶ç¤¬¥Õ¥¡¥¤¥ë `%s' ¤ËɬÍפǤ¹" - -#: cobc/parser.y:12361 cobc/parser.y:15495 -#, fuzzy, c-format -msgid "%s is invalid in nested program" -msgstr "`%s' ¤Ï½¤¾þ½ÐÍè¤Þ¤»¤ó" - -#: cobc/parser.y:12399 cobc/parser.y:12440 cobc/parser.y:12451 -#: cobc/parser.y:12462 -#, c-format -msgid "maximum evaluate depth exceeded (%d)" -msgstr "" - -#: cobc/parser.y:12503 cobc/parser.y:12513 -msgid "WHEN without imperative statement" -msgstr "" - -#: cobc/parser.y:12531 cobc/parser.y:12541 -msgid "WHEN OTHER without imperative statement" -msgstr "" - -#: cobc/parser.y:12621 -#, fuzzy -msgid "invalid THROUGH usage" -msgstr "ÉÔÅö¤Ê VALUE ¶ç¤Ç¤¹" - -#: cobc/parser.y:12700 -msgid "EXIT PROGRAM is not allowed within a USE GLOBAL procedure" -msgstr "" - -#: cobc/parser.y:12704 -msgid "EXIT PROGRAM not allowed within a FUNCTION" -msgstr "" - -#: cobc/parser.y:12713 cobc/parser.y:12926 -msgid "RETURNING/GIVING not allowed for non-returning runtime elements" -msgstr "" - -#: cobc/parser.y:12725 -msgid "EXIT FUNCTION is not allowed within a USE GLOBAL procedure" -msgstr "" - -#: cobc/parser.y:12729 -msgid "EXIT FUNCTION only allowed within a FUNCTION" -msgstr "" - -#: cobc/parser.y:12743 cobc/parser.y:12766 -msgid "EXIT PERFORM is only valid with inline PERFORM" -msgstr "" - -#: cobc/parser.y:12788 -msgid "EXIT SECTION is only valid with an active SECTION" -msgstr "" - -#: cobc/parser.y:12809 -msgid "EXIT PARAGRAPH is only valid with an active PARAGRAPH" -msgstr "" - -#: cobc/parser.y:12956 -msgid "IF without imperative statement" -msgstr "" - -#: cobc/parser.y:13173 -msgid "TALLYING clause is incomplete" -msgstr "" - -#: cobc/parser.y:13289 -msgid "INSPECT missing ALL/FIRST/LEADING/TRAILING" -msgstr "" - -#: cobc/parser.y:13407 -msgid "JSON PARSE" -msgstr "" - -#: cobc/parser.y:13552 -#, fuzzy -msgid "LOCK clauses" -msgstr "`%s' ¤Ï½¤¾þ½ÐÍè¤Þ¤»¤ó" - -#: cobc/parser.y:13717 -msgid "inline PERFORM without imperative statement" -msgstr "" - -#: cobc/parser.y:13838 cobc/parser.y:13846 cobc/parser.y:13854 -#, c-format -msgid "PERFORM VARYING '%s' (line %d of %s) is not a numeric field" -msgstr "" - -#: cobc/parser.y:13870 -#, fuzzy -msgid "PERFORM VARYING without BY phrase" -msgstr "GO TO ¤ËÊ£¿ô¤Î¼ê³¤­Ì¾¤¬»ØÄꤵ¤ì¤Æ¤¤¤Þ¤¹" - -#: cobc/parser.y:13910 -#, fuzzy, c-format -msgid "'%s' is not an object-reference" -msgstr "`%s' ¤ÏÀ°¿ô¤Ç¤Ï¤¢¤ê¤Þ¤»¤ó" - -#: cobc/parser.y:13951 cobc/typeck.c:10958 cobc/typeck.c:12100 -msgid "LOCK clause invalid with file LOCK AUTOMATIC" -msgstr "" - -#: cobc/parser.y:13956 -#, fuzzy -msgid "KEY clause invalid with this file type" -msgstr "`%s' ¤Ï½¤¾þ½ÐÍè¤Þ¤»¤ó" - -#: cobc/parser.y:13961 cobc/typeck.c:10954 cobc/typeck.c:12096 -msgid "INVALID KEY clause invalid with this file type" -msgstr "" - -#: cobc/parser.y:14591 -msgid "file sort requires KEY phrase" -msgstr "" - -#: cobc/parser.y:14615 -msgid "table SORT requires KEY phrase" -msgstr "" - -#: cobc/parser.y:14677 -msgid "file sort requires USING or INPUT PROCEDURE" -msgstr "" - -#: cobc/parser.y:14684 -msgid "USING invalid with table SORT" -msgstr "" - -#: cobc/parser.y:14694 -msgid "INPUT PROCEDURE invalid with table SORT" -msgstr "" - -#: cobc/parser.y:14696 -msgid "INPUT PROCEDURE invalid with MERGE" -msgstr "" - -#: cobc/parser.y:14709 -msgid "file sort requires GIVING or OUTPUT PROCEDURE" -msgstr "" - -#: cobc/parser.y:14716 -msgid "GIVING invalid with table SORT" -msgstr "" - -#: cobc/parser.y:14726 -msgid "OUTPUT PROCEDURE invalid with table SORT" -msgstr "" - -#: cobc/parser.y:14753 -#, fuzzy -msgid "SIZE/LENGTH invalid here" -msgstr "`%s' ¤Ï½¤¾þ½ÐÍè¤Þ¤»¤ó" - -#: cobc/parser.y:14806 -msgid "NOT EQUAL condition not allowed on START statement" -msgstr "" - -#: cobc/parser.y:14872 -#, fuzzy, c-format -msgid "%s is replaced by %s" -msgstr "%s ¤Ï %s ¤Ç¤Ï¸Å¤¤»ÅÍͤǤ¹" - -#: cobc/parser.y:14925 -msgid "STOP literal" -msgstr "" - -#: cobc/parser.y:14929 -#, fuzzy -msgid "STOP identifier" -msgstr "ÉÔÅö¤Ê VALUE ¶ç¤Ç¤¹" - -#: cobc/parser.y:15066 -msgid "SUPPRESS statement must be within DECLARATIVES" -msgstr "" - -#: cobc/parser.y:15140 -#, fuzzy -msgid "UNLOCK invalid for SORT files" -msgstr "ÉÔÅö¤Ê VALUE ¶ç¤Ç¤¹" - -#: cobc/parser.y:15276 cobc/parser.y:15355 -msgid "USE statement must be within DECLARATIVES" -msgstr "" - -#: cobc/parser.y:15278 -msgid "SECTION header missing before USE statement" -msgstr "" - -#: cobc/parser.y:15357 -msgid "USE DEBUGGING not supported in contained program" -msgstr "" - -#: cobc/parser.y:15405 cobc/parser.y:15414 cobc/parser.y:15432 -#: cobc/parser.y:15468 cobc/typeck.c:3792 -#, fuzzy, c-format -msgid "duplicate DEBUGGING target: '%s'" -msgstr "ÉÔÅö¤Ê VALUE ¶ç¤Ç¤¹" - -#: cobc/parser.y:15430 -#, fuzzy -msgid "constant item cannot be used here" -msgstr "`%s' ¤Ïź»úÉÕ¤±½ÐÍè¤Þ¤»¤ó" - -#: cobc/parser.y:15456 -msgid "duplicate USE DEBUGGING ON ALL PROCEDURES" -msgstr "" - -#: cobc/parser.y:15528 -#, fuzzy, c-format -msgid "'%s' is not a report group" -msgstr "`%s' ¤Ï¥Õ¥¡¥¤¥ë̾¤Ç¤Ï¤¢¤ê¤Þ¤»¤ó" - -#: cobc/parser.y:15710 -msgid "ENCODING clause must come before XML-DECLARATION" -msgstr "" - -#: cobc/parser.y:15712 -msgid "ENCODING clause must come before ATTRIBUTES" -msgstr "" - -#: cobc/parser.y:15715 -msgid "XML GENERATE ENCODING clause" -msgstr "" - -#: cobc/parser.y:15722 -msgid "XML-DECLARATION clause must come before ATTRIBUTES" -msgstr "" - -#: cobc/parser.y:15725 -msgid "XML GENERATE XML-DECLARATION clause" -msgstr "" - -#: cobc/parser.y:15731 -msgid "XML GENERATE WITH ATTRIBUTES clause" -msgstr "" - -#: cobc/parser.y:15744 -msgid "XML GENERATE NAMESPACE clause" -msgstr "" - -#: cobc/parser.y:15768 -msgid "XML GENERATE NAME OF clause" -msgstr "" - -#: cobc/parser.y:15799 -msgid "XML GENERATE TYPE OF clause" -msgstr "" - -#: cobc/parser.y:15840 -msgid "XML GENERATE SUPPRESS clause" -msgstr "" - -#: cobc/parser.y:15914 -msgid "XML PARSE" -msgstr "" - -#: cobc/parser.y:15955 cobc/parser.y:16633 cobc/parser.y:16729 -#: cobc/parser.y:16815 -#, fuzzy, c-format -msgid "'%s' is not a file name" -msgstr "`%s' ¤Ï¥Õ¥¡¥¤¥ë̾¤Ç¤Ï¤¢¤ê¤Þ¤»¤ó" - -#: cobc/parser.y:16161 -msgid "NOT SIZE ERROR before SIZE ERROR" -msgstr "" - -#: cobc/parser.y:16207 -msgid "NOT OVERFLOW before OVERFLOW" -msgstr "" - -#: cobc/parser.y:16306 -msgid "NOT AT END-OF-PAGE before AT END-OF-PAGE" -msgstr "" - -#: cobc/parser.y:16356 -msgid "NOT INVALID KEY before INVALID KEY" -msgstr "" - -#: cobc/parser.y:16619 -#, fuzzy -msgid "LINAGE-COUNTER must be qualified here" -msgstr "`%s' ¤Ï½¤¾þ½ÐÍè¤Þ¤»¤ó" - -#: cobc/parser.y:16622 -#, fuzzy -msgid "invalid LINAGE-COUNTER usage" -msgstr "ÉÔÅö¤Ê VALUE ¶ç¤Ç¤¹" - -#: cobc/parser.y:16643 -#, fuzzy -msgid "LINE-COUNTER must be qualified here" -msgstr "`%s' ¤Ï½¤¾þ½ÐÍè¤Þ¤»¤ó" - -#: cobc/parser.y:16647 -#, fuzzy -msgid "invalid LINE-COUNTER usage" -msgstr "ÉÔÅö¤Ê VALUE ¶ç¤Ç¤¹" - -#: cobc/parser.y:16658 cobc/parser.y:16683 -#, fuzzy, c-format -msgid "'%s' is not a report name" -msgstr "`%s' ¤Ï¥Õ¥¡¥¤¥ë̾¤Ç¤Ï¤¢¤ê¤Þ¤»¤ó" - -#: cobc/parser.y:16668 -#, fuzzy -msgid "PAGE-COUNTER must be qualified here" -msgstr "`%s' ¤Ï½¤¾þ½ÐÍè¤Þ¤»¤ó" - -#: cobc/parser.y:16672 -#, fuzzy -msgid "invalid PAGE-COUNTER usage" -msgstr "ÉÔÅö¤Ê VALUE ¶ç¤Ç¤¹" - -#: cobc/parser.y:16719 cobc/typeck.c:10919 cobc/typeck.c:11004 -#: cobc/typeck.c:12064 -#, fuzzy, c-format -msgid "%s requires a record name as subject" -msgstr "`%s' ¤Ï¥¢¥ë¥Õ¥¡¥Ù¥Ã¥È̾¤Ç¤Ï¤¢¤ê¤Þ¤»¤ó" - -#: cobc/parser.y:16746 -#, fuzzy, c-format -msgid "'%s' not indexed" -msgstr "`%s' ¤Ë¤Ï INDEXED BY ¤¬É¬ÍפǤ¹" - -#: cobc/parser.y:16772 cobc/parser.y:16797 -#, c-format -msgid "multiple reference to '%s' " -msgstr "" - -#: cobc/parser.y:16827 -#, fuzzy, c-format -msgid "'%s' is not a CD name" -msgstr "`%s' ¤Ï¥Õ¥¡¥¤¥ë̾¤Ç¤Ï¤¢¤ê¤Þ¤»¤ó" - -#: cobc/parser.y:16841 -#, fuzzy, c-format -msgid "'%s' is not a valid report name" -msgstr "`%s' ¤Ï¥Õ¥¡¥¤¥ë̾¤Ç¤Ï¤¢¤ê¤Þ¤»¤ó" - -#: cobc/parser.y:17092 -#, fuzzy -msgid "invalid mnemonic identifier" -msgstr "ÉÔÅö¤Ê¥Ë¡¼¥â¥Ë¥Ã¥¯¤Ç¤¹" - -#: cobc/parser.y:17172 -#, fuzzy -msgid "a numeric literal is expected here" -msgstr "ʸ»úÎó¤¬É¬ÍפǤ¹" - -#: cobc/parser.y:17184 cobc/parser.y:17886 -#, fuzzy -msgid "a non-numeric literal is expected here" -msgstr "ʸ»úÎó¤¬É¬ÍפǤ¹" - -#: cobc/parser.y:17357 cobc/typeck.c:6116 cobc/typeck.c:6123 -#, fuzzy, c-format -msgid "'%s' is not numeric" -msgstr "`%s' ¤Ï¿ô»ú¹àÌܤǤϤ¢¤ê¤Þ¤»¤ó" - -#: cobc/parser.y:17373 -#, fuzzy, c-format -msgid "'%s' is not a field or file" -msgstr "`%s' ¤Ï¥Õ¥¡¥¤¥ë̾¤Ç¤Ï¤¢¤ê¤Þ¤»¤ó" - -#: cobc/parser.y:17393 cobc/parser.y:17411 -#, fuzzy, c-format -msgid "'%s' is not a field" -msgstr "%s ¤Ï̤ÄêµÁ¤Ç¤¹" - -#: cobc/parser.y:17533 -#, fuzzy, c-format -msgid "'%s' is not a field or alphabet" -msgstr "`%s' ¤Ï¥Õ¥¡¥¤¥ë̾¤Ç¤Ï¤¢¤ê¤Þ¤»¤ó" - -#: cobc/parser.y:17559 -#, fuzzy -msgid "a subscripted data-item cannot be used here" -msgstr "`%s' ¤Ïź»úÉÕ¤±½ÐÍè¤Þ¤»¤ó" - -#: cobc/parser.y:17609 -#, fuzzy -msgid "unsigned integer value expected" -msgstr "¿ôÃͤ¬É¬ÍפǤ¹" - -#: cobc/parser.y:17621 cobc/parser.y:17625 cobc/parser.y:17675 -#, fuzzy -msgid "integer value expected" -msgstr "¿ôÃͤ¬É¬ÍפǤ¹" - -#: cobc/parser.y:17630 -#, fuzzy -msgid "invalid symbolic integer" -msgstr "ÉÔÅö¤Ê VALUE ¶ç¤Ç¤¹" - -#: cobc/parser.y:17646 cobc/parser.y:17650 -#, fuzzy -msgid "unsigned positive integer value expected" -msgstr "¿ôÃͤ¬É¬ÍפǤ¹" - -#: cobc/parser.y:17679 -#, fuzzy -msgid "invalid CLASS value" -msgstr "ÉÔÅö¤Ê VALUE ¶ç¤Ç¤¹" - -#: cobc/parser.y:17767 -msgid "PHYSICAL argument for LENGTH functions" -msgstr "" - -#: cobc/parser.y:17938 cobc/parser.y:17955 -msgid "cannot specify offset and SYSTEM-OFFSET at the same time" -msgstr "" - -#: cobc/pplex.l:223 cobc/pplex.l:1739 -msgid "debugging indicator" -msgstr "" - -#: cobc/pplex.l:300 -#, fuzzy -msgid "ignoring empty directive" -msgstr "¥Þ¥¤¥Ê¥¹Éä¹æ¤Ï̵»ë¤µ¤ì¤Þ¤¹" - -#: cobc/pplex.l:310 cobc/pplex.l:369 -#, fuzzy, c-format -msgid "ignoring invalid directive: '%s'" -msgstr "¥Þ¥¤¥Ê¥¹Éä¹æ¤Ï̵»ë¤µ¤ì¤Þ¤¹" - -#: cobc/pplex.l:317 -#, fuzzy -msgid "ignoring invalid directive" -msgstr "¥Þ¥¤¥Ê¥¹Éä¹æ¤Ï̵»ë¤µ¤ì¤Þ¤¹" - -#: cobc/pplex.l:324 -#, fuzzy -msgid "VCS directive" -msgstr "ÉÔÅö¤Ê VALUE ¶ç¤Ç¤¹" - -#: cobc/pplex.l:377 cobc/pplex.l:392 -msgid "spurious '$' detected - ignored" -msgstr "" - -#: cobc/pplex.l:386 -#, fuzzy, c-format -msgid "ignoring unknown directive: '%s'" -msgstr "¥Þ¥¤¥Ê¥¹Éä¹æ¤Ï̵»ë¤µ¤ì¤Þ¤¹" - -#: cobc/pplex.l:398 -#, fuzzy -msgid "PROCESS statement ignored" -msgstr "PROCESS ʸ¤Ï̵»ë¤µ¤ì¤Þ¤¹" - -#: cobc/pplex.l:864 -msgid "IF/ELIF/ELSE directive without matching END-IF" -msgstr "" - -#: cobc/pplex.l:981 -#, fuzzy -msgid "file was included here" -msgstr "ÉÔÅö¤Ê¹ÔÏ¢·ë¤Ç¤¹" - -#: cobc/pplex.l:1186 -#, fuzzy, c-format -msgid "directive nest depth exceeded: %d" -msgstr "`%s' ¤Ï¼ÂÁõ¤µ¤ì¤Æ¤¤¤Þ¤»¤ó" - -#: cobc/pplex.l:1204 -msgid "ELSE directive without matching IF/ELIF" -msgstr "" - -#: cobc/pplex.l:1220 -msgid "END-IF directive without matching IF/ELIF/ELSE" -msgstr "" - -#: cobc/pplex.l:1236 -msgid "ELIF directive without matching IF/ELIF" -msgstr "" - -#: cobc/pplex.l:1258 -#, fuzzy, c-format -msgid "invalid internal case: %u" -msgstr "ÃͤÎÂ礭¤µ¤¬¹àÌܤÎÂ礭¤µ¤ò±Û¤¨¤Æ¤¤¤Þ¤¹" - -#: cobc/pplex.l:1395 -msgid "buffer overrun - too many continuation lines" -msgstr "" - -#: cobc/pplex.l:1485 cobc/pplex.l:1494 -#, fuzzy -msgid "line not terminated by a newline" -msgstr "¥Õ¥¡¥¤¥ë¤¬²þ¹Ô¤Ç½ª¤ï¤Ã¤Æ¤¤¤Þ¤»¤ó" - -#: cobc/pplex.l:1488 cobc/pplex.l:1497 -#, c-format -msgid "source text exceeds %d bytes, will be truncated" -msgstr "" - -#: cobc/pplex.l:1516 -msgid "version control conflict marker in file" -msgstr "" - -#: cobc/pplex.l:1727 -#, fuzzy -msgid "invalid continuation in comment entry" -msgstr "ÉÔÅö¤Ê¹ÔÏ¢·ë¤Ç¤¹" - -#: cobc/pplex.l:1732 -msgid "continuation of COBOL words" -msgstr "" - -#: cobc/pplex.l:1752 -#, fuzzy, c-format -msgid "invalid indicator '%c' at column 7" -msgstr "7 ·åÌܤ¬ÉÔÅö¤Ê»Ø¼¨»Ò¤Ç¤¹ `%c'" - -#: cobc/pplex.l:1800 cobc/pplex.l:1811 -#, fuzzy -msgid "invalid line continuation" -msgstr "ÉÔÅö¤Ê¹ÔÏ¢·ë¤Ç¤¹" - -#: cobc/pplex.l:1819 -msgid "continuation character expected" -msgstr "" - -#: cobc/pplex.l:1885 -#, fuzzy, c-format -msgid "source text after program-text area (column %d)" -msgstr "¥½¡¼¥¹¹Ô¤¬ %d ·å¤ò±Û¤¨¤Æ¤¤¤Þ¤¹" - -#: cobc/ppparse.y:225 -msgid "directive comparison on different types" -msgstr "" - -#: cobc/ppparse.y:293 -#, fuzzy, c-format -msgid "duplicate DEFINE directive '%s'" -msgstr "ÉÔÅö¤Ê VALUE ¶ç¤Ç¤¹" - -#: cobc/ppparse.y:300 cobc/ppparse.y:310 -#, fuzzy -msgid "invalid constant in DEFINE directive" -msgstr "ÉÔÅö¤Ê VALUE ¶ç¤Ç¤¹" - -#: cobc/ppparse.y:408 -#, c-format -msgid "compiler flag '%s' unknown" -msgstr "" - -#: cobc/ppparse.y:454 -#, fuzzy, c-format -msgid "invalid %s directive option '%s'" -msgstr "ÉÔÅö¤Ê VALUE ¶ç¤Ç¤¹" - -#: cobc/ppparse.y:667 -msgid "*CONTROL statement" -msgstr "" - -#: cobc/ppparse.y:933 cobc/ppparse.y:1004 cobc/ppparse.y:1141 -#, fuzzy, c-format -msgid "invalid %s directive" -msgstr "ÉÔÅö¤Ê VALUE ¶ç¤Ç¤¹" - -#: cobc/ppparse.y:1043 -#, fuzzy -msgid "LEAP-SECOND ON directive" -msgstr "¥Þ¥¤¥Ê¥¹Éä¹æ¤Ï̵»ë¤µ¤ì¤Þ¤¹" - -#: cobc/ppparse.y:1051 -msgid "TURN directive" -msgstr "" - -#: cobc/ppparse.y:1133 cobc/ppparse.y:1158 -#, fuzzy -msgid "invalid constant" -msgstr "ÉÔÅö¤Ê¿ô»úÄê¿ô¤Ç¤¹" - -#: cobc/reserved.c:3797 -#, fuzzy -msgid "device name" -msgstr "ÉÔÅö¤Ê¥Ë¡¼¥â¥Ë¥Ã¥¯¤Ç¤¹" - -#: cobc/reserved.c:3800 -msgid "switch name" -msgstr "" - -#: cobc/reserved.c:3803 -msgid "feature name" -msgstr "" - -#: cobc/reserved.c:3902 -#, c-format -msgid "reserved word must have less than %d characters" -msgstr "" - -#: cobc/reserved.c:3921 -msgid "ignored asterisk at end of alias target" -msgstr "" - -#: cobc/reserved.c:3984 -#, c-format -msgid "alias target '%s' is not a default reserved word" -msgstr "" - -#: cobc/reserved.c:4447 -#, fuzzy, c-format -msgid "invalid system-name '%s'" -msgstr "ÉÔÅö¤Ê¥·¥¹¥Æ¥à̾¤Ç¤¹ `%s'" - -#: cobc/reserved.c:4584 -#, c-format -msgid "'%s' is a reserved word, but isn't supported" -msgstr "" - -#: cobc/reserved.c:4689 -#, fuzzy, c-format -msgid "intrinsic function %s is unknown" -msgstr "`%s' ¤ÏÀ°¿ô¤Ç¤Ï¤¢¤ê¤Þ¤»¤ó" - -#: cobc/reserved.c:4717 -#, fuzzy -msgid "Intrinsic Function" -msgstr "`%s' ¤ÏÀ°¿ô¤Ç¤Ï¤¢¤ê¤Þ¤»¤ó" - -#: cobc/reserved.c:4717 cobc/reserved.c:4897 cobc/reserved.c:5034 -#, fuzzy -msgid "Implemented" -msgstr "`%s' ¤Ï¼ÂÁõ¤µ¤ì¤Æ¤¤¤Þ¤»¤ó" - -#: cobc/reserved.c:4717 cobc/typeck.c:1022 -msgid "Parameters" -msgstr "" - -#: cobc/reserved.c:4721 cobc/reserved.c:4901 cobc/reserved.c:5048 -msgid "Yes" -msgstr "" - -#: cobc/reserved.c:4724 cobc/reserved.c:4904 cobc/reserved.c:5054 -msgid "No" -msgstr "" - -#: cobc/reserved.c:4730 -msgid "Unlimited" -msgstr "" - -#: cobc/reserved.c:4804 -#, c-format -msgid "special register %s is unknown, needs a definition" -msgstr "" - -#: cobc/reserved.c:4810 -#, c-format -msgid "special register %s is unknown" -msgstr "" - -#: cobc/reserved.c:4897 -msgid "Internal registers" -msgstr "" - -#: cobc/reserved.c:4897 -#, fuzzy -msgid "Definition" -msgstr "`%s' ¤¬ºÆÄêµÁ¤µ¤ì¤Æ¤¤¤Þ¤¹" - -#: cobc/reserved.c:4985 -#, fuzzy, c-format -msgid "unknown system-name '%s'" -msgstr "¤½¤Î¤è¤¦¤Êʸ¤Ï¤¢¤ê¤Þ¤»¤ó `%s'" - -#: cobc/reserved.c:5011 -#, fuzzy -msgid "System names" -msgstr "ÉÔÅö¤Ê¥Ë¡¼¥â¥Ë¥Ã¥¯¤Ç¤¹" - -#: cobc/reserved.c:5034 -msgid "Reserved Words" -msgstr "" - -#: cobc/reserved.c:5046 -msgid "Yes (Context sensitive)" -msgstr "" - -#: cobc/reserved.c:5052 -msgid "No (Context sensitive)" -msgstr "" - -#: cobc/reserved.c:5081 -msgid "Extra (obsolete) context sensitive words" -msgstr "" - -#: cobc/scanner.l:265 cobc/scanner.l:2288 -#, c-format -msgid "'%s' is not a default reserved word, so cannot be aliased" -msgstr "" - -#: cobc/scanner.l:268 -#, c-format -msgid "'%s' is not a reserved word; you may want ADDSYN or OVERRIDE instead" -msgstr "" - -#: cobc/scanner.l:988 -#, fuzzy, c-format -msgid "a constant may not be used here - '%s'" -msgstr "`%s' ¤Ïź»úÉÕ¤±½ÐÍè¤Þ¤»¤ó" - -#: cobc/scanner.l:1043 -msgid "ignoring redundant ." -msgstr "" - -#: cobc/scanner.l:1101 -#, c-format -msgid "invalid symbol '%s' - skipping word" -msgstr "" - -#: cobc/scanner.l:1191 -#, fuzzy -msgid "invalid national literal" -msgstr "ÉÔÅö¤Ê X Äê¿ô¤Ç¤¹: %s" - -#: cobc/scanner.l:1202 cobc/tree.c:2531 -#, fuzzy, c-format -msgid "invalid literal: '%s'" -msgstr "ÉÔÅö¤Ê H Äê¿ô¤Ç¤¹: %s" - -#: cobc/scanner.l:1204 -#, fuzzy, c-format -msgid "invalid hexadecimal literal: '%s'" -msgstr "ÉÔÅö¤Ê X Äê¿ô¤Ç¤¹: %s" - -#: cobc/scanner.l:1206 cobc/tree.c:1613 -#, fuzzy, c-format -msgid "invalid numeric literal: '%s'" -msgstr "ÉÔÅö¤Ê¿ô»úÄê¿ô¤Ç¤¹" - -#: cobc/scanner.l:1208 -#, fuzzy, c-format -msgid "invalid floating-point literal: '%s'" -msgstr "ÉÔÅö¤Ê¿ô»úÄê¿ô¤Ç¤¹" - -#: cobc/scanner.l:1210 -#, fuzzy, c-format -msgid "invalid %s literal: '%s'" -msgstr "ÉÔÅö¤Ê X Äê¿ô¤Ç¤¹: %s" - -#: cobc/scanner.l:1261 -#, fuzzy, c-format -msgid "literal length exceeds %d characters" -msgstr "¥ì¥³¡¼¥ÉŤ¬Ã»¤«²á¤®¤Þ¤¹ `%s'" - -#: cobc/scanner.l:1277 cobc/scanner.l:1326 cobc/scanner.l:1620 -#, fuzzy -msgid "zero-length literal" -msgstr "ÉÔÅö¤Ê¿ô»úÄê¿ô¤Ç¤¹" - -#: cobc/scanner.l:1280 -#, fuzzy -msgid "national literal has zero length; a SPACE will be assumed" -msgstr "ʸ»úÎó¤¬É¬ÍפǤ¹" - -#: cobc/scanner.l:1281 -#, fuzzy -msgid "alphanumeric literal has zero length; a SPACE will be assumed" -msgstr "ʸ»úÎó¤¬É¬ÍפǤ¹" - -#: cobc/scanner.l:1293 cobc/scanner.l:1294 cobc/scanner.l:1298 -#: cobc/scanner.l:1365 -#, fuzzy -msgid "national literal" -msgstr "ÉÔÅö¤Ê H Äê¿ô¤Ç¤¹: %s" - -#: cobc/scanner.l:1297 -#, fuzzy -msgid "national-character literal" -msgstr "ÉÔÅö¤Ê H Äê¿ô¤Ç¤¹: %s" - -#: cobc/scanner.l:1330 -#, fuzzy -msgid "hexadecimal literal has zero length; X'00' will be assumed" -msgstr "ʸ»úÎó¤¬É¬ÍפǤ¹" - -#: cobc/scanner.l:1349 -#, fuzzy -msgid "hexadecimal-boolean literal" -msgstr "ÉÔÅö¤Ê¿ô»úÄê¿ô¤Ç¤¹" - -#: cobc/scanner.l:1356 cobc/scanner.l:1370 cobc/scanner.l:1485 -#: cobc/scanner.l:1544 cobc/scanner.l:1642 cobc/scanner.l:1711 cobc/tree.c:2532 -#, fuzzy, c-format -msgid "literal length %d exceeds %d characters" -msgstr "¥ì¥³¡¼¥ÉŤ¬Ã»¤«²á¤®¤Þ¤¹ `%s'" - -#: cobc/scanner.l:1362 -#, fuzzy -msgid "hexadecimal-national literal" -msgstr "ÉÔÅö¤Ê X Äê¿ô¤Ç¤¹: %s" - -#: cobc/scanner.l:1393 cobc/scanner.l:1425 cobc/scanner.l:1560 -#: cobc/scanner.l:1656 cobc/scanner.l:1721 -#, fuzzy, c-format -msgid "literal contains invalid character '%c'" -msgstr "%s ¶ç¤¬¥Õ¥¡¥¤¥ë `%s' ¤ËɬÍפǤ¹" - -#: cobc/scanner.l:1449 -#, fuzzy, c-format -msgid "literal does not have an even number of digits" -msgstr "¥ì¥³¡¼¥ÉŤ¬Ã»¤«²á¤®¤Þ¤¹ `%s'" - -#: cobc/scanner.l:1492 -#, fuzzy, c-format -msgid "%s literals must contain at least one character" -msgstr "%s ¶ç¤¬¥Õ¥¡¥¤¥ë `%s' ¤ËɬÍפǤ¹" - -#: cobc/scanner.l:1527 cobc/scanner.l:1628 cobc/scanner.l:1702 -#, fuzzy -msgid "ACUCOBOL numeric literal" -msgstr "ÉÔÅö¤Ê¿ô»úÄê¿ô¤Ç¤¹" - -#: cobc/scanner.l:1537 -#, fuzzy -msgid "H literals must contain at least one character" -msgstr "%s ¶ç¤¬¥Õ¥¡¥¤¥ë `%s' ¤ËɬÍפǤ¹" - -#: cobc/scanner.l:1575 cobc/scanner.l:1667 cobc/scanner.l:1732 -#, fuzzy, c-format -msgid "literal exceeds limit %u" -msgstr "ÃͤÎÂ礭¤µ¤¬¹àÌܤÎÂ礭¤µ¤ò±Û¤¨¤Æ¤¤¤Þ¤¹" - -#: cobc/scanner.l:1616 -#, fuzzy -msgid "numeric boolean literal" -msgstr "ÉÔÅö¤Ê¿ô»úÄê¿ô¤Ç¤¹" - -#: cobc/scanner.l:1622 -#, fuzzy -msgid "Boolean literal has zero length; B'0' will be assumed" -msgstr "ʸ»úÎó¤¬É¬ÍפǤ¹" - -#: cobc/scanner.l:1698 -#, fuzzy -msgid "HP COBOL octal literal" -msgstr "ÉÔÅö¤Ê¿ô»úÄê¿ô¤Ç¤¹" - -#: cobc/scanner.l:1810 cobc/tree.c:1624 -#, fuzzy, c-format -msgid "literal length %d exceeds maximum of %d digits" -msgstr "¥ì¥³¡¼¥ÉŤ¬Ã»¤«²á¤®¤Þ¤¹ `%s'" - -#: cobc/scanner.l:1816 cobc/tree.c:1629 -#, fuzzy, c-format -msgid "literal length %d exceeds %d digits" -msgstr "¥ì¥³¡¼¥ÉŤ¬Ã»¤«²á¤®¤Þ¤¹ `%s'" - -#: cobc/scanner.l:1928 cobc/tree.c:3513 -#, fuzzy, c-format -msgid "significand has more than %d digits" -msgstr "18 ·å¤ò±Û¤¨¤ë¿ô»ú¹àÌܤϵö¤µ¤ì¤Þ¤»¤ó" - -#: cobc/scanner.l:1933 -#, c-format -msgid "exponent has decimal point" -msgstr "" - -#: cobc/scanner.l:1939 cobc/tree.c:3521 -#, c-format -msgid "exponent has more than 4 digits" -msgstr "" - -#: cobc/scanner.l:1969 -#, c-format -msgid "exponent not between -6143 and 6144" -msgstr "" - -#: cobc/scanner.l:1978 -#, c-format -msgid "significand of 0 must be positive" -msgstr "" - -#: cobc/scanner.l:1983 -#, c-format -msgid "exponent of 0 must be 0" -msgstr "" - -#: cobc/scanner.l:1988 -#, c-format -msgid "exponent of 0 must be positive" -msgstr "" - -#: cobc/scanner.l:2170 -#, fuzzy, c-format -msgid "invalid CONSTANT: %s" -msgstr "ÉÔÅö¤Ê¿ô»úÄê¿ô¤Ç¤¹" - -#: cobc/scanner.l:2180 -#, fuzzy, c-format -msgid "invalid alphanumeric CONSTANT: %s" -msgstr "ÉÔÅö¤Ê¿ô»úÄê¿ô¤Ç¤¹" - -#: cobc/scanner.l:2184 -#, fuzzy, c-format -msgid "empty alphanumeric CONSTANT: %s" -msgstr "ÉÔÅö¤Ê¿ô»úÄê¿ô¤Ç¤¹" - -#: cobc/scanner.l:2201 cobc/scanner.l:2209 cobc/scanner.l:2214 -#, fuzzy, c-format -msgid "invalid numeric CONSTANT: %s" -msgstr "ÉÔÅö¤Ê¿ô»úÄê¿ô¤Ç¤¹" - -#: cobc/scanner.l:2291 -#, c-format -msgid "'%s' is already reserved; you may want MAKESYN instead" -msgstr "" - -#: cobc/tree.c:341 -#, fuzzy, c-format -msgid "%s clause is required for file '%s'" -msgstr "%s ¶ç¤¬¥Õ¥¡¥¤¥ë `%s' ¤ËɬÍפǤ¹" - -#: cobc/tree.c:345 -#, fuzzy, c-format -msgid "%s clause is invalid for file '%s' (file type)" -msgstr "`%s' ¤Ï½¤¾þ½ÐÍè¤Þ¤»¤ó" - -#: cobc/tree.c:349 -#, fuzzy, c-format -msgid "%s clause is invalid for file '%s'" -msgstr "%s ¶ç¤¬¥Õ¥¡¥¤¥ë `%s' ¤ËɬÍפǤ¹" - -#: cobc/tree.c:376 -#, c-format -msgid "FOR item '%s' is a record" -msgstr "" - -#: cobc/tree.c:385 -#, c-format -msgid "FOR item '%s' is in different record to '%s'" -msgstr "" - -#: cobc/tree.c:394 -#, c-format -msgid "FOR item '%s' is not in a record associated with '%s'" -msgstr "" - -#: cobc/tree.c:477 -msgid "internal error node" -msgstr "" - -#: cobc/tree.c:479 -#, fuzzy -msgid "unknown constant" -msgstr "¤½¤Î¤è¤¦¤Êʸ¤Ï¤¢¤ê¤Þ¤»¤ó `%s'" - -#: cobc/tree.c:639 -#, fuzzy, c-format -msgid "FUNCTION %s has invalid/not supported arguments - tag %d" -msgstr "`%s' ¤ÏÉôʬ»²¾È¤Ç¤­¤Þ¤»¤ó" - -#: cobc/tree.c:760 -#, fuzzy, c-format -msgid "invalid date/time function: '%d'" -msgstr "ÉÔÅö¤Ê PICTURE ÄêµÁ¤Ç¤¹" - -#: cobc/tree.c:798 -#, fuzzy, c-format -msgid "FUNCTION '%s' has invalid date/time format" -msgstr "`%s' ¤ÏÉôʬ»²¾È¤Ç¤­¤Þ¤»¤ó" - -#: cobc/tree.c:805 -#, fuzzy, c-format -msgid "FUNCTION '%s' has format in variable" -msgstr "`%s' ¤ÏÉôʬ»²¾È¤Ç¤­¤Þ¤»¤ó" - -#: cobc/tree.c:1186 -#, fuzzy, c-format -msgid "literal '%s'" -msgstr "ÉÔÅö¤Ê H Äê¿ô¤Ç¤¹: %s" - -#: cobc/tree.c:1315 -#, c-format -msgid "unknown tree tag: %d, category: %d" -msgstr "" - -#: cobc/tree.c:1405 -#, fuzzy, c-format -msgid "unexpected numeric USAGE: %d" -msgstr "ÉÔÅö¤Ê¿ô»úÄê¿ô¤Ç¤¹" - -#: cobc/tree.c:1419 -#, fuzzy, c-format -msgid "unexpected category: %d" -msgstr "ÉÔÅö¤Ê¿ô»úÄê¿ô¤Ç¤¹" - -#: cobc/tree.c:1678 cobc/tree.c:1690 cobc/tree.c:1752 cobc/tree.c:1802 -#, fuzzy, c-format -msgid "numeric literal '%s' exceeds limit '%s'" -msgstr "ÃͤÎÂ礭¤µ¤¬¹àÌܤÎÂ礭¤µ¤ò±Û¤¨¤Æ¤¤¤Þ¤¹" - -#: cobc/tree.c:2387 -#, fuzzy -msgid "invalid LOCALE literal" -msgstr "ÉÔÅö¤Ê X Äê¿ô¤Ç¤¹: %s" - -#: cobc/tree.c:2512 -#, fuzzy -msgid "only literals with the same category can be concatenated" -msgstr "ʸ»úÎó¤¬É¬ÍפǤ¹" - -#: cobc/tree.c:2519 -#, fuzzy -msgid "only alphanumeric, national or boolean literals may be concatenated" -msgstr "ʸ»úÎó¤¬É¬ÍפǤ¹" - -#: cobc/tree.c:2791 -msgid "B, 0 or /" -msgstr "" - -#: cobc/tree.c:2805 -msgid "the sign of the floating-point exponent" -msgstr "" - -#: cobc/tree.c:2807 -msgid "a leading +/- sign" -msgstr "" - -#: cobc/tree.c:2809 -msgid "a trailing +/- sign" -msgstr "" - -#: cobc/tree.c:2811 -msgid "CR or DB" -msgstr "" - -#: cobc/tree.c:2813 -msgid "a leading currency symbol" -msgstr "" - -#: cobc/tree.c:2815 -msgid "a trailing currency symbol" -msgstr "" - -#: cobc/tree.c:2817 -msgid "a Z or * which is before the decimal point" -msgstr "" - -#: cobc/tree.c:2819 -msgid "a Z or * which is after the decimal point" -msgstr "" - -#: cobc/tree.c:2821 -msgid "a floating +/- string which is before the decimal point" -msgstr "" - -#: cobc/tree.c:2823 -msgid "a floating +/- string which is after the decimal point" -msgstr "" - -#: cobc/tree.c:2825 -msgid "a floating currency symbol string which is before the decimal point" -msgstr "" - -#: cobc/tree.c:2827 -msgid "a floating currency symbol string which is after the decimal point" -msgstr "" - -#: cobc/tree.c:2831 -msgid "A or X" -msgstr "" - -#: cobc/tree.c:2837 -msgid "a P which is before the decimal point" -msgstr "" - -#: cobc/tree.c:2839 -msgid "a P which is after the decimal point" -msgstr "" - -#: cobc/tree.c:2860 cobc/tree.c:3267 -#, c-format -msgid "%s may only occur once in a PICTURE string" -msgstr "" - -#: cobc/tree.c:2862 cobc/tree.c:3219 -#, fuzzy, c-format -msgid "%s cannot follow %s" -msgstr "`%s' ¤Ï½¤¾þ½ÐÍè¤Þ¤»¤ó" - -#: cobc/tree.c:2865 -#, fuzzy -msgid "invalid PICTURE string detected" -msgstr "ÉÔÅö¤Ê¥ª¥×¥·¥ç¥ó¤Ç¤¹ -std=%s\n" - -#: cobc/tree.c:2976 -msgid "number or constant in parentheses is not an unsigned integer" -msgstr "" - -#: cobc/tree.c:2985 -msgid "only up to 9 significant digits are permitted within parentheses" -msgstr "" - -#: cobc/tree.c:2991 -msgid "number or constant in parentheses must be greater than zero" -msgstr "" - -#: cobc/tree.c:3002 -msgid "parentheses must be preceded by a picture symbol" -msgstr "" - -#: cobc/tree.c:3032 -msgid "unbalanced parentheses" -msgstr "" - -#: cobc/tree.c:3040 -msgid "parentheses must contain an unsigned integer" -msgstr "" - -#: cobc/tree.c:3078 -#, fuzzy, c-format -msgid "'%s' is not a constant-name" -msgstr "`%s' ¤Ï¥Õ¥¡¥¤¥ë̾¤Ç¤Ï¤¢¤ê¤Þ¤»¤ó" - -#: cobc/tree.c:3085 -#, fuzzy, c-format -msgid "'%s' is not a numeric literal" -msgstr "`%s' ¤Ï¿ôÃͤǤϤ¢¤ê¤Þ¤»¤ó" - -#: cobc/tree.c:3089 -#, fuzzy, c-format -msgid "'%s' is not an integer" -msgstr "`%s' ¤ÏÀ°¿ô¤Ç¤Ï¤¢¤ê¤Þ¤»¤ó" - -#: cobc/tree.c:3093 -#, fuzzy, c-format -msgid "'%s' is not unsigned" -msgstr "%s ¤Ï̤ÄêµÁ¤Ç¤¹" - -#: cobc/tree.c:3149 -msgid "missing PICTURE string" -msgstr "" - -#: cobc/tree.c:3178 -msgid "C must be followed by R" -msgstr "" - -#: cobc/tree.c:3181 -msgid "D must be followed by B" -msgstr "" - -#: cobc/tree.c:3195 cobc/tree.c:3264 cobc/tree.c:3290 cobc/tree.c:3401 -msgid "uncommon parentheses" -msgstr "" - -#: cobc/tree.c:3219 -msgid "exponent" -msgstr "" - -#: cobc/tree.c:3272 -msgid "S must be at start of PICTURE string" -msgstr "" - -#: cobc/tree.c:3328 -msgid "P must be at start or end of PICTURE string" -msgstr "" - -#: cobc/tree.c:3358 -msgid "cannot have both Z and * in PICTURE string" -msgstr "" - -#: cobc/tree.c:3436 -#, fuzzy, c-format -msgid "invalid PICTURE character '%c'" -msgstr "%s ¶ç¤¬¥Õ¥¡¥¤¥ë `%s' ¤ËɬÍפǤ¹" - -#: cobc/tree.c:3466 -#, c-format -msgid "PICTURE string may not contain more than %d characters; contains %d characters" -msgstr "" - -#: cobc/tree.c:3471 -msgid "PICTURE string must contain at least one of the set A, N, X, Z, 1, 9 and *; or at least two of the set +, - and the currency symbol" -msgstr "" - -#: cobc/tree.c:3498 -#, fuzzy, c-format -msgid "numeric field cannot be larger than %d digits" -msgstr "18 ·å¤ò±Û¤¨¤ë¿ô»ú¹àÌܤϵö¤µ¤ì¤Þ¤»¤ó" - -#: cobc/tree.c:3954 cobc/tree.c:3967 -#, c-format -msgid "no DETAIL line defined in report %s" -msgstr "" - -#: cobc/tree.c:3969 -msgid "PAGE LIMIT FIRST DETAIL should be >= HEADING" -msgstr "" - -#: cobc/tree.c:3972 -msgid "PAGE LIMIT FOOTING should be >= HEADING" -msgstr "" - -#: cobc/tree.c:3974 -msgid "PAGE LIMIT LAST DETAIL should be >= FIRST DETAIL" -msgstr "" - -#: cobc/tree.c:3976 -msgid "PAGE LIMIT FOOTING should be >= LAST DETAIL" -msgstr "" - -#: cobc/tree.c:3978 -msgid "PAGE LIMIT LINES should be >= FOOTING" -msgstr "" - -#: cobc/tree.c:4162 -#, c-format -msgid "maximum keys (%d/%d) exceeded for file '%s'" -msgstr "" - -#: cobc/tree.c:4226 cobc/tree.c:4249 -#, fuzzy, c-format -msgid "invalid KEY item '%s', not in file '%s'" -msgstr "ÉÔÅö¤Ê X Äê¿ô¤Ç¤¹: %s" - -#: cobc/tree.c:4260 -#, c-format -msgid "minimal record length %d can not hold the key item '%s'; needs to be at least %d" -msgstr "" - -#: cobc/tree.c:4296 -#, c-format -msgid "missing file description for %s" -msgstr "" - -#: cobc/tree.c:4328 -#, fuzzy, c-format -msgid "size of record '%s' (%d) smaller than minimum of file '%s' (%d)" -msgstr "`%s' ¤Î¥µ¥¤¥º¤¬ `%s' ¤Î¥µ¥¤¥º¤ò±Û¤¨¤Æ¤¤¤Þ¤¹" - -#: cobc/tree.c:4331 cobc/tree.c:4348 -msgid "file size adjusted" -msgstr "" - -#: cobc/tree.c:4343 -#, fuzzy, c-format -msgid "size of record '%s' (%d) larger than maximum of file '%s' (%d)" -msgstr "`%s' ¤Î¥µ¥¤¥º¤¬ `%s' ¤Î¥µ¥¤¥º¤ò±Û¤¨¤Æ¤¤¤Þ¤¹" - -#: cobc/tree.c:4386 -#, c-format -msgid "file '%s': RECORD VARYING specified without limits, but implied limits are equal" -msgstr "" - -#: cobc/tree.c:4393 -#, fuzzy, c-format -msgid "file '%s': record size (IDX) %d exceeds maximum allowed (%d)" -msgstr "¥ì¥³¡¼¥ÉŤ¬Ã»¤«²á¤®¤Þ¤¹ `%s'" - -#: cobc/tree.c:4397 -#, fuzzy, c-format -msgid "file '%s': record size %d exceeds maximum allowed (%d)" -msgstr "¥ì¥³¡¼¥ÉŤ¬Ã»¤«²á¤®¤Þ¤¹ `%s'" - -#: cobc/tree.c:4404 -msgid "RECORD DELIMITER clause on file with fixed-length records" -msgstr "" - -#: cobc/tree.c:4965 -#, fuzzy, c-format -msgid "literal '%.38s' is longer than '%s'" -msgstr "`%s' ¤Î¥µ¥¤¥º¤¬ `%s' ¤Î¥µ¥¤¥º¤ò±Û¤¨¤Æ¤¤¤Þ¤¹" - -#: cobc/tree.c:4969 -#, c-format -msgid "literal '%.38s' is longer than reference-modification of '%s'" -msgstr "" - -#: cobc/tree.c:4994 -#, c-format -msgid "literal '%s' is alphanumeric but '%s' is numeric" -msgstr "" - -#: cobc/tree.c:5036 -#, c-format -msgid "literal '%s' has more decimals than '%s'" -msgstr "" - -#: cobc/tree.c:5078 -#, c-format -msgid "literal '%s' has more digits than '%s'" -msgstr "" - -#: cobc/tree.c:5118 cobc/tree.c:5142 -#, c-format -msgid "unsigned '%s' may not be %s %s" -msgstr "" - -#: cobc/tree.c:5128 cobc/tree.c:5151 -#, c-format -msgid "unsigned '%s' may always be %s %s" -msgstr "" - -#: cobc/tree.c:5184 cobc/tree.c:5209 -#, fuzzy, c-format -msgid "'%s' may not be %s %s" -msgstr "`%s' ¤Ïź»úÉÕ¤±½ÐÍè¤Þ¤»¤ó" - -#: cobc/tree.c:5195 cobc/tree.c:5220 -#, c-format -msgid "'%s' may always be %s %s" -msgstr "" - -#: cobc/tree.c:5355 -#, fuzzy -msgid "divide by constant ZERO" -msgstr "ÉÔÅö¤Ê¿ô»úÄê¿ô¤Ç¤¹" - -#: cobc/tree.c:5404 cobc/tree.c:5409 cobc/tree.c:5630 cobc/tree.c:5670 -#: cobc/typeck.c:4476 cobc/typeck.c:4484 cobc/typeck.c:4491 cobc/typeck.c:5561 -#: cobc/typeck.c:5706 -#, fuzzy -msgid "invalid expression" -msgstr "ÉÔÅö¤Ê¼°¤Ç¤¹" - -#: cobc/tree.c:5627 -#, fuzzy, c-format -msgid "invalid expression: %s %s %s" -msgstr "ÉÔÅö¤Ê¼°¤Ç¤¹" - -#: cobc/tree.c:5675 -#, fuzzy, c-format -msgid "unexpected operator: %d" -msgstr "ÉÔÅö¤Ê¿ô»úÄê¿ô¤Ç¤¹" - -#: cobc/tree.c:5685 -#, c-format -msgid "expression '%.38s' %s '%.38s' is always TRUE" -msgstr "" - -#: cobc/tree.c:5691 -msgid "expression is always TRUE" -msgstr "" - -#: cobc/tree.c:5703 -#, c-format -msgid "expression '%.38s' %s '%.38s' is always FALSE" -msgstr "" - -#: cobc/tree.c:5709 -msgid "expression is always FALSE" -msgstr "" - -#: cobc/tree.c:6024 -msgid "PERFORM FOREVER since UNTIL is always FALSE" -msgstr "" - -#: cobc/tree.c:6028 -msgid "PERFORM ONCE since UNTIL is always TRUE" -msgstr "" - -#: cobc/tree.c:6031 -msgid "PERFORM NEVER since UNTIL is always TRUE" -msgstr "" - -#: cobc/tree.c:6132 -#, c-format -msgid "no definition/prototype seen for FUNCTION '%s'" -msgstr "" - -#: cobc/tree.c:6134 -#, c-format -msgid "no definition/prototype seen for PROGRAM '%s'" -msgstr "" - -#: cobc/tree.c:6143 -#, c-format -msgid "no definition/prototype seen for FUNCTION with external name '%s'" -msgstr "" - -#: cobc/tree.c:6145 -#, c-format -msgid "no definition/prototype seen for PROGRAM with external name '%s'" -msgstr "" - -#: cobc/tree.c:6237 -#, fuzzy, c-format -msgid "FUNCTION %s has invalid argument" -msgstr "`%s' ¤ÏÉôʬ»²¾È¤Ç¤­¤Þ¤»¤ó" - -#: cobc/tree.c:6239 -#, c-format -msgid "either all arguments or none should be if type %s" -msgstr "" - -#: cobc/tree.c:6271 cobc/tree.c:6277 cobc/tree.c:6319 cobc/tree.c:6324 -#, fuzzy, c-format -msgid "FUNCTION '%s' has invalid reference modification" -msgstr "`%s' ¤ÏÉôʬ»²¾È¤Ç¤­¤Þ¤»¤ó" - -#: cobc/tree.c:6288 cobc/tree.c:6730 -#, fuzzy, c-format -msgid "FUNCTION '%s' unknown" -msgstr "`%s' ¤Ï¼ÂÁõ¤µ¤ì¤Æ¤¤¤Þ¤»¤ó" - -#: cobc/tree.c:6292 -#, fuzzy, c-format -msgid "FUNCTION '%s' is not implemented" -msgstr "`%s' ¤Ï¼ÂÁõ¤µ¤ì¤Æ¤¤¤Þ¤»¤ó" - -#: cobc/tree.c:6299 cobc/tree.c:6306 cobc/tree.c:6714 -#, fuzzy, c-format -msgid "FUNCTION '%s' has wrong number of arguments" -msgstr "WHEN ¶ç¤Î°ú¿ô¤Î¿ô¤¬ÉÔÅö¤Ç¤¹" - -#: cobc/tree.c:6313 -#, fuzzy, c-format -msgid "FUNCTION '%s' cannot have reference modification" -msgstr "`%s' ¤ÏÉôʬ»²¾È¤Ç¤­¤Þ¤»¤ó" - -#: cobc/tree.c:6572 cobc/tree.c:6646 cobc/tree.c:6652 cobc/tree.c:6660 -#: cobc/tree.c:6668 -#, fuzzy, c-format -msgid "FUNCTION '%s' has invalid argument" -msgstr "`%s' ¤ÏÉôʬ»²¾È¤Ç¤­¤Þ¤»¤ó" - -#: cobc/tree.c:6720 -#, fuzzy, c-format -msgid "FUNCTION '%s' has invalid first argument" -msgstr "`%s' ¤ÏÉôʬ»²¾È¤Ç¤­¤Þ¤»¤ó" - -#: cobc/typeck.c:686 -#, fuzzy, c-format -msgid "%s item not allowed here: '%s'" -msgstr "`%s' ¤Ï½¤¾þ½ÐÍè¤Þ¤»¤ó" - -#: cobc/typeck.c:728 -#, fuzzy, c-format -msgid "'%s' is not a group name" -msgstr "`%s' ¤Ï½¸ÃĹàÌܤǤϤ¢¤ê¤Þ¤»¤ó" - -#: cobc/typeck.c:753 -#, fuzzy, c-format -msgid "'%s' is not a numeric name" -msgstr "`%s' ¤Ï¿ô»ú¹àÌܤǤϤ¢¤ê¤Þ¤»¤ó" - -#: cobc/typeck.c:782 -#, fuzzy, c-format -msgid "'%s' is not a numeric or numeric-edited name" -msgstr "`%s' ¤Ï¿ô»ú¹àÌÜ¡¢¤â¤·¤¯¤Ï¿ô»úÊÔ½¸¹àÌܤǤϤ¢¤ê¤Þ¤»¤ó" - -#: cobc/typeck.c:835 -#, fuzzy, c-format -msgid "'%s' is Alpha, instead of a numeric value" -msgstr "`%s' ¤Ï¿ôÃͤǤϤ¢¤ê¤Þ¤»¤ó" - -#: cobc/typeck.c:838 -#, fuzzy, c-format -msgid "'%s' is Alpha Edited, instead of a numeric value" -msgstr "`%s' ¤Ï¿ôÃͤǤϤ¢¤ê¤Þ¤»¤ó" - -#: cobc/typeck.c:851 -#, fuzzy, c-format -msgid "'%s' is not a numeric value" -msgstr "`%s' ¤Ï¿ôÃͤǤϤ¢¤ê¤Þ¤»¤ó" - -#: cobc/typeck.c:901 -#, fuzzy, c-format -msgid "'%s' is not an integer value" -msgstr "`%s' ¤ÏÀ°¿ô¤Ç¤Ï¤¢¤ê¤Þ¤»¤ó" - -#: cobc/typeck.c:905 -msgid "positive numeric integer is required here" -msgstr "" - -#: cobc/typeck.c:1022 -msgid "System routine" -msgstr "" - -#: cobc/typeck.c:1638 libcob/call.c:1069 -#, c-format -msgid "'%s' literal includes leading spaces which are omitted" -msgstr "" - -#: cobc/typeck.c:1642 -#, c-format -msgid "'%s' literal includes trailing spaces which are omitted" -msgstr "" - -#: cobc/typeck.c:1709 -msgid "ON/OFF usage requires a SWITCH name" -msgstr "" - -#: cobc/typeck.c:1727 -#, fuzzy, c-format -msgid "word length exceeds maximum of %d characters: '%s'" -msgstr "¥ì¥³¡¼¥ÉŤ¬Ã»¤«²á¤®¤Þ¤¹ `%s'" - -#: cobc/typeck.c:1730 cobc/typeck.c:1733 -#, fuzzy, c-format -msgid "word length exceeds %d characters: '%s'" -msgstr "¥ì¥³¡¼¥ÉŤ¬Ã»¤«²á¤®¤Þ¤¹ `%s'" - -#: cobc/typeck.c:1810 -#, c-format -msgid "ASSIGN %s interpreted as '%s'" -msgstr "" - -#: cobc/typeck.c:1900 cobc/typeck.c:2067 -#, c-format -msgid "subscript missing for '%s' - defaulting to 1" -msgstr "" - -#: cobc/typeck.c:1913 cobc/typeck.c:1992 -#, fuzzy, c-format -msgid "'%s' cannot be reference modified" -msgstr "`%s' ¤ÏÉôʬ»²¾È¤Ç¤­¤Þ¤»¤ó" - -#: cobc/typeck.c:1923 cobc/typeck.c:1988 cobc/typeck.c:2256 -#, fuzzy, c-format -msgid "'%s' cannot be subscripted" -msgstr "`%s' ¤Ïź»úÉÕ¤±½ÐÍè¤Þ¤»¤ó" - -#: cobc/typeck.c:1927 cobc/typeck.c:2260 -#, fuzzy, c-format -msgid "'%s' requires one subscript" -msgstr "`%s' ¤Ï 1 ¤Ä¤Îź»ú¤òɬÍפȤ·¤Þ¤¹" - -#: cobc/typeck.c:1930 cobc/typeck.c:2263 -#, fuzzy, c-format -msgid "'%s' requires %d subscripts" -msgstr "`%s' ¤Ï %d ¤Ä¤Îź»ú¤òɬÍפȤ·¤Þ¤¹" - -#. TRANSLATORS: This msgid is used when a variable name -#. or label is referenced in a compiler message. -#: cobc/typeck.c:1946 -#, c-format -msgid "'%s'" -msgstr "" - -#: cobc/typeck.c:1948 -#, c-format -msgid "'%s' (accessed by '%s')" -msgstr "" - -#: cobc/typeck.c:2051 -#, fuzzy, c-format -msgid "'%s' has no OCCURS clause" -msgstr "`%s' ¤Ï PICTURE ¶ç¤ò»ý¤Ä¤³¤È¤¬½ÐÍè¤Þ¤»¤ó" - -#: cobc/typeck.c:2108 libcob/common.c:3114 -#, fuzzy, c-format -msgid "subscript of '%s' out of bounds: %d" -msgstr "'%s' ¤Îź»ú¤¬ÈϰϤòĶ¤¨¤Æ¤¤¤Þ¤¹: %d" - -#: cobc/typeck.c:2162 cobc/typeck.c:2172 -msgid "offset must be greater than zero" -msgstr "" - -#: cobc/typeck.c:2167 cobc/typeck.c:2185 cobc/typeck.c:2204 -msgid "length must be greater than zero" -msgstr "" - -#: cobc/typeck.c:2175 cobc/typeck.c:2178 libcob/common.c:3136 -#, fuzzy, c-format -msgid "offset of '%s' out of bounds: %d" -msgstr "'%s' ¤Î³«»Ï°ÌÃÖ¤¬ÈϰϤòĶ¤¨¤Æ¤¤¤Þ¤¹: %d" - -#: cobc/typeck.c:2189 cobc/typeck.c:2193 cobc/typeck.c:2207 cobc/typeck.c:2211 -#: libcob/common.c:3149 -#, fuzzy, c-format -msgid "length of '%s' out of bounds: %d" -msgstr "'%s' ¤ÎŤµ¤¬ÈϰϤòĶ¤¨¤Æ¤¤¤Þ¤¹: %d" - -#: cobc/typeck.c:2323 cobc/typeck.c:2407 -#, fuzzy -msgid "reference modification not allowed here" -msgstr "`%s' ¤Ï½¤¾þ½ÐÍè¤Þ¤»¤ó" - -#: cobc/typeck.c:2337 cobc/typeck.c:2433 -#, fuzzy -msgid "88 level item not allowed here" -msgstr "`%s' ¤Ï½¤¾þ½ÐÍè¤Þ¤»¤ó" - -#: cobc/typeck.c:2342 -#, c-format -msgid "LENGTH OF '%s' not allowed outside of Procedure Division" -msgstr "" - -#: cobc/typeck.c:2346 cobc/typeck.c:2437 cobc/typeck.c:2445 cobc/typeck.c:2512 -#, fuzzy -msgid "variable length item not allowed here" -msgstr "`%s' ¤Ï½¤¾þ½ÐÍè¤Þ¤»¤ó" - -#: cobc/typeck.c:2375 -#, fuzzy, c-format -msgid "'%s' has not been DEFINEd" -msgstr "`%s' ¤Ï SPECIAL-NAMES ¤ÇÄêµÁ¤µ¤ì¤Æ¤¤¤Þ¤»¤ó" - -#: cobc/typeck.c:2411 -#, fuzzy -msgid "only field names allowed here" -msgstr "`%s' ¤Ï½¤¾þ½ÐÍè¤Þ¤»¤ó" - -#: cobc/typeck.c:2422 -#, c-format -msgid "VALUE of '%s': %s target '%s' is invalid" -msgstr "" - -#: cobc/typeck.c:2424 cobc/typeck.c:2494 -msgid "target must be in FILE SECTION or LINKAGE SECTION or have the EXTERNAL clause" -msgstr "" - -#: cobc/typeck.c:2480 cobc/typeck.c:2493 -#, fuzzy, c-format -msgid "VALUE of '%s': %s target is invalid" -msgstr "%s ¶ç¤¬¥Õ¥¡¥¤¥ë `%s' ¤ËɬÍפǤ¹" - -#: cobc/typeck.c:2482 -#, fuzzy -msgid "no previous data-item found" -msgstr "¥ì¥Ù¥ë %02d ¤Î¥Ç¡¼¥¿¹àÌܤ¬Á°¤Ë¤¢¤ê¤Þ¤»¤ó" - -#: cobc/typeck.c:2667 -#, fuzzy, c-format -msgid "'%s' is not an alphabet name" -msgstr "`%s' ¤Ï¥¢¥ë¥Õ¥¡¥Ù¥Ã¥È̾¤Ç¤Ï¤¢¤ê¤Þ¤»¤ó" - -#: cobc/typeck.c:2931 -#, fuzzy, c-format -msgid "duplicate character values in alphabet '%s': %s" -msgstr "ÉÔÅö¤Ê¥ì¥Ù¥ëÈÖ¹æ¤Ç¤¹ `%s'" - -#: cobc/typeck.c:2936 -#, fuzzy, c-format -msgid "invalid character values in alphabet '%s', starting at position %d" -msgstr "ÉÔÅö¤Ê¥ì¥Ù¥ëÈÖ¹æ¤Ç¤¹ `%s'" - -#: cobc/typeck.c:2990 -#, fuzzy -msgid "invalid ALPHABET name" -msgstr "ÉÔÅö¤Ê VALUE ¶ç¤Ç¤¹" - -#: cobc/typeck.c:3054 -#, fuzzy, c-format -msgid "duplicate character values in class '%s'" -msgstr "ÉÔÅö¤Ê¥ì¥Ù¥ëÈÖ¹æ¤Ç¤¹ `%s'" - -#: cobc/typeck.c:3072 -#, fuzzy, c-format -msgid "'%s' is not a locale name" -msgstr "`%s' ¤Ï¥Õ¥¡¥¤¥ë̾¤Ç¤Ï¤¢¤ê¤Þ¤»¤ó" - -#: cobc/typeck.c:3206 -#, fuzzy -msgid "invalid RECORD DEPENDING item" -msgstr "ÉÔÅö¤Ê VALUE ¶ç¤Ç¤¹" - -#: cobc/typeck.c:3211 -msgid "RECORD DEPENDING must reference a data-item" -msgstr "" - -#: cobc/typeck.c:3234 -#, c-format -msgid "RECORD DEPENDING item '%s' should be defined in WORKING-STORAGE, LOCAL-STORAGE or LINKAGE SECTION" -msgstr "" - -#: cobc/typeck.c:3247 -#, fuzzy, c-format -msgid "file %s: RELATIVE KEY %s is not numeric" -msgstr "18 ·å¤ò±Û¤¨¤ë¿ô»ú¹àÌܤϵö¤µ¤ì¤Þ¤»¤ó" - -#: cobc/typeck.c:3256 -#, c-format -msgid "file %s: RELATIVE KEY %s must be integer" -msgstr "" - -#: cobc/typeck.c:3261 -#, c-format -msgid "file %s: RELATIVE KEY %s must be unsigned" -msgstr "" - -#: cobc/typeck.c:3268 -#, c-format -msgid "file %s: RELATIVE KEY %s cannot have OCCURS" -msgstr "" - -#: cobc/typeck.c:3274 -#, c-format -msgid "RELATIVE KEY %s cannot be in file record belonging to %s" -msgstr "" - -#: cobc/typeck.c:3283 -#, c-format -msgid "file %s: RELATIVE KEY %s declared outside WORKING-STORAGE" -msgstr "" - -#: cobc/typeck.c:3306 cobc/typeck.c:7184 -#, fuzzy, c-format -msgid "'%s' is not a valid data name" -msgstr "`%s' ¤Ï¥¢¥ë¥Õ¥¡¥Ù¥Ã¥È̾¤Ç¤Ï¤¢¤ê¤Þ¤»¤ó" - -#: cobc/typeck.c:3313 -#, c-format -msgid "CRT STATUS item '%s' should be defined in WORKING-STORAGE or LOCAL-STORAGE" -msgstr "" - -#: cobc/typeck.c:3319 -#, c-format -msgid "'%s' CRT STATUS must have at least 4 digits" -msgstr "" - -#: cobc/typeck.c:3325 -#, c-format -msgid "'%s' CRT STATUS must be 4 characters long" -msgstr "" - -#: cobc/typeck.c:3341 -#, c-format -msgid "variable '%s' will be implicitly defined" -msgstr "" - -#: cobc/typeck.c:3375 cobc/typeck.c:3438 -msgid "ASSIGN variable" -msgstr "" - -#: cobc/typeck.c:3443 -#, fuzzy, c-format -msgid "ASSIGN data item '%s' is invalid" -msgstr "¥°¥ë¡¼¥×¹àÌÜ `%s' ¤Ï %s ¶ç¤ò»ý¤Ä¤³¤È¤¬½ÐÍè¤Þ¤»¤ó" - -#: cobc/typeck.c:3507 -#, c-format -msgid "'%s' CURSOR must be 4 or 6 characters long" -msgstr "" - -#: cobc/typeck.c:3557 cobc/typeck.c:3561 -#, fuzzy, c-format -msgid "%s does not have a fixed location" -msgstr "`%s' ¤ÏÉôʬ»²¾È¤Ç¤­¤Þ¤»¤ó" - -#: cobc/typeck.c:3573 -#, fuzzy, c-format -msgid "'%s' cannot have nested OCCURS DEPENDING" -msgstr "`%s' ¤Ï OCCURS DEPENDING ¤ò»ý¤Ä¤³¤È¤¬½ÐÍè¤Þ¤»¤ó" - -#: cobc/typeck.c:3587 -#, fuzzy, c-format -msgid "'%s' OCCURS DEPENDING ON field item invalid here" -msgstr "`%s' ¤Ï½¤¾þ½ÐÍè¤Þ¤»¤ó" - -#: cobc/typeck.c:3595 -#, fuzzy, c-format -msgid "'%s' cannot have OCCURS DEPENDING because of '%s'" -msgstr "`%s' ¤Ï OCCURS DEPENDING ¤ò»ý¤Ä¤³¤È¤¬½ÐÍè¤Þ¤»¤ó" - -#: cobc/typeck.c:3607 -#, c-format -msgid "'%s' OCCURS DEPENDING ON item must have GLOBAL attribute" -msgstr "" - -#: cobc/typeck.c:3621 -#, c-format -msgid "PASSWORD '%s' for EXTERNAL file '%s' must have EXTERNAL attribute" -msgstr "" - -#: cobc/typeck.c:3644 -#, c-format -msgid "file %s: ASSIGN %s declared outside WORKING-STORAGE" -msgstr "" - -#: cobc/typeck.c:3674 -#, fuzzy, c-format -msgid "duplicate APPLY COMMIT target: '%s'" -msgstr "ÉÔÅö¤Ê VALUE ¶ç¤Ç¤¹" - -#: cobc/typeck.c:3688 -#, fuzzy -msgid "APPLY COMMIT statement invalid for SORT file" -msgstr "ÉÔÅö¤Ê VALUE ¶ç¤Ç¤¹" - -#: cobc/typeck.c:3691 -#, fuzzy -msgid "APPLY COMMIT statement invalid for REPORT file" -msgstr "ÉÔÅö¤Ê VALUE ¶ç¤Ç¤¹" - -#: cobc/typeck.c:3698 -#, c-format -msgid "APPLY COMMIT item '%s' should be defined in WORKING-STORAGE or LOCAL-STORAGE" -msgstr "" - -#: cobc/typeck.c:3712 -#, fuzzy, c-format -msgid "item not allowed here: '%s'" -msgstr "`%s' ¤Ï½¤¾þ½ÐÍè¤Þ¤»¤ó" - -#: cobc/typeck.c:3725 -#, fuzzy, c-format -msgid "%s may not be subscripted" -msgstr "`%s' ¤Ïź»úÉÕ¤±½ÐÍè¤Þ¤»¤ó" - -#: cobc/typeck.c:3729 -#, fuzzy, c-format -msgid "%s may not be reference modified" -msgstr "`%s' ¤ÏÉôʬ»²¾È¤Ç¤­¤Þ¤»¤ó" - -#: cobc/typeck.c:3789 -#, fuzzy, c-format -msgid "DEBUGGING target invalid: '%s'" -msgstr "`%s' ¤Ï¥¢¥ë¥Õ¥¡¥Ù¥Ã¥È̾¤Ç¤Ï¤¢¤ê¤Þ¤»¤ó" - -#: cobc/typeck.c:3795 -#, fuzzy, c-format -msgid "DEBUGGING target already specified with ALL PROCEDURES: '%s'" -msgstr "`%s' ¤Ï¥¢¥ë¥Õ¥¡¥Ù¥Ã¥È̾¤Ç¤Ï¤¢¤ê¤Þ¤»¤ó" - -#: cobc/typeck.c:3815 -#, fuzzy -msgid "DEBUGGING target" -msgstr "`%s' ¤Ï¥¢¥ë¥Õ¥¡¥Ù¥Ã¥È̾¤Ç¤Ï¤¢¤ê¤Þ¤»¤ó" - -#: cobc/typeck.c:3822 -#, fuzzy, c-format -msgid "'%s' is not a valid DEBUGGING target" -msgstr "`%s' ¤Ï¥¢¥ë¥Õ¥¡¥Ù¥Ã¥È̾¤Ç¤Ï¤¢¤ê¤Þ¤»¤ó" - -#: cobc/typeck.c:3860 cobc/typeck.c:3865 -#, fuzzy, c-format -msgid "'%s' is not in DECLARATIVES" -msgstr "`%s' ¤Ï SPECIAL-NAMES ¤ÇÄêµÁ¤µ¤ì¤Æ¤¤¤Þ¤»¤ó" - -#: cobc/typeck.c:3877 -#, c-format -msgid "invalid reference to '%s' (in DECLARATIVES)" -msgstr "" - -#: cobc/typeck.c:3886 -#, fuzzy, c-format -msgid "'%s' is not a procedure name" -msgstr "`%s' ¤Ï¼ê³¤­Ì¾¤Ç¤Ï¤¢¤ê¤Þ¤»¤ó" - -#: cobc/typeck.c:3948 -#, c-format -msgid "LINKAGE item '%s' is not a PROCEDURE USING parameter" -msgstr "" - -#: cobc/typeck.c:4001 -#, fuzzy, c-format -msgid "'%s' is not an alterable paragraph" -msgstr "`%s' ¤ÏÀ°¿ô¤Ç¤Ï¤¢¤ê¤Þ¤»¤ó" - -#: cobc/typeck.c:4604 cobc/typeck.c:4608 -#, fuzzy, c-format -msgid "suggest parentheses around %s within %s" -msgstr "OR ¤ËÎÙÀܤ¹¤ë AND ¤Ë¤Ï³ç¸Ì¤¬¿ä¾©¤µ¤ì¤Þ¤¹" - -#: cobc/typeck.c:4616 -#, fuzzy -msgid "invalid conditional expression" -msgstr "ÉÔÅö¤Ê¼°¤Ç¤¹" - -#: cobc/typeck.c:4726 -#, c-format -msgid "internal decimal structure size exceeded: %d" -msgstr "" - -#: cobc/typeck.c:4729 -msgid "Try to minimize the number of parentheses or split into multiple computations." -msgstr "" - -#: cobc/typeck.c:4753 -#, c-format -msgid "more than %d nested expressions" -msgstr "" - -#: cobc/typeck.c:4795 -msgid "precision of result may change with arithmetic-osvs" -msgstr "" - -#: cobc/typeck.c:4851 -#, fuzzy, c-format -msgid "unexpected operation: %c (%d)" -msgstr "ÉÔÅö¤Ê¿ô»úÄê¿ô¤Ç¤¹" - -#: cobc/typeck.c:4856 -#, c-format -msgid "%s operator may be misplaced" -msgstr "" - -#: cobc/typeck.c:4926 -#, fuzzy -msgid "unexpected constant expansion" -msgstr "ÉÔÅö¤Ê¿ô»úÄê¿ô¤Ç¤¹" - -#: cobc/typeck.c:5747 -#, c-format -msgid "more than %d nested conditions" -msgstr "" - -#: cobc/typeck.c:6104 cobc/typeck.c:6180 -msgid "no CORRESPONDING items found" -msgstr "" - -#: cobc/typeck.c:6252 -msgid "no items to ACCEPT found" -msgstr "" - -#: cobc/typeck.c:6302 -#, fuzzy -msgid "no items to DISPLAY found" -msgstr "%s: Àá `%s':\n" - -#: cobc/typeck.c:6421 -msgid "cannot specify figurative constant ZERO in AT clause" -msgstr "" - -#: cobc/typeck.c:6425 -#, fuzzy -msgid "value in AT clause is not numeric" -msgstr "18 ·å¤ò±Û¤¨¤ë¿ô»ú¹àÌܤϵö¤µ¤ì¤Þ¤»¤ó" - -#: cobc/typeck.c:6431 -#, fuzzy -msgid "value in AT clause must have 4 or 6 digits" -msgstr "18 ·å¤ò±Û¤¨¤ë¿ô»ú¹àÌܤϵö¤µ¤ì¤Þ¤»¤ó" - -#: cobc/typeck.c:6553 -#, fuzzy -msgid "invalid PROMPT literal" -msgstr "ÉÔÅö¤Ê X Äê¿ô¤Ç¤¹: %s" - -#: cobc/typeck.c:6558 -#, fuzzy -msgid "invalid PROMPT identifier" -msgstr "ÉÔÅö¤Ê VALUE ¶ç¤Ç¤¹" - -#: cobc/typeck.c:6848 -#, fuzzy, c-format -msgid "'%s' is not an input device" -msgstr "`%s' ¤Ï¿ô»ú¹àÌܤǤϤ¢¤ê¤Þ¤»¤ó" - -#: cobc/typeck.c:6878 cobc/typeck.c:8016 -#, fuzzy, c-format -msgid "'%s' is not defined in SPECIAL-NAMES" -msgstr "`%s' ¤Ï SPECIAL-NAMES ¤ÇÄêµÁ¤µ¤ì¤Æ¤¤¤Þ¤»¤ó" - -#: cobc/typeck.c:6883 -#, fuzzy, c-format -msgid "invalid input device '%s'" -msgstr "`%s' ¤ÏÉÔÅö¤ÊÆþÎÏ¥¹¥È¥ê¡¼¥à¤Ç¤¹" - -#: cobc/typeck.c:6888 cobc/typeck.c:8020 -#, c-format -msgid "unknown device '%s'; it may exist in another dialect" -msgstr "" - -#: cobc/typeck.c:6891 cobc/typeck.c:8023 -#, fuzzy, c-format -msgid "unknown device '%s'; not defined in SPECIAL-NAMES" -msgstr "`%s' ¤Ï SPECIAL-NAMES ¤ÇÄêµÁ¤µ¤ì¤Æ¤¤¤Þ¤»¤ó" - -#: cobc/typeck.c:6915 -#, fuzzy -msgid "target of ALLOCATE is not a BASED item" -msgstr "SET ½ÐÍè¤ë¤Î¤Ï INDEXED ¤« POINTER ¤À¤±¤Ç¤¹" - -#: cobc/typeck.c:6926 -#, fuzzy -msgid "target of RETURNING is not a data pointer" -msgstr "SET ½ÐÍè¤ë¤Î¤Ï INDEXED ¤« POINTER ¤À¤±¤Ç¤¹" - -#: cobc/typeck.c:6936 cobc/typeck.c:7342 -msgid "amount must be specified as a numeric expression" -msgstr "" - -#: cobc/typeck.c:6949 -msgid "INITIALIZED TO item is not alphanumeric" -msgstr "" - -#: cobc/typeck.c:7019 -msgid "only alphanumeric FUNCTION types are allowed here" -msgstr "" - -#: cobc/typeck.c:7027 -#, fuzzy -msgid "invalid RETURNING field" -msgstr "ÉÔÅö¤Ê VALUE ¶ç¤Ç¤¹" - -#: cobc/typeck.c:7046 -msgid "STDCALL not available on this platform" -msgstr "" - -#: cobc/typeck.c:7050 -msgid "STDCALL used on 64-bit Windows platform" -msgstr "" - -#: cobc/typeck.c:7055 -msgid "STATIC CALL convention requires a literal program name" -msgstr "" - -#: cobc/typeck.c:7060 cobc/typeck.c:10632 cobc/typeck.c:11539 -#: cobc/typeck.c:11903 -msgid "HANDLE must be either a generic or a THREAD HANDLE" -msgstr "" - -#: cobc/typeck.c:7078 -#, fuzzy -msgid "numeric literal is negative" -msgstr "ÃͤÎÂ礭¤µ¤¬¹àÌܤÎÂ礭¤µ¤ò±Û¤¨¤Æ¤¤¤Þ¤¹" - -#: cobc/typeck.c:7157 -#, fuzzy -msgid "numeric literal exceeds size limits" -msgstr "ÃͤÎÂ礭¤µ¤¬¹àÌܤÎÂ礭¤µ¤ò±Û¤¨¤Æ¤¤¤Þ¤¹" - -#: cobc/typeck.c:7175 -#, fuzzy, c-format -msgid "figurative constant %s invalid here" -msgstr "%s ¶ç¤¬¥Õ¥¡¥¤¥ë `%s' ¤ËɬÍפǤ¹" - -#: cobc/typeck.c:7190 -#, fuzzy, c-format -msgid "'%s' ANY LENGTH item not passed BY REFERENCE" -msgstr "`%s' ¤Ï½¤¾þ½ÐÍè¤Þ¤»¤ó" - -#: cobc/typeck.c:7198 -#, fuzzy, c-format -msgid "'%s' is not a 01 or 77 level item" -msgstr "`%s' ¤Ï¥ì¥Ù¥ë 01 ¤« 77 ¤Ç¤Ê¤±¤ì¤Ð¤Ê¤ê¤Þ¤»¤ó" - -#: cobc/typeck.c:7228 cobc/typeck.c:7233 -#, fuzzy, c-format -msgid "wrong number of CALL parameters for '%s', %d given, %d expected" -msgstr "WHEN ¶ç¤Î°ú¿ô¤Î¿ô¤¬ÉÔÅö¤Ç¤¹" - -#: cobc/typeck.c:7300 cobc/typeck.c:7374 cobc/typeck.c:7378 cobc/typeck.c:7382 -#: cobc/typeck.c:7412 cobc/typeck.c:10591 cobc/typeck.c:10755 -#: cobc/typeck.c:10944 cobc/typeck.c:10948 cobc/typeck.c:11844 -#: cobc/typeck.c:12087 cobc/typeck.c:12090 -#, fuzzy, c-format -msgid "%s not allowed on %s files" -msgstr "`%s' ¤Ï½¤¾þ½ÐÍè¤Þ¤»¤ó" - -#: cobc/typeck.c:7336 -msgid "AFTER phrase in CONTINUE statement" -msgstr "" - -#: cobc/typeck.c:7478 -msgid "positions cannot be specified for main windows" -msgstr "" - -#: cobc/typeck.c:7488 cobc/typeck.c:7491 cobc/typeck.c:7508 -msgid "HANDLE must be either a generic or a WINDOW HANDLE or X(10)" -msgstr "" - -#: cobc/typeck.c:7617 -#, c-format -msgid "'%s' is an invalid type for DISPLAY operand" -msgstr "" - -#: cobc/typeck.c:7622 -#, fuzzy -msgid "invalid type for DISPLAY operand" -msgstr "%s: Àá `%s':\n" - -#: cobc/typeck.c:7973 cobc/typeck.c:8006 -#, fuzzy, c-format -msgid "'%s' is not an output device" -msgstr "`%s' ¤Ï¿ô»ú¹àÌܤǤϤ¢¤ê¤Þ¤»¤ó" - -#: cobc/typeck.c:8109 -#, fuzzy -msgid "invalid use of 88 level in WHEN expression" -msgstr "ÉÔÅö¤Ê¼°¤Ç¤¹" - -#: cobc/typeck.c:8165 -#, fuzzy -msgid "wrong number of WHEN parameters" -msgstr "WHEN ¶ç¤Î°ú¿ô¤Î¿ô¤¬ÉÔÅö¤Ç¤¹" - -#: cobc/typeck.c:8244 cobc/typeck.c:8256 -#, fuzzy, c-format -msgid "target %d of FREE is not a BASED data item" -msgstr "SET ½ÐÍè¤ë¤Î¤Ï INDEXED ¤« POINTER ¤À¤±¤Ç¤¹" - -#: cobc/typeck.c:8262 -#, fuzzy, c-format -msgid "target %d of FREE must be a data pointer" -msgstr "SET ½ÐÍè¤ë¤Î¤Ï INDEXED ¤« POINTER ¤À¤±¤Ç¤¹" - -#: cobc/typeck.c:8276 -#, fuzzy -msgid "GO TO without procedure-name" -msgstr "GO TO ¤ËÊ£¿ô¤Î¼ê³¤­Ì¾¤¬»ØÄꤵ¤ì¤Æ¤¤¤Þ¤¹" - -#: cobc/typeck.c:8286 -#, fuzzy -msgid "GO TO with multiple procedure-names" -msgstr "GO TO ¤ËÊ£¿ô¤Î¼ê³¤­Ì¾¤¬»ØÄꤵ¤ì¤Æ¤¤¤Þ¤¹" - -#: cobc/typeck.c:8308 -#, fuzzy -msgid "GO TO ENTRY with multiple entry-names" -msgstr "GO TO ¤ËÊ£¿ô¤Î¼ê³¤­Ì¾¤¬»ØÄꤵ¤ì¤Æ¤¤¤Þ¤¹" - -#: cobc/typeck.c:8367 -#, fuzzy -msgid "invalid INITIALIZE statement" -msgstr "ÉÔÅö¤Ê MOVE ʸ¤Ç¤¹" - -#: cobc/typeck.c:8443 cobc/typeck.c:8446 -#, c-format -msgid "%s operands differ in size" -msgstr "" - -#: cobc/typeck.c:8476 -#, fuzzy, c-format -msgid "unexpected clause %d" -msgstr "ÉÔÅö¤Ê¿ô»úÄê¿ô¤Ç¤¹" - -#: cobc/typeck.c:8545 cobc/typeck.c:8556 cobc/typeck.c:8567 cobc/typeck.c:8578 -#, fuzzy, c-format -msgid "data name expected before %s" -msgstr "ALL ¤ÎÁ°¤Ë¥Ç¡¼¥¿Ì¾¤¬É¬ÍפǤ¹<" - -#: cobc/typeck.c:8588 -#, fuzzy, c-format -msgid "ALL, LEADING or TRAILING expected before '%s'" -msgstr "`%s' ¤ÎÁ°¤Ë ALL ¤Þ¤¿¤Ï LEADING¤¬É¬ÍפǤ¹" - -#: cobc/typeck.c:8598 -msgid "operand has wrong size" -msgstr "" - -#: cobc/typeck.c:8669 -#, c-format -msgid "internal register '%s' defined as BINARY-LONG" -msgstr "" - -#: cobc/typeck.c:8672 cobc/typeck.c:8675 cobc/typeck.c:8678 cobc/typeck.c:8681 -#: cobc/typeck.c:8684 cobc/typeck.c:8687 cobc/typeck.c:8690 cobc/typeck.c:8693 -#: cobc/typeck.c:8696 -#, fuzzy, c-format -msgid "'%s' defined here as USAGE %s" -msgstr "`%s' ¤Ï¤³¤³¤Ç PIC %s ¤È¤·¤ÆÄêµÁ¤µ¤ì¤Þ¤·¤¿" - -#: cobc/typeck.c:8699 -#, fuzzy, c-format -msgid "'%s' defined here as PIC %s" -msgstr "`%s' ¤Ï¤³¤³¤Ç PIC %s ¤È¤·¤ÆÄêµÁ¤µ¤ì¤Þ¤·¤¿" - -#: cobc/typeck.c:8702 -#, fuzzy, c-format -msgid "'%s' defined here as a group of length %d" -msgstr "`%s' ¤Ï¤³¤³¤ÇÂ礭¤µ %d ¤Î¥°¥ë¡¼¥×¤È¤·¤ÆÄêµÁ¤µ¤ì¤Æ¤¤¤Þ¤¹" - -#: cobc/typeck.c:8741 -#, c-format -msgid "value is %s" -msgstr "" - -#: cobc/typeck.c:8745 -#, fuzzy, c-format -msgid "value size is %d" -msgstr "ÃͤÎÂ礭¤µ¤¬¹àÌܤÎÂ礭¤µ¤ò±Û¤¨¤Æ¤¤¤Þ¤¹" - -#: cobc/typeck.c:9022 -#, fuzzy -msgid "invalid destination for MOVE" -msgstr "ÉÔÅö¤Ê¹ÔÏ¢·ë¤Ç¤¹" - -#: cobc/typeck.c:9057 -#, fuzzy -msgid "MOVE of figurative constant SPACE to numeric item" -msgstr "%s ¶ç¤¬¥Õ¥¡¥¤¥ë `%s' ¤ËɬÍפǤ¹" - -#: cobc/typeck.c:9072 -msgid "MOVE of figurative constant QUOTE to numeric item" -msgstr "" - -#: cobc/typeck.c:9077 cobc/typeck.c:9089 -#, fuzzy -msgid "MOVE of figurative constant to numeric item" -msgstr "%s ¶ç¤¬¥Õ¥¡¥¤¥ë `%s' ¤ËɬÍפǤ¹" - -#: cobc/typeck.c:9151 -msgid "numeric literal in VALUE clause of numeric-edited item" -msgstr "" - -#: cobc/typeck.c:9176 -msgid "numeric move to ALPHABETIC" -msgstr "" - -#: cobc/typeck.c:9188 -#, fuzzy -msgid "data item not signed" -msgstr "¥Ç¡¼¥¿¹àÌܤËÉä¹æ¤¬¤¢¤ê¤Þ¤»¤ó" - -#: cobc/typeck.c:9191 -#, fuzzy -msgid "ignoring sign" -msgstr "¥Þ¥¤¥Ê¥¹Éä¹æ¤Ï̵»ë¤µ¤ì¤Þ¤¹" - -#: cobc/typeck.c:9503 -msgid "overlapping MOVE may occur and produce unpredictable results" -msgstr "" - -#: cobc/typeck.c:9510 -msgid "overlapping MOVE may produce unpredictable results" -msgstr "" - -#: cobc/typeck.c:9643 -#, fuzzy -msgid "invalid source for MOVE" -msgstr "ÉÔÅö¤Ê¹ÔÏ¢·ë¤Ç¤¹" - -#: cobc/typeck.c:9666 -msgid "source is non-numeric - substituting zero" -msgstr "" - -#: cobc/typeck.c:9672 cobc/typeck.c:9683 -#, fuzzy -msgid "invalid VALUE clause" -msgstr "ÉÔÅö¤Ê VALUE ¶ç¤Ç¤¹" - -#: cobc/typeck.c:9675 cobc/typeck.c:11480 cobc/typeck.c:11485 -#: cobc/typeck.c:11512 cobc/typeck.c:11517 -#, fuzzy -msgid "invalid SET statement" -msgstr "ÉÔÅö¤Ê MOVE ʸ¤Ç¤¹" - -#: cobc/typeck.c:9677 -#, fuzzy -msgid "invalid MOVE statement" -msgstr "ÉÔÅö¤Ê MOVE ʸ¤Ç¤¹" - -#: cobc/typeck.c:9684 -#, fuzzy -msgid "literal exceeds data size" -msgstr "ÃͤÎÂ礭¤µ¤¬¹àÌܤÎÂ礭¤µ¤ò±Û¤¨¤Æ¤¤¤Þ¤¹" - -#: cobc/typeck.c:9688 -#, fuzzy -msgid "numeric literal exceeds data size" -msgstr "ÃͤÎÂ礭¤µ¤¬¹àÌܤÎÂ礭¤µ¤ò±Û¤¨¤Æ¤¤¤Þ¤¹" - -#: cobc/typeck.c:9697 -#, fuzzy -msgid "MOVE of non-integer to alphanumeric" -msgstr "ÈóÀ°¿ô¤«¤é±Ñ¿ô»ú¹àÌܤؤΠMOVE ¤Ï½ÐÍè¤Þ¤»¤ó" - -#: cobc/typeck.c:9703 -#, fuzzy -msgid "numeric value is expected" -msgstr "¿ôÃͤ¬É¬ÍפǤ¹" - -#: cobc/typeck.c:9708 -#, fuzzy -msgid "alphanumeric value is expected" -msgstr "ʸ»úÎó¤¬É¬ÍפǤ¹" - -#: cobc/typeck.c:9713 -#, fuzzy -msgid "value does not fit the picture string" -msgstr "Ãͤ¬ PICTURE ¤Ë¹çÃפ·¤Þ¤»¤ó" - -#: cobc/typeck.c:9719 -#, fuzzy -msgid "value size exceeds data size" -msgstr "ÃͤÎÂ礭¤µ¤¬¹àÌܤÎÂ礭¤µ¤ò±Û¤¨¤Æ¤¤¤Þ¤¹" - -#: cobc/typeck.c:9724 -msgid "sending field larger than receiving field" -msgstr "" - -#: cobc/typeck.c:9729 -msgid "some digits may be truncated" -msgstr "" - -#: cobc/typeck.c:10515 -#, fuzzy, c-format -msgid "invalid MOVE target: %s" -msgstr "ÉÔÅö¤Ê MOVE ʸ¤Ç¤¹" - -#: cobc/typeck.c:10768 -#, fuzzy -msgid "READ PREVIOUS not allowed for this file type" -msgstr "`%s' ¤Ï½¤¾þ½ÐÍè¤Þ¤»¤ó" - -#: cobc/typeck.c:10776 -msgid "KEY ignored with sequential READ" -msgstr "½çÆɤ߹þ¤ß¤Î READ ¤Ç¤¢¤ë¤¿¤á KEY ¤Ï̵»ë¤µ¤ì¤Þ¤¹" - -#: cobc/typeck.c:10872 -#, fuzzy -msgid "figurative constants not allowed in FROM clause" -msgstr "%s ¶ç¤¬¥Õ¥¡¥¤¥ë `%s' ¤ËɬÍפǤ¹" - -#: cobc/typeck.c:10879 -msgid "literal in FROM clause must be alphanumeric, national or boolean" -msgstr "" - -#: cobc/typeck.c:10902 cobc/typeck.c:12047 -#, fuzzy, c-format -msgid "%s FILE requires a FROM clause" -msgstr "`%s' ¤Ï¥¢¥ë¥Õ¥¡¥Ù¥Ã¥È̾¤Ç¤Ï¤¢¤ê¤Þ¤»¤ó" - -#: cobc/typeck.c:10924 cobc/typeck.c:11010 cobc/typeck.c:12069 -#, c-format -msgid "%s subject does not refer to a record name" -msgstr "" - -#: cobc/typeck.c:11016 -#, fuzzy -msgid "RELEASE not allowed on this record item" -msgstr "`%s' ¤Ï½¤¾þ½ÐÍè¤Þ¤»¤ó" - -#: cobc/typeck.c:11097 cobc/typeck.c:11118 cobc/typeck.c:11125 -#, fuzzy -msgid "invalid SEARCH ALL condition" -msgstr "SEARCH ALL ¤Î¾ò·ï¼°¤¬ÉÔÅö¤Ç¤¹" - -#: cobc/typeck.c:11237 cobc/typeck.c:11241 -msgid "SET targets must be PROGRAM-POINTER" -msgstr "" - -#: cobc/typeck.c:11268 cobc/typeck.c:11335 cobc/typeck.c:11403 -#, c-format -msgid "cannot change address of '%s', which is not level 1 or 77" -msgstr "" - -#: cobc/typeck.c:11272 cobc/typeck.c:11339 cobc/typeck.c:11407 -#, c-format -msgid "cannot change address of '%s', which is not BASED or a LINKAGE item" -msgstr "" - -#: cobc/typeck.c:11291 -#, c-format -msgid "SET target '%s' is not numeric, an INDEX or a POINTER" -msgstr "" - -#: cobc/typeck.c:11360 -#, c-format -msgid "SET target '%s' is not a POINTER for FCD" -msgstr "" - -#: cobc/typeck.c:11428 -#, c-format -msgid "SET target '%s' is not a POINTER for FCD-KEYDEF" -msgstr "" - -#: cobc/typeck.c:11521 -#, fuzzy -msgid "field does not have a FALSE clause" -msgstr "REDEFINES ¤Ë´Þ¤Þ¤ì¤ë¹àÌÜ¤Ï VALUE ¶ç¤ò»ý¤Ä¤³¤È¤¬½ÐÍè¤Þ¤»¤ó" - -#: cobc/typeck.c:11552 -msgid "THREAD-priority must be between 1 and 32767" -msgstr "" - -#: cobc/typeck.c:11572 -msgid "SET ATTRIBUTE requires a screen item as subject" -msgstr "" - -#: cobc/typeck.c:11578 -msgid "SET ATTRIBUTE subject does not refer to a screen item" -msgstr "" - -#: cobc/typeck.c:11629 -#, fuzzy -msgid "invalid SORT filename" -msgstr "ÉÔÅö¤Ê VALUE ¶ç¤Ç¤¹" - -#: cobc/typeck.c:11689 -#, fuzzy -msgid "invalid SORT USING parameter" -msgstr "ÉÔÅö¤Ê MOVE ʸ¤Ç¤¹" - -#: cobc/typeck.c:11718 -#, fuzzy -msgid "invalid SORT GIVING parameter" -msgstr "ÉÔÅö¤Ê MOVE ʸ¤Ç¤¹" - -#: cobc/typeck.c:11772 cobc/typeck.c:11799 cobc/typeck.c:11819 -#, fuzzy -msgid "invalid key item" -msgstr "ÉÔÅö¤Ê VALUE ¶ç¤Ç¤¹" - -#: cobc/typeck.c:11849 -msgid "LENGTH/SIZE clause only allowed on INDEXED files" -msgstr "" - -#: cobc/typeck.c:11854 -#, fuzzy -msgid "START not allowed with ACCESS MODE RANDOM" -msgstr "`%s' ¤Ï½¤¾þ½ÐÍè¤Þ¤»¤ó" - -#: cobc/typeck.c:12103 -#, fuzzy -msgid "LOCK clause invalid here" -msgstr "`%s' ¤Ï½¤¾þ½ÐÍè¤Þ¤»¤ó" - -#: cobc/typeck.c:12365 -msgid "data item is not part of a report" -msgstr "" - -#: cobc/typeck.c:12385 -msgid "improper use of SUPPRESS PRINTING" -msgstr "" - -#: cobc/typeck.c:12400 -#, fuzzy, c-format -msgid "%s must be alphanumeric or national" -msgstr "`%s' ¤Ï¿ôÃͤǤϤ¢¤ê¤Þ¤»¤ó" - -#: cobc/typeck.c:12411 -#, c-format -msgid "%s may not be a figurative constant" -msgstr "" - -#: cobc/typeck.c:12438 -#, c-format -msgid "%s must be a child of the input record" -msgstr "" - -#: cobc/typeck.c:12464 -#, c-format -msgid "%s may not be an ignored item in JSON/XML GENERATE" -msgstr "" - -#: cobc/typeck.c:12475 -#, c-format -msgid "%s must be elementary" -msgstr "" - -#: cobc/typeck.c:12487 -#, fuzzy, c-format -msgid "%s must be USAGE DISPLAY or NATIONAL" -msgstr "`%s' ¤Ï SPECIAL-NAMES ¤ÇÄêµÁ¤µ¤ì¤Æ¤¤¤Þ¤»¤ó" - -#: cobc/typeck.c:12501 -#, fuzzy, c-format -msgid "%s must be an integer" -msgstr "`%s' ¤ÏÀ°¿ô¤Ç¤Ï¤¢¤ê¤Þ¤»¤ó" - -#: cobc/typeck.c:12517 cobc/typeck.c:12523 -msgid "JSON/XML GENERATE receiving item" -msgstr "" - -#: cobc/typeck.c:12520 -msgid "JSON/XML GENERATE receiving item may not have JUSTIFIED clause" -msgstr "" - -#: cobc/typeck.c:12608 -#, fuzzy -msgid "JSON/XML GENERATE input record may not be reference modified" -msgstr "`%s' ¤ÏÉôʬ»²¾È¤Ç¤­¤Þ¤»¤ó" - -#: cobc/typeck.c:12614 -msgid "JSON/XML GENERATE input record may not have RENAMES clause" -msgstr "" - -#: cobc/typeck.c:12619 -#, c-format -msgid "all the children of '%s' are ignored in JSON/XML GENERATE" -msgstr "" - -#: cobc/typeck.c:12626 -msgid "JSON/XML GENERATE input record has subrecords with non-unique names" -msgstr "" - -#: cobc/typeck.c:12631 -msgid "floating-point items in JSON/XML GENERATE" -msgstr "" - -#: cobc/typeck.c:12635 -msgid "OCCURS items in JSON/XML GENERATE" -msgstr "" - -#: cobc/typeck.c:12660 -msgid "COUNT IN item must be numeric and an integer" -msgstr "" - -#: cobc/typeck.c:12665 -msgid "COUNT IN item must be an integer" -msgstr "" - -#: cobc/typeck.c:12668 -msgid "COUNT IN item may not have PICTURE with P in it" -msgstr "" - -#: cobc/typeck.c:12711 -msgid "NAMESPACE must be a valid URI" -msgstr "" - -#: cobc/typeck.c:12755 -msgid "NAMESPACE-PREFIX must be a valid XML name" -msgstr "" - -#: cobc/typeck.c:12780 cobc/typeck.c:12787 -msgid "NAME OF item" -msgstr "" - -#: cobc/typeck.c:12784 -msgid "NAME OF item must be the input record or a child of it" -msgstr "" - -#: cobc/typeck.c:12791 -msgid "NAME OF name must be a valid XML name" -msgstr "" - -#: cobc/typeck.c:12817 cobc/typeck.c:12818 cobc/typeck.c:12821 -#: cobc/typeck.c:12825 -msgid "TYPE OF item" -msgstr "" - -#: cobc/typeck.c:12843 -msgid "SUPPRESS WHEN SPACE item" -msgstr "" - -#: cobc/typeck.c:12846 -msgid "SUPPRESS WHEN LOW-VALUE item" -msgstr "" - -#: cobc/typeck.c:12848 -msgid "SUPPRESS WHEN HIGH-VALUE item" -msgstr "" - -#: cobc/typeck.c:12877 cobc/typeck.c:12885 cobc/typeck.c:12889 -msgid "SUPPRESS item" -msgstr "" - -#: cobc/typeck.c:12881 -msgid "SUPPRESS item with WHEN clause" -msgstr "" - -#: cobc/typeck.c:12958 -msgid "WITH ATTRIBUTES specified, but no attributes can be generated" -msgstr "" - -#: cobc/warning.def:34 -msgid " -Wextra additional warnings only raised with -W or -Wall" -msgstr "" - -#: cobc/warning.def:37 -#, fuzzy -msgid " -Wno-unfinished do not warn if unfinished features are used" -msgstr "ÇÑÍ×ÁǤ¬»È¤ï¤ì¤Æ¤¤¤ì¤Ð·Ù¹ð¤¹¤ë" - -#: cobc/warning.def:40 -#, fuzzy -msgid " -Wno-pending do not warn if pending features are mentioned" -msgstr "ÇÑÍ×ÁǤ¬»È¤ï¤ì¤Æ¤¤¤ì¤Ð·Ù¹ð¤¹¤ë" - -#: cobc/warning.def:43 -#, fuzzy -msgid " -Wobsolete warn if obsolete features are used" -msgstr "ÇÑÍ×ÁǤ¬»È¤ï¤ì¤Æ¤¤¤ì¤Ð·Ù¹ð¤¹¤ë" - -#: cobc/warning.def:46 -#, fuzzy -msgid " -Warchaic warn if archaic features are used" -msgstr "¸Å¤¤»ÅÍͤ¬»È¤ï¤ì¤Æ¤¤¤ì¤Ð·Ù¹ð¤¹¤ë" - -#: cobc/warning.def:49 -#, fuzzy -msgid " -Wredefinition warn about incompatible redefinition of data items" -msgstr "¥Ç¡¼¥¿¹àÌܤκÆÄêµÁ¤ò·Ù¹ð¤¹¤ë" - -#: cobc/warning.def:52 -msgid " -Wtruncate warn about field truncation from constant assignments" -msgstr "" - -#: cobc/warning.def:55 -msgid " -Wpossible-truncate warn about possible field truncation" -msgstr "" - -#: cobc/warning.def:58 -msgid " -Woverlap warn about overlapping MOVE of items" -msgstr "" - -#: cobc/warning.def:61 -msgid " -Wpossible-overlap warn about MOVE of items that may overlap depending on variables" -msgstr "" - -#: cobc/warning.def:64 -#, fuzzy -msgid " -Wparentheses warn about lack of parentheses around AND within OR" -msgstr "OR ¤È AND ¤¬³ç¸Ì¤Ê¤·¤Çʤó¤Ç¤¤¤ì¤Ð·Ù¹ð¤¹¤ë" - -#: cobc/warning.def:67 -msgid " -Wstrict-typing warn strictly about type mismatch" -msgstr "" - -#: cobc/warning.def:70 -#, fuzzy -msgid " -Wimplicit-define warn about implicitly defined data items" -msgstr "¥Ç¡¼¥¿¹àÌܤκÆÄêµÁ¤ò·Ù¹ð¤¹¤ë" - -#: cobc/warning.def:73 -msgid " -Wcorresponding warn about CORRESPONDING with no matching items" -msgstr "" - -#: cobc/warning.def:76 -#, fuzzy -msgid " -Winitial-value warn if initial VALUE clause is ignored" -msgstr "ÉÔÅö¤Ê VALUE ¶ç¤Ç¤¹" - -#: cobc/warning.def:79 -msgid " -Wprototypes warn about missing FUNCTION prototypes/definitions" -msgstr "" - -#: cobc/warning.def:82 -msgid " -Warithmetic-osvs warn if arithmetic expression precision has changed" -msgstr "" - -#: cobc/warning.def:85 -msgid " -Wcall-params warn about non 01/77 items for CALL parameters" -msgstr "" - -#: cobc/warning.def:88 -msgid " -Wconstant-expression warn about expressions that always resolve to true/false" -msgstr "" - -#: cobc/warning.def:91 -#, fuzzy -msgid " -Wcolumn-overflow warn about text after program-text area, FIXED format" -msgstr "72 ·å¤ò±Û¤¨¤ë¥Æ¥­¥¹¥È¤ò·Ù¹ð¤¹¤ë" - -#: cobc/warning.def:94 -#, fuzzy -msgid " -Wterminator warn about lack of scope terminator END-XXX" -msgstr "½ª»ßÉä(END-XXX)¤¬¤Ê¤±¤ì¤Ð·Ù¹ð¤¹¤ë" - -#: cobc/warning.def:97 -msgid " -Wlinkage warn about dangling LINKAGE items" -msgstr "" - -#: cobc/warning.def:100 -msgid " -Wunreachable warn about likely unreachable statements" -msgstr "" - -#: cobc/warning.def:103 -msgid " -Wno-dialect do not warn about dialect specific issues" -msgstr "" - -#: cobc/warning.def:106 -msgid " -Wothers do not warn about different issues" -msgstr "" - -#: cobc/warning.def:109 -msgid " -Wno-unsupported do not warn if runtime does not support a feature used" -msgstr "" - -#: libcob/call.c:87 -#, c-format -msgid "LoadLibrary/GetProcAddress error %d" -msgstr "" - -#: libcob/call.c:939 -#, fuzzy -msgid "indeterminable error in resolve of COBOL CALL" -msgstr "±Ê³¥Õ¥¡¥¤¥ë¥¨¥é¡¼¤Ç¤¹" - -#: libcob/call.c:1022 -#, fuzzy, c-format -msgid "user-defined FUNCTION '%s' not found" -msgstr "'%s' ¤Î³«»Ï°ÌÃÖ¤¬ÈϰϤòĶ¤¨¤Æ¤¤¤Þ¤¹: %d" - -#: libcob/call.c:1129 libcob/call.c:1208 libcob/call.c:1326 libcob/call.c:1354 -#, c-format -msgid "NULL parameter passed to '%s'" -msgstr "" - -#: libcob/call.c:1204 -#, fuzzy, c-format -msgid "invalid number of arguments passed to '%s'" -msgstr "WHEN ¶ç¤Î°ú¿ô¤Î¿ô¤¬ÉÔÅö¤Ç¤¹" - -#: libcob/call.c:1330 -msgid "multiple call to 'cob_setjmp'" -msgstr "" - -#: libcob/call.c:1358 -msgid "call to 'cob_longjmp' with no prior 'cob_setjmp'" -msgstr "" - -#: libcob/call.c:1592 libcob/call.c:1633 libcob/call.c:1646 -#: libcob/common.c:7081 -#, fuzzy -msgid "cob_init() has not been called" -msgstr "cob_resolve() ¤ÎÁ°¤Ë cob_init() ¤ò¸Æ¤Ð¤Ê¤±¤ì¤Ð¤Ê¤ê¤Þ¤»¤ó" - -#: libcob/call.c:1598 -#, c-format -msgid "parameter %d is not within range of %d" -msgstr "" - -#: libcob/call.c:1604 -#, c-format -msgid "parameter %d is NULL" -msgstr "" - -#: libcob/call.c:1859 libcob/call.c:1916 -#, c-format -msgid "attempt to over-write constant parameter %d with " -msgstr "" - -#: libcob/call.c:1965 -#, c-format -msgid "attempt to over-write constant parameter %d with '%s'" -msgstr "" - -#: libcob/cobgetopt.c:497 -#, c-format -msgid "%s: option '%s' is ambiguous; possibilities:" -msgstr "" - -#: libcob/cobgetopt.c:538 -#, fuzzy, c-format -msgid "%s: option '--%s' doesn't allow an argument" -msgstr "`%s' ¤Ï %d ¤Ä¤Îź»ú¤òɬÍפȤ·¤Þ¤¹" - -#: libcob/cobgetopt.c:545 -#, fuzzy, c-format -msgid "%s: option '%c%s' doesn't allow an argument" -msgstr "`%s' ¤Ï %d ¤Ä¤Îź»ú¤òɬÍפȤ·¤Þ¤¹" - -#: libcob/cobgetopt.c:565 -#, fuzzy, c-format -msgid "%s: option '--%s' requires an argument" -msgstr "`%s' ¤Ï %d ¤Ä¤Îź»ú¤òɬÍפȤ·¤Þ¤¹" - -#: libcob/cobgetopt.c:597 -#, fuzzy, c-format -msgid "%s: unrecognized option '--%s'" -msgstr "ÉÔÅö¤Ê¥ª¥×¥·¥ç¥ó¤Ç¤¹ -std=%s\n" - -#: libcob/cobgetopt.c:604 -#, fuzzy, c-format -msgid "%s: unrecognized option '%c%s'" -msgstr "ÉÔÅö¤Ê¥ª¥×¥·¥ç¥ó¤Ç¤¹ -std=%s\n" - -#: libcob/cobgetopt.c:633 -#, fuzzy, c-format -msgid "%s: invalid option -- %c" -msgstr "ÉÔÅö¤Ê¥ª¥×¥·¥ç¥ó¤Ç¤¹ -std=%s\n" - -#: libcob/cobgetopt.c:664 libcob/cobgetopt.c:805 -#, fuzzy, c-format -msgid "%s: option requires an argument -- %c" -msgstr "`%s' ¤Ï %d ¤Ä¤Îź»ú¤òɬÍפȤ·¤Þ¤¹" - -#: libcob/cobgetopt.c:714 -#, fuzzy, c-format -msgid "%s: option '-W %s' is ambiguous" -msgstr "`%s' ¤Ï %d ¤Ä¤Îź»ú¤òɬÍפȤ·¤Þ¤¹" - -#: libcob/cobgetopt.c:736 -#, fuzzy, c-format -msgid "%s: option '-W %s' doesn't allow an argument" -msgstr "`%s' ¤Ï %d ¤Ä¤Îź»ú¤òɬÍפȤ·¤Þ¤¹" - -#: libcob/cobgetopt.c:754 -#, fuzzy, c-format -msgid "%s: option '%s' requires an argument" -msgstr "`%s' ¤Ï %d ¤Ä¤Îź»ú¤òɬÍפȤ·¤Þ¤¹" - -#: libcob/common.c:793 -#, c-format -msgid "attempt to reference unallocated memory" -msgstr "" - -#: libcob/common.c:798 -#, c-format -msgid "bus error" -msgstr "" - -#: libcob/common.c:803 -#, c-format -msgid "fatal arithmetic error" -msgstr "" - -#: libcob/common.c:807 -#, c-format -msgid "caught signal" -msgstr "" - -#: libcob/common.c:811 -#, c-format -msgid "signal %s" -msgstr "" - -#: libcob/common.c:817 -#, c-format -msgid "abnormal termination - file contents may be incorrect" -msgstr "" - -#: libcob/common.c:2049 -msgid "NULL field" -msgstr "" - -#: libcob/common.c:2059 -msgid "field with NULL address" -msgstr "" - -#: libcob/common.c:2345 -msgid "version mismatch" -msgstr "" - -#: libcob/common.c:2346 libcob/common.c:2348 -#, c-format -msgid "%s has version %s.%d" -msgstr "" - -#: libcob/common.c:2358 -#, fuzzy, c-format -msgid "CALL to %s requires %d arguments" -msgstr "`%s' ¤Ï %d ¤Ä¤Îź»ú¤òɬÍפȤ·¤Þ¤¹" - -#: libcob/common.c:2980 -#, c-format -msgid "BASED/LINKAGE item %s has NULL address" -msgstr "" - -#: libcob/common.c:2992 libcob/common.c:2995 -#, c-format -msgid "LINKAGE item %s not passed by caller" -msgstr "" - -#: libcob/common.c:3081 -#, fuzzy, c-format -msgid "'%s' (Type: %s) not numeric: '%s'" -msgstr "`%s' ¤Ï¿ô»ú¤Ç¤Ï¤¢¤ê¤Þ¤»¤ó: `%s'" - -#: libcob/common.c:3096 -#, fuzzy, c-format -msgid "OCCURS DEPENDING ON '%s' out of bounds: %d" -msgstr "OCCURS DEPENDING ON `%s' ¤¬ÈϰϤò±Û¤¨¤Æ¤¤¤Þ¤¹: %d" - -#: libcob/common.c:3099 libcob/common.c:3120 -#, fuzzy, c-format -msgid "maximum subscript for '%s': %d" -msgstr "'%s' ¤Îź»ú¤¬ÈϰϤòĶ¤¨¤Æ¤¤¤Þ¤¹: %d" - -#: libcob/common.c:3101 -#, fuzzy, c-format -msgid "minimum subscript for '%s': %d" -msgstr "'%s' ¤Îź»ú¤¬ÈϰϤòĶ¤¨¤Æ¤¤¤Þ¤¹: %d" - -#: libcob/common.c:3117 -#, c-format -msgid "current maximum subscript for '%s': %d" -msgstr "" - -#: libcob/common.c:3139 -#, fuzzy, c-format -msgid "offset of '%s' out of bounds: %d, maximum: %d" -msgstr "'%s' ¤Î³«»Ï°ÌÃÖ¤¬ÈϰϤòĶ¤¨¤Æ¤¤¤Þ¤¹: %d" - -#: libcob/common.c:3152 -#, fuzzy, c-format -msgid "length of '%s' out of bounds: %d, maximum: %d" -msgstr "'%s' ¤ÎŤµ¤¬ÈϰϤòĶ¤¨¤Æ¤¤¤Þ¤¹: %d" - -#: libcob/common.c:3161 -#, fuzzy, c-format -msgid "length of '%s' out of bounds: %d, starting at: %d, maximum: %d" -msgstr "'%s' ¤ÎŤµ¤¬ÈϰϤòĶ¤¨¤Æ¤¤¤Þ¤¹: %d" - -#: libcob/common.c:3176 libcob/common.c:3181 -#, c-format -msgid "EXTERNAL item '%s' previously allocated with size %d, requested size is %d" -msgstr "" - -#: libcob/common.c:3682 -#, fuzzy, c-format -msgid "COB_CURRENT_DATE '%s' is invalid" -msgstr "`%s' ¤Ï½¤¾þ½ÐÍè¤Þ¤»¤ó" - -#: libcob/common.c:4585 -#, c-format -msgid "parameter to SYSTEM call is larger than %d characters" -msgstr "" - -#: libcob/common.c:5195 -#, c-format -msgid "error '%s' during CBL_GC_FORK" -msgstr "" - -#: libcob/common.c:5200 libcob/common.c:5297 -#, fuzzy, c-format -msgid "'%s' is not supported on this platform" -msgstr "`%s' ¤Ï¼ÂÁõ¤µ¤ì¤Æ¤¤¤Þ¤»¤ó" - -#: libcob/common.c:5226 -#, c-format -msgid "error '%s' for P%d during CBL_GC_WAITPID" -msgstr "" - -#: libcob/common.c:5418 -msgid "Call to CBL_GC_GETOPT with wrong longoption size." -msgstr "" - -#: libcob/common.c:5423 -msgid "Call to CBL_GC_GETOPT with missing longind." -msgstr "" - -#: libcob/common.c:5837 libcob/common.c:5858 libcob/common.c:5871 -#: libcob/common.c:7785 -#, c-format -msgid "(default)" -msgstr "" - -#: libcob/common.c:6119 libcob/common.c:6138 -msgid "should be unsigned" -msgstr "" - -#: libcob/common.c:6127 libcob/common.c:6176 -msgid "should be numeric" -msgstr "" - -#: libcob/common.c:6185 -#, c-format -msgid "minimum value: %lu" -msgstr "" - -#: libcob/common.c:6236 libcob/common.c:6787 libcob/common.c:6801 -#, c-format -msgid "should not contain '%c'" -msgstr "" - -#: libcob/common.c:6316 libcob/common.c:6384 libcob/common.c:6393 -#: libcob/common.c:6401 -#, c-format -msgid "not set" -msgstr "" - -#: libcob/common.c:6376 libcob/common.c:6379 libcob/common.c:6382 -#, c-format -msgid "set by %s" -msgstr "" - -#: libcob/common.c:6516 -#, c-format -msgid "WARNING - '%s' without a value - ignored!" -msgstr "" - -#: libcob/common.c:6519 -#, fuzzy, c-format -msgid "'%s' without a value!" -msgstr "`%s' ¤Ï¿ôÃͤǤϤ¢¤ê¤Þ¤»¤ó" - -#: libcob/common.c:6545 -#, c-format -msgid "WARNING - '%s %s' without a value - ignored!" -msgstr "" - -#: libcob/common.c:7034 -msgid "error" -msgstr "" - -#: libcob/common.c:7064 -msgid "attempt to CANCEL active program" -msgstr "" - -#: libcob/common.c:7091 -msgid "CALL of program with CHAINING clause" -msgstr "" - -#: libcob/common.c:7095 -msgid "stack overflow, possible PERFORM depth exceeded" -msgstr "" - -#: libcob/common.c:7100 -msgid "invalid entry/exit in GLOBAL USE procedure" -msgstr "" - -#: libcob/common.c:7105 -msgid "unable to allocate memory" -msgstr "" - -#: libcob/common.c:7110 -#, fuzzy -msgid "invalid entry into module" -msgstr "ÉÔÅö¤Ê VALUE ¶ç¤Ç¤¹" - -#: libcob/common.c:7115 -#, c-format -msgid "recursive CALL from %s to %s which is NOT RECURSIVE" -msgstr "" - -#: libcob/common.c:7125 -#, fuzzy -msgid "divide by ZERO" -msgstr "ÉÔÅö¤Ê¿ô»úÄê¿ô¤Ç¤¹" - -#: libcob/common.c:7132 -#, fuzzy -msgid "end of file" -msgstr "¥Õ¥¡¥¤¥ë¤Î½ª¤ï¤ê¤Ç¤¹" - -#: libcob/common.c:7135 -#, fuzzy -msgid "key out of range" -msgstr "¥­¡¼¤ÎÈϰϤ¬ÉÔÅö¤Ç¤¹" - -#: libcob/common.c:7138 -#, fuzzy -msgid "key order not ascending" -msgstr "¥­¡¼¤¬¾º½ç¤Ç¤Ï¤¢¤ê¤Þ¤»¤ó" - -#: libcob/common.c:7141 -#, fuzzy -msgid "record key already exists" -msgstr "¥ì¥³¡¼¥É¥­¡¼¤¬´û¤Ë¸ºß¤·¤Þ¤¹" - -#: libcob/common.c:7144 -#, fuzzy -msgid "record key does not exist" -msgstr "¥ì¥³¡¼¥É¥­¡¼¤¬Â¸ºß¤·¤Þ¤»¤ó" - -#: libcob/common.c:7147 -#, fuzzy -msgid "permanent file error" -msgstr "±Ê³¥Õ¥¡¥¤¥ë¥¨¥é¡¼¤Ç¤¹" - -#: libcob/common.c:7150 -#, fuzzy -msgid "inconsistant file name" -msgstr "ÉÔÅö¤Ê¹ÔÏ¢·ë¤Ç¤¹" - -#: libcob/common.c:7153 -#, fuzzy -msgid "file does not exist" -msgstr "¥Õ¥¡¥¤¥ë¤¬Â¸ºß¤·¤Þ¤»¤ó" - -#: libcob/common.c:7156 -#, fuzzy -msgid "permission denied" -msgstr "ÍøÍѵö²Ä¤¬¤¢¤ê¤Þ¤»¤ó" - -#: libcob/common.c:7159 -#, fuzzy -msgid "file already open" -msgstr "¥Õ¥¡¥¤¥ë¤Ï´û¤Ë³«¤¤¤Æ¤¤¤Þ¤¹" - -#: libcob/common.c:7162 -#, fuzzy -msgid "file not open" -msgstr "¥Õ¥¡¥¤¥ë¤¬³«¤¤¤Æ¤¤¤Þ¤»¤ó" - -#: libcob/common.c:7165 -msgid "READ must be executed first" -msgstr "READ ¤òÀè¤Ë¼Â¹Ô¤·¤Ê¤±¤ì¤Ð¤Ê¤ê¤Þ¤»¤ó" - -#: libcob/common.c:7168 -#, fuzzy -msgid "record overflow" -msgstr "¥ì¥³¡¼¥É¤ÎÎΰè¤òĶ¤¨¤Æ¤¤¤Þ¤¹" - -#: libcob/common.c:7171 -msgid "READ after unsuccessful READ/START" -msgstr "" - -#: libcob/common.c:7174 -#, fuzzy -msgid "READ/START not allowed, file not open for input" -msgstr "READ¡¢START ¤Ïµö²Ä¤µ¤ì¤Þ¤»¤ó" - -#: libcob/common.c:7177 -msgid "WRITE not allowed, file not open for output" -msgstr "" - -#: libcob/common.c:7180 -#, fuzzy -msgid "DELETE/REWRITE not allowed, file not open for I-O" -msgstr "DELETE¡¢REWRITE ¤Ïµö²Ä¤µ¤ì¤Þ¤»¤ó" - -#: libcob/common.c:7183 -msgid "record locked by another file connector" -msgstr "" - -#: libcob/common.c:7186 -#, fuzzy -msgid "LINAGE values invalid" -msgstr "`%s' ¤Ï½¤¾þ½ÐÍè¤Þ¤»¤ó" - -#: libcob/common.c:7189 -msgid "file sharing conflict" -msgstr "" - -#: libcob/common.c:7193 -msgid "runtime library is not configured for this operation" -msgstr "" - -#: libcob/common.c:7198 -#, fuzzy -msgid "unknown file error" -msgstr "¸¶°øÉÔÌÀ¤Î¥Õ¥¡¥¤¥ë¥¨¥é¡¼¤Ç¤¹" - -#: libcob/common.c:7205 -#, fuzzy, c-format -msgid "%s (status = %02d) for file %s" -msgstr "%s ¶ç¤¬¥Õ¥¡¥¤¥ë `%s' ¤ËɬÍפǤ¹" - -#: libcob/common.c:7208 -#, fuzzy, c-format -msgid "%s (status = %02d) for file %s on %s" -msgstr "%s ¶ç¤¬¥Õ¥¡¥¤¥ë `%s' ¤ËɬÍפǤ¹" - -#: libcob/common.c:7215 -msgid "attempt to use non-implemented function" -msgstr "" - -#: libcob/common.c:7218 -msgid "attempt to use non-implemented XML I/O" -msgstr "" - -#: libcob/common.c:7221 -msgid "attempt to use non-implemented JSON I/O" -msgstr "" - -#: libcob/common.c:7268 -msgid "environment variables" -msgstr "" - -#: libcob/common.c:7315 -msgid "License LGPLv3+: GNU LGPL version 3 or later " -msgstr "" - -#: libcob/common.c:7372 libcob/common.c:7374 -msgid "dynamic loading" -msgstr "" - -#: libcob/common.c:7379 -msgid "enabled" -msgstr "" - -#: libcob/common.c:7460 libcob/common.c:7577 libcob/common.c:7586 -#: libcob/common.c:7603 libcob/common.c:7618 -#, c-format -msgid "%s, version %d.%d.%d" -msgstr "" - -#: libcob/common.c:7462 libcob/common.c:7579 libcob/common.c:7588 -#: libcob/common.c:7620 -#, c-format -msgid "%s, version %d.%d.%d (compiled with %d.%d)" -msgstr "" - -#: libcob/common.c:7465 -#, c-format -msgid "%s, version %s" -msgstr "" - -#: libcob/common.c:7486 libcob/common.c:7488 libcob/common.c:7493 -#: libcob/common.c:7495 libcob/common.c:7498 -msgid "mouse support" -msgstr "" - -#: libcob/common.c:7636 -msgid "CALL configuration" -msgstr "" - -#: libcob/common.c:7637 -#, fuzzy -msgid "File I/O configuration" -msgstr "ÉÔÅö¤Ê¹ÔÏ¢·ë¤Ç¤¹" - -#: libcob/common.c:7638 -msgid "Screen I/O configuration" -msgstr "" - -#: libcob/common.c:7639 -msgid "Miscellaneous" -msgstr "" - -#: libcob/common.c:7640 -msgid "System configuration" -msgstr "" - -#: libcob/common.c:7644 -#, fuzzy -msgid "runtime configuration" -msgstr "ÉÔÅö¤Ê¹ÔÏ¢·ë¤Ç¤¹" - -#: libcob/common.c:7646 -msgid "via" -msgstr "" - -#: libcob/common.c:7719 libcob/common.c:7747 -msgid "... removed from environment" -msgstr "" - -#: libcob/common.c:7773 libcob/common.c:7775 -#, c-format -msgid "(set by %s)" -msgstr "" - -#: libcob/common.c:7783 -#, c-format -msgid "(reset)" -msgstr "" - -#: libcob/common.c:8167 libcob/common.c:8286 -#, c-format -msgid "%s called with unknown option: %d" -msgstr "" - -#: libcob/common.c:8239 -#, c-format -msgid "Module dump due to %s\n" -msgstr "" - -#: libcob/common.c:8243 -#, fuzzy, c-format -msgid " Last statement of %s was Line %d of %s\n" -msgstr "%s ʸ¤¬ END-%s ¤Ç½ª¤ï¤Ã¤Æ¤¤¤Þ¤»¤ó" - -#: libcob/common.c:8249 -#, c-format -msgid " Last statement of %s unknown\n" -msgstr "" - -#: libcob/common.c:8259 -#, c-format -msgid "Dump Program-Id %s from %s compiled %s\n" -msgstr "" - -#: libcob/fileio.c:287 -#, c-format -msgid "ERROR I/O routine %s is not present" -msgstr "" - -#: libcob/fileio.c:1365 -#, c-format -msgid "I/O routine %s is not present for %s" -msgstr "" - -#: libcob/fileio.c:1404 -#, c-format -msgid "I/O routine %s is not known for %s" -msgstr "" - -#: libcob/fileio.c:2599 -#, c-format -msgid "ERROR FILE %s has record size %d exceeds %d in program" -msgstr "" - -#: libcob/fileio.c:2967 libcob/fileio.c:2974 -#, c-format -msgid "ERROR FILE %s opening pipe" -msgstr "" - -#: libcob/fileio.c:4979 -#, c-format -msgid "ERROR FILE %s does not match current version; Recompile the program" -msgstr "" - -#: libcob/fileio.c:5034 -#, c-format -msgid "ERROR FILE %s has ASSIGN field is NULL" -msgstr "" - -#: libcob/fileio.c:5707 -#, c-format -msgid "call to CBL_OPEN_FILE with wrong access mode: %d" -msgstr "" - -#: libcob/fileio.c:5756 -#, c-format -msgid "call to CBL_CREATE_FILE with wrong file_lock: %d" -msgstr "" - -#: libcob/fileio.c:5759 -#, c-format -msgid "call to CBL_CREATE_FILE with wrong file_dev: %d" -msgstr "" - -#: libcob/fileio.c:5955 libcob/fileio.c:6215 -#, c-format -msgid "'%s' - File detail area is too short" -msgstr "" - -#: libcob/fileio.c:6437 -msgid "SORT is unable to acquire temporary file" -msgstr "" - -#: libcob/fileio.c:7057 -#, c-format -msgid "implicit CLOSE of %s" -msgstr "" - -#: libcob/fileio.c:7165 -#, c-format -msgid "C-ISAM library %s is not present" -msgstr "" - -#: libcob/fileio.c:7173 -#, c-format -msgid "D-ISAM library %s is not present" -msgstr "" - -#: libcob/fileio.c:7181 -#, c-format -msgid "VB-ISAM library %s is not present" -msgstr "" - -#: libcob/screenio.c:429 -msgid "failed to initialize curses" -msgstr "" - -#: libcob/screenio.c:3591 -msgid "end of program, please press a key to exit" -msgstr "" - -#: libcob/termio.c:70 libcob/termio.c:106 -msgid "(Not representable)" -msgstr "" - -#: libcob/termio.c:347 -#, c-format -msgid "cannot open %s (=%s)" -msgstr "" - -#: libcob/termio.c:362 -msgid "COB_DISPLAY_PUNCH_FILE is invalid, output to SYSPUNCH skipped" -msgstr "" - -#: bin/cobcrun.c:122 -msgid "GnuCOBOL module loader" -msgstr "" - -#: bin/cobcrun.c:124 -#, c-format -msgid "Usage: %s [options] PROGRAM [parameter ...]" -msgstr "" - -#: bin/cobcrun.c:126 -#, c-format -msgid " or: %s options" -msgstr "" - -#: bin/cobcrun.c:129 -msgid "Options:" -msgstr "" - -#: bin/cobcrun.c:130 -msgid " -h, -help display this help and exit" -msgstr "" - -#: bin/cobcrun.c:131 -msgid " -V, -version display cobcrun and runtime version and exit" -msgstr "" - -#: bin/cobcrun.c:132 -msgid " -i, -info display runtime information (build/environment)" -msgstr "" - -#: bin/cobcrun.c:134 -msgid " -q, -brief reduced displays" -msgstr "" - -#: bin/cobcrun.c:136 -msgid " -c , -config= set runtime configuration from " -msgstr "" - -#: bin/cobcrun.c:137 -msgid "" -" -r, -runtime-config display current runtime configuration\n" -" (value and origin for all settings)" -msgstr "" - -#: bin/cobcrun.c:139 -msgid "" -" -M , -module= set entry point module name and/or load path\n" -" where -M module prepends any directory to the\n" -" dynamic link loader library search path\n" -" and any basename to the module preload list\n" -" (COB_LIBRARY_PATH and/or COB_PRELOAD)" -msgstr "" - -#: bin/cobcrun.c:145 -#, c-format -msgid "" -"Report bugs to: %s\n" -"or (preferably) use the issue tracker via the home page." -msgstr "" - -#: bin/cobcrun.c:148 -msgid "GnuCOBOL home page: " -msgstr "" - -#: bin/cobcrun.c:149 -msgid "General help using GNU software: " -msgstr "" - -#: bin/cobcrun.c:274 -#, fuzzy -msgid "invalid configuration file name" -msgstr "ÉÔÅö¤Ê¹ÔÏ¢·ë¤Ç¤¹" - -#: bin/cobcrun.c:325 -#, fuzzy, c-format -msgid "invalid module argument '%s'" -msgstr "ÉÔÅö¤ÊÆþÎÏ¥¹¥È¥ê¡¼¥à¤Ç¤¹" - -#: bin/cobcrun.c:377 -#, c-format -msgid "%s: missing PROGRAM name" -msgstr "" - -#: bin/cobcrun.c:379 -#, c-format -msgid "Try '%s --help' for more information." -msgstr "" - -#: bin/cobcrun.c:387 -#, fuzzy, c-format -msgid "%s: PROGRAM name exceeds %d characters" -msgstr "¥ì¥³¡¼¥ÉŤ¬Ã»¤«²á¤®¤Þ¤¹ `%s'" - -#, fuzzy -#~ msgid "%s: %d: invalid cast from '%s' type %s to type %s" -#~ msgstr "%s: Àá `%s':\n" - -#, fuzzy -#~ msgid "unknown name error '%s'%s" -#~ msgstr "¸¶°øÉÔÌÀ¤Î¥Õ¥¡¥¤¥ë¥¨¥é¡¼¤Ç¤¹" - -#, fuzzy -#~ msgid " -list-intrinsics display intrinsic functions" -#~ msgstr "`%s' ¤ÏÀ°¿ô¤Ç¤Ï¤¢¤ê¤Þ¤»¤ó" - -#, fuzzy -#~ msgid "invalid parameter -std=%s" -#~ msgstr "ÉÔÅö¤Ê MOVE ʸ¤Ç¤¹" - -#, fuzzy -#~ msgid "invalid option detected" -#~ msgstr "ÉÔÅö¤Ê¥ª¥×¥·¥ç¥ó¤Ç¤¹ -std=%s\n" - -#, fuzzy -#~ msgid "Invalid type for '%s'" -#~ msgstr "%s: Àá `%s':\n" - -#, fuzzy -#~ msgid "invalid type for '%s'" -#~ msgstr "%s: Àá `%s':\n" - -#, fuzzy -#~ msgid "constant item '%s' cannot have a %s clause" -#~ msgstr "¥°¥ë¡¼¥×¹àÌÜ `%s' ¤Ï %s ¶ç¤ò»ý¤Ä¤³¤È¤¬½ÐÍè¤Þ¤»¤ó" - -#, fuzzy -#~ msgid "88-level cannot be used here" -#~ msgstr "`%s' ¤Ïź»úÉÕ¤±½ÐÍè¤Þ¤»¤ó" - -#, fuzzy -#~ msgid "REDEFINES clause should follow entry-name" -#~ msgstr "REDEFINES ¶ç¤Ï¹àÌÜ̾¤Îľ¸å¤Ë¤Ê¤±¤ì¤Ð¤Ê¤ê¤Þ¤»¤ó" - -#, fuzzy -#~ msgid "ANY LENGTH items may only be BY REFERENCE formal parameters" -#~ msgstr "`%s' ¤Ï½¤¾þ½ÐÍè¤Þ¤»¤ó" - -#, fuzzy -#~ msgid "%s is not implemented" -#~ msgstr "`%s' ¤Ï¼ÂÁõ¤µ¤ì¤Æ¤¤¤Þ¤»¤ó" - -#, fuzzy -#~ msgid "invalid target for DEBUGGING ALL" -#~ msgstr "ÉÔÅö¤Ê¹ÔÏ¢·ë¤Ç¤¹" - -#, fuzzy -#~ msgid "non-negative integer value expected" -#~ msgstr "¿ôÃͤ¬É¬ÍפǤ¹" - -#, fuzzy -#~ msgid "invalid literal cast" -#~ msgstr "ÉÔÅö¤Ê H Äê¿ô¤Ç¤¹: %s" - -#, fuzzy -#~ msgid "invalid use of 88 level item" -#~ msgstr "ÉÔÅö¤Ê¼°¤Ç¤¹" - -#, fuzzy -#~ msgid "invalid use of HANDLE item" -#~ msgstr "ÉÔÅö¤Ê¼°¤Ç¤¹" - -#, fuzzy -#~ msgid "Variable length item not allowed here" -#~ msgstr "`%s' ¤Ï½¤¾þ½ÐÍè¤Þ¤»¤ó" - -#, fuzzy -#~ msgid "warn type mismatch strictly" -#~ msgstr "¥¿¥¤¥×¤ÎÉÔŬ¹ç¤ò¸·Ì©¤Ë·Ù¹ð¤¹¤ë" - -#, fuzzy -#~ msgid "warn unreachable statements" -#~ msgstr "ÉÔÅö¤Ê MOVE ʸ¤Ç¤¹" - -#, fuzzy -#~ msgid "cannot find module" -#~ msgstr "¥â¥¸¥å¡¼¥ë¤¬¸«ÉÕ¤«¤ê¤Þ¤»¤ó `%s'" - -#, fuzzy -#~ msgid "cannot find entry point" -#~ msgstr "¥â¥¸¥å¡¼¥ë¤¬¸«ÉÕ¤«¤ê¤Þ¤»¤ó `%s'" - -#, fuzzy -#~ msgid "invalid option -std=%s" -#~ msgstr "ÉÔÅö¤Ê¥ª¥×¥·¥ç¥ó¤Ç¤¹ -std=%s\n" - -#, fuzzy -#~ msgid "unexpected constant" -#~ msgstr "ÉÔÅö¤Ê¿ô»úÄê¿ô¤Ç¤¹" - -#, fuzzy -#~ msgid "'%s' cannot be set via command line" -#~ msgstr "`%s' ¤Ï²ÄÊÑĹ¤Ë½ÐÍè¤Þ¤»¤ó" - -#, fuzzy -#~ msgid "entries under REDEFINES cannot have a VALUE clause" -#~ msgstr "REDEFINES ¤Ë´Þ¤Þ¤ì¤ë¹àÌÜ¤Ï VALUE ¶ç¤ò»ý¤Ä¤³¤È¤¬½ÐÍè¤Þ¤»¤ó" - -#, fuzzy -#~ msgid "unexpected usage %d" -#~ msgstr "ÉÔÅö¤Ê¿ô»úÄê¿ô¤Ç¤¹" - -#, fuzzy -#~ msgid "unexpected tallying phrase" -#~ msgstr "ÉÔÅö¤Ê¿ô»úÄê¿ô¤Ç¤¹" - -#, fuzzy -#~ msgid "duplicate define" -#~ msgstr "ÉÔÅö¤Ê¥ì¥Ù¥ëÈÖ¹æ¤Ç¤¹ `%s'" - -#, fuzzy -#~ msgid "the targets of SET must be either indexes or pointers" -#~ msgstr "SET ½ÐÍè¤ë¤Î¤Ï INDEXED ¤« POINTER ¤À¤±¤Ç¤¹" - -#, fuzzy -#~ msgid "the address of '%s' cannot be changed" -#~ msgstr "`%s' ¤Î¥¢¥É¥ì¥¹¤ÏÊѹ¹¤Ç¤­¤Þ¤»¤ó" - -#, fuzzy -#~ msgid "warn inconsistent constant" -#~ msgstr "ÉÔŬÀÚ¤ÊÄê¿ô¤ò·Ù¹ð¤¹¤ë" - -#, fuzzy -#~ msgid "invalid currency sign '%s'" -#~ msgstr "ÉÔÅö¤ÊÄ̲ߵ­¹æ¤Ç¤¹ `%s'" - -#, fuzzy -#~ msgid "invalid output device" -#~ msgstr "ÉÔÅö¤ÊÆþÎÏ¥¹¥È¥ê¡¼¥à¤Ç¤¹" - -#, fuzzy -#~ msgid "Level number of REDEFINES entry cannot be 66 or 88" -#~ msgstr "REDEFINES ¶ç¤Î¹àÌܤϥì¥Ù¥ëÈÖ¹æ 66 ¤Þ¤¿¤Ï 88 ¤Ç¤¢¤Ã¤Æ¤Ï¤Ê¤ê¤Þ¤»¤ó" - -#, fuzzy -#~ msgid "Invalid special names clause" -#~ msgstr "ÉÔÅö¤Ê VALUE ¶ç¤Ç¤¹" - -#, fuzzy -#~ msgid "Invalid SYMBOLIC clause" -#~ msgstr "ÉÔÅö¤Ê VALUE ¶ç¤Ç¤¹" - -#, fuzzy -#~ msgid "Alphabet-name is expected '%s'" -#~ msgstr "¥¢¥ë¥Õ¥¡¥Ù¥Ã¥È̾¤¬É¬ÍפǤ¹ `%s'" - -#, fuzzy -#~ msgid "Invalid PAGE clause" -#~ msgstr "ÉÔÅö¤Ê VALUE ¶ç¤Ç¤¹" - -#, fuzzy -#~ msgid "Invalid SYMBOLIC integer" -#~ msgstr "ÉÔÅö¤Ê VALUE ¶ç¤Ç¤¹" - -#, fuzzy -#~ msgid "" -#~ msgstr "ÉÔÅö¤Ê¿ô»úÄê¿ô¤Ç¤¹" - -#, fuzzy -#~ msgid "Unexpected cast type -> %d" -#~ msgstr "ÉÔÅö¤Ê¿ô»úÄê¿ô¤Ç¤¹" - -#, fuzzy -#~ msgid "Invalid literal cast - Aborting" -#~ msgstr "ÃͤÎÂ礭¤µ¤¬¹àÌܤÎÂ礭¤µ¤ò±Û¤¨¤Æ¤¤¤Þ¤¹" - -#, fuzzy -#~ msgid "Invalid picture string - '%s'" -#~ msgstr "ÉÔÅö¤Ê PICTURE ÄêµÁ¤Ç¤¹" - -#, fuzzy -#~ msgid "Record size too small '%s' (%d)" -#~ msgstr "¥ì¥³¡¼¥ÉŤ¬Ã»¤«²á¤®¤Þ¤¹ `%s'" - -#, fuzzy -#~ msgid "Record size too large '%s' (%d)" -#~ msgstr "¥ì¥³¡¼¥ÉŤ¬Ä¹²á¤®¤Þ¤¹ `%s'" - -#, fuzzy -#~ msgid "Invalid value in AT clause" -#~ msgstr "ÉÔÅö¤Ê VALUE ¶ç¤Ç¤¹" - -#, fuzzy -#~ msgid "Data name expected before CHARACTERS" -#~ msgstr "CHARACTERS ¤ÎÁ°¤Ë¥Ç¡¼¥¿Ì¾¤¬É¬ÍפǤ¹" - -#, fuzzy -#~ msgid "Data name expected before LEADING" -#~ msgstr "LEADING ¤ÎÁ°¤Ë¥Ç¡¼¥¿Ì¾¤¬É¬ÍפǤ¹<" - -#, fuzzy -#~ msgid "Data name expected before TRAILING" -#~ msgstr "LEADING ¤ÎÁ°¤Ë¥Ç¡¼¥¿Ì¾¤¬É¬ÍפǤ¹<" - -#, fuzzy -#~ msgid "Invalid VALUE clause - literal exceeds data size" -#~ msgstr "ÃͤÎÂ礭¤µ¤¬¹àÌܤÎÂ礭¤µ¤ò±Û¤¨¤Æ¤¤¤Þ¤¹" - -#, fuzzy -#~ msgid "Failed to READ" -#~ msgstr "Æɤ߹þ¤ß¤Ë¼ºÇÔ¤·¤Þ¤·¤¿" - -#~ msgid "WRITE not allowed" -#~ msgstr "WRITE ¤Ïµö²Ä¤µ¤ì¤Þ¤»¤ó" - -#, fuzzy -#~ msgid "Invalid tab-width value - %d" -#~ msgstr "ÉÔÅö¤Ê¹ÔÏ¢·ë¤Ç¤¹" - -#, fuzzy -#~ msgid "Invalid continuation: no literal/word needs to be continued" -#~ msgstr "ÉÔÅö¤Ê¹ÔÏ¢·ë¤Ç¤¹" - -#, fuzzy -#~ msgid "%s: option `%s' requires an argument" -#~ msgstr "`%s' ¤Ï %d ¤Ä¤Îź»ú¤òɬÍפȤ·¤Þ¤¹" - -#, fuzzy -#~ msgid "Numeric literal exceeds limit - Aborting" -#~ msgstr "ÃͤÎÂ礭¤µ¤¬¹àÌܤÎÂ礭¤µ¤ò±Û¤¨¤Æ¤¤¤Þ¤¹" - -#, fuzzy -#~ msgid "'%s' defined here as USAGE FLOAT" -#~ msgstr "`%s' ¤Ï¤³¤³¤Ç PIC %s ¤È¤·¤ÆÄêµÁ¤µ¤ì¤Þ¤·¤¿" - -#, fuzzy -#~ msgid "'%s' defined here as USAGE DOUBLE" -#~ msgstr "`%s' ¤Ï¤³¤³¤Ç PIC %s ¤È¤·¤ÆÄêµÁ¤µ¤ì¤Þ¤·¤¿" - -#, fuzzy -#~ msgid "'%s' defined here as USAGE FLOAT EXTENDED" -#~ msgstr "`%s' ¤Ï¤³¤³¤Ç PIC %s ¤È¤·¤ÆÄêµÁ¤µ¤ì¤Þ¤·¤¿" - -#, fuzzy -#~ msgid "'%s' defined here as USAGE FLOAT-BINARY-7" -#~ msgstr "`%s' ¤Ï¤³¤³¤Ç PIC %s ¤È¤·¤ÆÄêµÁ¤µ¤ì¤Þ¤·¤¿" - -#, fuzzy -#~ msgid "'%s' defined here as USAGE FLOAT-BINARY-16" -#~ msgstr "`%s' ¤Ï¤³¤³¤Ç PIC %s ¤È¤·¤ÆÄêµÁ¤µ¤ì¤Þ¤·¤¿" - -#, fuzzy -#~ msgid "'%s' defined here as USAGE FLOAT-BINARY-34" -#~ msgstr "`%s' ¤Ï¤³¤³¤Ç PIC %s ¤È¤·¤ÆÄêµÁ¤µ¤ì¤Þ¤·¤¿" - -#, fuzzy -#~ msgid "'%s' defined here as USAGE FLOAT-DECIMAL-16" -#~ msgstr "`%s' ¤Ï¤³¤³¤Ç PIC %s ¤È¤·¤ÆÄêµÁ¤µ¤ì¤Þ¤·¤¿" - -#, fuzzy -#~ msgid "'%s' defined here as USAGE FLOAT-DECIMAL-34" -#~ msgstr "`%s' ¤Ï¤³¤³¤Ç PIC %s ¤È¤·¤ÆÄêµÁ¤µ¤ì¤Þ¤·¤¿" - -#, fuzzy -#~ msgid "Invalid SOURCEFORMAT directive" -#~ msgstr "ÉÔÅö¤Ê VALUE ¶ç¤Ç¤¹" - -#, fuzzy -#~ msgid "Invalid IF/ELIF directive" -#~ msgstr "ÉÔÅö¤Ê VALUE ¶ç¤Ç¤¹" - -#, fuzzy -#~ msgid "Invalid line" -#~ msgstr "ÉÔÅö¤Ê VALUE ¶ç¤Ç¤¹" - -#, fuzzy -#~ msgid "ALTERNATE clause invalid for this file type" -#~ msgstr "`%s' ¤Ï½¤¾þ½ÐÍè¤Þ¤»¤ó" - -#, fuzzy -#~ msgid "ORGANIZATION clause invalid" -#~ msgstr "`%s' ¤Ï½¤¾þ½ÐÍè¤Þ¤»¤ó" - -#, fuzzy -#~ msgid "Invalid target for INSPECT" -#~ msgstr "ÉÔÅö¤Ê¹ÔÏ¢·ë¤Ç¤¹" - -#, fuzzy -#~ msgid "FUNCTION-ID is not yet implemented" -#~ msgstr "`%s' ¤Ï¼ÂÁõ¤µ¤ì¤Æ¤¤¤Þ¤»¤ó" - -#, fuzzy -#~ msgid "REPORT WRITER not implemented" -#~ msgstr "`%s' ¤Ï¼ÂÁõ¤µ¤ì¤Æ¤¤¤Þ¤»¤ó" - -#, fuzzy -#~ msgid "EXTERNAL not allowed here" -#~ msgstr "`%s' ¤Ï½¤¾þ½ÐÍè¤Þ¤»¤ó" - -#, fuzzy -#~ msgid "EXTERNAL only allowed at 01/77 level" -#~ msgstr "`%s' ¤Ï½¤¾þ½ÐÍè¤Þ¤»¤ó" - -#, fuzzy -#~ msgid "GLOBAL only allowed at 01/77 level" -#~ msgstr "`%s' ¤Ï½¤¾þ½ÐÍè¤Þ¤»¤ó" - -#, fuzzy -#~ msgid "GLOBAL not allowed here" -#~ msgstr "`%s' ¤Ï½¤¾þ½ÐÍè¤Þ¤»¤ó" - -#, fuzzy -#~ msgid "REPORT SECTION not implemented" -#~ msgstr "`%s' ¤Ï¼ÂÁõ¤µ¤ì¤Æ¤¤¤Þ¤»¤ó" - -#, fuzzy -#~ msgid "Invalid option" -#~ msgstr "ÉÔÅö¤Ê¥ª¥×¥·¥ç¥ó¤Ç¤¹ -std=%s\n" - -#, fuzzy -#~ msgid "Invalid directive comparison" -#~ msgstr "ÉÔÅö¤Ê PICTURE ÄêµÁ¤Ç¤¹" - -#, fuzzy -#~ msgid "'%s' defined here as USAGE FLOAT-DECIMAL-7" -#~ msgstr "`%s' ¤Ï¤³¤³¤Ç PIC %s ¤È¤·¤ÆÄêµÁ¤µ¤ì¤Þ¤·¤¿" - -#, fuzzy -#~ msgid "Invalid -MT parameter\n" -#~ msgstr "ÉÔÅö¤Ê MOVE ʸ¤Ç¤¹" - -#, fuzzy -#~ msgid "Invalid -MF parameter\n" -#~ msgstr "ÉÔÅö¤Ê MOVE ʸ¤Ç¤¹" - -#~ msgid "-MT must be given to specify target file\n" -#~ msgstr "¥¿¡¼¥²¥Ã¥È¥Õ¥¡¥¤¥ë¤ò -MT ¤Ç»ØÄꤷ¤Æ²¼¤µ¤¤\n" - -#, fuzzy -#~ msgid "Unexepected tree tag %d" -#~ msgstr "ÉÔÅö¤Ê¿ô»úÄê¿ô¤Ç¤¹" - -#, fuzzy -#~ msgid "Invalid -conf parameter\n" -#~ msgstr "ÉÔÅö¤Ê MOVE ʸ¤Ç¤¹" - -#, fuzzy -#~ msgid "Invalid -I parameter\n" -#~ msgstr "ÉÔÅö¤Ê MOVE ʸ¤Ç¤¹" - -#, fuzzy -#~ msgid "Invalid -L parameter\n" -#~ msgstr "ÉÔÅö¤Ê MOVE ʸ¤Ç¤¹" - -#, fuzzy -#~ msgid "Invalid -l parameter\n" -#~ msgstr "ÉÔÅö¤Ê MOVE ʸ¤Ç¤¹" - -#, fuzzy -#~ msgid "Invalid --ext parameter\n" -#~ msgstr "ÉÔÅö¤Ê MOVE ʸ¤Ç¤¹" - -#, fuzzy -#~ msgid "Invalid -K parameter\n" -#~ msgstr "ÉÔÅö¤Ê MOVE ʸ¤Ç¤¹" - -#, fuzzy -#~ msgid "Invalid -k parameter\n" -#~ msgstr "ÉÔÅö¤Ê MOVE ʸ¤Ç¤¹" - -#, fuzzy -#~ msgid "Invalid -fstack-size parameter\n" -#~ msgstr "ÉÔÅö¤Ê MOVE ʸ¤Ç¤¹" - -#, fuzzy -#~ msgid "Invalid -fif-cutoff parameter\n" -#~ msgstr "ÉÔÅö¤Ê MOVE ʸ¤Ç¤¹" - -#, fuzzy -#~ msgid "Invalid -fsign parameter\n" -#~ msgstr "ÉÔÅö¤Ê MOVE ʸ¤Ç¤¹" - -#, fuzzy -#~ msgid "Invalid -ffold-copy parameter\n" -#~ msgstr "ÉÔÅö¤Ê MOVE ʸ¤Ç¤¹" - -#, fuzzy -#~ msgid "Invalid -ffold-call parameter\n" -#~ msgstr "ÉÔÅö¤Ê MOVE ʸ¤Ç¤¹" - -#, fuzzy -#~ msgid "Invalid -fdefaultbyte parameter\n" -#~ msgstr "ÉÔÅö¤Ê MOVE ʸ¤Ç¤¹" - -#, fuzzy -#~ msgid "%s:%d: Invalid line\n" -#~ msgstr "ÉÔÅö¤Ê VALUE ¶ç¤Ç¤¹" - -#, fuzzy -#~ msgid "Invalid WHEN expression" -#~ msgstr "ÉÔÅö¤Ê¼°¤Ç¤¹" - -#, fuzzy -#~ msgid "Error: Invalid fold-copy combination\n" -#~ msgstr "ÉÔÅö¤Ê¹ÔÏ¢·ë¤Ç¤¹" - -#, fuzzy -#~ msgid "Value required for constant item '%s'" -#~ msgstr "%s ¶ç¤¬¥Õ¥¡¥¤¥ë `%s' ¤ËɬÍפǤ¹" - -#, fuzzy -#~ msgid "Undeclared key '%s'" -#~ msgstr "`%s' ¤Ï¥­¡¼Àë¸À¤µ¤ì¤Æ¤¤¤Þ¤»¤ó" - -#, fuzzy -#~ msgid "Switch-name is expected '%s'" -#~ msgstr "¥¹¥¤¥Ã¥Á̾¤¬É¬ÍפǤ¹ `%s'" - -#, fuzzy -#~ msgid "Level %02d item '%s' cannot have other than %s clause" -#~ msgstr "¥ì¥Ù¥ë %02d ¹àÌÜ `%s' ¤Ï %s ¶ç°Ê³°¤ò»ý¤Ä¤³¤È¤¬½ÐÍè¤Þ¤»¤ó" - -#, fuzzy -#~ msgid "" -#~ "Options:\n" -#~ " --help Display this message\n" -#~ " --version, -V Display compiler version\n" -#~ " -v Display the programs invoked by the compiler\n" -#~ " -x Build an executable program\n" -#~ " -m Build a dynamically loadable module (default)\n" -#~ " -std= Compile for a specific dialect :\n" -#~ " cobol2002 Cobol 2002\n" -#~ " cobol85 Cobol 85\n" -#~ " ibm IBM Compatible\n" -#~ " mvs MVS Compatible\n" -#~ " bs2000 BS2000 Compatible\n" -#~ " mf Micro Focus Compatible\n" -#~ " default When not specified\n" -#~ " See config/default.conf and config/*.conf\n" -#~ " -free Use free source format\n" -#~ " -fixed Use fixed source format (default)\n" -#~ " -O, -O2, -Os Enable optimization\n" -#~ " -g Produce debugging information in the output\n" -#~ " -debug Enable all run-time error checking\n" -#~ " -o Place the output into \n" -#~ " -b Combine all input files into a single\n" -#~ " dynamically loadable module\n" -#~ " -E Preprocess only; do not compile, assemble or link\n" -#~ " -C Translation only; convert COBOL to C\n" -#~ " -S Compile only; output assembly file\n" -#~ " -c Compile and assemble, but do not link\n" -#~ " -t Generate and place a program listing into \n" -#~ " -I Add to copy/include search path\n" -#~ " -L Add to library search path\n" -#~ " -l Link the library \n" -#~ " -D Pass to the C compiler\n" -#~ " -conf= User defined dialect configuration - See -std=\n" -#~ " --list-reserved Display all reserved words\n" -#~ " --list-intrinsics Display intrinsic functions\n" -#~ " -save-temps(=) Save intermediate files (default current directory)\n" -#~ " -MT Set target file used in dependency list\n" -#~ " -MF Place dependency list into \n" -#~ " -ext Add default file extension\n" -#~ "\n" -#~ " -Wall Enable all warnings" -#~ msgstr "" -#~ "°ìÈÌŪ¤Ê¥ª¥×¥·¥ç¥ó:\n" -#~ " --help ¤³¤Î¥á¥Ã¥»¡¼¥¸¤òɽ¼¨\n" -#~ " --version ¥³¥ó¥Ñ¥¤¥é¤Î¥Ð¡¼¥¸¥ç¥ó¤òɽ¼¨\n" -#~ " --verbose, -v ¥³¥ó¥Ñ¥¤¥é¤«¤é¸Æ¤Ð¤ì¤ë¥×¥í¥°¥é¥à¤òɽ¼¨¤¹¤ë\n" -#~ " --list-reserved ͽÌó¸ì¤Î°ìÍ÷¤òɽ¼¨¤¹¤ë\n" -#~ " -save-temps Ãæ´Ö¥Õ¥¡¥¤¥ë¤òºï½ü¤·¤Ê¤¤\n" -#~ " -E Á°½èÍý¤Î¤ß¡£¥³¥ó¥Ñ¥¤¥ë¡¢¥¢¥»¥ó¥Ö¥ë¡¢¥ê¥ó¥¯¤ò¤·¤Ê¤¤\n" -#~ " -C ËÝÌõ¤Î¤ß¡£COBOL ¤ò C ¤ËÊÑ´¹¤¹¤ë\n" -#~ " -S ¥³¥ó¥Ñ¥¤¥ë¤Î¤ß¡£¥¢¥»¥ó¥Ö¥ê¥Õ¥¡¥¤¥ë¤ò½ÐÎϤ¹¤ë\n" -#~ " -c ¥³¥ó¥Ñ¥¤¥ë¤È¥¢¥»¥ó¥Ö¥ë¡£¥ê¥ó¥¯¤ò¤·¤Ê¤¤\n" -#~ " -m ưŪ¥ê¥ó¥¯²Äǽ¤Ê¥â¥¸¥å¡¼¥ë¤òÀ¸À®¤¹¤ë\n" -#~ " -O, -O2 ºÇŬ²½¤òÍ­¸ú¤Ë¤¹¤ë\n" -#~ " -g ¥Ç¥Ð¥Ã¥°¾ðÊó¤ò½ÐÎϤ˴ޤá¤ë\n" -#~ " -debug ¼Â¹Ô»þ¤Î¥¨¥é¡¼¥Á¥§¥Ã¥¯¤òÁ´¤ÆÍ­¸ú¤Ë¤¹¤ë\n" -#~ " -o ½ÐÎϤò ¤ËÊݸ¤¹¤ë\n" -#~ " -t ¥ê¥¹¥Æ¥£¥ó¥°¥Õ¥¡¥¤¥ë¤ò½ÐÎϤ¹¤ë\n" -#~ " -I ¥³¥Ô¡¼¥Õ¥¡¥¤¥ë¤ò ¤«¤éõ¤¹\n" -#~ " -L ¥ê¥ó¥¯¥Õ¥¡¥¤¥ë¤ò ¤«¤éõ¤¹\n" -#~ " -l ¥é¥¤¥Ö¥é¥ê ¤ò¥ê¥ó¥¯¤¹¤ë\n" -#~ " -MT °Í¸¥ê¥¹¥È¤ÎÂоݥե¡¥¤¥ë¤ò»ØÄꤹ¤ë\n" -#~ " -MF °Í¸¥ê¥¹¥È¤ò ¤ËÊݸ¤¹¤ë\n" -#~ " -free ¥½¡¼¥¹¥³¡¼¥É¤Î½ñ¼°¤ò¼«Í³·Á¼°¤Ë¤¹¤ë\n" -#~ " -fixed ¥½¡¼¥¹¥³¡¼¥É¤Î½ñ¼°¤ò¸ÇÄê·Á¼°¤Ë¤¹¤ë\n" -#~ " -ext ¥Õ¥¡¥¤¥ë¤Î¥Ç¥Õ¥©¥ë¥È³ÈÄ¥»Ò¤òÄɲ乤ë\n" -#~ "\n" -#~ " -Wall Á´¤Æ¤Î¥ï¡¼¥Ë¥ó¥°¤òÍ­¸ú¤Ë¤¹¤ë" - -#, fuzzy -#~ msgid "Wrong number of data items" -#~ msgstr "¥Ç¡¼¥¿¹àÌܤοô¤¬ÉÔÅö¤Ç¤¹" - -#, fuzzy -#~ msgid "'%s' not numeric item" -#~ msgstr "`%s' ¤Ï¿ô»ú¹àÌܤǤϤ¢¤ê¤Þ¤»¤ó" - -#, fuzzy -#~ msgid "Invalid color '%d'" -#~ msgstr "ÉÔÅö¤Ê¿§¤Ç¤¹ `%d'" - -#~ msgid "Include trace code in the output" -#~ msgstr "¥È¥ì¡¼¥¹¤ò½ÐÎϤ˴ޤá¤ë" - -#~ msgid "Include source location in the output" -#~ msgstr "¥½¡¼¥¹¤Î°ÌÃÖ¤ò½ÐÎϤ˴ޤá¤ë" - -#~ msgid "Include line directive in the output" -#~ msgstr "¹Ô¾ðÊó¤ò½ÐÎϤ˴ޤá¤ë" - -#, fuzzy -#~ msgid "Warning: cob_init expected in the main program\n" -#~ msgstr "warning: ¥á¥¤¥ó¥×¥í¥°¥é¥à¤Ç cob_init ¸Æ¤Ð¤ì¤Æ¤¤¤Þ¤»¤ó\n" - -#, fuzzy -#~ msgid "Invalid display sign '%d'" -#~ msgstr "ÉÔÅö¤ÊÄ̲ߵ­¹æ¤Ç¤¹ `%s'" - -#, fuzzy -#~ msgid "78 level can not have a PICTURE clause - '%s'" -#~ msgstr "`%s' ¤Ï PICTURE ¶ç¤ò»ý¤Ä¤³¤È¤¬½ÐÍè¤Þ¤»¤ó" - -#, fuzzy -#~ msgid "Include the main function in the output (deprecated, use -x)" -#~ msgstr "main ´Ø¿ô¤ò½ÐÎϤ˴ޤá¤ë" - -#, fuzzy -#~ msgid "Inline runtime functions (deprecated)" -#~ msgstr "°ìÈÌŪ¤Ê½èÍý¤Ç´Ø¿ô¤Î¥¤¥ó¥é¥¤¥ó²½¤ò¹Ô¤Ê¤¦" diff -Nru gnucobol-4.0~early~20200606/po/LINGUAS gnucobol-5/po/LINGUAS --- gnucobol-4.0~early~20200606/po/LINGUAS 2020-06-06 20:52:58.000000000 +0000 +++ gnucobol-5/po/LINGUAS 1970-01-01 00:00:00.000000000 +0000 @@ -1,2 +0,0 @@ -# List of available languages. -en@boldquot en@quot de es fr it ja nl pt sv diff -Nru gnucobol-4.0~early~20200606/po/Makefile.in.in gnucobol-5/po/Makefile.in.in --- gnucobol-4.0~early~20200606/po/Makefile.in.in 2020-06-06 20:52:02.000000000 +0000 +++ gnucobol-5/po/Makefile.in.in 1970-01-01 00:00:00.000000000 +0000 @@ -1,483 +0,0 @@ -# Makefile for PO directory in any package using GNU gettext. -# Copyright (C) 1995-1997, 2000-2007, 2009-2010 by Ulrich Drepper -# -# Copying and distribution of this file, with or without modification, -# are permitted in any medium without royalty provided the copyright -# notice and this notice are preserved. This file is offered as-is, -# without any warranty. -# -# Origin: gettext-0.19.8 -GETTEXT_MACRO_VERSION = 0.19 - -PACKAGE = @PACKAGE@ -VERSION = @VERSION@ -PACKAGE_BUGREPORT = @PACKAGE_BUGREPORT@ - -SED = @SED@ -SHELL = /bin/sh -@SET_MAKE@ - -srcdir = @srcdir@ -top_srcdir = @top_srcdir@ -VPATH = @srcdir@ - -prefix = @prefix@ -exec_prefix = @exec_prefix@ -datarootdir = @datarootdir@ -datadir = @datadir@ -localedir = @localedir@ -gettextsrcdir = $(datadir)/gettext/po - -INSTALL = @INSTALL@ -INSTALL_DATA = @INSTALL_DATA@ - -# We use $(mkdir_p). -# In automake <= 1.9.x, $(mkdir_p) is defined either as "mkdir -p --" or as -# "$(mkinstalldirs)" or as "$(install_sh) -d". For these automake versions, -# @install_sh@ does not start with $(SHELL), so we add it. -# In automake >= 1.10, @mkdir_p@ is derived from ${MKDIR_P}, which is defined -# either as "/path/to/mkdir -p" or ".../install-sh -c -d". For these automake -# versions, $(mkinstalldirs) and $(install_sh) are unused. -mkinstalldirs = $(SHELL) @install_sh@ -d -install_sh = $(SHELL) @install_sh@ -MKDIR_P = @MKDIR_P@ -mkdir_p = @mkdir_p@ - -# When building gettext-tools, we prefer to use the built programs -# rather than installed programs. However, we can't do that when we -# are cross compiling. -CROSS_COMPILING = @CROSS_COMPILING@ - -GMSGFMT_ = @GMSGFMT@ -GMSGFMT_no = @GMSGFMT@ -GMSGFMT_yes = @GMSGFMT_015@ -GMSGFMT = $(GMSGFMT_$(USE_MSGCTXT)) -MSGFMT_ = @MSGFMT@ -MSGFMT_no = @MSGFMT@ -MSGFMT_yes = @MSGFMT_015@ -MSGFMT = $(MSGFMT_$(USE_MSGCTXT)) -XGETTEXT_ = @XGETTEXT@ -XGETTEXT_no = @XGETTEXT@ -XGETTEXT_yes = @XGETTEXT_015@ -XGETTEXT = $(XGETTEXT_$(USE_MSGCTXT)) -MSGMERGE = msgmerge -MSGMERGE_UPDATE = @MSGMERGE@ --update -MSGINIT = msginit -MSGCONV = msgconv -MSGFILTER = msgfilter - -POFILES = @POFILES@ -GMOFILES = @GMOFILES@ -UPDATEPOFILES = @UPDATEPOFILES@ -DUMMYPOFILES = @DUMMYPOFILES@ -DISTFILES.common = Makefile.in.in remove-potcdate.sin \ -$(DISTFILES.common.extra1) $(DISTFILES.common.extra2) $(DISTFILES.common.extra3) -DISTFILES = $(DISTFILES.common) Makevars POTFILES.in \ -$(POFILES) $(GMOFILES) \ -$(DISTFILES.extra1) $(DISTFILES.extra2) $(DISTFILES.extra3) - -POTFILES = \ - -CATALOGS = @CATALOGS@ - -POFILESDEPS_ = $(srcdir)/$(DOMAIN).pot -POFILESDEPS_yes = $(POFILESDEPS_) -POFILESDEPS_no = -POFILESDEPS = $(POFILESDEPS_$(PO_DEPENDS_ON_POT)) - -DISTFILESDEPS_ = update-po -DISTFILESDEPS_yes = $(DISTFILESDEPS_) -DISTFILESDEPS_no = -DISTFILESDEPS = $(DISTFILESDEPS_$(DIST_DEPENDS_ON_UPDATE_PO)) - -# Makevars gets inserted here. (Don't remove this line!) - -.SUFFIXES: -.SUFFIXES: .po .gmo .mo .sed .sin .nop .po-create .po-update - -.po.mo: - @echo "$(MSGFMT) -c -o $@ $<"; \ - $(MSGFMT) -c -o t-$@ $< && mv t-$@ $@ - -.po.gmo: - @lang=`echo $* | sed -e 's,.*/,,'`; \ - test "$(srcdir)" = . && cdcmd="" || cdcmd="cd $(srcdir) && "; \ - echo "$${cdcmd}rm -f $${lang}.gmo && $(GMSGFMT) -c --statistics --verbose -o $${lang}.gmo $${lang}.po"; \ - cd $(srcdir) && rm -f $${lang}.gmo && $(GMSGFMT) -c --statistics --verbose -o t-$${lang}.gmo $${lang}.po && mv t-$${lang}.gmo $${lang}.gmo - -.sin.sed: - sed -e '/^#/d' $< > t-$@ - mv t-$@ $@ - - -all: all-@USE_NLS@ - -all-yes: stamp-po -all-no: - -# Ensure that the gettext macros and this Makefile.in.in are in sync. -CHECK_MACRO_VERSION = \ - test "$(GETTEXT_MACRO_VERSION)" = "@GETTEXT_MACRO_VERSION@" \ - || { echo "*** error: gettext infrastructure mismatch: using a Makefile.in.in from gettext version $(GETTEXT_MACRO_VERSION) but the autoconf macros are from gettext version @GETTEXT_MACRO_VERSION@" 1>&2; \ - exit 1; \ - } - -# $(srcdir)/$(DOMAIN).pot is only created when needed. When xgettext finds no -# internationalized messages, no $(srcdir)/$(DOMAIN).pot is created (because -# we don't want to bother translators with empty POT files). We assume that -# LINGUAS is empty in this case, i.e. $(POFILES) and $(GMOFILES) are empty. -# In this case, stamp-po is a nop (i.e. a phony target). - -# stamp-po is a timestamp denoting the last time at which the CATALOGS have -# been loosely updated. Its purpose is that when a developer or translator -# checks out the package via CVS, and the $(DOMAIN).pot file is not in CVS, -# "make" will update the $(DOMAIN).pot and the $(CATALOGS), but subsequent -# invocations of "make" will do nothing. This timestamp would not be necessary -# if updating the $(CATALOGS) would always touch them; however, the rule for -# $(POFILES) has been designed to not touch files that don't need to be -# changed. -stamp-po: $(srcdir)/$(DOMAIN).pot - @$(CHECK_MACRO_VERSION) - test ! -f $(srcdir)/$(DOMAIN).pot || \ - test -z "$(GMOFILES)" || $(MAKE) $(GMOFILES) - @test ! -f $(srcdir)/$(DOMAIN).pot || { \ - echo "touch stamp-po" && \ - echo timestamp > stamp-poT && \ - mv stamp-poT stamp-po; \ - } - -# Note: Target 'all' must not depend on target '$(DOMAIN).pot-update', -# otherwise packages like GCC can not be built if only parts of the source -# have been downloaded. - -# This target rebuilds $(DOMAIN).pot; it is an expensive operation. -# Note that $(DOMAIN).pot is not touched if it doesn't need to be changed. -# The determination of whether the package xyz is a GNU one is based on the -# heuristic whether some file in the top level directory mentions "GNU xyz". -# If GNU 'find' is available, we avoid grepping through monster files. -$(DOMAIN).pot-update: $(POTFILES) $(srcdir)/POTFILES.in remove-potcdate.sed - package_gnu="$(PACKAGE_GNU)"; \ - test -n "$$package_gnu" || { \ - if { if (LC_ALL=C find --version) 2>/dev/null | grep GNU >/dev/null; then \ - LC_ALL=C find -L $(top_srcdir) -maxdepth 1 -type f \ - -size -10000000c -exec grep 'GNU @PACKAGE@' \ - /dev/null '{}' ';' 2>/dev/null; \ - else \ - LC_ALL=C grep 'GNU @PACKAGE@' $(top_srcdir)/* 2>/dev/null; \ - fi; \ - } | grep -v 'libtool:' >/dev/null; then \ - package_gnu=yes; \ - else \ - package_gnu=no; \ - fi; \ - }; \ - if test "$$package_gnu" = "yes"; then \ - package_prefix='GNU '; \ - else \ - package_prefix=''; \ - fi; \ - if test -n '$(MSGID_BUGS_ADDRESS)' || test '$(PACKAGE_BUGREPORT)' = '@'PACKAGE_BUGREPORT'@'; then \ - msgid_bugs_address='$(MSGID_BUGS_ADDRESS)'; \ - else \ - msgid_bugs_address='$(PACKAGE_BUGREPORT)'; \ - fi; \ - case `$(XGETTEXT) --version | sed 1q | sed -e 's,^[^0-9]*,,'` in \ - '' | 0.[0-9] | 0.[0-9].* | 0.1[0-5] | 0.1[0-5].* | 0.16 | 0.16.[0-1]*) \ - $(XGETTEXT) --default-domain=$(DOMAIN) --directory=$(top_srcdir) \ - --add-comments=TRANSLATORS: $(XGETTEXT_OPTIONS) @XGETTEXT_EXTRA_OPTIONS@ \ - --files-from=$(srcdir)/POTFILES.in \ - --copyright-holder='$(COPYRIGHT_HOLDER)' \ - --msgid-bugs-address="$$msgid_bugs_address" \ - ;; \ - *) \ - $(XGETTEXT) --default-domain=$(DOMAIN) --directory=$(top_srcdir) \ - --add-comments=TRANSLATORS: $(XGETTEXT_OPTIONS) @XGETTEXT_EXTRA_OPTIONS@ \ - --files-from=$(srcdir)/POTFILES.in \ - --copyright-holder='$(COPYRIGHT_HOLDER)' \ - --package-name="$${package_prefix}@PACKAGE@" \ - --package-version='@VERSION@' \ - --msgid-bugs-address="$$msgid_bugs_address" \ - ;; \ - esac - test ! -f $(DOMAIN).po || { \ - if test -f $(srcdir)/$(DOMAIN).pot-header; then \ - sed -e '1,/^#$$/d' < $(DOMAIN).po > $(DOMAIN).1po && \ - cat $(srcdir)/$(DOMAIN).pot-header $(DOMAIN).1po > $(DOMAIN).po; \ - rm -f $(DOMAIN).1po; \ - fi; \ - if test -f $(srcdir)/$(DOMAIN).pot; then \ - sed -f remove-potcdate.sed < $(srcdir)/$(DOMAIN).pot > $(DOMAIN).1po && \ - sed -f remove-potcdate.sed < $(DOMAIN).po > $(DOMAIN).2po && \ - if cmp $(DOMAIN).1po $(DOMAIN).2po >/dev/null 2>&1; then \ - rm -f $(DOMAIN).1po $(DOMAIN).2po $(DOMAIN).po; \ - else \ - rm -f $(DOMAIN).1po $(DOMAIN).2po $(srcdir)/$(DOMAIN).pot && \ - mv $(DOMAIN).po $(srcdir)/$(DOMAIN).pot; \ - fi; \ - else \ - mv $(DOMAIN).po $(srcdir)/$(DOMAIN).pot; \ - fi; \ - } - -# This rule has no dependencies: we don't need to update $(DOMAIN).pot at -# every "make" invocation, only create it when it is missing. -# Only "make $(DOMAIN).pot-update" or "make dist" will force an update. -$(srcdir)/$(DOMAIN).pot: - $(MAKE) $(DOMAIN).pot-update - -# This target rebuilds a PO file if $(DOMAIN).pot has changed. -# Note that a PO file is not touched if it doesn't need to be changed. -$(POFILES): $(POFILESDEPS) - @lang=`echo $@ | sed -e 's,.*/,,' -e 's/\.po$$//'`; \ - if test -f "$(srcdir)/$${lang}.po"; then \ - test -f $(srcdir)/$(DOMAIN).pot || $(MAKE) $(srcdir)/$(DOMAIN).pot; \ - test "$(srcdir)" = . && cdcmd="" || cdcmd="cd $(srcdir) && "; \ - echo "$${cdcmd}$(MSGMERGE_UPDATE) $(MSGMERGE_OPTIONS) --lang=$${lang} $${lang}.po $(DOMAIN).pot"; \ - cd $(srcdir) \ - && { case `$(MSGMERGE) --version | sed 1q | sed -e 's,^[^0-9]*,,'` in \ - '' | 0.[0-9] | 0.[0-9].* | 0.1[0-7] | 0.1[0-7].*) \ - $(MSGMERGE_UPDATE) $(MSGMERGE_OPTIONS) $${lang}.po $(DOMAIN).pot;; \ - *) \ - $(MSGMERGE_UPDATE) $(MSGMERGE_OPTIONS) --lang=$${lang} $${lang}.po $(DOMAIN).pot;; \ - esac; \ - }; \ - else \ - $(MAKE) $${lang}.po-create; \ - fi - - -install: install-exec install-data -install-exec: -install-data: install-data-@USE_NLS@ - if test "$(PACKAGE)" = "gettext-tools"; then \ - $(mkdir_p) $(DESTDIR)$(gettextsrcdir); \ - for file in $(DISTFILES.common) Makevars.template; do \ - $(INSTALL_DATA) $(srcdir)/$$file \ - $(DESTDIR)$(gettextsrcdir)/$$file; \ - done; \ - for file in Makevars; do \ - rm -f $(DESTDIR)$(gettextsrcdir)/$$file; \ - done; \ - else \ - : ; \ - fi -install-data-no: all -install-data-yes: all - @catalogs='$(CATALOGS)'; \ - for cat in $$catalogs; do \ - cat=`basename $$cat`; \ - lang=`echo $$cat | sed -e 's/\.gmo$$//'`; \ - dir=$(localedir)/$$lang/LC_MESSAGES; \ - $(mkdir_p) $(DESTDIR)$$dir; \ - if test -r $$cat; then realcat=$$cat; else realcat=$(srcdir)/$$cat; fi; \ - $(INSTALL_DATA) $$realcat $(DESTDIR)$$dir/$(DOMAIN).mo; \ - echo "installing $$realcat as $(DESTDIR)$$dir/$(DOMAIN).mo"; \ - for lc in '' $(EXTRA_LOCALE_CATEGORIES); do \ - if test -n "$$lc"; then \ - if (cd $(DESTDIR)$(localedir)/$$lang && LC_ALL=C ls -l -d $$lc 2>/dev/null) | grep ' -> ' >/dev/null; then \ - link=`cd $(DESTDIR)$(localedir)/$$lang && LC_ALL=C ls -l -d $$lc | sed -e 's/^.* -> //'`; \ - mv $(DESTDIR)$(localedir)/$$lang/$$lc $(DESTDIR)$(localedir)/$$lang/$$lc.old; \ - mkdir $(DESTDIR)$(localedir)/$$lang/$$lc; \ - (cd $(DESTDIR)$(localedir)/$$lang/$$lc.old && \ - for file in *; do \ - if test -f $$file; then \ - ln -s ../$$link/$$file $(DESTDIR)$(localedir)/$$lang/$$lc/$$file; \ - fi; \ - done); \ - rm -f $(DESTDIR)$(localedir)/$$lang/$$lc.old; \ - else \ - if test -d $(DESTDIR)$(localedir)/$$lang/$$lc; then \ - :; \ - else \ - rm -f $(DESTDIR)$(localedir)/$$lang/$$lc; \ - mkdir $(DESTDIR)$(localedir)/$$lang/$$lc; \ - fi; \ - fi; \ - rm -f $(DESTDIR)$(localedir)/$$lang/$$lc/$(DOMAIN).mo; \ - ln -s ../LC_MESSAGES/$(DOMAIN).mo $(DESTDIR)$(localedir)/$$lang/$$lc/$(DOMAIN).mo 2>/dev/null || \ - ln $(DESTDIR)$(localedir)/$$lang/LC_MESSAGES/$(DOMAIN).mo $(DESTDIR)$(localedir)/$$lang/$$lc/$(DOMAIN).mo 2>/dev/null || \ - cp -p $(DESTDIR)$(localedir)/$$lang/LC_MESSAGES/$(DOMAIN).mo $(DESTDIR)$(localedir)/$$lang/$$lc/$(DOMAIN).mo; \ - echo "installing $$realcat link as $(DESTDIR)$(localedir)/$$lang/$$lc/$(DOMAIN).mo"; \ - fi; \ - done; \ - done - -install-strip: install - -installdirs: installdirs-exec installdirs-data -installdirs-exec: -installdirs-data: installdirs-data-@USE_NLS@ - if test "$(PACKAGE)" = "gettext-tools"; then \ - $(mkdir_p) $(DESTDIR)$(gettextsrcdir); \ - else \ - : ; \ - fi -installdirs-data-no: -installdirs-data-yes: - @catalogs='$(CATALOGS)'; \ - for cat in $$catalogs; do \ - cat=`basename $$cat`; \ - lang=`echo $$cat | sed -e 's/\.gmo$$//'`; \ - dir=$(localedir)/$$lang/LC_MESSAGES; \ - $(mkdir_p) $(DESTDIR)$$dir; \ - for lc in '' $(EXTRA_LOCALE_CATEGORIES); do \ - if test -n "$$lc"; then \ - if (cd $(DESTDIR)$(localedir)/$$lang && LC_ALL=C ls -l -d $$lc 2>/dev/null) | grep ' -> ' >/dev/null; then \ - link=`cd $(DESTDIR)$(localedir)/$$lang && LC_ALL=C ls -l -d $$lc | sed -e 's/^.* -> //'`; \ - mv $(DESTDIR)$(localedir)/$$lang/$$lc $(DESTDIR)$(localedir)/$$lang/$$lc.old; \ - mkdir $(DESTDIR)$(localedir)/$$lang/$$lc; \ - (cd $(DESTDIR)$(localedir)/$$lang/$$lc.old && \ - for file in *; do \ - if test -f $$file; then \ - ln -s ../$$link/$$file $(DESTDIR)$(localedir)/$$lang/$$lc/$$file; \ - fi; \ - done); \ - rm -f $(DESTDIR)$(localedir)/$$lang/$$lc.old; \ - else \ - if test -d $(DESTDIR)$(localedir)/$$lang/$$lc; then \ - :; \ - else \ - rm -f $(DESTDIR)$(localedir)/$$lang/$$lc; \ - mkdir $(DESTDIR)$(localedir)/$$lang/$$lc; \ - fi; \ - fi; \ - fi; \ - done; \ - done - -# Define this as empty until I found a useful application. -installcheck: - -uninstall: uninstall-exec uninstall-data -uninstall-exec: -uninstall-data: uninstall-data-@USE_NLS@ - if test "$(PACKAGE)" = "gettext-tools"; then \ - for file in $(DISTFILES.common) Makevars.template; do \ - rm -f $(DESTDIR)$(gettextsrcdir)/$$file; \ - done; \ - else \ - : ; \ - fi -uninstall-data-no: -uninstall-data-yes: - catalogs='$(CATALOGS)'; \ - for cat in $$catalogs; do \ - cat=`basename $$cat`; \ - lang=`echo $$cat | sed -e 's/\.gmo$$//'`; \ - for lc in LC_MESSAGES $(EXTRA_LOCALE_CATEGORIES); do \ - rm -f $(DESTDIR)$(localedir)/$$lang/$$lc/$(DOMAIN).mo; \ - done; \ - done - -check: all - -info dvi ps pdf html tags TAGS ctags CTAGS ID: - -mostlyclean: - rm -f remove-potcdate.sed - rm -f stamp-poT - rm -f core core.* $(DOMAIN).po $(DOMAIN).1po $(DOMAIN).2po *.new.po - rm -fr *.o - -clean: mostlyclean - -distclean: clean - rm -f Makefile Makefile.in POTFILES *.mo - -maintainer-clean: distclean - @echo "This command is intended for maintainers to use;" - @echo "it deletes files that may require special tools to rebuild." - rm -f stamp-po $(GMOFILES) - -distdir = $(top_builddir)/$(PACKAGE)-$(VERSION)/$(subdir) -dist distdir: - test -z "$(DISTFILESDEPS)" || $(MAKE) $(DISTFILESDEPS) - @$(MAKE) dist2 -# This is a separate target because 'update-po' must be executed before. -dist2: stamp-po $(DISTFILES) - dists="$(DISTFILES)"; \ - if test "$(PACKAGE)" = "gettext-tools"; then \ - dists="$$dists Makevars.template"; \ - fi; \ - if test -f $(srcdir)/$(DOMAIN).pot; then \ - dists="$$dists $(DOMAIN).pot stamp-po"; \ - fi; \ - if test -f $(srcdir)/ChangeLog; then \ - dists="$$dists ChangeLog"; \ - fi; \ - for i in 0 1 2 3 4 5 6 7 8 9; do \ - if test -f $(srcdir)/ChangeLog.$$i; then \ - dists="$$dists ChangeLog.$$i"; \ - fi; \ - done; \ - if test -f $(srcdir)/LINGUAS; then dists="$$dists LINGUAS"; fi; \ - for file in $$dists; do \ - if test -f $$file; then \ - cp -p $$file $(distdir) || exit 1; \ - else \ - cp -p $(srcdir)/$$file $(distdir) || exit 1; \ - fi; \ - done - -update-po: Makefile - $(MAKE) $(DOMAIN).pot-update - test -z "$(UPDATEPOFILES)" || $(MAKE) $(UPDATEPOFILES) - $(MAKE) update-gmo - -# General rule for creating PO files. - -.nop.po-create: - @lang=`echo $@ | sed -e 's/\.po-create$$//'`; \ - echo "File $$lang.po does not exist. If you are a translator, you can create it through 'msginit'." 1>&2; \ - exit 1 - -# General rule for updating PO files. - -.nop.po-update: - @lang=`echo $@ | sed -e 's/\.po-update$$//'`; \ - if test "$(PACKAGE)" = "gettext-tools" && test "$(CROSS_COMPILING)" != "yes"; then PATH=`pwd`/../src:$$PATH; fi; \ - tmpdir=`pwd`; \ - echo "$$lang:"; \ - test "$(srcdir)" = . && cdcmd="" || cdcmd="cd $(srcdir) && "; \ - echo "$${cdcmd}$(MSGMERGE) $(MSGMERGE_OPTIONS) --lang=$$lang $$lang.po $(DOMAIN).pot -o $$lang.new.po"; \ - cd $(srcdir); \ - if { case `$(MSGMERGE) --version | sed 1q | sed -e 's,^[^0-9]*,,'` in \ - '' | 0.[0-9] | 0.[0-9].* | 0.1[0-7] | 0.1[0-7].*) \ - $(MSGMERGE) $(MSGMERGE_OPTIONS) -o $$tmpdir/$$lang.new.po $$lang.po $(DOMAIN).pot;; \ - *) \ - $(MSGMERGE) $(MSGMERGE_OPTIONS) --lang=$$lang -o $$tmpdir/$$lang.new.po $$lang.po $(DOMAIN).pot;; \ - esac; \ - }; then \ - if cmp $$lang.po $$tmpdir/$$lang.new.po >/dev/null 2>&1; then \ - rm -f $$tmpdir/$$lang.new.po; \ - else \ - if mv -f $$tmpdir/$$lang.new.po $$lang.po; then \ - :; \ - else \ - echo "msgmerge for $$lang.po failed: cannot move $$tmpdir/$$lang.new.po to $$lang.po" 1>&2; \ - exit 1; \ - fi; \ - fi; \ - else \ - echo "msgmerge for $$lang.po failed!" 1>&2; \ - rm -f $$tmpdir/$$lang.new.po; \ - fi - -$(DUMMYPOFILES): - -update-gmo: Makefile $(GMOFILES) - @: - -# Recreate Makefile by invoking config.status. Explicitly invoke the shell, -# because execution permission bits may not work on the current file system. -# Use @SHELL@, which is the shell determined by autoconf for the use by its -# scripts, not $(SHELL) which is hardwired to /bin/sh and may be deficient. -Makefile: Makefile.in.in Makevars $(top_builddir)/config.status @POMAKEFILEDEPS@ - cd $(top_builddir) \ - && @SHELL@ ./config.status $(subdir)/$@.in po-directories - -force: - -# Tell versions [3.59,3.63) of GNU make not to export all variables. -# Otherwise a system limit (for SysV at least) may be exceeded. -.NOEXPORT: diff -Nru gnucobol-4.0~early~20200606/po/Makevars gnucobol-5/po/Makevars --- gnucobol-4.0~early~20200606/po/Makevars 2020-06-06 20:52:02.000000000 +0000 +++ gnucobol-5/po/Makevars 1970-01-01 00:00:00.000000000 +0000 @@ -1,78 +0,0 @@ -# Makefile variables for PO directory in any package using GNU gettext. - -# Usually the message domain is the same as the package name. -DOMAIN = $(PACKAGE) - -# These two variables depend on the location of this directory. -subdir = po -top_builddir = .. - -# These options get passed to xgettext. -XGETTEXT_OPTIONS = --language=C --keyword=_ --keyword=N_ --flag=_:1:pass-c-format --flag=N_:1:pass-c-format - -# This is the copyright holder that gets inserted into the header of the -# $(DOMAIN).pot file. Set this to the copyright holder of the surrounding -# package. (Note that the msgstr strings, extracted from the package's -# sources, belong to the copyright holder of the package.) Translators are -# expected to transfer the copyright for their translations to this person -# or entity, or to disclaim their copyright. The empty string stands for -# the public domain; in this case the translators are expected to disclaim -# their copyright. -COPYRIGHT_HOLDER = Free Software Foundation, Inc. - -# This tells whether or not to prepend "GNU " prefix to the package -# name that gets inserted into the header of the $(DOMAIN).pot file. -# Possible values are "yes", "no", or empty. If it is empty, try to -# detect it automatically by scanning the files in $(top_srcdir) for -# "GNU packagename" string. -PACKAGE_GNU = "no" - -# This is the email address or URL to which the translators shall report -# bugs in the untranslated strings: -# - Strings which are not entire sentences, see the maintainer guidelines -# in the GNU gettext documentation, section 'Preparing Strings'. -# - Strings which use unclear terms or require additional context to be -# understood. -# - Strings which make invalid assumptions about notation of date, time or -# money. -# - Pluralisation problems. -# - Incorrect English spelling. -# - Incorrect formatting. -# It can be your email address, or a mailing list address where translators -# can write to without being subscribed, or the URL of a web page through -# which the translators can contact you. -MSGID_BUGS_ADDRESS = gnucobol-messages@gnu.org - -# This is the list of locale categories, beyond LC_MESSAGES, for which the -# message catalogs shall be used. It is usually empty. -EXTRA_LOCALE_CATEGORIES = - -# This tells whether the $(DOMAIN).pot file contains messages with an 'msgctxt' -# context. Possible values are "yes" and "no". Set this to yes if the -# package uses functions taking also a message context, like pgettext(), or -# if in $(XGETTEXT_OPTIONS) you define keywords with a context argument. -USE_MSGCTXT = no - -# These options get passed to msgmerge. -# Useful options are in particular: -# --previous to keep previous msgids of translated messages, -# --quiet to reduce the verbosity. -MSGMERGE_OPTIONS = --no-wrap - -# These options get passed to msginit. -# If you want to disable line wrapping when writing PO files, add -# --no-wrap to MSGMERGE_OPTIONS, XGETTEXT_OPTIONS, and -# MSGINIT_OPTIONS. -MSGINIT_OPTIONS = - -# This tells whether or not to regenerate a PO file when $(DOMAIN).pot -# has changed. Possible values are "yes" and "no". Set this to no if -# the POT file is checked in the repository and the version control -# program ignores timestamps. -PO_DEPENDS_ON_POT = yes - -# This tells whether or not to forcibly update $(DOMAIN).pot and -# regenerate PO files on "make dist". Possible values are "yes" and -# "no". Set this to no if the POT file and PO files are maintained -# externally. -DIST_DEPENDS_ON_UPDATE_PO = no Binary files /tmp/tmp8r0303vl/MzBWgGBJBM/gnucobol-4.0~early~20200606/po/nl.gmo and /tmp/tmp8r0303vl/cieYbammgl/gnucobol-5/po/nl.gmo differ diff -Nru gnucobol-4.0~early~20200606/po/nl.po gnucobol-5/po/nl.po --- gnucobol-4.0~early~20200606/po/nl.po 2020-06-06 20:53:00.000000000 +0000 +++ gnucobol-5/po/nl.po 1970-01-01 00:00:00.000000000 +0000 @@ -1,6718 +0,0 @@ -# Dutch translations for GNU Cobol package -# Copyright (C) 2012 Keisuke Nishida / Roger While -# This file is distributed under the same license as the GNU Cobol package. -# -# Ed Borchert , -# Ronald Heirbaut -msgid "" -msgstr "" -"Project-Id-Version: gnu-cobol 2.0\n" -"Report-Msgid-Bugs-To: gnucobol-messages@gnu.org\n" -"POT-Creation-Date: 2020-06-06 20:52+0000\n" -"PO-Revision-Date: 2016-08-13 23:32+0100\n" -"Last-Translator: Ed Borchert, Ronald Heirbaut\n" -"Language-Team: Dutch \n" -"Language: nl\n" -"MIME-Version: 1.0\n" -"Content-Type: text/plain; charset=UTF-8\n" -"Content-Transfer-Encoding: 8bit\n" -"X-Poedit-Language: Dutch\n" -"X-Poedit-Country: NETHERLANDS\n" - -#: cobc/cobc.c:117 -#, fuzzy, c-format -msgid "invalid parameter: %s" -msgstr "Ongeldige %s parameter" - -#: cobc/cobc.c:826 -msgid "too many errors" -msgstr "" - -#: cobc/cobc.c:838 -#, fuzzy -msgid "internal compiler error" -msgstr "%s:%d Interne compiler fout" - -#: cobc/cobc.c:904 cobc/cobc.c:991 cobc/cobc.c:1051 cobc/cobc.c:1127 -#: cobc/cobc.c:1167 cobc/cobc.c:1243 -#, fuzzy, c-format -msgid "cannot allocate %d bytes of memory" -msgstr "Kan geen %d bytes geheugen verkrijgen - Afbreken" - -#: cobc/cobc.c:917 cobc/cobc.c:933 cobc/cobc.c:953 cobc/cobc.c:1011 -#: cobc/cobc.c:1029 cobc/cobc.c:1147 cobc/cobc.c:1262 cobc/cobc.c:1279 -#: cobc/field.c:2008 libcob/common.c:7121 -#, fuzzy, c-format -msgid "call to %s with NULL pointer" -msgstr "Aanroep van %s met NULL pointer" - -#: cobc/cobc.c:974 -#, fuzzy, c-format -msgid "cannot reallocate %d bytes of memory" -msgstr "Kan geen %d bytes geheugen verkrijgen - Afbreken" - -#: cobc/cobc.c:1068 cobc/cobc.c:1184 -#, fuzzy -msgid "attempt to reallocate non-allocated memory" -msgstr "Poging om niet geïnitialiseerd geheugen te verkrijgen - Afbreken" - -#: cobc/cobc.c:1101 cobc/cobc.c:1217 -#, c-format -msgid "call to %s with invalid pointer, as it is missing in list" -msgstr "" - -#: cobc/cobc.c:1390 -#, fuzzy, c-format -msgid "assuming literal for unquoted '%s'" -msgstr "Waarschuwing - Aanname constante voor '%s' zonder aanhalingstekens" - -#: cobc/cobc.c:1437 -#, fuzzy -msgid " - length exceeds maximum" -msgstr "Woord lengte overschrijdt maximum toegestaan - '%s'" - -#: cobc/cobc.c:1441 -msgid " - name cannot be empty" -msgstr "" - -#: cobc/cobc.c:1444 -#, fuzzy -msgid " - name cannot begin with space or underscore" -msgstr " - Naam mag niet beginnen met spatie of underscore" - -#: cobc/cobc.c:1447 -#, fuzzy -msgid " - name cannot begin with 'cob_' or 'COB_'" -msgstr " - Naam mag niet beginnen met 'cob_' of 'COB_'" - -#: cobc/cobc.c:1450 -#, fuzzy -msgid " - name duplicates a 'C' keyword" -msgstr " - Naam is een 'C' gereserveerd woord" - -#: cobc/cobc.c:1453 -#, fuzzy -msgid " - name cannot contain a directory separator" -msgstr " - Naam mag geen map scheidingsteken bevatten" - -#: cobc/cobc.c:1462 -#, fuzzy, c-format -msgid "invalid file base name '%s'%s" -msgstr "Ongeldige bestandsnaam '%s'%s" - -#: cobc/cobc.c:1466 -#, fuzzy, c-format -msgid "invalid ENTRY '%s'%s" -msgstr "Ongeldige ENTRY '%s'%s" - -#: cobc/cobc.c:1469 -#, fuzzy, c-format -msgid "invalid PROGRAM-ID '%s'%s" -msgstr "Ongeldige PROGRAM-ID '%s'%s" - -#: cobc/cobc.c:1596 cobc/cobc.c:8151 -msgid "please check environment variables as noted above" -msgstr "" - -#: cobc/cobc.c:1608 cobc/error.c:254 cobc/error.c:274 cobc/error.c:505 -#: cobc/error.c:528 -#, fuzzy -msgid "error: " -msgstr "Fout: " - -#: cobc/cobc.c:1631 -#, fuzzy, c-format -msgid "duplicate DEFINE '%s' - ignored" -msgstr "Dubbele definitie '%s' - Negeren" - -#: cobc/cobc.c:1683 -#, c-format -msgid "environment variable '%s' is '%s'; should not contain '%c'" -msgstr "" - -#: cobc/cobc.c:1712 -#, fuzzy -msgid "parameter buffer size exceeded" -msgstr "Parameter buffer grootte overschreden" - -#: cobc/cobc.c:1752 -#, fuzzy, c-format -msgid "warning: could not move temporary file to %s" -msgstr "Waarschuwing - Kon tijdelijk bestand niet verplaatsen naar %s" - -#: cobc/cobc.c:1957 cobc/cobc.c:1960 cobc/parser.y:803 cobc/reserved.c:3807 -#: libcob/common.c:761 libcob/common.c:1805 libcob/common.c:2002 -#: libcob/common.c:6325 libcob/common.c:7495 libcob/common.c:8025 -#: libcob/common.c:8104 -#, fuzzy -msgid "unknown" -msgstr "Onbekend" - -#: cobc/cobc.c:1963 -#, fuzzy, c-format -msgid "aborting codegen for %s (%s: %s)" -msgstr "Afbreken compilatie van %s bij regel %d" - -#: cobc/cobc.c:1966 -#, fuzzy, c-format -msgid "aborting compile of %s at line %d (%s: %s)" -msgstr "Afbreken compilatie van %s bij regel %d" - -#: cobc/cobc.c:1970 -msgid "aborting" -msgstr "" - -#: cobc/cobc.c:1993 cobc/cobc.c:2028 libcob/common.c:7086 bin/cobcrun.c:342 -#, fuzzy -msgid "Please report this!" -msgstr "Codegen fout - Doorgeven s.v.p." - -#: cobc/cobc.c:2046 bin/cobcrun.c:106 -msgid "License GPLv3+: GNU GPL version 3 or later " -msgstr "" - -#: cobc/cobc.c:2047 libcob/common.c:7316 bin/cobcrun.c:107 -msgid "" -"This is free software; see the source for copying conditions. There is NO\n" -"warranty; not even for MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE." -msgstr "" -"Dit is vrij beschikbare software; zie de bron code voor de kopieer condities. Er is GEEN\n" -"garantie en geen toestemming voor verkoop. Ook niet voor een bepaalde toepassing." - -#: cobc/cobc.c:2049 libcob/common.c:7318 bin/cobcrun.c:109 -#, c-format -msgid "Written by %s\n" -msgstr "" - -#. TRANSLATORS: This msgid is indented as the "Packaged" msgid, %s expands to date and time -#: cobc/cobc.c:2050 cobc/cobc.c:2063 libcob/common.c:7321 bin/cobcrun.c:110 -#, c-format -msgid "Built %s" -msgstr "Gebouwd %s" - -#. TRANSLATORS: This msgid is indented as the "Built" msgid, %s expands to date and time -#: cobc/cobc.c:2052 cobc/cobc.c:2065 libcob/common.c:7324 bin/cobcrun.c:112 -#, c-format -msgid "Packaged %s" -msgstr "Verpakt %s" - -#: cobc/cobc.c:2054 cobc/cobc.c:2067 -#, c-format -msgid "C version %s%s" -msgstr "C versie %s%s" - -#: cobc/cobc.c:2080 -#, fuzzy -msgid "executing:" -msgstr "Uitvoeren:" - -#: cobc/cobc.c:2082 -#, fuzzy -msgid "to be executed:" -msgstr "READ moet eerst worden uitgevoerd" - -#: cobc/cobc.c:2120 cobc/cobc.c:2121 libcob/common.c:5815 libcob/common.c:5816 -#: libcob/common.c:5847 libcob/common.c:5848 -msgid "env" -msgstr "" - -#: cobc/cobc.c:2156 libcob/common.c:7351 -#, fuzzy -msgid "build information" -msgstr "Bouw informatie" - -#: cobc/cobc.c:2157 libcob/common.c:7352 -#, fuzzy -msgid "build environment" -msgstr "Bouw omgeving" - -#: cobc/cobc.c:2167 libcob/common.c:7363 -msgid "GnuCOBOL information" -msgstr "GnuCOBOL informatie" - -#: cobc/cobc.c:2212 libcob/common.c:6366 libcob/common.c:7386 -#: libcob/common.c:7486 libcob/common.c:7493 -msgid "yes" -msgstr "" - -#: cobc/cobc.c:2214 libcob/common.c:6368 libcob/common.c:7388 -#: libcob/common.c:7488 -msgid "no" -msgstr "" - -#: cobc/cobc.c:2218 libcob/common.c:7392 -msgid "8 bytes" -msgstr "8 bytes" - -#: cobc/cobc.c:2220 libcob/common.c:7394 -msgid "4 bytes" -msgstr "4 bytes" - -#: cobc/cobc.c:2224 cobc/cobc.c:2226 libcob/common.c:7398 libcob/common.c:7400 -msgid "endianness" -msgstr "" - -#: cobc/cobc.c:2224 libcob/common.c:7398 -msgid "big-endian" -msgstr "" - -#: cobc/cobc.c:2226 libcob/common.c:7400 -msgid "little-endian" -msgstr "" - -#: cobc/cobc.c:2230 cobc/cobc.c:2232 libcob/common.c:7404 libcob/common.c:7406 -#, fuzzy -msgid "native character set" -msgstr "Voortzettings teken verwacht" - -#: cobc/cobc.c:2230 libcob/common.c:7404 -msgid "EBCDIC" -msgstr "" - -#: cobc/cobc.c:2232 libcob/common.c:7406 -msgid "ASCII" -msgstr "" - -#: cobc/cobc.c:2235 libcob/common.c:7410 libcob/common.c:7476 -msgid "extended screen I/O" -msgstr "" - -#: cobc/cobc.c:2238 libcob/common.c:7502 -#, fuzzy -msgid "variable file format" -msgstr "Variabel formaat" - -#: cobc/cobc.c:2244 cobc/cobc.c:2246 libcob/common.c:7508 libcob/common.c:7510 -#, fuzzy -msgid "sequential file handler" -msgstr "Sequentiële handler" - -#: cobc/cobc.c:2246 libcob/common.c:7510 -msgid "built-in" -msgstr "" - -#: cobc/cobc.c:2254 cobc/cobc.c:2260 cobc/cobc.c:2262 cobc/cobc.c:2269 -#: cobc/cobc.c:2271 cobc/cobc.c:2275 cobc/cobc.c:2278 cobc/cobc.c:2282 -#: cobc/cobc.c:2284 cobc/cobc.c:2289 cobc/cobc.c:2291 cobc/cobc.c:2298 -#: cobc/cobc.c:2300 cobc/cobc.c:2307 libcob/common.c:7516 libcob/common.c:7527 -#: libcob/common.c:7533 libcob/common.c:7535 libcob/common.c:7539 -#: libcob/common.c:7542 libcob/common.c:7546 libcob/common.c:7548 -#: libcob/common.c:7553 libcob/common.c:7555 libcob/common.c:7562 -#: libcob/common.c:7564 libcob/common.c:7571 -#, fuzzy -msgid "indexed file handler" -msgstr "Sequentiële handler" - -#: cobc/cobc.c:2304 libcob/common.c:7568 -#, fuzzy -msgid "default indexed handler" -msgstr "hier gedefinieerd" - -#: cobc/cobc.c:2307 cobc/cobc.c:2319 cobc/cobc.c:2325 libcob/common.c:7381 -#: libcob/common.c:7498 libcob/common.c:7571 libcob/common.c:7611 -#: libcob/common.c:7625 -#, fuzzy -msgid "disabled" -msgstr "Uitgeschakeld" - -#: cobc/cobc.c:2311 cobc/cobc.c:2313 libcob/common.c:7594 libcob/common.c:7596 -msgid "mathematical library" -msgstr "" - -#: cobc/cobc.c:2317 cobc/cobc.c:2319 libcob/common.c:7605 libcob/common.c:7611 -msgid "XML library" -msgstr "" - -#: cobc/cobc.c:2323 cobc/cobc.c:2325 libcob/common.c:7623 libcob/common.c:7625 -msgid "JSON library" -msgstr "" - -#: cobc/cobc.c:2332 -#, fuzzy -msgid "only one of options 'E', 'S', 'C', 'c' may be specified" -msgstr "Alleen één van de opties 'E', 'S', 'C', 'c' mag worden opgegeven" - -#: cobc/cobc.c:2338 -#, fuzzy -msgid "only one of options 'm', 'x', 'b' may be specified" -msgstr "Alleen één van de opties 'E', 'S', 'C', 'c' mag worden opgegeven" - -#: cobc/cobc.c:2367 -#, c-format -msgid "-fdump= requires one of 'ALL', 'FD', 'WS', 'LS', 'RD', 'FD', 'SC' not '%s'" -msgstr "" - -#: cobc/cobc.c:2392 -#, c-format -msgid "'%s' is not an intrinsic function" -msgstr "'%s' is geen interne compiler functie" - -#: cobc/cobc.c:2434 cobc/cobc.c:7516 cobc/cobc.c:7630 cobc/codegen.c:3796 -#: cobc/codegen.c:3905 cobc/codegen.c:5221 cobc/codegen.c:12426 cobc/tree.c:789 -#: cobc/tree.c:1221 cobc/tree.c:4101 cobc/tree.c:4648 cobc/tree.c:4891 -#: cobc/typeck.c:3294 cobc/typeck.c:7812 cobc/typeck.c:7847 cobc/typeck.c:8660 -#: cobc/typeck.c:11261 cobc/typeck.c:11329 cobc/typeck.c:11397 -#: cobc/typeck.c:11681 cobc/typeck.c:11724 -#, fuzzy, c-format -msgid "call to '%s' with invalid parameter '%s'" -msgstr "FUNCTION '%s' heeft een ongeldige parameter" - -#: cobc/cobc.c:2737 -#, fuzzy -msgid "loading standard configuration file 'default.conf'" -msgstr "Ongeldige regel voortzetting" - -#: cobc/cobc.c:2871 -#, fuzzy -msgid "invalid output file name" -msgstr "Ongeldige uitvoer bestandsnaam" - -#: cobc/cobc.c:2971 -#, fuzzy, c-format -msgid "warning: '%s' is not a directory, defaulting to current directory" -msgstr "Waarschuwing - '%s' is geen map, huidige map wordt gebruikt" - -#: cobc/cobc.c:2998 -#, c-format -msgid "warning: %d lines per listing page specified, using %d" -msgstr "" - -#: cobc/cobc.c:3048 -#, fuzzy, c-format -msgid "warning: assuming '%s' is a DEFINE - did you intend to use -debug?" -msgstr "Waarschuwing - aangenomen wordt dat '%s' een DEFINE is - bedoelt u -debug?" - -#: cobc/cobc.c:3315 -#, fuzzy, c-format -msgid "unknown warning option '%s'" -msgstr "Onbekend label '%s'" - -#: cobc/cobc.c:3367 -#, fuzzy, c-format -msgid "%s option requires a listing file" -msgstr "%s: optie `%s' verwacht een argument\n" - -#: cobc/cobc.c:3374 -msgid "output to stdout only valid for preprocess" -msgstr "" - -#: cobc/cobc.c:3466 -msgid "all runtime checks are enabled" -msgstr "" - -#: cobc/cobc.c:3572 -msgid "only one stdin input allowed" -msgstr "" - -#: cobc/cobc.c:3582 -#, fuzzy, c-format -msgid "invalid file name parameter (length > %d)" -msgstr "Ongeldige bestandsnaam parameter" - -#: cobc/cobc.c:3807 -msgid "nothing for -j to run" -msgstr "" - -#: cobc/cobc.c:3883 cobc/cobc.c:4071 cobc/cobc.c:4130 cobc/cobc.c:4158 -#: cobc/cobc.c:4247 cobc/cobc.c:4306 cobc/cobc.c:4430 cobc/cobc.c:4469 -#: cobc/cobc.c:6993 -#, fuzzy -msgid "return status:" -msgstr "Retour status:" - -#: cobc/cobc.c:4361 -#, fuzzy -msgid "preprocessing:" -msgstr "Voorverwerking:" - -#: cobc/cobc.c:4435 -msgid "'cobxref' execution unsuccessful" -msgstr "Uitvoering 'xcobref' mislukt" - -#: cobc/cobc.c:4438 -#, fuzzy, c-format -msgid "check that 'cobxref' is in %s" -msgstr "Controleer of 'xcobref' voorkomt in %s" - -#: cobc/cobc.c:4440 -#, fuzzy -msgid "no listing produced" -msgstr "Geen lijst gemaakt" - -#: cobc/cobc.c:5328 cobc/cobc.c:5367 -msgid "No fields defined." -msgstr "" - -#: cobc/cobc.c:5387 -msgid "No labels defined." -msgstr "" - -#: cobc/cobc.c:5409 -msgid "Error/Warning summary:" -msgstr "" - -#: cobc/cobc.c:5453 -msgid "0 warnings in compilation group" -msgstr "" - -#: cobc/cobc.c:5457 -msgid "1 warning in compilation group" -msgstr "" - -#: cobc/cobc.c:5461 -#, c-format -msgid "%d warnings in compilation group" -msgstr "" - -#: cobc/cobc.c:5467 -#, fuzzy -msgid "0 errors in compilation group" -msgstr "Teveel fouten - Compilatie wordt afgebroken" - -#: cobc/cobc.c:5471 -#, fuzzy -msgid "1 error in compilation group" -msgstr "Teveel fouten - Compilatie wordt afgebroken" - -#: cobc/cobc.c:5475 -#, fuzzy, c-format -msgid "%d errors in compilation group" -msgstr "Teveel fouten - Compilatie wordt afgebroken" - -#: cobc/cobc.c:5481 -#, fuzzy, c-format -msgid "Too many errors in compilation group: %d maximum errors" -msgstr "Teveel fouten - Compilatie wordt afgebroken" - -#: cobc/cobc.c:6050 -#, c-format -msgid "%s: %d: Too many continuation lines" -msgstr "" - -#: cobc/cobc.c:6972 -#, fuzzy -msgid "parsing:" -msgstr "Ontleden:" - -#: cobc/cobc.c:7034 -#, fuzzy -msgid "translating:" -msgstr "Vertalen:" - -#: cobc/cobc.c:8157 -#, fuzzy -msgid "no input files" -msgstr "Geen invoer bestanden" - -#: cobc/cobc.c:8186 -#, fuzzy, c-format -msgid "%s option invalid in this combination" -msgstr "-o optie ongeldig bij deze combinatie" - -#: cobc/cobc.c:8227 -#, fuzzy -msgid "command line:" -msgstr "Opdracht regel:" - -#: cobc/codegen.c:973 cobc/codegen.c:4487 cobc/codegen.c:11093 -#, fuzzy -msgid "unexpected CONSTANT item" -msgstr "Onverwacht CONSTANT item" - -#: cobc/codegen.c:1188 cobc/codegen.c:1196 cobc/codegen.c:1291 -#: cobc/codegen.c:1603 cobc/codegen.c:2202 cobc/codegen.c:3212 -#: cobc/codegen.c:3455 cobc/codegen.c:3988 cobc/codegen.c:4454 -#: cobc/codegen.c:7902 cobc/codegen.c:8507 cobc/codegen.c:10298 -#: cobc/field.c:817 cobc/scanner.l:2104 cobc/tree.c:611 cobc/tree.c:3728 -#: cobc/typeck.c:5015 cobc/typeck.c:8662 cobc/typeck.c:9657 -#, fuzzy, c-format -msgid "unexpected tree tag: %d" -msgstr "Onverwacht boom label %d" - -#: cobc/codegen.c:2999 cobc/codegen.c:3295 cobc/codegen.c:8125 cobc/tree.c:1243 -#, fuzzy, c-format -msgid "unexpected cast type: %d" -msgstr "Onverwacht wijzigings type %d" - -#: cobc/codegen.c:3725 cobc/codegen.c:4434 -#, fuzzy, c-format -msgid "internal statement stack depth exceeded: %d" -msgstr "Interne statement stapel diepte overschreden -> %d" - -#: cobc/codegen.c:3798 -#, fuzzy, c-format -msgid "%s is not a field" -msgstr "'%s' is niet gedefinieerd" - -#: cobc/codegen.c:4186 cobc/codegen.c:4279 -#, fuzzy, c-format -msgid "unexpected function: %s" -msgstr "Onverwachte functie %s" - -#: cobc/codegen.c:4270 -#, fuzzy, c-format -msgid "unexpected operator: %c" -msgstr "Onverwachte operator -> %d" - -#: cobc/codegen.c:5043 -#, fuzzy, c-format -msgid "unexpected tree category: %d" -msgstr "Onverwachte boom categorie %d" - -#: cobc/codegen.c:5438 cobc/codegen.c:5465 cobc/codegen.c:5662 -#: cobc/codegen.c:5694 -#, fuzzy, c-format -msgid "unexpected size: %d" -msgstr "Onverwachte grootte" - -#: cobc/codegen.c:7254 -#, c-format -msgid "No ENTRY FOR GO TO '%s'" -msgstr "" - -#: cobc/codegen.c:7475 cobc/codegen.c:7725 -#, fuzzy, c-format -msgid "unexpected handler type: %d" -msgstr "Onverwacht wijzigings type %d" - -#: cobc/codegen.c:7823 -#, fuzzy -msgid "unexpected error_node parameter" -msgstr "Onverwachte error_node parameter" - -#: cobc/codegen.c:8146 -#, fuzzy, c-format -msgid "unexpected tree type: %d" -msgstr "Onverwacht boom type %d" - -#: cobc/codegen.c:8703 cobc/typeck.c:6511 cobc/typeck.c:12940 -#: cobc/typeck.c:12984 -#, fuzzy, c-format -msgid "compiler is not configured to support %s" -msgstr "Runtime library is niet geconfigureerd voor deze operatie" - -#: cobc/codegen.c:9128 -msgid "Nested OCCURS in report" -msgstr "" - -#: cobc/codeoptim.c:2762 -#, fuzzy, c-format -msgid "unexpected optimization value: %d" -msgstr "Onverwachte optimalisatie waarde" - -#: cobc/config.c:162 libcob/common.c:6786 libcob/common.c:6800 -#: libcob/common.c:7242 -#, fuzzy, c-format -msgid "invalid value '%s' for configuration tag '%s'" -msgstr "Ongeldige waarde voor '%s'" - -#: cobc/config.c:165 libcob/common.c:6093 libcob/common.c:6209 -#, c-format -msgid "should be one of the following values: %s" -msgstr "" - -#: cobc/config.c:167 -msgid "must be numeric" -msgstr "" - -#: cobc/config.c:169 libcob/common.c:6191 -#, c-format -msgid "maximum value: %lu" -msgstr "" - -#: cobc/config.c:171 -#, c-format -msgid "minimum value: %d" -msgstr "" - -#: cobc/config.c:203 -#, fuzzy, c-format -msgid "unsupported value '%s' for configuration tag '%s'" -msgstr "Ongeldige waarde voor '%s'" - -#: cobc/config.c:311 cobc/pplex.l:977 libcob/common.c:6702 -msgid "recursive inclusion" -msgstr "" - -#: cobc/config.c:386 libcob/common.c:6753 -#, fuzzy -msgid "configuration file was included here" -msgstr "Ongeldige regel voortzetting" - -#: cobc/config.c:415 -#, c-format -msgid "The previous loaded configuration '%s' will be discarded." -msgstr "" - -#: cobc/config.c:449 -msgid "missing definitions:" -msgstr "" - -#: cobc/config.c:451 -#, fuzzy, c-format -msgid "\tno definition of '%s'" -msgstr "%s: Geen definitie voor '%s'" - -#: cobc/config.c:512 -#, fuzzy, c-format -msgid "invalid configuration tag '%s'" -msgstr "Ongeldige regel voortzetting" - -#: cobc/config.c:525 libcob/common.c:6509 libcob/common.c:6592 -#: libcob/common.c:6620 -#, fuzzy, c-format -msgid "unknown configuration tag '%s'" -msgstr "Onbekend label '%s'" - -#: cobc/config.c:549 -#, fuzzy, c-format -msgid "invalid configuration tag '%s' in word-list" -msgstr "Ongeldige regel voortzetting" - -#: cobc/config.c:608 -#, c-format -msgid "Could not access word list for '%s'" -msgstr "" - -#: cobc/error.c:87 -#, fuzzy, c-format -msgid "in section '%s':" -msgstr "in sectie" - -#: cobc/error.c:98 -#, fuzzy, c-format -msgid "in paragraph '%s':" -msgstr "in paragraaf" - -#: cobc/error.c:121 libcob/common.c:7252 -msgid "configuration error:" -msgstr "" - -#: cobc/error.c:134 libcob/common.c:673 -#, c-format -msgid "system error %d" -msgstr "" - -#: cobc/error.c:231 cobc/error.c:323 cobc/error.c:478 -msgid "error [-Werror]: " -msgstr "" - -#: cobc/error.c:231 cobc/error.c:323 cobc/error.c:478 cobc/error.c:505 -#: libcob/common.c:6881 libcob/common.c:6906 -#, c-format -msgid "warning: " -msgstr "waarschuwing: " - -#: cobc/error.c:274 cobc/error.c:528 -msgid "error (ignored): " -msgstr "" - -#: cobc/error.c:364 cobc/error.c:380 cobc/error.c:563 cobc/error.c:584 -#, c-format -msgid "%s used" -msgstr "" - -#: cobc/error.c:367 cobc/error.c:566 -#, c-format -msgid "%s is archaic in %s" -msgstr "%s is verouderd in %s" - -#: cobc/error.c:371 cobc/error.c:570 -#, c-format -msgid "%s is obsolete in %s" -msgstr "%s is overbodig in %s" - -#: cobc/error.c:377 cobc/error.c:576 cobc/parser.y:5186 cobc/parser.y:5325 -#, c-format -msgid "%s ignored" -msgstr "%s genegeerd" - -#: cobc/error.c:383 cobc/error.c:586 -#, c-format -msgid "%s does not conform to %s" -msgstr "%s is niet in overeenstemming met %s" - -#: cobc/error.c:399 -msgid "configuration warning:" -msgstr "" - -#: cobc/error.c:621 cobc/error.c:640 -#, c-format -msgid "redefinition of '%s'" -msgstr "herdefinitie van '%s'" - -#: cobc/error.c:628 cobc/error.c:653 -#, c-format -msgid "'%s' previously defined here" -msgstr "'%s' eerder gedefinieerd hier" - -#: cobc/error.c:677 cobc/error.c:684 -#, c-format -msgid "'%s' is not defined" -msgstr "'%s' is niet gedefinieerd" - -#: cobc/error.c:680 -#, fuzzy, c-format -msgid "'%s' cannot be used here" -msgstr "'%s' kan hier niet worden geïndexeerd" - -#: cobc/error.c:682 cobc/parser.y:7009 -#, c-format -msgid "'%s' is not defined, but is a reserved word in another dialect" -msgstr "" - -#: cobc/error.c:716 -#, fuzzy, c-format -msgid "'%s' is ambiguous; needs qualification" -msgstr "%s onduidelijk; specificeer nader" - -#: cobc/error.c:746 cobc/parser.y:16748 -#, c-format -msgid "'%s' defined here" -msgstr "'%s' hier gedefinieerd" - -#: cobc/error.c:757 -#, fuzzy, c-format -msgid "fatal error: %s" -msgstr "BDB fout: %s" - -#: cobc/error.c:765 -#, fuzzy, c-format -msgid "group item '%s' cannot have %s clause" -msgstr "Groeps item '%s' kan geen %s clausule hebben" - -#: cobc/error.c:779 -#, c-format -msgid "constant item '%s' requires a %s clause" -msgstr "constante item '%s' verwacht een %s clausule" - -#: cobc/error.c:781 -#, c-format -msgid "level %02d item '%s' requires a %s clause" -msgstr "level %02d item '%s' verwacht een %s clausule" - -#: cobc/error.c:795 -#, c-format -msgid "constant item '%s' can only have a %s clause" -msgstr "constante item '%s' kan alleen een %s clausule hebben" - -#: cobc/error.c:797 -#, c-format -msgid "level %02d item '%s' can only have a %s clause" -msgstr "nivo %02d item '%s' kan alleen een %s clausule hebben" - -#: cobc/field.c:131 -msgid "constant expression has Divide by ZERO" -msgstr "" - -#: cobc/field.c:187 cobc/field.c:324 cobc/field.c:332 -msgid "missing right parenthesis" -msgstr "" - -#: cobc/field.c:216 -#, c-format -msgid "expression stack overflow at %d entries for operation '%c'" -msgstr "" - -#: cobc/field.c:257 -#, c-format -msgid "expression stack overflow at %d entries" -msgstr "" - -#: cobc/field.c:274 -msgid "missing left parenthesis" -msgstr "" - -#: cobc/field.c:315 -#, fuzzy, c-format -msgid "invalid operator '%s' in expression" -msgstr "Ongeldige expressie" - -#: cobc/field.c:334 -#, c-format -msgid "'%c' operator misplaced" -msgstr "" - -#: cobc/field.c:395 -#, c-format -msgid "invalid level number '%s'" -msgstr "ongeldig nivo nummer '%s'" - -#: cobc/field.c:454 -msgid "entry following SAME AS may not be subordinate to it" -msgstr "" - -#: cobc/field.c:459 cobc/field.c:496 -msgid "level number must begin with 01 or 77" -msgstr "nivo nummer moet beginnen met 01 of 77" - -#: cobc/field.c:541 cobc/field.c:557 -#, c-format -msgid "no previous data item of level %02d" -msgstr "geen eerder data item met nivo %02d" - -#: cobc/field.c:599 -#, c-format -msgid "'%s' cannot be qualified here" -msgstr "'%s' kan hier niet worden gespecificeerd" - -#: cobc/field.c:605 -#, c-format -msgid "'%s' cannot be subscripted here" -msgstr "'%s' kan hier niet worden geïndexeerd" - -#: cobc/field.c:617 -#, c-format -msgid "'%s' is not defined in '%s'" -msgstr "'%s' is niet gedefinieerd in '%s'" - -#: cobc/field.c:638 -#, fuzzy -msgid "level number of REDEFINES entries must be identical" -msgstr "Nivo nummer van REDEFINES beschrijvingen moet gelijk zijn" - -#: cobc/field.c:643 -#, fuzzy, c-format -msgid "'%s' is not the original definition" -msgstr "'%s' niet de originele definitie" - -#: cobc/field.c:758 -#, fuzzy, c-format -msgid "PICTURE clause not compatible with USAGE %s" -msgstr "'%s' PICTURE clausule niet compatibel met USAGE" - -#: cobc/field.c:855 cobc/field.c:930 cobc/field.c:941 -#, c-format -msgid "PICTURE clause required for '%s'" -msgstr "PICTURE clausule verplicht voor '%s'" - -#: cobc/field.c:937 -#, fuzzy, c-format -msgid "a non-numeric literal is expected for '%s'" -msgstr "Een niet numerieke constante is verwacht voor '%s'" - -#: cobc/field.c:949 -#, fuzzy, c-format -msgid "defining implicit picture size %d for '%s'" -msgstr "Aannemen impliciete opmaak grootte %d voor '%s'" - -#: cobc/field.c:969 -#, c-format -msgid "'%s' ANY LENGTH only allowed in LINKAGE" -msgstr "'%s' ANY LENGTH alleen toegestaan in LINKAGE" - -#: cobc/field.c:973 -#, c-format -msgid "'%s' ANY LENGTH must be 01 level" -msgstr "'%s' ANY LENGTH moet 01 nivo zijn" - -#: cobc/field.c:977 -#, fuzzy, c-format -msgid "'%s' ANY LENGTH cannot be BASED/EXTERNAL" -msgstr "'%s' ANY LENGTH kan niet in BASED/EXTERNAL" - -#: cobc/field.c:982 cobc/field.c:1010 -#, c-format -msgid "'%s' ANY LENGTH has invalid definition" -msgstr "'%s' ANY LENGTH heeft ongeldige definitie" - -#: cobc/field.c:993 -#, fuzzy, c-format -msgid "'%s' ANY NUMERIC must be PIC 9" -msgstr "'%s' ANY LENGTH moet een PICTURE hebben" - -#: cobc/field.c:998 -#, fuzzy, c-format -msgid "'%s' ANY LENGTH must be PIC X or PIC N" -msgstr "'%s' ANY LENGTH moet een PICTURE hebben" - -#: cobc/field.c:1008 -#, fuzzy, c-format -msgid "'%s' ANY NUMERIC has invalid definition" -msgstr "'%s' ANY LENGTH heeft ongeldige definitie" - -#: cobc/field.c:1026 -#, c-format -msgid "'%s' EXTERNAL must be specified at 01/77 level" -msgstr "'%s' EXTERNAL moet op 01/77 nivo worden gespecificeerd" - -#: cobc/field.c:1030 -#, c-format -msgid "'%s' EXTERNAL can only be specified in WORKING-STORAGE section" -msgstr "'%s' EXTERNAL kan alleen in WORKING-STORAGE sectie worden gespecificeerd" - -#: cobc/field.c:1034 -#, c-format -msgid "'%s' EXTERNAL and BASED are mutually exclusive" -msgstr "'%s' EXTERNAL en BASED sluiten elkaar uit" - -#: cobc/field.c:1037 -#, c-format -msgid "'%s' EXTERNAL not allowed with REDEFINES" -msgstr "'%s' EXTERNAL niet toegestaan met REDEFINES" - -#: cobc/field.c:1049 -#, c-format -msgid "'%s' BASED not allowed here" -msgstr "'%s' BASED niet toegestaan hier" - -#: cobc/field.c:1052 -#, c-format -msgid "'%s' BASED not allowed with REDEFINES" -msgstr "'%s' BASED niet toegestaan met REDEFINES" - -#: cobc/field.c:1055 -#, c-format -msgid "'%s' BASED only allowed at the 01 and 77 levels" -msgstr "'%s' BASED alleen toegestaan op 01 en 77 nivo's" - -#: cobc/field.c:1067 -#, fuzzy, c-format -msgid "level %02d item '%s' cannot have a %s clause" -msgstr "Nivo %02d item '%s' kan geen a %s clausule hebben" - -#: cobc/field.c:1082 -#, c-format -msgid "'%s' cannot have the OCCURS clause due to '%s'" -msgstr "'%s' OCCURS clausule kan niet vanwege '%s'" - -#: cobc/field.c:1101 -#, c-format -msgid "the original definition '%s' should not have OCCURS clause" -msgstr "de originele definitie '%s' mag geen OCCURS hebben" - -#: cobc/field.c:1108 -msgid "REDEFINES must follow the original definition" -msgstr "REDEFINES moet na de originele definitie" - -#: cobc/field.c:1115 -#, c-format -msgid "'%s' cannot be variable length" -msgstr "'%s' kan geen variabele lengte zijn" - -#: cobc/field.c:1118 -#, c-format -msgid "the original definition '%s' cannot be variable length" -msgstr "de originele definitie '%s' kan geen variabele lengte zijn" - -#: cobc/field.c:1142 -#, c-format -msgid "SCREEN group item '%s' has invalid clause" -msgstr "SCREEN groeps item '%s' heeft ongeldige clausule" - -#: cobc/field.c:1223 -#, fuzzy, c-format -msgid "%s USAGE %s incompatible with %s USAGE %s" -msgstr "%s clausule niet compatibel met USAGE %d" - -#: cobc/field.c:1302 -#, c-format -msgid "'%s' cannot have PICTURE clause" -msgstr "'%s' kan geen PICTURE clausule hebben" - -#: cobc/field.c:1318 cobc/field.c:1328 -#, fuzzy, c-format -msgid "%s item '%s' should be USAGE DISPLAY" -msgstr "'%s' is niet in LINKAGE SECTION" - -#: cobc/field.c:1351 -#, fuzzy, c-format -msgid "'%s' COMP-6 with sign - changing to COMP-3" -msgstr "'%s' COMP-6 met teken - Gewijzigd naar COMP-3" - -#: cobc/field.c:1377 -msgid "elementary items with SIGN clause must have S in PICTURE" -msgstr "" - -#: cobc/field.c:1380 -msgid "elementary items with SIGN clause must be USAGE DISPLAY or NATIONAL" -msgstr "" - -#: cobc/field.c:1397 -#, c-format -msgid "'%s' cannot have JUSTIFIED RIGHT" -msgstr "'%s' kan geen JUSTIFIED RIGHT zijn" - -#: cobc/field.c:1410 -#, fuzzy, c-format -msgid "'%s' cannot have S in PICTURE string and BLANK WHEN ZERO" -msgstr "'%s' kan geen BLANK WHEN ZERO zijn" - -#: cobc/field.c:1415 -#, c-format -msgid "'%s' cannot have BLANK WHEN ZERO without being USAGE DISPLAY or NATIONAL" -msgstr "" - -#: cobc/field.c:1426 -#, fuzzy, c-format -msgid "'%s' cannot have * in PICTURE string and BLANK WHEN ZERO" -msgstr "'%s' kan geen BLANK WHEN ZERO zijn" - -#: cobc/field.c:1433 -#, fuzzy, c-format -msgid "'%s' is not numeric, so cannot have BLANK WHEN ZERO" -msgstr "'%s' kan geen BLANK WHEN ZERO zijn" - -#: cobc/field.c:1446 -#, fuzzy -msgid "only level 88 items may have multiple values" -msgstr "Alleen nivo 88 item mag meerdere waarden hebben" - -#: cobc/field.c:1454 cobc/field.c:1458 -#, fuzzy, c-format -msgid "initial VALUE clause ignored for %s item '%s'" -msgstr "Eerste VALUE clausule genegeerd voor EXTERNAL item" - -#: cobc/field.c:1471 -msgid "FULL has no effect on numeric items; you may want REQUIRED or PIC Z" -msgstr "" - -#: cobc/field.c:1499 -msgid "VALUE may not contain a figurative constant" -msgstr "" - -#: cobc/field.c:1507 -msgid "cannot specify both FULL and JUSTIFIED" -msgstr "" - -#: cobc/field.c:1519 -#, c-format -msgid "'%s' has FROM, TO or USING without PIC; PIC will be implied" -msgstr "" - -#: cobc/field.c:1533 -#, c-format -msgid "'%s' has numeric VALUE without PIC; PIC will be implied" -msgstr "" - -#: cobc/field.c:1548 -#, c-format -msgid "'%s' cannot have PIC without FROM, TO, USING or numeric VALUE" -msgstr "" - -#: cobc/field.c:1560 -#, c-format -msgid "'%s' needs a PIC, FROM, TO, USING, VALUE, BELL, BLANK or ERASE clause" -msgstr "" - -#: cobc/field.c:1574 -msgid "cannot specify both PIC and VALUE" -msgstr "" - -#: cobc/field.c:1582 -msgid "cannot have PIC without FROM, TO or USING" -msgstr "" - -#: cobc/field.c:1591 -msgid "cannot have FROM, TO or USING without PIC" -msgstr "" - -#: cobc/field.c:1600 -#, fuzzy -msgid "VALUE item may not be numeric" -msgstr "INITIALIZED TO item is niet alfanumeriek" - -#: cobc/field.c:1616 -#, c-format -msgid "'%s' needs a PIC, COL, LINE, VALUE, BELL or BLANK clause" -msgstr "" - -#: cobc/field.c:1647 -msgid "cannot use AUTO, FULL, PROMPT, REQUIRED or SECURE on elementary item without TO or USING" -msgstr "" - -#: cobc/field.c:1654 -msgid "cannot use BLANK WHEN ZERO, JUSTIFIED, OCCURS or SIGN on item without FROM, TO or USING" -msgstr "" - -#: cobc/field.c:1674 -msgid "cannot use AUTO, FULL, REQUIRED or SECURE on elementary item without FROM, TO or USING" -msgstr "" - -#: cobc/field.c:1679 -msgid "cannot use BLANK WHEN ZERO, JUSTIFIED or SIGN without FROM, TO or USING" -msgstr "" - -#: cobc/field.c:1697 -#, fuzzy -msgid "cannot have BLANK WHEN ZERO without PIC" -msgstr "'%s' kan geen BLANK WHEN ZERO zijn" - -#: cobc/field.c:1700 -#, fuzzy -msgid "cannot have JUSTIFIED without PIC" -msgstr "'%s' kan geen JUSTIFIED RIGHT zijn" - -#: cobc/field.c:1720 -msgid "cannot have AUTO without FROM, TO or USING" -msgstr "" - -#: cobc/field.c:1725 -msgid "cannot use FULL or REQUIRED on item without TO or USING" -msgstr "" - -#: cobc/field.c:1732 -msgid "SECURE can be used with TO only" -msgstr "" - -#: cobc/field.c:1734 -#, fuzzy -msgid "SECURE must be used with TO" -msgstr "READ moet eerst worden uitgevoerd" - -#: cobc/field.c:1753 -#, fuzzy, c-format -msgid "'%s' does nothing" -msgstr "'%s' is niet gedefinieerd" - -#: cobc/field.c:1797 -msgid "BLANK ZERO not compatible with USAGE" -msgstr "BLANK ZERO niet compatibel met USAGE" - -#: cobc/field.c:1800 -#, fuzzy -msgid "SIGN clause not compatible with USAGE" -msgstr "%s clausule niet compatibel met USAGE %d" - -#: cobc/field.c:1977 -#, fuzzy, c-format -msgid "'%s' PICTURE clause not compatible with USAGE" -msgstr "'%s' PICTURE clausule niet compatibel met USAGE" - -#: cobc/field.c:2027 -#, fuzzy, c-format -msgid "'%s' 77 level is not allowed here" -msgstr "'%s' 77 nivo hier niet toegestaan" - -#: cobc/field.c:2424 -msgid "OCCURS and multi COLUMNs is not allowed" -msgstr "" - -#: cobc/field.c:2452 -#, fuzzy, c-format -msgid "duplicate LINE %d ignored" -msgstr "Dubbele definitie '%s' - Negeren" - -#: cobc/field.c:2469 -#, fuzzy, c-format -msgid "ignoring SYNCHRONIZED for group item '%s'" -msgstr "SYNCHRONIZED genegeerd voor groep item '%s'" - -#: cobc/field.c:2485 cobc/field.c:2498 cobc/field.c:2778 cobc/field.c:2781 -#, fuzzy, c-format -msgid "size of '%s' larger than size of '%s'" -msgstr "Lengte van '%s' groter dan lengte van '%s'" - -#: cobc/field.c:2638 cobc/field.c:2703 -#, fuzzy, c-format -msgid "'%s' cannot be larger than %d bytes" -msgstr "'%s' kan niet groter zijn dan %d bytes" - -#: cobc/field.c:2676 cobc/field.c:2684 -#, c-format -msgid "'%s' binary field cannot be larger than %d digits" -msgstr "'%s' binair veld kan niet groter zijn dan %d cijfers" - -#: cobc/field.c:2764 cobc/field.c:3216 -#, c-format -msgid "unexpected USAGE: %d" -msgstr "onbekende USAGE: %d" - -#: cobc/field.c:2876 -#, fuzzy -msgid "literal type does not match numeric data type" -msgstr "Constante type komt niet overeen met data type" - -#: cobc/field.c:2953 -#, c-format -msgid "THRU item '%s' may not come before '%s'" -msgstr "" - -#: cobc/field.c:2976 -#, c-format -msgid "RENAMES cannot start/end at the OCCURS item '%s'" -msgstr "" - -#: cobc/field.c:2984 -#, c-format -msgid "cannot use RENAMES on part of the table '%s'" -msgstr "" - -#: cobc/field.c:3022 -#, c-format -msgid "RENAMES may not contain '%s' as it is a pointer or object reference" -msgstr "" - -#: cobc/field.c:3027 -#, c-format -msgid "RENAMES may not contain '%s' as it is an OCCURS DEPENDING table" -msgstr "" - -#: cobc/field.c:3049 -msgid "RENAMES of 01-, 66- and 77-level items" -msgstr "" - -#: cobc/field.c:3051 -#, fuzzy -msgid "RENAMES may not reference a level 88" -msgstr "RENAMES mag niet verwijzen naar een 01 of > 50 nivo" - -#: cobc/field.c:3075 -#, c-format -msgid "'%s' must immediately follow the record '%s'" -msgstr "" - -#: cobc/field.c:3083 -#, c-format -msgid "THRU item must be different to '%s'" -msgstr "" - -#: cobc/field.c:3089 -#, c-format -msgid "'%s' and '%s' must be in the same record" -msgstr "" - -#: cobc/field.c:3100 -#, c-format -msgid "THRU item '%s' may not be subordinate to '%s'" -msgstr "" - -#: cobc/flag.def:40 -msgid "" -" -fstack-size=\tdefine PERFORM stack size\n" -" * default: 255" -msgstr "" - -#: cobc/flag.def:44 -#, fuzzy -msgid "" -" -fsign=[ASCII|EBCDIC]\tdefine display sign representation\n" -" * default: machine native" -msgstr "" -"Definieer display teken representatie\n" -"\t\t\t- ASCII of EBCDIC (Standaard : machine native)" - -#: cobc/flag.def:48 -#, fuzzy -msgid "" -" -ffold-copy=[UPPER|LOWER]\tfold COPY subject to value\n" -" * default: no transformation" -msgstr "" -"Transformeer COPY naar waarde\n" -"\t\t\t- UPPER of LOWER (Standaard : geen transformatie)" - -#: cobc/flag.def:52 -msgid "" -" -ffold-call=[UPPER|LOWER]\tfold PROGRAM-ID, CALL, CANCEL subject to value\n" -" * default: no transformation" -msgstr "" - -#: cobc/flag.def:56 -msgid "" -" -fdefaultbyte=\tinitialize fields without VALUE to value\n" -" * decimal 0..255 or any quoted character\n" -" * default: initialize to picture" -msgstr "" - -#: cobc/flag.def:61 -msgid "" -" -fmax-errors=\tmaximum number of errors to report before\n" -" compilation is aborted\n" -" * default: 128" -msgstr "" - -#: cobc/flag.def:68 -msgid "" -" -fintrinsics=[ALL|intrinsic function name(,name,...)]\n" -" intrinsics to be used without FUNCTION keyword" -msgstr "" - -#: cobc/flag.def:72 -msgid "" -" -fdump= dump data fields on abort, may be\n" -" a combination of: ALL, WS, LS, RD, FD, SC" -msgstr "" - -#: cobc/flag.def:76 -msgid "" -" -fcallfh= use external provided EXTFH interface module\n" -" for I/O" -msgstr "" - -#: cobc/flag.def:80 -msgid "" -" -fsqldb= which Database is used, may be\n" -" MySQL, MSSQL, Oracle10, Oracle11, Oracle12" -msgstr "" - -#: cobc/flag.def:84 -msgid " -fsqlschema= define database schema name" -msgstr "" - -#: cobc/flag.def:91 -msgid "" -" -fno-recursive-check disable check of recursive program call;\n" -" effectively compiling as RECURSIVE program" -msgstr "" - -#: cobc/flag.def:95 -#, fuzzy -msgid "" -" -fwinmain generate WinMain instead of main when compiling\n" -" as executable" -msgstr " -i, -info Toont compiler bouw informatie" - -#: cobc/flag.def:99 -#, fuzzy -msgid " -fcomputed-goto generate computed goto C statements" -msgstr "Genereer berekende goto C statements" - -#: cobc/flag.def:102 -#, fuzzy -msgid " -falternate-ebcdic use restricted ASCII to EBCDIC translate" -msgstr "Gebruik beperkte ASCII naar EBCDIC vertaling" - -#: cobc/flag.def:105 -msgid " -fextra-brace generate extra braces in C source" -msgstr "" - -#: cobc/flag.def:108 -msgid " -fgen-c-line-directives\tgenerate source location directives in C code" -msgstr "" - -#: cobc/flag.def:111 -msgid " -fgen-c-labels generate extra labels in C sources" -msgstr "" - -#: cobc/flag.def:114 -#, fuzzy -msgid " -fcorrect-numeric attempt correction of invalid numeric display items" -msgstr "Probeer fouten in numerieke display items te corrigeren" - -#: cobc/flag.def:117 -#, fuzzy -msgid " -fstack-on-heap PERFORM stack allocated on heap" -msgstr "PERFORM stapel gealloceerd in dynamisch geheugen" - -#: cobc/flag.def:120 -msgid " -ffast-math Disables emitting faster arithmetic logic" -msgstr "" - -#: cobc/flag.def:125 -msgid "" -" -fno-remove-unreachable\tdisable remove of unreachable code\n" -" * turned off by -g" -msgstr "" - -#: cobc/flag.def:129 -msgid " -finline-intrinsic\twhen possible resolve intrinsic FUNCTIONs at compile time" -msgstr "" - -#: cobc/flag.def:132 -#, fuzzy -msgid "" -" -ftrace generate trace code\n" -" * scope: executed SECTION/PARAGRAPH" -msgstr "" -" -Xref Genereer kruisverwijzing door 'cobxref'\n" -" (V. Coen's 'cobxref' moet in het pad staan" - -#: cobc/flag.def:136 -#, fuzzy -msgid "" -" -ftraceall generate trace code\n" -" * scope: executed SECTION/PARAGRAPH/STATEMENTS\n" -" * turned on by -debug" -msgstr "" -"Genereer trace code\n" -"\t\t\t- SECTIE/PARAGRAAF/STATEMENTS uitgevoerd\t\t\t- Ingeschakeld door -debug" - -#: cobc/flag.def:141 -#, fuzzy -msgid " -fsyntax-only syntax error checking only; don't emit any output" -msgstr "Alleen syntaxis fout controle; maak geen uitvoer" - -#: cobc/flag.def:144 -#, fuzzy -msgid "" -" -fdebugging-line enable debugging lines\n" -" * 'D' in indicator column or floating >>D" -msgstr "" -"Inschakelen debugging regels\n" -"\t\t\t- 'D' in indicator kolom of zwervende >>D" - -#: cobc/flag.def:148 -#, fuzzy -msgid "" -" -fsource-location generate source location code\n" -" * turned on by -debug/-g/-ftraceall" -msgstr "" -"Genereer bron locatie code\n" -"\t\t\t- Ingeschakeld door -debug/-g/-ftraceall" - -#: cobc/flag.def:152 -#, fuzzy -msgid " -fimplicit-init automatic initialization of the COBOL runtime system" -msgstr "Automatische initialisatie van het Cobol runtime systeem" - -#: cobc/flag.def:155 -#, fuzzy -msgid "" -" -fstack-check PERFORM stack checking\n" -" * turned on by -debug or -g" -msgstr "" -"Doe stapel controle\n" -"\t\t\t- Ingeschakeld door -debug of -g" - -#: cobc/flag.def:159 -#, fuzzy -msgid "" -" -fwrite-after use AFTER 1 for WRITE of LINE SEQUENTIAL\n" -" * default: BEFORE 1" -msgstr "" -"Gebruik AFTER 1 voor WRITE bij LINE SEQUENTIAL\n" -"\t\t\t- Standaard : BEFORE 1" - -#: cobc/flag.def:163 -#, fuzzy -msgid "" -" -fmfcomment '*' or '/' in column 1 treated as comment\n" -" * FIXED format only" -msgstr "" -"Zie '*' of '/' in kolom 1 als commentaar\n" -"\t\t\t- Alleen bij vast formaat" - -#: cobc/flag.def:167 -msgid "" -" -facucomment '$' in indicator area treated as '*',\n" -" '|' treated as floating comment" -msgstr "" - -#: cobc/flag.def:171 -#, fuzzy -msgid "" -" -fnotrunc allow numeric field overflow\n" -" * non-ANSI behaviour" -msgstr "" -"Sta overloop toe in numerieke velden\n" -"\t\t\t- Non-ANSI gedrag" - -#: cobc/flag.def:175 -msgid "" -" -fodoslide adjust items following OCCURS DEPENDING\n" -" * implies -fcomplex-odo" -msgstr "" - -#: cobc/flag.def:179 -#, fuzzy -msgid "" -" -fsingle-quote use a single quote (apostrophe) for QUOTE\n" -" * default: double quote" -msgstr "" -"Gebruik een enkel aanhalingsteken (apostrof) voor QUOTE\n" -"\t\t\t- Standaard : dubbel aanhalingsteken" - -#: cobc/flag.def:189 -#, fuzzy -msgid "" -" -foptional-file treat all files as OPTIONAL\n" -" * unless NOT OPTIONAL specified" -msgstr "" -"Behandel alle bestanden als OPTIONAL\n" -"\t\t\t- tenzij NOT OPTIONAL is gespecificeerd" - -#: cobc/flag.def:193 -#, fuzzy -msgid " -fstatic-call output static function calls for the CALL statement" -msgstr "Uitvoer statische functie roept een CALL statement aan" - -#: cobc/flag.def:196 -msgid "" -" -fno-gen-c-decl-static-call\tdisable generation of C function declations\n" -" for subroutines with static CALL" -msgstr "" - -#: cobc/flag.def:200 -msgid " -fmf-files Sequential & Relative files will match Micro Focus format" -msgstr "" - -#: cobc/flag.def:203 -msgid "" -" -fno-theaders suppress all headers and output of compilation\n" -" options from listing while keeping page breaks" -msgstr "" - -#: cobc/flag.def:207 -#, fuzzy -msgid " -fno-tsource suppress source from listing" -msgstr " -free Gebruik vrij bron formaat" - -#: cobc/flag.def:210 -msgid " -fno-tmessages suppress warning and error summary from listing" -msgstr "" - -#: cobc/flag.def:213 -#, fuzzy -msgid " -ftsymbols specify symbols in listing" -msgstr " -free Gebruik vrij bron formaat" - -#: cobc/parser.y:283 cobc/parser.y:317 -#, fuzzy, c-format -msgid "unreachable statement '%s'" -msgstr "Statement wordt niet bereikt '%s'" - -#: cobc/parser.y:410 cobc/parser.y:703 -#, c-format -msgid "'%s' is not in LINKAGE SECTION" -msgstr "'%s' is niet in LINKAGE SECTION" - -#: cobc/parser.y:413 cobc/typeck.c:3705 -#, fuzzy, c-format -msgid "'%s' cannot be BASED/EXTERNAL" -msgstr "'%s' mag niet BASED/EXTERNAL zijn" - -#: cobc/parser.y:418 -#, c-format -msgid "'%s' is not in WORKING-STORAGE SECTION" -msgstr "'%s' is niet in WORKING-STORAGE SECTION" - -#: cobc/parser.y:425 cobc/typeck.c:3702 -#, c-format -msgid "'%s' not level 01 or 77" -msgstr "'%s' niet nivo 01 of 77" - -#: cobc/parser.y:428 cobc/parser.y:443 cobc/typeck.c:3708 -#, c-format -msgid "'%s' REDEFINES field not allowed here" -msgstr "'%s' REDEFINES veld hier niet toegestaan" - -#: cobc/parser.y:456 -#, c-format -msgid "'%s' USING item duplicates RETURNING item" -msgstr "'%s' USING item multipliceert RETURNING item" - -#: cobc/parser.y:466 -#, c-format -msgid "ENTRY '%s' duplicated" -msgstr "ENTRY '%s' dubbel" - -#: cobc/parser.y:502 -#, fuzzy, c-format -msgid "ENTRY FOR GO TO '%s' duplicated" -msgstr "ENTRY '%s' dubbel" - -#: cobc/parser.y:518 -#, fuzzy, c-format -msgid "maximum nested program depth exceeded (%d)" -msgstr "Maximum aantal insluitende programma's overschreden (%d)" - -#: cobc/parser.y:544 cobc/parser.y:571 -#, fuzzy, c-format -msgid "%s statement not terminated by %s" -msgstr "%s statement niet afgesloten met END-%s" - -#: cobc/parser.y:574 -#, fuzzy, c-format -msgid "%s statement not terminated" -msgstr "%s statement niet afgesloten met END-%s" - -#: cobc/parser.y:638 -msgid "USE statement invalid for SORT file" -msgstr "USE statement ongeldig voor SORT bestand" - -#: cobc/parser.y:665 cobc/parser.y:667 -#, fuzzy, c-format -msgid "duplicate %s clause" -msgstr "Dubbele %s clausule" - -#: cobc/parser.y:685 -#, c-format -msgid "Cannot specify %s without number of lines on page" -msgstr "" - -#: cobc/parser.y:695 -#, c-format -msgid "maximum OCCURS depth exceeded (%d)" -msgstr "maximum OCCURS diepte overschreden (%d)" - -#: cobc/parser.y:709 cobc/parser.y:711 cobc/parser.y:6808 cobc/parser.y:6811 -#: cobc/parser.y:6813 cobc/parser.y:6815 cobc/parser.y:6850 cobc/parser.y:7573 -#: cobc/parser.y:7575 cobc/parser.y:7577 cobc/parser.y:7579 cobc/parser.y:7625 -#: cobc/parser.y:7634 cobc/parser.y:9548 cobc/parser.y:10994 -#: cobc/parser.y:12370 cobc/parser.y:13552 -#, c-format -msgid "%s and %s are mutually exclusive" -msgstr "%s and %s sluiten elkaar uit" - -#: cobc/parser.y:725 cobc/parser.y:729 -msgid "TO phrase without DEPENDING phrase" -msgstr "" - -#: cobc/parser.y:726 -msgid "maximum number of occurrences assumed to be exact number" -msgstr "" - -#: cobc/parser.y:733 cobc/parser.y:7355 -msgid "OCCURS TO must be greater than OCCURS FROM" -msgstr "" - -#: cobc/parser.y:742 -#, fuzzy -msgid "OCCURS DEPENDING ON without TO phrase" -msgstr "GO TO met meerdere procedure-namen" - -#: cobc/parser.y:808 -#, c-format -msgid "%s header missing - assumed" -msgstr "%s kop ontbreekt - veronderstelt" - -#: cobc/parser.y:810 -#, c-format -msgid "%s header missing" -msgstr "%s kop ontbreekt" - -#: cobc/parser.y:942 -#, fuzzy, c-format -msgid "duplicate %s" -msgstr "Dubbele %s clausule" - -#: cobc/parser.y:944 -#, c-format -msgid "%s incorrectly after %s" -msgstr "" - -#: cobc/parser.y:1046 -#, fuzzy, c-format -msgid "redefinition of program name '%s'" -msgstr "Herdefinitie van '%s'" - -#: cobc/parser.y:1050 -#, fuzzy, c-format -msgid "redefinition of program ID '%s'" -msgstr "Herdefinitie van '%s'" - -#: cobc/parser.y:1082 -#, c-format -msgid "FUNCTION '%s' has no PROCEDURE DIVISION" -msgstr "" - -#: cobc/parser.y:1188 -msgid "functions may not be defined within a program/function" -msgstr "" - -#: cobc/parser.y:1238 -#, fuzzy, c-format -msgid "END FUNCTION '%s' is different from FUNCTION-ID '%s'" -msgstr "END FUNCTION '%s' verschilt met FUNCTION-ID '%s'" - -#: cobc/parser.y:1252 -#, fuzzy, c-format -msgid "END PROGRAM '%s' is different from PROGRAM-ID '%s'" -msgstr "END PROGRAM '%s' verschilt met PROGRAM-ID '%s'" - -#: cobc/parser.y:1301 -#, fuzzy -msgid "currency symbol must be one character long" -msgstr "'%s' CURSOR is niet 4 of 6 karakters lang" - -#: cobc/parser.y:1358 -#, fuzzy, c-format -msgid "invalid character '%c' in currency symbol" -msgstr "Ongeldige expressie" - -#: cobc/parser.y:1374 -msgid "prototype has same name as current function and will be ignored" -msgstr "" - -#: cobc/parser.y:1401 -#, c-format -msgid "duplicate REPOSITORY entries for '%s' do not match" -msgstr "" - -#: cobc/parser.y:1405 -#, c-format -msgid "duplicate REPOSITORY entry for '%s'" -msgstr "" - -#: cobc/parser.y:1470 -#, c-format -msgid "ORGANIZATION %s is incompatible with RECORD DELIMITER" -msgstr "" - -#: cobc/parser.y:1502 -#, c-format -msgid "illegal combination of %s with other clauses" -msgstr "" - -#: cobc/parser.y:1517 cobc/parser.y:1520 cobc/parser.y:1551 -#, c-format -msgid "cannot specify both %s and %s" -msgstr "" - -#: cobc/parser.y:1548 -#, c-format -msgid "cannot specify both %s and %s; %s is ignored" -msgstr "" - -#: cobc/parser.y:1720 -msgid "FOR phrase cannot immediately follow ALL/LEADING/TRAILING" -msgstr "" - -#: cobc/parser.y:1722 -msgid "missing CHARACTERS/ALL/LEADING/TRAILING phrase after FOR phrase" -msgstr "" - -#: cobc/parser.y:1729 -#, fuzzy -msgid "missing value between ALL/LEADING/TRAILING words" -msgstr "ALL, LEADING of TRAILING verwacht voor '%s'" - -#: cobc/parser.y:1734 -msgid "missing FOR phrase before CHARACTERS/ALL/LEADING/TRAILING phrase" -msgstr "" - -#: cobc/parser.y:1741 -#, fuzzy -msgid "missing ALL/LEADING/TRAILING before value" -msgstr "ALL, LEADING of TRAILING verwacht voor '%s'" - -#: cobc/parser.y:1796 -msgid "use of condition-name in place of data-name" -msgstr "" - -#: cobc/parser.y:1800 cobc/parser.y:6753 cobc/typeck.c:665 -#, fuzzy, c-format -msgid "condition-name not allowed here: '%s'" -msgstr "Verwijzingsmodificatie hier niet toegestaan" - -#: cobc/parser.y:1827 -msgid "cannot specify NO ADVANCING in screen DISPLAY" -msgstr "" - -#: cobc/parser.y:1899 cobc/parser.y:1916 -msgid "non-standard DISPLAY" -msgstr "" - -#: cobc/parser.y:1903 -msgid "screens may only be displayed on CRT" -msgstr "" - -#: cobc/parser.y:1908 cobc/parser.y:1951 -msgid "cannot mix screens and fields in the same DISPLAY statement" -msgstr "" - -#: cobc/parser.y:1912 -msgid "screen clauses may only be used for DISPLAY on CRT" -msgstr "" - -#: cobc/parser.y:1957 -msgid "ambiguous DISPLAY; put items to display on device in separate DISPLAY" -msgstr "" - -#: cobc/parser.y:1973 -#, fuzzy, c-format -msgid "%s is not an alphanumeric literal" -msgstr "'%s' is geen numerieke waarde" - -#: cobc/parser.y:1975 -#, fuzzy, c-format -msgid "'%s' is not USAGE DISPLAY" -msgstr "'%s' is niet in LINKAGE SECTION" - -#: cobc/parser.y:1990 cobc/typeck.c:8481 -#, fuzzy, c-format -msgid "invalid target for %s" -msgstr "Ongeldig type voor '%s'" - -#: cobc/parser.y:1997 cobc/parser.y:6747 -#, fuzzy -msgid "SCREEN item cannot be used here" -msgstr "'%s' kan hier niet worden geïndexeerd" - -#: cobc/parser.y:1999 -#, fuzzy -msgid "RENAMES item may not be used here" -msgstr "Hier mag geen constante worden gebruikt - '%s'" - -#: cobc/parser.y:2001 cobc/typeck.c:2333 cobc/typeck.c:2429 -msgid "ANY LENGTH item not allowed here" -msgstr "ANY LENGTH item hier niet toegestaan" - -#: cobc/parser.y:2005 -#, c-format -msgid "item '%s' has wrong class for VALIDATE" -msgstr "" - -#: cobc/parser.y:2014 -#, fuzzy -msgid "WHEN clause must follow EVERY clause" -msgstr "REDEFINES clausule moet na ENTRY naam komen" - -#: cobc/parser.y:2096 cobc/parser.y:17197 -#, fuzzy -msgid "non-zero value expected" -msgstr "Geheel getal waarde" - -#: cobc/parser.y:2102 cobc/tree.c:4352 -#, fuzzy, c-format -msgid "RECORD size (IDX) exceeds maximum allowed (%d)" -msgstr "RECORD grootte overschrijdt het toegestane maximum (%d)" - -#: cobc/parser.y:2106 cobc/tree.c:4355 -#, c-format -msgid "RECORD size exceeds maximum allowed (%d)" -msgstr "RECORD grootte overschrijdt het toegestane maximum (%d)" - -#: cobc/parser.y:2111 -msgid "RECORD clause invalid" -msgstr "RECORD clausule ongeldig" - -#: cobc/parser.y:3188 -#, fuzzy -msgid "multiple PROGRAM-ID's without matching END PROGRAM" -msgstr "Meerdere PROGRAM-ID's zonder bijbehorend END PROGRAM" - -#: cobc/parser.y:3191 -#, fuzzy -msgid "executable requested but no program found" -msgstr "Uitvoerbaar programma gevraagd maar geen programma gevonden" - -#: cobc/parser.y:3408 cobc/parser.y:3417 -msgid "COMMON may only be used in a contained program" -msgstr "COMMON mag alleen worden gebruikt in een bijgesloten programma" - -#: cobc/parser.y:3426 cobc/parser.y:3458 -msgid "CALL prototypes" -msgstr "" - -#: cobc/parser.y:3607 cobc/parser.y:3884 cobc/parser.y:3928 cobc/parser.y:4036 -#: cobc/parser.y:4223 cobc/parser.y:4319 cobc/parser.y:4360 cobc/parser.y:4431 -#: cobc/parser.y:4452 cobc/parser.y:4531 cobc/parser.y:4550 cobc/parser.y:4566 -#: cobc/parser.y:4584 cobc/parser.y:4602 cobc/parser.y:4619 cobc/parser.y:4637 -#: cobc/parser.y:6868 cobc/parser.y:7694 -#, c-format -msgid "%s not allowed in nested programs" -msgstr "%s niet toegestaan in ingesloten programma's" - -#: cobc/parser.y:3761 -msgid "segment-number must be in range of values 1 to 49" -msgstr "" - -#: cobc/parser.y:3773 -#, fuzzy -msgid "duplicate CLASSIFICATION clause" -msgstr "Dubbele CLASSIFICATION clausule" - -#: cobc/parser.y:3849 -msgid "PROGRAM phrase" -msgstr "" - -#: cobc/parser.y:3944 cobc/parser.y:3955 cobc/parser.y:4271 -#, fuzzy, c-format -msgid "invalid %s clause" -msgstr "Ongeldige CRT clausule" - -#: cobc/parser.y:4386 cobc/parser.y:4390 -msgid "CLASS literal with THRU must have size 1" -msgstr "CLASS constante met THRU moet een grootte van 1 zijn" - -#: cobc/parser.y:4417 -#, fuzzy -msgid "CLASS IS integer IN alphabet-name" -msgstr "'%s' is geen alfabet naam" - -#: cobc/parser.y:4464 -msgid "separate currency symbol and currency string" -msgstr "" - -#: cobc/parser.y:4497 -#, fuzzy, c-format -msgid "invalid CURRENCY SIGN '%s'" -msgstr "Ongeldige ENTRY '%s'%s" - -#: cobc/parser.y:4715 -msgid "cannot use RELATIVE KEY clause on INDEXED files" -msgstr "" - -#: cobc/parser.y:4719 -msgid "cannot use RECORD KEY clause on RELATIVE files" -msgstr "" - -#: cobc/parser.y:4793 -msgid "EXTERNAL/DYNAMIC cannot be used with literals" -msgstr "" - -#: cobc/parser.y:4813 -msgid "EXTERNAL/DYNAMIC cannot be used with USING/VARYING" -msgstr "" - -#: cobc/parser.y:4824 -msgid "EXTERNAL/DYNAMIC cannot be used with DISK FROM" -msgstr "" - -#: cobc/parser.y:4826 -msgid "ASSIGN DISK FROM" -msgstr "" - -#: cobc/parser.y:4942 -msgid "ASSIGN EXTERNAL/DYNAMIC" -msgstr "" - -#: cobc/parser.y:5165 -#, fuzzy, c-format -msgid "'%s' is not an alphabet-name" -msgstr "'%s' is geen alfabet naam" - -#: cobc/parser.y:5254 -#, c-format -msgid "%s only valid with ORGANIZATION %s" -msgstr "" - -#: cobc/parser.y:5321 cobc/parser.y:5344 -#, fuzzy, c-format -msgid "RECORD DELIMITER %s only allowed with SEQUENTIAL files" -msgstr "START niet toegestaan bij SEQUENTIAL bestanden" - -#: cobc/parser.y:5323 cobc/parser.y:5336 cobc/parser.y:5348 cobc/parser.y:5358 -#, fuzzy -msgid "RECORD DELIMITER clause" -msgstr "LOCK clausule ongeldig hier" - -#: cobc/parser.y:5332 -#, fuzzy, c-format -msgid "RECORD DELIMITER %s only allowed with (LINE) SEQUENTIAL files" -msgstr "OPEN I-O niet toegestaan bij LINE SEQUENTIAL bestanden" - -#: cobc/parser.y:5337 -msgid "LINE-SEQUENTIAL phrase" -msgstr "" - -#: cobc/parser.y:5349 -msgid "BINARY-SEQUENTIAL phrase" -msgstr "" - -#: cobc/parser.y:5357 -#, fuzzy -msgid "RECORD DELIMITER clause only allowed with (LINE) SEQUENTIAL files" -msgstr "RECORD clausule genegeerd voor LINE SEQUENTIAL" - -#: cobc/parser.y:5360 -#, c-format -msgid "RECORD DELIMITER %s not recognized; will be ignored" -msgstr "" - -#: cobc/parser.y:5398 -msgid "DUPLICATES for primary keys" -msgstr "" - -#: cobc/parser.y:5637 -msgid "DOS/VS APPLY phrase" -msgstr "" - -#: cobc/parser.y:5752 -msgid "RECORD description missing or invalid" -msgstr "RECORD beschrijving ontbreekt of ongeldig" - -#: cobc/parser.y:5778 -#, fuzzy, c-format -msgid "duplicate file description for %s" -msgstr "Dubbele waarden in class '%s'" - -#: cobc/parser.y:5811 cobc/parser.y:5821 -#, fuzzy -msgid "file cannot have both EXTERNAL and GLOBAL clauses" -msgstr "Bestand kan niet zowel EXTERNAL als GLOBAL clausules hebben" - -#: cobc/parser.y:5825 cobc/parser.y:6414 cobc/parser.y:6853 cobc/parser.y:12363 -#: cobc/parser.y:15305 -#, fuzzy, c-format -msgid "%s is invalid in a user FUNCTION" -msgstr "%s is ongeldig in FUNCTION" - -#: cobc/parser.y:5863 cobc/parser.y:5872 -msgid "RECORD clause ignored for LINE SEQUENTIAL" -msgstr "RECORD clausule genegeerd voor LINE SEQUENTIAL" - -#: cobc/parser.y:5964 -msgid "LINAGE clause with wrong file type" -msgstr "LINAGE clausule met incorrect bestandstype" - -#: cobc/parser.y:6026 -msgid "RECORDING MODE U or S can only be used with RECORD SEQUENTIAL files" -msgstr "" - -#: cobc/parser.y:6059 -#, c-format -msgid "ignoring CODE-SET '%s'" -msgstr "CODE-SET '%s' genegeerd" - -#: cobc/parser.y:6070 -msgid "CODE-SET clause invalid for file type" -msgstr "CODE-SET clausule ongeldig voor bestandstype" - -#: cobc/parser.y:6092 -msgid "REPORT clause with wrong file type" -msgstr "REPORT clausule met incorrect bestandstype" - -#: cobc/parser.y:6170 -#, fuzzy -msgid "CD record missing" -msgstr "%s kop ontbreekt" - -#: cobc/parser.y:6601 -msgid "CONSTANT item not at 01 level" -msgstr "CONSTANT item niet op 01 nivo" - -#: cobc/parser.y:6721 -#, fuzzy -msgid "REDEFINES clause not following entry-name" -msgstr "REDEFINES clausule moet na ENTRY naam komen" - -#: cobc/parser.y:6743 -msgid "SAME AS clause" -msgstr "" - -#: cobc/parser.y:6750 -#, fuzzy -msgid "REPORT item cannot be used here" -msgstr "'%s' kan hier niet worden geïndexeerd" - -#: cobc/parser.y:6757 -#, fuzzy -msgid "elementary item expected" -msgstr "Geheel getal waarde" - -#: cobc/parser.y:6764 -#, fuzzy -msgid "SAME AS item may not reference itself" -msgstr "RENAMES mag niet verwijzen naar een 01 of > 50 nivo" - -#: cobc/parser.y:6771 -msgid "SAME AS item may not be subordinate to any item with USAGE clause" -msgstr "" - -#: cobc/parser.y:6773 -msgid "SAME AS item may not be subordinate to any item with SIGN clause" -msgstr "" - -#: cobc/parser.y:6801 cobc/parser.y:6855 cobc/parser.y:7567 cobc/parser.y:7650 -#: cobc/parser.y:7674 -#, c-format -msgid "%s not allowed here" -msgstr "%s niet toegestaan hier" - -#: cobc/parser.y:6803 cobc/parser.y:6845 cobc/parser.y:7569 -#, c-format -msgid "%s only allowed at 01/77 level" -msgstr "%s alleen toegestaan op 01/77 nivo" - -#: cobc/parser.y:6805 cobc/parser.y:6847 cobc/parser.y:7571 cobc/parser.y:7654 -#: cobc/parser.y:7676 -#, c-format -msgid "%s requires a data name" -msgstr "Item %s vereist een veld naam" - -#: cobc/parser.y:6958 -msgid "a locale-format PICTURE string must only consist of '9', '.', '+', 'Z' and the currency-sign" -msgstr "" - -#: cobc/parser.y:6992 cobc/typeck.c:3658 -#, fuzzy, c-format -msgid "'%s' is not a locale-name" -msgstr "'%s' is niet een LOCALE naam" - -#: cobc/parser.y:7007 -#, fuzzy, c-format -msgid "'%s' is not a valid USAGE" -msgstr "'%s' is geen geldige data naam" - -#: cobc/parser.y:7012 -#, fuzzy, c-format -msgid "unknown USAGE: %s" -msgstr "Onbekende storing : %d" - -#: cobc/parser.y:7149 -#, c-format -msgid "unknown HANDLE type: %s" -msgstr "" - -#: cobc/parser.y:7406 cobc/parser.y:7408 -msgid "INDEXED should follow ASCENDING/DESCENDING" -msgstr "" - -#: cobc/parser.y:7526 -msgid "SYNCHRONIZED clause" -msgstr "" - -#: cobc/parser.y:7529 -msgid "LEFT/RIGHT phrases in SYNCHRONIZED clause" -msgstr "" - -#: cobc/parser.y:7612 -msgid "FALSE clause only allowed for 88 level" -msgstr "FALSE clausule alleen voor 88 nivo" - -#: cobc/parser.y:7652 -#, fuzzy, c-format -msgid "%s only allowed at 01 level" -msgstr "%s alleen toegestaan op 01/77 nivo" - -#: cobc/parser.y:7656 cobc/parser.y:7678 -#, c-format -msgid "%s and %s combination not allowed" -msgstr "" - -#: cobc/parser.y:7787 -msgid "GLOBAL is not allowed with RD" -msgstr "GLOBAL is niet toegestaan met RD" - -#: cobc/parser.y:8321 -msgid "PLUS is not recommended with LEFT, RIGHT or CENTER" -msgstr "" - -#: cobc/parser.y:8323 -#, fuzzy -msgid "PLUS is not allowed with LEFT, RIGHT or CENTER" -msgstr "GLOBAL is niet toegestaan met RD" - -#: cobc/parser.y:8360 cobc/parser.y:8390 -msgid "PLUS is ignored on first field of line" -msgstr "" - -#: cobc/parser.y:8398 -msgid "invalid COLUMN integer; must be > 0" -msgstr "" - -#: cobc/parser.y:8400 -msgid "COLUMN numbers should increase" -msgstr "" - -#: cobc/parser.y:8499 cobc/parser.y:8555 -msgid "INITIAL specified on non-input field" -msgstr "INITIAL gespecificeerd op een niet-invoer veld" - -#: cobc/parser.y:8511 cobc/parser.y:8567 -msgid "relative LINE/COLUMN clause required with OCCURS" -msgstr "" - -#: cobc/parser.y:8669 cobc/parser.y:8673 -msgid "screen positions from data-item" -msgstr "" - -#: cobc/parser.y:9498 -#, fuzzy -msgid "OCCURS screen items" -msgstr "GLOBAL is niet toegestaan met scherm items" - -#: cobc/parser.y:9510 -#, fuzzy -msgid "GLOBAL screen items" -msgstr "GLOBAL is niet toegestaan met scherm items" - -#: cobc/parser.y:9554 -msgid "overriding convention specified in ENTRY-CONVENTION" -msgstr "" - -#: cobc/parser.y:9566 -#, fuzzy -msgid "executable program requested but PROCEDURE/ENTRY has USING clause" -msgstr "Uitvoerbaar programma gevraagd maar PROCEDURE/ENTRY heeft USING clausule" - -#: cobc/parser.y:9636 cobc/parser.y:9653 cobc/parser.y:11184 -#, fuzzy, c-format -msgid "number of arguments exceeds maximum %d" -msgstr "Aantal parameters overschrijdt maximum %d" - -#: cobc/parser.y:9645 -msgid "CHAINING invalid in user FUNCTION" -msgstr "CHAINING ongeldig in een FUNCTION" - -#: cobc/parser.y:9692 cobc/parser.y:11261 cobc/parser.y:11270 -#, c-format -msgid "%s not allowed in CHAINED programs" -msgstr "%s niet toegestaan in CHAINED programma" - -#: cobc/parser.y:9704 cobc/parser.y:9712 cobc/parser.y:9720 cobc/parser.y:9741 -msgid "SIZE only allowed for BY VALUE items" -msgstr "SIZE alleen toegestaan voor BY VALUE items" - -#: cobc/parser.y:9743 cobc/parser.y:9760 -#, fuzzy -msgid "invalid value for SIZE" -msgstr "Ongeldige waarde voor SIZE" - -#: cobc/parser.y:9775 -msgid "MEMORY SIZE phrase in CALL statement" -msgstr "" - -#: cobc/parser.y:9787 -msgid "OPTIONAL only allowed for BY REFERENCE items" -msgstr "OPTIONAL alleen toegestaan voor BY REFERENCE items" - -#: cobc/parser.y:9799 -msgid "RETURNING clause is required for a FUNCTION" -msgstr "RETURNING clausule is verplicht voor FUNCTION" - -#: cobc/parser.y:9805 -msgid "RETURNING clause cannot be OMITTED for main program" -msgstr "" - -#: cobc/parser.y:9808 -#, fuzzy -msgid "RETURNING clause cannot be OMITTED for a FUNCTION" -msgstr "RETURNING clausule is verplicht voor FUNCTION" - -#: cobc/parser.y:9821 -#, fuzzy -msgid "RETURNING item is not defined in LINKAGE SECTION" -msgstr "'%s' is niet in LINKAGE SECTION" - -#: cobc/parser.y:9823 -msgid "RETURNING item must have level 01" -msgstr "RETURNING item moet nivo 01" - -#: cobc/parser.y:9825 -#, fuzzy -msgid "RETURNING item should not have OCCURS" -msgstr "RETURNING item moet nivo 01" - -#: cobc/parser.y:9829 -msgid "function RETURNING item may not be ANY LENGTH" -msgstr "" - -#: cobc/parser.y:10017 -#, fuzzy, c-format -msgid "'%s' is not a statement" -msgstr "'%s' is geen report naam" - -#: cobc/parser.y:10019 -#, c-format -msgid "unknown statement '%s'; it may exist in another dialect" -msgstr "" - -#: cobc/parser.y:10022 -#, fuzzy, c-format -msgid "unknown statement '%s'" -msgstr "Onbekend statement '%s'" - -#: cobc/parser.y:10039 -msgid "section segments" -msgstr "" - -#: cobc/parser.y:10041 -#, fuzzy -msgid "SECTION segment-number must be less than or equal to 99" -msgstr "SECTION segment ongeldig binnen DECLARATIVE" - -#: cobc/parser.y:10044 -#, fuzzy -msgid "SECTION segment-number in DECLARATIVES must be less than 50" -msgstr "SECTION segment ongeldig binnen DECLARATIVE" - -#: cobc/parser.y:10052 -#, fuzzy -msgid "SECTION segment within DECLARATIVES" -msgstr "SECTION segment ongeldig binnen DECLARATIVE" - -#: cobc/parser.y:10240 cobc/parser.y:10375 -msgid "non-standard ACCEPT" -msgstr "" - -#: cobc/parser.y:10252 -#, fuzzy -msgid "PROMPT clause" -msgstr "LOCK clausule ongeldig hier" - -#: cobc/parser.y:10256 -msgid "SIZE IS clause" -msgstr "" - -#: cobc/parser.y:10471 cobc/parser.y:10763 -msgid "TIME-OUT or BEFORE TIME clauses" -msgstr "" - -#: cobc/parser.y:10497 cobc/parser.y:10513 cobc/parser.y:10528 -msgid "AT screen-location" -msgstr "" - -#: cobc/parser.y:10529 -msgid "LINE or COLUMN" -msgstr "" - -#: cobc/parser.y:10893 -msgid "ALLOCATE CHARACTERS requires RETURNING clause" -msgstr "ALLOCATE CHARACTERS vereist RETURNING clausule" - -#: cobc/parser.y:10908 cobc/parser.y:12168 -#, fuzzy, c-format -msgid "ignoring %s phrase" -msgstr "Teken genegeerd" - -#: cobc/parser.y:10910 -msgid "addressing mode should be either 24 or 31 bit" -msgstr "" - -#: cobc/parser.y:10982 -#, fuzzy -msgid "recursive program call - assuming RECURSIVE attribute" -msgstr "Recursieve programma aanroep - RECURSIVE attribute aangenomen" - -#: cobc/parser.y:11001 -msgid "STATIC CALL convention ignored because of ON EXCEPTION" -msgstr "" - -#: cobc/parser.y:11010 -msgid "ON EXCEPTION ignored because of STATIC CALL" -msgstr "" - -#: cobc/parser.y:11111 cobc/typeck.c:12209 -#, fuzzy -msgid "invalid mnemonic name" -msgstr "Ongeldige mnemonic naam" - -#: cobc/parser.y:11131 cobc/parser.y:11428 -msgid "CALL/CANCEL with program-prototype-name" -msgstr "" - -#: cobc/parser.y:11135 -msgid "id/literal ignored, using prototype name" -msgstr "" - -#: cobc/parser.y:11141 -#, fuzzy -msgid "NESTED phrase is only valid with literal" -msgstr "EXIT PERFORM is alleen geldig in een ingesloten PERFORM" - -#: cobc/parser.y:11202 -#, fuzzy -msgid "OMITTED only allowed when arguments are passed BY REFERENCE" -msgstr "OMITTED alleen toegestaan met BY REFERENCE" - -#: cobc/parser.y:11226 -#, fuzzy -msgid "invalid file name reference" -msgstr "Ongeldige bestandsnaam verwijzing" - -#: cobc/parser.y:11234 -#, fuzzy, c-format -msgid "BY CONTENT assumed for alphanumeric item '%s'" -msgstr "BY CONTENT aangenomen voor alfanumeriek item" - -#: cobc/parser.y:11239 -#, fuzzy, c-format -msgid "BY CONTENT assumed for national item '%s'" -msgstr "BY CONTENT aangenomen voor alfanumeriek item" - -#: cobc/parser.y:11302 -msgid "RETURNING item must have level 01 or 77" -msgstr "RETURNING item moet nivo 01 of 77 zijn" - -#: cobc/parser.y:11306 -#, fuzzy -msgid "RETURNING item must be a LINKAGE SECTION item or have BASED clause" -msgstr "RETURNING item is niet in LINKAGE SECTION en niet BASED" - -#: cobc/parser.y:11340 cobc/parser.y:15972 cobc/parser.y:16027 -#: cobc/parser.y:16071 cobc/parser.y:16115 -msgid "NOT EXCEPTION before EXCEPTION" -msgstr "" - -#: cobc/parser.y:12041 -#, c-format -msgid "HANDLE must be a %s HANDLE" -msgstr "" - -#: cobc/parser.y:12053 -msgid "HANDLE must be a generic HANDLE" -msgstr "" - -#: cobc/parser.y:12130 -#, fuzzy, c-format -msgid "HANDLE clause invalid for %s" -msgstr "%s clausule is verplicht voor bestand '%s'" - -#: cobc/parser.y:12361 cobc/parser.y:15495 -#, fuzzy, c-format -msgid "%s is invalid in nested program" -msgstr "%s is ongeldig in ingesloten programma" - -#: cobc/parser.y:12399 cobc/parser.y:12440 cobc/parser.y:12451 -#: cobc/parser.y:12462 -#, fuzzy, c-format -msgid "maximum evaluate depth exceeded (%d)" -msgstr "Maximum evaluate diepte overschreden (%d)" - -#: cobc/parser.y:12503 cobc/parser.y:12513 -msgid "WHEN without imperative statement" -msgstr "" - -#: cobc/parser.y:12531 cobc/parser.y:12541 -msgid "WHEN OTHER without imperative statement" -msgstr "" - -#: cobc/parser.y:12621 -#, fuzzy -msgid "invalid THROUGH usage" -msgstr "Ongeldig THROUGH gebruik" - -#: cobc/parser.y:12700 -msgid "EXIT PROGRAM is not allowed within a USE GLOBAL procedure" -msgstr "EXIT PROGRAM is niet toegestaan in een USE GLOBAL procedure" - -#: cobc/parser.y:12704 -#, fuzzy -msgid "EXIT PROGRAM not allowed within a FUNCTION" -msgstr "EXIT FUNCTION is alleen toegestaan in FUNCTION type" - -#: cobc/parser.y:12713 cobc/parser.y:12926 -msgid "RETURNING/GIVING not allowed for non-returning runtime elements" -msgstr "" - -#: cobc/parser.y:12725 -msgid "EXIT FUNCTION is not allowed within a USE GLOBAL procedure" -msgstr "EXIT FUNCTION is niet toegestaan in een USE GLOBAL procedure" - -#: cobc/parser.y:12729 -#, fuzzy -msgid "EXIT FUNCTION only allowed within a FUNCTION" -msgstr "EXIT FUNCTION is alleen toegestaan in FUNCTION type" - -#: cobc/parser.y:12743 cobc/parser.y:12766 -msgid "EXIT PERFORM is only valid with inline PERFORM" -msgstr "EXIT PERFORM is alleen geldig in een ingesloten PERFORM" - -#: cobc/parser.y:12788 -msgid "EXIT SECTION is only valid with an active SECTION" -msgstr "EXIT SECTION is alleen geldig in een SECTION" - -#: cobc/parser.y:12809 -msgid "EXIT PARAGRAPH is only valid with an active PARAGRAPH" -msgstr "EXIT PARAGRAPH is alleen geldig in een PARAGRAPH" - -#: cobc/parser.y:12956 -msgid "IF without imperative statement" -msgstr "" - -#: cobc/parser.y:13173 -#, fuzzy -msgid "TALLYING clause is incomplete" -msgstr "LINAGE clausule met incorrect bestandstype" - -#: cobc/parser.y:13289 -msgid "INSPECT missing ALL/FIRST/LEADING/TRAILING" -msgstr "" - -#: cobc/parser.y:13407 -msgid "JSON PARSE" -msgstr "" - -#: cobc/parser.y:13552 -#, fuzzy -msgid "LOCK clauses" -msgstr "LOCK clausule ongeldig hier" - -#: cobc/parser.y:13717 -msgid "inline PERFORM without imperative statement" -msgstr "" - -#: cobc/parser.y:13838 cobc/parser.y:13846 cobc/parser.y:13854 -#, c-format -msgid "PERFORM VARYING '%s' (line %d of %s) is not a numeric field" -msgstr "" - -#: cobc/parser.y:13870 -#, fuzzy -msgid "PERFORM VARYING without BY phrase" -msgstr "GO TO met meerdere procedure-namen" - -#: cobc/parser.y:13910 -#, fuzzy, c-format -msgid "'%s' is not an object-reference" -msgstr "'%s' is geen heel getal" - -#: cobc/parser.y:13951 cobc/typeck.c:10958 cobc/typeck.c:12100 -msgid "LOCK clause invalid with file LOCK AUTOMATIC" -msgstr "LOCK clausule ongeldig met LOCK AUTOMATIC bestand" - -#: cobc/parser.y:13956 -msgid "KEY clause invalid with this file type" -msgstr "KEY clausule ongeldig met dit bestandstype" - -#: cobc/parser.y:13961 cobc/typeck.c:10954 cobc/typeck.c:12096 -msgid "INVALID KEY clause invalid with this file type" -msgstr "INVALID KEY clausule ongeldig met dit bestandstype" - -#: cobc/parser.y:14591 -#, fuzzy -msgid "file sort requires KEY phrase" -msgstr "Bestands sort vereist KEY beschrijving" - -#: cobc/parser.y:14615 -#, fuzzy -msgid "table SORT requires KEY phrase" -msgstr "Bestands sort vereist KEY beschrijving" - -#: cobc/parser.y:14677 -#, fuzzy -msgid "file sort requires USING or INPUT PROCEDURE" -msgstr "Bestands sort vereist USING of INPUT PROCEDURE" - -#: cobc/parser.y:14684 -msgid "USING invalid with table SORT" -msgstr "USING ongeldig met tabel SORT" - -#: cobc/parser.y:14694 -msgid "INPUT PROCEDURE invalid with table SORT" -msgstr "INPUT PROCEDURE ongeldig met tabel SORT" - -#: cobc/parser.y:14696 -msgid "INPUT PROCEDURE invalid with MERGE" -msgstr "INPUT PROCEDURE ongeldig met MERGE" - -#: cobc/parser.y:14709 -#, fuzzy -msgid "file sort requires GIVING or OUTPUT PROCEDURE" -msgstr "Bestands sort vereist GIVING of OUTPUT PROCEDURE" - -#: cobc/parser.y:14716 -msgid "GIVING invalid with table SORT" -msgstr "GIVING ongeldig met tabel SORT" - -#: cobc/parser.y:14726 -msgid "OUTPUT PROCEDURE invalid with table SORT" -msgstr "OUTPUT PROCEDURE ongeldig met tabel SORT" - -#: cobc/parser.y:14753 -msgid "SIZE/LENGTH invalid here" -msgstr "SIZE/LENGTH ongeldig hier" - -#: cobc/parser.y:14806 -#, fuzzy -msgid "NOT EQUAL condition not allowed on START statement" -msgstr "NOT EQUAL conditie niet toegestaan bij START statement" - -#: cobc/parser.y:14872 -#, fuzzy, c-format -msgid "%s is replaced by %s" -msgstr "%s is verouderd in %s" - -#: cobc/parser.y:14925 -msgid "STOP literal" -msgstr "" - -#: cobc/parser.y:14929 -#, fuzzy -msgid "STOP identifier" -msgstr "Ongeldige PROMPT identifier" - -#: cobc/parser.y:15066 -msgid "SUPPRESS statement must be within DECLARATIVES" -msgstr "SUPPRESS statement moet binnen DECLARATIVES" - -#: cobc/parser.y:15140 -msgid "UNLOCK invalid for SORT files" -msgstr "UNLOCK ongeldig voor SORT bestanden" - -#: cobc/parser.y:15276 cobc/parser.y:15355 -msgid "USE statement must be within DECLARATIVES" -msgstr "USE statement moet binnen DECLARATIVES" - -#: cobc/parser.y:15278 -msgid "SECTION header missing before USE statement" -msgstr "SECTION kop ontbreekt voorafgaand aan USE statement" - -#: cobc/parser.y:15357 -msgid "USE DEBUGGING not supported in contained program" -msgstr "USE DEBUGGING niet ondersteund in bijgesloten programma" - -#: cobc/parser.y:15405 cobc/parser.y:15414 cobc/parser.y:15432 -#: cobc/parser.y:15468 cobc/typeck.c:3792 -#, fuzzy, c-format -msgid "duplicate DEBUGGING target: '%s'" -msgstr "Ongeldig DEFINE/SET statement" - -#: cobc/parser.y:15430 -#, fuzzy -msgid "constant item cannot be used here" -msgstr "Hier mag geen constante worden gebruikt - '%s'" - -#: cobc/parser.y:15456 -#, fuzzy -msgid "duplicate USE DEBUGGING ON ALL PROCEDURES" -msgstr "Dubbele USE DEBUGGING ON ALL PROCEDURES" - -#: cobc/parser.y:15528 -#, fuzzy, c-format -msgid "'%s' is not a report group" -msgstr "'%s' is geen report naam" - -#: cobc/parser.y:15710 -msgid "ENCODING clause must come before XML-DECLARATION" -msgstr "" - -#: cobc/parser.y:15712 -msgid "ENCODING clause must come before ATTRIBUTES" -msgstr "" - -#: cobc/parser.y:15715 -msgid "XML GENERATE ENCODING clause" -msgstr "" - -#: cobc/parser.y:15722 -msgid "XML-DECLARATION clause must come before ATTRIBUTES" -msgstr "" - -#: cobc/parser.y:15725 -msgid "XML GENERATE XML-DECLARATION clause" -msgstr "" - -#: cobc/parser.y:15731 -msgid "XML GENERATE WITH ATTRIBUTES clause" -msgstr "" - -#: cobc/parser.y:15744 -msgid "XML GENERATE NAMESPACE clause" -msgstr "" - -#: cobc/parser.y:15768 -msgid "XML GENERATE NAME OF clause" -msgstr "" - -#: cobc/parser.y:15799 -msgid "XML GENERATE TYPE OF clause" -msgstr "" - -#: cobc/parser.y:15840 -msgid "XML GENERATE SUPPRESS clause" -msgstr "" - -#: cobc/parser.y:15914 -msgid "XML PARSE" -msgstr "" - -#: cobc/parser.y:15955 cobc/parser.y:16633 cobc/parser.y:16729 -#: cobc/parser.y:16815 -#, c-format -msgid "'%s' is not a file name" -msgstr "'%s' is geen bestandsnaam" - -#: cobc/parser.y:16161 -msgid "NOT SIZE ERROR before SIZE ERROR" -msgstr "" - -#: cobc/parser.y:16207 -msgid "NOT OVERFLOW before OVERFLOW" -msgstr "" - -#: cobc/parser.y:16306 -msgid "NOT AT END-OF-PAGE before AT END-OF-PAGE" -msgstr "" - -#: cobc/parser.y:16356 -msgid "NOT INVALID KEY before INVALID KEY" -msgstr "" - -#: cobc/parser.y:16619 -msgid "LINAGE-COUNTER must be qualified here" -msgstr "LINAGE-COUNTER moet hier gespecificeerd worden" - -#: cobc/parser.y:16622 -#, fuzzy -msgid "invalid LINAGE-COUNTER usage" -msgstr "Ongeldig LINAGE-COUNTER gebruik" - -#: cobc/parser.y:16643 -msgid "LINE-COUNTER must be qualified here" -msgstr "LINE-COUNTER moet hier gespecificeerd worden" - -#: cobc/parser.y:16647 -#, fuzzy -msgid "invalid LINE-COUNTER usage" -msgstr "Ongeldig LINE-COUNTER gebruik" - -#: cobc/parser.y:16658 cobc/parser.y:16683 -#, c-format -msgid "'%s' is not a report name" -msgstr "'%s' is geen report naam" - -#: cobc/parser.y:16668 -msgid "PAGE-COUNTER must be qualified here" -msgstr "PAGE-COUNTER moet hier gespecificeerd worden" - -#: cobc/parser.y:16672 -#, fuzzy -msgid "invalid PAGE-COUNTER usage" -msgstr "Ongeldig PAGE-COUNTER gebruik" - -#: cobc/parser.y:16719 cobc/typeck.c:10919 cobc/typeck.c:11004 -#: cobc/typeck.c:12064 -#, fuzzy, c-format -msgid "%s requires a record name as subject" -msgstr "%s vereist een record naam" - -#: cobc/parser.y:16746 -#, c-format -msgid "'%s' not indexed" -msgstr "'%s' niet geïndexeerd" - -#: cobc/parser.y:16772 cobc/parser.y:16797 -#, fuzzy, c-format -msgid "multiple reference to '%s' " -msgstr "Meerdere verwijzingen naar '%s' " - -#: cobc/parser.y:16827 -#, fuzzy, c-format -msgid "'%s' is not a CD name" -msgstr "'%s' is geen bestandsnaam" - -#: cobc/parser.y:16841 -#, fuzzy, c-format -msgid "'%s' is not a valid report name" -msgstr "'%s' is geen report naam" - -#: cobc/parser.y:17092 -#, fuzzy -msgid "invalid mnemonic identifier" -msgstr "Ongeldige mnemonic identifier" - -#: cobc/parser.y:17172 -#, fuzzy -msgid "a numeric literal is expected here" -msgstr "Een niet numerieke constante is verwacht voor '%s'" - -#: cobc/parser.y:17184 cobc/parser.y:17886 -#, fuzzy -msgid "a non-numeric literal is expected here" -msgstr "Een niet numerieke constante is verwacht voor '%s'" - -#: cobc/parser.y:17357 cobc/typeck.c:6116 cobc/typeck.c:6123 -#, fuzzy, c-format -msgid "'%s' is not numeric" -msgstr "'%s' is geen numerieke naam" - -#: cobc/parser.y:17373 -#, fuzzy, c-format -msgid "'%s' is not a field or file" -msgstr "'%s' is geen bestandsnaam" - -#: cobc/parser.y:17393 cobc/parser.y:17411 -#, fuzzy, c-format -msgid "'%s' is not a field" -msgstr "'%s' is niet gedefinieerd" - -#: cobc/parser.y:17533 -#, fuzzy, c-format -msgid "'%s' is not a field or alphabet" -msgstr "'%s' is geen bestandsnaam" - -#: cobc/parser.y:17559 -#, fuzzy -msgid "a subscripted data-item cannot be used here" -msgstr "'%s' kan hier niet worden geïndexeerd" - -#: cobc/parser.y:17609 -#, fuzzy -msgid "unsigned integer value expected" -msgstr "Geheel getal waarde" - -#: cobc/parser.y:17621 cobc/parser.y:17625 cobc/parser.y:17675 -#, fuzzy -msgid "integer value expected" -msgstr "Geheel getal waarde" - -#: cobc/parser.y:17630 -#, fuzzy -msgid "invalid symbolic integer" -msgstr "Ongeldig geheel getal" - -#: cobc/parser.y:17646 cobc/parser.y:17650 -#, fuzzy -msgid "unsigned positive integer value expected" -msgstr "Geheel getal waarde" - -#: cobc/parser.y:17679 -#, fuzzy -msgid "invalid CLASS value" -msgstr "Ongeldige CLASS waarde" - -#: cobc/parser.y:17767 -msgid "PHYSICAL argument for LENGTH functions" -msgstr "" - -#: cobc/parser.y:17938 cobc/parser.y:17955 -msgid "cannot specify offset and SYSTEM-OFFSET at the same time" -msgstr "" - -#: cobc/pplex.l:223 cobc/pplex.l:1739 -msgid "debugging indicator" -msgstr "" - -#: cobc/pplex.l:300 -#, fuzzy -msgid "ignoring empty directive" -msgstr "Leeg statement genegeerd" - -#: cobc/pplex.l:310 cobc/pplex.l:369 -#, fuzzy, c-format -msgid "ignoring invalid directive: '%s'" -msgstr "Ongeldig statement genegeerd - '%s'" - -#: cobc/pplex.l:317 -#, fuzzy -msgid "ignoring invalid directive" -msgstr "Ongeldig statement genegeerd" - -#: cobc/pplex.l:324 -#, fuzzy -msgid "VCS directive" -msgstr "Ongeldig SOURCE statement" - -#: cobc/pplex.l:377 cobc/pplex.l:392 -#, fuzzy -msgid "spurious '$' detected - ignored" -msgstr "Valse '$' ontdekt - genegeerd" - -#: cobc/pplex.l:386 -#, fuzzy, c-format -msgid "ignoring unknown directive: '%s'" -msgstr "Ongeldig statement genegeerd - '%s'" - -#: cobc/pplex.l:398 -msgid "PROCESS statement ignored" -msgstr "PROCESS statement genegeerd" - -#: cobc/pplex.l:864 -#, fuzzy -msgid "IF/ELIF/ELSE directive without matching END-IF" -msgstr "ELSE statement zonder bijbehorende IF/ELIF" - -#: cobc/pplex.l:981 -#, fuzzy -msgid "file was included here" -msgstr "Ongeldige regel voortzetting" - -#: cobc/pplex.l:1186 -#, fuzzy, c-format -msgid "directive nest depth exceeded: %d" -msgstr "Ingesloten richtlijn diepte overschreden - %d" - -#: cobc/pplex.l:1204 -msgid "ELSE directive without matching IF/ELIF" -msgstr "ELSE statement zonder bijbehorende IF/ELIF" - -#: cobc/pplex.l:1220 -msgid "END-IF directive without matching IF/ELIF/ELSE" -msgstr "END-IF statement zonder bijbehorende IF/ELIF/ELSE" - -#: cobc/pplex.l:1236 -msgid "ELIF directive without matching IF/ELIF" -msgstr "ELIF statement zonder bijbehorende IF/ELIF" - -#: cobc/pplex.l:1258 -#, fuzzy, c-format -msgid "invalid internal case: %u" -msgstr "Ongeldige interne case - %u" - -#: cobc/pplex.l:1395 -msgid "buffer overrun - too many continuation lines" -msgstr "" - -#: cobc/pplex.l:1485 cobc/pplex.l:1494 -#, fuzzy -msgid "line not terminated by a newline" -msgstr "Regel niet afgesloten met een newline" - -#: cobc/pplex.l:1488 cobc/pplex.l:1497 -#, c-format -msgid "source text exceeds %d bytes, will be truncated" -msgstr "" - -#: cobc/pplex.l:1516 -msgid "version control conflict marker in file" -msgstr "" - -#: cobc/pplex.l:1727 -#, fuzzy -msgid "invalid continuation in comment entry" -msgstr "Ongeldige voortzetting in commentaar gebied" - -#: cobc/pplex.l:1732 -msgid "continuation of COBOL words" -msgstr "" - -#: cobc/pplex.l:1752 -#, fuzzy, c-format -msgid "invalid indicator '%c' at column 7" -msgstr "Ongeldige indicator '%c' in kolom 7" - -#: cobc/pplex.l:1800 cobc/pplex.l:1811 -#, fuzzy -msgid "invalid line continuation" -msgstr "Ongeldige regel voortzetting" - -#: cobc/pplex.l:1819 -#, fuzzy -msgid "continuation character expected" -msgstr "Voortzettings teken verwacht" - -#: cobc/pplex.l:1885 -#, fuzzy, c-format -msgid "source text after program-text area (column %d)" -msgstr "Bron tekst na kolom %d" - -#: cobc/ppparse.y:225 -#, fuzzy -msgid "directive comparison on different types" -msgstr "Statement vergelijking met verschillende types" - -#: cobc/ppparse.y:293 -#, fuzzy, c-format -msgid "duplicate DEFINE directive '%s'" -msgstr "Ongeldig DEFINE/SET statement" - -#: cobc/ppparse.y:300 cobc/ppparse.y:310 -#, fuzzy -msgid "invalid constant in DEFINE directive" -msgstr "Ongeldig DEFINE/SET statement" - -#: cobc/ppparse.y:408 -#, c-format -msgid "compiler flag '%s' unknown" -msgstr "" - -#: cobc/ppparse.y:454 -#, fuzzy, c-format -msgid "invalid %s directive option '%s'" -msgstr "Ongeldig SOURCE statement" - -#: cobc/ppparse.y:667 -msgid "*CONTROL statement" -msgstr "" - -#: cobc/ppparse.y:933 cobc/ppparse.y:1004 cobc/ppparse.y:1141 -#, fuzzy, c-format -msgid "invalid %s directive" -msgstr "Ongeldig SOURCE statement" - -#: cobc/ppparse.y:1043 -#, fuzzy -msgid "LEAP-SECOND ON directive" -msgstr "LEAP-SECOND statement genegeerd" - -#: cobc/ppparse.y:1051 -msgid "TURN directive" -msgstr "" - -#: cobc/ppparse.y:1133 cobc/ppparse.y:1158 -#, fuzzy -msgid "invalid constant" -msgstr "Ongeldige constante" - -#: cobc/reserved.c:3797 -#, fuzzy -msgid "device name" -msgstr "Apparaat naam" - -#: cobc/reserved.c:3800 -#, fuzzy -msgid "switch name" -msgstr "Switch naam" - -#: cobc/reserved.c:3803 -#, fuzzy -msgid "feature name" -msgstr "Kenmerk naam" - -#: cobc/reserved.c:3902 -#, fuzzy, c-format -msgid "reserved word must have less than %d characters" -msgstr "Parameter voor SYSTEM call is groter dan 8192 karakters" - -#: cobc/reserved.c:3921 -msgid "ignored asterisk at end of alias target" -msgstr "" - -#: cobc/reserved.c:3984 -#, c-format -msgid "alias target '%s' is not a default reserved word" -msgstr "" - -#: cobc/reserved.c:4447 -#, fuzzy, c-format -msgid "invalid system-name '%s'" -msgstr "Ongeldige systeem-naam '%s'" - -#: cobc/reserved.c:4584 -#, fuzzy, c-format -msgid "'%s' is a reserved word, but isn't supported" -msgstr "'%s' gereserveerd woord, maar niet ondersteund" - -#: cobc/reserved.c:4689 -#, fuzzy, c-format -msgid "intrinsic function %s is unknown" -msgstr "'%s' is geen interne compiler functie" - -#: cobc/reserved.c:4717 -#, fuzzy -msgid "Intrinsic Function" -msgstr "'%s' is geen interne compiler functie" - -#: cobc/reserved.c:4717 cobc/reserved.c:4897 cobc/reserved.c:5034 -#, fuzzy -msgid "Implemented" -msgstr "'%s' niet geïmplementeerd" - -#: cobc/reserved.c:4717 cobc/typeck.c:1022 -msgid "Parameters" -msgstr "" - -#: cobc/reserved.c:4721 cobc/reserved.c:4901 cobc/reserved.c:5048 -msgid "Yes" -msgstr "" - -#: cobc/reserved.c:4724 cobc/reserved.c:4904 cobc/reserved.c:5054 -#, fuzzy -msgid "No" -msgstr "N" - -#: cobc/reserved.c:4730 -msgid "Unlimited" -msgstr "" - -#: cobc/reserved.c:4804 -#, c-format -msgid "special register %s is unknown, needs a definition" -msgstr "" - -#: cobc/reserved.c:4810 -#, c-format -msgid "special register %s is unknown" -msgstr "" - -#: cobc/reserved.c:4897 -#, fuzzy -msgid "Internal registers" -msgstr "Extra interne registers\tDefinitie" - -#: cobc/reserved.c:4897 -#, fuzzy -msgid "Definition" -msgstr "Herdefinitie van '%s'" - -#: cobc/reserved.c:4985 -#, fuzzy, c-format -msgid "unknown system-name '%s'" -msgstr "Onbekend statement '%s'" - -#: cobc/reserved.c:5011 -#, fuzzy -msgid "System names" -msgstr "GNU Cobol Bouw omgeving" - -#: cobc/reserved.c:5034 -msgid "Reserved Words" -msgstr "" - -#: cobc/reserved.c:5046 -#, fuzzy -msgid "Yes (Context sensitive)" -msgstr "Y (Context gevoelig)" - -#: cobc/reserved.c:5052 -#, fuzzy -msgid "No (Context sensitive)" -msgstr "N (Context gevoelig)" - -#: cobc/reserved.c:5081 -msgid "Extra (obsolete) context sensitive words" -msgstr "Extra (niet meer in gebruik) context gevoelige woorden" - -#: cobc/scanner.l:265 cobc/scanner.l:2288 -#, fuzzy, c-format -msgid "'%s' is not a default reserved word, so cannot be aliased" -msgstr "'%s' gereserveerd woord, maar niet ondersteund" - -#: cobc/scanner.l:268 -#, fuzzy, c-format -msgid "'%s' is not a reserved word; you may want ADDSYN or OVERRIDE instead" -msgstr "'%s' gereserveerd woord, maar niet ondersteund" - -#: cobc/scanner.l:988 -#, fuzzy, c-format -msgid "a constant may not be used here - '%s'" -msgstr "Hier mag geen constante worden gebruikt - '%s'" - -#: cobc/scanner.l:1043 -msgid "ignoring redundant ." -msgstr "" - -#: cobc/scanner.l:1101 -#, fuzzy, c-format -msgid "invalid symbol '%s' - skipping word" -msgstr "Ongeldig symbool: %s - Woord overgeslagen" - -#: cobc/scanner.l:1191 -#, fuzzy -msgid "invalid national literal" -msgstr "Ongeldige X constante: %s" - -#: cobc/scanner.l:1202 cobc/tree.c:2531 -#, fuzzy, c-format -msgid "invalid literal: '%s'" -msgstr "Ongeldige H constante: %s" - -#: cobc/scanner.l:1204 -#, fuzzy, c-format -msgid "invalid hexadecimal literal: '%s'" -msgstr "Ongeldige X constante: %s" - -#: cobc/scanner.l:1206 cobc/tree.c:1613 -#, fuzzy, c-format -msgid "invalid numeric literal: '%s'" -msgstr "Ongeldige numerieke constante" - -#: cobc/scanner.l:1208 -#, fuzzy, c-format -msgid "invalid floating-point literal: '%s'" -msgstr "Ongeldige drijvende komma constante" - -#: cobc/scanner.l:1210 -#, fuzzy, c-format -msgid "invalid %s literal: '%s'" -msgstr "Ongeldige X constante: %s" - -#: cobc/scanner.l:1261 -#, fuzzy, c-format -msgid "literal length exceeds %d characters" -msgstr "Woord lengte overschrijdt 31 karakters - '%s'" - -#: cobc/scanner.l:1277 cobc/scanner.l:1326 cobc/scanner.l:1620 -#, fuzzy -msgid "zero-length literal" -msgstr "Ongeldige numerieke constante" - -#: cobc/scanner.l:1280 -#, fuzzy -msgid "national literal has zero length; a SPACE will be assumed" -msgstr "Alfanumerieke constante heeft lengte nul" - -#: cobc/scanner.l:1281 -#, fuzzy -msgid "alphanumeric literal has zero length; a SPACE will be assumed" -msgstr "Alfanumerieke constante heeft lengte nul" - -#: cobc/scanner.l:1293 cobc/scanner.l:1294 cobc/scanner.l:1298 -#: cobc/scanner.l:1365 -#, fuzzy -msgid "national literal" -msgstr "Ongeldige H constante: %s" - -#: cobc/scanner.l:1297 -#, fuzzy -msgid "national-character literal" -msgstr "Ongeldige H constante: %s" - -#: cobc/scanner.l:1330 -#, fuzzy -msgid "hexadecimal literal has zero length; X'00' will be assumed" -msgstr "Alfanumerieke constante heeft lengte nul" - -#: cobc/scanner.l:1349 -#, fuzzy -msgid "hexadecimal-boolean literal" -msgstr "Ongeldige numerieke constante" - -#: cobc/scanner.l:1356 cobc/scanner.l:1370 cobc/scanner.l:1485 -#: cobc/scanner.l:1544 cobc/scanner.l:1642 cobc/scanner.l:1711 cobc/tree.c:2532 -#, fuzzy, c-format -msgid "literal length %d exceeds %d characters" -msgstr "Woord lengte overschrijdt 31 karakters - '%s'" - -#: cobc/scanner.l:1362 -#, fuzzy -msgid "hexadecimal-national literal" -msgstr "Ongeldige X constante: %s" - -#: cobc/scanner.l:1393 cobc/scanner.l:1425 cobc/scanner.l:1560 -#: cobc/scanner.l:1656 cobc/scanner.l:1721 -#, fuzzy, c-format -msgid "literal contains invalid character '%c'" -msgstr "Figuratieve constante ongeldig hier" - -#: cobc/scanner.l:1449 -#, fuzzy, c-format -msgid "literal does not have an even number of digits" -msgstr "Woord lengte overschrijdt 31 karakters - '%s'" - -#: cobc/scanner.l:1492 -#, fuzzy, c-format -msgid "%s literals must contain at least one character" -msgstr "Figuratieve constante ongeldig hier" - -#: cobc/scanner.l:1527 cobc/scanner.l:1628 cobc/scanner.l:1702 -#, fuzzy -msgid "ACUCOBOL numeric literal" -msgstr "Ongeldige numerieke constante" - -#: cobc/scanner.l:1537 -#, fuzzy -msgid "H literals must contain at least one character" -msgstr "Figuratieve constante ongeldig hier" - -#: cobc/scanner.l:1575 cobc/scanner.l:1667 cobc/scanner.l:1732 -#, fuzzy, c-format -msgid "literal exceeds limit %u" -msgstr "Numerieke constante overschrijdt data grootte" - -#: cobc/scanner.l:1616 -#, fuzzy -msgid "numeric boolean literal" -msgstr "Ongeldige numerieke constante" - -#: cobc/scanner.l:1622 -#, fuzzy -msgid "Boolean literal has zero length; B'0' will be assumed" -msgstr "Alfanumerieke constante heeft lengte nul" - -#: cobc/scanner.l:1698 -#, fuzzy -msgid "HP COBOL octal literal" -msgstr "Ongeldige numerieke constante" - -#: cobc/scanner.l:1810 cobc/tree.c:1624 -#, fuzzy, c-format -msgid "literal length %d exceeds maximum of %d digits" -msgstr "Woord lengte overschrijdt 31 karakters - '%s'" - -#: cobc/scanner.l:1816 cobc/tree.c:1629 -#, fuzzy, c-format -msgid "literal length %d exceeds %d digits" -msgstr "Woord lengte overschrijdt 31 karakters - '%s'" - -#: cobc/scanner.l:1928 cobc/tree.c:3513 -#, fuzzy, c-format -msgid "significand has more than %d digits" -msgstr "Numeriek veld mag niet groter zijn dan %d cijfers" - -#: cobc/scanner.l:1933 -#, c-format -msgid "exponent has decimal point" -msgstr "" - -#: cobc/scanner.l:1939 cobc/tree.c:3521 -#, c-format -msgid "exponent has more than 4 digits" -msgstr "" - -#: cobc/scanner.l:1969 -#, c-format -msgid "exponent not between -6143 and 6144" -msgstr "" - -#: cobc/scanner.l:1978 -#, c-format -msgid "significand of 0 must be positive" -msgstr "" - -#: cobc/scanner.l:1983 -#, c-format -msgid "exponent of 0 must be 0" -msgstr "" - -#: cobc/scanner.l:1988 -#, c-format -msgid "exponent of 0 must be positive" -msgstr "" - -#: cobc/scanner.l:2170 -#, fuzzy, c-format -msgid "invalid CONSTANT: %s" -msgstr "Ongeldige CONSTANT - %s" - -#: cobc/scanner.l:2180 -#, fuzzy, c-format -msgid "invalid alphanumeric CONSTANT: %s" -msgstr "Ongeldige alfanumerieke CONSTANT - %s" - -#: cobc/scanner.l:2184 -#, fuzzy, c-format -msgid "empty alphanumeric CONSTANT: %s" -msgstr "Lege alfanumerieke CONSTANT - %s" - -#: cobc/scanner.l:2201 cobc/scanner.l:2209 cobc/scanner.l:2214 -#, fuzzy, c-format -msgid "invalid numeric CONSTANT: %s" -msgstr "Ongeldige numerieke CONSTANT - %s" - -#: cobc/scanner.l:2291 -#, c-format -msgid "'%s' is already reserved; you may want MAKESYN instead" -msgstr "" - -#: cobc/tree.c:341 -#, c-format -msgid "%s clause is required for file '%s'" -msgstr "%s clausule is verplicht voor bestand '%s'" - -#: cobc/tree.c:345 -#, fuzzy, c-format -msgid "%s clause is invalid for file '%s' (file type)" -msgstr "RECORD clausule ongeldig voor dit bestandstype" - -#: cobc/tree.c:349 -#, fuzzy, c-format -msgid "%s clause is invalid for file '%s'" -msgstr "%s clausule is verplicht voor bestand '%s'" - -#: cobc/tree.c:376 -#, c-format -msgid "FOR item '%s' is a record" -msgstr "" - -#: cobc/tree.c:385 -#, fuzzy, c-format -msgid "FOR item '%s' is in different record to '%s'" -msgstr "END PROGRAM '%s' verschilt met PROGRAM-ID '%s'" - -#: cobc/tree.c:394 -#, c-format -msgid "FOR item '%s' is not in a record associated with '%s'" -msgstr "" - -#: cobc/tree.c:477 -#, fuzzy -msgid "internal error node" -msgstr "Interne fout knooppunt" - -#: cobc/tree.c:479 -#, fuzzy -msgid "unknown constant" -msgstr "Onbekende constante" - -#: cobc/tree.c:639 -#, fuzzy, c-format -msgid "FUNCTION %s has invalid/not supported arguments - tag %d" -msgstr "FUNCTION %s heeft ongeldige/niet ondersteunde argumenten - Label %d" - -#: cobc/tree.c:760 -#, fuzzy, c-format -msgid "invalid date/time function: '%d'" -msgstr "Ongeldige opmaak string - '%s'" - -#: cobc/tree.c:798 -#, fuzzy, c-format -msgid "FUNCTION '%s' has invalid date/time format" -msgstr "FUNCTION '%s' heeft een ongeldige parameter" - -#: cobc/tree.c:805 -#, fuzzy, c-format -msgid "FUNCTION '%s' has format in variable" -msgstr "FUNCTION '%s' heeft een ongeldige parameter" - -#: cobc/tree.c:1186 -#, fuzzy, c-format -msgid "literal '%s'" -msgstr "Ongeldige H constante: %s" - -#: cobc/tree.c:1315 -#, fuzzy, c-format -msgid "unknown tree tag: %d, category: %d" -msgstr "Onbekende boom label %d Categorie %d" - -#: cobc/tree.c:1405 -#, fuzzy, c-format -msgid "unexpected numeric USAGE: %d" -msgstr "Onbekende USAGE - %d" - -#: cobc/tree.c:1419 -#, fuzzy, c-format -msgid "unexpected category: %d" -msgstr "Onverwachte categorie -> %d" - -#: cobc/tree.c:1678 cobc/tree.c:1690 cobc/tree.c:1752 cobc/tree.c:1802 -#, fuzzy, c-format -msgid "numeric literal '%s' exceeds limit '%s'" -msgstr "Numerieke constante overschrijdt de maximum grootte" - -#: cobc/tree.c:2387 -#, fuzzy -msgid "invalid LOCALE literal" -msgstr "Ongeldige LOCALE constante" - -#: cobc/tree.c:2512 -#, fuzzy -msgid "only literals with the same category can be concatenated" -msgstr "Alfanumerieke constante heeft lengte nul" - -#: cobc/tree.c:2519 -#, fuzzy -msgid "only alphanumeric, national or boolean literals may be concatenated" -msgstr "Alfanumerieke constante heeft lengte nul" - -#: cobc/tree.c:2791 -msgid "B, 0 or /" -msgstr "" - -#: cobc/tree.c:2805 -msgid "the sign of the floating-point exponent" -msgstr "" - -#: cobc/tree.c:2807 -msgid "a leading +/- sign" -msgstr "" - -#: cobc/tree.c:2809 -msgid "a trailing +/- sign" -msgstr "" - -#: cobc/tree.c:2811 -msgid "CR or DB" -msgstr "" - -#: cobc/tree.c:2813 -msgid "a leading currency symbol" -msgstr "" - -#: cobc/tree.c:2815 -msgid "a trailing currency symbol" -msgstr "" - -#: cobc/tree.c:2817 -msgid "a Z or * which is before the decimal point" -msgstr "" - -#: cobc/tree.c:2819 -msgid "a Z or * which is after the decimal point" -msgstr "" - -#: cobc/tree.c:2821 -msgid "a floating +/- string which is before the decimal point" -msgstr "" - -#: cobc/tree.c:2823 -msgid "a floating +/- string which is after the decimal point" -msgstr "" - -#: cobc/tree.c:2825 -msgid "a floating currency symbol string which is before the decimal point" -msgstr "" - -#: cobc/tree.c:2827 -msgid "a floating currency symbol string which is after the decimal point" -msgstr "" - -#: cobc/tree.c:2831 -msgid "A or X" -msgstr "" - -#: cobc/tree.c:2837 -msgid "a P which is before the decimal point" -msgstr "" - -#: cobc/tree.c:2839 -msgid "a P which is after the decimal point" -msgstr "" - -#: cobc/tree.c:2860 cobc/tree.c:3267 -#, c-format -msgid "%s may only occur once in a PICTURE string" -msgstr "" - -#: cobc/tree.c:2862 cobc/tree.c:3219 -#, fuzzy, c-format -msgid "%s cannot follow %s" -msgstr "%s niet toegestaan hier" - -#: cobc/tree.c:2865 -#, fuzzy -msgid "invalid PICTURE string detected" -msgstr "Ongeldige optie gevonden" - -#: cobc/tree.c:2976 -msgid "number or constant in parentheses is not an unsigned integer" -msgstr "" - -#: cobc/tree.c:2985 -msgid "only up to 9 significant digits are permitted within parentheses" -msgstr "" - -#: cobc/tree.c:2991 -msgid "number or constant in parentheses must be greater than zero" -msgstr "" - -#: cobc/tree.c:3002 -msgid "parentheses must be preceded by a picture symbol" -msgstr "" - -#: cobc/tree.c:3032 -msgid "unbalanced parentheses" -msgstr "" - -#: cobc/tree.c:3040 -msgid "parentheses must contain an unsigned integer" -msgstr "" - -#: cobc/tree.c:3078 -#, fuzzy, c-format -msgid "'%s' is not a constant-name" -msgstr "'%s' is geen report naam" - -#: cobc/tree.c:3085 -#, fuzzy, c-format -msgid "'%s' is not a numeric literal" -msgstr "'%s' is geen numerieke waarde" - -#: cobc/tree.c:3089 -#, fuzzy, c-format -msgid "'%s' is not an integer" -msgstr "'%s' is geen heel getal" - -#: cobc/tree.c:3093 -#, fuzzy, c-format -msgid "'%s' is not unsigned" -msgstr "'%s' is niet gedefinieerd" - -#: cobc/tree.c:3149 -msgid "missing PICTURE string" -msgstr "" - -#: cobc/tree.c:3178 -msgid "C must be followed by R" -msgstr "" - -#: cobc/tree.c:3181 -msgid "D must be followed by B" -msgstr "" - -#: cobc/tree.c:3195 cobc/tree.c:3264 cobc/tree.c:3290 cobc/tree.c:3401 -msgid "uncommon parentheses" -msgstr "" - -#: cobc/tree.c:3219 -msgid "exponent" -msgstr "" - -#: cobc/tree.c:3272 -msgid "S must be at start of PICTURE string" -msgstr "" - -#: cobc/tree.c:3328 -msgid "P must be at start or end of PICTURE string" -msgstr "" - -#: cobc/tree.c:3358 -msgid "cannot have both Z and * in PICTURE string" -msgstr "" - -#: cobc/tree.c:3436 -#, fuzzy, c-format -msgid "invalid PICTURE character '%c'" -msgstr "Figuratieve constante ongeldig hier" - -#: cobc/tree.c:3466 -#, c-format -msgid "PICTURE string may not contain more than %d characters; contains %d characters" -msgstr "" - -#: cobc/tree.c:3471 -msgid "PICTURE string must contain at least one of the set A, N, X, Z, 1, 9 and *; or at least two of the set +, - and the currency symbol" -msgstr "" - -#: cobc/tree.c:3498 -#, fuzzy, c-format -msgid "numeric field cannot be larger than %d digits" -msgstr "Numeriek veld mag niet groter zijn dan %d cijfers" - -#: cobc/tree.c:3954 cobc/tree.c:3967 -#, c-format -msgid "no DETAIL line defined in report %s" -msgstr "" - -#: cobc/tree.c:3969 -msgid "PAGE LIMIT FIRST DETAIL should be >= HEADING" -msgstr "" - -#: cobc/tree.c:3972 -msgid "PAGE LIMIT FOOTING should be >= HEADING" -msgstr "" - -#: cobc/tree.c:3974 -msgid "PAGE LIMIT LAST DETAIL should be >= FIRST DETAIL" -msgstr "" - -#: cobc/tree.c:3976 -msgid "PAGE LIMIT FOOTING should be >= LAST DETAIL" -msgstr "" - -#: cobc/tree.c:3978 -msgid "PAGE LIMIT LINES should be >= FOOTING" -msgstr "" - -#: cobc/tree.c:4162 -#, c-format -msgid "maximum keys (%d/%d) exceeded for file '%s'" -msgstr "" - -#: cobc/tree.c:4226 cobc/tree.c:4249 -#, fuzzy, c-format -msgid "invalid KEY item '%s', not in file '%s'" -msgstr "Ongeldig KEY item '%s'" - -#: cobc/tree.c:4260 -#, c-format -msgid "minimal record length %d can not hold the key item '%s'; needs to be at least %d" -msgstr "" - -#: cobc/tree.c:4296 -#, c-format -msgid "missing file description for %s" -msgstr "" - -#: cobc/tree.c:4328 -#, fuzzy, c-format -msgid "size of record '%s' (%d) smaller than minimum of file '%s' (%d)" -msgstr "Lengte van '%s' groter dan lengte van '%s'" - -#: cobc/tree.c:4331 cobc/tree.c:4348 -msgid "file size adjusted" -msgstr "" - -#: cobc/tree.c:4343 -#, fuzzy, c-format -msgid "size of record '%s' (%d) larger than maximum of file '%s' (%d)" -msgstr "Lengte van '%s' groter dan lengte van '%s'" - -#: cobc/tree.c:4386 -#, c-format -msgid "file '%s': RECORD VARYING specified without limits, but implied limits are equal" -msgstr "" - -#: cobc/tree.c:4393 -#, fuzzy, c-format -msgid "file '%s': record size (IDX) %d exceeds maximum allowed (%d)" -msgstr "Record grootte overschrijdt maximum toegestaan (%d) - Bestand '%s'" - -#: cobc/tree.c:4397 -#, fuzzy, c-format -msgid "file '%s': record size %d exceeds maximum allowed (%d)" -msgstr "Record grootte overschrijdt maximum toegestaan (%d) - Bestand '%s'" - -#: cobc/tree.c:4404 -msgid "RECORD DELIMITER clause on file with fixed-length records" -msgstr "" - -#: cobc/tree.c:4965 -#, fuzzy, c-format -msgid "literal '%.38s' is longer than '%s'" -msgstr "Lengte van '%s' groter dan lengte van '%s'" - -#: cobc/tree.c:4969 -#, c-format -msgid "literal '%.38s' is longer than reference-modification of '%s'" -msgstr "" - -#: cobc/tree.c:4994 -#, c-format -msgid "literal '%s' is alphanumeric but '%s' is numeric" -msgstr "" - -#: cobc/tree.c:5036 -#, c-format -msgid "literal '%s' has more decimals than '%s'" -msgstr "" - -#: cobc/tree.c:5078 -#, c-format -msgid "literal '%s' has more digits than '%s'" -msgstr "" - -#: cobc/tree.c:5118 cobc/tree.c:5142 -#, c-format -msgid "unsigned '%s' may not be %s %s" -msgstr "" - -#: cobc/tree.c:5128 cobc/tree.c:5151 -#, c-format -msgid "unsigned '%s' may always be %s %s" -msgstr "" - -#: cobc/tree.c:5184 cobc/tree.c:5209 -#, fuzzy, c-format -msgid "'%s' may not be %s %s" -msgstr "'%s' kan hier niet worden geïndexeerd" - -#: cobc/tree.c:5195 cobc/tree.c:5220 -#, c-format -msgid "'%s' may always be %s %s" -msgstr "" - -#: cobc/tree.c:5355 -#, fuzzy -msgid "divide by constant ZERO" -msgstr "Ongeldige constante" - -#: cobc/tree.c:5404 cobc/tree.c:5409 cobc/tree.c:5630 cobc/tree.c:5670 -#: cobc/typeck.c:4476 cobc/typeck.c:4484 cobc/typeck.c:4491 cobc/typeck.c:5561 -#: cobc/typeck.c:5706 -#, fuzzy -msgid "invalid expression" -msgstr "Ongeldige expressie" - -#: cobc/tree.c:5627 -#, fuzzy, c-format -msgid "invalid expression: %s %s %s" -msgstr "Ongeldige expressie" - -#: cobc/tree.c:5675 -#, fuzzy, c-format -msgid "unexpected operator: %d" -msgstr "Onverwachte operator -> %d" - -#: cobc/tree.c:5685 -#, c-format -msgid "expression '%.38s' %s '%.38s' is always TRUE" -msgstr "" - -#: cobc/tree.c:5691 -msgid "expression is always TRUE" -msgstr "" - -#: cobc/tree.c:5703 -#, c-format -msgid "expression '%.38s' %s '%.38s' is always FALSE" -msgstr "" - -#: cobc/tree.c:5709 -msgid "expression is always FALSE" -msgstr "" - -#: cobc/tree.c:6024 -msgid "PERFORM FOREVER since UNTIL is always FALSE" -msgstr "" - -#: cobc/tree.c:6028 -msgid "PERFORM ONCE since UNTIL is always TRUE" -msgstr "" - -#: cobc/tree.c:6031 -msgid "PERFORM NEVER since UNTIL is always TRUE" -msgstr "" - -#: cobc/tree.c:6132 -#, fuzzy, c-format -msgid "no definition/prototype seen for FUNCTION '%s'" -msgstr "%s: Geen definitie voor '%s'" - -#: cobc/tree.c:6134 -#, fuzzy, c-format -msgid "no definition/prototype seen for PROGRAM '%s'" -msgstr "%s: Geen definitie voor '%s'" - -#: cobc/tree.c:6143 -#, fuzzy, c-format -msgid "no definition/prototype seen for FUNCTION with external name '%s'" -msgstr "%s: Geen definitie voor '%s'" - -#: cobc/tree.c:6145 -#, fuzzy, c-format -msgid "no definition/prototype seen for PROGRAM with external name '%s'" -msgstr "%s: Geen definitie voor '%s'" - -#: cobc/tree.c:6237 -#, fuzzy, c-format -msgid "FUNCTION %s has invalid argument" -msgstr "FUNCTION '%s' heeft een ongeldige parameter" - -#: cobc/tree.c:6239 -#, c-format -msgid "either all arguments or none should be if type %s" -msgstr "" - -#: cobc/tree.c:6271 cobc/tree.c:6277 cobc/tree.c:6319 cobc/tree.c:6324 -#, c-format -msgid "FUNCTION '%s' has invalid reference modification" -msgstr "FUNCTION '%s' heeft ongeldige verwijzingsmodificatie" - -#: cobc/tree.c:6288 cobc/tree.c:6730 -#, c-format -msgid "FUNCTION '%s' unknown" -msgstr "FUNCTION '%s' onbekend" - -#: cobc/tree.c:6292 -#, fuzzy, c-format -msgid "FUNCTION '%s' is not implemented" -msgstr "FUNCTION '%s' niet geïmplementeerd" - -#: cobc/tree.c:6299 cobc/tree.c:6306 cobc/tree.c:6714 -#, c-format -msgid "FUNCTION '%s' has wrong number of arguments" -msgstr "FUNCTION '%s' aantal argumenten incorrect" - -#: cobc/tree.c:6313 -#, fuzzy, c-format -msgid "FUNCTION '%s' cannot have reference modification" -msgstr "FUNCTION '%s' kan geen verwijzingsmodificatie hebben" - -#: cobc/tree.c:6572 cobc/tree.c:6646 cobc/tree.c:6652 cobc/tree.c:6660 -#: cobc/tree.c:6668 -#, fuzzy, c-format -msgid "FUNCTION '%s' has invalid argument" -msgstr "FUNCTION '%s' heeft een ongeldige parameter" - -#: cobc/tree.c:6720 -#, fuzzy, c-format -msgid "FUNCTION '%s' has invalid first argument" -msgstr "FUNCTION '%s' heeft een ongeldige eerste parameter" - -#: cobc/typeck.c:686 -#, fuzzy, c-format -msgid "%s item not allowed here: '%s'" -msgstr "%s niet toegestaan hier" - -#: cobc/typeck.c:728 -#, fuzzy, c-format -msgid "'%s' is not a group name" -msgstr "'%s' is geen groep naam" - -#: cobc/typeck.c:753 -#, c-format -msgid "'%s' is not a numeric name" -msgstr "'%s' is geen numerieke naam" - -#: cobc/typeck.c:782 -#, fuzzy, c-format -msgid "'%s' is not a numeric or numeric-edited name" -msgstr "'%s' is niet numeriek of numeriek-opmaak naam" - -#: cobc/typeck.c:835 -#, fuzzy, c-format -msgid "'%s' is Alpha, instead of a numeric value" -msgstr "'%s' is geen numerieke waarde" - -#: cobc/typeck.c:838 -#, fuzzy, c-format -msgid "'%s' is Alpha Edited, instead of a numeric value" -msgstr "'%s' is geen numerieke waarde" - -#: cobc/typeck.c:851 -#, c-format -msgid "'%s' is not a numeric value" -msgstr "'%s' is geen numerieke waarde" - -#: cobc/typeck.c:901 -#, c-format -msgid "'%s' is not an integer value" -msgstr "'%s' is geen heel getal" - -#: cobc/typeck.c:905 -#, fuzzy -msgid "positive numeric integer is required here" -msgstr "Een positief numeriek heel getal is hier verplicht" - -#: cobc/typeck.c:1022 -#, fuzzy -msgid "System routine" -msgstr "GNU Cobol Bouw omgeving" - -#: cobc/typeck.c:1638 libcob/call.c:1069 -#, c-format -msgid "'%s' literal includes leading spaces which are omitted" -msgstr "" - -#: cobc/typeck.c:1642 -#, c-format -msgid "'%s' literal includes trailing spaces which are omitted" -msgstr "" - -#: cobc/typeck.c:1709 -msgid "ON/OFF usage requires a SWITCH name" -msgstr "ON/OFF gebruik vereist een SWITCH naam" - -#: cobc/typeck.c:1727 -#, fuzzy, c-format -msgid "word length exceeds maximum of %d characters: '%s'" -msgstr "Woord lengte overschrijdt 31 karakters - '%s'" - -#: cobc/typeck.c:1730 cobc/typeck.c:1733 -#, fuzzy, c-format -msgid "word length exceeds %d characters: '%s'" -msgstr "Woord lengte overschrijdt 31 karakters - '%s'" - -#: cobc/typeck.c:1810 -#, fuzzy, c-format -msgid "ASSIGN %s interpreted as '%s'" -msgstr "ASSIGN geïnterpreteerd als %s" - -#: cobc/typeck.c:1900 cobc/typeck.c:2067 -#, fuzzy, c-format -msgid "subscript missing for '%s' - defaulting to 1" -msgstr "Index ontbreekt voor '%s' - Standaard 1" - -#: cobc/typeck.c:1913 cobc/typeck.c:1992 -#, c-format -msgid "'%s' cannot be reference modified" -msgstr "'%s' accepteert geen verwijzingsmodificatie" - -#: cobc/typeck.c:1923 cobc/typeck.c:1988 cobc/typeck.c:2256 -#, c-format -msgid "'%s' cannot be subscripted" -msgstr "'%s' accepteert geen index" - -#: cobc/typeck.c:1927 cobc/typeck.c:2260 -#, fuzzy, c-format -msgid "'%s' requires one subscript" -msgstr "'%s' vereist 1 index" - -#: cobc/typeck.c:1930 cobc/typeck.c:2263 -#, c-format -msgid "'%s' requires %d subscripts" -msgstr "'%s' vereist %d indices" - -#. TRANSLATORS: This msgid is used when a variable name -#. or label is referenced in a compiler message. -#: cobc/typeck.c:1946 -#, c-format -msgid "'%s'" -msgstr "" - -#: cobc/typeck.c:1948 -#, c-format -msgid "'%s' (accessed by '%s')" -msgstr "" - -#: cobc/typeck.c:2051 -#, c-format -msgid "'%s' has no OCCURS clause" -msgstr "'%s' heeft geen OCCURS clausule" - -#: cobc/typeck.c:2108 libcob/common.c:3114 -#, fuzzy, c-format -msgid "subscript of '%s' out of bounds: %d" -msgstr "Index van '%s' buiten grens: %d" - -#: cobc/typeck.c:2162 cobc/typeck.c:2172 -msgid "offset must be greater than zero" -msgstr "" - -#: cobc/typeck.c:2167 cobc/typeck.c:2185 cobc/typeck.c:2204 -msgid "length must be greater than zero" -msgstr "" - -#: cobc/typeck.c:2175 cobc/typeck.c:2178 libcob/common.c:3136 -#, fuzzy, c-format -msgid "offset of '%s' out of bounds: %d" -msgstr "Start positie van '%s' buiten grens: %d" - -#: cobc/typeck.c:2189 cobc/typeck.c:2193 cobc/typeck.c:2207 cobc/typeck.c:2211 -#: libcob/common.c:3149 -#, fuzzy, c-format -msgid "length of '%s' out of bounds: %d" -msgstr "Lengte van '%s' buiten grens: %d" - -#: cobc/typeck.c:2323 cobc/typeck.c:2407 -#, fuzzy -msgid "reference modification not allowed here" -msgstr "Verwijzingsmodificatie hier niet toegestaan" - -#: cobc/typeck.c:2337 cobc/typeck.c:2433 -msgid "88 level item not allowed here" -msgstr "88 nivo item hier niet toegestaan" - -#: cobc/typeck.c:2342 -#, c-format -msgid "LENGTH OF '%s' not allowed outside of Procedure Division" -msgstr "" - -#: cobc/typeck.c:2346 cobc/typeck.c:2437 cobc/typeck.c:2445 cobc/typeck.c:2512 -#, fuzzy -msgid "variable length item not allowed here" -msgstr "Variabele lengte hier niet toegestaan here" - -#: cobc/typeck.c:2375 -#, fuzzy, c-format -msgid "'%s' has not been DEFINEd" -msgstr "'%s' is niet in DECLARATIVES" - -#: cobc/typeck.c:2411 -#, fuzzy -msgid "only field names allowed here" -msgstr "88 nivo item hier niet toegestaan" - -#: cobc/typeck.c:2422 -#, c-format -msgid "VALUE of '%s': %s target '%s' is invalid" -msgstr "" - -#: cobc/typeck.c:2424 cobc/typeck.c:2494 -#, fuzzy -msgid "target must be in FILE SECTION or LINKAGE SECTION or have the EXTERNAL clause" -msgstr "RETURNING item is niet in LINKAGE SECTION en niet BASED" - -#: cobc/typeck.c:2480 cobc/typeck.c:2493 -#, fuzzy, c-format -msgid "VALUE of '%s': %s target is invalid" -msgstr "SET doel is omgeldig - '%s'" - -#: cobc/typeck.c:2482 -#, fuzzy -msgid "no previous data-item found" -msgstr "geen eerder data item met nivo %02d" - -#: cobc/typeck.c:2667 -#, c-format -msgid "'%s' is not an alphabet name" -msgstr "'%s' is geen alfabet naam" - -#: cobc/typeck.c:2931 -#, fuzzy, c-format -msgid "duplicate character values in alphabet '%s': %s" -msgstr "Dubbele karakter waarde in alfabet '%s'" - -#: cobc/typeck.c:2936 -#, fuzzy, c-format -msgid "invalid character values in alphabet '%s', starting at position %d" -msgstr "Ongeldige karakter waarde in alfabet '%s'" - -#: cobc/typeck.c:2990 -#, fuzzy -msgid "invalid ALPHABET name" -msgstr "Ongeldige ALPHABET naam" - -#: cobc/typeck.c:3054 -#, fuzzy, c-format -msgid "duplicate character values in class '%s'" -msgstr "Dubbele waarden in class '%s'" - -#: cobc/typeck.c:3072 -#, c-format -msgid "'%s' is not a locale name" -msgstr "'%s' is niet een LOCALE naam" - -#: cobc/typeck.c:3206 -#, fuzzy -msgid "invalid RECORD DEPENDING item" -msgstr "Ongeldig RECORD DEPENDING item" - -#: cobc/typeck.c:3211 -msgid "RECORD DEPENDING must reference a data-item" -msgstr "" - -#: cobc/typeck.c:3234 -#, fuzzy, c-format -msgid "RECORD DEPENDING item '%s' should be defined in WORKING-STORAGE, LOCAL-STORAGE or LINKAGE SECTION" -msgstr "RECORD DEPENDING item moet in WORKING/LOCAL/LINKAGE sectie" - -#: cobc/typeck.c:3247 -#, fuzzy, c-format -msgid "file %s: RELATIVE KEY %s is not numeric" -msgstr "Numeriek veld mag niet groter zijn dan %d cijfers" - -#: cobc/typeck.c:3256 -#, c-format -msgid "file %s: RELATIVE KEY %s must be integer" -msgstr "" - -#: cobc/typeck.c:3261 -#, c-format -msgid "file %s: RELATIVE KEY %s must be unsigned" -msgstr "" - -#: cobc/typeck.c:3268 -#, c-format -msgid "file %s: RELATIVE KEY %s cannot have OCCURS" -msgstr "" - -#: cobc/typeck.c:3274 -#, c-format -msgid "RELATIVE KEY %s cannot be in file record belonging to %s" -msgstr "" - -#: cobc/typeck.c:3283 -#, c-format -msgid "file %s: RELATIVE KEY %s declared outside WORKING-STORAGE" -msgstr "" - -#: cobc/typeck.c:3306 cobc/typeck.c:7184 -#, c-format -msgid "'%s' is not a valid data name" -msgstr "'%s' is geen geldige data naam" - -#: cobc/typeck.c:3313 -#, fuzzy, c-format -msgid "CRT STATUS item '%s' should be defined in WORKING-STORAGE or LOCAL-STORAGE" -msgstr "RECORD DEPENDING item moet in WORKING/LOCAL/LINKAGE sectie" - -#: cobc/typeck.c:3319 -#, fuzzy, c-format -msgid "'%s' CRT STATUS must have at least 4 digits" -msgstr "'%s' CRT STATUS is niet 4 karakters lang" - -#: cobc/typeck.c:3325 -#, fuzzy, c-format -msgid "'%s' CRT STATUS must be 4 characters long" -msgstr "'%s' CRT STATUS is niet 4 karakters lang" - -#: cobc/typeck.c:3341 -#, fuzzy, c-format -msgid "variable '%s' will be implicitly defined" -msgstr "'%s' wordt impliciet gedefinieerd" - -#: cobc/typeck.c:3375 cobc/typeck.c:3438 -msgid "ASSIGN variable" -msgstr "" - -#: cobc/typeck.c:3443 -#, fuzzy, c-format -msgid "ASSIGN data item '%s' is invalid" -msgstr "ASSIGN data item '%s' ongeldig" - -#: cobc/typeck.c:3507 -#, fuzzy, c-format -msgid "'%s' CURSOR must be 4 or 6 characters long" -msgstr "'%s' CURSOR is niet 4 of 6 karakters lang" - -#: cobc/typeck.c:3557 cobc/typeck.c:3561 -#, fuzzy, c-format -msgid "%s does not have a fixed location" -msgstr "FUNCTION '%s' kan geen verwijzingsmodificatie hebben" - -#: cobc/typeck.c:3573 -#, fuzzy, c-format -msgid "'%s' cannot have nested OCCURS DEPENDING" -msgstr "'%s' kan geen OCCURS DEPENDING hebben" - -#: cobc/typeck.c:3587 -#, fuzzy, c-format -msgid "'%s' OCCURS DEPENDING ON field item invalid here" -msgstr "'%s' ODO veld item is hier ongeldig" - -#: cobc/typeck.c:3595 -#, fuzzy, c-format -msgid "'%s' cannot have OCCURS DEPENDING because of '%s'" -msgstr "'%s' kan geen OCCURS DEPENDING hebben" - -#: cobc/typeck.c:3607 -#, fuzzy, c-format -msgid "'%s' OCCURS DEPENDING ON item must have GLOBAL attribute" -msgstr "'%s' ODO item moet GLOBAL attribute hebben" - -#: cobc/typeck.c:3621 -#, c-format -msgid "PASSWORD '%s' for EXTERNAL file '%s' must have EXTERNAL attribute" -msgstr "" - -#: cobc/typeck.c:3644 -#, c-format -msgid "file %s: ASSIGN %s declared outside WORKING-STORAGE" -msgstr "" - -#: cobc/typeck.c:3674 -#, fuzzy, c-format -msgid "duplicate APPLY COMMIT target: '%s'" -msgstr "Ongeldig DEFINE/SET statement" - -#: cobc/typeck.c:3688 -#, fuzzy -msgid "APPLY COMMIT statement invalid for SORT file" -msgstr "USE statement ongeldig voor SORT bestand" - -#: cobc/typeck.c:3691 -#, fuzzy -msgid "APPLY COMMIT statement invalid for REPORT file" -msgstr "USE statement ongeldig voor SORT bestand" - -#: cobc/typeck.c:3698 -#, fuzzy, c-format -msgid "APPLY COMMIT item '%s' should be defined in WORKING-STORAGE or LOCAL-STORAGE" -msgstr "RECORD DEPENDING item moet in WORKING/LOCAL/LINKAGE sectie" - -#: cobc/typeck.c:3712 -#, fuzzy, c-format -msgid "item not allowed here: '%s'" -msgstr "%s niet toegestaan hier" - -#: cobc/typeck.c:3725 -#, fuzzy, c-format -msgid "%s may not be subscripted" -msgstr "'%s' accepteert geen index" - -#: cobc/typeck.c:3729 -#, fuzzy, c-format -msgid "%s may not be reference modified" -msgstr "'%s' accepteert geen verwijzingsmodificatie" - -#: cobc/typeck.c:3789 -#, fuzzy, c-format -msgid "DEBUGGING target invalid: '%s'" -msgstr "'%s' - DEBUGGING doel ongeldig" - -#: cobc/typeck.c:3795 -#, fuzzy, c-format -msgid "DEBUGGING target already specified with ALL PROCEDURES: '%s'" -msgstr "'%s' - DEBUGGING doel ongeldig met ALL PROCEDURES" - -#: cobc/typeck.c:3815 -#, fuzzy -msgid "DEBUGGING target" -msgstr "'%s' - DEBUGGING doel ongeldig" - -#: cobc/typeck.c:3822 -#, c-format -msgid "'%s' is not a valid DEBUGGING target" -msgstr "'%s' is geen geldig DEBUGGING doel" - -#: cobc/typeck.c:3860 cobc/typeck.c:3865 -#, c-format -msgid "'%s' is not in DECLARATIVES" -msgstr "'%s' is niet in DECLARATIVES" - -#: cobc/typeck.c:3877 -#, fuzzy, c-format -msgid "invalid reference to '%s' (in DECLARATIVES)" -msgstr "Ongeldige verwijzing naar '%s' (In DECLARATIVES)" - -#: cobc/typeck.c:3886 -#, fuzzy, c-format -msgid "'%s' is not a procedure name" -msgstr "'%s' geen procedure naam" - -#: cobc/typeck.c:3948 -#, c-format -msgid "LINKAGE item '%s' is not a PROCEDURE USING parameter" -msgstr "LINKAGE item '%s' is niet een PROCEDURE USING parameter" - -#: cobc/typeck.c:4001 -#, c-format -msgid "'%s' is not an alterable paragraph" -msgstr "'%s' is te wijzigen paragraaf" - -#: cobc/typeck.c:4604 cobc/typeck.c:4608 -#, fuzzy, c-format -msgid "suggest parentheses around %s within %s" -msgstr "Suggestie haken om AND binnen OR" - -#: cobc/typeck.c:4616 -#, fuzzy -msgid "invalid conditional expression" -msgstr "Ongeldige expressie" - -#: cobc/typeck.c:4726 -#, fuzzy, c-format -msgid "internal decimal structure size exceeded: %d" -msgstr "Interne decimal structuur grootte overschrijdt - %d" - -#: cobc/typeck.c:4729 -msgid "Try to minimize the number of parentheses or split into multiple computations." -msgstr "" - -#: cobc/typeck.c:4753 -#, c-format -msgid "more than %d nested expressions" -msgstr "" - -#: cobc/typeck.c:4795 -msgid "precision of result may change with arithmetic-osvs" -msgstr "" - -#: cobc/typeck.c:4851 -#, fuzzy, c-format -msgid "unexpected operation: %c (%d)" -msgstr "Onverwachte operatie %d" - -#: cobc/typeck.c:4856 -#, c-format -msgid "%s operator may be misplaced" -msgstr "" - -#: cobc/typeck.c:4926 -#, fuzzy -msgid "unexpected constant expansion" -msgstr "Onverwachte constante expansie" - -#: cobc/typeck.c:5747 -#, c-format -msgid "more than %d nested conditions" -msgstr "" - -#: cobc/typeck.c:6104 cobc/typeck.c:6180 -#, fuzzy -msgid "no CORRESPONDING items found" -msgstr "Geen CORRESPONDING items gevonden" - -#: cobc/typeck.c:6252 -msgid "no items to ACCEPT found" -msgstr "" - -#: cobc/typeck.c:6302 -#, fuzzy -msgid "no items to DISPLAY found" -msgstr "Ongeldig type voor DISPLAY operand" - -#: cobc/typeck.c:6421 -msgid "cannot specify figurative constant ZERO in AT clause" -msgstr "" - -#: cobc/typeck.c:6425 -#, fuzzy -msgid "value in AT clause is not numeric" -msgstr "Numeriek veld mag niet groter zijn dan %d cijfers" - -#: cobc/typeck.c:6431 -#, fuzzy -msgid "value in AT clause must have 4 or 6 digits" -msgstr "Numeriek veld mag niet groter zijn dan %d cijfers" - -#: cobc/typeck.c:6553 -#, fuzzy -msgid "invalid PROMPT literal" -msgstr "Ongeldige PROMPT constante" - -#: cobc/typeck.c:6558 -#, fuzzy -msgid "invalid PROMPT identifier" -msgstr "Ongeldige PROMPT identifier" - -#: cobc/typeck.c:6848 -#, fuzzy, c-format -msgid "'%s' is not an input device" -msgstr "'%s' is geen uitvoer apparaat" - -#: cobc/typeck.c:6878 cobc/typeck.c:8016 -#, c-format -msgid "'%s' is not defined in SPECIAL-NAMES" -msgstr "'%s' is niet definieerd in SPECIAL-NAMES" - -#: cobc/typeck.c:6883 -#, fuzzy, c-format -msgid "invalid input device '%s'" -msgstr "Ongeldige invoer apparaat '%s'" - -#: cobc/typeck.c:6888 cobc/typeck.c:8020 -#, c-format -msgid "unknown device '%s'; it may exist in another dialect" -msgstr "" - -#: cobc/typeck.c:6891 cobc/typeck.c:8023 -#, fuzzy, c-format -msgid "unknown device '%s'; not defined in SPECIAL-NAMES" -msgstr "'%s' is niet definieerd in SPECIAL-NAMES" - -#: cobc/typeck.c:6915 -#, fuzzy -msgid "target of ALLOCATE is not a BASED item" -msgstr "Doel van ALLOCATE is geen BASED item" - -#: cobc/typeck.c:6926 -#, fuzzy -msgid "target of RETURNING is not a data pointer" -msgstr "Doel van RETURNING is geen data pointer" - -#: cobc/typeck.c:6936 cobc/typeck.c:7342 -msgid "amount must be specified as a numeric expression" -msgstr "" - -#: cobc/typeck.c:6949 -msgid "INITIALIZED TO item is not alphanumeric" -msgstr "INITIALIZED TO item is niet alfanumeriek" - -#: cobc/typeck.c:7019 -#, fuzzy -msgid "only alphanumeric FUNCTION types are allowed here" -msgstr "Alleen alphanumerieke FUNCTION types zijn hier toegestaan" - -#: cobc/typeck.c:7027 -#, fuzzy -msgid "invalid RETURNING field" -msgstr "Ongeldig RETURNING veld" - -#: cobc/typeck.c:7046 -msgid "STDCALL not available on this platform" -msgstr "STDCALL niet beschikbaar op dit platform" - -#: cobc/typeck.c:7050 -msgid "STDCALL used on 64-bit Windows platform" -msgstr "STDCALL gebruikt op 64-bit Windows platform" - -#: cobc/typeck.c:7055 -msgid "STATIC CALL convention requires a literal program name" -msgstr "STATIC CALL conventie vereist een constante als programma naam" - -#: cobc/typeck.c:7060 cobc/typeck.c:10632 cobc/typeck.c:11539 -#: cobc/typeck.c:11903 -msgid "HANDLE must be either a generic or a THREAD HANDLE" -msgstr "" - -#: cobc/typeck.c:7078 -#, fuzzy -msgid "numeric literal is negative" -msgstr "Numerieke constante is negatief" - -#: cobc/typeck.c:7157 -#, fuzzy -msgid "numeric literal exceeds size limits" -msgstr "Numerieke constante overschrijdt de maximum grootte" - -#: cobc/typeck.c:7175 -#, fuzzy, c-format -msgid "figurative constant %s invalid here" -msgstr "Figuratieve constante ongeldig hier" - -#: cobc/typeck.c:7190 -#, c-format -msgid "'%s' ANY LENGTH item not passed BY REFERENCE" -msgstr "'%s' ANY LENGTH item niet doorgegeven BY REFERENCE" - -#: cobc/typeck.c:7198 -#, c-format -msgid "'%s' is not a 01 or 77 level item" -msgstr "'%s' is geen 01 of 77 nivo item" - -#: cobc/typeck.c:7228 cobc/typeck.c:7233 -#, fuzzy, c-format -msgid "wrong number of CALL parameters for '%s', %d given, %d expected" -msgstr "Verkeerd aantal CALL parameters voor '%s'" - -#: cobc/typeck.c:7300 cobc/typeck.c:7374 cobc/typeck.c:7378 cobc/typeck.c:7382 -#: cobc/typeck.c:7412 cobc/typeck.c:10591 cobc/typeck.c:10755 -#: cobc/typeck.c:10944 cobc/typeck.c:10948 cobc/typeck.c:11844 -#: cobc/typeck.c:12087 cobc/typeck.c:12090 -#, fuzzy, c-format -msgid "%s not allowed on %s files" -msgstr "%s niet toegestaan bij %s bestanden" - -#: cobc/typeck.c:7336 -msgid "AFTER phrase in CONTINUE statement" -msgstr "" - -#: cobc/typeck.c:7478 -msgid "positions cannot be specified for main windows" -msgstr "" - -#: cobc/typeck.c:7488 cobc/typeck.c:7491 cobc/typeck.c:7508 -msgid "HANDLE must be either a generic or a WINDOW HANDLE or X(10)" -msgstr "" - -#: cobc/typeck.c:7617 -#, c-format -msgid "'%s' is an invalid type for DISPLAY operand" -msgstr "'%s' is een ongeldig type voor DISPLAY operand" - -#: cobc/typeck.c:7622 -#, fuzzy -msgid "invalid type for DISPLAY operand" -msgstr "Ongeldig type voor DISPLAY operand" - -#: cobc/typeck.c:7973 cobc/typeck.c:8006 -#, c-format -msgid "'%s' is not an output device" -msgstr "'%s' is geen uitvoer apparaat" - -#: cobc/typeck.c:8109 -#, fuzzy -msgid "invalid use of 88 level in WHEN expression" -msgstr "Ongeldig gebruik van 88 nivo in WHEN expressie" - -#: cobc/typeck.c:8165 -#, fuzzy -msgid "wrong number of WHEN parameters" -msgstr "Verkeerd aantal WHEN parameters" - -#: cobc/typeck.c:8244 cobc/typeck.c:8256 -#, fuzzy, c-format -msgid "target %d of FREE is not a BASED data item" -msgstr "Doel %d van FREE is geen BASED data item" - -#: cobc/typeck.c:8262 -#, fuzzy, c-format -msgid "target %d of FREE must be a data pointer" -msgstr "Doel %d van FREE moet een data pointer zijn" - -#: cobc/typeck.c:8276 -#, fuzzy -msgid "GO TO without procedure-name" -msgstr "GO TO met meerdere procedure-namen" - -#: cobc/typeck.c:8286 -msgid "GO TO with multiple procedure-names" -msgstr "GO TO met meerdere procedure-namen" - -#: cobc/typeck.c:8308 -#, fuzzy -msgid "GO TO ENTRY with multiple entry-names" -msgstr "GO TO met meerdere procedure-namen" - -#: cobc/typeck.c:8367 -#, fuzzy -msgid "invalid INITIALIZE statement" -msgstr "Ongeldig SET statement" - -#: cobc/typeck.c:8443 cobc/typeck.c:8446 -#, fuzzy, c-format -msgid "%s operands differ in size" -msgstr "%s operands verschillen in grootte" - -#: cobc/typeck.c:8476 -#, fuzzy, c-format -msgid "unexpected clause %d" -msgstr "Onverwachte grootte" - -#: cobc/typeck.c:8545 cobc/typeck.c:8556 cobc/typeck.c:8567 cobc/typeck.c:8578 -#, fuzzy, c-format -msgid "data name expected before %s" -msgstr "Data naam verwacht voor %s" - -#: cobc/typeck.c:8588 -#, c-format -msgid "ALL, LEADING or TRAILING expected before '%s'" -msgstr "ALL, LEADING of TRAILING verwacht voor '%s'" - -#: cobc/typeck.c:8598 -#, fuzzy -msgid "operand has wrong size" -msgstr "Operand heeft verkeerde grootte" - -#: cobc/typeck.c:8669 -#, fuzzy, c-format -msgid "internal register '%s' defined as BINARY-LONG" -msgstr "Intern register '%s' gedefinieerd als BINARY-LONG" - -#: cobc/typeck.c:8672 cobc/typeck.c:8675 cobc/typeck.c:8678 cobc/typeck.c:8681 -#: cobc/typeck.c:8684 cobc/typeck.c:8687 cobc/typeck.c:8690 cobc/typeck.c:8693 -#: cobc/typeck.c:8696 -#, c-format -msgid "'%s' defined here as USAGE %s" -msgstr "'%s' hier gedefinieerd als USAGE %s" - -#: cobc/typeck.c:8699 -#, c-format -msgid "'%s' defined here as PIC %s" -msgstr "'%s' hier gedefinieerd als PIC %s" - -#: cobc/typeck.c:8702 -#, c-format -msgid "'%s' defined here as a group of length %d" -msgstr "'%s' hier gedefinieerd als een groep met lengte %d" - -#: cobc/typeck.c:8741 -#, c-format -msgid "value is %s" -msgstr "" - -#: cobc/typeck.c:8745 -#, fuzzy, c-format -msgid "value size is %d" -msgstr "Grootte van de waarde overschrijdt de data grootte" - -#: cobc/typeck.c:9022 -#, fuzzy -msgid "invalid destination for MOVE" -msgstr "Ongeldige bestemming voor MOVE" - -#: cobc/typeck.c:9057 -#, fuzzy -msgid "MOVE of figurative constant SPACE to numeric item" -msgstr "Figuratieve constante ongeldig hier" - -#: cobc/typeck.c:9072 -msgid "MOVE of figurative constant QUOTE to numeric item" -msgstr "" - -#: cobc/typeck.c:9077 cobc/typeck.c:9089 -#, fuzzy -msgid "MOVE of figurative constant to numeric item" -msgstr "Figuratieve constante ongeldig hier" - -#: cobc/typeck.c:9151 -msgid "numeric literal in VALUE clause of numeric-edited item" -msgstr "" - -#: cobc/typeck.c:9176 -#, fuzzy -msgid "numeric move to ALPHABETIC" -msgstr "Numerieke move naar ALPHABETIC" - -#: cobc/typeck.c:9188 -#, fuzzy -msgid "data item not signed" -msgstr "Data item kent geen teken" - -#: cobc/typeck.c:9191 -#, fuzzy -msgid "ignoring sign" -msgstr "Teken genegeerd" - -#: cobc/typeck.c:9503 -#, fuzzy -msgid "overlapping MOVE may occur and produce unpredictable results" -msgstr "Overlappende MOVE kan onvoorspelbare resultaten geven" - -#: cobc/typeck.c:9510 -#, fuzzy -msgid "overlapping MOVE may produce unpredictable results" -msgstr "Overlappende MOVE kan onvoorspelbare resultaten geven" - -#: cobc/typeck.c:9643 -#, fuzzy -msgid "invalid source for MOVE" -msgstr "Ongeldige bron voor MOVE" - -#: cobc/typeck.c:9666 -#, fuzzy -msgid "source is non-numeric - substituting zero" -msgstr "Bron is niet-numeriek - vervangen door nul" - -#: cobc/typeck.c:9672 cobc/typeck.c:9683 -#, fuzzy -msgid "invalid VALUE clause" -msgstr "Ongeldige VALUE clausule" - -#: cobc/typeck.c:9675 cobc/typeck.c:11480 cobc/typeck.c:11485 -#: cobc/typeck.c:11512 cobc/typeck.c:11517 -#, fuzzy -msgid "invalid SET statement" -msgstr "Ongeldig SET statement" - -#: cobc/typeck.c:9677 -#, fuzzy -msgid "invalid MOVE statement" -msgstr "Ongeldig MOVE statement" - -#: cobc/typeck.c:9684 -#, fuzzy -msgid "literal exceeds data size" -msgstr "Numerieke constante overschrijdt data grootte" - -#: cobc/typeck.c:9688 -#, fuzzy -msgid "numeric literal exceeds data size" -msgstr "Numerieke constante overschrijdt data grootte" - -#: cobc/typeck.c:9697 -#, fuzzy -msgid "MOVE of non-integer to alphanumeric" -msgstr "Move geen heel getal naar alfanumeriek" - -#: cobc/typeck.c:9703 -#, fuzzy -msgid "numeric value is expected" -msgstr "Numerieke waarde verwacht" - -#: cobc/typeck.c:9708 -#, fuzzy -msgid "alphanumeric value is expected" -msgstr "Alanumerieke waarde verwacht" - -#: cobc/typeck.c:9713 -#, fuzzy -msgid "value does not fit the picture string" -msgstr "Waarde past niet in de opmaak string" - -#: cobc/typeck.c:9719 -#, fuzzy -msgid "value size exceeds data size" -msgstr "Grootte van de waarde overschrijdt de data grootte" - -#: cobc/typeck.c:9724 -#, fuzzy -msgid "sending field larger than receiving field" -msgstr "Zendende veld groter dan ontvangende veld" - -#: cobc/typeck.c:9729 -#, fuzzy -msgid "some digits may be truncated" -msgstr "Some cijfers worden mogelijk afgekapt" - -#: cobc/typeck.c:10515 -#, fuzzy, c-format -msgid "invalid MOVE target: %s" -msgstr "Ongeldig MOVE doel - %s" - -#: cobc/typeck.c:10768 -msgid "READ PREVIOUS not allowed for this file type" -msgstr "READ PREVIOUS niet toegestaan bij dit bestands type" - -#: cobc/typeck.c:10776 -msgid "KEY ignored with sequential READ" -msgstr "KEY genegeerd bij sequentiële READ" - -#: cobc/typeck.c:10872 -#, fuzzy -msgid "figurative constants not allowed in FROM clause" -msgstr "Figuratieve constante ongeldig hier" - -#: cobc/typeck.c:10879 -msgid "literal in FROM clause must be alphanumeric, national or boolean" -msgstr "" - -#: cobc/typeck.c:10902 cobc/typeck.c:12047 -#, fuzzy, c-format -msgid "%s FILE requires a FROM clause" -msgstr "Item %s vereist een veld naam" - -#: cobc/typeck.c:10924 cobc/typeck.c:11010 cobc/typeck.c:12069 -#, fuzzy, c-format -msgid "%s subject does not refer to a record name" -msgstr "%s onderwerp verwijst niet naar een record naam" - -#: cobc/typeck.c:11016 -msgid "RELEASE not allowed on this record item" -msgstr "RELEASE niet toegestaan bij this record item" - -#: cobc/typeck.c:11097 cobc/typeck.c:11118 cobc/typeck.c:11125 -#, fuzzy -msgid "invalid SEARCH ALL condition" -msgstr "Ongeldige SEARCH ALL conditie" - -#: cobc/typeck.c:11237 cobc/typeck.c:11241 -msgid "SET targets must be PROGRAM-POINTER" -msgstr "SET doelen moeten PROGRAM-POINTER zijn" - -#: cobc/typeck.c:11268 cobc/typeck.c:11335 cobc/typeck.c:11403 -#, c-format -msgid "cannot change address of '%s', which is not level 1 or 77" -msgstr "" - -#: cobc/typeck.c:11272 cobc/typeck.c:11339 cobc/typeck.c:11407 -#, c-format -msgid "cannot change address of '%s', which is not BASED or a LINKAGE item" -msgstr "" - -#: cobc/typeck.c:11291 -#, c-format -msgid "SET target '%s' is not numeric, an INDEX or a POINTER" -msgstr "" - -#: cobc/typeck.c:11360 -#, fuzzy, c-format -msgid "SET target '%s' is not a POINTER for FCD" -msgstr "SET doelen moeten PROGRAM-POINTER zijn" - -#: cobc/typeck.c:11428 -#, c-format -msgid "SET target '%s' is not a POINTER for FCD-KEYDEF" -msgstr "" - -#: cobc/typeck.c:11521 -#, fuzzy -msgid "field does not have a FALSE clause" -msgstr "Veld heeft geen FALSE clausule" - -#: cobc/typeck.c:11552 -msgid "THREAD-priority must be between 1 and 32767" -msgstr "" - -#: cobc/typeck.c:11572 -msgid "SET ATTRIBUTE requires a screen item as subject" -msgstr "SET ATTRIBUTE vereist een screen item als onderwerp" - -#: cobc/typeck.c:11578 -msgid "SET ATTRIBUTE subject does not refer to a screen item" -msgstr "SET ATTRIBUTE onderwerp verwijst niet naar een screen item" - -#: cobc/typeck.c:11629 -#, fuzzy -msgid "invalid SORT filename" -msgstr "Ongeldige SORT bestandsnaam" - -#: cobc/typeck.c:11689 -#, fuzzy -msgid "invalid SORT USING parameter" -msgstr "Ongeldige SORT USING parameter" - -#: cobc/typeck.c:11718 -#, fuzzy -msgid "invalid SORT GIVING parameter" -msgstr "Ongeldige SORT GIVING parameter" - -#: cobc/typeck.c:11772 cobc/typeck.c:11799 cobc/typeck.c:11819 -#, fuzzy -msgid "invalid key item" -msgstr "Ongeldig key item" - -#: cobc/typeck.c:11849 -msgid "LENGTH/SIZE clause only allowed on INDEXED files" -msgstr "LENGTH/SIZE clausule alleen mogelijk bij INDEXED bestanden" - -#: cobc/typeck.c:11854 -msgid "START not allowed with ACCESS MODE RANDOM" -msgstr "START niet toegestaan bij ACCESS MODE RANDOM" - -#: cobc/typeck.c:12103 -msgid "LOCK clause invalid here" -msgstr "LOCK clausule ongeldig hier" - -#: cobc/typeck.c:12365 -msgid "data item is not part of a report" -msgstr "" - -#: cobc/typeck.c:12385 -msgid "improper use of SUPPRESS PRINTING" -msgstr "" - -#: cobc/typeck.c:12400 -#, fuzzy, c-format -msgid "%s must be alphanumeric or national" -msgstr "'%s' is geen numerieke waarde" - -#: cobc/typeck.c:12411 -#, c-format -msgid "%s may not be a figurative constant" -msgstr "" - -#: cobc/typeck.c:12438 -#, c-format -msgid "%s must be a child of the input record" -msgstr "" - -#: cobc/typeck.c:12464 -#, c-format -msgid "%s may not be an ignored item in JSON/XML GENERATE" -msgstr "" - -#: cobc/typeck.c:12475 -#, c-format -msgid "%s must be elementary" -msgstr "" - -#: cobc/typeck.c:12487 -#, fuzzy, c-format -msgid "%s must be USAGE DISPLAY or NATIONAL" -msgstr "'%s' is niet in LINKAGE SECTION" - -#: cobc/typeck.c:12501 -#, fuzzy, c-format -msgid "%s must be an integer" -msgstr "'%s' is geen heel getal" - -#: cobc/typeck.c:12517 cobc/typeck.c:12523 -msgid "JSON/XML GENERATE receiving item" -msgstr "" - -#: cobc/typeck.c:12520 -msgid "JSON/XML GENERATE receiving item may not have JUSTIFIED clause" -msgstr "" - -#: cobc/typeck.c:12608 -#, fuzzy -msgid "JSON/XML GENERATE input record may not be reference modified" -msgstr "'%s' accepteert geen verwijzingsmodificatie" - -#: cobc/typeck.c:12614 -msgid "JSON/XML GENERATE input record may not have RENAMES clause" -msgstr "" - -#: cobc/typeck.c:12619 -#, c-format -msgid "all the children of '%s' are ignored in JSON/XML GENERATE" -msgstr "" - -#: cobc/typeck.c:12626 -msgid "JSON/XML GENERATE input record has subrecords with non-unique names" -msgstr "" - -#: cobc/typeck.c:12631 -msgid "floating-point items in JSON/XML GENERATE" -msgstr "" - -#: cobc/typeck.c:12635 -msgid "OCCURS items in JSON/XML GENERATE" -msgstr "" - -#: cobc/typeck.c:12660 -msgid "COUNT IN item must be numeric and an integer" -msgstr "" - -#: cobc/typeck.c:12665 -msgid "COUNT IN item must be an integer" -msgstr "" - -#: cobc/typeck.c:12668 -msgid "COUNT IN item may not have PICTURE with P in it" -msgstr "" - -#: cobc/typeck.c:12711 -msgid "NAMESPACE must be a valid URI" -msgstr "" - -#: cobc/typeck.c:12755 -msgid "NAMESPACE-PREFIX must be a valid XML name" -msgstr "" - -#: cobc/typeck.c:12780 cobc/typeck.c:12787 -msgid "NAME OF item" -msgstr "" - -#: cobc/typeck.c:12784 -msgid "NAME OF item must be the input record or a child of it" -msgstr "" - -#: cobc/typeck.c:12791 -msgid "NAME OF name must be a valid XML name" -msgstr "" - -#: cobc/typeck.c:12817 cobc/typeck.c:12818 cobc/typeck.c:12821 -#: cobc/typeck.c:12825 -msgid "TYPE OF item" -msgstr "" - -#: cobc/typeck.c:12843 -msgid "SUPPRESS WHEN SPACE item" -msgstr "" - -#: cobc/typeck.c:12846 -msgid "SUPPRESS WHEN LOW-VALUE item" -msgstr "" - -#: cobc/typeck.c:12848 -msgid "SUPPRESS WHEN HIGH-VALUE item" -msgstr "" - -#: cobc/typeck.c:12877 cobc/typeck.c:12885 cobc/typeck.c:12889 -msgid "SUPPRESS item" -msgstr "" - -#: cobc/typeck.c:12881 -#, fuzzy -msgid "SUPPRESS item with WHEN clause" -msgstr "Waarschuw bij EXTERNAL item met VALUE clausule" - -#: cobc/typeck.c:12958 -msgid "WITH ATTRIBUTES specified, but no attributes can be generated" -msgstr "" - -#: cobc/warning.def:34 -#, fuzzy -msgid " -Wextra additional warnings only raised with -W or -Wall" -msgstr " -W Inschakelen alle waarschuwingen" - -#: cobc/warning.def:37 -#, fuzzy -msgid " -Wno-unfinished do not warn if unfinished features are used" -msgstr "Waarschuw indien verouderde opties worden gebruikt" - -#: cobc/warning.def:40 -#, fuzzy -msgid " -Wno-pending do not warn if pending features are mentioned" -msgstr "Waarschuw indien verouderde opties worden gebruikt" - -#: cobc/warning.def:43 -#, fuzzy -msgid " -Wobsolete warn if obsolete features are used" -msgstr "Waarschuw indien verouderde opties worden gebruikt" - -#: cobc/warning.def:46 -#, fuzzy -msgid " -Warchaic warn if archaic features are used" -msgstr "Waarschuw indien verouderde opties worden gebruikt" - -#: cobc/warning.def:49 -#, fuzzy -msgid " -Wredefinition warn about incompatible redefinition of data items" -msgstr "Waarschuw bij incompatibele herdefinitie van data items" - -#: cobc/warning.def:52 -msgid " -Wtruncate warn about field truncation from constant assignments" -msgstr "" - -#: cobc/warning.def:55 -#, fuzzy -msgid " -Wpossible-truncate warn about possible field truncation" -msgstr "Waarschuw bij mogelijke veld truncatie" - -#: cobc/warning.def:58 -#, fuzzy -msgid " -Woverlap warn about overlapping MOVE of items" -msgstr "Waarschuw bij overlappende MOVE items" - -#: cobc/warning.def:61 -msgid " -Wpossible-overlap warn about MOVE of items that may overlap depending on variables" -msgstr "" - -#: cobc/warning.def:64 -#, fuzzy -msgid " -Wparentheses warn about lack of parentheses around AND within OR" -msgstr "Waarschuw bij ontbrekende haken rond AND binnen OR" - -#: cobc/warning.def:67 -msgid " -Wstrict-typing warn strictly about type mismatch" -msgstr "" - -#: cobc/warning.def:70 -#, fuzzy -msgid " -Wimplicit-define warn about implicitly defined data items" -msgstr "Waarschuw bij impliciet gedefinieerde data items" - -#: cobc/warning.def:73 -#, fuzzy -msgid " -Wcorresponding warn about CORRESPONDING with no matching items" -msgstr "Waarschuw bij CORRESPONDING met geen bijbehorende items" - -#: cobc/warning.def:76 -#, fuzzy -msgid " -Winitial-value warn if initial VALUE clause is ignored" -msgstr "Eerste VALUE clausule genegeerd voor EXTERNAL item" - -#: cobc/warning.def:79 -msgid " -Wprototypes warn about missing FUNCTION prototypes/definitions" -msgstr "" - -#: cobc/warning.def:82 -msgid " -Warithmetic-osvs warn if arithmetic expression precision has changed" -msgstr "" - -#: cobc/warning.def:85 -#, fuzzy -msgid " -Wcall-params warn about non 01/77 items for CALL parameters" -msgstr "Waarschuw bij niet 01/77 items als CALL parameter" - -#: cobc/warning.def:88 -msgid " -Wconstant-expression warn about expressions that always resolve to true/false" -msgstr "" - -#: cobc/warning.def:91 -#, fuzzy -msgid " -Wcolumn-overflow warn about text after program-text area, FIXED format" -msgstr "Waarschuw bij text na kolom 72, FIXED formaat" - -#: cobc/warning.def:94 -#, fuzzy -msgid " -Wterminator warn about lack of scope terminator END-XXX" -msgstr "Waarschuw bij ontbreken van scope terminator END-XXX" - -#: cobc/warning.def:97 -#, fuzzy -msgid " -Wlinkage warn about dangling LINKAGE items" -msgstr "Waarschuw bij zwevende LINKAGE items" - -#: cobc/warning.def:100 -msgid " -Wunreachable warn about likely unreachable statements" -msgstr "" - -#: cobc/warning.def:103 -msgid " -Wno-dialect do not warn about dialect specific issues" -msgstr "" - -#: cobc/warning.def:106 -#, fuzzy -msgid " -Wothers do not warn about different issues" -msgstr " -W Inschakelen alle waarschuwingen" - -#: cobc/warning.def:109 -msgid " -Wno-unsupported do not warn if runtime does not support a feature used" -msgstr "" - -#: libcob/call.c:87 -#, c-format -msgid "LoadLibrary/GetProcAddress error %d" -msgstr "LoadLibrary/GetProcAddress fout %d" - -#: libcob/call.c:939 -#, fuzzy -msgid "indeterminable error in resolve of COBOL CALL" -msgstr "Onbepaalbare fout" - -#: libcob/call.c:1022 -#, fuzzy, c-format -msgid "user-defined FUNCTION '%s' not found" -msgstr "User FUNCTION '%s' niet gevonden" - -#: libcob/call.c:1129 libcob/call.c:1208 libcob/call.c:1326 libcob/call.c:1354 -#, c-format -msgid "NULL parameter passed to '%s'" -msgstr "NULL parameter doorgegeven aan '%s'" - -#: libcob/call.c:1204 -#, fuzzy, c-format -msgid "invalid number of arguments passed to '%s'" -msgstr "Ongeldig aantal argumenten voor %s'" - -#: libcob/call.c:1330 -#, fuzzy -msgid "multiple call to 'cob_setjmp'" -msgstr "Meerdere aanroepen van 'cob_setjmp'" - -#: libcob/call.c:1358 -#, fuzzy -msgid "call to 'cob_longjmp' with no prior 'cob_setjmp'" -msgstr "Aanroep van 'cob_longjmp' zonder voorafgaande 'cob_setjmp'" - -#: libcob/call.c:1592 libcob/call.c:1633 libcob/call.c:1646 -#: libcob/common.c:7081 -msgid "cob_init() has not been called" -msgstr "cob_init() is niet aangeroepen" - -#: libcob/call.c:1598 -#, c-format -msgid "parameter %d is not within range of %d" -msgstr "" - -#: libcob/call.c:1604 -#, fuzzy, c-format -msgid "parameter %d is NULL" -msgstr "NULL parameter doorgegeven aan '%s'" - -#: libcob/call.c:1859 libcob/call.c:1916 -#, c-format -msgid "attempt to over-write constant parameter %d with " -msgstr "" - -#: libcob/call.c:1965 -#, c-format -msgid "attempt to over-write constant parameter %d with '%s'" -msgstr "" - -#: libcob/cobgetopt.c:497 -#, fuzzy, c-format -msgid "%s: option '%s' is ambiguous; possibilities:" -msgstr "%s: optie `%s' is onduidelijk\n" - -#: libcob/cobgetopt.c:538 -#, fuzzy, c-format -msgid "%s: option '--%s' doesn't allow an argument" -msgstr "%s: optie `--%s' verwacht geen argument\n" - -#: libcob/cobgetopt.c:545 -#, fuzzy, c-format -msgid "%s: option '%c%s' doesn't allow an argument" -msgstr "%s: optie `%c%s' verwacht geen argument\n" - -#: libcob/cobgetopt.c:565 -#, fuzzy, c-format -msgid "%s: option '--%s' requires an argument" -msgstr "%s: optie `%s' verwacht een argument\n" - -#: libcob/cobgetopt.c:597 -#, fuzzy, c-format -msgid "%s: unrecognized option '--%s'" -msgstr "%s: onbekende optie `--%s'\n" - -#: libcob/cobgetopt.c:604 -#, fuzzy, c-format -msgid "%s: unrecognized option '%c%s'" -msgstr "%s: onbekende optie `%c%s'\n" - -#: libcob/cobgetopt.c:633 -#, fuzzy, c-format -msgid "%s: invalid option -- %c" -msgstr "%s: ongeldige optie -- %c\n" - -#: libcob/cobgetopt.c:664 libcob/cobgetopt.c:805 -#, fuzzy, c-format -msgid "%s: option requires an argument -- %c" -msgstr "%s: optie verwacht een argument -- %c\n" - -#: libcob/cobgetopt.c:714 -#, fuzzy, c-format -msgid "%s: option '-W %s' is ambiguous" -msgstr "%s: optie `-W %s' is onduidelijk\n" - -#: libcob/cobgetopt.c:736 -#, fuzzy, c-format -msgid "%s: option '-W %s' doesn't allow an argument" -msgstr "%s: optie `-W %s' verwacht geen argument\n" - -#: libcob/cobgetopt.c:754 -#, fuzzy, c-format -msgid "%s: option '%s' requires an argument" -msgstr "%s: optie `%s' verwacht een argument\n" - -#: libcob/common.c:793 -#, fuzzy, c-format -msgid "attempt to reference unallocated memory" -msgstr "Poging om te verwijzen naar niet toegewezen geheugen" - -#: libcob/common.c:798 -#, fuzzy, c-format -msgid "bus error" -msgstr "Fout: " - -#: libcob/common.c:803 -#, c-format -msgid "fatal arithmetic error" -msgstr "" - -#: libcob/common.c:807 -#, c-format -msgid "caught signal" -msgstr "" - -#: libcob/common.c:811 -#, c-format -msgid "signal %s" -msgstr "" - -#: libcob/common.c:817 -#, fuzzy, c-format -msgid "abnormal termination - file contents may be incorrect" -msgstr "Abnormaal einde - Bestandsinhoud kan incorrect zijn" - -#: libcob/common.c:2049 -msgid "NULL field" -msgstr "" - -#: libcob/common.c:2059 -msgid "field with NULL address" -msgstr "" - -#: libcob/common.c:2345 -#, fuzzy -msgid "version mismatch" -msgstr "Fout - Versie conflict" - -#: libcob/common.c:2346 libcob/common.c:2348 -#, fuzzy, c-format -msgid "%s has version %s.%d" -msgstr "%s heeft versie/patch nivo %s/%d" - -#: libcob/common.c:2358 -#, fuzzy, c-format -msgid "CALL to %s requires %d arguments" -msgstr "CALL naar %s vereist %d parameters" - -#: libcob/common.c:2980 -#, fuzzy, c-format -msgid "BASED/LINKAGE item %s has NULL address" -msgstr "BASED/LINKAGE item '%s' heeft een NULL adres" - -#: libcob/common.c:2992 libcob/common.c:2995 -#, c-format -msgid "LINKAGE item %s not passed by caller" -msgstr "" - -#: libcob/common.c:3081 -#, fuzzy, c-format -msgid "'%s' (Type: %s) not numeric: '%s'" -msgstr "'%s' niet numeriek: '%s'" - -#: libcob/common.c:3096 -#, c-format -msgid "OCCURS DEPENDING ON '%s' out of bounds: %d" -msgstr "OCCURS DEPENDING ON '%s' buiten grens: %d" - -#: libcob/common.c:3099 libcob/common.c:3120 -#, fuzzy, c-format -msgid "maximum subscript for '%s': %d" -msgstr "Index van '%s' buiten grens: %d" - -#: libcob/common.c:3101 -#, fuzzy, c-format -msgid "minimum subscript for '%s': %d" -msgstr "Index van '%s' buiten grens: %d" - -#: libcob/common.c:3117 -#, c-format -msgid "current maximum subscript for '%s': %d" -msgstr "" - -#: libcob/common.c:3139 -#, fuzzy, c-format -msgid "offset of '%s' out of bounds: %d, maximum: %d" -msgstr "Start positie van '%s' buiten grens: %d" - -#: libcob/common.c:3152 -#, fuzzy, c-format -msgid "length of '%s' out of bounds: %d, maximum: %d" -msgstr "Lengte van '%s' buiten grens: %d" - -#: libcob/common.c:3161 -#, fuzzy, c-format -msgid "length of '%s' out of bounds: %d, starting at: %d, maximum: %d" -msgstr "Lengte van '%s' buiten grens: %d" - -#: libcob/common.c:3176 libcob/common.c:3181 -#, c-format -msgid "EXTERNAL item '%s' previously allocated with size %d, requested size is %d" -msgstr "EXTERNAL item '%s' eerder gemaakt met grootte %d, gevraagde grootte is %d" - -#: libcob/common.c:3682 -#, c-format -msgid "COB_CURRENT_DATE '%s' is invalid" -msgstr "" - -#: libcob/common.c:4585 -#, fuzzy, c-format -msgid "parameter to SYSTEM call is larger than %d characters" -msgstr "Parameter voor SYSTEM call is groter dan 8192 karakters" - -#: libcob/common.c:5195 -#, c-format -msgid "error '%s' during CBL_GC_FORK" -msgstr "" - -#: libcob/common.c:5200 libcob/common.c:5297 -#, fuzzy, c-format -msgid "'%s' is not supported on this platform" -msgstr "'%s' niet ondersteund" - -#: libcob/common.c:5226 -#, c-format -msgid "error '%s' for P%d during CBL_GC_WAITPID" -msgstr "" - -#: libcob/common.c:5418 -msgid "Call to CBL_GC_GETOPT with wrong longoption size." -msgstr "" - -#: libcob/common.c:5423 -msgid "Call to CBL_GC_GETOPT with missing longind." -msgstr "" - -#: libcob/common.c:5837 libcob/common.c:5858 libcob/common.c:5871 -#: libcob/common.c:7785 -#, c-format -msgid "(default)" -msgstr "" - -#: libcob/common.c:6119 libcob/common.c:6138 -msgid "should be unsigned" -msgstr "" - -#: libcob/common.c:6127 libcob/common.c:6176 -msgid "should be numeric" -msgstr "" - -#: libcob/common.c:6185 -#, c-format -msgid "minimum value: %lu" -msgstr "" - -#: libcob/common.c:6236 libcob/common.c:6787 libcob/common.c:6801 -#, c-format -msgid "should not contain '%c'" -msgstr "" - -#: libcob/common.c:6316 libcob/common.c:6384 libcob/common.c:6393 -#: libcob/common.c:6401 -#, c-format -msgid "not set" -msgstr "" - -#: libcob/common.c:6376 libcob/common.c:6379 libcob/common.c:6382 -#, c-format -msgid "set by %s" -msgstr "" - -#: libcob/common.c:6516 -#, c-format -msgid "WARNING - '%s' without a value - ignored!" -msgstr "" - -#: libcob/common.c:6519 -#, fuzzy, c-format -msgid "'%s' without a value!" -msgstr "'%s' is geen numerieke waarde" - -#: libcob/common.c:6545 -#, c-format -msgid "WARNING - '%s %s' without a value - ignored!" -msgstr "" - -#: libcob/common.c:7034 -#, fuzzy -msgid "error" -msgstr "Fout: " - -#: libcob/common.c:7064 -#, fuzzy -msgid "attempt to CANCEL active program" -msgstr "CANCEL poging op een actief programma" - -#: libcob/common.c:7091 -msgid "CALL of program with CHAINING clause" -msgstr "" - -#: libcob/common.c:7095 -#, fuzzy -msgid "stack overflow, possible PERFORM depth exceeded" -msgstr "Stack overloop, mogelijke PERFORM diepte overschrijding" - -#: libcob/common.c:7100 -#, fuzzy -msgid "invalid entry/exit in GLOBAL USE procedure" -msgstr "Ongeldige entry/exit in GLOBAL USE procedure" - -#: libcob/common.c:7105 -#, fuzzy -msgid "unable to allocate memory" -msgstr "Onmogelijk om geheugen te verkrijgen" - -#: libcob/common.c:7110 -#, fuzzy -msgid "invalid entry into module" -msgstr "ongeldige ingang in module" - -#: libcob/common.c:7115 -#, c-format -msgid "recursive CALL from %s to %s which is NOT RECURSIVE" -msgstr "" - -#: libcob/common.c:7125 -#, fuzzy -msgid "divide by ZERO" -msgstr "Ongeldige constante" - -#: libcob/common.c:7132 -#, fuzzy -msgid "end of file" -msgstr "Einde bestand" - -#: libcob/common.c:7135 -#, fuzzy -msgid "key out of range" -msgstr "Key buiten bereik" - -#: libcob/common.c:7138 -#, fuzzy -msgid "key order not ascending" -msgstr "Key volgorde niet oplopend" - -#: libcob/common.c:7141 -#, fuzzy -msgid "record key already exists" -msgstr "Record key bestaat al" - -#: libcob/common.c:7144 -#, fuzzy -msgid "record key does not exist" -msgstr "Record key niet aanwezig" - -#: libcob/common.c:7147 -#, fuzzy -msgid "permanent file error" -msgstr "Permanente bestands fout" - -#: libcob/common.c:7150 -#, fuzzy -msgid "inconsistant file name" -msgstr "Ongeldige regel voortzetting" - -#: libcob/common.c:7153 -#, fuzzy -msgid "file does not exist" -msgstr "Bestand niet aanwezig" - -#: libcob/common.c:7156 -#, fuzzy -msgid "permission denied" -msgstr "Toestemming geweigerd" - -#: libcob/common.c:7159 -#, fuzzy -msgid "file already open" -msgstr "Bestand is al geopend" - -#: libcob/common.c:7162 -#, fuzzy -msgid "file not open" -msgstr "Bestand nog niet geopend" - -#: libcob/common.c:7165 -msgid "READ must be executed first" -msgstr "READ moet eerst worden uitgevoerd" - -#: libcob/common.c:7168 -#, fuzzy -msgid "record overflow" -msgstr "Record overflow" - -#: libcob/common.c:7171 -msgid "READ after unsuccessful READ/START" -msgstr "" - -#: libcob/common.c:7174 -#, fuzzy -msgid "READ/START not allowed, file not open for input" -msgstr "READ/START niet toegestaan" - -#: libcob/common.c:7177 -msgid "WRITE not allowed, file not open for output" -msgstr "" - -#: libcob/common.c:7180 -#, fuzzy -msgid "DELETE/REWRITE not allowed, file not open for I-O" -msgstr "DELETE/REWRITE niet toegestaan" - -#: libcob/common.c:7183 -#, fuzzy -msgid "record locked by another file connector" -msgstr "Record geblokkeerd door een andere bestands connector" - -#: libcob/common.c:7186 -msgid "LINAGE values invalid" -msgstr "LINAGE waarden ongeldig" - -#: libcob/common.c:7189 -#, fuzzy -msgid "file sharing conflict" -msgstr "Bestands deling conflict" - -#: libcob/common.c:7193 -#, fuzzy -msgid "runtime library is not configured for this operation" -msgstr "Runtime library is niet geconfigureerd voor deze operatie" - -#: libcob/common.c:7198 -#, fuzzy -msgid "unknown file error" -msgstr "Onbekende bestands fout" - -#: libcob/common.c:7205 -#, fuzzy, c-format -msgid "%s (status = %02d) for file %s" -msgstr "%s (Status = %02d) Bestand : '%s'" - -#: libcob/common.c:7208 -#, fuzzy, c-format -msgid "%s (status = %02d) for file %s on %s" -msgstr "%s (Status = %02d) Bestand : '%s'" - -#: libcob/common.c:7215 -#, fuzzy -msgid "attempt to use non-implemented function" -msgstr "Poging om een niet geïmplementeerde functie te gebruiken" - -#: libcob/common.c:7218 -#, fuzzy -msgid "attempt to use non-implemented XML I/O" -msgstr "Poging om een niet geïmplementeerde functie te gebruiken" - -#: libcob/common.c:7221 -#, fuzzy -msgid "attempt to use non-implemented JSON I/O" -msgstr "Poging om een niet geïmplementeerde functie te gebruiken" - -#: libcob/common.c:7268 -msgid "environment variables" -msgstr "" - -#: libcob/common.c:7315 -msgid "License LGPLv3+: GNU LGPL version 3 or later " -msgstr "" - -#: libcob/common.c:7372 libcob/common.c:7374 -#, fuzzy -msgid "dynamic loading" -msgstr "Dynamisch laden" - -#: libcob/common.c:7379 -#, fuzzy -msgid "enabled" -msgstr "Ingeschakeld" - -#: libcob/common.c:7460 libcob/common.c:7577 libcob/common.c:7586 -#: libcob/common.c:7603 libcob/common.c:7618 -#, fuzzy, c-format -msgid "%s, version %d.%d.%d" -msgstr "C versie %s%s" - -#: libcob/common.c:7462 libcob/common.c:7579 libcob/common.c:7588 -#: libcob/common.c:7620 -#, c-format -msgid "%s, version %d.%d.%d (compiled with %d.%d)" -msgstr "" - -#: libcob/common.c:7465 -#, fuzzy, c-format -msgid "%s, version %s" -msgstr "C versie %s%s" - -#: libcob/common.c:7486 libcob/common.c:7488 libcob/common.c:7493 -#: libcob/common.c:7495 libcob/common.c:7498 -msgid "mouse support" -msgstr "" - -#: libcob/common.c:7636 -#, fuzzy -msgid "CALL configuration" -msgstr "GNU Cobol Bouw omgeving" - -#: libcob/common.c:7637 -#, fuzzy -msgid "File I/O configuration" -msgstr "GNU Cobol Bouw omgeving" - -#: libcob/common.c:7638 -#, fuzzy -msgid "Screen I/O configuration" -msgstr "GNU Cobol Bouw omgeving" - -#: libcob/common.c:7639 -msgid "Miscellaneous" -msgstr "" - -#: libcob/common.c:7640 -#, fuzzy -msgid "System configuration" -msgstr "GNU Cobol Bouw omgeving" - -#: libcob/common.c:7644 -#, fuzzy -msgid "runtime configuration" -msgstr "GNU Cobol Bouw omgeving" - -#: libcob/common.c:7646 -msgid "via" -msgstr "" - -#: libcob/common.c:7719 libcob/common.c:7747 -msgid "... removed from environment" -msgstr "" - -#: libcob/common.c:7773 libcob/common.c:7775 -#, c-format -msgid "(set by %s)" -msgstr "" - -#: libcob/common.c:7783 -#, c-format -msgid "(reset)" -msgstr "" - -#: libcob/common.c:8167 libcob/common.c:8286 -#, c-format -msgid "%s called with unknown option: %d" -msgstr "" - -#: libcob/common.c:8239 -#, c-format -msgid "Module dump due to %s\n" -msgstr "" - -#: libcob/common.c:8243 -#, fuzzy, c-format -msgid " Last statement of %s was Line %d of %s\n" -msgstr "%s statement niet afgesloten met END-%s" - -#: libcob/common.c:8249 -#, c-format -msgid " Last statement of %s unknown\n" -msgstr "" - -#: libcob/common.c:8259 -#, c-format -msgid "Dump Program-Id %s from %s compiled %s\n" -msgstr "" - -#: libcob/fileio.c:287 -#, c-format -msgid "ERROR I/O routine %s is not present" -msgstr "" - -#: libcob/fileio.c:1365 -#, c-format -msgid "I/O routine %s is not present for %s" -msgstr "" - -#: libcob/fileio.c:1404 -#, c-format -msgid "I/O routine %s is not known for %s" -msgstr "" - -#: libcob/fileio.c:2599 -#, c-format -msgid "ERROR FILE %s has record size %d exceeds %d in program" -msgstr "" - -#: libcob/fileio.c:2967 libcob/fileio.c:2974 -#, c-format -msgid "ERROR FILE %s opening pipe" -msgstr "" - -#: libcob/fileio.c:4979 -#, c-format -msgid "ERROR FILE %s does not match current version; Recompile the program" -msgstr "" - -#: libcob/fileio.c:5034 -#, c-format -msgid "ERROR FILE %s has ASSIGN field is NULL" -msgstr "" - -#: libcob/fileio.c:5707 -#, c-format -msgid "call to CBL_OPEN_FILE with wrong access mode: %d" -msgstr "" - -#: libcob/fileio.c:5756 -#, c-format -msgid "call to CBL_CREATE_FILE with wrong file_lock: %d" -msgstr "" - -#: libcob/fileio.c:5759 -#, c-format -msgid "call to CBL_CREATE_FILE with wrong file_dev: %d" -msgstr "" - -#: libcob/fileio.c:5955 libcob/fileio.c:6215 -#, fuzzy, c-format -msgid "'%s' - File detail area is too short" -msgstr "'C$FILEINFO' - Bestandsadministratie geheugen is te klein" - -#: libcob/fileio.c:6437 -msgid "SORT is unable to acquire temporary file" -msgstr "SORT kan geen tijdelijk bestand maken" - -#: libcob/fileio.c:7057 -#, fuzzy, c-format -msgid "implicit CLOSE of %s" -msgstr "WAARSCHUWING - Impliciete CLOSE van %s ('%s')" - -#: libcob/fileio.c:7165 -#, c-format -msgid "C-ISAM library %s is not present" -msgstr "" - -#: libcob/fileio.c:7173 -#, c-format -msgid "D-ISAM library %s is not present" -msgstr "" - -#: libcob/fileio.c:7181 -#, c-format -msgid "VB-ISAM library %s is not present" -msgstr "" - -#: libcob/screenio.c:429 -#, fuzzy -msgid "failed to initialize curses" -msgstr "Kan curses niet initialiseren" - -#: libcob/screenio.c:3591 -msgid "end of program, please press a key to exit" -msgstr "" - -#: libcob/termio.c:70 libcob/termio.c:106 -msgid "(Not representable)" -msgstr "(Niet representeerbaar)" - -#: libcob/termio.c:347 -#, c-format -msgid "cannot open %s (=%s)" -msgstr "" - -#: libcob/termio.c:362 -msgid "COB_DISPLAY_PUNCH_FILE is invalid, output to SYSPUNCH skipped" -msgstr "" - -#: bin/cobcrun.c:122 -msgid "GnuCOBOL module loader" -msgstr "" - -#: bin/cobcrun.c:124 -#, fuzzy, c-format -msgid "Usage: %s [options] PROGRAM [parameter ...]" -msgstr "Gebruik: %s PROGRAM [param ...]" - -#: bin/cobcrun.c:126 -#, c-format -msgid " or: %s options" -msgstr " of: %s opties" - -#: bin/cobcrun.c:129 -msgid "Options:" -msgstr "Opties:" - -#: bin/cobcrun.c:130 -#, fuzzy -msgid " -h, -help display this help and exit" -msgstr " -h, -help Toont deze boodschap" - -#: bin/cobcrun.c:131 -#, fuzzy -msgid " -V, -version display cobcrun and runtime version and exit" -msgstr " -V, -version Toont compiler verse" - -#: bin/cobcrun.c:132 -#, fuzzy -msgid " -i, -info display runtime information (build/environment)" -msgstr " -i, -info Toont compiler bouw informatie" - -#: bin/cobcrun.c:134 -#, fuzzy -msgid " -q, -brief reduced displays" -msgstr " -h, -help Toont deze boodschap" - -#: bin/cobcrun.c:136 -#, fuzzy -msgid " -c , -config= set runtime configuration from " -msgstr " -conf= Gebruiker gedefinieerde dialect configuratie - Zie -std=" - -#: bin/cobcrun.c:137 -#, fuzzy -msgid "" -" -r, -runtime-config display current runtime configuration\n" -" (value and origin for all settings)" -msgstr " -r, -runtime-env Toont compiler bouw informatie" - -#: bin/cobcrun.c:139 -msgid "" -" -M , -module= set entry point module name and/or load path\n" -" where -M module prepends any directory to the\n" -" dynamic link loader library search path\n" -" and any basename to the module preload list\n" -" (COB_LIBRARY_PATH and/or COB_PRELOAD)" -msgstr "" - -#: bin/cobcrun.c:145 -#, c-format -msgid "" -"Report bugs to: %s\n" -"or (preferably) use the issue tracker via the home page." -msgstr "" - -#: bin/cobcrun.c:148 -msgid "GnuCOBOL home page: " -msgstr "" - -#: bin/cobcrun.c:149 -msgid "General help using GNU software: " -msgstr "" - -#: bin/cobcrun.c:274 -#, fuzzy -msgid "invalid configuration file name" -msgstr "Ongeldige regel voortzetting" - -#: bin/cobcrun.c:325 -#, fuzzy, c-format -msgid "invalid module argument '%s'" -msgstr "Ongeldige uitvoer bestandsnaam" - -#: bin/cobcrun.c:377 -#, c-format -msgid "%s: missing PROGRAM name" -msgstr "" - -#: bin/cobcrun.c:379 -#, c-format -msgid "Try '%s --help' for more information." -msgstr "" - -#: bin/cobcrun.c:387 -#, fuzzy, c-format -msgid "%s: PROGRAM name exceeds %d characters" -msgstr "PROGRAM naam overschrijdt 31 karakters" - -#, fuzzy -#~ msgid "%s: %d: invalid cast from '%s' type %s to type %s" -#~ msgstr "%s:%d Ongeldige wijziging van '%s' type %s naar type %s" - -#, fuzzy -#~ msgid " - length is < 1 or > 31" -#~ msgstr " - Lengte is < 1 of > 31" - -#, fuzzy -#~ msgid "unknown name error '%s'%s" -#~ msgstr "Onbekende naam fout '%s'%s" - -#~ msgid "ISAM handler" -#~ msgstr "ISAM handler" - -#~ msgid "- NOT set with -Wall" -#~ msgstr "- NIET gezet met -Wall" - -#, fuzzy -#~ msgid "Usage: %s [options]... file..." -#~ msgstr "Gebruik: cobc [opties] bestand ..." - -#, fuzzy -#~ msgid " -h, -help display this help and exit" -#~ msgstr " -h, -help Toont deze boodschap" - -#, fuzzy -#~ msgid " -V, -version display compiler version and exit" -#~ msgstr " -V, -version Toont compiler verse" - -#, fuzzy -#~ msgid "" -#~ " -v, -verbose display compiler version and the commands\n" -#~ " invoked by the compiler" -#~ msgstr " -v Toont de opdrachten uitgevoerd door de compiler" - -#, fuzzy -#~ msgid " -q, -brief reduced displays, commands invoked not shown" -#~ msgstr " -v Toont de opdrachten uitgevoerd door de compiler" - -#, fuzzy -#~ msgid " -### like -v but commands not executed" -#~ msgstr " -x Bouw een uitvoerbaar programma" - -#, fuzzy -#~ msgid " -x build an executable program" -#~ msgstr " -x Bouw een uitvoerbaar programma" - -#, fuzzy -#~ msgid " -m build a dynamically loadable module (default)" -#~ msgstr " -m Bouw een dynamisch laadbare module (standaard)" - -#, fuzzy -#~ msgid " -fixed use fixed source format (default)" -#~ msgstr " -fixed Gebruik vast bron formaat (standaard)" - -#, fuzzy -#~ msgid " -O, -O2, -O3, -Os enable optimization" -#~ msgstr " -O, -O2, -Os Inschakelen optimalisatie" - -#, fuzzy -#~ msgid " -g enable C compiler debug / stack check / trace" -#~ msgstr " -g Inschakelen C compiler debug / stack check / trace" - -#, fuzzy -#~ msgid " -d, -debug enable all run-time error checking" -#~ msgstr " -debug Inschakelen alle run-time fout controles" - -#, fuzzy -#~ msgid " -o place the output into " -#~ msgstr " -o Plaats de uitvoer in " - -#, fuzzy -#~ msgid "" -#~ " -b combine all input files into a single\n" -#~ " dynamically loadable module" -#~ msgstr "" -#~ " -b Combineer alle invoer bestanden in één bestand\n" -#~ " dynamisch laadbare module" - -#, fuzzy -#~ msgid " -E preprocess only; do not compile or link" -#~ msgstr " -E Alleen voorbewerken; niet compileren of linken" - -#, fuzzy -#~ msgid " -C translation only; convert COBOL to C" -#~ msgstr " -C Alleen vertalen; converteer COBOL naar C" - -#, fuzzy -#~ msgid " -S compile only; output assembly file" -#~ msgstr " -S Alleen compileren; uitvoer assembler bestand" - -#, fuzzy -#~ msgid " -c compile and assemble, but do not link" -#~ msgstr " -c Compileer en assembleer, maar niet linken" - -#, fuzzy -#~ msgid " -T generate and place a wide program listing into " -#~ msgstr " -o Plaats de uitvoer in " - -#, fuzzy -#~ msgid " -t generate and place a program listing into " -#~ msgstr " -o Plaats de uitvoer in " - -#, fuzzy -#~ msgid " -P[=] generate preprocessed program listing (.lst)" -#~ msgstr " -P(=) Genereer voorbewerkte programma lijst (.lst)" - -#, fuzzy -#~ msgid " -Xref specify cross reference in listing" -#~ msgstr " -free Gebruik vrij bron formaat" - -#, fuzzy -#~ msgid " -I add to copy/include search path" -#~ msgstr " -I Voeg toe aan copy/include zoek pad" - -#, fuzzy -#~ msgid " -L add to library search path" -#~ msgstr " -L Voeg toe aan library zoek pad" - -#, fuzzy -#~ msgid " -l link the library " -#~ msgstr " -l Link de bibliotheek " - -#, fuzzy -#~ msgid " -A add to the C compile phase" -#~ msgstr " -A Voeg toe aan de C compileer fase" - -#, fuzzy -#~ msgid " -Q add to the C link phase" -#~ msgstr " -Q Voeg toe aan de C link fase" - -#, fuzzy -#~ msgid " -D define for COBOL compilation" -#~ msgstr " -D Maak bekend bij de COBOL compiler" - -#, fuzzy -#~ msgid " -K generate CALL to as static" -#~ msgstr " -K Genereer aanroep van als statisch" - -#, fuzzy -#~ msgid " -conf= user-defined dialect configuration; see -std" -#~ msgstr " -conf= Gebruiker gedefinieerde dialect configuratie - Zie -std=" - -#, fuzzy -#~ msgid " -list-reserved display reserved words" -#~ msgstr " -list-reserved Toon gereserveerde woorden" - -#, fuzzy -#~ msgid " -list-intrinsics display intrinsic functions" -#~ msgstr " -list-intrinsics Toon intrinsieke functies" - -#, fuzzy -#~ msgid " -list-mnemonics display mnemonic names" -#~ msgstr " -list-mnemonics Toon mnemonic namen" - -#, fuzzy -#~ msgid " -list-system display system routines" -#~ msgstr " -list-system Toon systeem routines" - -#, fuzzy -#~ msgid " -ext add file extension for resolving COPY" -#~ msgstr " -ext Voeg standaard bestands suffix toe" - -#, fuzzy -#~ msgid " -W enable all warnings" -#~ msgstr " -W Inschakelen alle waarschuwingen" - -#, fuzzy -#~ msgid " -Wall enable most warnings (all except as noted below)" -#~ msgstr " -Wall Inschakelen alle waarschuwingen behalve zoals vermeld hieronder" - -#, fuzzy -#~ msgid "invalid parameter -std=%s" -#~ msgstr "Ongeldige %s parameter" - -#, fuzzy -#~ msgid "invalid option detected" -#~ msgstr "Ongeldige optie gevonden" - -#, fuzzy -#~ msgid "unknown option ignored:\t%s" -#~ msgstr "Onbekende optie genegeerd:\t%s" - -#, fuzzy -#~ msgid "Invalid type for '%s'" -#~ msgstr "Ongeldig type voor '%s'" - -#, fuzzy -#~ msgid "invalid type for '%s'" -#~ msgstr "Ongeldig type voor '%s'" - -#, fuzzy -#~ msgid "constant item '%s' cannot have a %s clause" -#~ msgstr "Constante item '%s' kan geen %s clausule hebben" - -#~ msgid "define PERFORM stack size" -#~ msgstr "definieer PERFORM stapel grootte" - -#~ msgid "define cutoff depth for IF statements" -#~ msgstr "definieer afbreek diepte voor IF statements" - -#~ msgid "no transformation" -#~ msgstr "geen transformatie" - -#~ msgid "fold PROGRAM-ID, CALL, CANCEL subject to value" -#~ msgstr "transformeer PROGRAM-ID, CALL, CANCEL naar waarde" - -#, fuzzy -#~ msgid "initialize fields without VALUE to decimal value" -#~ msgstr "" -#~ "Initialiseer velden zonder VALUE naar numerieke waarde\n" -#~ "\t\t\t- 0 to 255 (Standaard : initialiseer naar opmaak)" - -#, fuzzy -#~ msgid "intrinsics to be used without FUNCTION keyword" -#~ msgstr "" -#~ "Ingebouwde functie moet gebruikt worden zonder FUNCTION sleutelwoord\n" -#~ "\t\t\t- ALL of ingebouwde functienaam (,naam,...)" - -#, fuzzy -#~ msgid "generate extra braces in generated C code" -#~ msgstr "Genereer extra accolades in gegenereerde C code" - -#, fuzzy -#~ msgid "" -#~ "generate trace code\n" -#~ "\t\t\t- executed SECTION/PARAGRAPH" -#~ msgstr "" -#~ "Genereer trace code\n" -#~ "\t\t\t- SECTIE/PARAGRAAF uitgevoerd" - -#, fuzzy -#~ msgid "" -#~ "adjust items following OCCURS DEPENDING\n" -#~ "\t\t\t- requires implicit/explicit relaxed syntax" -#~ msgstr "" -#~ "Wijzig items na OCCURS DEPENDING\n" -#~ "\t\t\t- Vereist impliciete/expliciete versoepelde syntaxis" - -#, fuzzy -#~ msgid "check recursive program call" -#~ msgstr "Controleer recursieve programma aanroep" - -#, fuzzy -#~ msgid "" -#~ "relax syntax checking\n" -#~ "\t\t\t- e.g. REDEFINES position" -#~ msgstr "" -#~ "Versoepel syntaxis controle\n" -#~ "\t\t\t- bv. REDEFINES positie" - -#, fuzzy -#~ msgid "PICTURE SYMBOL for CURRENCY must be one character long" -#~ msgstr "'%s' CURSOR is niet 4 of 6 karakters lang" - -#, fuzzy -#~ msgid "88-level cannot be used here" -#~ msgstr "'%s' kan hier niet worden geïndexeerd" - -#~ msgid "RECORD description invalid with REPORT" -#~ msgstr "RECORD beschijving ongeldig bij REPORT" - -#~ msgid "REDEFINES clause should follow entry-name" -#~ msgstr "REDEFINES clausule hoort na ENTRY naam te komen" - -#, fuzzy -#~ msgid "ANY LENGTH items may only be BY REFERENCE formal parameters" -#~ msgstr "'%s' ANY LENGTH item niet doorgegeven BY REFERENCE" - -#, fuzzy -#~ msgid "ignoring CONVERSION" -#~ msgstr "CONVERSION genegeerd" - -#, fuzzy -#~ msgid "%s is not implemented" -#~ msgstr "'%s' niet geïmplementeerd" - -#, fuzzy -#~ msgid "invalid target for DEBUGGING ALL" -#~ msgstr "Ongeldig doel voor DEBUGGING ALL" - -#, fuzzy -#~ msgid "non-negative integer value expected" -#~ msgstr "Geheel getal waarde" - -#, fuzzy -#~ msgid "invalid literal cast" -#~ msgstr "Ongeldige H constante: %s" - -#, fuzzy -#~ msgid "no definition/prototype seen for function '%s'" -#~ msgstr "%s: Geen definitie voor '%s'" - -#, fuzzy -#~ msgid "no definition/prototype seen for function with external name '%s'" -#~ msgstr "%s: Geen definitie voor '%s'" - -#, fuzzy -#~ msgid "invalid use of 88 level item" -#~ msgstr "Ongeldige gebruik van 88 nivo item" - -#, fuzzy -#~ msgid "invalid use of HANDLE item" -#~ msgstr "Ongeldige gebruik van 88 nivo item" - -#, fuzzy -#~ msgid "Variable length item not allowed here" -#~ msgstr "Variabele lengte hier niet toegestaan here" - -#, fuzzy -#~ msgid "the CHARACTERS field of ALLOCATE must be numeric" -#~ msgstr "Het CHARACTERS veld van ALLOCATE moet numeriek zijn" - -#, fuzzy -#~ msgid "warn type mismatch strictly" -#~ msgstr "Waarschuw bij type conflicten" - -#, fuzzy -#~ msgid "warn unreachable statements" -#~ msgstr "Waarschuw bij onbereikbare statements" - -#, fuzzy -#~ msgid "cannot find module" -#~ msgstr "Onvindbare module" - -#, fuzzy -#~ msgid "cannot find entry point" -#~ msgstr "Onvindbaar ingangspunt" - -#, fuzzy -#~ msgid "%s COBOL runtime is not initialized" -#~ msgstr "'cobcommandline' - Runtime is niet geïnitialiseerd" - -#, fuzzy -#~ msgid "libcob has version/patch level %s/%d" -#~ msgstr "%s heeft versie/patch nivo %s/%d" - -#, fuzzy -#~ msgid "malloc error" -#~ msgstr "Malloc fout" - -#, fuzzy -#~ msgid "codegen error - Please report this!" -#~ msgstr "Codegen fout - Doorgeven s.v.p." - -#, fuzzy -#~ msgid "invalid recursive COBOL CALL to '%s'" -#~ msgstr "Ongeldige recursieve COBOL CALL" - -#~ msgid "BDB error: %s" -#~ msgstr "BDB fout: %s" - -#~ msgid "BDB error: %s %s" -#~ msgstr "BDB fout: %s %s" - -#, fuzzy -#~ msgid "cannot join BDB environment (%s), error: %d %s" -#~ msgstr "Kan niet verbinden met BDB omgeving, fout: %d %s" - -#, fuzzy -#~ msgid " -v, -verbose display the commands invoked by the compiler" -#~ msgstr " -v Toont de opdrachten uitgevoerd door de compiler" - -#, fuzzy -#~ msgid "invalid option -std=%s" -#~ msgstr "Ongeldige optie -std=%s" - -#, fuzzy -#~ msgid "unexpected constant" -#~ msgstr "Onverwachte constante" - -#, fuzzy -#~ msgid "'%s' cannot be set via command line" -#~ msgstr "'%s' kan hier niet worden geïndexeerd" - -#, fuzzy -#~ msgid "entries under REDEFINES cannot have a VALUE clause" -#~ msgstr "Beschrijvingen onder REDEFINES kunnen geen VALUE clausule hebben" - -#, fuzzy -#~ msgid "unexpected usage %d" -#~ msgstr "Onverwachte grootte" - -#, fuzzy -#~ msgid "" -#~ "allow syntax extensions\n" -#~ "\t\t\t- e.g. switch name SW1, etc." -#~ msgstr "" -#~ "Sta syntaxis extensies toe\n" -#~ "\t\t\t- bv. Switch naam SW1, etc." - -#, fuzzy -#~ msgid "unexpected tallying phrase" -#~ msgstr "Onverwachte functie %s" - -#, fuzzy -#~ msgid "phrases in non-standard order" -#~ msgstr "Frases in niet-standard volgorde" - -#, fuzzy -#~ msgid "duplicate define" -#~ msgstr "Dubbele definitie" - -#~ msgid "Mnemonic names" -#~ msgstr "Mnemonic namen" - -#~ msgid "Extended mnemonic names (with -fsyntax-extension)" -#~ msgstr "Uitgebreide mnemonic namen (met -fsyntax-extension)" - -#, fuzzy -#~ msgid "the targets of SET must be either indexes or pointers" -#~ msgstr "De doelen van SET moeten indices of pointers zijn" - -#, fuzzy -#~ msgid "the address of '%s' cannot be changed" -#~ msgstr "Het adres van '%s' mag niet gewijzigd worden" - -#, fuzzy -#~ msgid "warn inconsistent constant" -#~ msgstr "Waarschuw bij inconsistente constanten" - -#, fuzzy -#~ msgid "recursive call of chained program" -#~ msgstr "Recursieve aanroep van chained programma" - -#~ msgid "Variable format" -#~ msgstr "Variabel formaat" - -#~ msgid "Sequential handler" -#~ msgstr "Sequentiële handler" - -#, fuzzy -#~ msgid "invalid currency sign '%s'" -#~ msgstr "Ongeldig valuta teken '%s'" - -#, fuzzy -#~ msgid "table sort without keys not implemented yet" -#~ msgstr "Tabel sort zonder keys nog niet geïmplemented" - -#, fuzzy -#~ msgid "invalid output device" -#~ msgstr "Ongeldig uitvoer apparaat" - -#~ msgid "System routine\t\t\tParameters" -#~ msgstr "Systeem routine\t\t\tParameters" - -#~ msgid "Build information" -#~ msgstr "Bouw informatie" - -#~ msgid "Build environment" -#~ msgstr "Bouw omgeving" - -#, fuzzy -#~ msgid " where -M module prepends any directory to the" -#~ msgstr " Zie config/default.conf en config/*.conf" - -#, fuzzy -#~ msgid " dynamic link loader library search path" -#~ msgstr " -m Bouw een dynamisch laadbare module (standaard)" - -#, fuzzy -#~ msgid " and any basename to the module preload list" -#~ msgstr " -m Bouw een dynamisch laadbare module (standaard)" - -#, fuzzy -#~ msgid " -cb_conf= override configuration entry" -#~ msgstr " -conf= Gebruiker gedefinieerde dialect configuratie - Zie -std=" - -#~ msgid "Reserved Words\t\t\tImplemented (Y/N)" -#~ msgstr "Gereserveerde woorden\t\t\tGeïmplementeerd (J/N)" - -#~ msgid "Y" -#~ msgstr "Y" - -#~ msgid "N" -#~ msgstr "N" - -#~ msgid "Intrinsic Function\t\tImplemented\tParameters" -#~ msgstr "Intrinsieke Functie\t\tGeïmplementeerd\tParameters" - -#~ msgid "Error: " -#~ msgstr "Fout: " - -#, fuzzy -#~ msgid "options:" -#~ msgstr "Opties:" - -#, fuzzy -#~ msgid " -j run job after build" -#~ msgstr " -W Inschakelen alle waarschuwingen" - -#~ msgid "No such file or directory" -#~ msgstr "Onbekend bestand of map" - -#~ msgid "Warning: " -#~ msgstr "Waarschuwing: " - -#~ msgid "Level number of REDEFINES entry cannot be 66 or 88" -#~ msgstr "Nivo nummer van REDEFINES beschrijving mag geen 66 of 88 zijn" - -#~ msgid "Invalid special names clause" -#~ msgstr "Ongeldige SPECIAL NAMES clausule" - -#~ msgid "Invalid SYMBOLIC clause" -#~ msgstr "Ongeldige SYMBOLIC clausule" - -#~ msgid "Item requires a data name" -#~ msgstr "Item vereist een veld naam" - -#~ msgid "Invalid PAGE clause" -#~ msgstr "Ongeldige PAGE clausule" - -#, fuzzy -#~ msgid "Screen DISPLAY does not have a LINE or COL clause" -#~ msgstr "Veld heeft geen FALSE clausule" - -#~ msgid "EXIT PROGRAM only allowed within a PROGRAM type" -#~ msgstr "EXIT PROGRAM is alleen toegestaan in een PROGRAM type" - -#~ msgid "INSPECT missing a keyword" -#~ msgstr "INSPECT mist een sleutelwoord" - -#~ msgid "Invalid SYMBOLIC integer" -#~ msgstr "Ongeldig SYMBOLIC geheel getal" - -#~ msgid "Dangling IF/ELSE directive" -#~ msgstr "Zwevend IF/ELSE statement" - -#, fuzzy -#~ msgid "%s directive not yet implemented" -#~ msgstr "TURN statement nog niet geïmplementeerd" - -#~ msgid "A SPACE will be assumed" -#~ msgstr "Een SPATIE wordt aangenomen" - -#~ msgid "" -#~ msgstr "" - -#~ msgid "Unexpected cast type -> %d" -#~ msgstr "Onverwacht wijziging type -> %d" - -#~ msgid "Unexpected numeric usage -> %d" -#~ msgstr "Onverwacht numeriek gebruik -> %d" - -#~ msgid "Invalid literal cast - Aborting" -#~ msgstr "Ongeldige constante wijziging - Afbreken" - -#~ msgid "Invalid picture string - '%s'" -#~ msgstr "Ongeldige opmaak string - '%s'" - -#, fuzzy -#~ msgid "Record size too small '%s' (%d)" -#~ msgstr "Record te klein '%s'" - -#~ msgid "Record size too large '%s' (%d)" -#~ msgstr "Record te groot '%s' (%d)" - -#, fuzzy -#~ msgid "Invalid value in AT clause" -#~ msgstr "Ongeldige CRT clausule" - -#~ msgid "Invalid VALUE clause - literal exceeds data size" -#~ msgstr "Ongeldige VALUE clausule - constante overschrijdt data grootte" - -#, fuzzy -#~ msgid "Failed to READ" -#~ msgstr "Lezen niet gelukt" - -#~ msgid "WRITE not allowed" -#~ msgstr "WRITE niet toegestaan" - -#, fuzzy -#~ msgid "System" -#~ msgstr "Systeem" - -#, fuzzy -#~ msgid "Libtool" -#~ msgstr "Libtool" - -#~ msgid "External" -#~ msgstr "Extern" - -#~ msgid "Internal" -#~ msgstr "Intern" - -#~ msgid "Alphabet-name is expected '%s'" -#~ msgstr "Alphabet-name is verwacht '%s'" - -#~ msgid "N (85 obsolete)" -#~ msgstr "N (85 niet meer in gebruik)" - -#, fuzzy -#~ msgid "Data name expected before CHARACTERS" -#~ msgstr "Data naam verwacht voor %s" - -#, fuzzy -#~ msgid "Data name expected before LEADING" -#~ msgstr "Data naam verwacht voor %s" - -#, fuzzy -#~ msgid "Data name expected before TRAILING" -#~ msgstr "Data naam verwacht voor %s" - -#~ msgid "Library has version/patch level %s/%d" -#~ msgstr "Library heeft versie/patch nivo %s/%d" - -#, fuzzy -#~ msgid "GNU Cobol information" -#~ msgstr "Bouw informatie" - -#~ msgid "BDB" -#~ msgstr "BDB" - -#, fuzzy -#~ msgid "C-ISAM (experimental)" -#~ msgstr "C-ISAM (Experimenteel)" - -#, fuzzy -#~ msgid "D-ISAM (experimental)" -#~ msgstr "D-ISAM (Experimenteel)" - -#, fuzzy -#~ msgid "VBISAM (experimental)" -#~ msgstr "VBISAM (Experimenteel)" - -#~ msgid "Failed to load the initial config file" -#~ msgstr "Laden eerste configuratie bestand mislukt" - -#~ msgid "Invalid tab-width value - %d" -#~ msgstr "Ongeldige waarde voor tab-breedte - %d" - -#~ msgid "Invalid text-column value - %d" -#~ msgstr "Ongeldige tekst-kolom waarde - %d" - -#~ msgid "Numeric literal exceeds limit - Aborting" -#~ msgstr "Numerieke constante overschrijdt limiet - Afbreken" - -#~ msgid "Memory allocation failure" -#~ msgstr "Geheugen allocatie storing" - -#, fuzzy -#~ msgid " -std= Warnings/features for a specific dialect:" -#~ msgstr " -std= Waarschuwingen/kenmerken van een specifiek dialect :" - -#, fuzzy -#~ msgid "BASED and OCCURS are mutually exclusive" -#~ msgstr "EXTERNAL en OCCURS sluiten elkaar uit" - -#~ msgid "EXTERNAL and OCCURS are mutually exclusive" -#~ msgstr "EXTERNAL en OCCURS sluiten elkaar uit" - -#, fuzzy -#~ msgid "Call environment" -#~ msgstr "Bouw omgeving" - -#~ msgid "Invalid SOURCEFORMAT directive" -#~ msgstr "Ongeldig SOURCEFORMAT statement" - -#~ msgid "Invalid FOLD-COPY-NAME directive" -#~ msgstr "Ongeldig FOLD-COPY-NAME statement" - -#~ msgid "Invalid IF/ELIF directive" -#~ msgstr "Ongeldig IF/ELIF statement" - -#, fuzzy -#~ msgid "Call to cobc_free with NULL pointer" -#~ msgstr "Aanroep van cobc_parse_strdup met NULL pointer" - -#~ msgid "Buffer overrun - Literal too long - Aborting" -#~ msgstr "Buffer overloop - Constante te lang - Afbreken" - -#~ msgid "Invalid line" -#~ msgstr "Ongeldig regelnummer" - -#~ msgid "ALTERNATE clause invalid for this file type" -#~ msgstr "ALTERNATE clausule ongeldig voor dit bestandstype" - -#~ msgid "ORGANIZATION clause invalid" -#~ msgstr "ORGANIZATION clausule ongeldig" - -#~ msgid "Cannot join BDB environment, env_open: %d %s" -#~ msgstr "Kan niet verbinden met BDB omgeving, env_open: %d %s" - -#~ msgid "'CBL_CHECK_FILE_EXIST' - File detail area is too short" -#~ msgstr "'CBL_CHECK_FILE_EXIST' - Bestandsadministratie geheugen is te klein" - -#~ msgid "NULL name parameter passed to '%s'" -#~ msgstr "NULL naam parameter doorgegeven aan '%s'" - -#~ msgid "Operation not allowed on LINE SEQUENTIAL files" -#~ msgstr "Operatie niet toegestaan bij LINE SEQUENTIAL bestanden" - -#~ msgid "Invalid target for INSPECT" -#~ msgstr "Ongeldig doel voor INSPECT" - -#~ msgid "REWRITE requires a record name as subject" -#~ msgstr "REWRITE vereist een record naam" - -#~ msgid "REWRITE subject does not refer to a record name" -#~ msgstr "REWRITE verwijst niet naar een record naam" - -#~ msgid "RELEASE requires a record name as subject" -#~ msgstr "RELEASE vereist een record naam" - -#~ msgid "RELEASE subject does not refer to a record name" -#~ msgstr "RELEASE verwijst niet naar een record naam" - -#~ msgid "GLOBAL is invalid in a user FUNCTION" -#~ msgstr "GLOBAL is ongeldig in een FUNCTION" - -#, fuzzy -#~ msgid "USE AT is invalid in nested program" -#~ msgstr "%s is ongeldig in ingesloten programma" - -#~ msgid "FUNCTION-ID is not yet implemented" -#~ msgstr "FUNCTION-ID is nog niet geïmplementeerd" - -#~ msgid "CONFIGURATION SECTION not allowed in nested programs" -#~ msgstr "CONFIGURATION SECTION niet toegestaan in ingesloten programma's" - -#~ msgid "REPORT WRITER not implemented" -#~ msgstr "REPORT WRITER niet gemplementeerd" - -#~ msgid "EXTERNAL not allowed here" -#~ msgstr "EXTERNAL niet toegestaan hier" - -#~ msgid "EXTERNAL only allowed at 01/77 level" -#~ msgstr "EXTERNAL alleen toegestaan op 01/77 nivo" - -#~ msgid "EXTERNAL requires a data name" -#~ msgstr "EXTERNAL vereist een veld naam" - -#~ msgid "GLOBAL and EXTERNAL are mutually exclusive" -#~ msgstr "GLOBAL en EXTERNAL sluiten elkaar uit" - -#~ msgid "BASED and EXTERNAL are mutually exclusive" -#~ msgstr "BASED en EXTERNAL sluiten elkaar uit" - -#~ msgid "EXTERNAL and REDEFINES are mutually exclusive" -#~ msgstr "EXTERNAL en REDEFINES sluiten elkaar uit" - -#~ msgid "GLOBAL only allowed at 01/77 level" -#~ msgstr "GLOBAL alleen toegestaan op 01/77 nivo" - -#~ msgid "GLOBAL requires a data name" -#~ msgstr "GLOBAL vereist een veld name" - -#~ msgid "GLOBAL not allowed here" -#~ msgstr "GLOBAL niet toegestaan hier" - -#~ msgid "BASED requires a data name" -#~ msgstr "BASED vereist een veld naam" - -#~ msgid "BASED and REDEFINES are mutually exclusive" -#~ msgstr "BASED en REDEFINES sluiten elkaar uit" - -#~ msgid "BASED and ANY LENGTH are mutually exclusive" -#~ msgstr "BASED en ANY LENGTH sluiten elkaar uit" - -#~ msgid "BASED and ANY clause are mutually exclusive" -#~ msgstr "BASED en ANY clausule sluiten elkaar uit" - -#~ msgid "LOCAL-STORAGE not allowed in nested programs" -#~ msgstr "LOCAL-STORAGE niet toegestaan in ingesloten programma's" - -#~ msgid "REPORT SECTION not implemented" -#~ msgstr "REPORT SECTION niet geïmplementeerd" - -#~ msgid "BY CONTENT not allowed in CHAINED program" -#~ msgstr "BY CONTENT niet toegestaan in CHAINED programma" - -#~ msgid "SHARING and LOCK clauses are mutually exclusive" -#~ msgstr "SHARING en LOCK clausules sluiten elkaar uit" - -#~ msgid "%s (Experimental)" -#~ msgstr "%s (Experimenteel)" - -#~ msgid "Invalid target for REPLACING/CONVERTING" -#~ msgstr "Ongeldig doel voor REPLACING/CONVERTING" - -#~ msgid "or : cobcrun --help (-h)" -#~ msgstr "of : cobcrun --help (-h)" - -#~ msgid " Print this help" -#~ msgstr " Toon deze help" - -#~ msgid "or : cobcrun --version (-V)" -#~ msgstr "of : cobcrun --version (-V)" - -#~ msgid " Print version information" -#~ msgstr " Toon versie informatie" - -#~ msgid " Print build information" -#~ msgstr " Toon Bouw informatie" - -#~ msgid "Invalid option" -#~ msgstr "Ongeldige optie" - -#~ msgid "NULL parameter passed to 'cob_cancel'" -#~ msgstr "NULL parameter doorgegeven aan 'cob_cancel'" - -#~ msgid "NULL parameter passed to 'cob_longjmp'" -#~ msgstr "NULL parameter doorgegeven aan 'cob_longjmp'" - -#~ msgid "Check that 'cobxref' is in %%PATH%%" -#~ msgstr "Controleer of 'xcobref' voorkomt in %%PATH%%" - -#~ msgid "Call to cobc_main_strdup with NULL pointer" -#~ msgstr "Aanroep van cobc_main_strdup met NULL pointer" - -#~ msgid "Call to cobc_plex_strdup with NULL pointer" -#~ msgstr "Aanroep van cobc_plex_strdup met NULL pointer" - -#~ msgid "Call to cobc_check_string with NULL pointer" -#~ msgstr "Aanroep van cobc_check_string met NULL pointer" - -#~ msgid "Call to cobc_stradd_dup with NULL pointer" -#~ msgstr "Aanroep van cobc_stradd_dup met NULL pointer" - -#~ msgid "RETURNING item moet nivo 01 zijn" -#~ msgstr "RETURNING item moet nivo 01 zijn" diff -Nru gnucobol-4.0~early~20200606/po/POTFILES.in gnucobol-5/po/POTFILES.in --- gnucobol-4.0~early~20200606/po/POTFILES.in 2020-06-06 20:52:02.000000000 +0000 +++ gnucobol-5/po/POTFILES.in 1970-01-01 00:00:00.000000000 +0000 @@ -1,30 +0,0 @@ -# List of source files containing translatable strings. - -# cobc -cobc/cobc.c -cobc/codegen.c -cobc/codeoptim.c -cobc/config.c -cobc/error.c -cobc/field.c -cobc/flag.def -cobc/parser.y -cobc/pplex.l -cobc/ppparse.y -cobc/reserved.c -cobc/scanner.l -cobc/tree.c -cobc/typeck.c -cobc/warning.def - -# libcob -libcob/call.c -libcob/cobgetopt.c -libcob/common.c -libcob/fileio.c -libcob/move.c -libcob/screenio.c -libcob/termio.c - -# bin -bin/cobcrun.c Binary files /tmp/tmp8r0303vl/MzBWgGBJBM/gnucobol-4.0~early~20200606/po/pt.gmo and /tmp/tmp8r0303vl/cieYbammgl/gnucobol-5/po/pt.gmo differ diff -Nru gnucobol-4.0~early~20200606/po/pt.po gnucobol-5/po/pt.po --- gnucobol-4.0~early~20200606/po/pt.po 2020-06-06 20:53:00.000000000 +0000 +++ gnucobol-5/po/pt.po 1970-01-01 00:00:00.000000000 +0000 @@ -1,6973 +0,0 @@ -# Portuguese (Portugal) translations for GnuCOBOL package -# Copyright (C) 2017 Free Software Foundation, Inc. -# This file is distributed under the same license as the GnuCOBOL package. -# Mário Matos , 2017. -# -msgid "" -msgstr "" -"Project-Id-Version: gnucobol 2.2\n" -"Report-Msgid-Bugs-To: gnucobol-messages@gnu.org\n" -"POT-Creation-Date: 2020-06-06 20:52+0000\n" -"PO-Revision-Date: 2017-05-09 21:17+0200\n" -"Last-Translator: Mário Matos \n" -"Language-Team: Portuguese \n" -"Language: pt\n" -"MIME-Version: 1.0\n" -"Content-Type: text/plain; charset=UTF-8\n" -"Content-Transfer-Encoding: 8bit\n" -"X-Generator: Poedit 2.0.1\n" - -#: cobc/cobc.c:117 -#, fuzzy, c-format -msgid "invalid parameter: %s" -msgstr "parâmetro inválido %s" - -#: cobc/cobc.c:826 -msgid "too many errors" -msgstr "demasiados erros" - -#: cobc/cobc.c:838 -#, fuzzy -msgid "internal compiler error" -msgstr "%s: %d: erro interno do compilador" - -#: cobc/cobc.c:904 cobc/cobc.c:991 cobc/cobc.c:1051 cobc/cobc.c:1127 -#: cobc/cobc.c:1167 cobc/cobc.c:1243 -#, fuzzy, c-format -msgid "cannot allocate %d bytes of memory" -msgstr "não é possível alocar %d octetos (bytes) de memória" - -#: cobc/cobc.c:917 cobc/cobc.c:933 cobc/cobc.c:953 cobc/cobc.c:1011 -#: cobc/cobc.c:1029 cobc/cobc.c:1147 cobc/cobc.c:1262 cobc/cobc.c:1279 -#: cobc/field.c:2008 libcob/common.c:7121 -#, fuzzy, c-format -msgid "call to %s with NULL pointer" -msgstr "chamada (call) a %s com um ponteiro nulo (NULL pointer)" - -#: cobc/cobc.c:974 -#, fuzzy, c-format -msgid "cannot reallocate %d bytes of memory" -msgstr "não é possível realocar %d octetos (bytes) de memória" - -#: cobc/cobc.c:1068 cobc/cobc.c:1184 -#, fuzzy -msgid "attempt to reallocate non-allocated memory" -msgstr "tentativa de realocação de memória não alocada" - -#: cobc/cobc.c:1101 cobc/cobc.c:1217 -#, c-format -msgid "call to %s with invalid pointer, as it is missing in list" -msgstr "chamada (call) a %s com ponteiro inválido, uma vez que este não se encontra na lista" - -#: cobc/cobc.c:1390 -#, fuzzy, c-format -msgid "assuming literal for unquoted '%s'" -msgstr "assumindo literal para '%s' sem aspas (unquoted)" - -#: cobc/cobc.c:1437 -#, fuzzy -msgid " - length exceeds maximum" -msgstr "Comprimento de palavra excede o máximo permitido - '%s'" - -#: cobc/cobc.c:1441 -msgid " - name cannot be empty" -msgstr "" - -#: cobc/cobc.c:1444 -#, fuzzy -msgid " - name cannot begin with space or underscore" -msgstr " - nome não pode começar com o caratere 'espaço' (' ') ou 'sublinhado' ('_')" - -#: cobc/cobc.c:1447 -#, fuzzy -msgid " - name cannot begin with 'cob_' or 'COB_'" -msgstr " - nome não pode começar com 'cob_' ou 'COB_'" - -#: cobc/cobc.c:1450 -#, fuzzy -msgid " - name duplicates a 'C' keyword" -msgstr " - nome duplica uma palavra-chave da linguagem 'C'" - -#: cobc/cobc.c:1453 -#, fuzzy -msgid " - name cannot contain a directory separator" -msgstr " - nome não pode conter um separador de diretório (e.g. '/' em sistemas tipo Unix ou '\\' em sistemas Windows)" - -#: cobc/cobc.c:1462 -#, fuzzy, c-format -msgid "invalid file base name '%s'%s" -msgstr "nome base de ficheiro inválido '%s'%s" - -#: cobc/cobc.c:1466 -#, fuzzy, c-format -msgid "invalid ENTRY '%s'%s" -msgstr "ENTRY inválida '%s'%s" - -#: cobc/cobc.c:1469 -#, fuzzy, c-format -msgid "invalid PROGRAM-ID '%s'%s" -msgstr "PROGRAM-ID inválida '%s'%s" - -#: cobc/cobc.c:1596 cobc/cobc.c:8151 -#, fuzzy -msgid "please check environment variables as noted above" -msgstr "variáveis de ambiente" - -#: cobc/cobc.c:1608 cobc/error.c:254 cobc/error.c:274 cobc/error.c:505 -#: cobc/error.c:528 -#, fuzzy -msgid "error: " -msgstr "erro: " - -#: cobc/cobc.c:1631 -#, fuzzy, c-format -msgid "duplicate DEFINE '%s' - ignored" -msgstr "definição (define) duplicada '%s' - ignorado" - -#: cobc/cobc.c:1683 -#, c-format -msgid "environment variable '%s' is '%s'; should not contain '%c'" -msgstr "variável de ambiente '%s' é '%s'; não deverá conter '%c'" - -#: cobc/cobc.c:1712 -#, fuzzy -msgid "parameter buffer size exceeded" -msgstr "excedido o espaço de memória física temporária ou retentor (buffer) do parâmetro" - -#: cobc/cobc.c:1752 -#, fuzzy, c-format -msgid "warning: could not move temporary file to %s" -msgstr "aviso: não foi possível mover o ficheiro temporário para %s" - -#: cobc/cobc.c:1957 cobc/cobc.c:1960 cobc/parser.y:803 cobc/reserved.c:3807 -#: libcob/common.c:761 libcob/common.c:1805 libcob/common.c:2002 -#: libcob/common.c:6325 libcob/common.c:7495 libcob/common.c:8025 -#: libcob/common.c:8104 -#, fuzzy -msgid "unknown" -msgstr "Desconhecid(o(s)/a(s))" - -#: cobc/cobc.c:1963 -#, fuzzy, c-format -msgid "aborting codegen for %s (%s: %s)" -msgstr "a abortar a compilação de %s na linha %d" - -#: cobc/cobc.c:1966 -#, fuzzy, c-format -msgid "aborting compile of %s at line %d (%s: %s)" -msgstr "a abortar a compilação de %s na linha %d" - -#: cobc/cobc.c:1970 -msgid "aborting" -msgstr "a abortar" - -#: cobc/cobc.c:1993 cobc/cobc.c:2028 libcob/common.c:7086 bin/cobcrun.c:342 -#, fuzzy -msgid "Please report this!" -msgstr "Erro de geração de código (codegen) - Por favor informe esta situação!" - -#: cobc/cobc.c:2046 bin/cobcrun.c:106 -#, fuzzy -msgid "License GPLv3+: GNU GPL version 3 or later " -msgstr "Licença GPLv3+: GNU GPL versão 3 ou superior " - -#: cobc/cobc.c:2047 libcob/common.c:7316 bin/cobcrun.c:107 -msgid "" -"This is free software; see the source for copying conditions. There is NO\n" -"warranty; not even for MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE." -msgstr "" -"Este programa é livre; ver a origem para condições de cópia. NÃO existe\n" -"garantia; nem sequer para COMERCIALIZAÇÃO ou ADEQUAÇÃO A UM DETERMINADO FIM." - -#: cobc/cobc.c:2049 libcob/common.c:7318 bin/cobcrun.c:109 -#, c-format -msgid "Written by %s\n" -msgstr "Escrito por %s\n" - -#. TRANSLATORS: This msgid is indented as the "Packaged" msgid, %s expands to date and time -#: cobc/cobc.c:2050 cobc/cobc.c:2063 libcob/common.c:7321 bin/cobcrun.c:110 -#, c-format -msgid "Built %s" -msgstr "Compilado em: %s" - -#. TRANSLATORS: This msgid is indented as the "Built" msgid, %s expands to date and time -#: cobc/cobc.c:2052 cobc/cobc.c:2065 libcob/common.c:7324 bin/cobcrun.c:112 -#, c-format -msgid "Packaged %s" -msgstr "Empacotado em: %s" - -#: cobc/cobc.c:2054 cobc/cobc.c:2067 -#, c-format -msgid "C version %s%s" -msgstr "Versão de 'C': %s%s" - -#: cobc/cobc.c:2080 -#, fuzzy -msgid "executing:" -msgstr "a executar:" - -#: cobc/cobc.c:2082 -#, fuzzy -msgid "to be executed:" -msgstr "READ tem de ser executado primeiro" - -# @@@ ??? -#: cobc/cobc.c:2120 cobc/cobc.c:2121 libcob/common.c:5815 libcob/common.c:5816 -#: libcob/common.c:5847 libcob/common.c:5848 -msgid "env" -msgstr "env" - -#: cobc/cobc.c:2156 libcob/common.c:7351 -#, fuzzy -msgid "build information" -msgstr "informação de compilação" - -#: cobc/cobc.c:2157 libcob/common.c:7352 -#, fuzzy -msgid "build environment" -msgstr "ambiente de compilação" - -#: cobc/cobc.c:2167 libcob/common.c:7363 -#, fuzzy -msgid "GnuCOBOL information" -msgstr "informação GnuCOBOL" - -#: cobc/cobc.c:2212 libcob/common.c:6366 libcob/common.c:7386 -#: libcob/common.c:7486 libcob/common.c:7493 -#, fuzzy -msgid "yes" -msgstr "sim" - -#: cobc/cobc.c:2214 libcob/common.c:6368 libcob/common.c:7388 -#: libcob/common.c:7488 -msgid "no" -msgstr "não" - -#: cobc/cobc.c:2218 libcob/common.c:7392 -msgid "8 bytes" -msgstr "8 octetos (bytes)" - -#: cobc/cobc.c:2220 libcob/common.c:7394 -msgid "4 bytes" -msgstr "4 octetos (bytes)" - -#: cobc/cobc.c:2224 cobc/cobc.c:2226 libcob/common.c:7398 libcob/common.c:7400 -msgid "endianness" -msgstr "" - -#: cobc/cobc.c:2224 libcob/common.c:7398 -msgid "big-endian" -msgstr "" - -#: cobc/cobc.c:2226 libcob/common.c:7400 -msgid "little-endian" -msgstr "" - -#: cobc/cobc.c:2230 cobc/cobc.c:2232 libcob/common.c:7404 libcob/common.c:7406 -#, fuzzy -msgid "native character set" -msgstr "caratere de continuação esperado" - -#: cobc/cobc.c:2230 libcob/common.c:7404 -msgid "EBCDIC" -msgstr "" - -#: cobc/cobc.c:2232 libcob/common.c:7406 -msgid "ASCII" -msgstr "" - -#: cobc/cobc.c:2235 libcob/common.c:7410 libcob/common.c:7476 -msgid "extended screen I/O" -msgstr "entrada/saída de ecrã (screen I/O) estendida" - -#: cobc/cobc.c:2238 libcob/common.c:7502 -#, fuzzy -msgid "variable file format" -msgstr "formato da variável" - -#: cobc/cobc.c:2244 cobc/cobc.c:2246 libcob/common.c:7508 libcob/common.c:7510 -#, fuzzy -msgid "sequential file handler" -msgstr "manipulador sequencial" - -#: cobc/cobc.c:2246 libcob/common.c:7510 -msgid "built-in" -msgstr "integrado" - -#: cobc/cobc.c:2254 cobc/cobc.c:2260 cobc/cobc.c:2262 cobc/cobc.c:2269 -#: cobc/cobc.c:2271 cobc/cobc.c:2275 cobc/cobc.c:2278 cobc/cobc.c:2282 -#: cobc/cobc.c:2284 cobc/cobc.c:2289 cobc/cobc.c:2291 cobc/cobc.c:2298 -#: cobc/cobc.c:2300 cobc/cobc.c:2307 libcob/common.c:7516 libcob/common.c:7527 -#: libcob/common.c:7533 libcob/common.c:7535 libcob/common.c:7539 -#: libcob/common.c:7542 libcob/common.c:7546 libcob/common.c:7548 -#: libcob/common.c:7553 libcob/common.c:7555 libcob/common.c:7562 -#: libcob/common.c:7564 libcob/common.c:7571 -#, fuzzy -msgid "indexed file handler" -msgstr "manipulador sequencial" - -#: cobc/cobc.c:2304 libcob/common.c:7568 -#, fuzzy -msgid "default indexed handler" -msgstr "definido aqui" - -#: cobc/cobc.c:2307 cobc/cobc.c:2319 cobc/cobc.c:2325 libcob/common.c:7381 -#: libcob/common.c:7498 libcob/common.c:7571 libcob/common.c:7611 -#: libcob/common.c:7625 -#, fuzzy -msgid "disabled" -msgstr "desabilitado" - -#: cobc/cobc.c:2311 cobc/cobc.c:2313 libcob/common.c:7594 libcob/common.c:7596 -msgid "mathematical library" -msgstr "" - -#: cobc/cobc.c:2317 cobc/cobc.c:2319 libcob/common.c:7605 libcob/common.c:7611 -msgid "XML library" -msgstr "" - -#: cobc/cobc.c:2323 cobc/cobc.c:2325 libcob/common.c:7623 libcob/common.c:7625 -msgid "JSON library" -msgstr "" - -#: cobc/cobc.c:2332 -#, fuzzy -msgid "only one of options 'E', 'S', 'C', 'c' may be specified" -msgstr "apenas uma das opções 'E', 'S', 'C', 'c' podem ser especificadas" - -#: cobc/cobc.c:2338 -#, fuzzy -msgid "only one of options 'm', 'x', 'b' may be specified" -msgstr "apenas uma das opções 'm', 'x', 'b' podem ser especificadas" - -#: cobc/cobc.c:2367 -#, c-format -msgid "-fdump= requires one of 'ALL', 'FD', 'WS', 'LS', 'RD', 'FD', 'SC' not '%s'" -msgstr "" - -#: cobc/cobc.c:2392 -#, c-format -msgid "'%s' is not an intrinsic function" -msgstr "'%s' não é uma função intrínseca" - -#: cobc/cobc.c:2434 cobc/cobc.c:7516 cobc/cobc.c:7630 cobc/codegen.c:3796 -#: cobc/codegen.c:3905 cobc/codegen.c:5221 cobc/codegen.c:12426 cobc/tree.c:789 -#: cobc/tree.c:1221 cobc/tree.c:4101 cobc/tree.c:4648 cobc/tree.c:4891 -#: cobc/typeck.c:3294 cobc/typeck.c:7812 cobc/typeck.c:7847 cobc/typeck.c:8660 -#: cobc/typeck.c:11261 cobc/typeck.c:11329 cobc/typeck.c:11397 -#: cobc/typeck.c:11681 cobc/typeck.c:11724 -#, fuzzy, c-format -msgid "call to '%s' with invalid parameter '%s'" -msgstr "chamada (CALL) a '%s' com parâmetro inválido '%s'" - -#: cobc/cobc.c:2737 -msgid "loading standard configuration file 'default.conf'" -msgstr "carregando o ficheiro de configuração padronizado 'default.conf'" - -#: cobc/cobc.c:2871 -#, fuzzy -msgid "invalid output file name" -msgstr "nome de ficheiro de saída inválido" - -#: cobc/cobc.c:2971 -#, fuzzy, c-format -msgid "warning: '%s' is not a directory, defaulting to current directory" -msgstr "aviso: '%s' não é um diretório, a padronizar para o diretório actual" - -#: cobc/cobc.c:2998 -#, c-format -msgid "warning: %d lines per listing page specified, using %d" -msgstr "" - -#: cobc/cobc.c:3048 -#, fuzzy, c-format -msgid "warning: assuming '%s' is a DEFINE - did you intend to use -debug?" -msgstr "aviso: a assumir que '%s' é uma definição (DEFINE) - pretendia usar '-debug' para depuraração?" - -#: cobc/cobc.c:3315 -#, fuzzy, c-format -msgid "unknown warning option '%s'" -msgstr "nome/rótulo de configuração (configuration tag) desconhecido '%s'" - -#: cobc/cobc.c:3367 -#, fuzzy, c-format -msgid "%s option requires a listing file" -msgstr "a opção '%s' requer um ficheiro de listagem" - -#: cobc/cobc.c:3374 -msgid "output to stdout only valid for preprocess" -msgstr "" - -#: cobc/cobc.c:3466 -msgid "all runtime checks are enabled" -msgstr "todas as opções de verificação do programa de execução (runtime) estão habilitadas" - -#: cobc/cobc.c:3572 -msgid "only one stdin input allowed" -msgstr "permitida apenas uma entrada-padrão (stdin)" - -#: cobc/cobc.c:3582 -#, fuzzy, c-format -msgid "invalid file name parameter (length > %d)" -msgstr "parâmetro para nome de ficheiro inválido (comprimento > %d)" - -#: cobc/cobc.c:3807 -msgid "nothing for -j to run" -msgstr "não existe nada para executar com '-j'" - -#: cobc/cobc.c:3883 cobc/cobc.c:4071 cobc/cobc.c:4130 cobc/cobc.c:4158 -#: cobc/cobc.c:4247 cobc/cobc.c:4306 cobc/cobc.c:4430 cobc/cobc.c:4469 -#: cobc/cobc.c:6993 -#, fuzzy -msgid "return status:" -msgstr "valor ou condição (status) de retorno:" - -#: cobc/cobc.c:4361 -#, fuzzy -msgid "preprocessing:" -msgstr "preprocessando:" - -#: cobc/cobc.c:4435 -msgid "'cobxref' execution unsuccessful" -msgstr "execução de 'cobxref' malsucedida" - -#: cobc/cobc.c:4438 -#, fuzzy, c-format -msgid "check that 'cobxref' is in %s" -msgstr "verificar se 'cobxref' está contido em %s" - -#: cobc/cobc.c:4440 -#, fuzzy -msgid "no listing produced" -msgstr "não foi criada nenhuma listagem" - -#: cobc/cobc.c:5328 cobc/cobc.c:5367 -msgid "No fields defined." -msgstr "" - -#: cobc/cobc.c:5387 -msgid "No labels defined." -msgstr "" - -#: cobc/cobc.c:5409 -msgid "Error/Warning summary:" -msgstr "" - -#: cobc/cobc.c:5453 -msgid "0 warnings in compilation group" -msgstr "" - -#: cobc/cobc.c:5457 -msgid "1 warning in compilation group" -msgstr "" - -#: cobc/cobc.c:5461 -#, c-format -msgid "%d warnings in compilation group" -msgstr "" - -#: cobc/cobc.c:5467 -#, fuzzy -msgid "0 errors in compilation group" -msgstr "Demasiados erros - A abortar a compilação" - -#: cobc/cobc.c:5471 -#, fuzzy -msgid "1 error in compilation group" -msgstr "Demasiados erros - A abortar a compilação" - -#: cobc/cobc.c:5475 -#, fuzzy, c-format -msgid "%d errors in compilation group" -msgstr "Demasiados erros - A abortar a compilação" - -#: cobc/cobc.c:5481 -#, fuzzy, c-format -msgid "Too many errors in compilation group: %d maximum errors" -msgstr "Demasiados erros - A abortar a compilação" - -#: cobc/cobc.c:6050 -#, c-format -msgid "%s: %d: Too many continuation lines" -msgstr "%s: %d: Demasiadas linhas de continuação" - -#: cobc/cobc.c:6972 -#, fuzzy -msgid "parsing:" -msgstr "a analisar:" - -#: cobc/cobc.c:7034 -#, fuzzy -msgid "translating:" -msgstr "a traduzir:" - -#: cobc/cobc.c:8157 -#, fuzzy -msgid "no input files" -msgstr "sem ficheiros de entrada" - -#: cobc/cobc.c:8186 -#, c-format -msgid "%s option invalid in this combination" -msgstr "opção '%s' inválida nesta combinação" - -#: cobc/cobc.c:8227 -#, fuzzy -msgid "command line:" -msgstr "linha de comando:" - -#: cobc/codegen.c:973 cobc/codegen.c:4487 cobc/codegen.c:11093 -#, fuzzy -msgid "unexpected CONSTANT item" -msgstr "item CONSTANT inesperado" - -#: cobc/codegen.c:1188 cobc/codegen.c:1196 cobc/codegen.c:1291 -#: cobc/codegen.c:1603 cobc/codegen.c:2202 cobc/codegen.c:3212 -#: cobc/codegen.c:3455 cobc/codegen.c:3988 cobc/codegen.c:4454 -#: cobc/codegen.c:7902 cobc/codegen.c:8507 cobc/codegen.c:10298 -#: cobc/field.c:817 cobc/scanner.l:2104 cobc/tree.c:611 cobc/tree.c:3728 -#: cobc/typeck.c:5015 cobc/typeck.c:8662 cobc/typeck.c:9657 -#, fuzzy, c-format -msgid "unexpected tree tag: %d" -msgstr "marca/rótulo de árvore (tree tag) inesperado: %d" - -#: cobc/codegen.c:2999 cobc/codegen.c:3295 cobc/codegen.c:8125 cobc/tree.c:1243 -#, fuzzy, c-format -msgid "unexpected cast type: %d" -msgstr "conversão de tipo de dados (cast type) inesperada: %d" - -#: cobc/codegen.c:3725 cobc/codegen.c:4434 -#, fuzzy, c-format -msgid "internal statement stack depth exceeded: %d" -msgstr "excedida a profundidade interna da pilha de instruções: %d" - -#: cobc/codegen.c:3798 -#, fuzzy, c-format -msgid "%s is not a field" -msgstr "'%s' não é um campo" - -#: cobc/codegen.c:4186 cobc/codegen.c:4279 -#, fuzzy, c-format -msgid "unexpected function: %s" -msgstr "função inesperada: %s" - -#: cobc/codegen.c:4270 -#, fuzzy, c-format -msgid "unexpected operator: %c" -msgstr "operador inesperado: %d" - -#: cobc/codegen.c:5043 -#, fuzzy, c-format -msgid "unexpected tree category: %d" -msgstr "categoria de árvore (tree category) inesperada: %d" - -#: cobc/codegen.c:5438 cobc/codegen.c:5465 cobc/codegen.c:5662 -#: cobc/codegen.c:5694 -#, fuzzy, c-format -msgid "unexpected size: %d" -msgstr "tamanho inesperado: %d" - -#: cobc/codegen.c:7254 -#, c-format -msgid "No ENTRY FOR GO TO '%s'" -msgstr "" - -#: cobc/codegen.c:7475 cobc/codegen.c:7725 -#, fuzzy, c-format -msgid "unexpected handler type: %d" -msgstr "tipo de manipulador (handler type) inesperado %d" - -#: cobc/codegen.c:7823 -#, fuzzy -msgid "unexpected error_node parameter" -msgstr "parâmetro 'error_node' inesperado" - -#: cobc/codegen.c:8146 -#, fuzzy, c-format -msgid "unexpected tree type: %d" -msgstr "tipo de árvore (tree type) inesperado: %d" - -#: cobc/codegen.c:8703 cobc/typeck.c:6511 cobc/typeck.c:12940 -#: cobc/typeck.c:12984 -#, fuzzy, c-format -msgid "compiler is not configured to support %s" -msgstr "biblioteca de execução (runtime library) não está configurada para esta operação" - -#: cobc/codegen.c:9128 -msgid "Nested OCCURS in report" -msgstr "" - -#: cobc/codeoptim.c:2762 -#, fuzzy, c-format -msgid "unexpected optimization value: %d" -msgstr "valor de otimização inesperado: %d" - -#: cobc/config.c:162 libcob/common.c:6786 libcob/common.c:6800 -#: libcob/common.c:7242 -#, fuzzy, c-format -msgid "invalid value '%s' for configuration tag '%s'" -msgstr "valor '%s' inválido para o nome/rótulo de configuração (configuration tag) '%s'" - -#: cobc/config.c:165 libcob/common.c:6093 libcob/common.c:6209 -#, c-format -msgid "should be one of the following values: %s" -msgstr "deveria ser um dos seguintes valores: %s" - -#: cobc/config.c:167 -msgid "must be numeric" -msgstr "t(e/ê)m de ser numérico(s)" - -#: cobc/config.c:169 libcob/common.c:6191 -#, c-format -msgid "maximum value: %lu" -msgstr "valor máximo: %lu" - -#: cobc/config.c:171 -#, c-format -msgid "minimum value: %d" -msgstr "valor mínimo: %d" - -#: cobc/config.c:203 -#, fuzzy, c-format -msgid "unsupported value '%s' for configuration tag '%s'" -msgstr "valor '%s' não suportado para o nome/rótulo de configuração (configuration tag) '%s'" - -#: cobc/config.c:311 cobc/pplex.l:977 libcob/common.c:6702 -msgid "recursive inclusion" -msgstr "inclusão recursiva" - -#: cobc/config.c:386 libcob/common.c:6753 -#, fuzzy -msgid "configuration file was included here" -msgstr "o ficheiro de configuração foi incluído aqui" - -#: cobc/config.c:415 -#, c-format -msgid "The previous loaded configuration '%s' will be discarded." -msgstr "A configuração previamente carregada '%s' será descartada." - -#: cobc/config.c:449 -msgid "missing definitions:" -msgstr "definições em falta:" - -#: cobc/config.c:451 -#, fuzzy, c-format -msgid "\tno definition of '%s'" -msgstr "\tnão existem definições de '%s'" - -#: cobc/config.c:512 -#, fuzzy, c-format -msgid "invalid configuration tag '%s'" -msgstr "nome/rótulo de configuração (configuration tag) inválido '%s'" - -#: cobc/config.c:525 libcob/common.c:6509 libcob/common.c:6592 -#: libcob/common.c:6620 -#, fuzzy, c-format -msgid "unknown configuration tag '%s'" -msgstr "nome/rótulo de configuração (configuration tag) desconhecido '%s'" - -#: cobc/config.c:549 -#, fuzzy, c-format -msgid "invalid configuration tag '%s' in word-list" -msgstr "nome/rótulo de configuração (configuration tag) inválido '%s'" - -#: cobc/config.c:608 -#, c-format -msgid "Could not access word list for '%s'" -msgstr "" - -#: cobc/error.c:87 -#, fuzzy, c-format -msgid "in section '%s':" -msgstr "na secção" - -#: cobc/error.c:98 -#, fuzzy, c-format -msgid "in paragraph '%s':" -msgstr "no parágrafo" - -#: cobc/error.c:121 libcob/common.c:7252 -msgid "configuration error:" -msgstr "erro de configuração:" - -#: cobc/error.c:134 libcob/common.c:673 -#, c-format -msgid "system error %d" -msgstr "erro de sistema %d" - -#: cobc/error.c:231 cobc/error.c:323 cobc/error.c:478 -msgid "error [-Werror]: " -msgstr "" - -#: cobc/error.c:231 cobc/error.c:323 cobc/error.c:478 cobc/error.c:505 -#: libcob/common.c:6881 libcob/common.c:6906 -#, fuzzy, c-format -msgid "warning: " -msgstr "aviso: " - -#: cobc/error.c:274 cobc/error.c:528 -msgid "error (ignored): " -msgstr "" - -#: cobc/error.c:364 cobc/error.c:380 cobc/error.c:563 cobc/error.c:584 -#, c-format -msgid "%s used" -msgstr "%s usad(o/a)" - -#: cobc/error.c:367 cobc/error.c:566 -#, c-format -msgid "%s is archaic in %s" -msgstr "%s é antiquad(o/a) (archaic) em %s" - -#: cobc/error.c:371 cobc/error.c:570 -#, c-format -msgid "%s is obsolete in %s" -msgstr "%s é obsolet(o/a) em %s" - -#: cobc/error.c:377 cobc/error.c:576 cobc/parser.y:5186 cobc/parser.y:5325 -#, c-format -msgid "%s ignored" -msgstr "%s ignorad(o/a)" - -#: cobc/error.c:383 cobc/error.c:586 -#, c-format -msgid "%s does not conform to %s" -msgstr "%s não está em conformidade com %s" - -#: cobc/error.c:399 -#, fuzzy -msgid "configuration warning:" -msgstr "aviso de configuração" - -#: cobc/error.c:621 cobc/error.c:640 -#, fuzzy, c-format -msgid "redefinition of '%s'" -msgstr "redefinição de '%s'" - -#: cobc/error.c:628 cobc/error.c:653 -#, c-format -msgid "'%s' previously defined here" -msgstr "'%s' previamente definido(s) aqui" - -#: cobc/error.c:677 cobc/error.c:684 -#, fuzzy, c-format -msgid "'%s' is not defined" -msgstr "%s não está definid(o/a)" - -#: cobc/error.c:680 -#, fuzzy, c-format -msgid "'%s' cannot be used here" -msgstr "'%s' não pode ser usad(o/a) aqui" - -#: cobc/error.c:682 cobc/parser.y:7009 -#, c-format -msgid "'%s' is not defined, but is a reserved word in another dialect" -msgstr "'%s' não está definid(o/a), mas é uma palavra reservada noutro dialeto" - -#: cobc/error.c:716 -#, fuzzy, c-format -msgid "'%s' is ambiguous; needs qualification" -msgstr "%s é ambigu(o/a); necessita qualificação" - -#: cobc/error.c:746 cobc/parser.y:16748 -#, c-format -msgid "'%s' defined here" -msgstr "'%s' definid(o/a) aqui" - -#: cobc/error.c:757 -#, fuzzy, c-format -msgid "fatal error: %s" -msgstr "erro fatal: %s" - -#: cobc/error.c:765 -#, fuzzy, c-format -msgid "group item '%s' cannot have %s clause" -msgstr "item de grupo '%s' não pode ter a cláusula %s" - -#: cobc/error.c:779 -#, fuzzy, c-format -msgid "constant item '%s' requires a %s clause" -msgstr "item constante '%s' requer a cláusula %s" - -#: cobc/error.c:781 -#, fuzzy, c-format -msgid "level %02d item '%s' requires a %s clause" -msgstr "item de nível %02d '%s' requer a cláusula %s" - -#: cobc/error.c:795 -#, fuzzy, c-format -msgid "constant item '%s' can only have a %s clause" -msgstr "item constante '%s' só pode ter a cláusula %s" - -#: cobc/error.c:797 -#, fuzzy, c-format -msgid "level %02d item '%s' can only have a %s clause" -msgstr "item de nível %02d '%s' só pode ter a cláusula %s" - -#: cobc/field.c:131 -msgid "constant expression has Divide by ZERO" -msgstr "" - -#: cobc/field.c:187 cobc/field.c:324 cobc/field.c:332 -msgid "missing right parenthesis" -msgstr "" - -#: cobc/field.c:216 -#, c-format -msgid "expression stack overflow at %d entries for operation '%c'" -msgstr "" - -#: cobc/field.c:257 -#, c-format -msgid "expression stack overflow at %d entries" -msgstr "" - -#: cobc/field.c:274 -#, fuzzy -msgid "missing left parenthesis" -msgstr "definições em falta:" - -#: cobc/field.c:315 -#, fuzzy, c-format -msgid "invalid operator '%s' in expression" -msgstr "expressão inválida" - -#: cobc/field.c:334 -#, c-format -msgid "'%c' operator misplaced" -msgstr "" - -#: cobc/field.c:395 -#, fuzzy, c-format -msgid "invalid level number '%s'" -msgstr "número de nível '%s' inválido" - -#: cobc/field.c:454 -#, fuzzy -msgid "entry following SAME AS may not be subordinate to it" -msgstr "o item THRU '%s' não pode ser subordinado a '%s'" - -#: cobc/field.c:459 cobc/field.c:496 -#, fuzzy -msgid "level number must begin with 01 or 77" -msgstr "o número de nível tem que começar com 01 ou 77" - -#: cobc/field.c:541 cobc/field.c:557 -#, fuzzy, c-format -msgid "no previous data item of level %02d" -msgstr "não existe previamente um item de dados de nível %02d" - -#: cobc/field.c:599 -#, c-format -msgid "'%s' cannot be qualified here" -msgstr "'%s' não pode ser qualificad(o/a) aqui" - -#: cobc/field.c:605 -#, c-format -msgid "'%s' cannot be subscripted here" -msgstr "'%s' não pode ser endereçad(o/a) (subscripted) aqui" - -#: cobc/field.c:617 -#, c-format -msgid "'%s' is not defined in '%s'" -msgstr "'%s' não está definid(o/a) em '%s'" - -#: cobc/field.c:638 -#, fuzzy -msgid "level number of REDEFINES entries must be identical" -msgstr "número de nível de entradas REDEFINES têm de ser idênticas" - -#: cobc/field.c:643 -#, fuzzy, c-format -msgid "'%s' is not the original definition" -msgstr "'%s' não é a definição original" - -#: cobc/field.c:758 -#, fuzzy, c-format -msgid "PICTURE clause not compatible with USAGE %s" -msgstr "a cláusula PICTURE não é compatível com USAGE %s" - -#: cobc/field.c:855 cobc/field.c:930 cobc/field.c:941 -#, c-format -msgid "PICTURE clause required for '%s'" -msgstr "cláusula PICTURE requerida para '%s'" - -#: cobc/field.c:937 -#, fuzzy, c-format -msgid "a non-numeric literal is expected for '%s'" -msgstr "é esperado um literal não numérico para '%s'" - -#: cobc/field.c:949 -#, fuzzy, c-format -msgid "defining implicit picture size %d for '%s'" -msgstr "a definir o tamanho implícito da cláusula PICTURE %d para '%s'" - -#: cobc/field.c:969 -#, c-format -msgid "'%s' ANY LENGTH only allowed in LINKAGE" -msgstr "'%s' ANY LENGTH só é permitid(o/a) na secção LINKAGE" - -#: cobc/field.c:973 -#, c-format -msgid "'%s' ANY LENGTH must be 01 level" -msgstr "'%s' ANY LENGTH tem de ser de nível 01" - -#: cobc/field.c:977 -#, fuzzy, c-format -msgid "'%s' ANY LENGTH cannot be BASED/EXTERNAL" -msgstr "'%s' ANY LENGTH não pode ser BASED/EXTERNAL" - -#: cobc/field.c:982 cobc/field.c:1010 -#, c-format -msgid "'%s' ANY LENGTH has invalid definition" -msgstr "'%s' ANY LENGTH tem definição inválida" - -#: cobc/field.c:993 -#, fuzzy, c-format -msgid "'%s' ANY NUMERIC must be PIC 9" -msgstr "'%s' ANY LENGTH tem de usar a cláusula PICTURE" - -#: cobc/field.c:998 -#, fuzzy, c-format -msgid "'%s' ANY LENGTH must be PIC X or PIC N" -msgstr "'%s' ANY LENGTH tem de usar a cláusula PICTURE" - -#: cobc/field.c:1008 -#, fuzzy, c-format -msgid "'%s' ANY NUMERIC has invalid definition" -msgstr "'%s' ANY LENGTH tem definição inválida" - -#: cobc/field.c:1026 -#, c-format -msgid "'%s' EXTERNAL must be specified at 01/77 level" -msgstr "'%s' EXTERNAL tem de ser especificad(o/a) com nível 01 ou 77" - -#: cobc/field.c:1030 -#, c-format -msgid "'%s' EXTERNAL can only be specified in WORKING-STORAGE section" -msgstr "'%s' EXTERNAL só pode ser especificad(o/a) na secção WORKING-STORAGE" - -#: cobc/field.c:1034 -#, c-format -msgid "'%s' EXTERNAL and BASED are mutually exclusive" -msgstr "'%s' EXTERNAL e BASED são mutuamente exclusivos" - -#: cobc/field.c:1037 -#, c-format -msgid "'%s' EXTERNAL not allowed with REDEFINES" -msgstr "'%s' EXTERNAL não é permitid(o/a) com REDEFINES" - -#: cobc/field.c:1049 -#, c-format -msgid "'%s' BASED not allowed here" -msgstr "'%s' BASED não é permitid(o/a) aqui" - -#: cobc/field.c:1052 -#, c-format -msgid "'%s' BASED not allowed with REDEFINES" -msgstr "'%s' BASED não é permitid(o/a) com REDEFINES" - -#: cobc/field.c:1055 -#, c-format -msgid "'%s' BASED only allowed at the 01 and 77 levels" -msgstr "'%s' BASED só é permitid(o/a) nos níveis 01 e 77" - -#: cobc/field.c:1067 -#, fuzzy, c-format -msgid "level %02d item '%s' cannot have a %s clause" -msgstr "item de nível %02d '%s' não pode ter a cláusula %s" - -#: cobc/field.c:1082 -#, c-format -msgid "'%s' cannot have the OCCURS clause due to '%s'" -msgstr "'%s' não pode ter a cláusula OCCURS devido a '%s'" - -#: cobc/field.c:1101 -#, fuzzy, c-format -msgid "the original definition '%s' should not have OCCURS clause" -msgstr "a definição original '%s' não deveria ter a cláusula OCCURS" - -#: cobc/field.c:1108 -msgid "REDEFINES must follow the original definition" -msgstr "REDEFINES tem de seguir a definição original" - -#: cobc/field.c:1115 -#, c-format -msgid "'%s' cannot be variable length" -msgstr "'%s' não pode ser de comprimento variável" - -#: cobc/field.c:1118 -#, fuzzy, c-format -msgid "the original definition '%s' cannot be variable length" -msgstr "a definição original '%s' não pode ser de comprimento variável" - -#: cobc/field.c:1142 -#, c-format -msgid "SCREEN group item '%s' has invalid clause" -msgstr "o item de grupo SCREEN '%s' contém uma cláusula inválida" - -#: cobc/field.c:1223 -#, fuzzy, c-format -msgid "%s USAGE %s incompatible with %s USAGE %s" -msgstr "cláusula %s não compatível com USAGE %d" - -#: cobc/field.c:1302 -#, c-format -msgid "'%s' cannot have PICTURE clause" -msgstr "'%s' não pode ter a cláusula de PICTURE" - -#: cobc/field.c:1318 cobc/field.c:1328 -#, fuzzy, c-format -msgid "%s item '%s' should be USAGE DISPLAY" -msgstr "'%s' não é USAGE DISPLAY" - -#: cobc/field.c:1351 -#, fuzzy, c-format -msgid "'%s' COMP-6 with sign - changing to COMP-3" -msgstr "'%s' COMP-6 com sinal - a alterar para COMP-3" - -#: cobc/field.c:1377 -msgid "elementary items with SIGN clause must have S in PICTURE" -msgstr "itens elementares com a cláusula SIGN têm de ter 'S' em PICTURE" - -#: cobc/field.c:1380 -msgid "elementary items with SIGN clause must be USAGE DISPLAY or NATIONAL" -msgstr "itens elementares com a cláusula SIGN têm de usar USAGE DISPLAY or NATIONAL" - -#: cobc/field.c:1397 -#, c-format -msgid "'%s' cannot have JUSTIFIED RIGHT" -msgstr "'%s' não pode usar JUSTIFIED RIGHT" - -#: cobc/field.c:1410 -#, fuzzy, c-format -msgid "'%s' cannot have S in PICTURE string and BLANK WHEN ZERO" -msgstr "'%s' não pode ter 'S' em PICTURE e BLANK WHEN ZERO" - -#: cobc/field.c:1415 -#, c-format -msgid "'%s' cannot have BLANK WHEN ZERO without being USAGE DISPLAY or NATIONAL" -msgstr "'%s' não pode ter BLANK WHEN ZERO sem ser USAGE DISPLAY ou NATIONAL" - -#: cobc/field.c:1426 -#, fuzzy, c-format -msgid "'%s' cannot have * in PICTURE string and BLANK WHEN ZERO" -msgstr "'%s' não pode ter '*' em PICTURE e BLANK WHEN ZERO" - -#: cobc/field.c:1433 -#, fuzzy, c-format -msgid "'%s' is not numeric, so cannot have BLANK WHEN ZERO" -msgstr "'%s' não é numérico, portanto não pode ter BLANK WHEN ZERO" - -#: cobc/field.c:1446 -#, fuzzy -msgid "only level 88 items may have multiple values" -msgstr "apenas os itens de nível 88 podem usar valores múltiplos" - -#: cobc/field.c:1454 cobc/field.c:1458 -#, fuzzy, c-format -msgid "initial VALUE clause ignored for %s item '%s'" -msgstr "cláusula inicial VALUE ignorada para o item EXTERNAL" - -#: cobc/field.c:1471 -msgid "FULL has no effect on numeric items; you may want REQUIRED or PIC Z" -msgstr "" - -#: cobc/field.c:1499 -msgid "VALUE may not contain a figurative constant" -msgstr "" - -#: cobc/field.c:1507 -#, fuzzy -msgid "cannot specify both FULL and JUSTIFIED" -msgstr "não é possível especificar ambos '%s' e '%s'" - -#: cobc/field.c:1519 -#, c-format -msgid "'%s' has FROM, TO or USING without PIC; PIC will be implied" -msgstr "" - -#: cobc/field.c:1533 -#, c-format -msgid "'%s' has numeric VALUE without PIC; PIC will be implied" -msgstr "" - -#: cobc/field.c:1548 -#, c-format -msgid "'%s' cannot have PIC without FROM, TO, USING or numeric VALUE" -msgstr "" - -#: cobc/field.c:1560 -#, c-format -msgid "'%s' needs a PIC, FROM, TO, USING, VALUE, BELL, BLANK or ERASE clause" -msgstr "" - -#: cobc/field.c:1574 -#, fuzzy -msgid "cannot specify both PIC and VALUE" -msgstr "não é possível especificar ambos '%s' e '%s'" - -#: cobc/field.c:1582 -msgid "cannot have PIC without FROM, TO or USING" -msgstr "" - -#: cobc/field.c:1591 -msgid "cannot have FROM, TO or USING without PIC" -msgstr "" - -#: cobc/field.c:1600 -#, fuzzy -msgid "VALUE item may not be numeric" -msgstr "item INITIALIZED TO não é alfanumérico" - -#: cobc/field.c:1616 -#, c-format -msgid "'%s' needs a PIC, COL, LINE, VALUE, BELL or BLANK clause" -msgstr "" - -#: cobc/field.c:1647 -msgid "cannot use AUTO, FULL, PROMPT, REQUIRED or SECURE on elementary item without TO or USING" -msgstr "" - -#: cobc/field.c:1654 -msgid "cannot use BLANK WHEN ZERO, JUSTIFIED, OCCURS or SIGN on item without FROM, TO or USING" -msgstr "" - -#: cobc/field.c:1674 -msgid "cannot use AUTO, FULL, REQUIRED or SECURE on elementary item without FROM, TO or USING" -msgstr "" - -#: cobc/field.c:1679 -msgid "cannot use BLANK WHEN ZERO, JUSTIFIED or SIGN without FROM, TO or USING" -msgstr "" - -#: cobc/field.c:1697 -#, fuzzy -msgid "cannot have BLANK WHEN ZERO without PIC" -msgstr "'%s' não pode ter BLANK WHEN ZERO sem ser USAGE DISPLAY ou NATIONAL" - -#: cobc/field.c:1700 -#, fuzzy -msgid "cannot have JUSTIFIED without PIC" -msgstr "'%s' não pode usar JUSTIFIED RIGHT" - -#: cobc/field.c:1720 -msgid "cannot have AUTO without FROM, TO or USING" -msgstr "" - -#: cobc/field.c:1725 -msgid "cannot use FULL or REQUIRED on item without TO or USING" -msgstr "" - -#: cobc/field.c:1732 -msgid "SECURE can be used with TO only" -msgstr "" - -#: cobc/field.c:1734 -#, fuzzy -msgid "SECURE must be used with TO" -msgstr "READ tem de ser executado primeiro" - -#: cobc/field.c:1753 -#, fuzzy, c-format -msgid "'%s' does nothing" -msgstr "%s não está definid(o/a)" - -#: cobc/field.c:1797 -msgid "BLANK ZERO not compatible with USAGE" -msgstr "BLANK ZERO não compatível com USAGE" - -#: cobc/field.c:1800 -#, fuzzy -msgid "SIGN clause not compatible with USAGE" -msgstr "cláusula %s não compatível com USAGE %d" - -#: cobc/field.c:1977 -#, fuzzy, c-format -msgid "'%s' PICTURE clause not compatible with USAGE" -msgstr "a cláusula PICTURE não é compatível com USAGE %s" - -#: cobc/field.c:2027 -#, fuzzy, c-format -msgid "'%s' 77 level is not allowed here" -msgstr "'%s' o nível 77 não é permitido aqui" - -#: cobc/field.c:2424 -msgid "OCCURS and multi COLUMNs is not allowed" -msgstr "" - -#: cobc/field.c:2452 -#, fuzzy, c-format -msgid "duplicate LINE %d ignored" -msgstr "definição (define) duplicada '%s' - ignorado" - -#: cobc/field.c:2469 -#, fuzzy, c-format -msgid "ignoring SYNCHRONIZED for group item '%s'" -msgstr "ignorando SYNCHRONIZIED para o item de grupo '%s'" - -#: cobc/field.c:2485 cobc/field.c:2498 cobc/field.c:2778 cobc/field.c:2781 -#, fuzzy, c-format -msgid "size of '%s' larger than size of '%s'" -msgstr "o tamanho de '%s' é mais comprido que o tamanho de '%s'" - -#: cobc/field.c:2638 cobc/field.c:2703 -#, fuzzy, c-format -msgid "'%s' cannot be larger than %d bytes" -msgstr "'%s' não pode ser maior do que %d octetos (bytes)" - -#: cobc/field.c:2676 cobc/field.c:2684 -#, c-format -msgid "'%s' binary field cannot be larger than %d digits" -msgstr "'%s' o campo binário não pode ser maior do que %d dígitos" - -#: cobc/field.c:2764 cobc/field.c:3216 -#, fuzzy, c-format -msgid "unexpected USAGE: %d" -msgstr "USAGE inesperado: %d" - -#: cobc/field.c:2876 -#, fuzzy -msgid "literal type does not match numeric data type" -msgstr "tipo literal não corresponde ao tipo de dados numérico" - -#: cobc/field.c:2953 -#, c-format -msgid "THRU item '%s' may not come before '%s'" -msgstr "o item THRU '%s' não pode vir antes de '%s'" - -#: cobc/field.c:2976 -#, c-format -msgid "RENAMES cannot start/end at the OCCURS item '%s'" -msgstr "RENAMES não pode iniciar/acabar no item OCCURS '%s'" - -#: cobc/field.c:2984 -#, c-format -msgid "cannot use RENAMES on part of the table '%s'" -msgstr "não pode usar RENAMES em parte da tabela '%s'" - -#: cobc/field.c:3022 -#, c-format -msgid "RENAMES may not contain '%s' as it is a pointer or object reference" -msgstr "RENAMES não pode conter '%s' porque é um ponteiro ou uma referência a um objeto" - -#: cobc/field.c:3027 -#, c-format -msgid "RENAMES may not contain '%s' as it is an OCCURS DEPENDING table" -msgstr "RENAMES não pode conter '%s' porque é uma tabela OCCURS DEPENDING (ODO table)" - -#: cobc/field.c:3049 -msgid "RENAMES of 01-, 66- and 77-level items" -msgstr "RENAMES dos itens de nível 01, 66 e 77" - -#: cobc/field.c:3051 -#, fuzzy -msgid "RENAMES may not reference a level 88" -msgstr "RENAMES não pode referênciar o nível 88" - -#: cobc/field.c:3075 -#, c-format -msgid "'%s' must immediately follow the record '%s'" -msgstr "''%s' tem de vir imediatamente após o registo '%s'" - -#: cobc/field.c:3083 -#, c-format -msgid "THRU item must be different to '%s'" -msgstr "o item THRU tem de ser diferente de '%s'" - -#: cobc/field.c:3089 -#, c-format -msgid "'%s' and '%s' must be in the same record" -msgstr "'%s' e '%s' têm que estar definidos no mesmo registo" - -#: cobc/field.c:3100 -#, c-format -msgid "THRU item '%s' may not be subordinate to '%s'" -msgstr "o item THRU '%s' não pode ser subordinado a '%s'" - -#: cobc/flag.def:40 -msgid "" -" -fstack-size=\tdefine PERFORM stack size\n" -" * default: 255" -msgstr "" - -#: cobc/flag.def:44 -#, fuzzy -msgid "" -" -fsign=[ASCII|EBCDIC]\tdefine display sign representation\n" -" * default: machine native" -msgstr "" -"Definir a representação do sinal de exibição\n" -"\t\t\t- ASCII ou EBCDIC (Padrão : nativo da máquina)" - -#: cobc/flag.def:48 -#, fuzzy -msgid "" -" -ffold-copy=[UPPER|LOWER]\tfold COPY subject to value\n" -" * default: no transformation" -msgstr "" -"insensibilidade à capitalização de COPY (Fold COPY) sujeito a valor (e.g. -ffold-copy=UPPER)\n" -"\t\t\t- Maiúsculas (UPPER) ou minúsculas (LOWER) (Padrão : sem transformação)" - -#: cobc/flag.def:52 -msgid "" -" -ffold-call=[UPPER|LOWER]\tfold PROGRAM-ID, CALL, CANCEL subject to value\n" -" * default: no transformation" -msgstr "" - -#: cobc/flag.def:56 -msgid "" -" -fdefaultbyte=\tinitialize fields without VALUE to value\n" -" * decimal 0..255 or any quoted character\n" -" * default: initialize to picture" -msgstr "" - -#: cobc/flag.def:61 -msgid "" -" -fmax-errors=\tmaximum number of errors to report before\n" -" compilation is aborted\n" -" * default: 128" -msgstr "" - -#: cobc/flag.def:68 -msgid "" -" -fintrinsics=[ALL|intrinsic function name(,name,...)]\n" -" intrinsics to be used without FUNCTION keyword" -msgstr "" - -#: cobc/flag.def:72 -msgid "" -" -fdump= dump data fields on abort, may be\n" -" a combination of: ALL, WS, LS, RD, FD, SC" -msgstr "" - -#: cobc/flag.def:76 -msgid "" -" -fcallfh= use external provided EXTFH interface module\n" -" for I/O" -msgstr "" - -#: cobc/flag.def:80 -msgid "" -" -fsqldb= which Database is used, may be\n" -" MySQL, MSSQL, Oracle10, Oracle11, Oracle12" -msgstr "" - -#: cobc/flag.def:84 -msgid " -fsqlschema= define database schema name" -msgstr "" - -#: cobc/flag.def:91 -msgid "" -" -fno-recursive-check disable check of recursive program call;\n" -" effectively compiling as RECURSIVE program" -msgstr "" - -#: cobc/flag.def:95 -#, fuzzy -msgid "" -" -fwinmain generate WinMain instead of main when compiling\n" -" as executable" -msgstr " -i, -info exibe a informação do compilador (compilação/ambiente)" - -#: cobc/flag.def:99 -#, fuzzy -msgid " -fcomputed-goto generate computed goto C statements" -msgstr "gera instruções 'goto' na linguagem 'C'" - -#: cobc/flag.def:102 -#, fuzzy -msgid " -falternate-ebcdic use restricted ASCII to EBCDIC translate" -msgstr "usa tradução ASCII para EBCDIC de forma restrita" - -#: cobc/flag.def:105 -msgid " -fextra-brace generate extra braces in C source" -msgstr "" - -#: cobc/flag.def:108 -msgid " -fgen-c-line-directives\tgenerate source location directives in C code" -msgstr "" - -#: cobc/flag.def:111 -msgid " -fgen-c-labels generate extra labels in C sources" -msgstr "" - -#: cobc/flag.def:114 -#, fuzzy -msgid " -fcorrect-numeric attempt correction of invalid numeric display items" -msgstr "tentativa de correção de itens de exibição numéricos inválidos" - -#: cobc/flag.def:117 -#, fuzzy -msgid " -fstack-on-heap PERFORM stack allocated on heap" -msgstr "pilha de PERFORM alocada na memória 'heap' (estrutura de dados organizada como árvore binária balanceada)" - -#: cobc/flag.def:120 -msgid " -ffast-math Disables emitting faster arithmetic logic" -msgstr "" - -#: cobc/flag.def:125 -msgid "" -" -fno-remove-unreachable\tdisable remove of unreachable code\n" -" * turned off by -g" -msgstr "" - -#: cobc/flag.def:129 -msgid " -finline-intrinsic\twhen possible resolve intrinsic FUNCTIONs at compile time" -msgstr "" - -#: cobc/flag.def:132 -#, fuzzy -msgid "" -" -ftrace generate trace code\n" -" * scope: executed SECTION/PARAGRAPH" -msgstr "" -" -Xref gera uma referência cruzada através de 'cobxref'\n" -" ('cobxref' de V. Coen tem que estar definido em 'path')" - -#: cobc/flag.def:136 -#, fuzzy -msgid "" -" -ftraceall generate trace code\n" -" * scope: executed SECTION/PARAGRAPH/STATEMENTS\n" -" * turned on by -debug" -msgstr "" -"gera código de rastreio\n" -"\t\t\t- SECTION/PARAGRAPH/STATEMENTS executado(s)\n" -"\t\t\t- habilitado por -debug" - -#: cobc/flag.def:141 -#, fuzzy -msgid " -fsyntax-only syntax error checking only; don't emit any output" -msgstr "apenas para verificação de erros de sintaxe; não emite qualquer resultado" - -#: cobc/flag.def:144 -#, fuzzy -msgid "" -" -fdebugging-line enable debugging lines\n" -" * 'D' in indicator column or floating >>D" -msgstr "" -"habilita linhas de depuração\n" -"\t\t\t- 'D' na coluna indicadora (7) ou '>>D' flutuante" - -#: cobc/flag.def:148 -#, fuzzy -msgid "" -" -fsource-location generate source location code\n" -" * turned on by -debug/-g/-ftraceall" -msgstr "" -"Gera código de localização na fonte (source)\n" -"\t\t\t- habilitado por '-debug/-g/-ftraceall'" - -#: cobc/flag.def:152 -#, fuzzy -msgid " -fimplicit-init automatic initialization of the COBOL runtime system" -msgstr "inicialização automática do sistema de execução (runtime) do GnuCOBOL" - -#: cobc/flag.def:155 -#, fuzzy -msgid "" -" -fstack-check PERFORM stack checking\n" -" * turned on by -debug or -g" -msgstr "" -"verificação da pilha (stack) de PERFORM\n" -"\t\t\t- habilitado por '-debug' ou '-g'" - -#: cobc/flag.def:159 -#, fuzzy -msgid "" -" -fwrite-after use AFTER 1 for WRITE of LINE SEQUENTIAL\n" -" * default: BEFORE 1" -msgstr "" -"usar AFTER 1 para escrita (WRITE) de ficheiros sequênciais com registos delimitados (LINE SEQUENTIAL)\n" -"\t\t\t- padrão: BEFORE 1" - -#: cobc/flag.def:163 -#, fuzzy -msgid "" -" -fmfcomment '*' or '/' in column 1 treated as comment\n" -" * FIXED format only" -msgstr "" -"'*' ou '/' na columa 1 tratado como comentário\n" -"\t\t\t- apenas para fontes de formato fixo (FIXED)" - -#: cobc/flag.def:167 -#, fuzzy -msgid "" -" -facucomment '$' in indicator area treated as '*',\n" -" '|' treated as floating comment" -msgstr "" -"'$' na coluna indicadora (7) é tratado como '*',\n" -"\t\t\t'|' tratado como comentário flutuante" - -#: cobc/flag.def:171 -#, fuzzy -msgid "" -" -fnotrunc allow numeric field overflow\n" -" * non-ANSI behaviour" -msgstr "" -"permit(e/ir) transbordo (overflow) de campo numérico\n" -"\t\t\t- comportamento não-ANSI" - -#: cobc/flag.def:175 -msgid "" -" -fodoslide adjust items following OCCURS DEPENDING\n" -" * implies -fcomplex-odo" -msgstr "" - -#: cobc/flag.def:179 -#, fuzzy -msgid "" -" -fsingle-quote use a single quote (apostrophe) for QUOTE\n" -" * default: double quote" -msgstr "" -"usa apóstrofo (apostrophe) para QUOTE\n" -"\t\t\t- padrão: aspa (double quote)" - -#: cobc/flag.def:189 -#, fuzzy -msgid "" -" -foptional-file treat all files as OPTIONAL\n" -" * unless NOT OPTIONAL specified" -msgstr "" -"trata todos os ficheiros como opcionais (OPTIONAL)\n" -"\t\t\t- exceto se NOT OPTIONAL fôr especificado" - -# @@@ BAD ENGLISH OR BAD PORTUGUESE ??? -#: cobc/flag.def:193 -#, fuzzy -msgid " -fstatic-call output static function calls for the CALL statement" -msgstr "chamadas a funções estáticas de saída para a instrução CALL" - -#: cobc/flag.def:196 -#, fuzzy -msgid "" -" -fno-gen-c-decl-static-call\tdisable generation of C function declations\n" -" for subroutines with static CALL" -msgstr "desabilita a generação de declarações de funções 'C' para subrotinas com chamada (CALL) estática" - -#: cobc/flag.def:200 -msgid " -fmf-files Sequential & Relative files will match Micro Focus format" -msgstr "" - -#: cobc/flag.def:203 -msgid "" -" -fno-theaders suppress all headers and output of compilation\n" -" options from listing while keeping page breaks" -msgstr "" - -#: cobc/flag.def:207 -#, fuzzy -msgid " -fno-tsource suppress source from listing" -msgstr " -F -free usa programa fonte (source) de formato livre" - -#: cobc/flag.def:210 -msgid " -fno-tmessages suppress warning and error summary from listing" -msgstr "" - -#: cobc/flag.def:213 -#, fuzzy -msgid " -ftsymbols specify symbols in listing" -msgstr " --no-symbols não especifica símbolos na listagem" - -#: cobc/parser.y:283 cobc/parser.y:317 -#, fuzzy, c-format -msgid "unreachable statement '%s'" -msgstr "instrução inacessível '%s'" - -#: cobc/parser.y:410 cobc/parser.y:703 -#, c-format -msgid "'%s' is not in LINKAGE SECTION" -msgstr "'%s' não está na LINKAGE SECTION" - -#: cobc/parser.y:413 cobc/typeck.c:3705 -#, fuzzy, c-format -msgid "'%s' cannot be BASED/EXTERNAL" -msgstr "'%s' não pode ser BASED/EXTERNAL" - -#: cobc/parser.y:418 -#, c-format -msgid "'%s' is not in WORKING-STORAGE SECTION" -msgstr "'%s' não está na WORKING-STORAGE SECTION" - -#: cobc/parser.y:425 cobc/typeck.c:3702 -#, c-format -msgid "'%s' not level 01 or 77" -msgstr "'%s' não pertence ao nível 01 ou 77" - -#: cobc/parser.y:428 cobc/parser.y:443 cobc/typeck.c:3708 -#, c-format -msgid "'%s' REDEFINES field not allowed here" -msgstr "'%s' campo REDEFINES não é permitido aqui" - -#: cobc/parser.y:456 -#, c-format -msgid "'%s' USING item duplicates RETURNING item" -msgstr "'%s' item USING duplica o item RETURNING" - -#: cobc/parser.y:466 -#, c-format -msgid "ENTRY '%s' duplicated" -msgstr "ENTRY '%s' duplicad(o/a)" - -#: cobc/parser.y:502 -#, fuzzy, c-format -msgid "ENTRY FOR GO TO '%s' duplicated" -msgstr "ENTRY '%s' duplicad(o/a)" - -#: cobc/parser.y:518 -#, fuzzy, c-format -msgid "maximum nested program depth exceeded (%d)" -msgstr "profundidade máxima excedida para programa aninhado (programa contido dentro de outro) (nested) (%d)" - -#: cobc/parser.y:544 cobc/parser.y:571 -#, fuzzy, c-format -msgid "%s statement not terminated by %s" -msgstr "instrução %s não terminada por END-%s" - -#: cobc/parser.y:574 -#, fuzzy, c-format -msgid "%s statement not terminated" -msgstr "instrução %s não terminada por END-%s" - -#: cobc/parser.y:638 -msgid "USE statement invalid for SORT file" -msgstr "instrução USE inválida para o ficheiro de ordenação (SORT file)" - -#: cobc/parser.y:665 cobc/parser.y:667 -#, fuzzy, c-format -msgid "duplicate %s clause" -msgstr "cláusula %s duplicada" - -#: cobc/parser.y:685 -#, c-format -msgid "Cannot specify %s without number of lines on page" -msgstr "" - -#: cobc/parser.y:695 -#, fuzzy, c-format -msgid "maximum OCCURS depth exceeded (%d)" -msgstr "profundidade máxima excedida para OCCURS (%d)" - -#: cobc/parser.y:709 cobc/parser.y:711 cobc/parser.y:6808 cobc/parser.y:6811 -#: cobc/parser.y:6813 cobc/parser.y:6815 cobc/parser.y:6850 cobc/parser.y:7573 -#: cobc/parser.y:7575 cobc/parser.y:7577 cobc/parser.y:7579 cobc/parser.y:7625 -#: cobc/parser.y:7634 cobc/parser.y:9548 cobc/parser.y:10994 -#: cobc/parser.y:12370 cobc/parser.y:13552 -#, c-format -msgid "%s and %s are mutually exclusive" -msgstr "%s e %s são mutuamente exclusivos" - -#: cobc/parser.y:725 cobc/parser.y:729 -msgid "TO phrase without DEPENDING phrase" -msgstr "frase TO sem frase DEPENDING" - -#: cobc/parser.y:726 -#, fuzzy -msgid "maximum number of occurrences assumed to be exact number" -msgstr "número máximo de ocorrências assumido como número exato" - -#: cobc/parser.y:733 cobc/parser.y:7355 -msgid "OCCURS TO must be greater than OCCURS FROM" -msgstr "OCCURS TO tem de ser maior que OCCURS FROM" - -#: cobc/parser.y:742 -#, fuzzy -msgid "OCCURS DEPENDING ON without TO phrase" -msgstr "ODO (OCCURS DEPENDING ON) sem a frase TO" - -#: cobc/parser.y:808 -#, c-format -msgid "%s header missing - assumed" -msgstr "%s sem o cabeçalho - assumido" - -#: cobc/parser.y:810 -#, c-format -msgid "%s header missing" -msgstr "%s sem o cabeçalho" - -#: cobc/parser.y:942 -#, fuzzy, c-format -msgid "duplicate %s" -msgstr "cláusula %s duplicada" - -#: cobc/parser.y:944 -#, c-format -msgid "%s incorrectly after %s" -msgstr "" - -#: cobc/parser.y:1046 -#, fuzzy, c-format -msgid "redefinition of program name '%s'" -msgstr "redefinição do nome do programa '%s'" - -#: cobc/parser.y:1050 -#, fuzzy, c-format -msgid "redefinition of program ID '%s'" -msgstr "redefinição da identificação do programa (program ID) '%s'" - -#: cobc/parser.y:1082 -#, c-format -msgid "FUNCTION '%s' has no PROCEDURE DIVISION" -msgstr "" - -#: cobc/parser.y:1188 -msgid "functions may not be defined within a program/function" -msgstr "" - -#: cobc/parser.y:1238 -#, fuzzy, c-format -msgid "END FUNCTION '%s' is different from FUNCTION-ID '%s'" -msgstr "END FUNCTION '%s' não corresponde a FUNCTION-ID '%s'" - -#: cobc/parser.y:1252 -#, fuzzy, c-format -msgid "END PROGRAM '%s' is different from PROGRAM-ID '%s'" -msgstr "END PROGRAM '%s' não corresponde a PROGRAM-ID '%s'" - -#: cobc/parser.y:1301 -#, fuzzy -msgid "currency symbol must be one character long" -msgstr "'%s' CURSOR tem de ter 4 ou 6 carateres" - -#: cobc/parser.y:1358 -#, fuzzy, c-format -msgid "invalid character '%c' in currency symbol" -msgstr "um símbolo monetário traseiro (e.g. 123.45 €)" - -#: cobc/parser.y:1374 -msgid "prototype has same name as current function and will be ignored" -msgstr "protótipo tem o mesmo nome da função atual e será ignorado" - -#: cobc/parser.y:1401 -#, c-format -msgid "duplicate REPOSITORY entries for '%s' do not match" -msgstr "entradas de repositório (REPOSITORY) para '%s' não correspondem" - -#: cobc/parser.y:1405 -#, c-format -msgid "duplicate REPOSITORY entry for '%s'" -msgstr "entrada de repositório (REPOSITORY entry) duplicada para '%s'" - -#: cobc/parser.y:1470 -#, c-format -msgid "ORGANIZATION %s is incompatible with RECORD DELIMITER" -msgstr "" - -#: cobc/parser.y:1502 -#, c-format -msgid "illegal combination of %s with other clauses" -msgstr "" - -#: cobc/parser.y:1517 cobc/parser.y:1520 cobc/parser.y:1551 -#, c-format -msgid "cannot specify both %s and %s" -msgstr "não é possível especificar ambos '%s' e '%s'" - -#: cobc/parser.y:1548 -#, c-format -msgid "cannot specify both %s and %s; %s is ignored" -msgstr "não é possível especificar ambos '%s' e '%s'; '%s' ignorado" - -#: cobc/parser.y:1720 -msgid "FOR phrase cannot immediately follow ALL/LEADING/TRAILING" -msgstr "frase FOR não pode seguir imediatamente ALL/LEADING/TRAILING" - -#: cobc/parser.y:1722 -msgid "missing CHARACTERS/ALL/LEADING/TRAILING phrase after FOR phrase" -msgstr "falta a frase CHARACTERS/ALL/LEADING/TRAILING após a frase FOR" - -#: cobc/parser.y:1729 -#, fuzzy -msgid "missing value between ALL/LEADING/TRAILING words" -msgstr "falta o valor entre as palavras CHARACTERS/ALL/LEADING/TRAILING" - -#: cobc/parser.y:1734 -msgid "missing FOR phrase before CHARACTERS/ALL/LEADING/TRAILING phrase" -msgstr "falta a frase FOR antes da frase CHARACTERS/ALL/LEADING/TRAILING" - -#: cobc/parser.y:1741 -#, fuzzy -msgid "missing ALL/LEADING/TRAILING before value" -msgstr "falta ALL/LEADING/TRAILING antes do valor" - -#: cobc/parser.y:1796 -msgid "use of condition-name in place of data-name" -msgstr "" - -#: cobc/parser.y:1800 cobc/parser.y:6753 cobc/typeck.c:665 -#, fuzzy, c-format -msgid "condition-name not allowed here: '%s'" -msgstr "modificação da referência não é permitida aqui" - -#: cobc/parser.y:1827 -msgid "cannot specify NO ADVANCING in screen DISPLAY" -msgstr "não é possível especificar NO ADVANCING em exibição de ecrã (screen DISPLAY)" - -#: cobc/parser.y:1899 cobc/parser.y:1916 -msgid "non-standard DISPLAY" -msgstr "DISPLAY despadronizado (non-standard)" - -#: cobc/parser.y:1903 -msgid "screens may only be displayed on CRT" -msgstr "ecrãs (screens) só podem ser exibidos no ecrã CRT (tubo de raios catódicos)" - -#: cobc/parser.y:1908 cobc/parser.y:1951 -msgid "cannot mix screens and fields in the same DISPLAY statement" -msgstr "não pode misturar ecrãs (screens) e campos (fields) na mesma instrução DISPLAY" - -#: cobc/parser.y:1912 -msgid "screen clauses may only be used for DISPLAY on CRT" -msgstr "cláusulas de ecrã (screen) só podem ser usadas com DISPLAY no ecrã CRT (tubo de raios catódicos)" - -#: cobc/parser.y:1957 -msgid "ambiguous DISPLAY; put items to display on device in separate DISPLAY" -msgstr "DISPLAY ambíguo; colocar os items a exibir num dispositivo com exibição (DISPLAY) separada" - -#: cobc/parser.y:1973 -#, fuzzy, c-format -msgid "%s is not an alphanumeric literal" -msgstr "'%s' não é um literal alfanumérico" - -#: cobc/parser.y:1975 -#, fuzzy, c-format -msgid "'%s' is not USAGE DISPLAY" -msgstr "'%s' não é USAGE DISPLAY" - -#: cobc/parser.y:1990 cobc/typeck.c:8481 -#, fuzzy, c-format -msgid "invalid target for %s" -msgstr "destino inválido para %s" - -#: cobc/parser.y:1997 cobc/parser.y:6747 -#, fuzzy -msgid "SCREEN item cannot be used here" -msgstr "'%s' não pode ser usad(o/a) aqui" - -#: cobc/parser.y:1999 -#, fuzzy -msgid "RENAMES item may not be used here" -msgstr "a constante não pode ser usada aqui - '%s'" - -#: cobc/parser.y:2001 cobc/typeck.c:2333 cobc/typeck.c:2429 -msgid "ANY LENGTH item not allowed here" -msgstr "item ANY LENGTH não é permitido aqui" - -#: cobc/parser.y:2005 -#, c-format -msgid "item '%s' has wrong class for VALIDATE" -msgstr "" - -#: cobc/parser.y:2014 -#, fuzzy -msgid "WHEN clause must follow EVERY clause" -msgstr "cláusula REDEFINES tem de seguir o nome-de-entrada" - -#: cobc/parser.y:2096 cobc/parser.y:17197 -#, fuzzy -msgid "non-zero value expected" -msgstr "esperado um valor inteiro" - -#: cobc/parser.y:2102 cobc/tree.c:4352 -#, fuzzy, c-format -msgid "RECORD size (IDX) exceeds maximum allowed (%d)" -msgstr "tamanho do registo (RECORD) excede o máximo permitido (%d)" - -#: cobc/parser.y:2106 cobc/tree.c:4355 -#, c-format -msgid "RECORD size exceeds maximum allowed (%d)" -msgstr "tamanho do registo (RECORD) excede o máximo permitido (%d)" - -#: cobc/parser.y:2111 -msgid "RECORD clause invalid" -msgstr "cláusula RECORD inválida" - -#: cobc/parser.y:3188 -#, fuzzy -msgid "multiple PROGRAM-ID's without matching END PROGRAM" -msgstr "múltiplos 'PROGRAM-ID' sem o correspondente 'END PROGRAM' de cada um" - -#: cobc/parser.y:3191 -#, fuzzy -msgid "executable requested but no program found" -msgstr "programa executável solicitado mas não encontrado" - -#: cobc/parser.y:3408 cobc/parser.y:3417 -msgid "COMMON may only be used in a contained program" -msgstr "COMMON só pode ser usado num programa aninhado (programa contido dentro de outro)" - -#: cobc/parser.y:3426 cobc/parser.y:3458 -msgid "CALL prototypes" -msgstr "protótipos CALL" - -#: cobc/parser.y:3607 cobc/parser.y:3884 cobc/parser.y:3928 cobc/parser.y:4036 -#: cobc/parser.y:4223 cobc/parser.y:4319 cobc/parser.y:4360 cobc/parser.y:4431 -#: cobc/parser.y:4452 cobc/parser.y:4531 cobc/parser.y:4550 cobc/parser.y:4566 -#: cobc/parser.y:4584 cobc/parser.y:4602 cobc/parser.y:4619 cobc/parser.y:4637 -#: cobc/parser.y:6868 cobc/parser.y:7694 -#, c-format -msgid "%s not allowed in nested programs" -msgstr "%s não é permitido em programas aninhados (programas contidos dentro de outros)" - -#: cobc/parser.y:3761 -msgid "segment-number must be in range of values 1 to 49" -msgstr "" - -#: cobc/parser.y:3773 -#, fuzzy -msgid "duplicate CLASSIFICATION clause" -msgstr "cláusula CLASSIFICATION duplicada" - -#: cobc/parser.y:3849 -msgid "PROGRAM phrase" -msgstr "frase PROGRAM" - -#: cobc/parser.y:3944 cobc/parser.y:3955 cobc/parser.y:4271 -#, fuzzy, c-format -msgid "invalid %s clause" -msgstr "cláusula %s inválida" - -#: cobc/parser.y:4386 cobc/parser.y:4390 -msgid "CLASS literal with THRU must have size 1" -msgstr "literal CLASS com THRU tem de ter 1 caratere de comprimento" - -#: cobc/parser.y:4417 -#, fuzzy -msgid "CLASS IS integer IN alphabet-name" -msgstr "'%s' não é um nome-de-alfabeto" - -#: cobc/parser.y:4464 -msgid "separate currency symbol and currency string" -msgstr "" - -#: cobc/parser.y:4497 -#, fuzzy, c-format -msgid "invalid CURRENCY SIGN '%s'" -msgstr "CURRENCY SIGN '%s' inválido" - -#: cobc/parser.y:4715 -msgid "cannot use RELATIVE KEY clause on INDEXED files" -msgstr "" - -#: cobc/parser.y:4719 -msgid "cannot use RECORD KEY clause on RELATIVE files" -msgstr "" - -#: cobc/parser.y:4793 -msgid "EXTERNAL/DYNAMIC cannot be used with literals" -msgstr "" - -#: cobc/parser.y:4813 -msgid "EXTERNAL/DYNAMIC cannot be used with USING/VARYING" -msgstr "" - -#: cobc/parser.y:4824 -msgid "EXTERNAL/DYNAMIC cannot be used with DISK FROM" -msgstr "" - -#: cobc/parser.y:4826 -msgid "ASSIGN DISK FROM" -msgstr "" - -#: cobc/parser.y:4942 -msgid "ASSIGN EXTERNAL/DYNAMIC" -msgstr "" - -#: cobc/parser.y:5165 -#, fuzzy, c-format -msgid "'%s' is not an alphabet-name" -msgstr "'%s' não é um nome-de-alfabeto" - -#: cobc/parser.y:5254 -#, c-format -msgid "%s only valid with ORGANIZATION %s" -msgstr "" - -#: cobc/parser.y:5321 cobc/parser.y:5344 -#, fuzzy, c-format -msgid "RECORD DELIMITER %s only allowed with SEQUENTIAL files" -msgstr "READ PREVIOUS apenas permitida em ficheiros indexados de leitura sequencial (INDEXED SEQUENTIAL)" - -#: cobc/parser.y:5323 cobc/parser.y:5336 cobc/parser.y:5348 cobc/parser.y:5358 -#, fuzzy -msgid "RECORD DELIMITER clause" -msgstr "cláusulas LOCK" - -#: cobc/parser.y:5332 -#, fuzzy, c-format -msgid "RECORD DELIMITER %s only allowed with (LINE) SEQUENTIAL files" -msgstr "READ PREVIOUS apenas permitida em ficheiros indexados de leitura sequencial (INDEXED SEQUENTIAL)" - -#: cobc/parser.y:5337 -msgid "LINE-SEQUENTIAL phrase" -msgstr "" - -#: cobc/parser.y:5349 -msgid "BINARY-SEQUENTIAL phrase" -msgstr "" - -#: cobc/parser.y:5357 -#, fuzzy -msgid "RECORD DELIMITER clause only allowed with (LINE) SEQUENTIAL files" -msgstr "READ PREVIOUS apenas permitida em ficheiros indexados de leitura sequencial (INDEXED SEQUENTIAL)" - -#: cobc/parser.y:5360 -#, c-format -msgid "RECORD DELIMITER %s not recognized; will be ignored" -msgstr "" - -#: cobc/parser.y:5398 -msgid "DUPLICATES for primary keys" -msgstr "" - -#: cobc/parser.y:5637 -msgid "DOS/VS APPLY phrase" -msgstr "" - -#: cobc/parser.y:5752 -msgid "RECORD description missing or invalid" -msgstr "descrição RECORD não existe ou é inválida" - -#: cobc/parser.y:5778 -#, fuzzy, c-format -msgid "duplicate file description for %s" -msgstr "valores duplicados na classe '%s'" - -#: cobc/parser.y:5811 cobc/parser.y:5821 -#, fuzzy -msgid "file cannot have both EXTERNAL and GLOBAL clauses" -msgstr "ficheiro não pode ter ambas as cláusulas EXTERNAL e GLOBAL" - -#: cobc/parser.y:5825 cobc/parser.y:6414 cobc/parser.y:6853 cobc/parser.y:12363 -#: cobc/parser.y:15305 -#, fuzzy, c-format -msgid "%s is invalid in a user FUNCTION" -msgstr "%s é inválid(o/a) numa função-definida-pelo-utilizador (UDF)" - -#: cobc/parser.y:5863 cobc/parser.y:5872 -msgid "RECORD clause ignored for LINE SEQUENTIAL" -msgstr "cláusula RECORD ignorada para LINE SEQUENTIAL" - -#: cobc/parser.y:5964 -msgid "LINAGE clause with wrong file type" -msgstr "cláusula LINAGE com tipo de ficheiro incorreto" - -#: cobc/parser.y:6026 -msgid "RECORDING MODE U or S can only be used with RECORD SEQUENTIAL files" -msgstr "RECORDING MODE U or S só pode ser usado com ficheiros de registos sequenciais (RECORD SEQUENTIAL)" - -#: cobc/parser.y:6059 -#, fuzzy, c-format -msgid "ignoring CODE-SET '%s'" -msgstr "a ignorar CODE-SET '%s'" - -#: cobc/parser.y:6070 -msgid "CODE-SET clause invalid for file type" -msgstr "cláusula CODE-SET inválida para o tipo de ficheiro" - -#: cobc/parser.y:6092 -msgid "REPORT clause with wrong file type" -msgstr "cláusula REPORT com o tipo de ficheiro incorreto" - -#: cobc/parser.y:6170 -#, fuzzy -msgid "CD record missing" -msgstr "falta o registo CD" - -#: cobc/parser.y:6601 -msgid "CONSTANT item not at 01 level" -msgstr "item CONSTANT não se encontra no nível 01" - -#: cobc/parser.y:6721 -#, fuzzy -msgid "REDEFINES clause not following entry-name" -msgstr "cláusula REDEFINES tem de seguir o nome-de-entrada" - -#: cobc/parser.y:6743 -msgid "SAME AS clause" -msgstr "" - -#: cobc/parser.y:6750 -#, fuzzy -msgid "REPORT item cannot be used here" -msgstr "'%s' não pode ser usad(o/a) aqui" - -#: cobc/parser.y:6757 -#, fuzzy -msgid "elementary item expected" -msgstr "esperado um valor inteiro" - -#: cobc/parser.y:6764 -#, fuzzy -msgid "SAME AS item may not reference itself" -msgstr "RENAMES não pode referênciar o nível 88" - -#: cobc/parser.y:6771 -#, fuzzy -msgid "SAME AS item may not be subordinate to any item with USAGE clause" -msgstr "o item THRU '%s' não pode ser subordinado a '%s'" - -#: cobc/parser.y:6773 -#, fuzzy -msgid "SAME AS item may not be subordinate to any item with SIGN clause" -msgstr "o item THRU '%s' não pode ser subordinado a '%s'" - -#: cobc/parser.y:6801 cobc/parser.y:6855 cobc/parser.y:7567 cobc/parser.y:7650 -#: cobc/parser.y:7674 -#, c-format -msgid "%s not allowed here" -msgstr "%s não é permitido aqui" - -#: cobc/parser.y:6803 cobc/parser.y:6845 cobc/parser.y:7569 -#, c-format -msgid "%s only allowed at 01/77 level" -msgstr "%s apenas permitido no nível 01/77" - -#: cobc/parser.y:6805 cobc/parser.y:6847 cobc/parser.y:7571 cobc/parser.y:7654 -#: cobc/parser.y:7676 -#, fuzzy, c-format -msgid "%s requires a data name" -msgstr "%s requere um nome de dados" - -#: cobc/parser.y:6958 -msgid "a locale-format PICTURE string must only consist of '9', '.', '+', 'Z' and the currency-sign" -msgstr "" - -#: cobc/parser.y:6992 cobc/typeck.c:3658 -#, fuzzy, c-format -msgid "'%s' is not a locale-name" -msgstr "'%s' não é um nome de local (locale)" - -#: cobc/parser.y:7007 -#, fuzzy, c-format -msgid "'%s' is not a valid USAGE" -msgstr "'%s' não é um nome de datos válido" - -#: cobc/parser.y:7012 -#, fuzzy, c-format -msgid "unknown USAGE: %s" -msgstr "falha desconhecida: %d" - -#: cobc/parser.y:7149 -#, c-format -msgid "unknown HANDLE type: %s" -msgstr "" - -#: cobc/parser.y:7406 cobc/parser.y:7408 -msgid "INDEXED should follow ASCENDING/DESCENDING" -msgstr "" - -#: cobc/parser.y:7526 -msgid "SYNCHRONIZED clause" -msgstr "" - -#: cobc/parser.y:7529 -msgid "LEFT/RIGHT phrases in SYNCHRONIZED clause" -msgstr "" - -#: cobc/parser.y:7612 -msgid "FALSE clause only allowed for 88 level" -msgstr "cláusula FALSE apenas permitido no nivel 88" - -#: cobc/parser.y:7652 -#, fuzzy, c-format -msgid "%s only allowed at 01 level" -msgstr "%s apenas permitido no nível 01/77" - -#: cobc/parser.y:7656 cobc/parser.y:7678 -#, c-format -msgid "%s and %s combination not allowed" -msgstr "" - -#: cobc/parser.y:7787 -msgid "GLOBAL is not allowed with RD" -msgstr "GLOBAL não é permitido com RD" - -#: cobc/parser.y:8321 -msgid "PLUS is not recommended with LEFT, RIGHT or CENTER" -msgstr "" - -#: cobc/parser.y:8323 -#, fuzzy -msgid "PLUS is not allowed with LEFT, RIGHT or CENTER" -msgstr "GLOBAL não é permitido com RD" - -#: cobc/parser.y:8360 cobc/parser.y:8390 -msgid "PLUS is ignored on first field of line" -msgstr "" - -#: cobc/parser.y:8398 -msgid "invalid COLUMN integer; must be > 0" -msgstr "" - -#: cobc/parser.y:8400 -msgid "COLUMN numbers should increase" -msgstr "" - -#: cobc/parser.y:8499 cobc/parser.y:8555 -msgid "INITIAL specified on non-input field" -msgstr "INITIAL não foi especificado num campo de entrada" - -#: cobc/parser.y:8511 cobc/parser.y:8567 -msgid "relative LINE/COLUMN clause required with OCCURS" -msgstr "cláusula LINE/COLUMN relativa requerida com OCCURS" - -#: cobc/parser.y:8669 cobc/parser.y:8673 -msgid "screen positions from data-item" -msgstr "" - -#: cobc/parser.y:9498 -#, fuzzy -msgid "OCCURS screen items" -msgstr "GLOBAL não é permitida com itens de ecrã (screen)" - -#: cobc/parser.y:9510 -#, fuzzy -msgid "GLOBAL screen items" -msgstr "GLOBAL não é permitida com itens de ecrã (screen)" - -#: cobc/parser.y:9554 -msgid "overriding convention specified in ENTRY-CONVENTION" -msgstr "" - -#: cobc/parser.y:9566 -#, fuzzy -msgid "executable program requested but PROCEDURE/ENTRY has USING clause" -msgstr "programa executável solicitado mas PROCEDURE/ENTRY tem cláusula USING" - -#: cobc/parser.y:9636 cobc/parser.y:9653 cobc/parser.y:11184 -#, fuzzy, c-format -msgid "number of arguments exceeds maximum %d" -msgstr "número de parâmetros excede o máximo %d" - -#: cobc/parser.y:9645 -msgid "CHAINING invalid in user FUNCTION" -msgstr "CHAINING inválido numa função-definida-pelo-utilizador (UDF)" - -#: cobc/parser.y:9692 cobc/parser.y:11261 cobc/parser.y:11270 -#, c-format -msgid "%s not allowed in CHAINED programs" -msgstr "%s não é permitido em programas CHAINED" - -#: cobc/parser.y:9704 cobc/parser.y:9712 cobc/parser.y:9720 cobc/parser.y:9741 -msgid "SIZE only allowed for BY VALUE items" -msgstr "SIZE apenas permitido para itens passados por valor (BY VALUE)" - -#: cobc/parser.y:9743 cobc/parser.y:9760 -#, fuzzy -msgid "invalid value for SIZE" -msgstr "valor inválido para SIZE" - -#: cobc/parser.y:9775 -msgid "MEMORY SIZE phrase in CALL statement" -msgstr "" - -#: cobc/parser.y:9787 -msgid "OPTIONAL only allowed for BY REFERENCE items" -msgstr "OPTIONAL apenas permitido para itens passados por referência (BY REFERENCE)" - -#: cobc/parser.y:9799 -msgid "RETURNING clause is required for a FUNCTION" -msgstr "cláusula RETURNING é requerida para uma função (FUNCTION)" - -#: cobc/parser.y:9805 -msgid "RETURNING clause cannot be OMITTED for main program" -msgstr "cláusula RETURNING não pode ser OMITTED para o programa principal" - -#: cobc/parser.y:9808 -#, fuzzy -msgid "RETURNING clause cannot be OMITTED for a FUNCTION" -msgstr "cláusula RETURNING não pode ser omitida (OMITTED) para uma função (FUNTION)" - -#: cobc/parser.y:9821 -#, fuzzy -msgid "RETURNING item is not defined in LINKAGE SECTION" -msgstr "'%s' não está na LINKAGE SECTION" - -#: cobc/parser.y:9823 -#, fuzzy -msgid "RETURNING item must have level 01" -msgstr "item RETURNING tem de ter o nível 01" - -#: cobc/parser.y:9825 -#, fuzzy -msgid "RETURNING item should not have OCCURS" -msgstr "item RETURNING não deverá ter OCCURS" - -#: cobc/parser.y:9829 -msgid "function RETURNING item may not be ANY LENGTH" -msgstr "item RETURNING de uma função não pode ser definido com ANY LENGTH" - -#: cobc/parser.y:10017 -#, fuzzy, c-format -msgid "'%s' is not a statement" -msgstr "'%s' não é uma instrução" - -#: cobc/parser.y:10019 -#, c-format -msgid "unknown statement '%s'; it may exist in another dialect" -msgstr "instrução desconhecida '%s'; pode existir noutro dialeto" - -#: cobc/parser.y:10022 -#, fuzzy, c-format -msgid "unknown statement '%s'" -msgstr "instrução desconhecida '%s'" - -#: cobc/parser.y:10039 -msgid "section segments" -msgstr "" - -#: cobc/parser.y:10041 -msgid "SECTION segment-number must be less than or equal to 99" -msgstr "" - -#: cobc/parser.y:10044 -#, fuzzy -msgid "SECTION segment-number in DECLARATIVES must be less than 50" -msgstr "segmento SECTION inválido dentro de DECLARATIVE" - -#: cobc/parser.y:10052 -#, fuzzy -msgid "SECTION segment within DECLARATIVES" -msgstr "segmento SECTION inválido dentro de DECLARATIVE" - -#: cobc/parser.y:10240 cobc/parser.y:10375 -msgid "non-standard ACCEPT" -msgstr "ACCEPT não padronizado" - -#: cobc/parser.y:10252 -#, fuzzy -msgid "PROMPT clause" -msgstr "cláusulas LOCK" - -#: cobc/parser.y:10256 -msgid "SIZE IS clause" -msgstr "" - -#: cobc/parser.y:10471 cobc/parser.y:10763 -msgid "TIME-OUT or BEFORE TIME clauses" -msgstr "cláusulas TIME-OUT ou BEFORE TIME" - -#: cobc/parser.y:10497 cobc/parser.y:10513 cobc/parser.y:10528 -msgid "AT screen-location" -msgstr "AT screen-location" - -#: cobc/parser.y:10529 -msgid "LINE or COLUMN" -msgstr "LINE ou COLUMN" - -#: cobc/parser.y:10893 -msgid "ALLOCATE CHARACTERS requires RETURNING clause" -msgstr "ALLOCATE CHARACTERS requere cláusula RETURNING" - -#: cobc/parser.y:10908 cobc/parser.y:12168 -#, fuzzy, c-format -msgid "ignoring %s phrase" -msgstr "ignorando sinal" - -#: cobc/parser.y:10910 -msgid "addressing mode should be either 24 or 31 bit" -msgstr "" - -#: cobc/parser.y:10982 -#, fuzzy -msgid "recursive program call - assuming RECURSIVE attribute" -msgstr "chamada recursiva a um programa - assume-se o atributo RECURSIVE" - -#: cobc/parser.y:11001 -msgid "STATIC CALL convention ignored because of ON EXCEPTION" -msgstr "" - -#: cobc/parser.y:11010 -msgid "ON EXCEPTION ignored because of STATIC CALL" -msgstr "" - -#: cobc/parser.y:11111 cobc/typeck.c:12209 -#, fuzzy -msgid "invalid mnemonic name" -msgstr "nome mnemónico inválido" - -#: cobc/parser.y:11131 cobc/parser.y:11428 -msgid "CALL/CANCEL with program-prototype-name" -msgstr "CALL/CANCEL com nome-do-protótipo-do-programa (program-prototype-name)" - -#: cobc/parser.y:11135 -msgid "id/literal ignored, using prototype name" -msgstr "" - -#: cobc/parser.y:11141 -#, fuzzy -msgid "NESTED phrase is only valid with literal" -msgstr "EXIT PERFORM é apenas válido com PERFORM em linha (inline)" - -#: cobc/parser.y:11202 -#, fuzzy -msgid "OMITTED only allowed when arguments are passed BY REFERENCE" -msgstr "OMITTED apenas permitido quando os parâmetros são passados por referência (BY REFERENCE)" - -#: cobc/parser.y:11226 -#, fuzzy -msgid "invalid file name reference" -msgstr "referência de nome de ficheiro inválido" - -#: cobc/parser.y:11234 -#, fuzzy, c-format -msgid "BY CONTENT assumed for alphanumeric item '%s'" -msgstr "BY CONTENT assumido para item alfanumérico" - -#: cobc/parser.y:11239 -#, fuzzy, c-format -msgid "BY CONTENT assumed for national item '%s'" -msgstr "BY CONTENT assumido para item alfanumérico" - -#: cobc/parser.y:11302 -msgid "RETURNING item must have level 01 or 77" -msgstr "item RETURNING ten de ter o nível 01 ou 77" - -#: cobc/parser.y:11306 -#, fuzzy -msgid "RETURNING item must be a LINKAGE SECTION item or have BASED clause" -msgstr "item RETURNING tem de ser definido na LINKAGE SECTION ou ter uma cláusula BASED" - -#: cobc/parser.y:11340 cobc/parser.y:15972 cobc/parser.y:16027 -#: cobc/parser.y:16071 cobc/parser.y:16115 -msgid "NOT EXCEPTION before EXCEPTION" -msgstr "NOT EXCEPTION antes de EXCEPTION" - -#: cobc/parser.y:12041 -#, c-format -msgid "HANDLE must be a %s HANDLE" -msgstr "" - -#: cobc/parser.y:12053 -msgid "HANDLE must be a generic HANDLE" -msgstr "" - -#: cobc/parser.y:12130 -#, fuzzy, c-format -msgid "HANDLE clause invalid for %s" -msgstr "a cláusula %s é inválida para o ficheiro '%s'" - -#: cobc/parser.y:12361 cobc/parser.y:15495 -#, fuzzy, c-format -msgid "%s is invalid in nested program" -msgstr "%s é inválido em programas aninhados (programas contidos dentro de outros)" - -#: cobc/parser.y:12399 cobc/parser.y:12440 cobc/parser.y:12451 -#: cobc/parser.y:12462 -#, fuzzy, c-format -msgid "maximum evaluate depth exceeded (%d)" -msgstr "máxima profundidade para avaliação excedida (%d)" - -#: cobc/parser.y:12503 cobc/parser.y:12513 -msgid "WHEN without imperative statement" -msgstr "" - -#: cobc/parser.y:12531 cobc/parser.y:12541 -msgid "WHEN OTHER without imperative statement" -msgstr "" - -#: cobc/parser.y:12621 -#, fuzzy -msgid "invalid THROUGH usage" -msgstr "utilização inválida de THRU/THROUGH" - -#: cobc/parser.y:12700 -msgid "EXIT PROGRAM is not allowed within a USE GLOBAL procedure" -msgstr "EXIT PROGRAM não é permitido dentro de um procedimento com USE GLOBAL" - -#: cobc/parser.y:12704 -#, fuzzy -msgid "EXIT PROGRAM not allowed within a FUNCTION" -msgstr "EXIT PROGRAM não é permitido dentro duma função (FUNCTION)" - -#: cobc/parser.y:12713 cobc/parser.y:12926 -msgid "RETURNING/GIVING not allowed for non-returning runtime elements" -msgstr "" - -#: cobc/parser.y:12725 -msgid "EXIT FUNCTION is not allowed within a USE GLOBAL procedure" -msgstr "EXIT FUNCTION não é permitido dentro de um procedimiento com USE GLOBAL" - -#: cobc/parser.y:12729 -#, fuzzy -msgid "EXIT FUNCTION only allowed within a FUNCTION" -msgstr "EXIT FUNCTION apenas permitido dentro de uma função (FUNCTION)" - -#: cobc/parser.y:12743 cobc/parser.y:12766 -msgid "EXIT PERFORM is only valid with inline PERFORM" -msgstr "EXIT PERFORM é apenas válido com PERFORM em linha (inline)" - -#: cobc/parser.y:12788 -msgid "EXIT SECTION is only valid with an active SECTION" -msgstr "EXIT SECTION é apenas válido com uma secção (SECTION) activa" - -#: cobc/parser.y:12809 -msgid "EXIT PARAGRAPH is only valid with an active PARAGRAPH" -msgstr "EXIT PARAGRAPH é apenas válido com um parágrafo (PARAGRAPH) activo" - -#: cobc/parser.y:12956 -msgid "IF without imperative statement" -msgstr "" - -#: cobc/parser.y:13173 -#, fuzzy -msgid "TALLYING clause is incomplete" -msgstr "Cláusula TALLYING está incompleta" - -#: cobc/parser.y:13289 -msgid "INSPECT missing ALL/FIRST/LEADING/TRAILING" -msgstr "INSPECT sem ALL/FIRST/LEADING/TRAILING" - -#: cobc/parser.y:13407 -msgid "JSON PARSE" -msgstr "" - -#: cobc/parser.y:13552 -#, fuzzy -msgid "LOCK clauses" -msgstr "cláusulas LOCK" - -#: cobc/parser.y:13717 -msgid "inline PERFORM without imperative statement" -msgstr "" - -#: cobc/parser.y:13838 cobc/parser.y:13846 cobc/parser.y:13854 -#, c-format -msgid "PERFORM VARYING '%s' (line %d of %s) is not a numeric field" -msgstr "" - -#: cobc/parser.y:13870 -#, fuzzy -msgid "PERFORM VARYING without BY phrase" -msgstr "ODO (OCCURS DEPENDING ON) sem a frase TO" - -#: cobc/parser.y:13910 -#, fuzzy, c-format -msgid "'%s' is not an object-reference" -msgstr "'%s' não é um inteiro" - -#: cobc/parser.y:13951 cobc/typeck.c:10958 cobc/typeck.c:12100 -msgid "LOCK clause invalid with file LOCK AUTOMATIC" -msgstr "cláusula LOCK inválida com ficheiro definido com bloqueio automático (LOCK AUTOMATIC)" - -#: cobc/parser.y:13956 -msgid "KEY clause invalid with this file type" -msgstr "cláusula KEY inválida com este tipo de ficheiro" - -#: cobc/parser.y:13961 cobc/typeck.c:10954 cobc/typeck.c:12096 -msgid "INVALID KEY clause invalid with this file type" -msgstr "cláusula INVALID KEY inválida com este tipo de ficheiro" - -#: cobc/parser.y:14591 -#, fuzzy -msgid "file sort requires KEY phrase" -msgstr "ficheiro de ordenação (sort) requere a frase KEY" - -#: cobc/parser.y:14615 -#, fuzzy -msgid "table SORT requires KEY phrase" -msgstr "ficheiro de ordenação (sort) requere a frase KEY" - -#: cobc/parser.y:14677 -#, fuzzy -msgid "file sort requires USING or INPUT PROCEDURE" -msgstr "ficheiro de ordenação (sort) requere USING ou INPUT PROCEDURE" - -#: cobc/parser.y:14684 -msgid "USING invalid with table SORT" -msgstr "USING inválido com tabela de ordenação (SORT)" - -#: cobc/parser.y:14694 -msgid "INPUT PROCEDURE invalid with table SORT" -msgstr "INPUT PROCEDURE inválido com tabela de ordenação (SORT)" - -#: cobc/parser.y:14696 -msgid "INPUT PROCEDURE invalid with MERGE" -msgstr "INPUT PROCEDURE inválido com MERGE" - -#: cobc/parser.y:14709 -#, fuzzy -msgid "file sort requires GIVING or OUTPUT PROCEDURE" -msgstr "ficheiro de ordenação requere GIVING ou OUTPUT PROCEDURE" - -#: cobc/parser.y:14716 -msgid "GIVING invalid with table SORT" -msgstr "GIVING inválido com tabela de ordenação (SORT)" - -#: cobc/parser.y:14726 -msgid "OUTPUT PROCEDURE invalid with table SORT" -msgstr "OUTPUT PROCEDURE inválido com tabela de ordenação (SORT)" - -#: cobc/parser.y:14753 -msgid "SIZE/LENGTH invalid here" -msgstr "SIZE/LENGTH inválido aqui" - -#: cobc/parser.y:14806 -#, fuzzy -msgid "NOT EQUAL condition not allowed on START statement" -msgstr "condição NOT EQUAL não é permitida na instrução START" - -#: cobc/parser.y:14872 -#, fuzzy, c-format -msgid "%s is replaced by %s" -msgstr "%s é antiquad(o/a) (archaic) em %s" - -#: cobc/parser.y:14925 -msgid "STOP literal" -msgstr "" - -#: cobc/parser.y:14929 -#, fuzzy -msgid "STOP identifier" -msgstr "identificador PROMPT inválido" - -#: cobc/parser.y:15066 -msgid "SUPPRESS statement must be within DECLARATIVES" -msgstr "instrução SUPPRESS tem de ser definida nas declarativas (DECLARATIVES)" - -#: cobc/parser.y:15140 -msgid "UNLOCK invalid for SORT files" -msgstr "UNLOCK inválido para ficheiros de ordenação (SORT)" - -#: cobc/parser.y:15276 cobc/parser.y:15355 -msgid "USE statement must be within DECLARATIVES" -msgstr "instrução USE tem de estar definida nas declarativas (DECLARATIVES)" - -#: cobc/parser.y:15278 -msgid "SECTION header missing before USE statement" -msgstr "cabeçalho SECTION não foi definido antes da instrução USE" - -#: cobc/parser.y:15357 -msgid "USE DEBUGGING not supported in contained program" -msgstr "USE DEBUGGING não suportado em programa aninhado" - -#: cobc/parser.y:15405 cobc/parser.y:15414 cobc/parser.y:15432 -#: cobc/parser.y:15468 cobc/typeck.c:3792 -#, fuzzy, c-format -msgid "duplicate DEBUGGING target: '%s'" -msgstr "Diretiva DEFINE/SET inválida" - -#: cobc/parser.y:15430 -#, fuzzy -msgid "constant item cannot be used here" -msgstr "a constante não pode ser usada aqui - '%s'" - -#: cobc/parser.y:15456 -#, fuzzy -msgid "duplicate USE DEBUGGING ON ALL PROCEDURES" -msgstr "USE DEBUGGING ON ALL PROCEDURES duplicado" - -#: cobc/parser.y:15528 -#, fuzzy, c-format -msgid "'%s' is not a report group" -msgstr "'%s' não é um nome de um relatório (report)" - -#: cobc/parser.y:15710 -msgid "ENCODING clause must come before XML-DECLARATION" -msgstr "" - -#: cobc/parser.y:15712 -msgid "ENCODING clause must come before ATTRIBUTES" -msgstr "" - -#: cobc/parser.y:15715 -msgid "XML GENERATE ENCODING clause" -msgstr "" - -#: cobc/parser.y:15722 -msgid "XML-DECLARATION clause must come before ATTRIBUTES" -msgstr "" - -#: cobc/parser.y:15725 -msgid "XML GENERATE XML-DECLARATION clause" -msgstr "" - -#: cobc/parser.y:15731 -msgid "XML GENERATE WITH ATTRIBUTES clause" -msgstr "" - -#: cobc/parser.y:15744 -msgid "XML GENERATE NAMESPACE clause" -msgstr "" - -#: cobc/parser.y:15768 -msgid "XML GENERATE NAME OF clause" -msgstr "" - -#: cobc/parser.y:15799 -msgid "XML GENERATE TYPE OF clause" -msgstr "" - -#: cobc/parser.y:15840 -msgid "XML GENERATE SUPPRESS clause" -msgstr "" - -#: cobc/parser.y:15914 -msgid "XML PARSE" -msgstr "" - -#: cobc/parser.y:15955 cobc/parser.y:16633 cobc/parser.y:16729 -#: cobc/parser.y:16815 -#, c-format -msgid "'%s' is not a file name" -msgstr "'%s' não é um nome de um ficheiro" - -#: cobc/parser.y:16161 -msgid "NOT SIZE ERROR before SIZE ERROR" -msgstr "NOT SIZE ERROR antes de SIZE ERROR" - -#: cobc/parser.y:16207 -msgid "NOT OVERFLOW before OVERFLOW" -msgstr "NOT OVERFLOW antes de OVERFLOW" - -#: cobc/parser.y:16306 -msgid "NOT AT END-OF-PAGE before AT END-OF-PAGE" -msgstr "NOT AT END-OF-PAGE antes de AT END-OF-PAGE" - -#: cobc/parser.y:16356 -msgid "NOT INVALID KEY before INVALID KEY" -msgstr "NOT INVALID KEY antes de INVALID KEY" - -#: cobc/parser.y:16619 -msgid "LINAGE-COUNTER must be qualified here" -msgstr "LINAGE-COUNTER tem de ser qualificado aqui" - -#: cobc/parser.y:16622 -#, fuzzy -msgid "invalid LINAGE-COUNTER usage" -msgstr "modo de usar de LINAGE-COUNTER inválido" - -#: cobc/parser.y:16643 -msgid "LINE-COUNTER must be qualified here" -msgstr "LINE-COUNTER tem de ser qualificado aqui" - -#: cobc/parser.y:16647 -#, fuzzy -msgid "invalid LINE-COUNTER usage" -msgstr "modo de usar de LINE-COUNTER inválido" - -#: cobc/parser.y:16658 cobc/parser.y:16683 -#, c-format -msgid "'%s' is not a report name" -msgstr "'%s' não é um nome de um relatório (report)" - -#: cobc/parser.y:16668 -msgid "PAGE-COUNTER must be qualified here" -msgstr "PAGE-COUNTER tem de ser qualificado aqui" - -#: cobc/parser.y:16672 -#, fuzzy -msgid "invalid PAGE-COUNTER usage" -msgstr "modo de usar de PAGE-COUNTER inválido" - -#: cobc/parser.y:16719 cobc/typeck.c:10919 cobc/typeck.c:11004 -#: cobc/typeck.c:12064 -#, fuzzy, c-format -msgid "%s requires a record name as subject" -msgstr "%s requere um nome de registo (record) como assunto" - -#: cobc/parser.y:16746 -#, c-format -msgid "'%s' not indexed" -msgstr "'%s' não indexado" - -#: cobc/parser.y:16772 cobc/parser.y:16797 -#, fuzzy, c-format -msgid "multiple reference to '%s' " -msgstr "múltiplas referências a '%s' " - -#: cobc/parser.y:16827 -#, fuzzy, c-format -msgid "'%s' is not a CD name" -msgstr "'%s' não é um nome CD" - -#: cobc/parser.y:16841 -#, fuzzy, c-format -msgid "'%s' is not a valid report name" -msgstr "'%s' não é um nome de um relatório (report)" - -#: cobc/parser.y:17092 -#, fuzzy -msgid "invalid mnemonic identifier" -msgstr "identificador mnemónico inválido" - -#: cobc/parser.y:17172 -#, fuzzy -msgid "a numeric literal is expected here" -msgstr "é esperado um literal não numérico para '%s'" - -#: cobc/parser.y:17184 cobc/parser.y:17886 -#, fuzzy -msgid "a non-numeric literal is expected here" -msgstr "é esperado um literal não numérico para '%s'" - -#: cobc/parser.y:17357 cobc/typeck.c:6116 cobc/typeck.c:6123 -#, fuzzy, c-format -msgid "'%s' is not numeric" -msgstr "'%s' não é numérico" - -#: cobc/parser.y:17373 -#, fuzzy, c-format -msgid "'%s' is not a field or file" -msgstr "'%s' não é um campo (field) ou ficheiro (file)" - -#: cobc/parser.y:17393 cobc/parser.y:17411 -#, fuzzy, c-format -msgid "'%s' is not a field" -msgstr "'%s' não é um campo" - -#: cobc/parser.y:17533 -#, fuzzy, c-format -msgid "'%s' is not a field or alphabet" -msgstr "'%s' não é um campo (field) ou ficheiro (file)" - -#: cobc/parser.y:17559 -#, fuzzy -msgid "a subscripted data-item cannot be used here" -msgstr "'%s' não pode ser usad(o/a) aqui" - -#: cobc/parser.y:17609 -#, fuzzy -msgid "unsigned integer value expected" -msgstr "esperado valor inteiro positivo (sem sinal)" - -#: cobc/parser.y:17621 cobc/parser.y:17625 cobc/parser.y:17675 -#, fuzzy -msgid "integer value expected" -msgstr "esperado um valor inteiro" - -#: cobc/parser.y:17630 -#, fuzzy -msgid "invalid symbolic integer" -msgstr "inteiro simbólico inválido" - -#: cobc/parser.y:17646 cobc/parser.y:17650 -#, fuzzy -msgid "unsigned positive integer value expected" -msgstr "esperado valor inteiro positivo (sem sinal)" - -#: cobc/parser.y:17679 -#, fuzzy -msgid "invalid CLASS value" -msgstr "valor de CLASS inválido" - -#: cobc/parser.y:17767 -msgid "PHYSICAL argument for LENGTH functions" -msgstr "" - -#: cobc/parser.y:17938 cobc/parser.y:17955 -msgid "cannot specify offset and SYSTEM-OFFSET at the same time" -msgstr "Não é possível especificar o deslocamento (offset) e SYSTEM-OFFSET ao mesmo tempo" - -#: cobc/pplex.l:223 cobc/pplex.l:1739 -msgid "debugging indicator" -msgstr "" - -#: cobc/pplex.l:300 -#, fuzzy -msgid "ignoring empty directive" -msgstr "ignorando directiva vazia" - -#: cobc/pplex.l:310 cobc/pplex.l:369 -#, fuzzy, c-format -msgid "ignoring invalid directive: '%s'" -msgstr "ignorando directiva inválida: '%s'" - -#: cobc/pplex.l:317 -#, fuzzy -msgid "ignoring invalid directive" -msgstr "ignorando directiva inválida" - -#: cobc/pplex.l:324 -#, fuzzy -msgid "VCS directive" -msgstr "diretiva PAGE" - -#: cobc/pplex.l:377 cobc/pplex.l:392 -#, fuzzy -msgid "spurious '$' detected - ignored" -msgstr "detetados '$' falsos - ignorado" - -#: cobc/pplex.l:386 -#, fuzzy, c-format -msgid "ignoring unknown directive: '%s'" -msgstr "ignorando directiva inválida: '%s'" - -#: cobc/pplex.l:398 -msgid "PROCESS statement ignored" -msgstr "instrução PROCESS ignorada" - -#: cobc/pplex.l:864 -#, fuzzy -msgid "IF/ELIF/ELSE directive without matching END-IF" -msgstr "directiva IF/ELIF/ELSE sem o correspondente END-IF" - -#: cobc/pplex.l:981 -#, fuzzy -msgid "file was included here" -msgstr "o ficheiro de configuração foi incluído aqui" - -# @@@ CHECK TRANSLATION ??? -#: cobc/pplex.l:1186 -#, fuzzy, c-format -msgid "directive nest depth exceeded: %d" -msgstr "profundidade do nó diretivo excedido: %d" - -#: cobc/pplex.l:1204 -msgid "ELSE directive without matching IF/ELIF" -msgstr "directiva ELSE sem o(s) correspondente(s) IF/ELIF" - -#: cobc/pplex.l:1220 -msgid "END-IF directive without matching IF/ELIF/ELSE" -msgstr "directiva END-IF sem o(s) correspondente(s) IF/ELIF/ELSE" - -#: cobc/pplex.l:1236 -msgid "ELIF directive without matching IF/ELIF" -msgstr "directiva ELIF sem o(s) correspondente(s) IF/ELIF" - -#: cobc/pplex.l:1258 -#, fuzzy, c-format -msgid "invalid internal case: %u" -msgstr "situação interna inválida: %u" - -#: cobc/pplex.l:1395 -msgid "buffer overrun - too many continuation lines" -msgstr "ultrapassado o limite da memória de armazenamento temporário (buffer) - demasiadas linhas de continuação" - -#: cobc/pplex.l:1485 cobc/pplex.l:1494 -#, fuzzy -msgid "line not terminated by a newline" -msgstr "" -"linha não terminada por uma nova linha (newline)\n" -"e.g. ascii decimal 10" - -#: cobc/pplex.l:1488 cobc/pplex.l:1497 -#, c-format -msgid "source text exceeds %d bytes, will be truncated" -msgstr "o texto do programa fonte excede %d octetos (bytes), será truncado" - -#: cobc/pplex.l:1516 -msgid "version control conflict marker in file" -msgstr "" - -#: cobc/pplex.l:1727 -#, fuzzy -msgid "invalid continuation in comment entry" -msgstr "continuação inválida na entrada de comentário" - -#: cobc/pplex.l:1732 -msgid "continuation of COBOL words" -msgstr "continuação das palavras COBOL" - -#: cobc/pplex.l:1752 -#, fuzzy, c-format -msgid "invalid indicator '%c' at column 7" -msgstr "indicador '%c' inválido na coluna 7" - -#: cobc/pplex.l:1800 cobc/pplex.l:1811 -#, fuzzy -msgid "invalid line continuation" -msgstr "continuação de linha inválida" - -#: cobc/pplex.l:1819 -#, fuzzy -msgid "continuation character expected" -msgstr "caratere de continuação esperado" - -# @@@ CHECK TRANSLATION ??? -#: cobc/pplex.l:1885 -#, fuzzy, c-format -msgid "source text after program-text area (column %d)" -msgstr "código fonte após a área de instruções-de-programação (coluna %d)" - -# @@@ CHECK TRANSLATION ??? -#: cobc/ppparse.y:225 -#, fuzzy -msgid "directive comparison on different types" -msgstr "comparação de instruções em diferentes tipos" - -#: cobc/ppparse.y:293 -#, fuzzy, c-format -msgid "duplicate DEFINE directive '%s'" -msgstr "Diretiva DEFINE/SET inválida" - -#: cobc/ppparse.y:300 cobc/ppparse.y:310 -#, fuzzy -msgid "invalid constant in DEFINE directive" -msgstr "Diretiva DEFINE/SET inválida" - -#: cobc/ppparse.y:408 -#, c-format -msgid "compiler flag '%s' unknown" -msgstr "" - -#: cobc/ppparse.y:454 -#, fuzzy, c-format -msgid "invalid %s directive option '%s'" -msgstr "diretiva %s inválida" - -#: cobc/ppparse.y:667 -#, fuzzy -msgid "*CONTROL statement" -msgstr "segmento SECTION" - -#: cobc/ppparse.y:933 cobc/ppparse.y:1004 cobc/ppparse.y:1141 -#, fuzzy, c-format -msgid "invalid %s directive" -msgstr "diretiva %s inválida" - -#: cobc/ppparse.y:1043 -#, fuzzy -msgid "LEAP-SECOND ON directive" -msgstr "ignorando a directiva LEAP-SECOND" - -#: cobc/ppparse.y:1051 -msgid "TURN directive" -msgstr "diretiva TURN" - -#: cobc/ppparse.y:1133 cobc/ppparse.y:1158 -#, fuzzy -msgid "invalid constant" -msgstr "constante inválida" - -#: cobc/reserved.c:3797 -#, fuzzy -msgid "device name" -msgstr "nome do dispositivo" - -#: cobc/reserved.c:3800 -#, fuzzy -msgid "switch name" -msgstr "nome do comutador (switch)" - -#: cobc/reserved.c:3803 -#, fuzzy -msgid "feature name" -msgstr "nome da característica (feature)" - -#: cobc/reserved.c:3902 -#, fuzzy, c-format -msgid "reserved word must have less than %d characters" -msgstr "palavra reservada tem de ter menos de %d carateres" - -#: cobc/reserved.c:3921 -msgid "ignored asterisk at end of alias target" -msgstr "asterisco ignorado no fim do nome alternativo (alias) destino (target)" - -#: cobc/reserved.c:3984 -#, c-format -msgid "alias target '%s' is not a default reserved word" -msgstr "nome alternativo (alias) de destino (target) '%s' não é uma palavra reservada padrão" - -#: cobc/reserved.c:4447 -#, fuzzy, c-format -msgid "invalid system-name '%s'" -msgstr "nome-de-sistema inválido '%s'" - -#: cobc/reserved.c:4584 -#, fuzzy, c-format -msgid "'%s' is a reserved word, but isn't supported" -msgstr "'%s' é uma palavra reservada, mas não é suportada" - -#: cobc/reserved.c:4689 -#, fuzzy, c-format -msgid "intrinsic function %s is unknown" -msgstr "função intrínseca" - -#: cobc/reserved.c:4717 -#, fuzzy -msgid "Intrinsic Function" -msgstr "função intrínseca" - -#: cobc/reserved.c:4717 cobc/reserved.c:4897 cobc/reserved.c:5034 -#, fuzzy -msgid "Implemented" -msgstr "Implementad(o/a)" - -#: cobc/reserved.c:4717 cobc/typeck.c:1022 -msgid "Parameters" -msgstr "Parâmetros" - -#: cobc/reserved.c:4721 cobc/reserved.c:4901 cobc/reserved.c:5048 -#, fuzzy -msgid "Yes" -msgstr "Sim (Yes)" - -#: cobc/reserved.c:4724 cobc/reserved.c:4904 cobc/reserved.c:5054 -#, fuzzy -msgid "No" -msgstr "Não (No)" - -#: cobc/reserved.c:4730 -msgid "Unlimited" -msgstr "Sem limite" - -#: cobc/reserved.c:4804 -#, c-format -msgid "special register %s is unknown, needs a definition" -msgstr "" - -#: cobc/reserved.c:4810 -#, c-format -msgid "special register %s is unknown" -msgstr "" - -#: cobc/reserved.c:4897 -#, fuzzy -msgid "Internal registers" -msgstr "Registos internos suplementares (extra)" - -#: cobc/reserved.c:4897 -#, fuzzy -msgid "Definition" -msgstr "definição" - -#: cobc/reserved.c:4985 -#, fuzzy, c-format -msgid "unknown system-name '%s'" -msgstr "instrução desconhecida '%s'" - -#: cobc/reserved.c:5011 -#, fuzzy -msgid "System names" -msgstr "Rotina de sistema" - -#: cobc/reserved.c:5034 -msgid "Reserved Words" -msgstr "Palavras Reservadas" - -#: cobc/reserved.c:5046 -#, fuzzy -msgid "Yes (Context sensitive)" -msgstr "Sim (Yes) (sensível ao contexto)" - -#: cobc/reserved.c:5052 -#, fuzzy -msgid "No (Context sensitive)" -msgstr "Não (No) (sensível ao contexto)" - -#: cobc/reserved.c:5081 -msgid "Extra (obsolete) context sensitive words" -msgstr "Palavras suplementares (obsoletas) sensíveis ao contexto" - -#: cobc/scanner.l:265 cobc/scanner.l:2288 -#, fuzzy, c-format -msgid "'%s' is not a default reserved word, so cannot be aliased" -msgstr "'%s' não está definid(o/a), mas é uma palavra reservada noutro dialeto" - -#: cobc/scanner.l:268 -#, fuzzy, c-format -msgid "'%s' is not a reserved word; you may want ADDSYN or OVERRIDE instead" -msgstr "'%s' é uma palavra reservada, mas não é suportada" - -#: cobc/scanner.l:988 -#, fuzzy, c-format -msgid "a constant may not be used here - '%s'" -msgstr "a constante não pode ser usada aqui - '%s'" - -#: cobc/scanner.l:1043 -msgid "ignoring redundant ." -msgstr "ignorando o redundante." - -#: cobc/scanner.l:1101 -#, fuzzy, c-format -msgid "invalid symbol '%s' - skipping word" -msgstr "símbolo inválido '%s' - ignorando a palavra" - -#: cobc/scanner.l:1191 -#, fuzzy -msgid "invalid national literal" -msgstr "literal nacional inválido" - -#: cobc/scanner.l:1202 cobc/tree.c:2531 -#, fuzzy, c-format -msgid "invalid literal: '%s'" -msgstr "literal inválido: '%s'" - -#: cobc/scanner.l:1204 -#, fuzzy, c-format -msgid "invalid hexadecimal literal: '%s'" -msgstr "literal hexadecimal inválido: '%s'" - -#: cobc/scanner.l:1206 cobc/tree.c:1613 -#, fuzzy, c-format -msgid "invalid numeric literal: '%s'" -msgstr "literal numérico inválido: '%s'" - -#: cobc/scanner.l:1208 -#, fuzzy, c-format -msgid "invalid floating-point literal: '%s'" -msgstr "literal de ponto flutuante inválido" - -#: cobc/scanner.l:1210 -#, fuzzy, c-format -msgid "invalid %s literal: '%s'" -msgstr "literal %s inválido: '%s'" - -#: cobc/scanner.l:1261 -#, fuzzy, c-format -msgid "literal length exceeds %d characters" -msgstr "o comprimento do literal excede %d carateres" - -#: cobc/scanner.l:1277 cobc/scanner.l:1326 cobc/scanner.l:1620 -#, fuzzy -msgid "zero-length literal" -msgstr "literal numérico booleano" - -#: cobc/scanner.l:1280 -#, fuzzy -msgid "national literal has zero length; a SPACE will be assumed" -msgstr "o literal alfanumérico tem comprimento zero; um espaço (SPACE) será assumido" - -#: cobc/scanner.l:1281 -#, fuzzy -msgid "alphanumeric literal has zero length; a SPACE will be assumed" -msgstr "o literal alfanumérico tem comprimento zero; um espaço (SPACE) será assumido" - -#: cobc/scanner.l:1293 cobc/scanner.l:1294 cobc/scanner.l:1298 -#: cobc/scanner.l:1365 -#, fuzzy -msgid "national literal" -msgstr "literal nacional" - -#: cobc/scanner.l:1297 -#, fuzzy -msgid "national-character literal" -msgstr "literal nacional" - -#: cobc/scanner.l:1330 -#, fuzzy -msgid "hexadecimal literal has zero length; X'00' will be assumed" -msgstr "o literal alfanumérico tem comprimento zero; um espaço (SPACE) será assumido" - -#: cobc/scanner.l:1349 -#, fuzzy -msgid "hexadecimal-boolean literal" -msgstr "literal hexadecimal-booleano" - -#: cobc/scanner.l:1356 cobc/scanner.l:1370 cobc/scanner.l:1485 -#: cobc/scanner.l:1544 cobc/scanner.l:1642 cobc/scanner.l:1711 cobc/tree.c:2532 -#, fuzzy, c-format -msgid "literal length %d exceeds %d characters" -msgstr "o comprimento do literal %d excede %d carateres" - -#: cobc/scanner.l:1362 -#, fuzzy -msgid "hexadecimal-national literal" -msgstr "literal hexadecimal-nacional" - -#: cobc/scanner.l:1393 cobc/scanner.l:1425 cobc/scanner.l:1560 -#: cobc/scanner.l:1656 cobc/scanner.l:1721 -#, fuzzy, c-format -msgid "literal contains invalid character '%c'" -msgstr "o literal contém um caratere inválido '%c'" - -#: cobc/scanner.l:1449 -#, c-format -msgid "literal does not have an even number of digits" -msgstr "o literal não tem um número de dígitos par (even)" - -#: cobc/scanner.l:1492 -#, fuzzy, c-format -msgid "%s literals must contain at least one character" -msgstr "o literal contém um caratere inválido '%c'" - -#: cobc/scanner.l:1527 cobc/scanner.l:1628 cobc/scanner.l:1702 -#, fuzzy -msgid "ACUCOBOL numeric literal" -msgstr "literal numérico ACUCOBOL" - -#: cobc/scanner.l:1537 -#, fuzzy -msgid "H literals must contain at least one character" -msgstr "o literal contém um caratere inválido '%c'" - -#: cobc/scanner.l:1575 cobc/scanner.l:1667 cobc/scanner.l:1732 -#, fuzzy, c-format -msgid "literal exceeds limit %u" -msgstr "literal excede tamanho de datos" - -#: cobc/scanner.l:1616 -#, fuzzy -msgid "numeric boolean literal" -msgstr "literal numérico booleano" - -#: cobc/scanner.l:1622 -#, fuzzy -msgid "Boolean literal has zero length; B'0' will be assumed" -msgstr "o literal alfanumérico tem comprimento zero; um espaço (SPACE) será assumido" - -#: cobc/scanner.l:1698 -#, fuzzy -msgid "HP COBOL octal literal" -msgstr "literal numérico ACUCOBOL" - -#: cobc/scanner.l:1810 cobc/tree.c:1624 -#, fuzzy, c-format -msgid "literal length %d exceeds maximum of %d digits" -msgstr "o comprimento do literal %d excede o máximo de %d dígitos" - -#: cobc/scanner.l:1816 cobc/tree.c:1629 -#, fuzzy, c-format -msgid "literal length %d exceeds %d digits" -msgstr "o comprimento do literal %d excede %d dígitos" - -#: cobc/scanner.l:1928 cobc/tree.c:3513 -#, fuzzy, c-format -msgid "significand has more than %d digits" -msgstr "o significando (ou mantissa) tem mais de 34 dígitos" - -#: cobc/scanner.l:1933 -#, c-format -msgid "exponent has decimal point" -msgstr "o exponente tem um ponto decimal" - -#: cobc/scanner.l:1939 cobc/tree.c:3521 -#, c-format -msgid "exponent has more than 4 digits" -msgstr "o exponente tem mais de 4 dígitos" - -#: cobc/scanner.l:1969 -#, fuzzy, c-format -msgid "exponent not between -6143 and 6144" -msgstr "o exponente não se situa entre os valores -78 e 76" - -#: cobc/scanner.l:1978 -#, c-format -msgid "significand of 0 must be positive" -msgstr "o significando (ou mantissa) de 0 tem de ser positivo" - -#: cobc/scanner.l:1983 -#, c-format -msgid "exponent of 0 must be 0" -msgstr "o exponente de 0 tem de ser 0" - -#: cobc/scanner.l:1988 -#, c-format -msgid "exponent of 0 must be positive" -msgstr "o exponente de 0 tem de ser positivo" - -#: cobc/scanner.l:2170 -#, fuzzy, c-format -msgid "invalid CONSTANT: %s" -msgstr "constante (CONSTANT) inválida: %s" - -#: cobc/scanner.l:2180 -#, fuzzy, c-format -msgid "invalid alphanumeric CONSTANT: %s" -msgstr "constante (CONSTANT) alfanumérica inválida: %s" - -#: cobc/scanner.l:2184 -#, fuzzy, c-format -msgid "empty alphanumeric CONSTANT: %s" -msgstr "constante (CONSTANT) alfanumérica vazia: %s" - -#: cobc/scanner.l:2201 cobc/scanner.l:2209 cobc/scanner.l:2214 -#, fuzzy, c-format -msgid "invalid numeric CONSTANT: %s" -msgstr "constante (CONSTANT) numérica inválida: %s" - -#: cobc/scanner.l:2291 -#, c-format -msgid "'%s' is already reserved; you may want MAKESYN instead" -msgstr "" - -#: cobc/tree.c:341 -#, c-format -msgid "%s clause is required for file '%s'" -msgstr "cláusula %s é requerida para o ficheiro '%s'" - -#: cobc/tree.c:345 -#, fuzzy, c-format -msgid "%s clause is invalid for file '%s' (file type)" -msgstr "a cláusula %s é inválida para o ficheiro '%s' (tipo de ficheiro)" - -#: cobc/tree.c:349 -#, fuzzy, c-format -msgid "%s clause is invalid for file '%s'" -msgstr "a cláusula %s é inválida para o ficheiro '%s'" - -#: cobc/tree.c:376 -#, c-format -msgid "FOR item '%s' is a record" -msgstr "item FOR '%s' é um registo (record)" - -# @@@ CHECK TRANSLATION ??? -#: cobc/tree.c:385 -#, fuzzy, c-format -msgid "FOR item '%s' is in different record to '%s'" -msgstr "item FOR '%s' está num registo (record) diferente para '%s'" - -#: cobc/tree.c:394 -#, c-format -msgid "FOR item '%s' is not in a record associated with '%s'" -msgstr "item FOR '%s' não é um registo associado com '%s'" - -# @@@ CHECK TRANSLATION ??? -#: cobc/tree.c:477 -#, fuzzy -msgid "internal error node" -msgstr "nó de erro interno" - -#: cobc/tree.c:479 -#, fuzzy -msgid "unknown constant" -msgstr "constante desconhecida" - -#: cobc/tree.c:639 -#, fuzzy, c-format -msgid "FUNCTION %s has invalid/not supported arguments - tag %d" -msgstr "FUNCTION %s tem argumentos inválidos/não suportados - Identificador (Tag) %d" - -#: cobc/tree.c:760 -#, fuzzy, c-format -msgid "invalid date/time function: '%d'" -msgstr "função data/hora (date/time) inválida: '%d'" - -#: cobc/tree.c:798 -#, fuzzy, c-format -msgid "FUNCTION '%s' has invalid date/time format" -msgstr "FUNCTION '%s' tem o formato data/hora (date/time) inválido" - -# @@@ CHECK TRANSLATION ??? -#: cobc/tree.c:805 -#, fuzzy, c-format -msgid "FUNCTION '%s' has format in variable" -msgstr "FUNCTION '%s' tem formato na variável" - -#: cobc/tree.c:1186 -#, fuzzy, c-format -msgid "literal '%s'" -msgstr "literal inválido: '%s'" - -#: cobc/tree.c:1315 -#, fuzzy, c-format -msgid "unknown tree tag: %d, category: %d" -msgstr "marca/rótulo de árvore (tree tag) desconhecid(o/a): %d, categoria: %d" - -#: cobc/tree.c:1405 -#, fuzzy, c-format -msgid "unexpected numeric USAGE: %d" -msgstr "modo de usar (USAGE) numérico inesperado: %d" - -#: cobc/tree.c:1419 -#, fuzzy, c-format -msgid "unexpected category: %d" -msgstr "categoria inesperada: %d" - -#: cobc/tree.c:1678 cobc/tree.c:1690 cobc/tree.c:1752 cobc/tree.c:1802 -#, fuzzy, c-format -msgid "numeric literal '%s' exceeds limit '%s'" -msgstr "literal numérico '%s' excede o limite '%s'" - -#: cobc/tree.c:2387 -#, fuzzy -msgid "invalid LOCALE literal" -msgstr "literal LOCALE inválido" - -#: cobc/tree.c:2512 -#, fuzzy -msgid "only literals with the same category can be concatenated" -msgstr "só é possível concatenar literais da mesma categoria" - -# @@@ BAD ENGLISH - "alpanumeric" should be "alphanumeric" -#: cobc/tree.c:2519 -#, fuzzy -msgid "only alphanumeric, national or boolean literals may be concatenated" -msgstr "só é possível concatenar literais alfanuméricos, nacionais ou booleanos" - -#: cobc/tree.c:2791 -msgid "B, 0 or /" -msgstr "B, 0 ou /" - -#: cobc/tree.c:2805 -msgid "the sign of the floating-point exponent" -msgstr "o sinal do exponente do valor de ponto flutuante (floating-point)" - -#: cobc/tree.c:2807 -msgid "a leading +/- sign" -msgstr "um sinal dianteiro (leading) +/- (e.g. -123.45)" - -#: cobc/tree.c:2809 -msgid "a trailing +/- sign" -msgstr "um sinal traseiro (trailing) +/- (e.g. 123.45-" - -#: cobc/tree.c:2811 -msgid "CR or DB" -msgstr "CR ou DB" - -#: cobc/tree.c:2813 -msgid "a leading currency symbol" -msgstr "um símbolo monetário dianteiro (e.g. € 123.45)" - -#: cobc/tree.c:2815 -msgid "a trailing currency symbol" -msgstr "um símbolo monetário traseiro (e.g. 123.45 €)" - -#: cobc/tree.c:2817 -msgid "a Z or * which is before the decimal point" -msgstr "um Z ou * o qual se encontra antes do ponto decimal" - -#: cobc/tree.c:2819 -msgid "a Z or * which is after the decimal point" -msgstr "um Z ou * o qual se encontra depois do ponto decimal" - -#: cobc/tree.c:2821 -msgid "a floating +/- string which is before the decimal point" -msgstr "uma sequência (string) flutuante +/-, a qual se encontra antes do ponto decimal" - -#: cobc/tree.c:2823 -msgid "a floating +/- string which is after the decimal point" -msgstr "uma sequência (string) flutuante +/-, a qual se encontra depois do ponto decimal" - -#: cobc/tree.c:2825 -msgid "a floating currency symbol string which is before the decimal point" -msgstr "uma sequência (string) flutuante do símbolo monetário a qual se encontra antes do ponto decimal" - -#: cobc/tree.c:2827 -msgid "a floating currency symbol string which is after the decimal point" -msgstr "uma sequência (string) flutuante do símbolo monetário a qual se encontra depois do ponto decimal" - -#: cobc/tree.c:2831 -msgid "A or X" -msgstr "A ou X" - -#: cobc/tree.c:2837 -msgid "a P which is before the decimal point" -msgstr "um P que se encontra antes do ponto decimal" - -#: cobc/tree.c:2839 -msgid "a P which is after the decimal point" -msgstr "um P que se encontra depois do ponto decimal" - -#: cobc/tree.c:2860 cobc/tree.c:3267 -#, c-format -msgid "%s may only occur once in a PICTURE string" -msgstr "%s só pode ocorrer uma vez numa sequência (string) PICTURE" - -#: cobc/tree.c:2862 cobc/tree.c:3219 -#, fuzzy, c-format -msgid "%s cannot follow %s" -msgstr "%s não pode ser definida após %s" - -#: cobc/tree.c:2865 -#, fuzzy -msgid "invalid PICTURE string detected" -msgstr "detetada sequência (string) PICTURE inválida" - -#: cobc/tree.c:2976 -msgid "number or constant in parentheses is not an unsigned integer" -msgstr "número ou constante entre parêntesis não corresponde a um inteiro sem sinal" - -#: cobc/tree.c:2985 -msgid "only up to 9 significant digits are permitted within parentheses" -msgstr "apenas o máximo de 9 dígitos significativos são permitidos entre parêntesis" - -#: cobc/tree.c:2991 -msgid "number or constant in parentheses must be greater than zero" -msgstr "número ou constante entre parêntesis tem de ser maior que zero" - -#: cobc/tree.c:3002 -msgid "parentheses must be preceded by a picture symbol" -msgstr "" - -#: cobc/tree.c:3032 -msgid "unbalanced parentheses" -msgstr "parêntesis desequilibrados" - -#: cobc/tree.c:3040 -#, fuzzy -msgid "parentheses must contain an unsigned integer" -msgstr "parêntesis têm de conter (uma constante definida como) um inteiro positivo" - -#: cobc/tree.c:3078 -#, fuzzy, c-format -msgid "'%s' is not a constant-name" -msgstr "'%s' não é o nome de uma constante" - -#: cobc/tree.c:3085 -#, fuzzy, c-format -msgid "'%s' is not a numeric literal" -msgstr "'%s' não é um literal numérico" - -#: cobc/tree.c:3089 -#, fuzzy, c-format -msgid "'%s' is not an integer" -msgstr "'%s' não é um inteiro" - -#: cobc/tree.c:3093 -#, fuzzy, c-format -msgid "'%s' is not unsigned" -msgstr "'%s' não é 'sem-sinal' (unsigned)" - -#: cobc/tree.c:3149 -msgid "missing PICTURE string" -msgstr "falta a sequência (string) PICTURE" - -#: cobc/tree.c:3178 -msgid "C must be followed by R" -msgstr "C tem de ser seguido por R (tal como 'CR', não 'C R')" - -#: cobc/tree.c:3181 -msgid "D must be followed by B" -msgstr "D tem de ser seguido por B (tal como 'DB', não 'D B')" - -#: cobc/tree.c:3195 cobc/tree.c:3264 cobc/tree.c:3290 cobc/tree.c:3401 -#, fuzzy -msgid "uncommon parentheses" -msgstr "parêntesis desequilibrados" - -#: cobc/tree.c:3219 -msgid "exponent" -msgstr "" - -#: cobc/tree.c:3272 -msgid "S must be at start of PICTURE string" -msgstr "S tem de estar definido no início da sequência (string) PICTURE" - -#: cobc/tree.c:3328 -msgid "P must be at start or end of PICTURE string" -msgstr "P tem de estar definido no início ou no fim da sequência (string) PICTURE" - -#: cobc/tree.c:3358 -msgid "cannot have both Z and * in PICTURE string" -msgstr "não é possível ambos Z e * na sequência (string) PICTURE" - -#: cobc/tree.c:3436 -#, fuzzy, c-format -msgid "invalid PICTURE character '%c'" -msgstr "caratere '%c' inválido em PICTURE" - -#: cobc/tree.c:3466 -#, c-format -msgid "PICTURE string may not contain more than %d characters; contains %d characters" -msgstr "sequência (string) PICTURE não pode conter mais de %d carateres; contém %d carateres" - -#: cobc/tree.c:3471 -msgid "PICTURE string must contain at least one of the set A, N, X, Z, 1, 9 and *; or at least two of the set +, - and the currency symbol" -msgstr "sequência (string) PICTURE tem de conter pelo menos um do conjunto 'A,N,X,Z,1,9,*'; ou pelo menos dois do conjunto '+,-,símbolo monetário'" - -#: cobc/tree.c:3498 -#, fuzzy, c-format -msgid "numeric field cannot be larger than %d digits" -msgstr "campo numérico não pode exceder %d dígitos" - -#: cobc/tree.c:3954 cobc/tree.c:3967 -#, c-format -msgid "no DETAIL line defined in report %s" -msgstr "" - -#: cobc/tree.c:3969 -msgid "PAGE LIMIT FIRST DETAIL should be >= HEADING" -msgstr "" - -#: cobc/tree.c:3972 -msgid "PAGE LIMIT FOOTING should be >= HEADING" -msgstr "" - -#: cobc/tree.c:3974 -msgid "PAGE LIMIT LAST DETAIL should be >= FIRST DETAIL" -msgstr "" - -#: cobc/tree.c:3976 -msgid "PAGE LIMIT FOOTING should be >= LAST DETAIL" -msgstr "" - -#: cobc/tree.c:3978 -msgid "PAGE LIMIT LINES should be >= FOOTING" -msgstr "" - -#: cobc/tree.c:4162 -#, c-format -msgid "maximum keys (%d/%d) exceeded for file '%s'" -msgstr "" - -#: cobc/tree.c:4226 cobc/tree.c:4249 -#, fuzzy, c-format -msgid "invalid KEY item '%s', not in file '%s'" -msgstr "item KEY inválido '%s', não existe no ficheiro '%s'" - -#: cobc/tree.c:4260 -#, c-format -msgid "minimal record length %d can not hold the key item '%s'; needs to be at least %d" -msgstr "comprimento mínimo do registo %d não permite a chave '%s'; necessita ser pelo menos %d" - -#: cobc/tree.c:4296 -#, fuzzy, c-format -msgid "missing file description for %s" -msgstr "definições em falta:" - -#: cobc/tree.c:4328 -#, fuzzy, c-format -msgid "size of record '%s' (%d) smaller than minimum of file '%s' (%d)" -msgstr "comprimento do registo '%s' (%d) é menor que o mínimo exigido pelo ficheiro '%s' (%d)" - -#: cobc/tree.c:4331 cobc/tree.c:4348 -msgid "file size adjusted" -msgstr "" - -#: cobc/tree.c:4343 -#, fuzzy, c-format -msgid "size of record '%s' (%d) larger than maximum of file '%s' (%d)" -msgstr "comprimento do registo '%s' (%d) é maior que o máximo exigido pelo ficheiro '%s' (%d)" - -#: cobc/tree.c:4386 -#, c-format -msgid "file '%s': RECORD VARYING specified without limits, but implied limits are equal" -msgstr "" - -#: cobc/tree.c:4393 -#, fuzzy, c-format -msgid "file '%s': record size (IDX) %d exceeds maximum allowed (%d)" -msgstr "ficheiro '%s': comprimento do registo excede o máximo permitido (%d)" - -#: cobc/tree.c:4397 -#, fuzzy, c-format -msgid "file '%s': record size %d exceeds maximum allowed (%d)" -msgstr "ficheiro '%s': comprimento do registo excede o máximo permitido (%d)" - -#: cobc/tree.c:4404 -msgid "RECORD DELIMITER clause on file with fixed-length records" -msgstr "" - -#: cobc/tree.c:4965 -#, fuzzy, c-format -msgid "literal '%.38s' is longer than '%s'" -msgstr "o tamanho de '%s' é mais comprido que o tamanho de '%s'" - -#: cobc/tree.c:4969 -#, c-format -msgid "literal '%.38s' is longer than reference-modification of '%s'" -msgstr "" - -#: cobc/tree.c:4994 -#, c-format -msgid "literal '%s' is alphanumeric but '%s' is numeric" -msgstr "" - -#: cobc/tree.c:5036 -#, c-format -msgid "literal '%s' has more decimals than '%s'" -msgstr "" - -#: cobc/tree.c:5078 -#, c-format -msgid "literal '%s' has more digits than '%s'" -msgstr "" - -#: cobc/tree.c:5118 cobc/tree.c:5142 -#, fuzzy, c-format -msgid "unsigned '%s' may not be %s %s" -msgstr "o item THRU '%s' não pode ser subordinado a '%s'" - -#: cobc/tree.c:5128 cobc/tree.c:5151 -#, c-format -msgid "unsigned '%s' may always be %s %s" -msgstr "" - -#: cobc/tree.c:5184 cobc/tree.c:5209 -#, fuzzy, c-format -msgid "'%s' may not be %s %s" -msgstr "'%s' não pode ser usad(o/a) aqui" - -#: cobc/tree.c:5195 cobc/tree.c:5220 -#, c-format -msgid "'%s' may always be %s %s" -msgstr "" - -#: cobc/tree.c:5355 -#, fuzzy -msgid "divide by constant ZERO" -msgstr "constante inválida" - -#: cobc/tree.c:5404 cobc/tree.c:5409 cobc/tree.c:5630 cobc/tree.c:5670 -#: cobc/typeck.c:4476 cobc/typeck.c:4484 cobc/typeck.c:4491 cobc/typeck.c:5561 -#: cobc/typeck.c:5706 -#, fuzzy -msgid "invalid expression" -msgstr "expressão inválida" - -#: cobc/tree.c:5627 -#, fuzzy, c-format -msgid "invalid expression: %s %s %s" -msgstr "expressão inválida" - -#: cobc/tree.c:5675 -#, fuzzy, c-format -msgid "unexpected operator: %d" -msgstr "operador inesperado: %d" - -#: cobc/tree.c:5685 -#, c-format -msgid "expression '%.38s' %s '%.38s' is always TRUE" -msgstr "" - -#: cobc/tree.c:5691 -msgid "expression is always TRUE" -msgstr "" - -#: cobc/tree.c:5703 -#, c-format -msgid "expression '%.38s' %s '%.38s' is always FALSE" -msgstr "" - -#: cobc/tree.c:5709 -msgid "expression is always FALSE" -msgstr "" - -#: cobc/tree.c:6024 -msgid "PERFORM FOREVER since UNTIL is always FALSE" -msgstr "" - -#: cobc/tree.c:6028 -msgid "PERFORM ONCE since UNTIL is always TRUE" -msgstr "" - -#: cobc/tree.c:6031 -msgid "PERFORM NEVER since UNTIL is always TRUE" -msgstr "" - -#: cobc/tree.c:6132 -#, fuzzy, c-format -msgid "no definition/prototype seen for FUNCTION '%s'" -msgstr "não existe aparentemente definição/protótipo para o programa '%s'" - -#: cobc/tree.c:6134 -#, fuzzy, c-format -msgid "no definition/prototype seen for PROGRAM '%s'" -msgstr "não existe aparentemente definição/protótipo para o programa '%s'" - -#: cobc/tree.c:6143 -#, fuzzy, c-format -msgid "no definition/prototype seen for FUNCTION with external name '%s'" -msgstr "não existe aparentemente definição/protótipo para o programa '%s'" - -#: cobc/tree.c:6145 -#, fuzzy, c-format -msgid "no definition/prototype seen for PROGRAM with external name '%s'" -msgstr "não existe aparentemente definição/protótipo para o programa '%s'" - -#: cobc/tree.c:6237 -#, fuzzy, c-format -msgid "FUNCTION %s has invalid argument" -msgstr "FUNCTION '%s' tem parâmetro inválido" - -#: cobc/tree.c:6239 -#, c-format -msgid "either all arguments or none should be if type %s" -msgstr "" - -#: cobc/tree.c:6271 cobc/tree.c:6277 cobc/tree.c:6319 cobc/tree.c:6324 -#, c-format -msgid "FUNCTION '%s' has invalid reference modification" -msgstr "FUNCTION '%s' tem modificação de referência inválida" - -#: cobc/tree.c:6288 cobc/tree.c:6730 -#, c-format -msgid "FUNCTION '%s' unknown" -msgstr "FUNCTION '%s' desconhecida" - -#: cobc/tree.c:6292 -#, fuzzy, c-format -msgid "FUNCTION '%s' is not implemented" -msgstr "FUNCTION '%s' não está implementada" - -#: cobc/tree.c:6299 cobc/tree.c:6306 cobc/tree.c:6714 -#, c-format -msgid "FUNCTION '%s' has wrong number of arguments" -msgstr "FUNCTION '%s' tem um número incorreto de argumentos" - -#: cobc/tree.c:6313 -#, fuzzy, c-format -msgid "FUNCTION '%s' cannot have reference modification" -msgstr "FUNCTION '%s' não pode ter modificação da referencia" - -#: cobc/tree.c:6572 cobc/tree.c:6646 cobc/tree.c:6652 cobc/tree.c:6660 -#: cobc/tree.c:6668 -#, fuzzy, c-format -msgid "FUNCTION '%s' has invalid argument" -msgstr "FUNCTION '%s' tem parâmetro inválido" - -#: cobc/tree.c:6720 -#, fuzzy, c-format -msgid "FUNCTION '%s' has invalid first argument" -msgstr "FUNCTION '%s' tem o primeiro parâmetro inválido" - -#: cobc/typeck.c:686 -#, fuzzy, c-format -msgid "%s item not allowed here: '%s'" -msgstr "%s não é permitido aqui" - -#: cobc/typeck.c:728 -#, fuzzy, c-format -msgid "'%s' is not a group name" -msgstr "'%s' não é um nome de grupo" - -#: cobc/typeck.c:753 -#, c-format -msgid "'%s' is not a numeric name" -msgstr "'%s' não é um nome numérico" - -#: cobc/typeck.c:782 -#, fuzzy, c-format -msgid "'%s' is not a numeric or numeric-edited name" -msgstr "'%s' não é um nome numérico ou numérico-editado" - -#: cobc/typeck.c:835 -#, fuzzy, c-format -msgid "'%s' is Alpha, instead of a numeric value" -msgstr "'%s' não é um valor numérico" - -#: cobc/typeck.c:838 -#, fuzzy, c-format -msgid "'%s' is Alpha Edited, instead of a numeric value" -msgstr "'%s' não é um valor numérico" - -#: cobc/typeck.c:851 -#, c-format -msgid "'%s' is not a numeric value" -msgstr "'%s' não é um valor numérico" - -#: cobc/typeck.c:901 -#, c-format -msgid "'%s' is not an integer value" -msgstr "'%s' não é um valor inteiro" - -#: cobc/typeck.c:905 -#, fuzzy -msgid "positive numeric integer is required here" -msgstr "é requerido aqui um valor inteiro positivo" - -#: cobc/typeck.c:1022 -#, fuzzy -msgid "System routine" -msgstr "Rotina de sistema" - -#: cobc/typeck.c:1638 libcob/call.c:1069 -#, c-format -msgid "'%s' literal includes leading spaces which are omitted" -msgstr "o literal '%s' inclui espaços dianteiros os quais são omitidos (e.g. ' TESTE' -> 'TESTE')" - -#: cobc/typeck.c:1642 -#, c-format -msgid "'%s' literal includes trailing spaces which are omitted" -msgstr "o literal '%s' inclui espaços traseiros os quais são omitidos (e.g. 'TESTE ' -> 'TESTE')" - -#: cobc/typeck.c:1709 -msgid "ON/OFF usage requires a SWITCH name" -msgstr "o modo de usar de ON/OFF requere o nome de um comutador (SWITCH)" - -#: cobc/typeck.c:1727 -#, fuzzy, c-format -msgid "word length exceeds maximum of %d characters: '%s'" -msgstr "o comprimento da palavra excede o máximo de %d carateres: '%s'" - -#: cobc/typeck.c:1730 cobc/typeck.c:1733 -#, fuzzy, c-format -msgid "word length exceeds %d characters: '%s'" -msgstr "o comprimento da palavra excede %d carateres: '%s'" - -#: cobc/typeck.c:1810 -#, fuzzy, c-format -msgid "ASSIGN %s interpreted as '%s'" -msgstr "ASSIGN interpretado como %s" - -#: cobc/typeck.c:1900 cobc/typeck.c:2067 -#, fuzzy, c-format -msgid "subscript missing for '%s' - defaulting to 1" -msgstr "falta endereço (subscript) para '%s' - assumindo 1" - -#: cobc/typeck.c:1913 cobc/typeck.c:1992 -#, c-format -msgid "'%s' cannot be reference modified" -msgstr "'%s' não pode ser modificado por referência" - -#: cobc/typeck.c:1923 cobc/typeck.c:1988 cobc/typeck.c:2256 -#, c-format -msgid "'%s' cannot be subscripted" -msgstr "'%s' não pode endereçado (subscripted)" - -#: cobc/typeck.c:1927 cobc/typeck.c:2260 -#, fuzzy, c-format -msgid "'%s' requires one subscript" -msgstr "'%s' requere 1 endereço (vetor)" - -#: cobc/typeck.c:1930 cobc/typeck.c:2263 -#, c-format -msgid "'%s' requires %d subscripts" -msgstr "'%s; requiere %d endereços (matriz)" - -#. TRANSLATORS: This msgid is used when a variable name -#. or label is referenced in a compiler message. -#: cobc/typeck.c:1946 -#, c-format -msgid "'%s'" -msgstr "" - -#: cobc/typeck.c:1948 -#, c-format -msgid "'%s' (accessed by '%s')" -msgstr "'%s' (acedido por '%s')" - -#: cobc/typeck.c:2051 -#, c-format -msgid "'%s' has no OCCURS clause" -msgstr "'%s' não tem cláusula OCCURS" - -#: cobc/typeck.c:2108 libcob/common.c:3114 -#, fuzzy, c-format -msgid "subscript of '%s' out of bounds: %d" -msgstr "endereço de '%s' fora dos limites: %d" - -#: cobc/typeck.c:2162 cobc/typeck.c:2172 -#, fuzzy -msgid "offset must be greater than zero" -msgstr "número ou constante entre parêntesis tem de ser maior que zero" - -#: cobc/typeck.c:2167 cobc/typeck.c:2185 cobc/typeck.c:2204 -#, fuzzy -msgid "length must be greater than zero" -msgstr "número ou constante entre parêntesis tem de ser maior que zero" - -#: cobc/typeck.c:2175 cobc/typeck.c:2178 libcob/common.c:3136 -#, fuzzy, c-format -msgid "offset of '%s' out of bounds: %d" -msgstr "deslocamento (offset) de '%s' fora dos limites: %d" - -#: cobc/typeck.c:2189 cobc/typeck.c:2193 cobc/typeck.c:2207 cobc/typeck.c:2211 -#: libcob/common.c:3149 -#, fuzzy, c-format -msgid "length of '%s' out of bounds: %d" -msgstr "comprimento de '%s' fora dos limites: %d" - -#: cobc/typeck.c:2323 cobc/typeck.c:2407 -#, fuzzy -msgid "reference modification not allowed here" -msgstr "modificação da referência não é permitida aqui" - -#: cobc/typeck.c:2337 cobc/typeck.c:2433 -msgid "88 level item not allowed here" -msgstr "item de nível 88 não é permitido aqui" - -#: cobc/typeck.c:2342 -#, c-format -msgid "LENGTH OF '%s' not allowed outside of Procedure Division" -msgstr "" - -#: cobc/typeck.c:2346 cobc/typeck.c:2437 cobc/typeck.c:2445 cobc/typeck.c:2512 -#, fuzzy -msgid "variable length item not allowed here" -msgstr "item de comprimento variável não é permitido aqui" - -#: cobc/typeck.c:2375 -#, fuzzy, c-format -msgid "'%s' has not been DEFINEd" -msgstr "'%s' não existe nas declarativas (DECLARATIVES)" - -#: cobc/typeck.c:2411 -#, fuzzy -msgid "only field names allowed here" -msgstr "item de nível 88 não é permitido aqui" - -#: cobc/typeck.c:2422 -#, c-format -msgid "VALUE of '%s': %s target '%s' is invalid" -msgstr "" - -#: cobc/typeck.c:2424 cobc/typeck.c:2494 -#, fuzzy -msgid "target must be in FILE SECTION or LINKAGE SECTION or have the EXTERNAL clause" -msgstr "item RETURNING tem de ser definido na LINKAGE SECTION ou ter uma cláusula BASED" - -#: cobc/typeck.c:2480 cobc/typeck.c:2493 -#, fuzzy, c-format -msgid "VALUE of '%s': %s target is invalid" -msgstr "o destino de SET é inválido: '%s'" - -#: cobc/typeck.c:2482 -#, fuzzy -msgid "no previous data-item found" -msgstr "não existe previamente um item de dados de nível %02d" - -#: cobc/typeck.c:2667 -#, c-format -msgid "'%s' is not an alphabet name" -msgstr "'%s' não é um nome de alfabeto" - -#: cobc/typeck.c:2931 -#, fuzzy, c-format -msgid "duplicate character values in alphabet '%s': %s" -msgstr "valores de caracteres duplicados no alfabeto '%s': %s" - -#: cobc/typeck.c:2936 -#, fuzzy, c-format -msgid "invalid character values in alphabet '%s', starting at position %d" -msgstr "valores de carateres inválidos no alfabeto '%s', começando na posição %d" - -#: cobc/typeck.c:2990 -#, fuzzy -msgid "invalid ALPHABET name" -msgstr "nome de alfabeto (ALPHABET) inválido" - -#: cobc/typeck.c:3054 -#, fuzzy, c-format -msgid "duplicate character values in class '%s'" -msgstr "valores duplicados na classe '%s'" - -#: cobc/typeck.c:3072 -#, c-format -msgid "'%s' is not a locale name" -msgstr "'%s' não é um nome de local (locale)" - -#: cobc/typeck.c:3206 -#, fuzzy -msgid "invalid RECORD DEPENDING item" -msgstr "item RECORD DEPENDING inválido" - -#: cobc/typeck.c:3211 -msgid "RECORD DEPENDING must reference a data-item" -msgstr "RECORD DEPENDING tem de referenciar um item-de-dados" - -#: cobc/typeck.c:3234 -#, fuzzy, c-format -msgid "RECORD DEPENDING item '%s' should be defined in WORKING-STORAGE, LOCAL-STORAGE or LINKAGE SECTION" -msgstr "item RECORD DEPENDING '%s' deverá ser definido numa das seguintes secções: WORKING-STORAGE, LOCAL-STORAGE or LINKAGE" - -#: cobc/typeck.c:3247 -#, fuzzy, c-format -msgid "file %s: RELATIVE KEY %s is not numeric" -msgstr "valor na cláusula AT não é numérico" - -#: cobc/typeck.c:3256 -#, c-format -msgid "file %s: RELATIVE KEY %s must be integer" -msgstr "" - -#: cobc/typeck.c:3261 -#, c-format -msgid "file %s: RELATIVE KEY %s must be unsigned" -msgstr "" - -#: cobc/typeck.c:3268 -#, c-format -msgid "file %s: RELATIVE KEY %s cannot have OCCURS" -msgstr "" - -#: cobc/typeck.c:3274 -#, c-format -msgid "RELATIVE KEY %s cannot be in file record belonging to %s" -msgstr "" - -#: cobc/typeck.c:3283 -#, c-format -msgid "file %s: RELATIVE KEY %s declared outside WORKING-STORAGE" -msgstr "" - -#: cobc/typeck.c:3306 cobc/typeck.c:7184 -#, c-format -msgid "'%s' is not a valid data name" -msgstr "'%s' não é um nome de datos válido" - -#: cobc/typeck.c:3313 -#, fuzzy, c-format -msgid "CRT STATUS item '%s' should be defined in WORKING-STORAGE or LOCAL-STORAGE" -msgstr "item RECORD DEPENDING '%s' deverá ser definido numa das seguintes secções: WORKING-STORAGE, LOCAL-STORAGE or LINKAGE" - -#: cobc/typeck.c:3319 -#, fuzzy, c-format -msgid "'%s' CRT STATUS must have at least 4 digits" -msgstr "'%s' CRT STATUS tem de ter 4 carateres" - -#: cobc/typeck.c:3325 -#, fuzzy, c-format -msgid "'%s' CRT STATUS must be 4 characters long" -msgstr "'%s' CRT STATUS tem de ter 4 carateres" - -#: cobc/typeck.c:3341 -#, fuzzy, c-format -msgid "variable '%s' will be implicitly defined" -msgstr "'%s' será definido implicitamente" - -#: cobc/typeck.c:3375 cobc/typeck.c:3438 -msgid "ASSIGN variable" -msgstr "" - -#: cobc/typeck.c:3443 -#, fuzzy, c-format -msgid "ASSIGN data item '%s' is invalid" -msgstr "item de dados ASSIGN '%s' inválido" - -#: cobc/typeck.c:3507 -#, fuzzy, c-format -msgid "'%s' CURSOR must be 4 or 6 characters long" -msgstr "'%s' CURSOR tem de ter 4 ou 6 carateres" - -# @@@ BAD ENGLISH ??? -#: cobc/typeck.c:3557 cobc/typeck.c:3561 -#, fuzzy, c-format -msgid "%s does not have a fixed location" -msgstr "FUNCTION '%s' não tem um tempo de deslocamento (offset time)" - -#: cobc/typeck.c:3573 -#, fuzzy, c-format -msgid "'%s' cannot have nested OCCURS DEPENDING" -msgstr "'%s' não pode usar OCURRS DEPENDING" - -#: cobc/typeck.c:3587 -#, fuzzy, c-format -msgid "'%s' OCCURS DEPENDING ON field item invalid here" -msgstr "'%s' item de campo ODO (OCCURS DEPENDING ON) inválido aqui" - -#: cobc/typeck.c:3595 -#, fuzzy, c-format -msgid "'%s' cannot have OCCURS DEPENDING because of '%s'" -msgstr "'%s' não pode usar OCURRS DEPENDING" - -#: cobc/typeck.c:3607 -#, fuzzy, c-format -msgid "'%s' OCCURS DEPENDING ON item must have GLOBAL attribute" -msgstr "'%s' item ODO (OCCURS DEPENDING ON) tem de ter o atributo GLOBAL" - -#: cobc/typeck.c:3621 -#, c-format -msgid "PASSWORD '%s' for EXTERNAL file '%s' must have EXTERNAL attribute" -msgstr "" - -#: cobc/typeck.c:3644 -#, c-format -msgid "file %s: ASSIGN %s declared outside WORKING-STORAGE" -msgstr "" - -#: cobc/typeck.c:3674 -#, fuzzy, c-format -msgid "duplicate APPLY COMMIT target: '%s'" -msgstr "entrada de repositório (REPOSITORY entry) duplicada para '%s'" - -#: cobc/typeck.c:3688 -#, fuzzy -msgid "APPLY COMMIT statement invalid for SORT file" -msgstr "instrução USE inválida para o ficheiro de ordenação (SORT file)" - -#: cobc/typeck.c:3691 -#, fuzzy -msgid "APPLY COMMIT statement invalid for REPORT file" -msgstr "instrução USE inválida para o ficheiro de ordenação (SORT file)" - -#: cobc/typeck.c:3698 -#, fuzzy, c-format -msgid "APPLY COMMIT item '%s' should be defined in WORKING-STORAGE or LOCAL-STORAGE" -msgstr "item RECORD DEPENDING '%s' deverá ser definido numa das seguintes secções: WORKING-STORAGE, LOCAL-STORAGE or LINKAGE" - -#: cobc/typeck.c:3712 -#, fuzzy, c-format -msgid "item not allowed here: '%s'" -msgstr "%s não é permitido aqui" - -#: cobc/typeck.c:3725 -#, fuzzy, c-format -msgid "%s may not be subscripted" -msgstr "'%s' não pode endereçado (subscripted)" - -#: cobc/typeck.c:3729 -#, fuzzy, c-format -msgid "%s may not be reference modified" -msgstr "'%s' não pode ser modificado por referência" - -#: cobc/typeck.c:3789 -#, fuzzy, c-format -msgid "DEBUGGING target invalid: '%s'" -msgstr "destino para DEBUGGING inválido: '%s'" - -#: cobc/typeck.c:3795 -#, fuzzy, c-format -msgid "DEBUGGING target already specified with ALL PROCEDURES: '%s'" -msgstr "destino para DEBUGGING inválido com ALL PROCEDURES: '%s'" - -#: cobc/typeck.c:3815 -#, fuzzy -msgid "DEBUGGING target" -msgstr "destino para DEBUGGING inválido: '%s'" - -#: cobc/typeck.c:3822 -#, c-format -msgid "'%s' is not a valid DEBUGGING target" -msgstr "'%s' não é um destino válido para DEBUGGING" - -#: cobc/typeck.c:3860 cobc/typeck.c:3865 -#, c-format -msgid "'%s' is not in DECLARATIVES" -msgstr "'%s' não existe nas declarativas (DECLARATIVES)" - -#: cobc/typeck.c:3877 -#, fuzzy, c-format -msgid "invalid reference to '%s' (in DECLARATIVES)" -msgstr "referência inválida de '%s' (em DECLARATIVES)" - -#: cobc/typeck.c:3886 -#, fuzzy, c-format -msgid "'%s' is not a procedure name" -msgstr "'%s' não é o nome de um procedimento" - -#: cobc/typeck.c:3948 -#, c-format -msgid "LINKAGE item '%s' is not a PROCEDURE USING parameter" -msgstr "item '%s' em LINKAGE não é um parâmetro PROCEDURE USING" - -#: cobc/typeck.c:4001 -#, c-format -msgid "'%s' is not an alterable paragraph" -msgstr "'%s' não é um parágrafo alterável" - -#: cobc/typeck.c:4604 cobc/typeck.c:4608 -#, fuzzy, c-format -msgid "suggest parentheses around %s within %s" -msgstr "Parêntesis sugeridos em redor de AND dentro de OR" - -#: cobc/typeck.c:4616 -#, fuzzy -msgid "invalid conditional expression" -msgstr "expressão inválida" - -#: cobc/typeck.c:4726 -#, fuzzy, c-format -msgid "internal decimal structure size exceeded: %d" -msgstr "excedido o tamanho de estrutura decimal interna: %d" - -#: cobc/typeck.c:4729 -msgid "Try to minimize the number of parentheses or split into multiple computations." -msgstr "Tantar minimizar o número de parêntesis ou dividir em múltiplos cáculos/computações." - -#: cobc/typeck.c:4753 -#, c-format -msgid "more than %d nested expressions" -msgstr "" - -#: cobc/typeck.c:4795 -msgid "precision of result may change with arithmetic-osvs" -msgstr "" - -#: cobc/typeck.c:4851 -#, fuzzy, c-format -msgid "unexpected operation: %c (%d)" -msgstr "operação inesperada: %c (%d)" - -#: cobc/typeck.c:4856 -#, c-format -msgid "%s operator may be misplaced" -msgstr "" - -#: cobc/typeck.c:4926 -#, fuzzy -msgid "unexpected constant expansion" -msgstr "expansão de constante inesperada" - -#: cobc/typeck.c:5747 -#, c-format -msgid "more than %d nested conditions" -msgstr "" - -#: cobc/typeck.c:6104 cobc/typeck.c:6180 -#, fuzzy -msgid "no CORRESPONDING items found" -msgstr "não foram encontrados itens CORRESPONDING" - -#: cobc/typeck.c:6252 -msgid "no items to ACCEPT found" -msgstr "" - -#: cobc/typeck.c:6302 -#, fuzzy -msgid "no items to DISPLAY found" -msgstr "tipo inválido para operando de DISPLAY" - -#: cobc/typeck.c:6421 -msgid "cannot specify figurative constant ZERO in AT clause" -msgstr "não é possível especificar constante figurativa ZERO na cláusula AT" - -#: cobc/typeck.c:6425 -#, fuzzy -msgid "value in AT clause is not numeric" -msgstr "valor na cláusula AT não é numérico" - -#: cobc/typeck.c:6431 -#, fuzzy -msgid "value in AT clause must have 4 or 6 digits" -msgstr "valor na cláusula AT tem de ter 4 ou 6 dígitos" - -#: cobc/typeck.c:6553 -#, fuzzy -msgid "invalid PROMPT literal" -msgstr "literal PROMPT inválido" - -#: cobc/typeck.c:6558 -#, fuzzy -msgid "invalid PROMPT identifier" -msgstr "identificador PROMPT inválido" - -#: cobc/typeck.c:6848 -#, fuzzy, c-format -msgid "'%s' is not an input device" -msgstr "'%s' não é um dispositivo de entrada (input device)" - -#: cobc/typeck.c:6878 cobc/typeck.c:8016 -#, c-format -msgid "'%s' is not defined in SPECIAL-NAMES" -msgstr "'%s' não está definido em SPECIAL-NAMES" - -#: cobc/typeck.c:6883 -#, fuzzy, c-format -msgid "invalid input device '%s'" -msgstr "dispositivo de entrada '%s' inválido" - -#: cobc/typeck.c:6888 cobc/typeck.c:8020 -#, c-format -msgid "unknown device '%s'; it may exist in another dialect" -msgstr "dispositivo desconhecido '%s'; pode existir noutro dialeto" - -#: cobc/typeck.c:6891 cobc/typeck.c:8023 -#, fuzzy, c-format -msgid "unknown device '%s'; not defined in SPECIAL-NAMES" -msgstr "dispositivo desconhecido '%s'; não foi definido em SPECIAL-NAMES" - -#: cobc/typeck.c:6915 -#, fuzzy -msgid "target of ALLOCATE is not a BASED item" -msgstr "destino de ALLOCATE não é um item BASED" - -#: cobc/typeck.c:6926 -#, fuzzy -msgid "target of RETURNING is not a data pointer" -msgstr "destino de RETURNING não é um ponteiro de dados" - -#: cobc/typeck.c:6936 cobc/typeck.c:7342 -msgid "amount must be specified as a numeric expression" -msgstr "" - -#: cobc/typeck.c:6949 -msgid "INITIALIZED TO item is not alphanumeric" -msgstr "item INITIALIZED TO não é alfanumérico" - -#: cobc/typeck.c:7019 -#, fuzzy -msgid "only alphanumeric FUNCTION types are allowed here" -msgstr "apenas os tipos de função (FUNCTION) alfanuméricos são permitidos aqui" - -#: cobc/typeck.c:7027 -#, fuzzy -msgid "invalid RETURNING field" -msgstr "campo RETURNING inválido" - -#: cobc/typeck.c:7046 -msgid "STDCALL not available on this platform" -msgstr "STDCALL não está disponível nesta plataforma" - -#: cobc/typeck.c:7050 -msgid "STDCALL used on 64-bit Windows platform" -msgstr "STDCALL utilizado em plataforma Windows de 64-bits" - -#: cobc/typeck.c:7055 -msgid "STATIC CALL convention requires a literal program name" -msgstr "convenção STATIC CALL requere um literal no nome do programa" - -#: cobc/typeck.c:7060 cobc/typeck.c:10632 cobc/typeck.c:11539 -#: cobc/typeck.c:11903 -msgid "HANDLE must be either a generic or a THREAD HANDLE" -msgstr "" - -#: cobc/typeck.c:7078 -#, fuzzy -msgid "numeric literal is negative" -msgstr "literal numérico á negativo" - -#: cobc/typeck.c:7157 -#, fuzzy -msgid "numeric literal exceeds size limits" -msgstr "literal numérico excede os limites de tamanho" - -#: cobc/typeck.c:7175 -#, fuzzy, c-format -msgid "figurative constant %s invalid here" -msgstr "constante figurativa inválida aqui" - -#: cobc/typeck.c:7190 -#, c-format -msgid "'%s' ANY LENGTH item not passed BY REFERENCE" -msgstr "'%s' item ANY LENGTH não foi passado por referência (BY REFERENCE)" - -#: cobc/typeck.c:7198 -#, c-format -msgid "'%s' is not a 01 or 77 level item" -msgstr "'%s' não é um item de nível 01 ou 77" - -#: cobc/typeck.c:7228 cobc/typeck.c:7233 -#, fuzzy, c-format -msgid "wrong number of CALL parameters for '%s', %d given, %d expected" -msgstr "número incorreto de parâmetros em CALL para '%s'" - -#: cobc/typeck.c:7300 cobc/typeck.c:7374 cobc/typeck.c:7378 cobc/typeck.c:7382 -#: cobc/typeck.c:7412 cobc/typeck.c:10591 cobc/typeck.c:10755 -#: cobc/typeck.c:10944 cobc/typeck.c:10948 cobc/typeck.c:11844 -#: cobc/typeck.c:12087 cobc/typeck.c:12090 -#, fuzzy, c-format -msgid "%s not allowed on %s files" -msgstr "%s não permitida nos ficheiros %s" - -#: cobc/typeck.c:7336 -msgid "AFTER phrase in CONTINUE statement" -msgstr "" - -#: cobc/typeck.c:7478 -msgid "positions cannot be specified for main windows" -msgstr "" - -#: cobc/typeck.c:7488 cobc/typeck.c:7491 cobc/typeck.c:7508 -msgid "HANDLE must be either a generic or a WINDOW HANDLE or X(10)" -msgstr "" - -#: cobc/typeck.c:7617 -#, c-format -msgid "'%s' is an invalid type for DISPLAY operand" -msgstr "'%s' é um tipo inválido para o operando de DISPLAY" - -#: cobc/typeck.c:7622 -#, fuzzy -msgid "invalid type for DISPLAY operand" -msgstr "tipo inválido para operando de DISPLAY" - -#: cobc/typeck.c:7973 cobc/typeck.c:8006 -#, c-format -msgid "'%s' is not an output device" -msgstr "'%s' não é um dispositivo de salida" - -#: cobc/typeck.c:8109 -#, fuzzy -msgid "invalid use of 88 level in WHEN expression" -msgstr "utilização inválida do nivel 88 na expressão WHEN" - -#: cobc/typeck.c:8165 -#, fuzzy -msgid "wrong number of WHEN parameters" -msgstr "número incorreto de parâmetros em WHEN" - -#: cobc/typeck.c:8244 cobc/typeck.c:8256 -#, fuzzy, c-format -msgid "target %d of FREE is not a BASED data item" -msgstr "destino %d de FREE não é um item de datos BASED" - -#: cobc/typeck.c:8262 -#, fuzzy, c-format -msgid "target %d of FREE must be a data pointer" -msgstr "destino %d de FREE tem de ser um ponteiro de dados" - -#: cobc/typeck.c:8276 -#, fuzzy -msgid "GO TO without procedure-name" -msgstr "GO TO sem nome-de-procedimento" - -#: cobc/typeck.c:8286 -msgid "GO TO with multiple procedure-names" -msgstr "GO TO com múltiplos nomes-de-procedimentos" - -#: cobc/typeck.c:8308 -#, fuzzy -msgid "GO TO ENTRY with multiple entry-names" -msgstr "GO TO com múltiplos nomes-de-procedimentos" - -#: cobc/typeck.c:8367 -#, fuzzy -msgid "invalid INITIALIZE statement" -msgstr "instrução INITIALIZE inválida" - -#: cobc/typeck.c:8443 cobc/typeck.c:8446 -#, c-format -msgid "%s operands differ in size" -msgstr "operandos de %s diferem em tamanho" - -#: cobc/typeck.c:8476 -#, fuzzy, c-format -msgid "unexpected clause %d" -msgstr "cláusula inesperada %d" - -#: cobc/typeck.c:8545 cobc/typeck.c:8556 cobc/typeck.c:8567 cobc/typeck.c:8578 -#, fuzzy, c-format -msgid "data name expected before %s" -msgstr "nome de dados esperado antes de %s" - -#: cobc/typeck.c:8588 -#, c-format -msgid "ALL, LEADING or TRAILING expected before '%s'" -msgstr "esparado ALL, LEADING ou TRAILING antes de '%s'" - -#: cobc/typeck.c:8598 -#, fuzzy -msgid "operand has wrong size" -msgstr "operando tem o tamanho incorreto" - -#: cobc/typeck.c:8669 -#, fuzzy, c-format -msgid "internal register '%s' defined as BINARY-LONG" -msgstr "registo interno '%s' definido como BINARY-LONG" - -#: cobc/typeck.c:8672 cobc/typeck.c:8675 cobc/typeck.c:8678 cobc/typeck.c:8681 -#: cobc/typeck.c:8684 cobc/typeck.c:8687 cobc/typeck.c:8690 cobc/typeck.c:8693 -#: cobc/typeck.c:8696 -#, c-format -msgid "'%s' defined here as USAGE %s" -msgstr "'%s' definido aqui como USAGE %s" - -#: cobc/typeck.c:8699 -#, c-format -msgid "'%s' defined here as PIC %s" -msgstr "'%s' definido aqui como PIC %s" - -#: cobc/typeck.c:8702 -#, c-format -msgid "'%s' defined here as a group of length %d" -msgstr "'%s' definido aqui como um grupo de comprimento %d" - -#: cobc/typeck.c:8741 -#, c-format -msgid "value is %s" -msgstr "" - -#: cobc/typeck.c:8745 -#, fuzzy, c-format -msgid "value size is %d" -msgstr "tamanho do valor excede o tamanho de dados" - -#: cobc/typeck.c:9022 -#, fuzzy -msgid "invalid destination for MOVE" -msgstr "variável destino inválido para MOVE" - -#: cobc/typeck.c:9057 -#, fuzzy -msgid "MOVE of figurative constant SPACE to numeric item" -msgstr "constante figurativa inválida aqui" - -#: cobc/typeck.c:9072 -msgid "MOVE of figurative constant QUOTE to numeric item" -msgstr "" - -#: cobc/typeck.c:9077 cobc/typeck.c:9089 -#, fuzzy -msgid "MOVE of figurative constant to numeric item" -msgstr "constante figurativa inválida aqui" - -#: cobc/typeck.c:9151 -msgid "numeric literal in VALUE clause of numeric-edited item" -msgstr "" - -#: cobc/typeck.c:9176 -#, fuzzy -msgid "numeric move to ALPHABETIC" -msgstr "transferência (move) numérica para ALPHABETIC" - -#: cobc/typeck.c:9188 -#, fuzzy -msgid "data item not signed" -msgstr "item de dados não tem sinal" - -#: cobc/typeck.c:9191 -#, fuzzy -msgid "ignoring sign" -msgstr "ignorando sinal" - -#: cobc/typeck.c:9503 -#, fuzzy -msgid "overlapping MOVE may occur and produce unpredictable results" -msgstr "sobreposição de MOVE pode ocorrer e produzir resultados imprevisíveis" - -#: cobc/typeck.c:9510 -#, fuzzy -msgid "overlapping MOVE may produce unpredictable results" -msgstr "sobreposição de MOVE pode produzir resultados imprevisíveis" - -#: cobc/typeck.c:9643 -#, fuzzy -msgid "invalid source for MOVE" -msgstr "valor origem inválido para MOVE" - -#: cobc/typeck.c:9666 -#, fuzzy -msgid "source is non-numeric - substituting zero" -msgstr "valor origem não é numérico - substituindo por zero" - -#: cobc/typeck.c:9672 cobc/typeck.c:9683 -#, fuzzy -msgid "invalid VALUE clause" -msgstr "cláusula VALUE inválida" - -#: cobc/typeck.c:9675 cobc/typeck.c:11480 cobc/typeck.c:11485 -#: cobc/typeck.c:11512 cobc/typeck.c:11517 -#, fuzzy -msgid "invalid SET statement" -msgstr "instrução SET inválida" - -#: cobc/typeck.c:9677 -#, fuzzy -msgid "invalid MOVE statement" -msgstr "instrução MOVE inválida" - -#: cobc/typeck.c:9684 -#, fuzzy -msgid "literal exceeds data size" -msgstr "literal excede tamanho de datos" - -#: cobc/typeck.c:9688 -#, fuzzy -msgid "numeric literal exceeds data size" -msgstr "literal numérico excede tamanho de dados" - -#: cobc/typeck.c:9697 -#, fuzzy -msgid "MOVE of non-integer to alphanumeric" -msgstr "transferência (MOVE) de valor não-inteiro para alfanumérico" - -#: cobc/typeck.c:9703 -#, fuzzy -msgid "numeric value is expected" -msgstr "é esperado um valor numérico" - -#: cobc/typeck.c:9708 -#, fuzzy -msgid "alphanumeric value is expected" -msgstr "é esperado um valor alfanumérico" - -#: cobc/typeck.c:9713 -#, fuzzy -msgid "value does not fit the picture string" -msgstr "valor não se ajusta à PICTURE (string)" - -#: cobc/typeck.c:9719 -#, fuzzy -msgid "value size exceeds data size" -msgstr "tamanho do valor excede o tamanho de dados" - -#: cobc/typeck.c:9724 -#, fuzzy -msgid "sending field larger than receiving field" -msgstr "campo de envio é maior que o campo de receção" - -#: cobc/typeck.c:9729 -#, fuzzy -msgid "some digits may be truncated" -msgstr "alguns dígitos podem ser truncados" - -#: cobc/typeck.c:10515 -#, fuzzy, c-format -msgid "invalid MOVE target: %s" -msgstr "variável destino MOVE inválido: %s" - -#: cobc/typeck.c:10768 -msgid "READ PREVIOUS not allowed for this file type" -msgstr "READ PREVIOUS não é permitido para este tipo de ficheiro" - -#: cobc/typeck.c:10776 -msgid "KEY ignored with sequential READ" -msgstr "chave (KEY) ignorada com leitura (READ) sequencial" - -#: cobc/typeck.c:10872 -#, fuzzy -msgid "figurative constants not allowed in FROM clause" -msgstr "constante figurativa inválida aqui" - -#: cobc/typeck.c:10879 -msgid "literal in FROM clause must be alphanumeric, national or boolean" -msgstr "" - -#: cobc/typeck.c:10902 cobc/typeck.c:12047 -#, fuzzy, c-format -msgid "%s FILE requires a FROM clause" -msgstr "%s requere um nome de dados" - -#: cobc/typeck.c:10924 cobc/typeck.c:11010 cobc/typeck.c:12069 -#, fuzzy, c-format -msgid "%s subject does not refer to a record name" -msgstr "o assunto %s não se refere a um nome de registo" - -#: cobc/typeck.c:11016 -msgid "RELEASE not allowed on this record item" -msgstr "RELEASE não é permitido neste registo" - -#: cobc/typeck.c:11097 cobc/typeck.c:11118 cobc/typeck.c:11125 -#, fuzzy -msgid "invalid SEARCH ALL condition" -msgstr "condição SEARCH ALL inválida" - -#: cobc/typeck.c:11237 cobc/typeck.c:11241 -msgid "SET targets must be PROGRAM-POINTER" -msgstr "o destino de SET tem de ser um ponteiro para um programa (PROGRAM-POINTER)" - -#: cobc/typeck.c:11268 cobc/typeck.c:11335 cobc/typeck.c:11403 -#, c-format -msgid "cannot change address of '%s', which is not level 1 or 77" -msgstr "" - -#: cobc/typeck.c:11272 cobc/typeck.c:11339 cobc/typeck.c:11407 -#, c-format -msgid "cannot change address of '%s', which is not BASED or a LINKAGE item" -msgstr "" - -#: cobc/typeck.c:11291 -#, c-format -msgid "SET target '%s' is not numeric, an INDEX or a POINTER" -msgstr "" - -#: cobc/typeck.c:11360 -#, fuzzy, c-format -msgid "SET target '%s' is not a POINTER for FCD" -msgstr "o destino de SET tem de ser um ponteiro para um programa (PROGRAM-POINTER)" - -#: cobc/typeck.c:11428 -#, c-format -msgid "SET target '%s' is not a POINTER for FCD-KEYDEF" -msgstr "" - -#: cobc/typeck.c:11521 -#, fuzzy -msgid "field does not have a FALSE clause" -msgstr "campo não tem a cláusula FALSE" - -#: cobc/typeck.c:11552 -msgid "THREAD-priority must be between 1 and 32767" -msgstr "" - -#: cobc/typeck.c:11572 -msgid "SET ATTRIBUTE requires a screen item as subject" -msgstr "SET ATTRIBUTE requere um item de ecrã (screen) como objetivo" - -#: cobc/typeck.c:11578 -msgid "SET ATTRIBUTE subject does not refer to a screen item" -msgstr "um sujeito de SET ATTRIBUTE não se refere a um item de ecrã (screen)" - -#: cobc/typeck.c:11629 -#, fuzzy -msgid "invalid SORT filename" -msgstr "nome de ficheiro inválido em SORT" - -#: cobc/typeck.c:11689 -#, fuzzy -msgid "invalid SORT USING parameter" -msgstr "parâmetro inválido em SORT USING" - -#: cobc/typeck.c:11718 -#, fuzzy -msgid "invalid SORT GIVING parameter" -msgstr "parâmetro inválido em SORT GIVING" - -#: cobc/typeck.c:11772 cobc/typeck.c:11799 cobc/typeck.c:11819 -#, fuzzy -msgid "invalid key item" -msgstr "item chave (key) inválido" - -#: cobc/typeck.c:11849 -msgid "LENGTH/SIZE clause only allowed on INDEXED files" -msgstr "clásula LENGTH/SIZE só é permitida em ficheiros indexados (INDEXED)" - -#: cobc/typeck.c:11854 -msgid "START not allowed with ACCESS MODE RANDOM" -msgstr "START não é permitido com ACCESS MODE RANDOM" - -#: cobc/typeck.c:12103 -msgid "LOCK clause invalid here" -msgstr "cláusula LOCK inválida aqui" - -#: cobc/typeck.c:12365 -msgid "data item is not part of a report" -msgstr "" - -#: cobc/typeck.c:12385 -msgid "improper use of SUPPRESS PRINTING" -msgstr "" - -#: cobc/typeck.c:12400 -#, fuzzy, c-format -msgid "%s must be alphanumeric or national" -msgstr "'%s' não é um literal alfanumérico" - -#: cobc/typeck.c:12411 -#, c-format -msgid "%s may not be a figurative constant" -msgstr "" - -#: cobc/typeck.c:12438 -#, fuzzy, c-format -msgid "%s must be a child of the input record" -msgstr "'%s' e '%s' têm que estar definidos no mesmo registo" - -#: cobc/typeck.c:12464 -#, c-format -msgid "%s may not be an ignored item in JSON/XML GENERATE" -msgstr "" - -#: cobc/typeck.c:12475 -#, fuzzy, c-format -msgid "%s must be elementary" -msgstr "t(e/ê)m de ser numérico(s)" - -#: cobc/typeck.c:12487 -#, fuzzy, c-format -msgid "%s must be USAGE DISPLAY or NATIONAL" -msgstr "itens elementares com a cláusula SIGN têm de usar USAGE DISPLAY or NATIONAL" - -#: cobc/typeck.c:12501 -#, fuzzy, c-format -msgid "%s must be an integer" -msgstr "'%s' não é um inteiro" - -#: cobc/typeck.c:12517 cobc/typeck.c:12523 -msgid "JSON/XML GENERATE receiving item" -msgstr "" - -#: cobc/typeck.c:12520 -msgid "JSON/XML GENERATE receiving item may not have JUSTIFIED clause" -msgstr "" - -#: cobc/typeck.c:12608 -#, fuzzy -msgid "JSON/XML GENERATE input record may not be reference modified" -msgstr "'%s' não pode ser modificado por referência" - -#: cobc/typeck.c:12614 -msgid "JSON/XML GENERATE input record may not have RENAMES clause" -msgstr "" - -#: cobc/typeck.c:12619 -#, c-format -msgid "all the children of '%s' are ignored in JSON/XML GENERATE" -msgstr "" - -#: cobc/typeck.c:12626 -msgid "JSON/XML GENERATE input record has subrecords with non-unique names" -msgstr "" - -#: cobc/typeck.c:12631 -msgid "floating-point items in JSON/XML GENERATE" -msgstr "" - -#: cobc/typeck.c:12635 -msgid "OCCURS items in JSON/XML GENERATE" -msgstr "" - -#: cobc/typeck.c:12660 -msgid "COUNT IN item must be numeric and an integer" -msgstr "" - -#: cobc/typeck.c:12665 -msgid "COUNT IN item must be an integer" -msgstr "" - -#: cobc/typeck.c:12668 -msgid "COUNT IN item may not have PICTURE with P in it" -msgstr "" - -#: cobc/typeck.c:12711 -msgid "NAMESPACE must be a valid URI" -msgstr "" - -#: cobc/typeck.c:12755 -msgid "NAMESPACE-PREFIX must be a valid XML name" -msgstr "" - -#: cobc/typeck.c:12780 cobc/typeck.c:12787 -msgid "NAME OF item" -msgstr "" - -#: cobc/typeck.c:12784 -msgid "NAME OF item must be the input record or a child of it" -msgstr "" - -#: cobc/typeck.c:12791 -msgid "NAME OF name must be a valid XML name" -msgstr "" - -#: cobc/typeck.c:12817 cobc/typeck.c:12818 cobc/typeck.c:12821 -#: cobc/typeck.c:12825 -msgid "TYPE OF item" -msgstr "" - -#: cobc/typeck.c:12843 -msgid "SUPPRESS WHEN SPACE item" -msgstr "" - -#: cobc/typeck.c:12846 -msgid "SUPPRESS WHEN LOW-VALUE item" -msgstr "" - -#: cobc/typeck.c:12848 -msgid "SUPPRESS WHEN HIGH-VALUE item" -msgstr "" - -#: cobc/typeck.c:12877 cobc/typeck.c:12885 cobc/typeck.c:12889 -msgid "SUPPRESS item" -msgstr "" - -#: cobc/typeck.c:12881 -#, fuzzy -msgid "SUPPRESS item with WHEN clause" -msgstr "avisar item EXTERNAL com cláusula VALUE" - -#: cobc/typeck.c:12958 -msgid "WITH ATTRIBUTES specified, but no attributes can be generated" -msgstr "" - -#: cobc/warning.def:34 -#, fuzzy -msgid " -Wextra additional warnings only raised with -W or -Wall" -msgstr " -W habilita todos os avisos" - -#: cobc/warning.def:37 -#, fuzzy -msgid " -Wno-unfinished do not warn if unfinished features are used" -msgstr "não avisar se forem usadas características incompletas" - -#: cobc/warning.def:40 -#, fuzzy -msgid " -Wno-pending do not warn if pending features are mentioned" -msgstr "não avisar se forem usadas características incompletas" - -#: cobc/warning.def:43 -#, fuzzy -msgid " -Wobsolete warn if obsolete features are used" -msgstr "avisar se forem usadas características obsoletas" - -#: cobc/warning.def:46 -#, fuzzy -msgid " -Warchaic warn if archaic features are used" -msgstr "avisar se forem usadas características arcaicas" - -#: cobc/warning.def:49 -#, fuzzy -msgid " -Wredefinition warn about incompatible redefinition of data items" -msgstr "avisar sobre redefinição incompatível de itens de dados" - -#: cobc/warning.def:52 -msgid " -Wtruncate warn about field truncation from constant assignments" -msgstr "" - -#: cobc/warning.def:55 -#, fuzzy -msgid " -Wpossible-truncate warn about possible field truncation" -msgstr "avisar possível truncagem de um campo" - -#: cobc/warning.def:58 -#, fuzzy -msgid " -Woverlap warn about overlapping MOVE of items" -msgstr "avisar sobre itens MOVE sobrepostos" - -#: cobc/warning.def:61 -#, fuzzy -msgid " -Wpossible-overlap warn about MOVE of items that may overlap depending on variables" -msgstr "avisar sobre itens MOVE que se podem sobrepôr dependendo das variáveis" - -#: cobc/warning.def:64 -#, fuzzy -msgid " -Wparentheses warn about lack of parentheses around AND within OR" -msgstr "avisar falta de parêntesis ao redor de AND dentro de OR" - -#: cobc/warning.def:67 -msgid " -Wstrict-typing warn strictly about type mismatch" -msgstr "" - -#: cobc/warning.def:70 -#, fuzzy -msgid " -Wimplicit-define warn about implicitly defined data items" -msgstr "avisar implicitamente os itens de dados definidos" - -#: cobc/warning.def:73 -#, fuzzy -msgid " -Wcorresponding warn about CORRESPONDING with no matching items" -msgstr "avisar CORRESPONDING com itens sem correspondência" - -#: cobc/warning.def:76 -#, fuzzy -msgid " -Winitial-value warn if initial VALUE clause is ignored" -msgstr "cláusula inicial VALUE ignorada para o item EXTERNAL" - -#: cobc/warning.def:79 -#, fuzzy -msgid " -Wprototypes warn about missing FUNCTION prototypes/definitions" -msgstr "avisar a falta de protótipos/definições de funções" - -#: cobc/warning.def:82 -msgid " -Warithmetic-osvs warn if arithmetic expression precision has changed" -msgstr "" - -#: cobc/warning.def:85 -#, fuzzy -msgid " -Wcall-params warn about non 01/77 items for CALL parameters" -msgstr "avisar itens que não sejam do nível 01/77 para parâmetros CALL" - -#: cobc/warning.def:88 -msgid " -Wconstant-expression warn about expressions that always resolve to true/false" -msgstr "" - -#: cobc/warning.def:91 -#, fuzzy -msgid " -Wcolumn-overflow warn about text after program-text area, FIXED format" -msgstr "avisar sobre texto após a área de programação (tipicamente, coluna 72), formato fixo (FIXED)" - -#: cobc/warning.def:94 -#, fuzzy -msgid " -Wterminator warn about lack of scope terminator END-XXX" -msgstr "avisar sobre a falta do terminador de escopo END-XXX (e.g. IF [THEN] ... END-IF)" - -#: cobc/warning.def:97 -#, fuzzy -msgid " -Wlinkage warn about dangling LINKAGE items" -msgstr "avisar sobre itens LINKAGE pendentes" - -#: cobc/warning.def:100 -msgid " -Wunreachable warn about likely unreachable statements" -msgstr "" - -#: cobc/warning.def:103 -msgid " -Wno-dialect do not warn about dialect specific issues" -msgstr "" - -#: cobc/warning.def:106 -#, fuzzy -msgid " -Wothers do not warn about different issues" -msgstr " -W habilita todos os avisos" - -#: cobc/warning.def:109 -msgid " -Wno-unsupported do not warn if runtime does not support a feature used" -msgstr "" - -#: libcob/call.c:87 -#, c-format -msgid "LoadLibrary/GetProcAddress error %d" -msgstr "erro em LoadLibrary/GetProcAddress %d" - -#: libcob/call.c:939 -#, fuzzy -msgid "indeterminable error in resolve of COBOL CALL" -msgstr "Erro indeterminável na resolução da instrução CALL do COBOL" - -#: libcob/call.c:1022 -#, fuzzy, c-format -msgid "user-defined FUNCTION '%s' not found" -msgstr "não foi encontrada a função-definida-pelo-utilizador (UDF) '%s'" - -#: libcob/call.c:1129 libcob/call.c:1208 libcob/call.c:1326 libcob/call.c:1354 -#, c-format -msgid "NULL parameter passed to '%s'" -msgstr "parâmetro nulo (NULL parameter) passado para '%s'" - -#: libcob/call.c:1204 -#, fuzzy, c-format -msgid "invalid number of arguments passed to '%s'" -msgstr "número inválido de argumentos passados para '%s'" - -#: libcob/call.c:1330 -#, fuzzy -msgid "multiple call to 'cob_setjmp'" -msgstr "chamada (call) múltipla a 'cob_setjmp'" - -#: libcob/call.c:1358 -#, fuzzy -msgid "call to 'cob_longjmp' with no prior 'cob_setjmp'" -msgstr "chamada (call) a 'cob_longjmp' sem previamente ter chamado 'cob_setjmp'" - -#: libcob/call.c:1592 libcob/call.c:1633 libcob/call.c:1646 -#: libcob/common.c:7081 -msgid "cob_init() has not been called" -msgstr "'cob_init()' não foi chamado" - -#: libcob/call.c:1598 -#, c-format -msgid "parameter %d is not within range of %d" -msgstr "" - -#: libcob/call.c:1604 -#, fuzzy, c-format -msgid "parameter %d is NULL" -msgstr "parâmetros passados por valor (BY VALUE)" - -#: libcob/call.c:1859 libcob/call.c:1916 -#, c-format -msgid "attempt to over-write constant parameter %d with " -msgstr "" - -#: libcob/call.c:1965 -#, c-format -msgid "attempt to over-write constant parameter %d with '%s'" -msgstr "" - -#: libcob/cobgetopt.c:497 -#, fuzzy, c-format -msgid "%s: option '%s' is ambiguous; possibilities:" -msgstr "%s: a opção '%s' é ambigua; possibilidades:" - -#: libcob/cobgetopt.c:538 -#, fuzzy, c-format -msgid "%s: option '--%s' doesn't allow an argument" -msgstr "%s: opção '--%s' não permite um argumento" - -#: libcob/cobgetopt.c:545 -#, fuzzy, c-format -msgid "%s: option '%c%s' doesn't allow an argument" -msgstr "%s: opção '%c%s' não permite um argumento" - -#: libcob/cobgetopt.c:565 -#, fuzzy, c-format -msgid "%s: option '--%s' requires an argument" -msgstr "%s: opção '--%s' requere um argumento" - -#: libcob/cobgetopt.c:597 -#, fuzzy, c-format -msgid "%s: unrecognized option '--%s'" -msgstr "%s: opção não reconhecida '--%s'" - -#: libcob/cobgetopt.c:604 -#, fuzzy, c-format -msgid "%s: unrecognized option '%c%s'" -msgstr "%s: opção não reconhecida '%c%s'" - -#: libcob/cobgetopt.c:633 -#, fuzzy, c-format -msgid "%s: invalid option -- %c" -msgstr "%s: opção inválida -- %c" - -#: libcob/cobgetopt.c:664 libcob/cobgetopt.c:805 -#, fuzzy, c-format -msgid "%s: option requires an argument -- %c" -msgstr "%s: opção requere um argumento -- %c" - -#: libcob/cobgetopt.c:714 -#, fuzzy, c-format -msgid "%s: option '-W %s' is ambiguous" -msgstr "%s: opção '-W %s' é ambigua" - -#: libcob/cobgetopt.c:736 -#, fuzzy, c-format -msgid "%s: option '-W %s' doesn't allow an argument" -msgstr "%s: opção '-W %s' não permite um argumento" - -#: libcob/cobgetopt.c:754 -#, fuzzy, c-format -msgid "%s: option '%s' requires an argument" -msgstr "%s: opção '%s' requere um argumento" - -#: libcob/common.c:793 -#, fuzzy, c-format -msgid "attempt to reference unallocated memory" -msgstr "tentativa de referenciar memória não alocada" - -#: libcob/common.c:798 -#, fuzzy, c-format -msgid "bus error" -msgstr "erro: " - -#: libcob/common.c:803 -#, c-format -msgid "fatal arithmetic error" -msgstr "" - -#: libcob/common.c:807 -#, c-format -msgid "caught signal" -msgstr "sinal capturado" - -#: libcob/common.c:811 -#, c-format -msgid "signal %s" -msgstr "sinal %s" - -#: libcob/common.c:817 -#, fuzzy, c-format -msgid "abnormal termination - file contents may be incorrect" -msgstr "terminação anormal - conteúdo de ficheiro pode estar incorreto" - -#: libcob/common.c:2049 -msgid "NULL field" -msgstr "" - -#: libcob/common.c:2059 -msgid "field with NULL address" -msgstr "" - -#: libcob/common.c:2345 -#, fuzzy -msgid "version mismatch" -msgstr "erro: incompatibilidade de versão" - -#: libcob/common.c:2346 libcob/common.c:2348 -#, fuzzy, c-format -msgid "%s has version %s.%d" -msgstr "%s tem versão/nível do remendo (patch) %s/%d" - -#: libcob/common.c:2358 -#, fuzzy, c-format -msgid "CALL to %s requires %d arguments" -msgstr "chamada (CALL) a %s requere %d parâmetros" - -#: libcob/common.c:2980 -#, fuzzy, c-format -msgid "BASED/LINKAGE item %s has NULL address" -msgstr "item BASED/LINKAGE '%s' tem endereço nulo (NULL address)" - -#: libcob/common.c:2992 libcob/common.c:2995 -#, c-format -msgid "LINKAGE item %s not passed by caller" -msgstr "item LINKAGE %s não foi passado pelo programa chamador (caller)" - -#: libcob/common.c:3081 -#, fuzzy, c-format -msgid "'%s' (Type: %s) not numeric: '%s'" -msgstr "'%s' não é numérico: '%s'" - -#: libcob/common.c:3096 -#, c-format -msgid "OCCURS DEPENDING ON '%s' out of bounds: %d" -msgstr "OCCURS DEPENDING ON '%s' fora dos limites: %d" - -#: libcob/common.c:3099 libcob/common.c:3120 -#, fuzzy, c-format -msgid "maximum subscript for '%s': %d" -msgstr "endereço de '%s' fora dos limites: %d" - -#: libcob/common.c:3101 -#, fuzzy, c-format -msgid "minimum subscript for '%s': %d" -msgstr "endereço de '%s' fora dos limites: %d" - -#: libcob/common.c:3117 -#, c-format -msgid "current maximum subscript for '%s': %d" -msgstr "" - -#: libcob/common.c:3139 -#, fuzzy, c-format -msgid "offset of '%s' out of bounds: %d, maximum: %d" -msgstr "deslocamento (offset) de '%s' fora dos limites: %d" - -#: libcob/common.c:3152 -#, fuzzy, c-format -msgid "length of '%s' out of bounds: %d, maximum: %d" -msgstr "comprimento de '%s' fora dos limites: %d" - -#: libcob/common.c:3161 -#, fuzzy, c-format -msgid "length of '%s' out of bounds: %d, starting at: %d, maximum: %d" -msgstr "comprimento de '%s' fora dos limites: %d" - -#: libcob/common.c:3176 libcob/common.c:3181 -#, c-format -msgid "EXTERNAL item '%s' previously allocated with size %d, requested size is %d" -msgstr "item EXTERNAL '%s' previamente alocado com tamanho %d, comprimento pedido é %d" - -#: libcob/common.c:3682 -#, c-format -msgid "COB_CURRENT_DATE '%s' is invalid" -msgstr "" - -#: libcob/common.c:4585 -#, fuzzy, c-format -msgid "parameter to SYSTEM call is larger than %d characters" -msgstr "parâmetro para chamada SYSTEM é superior a %d carateres" - -#: libcob/common.c:5195 -#, fuzzy, c-format -msgid "error '%s' during CBL_GC_FORK" -msgstr "Erro '%s' durante CBL_GC_FORK" - -#: libcob/common.c:5200 libcob/common.c:5297 -#, fuzzy, c-format -msgid "'%s' is not supported on this platform" -msgstr "'%s' não é suportado nesta plataforma" - -#: libcob/common.c:5226 -#, c-format -msgid "error '%s' for P%d during CBL_GC_WAITPID" -msgstr "erro '%s' para P%d durante CBL_GC_WAITPID" - -#: libcob/common.c:5418 -msgid "Call to CBL_GC_GETOPT with wrong longoption size." -msgstr "Chamada a CBL_GC_GETOPT com o tamanho de opção longa (longoption) incorreto" - -#: libcob/common.c:5423 -msgid "Call to CBL_GC_GETOPT with missing longind." -msgstr "Chamada a CBL_GC_GETOPT com inexistente 'longind'" - -#: libcob/common.c:5837 libcob/common.c:5858 libcob/common.c:5871 -#: libcob/common.c:7785 -#, c-format -msgid "(default)" -msgstr "(padrão)" - -#: libcob/common.c:6119 libcob/common.c:6138 -msgid "should be unsigned" -msgstr "" - -#: libcob/common.c:6127 libcob/common.c:6176 -#, fuzzy -msgid "should be numeric" -msgstr "t(e/ê)m de ser numérico(s)" - -#: libcob/common.c:6185 -#, c-format -msgid "minimum value: %lu" -msgstr "valor mínimo: %lu" - -#: libcob/common.c:6236 libcob/common.c:6787 libcob/common.c:6801 -#, c-format -msgid "should not contain '%c'" -msgstr "não deveria conter '%c'" - -#: libcob/common.c:6316 libcob/common.c:6384 libcob/common.c:6393 -#: libcob/common.c:6401 -#, c-format -msgid "not set" -msgstr "" - -# @@@ CONTEXT ??? -#: libcob/common.c:6376 libcob/common.c:6379 libcob/common.c:6382 -#, fuzzy, c-format -msgid "set by %s" -msgstr "(set by %s)" - -#: libcob/common.c:6516 -#, c-format -msgid "WARNING - '%s' without a value - ignored!" -msgstr "AVISO - '%s' sem um valor - ignorado!" - -#: libcob/common.c:6519 -#, fuzzy, c-format -msgid "'%s' without a value!" -msgstr "'%s' sem um valor" - -#: libcob/common.c:6545 -#, c-format -msgid "WARNING - '%s %s' without a value - ignored!" -msgstr "AVISO - '%s %s' sem um valor - ignorado!" - -#: libcob/common.c:7034 -#, fuzzy -msgid "error" -msgstr "erro: " - -#: libcob/common.c:7064 -#, fuzzy -msgid "attempt to CANCEL active program" -msgstr "tentativa de cancelar (CANCEL) o programa ativo" - -#: libcob/common.c:7091 -msgid "CALL of program with CHAINING clause" -msgstr "" - -#: libcob/common.c:7095 -#, fuzzy -msgid "stack overflow, possible PERFORM depth exceeded" -msgstr "o limite da pilha de memória foi ultrapassado, possível profundidade de PERFORM excedida" - -#: libcob/common.c:7100 -#, fuzzy -msgid "invalid entry/exit in GLOBAL USE procedure" -msgstr "entrada/saída (entry/exit) inválida em procedimento GLOBAL USE" - -#: libcob/common.c:7105 -#, fuzzy -msgid "unable to allocate memory" -msgstr "incapacidade de alocar memória" - -#: libcob/common.c:7110 -#, fuzzy -msgid "invalid entry into module" -msgstr "entrada (entry) inválida no módulo" - -#: libcob/common.c:7115 -#, c-format -msgid "recursive CALL from %s to %s which is NOT RECURSIVE" -msgstr "" - -#: libcob/common.c:7125 -#, fuzzy -msgid "divide by ZERO" -msgstr "constante inválida" - -#: libcob/common.c:7132 -#, fuzzy -msgid "end of file" -msgstr "fim de ficheiro" - -#: libcob/common.c:7135 -#, fuzzy -msgid "key out of range" -msgstr "chave fora de alcance" - -#: libcob/common.c:7138 -#, fuzzy -msgid "key order not ascending" -msgstr "a ordem da chave não é ascendente (ascending)" - -#: libcob/common.c:7141 -#, fuzzy -msgid "record key already exists" -msgstr "a chave do registo já existe" - -#: libcob/common.c:7144 -#, fuzzy -msgid "record key does not exist" -msgstr "a chave do registo não existe" - -#: libcob/common.c:7147 -#, fuzzy -msgid "permanent file error" -msgstr "erro de ficheiro permanente" - -#: libcob/common.c:7150 -#, fuzzy -msgid "inconsistant file name" -msgstr "nome do ficheiro de configuração inválido" - -#: libcob/common.c:7153 -#, fuzzy -msgid "file does not exist" -msgstr "o ficheiro não existe" - -#: libcob/common.c:7156 -#, fuzzy -msgid "permission denied" -msgstr "permissão negada" - -#: libcob/common.c:7159 -#, fuzzy -msgid "file already open" -msgstr "ficheiro já aberto" - -#: libcob/common.c:7162 -#, fuzzy -msgid "file not open" -msgstr "ficheiro não aberto" - -#: libcob/common.c:7165 -msgid "READ must be executed first" -msgstr "READ tem de ser executado primeiro" - -#: libcob/common.c:7168 -#, fuzzy -msgid "record overflow" -msgstr "transbordo de registro" - -# @@@ BAD ENGLISH - "uncessful" should be "unsuccessful" -#: libcob/common.c:7171 -#, fuzzy -msgid "READ after unsuccessful READ/START" -msgstr "READ após READ/START mal sucedido" - -#: libcob/common.c:7174 -#, fuzzy -msgid "READ/START not allowed, file not open for input" -msgstr "READ/START não permitido, o ficheiro não está aberto para leitura (input)" - -#: libcob/common.c:7177 -msgid "WRITE not allowed, file not open for output" -msgstr "WRITE não permitido, o ficheiro não está aberto para escrita (output)" - -#: libcob/common.c:7180 -#, fuzzy -msgid "DELETE/REWRITE not allowed, file not open for I-O" -msgstr "DELETE/REWRITE não permitido, o ficheiro não está aberto para E/S (I/O)" - -#: libcob/common.c:7183 -#, fuzzy -msgid "record locked by another file connector" -msgstr "registo bloqueado por outro utilizador ou processo" - -#: libcob/common.c:7186 -msgid "LINAGE values invalid" -msgstr "valores LINAGE inválidos" - -#: libcob/common.c:7189 -#, fuzzy -msgid "file sharing conflict" -msgstr "conflicto em partilha de ficheiro" - -#: libcob/common.c:7193 -#, fuzzy -msgid "runtime library is not configured for this operation" -msgstr "biblioteca de execução (runtime library) não está configurada para esta operação" - -#: libcob/common.c:7198 -#, fuzzy -msgid "unknown file error" -msgstr "erro de ficheiro desconhecido" - -#: libcob/common.c:7205 -#, fuzzy, c-format -msgid "%s (status = %02d) for file %s" -msgstr "%s (status = %02d) ficheiro : '%s'" - -#: libcob/common.c:7208 -#, fuzzy, c-format -msgid "%s (status = %02d) for file %s on %s" -msgstr "%s (status = %02d) ficheiro : '%s'" - -#: libcob/common.c:7215 -#, fuzzy -msgid "attempt to use non-implemented function" -msgstr "tentativa de utilização de função não implementada" - -#: libcob/common.c:7218 -#, fuzzy -msgid "attempt to use non-implemented XML I/O" -msgstr "tentativa de utilização de função não implementada" - -#: libcob/common.c:7221 -#, fuzzy -msgid "attempt to use non-implemented JSON I/O" -msgstr "tentativa de utilização de função não implementada" - -#: libcob/common.c:7268 -msgid "environment variables" -msgstr "variáveis de ambiente" - -#: libcob/common.c:7315 -msgid "License LGPLv3+: GNU LGPL version 3 or later " -msgstr "Licença LGPLv3+: GNU LGPL versão 3 ou posterior " - -#: libcob/common.c:7372 libcob/common.c:7374 -#, fuzzy -msgid "dynamic loading" -msgstr "Carregamento dinâmico" - -#: libcob/common.c:7379 -#, fuzzy -msgid "enabled" -msgstr "ativad(o/a)" - -#: libcob/common.c:7460 libcob/common.c:7577 libcob/common.c:7586 -#: libcob/common.c:7603 libcob/common.c:7618 -#, fuzzy, c-format -msgid "%s, version %d.%d.%d" -msgstr "Versão de 'C': %s%s" - -#: libcob/common.c:7462 libcob/common.c:7579 libcob/common.c:7588 -#: libcob/common.c:7620 -#, c-format -msgid "%s, version %d.%d.%d (compiled with %d.%d)" -msgstr "" - -#: libcob/common.c:7465 -#, fuzzy, c-format -msgid "%s, version %s" -msgstr "Versão de 'C': %s%s" - -#: libcob/common.c:7486 libcob/common.c:7488 libcob/common.c:7493 -#: libcob/common.c:7495 libcob/common.c:7498 -#, fuzzy -msgid "mouse support" -msgstr "" - -#: libcob/common.c:7636 -msgid "CALL configuration" -msgstr "configuração CALL" - -#: libcob/common.c:7637 -msgid "File I/O configuration" -msgstr "Configuração E/S (I/O) de ficheiro (file)" - -#: libcob/common.c:7638 -msgid "Screen I/O configuration" -msgstr "configuração E/S (I/O) de ecrã (screen)" - -#: libcob/common.c:7639 -msgid "Miscellaneous" -msgstr "Diversos" - -#: libcob/common.c:7640 -msgid "System configuration" -msgstr "Configuração de sistema" - -#: libcob/common.c:7644 -#, fuzzy -msgid "runtime configuration" -msgstr "configuração do programa de execução (runtime)" - -#: libcob/common.c:7646 -msgid "via" -msgstr "via" - -#: libcob/common.c:7719 libcob/common.c:7747 -msgid "... removed from environment" -msgstr "... removido do ambiente" - -# @@@ CONTEXT ??? -#: libcob/common.c:7773 libcob/common.c:7775 -#, fuzzy, c-format -msgid "(set by %s)" -msgstr "(set by %s)" - -# @@@ CONTEXT ??? -#: libcob/common.c:7783 -#, fuzzy, c-format -msgid "(reset)" -msgstr "(reset)" - -#: libcob/common.c:8167 libcob/common.c:8286 -#, c-format -msgid "%s called with unknown option: %d" -msgstr "" - -#: libcob/common.c:8239 -#, c-format -msgid "Module dump due to %s\n" -msgstr "" - -#: libcob/common.c:8243 -#, fuzzy, c-format -msgid " Last statement of %s was Line %d of %s\n" -msgstr "instrução %s não terminada por END-%s" - -#: libcob/common.c:8249 -#, c-format -msgid " Last statement of %s unknown\n" -msgstr "" - -#: libcob/common.c:8259 -#, c-format -msgid "Dump Program-Id %s from %s compiled %s\n" -msgstr "" - -#: libcob/fileio.c:287 -#, c-format -msgid "ERROR I/O routine %s is not present" -msgstr "" - -#: libcob/fileio.c:1365 -#, c-format -msgid "I/O routine %s is not present for %s" -msgstr "" - -#: libcob/fileio.c:1404 -#, c-format -msgid "I/O routine %s is not known for %s" -msgstr "" - -#: libcob/fileio.c:2599 -#, c-format -msgid "ERROR FILE %s has record size %d exceeds %d in program" -msgstr "" - -#: libcob/fileio.c:2967 libcob/fileio.c:2974 -#, c-format -msgid "ERROR FILE %s opening pipe" -msgstr "" - -#: libcob/fileio.c:4979 -#, c-format -msgid "ERROR FILE %s does not match current version; Recompile the program" -msgstr "" - -#: libcob/fileio.c:5034 -#, c-format -msgid "ERROR FILE %s has ASSIGN field is NULL" -msgstr "" - -#: libcob/fileio.c:5707 -#, c-format -msgid "call to CBL_OPEN_FILE with wrong access mode: %d" -msgstr "chamada (all) a CBL_OPEN_FILE com modo de acesso incorreto: %d" - -#: libcob/fileio.c:5756 -#, c-format -msgid "call to CBL_CREATE_FILE with wrong file_lock: %d" -msgstr "chamada (call) a CBL_CREATE_FILE com 'file_lock' incorreto: %d" - -#: libcob/fileio.c:5759 -#, c-format -msgid "call to CBL_CREATE_FILE with wrong file_dev: %d" -msgstr "chamada (call) a CBL_CREATE_FILE com 'file_dev' incorreto: %d" - -#: libcob/fileio.c:5955 libcob/fileio.c:6215 -#, c-format -msgid "'%s' - File detail area is too short" -msgstr "'%s' - área de detalhe de ficheiro é demasiado curta" - -#: libcob/fileio.c:6437 -msgid "SORT is unable to acquire temporary file" -msgstr "SORT é incapaz de obter ficheiro temporário" - -#: libcob/fileio.c:7057 -#, fuzzy, c-format -msgid "implicit CLOSE of %s" -msgstr "CLOSE implícito de %s ('%s')" - -#: libcob/fileio.c:7165 -#, c-format -msgid "C-ISAM library %s is not present" -msgstr "" - -#: libcob/fileio.c:7173 -#, c-format -msgid "D-ISAM library %s is not present" -msgstr "" - -#: libcob/fileio.c:7181 -#, c-format -msgid "VB-ISAM library %s is not present" -msgstr "" - -#: libcob/screenio.c:429 -#, fuzzy -msgid "failed to initialize curses" -msgstr "falha a inicializar 'curses'" - -#: libcob/screenio.c:3591 -msgid "end of program, please press a key to exit" -msgstr "" - -#: libcob/termio.c:70 libcob/termio.c:106 -msgid "(Not representable)" -msgstr "(Não representável)" - -#: libcob/termio.c:347 -#, fuzzy, c-format -msgid "cannot open %s (=%s)" -msgstr "não é possível especificar ambos '%s' e '%s'" - -#: libcob/termio.c:362 -msgid "COB_DISPLAY_PUNCH_FILE is invalid, output to SYSPUNCH skipped" -msgstr "" - -#: bin/cobcrun.c:122 -msgid "GnuCOBOL module loader" -msgstr "" - -#: bin/cobcrun.c:124 -#, fuzzy, c-format -msgid "Usage: %s [options] PROGRAM [parameter ...]" -msgstr "Modo de usar: %s [opções] PROGRAMA [parâmetro ...]" - -#: bin/cobcrun.c:126 -#, c-format -msgid " or: %s options" -msgstr " ou: %s opções" - -#: bin/cobcrun.c:129 -msgid "Options:" -msgstr "Opções:" - -#: bin/cobcrun.c:130 -#, fuzzy -msgid " -h, -help display this help and exit" -msgstr " -h, -help exibe esta menssagem" - -#: bin/cobcrun.c:131 -#, fuzzy -msgid " -V, -version display cobcrun and runtime version and exit" -msgstr " -V, -version exibe a versão do programa de execução (runtime) e termina" - -#: bin/cobcrun.c:132 -#, fuzzy -msgid " -i, -info display runtime information (build/environment)" -msgstr " -i, -info exibe a informação do programa de execução (configuração/ambiente)" - -#: bin/cobcrun.c:134 -#, fuzzy -msgid " -q, -brief reduced displays" -msgstr " -q, -brief informação reduzida" - -#: bin/cobcrun.c:136 -#, fuzzy -msgid " -c , -config= set runtime configuration from " -msgstr " -c , -config= estabece a configuração do programa de execução a partir do ficheiro " - -#: bin/cobcrun.c:137 -#, fuzzy -msgid "" -" -r, -runtime-config display current runtime configuration\n" -" (value and origin for all settings)" -msgstr "" -" -r, -runtime-conf exibe a configuração do programa de execução atual\n" -" (valor e origem para todas as configurações)" - -#: bin/cobcrun.c:139 -msgid "" -" -M , -module= set entry point module name and/or load path\n" -" where -M module prepends any directory to the\n" -" dynamic link loader library search path\n" -" and any basename to the module preload list\n" -" (COB_LIBRARY_PATH and/or COB_PRELOAD)" -msgstr "" -" -M , -module= Define o nome do módulo de ponto de entrada e/ou o caminho de carregamento\n" -" onde o módulo -M prefixa qualquer diretório para o\n" -" caminho de pesquisa da biblioteca do carregador de enlace dinâmico\n" -" e qualquer nome base para a lista de pré-carregamento de módulos\n" -" (COB_LIBRARY_PATH e/ou COB_PRELOAD)" - -#: bin/cobcrun.c:145 -#, c-format -msgid "" -"Report bugs to: %s\n" -"or (preferably) use the issue tracker via the home page." -msgstr "" -"Reportar incorreções (bugs) para: %s\n" -"ou (preferencialmente) usar o rastreador de problemas (issue tracker) através da página inicial." - -#: bin/cobcrun.c:148 -#, fuzzy -msgid "GnuCOBOL home page: " -msgstr "Página inicial do GnuCOBOL: " - -#: bin/cobcrun.c:149 -#, fuzzy -msgid "General help using GNU software: " -msgstr "Ajuda geral sobre utilização dos programas GNU: " - -#: bin/cobcrun.c:274 -#, fuzzy -msgid "invalid configuration file name" -msgstr "nome do ficheiro de configuração inválido" - -#: bin/cobcrun.c:325 -#, fuzzy, c-format -msgid "invalid module argument '%s'" -msgstr "argumento de módulo inválido" - -#: bin/cobcrun.c:377 -#, c-format -msgid "%s: missing PROGRAM name" -msgstr "" - -#: bin/cobcrun.c:379 -#, c-format -msgid "Try '%s --help' for more information." -msgstr "" - -#: bin/cobcrun.c:387 -#, fuzzy, c-format -msgid "%s: PROGRAM name exceeds %d characters" -msgstr "nome de programa (PROGRAM) excede 31 carateres" - -#, fuzzy -#~ msgid "%s: %d: invalid cast from '%s' type %s to type %s" -#~ msgstr "%s: %d: conversão inválida do tipo de dados (cast) '%s' para o tipo %s" - -#, fuzzy -#~ msgid " - length is < 1 or > 31" -#~ msgstr " - comprimento é < 1 ou > 31" - -#, fuzzy -#~ msgid "unknown name error '%s'%s" -#~ msgstr "erro: nome desconhecido '%s'%s" - -#~ msgid "ISAM handler" -#~ msgstr "manipulador ISAM" - -#~ msgid "- NOT set with -Wall" -#~ msgstr "- NÃO está definido com -Wall" - -#~ msgid "- ALWAYS active" -#~ msgstr "- ALWAYS ativo" - -#~ msgid "default" -#~ msgstr "padrão" - -#~ msgid "GnuCOBOL compiler for most COBOL dialects with lots of extensions" -#~ msgstr "compilador GnuCOBOL para a maioria dos dialetos com bastantes extensões" - -#~ msgid "Usage: %s [options]... file..." -#~ msgstr "Modo de usar: %s [opções]... ficheiro..." - -#, fuzzy -#~ msgid " -h, -help display this help and exit" -#~ msgstr " -h, -help exibe esta ajuda (help) e termina" - -#, fuzzy -#~ msgid " -V, -version display compiler version and exit" -#~ msgstr " -V, -version exibe a versão do compilador e termina" - -#, fuzzy -#~ msgid "" -#~ " -v, -verbose display compiler version and the commands\n" -#~ " invoked by the compiler" -#~ msgstr "" -#~ " -vv exibe a versão do compilador e os comandos\n" -#~ " invocados pelo compilador" - -#, fuzzy -#~ msgid " -q, -brief reduced displays, commands invoked not shown" -#~ msgstr " -q, -brief exibições reduzidas; os comandos invocados não são mostrados" - -#, fuzzy -#~ msgid " -### like -v but commands not executed" -#~ msgstr " -x cria um programa executável" - -#, fuzzy -#~ msgid " -x build an executable program" -#~ msgstr " -x cria um programa executável" - -#, fuzzy -#~ msgid " -m build a dynamically loadable module (default)" -#~ msgstr " -m cria um módulo de carregamento dinâmico (padrão)" - -#~ msgid " -j [], -job[=]\trun program after build, passing " -#~ msgstr " -j [], -job[=]\texecuta programa após a sua criação, passando o(s) argumento(s) " - -#, fuzzy -#~ msgid "" -#~ " -std= warnings/features for a specific dialect\n" -#~ " can be one of:\n" -#~ " default, cobol2014, cobol2002, cobol85, xopen,\n" -#~ " ibm-strict, ibm, mvs-strict, mvs,\n" -#~ " mf-strict, mf, bs2000-strict, bs2000,\n" -#~ " acu-strict, acu, rm-strict, rm;\n" -#~ " see configuration files in directory config" -#~ msgstr "" -#~ " -std= avisos/características e/ou recursos para um dialeto específico\n" -#~ " pode ser um dos seguintes:\n" -#~ " cobol2014, cobol2002, cobol85, default (padrão),\n" -#~ " ibm, mvs, bs2000, mf, acu;\n" -#~ " ver ficheiros de configuração no subdiretório 'config'" - -#, fuzzy -#~ msgid " -fixed use fixed source format (default)" -#~ msgstr " -fixed usa programa fonte (source) de formato fixo (padrão)" - -#, fuzzy -#~ msgid " -O, -O2, -O3, -Os enable optimization" -#~ msgstr " -O, -O2, -Os habilita otimização" - -#, fuzzy -#~ msgid " -g enable C compiler debug / stack check / trace" -#~ msgstr " -g habilita 'depuração/verificação de pilha/rastreio' do compilador 'C'" - -#, fuzzy -#~ msgid " -d, -debug enable all run-time error checking" -#~ msgstr " -d, -debug habilita a verificação de todos os erros em tempo de execução" - -#, fuzzy -#~ msgid " -o place the output into " -#~ msgstr " -o coloca o resultado (output) no ficheiro " - -#, fuzzy -#~ msgid "" -#~ " -b combine all input files into a single\n" -#~ " dynamically loadable module" -#~ msgstr " -b combina todos os ficheiro de entrada num único\n" - -#, fuzzy -#~ msgid " -E preprocess only; do not compile or link" -#~ msgstr " -E apenas preprocessamento; não compila ou enlaça (link)" - -#, fuzzy -#~ msgid " -C translation only; convert COBOL to C" -#~ msgstr " -C apenas tradução; converte COBOL para linguagem 'C'" - -#, fuzzy -#~ msgid " -S compile only; output assembly file" -#~ msgstr " -S apenas compilação; gera um programa fonte em 'assembler' (e.g. '*.s')" - -#, fuzzy -#~ msgid " -c compile and assemble, but do not link" -#~ msgstr " -c compila e assembla, mas não enlaça (link)" - -#, fuzzy -#~ msgid " -T generate and place a wide program listing into " -#~ msgstr " -T gera e coloca uma listagem alargada no ficheiro " - -#, fuzzy -#~ msgid " -t generate and place a program listing into " -#~ msgstr " -t gera e coloca uma listagem normal no ficheiro " - -#~ msgid " --tlines= specify lines per page in listing, default = 55" -#~ msgstr " --tlines= especifica o número de linhas por página numa listagem criada por -T ou -t, padrão = 55" - -#, fuzzy -#~ msgid " -P[=] generate preprocessed program listing (.lst)" -#~ msgstr " -P[=] gera uma listagem (.lst) do programa fonte preprocessado" - -#, fuzzy -#~ msgid " -Xref specify cross reference in listing" -#~ msgstr " --no-symbols não especifica símbolos na listagem" - -#, fuzzy -#~ msgid " -I add to copy/include search path" -#~ msgstr " -I adiciona aos caminhos de pesquisa dos subdiretórios copy/include" - -#, fuzzy -#~ msgid " -L add to library search path" -#~ msgstr " -L adiciona ao caminho de pesquisa do subdiretório de bibliotecas (tipicamente 'lib')" - -#, fuzzy -#~ msgid " -l link the library " -#~ msgstr " -l enlaça (link) a bibloteca " - -#, fuzzy -#~ msgid " -A add to the C compile phase" -#~ msgstr " -A adiciona à fase de compilação C" - -#, fuzzy -#~ msgid " -Q add to the C link phase" -#~ msgstr " -Q adiciona à fase de enlace (link) C" - -#, fuzzy -#~ msgid " -D define for COBOL compilation" -#~ msgstr " -D define para a compilação COBOL" - -#, fuzzy -#~ msgid " -K generate CALL to as static" -#~ msgstr " -K gera chamada para entrada estaticamente" - -#, fuzzy -#~ msgid " -conf= user-defined dialect configuration; see -std" -#~ msgstr " -conf= configuração do dialeto definido-pelo-utilizador; ver -std" - -#, fuzzy -#~ msgid " -list-reserved display reserved words" -#~ msgstr " -list-reserved exibe palavras reservadas" - -#, fuzzy -#~ msgid " -list-intrinsics display intrinsic functions" -#~ msgstr " -list-intrinsics exibe funções intrínsecas" - -#, fuzzy -#~ msgid " -list-mnemonics display mnemonic names" -#~ msgstr " -list-mnemonics exibe nomes mnemónicos" - -#, fuzzy -#~ msgid " -list-system display system routines" -#~ msgstr " -list-system exibe rotinas de sistema" - -#, fuzzy -#~ msgid "" -#~ " -save-temps[=] save intermediate files\n" -#~ " - default: current directory" -#~ msgstr "" -#~ " -save-temps[=] guarda ficheiros intermediários\n" -#~ " - padrão: directório atual" - -#, fuzzy -#~ msgid " -ext add file extension for resolving COPY" -#~ msgstr " -ext adiciona extensão de ficheiro (e.g. .CPY, .cpy) para resolver COPY" - -#, fuzzy -#~ msgid " -W enable all warnings" -#~ msgstr " -W habilita todos os avisos" - -#, fuzzy -#~ msgid " -Wall enable most warnings (all except as noted below)" -#~ msgstr " -Wall habilita a maior parte dos avisos (todos exceto os abaixo indicados)" - -#~ msgid " -Wno- disable warning enabled by -W or -Wall" -#~ msgstr " -Wno- desabilita avisos habilitados por -W ou -Wall" - -#~ msgid "" -#~ msgstr "" - -#~ msgid "where is one of the following:" -#~ msgstr "onde corresponde a um dos seguintes:" - -#~ msgid "word to be taken out of the reserved words list" -#~ msgstr "palavra a retirar da lista de palavras reservadas" - -#~ msgid "" -#~ msgstr "" - -#~ msgid "word to be added to reserved words list" -#~ msgstr "palavra a adicionar à lista de palavras reservadas" - -#~ msgid "word to be added to reserved words list as alias" -#~ msgstr "palavra a adicionar à lista de palavras reservadas como nome alternativo (alias)" - -#~ msgid ":" -#~ msgstr ":" - -#, fuzzy -#~ msgid "invalid parameter -std=%s" -#~ msgstr "parâmetro inválido %s" - -#, fuzzy -#~ msgid "invalid option detected" -#~ msgstr "detetada opção inválida" - -#, fuzzy -#~ msgid "unknown option ignored:\t%s" -#~ msgstr "opção desconhecida ignorada:\t%s" - -#~ msgid "Invalid type for '%s'" -#~ msgstr "Tipo inválido para '%s'" - -#, fuzzy -#~ msgid "invalid type for '%s'" -#~ msgstr "tipo inválido para '%s'" - -#, fuzzy -#~ msgid "constant item '%s' cannot have a %s clause" -#~ msgstr "item constante '%s' não pode ter a cláusula %s" - -#, fuzzy -#~ msgid "define PERFORM stack size" -#~ msgstr "definir tamanho da pilha para PERFORM" - -#~ msgid "" -#~ msgstr "" - -#, fuzzy -#~ msgid "define cutoff depth for IF statements" -#~ msgstr "define a profundidade de corte para instruções IF" - -#~ msgid "define display sign representation" -#~ msgstr "define a representação do sinal de exibição (display)" - -#~ msgid "machine native" -#~ msgstr "nativo d(o/a) equipamento/máquina" - -#~ msgid "fold COPY subject to value" -#~ msgstr "insensibilidade à capitalização de COPY (Fold COPY) sujeito a valor" - -#, fuzzy -#~ msgid "no transformation" -#~ msgstr "sem transformação" - -#, fuzzy -#~ msgid "fold PROGRAM-ID, CALL, CANCEL subject to value" -#~ msgstr "insensibilidade à capitalização de PROGRAM-ID, CALL, CANCEL sujeito a valor" - -#, fuzzy -#~ msgid "initialize fields without VALUE to decimal value" -#~ msgstr "inicializa(r) campos sem VALUE para valor decimal" - -#, fuzzy -#~ msgid "initialize to picture" -#~ msgstr "inicializa(r) em relação ao modo de exibição (PICTURE)" - -#, fuzzy -#~ msgid "maximum number of errors to report" -#~ msgstr "número máximo de ocorrências assumido como número exato" - -#, fuzzy -#~ msgid "intrinsics to be used without FUNCTION keyword" -#~ msgstr "funções intrínsecas para serem usadas sem a palavra-chave FUNCTION" - -# @@@ ??? -#~ msgid "[ALL|intrinsic function name(,name,...)]" -#~ msgstr "[ALL|intrinsic function name(,name,...)]" - -#, fuzzy -#~ msgid "generate extra braces in generated C code" -#~ msgstr "gera chavetas ('{}') adicionais no código 'C' gerado" - -#, fuzzy -#~ msgid "" -#~ "generate trace code\n" -#~ "\t\t\t- executed SECTION/PARAGRAPH" -#~ msgstr "" -#~ "gera código de rastreio\n" -#~ "\t\t\t- SECTION/PARAGRAPH executado" - -#, fuzzy -#~ msgid "" -#~ "adjust items following OCCURS DEPENDING\n" -#~ "\t\t\t- requires implicit/explicit relaxed syntax" -#~ msgstr "" -#~ "ajusta itens seguintes a OCCURS DEPENDING\n" -#~ "\t\t\t- requere sintaxe descontraída (relaxed) implicita ou explicitamente" - -#, fuzzy -#~ msgid "check recursive program call" -#~ msgstr "verifica chamada a programa recursivo" - -#, fuzzy -#~ msgid "" -#~ "relax syntax checking\n" -#~ "\t\t\t- e.g. REDEFINES position" -#~ msgstr "" -#~ "verificação de sintaxe descontraída (relax)\n" -#~ "\t\t\t- e.g. posição REDEFINES" - -#, fuzzy -#~ msgid "PICTURE SYMBOL for CURRENCY must be one character long" -#~ msgstr "o símbolo de exibição (PICTURE SYMBOL) para CURRENCY tem de ter o tamanho de um caratere" - -#~ msgid "invalid character '%c' in PICTURE SYMBOL for CURRENCY" -#~ msgstr "caratere inválido '%c' em PICTURE SYMBOL para CURRENCY" - -#, fuzzy -#~ msgid "88-level cannot be used here" -#~ msgstr "o nível 88 não pode ser usado aqui" - -#~ msgid "CURRENCY SIGN longer than one character" -#~ msgstr "CURRENCY SIGN maior do que um caratere" - -#~ msgid "CURRENCY SIGN other than '$'" -#~ msgstr "CURRENCY SIGN diferente de '$'" - -#~ msgid "RECORD description invalid with REPORT" -#~ msgstr "descrição RECORD inválida com REPORT" - -#~ msgid "COMMUNICATION SECTION" -#~ msgstr "secção de comunicação (COMMUNICATION SECTION)" - -#~ msgid "REDEFINES clause should follow entry-name" -#~ msgstr "cláusula REDEFINES deveria seguir o nome-de-entrada" - -#, fuzzy -#~ msgid "ANY LENGTH items may only be BY REFERENCE formal parameters" -#~ msgstr "itens ANY LENGTH só podem ser passados por referência (BY REFERENCE)" - -#, fuzzy -#~ msgid "ignoring CONVERSION" -#~ msgstr "ignorando CONVERSION" - -#, fuzzy -#~ msgid "%s is not implemented" -#~ msgstr "'%s' não está implementad(o/a)" - -#~ msgid "table SORT without keys" -#~ msgstr "tabela de ordenação (SORT) sem chave(s)" - -#, fuzzy -#~ msgid "invalid target for DEBUGGING ALL" -#~ msgstr "destino (target) inválido para DEBUGGING ALL" - -#, fuzzy -#~ msgid "non-negative integer value expected" -#~ msgstr "esperado um valor inteiro não negativo (>=0)" - -#~ msgid "'LENGTH OF' phrase" -#~ msgstr "frase 'LENGTH OF'" - -#~ msgid "cannot find the UTC offset on this system" -#~ msgstr "não é possível encontrar deslocamento (offset) UTC neste sistema" - -#, fuzzy -#~ msgid "invalid literal cast" -#~ msgstr "conversão do tipo de dados (cast) de um literal inválida" - -#~ msgid "only one set of parentheses is permitted" -#~ msgstr "apenas é permitido um conjunto de parêntesis (e.g. '( ... )'" - -#~ msgid "no definition/prototype seen for function '%s'" -#~ msgstr "não existe aparentemente definição/protótipo para a função '%s'" - -#~ msgid "no definition/prototype seen for function with external name '%s'" -#~ msgstr "não existe aparentemente definição/protótipo para a função com nome externo '%s'" - -#, fuzzy -#~ msgid "invalid use of 88 level item" -#~ msgstr "utilização inválida do item de nivel 88" - -#~ msgid "reference to item containing nested ODO" -#~ msgstr "referência do item contendo ODO (OCCURS DEPENDING ON) aninhado (tabelas contidas dentro de outras) (nested)" - -#, fuzzy -#~ msgid "invalid use of HANDLE item" -#~ msgstr "utilização inválida do item de nivel 88" - -#, fuzzy -#~ msgid "Variable length item not allowed here" -#~ msgstr "item de comprimento variável não é permitido aqui" - -#, fuzzy -#~ msgid "the CHARACTERS field of ALLOCATE must be numeric" -#~ msgstr "o campo CHARACTERS de ALLOCATE tem de ser numérico" - -#, fuzzy -#~ msgid "warn type mismatch strictly" -#~ msgstr "avisar tipo incompatível estritamente" - -#, fuzzy -#~ msgid "warn unreachable statements" -#~ msgstr "avisar sobre instruções inacessíveis" - -#, fuzzy -#~ msgid "cannot find module" -#~ msgstr "não pode encontrar módulo" - -#, fuzzy -#~ msgid "cannot find entry point" -#~ msgstr "não pode encontrar ponto de entrada (ENTRY)" - -#, fuzzy -#~ msgid "%s COBOL runtime is not initialized" -#~ msgstr "'cobcommandline' - O programa de execução (runtime) não foi inicializado" - -#~ msgid "cob_sig_handler caught not handled signal: %d" -#~ msgstr "'cob_sig_handler' capturado; sinal não manipulado: %d" - -#, fuzzy -#~ msgid "libcob has version/patch level %s/%d" -#~ msgstr "libcob tem versão/nível do remendo (patch) %s/%d" - -#~ msgid " (default)" -#~ msgstr " (padrão)" - -#, fuzzy -#~ msgid "malloc error" -#~ msgstr "Erro de alocação de memória (C malloc)" - -#, fuzzy -#~ msgid "codegen error - Please report this!" -#~ msgstr "Erro de geração de código (codegen) - Por favor informe esta situação!" - -#, fuzzy -#~ msgid "invalid recursive COBOL CALL to '%s'" -#~ msgstr "chamada (CALL) recursiva a '%s' inválida" - -#~ msgid "EXTFH" -#~ msgstr "EXTFH (manipulador externo de ficheiros)" - -#~ msgid "BDB error: %s" -#~ msgstr "erro BDB: %s" - -#~ msgid "BDB error: %s %s" -#~ msgstr "erro BDB: %s %s" - -#, fuzzy -#~ msgid "cannot join BDB environment (%s), error: %d %s" -#~ msgstr "Não é possível unir ambiente BDB (%s), erro: %d %s" - -#~ msgid "COBOL driver program for GnuCOBOL modules" -#~ msgstr "programa controlador (driver) do COBOL para módulos GnuCOBOL" - -#~ msgid "problem with setenv %s: %d" -#~ msgstr "problema com 'setenv %s': %d" - -#, fuzzy -#~ msgid " -v, -verbose display the commands invoked by the compiler" -#~ msgstr " -v exibe os comandos invocados pelo compilador" - -#, fuzzy -#~ msgid "invalid option -std=%s" -#~ msgstr "opção inválida -std=%s" - -#, fuzzy -#~ msgid "unexpected constant" -#~ msgstr "constante inesperada" - -#, fuzzy -#~ msgid "'%s' cannot be set via command line" -#~ msgstr "'%s' não pode ser estabelecido através da linha de comando" - -#, fuzzy -#~ msgid "entries under REDEFINES cannot have a VALUE clause" -#~ msgstr "entradas sob REDEFINES não poder usar a clásula VALUE" - -#, fuzzy -#~ msgid "unexpected usage %d" -#~ msgstr "modo de usar inesperado '%d'" - -#, fuzzy -#~ msgid "" -#~ "allow syntax extensions\n" -#~ "\t\t\t- e.g. switch name SW1, etc." -#~ msgstr "" -#~ "permite extensões de sintaxe\n" -#~ "\t\t\t- e.g. nome do comutador (switch) SW1, etc." - -#, fuzzy -#~ msgid "unexpected tallying phrase" -#~ msgstr "frase de contagem (tallying) inesperada" - -#, fuzzy -#~ msgid "phrases in non-standard order" -#~ msgstr "frases numa ordem despadronizada (non-standard order)" - -#, fuzzy -#~ msgid "RETURNING item should not be in LOCAL-STORAGE" -#~ msgstr "item RETURNING não deverá ser definido na LOCAL-STORAGE" - -# @@@ CHECK TRANSLATION ??? -#, fuzzy -#~ msgid "duplicate define" -#~ msgstr "definição (#define) duplicada" - -#~ msgid "Mnemonic names" -#~ msgstr "Nomes mnemónicos" - -#~ msgid "Extended mnemonic names (with -fsyntax-extension)" -#~ msgstr "Nomes mnemónicos expandidos (com -fsyntax-extension)" - -#, fuzzy -#~ msgid "the targets of SET must be either indexes or pointers" -#~ msgstr "os destinos de SET têm de ser ou índices ou ponteiros" - -#, fuzzy -#~ msgid "the address of '%s' cannot be changed" -#~ msgstr "o endereço de '%s' não pode ser alterado" - -#, fuzzy -#~ msgid "warn inconsistent constant" -#~ msgstr "avisar sobre constante inconsistent" - -#, fuzzy -#~ msgid "recursive call of chained program" -#~ msgstr "chamada recursiva de programa sem retorno ou encadeado (chained)" - -#~ msgid "Extended screen I/O" -#~ msgstr "Expansão de E/S (I/O) de ecrã (screen)" - -#~ msgid "Variable format" -#~ msgstr "Formato de variável" - -#~ msgid "Sequential handler" -#~ msgstr "Manipulador sequêncial" - -#, fuzzy -#~ msgid "invalid currency sign '%s'" -#~ msgstr "símbolo monetário '%s' inválido" - -#, fuzzy -#~ msgid "table sort without keys not implemented yet" -#~ msgstr "tabela de ordenação (sort) sem chaves ainda não foi implementada" - -#, fuzzy -#~ msgid "invalid output device" -#~ msgstr "dispositivo de saída inválido" - -#~ msgid "Build information" -#~ msgstr "informação do resultado da compilação" - -#~ msgid "Build environment" -#~ msgstr "Ambiente de preparação para obter o resultado da compilação" - -#~ msgid "System" -#~ msgstr "Sistema" - -#~ msgid "Libtool" -#~ msgstr "Libtool" - -#~ msgid "External" -#~ msgstr "Extern(o/a)" - -#~ msgid "Internal" -#~ msgstr "Intern(o/a)" - -#, fuzzy -#~ msgid " invoked by the compiler" -#~ msgstr "-v invocad(o/a) pelo compilador" - -#, fuzzy -#~ msgid " -j Run job, after build" -#~ msgstr " -W Executar programa, após criação" - -#, fuzzy -#~ msgid " -std= Warnings/features for a specific dialect:" -#~ msgstr " -std= avisos/características para um dialeto específico:" - -#~ msgid " cobol2002 COBOL 2002" -#~ msgstr " cobol2002 COBOL 2002" - -#, fuzzy -#~ msgid " cobol2014 COBOL 2014" -#~ msgstr " cobol2002 COBOL 2002" - -#~ msgid " ibm IBM Compatible" -#~ msgstr " ibm Compatível IBM" - -#~ msgid " mvs MVS Compatible" -#~ msgstr " mvs Compatível MVS" - -#~ msgid " bs2000 BS2000 Compatible" -#~ msgstr " bs2000 Compatível BS2000" - -#~ msgid " mf Micro Focus Compatible" -#~ msgstr " mf Compatível Micro Focus" - -#~ msgid " acu ACUCOBOL-GT Compatible" -#~ msgstr " acu Compatível ACUCOBOL-GT" - -#~ msgid " default When not specified" -#~ msgstr " padrão Quando não especificado" - -#~ msgid " See config/default.conf and config/*.conf" -#~ msgstr " Ver config/default.conf e config/*.conf" - -#, fuzzy -#~ msgid " -F Alias (short option) for -free" -#~ msgstr " -F Nome alternativo (opção curta) para -free" - -#~ msgid " (V. Coen's 'cobxref' must be in path)" -#~ msgstr " ('cobxref' de V. Coen tem que estar definido em 'path')" - -#~ msgid " -save-temps(=) Save intermediate files" -#~ msgstr " -save-temps(=) Guarda ficheiros intermediários" - -#~ msgid "Failed to load the initial config file" -#~ msgstr "Falha a carregar o ficheiro de configuração (config) inicial" - -#~ msgid "Invalid tab-width value - %d" -#~ msgstr "Valor inválido da largura de tabulação (tab-width) - %d" - -#~ msgid "Invalid text-column value - %d" -#~ msgstr "Valor inválido da columna de texto (text-column) - %d" - -#~ msgid "No such file or directory" -#~ msgstr "Ficheiro ou diretório inexistente" - -#~ msgid "Level number of REDEFINES entry cannot be 66 or 88" -#~ msgstr "Número de nível da entrada REDEFINES não pode ser 66 ou 88" - -#~ msgid "Invalid special names clause" -#~ msgstr "Cláusula de nomes especiais (special names) inválida" - -#~ msgid "Invalid SYMBOLIC clause" -#~ msgstr "Cláusula SYMBOLIC Inválida" - -#~ msgid "Alphabet-name is expected '%s'" -#~ msgstr "Nome-de-alfabeto (alphabet-name) esperado '%s'" - -#~ msgid "Item requires a data name" -#~ msgstr "Item requere um nome de dados" - -#~ msgid "Invalid PAGE clause" -#~ msgstr "Cláusula PAGE inválida" - -#~ msgid "EXIT PROGRAM only allowed within a PROGRAM type" -#~ msgstr "EXIT PROGRAM apenas permitido dentro de um tipo de programa (PROGRAM)" - -#~ msgid "INSPECT missing a keyword" -#~ msgstr "Falta uma palavra-chave em INSPECT" - -#~ msgid "Invalid SYMBOLIC integer" -#~ msgstr "Inteiro simbólico (SYMBOLIC integer) inválido" - -#~ msgid "Dangling IF/ELSE directive" -#~ msgstr "Diretiva IF/ELSE pendente" - -#, fuzzy -#~ msgid "Invalid continuation: no literal/word needs to be continued" -#~ msgstr "Continuação inválida: literal/palavra não necessita ser continuad(o/a)" - -#, fuzzy -#~ msgid "%s directive not yet implemented" -#~ msgstr "%s diretiva ainda não implementada" - -# @@@ (S/N) - IS IT POSSIBLE ??? -#~ msgid "Reserved Words\t\t\tImplemented (Y/N)" -#~ msgstr "Palavras Reservadas\t\t\tImplementadas (S/N)" - -#~ msgid "N (85 obsolete)" -#~ msgstr "N (85 obsoleto)" - -# @@@ Y vs. S - IS IT POSSIBLE ??? -#~ msgid "Y" -#~ msgstr "S" - -#~ msgid "N" -#~ msgstr "N" - -#~ msgid "Intrinsic Function\t\tImplemented\tParameters" -#~ msgstr "Função Intrínseca\t\tImplementada\tParâmetros" - -#~ msgid "A SPACE will be assumed" -#~ msgstr "Será assumido um espaço (SPACE)" - -#~ msgid "" -#~ msgstr "" - -#~ msgid "Unexpected cast type -> %d" -#~ msgstr "Conversão de tipo de dados inesperada -> %d" - -#~ msgid "Unexpected numeric usage -> %d" -#~ msgstr "Modo de usar numérica inesperado -> %d" - -#~ msgid "Invalid picture string - '%s'" -#~ msgstr "Cadeia de carateres 'picture' inválida - '%s'" - -#, fuzzy -#~ msgid "Record size too small '%s' (%d)" -#~ msgstr "Tamanho de registo muito pequeno '%s' (%d)" - -#~ msgid "Record size too large '%s' (%d)" -#~ msgstr "Tamanho de registo muito grande '%s' (%d)" - -#, fuzzy -#~ msgid "Invalid value in AT clause" -#~ msgstr "Valor inválido na cláusula AT" - -#~ msgid "Data name expected before CHARACTERS" -#~ msgstr "Esperado nome de dados antes de CHARACTERS" - -#~ msgid "Data name expected before LEADING" -#~ msgstr "Esperado nome de dados antes de LEADING" - -#~ msgid "Data name expected before TRAILING" -#~ msgstr "Esperado nome de dados antes de TRAILING" - -#~ msgid "Invalid VALUE clause - literal exceeds data size" -#~ msgstr "Cláusula VALUE inválida - literal excede o tamanho de dados" - -#, fuzzy -#~ msgid "%s: option `%s' requires an argument" -#~ msgstr "%s: opção '%s' requere um argumento\n" - -#, fuzzy -#~ msgid "Failed to READ" -#~ msgstr "Falha a ler (READ)" - -#~ msgid "WRITE not allowed" -#~ msgstr "WRITE não é permitido" - -#~ msgid "Library has version/patch level %s/%d" -#~ msgstr "Biblioteca tem versão/nível do remendo %s/%d" - -#, fuzzy -#~ msgid " -a Alias (short option) for assistive -debug" -#~ msgstr " -a Alternativa (opção curta) para depuração -debug" - -#~ msgid "Numeric literal exceeds limit - Aborting" -#~ msgstr "Literal numérico excede limite - A abortar" - -#~ msgid "BDB" -#~ msgstr "BDB (BerkeleyDB)" - -#~ msgid "C-ISAM (Experimental)" -#~ msgstr "C-ISAM (Experimental)" - -#~ msgid "D-ISAM (Experimental)" -#~ msgstr "D-ISAM (Experimental)" - -#~ msgid "VBISAM (Experimental)" -#~ msgstr "VBISAM (Experimental)" - -#~ msgid "Memory allocation failure" -#~ msgstr "Falha na alocação de memória" - -#, fuzzy -#~ msgid "GnuCOBOL runtime environment" -#~ msgstr "Ambiente do programa de execução (runtime) do GnuCOBOL" - -#~ msgid "Only one of options %s may be specified" -#~ msgstr "Apenas uma das opções %s pode ser especificada" - -#~ msgid "'%s' defined here as USAGE FLOAT" -#~ msgstr "'%s' definido aqui como USAGE FLOAT" - -#~ msgid "'%s' defined here as USAGE DOUBLE" -#~ msgstr "'%s' definido aqui como USAGE DOUBLE" - -#~ msgid "'%s' defined here as USAGE FLOAT EXTENDED" -#~ msgstr "'%s' definido aqui como USAGE FLOAT EXTENDED" - -#~ msgid "'%s' defined here as USAGE FLOAT-BINARY-7" -#~ msgstr "'%s' definido aqui como USAGE FLOAT-BINARY-7" - -#~ msgid "'%s' defined here as USAGE FLOAT-BINARY-16" -#~ msgstr "'%s' definido aqui como USAGE FLOAT-BINARY-16" - -#~ msgid "'%s' defined here as USAGE FLOAT-BINARY-34" -#~ msgstr "'%s' definido aqui como USAGE FLOAT-BINARY-34" - -#~ msgid "'%s' defined here as USAGE FLOAT-DECIMAL-16" -#~ msgstr "'%s' definido aqui como USAGE FLOAT-DECIMAL-16" - -#~ msgid "'%s' defined here as USAGE FLOAT-DECIMAL-34" -#~ msgstr "'%s' definido aqui como USAGE FLOAT-DECIMAL-34" - -#, fuzzy -#~ msgid "BASED and OCCURS are mutually exclusive" -#~ msgstr "BASED e OCCURS são mutuamente exclusivas" - -#~ msgid "EXTERNAL and OCCURS are mutually exclusive" -#~ msgstr "EXTERNAL e OCCURS são mutuamente excluyentes" - -#, fuzzy -#~ msgid "Call environment" -#~ msgstr "Ambiente de chamada (call)" - -#~ msgid "Invalid SOURCEFORMAT directive" -#~ msgstr "Diretiva SOURCEFORMAT inválida" - -#~ msgid "Invalid FOLD-COPY-NAME directive" -#~ msgstr "Diretiva FOLD-COPY-NAME inválida" - -#~ msgid "Invalid IF/ELIF directive" -#~ msgstr "Diretiva IF/ELIF inválida" - -#, fuzzy -#~ msgid "Call to cobc_free with NULL pointer" -#~ msgstr "Chamada a 'cobc_parse_strdup' com ponteiro nulo (NULL pointer)" - -#~ msgid "Buffer overrun - Literal too long - Aborting" -#~ msgstr "Ultrapassado o limite da memória de armazenamento temporário (buffer) - A abortar" - -#~ msgid "Invalid line" -#~ msgstr "Linha inválida" - -#~ msgid "ALTERNATE clause invalid for this file type" -#~ msgstr "Cláusula ALTERNATE inválida para este tipo de ficheiro" - -#~ msgid "ORGANIZATION clause invalid" -#~ msgstr "Cláusula ORGANIZATION inválida" - -#~ msgid "Cannot join BDB environment, env_open: %d %s" -#~ msgstr "Não é possível unir o ambiente BDB, 'env_open': %d %s" - -#~ msgid "'CBL_CHECK_FILE_EXIST' - File detail area is too short" -#~ msgstr "'CBL_CHECK_FILE_EXIST' - Ãrea de detalhe do ficheiro é muito curta" - -#~ msgid "NULL name parameter passed to '%s'" -#~ msgstr "Parâmetro de nome nulo (NULL name parameter) passado para '%s'" - -#~ msgid "Operation not allowed on LINE SEQUENTIAL files" -#~ msgstr "Operação não permitida em ficheiros sequênciais com registos delimitados (e.g. 0x0a', 0x0d ou 0x0d0a)" - -#~ msgid "Invalid target for INSPECT" -#~ msgstr "Destino inválido para INSPECT" - -#~ msgid "OPEN I-O not allowed on LINE SEQUENTIAL files" -#~ msgstr "OPEN I-O não permitido em ficheiros sequênciais com registos delimitados (e.g. 0x0a', 0x0d ou 0x0d0a)" - -#~ msgid "REWRITE requires a record name as subject" -#~ msgstr "REWRITE requere um nome de registo como sujeito" - -#~ msgid "REWRITE subject does not refer to a record name" -#~ msgstr "Sujeito de REWRITE não faz referência a um nome de registo" - -#~ msgid "RELEASE requires a record name as subject" -#~ msgstr "RELEASE requere um nome de registo como sujeito" - -#~ msgid "RELEASE subject does not refer to a record name" -#~ msgstr "Sujeto de RELEASE não faz referência a um nome de registo" - -#~ msgid "START not allowed on SEQUENTIAL files" -#~ msgstr "START não permitido em ficheiros sequênciais (SEQUENTIAL files)" - -#~ msgid "GLOBAL is invalid in a user FUNCTION" -#~ msgstr "GLOBAL é inválido numa função-definida-pelo-utilizador (UDF)" - -#~ msgid "USE AT is invalid in nested program" -#~ msgstr "USE AT é inválido em programa aninhado (programa contido dentro de outro) (nested)" - -#~ msgid "FUNCTION-ID is not yet implemented" -#~ msgstr "FUNCTION-ID não está ainda implementada" - -#~ msgid "CONFIGURATION SECTION not allowed in nested programs" -#~ msgstr "CONFIGURATION SECTION não é permitida em programas aninhados (programas contidos dentro de outros) (nested)" - -#~ msgid "REPORT WRITER not implemented" -#~ msgstr "REPORT WRITER não está implementada" - -#~ msgid "EXTERNAL not allowed here" -#~ msgstr "EXTERNAL não é permitida aqui" - -#~ msgid "EXTERNAL only allowed at 01/77 level" -#~ msgstr "EXTERNAL apenas permitida ao nível 01/77" - -#~ msgid "EXTERNAL requires a data name" -#~ msgstr "EXTERNAL requere um nome de dados" - -#~ msgid "GLOBAL and EXTERNAL are mutually exclusive" -#~ msgstr "GLOBAL e EXTERNAL são mutuamente exclusivas" - -#~ msgid "BASED and EXTERNAL are mutually exclusive" -#~ msgstr "BASED e EXTERNAL são mutuamente exclusivas" - -#~ msgid "EXTERNAL and REDEFINES are mutually exclusive" -#~ msgstr "EXTERNAL e REDEFINES são mutuamente exclusivas" - -#~ msgid "GLOBAL only allowed at 01/77 level" -#~ msgstr "GLOBAL apenas permitido ao nível 01/77" - -#~ msgid "GLOBAL requires a data name" -#~ msgstr "GLOBAL requere um nome de dados" - -#~ msgid "GLOBAL not allowed here" -#~ msgstr "GLOBAL não é permitido aqui" - -#~ msgid "BASED requires a data name" -#~ msgstr "BASED requere um nome de dados" - -#~ msgid "BASED and REDEFINES are mutually exclusive" -#~ msgstr "BASED e REDEFINES são mutuamente exclusivas" - -#~ msgid "BASED and ANY LENGTH are mutually exclusive" -#~ msgstr "BASED e ANY LENGTH são mutuamente exclusivas" - -#, fuzzy -#~ msgid "BASED and ANY clause are mutually exclusive" -#~ msgstr "Cláusulas BASED e ANY são mutuamente exclusivas" - -#~ msgid "LOCAL-STORAGE not allowed in nested programs" -#~ msgstr "LOCAL-STORAGE não é permitida em programas aninhados (programas contidos dentro de outros) (nested)" - -#~ msgid "REPORT SECTION not implemented" -#~ msgstr "REPORT SECTION não implementada" - -#~ msgid "BY CONTENT not allowed in CHAINED program" -#~ msgstr "BY CONTENT não é permitida num programa sem retorno ou encadeado (CHAINED program)" - -#~ msgid "SHARING and LOCK clauses are mutually exclusive" -#~ msgstr "Cláusulas SHARING e LOCK são mutuamente exclusivas" - -#~ msgid "Call to cobc_main_strdup with NULL pointer" -#~ msgstr "Chamada a 'cobc_main_strdup' com ponteiro nulo (NULL)" - -#~ msgid "Call to cobc_plex_strdup with NULL pointer" -#~ msgstr "Chamada a 'cobc_plex_strdup' com ponteiro nulo (NULL)" - -#~ msgid "Call to cobc_check_string with NULL pointer" -#~ msgstr "Chamada a 'cobc_check_string' com ponteiro nulo (NULL)" - -#~ msgid "Call to cobc_stradd_dup with NULL pointer" -#~ msgstr "Chamada a 'cobc_stradd_dup' com ponteiro nulo (NULL)" - -#~ msgid "Check that 'cobxref' is in %%PATH%%" -#~ msgstr "Verificar se caminho de 'cobxref' está incluído na variável de sistema '%%PATH%%'" - -#~ msgid "NULL parameter passed to 'cob_cancel'" -#~ msgstr "Parâmetro nulo (NULL) passado para 'cob_cancel'" - -#~ msgid "NULL parameter passed to 'cob_longjmp'" -#~ msgstr "Parâmetro nulo (NULL) passado para 'cob_longjmp'" - -#~ msgid "OpenCOBOL information" -#~ msgstr "Informação OpenCOBOL" - -#~ msgid "Invalid target for REPLACING/CONVERTING" -#~ msgstr "Destino inválido para REPLACING/CONVERTING" - -#~ msgid "or : cobcrun --help (-h)" -#~ msgstr "ou : cobcrun --help (-h)" - -#~ msgid " Print this help" -#~ msgstr " Exibe esta ajuda (help)" - -#~ msgid "or : cobcrun --version (-V)" -#~ msgstr "ou : cobcrun --version (-V)" - -#~ msgid " Print version information" -#~ msgstr " Exibe informação da versão" - -#~ msgid " Print build information" -#~ msgstr " Exibe informação do resultado da compilação" - -#~ msgid "Invalid option" -#~ msgstr "Opção inválida" - -#~ msgid "Invalid directive comparison" -#~ msgstr "Comparação de diretiva inválida" - -#~ msgid "#" -#~ msgstr "#" - -#~ msgid "Numeric literal exceeds maximum" -#~ msgstr "Literal numérico excede o máximo" - -#~ msgid "" -#~ "Built %s\n" -#~ "Packaged %s\n" -#~ "C version %s%s\n" -#~ msgstr "" -#~ "Compilado %s\n" -#~ "Empacotado %s\n" -#~ "Versão C %s%s\n" - -# ??? -#~ msgid " -stack-size=n Set perform stack size" -#~ msgstr " -stack-size=n Estabelece o tamanho da pilha de memória para PERFORM" - -#~ msgid " - (>= 64, <= 512, default 255)" -#~ msgstr " - (>= 64, <= 512, padrão 255)" - -#~ msgid "Too many parameters specified in USING clause" -#~ msgstr "Demasiados parâmetros especificados na cláusula USING" - -#~ msgid "Too many parameters specified on CALL" -#~ msgstr "Demasiados parâmetros especificados em CALL" diff -Nru gnucobol-4.0~early~20200606/po/quot.sed gnucobol-5/po/quot.sed --- gnucobol-4.0~early~20200606/po/quot.sed 2020-06-06 20:52:02.000000000 +0000 +++ gnucobol-5/po/quot.sed 1970-01-01 00:00:00.000000000 +0000 @@ -1,6 +0,0 @@ -s/"\([^"]*\)"/“\1â€/g -s/`\([^`']*\)'/‘\1’/g -s/ '\([^`']*\)' / ‘\1’ /g -s/ '\([^`']*\)'$/ ‘\1’/g -s/^'\([^`']*\)' /‘\1’ /g -s/“â€/""/g diff -Nru gnucobol-4.0~early~20200606/po/remove-potcdate.sin gnucobol-5/po/remove-potcdate.sin --- gnucobol-4.0~early~20200606/po/remove-potcdate.sin 2020-06-06 20:52:02.000000000 +0000 +++ gnucobol-5/po/remove-potcdate.sin 1970-01-01 00:00:00.000000000 +0000 @@ -1,19 +0,0 @@ -# Sed script that remove the POT-Creation-Date line in the header entry -# from a POT file. -# -# The distinction between the first and the following occurrences of the -# pattern is achieved by looking at the hold space. -/^"POT-Creation-Date: .*"$/{ -x -# Test if the hold space is empty. -s/P/P/ -ta -# Yes it was empty. First occurrence. Remove the line. -g -d -bb -:a -# The hold space was nonempty. Following occurrences. Do nothing. -x -:b -} diff -Nru gnucobol-4.0~early~20200606/po/Rules-quot gnucobol-5/po/Rules-quot --- gnucobol-4.0~early~20200606/po/Rules-quot 2020-06-06 20:52:02.000000000 +0000 +++ gnucobol-5/po/Rules-quot 1970-01-01 00:00:00.000000000 +0000 @@ -1,58 +0,0 @@ -# This file, Rules-quot, can be copied and used freely without restrictions. -# Special Makefile rules for English message catalogs with quotation marks. - -DISTFILES.common.extra1 = quot.sed boldquot.sed en@quot.header en@boldquot.header insert-header.sin Rules-quot - -.SUFFIXES: .insert-header .po-update-en - -en@quot.po-create: - $(MAKE) en@quot.po-update -en@boldquot.po-create: - $(MAKE) en@boldquot.po-update - -en@quot.po-update: en@quot.po-update-en -en@boldquot.po-update: en@boldquot.po-update-en - -.insert-header.po-update-en: - @lang=`echo $@ | sed -e 's/\.po-update-en$$//'`; \ - if test "$(PACKAGE)" = "gettext-tools" && test "$(CROSS_COMPILING)" != "yes"; then PATH=`pwd`/../src:$$PATH; GETTEXTLIBDIR=`cd $(top_srcdir)/src && pwd`; export GETTEXTLIBDIR; fi; \ - tmpdir=`pwd`; \ - echo "$$lang:"; \ - ll=`echo $$lang | sed -e 's/@.*//'`; \ - LC_ALL=C; export LC_ALL; \ - cd $(srcdir); \ - if $(MSGINIT) $(MSGINIT_OPTIONS) -i $(DOMAIN).pot --no-translator -l $$lang -o - 2>/dev/null \ - | $(SED) -f $$tmpdir/$$lang.insert-header | $(MSGCONV) -t UTF-8 | \ - { case `$(MSGFILTER) --version | sed 1q | sed -e 's,^[^0-9]*,,'` in \ - '' | 0.[0-9] | 0.[0-9].* | 0.1[0-8] | 0.1[0-8].*) \ - $(MSGFILTER) $(SED) -f `echo $$lang | sed -e 's/.*@//'`.sed \ - ;; \ - *) \ - $(MSGFILTER) `echo $$lang | sed -e 's/.*@//'` \ - ;; \ - esac } 2>/dev/null > $$tmpdir/$$lang.new.po \ - ; then \ - if cmp $$lang.po $$tmpdir/$$lang.new.po >/dev/null 2>&1; then \ - rm -f $$tmpdir/$$lang.new.po; \ - else \ - if mv -f $$tmpdir/$$lang.new.po $$lang.po; then \ - :; \ - else \ - echo "creation of $$lang.po failed: cannot move $$tmpdir/$$lang.new.po to $$lang.po" 1>&2; \ - exit 1; \ - fi; \ - fi; \ - else \ - echo "creation of $$lang.po failed!" 1>&2; \ - rm -f $$tmpdir/$$lang.new.po; \ - fi - -en@quot.insert-header: insert-header.sin - sed -e '/^#/d' -e 's/HEADER/en@quot.header/g' $(srcdir)/insert-header.sin > en@quot.insert-header - -en@boldquot.insert-header: insert-header.sin - sed -e '/^#/d' -e 's/HEADER/en@boldquot.header/g' $(srcdir)/insert-header.sin > en@boldquot.insert-header - -mostlyclean: mostlyclean-quot -mostlyclean-quot: - rm -f *.insert-header diff -Nru gnucobol-4.0~early~20200606/po/stamp-po gnucobol-5/po/stamp-po --- gnucobol-4.0~early~20200606/po/stamp-po 2020-06-06 20:53:00.000000000 +0000 +++ gnucobol-5/po/stamp-po 1970-01-01 00:00:00.000000000 +0000 @@ -1 +0,0 @@ -timestamp Binary files /tmp/tmp8r0303vl/MzBWgGBJBM/gnucobol-4.0~early~20200606/po/sv.gmo and /tmp/tmp8r0303vl/cieYbammgl/gnucobol-5/po/sv.gmo differ diff -Nru gnucobol-4.0~early~20200606/po/sv.po gnucobol-5/po/sv.po --- gnucobol-4.0~early~20200606/po/sv.po 2020-06-06 20:53:00.000000000 +0000 +++ gnucobol-5/po/sv.po 1970-01-01 00:00:00.000000000 +0000 @@ -1,6177 +0,0 @@ -# Swedish translation for gnucobol -# Copyright (C) 2017 Free Software Foundation, Inc. -# This file is distributed under the same license as the gnucobol package. -# Sebastian Rasmussen , 2017. -# -msgid "" -msgstr "" -"Project-Id-Version: gnucobol 2.2-rc1\n" -"Report-Msgid-Bugs-To: gnucobol-messages@gnu.org\n" -"POT-Creation-Date: 2020-06-06 20:52+0000\n" -"PO-Revision-Date: 2017-10-17 16:05+0200\n" -"Last-Translator: Sebastian Rasmussen \n" -"Language-Team: Swedish \n" -"Language: sv\n" -"MIME-Version: 1.0\n" -"Content-Type: text/plain; charset=UTF-8\n" -"Content-Transfer-Encoding: 8bit\n" -"X-Bugs: Report translation errors to the Language-Team address.\n" -"Plural-Forms: nplurals=2; plural=(n != 1);\n" -"X-Generator: Poedit 2.0.4\n" - -#: cobc/cobc.c:117 -#, c-format -msgid "invalid parameter: %s" -msgstr "ogiltig parameter: %s" - -#: cobc/cobc.c:826 -msgid "too many errors" -msgstr "för mÃ¥nga fel" - -#: cobc/cobc.c:838 -#, fuzzy -msgid "internal compiler error" -msgstr "%s: %d internt kompilatorfel" - -#: cobc/cobc.c:904 cobc/cobc.c:991 cobc/cobc.c:1051 cobc/cobc.c:1127 -#: cobc/cobc.c:1167 cobc/cobc.c:1243 -#, c-format -msgid "cannot allocate %d bytes of memory" -msgstr "kan inte allokera %d byte minne" - -#: cobc/cobc.c:917 cobc/cobc.c:933 cobc/cobc.c:953 cobc/cobc.c:1011 -#: cobc/cobc.c:1029 cobc/cobc.c:1147 cobc/cobc.c:1262 cobc/cobc.c:1279 -#: cobc/field.c:2008 libcob/common.c:7121 -#, c-format -msgid "call to %s with NULL pointer" -msgstr "anrop till %s med NULL-pekare" - -#: cobc/cobc.c:974 -#, c-format -msgid "cannot reallocate %d bytes of memory" -msgstr "kan inte omallokera %d byte minne" - -#: cobc/cobc.c:1068 cobc/cobc.c:1184 -msgid "attempt to reallocate non-allocated memory" -msgstr "försök att omallokera icke-allokerat minne" - -#: cobc/cobc.c:1101 cobc/cobc.c:1217 -#, c-format -msgid "call to %s with invalid pointer, as it is missing in list" -msgstr "anrop till %s med ogiltig pekare, dÃ¥ det saknas i listan" - -#: cobc/cobc.c:1390 -#, c-format -msgid "assuming literal for unquoted '%s'" -msgstr "antar litteral för â€%s†utan citattecken" - -#: cobc/cobc.c:1437 -#, fuzzy -msgid " - length exceeds maximum" -msgstr "litterallängd %d överskriver maximala %d siffror" - -#: cobc/cobc.c:1441 -msgid " - name cannot be empty" -msgstr "" - -#: cobc/cobc.c:1444 -msgid " - name cannot begin with space or underscore" -msgstr " - namn kan inte börja med blanksteg eller understreck" - -#: cobc/cobc.c:1447 -msgid " - name cannot begin with 'cob_' or 'COB_'" -msgstr " - namn kan inte börja med â€cob_†eller â€COB_â€" - -#: cobc/cobc.c:1450 -msgid " - name duplicates a 'C' keyword" -msgstr " - namn är ett duplikat av ett â€Câ€-nyckelord" - -#: cobc/cobc.c:1453 -msgid " - name cannot contain a directory separator" -msgstr " - namn kan inte innehÃ¥lla en katalogavskiljare" - -#: cobc/cobc.c:1462 -#, c-format -msgid "invalid file base name '%s'%s" -msgstr "ogiltigt basnamn för fil â€%sâ€%s" - -#: cobc/cobc.c:1466 -#, c-format -msgid "invalid ENTRY '%s'%s" -msgstr "ogiltigt ENTRY â€%sâ€%s" - -#: cobc/cobc.c:1469 -#, c-format -msgid "invalid PROGRAM-ID '%s'%s" -msgstr "ogiltigt PROGRAM-ID â€%sâ€%s" - -#: cobc/cobc.c:1596 cobc/cobc.c:8151 -#, fuzzy -msgid "please check environment variables as noted above" -msgstr "miljövariabler" - -#: cobc/cobc.c:1608 cobc/error.c:254 cobc/error.c:274 cobc/error.c:505 -#: cobc/error.c:528 -msgid "error: " -msgstr "fel: " - -#: cobc/cobc.c:1631 -#, c-format -msgid "duplicate DEFINE '%s' - ignored" -msgstr "duplicerad DEFINE â€%s†- överhoppad" - -#: cobc/cobc.c:1683 -#, c-format -msgid "environment variable '%s' is '%s'; should not contain '%c'" -msgstr "miljövariabel â€%s†är â€%sâ€; borde innehÃ¥lla â€%câ€" - -#: cobc/cobc.c:1712 -msgid "parameter buffer size exceeded" -msgstr "storlek för parameterbuffert överskreds" - -#: cobc/cobc.c:1752 -#, c-format -msgid "warning: could not move temporary file to %s" -msgstr "varning: kunde inte flytta temporärfil till %s" - -#: cobc/cobc.c:1957 cobc/cobc.c:1960 cobc/parser.y:803 cobc/reserved.c:3807 -#: libcob/common.c:761 libcob/common.c:1805 libcob/common.c:2002 -#: libcob/common.c:6325 libcob/common.c:7495 libcob/common.c:8025 -#: libcob/common.c:8104 -msgid "unknown" -msgstr "okänd" - -#: cobc/cobc.c:1963 -#, c-format -msgid "aborting codegen for %s (%s: %s)" -msgstr "avbryter kodgenerering för %s (%s: %s)" - -#: cobc/cobc.c:1966 -#, c-format -msgid "aborting compile of %s at line %d (%s: %s)" -msgstr "avbryter kompilering av %s pÃ¥ rad %d (%s: %s)" - -#: cobc/cobc.c:1970 -msgid "aborting" -msgstr "avbryter" - -#: cobc/cobc.c:1993 cobc/cobc.c:2028 libcob/common.c:7086 bin/cobcrun.c:342 -msgid "Please report this!" -msgstr "Rapportera detta!" - -#: cobc/cobc.c:2046 bin/cobcrun.c:106 -#, fuzzy -msgid "License GPLv3+: GNU GPL version 3 or later " -msgstr "Licens GPLv3+: GNU GPL version 3 eller senare " - -#: cobc/cobc.c:2047 libcob/common.c:7316 bin/cobcrun.c:107 -msgid "" -"This is free software; see the source for copying conditions. There is NO\n" -"warranty; not even for MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE." -msgstr "" -"Det här är fri programvara; se källkoden för kopieringsvillkor. Det finns INGA\n" -"garantier; inte ens för SÄLJBARHET eller LÄMPLIGHET FÖR NÃ…GOT SPECIELLT ÄNDAMÃ…L." - -#: cobc/cobc.c:2049 libcob/common.c:7318 bin/cobcrun.c:109 -#, c-format -msgid "Written by %s\n" -msgstr "Skrivet av %s\n" - -#. TRANSLATORS: This msgid is indented as the "Packaged" msgid, %s expands to date and time -#: cobc/cobc.c:2050 cobc/cobc.c:2063 libcob/common.c:7321 bin/cobcrun.c:110 -#, c-format -msgid "Built %s" -msgstr "Byggt %s" - -#. TRANSLATORS: This msgid is indented as the "Built" msgid, %s expands to date and time -#: cobc/cobc.c:2052 cobc/cobc.c:2065 libcob/common.c:7324 bin/cobcrun.c:112 -#, c-format -msgid "Packaged %s" -msgstr "Paketerat %s" - -#: cobc/cobc.c:2054 cobc/cobc.c:2067 -#, c-format -msgid "C version %s%s" -msgstr "C-version %s%s" - -#: cobc/cobc.c:2080 -msgid "executing:" -msgstr "exekverar:" - -#: cobc/cobc.c:2082 -msgid "to be executed:" -msgstr "kommer att exekveras:" - -#: cobc/cobc.c:2120 cobc/cobc.c:2121 libcob/common.c:5815 libcob/common.c:5816 -#: libcob/common.c:5847 libcob/common.c:5848 -msgid "env" -msgstr "env" - -#: cobc/cobc.c:2156 libcob/common.c:7351 -msgid "build information" -msgstr "bygginformation" - -#: cobc/cobc.c:2157 libcob/common.c:7352 -msgid "build environment" -msgstr "byggmiljö" - -#: cobc/cobc.c:2167 libcob/common.c:7363 -msgid "GnuCOBOL information" -msgstr "GnuCOBOL-information" - -#: cobc/cobc.c:2212 libcob/common.c:6366 libcob/common.c:7386 -#: libcob/common.c:7486 libcob/common.c:7493 -msgid "yes" -msgstr "ja" - -#: cobc/cobc.c:2214 libcob/common.c:6368 libcob/common.c:7388 -#: libcob/common.c:7488 -msgid "no" -msgstr "nej" - -#: cobc/cobc.c:2218 libcob/common.c:7392 -msgid "8 bytes" -msgstr "8 byte" - -#: cobc/cobc.c:2220 libcob/common.c:7394 -msgid "4 bytes" -msgstr "4 byte" - -#: cobc/cobc.c:2224 cobc/cobc.c:2226 libcob/common.c:7398 libcob/common.c:7400 -msgid "endianness" -msgstr "" - -#: cobc/cobc.c:2224 libcob/common.c:7398 -msgid "big-endian" -msgstr "" - -#: cobc/cobc.c:2226 libcob/common.c:7400 -msgid "little-endian" -msgstr "" - -#: cobc/cobc.c:2230 cobc/cobc.c:2232 libcob/common.c:7404 libcob/common.c:7406 -#, fuzzy -msgid "native character set" -msgstr "fortsättningstecken förväntades" - -#: cobc/cobc.c:2230 libcob/common.c:7404 -msgid "EBCDIC" -msgstr "" - -#: cobc/cobc.c:2232 libcob/common.c:7406 -msgid "ASCII" -msgstr "" - -#: cobc/cobc.c:2235 libcob/common.c:7410 libcob/common.c:7476 -msgid "extended screen I/O" -msgstr "utökad skärm-I/O" - -#: cobc/cobc.c:2238 libcob/common.c:7502 -#, fuzzy -msgid "variable file format" -msgstr "variabelformat" - -#: cobc/cobc.c:2244 cobc/cobc.c:2246 libcob/common.c:7508 libcob/common.c:7510 -#, fuzzy -msgid "sequential file handler" -msgstr "sekventiell hanterare" - -#: cobc/cobc.c:2246 libcob/common.c:7510 -msgid "built-in" -msgstr "inbyggd" - -#: cobc/cobc.c:2254 cobc/cobc.c:2260 cobc/cobc.c:2262 cobc/cobc.c:2269 -#: cobc/cobc.c:2271 cobc/cobc.c:2275 cobc/cobc.c:2278 cobc/cobc.c:2282 -#: cobc/cobc.c:2284 cobc/cobc.c:2289 cobc/cobc.c:2291 cobc/cobc.c:2298 -#: cobc/cobc.c:2300 cobc/cobc.c:2307 libcob/common.c:7516 libcob/common.c:7527 -#: libcob/common.c:7533 libcob/common.c:7535 libcob/common.c:7539 -#: libcob/common.c:7542 libcob/common.c:7546 libcob/common.c:7548 -#: libcob/common.c:7553 libcob/common.c:7555 libcob/common.c:7562 -#: libcob/common.c:7564 libcob/common.c:7571 -#, fuzzy -msgid "indexed file handler" -msgstr "sekventiell hanterare" - -#: cobc/cobc.c:2304 libcob/common.c:7568 -msgid "default indexed handler" -msgstr "" - -#: cobc/cobc.c:2307 cobc/cobc.c:2319 cobc/cobc.c:2325 libcob/common.c:7381 -#: libcob/common.c:7498 libcob/common.c:7571 libcob/common.c:7611 -#: libcob/common.c:7625 -msgid "disabled" -msgstr "inaktiverad" - -#: cobc/cobc.c:2311 cobc/cobc.c:2313 libcob/common.c:7594 libcob/common.c:7596 -msgid "mathematical library" -msgstr "matematikbibliotek" - -#: cobc/cobc.c:2317 cobc/cobc.c:2319 libcob/common.c:7605 libcob/common.c:7611 -msgid "XML library" -msgstr "" - -#: cobc/cobc.c:2323 cobc/cobc.c:2325 libcob/common.c:7623 libcob/common.c:7625 -msgid "JSON library" -msgstr "" - -#: cobc/cobc.c:2332 -msgid "only one of options 'E', 'S', 'C', 'c' may be specified" -msgstr "endast en av flaggorna â€Eâ€, â€Sâ€, â€Câ€, â€c†fÃ¥r anges" - -#: cobc/cobc.c:2338 -msgid "only one of options 'm', 'x', 'b' may be specified" -msgstr "endast en av flaggorna â€mâ€, â€xâ€, â€b†fÃ¥r anges" - -#: cobc/cobc.c:2367 -#, c-format -msgid "-fdump= requires one of 'ALL', 'FD', 'WS', 'LS', 'RD', 'FD', 'SC' not '%s'" -msgstr "" - -#: cobc/cobc.c:2392 -#, c-format -msgid "'%s' is not an intrinsic function" -msgstr "â€%s†är inte en inbyggd funktion" - -#: cobc/cobc.c:2434 cobc/cobc.c:7516 cobc/cobc.c:7630 cobc/codegen.c:3796 -#: cobc/codegen.c:3905 cobc/codegen.c:5221 cobc/codegen.c:12426 cobc/tree.c:789 -#: cobc/tree.c:1221 cobc/tree.c:4101 cobc/tree.c:4648 cobc/tree.c:4891 -#: cobc/typeck.c:3294 cobc/typeck.c:7812 cobc/typeck.c:7847 cobc/typeck.c:8660 -#: cobc/typeck.c:11261 cobc/typeck.c:11329 cobc/typeck.c:11397 -#: cobc/typeck.c:11681 cobc/typeck.c:11724 -#, c-format -msgid "call to '%s' with invalid parameter '%s'" -msgstr "anrop till â€%s†med ogiltig parameter â€%sâ€" - -#: cobc/cobc.c:2737 -msgid "loading standard configuration file 'default.conf'" -msgstr "läser in standardkonfigurationsfil â€default.confâ€" - -#: cobc/cobc.c:2871 -msgid "invalid output file name" -msgstr "ogiltigt namn pÃ¥ utmatningsfil" - -#: cobc/cobc.c:2971 -#, c-format -msgid "warning: '%s' is not a directory, defaulting to current directory" -msgstr "varning: â€%s†är inte en katalog, använder aktuell katalog som standard" - -#: cobc/cobc.c:2998 -#, c-format -msgid "warning: %d lines per listing page specified, using %d" -msgstr "" - -#: cobc/cobc.c:3048 -#, c-format -msgid "warning: assuming '%s' is a DEFINE - did you intend to use -debug?" -msgstr "varning: antar â€%s†är en DEFINE - avsÃ¥g du att använda -debug?" - -#: cobc/cobc.c:3315 -#, c-format -msgid "unknown warning option '%s'" -msgstr "okänd varningsflagga â€%sâ€" - -#: cobc/cobc.c:3367 -#, c-format -msgid "%s option requires a listing file" -msgstr "%s-flagga kräver en listningsfil" - -#: cobc/cobc.c:3374 -msgid "output to stdout only valid for preprocess" -msgstr "" - -#: cobc/cobc.c:3466 -msgid "all runtime checks are enabled" -msgstr "alla körtidskontroller är aktiverade" - -#: cobc/cobc.c:3572 -msgid "only one stdin input allowed" -msgstr "endast en standard in tillÃ¥ts" - -#: cobc/cobc.c:3582 -#, c-format -msgid "invalid file name parameter (length > %d)" -msgstr "ogiltig filnamnsparameter (längd > %d)" - -#: cobc/cobc.c:3807 -msgid "nothing for -j to run" -msgstr "ingenting att köra för -j" - -#: cobc/cobc.c:3883 cobc/cobc.c:4071 cobc/cobc.c:4130 cobc/cobc.c:4158 -#: cobc/cobc.c:4247 cobc/cobc.c:4306 cobc/cobc.c:4430 cobc/cobc.c:4469 -#: cobc/cobc.c:6993 -msgid "return status:" -msgstr "returstatus:" - -#: cobc/cobc.c:4361 -msgid "preprocessing:" -msgstr "preprocessar:" - -#: cobc/cobc.c:4435 -msgid "'cobxref' execution unsuccessful" -msgstr "â€cobxrefâ€-exekvering misslyckades" - -#: cobc/cobc.c:4438 -#, c-format -msgid "check that 'cobxref' is in %s" -msgstr "kontrollera att â€cobxref†finns i %s" - -#: cobc/cobc.c:4440 -msgid "no listing produced" -msgstr "ingen listning producerad" - -#: cobc/cobc.c:5328 cobc/cobc.c:5367 -msgid "No fields defined." -msgstr "Inga fält definierade." - -#: cobc/cobc.c:5387 -msgid "No labels defined." -msgstr "Inga etiketter definierade." - -#: cobc/cobc.c:5409 -msgid "Error/Warning summary:" -msgstr "Fel-/varningssammanfattning:" - -#: cobc/cobc.c:5453 -msgid "0 warnings in compilation group" -msgstr "0 varningar i kompileringsgrupp" - -#: cobc/cobc.c:5457 -msgid "1 warning in compilation group" -msgstr "1 varning i kompileringsgrupp" - -#: cobc/cobc.c:5461 -#, c-format -msgid "%d warnings in compilation group" -msgstr "%d varningar i kompileringsgrupp" - -#: cobc/cobc.c:5467 -msgid "0 errors in compilation group" -msgstr "0 fel i kompileringsgrupp" - -#: cobc/cobc.c:5471 -msgid "1 error in compilation group" -msgstr "1 fel i kompileringsgrupp" - -#: cobc/cobc.c:5475 -#, c-format -msgid "%d errors in compilation group" -msgstr "%d fel i kompileringsgrupp" - -#: cobc/cobc.c:5481 -#, c-format -msgid "Too many errors in compilation group: %d maximum errors" -msgstr "För mÃ¥nga fel i kompileringsgrupp: %d fel som mest" - -#: cobc/cobc.c:6050 -#, c-format -msgid "%s: %d: Too many continuation lines" -msgstr "%s: %d: Allt för mÃ¥nga fortsättningsrader" - -#: cobc/cobc.c:6972 -msgid "parsing:" -msgstr "tolkning:" - -#: cobc/cobc.c:7034 -msgid "translating:" -msgstr "översätter:" - -#: cobc/cobc.c:8157 -msgid "no input files" -msgstr "inga inmatningsfiler" - -#: cobc/cobc.c:8186 -#, c-format -msgid "%s option invalid in this combination" -msgstr "%s-flagga ogiltig i denna kombination" - -#: cobc/cobc.c:8227 -msgid "command line:" -msgstr "kommandorad:" - -#: cobc/codegen.c:973 cobc/codegen.c:4487 cobc/codegen.c:11093 -msgid "unexpected CONSTANT item" -msgstr "okänt CONSTANT-objekt" - -#: cobc/codegen.c:1188 cobc/codegen.c:1196 cobc/codegen.c:1291 -#: cobc/codegen.c:1603 cobc/codegen.c:2202 cobc/codegen.c:3212 -#: cobc/codegen.c:3455 cobc/codegen.c:3988 cobc/codegen.c:4454 -#: cobc/codegen.c:7902 cobc/codegen.c:8507 cobc/codegen.c:10298 -#: cobc/field.c:817 cobc/scanner.l:2104 cobc/tree.c:611 cobc/tree.c:3728 -#: cobc/typeck.c:5015 cobc/typeck.c:8662 cobc/typeck.c:9657 -#, c-format -msgid "unexpected tree tag: %d" -msgstr "okänd trädtagg: %d" - -#: cobc/codegen.c:2999 cobc/codegen.c:3295 cobc/codegen.c:8125 cobc/tree.c:1243 -#, c-format -msgid "unexpected cast type: %d" -msgstr "okänd typkonverteringstyp: %d" - -#: cobc/codegen.c:3725 cobc/codegen.c:4434 -#, c-format -msgid "internal statement stack depth exceeded: %d" -msgstr "internt djup för satsstack överskreds: %d" - -#: cobc/codegen.c:3798 -#, c-format -msgid "%s is not a field" -msgstr "%s är inte ett fält" - -#: cobc/codegen.c:4186 cobc/codegen.c:4279 -#, c-format -msgid "unexpected function: %s" -msgstr "oväntad funktion: %s" - -#: cobc/codegen.c:4270 -#, fuzzy, c-format -msgid "unexpected operator: %c" -msgstr "oväntad operator: %d" - -#: cobc/codegen.c:5043 -#, c-format -msgid "unexpected tree category: %d" -msgstr "oväntad trädkategori: %d" - -#: cobc/codegen.c:5438 cobc/codegen.c:5465 cobc/codegen.c:5662 -#: cobc/codegen.c:5694 -#, c-format -msgid "unexpected size: %d" -msgstr "oväntad storlek: %d" - -#: cobc/codegen.c:7254 -#, c-format -msgid "No ENTRY FOR GO TO '%s'" -msgstr "" - -#: cobc/codegen.c:7475 cobc/codegen.c:7725 -#, c-format -msgid "unexpected handler type: %d" -msgstr "oväntad hanterartyp: %d" - -#: cobc/codegen.c:7823 -msgid "unexpected error_node parameter" -msgstr "oväntad error_node-parameter" - -#: cobc/codegen.c:8146 -#, c-format -msgid "unexpected tree type: %d" -msgstr "oväntad trädtyp: %d" - -#: cobc/codegen.c:8703 cobc/typeck.c:6511 cobc/typeck.c:12940 -#: cobc/typeck.c:12984 -#, fuzzy, c-format -msgid "compiler is not configured to support %s" -msgstr "körtidsbibliotek är inte konfigurerat för denna Ã¥tgärd" - -#: cobc/codegen.c:9128 -msgid "Nested OCCURS in report" -msgstr "" - -#: cobc/codeoptim.c:2762 -#, c-format -msgid "unexpected optimization value: %d" -msgstr "oväntat optimeringsvärde: %d" - -#: cobc/config.c:162 libcob/common.c:6786 libcob/common.c:6800 -#: libcob/common.c:7242 -#, c-format -msgid "invalid value '%s' for configuration tag '%s'" -msgstr "ogiltigt värde â€%s†för konfigurationstagg â€%sâ€" - -#: cobc/config.c:165 libcob/common.c:6093 libcob/common.c:6209 -#, c-format -msgid "should be one of the following values: %s" -msgstr "borde vara endera av följande värden: %s" - -#: cobc/config.c:167 -msgid "must be numeric" -msgstr "mÃ¥ste vara numerisk" - -#: cobc/config.c:169 libcob/common.c:6191 -#, c-format -msgid "maximum value: %lu" -msgstr "största värde: %lu" - -#: cobc/config.c:171 -#, c-format -msgid "minimum value: %d" -msgstr "minsta värde: %d" - -#: cobc/config.c:203 -#, c-format -msgid "unsupported value '%s' for configuration tag '%s'" -msgstr "värde â€%s†för konfigurationstagg â€%s†stöds inte" - -#: cobc/config.c:311 cobc/pplex.l:977 libcob/common.c:6702 -msgid "recursive inclusion" -msgstr "rekursiv inkludering" - -#: cobc/config.c:386 libcob/common.c:6753 -msgid "configuration file was included here" -msgstr "konfigurationsfil inkluderades här" - -#: cobc/config.c:415 -#, c-format -msgid "The previous loaded configuration '%s' will be discarded." -msgstr "Tidigare inläst konfiguration â€%s†kommer att kasseras." - -#: cobc/config.c:449 -msgid "missing definitions:" -msgstr "saknar definitioner:" - -#: cobc/config.c:451 -#, c-format -msgid "\tno definition of '%s'" -msgstr "\tingen definition av â€%sâ€" - -#: cobc/config.c:512 -#, c-format -msgid "invalid configuration tag '%s'" -msgstr "ogiltig konfigurationstagg â€%sâ€" - -#: cobc/config.c:525 libcob/common.c:6509 libcob/common.c:6592 -#: libcob/common.c:6620 -#, c-format -msgid "unknown configuration tag '%s'" -msgstr "okänd konfigurationstagg â€%sâ€" - -#: cobc/config.c:549 -#, c-format -msgid "invalid configuration tag '%s' in word-list" -msgstr "ogiltig konfigurationstagg â€%s†i ordlista" - -#: cobc/config.c:608 -#, c-format -msgid "Could not access word list for '%s'" -msgstr "Kunde inte komma Ã¥t ordlista för â€%sâ€" - -#: cobc/error.c:87 -#, fuzzy, c-format -msgid "in section '%s':" -msgstr "i avsnitt" - -#: cobc/error.c:98 -#, fuzzy, c-format -msgid "in paragraph '%s':" -msgstr "i stycke" - -#: cobc/error.c:121 libcob/common.c:7252 -msgid "configuration error:" -msgstr "konfigurationsfel:" - -#: cobc/error.c:134 libcob/common.c:673 -#, c-format -msgid "system error %d" -msgstr "systemfel %d" - -#: cobc/error.c:231 cobc/error.c:323 cobc/error.c:478 -msgid "error [-Werror]: " -msgstr "fel [-Werror]: " - -#: cobc/error.c:231 cobc/error.c:323 cobc/error.c:478 cobc/error.c:505 -#: libcob/common.c:6881 libcob/common.c:6906 -#, c-format -msgid "warning: " -msgstr "varning: " - -#: cobc/error.c:274 cobc/error.c:528 -msgid "error (ignored): " -msgstr "fel (överhoppat): " - -#: cobc/error.c:364 cobc/error.c:380 cobc/error.c:563 cobc/error.c:584 -#, c-format -msgid "%s used" -msgstr "%s använd" - -#: cobc/error.c:367 cobc/error.c:566 -#, c-format -msgid "%s is archaic in %s" -msgstr "%s är Ã¥lderdomlig i %s" - -#: cobc/error.c:371 cobc/error.c:570 -#, c-format -msgid "%s is obsolete in %s" -msgstr "%s är förÃ¥ldrad i %s" - -#: cobc/error.c:377 cobc/error.c:576 cobc/parser.y:5186 cobc/parser.y:5325 -#, c-format -msgid "%s ignored" -msgstr "%s överhoppades" - -#: cobc/error.c:383 cobc/error.c:586 -#, c-format -msgid "%s does not conform to %s" -msgstr "%s följer inte %s" - -#: cobc/error.c:399 -msgid "configuration warning:" -msgstr "konfigurationsvarning:" - -#: cobc/error.c:621 cobc/error.c:640 -#, c-format -msgid "redefinition of '%s'" -msgstr "omdefinition av â€%sâ€" - -#: cobc/error.c:628 cobc/error.c:653 -#, c-format -msgid "'%s' previously defined here" -msgstr "â€%s†tidigare definierad här" - -#: cobc/error.c:677 cobc/error.c:684 -#, c-format -msgid "'%s' is not defined" -msgstr "â€%s†är inte definierad" - -#: cobc/error.c:680 -#, c-format -msgid "'%s' cannot be used here" -msgstr "â€%s†kan inte användas här" - -#: cobc/error.c:682 cobc/parser.y:7009 -#, c-format -msgid "'%s' is not defined, but is a reserved word in another dialect" -msgstr "â€%s†är inte definierad, men är ett reserverat ord i en annan dialekt" - -#: cobc/error.c:716 -#, c-format -msgid "'%s' is ambiguous; needs qualification" -msgstr "â€%s†är tvetydig; behöver kvalificering" - -#: cobc/error.c:746 cobc/parser.y:16748 -#, c-format -msgid "'%s' defined here" -msgstr "â€%s†definierad här" - -#: cobc/error.c:757 -#, c-format -msgid "fatal error: %s" -msgstr "ödesdigert fel: %s" - -#: cobc/error.c:765 -#, c-format -msgid "group item '%s' cannot have %s clause" -msgstr "gruppobjekt â€%s†kan inte ha en %s-klausul" - -#: cobc/error.c:779 -#, c-format -msgid "constant item '%s' requires a %s clause" -msgstr "konstantobjekt â€%s†kräver en %s-klausul" - -#: cobc/error.c:781 -#, c-format -msgid "level %02d item '%s' requires a %s clause" -msgstr "nivÃ¥ %02d-objekt â€%s†kräver en %s-klausul" - -#: cobc/error.c:795 -#, c-format -msgid "constant item '%s' can only have a %s clause" -msgstr "konstantobjekt â€%s†kan endast ha en %s-klausul" - -#: cobc/error.c:797 -#, c-format -msgid "level %02d item '%s' can only have a %s clause" -msgstr "nivÃ¥ %02d-objekt â€%s†kan endast ha en %s-klausul" - -#: cobc/field.c:131 -#, fuzzy -msgid "constant expression has Divide by ZERO" -msgstr "Konstantuttryck har division med noll" - -#: cobc/field.c:187 cobc/field.c:324 cobc/field.c:332 -msgid "missing right parenthesis" -msgstr "saknar högerparentes" - -#: cobc/field.c:216 -#, c-format -msgid "expression stack overflow at %d entries for operation '%c'" -msgstr "" - -#: cobc/field.c:257 -#, c-format -msgid "expression stack overflow at %d entries" -msgstr "" - -#: cobc/field.c:274 -msgid "missing left parenthesis" -msgstr "saknar vänsterparentes" - -#: cobc/field.c:315 -#, c-format -msgid "invalid operator '%s' in expression" -msgstr "ogiltig operator â€%s†i uttryck" - -#: cobc/field.c:334 -#, c-format -msgid "'%c' operator misplaced" -msgstr "felplacerad operator â€%câ€" - -#: cobc/field.c:395 -#, c-format -msgid "invalid level number '%s'" -msgstr "ogiltigt nivÃ¥nummer â€%sâ€" - -#: cobc/field.c:454 -#, fuzzy -msgid "entry following SAME AS may not be subordinate to it" -msgstr "THRU-objekt â€%s†fÃ¥r inte vara underordnat â€%sâ€" - -#: cobc/field.c:459 cobc/field.c:496 -msgid "level number must begin with 01 or 77" -msgstr "nivÃ¥nummer mÃ¥ste börja med 01 eller 77" - -#: cobc/field.c:541 cobc/field.c:557 -#, c-format -msgid "no previous data item of level %02d" -msgstr "inget tidigare dataobjekt för nivÃ¥ %02d" - -#: cobc/field.c:599 -#, c-format -msgid "'%s' cannot be qualified here" -msgstr "â€%s†kan inte kvalificeras här" - -#: cobc/field.c:605 -#, c-format -msgid "'%s' cannot be subscripted here" -msgstr "â€%s†kan inte indexeras här" - -#: cobc/field.c:617 -#, c-format -msgid "'%s' is not defined in '%s'" -msgstr "â€%s†är inte definierad i â€%sâ€" - -#: cobc/field.c:638 -msgid "level number of REDEFINES entries must be identical" -msgstr "nivÃ¥nummer för REDEFINES-poster mÃ¥ste vara identiska" - -#: cobc/field.c:643 -#, c-format -msgid "'%s' is not the original definition" -msgstr "â€%s†är inte originaldefinitionen" - -#: cobc/field.c:758 -#, c-format -msgid "PICTURE clause not compatible with USAGE %s" -msgstr "PICTURE-klausul inte kompatibel med USAGE %s" - -#: cobc/field.c:855 cobc/field.c:930 cobc/field.c:941 -#, c-format -msgid "PICTURE clause required for '%s'" -msgstr "PICTURE-klausul krävs för â€%sâ€" - -#: cobc/field.c:937 -#, c-format -msgid "a non-numeric literal is expected for '%s'" -msgstr "en icke-numerisk litteral förväntas för â€%sâ€" - -#: cobc/field.c:949 -#, c-format -msgid "defining implicit picture size %d for '%s'" -msgstr "definierar implicit bildstorlek %d för â€%sâ€" - -#: cobc/field.c:969 -#, c-format -msgid "'%s' ANY LENGTH only allowed in LINKAGE" -msgstr "â€%s†ANY LENGTH tillÃ¥ts endast i LINKAGE" - -#: cobc/field.c:973 -#, c-format -msgid "'%s' ANY LENGTH must be 01 level" -msgstr "â€%s†ANY LENGTH mÃ¥ste vara nivÃ¥ 01" - -#: cobc/field.c:977 -#, c-format -msgid "'%s' ANY LENGTH cannot be BASED/EXTERNAL" -msgstr "â€%s†ANY LENGTH fÃ¥r inte vara BASED/EXTERNAL" - -#: cobc/field.c:982 cobc/field.c:1010 -#, c-format -msgid "'%s' ANY LENGTH has invalid definition" -msgstr "â€%s†ANY LENGTH har ogiltig definition" - -#: cobc/field.c:993 -#, c-format -msgid "'%s' ANY NUMERIC must be PIC 9" -msgstr "â€%s†ANY NUMERIC mÃ¥ste vara PIC 9" - -#: cobc/field.c:998 -#, fuzzy, c-format -msgid "'%s' ANY LENGTH must be PIC X or PIC N" -msgstr "â€%s†ANY LENGTH mÃ¥ste vara PIC X eller PIC A" - -#: cobc/field.c:1008 -#, c-format -msgid "'%s' ANY NUMERIC has invalid definition" -msgstr "â€%s†ANY NUMERIC har ogiltig definition" - -#: cobc/field.c:1026 -#, c-format -msgid "'%s' EXTERNAL must be specified at 01/77 level" -msgstr "â€%s†EXTERNAL mÃ¥ste anges vid 01/77-nivÃ¥" - -#: cobc/field.c:1030 -#, c-format -msgid "'%s' EXTERNAL can only be specified in WORKING-STORAGE section" -msgstr "â€%s†EXTERNAL kan endast anges i WORKING-STORAGE-sektionen" - -#: cobc/field.c:1034 -#, c-format -msgid "'%s' EXTERNAL and BASED are mutually exclusive" -msgstr "â€%s†EXTERNAL och BASED är ömsesidigt uteslutande" - -#: cobc/field.c:1037 -#, c-format -msgid "'%s' EXTERNAL not allowed with REDEFINES" -msgstr "â€%s†EXTERNAL inte tillÃ¥ten med REDEFINES" - -#: cobc/field.c:1049 -#, c-format -msgid "'%s' BASED not allowed here" -msgstr "â€%s†BASED inte tillÃ¥tet här" - -#: cobc/field.c:1052 -#, c-format -msgid "'%s' BASED not allowed with REDEFINES" -msgstr "â€%s†BASED inte tillÃ¥tet med REDEFINES" - -#: cobc/field.c:1055 -#, c-format -msgid "'%s' BASED only allowed at the 01 and 77 levels" -msgstr "â€%s†BASED endast tillÃ¥tet vid 01- och 77-nivÃ¥erna" - -#: cobc/field.c:1067 -#, c-format -msgid "level %02d item '%s' cannot have a %s clause" -msgstr "nivÃ¥ %02d-objekt â€%s†kan inte ha en %s-klausul" - -#: cobc/field.c:1082 -#, c-format -msgid "'%s' cannot have the OCCURS clause due to '%s'" -msgstr "â€%s†fÃ¥r inte ha OCCURS-klausulen pÃ¥ grund av â€%sâ€" - -#: cobc/field.c:1101 -#, c-format -msgid "the original definition '%s' should not have OCCURS clause" -msgstr "originaldefinitionen â€%s†borde inte ha en OCCURS-klausul" - -#: cobc/field.c:1108 -msgid "REDEFINES must follow the original definition" -msgstr "REDEFINES mÃ¥ste följa originaldefinitionen" - -#: cobc/field.c:1115 -#, c-format -msgid "'%s' cannot be variable length" -msgstr "â€%s†fÃ¥r inte ha variabel längd" - -#: cobc/field.c:1118 -#, c-format -msgid "the original definition '%s' cannot be variable length" -msgstr "originaldefinitionen â€%s†fÃ¥r inte ha variabel längd" - -#: cobc/field.c:1142 -#, c-format -msgid "SCREEN group item '%s' has invalid clause" -msgstr "SCREEN-gruppobjekt â€%s†har ogiltig klausul" - -#: cobc/field.c:1223 -#, fuzzy, c-format -msgid "%s USAGE %s incompatible with %s USAGE %s" -msgstr "PICTURE-klausul inte kompatibel med USAGE %s" - -#: cobc/field.c:1302 -#, c-format -msgid "'%s' cannot have PICTURE clause" -msgstr "â€%s†fÃ¥r inte ha PICTURE-klausul" - -#: cobc/field.c:1318 cobc/field.c:1328 -#, fuzzy, c-format -msgid "%s item '%s' should be USAGE DISPLAY" -msgstr "â€%s†är inte USAGE DISPLAY" - -#: cobc/field.c:1351 -#, c-format -msgid "'%s' COMP-6 with sign - changing to COMP-3" -msgstr "â€%s†COMP-6 med tecken - ändrar till COMP-3" - -#: cobc/field.c:1377 -msgid "elementary items with SIGN clause must have S in PICTURE" -msgstr "elementära objekt med SIGN-klausul mÃ¥ste ha S i PICTURE" - -#: cobc/field.c:1380 -msgid "elementary items with SIGN clause must be USAGE DISPLAY or NATIONAL" -msgstr "elementära objekt med SIGN-klausul mÃ¥ste vara USAGE DISPLAY eller NATIONAL" - -#: cobc/field.c:1397 -#, c-format -msgid "'%s' cannot have JUSTIFIED RIGHT" -msgstr "â€%s†fÃ¥r inte ha JUSTIFIED RIGHT" - -#: cobc/field.c:1410 -#, c-format -msgid "'%s' cannot have S in PICTURE string and BLANK WHEN ZERO" -msgstr "â€%s†fÃ¥r inte ha S i PICTURE-sträng och BLANK WHEN ZERO" - -#: cobc/field.c:1415 -#, c-format -msgid "'%s' cannot have BLANK WHEN ZERO without being USAGE DISPLAY or NATIONAL" -msgstr "â€%s†fÃ¥r inte ha BLANK WHEN ZERO utan att vara USAGE DISPLAY eller NATIONAL" - -#: cobc/field.c:1426 -#, c-format -msgid "'%s' cannot have * in PICTURE string and BLANK WHEN ZERO" -msgstr "â€%s†fÃ¥r inte ha * i PICTURE-sträng och BLANK WHEN ZERO" - -#: cobc/field.c:1433 -#, c-format -msgid "'%s' is not numeric, so cannot have BLANK WHEN ZERO" -msgstr "â€%s†är inte numeriskt, och fÃ¥r därför inte ha BLANK WHEN ZERO" - -#: cobc/field.c:1446 -msgid "only level 88 items may have multiple values" -msgstr "endast nivÃ¥-88-objekt fÃ¥r ha multipla värden" - -#: cobc/field.c:1454 cobc/field.c:1458 -#, fuzzy, c-format -msgid "initial VALUE clause ignored for %s item '%s'" -msgstr "inledande VALUE-klausul överhoppad för %s-objekt" - -#: cobc/field.c:1471 -msgid "FULL has no effect on numeric items; you may want REQUIRED or PIC Z" -msgstr "" - -#: cobc/field.c:1499 -msgid "VALUE may not contain a figurative constant" -msgstr "" - -#: cobc/field.c:1507 -#, fuzzy -msgid "cannot specify both FULL and JUSTIFIED" -msgstr "kan inte ange bÃ¥de %s och %s" - -#: cobc/field.c:1519 -#, c-format -msgid "'%s' has FROM, TO or USING without PIC; PIC will be implied" -msgstr "" - -#: cobc/field.c:1533 -#, c-format -msgid "'%s' has numeric VALUE without PIC; PIC will be implied" -msgstr "" - -#: cobc/field.c:1548 -#, c-format -msgid "'%s' cannot have PIC without FROM, TO, USING or numeric VALUE" -msgstr "" - -#: cobc/field.c:1560 -#, c-format -msgid "'%s' needs a PIC, FROM, TO, USING, VALUE, BELL, BLANK or ERASE clause" -msgstr "" - -#: cobc/field.c:1574 -#, fuzzy -msgid "cannot specify both PIC and VALUE" -msgstr "kan inte ange bÃ¥de %s och %s" - -#: cobc/field.c:1582 -msgid "cannot have PIC without FROM, TO or USING" -msgstr "" - -#: cobc/field.c:1591 -msgid "cannot have FROM, TO or USING without PIC" -msgstr "" - -#: cobc/field.c:1600 -#, fuzzy -msgid "VALUE item may not be numeric" -msgstr "INITIALIZED TO-objekt är inte alfanumeriskt" - -#: cobc/field.c:1616 -#, c-format -msgid "'%s' needs a PIC, COL, LINE, VALUE, BELL or BLANK clause" -msgstr "" - -#: cobc/field.c:1647 -msgid "cannot use AUTO, FULL, PROMPT, REQUIRED or SECURE on elementary item without TO or USING" -msgstr "" - -#: cobc/field.c:1654 -msgid "cannot use BLANK WHEN ZERO, JUSTIFIED, OCCURS or SIGN on item without FROM, TO or USING" -msgstr "" - -#: cobc/field.c:1674 -msgid "cannot use AUTO, FULL, REQUIRED or SECURE on elementary item without FROM, TO or USING" -msgstr "" - -#: cobc/field.c:1679 -msgid "cannot use BLANK WHEN ZERO, JUSTIFIED or SIGN without FROM, TO or USING" -msgstr "" - -#: cobc/field.c:1697 -#, fuzzy -msgid "cannot have BLANK WHEN ZERO without PIC" -msgstr "â€%s†fÃ¥r inte ha BLANK WHEN ZERO utan att vara USAGE DISPLAY eller NATIONAL" - -#: cobc/field.c:1700 -#, fuzzy -msgid "cannot have JUSTIFIED without PIC" -msgstr "â€%s†fÃ¥r inte ha JUSTIFIED RIGHT" - -#: cobc/field.c:1720 -msgid "cannot have AUTO without FROM, TO or USING" -msgstr "" - -#: cobc/field.c:1725 -msgid "cannot use FULL or REQUIRED on item without TO or USING" -msgstr "" - -#: cobc/field.c:1732 -msgid "SECURE can be used with TO only" -msgstr "" - -#: cobc/field.c:1734 -#, fuzzy -msgid "SECURE must be used with TO" -msgstr "READ mÃ¥ste köras först" - -#: cobc/field.c:1753 -#, fuzzy, c-format -msgid "'%s' does nothing" -msgstr "â€%s†är inte definierad" - -#: cobc/field.c:1797 -#, fuzzy -msgid "BLANK ZERO not compatible with USAGE" -msgstr "PICTURE-klausul inte kompatibel med USAGE %s" - -#: cobc/field.c:1800 -#, fuzzy -msgid "SIGN clause not compatible with USAGE" -msgstr "PICTURE-klausul inte kompatibel med USAGE %s" - -#: cobc/field.c:1977 -#, fuzzy, c-format -msgid "'%s' PICTURE clause not compatible with USAGE" -msgstr "PICTURE-klausul inte kompatibel med USAGE %s" - -#: cobc/field.c:2027 -#, fuzzy, c-format -msgid "'%s' 77 level is not allowed here" -msgstr "â€%s†77-nivÃ¥ inte tillÃ¥ten här" - -#: cobc/field.c:2424 -msgid "OCCURS and multi COLUMNs is not allowed" -msgstr "" - -#: cobc/field.c:2452 -#, fuzzy, c-format -msgid "duplicate LINE %d ignored" -msgstr "duplicerad DEFINE â€%s†- överhoppad" - -#: cobc/field.c:2469 -#, c-format -msgid "ignoring SYNCHRONIZED for group item '%s'" -msgstr "hoppar över SYNCHRONIZED för gruppobjekt â€%sâ€" - -#: cobc/field.c:2485 cobc/field.c:2498 cobc/field.c:2778 cobc/field.c:2781 -#, c-format -msgid "size of '%s' larger than size of '%s'" -msgstr "storlek för â€%s†större än storlek för â€%sâ€" - -#: cobc/field.c:2638 cobc/field.c:2703 -#, c-format -msgid "'%s' cannot be larger than %d bytes" -msgstr "â€%s†fÃ¥r inte vara större än %d byte" - -#: cobc/field.c:2676 cobc/field.c:2684 -#, c-format -msgid "'%s' binary field cannot be larger than %d digits" -msgstr "binärfält â€%s†fÃ¥r inte vara större än %d siffror" - -#: cobc/field.c:2764 cobc/field.c:3216 -#, c-format -msgid "unexpected USAGE: %d" -msgstr "oväntad USAGE: %d" - -#: cobc/field.c:2876 -msgid "literal type does not match numeric data type" -msgstr "litteraltyp matchar inte numerisk datatyp" - -#: cobc/field.c:2953 -#, c-format -msgid "THRU item '%s' may not come before '%s'" -msgstr "THRU-objekt â€%s†fÃ¥r inte komma före â€%sâ€" - -#: cobc/field.c:2976 -#, c-format -msgid "RENAMES cannot start/end at the OCCURS item '%s'" -msgstr "RENAMES fÃ¥r inte starta/börja med OCCURS-objektet â€%sâ€" - -#: cobc/field.c:2984 -#, c-format -msgid "cannot use RENAMES on part of the table '%s'" -msgstr "fÃ¥r inte använda RENAMES för en del av tabellen â€%sâ€" - -#: cobc/field.c:3022 -#, c-format -msgid "RENAMES may not contain '%s' as it is a pointer or object reference" -msgstr "RENAMES fÃ¥r inte innehÃ¥lla â€%s†dÃ¥ det är en pekare eller objektreferens" - -#: cobc/field.c:3027 -#, c-format -msgid "RENAMES may not contain '%s' as it is an OCCURS DEPENDING table" -msgstr "RENAMES fÃ¥r inte innehÃ¥lla â€%s†dÃ¥ det är en OCCURS DEPENDING-tabell" - -#: cobc/field.c:3049 -msgid "RENAMES of 01-, 66- and 77-level items" -msgstr "RENAMES av 01-, 66- och 77-nivÃ¥objekt" - -#: cobc/field.c:3051 -msgid "RENAMES may not reference a level 88" -msgstr "RENAMES fÃ¥r inte referera nivÃ¥ 88" - -#: cobc/field.c:3075 -#, c-format -msgid "'%s' must immediately follow the record '%s'" -msgstr "â€%s†mÃ¥ste omedelbart följa pÃ¥ posten â€%sâ€" - -#: cobc/field.c:3083 -#, c-format -msgid "THRU item must be different to '%s'" -msgstr "THRU-objekt mÃ¥ste vara annorlunda jämfört med â€%sâ€" - -#: cobc/field.c:3089 -#, c-format -msgid "'%s' and '%s' must be in the same record" -msgstr "â€%s†och â€%s†mÃ¥ste vara i samma post" - -#: cobc/field.c:3100 -#, c-format -msgid "THRU item '%s' may not be subordinate to '%s'" -msgstr "THRU-objekt â€%s†fÃ¥r inte vara underordnat â€%sâ€" - -#: cobc/flag.def:40 -msgid "" -" -fstack-size=\tdefine PERFORM stack size\n" -" * default: 255" -msgstr "" - -#: cobc/flag.def:44 -msgid "" -" -fsign=[ASCII|EBCDIC]\tdefine display sign representation\n" -" * default: machine native" -msgstr "" - -#: cobc/flag.def:48 -msgid "" -" -ffold-copy=[UPPER|LOWER]\tfold COPY subject to value\n" -" * default: no transformation" -msgstr "" - -#: cobc/flag.def:52 -msgid "" -" -ffold-call=[UPPER|LOWER]\tfold PROGRAM-ID, CALL, CANCEL subject to value\n" -" * default: no transformation" -msgstr "" - -#: cobc/flag.def:56 -msgid "" -" -fdefaultbyte=\tinitialize fields without VALUE to value\n" -" * decimal 0..255 or any quoted character\n" -" * default: initialize to picture" -msgstr "" - -#: cobc/flag.def:61 -msgid "" -" -fmax-errors=\tmaximum number of errors to report before\n" -" compilation is aborted\n" -" * default: 128" -msgstr "" - -#: cobc/flag.def:68 -msgid "" -" -fintrinsics=[ALL|intrinsic function name(,name,...)]\n" -" intrinsics to be used without FUNCTION keyword" -msgstr "" - -#: cobc/flag.def:72 -msgid "" -" -fdump= dump data fields on abort, may be\n" -" a combination of: ALL, WS, LS, RD, FD, SC" -msgstr "" - -#: cobc/flag.def:76 -msgid "" -" -fcallfh= use external provided EXTFH interface module\n" -" for I/O" -msgstr "" - -#: cobc/flag.def:80 -msgid "" -" -fsqldb= which Database is used, may be\n" -" MySQL, MSSQL, Oracle10, Oracle11, Oracle12" -msgstr "" - -#: cobc/flag.def:84 -msgid " -fsqlschema= define database schema name" -msgstr "" - -#: cobc/flag.def:91 -msgid "" -" -fno-recursive-check disable check of recursive program call;\n" -" effectively compiling as RECURSIVE program" -msgstr "" - -#: cobc/flag.def:95 -#, fuzzy -msgid "" -" -fwinmain generate WinMain instead of main when compiling\n" -" as executable" -msgstr "generera WinMain istället för main vid kompilering som körbar fil" - -#: cobc/flag.def:99 -#, fuzzy -msgid " -fcomputed-goto generate computed goto C statements" -msgstr "generera beräknade C-goto-satser" - -#: cobc/flag.def:102 -#, fuzzy -msgid " -falternate-ebcdic use restricted ASCII to EBCDIC translate" -msgstr "använd begränsad ASCII till EBCDIC-översättning" - -#: cobc/flag.def:105 -msgid " -fextra-brace generate extra braces in C source" -msgstr "" - -#: cobc/flag.def:108 -msgid " -fgen-c-line-directives\tgenerate source location directives in C code" -msgstr "" - -#: cobc/flag.def:111 -msgid " -fgen-c-labels generate extra labels in C sources" -msgstr "" - -#: cobc/flag.def:114 -#, fuzzy -msgid " -fcorrect-numeric attempt correction of invalid numeric display items" -msgstr "försök att rätta ogiltiga, numeriska objekt som ska visas" - -#: cobc/flag.def:117 -#, fuzzy -msgid " -fstack-on-heap PERFORM stack allocated on heap" -msgstr "PERFORM-stack allokerad pÃ¥ heap" - -#: cobc/flag.def:120 -msgid " -ffast-math Disables emitting faster arithmetic logic" -msgstr "" - -#: cobc/flag.def:125 -msgid "" -" -fno-remove-unreachable\tdisable remove of unreachable code\n" -" * turned off by -g" -msgstr "" - -#: cobc/flag.def:129 -msgid " -finline-intrinsic\twhen possible resolve intrinsic FUNCTIONs at compile time" -msgstr "" - -#: cobc/flag.def:132 -#, fuzzy -msgid "" -" -ftrace generate trace code\n" -" * scope: executed SECTION/PARAGRAPH" -msgstr "" -" -Xref generera korsreferens via 'cobxref'\n" -" (V. Coens â€cobxref†mÃ¥ste finnas i sökvägen)" - -#: cobc/flag.def:136 -#, fuzzy -msgid "" -" -ftraceall generate trace code\n" -" * scope: executed SECTION/PARAGRAPH/STATEMENTS\n" -" * turned on by -debug" -msgstr "" -"generera spÃ¥rningskod\n" -"\t\t\t- körd SECTION/PARAGRAPH/STATEMENTS\n" -"\t\t\t- slÃ¥s pÃ¥ via -debug" - -#: cobc/flag.def:141 -#, fuzzy -msgid " -fsyntax-only syntax error checking only; don't emit any output" -msgstr "endast syntaxfelskontroll; mata inte ut nÃ¥gon utdata" - -#: cobc/flag.def:144 -#, fuzzy -msgid "" -" -fdebugging-line enable debugging lines\n" -" * 'D' in indicator column or floating >>D" -msgstr "" -"aktivera felsökningsrader\n" -"\t\t\t- 'D' i indikatorkolumn eller flytande >>D" - -#: cobc/flag.def:148 -#, fuzzy -msgid "" -" -fsource-location generate source location code\n" -" * turned on by -debug/-g/-ftraceall" -msgstr "" -"generera källkodsplatskod\n" -"\t\t\t- slÃ¥ pÃ¥ via -debug/-g/-ftraceall" - -#: cobc/flag.def:152 -#, fuzzy -msgid " -fimplicit-init automatic initialization of the COBOL runtime system" -msgstr "automatisk initialisering av COBOL-körtidssystemet" - -#: cobc/flag.def:155 -#, fuzzy -msgid "" -" -fstack-check PERFORM stack checking\n" -" * turned on by -debug or -g" -msgstr "" -"PERFORM-stackkontroll\n" -"\t\t\t- slÃ¥s pÃ¥ av -debug eller -g" - -#: cobc/flag.def:159 -#, fuzzy -msgid "" -" -fwrite-after use AFTER 1 for WRITE of LINE SEQUENTIAL\n" -" * default: BEFORE 1" -msgstr "" -"använd AFTER 1 istället för WRITE av LINE SEQUENTIAL\n" -"\t\t\t- standard: BEFORE 1" - -#: cobc/flag.def:163 -#, fuzzy -msgid "" -" -fmfcomment '*' or '/' in column 1 treated as comment\n" -" * FIXED format only" -msgstr "" -"â€*†eller â€/†i kolumn 1 behandlas som kommentarer\n" -"\t\t\t- endast FIXED-format" - -#: cobc/flag.def:167 -#, fuzzy -msgid "" -" -facucomment '$' in indicator area treated as '*',\n" -" '|' treated as floating comment" -msgstr "" -"â€$†i indikatoromrÃ¥det behandlas som â€*â€,\n" -"\t\t\tâ€|†behandlas som en flytande kommentar" - -#: cobc/flag.def:171 -#, fuzzy -msgid "" -" -fnotrunc allow numeric field overflow\n" -" * non-ANSI behaviour" -msgstr "" -"tillÃ¥t överspill i numeriska fält\n" -"\t\t\t- icke-ANSI-beteende" - -#: cobc/flag.def:175 -msgid "" -" -fodoslide adjust items following OCCURS DEPENDING\n" -" * implies -fcomplex-odo" -msgstr "" - -#: cobc/flag.def:179 -#, fuzzy -msgid "" -" -fsingle-quote use a single quote (apostrophe) for QUOTE\n" -" * default: double quote" -msgstr "" -"använd ett enkelt citationstecken (apostrof) för QUOTE\n" -"\t\t\t- standard: dubbla citationstecken" - -#: cobc/flag.def:189 -#, fuzzy -msgid "" -" -foptional-file treat all files as OPTIONAL\n" -" * unless NOT OPTIONAL specified" -msgstr "" -"behandla alla filer som OPTIONAL\n" -"\t\t\t- om inte NOT OPTIONAL angivits" - -#: cobc/flag.def:193 -#, fuzzy -msgid " -fstatic-call output static function calls for the CALL statement" -msgstr "mata ut statiska funktionsanrop för CALL-satser" - -#: cobc/flag.def:196 -#, fuzzy -msgid "" -" -fno-gen-c-decl-static-call\tdisable generation of C function declations\n" -" for subroutines with static CALL" -msgstr "inaktivera generering av C-funktionsdeklarationer för subrutiner med statiska CALL" - -#: cobc/flag.def:200 -msgid " -fmf-files Sequential & Relative files will match Micro Focus format" -msgstr "" - -#: cobc/flag.def:203 -msgid "" -" -fno-theaders suppress all headers and output of compilation\n" -" options from listing while keeping page breaks" -msgstr "" - -#: cobc/flag.def:207 -#, fuzzy -msgid " -fno-tsource suppress source from listing" -msgstr " -F, -free använd fritt källkodsformat" - -#: cobc/flag.def:210 -msgid " -fno-tmessages suppress warning and error summary from listing" -msgstr "" - -#: cobc/flag.def:213 -#, fuzzy -msgid " -ftsymbols specify symbols in listing" -msgstr " --tsymbols ange symboler i listning" - -#: cobc/parser.y:283 cobc/parser.y:317 -#, c-format -msgid "unreachable statement '%s'" -msgstr "onÃ¥bar sats â€%sâ€" - -#: cobc/parser.y:410 cobc/parser.y:703 -#, c-format -msgid "'%s' is not in LINKAGE SECTION" -msgstr "â€%s†är inte i LINKAGE SECTION" - -#: cobc/parser.y:413 cobc/typeck.c:3705 -#, c-format -msgid "'%s' cannot be BASED/EXTERNAL" -msgstr "â€%s†kan inte vara BASED/EXTERNAL" - -#: cobc/parser.y:418 -#, c-format -msgid "'%s' is not in WORKING-STORAGE SECTION" -msgstr "â€%s†är inte i WORKING-STORAGE SECTION" - -#: cobc/parser.y:425 cobc/typeck.c:3702 -#, c-format -msgid "'%s' not level 01 or 77" -msgstr "â€%s†är inte nivÃ¥ 01 eller 77" - -#: cobc/parser.y:428 cobc/parser.y:443 cobc/typeck.c:3708 -#, c-format -msgid "'%s' REDEFINES field not allowed here" -msgstr "â€%sâ€REDEFINES-fält inte tillÃ¥tet här" - -#: cobc/parser.y:456 -#, c-format -msgid "'%s' USING item duplicates RETURNING item" -msgstr "â€%s†USING-objekt duplicerar RETURNING-objekt" - -#: cobc/parser.y:466 -#, c-format -msgid "ENTRY '%s' duplicated" -msgstr "ENTRY â€%s†duplicerad" - -#: cobc/parser.y:502 -#, fuzzy, c-format -msgid "ENTRY FOR GO TO '%s' duplicated" -msgstr "ENTRY â€%s†duplicerad" - -#: cobc/parser.y:518 -#, c-format -msgid "maximum nested program depth exceeded (%d)" -msgstr "maximalt nästlat programdjup överskreds (%d)" - -#: cobc/parser.y:544 cobc/parser.y:571 -#, c-format -msgid "%s statement not terminated by %s" -msgstr "%s sats inte avslutad med %s" - -#: cobc/parser.y:574 -#, c-format -msgid "%s statement not terminated" -msgstr "%s sats inte avslutad" - -#: cobc/parser.y:638 -msgid "USE statement invalid for SORT file" -msgstr "USE-sats ogiltig i SORT-fil" - -#: cobc/parser.y:665 cobc/parser.y:667 -#, c-format -msgid "duplicate %s clause" -msgstr "duplicerad %s-klausul" - -#: cobc/parser.y:685 -#, c-format -msgid "Cannot specify %s without number of lines on page" -msgstr "" - -#: cobc/parser.y:695 -#, c-format -msgid "maximum OCCURS depth exceeded (%d)" -msgstr "maximalt OCCURS-djup överskreds (%d)" - -#: cobc/parser.y:709 cobc/parser.y:711 cobc/parser.y:6808 cobc/parser.y:6811 -#: cobc/parser.y:6813 cobc/parser.y:6815 cobc/parser.y:6850 cobc/parser.y:7573 -#: cobc/parser.y:7575 cobc/parser.y:7577 cobc/parser.y:7579 cobc/parser.y:7625 -#: cobc/parser.y:7634 cobc/parser.y:9548 cobc/parser.y:10994 -#: cobc/parser.y:12370 cobc/parser.y:13552 -#, c-format -msgid "%s and %s are mutually exclusive" -msgstr "%s och %s är ömsesidigt uteslutande" - -#: cobc/parser.y:725 cobc/parser.y:729 -msgid "TO phrase without DEPENDING phrase" -msgstr "TO-fras utan DEPENDING-fras" - -#: cobc/parser.y:726 -#, fuzzy -msgid "maximum number of occurrences assumed to be exact number" -msgstr "maximalt antal förekomster antas vara exakt nummer" - -#: cobc/parser.y:733 cobc/parser.y:7355 -msgid "OCCURS TO must be greater than OCCURS FROM" -msgstr "OCCUR TO mÃ¥ste vara större än OCCURS FROM" - -#: cobc/parser.y:742 -#, fuzzy -msgid "OCCURS DEPENDING ON without TO phrase" -msgstr "ODO utan TO-fras" - -#: cobc/parser.y:808 -#, c-format -msgid "%s header missing - assumed" -msgstr "%s-huvud saknas - antas finnas" - -#: cobc/parser.y:810 -#, c-format -msgid "%s header missing" -msgstr "%s-huvud saknas" - -#: cobc/parser.y:942 -#, fuzzy, c-format -msgid "duplicate %s" -msgstr "duplicerad %s-klausul" - -#: cobc/parser.y:944 -#, c-format -msgid "%s incorrectly after %s" -msgstr "" - -#: cobc/parser.y:1046 -#, c-format -msgid "redefinition of program name '%s'" -msgstr "omdefinition av programnamn â€%sâ€" - -#: cobc/parser.y:1050 -#, c-format -msgid "redefinition of program ID '%s'" -msgstr "omdefinition av program-ID â€%sâ€" - -#: cobc/parser.y:1082 -#, c-format -msgid "FUNCTION '%s' has no PROCEDURE DIVISION" -msgstr "FUNCTION â€%s†har ingen PROCEDURE DIVISION" - -#: cobc/parser.y:1188 -msgid "functions may not be defined within a program/function" -msgstr "funktioner fÃ¥r inte definieras inom ett program/funktion" - -#: cobc/parser.y:1238 -#, c-format -msgid "END FUNCTION '%s' is different from FUNCTION-ID '%s'" -msgstr "END FUNCTION â€%s†är inte samma som FUNCTION-ID â€%sâ€" - -#: cobc/parser.y:1252 -#, c-format -msgid "END PROGRAM '%s' is different from PROGRAM-ID '%s'" -msgstr "END PROGRAM â€%s†är inte samma som PROGRAM-ID â€%sâ€" - -#: cobc/parser.y:1301 -#, fuzzy -msgid "currency symbol must be one character long" -msgstr "â€%s†CURSOR mÃ¥ste vara 4 eller 6 tecken lÃ¥ngt" - -#: cobc/parser.y:1358 -#, fuzzy, c-format -msgid "invalid character '%c' in currency symbol" -msgstr "en efterföljande valutasymbol" - -#: cobc/parser.y:1374 -msgid "prototype has same name as current function and will be ignored" -msgstr "prototyp har samma namn som aktuell funktion och kommer att hoppas över" - -#: cobc/parser.y:1401 -#, c-format -msgid "duplicate REPOSITORY entries for '%s' do not match" -msgstr "duplicerade REPOSITORY-poster för â€%s†matchar inte" - -#: cobc/parser.y:1405 -#, c-format -msgid "duplicate REPOSITORY entry for '%s'" -msgstr "duplicerad REPOSITORY-post för â€%sâ€" - -#: cobc/parser.y:1470 -#, c-format -msgid "ORGANIZATION %s is incompatible with RECORD DELIMITER" -msgstr "" - -#: cobc/parser.y:1502 -#, c-format -msgid "illegal combination of %s with other clauses" -msgstr "" - -#: cobc/parser.y:1517 cobc/parser.y:1520 cobc/parser.y:1551 -#, c-format -msgid "cannot specify both %s and %s" -msgstr "kan inte ange bÃ¥de %s och %s" - -#: cobc/parser.y:1548 -#, c-format -msgid "cannot specify both %s and %s; %s is ignored" -msgstr "kan inte ange bÃ¥de %s och %s; %s hoppas över" - -#: cobc/parser.y:1720 -msgid "FOR phrase cannot immediately follow ALL/LEADING/TRAILING" -msgstr "FOR-fras kan inte omedelbart följa pÃ¥ ALL/LEADING/TRAILING" - -#: cobc/parser.y:1722 -msgid "missing CHARACTERS/ALL/LEADING/TRAILING phrase after FOR phrase" -msgstr "saknar CHARACTERS/ALL/LEADING/TRAILING-fras efter FOR-fras" - -#: cobc/parser.y:1729 -#, fuzzy -msgid "missing value between ALL/LEADING/TRAILING words" -msgstr "saknar värde mellan CHARACTERS/ALL/LEADING/TRAILING-ord" - -#: cobc/parser.y:1734 -msgid "missing FOR phrase before CHARACTERS/ALL/LEADING/TRAILING phrase" -msgstr "saknar FOR-fras före CHARACTERS/ALL/LEADING/TRAILING-fras" - -#: cobc/parser.y:1741 -msgid "missing ALL/LEADING/TRAILING before value" -msgstr "saknar ALL/LEADING/TRAILING före värde" - -#: cobc/parser.y:1796 -msgid "use of condition-name in place of data-name" -msgstr "" - -#: cobc/parser.y:1800 cobc/parser.y:6753 cobc/typeck.c:665 -#, fuzzy, c-format -msgid "condition-name not allowed here: '%s'" -msgstr "referensmodifiering inte tillÃ¥ten här" - -#: cobc/parser.y:1827 -msgid "cannot specify NO ADVANCING in screen DISPLAY" -msgstr "kan inte ange NO ADVANCING i skärm DISPLAY" - -#: cobc/parser.y:1899 cobc/parser.y:1916 -msgid "non-standard DISPLAY" -msgstr "icke-standard DISPLAY" - -#: cobc/parser.y:1903 -msgid "screens may only be displayed on CRT" -msgstr "skärmar kan endast visas pÃ¥ CRT" - -#: cobc/parser.y:1908 cobc/parser.y:1951 -msgid "cannot mix screens and fields in the same DISPLAY statement" -msgstr "kan inte blanda skärmar och fält i samma DISPLAY-sats" - -#: cobc/parser.y:1912 -msgid "screen clauses may only be used for DISPLAY on CRT" -msgstr "skärm-klausuler kan endast användas för DISPLAY pÃ¥ CRT" - -#: cobc/parser.y:1957 -msgid "ambiguous DISPLAY; put items to display on device in separate DISPLAY" -msgstr "tvetydig DISPLAY; stoppa objekt att visa pÃ¥ enhet i separat DISPLAY" - -#: cobc/parser.y:1973 -#, c-format -msgid "%s is not an alphanumeric literal" -msgstr "%s är inte en alfanumerisk litteral" - -#: cobc/parser.y:1975 -#, c-format -msgid "'%s' is not USAGE DISPLAY" -msgstr "â€%s†är inte USAGE DISPLAY" - -#: cobc/parser.y:1990 cobc/typeck.c:8481 -#, c-format -msgid "invalid target for %s" -msgstr "ogiltigt mÃ¥l för %s" - -#: cobc/parser.y:1997 cobc/parser.y:6747 -#, fuzzy -msgid "SCREEN item cannot be used here" -msgstr "â€%s†kan inte användas här" - -#: cobc/parser.y:1999 -#, fuzzy -msgid "RENAMES item may not be used here" -msgstr "en konstant kan inte användas här - â€%sâ€" - -#: cobc/parser.y:2001 cobc/typeck.c:2333 cobc/typeck.c:2429 -msgid "ANY LENGTH item not allowed here" -msgstr "ANY LENGTH-objekt inte tillÃ¥tet här" - -#: cobc/parser.y:2005 -#, c-format -msgid "item '%s' has wrong class for VALIDATE" -msgstr "" - -#: cobc/parser.y:2014 -#, fuzzy -msgid "WHEN clause must follow EVERY clause" -msgstr "REDEFINES-klausul mÃ¥ste följa pÃ¥ postnamn" - -#: cobc/parser.y:2096 cobc/parser.y:17197 -#, fuzzy -msgid "non-zero value expected" -msgstr "heltalsvärde förväntades" - -#: cobc/parser.y:2102 cobc/tree.c:4352 -#, fuzzy, c-format -msgid "RECORD size (IDX) exceeds maximum allowed (%d)" -msgstr "RECORD-storlek överstiger största tillÃ¥tna (%d)" - -#: cobc/parser.y:2106 cobc/tree.c:4355 -#, c-format -msgid "RECORD size exceeds maximum allowed (%d)" -msgstr "RECORD-storlek överstiger största tillÃ¥tna (%d)" - -#: cobc/parser.y:2111 -msgid "RECORD clause invalid" -msgstr "RECORD-klausul ogiltig" - -#: cobc/parser.y:3188 -msgid "multiple PROGRAM-ID's without matching END PROGRAM" -msgstr "multipla PROGRAM-ID:n utan matchande END PROGRAM" - -#: cobc/parser.y:3191 -msgid "executable requested but no program found" -msgstr "körbar fil begärd men inget program hittades" - -#: cobc/parser.y:3408 cobc/parser.y:3417 -msgid "COMMON may only be used in a contained program" -msgstr "COMMON fÃ¥r endast användas i ett inneslutet program" - -#: cobc/parser.y:3426 cobc/parser.y:3458 -msgid "CALL prototypes" -msgstr "CALL-prototyper" - -#: cobc/parser.y:3607 cobc/parser.y:3884 cobc/parser.y:3928 cobc/parser.y:4036 -#: cobc/parser.y:4223 cobc/parser.y:4319 cobc/parser.y:4360 cobc/parser.y:4431 -#: cobc/parser.y:4452 cobc/parser.y:4531 cobc/parser.y:4550 cobc/parser.y:4566 -#: cobc/parser.y:4584 cobc/parser.y:4602 cobc/parser.y:4619 cobc/parser.y:4637 -#: cobc/parser.y:6868 cobc/parser.y:7694 -#, c-format -msgid "%s not allowed in nested programs" -msgstr "%s inte tillÃ¥tet i nästlade program" - -#: cobc/parser.y:3761 -msgid "segment-number must be in range of values 1 to 49" -msgstr "segmentnummer mÃ¥ste vara i intervallet 1 till 49" - -#: cobc/parser.y:3773 -msgid "duplicate CLASSIFICATION clause" -msgstr "duplicerad CLASSIFICATION-klausul" - -#: cobc/parser.y:3849 -msgid "PROGRAM phrase" -msgstr "PROGRAM-fras" - -#: cobc/parser.y:3944 cobc/parser.y:3955 cobc/parser.y:4271 -#, c-format -msgid "invalid %s clause" -msgstr "ogiltig %s-klausul" - -#: cobc/parser.y:4386 cobc/parser.y:4390 -msgid "CLASS literal with THRU must have size 1" -msgstr "CLASS-litteral med THRU mÃ¥ste ha storlek 1" - -#: cobc/parser.y:4417 -#, fuzzy -msgid "CLASS IS integer IN alphabet-name" -msgstr "â€%s†är inte ett alfabetsnamn" - -#: cobc/parser.y:4464 -msgid "separate currency symbol and currency string" -msgstr "" - -#: cobc/parser.y:4497 -#, c-format -msgid "invalid CURRENCY SIGN '%s'" -msgstr "ogiltigt CURRENCY SIGN â€%sâ€" - -#: cobc/parser.y:4715 -msgid "cannot use RELATIVE KEY clause on INDEXED files" -msgstr "" - -#: cobc/parser.y:4719 -msgid "cannot use RECORD KEY clause on RELATIVE files" -msgstr "" - -#: cobc/parser.y:4793 -msgid "EXTERNAL/DYNAMIC cannot be used with literals" -msgstr "" - -#: cobc/parser.y:4813 -msgid "EXTERNAL/DYNAMIC cannot be used with USING/VARYING" -msgstr "" - -#: cobc/parser.y:4824 -msgid "EXTERNAL/DYNAMIC cannot be used with DISK FROM" -msgstr "" - -#: cobc/parser.y:4826 -msgid "ASSIGN DISK FROM" -msgstr "" - -#: cobc/parser.y:4942 -msgid "ASSIGN EXTERNAL/DYNAMIC" -msgstr "" - -#: cobc/parser.y:5165 -#, c-format -msgid "'%s' is not an alphabet-name" -msgstr "â€%s†är inte ett alfabetsnamn" - -#: cobc/parser.y:5254 -#, c-format -msgid "%s only valid with ORGANIZATION %s" -msgstr "" - -#: cobc/parser.y:5321 cobc/parser.y:5344 -#, fuzzy, c-format -msgid "RECORD DELIMITER %s only allowed with SEQUENTIAL files" -msgstr "RECORDING MODE U eller S fÃ¥r endast användas med RECORD SEQUENTIAL-filer" - -#: cobc/parser.y:5323 cobc/parser.y:5336 cobc/parser.y:5348 cobc/parser.y:5358 -#, fuzzy -msgid "RECORD DELIMITER clause" -msgstr "PROMPT-klausul" - -#: cobc/parser.y:5332 -#, fuzzy, c-format -msgid "RECORD DELIMITER %s only allowed with (LINE) SEQUENTIAL files" -msgstr "RECORDING MODE U eller S fÃ¥r endast användas med RECORD SEQUENTIAL-filer" - -#: cobc/parser.y:5337 -msgid "LINE-SEQUENTIAL phrase" -msgstr "" - -#: cobc/parser.y:5349 -msgid "BINARY-SEQUENTIAL phrase" -msgstr "" - -#: cobc/parser.y:5357 -#, fuzzy -msgid "RECORD DELIMITER clause only allowed with (LINE) SEQUENTIAL files" -msgstr "RECORDING MODE U eller S fÃ¥r endast användas med RECORD SEQUENTIAL-filer" - -#: cobc/parser.y:5360 -#, c-format -msgid "RECORD DELIMITER %s not recognized; will be ignored" -msgstr "" - -#: cobc/parser.y:5398 -msgid "DUPLICATES for primary keys" -msgstr "" - -#: cobc/parser.y:5637 -msgid "DOS/VS APPLY phrase" -msgstr "" - -#: cobc/parser.y:5752 -msgid "RECORD description missing or invalid" -msgstr "RECORD-beskrivning saknas eller ogiltig" - -#: cobc/parser.y:5778 -#, fuzzy, c-format -msgid "duplicate file description for %s" -msgstr "duplicerade värden i klass â€%sâ€" - -#: cobc/parser.y:5811 cobc/parser.y:5821 -msgid "file cannot have both EXTERNAL and GLOBAL clauses" -msgstr "fil fÃ¥r inte ha bÃ¥de EXTERNAL och GLOBAL-klausuler" - -#: cobc/parser.y:5825 cobc/parser.y:6414 cobc/parser.y:6853 cobc/parser.y:12363 -#: cobc/parser.y:15305 -#, c-format -msgid "%s is invalid in a user FUNCTION" -msgstr "%s är ogiltig i en användar-FUNCTION" - -#: cobc/parser.y:5863 cobc/parser.y:5872 -msgid "RECORD clause ignored for LINE SEQUENTIAL" -msgstr "RECORD-klausul överhoppas pÃ¥ grund av LINE SEQUENTIAL" - -#: cobc/parser.y:5964 -msgid "LINAGE clause with wrong file type" -msgstr "LINAGE-klausul med fel filtyp" - -#: cobc/parser.y:6026 -msgid "RECORDING MODE U or S can only be used with RECORD SEQUENTIAL files" -msgstr "RECORDING MODE U eller S fÃ¥r endast användas med RECORD SEQUENTIAL-filer" - -#: cobc/parser.y:6059 -#, c-format -msgid "ignoring CODE-SET '%s'" -msgstr "hoppar över CODE-SET â€%sâ€" - -#: cobc/parser.y:6070 -msgid "CODE-SET clause invalid for file type" -msgstr "CODE-SET-klausul ogiltig för filtyp" - -#: cobc/parser.y:6092 -msgid "REPORT clause with wrong file type" -msgstr "REPORT-klausul med fel filtyp" - -#: cobc/parser.y:6170 -msgid "CD record missing" -msgstr "CD-post saknas" - -#: cobc/parser.y:6601 -msgid "CONSTANT item not at 01 level" -msgstr "CONSTANT-objekt inte vid nivÃ¥ 01" - -#: cobc/parser.y:6721 -#, fuzzy -msgid "REDEFINES clause not following entry-name" -msgstr "REDEFINES-klausul mÃ¥ste följa pÃ¥ postnamn" - -#: cobc/parser.y:6743 -#, fuzzy -msgid "SAME AS clause" -msgstr "SIZE IS-klausul" - -#: cobc/parser.y:6750 -#, fuzzy -msgid "REPORT item cannot be used here" -msgstr "â€%s†kan inte användas här" - -#: cobc/parser.y:6757 -#, fuzzy -msgid "elementary item expected" -msgstr "heltalsvärde förväntades" - -#: cobc/parser.y:6764 -#, fuzzy -msgid "SAME AS item may not reference itself" -msgstr "RENAMES fÃ¥r inte referera nivÃ¥ 88" - -#: cobc/parser.y:6771 -#, fuzzy -msgid "SAME AS item may not be subordinate to any item with USAGE clause" -msgstr "THRU-objekt â€%s†fÃ¥r inte vara underordnat â€%sâ€" - -#: cobc/parser.y:6773 -#, fuzzy -msgid "SAME AS item may not be subordinate to any item with SIGN clause" -msgstr "THRU-objekt â€%s†fÃ¥r inte vara underordnat â€%sâ€" - -#: cobc/parser.y:6801 cobc/parser.y:6855 cobc/parser.y:7567 cobc/parser.y:7650 -#: cobc/parser.y:7674 -#, c-format -msgid "%s not allowed here" -msgstr "%s inte tillÃ¥tet här" - -#: cobc/parser.y:6803 cobc/parser.y:6845 cobc/parser.y:7569 -#, c-format -msgid "%s only allowed at 01/77 level" -msgstr "%s endast tillÃ¥tet vid nivÃ¥ 01/77" - -#: cobc/parser.y:6805 cobc/parser.y:6847 cobc/parser.y:7571 cobc/parser.y:7654 -#: cobc/parser.y:7676 -#, c-format -msgid "%s requires a data name" -msgstr "%s kräver ett datanamn" - -#: cobc/parser.y:6958 -msgid "a locale-format PICTURE string must only consist of '9', '.', '+', 'Z' and the currency-sign" -msgstr "" - -#: cobc/parser.y:6992 cobc/typeck.c:3658 -#, fuzzy, c-format -msgid "'%s' is not a locale-name" -msgstr "â€%s†är inte ett lokalnamn" - -#: cobc/parser.y:7007 -#, fuzzy, c-format -msgid "'%s' is not a valid USAGE" -msgstr "â€%s†är inte ett giltigt datanamn" - -#: cobc/parser.y:7012 -#, fuzzy, c-format -msgid "unknown USAGE: %s" -msgstr "okänt fel: %d" - -#: cobc/parser.y:7149 -#, c-format -msgid "unknown HANDLE type: %s" -msgstr "" - -#: cobc/parser.y:7406 cobc/parser.y:7408 -msgid "INDEXED should follow ASCENDING/DESCENDING" -msgstr "INDEXED bör följa pÃ¥ ASCENDING/DESCENDING" - -#: cobc/parser.y:7526 -#, fuzzy -msgid "SYNCHRONIZED clause" -msgstr "SIZE IS-klausul" - -#: cobc/parser.y:7529 -msgid "LEFT/RIGHT phrases in SYNCHRONIZED clause" -msgstr "" - -#: cobc/parser.y:7612 -msgid "FALSE clause only allowed for 88 level" -msgstr "FALSE-klausul endast tillÃ¥ten för nivÃ¥ 88" - -#: cobc/parser.y:7652 -#, fuzzy, c-format -msgid "%s only allowed at 01 level" -msgstr "%s endast tillÃ¥tet vid nivÃ¥ 01/77" - -#: cobc/parser.y:7656 cobc/parser.y:7678 -#, c-format -msgid "%s and %s combination not allowed" -msgstr "" - -#: cobc/parser.y:7787 -msgid "GLOBAL is not allowed with RD" -msgstr "GLOBAL är inte tillÃ¥tet med RD" - -#: cobc/parser.y:8321 -msgid "PLUS is not recommended with LEFT, RIGHT or CENTER" -msgstr "" - -#: cobc/parser.y:8323 -#, fuzzy -msgid "PLUS is not allowed with LEFT, RIGHT or CENTER" -msgstr "GLOBAL är inte tillÃ¥tet med RD" - -#: cobc/parser.y:8360 cobc/parser.y:8390 -msgid "PLUS is ignored on first field of line" -msgstr "" - -#: cobc/parser.y:8398 -msgid "invalid COLUMN integer; must be > 0" -msgstr "" - -#: cobc/parser.y:8400 -msgid "COLUMN numbers should increase" -msgstr "" - -#: cobc/parser.y:8499 cobc/parser.y:8555 -msgid "INITIAL specified on non-input field" -msgstr "INITIAL angivet för ett icke-indatafält" - -#: cobc/parser.y:8511 cobc/parser.y:8567 -msgid "relative LINE/COLUMN clause required with OCCURS" -msgstr "relativ LINE/COLUMN-klausul krävs med OCCURS" - -#: cobc/parser.y:8669 cobc/parser.y:8673 -msgid "screen positions from data-item" -msgstr "" - -#: cobc/parser.y:9498 -#, fuzzy -msgid "OCCURS screen items" -msgstr "GLOBAL-skärmobjekt" - -#: cobc/parser.y:9510 -msgid "GLOBAL screen items" -msgstr "GLOBAL-skärmobjekt" - -#: cobc/parser.y:9554 -msgid "overriding convention specified in ENTRY-CONVENTION" -msgstr "Ã¥sidosätter konvention angiven i ENTRY-CONVENTION" - -#: cobc/parser.y:9566 -msgid "executable program requested but PROCEDURE/ENTRY has USING clause" -msgstr "körbart program begärt men PROCEDURE/ENTRY har USING-klausul" - -#: cobc/parser.y:9636 cobc/parser.y:9653 cobc/parser.y:11184 -#, fuzzy, c-format -msgid "number of arguments exceeds maximum %d" -msgstr "antal parametrar överstiger maximala %d" - -#: cobc/parser.y:9645 -msgid "CHAINING invalid in user FUNCTION" -msgstr "CHAINING ogiltig i användar-FUNCTION" - -#: cobc/parser.y:9692 cobc/parser.y:11261 cobc/parser.y:11270 -#, c-format -msgid "%s not allowed in CHAINED programs" -msgstr "%s inte tillÃ¥tet i CHAINED-program" - -#: cobc/parser.y:9704 cobc/parser.y:9712 cobc/parser.y:9720 cobc/parser.y:9741 -msgid "SIZE only allowed for BY VALUE items" -msgstr "SIZE endast tillÃ¥tet för BY VALUE-objekt" - -#: cobc/parser.y:9743 cobc/parser.y:9760 -msgid "invalid value for SIZE" -msgstr "ogiltigt värde för SIZE" - -#: cobc/parser.y:9775 -msgid "MEMORY SIZE phrase in CALL statement" -msgstr "" - -#: cobc/parser.y:9787 -msgid "OPTIONAL only allowed for BY REFERENCE items" -msgstr "OPTIONAL endast tillÃ¥tet för BY REFERENCE-objekt" - -#: cobc/parser.y:9799 -msgid "RETURNING clause is required for a FUNCTION" -msgstr "RETURNING-klausul krävs för en FUNCTION" - -#: cobc/parser.y:9805 -msgid "RETURNING clause cannot be OMITTED for main program" -msgstr "RETURNING-klausul fÃ¥r inte vara OMITTED för huvudprogram" - -#: cobc/parser.y:9808 -msgid "RETURNING clause cannot be OMITTED for a FUNCTION" -msgstr "RETURNING-klausul fÃ¥r inte vara OMITTED för en FUNCTION" - -#: cobc/parser.y:9821 -msgid "RETURNING item is not defined in LINKAGE SECTION" -msgstr "RETURNING-objekt är inte definierat i LINKAGE SECTION" - -#: cobc/parser.y:9823 -msgid "RETURNING item must have level 01" -msgstr "RETURNING-objekt mÃ¥ste ha nivÃ¥ 01" - -#: cobc/parser.y:9825 -msgid "RETURNING item should not have OCCURS" -msgstr "RETURNING-objekt borde inte ha OCCURS" - -#: cobc/parser.y:9829 -msgid "function RETURNING item may not be ANY LENGTH" -msgstr "funktion RETURNING-objekt fÃ¥r inte vara ANY LENGTH" - -#: cobc/parser.y:10017 -#, c-format -msgid "'%s' is not a statement" -msgstr "â€%s†är inte en sats" - -#: cobc/parser.y:10019 -#, c-format -msgid "unknown statement '%s'; it may exist in another dialect" -msgstr "okänd sats â€%sâ€; den kanske finns i en annan dialekt" - -#: cobc/parser.y:10022 -#, c-format -msgid "unknown statement '%s'" -msgstr "okänd sats â€%sâ€" - -#: cobc/parser.y:10039 -msgid "section segments" -msgstr "" - -#: cobc/parser.y:10041 -msgid "SECTION segment-number must be less than or equal to 99" -msgstr "SECTION segmentnummer mÃ¥ste vara mindre än eller lika med 99" - -#: cobc/parser.y:10044 -msgid "SECTION segment-number in DECLARATIVES must be less than 50" -msgstr "SECTION segmentnummer i DECLARATIVES mÃ¥ste vara mindre än 50" - -#: cobc/parser.y:10052 -msgid "SECTION segment within DECLARATIVES" -msgstr "SECTION segment inom DECLARATIVES" - -#: cobc/parser.y:10240 cobc/parser.y:10375 -msgid "non-standard ACCEPT" -msgstr "icke-standard ACCEPT" - -#: cobc/parser.y:10252 -msgid "PROMPT clause" -msgstr "PROMPT-klausul" - -#: cobc/parser.y:10256 -msgid "SIZE IS clause" -msgstr "SIZE IS-klausul" - -#: cobc/parser.y:10471 cobc/parser.y:10763 -msgid "TIME-OUT or BEFORE TIME clauses" -msgstr "TIME-OUT eller BEFORE TIME-klausuler" - -#: cobc/parser.y:10497 cobc/parser.y:10513 cobc/parser.y:10528 -msgid "AT screen-location" -msgstr "AT skärmposition" - -#: cobc/parser.y:10529 -msgid "LINE or COLUMN" -msgstr "LINE eller COLUMN" - -#: cobc/parser.y:10893 -msgid "ALLOCATE CHARACTERS requires RETURNING clause" -msgstr "ALLOCATE CHARACTERS kräver RETURNING-klausul" - -#: cobc/parser.y:10908 cobc/parser.y:12168 -#, fuzzy, c-format -msgid "ignoring %s phrase" -msgstr "hoppar över tecken" - -#: cobc/parser.y:10910 -msgid "addressing mode should be either 24 or 31 bit" -msgstr "" - -#: cobc/parser.y:10982 -msgid "recursive program call - assuming RECURSIVE attribute" -msgstr "rekursivt programanrop - antar RECURSIVE-attribut" - -#: cobc/parser.y:11001 -msgid "STATIC CALL convention ignored because of ON EXCEPTION" -msgstr "" - -#: cobc/parser.y:11010 -msgid "ON EXCEPTION ignored because of STATIC CALL" -msgstr "" - -#: cobc/parser.y:11111 cobc/typeck.c:12209 -msgid "invalid mnemonic name" -msgstr "ogiltigt mnemonic-namn" - -#: cobc/parser.y:11131 cobc/parser.y:11428 -msgid "CALL/CANCEL with program-prototype-name" -msgstr "CALL/CANCEL med programprototypnamn" - -#: cobc/parser.y:11135 -msgid "id/literal ignored, using prototype name" -msgstr "id/litteral överhoppad, använder prototypnamn" - -#: cobc/parser.y:11141 -msgid "NESTED phrase is only valid with literal" -msgstr "NESTED-fras är endast giltig med litteral" - -#: cobc/parser.y:11202 -#, fuzzy -msgid "OMITTED only allowed when arguments are passed BY REFERENCE" -msgstr "OMITTED endast tillÃ¥ten när parametrar skickas via BY REFERENCE" - -#: cobc/parser.y:11226 -msgid "invalid file name reference" -msgstr "ogiltig filnamnsreferens" - -#: cobc/parser.y:11234 -#, fuzzy, c-format -msgid "BY CONTENT assumed for alphanumeric item '%s'" -msgstr "BY CONTENT antas för alfanumeriskt objekt" - -#: cobc/parser.y:11239 -#, fuzzy, c-format -msgid "BY CONTENT assumed for national item '%s'" -msgstr "BY CONTENT antas för alfanumeriskt objekt" - -#: cobc/parser.y:11302 -msgid "RETURNING item must have level 01 or 77" -msgstr "RETURNING-objekt mÃ¥ste ha nivÃ¥ 01 eller 77" - -#: cobc/parser.y:11306 -msgid "RETURNING item must be a LINKAGE SECTION item or have BASED clause" -msgstr "RETURNING-objekt mÃ¥ste vara ett LINKAGE SECTION-objekt eller ha BASED-klausul" - -#: cobc/parser.y:11340 cobc/parser.y:15972 cobc/parser.y:16027 -#: cobc/parser.y:16071 cobc/parser.y:16115 -msgid "NOT EXCEPTION before EXCEPTION" -msgstr "NOT EXCEPTION före EXCEPTION" - -#: cobc/parser.y:12041 -#, fuzzy, c-format -msgid "HANDLE must be a %s HANDLE" -msgstr "HANDLE mÃ¥ste vara antingen en generisk eller ett THREAD HANDLE" - -#: cobc/parser.y:12053 -#, fuzzy -msgid "HANDLE must be a generic HANDLE" -msgstr "HANDLE mÃ¥ste vara antingen en generisk eller ett THREAD HANDLE" - -#: cobc/parser.y:12130 -#, c-format -msgid "HANDLE clause invalid for %s" -msgstr "HANDLE-klausul ogiltig för %s" - -#: cobc/parser.y:12361 cobc/parser.y:15495 -#, c-format -msgid "%s is invalid in nested program" -msgstr "%s är ogiltig i nästlat program" - -#: cobc/parser.y:12399 cobc/parser.y:12440 cobc/parser.y:12451 -#: cobc/parser.y:12462 -#, c-format -msgid "maximum evaluate depth exceeded (%d)" -msgstr "maximalt beräkningsdjup överskreds (%d)" - -#: cobc/parser.y:12503 cobc/parser.y:12513 -msgid "WHEN without imperative statement" -msgstr "" - -#: cobc/parser.y:12531 cobc/parser.y:12541 -msgid "WHEN OTHER without imperative statement" -msgstr "" - -#: cobc/parser.y:12621 -msgid "invalid THROUGH usage" -msgstr "ogiltig THROUGH-användning" - -#: cobc/parser.y:12700 -msgid "EXIT PROGRAM is not allowed within a USE GLOBAL procedure" -msgstr "EXIT PROGRAM är inte tillÃ¥tet inom en USE GLOBAL-procedur" - -#: cobc/parser.y:12704 -msgid "EXIT PROGRAM not allowed within a FUNCTION" -msgstr "EXIT PROGRAM är inte tillÃ¥tet inom en FUNCTION" - -#: cobc/parser.y:12713 cobc/parser.y:12926 -#, fuzzy -msgid "RETURNING/GIVING not allowed for non-returning runtime elements" -msgstr "RETURNING/GIVING inte tillÃ¥tet för icke-returnerande källor" - -#: cobc/parser.y:12725 -msgid "EXIT FUNCTION is not allowed within a USE GLOBAL procedure" -msgstr "EXIT FUNCTION är inte tillÃ¥tet inom en USE GLOBAL-procedur" - -#: cobc/parser.y:12729 -msgid "EXIT FUNCTION only allowed within a FUNCTION" -msgstr "EXIT FUNCTION endast tillÃ¥tet inom en FUNCTION" - -#: cobc/parser.y:12743 cobc/parser.y:12766 -msgid "EXIT PERFORM is only valid with inline PERFORM" -msgstr "EXIT PERFORM är endast giltigt med inline PERFORM" - -#: cobc/parser.y:12788 -msgid "EXIT SECTION is only valid with an active SECTION" -msgstr "EXIT SECTION är endast giltig med en aktiv SECTION" - -#: cobc/parser.y:12809 -msgid "EXIT PARAGRAPH is only valid with an active PARAGRAPH" -msgstr "EXIT PARAGRAPH är endast giltig med en aktiv PARAGRAPH" - -#: cobc/parser.y:12956 -msgid "IF without imperative statement" -msgstr "" - -#: cobc/parser.y:13173 -msgid "TALLYING clause is incomplete" -msgstr "TALLYING-klausul är ofullständig" - -#: cobc/parser.y:13289 -msgid "INSPECT missing ALL/FIRST/LEADING/TRAILING" -msgstr "INSPECT saknar ALL/FIRST/LEADING/TRAILING" - -#: cobc/parser.y:13407 -msgid "JSON PARSE" -msgstr "" - -#: cobc/parser.y:13552 -msgid "LOCK clauses" -msgstr "LOCK-klausuler" - -#: cobc/parser.y:13717 -msgid "inline PERFORM without imperative statement" -msgstr "" - -#: cobc/parser.y:13838 cobc/parser.y:13846 cobc/parser.y:13854 -#, c-format -msgid "PERFORM VARYING '%s' (line %d of %s) is not a numeric field" -msgstr "" - -#: cobc/parser.y:13870 -#, fuzzy -msgid "PERFORM VARYING without BY phrase" -msgstr "ODO utan TO-fras" - -#: cobc/parser.y:13910 -#, fuzzy, c-format -msgid "'%s' is not an object-reference" -msgstr "â€%s†är inte ett heltal" - -#: cobc/parser.y:13951 cobc/typeck.c:10958 cobc/typeck.c:12100 -msgid "LOCK clause invalid with file LOCK AUTOMATIC" -msgstr "LOCK-klausul ogiltig med fil LOCK AUTOMATIC" - -#: cobc/parser.y:13956 -msgid "KEY clause invalid with this file type" -msgstr "KEY-klausul ogiltig med denna filtyp" - -#: cobc/parser.y:13961 cobc/typeck.c:10954 cobc/typeck.c:12096 -msgid "INVALID KEY clause invalid with this file type" -msgstr "INVALID KEY-klausul ogiltig med denna filtyp" - -#: cobc/parser.y:14591 -msgid "file sort requires KEY phrase" -msgstr "filsortering kräver KEY-fras" - -#: cobc/parser.y:14615 -#, fuzzy -msgid "table SORT requires KEY phrase" -msgstr "filsortering kräver KEY-fras" - -#: cobc/parser.y:14677 -msgid "file sort requires USING or INPUT PROCEDURE" -msgstr "filsortering kräver USING eller INPUT PROCEDURE" - -#: cobc/parser.y:14684 -msgid "USING invalid with table SORT" -msgstr "USING ogiltig med tabell SORT" - -#: cobc/parser.y:14694 -msgid "INPUT PROCEDURE invalid with table SORT" -msgstr "INPUT PROCEDURE ogiltig med tabell SORT" - -#: cobc/parser.y:14696 -msgid "INPUT PROCEDURE invalid with MERGE" -msgstr "INPUT PROCEDURE ogiltig med MERGE" - -#: cobc/parser.y:14709 -msgid "file sort requires GIVING or OUTPUT PROCEDURE" -msgstr "filsortering kräver GIVING eller OUTPUT PROCEDURE" - -#: cobc/parser.y:14716 -msgid "GIVING invalid with table SORT" -msgstr "GIVING ogiltig med tabell SORT" - -#: cobc/parser.y:14726 -msgid "OUTPUT PROCEDURE invalid with table SORT" -msgstr "OUTPUT PROCEDURE ogiltig med tabell SORT" - -#: cobc/parser.y:14753 -msgid "SIZE/LENGTH invalid here" -msgstr "SIZE/LENGTH ogiltigt här" - -#: cobc/parser.y:14806 -msgid "NOT EQUAL condition not allowed on START statement" -msgstr "NOT EQUAL-villkor inte tillÃ¥tet för START-sats" - -#: cobc/parser.y:14872 -#, c-format -msgid "%s is replaced by %s" -msgstr "%s ersätts av %s" - -#: cobc/parser.y:14925 -msgid "STOP literal" -msgstr "STOP-litteral" - -#: cobc/parser.y:14929 -msgid "STOP identifier" -msgstr "STOP-identifierare" - -#: cobc/parser.y:15066 -msgid "SUPPRESS statement must be within DECLARATIVES" -msgstr "SUPPRESS-sats mÃ¥ste placeras inom DECLARATIVES" - -#: cobc/parser.y:15140 -msgid "UNLOCK invalid for SORT files" -msgstr "UNLOCK ogiltigt för SORT-filer" - -#: cobc/parser.y:15276 cobc/parser.y:15355 -msgid "USE statement must be within DECLARATIVES" -msgstr "USE-sats mÃ¥ste placeras inom DECLARATIVES" - -#: cobc/parser.y:15278 -msgid "SECTION header missing before USE statement" -msgstr "SECTION-huvud saknas före USE-sats" - -#: cobc/parser.y:15357 -msgid "USE DEBUGGING not supported in contained program" -msgstr "USE DEBUGGING stöds inte i inneslutet program" - -#: cobc/parser.y:15405 cobc/parser.y:15414 cobc/parser.y:15432 -#: cobc/parser.y:15468 cobc/typeck.c:3792 -#, fuzzy, c-format -msgid "duplicate DEBUGGING target: '%s'" -msgstr "duplicerat DEFINE-direktiv â€%sâ€" - -#: cobc/parser.y:15430 -#, fuzzy -msgid "constant item cannot be used here" -msgstr "en konstant kan inte användas här - â€%sâ€" - -#: cobc/parser.y:15456 -msgid "duplicate USE DEBUGGING ON ALL PROCEDURES" -msgstr "duplicerade USE DEBUGGING ON ALL PROCEDURES" - -#: cobc/parser.y:15528 -#, fuzzy, c-format -msgid "'%s' is not a report group" -msgstr "â€%s†är inte ett rapportnamn" - -#: cobc/parser.y:15710 -msgid "ENCODING clause must come before XML-DECLARATION" -msgstr "" - -#: cobc/parser.y:15712 -msgid "ENCODING clause must come before ATTRIBUTES" -msgstr "" - -#: cobc/parser.y:15715 -msgid "XML GENERATE ENCODING clause" -msgstr "" - -#: cobc/parser.y:15722 -msgid "XML-DECLARATION clause must come before ATTRIBUTES" -msgstr "" - -#: cobc/parser.y:15725 -msgid "XML GENERATE XML-DECLARATION clause" -msgstr "" - -#: cobc/parser.y:15731 -msgid "XML GENERATE WITH ATTRIBUTES clause" -msgstr "" - -#: cobc/parser.y:15744 -msgid "XML GENERATE NAMESPACE clause" -msgstr "" - -#: cobc/parser.y:15768 -msgid "XML GENERATE NAME OF clause" -msgstr "" - -#: cobc/parser.y:15799 -msgid "XML GENERATE TYPE OF clause" -msgstr "" - -#: cobc/parser.y:15840 -msgid "XML GENERATE SUPPRESS clause" -msgstr "" - -#: cobc/parser.y:15914 -msgid "XML PARSE" -msgstr "" - -#: cobc/parser.y:15955 cobc/parser.y:16633 cobc/parser.y:16729 -#: cobc/parser.y:16815 -#, c-format -msgid "'%s' is not a file name" -msgstr "â€%s†är inte ett filnamn" - -#: cobc/parser.y:16161 -msgid "NOT SIZE ERROR before SIZE ERROR" -msgstr "NOT SIZE ERROR före SIZE ERROR" - -#: cobc/parser.y:16207 -msgid "NOT OVERFLOW before OVERFLOW" -msgstr "NOT OVERFLOW före OVERFLOW" - -#: cobc/parser.y:16306 -msgid "NOT AT END-OF-PAGE before AT END-OF-PAGE" -msgstr "NOT AT END-OF-PAGE före AT END-OF-PAGE" - -#: cobc/parser.y:16356 -msgid "NOT INVALID KEY before INVALID KEY" -msgstr "NOT INVALID KEY före INVALID KEY" - -#: cobc/parser.y:16619 -msgid "LINAGE-COUNTER must be qualified here" -msgstr "LINAGE-COUNTER mÃ¥ste kvalificeras här" - -#: cobc/parser.y:16622 -msgid "invalid LINAGE-COUNTER usage" -msgstr "ogiltig LINAGE-COUNTER-användning" - -#: cobc/parser.y:16643 -msgid "LINE-COUNTER must be qualified here" -msgstr "LINE-COUNTER mÃ¥ste kvalificeras här" - -#: cobc/parser.y:16647 -msgid "invalid LINE-COUNTER usage" -msgstr "ogiltig LINE-COUNTER-användning" - -#: cobc/parser.y:16658 cobc/parser.y:16683 -#, c-format -msgid "'%s' is not a report name" -msgstr "â€%s†är inte ett rapportnamn" - -#: cobc/parser.y:16668 -msgid "PAGE-COUNTER must be qualified here" -msgstr "PAGE-COUNTER mÃ¥ste kvalificeras här" - -#: cobc/parser.y:16672 -msgid "invalid PAGE-COUNTER usage" -msgstr "ogiltig PAGE-COUNTER-användning" - -#: cobc/parser.y:16719 cobc/typeck.c:10919 cobc/typeck.c:11004 -#: cobc/typeck.c:12064 -#, c-format -msgid "%s requires a record name as subject" -msgstr "%s kräver ett postnamn som ämne" - -#: cobc/parser.y:16746 -#, c-format -msgid "'%s' not indexed" -msgstr "â€%s†är inte indexerat" - -#: cobc/parser.y:16772 cobc/parser.y:16797 -#, c-format -msgid "multiple reference to '%s' " -msgstr "flera referenser till â€%s†" - -#: cobc/parser.y:16827 -#, c-format -msgid "'%s' is not a CD name" -msgstr "â€%s†är inte ett CD-namn" - -#: cobc/parser.y:16841 -#, fuzzy, c-format -msgid "'%s' is not a valid report name" -msgstr "â€%s†är inte ett rapportnamn" - -#: cobc/parser.y:17092 -msgid "invalid mnemonic identifier" -msgstr "ogiltig mnemonic-identifierare" - -#: cobc/parser.y:17172 -#, fuzzy -msgid "a numeric literal is expected here" -msgstr "en icke-numerisk litteral förväntas för â€%sâ€" - -#: cobc/parser.y:17184 cobc/parser.y:17886 -#, fuzzy -msgid "a non-numeric literal is expected here" -msgstr "en icke-numerisk litteral förväntas för â€%sâ€" - -#: cobc/parser.y:17357 cobc/typeck.c:6116 cobc/typeck.c:6123 -#, c-format -msgid "'%s' is not numeric" -msgstr "â€%s†är inte numeriskt" - -#: cobc/parser.y:17373 -#, c-format -msgid "'%s' is not a field or file" -msgstr "â€%s†är inte ett fält eller en fil" - -#: cobc/parser.y:17393 cobc/parser.y:17411 -#, c-format -msgid "'%s' is not a field" -msgstr "â€%s†är inte ett fält" - -#: cobc/parser.y:17533 -#, fuzzy, c-format -msgid "'%s' is not a field or alphabet" -msgstr "â€%s†är inte ett fält eller en fil" - -#: cobc/parser.y:17559 -#, fuzzy -msgid "a subscripted data-item cannot be used here" -msgstr "â€%s†kan inte användas här" - -#: cobc/parser.y:17609 -#, fuzzy -msgid "unsigned integer value expected" -msgstr "teckenlöst positivt heltalsvärde förväntades" - -#: cobc/parser.y:17621 cobc/parser.y:17625 cobc/parser.y:17675 -msgid "integer value expected" -msgstr "heltalsvärde förväntades" - -#: cobc/parser.y:17630 -msgid "invalid symbolic integer" -msgstr "ogiltigt symboliskt heltal" - -#: cobc/parser.y:17646 cobc/parser.y:17650 -msgid "unsigned positive integer value expected" -msgstr "teckenlöst positivt heltalsvärde förväntades" - -#: cobc/parser.y:17679 -msgid "invalid CLASS value" -msgstr "ogiltigt CLASS-värde" - -#: cobc/parser.y:17767 -msgid "PHYSICAL argument for LENGTH functions" -msgstr "" - -#: cobc/parser.y:17938 cobc/parser.y:17955 -msgid "cannot specify offset and SYSTEM-OFFSET at the same time" -msgstr "kan inte samtidigt ange position och SYSTEM-OFFSET" - -#: cobc/pplex.l:223 cobc/pplex.l:1739 -msgid "debugging indicator" -msgstr "felsökningsindikator" - -#: cobc/pplex.l:300 -msgid "ignoring empty directive" -msgstr "hoppar över tomt direktiv" - -#: cobc/pplex.l:310 cobc/pplex.l:369 -#, c-format -msgid "ignoring invalid directive: '%s'" -msgstr "hoppar över ogiltigt direktiv: â€%sâ€" - -#: cobc/pplex.l:317 -msgid "ignoring invalid directive" -msgstr "hoppar över ogiltigt direktiv" - -#: cobc/pplex.l:324 -msgid "VCS directive" -msgstr "VCS-direktiv" - -#: cobc/pplex.l:377 cobc/pplex.l:392 -msgid "spurious '$' detected - ignored" -msgstr "vilsekommet â€$†hittat - hoppas över" - -#: cobc/pplex.l:386 -#, fuzzy, c-format -msgid "ignoring unknown directive: '%s'" -msgstr "hoppar över ogiltigt direktiv: â€%sâ€" - -#: cobc/pplex.l:398 -msgid "PROCESS statement ignored" -msgstr "PROCESS-sats överhoppad" - -#: cobc/pplex.l:864 -msgid "IF/ELIF/ELSE directive without matching END-IF" -msgstr "IF/ELIF/ELSE-direktiv utan matchande END-IF" - -#: cobc/pplex.l:981 -#, fuzzy -msgid "file was included here" -msgstr "konfigurationsfil inkluderades här" - -#: cobc/pplex.l:1186 -#, c-format -msgid "directive nest depth exceeded: %d" -msgstr "djup för direktivnästling överskreds: %d" - -#: cobc/pplex.l:1204 -msgid "ELSE directive without matching IF/ELIF" -msgstr "ELSE-direktiv utan matchande IF/ELIF" - -#: cobc/pplex.l:1220 -msgid "END-IF directive without matching IF/ELIF/ELSE" -msgstr "END-IF-direktiv utan matchande IF/ELIF/ELSE" - -#: cobc/pplex.l:1236 -msgid "ELIF directive without matching IF/ELIF" -msgstr "ELIF-direktiv utan matchande IF/ELIF" - -#: cobc/pplex.l:1258 -#, c-format -msgid "invalid internal case: %u" -msgstr "ogiltigt internt fall: %u" - -#: cobc/pplex.l:1395 -msgid "buffer overrun - too many continuation lines" -msgstr "buffertöverspill - för mÃ¥nga fortsättningsrader" - -#: cobc/pplex.l:1485 cobc/pplex.l:1494 -msgid "line not terminated by a newline" -msgstr "rad inte avslutad av nyrad" - -#: cobc/pplex.l:1488 cobc/pplex.l:1497 -#, c-format -msgid "source text exceeds %d bytes, will be truncated" -msgstr "källkodstext överstiger %d byte, kommer att trunkeras" - -#: cobc/pplex.l:1516 -msgid "version control conflict marker in file" -msgstr "" - -#: cobc/pplex.l:1727 -msgid "invalid continuation in comment entry" -msgstr "ogiltig fortsättning i kommentarspost" - -#: cobc/pplex.l:1732 -msgid "continuation of COBOL words" -msgstr "fortsättning av COBOL-ord" - -#: cobc/pplex.l:1752 -#, c-format -msgid "invalid indicator '%c' at column 7" -msgstr "ogiltig indikator â€%c†i kolumn 7" - -#: cobc/pplex.l:1800 cobc/pplex.l:1811 -msgid "invalid line continuation" -msgstr "ogiltig radfortsättning" - -#: cobc/pplex.l:1819 -msgid "continuation character expected" -msgstr "fortsättningstecken förväntades" - -#: cobc/pplex.l:1885 -#, c-format -msgid "source text after program-text area (column %d)" -msgstr "källkodstext efter omrÃ¥de för programtext (kolumn %d)" - -#: cobc/ppparse.y:225 -msgid "directive comparison on different types" -msgstr "direktivjämförelse för olika typer" - -#: cobc/ppparse.y:293 -#, c-format -msgid "duplicate DEFINE directive '%s'" -msgstr "duplicerat DEFINE-direktiv â€%sâ€" - -#: cobc/ppparse.y:300 cobc/ppparse.y:310 -msgid "invalid constant in DEFINE directive" -msgstr "ogiltig konstant i DEFINE-direktiv" - -#: cobc/ppparse.y:408 -#, c-format -msgid "compiler flag '%s' unknown" -msgstr "" - -#: cobc/ppparse.y:454 -#, fuzzy, c-format -msgid "invalid %s directive option '%s'" -msgstr "ogiltigt %s-direktiv" - -#: cobc/ppparse.y:667 -msgid "*CONTROL statement" -msgstr "*CONTROL-sats" - -#: cobc/ppparse.y:933 cobc/ppparse.y:1004 cobc/ppparse.y:1141 -#, c-format -msgid "invalid %s directive" -msgstr "ogiltigt %s-direktiv" - -#: cobc/ppparse.y:1043 -msgid "LEAP-SECOND ON directive" -msgstr "LEAP-SECOND ON-direktiv" - -#: cobc/ppparse.y:1051 -msgid "TURN directive" -msgstr "TURN-direktiv" - -#: cobc/ppparse.y:1133 cobc/ppparse.y:1158 -msgid "invalid constant" -msgstr "ogiltig konstant" - -#: cobc/reserved.c:3797 -msgid "device name" -msgstr "enhetsnamn" - -#: cobc/reserved.c:3800 -msgid "switch name" -msgstr "växelnamn" - -#: cobc/reserved.c:3803 -msgid "feature name" -msgstr "funktionsnamn" - -#: cobc/reserved.c:3902 -#, c-format -msgid "reserved word must have less than %d characters" -msgstr "reserverat ord mÃ¥ste ha färre än %d tecken" - -#: cobc/reserved.c:3921 -msgid "ignored asterisk at end of alias target" -msgstr "överhoppad asterisk vid slutet av alias-mÃ¥l" - -#: cobc/reserved.c:3984 -#, c-format -msgid "alias target '%s' is not a default reserved word" -msgstr "alias mÃ¥l â€%s†är inte ett standardreserverat ord" - -#: cobc/reserved.c:4447 -#, c-format -msgid "invalid system-name '%s'" -msgstr "ogiltigt systemnamn â€%sâ€" - -#: cobc/reserved.c:4584 -#, c-format -msgid "'%s' is a reserved word, but isn't supported" -msgstr "â€%s†är ett reserverat ord, men det stöds inte" - -#: cobc/reserved.c:4689 -#, c-format -msgid "intrinsic function %s is unknown" -msgstr "inbyggd funktion %s är okänd" - -#: cobc/reserved.c:4717 -msgid "Intrinsic Function" -msgstr "Inbyggd funktion" - -#: cobc/reserved.c:4717 cobc/reserved.c:4897 cobc/reserved.c:5034 -msgid "Implemented" -msgstr "Implementerad" - -#: cobc/reserved.c:4717 cobc/typeck.c:1022 -msgid "Parameters" -msgstr "Parametrar" - -#: cobc/reserved.c:4721 cobc/reserved.c:4901 cobc/reserved.c:5048 -msgid "Yes" -msgstr "Ja" - -#: cobc/reserved.c:4724 cobc/reserved.c:4904 cobc/reserved.c:5054 -msgid "No" -msgstr "Nej" - -#: cobc/reserved.c:4730 -msgid "Unlimited" -msgstr "Obegränsat" - -#: cobc/reserved.c:4804 -#, fuzzy, c-format -msgid "special register %s is unknown, needs a definition" -msgstr "specialregister %s är okänt, behöver en definition" - -#: cobc/reserved.c:4810 -#, c-format -msgid "special register %s is unknown" -msgstr "specialregister %s är okänt" - -#: cobc/reserved.c:4897 -msgid "Internal registers" -msgstr "Interna register" - -#: cobc/reserved.c:4897 -msgid "Definition" -msgstr "Definition" - -#: cobc/reserved.c:4985 -#, fuzzy, c-format -msgid "unknown system-name '%s'" -msgstr "okänd sats â€%sâ€" - -#: cobc/reserved.c:5011 -msgid "System names" -msgstr "Systemnamn" - -#: cobc/reserved.c:5034 -msgid "Reserved Words" -msgstr "Reserverad ord" - -#: cobc/reserved.c:5046 -msgid "Yes (Context sensitive)" -msgstr "Ja (sammanhangskänsligt)" - -#: cobc/reserved.c:5052 -msgid "No (Context sensitive)" -msgstr "Nej (sammanhangskänsligt)" - -#: cobc/reserved.c:5081 -msgid "Extra (obsolete) context sensitive words" -msgstr "Extra (förÃ¥ldrade) sammanhangskänsliga ord" - -#: cobc/scanner.l:265 cobc/scanner.l:2288 -#, fuzzy, c-format -msgid "'%s' is not a default reserved word, so cannot be aliased" -msgstr "â€%s†är inte definierad, men är ett reserverat ord i en annan dialekt" - -#: cobc/scanner.l:268 -#, fuzzy, c-format -msgid "'%s' is not a reserved word; you may want ADDSYN or OVERRIDE instead" -msgstr "â€%s†är ett reserverat ord, men det stöds inte" - -#: cobc/scanner.l:988 -#, c-format -msgid "a constant may not be used here - '%s'" -msgstr "en konstant kan inte användas här - â€%sâ€" - -#: cobc/scanner.l:1043 -msgid "ignoring redundant ." -msgstr "hoppar över överflödig ." - -#: cobc/scanner.l:1101 -#, c-format -msgid "invalid symbol '%s' - skipping word" -msgstr "ogiltig symbol â€%s†- hoppar över ord" - -#: cobc/scanner.l:1191 -msgid "invalid national literal" -msgstr "ogiltig nationell litteral" - -#: cobc/scanner.l:1202 cobc/tree.c:2531 -#, c-format -msgid "invalid literal: '%s'" -msgstr "ogiltig litteral: â€%sâ€" - -#: cobc/scanner.l:1204 -#, c-format -msgid "invalid hexadecimal literal: '%s'" -msgstr "ogiltig hexadecimal litteral: â€%sâ€" - -#: cobc/scanner.l:1206 cobc/tree.c:1613 -#, c-format -msgid "invalid numeric literal: '%s'" -msgstr "ogiltig numerisk litteral: â€%sâ€" - -#: cobc/scanner.l:1208 -#, c-format -msgid "invalid floating-point literal: '%s'" -msgstr "ogiltig flyttalslitteral: â€%sâ€" - -#: cobc/scanner.l:1210 -#, c-format -msgid "invalid %s literal: '%s'" -msgstr "ogiltig %s-litteral: â€%sâ€" - -#: cobc/scanner.l:1261 -#, c-format -msgid "literal length exceeds %d characters" -msgstr "litterallängd överskrider %d tecken" - -#: cobc/scanner.l:1277 cobc/scanner.l:1326 cobc/scanner.l:1620 -#, fuzzy -msgid "zero-length literal" -msgstr "numerisk-boolesk litteral" - -#: cobc/scanner.l:1280 -#, fuzzy -msgid "national literal has zero length; a SPACE will be assumed" -msgstr "alfanumerisk litteral har längd noll; ett SPACE antas" - -#: cobc/scanner.l:1281 -msgid "alphanumeric literal has zero length; a SPACE will be assumed" -msgstr "alfanumerisk litteral har längd noll; ett SPACE antas" - -#: cobc/scanner.l:1293 cobc/scanner.l:1294 cobc/scanner.l:1298 -#: cobc/scanner.l:1365 -msgid "national literal" -msgstr "nationell litteral" - -#: cobc/scanner.l:1297 -#, fuzzy -msgid "national-character literal" -msgstr "nationell litteral" - -#: cobc/scanner.l:1330 -#, fuzzy -msgid "hexadecimal literal has zero length; X'00' will be assumed" -msgstr "alfanumerisk litteral har längd noll; ett SPACE antas" - -#: cobc/scanner.l:1349 -msgid "hexadecimal-boolean literal" -msgstr "hexadecimal-boolesk litteral" - -#: cobc/scanner.l:1356 cobc/scanner.l:1370 cobc/scanner.l:1485 -#: cobc/scanner.l:1544 cobc/scanner.l:1642 cobc/scanner.l:1711 cobc/tree.c:2532 -#, c-format -msgid "literal length %d exceeds %d characters" -msgstr "litterallängd %d överskrider %d tecken" - -#: cobc/scanner.l:1362 -msgid "hexadecimal-national literal" -msgstr "hexadecimal-nationell litteral" - -#: cobc/scanner.l:1393 cobc/scanner.l:1425 cobc/scanner.l:1560 -#: cobc/scanner.l:1656 cobc/scanner.l:1721 -#, c-format -msgid "literal contains invalid character '%c'" -msgstr "litteral innehÃ¥ller ogiltigt tecken â€%câ€" - -#: cobc/scanner.l:1449 -#, c-format -msgid "literal does not have an even number of digits" -msgstr "litteral har inte ett jämnt antal siffror" - -#: cobc/scanner.l:1492 -#, fuzzy, c-format -msgid "%s literals must contain at least one character" -msgstr "litteral innehÃ¥ller ogiltigt tecken â€%câ€" - -#: cobc/scanner.l:1527 cobc/scanner.l:1628 cobc/scanner.l:1702 -msgid "ACUCOBOL numeric literal" -msgstr "ACUCOBOL-numerisk litteral" - -#: cobc/scanner.l:1537 -#, fuzzy -msgid "H literals must contain at least one character" -msgstr "litteral innehÃ¥ller ogiltigt tecken â€%câ€" - -#: cobc/scanner.l:1575 cobc/scanner.l:1667 cobc/scanner.l:1732 -#, c-format -msgid "literal exceeds limit %u" -msgstr "litteral överskred gräns %u" - -#: cobc/scanner.l:1616 -msgid "numeric boolean literal" -msgstr "numerisk-boolesk litteral" - -#: cobc/scanner.l:1622 -#, fuzzy -msgid "Boolean literal has zero length; B'0' will be assumed" -msgstr "alfanumerisk litteral har längd noll; ett SPACE antas" - -#: cobc/scanner.l:1698 -#, fuzzy -msgid "HP COBOL octal literal" -msgstr "ACUCOBOL-numerisk litteral" - -#: cobc/scanner.l:1810 cobc/tree.c:1624 -#, c-format -msgid "literal length %d exceeds maximum of %d digits" -msgstr "litterallängd %d överskriver maximala %d siffror" - -#: cobc/scanner.l:1816 cobc/tree.c:1629 -#, c-format -msgid "literal length %d exceeds %d digits" -msgstr "litterallängd %d överskriver %d siffror" - -#: cobc/scanner.l:1928 cobc/tree.c:3513 -#, fuzzy, c-format -msgid "significand has more than %d digits" -msgstr "mantissa har fler än 34 siffror" - -#: cobc/scanner.l:1933 -#, c-format -msgid "exponent has decimal point" -msgstr "exponent har decimalpunkt" - -#: cobc/scanner.l:1939 cobc/tree.c:3521 -#, c-format -msgid "exponent has more than 4 digits" -msgstr "exponent har fler än 4 tecken" - -#: cobc/scanner.l:1969 -#, fuzzy, c-format -msgid "exponent not between -6143 and 6144" -msgstr "exponent inte mellan -78 och 76" - -#: cobc/scanner.l:1978 -#, c-format -msgid "significand of 0 must be positive" -msgstr "en mantissa som är 0 mÃ¥ste vara positiv" - -#: cobc/scanner.l:1983 -#, c-format -msgid "exponent of 0 must be 0" -msgstr "en exponent för 0 mÃ¥ste vara 0" - -#: cobc/scanner.l:1988 -#, c-format -msgid "exponent of 0 must be positive" -msgstr "en exponent för 0 mÃ¥ste vara positiv" - -#: cobc/scanner.l:2170 -#, c-format -msgid "invalid CONSTANT: %s" -msgstr "ogiltig CONSTANT: %s" - -#: cobc/scanner.l:2180 -#, c-format -msgid "invalid alphanumeric CONSTANT: %s" -msgstr "ogiltig alfanumerisk CONSTANT: %s" - -#: cobc/scanner.l:2184 -#, c-format -msgid "empty alphanumeric CONSTANT: %s" -msgstr "tom alfanumerisk CONSTANT: %s" - -#: cobc/scanner.l:2201 cobc/scanner.l:2209 cobc/scanner.l:2214 -#, c-format -msgid "invalid numeric CONSTANT: %s" -msgstr "ogiltig numerisk CONSTANT: %s" - -#: cobc/scanner.l:2291 -#, c-format -msgid "'%s' is already reserved; you may want MAKESYN instead" -msgstr "" - -#: cobc/tree.c:341 -#, c-format -msgid "%s clause is required for file '%s'" -msgstr "%s-klausul krävs för fil â€%sâ€" - -#: cobc/tree.c:345 -#, c-format -msgid "%s clause is invalid for file '%s' (file type)" -msgstr "%s-klausul är ogiltig för fil â€%s†(filtyp)" - -#: cobc/tree.c:349 -#, c-format -msgid "%s clause is invalid for file '%s'" -msgstr "%s-klausul är ogiltig för fil â€%sâ€" - -#: cobc/tree.c:376 -#, c-format -msgid "FOR item '%s' is a record" -msgstr "FOR-objekt â€%s†är en post" - -#: cobc/tree.c:385 -#, c-format -msgid "FOR item '%s' is in different record to '%s'" -msgstr "FOR-objekt â€%s†är i en annan post än â€%sâ€" - -#: cobc/tree.c:394 -#, c-format -msgid "FOR item '%s' is not in a record associated with '%s'" -msgstr "FOR-objekt â€%s†är inte en post associerad med â€%sâ€" - -#: cobc/tree.c:477 -msgid "internal error node" -msgstr "intern felnod" - -#: cobc/tree.c:479 -msgid "unknown constant" -msgstr "okänd konstant" - -#: cobc/tree.c:639 -#, fuzzy, c-format -msgid "FUNCTION %s has invalid/not supported arguments - tag %d" -msgstr "FUNCTION %s har ogiltiga argument, eller argument som inte stöds - Tagg %d" - -#: cobc/tree.c:760 -#, c-format -msgid "invalid date/time function: '%d'" -msgstr "ogiltig datum-/tidsfunktion: â€%dâ€" - -#: cobc/tree.c:798 -#, c-format -msgid "FUNCTION '%s' has invalid date/time format" -msgstr "FUNCTION â€%s†har ogiltigt datum-/tidsformat" - -#: cobc/tree.c:805 -#, c-format -msgid "FUNCTION '%s' has format in variable" -msgstr "FUNCTION â€%s†har format i variabel" - -#: cobc/tree.c:1186 -#, fuzzy, c-format -msgid "literal '%s'" -msgstr "ogiltig litteral: â€%sâ€" - -#: cobc/tree.c:1315 -#, c-format -msgid "unknown tree tag: %d, category: %d" -msgstr "okänd trädtagg: %d, kategori: %d" - -#: cobc/tree.c:1405 -#, c-format -msgid "unexpected numeric USAGE: %d" -msgstr "oväntad numerisk USAGE: %d" - -#: cobc/tree.c:1419 -#, c-format -msgid "unexpected category: %d" -msgstr "oväntad kategori: %d" - -#: cobc/tree.c:1678 cobc/tree.c:1690 cobc/tree.c:1752 cobc/tree.c:1802 -#, c-format -msgid "numeric literal '%s' exceeds limit '%s'" -msgstr "numerisk litteral â€%s†överskrider gräns â€%sâ€" - -#: cobc/tree.c:2387 -msgid "invalid LOCALE literal" -msgstr "ogiltig LOCALE-litteral" - -#: cobc/tree.c:2512 -msgid "only literals with the same category can be concatenated" -msgstr "endast litteraler med samma kategori kan konkateneras" - -#: cobc/tree.c:2519 -#, fuzzy -msgid "only alphanumeric, national or boolean literals may be concatenated" -msgstr "endast alfanumeriska, nationella eller booleska litteraler kan konkateneras" - -#: cobc/tree.c:2791 -msgid "B, 0 or /" -msgstr "B, 0 eller /" - -#: cobc/tree.c:2805 -msgid "the sign of the floating-point exponent" -msgstr "tecknet pÃ¥ flyttalsexponenten" - -#: cobc/tree.c:2807 -msgid "a leading +/- sign" -msgstr "ett inledande +/--tecken" - -#: cobc/tree.c:2809 -msgid "a trailing +/- sign" -msgstr "ett efterföljande +/--tecken" - -#: cobc/tree.c:2811 -msgid "CR or DB" -msgstr "CR eller DB" - -#: cobc/tree.c:2813 -msgid "a leading currency symbol" -msgstr "en inledande valutasymbol" - -#: cobc/tree.c:2815 -msgid "a trailing currency symbol" -msgstr "en efterföljande valutasymbol" - -#: cobc/tree.c:2817 -msgid "a Z or * which is before the decimal point" -msgstr "ett Z eller * som kommer före decimalpunkten" - -#: cobc/tree.c:2819 -msgid "a Z or * which is after the decimal point" -msgstr "ett Z eller * som kommer efter decimalpunkten" - -#: cobc/tree.c:2821 -msgid "a floating +/- string which is before the decimal point" -msgstr "en flytande +/--sträng som kommer före decimalpunkten" - -#: cobc/tree.c:2823 -msgid "a floating +/- string which is after the decimal point" -msgstr "en flytande +/--sträng som kommer efter decimalpunkten" - -#: cobc/tree.c:2825 -msgid "a floating currency symbol string which is before the decimal point" -msgstr "en flytande valutasymbolsträng som kommer före decimalpunkten" - -#: cobc/tree.c:2827 -msgid "a floating currency symbol string which is after the decimal point" -msgstr "en flytande valutasymbolsträng som kommer efter decimalpunkten" - -#: cobc/tree.c:2831 -msgid "A or X" -msgstr "A eller X" - -#: cobc/tree.c:2837 -msgid "a P which is before the decimal point" -msgstr "ett P som kommer före decimalpunkten" - -#: cobc/tree.c:2839 -msgid "a P which is after the decimal point" -msgstr "ett P som kommer efter decimalpunkten" - -#: cobc/tree.c:2860 cobc/tree.c:3267 -#, c-format -msgid "%s may only occur once in a PICTURE string" -msgstr "%s fÃ¥r endast förekomma en gÃ¥ng i en PICTURE-sträng" - -#: cobc/tree.c:2862 cobc/tree.c:3219 -#, c-format -msgid "%s cannot follow %s" -msgstr "%s kan inte följa pÃ¥ %s" - -#: cobc/tree.c:2865 -msgid "invalid PICTURE string detected" -msgstr "ogiltig PICTURE-sträng hittad" - -#: cobc/tree.c:2976 -msgid "number or constant in parentheses is not an unsigned integer" -msgstr "nummer eller konstant i parenteser är inte ett teckenlöst heltal" - -#: cobc/tree.c:2985 -msgid "only up to 9 significant digits are permitted within parentheses" -msgstr "endast upp till 9 signifikanta siffror är tillÃ¥tna inom parenteser" - -#: cobc/tree.c:2991 -msgid "number or constant in parentheses must be greater than zero" -msgstr "nummer eller konstant i parenteser mÃ¥ste vara större än noll" - -#: cobc/tree.c:3002 -msgid "parentheses must be preceded by a picture symbol" -msgstr "" - -#: cobc/tree.c:3032 -msgid "unbalanced parentheses" -msgstr "obalanserade parenteser" - -#: cobc/tree.c:3040 -#, fuzzy -msgid "parentheses must contain an unsigned integer" -msgstr "parenteser mÃ¥ste innehÃ¥lla (ett konstantnamn definierat som) ett positivt heltal" - -#: cobc/tree.c:3078 -#, c-format -msgid "'%s' is not a constant-name" -msgstr "â€%s†är inte ett konstantnamn" - -#: cobc/tree.c:3085 -#, c-format -msgid "'%s' is not a numeric literal" -msgstr "â€%s†är inte en numerisk litteral" - -#: cobc/tree.c:3089 -#, c-format -msgid "'%s' is not an integer" -msgstr "â€%s†är inte ett heltal" - -#: cobc/tree.c:3093 -#, c-format -msgid "'%s' is not unsigned" -msgstr "â€%s†är inte teckenlöst" - -#: cobc/tree.c:3149 -msgid "missing PICTURE string" -msgstr "saknar PICTURE-sträng" - -#: cobc/tree.c:3178 -msgid "C must be followed by R" -msgstr "C mÃ¥ste följas av R" - -#: cobc/tree.c:3181 -msgid "D must be followed by B" -msgstr "D mÃ¥ste följas av B" - -#: cobc/tree.c:3195 cobc/tree.c:3264 cobc/tree.c:3290 cobc/tree.c:3401 -#, fuzzy -msgid "uncommon parentheses" -msgstr "obalanserade parenteser" - -#: cobc/tree.c:3219 -msgid "exponent" -msgstr "" - -#: cobc/tree.c:3272 -msgid "S must be at start of PICTURE string" -msgstr "S mÃ¥ste vara i början av PICTURE-sträng" - -#: cobc/tree.c:3328 -msgid "P must be at start or end of PICTURE string" -msgstr "P mÃ¥ste vara i början eller slutet av PICTURE-sträng" - -#: cobc/tree.c:3358 -msgid "cannot have both Z and * in PICTURE string" -msgstr "kan inte ha bÃ¥de Z och * i PICTURE-sträng" - -#: cobc/tree.c:3436 -#, c-format -msgid "invalid PICTURE character '%c'" -msgstr "ogiltigt PICTURE-tecken â€%câ€" - -#: cobc/tree.c:3466 -#, c-format -msgid "PICTURE string may not contain more than %d characters; contains %d characters" -msgstr "PICTURE-sträng fÃ¥r inte innehÃ¥lla mer än %d tecken; innehÃ¥ller %d tecken" - -#: cobc/tree.c:3471 -msgid "PICTURE string must contain at least one of the set A, N, X, Z, 1, 9 and *; or at least two of the set +, - and the currency symbol" -msgstr "PICTURE-sträng mÃ¥ste innehÃ¥lla Ã¥tminstone ett tecken frÃ¥n uppsättningen A, N, X, Z, 1, 9, eller *; eller Ã¥tminstone tvÃ¥ i mängden +, - och valutasymbolen" - -#: cobc/tree.c:3498 -#, c-format -msgid "numeric field cannot be larger than %d digits" -msgstr "numeriskt fält kan inte vara större än %d siffror" - -#: cobc/tree.c:3954 cobc/tree.c:3967 -#, c-format -msgid "no DETAIL line defined in report %s" -msgstr "" - -#: cobc/tree.c:3969 -msgid "PAGE LIMIT FIRST DETAIL should be >= HEADING" -msgstr "" - -#: cobc/tree.c:3972 -msgid "PAGE LIMIT FOOTING should be >= HEADING" -msgstr "" - -#: cobc/tree.c:3974 -msgid "PAGE LIMIT LAST DETAIL should be >= FIRST DETAIL" -msgstr "" - -#: cobc/tree.c:3976 -msgid "PAGE LIMIT FOOTING should be >= LAST DETAIL" -msgstr "" - -#: cobc/tree.c:3978 -msgid "PAGE LIMIT LINES should be >= FOOTING" -msgstr "" - -#: cobc/tree.c:4162 -#, c-format -msgid "maximum keys (%d/%d) exceeded for file '%s'" -msgstr "" - -#: cobc/tree.c:4226 cobc/tree.c:4249 -#, c-format -msgid "invalid KEY item '%s', not in file '%s'" -msgstr "ogiltigt KEY-objekt â€%sâ€, inte i fil â€%sâ€" - -#: cobc/tree.c:4260 -#, c-format -msgid "minimal record length %d can not hold the key item '%s'; needs to be at least %d" -msgstr "minimal postlängd %d kan inte hÃ¥lla nyckelobjekt â€%sâ€; behöver vara Ã¥tminstone %d" - -#: cobc/tree.c:4296 -#, fuzzy, c-format -msgid "missing file description for %s" -msgstr "saknar definitioner:" - -#: cobc/tree.c:4328 -#, c-format -msgid "size of record '%s' (%d) smaller than minimum of file '%s' (%d)" -msgstr "storlek för post â€%s†(%d) mindre än det minsta för fil â€%s†(%d)" - -#: cobc/tree.c:4331 cobc/tree.c:4348 -msgid "file size adjusted" -msgstr "" - -#: cobc/tree.c:4343 -#, c-format -msgid "size of record '%s' (%d) larger than maximum of file '%s' (%d)" -msgstr "storlek för post â€%s†(%d) större än det största för fil â€%s†(%d)" - -#: cobc/tree.c:4386 -#, c-format -msgid "file '%s': RECORD VARYING specified without limits, but implied limits are equal" -msgstr "" - -#: cobc/tree.c:4393 -#, c-format -msgid "file '%s': record size (IDX) %d exceeds maximum allowed (%d)" -msgstr "fil â€%sâ€: poststorlek (IDX) %d överstiger största tillÃ¥tna (%d)" - -#: cobc/tree.c:4397 -#, c-format -msgid "file '%s': record size %d exceeds maximum allowed (%d)" -msgstr "fil â€%sâ€: poststorlek %d överstiger största tillÃ¥tna (%d)" - -#: cobc/tree.c:4404 -msgid "RECORD DELIMITER clause on file with fixed-length records" -msgstr "" - -#: cobc/tree.c:4965 -#, fuzzy, c-format -msgid "literal '%.38s' is longer than '%s'" -msgstr "litteral är längre än fält" - -#: cobc/tree.c:4969 -#, c-format -msgid "literal '%.38s' is longer than reference-modification of '%s'" -msgstr "" - -#: cobc/tree.c:4994 -#, c-format -msgid "literal '%s' is alphanumeric but '%s' is numeric" -msgstr "" - -#: cobc/tree.c:5036 -#, c-format -msgid "literal '%s' has more decimals than '%s'" -msgstr "" - -#: cobc/tree.c:5078 -#, c-format -msgid "literal '%s' has more digits than '%s'" -msgstr "" - -#: cobc/tree.c:5118 cobc/tree.c:5142 -#, fuzzy, c-format -msgid "unsigned '%s' may not be %s %s" -msgstr "THRU-objekt â€%s†fÃ¥r inte vara underordnat â€%sâ€" - -#: cobc/tree.c:5128 cobc/tree.c:5151 -#, c-format -msgid "unsigned '%s' may always be %s %s" -msgstr "" - -#: cobc/tree.c:5184 cobc/tree.c:5209 -#, fuzzy, c-format -msgid "'%s' may not be %s %s" -msgstr "â€%s†kan inte användas här" - -#: cobc/tree.c:5195 cobc/tree.c:5220 -#, c-format -msgid "'%s' may always be %s %s" -msgstr "" - -#: cobc/tree.c:5355 -msgid "divide by constant ZERO" -msgstr "division med konstant ZERO" - -#: cobc/tree.c:5404 cobc/tree.c:5409 cobc/tree.c:5630 cobc/tree.c:5670 -#: cobc/typeck.c:4476 cobc/typeck.c:4484 cobc/typeck.c:4491 cobc/typeck.c:5561 -#: cobc/typeck.c:5706 -msgid "invalid expression" -msgstr "ogiltigt uttryck" - -#: cobc/tree.c:5627 -#, fuzzy, c-format -msgid "invalid expression: %s %s %s" -msgstr "ogiltigt uttryck" - -#: cobc/tree.c:5675 -#, c-format -msgid "unexpected operator: %d" -msgstr "oväntad operator: %d" - -#: cobc/tree.c:5685 -#, c-format -msgid "expression '%.38s' %s '%.38s' is always TRUE" -msgstr "uttryck â€%.38s†%s â€%.38s†är alltid TRUE" - -#: cobc/tree.c:5691 -msgid "expression is always TRUE" -msgstr "uttryck är alltid TRUE" - -#: cobc/tree.c:5703 -#, c-format -msgid "expression '%.38s' %s '%.38s' is always FALSE" -msgstr "uttryck â€%.38s†%s â€%.38s†är alltid FALSE" - -#: cobc/tree.c:5709 -msgid "expression is always FALSE" -msgstr "uttryck är alltid FALSE" - -#: cobc/tree.c:6024 -msgid "PERFORM FOREVER since UNTIL is always FALSE" -msgstr "PERFORM FOREVER dÃ¥ UNTIL är alltid FALSE" - -#: cobc/tree.c:6028 -msgid "PERFORM ONCE since UNTIL is always TRUE" -msgstr "PERFORM ONCE dÃ¥ UNTIL är alltid TRUE" - -#: cobc/tree.c:6031 -msgid "PERFORM NEVER since UNTIL is always TRUE" -msgstr "PERFORM NEVER dÃ¥ UNTIL alltid är TRUE" - -#: cobc/tree.c:6132 -#, fuzzy, c-format -msgid "no definition/prototype seen for FUNCTION '%s'" -msgstr "ingen definition/prototyp hittad för program â€%sâ€" - -#: cobc/tree.c:6134 -#, fuzzy, c-format -msgid "no definition/prototype seen for PROGRAM '%s'" -msgstr "ingen definition/prototyp hittad för program â€%sâ€" - -#: cobc/tree.c:6143 -#, fuzzy, c-format -msgid "no definition/prototype seen for FUNCTION with external name '%s'" -msgstr "ingen definition/prototyp hittad för program med externt namn â€%sâ€" - -#: cobc/tree.c:6145 -#, fuzzy, c-format -msgid "no definition/prototype seen for PROGRAM with external name '%s'" -msgstr "ingen definition/prototyp hittad för program med externt namn â€%sâ€" - -#: cobc/tree.c:6237 -#, fuzzy, c-format -msgid "FUNCTION %s has invalid argument" -msgstr "FUNCTION â€%s†har ogiltig parameter" - -#: cobc/tree.c:6239 -#, c-format -msgid "either all arguments or none should be if type %s" -msgstr "" - -#: cobc/tree.c:6271 cobc/tree.c:6277 cobc/tree.c:6319 cobc/tree.c:6324 -#, c-format -msgid "FUNCTION '%s' has invalid reference modification" -msgstr "FUNCTION â€%s†har ogiltig referensmodifiering" - -#: cobc/tree.c:6288 cobc/tree.c:6730 -#, c-format -msgid "FUNCTION '%s' unknown" -msgstr "FUNCTION â€%s†okänd" - -#: cobc/tree.c:6292 -#, c-format -msgid "FUNCTION '%s' is not implemented" -msgstr "FUNCTION â€%s†är inte implementerad" - -#: cobc/tree.c:6299 cobc/tree.c:6306 cobc/tree.c:6714 -#, c-format -msgid "FUNCTION '%s' has wrong number of arguments" -msgstr "FUNCTION â€%s†har fel antal argument" - -#: cobc/tree.c:6313 -#, c-format -msgid "FUNCTION '%s' cannot have reference modification" -msgstr "FUNCTION â€%s†fÃ¥r inte ha referensmodifiering" - -#: cobc/tree.c:6572 cobc/tree.c:6646 cobc/tree.c:6652 cobc/tree.c:6660 -#: cobc/tree.c:6668 -#, fuzzy, c-format -msgid "FUNCTION '%s' has invalid argument" -msgstr "FUNCTION â€%s†har ogiltig parameter" - -#: cobc/tree.c:6720 -#, fuzzy, c-format -msgid "FUNCTION '%s' has invalid first argument" -msgstr "FUNCTION â€%s†har ogiltig inledande parameter" - -#: cobc/typeck.c:686 -#, fuzzy, c-format -msgid "%s item not allowed here: '%s'" -msgstr "%s inte tillÃ¥tet här" - -#: cobc/typeck.c:728 -#, c-format -msgid "'%s' is not a group name" -msgstr "â€%s†är inte ett gruppnamn" - -#: cobc/typeck.c:753 -#, c-format -msgid "'%s' is not a numeric name" -msgstr "â€%s†är inte ett numeriskt namn" - -#: cobc/typeck.c:782 -#, c-format -msgid "'%s' is not a numeric or numeric-edited name" -msgstr "â€%s†är inte ett numeriskt eller redigerat numeriskt namn" - -#: cobc/typeck.c:835 -#, fuzzy, c-format -msgid "'%s' is Alpha, instead of a numeric value" -msgstr "â€%s†är inte ett numeriskt värde" - -#: cobc/typeck.c:838 -#, fuzzy, c-format -msgid "'%s' is Alpha Edited, instead of a numeric value" -msgstr "â€%s†är inte ett numeriskt värde" - -#: cobc/typeck.c:851 -#, c-format -msgid "'%s' is not a numeric value" -msgstr "â€%s†är inte ett numeriskt värde" - -#: cobc/typeck.c:901 -#, c-format -msgid "'%s' is not an integer value" -msgstr "â€%s†är inte ett heltalsvärde" - -#: cobc/typeck.c:905 -msgid "positive numeric integer is required here" -msgstr "positivt numeriskt heltal krävs här" - -#: cobc/typeck.c:1022 -msgid "System routine" -msgstr "Systemrutin" - -#: cobc/typeck.c:1638 libcob/call.c:1069 -#, c-format -msgid "'%s' literal includes leading spaces which are omitted" -msgstr "litteral â€%s†inkluderar inledande blanksteg som utelämnas" - -#: cobc/typeck.c:1642 -#, c-format -msgid "'%s' literal includes trailing spaces which are omitted" -msgstr "litteral â€%s†inkluderar efterföljande blanksteg som utelämnas" - -#: cobc/typeck.c:1709 -msgid "ON/OFF usage requires a SWITCH name" -msgstr "ON/OFF-användning kräver ett SWITCH-namn" - -#: cobc/typeck.c:1727 -#, c-format -msgid "word length exceeds maximum of %d characters: '%s'" -msgstr "ordlängd överstiger största antal tecken %d: â€%sâ€" - -#: cobc/typeck.c:1730 cobc/typeck.c:1733 -#, c-format -msgid "word length exceeds %d characters: '%s'" -msgstr "ordlängd överstiger %d tecken: â€%sâ€" - -#: cobc/typeck.c:1810 -#, fuzzy, c-format -msgid "ASSIGN %s interpreted as '%s'" -msgstr "ASSIGN-tolkat som %s" - -#: cobc/typeck.c:1900 cobc/typeck.c:2067 -#, c-format -msgid "subscript missing for '%s' - defaulting to 1" -msgstr "indexering saknas för â€%s†- antar standardvärdet 1" - -#: cobc/typeck.c:1913 cobc/typeck.c:1992 -#, c-format -msgid "'%s' cannot be reference modified" -msgstr "â€%s†kan inte referensmodifieras" - -#: cobc/typeck.c:1923 cobc/typeck.c:1988 cobc/typeck.c:2256 -#, c-format -msgid "'%s' cannot be subscripted" -msgstr "â€%s†kan inte indexeras" - -#: cobc/typeck.c:1927 cobc/typeck.c:2260 -#, c-format -msgid "'%s' requires one subscript" -msgstr "â€%s†kräver en indexering" - -#: cobc/typeck.c:1930 cobc/typeck.c:2263 -#, c-format -msgid "'%s' requires %d subscripts" -msgstr "â€%s†kräver %d indexeringar" - -#. TRANSLATORS: This msgid is used when a variable name -#. or label is referenced in a compiler message. -#: cobc/typeck.c:1946 -#, c-format -msgid "'%s'" -msgstr "" - -#: cobc/typeck.c:1948 -#, c-format -msgid "'%s' (accessed by '%s')" -msgstr "â€%s†(Ã¥tkomst via â€%sâ€)" - -#: cobc/typeck.c:2051 -#, c-format -msgid "'%s' has no OCCURS clause" -msgstr "â€%s†har ingen OCCURS-klausul" - -#: cobc/typeck.c:2108 libcob/common.c:3114 -#, c-format -msgid "subscript of '%s' out of bounds: %d" -msgstr "indexering â€%s†utanför intervall: %d" - -#: cobc/typeck.c:2162 cobc/typeck.c:2172 -#, fuzzy -msgid "offset must be greater than zero" -msgstr "nummer eller konstant i parenteser mÃ¥ste vara större än noll" - -#: cobc/typeck.c:2167 cobc/typeck.c:2185 cobc/typeck.c:2204 -#, fuzzy -msgid "length must be greater than zero" -msgstr "nummer eller konstant i parenteser mÃ¥ste vara större än noll" - -#: cobc/typeck.c:2175 cobc/typeck.c:2178 libcob/common.c:3136 -#, c-format -msgid "offset of '%s' out of bounds: %d" -msgstr "position â€%s†utanför intervall: %d" - -#: cobc/typeck.c:2189 cobc/typeck.c:2193 cobc/typeck.c:2207 cobc/typeck.c:2211 -#: libcob/common.c:3149 -#, c-format -msgid "length of '%s' out of bounds: %d" -msgstr "längd â€%s†utanför intervall: %d" - -#: cobc/typeck.c:2323 cobc/typeck.c:2407 -msgid "reference modification not allowed here" -msgstr "referensmodifiering inte tillÃ¥ten här" - -#: cobc/typeck.c:2337 cobc/typeck.c:2433 -msgid "88 level item not allowed here" -msgstr "nivÃ¥ 88-objekt inte tillÃ¥tet här" - -#: cobc/typeck.c:2342 -#, c-format -msgid "LENGTH OF '%s' not allowed outside of Procedure Division" -msgstr "" - -#: cobc/typeck.c:2346 cobc/typeck.c:2437 cobc/typeck.c:2445 cobc/typeck.c:2512 -msgid "variable length item not allowed here" -msgstr "objekt med variabel längd inte tillÃ¥tet här" - -# sebras: argh, this makes it so difficult to translate. how about "defined by DEFINE"? -#: cobc/typeck.c:2375 -#, c-format -msgid "'%s' has not been DEFINEd" -msgstr "â€%s†har inte definierats med DEFINE" - -#: cobc/typeck.c:2411 -msgid "only field names allowed here" -msgstr "endast fältnamn tillÃ¥tna här" - -#: cobc/typeck.c:2422 -#, c-format -msgid "VALUE of '%s': %s target '%s' is invalid" -msgstr "VALUE av â€%sâ€: %s mÃ¥l â€%s†är ogiltigt" - -#: cobc/typeck.c:2424 cobc/typeck.c:2494 -msgid "target must be in FILE SECTION or LINKAGE SECTION or have the EXTERNAL clause" -msgstr "mÃ¥l mÃ¥ste vara i FILE SECTION eller LINKAGE SECTION eller har en EXTERNAL-klausul" - -#: cobc/typeck.c:2480 cobc/typeck.c:2493 -#, c-format -msgid "VALUE of '%s': %s target is invalid" -msgstr "VALUE av â€%sâ€: %s mÃ¥l är ogiltigt" - -#: cobc/typeck.c:2482 -msgid "no previous data-item found" -msgstr "inget tidigare dataobjekt hittat" - -#: cobc/typeck.c:2667 -#, c-format -msgid "'%s' is not an alphabet name" -msgstr "â€%s†är inte ett alfabetsnamn" - -#: cobc/typeck.c:2931 -#, c-format -msgid "duplicate character values in alphabet '%s': %s" -msgstr "duplicerade teckenvärde i alfabet â€%sâ€: %s" - -#: cobc/typeck.c:2936 -#, c-format -msgid "invalid character values in alphabet '%s', starting at position %d" -msgstr "ogiltiga teckenvärden i alfabet â€%sâ€, börjar pÃ¥ position %d" - -#: cobc/typeck.c:2990 -msgid "invalid ALPHABET name" -msgstr "ogiltigt ALPHABET-namn" - -#: cobc/typeck.c:3054 -#, fuzzy, c-format -msgid "duplicate character values in class '%s'" -msgstr "duplicerade värden i klass â€%sâ€" - -#: cobc/typeck.c:3072 -#, c-format -msgid "'%s' is not a locale name" -msgstr "â€%s†är inte ett lokalnamn" - -#: cobc/typeck.c:3206 -msgid "invalid RECORD DEPENDING item" -msgstr "ogiltigt RECORD DEPENDING-objekt" - -#: cobc/typeck.c:3211 -msgid "RECORD DEPENDING must reference a data-item" -msgstr "RECORD DEPENDING mÃ¥ste referera till ett dataobjekt" - -#: cobc/typeck.c:3234 -#, c-format -msgid "RECORD DEPENDING item '%s' should be defined in WORKING-STORAGE, LOCAL-STORAGE or LINKAGE SECTION" -msgstr "RECORD DEPENDING-objekt â€%s†borde definieras i WORKING-STORAGE, LOCAL-STORAGE eller LINKAGE SECTION" - -#: cobc/typeck.c:3247 -#, fuzzy, c-format -msgid "file %s: RELATIVE KEY %s is not numeric" -msgstr "värde i AT-klausul är inte numeriskt" - -#: cobc/typeck.c:3256 -#, c-format -msgid "file %s: RELATIVE KEY %s must be integer" -msgstr "" - -#: cobc/typeck.c:3261 -#, c-format -msgid "file %s: RELATIVE KEY %s must be unsigned" -msgstr "" - -#: cobc/typeck.c:3268 -#, c-format -msgid "file %s: RELATIVE KEY %s cannot have OCCURS" -msgstr "" - -#: cobc/typeck.c:3274 -#, c-format -msgid "RELATIVE KEY %s cannot be in file record belonging to %s" -msgstr "" - -#: cobc/typeck.c:3283 -#, c-format -msgid "file %s: RELATIVE KEY %s declared outside WORKING-STORAGE" -msgstr "" - -#: cobc/typeck.c:3306 cobc/typeck.c:7184 -#, c-format -msgid "'%s' is not a valid data name" -msgstr "â€%s†är inte ett giltigt datanamn" - -#: cobc/typeck.c:3313 -#, fuzzy, c-format -msgid "CRT STATUS item '%s' should be defined in WORKING-STORAGE or LOCAL-STORAGE" -msgstr "RECORD DEPENDING-objekt â€%s†borde definieras i WORKING-STORAGE, LOCAL-STORAGE eller LINKAGE SECTION" - -#: cobc/typeck.c:3319 -#, fuzzy, c-format -msgid "'%s' CRT STATUS must have at least 4 digits" -msgstr "â€%s†CRT STATUS mÃ¥ste vara 4 tecken lÃ¥ngt" - -#: cobc/typeck.c:3325 -#, c-format -msgid "'%s' CRT STATUS must be 4 characters long" -msgstr "â€%s†CRT STATUS mÃ¥ste vara 4 tecken lÃ¥ngt" - -#: cobc/typeck.c:3341 -#, fuzzy, c-format -msgid "variable '%s' will be implicitly defined" -msgstr "â€%s†kommer att definieras implicit" - -#: cobc/typeck.c:3375 cobc/typeck.c:3438 -msgid "ASSIGN variable" -msgstr "" - -#: cobc/typeck.c:3443 -#, fuzzy, c-format -msgid "ASSIGN data item '%s' is invalid" -msgstr "ASSIGN-dataobjekt â€%s†ogiltigt" - -#: cobc/typeck.c:3507 -#, c-format -msgid "'%s' CURSOR must be 4 or 6 characters long" -msgstr "â€%s†CURSOR mÃ¥ste vara 4 eller 6 tecken lÃ¥ngt" - -#: cobc/typeck.c:3557 cobc/typeck.c:3561 -#, fuzzy, c-format -msgid "%s does not have a fixed location" -msgstr "%s är inte ett fält" - -#: cobc/typeck.c:3573 -#, fuzzy, c-format -msgid "'%s' cannot have nested OCCURS DEPENDING" -msgstr "â€%s†fÃ¥r inte ha OCCURS DEPENDING" - -#: cobc/typeck.c:3587 -#, fuzzy, c-format -msgid "'%s' OCCURS DEPENDING ON field item invalid here" -msgstr "â€%s†ODO-fältobjekt ogiltigt här" - -#: cobc/typeck.c:3595 -#, fuzzy, c-format -msgid "'%s' cannot have OCCURS DEPENDING because of '%s'" -msgstr "â€%s†fÃ¥r inte ha OCCURS DEPENDING" - -#: cobc/typeck.c:3607 -#, fuzzy, c-format -msgid "'%s' OCCURS DEPENDING ON item must have GLOBAL attribute" -msgstr "â€%s†ODO-objekt mÃ¥ste ha GLOBAL-attribut" - -#: cobc/typeck.c:3621 -#, c-format -msgid "PASSWORD '%s' for EXTERNAL file '%s' must have EXTERNAL attribute" -msgstr "" - -#: cobc/typeck.c:3644 -#, c-format -msgid "file %s: ASSIGN %s declared outside WORKING-STORAGE" -msgstr "" - -#: cobc/typeck.c:3674 -#, fuzzy, c-format -msgid "duplicate APPLY COMMIT target: '%s'" -msgstr "duplicerad REPOSITORY-post för â€%sâ€" - -#: cobc/typeck.c:3688 -#, fuzzy -msgid "APPLY COMMIT statement invalid for SORT file" -msgstr "USE-sats ogiltig i SORT-fil" - -#: cobc/typeck.c:3691 -#, fuzzy -msgid "APPLY COMMIT statement invalid for REPORT file" -msgstr "USE-sats ogiltig i SORT-fil" - -#: cobc/typeck.c:3698 -#, fuzzy, c-format -msgid "APPLY COMMIT item '%s' should be defined in WORKING-STORAGE or LOCAL-STORAGE" -msgstr "RECORD DEPENDING-objekt â€%s†borde definieras i WORKING-STORAGE, LOCAL-STORAGE eller LINKAGE SECTION" - -#: cobc/typeck.c:3712 -#, fuzzy, c-format -msgid "item not allowed here: '%s'" -msgstr "%s inte tillÃ¥tet här" - -#: cobc/typeck.c:3725 -#, fuzzy, c-format -msgid "%s may not be subscripted" -msgstr "â€%s†kan inte indexeras" - -#: cobc/typeck.c:3729 -#, fuzzy, c-format -msgid "%s may not be reference modified" -msgstr "â€%s†kan inte referensmodifieras" - -#: cobc/typeck.c:3789 -#, c-format -msgid "DEBUGGING target invalid: '%s'" -msgstr "DEBUGGING-mÃ¥l ogiltigt: â€%sâ€" - -#: cobc/typeck.c:3795 -#, fuzzy, c-format -msgid "DEBUGGING target already specified with ALL PROCEDURES: '%s'" -msgstr "DEBUGGING-mÃ¥l ogiltigt med ALL PROCEDURES: â€%sâ€" - -#: cobc/typeck.c:3815 -#, fuzzy -msgid "DEBUGGING target" -msgstr "DEBUGGING-mÃ¥l ogiltigt: â€%sâ€" - -#: cobc/typeck.c:3822 -#, c-format -msgid "'%s' is not a valid DEBUGGING target" -msgstr "â€%s†är inte ett giltigt DEBUGGING-mÃ¥l" - -#: cobc/typeck.c:3860 cobc/typeck.c:3865 -#, c-format -msgid "'%s' is not in DECLARATIVES" -msgstr "â€%s†är inte inuti DECLARATIVES" - -#: cobc/typeck.c:3877 -#, c-format -msgid "invalid reference to '%s' (in DECLARATIVES)" -msgstr "ogiltig referens till â€%s†(i DECLARATIVES)" - -#: cobc/typeck.c:3886 -#, c-format -msgid "'%s' is not a procedure name" -msgstr "â€%s†är inte ett procedurnamn" - -#: cobc/typeck.c:3948 -#, c-format -msgid "LINKAGE item '%s' is not a PROCEDURE USING parameter" -msgstr "LINKAGE-objekt â€%s†är inte en PROCEDURE USING-parameter" - -#: cobc/typeck.c:4001 -#, c-format -msgid "'%s' is not an alterable paragraph" -msgstr "â€%s†är inte ett ändringsbart stycke" - -#: cobc/typeck.c:4604 cobc/typeck.c:4608 -#, c-format -msgid "suggest parentheses around %s within %s" -msgstr "föreslÃ¥r parenteser runt %s inom %s" - -#: cobc/typeck.c:4616 -#, fuzzy -msgid "invalid conditional expression" -msgstr "ogiltigt uttryck" - -#: cobc/typeck.c:4726 -#, c-format -msgid "internal decimal structure size exceeded: %d" -msgstr "intern decimalstrukturstorlek överskriden: %d" - -#: cobc/typeck.c:4729 -msgid "Try to minimize the number of parentheses or split into multiple computations." -msgstr "Försök att minimera antalet parenteser eller dela upp i flera beräkningar." - -#: cobc/typeck.c:4753 -#, fuzzy, c-format -msgid "more than %d nested expressions" -msgstr "fler än %d nästlade villkor" - -#: cobc/typeck.c:4795 -msgid "precision of result may change with arithmetic-osvs" -msgstr "precision för resultatet kan förändras med osvs-aritmetik" - -#: cobc/typeck.c:4851 -#, c-format -msgid "unexpected operation: %c (%d)" -msgstr "oväntad Ã¥tgärd: %c (%d)" - -#: cobc/typeck.c:4856 -#, c-format -msgid "%s operator may be misplaced" -msgstr "%s-operatorn kan vara felplacerad" - -#: cobc/typeck.c:4926 -msgid "unexpected constant expansion" -msgstr "oväntat konstantuttryck" - -#: cobc/typeck.c:5747 -#, c-format -msgid "more than %d nested conditions" -msgstr "fler än %d nästlade villkor" - -#: cobc/typeck.c:6104 cobc/typeck.c:6180 -msgid "no CORRESPONDING items found" -msgstr "inget CORRESPONDING-objekt hittat" - -#: cobc/typeck.c:6252 -msgid "no items to ACCEPT found" -msgstr "" - -#: cobc/typeck.c:6302 -#, fuzzy -msgid "no items to DISPLAY found" -msgstr "ogiltig typ för DISPLAY-operand" - -#: cobc/typeck.c:6421 -msgid "cannot specify figurative constant ZERO in AT clause" -msgstr "kan inte ange bildlig konstant ZERO i AT-klausul" - -#: cobc/typeck.c:6425 -msgid "value in AT clause is not numeric" -msgstr "värde i AT-klausul är inte numeriskt" - -#: cobc/typeck.c:6431 -msgid "value in AT clause must have 4 or 6 digits" -msgstr "värde i AT-klausul mÃ¥ste ha 4 eller 6 siffror" - -#: cobc/typeck.c:6553 -msgid "invalid PROMPT literal" -msgstr "ogiltig PROMPT-litteral" - -#: cobc/typeck.c:6558 -msgid "invalid PROMPT identifier" -msgstr "ogiltig PROMPT-identifierare" - -#: cobc/typeck.c:6848 -#, c-format -msgid "'%s' is not an input device" -msgstr "â€%s†är inte en inmatningsenhet" - -#: cobc/typeck.c:6878 cobc/typeck.c:8016 -#, c-format -msgid "'%s' is not defined in SPECIAL-NAMES" -msgstr "â€%s†är inte definierad i SPECIAL-NAMES" - -#: cobc/typeck.c:6883 -#, c-format -msgid "invalid input device '%s'" -msgstr "ogiltig inmatningsenhet â€%sâ€" - -#: cobc/typeck.c:6888 cobc/typeck.c:8020 -#, c-format -msgid "unknown device '%s'; it may exist in another dialect" -msgstr "okänd enhet â€%sâ€; den kanske finns i en annan dialekt" - -#: cobc/typeck.c:6891 cobc/typeck.c:8023 -#, c-format -msgid "unknown device '%s'; not defined in SPECIAL-NAMES" -msgstr "okänd enhet â€%sâ€; inte definierad i SPECIAL-NAMES" - -#: cobc/typeck.c:6915 -msgid "target of ALLOCATE is not a BASED item" -msgstr "mÃ¥l för ALLOCATE är inte ett BASED-objekt" - -#: cobc/typeck.c:6926 -msgid "target of RETURNING is not a data pointer" -msgstr "mÃ¥l för RETURNING är inte en datapekare" - -#: cobc/typeck.c:6936 cobc/typeck.c:7342 -msgid "amount must be specified as a numeric expression" -msgstr "" - -#: cobc/typeck.c:6949 -msgid "INITIALIZED TO item is not alphanumeric" -msgstr "INITIALIZED TO-objekt är inte alfanumeriskt" - -#: cobc/typeck.c:7019 -msgid "only alphanumeric FUNCTION types are allowed here" -msgstr "endast alfanumeriska FUNCTION-typer tillÃ¥ts här" - -#: cobc/typeck.c:7027 -msgid "invalid RETURNING field" -msgstr "ogiltigt RETURNING-fält" - -#: cobc/typeck.c:7046 -msgid "STDCALL not available on this platform" -msgstr "STDCALL inte tillgängligt pÃ¥ denna plattform" - -#: cobc/typeck.c:7050 -msgid "STDCALL used on 64-bit Windows platform" -msgstr "STDCALL använt pÃ¥ 64-bitars Windows-plattform" - -#: cobc/typeck.c:7055 -msgid "STATIC CALL convention requires a literal program name" -msgstr "STATIC CALL-konvention kräver ett litteralt programnamn" - -#: cobc/typeck.c:7060 cobc/typeck.c:10632 cobc/typeck.c:11539 -#: cobc/typeck.c:11903 -msgid "HANDLE must be either a generic or a THREAD HANDLE" -msgstr "HANDLE mÃ¥ste vara antingen en generisk eller ett THREAD HANDLE" - -#: cobc/typeck.c:7078 -msgid "numeric literal is negative" -msgstr "numerisk litteral är negativ" - -#: cobc/typeck.c:7157 -msgid "numeric literal exceeds size limits" -msgstr "numerisk litteral överskriver storleksbegränsningar" - -#: cobc/typeck.c:7175 -#, fuzzy, c-format -msgid "figurative constant %s invalid here" -msgstr "bildlig konstant ogiltig här" - -#: cobc/typeck.c:7190 -#, c-format -msgid "'%s' ANY LENGTH item not passed BY REFERENCE" -msgstr "â€%s†ANY LENGTH-objekt förbigÃ¥s inte av BY REFERENCE" - -#: cobc/typeck.c:7198 -#, c-format -msgid "'%s' is not a 01 or 77 level item" -msgstr "â€%s†är inte ett nivÃ¥-01- eller -77-objekt" - -#: cobc/typeck.c:7228 cobc/typeck.c:7233 -#, c-format -msgid "wrong number of CALL parameters for '%s', %d given, %d expected" -msgstr "fel antal CALL-parametrar för â€%sâ€, %d angivna, %d förväntades" - -#: cobc/typeck.c:7300 cobc/typeck.c:7374 cobc/typeck.c:7378 cobc/typeck.c:7382 -#: cobc/typeck.c:7412 cobc/typeck.c:10591 cobc/typeck.c:10755 -#: cobc/typeck.c:10944 cobc/typeck.c:10948 cobc/typeck.c:11844 -#: cobc/typeck.c:12087 cobc/typeck.c:12090 -#, c-format -msgid "%s not allowed on %s files" -msgstr "%s inte tillÃ¥tet pÃ¥ %s-filer" - -#: cobc/typeck.c:7336 -msgid "AFTER phrase in CONTINUE statement" -msgstr "" - -#: cobc/typeck.c:7478 -msgid "positions cannot be specified for main windows" -msgstr "positioner kan inte anges för huvudfönster" - -#: cobc/typeck.c:7488 cobc/typeck.c:7491 cobc/typeck.c:7508 -#, fuzzy -msgid "HANDLE must be either a generic or a WINDOW HANDLE or X(10)" -msgstr "HANDLE mÃ¥ste vara antingen en generisk eller ett WINDOW HANDLE" - -#: cobc/typeck.c:7617 -#, c-format -msgid "'%s' is an invalid type for DISPLAY operand" -msgstr "â€%s†är en ogiltig typ för DISPLAY-operand" - -#: cobc/typeck.c:7622 -msgid "invalid type for DISPLAY operand" -msgstr "ogiltig typ för DISPLAY-operand" - -#: cobc/typeck.c:7973 cobc/typeck.c:8006 -#, c-format -msgid "'%s' is not an output device" -msgstr "â€%s†är inte en utmatningsenhet" - -#: cobc/typeck.c:8109 -msgid "invalid use of 88 level in WHEN expression" -msgstr "ogiltig användning av nivÃ¥-88 i WHEN-uttryck" - -#: cobc/typeck.c:8165 -msgid "wrong number of WHEN parameters" -msgstr "fel antal WHEN-parametrar" - -#: cobc/typeck.c:8244 cobc/typeck.c:8256 -#, c-format -msgid "target %d of FREE is not a BASED data item" -msgstr "mÃ¥l %d för FREE är inte ett BASED-dataobjekt" - -#: cobc/typeck.c:8262 -#, c-format -msgid "target %d of FREE must be a data pointer" -msgstr "mÃ¥l %d för FREE mÃ¥ste vara en datapekare" - -#: cobc/typeck.c:8276 -msgid "GO TO without procedure-name" -msgstr "GO TO utan procedurnamn" - -#: cobc/typeck.c:8286 -msgid "GO TO with multiple procedure-names" -msgstr "GO TO med flera procedurnamn" - -#: cobc/typeck.c:8308 -#, fuzzy -msgid "GO TO ENTRY with multiple entry-names" -msgstr "GO TO med flera procedurnamn" - -#: cobc/typeck.c:8367 -msgid "invalid INITIALIZE statement" -msgstr "ogiltig INITIALIZE-sats" - -#: cobc/typeck.c:8443 cobc/typeck.c:8446 -#, c-format -msgid "%s operands differ in size" -msgstr "%s operander skiljer sig i storlek" - -#: cobc/typeck.c:8476 -#, c-format -msgid "unexpected clause %d" -msgstr "oväntad klausul %d" - -#: cobc/typeck.c:8545 cobc/typeck.c:8556 cobc/typeck.c:8567 cobc/typeck.c:8578 -#, c-format -msgid "data name expected before %s" -msgstr "datanamn förväntades före %s" - -#: cobc/typeck.c:8588 -#, c-format -msgid "ALL, LEADING or TRAILING expected before '%s'" -msgstr "ALL, LEADING eller TRAILING förväntades före â€%sâ€" - -#: cobc/typeck.c:8598 -msgid "operand has wrong size" -msgstr "operand har fel storlek" - -#: cobc/typeck.c:8669 -#, c-format -msgid "internal register '%s' defined as BINARY-LONG" -msgstr "internt register â€%s†definierat som BINARY-LONG" - -#: cobc/typeck.c:8672 cobc/typeck.c:8675 cobc/typeck.c:8678 cobc/typeck.c:8681 -#: cobc/typeck.c:8684 cobc/typeck.c:8687 cobc/typeck.c:8690 cobc/typeck.c:8693 -#: cobc/typeck.c:8696 -#, c-format -msgid "'%s' defined here as USAGE %s" -msgstr "â€%s†definierat här som USAGE %s" - -#: cobc/typeck.c:8699 -#, c-format -msgid "'%s' defined here as PIC %s" -msgstr "â€%s†definierat här som PIC %s" - -#: cobc/typeck.c:8702 -#, c-format -msgid "'%s' defined here as a group of length %d" -msgstr "â€%s†definierat här som en grupp med längden %d" - -#: cobc/typeck.c:8741 -#, c-format -msgid "value is %s" -msgstr "" - -#: cobc/typeck.c:8745 -#, fuzzy, c-format -msgid "value size is %d" -msgstr "storlek för värde överstiger datastorlek" - -#: cobc/typeck.c:9022 -msgid "invalid destination for MOVE" -msgstr "ogiltig destination för MOVE" - -#: cobc/typeck.c:9057 -#, fuzzy -msgid "MOVE of figurative constant SPACE to numeric item" -msgstr "MOVE av bildlig konstant till numeriskt objekt" - -#: cobc/typeck.c:9072 -msgid "MOVE of figurative constant QUOTE to numeric item" -msgstr "MOVE av bildlig konstant QUOTE till numeriskt objekt" - -#: cobc/typeck.c:9077 cobc/typeck.c:9089 -msgid "MOVE of figurative constant to numeric item" -msgstr "MOVE av bildlig konstant till numeriskt objekt" - -#: cobc/typeck.c:9151 -msgid "numeric literal in VALUE clause of numeric-edited item" -msgstr "numerisk litteral i VALUE-klausul av numeriskt redigerat objekt" - -#: cobc/typeck.c:9176 -msgid "numeric move to ALPHABETIC" -msgstr "numerisk förflyttning till ALPHABETIC" - -#: cobc/typeck.c:9188 -msgid "data item not signed" -msgstr "dataobjekt saknar tecken" - -#: cobc/typeck.c:9191 -msgid "ignoring sign" -msgstr "hoppar över tecken" - -#: cobc/typeck.c:9503 -msgid "overlapping MOVE may occur and produce unpredictable results" -msgstr "överlappande MOVE kan förekomma och ger oförutsägbara resultat" - -#: cobc/typeck.c:9510 -msgid "overlapping MOVE may produce unpredictable results" -msgstr "överlappande MOVE kan ge oförutsägbara resultat" - -#: cobc/typeck.c:9643 -msgid "invalid source for MOVE" -msgstr "ogiltig källa för MOVE" - -#: cobc/typeck.c:9666 -msgid "source is non-numeric - substituting zero" -msgstr "" - -#: cobc/typeck.c:9672 cobc/typeck.c:9683 -msgid "invalid VALUE clause" -msgstr "ogiltig VALUE-klausul" - -#: cobc/typeck.c:9675 cobc/typeck.c:11480 cobc/typeck.c:11485 -#: cobc/typeck.c:11512 cobc/typeck.c:11517 -msgid "invalid SET statement" -msgstr "ogiltig SET-sats" - -#: cobc/typeck.c:9677 -msgid "invalid MOVE statement" -msgstr "ogiltig MOVE-sats" - -#: cobc/typeck.c:9684 -msgid "literal exceeds data size" -msgstr "litteral överskrider datastorlek" - -#: cobc/typeck.c:9688 -msgid "numeric literal exceeds data size" -msgstr "numerisk litteral överskrider datastorlek" - -#: cobc/typeck.c:9697 -msgid "MOVE of non-integer to alphanumeric" -msgstr "MOVE av icke-heltal till alfanumeriskt" - -#: cobc/typeck.c:9703 -msgid "numeric value is expected" -msgstr "numeriskt värde förväntades" - -#: cobc/typeck.c:9708 -msgid "alphanumeric value is expected" -msgstr "alfanumeriskt värde förväntades" - -#: cobc/typeck.c:9713 -msgid "value does not fit the picture string" -msgstr "värde passar inte i bildsträngen" - -#: cobc/typeck.c:9719 -msgid "value size exceeds data size" -msgstr "storlek för värde överstiger datastorlek" - -#: cobc/typeck.c:9724 -msgid "sending field larger than receiving field" -msgstr "skickar fält större än mottagande fält" - -#: cobc/typeck.c:9729 -msgid "some digits may be truncated" -msgstr "vissa siffror kan komma att trunkeras" - -#: cobc/typeck.c:10515 -#, c-format -msgid "invalid MOVE target: %s" -msgstr "ogiltigt MOVE-mÃ¥l: %s" - -#: cobc/typeck.c:10768 -msgid "READ PREVIOUS not allowed for this file type" -msgstr "READ PREVIOUS inte tillÃ¥tet för denna filtyp" - -#: cobc/typeck.c:10776 -msgid "KEY ignored with sequential READ" -msgstr "KEY överhoppat med sekventiell READ" - -#: cobc/typeck.c:10872 -#, fuzzy -msgid "figurative constants not allowed in FROM clause" -msgstr "bildlig konstant ogiltig här" - -#: cobc/typeck.c:10879 -msgid "literal in FROM clause must be alphanumeric, national or boolean" -msgstr "" - -#: cobc/typeck.c:10902 cobc/typeck.c:12047 -#, c-format -msgid "%s FILE requires a FROM clause" -msgstr "%s FILE kräver en FROM-klausul" - -#: cobc/typeck.c:10924 cobc/typeck.c:11010 cobc/typeck.c:12069 -#, c-format -msgid "%s subject does not refer to a record name" -msgstr "%s-ämne refererar inte till ett postnamn" - -#: cobc/typeck.c:11016 -msgid "RELEASE not allowed on this record item" -msgstr "RELEASE inte tillÃ¥tet för detta postobjekt" - -#: cobc/typeck.c:11097 cobc/typeck.c:11118 cobc/typeck.c:11125 -msgid "invalid SEARCH ALL condition" -msgstr "ogiltigt SEARCH ALL-villkor" - -#: cobc/typeck.c:11237 cobc/typeck.c:11241 -msgid "SET targets must be PROGRAM-POINTER" -msgstr "SET-mÃ¥l mÃ¥ste vara PROGRAM-POINTER" - -#: cobc/typeck.c:11268 cobc/typeck.c:11335 cobc/typeck.c:11403 -#, c-format -msgid "cannot change address of '%s', which is not level 1 or 77" -msgstr "kan inte ändra adress för â€%sâ€, vilken inte är nivÃ¥ 1 eller 77" - -#: cobc/typeck.c:11272 cobc/typeck.c:11339 cobc/typeck.c:11407 -#, fuzzy, c-format -msgid "cannot change address of '%s', which is not BASED or a LINKAGE item" -msgstr "kan inte ändra adress för â€%sâ€, vilken inte är BASED eller ett länkningsobjekt" - -#: cobc/typeck.c:11291 -#, fuzzy, c-format -msgid "SET target '%s' is not numeric, an INDEX or a POINTER" -msgstr "SET-mÃ¥l â€%s†är inte numeriskt, ett index eller en pekare" - -#: cobc/typeck.c:11360 -#, fuzzy, c-format -msgid "SET target '%s' is not a POINTER for FCD" -msgstr "SET-mÃ¥l â€%s†är inte numeriskt, ett index eller en pekare" - -#: cobc/typeck.c:11428 -#, c-format -msgid "SET target '%s' is not a POINTER for FCD-KEYDEF" -msgstr "" - -#: cobc/typeck.c:11521 -msgid "field does not have a FALSE clause" -msgstr "fält har inte en FALSE-klausul" - -#: cobc/typeck.c:11552 -msgid "THREAD-priority must be between 1 and 32767" -msgstr "THREAD-prioritet mÃ¥ste vara mellan 1 och 32767" - -#: cobc/typeck.c:11572 -msgid "SET ATTRIBUTE requires a screen item as subject" -msgstr "SET ATTRIBUTE kräver ett skärmobjekt som ämne" - -#: cobc/typeck.c:11578 -msgid "SET ATTRIBUTE subject does not refer to a screen item" -msgstr "SET ATTRIBUTE-ämne refererar inte till ett skärmobjekt" - -#: cobc/typeck.c:11629 -msgid "invalid SORT filename" -msgstr "ogiltigt SORT-filnamn" - -#: cobc/typeck.c:11689 -msgid "invalid SORT USING parameter" -msgstr "ogiltig SORT USING-parameter" - -#: cobc/typeck.c:11718 -msgid "invalid SORT GIVING parameter" -msgstr "ogiltig SORT GIVING-parameter" - -#: cobc/typeck.c:11772 cobc/typeck.c:11799 cobc/typeck.c:11819 -msgid "invalid key item" -msgstr "ogiltigt nyckelobjekt" - -#: cobc/typeck.c:11849 -msgid "LENGTH/SIZE clause only allowed on INDEXED files" -msgstr "LENGTH-/SIZE-klausul endast tillÃ¥ten för INDEXED-filer" - -#: cobc/typeck.c:11854 -msgid "START not allowed with ACCESS MODE RANDOM" -msgstr "START inte tillÃ¥tet med ACCESS MODE RANDOM" - -#: cobc/typeck.c:12103 -msgid "LOCK clause invalid here" -msgstr "LOCK-klausul ogiltig här" - -#: cobc/typeck.c:12365 -msgid "data item is not part of a report" -msgstr "" - -#: cobc/typeck.c:12385 -msgid "improper use of SUPPRESS PRINTING" -msgstr "" - -#: cobc/typeck.c:12400 -#, fuzzy, c-format -msgid "%s must be alphanumeric or national" -msgstr "%s är inte en alfanumerisk litteral" - -#: cobc/typeck.c:12411 -#, c-format -msgid "%s may not be a figurative constant" -msgstr "" - -#: cobc/typeck.c:12438 -#, fuzzy, c-format -msgid "%s must be a child of the input record" -msgstr "â€%s†och â€%s†mÃ¥ste vara i samma post" - -#: cobc/typeck.c:12464 -#, c-format -msgid "%s may not be an ignored item in JSON/XML GENERATE" -msgstr "" - -#: cobc/typeck.c:12475 -#, fuzzy, c-format -msgid "%s must be elementary" -msgstr "mÃ¥ste vara numerisk" - -#: cobc/typeck.c:12487 -#, fuzzy, c-format -msgid "%s must be USAGE DISPLAY or NATIONAL" -msgstr "elementära objekt med SIGN-klausul mÃ¥ste vara USAGE DISPLAY eller NATIONAL" - -#: cobc/typeck.c:12501 -#, fuzzy, c-format -msgid "%s must be an integer" -msgstr "â€%s†är inte ett heltal" - -#: cobc/typeck.c:12517 cobc/typeck.c:12523 -msgid "JSON/XML GENERATE receiving item" -msgstr "" - -#: cobc/typeck.c:12520 -msgid "JSON/XML GENERATE receiving item may not have JUSTIFIED clause" -msgstr "" - -#: cobc/typeck.c:12608 -#, fuzzy -msgid "JSON/XML GENERATE input record may not be reference modified" -msgstr "â€%s†kan inte referensmodifieras" - -#: cobc/typeck.c:12614 -msgid "JSON/XML GENERATE input record may not have RENAMES clause" -msgstr "" - -#: cobc/typeck.c:12619 -#, c-format -msgid "all the children of '%s' are ignored in JSON/XML GENERATE" -msgstr "" - -#: cobc/typeck.c:12626 -msgid "JSON/XML GENERATE input record has subrecords with non-unique names" -msgstr "" - -#: cobc/typeck.c:12631 -msgid "floating-point items in JSON/XML GENERATE" -msgstr "" - -#: cobc/typeck.c:12635 -msgid "OCCURS items in JSON/XML GENERATE" -msgstr "" - -#: cobc/typeck.c:12660 -msgid "COUNT IN item must be numeric and an integer" -msgstr "" - -#: cobc/typeck.c:12665 -msgid "COUNT IN item must be an integer" -msgstr "" - -#: cobc/typeck.c:12668 -msgid "COUNT IN item may not have PICTURE with P in it" -msgstr "" - -#: cobc/typeck.c:12711 -msgid "NAMESPACE must be a valid URI" -msgstr "" - -#: cobc/typeck.c:12755 -msgid "NAMESPACE-PREFIX must be a valid XML name" -msgstr "" - -#: cobc/typeck.c:12780 cobc/typeck.c:12787 -msgid "NAME OF item" -msgstr "" - -#: cobc/typeck.c:12784 -msgid "NAME OF item must be the input record or a child of it" -msgstr "" - -#: cobc/typeck.c:12791 -msgid "NAME OF name must be a valid XML name" -msgstr "" - -#: cobc/typeck.c:12817 cobc/typeck.c:12818 cobc/typeck.c:12821 -#: cobc/typeck.c:12825 -msgid "TYPE OF item" -msgstr "" - -#: cobc/typeck.c:12843 -msgid "SUPPRESS WHEN SPACE item" -msgstr "" - -#: cobc/typeck.c:12846 -msgid "SUPPRESS WHEN LOW-VALUE item" -msgstr "" - -#: cobc/typeck.c:12848 -msgid "SUPPRESS WHEN HIGH-VALUE item" -msgstr "" - -#: cobc/typeck.c:12877 cobc/typeck.c:12885 cobc/typeck.c:12889 -msgid "SUPPRESS item" -msgstr "" - -#: cobc/typeck.c:12881 -msgid "SUPPRESS item with WHEN clause" -msgstr "" - -#: cobc/typeck.c:12958 -msgid "WITH ATTRIBUTES specified, but no attributes can be generated" -msgstr "" - -#: cobc/warning.def:34 -#, fuzzy -msgid " -Wextra additional warnings only raised with -W or -Wall" -msgstr " -Werror behandla alla varningar som fel" - -#: cobc/warning.def:37 -#, fuzzy -msgid " -Wno-unfinished do not warn if unfinished features are used" -msgstr "varna inte vid användning av oavslutade funktioner" - -#: cobc/warning.def:40 -#, fuzzy -msgid " -Wno-pending do not warn if pending features are mentioned" -msgstr "varna inte dÃ¥ väntande funktioner nämns" - -#: cobc/warning.def:43 -#, fuzzy -msgid " -Wobsolete warn if obsolete features are used" -msgstr "varna vid användning av förÃ¥ldrade funktioner" - -#: cobc/warning.def:46 -#, fuzzy -msgid " -Warchaic warn if archaic features are used" -msgstr "varna vid användning av Ã¥lderdomliga funktioner" - -# sebras: warn on? -#: cobc/warning.def:49 -#, fuzzy -msgid " -Wredefinition warn about incompatible redefinition of data items" -msgstr "varna vid inkompatibla omdefinitioner för data objekt" - -#: cobc/warning.def:52 -#, fuzzy -msgid " -Wtruncate warn about field truncation from constant assignments" -msgstr "varna för fälttrunkering vid konstanttilldelningar" - -#: cobc/warning.def:55 -#, fuzzy -msgid " -Wpossible-truncate warn about possible field truncation" -msgstr "varna för möjlig fälttrunkering" - -#: cobc/warning.def:58 -#, fuzzy -msgid " -Woverlap warn about overlapping MOVE of items" -msgstr "varna för överlappande MOVE-objekt" - -#: cobc/warning.def:61 -#, fuzzy -msgid " -Wpossible-overlap warn about MOVE of items that may overlap depending on variables" -msgstr "varna för MOVE-objekt som kan överlappa beroende pÃ¥ variabler" - -#: cobc/warning.def:64 -#, fuzzy -msgid " -Wparentheses warn about lack of parentheses around AND within OR" -msgstr "varna om parenteser saknas runt AND inom OR" - -#: cobc/warning.def:67 -msgid " -Wstrict-typing warn strictly about type mismatch" -msgstr "" - -#: cobc/warning.def:70 -#, fuzzy -msgid " -Wimplicit-define warn about implicitly defined data items" -msgstr "varna vid implicit definierade dataobjekt" - -#: cobc/warning.def:73 -#, fuzzy -msgid " -Wcorresponding warn about CORRESPONDING with no matching items" -msgstr "varna dÃ¥ CORRESPONDING inte har nÃ¥gra matchande objekt" - -# sebras: why the capitalized Initial? -#: cobc/warning.def:76 -#, fuzzy -msgid " -Winitial-value warn if initial VALUE clause is ignored" -msgstr "varna dÃ¥ inledande VALUE-klausul hoppas över" - -#: cobc/warning.def:79 -#, fuzzy -msgid " -Wprototypes warn about missing FUNCTION prototypes/definitions" -msgstr "varna om FUNCTION prototyper/definitioner inte hittas" - -#: cobc/warning.def:82 -#, fuzzy -msgid " -Warithmetic-osvs warn if arithmetic expression precision has changed" -msgstr "varna om precisionen för aritmetiska uttryck har ändrats" - -#: cobc/warning.def:85 -#, fuzzy -msgid " -Wcall-params warn about non 01/77 items for CALL parameters" -msgstr "varna för icke 01/77-objekt som CALL-parametrar" - -#: cobc/warning.def:88 -#, fuzzy -msgid " -Wconstant-expression warn about expressions that always resolve to true/false" -msgstr "varna för uttryck som alltid beräknas till sant/falskt" - -#: cobc/warning.def:91 -#, fuzzy -msgid " -Wcolumn-overflow warn about text after program-text area, FIXED format" -msgstr "varna vid text efter programtextomrÃ¥de, FIXED-format" - -#: cobc/warning.def:94 -#, fuzzy -msgid " -Wterminator warn about lack of scope terminator END-XXX" -msgstr "varna för avsaknad av räckviddsavslutare END-XXX" - -#: cobc/warning.def:97 -#, fuzzy -msgid " -Wlinkage warn about dangling LINKAGE items" -msgstr "varna vid hängande LINKAGE-objekt" - -#: cobc/warning.def:100 -msgid " -Wunreachable warn about likely unreachable statements" -msgstr "" - -#: cobc/warning.def:103 -msgid " -Wno-dialect do not warn about dialect specific issues" -msgstr "" - -#: cobc/warning.def:106 -#, fuzzy -msgid " -Wothers do not warn about different issues" -msgstr " -Werror behandla alla varningar som fel" - -#: cobc/warning.def:109 -msgid " -Wno-unsupported do not warn if runtime does not support a feature used" -msgstr "" - -#: libcob/call.c:87 -#, c-format -msgid "LoadLibrary/GetProcAddress error %d" -msgstr "LoadLibrary/GetProcAddress-fel %d" - -#: libcob/call.c:939 -msgid "indeterminable error in resolve of COBOL CALL" -msgstr "obestämbart fel i upplösning av COBOL CALL" - -#: libcob/call.c:1022 -#, c-format -msgid "user-defined FUNCTION '%s' not found" -msgstr "användardefinierad FUNCTION â€%s†hittades inte" - -#: libcob/call.c:1129 libcob/call.c:1208 libcob/call.c:1326 libcob/call.c:1354 -#, c-format -msgid "NULL parameter passed to '%s'" -msgstr "NULL-parameter skickad till â€%sâ€" - -#: libcob/call.c:1204 -#, c-format -msgid "invalid number of arguments passed to '%s'" -msgstr "ogiltigt antal argument skickade till â€%sâ€" - -#: libcob/call.c:1330 -msgid "multiple call to 'cob_setjmp'" -msgstr "flera anrop till â€cob_setjmpâ€" - -#: libcob/call.c:1358 -msgid "call to 'cob_longjmp' with no prior 'cob_setjmp'" -msgstr "anrop till â€cob_longjmp†utan föregÃ¥ende â€cob_setjmpâ€" - -#: libcob/call.c:1592 libcob/call.c:1633 libcob/call.c:1646 -#: libcob/common.c:7081 -msgid "cob_init() has not been called" -msgstr "cob_init() har inte anropats" - -#: libcob/call.c:1598 -#, fuzzy, c-format -msgid "parameter %d is not within range of %d" -msgstr "%s: parameter %d är inte inom intervall för %d" - -#: libcob/call.c:1604 -#, fuzzy, c-format -msgid "parameter %d is NULL" -msgstr "%s: parameter %d är NULL" - -#: libcob/call.c:1859 libcob/call.c:1916 -#, fuzzy, c-format -msgid "attempt to over-write constant parameter %d with " -msgstr "%s: försök att skriva över konstantparameter %d med " - -#: libcob/call.c:1965 -#, fuzzy, c-format -msgid "attempt to over-write constant parameter %d with '%s'" -msgstr "%s: försök att skriva över konstantparameter %d med â€%sâ€" - -#: libcob/cobgetopt.c:497 -#, c-format -msgid "%s: option '%s' is ambiguous; possibilities:" -msgstr "%s: flagga â€%s†är tvetydig; möjligheter:" - -#: libcob/cobgetopt.c:538 -#, c-format -msgid "%s: option '--%s' doesn't allow an argument" -msgstr "%s: flagga â€--%s†tillÃ¥ter inte ett argument" - -#: libcob/cobgetopt.c:545 -#, c-format -msgid "%s: option '%c%s' doesn't allow an argument" -msgstr "%s: flagga â€%c%s†tillÃ¥ter inte ett argument" - -#: libcob/cobgetopt.c:565 -#, c-format -msgid "%s: option '--%s' requires an argument" -msgstr "%s: flagga â€--%s†kräver ett argument" - -#: libcob/cobgetopt.c:597 -#, c-format -msgid "%s: unrecognized option '--%s'" -msgstr "%s: okänd flagga â€--%sâ€" - -#: libcob/cobgetopt.c:604 -#, c-format -msgid "%s: unrecognized option '%c%s'" -msgstr "%s: okänd flagga â€%c%sâ€" - -#: libcob/cobgetopt.c:633 -#, c-format -msgid "%s: invalid option -- %c" -msgstr "%s: okänd flagga -- %c" - -#: libcob/cobgetopt.c:664 libcob/cobgetopt.c:805 -#, c-format -msgid "%s: option requires an argument -- %c" -msgstr "%s: flagga kräver ett argument -- %c" - -#: libcob/cobgetopt.c:714 -#, c-format -msgid "%s: option '-W %s' is ambiguous" -msgstr "%s: flagga â€-W %s†är tvetydig" - -#: libcob/cobgetopt.c:736 -#, c-format -msgid "%s: option '-W %s' doesn't allow an argument" -msgstr "%s: flagga â€-W %s†tillÃ¥ter inte ett argument" - -#: libcob/cobgetopt.c:754 -#, c-format -msgid "%s: option '%s' requires an argument" -msgstr "%s: flagga â€%s†kräver ett argument" - -#: libcob/common.c:793 -#, c-format -msgid "attempt to reference unallocated memory" -msgstr "försök att referera till oallokerat minne" - -#: libcob/common.c:798 -#, c-format -msgid "bus error" -msgstr "bussfel" - -#: libcob/common.c:803 -#, c-format -msgid "fatal arithmetic error" -msgstr "" - -#: libcob/common.c:807 -#, c-format -msgid "caught signal" -msgstr "fÃ¥ngad signal" - -#: libcob/common.c:811 -#, c-format -msgid "signal %s" -msgstr "signal %s" - -#: libcob/common.c:817 -#, c-format -msgid "abnormal termination - file contents may be incorrect" -msgstr "onormal avslutning - filinnehÃ¥ll kan vara felaktigt" - -#: libcob/common.c:2049 -msgid "NULL field" -msgstr "" - -#: libcob/common.c:2059 -msgid "field with NULL address" -msgstr "" - -#: libcob/common.c:2345 -#, fuzzy -msgid "version mismatch" -msgstr "fel: version stämmer inte" - -#: libcob/common.c:2346 libcob/common.c:2348 -#, fuzzy, c-format -msgid "%s has version %s.%d" -msgstr "%s har version/programfixnivÃ¥ %s/%d" - -#: libcob/common.c:2358 -#, fuzzy, c-format -msgid "CALL to %s requires %d arguments" -msgstr "CALL till %s kräver %d parametrar" - -#: libcob/common.c:2980 -#, c-format -msgid "BASED/LINKAGE item %s has NULL address" -msgstr "BASED/LINKAGE-objekt %s har NULL-adress" - -#: libcob/common.c:2992 libcob/common.c:2995 -#, c-format -msgid "LINKAGE item %s not passed by caller" -msgstr "LINKAGE-objekt %s inte skickat av anroparen" - -#: libcob/common.c:3081 -#, fuzzy, c-format -msgid "'%s' (Type: %s) not numeric: '%s'" -msgstr "â€%s†inte numeriskt: â€%sâ€" - -#: libcob/common.c:3096 -#, c-format -msgid "OCCURS DEPENDING ON '%s' out of bounds: %d" -msgstr "OCCURS DEPENDING ON â€%s†utanför intervall: %d" - -#: libcob/common.c:3099 libcob/common.c:3120 -#, c-format -msgid "maximum subscript for '%s': %d" -msgstr "högsta index för â€%sâ€: %d" - -#: libcob/common.c:3101 -#, c-format -msgid "minimum subscript for '%s': %d" -msgstr "minsta index för â€%sâ€: %d" - -#: libcob/common.c:3117 -#, c-format -msgid "current maximum subscript for '%s': %d" -msgstr "för närvarande största index för â€%sâ€: %d" - -#: libcob/common.c:3139 -#, fuzzy, c-format -msgid "offset of '%s' out of bounds: %d, maximum: %d" -msgstr "position â€%s†utanför intervall: %d" - -#: libcob/common.c:3152 -#, fuzzy, c-format -msgid "length of '%s' out of bounds: %d, maximum: %d" -msgstr "längd â€%s†utanför intervall: %d" - -#: libcob/common.c:3161 -#, fuzzy, c-format -msgid "length of '%s' out of bounds: %d, starting at: %d, maximum: %d" -msgstr "längd â€%s†utanför intervall: %d" - -#: libcob/common.c:3176 libcob/common.c:3181 -#, c-format -msgid "EXTERNAL item '%s' previously allocated with size %d, requested size is %d" -msgstr "EXTERNAL-objekt â€%s†tidigare allokerat med storlek %d, begärd storlek är %d" - -#: libcob/common.c:3682 -#, c-format -msgid "COB_CURRENT_DATE '%s' is invalid" -msgstr "COB_CURRENT_DATE â€%s†är ogiltigt" - -#: libcob/common.c:4585 -#, c-format -msgid "parameter to SYSTEM call is larger than %d characters" -msgstr "parameter till SYSTEM-anrop är större än %d tecken" - -#: libcob/common.c:5195 -#, fuzzy, c-format -msgid "error '%s' during CBL_GC_FORK" -msgstr "Fel â€%s†under CBL_GC_FORK" - -#: libcob/common.c:5200 libcob/common.c:5297 -#, c-format -msgid "'%s' is not supported on this platform" -msgstr "â€%s†stöds inte pÃ¥ denna plattform" - -#: libcob/common.c:5226 -#, c-format -msgid "error '%s' for P%d during CBL_GC_WAITPID" -msgstr "fel â€%s†för P%d under CBL_GC_WAITPID" - -#: libcob/common.c:5418 -msgid "Call to CBL_GC_GETOPT with wrong longoption size." -msgstr "Anrop till CBL_GC_GETOPT med fel storlek pÃ¥ lÃ¥ngflagga." - -#: libcob/common.c:5423 -msgid "Call to CBL_GC_GETOPT with missing longind." -msgstr "Anrop till CBL_GC_GETOPT där lÃ¥ngindex saknas." - -#: libcob/common.c:5837 libcob/common.c:5858 libcob/common.c:5871 -#: libcob/common.c:7785 -#, fuzzy, c-format -msgid "(default)" -msgstr " (standard)" - -#: libcob/common.c:6119 libcob/common.c:6138 -msgid "should be unsigned" -msgstr "" - -#: libcob/common.c:6127 libcob/common.c:6176 -#, fuzzy -msgid "should be numeric" -msgstr "mÃ¥ste vara numerisk" - -#: libcob/common.c:6185 -#, c-format -msgid "minimum value: %lu" -msgstr "minsta värde: %lu" - -#: libcob/common.c:6236 libcob/common.c:6787 libcob/common.c:6801 -#, c-format -msgid "should not contain '%c'" -msgstr "borde inte innehÃ¥lla â€%câ€" - -#: libcob/common.c:6316 libcob/common.c:6384 libcob/common.c:6393 -#: libcob/common.c:6401 -#, c-format -msgid "not set" -msgstr "" - -#: libcob/common.c:6376 libcob/common.c:6379 libcob/common.c:6382 -#, fuzzy, c-format -msgid "set by %s" -msgstr " (satt av %s)" - -#: libcob/common.c:6516 -#, c-format -msgid "WARNING - '%s' without a value - ignored!" -msgstr "VARNING - â€%s†utan ett värde - överhoppat!" - -#: libcob/common.c:6519 -#, c-format -msgid "'%s' without a value!" -msgstr "â€%s†utan ett värde!" - -#: libcob/common.c:6545 -#, c-format -msgid "WARNING - '%s %s' without a value - ignored!" -msgstr "VARNING - â€%s %s†utan ett värde - överhoppat!" - -#: libcob/common.c:7034 -#, fuzzy -msgid "error" -msgstr "fel: " - -#: libcob/common.c:7064 -msgid "attempt to CANCEL active program" -msgstr "försök att köra CANCEL pÃ¥ aktivt program" - -#: libcob/common.c:7091 -msgid "CALL of program with CHAINING clause" -msgstr "CALL till program med CHAINING-klausul" - -#: libcob/common.c:7095 -msgid "stack overflow, possible PERFORM depth exceeded" -msgstr "stacköverspill, möjligt PERFORM-djup överskridit" - -#: libcob/common.c:7100 -msgid "invalid entry/exit in GLOBAL USE procedure" -msgstr "ogiltig ingÃ¥ng/avslut i GLOBAL USE-procedur" - -#: libcob/common.c:7105 -msgid "unable to allocate memory" -msgstr "kan inte allokera minne" - -#: libcob/common.c:7110 -msgid "invalid entry into module" -msgstr "ogiltig ingÃ¥ng in i modul" - -#: libcob/common.c:7115 -#, c-format -msgid "recursive CALL from %s to %s which is NOT RECURSIVE" -msgstr "" - -#: libcob/common.c:7125 -#, fuzzy -msgid "divide by ZERO" -msgstr "division med konstant ZERO" - -#: libcob/common.c:7132 -msgid "end of file" -msgstr "slut pÃ¥ fil" - -#: libcob/common.c:7135 -msgid "key out of range" -msgstr "nyckel utanför intervall" - -#: libcob/common.c:7138 -msgid "key order not ascending" -msgstr "nyckelsortering inte stigande" - -#: libcob/common.c:7141 -msgid "record key already exists" -msgstr "postnyckel existerar redan" - -#: libcob/common.c:7144 -msgid "record key does not exist" -msgstr "postnyckel existerar inte" - -#: libcob/common.c:7147 -msgid "permanent file error" -msgstr "permanent filfel" - -#: libcob/common.c:7150 -#, fuzzy -msgid "inconsistant file name" -msgstr "ogiltigt namn pÃ¥ konfigurationsfil" - -#: libcob/common.c:7153 -msgid "file does not exist" -msgstr "filen existerar inte" - -#: libcob/common.c:7156 -msgid "permission denied" -msgstr "Ã¥tkomst nekad" - -#: libcob/common.c:7159 -msgid "file already open" -msgstr "fil redan öppen" - -#: libcob/common.c:7162 -msgid "file not open" -msgstr "fil inte öppen" - -#: libcob/common.c:7165 -msgid "READ must be executed first" -msgstr "READ mÃ¥ste köras först" - -#: libcob/common.c:7168 -msgid "record overflow" -msgstr "postöverspill" - -# sebras: unsuccessful -#: libcob/common.c:7171 -#, fuzzy -msgid "READ after unsuccessful READ/START" -msgstr "READ efter misslyckad READ/START" - -#: libcob/common.c:7174 -msgid "READ/START not allowed, file not open for input" -msgstr "READ/START inte tillÃ¥tet, fil inte öppen för inmatning" - -#: libcob/common.c:7177 -msgid "WRITE not allowed, file not open for output" -msgstr "WRITE inte tillÃ¥tet, fil inte öppen för utmatning" - -#: libcob/common.c:7180 -msgid "DELETE/REWRITE not allowed, file not open for I-O" -msgstr "DELETE/REWRITE inte tillÃ¥tet, fil inte öppen för in-/utmatning" - -#: libcob/common.c:7183 -msgid "record locked by another file connector" -msgstr "post lÃ¥st av en annan filkontakt" - -#: libcob/common.c:7186 -msgid "LINAGE values invalid" -msgstr "LINAGE-värden ogiltiga" - -#: libcob/common.c:7189 -msgid "file sharing conflict" -msgstr "fildelningskonflikt" - -#: libcob/common.c:7193 -msgid "runtime library is not configured for this operation" -msgstr "körtidsbibliotek är inte konfigurerat för denna Ã¥tgärd" - -#: libcob/common.c:7198 -msgid "unknown file error" -msgstr "okänt filfel" - -#: libcob/common.c:7205 -#, fuzzy, c-format -msgid "%s (status = %02d) for file %s" -msgstr "%s (status = %02d) fil: â€%sâ€" - -#: libcob/common.c:7208 -#, fuzzy, c-format -msgid "%s (status = %02d) for file %s on %s" -msgstr "%s (status = %02d) fil: â€%sâ€" - -#: libcob/common.c:7215 -msgid "attempt to use non-implemented function" -msgstr "försök att använda icke-implementerad funktion" - -#: libcob/common.c:7218 -#, fuzzy -msgid "attempt to use non-implemented XML I/O" -msgstr "försök att använda icke-implementerad funktion" - -#: libcob/common.c:7221 -#, fuzzy -msgid "attempt to use non-implemented JSON I/O" -msgstr "försök att använda icke-implementerad funktion" - -#: libcob/common.c:7268 -msgid "environment variables" -msgstr "miljövariabler" - -#: libcob/common.c:7315 -msgid "License LGPLv3+: GNU LGPL version 3 or later " -msgstr "Licens LGPLv3+: GNU LGPL version 3 eller senare " - -#: libcob/common.c:7372 libcob/common.c:7374 -msgid "dynamic loading" -msgstr "dynamisk inläsning" - -#: libcob/common.c:7379 -msgid "enabled" -msgstr "aktiverad" - -#: libcob/common.c:7460 libcob/common.c:7577 libcob/common.c:7586 -#: libcob/common.c:7603 libcob/common.c:7618 -#, fuzzy, c-format -msgid "%s, version %d.%d.%d" -msgstr "C-version %s%s" - -#: libcob/common.c:7462 libcob/common.c:7579 libcob/common.c:7588 -#: libcob/common.c:7620 -#, c-format -msgid "%s, version %d.%d.%d (compiled with %d.%d)" -msgstr "" - -#: libcob/common.c:7465 -#, fuzzy, c-format -msgid "%s, version %s" -msgstr "C-version %s%s" - -#: libcob/common.c:7486 libcob/common.c:7488 libcob/common.c:7493 -#: libcob/common.c:7495 libcob/common.c:7498 -#, fuzzy -msgid "mouse support" -msgstr "" - -#: libcob/common.c:7636 -msgid "CALL configuration" -msgstr "CALL-konfiguration" - -#: libcob/common.c:7637 -msgid "File I/O configuration" -msgstr "Fil in/ut-konfiguration" - -#: libcob/common.c:7638 -msgid "Screen I/O configuration" -msgstr "Skärm in/ut-konfiguration" - -#: libcob/common.c:7639 -msgid "Miscellaneous" -msgstr "Diverse" - -#: libcob/common.c:7640 -msgid "System configuration" -msgstr "Systemkonfiguration" - -#: libcob/common.c:7644 -msgid "runtime configuration" -msgstr "körtidskonfiguration" - -#: libcob/common.c:7646 -msgid "via" -msgstr "via" - -#: libcob/common.c:7719 libcob/common.c:7747 -msgid "... removed from environment" -msgstr "… borttagen frÃ¥n miljö" - -#: libcob/common.c:7773 libcob/common.c:7775 -#, fuzzy, c-format -msgid "(set by %s)" -msgstr " (satt av %s)" - -#: libcob/common.c:7783 -#, fuzzy, c-format -msgid "(reset)" -msgstr " (Ã¥terställd)" - -#: libcob/common.c:8167 libcob/common.c:8286 -#, c-format -msgid "%s called with unknown option: %d" -msgstr "" - -#: libcob/common.c:8239 -#, c-format -msgid "Module dump due to %s\n" -msgstr "" - -#: libcob/common.c:8243 -#, fuzzy, c-format -msgid " Last statement of %s was Line %d of %s\n" -msgstr "%s sats inte avslutad med %s" - -#: libcob/common.c:8249 -#, fuzzy, c-format -msgid " Last statement of %s unknown\n" -msgstr "systemnamn %s är okänt" - -#: libcob/common.c:8259 -#, c-format -msgid "Dump Program-Id %s from %s compiled %s\n" -msgstr "" - -#: libcob/fileio.c:287 -#, c-format -msgid "ERROR I/O routine %s is not present" -msgstr "" - -#: libcob/fileio.c:1365 -#, c-format -msgid "I/O routine %s is not present for %s" -msgstr "" - -#: libcob/fileio.c:1404 -#, c-format -msgid "I/O routine %s is not known for %s" -msgstr "" - -#: libcob/fileio.c:2599 -#, c-format -msgid "ERROR FILE %s has record size %d exceeds %d in program" -msgstr "" - -#: libcob/fileio.c:2967 libcob/fileio.c:2974 -#, c-format -msgid "ERROR FILE %s opening pipe" -msgstr "" - -#: libcob/fileio.c:4979 -#, c-format -msgid "ERROR FILE %s does not match current version; Recompile the program" -msgstr "" - -#: libcob/fileio.c:5034 -#, c-format -msgid "ERROR FILE %s has ASSIGN field is NULL" -msgstr "" - -#: libcob/fileio.c:5707 -#, c-format -msgid "call to CBL_OPEN_FILE with wrong access mode: %d" -msgstr "anrop till CBL_OPEN_FILE med fel Ã¥tkomstläge: %d" - -#: libcob/fileio.c:5756 -#, c-format -msgid "call to CBL_CREATE_FILE with wrong file_lock: %d" -msgstr "anrop till CBL_CREATE_FILE med fel file_lock: %d" - -#: libcob/fileio.c:5759 -#, c-format -msgid "call to CBL_CREATE_FILE with wrong file_dev: %d" -msgstr "anrop till CBL_CREATE_FILE med fel file_dev: %d" - -#: libcob/fileio.c:5955 libcob/fileio.c:6215 -#, c-format -msgid "'%s' - File detail area is too short" -msgstr "â€%s†- OmrÃ¥de för fildetaljer är för kort" - -#: libcob/fileio.c:6437 -msgid "SORT is unable to acquire temporary file" -msgstr "SORT kan inte fÃ¥ tag i temporärfil" - -#: libcob/fileio.c:7057 -#, fuzzy, c-format -msgid "implicit CLOSE of %s" -msgstr "implicit CLOSE av %s (â€%sâ€)" - -#: libcob/fileio.c:7165 -#, c-format -msgid "C-ISAM library %s is not present" -msgstr "" - -#: libcob/fileio.c:7173 -#, c-format -msgid "D-ISAM library %s is not present" -msgstr "" - -#: libcob/fileio.c:7181 -#, c-format -msgid "VB-ISAM library %s is not present" -msgstr "" - -#: libcob/screenio.c:429 -msgid "failed to initialize curses" -msgstr "misslyckades att initiera curses" - -#: libcob/screenio.c:3591 -msgid "end of program, please press a key to exit" -msgstr "slut pÃ¥ program, tryck pÃ¥ en tangent för att avsluta" - -#: libcob/termio.c:70 libcob/termio.c:106 -msgid "(Not representable)" -msgstr "(Inte representerbar)" - -#: libcob/termio.c:347 -#, fuzzy, c-format -msgid "cannot open %s (=%s)" -msgstr "kan inte ange bÃ¥de %s och %s" - -#: libcob/termio.c:362 -msgid "COB_DISPLAY_PUNCH_FILE is invalid, output to SYSPUNCH skipped" -msgstr "" - -#: bin/cobcrun.c:122 -msgid "GnuCOBOL module loader" -msgstr "" - -#: bin/cobcrun.c:124 -#, c-format -msgid "Usage: %s [options] PROGRAM [parameter ...]" -msgstr "Användning: %s [flaggor] PROGRAM [parameter …]" - -#: bin/cobcrun.c:126 -#, c-format -msgid " or: %s options" -msgstr " eller: %s flaggor" - -#: bin/cobcrun.c:129 -msgid "Options:" -msgstr "Flaggor:" - -#: bin/cobcrun.c:130 -msgid " -h, -help display this help and exit" -msgstr " -h, -help skriv ut denna hjälp och avsluta" - -#: bin/cobcrun.c:131 -msgid " -V, -version display cobcrun and runtime version and exit" -msgstr " -V, -version skriv ut cobcrun- och körtidsversion och avsluta" - -#: bin/cobcrun.c:132 -msgid " -i, -info display runtime information (build/environment)" -msgstr " -i, -info skriv ut körtidsinformation (bygge/miljö)" - -#: bin/cobcrun.c:134 -msgid " -q, -brief reduced displays" -msgstr " -q, -brief reducera utskrifter" - -#: bin/cobcrun.c:136 -msgid " -c , -config= set runtime configuration from " -msgstr " -c , -config= ställ in körtidskonfiguration frÃ¥n " - -#: bin/cobcrun.c:137 -#, fuzzy -msgid "" -" -r, -runtime-config display current runtime configuration\n" -" (value and origin for all settings)" -msgstr "" -" -r, -runtime-conf skriv ut aktuell körtidskonfiguration\n" -" (värde och härkomst för alla inställningar)" - -#: bin/cobcrun.c:139 -msgid "" -" -M , -module= set entry point module name and/or load path\n" -" where -M module prepends any directory to the\n" -" dynamic link loader library search path\n" -" and any basename to the module preload list\n" -" (COB_LIBRARY_PATH and/or COB_PRELOAD)" -msgstr "" -" -M , -module= ställ in modulnamn för ingÃ¥ngspunkt och/eller inläsningssökväg\n" -" där -M modul lägger till katalogen till bibliotekssökvägen\n" -" för den dynamiska länkningsinläsaren\n" -" och basnamn till modulförinläsningslistan\n" -" (COB_LIBRARY_PATH och/eller COB_PRELOAD)" - -#: bin/cobcrun.c:145 -#, c-format -msgid "" -"Report bugs to: %s\n" -"or (preferably) use the issue tracker via the home page." -msgstr "" -"Rapportera fel till: %s\n" -"eller (hellre) via felrapporteringssystemet via webbplatsen." - -#: bin/cobcrun.c:148 -#, fuzzy -msgid "GnuCOBOL home page: " -msgstr "GnuCOBOL webbplats: " - -#: bin/cobcrun.c:149 -#, fuzzy -msgid "General help using GNU software: " -msgstr "Allmän hjälp med att använda GNU-programvara: " - -#: bin/cobcrun.c:274 -msgid "invalid configuration file name" -msgstr "ogiltigt namn pÃ¥ konfigurationsfil" - -#: bin/cobcrun.c:325 -#, fuzzy, c-format -msgid "invalid module argument '%s'" -msgstr "ogiltigt modulargument" - -#: bin/cobcrun.c:377 -#, c-format -msgid "%s: missing PROGRAM name" -msgstr "" - -#: bin/cobcrun.c:379 -#, c-format -msgid "Try '%s --help' for more information." -msgstr "" - -#: bin/cobcrun.c:387 -#, fuzzy, c-format -msgid "%s: PROGRAM name exceeds %d characters" -msgstr "PROGRAM-namn överstiger 31 tecken" - -#~ msgid "%s: %d: invalid cast from '%s' type %s to type %s" -#~ msgstr "%s: %d: ogiltig typkonvertering frÃ¥n â€%s†typ %s till typ %s" - -#~ msgid " - length is < 1 or > 31" -#~ msgstr " - längden är < 1 eller > 31" - -#~ msgid "unknown name error '%s'%s" -#~ msgstr "okänt namnfel â€%sâ€%s" - -#~ msgid "ISAM handler" -#~ msgstr "ISAM-hanterare" - -#~ msgid "- NOT set with -Wall" -#~ msgstr "- INTE satt med -Wall" - -#~ msgid "- ALWAYS active" -#~ msgstr "- ALLTID aktiv" - -#~ msgid "default" -#~ msgstr "standard" - -#~ msgid "GnuCOBOL compiler for most COBOL dialects with lots of extensions" -#~ msgstr "GnuCOBOL-kompilator för de flesta COBOL-dialekter med mÃ¥nga utökningar" - -#~ msgid "Usage: %s [options]... file..." -#~ msgstr "Användning: %s [flaggor]… fil…" - -#~ msgid " -h, -help display this help and exit" -#~ msgstr " -h, -help visa denna hjälp och avsluta" - -#~ msgid " -V, -version display compiler version and exit" -#~ msgstr " -V, -version visa kompilatorversion och avsluta" - -#~ msgid "" -#~ " -i, -info display compiler information (build/environment)\n" -#~ " and exit" -#~ msgstr "" -#~ " -i, -info visa kompilatorinformation (bygge/miljö)\n" -#~ " och avsluta" - -#~ msgid "" -#~ " -v, -verbose display compiler version and the commands\n" -#~ " invoked by the compiler" -#~ msgstr "" -#~ " -v, -verbose visa kompilatorversion och kommandona\n" -#~ " som startas av kompilatorn" - -#~ msgid "" -#~ " -vv, -verbose=2 like -v but additional pass verbose option\n" -#~ " to assembler/compiler" -#~ msgstr "" -#~ " -vv, -verbose=2 som -v men skickar vidare utförlighetsflaggan\n" -#~ " till assembler/kompilator" - -#~ msgid "" -#~ " -vvv, -verbose=3 like -vv but additional pass verbose option\n" -#~ " to linker" -#~ msgstr "" -#~ " -vvv, -verbose=3 som -vv men skickar vidare utförlighetsflaggan\n" -#~ " till länkare" - -#~ msgid " -q, -brief reduced displays, commands invoked not shown" -#~ msgstr " -q, -brief reducera utskrifter, kommandon som körs visas inte" - -#~ msgid " -### like -v but commands not executed" -#~ msgstr " -### som -v men kommandon körs inte" - -#~ msgid " -x build an executable program" -#~ msgstr " -x bygg ett körbart program" - -#~ msgid " -m build a dynamically loadable module (default)" -#~ msgstr " -m bygg en dynamiskt inläsningsbar modul (standard)" - -#~ msgid " -j [], -job[=]\trun program after build, passing " -#~ msgstr " -j [], -job[=]\tkör program efter bygge, skicka vidare " - -#~ msgid "" -#~ " -std= warnings/features for a specific dialect\n" -#~ " can be one of:\n" -#~ " default, cobol2014, cobol2002, cobol85, xopen,\n" -#~ " ibm-strict, ibm, mvs-strict, mvs,\n" -#~ " mf-strict, mf, bs2000-strict, bs2000,\n" -#~ " acu-strict, acu, rm-strict, rm;\n" -#~ " see configuration files in directory config" -#~ msgstr "" -#~ " -std= varningar/funktioner för en specifik dialekt\n" -#~ " kan vara endera av:\n" -#~ " default, cobol2014, cobol2002, cobol85, xopen,\n" -#~ " ibm-strict, ibm, mvs-strict, mvs,\n" -#~ " mf-strict, mf, bs2000-strict, bs2000,\n" -#~ " acu-strict, acu, rm-strict, rm;\n" -#~ " se konfigurationsfiler i katalogkonfiguration" - -#~ msgid " -fixed use fixed source format (default)" -#~ msgstr " -fixed använd fixerat källkodsformat (standard)" - -#~ msgid " -O, -O2, -O3, -Os enable optimization" -#~ msgstr " -O, -O2, -O3, -Os aktivera optimering" - -#~ msgid " -g enable C compiler debug / stack check / trace" -#~ msgstr " -g aktivera C-kompilatorns felsökning / stackkontroll / spÃ¥rning" - -#~ msgid " -d, -debug enable all run-time error checking" -#~ msgstr " -d, -debug aktivera all felkontroll för körtid" - -#~ msgid " -o place the output into " -#~ msgstr " -o placera utmatning i " - -#~ msgid "" -#~ " -b combine all input files into a single\n" -#~ " dynamically loadable module" -#~ msgstr "" -#~ " -b kombinera alla indatafiler i en enda\n" -#~ " dynamiskt inläsningsbar modul" - -#~ msgid " -E preprocess only; do not compile or link" -#~ msgstr " -E preprocessa bara; kompilera och länka inte" - -#~ msgid " -C translation only; convert COBOL to C" -#~ msgstr " -C översätt bara; konvertera COBOL till C" - -#~ msgid " -S compile only; output assembly file" -#~ msgstr " -S kompilera bara; mata ut assemblerfil" - -#~ msgid " -c compile and assemble, but do not link" -#~ msgstr " -c kompilera och assemblera, men länka inte" - -#~ msgid " -T generate and place a wide program listing into " -#~ msgstr " -T generera och placera en bred programlistning i " - -#~ msgid " -t generate and place a program listing into " -#~ msgstr " -t generera och placera programlistning i " - -#~ msgid " --tlines= specify lines per page in listing, default = 55" -#~ msgstr " --tlines= ange rader per sida i listning, standard = 55" - -#~ msgid " -P[=] generate preprocessed program listing (.lst)" -#~ msgstr " -P[=] generera preprocessad programlistning (.lst)" - -#~ msgid " -Xref specify cross reference in listing" -#~ msgstr " -Xref ange korsreferens i listning" - -#~ msgid " -I add to copy/include search path" -#~ msgstr " -I lägg till till kopierings-/inkluderingssökväg" - -#~ msgid " -L add to library search path" -#~ msgstr " -L lägg till till bibliotekssökväg" - -#~ msgid " -l link the library " -#~ msgstr " -l länka med bibliotek " - -#~ msgid " -A add to the C compile phase" -#~ msgstr " -A lägg till vid C-kompileringsfasen" - -#~ msgid " -Q add to the C link phase" -#~ msgstr " -Q lägg till vid C-länkningsfas" - -#~ msgid " -D define for COBOL compilation" -#~ msgstr " -D definiera vid COBOL-kompilering" - -#~ msgid " -K generate CALL to as static" -#~ msgstr " -K generera CALL till som statiskt" - -#~ msgid " -conf= user-defined dialect configuration; see -std" -#~ msgstr " -conf= användardefinierad dialektkonfiguration; se -std" - -#~ msgid " -list-reserved display reserved words" -#~ msgstr " -list-reserved visa reserverade ord" - -#~ msgid " -list-intrinsics display intrinsic functions" -#~ msgstr " -list-intrinsics visa inbyggda funktioner" - -#~ msgid " -list-mnemonics display mnemonic names" -#~ msgstr " -list-mnemonics visa mnemonic-namn" - -#~ msgid " -list-system display system routines" -#~ msgstr " -list-system visa systemrutiner" - -#~ msgid "" -#~ " -save-temps[=] save intermediate files\n" -#~ " - default: current directory" -#~ msgstr "" -#~ " -save-temps[=] spara intermediära filer\n" -#~ " - standard: aktuell katalog" - -#~ msgid " -ext add file extension for resolving COPY" -#~ msgstr " -ext lägg till filslut för COPY-upplösning" - -#~ msgid " -W enable all warnings" -#~ msgstr " -W aktivera alla varningar" - -#~ msgid " -Wall enable most warnings (all except as noted below)" -#~ msgstr " -Wall aktivera de flesta varningar (alla förutom de som nämns nedan)" - -#~ msgid " -Wno- disable warning enabled by -W or -Wall" -#~ msgstr " -Wno- inaktivera varning aktiverad av -W eller -Wall" - -#~ msgid " -Werror= treat specified as error" -#~ msgstr " -Werror= behandla angiven som fel" - -#~ msgid "" -#~ msgstr "" - -#~ msgid "where is one of the following:" -#~ msgstr "där är endera av följande:" - -#~ msgid "word to be taken out of the reserved words list" -#~ msgstr "ord som tas ut ur listan över reserverade ord" - -#~ msgid "" -#~ msgstr "" - -#~ msgid "word to be added to reserved words list" -#~ msgstr "ord som läggs till listan över reserverade ord" - -#~ msgid "word to be added to reserved words list as alias" -#~ msgstr "ord som läggs till listor över reserverade ord som alias" - -#~ msgid ":" -#~ msgstr ":" - -#~ msgid "invalid parameter -std=%s" -#~ msgstr "ogiltig parameter -std=%s" - -#~ msgid "invalid option detected" -#~ msgstr "ogiltig flagga hittad" - -#~ msgid "unknown option ignored:\t%s" -#~ msgstr "okänd flagga överhoppad:\t%s" - -#~ msgid "Invalid type for '%s'" -#~ msgstr "Ogiltig typ för â€%sâ€" - -#~ msgid "invalid type for '%s'" -#~ msgstr "ogiltig typ för â€%sâ€" - -#~ msgid "constant item '%s' cannot have a %s clause" -#~ msgstr "konstantobjekt â€%s†kan inte ha en %s-klausul" - -#~ msgid "define PERFORM stack size" -#~ msgstr "definiera PERFORM-stackstorlek" - -#~ msgid "" -#~ msgstr "" - -#~ msgid "define cutoff depth for IF statements" -#~ msgstr "definiera avstängningsdjup för IF-satser" - -#~ msgid "define display sign representation" -#~ msgstr "definiera visning av teckenrepresentation" - -#~ msgid "machine native" -#~ msgstr "maskininbyggd" - -#~ msgid "fold COPY subject to value" -#~ msgstr "vik COPY-ämne till värde" - -#~ msgid "no transformation" -#~ msgstr "ingen transformering" - -#~ msgid "fold PROGRAM-ID, CALL, CANCEL subject to value" -#~ msgstr "vik PROGRAM-ID, CALL, CANCEL-ämne till värde" - -#~ msgid "initialize fields without VALUE to decimal value" -#~ msgstr "initiera fält utan VALUE till decimalvärde" - -#~ msgid "0..255 or any quoted character" -#~ msgstr "0..255 eller vilket citerat tecken som helst" - -#~ msgid "initialize to picture" -#~ msgstr "initiera till bild" - -#~ msgid "maximum number of errors to report" -#~ msgstr "maximalt antal fel att rapportera" - -#~ msgid "intrinsics to be used without FUNCTION keyword" -#~ msgstr "inbyggda funktioner som kan användas utan nyckelordet FUNCTION" - -#~ msgid "[ALL|intrinsic function name(,name,...)]" -#~ msgstr "[ALL|namn pÃ¥ inbyggd funktion(,namn,…)]" - -#~ msgid "generate extra braces in generated C code" -#~ msgstr "generera extra klammerparenteser i genererad C-kod" - -#~ msgid "" -#~ "generate trace code\n" -#~ "\t\t\t- executed SECTION/PARAGRAPH" -#~ msgstr "" -#~ "generera spÃ¥rningskod\n" -#~ "\t\t\t- körd SECTION/PARAGRAPH" - -#~ msgid "" -#~ "adjust items following OCCURS DEPENDING\n" -#~ "\t\t\t- requires implicit/explicit relaxed syntax" -#~ msgstr "" -#~ "justera objekt som följer pÃ¥ OCCURS DEPENDING\n" -#~ "\t\t\t- kräver implicit/explicit-avslappnad syntax" - -#~ msgid "check recursive program call" -#~ msgstr "kontrollera rekursivt programanrop" - -#~ msgid "" -#~ "relax syntax checking\n" -#~ "\t\t\t- e.g. REDEFINES position" -#~ msgstr "" -#~ "lätta upp syntaxkontroll\n" -#~ "\t\t\t- t.ex. REDEFINES-plats" - -#~ msgid "PICTURE SYMBOL for CURRENCY must be one character long" -#~ msgstr "PICTURE SYMBOL för CURRENCY mÃ¥ste vara ett tecken lÃ¥ngt" - -#~ msgid "invalid character '%c' in PICTURE SYMBOL for CURRENCY" -#~ msgstr "ogiltigt tecken â€%c†i PICTURE SYMBOL för CURRENCY" - -#~ msgid "88-level cannot be used here" -#~ msgstr "88-nivÃ¥ kan inte användas här" - -#~ msgid "incorrect order of CONFIGURATION SECTION paragraphs" -#~ msgstr "felaktig ordning pÃ¥ CONFIGURATION SECTION-stycken" - -#~ msgid "incorrect order of SOURCE- and OBJECT-COMPUTER paragraphs" -#~ msgstr "felaktig ordning pÃ¥ SOURCE- och OBJECT-COMPUTER-stycken" - -#~ msgid "CURRENCY SIGN longer than one character" -#~ msgstr "CURRENCY SIGN längre än ett tecken" - -#~ msgid "CURRENCY SIGN other than '$'" -#~ msgstr "CURRENCY SIGN annat än â€$â€" - -#~ msgid "RECORD description invalid with REPORT" -#~ msgstr "RECORD-beskrivning ogiltig med REPORT" - -#~ msgid "COMMUNICATION SECTION" -#~ msgstr "COMMUNICATION SECTION" - -#~ msgid "REDEFINES clause should follow entry-name" -#~ msgstr "REDEFINES-klausul bör följa pÃ¥ postnamn" - -#~ msgid "ANY LENGTH items may only be BY REFERENCE formal parameters" -#~ msgstr "ANY LENGTH-objekt fÃ¥r endast vara BY REFERENCE-formella parametrar" - -#~ msgid "parameters passed BY VALUE" -#~ msgstr "parametrar skickade BY VALUE" - -#~ msgid "ignoring CONVERSION" -#~ msgstr "hoppar över CONVERSION" - -#~ msgid "%s is not implemented" -#~ msgstr "%s är inte implementerad" - -#~ msgid "table SORT without keys" -#~ msgstr "tabell SORT utan nycklar" - -#~ msgid "invalid target for DEBUGGING ALL" -#~ msgstr "ogiltigt mÃ¥l för DEBUGGING ALL" - -#~ msgid "non-negative integer value expected" -#~ msgstr "icke-negativt heltalsvärde förväntades" - -#~ msgid "'LENGTH OF' phrase" -#~ msgstr "â€LENGTH OFâ€-fras" - -#~ msgid "cannot find the UTC offset on this system" -#~ msgstr "kan inte hitta UTC-differens pÃ¥ detta system" - -#~ msgid "invalid literal cast" -#~ msgstr "ogiltig typkonvertering av litteral" - -#~ msgid "only one set of parentheses is permitted" -#~ msgstr "endast en uppsättning parenteser tillÃ¥ts" - -#~ msgid "no definition/prototype seen for function '%s'" -#~ msgstr "ingen definition/prototyp hittad för funktion â€%sâ€" - -#~ msgid "no definition/prototype seen for function with external name '%s'" -#~ msgstr "ingen definition/prototyp hittad för funktion med externt namn â€%sâ€" - -#~ msgid "invalid use of 88 level item" -#~ msgstr "ogiltig användning av nivÃ¥ 88-objekt" - -#~ msgid "reference to item containing nested ODO" -#~ msgstr "referens till objekt som innehÃ¥ller nästlad ODO" - -#~ msgid "invalid use of HANDLE item" -#~ msgstr "ogiltig användning av HANDLE-objekt" - -#~ msgid "Variable length item not allowed here" -#~ msgstr "Objekt med variabel längd inte tillÃ¥tet här" - -#~ msgid "the CHARACTERS field of ALLOCATE must be numeric" -#~ msgstr "fältet CHARACTERS för ALLOCATE mÃ¥ste vara numeriskt" - -#~ msgid "HANDLE must be either a generic or a WINDOW handle" -#~ msgstr "HANDLE mÃ¥ste vara antingen en generisk eller ett WINDOW-handtag" - -#~ msgid "warn type mismatch strictly" -#~ msgstr "varna om typer inte stämmer överens strikt" - -#~ msgid "warn unreachable statements" -#~ msgstr "varna för onÃ¥bara satser" - -#~ msgid "cannot find module" -#~ msgstr "kan inte hitta modul" - -#~ msgid "cannot find entry point" -#~ msgstr "kan inte hitta ingÃ¥ngspunkt" - -#~ msgid "%s: COBOL runtime is not initialized" -#~ msgstr "%s: COBOL-körtid är inte initierad" - -#~ msgid "%s COBOL runtime is not initialized" -#~ msgstr "%s COBOL-körtid är inte initierad" - -#~ msgid "%s: attempt to over-write constant param %d" -#~ msgstr "%s: försök att skriva över konstantparameter %d" - -#~ msgid "cob_sig_handler caught not handled signal: %d" -#~ msgstr "cob_sig_handler fÃ¥ngade ohanterad signal: %d" - -#~ msgid "libcob has version/patch level %s/%d" -#~ msgstr "libcob har version/programfixnivÃ¥ %s/%d" - -#~ msgid "malloc error" -#~ msgstr "malloc-fel" - -#~ msgid "codegen error - Please report this!" -#~ msgstr "kodgenereringsfel - Rapportera detta!" - -#~ msgid "invalid recursive COBOL CALL to '%s'" -#~ msgstr "ogiltigt rekursivt COBOL CALL till â€%sâ€" - -#~ msgid "EXTFH" -#~ msgstr "EXTFH" - -#~ msgid "BDB error: %s" -#~ msgstr "BDB-fel: %s" - -#~ msgid "BDB error: %s %s" -#~ msgstr "BDB-fel: %s %s" - -#~ msgid "cannot join BDB environment (%s), error: %d %s" -#~ msgstr "kan inte sammanfoga BDB-miljö (%s): fel: %d %s" - -#~ msgid "COBOL driver program for GnuCOBOL modules" -#~ msgstr "COBOL-drivrutinsprogram för GnuCOBOL-moduler" - -#~ msgid "problem with setenv %s: %d" -#~ msgstr "problem med setenv %s: %d" diff -Nru gnucobol-4.0~early~20200606/po/update_linguas.sh gnucobol-5/po/update_linguas.sh --- gnucobol-4.0~early~20200606/po/update_linguas.sh 2020-06-06 20:52:02.000000000 +0000 +++ gnucobol-5/po/update_linguas.sh 1970-01-01 00:00:00.000000000 +0000 @@ -1,37 +0,0 @@ -#!/bin/sh -# shell for updating the translations before a release - -# Let this be executed in the po/ subdir. -cd "$(dirname "$0")" || exit - -echo "Updating translations via TP" -rsync -Lrtvz translationproject.org::tp/latest/gnucobol/ . # || exit - -# Are there now PO files that are not in svn yet? -NEWSTUFF=$(svn status | grep "^\? .*.po$" | sed -e's/\? *//') - -if [ -n "${NEWSTUFF}" ]; then - echo; echo "New languages found; updating LINGUAS ..." - echo "# List of available languages." >LINGUAS - echo "en@boldquot en@quot" $(printf '%s\n' *.po | LC_ALL=C sort | sed -e 's/\.po//g' -e 's/en\@.*//g') >>LINGUAS - echo "... and adding new files to svn:" - for file in "${NEWSTUFF}"; do svn add $file; done -fi - -echo; echo "Regenerating POT file and remerging and recompiling PO files..." - -if test -f Makefile; then - make update-po - - # Ensure that the PO files are newer than the POT. - touch *.po - - # Compile PO files - make - -else - - echo; echo "WARNING: no Makefile available!" - echo "remerge and compilation of PO files isn't done yet" - echo; -fi diff -Nru gnucobol-4.0~early~20200606/README gnucobol-5/README --- gnucobol-4.0~early~20200606/README 2020-06-06 20:52:02.000000000 +0000 +++ gnucobol-5/README 1970-01-01 00:00:00.000000000 +0000 @@ -1,325 +0,0 @@ - - GnuCOBOL - https://www.gnu.org/software/gnucobol/ - https://sourceforge.net/projects/open-cobol - https://savannah.gnu.org/projects/gnucobol - -GnuCOBOL is a free (like both in "free speech" and in "free beer") -COBOL compiler, formerly known as OpenCOBOL. -It implements a substantial part of the COBOL 85, COBOL 2002 and COBOL 2014 -standards, as well as many extensions included in other COBOL compilers. - -GnuCOBOL translates COBOL into C and compiles the translated code -using the native C compiler on various platforms, including Unix/Linux, -Mac OS X, and Microsoft Windows. - -This package contains the following subdirectories: - - cobc COBOL compiler - libcob COBOL run-time library - bin COBOL driver program - build_aux Helper scripts - lib Helper routines for missing OS functionality - config Configuration files - po International messages - doc 'info' and 'pdf' files - tests Test suite (GnuCOBOL and framework for COBOL85) - extras useful COBOL programs - -All programs except those in lib and libcob are distributed under -the GNU General Public License. See COPYING for details. - -Programs in lib and libcob are distributed under the GNU Lesser -General Public License. See COPYING.LESSER for details. - -For any copyright year range specified as YYYY-ZZZZ in this package, -that the range specifies every single year in that closed interval. - -Although many have participated, most development thanks go to - - Roger While - Keisuke Nishida - -See AUTHORS for the author of each file. - -============ -Requirements -============ - - *** - NOTE - For all the following packages (required or optional), - BOTH runtime AND development components are necessary. - *** - *** - NOTE - All the following packages are normally part of a Linux - distribution. Cygwin distribution also has these as installable - packages, other operating systems also may have repositories for - these - eg. MAC OS, CentOS and others all have package repositories. - ALWAYS install the distribution packages when available !! - *** - -GnuCOBOL REQUIRES one of the following external libraries to be installed -for implementation of decimal arithmetic: - - BOTH runtime AND development components required. - - o GNU MP (libgmp) 4.1.2 or later - https://gmplib.org - - OR - - o MPIR (libgmp - MPIR gmp-compat) 1.3.1 or later - (preferred when compiling on Windows with other compilers than GCC) - http://mpir.org - - GNU MP and MPIR are distributed under GNU Lesser General Public License. - - NOTE - Please ALWAYS use the distro package whenever possible !! - See NOTE above. - - -GnuCOBOL MAY require the following external libraries to be installed: - - *** - NOTE - libltdl is NOT needed when installing on Linux, - SUN Solaris, MAC OS, CentOS or Windows - (including Cygwin, MingW and native windows). - It is also NOT needed with later versions of AIX and HP-UX. - (AIX >= 5.1 and HP-UX >= 11.1 are known to NOT require this). - (Check if you have the "dlopen" function). - *** - - o GNU Libtool (libltdl) - https://www.gnu.org/software/libtool/libtool.html - - libltdl is used to implement dynamic CALL statements. - - GNU Libtool is distributed under GNU Lesser General Public License. - - -The following libraries ARE required WHEN : - -1) Indexed-Sequential file I/O (ISAM) is used - - BOTH runtime AND development components required. - - One of the following: - - o Berkeley DB (libdb) 4.1 or later - https://www.oracle.com/ - https://www.oracle.com/technology/products/berkeley-db/db/index.html - - Berkeley DB is distributed under Oracles own open-source license. - Note that if you linked your software with Berkeley DB, - you must distribute the source code of your software along with your - software, or you have to pay royalty to Oracle. - - o VBISAM - ISAM file handler (libvbisam) 2.0 or later - https://sourceforge.net/projects/vbisam/ - - VBISAM is distributed under GNU Lesser General Public License. - - o DISAM File handler (libdisam) - http://www.isamcentral.com - - DISAM is distributed under the proprietary License - "Byte Designs Ltd. DISAM Software License". - -2) SCREEN SECTION and/or extended ACCEPT/DISPLAY is used - - BOTH runtime AND development components required. - - One of the following: - - o Ncurses (ncurses or ncursesw) 5.2 or later - https://www.gnu.org/software/ncurses/ncurses.html - - Ncurses is distributed under a BSD style license. - - o PDCurses (pdcurses) for MinGW/native windows ports - https://pdcurses.org/ or https://github.com/Bill-Gray/PDCurses/ - - PDCurses is distributed as Public Domain. - - o Unix curses - -3) XML runtime support is used - - BOTH runtime AND development components required. - - libxml2 - http://xmlsoft.org - - libxml2 is distributed under MIT License. - -4) JSON runtime support is used - - BOTH runtime AND development components required. - As an alternative of an installed version you may place - cJSON.c and cJSON.h under "libcob" to include the used functions - directly in the COBOL runtime. - - cJSON >= 1.3.0 - https://github.com/DaveGamble/cJSON - - cJSON is distributed under MIT License. - -============ - -============ -Installation -============ - -See the INSTALL file for detailed information about how to configure -and install GnuCOBOL. -Special requirements and further installation notes are listed below. - -** NOTE ** - The default installation path for GnuCOBOL is /usr/local. - The installation path may be changed by specifying --prefix= - as a parameter to the configure. - Further parameters may be specified to affect - include/library search paths. - Execute ./configure --help for further details. - -To generate/install GnuCOBOL : - -************************************** - - Configure and build - ./configure - make - - Here you may run different tests with the version of GnuCOBOL that is - not installed yet, see "Tests" below. - This is *highly recommended* before installing. - - Install - make install - -** NOTE ** - You generally need super-user privileges to execute "make install" - unless you changed the installation directory with - "./configure --prefix=" or install to a different location with - "make install DESTDIR=". - In those later cases you only need to have full access to . - -** NOTE ** - On Linux systems, if you are installing for the - -first- time, you may need to run "ldconfig" (as root). - In fact, it does not hurt if you always do this. - -** NOTE ** - On some Red Hat (Fedora) installations and - possibly other Linux distros, /usr/local/lib - is NOT automatically searched at runtime. - Edit /etc/ld.so.conf (or the equivalent file) and add - /usr/local/lib to the file. - Rerun "ldconfig". - -************************************** - -If you think you have a problem or just want to log -the output of make then redirect the output with : - make 1>mymake.log 2>&1 - make install 1>myinstall.log 2>&1 - -************************************** - -You can get back to a clean installation status by running : - make distclean - -************************************** - - -============ -Tests -============ - - - To run the internal testsuite, simply do - make check - This MUST succeed - If not, please report. - - You may optionally perform a series of COBOL85 tests. - make test - It is recommended that you also perform these tests. - -** NOTE ** - The language interpreter "perl" is required to run COBOL85 tests. - -** NOTE ** - Running "make test" will try to download the COBOL85 - testsuite if it is missing. - For details see tests/cobol85/README. - - If you want to run both testsuites you can run - make checkall - - -============ - -The following is only interesting for advanced use. -A normal user should not have recourse to use these -options. - -There are many configure options (see configure --help for a full list), -these are the most important ones: - - --with-db Use Berkeley DB >= 4.1 (libdb) (ISAM handler) - This is the default - - --without-db Do neither use Berkeley DB nor any other ISAM handler - You will not be able to use indexed I/O - - --with-vbisam Use VBISAM (libvbisam) (ISAM handler) - - --with-dl Use the system dynamic linker - This is the default - - --without-dl Use ltdl for dynamic program loading - - --with-patch-level= Set internal patch level to n (default 0) - - --with-varseq= Define the default format for variable - length sequential files. - - The default may be overridden at run time by - setting the environment variable - COB_VARSEQ_FORMAT to 0, 1, 2, or 3. - - For values of 0, 1 and 2, four bytes are - written preceding each record. The format of - these four bytes for values of 0, 1, 2 is - as follows : - n = 0 (default) - The first 2 bytes are the record length - in big-endian order. This is compatible - with mainframe. Bytes 3 and 4 are set - to binary 0. - n = 1 - The 4 bytes are the record length in - big-endian order. - n = 2 - The 4 bytes are the record length in - native machine order (int). - (This was previously the default) - - For the value of 3, two bytes are written - preceding each record : - n = 3 - The first 2 bytes are the record length - in big-endian order. The record follows - immediately after beginning at byte 3. - - --enable-debug Add '-g' debug option to make - -============ - -============ -Development -============ - -If you wish to hack the GnuCOBOL source or build from version control, -see HACKING. diff -Nru gnucobol-4.0~early~20200606/tarstamp.h gnucobol-5/tarstamp.h --- gnucobol-4.0~early~20200606/tarstamp.h 2020-06-06 20:56:36.000000000 +0000 +++ gnucobol-5/tarstamp.h 1970-01-01 00:00:00.000000000 +0000 @@ -1,3 +0,0 @@ -#define COB_TAR_DATE "Jun 06 2020 20:56:36 UTC" -#define COB_NUM_TAR_DATE 20200606 -#define COB_NUM_TAR_TIME 205636 diff -Nru gnucobol-4.0~early~20200606/tests/atlocal.in gnucobol-5/tests/atlocal.in --- gnucobol-4.0~early~20200606/tests/atlocal.in 2020-06-06 20:52:00.000000000 +0000 +++ gnucobol-5/tests/atlocal.in 1970-01-01 00:00:00.000000000 +0000 @@ -1,155 +0,0 @@ -# -# atlocal gnucobol/tests -# -# Copyright (C) 2003-2012, 2014-2020 Free Software Foundation, Inc. -# Written by Keisuke Nishida, Roger While, Simon Sobisch, Edward Hart -# -# This file is part of GnuCOBOL. -# -# The GnuCOBOL compiler is free software: you can redistribute it -# and/or modify it under the terms of the GNU General Public License -# as published by the Free Software Foundation, either version 3 of the -# License, or (at your option) any later version. -# -# GnuCOBOL is distributed in the hope that it will be useful, -# but WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -# GNU General Public License for more details. -# -# You should have received a copy of the GNU General Public License -# along with GnuCOBOL. If not, see . - -if test "$GNUCOBOL_ENV_SETUP" != "1" -a "$GNUCOBOL_TEST_LOCAL" != "1"; then - ABS_COBC="${abs_top_builddir}/cobc/cobc@COB_EXE_EXT@" - ABS_COBCRUN="${abs_top_builddir}/bin/cobcrun@COB_EXE_EXT@" - # prepend PATH with the actual binaries to let the testsuite find them for - # general check and version output, nomally not needed - PATH="${abs_top_builddir}/libcob/.libs:${abs_top_builddir}/cobc:${abs_top_builddir}/bin:${PATH}" - export PATH -fi -COBC="cobc@COB_EXE_EXT@" -COBCRUN="cobcrun@COB_EXE_EXT@" -COBCRUN_DIRECT="" # used for running created executables through tools - -# be sure to use the English messages -LC_ALL=C -export LC_ALL - - -TEMPLATE="${abs_srcdir}/testsuite.src" - -FLAGS="-debug -Wall ${COBOL_FLAGS}" -COMPILE="${COBC} -x ${FLAGS}" -COMPILE_ONLY="${COBC} -fsyntax-only ${FLAGS} -Wno-unsupported" -COMPILE_MODULE="${COBC} -m ${FLAGS}" - -# Helper script to unify listings (replace version, date, time) -UNIFY_LISTING="${abs_srcdir}/listings-sed.sh" - -# test runner for manual tests, content may be changed by the user -RUN_PROG_MANUAL="${abs_builddir}/run_prog_manual.sh" - -# unset option if not internally set -_unset_option () { - if test "$1" != "COB_CONFIG_DIR" \ - -a "$1" != "COB_RUNTIME_CONFIG"; then - unset $1 - fi -} - -# unset all environment variables that are used in libcob -# for runtime configuration -COB_RUNTIME_CONFIG="${abs_top_srcdir}/config/runtime_empty.cfg" -export COB_RUNTIME_CONFIG -for cobenv in `"${abs_top_builddir}/pre-inst-env" $COBCRUN --runtime-conf | grep COB_ | cut -d: -f2 | cut -d= -f1`; \ - do _unset_option $cobenv; \ -done - -# different flags checked in the testsuite -COB_UNIX_LF=1 -export COB_UNIX_LF - -if test "$GNUCOBOL_TEST_LOCAL" != "1"; then - COB_OBJECT_EXT="@COB_OBJECT_EXT@" - COB_EXE_EXT="@COB_EXE_EXT@" - COB_BIGENDIAN="@COB_BIGENDIAN@" - COB_HAS_ISAM="@COB_HAS_ISAM@" - COB_HAS_XML2="@COB_HAS_XML2@" - COB_HAS_CJSON="@COB_HAS_CJSON@" - COB_HAS_CURSES="@COB_HAS_CURSES@" - COB_HAS_64_BIT_POINTER="@COB_HAS_64_BIT_POINTER@" -else - COB_OBJECT_EXT="$($COBC --info | grep COB_OBJECT_EXT | cut -d: -f2 | cut -b2-)" - COB_EXE_EXT="$($COBC --info | grep COB_EXE_EXT | cut -d: -f2 | cut -b2-)" - - COB_HAS_64_BIT_POINTER=`$COBCRUN --info | grep "64bit-mode" | cut -d: -f2 | cut -b2-` - if test $($COBC --info | grep -i -c "ISAM.*disabled") = 0; then - COB_HAS_ISAM="yes" - else - COB_HAS_ISAM="no" - fi - if test $($COBC --info | grep -i -c "XML library.*disabled") = 0; then - COB_HAS_XML2="yes" - else - COB_HAS_XML2="no" - fi - if test $($COBC --info | grep -i -c "JSON library.*disabled") = 0; then - COB_HAS_CJSON="yes" - else - COB_HAS_CJSON="no" - fi -fi -if test "x$MSYSTEM" != "x" -o "$OSTYPE" = "cygwin"; then - # running MSYS builds as not-visible child processes result in - # "Redirection is not supported" (old PDcurses) and exit 127 (NCurses) - # --> disabling the tests for this feature - COB_HAS_CURSES="no" -fi -export COB_HAS_ISAM COB_HAS_XML2 COB_HAS_CJSON COB_HAS_CURSES COB_HAS_64_BIT_POINTER -export COBC COBCRUN COBCRUN_DIRECT RUN_PROG_MANUAL -export COB_OBJECT_EXT COB_EXE_EXT - -COB_SCHEMA_DIR=. -export COB_SCHEMA_DIR - -# possible path conversion for running the testsuite in an environment -# that doesn't match the one where the tested binaries were built -# Note: not needed for running the testsuite with MSYS as this translates the path -# if MSYS_NO_PATHCONV=1 is not set -_return_path () { - echo "$1" -} - -# options that are also used in pre-inst-env (always add to both) -# but not directly in the testsuite -if test "$GNUCOBOL_ENV_SETUP" != "1" -a "$GNUCOBOL_TEST_LOCAL" != "1"; then - COB_CFLAGS="-I${abs_top_srcdir} @COB_CFLAGS@" - COB_LDFLAGS="@COB_LDFLAGS@" - COB_LIBS="-L${abs_top_builddir}/libcob/.libs -lcob" - COB_CONFIG_DIR="${abs_top_srcdir}/config" - COB_COPY_DIR="${abs_top_srcdir}/copy" - LD_LIBRARY_PATH="${abs_top_builddir}/libcob/.libs:$LD_LIBRARY_PATH" - DYLD_LIBRARY_PATH="${abs_top_builddir}/libcob/.libs:$DYLD_LIBRARY_PATH" - SHLIB_PATH="${abs_top_builddir}/libcob/.libs:$SHLIB_PATH" - LIBPATH="${abs_top_builddir}/libcob/.libs:$LIBPATH" - COB_LIBRARY_PATH="${abs_top_builddir}/extras:$COB_LIBRARY_PATH" - - export COB_CFLAGS COB_LDFLAGS COB_LIBS - export COB_CONFIG_DIR COB_COPY_DIR - export LD_LIBRARY_PATH DYLD_LIBRARY_PATH SHLIB_PATH LIBPATH - export COB_LIBRARY_PATH -fi - -# Fix for testcases where cobc translates path to win32 equivalents -if test "x$MSYSTEM" != "x"; then - PATHSEP=";" -else - PATHSEP='@PATH_SEPARATOR@'; -fi -export PATHSEP - -# to ensure that no external DB_HOME is polluted: unset -DB_HOME="" && export DB_HOME - -# For the very rare cases where cobc/libcob may need to know if they're running in test mode: -COB_IS_RUNNING_IN_TESTMODE=1 && export COB_IS_RUNNING_IN_TESTMODE diff -Nru gnucobol-4.0~early~20200606/tests/ChangeLog gnucobol-5/tests/ChangeLog --- gnucobol-4.0~early~20200606/tests/ChangeLog 2020-06-06 20:52:00.000000000 +0000 +++ gnucobol-5/tests/ChangeLog 1970-01-01 00:00:00.000000000 +0000 @@ -1,977 +0,0 @@ - -2020-04-02 Simon Sobisch - - * run_prog_manual.sh.in, testsuite.src/run_manual_screen.at: - pass program to run to the script instead of hard-wire of "./prog" - -2020-02-02 Simon Sobisch - - * atlocal.in: always set COB_SCHEMA_DIR to not access anything outside - of builddir - -2020-01-02 Simon Sobisch - - * testsuite.src: moved trace related tests from run_misc.at to run_file.at - -2019-06-30 Simon Sobisch - - * run_prog_manual.sh.in, Makefile.am: changed the manual test runner - to be a script handled by autoconf instead of make - -2019-06-18 Simon Sobisch - - * atlocal.in: explicit disable BDB internal locking by unsetting DB_HOME - to work around issues in different environments and to not pollute the - users's general BDB locking files - -2019-06-11 Simon Sobisch - - * Makefile.am (check, checkmanual): now fails if the testsuite reports - any unexpected result (exit with non-zero return) - -2019-05-24 Simon Sobisch - - * atlocal.in: early unset of COB_ variables (before we set them...) - -2019-04-06 Simon Sobisch - - * Makefile.am, atlocal.in: splitted some make targets and added new - localcheck target, which runs the testsuite using the current - environment (whatever GnuCOBOL version is in PATH) - -2019-03-23 Simon Sobisch - - * testsuite.src/run_fundamental.at, testsuite.src/run_misc.at: - adjusted C test sources in the testsuite to include stdio.h - where necessary - -2019-03-09 Simon Sobisch - - * testsuite.src/*: adjusted C test sources in the testsuite - with missing/wrong external attributes - -2019-02-18 Simon Sobisch - - * Makefile.am: cleanup distribution rules - -2019-01-03 Edward Hart - - * testsuite.src/run_xml.at: renamed to run_ml.at - -2018-11-11 Simon Sobisch - - * atlocal_win: dynamically set COB_OBJECT_EXT and COB_EXE_EXT - -2018-08-11 Ron Norman - - * testsuite.src/run_misc.at: Added code to test temp decimals - to the 'Multiple calls of INITIAL program' test case - -2018-08-07 Brian Tiffin - - * testsuite.src/run_functions.at: Rename CONTENTS-OF to CONTENT-OF - -2018-07-30 Edward Hart - - * testsuite.src/run_file.at, testsuite.src/syn_file.at: merge tests - added by Joe Robbins in 2014 to the fileiorewrite branch. - -2018-06-21 Brian Tiffin - - * testsuite.src/run_functions.at: Test CONTENTS-OF and - CONTENT-LENGTH - -2018-04-24 Dave Pitts - - * testsuite.src/listings.at: BUG #515 Fixed test cases. - -2018-04-16 Luke Smith - - * testsuite.src/run_manual_screen.at - - Add keywords and SIZE to special key tests. - -2018-04-10 Luke Smith - - * testsuite.src/run_manual_screen.at - - add key tests: Home, End, Insert, Backspace, - Delete, alt delete, alt left-arrow, alt right-arrow - -2018-03-31 Simon Sobisch - - * testsuite.src/run_functions.at, atlocal.in, atlocal_valgrind, - atlocal_win: COB_HAS_UTC_OFFSET removed as no longer needed - -2018-03-27 Simon Sobisch - - * testsuite.src/run_manual_screen.at: adjusted keywords, - skip screen tests if support for it is missing (we should adjust - at least the bell test to be run) - * run_prog_manual.sh.in: tweaked template for better portability, - fixed non-working timeout - -2018-03-26 Simon Sobisch - - * run_prog_manual.sh.in: add option to run manual tests in - plain terminal environments using the screen window manager; - added timeout (currently 60 seconds for each test) - -2018-03-25 Simon Sobisch - - * testsuite_manual.at: source for new manual test suite - * testsuite.src/run_manual_screen.at: adjusted version of screen - test suite written by Edward Hart (Patch #26) - * Makefile.am (checkmanual): new target for running manual tests - * Makefile.am, atlocal.in: adjustments for the new manual testsuite - * run_prog_manual.sh.in: template for test runner - we use a template - here as the user may need to tweak this according to his system - * testsuite.src/run_manual_screen.at: allow test cases to be directly - acknowledged by ENTER and mark as failed with any function key; - for failing BEEP tests: mention and check COB_BELL=FLASH - -2018-02-16 Simon Sobisch - - * testsuite.at, testsuite.src/run_reportwriter.at: activated and - tweaked RW run checks - -2018-02-16 Dave Pitts - - * testsuite.src/listings.at: BUG #494 Added test case for embedded - quotes, eg. 'yyy-'hello. - Added test case for the report writer. - -2017-11-11 Simon Sobisch - - * testsuite.src/run_fundamental.at: added tests for DEBUG module - -2017-11-06 Simon Sobisch - - * testsuite.src/run_extensions.at, testsuite.src/run_fundamental.at: - moved debugging line checks from to run_fundamental.at - * testsuite.src/run_fundamental.at: added first checks for COB_SET_DEBUG - -2017-11-05 Simon Sobisch - - * listings-sed.sh: use `` instead of $() - see Bug #437 - -2017-11-02 Simon Sobisch - - * testsuite.src/configuration.at, testsuite.src/used_binaries.at: added - some checks for increasing code coverage (leading to a minor bugfix) - -2017-10-30 Simon Sobisch - - * atlocal.in, atlocal_valgrind, atlocal_win: adjustments for cygwin - * atlocal_win: re-integrated missing export for COB_MSG_FORMAT - -2017-10-26 Simon Sobisch - - * atlocal.in, atlocal_valgrind, atlocal_win: adjustments for MSYS2 - -2017-10-22 Simon Sobisch - - * atlocal.in, atlocal_valgrind, atlocal_win: set COBC and COBCRUN as - autoconf does (including the possible EXEEXT); - export COBC, COBCRUN; unified - -2017-09-24 Simon Sobisch - - * atlocal.in: set and export variables in separate lines; - use `` instead of $() - see Bug #437 - -2017-09-10 Simon Sobisch - - * atlocal.in, atlocal_valgrind, atlocal_win: set COB_RUNTIME_CONFIG - before running `cobcrun --runtime-conf` - -2017-08-28 Simon Sobisch - - * atlocal_valgrind: changed default name for valgrind log files - to show the actual compilation; - changed for easier applying of suppression rules; - don't use valgrind in atlocal itself for "cobcrun --runtime-conf" - -2017-08-14 Simon Sobisch - - * atlocal.in, atlocal_valgrind, atlocal_win: set COBCRUN_DIRECT - used for running executables through tools (especially valgrind) - * testsuite.src: COBCRUN_DIRECT as prefix for running generated executables - -2017-08-13 Simon Sobisch - - * atlocal.in, atlocal_valgrind, atlocal_win: export COB_HAS_64_BIT_POINTER - * testsuite.src/data_pointer.at, testsuite.src/listings.at: check - COB_HAS_64_BIT_POINTER instead of indirect test from COBOL - -2017-07-25 Simon Sobisch - - * testsuite.src/run_misc.at, testsuite.src/data_binary.at: changed - subsequent compilations in same folder to use a different output name - -2017-07-03 Simon Sobisch - - * testsuite.at, Makefile.am: added testsuite.src/syn_refmod.at - * testsuite.src/run_refmod.at, testsuite.src/syn_refmod.at: moved - compiler tests for reference modification to its own source and - added check for [no-]constant-folding out of bounds - -2017-06-16 Dave Pitts - - * testsuite.src/listings.at: Corrected Replacement w/o strings test. - -2017-06-16 Simon Sobisch - - * ChangeLog: moved cobol85 entries to cobol85/ChangeLog - -2017-06-15 Simon Sobisch - - * Makefile.am: added .PHONY to correctly declare logical targets that - always have to be executed and don't result in a file - -2017-05-20 Ron Norman - - * testsuite.src/run_extensions.at: Test added for -fodoslide - -2017-05-13 Simon Sobisch - - * testsuite.src/run_misc.at: set COB_EXIT_WAIT=0 in all testcases - where we do extended screenio - -2017-05-10 Dave Pitts - - * testsuite.src/listings.at: added "Too many errors" message - -2017-05-08 Dave Pitts - - * testsuite.src/listings.at: corrected max error count test - -2017-05-03 Simon Sobisch - - * listings-sed.sh: simplified (more likely to run in non GNU/Linux - environments) - -2017-04-25 Brian Tiffin - - * testsuite.src/run_extensions.at: Drop daylight value test, zero means no - rule exists, non-zero means rule exists, testing for bad value is - pointless. - -2017-04-11 Simon Sobisch - - * testsuite.src/run_misc.at, testsuite.src/syn_definition.at: moved - and renamed syntax tests for RETURNING to syn_defintion, - added checks for RETURNING item - -2017-03-22 Dave Pitts - - * testsuite.src/listings.at: Added Error/Warning summary to listings. - -2017-03-21 Dave Pitts - - * testsuite.src/listings.at: Changed variable indentation and redefines. - -2017-03-19 Dave Pitts - - * testsuite.src/listings.at: Added multiple files listing test. - -2017-02-21 Dave Pitts - - * testsuite.src/listings.at: Fixed to pass internal cross reference. - -2017-02-20 Simon Sobisch - - * testsuite.src/run_file.at: fixed generation with old autoconf - that trips on the string AT_DATA in AT_DATA definitions - -2017-01-20 Brian Tiffin - - * testsuite.src/run_misc.at: add PROCEDURE DIVISION EXTERN test - -2017-01-10 Simon Sobisch - - * testsuite.at: minimized the output of testsuite --version while adding - core authors to it - -2016-12-30 Ron Norman - - * run_file.at: Add test cases for fiel SHARING/RETRY - These test programs use SYSTEM with & to start two - concurrent running copies of the test program to - run concurrent test cases. There is also several C$SLEEP - calls to setup the test scenarios. - So these tests appear to run for a long time - -2016-12-06 Simon Sobisch - - * testsuite.at: added cobcrun to tested programs - * atlocal_win: changes for allowing test of Windows binaries with - WSL / Bash on Windows - * listings-sed.sh: adjustment for optional package suffixes - -2016-12-05 Simon Sobisch - - * atlocal_valgrind: sample configuration for running testsuites - with valgrind - -2016-11-19 Simon Sobisch - - * testsuite.src/run_extensions.at: splitted tests for CBL_GC_FORK / - CBL_GC_WAITPID, skip these tests if the functions return "not available" - -2016-11-17 Ron Norman - - * testsuite.src/run_extensions.at: add CBL_GC_FORK & CBL_GC_WAITPID - -2016-11-15 Ron Norman - - * run_misc.at: - changed dump.c as numeric literals are now passed - as PIC 9(9) BINARY format. - * run_extensions.at: Added test case for CALL USING numeric literals - -2016-11-12 Simon Sobisch - - * atlocal.in, atlocal_win: added COB_IS_RUNNING_IN_TESTMODE - -2016-11-11 Dave Pitts - - * testsuite.src/listings.at: changed for new spacing - -2016-11-09 Dave Pitts - - * testsuite.src/listings.at: added cross reference tests - -2016-11-07 Dave Pitts - - * testsuite.src/listings.at: Added 88 values to printed symbol listing. - -2016-11-06 Simon Sobisch - - * listings-sed.sh, testsuite.src/listing.at: adjustment for new maximum - of 14 digits in version string - * testsuite.src/listing.at: capture original listing, instead of unified one - -2016-11-04 Simon Sobisch - - * listings-sed.sh: moved from testsuite.src/listings-sed.sh - * listings-sed.sh: adjustment for exotic shells - * atlocal.in, atlocal_win: adjusted listings-sed.sh path in UNIFY_LISTING - * Makefile.am: added listings-sed.sh to EXTRA_DIST - -2016-11-01 Dave Pitts - - * testsuite.src/listings.at: Changed preprocessed compile for new line - number processing and added an error preprocessed test case. - -2016-10-31 Dave Pitts - - * testsuite.src/listings.at: Added header/trailer to file not found - test case. - -2016-10-29 Dave Pitts - - * testsuite.src/listings-sed.sh: Fixed for generic 9 character version. - * testsuite.src/listings.at: Fixed for generic 9 character version. - -2016-10-29 Simon Sobisch - - * atlocal.in: pass COB_HAS_UTC_OFFSET, set PATHSEP and COB_HAS_CURSES - for MinGW - * testsuite.src/listings-sed.sh: fix for patchlevel up to 999 - * testsuite.src/configuration.at, testsuite.src/used_binaries.at: - used `cobc -q` (instead of sed script) to simplify "unrecognized option" - * testsuite.src/run_misc.at: define NULL if needed - * testsuite.src/run_accept.at: evaluate COB_HAS_CURSES - * testsuite.src/run_functions.at: evaluate COB_HAS_UTC_OFFSET - * testsuite.src/configuration.at: evaluate PATHSEP - -2016-10-22 Dave Pitts - - * testsuite.src/listings.at: Added --no_symbols test. - -2016-10-18 Dave Pitts - - * testsuite.src/listings.at: Added some sequence numbers to a couple of - examples. Would have caught the SOURCEFORMAT VARIABLE bug. - -2016-10-17 Simon Sobisch - - * atlocal.in, atlocal_win: added UNIFY_LISTING - * testsuite.src/listings.at: moved simplified sed commands used to a single - script listings-sed.sh and use this via UNIFY_LISTING - * testsuite.src/listings.at: split symbols test, added test for -tlines, - use -tlines=0 to remove unforced page breaks - * atlocal_win: added missing COB_HAS_UTC_OFFSET - -2016-10-16 Dave Pitts - - * testsuite.src/listings.at: changed hardcoded listing version to a - template - -2016-10-11 Dave Pitts - - * testsuite.src/listings.at: added Symbols test with OCCURS - -2016-09-18 Simon Sobisch - - * testsuite.src/syn_file.at: added tests for variable record size, - depending on item and and key fields - -2016-09-16 Simon Sobisch - - * atlocal.in, atlocal_win : fix unset of environment variables - that are used in libcob for runtime configuration; bug #319 - -2016-08-28 Simon Sobisch - - * Makefile.am: checking `diff` on start of target "check" - -2016-08-02 Dave Pitts - - * testsuite.src/listings.at: Added tests for non-existent file and - copybook messages in the listing file. - -2016-07-24 Dave Pitts - - * testsuite.src/listings.at: Fixed test for 32/64 bit pointers and - additional picture information. - -2016-07-18 Dave Pitts - - * testsuite.src/listings.at: Added SCREEN and LINKAGE section tests. - -2016-07-17 Brian Tiffin - - * testsuite.src/run_misc.at: Added tests for C calling COBOL - with and without setting cob_call_params. - Added tests for ENTRY lookup within main module. - -2016-07-17 Brian Tiffin - - * testsuite.src/run_extensions.at: Moved stdout stderr fprintf test - in CBL_OC_HOSTED to external C subprogram. - And then a correction to account for linkage exports. - -2016-07-04 Brian Tiffin - - * testsuite.src/run_extensions.at: Removed a "feof" call in - CBL_OC_HOSTED testing to help with Cygwin - -2016-06-28 Dave Pitts - - * testsuite.src/listings.at: Added Files with FILLER. - -2016-06-26 Dave Pitts - - * testsuite.src/listings.at: Added LISTING ON/OFF test. - -2016-06-20 Dave Pitts - - * testsuite.src/listings.at: new file, tests for compiler listings - * testsuite.at, Makefile.am: added testsuite.src/listings.at - -2016-06-15 Brian Tiffin - - * testsuite.src/used_binaries.at: added tests for -j"args" - -2016-05-31 Brian Tiffin - - * testsuite.src/run_fundamental.at: Added ADD/SUBTRACT CORRESPONDING test - -2016-05-22 Brian Tiffin - - * testsuite.src/run_extensions.at: changed CBL_OC_HOSTED errno test - -2016-05-15 Brian Tiffin - - * testsuite.src/used_binaries.at: added tests for cobcrun -M - -2016-05-01 Ron Norman - * run_misc.at removed check for 'NEW' as this is now a reserved word - configuration.at updated to match compiler - syn_definition.at updated to expect SYNC RIGHT to pass - -2016-04-23 Brian Tiffin - - * testsuite.src/data_binary.at: added test for binary-double unsigned - compare when high bit set. - -2016-02-01 Simon Sobisch - - * testsuite.at, testsuite.src/syn_reportwriter.at: RW checks earlier - skipped are now only comments - will be added back in 3.0 with more - and better checks - -2016-01-12 Simon Sobisch - - * Makefile.am: added targets "test" (running ANSI testsuite) and - "checkall" (running both GnuCOBOL and ANSI testsuite) - -2015-12-23 Simon Sobisch - - * general: remove -std=cobol2002 for compiling (effectively using default), - checked with cobol2014 where checking for standard behaviour, - used -cb_conf when checking single compiler configurations instead - of creating+using a test.conf or loading a completely different -std, - check stdout+stderr where missing, removed the ifdef for __INTEL_COMPILER - as this is included via libcob.h now - * configuration.at: check for all standard configurations -std to - be usable - -2015-12-15 Brian Tiffin - - * testsuite.src/run_misc.at: command line option -a replaced with -R - as short form for -debug - -2015-12-14 Brian Tiffin - - * testsuite.src/data_display.at: add unsigned numeric display tests - -2015-11-01 Simon Sobisch - - * general: skip tests that need a curses build if not available - * general: use new internal shell function _return_path for resolving paths - (necessary for use of paths in testsuite when testing non-cygwin builds - with cygwin) - * atlocal_win: set tests to skip (via COB_HAS_ISAM / COB_HAS_CURSES) - depending on available features (parsing cobc --info) - -2015-10-25 Simon Sobisch - - * testsuite.src/configuration.at: mayor update including runtime - configuration - -2015-08-03 Brian Tiffin - - * testsuite.src/run_misc.at: compile from stdin, run after compile - -2015-06-08 Luke Smith - - * testsuite.src/syn_misc.at: FR #37 ACCEPT/DISPLAY field WITH SIZE - -2015-05-11 Simon Sobisch - - * testsuite.src/run_functions.at : revised all tests from ACOS to LENGTH - -2015-04-28 Ron Norman - * Added a few more test programs to run_file.at and run_misc.at - -2015-04-27 Simon Sobisch - - * testsuite.src/run_file.at : (new) moved testsuite entries for - file handling to their own test definition (origin: run_misc.at) - -2015-03-19 Simon Sobisch - - * testsuite.src/syn_functions.at : (new) moved testsuite entries for - FUNCTIONs to their own test definition (origin: syn_misc.at) - -2015-03-14 Simon Sobisch - - * atlocal.in, atlocal_win: Added setting of COB_RUNTIME_CONFIG - * moved tests for checking used binaries (cobc, cobcrun, extras) from - testsuite.src/run_misc.at to testsuite.src/used_binaries.at - * moved tests for checking compiler configuration from - testsuite.src/syn_misc.at to testsuite.src/configuration.at, updated - tests and added new ones - -2014-12-01 Simon Sobisch - - * testsuite.src/syn_screen.at : (new) Added first testsuite entries for - SCREEN section - -2014-09-12 Simon Sobisch - - * support spaces in testsuite - * changed atlocal_win, removing the need for a configured source - (works with build_windows out of the box) - -2014-08-07 Simon Sobisch - - * atlocal.in : unset all environmental vars that are used by libcob - -2014-04-30 Simon Sobisch - - * testsuite.src/*.at: Added check for cobc's exit code and stderr - where missing - -2014-14-04 Philipp Böhme - - * testsuite.src/run_extensions.at: Added tests for getopt. - -2014-01-14 Simon Sobisch - - * testsuite.src/run_reportwriter.at, testsuite.src/syn_reportwriter.at: - Added first testsuite entries for REPORT WRITER - -2010-06-28 Roger While - - * MARK - Version 2.0 - * Move to GPL/LGPL 3 - -2009-06-09 Roger While - - * New OC tests for edited moves - -2009-05-11 Roger While - - * Allow tests to run without ISAM I/O - -2009-03-12 Roger While - - * Fix for newest development software - * Use minimum quadrigraphs in autotests for compatibility - -2009-01-20 Roger While - - * OC tests for DPC and 78 levels - -2008-10-17 Roger While - - * Add test for non-ALLOCATED BASED item - -2008-09-30 Roger While - - * Makefile.am : Fix out of source directory builds - -2008-08-09 Roger While - - * Change ENTRY test so as not to use obscure/obsoleted options - -2008-07-02 Roger While - - * General for all OC tests - Cater for activated END-xxx checking - -2008-05-23 Roger While - - * Due to display POINTER changes, ignore output from POINTER datarep test - -2008-03-25 Roger While - - * Add OC tests for reference modification of FUNCTIONS - * Add OC test for COB_LOAD_CASE - -2008-02-18 Roger While - - * Add OC test for ANY LENGTH - -2008-02-14 Roger While - - * atlocal.in : Fix up library search order - -2008-01-09 Roger While - - * BY CONTENT not allowed in PROCEDURE header - -2007-12-27 Roger While - - ** Mark 1.0 RELEASE - -2007-12-27 Roger While - - * Add OC test for WHEN-COMPILED - -2007-10-27 Roger While - - * OC test for INSPECT with figurative constant - -2007-05-11 Roger While - - * Adjust OC test result to agree with tightened input - file presence check - -2007-03-05 Roger While - - * OC tests for LOCALE-DATE, LOCALE-TIME - -2007-01-29 Roger While - - * OC test for ODO without TO clause - -2007-01-16 Roger While - - * OC test for ASSIGN [TO] KEYBOARD/DISPLAY - -2006-12-17 Roger While - - * OC test for NUMVAL-C - -2006-12-14 Roger While - - * OC tests for TRIM, UPPER-CASE - -2006-10-23 Roger While - - * Change C code in the tests to prototype functions - -2006-07-23 Roger While - - * run.src, atlocal.in: Remove SWITCH settings from - atlocal and insert directly into the tests - -2006-07-19 Roger While - - * syntax.src, run.src : Change tests to accomodate revised - messages - -2006-05-18 Roger While - - * OC tests for FUNCTION's EXCEPTION-FILE, - EXCEPTION-LOCATION, EXCEPTION-STATEMENT, EXCEPTION-STATUS - -2006-05-08 Roger While - - * OC test for PROCEDURE DIVISION CHAINING - * OC test for INSPECT REPLACING TRAILING - -2006-03-22 Roger While - - * OC test for EBCDIC table SORT - -2006-03-04 Roger While - - * OC test for 88 level FALSE IS clause and - SET TO FALSE. - -2006-01-29 Roger While - - * OC test for COB_PRE_LOAD - -2006-01-26 Roger While - - * OC test for UNSTRING DELIMITED LOW-VALUE - -2006-01-21 Roger While - - * tests/syntax.src/definition.at : Test mismatched levels - -2006-01-05 Roger While - - * General : Bootstrap up to new libtool / automake - atlocal.in : More fixes for HP/IBM/Sun - -2005-12-30 Roger While - - * Relax LOG10 test - Fix big endian shell test - atlocal.in : Insert SHLIB_PATH/LIBPATH for AIX/HP-UX - -2005-12-28 Roger While - - * run.src/extensions.at : Remove A\$B (MingW) - -2005-12-09 Roger While - - * atlocal.in, run.src/*.at: Changes for '-x' option - -2005-12-05 Roger While - - * atlocal.in : Include libcob/.libs in PATH, needed for Win32 - -2005-12-04 Roger While - - * Relax EXP test for MingW - -2005-11-25 Roger While - - * New OC test for sticky-linkage - -2005-11-07 Roger While - - * New test for PERFORM type OSVS. - * Get the FUNCTION tests in alphabetical order. - -2005-11-01 Roger While - - * Relax TAN test. - -2005-10-28 Roger While - - * Relax the range check for STANDARD-DEVIATION - Don't do native binary tests when native = big-endian - -2005-10-27 Roger While - - * Fixes all over for MAC (Darwin) - We had "-shared" hard-coded in several places. - Pick up the real value from the configure. - -2005-10-14 Roger While - - * Fix a typo - -2005-10-13 Roger While - - * Fix various tests for GCC 4 - -2005-07-31 Roger While - - * Tests for SIGN, FRACTION-PART. - * Tweak the tests a bit more to cater for the - abysmal precision of MingW. - -2005-07-14 Roger While - - * New test for START of SEQ file. - * Tweak the IF tests a bit. This should cater - for the precison vagueries of doubles. - -2005-07-02 Roger While - - * run.src/functions.at : New Intrinsic Function tests - -2005-06-13 Roger While - - * atlocal.in : Export COB_SWITCH_1/2 for OC - and Cobol85 tests. - run, run.src/misc.at : Test for SWITCH. - -2005-06-11 Roger While - - * Add in INSPECT BEFORE/AFTER tests - -2005-05-28 Roger While - - * Use absolute path for cobcrun; seems that some - environments do not propogate the path correctly. - -2005-05-15 Roger While - - * Adjust tests for "Warning" and "Error". - -2005-05-12 Roger While - - * Adjust tests for larger redefines - (not allowed for cobol2002) - -2005-05-03 Roger While - - * Makexx : Due to autoreconf. - * run-O, data-rep-O : Use -O instead of -fruntime-inlining - * run.src,syntax.src : Add tests for duplicate paras and larger - redefines. - Adjust for endianness. - -2005-04-15 Keisuke Nishida - - * atlocal.in (BIGENDIAN): New variable. - * data-rep.src/binary.at: Don't test native binary on big-endian - machines. - (COMP-5): Moved from run.src/extensions.at. - -2005-04-13 Keisuke Nishida - - * atlocal.in (CC): Set -fPIC when necessary. - -2005-03-03 Roger While - - * run.src/extensions.at : - Fix a dangling file in /tmp - * general: Small cleanups in other files - -2005-02-22 Roger While - - * run, run.src/misc.at : Fix REF/CONTENT/VALUE test - -2005-02-12 Roger While - - * run.src/misc.at : .. BY CONTENT LENGTH OF .. - run.src/subscripts.at : Clean up a little - run.src/return-code.at : Clean up a little - -2005-02-11 Roger While - - * Dummy entry - -2005-02-11 Roger While - - * run.src/extensions.at : Fix ARGUMENT check - -2005-02-08 Roger While - - * run.src/misc.at, run : Add EXTERNAL as Literal check - -2005-02-08 Roger While - - * run.src/misc.at, run : Add cobcrun check - -2005-02-04 Roger While - - * run.src/extensions.at : MF extensions - -2004-03-06 Keisuke Nishida - - * data-rep.src/pointer.at: New file. - -2004-03-01 Keisuke Nishida - - * Reorganized tests into run.src, syntax.src, and data-rep.src. - -2003-11-26 Keisuke Nishida - - * cobol2002-run.src, cobol2002-syntax.src, data-rep.src, - extension.src: New subdirectories. - -2003-08-21 Keisuke Nishida - - * display.at, packed.at: New files. - -2003-08-10 Keisuke Nishida - - * binary.at: New file. - -2003-05-30 Keisuke Nishida - - * occurs.at: New file. - -2003-05-21 Keisuke Nishida - - * multiply.at: New file. - * extension.at: New file. - -2003-04-29 Keisuke Nishida - - * fundamental.at, entry.at: New files. - -2003-04-26 Keisuke Nishida - - * subscripts.at, ref-mod.at: Divided from reference.at. - * value.at: Renamed from constant.at. - * usage.at: Renamed from packed.at. - * initialize.at: New file. - -2003-04-10 Keisuke Nishida - - * constant.at, move.at: New files. - -2003-04-04 Keisuke Nishida - - * packed.at: New file. - -2003-03-08 Keisuke Nishida - - * testsuite.at: Include all *.at files. - * Makefile.am: Build only a single testsuite script. - -2003-02-28 Keisuke Nishida - - * reference.at: Combine runtime.at and subref.at. - -2003-02-25 Keisuke Nishida - - * definition.at, misc.at: New files. - * redef.at: Removed. - -2002-12-12 Keisuke Nishida - - * redefines.at: New file. - -2002-12-10 Keisuke Nishida - - * Makefile.am, atlocal.in: New files. - * redef.at, subref.at, runtime.at: New files. - - -Copyright 2002-2020 Free Software Foundation, Inc. - -Copying and distribution of this file, with or without modification, are -permitted provided the copyright notice and this notice are preserved. diff -Nru gnucobol-4.0~early~20200606/tests/cobol85/ChangeLog gnucobol-5/tests/cobol85/ChangeLog --- gnucobol-4.0~early~20200606/tests/cobol85/ChangeLog 2020-06-06 20:52:00.000000000 +0000 +++ gnucobol-5/tests/cobol85/ChangeLog 1970-01-01 00:00:00.000000000 +0000 @@ -1,304 +0,0 @@ - -2020-03-11 Simon Sobisch - - * Makefile.am (unpack-Z): improved portability - -2019-12-10 Simon Sobisch - - * Makefile.am: allow to override URL_NEWCOB_Z and URL_NEWCOB_TAR_GZ - * Makefile.am: improved portability to non-gmake - passing absolute name - for NEWCOB_VAL from either build or srcdir, removing the need to copy - newcob.val from srcdir (only the archives are copied from there) - -2019-06-11 Simon Sobisch - - * Makefile.am: added some additional output to show current status - * Makefile.am (summary.log): now always rebuild (.PHONY) - * Makefile.am (diff): ensure that results of all modules are compared - (now only fails early if there's an actual error during diff) - * Makefile.am: moved dependency on summary.log from diff to diff-summary - * report.pl: create additional file in each module directory: duration.txt - showing the duration in fractional seconds for each test (system time!) - * Makefile.am (duration.log): new target collecting rough durations - -2019-06-10 Simon Sobisch - - * Makefile.am ($(MODULES)): missing dependency Makefile.module.in added, - * Makefile.am (EXEC85.cob): delete in case of issues during sed ensuring - to not end with a partial source - * Makefile.module.in (clean, clean-db): targets added - * report.pl: only delete files in DB_HOME if it does not equal to "." - -2019-05-25 Simon Sobisch - - * expand.pl: added checks for input arguments and valid file - -2019-05-20 Simon Sobisch - - * Makefile.am: setting of DIFF_FLAGS now done by configure - * Makefile.am: use quotes for filenames in external commands, - run testsuite with active runtime checks - -2019-03-16 Simon Sobisch - - * Makefile.am: new DIFF_FLAGS initialized to --strip-trailing-cr to allow - valid test results also with unclean/unexpected EOL - * report.pl: reduced number of environment checks, - adjusted to actually work with a MSWin32 port of perl - -2019-01-18 Simon Sobisch - - * Makefile.am: fix for Bug #563: new WGET_FLAGS initialized to "-t1 -T5" - to explicit specify the timeout and allow overriding these parameters - -2019-01-01 Simon Sobisch - - * Makefile.am: renamed target all to modules as we don't want to - auto-generate those - -2018-12-30 Simon Sobisch - - * Makefile.am (newcob.val.tar.gz) new target to download from sourceforge - * Makefile.am: newcob.val.tar.gz / newcob.val.Z are also copied from - srcdir if existing there already - * Makefile.am: fix for Bug #563: fall-back to download from sourceforge - if download from NIST is not possible - * Makefile.am (all): new target extracting all tests - * Makefile.am: additional insert test names when generating the module - specific Makefile - * Makefile.module.in (test-local, test-O-local): new targets to allow - running the tests with a GnuCOBOL version that is locally installed - instead of the version currently build - * Makefile.module.in (lib, lib-local): new targets to only compile - the module specific libs - * Makefile.module.in: new targets for single tests - * report.pl: extracted functions compile_lib and run_test - * report.pl: allow to run a single test by passing the test name - as parameter or compiling libs only by passing "lib" - -2018-06-05 Simon Sobisch - - * Makefile.am: split rules for EXEC85 and EXEC85.cob to prevent - unneeded recreation of the source file - -2018-05-08 Simon Sobisch - - * Makefile.am: new URL for NIST suite, using https - -2017-12-06 Simon Sobisch - - * Makefile.am: adjustments after merge from reportwriter - * report.pl: retro-fixed RW301 and RW302 to be comp_only - * RW.txt, summary.txt, summarynoix.txt: adjusted expected results - -2017-09-24 Simon Sobisch - - * Makefile.module.in: (new file) moved content of generated - Makefiles to separate template file; - splitted into multiple targets and all target - * Makefile.am: adjusted to `sed` the template instead of - using `echo` to create the module Makefile - -2017-09-02 Simon Sobisch - - * Makefile.am: extra target for summary.log - -2017-08-28 Simon Sobisch - - * Makefile.am: use $COBC defined in atlocal instead of "cobc"; - passing hints for valgrind logfile name when sourcing atlocal - -2017-07-20 Simon Sobisch - - * report.pl: activated runtime checks where possible to prevent - loops and hard aborts for not-working environments, for example - when running ISAM tests with a no-ISAM build - -2017-07-14 Simon Sobisch - - * Makefile.am: added some hacks for make not supporting $> and $(D>), - make tests works there (again) as long as newcob.val is in builddir - -2017-06-30 Simon Sobisch - - * Makefile.am: separated rule for newcob.val.Z and make sure that - out-of-path newcob.val.Z is copied before uncompress; - corrected rule for EXEC85 to include executable extension - -2017-06-15 Simon Sobisch - - * Makefile.am: added .PHONY to correctly declare logical targets that - always have to be executed and don't result in a file - * Makefile.am: fixing tests with newcob.val in all possible VPATH - entries by using the prerequisite's path directly in the Makefile - and with ASSIGN variable for EXEC85 - * Makefile.am: always build all test module folders, - even if they aren't tested - * Makefile.am: allow parallel testing of modules - * Makefile.am, summary.txt: moved IX to end of tests to have the same - order with DBNOIX - -2017-05-31 Simon Sobisch - - * report.pl: redirect stderr to /dev/null if to_kill is requested - -2017-04-23 Simon Sobisch - - * Makefile.am: HACK for newcob.val in sourcedir during VPATH build - -2017-03-19 Edward Hart - - * report.pl, EXEC85.conf.in: fixed bug #363: redefining filename (viz. - "report.log") as variable is not portable. - * report.pl, summary.pl: fixed warnings and added "use warnings;" and - "use strict;" directives. - -2017-01-03 Simon Sobisch - - * report.pl: replaced fifo by sysin redirection and new kill sequence - -2016-12-18 Simon Sobisch - - * report.pl: fixing running the suite from shared file systems by - moving fifo to tempdir (where creation of fifo should always be possible) - * report.pl, NC.txt: automated "manual investigations" - * report.pl: moved test specific compilation flags to $cobc_flags - and show them on command line, - create report.log directly with test specific name - -2016-12-14 Edward Hart - - * report.pl, *.txt: compile only tests no longer - increment the successful test counter, as this is for runtime tests - * report.pl: allow passing input to programs (e.g. for those - with STOP literal), implemented by mkfifo, asynchron run and kill - -2016-12-12 Edward Hart - - * report.pl: updated and annotated the list of compile-only tests - -2016-12-05 Simon Sobisch - - * report.pl: check environment for COBC/COBCRUN to override - the called binaries (useful for testing with valgrind) - -2016-10-30 Simon Sobisch - - * Makefile.am, report.pl: added support for make with - multiple jobs (only done when building the test directories) - -2016-08-28 Simon Sobisch - - * Makefile.am: checking perl binary before running target "test" - -2015-02-11 Simon Sobisch - - * Makefile.am: added target for decompressing newcob.val.Z and - download it - -2010-06-28 Roger While - - * MARK - Version 2.0 - * Move to GPL/LGPL 3 - -2009-07-01 Roger While - - * Include some extra 85 compile only programs - -2009-05-11 Roger While - - * Allow tests to run without ISAM I/O - -2009-03-05 Roger While - - * Clean up 85 test scripts - -2008-12-02 Roger While - - * Activate some more ANSI85 tests - -2008-11-28 Roger While - - * Adjust ANSI85 results; USE GLOBAL tests now run - * Adjust ANSI85 report output - -2008-11-25 Roger While - - * report.pl, summary.pl: fix warning when running perl with -w - -2008-11-07 Roger While - - * Adjust ANSI85 results; we successfully execute one of the GLOBAL tests - -2008-10-11 Roger While - - * Makefile.am : Refix out of source directory builds - -2008-09-30 Roger While - - * Makefile.am : Fix out of source directory builds - -2008-01-02 Roger While - - * Cobol85 tests rechanged to cater for unsupported ALTER - -2007-12-27 Roger While - - ** Mark 1.0 RELEASE - -2007-12-21 Roger While - - * Cobol85 tests changed to cater for unsupported ALTER - -2006-07-23 Roger While - - * report.pl : Remove SWITCH settings from atlocal and insert - directly into the tests - -2006-07-06 Roger While - - * report.pl : Cater for DB_HOME (BDB >= 4.1) - -2006-02-08 Roger While - - * Adjust results for cobol85 suite. - We now pass some nested program tests. - -2006-01-05 Roger While - - * general: Bootstrap up to new libtool / automake - * ifedit.sh: Fix up test IX110A - - This has an incorrect PIC clause in the - compressed file newcob.val.Z. - -2005-12-09 Roger While - - * report.pl, Makefile.am: Changes for '-x' option - -2005-12-05 Roger While - - * report.pl, Makefile.am : Fix perl usage - -2005-11-09 Roger While - - * Adjust Cobol85 test results for SAME RECORD implementation. - -2005-10-01 Roger While - - * Makefile.am : Include IF.txt, ifedit.sh - -2005-05-03 Roger While - - * general : Allow to run without a "make install". - Update expected results. - * EXEC85.conf.in - Change 2 params. - -2005-03-03 Roger While - - * SQ.txt, summary.txt : We now pass the LINAGE tests - - -Copyright 2005-2010,2015-2020 Free Software Foundation, Inc. - -Copying and distribution of this file, with or without modification, are -permitted provided the copyright notice and this notice are preserved. diff -Nru gnucobol-4.0~early~20200606/tests/cobol85/DBNOIX.txt gnucobol-5/tests/cobol85/DBNOIX.txt --- gnucobol-4.0~early~20200606/tests/cobol85/DBNOIX.txt 2020-06-06 20:52:00.000000000 +0000 +++ gnucobol-5/tests/cobol85/DBNOIX.txt 1970-01-01 00:00:00.000000000 +0000 @@ -1,25 +0,0 @@ -Filename total pass fail deleted inspect --------- ----- ---- ---- ------- ------- -DB101A.CBL 34 25 0 0 9 OK -DB102A.CBL 14 14 0 0 0 OK -DB103M.CBL 14 14 0 0 0 OK -DB103M.CBL 28 28 0 0 0 OK -DB104A.CBL 12 9 0 0 3 OK -DB105A.CBL 227 227 0 0 0 OK -DB201A.CBL 68 56 0 4 8 OK -DB202A.CBL 24 20 0 0 4 OK -DB203A.CBL ----- test skipped ----- -DB204A.CBL 4 3 0 0 1 OK -DB205A.CBL 0 0 0 0 0 OK -DB301M.CBL 1 1 0 0 0 OK -DB302M.CBL 1 1 0 0 0 OK -DB303M.CBL 1 1 0 0 0 OK -DB304M.CBL 0 0 0 0 0 OK -DB305M.CBL 1 1 0 0 0 OK --------- ----- ---- ---- ------- ------- -Total 429 400 0 4 25 - -Number of programs: 15 -Successfully executed: 15 -Compile error: 0 -Execute error: 0 diff -Nru gnucobol-4.0~early~20200606/tests/cobol85/DB.txt gnucobol-5/tests/cobol85/DB.txt --- gnucobol-4.0~early~20200606/tests/cobol85/DB.txt 2020-06-06 20:52:00.000000000 +0000 +++ gnucobol-5/tests/cobol85/DB.txt 1970-01-01 00:00:00.000000000 +0000 @@ -1,25 +0,0 @@ -Filename total pass fail deleted inspect --------- ----- ---- ---- ------- ------- -DB101A.CBL 34 25 0 0 9 OK -DB102A.CBL 14 14 0 0 0 OK -DB103M.CBL 14 14 0 0 0 OK -DB103M.CBL 28 28 0 0 0 OK -DB104A.CBL 12 9 0 0 3 OK -DB105A.CBL 227 227 0 0 0 OK -DB201A.CBL 68 56 0 4 8 OK -DB202A.CBL 24 20 0 0 4 OK -DB203A.CBL 20 18 0 0 2 OK -DB204A.CBL 4 3 0 0 1 OK -DB205A.CBL 0 0 0 0 0 OK -DB301M.CBL 1 1 0 0 0 OK -DB302M.CBL 1 1 0 0 0 OK -DB303M.CBL 1 1 0 0 0 OK -DB304M.CBL 0 0 0 0 0 OK -DB305M.CBL 1 1 0 0 0 OK --------- ----- ---- ---- ------- ------- -Total 449 418 0 4 27 - -Number of programs: 16 -Successfully executed: 16 -Compile error: 0 -Execute error: 0 diff -Nru gnucobol-4.0~early~20200606/tests/cobol85/EXEC85.conf.in gnucobol-5/tests/cobol85/EXEC85.conf.in --- gnucobol-4.0~early~20200606/tests/cobol85/EXEC85.conf.in 2020-06-06 20:52:00.000000000 +0000 +++ gnucobol-5/tests/cobol85/EXEC85.conf.in 1970-01-01 00:00:00.000000000 +0000 @@ -1,126 +0,0 @@ -*KILL-DELETIONS -X-00173 "XXXXX001" -X-00273 "XXXXX002" -X-00373 "XXXXX003" -X-00473 "XXXXX004" -X-00573 "XXXXX005" -X-00673 "XXXXX006" -X-00773 "XXXXX007" -X-00873 "XXXXX008" -X-00973 "XXXXX009" -X-01073 "XXXXX010" -X-01173 "XXXXX011" -X-01273 "XXXXX012" -X-01373 "XXXXX013" -X-01473 "XXXXX014" -X-01573 "XXXXX015" -X-01673 "XXXXX016" -X-01773 "XXXXX017" -X-01873 "XXXXX018" -X-01973 "XXXXX019" -X-02073 "XXXXX020" -X-02173 "XXXXX021" -X-02273 "XXXXX022" -X-02373 "XXXXX023" -X-02473 "XXXXX024" -X-02573 "XXXXX025" -X-02673 "XXXXX026" -X-02773 "XXXXX027" -X-02873 "XXXXX028" -X-02973 "XXXXX029" -X-03073 "INPUTQUEUE1" -X-03173 "INPUTKEY1" -X-03273 "OUTPUTQUEUE1" -X-03373 "OUTPUTKEY1" -X-03473 "INPUTQUEUE2" -X-03573 "OUTPUTQUEUE2" -X-03673 "INPUTKEY2" -X-03773 "OUTPUTKEY2" -X-03873 "QUEUE1" -X-03973 "QUEUE2" -X-04073 "QUEUE3" -X-04173 "QUEUE4" -X-04273 "TERM1" -X-04373 "TERM2" -X-04773 "." -X-04873 "../copyalt" -X-04973 "XXXXX049" -X-05173 SWITCH-1 -X-05273 SWITCH-2 -X-05373 MULTIPLE FILE TFIL -X-05573 "REPORT" -X-05673 SYSOUT -X-05773 SYSIN -X-06073 "XXXXX060" -X-06173 "XXXXX061" -X-06273 "XXXXX062" -X-06373 " $$()*+,-./0123456789;<=>ABCDEFGHIJKLMNOPQRSTUVWXYZ" -X-06473 "ZYXWVUTSRQPONMLKJIHGFEDCBA>=<;9876543210/.-,+*)($$ " -X-06573 1000 -X-06773 1000 -X-06873 64000 -X-06973 SYSIN -X-07073 STANDARD-1 -X-07373 FORMFEED -X-07473 OCLABELID -X-07573 "OCDUMMY" -X-07673 "OCDUMMY" -X-07773 "OCDUMMY" -X-08173 "12345678" -X-08273 GNU-Linux -X-08373 GNU-Linux -X-08673 PIC X(8) -X-09073 "A" -X-09173 "D" -X-09273 "XXXXX092" -*END-MONITOR -*BEGIN-UPDATE -*START IF119A -061200 COMPUTE WS-NUM = FUNCTION MAX (4 0 5 3 7). -*START IF120A -050300 COMPUTE WS-NUM = FUNCTION MEAN (4 0 5 3 7). -*START IF121A -050000 COMPUTE WS-NUM = FUNCTION MEDIAN (4 0 5 3 7). -*START IF122A -052200 COMPUTE WS-NUM = FUNCTION MIDRANGE (4 0 5 3 7). -*START IF123A -061500 COMPUTE WS-NUM = FUNCTION MIN (4 0 5 3 7). -*START IF128A -054900 COMPUTE WS-INT = FUNCTION ORD-MAX (4 0 5 3 7). -*START IF129A -055200 COMPUTE WS-INT = FUNCTION ORD-MIN (4 0 5 3 7). -*START IF132A -049800 COMPUTE WS-NUM = FUNCTION RANGE (4 0 5 3 7). -*START IF137A -053100 COMPUTE WS-NUM = FUNCTION STANDARD-DEVIATION (4 0 5 3 7). -*START IF138A -049800 COMPUTE WS-NUM = FUNCTION SUM (4 0 5 3 7). -*START IF141A -052500 COMPUTE WS-NUM = FUNCTION VARIANCE (4 0 5 3 7). -*START IF402M -005900 -008600 -*START IX110A -012250 01 STATUS-TEST-10 PIC 9 VALUE ZERO. -*START NC174A -065200 -*START NC217A -051300 STRING ID1-1 OF ID1-XN-X-25 (ID8-DU-2V0) -051400 ID1-2 OF ID1-XN-X-25 (ID8-DU-2V0) -051500 ID1-3 OF ID1-XN-X-25 (ID8-DU-2V0) -051600 ID1-4 OF ID1-XN-X-25 (ID8-DU-2V0) -051700 ID1-5 OF ID1-XN-X-25 (ID8-DU-2V0) -051800 DELIMITED BY SIZE INTO ID7-XN-5 -051900 POINTER ID8-DU-2V0. -052000 GO TO STRING-TEST-4-1. -*START SM208A -057300 GO TO REP-TEST-7-1. -*START SQ106A -114400 GO TO SEQ-TEST-RD-15-03. -135600 GO TO SEQ-TEST-RD-17-03. -148400 GO TO SEQ-TEST-RD-18-03. -174000 GO TO SEQ-TEST-RD-20-03. -228400 GO TO SEQ-TEST-RD-24-03. -243700 GO TO SEQ-TEST-RD-25-03. -*END-UPDATE -*START diff -Nru gnucobol-4.0~early~20200606/tests/cobol85/expand.pl gnucobol-5/tests/cobol85/expand.pl --- gnucobol-4.0~early~20200606/tests/cobol85/expand.pl 2020-06-06 20:52:00.000000000 +0000 +++ gnucobol-5/tests/cobol85/expand.pl 1970-01-01 00:00:00.000000000 +0000 @@ -1,75 +0,0 @@ -# -# gnucobol/tests/cobol85/expand.pl -# -# Copyright (C) 2001-2012,219 Free Software Foundation, Inc. -# Written by Keisuke Nishida, Roger While, Simon Sobisch -# -# This file is part of GnuCOBOL. -# -# The GnuCOBOL compiler is free software: you can redistribute it -# and/or modify it under the terms of the GNU General Public License -# as published by the Free Software Foundation, either version 3 of the -# License, or (at your option) any later version. -# -# GnuCOBOL is distributed in the hope that it will be useful, -# but WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -# GNU General Public License for more details. -# -# You should have received a copy of the GNU General Public License -# along with GnuCOBOL. If not, see . - -my $input = shift; -my $moddir = shift; -if ($input eq "") {die "missing argument: input file";} -if ($moddir eq "") {die "missing argument: output directory";} -open (IN, $input) or die "input file \"$input\" not found"; - -my $output = ''; -while () { - s/\x0d\x0a|\x0d|\x0a//g; - if (/^ \*HEADER,([^,]*),([^, ]*)(,([^,]*),([^, ]*))?/) { - my ($type, $prog, $subt, $subr) = ($1, $2, $4, $5); - $output = $type; - my $module = $moddir; - my $name = ''; - if ($subt) { - if ($subt eq "SUBPRG") { - $name = "$subr.SUB"; - } elsif ($subt eq "SUBRTN") { - $name = "lib/$subr.CBL"; - mkdir "$module/lib",0755 unless (-e "$module/lib"); - } - } elsif ($type eq "COBOL") { - $name = "$prog.CBL"; - } elsif ($type eq "DATA*") { - if (substr($prog, 0, 2) eq $module) { - $name = "$prog.DAT"; - } - } elsif ($type eq "CLBRY") { - if ($prog eq "ALTL1") { - $module = "copyalt"; - $name = "ALTLB" unless (-e "copyalt/ALTLB"); - } else { - $module = "copy"; - $name = "$prog" unless (-e "copy/$prog"); - } - } - if ($name) { - mkdir $module,0755 unless (-e $module); - open (OUT, "> $module/$name") or die; - while () { - last if /^ \*END/; - if ($type eq "DATA*" and length >= 80) { - s/\x0d\x0a|\x0d|\x0a//g; - } - print OUT; - } - } else { - while () { - last if /^ \*END/; - } - } - } -} -if ($output eq "") {die "input file \"$input\" does not contain data to expand";} diff -Nru gnucobol-4.0~early~20200606/tests/cobol85/IC.txt gnucobol-5/tests/cobol85/IC.txt --- gnucobol-4.0~early~20200606/tests/cobol85/IC.txt 2020-06-06 20:52:00.000000000 +0000 +++ gnucobol-5/tests/cobol85/IC.txt 1970-01-01 00:00:00.000000000 +0000 @@ -1,34 +0,0 @@ -Filename total pass fail deleted inspect --------- ----- ---- ---- ------- ------- -IC101A.CBL 5 5 0 0 0 OK -IC103A.CBL 10 10 0 0 0 OK -IC106A.CBL 14 14 0 0 0 OK -IC108A.CBL 9 9 0 0 0 OK -IC112A.CBL 3 3 0 0 0 OK -IC114A.CBL 3 3 0 0 0 OK -IC116M.CBL 1 1 0 0 0 OK -IC201A.CBL 11 11 0 0 0 OK -IC203A.CBL 21 21 0 0 0 OK -IC207A.CBL 11 11 0 0 0 OK -IC209A.CBL 4 4 0 0 0 OK -IC213A.CBL 3 3 0 0 0 OK -IC216A.CBL 2 2 0 0 0 OK -IC222A.CBL 16 16 0 0 0 OK -IC223A.CBL 11 11 0 0 0 OK -IC224A.CBL 44 44 0 0 0 OK -IC225A.CBL 36 36 0 0 0 OK -IC226A.CBL 4 4 0 0 0 OK -IC227A.CBL 23 19 0 4 0 OK -IC228A.CBL 4 4 0 0 0 OK -IC233A.CBL 1 1 0 0 0 OK -IC234A.CBL 1 1 0 0 0 OK -IC235A.CBL 12 12 0 0 0 OK -IC237A.CBL 1 1 0 0 0 OK -IC401M.CBL 0 0 0 0 0 OK --------- ----- ---- ---- ------- ------- -Total 250 246 0 4 0 - -Number of programs: 25 -Successfully executed: 25 -Compile error: 0 -Execute error: 0 diff -Nru gnucobol-4.0~early~20200606/tests/cobol85/IF.txt gnucobol-5/tests/cobol85/IF.txt --- gnucobol-4.0~early~20200606/tests/cobol85/IF.txt 2020-06-06 20:52:00.000000000 +0000 +++ gnucobol-5/tests/cobol85/IF.txt 1970-01-01 00:00:00.000000000 +0000 @@ -1,54 +0,0 @@ -Filename total pass fail deleted inspect --------- ----- ---- ---- ------- ------- -IF101A.CBL 26 26 0 0 0 OK -IF102A.CBL 13 13 0 0 0 OK -IF103A.CBL 23 23 0 0 0 OK -IF104A.CBL 27 27 0 0 0 OK -IF105A.CBL 8 8 0 0 0 OK -IF106A.CBL 30 30 0 0 0 OK -IF107A.CBL 2 2 0 0 0 OK -IF108A.CBL 10 10 0 0 0 OK -IF109A.CBL 8 8 0 0 0 OK -IF110A.CBL 9 9 0 0 0 OK -IF111A.CBL 23 23 0 0 0 OK -IF112A.CBL 8 8 0 0 0 OK -IF113A.CBL 8 8 0 0 0 OK -IF114A.CBL 23 23 0 0 0 OK -IF115A.CBL 8 8 0 0 0 OK -IF116A.CBL 25 25 0 0 0 OK -IF117A.CBL 32 32 0 0 0 OK -IF118A.CBL 13 13 0 0 0 OK -IF119A.CBL 23 23 0 0 0 OK -IF120A.CBL 17 17 0 0 0 OK -IF121A.CBL 17 17 0 0 0 OK -IF122A.CBL 17 17 0 0 0 OK -IF123A.CBL 23 23 0 0 0 OK -IF124A.CBL 21 21 0 0 0 OK -IF125A.CBL 20 20 0 0 0 OK -IF126A.CBL 30 30 0 0 0 OK -IF127A.CBL 9 9 0 0 0 OK -IF128A.CBL 16 16 0 0 0 OK -IF129A.CBL 17 17 0 0 0 OK -IF130A.CBL 21 21 0 0 0 OK -IF131A.CBL 8 8 0 0 0 OK -IF132A.CBL 15 15 0 0 0 OK -IF133A.CBL 17 17 0 0 0 OK -IF134A.CBL 13 13 0 0 0 OK -IF135A.CBL 32 32 0 0 0 OK -IF136A.CBL 26 26 0 0 0 OK -IF137A.CBL 17 17 0 0 0 OK -IF138A.CBL 16 16 0 0 0 OK -IF139A.CBL 30 30 0 0 0 OK -IF140A.CBL 13 13 0 0 0 OK -IF141A.CBL 16 16 0 0 0 OK -IF142A.CBL 2 2 0 0 0 OK -IF401M.CBL 0 0 0 0 0 OK -IF402M.CBL 1 1 0 0 0 OK -IF403M.CBL 0 0 0 0 0 OK --------- ----- ---- ---- ------- ------- -Total 733 733 0 0 0 - -Number of programs: 45 -Successfully executed: 45 -Compile error: 0 -Execute error: 0 diff -Nru gnucobol-4.0~early~20200606/tests/cobol85/IX.txt gnucobol-5/tests/cobol85/IX.txt --- gnucobol-4.0~early~20200606/tests/cobol85/IX.txt 2020-06-06 20:52:00.000000000 +0000 +++ gnucobol-5/tests/cobol85/IX.txt 1970-01-01 00:00:00.000000000 +0000 @@ -1,51 +0,0 @@ -Filename total pass fail deleted inspect --------- ----- ---- ---- ------- ------- -IX101A.CBL 2 2 0 0 0 OK -IX102A.SUB 11 11 0 0 0 OK -IX103A.SUB 12 12 0 0 0 OK -IX104A.CBL 13 13 0 0 0 OK -IX105A.CBL 9 9 0 0 0 OK -IX106A.CBL 10 10 0 0 0 OK -IX107A.CBL 14 14 0 0 0 OK -IX108A.CBL 32 32 0 0 0 OK -IX109A.CBL 13 13 0 0 0 OK -IX110A.SUB 4 4 0 0 0 OK -IX111A.SUB 1 1 0 0 0 OK -IX112A.CBL 7 7 0 0 0 OK -IX113A.CBL 4 4 0 0 0 OK -IX114A.SUB 3 3 0 0 0 OK -IX115A.SUB 3 3 0 0 0 OK -IX116A.SUB 3 3 0 0 0 OK -IX117A.SUB 3 3 0 0 0 OK -IX118A.SUB 3 3 0 0 0 OK -IX119A.SUB 3 3 0 0 0 OK -IX120A.SUB 2 2 0 0 0 OK -IX121A.CBL 3 3 0 0 0 OK -IX201A.CBL 2 2 0 0 0 OK -IX202A.SUB 11 11 0 0 0 OK -IX203A.SUB 12 12 0 0 0 OK -IX204A.CBL 13 13 0 0 0 OK -IX205A.CBL 12 12 0 0 0 OK -IX206A.CBL 10 10 0 0 0 OK -IX207A.CBL 8 8 0 0 0 OK -IX208A.CBL 29 29 0 0 0 OK -IX209A.CBL 56 56 0 0 0 OK -IX210A.CBL 39 39 0 0 0 OK -IX211A.CBL 17 17 0 0 0 OK -IX212A.CBL 24 24 0 0 0 OK -IX213A.CBL 21 21 0 0 0 OK -IX214A.CBL 39 39 0 0 0 OK -IX215A.CBL 33 33 0 0 0 OK -IX216A.CBL 15 14 0 1 0 OK -IX217A.CBL 6 6 0 0 0 OK -IX218A.CBL 6 6 0 0 0 OK -IX301M.CBL 0 0 0 0 0 OK -IX302M.CBL 0 0 0 0 0 OK -IX401M.CBL 0 0 0 0 0 OK --------- ----- ---- ---- ------- ------- -Total 508 507 0 1 0 - -Number of programs: 42 -Successfully executed: 42 -Compile error: 0 -Execute error: 0 diff -Nru gnucobol-4.0~early~20200606/tests/cobol85/Makefile.am gnucobol-5/tests/cobol85/Makefile.am --- gnucobol-4.0~early~20200606/tests/cobol85/Makefile.am 2020-06-06 20:52:00.000000000 +0000 +++ gnucobol-5/tests/cobol85/Makefile.am 1970-01-01 00:00:00.000000000 +0000 @@ -1,232 +0,0 @@ -# -# Makefile gnucobol/tests/cobol85 -# -# Copyright (C) 2003-2012, 2015-2020 Free Software Foundation, Inc. -# Written by Keisuke Nishida, Roger While, Simon Sobisch -# -# This file is part of GnuCOBOL. -# -# The GnuCOBOL compiler is free software: you can redistribute it -# and/or modify it under the terms of the GNU General Public License -# as published by the Free Software Foundation, either version 3 of the -# License, or (at your option) any later version. -# -# GnuCOBOL is distributed in the hope that it will be useful, -# but WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -# GNU General Public License for more details. -# -# You should have received a copy of the GNU General Public License -# along with GnuCOBOL. If not, see . - -# FIXME: doesn't work when EXEC85$(EXEEXT) exists in sourcedir but not -# in builddir - -RM = rm -rf - -MODULES_ALL = NC SM IC SQ RL ST SG OB IF RW DB IX DBNOIX CM - -# currently untested modules: CM -if COB_MAKE_IX -MODULES = NC SM IC SQ RL ST SG OB IF RW DB IX -MODULES_RUN = NC_RUN SM_RUN IC_RUN SQ_RUN RL_RUN \ - ST_RUN SG_RUN OB_RUN IF_RUN RW_RUN DB_RUN IX_RUN -SUMMARY = summary.txt -else -MODULES = NC SM IC SQ RL ST SG OB IF RW DBNOIX -MODULES_RUN = NC_RUN SM_RUN IC_RUN SQ_RUN RL_RUN \ - ST_RUN SG_RUN OB_RUN IF_RUN RW_RUN DBNOIX_RUN -SUMMARY = summarynoix.txt -endif - -URL_NEWCOB_Z = https://www.itl.nist.gov/div897/ctg/suites/newcob.val.Z -URL_NEWCOB_TAR_GZ = https://sourceforge.net/projects/open-cobol/files/nist/newcob.val.tar.gz/download - -EXTRA_DIST = EXEC85.conf.in expand.pl report.pl summary.pl summary.txt \ - summarynoix.txt NC.txt SM.txt IC.txt SQ.txt RL.txt IX.txt \ - ST.txt SG.txt OB.txt IF.txt RW.txt DB.txt DBNOIX.txt Makefile.module.in - -#CLEANFILES = EXEC85$(EXEEXT) summary.log - -COB85DIR = "`cd $(srcdir) && pwd`" -WGET_FLAGS = -t1 -T5 -DIFF_FLAGS = @DIFF_FLAGS@ -COBC_FLAGS = -std=cobol85 -debug - -# MAKEFLAGS = --no-print-directory - -# targets that are only logical targets instead of files -.PHONY: test diff-summary diff summary.log $(MODULES_RUN) unpack-Z unpack-gz - -NC_RUN: NC - @cd NC && $(MAKE) -k - -SM_RUN: SM - @cd SM && $(MAKE) -k - -IC_RUN: IC - @cd IC && $(MAKE) -k - -SQ_RUN: SQ - @cd SQ && $(MAKE) -k - -RL_RUN: RL - @cd RL && $(MAKE) -k - -ST_RUN: ST - @cd ST && $(MAKE) -k - -SG_RUN: SG - @cd SG && $(MAKE) -k - -OB_RUN: OB - @cd OB && $(MAKE) -k - -IF_RUN: IF - @cd IF && $(MAKE) -k - -RW_RUN: RW - @cd RW && $(MAKE) -k - -DB_RUN: DB - @cd DB && $(MAKE) -k - -IX_RUN: IX - @cd IX && $(MAKE) -k - -DBNOIX_RUN: DBNOIX - @cd DBNOIX && $(MAKE) -k - -CM_RUN: CM - @cd CM && $(MAKE) -k - -modules: $(MODULES_ALL) - -duration.log: - @echo "Collecting durations for each module..." - @echo "Duration for modules: $(MODULES)" > $@ - @echo "" >> $@ - @for m in $(MODULES); do \ - cat "$$m/duration.txt" >> $@; \ - done - @echo Done - -test: $(MODULES_RUN) - @echo - $(MAKE) diff-summary - -summary.log: - @echo "Computing total test results..." - @perl "$(srcdir)/summary.pl" $(MODULES) > $@ - -diff: - @echo "Comparing test results for each module" - @retd=0; for m in $(MODULES); do \ - echo "diff $$m/report.txt..."; \ - diff $(DIFF_FLAGS) "$(srcdir)/$$m.txt" "$$m/report.txt"; \ - ret=$$? && if test $$ret -gt $$retd; then retd=$$ret; fi \ - done; \ - if test $$retd -gt 1; then exit $$retd; fi - @echo Done - $(MAKE) diff-summary - -diff-summary: - $(MAKE) summary.log - @echo "Comparing total test results..." - @echo "diff $(SUMMARY)..." - @diff $(DIFF_FLAGS) "$(srcdir)/$(SUMMARY)" "summary.log" - @echo Done - -newcob.val.Z: - @echo "Trying to download newcob.val.Z..." - @wget $(WGET_FLAGS) "$(URL_NEWCOB_Z)" - -newcob.val.tar.gz: - @echo "Trying to download newcob.val.tar.gz..." - @wget $(WGET_FLAGS) -O $@ "$(URL_NEWCOB_TAR_GZ)" - -unpack-Z: newcob.val.Z - @echo "Unpacking $<..." - @gunzip -f "$<" || gzip -d -f "$<" || uncompress "$<" - -unpack-gz: newcob.val.tar.gz - @echo "Unpacking $<..." - @tar -xf "$<" - -# always copy pack from srcdir for in-place unpack, if possible -newcob.val: - @if test -f "$(srcdir)/newcob.val.tar.gz"; then \ - if test ! -f "$(abs_builddir)/newcob.val.tar.gz"; then \ - export pack=newcob.val.tar.gz && \ - echo "Copying $$pack to current directory..." && \ - cp "$(srcdir)/$$pack" . ; \ - fi; \ - $(MAKE) unpack-gz; \ - else \ - if test -f "$(srcdir)/newcob.val.Z"; then \ - if test ! -f "$(abs_builddir)/newcob.val.Z"; then \ - export pack=newcob.val.Z && \ - echo "Copying $$pack to current directory..." && \ - cp "$(srcdir)/$$pack" . ; \ - fi; \ - $(MAKE) unpack-Z; \ - else \ - ($(MAKE) newcob.val.Z && $(MAKE) unpack-Z) || \ - (echo Fallback to sourceforge.net && \ - $(MAKE) newcob.val.tar.gz && $(MAKE) unpack-gz); \ - fi; \ - fi - @if ! test -f "newcob.val"; then \ - echo "newcob.val missing, automatic download and uncompress did not work"; \ - exit 1; \ - fi - -clean-local: - $(RM) copy copyalt $(MODULES_ALL) EXEC85$(EXEEXT) summary.log EXEC85.cob - -$(MODULES_ALL): newcob.val EXEC85$(EXEEXT) $(srcdir)/EXEC85.conf.in Makefile.module.in - @echo "Building module directory $@ ..." - @mkdir -p ./$@ - @echo "*SELECT-MODULE `echo $@ | sed 's/\(..\).*/\1/'`" > ./$@/EXEC85.conf - @cat $(srcdir)/EXEC85.conf.in >> ./$@/EXEC85.conf -# setting NEWCOB_VAL to the full name for EXEC85 - @if test -f "$(abs_builddir)/newcob.val"; then \ - export NEWCOB_VAL=$(abs_builddir)/newcob.val; \ - else \ - export NEWCOB_VAL=$(abs_srcdir)/newcob.val; \ - fi; \ - cd $@ && "$(abs_top_builddir)/pre-inst-env" ../EXEC85$(EXEEXT) - @perl $(srcdir)/expand.pl $@/newcob.tmp $@ -# @$(RM) ./$@/newcob.tmp ./$@/newcob.log ./$@/EXEC85.conf - @export CBL_LIST="`ls $@/*.CBL | cut -b4- | tr "\n" " "`" && \ - sed -e 's/##MODULE##/'"$@"'/' \ - -e 's|##COB85DIR##|'"$(COB85DIR)"'|' \ - -e 's|##TESTS##|'"` echo $$CBL_LIST | sed -e 's/\.CBL//g'`"'|' \ - -e 's|##TESTS_LOCAL##|'"`echo $$CBL_LIST | sed -e 's/\.CBL/-local/g'`"'|' \ - $(srcdir)/Makefile.module.in > $@/Makefile - @echo "Finished module directory $@." - -EXEC85.cob: newcob.val - @echo "Extracting EXEC85 program from newcob.val" -# setting NEWCOB_VAL to the full name for the sed invocation - @if test -f "$(abs_builddir)/newcob.val"; then \ - NEWCOB_VAL=$(abs_builddir)/newcob.val; \ - else \ - NEWCOB_VAL=$(abs_srcdir)/newcob.val; \ - fi; \ - sed -e '/^\*END/,$$d' \ - -e '1,/^\*HEADER/d' \ - -e 's/^002500.*/ SELECT POPULATION-FILE/' \ - -e 's/^002700.*/ "NEWCOB_VAL" ORGANIZATION LINE SEQUENTIAL./' \ - -e 's/^003000.*/ "newcob.tmp" ORGANIZATION LINE SEQUENTIAL./' \ - -e 's/^003100.*//' \ - -e 's/^003400.*/ "unused"./' \ - -e 's/^003700.*/ "newcob.log"./' \ - -e 's/^004000.*/ "EXEC85.conf" ORGANIZATION LINE SEQUENTIAL./' \ - "$$NEWCOB_VAL" > EXEC85.cob || ($(RM) EXEC85.cob && false) - - -EXEC85$(EXEEXT): EXEC85.cob - @echo "Compiling EXEC85 program" - @if test -f "EXEC85.cob"; then EXEC_SRC="EXEC85.cob"; else EXEC_SRC="$(srcdir)/EXEC85.cob"; fi; \ - "$(top_builddir)/pre-inst-env" cobc$(EXEEXT) $(COBC_FLAGS) -x "$$EXEC_SRC" diff -Nru gnucobol-4.0~early~20200606/tests/cobol85/Makefile.in gnucobol-5/tests/cobol85/Makefile.in --- gnucobol-4.0~early~20200606/tests/cobol85/Makefile.in 2020-06-06 20:56:36.000000000 +0000 +++ gnucobol-5/tests/cobol85/Makefile.in 1970-01-01 00:00:00.000000000 +0000 @@ -1,754 +0,0 @@ -# Makefile.in generated by automake 1.15.1 from Makefile.am. -# @configure_input@ - -# Copyright (C) 1994-2017 Free Software Foundation, Inc. - -# This Makefile.in is free software; the Free Software Foundation -# gives unlimited permission to copy and/or distribute it, -# with or without modifications, as long as this notice is preserved. - -# This program is distributed in the hope that it will be useful, -# but WITHOUT ANY WARRANTY, to the extent permitted by law; without -# even the implied warranty of MERCHANTABILITY or FITNESS FOR A -# PARTICULAR PURPOSE. - -@SET_MAKE@ - -# -# Makefile gnucobol/tests/cobol85 -# -# Copyright (C) 2003-2012, 2015-2020 Free Software Foundation, Inc. -# Written by Keisuke Nishida, Roger While, Simon Sobisch -# -# This file is part of GnuCOBOL. -# -# The GnuCOBOL compiler is free software: you can redistribute it -# and/or modify it under the terms of the GNU General Public License -# as published by the Free Software Foundation, either version 3 of the -# License, or (at your option) any later version. -# -# GnuCOBOL is distributed in the hope that it will be useful, -# but WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -# GNU General Public License for more details. -# -# You should have received a copy of the GNU General Public License -# along with GnuCOBOL. If not, see . - -# FIXME: doesn't work when EXEC85$(EXEEXT) exists in sourcedir but not -# in builddir -VPATH = @srcdir@ -am__is_gnu_make = { \ - if test -z '$(MAKELEVEL)'; then \ - false; \ - elif test -n '$(MAKE_HOST)'; then \ - true; \ - elif test -n '$(MAKE_VERSION)' && test -n '$(CURDIR)'; then \ - true; \ - else \ - false; \ - fi; \ -} -am__make_running_with_option = \ - case $${target_option-} in \ - ?) ;; \ - *) echo "am__make_running_with_option: internal error: invalid" \ - "target option '$${target_option-}' specified" >&2; \ - exit 1;; \ - esac; \ - has_opt=no; \ - sane_makeflags=$$MAKEFLAGS; \ - if $(am__is_gnu_make); then \ - sane_makeflags=$$MFLAGS; \ - else \ - case $$MAKEFLAGS in \ - *\\[\ \ ]*) \ - bs=\\; \ - sane_makeflags=`printf '%s\n' "$$MAKEFLAGS" \ - | sed "s/$$bs$$bs[$$bs $$bs ]*//g"`;; \ - esac; \ - fi; \ - skip_next=no; \ - strip_trailopt () \ - { \ - flg=`printf '%s\n' "$$flg" | sed "s/$$1.*$$//"`; \ - }; \ - for flg in $$sane_makeflags; do \ - test $$skip_next = yes && { skip_next=no; continue; }; \ - case $$flg in \ - *=*|--*) continue;; \ - -*I) strip_trailopt 'I'; skip_next=yes;; \ - -*I?*) strip_trailopt 'I';; \ - -*O) strip_trailopt 'O'; skip_next=yes;; \ - -*O?*) strip_trailopt 'O';; \ - -*l) strip_trailopt 'l'; skip_next=yes;; \ - -*l?*) strip_trailopt 'l';; \ - -[dEDm]) skip_next=yes;; \ - -[JT]) skip_next=yes;; \ - esac; \ - case $$flg in \ - *$$target_option*) has_opt=yes; break;; \ - esac; \ - done; \ - test $$has_opt = yes -am__make_dryrun = (target_option=n; $(am__make_running_with_option)) -am__make_keepgoing = (target_option=k; $(am__make_running_with_option)) -pkgdatadir = $(datadir)/@PACKAGE@ -pkgincludedir = $(includedir)/@PACKAGE@ -pkglibdir = $(libdir)/@PACKAGE@ -pkglibexecdir = $(libexecdir)/@PACKAGE@ -am__cd = CDPATH="$${ZSH_VERSION+.}$(PATH_SEPARATOR)" && cd -install_sh_DATA = $(install_sh) -c -m 644 -install_sh_PROGRAM = $(install_sh) -c -install_sh_SCRIPT = $(install_sh) -c -INSTALL_HEADER = $(INSTALL_DATA) -transform = $(program_transform_name) -NORMAL_INSTALL = : -PRE_INSTALL = : -POST_INSTALL = : -NORMAL_UNINSTALL = : -PRE_UNINSTALL = : -POST_UNINSTALL = : -build_triplet = @build@ -host_triplet = @host@ -subdir = tests/cobol85 -ACLOCAL_M4 = $(top_srcdir)/aclocal.m4 -am__aclocal_m4_deps = $(top_srcdir)/m4/codeset.m4 \ - $(top_srcdir)/m4/gettext.m4 $(top_srcdir)/m4/iconv.m4 \ - $(top_srcdir)/m4/intlmacosx.m4 $(top_srcdir)/m4/lib-ld.m4 \ - $(top_srcdir)/m4/lib-link.m4 $(top_srcdir)/m4/lib-prefix.m4 \ - $(top_srcdir)/m4/libtool.m4 $(top_srcdir)/m4/ltoptions.m4 \ - $(top_srcdir)/m4/ltsugar.m4 $(top_srcdir)/m4/ltversion.m4 \ - $(top_srcdir)/m4/lt~obsolete.m4 \ - $(top_srcdir)/m4/m4_ax_check_define.m4 \ - $(top_srcdir)/m4/m4_ax_code_coverage.m4 \ - $(top_srcdir)/m4/nls.m4 $(top_srcdir)/m4/pkg.m4 \ - $(top_srcdir)/m4/po.m4 $(top_srcdir)/m4/progtest.m4 \ - $(top_srcdir)/configure.ac -am__configure_deps = $(am__aclocal_m4_deps) $(CONFIGURE_DEPENDENCIES) \ - $(ACLOCAL_M4) -DIST_COMMON = $(srcdir)/Makefile.am $(am__DIST_COMMON) -mkinstalldirs = $(SHELL) $(top_srcdir)/build_aux/mkinstalldirs -CONFIG_HEADER = $(top_builddir)/config.h -CONFIG_CLEAN_FILES = -CONFIG_CLEAN_VPATH_FILES = -AM_V_P = $(am__v_P_@AM_V@) -am__v_P_ = $(am__v_P_@AM_DEFAULT_V@) -am__v_P_0 = false -am__v_P_1 = : -AM_V_GEN = $(am__v_GEN_@AM_V@) -am__v_GEN_ = $(am__v_GEN_@AM_DEFAULT_V@) -am__v_GEN_0 = @echo " GEN " $@; -am__v_GEN_1 = -AM_V_at = $(am__v_at_@AM_V@) -am__v_at_ = $(am__v_at_@AM_DEFAULT_V@) -am__v_at_0 = @ -am__v_at_1 = -SOURCES = -DIST_SOURCES = -am__can_run_installinfo = \ - case $$AM_UPDATE_INFO_DIR in \ - n|no|NO) false;; \ - *) (install-info --version) >/dev/null 2>&1;; \ - esac -am__tagged_files = $(HEADERS) $(SOURCES) $(TAGS_FILES) $(LISP) -am__DIST_COMMON = $(srcdir)/Makefile.in \ - $(top_srcdir)/build_aux/mkinstalldirs ChangeLog README -DISTFILES = $(DIST_COMMON) $(DIST_SOURCES) $(TEXINFOS) $(EXTRA_DIST) -ACLOCAL = @ACLOCAL@ -AMTAR = @AMTAR@ -AM_DEFAULT_VERBOSITY = @AM_DEFAULT_VERBOSITY@ -AR = @AR@ -AS = @AS@ -AUTOCONF = @AUTOCONF@ -AUTOHEADER = @AUTOHEADER@ -AUTOMAKE = @AUTOMAKE@ -AWK = @AWK@ -CC = @CC@ -CCDEPMODE = @CCDEPMODE@ -CFLAGS = @CFLAGS@ -CJSON_CFLAGS = @CJSON_CFLAGS@ -CJSON_LIBS = @CJSON_LIBS@ -COBC_LIBS = @COBC_LIBS@ -COB_BIGENDIAN = @COB_BIGENDIAN@ -COB_CC = @COB_CC@ -COB_CFLAGS = @COB_CFLAGS@ -COB_CONFIG_DIR = @COB_CONFIG_DIR@ -COB_COPY_DIR = @COB_COPY_DIR@ -COB_EXE_EXT = @COB_EXE_EXT@ -COB_EXPORT_DYN = @COB_EXPORT_DYN@ -COB_FIX_LIB = @COB_FIX_LIB@ -COB_FIX_LIBTOOL = @COB_FIX_LIBTOOL@ -COB_HAS_64_BIT_POINTER = @COB_HAS_64_BIT_POINTER@ -COB_HAS_BDB = @COB_HAS_BDB@ -COB_HAS_CISAM = @COB_HAS_CISAM@ -COB_HAS_CJSON = @COB_HAS_CJSON@ -COB_HAS_CURSES = @COB_HAS_CURSES@ -COB_HAS_DISAM = @COB_HAS_DISAM@ -COB_HAS_ISAM = @COB_HAS_ISAM@ -COB_HAS_LMDB = @COB_HAS_LMDB@ -COB_HAS_OCEXTFH = @COB_HAS_OCEXTFH@ -COB_HAS_OCI = @COB_HAS_OCI@ -COB_HAS_ODBC = @COB_HAS_ODBC@ -COB_HAS_VBISAM = @COB_HAS_VBISAM@ -COB_HAS_XML2 = @COB_HAS_XML2@ -COB_KEYWORD_INLINE = @COB_KEYWORD_INLINE@ -COB_LDFLAGS = @COB_LDFLAGS@ -COB_LIBRARY_PATH = @COB_LIBRARY_PATH@ -COB_LIBS = @COB_LIBS@ -COB_MODULE_EXT = @COB_MODULE_EXT@ -COB_OBJECT_EXT = @COB_OBJECT_EXT@ -COB_PATCH_LEVEL = @COB_PATCH_LEVEL@ -COB_PIC_FLAGS = @COB_PIC_FLAGS@ -COB_SCHEMA_DIR = @COB_SCHEMA_DIR@ -COB_SHARED_OPT = @COB_SHARED_OPT@ -CODE_COVERAGE_CFLAGS = @CODE_COVERAGE_CFLAGS@ -CODE_COVERAGE_CPPFLAGS = @CODE_COVERAGE_CPPFLAGS@ -CODE_COVERAGE_CXXFLAGS = @CODE_COVERAGE_CXXFLAGS@ -CODE_COVERAGE_ENABLED = @CODE_COVERAGE_ENABLED@ -CODE_COVERAGE_LDFLAGS = @CODE_COVERAGE_LDFLAGS@ -CODE_COVERAGE_LIBS = @CODE_COVERAGE_LIBS@ -CPP = @CPP@ -CPPFLAGS = @CPPFLAGS@ -CYGPATH_W = @CYGPATH_W@ -DEFS = @DEFS@ -DEPDIR = @DEPDIR@ -DIFF_FLAGS = @DIFF_FLAGS@ -DLLTOOL = @DLLTOOL@ -DSYMUTIL = @DSYMUTIL@ -DUMPBIN = @DUMPBIN@ -ECHO_C = @ECHO_C@ -ECHO_N = @ECHO_N@ -ECHO_T = @ECHO_T@ -EGREP = @EGREP@ -EXEEXT = @EXEEXT@ -FGREP = @FGREP@ -GCOV = @GCOV@ -GENHTML = @GENHTML@ -GETTEXT_MACRO_VERSION = @GETTEXT_MACRO_VERSION@ -GMSGFMT = @GMSGFMT@ -GMSGFMT_015 = @GMSGFMT_015@ -GREP = @GREP@ -HELP2MAN = @HELP2MAN@ -INSTALL = @INSTALL@ -INSTALL_DATA = @INSTALL_DATA@ -INSTALL_PROGRAM = @INSTALL_PROGRAM@ -INSTALL_SCRIPT = @INSTALL_SCRIPT@ -INSTALL_STRIP_PROGRAM = @INSTALL_STRIP_PROGRAM@ -INTLLIBS = @INTLLIBS@ -INTL_MACOSX_LIBS = @INTL_MACOSX_LIBS@ -LCOV = @LCOV@ -LD = @LD@ -LDFLAGS = @LDFLAGS@ -LEX = @LEX@ -LEXLIB = @LEXLIB@ -LEX_OUTPUT_ROOT = @LEX_OUTPUT_ROOT@ -LIBCOB_CISAM = @LIBCOB_CISAM@ -LIBCOB_CPPFLAGS = @LIBCOB_CPPFLAGS@ -LIBCOB_DISAM = @LIBCOB_DISAM@ -LIBCOB_LIBS = @LIBCOB_LIBS@ -LIBCOB_VBISAM = @LIBCOB_VBISAM@ -LIBICONV = @LIBICONV@ -LIBINTL = @LIBINTL@ -LIBOBJS = @LIBOBJS@ -LIBS = @LIBS@ -LIBTOOL = @LIBTOOL@ -LIPO = @LIPO@ -LN_S = @LN_S@ -LTLIBICONV = @LTLIBICONV@ -LTLIBINTL = @LTLIBINTL@ -LTLIBOBJS = @LTLIBOBJS@ -LT_SYS_LIBRARY_PATH = @LT_SYS_LIBRARY_PATH@ -MAKE = @MAKE@ -MAKEINFO = @MAKEINFO@ -MANIFEST_TOOL = @MANIFEST_TOOL@ -MKDIR_P = @MKDIR_P@ -MSGFMT = @MSGFMT@ -MSGFMT_015 = @MSGFMT_015@ -MSGMERGE = @MSGMERGE@ -NM = @NM@ -NMEDIT = @NMEDIT@ -OBJDUMP = @OBJDUMP@ -OBJEXT = @OBJEXT@ -ODBC_CFLAGS = @ODBC_CFLAGS@ -ODBC_LIBS = @ODBC_LIBS@ -OTOOL = @OTOOL@ -OTOOL64 = @OTOOL64@ -PACKAGE = @PACKAGE@ -PACKAGE_BUGREPORT = @PACKAGE_BUGREPORT@ -PACKAGE_NAME = @PACKAGE_NAME@ -PACKAGE_STRING = @PACKAGE_STRING@ -PACKAGE_TARNAME = @PACKAGE_TARNAME@ -PACKAGE_URL = @PACKAGE_URL@ -PACKAGE_VERSION = @PACKAGE_VERSION@ -PATH_SEPARATOR = @PATH_SEPARATOR@ -PKG_CONFIG = @PKG_CONFIG@ -PKG_CONFIG_LIBDIR = @PKG_CONFIG_LIBDIR@ -PKG_CONFIG_PATH = @PKG_CONFIG_PATH@ -POSUB = @POSUB@ -RANLIB = @RANLIB@ -SED = @SED@ -SET_MAKE = @SET_MAKE@ -SHELL = @SHELL@ -STRIP = @STRIP@ -USE_NLS = @USE_NLS@ -VERSION = @VERSION@ -XGETTEXT = @XGETTEXT@ -XGETTEXT_015 = @XGETTEXT_015@ -XGETTEXT_EXTRA_OPTIONS = @XGETTEXT_EXTRA_OPTIONS@ -XML2_CFLAGS = @XML2_CFLAGS@ -XML2_LIBS = @XML2_LIBS@ -YACC = @YACC@ -YFLAGS = @YFLAGS@ -abs_builddir = @abs_builddir@ -abs_srcdir = @abs_srcdir@ -abs_top_builddir = @abs_top_builddir@ -abs_top_srcdir = @abs_top_srcdir@ -ac_ct_AR = @ac_ct_AR@ -ac_ct_CC = @ac_ct_CC@ -ac_ct_DUMPBIN = @ac_ct_DUMPBIN@ -am__include = @am__include@ -am__leading_dot = @am__leading_dot@ -am__quote = @am__quote@ -am__tar = @am__tar@ -am__untar = @am__untar@ -bindir = @bindir@ -build = @build@ -build_alias = @build_alias@ -build_cpu = @build_cpu@ -build_os = @build_os@ -build_vendor = @build_vendor@ -builddir = @builddir@ -configured_make = @configured_make@ -datadir = @datadir@ -datarootdir = @datarootdir@ -docdir = @docdir@ -dvidir = @dvidir@ -exec_prefix = @exec_prefix@ -host = @host@ -host_alias = @host_alias@ -host_cpu = @host_cpu@ -host_os = @host_os@ -host_vendor = @host_vendor@ -htmldir = @htmldir@ -includedir = @includedir@ -infodir = @infodir@ -install_sh = @install_sh@ -libdir = @libdir@ -libexecdir = @libexecdir@ -localedir = @localedir@ -localstatedir = @localstatedir@ -mandir = @mandir@ -mkdir_p = @mkdir_p@ -oldincludedir = @oldincludedir@ -pdfdir = @pdfdir@ -prefix = @prefix@ -program_transform_name = @program_transform_name@ -psdir = @psdir@ -runstatedir = @runstatedir@ -sbindir = @sbindir@ -sharedstatedir = @sharedstatedir@ -srcdir = @srcdir@ -sysconfdir = @sysconfdir@ -target_alias = @target_alias@ -top_build_prefix = @top_build_prefix@ -top_builddir = @top_builddir@ -top_srcdir = @top_srcdir@ -xml2_config_found = @xml2_config_found@ -RM = rm -rf -MODULES_ALL = NC SM IC SQ RL ST SG OB IF RW DB IX DBNOIX CM -@COB_MAKE_IX_FALSE@MODULES = NC SM IC SQ RL ST SG OB IF RW DBNOIX - -# currently untested modules: CM -@COB_MAKE_IX_TRUE@MODULES = NC SM IC SQ RL ST SG OB IF RW DB IX -@COB_MAKE_IX_FALSE@MODULES_RUN = NC_RUN SM_RUN IC_RUN SQ_RUN RL_RUN \ -@COB_MAKE_IX_FALSE@ ST_RUN SG_RUN OB_RUN IF_RUN RW_RUN DBNOIX_RUN - -@COB_MAKE_IX_TRUE@MODULES_RUN = NC_RUN SM_RUN IC_RUN SQ_RUN RL_RUN \ -@COB_MAKE_IX_TRUE@ ST_RUN SG_RUN OB_RUN IF_RUN RW_RUN DB_RUN IX_RUN - -@COB_MAKE_IX_FALSE@SUMMARY = summarynoix.txt -@COB_MAKE_IX_TRUE@SUMMARY = summary.txt -URL_NEWCOB_Z = https://www.itl.nist.gov/div897/ctg/suites/newcob.val.Z -URL_NEWCOB_TAR_GZ = https://sourceforge.net/projects/open-cobol/files/nist/newcob.val.tar.gz/download -EXTRA_DIST = EXEC85.conf.in expand.pl report.pl summary.pl summary.txt \ - summarynoix.txt NC.txt SM.txt IC.txt SQ.txt RL.txt IX.txt \ - ST.txt SG.txt OB.txt IF.txt RW.txt DB.txt DBNOIX.txt Makefile.module.in - - -#CLEANFILES = EXEC85$(EXEEXT) summary.log -COB85DIR = "`cd $(srcdir) && pwd`" -WGET_FLAGS = -t1 -T5 -COBC_FLAGS = -std=cobol85 -debug -all: all-am - -.SUFFIXES: -$(srcdir)/Makefile.in: $(srcdir)/Makefile.am $(am__configure_deps) - @for dep in $?; do \ - case '$(am__configure_deps)' in \ - *$$dep*) \ - ( cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh ) \ - && { if test -f $@; then exit 0; else break; fi; }; \ - exit 1;; \ - esac; \ - done; \ - echo ' cd $(top_srcdir) && $(AUTOMAKE) --gnu tests/cobol85/Makefile'; \ - $(am__cd) $(top_srcdir) && \ - $(AUTOMAKE) --gnu tests/cobol85/Makefile -Makefile: $(srcdir)/Makefile.in $(top_builddir)/config.status - @case '$?' in \ - *config.status*) \ - cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh;; \ - *) \ - echo ' cd $(top_builddir) && $(SHELL) ./config.status $(subdir)/$@ $(am__depfiles_maybe)'; \ - cd $(top_builddir) && $(SHELL) ./config.status $(subdir)/$@ $(am__depfiles_maybe);; \ - esac; - -$(top_builddir)/config.status: $(top_srcdir)/configure $(CONFIG_STATUS_DEPENDENCIES) - cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh - -$(top_srcdir)/configure: $(am__configure_deps) - cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh -$(ACLOCAL_M4): $(am__aclocal_m4_deps) - cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh -$(am__aclocal_m4_deps): - -mostlyclean-libtool: - -rm -f *.lo - -clean-libtool: - -rm -rf .libs _libs -tags TAGS: - -ctags CTAGS: - -cscope cscopelist: - - -distdir: $(DISTFILES) - @srcdirstrip=`echo "$(srcdir)" | sed 's/[].[^$$\\*]/\\\\&/g'`; \ - topsrcdirstrip=`echo "$(top_srcdir)" | sed 's/[].[^$$\\*]/\\\\&/g'`; \ - list='$(DISTFILES)'; \ - dist_files=`for file in $$list; do echo $$file; done | \ - sed -e "s|^$$srcdirstrip/||;t" \ - -e "s|^$$topsrcdirstrip/|$(top_builddir)/|;t"`; \ - case $$dist_files in \ - */*) $(MKDIR_P) `echo "$$dist_files" | \ - sed '/\//!d;s|^|$(distdir)/|;s,/[^/]*$$,,' | \ - sort -u` ;; \ - esac; \ - for file in $$dist_files; do \ - if test -f $$file || test -d $$file; then d=.; else d=$(srcdir); fi; \ - if test -d $$d/$$file; then \ - dir=`echo "/$$file" | sed -e 's,/[^/]*$$,,'`; \ - if test -d "$(distdir)/$$file"; then \ - find "$(distdir)/$$file" -type d ! -perm -700 -exec chmod u+rwx {} \;; \ - fi; \ - if test -d $(srcdir)/$$file && test $$d != $(srcdir); then \ - cp -fpR $(srcdir)/$$file "$(distdir)$$dir" || exit 1; \ - find "$(distdir)/$$file" -type d ! -perm -700 -exec chmod u+rwx {} \;; \ - fi; \ - cp -fpR $$d/$$file "$(distdir)$$dir" || exit 1; \ - else \ - test -f "$(distdir)/$$file" \ - || cp -p $$d/$$file "$(distdir)/$$file" \ - || exit 1; \ - fi; \ - done -check-am: all-am -check: check-am -all-am: Makefile -installdirs: -install: install-am -install-exec: install-exec-am -install-data: install-data-am -uninstall: uninstall-am - -install-am: all-am - @$(MAKE) $(AM_MAKEFLAGS) install-exec-am install-data-am - -installcheck: installcheck-am -install-strip: - if test -z '$(STRIP)'; then \ - $(MAKE) $(AM_MAKEFLAGS) INSTALL_PROGRAM="$(INSTALL_STRIP_PROGRAM)" \ - install_sh_PROGRAM="$(INSTALL_STRIP_PROGRAM)" INSTALL_STRIP_FLAG=-s \ - install; \ - else \ - $(MAKE) $(AM_MAKEFLAGS) INSTALL_PROGRAM="$(INSTALL_STRIP_PROGRAM)" \ - install_sh_PROGRAM="$(INSTALL_STRIP_PROGRAM)" INSTALL_STRIP_FLAG=-s \ - "INSTALL_PROGRAM_ENV=STRIPPROG='$(STRIP)'" install; \ - fi -mostlyclean-generic: - -clean-generic: - -distclean-generic: - -test -z "$(CONFIG_CLEAN_FILES)" || rm -f $(CONFIG_CLEAN_FILES) - -test . = "$(srcdir)" || test -z "$(CONFIG_CLEAN_VPATH_FILES)" || rm -f $(CONFIG_CLEAN_VPATH_FILES) - -maintainer-clean-generic: - @echo "This command is intended for maintainers to use" - @echo "it deletes files that may require special tools to rebuild." -clean: clean-am - -clean-am: clean-generic clean-libtool clean-local mostlyclean-am - -distclean: distclean-am - -rm -f Makefile -distclean-am: clean-am distclean-generic - -dvi: dvi-am - -dvi-am: - -html: html-am - -html-am: - -info: info-am - -info-am: - -install-data-am: - -install-dvi: install-dvi-am - -install-dvi-am: - -install-exec-am: - -install-html: install-html-am - -install-html-am: - -install-info: install-info-am - -install-info-am: - -install-man: - -install-pdf: install-pdf-am - -install-pdf-am: - -install-ps: install-ps-am - -install-ps-am: - -installcheck-am: - -maintainer-clean: maintainer-clean-am - -rm -f Makefile -maintainer-clean-am: distclean-am maintainer-clean-generic - -mostlyclean: mostlyclean-am - -mostlyclean-am: mostlyclean-generic mostlyclean-libtool - -pdf: pdf-am - -pdf-am: - -ps: ps-am - -ps-am: - -uninstall-am: - -.MAKE: install-am install-strip - -.PHONY: all all-am check check-am clean clean-generic clean-libtool \ - clean-local cscopelist-am ctags-am distclean distclean-generic \ - distclean-libtool distdir dvi dvi-am html html-am info info-am \ - install install-am install-data install-data-am install-dvi \ - install-dvi-am install-exec install-exec-am install-html \ - install-html-am install-info install-info-am install-man \ - install-pdf install-pdf-am install-ps install-ps-am \ - install-strip installcheck installcheck-am installdirs \ - maintainer-clean maintainer-clean-generic mostlyclean \ - mostlyclean-generic mostlyclean-libtool pdf pdf-am ps ps-am \ - tags-am uninstall uninstall-am - -.PRECIOUS: Makefile - - -# MAKEFLAGS = --no-print-directory - -# targets that are only logical targets instead of files -.PHONY: test diff-summary diff summary.log $(MODULES_RUN) unpack-Z unpack-gz - -NC_RUN: NC - @cd NC && $(MAKE) -k - -SM_RUN: SM - @cd SM && $(MAKE) -k - -IC_RUN: IC - @cd IC && $(MAKE) -k - -SQ_RUN: SQ - @cd SQ && $(MAKE) -k - -RL_RUN: RL - @cd RL && $(MAKE) -k - -ST_RUN: ST - @cd ST && $(MAKE) -k - -SG_RUN: SG - @cd SG && $(MAKE) -k - -OB_RUN: OB - @cd OB && $(MAKE) -k - -IF_RUN: IF - @cd IF && $(MAKE) -k - -RW_RUN: RW - @cd RW && $(MAKE) -k - -DB_RUN: DB - @cd DB && $(MAKE) -k - -IX_RUN: IX - @cd IX && $(MAKE) -k - -DBNOIX_RUN: DBNOIX - @cd DBNOIX && $(MAKE) -k - -CM_RUN: CM - @cd CM && $(MAKE) -k - -modules: $(MODULES_ALL) - -duration.log: - @echo "Collecting durations for each module..." - @echo "Duration for modules: $(MODULES)" > $@ - @echo "" >> $@ - @for m in $(MODULES); do \ - cat "$$m/duration.txt" >> $@; \ - done - @echo Done - -test: $(MODULES_RUN) - @echo - $(MAKE) diff-summary - -summary.log: - @echo "Computing total test results..." - @perl "$(srcdir)/summary.pl" $(MODULES) > $@ - -diff: - @echo "Comparing test results for each module" - @retd=0; for m in $(MODULES); do \ - echo "diff $$m/report.txt..."; \ - diff $(DIFF_FLAGS) "$(srcdir)/$$m.txt" "$$m/report.txt"; \ - ret=$$? && if test $$ret -gt $$retd; then retd=$$ret; fi \ - done; \ - if test $$retd -gt 1; then exit $$retd; fi - @echo Done - $(MAKE) diff-summary - -diff-summary: - $(MAKE) summary.log - @echo "Comparing total test results..." - @echo "diff $(SUMMARY)..." - @diff $(DIFF_FLAGS) "$(srcdir)/$(SUMMARY)" "summary.log" - @echo Done - -newcob.val.Z: - @echo "Trying to download newcob.val.Z..." - @wget $(WGET_FLAGS) "$(URL_NEWCOB_Z)" - -newcob.val.tar.gz: - @echo "Trying to download newcob.val.tar.gz..." - @wget $(WGET_FLAGS) -O $@ "$(URL_NEWCOB_TAR_GZ)" - -unpack-Z: newcob.val.Z - @echo "Unpacking $<..." - @gunzip -f "$<" || gzip -d -f "$<" || uncompress "$<" - -unpack-gz: newcob.val.tar.gz - @echo "Unpacking $<..." - @tar -xf "$<" - -# always copy pack from srcdir for in-place unpack, if possible -newcob.val: - @if test -f "$(srcdir)/newcob.val.tar.gz"; then \ - if test ! -f "$(abs_builddir)/newcob.val.tar.gz"; then \ - export pack=newcob.val.tar.gz && \ - echo "Copying $$pack to current directory..." && \ - cp "$(srcdir)/$$pack" . ; \ - fi; \ - $(MAKE) unpack-gz; \ - else \ - if test -f "$(srcdir)/newcob.val.Z"; then \ - if test ! -f "$(abs_builddir)/newcob.val.Z"; then \ - export pack=newcob.val.Z && \ - echo "Copying $$pack to current directory..." && \ - cp "$(srcdir)/$$pack" . ; \ - fi; \ - $(MAKE) unpack-Z; \ - else \ - ($(MAKE) newcob.val.Z && $(MAKE) unpack-Z) || \ - (echo Fallback to sourceforge.net && \ - $(MAKE) newcob.val.tar.gz && $(MAKE) unpack-gz); \ - fi; \ - fi - @if ! test -f "newcob.val"; then \ - echo "newcob.val missing, automatic download and uncompress did not work"; \ - exit 1; \ - fi - -clean-local: - $(RM) copy copyalt $(MODULES_ALL) EXEC85$(EXEEXT) summary.log EXEC85.cob - -$(MODULES_ALL): newcob.val EXEC85$(EXEEXT) $(srcdir)/EXEC85.conf.in Makefile.module.in - @echo "Building module directory $@ ..." - @mkdir -p ./$@ - @echo "*SELECT-MODULE `echo $@ | sed 's/\(..\).*/\1/'`" > ./$@/EXEC85.conf - @cat $(srcdir)/EXEC85.conf.in >> ./$@/EXEC85.conf -# setting NEWCOB_VAL to the full name for EXEC85 - @if test -f "$(abs_builddir)/newcob.val"; then \ - export NEWCOB_VAL=$(abs_builddir)/newcob.val; \ - else \ - export NEWCOB_VAL=$(abs_srcdir)/newcob.val; \ - fi; \ - cd $@ && "$(abs_top_builddir)/pre-inst-env" ../EXEC85$(EXEEXT) - @perl $(srcdir)/expand.pl $@/newcob.tmp $@ -# @$(RM) ./$@/newcob.tmp ./$@/newcob.log ./$@/EXEC85.conf - @export CBL_LIST="`ls $@/*.CBL | cut -b4- | tr "\n" " "`" && \ - sed -e 's/##MODULE##/'"$@"'/' \ - -e 's|##COB85DIR##|'"$(COB85DIR)"'|' \ - -e 's|##TESTS##|'"` echo $$CBL_LIST | sed -e 's/\.CBL//g'`"'|' \ - -e 's|##TESTS_LOCAL##|'"`echo $$CBL_LIST | sed -e 's/\.CBL/-local/g'`"'|' \ - $(srcdir)/Makefile.module.in > $@/Makefile - @echo "Finished module directory $@." - -EXEC85.cob: newcob.val - @echo "Extracting EXEC85 program from newcob.val" -# setting NEWCOB_VAL to the full name for the sed invocation - @if test -f "$(abs_builddir)/newcob.val"; then \ - NEWCOB_VAL=$(abs_builddir)/newcob.val; \ - else \ - NEWCOB_VAL=$(abs_srcdir)/newcob.val; \ - fi; \ - sed -e '/^\*END/,$$d' \ - -e '1,/^\*HEADER/d' \ - -e 's/^002500.*/ SELECT POPULATION-FILE/' \ - -e 's/^002700.*/ "NEWCOB_VAL" ORGANIZATION LINE SEQUENTIAL./' \ - -e 's/^003000.*/ "newcob.tmp" ORGANIZATION LINE SEQUENTIAL./' \ - -e 's/^003100.*//' \ - -e 's/^003400.*/ "unused"./' \ - -e 's/^003700.*/ "newcob.log"./' \ - -e 's/^004000.*/ "EXEC85.conf" ORGANIZATION LINE SEQUENTIAL./' \ - "$$NEWCOB_VAL" > EXEC85.cob || ($(RM) EXEC85.cob && false) - -EXEC85$(EXEEXT): EXEC85.cob - @echo "Compiling EXEC85 program" - @if test -f "EXEC85.cob"; then EXEC_SRC="EXEC85.cob"; else EXEC_SRC="$(srcdir)/EXEC85.cob"; fi; \ - "$(top_builddir)/pre-inst-env" cobc$(EXEEXT) $(COBC_FLAGS) -x "$$EXEC_SRC" - -# Tell versions [3.59,3.63) of GNU make to not export all variables. -# Otherwise a system limit (for SysV at least) may be exceeded. -.NOEXPORT: diff -Nru gnucobol-4.0~early~20200606/tests/cobol85/Makefile.module.in gnucobol-5/tests/cobol85/Makefile.module.in --- gnucobol-4.0~early~20200606/tests/cobol85/Makefile.module.in 2020-06-06 20:52:00.000000000 +0000 +++ gnucobol-5/tests/cobol85/Makefile.module.in 1970-01-01 00:00:00.000000000 +0000 @@ -1,82 +0,0 @@ -# -# Makefile gnucobol/tests/cobol85/##MODULE## -# -# Copyright (C) 2003-2012, 2015-2019 Free Software Foundation, Inc. -# Written by Keisuke Nishida, Roger While, Simon Sobisch -# -# This file is part of GnuCOBOL. -# -# The GnuCOBOL compiler is free software: you can redistribute it -# and/or modify it under the terms of the GNU General Public License -# as published by the Free Software Foundation, either version 3 of the -# License, or (at your option) any later version. -# -# GnuCOBOL is distributed in the hope that it will be useful, -# but WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -# GNU General Public License for more details. -# -# You should have received a copy of the GNU General Public License -# along with GnuCOBOL. If not, see . - -TESTS = ##TESTS## -TESTS_LOCAL = ##TESTS_LOCAL## - -RM = rm -rf - -# targets that are only logical targets instead of files -.PHONY: test test-local diff test-O test-O-local lib lib-local $\ - (TESTS) $(TESTS_LOCAL) - -all: - @$(MAKE) test - @$(MAKE) diff -# @$(MAKE) test-O -# @$(MAKE) diff - @echo - -test: - @. ../../atconfig && . ../../atlocal NIST_$@ && $(MAKE) $@-local - -test-local: - @echo - @echo "Performing tests for module directory ##MODULE##" - @perl ##COB85DIR##/report.pl - -diff: report.txt - @echo - @echo "Comparing test results for module directory ##MODULE##" - diff ##COB85DIR##/##MODULE##.txt report.txt || true - -test-O: - @. ../../atconfig && . ../../atlocal NIST-##MODULE##-O_$@ && $(MAKE) $@-local - -test-O-local: - @echo - @echo "Performing tests (optimized) for module directory ##MODULE##" - @perl ##COB85DIR##/report.pl -O - -lib: - @. ../../atconfig && . ../../atlocal NIST-##MODULE##_lib && $(MAKE) $@-local - -lib-local: - @echo "" - @if test -d lib; then \ - echo "Compiling libs for module directory ##MODULE##..."; \ - perl ##COB85DIR##/report.pl lib ; \ - fi - -$(TESTS): lib - @. ../../atconfig && . ../../atlocal NIST_$@ && $(MAKE) $@-local - -$(TESTS_LOCAL): lib-local - @echo "Running single test `echo $@ | sed -e 's|-.*||g'`" - @perl ##COB85DIR##/report.pl `echo $@ | sed -e 's|-.*||g'` 2>$@.log - @grep `echo $@ | sed -e 's|-.*||g'` ##COB85DIR##/##MODULE##.txt | diff - $@.log - @rm -rf $@.log - -clean: clean-db - $(RM) *.log *.out - -clean-db: - $(RM) __db.* diff -Nru gnucobol-4.0~early~20200606/tests/cobol85/NC.txt gnucobol-5/tests/cobol85/NC.txt --- gnucobol-4.0~early~20200606/tests/cobol85/NC.txt 2020-06-06 20:52:00.000000000 +0000 +++ gnucobol-5/tests/cobol85/NC.txt 1970-01-01 00:00:00.000000000 +0000 @@ -1,104 +0,0 @@ -Filename total pass fail deleted inspect --------- ----- ---- ---- ------- ------- -NC101A.CBL 93 93 0 0 0 OK -NC102A.CBL 42 42 0 0 0 OK -NC103A.CBL 102 102 0 0 0 OK -NC104A.CBL 141 141 0 0 0 OK -NC105A.CBL 132 129 0 3 0 OK -NC106A.CBL 126 126 0 0 0 OK -NC107A.CBL 177 177 0 0 0 OK -NC108M.CBL 14 14 0 0 0 OK -NC109M.CBL 11 11 0 0 0 OK -NC110M.CBL 1 1 0 0 0 OK -NC111A.CBL 7 7 0 0 0 OK -NC112A.CBL 32 32 0 0 0 OK -NC113M.CBL 15 15 0 0 0 OK -NC114M.CBL 6 5 0 0 1 OK -NC115A.CBL 31 31 0 0 0 OK -NC116A.CBL 66 66 0 0 0 OK -NC117A.CBL 40 40 0 0 0 OK -NC118A.CBL 29 29 0 0 0 OK -NC119A.CBL 36 36 0 0 0 OK -NC120A.CBL 39 39 0 0 0 OK -NC121M.CBL 41 41 0 0 0 OK -NC122A.CBL 24 24 0 0 0 OK -NC123A.CBL 34 34 0 0 0 OK -NC124A.CBL 169 169 0 0 0 OK -NC125A.CBL 110 110 0 0 0 OK -NC126A.CBL 145 145 0 0 0 OK -NC127A.CBL 2 2 0 0 0 OK -NC131A.CBL 10 10 0 0 0 OK -NC132A.CBL 25 25 0 0 0 OK -NC133A.CBL 25 25 0 0 0 OK -NC134A.CBL 20 20 0 0 0 OK -NC135A.CBL 8 8 0 0 0 OK -NC136A.CBL 8 8 0 0 0 OK -NC137A.CBL 8 8 0 0 0 OK -NC138A.CBL 36 36 0 0 0 OK -NC139A.CBL 41 41 0 0 0 OK -NC140A.CBL 70 70 0 0 0 OK -NC141A.CBL 9 9 0 0 0 OK -NC170A.CBL 96 96 0 0 0 OK -NC171A.CBL 108 108 0 0 0 OK -NC172A.CBL 101 101 0 0 0 OK -NC173A.CBL 102 102 0 0 0 OK -NC174A.CBL 77 77 0 0 0 OK -NC175A.CBL 97 97 0 0 0 OK -NC176A.CBL 124 124 0 0 0 OK -NC177A.CBL 108 108 0 0 0 OK -NC201A.CBL 59 59 0 0 0 OK -NC202A.CBL 77 77 0 0 0 OK -NC203A.CBL 57 57 0 0 0 OK -NC204M.CBL 15 15 0 0 0 OK -NC205A.CBL 10 10 0 0 0 OK -NC206A.CBL 53 53 0 0 0 OK -NC207A.CBL 85 85 0 0 0 OK -NC208A.CBL 24 24 0 0 0 OK -NC209A.CBL 32 32 0 0 0 OK -NC210A.CBL 85 85 0 0 0 OK -NC211A.CBL 51 51 0 0 0 OK -NC214M.CBL 1 1 0 0 0 OK -NC215A.CBL 7 7 0 0 0 OK -NC216A.CBL 57 57 0 0 0 OK -NC217A.CBL 82 82 0 0 0 OK -NC218A.CBL 125 125 0 0 0 OK -NC219A.CBL 9 9 0 0 0 OK -NC220M.CBL 25 25 0 0 0 OK -NC221A.CBL 17 17 0 0 0 OK -NC222A.CBL 8 8 0 0 0 OK -NC223A.CBL 94 94 0 0 0 OK -NC224A.CBL 14 14 0 0 0 OK -NC225A.CBL 63 63 0 0 0 OK -NC231A.CBL 24 24 0 0 0 OK -NC232A.CBL 17 17 0 0 0 OK -NC233A.CBL 14 14 0 0 0 OK -NC234A.CBL 17 17 0 0 0 OK -NC235A.CBL 13 13 0 0 0 OK -NC236A.CBL 10 10 0 0 0 OK -NC237A.CBL 13 13 0 0 0 OK -NC238A.CBL 10 10 0 0 0 OK -NC239A.CBL 8 8 0 0 0 OK -NC240A.CBL 11 11 0 0 0 OK -NC241A.CBL 11 11 0 0 0 OK -NC242A.CBL 12 12 0 0 0 OK -NC243A.CBL 16 16 0 0 0 OK -NC244A.CBL 6 6 0 0 0 OK -NC245A.CBL 28 28 0 0 0 OK -NC246A.CBL 49 49 0 0 0 OK -NC247A.CBL 21 20 0 1 0 OK -NC248A.CBL 11 11 0 0 0 OK -NC250A.CBL 115 115 0 0 0 OK -NC251A.CBL 59 59 0 0 0 OK -NC252A.CBL 75 75 0 0 0 OK -NC253A.CBL 61 61 0 0 0 OK -NC254A.CBL 9 9 0 0 0 OK -NC302M.CBL 0 0 0 0 0 OK -NC303M.CBL 0 0 0 0 0 OK -NC401M.CBL 0 0 0 0 0 OK --------- ----- ---- ---- ------- ------- -Total 4398 4393 0 4 1 - -Number of programs: 95 -Successfully executed: 95 -Compile error: 0 -Execute error: 0 diff -Nru gnucobol-4.0~early~20200606/tests/cobol85/OB.txt gnucobol-5/tests/cobol85/OB.txt --- gnucobol-4.0~early~20200606/tests/cobol85/OB.txt 2020-06-06 20:52:00.000000000 +0000 +++ gnucobol-5/tests/cobol85/OB.txt 1970-01-01 00:00:00.000000000 +0000 @@ -1,16 +0,0 @@ -Filename total pass fail deleted inspect --------- ----- ---- ---- ------- ------- -OBIC1A.CBL 1 1 0 0 0 OK -OBNC1M.CBL 6 6 0 0 0 OK -OBNC2M.CBL 16 16 0 0 0 OK -OBSQ1A.CBL 6 6 0 0 0 OK -OBSQ3A.CBL 1 1 0 0 0 OK -OBSQ4A.SUB 4 4 0 0 0 OK -OBSQ5A.SUB 5 5 0 0 0 OK --------- ----- ---- ---- ------- ------- -Total 39 39 0 0 0 - -Number of programs: 7 -Successfully executed: 7 -Compile error: 0 -Execute error: 0 diff -Nru gnucobol-4.0~early~20200606/tests/cobol85/README gnucobol-5/tests/cobol85/README --- gnucobol-4.0~early~20200606/tests/cobol85/README 2020-06-06 20:52:00.000000000 +0000 +++ gnucobol-5/tests/cobol85/README 1970-01-01 00:00:00.000000000 +0000 @@ -1,92 +0,0 @@ -How to run the NIST CCVS85 (aka. ANSI85) Test Suite -===================================== - -*NOTE* It is expected that WARNING messages appear when running the test. - -*NOTE* The language interpreter "perl" is required to run these tests. - -The final command of the the test is a diff between expected results and -actual results, i.e. "diff summary.txt summary.log". -If there is any output from this command, please tar and compress the -complete cobol85 directory and report this to the GnuCOBOL mailing list. -You will receive further instructions where to send this. - -*NOTE* This test can take a long time depending on your hardware. - -1. Prerequisite: test suite "newcob.val", EITHER - - Automatic download/uncompress - If the test suite is not available "make test" will uncompress the archive - "newcob.val.Z" from tests/cobol85. - If the test archive is also missing "make test" will try to download the - archive beforehand. -OR- - Manually download the test archive "newcob.val.Z" from - http://www.itl.nist.gov/div897/ctg/cobol_form.htm - - Uncompress it and move the file newcob.val to the tests/cobol85 directory - -2. Run the test suite: - make test - *or* run it in parallel (providing a big speedup) - make -j4 test - this tests up to 4 modules in parallel, you may adjust the number "4" - depending on the amount of available resources - make test-local - perform the tests with the GnuCOBOL version that is available in the - local context instead of the version in the local build tree - -3. Test report summary will be put in summary.log. - -4. When rerunning the tests as a result of a change, always do a "make clean" - *before* "make test" - -5. The default tests configured for GnuCOBOL are: - NC SM IC SQ RL IX ST SG OB IF RW DB - Note: IX will be skipped if ISAM access was disabled during configure and - only a subset of DB (internally DBNOIX) will be run. - -Make Options ------------- - -- make NC (or any other module instead of NC) generate COBOL test runner - EXEC85 and extract tests for the given module -- make modules generate EXEC85 and extract COBOL tests for all modules -- make test run the test suite with the configured modules - (after implied make MODULE) -- make diff compare the expected results (*.txt) to the last reports -- make clean remove built files - -In each of the module directories you may run: -- make test perform the tests for this module (results in new report.txt) -- make test-O perform the tests for this module with compiler optimizations - enabled (needs more time, no differences expected to "test") -- make test-local perform the tests in local context (see above) -- make diff compare the expected results (../MODULE.txt) to the last report -- make TESTnnn compile and run a specific test, compare expected results -- make TESTnnn-local compile and run a specific test in local context, - (see above), compare expected results - -Test Modules ------------- - -Core tests: - - NC - COBOL nucleus tests - SM - COPY sentence tests - IC - CALL sentence tests - -File I-O tests: - - SQ - Sequential file I-O tests - RL - Relative file I-O tests - IX - Indexed file I-O tests - ST - SORT sentence tests - -Advanced facilities: - - RW - REPORT SECTION tests - CM - COMMUNICATION SECTION tests - IF - Intrinsic Function tests - SG - Segment tests - DB - Debugging facilities tests - OB - Obsolete facilities tests diff -Nru gnucobol-4.0~early~20200606/tests/cobol85/report.pl gnucobol-5/tests/cobol85/report.pl --- gnucobol-4.0~early~20200606/tests/cobol85/report.pl 2020-06-06 20:52:00.000000000 +0000 +++ gnucobol-5/tests/cobol85/report.pl 1970-01-01 00:00:00.000000000 +0000 @@ -1,576 +0,0 @@ -# -# gnucobol/tests/cobol85/report.pl -# -# Copyright (C) 2001-2012, 2016-2019 Free Software Foundation, Inc. -# Written by Keisuke Nishida, Roger While, Simon Sobisch, Edward Hart -# -# This file is part of GnuCOBOL. -# -# The GnuCOBOL compiler is free software: you can redistribute it -# and/or modify it under the terms of the GNU General Public License -# as published by the Free Software Foundation, either version 3 of the -# License, or (at your option) any later version. -# -# GnuCOBOL is distributed in the hope that it will be useful, -# but WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -# GNU General Public License for more details. -# -# You should have received a copy of the GNU General Public License -# along with GnuCOBOL. If not, see . - -use strict; -use warnings; - -$SIG{INT} = sub { die "\nInterrupted\n" }; -$SIG{QUIT} = sub { die "\nInterrupted\n" }; -$SIG{PIPE} = sub { die "\nInterrupted\n" }; -$SIG{TERM} = sub { die "\nInterrupted\n" }; - -my $opt = shift; - -my $compile; -my $compile_module; - -# change to 1 if executable doesn't work / cobcrun test should be done -my $force_cobcrun = 0; - -my $cobc = $ENV{"COBC"}; -my $cobcrun = $ENV{"COBCRUN"}; -my $cobcrun_direct = $ENV{"COBCRUN_DIRECT"}; - -my $single_test; -if (defined $opt) { - my $test = substr $opt, 0, 1; - if ($test ne "-" && $test ne "/") { - $single_test = $opt; - $opt = shift; - } else { - $single_test = shift; - } -} - -if (defined $opt) { - $opt = "-std=cobol85 $opt" -} else { - $opt = "-std=cobol85" -} - -if (defined $cobc) { - $cobc = "$cobc $opt"; -} else { - $cobc = "cobc $opt"; -} - -if (!defined $cobcrun) { - $cobcrun = "cobcrun"; -} - -if (defined $cobcrun_direct) { - $cobcrun_direct = "$cobcrun_direct "; -} else { - $cobcrun_direct = ""; -} - -$compile_module = "$cobc -m"; -if ($force_cobcrun) { - $compile = $compile_module; -} else { - $compile = "$cobc -x"; -} - -my $REMOVE = "XXXXX*"; -my $TRAP; -my $REMOVE_COMMANDS; -if ($^O ne "MSWin32" && $^O ne "dos") { - $TRAP = "trap 'exit 77' INT QUIT TERM PIPE;"; - $REMOVE_COMMANDS = "$TRAP rm -rf $REMOVE"; - if ($ENV{'DB_HOME'} && $ENV{'DB_HOME'} ne ".") { - $REMOVE_COMMANDS = "$REMOVE_COMMANDS $ENV{'DB_HOME'}/$REMOVE"; - } - $cobcrun_direct = "$cobcrun_direct./"; -} else { - $TRAP = ""; - $REMOVE_COMMANDS = "ERASE /F /Q $REMOVE &&"; - if ($ENV{'DB_HOME'} && $ENV{'DB_HOME'} ne ".") { - $REMOVE_COMMANDS = "$REMOVE_COMMANDS $ENV{'DB_HOME'}\\$REMOVE &&"; - } - $REMOVE_COMMANDS = "$REMOVE_COMMANDS " . - "FOR /F %I IN ('DIR /A:D /B $REMOVE') DO RD /S /Q %I"; - $REMOVE_COMMANDS = "$REMOVE_COMMANDS 1>NUL 2>&1"; - $cobcrun_direct = "$cobcrun_direct.\\"; -} - -# for obsolete systems use duration in seconds, otherwise get nanos from system -# (the better Time::HiRes is only a core module since Perl 5.7.3) -sub time_since_epoch { - if ($^O ne "MSWin32" && $^O ne "dos") { - return `date +%s.%N`; - } else { - return time; - } -} -# temporary directory (used for fifos, currently not active) -# my $tmpdir = $ENV{"TMPDIR"}; -# if (!defined $tmpdir) { -# $tmpdir = $ENV{"TEMP"}; -# if (!defined $tmpdir) { -# $tmpdir = $ENV{"TMP"}; -# if (!defined $tmpdir) { -# $tmpdir = "/tmp"; -# } -# } -# } - -my $num_progs = 0; -my $test_skipped = 0; -my $compile_error = 0; -my $execute_error = 0; - -my $total_all = 0; -my $total_pass = 0; -my $total_fail = 0; -my $total_deleted = 0; -my $total_inspect = 0; -my $total_ok = 0; -my $ret = 0; -my $db103m = 0; - -$ENV{"COB_SWITCH_1"} = "ON"; -$ENV{"COB_SWITCH_2"} = "OFF"; - -$ENV{"COB_DISABLE_WARNINGS"} = "Y"; - -# DB103M should be executed twice with differing -# runtime DEBUG switch. -# Dealt with lower down in the code - -# Skip DB203A if no ISAM configured -my %skip; -if (defined $ENV{'COB_HAS_ISAM'} && $ENV{'COB_HAS_ISAM'} eq "no") { - $skip{DB203A} = 1; -} - -# OBNC1M tests the STOP literal statement and requires user input with a final kill. -my %raw_input; -$raw_input{OBNC1M} = "\n\n\n\n\n\n\n\n\003"; # 8 newlines + kill character -my %to_kill; -$to_kill{OBNC1M} = 1; - -# NC114M test the compiler listing along to other parts. -my %cobc_flags; -$cobc_flags{NC114M} = "-t NC114M.lst"; - -# NC302M tests the compiler flagging of obsolete features, including STOP literal. -$cobc_flags{NC302M} = "-Wobsolete"; -$raw_input{NC302M} = "\n"; - -# DB304M tests the compiler flagging of obsolete features -$cobc_flags{DB304M} = "-Wobsolete"; - -# Compile only programs - -# The following tests are for compiler flagging and cannot run without abends. -# TO-DO: automatically check cobc emits the right number of warnings with -# -Wobsolete (ignore high subset checking). -my %comp_only; -$comp_only{NC401M} = 1; -$comp_only{RL301M} = 1; -$comp_only{RL401M} = 1; -$comp_only{IC401M} = 1; -$comp_only{IX301M} = 1; -$comp_only{IX401M} = 1; -$comp_only{SQ303M} = 1; -$comp_only{SQ401M} = 1; -$comp_only{ST301M} = 1; -$comp_only{RW301M} = 1; -$comp_only{RW302M} = 1; - -# Until RECEIVE is implemented, DB205A contains an infinite loop. -$comp_only{DB205A} = 1; - -# Programs that do not produce any meaningful test results -# However they must execute successfully -my %no_output; -$no_output{NC110M} = 1; -$no_output{NC214M} = 1; -$no_output{OBSQ3A} = 1; -$no_output{ST102A} = 1; -$no_output{ST109A} = 1; -$no_output{ST110A} = 1; -$no_output{ST112M} = 1; -$no_output{ST113M} = 1; -$no_output{ST115A} = 1; -$no_output{ST116A} = 1; -$no_output{ST120A} = 1; -$no_output{ST122A} = 1; -$no_output{ST123A} = 1; -$no_output{DB301M} = 1; -$no_output{DB302M} = 1; -$no_output{DB303M} = 1; -$no_output{DB305M} = 1; -$no_output{IF402M} = 1; - -$cobc_flags{SM206A} = "-fdebugging-line"; - -# Programs that won't run correctly with enabled runtime checks -# TODO for later: only deactivate specific checks by -fno-ec-... -my %no_debug; -$no_debug{DB101A} = 1; -$no_debug{DB104A} = 1; -$no_debug{DB201A} = 1; -$no_debug{DB202A} = 1; -$no_debug{DB203A} = 1; -$no_debug{DB204A} = 1; - -# Programs that need to be "visual" inspected -# NC113M: inspected additional to normal tests for output of hex values -# SQ101M, SQ201M, SQ207M, SQ208M, SQ209M, SQ210M: send report.log to printer and check result -# - -if (!defined $single_test) { - open (LOG_FH, "> report.txt") or die; - print LOG_FH "Filename total pass fail deleted inspect\n"; - print LOG_FH "-------- ----- ---- ---- ------- -------\n"; - open (LOG_TIME, "> duration.txt") or die; - print LOG_TIME "Filename Duration\n"; - print LOG_TIME "-------- --------\n"; -} else { - *LOG_FH = *STDERR; -} -my $global_start = time_since_epoch (); - -my $in; - -if (defined $single_test) { - if ($single_test ne "lib") { - run_test ("$single_test.CBL"); - } else { - foreach $in (glob("lib/*.CBL")) { - compile_lib ($in); - } - } - exit; -} else { - foreach $in (glob("lib/*.CBL")) { - compile_lib ($in); - } -} - -foreach $in (sort (glob("*.{CBL,SUB}"))) { - run_test ($in); -} -my $global_end = time_since_epoch (); - -print LOG_FH ("-------- ----- ---- ---- ------- -------\n"); -printf LOG_FH ("Total %5s %4s %4s %7s %7s\n\n", - $total_all, $total_pass, $total_fail, $total_deleted, - $total_inspect); - -printf LOG_FH ("Number of programs: %2s\n", $num_progs); -printf LOG_FH ("Successfully executed: %2s\n", $total_ok); -printf LOG_FH ("Compile error: %2s\n", $compile_error); -printf LOG_FH ("Execute error: %2s\n", $execute_error); - -print LOG_TIME "-------- --------\n"; -printf LOG_TIME ("Total %8.4f\n\n", ($global_end - $global_start)); - -sub compile_lib { - my $in = $_[0]; - print "$compile_module $in\n"; - my $local_start = time_since_epoch (); - $ret = system ("$TRAP $compile_module $in"); - if ($ret != 0) { - if (($ret >> 8) == 77) { - die "Interrupted\n"; - } - print "Unexpected status $ret for module $in\n"; - } - my $local_end = time_since_epoch (); - printf LOG_TIME ("%-11s %8.4f\n", (substr $in, 4), ($local_end - $local_start)); -} - -sub run_test { - my $in = $_[0]; - my $exe = $in; - my $cmd; - my $subt; - - $exe =~ s/\.CBL//; - $exe =~ s/\.SUB//; - - my $line_prefix = sprintf("%-11s", $in); - if ($skip{$exe}) { - $test_skipped++; - print LOG_FH ("$line_prefix ----- test skipped -----\n"); - return; - } - - if (-e "./$exe.DAT") { - if ($force_cobcrun) { - $cmd = "$cobcrun $exe < $exe.DAT"; - } else { - $cmd = "$cobcrun_direct$exe < $exe.DAT"; - } - } else { - if ($force_cobcrun) { - $cmd = "$cobcrun $exe"; - } else { - $cmd = "$cobcrun_direct$exe"; - } - } - - $num_progs++; - my $compile_current = $compile; - if ($cobc_flags{$exe}) { - $compile_current = "$compile_current $cobc_flags{$exe}"; - } - if ($exe =~ /^SM/) { - $compile_current = "$compile_current -I ../copy"; - } - if (!$no_debug{$exe}) { - $compile_current = "$compile_current -debug"; - } - $compile_current = "$compile_current $in"; - if ($comp_only{$exe}) { - print "$compile_current\n"; - } else { - print "$compile_current && $cmd\n"; - } - $compile_current = "$compile_current 1> $exe.cobc.out 2>&1"; - - my $total = 0; - my $pass = 0; - my $fail = 0; - my $deleted = 0; - my $inspect = 0; - - my $local_start = time_since_epoch (); - $ret = system ("$TRAP $compile_current"); - if ($ret != 0) { - if (($ret >> 8) == 77) { - die "Interrupted\n"; - } - $compile_error++; - print LOG_FH ("$line_prefix ***** compile error *****\n"); - my $local_end = time_since_epoch (); - printf LOG_TIME ("%-11s %8.4f\n", $in, ($local_end - $local_start)); - return; - } - - # Some programs need to be checked for compiler warnings - #if ($exe eq "NC302M" || $exe eq "DB304M") { - # $total = 7; --> TODO: get amount from test source - # open (my $COBC_OUT, '<', "$exe.cobc.out"); - # while (<$COBC_OUT>) { - # if - # if (/ warning: ([A-Z-]+) .* obsolete /) { - # $pass += 1; - # return; - # } - # } - #} - - unlink "$exe.cobc.out" if (-s "$exe.cobc.out" == 0); - - if ($comp_only{$exe}) { - print LOG_FH ("$line_prefix 0 0 0 0 0 OK\n"); - $total_ok++; - my $local_end = time_since_epoch (); - printf LOG_TIME ("%-11s %8.4f\n", $in, ($local_end - $local_start)); - return; - } - - - if ($in =~ /\.CBL/) { - $ret = system ("$REMOVE_COMMANDS"); - if (($ret >> 8) == 77) { - die "Interrupted\n"; - } - } - - $subt = substr($exe, 0, 2); - if ($exe eq "DB102A") { - $ENV{"COB_SET_DEBUG"} = "N"; - } elsif ($subt eq "DB") { - $ENV{"COB_SET_DEBUG"} = "Y"; - } else { - $ENV{"COB_SET_DEBUG"} = "N"; - } - if ($subt eq "RW") { - $ENV{"DD_XXXXX049"} = "$exe.rep"; - } - $ENV{"REPORT"} = "$exe.log"; - if ($raw_input{$exe}) { - $cmd = "$cmd < $exe.inp"; - system ("echo \"$raw_input{$exe}\" > $exe.inp"); - } - -testrepeat: - if (!$to_kill{$exe}) { - $ret = system ("$TRAP $cmd > $exe.out"); - } else { - $ret = system ("$TRAP $cmd > $exe.out 2>/dev/null"); - } - - if ($ret != 0 && !($ret >> 2 && $to_kill{$exe})) { - if (($ret >> 8) == 77) { - die "Interrupted\n"; - } - $execute_error++; - my $local_end = time_since_epoch (); - printf LOG_TIME ("%-11s %8.4f\n", $in, ($local_end - $local_start)); - print LOG_FH ("$line_prefix ***** execute error $ret *****\n"); - return; - } - if ($no_output{$exe}) { - $total = 1; - $pass = 1; - } elsif (open (my $PRT, '<', $ENV{"REPORT"})) { - - # NC107A: check hex values in report - if ($exe eq "NC107A") { - binmode($PRT); - while (<$PRT>) { - if (/^ *([0-9]+) *OF *([0-9]+) *TESTS WERE/) { - $total += $2; - $pass += $1; - } elsif (/^ *([0-9NO]+) *TEST\(S\) ([A-Z]+)/) { - my $num = $1 eq "NO" ? 0 : $1; - if ($2 eq "FAILED") { - $fail += $num; - } elsif ($2 eq "DELETED") { - $deleted += $num; - } - } elsif (/^\*\*\* INFORMATION \*\*\* (.{20}) ([A-Z-]+) /) { - if (("$2" eq "ZERO" && "$1" eq " 000000000000000000 ") - || ("$2" eq "SPACE" && "$1" eq " ") - || ("$2" eq "QUOTE" && "$1" eq "\"\"\"\"\"\"\"\"\"\"\"\"\"\"\"\"\"\"\"\"") - || ("$2" eq "HIGH-VALUE" && "$1" eq "\377\377\377\377\377\377\377\377\377\377\377\377\377\377\377\377\377\377\377\377") - || ("$2" eq "LOW-VALUE" && "$1" eq "\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000") ) { - $pass += 1; - } else { - $fail += 1; - } - } - } - - # NC113M needs to be "visual" inspected for tests being sequential - } elsif ($exe eq "NC113M") { - my $seqcount = 0; - while (<$PRT>) { - if (/^ MARGIN TESTING *MAR-TEST-([0-9]+) /) { - $seqcount += 1; - if ($seqcount eq $1) { - $pass += 1; - } else { - $fail += 1; - $seqcount = $1; - } - } elsif (/^ *([0-9]+) *TESTS REQUIRE VISUAL INSPECTION/) { - $total += $1; - } - } - - # NC114M TODO: check the listing, removing the "inspect" entries - - # NC121M/NC220M: needs to be inspected for identical display output - } elsif ($exe eq "NC121M" || $exe eq "NC220M") { - my $line = my $line2 =""; - if (open (my $fh, '<', "$exe.out")) { - <$fh>; - $line = <$fh>; - $line2 = <$fh>; - } - while (<$PRT>) { - if (/^ *([0-9]+) *OF *([0-9]+) *TESTS WERE/) { - $total += $2; - $pass += $1; - } elsif (/^ *([0-9NO]+) *TEST\(S\) ([A-Z]+)/) { - my $num = $1 eq "NO" ? 0 : $1; - if ($2 eq "FAILED") { - $fail += $num; - } elsif ($2 eq "DELETED") { - $deleted += $num; - } - } elsif (/^\*\*\* INFORMATION \*\*\* *([0-9A-Z-]+) /) { - chomp $line; - if ($line eq $1) { - $pass += 1; - } else { - $fail += 1; - } - $line = $line2; - } - } - - # NC135A: needs to be inspected for table output - } elsif ($exe eq "NC135A") { - my $seqcount = 0; - while (<$PRT>) { - if (/^ *([0-9]+) *OF *([0-9]+) *TESTS WERE/) { - $total += $2; - $pass += $1; - } elsif (/^ *([0-9NO]+) *TEST\(S\) ([A-Z]+)/) { - my $num = $1 eq "NO" ? 0 : $1; - if ($2 eq "FAILED") { - $fail += $num; - } elsif ($2 eq "DELETED") { - $deleted += $num; - } - } elsif (/^ (\d+ )+/) { - while ($_ =~ /(\d+) /g) { - $seqcount += 1; - if ($seqcount != $1) { - $fail += 1; - last; - } - if ($seqcount == 300) { - $pass += 1; - } - } - } - } - - # normal test procedure - } else { - while (<$PRT>) { - if (/^ *([0-9]+) *OF *([0-9]+) *TESTS WERE/) { - $total += $2; - $pass += $1; - } elsif (/^ *([0-9NO]+) *TEST\(S\) ([A-Z]+)/) { - my $num = $1 eq "NO" ? 0 : $1; - if ($2 eq "FAILED") { - $fail += $num; - } elsif ($2 eq "DELETED") { - $deleted += $num; - } elsif ($2 eq "REQUIRE") { - $inspect += $num; - } - } elsif (/^ *([0-9]+) *TESTS REQUIRE VISUAL INSPECTION/) { - $total += $1; - $inspect += $1; - } - } - } - } - printf LOG_FH ("$line_prefix %5s %4s %4s %7s %7s %s\n", - $total, $pass, $fail, $deleted, $inspect, - $fail == 0 ? "OK" : ""); - $total_all += $total; - $total_pass += $pass; - $total_fail += $fail; - $total_deleted += $deleted; - $total_inspect += $inspect; - $total_ok++ if $fail == 0; - if ($exe eq "DB103M" && $db103m == 0) { - $db103m = 1; - $ENV{"COB_SET_DEBUG"} = "N"; - $num_progs++; - print "Reexecution with runtime DEBUG off ./DB103M\n"; - goto testrepeat; - } - my $local_end = time_since_epoch (); - printf LOG_TIME ("%-11s %8.4f\n", $in, ($local_end - $local_start)); - unlink "$exe.out" if (-s "$exe.out" == 0); -} diff -Nru gnucobol-4.0~early~20200606/tests/cobol85/RL.txt gnucobol-5/tests/cobol85/RL.txt --- gnucobol-4.0~early~20200606/tests/cobol85/RL.txt 2020-06-06 20:52:00.000000000 +0000 +++ gnucobol-5/tests/cobol85/RL.txt 1970-01-01 00:00:00.000000000 +0000 @@ -1,44 +0,0 @@ -Filename total pass fail deleted inspect --------- ----- ---- ---- ------- ------- -RL101A.CBL 1 1 0 0 0 OK -RL102A.SUB 11 11 0 0 0 OK -RL103A.SUB 11 11 0 0 0 OK -RL104A.CBL 12 12 0 0 0 OK -RL105A.CBL 4 4 0 0 0 OK -RL106A.CBL 4 4 0 0 0 OK -RL107A.CBL 19 19 0 0 0 OK -RL108A.CBL 1 1 0 0 0 OK -RL109A.SUB 11 11 0 0 0 OK -RL110A.SUB 10 10 0 0 0 OK -RL111A.CBL 24 24 0 0 0 OK -RL112A.CBL 12 12 0 0 0 OK -RL113A.CBL 11 11 0 0 0 OK -RL114A.CBL 13 13 0 0 0 OK -RL115A.CBL 13 13 0 0 0 OK -RL116A.CBL 3 3 0 0 0 OK -RL117A.CBL 8 6 0 2 0 OK -RL118A.CBL 4 2 0 2 0 OK -RL119A.CBL 1 1 0 0 0 OK -RL201A.CBL 1 1 0 0 0 OK -RL202A.SUB 11 11 0 0 0 OK -RL203A.SUB 11 11 0 0 0 OK -RL204A.CBL 12 12 0 0 0 OK -RL205A.CBL 67 66 0 1 0 OK -RL206A.CBL 501 501 0 0 0 OK -RL207A.SUB 20 20 0 0 0 OK -RL208A.SUB 11 11 0 0 0 OK -RL209A.CBL 1 1 0 0 0 OK -RL210A.CBL 1 1 0 0 0 OK -RL211A.CBL 501 501 0 0 0 OK -RL212A.CBL 1 1 0 0 0 OK -RL213A.SUB 521 521 0 0 0 OK -RL301M.CBL 0 0 0 0 0 OK -RL302M.CBL 0 0 0 0 0 OK -RL401M.CBL 0 0 0 0 0 OK --------- ----- ---- ---- ------- ------- -Total 1832 1827 0 5 0 - -Number of programs: 35 -Successfully executed: 35 -Compile error: 0 -Execute error: 0 diff -Nru gnucobol-4.0~early~20200606/tests/cobol85/RW.txt gnucobol-5/tests/cobol85/RW.txt --- gnucobol-4.0~early~20200606/tests/cobol85/RW.txt 2020-06-06 20:52:00.000000000 +0000 +++ gnucobol-5/tests/cobol85/RW.txt 1970-01-01 00:00:00.000000000 +0000 @@ -1,15 +0,0 @@ -Filename total pass fail deleted inspect --------- ----- ---- ---- ------- ------- -RW101A.CBL 8 8 0 0 0 OK -RW102A.CBL 4 4 0 0 0 OK -RW103A.CBL 14 14 0 0 0 OK -RW104A.CBL 14 14 0 0 0 OK -RW301M.CBL 0 0 0 0 0 OK -RW302M.CBL 0 0 0 0 0 OK --------- ----- ---- ---- ------- ------- -Total 40 40 0 0 0 - -Number of programs: 6 -Successfully executed: 6 -Compile error: 0 -Execute error: 0 diff -Nru gnucobol-4.0~early~20200606/tests/cobol85/SG.txt gnucobol-5/tests/cobol85/SG.txt --- gnucobol-4.0~early~20200606/tests/cobol85/SG.txt 2020-06-06 20:52:00.000000000 +0000 +++ gnucobol-5/tests/cobol85/SG.txt 1970-01-01 00:00:00.000000000 +0000 @@ -1,22 +0,0 @@ -Filename total pass fail deleted inspect --------- ----- ---- ---- ------- ------- -SG101A.CBL 151 151 0 0 0 OK -SG102A.CBL 8 8 0 0 0 OK -SG103A.CBL 7 7 0 0 0 OK -SG104A.CBL 9 9 0 0 0 OK -SG105A.CBL 9 9 0 0 0 OK -SG106A.CBL 9 9 0 0 0 OK -SG201A.CBL 79 79 0 0 0 OK -SG202A.CBL 5 5 0 0 0 OK -SG203A.CBL 18 18 0 0 0 OK -SG204A.CBL 15 15 0 0 0 OK -SG302M.CBL 0 0 0 0 0 OK -SG303M.CBL 0 0 0 0 0 OK -SG401M.CBL 0 0 0 0 0 OK --------- ----- ---- ---- ------- ------- -Total 310 310 0 0 0 - -Number of programs: 13 -Successfully executed: 13 -Compile error: 0 -Execute error: 0 diff -Nru gnucobol-4.0~early~20200606/tests/cobol85/SM.txt gnucobol-5/tests/cobol85/SM.txt --- gnucobol-4.0~early~20200606/tests/cobol85/SM.txt 2020-06-06 20:52:00.000000000 +0000 +++ gnucobol-5/tests/cobol85/SM.txt 1970-01-01 00:00:00.000000000 +0000 @@ -1,26 +0,0 @@ -Filename total pass fail deleted inspect --------- ----- ---- ---- ------- ------- -SM101A.CBL 8 8 0 0 0 OK -SM102A.SUB 4 4 0 0 0 OK -SM103A.CBL 6 6 0 0 0 OK -SM104A.SUB 7 7 0 0 0 OK -SM105A.CBL 9 9 0 0 0 OK -SM106A.CBL 1 0 0 0 1 OK -SM107A.CBL 200 200 0 0 0 OK -SM201A.CBL 11 11 0 0 0 OK -SM202A.SUB 7 7 0 0 0 OK -SM203A.CBL 1 1 0 0 0 OK -SM204A.SUB 4 4 0 0 0 OK -SM205A.CBL 9 9 0 0 0 OK -SM206A.CBL 16 14 0 2 0 OK -SM207A.CBL 2 2 0 0 0 OK -SM208A.CBL 9 9 0 0 0 OK -SM301M.CBL 0 0 0 0 0 OK -SM401M.CBL 0 0 0 0 0 OK --------- ----- ---- ---- ------- ------- -Total 294 291 0 2 1 - -Number of programs: 17 -Successfully executed: 17 -Compile error: 0 -Execute error: 0 diff -Nru gnucobol-4.0~early~20200606/tests/cobol85/SQ.txt gnucobol-5/tests/cobol85/SQ.txt --- gnucobol-4.0~early~20200606/tests/cobol85/SQ.txt 2020-06-06 20:52:00.000000000 +0000 +++ gnucobol-5/tests/cobol85/SQ.txt 1970-01-01 00:00:00.000000000 +0000 @@ -1,94 +0,0 @@ -Filename total pass fail deleted inspect --------- ----- ---- ---- ------- ------- -SQ101M.CBL 57 0 0 0 57 OK -SQ102A.CBL 11 11 0 0 0 OK -SQ103A.CBL 30 30 0 0 0 OK -SQ104A.CBL 11 11 0 0 0 OK -SQ105A.CBL 22 22 0 0 0 OK -SQ106A.CBL 75 75 0 0 0 OK -SQ107A.CBL 6 6 0 0 0 OK -SQ108A.CBL 8 8 0 0 0 OK -SQ109M.CBL 6 6 0 0 0 OK -SQ110M.CBL 6 6 0 0 0 OK -SQ111A.CBL 1 1 0 0 0 OK -SQ112A.CBL 7 7 0 0 0 OK -SQ113A.CBL 22 22 0 0 0 OK -SQ114A.CBL 15 15 0 0 0 OK -SQ115A.CBL 3 3 0 0 0 OK -SQ116A.CBL 10 10 0 0 0 OK -SQ117A.CBL 8 8 0 0 0 OK -SQ121A.CBL 3 3 0 0 0 OK -SQ122A.CBL 7 7 0 0 0 OK -SQ123A.CBL 9 9 0 0 0 OK -SQ124A.CBL 19 19 0 0 0 OK -SQ125A.CBL 2 2 0 0 0 OK -SQ126A.CBL 7 7 0 0 0 OK -SQ127A.CBL 6 6 0 0 0 OK -SQ128A.CBL 9 9 0 0 0 OK -SQ129A.CBL 1 1 0 0 0 OK -SQ130A.CBL 1 1 0 0 0 OK -SQ131A.CBL 2 2 0 0 0 OK -SQ132A.CBL 1 1 0 0 0 OK -SQ133A.CBL 15 15 0 0 0 OK -SQ134A.CBL 15 15 0 0 0 OK -SQ135A.CBL 1 1 0 0 0 OK -SQ136A.CBL 1 1 0 0 0 OK -SQ137A.CBL 1 1 0 0 0 OK -SQ138A.CBL 1 1 0 0 0 OK -SQ139A.CBL 1 1 0 0 0 OK -SQ140A.CBL 1 1 0 0 0 OK -SQ141A.CBL 1 1 0 0 0 OK -SQ142A.CBL 1 1 0 0 0 OK -SQ143A.CBL 1 1 0 0 0 OK -SQ144A.CBL 1 1 0 0 0 OK -SQ146A.CBL 1 1 0 0 0 OK -SQ147A.CBL 1 1 0 0 0 OK -SQ148A.CBL 2 2 0 0 0 OK -SQ149A.CBL 1 1 0 0 0 OK -SQ150A.CBL 1 1 0 0 0 OK -SQ151A.CBL 1 1 0 0 0 OK -SQ152A.CBL 1 1 0 0 0 OK -SQ153A.CBL 1 1 0 0 0 OK -SQ154A.CBL 1 1 0 0 0 OK -SQ155A.CBL 1 1 0 0 0 OK -SQ156A.CBL 1 1 0 0 0 OK -SQ201M.CBL 23 12 0 0 11 OK -SQ202A.CBL 1 1 0 0 0 OK -SQ203A.SUB 4 4 0 0 0 OK -SQ204A.CBL 2 2 0 0 0 OK -SQ205A.CBL 2 2 0 0 0 OK -SQ206A.CBL 4 4 0 0 0 OK -SQ207M.CBL 8 0 0 0 8 OK -SQ208M.CBL 7 0 0 0 7 OK -SQ209M.CBL 3 0 0 0 3 OK -SQ210M.CBL 3 0 0 0 3 OK -SQ211A.CBL 4 4 0 0 0 OK -SQ212A.CBL 1 1 0 0 0 OK -SQ213A.CBL 7 7 0 0 0 OK -SQ214A.CBL 5 5 0 0 0 OK -SQ215A.CBL 4 4 0 0 0 OK -SQ216A.CBL 7 7 0 0 0 OK -SQ217A.CBL 7 7 0 0 0 OK -SQ218A.CBL 6 6 0 0 0 OK -SQ219A.CBL 6 6 0 0 0 OK -SQ220A.CBL 6 6 0 0 0 OK -SQ221A.CBL 6 6 0 0 0 OK -SQ222A.CBL 6 6 0 0 0 OK -SQ223A.CBL 6 6 0 0 0 OK -SQ224A.CBL 3 3 0 0 0 OK -SQ225A.CBL 3 3 0 0 0 OK -SQ226A.CBL 37 37 0 0 0 OK -SQ227A.CBL 16 16 0 0 0 OK -SQ228A.CBL 1 1 0 0 0 OK -SQ229A.CBL 1 1 0 0 0 OK -SQ230A.CBL 1 1 0 0 0 OK -SQ302M.CBL 0 0 0 0 0 OK -SQ303M.CBL 0 0 0 0 0 OK -SQ401M.CBL 0 0 0 0 0 OK --------- ----- ---- ---- ------- ------- -Total 607 518 0 0 89 - -Number of programs: 85 -Successfully executed: 85 -Compile error: 0 -Execute error: 0 diff -Nru gnucobol-4.0~early~20200606/tests/cobol85/ST.txt gnucobol-5/tests/cobol85/ST.txt --- gnucobol-4.0~early~20200606/tests/cobol85/ST.txt 2020-06-06 20:52:00.000000000 +0000 +++ gnucobol-5/tests/cobol85/ST.txt 1970-01-01 00:00:00.000000000 +0000 @@ -1,49 +0,0 @@ -Filename total pass fail deleted inspect --------- ----- ---- ---- ------- ------- -ST101A.CBL 9 9 0 0 0 OK -ST102A.SUB 1 1 0 0 0 OK -ST103A.SUB 9 9 0 0 0 OK -ST104A.CBL 1 1 0 0 0 OK -ST105A.SUB 2 2 0 0 0 OK -ST106A.CBL 1 1 0 0 0 OK -ST107A.SUB 6 6 0 0 0 OK -ST108A.CBL 9 9 0 0 0 OK -ST109A.CBL 1 1 0 0 0 OK -ST110A.SUB 1 1 0 0 0 OK -ST111A.SUB 7 7 0 0 0 OK -ST112M.CBL 1 1 0 0 0 OK -ST113M.SUB 1 1 0 0 0 OK -ST114M.SUB 10 10 0 0 0 OK -ST115A.CBL 1 1 0 0 0 OK -ST116A.SUB 1 1 0 0 0 OK -ST117A.SUB 1 1 0 0 0 OK -ST118A.CBL 9 9 0 0 0 OK -ST119A.CBL 27 27 0 0 0 OK -ST120A.SUB 1 1 0 0 0 OK -ST121A.SUB 9 9 0 0 0 OK -ST122A.CBL 1 1 0 0 0 OK -ST123A.SUB 1 1 0 0 0 OK -ST124A.SUB 7 7 0 0 0 OK -ST125A.CBL 1 1 0 0 0 OK -ST126A.SUB 18 18 0 0 0 OK -ST127A.CBL 27 27 0 0 0 OK -ST131A.CBL 15 15 0 0 0 OK -ST132A.CBL 6 6 0 0 0 OK -ST133A.CBL 18 18 0 0 0 OK -ST134A.CBL 4 4 0 0 0 OK -ST135A.CBL 9 9 0 0 0 OK -ST136A.CBL 5 5 0 0 0 OK -ST137A.CBL 6 6 0 0 0 OK -ST139A.CBL 10 10 0 0 0 OK -ST140A.CBL 11 11 0 0 0 OK -ST144A.CBL 11 11 0 0 0 OK -ST146A.CBL 4 4 0 0 0 OK -ST147A.CBL 26 26 0 0 0 OK -ST301M.CBL 0 0 0 0 0 OK --------- ----- ---- ---- ------- ------- -Total 288 288 0 0 0 - -Number of programs: 40 -Successfully executed: 40 -Compile error: 0 -Execute error: 0 diff -Nru gnucobol-4.0~early~20200606/tests/cobol85/summarynoix.txt gnucobol-5/tests/cobol85/summarynoix.txt --- gnucobol-4.0~early~20200606/tests/cobol85/summarynoix.txt 2020-06-06 20:52:00.000000000 +0000 +++ gnucobol-5/tests/cobol85/summarynoix.txt 1970-01-01 00:00:00.000000000 +0000 @@ -1,16 +0,0 @@ ------- Directory Information ------- --- Total Tests Information --- -Module Programs Executed Error Crash Pass Fail Deleted Inspect Total ------- -------- -------- ----- ----- ----- ---- ------- ------- ----- -NC 95 95 0 0 4393 0 4 1 4398 -SM 17 17 0 0 291 0 2 1 294 -IC 25 25 0 0 246 0 4 0 250 -SQ 85 85 0 0 518 0 0 89 607 -RL 35 35 0 0 1827 0 5 0 1832 -ST 40 40 0 0 288 0 0 0 288 -SG 13 13 0 0 310 0 0 0 310 -OB 7 7 0 0 39 0 0 0 39 -IF 45 45 0 0 733 0 0 0 733 -RW 6 6 0 0 40 0 0 0 40 -DBNOIX 15 15 0 0 400 0 4 25 429 ------- -------- -------- ----- ----- ----- ---- ------- ------- ----- -Total 383 383 0 0 9085 0 19 116 9220 diff -Nru gnucobol-4.0~early~20200606/tests/cobol85/summary.pl gnucobol-5/tests/cobol85/summary.pl --- gnucobol-4.0~early~20200606/tests/cobol85/summary.pl 2020-06-06 20:52:00.000000000 +0000 +++ gnucobol-5/tests/cobol85/summary.pl 1970-01-01 00:00:00.000000000 +0000 @@ -1,83 +0,0 @@ -# -# gnucobol/tests/cobol85/summary.pl -# -# Copyright (C) 2002-2012, 2017 Free Software Foundation, Inc. -# Written by Keisuke Nishida, Roger While -# -# This file is part of GnuCOBOL. -# -# The GnuCOBOL compiler is free software: you can redistribute it -# and/or modify it under the terms of the GNU General Public License -# as published by the Free Software Foundation, either version 3 of the -# License, or (at your option) any later version. -# -# GnuCOBOL is distributed in the hope that it will be useful, -# but WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -# GNU General Public License for more details. -# -# You should have received a copy of the GNU General Public License -# along with GnuCOBOL. If not, see . - -use strict; -use warnings; - -my $total_progs = 0; -my $total_executed = 0; -my $total_error = 0; -my $total_crash = 0; -my $total_pass = 0; -my $total_fail = 0; -my $total_del = 0; -my $total_insp = 0; -my $total_total = 0; - -print ("------ Directory Information ------- --- Total Tests Information ---\n"); -print ("Module Programs Executed Error Crash Pass Fail Deleted Inspect Total\n"); -print ("------ -------- -------- ----- ----- ----- ---- ------- ------- -----\n"); - -my $module; -while ($module = shift) { - open(IN, "$module/report.txt") or die; - my $test; - my $pass; - my $fail; - my $delete; - my $inspect; - my $progs; - my $executed; - my $error; - my $crash; - - while () { - if (/^Total *(\d+) *(\d+) *(\d+) *(\d+) *(\d+)/) { - ($test, $pass, $fail, $delete, $inspect) = ($1, $2, $3, $4, $5); - } elsif (/^Number of programs: *(\d+)/) { - $progs = $1; - } elsif (/^Successfully executed: *(\d+)/) { - $executed = $1; - } elsif (/^Compile error: *(\d+)/) { - $error = $1; - } elsif (/^Execute error: *(\d+)/) { - $crash = $1; - } - } - printf "%-6s %8d %8d %5d %5d %4d %4d %7d %7d %5d\n", - $module, $progs, $executed, $error, $crash, - $pass, $fail, $delete, $inspect, $test; - $total_progs += $progs; - $total_executed += $executed; - $total_error += $error; - $total_crash += $crash; - $total_pass += $pass; - $total_fail += $fail; - $total_del += $delete; - $total_insp += $inspect; - $total_total += $test; -} - -print ("------ -------- -------- ----- ----- ----- ---- ------- ------- -----\n"); -printf "Total %8d %8d %5d %5d %5d %4d %7d %7d %5d\n", - $total_progs, $total_executed, $total_error, $total_crash, - $total_pass, $total_fail, $total_del, $total_insp, $total_total; -print STDERR "Total executed programs : $total_executed - Total performed tests : $total_total\n\n"; diff -Nru gnucobol-4.0~early~20200606/tests/cobol85/summary.txt gnucobol-5/tests/cobol85/summary.txt --- gnucobol-4.0~early~20200606/tests/cobol85/summary.txt 2020-06-06 20:52:00.000000000 +0000 +++ gnucobol-5/tests/cobol85/summary.txt 1970-01-01 00:00:00.000000000 +0000 @@ -1,17 +0,0 @@ ------- Directory Information ------- --- Total Tests Information --- -Module Programs Executed Error Crash Pass Fail Deleted Inspect Total ------- -------- -------- ----- ----- ----- ---- ------- ------- ----- -NC 95 95 0 0 4393 0 4 1 4398 -SM 17 17 0 0 291 0 2 1 294 -IC 25 25 0 0 246 0 4 0 250 -SQ 85 85 0 0 518 0 0 89 607 -RL 35 35 0 0 1827 0 5 0 1832 -ST 40 40 0 0 288 0 0 0 288 -SG 13 13 0 0 310 0 0 0 310 -OB 7 7 0 0 39 0 0 0 39 -IF 45 45 0 0 733 0 0 0 733 -RW 6 6 0 0 40 0 0 0 40 -DB 16 16 0 0 418 0 4 27 449 -IX 42 42 0 0 507 0 1 0 508 ------- -------- -------- ----- ----- ----- ---- ------- ------- ----- -Total 426 426 0 0 9610 0 20 118 9748 diff -Nru gnucobol-4.0~early~20200606/tests/listings-sed.sh gnucobol-5/tests/listings-sed.sh --- gnucobol-4.0~early~20200606/tests/listings-sed.sh 2020-06-06 20:52:00.000000000 +0000 +++ gnucobol-5/tests/listings-sed.sh 1970-01-01 00:00:00.000000000 +0000 @@ -1,49 +0,0 @@ -#! /bin/sh -# -# listings-sed.sh gnucobol/tests -# -# Copyright (C) 2016-2017 Free Software Foundation, Inc. -# Written by Simon Sobisch, David Pitts -# -# This file is part of GnuCOBOL. -# -# The GnuCOBOL compiler is free software: you can redistribute it -# and/or modify it under the terms of the GNU General Public License -# as published by the Free Software Foundation, either version 3 of the -# License, or (at your option) any later version. -# -# GnuCOBOL is distributed in the hope that it will be useful, -# but WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -# GNU General Public License for more details. -# -# You should have received a copy of the GNU General Public License -# along with GnuCOBOL. If not, see . - -# Necessary sed replacements for unifying a listing - -# Note: We cater for a maximum version string of 14: -# Mayor (2) '.' Minor (2) '.' Patchlevel (8 - as some people place a date here) -# Note: We replace the date two times, as not all systems have %e modifier in C -# and use %E in this case ("Mon Feb 04" instead of "Mon Feb 4"). - -date1=`date +"%a %b %e"` -date2=`date +"%a %b %d"` - -if test "$3" = "once"; then - sed \ - -e 's/GnuCOBOL [0-9][0-9]*\.[0-9][0-9]*[-devalphabetarc]*[0-9]*\.[0-9][0-9]* */GnuCOBOL V.R.P /g' \ - -e 's/[0-2][0-9]:[0-6][0-9]:[0-9][0-9] [0-9][0-9][0-9][0-9]$/HH:MM:SS YYYY/g' \ - -e 's/'"$date1"'/DDD MMM dd/g' \ - -e 's/'"$date2"'/DDD MMM dd/g' \ - <"$1" >"$2" -else - sed \ - -e 's/GnuCOBOL [0-9][0-9]*\.[0-9][0-9]*[-devalphabetarc]*[0-9]*\.[0-9][0-9]* */GnuCOBOL V.R.P /g' \ - -e 's/[0-2][0-9]:[0-6][0-9]:[0-9][0-9] [0-9][0-9][0-9][0-9]/HH:MM:SS YYYY/g' \ - -e 's/'"$date1"'/DDD MMM dd/g' \ - -e 's/'"$date2"'/DDD MMM dd/g' \ - <"$1" >"$2" -fi - - diff -Nru gnucobol-4.0~early~20200606/tests/Makefile.am gnucobol-5/tests/Makefile.am --- gnucobol-4.0~early~20200606/tests/Makefile.am 2020-06-06 20:52:00.000000000 +0000 +++ gnucobol-5/tests/Makefile.am 1970-01-01 00:00:00.000000000 +0000 @@ -1,130 +0,0 @@ -# -# Makefile gnucobol/tests -# -# Copyright (C) 2003-2012, 2014-2019 Free Software Foundation, Inc. -# Written by Keisuke Nishida, Roger While, Simon Sobisch -# -# This file is part of GnuCOBOL. -# -# The GnuCOBOL compiler is free software: you can redistribute it -# and/or modify it under the terms of the GNU General Public License -# as published by the Free Software Foundation, either version 3 of the -# License, or (at your option) any later version. -# -# GnuCOBOL is distributed in the hope that it will be useful, -# but WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -# GNU General Public License for more details. -# -# You should have received a copy of the GNU General Public License -# along with GnuCOBOL. If not, see . - -SUBDIRS = cobol85 - -TESTSUITE = $(srcdir)/testsuite -TESTSUITE_MANUAL = $(srcdir)/testsuite_manual -dist_check_SCRIPTS = listings-sed.sh - -testsuite_sources = \ - testsuite.src/used_binaries.at \ - testsuite.src/configuration.at \ - testsuite.src/syn_copy.at \ - testsuite.src/syn_definition.at \ - testsuite.src/syn_file.at \ - testsuite.src/syn_functions.at \ - testsuite.src/syn_misc.at \ - testsuite.src/syn_move.at \ - testsuite.src/syn_multiply.at \ - testsuite.src/syn_occurs.at \ - testsuite.src/syn_redefines.at \ - testsuite.src/syn_refmod.at \ - testsuite.src/syn_reportwriter.at \ - testsuite.src/syn_screen.at \ - testsuite.src/syn_set.at \ - testsuite.src/syn_subscripts.at \ - testsuite.src/syn_value.at \ - testsuite.src/listings.at \ - testsuite.src/run_accept.at \ - testsuite.src/run_extensions.at \ - testsuite.src/run_file.at \ - testsuite.src/run_functions.at \ - testsuite.src/run_fundamental.at \ - testsuite.src/run_initialize.at \ - testsuite.src/run_misc.at \ - testsuite.src/run_ml.at \ - testsuite.src/run_refmod.at \ - testsuite.src/run_reportwriter.at \ - testsuite.src/run_returncode.at \ - testsuite.src/run_subscripts.at \ - testsuite.src/data_binary.at \ - testsuite.src/data_display.at \ - testsuite.src/data_packed.at \ - testsuite.src/data_pointer.at \ - testsuite.src/numeric-dump.cob \ - testsuite.src/numeric-display.cob - -testsuite_manual_sources = \ - testsuite.src/run_manual_screen.at - -EXTRA_DIST = $(srcdir)/package.m4 $(TESTSUITE) $(TESTSUITE_MANUAL) \ - $(srcdir)/testsuite.at $(srcdir)/testsuite_manual.at \ - $(srcdir)/listings-sed.sh \ - $(testsuite_sources) $(testsuite_manual_sources) - -DISTCLEANFILES = atconfig - -check-local: prereq-testsuite - @GNUCOBOL_TEST_LOCAL="" $(TESTSUITE) $(TESTSUITEFLAGS) || (rm -f testsuite.dir/at-job-fifo; exit 1) - @rm -f testsuite.dir/at-job-fifo - -localcheck: prereq-testsuite - @GNUCOBOL_TEST_LOCAL="1" $(TESTSUITE) $(TESTSUITEFLAGS) || (rm -f testsuite.dir/at-job-fifo; exit 1) - @rm -f testsuite.dir/at-job-fifo - -prereq-check: - @echo testing for working diff && diff - "$(TESTSUITE)" < "$(TESTSUITE)" \ - || (echo "Error: no working 'diff' in PATH" && false) - -prereq-testsuite: $(TESTSUITE) prereq-check - @rm -rf testsuite.dir - -prereq-manual: $(TESTSUITE_MANUAL) prereq-check - @rm -rf testsuite_manual.dir - -clean-local: - rm -rf *.dir *.log - -checkmanual: prereq-manual - @$(TESTSUITE_MANUAL) $(TESTSUITEFLAGS) || (rm -f testsuite_manual.dir/at-job-fifo; exit 1) - @rm -f testsuite_manual.dir/at-job-fifo - -# targets that are only logical targets instead of files -.PHONY: test checkall checkmanual localcheck \ - prereq-check prereq-testsuite prereq-manual - -test: - @echo testing for perl && perl -v 1>/dev/null \ - || (echo "Error: no working 'perl' in PATH" && false) - cd cobol85 && $(MAKE) $(AM_MAKEFLAGS) test - -checkall: check test - -$(srcdir)/package.m4: $(top_srcdir)/configure.ac - @echo "creating $(srcdir)/package.m4" - @{ \ - echo '# Signature of the current package.'; \ - echo 'm4_define([AT_PACKAGE_NAME], [@PACKAGE_NAME@])'; \ - echo 'm4_define([AT_PACKAGE_TARNAME], [@PACKAGE_TARNAME@])'; \ - echo 'm4_define([AT_PACKAGE_VERSION], [@PACKAGE_VERSION@])'; \ - echo 'm4_define([AT_PACKAGE_STRING], [@PACKAGE_STRING@])'; \ - echo 'm4_define([AT_PACKAGE_BUGREPORT], [@PACKAGE_BUGREPORT@])'; \ - echo 'm4_define([AT_PACKAGE_URL], [@PACKAGE_URL@])'; \ - } > $(srcdir)/package.m4 - -$(TESTSUITE): $(testsuite_sources) $(srcdir)/package.m4 $(srcdir)/testsuite.at - autom4te --language=autotest -I $(srcdir) -I $(srcdir)/testsuite.src -o $(srcdir)/testsuite $(srcdir)/testsuite.at - chmod +x $(srcdir)/testsuite - -$(TESTSUITE_MANUAL): $(testsuite_manual_sources) $(srcdir)/package.m4 $(srcdir)/testsuite_manual.at - autom4te --language=autotest -I $(srcdir) -I $(srcdir)/testsuite.src -o $(srcdir)/testsuite_manual $(srcdir)/testsuite_manual.at - chmod +x $(srcdir)/testsuite_manual diff -Nru gnucobol-4.0~early~20200606/tests/Makefile.in gnucobol-5/tests/Makefile.in --- gnucobol-4.0~early~20200606/tests/Makefile.in 2020-06-06 20:56:36.000000000 +0000 +++ gnucobol-5/tests/Makefile.in 1970-01-01 00:00:00.000000000 +0000 @@ -1,846 +0,0 @@ -# Makefile.in generated by automake 1.15.1 from Makefile.am. -# @configure_input@ - -# Copyright (C) 1994-2017 Free Software Foundation, Inc. - -# This Makefile.in is free software; the Free Software Foundation -# gives unlimited permission to copy and/or distribute it, -# with or without modifications, as long as this notice is preserved. - -# This program is distributed in the hope that it will be useful, -# but WITHOUT ANY WARRANTY, to the extent permitted by law; without -# even the implied warranty of MERCHANTABILITY or FITNESS FOR A -# PARTICULAR PURPOSE. - -@SET_MAKE@ - -# -# Makefile gnucobol/tests -# -# Copyright (C) 2003-2012, 2014-2019 Free Software Foundation, Inc. -# Written by Keisuke Nishida, Roger While, Simon Sobisch -# -# This file is part of GnuCOBOL. -# -# The GnuCOBOL compiler is free software: you can redistribute it -# and/or modify it under the terms of the GNU General Public License -# as published by the Free Software Foundation, either version 3 of the -# License, or (at your option) any later version. -# -# GnuCOBOL is distributed in the hope that it will be useful, -# but WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -# GNU General Public License for more details. -# -# You should have received a copy of the GNU General Public License -# along with GnuCOBOL. If not, see . -VPATH = @srcdir@ -am__is_gnu_make = { \ - if test -z '$(MAKELEVEL)'; then \ - false; \ - elif test -n '$(MAKE_HOST)'; then \ - true; \ - elif test -n '$(MAKE_VERSION)' && test -n '$(CURDIR)'; then \ - true; \ - else \ - false; \ - fi; \ -} -am__make_running_with_option = \ - case $${target_option-} in \ - ?) ;; \ - *) echo "am__make_running_with_option: internal error: invalid" \ - "target option '$${target_option-}' specified" >&2; \ - exit 1;; \ - esac; \ - has_opt=no; \ - sane_makeflags=$$MAKEFLAGS; \ - if $(am__is_gnu_make); then \ - sane_makeflags=$$MFLAGS; \ - else \ - case $$MAKEFLAGS in \ - *\\[\ \ ]*) \ - bs=\\; \ - sane_makeflags=`printf '%s\n' "$$MAKEFLAGS" \ - | sed "s/$$bs$$bs[$$bs $$bs ]*//g"`;; \ - esac; \ - fi; \ - skip_next=no; \ - strip_trailopt () \ - { \ - flg=`printf '%s\n' "$$flg" | sed "s/$$1.*$$//"`; \ - }; \ - for flg in $$sane_makeflags; do \ - test $$skip_next = yes && { skip_next=no; continue; }; \ - case $$flg in \ - *=*|--*) continue;; \ - -*I) strip_trailopt 'I'; skip_next=yes;; \ - -*I?*) strip_trailopt 'I';; \ - -*O) strip_trailopt 'O'; skip_next=yes;; \ - -*O?*) strip_trailopt 'O';; \ - -*l) strip_trailopt 'l'; skip_next=yes;; \ - -*l?*) strip_trailopt 'l';; \ - -[dEDm]) skip_next=yes;; \ - -[JT]) skip_next=yes;; \ - esac; \ - case $$flg in \ - *$$target_option*) has_opt=yes; break;; \ - esac; \ - done; \ - test $$has_opt = yes -am__make_dryrun = (target_option=n; $(am__make_running_with_option)) -am__make_keepgoing = (target_option=k; $(am__make_running_with_option)) -pkgdatadir = $(datadir)/@PACKAGE@ -pkgincludedir = $(includedir)/@PACKAGE@ -pkglibdir = $(libdir)/@PACKAGE@ -pkglibexecdir = $(libexecdir)/@PACKAGE@ -am__cd = CDPATH="$${ZSH_VERSION+.}$(PATH_SEPARATOR)" && cd -install_sh_DATA = $(install_sh) -c -m 644 -install_sh_PROGRAM = $(install_sh) -c -install_sh_SCRIPT = $(install_sh) -c -INSTALL_HEADER = $(INSTALL_DATA) -transform = $(program_transform_name) -NORMAL_INSTALL = : -PRE_INSTALL = : -POST_INSTALL = : -NORMAL_UNINSTALL = : -PRE_UNINSTALL = : -POST_UNINSTALL = : -build_triplet = @build@ -host_triplet = @host@ -subdir = tests -ACLOCAL_M4 = $(top_srcdir)/aclocal.m4 -am__aclocal_m4_deps = $(top_srcdir)/m4/codeset.m4 \ - $(top_srcdir)/m4/gettext.m4 $(top_srcdir)/m4/iconv.m4 \ - $(top_srcdir)/m4/intlmacosx.m4 $(top_srcdir)/m4/lib-ld.m4 \ - $(top_srcdir)/m4/lib-link.m4 $(top_srcdir)/m4/lib-prefix.m4 \ - $(top_srcdir)/m4/libtool.m4 $(top_srcdir)/m4/ltoptions.m4 \ - $(top_srcdir)/m4/ltsugar.m4 $(top_srcdir)/m4/ltversion.m4 \ - $(top_srcdir)/m4/lt~obsolete.m4 \ - $(top_srcdir)/m4/m4_ax_check_define.m4 \ - $(top_srcdir)/m4/m4_ax_code_coverage.m4 \ - $(top_srcdir)/m4/nls.m4 $(top_srcdir)/m4/pkg.m4 \ - $(top_srcdir)/m4/po.m4 $(top_srcdir)/m4/progtest.m4 \ - $(top_srcdir)/configure.ac -am__configure_deps = $(am__aclocal_m4_deps) $(CONFIGURE_DEPENDENCIES) \ - $(ACLOCAL_M4) -DIST_COMMON = $(srcdir)/Makefile.am $(dist_check_SCRIPTS) \ - $(am__DIST_COMMON) -mkinstalldirs = $(SHELL) $(top_srcdir)/build_aux/mkinstalldirs -CONFIG_HEADER = $(top_builddir)/config.h -CONFIG_CLEAN_FILES = atlocal run_prog_manual.sh -CONFIG_CLEAN_VPATH_FILES = -AM_V_P = $(am__v_P_@AM_V@) -am__v_P_ = $(am__v_P_@AM_DEFAULT_V@) -am__v_P_0 = false -am__v_P_1 = : -AM_V_GEN = $(am__v_GEN_@AM_V@) -am__v_GEN_ = $(am__v_GEN_@AM_DEFAULT_V@) -am__v_GEN_0 = @echo " GEN " $@; -am__v_GEN_1 = -AM_V_at = $(am__v_at_@AM_V@) -am__v_at_ = $(am__v_at_@AM_DEFAULT_V@) -am__v_at_0 = @ -am__v_at_1 = -SOURCES = -DIST_SOURCES = -RECURSIVE_TARGETS = all-recursive check-recursive cscopelist-recursive \ - ctags-recursive dvi-recursive html-recursive info-recursive \ - install-data-recursive install-dvi-recursive \ - install-exec-recursive install-html-recursive \ - install-info-recursive install-pdf-recursive \ - install-ps-recursive install-recursive installcheck-recursive \ - installdirs-recursive pdf-recursive ps-recursive \ - tags-recursive uninstall-recursive -am__can_run_installinfo = \ - case $$AM_UPDATE_INFO_DIR in \ - n|no|NO) false;; \ - *) (install-info --version) >/dev/null 2>&1;; \ - esac -RECURSIVE_CLEAN_TARGETS = mostlyclean-recursive clean-recursive \ - distclean-recursive maintainer-clean-recursive -am__recursive_targets = \ - $(RECURSIVE_TARGETS) \ - $(RECURSIVE_CLEAN_TARGETS) \ - $(am__extra_recursive_targets) -AM_RECURSIVE_TARGETS = $(am__recursive_targets:-recursive=) TAGS CTAGS \ - distdir -am__tagged_files = $(HEADERS) $(SOURCES) $(TAGS_FILES) $(LISP) -# Read a list of newline-separated strings from the standard input, -# and print each of them once, without duplicates. Input order is -# *not* preserved. -am__uniquify_input = $(AWK) '\ - BEGIN { nonempty = 0; } \ - { items[$$0] = 1; nonempty = 1; } \ - END { if (nonempty) { for (i in items) print i; }; } \ -' -# Make sure the list of sources is unique. This is necessary because, -# e.g., the same source file might be shared among _SOURCES variables -# for different programs/libraries. -am__define_uniq_tagged_files = \ - list='$(am__tagged_files)'; \ - unique=`for i in $$list; do \ - if test -f "$$i"; then echo $$i; else echo $(srcdir)/$$i; fi; \ - done | $(am__uniquify_input)` -ETAGS = etags -CTAGS = ctags -DIST_SUBDIRS = $(SUBDIRS) -am__DIST_COMMON = $(srcdir)/Makefile.in $(srcdir)/atlocal.in \ - $(srcdir)/run_prog_manual.sh.in \ - $(top_srcdir)/build_aux/mkinstalldirs ChangeLog -DISTFILES = $(DIST_COMMON) $(DIST_SOURCES) $(TEXINFOS) $(EXTRA_DIST) -am__relativize = \ - dir0=`pwd`; \ - sed_first='s,^\([^/]*\)/.*$$,\1,'; \ - sed_rest='s,^[^/]*/*,,'; \ - sed_last='s,^.*/\([^/]*\)$$,\1,'; \ - sed_butlast='s,/*[^/]*$$,,'; \ - while test -n "$$dir1"; do \ - first=`echo "$$dir1" | sed -e "$$sed_first"`; \ - if test "$$first" != "."; then \ - if test "$$first" = ".."; then \ - dir2=`echo "$$dir0" | sed -e "$$sed_last"`/"$$dir2"; \ - dir0=`echo "$$dir0" | sed -e "$$sed_butlast"`; \ - else \ - first2=`echo "$$dir2" | sed -e "$$sed_first"`; \ - if test "$$first2" = "$$first"; then \ - dir2=`echo "$$dir2" | sed -e "$$sed_rest"`; \ - else \ - dir2="../$$dir2"; \ - fi; \ - dir0="$$dir0"/"$$first"; \ - fi; \ - fi; \ - dir1=`echo "$$dir1" | sed -e "$$sed_rest"`; \ - done; \ - reldir="$$dir2" -ACLOCAL = @ACLOCAL@ -AMTAR = @AMTAR@ -AM_DEFAULT_VERBOSITY = @AM_DEFAULT_VERBOSITY@ -AR = @AR@ -AS = @AS@ -AUTOCONF = @AUTOCONF@ -AUTOHEADER = @AUTOHEADER@ -AUTOMAKE = @AUTOMAKE@ -AWK = @AWK@ -CC = @CC@ -CCDEPMODE = @CCDEPMODE@ -CFLAGS = @CFLAGS@ -CJSON_CFLAGS = @CJSON_CFLAGS@ -CJSON_LIBS = @CJSON_LIBS@ -COBC_LIBS = @COBC_LIBS@ -COB_BIGENDIAN = @COB_BIGENDIAN@ -COB_CC = @COB_CC@ -COB_CFLAGS = @COB_CFLAGS@ -COB_CONFIG_DIR = @COB_CONFIG_DIR@ -COB_COPY_DIR = @COB_COPY_DIR@ -COB_EXE_EXT = @COB_EXE_EXT@ -COB_EXPORT_DYN = @COB_EXPORT_DYN@ -COB_FIX_LIB = @COB_FIX_LIB@ -COB_FIX_LIBTOOL = @COB_FIX_LIBTOOL@ -COB_HAS_64_BIT_POINTER = @COB_HAS_64_BIT_POINTER@ -COB_HAS_BDB = @COB_HAS_BDB@ -COB_HAS_CISAM = @COB_HAS_CISAM@ -COB_HAS_CJSON = @COB_HAS_CJSON@ -COB_HAS_CURSES = @COB_HAS_CURSES@ -COB_HAS_DISAM = @COB_HAS_DISAM@ -COB_HAS_ISAM = @COB_HAS_ISAM@ -COB_HAS_LMDB = @COB_HAS_LMDB@ -COB_HAS_OCEXTFH = @COB_HAS_OCEXTFH@ -COB_HAS_OCI = @COB_HAS_OCI@ -COB_HAS_ODBC = @COB_HAS_ODBC@ -COB_HAS_VBISAM = @COB_HAS_VBISAM@ -COB_HAS_XML2 = @COB_HAS_XML2@ -COB_KEYWORD_INLINE = @COB_KEYWORD_INLINE@ -COB_LDFLAGS = @COB_LDFLAGS@ -COB_LIBRARY_PATH = @COB_LIBRARY_PATH@ -COB_LIBS = @COB_LIBS@ -COB_MODULE_EXT = @COB_MODULE_EXT@ -COB_OBJECT_EXT = @COB_OBJECT_EXT@ -COB_PATCH_LEVEL = @COB_PATCH_LEVEL@ -COB_PIC_FLAGS = @COB_PIC_FLAGS@ -COB_SCHEMA_DIR = @COB_SCHEMA_DIR@ -COB_SHARED_OPT = @COB_SHARED_OPT@ -CODE_COVERAGE_CFLAGS = @CODE_COVERAGE_CFLAGS@ -CODE_COVERAGE_CPPFLAGS = @CODE_COVERAGE_CPPFLAGS@ -CODE_COVERAGE_CXXFLAGS = @CODE_COVERAGE_CXXFLAGS@ -CODE_COVERAGE_ENABLED = @CODE_COVERAGE_ENABLED@ -CODE_COVERAGE_LDFLAGS = @CODE_COVERAGE_LDFLAGS@ -CODE_COVERAGE_LIBS = @CODE_COVERAGE_LIBS@ -CPP = @CPP@ -CPPFLAGS = @CPPFLAGS@ -CYGPATH_W = @CYGPATH_W@ -DEFS = @DEFS@ -DEPDIR = @DEPDIR@ -DIFF_FLAGS = @DIFF_FLAGS@ -DLLTOOL = @DLLTOOL@ -DSYMUTIL = @DSYMUTIL@ -DUMPBIN = @DUMPBIN@ -ECHO_C = @ECHO_C@ -ECHO_N = @ECHO_N@ -ECHO_T = @ECHO_T@ -EGREP = @EGREP@ -EXEEXT = @EXEEXT@ -FGREP = @FGREP@ -GCOV = @GCOV@ -GENHTML = @GENHTML@ -GETTEXT_MACRO_VERSION = @GETTEXT_MACRO_VERSION@ -GMSGFMT = @GMSGFMT@ -GMSGFMT_015 = @GMSGFMT_015@ -GREP = @GREP@ -HELP2MAN = @HELP2MAN@ -INSTALL = @INSTALL@ -INSTALL_DATA = @INSTALL_DATA@ -INSTALL_PROGRAM = @INSTALL_PROGRAM@ -INSTALL_SCRIPT = @INSTALL_SCRIPT@ -INSTALL_STRIP_PROGRAM = @INSTALL_STRIP_PROGRAM@ -INTLLIBS = @INTLLIBS@ -INTL_MACOSX_LIBS = @INTL_MACOSX_LIBS@ -LCOV = @LCOV@ -LD = @LD@ -LDFLAGS = @LDFLAGS@ -LEX = @LEX@ -LEXLIB = @LEXLIB@ -LEX_OUTPUT_ROOT = @LEX_OUTPUT_ROOT@ -LIBCOB_CISAM = @LIBCOB_CISAM@ -LIBCOB_CPPFLAGS = @LIBCOB_CPPFLAGS@ -LIBCOB_DISAM = @LIBCOB_DISAM@ -LIBCOB_LIBS = @LIBCOB_LIBS@ -LIBCOB_VBISAM = @LIBCOB_VBISAM@ -LIBICONV = @LIBICONV@ -LIBINTL = @LIBINTL@ -LIBOBJS = @LIBOBJS@ -LIBS = @LIBS@ -LIBTOOL = @LIBTOOL@ -LIPO = @LIPO@ -LN_S = @LN_S@ -LTLIBICONV = @LTLIBICONV@ -LTLIBINTL = @LTLIBINTL@ -LTLIBOBJS = @LTLIBOBJS@ -LT_SYS_LIBRARY_PATH = @LT_SYS_LIBRARY_PATH@ -MAKE = @MAKE@ -MAKEINFO = @MAKEINFO@ -MANIFEST_TOOL = @MANIFEST_TOOL@ -MKDIR_P = @MKDIR_P@ -MSGFMT = @MSGFMT@ -MSGFMT_015 = @MSGFMT_015@ -MSGMERGE = @MSGMERGE@ -NM = @NM@ -NMEDIT = @NMEDIT@ -OBJDUMP = @OBJDUMP@ -OBJEXT = @OBJEXT@ -ODBC_CFLAGS = @ODBC_CFLAGS@ -ODBC_LIBS = @ODBC_LIBS@ -OTOOL = @OTOOL@ -OTOOL64 = @OTOOL64@ -PACKAGE = @PACKAGE@ -PACKAGE_BUGREPORT = @PACKAGE_BUGREPORT@ -PACKAGE_NAME = @PACKAGE_NAME@ -PACKAGE_STRING = @PACKAGE_STRING@ -PACKAGE_TARNAME = @PACKAGE_TARNAME@ -PACKAGE_URL = @PACKAGE_URL@ -PACKAGE_VERSION = @PACKAGE_VERSION@ -PATH_SEPARATOR = @PATH_SEPARATOR@ -PKG_CONFIG = @PKG_CONFIG@ -PKG_CONFIG_LIBDIR = @PKG_CONFIG_LIBDIR@ -PKG_CONFIG_PATH = @PKG_CONFIG_PATH@ -POSUB = @POSUB@ -RANLIB = @RANLIB@ -SED = @SED@ -SET_MAKE = @SET_MAKE@ -SHELL = @SHELL@ -STRIP = @STRIP@ -USE_NLS = @USE_NLS@ -VERSION = @VERSION@ -XGETTEXT = @XGETTEXT@ -XGETTEXT_015 = @XGETTEXT_015@ -XGETTEXT_EXTRA_OPTIONS = @XGETTEXT_EXTRA_OPTIONS@ -XML2_CFLAGS = @XML2_CFLAGS@ -XML2_LIBS = @XML2_LIBS@ -YACC = @YACC@ -YFLAGS = @YFLAGS@ -abs_builddir = @abs_builddir@ -abs_srcdir = @abs_srcdir@ -abs_top_builddir = @abs_top_builddir@ -abs_top_srcdir = @abs_top_srcdir@ -ac_ct_AR = @ac_ct_AR@ -ac_ct_CC = @ac_ct_CC@ -ac_ct_DUMPBIN = @ac_ct_DUMPBIN@ -am__include = @am__include@ -am__leading_dot = @am__leading_dot@ -am__quote = @am__quote@ -am__tar = @am__tar@ -am__untar = @am__untar@ -bindir = @bindir@ -build = @build@ -build_alias = @build_alias@ -build_cpu = @build_cpu@ -build_os = @build_os@ -build_vendor = @build_vendor@ -builddir = @builddir@ -configured_make = @configured_make@ -datadir = @datadir@ -datarootdir = @datarootdir@ -docdir = @docdir@ -dvidir = @dvidir@ -exec_prefix = @exec_prefix@ -host = @host@ -host_alias = @host_alias@ -host_cpu = @host_cpu@ -host_os = @host_os@ -host_vendor = @host_vendor@ -htmldir = @htmldir@ -includedir = @includedir@ -infodir = @infodir@ -install_sh = @install_sh@ -libdir = @libdir@ -libexecdir = @libexecdir@ -localedir = @localedir@ -localstatedir = @localstatedir@ -mandir = @mandir@ -mkdir_p = @mkdir_p@ -oldincludedir = @oldincludedir@ -pdfdir = @pdfdir@ -prefix = @prefix@ -program_transform_name = @program_transform_name@ -psdir = @psdir@ -runstatedir = @runstatedir@ -sbindir = @sbindir@ -sharedstatedir = @sharedstatedir@ -srcdir = @srcdir@ -sysconfdir = @sysconfdir@ -target_alias = @target_alias@ -top_build_prefix = @top_build_prefix@ -top_builddir = @top_builddir@ -top_srcdir = @top_srcdir@ -xml2_config_found = @xml2_config_found@ -SUBDIRS = cobol85 -TESTSUITE = $(srcdir)/testsuite -TESTSUITE_MANUAL = $(srcdir)/testsuite_manual -dist_check_SCRIPTS = listings-sed.sh -testsuite_sources = \ - testsuite.src/used_binaries.at \ - testsuite.src/configuration.at \ - testsuite.src/syn_copy.at \ - testsuite.src/syn_definition.at \ - testsuite.src/syn_file.at \ - testsuite.src/syn_functions.at \ - testsuite.src/syn_misc.at \ - testsuite.src/syn_move.at \ - testsuite.src/syn_multiply.at \ - testsuite.src/syn_occurs.at \ - testsuite.src/syn_redefines.at \ - testsuite.src/syn_refmod.at \ - testsuite.src/syn_reportwriter.at \ - testsuite.src/syn_screen.at \ - testsuite.src/syn_set.at \ - testsuite.src/syn_subscripts.at \ - testsuite.src/syn_value.at \ - testsuite.src/listings.at \ - testsuite.src/run_accept.at \ - testsuite.src/run_extensions.at \ - testsuite.src/run_file.at \ - testsuite.src/run_functions.at \ - testsuite.src/run_fundamental.at \ - testsuite.src/run_initialize.at \ - testsuite.src/run_misc.at \ - testsuite.src/run_ml.at \ - testsuite.src/run_refmod.at \ - testsuite.src/run_reportwriter.at \ - testsuite.src/run_returncode.at \ - testsuite.src/run_subscripts.at \ - testsuite.src/data_binary.at \ - testsuite.src/data_display.at \ - testsuite.src/data_packed.at \ - testsuite.src/data_pointer.at \ - testsuite.src/numeric-dump.cob \ - testsuite.src/numeric-display.cob - -testsuite_manual_sources = \ - testsuite.src/run_manual_screen.at - -EXTRA_DIST = $(srcdir)/package.m4 $(TESTSUITE) $(TESTSUITE_MANUAL) \ - $(srcdir)/testsuite.at $(srcdir)/testsuite_manual.at \ - $(srcdir)/listings-sed.sh \ - $(testsuite_sources) $(testsuite_manual_sources) - -DISTCLEANFILES = atconfig -all: all-recursive - -.SUFFIXES: -$(srcdir)/Makefile.in: $(srcdir)/Makefile.am $(am__configure_deps) - @for dep in $?; do \ - case '$(am__configure_deps)' in \ - *$$dep*) \ - ( cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh ) \ - && { if test -f $@; then exit 0; else break; fi; }; \ - exit 1;; \ - esac; \ - done; \ - echo ' cd $(top_srcdir) && $(AUTOMAKE) --gnu tests/Makefile'; \ - $(am__cd) $(top_srcdir) && \ - $(AUTOMAKE) --gnu tests/Makefile -Makefile: $(srcdir)/Makefile.in $(top_builddir)/config.status - @case '$?' in \ - *config.status*) \ - cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh;; \ - *) \ - echo ' cd $(top_builddir) && $(SHELL) ./config.status $(subdir)/$@ $(am__depfiles_maybe)'; \ - cd $(top_builddir) && $(SHELL) ./config.status $(subdir)/$@ $(am__depfiles_maybe);; \ - esac; - -$(top_builddir)/config.status: $(top_srcdir)/configure $(CONFIG_STATUS_DEPENDENCIES) - cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh - -$(top_srcdir)/configure: $(am__configure_deps) - cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh -$(ACLOCAL_M4): $(am__aclocal_m4_deps) - cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh -$(am__aclocal_m4_deps): -atlocal: $(top_builddir)/config.status $(srcdir)/atlocal.in - cd $(top_builddir) && $(SHELL) ./config.status $(subdir)/$@ -run_prog_manual.sh: $(top_builddir)/config.status $(srcdir)/run_prog_manual.sh.in - cd $(top_builddir) && $(SHELL) ./config.status $(subdir)/$@ - -mostlyclean-libtool: - -rm -f *.lo - -clean-libtool: - -rm -rf .libs _libs - -# This directory's subdirectories are mostly independent; you can cd -# into them and run 'make' without going through this Makefile. -# To change the values of 'make' variables: instead of editing Makefiles, -# (1) if the variable is set in 'config.status', edit 'config.status' -# (which will cause the Makefiles to be regenerated when you run 'make'); -# (2) otherwise, pass the desired values on the 'make' command line. -$(am__recursive_targets): - @fail=; \ - if $(am__make_keepgoing); then \ - failcom='fail=yes'; \ - else \ - failcom='exit 1'; \ - fi; \ - dot_seen=no; \ - target=`echo $@ | sed s/-recursive//`; \ - case "$@" in \ - distclean-* | maintainer-clean-*) list='$(DIST_SUBDIRS)' ;; \ - *) list='$(SUBDIRS)' ;; \ - esac; \ - for subdir in $$list; do \ - echo "Making $$target in $$subdir"; \ - if test "$$subdir" = "."; then \ - dot_seen=yes; \ - local_target="$$target-am"; \ - else \ - local_target="$$target"; \ - fi; \ - ($(am__cd) $$subdir && $(MAKE) $(AM_MAKEFLAGS) $$local_target) \ - || eval $$failcom; \ - done; \ - if test "$$dot_seen" = "no"; then \ - $(MAKE) $(AM_MAKEFLAGS) "$$target-am" || exit 1; \ - fi; test -z "$$fail" - -ID: $(am__tagged_files) - $(am__define_uniq_tagged_files); mkid -fID $$unique -tags: tags-recursive -TAGS: tags - -tags-am: $(TAGS_DEPENDENCIES) $(am__tagged_files) - set x; \ - here=`pwd`; \ - if ($(ETAGS) --etags-include --version) >/dev/null 2>&1; then \ - include_option=--etags-include; \ - empty_fix=.; \ - else \ - include_option=--include; \ - empty_fix=; \ - fi; \ - list='$(SUBDIRS)'; for subdir in $$list; do \ - if test "$$subdir" = .; then :; else \ - test ! -f $$subdir/TAGS || \ - set "$$@" "$$include_option=$$here/$$subdir/TAGS"; \ - fi; \ - done; \ - $(am__define_uniq_tagged_files); \ - shift; \ - if test -z "$(ETAGS_ARGS)$$*$$unique"; then :; else \ - test -n "$$unique" || unique=$$empty_fix; \ - if test $$# -gt 0; then \ - $(ETAGS) $(ETAGSFLAGS) $(AM_ETAGSFLAGS) $(ETAGS_ARGS) \ - "$$@" $$unique; \ - else \ - $(ETAGS) $(ETAGSFLAGS) $(AM_ETAGSFLAGS) $(ETAGS_ARGS) \ - $$unique; \ - fi; \ - fi -ctags: ctags-recursive - -CTAGS: ctags -ctags-am: $(TAGS_DEPENDENCIES) $(am__tagged_files) - $(am__define_uniq_tagged_files); \ - test -z "$(CTAGS_ARGS)$$unique" \ - || $(CTAGS) $(CTAGSFLAGS) $(AM_CTAGSFLAGS) $(CTAGS_ARGS) \ - $$unique - -GTAGS: - here=`$(am__cd) $(top_builddir) && pwd` \ - && $(am__cd) $(top_srcdir) \ - && gtags -i $(GTAGS_ARGS) "$$here" -cscopelist: cscopelist-recursive - -cscopelist-am: $(am__tagged_files) - list='$(am__tagged_files)'; \ - case "$(srcdir)" in \ - [\\/]* | ?:[\\/]*) sdir="$(srcdir)" ;; \ - *) sdir=$(subdir)/$(srcdir) ;; \ - esac; \ - for i in $$list; do \ - if test -f "$$i"; then \ - echo "$(subdir)/$$i"; \ - else \ - echo "$$sdir/$$i"; \ - fi; \ - done >> $(top_builddir)/cscope.files - -distclean-tags: - -rm -f TAGS ID GTAGS GRTAGS GSYMS GPATH tags - -distdir: $(DISTFILES) - @srcdirstrip=`echo "$(srcdir)" | sed 's/[].[^$$\\*]/\\\\&/g'`; \ - topsrcdirstrip=`echo "$(top_srcdir)" | sed 's/[].[^$$\\*]/\\\\&/g'`; \ - list='$(DISTFILES)'; \ - dist_files=`for file in $$list; do echo $$file; done | \ - sed -e "s|^$$srcdirstrip/||;t" \ - -e "s|^$$topsrcdirstrip/|$(top_builddir)/|;t"`; \ - case $$dist_files in \ - */*) $(MKDIR_P) `echo "$$dist_files" | \ - sed '/\//!d;s|^|$(distdir)/|;s,/[^/]*$$,,' | \ - sort -u` ;; \ - esac; \ - for file in $$dist_files; do \ - if test -f $$file || test -d $$file; then d=.; else d=$(srcdir); fi; \ - if test -d $$d/$$file; then \ - dir=`echo "/$$file" | sed -e 's,/[^/]*$$,,'`; \ - if test -d "$(distdir)/$$file"; then \ - find "$(distdir)/$$file" -type d ! -perm -700 -exec chmod u+rwx {} \;; \ - fi; \ - if test -d $(srcdir)/$$file && test $$d != $(srcdir); then \ - cp -fpR $(srcdir)/$$file "$(distdir)$$dir" || exit 1; \ - find "$(distdir)/$$file" -type d ! -perm -700 -exec chmod u+rwx {} \;; \ - fi; \ - cp -fpR $$d/$$file "$(distdir)$$dir" || exit 1; \ - else \ - test -f "$(distdir)/$$file" \ - || cp -p $$d/$$file "$(distdir)/$$file" \ - || exit 1; \ - fi; \ - done - @list='$(DIST_SUBDIRS)'; for subdir in $$list; do \ - if test "$$subdir" = .; then :; else \ - $(am__make_dryrun) \ - || test -d "$(distdir)/$$subdir" \ - || $(MKDIR_P) "$(distdir)/$$subdir" \ - || exit 1; \ - dir1=$$subdir; dir2="$(distdir)/$$subdir"; \ - $(am__relativize); \ - new_distdir=$$reldir; \ - dir1=$$subdir; dir2="$(top_distdir)"; \ - $(am__relativize); \ - new_top_distdir=$$reldir; \ - echo " (cd $$subdir && $(MAKE) $(AM_MAKEFLAGS) top_distdir="$$new_top_distdir" distdir="$$new_distdir" \\"; \ - echo " am__remove_distdir=: am__skip_length_check=: am__skip_mode_fix=: distdir)"; \ - ($(am__cd) $$subdir && \ - $(MAKE) $(AM_MAKEFLAGS) \ - top_distdir="$$new_top_distdir" \ - distdir="$$new_distdir" \ - am__remove_distdir=: \ - am__skip_length_check=: \ - am__skip_mode_fix=: \ - distdir) \ - || exit 1; \ - fi; \ - done -check-am: all-am - $(MAKE) $(AM_MAKEFLAGS) $(dist_check_SCRIPTS) - $(MAKE) $(AM_MAKEFLAGS) check-local -check: check-recursive -all-am: Makefile -installdirs: installdirs-recursive -installdirs-am: -install: install-recursive -install-exec: install-exec-recursive -install-data: install-data-recursive -uninstall: uninstall-recursive - -install-am: all-am - @$(MAKE) $(AM_MAKEFLAGS) install-exec-am install-data-am - -installcheck: installcheck-recursive -install-strip: - if test -z '$(STRIP)'; then \ - $(MAKE) $(AM_MAKEFLAGS) INSTALL_PROGRAM="$(INSTALL_STRIP_PROGRAM)" \ - install_sh_PROGRAM="$(INSTALL_STRIP_PROGRAM)" INSTALL_STRIP_FLAG=-s \ - install; \ - else \ - $(MAKE) $(AM_MAKEFLAGS) INSTALL_PROGRAM="$(INSTALL_STRIP_PROGRAM)" \ - install_sh_PROGRAM="$(INSTALL_STRIP_PROGRAM)" INSTALL_STRIP_FLAG=-s \ - "INSTALL_PROGRAM_ENV=STRIPPROG='$(STRIP)'" install; \ - fi -mostlyclean-generic: - -clean-generic: - -distclean-generic: - -test -z "$(CONFIG_CLEAN_FILES)" || rm -f $(CONFIG_CLEAN_FILES) - -test . = "$(srcdir)" || test -z "$(CONFIG_CLEAN_VPATH_FILES)" || rm -f $(CONFIG_CLEAN_VPATH_FILES) - -test -z "$(DISTCLEANFILES)" || rm -f $(DISTCLEANFILES) - -maintainer-clean-generic: - @echo "This command is intended for maintainers to use" - @echo "it deletes files that may require special tools to rebuild." -clean: clean-recursive - -clean-am: clean-generic clean-libtool clean-local mostlyclean-am - -distclean: distclean-recursive - -rm -f Makefile -distclean-am: clean-am distclean-generic distclean-tags - -dvi: dvi-recursive - -dvi-am: - -html: html-recursive - -html-am: - -info: info-recursive - -info-am: - -install-data-am: - -install-dvi: install-dvi-recursive - -install-dvi-am: - -install-exec-am: - -install-html: install-html-recursive - -install-html-am: - -install-info: install-info-recursive - -install-info-am: - -install-man: - -install-pdf: install-pdf-recursive - -install-pdf-am: - -install-ps: install-ps-recursive - -install-ps-am: - -installcheck-am: - -maintainer-clean: maintainer-clean-recursive - -rm -f Makefile -maintainer-clean-am: distclean-am maintainer-clean-generic - -mostlyclean: mostlyclean-recursive - -mostlyclean-am: mostlyclean-generic mostlyclean-libtool - -pdf: pdf-recursive - -pdf-am: - -ps: ps-recursive - -ps-am: - -uninstall-am: - -.MAKE: $(am__recursive_targets) check-am install-am install-strip - -.PHONY: $(am__recursive_targets) CTAGS GTAGS TAGS all all-am check \ - check-am check-local clean clean-generic clean-libtool \ - clean-local cscopelist-am ctags ctags-am distclean \ - distclean-generic distclean-libtool distclean-tags distdir dvi \ - dvi-am html html-am info info-am install install-am \ - install-data install-data-am install-dvi install-dvi-am \ - install-exec install-exec-am install-html install-html-am \ - install-info install-info-am install-man install-pdf \ - install-pdf-am install-ps install-ps-am install-strip \ - installcheck installcheck-am installdirs installdirs-am \ - maintainer-clean maintainer-clean-generic mostlyclean \ - mostlyclean-generic mostlyclean-libtool pdf pdf-am ps ps-am \ - tags tags-am uninstall uninstall-am - -.PRECIOUS: Makefile - - -check-local: prereq-testsuite - @GNUCOBOL_TEST_LOCAL="" $(TESTSUITE) $(TESTSUITEFLAGS) || (rm -f testsuite.dir/at-job-fifo; exit 1) - @rm -f testsuite.dir/at-job-fifo - -localcheck: prereq-testsuite - @GNUCOBOL_TEST_LOCAL="1" $(TESTSUITE) $(TESTSUITEFLAGS) || (rm -f testsuite.dir/at-job-fifo; exit 1) - @rm -f testsuite.dir/at-job-fifo - -prereq-check: - @echo testing for working diff && diff - "$(TESTSUITE)" < "$(TESTSUITE)" \ - || (echo "Error: no working 'diff' in PATH" && false) - -prereq-testsuite: $(TESTSUITE) prereq-check - @rm -rf testsuite.dir - -prereq-manual: $(TESTSUITE_MANUAL) prereq-check - @rm -rf testsuite_manual.dir - -clean-local: - rm -rf *.dir *.log - -checkmanual: prereq-manual - @$(TESTSUITE_MANUAL) $(TESTSUITEFLAGS) || (rm -f testsuite_manual.dir/at-job-fifo; exit 1) - @rm -f testsuite_manual.dir/at-job-fifo - -# targets that are only logical targets instead of files -.PHONY: test checkall checkmanual localcheck \ - prereq-check prereq-testsuite prereq-manual - -test: - @echo testing for perl && perl -v 1>/dev/null \ - || (echo "Error: no working 'perl' in PATH" && false) - cd cobol85 && $(MAKE) $(AM_MAKEFLAGS) test - -checkall: check test - -$(srcdir)/package.m4: $(top_srcdir)/configure.ac - @echo "creating $(srcdir)/package.m4" - @{ \ - echo '# Signature of the current package.'; \ - echo 'm4_define([AT_PACKAGE_NAME], [@PACKAGE_NAME@])'; \ - echo 'm4_define([AT_PACKAGE_TARNAME], [@PACKAGE_TARNAME@])'; \ - echo 'm4_define([AT_PACKAGE_VERSION], [@PACKAGE_VERSION@])'; \ - echo 'm4_define([AT_PACKAGE_STRING], [@PACKAGE_STRING@])'; \ - echo 'm4_define([AT_PACKAGE_BUGREPORT], [@PACKAGE_BUGREPORT@])'; \ - echo 'm4_define([AT_PACKAGE_URL], [@PACKAGE_URL@])'; \ - } > $(srcdir)/package.m4 - -$(TESTSUITE): $(testsuite_sources) $(srcdir)/package.m4 $(srcdir)/testsuite.at - autom4te --language=autotest -I $(srcdir) -I $(srcdir)/testsuite.src -o $(srcdir)/testsuite $(srcdir)/testsuite.at - chmod +x $(srcdir)/testsuite - -$(TESTSUITE_MANUAL): $(testsuite_manual_sources) $(srcdir)/package.m4 $(srcdir)/testsuite_manual.at - autom4te --language=autotest -I $(srcdir) -I $(srcdir)/testsuite.src -o $(srcdir)/testsuite_manual $(srcdir)/testsuite_manual.at - chmod +x $(srcdir)/testsuite_manual - -# Tell versions [3.59,3.63) of GNU make to not export all variables. -# Otherwise a system limit (for SysV at least) may be exceeded. -.NOEXPORT: diff -Nru gnucobol-4.0~early~20200606/tests/package.m4 gnucobol-5/tests/package.m4 --- gnucobol-4.0~early~20200606/tests/package.m4 2020-06-06 20:53:03.000000000 +0000 +++ gnucobol-5/tests/package.m4 1970-01-01 00:00:00.000000000 +0000 @@ -1,7 +0,0 @@ -# Signature of the current package. -m4_define([AT_PACKAGE_NAME], [GnuCOBOL]) -m4_define([AT_PACKAGE_TARNAME], [gnucobol]) -m4_define([AT_PACKAGE_VERSION], [4.0-early-dev]) -m4_define([AT_PACKAGE_STRING], [GnuCOBOL 4.0-early-dev]) -m4_define([AT_PACKAGE_BUGREPORT], [bug-gnucobol@gnu.org]) -m4_define([AT_PACKAGE_URL], [https://www.gnu.org/software/gnucobol/]) diff -Nru gnucobol-4.0~early~20200606/tests/run_prog_manual.sh.in gnucobol-5/tests/run_prog_manual.sh.in --- gnucobol-4.0~early~20200606/tests/run_prog_manual.sh.in 2020-06-06 20:52:00.000000000 +0000 +++ gnucobol-5/tests/run_prog_manual.sh.in 1970-01-01 00:00:00.000000000 +0000 @@ -1,93 +0,0 @@ -#! /bin/sh -# -# run_prog_manual.sh gnucobol/tests -# -# Copyright (C) 2014-2020 Free Software Foundation, Inc. -# Written by Edward Hart, Simon Sobisch -# -# This file is part of GnuCOBOL. -# -# The GnuCOBOL compiler is free software: you can redistribute it -# and/or modify it under the terms of the GNU General Public License -# as published by the Free Software Foundation, either version 3 of the -# License, or (at your option) any later version. -# -# GnuCOBOL is distributed in the hope that it will be useful, -# but WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -# GNU General Public License for more details. -# -# You should have received a copy of the GNU General Public License -# along with GnuCOBOL. If not, see . - -# Running test program "prog" in a detached terminal and pass its return -# code to the testsuite after the terminal ends. - -# You may change run_prog_manual.sh according to you needs, especially -# if you want to use a different terminal/terminal manager than xterm/screen -# or different options for these. - -abs_top_builddir="@abs_top_builddir@" - -TIMEOUT=40 # timeout in seconds - -#SLEEP_SCALE=1 # always possible -SLEEP_SCALE=0.1 # needs a "modern" sleep implementation - -_test_with_xterm () { - xterm -T 'GnuCOBOL Manual Test Run' \ - -fa 'Liberation Mono' -fs 14 \ - -e "bash -c \"(\$COBCRUN_DIRECT $1 2>./syserr.log && echo \$? > ./result) || echo 1 > ./result\"" -} - - -# Note: when using screen manager you have to -# run `screen -r "GCTESTS"` in a separate terminal -# within 5 seconds after starting the tests -_test_with_screen () { - # check if screen session already exists, setup if not - screen -S "GCTESTS" -X select . 2>/dev/null 1>&2 - if test $? -ne 0; then - screen -dmS "GCTESTS" - screen -S "GCTESTS" -X stuff ". \"${abs_top_builddir}/tests/atconfig\" && . \"${abs_top_builddir}/tests/atlocal\" -" - sleep 5 - fi - # run actual test in screen session - screen -S "GCTESTS" -X exec ... bash -c "cd \"$PWD\" && ($COBCRUN_DIRECT $1 2>./syserr.log && echo $? > ./result) || echo 1 > ./result" -} - -# wait TIMEOUT seconds for the result file to be available -_wait_result () { - local wait_time=$TIMEOUT - if test "x$SLEEP_SCALE" = "x0.1"; then - wait_time=$(expr $((wait_time)) \* 10) - fi - until test $((wait_time)) -eq 0 -o -f "./result"; do - sleep "$SLEEP_SCALE" - wait_time=$(expr $((wait_time)) - 1) - done - test ! $((wait_time)) -eq 0 -} - - -# actual test - -rm -f ./result ./syserr.log -if test ! -z "$DISPLAY"; then - _test_with_xterm $1 || echo $? > ./result -else - _test_with_screen $1 || echo $? > ./result -fi - -_wait_result || { - (>&2 echo "No result file after waiting for $TIMEOUT seconds!") - if test ! -z "$DISPLAY"; then - screen -S "GCTESTS" -X kill - fi - echo 124 > ./result -} -if test -f ./syserr.log; then - (>&2 cat ./syserr.log) -fi -exit "$(cat ./result)" diff -Nru gnucobol-4.0~early~20200606/tests/testsuite gnucobol-5/tests/testsuite --- gnucobol-4.0~early~20200606/tests/testsuite 2020-06-06 20:53:05.000000000 +0000 +++ gnucobol-5/tests/testsuite 1970-01-01 00:00:00.000000000 +0000 @@ -1,131902 +0,0 @@ -#! /bin/sh -# Generated from testsuite.at by GNU Autoconf 2.69. -# -# Test cases Copyright (C) 2020 Free Software Foundation, Inc. -# -# Written by Keisuke Nishida, Roger While, Simon Sobisch, Edward Hart, -# Ron Norman, Brian Tiffin, Dave Pitts -# -# Copyright (C) 2009-2012 Free Software Foundation, Inc. -# -# This test suite is free software; the Free Software Foundation gives -# unlimited permission to copy, distribute and modify it. -## -------------------- ## -## M4sh Initialization. ## -## -------------------- ## - -# Be more Bourne compatible -DUALCASE=1; export DUALCASE # for MKS sh -if test -n "${ZSH_VERSION+set}" && (emulate sh) >/dev/null 2>&1; then : - emulate sh - NULLCMD=: - # Pre-4.2 versions of Zsh do word splitting on ${1+"$@"}, which - # is contrary to our usage. Disable this feature. - alias -g '${1+"$@"}'='"$@"' - setopt NO_GLOB_SUBST -else - case `(set -o) 2>/dev/null` in #( - *posix*) : - set -o posix ;; #( - *) : - ;; -esac -fi - - -as_nl=' -' -export as_nl -# Printing a long string crashes Solaris 7 /usr/bin/printf. -as_echo='\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\' -as_echo=$as_echo$as_echo$as_echo$as_echo$as_echo -as_echo=$as_echo$as_echo$as_echo$as_echo$as_echo$as_echo -# Prefer a ksh shell builtin over an external printf program on Solaris, -# but without wasting forks for bash or zsh. -if test -z "$BASH_VERSION$ZSH_VERSION" \ - && (test "X`print -r -- $as_echo`" = "X$as_echo") 2>/dev/null; then - as_echo='print -r --' - as_echo_n='print -rn --' -elif (test "X`printf %s $as_echo`" = "X$as_echo") 2>/dev/null; then - as_echo='printf %s\n' - as_echo_n='printf %s' -else - if test "X`(/usr/ucb/echo -n -n $as_echo) 2>/dev/null`" = "X-n $as_echo"; then - as_echo_body='eval /usr/ucb/echo -n "$1$as_nl"' - as_echo_n='/usr/ucb/echo -n' - else - as_echo_body='eval expr "X$1" : "X\\(.*\\)"' - as_echo_n_body='eval - arg=$1; - case $arg in #( - *"$as_nl"*) - expr "X$arg" : "X\\(.*\\)$as_nl"; - arg=`expr "X$arg" : ".*$as_nl\\(.*\\)"`;; - esac; - expr "X$arg" : "X\\(.*\\)" | tr -d "$as_nl" - ' - export as_echo_n_body - as_echo_n='sh -c $as_echo_n_body as_echo' - fi - export as_echo_body - as_echo='sh -c $as_echo_body as_echo' -fi - -# The user is always right. -if test "${PATH_SEPARATOR+set}" != set; then - PATH_SEPARATOR=: - (PATH='/bin;/bin'; FPATH=$PATH; sh -c :) >/dev/null 2>&1 && { - (PATH='/bin:/bin'; FPATH=$PATH; sh -c :) >/dev/null 2>&1 || - PATH_SEPARATOR=';' - } -fi - - -# IFS -# We need space, tab and new line, in precisely that order. Quoting is -# there to prevent editors from complaining about space-tab. -# (If _AS_PATH_WALK were called with IFS unset, it would disable word -# splitting by setting IFS to empty value.) -IFS=" "" $as_nl" - -# Find who we are. Look in the path if we contain no directory separator. -as_myself= -case $0 in #(( - *[\\/]* ) as_myself=$0 ;; - *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR -for as_dir in $PATH -do - IFS=$as_save_IFS - test -z "$as_dir" && as_dir=. - test -r "$as_dir/$0" && as_myself=$as_dir/$0 && break - done -IFS=$as_save_IFS - - ;; -esac -# We did not find ourselves, most probably we were run as `sh COMMAND' -# in which case we are not to be found in the path. -if test "x$as_myself" = x; then - as_myself=$0 -fi -if test ! -f "$as_myself"; then - $as_echo "$as_myself: error: cannot find myself; rerun with an absolute file name" >&2 - exit 1 -fi - -# Unset variables that we do not need and which cause bugs (e.g. in -# pre-3.0 UWIN ksh). But do not cause bugs in bash 2.01; the "|| exit 1" -# suppresses any "Segmentation fault" message there. '((' could -# trigger a bug in pdksh 5.2.14. -for as_var in BASH_ENV ENV MAIL MAILPATH -do eval test x\${$as_var+set} = xset \ - && ( (unset $as_var) || exit 1) >/dev/null 2>&1 && unset $as_var || : -done -PS1='$ ' -PS2='> ' -PS4='+ ' - -# NLS nuisances. -LC_ALL=C -export LC_ALL -LANGUAGE=C -export LANGUAGE - -# CDPATH. -(unset CDPATH) >/dev/null 2>&1 && unset CDPATH - -if test "x$CONFIG_SHELL" = x; then - as_bourne_compatible="if test -n \"\${ZSH_VERSION+set}\" && (emulate sh) >/dev/null 2>&1; then : - emulate sh - NULLCMD=: - # Pre-4.2 versions of Zsh do word splitting on \${1+\"\$@\"}, which - # is contrary to our usage. Disable this feature. - alias -g '\${1+\"\$@\"}'='\"\$@\"' - setopt NO_GLOB_SUBST -else - case \`(set -o) 2>/dev/null\` in #( - *posix*) : - set -o posix ;; #( - *) : - ;; -esac -fi -" - as_required="as_fn_return () { (exit \$1); } -as_fn_success () { as_fn_return 0; } -as_fn_failure () { as_fn_return 1; } -as_fn_ret_success () { return 0; } -as_fn_ret_failure () { return 1; } - -exitcode=0 -as_fn_success || { exitcode=1; echo as_fn_success failed.; } -as_fn_failure && { exitcode=1; echo as_fn_failure succeeded.; } -as_fn_ret_success || { exitcode=1; echo as_fn_ret_success failed.; } -as_fn_ret_failure && { exitcode=1; echo as_fn_ret_failure succeeded.; } -if ( set x; as_fn_ret_success y && test x = \"\$1\" ); then : - -else - exitcode=1; echo positional parameters were not saved. -fi -test x\$exitcode = x0 || exit 1 -test -x / || exit 1" - as_suggested=" as_lineno_1=";as_suggested=$as_suggested$LINENO;as_suggested=$as_suggested" as_lineno_1a=\$LINENO - as_lineno_2=";as_suggested=$as_suggested$LINENO;as_suggested=$as_suggested" as_lineno_2a=\$LINENO - eval 'test \"x\$as_lineno_1'\$as_run'\" != \"x\$as_lineno_2'\$as_run'\" && - test \"x\`expr \$as_lineno_1'\$as_run' + 1\`\" = \"x\$as_lineno_2'\$as_run'\"' || exit 1 -test \$(( 1 + 1 )) = 2 || exit 1" - if (eval "$as_required") 2>/dev/null; then : - as_have_required=yes -else - as_have_required=no -fi - if test x$as_have_required = xyes && (eval "$as_suggested") 2>/dev/null; then : - -else - as_save_IFS=$IFS; IFS=$PATH_SEPARATOR -as_found=false -for as_dir in /bin$PATH_SEPARATOR/usr/bin$PATH_SEPARATOR$PATH -do - IFS=$as_save_IFS - test -z "$as_dir" && as_dir=. - as_found=: - case $as_dir in #( - /*) - for as_base in sh bash ksh sh5; do - # Try only shells that exist, to save several forks. - as_shell=$as_dir/$as_base - if { test -f "$as_shell" || test -f "$as_shell.exe"; } && - { $as_echo "$as_bourne_compatible""$as_required" | as_run=a "$as_shell"; } 2>/dev/null; then : - CONFIG_SHELL=$as_shell as_have_required=yes - if { $as_echo "$as_bourne_compatible""$as_suggested" | as_run=a "$as_shell"; } 2>/dev/null; then : - break 2 -fi -fi - done;; - esac - as_found=false -done -$as_found || { if { test -f "$SHELL" || test -f "$SHELL.exe"; } && - { $as_echo "$as_bourne_compatible""$as_required" | as_run=a "$SHELL"; } 2>/dev/null; then : - CONFIG_SHELL=$SHELL as_have_required=yes -fi; } -IFS=$as_save_IFS - - - if test "x$CONFIG_SHELL" != x; then : - export CONFIG_SHELL - # We cannot yet assume a decent shell, so we have to provide a -# neutralization value for shells without unset; and this also -# works around shells that cannot unset nonexistent variables. -# Preserve -v and -x to the replacement shell. -BASH_ENV=/dev/null -ENV=/dev/null -(unset BASH_ENV) >/dev/null 2>&1 && unset BASH_ENV ENV -case $- in # (((( - *v*x* | *x*v* ) as_opts=-vx ;; - *v* ) as_opts=-v ;; - *x* ) as_opts=-x ;; - * ) as_opts= ;; -esac -exec $CONFIG_SHELL $as_opts "$as_myself" ${1+"$@"} -# Admittedly, this is quite paranoid, since all the known shells bail -# out after a failed `exec'. -$as_echo "$0: could not re-execute with $CONFIG_SHELL" >&2 -exit 255 -fi - - if test x$as_have_required = xno; then : - $as_echo "$0: This script requires a shell more modern than all" - $as_echo "$0: the shells that I found on your system." - if test x${ZSH_VERSION+set} = xset ; then - $as_echo "$0: In particular, zsh $ZSH_VERSION has bugs and should" - $as_echo "$0: be upgraded to zsh 4.3.4 or later." - else - $as_echo "$0: Please tell bug-autoconf@gnu.org about your system, -$0: including any error possibly output before this -$0: message. Then install a modern shell, or manually run -$0: the script under such a shell if you do have one." - fi - exit 1 -fi -fi -fi -SHELL=${CONFIG_SHELL-/bin/sh} -export SHELL -# Unset more variables known to interfere with behavior of common tools. -CLICOLOR_FORCE= GREP_OPTIONS= -unset CLICOLOR_FORCE GREP_OPTIONS - -## --------------------- ## -## M4sh Shell Functions. ## -## --------------------- ## -# as_fn_unset VAR -# --------------- -# Portably unset VAR. -as_fn_unset () -{ - { eval $1=; unset $1;} -} -as_unset=as_fn_unset - -# as_fn_set_status STATUS -# ----------------------- -# Set $? to STATUS, without forking. -as_fn_set_status () -{ - return $1 -} # as_fn_set_status - -# as_fn_exit STATUS -# ----------------- -# Exit the shell with STATUS, even in a "trap 0" or "set -e" context. -as_fn_exit () -{ - set +e - as_fn_set_status $1 - exit $1 -} # as_fn_exit - -# as_fn_mkdir_p -# ------------- -# Create "$as_dir" as a directory, including parents if necessary. -as_fn_mkdir_p () -{ - - case $as_dir in #( - -*) as_dir=./$as_dir;; - esac - test -d "$as_dir" || eval $as_mkdir_p || { - as_dirs= - while :; do - case $as_dir in #( - *\'*) as_qdir=`$as_echo "$as_dir" | sed "s/'/'\\\\\\\\''/g"`;; #'( - *) as_qdir=$as_dir;; - esac - as_dirs="'$as_qdir' $as_dirs" - as_dir=`$as_dirname -- "$as_dir" || -$as_expr X"$as_dir" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \ - X"$as_dir" : 'X\(//\)[^/]' \| \ - X"$as_dir" : 'X\(//\)$' \| \ - X"$as_dir" : 'X\(/\)' \| . 2>/dev/null || -$as_echo X"$as_dir" | - sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{ - s//\1/ - q - } - /^X\(\/\/\)[^/].*/{ - s//\1/ - q - } - /^X\(\/\/\)$/{ - s//\1/ - q - } - /^X\(\/\).*/{ - s//\1/ - q - } - s/.*/./; q'` - test -d "$as_dir" && break - done - test -z "$as_dirs" || eval "mkdir $as_dirs" - } || test -d "$as_dir" || as_fn_error $? "cannot create directory $as_dir" - - -} # as_fn_mkdir_p - -# as_fn_executable_p FILE -# ----------------------- -# Test if FILE is an executable regular file. -as_fn_executable_p () -{ - test -f "$1" && test -x "$1" -} # as_fn_executable_p -# as_fn_append VAR VALUE -# ---------------------- -# Append the text in VALUE to the end of the definition contained in VAR. Take -# advantage of any shell optimizations that allow amortized linear growth over -# repeated appends, instead of the typical quadratic growth present in naive -# implementations. -if (eval "as_var=1; as_var+=2; test x\$as_var = x12") 2>/dev/null; then : - eval 'as_fn_append () - { - eval $1+=\$2 - }' -else - as_fn_append () - { - eval $1=\$$1\$2 - } -fi # as_fn_append - -# as_fn_arith ARG... -# ------------------ -# Perform arithmetic evaluation on the ARGs, and store the result in the -# global $as_val. Take advantage of shells that can avoid forks. The arguments -# must be portable across $(()) and expr. -if (eval "test \$(( 1 + 1 )) = 2") 2>/dev/null; then : - eval 'as_fn_arith () - { - as_val=$(( $* )) - }' -else - as_fn_arith () - { - as_val=`expr "$@" || test $? -eq 1` - } -fi # as_fn_arith - - -# as_fn_error STATUS ERROR [LINENO LOG_FD] -# ---------------------------------------- -# Output "`basename $0`: error: ERROR" to stderr. If LINENO and LOG_FD are -# provided, also output the error to LOG_FD, referencing LINENO. Then exit the -# script with STATUS, using 1 if that was 0. -as_fn_error () -{ - as_status=$1; test $as_status -eq 0 && as_status=1 - if test "$4"; then - as_lineno=${as_lineno-"$3"} as_lineno_stack=as_lineno_stack=$as_lineno_stack - $as_echo "$as_me:${as_lineno-$LINENO}: error: $2" >&$4 - fi - $as_echo "$as_me: error: $2" >&2 - as_fn_exit $as_status -} # as_fn_error - -if expr a : '\(a\)' >/dev/null 2>&1 && - test "X`expr 00001 : '.*\(...\)'`" = X001; then - as_expr=expr -else - as_expr=false -fi - -if (basename -- /) >/dev/null 2>&1 && test "X`basename -- / 2>&1`" = "X/"; then - as_basename=basename -else - as_basename=false -fi - -as_me=`$as_basename -- "$0" || -$as_expr X/"$0" : '.*/\([^/][^/]*\)/*$' \| \ - X"$0" : 'X\(//\)$' \| \ - X"$0" : 'X\(/\)' \| . 2>/dev/null || -$as_echo X/"$0" | - sed '/^.*\/\([^/][^/]*\)\/*$/{ - s//\1/ - q - } - /^X\/\(\/\/\)$/{ - s//\1/ - q - } - /^X\/\(\/\).*/{ - s//\1/ - q - } - s/.*/./; q'` - -if (as_dir=`dirname -- /` && test "X$as_dir" = X/) >/dev/null 2>&1; then - as_dirname=dirname -else - as_dirname=false -fi - -# Avoid depending upon Character Ranges. -as_cr_letters='abcdefghijklmnopqrstuvwxyz' -as_cr_LETTERS='ABCDEFGHIJKLMNOPQRSTUVWXYZ' -as_cr_Letters=$as_cr_letters$as_cr_LETTERS -as_cr_digits='0123456789' -as_cr_alnum=$as_cr_Letters$as_cr_digits - - - as_lineno_1=$LINENO as_lineno_1a=$LINENO - as_lineno_2=$LINENO as_lineno_2a=$LINENO - eval 'test "x$as_lineno_1'$as_run'" != "x$as_lineno_2'$as_run'" && - test "x`expr $as_lineno_1'$as_run' + 1`" = "x$as_lineno_2'$as_run'"' || { - # Blame Lee E. McMahon (1931-1989) for sed's syntax. :-) - sed -n ' - p - /[$]LINENO/= - ' <$as_myself | - sed ' - s/[$]LINENO.*/&-/ - t lineno - b - :lineno - N - :loop - s/[$]LINENO\([^'$as_cr_alnum'_].*\n\)\(.*\)/\2\1\2/ - t loop - s/-\n.*// - ' >$as_me.lineno && - chmod +x "$as_me.lineno" || - { $as_echo "$as_me: error: cannot create $as_me.lineno; rerun with a POSIX shell" >&2; as_fn_exit 1; } - - # If we had to re-execute with $CONFIG_SHELL, we're ensured to have - # already done that, so ensure we don't try to do so again and fall - # in an infinite loop. This has already happened in practice. - _as_can_reexec=no; export _as_can_reexec - # Don't try to exec as it changes $[0], causing all sort of problems - # (the dirname of $[0] is not the place where we might find the - # original and so on. Autoconf is especially sensitive to this). - . "./$as_me.lineno" - # Exit status is that of the last command. - exit -} - -ECHO_C= ECHO_N= ECHO_T= -case `echo -n x` in #((((( --n*) - case `echo 'xy\c'` in - *c*) ECHO_T=' ';; # ECHO_T is single tab character. - xy) ECHO_C='\c';; - *) echo `echo ksh88 bug on AIX 6.1` > /dev/null - ECHO_T=' ';; - esac;; -*) - ECHO_N='-n';; -esac - -rm -f conf$$ conf$$.exe conf$$.file -if test -d conf$$.dir; then - rm -f conf$$.dir/conf$$.file -else - rm -f conf$$.dir - mkdir conf$$.dir 2>/dev/null -fi -if (echo >conf$$.file) 2>/dev/null; then - if ln -s conf$$.file conf$$ 2>/dev/null; then - as_ln_s='ln -s' - # ... but there are two gotchas: - # 1) On MSYS, both `ln -s file dir' and `ln file dir' fail. - # 2) DJGPP < 2.04 has no symlinks; `ln -s' creates a wrapper executable. - # In both cases, we have to default to `cp -pR'. - ln -s conf$$.file conf$$.dir 2>/dev/null && test ! -f conf$$.exe || - as_ln_s='cp -pR' - elif ln conf$$.file conf$$ 2>/dev/null; then - as_ln_s=ln - else - as_ln_s='cp -pR' - fi -else - as_ln_s='cp -pR' -fi -rm -f conf$$ conf$$.exe conf$$.dir/conf$$.file conf$$.file -rmdir conf$$.dir 2>/dev/null - -if mkdir -p . 2>/dev/null; then - as_mkdir_p='mkdir -p "$as_dir"' -else - test -d ./-p && rmdir ./-p - as_mkdir_p=false -fi - -as_test_x='test -x' -as_executable_p=as_fn_executable_p - -# Sed expression to map a string onto a valid CPP name. -as_tr_cpp="eval sed 'y%*$as_cr_letters%P$as_cr_LETTERS%;s%[^_$as_cr_alnum]%_%g'" - -# Sed expression to map a string onto a valid variable name. -as_tr_sh="eval sed 'y%*+%pp%;s%[^_$as_cr_alnum]%_%g'" - - - - - -SHELL=${CONFIG_SHELL-/bin/sh} - -# How were we run? -at_cli_args="$@" - - -# Not all shells have the 'times' builtin; the subshell is needed to make -# sure we discard the 'times: not found' message from the shell. -at_times_p=false -(times) >/dev/null 2>&1 && at_times_p=: - -# CLI Arguments to pass to the debugging scripts. -at_debug_args= -# -e sets to true -at_errexit_p=false -# Shall we be verbose? ':' means no, empty means yes. -at_verbose=: -at_quiet= -# Running several jobs in parallel, 0 means as many as test groups. -at_jobs=1 -at_traceon=: -at_trace_echo=: -at_check_filter_trace=: - -# Shall we keep the debug scripts? Must be `:' when the suite is -# run by a debug script, so that the script doesn't remove itself. -at_debug_p=false -# Display help message? -at_help_p=false -# Display the version message? -at_version_p=false -# List test groups? -at_list_p=false -# --clean -at_clean=false -# Test groups to run -at_groups= -# Whether to rerun failed tests. -at_recheck= -# Whether a write failure occurred -at_write_fail=0 - -# The directory we run the suite in. Default to . if no -C option. -at_dir=`pwd` -# An absolute reference to this testsuite script. -case $as_myself in - [\\/]* | ?:[\\/]* ) at_myself=$as_myself ;; - * ) at_myself=$at_dir/$as_myself ;; -esac -# Whether -C is in effect. -at_change_dir=false - -# Whether to enable colored test results. -at_color=auto -# List of the tested programs. -at_tested='cobc -cobcrun' -# As many question marks as there are digits in the last test group number. -# Used to normalize the test group numbers so that `ls' lists them in -# numerical order. -at_format='????' -# Description of all the test groups. -at_help_all="1;used_binaries.at:27;Compiler help and information;runmisc cobc; -2;used_binaries.at:46;Compiler outputs (general);runmisc cobc; -3;used_binaries.at:86;Compiler outputs (file specified);runmisc cobc; -4;used_binaries.at:114;Compiler outputs (path specified);runmisc cobc; -5;used_binaries.at:143;Compiler outputs (assembler);runmisc cobc; -6;used_binaries.at:178;Source file not found;cobc runmisc; -7;used_binaries.at:188;Temporary path invalid;cobc runmisc; -8;used_binaries.at:223;Using full path for cobc;runmisc; -9;used_binaries.at:241;C Compiler optimizations;runmisc cobc optimization; -10;used_binaries.at:278;Invalid cobc option;runmisc cobc; -11;used_binaries.at:302;cobcrun help and information;runmisc cobcrun; -12;used_binaries.at:312;cobcrun validation;runmisc; -13;used_binaries.at:352;cobcrun -M DSO entry argument;runmisc; -14;used_binaries.at:412;cobcrun -M directory/ default;runmisc; -15;used_binaries.at:451;cobcrun -M directory/dso alternate;runmisc; -16;used_binaries.at:502;cobcrun -M DSO entry multiple arguments;runmisc; -17;used_binaries.at:547;cobcrun error messages;runmisc; -18;used_binaries.at:570;Compile from stdin;runmisc stdin; -19;used_binaries.at:591;Run job after compilation;runmisc job; -20;used_binaries.at:610;Run job after compilation (path specified);runmisc job; -21;used_binaries.at:630;Run job with optional arguments;runmisc job; -22;configuration.at:22;cobc with standard configuration file;configuration misc; -23;configuration.at:43;cobc dialect features for all -std;configuration misc; -24;configuration.at:101;cobc with configuration file via -std;configuration misc; -25;configuration.at:122;cobc with standard configuration file via -conf;configuration misc; -26;configuration.at:143;cobc with own configuration file via -conf;configuration misc; -27;configuration.at:172;cobc configuration: recursive include;configuration misc; -28;configuration.at:210;cobc with -std and -conf;configuration misc; -29;configuration.at:237;cobc compiler flag on command line;configuration misc; -30;configuration.at:256;cobc compiler flag on command line (priority);configuration misc; -31;configuration.at:289;cobc configuration: entries;configuration misc; -32;configuration.at:336;cobc configuration: conf missing;configuration misc; -33;configuration.at:364;cobc configuration: conf optional;configuration misc; -34;configuration.at:400;cobc configuration: incomplete;configuration misc; -35;configuration.at:526;runtime configuration;configuration misc; -36;configuration.at:545;runtime configuration file;configuration misc; -37;configuration.at:588;runtime configuration: recursive include;configuration misc; -38;configuration.at:617;runtime configuration: environment priority;configuration misc; -39;configuration.at:630;runtime configuration: entries;configuration misc; -40;configuration.at:711;runtime configuration: conf missing;configuration misc; -41;configuration.at:740;runtime configuration: conf optional;configuration misc; -42;configuration.at:753;runtime configuration: strings and environment;configuration environment variable; -43;configuration.at:765;validation of COB_CONFIG_DIR;runtime configuration environment variable; -44;syn_copy.at:21;COPY: within comment;copy; -45;syn_copy.at:50;COPY: file not found;copy case fold-copy; -46;syn_copy.at:106;COPY: recursive;copy; -47;syn_copy.at:146;COPY: replacement order;copy; -48;syn_copy.at:173;COPY: separators;copy; -49;syn_copy.at:202;COPY: partial replacement;copy; -50;syn_copy.at:232;COPY: LEADING replacement;copy; -51;syn_copy.at:262;COPY: TRAILING replacement;copy; -52;syn_copy.at:292;COPY: recursive replacement;copy; -53;syn_copy.at:322;COPY: fixed/free format;copy; -54;syn_definition.at:25;Invalid source name;definition; -55;syn_definition.at:37;Invalid PROGRAM-ID;definition; -56;syn_definition.at:54;Invalid PROGRAM-ID type clause (1);definition; -57;syn_definition.at:71;invalid PROGRAM-ID type clause (2);definition; -58;syn_definition.at:88;INITIAL / RECURSIVE before COMMON;program-id definition; -59;syn_definition.at:120;Undefined data name;definition; -60;syn_definition.at:139;Undefined group name;definition; -61;syn_definition.at:161;Undefined data name in group;definition; -62;syn_definition.at:185;Reference not a group name;definition; -63;syn_definition.at:207;Incomplete 01 definition;definition; -64;syn_definition.at:225;error handling in conditions;definition; -65;syn_definition.at:299;Same labels in different sections;definition; -66;syn_definition.at:324;Redefinition of 01 items;definition; -67;syn_definition.at:346;Redefinition of 01 and 02 items;definition; -68;syn_definition.at:366;Redefinition of 02 items;definition; -69;syn_definition.at:387;Redefinition of 77 items;definition; -70;syn_definition.at:407;Redefinition of 01 and 77 items;definition; -71;syn_definition.at:427;Redefinition of 88 items;definition; -72;syn_definition.at:448;Redefinition of program-name by other programs;definition; -73;syn_definition.at:528;Redefinition of program-name within program;definition; -74;syn_definition.at:558;Redefinition of function-prototype name;definition; -75;syn_definition.at:583;PROCEDURE DIVISION RETURNING OMITTED: main;runmisc; -76;syn_definition.at:603;PROCEDURE DIVISION RETURNING OMITTED: FUNCTION;runmisc; -77;syn_definition.at:622;PROCEDURE DIVISION RETURNING item;runmisc; -78;syn_definition.at:717;Data item with same name as program-name;definition; -79;syn_definition.at:744;Ambiguous reference to 02 items;definition; -80;syn_definition.at:771;Ambiguous reference to 02 and 03 items;definition; -81;syn_definition.at:797;Ambiguous reference with qualification;definition; -82;syn_definition.at:826;Unique reference with ambiguous qualifiers;definition; -83;syn_definition.at:851;SYNCHRONIZED clause;definition sync; -84;syn_definition.at:893;Undefined procedure name;definition; -85;syn_definition.at:913;Redefinition of section names;definition; -86;syn_definition.at:938;Redefinition of section and paragraph names;definition; -87;syn_definition.at:964;Redefinition of label and variable names;definition; -88;syn_definition.at:1001;Redefinition of paragraph names;definition; -89;syn_definition.at:1027;Ambiguous reference to paragraph name;definition; -90;syn_definition.at:1053;Non-matching level numbers (extension);definition; -91;syn_definition.at:1077;CALL BY VALUE alphanumeric item (extension);definition; -92;syn_definition.at:1099;CALL BY VALUE national item (extension);definition; -93;syn_definition.at:1122;CALL BY VALUE figurative constants;definition; -94;syn_definition.at:1156;Duplicate identification division header;definition; -95;syn_definition.at:1171;RETURNING in STOP RUN / GOBACK / EXIT PROGRAM;definition return-code; -96;syn_definition.at:1222;Invalid ENVIRONMENT DIVISION order;definition; -97;syn_definition.at:1247;Function without END FUNCTION;definition functions; -98;syn_definition.at:1261;Nested programs without END PROGRAM;definition; -99;syn_definition.at:1283;Nested programs not in procedure division;definition; -100;syn_definition.at:1302;Screen section starts with 78-level;screen definition; -101;syn_definition.at:1318;Invalid PICTURE strings;definition usage; -102;syn_definition.at:1578;PICTURE strings invalid with BLANK WHEN ZERO;definition; -103;syn_definition.at:1601;PICTURE strings invalid with USAGE;definition; -104;syn_definition.at:1621;ALPHABET definition;definition; -105;syn_definition.at:1644;PROGRAM COLLATING SEQUENCE;definition alphabet; -106;syn_definition.at:1827;RENAMES item;definition 66; -107;syn_definition.at:1901;RENAMES of 01-, 66- and 77-level items;definition 66 extensions; -108;syn_definition.at:1927;SAME AS clause;definition external global; -109;syn_definition.at:1991;APPLY COMMIT clause;definition i-o-control rollback; -110;syn_subscripts.at:23;Non-numeric subscript;subscripts; -111;syn_subscripts.at:50;Subscript range check;subscripts; -112;syn_subscripts.at:91;Subscript bounds with OCCURS DEPENDING ON;runsubscripts subscripts odo; -113;syn_subscripts.at:118;Subscripted item requires OCCURS clause;subscripts; -114;syn_subscripts.at:144;Number of subscripts;subscripts; -115;syn_occurs.at:29;OCCURS with level 01 and 77;; -116;syn_occurs.at:84;OCCURS with level 66;renames; -117;syn_occurs.at:103;OCCURS with level 78;; -118;syn_occurs.at:121;OCCURS with level 88;; -119;syn_occurs.at:141;OCCURS with variable-occurrence data item;nested depending extensions odo; -120;syn_occurs.at:189;OCCURS data-items for INDEXED and KEY;ascending descending; -121;syn_occurs.at:229;Nested OCCURS clause;; -122;syn_occurs.at:266;OCCURS DEPENDING with wrong size;range; -123;syn_occurs.at:305;OCCURS DEPENDING followed by another field;extensions; -124;syn_occurs.at:347;OCCURS with unmatched DEPENDING / TO phrases;odo; -125;syn_occurs.at:390;OCCURS INDEXED before KEY;ascending descending; -126;syn_occurs.at:428;OCCURS size check;limit; -127;syn_occurs.at:454;ODO not Fixed Loc;odo; -128;syn_redefines.at:28;REDEFINES: not following entry-name;redefines; -129;syn_redefines.at:53;REDEFINES: level 02 by 01;redefines; -130;syn_redefines.at:74;REDEFINES: level 03 by 02;redefines; -131;syn_redefines.at:96;REDEFINES: level 66;redefines; -132;syn_redefines.at:118;REDEFINES: level 88;redefines; -133;syn_redefines.at:147;REDEFINES: lower level number;redefines; -134;syn_redefines.at:173;REDEFINES: with OCCURS;redefines; -135;syn_redefines.at:194;REDEFINES: with subscript;redefines; -136;syn_redefines.at:216;REDEFINES: with variable occurrence;redefines; -137;syn_redefines.at:251;REDEFINES: with qualification;redefines; -138;syn_redefines.at:277;REDEFINES: multiple redefinition;redefines; -139;syn_redefines.at:305;REDEFINES: size exceeds;redefines; -140;syn_redefines.at:338;REDEFINES: with VALUE;redefines; -141;syn_redefines.at:370;REDEFINES: with intervention;redefines; -142;syn_redefines.at:399;REDEFINES: within REDEFINES;redefines; -143;syn_redefines.at:419;REDEFINES: non-referenced ambiguous item;redefines; -144;syn_value.at:43;Numeric item (integer);value size; -145;syn_value.at:70;Numeric item (non-integer);value size; -146;syn_value.at:94;Numeric item with picture P;value size; -147;syn_value.at:126;Signed numeric literal;value; -148;syn_value.at:152;Alphabetic item;value size; -149;syn_value.at:179;Alphanumeric item;value size; -150;syn_value.at:204;Alphanumeric group item;value size; -151;syn_value.at:239;Numeric-edited item;value editing size; -152;syn_value.at:272;Alphanumeric-edited item;value editing size; -153;syn_value.at:340;Implicit picture from value;value; -154;syn_file.at:23;Missing SELECT;file; -155;syn_file.at:50;Duplicated SELECT;file; -156;syn_file.at:81;Missing FD;file; -157;syn_file.at:107;Duplicated FD;file; -158;syn_file.at:136;ASSIGN to device-name;file disk device; -159;syn_file.at:203;ASSIGN to printer-name;file printer print device; -160;syn_file.at:270;ASSIGN to lsq-device-name;file printer device; -161;syn_file.at:325;ASSIGN to variable;file; -162;syn_file.at:432;SELECT without ASSIGN;file; -163;syn_file.at:460;START on SEQUENTIAL file;file; -164;syn_file.at:497;OPEN SEQUENTIAL file REVERSED;file; -165;syn_file.at:545;OPEN SEQUENTIAL file NO REWIND;file; -166;syn_file.at:584;valid key items;file record alternate; -167;syn_file.at:634;INDEXED file invalid key items;record alternate split; -168;syn_file.at:698;variable record length;file; -169;syn_file.at:809;variable record length DEPENDING item;file; -170;syn_file.at:883;DECLARATIVES invalid procedure reference (1);file; -171;syn_file.at:972;DECLARATIVES invalid procedure reference (2);file; -172;syn_file.at:1013;EXTERNAL file;file; -173;syn_file.at:1041;RECORDING MODE;file extensions; -174;syn_file.at:1070;CODE-SET clause;file; -175;syn_file.at:1104;CODE-SET FOR clause;file extensions; -176;syn_file.at:1138;WRITE / REWRITE FROM clause and FILE;file record condition-name level-88 88; -177;syn_file.at:1199;Clauses following invalid ACCESS clause;file; -178;syn_file.at:1224;RELATIVE KEY type checks;relative file; -179;syn_file.at:1284;Mismatched KEY clause;file relative indexed; -180;syn_file.at:1311;RECORD DELIMITER;file; -181;syn_file.at:1422;FILE STATUS;file status; -182;syn_file.at:1472;INDEXED file PASSWORD clause;file external split key; -183;syn_file.at:1523;RECORD clause equal limits;file; -184;syn_file.at:1563;FILE ... FROM literal;file; -185;syn_file.at:1622;WRITE / REWRITE on LINE SEQUENTIAL files;file; -186;syn_file.at:1658;WRITE / REWRITE on REPORT files;file; -187;syn_file.at:1695;SELECT without fd-name;file; -188;syn_file.at:1714;Undeclared FILE-ID variable;file; -189;syn_file.at:1739;Undeclared FILE STATUS variable;file; -190;syn_file.at:1764;FILE STATUS field subordinate to FD;file; -191;syn_file.at:1793;FILE STATUS not PIC XX;file; -192;syn_file.at:1832;DELETE with LINE SEQUENTIAL;file; -193;syn_file.at:1859;DELETE with SEQUENTIAL;file; -194;syn_file.at:1885;ACCESS RANDOM with ORG SEQUENTIAL;file; -195;syn_file.at:1912;ALTERNATE RECORD KEY SUPPRESS WHEN;file; -196;syn_file.at:1957;RECORD definition with SOURCE IS / =;file; -197;syn_file.at:2008;ALTERNATE RECORD definition WITH NO DUPLICATES;file; -198;syn_file.at:2041;ALTERNATE RECORD definition omitting RECORD;file; -199;syn_file.at:2072;SELECT/OPEN syntax extensions;file select open mass-update bulk-addition lock; -200;syn_file.at:2167;GLOBAL FD nested progam;file; -201;syn_file.at:2205;XFD directive and creation;file cobc sql suppress when; -202;syn_reportwriter.at:23;REPORT error/warning;report; -203;syn_reportwriter.at:125;REPORT not positive integers in COL / LINE PLUS;lines cols columns; -204;syn_reportwriter.at:178;Missing DETAIL line;report; -205;syn_reportwriter.at:221;REPORT LINE PLUS ZERO;report; -206;syn_reportwriter.at:271;Incorrect REPORT NAME;report; -207;syn_reportwriter.at:388;REPORT with PLUS RIGHT/CENTER;report; -208;syn_reportwriter.at:481;PAGE LIMITS clause;report; -209;syn_reportwriter.at:516;Report FD without period;report; -210;syn_reportwriter.at:549;REPORT with unreferenced control field;report; -211;syn_reportwriter.at:577;Incorrect USAGE clause;report; -212;syn_refmod.at:25;valid reference modification;refmod; -213;syn_refmod.at:51;Static out of bounds;refmod; -214;syn_refmod.at:95;constant-folding out of bounds;refmod expression; -215;syn_refmod.at:133;Reference Bounds check;refmod; -216;syn_misc.at:23;ambiguous AND/OR;misc expression; -217;syn_misc.at:54;warn constant expressions;misc expression; -218;syn_misc.at:87;warn literal size;misc numeric constant expression; -219;syn_misc.at:352;warn literal size in constant expr. (level 88);misc numeric constant expression; -220;syn_misc.at:402;Invalid conditional expression (1);misc; -221;syn_misc.at:515;Invalid conditional expression (2);misc; -222;syn_misc.at:571;Invalid conditional expression (3);expression condition; -223;syn_misc.at:635;Valid conditional expression;misc; -224;syn_misc.at:668;missing headers;misc; -225;syn_misc.at:718;one line program;misc; -226;syn_misc.at:737;empty program;misc; -227;syn_misc.at:783;INITIALIZE constant;misc; -228;syn_misc.at:810;CLASS duplicate values;misc; -229;syn_misc.at:843;INSPECT invalid size;misc refmod; -230;syn_misc.at:884;INSPECT invalid target;misc; -231;syn_misc.at:907;INSPECT missing keyword;misc; -232;syn_misc.at:928;INSPECT repeated keywords;misc; -233;syn_misc.at:964;INSPECT incomplete clause;misc; -234;syn_misc.at:986;INSPECT multiple BEFORE/AFTER clauses;misc; -235;syn_misc.at:1009;maximum data size;misc; -236;syn_misc.at:1038;unreachable statement;misc extensions; -237;syn_misc.at:1088;CRT STATUS;special-names misc; -238;syn_misc.at:1130;SPECIAL-NAMES clause;misc extensions cursor crt status; -239;syn_misc.at:1219;CURRENCY SIGN;special-names misc; -240;syn_misc.at:1331;SWITCHES;runmisc extensions; -241;syn_misc.at:1458;unexpected mnemonic-name location;misc; -242;syn_misc.at:1485;wrong device for mnemonic-name;misc accept display special-names; -243;syn_misc.at:1510;missing mnemonic-name declaration;misc accept special-names; -244;syn_misc.at:1531;unknown device in dialect;misc accept display special-names; -245;syn_misc.at:1561;ACCEPT WITH ( NO ) UPDATE / DEFAULT;misc extensions; -246;syn_misc.at:1586;ACCEPT WITH AUTO / TAB;auto-skip autoterminate misc extensions screen; -247;syn_misc.at:1611;ACCEPT WITH LOWER / UPPER;misc extensions screen; -248;syn_misc.at:1633;ACCEPT WITH SIZE;protected size misc extensions screen; -249;syn_misc.at:1662;DISPLAY WITH SIZE;size misc extensions screen; -250;syn_misc.at:1687;source text after program-text area;misc fixed; -251;syn_misc.at:1708;line overflow in Fixed-form / Free-form;misc; -252;syn_misc.at:1756;continuation Indicator - too many lines;misc fixed literals listing; -253;syn_misc.at:2313;continuation of COBOL words;misc fixed literals; -254;syn_misc.at:2334;literal too long;misc literals literal-length continuation listing; -255;syn_misc.at:2569;line and floating comments;misc extensions indicator; -256;syn_misc.at:2734;word length;misc word-length; -257;syn_misc.at:2897;Segmentation Module;misc; -258;syn_misc.at:2989;ACCEPT FROM ESCAPE KEY;misc; -259;syn_misc.at:3014;Numeric literals;misc numeric-literal-length; -260;syn_misc.at:3193;floating-point literals;misc; -261;syn_misc.at:3300;X literals;misc; -262;syn_misc.at:3327;national literals;misc; -263;syn_misc.at:3365;NX literals;misc; -264;syn_misc.at:3403;binary literals;misc extensions; -265;syn_misc.at:3439;binary-hexadecimal literals;misc extensions; -266;syn_misc.at:3468;HP COBOL octal literals;misc extensions; -267;syn_misc.at:3504;ACUCOBOL literals;misc acu extensions binary octal hexadecimal; -268;syn_misc.at:3566;ACUCOBOL 32bit literal size;extensions literals; -269;syn_misc.at:3597;ACUCOBOL USAGE FLOAT / DOUBLE;misc acu extensions reserved; -270;syn_misc.at:3626;ACUCOBOL USAGE HANDLE;misc acu extensions reserved call destroy; -271;syn_misc.at:3735;ACUCOBOL WINDOW statements;misc acu extensions screen; -272;syn_misc.at:3820;ACUCOBOL GRAPHICAL controls;misc acu extensions screen modify inquire; -273;syn_misc.at:3899;DISPLAY MESSAGE BOX;misc acu extensions screen; -274;syn_misc.at:3942;DISPLAY OMITTED;misc extensions screen; -275;syn_misc.at:3963;CGI: EXTERNAL-FORM;misc acu extensions accept display; -276;syn_misc.at:4018;adding/removing reserved words;misc extensions configuration; -277;syn_misc.at:4048;adding aliases;misc extensions configuration reserved; -278;syn_misc.at:4082;overriding default words;misc extensions configuration reserved; -279;syn_misc.at:4112;complete specified word list;misc extensions configuration reserved; -280;syn_misc.at:4132;ANY LENGTH item as BY VALUE formal parameter;misc by value; -281;syn_misc.at:4155;swapped SOURCE- and OBJECT-COMPUTER;misc extensions; -282;syn_misc.at:4177;CONF. SECTION paragraphs in wrong order;misc extensions; -283;syn_misc.at:4249;NOT ON EXCEPTION with STATIC CALL convention;misc call-convention; -284;syn_misc.at:4297;NOT ON EXCEPTION phrases before ON EXCEPTION;misc; -285;syn_misc.at:4361;wrong dialect hints;misc configuration reserved; -286;syn_misc.at:4385;redundant periods;misc; -287;syn_misc.at:4415;IF-ELSE statement list with invalid syntax;misc; -288;syn_misc.at:4448;EVALUATE statement with invalid syntax;misc expression; -289;syn_misc.at:4498;MF reserved word directives;extensions addrsv addsyn makesyn override remove; -290;syn_misc.at:4554;STRING / UNSTRING with invalid syntax;misc; -291;syn_misc.at:4619;use of program-prototypes;misc; -292;syn_misc.at:4646;invalid INSPECT/TRANSFORM operands;misc inspect transform; -293;syn_misc.at:4690;SIGN clause checks;misc; -294;syn_misc.at:4715;conflicting entry conventions;misc entry-convention call-convention linkage; -295;syn_misc.at:4784;conflicting call conventions;misc call-convention linkage; -296;syn_misc.at:4813;dangling LINKAGE items;misc; -297;syn_misc.at:4869;ADD / SUBTRACT TABLE;misc; -298;syn_misc.at:4912;USE FOR DEBUGGING invalid ref-mod / subscripts;misc; -299;syn_misc.at:4957;USE FOR DEBUGGING duplicate targets;misc; -300;syn_misc.at:5010;USE FOR DEBUGGING syntax-checks;misc; -301;syn_misc.at:5078;Empty PERFORM with DEBUGGING MODE;misc; -302;syn_misc.at:5106;whitespace handling;misc; -303;syn_misc.at:5194;STOP identifier;misc extensions; -304;syn_misc.at:5220;01 CONSTANT;mirc reserved; -305;syn_misc.at:5268;78 VALUE;constant; -306;syn_misc.at:5315;level 78 NEXT / START OF;extensions constant length; -307;syn_misc.at:5374;SYMBOLIC CONSTANT;misc special-names; -308;syn_misc.at:5423;Constant Expressions (1);condition expression refmod if evaluate; -309;syn_misc.at:5548;Constant Expressions (2);condition expression unreachable 78; -310;syn_misc.at:5604;Constant Expressions (3);condition expression refmod undefined; -311;syn_misc.at:5653;Constant Expressions (4);condition expression refmod; -312;syn_misc.at:5686;Constant Expressions (5);condition expression unreachable; -313;syn_misc.at:5786;Missing imperative statements;condition expression if evaluate when perform; -314;syn_misc.at:5878;Fall-Through to WHEN OTHER;condition expression evaluate when; -315;syn_misc.at:5916;CONSTANT LENGTH / BYTE-LENGTH;misc; -316;syn_misc.at:5940;ANY LENGTH/NUMERIC with incorrect PIC;misc; -317;syn_misc.at:5977;VOLATILE clause;extensions; -318;syn_misc.at:6020;SET SOURCEFORMAT syntax checks;misc extensions directives; -319;syn_misc.at:6047;WHEN-COMPILED register in dialect;misc extensions; -320;syn_misc.at:6073;LIN / COL register;misc extensions; -321;syn_misc.at:6105;tokens consisting of multiple words;misc; -322;syn_misc.at:6132;zero-length literals;misc; -323;syn_misc.at:6193;@OPTIONS parsing;misc options; -324;syn_misc.at:6235;system routines with wrong number of parameters;misc call 91 c\$toupper cbl_gc_fork; -325;syn_misc.at:6264;invalid use of condition-name;misc move string unstring compute; -326;syn_misc.at:6328;XML GENERATE syntax checks;extensions; -327;syn_misc.at:6546;IBM Data Division;78 length; -328;syn_misc.at:6627;BASED clause, ALLOCATE / FREE statements;based; -329;syn_misc.at:6685;CONTINUE statement;based; -330;syn_misc.at:6729;conflict markers;; -331;syn_misc.at:6788;SORT syntax;misc fundamental key; -332;syn_misc.at:6842;Group Usage Error;numeric; -333;syn_misc.at:6884;OSVS I/O extensions;ibm file extensions; -334;syn_misc.at:6951;very long literal in error message;misc literals; -335;syn_move.at:37;MOVE SPACE TO numeric or numeric-edited item;move editing; -336;syn_move.at:63;MOVE ZERO TO alphabetic item;move; -337;syn_move.at:89;MOVE alphabetic TO x;move; -338;syn_move.at:120;MOVE alphanumeric TO x;move; -339;syn_move.at:148;MOVE alphanumeric-edited TO x;move editing; -340;syn_move.at:179;MOVE numeric (integer) TO x;move; -341;syn_move.at:209;MOVE numeric (non-integer) TO x;move; -342;syn_move.at:241;MOVE numeric-edited TO x;move editing; -343;syn_move.at:276;CORRESPONDING - Operands must be groups;move; -344;syn_move.at:306;CORRESPONDING - Target has no matching items;move; -345;syn_move.at:332;MOVE to erroneous field;move; -346;syn_move.at:355;Overlapping MOVE;move; -347;syn_move.at:454;invalid source for MOVE;move label program-prototype; -348;syn_move.at:484;invalid target for MOVE;move constant label program-prototype; -349;syn_move.at:520;SET error;set-move; -350;syn_move.at:552;MOVE FIGURATIVE to NUMERIC;move; -351;syn_multiply.at:28;Category check of Format 1;multiply; -352;syn_multiply.at:64;Category check of Format 2;multiply; -353;syn_multiply.at:102;Category check of literals;multiply; -354;syn_screen.at:24;Flexible ACCEPT/DISPLAY syntax;screen accept display; -355;syn_screen.at:92;Duplicate ACCEPT/DISPLAY clauses;screen accept display; -356;syn_screen.at:121;AT clause;screen extensions; -357;syn_screen.at:165;ACCEPT/DISPLAY extensions detection;at line column accept display screen extensions; -358;syn_screen.at:211;FROM clause;screen; -359;syn_screen.at:237;Incorrect USAGE clause;screen; -360;syn_screen.at:268;SCREEN SECTION clause numbers;screen; -361;syn_screen.at:300;Screen clauses;screen; -362;syn_screen.at:326;ACCEPT ON EXCEPTION/ESCAPE;screen; -363;syn_screen.at:356;Referencing 88-level;screen; -364;syn_screen.at:387;Conflicting screen clauses;screen; -365;syn_screen.at:448;Redundant screen clauses;screen; -366;syn_screen.at:481;Screen item OCCURS w-/wo relative LINE/COL;occurs; -367;syn_screen.at:541;VALUE clause missing;screen; -368;syn_screen.at:565;FULL on numeric item;screen; -369;syn_screen.at:589;Compiler-specific SCREEN SECTION clause rules;screen; -370;syn_screen.at:747;MS-COBOL position-spec;screen position lin col; -371;syn_screen.at:799;Screen with invalid FROM clause;screen constant; -372;syn_set.at:24;SET ADDRESS OF item;set; -373;syn_set.at:53;SET item TO 88-level;set; -374;syn_functions.at:22;ANY LENGTH / NUMERIC as function RETURNING item;functions extensions; -375;syn_functions.at:64;REPOSITORY INTRINSIC phrase;functions; -376;syn_functions.at:87;REPOSITORY FUNCTION phrase;functions; -377;syn_functions.at:135;Redundant REPOSITORY entries;functions; -378;syn_functions.at:174;Missing prototype/definition;functions programs prototypes; -379;syn_functions.at:205;Empty function;functions; -380;syn_functions.at:232;Function definition inside program;functions; -381;syn_functions.at:255;Intrinsic functions: dialect;functions; -382;syn_functions.at:280;Intrinsic functions: replaced;functions substitute; -383;syn_functions.at:324;Intrinsic functions: number of arguments;functions; -384;syn_functions.at:364;Intrinsic functions: reference modification;functions refmod; -385;syn_functions.at:412;Intrinsic functions: argument type;functions; -386;syn_functions.at:435;invalid formatted date/time args;functions formatted-date formatted-current-date formatted-time formatted-datetime integer-of-formatted-date seconds-from-formatted-time; -387;syn_functions.at:516;invalid formats w/ DECIMAL-POINT IS COMMA;functions formatted-time formatted-datetime; -388;syn_functions.at:550;Specified offset and SYSTEM-OFFSET;functions formatted-time formatted-datetime; -389;syn_functions.at:574;FUNCTION LENGTH / BYTE-LENGTH;functions prefixed; -390;listings.at:21;Minimal lines per listing pages;listing symbols options; -391;listings.at:84;COPY within comment;listing; -392;listings.at:158;Replacement w/o strings;listing symbols; -393;listings.at:220;COPY replacement order;listing symbols; -394;listings.at:321;COPY separators;listing symbols; -395;listings.at:386;COPY partial replacement;listing symbols; -396;listings.at:600;COPY LEADING replacement;listing symbols; -397;listings.at:669;COPY TRAILING replacement;listing symbols; -398;listings.at:739;COPY recursive replacement;listing symbols; -399;listings.at:804;COPY multiple files;listing symbols; -400;listings.at:1018;Error/Warning messages;listing error warning symbols; -401;listings.at:1399;Two source files;listing; -402;listings.at:1466;Multiple programs in one file;listing symbols; -403;listings.at:1679;Multiple programs in one compilation group;listing; -404;listings.at:1862;Wide listing;listing; -405;listings.at:1948;Symbols: simple;listing comp; -406;listings.at:2111;Symbols: pointer;listing 64bit; -407;listings.at:2389;Symbols: multiple programs/functions;listing program function; -408;listings.at:2515;Symbols: OCCURS/REDEFINES;listing; -409;listings.at:2627;Conditional compilation;listing; -410;listings.at:2686;File descriptions;listing; -411;listings.at:3041;Invalid PICTURE strings;listing; -412;listings.at:3544;Variable format;listing; -413;listings.at:3587;LISTING directive;listing; -414;listings.at:3687;Listing-directive statements;listing directive eject skip1 skip2 skip3 title; -415;listings.at:3755;Eject page;listing directive; -416;listings.at:3949;Cross reference;listing; -417;listings.at:5470;Report Writer;listing; -418;listings.at:5777;huge REPLACE;listing; -419;run_fundamental.at:24;DISPLAY literals;fundamental; -420;run_fundamental.at:86;DISPLAY literals, DECIMAL-POINT is COMMA;fundamental; -421;run_fundamental.at:125;Hexadecimal literal;fundamental; -422;run_fundamental.at:166;DISPLAY data items with VALUE clause;fundamental; -423;run_fundamental.at:213;DISPLAY data items with MOVE statement;fundamental; -424;run_fundamental.at:267;MOVE to edited item (1);fundamental editing; -425;run_fundamental.at:316;MOVE to edited item (2);fundamental editing; -426;run_fundamental.at:365;MOVE to item with simple and floating insertion;fundamental edited editing; -427;run_fundamental.at:400;MOVE to JUSTIFIED item;fundamental; -428;run_fundamental.at:445;MOVE integer literal to alphanumeric;fundamental; -429;run_fundamental.at:470;Compare FLOAT-LONG with floating-point literal;fundamental literal exponent; -430;run_fundamental.at:523;Check for equality of FLOAT-SHORT / FLOAT-LONG;fundamental; -431;run_fundamental.at:646;Overlapping MOVE;fundamental; -432;run_fundamental.at:747;Overlapping MOVE;fundamental; -433;run_fundamental.at:789;IBM MOVE;fundamental; -434;run_fundamental.at:828;ALPHABETIC test;fundamental; -435;run_fundamental.at:860;ALPHABETIC-UPPER test;fundamental; -436;run_fundamental.at:892;ALPHABETIC-LOWER test;fundamental; -437;run_fundamental.at:924;GLOBAL at same level;fundamental; -438;run_fundamental.at:973;GLOBAL at lower level;fundamental; -439;run_fundamental.at:1022;GLOBAL CONSTANT;fundamental; -440;run_fundamental.at:1107;GLOBAL identifiers from ENVIRONMENT DIVISION;fundamental function currency sign; -441;run_fundamental.at:1188;Entry point visibility (1);fundamental call; -442;run_fundamental.at:1220;Entry point visibility (2);fundamental call; -443;run_fundamental.at:1254;Contained program visibility (1);fundamental call; -444;run_fundamental.at:1309;Contained program visibility (2);fundamental call; -445;run_fundamental.at:1362;Contained program visibility (3);fundamental call; -446;run_fundamental.at:1413;Contained program visibility (4);fundamental call; -447;run_fundamental.at:1468;CALL/CANCEL with program-prototype-name;fundamental; -448;run_fundamental.at:1541;GLOBAL FD (RELATIVE 1);fundamental; -449;run_fundamental.at:1592;GLOBAL FD (INDEXED 1);fundamental; -450;run_fundamental.at:1645;GLOBAL FD (RELATIVE 2);fundamental; -451;run_fundamental.at:1695;GLOBAL FD (INDEXED 2);fundamental; -452;run_fundamental.at:1747;CANCEL test (1);fundamental; -453;run_fundamental.at:1774;CANCEL test (2);fundamental; -454;run_fundamental.at:1814;CANCEL test (3);fundamental; -455;run_fundamental.at:1857;Separate sign positions (1);fundamental; -456;run_fundamental.at:1881;Separate sign positions (2);fundamental; -457;run_fundamental.at:1914;Context sensitive words (1);fundamental byte-length; -458;run_fundamental.at:1937;Context sensitive words (2);fundamental yyyymmdd; -459;run_fundamental.at:1961;Context sensitive words (3);fundamental yyyyddd; -460;run_fundamental.at:1985;Context sensitive words (4);fundamental intrinsic; -461;run_fundamental.at:2010;Context sensitive words (5);fundamental recursive; -462;run_fundamental.at:2033;Context sensitive words (6);fundamental normal; -463;run_fundamental.at:2055;Context sensitive words (7);fundamental compute away-from-zero; -464;run_fundamental.at:2082;Context sensitive words (8);fundamental ibm unbounded attributes; -465;run_fundamental.at:2109;ROUNDED AWAY-FROM-ZERO;fundamental compute; -466;run_fundamental.at:2172;ROUNDED NEAREST-AWAY-FROM-ZERO;fundamental compute; -467;run_fundamental.at:2235;ROUNDED NEAREST-EVEN;fundamental compute; -468;run_fundamental.at:2298;ROUNDED NEAREST-TOWARD-ZERO;fundamental compute; -469;run_fundamental.at:2361;ROUNDED TOWARD-GREATER;fundamental compute; -470;run_fundamental.at:2424;ROUNDED TOWARD-LESSER;fundamental compute; -471;run_fundamental.at:2487;ROUNDED TRUNCATION;fundamental compute; -472;run_fundamental.at:2550;Numeric operations (1);fundamental add subtract; -473;run_fundamental.at:2594;Numeric operations (2);fundamental add subtract; -474;run_fundamental.at:2900;Numeric operations (3);fundamental add subtract; -475;run_fundamental.at:3206;Numeric operations (4);fundamental add subtract; -476;run_fundamental.at:3512;Numeric operations (5);fundamental add subtract; -477;run_fundamental.at:3818;Numeric operations (6);fundamental add; -478;run_fundamental.at:3887;Numeric operations (7);fundamental add compute literal; -479;run_fundamental.at:4179;Numeric operations (8);fundamental compute literal; -480;run_fundamental.at:4229;ADD CORRESPONDING;fundamental corresponding; -481;run_fundamental.at:4277;ADD CORRESPONDING no match;fundamental corresponding; -482;run_fundamental.at:4327;SYNC in OCCURS;fundamental synchronize; -483;run_fundamental.at:4367;88 level with THRU;runmisc; -484;run_fundamental.at:4462;88 level with FILLER;runmisc; -485;run_fundamental.at:4491;88 level with FALSE IS clause;runmisc; -486;run_fundamental.at:4519;BLANK WHEN ZERO;fundamental; -487;run_fundamental.at:4549;MULTIPLY BY literal in INITIAL program;decimal constants fundamental; -488;run_fundamental.at:4573;debugging lines (not active);fundamental; -489;run_fundamental.at:4596;debugging lines (-fdebugging-line);fundamental; -490;run_fundamental.at:4619;debugging lines (WITH DEBUGGING MODE);fundamental extensions; -491;run_fundamental.at:4645;debugging lines, free format (not active);fundamental extensions; -492;run_fundamental.at:4668;debugging lines, free format (-fdebugging-line);fundamental extensions; -493;run_fundamental.at:4691;USE FOR DEBUGGING (no DEBUGGING MODE);fundamental; -494;run_fundamental.at:4736;USE FOR DEBUGGING (COB_SET_DEBUG deactivated);fundamental; -495;run_fundamental.at:4781;USE FOR DEBUGGING ON ALL PROCEDURES;fundamental; -496;run_fundamental.at:4832;USE FOR DEBUGGING ON procedure;fundamental; -497;run_fundamental.at:4880;USE FOR DEBUGGING (COB_SET_DEBUG switched);fundamental; -498;run_fundamental.at:4929;USE FOR DEBUGGING ON [ALL] REFERENCES OF field;fundamental; -499;run_fundamental.at:4997;USE FOR DEBUGGING, reference within DEBUGGING;fundamental; -500;run_fundamental.at:5038;USE FOR DEBUGGING, time of execution;fundamental debugging; -501;run_fundamental.at:5088;USE FOR DEBUGGING, reference with OCCURS;fundamental debugging; -502;run_fundamental.at:5121;USE FOR DEBUGGING, referencing BASED item;fundamental debugging free allocate; -503;run_fundamental.at:5158;USE FOR DEBUGGING file;fundamental open write read close; -504;run_fundamental.at:5203;Abbreviated Expressions;expression conditional; -505;run_fundamental.at:5309;integer arithmetic on floating-point var;fundamental literal; -506;run_subscripts.at:26;Subscript out of bounds;runsubscripts subscripts; -507;run_subscripts.at:71;Value of DEPENDING ON N out of bounds;runsubscripts subscripts; -508;run_subscripts.at:122;Subscript bounds with OCCURS DEPENDING ON;runsubscripts subscripts odo; -509;run_subscripts.at:148;Subscript by arithmetic expression;runsubscripts subscripts; -510;run_subscripts.at:179;length of ODO w/- reference modification;runsubscripts subscripts; -511;run_subscripts.at:235;SEARCH ALL with OCCURS DEPENDING ON;runsubscripts subscripts odo; -512;run_refmod.at:25;Static reference modification;refmod; -513;run_refmod.at:57;Dynamic reference modification;refmod; -514;run_refmod.at:94;Offset underflow;refmod; -515;run_refmod.at:118;Offset overflow;refmod; -516;run_refmod.at:165;Length underflow;refmod; -517;run_refmod.at:189;Length overflow;refmod; -518;run_refmod.at:231;Length overflow with offset;refmod; -519;run_refmod.at:254;Test Reference Modification;numeric; -520;run_accept.at:28;ACCEPT OMITTED (simple);accept extensions; -521;run_accept.at:54;ACCEPT FROM TIME / DATE / DAY / DAY-OF-WEEK (1);accept; -522;run_accept.at:121;ACCEPT FROM TIME / DATE / DAY / DAY-OF-WEEK (2);accept configuration cob_current_date; -523;run_accept.at:204;ACCEPT DATE / DAY and intrinsic functions (1);accept function integer-of-date day-of-integer; -524;run_accept.at:241;ACCEPT DATE / DAY and intrinsic functions (2);accept configuration function integer-of-date day-of-integer; -525;run_accept.at:286;ACCEPT OMITTED (SCREEN);accept extensions; -526;run_initialize.at:27;INITIALIZE group entry with OCCURS;initialize; -527;run_initialize.at:55;INITIALIZE OCCURS with numeric edited;initialize editing; -528;run_initialize.at:88;INITIALIZE OCCURS with SIGN LEADING / TRAILING;initialize display; -529;run_initialize.at:159;INITIALIZE complex group (1);initialize; -530;run_initialize.at:187;INITIALIZE complex group (2);initialize; -531;run_initialize.at:215;INITIALIZE with REDEFINES;initialize; -532;run_initialize.at:242;INITIALIZE with FILLER;initialize; -533;run_initialize.at:309;INITIALIZE of EXTERNAL data items;initialize; -534;run_initialize.at:360;INITIALIZE with reference modification;initialize; -535;run_misc.at:23;Comma separator without space;runmisc; -536;run_misc.at:44;DECIMAL-POINT is COMMA (1);misc extensions; -537;run_misc.at:72;DECIMAL-POINT is COMMA (2);misc extensions; -538;run_misc.at:100;DECIMAL-POINT is COMMA (3);misc extensions; -539;run_misc.at:128;DECIMAL-POINT is COMMA (4);misc extensions; -540;run_misc.at:156;DECIMAL-POINT is COMMA (5);misc extensions; -541;run_misc.at:190;CURRENCY SIGN;misc fundamental; -542;run_misc.at:221;CURRENCY SIGN WITH PICTURE SYMBOL;misc fundamental; -543;run_misc.at:268;LOCAL-STORAGE (1);runmisc; -544;run_misc.at:304;LOCAL-STORAGE (2);runmisc; -545;run_misc.at:352;EXTERNAL data item;runmisc; -546;run_misc.at:394;EXTERNAL AS data item;runmisc; -547;run_misc.at:443;EXTERNAL data item size mismatch;runmisc; -548;run_misc.at:528;MOVE to itself;runmisc; -549;run_misc.at:554;MOVE with refmod;runmisc; -550;run_misc.at:578;MOVE with refmod (variable);runmisc; -551;run_misc.at:604;MOVE with group refmod;runmisc; -552;run_misc.at:629;MOVE indexes;runmisc; -553;run_misc.at:655;MOVE X'00';runmisc; -554;run_misc.at:690;MOVE Z'literal';runmisc literal; -555;run_misc.at:732;Floating continuation indicator;runmisc; -556;run_misc.at:754;Fixed continuation indicator;; -557;run_misc.at:796;Concatenation operator;runmisc; -558;run_misc.at:820;SOURCE FIXED/FREE directives;runmisc sourceformat fixed free; -559;run_misc.at:857;Level 01 subscripts;runmisc; -560;run_misc.at:879;Class check with reference modification;runmisc; -561;run_misc.at:903;Index and parenthesized expression;runmisc; -562;run_misc.at:927;Alphanumeric and binary numeric;runmisc; -563;run_misc.at:952;Non-numeric data in numeric items;runmisc; -564;run_misc.at:1026;Dynamic call with static linking;runmisc; -565;run_misc.at:1055;Static call with static linking;runmisc; -566;run_misc.at:1086;Dynamic CALL with ON EXCEPTION;runmisc; -567;run_misc.at:1118;Static CALL with ON EXCEPTION;runmisc; -568;run_misc.at:1158;CALL m1. CALL m2. CALL m1.;runmisc; -569;run_misc.at:1213;Recursive CALL of RECURSIVE program;runmisc cancel external; -570;run_misc.at:1270;Recursive CALL of INITIAL program;runmisc; -571;run_misc.at:1321;Recursive CALL with RECURSIVE assumed;runmisc; -572;run_misc.at:1369;Recursive CALL with ON EXCEPTION;runmisc exception-status; -573;run_misc.at:1426;Multiple calls of INITIAL program;runmisc call; -574;run_misc.at:1487;CALL binary literal parameter/LENGTH OF;runmisc; -575;run_misc.at:1542;CALL binary literal;call; -576;run_misc.at:1582;INSPECT REPLACING LEADING ZEROS BY SPACES;runmisc; -577;run_misc.at:1606;INSPECT No repeat conversion check;runmisc; -578;run_misc.at:1630;INSPECT CONVERTING alphabet;runmisc ascii ebcdic; -579;run_misc.at:1665;INSPECT CONVERTING TO figurative constant;runmisc; -580;run_misc.at:1689;INSPECT CONVERTING NULL;runmisc; -581;run_misc.at:1713;INSPECT CONVERTING TO NULL;runmisc; -582;run_misc.at:1737;INSPECT REPLACING figurative constant;runmisc; -583;run_misc.at:1761;INSPECT TALLYING BEFORE;runmisc; -584;run_misc.at:1796;INSPECT TALLYING AFTER;runmisc; -585;run_misc.at:1831;INSPECT REPLACING TRAILING ZEROS BY SPACES;runmisc; -586;run_misc.at:1855;INSPECT REPLACING complex;runmisc; -587;run_misc.at:1881;SWITCHES (environment COB_SWITCH_n and SET);runmisc; -588;run_misc.at:1978;Nested PERFORM;runmisc; -589;run_misc.at:2002;PERFORM VARYING BY -0.2;runmisc; -590;run_misc.at:2029;PERFORM VARYING BY phrase omitted;runmisc; -591;run_misc.at:2060;EXIT PERFORM;runmisc; -592;run_misc.at:2085;EXIT PERFORM CYCLE;runmisc; -593;run_misc.at:2110;EXIT PARAGRAPH;runmisc; -594;run_misc.at:2142;EXIT SECTION;runmisc; -595;run_misc.at:2176;PERFORM FOREVER / PERFORM UNTIL EXIT;runmisc extension; -596;run_misc.at:2217;PERFORM inline (1);runmisc; -597;run_misc.at:2244;PERFORM inline (2);runmisc; -598;run_misc.at:2269;Non-overflow after overflow;runmisc; -599;run_misc.at:2299;PERFORM ... CONTINUE;runmisc; -600;run_misc.at:2316;STRING with subscript reference;runmisc; -601;run_misc.at:2343;STRING / UNSTRING NOT ON OVERFLOW;runmisc exceptions; -602;run_misc.at:2460;UNSTRING DELIMITED ALL LOW-VALUE;runmisc; -603;run_misc.at:2495;UNSTRING DELIMITED ALL SPACE-2;runmisc; -604;run_misc.at:2560;UNSTRING DELIMITED POINTER;runmisc; -605;run_misc.at:2614;UNSTRING DELIMITER IN;runmisc; -606;run_misc.at:2657;UNSTRING with FUNCTION / literal;runmisc; -607;run_misc.at:2727;PICTURE COMP-X;numeric; -608;run_misc.at:2804;SORT: table sort;runmisc; -609;run_misc.at:2846;SORT: table sort (2);runmisc; -610;run_misc.at:2971;SORT: table sort (3);runmisc; -611;run_misc.at:3064;SORT: EBCDIC table sort;runmisc alphabet; -612;run_misc.at:3102;PIC ZZZ-, ZZZ+;runmisc editing; -613;run_misc.at:3155;PERFORM type OSVS;runmisc; -614;run_misc.at:3192;Sticky LINKAGE;runmisc; -615;run_misc.at:3239;COB_PRE_LOAD;runmisc; -616;run_misc.at:3265;COB_PRE_LOAD with entry points;runmisc; -617;run_misc.at:3336;Lookup ENTRY from main executable;runmisc; -618;run_misc.at:3377;COB_LOAD_CASE=UPPER test;runmisc; -619;run_misc.at:3403;ALLOCATE / FREE with BASED item (1);runmisc; -620;run_misc.at:3430;ALLOCATE / FREE with BASED item (2);runmisc; -621;run_misc.at:3477;ALLOCATE CHARACTERS INITIALIZED TO;runmisc; -622;run_misc.at:3518;Initialized value with defaultbyte;runmisc; -623;run_misc.at:3543;CALL with OMITTED parameter;runmisc; -624;run_misc.at:3582;CALL in from C, cob_call_params explicitly set;runmisc; -625;run_misc.at:3641;CALL in from C, cob_call_params unknown;runmisc; -626;run_misc.at:3699;CALL C with callback, PROCEDURE DIVISION EXTERN;runmisc extensions call-convention; -627;run_misc.at:3767;CALL C with callback, ENTRY-CONVENTION EXTERN;runmisc call-convention linkage; -628;run_misc.at:3919;CALL in from C with init missing / implicit;runmisc implicit-init; -629;run_misc.at:3972;CALL STATIC C from COBOL;runmisc; -630;run_misc.at:4028;ANY LENGTH (1);runmisc call; -631;run_misc.at:4071;ANY LENGTH (2);runmisc call; -632;run_misc.at:4115;ANY LENGTH (3);runmisc call; -633;run_misc.at:4158;ANY LENGTH (4);runmisc if call; -634;run_misc.at:4201;ANY LENGTH (5);runmisc; -635;run_misc.at:4226;access to BASED item without allocation;runmisc; -636;run_misc.at:4267;access to OPTIONAL LINKAGE item not passed;runmisc; -637;run_misc.at:4309;STOP RUN WITH NORMAL STATUS;runmisc; -638;run_misc.at:4327;STOP RUN WITH ERROR STATUS;runmisc; -639;run_misc.at:4345;SYMBOLIC clause;runmisc alphabet; -640;run_misc.at:4382;OCCURS clause with 1 entry;runmisc; -641;run_misc.at:4431;Computing of different USAGEs w/o decimal point;runmisc binary-c-long binary-char binary-double binary-long comp comp-1 comp-2 comp-3 comp-5 comp-6 comp-x comp-n float-decimal-16 float-decimal-34 float-long float-short; -642;run_misc.at:5067;Computing of different USAGEs w/- decimal point;runmisc binary-c-long binary-char binary-double binary-long comp comp-1 comp-2 comp-3 comp-5 comp-6 comp-n comp-x float-decimal-16 float-decimal-34 float-long float-short; -643;run_misc.at:5702;C/C++ reserved words/predefined identifiers;runmisc; -644;run_misc.at:6162;ON EXCEPTION clause of DISPLAY;runmisc exceptions screen; -645;run_misc.at:6187;EC-SCREEN-LINE-NUMBER and -STARTING-COLUMN;runmisc exceptions screen; -646;run_misc.at:6228;LINE/COLUMN 0 exceptions;line column runmisc exceptions extensions screen; -647;run_misc.at:6266;SET LAST EXCEPTION TO OFF;runmisc exceptions exception-status exception-location; -648;run_misc.at:6302;void PROCEDURE;runmisc; -649;run_misc.at:6331;Figurative constants to numeric field;numeric; -650;run_misc.at:6393;MF FIGURATIVE to NUMERIC;move; -651;run_misc.at:6529;void PROCEDURE, NOTHING return;runmisc; -652;run_misc.at:6559;C API Test;call; -653;run_misc.at:6883;CALL with program prototypes;runmisc; -654;run_misc.at:6939;REDEFINES values on FILLER and INITIALIZE;runmisc initialize; -655;run_misc.at:6994;PICTURE with constant-name;runmisc; -656;run_misc.at:7023;Quote marks in comment paragraphs;runmisc; -657;run_misc.at:7049;Numeric MOVE with/without -fbinary-truncate;runmisc size; -658;run_misc.at:7109;Alphanumeric MOVE with truncation;misc fundamental size; -659;run_misc.at:7173;PROGRAM-ID / CALL literal/variable with spaces;call; -660;run_misc.at:7241;DEFAULT ROUNDED MODE;runmisc; -661;run_misc.at:7271;OCCURS INDEXED ASCENDING;occurs extension; -662;run_misc.at:7370;ZERO unsigned and negative binary subscript;runmisc; -663;run_misc.at:7434;Default Arithmetic (1);runmisc; -664;run_misc.at:7547;Default Arithmetic Test (2);runmisc; -665;run_misc.at:7598;OSVS Arithmetic (1);runmisc; -666;run_misc.at:7715;OSVS Arithmetic Test (2);runmisc; -667;run_misc.at:7771;OSVS Arithmetic Test (3);osvs; -668;run_misc.at:7928;SET CONSTANT directive;misc directives extensions; -669;run_misc.at:8031;DEFINE OVERRIDE;cdf directive; -670;run_misc.at:8097;DEFINE Defaults;cdf directive; -671;run_misc.at:8163;78 VALUE;constant misc; -672;run_misc.at:8231;01 CONSTANT;misc; -673;run_misc.at:8311;DISPLAY UPON;chaining printer pipe console syserr syspch syspunch cob_display_print_pipe cob_display_print_file cob_display_punch_file; -674;run_misc.at:8404;FLOAT-DECIMAL w/o SIZE ERROR;numeric runmisc float-decimal-16 float-decimal-34 display compute; -675;run_misc.at:8578;FLOAT-SHORT / FLOAT-LONG w/o SIZE ERROR;numeric runmisc comp-1 comp-2 display compute; -676;run_misc.at:8777;FLOAT-SHORT with SIZE ERROR;comp-1; -677;run_misc.at:8828;FLOAT-LONG with SIZE ERROR;comp-2; -678;run_misc.at:8885;EC-SIZE-ZERO-DIVIDE;misc fundamental exceptions divide compute exception-status; -679;run_misc.at:8930;EC-SIZE-OVERFLOW;misc fundamental exceptions; -680;run_misc.at:8963;Constant Expressions;runmisc condition expression; -681;run_misc.at:9052;ENTRY FOR GO TO / GO TO ENTRY;runmisc condition expression; -682;run_misc.at:9142;PERFORM VARYING Float;perform; -683;run_misc.at:9180;Test PICTURE with Edit mask;numeric; -684;run_misc.at:9211;COMP-3 Index;numeric; -685;run_misc.at:9247;POINTER;numeric; -686;run_misc.at:9286;Figurative constants to numeric field;numeric; -687;run_misc.at:9350;READY TRACE / RESET TRACE;runmisc -ftrace -ftraceall -fsource-location call recursive return-code cob_physical_cancel cob_pre_load; -688;run_misc.at:9589;Test dump feature;dump; -689;run_misc.at:10058;Test COBOL-C interface;call; -690;run_misc.at:10223;Test COBOL-C interface (2);call; -691;run_misc.at:10320;COBOL2002 SYNC;numeric; -692;run_misc.at:10948;NO Subscript;length; -693;run_misc.at:11019;NO Subscript ACU;acu length; -694;run_misc.at:11090;IBM SYNC;numeric; -695;run_misc.at:11742;MF IBMCOMP SYNC;numeric; -696;run_misc.at:12394;MF SYNC;numeric; -697;run_misc.at:13046;default SYNC;numeric; -698;run_misc.at:13697;Group Usage 1;numeric; -699;run_misc.at:13739;Group Usage 2;numeric; -700;run_misc.at:13780;MF COMP-5 noibmcomp;noibmcomp; -701;run_misc.at:13812;MF COMP-5;ibmcomp; -702;run_misc.at:13844;Test HEX String;numeric; -703;run_file.at:23;READ INTO data item AT-END sequence;runfile; -704;run_file.at:60;LINAGE and LINAGE-COUNTER sample;runfile optional file status read write end-of-page line sequential cob_current_date; -705;run_file.at:346;OUTPUT on INDEXED file to missing directory;runfile open assign; -706;run_file.at:391;First READ on empty SEQUENTIAL INDEXED file;runfile; -707;run_file.at:431;READ NEXT without previous START;runfile write indexed; -708;run_file.at:509;REWRITE a RELATIVE file with RANDOM access;runfile; -709;run_file.at:576;error status RELATIVE file;runfile rewrite write declaratives; -710;run_file.at:641;File SORT, SEQUENTIAL;runfile using giving; -711;run_file.at:691;File SORT, SEQUENTIAL variable records;runfile; -712;run_file.at:773;INDEXED File KEYCHECK;runfile suppress when; -713;run_file.at:1562;SUPPRESS WHEN string;file-io; -714;run_file.at:2019;INDEXED File Sparse/Split keys;runfile; -715;run_file.at:2104;File SORT, LINE SEQUENTIAL;runfile using giving; -716;run_file.at:2163;File SORT, LINE SEQUENTIAL same file;runfile using giving; -717;run_file.at:2210;File SORT, LINE SEQUENTIAL variable records;runfile; -718;run_file.at:2274;File MERGE, LINE SEQUENTIAL variable records;runfile; -719;run_file.at:2365;SORT nonexistent file;runfile; -720;run_file.at:2400;SORT with INPUT/OUTPUT PROCEDUREs;runfile; -721;run_file.at:2490;SORT with key1 ASCENDING, key2 DESCENDING;runfile; -722;run_file.at:2554;ASSIGN with LOCAL-STORAGE item;runfile; -723;run_file.at:2591;ASSIGN with LOCAL-STORAGE item and INITIAL prog;runfile; -724;run_file.at:2631;ASSIGN with BASED data item and CHAINING;runfile status; -725;run_file.at:2711;ASSIGN with data item in LINKAGE;runfile-control file status; -726;run_file.at:2883;INDEXED file sparse/split keys;runfile split key sparse suppress; -727;run_file.at:3403;INDEXED file split keys WITH DUPLICATES;runfile key; -728;run_file.at:3561;INDEXED file variable length record;runfile write start read; -729;run_file.at:3816;INDEXED sample;runfile optional file status read write duplicates start; -730;run_file.at:4221;WRITE + REWRITE FILE name;runfile; -731;run_file.at:4374;START RELATIVE (1);fundamental runfile delete file; -732;run_file.at:4423;START RELATIVE (2);fundamental runfile; -733;run_file.at:4501;START RELATIVE (3);runfile; -734;run_file.at:4577;READ on OPTIONAL missing RELATIVE / SEQUENTIAL;runfile; -735;run_file.at:4699;READ on OPTIONAL missing INDEXED file;runfile; -736;run_file.at:4749;EXTERNAL RELATIVE file;runfile; -737;run_file.at:4785;DECLARATIVES procedure referencing;runfile; -738;run_file.at:4825;DECLARATIVES procedure referencing (multiple);runfile; -739;run_file.at:4869;System routines for directories (1);extensions runfile cbl_create_dir cbl_change_dir cbl_delete_dir; -740;run_file.at:4911;System routines for directories (2);runfile extensions cbl_create_dir cbl_create_file cbl_close_file cbl_check_file_exist cbl_delete_dir cbl_purge_dir; -741;run_file.at:5008;System routines for files;extensions runfile cbl_create_file cbl_write_file cbl_flush_file cbl_open_file cbl_read_file cbl_close_file cbl_rename_file cbl_delete_file c\$delete; -742;run_file.at:5178;System routine CBL_COPY_FILE;extensions runfile; -743;run_file.at:5213;Default file external name;runfile; -744;run_file.at:5287;SEQUENTIAL basic I/O;runfile; -745;run_file.at:5321;LINE SEQUENTIAL basic I/O;runfile; -746;run_file.at:5387;LINE SEQUENTIAL record truncation;runfile; -747;run_file.at:5434;SEQUENTIAL file I/O with variable records;runfile; -748;run_file.at:5509;LINE SEQUENTIAL file I/O with variable records;runfile; -749;run_file.at:5583;SEQUENTIAL file REWRITE;runfile; -750;run_file.at:5692;SEQUENTIAL file with LOCK MODE EXCLUSIVE;runfile; -751;run_file.at:5760;SEQUENTIAL file with OPEN WITH LOCK;runfile; -752;run_file.at:5826;SEQUENTIAL file with SHARING NO;runfile; -753;run_file.at:5894;SEQUENTIAL file with SHARING READ ONLY;runfile; -754;run_file.at:5969;SEQUENTIAL file with blocked lock;runfile; -755;run_file.at:6040;RELATIVE SEQUENTIAL basic I/O;runfile; -756;run_file.at:6074;RELATIVE RANDOM basic I/O;runfile; -757;run_file.at:6124;RELATIVE SEQUENTIAL with variable records;runfile; -758;run_file.at:6198;INDEXED SEQUENTIAL basic I/O;runfile; -759;run_file.at:6236;INDEXED SEQUENTIAL with variable records;runfile; -760;run_file.at:6319;INDEXED file with LOCK MODE EXCLUSIVE;runfile; -761;run_file.at:6396;INDEXED file with OPEN WITH LOCK;runfile; -762;run_file.at:6472;INDEXED file with SHARING NO;runfile; -763;run_file.at:6549;INDEXED file with SHARING READ ONLY;runfile; -764;run_file.at:6633;INDEXED file with blocked lock;runfile; -765;run_file.at:6713;INDEXED file with LOCK AUTOMATIC (1);runfile; -766;run_file.at:6802;INDEXED file with LOCK AUTOMATIC (2);runfile; -767;run_file.at:6892;INDEXED file with LOCK MANUAL;runfile; -768;run_file.at:6979;START INDEXED;runfile; -769;run_file.at:7058;INDEXED partial keys;runfile; -770;run_file.at:7202;INDEXED undeclared keys;runfile; -771;run_file.at:7366;READ INPUT pipe & WRITE OUTPUT pipe;runfile; -772;run_file.at:7461;EXTFH: using ISAM callback;runfile extfh; -773;run_file.at:8159;EXTFH: SEQUENTIAL files;runfile extfh; -774;run_file.at:8569;EXTFH: LINE SEQUENTIAL files, direct EXTFH;runfile; -775;run_file.at:8751;RELATIVE Multi-Record;runfile; -776;run_file.at:9002;RELATIVE one Record;runfile; -777;run_file.at:9412;SEQUENTIAL Multi-Record;runfile; -778;run_file.at:9672;SEQUENTIAL one Record;runfile; -779;run_file.at:9881;trace feature;runfile; -780;run_file.at:11209;trace feature with subroutine;runfile; -781;run_file.at:12728;trace feature with indexed EXTFH;runfile; -782;run_file.at:14149;RELATIVE File Locking;runfile; -783;run_file.at:14691;WRITE and REWRITE FILE name ;runfile; -784;run_file.at:14844;INDEXED File Locking;runfile; -785;run_file.at:15508;RELATIVE File Locking;runfile; -786;run_file.at:16059;Read on optional missing file;runfile; -787;run_file.at:16120;SELECT with ASSIGN in LINKAGE;runfile file-control; -788;run_file.at:16252;INDEXED File Variable len record;runfile; -789;run_file.at:16519;GC LINE SEQUENTIAL Long-Record;runfile; -790;run_file.at:16635;MF LINE SEQUENTIAL Long-Record;runfile; -791;run_file.at:16755;Indexed with FH--FCD;fh--fcd; -792;run_file.at:17352;PIPE I/O;pipe; -793;run_file.at:17553;LINE SEQUENTIAL one Record;runfile; -794;run_file.at:17786;INDEXED File READ/DELETE/READ;fileio; -795;run_reportwriter.at:23;Report Line Order;report file mapping; -796;run_reportwriter.at:120;REPORT COL PLUS;report runfile; -797;run_reportwriter.at:189;Report Overlapping Fields;report runfile; -798;run_reportwriter.at:258;EMPTY REPORT;report runfile; -799;run_reportwriter.at:327;PAGE LIMIT REPORT;report runfile; -800;run_reportwriter.at:389;PAGE LIMIT REPORT 2;report runfile; -801;run_reportwriter.at:461;Sample Customer Report;report runfile; -802;run_reportwriter.at:776;Sample Charge Report;report runfile; -803;run_reportwriter.at:1129;Sample Charge Report 2;report runfile; -804;run_reportwriter.at:1499;Sample Charge Report 3;report runfile; -805;run_reportwriter.at:1799;Sample Charge Report 4;report runfile; -806;run_reportwriter.at:2215;Sample Payroll Report;report runfile; -807;run_reportwriter.at:2900;Sample REPORT with RIGHT/CENTER;report runfile; -808;run_reportwriter.at:3068;STUDENT REPORT with INITIAL;report runfile; -809;run_reportwriter.at:3220;ORDER REPORT; Test substring;report runfile; -810;run_reportwriter.at:3568;Sample Control Break;report runfile; -811;run_reportwriter.at:3796;Sample Inventory Report;report runfile; -812;run_reportwriter.at:3989;Duplicate Detail Line;report runfile; -813;run_reportwriter.at:4117;Report with OCCURS;report runfile; -814;run_reportwriter.at:4222;Report CODE and LIMIT COLUMNS;report runfile; -815;run_reportwriter.at:4443;Duplicate INITIATE;report runfile; -816;run_reportwriter.at:4509;Missing INITIATE and GENERATE;report runfile; -817;run_reportwriter.at:4569;Missing INITIATE and TERMINATE;report runfile; -818;run_reportwriter.at:4623;Next Group Next Page;report runfile; -819;run_reportwriter.at:8946;Report PRESENT AFTER;report runfile; -820;run_returncode.at:23;RETURN-CODE moving;returncode; -821;run_returncode.at:49;RETURN-CODE passing;returncode; -822;run_returncode.at:101;RETURN-CODE nested;returncode; -823;run_functions.at:24;FUNCTION ABS;functions; -824;run_functions.at:46;FUNCTION ACOS;functions; -825;run_functions.at:70;FUNCTION ANNUITY;functions; -826;run_functions.at:94;FUNCTION ASIN;functions; -827;run_functions.at:118;FUNCTION ATAN;functions; -828;run_functions.at:142;FUNCTION BYTE-LENGTH;functions length; -829;run_functions.at:212;FUNCTION CHAR;functions; -830;run_functions.at:250;FUNCTION COMBINED-DATETIME;functions; -831;run_functions.at:275;FUNCTION CONCAT / CONCATENATE;functions; -832;run_functions.at:322;FUNCTION CONCATENATE with reference modding;functions; -833;run_functions.at:350;FUNCTION CONTENT-LENGTH;functions length; -834;run_functions.at:384;FUNCTION CONTENT-OF;functions pointer literal based allocate free exception-status; -835;run_functions.at:459;FUNCTION as CALL parameter BY CONTENT;functions; -836;run_functions.at:495;FUNCTION COS;functions; -837;run_functions.at:519;FUNCTION CURRENCY-SYMBOL;functions; -838;run_functions.at:542;FUNCTION CURRENT-DATE;functions; -839;run_functions.at:613;FUNCTION DATE-OF-INTEGER;functions; -840;run_functions.at:638;FUNCTION DATE-TO-YYYYMMDD;functions; -841;run_functions.at:663;FUNCTION DAY-OF-INTEGER;functions; -842;run_functions.at:688;FUNCTION DAY-TO-YYYYDDD;functions; -843;run_functions.at:713;FUNCTION E;functions; -844;run_functions.at:737;FUNCTION EXCEPTION-FILE;functions exceptions; -845;run_functions.at:772;FUNCTION EXCEPTION-LOCATION;functions exceptions; -846;run_functions.at:811;FUNCTION EXCEPTION-STATEMENT;functions exceptions; -847;run_functions.at:846;FUNCTION EXCEPTION-STATUS;functions exceptions; -848;run_functions.at:881;FUNCTION EXP;functions; -849;run_functions.at:905;FUNCTION EXP10;functions; -850;run_functions.at:930;FUNCTION FACTORIAL;functions; -851;run_functions.at:955;FUNCTION FORMATTED-CURRENT-DATE;functions; -852;run_functions.at:983;FUNCTION FORMATTED-DATE;functions; -853;run_functions.at:1046;FUNCTION FORMATTED-DATE with ref modding;functions; -854;run_functions.at:1071;FUNCTION FORMATTED-DATETIME;functions; -855;run_functions.at:1128;FUNCTION FORMATTED-DATETIME with ref modding;functions; -856;run_functions.at:1154;FUNCTION FORMATTED-TIME;functions; -857;run_functions.at:1241;FUNCTION FORMATTED-TIME DP.COMMA;functions; -858;run_functions.at:1272;FUNCTION FORMATTED-TIME with ref modding;functions; -859;run_functions.at:1297;FUNCTION FRACTION-PART;functions; -860;run_functions.at:1328;FUNCTION HIGHEST-ALGEBRAIC;functions; -861;run_functions.at:1396;FUNCTION INTEGER;functions; -862;run_functions.at:1429;FUNCTION INTEGER-OF-DATE;functions; -863;run_functions.at:1454;FUNCTION INTEGER-OF-DAY;functions; -864;run_functions.at:1479;FUNCTION INTEGER-OF-FORMATTED-DATE;functions; -865;run_functions.at:1529;FUNCTION INTEGER-PART;functions; -866;run_functions.at:1555;FUNCTION LENGTH;functions; -867;run_functions.at:1623;FUNCTION LOCALE-COMPARE;functions; -868;run_functions.at:1653;FUNCTION LOCALE-DATE;functions; -869;run_functions.at:1679;FUNCTION LOCALE-TIME;functions; -870;run_functions.at:1705;FUNCTION LOCALE-TIME-FROM-SECONDS;functions; -871;run_functions.at:1731;FUNCTION LOG;functions; -872;run_functions.at:1755;FUNCTION LOG10;functions; -873;run_functions.at:1779;FUNCTION LOWER-CASE;functions; -874;run_functions.at:1807;FUNCTION LOWER-CASE with reference modding;functions; -875;run_functions.at:1833;FUNCTION LOWEST-ALGEBRAIC;functions; -876;run_functions.at:1886;FUNCTION MAX;functions; -877;run_functions.at:1908;FUNCTION MEAN;functions; -878;run_functions.at:1930;FUNCTION MEDIAN;functions; -879;run_functions.at:1952;FUNCTION MIDRANGE;functions; -880;run_functions.at:1974;FUNCTION MIN;functions; -881;run_functions.at:1996;FUNCTION MOD (valid);functions; -882;run_functions.at:2026;FUNCTION MOD (invalid);functions exceptions; -883;run_functions.at:2057;FUNCTION MODULE-CALLER-ID;functions; -884;run_functions.at:2091;FUNCTION MODULE-DATE;functions; -885;run_functions.at:2116;FUNCTION MODULE-FORMATTED-DATE;functions; -886;run_functions.at:2141;FUNCTION MODULE-ID;functions; -887;run_functions.at:2162;FUNCTION MODULE-PATH;functions; -888;run_functions.at:2187;FUNCTION MODULE-SOURCE;functions; -889;run_functions.at:2208;FUNCTION MODULE-TIME;functions; -890;run_functions.at:2233;FUNCTION MONETARY-DECIMAL-POINT;functions; -891;run_functions.at:2256;FUNCTION MONETARY-THOUSANDS-SEPARATOR;functions; -892;run_functions.at:2279;FUNCTION NUMERIC-DECIMAL-POINT;functions; -893;run_functions.at:2302;FUNCTION NUMERIC-THOUSANDS-SEPARATOR;functions; -894;run_functions.at:2325;FUNCTION NUMVAL;functions; -895;run_functions.at:2356;FUNCTION NUMVAL-C;functions; -896;run_functions.at:2387;FUNCTION NUMVAL-C DP.COMMA;functions; -897;run_functions.at:2417;FUNCTION NUMVAL-F;functions; -898;run_functions.at:2440;FUNCTION ORD;functions; -899;run_functions.at:2462;FUNCTION ORD-MAX;functions; -900;run_functions.at:2484;FUNCTION ORD-MIN;functions; -901;run_functions.at:2506;FUNCTION PI;functions; -902;run_functions.at:2530;FUNCTION PRESENT-VALUE;functions; -903;run_functions.at:2552;FUNCTION RANDOM;functions; -904;run_functions.at:2576;FUNCTION RANGE;functions; -905;run_functions.at:2600;FUNCTION REM (valid);functions; -906;run_functions.at:2623;FUNCTION REM (invalid);functions exceptions; -907;run_functions.at:2654;FUNCTION REVERSE;functions; -908;run_functions.at:2679;FUNCTION REVERSE with reference modding;functions; -909;run_functions.at:2704;FUNCTION SECONDS-FROM-FORMATTED-TIME;functions; -910;run_functions.at:2771;FUNCTION SECONDS-PAST-MIDNIGHT;functions; -911;run_functions.at:2795;FUNCTION SIGN;functions; -912;run_functions.at:2834;FUNCTION SIN;functions; -913;run_functions.at:2858;FUNCTION SQRT;functions; -914;run_functions.at:2882;FUNCTION STANDARD-DEVIATION;functions; -915;run_functions.at:2906;FUNCTION STORED-CHAR-LENGTH;functions; -916;run_functions.at:2932;FUNCTION SUBSTITUTE;functions; -917;run_functions.at:2961;FUNCTION SUBSTITUTE with reference modding;functions; -918;run_functions.at:2989;FUNCTION SUBSTITUTE-CASE;functions; -919;run_functions.at:3016;FUNCTION SUBSTITUTE-CASE with reference mod;functions; -920;run_functions.at:3044;FUNCTION SUM;functions; -921;run_functions.at:3068;FUNCTION TAN;functions; -922;run_functions.at:3092;FUNCTION TEST-DATE-YYYYMMDD;functions; -923;run_functions.at:3114;FUNCTION TEST-DAY-YYYYDDD;functions; -924;run_functions.at:3136;FUNCTION TEST-FORMATTED-DATETIME with dates;functions; -925;run_functions.at:3263;FUNCTION TEST-FORMATTED-DATETIME with times;functions; -926;run_functions.at:3344;FUNCTION TEST-FORMATTED-DATETIME with datetimes;functions; -927;run_functions.at:3397;FUNCTION TEST-FORMATTED-DATETIME DP.COMMA;functions; -928;run_functions.at:3438;FUNCTION TEST-NUMVAL;functions; -929;run_functions.at:3536;FUNCTION TEST-NUMVAL-C;functions; -930;run_functions.at:3634;FUNCTION TEST-NUMVAL-F;functions; -931;run_functions.at:3732;FUNCTION TRIM;functions; -932;run_functions.at:3758;FUNCTION TRIM with reference modding;functions; -933;run_functions.at:3784;FUNCTION TRIM zero length;functions; -934;run_functions.at:3811;FUNCTION UPPER-CASE;functions; -935;run_functions.at:3836;FUNCTION UPPER-CASE with reference modding;functions; -936;run_functions.at:3861;FUNCTION VARIANCE;functions; -937;run_functions.at:3885;FUNCTION WHEN-COMPILED;functions; -938;run_functions.at:3939;FUNCTION YEAR-TO-YYYY;functions; -939;run_functions.at:3963;Formatted funcs w/ invalid variable format;functions formatted-current-date formatted-date formatted-time formatted-datetime; -940;run_functions.at:4044;FORMATTED-(DATE)TIME with SYSTEM-OFFSET;functions formatted-time formatted-datetime extensions; -941;run_functions.at:4082;Intrinsics without FUNCTION keyword (1);functions; -942;run_functions.at:4103;Intrinsics without FUNCTION keyword (2);functions; -943;run_functions.at:4126;User-Defined FUNCTION with/without parameter;functions; -944;run_functions.at:4177;UDF in COMPUTE;functions; -945;run_functions.at:4220;UDF replacing intrinsic function;functions substitute; -946;run_functions.at:4263;UDF with recursion (1);functions local-storage; -947;run_functions.at:4330;UDF with recursion (2);functions local-storage; -948;run_extensions.at:25;CALL BY CONTENT binary and literal;extensions literals; -949;run_extensions.at:75;Numeric Boolean literals;extensions; -950;run_extensions.at:104;ACUCOBOL literals;extensions acu binary octal hexadecimal; -951;run_extensions.at:130;HP COBOL octal literals;extensions; -952;run_extensions.at:191;Hexadecimal numeric literals;extensions; -953;run_extensions.at:218;CALL USING numeric literal;call; -954;run_extensions.at:286;Semi-parenthesized condition;extensions; -955;run_extensions.at:306;ADDRESS OF;extensions; -956;run_extensions.at:356;LENGTH OF;extensions value renames; -957;run_extensions.at:520;SET TO SIZE OF;extensions acu length; -958;run_extensions.at:557;WHEN-COMPILED;extensions; -959;run_extensions.at:586;Complex OCCURS DEPENDING ON (1);extensions; -960;run_extensions.at:615;Complex OCCURS DEPENDING ON (2);extensions; -961;run_extensions.at:678;Complex OCCURS DEPENDING ON (3);extensions; -962;run_extensions.at:741;Complex OCCURS DEPENDING ON (4);extensions; -963;run_extensions.at:807;Complex OCCURS DEPENDING ON (5);extensions; -964;run_extensions.at:873;Complex OCCURS DEPENDING ON (6);extensions runsubscripts nested subscripts; -965;run_extensions.at:914;OCCURS UNBOUNDED (1);extensions runsubscripts subscripts; -966;run_extensions.at:958;OCCURS UNBOUNDED (2);extensions runsubscripts depending odo subscripts; -967;run_extensions.at:1106;DEPENDING ON with ODOSLIDE;nested odo; -968;run_extensions.at:1321;DEPENDING ON with ODOSLIDE for IBM;occurs odo; -969;run_extensions.at:1425;DEPENDING ON with ODOSLIDE;move; -970;run_extensions.at:1605;DEPENDING ON with ODOSLIDE;subroutine; -971;run_extensions.at:1695;INITIALIZE level 01;initialize; -972;run_extensions.at:1747;MOVE of non-integer to alphanumeric;extensions; -973;run_extensions.at:1837;CALL USING file-name;extensions; -974;run_extensions.at:1882;CALL unusual PROGRAM-ID.;extensions; -975;run_extensions.at:1946;CALL / GOBACK with LOCAL-STORAGE;extensions; -976;run_extensions.at:1996;CALL BY VALUE alphanumeric item;extensions; -977;run_extensions.at:2032;CALL BY VALUE numeric literal WITH SIZE;extensions; -978;run_extensions.at:2132;Case-sensitive PROGRAM-ID;extensions; -979;run_extensions.at:2157;Quoted PROGRAM-ID;extensions; -980;run_extensions.at:2180;PROGRAM-ID AS clause;extensions; -981;run_extensions.at:2204;ASSIGN DYNAMIC and EXTERNAL;extensions runfile; -982;run_extensions.at:2253;ASSIGN DYNAMIC implicit variable;extensions runfile; -983;run_extensions.at:2285;ASSIGN EXTERNAL parsing;extensions runfile; -984;run_extensions.at:2319;ASSIGN directive;extensions runfile; -985;run_extensions.at:2364;ASSIGN expansion;extensions runfile; -986;run_extensions.at:2390;ASSIGN mapping;extensions runfile optional; -987;run_extensions.at:2561;ASSIGN with COB_FILE_PATH;extensions runfile; -988;run_extensions.at:2595;NUMBER-OF-CALL-PARAMETERS;extensions; -989;run_extensions.at:2650;TALLY register;extensions; -990;run_extensions.at:2684;Redefining TALLY;extensions register; -991;run_extensions.at:2720;PROCEDURE DIVISION USING BY ...;extensions; -992;run_extensions.at:2771;PROCEDURE DIVISION CHAINING;extensions call initialize; -993;run_extensions.at:2894;STOP RUN RETURNING/GIVING;extensions; -994;run_extensions.at:2950;GOBACK/EXIT PROGRAM RETURNING/GIVING;extensions; -995;run_extensions.at:3000;ENTRY;extensions; -996;run_extensions.at:3046;LINE SEQUENTIAL write;extensions; -997;run_extensions.at:3092;LINE SEQUENTIAL read;extensions; -998;run_extensions.at:3159;ASSIGN to KEYBOARD/DISPLAY;extensions; -999;run_extensions.at:3217;SORT ASSIGN KEYBOARD to ASSIGN DISPLAY;extensions; -1000;run_extensions.at:3279;Environment/Argument variable;extensions; -1001;run_extensions.at:3325;78 Level (1);extensions; -1002;run_extensions.at:3348;78 Level (2);extensions; -1003;run_extensions.at:3374;78 Level (3);extensions; -1004;run_extensions.at:3398;SWITCHES with non-standard names;runmisc extensions; -1005;run_extensions.at:3511;Larger REDEFINES lengths;extensions; -1006;run_extensions.at:3596;Obsolete 2002 keywords with COBOL2014;extensions; -1007;run_extensions.at:3626;System routine with wrong number of parameters;extensions narg; -1008;run_extensions.at:3669;System routine C\$NARG;extensions narg; -1009;run_extensions.at:3746;System routine C\$PARAMSIZE;extensions; -1010;run_extensions.at:3788;System routine C\$CALLEDBY;extensions; -1011;run_extensions.at:3834;System routine C\$JUSTIFY;extensions; -1012;run_extensions.at:3859;System routine C\$PRINTABLE;extensions; -1013;run_extensions.at:3888;System routine C\$MAKEDIR;extensions; -1014;run_extensions.at:3909;System routine C\$GETPID;extensions; -1015;run_extensions.at:3934;System routine C\$TOUPPER;extensions; -1016;run_extensions.at:3959;System routine C\$TOLOWER;extensions; -1017;run_extensions.at:3984;System routine CBL_OR;extensions; -1018;run_extensions.at:4011;System routine CBL_NOR;extensions; -1019;run_extensions.at:4038;System routine CBL_AND;extensions; -1020;run_extensions.at:4065;System routine CBL_XOR;extensions; -1021;run_extensions.at:4092;System routine CBL_IMP;extensions; -1022;run_extensions.at:4119;System routine CBL_NIMP;extensions; -1023;run_extensions.at:4146;System routine CBL_NOT;extensions; -1024;run_extensions.at:4172;System routine CBL_EQ;extensions; -1025;run_extensions.at:4199;System routine CBL_GC_GETOPT;extensions; -1026;run_extensions.at:4636;System routine CBL_GC_FORK;extensions c\$getpid; -1027;run_extensions.at:4704;System routine CBL_GC_WAITPID;extensions cbl_gc_fork; -1028;run_extensions.at:4756;System routine CBL_GC_HOSTED;extensions; -1029;run_extensions.at:4870;System routine SYSTEM, parameter handling;chaining trim; -1030;run_extensions.at:4981;System routine CBL_ERROR_PROC;extensions exceptions error exception-location exception-statement exception-file exception-status; -1031;run_extensions.at:5069;DISPLAY DIRECTIVE and \$DISPLAY;extensions; -1032;run_extensions.at:5094;Conditional/define directives (1);extensions directive; -1033;run_extensions.at:5119;Conditional/define directives (2);extensions directive; -1034;run_extensions.at:5144;Conditional/define directives (3);extensions directive; -1035;run_extensions.at:5172;Conditional/define directives (4);extensions directive; -1036;run_extensions.at:5198;Conditional/define directives (5);extensions directive; -1037;run_extensions.at:5223;Conditional/define directives (6);extensions directive; -1038;run_extensions.at:5249;Conditional/define directives (7);extensions directive; -1039;run_extensions.at:5271;Conditional/define directives (8);extensions directive; -1040;run_extensions.at:5291;Variable format;extensions runmisc; -1041;run_extensions.at:5313;Binary COMP-1 (1);extensions; -1042;run_extensions.at:5344;Binary COMP-1 (2);extensions directives; -1043;run_ml.at:19;XML GENERATE general;extensions; -1044;run_ml.at:127;XML GENERATE SUPPRESS;extensions; -1045;run_ml.at:204;XML GENERATE exceptions;extensions xml-code; -1046;run_ml.at:300;XML GENERATE record selection;extensions; -1047;run_ml.at:344;XML GENERATE trimming;extensions; -1048;run_ml.at:441;JSON GENERATE general;extensions; -1049;run_ml.at:491;JSON GENERATE SUPPRESS;extensions; -1050;run_ml.at:530;JSON GENERATE exceptions;extensions json-code; -1051;run_ml.at:595;JSON GENERATE record selection;extensions; -1052;run_ml.at:639;JSON GENERATE trimming;extensions; -1053;data_binary.at:23;BINARY: 2-4-8 big-endian;binary; -1054;data_binary.at:205;BINARY: 2-4-8 native;binary; -1055;data_binary.at:393;BINARY: 1-2-4-8 big-endian;binary; -1056;data_binary.at:575;BINARY: 1-2-4-8 native;binary; -1057;data_binary.at:763;BINARY: 1--8 big-endian;binary; -1058;data_binary.at:945;BINARY: 1--8 native;binary; -1059;data_binary.at:1133;BINARY: full-print;binary; -1060;data_binary.at:1185;BINARY: 64bit unsigned compare;binary; -1061;data_binary.at:1210;BINARY: 64bit unsigned arithmetic notrunc;binary; -1062;data_binary.at:1239;BINARY: 64bit signed negative constant range;binary; -1063;data_binary.at:1260;COMP-4 Truncate;numeric; -1064;data_binary.at:1321;COMP-4 No Truncate;numeric; -1065;data_display.at:21;DISPLAY: Sign ASCII;display; -1066;data_display.at:80;DISPLAY: Sign ASCII (2);display; -1067;data_display.at:126;DISPLAY: Sign EBCDIC;display; -1068;data_display.at:171;DISPLAY: unsigned;display; -1069;data_packed.at:25;PACKED-DECIMAL dump;packed; -1070;data_packed.at:161;PACKED-DECIMAL used with DISPLAY;packed; -1071;data_packed.at:216;PACKED-DECIMAL used with MOVE;packed; -1072;data_packed.at:273;PACKED-DECIMAL used with INITIALIZE;packed; -1073;data_packed.at:312;PACKED-DECIMAL arithmetic;packed; -1074;data_packed.at:348;PACKED-DECIMAL numeric test (1);packed; -1075;data_packed.at:490;PACKED-DECIMAL numeric test (2);packed; -1076;data_packed.at:606;COMP-6 used with DISPLAY;packed; -1077;data_packed.at:643;COMP-6 used with MOVE;packed; -1078;data_packed.at:690;COMP-6 arithmetic;packed; -1079;data_packed.at:722;COMP-6 numeric test;packed; -1080;data_pointer.at:21;POINTER: display;pointer 64bit; -" -# List of the all the test groups. -at_groups_all=`$as_echo "$at_help_all" | sed 's/;.*//'` - -# at_fn_validate_ranges NAME... -# ----------------------------- -# Validate and normalize the test group number contained in each variable -# NAME. Leading zeroes are treated as decimal. -at_fn_validate_ranges () -{ - for at_grp - do - eval at_value=\$$at_grp - if test $at_value -lt 1 || test $at_value -gt 1080; then - $as_echo "invalid test group: $at_value" >&2 - exit 1 - fi - case $at_value in - 0*) # We want to treat leading 0 as decimal, like expr and test, but - # AS_VAR_ARITH treats it as octal if it uses $(( )). - # With XSI shells, ${at_value#${at_value%%[1-9]*}} avoids the - # expr fork, but it is not worth the effort to determine if the - # shell supports XSI when the user can just avoid leading 0. - eval $at_grp='`expr $at_value + 0`' ;; - esac - done -} - -at_prev= -for at_option -do - # If the previous option needs an argument, assign it. - if test -n "$at_prev"; then - at_option=$at_prev=$at_option - at_prev= - fi - - case $at_option in - *=?*) at_optarg=`expr "X$at_option" : '[^=]*=\(.*\)'` ;; - *) at_optarg= ;; - esac - - # Accept the important Cygnus configure options, so we can diagnose typos. - - case $at_option in - --help | -h ) - at_help_p=: - ;; - - --list | -l ) - at_list_p=: - ;; - - --version | -V ) - at_version_p=: - ;; - - --clean | -c ) - at_clean=: - ;; - - --color ) - at_color=always - ;; - --color=* ) - case $at_optarg in - no | never | none) at_color=never ;; - auto | tty | if-tty) at_color=auto ;; - always | yes | force) at_color=always ;; - *) at_optname=`echo " $at_option" | sed 's/^ //; s/=.*//'` - as_fn_error $? "unrecognized argument to $at_optname: $at_optarg" ;; - esac - ;; - - --debug | -d ) - at_debug_p=: - ;; - - --errexit | -e ) - at_debug_p=: - at_errexit_p=: - ;; - - --verbose | -v ) - at_verbose=; at_quiet=: - ;; - - --trace | -x ) - at_traceon='set -x' - at_trace_echo=echo - at_check_filter_trace=at_fn_filter_trace - ;; - - [0-9] | [0-9][0-9] | [0-9][0-9][0-9] | [0-9][0-9][0-9][0-9]) - at_fn_validate_ranges at_option - as_fn_append at_groups "$at_option$as_nl" - ;; - - # Ranges - [0-9]- | [0-9][0-9]- | [0-9][0-9][0-9]- | [0-9][0-9][0-9][0-9]-) - at_range_start=`echo $at_option |tr -d X-` - at_fn_validate_ranges at_range_start - at_range=`$as_echo "$at_groups_all" | \ - sed -ne '/^'$at_range_start'$/,$p'` - as_fn_append at_groups "$at_range$as_nl" - ;; - - -[0-9] | -[0-9][0-9] | -[0-9][0-9][0-9] | -[0-9][0-9][0-9][0-9]) - at_range_end=`echo $at_option |tr -d X-` - at_fn_validate_ranges at_range_end - at_range=`$as_echo "$at_groups_all" | \ - sed -ne '1,/^'$at_range_end'$/p'` - as_fn_append at_groups "$at_range$as_nl" - ;; - - [0-9]-[0-9] | [0-9]-[0-9][0-9] | [0-9]-[0-9][0-9][0-9] | \ - [0-9]-[0-9][0-9][0-9][0-9] | [0-9][0-9]-[0-9][0-9] | \ - [0-9][0-9]-[0-9][0-9][0-9] | [0-9][0-9]-[0-9][0-9][0-9][0-9] | \ - [0-9][0-9][0-9]-[0-9][0-9][0-9] | \ - [0-9][0-9][0-9]-[0-9][0-9][0-9][0-9] | \ - [0-9][0-9][0-9][0-9]-[0-9][0-9][0-9][0-9] ) - at_range_start=`expr $at_option : '\(.*\)-'` - at_range_end=`expr $at_option : '.*-\(.*\)'` - if test $at_range_start -gt $at_range_end; then - at_tmp=$at_range_end - at_range_end=$at_range_start - at_range_start=$at_tmp - fi - at_fn_validate_ranges at_range_start at_range_end - at_range=`$as_echo "$at_groups_all" | \ - sed -ne '/^'$at_range_start'$/,/^'$at_range_end'$/p'` - as_fn_append at_groups "$at_range$as_nl" - ;; - - # Directory selection. - --directory | -C ) - at_prev=--directory - ;; - --directory=* ) - at_change_dir=: - at_dir=$at_optarg - if test x- = "x$at_dir" ; then - at_dir=./- - fi - ;; - - # Parallel execution. - --jobs | -j ) - at_jobs=0 - ;; - --jobs=* | -j[0-9]* ) - if test -n "$at_optarg"; then - at_jobs=$at_optarg - else - at_jobs=`expr X$at_option : 'X-j\(.*\)'` - fi - case $at_jobs in *[!0-9]*) - at_optname=`echo " $at_option" | sed 's/^ //; s/[0-9=].*//'` - as_fn_error $? "non-numeric argument to $at_optname: $at_jobs" ;; - esac - ;; - - # Keywords. - --keywords | -k ) - at_prev=--keywords - ;; - --keywords=* ) - at_groups_selected=$at_help_all - at_save_IFS=$IFS - IFS=, - set X $at_optarg - shift - IFS=$at_save_IFS - for at_keyword - do - at_invert= - case $at_keyword in - '!'*) - at_invert="-v" - at_keyword=`expr "X$at_keyword" : 'X!\(.*\)'` - ;; - esac - # It is on purpose that we match the test group titles too. - at_groups_selected=`$as_echo "$at_groups_selected" | - grep -i $at_invert "^[1-9][^;]*;.*[; ]$at_keyword[ ;]"` - done - # Smash the keywords. - at_groups_selected=`$as_echo "$at_groups_selected" | sed 's/;.*//'` - as_fn_append at_groups "$at_groups_selected$as_nl" - ;; - --recheck) - at_recheck=: - ;; - - *=*) - at_envvar=`expr "x$at_option" : 'x\([^=]*\)='` - # Reject names that are not valid shell variable names. - case $at_envvar in - '' | [0-9]* | *[!_$as_cr_alnum]* ) - as_fn_error $? "invalid variable name: \`$at_envvar'" ;; - esac - at_value=`$as_echo "$at_optarg" | sed "s/'/'\\\\\\\\''/g"` - # Export now, but save eval for later and for debug scripts. - export $at_envvar - as_fn_append at_debug_args " $at_envvar='$at_value'" - ;; - - *) $as_echo "$as_me: invalid option: $at_option" >&2 - $as_echo "Try \`$0 --help' for more information." >&2 - exit 1 - ;; - esac -done - -# Verify our last option didn't require an argument -if test -n "$at_prev"; then : - as_fn_error $? "\`$at_prev' requires an argument" -fi - -# The file containing the suite. -at_suite_log=$at_dir/$as_me.log - -# Selected test groups. -if test -z "$at_groups$at_recheck"; then - at_groups=$at_groups_all -else - if test -n "$at_recheck" && test -r "$at_suite_log"; then - at_oldfails=`sed -n ' - /^Failed tests:$/,/^Skipped tests:$/{ - s/^[ ]*\([1-9][0-9]*\):.*/\1/p - } - /^Unexpected passes:$/,/^## Detailed failed tests/{ - s/^[ ]*\([1-9][0-9]*\):.*/\1/p - } - /^## Detailed failed tests/q - ' "$at_suite_log"` - as_fn_append at_groups "$at_oldfails$as_nl" - fi - # Sort the tests, removing duplicates. - at_groups=`$as_echo "$at_groups" | sort -nu | sed '/^$/d'` -fi - -if test x"$at_color" = xalways \ - || { test x"$at_color" = xauto && test -t 1; }; then - at_red=`printf '\033[0;31m'` - at_grn=`printf '\033[0;32m'` - at_lgn=`printf '\033[1;32m'` - at_blu=`printf '\033[1;34m'` - at_std=`printf '\033[m'` -else - at_red= at_grn= at_lgn= at_blu= at_std= -fi - -# Help message. -if $at_help_p; then - cat <<_ATEOF || at_write_fail=1 -Usage: $0 [OPTION]... [VARIABLE=VALUE]... [TESTS] - -Run all the tests, or the selected TESTS, given by numeric ranges, and -save a detailed log file. Upon failure, create debugging scripts. - -Do not change environment variables directly. Instead, set them via -command line arguments. Set \`AUTOTEST_PATH' to select the executables -to exercise. Each relative directory is expanded as build and source -directories relative to the top level of this distribution. -E.g., from within the build directory /tmp/foo-1.0, invoking this: - - $ $0 AUTOTEST_PATH=bin - -is equivalent to the following, assuming the source directory is /src/foo-1.0: - - PATH=/tmp/foo-1.0/bin:/src/foo-1.0/bin:\$PATH $0 -_ATEOF -cat <<_ATEOF || at_write_fail=1 - -Operation modes: - -h, --help print the help message, then exit - -V, --version print version number, then exit - -c, --clean remove all the files this test suite might create and exit - -l, --list describes all the tests, or the selected TESTS -_ATEOF -cat <<_ATEOF || at_write_fail=1 - -Execution tuning: - -C, --directory=DIR - change to directory DIR before starting - --color[=never|auto|always] - disable colored test results, or enable even without terminal - -j, --jobs[=N] - Allow N jobs at once; infinite jobs with no arg (default 1) - -k, --keywords=KEYWORDS - select the tests matching all the comma-separated KEYWORDS - multiple \`-k' accumulate; prefixed \`!' negates a KEYWORD - --recheck select all tests that failed or passed unexpectedly last time - -e, --errexit abort as soon as a test fails; implies --debug - -v, --verbose force more detailed output - default for debugging scripts - -d, --debug inhibit clean up and top-level logging - default for debugging scripts - -x, --trace enable tests shell tracing -_ATEOF -cat <<_ATEOF || at_write_fail=1 - -Report bugs to . -GnuCOBOL home page: . -_ATEOF - exit $at_write_fail -fi - -# List of tests. -if $at_list_p; then - cat <<_ATEOF || at_write_fail=1 -GnuCOBOL 4.0-early-dev test suite: GnuCOBOL Tests test groups: - - NUM: FILE-NAME:LINE TEST-GROUP-NAME - KEYWORDS - -_ATEOF - # Pass an empty line as separator between selected groups and help. - $as_echo "$at_groups$as_nl$as_nl$at_help_all" | - awk 'NF == 1 && FS != ";" { - selected[$ 1] = 1 - next - } - /^$/ { FS = ";" } - NF > 0 { - if (selected[$ 1]) { - printf " %3d: %-18s %s\n", $ 1, $ 2, $ 3 - if ($ 4) { - lmax = 79 - indent = " " - line = indent - len = length (line) - n = split ($ 4, a, " ") - for (i = 1; i <= n; i++) { - l = length (a[i]) + 1 - if (i > 1 && len + l > lmax) { - print line - line = indent " " a[i] - len = length (line) - } else { - line = line " " a[i] - len += l - } - } - if (n) - print line - } - } - }' || at_write_fail=1 - exit $at_write_fail -fi -if $at_version_p; then - $as_echo "$as_me (GnuCOBOL 4.0-early-dev)" && - cat <<\_ATEOF || at_write_fail=1 - -Test cases Copyright (C) 2020 Free Software Foundation, Inc. - -Written by Keisuke Nishida, Roger While, Simon Sobisch, Edward Hart, -Ron Norman, Brian Tiffin, Dave Pitts - -Copyright (C) 2012 Free Software Foundation, Inc. -This test suite is free software; the Free Software Foundation gives -unlimited permission to copy, distribute and modify it. -_ATEOF - exit $at_write_fail -fi - -# Should we print banners? Yes if more than one test is run. -case $at_groups in #( - *$as_nl* ) - at_print_banners=: ;; #( - * ) at_print_banners=false ;; -esac -# Text for banner N, set to a single space once printed. -# Banner 1. testsuite.at:32 -# Category starts at test group 1. -at_banner_text_1="General tests of used binaries" -# Banner 2. testsuite.at:37 -# Category starts at test group 44. -at_banner_text_2="Syntax tests" -# Banner 3. testsuite.at:56 -# Category starts at test group 390. -at_banner_text_3="Listing tests" -# Banner 4. testsuite.at:61 -# Category starts at test group 419. -at_banner_text_4="Run tests" -# Banner 5. testsuite.at:77 -# Category starts at test group 1053. -at_banner_text_5="Data Representation" - -# Take any -C into account. -if $at_change_dir ; then - test x != "x$at_dir" && cd "$at_dir" \ - || as_fn_error $? "unable to change directory" - at_dir=`pwd` -fi - -# Load the config files for any default variable assignments. -for at_file in atconfig atlocal -do - test -r $at_file || continue - . ./$at_file || as_fn_error $? "invalid content: $at_file" -done - -# Autoconf <=2.59b set at_top_builddir instead of at_top_build_prefix: -: "${at_top_build_prefix=$at_top_builddir}" - -# Perform any assignments requested during argument parsing. -eval "$at_debug_args" - -# atconfig delivers names relative to the directory the test suite is -# in, but the groups themselves are run in testsuite-dir/group-dir. -if test -n "$at_top_srcdir"; then - builddir=../.. - for at_dir_var in srcdir top_srcdir top_build_prefix - do - eval at_val=\$at_$at_dir_var - case $at_val in - [\\/$]* | ?:[\\/]* ) at_prefix= ;; - *) at_prefix=../../ ;; - esac - eval "$at_dir_var=\$at_prefix\$at_val" - done -fi - -## -------------------- ## -## Directory structure. ## -## -------------------- ## - -# This is the set of directories and files used by this script -# (non-literals are capitalized): -# -# TESTSUITE - the testsuite -# TESTSUITE.log - summarizes the complete testsuite run -# TESTSUITE.dir/ - created during a run, remains after -d or failed test -# + at-groups/ - during a run: status of all groups in run -# | + NNN/ - during a run: meta-data about test group NNN -# | | + check-line - location (source file and line) of current AT_CHECK -# | | + status - exit status of current AT_CHECK -# | | + stdout - stdout of current AT_CHECK -# | | + stder1 - stderr, including trace -# | | + stderr - stderr, with trace filtered out -# | | + test-source - portion of testsuite that defines group -# | | + times - timestamps for computing duration -# | | + pass - created if group passed -# | | + xpass - created if group xpassed -# | | + fail - created if group failed -# | | + xfail - created if group xfailed -# | | + skip - created if group skipped -# + at-stop - during a run: end the run if this file exists -# + at-source-lines - during a run: cache of TESTSUITE line numbers for extraction -# + 0..NNN/ - created for each group NNN, remains after -d or failed test -# | + TESTSUITE.log - summarizes the group results -# | + ... - files created during the group - -# The directory the whole suite works in. -# Should be absolute to let the user `cd' at will. -at_suite_dir=$at_dir/$as_me.dir -# The file containing the suite ($at_dir might have changed since earlier). -at_suite_log=$at_dir/$as_me.log -# The directory containing helper files per test group. -at_helper_dir=$at_suite_dir/at-groups -# Stop file: if it exists, do not start new jobs. -at_stop_file=$at_suite_dir/at-stop -# The fifo used for the job dispatcher. -at_job_fifo=$at_suite_dir/at-job-fifo - -if $at_clean; then - test -d "$at_suite_dir" && - find "$at_suite_dir" -type d ! -perm -700 -exec chmod u+rwx \{\} \; - rm -f -r "$at_suite_dir" "$at_suite_log" - exit $? -fi - -# Don't take risks: use only absolute directories in PATH. -# -# For stand-alone test suites (ie. atconfig was not found), -# AUTOTEST_PATH is relative to `.'. -# -# For embedded test suites, AUTOTEST_PATH is relative to the top level -# of the package. Then expand it into build/src parts, since users -# may create executables in both places. -AUTOTEST_PATH=`$as_echo "$AUTOTEST_PATH" | sed "s|:|$PATH_SEPARATOR|g"` -at_path= -as_save_IFS=$IFS; IFS=$PATH_SEPARATOR -for as_dir in $AUTOTEST_PATH $PATH -do - IFS=$as_save_IFS - test -z "$as_dir" && as_dir=. - test -n "$at_path" && as_fn_append at_path $PATH_SEPARATOR -case $as_dir in - [\\/]* | ?:[\\/]* ) - as_fn_append at_path "$as_dir" - ;; - * ) - if test -z "$at_top_build_prefix"; then - # Stand-alone test suite. - as_fn_append at_path "$as_dir" - else - # Embedded test suite. - as_fn_append at_path "$at_top_build_prefix$as_dir$PATH_SEPARATOR" - as_fn_append at_path "$at_top_srcdir/$as_dir" - fi - ;; -esac - done -IFS=$as_save_IFS - - -# Now build and simplify PATH. -# -# There might be directories that don't exist, but don't redirect -# builtins' (eg., cd) stderr directly: Ultrix's sh hates that. -at_new_path= -as_save_IFS=$IFS; IFS=$PATH_SEPARATOR -for as_dir in $at_path -do - IFS=$as_save_IFS - test -z "$as_dir" && as_dir=. - test -d "$as_dir" || continue -case $as_dir in - [\\/]* | ?:[\\/]* ) ;; - * ) as_dir=`(cd "$as_dir" && pwd) 2>/dev/null` ;; -esac -case $PATH_SEPARATOR$at_new_path$PATH_SEPARATOR in - *$PATH_SEPARATOR$as_dir$PATH_SEPARATOR*) ;; - $PATH_SEPARATOR$PATH_SEPARATOR) at_new_path=$as_dir ;; - *) as_fn_append at_new_path "$PATH_SEPARATOR$as_dir" ;; -esac - done -IFS=$as_save_IFS - -PATH=$at_new_path -export PATH - -# Setting up the FDs. - - - -# 5 is the log file. Not to be overwritten if `-d'. -if $at_debug_p; then - at_suite_log=/dev/null -else - : >"$at_suite_log" -fi -exec 5>>"$at_suite_log" - -# Banners and logs. -$as_echo "## -------------------------------------------------- ## -## GnuCOBOL 4.0-early-dev test suite: GnuCOBOL Tests. ## -## -------------------------------------------------- ##" -{ - $as_echo "## -------------------------------------------------- ## -## GnuCOBOL 4.0-early-dev test suite: GnuCOBOL Tests. ## -## -------------------------------------------------- ##" - echo - - $as_echo "$as_me: command line was:" - $as_echo " \$ $0 $at_cli_args" - echo - - # If ChangeLog exists, list a few lines in case it might help determining - # the exact version. - if test -n "$at_top_srcdir" && test -f "$at_top_srcdir/ChangeLog"; then - $as_echo "## ---------- ## -## ChangeLog. ## -## ---------- ##" - echo - sed 's/^/| /;10q' "$at_top_srcdir/ChangeLog" - echo - fi - - { -cat <<_ASUNAME -## --------- ## -## Platform. ## -## --------- ## - -hostname = `(hostname || uname -n) 2>/dev/null | sed 1q` -uname -m = `(uname -m) 2>/dev/null || echo unknown` -uname -r = `(uname -r) 2>/dev/null || echo unknown` -uname -s = `(uname -s) 2>/dev/null || echo unknown` -uname -v = `(uname -v) 2>/dev/null || echo unknown` - -/usr/bin/uname -p = `(/usr/bin/uname -p) 2>/dev/null || echo unknown` -/bin/uname -X = `(/bin/uname -X) 2>/dev/null || echo unknown` - -/bin/arch = `(/bin/arch) 2>/dev/null || echo unknown` -/usr/bin/arch -k = `(/usr/bin/arch -k) 2>/dev/null || echo unknown` -/usr/convex/getsysinfo = `(/usr/convex/getsysinfo) 2>/dev/null || echo unknown` -/usr/bin/hostinfo = `(/usr/bin/hostinfo) 2>/dev/null || echo unknown` -/bin/machine = `(/bin/machine) 2>/dev/null || echo unknown` -/usr/bin/oslevel = `(/usr/bin/oslevel) 2>/dev/null || echo unknown` -/bin/universe = `(/bin/universe) 2>/dev/null || echo unknown` - -_ASUNAME - -as_save_IFS=$IFS; IFS=$PATH_SEPARATOR -for as_dir in $PATH -do - IFS=$as_save_IFS - test -z "$as_dir" && as_dir=. - $as_echo "PATH: $as_dir" - done -IFS=$as_save_IFS - -} - echo - - # Contents of the config files. - for at_file in atconfig atlocal - do - test -r $at_file || continue - $as_echo "$as_me: $at_file:" - sed 's/^/| /' $at_file - echo - done -} >&5 - - -## ------------------------- ## -## Autotest shell functions. ## -## ------------------------- ## - -# at_fn_banner NUMBER -# ------------------- -# Output banner NUMBER, provided the testsuite is running multiple groups and -# this particular banner has not yet been printed. -at_fn_banner () -{ - $at_print_banners || return 0 - eval at_banner_text=\$at_banner_text_$1 - test "x$at_banner_text" = "x " && return 0 - eval "at_banner_text_$1=\" \"" - if test -z "$at_banner_text"; then - $at_first || echo - else - $as_echo "$as_nl$at_banner_text$as_nl" - fi -} # at_fn_banner - -# at_fn_check_prepare_notrace REASON LINE -# --------------------------------------- -# Perform AT_CHECK preparations for the command at LINE for an untraceable -# command; REASON is the reason for disabling tracing. -at_fn_check_prepare_notrace () -{ - $at_trace_echo "Not enabling shell tracing (command contains $1)" - $as_echo "$2" >"$at_check_line_file" - at_check_trace=: at_check_filter=: - : >"$at_stdout"; : >"$at_stderr" -} - -# at_fn_check_prepare_trace LINE -# ------------------------------ -# Perform AT_CHECK preparations for the command at LINE for a traceable -# command. -at_fn_check_prepare_trace () -{ - $as_echo "$1" >"$at_check_line_file" - at_check_trace=$at_traceon at_check_filter=$at_check_filter_trace - : >"$at_stdout"; : >"$at_stderr" -} - -# at_fn_check_prepare_dynamic COMMAND LINE -# ---------------------------------------- -# Decide if COMMAND at LINE is traceable at runtime, and call the appropriate -# preparation function. -at_fn_check_prepare_dynamic () -{ - case $1 in - *$as_nl*) - at_fn_check_prepare_notrace 'an embedded newline' "$2" ;; - *) - at_fn_check_prepare_trace "$2" ;; - esac -} - -# at_fn_filter_trace -# ------------------ -# Remove the lines in the file "$at_stderr" generated by "set -x" and print -# them to stderr. -at_fn_filter_trace () -{ - mv "$at_stderr" "$at_stder1" - grep '^ *+' "$at_stder1" >&2 - grep -v '^ *+' "$at_stder1" >"$at_stderr" -} - -# at_fn_log_failure FILE-LIST -# --------------------------- -# Copy the files in the list on stdout with a "> " prefix, and exit the shell -# with a failure exit code. -at_fn_log_failure () -{ - for file - do $as_echo "$file:"; sed 's/^/> /' "$file"; done - echo 1 > "$at_status_file" - exit 1 -} - -# at_fn_check_skip EXIT-CODE LINE -# ------------------------------- -# Check whether EXIT-CODE is a special exit code (77 or 99), and if so exit -# the test group subshell with that same exit code. Use LINE in any report -# about test failure. -at_fn_check_skip () -{ - case $1 in - 99) echo 99 > "$at_status_file"; at_failed=: - $as_echo "$2: hard failure"; exit 99;; - 77) echo 77 > "$at_status_file"; exit 77;; - esac -} - -# at_fn_check_status EXPECTED EXIT-CODE LINE -# ------------------------------------------ -# Check whether EXIT-CODE is the EXPECTED exit code, and if so do nothing. -# Otherwise, if it is 77 or 99, exit the test group subshell with that same -# exit code; if it is anything else print an error message referring to LINE, -# and fail the test. -at_fn_check_status () -{ - case $2 in - $1 ) ;; - 77) echo 77 > "$at_status_file"; exit 77;; - 99) echo 99 > "$at_status_file"; at_failed=: - $as_echo "$3: hard failure"; exit 99;; - *) $as_echo "$3: exit code was $2, expected $1" - at_failed=:;; - esac -} - -# at_fn_diff_devnull FILE -# ----------------------- -# Emit a diff between /dev/null and FILE. Uses "test -s" to avoid useless diff -# invocations. -at_fn_diff_devnull () -{ - test -s "$1" || return 0 - $at_diff "$at_devnull" "$1" -} - -# at_fn_test NUMBER -# ----------------- -# Parse out test NUMBER from the tail of this file. -at_fn_test () -{ - eval at_sed=\$at_sed$1 - sed "$at_sed" "$at_myself" > "$at_test_source" -} - -# at_fn_create_debugging_script -# ----------------------------- -# Create the debugging script $at_group_dir/run which will reproduce the -# current test group. -at_fn_create_debugging_script () -{ - { - echo "#! /bin/sh" && - echo 'test "${ZSH_VERSION+set}" = set && alias -g '\''${1+"$@"}'\''='\''"$@"'\''' && - $as_echo "cd '$at_dir'" && - $as_echo "exec \${CONFIG_SHELL-$SHELL} \"$at_myself\" -v -d $at_debug_args $at_group \${1+\"\$@\"}" && - echo 'exit 1' - } >"$at_group_dir/run" && - chmod +x "$at_group_dir/run" -} - -## -------------------------------- ## -## End of autotest shell functions. ## -## -------------------------------- ## -{ - $as_echo "## ---------------- ## -## Tested programs. ## -## ---------------- ##" - echo -} >&5 - -# Report what programs are being tested. -for at_program in : $at_tested -do - test "$at_program" = : && continue - case $at_program in - [\\/]* | ?:[\\/]* ) $at_program_=$at_program ;; - * ) - as_save_IFS=$IFS; IFS=$PATH_SEPARATOR -for as_dir in $PATH -do - IFS=$as_save_IFS - test -z "$as_dir" && as_dir=. - test -f "$as_dir/$at_program" && break - done -IFS=$as_save_IFS - - at_program_=$as_dir/$at_program ;; - esac - if test -f "$at_program_"; then - { - $as_echo "$at_srcdir/testsuite.at:26: $at_program_ --version" - "$at_program_" --version &5 2>&1 - else - as_fn_error $? "cannot find $at_program" "$LINENO" 5 - fi -done - -{ - $as_echo "## ------------------ ## -## Running the tests. ## -## ------------------ ##" -} >&5 - -at_start_date=`date` -at_start_time=`date +%s 2>/dev/null` -$as_echo "$as_me: starting at: $at_start_date" >&5 - -# Create the master directory if it doesn't already exist. -as_dir="$at_suite_dir"; as_fn_mkdir_p || - as_fn_error $? "cannot create \`$at_suite_dir'" "$LINENO" 5 - -# Can we diff with `/dev/null'? DU 5.0 refuses. -if diff /dev/null /dev/null >/dev/null 2>&1; then - at_devnull=/dev/null -else - at_devnull=$at_suite_dir/devnull - >"$at_devnull" -fi - -# Use `diff -u' when possible. -if at_diff=`diff -u "$at_devnull" "$at_devnull" 2>&1` && test -z "$at_diff" -then - at_diff='diff -u' -else - at_diff=diff -fi - -# Get the last needed group. -for at_group in : $at_groups; do :; done - -# Extract the start and end lines of each test group at the tail -# of this file -awk ' -BEGIN { FS="" } -/^#AT_START_/ { - start = NR -} -/^#AT_STOP_/ { - test = substr ($ 0, 10) - print "at_sed" test "=\"1," start "d;" (NR-1) "q\"" - if (test == "'"$at_group"'") exit -}' "$at_myself" > "$at_suite_dir/at-source-lines" && -. "$at_suite_dir/at-source-lines" || - as_fn_error $? "cannot create test line number cache" "$LINENO" 5 -rm -f "$at_suite_dir/at-source-lines" - -# Set number of jobs for `-j'; avoid more jobs than test groups. -set X $at_groups; shift; at_max_jobs=$# -if test $at_max_jobs -eq 0; then - at_jobs=1 -fi -if test $at_jobs -ne 1 && - { test $at_jobs -eq 0 || test $at_jobs -gt $at_max_jobs; }; then - at_jobs=$at_max_jobs -fi - -# If parallel mode, don't output banners, don't split summary lines. -if test $at_jobs -ne 1; then - at_print_banners=false - at_quiet=: -fi - -# Set up helper dirs. -rm -rf "$at_helper_dir" && -mkdir "$at_helper_dir" && -cd "$at_helper_dir" && -{ test -z "$at_groups" || mkdir $at_groups; } || -as_fn_error $? "testsuite directory setup failed" "$LINENO" 5 - -# Functions for running a test group. We leave the actual -# test group execution outside of a shell function in order -# to avoid hitting zsh 4.x exit status bugs. - -# at_fn_group_prepare -# ------------------- -# Prepare for running a test group. -at_fn_group_prepare () -{ - # The directory for additional per-group helper files. - at_job_dir=$at_helper_dir/$at_group - # The file containing the location of the last AT_CHECK. - at_check_line_file=$at_job_dir/check-line - # The file containing the exit status of the last command. - at_status_file=$at_job_dir/status - # The files containing the output of the tested commands. - at_stdout=$at_job_dir/stdout - at_stder1=$at_job_dir/stder1 - at_stderr=$at_job_dir/stderr - # The file containing the code for a test group. - at_test_source=$at_job_dir/test-source - # The file containing dates. - at_times_file=$at_job_dir/times - - # Be sure to come back to the top test directory. - cd "$at_suite_dir" - - # Clearly separate the test groups when verbose. - $at_first || $at_verbose echo - - at_group_normalized=$at_group - - eval 'while :; do - case $at_group_normalized in #( - '"$at_format"'*) break;; - esac - at_group_normalized=0$at_group_normalized - done' - - - # Create a fresh directory for the next test group, and enter. - # If one already exists, the user may have invoked ./run from - # within that directory; we remove the contents, but not the - # directory itself, so that we aren't pulling the rug out from - # under the shell's notion of the current directory. - at_group_dir=$at_suite_dir/$at_group_normalized - at_group_log=$at_group_dir/$as_me.log - if test -d "$at_group_dir"; then - find "$at_group_dir" -type d ! -perm -700 -exec chmod u+rwx {} \; - rm -fr "$at_group_dir"/* "$at_group_dir"/.[!.] "$at_group_dir"/.??* -fi || - { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: test directory for $at_group_normalized could not be cleaned" >&5 -$as_echo "$as_me: WARNING: test directory for $at_group_normalized could not be cleaned" >&2;} - # Be tolerant if the above `rm' was not able to remove the directory. - as_dir="$at_group_dir"; as_fn_mkdir_p - - echo 0 > "$at_status_file" - - # In verbose mode, append to the log file *and* show on - # the standard output; in quiet mode only write to the log. - if test -z "$at_verbose"; then - at_tee_pipe='tee -a "$at_group_log"' - else - at_tee_pipe='cat >> "$at_group_log"' - fi -} - -# at_fn_group_banner ORDINAL LINE DESC PAD [BANNER] -# ------------------------------------------------- -# Declare the test group ORDINAL, located at LINE with group description DESC, -# and residing under BANNER. Use PAD to align the status column. -at_fn_group_banner () -{ - at_setup_line="$2" - test -n "$5" && at_fn_banner $5 - at_desc="$3" - case $1 in - [0-9]) at_desc_line=" $1: ";; - [0-9][0-9]) at_desc_line=" $1: " ;; - *) at_desc_line="$1: " ;; - esac - as_fn_append at_desc_line "$3$4" - $at_quiet $as_echo_n "$at_desc_line" - echo "# -*- compilation -*-" >> "$at_group_log" -} - -# at_fn_group_postprocess -# ----------------------- -# Perform cleanup after running a test group. -at_fn_group_postprocess () -{ - # Be sure to come back to the suite directory, in particular - # since below we might `rm' the group directory we are in currently. - cd "$at_suite_dir" - - if test ! -f "$at_check_line_file"; then - sed "s/^ */$as_me: WARNING: /" <<_ATEOF - A failure happened in a test group before any test could be - run. This means that test suite is improperly designed. Please - report this failure to . -_ATEOF - $as_echo "$at_setup_line" >"$at_check_line_file" - at_status=99 - fi - $at_verbose $as_echo_n "$at_group. $at_setup_line: " - $as_echo_n "$at_group. $at_setup_line: " >> "$at_group_log" - case $at_xfail:$at_status in - yes:0) - at_msg="UNEXPECTED PASS" - at_res=xpass - at_errexit=$at_errexit_p - at_color=$at_red - ;; - no:0) - at_msg="ok" - at_res=pass - at_errexit=false - at_color=$at_grn - ;; - *:77) - at_msg='skipped ('`cat "$at_check_line_file"`')' - at_res=skip - at_errexit=false - at_color=$at_blu - ;; - no:* | *:99) - at_msg='FAILED ('`cat "$at_check_line_file"`')' - at_res=fail - at_errexit=$at_errexit_p - at_color=$at_red - ;; - yes:*) - at_msg='expected failure ('`cat "$at_check_line_file"`')' - at_res=xfail - at_errexit=false - at_color=$at_lgn - ;; - esac - echo "$at_res" > "$at_job_dir/$at_res" - # In parallel mode, output the summary line only afterwards. - if test $at_jobs -ne 1 && test -n "$at_verbose"; then - $as_echo "$at_desc_line $at_color$at_msg$at_std" - else - # Make sure there is a separator even with long titles. - $as_echo " $at_color$at_msg$at_std" - fi - at_log_msg="$at_group. $at_desc ($at_setup_line): $at_msg" - case $at_status in - 0|77) - # $at_times_file is only available if the group succeeded. - # We're not including the group log, so the success message - # is written in the global log separately. But we also - # write to the group log in case they're using -d. - if test -f "$at_times_file"; then - at_log_msg="$at_log_msg ("`sed 1d "$at_times_file"`')' - rm -f "$at_times_file" - fi - $as_echo "$at_log_msg" >> "$at_group_log" - $as_echo "$at_log_msg" >&5 - - # Cleanup the group directory, unless the user wants the files - # or the success was unexpected. - if $at_debug_p || test $at_res = xpass; then - at_fn_create_debugging_script - if test $at_res = xpass && $at_errexit; then - echo stop > "$at_stop_file" - fi - else - if test -d "$at_group_dir"; then - find "$at_group_dir" -type d ! -perm -700 -exec chmod u+rwx \{\} \; - rm -fr "$at_group_dir" - fi - rm -f "$at_test_source" - fi - ;; - *) - # Upon failure, include the log into the testsuite's global - # log. The failure message is written in the group log. It - # is later included in the global log. - $as_echo "$at_log_msg" >> "$at_group_log" - - # Upon failure, keep the group directory for autopsy, and create - # the debugging script. With -e, do not start any further tests. - at_fn_create_debugging_script - if $at_errexit; then - echo stop > "$at_stop_file" - fi - ;; - esac -} - - -## ------------ ## -## Driver loop. ## -## ------------ ## - - -if (set -m && set +m && set +b) >/dev/null 2>&1; then - set +b - at_job_control_on='set -m' at_job_control_off='set +m' at_job_group=- -else - at_job_control_on=: at_job_control_off=: at_job_group= -fi - -for at_signal in 1 2 15; do - trap 'set +x; set +e - $at_job_control_off - at_signal='"$at_signal"' - echo stop > "$at_stop_file" - trap "" $at_signal - at_pgids= - for at_pgid in `jobs -p 2>/dev/null`; do - at_pgids="$at_pgids $at_job_group$at_pgid" - done - test -z "$at_pgids" || kill -$at_signal $at_pgids 2>/dev/null - wait - if test "$at_jobs" -eq 1 || test -z "$at_verbose"; then - echo >&2 - fi - at_signame=`kill -l $at_signal 2>&1 || echo $at_signal` - set x $at_signame - test 1 -gt 2 && at_signame=$at_signal - { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: caught signal $at_signame, bailing out" >&5 -$as_echo "$as_me: WARNING: caught signal $at_signame, bailing out" >&2;} - as_fn_arith 128 + $at_signal && exit_status=$as_val - as_fn_exit $exit_status' $at_signal -done - -rm -f "$at_stop_file" -at_first=: - -if test $at_jobs -ne 1 && - rm -f "$at_job_fifo" && - test -n "$at_job_group" && - ( mkfifo "$at_job_fifo" && trap 'exit 1' PIPE STOP TSTP ) 2>/dev/null -then - # FIFO job dispatcher. - - trap 'at_pids= - for at_pid in `jobs -p`; do - at_pids="$at_pids $at_job_group$at_pid" - done - if test -n "$at_pids"; then - at_sig=TSTP - test "${TMOUT+set}" = set && at_sig=STOP - kill -$at_sig $at_pids 2>/dev/null - fi - kill -STOP $$ - test -z "$at_pids" || kill -CONT $at_pids 2>/dev/null' TSTP - - echo - # Turn jobs into a list of numbers, starting from 1. - at_joblist=`$as_echo "$at_groups" | sed -n 1,${at_jobs}p` - - set X $at_joblist - shift - for at_group in $at_groups; do - $at_job_control_on 2>/dev/null - ( - # Start one test group. - $at_job_control_off - if $at_first; then - exec 7>"$at_job_fifo" - else - exec 6<&- - fi - trap 'set +x; set +e - trap "" PIPE - echo stop > "$at_stop_file" - echo >&7 - as_fn_exit 141' PIPE - at_fn_group_prepare - if cd "$at_group_dir" && - at_fn_test $at_group && - . "$at_test_source" - then :; else - { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: unable to parse test group: $at_group" >&5 -$as_echo "$as_me: WARNING: unable to parse test group: $at_group" >&2;} - at_failed=: - fi - at_fn_group_postprocess - echo >&7 - ) & - $at_job_control_off - if $at_first; then - at_first=false - exec 6<"$at_job_fifo" 7>"$at_job_fifo" - fi - shift # Consume one token. - if test $# -gt 0; then :; else - read at_token <&6 || break - set x $* - fi - test -f "$at_stop_file" && break - done - exec 7>&- - # Read back the remaining ($at_jobs - 1) tokens. - set X $at_joblist - shift - if test $# -gt 0; then - shift - for at_job - do - read at_token - done <&6 - fi - exec 6<&- - wait -else - # Run serially, avoid forks and other potential surprises. - for at_group in $at_groups; do - at_fn_group_prepare - if cd "$at_group_dir" && - at_fn_test $at_group && - . "$at_test_source"; then :; else - { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: unable to parse test group: $at_group" >&5 -$as_echo "$as_me: WARNING: unable to parse test group: $at_group" >&2;} - at_failed=: - fi - at_fn_group_postprocess - test -f "$at_stop_file" && break - at_first=false - done -fi - -# Wrap up the test suite with summary statistics. -cd "$at_helper_dir" - -# Use ?..???? when the list must remain sorted, the faster * otherwise. -at_pass_list=`for f in */pass; do echo $f; done | sed '/\*/d; s,/pass,,'` -at_skip_list=`for f in */skip; do echo $f; done | sed '/\*/d; s,/skip,,'` -at_xfail_list=`for f in */xfail; do echo $f; done | sed '/\*/d; s,/xfail,,'` -at_xpass_list=`for f in ?/xpass ??/xpass ???/xpass ????/xpass; do - echo $f; done | sed '/?/d; s,/xpass,,'` -at_fail_list=`for f in ?/fail ??/fail ???/fail ????/fail; do - echo $f; done | sed '/?/d; s,/fail,,'` - -set X $at_pass_list $at_xpass_list $at_xfail_list $at_fail_list $at_skip_list -shift; at_group_count=$# -set X $at_xpass_list; shift; at_xpass_count=$#; at_xpass_list=$* -set X $at_xfail_list; shift; at_xfail_count=$# -set X $at_fail_list; shift; at_fail_count=$#; at_fail_list=$* -set X $at_skip_list; shift; at_skip_count=$# - -as_fn_arith $at_group_count - $at_skip_count && at_run_count=$as_val -as_fn_arith $at_xpass_count + $at_fail_count && at_unexpected_count=$as_val -as_fn_arith $at_xfail_count + $at_fail_count && at_total_fail_count=$as_val - -# Back to the top directory. -cd "$at_dir" -rm -rf "$at_helper_dir" - -# Compute the duration of the suite. -at_stop_date=`date` -at_stop_time=`date +%s 2>/dev/null` -$as_echo "$as_me: ending at: $at_stop_date" >&5 -case $at_start_time,$at_stop_time in - [0-9]*,[0-9]*) - as_fn_arith $at_stop_time - $at_start_time && at_duration_s=$as_val - as_fn_arith $at_duration_s / 60 && at_duration_m=$as_val - as_fn_arith $at_duration_m / 60 && at_duration_h=$as_val - as_fn_arith $at_duration_s % 60 && at_duration_s=$as_val - as_fn_arith $at_duration_m % 60 && at_duration_m=$as_val - at_duration="${at_duration_h}h ${at_duration_m}m ${at_duration_s}s" - $as_echo "$as_me: test suite duration: $at_duration" >&5 - ;; -esac - -echo -$as_echo "## ------------- ## -## Test results. ## -## ------------- ##" -echo -{ - echo - $as_echo "## ------------- ## -## Test results. ## -## ------------- ##" - echo -} >&5 - -if test $at_run_count = 1; then - at_result="1 test" - at_were=was -else - at_result="$at_run_count tests" - at_were=were -fi -if $at_errexit_p && test $at_unexpected_count != 0; then - if test $at_xpass_count = 1; then - at_result="$at_result $at_were run, one passed" - else - at_result="$at_result $at_were run, one failed" - fi - at_result="$at_result unexpectedly and inhibited subsequent tests." - at_color=$at_red -else - # Don't you just love exponential explosion of the number of cases? - at_color=$at_red - case $at_xpass_count:$at_fail_count:$at_xfail_count in - # So far, so good. - 0:0:0) at_result="$at_result $at_were successful." at_color=$at_grn ;; - 0:0:*) at_result="$at_result behaved as expected." at_color=$at_lgn ;; - - # Some unexpected failures - 0:*:0) at_result="$at_result $at_were run, -$at_fail_count failed unexpectedly." ;; - - # Some failures, both expected and unexpected - 0:*:1) at_result="$at_result $at_were run, -$at_total_fail_count failed ($at_xfail_count expected failure)." ;; - 0:*:*) at_result="$at_result $at_were run, -$at_total_fail_count failed ($at_xfail_count expected failures)." ;; - - # No unexpected failures, but some xpasses - *:0:*) at_result="$at_result $at_were run, -$at_xpass_count passed unexpectedly." ;; - - # No expected failures, but failures and xpasses - *:1:0) at_result="$at_result $at_were run, -$at_unexpected_count did not behave as expected ($at_fail_count unexpected failure)." ;; - *:*:0) at_result="$at_result $at_were run, -$at_unexpected_count did not behave as expected ($at_fail_count unexpected failures)." ;; - - # All of them. - *:*:1) at_result="$at_result $at_were run, -$at_xpass_count passed unexpectedly, -$at_total_fail_count failed ($at_xfail_count expected failure)." ;; - *:*:*) at_result="$at_result $at_were run, -$at_xpass_count passed unexpectedly, -$at_total_fail_count failed ($at_xfail_count expected failures)." ;; - esac - - if test $at_skip_count = 0 && test $at_run_count -gt 1; then - at_result="All $at_result" - fi -fi - -# Now put skips in the mix. -case $at_skip_count in - 0) ;; - 1) at_result="$at_result -1 test was skipped." ;; - *) at_result="$at_result -$at_skip_count tests were skipped." ;; -esac - -if test $at_unexpected_count = 0; then - echo "$at_color$at_result$at_std" - echo "$at_result" >&5 -else - echo "${at_color}ERROR: $at_result$at_std" >&2 - echo "ERROR: $at_result" >&5 - { - echo - $as_echo "## ------------------------ ## -## Summary of the failures. ## -## ------------------------ ##" - - # Summary of failed and skipped tests. - if test $at_fail_count != 0; then - echo "Failed tests:" - $SHELL "$at_myself" $at_fail_list --list - echo - fi - if test $at_skip_count != 0; then - echo "Skipped tests:" - $SHELL "$at_myself" $at_skip_list --list - echo - fi - if test $at_xpass_count != 0; then - echo "Unexpected passes:" - $SHELL "$at_myself" $at_xpass_list --list - echo - fi - if test $at_fail_count != 0; then - $as_echo "## ---------------------- ## -## Detailed failed tests. ## -## ---------------------- ##" - echo - for at_group in $at_fail_list - do - at_group_normalized=$at_group - - eval 'while :; do - case $at_group_normalized in #( - '"$at_format"'*) break;; - esac - at_group_normalized=0$at_group_normalized - done' - - cat "$at_suite_dir/$at_group_normalized/$as_me.log" - echo - done - echo - fi - if test -n "$at_top_srcdir"; then - sed 'h;s/./-/g;s/^.../## /;s/...$/ ##/;p;x;p;x' <<_ASBOX -## ${at_top_build_prefix}config.log ## -_ASBOX - sed 's/^/| /' ${at_top_build_prefix}config.log - echo - fi - } >&5 - - sed 'h;s/./-/g;s/^.../## /;s/...$/ ##/;p;x;p;x' <<_ASBOX -## $as_me.log was created. ## -_ASBOX - - echo - if $at_debug_p; then - at_msg='per-test log files' - else - at_msg="\`${at_testdir+${at_testdir}/}$as_me.log'" - fi - $as_echo "Please send $at_msg and all information you think might help: - - To: - Subject: [GnuCOBOL 4.0-early-dev] $as_me: $at_fail_list${at_fail_list:+ failed${at_xpass_list:+, }}$at_xpass_list${at_xpass_list:+ passed unexpectedly} - -You may investigate any problem if you feel able to do so, in which -case the test suite provides a good starting point. Its output may -be found below \`${at_testdir+${at_testdir}/}$as_me.dir'. -" - exit 1 -fi - -exit 0 - -## ------------- ## -## Actual tests. ## -## ------------- ## -#AT_START_1 -at_fn_group_banner 1 'used_binaries.at:27' \ - "Compiler help and information" " " 1 -at_xfail=no -( - $as_echo "1. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -# FIXME: check at least some parts of the output by using $GREP -{ set +x -$as_echo "$at_srcdir/used_binaries.at:31: \$COBC --version" -at_fn_check_prepare_dynamic "$COBC --version" "used_binaries.at:31" -( $at_check_trace; $COBC --version -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo stdout:; cat "$at_stdout" -at_fn_check_status 0 $at_status "$at_srcdir/used_binaries.at:31" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/used_binaries.at:32: \$COBC --help" -at_fn_check_prepare_dynamic "$COBC --help" "used_binaries.at:32" -( $at_check_trace; $COBC --help -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo stdout:; cat "$at_stdout" -at_fn_check_status 0 $at_status "$at_srcdir/used_binaries.at:32" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/used_binaries.at:33: \$COBC --info" -at_fn_check_prepare_dynamic "$COBC --info" "used_binaries.at:33" -( $at_check_trace; $COBC --info -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo stdout:; cat "$at_stdout" -at_fn_check_status 0 $at_status "$at_srcdir/used_binaries.at:33" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/used_binaries.at:34: \$COBC --list-reserved" -at_fn_check_prepare_dynamic "$COBC --list-reserved" "used_binaries.at:34" -( $at_check_trace; $COBC --list-reserved -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo stdout:; cat "$at_stdout" -at_fn_check_status 0 $at_status "$at_srcdir/used_binaries.at:34" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/used_binaries.at:35: \$COBC --list-registers" -at_fn_check_prepare_dynamic "$COBC --list-registers" "used_binaries.at:35" -( $at_check_trace; $COBC --list-registers -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo stdout:; cat "$at_stdout" -at_fn_check_status 0 $at_status "$at_srcdir/used_binaries.at:35" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/used_binaries.at:36: \$COBC --list-intrinsics" -at_fn_check_prepare_dynamic "$COBC --list-intrinsics" "used_binaries.at:36" -( $at_check_trace; $COBC --list-intrinsics -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo stdout:; cat "$at_stdout" -at_fn_check_status 0 $at_status "$at_srcdir/used_binaries.at:36" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/used_binaries.at:37: \$COBC --list-mnemonics" -at_fn_check_prepare_dynamic "$COBC --list-mnemonics" "used_binaries.at:37" -( $at_check_trace; $COBC --list-mnemonics -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo stdout:; cat "$at_stdout" -at_fn_check_status 0 $at_status "$at_srcdir/used_binaries.at:37" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/used_binaries.at:38: \$COBC -std=mf --list-reserved" -at_fn_check_prepare_dynamic "$COBC -std=mf --list-reserved" "used_binaries.at:38" -( $at_check_trace; $COBC -std=mf --list-reserved -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo stdout:; cat "$at_stdout" -at_fn_check_status 0 $at_status "$at_srcdir/used_binaries.at:38" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/used_binaries.at:39: \$COBC -std=acu --list-registers" -at_fn_check_prepare_dynamic "$COBC -std=acu --list-registers" "used_binaries.at:39" -( $at_check_trace; $COBC -std=acu --list-registers -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo stdout:; cat "$at_stdout" -at_fn_check_status 0 $at_status "$at_srcdir/used_binaries.at:39" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/used_binaries.at:40: \$COBC -std=cobol2002 --list-intrinsics" -at_fn_check_prepare_dynamic "$COBC -std=cobol2002 --list-intrinsics" "used_binaries.at:40" -( $at_check_trace; $COBC -std=cobol2002 --list-intrinsics -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo stdout:; cat "$at_stdout" -at_fn_check_status 0 $at_status "$at_srcdir/used_binaries.at:40" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/used_binaries.at:41: \$COBC -std=ibm --list-mnemonics" -at_fn_check_prepare_dynamic "$COBC -std=ibm --list-mnemonics" "used_binaries.at:41" -( $at_check_trace; $COBC -std=ibm --list-mnemonics -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo stdout:; cat "$at_stdout" -at_fn_check_status 0 $at_status "$at_srcdir/used_binaries.at:41" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/used_binaries.at:42: \$COBC --list-system" -at_fn_check_prepare_dynamic "$COBC --list-system" "used_binaries.at:42" -( $at_check_trace; $COBC --list-system -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo stdout:; cat "$at_stdout" -at_fn_check_status 0 $at_status "$at_srcdir/used_binaries.at:42" -$at_failed && at_fn_log_failure -$at_traceon; } - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_1 -#AT_START_2 -at_fn_group_banner 2 'used_binaries.at:46' \ - "Compiler outputs (general)" " " 1 -at_xfail=no -( - $as_echo "2. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 BLA PIC X(5) VALUE 'bluBb'. - PROCEDURE DIVISION. - DISPLAY BLA NO ADVANCING END-DISPLAY - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/used_binaries.at:60: \$COBC -C prog.cob" -at_fn_check_prepare_dynamic "$COBC -C prog.cob" "used_binaries.at:60" -( $at_check_trace; $COBC -C prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo stderr:; cat "$at_stderr" -echo stdout:; cat "$at_stdout" -at_fn_check_status 0 $at_status "$at_srcdir/used_binaries.at:60" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/used_binaries.at:61: \$COBC -v -c prog.c" -at_fn_check_prepare_dynamic "$COBC -v -c prog.c" "used_binaries.at:61" -( $at_check_trace; $COBC -v -c prog.c -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo stderr:; cat "$at_stderr" -echo stdout:; cat "$at_stdout" -at_fn_check_status 0 $at_status "$at_srcdir/used_binaries.at:61" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/used_binaries.at:62: \$COBC -v prog.\$COB_OBJECT_EXT" -at_fn_check_prepare_dynamic "$COBC -v prog.$COB_OBJECT_EXT" "used_binaries.at:62" -( $at_check_trace; $COBC -v prog.$COB_OBJECT_EXT -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo stderr:; cat "$at_stderr" -echo stdout:; cat "$at_stdout" -at_fn_check_status 0 $at_status "$at_srcdir/used_binaries.at:62" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/used_binaries.at:63: \$COBCRUN prog" -at_fn_check_prepare_dynamic "$COBCRUN prog" "used_binaries.at:63" -( $at_check_trace; $COBCRUN prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo "bluBb" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/used_binaries.at:63" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/used_binaries.at:64: \$COBC -x -C prog.cob" -at_fn_check_prepare_dynamic "$COBC -x -C prog.cob" "used_binaries.at:64" -( $at_check_trace; $COBC -x -C prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo stderr:; cat "$at_stderr" -echo stdout:; cat "$at_stdout" -at_fn_check_status 0 $at_status "$at_srcdir/used_binaries.at:64" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/used_binaries.at:65: \$COBC -v -x -c prog.c" -at_fn_check_prepare_dynamic "$COBC -v -x -c prog.c" "used_binaries.at:65" -( $at_check_trace; $COBC -v -x -c prog.c -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo stderr:; cat "$at_stderr" -echo stdout:; cat "$at_stdout" -at_fn_check_status 0 $at_status "$at_srcdir/used_binaries.at:65" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/used_binaries.at:66: \$COBC -v -x prog.\$COB_OBJECT_EXT -o progo" -at_fn_check_prepare_dynamic "$COBC -v -x prog.$COB_OBJECT_EXT -o progo" "used_binaries.at:66" -( $at_check_trace; $COBC -v -x prog.$COB_OBJECT_EXT -o progo -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo stderr:; cat "$at_stderr" -echo stdout:; cat "$at_stdout" -at_fn_check_status 0 $at_status "$at_srcdir/used_binaries.at:66" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/used_binaries.at:67: \$COBCRUN_DIRECT ./progo" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./progo" "used_binaries.at:67" -( $at_check_trace; $COBCRUN_DIRECT ./progo -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo "bluBb" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/used_binaries.at:67" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/used_binaries.at:68: \$COBC -E prog.cob" -at_fn_check_prepare_dynamic "$COBC -E prog.cob" "used_binaries.at:68" -( $at_check_trace; $COBC -E prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo "#line 1 \"prog.cob\" - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 BLA PIC X(5) VALUE 'bluBb'. - PROCEDURE DIVISION. - DISPLAY BLA NO ADVANCING END-DISPLAY - STOP RUN. -" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/used_binaries.at:68" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/used_binaries.at:80: \$COBC -E -o prog.i prog.cob" -at_fn_check_prepare_dynamic "$COBC -E -o prog.i prog.cob" "used_binaries.at:80" -( $at_check_trace; $COBC -E -o prog.i prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/used_binaries.at:80" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/used_binaries.at:81: \$COBC -x prog.i" -at_fn_check_prepare_dynamic "$COBC -x prog.i" "used_binaries.at:81" -( $at_check_trace; $COBC -x prog.i -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/used_binaries.at:81" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/used_binaries.at:82: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "used_binaries.at:82" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo "bluBb" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/used_binaries.at:82" -$at_failed && at_fn_log_failure -$at_traceon; } - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_2 -#AT_START_3 -at_fn_group_banner 3 'used_binaries.at:86' \ - "Compiler outputs (file specified)" " " 1 -at_xfail=no -( - $as_echo "3. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 BLA PIC X(5) VALUE 'bluBb'. - PROCEDURE DIVISION. - DISPLAY BLA NO ADVANCING END-DISPLAY - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/used_binaries.at:100: \$COBC prog.cob -o prog.c" -at_fn_check_prepare_dynamic "$COBC prog.cob -o prog.c" "used_binaries.at:100" -( $at_check_trace; $COBC prog.cob -o prog.c -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/used_binaries.at:100" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/used_binaries.at:101: \$COBC prog.c -o prog.\$COB_OBJECT_EXT" -at_fn_check_prepare_dynamic "$COBC prog.c -o prog.$COB_OBJECT_EXT" "used_binaries.at:101" -( $at_check_trace; $COBC prog.c -o prog.$COB_OBJECT_EXT -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/used_binaries.at:101" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/used_binaries.at:102: \$COBC prog.\$COB_OBJECT_EXT -o prog" -at_fn_check_prepare_dynamic "$COBC prog.$COB_OBJECT_EXT -o prog" "used_binaries.at:102" -( $at_check_trace; $COBC prog.$COB_OBJECT_EXT -o prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/used_binaries.at:102" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/used_binaries.at:103: \$COBCRUN prog" -at_fn_check_prepare_dynamic "$COBCRUN prog" "used_binaries.at:103" -( $at_check_trace; $COBCRUN prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo "bluBb" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/used_binaries.at:103" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/used_binaries.at:104: \$COBC -x prog.cob -o prog.c" -at_fn_check_prepare_dynamic "$COBC -x prog.cob -o prog.c" "used_binaries.at:104" -( $at_check_trace; $COBC -x prog.cob -o prog.c -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/used_binaries.at:104" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/used_binaries.at:105: \$COBC -x prog.c -o prog.\$COB_OBJECT_EXT" -at_fn_check_prepare_dynamic "$COBC -x prog.c -o prog.$COB_OBJECT_EXT" "used_binaries.at:105" -( $at_check_trace; $COBC -x prog.c -o prog.$COB_OBJECT_EXT -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/used_binaries.at:105" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/used_binaries.at:106: \$COBC -x prog.\$COB_OBJECT_EXT -o progo\$COB_EXE_EXT" -at_fn_check_prepare_dynamic "$COBC -x prog.$COB_OBJECT_EXT -o progo$COB_EXE_EXT" "used_binaries.at:106" -( $at_check_trace; $COBC -x prog.$COB_OBJECT_EXT -o progo$COB_EXE_EXT -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/used_binaries.at:106" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/used_binaries.at:107: \$COBCRUN_DIRECT ./progo" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./progo" "used_binaries.at:107" -( $at_check_trace; $COBCRUN_DIRECT ./progo -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo "bluBb" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/used_binaries.at:107" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/used_binaries.at:108: \$COBC prog.cob -o prog.i" -at_fn_check_prepare_dynamic "$COBC prog.cob -o prog.i" "used_binaries.at:108" -( $at_check_trace; $COBC prog.cob -o prog.i -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/used_binaries.at:108" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/used_binaries.at:109: \$COBC -x prog.i -o prog\$COB_EXE_EXT" -at_fn_check_prepare_dynamic "$COBC -x prog.i -o prog$COB_EXE_EXT" "used_binaries.at:109" -( $at_check_trace; $COBC -x prog.i -o prog$COB_EXE_EXT -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/used_binaries.at:109" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/used_binaries.at:110: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "used_binaries.at:110" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo "bluBb" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/used_binaries.at:110" -$at_failed && at_fn_log_failure -$at_traceon; } - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_3 -#AT_START_4 -at_fn_group_banner 4 'used_binaries.at:114' \ - "Compiler outputs (path specified)" " " 1 -at_xfail=no -( - $as_echo "4. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 BLA PIC X(5) VALUE 'bluBb'. - PROCEDURE DIVISION. - DISPLAY BLA NO ADVANCING END-DISPLAY - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/used_binaries.at:128: mkdir -p sub" -at_fn_check_prepare_trace "used_binaries.at:128" -( $at_check_trace; mkdir -p sub -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/used_binaries.at:128" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/used_binaries.at:129: \$COBC prog.cob -o sub/prog.c" -at_fn_check_prepare_dynamic "$COBC prog.cob -o sub/prog.c" "used_binaries.at:129" -( $at_check_trace; $COBC prog.cob -o sub/prog.c -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/used_binaries.at:129" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/used_binaries.at:130: \$COBC \$(_return_path \"sub/prog.c\") -o \$(_return_path \"sub/prog.\$COB_OBJECT_EXT\")" -at_fn_check_prepare_notrace 'a $(...) command substitution' "used_binaries.at:130" -( $at_check_trace; $COBC $(_return_path "sub/prog.c") -o $(_return_path "sub/prog.$COB_OBJECT_EXT") -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/used_binaries.at:130" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/used_binaries.at:131: \$COBC \$(_return_path \"sub/prog.\$COB_OBJECT_EXT\") -o \$(_return_path \"sub/prog\")" -at_fn_check_prepare_notrace 'a $(...) command substitution' "used_binaries.at:131" -( $at_check_trace; $COBC $(_return_path "sub/prog.$COB_OBJECT_EXT") -o $(_return_path "sub/prog") -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/used_binaries.at:131" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/used_binaries.at:132: \$COBCRUN -M \$(_return_path \"sub/\") prog" -at_fn_check_prepare_notrace 'a $(...) command substitution' "used_binaries.at:132" -( $at_check_trace; $COBCRUN -M $(_return_path "sub/") prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo "bluBb" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/used_binaries.at:132" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/used_binaries.at:133: \$COBC -x prog.cob -o \$(_return_path \"sub/prog.c\")" -at_fn_check_prepare_notrace 'a $(...) command substitution' "used_binaries.at:133" -( $at_check_trace; $COBC -x prog.cob -o $(_return_path "sub/prog.c") -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/used_binaries.at:133" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/used_binaries.at:134: \$COBC -x \$(_return_path \"sub/prog.c\") -o \$(_return_path \"sub/prog.\$COB_OBJECT_EXT\")" -at_fn_check_prepare_notrace 'a $(...) command substitution' "used_binaries.at:134" -( $at_check_trace; $COBC -x $(_return_path "sub/prog.c") -o $(_return_path "sub/prog.$COB_OBJECT_EXT") -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/used_binaries.at:134" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/used_binaries.at:135: \$COBC -x \$(_return_path \"sub/prog.\$COB_OBJECT_EXT\") -o \$(_return_path \"sub/progo\$COB_EXE_EXT\")" -at_fn_check_prepare_notrace 'a $(...) command substitution' "used_binaries.at:135" -( $at_check_trace; $COBC -x $(_return_path "sub/prog.$COB_OBJECT_EXT") -o $(_return_path "sub/progo$COB_EXE_EXT") -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/used_binaries.at:135" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/used_binaries.at:136: \$COBCRUN_DIRECT ./sub/progo" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./sub/progo" "used_binaries.at:136" -( $at_check_trace; $COBCRUN_DIRECT ./sub/progo -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo "bluBb" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/used_binaries.at:136" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/used_binaries.at:137: \$COBC prog.cob -o \$(_return_path \"sub/prog.i\")" -at_fn_check_prepare_notrace 'a $(...) command substitution' "used_binaries.at:137" -( $at_check_trace; $COBC prog.cob -o $(_return_path "sub/prog.i") -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/used_binaries.at:137" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/used_binaries.at:138: \$COBC -x sub/prog.i -o \$(_return_path \"sub/prog\$COB_EXE_EXT\")" -at_fn_check_prepare_notrace 'a $(...) command substitution' "used_binaries.at:138" -( $at_check_trace; $COBC -x sub/prog.i -o $(_return_path "sub/prog$COB_EXE_EXT") -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/used_binaries.at:138" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/used_binaries.at:139: \$COBCRUN_DIRECT ./sub/prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./sub/prog" "used_binaries.at:139" -( $at_check_trace; $COBCRUN_DIRECT ./sub/prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo "bluBb" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/used_binaries.at:139" -$at_failed && at_fn_log_failure -$at_traceon; } - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_4 -#AT_START_5 -at_fn_group_banner 5 'used_binaries.at:143' \ - "Compiler outputs (assembler)" " " 1 -at_xfail=no -( - $as_echo "5. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 BLA PIC X(5) VALUE 'bluBb'. - PROCEDURE DIVISION. - DISPLAY BLA NO ADVANCING END-DISPLAY - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/used_binaries.at:157: \$COBC -v -S prog.cob" -at_fn_check_prepare_dynamic "$COBC -v -S prog.cob" "used_binaries.at:157" -( $at_check_trace; $COBC -v -S prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo stderr:; cat "$at_stderr" -echo stdout:; cat "$at_stdout" -at_fn_check_status 0 $at_status "$at_srcdir/used_binaries.at:157" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/used_binaries.at:158: test -f prog.s" -at_fn_check_prepare_trace "used_binaries.at:158" -( $at_check_trace; test -f prog.s -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/used_binaries.at:158" -if $at_failed; then : - # Previous test "failed" --> prog.s not available --> likely a VS build -# only check for file as cl.exe cannot create executables from self-created -# assembler sources -{ set +x -$as_echo "$at_srcdir/used_binaries.at:158: test -f prog.asm" -at_fn_check_prepare_trace "used_binaries.at:158" -( $at_check_trace; test -f prog.asm -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/used_binaries.at:158" -$at_failed && at_fn_log_failure -$at_traceon; } - -else - # Previous test "passed" --> prog.s is available, test compilation and run -{ set +x -$as_echo "$at_srcdir/used_binaries.at:158: \$COBC -v prog.s" -at_fn_check_prepare_dynamic "$COBC -v prog.s" "used_binaries.at:158" -( $at_check_trace; $COBC -v prog.s -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo stderr:; cat "$at_stderr" -echo stdout:; cat "$at_stdout" -at_fn_check_status 0 $at_status "$at_srcdir/used_binaries.at:158" -$at_failed && at_fn_log_failure -$at_traceon; } - - { set +x -$as_echo "$at_srcdir/used_binaries.at:158: \$COBCRUN prog" -at_fn_check_prepare_dynamic "$COBCRUN prog" "used_binaries.at:158" -( $at_check_trace; $COBCRUN prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo "bluBb" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/used_binaries.at:158" -$at_failed && at_fn_log_failure -$at_traceon; } - -fi -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/used_binaries.at:166: \$COBC -v -x -S prog.cob" -at_fn_check_prepare_dynamic "$COBC -v -x -S prog.cob" "used_binaries.at:166" -( $at_check_trace; $COBC -v -x -S prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo stderr:; cat "$at_stderr" -echo stdout:; cat "$at_stdout" -at_fn_check_status 0 $at_status "$at_srcdir/used_binaries.at:166" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/used_binaries.at:167: test -f prog.s" -at_fn_check_prepare_trace "used_binaries.at:167" -( $at_check_trace; test -f prog.s -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/used_binaries.at:167" -if $at_failed; then : - # Previous test "failed" --> prog.s not available --> likely a VS build -# only check for file as cl.exe cannot create executables from self-created -# assembler sources -{ set +x -$as_echo "$at_srcdir/used_binaries.at:167: test -f prog.asm" -at_fn_check_prepare_trace "used_binaries.at:167" -( $at_check_trace; test -f prog.asm -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/used_binaries.at:167" -$at_failed && at_fn_log_failure -$at_traceon; } - -else - # Previous test "passed" --> prog.s is available, test compilation and run -{ set +x -$as_echo "$at_srcdir/used_binaries.at:167: \$COBC -v -x prog.s" -at_fn_check_prepare_dynamic "$COBC -v -x prog.s" "used_binaries.at:167" -( $at_check_trace; $COBC -v -x prog.s -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo stderr:; cat "$at_stderr" -echo stdout:; cat "$at_stdout" -at_fn_check_status 0 $at_status "$at_srcdir/used_binaries.at:167" -$at_failed && at_fn_log_failure -$at_traceon; } - - { set +x -$as_echo "$at_srcdir/used_binaries.at:167: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "used_binaries.at:167" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo "bluBb" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/used_binaries.at:167" -$at_failed && at_fn_log_failure -$at_traceon; } - -fi -$at_failed && at_fn_log_failure -$at_traceon; } - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_5 -#AT_START_6 -at_fn_group_banner 6 'used_binaries.at:178' \ - "Source file not found" " " 1 -at_xfail=no -( - $as_echo "6. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -{ set +x -$as_echo "$at_srcdir/used_binaries.at:181: \$COMPILE_ONLY prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY prog.cob" "used_binaries.at:181" -( $at_check_trace; $COMPILE_ONLY prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "cobc: prog.cob: No such file or directory -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/used_binaries.at:181" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_6 -#AT_START_7 -at_fn_group_banner 7 'used_binaries.at:188' \ - "Temporary path invalid" " " 1 -at_xfail=no -( - $as_echo "7. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -# Note: may be either removed completely as there was a report about -# this test "failing" - or skipped as this very often fails for -# WIN32 builds - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - PROCEDURE DIVISION. - DISPLAY "OK" NO ADVANCING - END-DISPLAY. - EXIT PROGRAM. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/used_binaries.at:204: TMPDIR=\"\" TMP=\"notthere\" TEMP=\"\" \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "TMPDIR=\"\" TMP=\"notthere\" TEMP=\"\" $COMPILE prog.cob" "used_binaries.at:204" -( $at_check_trace; TMPDIR="" TMP="notthere" TEMP="" $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "libcob: warning: Temporary directory TMP is invalid, adjust TMPDIR! -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/used_binaries.at:204" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/used_binaries.at:207: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "used_binaries.at:207" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo "OK" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/used_binaries.at:207" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/used_binaries.at:208: TMPDIR=\"\" TMP=\"\" TEMP=\"./prog.cob\" \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "TMPDIR=\"\" TMP=\"\" TEMP=\"./prog.cob\" $COMPILE prog.cob" "used_binaries.at:208" -( $at_check_trace; TMPDIR="" TMP="" TEMP="./prog.cob" $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "libcob: warning: Temporary directory TEMP is invalid, adjust TMPDIR! -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/used_binaries.at:208" -$at_failed && at_fn_log_failure -$at_traceon; } - -# TMPDIR is only checked when actually needed which is currently only the case -# for SORT -#AT_CHECK([TMPDIR="./prog.cob" $COBCRUN_DIRECT ./prog], [0], [OK], -#[libcob: warning: Temporary directory TEMP is invalid, adjust TMPDIR! -#]) -#AT_CHECK([COB_DISABLE_WARNINGS=1 TMPDIR="./prog.cob" $COBCRUN_DIRECT ./prog], [0], [OK], -#[libcob: warning: Temporary directory TEMP is invalid, adjust TMPDIR! -#]) - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_7 -#AT_START_8 -at_fn_group_banner 8 'used_binaries.at:223' \ - "Using full path for cobc" " " 1 -at_xfail=no -( - $as_echo "8. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - PROCEDURE DIVISION. - DISPLAY "OK" NO ADVANCING - END-DISPLAY. - EXIT PROGRAM. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/used_binaries.at:235: \$COMPILE \"\$(_return_path \"\$(pwd)/prog.cob\")\"" -at_fn_check_prepare_notrace 'a $(...) command substitution' "used_binaries.at:235" -( $at_check_trace; $COMPILE "$(_return_path "$(pwd)/prog.cob")" -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/used_binaries.at:235" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/used_binaries.at:236: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "used_binaries.at:236" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo "OK" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/used_binaries.at:236" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_8 -#AT_START_9 -at_fn_group_banner 9 'used_binaries.at:241' \ - "C Compiler optimizations" " " 1 -at_xfail=no -( - $as_echo "9. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - PROCEDURE DIVISION. - DISPLAY "OK" NO ADVANCING - END-DISPLAY. - EXIT PROGRAM. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/used_binaries.at:253: \$COMPILE -v -O -o prog prog.cob" -at_fn_check_prepare_dynamic "$COMPILE -v -O -o prog prog.cob" "used_binaries.at:253" -( $at_check_trace; $COMPILE -v -O -o prog prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo stderr:; cat "$at_stderr" -echo stdout:; cat "$at_stdout" -at_fn_check_status 0 $at_status "$at_srcdir/used_binaries.at:253" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/used_binaries.at:254: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "used_binaries.at:254" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo "OK" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/used_binaries.at:254" -$at_failed && at_fn_log_failure -$at_traceon; } - - -{ set +x -$as_echo "$at_srcdir/used_binaries.at:256: \$COMPILE -v -O2 -o prog2 prog.cob" -at_fn_check_prepare_dynamic "$COMPILE -v -O2 -o prog2 prog.cob" "used_binaries.at:256" -( $at_check_trace; $COMPILE -v -O2 -o prog2 prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo stderr:; cat "$at_stderr" -echo stdout:; cat "$at_stdout" -at_fn_check_status 0 $at_status "$at_srcdir/used_binaries.at:256" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/used_binaries.at:257: \$COBCRUN_DIRECT ./prog2" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog2" "used_binaries.at:257" -( $at_check_trace; $COBCRUN_DIRECT ./prog2 -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo "OK" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/used_binaries.at:257" -$at_failed && at_fn_log_failure -$at_traceon; } - - -{ set +x -$as_echo "$at_srcdir/used_binaries.at:259: \$COMPILE -v -Os -o progs prog.cob" -at_fn_check_prepare_dynamic "$COMPILE -v -Os -o progs prog.cob" "used_binaries.at:259" -( $at_check_trace; $COMPILE -v -Os -o progs prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo stderr:; cat "$at_stderr" -echo stdout:; cat "$at_stdout" -at_fn_check_status 0 $at_status "$at_srcdir/used_binaries.at:259" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/used_binaries.at:260: \$COBCRUN_DIRECT ./progs" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./progs" "used_binaries.at:260" -( $at_check_trace; $COBCRUN_DIRECT ./progs -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo "OK" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/used_binaries.at:260" -$at_failed && at_fn_log_failure -$at_traceon; } - - -{ set +x -$as_echo "$at_srcdir/used_binaries.at:262: \$COMPILE -v -O3 -o prog3 prog.cob" -at_fn_check_prepare_dynamic "$COMPILE -v -O3 -o prog3 prog.cob" "used_binaries.at:262" -( $at_check_trace; $COMPILE -v -O3 -o prog3 prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo stderr:; cat "$at_stderr" -echo stdout:; cat "$at_stdout" -at_fn_check_status 0 $at_status "$at_srcdir/used_binaries.at:262" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/used_binaries.at:263: \$COBCRUN_DIRECT ./prog3" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog3" "used_binaries.at:263" -( $at_check_trace; $COBCRUN_DIRECT ./prog3 -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo "OK" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/used_binaries.at:263" -$at_failed && at_fn_log_failure -$at_traceon; } - - -{ set +x -$as_echo "$at_srcdir/used_binaries.at:265: \$COMPILE -v -O0 -o prog prog.cob" -at_fn_check_prepare_dynamic "$COMPILE -v -O0 -o prog prog.cob" "used_binaries.at:265" -( $at_check_trace; $COMPILE -v -O0 -o prog prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo stderr:; cat "$at_stderr" -echo stdout:; cat "$at_stdout" -at_fn_check_status 0 $at_status "$at_srcdir/used_binaries.at:265" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/used_binaries.at:266: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "used_binaries.at:266" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo "OK" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/used_binaries.at:266" -$at_failed && at_fn_log_failure -$at_traceon; } - - -# last test with O2 (strips output) and output name -{ set +x -$as_echo "$at_srcdir/used_binaries.at:269: mkdir -p sub" -at_fn_check_prepare_trace "used_binaries.at:269" -( $at_check_trace; mkdir -p sub -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/used_binaries.at:269" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/used_binaries.at:270: \$COMPILE_MODULE -v -O2 -o \$(_return_path \"sub/prog\") prog.cob" -at_fn_check_prepare_notrace 'a $(...) command substitution' "used_binaries.at:270" -( $at_check_trace; $COMPILE_MODULE -v -O2 -o $(_return_path "sub/prog") prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo stderr:; cat "$at_stderr" -echo stdout:; cat "$at_stdout" -at_fn_check_status 0 $at_status "$at_srcdir/used_binaries.at:270" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/used_binaries.at:271: \$COBCRUN -M sub/ prog" -at_fn_check_prepare_dynamic "$COBCRUN -M sub/ prog" "used_binaries.at:271" -( $at_check_trace; $COBCRUN -M sub/ prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo "OK" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/used_binaries.at:271" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/used_binaries.at:272: \$COMPILE -v -O2 -o \$(_return_path \"sub/prog\$COB_EXE_EXT\") prog.cob" -at_fn_check_prepare_notrace 'a $(...) command substitution' "used_binaries.at:272" -( $at_check_trace; $COMPILE -v -O2 -o $(_return_path "sub/prog$COB_EXE_EXT") prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo stderr:; cat "$at_stderr" -echo stdout:; cat "$at_stdout" -at_fn_check_status 0 $at_status "$at_srcdir/used_binaries.at:272" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/used_binaries.at:273: \$COBCRUN_DIRECT ./sub/prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./sub/prog" "used_binaries.at:273" -( $at_check_trace; $COBCRUN_DIRECT ./sub/prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo "OK" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/used_binaries.at:273" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_9 -#AT_START_10 -at_fn_group_banner 10 'used_binaries.at:278' \ - "Invalid cobc option" " " 1 -at_xfail=no -( - $as_echo "10. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. -_ATEOF - - -# normal option -{ set +x -$as_echo "$at_srcdir/used_binaries.at:287: \$COMPILE -q --thisoptiondoesntexist prog.cob" -at_fn_check_prepare_dynamic "$COMPILE -q --thisoptiondoesntexist prog.cob" "used_binaries.at:287" -( $at_check_trace; $COMPILE -q --thisoptiondoesntexist prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "cobc: unrecognized option '--thisoptiondoesntexist' -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/used_binaries.at:287" -$at_failed && at_fn_log_failure -$at_traceon; } - -# flag -{ set +x -$as_echo "$at_srcdir/used_binaries.at:291: \$COMPILE -q -flagdoesntexist prog.cob" -at_fn_check_prepare_dynamic "$COMPILE -q -flagdoesntexist prog.cob" "used_binaries.at:291" -( $at_check_trace; $COMPILE -q -flagdoesntexist prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "cobc: unrecognized option '-flagdoesntexist' -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/used_binaries.at:291" -$at_failed && at_fn_log_failure -$at_traceon; } - -# warning -{ set +x -$as_echo "$at_srcdir/used_binaries.at:295: \$COMPILE -q -Wdoesntexist prog.cob" -at_fn_check_prepare_dynamic "$COMPILE -q -Wdoesntexist prog.cob" "used_binaries.at:295" -( $at_check_trace; $COMPILE -q -Wdoesntexist prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "cobc: unrecognized option '-Wdoesntexist' -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/used_binaries.at:295" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_10 -#AT_START_11 -at_fn_group_banner 11 'used_binaries.at:302' \ - "cobcrun help and information" " " 1 -at_xfail=no -( - $as_echo "11. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -# FIXME: check at least some parts of the output by using $GREP -{ set +x -$as_echo "$at_srcdir/used_binaries.at:306: \$COBCRUN --version" -at_fn_check_prepare_dynamic "$COBCRUN --version" "used_binaries.at:306" -( $at_check_trace; $COBCRUN --version -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo stdout:; cat "$at_stdout" -at_fn_check_status 0 $at_status "$at_srcdir/used_binaries.at:306" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/used_binaries.at:307: \$COBCRUN --help" -at_fn_check_prepare_dynamic "$COBCRUN --help" "used_binaries.at:307" -( $at_check_trace; $COBCRUN --help -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo stdout:; cat "$at_stdout" -at_fn_check_status 0 $at_status "$at_srcdir/used_binaries.at:307" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/used_binaries.at:308: \$COBCRUN --info" -at_fn_check_prepare_dynamic "$COBCRUN --info" "used_binaries.at:308" -( $at_check_trace; $COBCRUN --info -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo stdout:; cat "$at_stdout" -at_fn_check_status 0 $at_status "$at_srcdir/used_binaries.at:308" -$at_failed && at_fn_log_failure -$at_traceon; } - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_11 -#AT_START_12 -at_fn_group_banner 12 'used_binaries.at:312' \ - "cobcrun validation" " " 1 -at_xfail=no -( - $as_echo "12. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >callee.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. callee. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 WRK-VAR PIC X(5). - 01 EXT-VAR PIC X(5) EXTERNAL. - PROCEDURE DIVISION. - DISPLAY EXT-VAR NO ADVANCING - END-DISPLAY. - MOVE "World" TO EXT-VAR. - EXIT PROGRAM. -_ATEOF - - -cat >caller.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. caller. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 EXT-VAR PIC X(5) EXTERNAL. - 01 WRK-VAR PIC X(5). - PROCEDURE DIVISION. - MOVE "Hello" TO EXT-VAR. - CALL "callee" - END-CALL. - DISPLAY EXT-VAR NO ADVANCING - END-DISPLAY. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/used_binaries.at:345: \$COMPILE_MODULE callee.cob" -at_fn_check_prepare_dynamic "$COMPILE_MODULE callee.cob" "used_binaries.at:345" -( $at_check_trace; $COMPILE_MODULE callee.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/used_binaries.at:345" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/used_binaries.at:346: \$COMPILE_MODULE caller.cob" -at_fn_check_prepare_dynamic "$COMPILE_MODULE caller.cob" "used_binaries.at:346" -( $at_check_trace; $COMPILE_MODULE caller.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/used_binaries.at:346" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/used_binaries.at:347: \$COBCRUN caller" -at_fn_check_prepare_dynamic "$COBCRUN caller" "used_binaries.at:347" -( $at_check_trace; $COBCRUN caller -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo "HelloWorld" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/used_binaries.at:347" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_12 -#AT_START_13 -at_fn_group_banner 13 'used_binaries.at:352' \ - "cobcrun -M DSO entry argument" " " 1 -at_xfail=no -( - $as_echo "13. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >callee.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. callee. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 EXT-VAR PIC X(5) EXTERNAL. - PROCEDURE DIVISION. - DISPLAY EXT-VAR END-DISPLAY. - MOVE "World" TO EXT-VAR. - EXIT PROGRAM. -_ATEOF - - -cat >caller.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. caller. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 EXT-VAR PIC X(5) EXTERNAL. - PROCEDURE DIVISION. - MOVE "Hello" TO EXT-VAR. - CALL "callee" END-CALL. - DISPLAY EXT-VAR END-DISPLAY. - STOP RUN. - END PROGRAM caller. - - IDENTIFICATION DIVISION. - PROGRAM-ID. inside. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 EXT-VAR PIC X(5) EXTERNAL. - 01 CLA-VAR PIC X(5). - PROCEDURE DIVISION. - MOVE "Aloha" TO EXT-VAR. - CALL "callee" END-CALL. - DISPLAY EXT-VAR END-DISPLAY. - ACCEPT CLA-VAR FROM COMMAND-LINE END-ACCEPT. - DISPLAY CLA-VAR END-DISPLAY. - STOP RUN. - END PROGRAM inside. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/used_binaries.at:396: \$COMPILE_MODULE callee.cob" -at_fn_check_prepare_dynamic "$COMPILE_MODULE callee.cob" "used_binaries.at:396" -( $at_check_trace; $COMPILE_MODULE callee.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/used_binaries.at:396" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/used_binaries.at:397: \$COMPILE_MODULE caller.cob" -at_fn_check_prepare_dynamic "$COMPILE_MODULE caller.cob" "used_binaries.at:397" -( $at_check_trace; $COMPILE_MODULE caller.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/used_binaries.at:397" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/used_binaries.at:398: \$COBCRUN -M ./caller inside again" -at_fn_check_prepare_dynamic "$COBCRUN -M ./caller inside again" "used_binaries.at:398" -( $at_check_trace; $COBCRUN -M ./caller inside again -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo "Aloha -World -again -" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/used_binaries.at:398" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_13 -#AT_START_14 -at_fn_group_banner 14 'used_binaries.at:412' \ - "cobcrun -M directory/ default" " " 1 -at_xfail=no -( - $as_echo "14. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >callee.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. callee. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 EXT-VAR PIC X(5) EXTERNAL. - PROCEDURE DIVISION. - DISPLAY EXT-VAR END-DISPLAY. - MOVE "World" TO EXT-VAR. - EXIT PROGRAM. -_ATEOF - - -cat >caller.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. caller. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 EXT-VAR PIC X(5) EXTERNAL. - PROCEDURE DIVISION. - MOVE "Hello" TO EXT-VAR. - CALL "callee" END-CALL. - DISPLAY EXT-VAR END-DISPLAY. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/used_binaries.at:440: \$COMPILE_MODULE callee.cob" -at_fn_check_prepare_dynamic "$COMPILE_MODULE callee.cob" "used_binaries.at:440" -( $at_check_trace; $COMPILE_MODULE callee.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/used_binaries.at:440" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/used_binaries.at:441: \$COMPILE_MODULE caller.cob" -at_fn_check_prepare_dynamic "$COMPILE_MODULE caller.cob" "used_binaries.at:441" -( $at_check_trace; $COMPILE_MODULE caller.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/used_binaries.at:441" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/used_binaries.at:442: \$COBCRUN -M ./ caller" -at_fn_check_prepare_dynamic "$COBCRUN -M ./ caller" "used_binaries.at:442" -( $at_check_trace; $COBCRUN -M ./ caller -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo "Hello -World -" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/used_binaries.at:442" -$at_failed && at_fn_log_failure -$at_traceon; } - - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_14 -#AT_START_15 -at_fn_group_banner 15 'used_binaries.at:451' \ - "cobcrun -M directory/dso alternate" " " 1 -at_xfail=no -( - $as_echo "15. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >callee.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. callee. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 EXT-VAR PIC X(5) EXTERNAL. - PROCEDURE DIVISION. - DISPLAY EXT-VAR END-DISPLAY. - MOVE "World" TO EXT-VAR. - EXIT PROGRAM. -_ATEOF - - -cat >caller.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. caller. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 EXT-VAR PIC X(5) EXTERNAL. - PROCEDURE DIVISION. - MOVE "Hello" TO EXT-VAR. - CALL "callee" END-CALL. - DISPLAY EXT-VAR END-DISPLAY. - STOP RUN. - END PROGRAM caller. - - IDENTIFICATION DIVISION. - PROGRAM-ID. inside. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 EXT-VAR PIC X(5) EXTERNAL. - PROCEDURE DIVISION. - MOVE "Aloha" TO EXT-VAR. - CALL "callee" END-CALL. - DISPLAY EXT-VAR END-DISPLAY. - STOP RUN. - END PROGRAM inside. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/used_binaries.at:492: \$COMPILE_MODULE callee.cob" -at_fn_check_prepare_dynamic "$COMPILE_MODULE callee.cob" "used_binaries.at:492" -( $at_check_trace; $COMPILE_MODULE callee.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/used_binaries.at:492" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/used_binaries.at:493: \$COMPILE_MODULE caller.cob" -at_fn_check_prepare_dynamic "$COMPILE_MODULE caller.cob" "used_binaries.at:493" -( $at_check_trace; $COMPILE_MODULE caller.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/used_binaries.at:493" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/used_binaries.at:494: \$COBCRUN -M ./caller inside" -at_fn_check_prepare_dynamic "$COBCRUN -M ./caller inside" "used_binaries.at:494" -( $at_check_trace; $COBCRUN -M ./caller inside -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo "Aloha -World -" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/used_binaries.at:494" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_15 -#AT_START_16 -at_fn_group_banner 16 'used_binaries.at:502' \ - "cobcrun -M DSO entry multiple arguments" " " 1 -at_xfail=no -( - $as_echo "16. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -# Test that modules can be called with ARGUMENT-VALUES -cat >called.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. called. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 CLI-ARGS PIC X(27). - 01 ARG-TWO PIC X(6). - PROCEDURE DIVISION. - ACCEPT CLI-ARGS FROM COMMAND-LINE END-ACCEPT. - DISPLAY 2 UPON ARGUMENT-NUMBER END-DISPLAY. - ACCEPT ARG-TWO FROM ARGUMENT-VALUE END-ACCEPT. - DISPLAY CLI-ARGS ":" ARG-TWO END-DISPLAY. - EXIT PROGRAM. -_ATEOF - - -cat >mainer.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. mainer. - PROCEDURE DIVISION. - STOP RUN. - END PROGRAM mainer. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/used_binaries.at:529: \$COBC -b \${FLAGS} mainer.cob called.cob" -at_fn_check_prepare_notrace 'a ${...} parameter expansion' "used_binaries.at:529" -( $at_check_trace; $COBC -b ${FLAGS} mainer.cob called.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/used_binaries.at:529" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/used_binaries.at:530: \$COBCRUN -M ./mainer called \"first argument\" \"second\" \"third\"" -at_fn_check_prepare_dynamic "$COBCRUN -M ./mainer called \"first argument\" \"second\" \"third\"" "used_binaries.at:530" -( $at_check_trace; $COBCRUN -M ./mainer called "first argument" "second" "third" -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo "first argument second third:second -" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/used_binaries.at:530" -$at_failed && at_fn_log_failure -$at_traceon; } - - -# additional test with environment configuration settings removed: -{ set +x -$as_echo "$at_srcdir/used_binaries.at:535: unset COB_PRE_LOAD COB_LIBRARY_PATH; \$COBCRUN -M ./mainer called \"first argument\" \"second\" \"third\"" -at_fn_check_prepare_dynamic "unset COB_PRE_LOAD COB_LIBRARY_PATH; $COBCRUN -M ./mainer called \"first argument\" \"second\" \"third\"" "used_binaries.at:535" -( $at_check_trace; unset COB_PRE_LOAD COB_LIBRARY_PATH; $COBCRUN -M ./mainer called "first argument" "second" "third" -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo "first argument second third:second -" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/used_binaries.at:535" -$at_failed && at_fn_log_failure -$at_traceon; } - - -# additional test with showing the preloaded environment -# FIXME: check at least some parts of the output ("configuration" and the expected output) by using $GREP -{ set +x -$as_echo "$at_srcdir/used_binaries.at:541: \$COBCRUN -M ./mainer --runtime-conf called \"first argument\" \"second\" \"third\"" -at_fn_check_prepare_dynamic "$COBCRUN -M ./mainer --runtime-conf called \"first argument\" \"second\" \"third\"" "used_binaries.at:541" -( $at_check_trace; $COBCRUN -M ./mainer --runtime-conf called "first argument" "second" "third" -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo stdout:; cat "$at_stdout" -at_fn_check_status 0 $at_status "$at_srcdir/used_binaries.at:541" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_16 -#AT_START_17 -at_fn_group_banner 17 'used_binaries.at:547' \ - "cobcrun error messages" " " 1 -at_xfail=no -( - $as_echo "17. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -{ set +x -$as_echo "$at_srcdir/used_binaries.at:550: \$COBCRUN -q" -at_fn_check_prepare_dynamic "$COBCRUN -q" "used_binaries.at:550" -( $at_check_trace; $COBCRUN -q -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "cobcrun: missing PROGRAM name -Try 'cobcrun --help' for more information. -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/used_binaries.at:550" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/used_binaries.at:554: \$COBCRUN -q -prog" -at_fn_check_prepare_dynamic "$COBCRUN -q -prog" "used_binaries.at:554" -( $at_check_trace; $COBCRUN -q -prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "cobcrun: unrecognized option '-prog' -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/used_binaries.at:554" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/used_binaries.at:557: \$COBCRUN noprog" -at_fn_check_prepare_dynamic "$COBCRUN noprog" "used_binaries.at:557" -( $at_check_trace; $COBCRUN noprog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "libcob: error: module 'noprog' not found -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/used_binaries.at:557" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/used_binaries.at:560: \$COBCRUN -q -M" -at_fn_check_prepare_dynamic "$COBCRUN -q -M" "used_binaries.at:560" -( $at_check_trace; $COBCRUN -q -M -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "cobcrun: option requires an argument -- M -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/used_binaries.at:560" -$at_failed && at_fn_log_failure -$at_traceon; } - -# FIXME - The following doesn't seem to work correct, -# we expect an error about missing module name -#AT_CHECK([$COBCRUN -q -M noprog], [1], [], []) - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_17 -#AT_START_18 -at_fn_group_banner 18 'used_binaries.at:570' \ - "Compile from stdin" " " 1 -at_xfail=no -( - $as_echo "18. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. a. - DATA DIVISION. - WORKING-STORAGE SECTION. - PROCEDURE DIVISION. - STOP RUN WITH NORMAL STATUS. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/used_binaries.at:582: cat prog.cob | \$COMPILE -" -at_fn_check_prepare_notrace 'a shell pipeline' "used_binaries.at:582" -( $at_check_trace; cat prog.cob | $COMPILE - -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/used_binaries.at:582" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/used_binaries.at:583: \$COBCRUN_DIRECT ./a.out" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./a.out" "used_binaries.at:583" -( $at_check_trace; $COBCRUN_DIRECT ./a.out -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/used_binaries.at:583" -$at_failed && at_fn_log_failure -$at_traceon; } - - -{ set +x -$as_echo "$at_srcdir/used_binaries.at:585: cat prog.cob | \$COMPILE_MODULE -" -at_fn_check_prepare_notrace 'a shell pipeline' "used_binaries.at:585" -( $at_check_trace; cat prog.cob | $COMPILE_MODULE - -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/used_binaries.at:585" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/used_binaries.at:586: \$COBCRUN a" -at_fn_check_prepare_dynamic "$COBCRUN a" "used_binaries.at:586" -( $at_check_trace; $COBCRUN a -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/used_binaries.at:586" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_18 -#AT_START_19 -at_fn_group_banner 19 'used_binaries.at:591' \ - "Run job after compilation" " " 1 -at_xfail=no -( - $as_echo "19. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - PROCEDURE DIVISION. - DISPLAY "job" WITH NO ADVANCING END-DISPLAY - STOP RUN WITH NORMAL STATUS. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/used_binaries.at:604: \$COMPILE -jd prog.cob" -at_fn_check_prepare_dynamic "$COMPILE -jd prog.cob" "used_binaries.at:604" -( $at_check_trace; $COMPILE -jd prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo "job" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/used_binaries.at:604" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/used_binaries.at:605: \$COMPILE_MODULE -jd prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_MODULE -jd prog.cob" "used_binaries.at:605" -( $at_check_trace; $COMPILE_MODULE -jd prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo "job" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/used_binaries.at:605" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_19 -#AT_START_20 -at_fn_group_banner 20 'used_binaries.at:610' \ - "Run job after compilation (path specified)" " " 1 -at_xfail=no -( - $as_echo "20. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - PROCEDURE DIVISION. - DISPLAY "job" WITH NO ADVANCING END-DISPLAY - STOP RUN WITH NORMAL STATUS. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/used_binaries.at:623: mkdir -p sub" -at_fn_check_prepare_trace "used_binaries.at:623" -( $at_check_trace; mkdir -p sub -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/used_binaries.at:623" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/used_binaries.at:624: \$COMPILE_MODULE -jd -o \$(_return_path \"sub/prog\") prog.cob" -at_fn_check_prepare_notrace 'a $(...) command substitution' "used_binaries.at:624" -( $at_check_trace; $COMPILE_MODULE -jd -o $(_return_path "sub/prog") prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo "job" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/used_binaries.at:624" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/used_binaries.at:625: \$COMPILE -jd -o \$(_return_path \"sub/prog\$COB_EXE_EXT\") prog.cob" -at_fn_check_prepare_notrace 'a $(...) command substitution' "used_binaries.at:625" -( $at_check_trace; $COMPILE -jd -o $(_return_path "sub/prog$COB_EXE_EXT") prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo "job" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/used_binaries.at:625" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_20 -#AT_START_21 -at_fn_group_banner 21 'used_binaries.at:630' \ - "Run job with optional arguments" " " 1 -at_xfail=no -( - $as_echo "21. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 CLI PIC X(8). - PROCEDURE DIVISION. - ACCEPT CLI FROM COMMAND-LINE - DISPLAY CLI WITH NO ADVANCING END-DISPLAY - STOP RUN WITH NORMAL STATUS. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/used_binaries.at:645: \$COMPILE -j=\"job 123\" prog.cob" -at_fn_check_prepare_dynamic "$COMPILE -j=\"job 123\" prog.cob" "used_binaries.at:645" -( $at_check_trace; $COMPILE -j="job 123" prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo "job 123 " | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/used_binaries.at:645" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/used_binaries.at:646: \$COMPILE -jdg prog.cob" -at_fn_check_prepare_dynamic "$COMPILE -jdg prog.cob" "used_binaries.at:646" -( $at_check_trace; $COMPILE -jdg prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo " " | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/used_binaries.at:646" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/used_binaries.at:647: \$COMPILE_MODULE --job=job123 prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_MODULE --job=job123 prog.cob" "used_binaries.at:647" -( $at_check_trace; $COMPILE_MODULE --job=job123 prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo "job123 " | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/used_binaries.at:647" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_21 -#AT_START_22 -at_fn_group_banner 22 'configuration.at:22' \ - "cobc with standard configuration file" " " 1 -at_xfail=no -( - $as_echo "22. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - AUTHOR. tester. - DATA DIVISION. - WORKING-STORAGE SECTION. - PROCEDURE DIVISION. - STOP RUN. -_ATEOF - - -# default configuration permits this extension -{ set +x -$as_echo "$at_srcdir/configuration.at:36: \$COMPILE_ONLY prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY prog.cob" "configuration.at:36" -( $at_check_trace; $COMPILE_ONLY prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob:4: warning: AUTHOR is obsolete in GnuCOBOL -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/configuration.at:36" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_22 -#AT_START_23 -at_fn_group_banner 23 'configuration.at:43' \ - "cobc dialect features for all -std" " " 1 -at_xfail=no -( - $as_echo "23. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - AUTHOR. tester. - DATA DIVISION. - WORKING-STORAGE SECTION. - PROCEDURE DIVISION. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/configuration.at:56: \$COMPILE_ONLY -std=default prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY -std=default prog.cob" "configuration.at:56" -( $at_check_trace; $COMPILE_ONLY -std=default prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob:4: warning: AUTHOR is obsolete in GnuCOBOL -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/configuration.at:56" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/configuration.at:59: \$COMPILE_ONLY -std=cobol85 prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY -std=cobol85 prog.cob" "configuration.at:59" -( $at_check_trace; $COMPILE_ONLY -std=cobol85 prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob:4: warning: AUTHOR is obsolete in COBOL 85 -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/configuration.at:59" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/configuration.at:62: \$COMPILE_ONLY -std=cobol2002 prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY -std=cobol2002 prog.cob" "configuration.at:62" -( $at_check_trace; $COMPILE_ONLY -std=cobol2002 prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob:4: error: AUTHOR does not conform to COBOL 2002 -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/configuration.at:62" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/configuration.at:65: \$COMPILE_ONLY -std=cobol2014 prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY -std=cobol2014 prog.cob" "configuration.at:65" -( $at_check_trace; $COMPILE_ONLY -std=cobol2014 prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob:4: error: AUTHOR does not conform to COBOL 2014 -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/configuration.at:65" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/configuration.at:68: \$COMPILE_ONLY -std=xopen prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY -std=xopen prog.cob" "configuration.at:68" -( $at_check_trace; $COMPILE_ONLY -std=xopen prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob:4: warning: AUTHOR used -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/configuration.at:68" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/configuration.at:71: \$COMPILE_ONLY -std=acu-strict prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY -std=acu-strict prog.cob" "configuration.at:71" -( $at_check_trace; $COMPILE_ONLY -std=acu-strict prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob:4: warning: AUTHOR is obsolete in ACUCOBOL-GT -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/configuration.at:71" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/configuration.at:74: \$COMPILE_ONLY -std=bs2000-strict prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY -std=bs2000-strict prog.cob" "configuration.at:74" -( $at_check_trace; $COMPILE_ONLY -std=bs2000-strict prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob:4: error: AUTHOR does not conform to BS2000 COBOL -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/configuration.at:74" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/configuration.at:77: \$COMPILE_ONLY -std=ibm-strict prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY -std=ibm-strict prog.cob" "configuration.at:77" -( $at_check_trace; $COMPILE_ONLY -std=ibm-strict prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob:4: warning: AUTHOR is obsolete in IBM COBOL -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/configuration.at:77" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/configuration.at:80: \$COMPILE_ONLY -std=mf-strict prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY -std=mf-strict prog.cob" "configuration.at:80" -( $at_check_trace; $COMPILE_ONLY -std=mf-strict prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob:4: warning: AUTHOR is obsolete in Micro Focus COBOL -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/configuration.at:80" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/configuration.at:83: \$COMPILE_ONLY -std=rm-strict prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY -std=rm-strict prog.cob" "configuration.at:83" -( $at_check_trace; $COMPILE_ONLY -std=rm-strict prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob:4: warning: AUTHOR is obsolete in RM-COBOL -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/configuration.at:83" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/configuration.at:86: \$COMPILE_ONLY -std=realia-strict prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY -std=realia-strict prog.cob" "configuration.at:86" -( $at_check_trace; $COMPILE_ONLY -std=realia-strict prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/configuration.at:86" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/configuration.at:87: \$COMPILE_ONLY -std=mvs-strict prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY -std=mvs-strict prog.cob" "configuration.at:87" -( $at_check_trace; $COMPILE_ONLY -std=mvs-strict prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob:4: warning: AUTHOR is obsolete in MVS/VM COBOL -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/configuration.at:87" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/configuration.at:90: \$COMPILE_ONLY -std=acu prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY -std=acu prog.cob" "configuration.at:90" -( $at_check_trace; $COMPILE_ONLY -std=acu prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/configuration.at:90" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/configuration.at:91: \$COMPILE_ONLY -std=bs2000 prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY -std=bs2000 prog.cob" "configuration.at:91" -( $at_check_trace; $COMPILE_ONLY -std=bs2000 prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/configuration.at:91" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/configuration.at:92: \$COMPILE_ONLY -std=ibm prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY -std=ibm prog.cob" "configuration.at:92" -( $at_check_trace; $COMPILE_ONLY -std=ibm prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/configuration.at:92" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/configuration.at:93: \$COMPILE_ONLY -std=mf prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY -std=mf prog.cob" "configuration.at:93" -( $at_check_trace; $COMPILE_ONLY -std=mf prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/configuration.at:93" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/configuration.at:94: \$COMPILE_ONLY -std=rm prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY -std=rm prog.cob" "configuration.at:94" -( $at_check_trace; $COMPILE_ONLY -std=rm prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/configuration.at:94" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/configuration.at:95: \$COMPILE_ONLY -std=realia prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY -std=realia prog.cob" "configuration.at:95" -( $at_check_trace; $COMPILE_ONLY -std=realia prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/configuration.at:95" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/configuration.at:96: \$COMPILE_ONLY -std=mvs prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY -std=mvs prog.cob" "configuration.at:96" -( $at_check_trace; $COMPILE_ONLY -std=mvs prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/configuration.at:96" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_23 -#AT_START_24 -at_fn_group_banner 24 'configuration.at:101' \ - "cobc with configuration file via -std" " " 1 -at_xfail=no -( - $as_echo "24. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - AUTHOR. tester. - DATA DIVISION. - WORKING-STORAGE SECTION. - PROCEDURE DIVISION. - STOP RUN. -_ATEOF - - -# check if -std loads configuration file and if override works -{ set +x -$as_echo "$at_srcdir/configuration.at:115: \$COMPILE_ONLY -std=cobol2014 prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY -std=cobol2014 prog.cob" "configuration.at:115" -( $at_check_trace; $COMPILE_ONLY -std=cobol2014 prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob:4: error: AUTHOR does not conform to COBOL 2014 -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/configuration.at:115" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_24 -#AT_START_25 -at_fn_group_banner 25 'configuration.at:122' \ - "cobc with standard configuration file via -conf" "" 1 -at_xfail=no -( - $as_echo "25. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - AUTHOR. tester. - DATA DIVISION. - WORKING-STORAGE SECTION. - PROCEDURE DIVISION. - STOP RUN. -_ATEOF - - -# check if override via -conf works -{ set +x -$as_echo "$at_srcdir/configuration.at:136: \$COMPILE_ONLY -conf=cobol2014.conf prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY -conf=cobol2014.conf prog.cob" "configuration.at:136" -( $at_check_trace; $COMPILE_ONLY -conf=cobol2014.conf prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob:4: error: AUTHOR does not conform to COBOL 2014 -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/configuration.at:136" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_25 -#AT_START_26 -at_fn_group_banner 26 'configuration.at:143' \ - "cobc with own configuration file via -conf" " " 1 -at_xfail=no -( - $as_echo "26. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >test.conf <<'_ATEOF' - -include "default.conf" -name: "Sample Conf" -comment-paragraphs: ok -_ATEOF - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - AUTHOR. tester. - DATA DIVISION. - WORKING-STORAGE SECTION. - PROCEDURE DIVISION. - STOP RUN. -_ATEOF - - -# check if override via -conf works and if include works -{ set +x -$as_echo "$at_srcdir/configuration.at:163: \$COMPILE_ONLY -conf=test.conf prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY -conf=test.conf prog.cob" "configuration.at:163" -( $at_check_trace; $COMPILE_ONLY -conf=test.conf prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/configuration.at:163" -$at_failed && at_fn_log_failure -$at_traceon; } - - -# check if configuration file loading with full path works -{ set +x -$as_echo "$at_srcdir/configuration.at:166: \$COMPILE_ONLY \\ --conf=\"\$(_return_path \"\$(pwd)/test.conf\")\" prog.cob" -at_fn_check_prepare_notrace 'a $(...) command substitution' "configuration.at:166" -( $at_check_trace; $COMPILE_ONLY \ --conf="$(_return_path "$(pwd)/test.conf")" prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/configuration.at:166" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_26 -#AT_START_27 -at_fn_group_banner 27 'configuration.at:172' \ - "cobc configuration: recursive include" " " 1 -at_xfail=no -( - $as_echo "27. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >test.conf <<'_ATEOF' - -# different line for "include" to check the line number -include "test2.conf" -_ATEOF - - -cat >test2.conf <<'_ATEOF' - -# include in -# line 4 -include "test3.conf" -_ATEOF - - -cat >test3.conf <<'_ATEOF' - -include "test.conf" -_ATEOF - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - PROCEDURE DIVISION. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/configuration.at:199: \$COMPILE_ONLY -conf=test.conf prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY -conf=test.conf prog.cob" "configuration.at:199" -( $at_check_trace; $COMPILE_ONLY -conf=test.conf prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "configuration error: -test.conf: recursive inclusion -test3.conf:2: configuration file was included here -test2.conf:4: configuration file was included here -test.conf:3: configuration file was included here -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/configuration.at:199" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_27 -#AT_START_28 -at_fn_group_banner 28 'configuration.at:210' \ - "cobc with -std and -conf" " " 1 -at_xfail=no -( - $as_echo "28. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >test.conf <<'_ATEOF' - -include "mf.conf" -name: "Sample Conf" -comment-paragraphs: ok -_ATEOF - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - AUTHOR. tester. - DATA DIVISION. - WORKING-STORAGE SECTION. - PROCEDURE DIVISION. - STOP RUN. -_ATEOF - - -# check if override via -conf works and if include works -{ set +x -$as_echo "$at_srcdir/configuration.at:230: \$COMPILE_ONLY -std=default -conf=test.conf prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY -std=default -conf=test.conf prog.cob" "configuration.at:230" -( $at_check_trace; $COMPILE_ONLY -std=default -conf=test.conf prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "configuration warning: test.conf: The previous loaded configuration 'GnuCOBOL' will be discarded. -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/configuration.at:230" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_28 -#AT_START_29 -at_fn_group_banner 29 'configuration.at:237' \ - "cobc compiler flag on command line" " " 1 -at_xfail=no -( - $as_echo "29. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - AUTHOR. tester. - DATA DIVISION. - WORKING-STORAGE SECTION. - PROCEDURE DIVISION. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/configuration.at:250: \$COMPILE_ONLY -fcomment-paragraphs=ok prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY -fcomment-paragraphs=ok prog.cob" "configuration.at:250" -( $at_check_trace; $COMPILE_ONLY -fcomment-paragraphs=ok prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/configuration.at:250" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_29 -#AT_START_30 -at_fn_group_banner 30 'configuration.at:256' \ - "cobc compiler flag on command line (priority)" " " 1 -at_xfail=no -( - $as_echo "30. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >test.conf <<'_ATEOF' - -include "default.conf" -name: "Sample Conf" -comment-paragraphs: unconformable -_ATEOF - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - AUTHOR. tester. - DATA DIVISION. - WORKING-STORAGE SECTION. - PROCEDURE DIVISION. - STOP RUN. -_ATEOF - - -# configuration flags must work -{ set +x -$as_echo "$at_srcdir/configuration.at:276: \$COMPILE_ONLY \\ --fcomment-paragraphs=ok prog.cob" -at_fn_check_prepare_notrace 'an embedded newline' "configuration.at:276" -( $at_check_trace; $COMPILE_ONLY \ --fcomment-paragraphs=ok prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/configuration.at:276" -$at_failed && at_fn_log_failure -$at_traceon; } - - -# configuration flag on command line must override all (no matter where it's used) -{ set +x -$as_echo "$at_srcdir/configuration.at:280: \$COMPILE_ONLY \\ --fcomment-paragraphs=ok -conf=test.conf prog.cob" -at_fn_check_prepare_notrace 'an embedded newline' "configuration.at:280" -( $at_check_trace; $COMPILE_ONLY \ --fcomment-paragraphs=ok -conf=test.conf prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/configuration.at:280" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/configuration.at:282: \$COMPILE_ONLY \\ --conf=test.conf -fcomment-paragraphs=ok prog.cob" -at_fn_check_prepare_notrace 'an embedded newline' "configuration.at:282" -( $at_check_trace; $COMPILE_ONLY \ --conf=test.conf -fcomment-paragraphs=ok prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/configuration.at:282" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_30 -#AT_START_31 -at_fn_group_banner 31 'configuration.at:289' \ - "cobc configuration: entries" " " 1 -at_xfail=no -( - $as_echo "31. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - PROCEDURE DIVISION. - STOP RUN. -_ATEOF - - -# conf entries must be clean -{ set +x -$as_echo "$at_srcdir/configuration.at:302: \$COMPILE_ONLY -q \\ --fcomment-paragraphsok prog.cob" -at_fn_check_prepare_notrace 'an embedded newline' "configuration.at:302" -( $at_check_trace; $COMPILE_ONLY -q \ --fcomment-paragraphsok prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "cobc: unrecognized option '-fcomment-paragraphsok' -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/configuration.at:302" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/configuration.at:306: \$COMPILE_ONLY \\ --fassign-clause=cobol-2002 prog.cob" -at_fn_check_prepare_notrace 'an embedded newline' "configuration.at:306" -( $at_check_trace; $COMPILE_ONLY \ --fassign-clause=cobol-2002 prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "configuration error: --fassign-clause=cobol-2002: invalid value 'cobol-2002' for configuration tag 'assign-clause'; - should be one of the following values: dynamic, external, mf, ibm -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/configuration.at:306" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/configuration.at:312: \$COMPILE_ONLY \\ --freserved-words=default prog.cob" -at_fn_check_prepare_notrace 'an embedded newline' "configuration.at:312" -( $at_check_trace; $COMPILE_ONLY \ --freserved-words=default prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/configuration.at:312" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/configuration.at:314: \$COMPILE_ONLY \\ --freserved-words=defaults prog.cob" -at_fn_check_prepare_notrace 'an embedded newline' "configuration.at:314" -( $at_check_trace; $COMPILE_ONLY \ --freserved-words=defaults prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "configuration error: --freserved-words=defaults: Could not access word list for 'defaults' -defaults.words: No such file or directory -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/configuration.at:314" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/configuration.at:320: \$COMPILE_ONLY \\ --fword-length=thirty prog.cob" -at_fn_check_prepare_notrace 'an embedded newline' "configuration.at:320" -( $at_check_trace; $COMPILE_ONLY \ --fword-length=thirty prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "configuration error: --fword-length=thirty: invalid value 'thirty' for configuration tag 'word-length'; - must be numeric -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/configuration.at:320" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/configuration.at:326: \$COMPILE_ONLY \\ --fstandard-define=99 prog.cob" -at_fn_check_prepare_notrace 'an embedded newline' "configuration.at:326" -( $at_check_trace; $COMPILE_ONLY \ --fstandard-define=99 prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "configuration error: --fstandard-define=99: invalid value '99' for configuration tag 'standard-define'; - maximum value: 9 -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/configuration.at:326" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_31 -#AT_START_32 -at_fn_group_banner 32 'configuration.at:336' \ - "cobc configuration: conf missing" " " 1 -at_xfail=no -( - $as_echo "32. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >defunc.conf <<'_ATEOF' - -include "notthere.conf" -_ATEOF - - -cat >defunc2.conf <<'_ATEOF' - -include -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/configuration.at:347: \$COMPILE_ONLY -conf=notthere.conf prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY -conf=notthere.conf prog.cob" "configuration.at:347" -( $at_check_trace; $COMPILE_ONLY -conf=notthere.conf prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "configuration error: -notthere.conf: No such file or directory -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/configuration.at:347" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/configuration.at:351: \$COMPILE_ONLY -conf=defunc.conf prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY -conf=defunc.conf prog.cob" "configuration.at:351" -( $at_check_trace; $COMPILE_ONLY -conf=defunc.conf prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "configuration error: -notthere.conf: No such file or directory -defunc.conf:2: configuration file was included here -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/configuration.at:351" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/configuration.at:356: \$COMPILE_ONLY -conf=defunc2.conf prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY -conf=defunc2.conf prog.cob" "configuration.at:356" -( $at_check_trace; $COMPILE_ONLY -conf=defunc2.conf prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "configuration error: -defunc2.conf:2: invalid configuration tag 'include' -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/configuration.at:356" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_32 -#AT_START_33 -at_fn_group_banner 33 'configuration.at:364' \ - "cobc configuration: conf optional" " " 1 -at_xfail=no -( - $as_echo "33. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >defunc.conf <<'_ATEOF' - -include "default.conf" -includeif "notthere.conf" -_ATEOF - - -cat >test.conf <<'_ATEOF' - -include "default.conf" -include "test2.conf" -_ATEOF - - -cat >test2.conf <<'_ATEOF' - -name: "Sample Conf" -comment-paragraphs: ok -_ATEOF - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - AUTHOR. tester. - DATA DIVISION. - WORKING-STORAGE SECTION. - PROCEDURE DIVISION. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/configuration.at:392: \$COMPILE_ONLY -conf=defunc.conf prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY -conf=defunc.conf prog.cob" "configuration.at:392" -( $at_check_trace; $COMPILE_ONLY -conf=defunc.conf prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob:4: warning: AUTHOR is obsolete in GnuCOBOL -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/configuration.at:392" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/configuration.at:395: \$COMPILE_ONLY -conf=test.conf prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY -conf=test.conf prog.cob" "configuration.at:395" -( $at_check_trace; $COMPILE_ONLY -conf=test.conf prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/configuration.at:395" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_33 -#AT_START_34 -at_fn_group_banner 34 'configuration.at:400' \ - "cobc configuration: incomplete" " " 1 -at_xfail=no -( - $as_echo "34. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >test.conf <<'_ATEOF' - -name: "Empty Conf" -_ATEOF - - -# check if incomplete configuration result in error -{ set +x -$as_echo "$at_srcdir/configuration.at:408: \$COMPILE_ONLY -conf=test.conf prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY -conf=test.conf prog.cob" "configuration.at:408" -( $at_check_trace; $COMPILE_ONLY -conf=test.conf prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "configuration error: -test.conf: missing definitions: - no definition of 'reserved-words' - no definition of 'tab-width' - no definition of 'text-column' - no definition of 'pic-length' - no definition of 'word-length' - no definition of 'literal-length' - no definition of 'numeric-literal-length' - no definition of 'align-record' - no definition of 'align-opt' - no definition of 'standard-define' - no definition of 'binary-size' - no definition of 'binary-byteorder' - no definition of 'assign-clause' - no definition of 'screen-section-rules' - no definition of 'filename-mapping' - no definition of 'pretty-display' - no definition of 'binary-truncate' - no definition of 'complex-odo' - no definition of 'indirect-redefines' - no definition of 'larger-redefines-ok' - no definition of 'relax-syntax-checks' - no definition of 'relax-level-hierarchy' - no definition of 'sticky-linkage' - no definition of 'move-ibm' - no definition of 'perform-osvs' - no definition of 'arithmetic-osvs' - no definition of 'constant-folding' - no definition of 'hostsign' - no definition of 'program-name-redefinition' - no definition of 'accept-update' - no definition of 'accept-auto' - no definition of 'console-is-crt' - no definition of 'no-echo-means-secure' - no definition of 'line-col-zero-default' - no definition of 'report-column-plus' - no definition of 'display-special-fig-consts' - no definition of 'binary-comp-1' - no definition of 'move-non-numeric-lit-to-numeric-is-zero' - no definition of 'implicit-assign-dynamic-var' - no definition of 'comment-paragraphs' - no definition of 'memory-size-clause' - no definition of 'multiple-file-tape-clause' - no definition of 'label-records-clause' - no definition of 'value-of-clause' - no definition of 'data-records-clause' - no definition of 'top-level-occurs-clause' - no definition of 'same-as-clause' - no definition of 'synchronized-clause' - no definition of 'sync-left-right' - no definition of 'special-names-clause' - no definition of 'goto-statement-without-name' - no definition of 'stop-literal-statement' - no definition of 'stop-identifier-statement' - no definition of 'debugging-mode' - no definition of 'use-for-debugging' - no definition of 'padding-character-clause' - no definition of 'next-sentence-phrase' - no definition of 'listing-statements' - no definition of 'title-statement' - no definition of 'entry-statement' - no definition of 'move-noninteger-to-alphanumeric' - no definition of 'occurs-max-length-without-subscript' - no definition of 'length-in-data-division' - no definition of 'move-figurative-constant-to-numeric' - no definition of 'move-figurative-space-to-numeric' - no definition of 'move-figurative-quote-to-numeric' - no definition of 'odo-without-to' - no definition of 'section-segments' - no definition of 'alter-statement' - no definition of 'call-overflow' - no definition of 'numeric-boolean' - no definition of 'hexadecimal-boolean' - no definition of 'national-literals' - no definition of 'hexadecimal-national-literals' - no definition of 'national-character-literals' - no definition of 'hp-octal-literals' - no definition of 'acu-literals' - no definition of 'word-continuation' - no definition of 'not-exception-before-exception' - no definition of 'accept-display-extensions' - no definition of 'renames-uncommon-levels' - no definition of 'symbolic-constant' - no definition of 'constant-78' - no definition of 'constant-01' - no definition of 'perform-varying-without-by' - no definition of 'reference-out-of-declaratives' - no definition of 'reference-bounds-check' - no definition of 'program-prototypes' - no definition of 'call-convention-mnemonic' - no definition of 'call-convention-linkage' - no definition of 'numeric-value-for-edited-item' - no definition of 'incorrect-conf-sec-order' - no definition of 'define-constant-directive' - no definition of 'free-redefines-position' - no definition of 'records-mismatch-record-clause' - no definition of 'record-delimiter' - no definition of 'sequential-delimiters' - no definition of 'record-delim-with-fixed-recs' - no definition of 'missing-statement' - no definition of 'zero-length-literals' - no definition of 'xml-generate-extra-phrases' - no definition of 'continue-after' - no definition of 'goto-entry' - no definition of 'depending-on-not-fixed' - no definition of 'binary-sync-clause' - no definition of 'nonnumeric-with-numeric-group-usage' - no definition of 'assign-variable' - no definition of 'assign-using-variable' - no definition of 'assign-ext-dyn' - no definition of 'assign-disk-from' -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/configuration.at:408" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_34 -#AT_START_35 -at_fn_group_banner 35 'configuration.at:526' \ - "runtime configuration" " " 1 -at_xfail=no -( - $as_echo "35. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -# check if --runtime-conf exits without error -# don't compare stdout -{ set +x -$as_echo "$at_srcdir/configuration.at:531: \$COBCRUN --runtime-conf" -at_fn_check_prepare_dynamic "$COBCRUN --runtime-conf" "configuration.at:531" -( $at_check_trace; $COBCRUN --runtime-conf -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo stdout:; cat "$at_stdout" -at_fn_check_status 0 $at_status "$at_srcdir/configuration.at:531" -$at_failed && at_fn_log_failure -$at_traceon; } - - -# check if --runtime-conf points to a file called "runtime_empty.cfg" -# use tr to remove newlines and spaces as the path likely is split -# into two lines -{ set +x -$as_echo "$at_srcdir/configuration.at:536: \$COBCRUN --runtime-conf | tr -d '\\n ' | \\ -grep \"runtime_empty.cfg\"" -at_fn_check_prepare_notrace 'an embedded newline' "configuration.at:536" -( $at_check_trace; $COBCRUN --runtime-conf | tr -d '\n ' | \ -grep "runtime_empty.cfg" -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo stdout:; cat "$at_stdout" -at_fn_check_status 0 $at_status "$at_srcdir/configuration.at:536" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/configuration.at:538: COB_RUNTIME_CONFIG=\"\" \$COBCRUN --runtime-conf | tr -d '\\n ' \\ -| grep \"runtime.cfg\"" -at_fn_check_prepare_notrace 'an embedded newline' "configuration.at:538" -( $at_check_trace; COB_RUNTIME_CONFIG="" $COBCRUN --runtime-conf | tr -d '\n ' \ -| grep "runtime.cfg" -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo stdout:; cat "$at_stdout" -at_fn_check_status 0 $at_status "$at_srcdir/configuration.at:538" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_35 -#AT_START_36 -at_fn_group_banner 36 'configuration.at:545' \ - "runtime configuration file" " " 1 -at_xfail=no -( - $as_echo "36. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >test.cfg <<'_ATEOF' - -include "test2.cfg" -_ATEOF - - -cat >test2.cfg <<'_ATEOF' - -physical_cancel true -_ATEOF - - -cat >test3.cfg <<'_ATEOF' - -setenv COB_PHYSICAL_CANCEL=true -_ATEOF - - - -# verify that default for physical cancel is still "no" -{ set +x -$as_echo "$at_srcdir/configuration.at:562: \$COBCRUN --runtime-conf | \\ -grep \"COB_PHYSICAL_CANCEL\" | grep \"no\" | grep \"default\"" -at_fn_check_prepare_notrace 'an embedded newline' "configuration.at:562" -( $at_check_trace; $COBCRUN --runtime-conf | \ -grep "COB_PHYSICAL_CANCEL" | grep "no" | grep "default" -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo stdout:; cat "$at_stdout" -at_fn_check_status 0 $at_status "$at_srcdir/configuration.at:562" -$at_failed && at_fn_log_failure -$at_traceon; } - - -# verify that override via -c works and if include works -{ set +x -$as_echo "$at_srcdir/configuration.at:566: \$COBCRUN -c test2.cfg --runtime-conf | \\ -grep \"physical_cancel\" | grep \"yes\"" -at_fn_check_prepare_notrace 'an embedded newline' "configuration.at:566" -( $at_check_trace; $COBCRUN -c test2.cfg --runtime-conf | \ -grep "physical_cancel" | grep "yes" -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo stdout:; cat "$at_stdout" -at_fn_check_status 0 $at_status "$at_srcdir/configuration.at:566" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/configuration.at:568: \$COBCRUN -c test.cfg --runtime-conf | \\ -grep \"physical_cancel\" | grep \"yes\"" -at_fn_check_prepare_notrace 'an embedded newline' "configuration.at:568" -( $at_check_trace; $COBCRUN -c test.cfg --runtime-conf | \ -grep "physical_cancel" | grep "yes" -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo stdout:; cat "$at_stdout" -at_fn_check_status 0 $at_status "$at_srcdir/configuration.at:568" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/configuration.at:570: \$COBCRUN -c test3.cfg --runtime-conf | \\ -grep \"COB_PHYSICAL_CANCEL\" | grep \"yes\"" -at_fn_check_prepare_notrace 'an embedded newline' "configuration.at:570" -( $at_check_trace; $COBCRUN -c test3.cfg --runtime-conf | \ -grep "COB_PHYSICAL_CANCEL" | grep "yes" -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo stdout:; cat "$at_stdout" -at_fn_check_status 0 $at_status "$at_srcdir/configuration.at:570" -$at_failed && at_fn_log_failure -$at_traceon; } - - -# verify that that long option works -{ set +x -$as_echo "$at_srcdir/configuration.at:574: \$COBCRUN --config=test3.cfg --runtime-conf | \\ -grep \"COB_PHYSICAL_CANCEL\" | grep \"yes\"" -at_fn_check_prepare_notrace 'an embedded newline' "configuration.at:574" -( $at_check_trace; $COBCRUN --config=test3.cfg --runtime-conf | \ -grep "COB_PHYSICAL_CANCEL" | grep "yes" -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo stdout:; cat "$at_stdout" -at_fn_check_status 0 $at_status "$at_srcdir/configuration.at:574" -$at_failed && at_fn_log_failure -$at_traceon; } - - -# verify that that environment setting works -{ set +x -$as_echo "$at_srcdir/configuration.at:578: COB_RUNTIME_CONFIG=test3.cfg \$COBCRUN --runtime-conf | \\ -grep \"COB_PHYSICAL_CANCEL\" | grep \"yes\"" -at_fn_check_prepare_notrace 'an embedded newline' "configuration.at:578" -( $at_check_trace; COB_RUNTIME_CONFIG=test3.cfg $COBCRUN --runtime-conf | \ -grep "COB_PHYSICAL_CANCEL" | grep "yes" -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo stdout:; cat "$at_stdout" -at_fn_check_status 0 $at_status "$at_srcdir/configuration.at:578" -$at_failed && at_fn_log_failure -$at_traceon; } - - -# verify that configuration file loading with full path works -{ set +x -$as_echo "$at_srcdir/configuration.at:582: \$COBCRUN -c \"\$(_return_path \"\$(pwd)/test.cfg\")\" --runtime-conf" -at_fn_check_prepare_notrace 'a $(...) command substitution' "configuration.at:582" -( $at_check_trace; $COBCRUN -c "$(_return_path "$(pwd)/test.cfg")" --runtime-conf -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo stdout:; cat "$at_stdout" -at_fn_check_status 0 $at_status "$at_srcdir/configuration.at:582" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_36 -#AT_START_37 -at_fn_group_banner 37 'configuration.at:588' \ - "runtime configuration: recursive include" " " 1 -at_xfail=no -( - $as_echo "37. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >test.cfg <<'_ATEOF' - -# different line for "include" to check the line number -include "test2.cfg" -_ATEOF - - -cat >test2.cfg <<'_ATEOF' - -# include in -# line 4 -include "test3.cfg" -_ATEOF - - -cat >test3.cfg <<'_ATEOF' - -include "test.cfg" -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/configuration.at:606: \$COBCRUN -c test.cfg -r" -at_fn_check_prepare_dynamic "$COBCRUN -c test.cfg -r" "configuration.at:606" -( $at_check_trace; $COBCRUN -c test.cfg -r -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "configuration error: -test.cfg: recursive inclusion -test3.cfg:2: configuration file was included here -test2.cfg:4: configuration file was included here -test.cfg:3: configuration file was included here -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/configuration.at:606" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_37 -#AT_START_38 -at_fn_group_banner 38 'configuration.at:617' \ - "runtime configuration: environment priority" " " 1 -at_xfail=no -( - $as_echo "38. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >test.cfg <<'_ATEOF' - -physical_cancel true -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/configuration.at:624: COB_PHYSICAL_CANCEL=false \$COBCRUN -c test.cfg --runtime-conf | \\ -grep \"COB_PHYSICAL_CANCEL\" | grep \"no\"" -at_fn_check_prepare_notrace 'an embedded newline' "configuration.at:624" -( $at_check_trace; COB_PHYSICAL_CANCEL=false $COBCRUN -c test.cfg --runtime-conf | \ -grep "COB_PHYSICAL_CANCEL" | grep "no" -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo stdout:; cat "$at_stdout" -at_fn_check_status 0 $at_status "$at_srcdir/configuration.at:624" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_38 -#AT_START_39 -at_fn_group_banner 39 'configuration.at:630' \ - "runtime configuration: entries" " " 1 -at_xfail=no -( - $as_echo "39. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -{ set +x -$as_echo "$at_srcdir/configuration.at:633: echo \"\$PATHSEP\"" -at_fn_check_prepare_dynamic "echo \"$PATHSEP\"" "configuration.at:633" -( $at_check_trace; echo "$PATHSEP" -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo "; -" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/configuration.at:633" -if $at_failed; then : - # Previous test "failed" --> PATHSEP isn't ; - -cat >defunc.cfg <<'_ATEOF' - -novar -physical_cancel notwithme -load_case insensitive -varseq_format big -sort_chunk 4K -sort_memory 4G # too big by some byte -setenv nothing -sort_chunk -trace_file /tmp:/temp -_ATEOF - - -# conf entries must be clean -{ set +x -$as_echo "$at_srcdir/configuration.at:651: \$COBCRUN -c defunc.cfg --runtime-conf" -at_fn_check_prepare_dynamic "$COBCRUN -c defunc.cfg --runtime-conf" "configuration.at:651" -( $at_check_trace; $COBCRUN -c defunc.cfg --runtime-conf -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "configuration error: -defunc.cfg:2: unknown configuration tag 'novar' -defunc.cfg:3: invalid value 'notwithme' for configuration tag 'physical_cancel'; - should be one of the following values: true, false -defunc.cfg:4: invalid value 'insensitive' for configuration tag 'load_case'; - should be one of the following values: LOWER(1), UPPER(2), not set(0) -defunc.cfg:5: invalid value 'big' for configuration tag 'varseq_format'; - should be one of the following values: 0, 1, 2, 3, mf, gc, b4, b32, l4, l32 -defunc.cfg:6: invalid value '4K' for configuration tag 'sort_chunk'; - minimum value: 131072 -defunc.cfg:7: invalid value '4G' for configuration tag 'sort_memory'; - maximum value: 4294967294 -defunc.cfg:8: WARNING - 'setenv nothing' without a value - ignored! -defunc.cfg:9: WARNING - 'sort_chunk' without a value - ignored! -defunc.cfg:10: invalid value '/tmp:/temp' for configuration tag 'trace_file'; - should not contain ':' -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/configuration.at:651" -$at_failed && at_fn_log_failure -$at_traceon; } - - - -else - # Previous test "passed" --> PATHSEP is ; - -cat >defunc.cfg <<'_ATEOF' - -novar -physical_cancel notwithme -load_case insensitive -varseq_format big -sort_chunk 4K -sort_memory 4G # too big by some byte -setenv nothing -sort_chunk -trace_file C:\tmp;C:\temp -_ATEOF - - -# conf entries must be clean -{ set +x -$as_echo "$at_srcdir/configuration.at:687: \$COBCRUN -c defunc.cfg --runtime-conf" -at_fn_check_prepare_dynamic "$COBCRUN -c defunc.cfg --runtime-conf" "configuration.at:687" -( $at_check_trace; $COBCRUN -c defunc.cfg --runtime-conf -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "configuration error: -defunc.cfg:2: unknown configuration tag 'novar' -defunc.cfg:3: invalid value 'notwithme' for configuration tag 'physical_cancel'; - should be one of the following values: true, false -defunc.cfg:4: invalid value 'insensitive' for configuration tag 'load_case'; - should be one of the following values: LOWER(1), UPPER(2), not set(0) -defunc.cfg:5: invalid value 'big' for configuration tag 'varseq_format'; - should be one of the following values: 0, 1, 2, 3, mf, gc, b4, b32, l4, l32 -defunc.cfg:6: invalid value '4K' for configuration tag 'sort_chunk'; - minimum value: 131072 -defunc.cfg:7: invalid value '4G' for configuration tag 'sort_memory'; - maximum value: 4294967294 -defunc.cfg:8: WARNING - 'setenv nothing' without a value - ignored! -defunc.cfg:9: WARNING - 'sort_chunk' without a value - ignored! -defunc.cfg:10: invalid value 'C:\\tmp;C:\\temp' for configuration tag 'trace_file'; - should not contain ';' -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/configuration.at:687" -$at_failed && at_fn_log_failure -$at_traceon; } - - - -fi -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_39 -#AT_START_40 -at_fn_group_banner 40 'configuration.at:711' \ - "runtime configuration: conf missing" " " 1 -at_xfail=no -( - $as_echo "40. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >defunc.cfg <<'_ATEOF' - -include "notthere.cfg" -_ATEOF - - -cat >defunc2.cfg <<'_ATEOF' - -include -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/configuration.at:722: \$COBCRUN -c notthere.cfg --runtime-conf" -at_fn_check_prepare_dynamic "$COBCRUN -c notthere.cfg --runtime-conf" "configuration.at:722" -( $at_check_trace; $COBCRUN -c notthere.cfg --runtime-conf -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "configuration error: -notthere.cfg: No such file or directory -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/configuration.at:722" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/configuration.at:726: \$COBCRUN -c defunc.cfg --runtime-conf" -at_fn_check_prepare_dynamic "$COBCRUN -c defunc.cfg --runtime-conf" "configuration.at:726" -( $at_check_trace; $COBCRUN -c defunc.cfg --runtime-conf -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "configuration error: -notthere.cfg: No such file or directory -defunc.cfg:2: configuration file was included here -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/configuration.at:726" -$at_failed && at_fn_log_failure -$at_traceon; } - - -{ set +x -$as_echo "$at_srcdir/configuration.at:732: \$COBCRUN -c defunc2.cfg --runtime-conf" -at_fn_check_prepare_dynamic "$COBCRUN -c defunc2.cfg --runtime-conf" "configuration.at:732" -( $at_check_trace; $COBCRUN -c defunc2.cfg --runtime-conf -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "configuration error: -defunc2.cfg:2: 'include' without a value! -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/configuration.at:732" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_40 -#AT_START_41 -at_fn_group_banner 41 'configuration.at:740' \ - "runtime configuration: conf optional" " " 1 -at_xfail=no -( - $as_echo "41. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >defunc.cfg <<'_ATEOF' - -include "runtime_empty.cfg" -includeif "notthere.cfg" -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/configuration.at:748: \$COBCRUN -c defunc.cfg --runtime-conf" -at_fn_check_prepare_dynamic "$COBCRUN -c defunc.cfg --runtime-conf" "configuration.at:748" -( $at_check_trace; $COBCRUN -c defunc.cfg --runtime-conf -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo stdout:; cat "$at_stdout" -at_fn_check_status 0 $at_status "$at_srcdir/configuration.at:748" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_41 -#AT_START_42 -at_fn_group_banner 42 'configuration.at:753' \ - "runtime configuration: strings and environment" " " 1 -at_xfail=no -( - $as_echo "42. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -{ set +x -$as_echo "$at_srcdir/configuration.at:756: unset greet name; \\ -TESTME=\"this is a test\" COB_EXIT_MSG='\${greet:Bye} \${name:-user}, \${TESTME}' \$COBCRUN --runtime-conf | \\ -grep \"COB_EXIT_MSG\" | grep \"Bye user, this is a test\"" -at_fn_check_prepare_notrace 'a ${...} parameter expansion' "configuration.at:756" -( $at_check_trace; unset greet name; \ -TESTME="this is a test" COB_EXIT_MSG='${greet:Bye} ${name:-user}, ${TESTME}' $COBCRUN --runtime-conf | \ -grep "COB_EXIT_MSG" | grep "Bye user, this is a test" -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo stdout:; cat "$at_stdout" -at_fn_check_status 0 $at_status "$at_srcdir/configuration.at:756" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/configuration.at:759: \$COBCRUN --runtime-conf | \\ -grep \"COB_EXIT_MSG\" | grep \"end of program, please press a key to exit\"" -at_fn_check_prepare_notrace 'an embedded newline' "configuration.at:759" -( $at_check_trace; $COBCRUN --runtime-conf | \ -grep "COB_EXIT_MSG" | grep "end of program, please press a key to exit" -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo stdout:; cat "$at_stdout" -at_fn_check_status 0 $at_status "$at_srcdir/configuration.at:759" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_42 -#AT_START_43 -at_fn_group_banner 43 'configuration.at:765' \ - "validation of COB_CONFIG_DIR" " " 1 -at_xfail=no -( - $as_echo "43. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - PROCEDURE DIVISION. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/configuration.at:775: echo \"\$PATHSEP\"" -at_fn_check_prepare_dynamic "echo \"$PATHSEP\"" "configuration.at:775" -( $at_check_trace; echo "$PATHSEP" -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo "; -" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/configuration.at:775" -if $at_failed; then : - # Previous test "failed" --> PATHSEP isn't ; - -{ set +x -$as_echo "$at_srcdir/configuration.at:780: COB_CONFIG_DIR=\"/temp:/tmp\" \\ -\$COMPILE prog.cob" -at_fn_check_prepare_notrace 'an embedded newline' "configuration.at:780" -( $at_check_trace; COB_CONFIG_DIR="/temp:/tmp" \ -$COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "cobc: environment variable 'COB_CONFIG_DIR' is '/temp:/tmp'; should not contain ':' -configuration error: -default.conf: No such file or directory -cobc: error: please check environment variables as noted above -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/configuration.at:780" -$at_failed && at_fn_log_failure -$at_traceon; } - - - -else - # Previous test "passed" --> PATHSEP is ; - -{ set +x -$as_echo "$at_srcdir/configuration.at:792: COB_CONFIG_DIR=\"C:\\temp;C:\\tmp\" \\ -\$COMPILE prog.cob" -at_fn_check_prepare_notrace 'an embedded newline' "configuration.at:792" -( $at_check_trace; COB_CONFIG_DIR="C:\temp;C:\tmp" \ -$COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "cobc: environment variable 'COB_CONFIG_DIR' is 'C:\\temp;C:\\tmp'; should not contain ';' -configuration error: -default.conf: No such file or directory -cobc: error: please check environment variables as noted above -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/configuration.at:792" -$at_failed && at_fn_log_failure -$at_traceon; } - - - -fi -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_43 -#AT_START_44 -at_fn_group_banner 44 'syn_copy.at:21' \ - "COPY: within comment" " " 2 -at_xfail=no -( - $as_echo "44. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - *COPY "copy.inc". - PROCEDURE DIVISION. - STOP RUN. -_ATEOF - - -cat >prog2.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog2. - DATA DIVISION. - WORKING-STORAGE SECTION. - *> COPY "copy.inc". - PROCEDURE DIVISION. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/syn_copy.at:44: \$COMPILE_ONLY prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY prog.cob" "syn_copy.at:44" -( $at_check_trace; $COMPILE_ONLY prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/syn_copy.at:44" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/syn_copy.at:45: \$COMPILE_ONLY -free prog2.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY -free prog2.cob" "syn_copy.at:45" -( $at_check_trace; $COMPILE_ONLY -free prog2.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/syn_copy.at:45" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_44 -#AT_START_45 -at_fn_group_banner 45 'syn_copy.at:50' \ - "COPY: file not found" " " 2 -at_xfail=no -( - $as_echo "45. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -# FIXME: possibly move "name without literal" to an extra test -# also testing the library name part (as "found", because -# of different slash) - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - COPY "copy.inc". - PROCEDURE DIVISION. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/syn_copy.at:67: \$COMPILE_ONLY prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY prog.cob" "syn_copy.at:67" -( $at_check_trace; $COMPILE_ONLY prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob:6: error: copy.inc: No such file or directory -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/syn_copy.at:67" -$at_failed && at_fn_log_failure -$at_traceon; } - - -cat >prog2.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - COPY copy.inc. - PROCEDURE DIVISION. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/syn_copy.at:81: \$COMPILE_ONLY prog2.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY prog2.cob" "syn_copy.at:81" -( $at_check_trace; $COMPILE_ONLY prog2.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog2.cob:6: error: COPY.INC: No such file or directory -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/syn_copy.at:81" -$at_failed && at_fn_log_failure -$at_traceon; } - - -cat >prog3.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - COPY copy.INC.inc. - PROCEDURE DIVISION. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/syn_copy.at:95: \$COMPILE_ONLY prog3.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY prog3.cob" "syn_copy.at:95" -( $at_check_trace; $COMPILE_ONLY prog3.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog3.cob:6: error: COPY.INC.INC: No such file or directory -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/syn_copy.at:95" -$at_failed && at_fn_log_failure -$at_traceon; } - - -{ set +x -$as_echo "$at_srcdir/syn_copy.at:99: \$COMPILE_ONLY -ffold-copy=lower prog3.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY -ffold-copy=lower prog3.cob" "syn_copy.at:99" -( $at_check_trace; $COMPILE_ONLY -ffold-copy=lower prog3.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog3.cob:6: error: copy.inc.inc: No such file or directory -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/syn_copy.at:99" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_45 -#AT_START_46 -at_fn_group_banner 46 'syn_copy.at:106' \ - "COPY: recursive" " " 2 -at_xfail=no -( - $as_echo "46. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - COPY copy1. - PROCEDURE DIVISION. - DISPLAY TEST-VAR. - STOP RUN. -_ATEOF - - -cat >copy1.CPY <<'_ATEOF' - - COPY copy2. - 01 TEST-VAR PIC X(2) VALUE "V1". -_ATEOF - - -cat >copy2.CPY <<'_ATEOF' - - 01 TEST-VAR2 PIC X(2) VALUE "V2". - COPY copy3. -_ATEOF - - -cat >copy3.CPY <<'_ATEOF' - COPY "copy1.CPY". - 01 TEST-VAR3 PIC X(2) VALUE "V3". -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/syn_copy.at:135: \$COMPILE_ONLY prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY prog.cob" "syn_copy.at:135" -( $at_check_trace; $COMPILE_ONLY prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "copy1.CPY: error: recursive inclusion -copy3.CPY:1: warning: file was included here -copy2.CPY:3: warning: file was included here -copy1.CPY:2: warning: file was included here -prog.cob:6: warning: file was included here -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/syn_copy.at:135" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_46 -#AT_START_47 -at_fn_group_banner 47 'syn_copy.at:146' \ - "COPY: replacement order" " " 2 -at_xfail=no -( - $as_echo "47. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >copy.inc <<'_ATEOF' - - 01 TEST-VAR PIC X(2) VALUE "OK". -_ATEOF - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - COPY "copy.inc" - REPLACING ==TEST-VAR== BY ==FIRST-MATCH== - ==TEST-VAR== BY ==SECOND-MATCH==. - PROCEDURE DIVISION. - DISPLAY FIRST-MATCH NO ADVANCING - END-DISPLAY. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/syn_copy.at:167: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "syn_copy.at:167" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/syn_copy.at:167" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/syn_copy.at:168: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "syn_copy.at:168" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo "OK" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/syn_copy.at:168" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_47 -#AT_START_48 -at_fn_group_banner 48 'syn_copy.at:173' \ - "COPY: separators" " " 2 -at_xfail=no -( - $as_echo "48. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >copy.inc <<'_ATEOF' - - 01 TEST-VAR PIC X(2) VALUE "OK". -_ATEOF - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - COPY "copy.inc" - REPLACING ==TEST-VAR==, BY ==FIRST-MATCH==, - , ==TEST-VAR==; BY ==SECOND-MATCH==; - ; ==TEST-VAR== , BY ==THIRD-MATCH== - ==TEST-VAR== ; BY ==FOURTH-MATCH==. - PROCEDURE DIVISION. - DISPLAY FIRST-MATCH NO ADVANCING - END-DISPLAY. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/syn_copy.at:196: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "syn_copy.at:196" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/syn_copy.at:196" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/syn_copy.at:197: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "syn_copy.at:197" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo "OK" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/syn_copy.at:197" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_48 -#AT_START_49 -at_fn_group_banner 49 'syn_copy.at:202' \ - "COPY: partial replacement" " " 2 -at_xfail=no -( - $as_echo "49. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >copy.inc <<'_ATEOF' - - 01 :TEST:-VAR PIC X(2) VALUE "OK". - 01 (TEST)-VAR PIC X(2) VALUE "OK". -_ATEOF - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - COPY "copy.inc" - REPLACING ==:TEST:== BY ==COLON== - ==(TEST)== BY ==PAREN==. - PROCEDURE DIVISION. - DISPLAY COLON-VAR NO ADVANCING - END-DISPLAY. - DISPLAY PAREN-VAR NO ADVANCING - END-DISPLAY. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/syn_copy.at:226: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "syn_copy.at:226" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/syn_copy.at:226" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/syn_copy.at:227: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "syn_copy.at:227" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo "OKOK" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/syn_copy.at:227" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_49 -#AT_START_50 -at_fn_group_banner 50 'syn_copy.at:232' \ - "COPY: LEADING replacement" " " 2 -at_xfail=no -( - $as_echo "50. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >copy.inc <<'_ATEOF' - - 01 TEST-VAR PIC X(2) VALUE "OK". - 01 NORM-VAR PIC X(2) VALUE "OK". -_ATEOF - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - COPY "copy.inc" - REPLACING LEADING ==TEST== BY ==FIRST== - LEADING ==NORM== BY ==SECOND==. - PROCEDURE DIVISION. - DISPLAY FIRST-VAR NO ADVANCING - END-DISPLAY. - DISPLAY SECOND-VAR NO ADVANCING - END-DISPLAY. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/syn_copy.at:256: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "syn_copy.at:256" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/syn_copy.at:256" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/syn_copy.at:257: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "syn_copy.at:257" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo "OKOK" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/syn_copy.at:257" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_50 -#AT_START_51 -at_fn_group_banner 51 'syn_copy.at:262' \ - "COPY: TRAILING replacement" " " 2 -at_xfail=no -( - $as_echo "51. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >copy.inc <<'_ATEOF' - - 01 TEST-FIRST PIC X(2) VALUE "OK". - 01 TEST-SECOND PIC X(2) VALUE "OK". -_ATEOF - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - COPY "copy.inc" - REPLACING TRAILING ==FIRST== BY ==VAR1== - TRAILING ==SECOND== BY ==VAR2==. - PROCEDURE DIVISION. - DISPLAY TEST-VAR1 NO ADVANCING - END-DISPLAY. - DISPLAY TEST-VAR2 NO ADVANCING - END-DISPLAY. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/syn_copy.at:286: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "syn_copy.at:286" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/syn_copy.at:286" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/syn_copy.at:287: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "syn_copy.at:287" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo "OKOK" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/syn_copy.at:287" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_51 -#AT_START_52 -at_fn_group_banner 52 'syn_copy.at:292' \ - "COPY: recursive replacement" " " 2 -at_xfail=no -( - $as_echo "52. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >copy-2.inc <<'_ATEOF' - - 01 TEST-VAR PIC X(2) VALUE "OK". -_ATEOF - - -cat >copy-1.inc <<'_ATEOF' - - COPY "copy-2.inc". -_ATEOF - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - COPY "copy-1.inc" - REPLACING ==TEST-VAR== BY ==COPY-VAR==. - PROCEDURE DIVISION. - DISPLAY COPY-VAR NO ADVANCING - END-DISPLAY. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/syn_copy.at:316: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "syn_copy.at:316" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/syn_copy.at:316" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/syn_copy.at:317: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "syn_copy.at:317" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo "OK" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/syn_copy.at:317" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_52 -#AT_START_53 -at_fn_group_banner 53 'syn_copy.at:322' \ - "COPY: fixed/free format" " " 2 -at_xfail=no -( - $as_echo "53. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >copy.inc <<'_ATEOF' - - >>SOURCE FIXED - 01 TEST-VAR PIC X(2) VALUE "OK". -_ATEOF - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - COPY "copy.inc". - PROCEDURE DIVISION. - DISPLAY TEST-VAR NO ADVANCING - END-DISPLAY. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/syn_copy.at:342: \$COMPILE -free prog.cob" -at_fn_check_prepare_dynamic "$COMPILE -free prog.cob" "syn_copy.at:342" -( $at_check_trace; $COMPILE -free prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/syn_copy.at:342" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/syn_copy.at:343: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "syn_copy.at:343" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo "OK" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/syn_copy.at:343" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_53 -#AT_START_54 -at_fn_group_banner 54 'syn_definition.at:25' \ - "Invalid source name" " " 2 -at_xfail=no -( - $as_echo "54. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -: >short.cob - -{ set +x -$as_echo "$at_srcdir/syn_definition.at:30: \$COMPILE_ONLY short.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY short.cob" "syn_definition.at:30" -( $at_check_trace; $COMPILE_ONLY short.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "short.cob: error: invalid file base name 'short' - name duplicates a 'C' keyword -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/syn_definition.at:30" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_54 -#AT_START_55 -at_fn_group_banner 55 'syn_definition.at:37' \ - "Invalid PROGRAM-ID" " " 2 -at_xfail=no -( - $as_echo "55. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >SHORT.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. short. - PROCEDURE DIVISION. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/syn_definition.at:47: \$COMPILE_ONLY SHORT.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY SHORT.cob" "syn_definition.at:47" -( $at_check_trace; $COMPILE_ONLY SHORT.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "SHORT.cob:3: error: invalid PROGRAM-ID 'short' - name duplicates a 'C' keyword -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/syn_definition.at:47" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_55 -#AT_START_56 -at_fn_group_banner 56 'syn_definition.at:54' \ - "Invalid PROGRAM-ID type clause (1)" " " 2 -at_xfail=no -( - $as_echo "56. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog IS COMMON. - PROCEDURE DIVISION. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/syn_definition.at:64: \$COMPILE_ONLY prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY prog.cob" "syn_definition.at:64" -( $at_check_trace; $COMPILE_ONLY prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob:3: error: COMMON may only be used in a contained program -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/syn_definition.at:64" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_56 -#AT_START_57 -at_fn_group_banner 57 'syn_definition.at:71' \ - "invalid PROGRAM-ID type clause (2)" " " 2 -at_xfail=no -( - $as_echo "57. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog IS INITIAL RECURSIVE. - PROCEDURE DIVISION. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/syn_definition.at:81: \$COMPILE_ONLY prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY prog.cob" "syn_definition.at:81" -( $at_check_trace; $COMPILE_ONLY prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob:3: error: syntax error, unexpected RECURSIVE, expecting . -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/syn_definition.at:81" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_57 -#AT_START_58 -at_fn_group_banner 58 'syn_definition.at:88' \ - "INITIAL / RECURSIVE before COMMON" " " 2 -at_xfail=no -( - $as_echo "58. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >containing-prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. containing-prog. - - PROCEDURE DIVISION. - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog-1 IS INITIAL COMMON. - PROCEDURE DIVISION. - STOP RUN. - END PROGRAM prog-1. - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog-2 IS RECURSIVE COMMON. - PROCEDURE DIVISION. - STOP RUN. - END PROGRAM prog-2. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/syn_definition.at:110: \$COMPILE_ONLY containing-prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY containing-prog.cob" "syn_definition.at:110" -( $at_check_trace; $COMPILE_ONLY containing-prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/syn_definition.at:110" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_58 -#AT_START_59 -at_fn_group_banner 59 'syn_definition.at:120' \ - "Undefined data name" " " 2 -at_xfail=no -( - $as_echo "59. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - PROCEDURE DIVISION. - DISPLAY X - END-DISPLAY. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/syn_definition.at:132: \$COMPILE_ONLY prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY prog.cob" "syn_definition.at:132" -( $at_check_trace; $COMPILE_ONLY prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob:5: error: 'X' cannot be used here -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/syn_definition.at:132" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_59 -#AT_START_60 -at_fn_group_banner 60 'syn_definition.at:139' \ - "Undefined group name" " " 2 -at_xfail=no -( - $as_echo "60. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 X PIC X. - PROCEDURE DIVISION. - DISPLAY X IN G - END-DISPLAY. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/syn_definition.at:154: \$COMPILE_ONLY prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY prog.cob" "syn_definition.at:154" -( $at_check_trace; $COMPILE_ONLY prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob:8: error: 'X IN G' is not defined -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/syn_definition.at:154" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_60 -#AT_START_61 -at_fn_group_banner 61 'syn_definition.at:161' \ - "Undefined data name in group" " " 2 -at_xfail=no -( - $as_echo "61. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 G. - 02 X PIC X. - 01 Y PIC X. - PROCEDURE DIVISION. - DISPLAY Y IN G - END-DISPLAY. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/syn_definition.at:178: \$COMPILE_ONLY prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY prog.cob" "syn_definition.at:178" -( $at_check_trace; $COMPILE_ONLY prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob:10: error: 'Y IN G' is not defined -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/syn_definition.at:178" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_61 -#AT_START_62 -at_fn_group_banner 62 'syn_definition.at:185' \ - "Reference not a group name" " " 2 -at_xfail=no -( - $as_echo "62. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 X PIC X. - PROCEDURE DIVISION. - DISPLAY X IN X - END-DISPLAY. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/syn_definition.at:200: \$COMPILE_ONLY prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY prog.cob" "syn_definition.at:200" -( $at_check_trace; $COMPILE_ONLY prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob:8: error: 'X IN X' is not defined -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/syn_definition.at:200" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_62 -#AT_START_63 -at_fn_group_banner 63 'syn_definition.at:207' \ - "Incomplete 01 definition" " " 2 -at_xfail=no -( - $as_echo "63. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 X. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/syn_definition.at:218: \$COMPILE_ONLY prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY prog.cob" "syn_definition.at:218" -( $at_check_trace; $COMPILE_ONLY prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob:6: error: PICTURE clause required for 'X' -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/syn_definition.at:218" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_63 -#AT_START_64 -at_fn_group_banner 64 'syn_definition.at:225' \ - "error handling in conditions" " " 2 -at_xfail=no -( - $as_echo "64. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 TESTME PIC X(1). - - PROCEDURE DIVISION. - - EVALUATE TRUE - WHEN TESTME IS NOT-DEFINED - CONTINUE - WHEN TESTME = 'A' - CONTINUE - WHEN OTHER - IF NOT TESTME IS NOT-DEFINED - THEN - CONTINUE - ELSE - CONTINUE - END-IF - END-EVALUATE - EVALUATE TRUE - WHEN TESTME IS 'ABC' - CONTINUE - WHEN TESTME = 'B' - CONTINUE - END-EVALUATE - EVALUATE TRUE - WHEN TESTME IS TESTME - CONTINUE - WHEN TESTME = 'C' - CONTINUE - END-EVALUATE - EVALUATE TRUE - WHEN TESTME NOT = NOT-DEFINED - CONTINUE - WHEN TESTME = 'D' - CONTINUE - END-EVALUATE - EVALUATE TRUE - WHEN TESTME ELSE NOT-DEFINED - CONTINUE - WHEN TESTME = 'E' - CONTINUE - END-EVALUATE - EVALUATE broken - WHEN NOT-DEFINED - continue - END-EVALUATE - - GOBACK. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/syn_definition.at:282: \$COMPILE_ONLY prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY prog.cob" "syn_definition.at:282" -( $at_check_trace; $COMPILE_ONLY prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob:11: error: syntax error, unexpected Identifier -prog.cob:16: error: syntax error, unexpected Identifier -prog.cob:24: error: syntax error, unexpected Literal -prog.cob:30: error: syntax error, unexpected Identifier -prog.cob:36: error: 'NOT-DEFINED' is not defined -prog.cob:42: error: syntax error, unexpected ELSE -prog.cob:42: error: syntax error, unexpected Identifier -prog.cob:42: error: invalid expression -prog.cob:47: error: 'broken' is not defined -prog.cob:48: error: 'NOT-DEFINED' is not defined -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/syn_definition.at:282" -$at_failed && at_fn_log_failure -$at_traceon; } - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_64 -#AT_START_65 -at_fn_group_banner 65 'syn_definition.at:299' \ - "Same labels in different sections" " " 2 -at_xfail=no -( - $as_echo "65. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - PROCEDURE DIVISION. - S-1 SECTION. - L. - - S-2 SECTION. - L. - - S-3 SECTION. - GO TO L. - L. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/syn_definition.at:317: \$COMPILE_ONLY prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY prog.cob" "syn_definition.at:317" -( $at_check_trace; $COMPILE_ONLY prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/syn_definition.at:317" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_65 -#AT_START_66 -at_fn_group_banner 66 'syn_definition.at:324' \ - "Redefinition of 01 items" " " 2 -at_xfail=no -( - $as_echo "66. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 X PIC X. - 01 X PIC X. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/syn_definition.at:336: \$COMPILE_ONLY prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY prog.cob" "syn_definition.at:336" -( $at_check_trace; $COMPILE_ONLY prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob:7: warning: redefinition of 'X' -prog.cob:6: warning: 'X' previously defined here -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/syn_definition.at:336" -$at_failed && at_fn_log_failure -$at_traceon; } - - -{ set +x -$as_echo "$at_srcdir/syn_definition.at:341: \$COMPILE_ONLY -Wno-extra prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY -Wno-extra prog.cob" "syn_definition.at:341" -( $at_check_trace; $COMPILE_ONLY -Wno-extra prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/syn_definition.at:341" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_66 -#AT_START_67 -at_fn_group_banner 67 'syn_definition.at:346' \ - "Redefinition of 01 and 02 items" " " 2 -at_xfail=no -( - $as_echo "67. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 X. - 02 X PIC X. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/syn_definition.at:358: \$COMPILE_ONLY prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY prog.cob" "syn_definition.at:358" -( $at_check_trace; $COMPILE_ONLY prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob:7: warning: redefinition of 'X' -prog.cob:6: warning: 'X' previously defined here -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/syn_definition.at:358" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_67 -#AT_START_68 -at_fn_group_banner 68 'syn_definition.at:366' \ - "Redefinition of 02 items" " " 2 -at_xfail=no -( - $as_echo "68. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 G. - 02 X PIC X. - 02 X PIC X. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/syn_definition.at:379: \$COMPILE_ONLY prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY prog.cob" "syn_definition.at:379" -( $at_check_trace; $COMPILE_ONLY prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob:8: warning: redefinition of 'X' -prog.cob:7: warning: 'X' previously defined here -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/syn_definition.at:379" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_68 -#AT_START_69 -at_fn_group_banner 69 'syn_definition.at:387' \ - "Redefinition of 77 items" " " 2 -at_xfail=no -( - $as_echo "69. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 77 X PIC X. - 77 X PIC X. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/syn_definition.at:399: \$COMPILE_ONLY prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY prog.cob" "syn_definition.at:399" -( $at_check_trace; $COMPILE_ONLY prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob:7: warning: redefinition of 'X' -prog.cob:6: warning: 'X' previously defined here -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/syn_definition.at:399" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_69 -#AT_START_70 -at_fn_group_banner 70 'syn_definition.at:407' \ - "Redefinition of 01 and 77 items" " " 2 -at_xfail=no -( - $as_echo "70. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 X PIC X. - 77 X PIC X. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/syn_definition.at:419: \$COMPILE_ONLY prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY prog.cob" "syn_definition.at:419" -( $at_check_trace; $COMPILE_ONLY prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob:7: warning: redefinition of 'X' -prog.cob:6: warning: 'X' previously defined here -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/syn_definition.at:419" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_70 -#AT_START_71 -at_fn_group_banner 71 'syn_definition.at:427' \ - "Redefinition of 88 items" " " 2 -at_xfail=no -( - $as_echo "71. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 X PIC X. - 88 A VALUE "A". - 88 A VALUE "B". -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/syn_definition.at:440: \$COMPILE_ONLY prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY prog.cob" "syn_definition.at:440" -( $at_check_trace; $COMPILE_ONLY prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob:8: warning: redefinition of 'A' -prog.cob:7: warning: 'A' previously defined here -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/syn_definition.at:440" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_71 -#AT_START_72 -at_fn_group_banner 72 'syn_definition.at:448' \ - "Redefinition of program-name by other programs" " " 2 -at_xfail=no -( - $as_echo "72. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 PROG PIC X. - - PROCEDURE DIVISION. - CONTINUE - . - IDENTIFICATION DIVISION. - PROGRAM-ID. foo COMMON. - END PROGRAM foo. - - IDENTIFICATION DIVISION. - PROGRAM-ID. barr. - PROCEDURE DIVISION. - CONTINUE - . - *> This should cause an error (clashes with COMMON subprog foo) - IDENTIFICATION DIVISION. - PROGRAM-ID. foo. - END PROGRAM foo. - END PROGRAM barr. - END PROGRAM prog. - - - *> This should cause an error. - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 foo PIC X. - - PROCEDURE DIVISION. - CONTINUE - . - *> This should clash with the data definition. - IDENTIFICATION DIVISION. - PROGRAM-ID. foo. - END PROGRAM foo. - END PROGRAM prog. - - *> This should cause an error - IDENTIFICATION DIVISION. - PROGRAM-ID. samename. - IDENTIFICATION DIVISION. - PROGRAM-ID. samename. - END PROGRAM samename. - END PROGRAM samename. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/syn_definition.at:505: \$COMPILE_ONLY --ffold-call=upper prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY --ffold-call=upper prog.cob" "syn_definition.at:505" -( $at_check_trace; $COMPILE_ONLY --ffold-call=upper prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob:7: warning: redefinition of 'prog' -prog.cob:3: warning: 'prog' previously defined here -prog.cob:23: error: redefinition of program name 'foo' -prog.cob:31: error: redefinition of program name 'prog' -prog.cob:42: error: redefinition of 'foo' -prog.cob:35: error: 'foo' previously defined here -prog.cob:42: error: redefinition of program name 'foo' -prog.cob:49: error: PROCEDURE DIVISION header missing -prog.cob:50: error: redefinition of program name 'samename' -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/syn_definition.at:505" -$at_failed && at_fn_log_failure -$at_traceon; } - - -{ set +x -$as_echo "$at_srcdir/syn_definition.at:517: \$COMPILE_ONLY prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY prog.cob" "syn_definition.at:517" -( $at_check_trace; $COMPILE_ONLY prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob:23: error: redefinition of program ID 'foo' -prog.cob:31: error: redefinition of program ID 'prog' -prog.cob:42: error: redefinition of program ID 'foo' -prog.cob:49: error: PROCEDURE DIVISION header missing -prog.cob:50: error: redefinition of program ID 'samename' -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/syn_definition.at:517" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_72 -#AT_START_73 -at_fn_group_banner 73 'syn_definition.at:528' \ - "Redefinition of program-name within program" " " 2 -at_xfail=no -( - $as_echo "73. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 prog PIC 99 VALUE 0. - - PROCEDURE DIVISION. - prog. - CONTINUE - . -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/syn_definition.at:545: \$COMPILE_ONLY prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY prog.cob" "syn_definition.at:545" -( $at_check_trace; $COMPILE_ONLY prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob:10: error: redefinition of 'prog' -prog.cob:7: error: 'prog' previously defined here -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/syn_definition.at:545" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/syn_definition.at:549: \$COMPILE_ONLY -fno-program-name-redefinition prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY -fno-program-name-redefinition prog.cob" "syn_definition.at:549" -( $at_check_trace; $COMPILE_ONLY -fno-program-name-redefinition prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob:7: warning: redefinition of 'prog' -prog.cob:3: warning: 'prog' previously defined here -prog.cob:10: error: redefinition of 'prog' -prog.cob:3: error: 'prog' previously defined here -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/syn_definition.at:549" -$at_failed && at_fn_log_failure -$at_traceon; } - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_73 -#AT_START_74 -at_fn_group_banner 74 'syn_definition.at:558' \ - "Redefinition of function-prototype name" " " 2 -at_xfail=no -( - $as_echo "74. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - - ENVIRONMENT DIVISION. - CONFIGURATION SECTION. - REPOSITORY. - FUNCTION func - . - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 func PIC X. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/syn_definition.at:575: \$COMPILE_ONLY prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY prog.cob" "syn_definition.at:575" -( $at_check_trace; $COMPILE_ONLY prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob:8: warning: no definition/prototype seen for FUNCTION 'func' -prog.cob:12: error: syntax error, unexpected user function name -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/syn_definition.at:575" -$at_failed && at_fn_log_failure -$at_traceon; } - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_74 -#AT_START_75 -at_fn_group_banner 75 'syn_definition.at:583' \ - "PROCEDURE DIVISION RETURNING OMITTED: main" " " 2 -at_xfail=no -( - $as_echo "75. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - PROCEDURE DIVISION RETURNING OMITTED. - MOVE 42 TO RETURN-CODE - GOBACK. -_ATEOF - - - -{ set +x -$as_echo "$at_srcdir/syn_definition.at:595: \$COMPILE_MODULE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_MODULE prog.cob" "syn_definition.at:595" -( $at_check_trace; $COMPILE_MODULE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/syn_definition.at:595" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/syn_definition.at:596: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "syn_definition.at:596" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob:4: error: RETURNING clause cannot be OMITTED for main program -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/syn_definition.at:596" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_75 -#AT_START_76 -at_fn_group_banner 76 'syn_definition.at:603' \ - "PROCEDURE DIVISION RETURNING OMITTED: FUNCTION" " " 2 -at_xfail=no -( - $as_echo "76. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - FUNCTION-ID. func. - PROCEDURE DIVISION RETURNING OMITTED. - MOVE 42 TO RETURN-CODE - GOBACK. - END FUNCTION func. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/syn_definition.at:615: \$COMPILE_ONLY prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY prog.cob" "syn_definition.at:615" -( $at_check_trace; $COMPILE_ONLY prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob:4: error: RETURNING clause cannot be OMITTED for a FUNCTION -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/syn_definition.at:615" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_76 -#AT_START_77 -at_fn_group_banner 77 'syn_definition.at:622' \ - "PROCEDURE DIVISION RETURNING item" " " 2 -at_xfail=no -( - $as_echo "77. $at_setup_line: testing $at_desc ..." - $at_traceon - - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - FUNCTION-ID. func. - DATA DIVISION. - LINKAGE SECTION. - 01 PAR-OUT PIC 9. - PROCEDURE DIVISION RETURNING PAR-OUT. - MOVE 4 TO PAR-OUT - GOBACK. - END FUNCTION func. -_ATEOF - - -cat >prog2.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - FUNCTION-ID. func. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 PAR-OUT PIC 9. - PROCEDURE DIVISION RETURNING PAR-OUT. - MOVE 4 TO PAR-OUT - GOBACK. - END FUNCTION func. -_ATEOF - - -cat >prog3.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - FUNCTION-ID. func. - DATA DIVISION. - LINKAGE SECTION. - 01 PAR-OUT PIC 9 OCCURS 10. - PROCEDURE DIVISION RETURNING PAR-OUT. - MOVE 4 TO PAR-OUT (1) - GOBACK. - END FUNCTION func. -_ATEOF - - -cat >prog4.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - FUNCTION-ID. func. - DATA DIVISION. - LINKAGE SECTION. - 01 PAR. - 02 PAR-OUT PIC 9. - PROCEDURE DIVISION RETURNING PAR-OUT. - MOVE 4 TO PAR-OUT - GOBACK. - END FUNCTION func. -_ATEOF - - -cat >prog5.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - FUNCTION-ID. func. - DATA DIVISION. - LINKAGE SECTION. - 01 PAR PIC 9. - PROCEDURE DIVISION USING PAR RETURNING PAR. - MOVE 4 TO PAR - GOBACK. - END FUNCTION func. - - IDENTIFICATION DIVISION. - FUNCTION-ID. func2. - DATA DIVISION. - LINKAGE SECTION. - 01 PAR-IN PIC 9. - 01 PAR-OUT REDEFINES PAR-IN PIC 9. - PROCEDURE DIVISION USING PAR-IN RETURNING PAR-OUT. - MOVE 4 TO PAR-OUT - GOBACK. - END FUNCTION func2. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/syn_definition.at:698: \$COMPILE_ONLY prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY prog.cob" "syn_definition.at:698" -( $at_check_trace; $COMPILE_ONLY prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/syn_definition.at:698" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/syn_definition.at:699: \$COMPILE_ONLY prog2.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY prog2.cob" "syn_definition.at:699" -( $at_check_trace; $COMPILE_ONLY prog2.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog2.cob:7: error: RETURNING item is not defined in LINKAGE SECTION -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/syn_definition.at:699" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/syn_definition.at:702: \$COMPILE_ONLY prog3.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY prog3.cob" "syn_definition.at:702" -( $at_check_trace; $COMPILE_ONLY prog3.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog3.cob:7: error: RETURNING item should not have OCCURS -prog3.cob:9: error: 'PAR-OUT' requires one subscript -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/syn_definition.at:702" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/syn_definition.at:706: \$COMPILE_ONLY prog4.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY prog4.cob" "syn_definition.at:706" -( $at_check_trace; $COMPILE_ONLY prog4.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog4.cob:8: error: RETURNING item must have level 01 -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/syn_definition.at:706" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/syn_definition.at:709: \$COMPILE_ONLY prog5.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY prog5.cob" "syn_definition.at:709" -( $at_check_trace; $COMPILE_ONLY prog5.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog5.cob:7: error: 'PAR' USING item duplicates RETURNING item -prog5.cob:18: error: 'PAR-OUT' REDEFINES field not allowed here -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/syn_definition.at:709" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_77 -#AT_START_78 -at_fn_group_banner 78 'syn_definition.at:717' \ - "Data item with same name as program-name" " " 2 -at_xfail=no -( - $as_echo "78. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - FUNCTION-ID. x. - DATA DIVISION. - LINKAGE SECTION. - 01 ret PIC 99. - PROCEDURE DIVISION RETURNING ret. - CONTINUE - . - END FUNCTION x. - - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 x PIC 999 VALUE 134. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/syn_definition.at:739: \$COMPILE_ONLY prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY prog.cob" "syn_definition.at:739" -( $at_check_trace; $COMPILE_ONLY prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/syn_definition.at:739" -$at_failed && at_fn_log_failure -$at_traceon; } - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_78 -#AT_START_79 -at_fn_group_banner 79 'syn_definition.at:744' \ - "Ambiguous reference to 02 items" " " 2 -at_xfail=no -( - $as_echo "79. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 G1. - 02 X PIC X. - 01 G2. - 02 X PIC X. - PROCEDURE DIVISION. - DISPLAY X - END-DISPLAY. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/syn_definition.at:762: \$COMPILE_ONLY prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY prog.cob" "syn_definition.at:762" -( $at_check_trace; $COMPILE_ONLY prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob:11: error: 'X' is ambiguous; needs qualification -prog.cob:7: error: 'X IN G1' defined here -prog.cob:9: error: 'X IN G2' defined here -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/syn_definition.at:762" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_79 -#AT_START_80 -at_fn_group_banner 80 'syn_definition.at:771' \ - "Ambiguous reference to 02 and 03 items" " " 2 -at_xfail=no -( - $as_echo "80. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 G. - 02 X. - 03 X PIC X. - PROCEDURE DIVISION. - DISPLAY X - END-DISPLAY. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/syn_definition.at:788: \$COMPILE_ONLY prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY prog.cob" "syn_definition.at:788" -( $at_check_trace; $COMPILE_ONLY prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob:10: error: 'X' is ambiguous; needs qualification -prog.cob:7: error: 'X IN G' defined here -prog.cob:8: error: 'X IN X IN G' defined here -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/syn_definition.at:788" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_80 -#AT_START_81 -at_fn_group_banner 81 'syn_definition.at:797' \ - "Ambiguous reference with qualification" " " 2 -at_xfail=no -( - $as_echo "81. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 G1. - 02 X. - 03 Y PIC X. - 01 G2. - 02 X. - 03 Y PIC X. - PROCEDURE DIVISION. - DISPLAY Y IN X - END-DISPLAY. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/syn_definition.at:817: \$COMPILE_ONLY prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY prog.cob" "syn_definition.at:817" -( $at_check_trace; $COMPILE_ONLY prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob:13: error: 'Y IN X' is ambiguous; needs qualification -prog.cob:8: error: 'Y IN X IN G1' defined here -prog.cob:11: error: 'Y IN X IN G2' defined here -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/syn_definition.at:817" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_81 -#AT_START_82 -at_fn_group_banner 82 'syn_definition.at:826' \ - "Unique reference with ambiguous qualifiers" " " 2 -at_xfail=no -( - $as_echo "82. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 G1. - 02 X. - 03 Y PIC X VALUE "Y". - 01 G2. - 02 X. - 03 Z PIC X VALUE "Z". - PROCEDURE DIVISION. - DISPLAY Z IN X NO ADVANCING - END-DISPLAY. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/syn_definition.at:846: \$COMPILE_ONLY prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY prog.cob" "syn_definition.at:846" -( $at_check_trace; $COMPILE_ONLY prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/syn_definition.at:846" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_82 -#AT_START_83 -at_fn_group_banner 83 'syn_definition.at:851' \ - "SYNCHRONIZED clause" " " 2 -at_xfail=no -( - $as_echo "83. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -# GC simply ignored RIGHT which is wrong according to ANSI/ISO; -# most dialects just skip this, but according to docs IBM handles it - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 77 CS-FULL PICTURE 9(4) COMPUTATIONAL SYNCHRONIZED. - 77 CS PIC 9(4) COMP SYNC. - 77 CSL PIC 9(4) COMP SYNC LEFT. - 77 CSR PIC 9(4) COMP SYNC RIGHT. - PROCEDURE DIVISION. - MOVE 1 TO CS-FULL, CS, CSL, CSR. - STOP RUN. -_ATEOF - - -# currently is: -{ set +x -$as_echo "$at_srcdir/syn_definition.at:872: \$COMPILE_ONLY prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY prog.cob" "syn_definition.at:872" -( $at_check_trace; $COMPILE_ONLY prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob:8: warning: SYNCHRONIZED LEFT/RIGHT is not implemented -prog.cob:9: warning: SYNCHRONIZED LEFT/RIGHT is not implemented -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/syn_definition.at:872" -$at_failed && at_fn_log_failure -$at_traceon; } - -#should be -#AT_CHECK([$COMPILE_ONLY prog.cob], [0], [], []) - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_83 -#AT_START_84 -at_fn_group_banner 84 'syn_definition.at:893' \ - "Undefined procedure name" " " 2 -at_xfail=no -( - $as_echo "84. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - PROCEDURE DIVISION. - GO TO END-OF-PROGRAM. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/syn_definition.at:904: \$COMPILE_ONLY prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY prog.cob" "syn_definition.at:904" -( $at_check_trace; $COMPILE_ONLY prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob:5: error: 'END-OF-PROGRAM' is not defined -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/syn_definition.at:904" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_84 -#AT_START_85 -at_fn_group_banner 85 'syn_definition.at:913' \ - "Redefinition of section names" " " 2 -at_xfail=no -( - $as_echo "85. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - PROCEDURE DIVISION. - L SECTION. - L SECTION. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/syn_definition.at:925: \$COMPILE_ONLY prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY prog.cob" "syn_definition.at:925" -( $at_check_trace; $COMPILE_ONLY prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob: in section 'L': -prog.cob:6: error: redefinition of 'L' -prog.cob:5: error: 'L' previously defined here -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/syn_definition.at:925" -$at_failed && at_fn_log_failure -$at_traceon; } - - -# FIXME: as long as there is no direct reference to the section -# this should be not more than a warning, -# maybe depending on a compiler configuration - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_85 -#AT_START_86 -at_fn_group_banner 86 'syn_definition.at:938' \ - "Redefinition of section and paragraph names" " " 2 -at_xfail=no -( - $as_echo "86. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - PROCEDURE DIVISION. - L SECTION. - L. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/syn_definition.at:950: \$COMPILE_ONLY prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY prog.cob" "syn_definition.at:950" -( $at_check_trace; $COMPILE_ONLY prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob: in section 'L': -prog.cob:6: error: redefinition of 'L' -prog.cob:5: error: 'L' previously defined here -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/syn_definition.at:950" -$at_failed && at_fn_log_failure -$at_traceon; } - - -# FIXME: as long as there is no direct reference to -# the paragraph/section this should be not more -# than a warning, maybe depending on a compiler -# configuration - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_86 -#AT_START_87 -at_fn_group_banner 87 'syn_definition.at:964' \ - "Redefinition of label and variable names" " " 2 -at_xfail=yes -( - $as_echo "87. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -# currently failing, see FR #260 - - -cat >prog.cob <<'_ATEOF' - - identification division. - program-id. WORD. - data division. - working-storage section. - *----------------------------------------------------------------- - 77 word pic 9. - *----------------------------------------------------------------- - PROCEDURE DIVISION. - main section. - * - move 0 to word - perform word - * - stop run returning word. - *----------------------------------------------------------------- - word section. - add 1 to word. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/syn_definition.at:990: \$COMPILE_ONLY -std=cobol2014 prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY -std=cobol2014 prog.cob" "syn_definition.at:990" -( $at_check_trace; $COMPILE_ONLY -std=cobol2014 prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob: in section 'main': -prog.cob:17: error: user-defined word re-used with different type does not conform to COBOL 2014 -prog.cob:17: error: redefinition of 'word' as label-name -prog.cob:7: error: 'word' previously defined here as data-name -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/syn_definition.at:990" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/syn_definition.at:996: \$COMPILE_ONLY prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY prog.cob" "syn_definition.at:996" -( $at_check_trace; $COMPILE_ONLY prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/syn_definition.at:996" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_87 -#AT_START_88 -at_fn_group_banner 88 'syn_definition.at:1001' \ - "Redefinition of paragraph names" " " 2 -at_xfail=no -( - $as_echo "88. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - PROCEDURE DIVISION. - L. - L. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/syn_definition.at:1013: \$COMPILE_ONLY prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY prog.cob" "syn_definition.at:1013" -( $at_check_trace; $COMPILE_ONLY prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/syn_definition.at:1013" -$at_failed && at_fn_log_failure -$at_traceon; } - - -## Change when we DON'T allow this (likely as a warning, -## depending on compiler configuration) -## AT_CHECK([$COMPILE_ONLY prog.cob], [1], [], -## [prog.cob: in paragraph 'L': -## prog.cob:6: error: redefinition of 'L' -## prog.cob:5: error: 'L' previously defined here -## ]) - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_88 -#AT_START_89 -at_fn_group_banner 89 'syn_definition.at:1027' \ - "Ambiguous reference to paragraph name" " " 2 -at_xfail=no -( - $as_echo "89. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - PROCEDURE DIVISION. - S-1 SECTION. - L. - S-2 SECTION. - L. - S-3 SECTION. - GO TO L. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/syn_definition.at:1043: \$COMPILE_ONLY prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY prog.cob" "syn_definition.at:1043" -( $at_check_trace; $COMPILE_ONLY prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob: in section 'S-3': -prog.cob:10: error: 'L' is ambiguous; needs qualification -prog.cob:6: error: 'L IN S-1' defined here -prog.cob:8: error: 'L IN S-2' defined here -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/syn_definition.at:1043" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_89 -#AT_START_90 -at_fn_group_banner 90 'syn_definition.at:1053' \ - "Non-matching level numbers (extension)" " " 2 -at_xfail=no -( - $as_echo "90. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 A. - 05 B. - 10 C PIC X. - 04 D. - 05 E PIC X. - PROCEDURE DIVISION. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/syn_definition.at:1070: \$COMPILE_ONLY -frelax-level-hierarchy prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY -frelax-level-hierarchy prog.cob" "syn_definition.at:1070" -( $at_check_trace; $COMPILE_ONLY -frelax-level-hierarchy prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob:9: warning: no previous data item of level 04 -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/syn_definition.at:1070" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_90 -#AT_START_91 -at_fn_group_banner 91 'syn_definition.at:1077' \ - "CALL BY VALUE alphanumeric item (extension)" " " 2 -at_xfail=no -( - $as_echo "91. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 X PIC X(4). - PROCEDURE DIVISION. - CALL "PROG2" USING BY VALUE X - END-CALL. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/syn_definition.at:1092: \$COMPILE_ONLY prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY prog.cob" "syn_definition.at:1092" -( $at_check_trace; $COMPILE_ONLY prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob:8: warning: BY CONTENT assumed for alphanumeric item 'X' -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/syn_definition.at:1092" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_91 -#AT_START_92 -at_fn_group_banner 92 'syn_definition.at:1099' \ - "CALL BY VALUE national item (extension)" " " 2 -at_xfail=no -( - $as_echo "92. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 N PIC N(4). - PROCEDURE DIVISION. - CALL "PROG2" USING BY VALUE N - END-CALL. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/syn_definition.at:1114: \$COMPILE_ONLY prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY prog.cob" "syn_definition.at:1114" -( $at_check_trace; $COMPILE_ONLY prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob:6: warning: handling of USAGE NATIONAL is unfinished; implementation is likely to be changed -prog.cob:8: warning: BY CONTENT assumed for national item 'N' -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/syn_definition.at:1114" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_92 -#AT_START_93 -at_fn_group_banner 93 'syn_definition.at:1122' \ - "CALL BY VALUE figurative constants" " " 2 -at_xfail=no -( - $as_echo "93. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - PROCEDURE DIVISION. - CALL "PROG2" USING BY VALUE - low-value - high-value - space - quote - zero - END-CALL. - CALL "PROG2" USING - low-value - high-value - space - quote - zero - END-CALL. - CALL "PROG3" USING - null - END-CALL. - STOP RUN. -_ATEOF - - -# FIXME: should raise an error with -std=cobolNNNN, no warning with -std=default -# --> revise after rw-merge -{ set +x -$as_echo "$at_srcdir/syn_definition.at:1151: \$COMPILE_ONLY -w prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY -w prog.cob" "syn_definition.at:1151" -( $at_check_trace; $COMPILE_ONLY -w prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/syn_definition.at:1151" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_93 -#AT_START_94 -at_fn_group_banner 94 'syn_definition.at:1156' \ - "Duplicate identification division header" " " 2 -at_xfail=no -( - $as_echo "94. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/syn_definition.at:1165: \$COMPILE_ONLY prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY prog.cob" "syn_definition.at:1165" -( $at_check_trace; $COMPILE_ONLY prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob:3: error: syntax error, unexpected IDENTIFICATION, expecting FUNCTION-ID or PROGRAM-ID -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/syn_definition.at:1165" -$at_failed && at_fn_log_failure -$at_traceon; } - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_94 -#AT_START_95 -at_fn_group_banner 95 'syn_definition.at:1171' \ - "RETURNING in STOP RUN / GOBACK / EXIT PROGRAM" " " 2 -at_xfail=no -( - $as_echo "95. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog1.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog1. - PROCEDURE DIVISION. - EXIT PROGRAM RETURNING -1. -_ATEOF - - -cat >prog2.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog2. - PROCEDURE DIVISION. - GOBACK GIVING 2. -_ATEOF - - -cat >prog3.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog3. - PROCEDURE DIVISION. - STOP RUN GIVING 0. -_ATEOF - - -cat >prog4.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog4. - PROCEDURE DIVISION. - MOVE 42 TO RETURN-CODE - GOBACK. -_ATEOF - - -cat >prog5.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog5. - PROCEDURE DIVISION. - GOBACK. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/syn_definition.at:1210: \$COMPILE prog1.cob prog2.cob prog3.cob prog4.cob prog5.cob" -at_fn_check_prepare_dynamic "$COMPILE prog1.cob prog2.cob prog3.cob prog4.cob prog5.cob" "syn_definition.at:1210" -( $at_check_trace; $COMPILE prog1.cob prog2.cob prog3.cob prog4.cob prog5.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/syn_definition.at:1210" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/syn_definition.at:1212: \$COMPILE -fnot-register=return-code \\ -prog1.cob prog2.cob prog3.cob prog4.cob prog5.cob" -at_fn_check_prepare_notrace 'an embedded newline' "syn_definition.at:1212" -( $at_check_trace; $COMPILE -fnot-register=return-code \ -prog1.cob prog2.cob prog3.cob prog4.cob prog5.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog1.cob:5: error: RETURNING/GIVING not allowed for non-returning runtime elements -prog2.cob:5: error: RETURNING/GIVING not allowed for non-returning runtime elements -prog4.cob:5: error: 'RETURN-CODE' is not defined -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/syn_definition.at:1212" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_95 -#AT_START_96 -at_fn_group_banner 96 'syn_definition.at:1222' \ - "Invalid ENVIRONMENT DIVISION order" " " 2 -at_xfail=no -( - $as_echo "96. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - - ENVIRONMENT DIVISION. - CONFIGURATION SECTION. - SPECIAL-NAMES. - CONSOLE IS CRT - . - SPECIAL-NAMES. - DECIMAL-POINT IS COMMA - . - SOURCE-COMPUTER. a-computer. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/syn_definition.at:1240: \$COMPILE_ONLY -fincorrect-conf-sec-order=error prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY -fincorrect-conf-sec-order=error prog.cob" "syn_definition.at:1240" -( $at_check_trace; $COMPILE_ONLY -fincorrect-conf-sec-order=error prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob:10: error: duplicate SPECIAL-NAMES -prog.cob:13: error: SOURCE-COMPUTER incorrectly after SPECIAL-NAMES used -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/syn_definition.at:1240" -$at_failed && at_fn_log_failure -$at_traceon; } - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_96 -#AT_START_97 -at_fn_group_banner 97 'syn_definition.at:1247' \ - "Function without END FUNCTION" " " 2 -at_xfail=no -( - $as_echo "97. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - FUNCTION-ID. func. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/syn_definition.at:1255: \$COMPILE_ONLY prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY prog.cob" "syn_definition.at:1255" -( $at_check_trace; $COMPILE_ONLY prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob:4: error: syntax error, unexpected end of file, expecting END FUNCTION -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/syn_definition.at:1255" -$at_failed && at_fn_log_failure -$at_traceon; } - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_97 -#AT_START_98 -at_fn_group_banner 98 'syn_definition.at:1261' \ - "Nested programs without END PROGRAM" " " 2 -at_xfail=no -( - $as_echo "98. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - PROCEDURE DIVISION. - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog-2. - PROCEDURE DIVISION. - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog-3. - - END PROGRAM prog. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/syn_definition.at:1279: \$COMPILE_ONLY prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY prog.cob" "syn_definition.at:1279" -( $at_check_trace; $COMPILE_ONLY prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/syn_definition.at:1279" -$at_failed && at_fn_log_failure -$at_traceon; } - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_98 -#AT_START_99 -at_fn_group_banner 99 'syn_definition.at:1283' \ - "Nested programs not in procedure division" " " 2 -at_xfail=no -( - $as_echo "99. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog-2. - - END PROGRAM prog. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/syn_definition.at:1296: \$COMPILE_ONLY prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY prog.cob" "syn_definition.at:1296" -( $at_check_trace; $COMPILE_ONLY prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob:5: error: PROCEDURE DIVISION header missing -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/syn_definition.at:1296" -$at_failed && at_fn_log_failure -$at_traceon; } - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_99 -#AT_START_100 -at_fn_group_banner 100 'syn_definition.at:1302' \ - "Screen section starts with 78-level" " " 2 -at_xfail=no -( - $as_echo "100. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - - DATA DIVISION. - SCREEN SECTION. - 78 const VALUE "x". -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/syn_definition.at:1314: \$COMPILE_ONLY prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY prog.cob" "syn_definition.at:1314" -( $at_check_trace; $COMPILE_ONLY prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/syn_definition.at:1314" -$at_failed && at_fn_log_failure -$at_traceon; } - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_100 -#AT_START_101 -at_fn_group_banner 101 'syn_definition.at:1318' \ - "Invalid PICTURE strings" " " 2 -at_xfail=no -( - $as_echo "101. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 empty-pic PIC. - 01 too-long-pic PIC XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX - -XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX. - 01 too-long-pic2 PIC XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX - -XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX - -XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX - -XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX - -XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX. - 01 multiple-symbols. - 03 PIC 9CRCR. - 03 PIC 9DBDB. - 03 PIC SS99S. - 03 PIC 99..9. - 03 PIC 99VV9. - 03 PIC +$99+. - 03 PIC $+99$-. - 01 non-symbols. - 03 PIC 9K. - 03 PIC 999C. - 03 PIC 999D. - 01 too-many-digits PIC 9(50). - 01 too-long-number-in-parens PIC 9(11111111111111). - 01 nested-parens PIC 9((100)). - 01 unbalanced-parens PIC 9(. - 01 multiple-pairs-of-parens PIC 9(5)(3). - 01 no-digit-in-parens PIC 9(). - 01 mutually-exclusive-symbols. - 03 PIC P(3)9.9. - 03 PIC 9V.9. - 03 PIC Z*. - 03 PIC +(5)--. - 03 PIC $(4)Z(9). - 03 PIC $$B*(4). - 03 PIC NX. - 03 PIC AN. - 03 PIC AZ(3). - 03 PIC 99.99XXXXX. - 03 PIC SA. - 03 PIC $$$B+++B---. - 03 PIC +++9+. - 03 PIC +9(5)CR. - 03 PIC -9(5)DB. - 01 non-rightmost-leftmost-symbols. - 03 PIC BBB+BB99. - 03 PIC 99-B. - 03 PIC 9CRB. - 03 PIC DB9(5). - 03 PIC 99$$$. - 03 PIC 99$B. - 03 PIC 0$99. - 03 PIC PPPVP9. - 01 missing-symbols. - 03 PIC B(5). - 03 PIC +. - 03 PIC $. - - 01 str-constant CONSTANT "hello". - 01 float-constant CONSTANT 1.0. - 01 signed-constant CONSTANT -1. - 01 invalid-constant. - 03 PIC X(str-constant). - 03 PIC X(float-constant). - 03 PIC X(signed-constant). - 03 PIC X(unseen-constant). - - 01 integer-constant CONSTANT 5. - 01 valid-pics. - 03 PIC VP9B. - 03 PIC B9P(3). - 03 PIC B$$$. - 03 PIC 0000+B0+++0B,+. - 03 PIC +(5)P(3). - 03 PIC ++.++. - 03 PIC $(integer-constant). - 03 PIC $$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$ - -(integer-constant). *> CHECKME: should this be really valid? - - - 01 PC-COLOR-BACKGROUND-TABLE. - 05 BIT-BACKGROUND-BLACK PIC 1(8) BIT VALUE B"00000000". - 05 BIT-BACKGROUND-BLUE PIC 1(8) BIT VALUE B"00010000". - 05 BIT-BACKGROUND-GREEN PIC 1(8) BIT VALUE B"00100000". - 05 BIT-BACKGROUND-CYAN PIC 1(8) BIT VALUE B"00110000". - 05 BIT-BACKGROUND-RED PIC 1(8) BIT VALUE B"01000000". - 05 BIT-BACKGROUND-MAGENTA PIC 1(8) BIT VALUE B"01010000". - 05 BIT-BACKGROUND-BROWN PIC 1(8) BIT VALUE B"01100000". - 05 BIT-BACKGROUND-LIGHT-GRAY PIC 1(8) BIT VALUE B"01110000". - 01 FILLER REDEFINES PC-COLOR-BACKGROUND-TABLE. - 05 COLOR-BACKGROUND - OCCURS 8 TIMES PIC 1(8) BIT. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/syn_definition.at:1419: \$COMPILE_ONLY -std=cobol2014 prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY -std=cobol2014 prog.cob" "syn_definition.at:1419" -( $at_check_trace; $COMPILE_ONLY -std=cobol2014 prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob:9: warning: continuation of COBOL words is archaic in COBOL 2014 -prog.cob:11: warning: continuation of COBOL words is archaic in COBOL 2014 -prog.cob:12: warning: continuation of COBOL words is archaic in COBOL 2014 -prog.cob:13: warning: continuation of COBOL words is archaic in COBOL 2014 -prog.cob:14: warning: continuation of COBOL words is archaic in COBOL 2014 -prog.cob:82: warning: continuation of COBOL words is archaic in COBOL 2014 -prog.cob:7: error: missing PICTURE string -prog.cob:8: error: PICTURE string may not contain more than 63 characters; contains 76 characters -prog.cob:10: error: PICTURE string may not contain more than 63 characters; contains 301 characters -prog.cob:16: error: CR or DB may only occur once in a PICTURE string -prog.cob:17: error: CR or DB may only occur once in a PICTURE string -prog.cob:18: error: S may only occur once in a PICTURE string -prog.cob:18: error: S must be at start of PICTURE string -prog.cob:19: error: . may only occur once in a PICTURE string -prog.cob:20: error: V may only occur once in a PICTURE string -prog.cob:21: error: a trailing +/- sign cannot follow a leading +/- sign -prog.cob:22: error: a leading +/- sign cannot follow a leading currency symbol -prog.cob:22: error: a trailing currency symbol cannot follow a leading currency symbol -prog.cob:22: error: a trailing +/- sign cannot follow a leading +/- sign -prog.cob:24: error: invalid PICTURE character 'K' -prog.cob:25: error: C must be followed by R -prog.cob:26: error: D must be followed by B -prog.cob:27: error: numeric field cannot be larger than 38 digits -prog.cob:28: error: only up to 9 significant digits are permitted within parentheses -prog.cob:29: error: parentheses must be preceded by a picture symbol -prog.cob:30: error: unbalanced parentheses -prog.cob:31: error: parentheses must be preceded by a picture symbol -prog.cob:32: error: parentheses must contain an unsigned integer -prog.cob:34: error: . cannot follow a P which is after the decimal point -prog.cob:35: error: . cannot follow V -prog.cob:36: error: cannot have both Z and * in PICTURE string -prog.cob:37: error: a trailing +/- sign cannot follow a floating +/- string which is before the decimal point -prog.cob:37: error: a trailing +/- sign may only occur once in a PICTURE string -prog.cob:38: error: a Z or * which is before the decimal point cannot follow a floating currency symbol string which is before the decimal point -prog.cob:39: error: a Z or * which is before the decimal point cannot follow a floating currency symbol string which is before the decimal point -prog.cob:40: warning: handling of USAGE NATIONAL is unfinished; implementation is likely to be changed -prog.cob:40: error: A or X cannot follow N -prog.cob:41: warning: handling of USAGE NATIONAL is unfinished; implementation is likely to be changed -prog.cob:41: error: N cannot follow A or X -prog.cob:42: error: a Z or * which is before the decimal point cannot follow A or X -prog.cob:43: error: A or X cannot follow . -prog.cob:44: error: A or X cannot follow S -prog.cob:45: error: a leading +/- sign cannot follow B, 0 or / -prog.cob:45: error: a leading +/- sign cannot follow a floating currency symbol string which is before the decimal point -prog.cob:45: error: a leading +/- sign may only occur once in a PICTURE string -prog.cob:45: error: a trailing +/- sign cannot follow a leading +/- sign -prog.cob:45: error: a trailing +/- sign may only occur once in a PICTURE string -prog.cob:46: error: a trailing +/- sign cannot follow a floating +/- string which is before the decimal point -prog.cob:47: error: CR or DB cannot follow a leading +/- sign -prog.cob:48: error: CR or DB cannot follow a leading +/- sign -prog.cob:50: error: a leading +/- sign cannot follow B, 0 or / -prog.cob:51: error: a leading +/- sign cannot follow 9 -prog.cob:52: error: B, 0 or / cannot follow CR or DB -prog.cob:53: error: 9 cannot follow CR or DB -prog.cob:54: error: a floating currency symbol string which is before the decimal point cannot follow 9 -prog.cob:55: error: a leading currency symbol cannot follow 9 -prog.cob:56: error: a leading currency symbol cannot follow B, 0 or / -prog.cob:57: error: P must be at start or end of PICTURE string -prog.cob:57: error: V cannot follow a P which is after the decimal point -prog.cob:59: error: PICTURE string must contain at least one of the set A, N, X, Z, 1, 9 and *; or at least two of the set +, - and the currency symbol -prog.cob:60: error: PICTURE string must contain at least one of the set A, N, X, Z, 1, 9 and *; or at least two of the set +, - and the currency symbol -prog.cob:61: error: PICTURE string must contain at least one of the set A, N, X, Z, 1, 9 and *; or at least two of the set +, - and the currency symbol -prog.cob:67: error: 'STR-CONSTANT' is not a numeric literal -prog.cob:68: error: 'FLOAT-CONSTANT' is not an integer -prog.cob:69: error: 'SIGNED-CONSTANT' is not unsigned -prog.cob:70: error: 'UNSEEN-CONSTANT' is not defined -prog.cob:81: warning: uncommon parentheses -prog.cob:86: warning: USAGE BIT is not implemented -prog.cob:87: warning: USAGE BIT is not implemented -prog.cob:88: warning: USAGE BIT is not implemented -prog.cob:89: warning: USAGE BIT is not implemented -prog.cob:90: warning: USAGE BIT is not implemented -prog.cob:91: warning: USAGE BIT is not implemented -prog.cob:92: warning: USAGE BIT is not implemented -prog.cob:93: warning: USAGE BIT is not implemented -prog.cob:96: warning: USAGE BIT is not implemented -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/syn_definition.at:1419" -$at_failed && at_fn_log_failure -$at_traceon; } - - -{ set +x -$as_echo "$at_srcdir/syn_definition.at:1498: \$COMPILE_ONLY prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY prog.cob" "syn_definition.at:1498" -( $at_check_trace; $COMPILE_ONLY prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob:9: warning: continuation of COBOL words used -prog.cob:11: warning: continuation of COBOL words used -prog.cob:12: warning: continuation of COBOL words used -prog.cob:13: warning: continuation of COBOL words used -prog.cob:14: warning: continuation of COBOL words used -prog.cob:82: warning: continuation of COBOL words used -prog.cob:7: error: missing PICTURE string -prog.cob:10: error: PICTURE string may not contain more than 255 characters; contains 301 characters -prog.cob:16: error: CR or DB may only occur once in a PICTURE string -prog.cob:17: error: CR or DB may only occur once in a PICTURE string -prog.cob:18: error: S may only occur once in a PICTURE string -prog.cob:18: error: S must be at start of PICTURE string -prog.cob:19: error: . may only occur once in a PICTURE string -prog.cob:20: error: V may only occur once in a PICTURE string -prog.cob:21: error: a trailing +/- sign cannot follow a leading +/- sign -prog.cob:22: error: a leading +/- sign cannot follow a leading currency symbol -prog.cob:22: error: a trailing currency symbol cannot follow a leading currency symbol -prog.cob:22: error: a trailing +/- sign cannot follow a leading +/- sign -prog.cob:24: error: invalid PICTURE character 'K' -prog.cob:25: error: C must be followed by R -prog.cob:26: error: D must be followed by B -prog.cob:27: error: numeric field cannot be larger than 38 digits -prog.cob:28: error: only up to 9 significant digits are permitted within parentheses -prog.cob:29: error: parentheses must be preceded by a picture symbol -prog.cob:30: error: unbalanced parentheses -prog.cob:31: error: parentheses must be preceded by a picture symbol -prog.cob:32: error: parentheses must contain an unsigned integer -prog.cob:34: error: . cannot follow a P which is after the decimal point -prog.cob:35: error: . cannot follow V -prog.cob:36: error: cannot have both Z and * in PICTURE string -prog.cob:37: error: a trailing +/- sign cannot follow a floating +/- string which is before the decimal point -prog.cob:37: error: a trailing +/- sign may only occur once in a PICTURE string -prog.cob:38: error: a Z or * which is before the decimal point cannot follow a floating currency symbol string which is before the decimal point -prog.cob:39: error: a Z or * which is before the decimal point cannot follow a floating currency symbol string which is before the decimal point -prog.cob:40: warning: handling of USAGE NATIONAL is unfinished; implementation is likely to be changed -prog.cob:40: error: A or X cannot follow N -prog.cob:41: warning: handling of USAGE NATIONAL is unfinished; implementation is likely to be changed -prog.cob:41: error: N cannot follow A or X -prog.cob:42: error: a Z or * which is before the decimal point cannot follow A or X -prog.cob:43: error: A or X cannot follow . -prog.cob:44: error: A or X cannot follow S -prog.cob:45: error: a leading +/- sign cannot follow B, 0 or / -prog.cob:45: error: a leading +/- sign cannot follow a floating currency symbol string which is before the decimal point -prog.cob:45: error: a leading +/- sign may only occur once in a PICTURE string -prog.cob:45: error: a trailing +/- sign cannot follow a leading +/- sign -prog.cob:45: error: a trailing +/- sign may only occur once in a PICTURE string -prog.cob:46: error: a trailing +/- sign cannot follow a floating +/- string which is before the decimal point -prog.cob:47: error: CR or DB cannot follow a leading +/- sign -prog.cob:48: error: CR or DB cannot follow a leading +/- sign -prog.cob:50: error: a leading +/- sign cannot follow B, 0 or / -prog.cob:51: error: a leading +/- sign cannot follow 9 -prog.cob:52: error: B, 0 or / cannot follow CR or DB -prog.cob:53: error: 9 cannot follow CR or DB -prog.cob:54: error: a floating currency symbol string which is before the decimal point cannot follow 9 -prog.cob:55: error: a leading currency symbol cannot follow 9 -prog.cob:56: error: a leading currency symbol cannot follow B, 0 or / -prog.cob:57: error: P must be at start or end of PICTURE string -prog.cob:57: error: V cannot follow a P which is after the decimal point -prog.cob:59: error: PICTURE string must contain at least one of the set A, N, X, Z, 1, 9 and *; or at least two of the set +, - and the currency symbol -prog.cob:60: error: PICTURE string must contain at least one of the set A, N, X, Z, 1, 9 and *; or at least two of the set +, - and the currency symbol -prog.cob:61: error: PICTURE string must contain at least one of the set A, N, X, Z, 1, 9 and *; or at least two of the set +, - and the currency symbol -prog.cob:67: error: 'STR-CONSTANT' is not a numeric literal -prog.cob:68: error: 'FLOAT-CONSTANT' is not an integer -prog.cob:69: error: 'SIGNED-CONSTANT' is not unsigned -prog.cob:70: error: 'UNSEEN-CONSTANT' is not defined -prog.cob:81: warning: uncommon parentheses -prog.cob:86: warning: USAGE BIT is not implemented -prog.cob:87: warning: USAGE BIT is not implemented -prog.cob:88: warning: USAGE BIT is not implemented -prog.cob:89: warning: USAGE BIT is not implemented -prog.cob:90: warning: USAGE BIT is not implemented -prog.cob:91: warning: USAGE BIT is not implemented -prog.cob:92: warning: USAGE BIT is not implemented -prog.cob:93: warning: USAGE BIT is not implemented -prog.cob:96: warning: USAGE BIT is not implemented -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/syn_definition.at:1498" -$at_failed && at_fn_log_failure -$at_traceon; } - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_101 -#AT_START_102 -at_fn_group_banner 102 'syn_definition.at:1578' \ - "PICTURE strings invalid with BLANK WHEN ZERO" " " 2 -at_xfail=no -( - $as_echo "102. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 x PIC S9(5) BLANK ZERO. - 01 y PIC *(5) BLANK ZERO. - - *> Actually valid - 01 z PIC -9(5) BLANK ZERO. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/syn_definition.at:1594: \$COMPILE_ONLY prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY prog.cob" "syn_definition.at:1594" -( $at_check_trace; $COMPILE_ONLY prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob:7: error: 'x' cannot have S in PICTURE string and BLANK WHEN ZERO -prog.cob:8: error: 'y' cannot have * in PICTURE string and BLANK WHEN ZERO -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/syn_definition.at:1594" -$at_failed && at_fn_log_failure -$at_traceon; } - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_102 -#AT_START_103 -at_fn_group_banner 103 'syn_definition.at:1601' \ - "PICTURE strings invalid with USAGE" " " 2 -at_xfail=no -( - $as_echo "103. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 x PIC XXX, COMP-6. - 01 y PIC +999, PACKED-DECIMAL. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/syn_definition.at:1614: \$COMPILE_ONLY prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY prog.cob" "syn_definition.at:1614" -( $at_check_trace; $COMPILE_ONLY prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob:7: error: PICTURE clause not compatible with USAGE COMP-6 -prog.cob:8: error: PICTURE clause not compatible with USAGE COMP-3 -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/syn_definition.at:1614" -$at_failed && at_fn_log_failure -$at_traceon; } - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_103 -#AT_START_104 -at_fn_group_banner 104 'syn_definition.at:1621' \ - "ALPHABET definition" " " 2 -at_xfail=no -( - $as_echo "104. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - CONFIGURATION SECTION. - SPECIAL-NAMES. - ALPHABET TESTME IS - 'A' THROUGH 'Z', x'00' thru x'05'; - x'41' ALSO x'42', ALSO x'00', x'C1' ALSO x'C2'. - ALPHABET FINE - 'A' also 'B' also 'C' also 'd' also 'e' ALSO 'f', - 'g' also 'G', '1' thru '9', x'00'. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/syn_definition.at:1638: \$COMPILE_ONLY prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY prog.cob" "syn_definition.at:1638" -( $at_check_trace; $COMPILE_ONLY prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob:7: error: duplicate character values in alphabet 'TESTME': x'00', A, B -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/syn_definition.at:1638" -$at_failed && at_fn_log_failure -$at_traceon; } - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_104 -#AT_START_105 -at_fn_group_banner 105 'syn_definition.at:1644' \ - "PROGRAM COLLATING SEQUENCE" " " 2 -at_xfail=no -( - $as_echo "105. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -# check that a reference on the bad alphabet does not break cobc -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - CONFIGURATION SECTION. - SOURCE-COMPUTER. GNU-LINUX. - OBJECT-COMPUTER. GC-MACHINE, - PROGRAM COLLATING SEQUENCE IS TESTME. - SPECIAL-NAMES. - ALPHABET TESTME IS - x'00' thru x'05', 'A' THROUGH 'Z'; - x'41' ALSO x'42', ALSO x'00', x'C1' ALSO x'C2'. -_ATEOF - - -cat >prog2.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog2. - ENVIRONMENT DIVISION. - CONFIGURATION SECTION. - SOURCE-COMPUTER. GNU-LINUX. - OBJECT-COMPUTER. GC-MACHINE, - PROGRAM COLLATING SEQUENCE IS TESTNO. -_ATEOF - - -cat >prog3.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog3. - ENVIRONMENT DIVISION. - CONFIGURATION SECTION. - SOURCE-COMPUTER. GNU-LINUX. - OBJECT-COMPUTER. GC-MACHINE, - PROGRAM COLLATING SEQUENCE IS ALPHABET-1, - ALPHABET-2. - SPECIAL-NAMES. - ALPHABET ALPHABET-1 IS - 'A' THROUGH 'Z', x'00' thru x'05'. - ALPHABET ALPHABET-2 - n'A' also n'B' ALSO n'f', - n'g' also n'G', n'1' thru n'9'. - END PROGRAM prog3. - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog3b. - ENVIRONMENT DIVISION. - CONFIGURATION SECTION. - SOURCE-COMPUTER. GNU-LINUX. - OBJECT-COMPUTER. GC-MACHINE, - PROGRAM SEQUENCE IS ALPHABET-1, - ALPHABET-2. - SPECIAL-NAMES. - ALPHABET ALPHABET-1 IS - 'A' THROUGH 'Z', x'00' thru x'05'. - ALPHABET ALPHABET-2 IS - n'A' ALSO n'f', - n'g' also n'G'. - END PROGRAM prog3b. - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog3c. - ENVIRONMENT DIVISION. - CONFIGURATION SECTION. - SOURCE-COMPUTER. GNU-LINUX. - OBJECT-COMPUTER. GC-MACHINE, SEQUENCE ALPHABET-1, ALPHABET-2. - SPECIAL-NAMES. - ALPHABET ALPHABET-1 x'00' thru x'05'. - ALPHABET ALPHABET-2 IS n'g' also n'G', n'1' thru n'9'. - END PROGRAM prog3c. - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog3d. - ENVIRONMENT DIVISION. - CONFIGURATION SECTION. - SOURCE-COMPUTER. GNU-LINUX. - OBJECT-COMPUTER. GC-MACHINE, SEQUENCE ALPHABET-1, ALPHABET-2. - SPECIAL-NAMES. - ALPHABET ALPHABET-1 IS 'A' THROUGH 'Z'. - ALPHABET ALPHABET-2 n'A' also n'B', n'1' thru n'9'. - END PROGRAM prog3d. - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog3e. - ENVIRONMENT DIVISION. - CONFIGURATION SECTION. - SOURCE-COMPUTER. GNU-LINUX. - OBJECT-COMPUTER. GC-MACHINE, SEQUENCE ALPHABET-1. - SPECIAL-NAMES. - ALPHABET ALPHABET-1 IS 'Z', x'00'. - END PROGRAM prog3e. - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog3f. - ENVIRONMENT DIVISION. - CONFIGURATION SECTION. - SOURCE-COMPUTER. GNU-LINUX. - OBJECT-COMPUTER. GC-MACHINE, - COLLATING SEQUENCE - FOR ALPHANUMERIC IS ALPHABET-1. - SPECIAL-NAMES. - ALPHABET ALPHABET-1 IS - 'A' THROUGH 'Z', x'00', x'05'. - END PROGRAM prog3f. - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog3g. - ENVIRONMENT DIVISION. - CONFIGURATION SECTION. - SOURCE-COMPUTER. GNU-LINUX. - OBJECT-COMPUTER. GC-MACHINE, - SEQUENCE ALPHANUMERIC ALPHABET-1. - SPECIAL-NAMES. - ALPHABET ALPHABET-1 IS - 'A' THROUGH 'D'. - END PROGRAM prog3g. - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog3h. - ENVIRONMENT DIVISION. - CONFIGURATION SECTION. - SOURCE-COMPUTER. GNU-LINUX. - OBJECT-COMPUTER. GC-MACHINE, - COLLATING SEQUENCE - FOR ALPHANUMERIC IS ALPHABET-1 - NATIONAL IS ALPHABET-2. - SPECIAL-NAMES. - ALPHABET ALPHABET-1 IS - 'A', 'C', x'05'. - ALPHABET ALPHABET-2 - n'A', n'1' thru n'9'. - END PROGRAM prog3h. - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog3i. - ENVIRONMENT DIVISION. - CONFIGURATION SECTION. - SOURCE-COMPUTER. GNU-LINUX. - OBJECT-COMPUTER. GC-MACHINE, - COLLATING SEQUENCE - NATIONAL ALPHABET-2 - ALPHANUMERIC ALPHABET-1. - SPECIAL-NAMES. - ALPHABET ALPHABET-1 IS - 'a' THROUGH 'z'. - ALPHABET ALPHABET-2 - n'B', n'C'; n'g' also n'G'. - END PROGRAM prog3i. - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog3j. - ENVIRONMENT DIVISION. - CONFIGURATION SECTION. - SOURCE-COMPUTER. GNU-LINUX. - OBJECT-COMPUTER. GC-MACHINE, - COLLATING SEQUENCE - NATIONAL ALPHABET-2. - SPECIAL-NAMES. - ALPHABET ALPHABET-2 - n'B', n'C'; n'g' also n'G'. - END PROGRAM prog3j. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/syn_definition.at:1808: \$COMPILE_ONLY prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY prog.cob" "syn_definition.at:1808" -( $at_check_trace; $COMPILE_ONLY prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob:10: error: duplicate character values in alphabet 'TESTME': x'00', A, B -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/syn_definition.at:1808" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/syn_definition.at:1811: \$COMPILE_ONLY prog2.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY prog2.cob" "syn_definition.at:1811" -( $at_check_trace; $COMPILE_ONLY prog2.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog2.cob:8: error: 'TESTNO' is not defined -prog2.cob:8: error: 'TESTNO' is not an alphabet name -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/syn_definition.at:1811" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/syn_definition.at:1815: \$COMPILE_ONLY -Wno-unfinished prog3.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY -Wno-unfinished prog3.cob" "syn_definition.at:1815" -( $at_check_trace; $COMPILE_ONLY -Wno-unfinished prog3.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog3.cob:9: warning: NATIONAL COLLATING SEQUENCE is not implemented -prog3.cob:25: warning: NATIONAL COLLATING SEQUENCE is not implemented -prog3.cob:39: warning: NATIONAL COLLATING SEQUENCE is not implemented -prog3.cob:50: warning: NATIONAL COLLATING SEQUENCE is not implemented -prog3.cob:99: warning: NATIONAL COLLATING SEQUENCE is not implemented -prog3.cob:114: warning: NATIONAL COLLATING SEQUENCE is not implemented -prog3.cob:130: warning: NATIONAL COLLATING SEQUENCE is not implemented -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/syn_definition.at:1815" -$at_failed && at_fn_log_failure -$at_traceon; } - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_105 -#AT_START_106 -at_fn_group_banner 106 'syn_definition.at:1827' \ - "RENAMES item" " " 2 -at_xfail=no -( - $as_echo "106. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 a. - 03 b PIC 9. - 03 c. - 05 d PIC 9. - 05 e PIC 9. - - 66 valid-1 RENAMES b. - 66 valid-2 RENAMES d THRU e. - - 66 invalid-1 RENAMES a. - 66 invalid-2 RENAMES c THRU d. - 66 invalid-3 RENAMES e THRU d. - 66 invalid-4 RENAMES valid-2. - - 01 f. - 03 g PIC X. - 88 h VALUE "a". - 03 i PIC X. - 03 j OCCURS 5 TIMES. - 05 k PIC X. - 05 l PIC X. - 03 m PIC 9. - 03 n POINTER, SYNC. - 03 o. - 05 p PIC X OCCURS 1 TO 10 DEPENDING ON l. - - 66 valid-3 RENAMES g THRU i. - 66 invalid-5 RENAMES h. - 66 invalid-6 RENAMES k THRU l. - 66 invalid-7 RENAMES j. - 66 invalid-8 RENAMES m THRU o. - 66 invalid-9 RENAMES b THRU m. - - 78 my-ext-const VALUE "123". - 66 invalid-ec RENAMES my-ext-const. - - 01 my-std-const CONSTANT AS "123". - 66 invalid-sc RENAMES my-std-const. - - PROCEDURE DIVISION. - DISPLAY valid-2 OF a - IF valid-1 = 1 - CONTINUE - END-IF - . -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/syn_definition.at:1882: \$COMPILE_ONLY -std=cobol2014 prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY -std=cobol2014 prog.cob" "syn_definition.at:1882" -( $at_check_trace; $COMPILE_ONLY -std=cobol2014 prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob:15: error: RENAMES of 01-, 66- and 77-level items does not conform to COBOL 2014 -prog.cob:16: error: THRU item 'd' may not be subordinate to 'c' -prog.cob:17: error: THRU item 'd' may not come before 'e' -prog.cob:18: error: RENAMES of 01-, 66- and 77-level items does not conform to COBOL 2014 -prog.cob:33: error: RENAMES may not reference a level 88 -prog.cob:34: error: cannot use RENAMES on part of the table 'j' -prog.cob:35: error: RENAMES cannot start/end at the OCCURS item 'j' -prog.cob:36: error: RENAMES may not contain 'n' as it is a pointer or object reference -prog.cob:36: error: RENAMES may not contain 'p' as it is an OCCURS DEPENDING table -prog.cob:37: error: 'invalid-9' must immediately follow the record 'a' -prog.cob:37: error: 'b' and 'm' must be in the same record -prog.cob:39: error: 78 VALUE does not conform to COBOL 2014 -prog.cob:40: error: a constant may not be used here - 'my-ext-const' -prog.cob:43: error: a constant may not be used here - 'my-std-const' -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/syn_definition.at:1882" -$at_failed && at_fn_log_failure -$at_traceon; } - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_106 -#AT_START_107 -at_fn_group_banner 107 'syn_definition.at:1901' \ - "RENAMES of 01-, 66- and 77-level items" " " 2 -at_xfail=no -( - $as_echo "107. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 a PIC X. - 66 renames-a RENAMES a. - 66 renames-a2 RENAMES renames-a. - - 77 b PIC X. - 66 renames-b RENAMES b. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/syn_definition.at:1917: \$COMPILE_ONLY -std=cobol2014 prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY -std=cobol2014 prog.cob" "syn_definition.at:1917" -( $at_check_trace; $COMPILE_ONLY -std=cobol2014 prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob:7: error: RENAMES of 01-, 66- and 77-level items does not conform to COBOL 2014 -prog.cob:8: error: RENAMES of 01-, 66- and 77-level items does not conform to COBOL 2014 -prog.cob:11: error: RENAMES of 01-, 66- and 77-level items does not conform to COBOL 2014 -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/syn_definition.at:1917" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/syn_definition.at:1922: \$COMPILE_ONLY -frenames-uncommon-levels=ok prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY -frenames-uncommon-levels=ok prog.cob" "syn_definition.at:1922" -( $at_check_trace; $COMPILE_ONLY -frenames-uncommon-levels=ok prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/syn_definition.at:1922" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_107 -#AT_START_108 -at_fn_group_banner 108 'syn_definition.at:1927' \ - "SAME AS clause" " " 2 -at_xfail=no -( - $as_echo "108. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 MESSAGE-TEXT-2 EXTERNAL. - 02 AUSGABE-FILE-NAME PIC X(50). - 02 FILLER REDEFINES AUSGABE-FILE-NAME. - 05 FILLER PIC 9999. - 02 AUSGABE-FILE-NAME-2. - 05 FILLER PIC 9999. - 05 DETAIL-NO PIC 9999. - 02 FILLER SAME AS AUSGABE-FILE-NAME. - - 77 OUTPUT-NAME SAME AS DETAIL-NO GLOBAL. - - 01 Z-MESSAGE-T2 SAME AS AUSGABE-FILE-NAME-2. - 01 Z-MESSAGE-T3. - 49 MT3 SAME AS MESSAGE-TEXT-2. - 49 MT3-REN REDEFINES MT3 SAME AS MESSAGE-TEXT-2. - - PROCEDURE DIVISION. - DISPLAY AUSGABE-FILE-NAME OF MESSAGE-TEXT-2 - DISPLAY DETAIL-NO OF Z-MESSAGE-T2 - DISPLAY AUSGABE-FILE-NAME OF MT3 - DISPLAY OUTPUT-NAME - GOBACK. -_ATEOF - - -cat >badprog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 MESSAGE-TEXT-2. - 02 AUSGABE-FILE-NAME PIC X(50). - 02 F1 SAME AS MESSAGE-TEXT-2. - 01 MT2 SAME AS MESSAGE-TEXT-2. - 05 FILLER PIC 9999. - 01 MT3 SAME AS MESSAGE-TEXT-2 PIC X. - 77 OUTPUT-NAME SAME AS MESSAGE-TEXT-2. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/syn_definition.at:1973: \$COMPILE_ONLY -std=mf-strict prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY -std=mf-strict prog.cob" "syn_definition.at:1973" -( $at_check_trace; $COMPILE_ONLY -std=mf-strict prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob:13: error: SAME AS clause does not conform to Micro Focus COBOL -prog.cob:15: error: SAME AS clause does not conform to Micro Focus COBOL -prog.cob:17: error: SAME AS clause does not conform to Micro Focus COBOL -prog.cob:19: error: SAME AS clause does not conform to Micro Focus COBOL -prog.cob:20: error: SAME AS clause does not conform to Micro Focus COBOL -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/syn_definition.at:1973" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/syn_definition.at:1980: \$COMPILE_ONLY prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY prog.cob" "syn_definition.at:1980" -( $at_check_trace; $COMPILE_ONLY prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/syn_definition.at:1980" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/syn_definition.at:1981: \$COMPILE_ONLY badprog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY badprog.cob" "syn_definition.at:1981" -( $at_check_trace; $COMPILE_ONLY badprog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "badprog.cob:8: error: SAME AS item may not reference itself -badprog.cob:10: error: entry following SAME AS may not be subordinate to it -badprog.cob:11: error: illegal combination of SAME AS with other clauses -badprog.cob:12: error: elementary item expected -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/syn_definition.at:1981" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_108 -#AT_START_109 -at_fn_group_banner 109 'syn_definition.at:1991' \ - "APPLY COMMIT clause" " " 2 -at_xfail=no -( - $as_echo "109. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. *> taken from "commit and rollback example" - *> from COBOL 202x draft - ENVIRONMENT DIVISION. - INPUT-OUTPUT SECTION. - FILE-CONTROL. - SELECT STCK-FILE - ASSIGN TO "STOCK" - ORGANIZATION IS INDEXED - ACCESS MODE IS RANDOM - FILE STATUS IS STCK-FILE-STATUS - RECORD KEY IS APPLY - SHARING WITH ALL OTHER. - - SELECT CHNG-FILE - ASSIGN TO "CHANGE" - ORGANIZATION IS SEQUENTIAL - ACCESS MODE IS SEQUENTIAL - FILE STATUS IS CHNG-FILE-STATUS - SHARING WITH ALL OTHER. - - SELECT SORT-FILE - ASSIGN TO "SORT". - - I-O-CONTROL. - APPLY COMMIT ON STCK-FILE CHNG-FILE STCK-FILE not-there - SORT-FILE UPDATE-COUNT not-there-again BASED-STUFF - RED-DATA SOME-DATA. - - DATA DIVISION. - FILE SECTION. - - FD STCK-FILE. - 01 STCK-REC. - 03 APPLY PIC X(5). - 03 STCK-QTY PIC 9(5)V99. - - SD SORT-FILE. - 01 SORT-REC PIC X(100). - - FD CHNG-FILE. - 01 CHNG-REC. - 03 CHNG-KEY PIC X(5). - 03 CHNG-QTY PIC 9(5)V99. - 03 CHNG-ACTION PIC X. - 03 CHNG-STATE PIC X. - - WORKING-STORAGE SECTION. - - 01 FILE-STATES. - 03 STCK-FILE-STATUS PIC XX. - 88 STCK-FILE-OK VALUE "00". - 03 CHNG-FILE-STATUS PIC XX. - 88 CHNG-FILE-OK VALUE "00". - 77 UPDATE-COUNT BINARY-LONG. - 77 BASED-STUFF PIC X BASED. - 01 DATA-HERE. - 03 SOME-DATA PIC 9. - 01 RED-DATA REDEFINES DATA-HERE PIC X. - - PROCEDURE DIVISION. - - MAIN SECTION. - - PERFORM INITIALISATION - PERFORM TERMINATION - STOP RUN WITH NORMAL STATUS 0 - - . INITIALISATION SECTION. - - OPEN I-O CHNG-FILE, STCK-FILE - IF NOT STCK-FILE-OK OR NOT CHNG-FILE-OK - PERFORM FATAL-ERROR - END-IF - - . TERMINATION SECTION. - - COMMIT - IF NOT STCK-FILE-OK OR NOT CHNG-FILE-OK - PERFORM FATAL-ERROR - END-IF - - . FATAL-ERROR SECTION. - - ROLLBACK - STOP RUN WITH ERROR STATUS 16. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/syn_definition.at:2083: \$COMPILE_ONLY prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY prog.cob" "syn_definition.at:2083" -( $at_check_trace; $COMPILE_ONLY prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob:29: warning: APPLY COMMIT is not implemented -prog.cob:27: error: 'not-there' is not defined -prog.cob:28: error: 'not-there-again' is not defined -prog.cob:27: error: duplicate APPLY COMMIT target: 'STCK-FILE' -prog.cob:28: error: APPLY COMMIT statement invalid for SORT file -prog.cob:29: error: 'RED-DATA' REDEFINES field not allowed here -prog.cob:29: error: 'SOME-DATA' not level 01 or 77 -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/syn_definition.at:2083" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_109 -#AT_START_110 -at_fn_group_banner 110 'syn_subscripts.at:23' \ - "Non-numeric subscript" " " 2 -at_xfail=no -( - $as_echo "110. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 G1. - 02 X PIC X OCCURS 10. - 01 I PIC X. - PROCEDURE DIVISION. - DISPLAY X(I) - END-DISPLAY. - DISPLAY X(I + 1) - END-DISPLAY. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/syn_subscripts.at:42: \$COMPILE_ONLY prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY prog.cob" "syn_subscripts.at:42" -( $at_check_trace; $COMPILE_ONLY prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob:10: error: 'I' is not an integer value -prog.cob:12: error: 'I' is not a numeric value -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/syn_subscripts.at:42" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_110 -#AT_START_111 -at_fn_group_banner 111 'syn_subscripts.at:50' \ - "Subscript range check" " " 2 -at_xfail=no -( - $as_echo "111. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 G1. - 02 X OCCURS 2. - 03 Y PIC X OCCURS 3. - PROCEDURE DIVISION. - DISPLAY X(0) - END-DISPLAY. - DISPLAY X(1) - END-DISPLAY. - DISPLAY X(2) - END-DISPLAY. - DISPLAY X(3) - END-DISPLAY. - DISPLAY Y(1, 0) - END-DISPLAY. - DISPLAY Y(1, 1) - END-DISPLAY. - DISPLAY Y(1, 3) - END-DISPLAY. - DISPLAY Y(1, 4) - END-DISPLAY. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/syn_subscripts.at:81: \$COMPILE_ONLY prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY prog.cob" "syn_subscripts.at:81" -( $at_check_trace; $COMPILE_ONLY prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob:10: error: subscript of 'X' out of bounds: 0 -prog.cob:16: error: subscript of 'X' out of bounds: 3 -prog.cob:18: error: subscript of 'Y' out of bounds: 0 -prog.cob:24: error: subscript of 'Y' out of bounds: 4 -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/syn_subscripts.at:81" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_111 -#AT_START_112 -at_fn_group_banner 112 'syn_subscripts.at:91' \ - "Subscript bounds with OCCURS DEPENDING ON" " " 2 -at_xfail=no -( - $as_echo "112. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 G. - 02 X PIC X OCCURS 4 TO 6 DEPENDING ON N. - 01 N PIC 9 VALUE 4. - PROCEDURE DIVISION. - DISPLAY X(0) - DISPLAY X(7) - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/syn_subscripts.at:108: \$COMPILE_ONLY prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY prog.cob" "syn_subscripts.at:108" -( $at_check_trace; $COMPILE_ONLY prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob:10: error: subscript of 'X' out of bounds: 0 -prog.cob:11: error: subscript of 'X' out of bounds: 7 -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/syn_subscripts.at:108" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_112 -#AT_START_113 -at_fn_group_banner 113 'syn_subscripts.at:118' \ - "Subscripted item requires OCCURS clause" " " 2 -at_xfail=no -( - $as_echo "113. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 G. - 02 X PIC X. - PROCEDURE DIVISION. - DISPLAY G(1) - END-DISPLAY. - DISPLAY X(1) - END-DISPLAY. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/syn_subscripts.at:136: \$COMPILE_ONLY prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY prog.cob" "syn_subscripts.at:136" -( $at_check_trace; $COMPILE_ONLY prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob:9: error: 'G' cannot be subscripted -prog.cob:11: error: 'X' cannot be subscripted -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/syn_subscripts.at:136" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_113 -#AT_START_114 -at_fn_group_banner 114 'syn_subscripts.at:144' \ - "Number of subscripts" " " 2 -at_xfail=no -( - $as_echo "114. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 G1. - 02 X OCCURS 2. - 03 Y PIC X OCCURS 3. - PROCEDURE DIVISION. - DISPLAY X - END-DISPLAY. - DISPLAY X(1) - END-DISPLAY. - DISPLAY X(1, 2) - END-DISPLAY. - DISPLAY Y(1) - END-DISPLAY. - DISPLAY Y(1, 2) - END-DISPLAY. - DISPLAY Y(1, 2, 3) - END-DISPLAY. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/syn_subscripts.at:171: \$COMPILE_ONLY prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY prog.cob" "syn_subscripts.at:171" -( $at_check_trace; $COMPILE_ONLY prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob:10: error: 'X' requires one subscript -prog.cob:14: error: 'X' requires one subscript -prog.cob:16: error: 'Y' requires 2 subscripts -prog.cob:20: error: 'Y' requires 2 subscripts -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/syn_subscripts.at:171" -$at_failed && at_fn_log_failure -$at_traceon; } - - -{ set +x -$as_echo "$at_srcdir/syn_subscripts.at:178: \$COMPILE_ONLY -frelax-syntax-checks prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY -frelax-syntax-checks prog.cob" "syn_subscripts.at:178" -( $at_check_trace; $COMPILE_ONLY -frelax-syntax-checks prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob:10: warning: subscript missing for 'X' - defaulting to 1 -prog.cob:14: error: 'X' requires one subscript -prog.cob:16: warning: subscript missing for 'Y' - defaulting to 1 -prog.cob:20: error: 'Y' requires 2 subscripts -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/syn_subscripts.at:178" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_114 -#AT_START_115 -at_fn_group_banner 115 'syn_occurs.at:29' \ - "OCCURS with level 01 and 77" " " 2 -at_xfail=no -( - $as_echo "115. $at_setup_line: testing $at_desc ..." - $at_traceon - -#AT_KEYWORDS([occurs]) - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 X-01 PIC X OCCURS 10. - 01 G OCCURS 10. - 02 X-02 PIC X OCCURS 10. - 01 G2. - 02 X2-02 PIC X OCCURS 10. - 77 X-77 PIC X OCCURS 10. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/syn_occurs.at:45: \$COMPILE_ONLY -std=cobol2014 prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY -std=cobol2014 prog.cob" "syn_occurs.at:45" -( $at_check_trace; $COMPILE_ONLY -std=cobol2014 prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob:6: error: level 01 item 'X-01' cannot have a OCCURS clause -prog.cob:7: error: level 01 item 'G' cannot have a OCCURS clause -prog.cob:11: error: level 77 item 'X-77' cannot have a OCCURS clause -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/syn_occurs.at:45" -$at_failed && at_fn_log_failure -$at_traceon; } - - -{ set +x -$as_echo "$at_srcdir/syn_occurs.at:51: \$COMPILE_ONLY prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY prog.cob" "syn_occurs.at:51" -( $at_check_trace; $COMPILE_ONLY prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/syn_occurs.at:51" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/syn_occurs.at:52: \$COMPILE_ONLY -ftop-level-occurs-clause=warning prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY -ftop-level-occurs-clause=warning prog.cob" "syn_occurs.at:52" -( $at_check_trace; $COMPILE_ONLY -ftop-level-occurs-clause=warning prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob:6: warning: 01/77 OCCURS used -prog.cob:7: warning: 01/77 OCCURS used -prog.cob:11: warning: 01/77 OCCURS used -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/syn_occurs.at:52" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_115 -#AT_START_116 -at_fn_group_banner 116 'syn_occurs.at:84' \ - "OCCURS with level 66" " " 2 -at_xfail=no -( - $as_echo "116. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 x PIC X. - 66 y RENAMES x OCCURS 10. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/syn_occurs.at:96: \$COMPILE_ONLY prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY prog.cob" "syn_occurs.at:96" -( $at_check_trace; $COMPILE_ONLY prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob:7: error: syntax error, unexpected OCCURS, expecting . -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/syn_occurs.at:96" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_116 -#AT_START_117 -at_fn_group_banner 117 'syn_occurs.at:103' \ - "OCCURS with level 78" " " 2 -at_xfail=no -( - $as_echo "117. $at_setup_line: testing $at_desc ..." - $at_traceon - -#AT_KEYWORDS([occurs]) - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 78 c value "a" OCCURS 10. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/syn_occurs.at:114: \$COMPILE_ONLY prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY prog.cob" "syn_occurs.at:114" -( $at_check_trace; $COMPILE_ONLY prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob:6: error: syntax error, unexpected OCCURS, expecting . -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/syn_occurs.at:114" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_117 -#AT_START_118 -at_fn_group_banner 118 'syn_occurs.at:121' \ - "OCCURS with level 88" " " 2 -at_xfail=no -( - $as_echo "118. $at_setup_line: testing $at_desc ..." - $at_traceon - -#AT_KEYWORDS([occurs]) - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 x PIC X. - 88 y VALUE "a" OCCURS 10. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/syn_occurs.at:133: \$COMPILE_ONLY prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY prog.cob" "syn_occurs.at:133" -( $at_check_trace; $COMPILE_ONLY prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob:7: error: syntax error, unexpected OCCURS, expecting . -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/syn_occurs.at:133" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_118 -#AT_START_119 -at_fn_group_banner 119 'syn_occurs.at:141' \ - "OCCURS with variable-occurrence data item" " " 2 -at_xfail=no -( - $as_echo "119. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 G-1. - 02 G-2 OCCURS 10. - 03 X PIC X(10) OCCURS 1 TO 4 DEPENDING ON I. - 77 I PIC 9. -_ATEOF - - -cat >prog2.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog2. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 G-1. - 02 G-2 OCCURS 1 TO 10 DEPENDING ON I. - 03 X PIC X(10) OCCURS 1 TO 4 DEPENDING ON I. - 77 I PIC 9. - PROCEDURE DIVISION. - DISPLAY X(I, I) END-DISPLAY - DISPLAY G-2 (I) END-DISPLAY - DISPLAY G-1 END-DISPLAY - . - -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/syn_occurs.at:172: \$COMPILE_ONLY prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY prog.cob" "syn_occurs.at:172" -( $at_check_trace; $COMPILE_ONLY prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob:7: error: 'G-2' cannot have the OCCURS clause due to 'X' -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/syn_occurs.at:172" -$at_failed && at_fn_log_failure -$at_traceon; } - - -{ set +x -$as_echo "$at_srcdir/syn_occurs.at:176: \$COMPILE_ONLY -fcomplex-odo prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY -fcomplex-odo prog.cob" "syn_occurs.at:176" -( $at_check_trace; $COMPILE_ONLY -fcomplex-odo prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/syn_occurs.at:176" -$at_failed && at_fn_log_failure -$at_traceon; } - - -{ set +x -$as_echo "$at_srcdir/syn_occurs.at:178: \$COMPILE_ONLY -fcomplex-odo prog2.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY -fcomplex-odo prog2.cob" "syn_occurs.at:178" -( $at_check_trace; $COMPILE_ONLY -fcomplex-odo prog2.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog2.cob:8: error: 'X' cannot have nested OCCURS DEPENDING -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/syn_occurs.at:178" -$at_failed && at_fn_log_failure -$at_traceon; } - - -{ set +x -$as_echo "$at_srcdir/syn_occurs.at:182: \$COMPILE_ONLY -fodoslide prog2.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY -fodoslide prog2.cob" "syn_occurs.at:182" -( $at_check_trace; $COMPILE_ONLY -fodoslide prog2.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/syn_occurs.at:182" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_119 -#AT_START_120 -at_fn_group_banner 120 'syn_occurs.at:189' \ - "OCCURS data-items for INDEXED and KEY" " " 2 -at_xfail=no -( - $as_echo "120. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 TAB. - 05 TAB-ENTRY1 - OCCURS 5 TIMES - ASCENDING KEY IS X1 - OF TAB-ENTRY1 - OF TAB - INDEXED BY IDX1 OF TAB. - 10 X1 PIC 9. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/syn_occurs.at:207: \$COMPILE_ONLY prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY prog.cob" "syn_occurs.at:207" -( $at_check_trace; $COMPILE_ONLY prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob:9: error: a subscripted data-item cannot be used here -prog.cob:12: error: a subscripted data-item cannot be used here -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/syn_occurs.at:207" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_120 -#AT_START_121 -at_fn_group_banner 121 'syn_occurs.at:229' \ - "Nested OCCURS clause" " " 2 -at_xfail=no -( - $as_echo "121. $at_setup_line: testing $at_desc ..." - $at_traceon - -#AT_KEYWORDS([occurs]) - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 G-1. - 02 G-2 OCCURS 2. - 03 G-3 OCCURS 2. - 04 G-4 OCCURS 2. - 05 G-5 OCCURS 2. - 06 G-6 OCCURS 2. - 07 G-7 OCCURS 2. - 08 G-8 OCCURS 2. - 09 X PIC X. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/syn_occurs.at:248: \$COMPILE_ONLY prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY prog.cob" "syn_occurs.at:248" -( $at_check_trace; $COMPILE_ONLY prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/syn_occurs.at:248" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_121 -#AT_START_122 -at_fn_group_banner 122 'syn_occurs.at:266' \ - "OCCURS DEPENDING with wrong size" " " 2 -at_xfail=no -( - $as_echo "122. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 FILLER. - 02 G-1 PIC X OCCURS 1 TO 1 DEPENDING ON I. - 01 FILLER. - 02 G-2 PIC X OCCURS -1 TO 1 DEPENDING ON I. - 01 FILLER. - 02 G-3 PIC X OCCURS +1 TO 1 DEPENDING ON I. - 01 FILLER. - 02 G-4 PIC X OCCURS 0 TO 1 DEPENDING ON I. - 01 I PIC 9. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/syn_occurs.at:285: \$COMPILE_ONLY prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY prog.cob" "syn_occurs.at:285" -( $at_check_trace; $COMPILE_ONLY prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob:7: error: OCCURS TO must be greater than OCCURS FROM -prog.cob:9: error: unsigned integer value expected -prog.cob:11: error: unsigned integer value expected -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/syn_occurs.at:285" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_122 -#AT_START_123 -at_fn_group_banner 123 'syn_occurs.at:305' \ - "OCCURS DEPENDING followed by another field" " " 2 -at_xfail=no -( - $as_echo "123. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 G-1. - 02 X PIC X OCCURS 1 TO 3 DEPENDING ON I. - 02 Y PIC X. - 01 G-2. - 02 G-3 OCCURS 1 TO 3 DEPENDING ON I. - 03 X PIC X. - 02 Y PIC X. - 01 G-4. - 02 G-5. - 03 X PIC X OCCURS 1 TO 3 DEPENDING ON I. - 02 Y PIC X. - 01 I PIC 9. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/syn_occurs.at:327: \$COMPILE_ONLY prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY prog.cob" "syn_occurs.at:327" -( $at_check_trace; $COMPILE_ONLY prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob:7: error: 'X' cannot have OCCURS DEPENDING because of 'Y' -prog.cob:10: error: 'G-3' cannot have OCCURS DEPENDING because of 'Y' -prog.cob:15: error: 'X' cannot have OCCURS DEPENDING because of 'Y' -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/syn_occurs.at:327" -$at_failed && at_fn_log_failure -$at_traceon; } - - -{ set +x -$as_echo "$at_srcdir/syn_occurs.at:333: \$COMPILE_ONLY -fcomplex-odo prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY -fcomplex-odo prog.cob" "syn_occurs.at:333" -( $at_check_trace; $COMPILE_ONLY -fcomplex-odo prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/syn_occurs.at:333" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_123 -#AT_START_124 -at_fn_group_banner 124 'syn_occurs.at:347' \ - "OCCURS with unmatched DEPENDING / TO phrases" " " 2 -at_xfail=no -( - $as_echo "124. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 Y PIC 9. - 01 XTAB. - 03 X PIC X OCCURS 10 DEPENDING ON Y. - 01 XTAB2. - 03 X2 PIC X OCCURS 1 TO 10. - 01 XTAB3. - 03 X3 PIC X OCCURS 1 TO 10 DEPENDING ON MISSING. - PROCEDURE DIVISION. - MOVE 'A' TO X(1), X2(2), X3(3) - GOBACK. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/syn_occurs.at:367: \$COMPILE_ONLY -std=cobol2014 prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY -std=cobol2014 prog.cob" "syn_occurs.at:367" -( $at_check_trace; $COMPILE_ONLY -std=cobol2014 prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob:8: error: OCCURS DEPENDING ON without TO phrase does not conform to COBOL 2014 -prog.cob:10: error: TO phrase without DEPENDING phrase -prog.cob:12: error: 'MISSING' is not defined -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/syn_occurs.at:367" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/syn_occurs.at:372: \$COMPILE_ONLY prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY prog.cob" "syn_occurs.at:372" -( $at_check_trace; $COMPILE_ONLY prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob:8: warning: OCCURS DEPENDING ON without TO phrase used -prog.cob:10: error: TO phrase without DEPENDING phrase -prog.cob:12: error: 'MISSING' is not defined -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/syn_occurs.at:372" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/syn_occurs.at:377: \$COMPILE_ONLY -frelax-syntax prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY -frelax-syntax prog.cob" "syn_occurs.at:377" -( $at_check_trace; $COMPILE_ONLY -frelax-syntax prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob:8: warning: OCCURS DEPENDING ON without TO phrase used -prog.cob:10: warning: TO phrase without DEPENDING phrase -prog.cob:10: warning: maximum number of occurrences assumed to be exact number -prog.cob:12: error: 'MISSING' is not defined -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/syn_occurs.at:377" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_124 -#AT_START_125 -at_fn_group_banner 125 'syn_occurs.at:390' \ - "OCCURS INDEXED before KEY" " " 2 -at_xfail=no -( - $as_echo "125. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 TAB. - 05 TAB-ENTRY1 - OCCURS 5 TIMES - INDEXED BY IDX1 - ASCENDING KEY IS X1 - DESCENDING Y1. - 10 X1 PIC 9(4). - 10 Y1 PIC X. - 05 TAB-ENTRY - OCCURS 2 TIMES - INDEXED BY IDX2 - DESCENDING KEY IS X2 - ASCENDING Y2. - 10 X2 PIC 9(4). - 10 Y2 PIC X. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/syn_occurs.at:415: \$COMPILE_ONLY prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY prog.cob" "syn_occurs.at:415" -( $at_check_trace; $COMPILE_ONLY prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob:10: error: INDEXED should follow ASCENDING/DESCENDING -prog.cob:17: error: INDEXED should follow ASCENDING/DESCENDING -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/syn_occurs.at:415" -$at_failed && at_fn_log_failure -$at_traceon; } - - -{ set +x -$as_echo "$at_srcdir/syn_occurs.at:420: \$COMPILE_ONLY -frelax-syntax-checks prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY -frelax-syntax-checks prog.cob" "syn_occurs.at:420" -( $at_check_trace; $COMPILE_ONLY -frelax-syntax-checks prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob:10: warning: INDEXED should follow ASCENDING/DESCENDING -prog.cob:17: warning: INDEXED should follow ASCENDING/DESCENDING -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/syn_occurs.at:420" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_125 -#AT_START_126 -at_fn_group_banner 126 'syn_occurs.at:428' \ - "OCCURS size check" " " 2 -at_xfail=no -( - $as_echo "126. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 X1. - 03 X PIC X OCCURS 1530001234 TIMES. - 01 X2. - 03 X PIC X OCCURS 2147483648 TIMES. - 01 X3. - 03 X PIC X OCCURS 9223372036854775808 TIMES. -_ATEOF - - -# Don't check actual output here as the actual limit depends on INT_MAX, therefore -# all entries may raise this error but only the last error message is guaranteed. -{ set +x -$as_echo "$at_srcdir/syn_occurs.at:446: \$COMPILE_ONLY prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY prog.cob" "syn_occurs.at:446" -( $at_check_trace; $COMPILE_ONLY prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo stderr:; cat "$at_stderr" -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/syn_occurs.at:446" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/syn_occurs.at:447: \$COMPILE_ONLY prog.cob 2>&1 | \\ -grep \"prog.cob:11: error: numeric literal '9223372036854775808' exceeds limit\"" -at_fn_check_prepare_notrace 'an embedded newline' "syn_occurs.at:447" -( $at_check_trace; $COMPILE_ONLY prog.cob 2>&1 | \ -grep "prog.cob:11: error: numeric literal '9223372036854775808' exceeds limit" -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo stdout:; cat "$at_stdout" -at_fn_check_status 0 $at_status "$at_srcdir/syn_occurs.at:447" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_126 -#AT_START_127 -at_fn_group_banner 127 'syn_occurs.at:454' \ - "ODO not Fixed Loc" " " 2 -at_xfail=no -( - $as_echo "127. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ****************************************************************** - ENVIRONMENT DIVISION. - DATA DIVISION. - ****************************************************************** - WORKING-STORAGE SECTION. - 01 DAT. - 02 ODO-1 PIC 9. - 02 ODO-1-DATA OCCURS 1 TO 6 TIMES DEPENDING ON ODO-1 - PIC 9. - 02 ODO-2 PIC 9. - 02 ODO-2-DATA OCCURS 1 TO 6 TIMES DEPENDING ON ODO-2 - PIC 9. - 02 ODO-3 PIC XXX. - - ****************************************************************** - PROCEDURE DIVISION. - STOP RUN. - -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/syn_occurs.at:480: \$COMPILE_ONLY -std=mf prog.cob " -at_fn_check_prepare_dynamic "$COMPILE_ONLY -std=mf prog.cob " "syn_occurs.at:480" -( $at_check_trace; $COMPILE_ONLY -std=mf prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/syn_occurs.at:480" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/syn_occurs.at:481: \$COMPILE_ONLY -std=mf -fodoslide prog.cob " -at_fn_check_prepare_dynamic "$COMPILE_ONLY -std=mf -fodoslide prog.cob " "syn_occurs.at:481" -( $at_check_trace; $COMPILE_ONLY -std=mf -fodoslide prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/syn_occurs.at:481" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_127 -#AT_START_128 -at_fn_group_banner 128 'syn_redefines.at:28' \ - "REDEFINES: not following entry-name" " " 2 -at_xfail=no -( - $as_echo "128. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 X PIC X. - 01 Y PIC 9 REDEFINES X. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/syn_redefines.at:40: \$COMPILE_ONLY -ffree-redefines-position=error prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY -ffree-redefines-position=error prog.cob" "syn_redefines.at:40" -( $at_check_trace; $COMPILE_ONLY -ffree-redefines-position=error prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob:7: error: REDEFINES clause not following entry-name used -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/syn_redefines.at:40" -$at_failed && at_fn_log_failure -$at_traceon; } - - -{ set +x -$as_echo "$at_srcdir/syn_redefines.at:44: \$COMPILE_ONLY prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY prog.cob" "syn_redefines.at:44" -( $at_check_trace; $COMPILE_ONLY prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob:7: warning: REDEFINES clause not following entry-name used -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/syn_redefines.at:44" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_128 -#AT_START_129 -at_fn_group_banner 129 'syn_redefines.at:53' \ - "REDEFINES: level 02 by 01" " " 2 -at_xfail=no -( - $as_echo "129. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 G. - 02 X PIC X. - 01 Y REDEFINES X PIC 9. - PROCEDURE DIVISION. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/syn_redefines.at:68: \$COMPILE_ONLY prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY prog.cob" "syn_redefines.at:68" -( $at_check_trace; $COMPILE_ONLY prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob:8: error: level number of REDEFINES entries must be identical -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/syn_redefines.at:68" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_129 -#AT_START_130 -at_fn_group_banner 130 'syn_redefines.at:74' \ - "REDEFINES: level 03 by 02" " " 2 -at_xfail=no -( - $as_echo "130. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 G1. - 02 G2. - 03 X PIC X. - 02 Y REDEFINES X PIC 9. - PROCEDURE DIVISION. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/syn_redefines.at:90: \$COMPILE_ONLY prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY prog.cob" "syn_redefines.at:90" -( $at_check_trace; $COMPILE_ONLY prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob:9: error: 'X' is not defined in 'G1' -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/syn_redefines.at:90" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_130 -#AT_START_131 -at_fn_group_banner 131 'syn_redefines.at:96' \ - "REDEFINES: level 66" " " 2 -at_xfail=no -( - $as_echo "131. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 G. - 02 X PIC X. - 66 A RENAMES X. - 66 B REDEFINES A PIC 9. - PROCEDURE DIVISION. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/syn_redefines.at:112: \$COMPILE_ONLY prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY prog.cob" "syn_redefines.at:112" -( $at_check_trace; $COMPILE_ONLY prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob:9: error: syntax error, unexpected REDEFINES, expecting RENAMES -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/syn_redefines.at:112" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_131 -#AT_START_132 -at_fn_group_banner 132 'syn_redefines.at:118' \ - "REDEFINES: level 88" " " 2 -at_xfail=no -( - $as_echo "132. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 X PIC X. - 88 A VALUE "A". - 88 B REDEFINES A VALUE "B". - PROCEDURE DIVISION. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/syn_redefines.at:133: \$COMPILE_ONLY prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY prog.cob" "syn_redefines.at:133" -( $at_check_trace; $COMPILE_ONLY prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob:8: error: syntax error, unexpected REDEFINES, expecting VALUE -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/syn_redefines.at:133" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_132 -#AT_START_133 -at_fn_group_banner 133 'syn_redefines.at:147' \ - "REDEFINES: lower level number" " " 2 -at_xfail=no -( - $as_echo "133. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 G1. - 02 G2. - 03 X PIC X. - 02 G3. - 03 A REDEFINES X PIC 9. - PROCEDURE DIVISION. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/syn_redefines.at:164: \$COMPILE_ONLY prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY prog.cob" "syn_redefines.at:164" -( $at_check_trace; $COMPILE_ONLY prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob:10: error: 'X' is not defined in 'G3' -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/syn_redefines.at:164" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_133 -#AT_START_134 -at_fn_group_banner 134 'syn_redefines.at:173' \ - "REDEFINES: with OCCURS" " " 2 -at_xfail=no -( - $as_echo "134. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 G. - 02 X PIC X OCCURS 2. - 02 Y REDEFINES X PIC XX. - PROCEDURE DIVISION. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/syn_redefines.at:188: \$COMPILE_ONLY prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY prog.cob" "syn_redefines.at:188" -( $at_check_trace; $COMPILE_ONLY prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob:8: warning: the original definition 'X' should not have OCCURS clause -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/syn_redefines.at:188" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_134 -#AT_START_135 -at_fn_group_banner 135 'syn_redefines.at:194' \ - "REDEFINES: with subscript" " " 2 -at_xfail=no -( - $as_echo "135. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 G1. - 02 G2 OCCURS 2. - 03 X PIC X. - 03 Y REDEFINES X(1) PIC X. - PROCEDURE DIVISION. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/syn_redefines.at:210: \$COMPILE_ONLY prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY prog.cob" "syn_redefines.at:210" -( $at_check_trace; $COMPILE_ONLY prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob:9: error: 'X' cannot be subscripted here -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/syn_redefines.at:210" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_135 -#AT_START_136 -at_fn_group_banner 136 'syn_redefines.at:216' \ - "REDEFINES: with variable occurrence" " " 2 -at_xfail=no -( - $as_echo "136. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 G1. - 02 X PIC XX. - 02 Y REDEFINES X PIC X OCCURS 1 TO 2 DEPENDING ON I. - 01 G2. - 02 X PIC XX. - 02 Y REDEFINES X. - 03 A PIC X OCCURS 1 TO 2 DEPENDING ON I. - 01 G3. - 02 X. - 03 A PIC X OCCURS 1 TO 2 DEPENDING ON I. - 02 Y REDEFINES X PIC X. - 01 I PIC 9. - PROCEDURE DIVISION. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/syn_redefines.at:240: \$COMPILE_ONLY prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY prog.cob" "syn_redefines.at:240" -( $at_check_trace; $COMPILE_ONLY prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob:8: error: 'Y' cannot be variable length -prog.cob:11: error: 'Y' cannot be variable length -prog.cob:16: error: the original definition 'X' cannot be variable length -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/syn_redefines.at:240" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_136 -#AT_START_137 -at_fn_group_banner 137 'syn_redefines.at:251' \ - "REDEFINES: with qualification" " " 2 -at_xfail=no -( - $as_echo "137. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 G1. - 02 X PIC X. - 01 G2. - 02 X PIC X. - 02 A REDEFINES X IN G1. - PROCEDURE DIVISION. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/syn_redefines.at:268: \$COMPILE_ONLY prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY prog.cob" "syn_redefines.at:268" -( $at_check_trace; $COMPILE_ONLY prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob:10: error: 'X' cannot be qualified here -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/syn_redefines.at:268" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_137 -#AT_START_138 -at_fn_group_banner 138 'syn_redefines.at:277' \ - "REDEFINES: multiple redefinition" " " 2 -at_xfail=no -( - $as_echo "138. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 G1. - 02 X PIC X. - 02 A REDEFINES X PIC 9. - 02 B REDEFINES X PIC 9. - 02 C REDEFINES B PIC 9. - PROCEDURE DIVISION. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/syn_redefines.at:294: \$COMPILE_ONLY prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY prog.cob" "syn_redefines.at:294" -( $at_check_trace; $COMPILE_ONLY prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob:10: error: 'B' is not the original definition -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/syn_redefines.at:294" -$at_failed && at_fn_log_failure -$at_traceon; } - - -{ set +x -$as_echo "$at_srcdir/syn_redefines.at:298: \$COMPILE_ONLY -std=mvs prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY -std=mvs prog.cob" "syn_redefines.at:298" -( $at_check_trace; $COMPILE_ONLY -std=mvs prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/syn_redefines.at:298" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_138 -#AT_START_139 -at_fn_group_banner 139 'syn_redefines.at:305' \ - "REDEFINES: size exceeds" " " 2 -at_xfail=no -( - $as_echo "139. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 G1. - 02 X PIC X. - 02 A REDEFINES X PIC 99. - 01 G2. - 02 X PIC X. - 02 A REDEFINES X PIC 9 OCCURS 2. - 01 WRK-X PIC X. - 01 WRK-X-REDEF REDEFINES WRK-X PIC 99. - 01 EXT-X PIC X EXTERNAL. - 01 EXT-X-REDEF REDEFINES EXT-X PIC 99. - PROCEDURE DIVISION. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/syn_redefines.at:327: \$COMPILE_ONLY prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY prog.cob" "syn_redefines.at:327" -( $at_check_trace; $COMPILE_ONLY prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob:8: error: size of 'A' larger than size of 'X' -prog.cob:11: error: size of 'A' larger than size of 'X' -prog.cob:15: error: size of 'EXT-X-REDEF' larger than size of 'EXT-X' -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/syn_redefines.at:327" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_139 -#AT_START_140 -at_fn_group_banner 140 'syn_redefines.at:338' \ - "REDEFINES: with VALUE" " " 2 -at_xfail=no -( - $as_echo "140. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 X PIC X. - 01 A REDEFINES X PIC X VALUE "A". - 01 G REDEFINES X. - 02 B PIC X VALUE "A". - 01 Y REDEFINES X PIC X. - 88 C VALUE "A". - PROCEDURE DIVISION. - STOP RUN. -_ATEOF - - -# FIXME: add a compiler configuration as the COBOL standard forbids this -# default.conf will allow it (with a warning) - -{ set +x -$as_echo "$at_srcdir/syn_redefines.at:359: \$COMPILE_ONLY prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY prog.cob" "syn_redefines.at:359" -( $at_check_trace; $COMPILE_ONLY prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob:7: warning: initial VALUE clause ignored for REDEFINES item 'A' -prog.cob:9: warning: initial VALUE clause ignored for REDEFINES item 'B' -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/syn_redefines.at:359" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/syn_redefines.at:363: \$COMPILE -frelax-syntax-checks prog.cob" -at_fn_check_prepare_dynamic "$COMPILE -frelax-syntax-checks prog.cob" "syn_redefines.at:363" -( $at_check_trace; $COMPILE -frelax-syntax-checks prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/syn_redefines.at:363" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_140 -#AT_START_141 -at_fn_group_banner 141 'syn_redefines.at:370' \ - "REDEFINES: with intervention" " " 2 -at_xfail=no -( - $as_echo "141. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 X PIC X. - 01 Y PIC X. - 01 A REDEFINES X PIC X. - 01 G. - 02 G-X PIC X. - 02 G-Y PIC X. - 02 G-A REDEFINES G-X PIC X. - PROCEDURE DIVISION. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/syn_redefines.at:389: \$COMPILE_ONLY prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY prog.cob" "syn_redefines.at:389" -( $at_check_trace; $COMPILE_ONLY prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob:8: error: REDEFINES must follow the original definition -prog.cob:12: error: REDEFINES must follow the original definition -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/syn_redefines.at:389" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_141 -#AT_START_142 -at_fn_group_banner 142 'syn_redefines.at:399' \ - "REDEFINES: within REDEFINES" " " 2 -at_xfail=no -( - $as_echo "142. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 X PIC X. - 01 G REDEFINES X. - 02 A PIC X. - 02 B REDEFINES A PIC 9. - PROCEDURE DIVISION. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/syn_redefines.at:415: \$COMPILE_ONLY prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY prog.cob" "syn_redefines.at:415" -( $at_check_trace; $COMPILE_ONLY prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/syn_redefines.at:415" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_142 -#AT_START_143 -at_fn_group_banner 143 'syn_redefines.at:419' \ - "REDEFINES: non-referenced ambiguous item" " " 2 -at_xfail=no -( - $as_echo "143. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 X PIC X. - 01 X PIC X. - 01 G REDEFINES X PIC 9. - PROCEDURE DIVISION. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/syn_redefines.at:434: \$COMPILE_ONLY prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY prog.cob" "syn_redefines.at:434" -( $at_check_trace; $COMPILE_ONLY prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob:7: warning: redefinition of 'X' -prog.cob:6: warning: 'X' previously defined here -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/syn_redefines.at:434" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_143 -#AT_START_144 -at_fn_group_banner 144 'syn_value.at:43' \ - "Numeric item (integer)" " " 2 -at_xfail=no -( - $as_echo "144. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 X-SPACE PIC 999 VALUE SPACE. - 01 X-ABC PIC 999 VALUE "abc". - 01 X-12-3 PIC 999 VALUE 12.3. - 01 X-123 PIC 999 VALUE 123. - 01 X-1234 PIC 999 VALUE 1234. - PROCEDURE DIVISION. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/syn_value.at:60: \$COMPILE_ONLY prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY prog.cob" "syn_value.at:60" -( $at_check_trace; $COMPILE_ONLY prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob:6: error: invalid VALUE clause -prog.cob:7: warning: numeric value is expected -prog.cob:8: warning: value size exceeds data size -prog.cob:10: warning: value size exceeds data size -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/syn_value.at:60" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_144 -#AT_START_145 -at_fn_group_banner 145 'syn_value.at:70' \ - "Numeric item (non-integer)" " " 2 -at_xfail=no -( - $as_echo "145. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 X-12 PIC 99V9 VALUE 12. - 01 X-123 PIC 99V9 VALUE 123. - 01 X-12-3 PIC 99V9 VALUE 12.3. - 01 X-12-34 PIC 99V9 VALUE 12.34. - PROCEDURE DIVISION. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/syn_value.at:86: \$COMPILE_ONLY prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY prog.cob" "syn_value.at:86" -( $at_check_trace; $COMPILE_ONLY prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob:7: warning: value size exceeds data size -prog.cob:9: warning: value size exceeds data size -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/syn_value.at:86" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_145 -#AT_START_146 -at_fn_group_banner 146 'syn_value.at:94' \ - "Numeric item with picture P" " " 2 -at_xfail=no -( - $as_echo "146. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 X-99PP-0 PIC 99PP VALUE 0. - 01 X-99PP-1200 PIC 99PP VALUE 1200. - 01 X-99PP-1230 PIC 99PP VALUE 1230. - 01 X-99PP-10000 PIC 99PP VALUE 10000. - 01 X-PP99--0 PIC PP99 VALUE .0. - 01 X-PP99--0012 PIC PP99 VALUE .0012. - 01 X-PP99--0123 PIC PP99 VALUE .0123. - 01 X-PP99--00001 PIC PP99 VALUE .00001. - PROCEDURE DIVISION. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/syn_value.at:114: \$COMPILE_ONLY prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY prog.cob" "syn_value.at:114" -( $at_check_trace; $COMPILE_ONLY prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob:8: warning: value does not fit the picture string -prog.cob:9: warning: value size exceeds data size -prog.cob:12: warning: value does not fit the picture string -prog.cob:13: warning: value size exceeds data size -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/syn_value.at:114" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_146 -#AT_START_147 -at_fn_group_banner 147 'syn_value.at:126' \ - "Signed numeric literal" " " 2 -at_xfail=no -( - $as_echo "147. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 X-9P PIC 9 VALUE +1. - 01 X-9N PIC 9 VALUE -1. - 01 X-S9P PIC S9 VALUE +1. - 01 X-S9N PIC S9 VALUE -1. - PROCEDURE DIVISION. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/syn_value.at:142: \$COMPILE_ONLY prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY prog.cob" "syn_value.at:142" -( $at_check_trace; $COMPILE_ONLY prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob:6: error: data item not signed -prog.cob:7: error: data item not signed -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/syn_value.at:142" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_147 -#AT_START_148 -at_fn_group_banner 148 'syn_value.at:152' \ - "Alphabetic item" " " 2 -at_xfail=no -( - $as_echo "148. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 X-123 PIC AAA VALUE 123. - 01 X-ZERO PIC AAA VALUE ZERO. - 01 X-AB1 PIC AAA VALUE "ab1". - 01 X-ABC PIC AAA VALUE "abc". - 01 X-ABCD PIC AAA VALUE "abcd". - PROCEDURE DIVISION. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/syn_value.at:169: \$COMPILE_ONLY prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY prog.cob" "syn_value.at:169" -( $at_check_trace; $COMPILE_ONLY prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob:6: warning: alphanumeric value is expected -prog.cob:7: error: invalid VALUE clause -prog.cob:8: warning: value does not fit the picture string -prog.cob:10: warning: value size exceeds data size -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/syn_value.at:169" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_148 -#AT_START_149 -at_fn_group_banner 149 'syn_value.at:179' \ - "Alphanumeric item" " " 2 -at_xfail=no -( - $as_echo "149. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 X-123 PIC XXX VALUE 123. - 01 X-ABC PIC XXX VALUE "abc". - 01 X-ABCD PIC XXX VALUE "abcd". - 01 X-SPACE PIC XXX VALUE "abc ". - PROCEDURE DIVISION. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/syn_value.at:195: \$COMPILE_ONLY prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY prog.cob" "syn_value.at:195" -( $at_check_trace; $COMPILE_ONLY prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob:6: warning: alphanumeric value is expected -prog.cob:8: warning: value size exceeds data size -prog.cob:9: warning: value does not fit the picture string -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/syn_value.at:195" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_149 -#AT_START_150 -at_fn_group_banner 150 'syn_value.at:204' \ - "Alphanumeric group item" " " 2 -at_xfail=no -( - $as_echo "150. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 G-1 VALUE 123. - 02 X PIC XXX. - 01 G-2 VALUE "abc". - 02 X PIC XXX. - 01 G-3 VALUE "abcd". - 02 X PIC XXX. - PROCEDURE DIVISION. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/syn_value.at:222: \$COMPILE_ONLY prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY prog.cob" "syn_value.at:222" -( $at_check_trace; $COMPILE_ONLY prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob:6: warning: alphanumeric value is expected -prog.cob:10: warning: value size exceeds data size -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/syn_value.at:222" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_150 -#AT_START_151 -at_fn_group_banner 151 'syn_value.at:239' \ - "Numeric-edited item" " " 2 -at_xfail=no -( - $as_echo "151. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 X-SPACE PIC **99.00 VALUE SPACE. - 01 X-123 PIC **999.00 VALUE 123. - 01 X-ABC PIC **99.00 VALUE "abc". - 01 X-MATCH PIC **99.00 VALUE "*123.00". - 01 X-OVERFLOW PIC **99.00 VALUE "*123.000". - PROCEDURE DIVISION. - MOVE 320.00 TO X-123 - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/syn_value.at:257: \$COMPILE_ONLY prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY prog.cob" "syn_value.at:257" -( $at_check_trace; $COMPILE_ONLY prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob:10: warning: value size exceeds data size -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/syn_value.at:257" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/syn_value.at:260: \$COMPILE_ONLY -std=ibm-strict prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY -std=ibm-strict prog.cob" "syn_value.at:260" -( $at_check_trace; $COMPILE_ONLY -std=ibm-strict prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob:7: error: numeric literal in VALUE clause of numeric-edited item used -prog.cob:10: warning: value size exceeds data size -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/syn_value.at:260" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/syn_value.at:264: \$COMPILE_ONLY -std=ibm prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY -std=ibm prog.cob" "syn_value.at:264" -( $at_check_trace; $COMPILE_ONLY -std=ibm prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob:7: warning: numeric literal in VALUE clause of numeric-edited item used -prog.cob:10: warning: value size exceeds data size -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/syn_value.at:264" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_151 -#AT_START_152 -at_fn_group_banner 152 'syn_value.at:272' \ - "Alphanumeric-edited item" " " 2 -at_xfail=no -( - $as_echo "152. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 X-123 PIC BXX VALUE 123. - 01 X-ABC PIC BXX VALUE "abc". - 01 X-MATCH PIC BXX VALUE " ab". - 01 X-OVERFLOW PIC BXX VALUE " abc". - PROCEDURE DIVISION. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/syn_value.at:288: \$COMPILE_ONLY prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY prog.cob" "syn_value.at:288" -( $at_check_trace; $COMPILE_ONLY prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob:6: warning: alphanumeric value is expected -prog.cob:9: warning: value size exceeds data size -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/syn_value.at:288" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_152 -#AT_START_153 -at_fn_group_banner 153 'syn_value.at:340' \ - "Implicit picture from value" " " 2 -at_xfail=no -( - $as_echo "153. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 IMPHEAD. - 05 IMPPIC VALUE " abc". - PROCEDURE DIVISION. - DISPLAY IMPPIC END-DISPLAY - STOP RUN. -_ATEOF - - -# Check: should we raise an error without -frelax-syntax-checks? -#AT_CHECK([$COMPILE_ONLY prog.cob], [1], [], -#[prog.cob:7: error: PICTURE clause required for 'IMPPIC' -#]) - -{ set +x -$as_echo "$at_srcdir/syn_value.at:360: \$COMPILE_ONLY -frelax-syntax-checks prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY -frelax-syntax-checks prog.cob" "syn_value.at:360" -( $at_check_trace; $COMPILE_ONLY -frelax-syntax-checks prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob:7: warning: defining implicit picture size 4 for 'IMPPIC' -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/syn_value.at:360" -$at_failed && at_fn_log_failure -$at_traceon; } - - -{ set +x -$as_echo "$at_srcdir/syn_value.at:364: \$COMPILE_ONLY -frelax-syntax-checks -w prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY -frelax-syntax-checks -w prog.cob" "syn_value.at:364" -( $at_check_trace; $COMPILE_ONLY -frelax-syntax-checks -w prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/syn_value.at:364" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_153 -#AT_START_154 -at_fn_group_banner 154 'syn_file.at:23' \ - "Missing SELECT" " " 2 -at_xfail=no -( - $as_echo "154. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - INPUT-OUTPUT SECTION. - FILE-CONTROL. - SELECT file2 ASSIGN DISK. - DATA DIVISION. - FILE SECTION. - FD file1. - 01 file1-rec PIC X. - FD file2. - 01 file2-rec PIC X. - PROCEDURE DIVISION. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/syn_file.at:43: \$COMPILE_ONLY prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY prog.cob" "syn_file.at:43" -( $at_check_trace; $COMPILE_ONLY prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob:10: error: 'file1' is not defined -prog.cob:10: error: 'file1' is not a file name -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/syn_file.at:43" -$at_failed && at_fn_log_failure -$at_traceon; } - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_154 -#AT_START_155 -at_fn_group_banner 155 'syn_file.at:50' \ - "Duplicated SELECT" " " 2 -at_xfail=no -( - $as_echo "155. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - INPUT-OUTPUT SECTION. - FILE-CONTROL. - SELECT file1 ASSIGN DISK. - SELECT file2 ASSIGN DISK. - SELECT file1 ASSIGN DISK. - DATA DIVISION. - FILE SECTION. - FD file1. - 01 file1-rec PIC X. - FD file2. - 01 file2-rec PIC X. - PROCEDURE DIVISION. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/syn_file.at:72: \$COMPILE_ONLY prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY prog.cob" "syn_file.at:72" -( $at_check_trace; $COMPILE_ONLY prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob:9: error: redefinition of 'file1' -prog.cob:7: error: 'file1' previously defined here -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/syn_file.at:72" -$at_failed && at_fn_log_failure -$at_traceon; } - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_155 -#AT_START_156 -at_fn_group_banner 156 'syn_file.at:81' \ - "Missing FD" " " 2 -at_xfail=no -( - $as_echo "156. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - INPUT-OUTPUT SECTION. - FILE-CONTROL. - SELECT file1 ASSIGN DISK. - SELECT file2 ASSIGN DISK. - DATA DIVISION. - FILE SECTION. - FD file2. - 01 file2-rec PIC X. - PROCEDURE DIVISION. - OPEN input file1 - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/syn_file.at:101: \$COMPILE_ONLY prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY prog.cob" "syn_file.at:101" -( $at_check_trace; $COMPILE_ONLY prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob:7: error: missing file description for FILE file1 -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/syn_file.at:101" -$at_failed && at_fn_log_failure -$at_traceon; } - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_156 -#AT_START_157 -at_fn_group_banner 157 'syn_file.at:107' \ - "Duplicated FD" " " 2 -at_xfail=no -( - $as_echo "157. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - INPUT-OUTPUT SECTION. - FILE-CONTROL. - SELECT file1 ASSIGN DISK. - SELECT file2 ASSIGN DISK. - DATA DIVISION. - FILE SECTION. - FD file1. - 01 file1-rec PIC X. - FD file2. - 01 file2-rec PIC X. - FD file1. - 01 file1-rec-2 PIC X. - PROCEDURE DIVISION. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/syn_file.at:130: \$COMPILE_ONLY prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY prog.cob" "syn_file.at:130" -( $at_check_trace; $COMPILE_ONLY prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob:15: error: duplicate file description for FILE file1 -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/syn_file.at:130" -$at_failed && at_fn_log_failure -$at_traceon; } - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_157 -#AT_START_158 -at_fn_group_banner 158 'syn_file.at:136' \ - "ASSIGN to device-name" " " 2 -at_xfail=no -( - $as_echo "158. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - INPUT-OUTPUT SECTION. - FILE-CONTROL. - SELECT TEST-FILE ASSIGN TO DISK - ORGANIZATION IS SEQUENTIAL. - DATA DIVISION. - FILE SECTION. - FD TEST-FILE. - 01 TEST-REC PIC X(4). - PROCEDURE DIVISION. - OPEN INPUT TEST-FILE. - CLOSE TEST-FILE. - STOP RUN. -_ATEOF - - -cat >prog2.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog2. - ENVIRONMENT DIVISION. - INPUT-OUTPUT SECTION. - FILE-CONTROL. - SELECT TEST-FILE ASSIGN TO DISK 'TFILE' - ORGANIZATION IS SEQUENTIAL. - DATA DIVISION. - FILE SECTION. - FD TEST-FILE. - 01 TEST-REC PIC X(4). - PROCEDURE DIVISION. - OPEN INPUT TEST-FILE. - CLOSE TEST-FILE. - STOP RUN. -_ATEOF - - -cat >prog3.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog3. - ENVIRONMENT DIVISION. - INPUT-OUTPUT SECTION. - FILE-CONTROL. - SELECT TEST-FILE ASSIGN TO DISK FNAME OF F1 - ORGANIZATION IS SEQUENTIAL. - DATA DIVISION. - FILE SECTION. - FD TEST-FILE. - 01 TEST-REC PIC X(4). - WORKING-STORAGE SECTION. - 01 F1. - 05 FNAME PIC X(255) VALUE 'TFILEOF'. - PROCEDURE DIVISION. - OPEN INPUT TEST-FILE. - CLOSE TEST-FILE. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/syn_file.at:196: \$COMPILE_ONLY -std=acu prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY -std=acu prog.cob" "syn_file.at:196" -( $at_check_trace; $COMPILE_ONLY -std=acu prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/syn_file.at:196" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/syn_file.at:197: \$COMPILE_ONLY -std=acu prog2.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY -std=acu prog2.cob" "syn_file.at:197" -( $at_check_trace; $COMPILE_ONLY -std=acu prog2.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/syn_file.at:197" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/syn_file.at:198: \$COMPILE_ONLY -std=acu prog3.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY -std=acu prog3.cob" "syn_file.at:198" -( $at_check_trace; $COMPILE_ONLY -std=acu prog3.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/syn_file.at:198" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_158 -#AT_START_159 -at_fn_group_banner 159 'syn_file.at:203' \ - "ASSIGN to printer-name" " " 2 -at_xfail=no -( - $as_echo "159. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - INPUT-OUTPUT SECTION. - FILE-CONTROL. - SELECT TEST-FILE ASSIGN TO PRINT - ORGANIZATION IS SEQUENTIAL. - DATA DIVISION. - FILE SECTION. - FD TEST-FILE. - 01 TEST-REC PIC X(4). - PROCEDURE DIVISION. - OPEN INPUT TEST-FILE. - CLOSE TEST-FILE. - STOP RUN. -_ATEOF - - -cat >prog2.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog2. - ENVIRONMENT DIVISION. - INPUT-OUTPUT SECTION. - FILE-CONTROL. - SELECT TEST-FILE ASSIGN TO PRINTER 'PFILE' - ORGANIZATION IS SEQUENTIAL. - DATA DIVISION. - FILE SECTION. - FD TEST-FILE. - 01 TEST-REC PIC X(4). - PROCEDURE DIVISION. - OPEN INPUT TEST-FILE. - CLOSE TEST-FILE. - STOP RUN. -_ATEOF - - -cat >prog3.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog3. - ENVIRONMENT DIVISION. - INPUT-OUTPUT SECTION. - FILE-CONTROL. - SELECT TEST-FILE ASSIGN TO PRINTER-1 FNAME OF F1 - ORGANIZATION IS SEQUENTIAL. - DATA DIVISION. - FILE SECTION. - FD TEST-FILE. - 01 TEST-REC PIC X(4). - WORKING-STORAGE SECTION. - 01 F1. - 05 FNAME PIC X(255) VALUE 'PFILEOF'. - PROCEDURE DIVISION. - OPEN INPUT TEST-FILE. - CLOSE TEST-FILE. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/syn_file.at:263: \$COMPILE_ONLY -std=acu prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY -std=acu prog.cob" "syn_file.at:263" -( $at_check_trace; $COMPILE_ONLY -std=acu prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/syn_file.at:263" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/syn_file.at:264: \$COMPILE_ONLY -std=acu prog2.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY -std=acu prog2.cob" "syn_file.at:264" -( $at_check_trace; $COMPILE_ONLY -std=acu prog2.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/syn_file.at:264" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/syn_file.at:265: \$COMPILE_ONLY -std=acu prog3.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY -std=acu prog3.cob" "syn_file.at:265" -( $at_check_trace; $COMPILE_ONLY -std=acu prog3.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/syn_file.at:265" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_159 -#AT_START_160 -at_fn_group_banner 160 'syn_file.at:270' \ - "ASSIGN to lsq-device-name" " " 2 -at_xfail=no -( - $as_echo "160. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - INPUT-OUTPUT SECTION. - FILE-CONTROL. - SELECT TST-FILE1 ASSIGN TO CARD-PUNCH "F1". - SELECT TST-FILE2 ASSIGN TO CARD-READER "F2". - SELECT TST-FILE3 ASSIGN TO CASSETTE "F3". - SELECT TST-FILE4 ASSIGN TO INPUT "F4". - SELECT TST-FILE5 ASSIGN TO INPUT-OUTPUT. - SELECT TST-FILE6 ASSIGN TO MAGNETIC-TAPE. - SELECT TST-FILE7 ASSIGN TO OUTPUT "F7". - DATA DIVISION. - FILE SECTION. - FD TST-FILE1. - 01 TST1-REC PIC X(4). - FD TST-FILE2. - 01 TST2-REC PIC X(4). - FD TST-FILE3. - 01 TST3-REC PIC X(4). - FD TST-FILE4. - 01 TST4-REC PIC X(4). - FD TST-FILE5. - 01 TST5-REC PIC X(4). - FD TST-FILE6. - 01 TST6-REC PIC X(4). - FD TST-FILE7. - 01 TST7-REC PIC X(4). - PROCEDURE DIVISION. - OPEN INPUT TST-FILE1. - CLOSE TST-FILE1. - OPEN INPUT TST-FILE2. - CLOSE TST-FILE2. - OPEN INPUT TST-FILE3. - CLOSE TST-FILE3. - OPEN INPUT TST-FILE4. - CLOSE TST-FILE4. - OPEN INPUT TST-FILE5. - CLOSE TST-FILE5. - OPEN INPUT TST-FILE6. - CLOSE TST-FILE6. - OPEN INPUT TST-FILE7. - CLOSE TST-FILE7. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/syn_file.at:320: \$COMPILE_ONLY -std=acu prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY -std=acu prog.cob" "syn_file.at:320" -( $at_check_trace; $COMPILE_ONLY -std=acu prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/syn_file.at:320" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_160 -#AT_START_161 -at_fn_group_banner 161 'syn_file.at:325' \ - "ASSIGN to variable" " " 2 -at_xfail=no -( - $as_echo "161. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -# Valid ASSIGNs -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - INPUT-OUTPUT SECTION. - FILE-CONTROL. - SELECT test-file-1 ASSIGN TO var-1 - ORGANIZATION IS SEQUENTIAL. - SELECT test-file-2 ASSIGN USING var-2 - ORGANIZATION IS SEQUENTIAL. - SELECT test-file-3 ASSIGN TO VARYING var-3 - ORGANIZATION IS SEQUENTIAL. - SELECT test-file-4 ASSIGN DISK USING var-4 - ORGANIZATION IS SEQUENTIAL. - SELECT test-file-5 ASSIGN DYNAMIC DISK var-5 - ORGANIZATION IS SEQUENTIAL. - SELECT test-file-6 ASSIGN DISK FROM var-6 - ORGANIZATION IS SEQUENTIAL. - DATA DIVISION. - FILE SECTION. - FD test-file-1. - 01 test-rec-1 PIC X(4). - FD test-file-2. - 01 test-rec-2 PIC X(4). - FD test-file-3. - 01 test-rec-3 PIC X(4). - FD test-file-4. - 01 test-rec-4 PIC X(4). - FD test-file-5. - 01 test-rec-5 PIC X(4). - FD test-file-6. - 01 test-rec-6 PIC X(4). - WORKING-STORAGE SECTION. - 01 var-1 PIC X(255). - 01 var-2 PIC X(255). - 01 var-3 PIC X(255). - 01 var-4 PIC X(255). - 01 var-5 PIC X(255). - 01 var-6 PIC X(255). - PROCEDURE DIVISION. - OPEN INPUT test-file-1 - CLOSE test-file-1 - OPEN INPUT test-file-2 - CLOSE test-file-2 - OPEN INPUT test-file-3 - CLOSE test-file-3 - OPEN INPUT test-file-4 - CLOSE test-file-4 - OPEN INPUT test-file-5 - CLOSE test-file-5 - OPEN INPUT test-file-6 - CLOSE test-file-6 - . -_ATEOF - - -# Invalid assigns -cat >prog2.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - INPUT-OUTPUT SECTION. - FILE-CONTROL. - SELECT test-file-1 ASSIGN USING not-a-var - ORGANIZATION IS SEQUENTIAL. - SELECT test-file-2 ASSIGN DYNAMIC not-a-var - ORGANIZATION IS SEQUENTIAL. - SELECT test-file-3 ASSIGN DISK FROM not-a-var - ORGANIZATION IS SEQUENTIAL. - DATA DIVISION. - FILE SECTION. - FD test-file-1. - 01 test-rec-1 PIC X(4). - FD test-file-2. - 01 test-rec-2 PIC X(4). - FD test-file-3. - 01 test-rec-3 PIC X(4). - PROCEDURE DIVISION. - OPEN INPUT test-file-1 - CLOSE test-file-1 - OPEN INPUT test-file-2 - CLOSE test-file-2 - OPEN INPUT test-file-3 - CLOSE test-file-3 - . -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/syn_file.at:415: \$COMPILE_ONLY -fassign-variable=warning -fassign-using-variable=warning -fassign-ext-dyn=warning -fassign-disk-from=warning prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY -fassign-variable=warning -fassign-using-variable=warning -fassign-ext-dyn=warning -fassign-disk-from=warning prog.cob" "syn_file.at:415" -( $at_check_trace; $COMPILE_ONLY -fassign-variable=warning -fassign-using-variable=warning -fassign-ext-dyn=warning -fassign-disk-from=warning prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob:10: warning: ASSIGN USING/VARYING variable used -prog.cob:12: warning: ASSIGN USING/VARYING variable used -prog.cob:14: warning: ASSIGN USING/VARYING variable used -prog.cob:15: warning: ASSIGN EXTERNAL/DYNAMIC used -prog.cob:18: warning: ASSIGN DISK FROM used -prog.cob:7: warning: ASSIGN variable used -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/syn_file.at:415" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/syn_file.at:423: \$COMPILE_ONLY prog2.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY prog2.cob" "syn_file.at:423" -( $at_check_trace; $COMPILE_ONLY prog2.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog2.cob:11: error: 'not-a-var' is not defined -prog2.cob:9: error: 'not-a-var' is not defined -prog2.cob:7: error: 'not-a-var' is not defined -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/syn_file.at:423" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_161 -#AT_START_162 -at_fn_group_banner 162 'syn_file.at:432' \ - "SELECT without ASSIGN" " " 2 -at_xfail=no -( - $as_echo "162. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - INPUT-OUTPUT SECTION. - FILE-CONTROL. - SELECT TEST-FILE - ORGANIZATION IS SEQUENTIAL. - DATA DIVISION. - FILE SECTION. - FD TEST-FILE. - 01 TEST-REC PIC X(4). - PROCEDURE DIVISION. - OPEN INPUT TEST-FILE. - CLOSE TEST-FILE. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/syn_file.at:453: \$COMPILE_ONLY prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY prog.cob" "syn_file.at:453" -( $at_check_trace; $COMPILE_ONLY prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob:7: error: ASSIGN clause is required for file 'TEST-FILE' -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/syn_file.at:453" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_162 -#AT_START_163 -at_fn_group_banner 163 'syn_file.at:460' \ - "START on SEQUENTIAL file" " " 2 -at_xfail=no -( - $as_echo "163. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - INPUT-OUTPUT SECTION. - FILE-CONTROL. - SELECT TEST-FILE ASSIGN "./TEST-FILE" - ORGANIZATION IS SEQUENTIAL. - SELECT TEST-FILE2 ASSIGN "./TEST-FILE" - ORGANIZATION IS LINE SEQUENTIAL. - DATA DIVISION. - FILE SECTION. - FD TEST-FILE. - 01 TEST-REC PIC X(4). - FD TEST-FILE2. - 01 TEST-REC2 PIC X(4). - PROCEDURE DIVISION. - OPEN INPUT TEST-FILE TEST-FILE2 - START TEST-FILE KEY EQUAL TEST-REC - END-START - START TEST-FILE2 KEY EQUAL TEST-REC2 - END-START - CLOSE TEST-FILE TEST-FILE2 - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/syn_file.at:489: \$COMPILE_ONLY prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY prog.cob" "syn_file.at:489" -( $at_check_trace; $COMPILE_ONLY prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob:19: error: START not allowed on SEQUENTIAL files -prog.cob:21: error: START not allowed on SEQUENTIAL files -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/syn_file.at:489" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_163 -#AT_START_164 -at_fn_group_banner 164 'syn_file.at:497' \ - "OPEN SEQUENTIAL file REVERSED" " " 2 -at_xfail=no -( - $as_echo "164. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -# FIXME: only allowed for INPUT + sequential files (currently not checked). -# If added we likely can allow this for LINE SEQUENTIAL, too. - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - INPUT-OUTPUT SECTION. - FILE-CONTROL. - SELECT TEST-FILE ASSIGN "./TEST-FILE" - ORGANIZATION IS SEQUENTIAL. - DATA DIVISION. - FILE SECTION. - FD TEST-FILE. - 01 TEST-REC PIC X(4). - PROCEDURE DIVISION. - OPEN INPUT TEST-FILE - READ TEST-FILE NEXT - END-READ - CLOSE TEST-FILE - OPEN INPUT TEST-FILE REVERSED - READ TEST-FILE NEXT - END-READ - CLOSE TEST-FILE - OPEN INPUT TEST-FILE WITH LOCK REVERSED - READ TEST-FILE NEXT - END-READ - CLOSE TEST-FILE - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/syn_file.at:531: \$COMPILE_ONLY prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY prog.cob" "syn_file.at:531" -( $at_check_trace; $COMPILE_ONLY prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob:18: warning: OPEN REVERSED is not implemented -prog.cob:22: warning: OPEN REVERSED is not implemented -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/syn_file.at:531" -$at_failed && at_fn_log_failure -$at_traceon; } - - -# note: as soon as implemented: won't be obsolete in GnuCOBOL, but leave message for now... -{ set +x -$as_echo "$at_srcdir/syn_file.at:537: \$COMPILE_ONLY -Werror=obsolete prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY -Werror=obsolete prog.cob" "syn_file.at:537" -( $at_check_trace; $COMPILE_ONLY -Werror=obsolete prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob:18: error [-Werror]: OPEN REVERSED is obsolete in GnuCOBOL -prog.cob:22: error [-Werror]: OPEN REVERSED is obsolete in GnuCOBOL -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/syn_file.at:537" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_164 -#AT_START_165 -at_fn_group_banner 165 'syn_file.at:545' \ - "OPEN SEQUENTIAL file NO REWIND" " " 2 -at_xfail=no -( - $as_echo "165. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -# FIXME: only allowed for INPUT/OUTPUT sequential files (currently not checked). - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - INPUT-OUTPUT SECTION. - FILE-CONTROL. - SELECT TEST-FILE ASSIGN "./TEST-FILE" - ORGANIZATION IS SEQUENTIAL. - DATA DIVISION. - FILE SECTION. - FD TEST-FILE. - 01 TEST-REC PIC X(4). - PROCEDURE DIVISION. - OPEN OUTPUT TEST-FILE NO REWIND - WRITE TEST-REC FROM "tEsT" - END-WRITE - WRITE TEST-REC FROM "TeSt" - END-WRITE - CLOSE TEST-FILE WITH NO REWIND - OPEN INPUT TEST-FILE WITH LOCK WITH NO REWIND - READ TEST-FILE NEXT *> should get EOF - END-READ - CLOSE TEST-FILE - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/syn_file.at:576: \$COMPILE_ONLY prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY prog.cob" "syn_file.at:576" -( $at_check_trace; $COMPILE_ONLY prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob:14: warning: OPEN WITH NO REWIND is not implemented -prog.cob:20: warning: OPEN WITH NO REWIND is not implemented -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/syn_file.at:576" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_165 -#AT_START_166 -at_fn_group_banner 166 'syn_file.at:584' \ - "valid key items" " " 2 -at_xfail=no -( - $as_echo "166. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - INPUT-OUTPUT SECTION. - FILE-CONTROL. - SELECT TEST-SOME ASSIGN TO 'FILE-TEST' - ORGANIZATION IS INDEXED - ACCESS MODE IS DYNAMIC - RECORD KEY IS TEST-P2 IN TEST-SOME - ALTERNATE KEY IS TEST-P3 IN TEST-SOME. - SELECT TEST-FILE ASSIGN TO 'FILE-TEST2' - ORGANIZATION IS INDEXED - ACCESS MODE IS DYNAMIC - RECORD KEY IS TEST-P1 - ALTERNATE KEY IS TEST-P4. - DATA DIVISION. - FILE SECTION. - FD TEST-SOME. - 01 SOME-REC. - 05 TEST-P2 PIC S9(4) COMP. - 05 TEST-P3 PIC S9(5) COMP-3. - FD TEST-FILE. - 01 TEST-REC. - 05 TEST-P1 PIC X(4). - 05 FILLER PIC X(4). - 05 TEST-P4 PIC X(4). - WORKING-STORAGE SECTION. - 01 WS-REC. - 05 TEST-P2 PIC S9(4) COMP. - 05 TEST-P3 PIC S9(5) COMP-3. - PROCEDURE DIVISION. - OPEN INPUT TEST-FILE - CLOSE TEST-FILE - OPEN OUTPUT TEST-SOME - MOVE CORRESPONDING WS-REC TO SOME-REC - WRITE SOME-REC - CLOSE TEST-SOME - * - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/syn_file.at:629: \$COMPILE_ONLY prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY prog.cob" "syn_file.at:629" -( $at_check_trace; $COMPILE_ONLY prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/syn_file.at:629" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_166 -#AT_START_167 -at_fn_group_banner 167 'syn_file.at:634' \ - "INDEXED file invalid key items" " " 2 -at_xfail=no -( - $as_echo "167. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - INPUT-OUTPUT SECTION. - FILE-CONTROL. - SELECT TEST-SOME ASSIGN TO 'FILE-TEST' - ORGANIZATION IS INDEXED - ACCESS MODE IS DYNAMIC - RECORD KEY IS TEST-P2 - ALTERNATE KEY IS TEST-P1 - ALTERNATE KEY IS TEST-P3. - SELECT TEST-FILE ASSIGN TO 'FILE-TEST2' - ORGANIZATION IS INDEXED - ACCESS MODE IS DYNAMIC - RECORD KEY IS TEST-P1 - ALTERNATE KEY IS TEST-P4 - ALTERNATE KEY IS NOT-THERE - ALTERNATE KEY IS SOME-REC. - SELECT TEST-MORE ASSIGN TO 'FILE-TEST-EXT' - ORGANIZATION IS INDEXED - ACCESS MODE IS DYNAMIC - RECORD KEY IS NOT-HERE-KEY - SOURCE IS NOT-IN-FILE1 - NOT-IN-FILE2. - DATA DIVISION. - FILE SECTION. - FD TEST-SOME. - 01 SOME-REC PIC X(20). - FD TEST-FILE. - 01 TEST-REC. - 05 TEST-P1 PIC X(4). - 05 FILLER PIC X(4). - 05 TEST-P4 PIC X(4). - FD TEST-MORE. - 01 MORE-REC. - 05 MORE-DATA PIC X(4). - WORKING-STORAGE SECTION. - 77 TEST-P2 PIC S9(4) COMP. - 77 TEST-P3 PIC S9(5) COMP-3. - PROCEDURE DIVISION. - OPEN INPUT TEST-FILE. - CLOSE TEST-FILE. - STOP RUN. -_ATEOF - - -# FIXME: "is not defined" should be changed in "is not defined in file ..." -{ set +x -$as_echo "$at_srcdir/syn_file.at:684: \$COMPILE_ONLY prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY prog.cob" "syn_file.at:684" -( $at_check_trace; $COMPILE_ONLY prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob:10: error: 'TEST-P2' is not defined -prog.cob:11: error: 'TEST-P1' is not defined -prog.cob:12: error: 'TEST-P3' is not defined -prog.cob:18: error: 'NOT-THERE' is not defined -prog.cob:13: error: invalid KEY item 'SOME-REC', not in file 'TEST-FILE' -prog.cob:24: error: 'NOT-IN-FILE1' is not defined -prog.cob:20: error: invalid KEY item 'NOT-HERE-KEY', not in file 'TEST-MORE' -prog.cob:25: error: 'NOT-IN-FILE2' is not defined -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/syn_file.at:684" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_167 -#AT_START_168 -at_fn_group_banner 168 'syn_file.at:698' \ - "variable record length" " " 2 -at_xfail=no -( - $as_echo "168. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - INPUT-OUTPUT SECTION. - FILE-CONTROL. - SELECT TEST-FILE ASSIGN TO 'FILE-TEST' - ORGANIZATION IS SEQUENTIAL. - DATA DIVISION. - FILE SECTION. - FD TEST-FILE - RECORD IS VARYING IN SIZE - RECORD CONTAINS 1 TO 1250 CHARACTERS. - 01 TEST-REC. - 05 TEST-P1 PIC X(4). - 05 TEST-P2 PIC S9(4) COMP. - 05 TEST-P3 PIC S9(5) COMP-3. - 05 TEST-P4 PIC S9(5). - 05 TEST-P5 PIC S9(2) BINARY. - 05 FILLER PIC X(129). - PROCEDURE DIVISION. - OPEN INPUT TEST-FILE. - CLOSE TEST-FILE. - STOP RUN. -_ATEOF - - -cat >prog2.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog2. - ENVIRONMENT DIVISION. - INPUT-OUTPUT SECTION. - FILE-CONTROL. - SELECT TEST-FILE ASSIGN TO 'FILE-TEST' - ORGANIZATION IS INDEXED - ACCESS MODE IS DYNAMIC - RECORD KEY IS TEST-P2 - ALTERNATE KEY IS TEST-P1 - ALTERNATE KEY IS TEST-P3. - DATA DIVISION. - FILE SECTION. - FD TEST-FILE - RECORD IS VARYING IN SIZE - FROM 2 TO 1250 CHARACTERS. - 01 TEST-REC. - 05 TEST-P1 PIC X(4). - 05 TEST-P2 PIC S9(4) COMP. - 05 TEST-P3 PIC S9(5) COMP-3. - 05 TEST-P4 PIC S9(5). - 05 TEST-P5 PIC S9(2) BINARY. - 05 FILLER PIC X(129). - 01 RECORDSIZE PIC X(04). - PROCEDURE DIVISION. - OPEN INPUT TEST-FILE. - CLOSE TEST-FILE. - STOP RUN. -_ATEOF - - -cat >prog3.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog3. - ENVIRONMENT DIVISION. - INPUT-OUTPUT SECTION. - FILE-CONTROL. - SELECT TEST-FILE ASSIGN TO 'FILE-TEST' - ORGANIZATION IS SEQUENTIAL. - DATA DIVISION. - FILE SECTION. - FD TEST-FILE - RECORD CONTAINS 5 TO 10 CHARACTERS. - 01 TEST-REC-1. - 05 FILLER PIC X(4). - 01 TEST-REC-2. - 05 FILLER PIC X(50). - PROCEDURE DIVISION. - OPEN INPUT TEST-FILE. - CLOSE TEST-FILE. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/syn_file.at:780: \$COMPILE_ONLY prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY prog.cob" "syn_file.at:780" -( $at_check_trace; $COMPILE_ONLY prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob:13: error: duplicate RECORD clause -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/syn_file.at:780" -$at_failed && at_fn_log_failure -$at_traceon; } - - -{ set +x -$as_echo "$at_srcdir/syn_file.at:784: \$COMPILE_ONLY -frelax-syntax-checks prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY -frelax-syntax-checks prog.cob" "syn_file.at:784" -( $at_check_trace; $COMPILE_ONLY -frelax-syntax-checks prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob:13: warning: duplicate RECORD clause -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/syn_file.at:784" -$at_failed && at_fn_log_failure -$at_traceon; } - - -{ set +x -$as_echo "$at_srcdir/syn_file.at:788: \$COMPILE_ONLY prog2.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY prog2.cob" "syn_file.at:788" -( $at_check_trace; $COMPILE_ONLY prog2.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog2.cob:20: error: minimal record length 2 can not hold the key item 'TEST-P2'; needs to be at least 6 -prog2.cob:19: error: minimal record length 2 can not hold the key item 'TEST-P1'; needs to be at least 4 -prog2.cob:21: error: minimal record length 2 can not hold the key item 'TEST-P3'; needs to be at least 9 -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/syn_file.at:788" -$at_failed && at_fn_log_failure -$at_traceon; } - - -{ set +x -$as_echo "$at_srcdir/syn_file.at:794: \$COMPILE_ONLY -std=cobol2014 prog3.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY -std=cobol2014 prog3.cob" "syn_file.at:794" -( $at_check_trace; $COMPILE_ONLY -std=cobol2014 prog3.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog3.cob:13: error: size of record 'TEST-REC-1' (4) smaller than minimum of file 'TEST-FILE' (5) -prog3.cob:15: error: size of record 'TEST-REC-2' (50) larger than maximum of file 'TEST-FILE' (10) -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/syn_file.at:794" -$at_failed && at_fn_log_failure -$at_traceon; } - - -{ set +x -$as_echo "$at_srcdir/syn_file.at:799: \$COMPILE_ONLY prog3.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY prog3.cob" "syn_file.at:799" -( $at_check_trace; $COMPILE_ONLY prog3.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog3.cob:13: warning: size of record 'TEST-REC-1' (4) smaller than minimum of file 'TEST-FILE' (5) -prog3.cob:13: warning: file size adjusted -prog3.cob:15: warning: size of record 'TEST-REC-2' (50) larger than maximum of file 'TEST-FILE' (10) -prog3.cob:15: warning: file size adjusted -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/syn_file.at:799" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_168 -#AT_START_169 -at_fn_group_banner 169 'syn_file.at:809' \ - "variable record length DEPENDING item" " " 2 -at_xfail=no -( - $as_echo "169. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - INPUT-OUTPUT SECTION. - FILE-CONTROL. - SELECT TEST-FILE ASSIGN TO 'FILE-TEST' - ORGANIZATION IS SEQUENTIAL. - SELECT TEST-FIL2 ASSIGN TO 'FILE-TEST-2' - ORGANIZATION IS SEQUENTIAL. - SELECT TEST-FIL3 ASSIGN TO 'FILE-TEST-3' - ORGANIZATION IS SEQUENTIAL. - SELECT TEST-FIL4 ASSIGN TO 'FILE-TEST-4' - ORGANIZATION IS SEQUENTIAL. - DATA DIVISION. - FILE SECTION. - FD TEST-FILE - RECORD IS VARYING IN SIZE - FROM 12 TO 125 CHARACTERS - DEPENDING ON RECORDSIZE. - 01 TEST-REC. - 05 FILLER PIC X(40). - FD TEST-FIL2 - RECORD IS VARYING IN SIZE - FROM 20 TO 250 CHARACTERS - DEPENDING ON TEST-FILE. - 01 TEST-REC2. - 05 FILLER PIC X(129). - 05 RECORDSIZE3 PIC 9(04). - 05 RECORDSIZE4 PIC X(04). - FD TEST-FIL3 - RECORD IS VARYING IN SIZE - FROM 40 TO 50 CHARACTERS - DEPENDING ON RECORDSIZE3. - 01 TEST-REC3. - 05 FILLER PIC X(50). - FD TEST-FIL4 - RECORD IS VARYING IN SIZE - FROM 1 TO 2 CHARACTERS - DEPENDING ON RECORDSIZE4. - 01 TEST-REC4. - 05 FILLER PIC X(2). - PROCEDURE DIVISION. - OPEN INPUT TEST-FILE. - CLOSE TEST-FILE. - OPEN INPUT TEST-FIL2. - CLOSE TEST-FIL2. - OPEN INPUT TEST-FIL3. - CLOSE TEST-FIL3. - OPEN INPUT TEST-FIL4. - CLOSE TEST-FIL4. - STOP RUN. -_ATEOF - - -# FIXME: the check misses "prog.cob:40: error: RECORD DEPENDING item must be unsigned numeric" -{ set +x -$as_echo "$at_srcdir/syn_file.at:867: \$COMPILE_ONLY prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY prog.cob" "syn_file.at:867" -( $at_check_trace; $COMPILE_ONLY prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob:20: error: 'RECORDSIZE' is not defined -prog.cob:26: error: RECORD DEPENDING must reference a data-item -prog.cob:34: error: RECORD DEPENDING item 'RECORDSIZE3' should be defined in WORKING-STORAGE, LOCAL-STORAGE or LINKAGE SECTION -prog.cob:40: error: RECORD DEPENDING item 'RECORDSIZE4' should be defined in WORKING-STORAGE, LOCAL-STORAGE or LINKAGE SECTION -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/syn_file.at:867" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/syn_file.at:873: \$COMPILE_ONLY -frelax-syntax-checks prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY -frelax-syntax-checks prog.cob" "syn_file.at:873" -( $at_check_trace; $COMPILE_ONLY -frelax-syntax-checks prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob:20: error: 'RECORDSIZE' is not defined -prog.cob:26: error: RECORD DEPENDING must reference a data-item -prog.cob:34: warning: RECORD DEPENDING item 'RECORDSIZE3' should be defined in WORKING-STORAGE, LOCAL-STORAGE or LINKAGE SECTION -prog.cob:40: warning: RECORD DEPENDING item 'RECORDSIZE4' should be defined in WORKING-STORAGE, LOCAL-STORAGE or LINKAGE SECTION -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/syn_file.at:873" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_169 -#AT_START_170 -at_fn_group_banner 170 'syn_file.at:883' \ - "DECLARATIVES invalid procedure reference (1)" " " 2 -at_xfail=no -( - $as_echo "170. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - INPUT-OUTPUT SECTION. - FILE-CONTROL. - SELECT GO-FILE ASSIGN "./TEST-FILE" - ORGANIZATION IS LINE SEQUENTIAL. - SELECT PERF-FILE ASSIGN "./TEST-FILE" - ORGANIZATION IS LINE SEQUENTIAL. - DATA DIVISION. - FILE SECTION. - FD GO-FILE. - 01 GO-REC PIC X(4). - FD PERF-FILE. - 01 PERF-REC PIC X(4). - PROCEDURE DIVISION. - DECLARATIVES. - G01 SECTION. - USE AFTER ERROR PROCEDURE ON GO-FILE. - G02. - DISPLAY "OK" - END-DISPLAY. - GO TO GG02. - P01 SECTION. - USE AFTER ERROR PROCEDURE ON PERF-FILE. - P02. - DISPLAY "OK" - END-DISPLAY. - * programs may do this -> nothing happens there with PERF-FILE - PERFORM PPOK. - * programs should not do this - * (the compiler currently cannot distinguish this) - PERFORM PP02. - END DECLARATIVES. - GG01 SECTION. - GG02. - OPEN INPUT GO-FILE. - CLOSE GO-FILE. - PP01 SECTION. - PP02. - OPEN INPUT PERF-FILE. - CLOSE PERF-FILE. - PP03. - DISPLAY 'LOG OUTPUT HERE'. - PPOK. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/syn_file.at:935: \$COMPILE_ONLY -Wno-dialect prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY -Wno-dialect prog.cob" "syn_file.at:935" -( $at_check_trace; $COMPILE_ONLY -Wno-dialect prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/syn_file.at:935" -$at_failed && at_fn_log_failure -$at_traceon; } - - -{ set +x -$as_echo "$at_srcdir/syn_file.at:937: \$COMPILE_ONLY prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY prog.cob" "syn_file.at:937" -( $at_check_trace; $COMPILE_ONLY prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob: in section 'G01': -prog.cob: in paragraph 'G02': -prog.cob:24: warning: 'GG02' is not in DECLARATIVES -prog.cob: in section 'P01': -prog.cob: in paragraph 'P02': -prog.cob:31: warning: 'PPOK' is not in DECLARATIVES -prog.cob:34: warning: 'PP02' is not in DECLARATIVES -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/syn_file.at:937" -$at_failed && at_fn_log_failure -$at_traceon; } - - -{ set +x -$as_echo "$at_srcdir/syn_file.at:947: \$COMPILE_ONLY -freference-out-of-declaratives=ok prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY -freference-out-of-declaratives=ok prog.cob" "syn_file.at:947" -( $at_check_trace; $COMPILE_ONLY -freference-out-of-declaratives=ok prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/syn_file.at:947" -$at_failed && at_fn_log_failure -$at_traceon; } - - -{ set +x -$as_echo "$at_srcdir/syn_file.at:949: \$COMPILE_ONLY -std=cobol2014 prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY -std=cobol2014 prog.cob" "syn_file.at:949" -( $at_check_trace; $COMPILE_ONLY -std=cobol2014 prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob: in section 'G01': -prog.cob: in paragraph 'G02': -prog.cob:24: error: 'GG02' is not in DECLARATIVES -prog.cob: in section 'P01': -prog.cob: in paragraph 'P02': -prog.cob:31: error: 'PPOK' is not in DECLARATIVES -prog.cob:34: error: 'PP02' is not in DECLARATIVES -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/syn_file.at:949" -$at_failed && at_fn_log_failure -$at_traceon; } - - -{ set +x -$as_echo "$at_srcdir/syn_file.at:959: \$COMPILE_ONLY -std=cobol2014 -frelax-syntax prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY -std=cobol2014 -frelax-syntax prog.cob" "syn_file.at:959" -( $at_check_trace; $COMPILE_ONLY -std=cobol2014 -frelax-syntax prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob: in section 'G01': -prog.cob: in paragraph 'G02': -prog.cob:24: warning: 'GG02' is not in DECLARATIVES -prog.cob: in section 'P01': -prog.cob: in paragraph 'P02': -prog.cob:31: warning: 'PPOK' is not in DECLARATIVES -prog.cob:34: warning: 'PP02' is not in DECLARATIVES -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/syn_file.at:959" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_170 -#AT_START_171 -at_fn_group_banner 171 'syn_file.at:972' \ - "DECLARATIVES invalid procedure reference (2)" " " 2 -at_xfail=no -( - $as_echo "171. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - INPUT-OUTPUT SECTION. - FILE-CONTROL. - SELECT TEST-FILE ASSIGN "./TEST-FILE" - ORGANIZATION IS LINE SEQUENTIAL. - DATA DIVISION. - FILE SECTION. - FD TEST-FILE. - 01 TEST-REC PIC X(4). - PROCEDURE DIVISION. - DECLARATIVES. - P01 SECTION. - USE AFTER ERROR PROCEDURE ON TEST-FILE. - P02. - DISPLAY "OK" - END-DISPLAY. - END DECLARATIVES. - PP01 SECTION. - PP02. - OPEN INPUT TEST-FILE. - CLOSE TEST-FILE. - PERFORM P02. - GO TO P02. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/syn_file.at:1004: \$COMPILE_ONLY prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY prog.cob" "syn_file.at:1004" -( $at_check_trace; $COMPILE_ONLY prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob: in section 'PP01': -prog.cob: in paragraph 'PP02': -prog.cob:26: error: invalid reference to 'P02' (in DECLARATIVES) -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/syn_file.at:1004" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_171 -#AT_START_172 -at_fn_group_banner 172 'syn_file.at:1013' \ - "EXTERNAL file" " " 2 -at_xfail=no -( - $as_echo "172. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - - ENVIRONMENT DIVISION. - INPUT-OUTPUT SECTION. - FILE-CONTROL. - SELECT my-file - ASSIGN TO "somefile" - ORGANIZATION IS SEQUENTIAL. - - DATA DIVISION. - FILE SECTION. - FD my-file EXTERNAL. - 01 my-record. - 03 my-record-data PIC X(80). - - PROCEDURE DIVISION. - GOBACK. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/syn_file.at:1037: \$COMPILE_ONLY prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY prog.cob" "syn_file.at:1037" -( $at_check_trace; $COMPILE_ONLY prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/syn_file.at:1037" -$at_failed && at_fn_log_failure -$at_traceon; } - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_172 -#AT_START_173 -at_fn_group_banner 173 'syn_file.at:1041' \ - "RECORDING MODE" " " 2 -at_xfail=no -( - $as_echo "173. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - - ENVIRONMENT DIVISION. - INPUT-OUTPUT SECTION. - FILE-CONTROL. - SELECT f ASSIGN "f.dat" LINE SEQUENTIAL. - - DATA DIVISION. - FILE SECTION. - FD f RECORDING MODE IS U. - 01 x PIC X. - - PROCEDURE DIVISION. - OPEN INPUT f - CLOSE f - . -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/syn_file.at:1064: \$COMPILE_ONLY prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY prog.cob" "syn_file.at:1064" -( $at_check_trace; $COMPILE_ONLY prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob:12: error: RECORDING MODE U or S can only be used with RECORD SEQUENTIAL files -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/syn_file.at:1064" -$at_failed && at_fn_log_failure -$at_traceon; } - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_173 -#AT_START_174 -at_fn_group_banner 174 'syn_file.at:1070' \ - "CODE-SET clause" " " 2 -at_xfail=no -( - $as_echo "174. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - - ENVIRONMENT DIVISION. - CONFIGURATION SECTION. - SPECIAL-NAMES. - ALPHABET A IS ASCII. - - INPUT-OUTPUT SECTION. - FILE-CONTROL. - SELECT f, ASSIGN "f.dat", LINE SEQUENTIAL. - SELECT g, ASSIGN "g.dat", LINE SEQUENTIAL. - - DATA DIVISION. - FILE SECTION. - FD f CODE-SET A. - 01 f-rec PIC X(10). - - FD g CODE-SET foo. - 01 g-rec PIC X(10). -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/syn_file.at:1096: \$COMPILE_ONLY prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY prog.cob" "syn_file.at:1096" -( $at_check_trace; $COMPILE_ONLY prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob:17: warning: ignoring CODE-SET 'A' -prog.cob:20: error: 'foo' is not defined -prog.cob:20: error: 'foo' is not an alphabet-name -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/syn_file.at:1096" -$at_failed && at_fn_log_failure -$at_traceon; } - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_174 -#AT_START_175 -at_fn_group_banner 175 'syn_file.at:1104' \ - "CODE-SET FOR clause" " " 2 -at_xfail=no -( - $as_echo "175. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - - ENVIRONMENT DIVISION. - CONFIGURATION SECTION. - SPECIAL-NAMES. - ALPHABET A IS EBCDIC. - - INPUT-OUTPUT SECTION. - FILE-CONTROL. - SELECT f ASSIGN "f.dat" LINE SEQUENTIAL. - - DATA DIVISION. - FILE SECTION. - FD f CODE-SET A FOR x, y, z. - 01 x. - 03 y PIC X(10). - 01 x-2. - 03 z PIC X(10). -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/syn_file.at:1129: \$COMPILE_ONLY prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY prog.cob" "syn_file.at:1129" -( $at_check_trace; $COMPILE_ONLY prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob:16: warning: FOR sub-records is not implemented -prog.cob:16: warning: CODE-SET is not implemented -prog.cob:16: error: FOR item 'x' is a record -prog.cob:16: error: FOR item 'z' is in different record to 'x' -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/syn_file.at:1129" -$at_failed && at_fn_log_failure -$at_traceon; } - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_175 -#AT_START_176 -at_fn_group_banner 176 'syn_file.at:1138' \ - "WRITE / REWRITE FROM clause and FILE" " " 2 -at_xfail=no -( - $as_echo "176. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - INPUT-OUTPUT SECTION. - FILE-CONTROL. - SELECT TEST-FILE ASSIGN TO 'FILE-TEST' - ORGANIZATION IS INDEXED - ACCESS MODE IS DYNAMIC - RECORD KEY IS TEST-P1. - DATA DIVISION. - FILE SECTION. - FD TEST-FILE. - 01 TEST-REC. - 05 TEST-P1 PIC X(4). - 05 TEST-P2 PIC S9(4) COMP. - WORKING-STORAGE SECTION. - 01 SOME-REC PIC X(04). - 88 SOME-VAL VALUE 'ABCD'. - PROCEDURE DIVISION. - OPEN I-O TEST-FILE. - WRITE SOME-VAL. - WRITE SOME-REC. - WRITE TEST-REC. - WRITE TEST-REC FROM SOME-REC. - WRITE TEST-FILE. - WRITE FILE TEST-REC. - WRITE FILE TEST-FILE. - WRITE FILE TEST-FILE FROM TEST-REC. - WRITE FILE TEST-FILE FROM SOME-REC. - REWRITE SOME-VAL. - REWRITE SOME-REC. - REWRITE TEST-REC. - REWRITE TEST-REC FROM SOME-REC. - REWRITE TEST-FILE. - REWRITE FILE TEST-REC. - REWRITE FILE TEST-FILE. - REWRITE FILE TEST-FILE FROM TEST-REC. - REWRITE FILE TEST-FILE FROM SOME-REC. - CLOSE TEST-FILE. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/syn_file.at:1184: \$COMPILE_ONLY prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY prog.cob" "syn_file.at:1184" -( $at_check_trace; $COMPILE_ONLY prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob:22: error: condition-name not allowed here: 'SOME-VAL' -prog.cob:23: error: WRITE subject does not refer to a record name -prog.cob:26: error: WRITE requires a record name as subject -prog.cob:27: error: 'TEST-REC' is not a file name -prog.cob:28: error: WRITE FILE requires a FROM clause -prog.cob:31: error: condition-name not allowed here: 'SOME-VAL' -prog.cob:32: error: REWRITE subject does not refer to a record name -prog.cob:35: error: REWRITE requires a record name as subject -prog.cob:36: error: 'TEST-REC' is not a file name -prog.cob:37: error: REWRITE FILE requires a FROM clause -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/syn_file.at:1184" -$at_failed && at_fn_log_failure -$at_traceon; } - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_176 -#AT_START_177 -at_fn_group_banner 177 'syn_file.at:1199' \ - "Clauses following invalid ACCESS clause" " " 2 -at_xfail=no -( - $as_echo "177. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - - ENVIRONMENT DIVISION. - INPUT-OUTPUT SECTION. - FILE-CONTROL. - SELECT testfile - ASSIGN TO filename - ORGANIZATION RELATIVE - ACCESS IS sequentia - STATUS IS stat. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/syn_file.at:1216: \$COMPILE_ONLY prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY prog.cob" "syn_file.at:1216" -( $at_check_trace; $COMPILE_ONLY prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob:11: error: syntax error, unexpected Identifier, expecting DYNAMIC or RANDOM or SEQUENTIAL -prog.cob:8: error: missing file description for FILE testfile -prog.cob:13: warning: variable 'filename' will be implicitly defined -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/syn_file.at:1216" -$at_failed && at_fn_log_failure -$at_traceon; } - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_177 -#AT_START_178 -at_fn_group_banner 178 'syn_file.at:1224' \ - "RELATIVE KEY type checks" " " 2 -at_xfail=no -( - $as_echo "178. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - INPUT-OUTPUT SECTION. - FILE-CONTROL. - SELECT FILE1 ASSIGN DISK - ORGANIZATION RELATIVE ACCESS MODE RANDOM - RELATIVE KEY FILE1-KEY. - SELECT FILE2 ASSIGN DISK - ORGANIZATION RELATIVE ACCESS MODE RANDOM - RELATIVE KEY FILE2-KEY. - SELECT FILE3 ASSIGN DISK - ORGANIZATION RELATIVE ACCESS MODE RANDOM - RELATIVE KEY FILE3-KEY. - SELECT FILE4 ASSIGN DISK - ORGANIZATION RELATIVE ACCESS MODE RANDOM - RELATIVE KEY FILE4-KEY. - SELECT FILE5 ASSIGN DISK - ORGANIZATION RELATIVE ACCESS MODE RANDOM - RELATIVE KEY FILE5-KEY. - DATA DIVISION. - FILE SECTION. - FD FILE1. - 01 FILE1-REC PIC X. - FD FILE2. - 01 FILE2-REC PIC X. - FD FILE3. - 01 FILE3-REC PIC X. - FD FILE4. - 01 FILE4-REC. - 05 FLD1 PIC X. - 05 FILE4-KEY PIC 999. - FD FILE5. - 01 FILE5-REC PIC X. - WORKING-STORAGE SECTION. - 77 FILE1-KEY PIC XXXX. - 01 FILE2-KEY. - 05 F2-KEY PIC 9(5). - 01 F3-KEY. - 05 FILE3-KEY PIC 9(5) OCCURS 2 TIMES. - 77 FILE5-KEY PIC 999V9. - PROCEDURE DIVISION. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/syn_file.at:1273: \$COMPILE_ONLY prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY prog.cob" "syn_file.at:1273" -( $at_check_trace; $COMPILE_ONLY prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob:9: error: file FILE1: RELATIVE KEY FILE1-KEY is not numeric -prog.cob:12: error: file FILE2: RELATIVE KEY FILE2-KEY is not numeric -prog.cob:15: error: file FILE3: RELATIVE KEY FILE3-KEY cannot have OCCURS -prog.cob:18: error: RELATIVE KEY FILE4-KEY cannot be in file record belonging to FILE4 -prog.cob:21: error: file FILE5: RELATIVE KEY FILE5-KEY must be integer -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/syn_file.at:1273" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_178 -#AT_START_179 -at_fn_group_banner 179 'syn_file.at:1284' \ - "Mismatched KEY clause" " " 2 -at_xfail=no -( - $as_echo "179. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - INPUT-OUTPUT SECTION. - FILE-CONTROL. - SELECT file-1 ASSIGN DISK, - INDEXED, RELATIVE KEY file-1-key. - SELECT file-2 ASSIGN DISK, - RELATIVE, RECORD KEY file-2-key. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/syn_file.at:1299: \$COMPILE_ONLY prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY prog.cob" "syn_file.at:1299" -( $at_check_trace; $COMPILE_ONLY prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob:8: error: cannot use RELATIVE KEY clause on INDEXED files -prog.cob:10: error: cannot use RECORD KEY clause on RELATIVE files -prog.cob:7: error: missing file description for FILE file-1 -prog.cob:8: error: 'file-1-key' is not defined -prog.cob:9: error: missing file description for FILE file-2 -prog.cob:10: error: 'file-2-key' is not defined -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/syn_file.at:1299" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_179 -#AT_START_180 -at_fn_group_banner 180 'syn_file.at:1311' \ - "RECORD DELIMITER" " " 2 -at_xfail=no -( - $as_echo "180. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - - ENVIRONMENT DIVISION. - INPUT-OUTPUT SECTION. - FILE-CONTROL. - *> Valid. - SELECT good-1 ASSIGN "a" - RECORD DELIMITER LINE-SEQUENTIAL. - - SELECT good-2 ASSIGN "a" - SEQUENTIAL - RECORD DELIMITER LINE-SEQUENTIAL. - - SELECT good-3 ASSIGN "a" - RECORD DELIMITER LINE-SEQUENTIAL - LINE SEQUENTIAL. - - SELECT good-4 ASSIGN "a" - RECORD DELIMITER BINARY-SEQUENTIAL. - - *> Warning. - SELECT ok-i-guess-1 ASSIGN "a" - RECORD DELIMITER STANDARD-1. - - SELECT ok-i-guess-2 ASSIGN "a" - RECORD DELIMITER THE-END-OF-THE-WORLD. - - *> Not valid. - SELECT bad-1 ASSIGN "a" - RECORD DELIMITER LINE-SEQUENTIAL - INDEXED - RECORD KEY bad-1-rec. - - SELECT bad-2 ASSIGN "a" - INDEXED - RECORD KEY bad-2-rec - RECORD DELIMITER LINE-SEQUENTIAL. - - SELECT bad-3 ASSIGN "a" - LINE SEQUENTIAL - RECORD DELIMITER BINARY-SEQUENTIAL. - - SELECT bad-4 ASSIGN "a" - LINE SEQUENTIAL - RECORD DELIMITER STANDARD-1. - - SELECT bad-5 ASSIGN "a" - RECORD DELIMITER BINARY-SEQUENTIAL. - - DATA DIVISION. - FILE SECTION. - FD good-1. - 01 good-1-rec PIC 9. - 01 good-1-rec-2 PIC 99. - - FD good-2 RECORD VARYING FROM 1 TO 5 CHARACTERS. - 01 good-2-rec PIC 9. - - FD good-3. - 01 good-3-rec PIC 9. - 01 good-3-rec-2 PIC 99. - - FD good-4 RECORD CONTAINS 1 TO 5 CHARACTERS. - 01 good-4-rec PIC 9. - - FD ok-i-guess-1. - 01 ok-i-guess-1-rec PIC 9. - 01 ok-i-guess-1-rec-2 PIC 99. - - FD ok-i-guess-2. - 01 ok-i-guess-2-rec PIC 9. - 01 ok-i-guess-2-rec-2 PIC 99. - - FD bad-1. - 01 bad-1-rec PIC 9. - - FD bad-2. - 01 bad-2-rec PIC 9. - - FD bad-3. - 01 bad-3-rec PIC 9. - - FD bad-4. - 01 bad-4-rec PIC 9. - - FD bad-5 RECORD CONTAINS 1 CHARACTERS. - 01 bad-5-rec PIC 9. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/syn_file.at:1405: \$COMPILE_ONLY -frecord-delim-with-fixed-recs=warning prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY -frecord-delim-with-fixed-recs=warning prog.cob" "syn_file.at:1405" -( $at_check_trace; $COMPILE_ONLY -frecord-delim-with-fixed-recs=warning prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob:25: warning: RECORD DELIMITER STANDARD-1 ignored -prog.cob:28: warning: RECORD DELIMITER THE-END-OF-THE-WORLD not recognized; will be ignored -prog.cob:33: error: ORGANIZATION INDEXED is incompatible with RECORD DELIMITER -prog.cob:39: error: RECORD DELIMITER LINE-SEQUENTIAL only allowed with (LINE) SEQUENTIAL files -prog.cob:36: error: RECORD clause is invalid for file 'bad-2' (file type) -prog.cob:43: error: RECORD DELIMITER BINARY-SEQUENTIAL only allowed with SEQUENTIAL files -prog.cob:47: error: RECORD DELIMITER STANDARD-1 only allowed with SEQUENTIAL files -prog.cob:79: warning: RECORD DELIMITER clause on file with fixed-length records used -prog.cob:82: warning: RECORD DELIMITER clause on file with fixed-length records used -prog.cob:85: warning: RECORD DELIMITER clause on file with fixed-length records used -prog.cob:88: warning: RECORD DELIMITER clause on file with fixed-length records used -prog.cob:90: warning: RECORD DELIMITER clause on file with fixed-length records used -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/syn_file.at:1405" -$at_failed && at_fn_log_failure -$at_traceon; } - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_180 -#AT_START_181 -at_fn_group_banner 181 'syn_file.at:1422' \ - "FILE STATUS" " " 2 -at_xfail=no -( - $as_echo "181. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - INPUT-OUTPUT SECTION. - FILE-CONTROL. - SELECT file1 ASSIGN TO 'FILE-TEST' - ORGANIZATION IS INDEXED - ACCESS MODE IS DYNAMIC - RECORD KEY IS file1-key - STATUS IS STATUS-1. - SELECT file2 ASSIGN TO 'FILE-TEST' - ORGANIZATION IS INDEXED - ACCESS MODE IS DYNAMIC - RECORD KEY IS file2-key - STATUS IS STATUS-1, STATUS-2. - DATA DIVISION. - FILE SECTION. - FD FILE1. - 01 FILE1-REC. - 05 FILE1-KEY PIC X. - FD FILE2. - 01 FILE2-REC. - 05 FILE2-KEY PIC 9. - 05 FILE2-DAT PIC X. - WORKING-STORAGE SECTION. - 77 STATUS-1 PIC X(02). - 77 STATUS-2 PIC X(06). - PROCEDURE DIVISION. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/syn_file.at:1457: \$COMPILE_ONLY prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY prog.cob" "syn_file.at:1457" -( $at_check_trace; $COMPILE_ONLY prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob:16: error: VSAM STATUS does not conform to GnuCOBOL -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/syn_file.at:1457" -$at_failed && at_fn_log_failure -$at_traceon; } - - -{ set +x -$as_echo "$at_srcdir/syn_file.at:1461: \$COMPILE_ONLY -frelax-syntax-checks prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY -frelax-syntax-checks prog.cob" "syn_file.at:1461" -( $at_check_trace; $COMPILE_ONLY -frelax-syntax-checks prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob:16: warning: VSAM STATUS ignored -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/syn_file.at:1461" -$at_failed && at_fn_log_failure -$at_traceon; } - - -{ set +x -$as_echo "$at_srcdir/syn_file.at:1465: \$COMPILE_ONLY -std=ibm-strict prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY -std=ibm-strict prog.cob" "syn_file.at:1465" -( $at_check_trace; $COMPILE_ONLY -std=ibm-strict prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob:16: warning: VSAM STATUS ignored -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/syn_file.at:1465" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_181 -#AT_START_182 -at_fn_group_banner 182 'syn_file.at:1472' \ - "INDEXED file PASSWORD clause" " " 2 -at_xfail=no -( - $as_echo "182. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - INPUT-OUTPUT SECTION. - FILE-CONTROL. - SELECT file1 ASSIGN TO 'FILE-TEST' - ORGANIZATION IS INDEXED - ACCESS MODE IS DYNAMIC - RECORD KEY IS file1-key PASSWORD IS PASS1 - STATUS IS FSTAT. - SELECT file2 ASSIGN TO 'FILE-TEST-EXT' - ORGANIZATION IS INDEXED - ACCESS MODE IS DYNAMIC - RECORD KEY IS file2-key PASSWORD IS PASS2 - ALTERNATE RECORD KEY IS NOTHEREKEY - SOURCE IS file2-dat file2-key - PASSWORD IS PASS-EXT - STATUS IS FSTAT. - DATA DIVISION. - FILE SECTION. - FD FILE1. - 01 FILE1-REC. - 05 FILE1-KEY PIC X. - FD FILE2 EXTERNAL. - 01 FILE2-REC. - 05 FILE2-KEY PIC 9. - 05 FILE2-DAT PIC X. - WORKING-STORAGE SECTION. - 77 FSTAT PIC X(02). - *> note: IBM specifies PASSWORDs are cut at / space filled to 8 bytes - 77 PASS1 PIC X(08). - 77 PASS2 PIC X(10). - 77 PASS-EXT PIC X(04) EXTERNAL. - PROCEDURE DIVISION. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/syn_file.at:1513: \$COMPILE_ONLY prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY prog.cob" "syn_file.at:1513" -( $at_check_trace; $COMPILE_ONLY prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob:10: warning: PASSWORD clause is not implemented -prog.cob:15: warning: PASSWORD clause is not implemented -prog.cob:18: warning: PASSWORD clause is not implemented -prog.cob:15: error: PASSWORD 'PASS2' for EXTERNAL file 'file2' must have EXTERNAL attribute -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/syn_file.at:1513" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_182 -#AT_START_183 -at_fn_group_banner 183 'syn_file.at:1523' \ - "RECORD clause equal limits" " " 2 -at_xfail=no -( - $as_echo "183. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - - ENVIRONMENT DIVISION. - INPUT-OUTPUT SECTION. - FILE-CONTROL. - SELECT f1 ASSIGN "f1". - SELECT f2 ASSIGN "f2". - SELECT f3 ASSIGN "f3". - SELECT f4 ASSIGN "f4". - - DATA DIVISION. - FILE SECTION. - FD f1 RECORD VARYING. - 01 f1-rec-1 PIC X. - 01 f1-rec-2 PIC 9. - - FD f2 RECORD VARYING 1 TO 1. - 01 f2-rec PIC X. - - FD f3 RECORD 1 TO 1. - 01 f3-rec PIC X. - - FD f4 RECORD IS VARYING IN SIZE. - 01 f4-rec-1 PIC X. - 01 f4-rec-2 PIC 99. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/syn_file.at:1555: \$COMPILE_ONLY -frecords-mismatch-record-clause=error prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY -frecords-mismatch-record-clause=error prog.cob" "syn_file.at:1555" -( $at_check_trace; $COMPILE_ONLY -frecords-mismatch-record-clause=error prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob:19: error: file 'f1': RECORD VARYING specified without limits, but implied limits are equal -prog.cob:19: error: RECORD clause invalid -prog.cob:22: error: RECORD clause invalid -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/syn_file.at:1555" -$at_failed && at_fn_log_failure -$at_traceon; } - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_183 -#AT_START_184 -at_fn_group_banner 184 'syn_file.at:1563' \ - "FILE ... FROM literal" " " 2 -at_xfail=no -( - $as_echo "184. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - - ENVIRONMENT DIVISION. - INPUT-OUTPUT SECTION. - FILE-CONTROL. - SELECT f ASSIGN TO "ssad". - - DATA DIVISION. - FILE SECTION. - FD f. - 01 f-rec PIC 999999. - - WORKING-STORAGE SECTION. - 01 num PIC 9(6) VALUE 123456. - - PROCEDURE DIVISION. - OPEN OUTPUT f - WRITE FILE f FROM zero - WRITE FILE f FROM 0 - WRITE FILE f FROM "abc" - REWRITE FILE f FROM zero - REWRITE FILE f FROM 0 - REWRITE FILE f FROM "abc" - CLOSE f - . -_ATEOF - - -# FIXME: the references to ZERO should actually show one less - -{ set +x -$as_echo "$at_srcdir/syn_file.at:1597: \$COMPILE_ONLY prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY prog.cob" "syn_file.at:1597" -( $at_check_trace; $COMPILE_ONLY prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob:21: error: figurative constants not allowed in FROM clause -prog.cob:21: error: literal in FROM clause must be alphanumeric, national or boolean -prog.cob:22: warning: numeric value is expected -prog.cob:13: warning: 'f-rec' defined here as PIC 999999 -prog.cob:24: error: figurative constants not allowed in FROM clause -prog.cob:24: error: literal in FROM clause must be alphanumeric, national or boolean -prog.cob:25: warning: numeric value is expected -prog.cob:13: warning: 'f-rec' defined here as PIC 999999 -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/syn_file.at:1597" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/syn_file.at:1607: \$COMPILE_ONLY -frelax-syntax-checks prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY -frelax-syntax-checks prog.cob" "syn_file.at:1607" -( $at_check_trace; $COMPILE_ONLY -frelax-syntax-checks prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob:22: warning: numeric value is expected -prog.cob:13: warning: 'f-rec' defined here as PIC 999999 -prog.cob:25: warning: numeric value is expected -prog.cob:13: warning: 'f-rec' defined here as PIC 999999 -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/syn_file.at:1607" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/syn_file.at:1613: \$COMPILE_ONLY -std=mf-strict prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY -std=mf-strict prog.cob" "syn_file.at:1613" -( $at_check_trace; $COMPILE_ONLY -std=mf-strict prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob:22: warning: source is non-numeric - substituting zero -prog.cob:25: warning: source is non-numeric - substituting zero -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/syn_file.at:1613" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_184 -#AT_START_185 -at_fn_group_banner 185 'syn_file.at:1622' \ - "WRITE / REWRITE on LINE SEQUENTIAL files" " " 2 -at_xfail=yes -( - $as_echo "185. $at_setup_line: testing $at_desc ..." - $at_traceon - - - - -# FIXME: this should be depending on a compilation flag, -# see reportwriter branch for this feature - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - - ENVIRONMENT DIVISION. - INPUT-OUTPUT SECTION. - FILE-CONTROL. - SELECT f ASSIGN TO "ssad" LINE SEQUENTIAL. - - DATA DIVISION. - FILE SECTION. - FD f. - 01 f-rec PIC X(05). - - PROCEDURE DIVISION. - OPEN OUTPUT f - WRITE FILE f FROM "abc" - REWRITE FILE f FROM "abc" - CLOSE f - . -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/syn_file.at:1651: \$COMPILE_ONLY prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY prog.cob" "syn_file.at:1651" -( $at_check_trace; $COMPILE_ONLY prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob:18: error: REWRITE not allowed on LINE SEQUENTIAL files -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/syn_file.at:1651" -$at_failed && at_fn_log_failure -$at_traceon; } - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_185 -#AT_START_186 -at_fn_group_banner 186 'syn_file.at:1658' \ - "WRITE / REWRITE on REPORT files" " " 2 -at_xfail=no -( - $as_echo "186. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - - ENVIRONMENT DIVISION. - INPUT-OUTPUT SECTION. - FILE-CONTROL. - SELECT f ASSIGN TO "ssad" LINE SEQUENTIAL. - - DATA DIVISION. - FILE SECTION. - FD f REPORT f-rep. - 01 f-rec PIC X(05). - - REPORT SECTION. - RD f-rep. - 01 f-rep-line TYPE DE PIC XXX. - - PROCEDURE DIVISION. - OPEN OUTPUT f - WRITE FILE f FROM "abc" - REWRITE FILE f FROM "abc" - CLOSE f - . -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/syn_file.at:1687: \$COMPILE_ONLY prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY prog.cob" "syn_file.at:1687" -( $at_check_trace; $COMPILE_ONLY prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob:21: error: WRITE not allowed on REPORT files -prog.cob:22: error: REWRITE not allowed on REPORT files -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/syn_file.at:1687" -$at_failed && at_fn_log_failure -$at_traceon; } - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_186 -#AT_START_187 -at_fn_group_banner 187 'syn_file.at:1695' \ - "SELECT without fd-name" " " 2 -at_xfail=no -( - $as_echo "187. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - - ENVIRONMENT DIVISION. - INPUT-OUTPUT SECTION. - FILE-CONTROL. - SELECT ASSIGN "asd". -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/syn_file.at:1708: \$COMPILE_ONLY prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY prog.cob" "syn_file.at:1708" -( $at_check_trace; $COMPILE_ONLY prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob:8: error: syntax error, unexpected ASSIGN, expecting Identifier -prog.cob:8: error: syntax error, unexpected Literal -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/syn_file.at:1708" -$at_failed && at_fn_log_failure -$at_traceon; } - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_187 -#AT_START_188 -at_fn_group_banner 188 'syn_file.at:1714' \ - "Undeclared FILE-ID variable" " " 2 -at_xfail=no -( - $as_echo "188. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - INPUT-OUTPUT SECTION. - FILE-CONTROL. - SELECT file1 ASSIGN DISK. - DATA DIVISION. - FILE SECTION. - FD file1 VALUE OF FILE-ID fid-file1. - 01 file1-rec PIC X. - PROCEDURE DIVISION. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/syn_file.at:1732: \$COMPILE_ONLY prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY prog.cob" "syn_file.at:1732" -( $at_check_trace; $COMPILE_ONLY prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob:10: warning: VALUE OF is obsolete in GnuCOBOL -prog.cob:12: warning: variable 'fid-file1' will be implicitly defined -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/syn_file.at:1732" -$at_failed && at_fn_log_failure -$at_traceon; } - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_188 -#AT_START_189 -at_fn_group_banner 189 'syn_file.at:1739' \ - "Undeclared FILE STATUS variable" " " 2 -at_xfail=no -( - $as_echo "189. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - INPUT-OUTPUT SECTION. - FILE-CONTROL. - SELECT file1 ASSIGN DISK - STATUS fs. - DATA DIVISION. - FILE SECTION. - FD file1. - 1 file1-rec pic x. - PROCEDURE DIVISION. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/syn_file.at:1758: \$COMPILE_ONLY prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY prog.cob" "syn_file.at:1758" -( $at_check_trace; $COMPILE_ONLY prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob:8: error: 'fs' is not defined -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/syn_file.at:1758" -$at_failed && at_fn_log_failure -$at_traceon; } - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_189 -#AT_START_190 -at_fn_group_banner 190 'syn_file.at:1764' \ - "FILE STATUS field subordinate to FD" " " 2 -at_xfail=yes -( - $as_echo "190. $at_setup_line: testing $at_desc ..." - $at_traceon - - - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - INPUT-OUTPUT SECTION. - FILE-CONTROL. - SELECT file1 ASSIGN DISK - STATUS fs. - DATA DIVISION. - FILE SECTION. - FD file1. - 01 file1-rec. - 02 filler pic x. - 02 fs pic xx. - PROCEDURE DIVISION. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/syn_file.at:1787: \$COMPILE_ONLY prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY prog.cob" "syn_file.at:1787" -( $at_check_trace; $COMPILE_ONLY prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob: NOT DETECTED AT COMPILE TIME -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/syn_file.at:1787" -$at_failed && at_fn_log_failure -$at_traceon; } - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_190 -#AT_START_191 -at_fn_group_banner 191 'syn_file.at:1793' \ - "FILE STATUS not PIC XX" " " 2 -at_xfail=yes -( - $as_echo "191. $at_setup_line: testing $at_desc ..." - $at_traceon - - - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - - ENVIRONMENT DIVISION. - INPUT-OUTPUT SECTION. - FILE-CONTROL. - SELECT file1 ASSIGN DISK - STATUS fs-1. - SELECT file2 ASSIGN DISK - STATUS fs-2. - - DATA DIVISION. - FILE SECTION. - FD file1. - 01 file1-rec PIC x. - - FD file2. - 01 file2-rec PIC X. - - WORKING-STORAGE SECTION. - 01 fs-1 PIC XXX. - 01 fs-2 PIC 99. - - PROCEDURE DIVISION. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/syn_file.at:1826: \$COMPILE_ONLY prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY prog.cob" "syn_file.at:1826" -( $at_check_trace; $COMPILE_ONLY prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob: NOT DETECTED AT COMPILE TIME -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/syn_file.at:1826" -$at_failed && at_fn_log_failure -$at_traceon; } - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_191 -#AT_START_192 -at_fn_group_banner 192 'syn_file.at:1832' \ - "DELETE with LINE SEQUENTIAL" " " 2 -at_xfail=no -( - $as_echo "192. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - INPUT-OUTPUT SECTION. - FILE-CONTROL. - SELECT file1 ASSIGN DISK ORGANIZATION LINE SEQUENTIAL. - DATA DIVISION. - FILE SECTION. - FD file1. - 01 file1-rec PIC X. - PROCEDURE DIVISION. - OPEN I-O file1. - DELETE file1. - CLOSE file1. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/syn_file.at:1852: \$COMPILE_ONLY prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY prog.cob" "syn_file.at:1852" -( $at_check_trace; $COMPILE_ONLY prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob:14: error: DELETE not allowed on LINE SEQUENTIAL files -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/syn_file.at:1852" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_192 -#AT_START_193 -at_fn_group_banner 193 'syn_file.at:1859' \ - "DELETE with SEQUENTIAL" " " 2 -at_xfail=no -( - $as_echo "193. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - INPUT-OUTPUT SECTION. - FILE-CONTROL. - SELECT file1 ASSIGN DISK ORGANIZATION SEQUENTIAL. - DATA DIVISION. - FILE SECTION. - FD file1. - 01 file1-rec PIC X. - PROCEDURE DIVISION. - OPEN I-O file1. - DELETE file1. - CLOSE file1. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/syn_file.at:1879: \$COMPILE_ONLY prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY prog.cob" "syn_file.at:1879" -( $at_check_trace; $COMPILE_ONLY prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob:14: error: DELETE not allowed on SEQUENTIAL files -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/syn_file.at:1879" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_193 -#AT_START_194 -at_fn_group_banner 194 'syn_file.at:1885' \ - "ACCESS RANDOM with ORG SEQUENTIAL" " " 2 -at_xfail=no -( - $as_echo "194. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - INPUT-OUTPUT SECTION. - FILE-CONTROL. - SELECT file1 ASSIGN DISK ORGANIZATION SEQUENTIAL - ACCESS RANDOM. - DATA DIVISION. - FILE SECTION. - FD file1. - 01 file1-rec PIC X. - PROCEDURE DIVISION. - STOP RUN. -_ATEOF - - -# TO-DO: Improve error message - say ACCESS RANDOM is incompatible with ORGANIZATION SEQUENTIAL. -{ set +x -$as_echo "$at_srcdir/syn_file.at:1905: \$COMPILE_ONLY prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY prog.cob" "syn_file.at:1905" -( $at_check_trace; $COMPILE_ONLY prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob:7: error: ORGANIZATION clause is invalid for file 'file1' -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/syn_file.at:1905" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_194 -#AT_START_195 -at_fn_group_banner 195 'syn_file.at:1912' \ - "ALTERNATE RECORD KEY SUPPRESS WHEN" " " 2 -at_xfail=no -( - $as_echo "195. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - INPUT-OUTPUT SECTION. - FILE-CONTROL. - SELECT TEST-FILE - ASSIGN "TESTFILE" - ACCESS DYNAMIC - ORGANIZATION INDEXED - RECORD KEY TESTKEY-P1 - ALTERNATE RECORD KEY TESTKEY-P2 - WITH DUPLICATES - SUPPRESS WHEN ZEROES - ALTERNATE RECORD KEY TESTKEY-P3 - WITH DUPLICATES - SUPPRESS WHEN SPACES - ALTERNATE RECORD KEY TESTKEY-P4 - WITH DUPLICATES - SUPPRESS WHEN ALL "A" - ALTERNATE RECORD KEY TESTKEY-P5 - WITH DUPLICATES - SUPPRESS WHEN ALL SPACES - . - DATA DIVISION. - FILE SECTION. - FD TEST-FILE. - 01 TEST-REC. - 03 TESTKEY-P1 PIC X(4). - 03 TESTKEY-P2 PIC 9(4). - 03 TESTDATA PIC X(4). - 03 TESTKEY-P3 PIC X(4). - 03 TESTKEY-P4 PIC X(4). - 03 TESTKEY-P5 PIC X(4). - PROCEDURE DIVISION. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/syn_file.at:1953: \$COMPILE_ONLY -std=mf prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY -std=mf prog.cob" "syn_file.at:1953" -( $at_check_trace; $COMPILE_ONLY -std=mf prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/syn_file.at:1953" -$at_failed && at_fn_log_failure -$at_traceon; } - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_195 -#AT_START_196 -at_fn_group_banner 196 'syn_file.at:1957' \ - "RECORD definition with SOURCE IS / =" " " 2 -at_xfail=no -( - $as_echo "196. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - INPUT-OUTPUT SECTION. - FILE-CONTROL. - SELECT TEST-FILE1 - ASSIGN "TESTFILE" - ACCESS DYNAMIC - ORGANIZATION INDEXED - RECORD KEY TESTKEY-P1 OF TEST-REC1 - ALTERNATE RECORD KEY - TEST1KEY2 = TESTKEY-P2 OF TEST-REC1, - TESTKEY-P3 OF TEST-REC1 - WITH DUPLICATES - . - SELECT TEST-FILE2 - ASSIGN "TESTFILE" - ACCESS DYNAMIC - ORGANIZATION INDEXED - RECORD KEY TESTKEY-P1 OF TEST-REC2 - ALTERNATE RECORD KEY - TEST2KEY2 SOURCE IS TESTKEY-P2 OF TEST-REC2, - TESTKEY-P3 OF TEST-REC2 - WITH DUPLICATES - . - DATA DIVISION. - FILE SECTION. - FD TEST-FILE1. - 01 TEST-REC1. - 03 TESTKEY-P1 PIC X(4). - 03 TESTKEY-P2 PIC 9(4). - 03 TESTDATA PIC X(4). - 03 TESTKEY-P3 PIC X(4). - FD TEST-FILE2. - 01 TEST-REC2. - 03 TESTKEY-P1 PIC X(4). - 03 TESTKEY-P2 PIC 9(4). - 03 TESTDATA PIC X(4). - 03 TESTKEY-P3 PIC X(4). - PROCEDURE DIVISION. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/syn_file.at:2004: \$COMPILE_ONLY prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY prog.cob" "syn_file.at:2004" -( $at_check_trace; $COMPILE_ONLY prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/syn_file.at:2004" -$at_failed && at_fn_log_failure -$at_traceon; } - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_196 -#AT_START_197 -at_fn_group_banner 197 'syn_file.at:2008' \ - "ALTERNATE RECORD definition WITH NO DUPLICATES" " " 2 -at_xfail=yes -( - $as_echo "197. $at_setup_line: testing $at_desc ..." - $at_traceon - - - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - INPUT-OUTPUT SECTION. - FILE-CONTROL. - SELECT TEST-FILE - ASSIGN "TESTFILE" - ACCESS DYNAMIC - ORGANIZATION INDEXED - RECORD KEY TESTKEY1 - ALTERNATE RECORD KEY TESTKEY2 - WITH DUPLICATES - ALTERNATE RECORD KEY TESTKEY3 - WITH NO DUPLICATES - . -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/syn_file.at:2031: \$COMPILE_ONLY prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY prog.cob" "syn_file.at:2031" -( $at_check_trace; $COMPILE_ONLY prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob:7: error: missing file description for FILE TEST-FILE -prog.cob:11: error: 'TESTKEY1' is not defined -prog.cob:12: error: 'TESTKEY2' is not defined -prog.cob:14: error: 'TESTKEY3' is not defined -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/syn_file.at:2031" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/syn_file.at:2037: \$COMPILE_ONLY -frelax-syntax prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY -frelax-syntax prog.cob" "syn_file.at:2037" -( $at_check_trace; $COMPILE_ONLY -frelax-syntax prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/syn_file.at:2037" -$at_failed && at_fn_log_failure -$at_traceon; } - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_197 -#AT_START_198 -at_fn_group_banner 198 'syn_file.at:2041' \ - "ALTERNATE RECORD definition omitting RECORD" " " 2 -at_xfail=yes -( - $as_echo "198. $at_setup_line: testing $at_desc ..." - $at_traceon - - - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - INPUT-OUTPUT SECTION. - FILE-CONTROL. - SELECT TEST-FILE - ASSIGN "TESTFILE" - ACCESS DYNAMIC - ORGANIZATION INDEXED - RECORD KEY TESTKEY1 - ALTERNATE KEY TESTKEY2 - . - PROCEDURE DIVISION. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/syn_file.at:2063: \$COMPILE_ONLY prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY prog.cob" "syn_file.at:2063" -( $at_check_trace; $COMPILE_ONLY prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob:7: error: missing file description for FILE TEST-FILE -prog.cob:11: error: 'TESTKEY1' is not defined -prog.cob:12: error: 'TESTKEY2' is not defined -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/syn_file.at:2063" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/syn_file.at:2068: \$COMPILE_ONLY -frelax-syntax prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY -frelax-syntax prog.cob" "syn_file.at:2068" -( $at_check_trace; $COMPILE_ONLY -frelax-syntax prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/syn_file.at:2068" -$at_failed && at_fn_log_failure -$at_traceon; } - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_198 -#AT_START_199 -at_fn_group_banner 199 'syn_file.at:2072' \ - "SELECT/OPEN syntax extensions" " " 2 -at_xfail=no -( - $as_echo "199. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -# FIXME: split tests, possibly add dialect configuration, -# add checks for "mutually exclusive" and ORGANIZATION - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - INPUT-OUTPUT SECTION. - FILE-CONTROL. - SELECT TEST-FILE1 - ASSIGN "TESTFILE1" - *> WITH ENCRYPTION shift/reduce conflict ? - ORGANIZATION INDEXED - ACCESS DYNAMIC - RECORD KEY TESTKEY-1P1 - WITH DUPLICATES - ALTERNATE RECORD KEY TESTKEY-1P2 - WITH NO DUPLICATES - LOCK EXCLUSIVE MASS-UPDATE - . - SELECT TEST-FILE2 - ASSIGN "TESTFILE2" - *> ENCRYPTION shift/reduce conflict ? - ORGANIZATION INDEXED - ACCESS DYNAMIC - RECORD KEY TESTKEY-2P1 - WITH NO DUPLICATES - ALTERNATE RECORD KEY TESTKEY-2P2 - WITH DUPLICATES - . - DATA DIVISION. - FILE SECTION. - FD TEST-FILE1. - 01 TEST-REC1. - 03 TESTKEY-1P1 PIC X(4). - 03 TESTKEY-1P2 PIC 9(4). - 03 ENCRYPTION PIC X(4). - FD TEST-FILE2. - 01 TEST-REC2. - 03 TESTKEY-2P1 PIC X(4). - 03 ALLOWING PIC X(4). - 03 TESTKEY-2P2 PIC 9(4). - PROCEDURE DIVISION. - OPEN EXCLUSIVE INPUT TEST-FILE2 - CLOSE TEST-FILE2 - OPEN I-O TEST-FILE1 TEST-FILE2 ALLOWING UPDATERS - CLOSE TEST-FILE1 - OPEN I-O TEST-FILE1 ALLOWING UPDATERS - CLOSE TEST-FILE1 - CLOSE TEST-FILE1 - OPEN I-O TEST-FILE1 ALLOWING READERS - CLOSE TEST-FILE1 - CLOSE TEST-FILE1 - OPEN I-O TEST-FILE1 ALLOWING WRITERS - CLOSE TEST-FILE1 - CLOSE TEST-FILE1 - OPEN I-O TEST-FILE1 ALLOWING ALL - CLOSE TEST-FILE1 - CLOSE TEST-FILE1 - OPEN I-O TEST-FILE1 ALLOWING NO - CLOSE TEST-FILE1 - OPEN I-O TEST-FILE1 ALLOWING NO OTHERS - CLOSE TEST-FILE1 - OPEN I-O TEST-FILE1 FOR LOCK - CLOSE TEST-FILE1 - OPEN I-O TEST-FILE1 LOCK - CLOSE TEST-FILE1 - OPEN I-O TEST-FILE1 BULK-ADDITION - CLOSE TEST-FILE1 - OPEN I-O TEST-FILE1 MASS-UPDATE - CLOSE TEST-FILE1 - * - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/syn_file.at:2150: \$COMPILE_ONLY prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY prog.cob" "syn_file.at:2150" -( $at_check_trace; $COMPILE_ONLY prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob:13: warning: DUPLICATES for primary keys is not implemented -prog.cob:16: warning: WITH MASS-UPDATE is not implemented -prog.cob:65: warning: WITH BULK-ADDITION is not implemented -prog.cob:67: warning: WITH MASS-UPDATE is not implemented -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/syn_file.at:2150" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/syn_file.at:2156: \$COMPILE_ONLY -std=acu-strict prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY -std=acu-strict prog.cob" "syn_file.at:2156" -( $at_check_trace; $COMPILE_ONLY -std=acu-strict prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob:13: warning: DUPLICATES for primary keys is not implemented -prog.cob:16: warning: WITH MASS-UPDATE is not implemented -prog.cob:34: error: syntax error, unexpected ENCRYPTION -prog.cob:38: error: syntax error, unexpected ALLOWING -prog.cob:65: warning: WITH BULK-ADDITION is not implemented -prog.cob:67: warning: WITH MASS-UPDATE is not implemented -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/syn_file.at:2156" -$at_failed && at_fn_log_failure -$at_traceon; } - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_199 -#AT_START_200 -at_fn_group_banner 200 'syn_file.at:2167' \ - "GLOBAL FD nested progam" " " 2 -at_xfail=no -( - $as_echo "200. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - - ENVIRONMENT DIVISION. - INPUT-OUTPUT SECTION. - FILE-CONTROL. - SELECT f ASSIGN "foo.dat" - ORGANIZATION INDEXED - RECORD KEY f-key. - - DATA DIVISION. - FILE SECTION. - FD f GLOBAL. - 01 f-rec GLOBAL. - 03 f-key PIC 9. - - PROCEDURE DIVISION. - CALL "output-statement". - - IDENTIFICATION DIVISION. - PROGRAM-ID. output-statement. - - PROCEDURE DIVISION. - WRITE f-rec. - END PROGRAM output-statement. - END PROGRAM prog. -_ATEOF - - -# note: we actually want to check codegen -> C compilation here -{ set +x -$as_echo "$at_srcdir/syn_file.at:2200: \$COMPILE -Wno-unsupported prog.cob" -at_fn_check_prepare_dynamic "$COMPILE -Wno-unsupported prog.cob" "syn_file.at:2200" -( $at_check_trace; $COMPILE -Wno-unsupported prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/syn_file.at:2200" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_200 -#AT_START_201 -at_fn_group_banner 201 'syn_file.at:2205' \ - "XFD directive and creation" " " 2 -at_xfail=no -( - $as_echo "201. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - - PROGRAM-ID. prog. - - ENVIRONMENT DIVISION. - CONFIGURATION SECTION. - - INPUT-OUTPUT SECTION. - FILE-CONTROL. - SELECT OPTIONAL TSPFILE - ASSIGN TO "testsql" - ORGANIZATION INDEXED ACCESS DYNAMIC - RECORD KEY IS PRIME-KEY - SOURCE IS CM-CUST-NUM - - ALTERNATE RECORD KEY IS SPLIT-KEY2 - SOURCE IS CM-TELEPHONE,CM-MACHINE WITH DUPLICATES - SUPPRESS WHEN "900" - - ALTERNATE RECORD KEY IS SPLIT-KEY3 - SOURCE IS CM-DISK,CM-DP-MGR,CM-MACHINE WITH DUPLICATES - SUPPRESS WHEN ALL "*" - FILE STATUS IS CUST-STAT - . - - DATA DIVISION. - FILE SECTION. - FD TSPFILE - BLOCK CONTAINS 5 RECORDS. - - $XFD NAME=tspfilex - 01 TSPFL-RECORD. - 05 TSPFL-REC. - $XFD USE GROUP CUSTNUM - 10 CM-CUST-NUM. - 15 CM-CUST-PRE PICTURE X(3). - 15 CM-CUST-NNN PICTURE X(5). - 10 CM-STATUS PICTURE X. - 10 CM-COMPANY PICTURE X(25). - $XFD USE GROUP VAR_LENGTH custaddr - 10 CM-ADDRESS. - 15 CM-ADDRESS-1 PICTURE X(25). - 15 CM-ADDRESS-2 PICTURE X(25). - 15 CM-ADDRESS-3 PICTURE X(25). - 10 CM-TELEPHONE PICTURE 9(10). - 10 CM-DP-MGR PICTURE X(25). - 10 CM-MACHINE PICTURE X(8). - 10 CM-MEMORY PICTURE X(4). - $XFD WHEN (CM-STATUS = 'A' && CM-TELEPHONE > 100) - $XFD AND CM-MACHINE = 'B' || CM-COMPANY = ' ' - 10 CM-MEMORYX REDEFINES CM-MEMORY. - 15 CM-MEMSZ PICTURE 9(2). - 15 CM-MEMUNIT PICTURE X(2). - 10 CM-DISK PICTURE X(8). - 10 CM-TAPE PICTURE X(8). - $XFD WHEN CM-STATUS = 'X' - 10 CM-TAPEX REDEFINES CM-TAPE PICTURE 9(8). - $XFD WHEN CM-STATUS = 'Y' - 10 CM-TAPEY REDEFINES CM-TAPE PICTURE 9(6)V99. - 10 CM-NO-TERMINALS PICTURE 9(5) BINARY. - 10 CM-COMPX PICTURE XXX COMP-X. - 10 CM-COMP5 PICTURE 9(7) COMP-5. - 10 CM-COMP1 COMP-1. - 10 CM-COMP2 COMP-2. - 10 CM-PRICE PICTURE 9(3)V99 COMP-3. - 10 CM-PRICES PICTURE S9(5)V99. - $XFD DATE "MMDDYYYY" - 10 CM-DATE PICTURE 9(8) COMP-3. - $XFD DATE "YYMMDDCC" - 10 CM-DATE2 PICTURE 9(8) COMP-3. - - WORKING-STORAGE SECTION. - - 01 CUST-STAT. - 05 STAT-1 PICTURE 9(4) COMP SYNC. - 05 FILLER REDEFINES STAT-1. - 10 STAT-X1 PIC X COMP-X. - 10 STAT-X2 PIC X COMP-X. - 77 BYTE-1 PICTURE 9(3). - 77 BYTE-2 PICTURE 9(3). - 77 MAX-SUB VALUE 16 PICTURE 9(5) COMP SYNC. - 77 DO-REWRITE PICTURE X VALUE 'N'. - 77 ENVVAR-IN PICTURE X(30). - 77 SAV-KEY PICTURE X(8). - 77 ENVVAR-OUT PICTURE X(60). - - 01 TEST-DATA. - - 02 DATA-CUST-NUM-TBL. - 05 FILLER PIC X(8) VALUE "ALP00000". - 05 FILLER PIC X(8) VALUE "BET00000". - 05 FILLER PIC X(8) VALUE "GAM00000". - 05 FILLER PIC X(8) VALUE "DEL00000". - 05 FILLER PIC X(8) VALUE "EPS00000". - 05 FILLER PIC X(8) VALUE "FOR00000". - 05 FILLER PIC X(8) VALUE "GIB00000". - 05 FILLER PIC X(8) VALUE "H&J00000". - 05 FILLER PIC X(8) VALUE "INC00000". - 05 FILLER PIC X(8) VALUE "JOH00000". - 05 FILLER PIC X(8) VALUE "KON00000". - 05 FILLER PIC X(8) VALUE "LEW00000". - 05 FILLER PIC X(8) VALUE "MOR00000". - 05 FILLER PIC X(8) VALUE "NEW00000". - 05 FILLER PIC X(8) VALUE "OLD00000". - 05 FILLER PIC X(8) VALUE "PRE00000". - - 02 DATA-CUST-NUM REDEFINES DATA-CUST-NUM-TBL - PIC X(8) OCCURS 16. - 02 DATA-COMPANY-TBL. - 05 FILLER PIC X(25) VALUE "ALPHA ELECTRICAL CO. LTD.". - 05 FILLER PIC X(25) VALUE "BETA SHOE MFG. INC. ". - 05 FILLER PIC X(25) VALUE "GAMMA X-RAY TECHNOLOGY ". - 05 FILLER PIC X(25) VALUE "DELTA LUGGAGE REPAIRS ". - 05 FILLER PIC X(25) VALUE "EPSILON EQUIPMENT SUPPLY ". - 05 FILLER PIC X(25) VALUE "FORTUNE COOKIE COMPANY ". - 05 FILLER PIC X(25) VALUE "GIBRALTER LIFE INSURANCE ". - 05 FILLER PIC X(25) VALUE "H & J PLUMBING SUPPLIES ". - 05 FILLER PIC X(25) VALUE "INCREMENTAL BACKUP CORP. ". - 05 FILLER PIC X(25) VALUE "JOHNSON BOATING SUPPLIES ". - 05 FILLER PIC X(25) VALUE "KONFLAB PLASTIC PRODUCTS.". - 05 FILLER PIC X(25) VALUE "LEWISTON GRAPHICS LTD. ". - 05 FILLER PIC X(25) VALUE "MORNINGSIDE CARPENTRY. ". - 05 FILLER PIC X(25) VALUE "NEW WAVE SURF SHOPS INC. ". - 05 FILLER PIC X(25) VALUE "OLD TYME PIZZA MFG. CO. ". - 05 FILLER PIC X(25) VALUE "PRESTIGE OFFICE FURNITURE". - - 02 DATA-COMPANY REDEFINES DATA-COMPANY-TBL - PIC X(25) OCCURS 16. - 02 DATA-ADDRESS-1-TBL. - 05 FILLER PIC X(25) VALUE "123 MAIN STREET ". - 05 FILLER PIC X(25) VALUE "1090 2ND AVE. WEST ". - 05 FILLER PIC X(25) VALUE "1401 JEFFERSON BLVD. ". - 05 FILLER PIC X(25) VALUE "1620 ARIZONA WAY ". - 05 FILLER PIC X(25) VALUE "1184 EAST FIRST STREET ". - 05 FILLER PIC X(25) VALUE "114 JOHN F. KENNEDY AVE. ". - 05 FILLER PIC X(25) VALUE "650 LIBERTY CRESCENT ". - 05 FILLER PIC X(25) VALUE "77 SUNSET BLVD. ". - 05 FILLER PIC X(25) VALUE "10908 SANTA MONICA BLVD. ". - 05 FILLER PIC X(25) VALUE "1134 PARIS ROAD ". - 05 FILLER PIC X(25) VALUE "808 NORTHWEST MAIN ST. ". - 05 FILLER PIC X(25) VALUE "9904 QUEEN STREET ". - 05 FILLER PIC X(25) VALUE "1709 DUNDAS CRESCENT W. ". - 05 FILLER PIC X(25) VALUE "3240 MARIS AVENUE ". - 05 FILLER PIC X(25) VALUE "1705 WISCONSIN ROAD ". - 05 FILLER PIC X(25) VALUE "114A MAPLE GROVE ". - - 02 DATA-ADDRESS-1 REDEFINES DATA-ADDRESS-1-TBL - PIC X(25) OCCURS 16. - 02 DATA-ADDRESS-2-TBL. - 05 FILLER PIC X(10) VALUE "NEW YORK ". - 05 FILLER PIC X(10) VALUE "ATLANTA ". - 05 FILLER PIC X(10) VALUE "WASHINGTON". - 05 FILLER PIC X(10) VALUE "TORONTO ". - 05 FILLER PIC X(10) VALUE "CALGARY ". - 05 FILLER PIC X(10) VALUE "SAN DIEGO ". - 05 FILLER PIC X(10) VALUE "LOS RIOS ". - 05 FILLER PIC X(10) VALUE "MADISON ". - 05 FILLER PIC X(10) VALUE "WILBUR ". - 05 FILLER PIC X(10) VALUE "TOPEKA ". - 05 FILLER PIC X(10) VALUE "SEATTLE ". - 05 FILLER PIC X(10) VALUE "NEW JERSEY". - 05 FILLER PIC X(10) VALUE "FORT WAYNE". - 05 FILLER PIC X(10) VALUE "COLUMBUS ". - 05 FILLER PIC X(10) VALUE "RICHMOND ". - 05 FILLER PIC X(10) VALUE "WHITEPLAIN". - - 02 DATA-ADDRESS-2 REDEFINES DATA-ADDRESS-2-TBL - PIC X(10) OCCURS 16. - 02 DATA-ADDRESS-3-TBL. - 05 FILLER PIC X(10) VALUE "N.Y. ". - 05 FILLER PIC X(10) VALUE "GEORGIA ". - 05 FILLER PIC X(10) VALUE "D.C. ". - 05 FILLER PIC X(10) VALUE "CANADA ". - 05 FILLER PIC X(10) VALUE "CANADA ". - 05 FILLER PIC X(10) VALUE "CALIFORNIA". - 05 FILLER PIC X(10) VALUE "NEW MEXICO". - 05 FILLER PIC X(10) VALUE "WISCONSIN ". - 05 FILLER PIC X(10) VALUE "DELAWARE ". - 05 FILLER PIC X(10) VALUE "KANSAS ". - 05 FILLER PIC X(10) VALUE "WASHINGTON". - 05 FILLER PIC X(10) VALUE "N.J. ". - 05 FILLER PIC X(10) VALUE "COLORADO ". - 05 FILLER PIC X(10) VALUE "OHIO ". - 05 FILLER PIC X(10) VALUE "VIRGINIA ". - 05 FILLER PIC X(10) VALUE "N.Y. ". - - 02 DATA-ADDRESS-3 REDEFINES DATA-ADDRESS-3-TBL - PIC X(10) OCCURS 16. - 02 DATA-TELEPHONE-TBL. - 05 FILLER PIC 9(10) VALUE 3131234432. - 05 FILLER PIC 9(10) VALUE 4082938498. - 05 FILLER PIC 9(10) VALUE 8372487274. - 05 FILLER PIC 9(10) VALUE 4169898509. - 05 FILLER PIC 9(10) VALUE 5292398745. - 05 FILLER PIC 9(10) VALUE 8009329492. - 05 FILLER PIC 9(10) VALUE 6456445643. - 05 FILLER PIC 9(10) VALUE 6546456333. - 05 FILLER PIC 9(10) VALUE 3455445444. - 05 FILLER PIC 9(10) VALUE 9006445643. - 05 FILLER PIC 9(10) VALUE 7456434355. - 05 FILLER PIC 9(10) VALUE 6554456433. - 05 FILLER PIC 9(10) VALUE 4169898509. - 05 FILLER PIC 9(10) VALUE 9004587453. - 05 FILLER PIC 9(10) VALUE 8787458374. - 05 FILLER PIC 9(10) VALUE 4169898509. - - 02 DATA-TELEPHONE REDEFINES DATA-TELEPHONE-TBL - PIC 9(10) OCCURS 16. - 02 DATA-DP-MGR-TBL. - 05 FILLER PIC X(20) VALUE "MR. DAVE HARRIS ". - 05 FILLER PIC X(20) VALUE "MS. JANICE SILCOX ". - 05 FILLER PIC X(20) VALUE "MR. ALLAN JONES ". - 05 FILLER PIC X(20) VALUE "MR. PETER MACKAY ". - 05 FILLER PIC X(20) VALUE "MRS. DONNA BREWER ". - 05 FILLER PIC X(20) VALUE "MR. MICHAEL SMYTHE ". - 05 FILLER PIC X(20) VALUE "MR. D.A. MORRISON ". - 05 FILLER PIC X(20) VALUE "MR. BRIAN PATTERSON ". - 05 FILLER PIC X(20) VALUE "MR. DARRYL TOWNSEND ". - 05 FILLER PIC X(20) VALUE "MS. VALERIE HARPER ". - 05 FILLER PIC X(20) VALUE "MR. FRED MILLER ". - 05 FILLER PIC X(20) VALUE "MR. DONALD FISCHER ". - 05 FILLER PIC X(20) VALUE "MR. STEVEN YOURDIN ". - 05 FILLER PIC X(20) VALUE "MS. Goldie Hawn ". - 05 FILLER PIC X(20) VALUE "MS. ALICE WINSTON ". - 05 FILLER PIC X(20) VALUE "MR. THOMAS JEFFERSON". - - 02 DATA-DP-MGR REDEFINES DATA-DP-MGR-TBL - PIC X(20) OCCURS 16. - 02 DATA-MACHINE-TBL. - 05 FILLER PIC X(8) VALUE "UNI-9030". - 05 FILLER PIC X(8) VALUE "UNI-9040". - 05 FILLER PIC X(8) VALUE "UNI-80/3". - 05 FILLER PIC X(8) VALUE "UNI-80/5". - 05 FILLER PIC X(8) VALUE "UNI-80/6". - 05 FILLER PIC X(8) VALUE "UNI-80/6". - 05 FILLER PIC X(8) VALUE "UNI-80/6". - 05 FILLER PIC X(8) VALUE "UNI-80/8". - 05 FILLER PIC X(8) VALUE "UNI-80/8". - 05 FILLER PIC X(8) VALUE "UNI-80/8". - 05 FILLER PIC X(8) VALUE "UNI-80/8". - 05 FILLER PIC X(8) VALUE "UNI-80/8". - 05 FILLER PIC X(8) VALUE "UNI-80/8". - 05 FILLER PIC X(8) VALUE "UNI-80/8". - 05 FILLER PIC X(8) VALUE "UNI-9040". - 05 FILLER PIC X(8) VALUE "UNI-9040". - - 02 DATA-MACHINE REDEFINES DATA-MACHINE-TBL - PIC X(8) OCCURS 16. - 02 DATA-NO-TERMINALS-TBL. - 05 FILLER PIC 9(3) COMP-3 VALUE 85. - 05 FILLER PIC 9(3) COMP-3 VALUE 34. - 05 FILLER PIC 9(3) COMP-3 VALUE 75. - 05 FILLER PIC 9(3) COMP-3 VALUE 45. - 05 FILLER PIC 9(3) COMP-3 VALUE 90. - 05 FILLER PIC 9(3) COMP-3 VALUE 107. - 05 FILLER PIC 9(3) COMP-3 VALUE 67. - 05 FILLER PIC 9(3) COMP-3 VALUE 32. - 05 FILLER PIC 9(3) COMP-3 VALUE 16. - 05 FILLER PIC 9(3) COMP-3 VALUE 34. - 05 FILLER PIC 9(3) COMP-3 VALUE 128. - 05 FILLER PIC 9(3) COMP-3 VALUE 64. - 05 FILLER PIC 9(3) COMP-3 VALUE 110. - 05 FILLER PIC 9(3) COMP-3 VALUE 324. - 05 FILLER PIC 9(3) COMP-3 VALUE 124. - 05 FILLER PIC 9(3) COMP-3 VALUE 86. - - 02 DATA-NO-TERMINALS REDEFINES DATA-NO-TERMINALS-TBL - PIC 9(3) COMP-3 OCCURS 16. - - 01 WORK-AREA. - 05 REC-NUM PICTURE 9(6) VALUE 0. - 05 REC-MAX PICTURE 9(6) VALUE 10. - 05 SUB PICTURE 9(4) COMP SYNC. - 88 ODD-RECORD VALUE 1 3 5 7 9 10 11. - 88 NULL-KEY VALUE 4 5 8 12 14. - - 05 TSPFL-KEY PICTURE X(8). - 01 CMD-LINE. - 05 CMD PICTURE X(3). - 05 FILLER PICTURE X. - 05 CMD-KEY PICTURE X(8). - - PROCEDURE DIVISION. - - MAINFILE. - ACCEPT CMD-LINE FROM COMMAND-LINE. - DISPLAY "IX_OPTIONS" UPON ENVIRONMENT-NAME - IF CMD = 'OCI' - OR CMD = 'OLK' - DISPLAY "format=oci" UPON ENVIRONMENT-VALUE - ELSE - DISPLAY "format=odbc" UPON ENVIRONMENT-VALUE. - IF CMD = 'LCK' - OR CMD = 'OLK' - OR CMD = 'SKP' - PERFORM LOCKTEST. - PERFORM LOADFILE. - PERFORM LISTFILE. - PERFORM REWRFILE. - PERFORM READFILE. - STOP RUN. - - LOADFILE. - DISPLAY "Loading sample data file." - UPON CONSOLE. - - OPEN EXCLUSIVE OUTPUT TSPFILE - IF CUST-STAT NOT = "00" - AND CUST-STAT NOT = "05" - DIVIDE STAT-1 BY 256 GIVING BYTE-1 REMAINDER BYTE-2 - DISPLAY "Error " CUST-STAT " " BYTE-1 " " BYTE-2 - " opening 'testisam' file" UPON CONSOLE - STOP RUN - END-IF. - - PERFORM 1000-LOAD-RECORD - VARYING SUB FROM 1 BY 1 - UNTIL SUB > MAX-SUB. - - DISPLAY "Sample data file load complete." - UPON CONSOLE. - CLOSE TSPFILE. - - REWRFILE. - DELETE FILE TSPFILE. - DISPLAY "Rewrite sample data file: " CUST-STAT - UPON CONSOLE. - - OPEN I-O TSPFILE - IF CUST-STAT NOT = "00" - AND CUST-STAT NOT = "05" - DIVIDE STAT-1 BY 256 GIVING BYTE-1 REMAINDER BYTE-2 - DISPLAY "Error " CUST-STAT " " BYTE-1 " " BYTE-2 - " opening 'testisam' file" - UPON CONSOLE - STOP RUN - END-IF. - - MOVE 'N' TO DO-REWRITE. - PERFORM 1000-LOAD-RECORD - VARYING SUB FROM 1 BY 1 - UNTIL SUB > MAX-SUB. - MOVE 'Y' TO DO-REWRITE. - PERFORM 1000-LOAD-RECORD - VARYING SUB FROM 1 BY 2 - UNTIL SUB > MAX-SUB. - MOVE 'N' TO DO-REWRITE. - - DISPLAY "Sample data file rewrite complete." - UPON CONSOLE. - CLOSE TSPFILE. - - *---------------------------------------------------------------* - * LOAD A RECORD FROM DATA TABLES * - *---------------------------------------------------------------* - - 1000-LOAD-RECORD. - - MOVE SPACES TO TSPFL-RECORD. - MOVE DATA-CUST-NUM (SUB) TO CM-CUST-NUM. - MOVE CM-CUST-NUM TO TSPFL-KEY. - MOVE DATA-COMPANY (SUB) TO CM-COMPANY. - MOVE DATA-ADDRESS-1 (SUB) TO CM-ADDRESS-1. - MOVE DATA-ADDRESS-2 (SUB) TO CM-ADDRESS-2. - MOVE DATA-ADDRESS-3 (SUB) TO CM-ADDRESS-3. - MOVE DATA-TELEPHONE (SUB) TO CM-TELEPHONE. - MOVE DATA-DP-MGR (SUB) TO CM-DP-MGR. - MOVE DATA-MACHINE (SUB) TO CM-MACHINE. - MOVE DATA-NO-TERMINALS (SUB) TO CM-NO-TERMINALS. - MOVE DATA-NO-TERMINALS (SUB) TO CM-COMPX. - MOVE DATA-NO-TERMINALS (SUB) TO CM-COMP5. - MOVE DATA-NO-TERMINALS (SUB) TO CM-COMP1. - MOVE DATA-NO-TERMINALS (SUB) TO CM-COMP2. - - IF ODD-RECORD - MOVE "8417" TO CM-DISK - MOVE "1600 BPI" TO CM-TAPE - MOVE 1.50 TO CM-PRICE - MOVE -91.50 TO CM-PRICES - MOVE 12192019 TO CM-DATE - MOVE 19121920 TO CM-DATE2 - MOVE "01MB" TO CM-MEMORY - ADD 3.12 TO CM-COMP2 - ELSE - MOVE "8470" TO CM-DISK - MOVE 7.50 TO CM-PRICE - MOVE -97.50 TO CM-PRICES - MOVE "6250 BPI" TO CM-TAPE - MOVE 04112022 TO CM-DATE - MOVE 22041120 TO CM-DATE2 - ADD 2.71 TO CM-COMP1 - MOVE "03GB" TO CM-MEMORY. - IF NULL-KEY - MOVE ALL "*" TO CM-DISK CM-DP-MGR CM-MACHINE - MOVE "X" TO CM-STATUS - MOVE ALL "7" TO CM-TAPE. - IF SUB = 1 OR 6 - MOVE "2417" TO CM-DISK - MOVE "549 mmm" TO CM-TAPE. - - IF DO-REWRITE = 'Y' - IF SUB NOT = 1 AND SUB NOT = 6 - MOVE "REWRITE" TO CM-DISK - END-IF - REWRITE TSPFL-RECORD - IF CUST-STAT NOT = "00" - AND CUST-STAT NOT = "02" - DISPLAY "REWRITE: " TSPFL-KEY ", Status: " - CUST-STAT UPON CONSOLE - END-IF - ELSE - WRITE TSPFL-RECORD - IF CUST-STAT NOT = "00" - AND CUST-STAT NOT = "02" - DISPLAY "WRITE: " TSPFL-KEY ", Status: " - CUST-STAT UPON CONSOLE - END-IF - END-IF. - - READFILE. - DISPLAY "READ SAMPLE FILE" UPON CONSOLE. - MOVE ZERO TO REC-NUM - OPEN I-O TSPFILE. - IF CUST-STAT NOT = "00" - DISPLAY "ERROR " CUST-STAT " OPENING INPUT FILE" - UPON CONSOLE - STOP RUN - END-IF. - COMMIT. - MOVE SPACES TO TSPFL-RECORD. - MOVE DATA-CUST-NUM (4) TO CM-CUST-NUM. - MOVE DATA-COMPANY (4) TO CM-COMPANY. - READ TSPFILE WITH NO LOCK - IF CUST-STAT NOT = "00" - DISPLAY "Error " CUST-STAT " on direct read of file" - UPON CONSOLE - CLOSE TSPFILE - STOP RUN - END-IF. - DISPLAY "Key: " CM-CUST-NUM " is " CM-COMPANY UPON CONSOLE - READ TSPFILE NEXT RECORD WITH NO LOCK - IF CUST-STAT NOT = "00" - DISPLAY "Error " CUST-STAT " on read next of file" - UPON CONSOLE - CLOSE TSPFILE - STOP RUN - END-IF. - DISPLAY "Key: " CM-CUST-NUM " is " CM-COMPANY UPON CONSOLE. - READ TSPFILE PREVIOUS RECORD WITH NO LOCK - IF CUST-STAT NOT = "00" - DISPLAY "Error " CUST-STAT " on read previous of file" - UPON CONSOLE - CLOSE TSPFILE - STOP RUN - END-IF. - DISPLAY "Key: " CM-CUST-NUM " is " CM-COMPANY UPON CONSOLE. - MOVE DATA-CUST-NUM (8) TO CM-CUST-NUM. - MOVE DATA-COMPANY (8) TO CM-COMPANY. - READ TSPFILE WITH LOCK - DISPLAY "Key: " CM-CUST-NUM " is " CM-COMPANY UPON CONSOLE. - READ TSPFILE NEXT RECORD WITH LOCK - IF CUST-STAT NOT = "00" - DISPLAY "Error " CUST-STAT " on read next lock of file" - UPON CONSOLE - CLOSE TSPFILE - STOP RUN - END-IF. - DISPLAY "Key: " CM-CUST-NUM " is " CM-COMPANY UPON CONSOLE. - MOVE CM-CUST-NUM TO SAV-KEY. - DELETE TSPFILE - IF CUST-STAT NOT = "00" - DISPLAY "Error " CUST-STAT " on DELETE " - UPON CONSOLE - CLOSE TSPFILE - STOP RUN - END-IF. - DISPLAY "Key: " CM-CUST-NUM " was deleted " UPON CONSOLE. - DELETE TSPFILE - DISPLAY "Error " CUST-STAT " on DUP DELETE " - UPON CONSOLE. - READ TSPFILE - IF CUST-STAT NOT = "00" - DISPLAY "Error " CUST-STAT " on reread of file" - UPON CONSOLE - ELSE - DISPLAY "Read:" CM-CUST-NUM " unexpected" UPON CONSOLE - END-IF. - REWRITE TSPFL-RECORD - DISPLAY "Error " CUST-STAT " on Bad REWRITE" - UPON CONSOLE. - * CLOSE TSPFILE. - * STOP RUN. - ROLLBACK. - MOVE SAV-KEY TO CM-CUST-NUM. - READ TSPFILE WITH LOCK - IF CUST-STAT NOT = "00" - DISPLAY "Error " CUST-STAT " on reread after Rollback" - UPON CONSOLE - ELSE - DISPLAY "Read Key: " CM-CUST-NUM " after Rollback" - END-IF. - MOVE SAV-KEY TO CM-CUST-NUM. - READ TSPFILE WITH NO LOCK - IF CUST-STAT NOT = "00" - DISPLAY "Error " CUST-STAT " on reread after Rollback" - UPON CONSOLE - END-IF. - CLOSE TSPFILE. - - LISTFILE. - DISPLAY "LIST SAMPLE FILE" UPON CONSOLE. - MOVE ZERO TO REC-NUM - OPEN INPUT TSPFILE - IF CUST-STAT NOT = "00" - DISPLAY "ERROR " CUST-STAT " OPENING INPUT FILE" - UPON CONSOLE - IF CUST-STAT (1:1) = "9" - DISPLAY "Sub Error " STAT-X2 UPON CONSOLE - END-IF - STOP RUN - END-IF. - MOVE SPACES TO TSPFL-RECORD. - MOVE DATA-CUST-NUM (4) TO CM-CUST-NUM. - READ TSPFILE WITH NO LOCK - IF CUST-STAT NOT = "00" - DISPLAY "Error " CUST-STAT " on direct read of file" - UPON CONSOLE - CLOSE TSPFILE - STOP RUN - END-IF. - DISPLAY "Key: " CM-CUST-NUM " is " CM-COMPANY UPON CONSOLE - IF CM-COMPANY = LOW-VALUES - DISPLAY "Error with direct read of file" UPON CONSOLE - CLOSE TSPFILE - STOP RUN - END-IF. - - MOVE SPACES TO TSPFL-RECORD. - START TSPFILE KEY GREATER THAN PRIME-KEY - IF CUST-STAT NOT = "00" - DISPLAY "Error " CUST-STAT " starting file" - UPON CONSOLE - CLOSE TSPFILE - STOP RUN - END-IF. - READ TSPFILE NEXT RECORD WITH NO LOCK - IF CUST-STAT NOT = "00" - DISPLAY "Error " CUST-STAT " on 1st read of file" - UPON CONSOLE - CLOSE TSPFILE - STOP RUN - END-IF. - PERFORM UNTIL CUST-STAT NOT = "00" - OR REC-NUM > REC-MAX - DISPLAY "Key: " CM-CUST-NUM " is " CM-COMPANY - " Disk=" CM-DISK "." - UPON CONSOLE - READ TSPFILE NEXT RECORD - AT END - MOVE "99" TO CUST-STAT - END-READ - ADD 1 TO REC-NUM - END-PERFORM - IF CUST-STAT = "99" - DISPLAY "Hit End of File" UPON CONSOLE - END-IF. - - DISPLAY "LIST SAMPLE FILE DESCENDING from " - CM-CUST-NUM UPON CONSOLE. - MOVE ZERO TO REC-NUM - START TSPFILE KEY LESS THAN PRIME-KEY - IF CUST-STAT NOT = "00" - DISPLAY "Error " CUST-STAT " starting file" - UPON CONSOLE - STOP RUN - END-IF. - READ TSPFILE PREVIOUS RECORD WITH NO LOCK - IF CUST-STAT NOT = "00" - DISPLAY "Error " CUST-STAT " on 1st read of file" - UPON CONSOLE - STOP RUN - END-IF. - PERFORM UNTIL CUST-STAT NOT = "00" - OR REC-NUM > REC-MAX - DISPLAY "Key: " CM-CUST-NUM " is " CM-COMPANY - " Disk=" CM-DISK "." - UPON CONSOLE - READ TSPFILE PREVIOUS RECORD - AT END - MOVE "99" TO CUST-STAT - END-READ - ADD 1 TO REC-NUM - END-PERFORM. - - DISPLAY "LIST SAMPLE FILE BY KEY2" UPON CONSOLE. - MOVE ZERO TO REC-NUM - MOVE SPACES TO TSPFL-RECORD. - START TSPFILE KEY GREATER THAN OR EQUAL TO SPLIT-KEY2 - IF CUST-STAT NOT = "00" - AND CUST-STAT NOT = "02" - DISPLAY "Error " CUST-STAT " starting file" - UPON CONSOLE - STOP RUN - END-IF. - READ TSPFILE NEXT RECORD WITH NO LOCK - IF CUST-STAT NOT = "00" - AND CUST-STAT NOT = "02" - DISPLAY "Error " CUST-STAT " on 1st read of file" - UPON CONSOLE - STOP RUN - END-IF. - PERFORM UNTIL (CUST-STAT NOT = "00" - AND CUST-STAT NOT = "02") - OR REC-NUM > REC-MAX - DISPLAY "Key: " CM-CUST-NUM - " Phone=" CM-TELEPHONE - " Machine=" CM-MACHINE - "." UPON CONSOLE - READ TSPFILE NEXT RECORD - AT END - MOVE "99" TO CUST-STAT - END-READ - ADD 1 TO REC-NUM - END-PERFORM. - CLOSE TSPFILE. - - DISPLAY "LIST SAMPLE FILE BY KEY3" UPON CONSOLE. - MOVE ZERO TO REC-NUM - MOVE SPACES TO TSPFL-RECORD. - START TSPFILE KEY GREATER THAN OR EQUAL TO SPLIT-KEY3 - IF CUST-STAT NOT = "00" - AND CUST-STAT NOT = "02" - DISPLAY "Error " CUST-STAT " starting file" - UPON CONSOLE - STOP RUN - END-IF. - READ TSPFILE NEXT RECORD WITH NO LOCK - IF CUST-STAT NOT = "00" - AND CUST-STAT NOT = "02" - DISPLAY "Error " CUST-STAT " on 1st read of file" - UPON CONSOLE - STOP RUN - END-IF. - PERFORM UNTIL (CUST-STAT NOT = "00" - AND CUST-STAT NOT = "02") - OR REC-NUM > REC-MAX - DISPLAY "Key: " CM-CUST-NUM - " Disk=" CM-DISK - " Mgr=" CM-DP-MGR - " Machine=" CM-MACHINE - "." UPON CONSOLE - READ TSPFILE NEXT RECORD - AT END - MOVE "99" TO CUST-STAT - END-READ - ADD 1 TO REC-NUM - END-PERFORM. - CLOSE TSPFILE. - - LOCKTEST. - DISPLAY "Locking record " CMD-KEY UPON CONSOLE. - MOVE ZERO TO REC-NUM - OPEN I-O TSPFILE. - IF CUST-STAT NOT = "00" - DISPLAY "ERROR " CUST-STAT " OPENING INPUT FILE" - UPON CONSOLE - STOP RUN - END-IF. - COMMIT. - MOVE SPACES TO TSPFL-RECORD. - MOVE CMD-KEY TO CM-CUST-NUM. - IF CMD = 'SKP' - DISPLAY "Read with SKIP " CMD-KEY - READ TSPFILE ADVANCING ON LOCK WITH LOCK - ELSE - DISPLAY "Read with LOCK " CMD-KEY - READ TSPFILE RETRY FOR 5 SECONDS WITH LOCK - END-IF. - IF CUST-STAT NOT = "00" - DISPLAY "Error " CUST-STAT " on read of " CMD-KEY - UPON CONSOLE - CLOSE TSPFILE - STOP RUN - END-IF. - DISPLAY "Hold: " CM-CUST-NUM " is " CM-COMPANY UPON CONSOLE - CALL "sleep" USING BY VALUE 20. - CLOSE TSPFILE. - STOP RUN. -_ATEOF - - -# FIXME: currently the .ddl is always created, should be only upon request -{ set +x -$as_echo "$at_srcdir/syn_file.at:2900: \$COMPILE -Wno-unsupported -fsqldb=mysql prog.cob" -at_fn_check_prepare_dynamic "$COMPILE -Wno-unsupported -fsqldb=mysql prog.cob" "syn_file.at:2900" -( $at_check_trace; $COMPILE -Wno-unsupported -fsqldb=mysql prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/syn_file.at:2900" -$at_failed && at_fn_log_failure -$at_traceon; } - - - - - -cat >reference <<'_ATEOF' -DROP TABLE tspfilex; -CREATE TABLE tspfilex ( - custnum CHAR(8) NOT NULL, - status CHAR(1), - company CHAR(25), - custaddr VARCHAR(75), - telephone DECIMAL(10) NOT NULL, - dp_mgr CHAR(25) NOT NULL, - machine CHAR(8) NOT NULL, - memory CHAR(4), - memsz DECIMAL(2), - memunit CHAR(2), - disk CHAR(8) NOT NULL, - tape CHAR(8), - tapex DECIMAL(8), - tapey DECIMAL(8,2), - no_terminals DECIMAL(5), - compx DECIMAL(8), - comp5 DECIMAL(7), - comp1 FLOAT(23), - comp2 FLOAT(53), - price DECIMAL(5,2), - prices DECIMAL(7,2), - date_x DATE, - date2 DATE -); -CREATE UNIQUE INDEX pk_tspfilex ON tspfilex (custnum); -CREATE INDEX k1_tspfilex ON tspfilex (telephone,machine); -CREATE INDEX k2_tspfilex ON tspfilex (disk,dp_mgr,machine); -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/syn_file.at:2936: diff reference tspfilex.ddl" -at_fn_check_prepare_trace "syn_file.at:2936" -( $at_check_trace; diff reference tspfilex.ddl -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/syn_file.at:2936" -$at_failed && at_fn_log_failure \ -"./tspfilex.ddl" -$at_traceon; } - - - - - -cat >reference <<'_ATEOF' -# generation comment here -H,1,tspfilex,2,',','.',0,3 -D,1,'MMDDYYYY',8,1,0,,0,4:4,0:2,2:2,0:0,0:0,0:0,0:0 -D,2,'YYMMDDCC',8,1,0,,0,0:2,2:2,4:2,0:0,0:0,0:0,6:2 -F,0000,0008,20,0009,0,0,,10,custnum -F,0008,0001,20,0002,0,0,,10,status -F,0009,0025,20,0026,0,0,,10,company -F,0034,0075,21,0076,0,0,,10,custaddr -F,0109,0010,16,0013,10,0,,10,telephone -F,0119,0025,20,0026,0,0,,10,dp_mgr -F,0144,0008,20,0009,0,0,,10,machine -C,0,=,status,'A' -C,0,>,telephone,100 -C,0,&& -C,0,=,machine,'B' -C,0,=,company,' ' -C,0,|| -C,2,&& -F,0152,0004,20,0005,0,0,,10,memory -G,3 -L,2 -F,0152,0002,16,0005,2,0,,15,memsz -F,0154,0002,20,0003,0,0,,15,memunit -L,3 -F,0156,0008,20,0009,0,0,,10,disk -C,5,=,status,'X' -C,6,=,status,'Y' -F,0164,0008,20,0009,0,0,,10,tape -G,7 -L,5 -F,0164,0008,16,0011,8,0,,10,tapex -G,7 -L,6 -F,0164,0008,16,0011,8,2,,10,tapey -L,7 -F,0172,0004,06,0013,5,0,,10,no_terminals -F,0176,0003,07,0011,8,0,,10,compx -F,0179,0004,03,0013,7,0,,10,comp5 -F,0183,0004,08,0036,15,8,,10,comp1 -F,0187,0008,08,0036,34,17,,10,comp2 -F,0195,0003,10,0008,5,2,,10,price -F,0198,0007,13,0010,7,2,,10,prices -F,0205,0005,10,0032,8,0,1,10,date_x -F,0210,0005,10,0032,8,0,2,10,date2 -K,0,N,N,,custnum -K,1,Y,Y,"900",telephone,machine -K,2,Y,Y,0x2A,disk,dp_mgr,machine -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/syn_file.at:2991: gcdiff -I# reference tspfilex.xd" -at_fn_check_prepare_trace "syn_file.at:2991" -( $at_check_trace; gcdiff -I# reference tspfilex.xd -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/syn_file.at:2991" -$at_failed && at_fn_log_failure \ -"./tspfilex.ddl" \ -"./tspfilex.xd" -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_201 -#AT_START_202 -at_fn_group_banner 202 'syn_reportwriter.at:23' \ - "REPORT error/warning" " " 2 -at_xfail=no -( - $as_echo "202. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - INPUT-OUTPUT SECTION. - FILE-CONTROL. - SELECT TRANSACTION-DATA - ASSIGN TO EXTERNAL DATAIN - ORGANIZATION IS LINE SEQUENTIAL. - - SELECT REPORT-FILE - ASSIGN TO EXTERNAL LINE ADVANCING SYSPRINT. - - DATA DIVISION. - FILE SECTION. - FD TRANSACTION-DATA. - 01 TRANSACTION-RECORD. - 03 TR-CUSTOMER-NUMBER PIC 9(04). - 03 FILLER PIC X(01). - 03 TR-CUSTOMER-NAME PIC X(16). - 03 FILLER PIC X(01). - 03 TR-ITEM-NUMBER PIC 9(05). - 03 FILLER REDEFINES TR-ITEM-NUMBER. - 05 TR-ITEM-DEPARTMENT PIC 9(01). - 05 FILLER PIC 9(04). - 03 FILLER PIC X(01). - 03 TR-ITEM-COST PIC 9(03)V99. - 03 FILLER PIC X(47). - FD REPORT-FILE - REPORT IS NO-REPORT. - WORKING-STORAGE SECTION. - 01 END-OF-FILE-SWITCH PIC X(1) VALUE 'N'. - 88 END-OF-FILE VALUE 'Y'. - 88 GOFOREVER VALUE 'X'. - - REPORT SECTION. - RD NO-REPORT - PAGE LIMIT IS 66 LINES - HEADING 1 - FIRST DETAIL 5 - LAST DETAIL 58. - - 01 PAGE-HEAD-GROUP TYPE PAGE HEADING. - 02 LINE 1. - 03 COLUMN 27 PIC X(41) VALUE - 'S A M P L E R E P O R T'. - 02 LINE PLUS 2. - 03 COLUMN 01 PIC X(09) VALUE 'CUST. NO.'. - 03 COLUMN 15 PIC X(10) VALUE 'CUST. NAME'. - 03 COLUMN 30 PIC X(05) VALUE 'DEPT.'. - 03 COLUMN 39 PIC X(08) VALUE 'ITEM NO.'. - 03 COLUMN 51 PIC X(09) VALUE 'ITEM COST'. - - 01 CHARGE-DETAIL TYPE DETAIL. - 02 LINE PLUS 1. - 03 COLUMN 03 PIC Z(04) SOURCE TR-CUSTOMER-NUMBER. - 03 COLUMN 10 PIC X(16) SOURCE TR-CUSTOMER-NAME. - 03 COLUMN 32 PIC 9(01) SOURCE TR-ITEM-DEPARTMENT. - 03 COLUMN 40 PIC 9(05) SOURCE TR-ITEM-NUMBER. - 03 COLUMN 51 PIC $$$$.99 SOURCE TR-ITEM-COST. - - PROCEDURE DIVISION. - - OPEN INPUT TRANSACTION-DATA, - OUTPUT REPORT-FILE. - - INITIATE CUSTOMER-REPORT. - - READ TRANSACTION-DATA - AT END - MOVE 'Y' TO END-OF-FILE-SWITCH - END-READ. - - PERFORM UNTIL GOFOREVER - GENERATE CHARGE-DETAIL - READ TRANSACTION-DATA - AT END - EXIT PERFORM - END-READ - END-PERFORM. - - TERMINATE CUSTOMER-REPORT. - - CLOSE TRANSACTION-DATA, - REPORT-FILE. - - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/syn_reportwriter.at:115: \$COMPILE_ONLY prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY prog.cob" "syn_reportwriter.at:115" -( $at_check_trace; $COMPILE_ONLY prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob:67: error: 'CUSTOMER-REPORT' is not defined -prog.cob:67: error: 'CUSTOMER-REPORT' is not a valid report name -prog.cob:82: error: 'CUSTOMER-REPORT' is not defined -prog.cob:82: error: 'CUSTOMER-REPORT' is not a valid report name -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/syn_reportwriter.at:115" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_202 -#AT_START_203 -at_fn_group_banner 203 'syn_reportwriter.at:125' \ - "REPORT not positive integers in COL / LINE PLUS" "" 2 -at_xfail=no -( - $as_echo "203. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - - ENVIRONMENT DIVISION. - INPUT-OUTPUT SECTION. - FILE-CONTROL. - SELECT out-file ASSIGN "blah.txt" - ORGANIZATION LINE SEQUENTIAL. - - DATA DIVISION. - FILE SECTION. - FD out-file REPORT rp. - - REPORT SECTION. - RD rp. - 01 rp-head TYPE PH. - 02 LINE NUMBER IS 1, COLUMNS 0 VALUE "Hello!". - 02 LINE IS 2, COLS 2 VALUE "Hello!". - 02 LINE NUMBERS ARE PLUS 1. - 03 COLUMN NUMBER 01 PIC X(09) VALUE 'CUST. NO.'. - 03 COLUMN PLUS 0 PIC X(09) VALUE 'ITEM'. - 02 LINES ARE PLUS 2 COL NUMBERS PLUS 0. - 03 COLUMN 1.5 PIC X(09) VALUE 'CUST. NO.'. - 03 COLUMN + -10 PIC X(09) VALUE 'ITEM'. - - 01 rp-detail TYPE DETAIL. - 02 LINE PLUS 1. - 03 COLUMN 03 PIC X(06) VALUE 'SAMPLE'. - 03 COLUMN +9 PIC X(06) VALUE 'REPORT'. - - PROCEDURE DIVISION. - OPEN OUTPUT out-file. - INITIATE rp. - GENERATE rp-detail. - TERMINATE rp. - CLOSE out-file. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/syn_reportwriter.at:168: \$COMPILE_ONLY -std=mf prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY -std=mf prog.cob" "syn_reportwriter.at:168" -( $at_check_trace; $COMPILE_ONLY -std=mf prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob:18: error: invalid COLUMN integer; must be > 0 -prog.cob:24: error: unsigned integer value expected -prog.cob:25: error: unsigned integer value expected -prog.cob:30: error: unsigned integer value expected -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/syn_reportwriter.at:168" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_203 -#AT_START_204 -at_fn_group_banner 204 'syn_reportwriter.at:178' \ - "Missing DETAIL line" " " 2 -at_xfail=no -( - $as_echo "204. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - - ENVIRONMENT DIVISION. - INPUT-OUTPUT SECTION. - FILE-CONTROL. - SELECT out-file ASSIGN "blah.txt" - ORGANIZATION LINE SEQUENTIAL. - - DATA DIVISION. - FILE SECTION. - FD out-file REPORT rp. - - REPORT SECTION. - RD rp. - 01 rp-head TYPE PH. - 02 LINE 1, COL 2 VALUE "Hello!". - 02 LINE PLUS 1. - 03 COLUMN 01 PIC X(09) VALUE 'CUST. NO.'. - 03 COLUMN PLUS 20 PIC X(09) VALUE 'ITEM'. - - - PROCEDURE DIVISION. - OPEN OUTPUT out-file. - INITIATE rp. - GENERATE rp-detail. - TERMINATE rp. - CLOSE out-file. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/syn_reportwriter.at:213: \$COMPILE_ONLY prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY prog.cob" "syn_reportwriter.at:213" -( $at_check_trace; $COMPILE_ONLY prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob:13: warning: no DETAIL line defined in report rp -prog.cob:27: error: 'rp-detail' is not defined -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/syn_reportwriter.at:213" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_204 -#AT_START_205 -at_fn_group_banner 205 'syn_reportwriter.at:221' \ - "REPORT LINE PLUS ZERO" " " 2 -at_xfail=no -( - $as_echo "205. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - - ENVIRONMENT DIVISION. - INPUT-OUTPUT SECTION. - FILE-CONTROL. - SELECT out-file ASSIGN "blah.txt" - ORGANIZATION LINE SEQUENTIAL. - - DATA DIVISION. - FILE SECTION. - FD out-file REPORT rp. - - REPORT SECTION. - RD rp. - 01 rp-head TYPE PH. - 02 LINE 1 COL 5 PIC X(20) VALUE "Hello World!". - 02 LINE 2 COL 4 PIC X(20) VALUE "Hello Goodbye!". - 02 LINE PLUS 0. - 03 COLUMN 1 PIC X(09) VALUE 'CUST. No.'. - 03 COLUMN PLUS 0 PIC X(09) VALUE 'ITEM'. - 02 LINE PLUS ZERO. - 03 COLUMN 1 PIC X(09) VALUE 'Cust. No.'. - 03 COLUMN + 10 PIC X(09) VALUE 'Item'. - - 01 rp-detail TYPE DETAIL. - 02 LINE PLUS 1. - 03 COLUMN 03 PIC X(06) VALUE 'SAMPLE'. - - PROCEDURE DIVISION. - OPEN OUTPUT out-file. - INITIATE rp. - GENERATE rp-detail. - TERMINATE rp. - CLOSE out-file. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/syn_reportwriter.at:263: \$COMPILE_ONLY prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY prog.cob" "syn_reportwriter.at:263" -( $at_check_trace; $COMPILE_ONLY prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob:20: warning: LINE PLUS 0 is not implemented -prog.cob:23: warning: LINE PLUS 0 is not implemented -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/syn_reportwriter.at:263" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_205 -#AT_START_206 -at_fn_group_banner 206 'syn_reportwriter.at:271' \ - "Incorrect REPORT NAME" " " 2 -at_xfail=no -( - $as_echo "206. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - INPUT-OUTPUT SECTION. - FILE-CONTROL. - SELECT TRANSACTION-DATA - ASSIGN TO EXTERNAL DATAIN - ORGANIZATION IS LINE SEQUENTIAL. - - SELECT REPORT-FILE - ASSIGN TO EXTERNAL LINE ADVANCING SYSPRINT. - - DATA DIVISION. - FILE SECTION. - FD TRANSACTION-DATA - LABEL RECORDS ARE OMITTED - BLOCK CONTAINS 0 RECORDS - RECORD CONTAINS 80 CHARACTERS - DATA RECORD IS TRANSACTION-RECORD. - 01 TRANSACTION-RECORD. - 03 TR-CUSTOMER-NUMBER PIC 9(04). - 03 FILLER PIC X(01). - 03 TR-CUSTOMER-NAME PIC X(16). - 03 FILLER PIC X(01). - 03 TR-ITEM-NUMBER PIC 9(05). - 03 FILLER REDEFINES TR-ITEM-NUMBER. - 05 TR-ITEM-DEPARTMENT PIC 9(01). - 05 FILLER PIC 9(04). - 03 FILLER PIC X(01). - 03 TR-ITEM-COST PIC 9(03)V99. - 03 FILLER PIC X(47). - FD REPORT-FILE - LABEL RECORDS ARE OMITTED - REPORT IS NO-REPORT. - WORKING-STORAGE SECTION. - 01 END-OF-FILE-SWITCH PIC X(1) VALUE 'N'. - 88 END-OF-FILE VALUE 'Y'. - 88 GOFOREVER VALUE 'X'. - - REPORT SECTION. - RD SOME-REPORT - PAGE LIMIT IS 66 LINES - HEADING 1 - FIRST DETAIL 5 - LAST DETAIL 58. - - 01 PAGE-HEAD-GROUP TYPE PAGE HEADING. - 02 LINE 1. - 03 COLUMN 27 PIC X(41) VALUE - 'S A M P L E R E P O R T'. - 02 LINE PLUS 2. - 03 COLUMN 01 PIC X(09) VALUE 'CUST. NO.'. - 03 COLUMN 15 PIC X(10) VALUE 'CUST. NAME'. - 03 COLUMN 30 PIC X(05) VALUE 'DEPT.'. - 03 COLUMN 39 PIC X(08) VALUE 'ITEM NO.'. - 03 COLUMN 51 PIC X(09) VALUE 'ITEM COST'. - - 01 CHARGE-DETAIL TYPE DETAIL. - 02 LINE PLUS 1. - 03 COLUMN 03 PIC Z(04) SOURCE TR-CUSTOMER-NUMBER. - 03 COLUMN 10 PIC X(16) SOURCE TR-CUSTOMER-NAME. - 03 COLUMN 32 PIC 9(01) SOURCE TR-ITEM-DEPARTMENT. - 03 COLUMN 40 PIC 9(05) SOURCE TR-ITEM-NUMBER. - 03 COLUMN 51 PIC $$$$.99 SOURCE TR-ITEM-COST. - - PROCEDURE DIVISION. - - OPEN INPUT TRANSACTION-DATA, - OUTPUT REPORT-FILE. - - INITIATE CUSTOMER-REPORT. - - READ TRANSACTION-DATA - AT END - MOVE 'Y' TO END-OF-FILE-SWITCH - END-READ. - - PERFORM UNTIL GOFOREVER - GENERATE CHARGE-DETAIL - READ TRANSACTION-DATA - AT END - EXIT PERFORM - END-READ - END-PERFORM. - - TERMINATE CUSTOMER-REPORT. - - CLOSE TRANSACTION-DATA, - REPORT-FILE. - - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/syn_reportwriter.at:368: \$COMPILE_ONLY -std=mf-strict prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY -std=mf-strict prog.cob" "syn_reportwriter.at:368" -( $at_check_trace; $COMPILE_ONLY -std=mf-strict prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob:17: warning: LABEL RECORDS is obsolete in Micro Focus COBOL -prog.cob:19: warning: RECORD clause ignored for LINE SEQUENTIAL -prog.cob:20: warning: DATA RECORDS is obsolete in Micro Focus COBOL -prog.cob:34: warning: LABEL RECORDS is obsolete in Micro Focus COBOL -prog.cob:42: error: 'SOME-REPORT' is not defined -prog.cob:42: error: 'SOME-REPORT' is not a valid report name -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/syn_reportwriter.at:368" -$at_failed && at_fn_log_failure -$at_traceon; } - - -{ set +x -$as_echo "$at_srcdir/syn_reportwriter.at:377: \$COMPILE_ONLY -std=cobol2002 -fassign-ext-dyn=ok prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY -std=cobol2002 -fassign-ext-dyn=ok prog.cob" "syn_reportwriter.at:377" -( $at_check_trace; $COMPILE_ONLY -std=cobol2002 -fassign-ext-dyn=ok prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob:17: error: syntax error, unexpected Identifier, expecting EXTERNAL or GLOBAL -prog.cob:34: error: syntax error, unexpected Identifier, expecting EXTERNAL or GLOBAL -prog.cob:36: error: RECORD description missing or invalid -prog.cob:42: error: 'SOME-REPORT' is not defined -prog.cob:42: error: 'SOME-REPORT' is not a valid report name -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/syn_reportwriter.at:377" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_206 -#AT_START_207 -at_fn_group_banner 207 'syn_reportwriter.at:388' \ - "REPORT with PLUS RIGHT/CENTER" " " 2 -at_xfail=no -( - $as_echo "207. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - CONFIGURATION SECTION. - INPUT-OUTPUT SECTION. - FILE-CONTROL. - SELECT INPUT-FILE ASSIGN TO EXTERNAL STUDENT - ORGANIZATION IS LINE SEQUENTIAL. - SELECT PRINT-FILE ASSIGN TO EXTERNAL - LINE ADVANCING REPORT1. - - DATA DIVISION. - FILE SECTION. - FD INPUT-FILE. - 01 INPUT-REC. - 05 STUDENT-ID PIC 9(5). - 05 STUDENT-NAME PIC X(20). - 05 MAJOR PIC XXX. - 05 NUM-COURSES PIC 9(6). - - FD PRINT-FILE - REPORT IS STUDENT-REPORT. - - WORKING-STORAGE SECTION. - 01 ARE-THERE-MORE-RECORDS PIC XXX VALUE "YES". - - REPORT SECTION. - RD STUDENT-REPORT - PAGE LIMIT 30 LINES - HEADING 1 - FIRST DETAIL 3 - LAST DETAIL 25 - FOOTING 28. - 01 HEADING-LINE - TYPE PAGE HEADING LINE PLUS 1. - 05 COLUMN 1 PIC X(2) VALUE "Ln". - 05 COLUMN 4 PIC X(6) VALUE "--ID--". - 05 COLUMN 16 PIC X(20) VALUE "--------Name--------". - 05 COLUMN 39 PIC X(5) VALUE " Mjr". - 05 COLUMN 48 PIC XXX VALUE "*-*". - 05 COLUMN 54 PIC X(5) VALUE "+Num+". - - 01 REPORT-LINE - TYPE DETAIL LINE PLUS 1. - 05 COLUMN PLUS 1 PIC 9(2) - SOURCE LINE-COUNTER OF STUDENT-REPORT. - 05 COLUMN LEFT PLUS 1 PIC Z(5)9 SOURCE STUDENT-ID. - 05 COLUMN CENTER 25 PIC X(20) SOURCE STUDENT-NAME. - 05 COLUMN RIGHT 43 PIC X(5) SOURCE MAJOR. - 05 COLUMN 48 PIC XXX VALUE "<->". - 05 COLUMN CENTER 56 PIC Z(4)9 SOURCE NUM-COURSES. - 05 COLUMN 60 62 65 PIC Z9 OCCURS 3 TIMES. - - PROCEDURE DIVISION. - A000-MAINLINE. - OPEN INPUT INPUT-FILE - OUTPUT PRINT-FILE - PERFORM DO-INIT. - READ INPUT-FILE - AT END - MOVE "NO" TO ARE-THERE-MORE-RECORDS. - PERFORM A001-LOOP - UNTIL ARE-THERE-MORE-RECORDS = "NO ". - PERFORM DO-TERM. - CLOSE INPUT-FILE - PRINT-FILE. - STOP RUN. - - A001-LOOP. - GENERATE REPORT-LINE. - READ INPUT-FILE - AT END - MOVE "NO " TO ARE-THERE-MORE-RECORDS. - DO-INIT. - INITIATE STUDENT-REPORT. - - DO-TERM. - TERMINATE STUDENT-REPORT. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/syn_reportwriter.at:472: \$COMPILE_ONLY prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY prog.cob" "syn_reportwriter.at:472" -( $at_check_trace; $COMPILE_ONLY prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob:46: warning: PLUS is ignored on first field of line -prog.cob:48: error: PLUS is not allowed with LEFT, RIGHT or CENTER -prog.cob:53: error: OCCURS and multi COLUMNs is not allowed -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/syn_reportwriter.at:472" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_207 -#AT_START_208 -at_fn_group_banner 208 'syn_reportwriter.at:481' \ - "PAGE LIMITS clause" " " 2 -at_xfail=no -( - $as_echo "208. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - - ENVIRONMENT DIVISION. - INPUT-OUTPUT SECTION. - FILE-CONTROL. - SELECT f ASSIGN "f.txt". - - DATA DIVISION. - FILE SECTION. - FD f REPORT r1, r2. - 01 f-rec PIC XXXXX. - - REPORT SECTION. - RD r1 PAGE LIMIT 1 LINES 1 COLUMNS - HEADING f-rec, - HEADING f-rec, - LINE LIMIT 1. - - RD r2 PAGE LIMIT 1 COLUMNS - HEADING f-rec. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/syn_reportwriter.at:508: \$COMPILE_ONLY prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY prog.cob" "syn_reportwriter.at:508" -( $at_check_trace; $COMPILE_ONLY prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob:19: error: duplicate HEADING clause -prog.cob:19: error: duplicate LINE LIMIT clause -prog.cob:22: error: Cannot specify HEADING without number of lines on page -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/syn_reportwriter.at:508" -$at_failed && at_fn_log_failure -$at_traceon; } - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_208 -#AT_START_209 -at_fn_group_banner 209 'syn_reportwriter.at:516' \ - "Report FD without period" " " 2 -at_xfail=no -( - $as_echo "209. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - - ENVIRONMENT DIVISION. - INPUT-OUTPUT SECTION. - FILE-CONTROL. - SELECT f ASSIGN "f.txt". - - DATA DIVISION. - FILE SECTION. - FD f REPORT r -_ATEOF - - -# In this case, the error handler enters an infinite loop, but it's OK as the -# error is still easy to identify and it doesn't occur if anything follows the -# "REPORT r". -{ set +x -$as_echo "$at_srcdir/syn_reportwriter.at:536: \$COMPILE_ONLY -fmax-errors=4 prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY -fmax-errors=4 prog.cob" "syn_reportwriter.at:536" -( $at_check_trace; $COMPILE_ONLY -fmax-errors=4 prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob:13: error: syntax error, unexpected end of file -prog.cob:13: error: syntax error, unexpected end of file -prog.cob:13: error: syntax error, unexpected end of file -prog.cob:13: error: syntax error, unexpected end of file -prog.cob:13: error: syntax error, unexpected end of file -cobc: too many errors - -cobc: aborting compile of prog.cob at line 13 (PROGRAM-ID: prog) -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 97 $at_status "$at_srcdir/syn_reportwriter.at:536" -$at_failed && at_fn_log_failure -$at_traceon; } - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_209 -#AT_START_210 -at_fn_group_banner 210 'syn_reportwriter.at:549' \ - "REPORT with unreferenced control field" " " 2 -at_xfail=no -( - $as_echo "210. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - - ENVIRONMENT DIVISION. - INPUT-OUTPUT SECTION. - FILE-CONTROL. - SELECT f ASSIGN "f.txt". - - DATA DIVISION. - FILE SECTION. - FD f REPORT r. - 01 f-rec PIC X. - - REPORT SECTION. - RD r. - 01 r0 TYPE DETAIL, PRESENT AFTER NEW f-rec. -_ATEOF - - -# no compile_only here as we check the C generation -{ set +x -$as_echo "$at_srcdir/syn_reportwriter.at:572: \$COMPILE prog.cob " -at_fn_check_prepare_dynamic "$COMPILE prog.cob " "syn_reportwriter.at:572" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/syn_reportwriter.at:572" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_210 -#AT_START_211 -at_fn_group_banner 211 'syn_reportwriter.at:577' \ - "Incorrect USAGE clause" " " 2 -at_xfail=no -( - $as_echo "211. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - - ENVIRONMENT DIVISION. - INPUT-OUTPUT SECTION. - FILE-CONTROL. - SELECT report-file ASSIGN EXTERNAL PRINTOUT - ORGANIZATION LINE SEQUENTIAL. - - DATA DIVISION. - FILE SECTION. - FD report-file REPORT rp. - - WORKING-STORAGE SECTION. - 01 foo PIC X(20). - - REPORT SECTION. - RD rp PAGE LIMIT 3. - - 01 rp-detail TYPE DE. - 02 LINE PLUS 1. - 03 FILLER SOURCE foo PIC X(30). - 03 FILLER PIC X(6) VALUE "<--->". - 03 THING1 PIC 9(3) BINARY VALUE 12. - 03 FILLER PIC 9 COMP-5 VALUE 1. - 03 THING3 COMP-2 VALUE 12. - - PROCEDURE DIVISION. - OPEN OUTPUT report-file. - INITIATE rp. - - MOVE "hello" TO foo. - GENERATE rp-detail. - - MOVE "goodbye" TO foo. - GENERATE rp-detail. - - TERMINATE rp. - CLOSE report-file. - STOP RUN. - END PROGRAM prog. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/syn_reportwriter.at:624: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "syn_reportwriter.at:624" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob:25: error: REPORT SECTION item 'THING1' should be USAGE DISPLAY -prog.cob:26: error: REPORT SECTION item 'FILLER 4' should be USAGE DISPLAY -prog.cob:27: error: REPORT SECTION item 'THING3' should be USAGE DISPLAY -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/syn_reportwriter.at:624" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_211 -#AT_START_212 -at_fn_group_banner 212 'syn_refmod.at:25' \ - "valid reference modification" " " 2 -at_xfail=no -( - $as_echo "212. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 X PIC X(4) VALUE "abcd". - PROCEDURE DIVISION. - DISPLAY X(1:1) ":" X(1:2) ":" X(1:3) ":" X(1:4) ":" X(1:) - END-DISPLAY. - DISPLAY X(2:1) ":" X(2:2) ":" X(2:3) ":" X(2:) - END-DISPLAY. - DISPLAY X(3:1) ":" X(3:2) ":" X(3:) - END-DISPLAY. - DISPLAY X(4:1) ":" X(4:) - END-DISPLAY. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/syn_refmod.at:46: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "syn_refmod.at:46" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/syn_refmod.at:46" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_212 -#AT_START_213 -at_fn_group_banner 213 'syn_refmod.at:51' \ - "Static out of bounds" " " 2 -at_xfail=no -( - $as_echo "213. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 X PIC X(4). - 01 Y PIC 9 VALUE 1. - PROCEDURE DIVISION. - DISPLAY X(0:1) - END-DISPLAY. - DISPLAY X(0:Y) - END-DISPLAY. - DISPLAY X(5:1) - END-DISPLAY. - DISPLAY X(5:Y) - END-DISPLAY. - DISPLAY X(1:0) - END-DISPLAY. - DISPLAY X(Y:0) - END-DISPLAY. - DISPLAY X(1:5) - END-DISPLAY. - DISPLAY X(Y:5) - END-DISPLAY. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/syn_refmod.at:81: \$COMPILE_ONLY -std=cobol2002 prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY -std=cobol2002 prog.cob" "syn_refmod.at:81" -( $at_check_trace; $COMPILE_ONLY -std=cobol2002 prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob:9: error: offset must be greater than zero -prog.cob:11: error: offset must be greater than zero -prog.cob:13: error: offset of 'X' out of bounds: 5 -prog.cob:15: error: offset of 'X' out of bounds: 5 -prog.cob:17: error: length must be greater than zero -prog.cob:19: error: length must be greater than zero -prog.cob:21: error: length of 'X' out of bounds: 5 -prog.cob:23: error: length of 'X' out of bounds: 5 -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/syn_refmod.at:81" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_213 -#AT_START_214 -at_fn_group_banner 214 'syn_refmod.at:95' \ - "constant-folding out of bounds" " " 2 -at_xfail=no -( - $as_echo "214. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 78 VAR-LEN VALUE 4. - 01 X PIC X(VAR-LEN). - PROCEDURE DIVISION. - IF VAR-LEN < 4 - DISPLAY X(4 - VAR-LEN:1) - END-DISPLAY - DISPLAY X(1: 4 - VAR-LEN) - END-DISPLAY - DISPLAY X(9 - VAR-LEN:1) - END-DISPLAY - DISPLAY X(1:9 - VAR-LEN) - END-DISPLAY - *> special test... - INSPECT X CONVERTING "DEF" TO X (1:0 + VAR-LEN) - END-IF - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/syn_refmod.at:121: \$COMPILE_ONLY -std=default -freference-bounds-check=error -Wno-constant-expr prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY -std=default -freference-bounds-check=error -Wno-constant-expr prog.cob" "syn_refmod.at:121" -( $at_check_trace; $COMPILE_ONLY -std=default -freference-bounds-check=error -Wno-constant-expr prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob:10: error (ignored): offset must be greater than zero -prog.cob:12: error (ignored): length must be greater than zero -prog.cob:14: error (ignored): offset of 'X' out of bounds: 5 -prog.cob:16: error (ignored): length of 'X' out of bounds: 5 -prog.cob:19: error (ignored): CONVERTING operands differ in size -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/syn_refmod.at:121" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/syn_refmod.at:128: \$COMPILE_ONLY -Wno-constant-expr -fno-constant-folding prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY -Wno-constant-expr -fno-constant-folding prog.cob" "syn_refmod.at:128" -( $at_check_trace; $COMPILE_ONLY -Wno-constant-expr -fno-constant-folding prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/syn_refmod.at:128" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_214 -#AT_START_215 -at_fn_group_banner 215 'syn_refmod.at:133' \ - "Reference Bounds check" " " 2 -at_xfail=no -( - $as_echo "215. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 TSTLEN PIC 99 VALUE 10. - 01 TSTBIN PIC 99 COMP VALUE 10. - 01 TSTBIN10 PIC 9(9) COMP VALUE 825373492. - 01 TSTX4 PIC X(4). - 01 TSTREC. - 05 TSTTAIL2 PIC X. - 05 TSTTAIL3 PIC X. - 05 FILLER PIC X(8). - 05 TSTEND PIC X. - 01 TSTREC2 PIC X(20). - 01 TSTXX PIC X(2). - PROCEDURE DIVISION. - MOVE " " TO TSTTAIL2 (1:2). - MOVE SPACES TO TSTTAIL3 (2:8). - MOVE " " TO TSTTAIL3 (1:15). - MOVE ALL "*" TO TSTREC (-1:-1). - MOVE " " TO TSTTAIL2 (1:0). - MOVE '$' TO TSTEND. - DISPLAY "TSTREC is " TSTREC. - MOVE ALL "+" TO TSTTAIL3 (0:TSTLEN). - MOVE '$' TO TSTEND. - DISPLAY "TSTREC is " TSTREC. - MOVE 11 to TSTLEN. - MOVE SPACES TO TSTTAIL2 (1:TSTLEN). - MOVE '$' TO TSTEND. - DISPLAY "TSTREC is " TSTREC. - MOVE '12' TO TSTXX. - MOVE TSTXX TO TSTLEN. - DISPLAY "TSTLEN is " TSTLEN. - MOVE ' 3' TO TSTXX. - MOVE TSTXX TO TSTLEN. - DISPLAY "TSTLEN is " TSTLEN. - MOVE ' ' TO TSTXX. - MOVE TSTXX TO TSTLEN. - DISPLAY "TSTLEN is " TSTLEN. - MOVE 75 TO TSTLEN. - MOVE TSTLEN TO TSTXX. - DISPLAY "TSTXX is " TSTXX " vs " TSTLEN. - MOVE ' 3' TO TSTXX. - MOVE TSTXX TO TSTBIN. - DISPLAY "TSTBIN is " TSTBIN. - ADD 1 to TSTBIN. - MOVE TSTBIN TO TSTXX. - DISPLAY "TSTXX is " TSTXX " vs " TSTBIN. - MOVE TSTBIN10 (1:4) TO TSTX4 (1:4). - DISPLAY "TSTBIN10 is " TSTBIN10 " vs '" TSTX4 "'". - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/syn_refmod.at:189: \$COMPILE_ONLY -std=cobol2002 prog.cob " -at_fn_check_prepare_dynamic "$COMPILE_ONLY -std=cobol2002 prog.cob " "syn_refmod.at:189" -( $at_check_trace; $COMPILE_ONLY -std=cobol2002 prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob:17: error: length of 'TSTTAIL2' out of bounds: 2 -prog.cob:18: error: offset of 'TSTTAIL3' out of bounds: 2 -prog.cob:19: error: length of 'TSTTAIL3' out of bounds: 15 -prog.cob:20: error: offset must be greater than zero -prog.cob:20: error: length must be greater than zero -prog.cob:21: error: length must be greater than zero -prog.cob:24: error: offset must be greater than zero -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/syn_refmod.at:189" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_215 -#AT_START_216 -at_fn_group_banner 216 'syn_misc.at:23' \ - "ambiguous AND/OR" " " 2 -at_xfail=no -( - $as_echo "216. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 ONE PIC 9 VALUE 1. - 01 TWO PIC 9 VALUE 2. - 01 THREE PIC 9 VALUE 3. - PROCEDURE DIVISION. - IF THREE = ONE AND TWO OR THREE - DISPLAY "OK" - END-DISPLAY - END-IF. - IF 3 = 1 OR 2 AND 3 - DISPLAY "NO" - END-DISPLAY - END-IF. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/syn_misc.at:46: \$COMPILE_ONLY -Wno-constant-expression prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY -Wno-constant-expression prog.cob" "syn_misc.at:46" -( $at_check_trace; $COMPILE_ONLY -Wno-constant-expression prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob:10: warning: suggest parentheses around AND within OR -prog.cob:14: warning: suggest parentheses around OR within AND -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/syn_misc.at:46" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_216 -#AT_START_217 -at_fn_group_banner 217 'syn_misc.at:54' \ - "warn constant expressions" " " 2 -at_xfail=no -( - $as_echo "217. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - PROCEDURE DIVISION. - IF 3 = 1 - AND 2 OR 3 - DISPLAY "OK" - END-DISPLAY - END-IF. - IF 3 = 1 OR - 2 AND 3 - DISPLAY "NO" - END-DISPLAY - END-IF. - STOP RUN. -_ATEOF - - -# FIXME positions broken -{ set +x -$as_echo "$at_srcdir/syn_misc.at:75: \$COMPILE_ONLY -w -Wconstant-expression prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY -w -Wconstant-expression prog.cob" "syn_misc.at:75" -( $at_check_trace; $COMPILE_ONLY -w -Wconstant-expression prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob:5: warning: expression '3' EQUALS '1' is always FALSE -prog.cob:6: warning: expression '3' EQUALS '2' is always FALSE -prog.cob:6: warning: expression '3' EQUALS '3' is always TRUE -prog.cob:10: warning: expression '3' EQUALS '1' is always FALSE -prog.cob:11: warning: expression '3' EQUALS '2' is always FALSE -prog.cob:11: warning: expression '3' EQUALS '3' is always TRUE -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/syn_misc.at:75" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_217 -#AT_START_218 -at_fn_group_banner 218 'syn_misc.at:87' \ - "warn literal size" " " 2 -at_xfail=no -( - $as_echo "218. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 WS-LINE-NUMBER PIC 9(3) VALUE ZERO. - 01 WS-NUMBER PIC 9(3)V99 VALUE ZERO. - 01 WS-TEXT PIC X(5) VALUE 'CAT'. - 01 PIC-9-SIGNED PIC S9(2) VALUE 5. - 01 PIC-9-SIGNED-DECIMAL PIC S9(2)V99 VALUE 5. - 01 PIC-9-NOT-SIGNED PIC 9(3) VALUE 5. - 01 PIC-9-NOT-DECIMAL PIC 9(3) VALUE 5. - 01 XX PIC 9(2) VALUE 2. - 01 PIC-9-DECIMAL PIC 9(3)V9 VALUE 5. - 01 COMPUTE-1 PIC 999V9999 VALUE 654.1873. - 01 GROUP-ITEM-X6. - 05 FILLER PIC X(6) VALUE 'CAT'. - 78 CONST1 VALUE 'CAT '. - 01 CONST2 CONSTANT AS 00000001234. - 01 IF-D16 PIC PP99 VALUE .0012. - PROCEDURE DIVISION. - MAIN. - IF GROUP-ITEM-X6 = '1234567' CONTINUE. - IF PIC-9-NOT-DECIMAL = 1.1 CONTINUE. - IF PIC-9-NOT-DECIMAL = 1.0 - CONTINUE. - IF PIC-9-DECIMAL = 1.01 - CONTINUE. - IF PIC-9-DECIMAL = 1.100 - CONTINUE. - IF PIC-9-SIGNED NOT = 11.0 - CONTINUE. - IF PIC-9-NOT-SIGNED < 0 - CONTINUE. - IF PIC-9-NOT-SIGNED < ZERO - CONTINUE. - IF PIC-9-NOT-SIGNED < (25 - 50) - CONTINUE. - IF PIC-9-DECIMAL = (2.24 / 2) - CONTINUE. - IF PIC-9-NOT-DECIMAL = "123" - CONTINUE. - IF PIC-9-NOT-DECIMAL = "1B0" *> field is numeric - CONTINUE. - IF PIC-9-NOT-DECIMAL (1:3) = "1B0" *> refmod is always alphanumeric - CONTINUE. - IF PIC-9-NOT-DECIMAL (1:3) NOT = "Hot Doggy" - CONTINUE. - IF PIC-9-NOT-DECIMAL (1:XX) NOT = "Hi" - CONTINUE. - IF WS-LINE-NUMBER > '123' - CONTINUE. - IF WS-TEXT > 'DOGGY' - CONTINUE. - IF WS-NUMBER > 123.999 - CONTINUE. - IF WS-LINE-NUMBER > 2345 - CONTINUE. - IF WS-LINE-NUMBER <= 1234 - CONTINUE. - IF WS-LINE-NUMBER > '1234' - CONTINUE. - IF 5432 < WS-LINE-NUMBER - CONTINUE. - IF 7855 >= WS-LINE-NUMBER - CONTINUE. - IF 1234 < WS-LINE-NUMBER - CONTINUE. - IF 5432 >= WS-LINE-NUMBER - CONTINUE. - IF WS-TEXT > 'DOGGY++' - CONTINUE. - IF WS-TEXT > 3141596 - CONTINUE. - IF WS-TEXT > 3.141596 - CONTINUE. - IF WS-TEXT = 3.141596 - CONTINUE. - IF 'DOG+CAT' NOT = WS-TEXT - CONTINUE. - IF WS-TEXT = 'CAT+DOG' - CONTINUE. - EVALUATE TRUE - WHEN 'DOG+CAT' = WS-TEXT - CONTINUE - WHEN CONST1 = 'CAT+DOG' - CONTINUE - WHEN CONST1 = 'CAT' - CONTINUE - WHEN CONST2 = 1234 - CONTINUE - END-EVALUATE - IF WS-LINE-NUMBER > 0000234 - CONTINUE. - IF WS-TEXT = 'CAT ' - CONTINUE. - IF ( COMPUTE-1 < 654.20038) AND - ( COMPUTE-1 > 654.17422) THEN - CONTINUE. - IF ( COMPUTE-1 < 5654.20) CONTINUE. - IF ( COMPUTE-1 > 5654.20) CONTINUE. - IF COMPUTE-1 < 05654.20 CONTINUE. - IF COMPUTE-1 > 05654.20 CONTINUE. - IF ( 5654.20 > COMPUTE-1) CONTINUE. - IF ( 5654.20 < COMPUTE-1) CONTINUE. - IF 05654.20 > COMPUTE-1 CONTINUE. - IF 05654.20 < COMPUTE-1 CONTINUE. - IF IF-D16 POSITIVE - CONTINUE. - IF IF-D16 NOT POSITIVE - CONTINUE. - IF IF-D16 NEGATIVE - CONTINUE. - IF IF-D16 NOT NEGATIVE - CONTINUE. - IF PIC-9-NOT-SIGNED > (25 - 50) - CONTINUE. - IF PIC-9-NOT-SIGNED >= -1 CONTINUE. - IF PIC-9-NOT-SIGNED >= -.1 CONTINUE. - IF PIC-9-NOT-SIGNED > 0.0 CONTINUE. - IF PIC-9-NOT-SIGNED > .0 CONTINUE. - IF PIC-9-NOT-SIGNED > ZERO - CONTINUE. - IF PIC-9-NOT-SIGNED >= 0.0 CONTINUE. - IF PIC-9-NOT-SIGNED >= .0 CONTINUE. - IF PIC-9-NOT-SIGNED >= ZERO - CONTINUE. - IF GROUP-ITEM-X6 (1:6) = '123456' - CONTINUE. - * Both have correct error check verified in syn_refmod.at - * IF GROUP-ITEM-X6 (2:6) = '123456' - * CONTINUE. - * IF GROUP-ITEM-X6 (WS-LINE-NUMBER:7) = '123456' - * CONTINUE. - IF GROUP-ITEM-X6 (1:5) = '123456' - CONTINUE. - IF GROUP-ITEM-X6 (3:) = '12345' - CONTINUE. - IF GROUP-ITEM-X6 (3:WS-LINE-NUMBER) = '12345' - CONTINUE. - IF GROUP-ITEM-X6 (WS-LINE-NUMBER:3) = '12345' - CONTINUE. - IF GROUP-ITEM-X6 (WS-LINE-NUMBER:WS-LINE-NUMBER) = '12345' - CONTINUE. - IF GROUP-ITEM-X6 (WS-LINE-NUMBER:) = '12345' - CONTINUE. - IF PIC-9-NOT-DECIMAL > 9 CONTINUE. - IF PIC-9-NOT-DECIMAL > 009 CONTINUE. - IF PIC-9-NOT-DECIMAL > 900 CONTINUE. - IF PIC-9-NOT-DECIMAL > 909 CONTINUE. - IF PIC-9-NOT-DECIMAL > 999 CONTINUE. - IF PIC-9-NOT-DECIMAL > 0000999 CONTINUE. - IF PIC-9-DECIMAL > 999 CONTINUE. - IF PIC-9-DECIMAL > 990.9 CONTINUE. - IF PIC-9-DECIMAL > 999.9 CONTINUE. - IF PIC-9-DECIMAL > 0999.90 CONTINUE. - IF PIC-9-DECIMAL > -0999.90 CONTINUE. - IF PIC-9-SIGNED-DECIMAL > 99.99 CONTINUE. - IF PIC-9-SIGNED-DECIMAL >= 99.99 CONTINUE. - IF PIC-9-SIGNED-DECIMAL < -99.99 CONTINUE. - IF PIC-9-SIGNED-DECIMAL <= -099.990 CONTINUE. - IF PIC-9-SIGNED-DECIMAL <= -099.991 CONTINUE. - - - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/syn_misc.at:257: \$COMPILE_ONLY prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY prog.cob" "syn_misc.at:257" -( $at_check_trace; $COMPILE_ONLY prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob: in paragraph 'MAIN': -prog.cob:23: warning: literal '1234567' is longer than 'GROUP-ITEM-X6' -prog.cob:23: warning: expression is always FALSE -prog.cob:24: warning: literal '1.1' has more decimals than 'PIC-9-NOT-DECIMAL' -prog.cob:24: warning: expression is always FALSE -prog.cob:27: warning: literal '1.01' has more decimals than 'PIC-9-DECIMAL' -prog.cob:27: warning: expression is always FALSE -prog.cob:33: warning: unsigned 'PIC-9-NOT-SIGNED' may not be LESS THAN ZERO -prog.cob:35: warning: unsigned 'PIC-9-NOT-SIGNED' may not be LESS THAN ZERO -prog.cob:38: warning: unsigned 'PIC-9-NOT-SIGNED' may not be LESS THAN -25 -prog.cob:40: warning: literal '1.12' has more decimals than 'PIC-9-DECIMAL' -prog.cob:40: warning: expression is always FALSE -prog.cob:43: warning: literal '1B0' is alphanumeric but 'PIC-9-NOT-DECIMAL' is numeric -prog.cob:47: warning: literal 'Hot Doggy' is longer than 'PIC-9-NOT-DECIMAL' -prog.cob:47: warning: expression is always TRUE -prog.cob:55: warning: literal '123.999' has more decimals than 'WS-NUMBER' -prog.cob:57: warning: literal '2345' has more digits than 'WS-LINE-NUMBER' -prog.cob:57: warning: expression is always FALSE -prog.cob:59: warning: literal '1234' has more digits than 'WS-LINE-NUMBER' -prog.cob:59: warning: expression is always TRUE -prog.cob:61: warning: literal '1234' has more digits than 'WS-LINE-NUMBER' -prog.cob:61: warning: expression is always FALSE -prog.cob:63: warning: literal '5432' has more digits than 'WS-LINE-NUMBER' -prog.cob:63: warning: expression is always FALSE -prog.cob:65: warning: literal '7855' has more digits than 'WS-LINE-NUMBER' -prog.cob:65: warning: expression is always TRUE -prog.cob:67: warning: literal '1234' has more digits than 'WS-LINE-NUMBER' -prog.cob:67: warning: expression is always FALSE -prog.cob:69: warning: literal '5432' has more digits than 'WS-LINE-NUMBER' -prog.cob:69: warning: expression is always TRUE -prog.cob:71: warning: literal 'DOGGY++' is longer than 'WS-TEXT' -prog.cob:73: warning: literal '3141596' is longer than 'WS-TEXT' -prog.cob:75: warning: literal '3.141596' is longer than 'WS-TEXT' -prog.cob:77: warning: literal '3.141596' is longer than 'WS-TEXT' -prog.cob:77: warning: expression is always FALSE -prog.cob:79: warning: literal 'DOG+CAT' is longer than 'WS-TEXT' -prog.cob:79: warning: expression is always TRUE -prog.cob:81: warning: literal 'CAT+DOG' is longer than 'WS-TEXT' -prog.cob:81: warning: expression is always FALSE -prog.cob:84: warning: literal 'DOG+CAT' is longer than 'WS-TEXT' -prog.cob:84: warning: expression is always FALSE -prog.cob:86: warning: expression 'CAT ' EQUALS 'CAT+DOG' is always FALSE -prog.cob:88: warning: expression 'CAT ' EQUALS 'CAT' is always TRUE -prog.cob:90: warning: expression '00000001234' EQUALS '1234' is always TRUE -prog.cob:97: warning: literal '654.20038' has more decimals than 'COMPUTE-1' -prog.cob:98: warning: literal '654.17422' has more decimals than 'COMPUTE-1' -prog.cob:100: warning: literal '5654.20' has more digits than 'COMPUTE-1' -prog.cob:100: warning: expression is always TRUE -prog.cob:101: warning: literal '5654.20' has more digits than 'COMPUTE-1' -prog.cob:101: warning: expression is always FALSE -prog.cob:102: warning: literal '5654.20' has more digits than 'COMPUTE-1' -prog.cob:102: warning: expression is always TRUE -prog.cob:103: warning: literal '5654.20' has more digits than 'COMPUTE-1' -prog.cob:103: warning: expression is always FALSE -prog.cob:104: warning: literal '5654.20' has more digits than 'COMPUTE-1' -prog.cob:104: warning: expression is always TRUE -prog.cob:105: warning: literal '5654.20' has more digits than 'COMPUTE-1' -prog.cob:105: warning: expression is always FALSE -prog.cob:106: warning: literal '5654.20' has more digits than 'COMPUTE-1' -prog.cob:106: warning: expression is always TRUE -prog.cob:107: warning: literal '5654.20' has more digits than 'COMPUTE-1' -prog.cob:107: warning: expression is always FALSE -prog.cob:112: warning: unsigned 'IF-D16' may not be LESS THAN ZERO -prog.cob:114: warning: unsigned 'IF-D16' may not be LESS THAN ZERO -prog.cob:117: warning: unsigned 'PIC-9-NOT-SIGNED' may always be GREATER THAN -25 -prog.cob:118: warning: unsigned 'PIC-9-NOT-SIGNED' may always be GREATER OR EQUAL -1 -prog.cob:119: warning: literal '-.1' has more decimals than 'PIC-9-NOT-SIGNED' -prog.cob:119: warning: unsigned 'PIC-9-NOT-SIGNED' may always be GREATER OR EQUAL -.1 -prog.cob:124: warning: unsigned 'PIC-9-NOT-SIGNED' may always be GREATER OR EQUAL ZERO -prog.cob:125: warning: unsigned 'PIC-9-NOT-SIGNED' may always be GREATER OR EQUAL ZERO -prog.cob:126: warning: unsigned 'PIC-9-NOT-SIGNED' may always be GREATER OR EQUAL ZERO -prog.cob:135: warning: literal '123456' is longer than reference-modification of 'GROUP-ITEM-X6' -prog.cob:135: warning: expression is always FALSE -prog.cob:137: warning: literal '12345' is longer than reference-modification of 'GROUP-ITEM-X6' -prog.cob:137: warning: expression is always FALSE -prog.cob:139: warning: literal '12345' is longer than reference-modification of 'GROUP-ITEM-X6' -prog.cob:139: warning: expression is always FALSE -prog.cob:141: warning: literal '12345' is longer than reference-modification of 'GROUP-ITEM-X6' -prog.cob:141: warning: expression is always FALSE -prog.cob:151: warning: 'PIC-9-NOT-DECIMAL' may not be GREATER THAN 999 -prog.cob:152: warning: 'PIC-9-NOT-DECIMAL' may not be GREATER THAN 999 -prog.cob:155: warning: 'PIC-9-DECIMAL' may not be GREATER THAN 999.9 -prog.cob:156: warning: 'PIC-9-DECIMAL' may not be GREATER THAN 999.9 -prog.cob:157: warning: unsigned 'PIC-9-DECIMAL' may always be GREATER THAN -999.90 -prog.cob:158: warning: 'PIC-9-SIGNED-DECIMAL' may not be GREATER THAN 99.99 -prog.cob:159: warning: 'PIC-9-SIGNED-DECIMAL' may not be GREATER THAN 99.99 -prog.cob:160: warning: 'PIC-9-SIGNED-DECIMAL' may not be LESS THAN -99.99 -prog.cob:161: warning: 'PIC-9-SIGNED-DECIMAL' may not be LESS THAN -99.99 -prog.cob:162: warning: literal '-99.991' has more decimals than 'PIC-9-SIGNED-DECIMAL' -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/syn_misc.at:257" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_218 -#AT_START_219 -at_fn_group_banner 219 'syn_misc.at:352' \ - "warn literal size in constant expr. (level 88)" " " 2 -at_xfail=no -( - $as_echo "219. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 x PIC 9. - 88 never-true value 99. - 01 y PIC 9. - 88 never-truen value -9. - 01 xx pic x. - 88 some-not values 'a', 'b', 'cd'. - 88 some-not-s values '00', 'a', 'b', 'cd'. - - PROCEDURE DIVISION. - if never-true - continue - end-if - if never-truen - continue - end-if - if some-not-s - set some-not to true - set some-not-s to true - end-if - set never-true to true - goback. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/syn_misc.at:384: \$COMPILE_ONLY prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY prog.cob" "syn_misc.at:384" -( $at_check_trace; $COMPILE_ONLY prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob:8: warning: literal '99' has more digits than 'x' -prog.cob:8: warning: expression is always FALSE -prog.cob:13: warning: literal '00' is longer than 'xx' -prog.cob:13: warning: expression is always FALSE -prog.cob:13: warning: literal 'cd' is longer than 'xx' -prog.cob:13: warning: expression is always FALSE -prog.cob:24: warning: value size exceeds data size -prog.cob:24: warning: value size is 2 -prog.cob:11: warning: 'xx' defined here as PIC X -prog.cob:26: warning: value size exceeds data size -prog.cob:26: warning: value is 99 -prog.cob:7: warning: 'x' defined here as PIC 9 -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/syn_misc.at:384" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_219 -#AT_START_220 -at_fn_group_banner 220 'syn_misc.at:402' \ - "Invalid conditional expression (1)" " " 2 -at_xfail=no -( - $as_echo "220. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 CON CONSTANT 10. - 01 V PIC 9. - 78 C78 VALUE 'A'. - PROCEDURE DIVISION. - IF FUNCTION TRIM (' ') - CONTINUE - CONTINUE - END-IF. - IF CON - CONTINUE - CONTINUE - END-IF. - IF V - CONTINUE - CONTINUE - END-IF. - IF C78 - CONTINUE - CONTINUE - END-IF. - IF '2' - CONTINUE - CONTINUE - END-IF. - IF C78 OR V - CONTINUE - CONTINUE - END-IF. - EVALUATE TRUE - WHEN FUNCTION TRIM (' ') - CONTINUE - CONTINUE - WHEN CON - CONTINUE - CONTINUE - WHEN V - CONTINUE - CONTINUE - WHEN C78 - CONTINUE - CONTINUE - WHEN '2' - CONTINUE - WHEN OTHER - CONTINUE - END-EVALUATE. - PERFORM VARYING V - FROM 1 BY 1 - UNTIL FUNCTION TRIM (' ') - CONTINUE - CONTINUE - END-PERFORM. - PERFORM VARYING V - FROM 1 BY 1 - UNTIL V - CONTINUE - CONTINUE - END-PERFORM. - PERFORM VARYING V - FROM 1 BY 1 - UNTIL C78 - CONTINUE - CONTINUE - END-PERFORM. - PERFORM VARYING V - FROM 1 BY 1 - UNTIL '2' - CONTINUE - CONTINUE - END-PERFORM. - IF NOTDEFINED = 1 OR 2 - CONTINUE - END-IF. - - IF (V = 1) AND V - CONTINUE - END-IF - - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/syn_misc.at:491: \$COMPILE_ONLY prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY prog.cob" "syn_misc.at:491" -( $at_check_trace; $COMPILE_ONLY prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob:10: error: invalid expression -prog.cob:14: error: invalid expression -prog.cob:18: error: invalid expression -prog.cob:22: error: invalid expression -prog.cob:26: error: invalid expression -prog.cob:30: error: invalid conditional expression -prog.cob:35: error: invalid expression -prog.cob:38: error: invalid expression -prog.cob:41: error: invalid expression -prog.cob:44: error: invalid expression -prog.cob:47: error: invalid expression -prog.cob:54: error: invalid expression -prog.cob:60: error: invalid expression -prog.cob:66: error: invalid expression -prog.cob:72: error: invalid expression -prog.cob:76: error: 'NOTDEFINED' is not defined -prog.cob:76: error: invalid expression -prog.cob:80: error: invalid expression -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/syn_misc.at:491" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_220 -#AT_START_221 -at_fn_group_banner 221 'syn_misc.at:515' \ - "Invalid conditional expression (2)" " " 2 -at_xfail=no -( - $as_echo "221. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 WRKN PIC S999 VALUE 123. - 01 WRKX PIC X(8) VALUE 'House'. - PROCEDURE DIVISION. - MAIN. - EVALUATE WRKN - GREATER ZERO - < 0 - > 0 - WHEN TRUE - DISPLAY "WHAT IS IT?" - END-EVALUATE. - IF WRKN = 123 EQUAL 456 - DISPLAY "Strange brew! " WRKN - END-IF. - IF WRKN NOT EQUAL 123 NOT = 456 - DISPLAY "Strange brew! " WRKN - END-IF. - IF WRKN = 123 OR 456 - DISPLAY "Home brew! " WRKN - END-IF. - IF WRKX = "Red" OR "White" - DISPLAY "Home wine! " WRKX - END-IF. - IF WRKX <= "Red" = "White" - DISPLAY "Home wine! " WRKX - END-IF. - IF WRKX = "Red" NOT "White" - DISPLAY "Home wine! " WRKX - END-IF. - IF WRKN = (123 - 12) OR - >= (456 + 16) - DISPLAY "And another brew! " WRKN - END-IF. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/syn_misc.at:559: \$COMPILE_ONLY prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY prog.cob" "syn_misc.at:559" -( $at_check_trace; $COMPILE_ONLY prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob: in paragraph 'MAIN': -prog.cob:10: error: GREATER THAN operator may be misplaced -prog.cob:17: error: EQUALS operator may be misplaced -prog.cob:20: error: NOT EQUAL operator may be misplaced -prog.cob:29: error: LESS OR EQUAL operator may be misplaced -prog.cob:32: error: invalid expression -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/syn_misc.at:559" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_221 -#AT_START_222 -at_fn_group_banner 222 'syn_misc.at:571' \ - "Invalid conditional expression (3)" " " 2 -at_xfail=no -( - $as_echo "222. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - DATA DIVISION. - ****************************************************************** - WORKING-STORAGE SECTION. - * - 01 FLD1 PIC 9 VALUE 1. - 01 FLD2 PIC 9 VALUE 2. - 01 FLDX PIC 9 VALUE 5. - 01 FLDY PIC 9 VALUE 6. - - PROCEDURE DIVISION. - IF 1 AND 2 > 1 THEN - DISPLAY 'Test 1 is WRONG' - ELSE - DISPLAY 'Test 1 is OK'. - - IF FLD1 AND FLDX > FLD2 THEN - DISPLAY 'Test 2 is OK' - ELSE - DISPLAY 'Test 2 is Wrong'. - - IF FLD1 OR FLDX > FLD2 THEN - DISPLAY 'Test 2 is OK' - ELSE - DISPLAY 'Test 2 is Wrong'. - - IF FLD1 > 2 AND FLDX > FLD2 THEN - DISPLAY 'Test 2 is OK' - ELSE - DISPLAY 'Test 2 is Wrong'. - - IF FLD2 IS NUMERIC AND FLD1 THEN - DISPLAY 'Test 2 is OK' - ELSE - DISPLAY 'Test 2 is Wrong'. - - IF FLDX > FLD2 AND FLD1 AND 8 THEN - DISPLAY 'Test 3 is OK ' FLDX ' > ' FLD2 ' & ' FLD1 - ELSE - DISPLAY 'Test 3 is Wrong'. - - IF FLDX > FLD2 OR FLD1 OR 8 THEN - DISPLAY 'Test 3 is OK' - ELSE - DISPLAY 'Test 3 is Wrong'. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/syn_misc.at:625: \$COMPILE_ONLY prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY prog.cob" "syn_misc.at:625" -( $at_check_trace; $COMPILE_ONLY prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob:15: error: invalid conditional expression -prog.cob:20: error: invalid conditional expression -prog.cob:25: error: invalid conditional expression -prog.cob:35: error: invalid expression -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/syn_misc.at:625" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_222 -#AT_START_223 -at_fn_group_banner 223 'syn_misc.at:635' \ - "Valid conditional expression" " " 2 -at_xfail=no -( - $as_echo "223. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 var PIC 999. - - PROCEDURE DIVISION. - IF var = 83 AND > 1 + 1 - CONTINUE - END-IF - IF var = 83 AND > 2 - CONTINUE - END-IF - IF var = 83 AND > (1 + 1) - CONTINUE - END-IF - IF (var NOT = 1) OR (var NOT = 2) - CONTINUE - END-IF - . -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/syn_misc.at:662: \$COMPILE_ONLY prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY prog.cob" "syn_misc.at:662" -( $at_check_trace; $COMPILE_ONLY prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/syn_misc.at:662" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/syn_misc.at:663: \$COMPILE_ONLY -fno-constant-folding prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY -fno-constant-folding prog.cob" "syn_misc.at:663" -( $at_check_trace; $COMPILE_ONLY -fno-constant-folding prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/syn_misc.at:663" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_223 -#AT_START_224 -at_fn_group_banner 224 'syn_misc.at:668' \ - "missing headers" " " 2 -at_xfail=no -( - $as_echo "224. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - SOURCE-COMPUTER. GNU-LINUX. - SPECIAL-NAMES. - SYMBOLIC NL IS 101 - NL2 102 - NUMERIC SIGN TRAILING SEPARATE - DECIMAL-POINT IS COMMA - . - - SELECT PRINT-FILE ASSIGN "EXTRXW" - ORGANIZATION LINE SEQUENTIAL - . - DATA DIVISION. - FD PRINT-FILE EXTERNAL. - 01 PRINT-REC PIC X(64). - - DISPLAY "X" - END-DISPLAY - ACCEPT OMITTED - END-ACCEPT - GOBACK - . -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/syn_misc.at:695: \$COMPILE_ONLY prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY prog.cob" "syn_misc.at:695" -( $at_check_trace; $COMPILE_ONLY prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob:2: error: PROGRAM-ID header missing -prog.cob:2: error: ENVIRONMENT DIVISION header missing -prog.cob:2: error: CONFIGURATION SECTION header missing -prog.cob:10: error: INPUT-OUTPUT SECTION header missing -prog.cob:10: error: FILE-CONTROL header missing -prog.cob:14: error: FILE SECTION header missing -prog.cob:17: error: PROCEDURE DIVISION header missing -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/syn_misc.at:695" -$at_failed && at_fn_log_failure -$at_traceon; } - - -{ set +x -$as_echo "$at_srcdir/syn_misc.at:705: \$COMPILE_ONLY -frelax-syntax-checks prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY -frelax-syntax-checks prog.cob" "syn_misc.at:705" -( $at_check_trace; $COMPILE_ONLY -frelax-syntax-checks prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob:2: warning: PROGRAM-ID header missing - assumed -prog.cob:2: warning: ENVIRONMENT DIVISION header missing - assumed -prog.cob:2: warning: CONFIGURATION SECTION header missing - assumed -prog.cob:10: warning: INPUT-OUTPUT SECTION header missing - assumed -prog.cob:10: warning: FILE-CONTROL header missing - assumed -prog.cob:14: warning: FILE SECTION header missing - assumed -prog.cob:17: warning: PROCEDURE DIVISION header missing - assumed -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/syn_misc.at:705" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_224 -#AT_START_225 -at_fn_group_banner 225 'syn_misc.at:718' \ - "one line program" " " 2 -at_xfail=no -( - $as_echo "225. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - DISPLAY "minimal". -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/syn_misc.at:724: \$COMPILE_ONLY prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY prog.cob" "syn_misc.at:724" -( $at_check_trace; $COMPILE_ONLY prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob:1: error: PROGRAM-ID header missing -prog.cob:1: error: PROCEDURE DIVISION header missing -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/syn_misc.at:724" -$at_failed && at_fn_log_failure -$at_traceon; } - - -{ set +x -$as_echo "$at_srcdir/syn_misc.at:729: \$COMPILE_ONLY -frelax-syntax-checks prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY -frelax-syntax-checks prog.cob" "syn_misc.at:729" -( $at_check_trace; $COMPILE_ONLY -frelax-syntax-checks prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob:1: warning: PROGRAM-ID header missing - assumed -prog.cob:1: warning: PROCEDURE DIVISION header missing - assumed -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/syn_misc.at:729" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_225 -#AT_START_226 -at_fn_group_banner 226 'syn_misc.at:737' \ - "empty program" " " 2 -at_xfail=no -( - $as_echo "226. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 x PIC 999 VALUE 124. - END PROGRAM prog. -_ATEOF - - -# Note: we need to test for generating a valid C source (with normal/no flags) -# here, not only for COBOL compilation -{ set +x -$as_echo "$at_srcdir/syn_misc.at:752: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "syn_misc.at:752" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/syn_misc.at:752" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/syn_misc.at:753: \$COBC prog.cob" -at_fn_check_prepare_dynamic "$COBC prog.cob" "syn_misc.at:753" -( $at_check_trace; $COBC prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/syn_misc.at:753" -$at_failed && at_fn_log_failure -$at_traceon; } - - -cat >prog2.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog2. - - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 x PIC 999 VALUE 124. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/syn_misc.at:764: \$COMPILE prog2.cob" -at_fn_check_prepare_dynamic "$COMPILE prog2.cob" "syn_misc.at:764" -( $at_check_trace; $COMPILE prog2.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/syn_misc.at:764" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/syn_misc.at:765: \$COBC prog2.cob" -at_fn_check_prepare_dynamic "$COBC prog2.cob" "syn_misc.at:765" -( $at_check_trace; $COBC prog2.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/syn_misc.at:765" -$at_failed && at_fn_log_failure -$at_traceon; } - - -: >prog3.cob - -{ set +x -$as_echo "$at_srcdir/syn_misc.at:769: \$COMPILE_ONLY prog3.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY prog3.cob" "syn_misc.at:769" -( $at_check_trace; $COMPILE_ONLY prog3.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog3.cob:1: error: PROGRAM-ID header missing -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/syn_misc.at:769" -$at_failed && at_fn_log_failure -$at_traceon; } - - -{ set +x -$as_echo "$at_srcdir/syn_misc.at:773: \$COMPILE -frelax-syntax-checks prog3.cob" -at_fn_check_prepare_dynamic "$COMPILE -frelax-syntax-checks prog3.cob" "syn_misc.at:773" -( $at_check_trace; $COMPILE -frelax-syntax-checks prog3.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog3.cob:1: warning: PROGRAM-ID header missing - assumed -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/syn_misc.at:773" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/syn_misc.at:776: \$COBC -frelax-syntax-checks prog3.cob" -at_fn_check_prepare_dynamic "$COBC -frelax-syntax-checks prog3.cob" "syn_misc.at:776" -( $at_check_trace; $COBC -frelax-syntax-checks prog3.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog3.cob:1: warning: PROGRAM-ID header missing - assumed -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/syn_misc.at:776" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_226 -#AT_START_227 -at_fn_group_banner 227 'syn_misc.at:783' \ - "INITIALIZE constant" " " 2 -at_xfail=no -( - $as_echo "227. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 CON CONSTANT 10. - 01 V PIC 9. - 78 C78 VALUE 'A'. - PROCEDURE DIVISION. - INITIALIZE CON. - INITIALIZE V. - INITIALIZE V, 9. - INITIALIZE C78, V. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/syn_misc.at:801: \$COMPILE_ONLY prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY prog.cob" "syn_misc.at:801" -( $at_check_trace; $COMPILE_ONLY prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob:10: error: invalid INITIALIZE statement -prog.cob:12: error: invalid INITIALIZE statement -prog.cob:13: error: invalid INITIALIZE statement -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/syn_misc.at:801" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_227 -#AT_START_228 -at_fn_group_banner 228 'syn_misc.at:810' \ - "CLASS duplicate values" " " 2 -at_xfail=no -( - $as_echo "228. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - CONFIGURATION SECTION. - SPECIAL-NAMES. - SYMBOLIC NL IS 101 - NL2 102 - CLASS CHECK-VALID 'a' THRU 'z' - 'A' THRU 'Z' - 'cdef' - . - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 X PIC X(8). - PROCEDURE DIVISION. - IF X IS CHECK-VALID - DISPLAY "OK" - END-DISPLAY - END-IF. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/syn_misc.at:836: \$COMPILE_ONLY prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY prog.cob" "syn_misc.at:836" -( $at_check_trace; $COMPILE_ONLY prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob:9: warning: duplicate character values in class 'CHECK-VALID' -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/syn_misc.at:836" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_228 -#AT_START_229 -at_fn_group_banner 229 'syn_misc.at:843' \ - "INSPECT invalid size" " " 2 -at_xfail=no -( - $as_echo "229. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - CONFIGURATION SECTION. - SPECIAL-NAMES. - ALPHABET ALPHA IS ASCII. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01. - 02 X-POS PIC 9 VALUE 3. - 02 X PIC X(8) OCCURS 2. - PROCEDURE DIVISION. - INSPECT X(1) REPLACING ALL SPACES BY "AA". - INSPECT X(1) REPLACING ALL "ABC" BY "AA". - INSPECT X(1) REPLACING ALL "DEF" BY SPACES. - INSPECT X(1) CONVERTING SPACES TO "AA". - INSPECT X(1) CONVERTING "ABC" TO "AA". - INSPECT X(1) (X-POS:2) CONVERTING "DEF" TO SPACES. - INSPECT X(1) CONVERTING "GHI" TO ALPHA. - *> the following is allowed, see NC221A and ref-mod definition - INSPECT X(1) CONVERTING "DEF" TO X(2) (X-POS:3). - INSPECT X(1) CONVERTING "DEF" TO X(2) (X-POS:4). - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/syn_misc.at:872: \$COMPILE_ONLY prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY prog.cob" "syn_misc.at:872" -( $at_check_trace; $COMPILE_ONLY prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob:14: error: REPLACING operands differ in size -prog.cob:15: error: REPLACING operands differ in size -prog.cob:17: error: CONVERTING operands differ in size -prog.cob:18: error: CONVERTING operands differ in size -prog.cob:20: error: CONVERTING operands differ in size -prog.cob:23: error: CONVERTING operands differ in size -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/syn_misc.at:872" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_229 -#AT_START_230 -at_fn_group_banner 230 'syn_misc.at:884' \ - "INSPECT invalid target" " " 2 -at_xfail=no -( - $as_echo "230. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 X PIC X(8). - PROCEDURE DIVISION. - INSPECT FUNCTION TRIM(X) REPLACING ALL "ABC" BY "DEF". - INSPECT FUNCTION TRIM(X) CONVERTING "ABC" TO "AAA". - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/syn_misc.at:899: \$COMPILE_ONLY prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY prog.cob" "syn_misc.at:899" -( $at_check_trace; $COMPILE_ONLY prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob:8: error: invalid target for REPLACING -prog.cob:9: error: invalid target for CONVERTING -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/syn_misc.at:899" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_230 -#AT_START_231 -at_fn_group_banner 231 'syn_misc.at:907' \ - "INSPECT missing keyword" " " 2 -at_xfail=no -( - $as_echo "231. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 X PIC X(8). - PROCEDURE DIVISION. - INSPECT X REPLACING "AB" BY "CD". - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/syn_misc.at:921: \$COMPILE_ONLY prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY prog.cob" "syn_misc.at:921" -( $at_check_trace; $COMPILE_ONLY prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob:8: error: INSPECT missing ALL/FIRST/LEADING/TRAILING -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/syn_misc.at:921" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_231 -#AT_START_232 -at_fn_group_banner 232 'syn_misc.at:928' \ - "INSPECT repeated keywords" " " 2 -at_xfail=no -( - $as_echo "232. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 x PIC 9(5). - - PROCEDURE DIVISION. - *> Ok - INSPECT "abcde" TALLYING x FOR CHARACTERS CHARACTERS - - *> Not ok - INSPECT "abcde" TALLYING x FOR ALL LEADING - TRAILING ALL ALL ALL TRAILING - INSPECT "abcde" TALLYING x FOR x FOR LEADING "a" - . -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/syn_misc.at:950: \$COMPILE_ONLY prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY prog.cob" "syn_misc.at:950" -( $at_check_trace; $COMPILE_ONLY prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob:14: error: missing value between ALL/LEADING/TRAILING words -prog.cob:15: error: missing value between ALL/LEADING/TRAILING words -prog.cob:15: error: missing value between ALL/LEADING/TRAILING words -prog.cob:15: error: missing value between ALL/LEADING/TRAILING words -prog.cob:15: error: missing value between ALL/LEADING/TRAILING words -prog.cob:15: error: missing value between ALL/LEADING/TRAILING words -prog.cob:16: error: TALLYING clause is incomplete -prog.cob:16: error: missing CHARACTERS/ALL/LEADING/TRAILING phrase after FOR phrase -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/syn_misc.at:950" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_232 -#AT_START_233 -at_fn_group_banner 233 'syn_misc.at:964' \ - "INSPECT incomplete clause" " " 2 -at_xfail=no -( - $as_echo "233. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 x PIC 9(5). - - PROCEDURE DIVISION. - INSPECT "abcde" TALLYING x FOR - . -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/syn_misc.at:980: \$COMPILE_ONLY prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY prog.cob" "syn_misc.at:980" -( $at_check_trace; $COMPILE_ONLY prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob:11: error: TALLYING clause is incomplete -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/syn_misc.at:980" -$at_failed && at_fn_log_failure -$at_traceon; } - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_233 -#AT_START_234 -at_fn_group_banner 234 'syn_misc.at:986' \ - "INSPECT multiple BEFORE/AFTER clauses" " " 2 -at_xfail=no -( - $as_echo "234. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 x PIC X(10). - - PROCEDURE DIVISION. - INSPECT x REPLACING CHARACTERS BY "x" - BEFORE "A" BEFORE "b" AFTER "c" - . -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/syn_misc.at:1003: \$COMPILE_ONLY prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY prog.cob" "syn_misc.at:1003" -( $at_check_trace; $COMPILE_ONLY prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob:11: error: syntax error, unexpected BEFORE -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/syn_misc.at:1003" -$at_failed && at_fn_log_failure -$at_traceon; } - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_234 -#AT_START_235 -at_fn_group_banner 235 'syn_misc.at:1009' \ - "maximum data size" " " 2 -at_xfail=no -( - $as_echo "235. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 SINGLE-ITEM PIC X(999999999). - 01 GROUP-ITEM1. - 05 FILLER PIC X(999999999). - 01 GROUP-ITEM2. - 05 FILLER PIC X(199999999). - 05 FILLER PIC X(199999999). - PROCEDURE DIVISION. - STOP RUN. - -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/syn_misc.at:1028: \$COMPILE_ONLY prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY prog.cob" "syn_misc.at:1028" -( $at_check_trace; $COMPILE_ONLY prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob:6: error: 'SINGLE-ITEM' cannot be larger than 268435456 bytes -prog.cob:8: error: 'FILLER 1' cannot be larger than 268435456 bytes -prog.cob:7: error: 'GROUP-ITEM1' cannot be larger than 268435456 bytes -prog.cob:9: error: 'GROUP-ITEM2' cannot be larger than 268435456 bytes -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/syn_misc.at:1028" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_235 -#AT_START_236 -at_fn_group_banner 236 'syn_misc.at:1038' \ - "unreachable statement" " " 2 -at_xfail=no -( - $as_echo "236. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - INPUT-OUTPUT SECTION. - FILE-CONTROL. - SELECT f ASSIGN TO 'f' LINE SEQUENTIAL. - DATA DIVISION. - FILE SECTION. - FD f. - 01 f-rec PIC X. - WORKING-STORAGE SECTION. - PROCEDURE DIVISION. - DECLARATIVES. - f-error SECTION. - USE AFTER ERROR ON f. - GOBACK - . - END DECLARATIVES. - - DISPLAY "VALID" - END-DISPLAY. - - P01. - GO TO P02. - DISPLAY "INVALID" - END-DISPLAY. - P02. - GO TO P03 - CONTINUE. *> explicit no unreachable warning - P03. - GO TO P04 - CONTINUE AFTER 2 SECONDS. *> that's one again - P04. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/syn_misc.at:1078: \$COMPILE_ONLY -Wunreachable prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY -Wunreachable prog.cob" "syn_misc.at:1078" -( $at_check_trace; $COMPILE_ONLY -Wunreachable prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob: in paragraph 'P01': -prog.cob:26: warning: unreachable statement 'DISPLAY' -prog.cob: in paragraph 'P03': -prog.cob:33: warning: unreachable statement 'CONTINUE AFTER' -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/syn_misc.at:1078" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_236 -#AT_START_237 -at_fn_group_banner 237 'syn_misc.at:1088' \ - "CRT STATUS" " " 2 -at_xfail=no -( - $as_echo "237. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - CONFIGURATION SECTION. - SPECIAL-NAMES. - CRT STATUS IS MY-CRT-STATUS. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 X PIC X. - PROCEDURE DIVISION. - ACCEPT X END-ACCEPT. - STOP RUN. -_ATEOF - - -cat >prog2.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog2. - ENVIRONMENT DIVISION. - CONFIGURATION SECTION. - SPECIAL-NAMES. - CRT STATUS IS MY-CRT-STATUS. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 X PIC X. - 77 MY-CRT-STATUS PIC 9(04). - PROCEDURE DIVISION. - ACCEPT X END-ACCEPT. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/syn_misc.at:1122: \$COMPILE_ONLY prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY prog.cob" "syn_misc.at:1122" -( $at_check_trace; $COMPILE_ONLY prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob:7: error: 'MY-CRT-STATUS' is not defined -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/syn_misc.at:1122" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/syn_misc.at:1125: \$COMPILE_ONLY prog2.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY prog2.cob" "syn_misc.at:1125" -( $at_check_trace; $COMPILE_ONLY prog2.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/syn_misc.at:1125" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_237 -#AT_START_238 -at_fn_group_banner 238 'syn_misc.at:1130' \ - "SPECIAL-NAMES clause" " " 2 -at_xfail=no -( - $as_echo "238. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -# FIXME: actually this is the only place for some CRT STATUS checks... - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - CONFIGURATION SECTION. - SPECIAL-NAMES. - CRT STATUS IS MY-CRT-STATUS. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 CURSOR-POSITION IS SPECIAL-NAMES CURSOR. - 03 CURSOR-ROW PIC 999. - 03 CURSOR-COL PIC 999. - 77 MY-CRT-STATUS PIC 9(04). - 77 CRT-STATUS IS SPECIAL-NAMES CRT STATUS PIC 9(5). - PROCEDURE DIVISION. - ACCEPT OMITTED END-ACCEPT. - STOP RUN. -_ATEOF - - -cat >prog2.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 77 CRT-STATUS IS SPECIAL-NAMES CRT STATUS PIC X(5). - PROCEDURE DIVISION. - ACCEPT OMITTED END-ACCEPT. - STOP RUN. -_ATEOF - - -cat >prog3.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 CURSOR-POSITION IS SPECIAL-NAMES CURSOR. - 03 CURSOR-ROW PIC 999. - 03 CURSOR-COL PIC 999. - 77 CRT-STATUS PIC X(4) IS SPECIAL-NAMES CRT STATUS. - PROCEDURE DIVISION. - ACCEPT OMITTED END-ACCEPT. - STOP RUN. -_ATEOF - - -cat >prog4.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 CURSOR-POSITION IS SPECIAL-NAMES CURSOR. - 03 CURSOR-ROW PIC 999. - 03 CURSOR-COL PIC 999. - 77 CRT-STATUS PIC 9(5) IS SPECIAL-NAMES CRT STATUS. - PROCEDURE DIVISION. - ACCEPT OMITTED END-ACCEPT. - STOP RUN. -_ATEOF - - -cat >prog5.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 77 CRT-STATUS PIC 9(3) IS SPECIAL-NAMES CRT STATUS. - PROCEDURE DIVISION. - ACCEPT OMITTED END-ACCEPT. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/syn_misc.at:1204: \$COMPILE_ONLY prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY prog.cob" "syn_misc.at:1204" -( $at_check_trace; $COMPILE_ONLY prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob:14: error: duplicate CRT STATUS clause -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/syn_misc.at:1204" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/syn_misc.at:1207: \$COMPILE_ONLY prog2.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY prog2.cob" "syn_misc.at:1207" -( $at_check_trace; $COMPILE_ONLY prog2.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog2.cob:6: error: 'CRT-STATUS' CRT STATUS must be 4 characters long -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/syn_misc.at:1207" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/syn_misc.at:1210: \$COMPILE_ONLY prog3.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY prog3.cob" "syn_misc.at:1210" -( $at_check_trace; $COMPILE_ONLY prog3.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/syn_misc.at:1210" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/syn_misc.at:1211: \$COMPILE_ONLY prog4.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY prog4.cob" "syn_misc.at:1211" -( $at_check_trace; $COMPILE_ONLY prog4.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/syn_misc.at:1211" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/syn_misc.at:1212: \$COMPILE_ONLY prog5.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY prog5.cob" "syn_misc.at:1212" -( $at_check_trace; $COMPILE_ONLY prog5.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog5.cob:6: error: 'CRT-STATUS' CRT STATUS must have at least 4 digits -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/syn_misc.at:1212" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_238 -#AT_START_239 -at_fn_group_banner 239 'syn_misc.at:1219' \ - "CURRENCY SIGN" " " 2 -at_xfail=no -( - $as_echo "239. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - CONFIGURATION SECTION. - SPECIAL-NAMES. - CURRENCY SIGN IS '*'. -_ATEOF - - -cat >prog2.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog2. - ENVIRONMENT DIVISION. - CONFIGURATION SECTION. - SPECIAL-NAMES. - CURRENCY 'DOLLAR'. -_ATEOF - - -cat >prog3.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog3. - ENVIRONMENT DIVISION. - CONFIGURATION SECTION. - SPECIAL-NAMES. - CURRENCY 'DOLLAR' - WITH PICTURE SYMBOL '$'. - DATA DIVISION. - WORKING-STORAGE SECTION. - 77 SOME-CASH PIC 9(04).99$. - PROCEDURE DIVISION. - MOVE 123.4 TO SOME-CASH - DISPLAY SOME-CASH END-DISPLAY. - STOP RUN. -_ATEOF - - -cat >prog4.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog4. - ENVIRONMENT DIVISION. - CONFIGURATION SECTION. - SPECIAL-NAMES. - CURRENCY ' ' - PICTURE SYMBOL '*'. -_ATEOF - - -cat >prog5.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog5. - ENVIRONMENT DIVISION. - CONFIGURATION SECTION. - SPECIAL-NAMES. - CURRENCY ' T ' - PICTURE SYMBOL ' '. -_ATEOF - - -cat >prog6.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog6. - ENVIRONMENT DIVISION. - CONFIGURATION SECTION. - SPECIAL-NAMES. - CURRENCY '+-' - PICTURE SYMBOL 'TT'. -_ATEOF - - -cat >prog7.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog7. - ENVIRONMENT DIVISION. - CONFIGURATION SECTION. - SPECIAL-NAMES. - CURRENCY SIGN IS 'T'. - DATA DIVISION. - WORKING-STORAGE SECTION. - 77 SOME-CASH PIC 9(04).99T. - PROCEDURE DIVISION. - MOVE 123.4 TO SOME-CASH - DISPLAY SOME-CASH END-DISPLAY. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/syn_misc.at:1303: \$COMPILE_ONLY prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY prog.cob" "syn_misc.at:1303" -( $at_check_trace; $COMPILE_ONLY prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob:7: error: invalid character '*' in currency symbol -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/syn_misc.at:1303" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/syn_misc.at:1306: \$COMPILE_ONLY prog2.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY prog2.cob" "syn_misc.at:1306" -( $at_check_trace; $COMPILE_ONLY prog2.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog2.cob:7: error: currency symbol must be one character long -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/syn_misc.at:1306" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/syn_misc.at:1309: \$COMPILE_ONLY prog3.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY prog3.cob" "syn_misc.at:1309" -( $at_check_trace; $COMPILE_ONLY prog3.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog3.cob:7: warning: separate currency symbol and currency string is not implemented -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/syn_misc.at:1309" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/syn_misc.at:1312: \$COMPILE_ONLY prog4.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY prog4.cob" "syn_misc.at:1312" -( $at_check_trace; $COMPILE_ONLY prog4.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog4.cob:7: warning: separate currency symbol and currency string is not implemented -prog4.cob:7: error: invalid CURRENCY SIGN ' ' -prog4.cob:8: error: invalid character '*' in currency symbol -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/syn_misc.at:1312" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/syn_misc.at:1317: \$COMPILE_ONLY prog5.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY prog5.cob" "syn_misc.at:1317" -( $at_check_trace; $COMPILE_ONLY prog5.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog5.cob:7: warning: separate currency symbol and currency string is not implemented -prog5.cob:8: error: invalid character ' ' in currency symbol -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/syn_misc.at:1317" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/syn_misc.at:1321: \$COMPILE_ONLY prog6.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY prog6.cob" "syn_misc.at:1321" -( $at_check_trace; $COMPILE_ONLY prog6.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog6.cob:7: warning: separate currency symbol and currency string is not implemented -prog6.cob:7: error: invalid CURRENCY SIGN '+-' -prog6.cob:8: error: currency symbol must be one character long -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/syn_misc.at:1321" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/syn_misc.at:1326: \$COMPILE_ONLY prog7.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY prog7.cob" "syn_misc.at:1326" -( $at_check_trace; $COMPILE_ONLY prog7.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/syn_misc.at:1326" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_239 -#AT_START_240 -at_fn_group_banner 240 'syn_misc.at:1331' \ - "SWITCHES" " " 2 -at_xfail=no -( - $as_echo "240. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - CONFIGURATION SECTION. - SPECIAL-NAMES. - SW1 - ON IS SWIT1-ON - OFF IS SWIT1-OFF - . - SWITCH B IS SWITCH-B - ON IS SWIT2-ON - OFF IS SWIT2-OFF - . - SWITCH-25 - ON IS SWIT25-ON - OFF IS SWIT25-OFF - . - SWITCH-25 - ON IS SWIT25-IS-ON - OFF IS SWIT25-IS-OFF - . - SWITCH 25 - ON IS SWIT25-SP-ON - OFF IS SWIT25-SP-OFF - . - SWITCH Y - ON IS SWIT25-Y-ON - OFF IS SWIT25-Y-OFF - . - SWITCH Z - ON IS SWIT26-ON - ON IS SWIT26-OFF - . - SWITCH-32 - ON IS SWIT32-ON - . - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 SWITCH PIC 99 VALUE 12. - PROCEDURE DIVISION. - ADD SWITCH 1 GIVING SWITCH - END-ADD. - IF SWITCH NOT = 13 - DISPLAY "SWITCH (variable) WRONG: " - SWITCH - END-DISPLAY - END-IF. - IF SWIT1-ON - DISPLAY "ON" - END-DISPLAY - ELSE - DISPLAY "OFF" - END-DISPLAY - END-IF. - IF SWIT2-ON - DISPLAY " ON" - END-DISPLAY - ELSE - DISPLAY " OFF" - END-DISPLAY - END-IF. - SET SWITCH-B TO OFF - IF SWIT2-ON - CONTINUE - END-IF. - IF SWIT25-ON - CONTINUE - END-IF. - IF SWIT26-ON - CONTINUE - END-IF. - IF SWIT32-ON - CONTINUE - END-IF. - IF SWIT32-OFF - CONTINUE - END-IF. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/syn_misc.at:1415: \$COMPILE_ONLY prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY prog.cob" "syn_misc.at:1415" -( $at_check_trace; $COMPILE_ONLY prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob:7: error: invalid system-name 'SW1' -prog.cob:8: error: ON/OFF usage requires a SWITCH name -prog.cob:9: error: ON/OFF usage requires a SWITCH name -prog.cob:11: error: invalid system-name 'SWITCH B' -prog.cob:12: error: ON/OFF usage requires a SWITCH name -prog.cob:13: error: ON/OFF usage requires a SWITCH name -prog.cob:23: error: invalid system-name 'SWITCH 25' -prog.cob:24: error: ON/OFF usage requires a SWITCH name -prog.cob:25: error: ON/OFF usage requires a SWITCH name -prog.cob:27: error: invalid system-name 'SWITCH Y' -prog.cob:28: error: ON/OFF usage requires a SWITCH name -prog.cob:29: error: ON/OFF usage requires a SWITCH name -prog.cob:31: error: invalid system-name 'SWITCH Z' -prog.cob:32: error: ON/OFF usage requires a SWITCH name -prog.cob:33: error: ON/OFF usage requires a SWITCH name -prog.cob:49: error: 'SWIT1-ON' is not defined -prog.cob:56: error: 'SWIT2-ON' is not defined -prog.cob:63: error: 'SWITCH-B' is not defined -prog.cob:63: error: syntax error, unexpected OFF -prog.cob:64: error: 'SWIT2-ON' is not defined -prog.cob:70: error: 'SWIT26-ON' is not defined -prog.cob:76: error: 'SWIT32-OFF' is not defined -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/syn_misc.at:1415" -$at_failed && at_fn_log_failure -$at_traceon; } - -# FIXME: There should be an additional -#prog.cob:19: error: duplicate definition of 'SWITCH-25' -#prog.cob:15: error: 'SWITCH-25' previously defined here -# -{ set +x -$as_echo "$at_srcdir/syn_misc.at:1443: \$COMPILE_ONLY -std=acu-strict -fsystem-name=SW1 -fno-relax-syntax-checks prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY -std=acu-strict -fsystem-name=SW1 -fno-relax-syntax-checks prog.cob" "syn_misc.at:1443" -( $at_check_trace; $COMPILE_ONLY -std=acu-strict -fsystem-name=SW1 -fno-relax-syntax-checks prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob:33: error: duplicate ON clause -prog.cob:76: error: 'SWIT32-OFF' is not defined -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/syn_misc.at:1443" -$at_failed && at_fn_log_failure -$at_traceon; } - -# FIXME: There should be an additional -#prog.cob:19: error: duplicate definition of 'SWITCH-25' -#prog.cob:15: error: 'SWITCH-25' previously defined here -#prog.cob:23: error: duplicate definition of 'SWITCH 25' -#prog.cob:15: error: 'SWITCH-25' previously defined here -#prog.cob:27: error: duplicate definition of 'SWITCH Y' -#prog.cob:15: error: 'SWITCH-25' previously defined here - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_240 -#AT_START_241 -at_fn_group_banner 241 'syn_misc.at:1458' \ - "unexpected mnemonic-name location" " " 2 -at_xfail=no -( - $as_echo "241. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - CONFIGURATION SECTION. - SPECIAL-NAMES. - stdin IS my-stdin - . - PROCEDURE DIVISION. - CALL "something" USING stdout - CALL "something" USING stdin - CALL "something" USING my-stdin - . -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/syn_misc.at:1476: \$COMPILE_ONLY prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY prog.cob" "syn_misc.at:1476" -( $at_check_trace; $COMPILE_ONLY prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob:10: error: invalid mnemonic identifier -prog.cob:11: error: invalid mnemonic identifier -prog.cob:12: error: invalid mnemonic identifier -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/syn_misc.at:1476" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_241 -#AT_START_242 -at_fn_group_banner 242 'syn_misc.at:1485' \ - "wrong device for mnemonic-name" " " 2 -at_xfail=no -( - $as_echo "242. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 77 var PIC x. - PROCEDURE DIVISION. - ACCEPT var FROM SYSOUT - DISPLAY var UPON SYSIN - ACCEPT var FROM SYSIN - DISPLAY var UPON SYSOUT - . -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/syn_misc.at:1502: \$COMPILE_ONLY prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY prog.cob" "syn_misc.at:1502" -( $at_check_trace; $COMPILE_ONLY prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob:8: error: 'SYSOUT' is not an input device -prog.cob:9: error: 'SYSIN' is not an output device -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/syn_misc.at:1502" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_242 -#AT_START_243 -at_fn_group_banner 243 'syn_misc.at:1510' \ - "missing mnemonic-name declaration" " " 2 -at_xfail=no -( - $as_echo "243. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 77 var PIC x. - PROCEDURE DIVISION. - ACCEPT var FROM mnemonic-name - . -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/syn_misc.at:1524: \$COMPILE_ONLY prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY prog.cob" "syn_misc.at:1524" -( $at_check_trace; $COMPILE_ONLY prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob:8: error: unknown device 'mnemonic-name'; not defined in SPECIAL-NAMES -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/syn_misc.at:1524" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_243 -#AT_START_244 -at_fn_group_banner 244 'syn_misc.at:1531' \ - "unknown device in dialect" " " 2 -at_xfail=no -( - $as_echo "244. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 77 var PIC x. - PROCEDURE DIVISION. - ACCEPT var FROM COMMAND-LINE - DISPLAY var UPON COMMAND-LINE - . -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/syn_misc.at:1546: \$COMPILE_ONLY prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY prog.cob" "syn_misc.at:1546" -( $at_check_trace; $COMPILE_ONLY prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/syn_misc.at:1546" -$at_failed && at_fn_log_failure -$at_traceon; } - - -# Checkme: Error currently doesn't occur for UPON_COMMAND_LINE as this is already tokenized -# in scanner.l. We just ignore this for now and maybe fix it later. -#AT_CHECK([$COMPILE_ONLY -fnot-reserved=COMMAND-LINE prog.cob], [1], [], -#[prog.cob:8: error: unknown device 'COMMAND-LINE'; it may exist in another dialect -#prog.cob:9: error: unknown device 'COMMAND-LINE'; it may exist in another dialect -#]) -{ set +x -$as_echo "$at_srcdir/syn_misc.at:1554: \$COMPILE_ONLY -fnot-reserved=COMMAND-LINE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY -fnot-reserved=COMMAND-LINE prog.cob" "syn_misc.at:1554" -( $at_check_trace; $COMPILE_ONLY -fnot-reserved=COMMAND-LINE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob:8: error: unknown device 'COMMAND-LINE'; it may exist in another dialect -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/syn_misc.at:1554" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_244 -#AT_START_245 -at_fn_group_banner 245 'syn_misc.at:1561' \ - "ACCEPT WITH ( NO ) UPDATE / DEFAULT" " " 2 -at_xfail=no -( - $as_echo "245. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - CONFIGURATION SECTION. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 X PIC X. - PROCEDURE DIVISION. - ACCEPT X END-ACCEPT. - ACCEPT X WITH UPDATE END-ACCEPT. - ACCEPT X WITH DEFAULT END-ACCEPT. - ACCEPT X WITH NO UPDATE END-ACCEPT. - ACCEPT X WITH NO DEFAULT END-ACCEPT. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/syn_misc.at:1581: \$COMPILE_ONLY -faccept-update prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY -faccept-update prog.cob" "syn_misc.at:1581" -( $at_check_trace; $COMPILE_ONLY -faccept-update prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/syn_misc.at:1581" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_245 -#AT_START_246 -at_fn_group_banner 246 'syn_misc.at:1586' \ - "ACCEPT WITH AUTO / TAB" " " 2 -at_xfail=no -( - $as_echo "246. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - CONFIGURATION SECTION. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 X PIC X. - PROCEDURE DIVISION. - ACCEPT X END-ACCEPT. - ACCEPT X WITH AUTO END-ACCEPT. - ACCEPT X WITH AUTO-SKIP END-ACCEPT. - ACCEPT X WITH AUTOTERMINATE END-ACCEPT. - ACCEPT X WITH TAB END-ACCEPT. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/syn_misc.at:1606: \$COMPILE_ONLY -faccept-auto prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY -faccept-auto prog.cob" "syn_misc.at:1606" -( $at_check_trace; $COMPILE_ONLY -faccept-auto prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/syn_misc.at:1606" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_246 -#AT_START_247 -at_fn_group_banner 247 'syn_misc.at:1611' \ - "ACCEPT WITH LOWER / UPPER" " " 2 -at_xfail=no -( - $as_echo "247. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 X PIC X(05). - PROCEDURE DIVISION. - ACCEPT X WITH LOWER END-ACCEPT. - ACCEPT X WITH UPPER END-ACCEPT. - ACCEPT X LOWER - ACCEPT X UPPER - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/syn_misc.at:1628: \$COMPILE_ONLY prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY prog.cob" "syn_misc.at:1628" -( $at_check_trace; $COMPILE_ONLY prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/syn_misc.at:1628" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_247 -#AT_START_248 -at_fn_group_banner 248 'syn_misc.at:1633' \ - "ACCEPT WITH SIZE" " " 2 -at_xfail=no -( - $as_echo "248. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 X PIC X(05). - 01 Y PIC 9(04) BINARY VALUE 4. - PROCEDURE DIVISION. - ACCEPT X WITH SIZE 0 END-ACCEPT. - ACCEPT X WITH SIZE IS 1 END-ACCEPT. - ACCEPT X WITH PROTECTED SIZE 2 END-ACCEPT. - ACCEPT X WITH PROTECTED SIZE IS 3 END-ACCEPT. - ACCEPT X SIZE Y END-ACCEPT. - ACCEPT X SIZE 0 - ACCEPT X SIZE IS 1 - ACCEPT X PROTECTED SIZE 2 - ACCEPT X PROTECTED SIZE IS 3 - ACCEPT X SIZE Y - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/syn_misc.at:1657: \$COMPILE_ONLY prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY prog.cob" "syn_misc.at:1657" -( $at_check_trace; $COMPILE_ONLY prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/syn_misc.at:1657" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_248 -#AT_START_249 -at_fn_group_banner 249 'syn_misc.at:1662' \ - "DISPLAY WITH SIZE" " " 2 -at_xfail=no -( - $as_echo "249. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 X PIC X(05). - 01 Y PIC 9(04) BINARY VALUE 7. - PROCEDURE DIVISION. - DISPLAY X AT 0101 WITH SIZE 5 END-DISPLAY. - DISPLAY X AT 0101 WITH SIZE IS 6 END-DISPLAY. - DISPLAY X AT 0101 WITH SIZE IS Y END-DISPLAY. - DISPLAY X AT 0101 SIZE 5 END-DISPLAY. - DISPLAY X AT 0101 SIZE IS 6 END-DISPLAY. - DISPLAY X AT 0101 SIZE IS Y END-DISPLAY. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/syn_misc.at:1682: \$COMPILE_ONLY prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY prog.cob" "syn_misc.at:1682" -( $at_check_trace; $COMPILE_ONLY prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/syn_misc.at:1682" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_249 -#AT_START_250 -at_fn_group_banner 250 'syn_misc.at:1687' \ - "source text after program-text area" " " 2 -at_xfail=no -( - $as_echo "250. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - CONFIGURATION SECTION. - DATA DIVISION. - WORKING-STORAGE SECTION. - PROCEDURE DIVISION. COMMENT - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/syn_misc.at:1701: \$COMPILE_ONLY -W prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY -W prog.cob" "syn_misc.at:1701" -( $at_check_trace; $COMPILE_ONLY -W prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob:8: warning: source text after program-text area (column 72) -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/syn_misc.at:1701" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_250 -#AT_START_251 -at_fn_group_banner 251 'syn_misc.at:1708' \ - "line overflow in Fixed-form / Free-form" " " 2 -at_xfail=no -( - $as_echo "251. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -# We're testing trailing tabs and whitespace (should not lead to warning) -# along with comments after boundaries (col 72 / col 512) - -# AT_DATA removes trailing spaces, workaround: add "_" and -# remove it later via sed - -cat >prog_tmpl.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - CONFIGURATION SECTION. _ - DATA DIVISION. _ - WORKING-STORAGE SECTION. *> This is a real comment - PROCEDURE DIVISION. This is commentary only - CONTINUE. *> comment after column 72 - * This is a very long comment that exceeds column 72 but doesn't exceed 512 bytes, therefore not leading to a line overflow. As it is a comment line there is no "Source text after column 72" warning - CONTINUE. CONTINUE. - CONTINUE. _ - STOP RUN. -_ATEOF - - -# AT_DATA workaround via sed: -{ set +x -$as_echo "$at_srcdir/syn_misc.at:1733: sed -e 's/_\$//' prog_tmpl.cob > prog.cob" -at_fn_check_prepare_dynamic "sed -e 's/_$//' prog_tmpl.cob > prog.cob" "syn_misc.at:1733" -( $at_check_trace; sed -e 's/_$//' prog_tmpl.cob > prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/syn_misc.at:1733" -$at_failed && at_fn_log_failure -$at_traceon; } - - -{ set +x -$as_echo "$at_srcdir/syn_misc.at:1735: \$COMPILE_ONLY -fixed -W prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY -fixed -W prog.cob" "syn_misc.at:1735" -( $at_check_trace; $COMPILE_ONLY -fixed -W prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob:7: warning: source text exceeds 512 bytes, will be truncated -prog.cob:8: warning: source text exceeds 512 bytes, will be truncated -prog.cob:11: warning: source text after program-text area (column 72) -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/syn_misc.at:1735" -$at_failed && at_fn_log_failure -$at_traceon; } - - -{ set +x -$as_echo "$at_srcdir/syn_misc.at:1741: \$COMPILE_ONLY -free -W prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY -free -W prog.cob" "syn_misc.at:1741" -( $at_check_trace; $COMPILE_ONLY -free -W prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob:7: warning: source text exceeds 512 bytes, will be truncated -prog.cob:8: warning: source text exceeds 512 bytes, will be truncated -prog.cob:8: error: unknown statement 'This' -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/syn_misc.at:1741" -$at_failed && at_fn_log_failure -$at_traceon; } - - -{ set +x -$as_echo "$at_srcdir/syn_misc.at:1747: \$COMPILE_ONLY -F -W prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY -F -W prog.cob" "syn_misc.at:1747" -( $at_check_trace; $COMPILE_ONLY -F -W prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob:7: warning: source text exceeds 512 bytes, will be truncated -prog.cob:8: warning: source text exceeds 512 bytes, will be truncated -prog.cob:8: error: unknown statement 'This' -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/syn_misc.at:1747" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_251 -#AT_START_252 -at_fn_group_banner 252 'syn_misc.at:1756' \ - "continuation Indicator - too many lines" " " 2 -at_xfail=no -( - $as_echo "252. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - CONFIGURATION SECTION. - DATA DIVISION. - WORKING-STORAGE SECTION. - PROCEDURE DIVISION. - DISPLAY ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' ' END-DISPLAY. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/syn_misc.at:2300: \$COMPILE_ONLY prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY prog.cob" "syn_misc.at:2300" -( $at_check_trace; $COMPILE_ONLY prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob:538: error: buffer overrun - too many continuation lines -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/syn_misc.at:2300" -$at_failed && at_fn_log_failure -$at_traceon; } - - -# extra test with listing as this is an edge case there - -{ set +x -$as_echo "$at_srcdir/syn_misc.at:2306: \$COMPILE_ONLY -t prog.lst prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY -t prog.lst prog.cob" "syn_misc.at:2306" -( $at_check_trace; $COMPILE_ONLY -t prog.lst prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob:538: error: buffer overrun - too many continuation lines -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/syn_misc.at:2306" -$at_failed && at_fn_log_failure \ -"prog.lst" -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_252 -#AT_START_253 -at_fn_group_banner 253 'syn_misc.at:2313' \ - "continuation of COBOL words" " " 2 -at_xfail=no -( - $as_echo "253. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - PROCEDURE DIVISION. - GO - - BACK. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/syn_misc.at:2324: \$COMPILE_ONLY -std=cobol2014 prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY -std=cobol2014 prog.cob" "syn_misc.at:2324" -( $at_check_trace; $COMPILE_ONLY -std=cobol2014 prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob:6: warning: continuation of COBOL words is archaic in COBOL 2014 -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/syn_misc.at:2324" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/syn_misc.at:2327: \$COMPILE_ONLY prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY prog.cob" "syn_misc.at:2327" -( $at_check_trace; $COMPILE_ONLY prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob:6: warning: continuation of COBOL words used -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/syn_misc.at:2327" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_253 -#AT_START_254 -at_fn_group_banner 254 'syn_misc.at:2334' \ - "literal too long" " " 2 -at_xfail=no -( - $as_echo "254. $at_setup_line: testing $at_desc ..." - $at_traceon - - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - CONFIGURATION SECTION. - DATA DIVISION. - WORKING-STORAGE SECTION. - PROCEDURE DIVISION. - DISPLAY ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' '. - STOP RUN. -_ATEOF - - -cat >prog2.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog2. - ENVIRONMENT DIVISION. - CONFIGURATION SECTION. - DATA DIVISION. - WORKING-STORAGE SECTION. - PROCEDURE DIVISION. - DISPLAY ' '- - ' '- - ' '- - ' '- - ' '- - ' '- - ' '- - ' '- - ' '- - ' '- - ' '- - ' '- - ' '- - ' '- - ' '- - ' '- - ' '- - ' '- - ' '- - ' '- - ' '- - ' '- - ' '- - ' '- - ' '- - ' '- - ' '- - ' '- - ' '- - ' '- - ' '- - ' '- - ' '- - ' '- - ' '- - ' '- - ' '- - ' ' END-DISPLAY. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/syn_misc.at:2538: \$COMPILE_ONLY prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY prog.cob" "syn_misc.at:2538" -( $at_check_trace; $COMPILE_ONLY prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob:9: error: invalid literal: ' ...' -prog.cob:9: error: literal length exceeds 8191 characters -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/syn_misc.at:2538" -$at_failed && at_fn_log_failure -$at_traceon; } - - -{ set +x -$as_echo "$at_srcdir/syn_misc.at:2543: \$COMPILE_ONLY -fliteral-length=160 prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY -fliteral-length=160 prog.cob" "syn_misc.at:2543" -( $at_check_trace; $COMPILE_ONLY -fliteral-length=160 prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob:9: error: invalid literal: ' ...' -prog.cob:9: error: literal length exceeds 160 characters -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/syn_misc.at:2543" -$at_failed && at_fn_log_failure -$at_traceon; } - - -{ set +x -$as_echo "$at_srcdir/syn_misc.at:2548: \$COMPILE_ONLY -free prog2.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY -free prog2.cob" "syn_misc.at:2548" -( $at_check_trace; $COMPILE_ONLY -free prog2.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog2.cob:43: error: invalid literal: ' ...' -prog2.cob:43: error: literal length 8299 exceeds 8191 characters -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/syn_misc.at:2548" -$at_failed && at_fn_log_failure -$at_traceon; } - - -# extra test with listing as this is an edge case there - -{ set +x -$as_echo "$at_srcdir/syn_misc.at:2555: \$COMPILE_ONLY -t prog.lst prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY -t prog.lst prog.cob" "syn_misc.at:2555" -( $at_check_trace; $COMPILE_ONLY -t prog.lst prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob:9: error: invalid literal: ' ...' -prog.cob:9: error: literal length exceeds 8191 characters -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/syn_misc.at:2555" -$at_failed && at_fn_log_failure \ -"prog.lst" -$at_traceon; } - - - -{ set +x -$as_echo "$at_srcdir/syn_misc.at:2561: \$COMPILE_ONLY -free -t prog2.lst prog2.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY -free -t prog2.lst prog2.cob" "syn_misc.at:2561" -( $at_check_trace; $COMPILE_ONLY -free -t prog2.lst prog2.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog2.cob:43: error: invalid literal: ' ...' -prog2.cob:43: error: literal length 8299 exceeds 8191 characters -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/syn_misc.at:2561" -$at_failed && at_fn_log_failure \ -"prog.lst" \ -"prog2.lst" -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_254 -#AT_START_255 -at_fn_group_banner 255 'syn_misc.at:2569' \ - "line and floating comments" " " 2 -at_xfail=no -( - $as_echo "255. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - CONFIGURATION SECTION. - DATA DIVISION. - WORKING-STORAGE SECTION. - PROCEDURE DIVISION. - * DISPLAY 'COMMENT' END-DISPLAY - / DISPLAY 'COMMENTSLASH' END-DISPLAY -* DISPLAY 'MFCOMMENTASTERISK' END-DISPLAY -/ DISPLAY 'MFCOMMENTSLASH' END-DISPLAY - * DISPLAY 'NOMFCOMMENTASTERISK' END-DISPLAY - / DISPLAY 'NOMFCOMMENTSLASH' END-DISPLAY - *> DISPLAY 'FLOATING' END-DISPLAY - *> DISPLAY 'NOFLOATING' END-DISPLAY - STOP RUN. -_ATEOF - - -cat >prog2.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog2. - ENVIRONMENT DIVISION. - CONFIGURATION SECTION. - DATA DIVISION. - WORKING-STORAGE SECTION. - PROCEDURE DIVISION. - * DISPLAY 'COMMENT' END-DISPLAY - / DISPLAY 'COMMENTSLASH' END-DISPLAY - $ DISPLAY 'COMMENTDOLLAR' END-DISPLAY -* DISPLAY 'MFCOMMENTASTERISK' END-DISPLAY -/ DISPLAY 'MFCOMMENTSLASH' END-DISPLAY - * DISPLAY 'NOMFCOMMENTASTERISK' END-DISPLAY - / DISPLAY 'NOMFCOMMENTSLASH' END-DISPLAY - *> DISPLAY 'FLOATING' END-DISPLAY - | DISPLAY 'ACUFLOATING' END-DISPLAY - | DISPLAY 'NOACUFLOATING' END-DISPLAY - *> DISPLAY 'NOFLOATING' END-DISPLAY - STOP RUN. -_ATEOF - - -cat >prog3.cob <<'_ATEOF' - -IDENTIFICATION DIVISION. -PROGRAM-ID. prog3. -ENVIRONMENT DIVISION. -CONFIGURATION SECTION. -DATA DIVISION. -WORKING-STORAGE SECTION. -PROCEDURE DIVISION. - * DISPLAY 'NOCOMMENT' END-DISPLAY - / DISPLAY 'NOCOMMENTSLASH' END-DISPLAY - $ DISPLAY 'NOCOMMENTDOLLAR' END-DISPLAY -* DISPLAY 'NOMFCOMMENTASTERISK' END-DISPLAY -/ DISPLAY 'NOMFCOMMENTSLASH' END-DISPLAY - | DISPLAY 'ACUFLOATING' END-DISPLAY - *> DISPLAY 'FLOATING' END-DISPLAY - x DISPLAY 'WRONGINDICATOR' END-DISPLAY - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/syn_misc.at:2632: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "syn_misc.at:2632" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/syn_misc.at:2632" -$at_failed && at_fn_log_failure -$at_traceon; } - - -{ set +x -$as_echo "$at_srcdir/syn_misc.at:2634: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "syn_misc.at:2634" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo "MFCOMMENTASTERISK -MFCOMMENTSLASH -NOMFCOMMENTASTERISK -NOMFCOMMENTSLASH -NOFLOATING -" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/syn_misc.at:2634" -$at_failed && at_fn_log_failure -$at_traceon; } - - -{ set +x -$as_echo "$at_srcdir/syn_misc.at:2642: \$COMPILE_ONLY prog2.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY prog2.cob" "syn_misc.at:2642" -( $at_check_trace; $COMPILE_ONLY prog2.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog2.cob:11: error: invalid indicator '\$' at column 7 -prog2.cob:17: error: invalid symbol '|' - skipping word -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/syn_misc.at:2642" -$at_failed && at_fn_log_failure -$at_traceon; } - - -# note: for checking the result we actually either need to run the program -# or change it to string concatenation and raise a constant compile time warning -# we do (historically) the first (for now) -# -{ set +x -$as_echo "$at_srcdir/syn_misc.at:2651: \$COMPILE -fmfcomment prog.cob" -at_fn_check_prepare_dynamic "$COMPILE -fmfcomment prog.cob" "syn_misc.at:2651" -( $at_check_trace; $COMPILE -fmfcomment prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/syn_misc.at:2651" -$at_failed && at_fn_log_failure -$at_traceon; } - - -{ set +x -$as_echo "$at_srcdir/syn_misc.at:2654: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "syn_misc.at:2654" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo "NOMFCOMMENTASTERISK -NOMFCOMMENTSLASH -NOFLOATING -" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/syn_misc.at:2654" -$at_failed && at_fn_log_failure -$at_traceon; } - - -{ set +x -$as_echo "$at_srcdir/syn_misc.at:2660: \$COMPILE_ONLY -fmfcomment prog2.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY -fmfcomment prog2.cob" "syn_misc.at:2660" -( $at_check_trace; $COMPILE_ONLY -fmfcomment prog2.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog2.cob:11: error: invalid indicator '\$' at column 7 -prog2.cob:17: error: invalid symbol '|' - skipping word -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/syn_misc.at:2660" -$at_failed && at_fn_log_failure -$at_traceon; } - - -# COMPILE needed, see note above -{ set +x -$as_echo "$at_srcdir/syn_misc.at:2666: \$COMPILE -facucomment prog.cob -o prog1" -at_fn_check_prepare_dynamic "$COMPILE -facucomment prog.cob -o prog1" "syn_misc.at:2666" -( $at_check_trace; $COMPILE -facucomment prog.cob -o prog1 -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/syn_misc.at:2666" -$at_failed && at_fn_log_failure -$at_traceon; } - - -{ set +x -$as_echo "$at_srcdir/syn_misc.at:2668: \$COBCRUN_DIRECT ./prog1" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog1" "syn_misc.at:2668" -( $at_check_trace; $COBCRUN_DIRECT ./prog1 -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo "MFCOMMENTASTERISK -MFCOMMENTSLASH -NOMFCOMMENTASTERISK -NOMFCOMMENTSLASH -NOFLOATING -" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/syn_misc.at:2668" -$at_failed && at_fn_log_failure -$at_traceon; } - - -# COMPILE needed, see note above -{ set +x -$as_echo "$at_srcdir/syn_misc.at:2677: \$COMPILE -facucomment prog2.cob" -at_fn_check_prepare_dynamic "$COMPILE -facucomment prog2.cob" "syn_misc.at:2677" -( $at_check_trace; $COMPILE -facucomment prog2.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/syn_misc.at:2677" -$at_failed && at_fn_log_failure -$at_traceon; } - - -{ set +x -$as_echo "$at_srcdir/syn_misc.at:2679: \$COBCRUN_DIRECT ./prog2" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog2" "syn_misc.at:2679" -( $at_check_trace; $COBCRUN_DIRECT ./prog2 -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo "MFCOMMENTASTERISK -MFCOMMENTSLASH -NOMFCOMMENTASTERISK -NOMFCOMMENTSLASH -NOACUFLOATING -NOFLOATING -" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/syn_misc.at:2679" -$at_failed && at_fn_log_failure -$at_traceon; } - - - -{ set +x -$as_echo "$at_srcdir/syn_misc.at:2689: \$COMPILE_ONLY -free prog3.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY -free prog3.cob" "syn_misc.at:2689" -( $at_check_trace; $COMPILE_ONLY -free prog3.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog3.cob:11: warning: spurious '\$' detected - ignored -prog3.cob:9: error: syntax error, unexpected * -prog3.cob:10: error: syntax error, unexpected / -prog3.cob:12: error: syntax error, unexpected * -prog3.cob:13: error: syntax error, unexpected / -prog3.cob:14: error: invalid symbol '|' - skipping word -prog3.cob:16: error: syntax error, unexpected Identifier -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/syn_misc.at:2689" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/syn_misc.at:2698: \$COMPILE_ONLY -free -fmfcomment prog3.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY -free -fmfcomment prog3.cob" "syn_misc.at:2698" -( $at_check_trace; $COMPILE_ONLY -free -fmfcomment prog3.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog3.cob:11: warning: spurious '\$' detected - ignored -prog3.cob:9: error: syntax error, unexpected * -prog3.cob:10: error: syntax error, unexpected / -prog3.cob:12: error: syntax error, unexpected * -prog3.cob:13: error: syntax error, unexpected / -prog3.cob:14: error: invalid symbol '|' - skipping word -prog3.cob:16: error: syntax error, unexpected Identifier -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/syn_misc.at:2698" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/syn_misc.at:2707: \$COMPILE_ONLY -free -facucomment prog3.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY -free -facucomment prog3.cob" "syn_misc.at:2707" -( $at_check_trace; $COMPILE_ONLY -free -facucomment prog3.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog3.cob:11: warning: spurious '\$' detected - ignored -prog3.cob:9: error: syntax error, unexpected * -prog3.cob:10: error: syntax error, unexpected / -prog3.cob:12: error: syntax error, unexpected * -prog3.cob:13: error: syntax error, unexpected / -prog3.cob:16: error: syntax error, unexpected Identifier -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/syn_misc.at:2707" -$at_failed && at_fn_log_failure -$at_traceon; } - -# Check that invalid indicator and doesn't abort preprocessing -# and that errors in preprocessing doesn't abort compilation -{ set +x -$as_echo "$at_srcdir/syn_misc.at:2717: \$COMPILE_ONLY prog3.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY prog3.cob" "syn_misc.at:2717" -( $at_check_trace; $COMPILE_ONLY prog3.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog3.cob:2: error: invalid indicator 'F' at column 7 -prog3.cob:3: error: invalid indicator 'M' at column 7 -prog3.cob:4: error: invalid indicator 'N' at column 7 -prog3.cob:5: error: invalid indicator 'U' at column 7 -prog3.cob:7: error: invalid indicator 'G' at column 7 -prog3.cob:8: error: invalid indicator 'U' at column 7 -prog3.cob:11: error: invalid indicator '\$' at column 7 -prog3.cob:16: error: invalid indicator 'x' at column 7 -prog3.cob:6: error: PROGRAM-ID header missing -prog3.cob:6: error: PROCEDURE DIVISION header missing -prog3.cob:6: error: syntax error, unexpected DIVISION -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/syn_misc.at:2717" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_255 -#AT_START_256 -at_fn_group_banner 256 'syn_misc.at:2734' \ - "word length" " " 2 -at_xfail=no -( - $as_echo "256. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - CONFIGURATION SECTION. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 FILLER PIC 9(01) VALUE 0. - 88 SOME-SPECIAL-VAL-WITH-LENGTH30 VALUE 0. - 88 SOME-SPECIAL-VAL-WITH-LENGTH-31 VALUE 1. - 88 SOME-SPECIAL-VAL-WITH-LENGTH-32C VALUE 1. - 88 SOME-SPECIAL-VAL-WITH-LENGTH-58C-WHO-NEEDS-THAT-LONG-NAMES VALUE 3. - 88 SOME-SPECIAL-VAL-WITH-LENGTH-90-CHARS-WHO-NEEDS-THAT-LONG-NAMES-I-CANNOT-THINK-OF-SOMEONE VALUE 4. - PROCEDURE DIVISION. - SOME-SPECIAL-PAR-WITH-LENGTH30. - SET SOME-SPECIAL-VAL-WITH-LENGTH30 TO TRUE. - SOME-SPECIAL-PAR-WITH-LENGTH-31. - SET SOME-SPECIAL-VAL-WITH-LENGTH-31 TO TRUE. - SOME-SPECIAL-PAR-WITH-LENGTH-32C. - SET SOME-SPECIAL-VAL-WITH-LENGTH-32C TO TRUE. - SOME-SPECIAL-PAR-WITH-LENGTH-58C-WHO-NEEDS-THAT-LONG-NAMES. - SET SOME-SPECIAL-VAL-WITH-LENGTH-58C-WHO-NEEDS-THAT-LONG-NAMES TO TRUE. - SOME-SPECIAL-PAR-WITH-LENGTH-90-CHARS-WHO-NEEDS-THAT-LONG-NAMES-I-CANNOT-THINK-OF-SOMEONE. - SET SOME-SPECIAL-VAL-WITH-LENGTH-90-CHARS-WHO-NEEDS-THAT-LONG-NAMES-I-CANNOT-THINK-OF-SOMEONE TO TRUE. - STOP RUN. -_ATEOF - - -cat >prog2.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog2. - ENVIRONMENT DIVISION. - CONFIGURATION SECTION. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 FILLER PIC 9(01) VALUE 0. - 88 SOME-SPECIAL-VAL-WITH-LENGTH30 VALUE 0. - 88 SOME-SPECIAL-VAL-WITH-LENGTH-31 VALUE 1. - 88 SOME-SPECIAL-VAL-WITH-LENGTH-32C VALUE 1. - 88 SOME-SPECIAL-VAL-WITH-LENGTH-58C-WHO-NEEDS-THAT-LONG-NAMES VALUE 3. - PROCEDURE DIVISION. - SOME-SPECIAL-PAR-WITH-LENGTH30. - SET SOME-SPECIAL-VAL-WITH-LENGTH30 TO TRUE. - SOME-SPECIAL-PAR-WITH-LENGTH-31. - SET SOME-SPECIAL-VAL-WITH-LENGTH-31 TO TRUE. - SOME-SPECIAL-PAR-WITH-LENGTH-32C. - SET SOME-SPECIAL-VAL-WITH-LENGTH-32C TO TRUE. - SOME-SPECIAL-PAR-WITH-LENGTH-58C-WHO-NEEDS-THAT-LONG-NAMES. - SET SOME-SPECIAL-VAL-WITH-LENGTH-58C-WHO-NEEDS-THAT-LONG-NAMES TO TRUE. - STOP RUN. -_ATEOF - - -cat >prog3.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog3. - DATA DIVISION. - WORKING-STORAGE SECTION. - 77 COUNTER PIC 9 VALUE 0. - PROCEDURE DIVISION. - - 00000000000000000000000000000000000000000000000000000000000 - SECTION. - 000000000000000000000000000000000000000000000000000000000000. - ADD 1 TO COUNTER END-ADD - EVALUATE COUNTER - WHEN 1 - PERFORM - 00000000000000000000000000000000000000000000000000000000000 - WHEN 2 - PERFORM - 000000000000000000000000000000000000000000000000000000000000 - WHEN 3 - MOVE 0 TO COUNTER - END-EVALUATE. - - 100000000000000000000000000000000000000000000000000000000001 - SECTION. - 20000000000000000000000000000000000000000000000000000000002. - ADD 1 TO COUNTER END-ADD - EVALUATE COUNTER - WHEN 1 - PERFORM - 100000000000000000000000000000000000000000000000000000000001 - WHEN 2 - PERFORM - 20000000000000000000000000000000000000000000000000000000002 - WHEN 3 - MOVE 0 TO COUNTER - END-EVALUATE. - - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/syn_misc.at:2829: \$COMPILE_ONLY -free -fword-length=31 prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY -free -fword-length=31 prog.cob" "syn_misc.at:2829" -( $at_check_trace; $COMPILE_ONLY -free -fword-length=31 prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob:11: error: word length exceeds 31 characters: 'SOME-SPECIAL-VAL-WITH-LENGTH-32C' -prog.cob:12: error: word length exceeds 31 characters: 'SOME-SPECIAL-VAL-WITH-LENGTH-58C-WHO-NEEDS-THAT-LONG-NAMES' -prog.cob:13: error: word length exceeds maximum of 63 characters: 'SOME-SPECIAL-VAL-WITH-LENGTH-90-CHARS-WHO-NEEDS-THAT-LONG-NAMES-I-CANNOT-THINK-OF-SOMEONE' -prog.cob: in paragraph 'SOME-SPECIAL-PAR-WITH-LENGTH-31': -prog.cob:19: error: word length exceeds 31 characters: 'SOME-SPECIAL-PAR-WITH-LENGTH-32C' -prog.cob: in paragraph 'SOME-SPECIAL-PAR-WITH-LENGTH-32C': -prog.cob:20: error: word length exceeds 31 characters: 'SOME-SPECIAL-VAL-WITH-LENGTH-32C' -prog.cob:21: error: word length exceeds 31 characters: 'SOME-SPECIAL-PAR-WITH-LENGTH-58C-WHO-NEEDS-THAT-LONG-NAMES' -prog.cob: in paragraph 'SOME-SPECIAL-PAR-WITH-LENGTH-58C-WHO-NEEDS-THAT-LONG-NAMES': -prog.cob:22: error: word length exceeds 31 characters: 'SOME-SPECIAL-VAL-WITH-LENGTH-58C-WHO-NEEDS-THAT-LONG-NAMES' -prog.cob:23: error: word length exceeds maximum of 63 characters: 'SOME-SPECIAL-PAR-WITH-LENGTH-90-CHARS-WHO-NEEDS-THAT-LONG-NAMES-I-CANNOT-THINK-OF-SOMEONE' -prog.cob: in paragraph 'SOME-SPECIAL-PAR-WITH-LENGTH-90-CHARS-WHO-NEEDS-THAT-LONG-NAMES-I-CANNOT-THINK-OF-SOMEONE': -prog.cob:24: error: word length exceeds maximum of 63 characters: 'SOME-SPECIAL-VAL-WITH-LENGTH-90-CHARS-WHO-NEEDS-THAT-LONG-NAMES-I-CANNOT-THINK-OF-SOMEONE' -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/syn_misc.at:2829" -$at_failed && at_fn_log_failure -$at_traceon; } - - -{ set +x -$as_echo "$at_srcdir/syn_misc.at:2845: \$COMPILE_ONLY -free -fword-length=45 prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY -free -fword-length=45 prog.cob" "syn_misc.at:2845" -( $at_check_trace; $COMPILE_ONLY -free -fword-length=45 prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob:12: error: word length exceeds 45 characters: 'SOME-SPECIAL-VAL-WITH-LENGTH-58C-WHO-NEEDS-THAT-LONG-NAMES' -prog.cob:13: error: word length exceeds maximum of 63 characters: 'SOME-SPECIAL-VAL-WITH-LENGTH-90-CHARS-WHO-NEEDS-THAT-LONG-NAMES-I-CANNOT-THINK-OF-SOMEONE' -prog.cob: in paragraph 'SOME-SPECIAL-PAR-WITH-LENGTH-32C': -prog.cob:21: error: word length exceeds 45 characters: 'SOME-SPECIAL-PAR-WITH-LENGTH-58C-WHO-NEEDS-THAT-LONG-NAMES' -prog.cob: in paragraph 'SOME-SPECIAL-PAR-WITH-LENGTH-58C-WHO-NEEDS-THAT-LONG-NAMES': -prog.cob:22: error: word length exceeds 45 characters: 'SOME-SPECIAL-VAL-WITH-LENGTH-58C-WHO-NEEDS-THAT-LONG-NAMES' -prog.cob:23: error: word length exceeds maximum of 63 characters: 'SOME-SPECIAL-PAR-WITH-LENGTH-90-CHARS-WHO-NEEDS-THAT-LONG-NAMES-I-CANNOT-THINK-OF-SOMEONE' -prog.cob: in paragraph 'SOME-SPECIAL-PAR-WITH-LENGTH-90-CHARS-WHO-NEEDS-THAT-LONG-NAMES-I-CANNOT-THINK-OF-SOMEONE': -prog.cob:24: error: word length exceeds maximum of 63 characters: 'SOME-SPECIAL-VAL-WITH-LENGTH-90-CHARS-WHO-NEEDS-THAT-LONG-NAMES-I-CANNOT-THINK-OF-SOMEONE' -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/syn_misc.at:2845" -$at_failed && at_fn_log_failure -$at_traceon; } - - -{ set +x -$as_echo "$at_srcdir/syn_misc.at:2857: \$COMPILE_ONLY -free -fword-length=60 prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY -free -fword-length=60 prog.cob" "syn_misc.at:2857" -( $at_check_trace; $COMPILE_ONLY -free -fword-length=60 prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob:13: error: word length exceeds maximum of 63 characters: 'SOME-SPECIAL-VAL-WITH-LENGTH-90-CHARS-WHO-NEEDS-THAT-LONG-NAMES-I-CANNOT-THINK-OF-SOMEONE' -prog.cob: in paragraph 'SOME-SPECIAL-PAR-WITH-LENGTH-58C-WHO-NEEDS-THAT-LONG-NAMES': -prog.cob:23: error: word length exceeds maximum of 63 characters: 'SOME-SPECIAL-PAR-WITH-LENGTH-90-CHARS-WHO-NEEDS-THAT-LONG-NAMES-I-CANNOT-THINK-OF-SOMEONE' -prog.cob: in paragraph 'SOME-SPECIAL-PAR-WITH-LENGTH-90-CHARS-WHO-NEEDS-THAT-LONG-NAMES-I-CANNOT-THINK-OF-SOMEONE': -prog.cob:24: error: word length exceeds maximum of 63 characters: 'SOME-SPECIAL-VAL-WITH-LENGTH-90-CHARS-WHO-NEEDS-THAT-LONG-NAMES-I-CANNOT-THINK-OF-SOMEONE' -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/syn_misc.at:2857" -$at_failed && at_fn_log_failure -$at_traceon; } - - -{ set +x -$as_echo "$at_srcdir/syn_misc.at:2865: \$COMPILE_ONLY -free -fword-length=45 -frelax-syntax-checks prog2.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY -free -fword-length=45 -frelax-syntax-checks prog2.cob" "syn_misc.at:2865" -( $at_check_trace; $COMPILE_ONLY -free -fword-length=45 -frelax-syntax-checks prog2.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog2.cob:12: warning: word length exceeds 45 characters: 'SOME-SPECIAL-VAL-WITH-LENGTH-58C-WHO-NEEDS-THAT-LONG-NAMES' -prog2.cob: in paragraph 'SOME-SPECIAL-PAR-WITH-LENGTH-32C': -prog2.cob:20: warning: word length exceeds 45 characters: 'SOME-SPECIAL-PAR-WITH-LENGTH-58C-WHO-NEEDS-THAT-LONG-NAMES' -prog2.cob: in paragraph 'SOME-SPECIAL-PAR-WITH-LENGTH-58C-WHO-NEEDS-THAT-LONG-NAMES': -prog2.cob:21: warning: word length exceeds 45 characters: 'SOME-SPECIAL-VAL-WITH-LENGTH-58C-WHO-NEEDS-THAT-LONG-NAMES' -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/syn_misc.at:2865" -$at_failed && at_fn_log_failure -$at_traceon; } - - -{ set +x -$as_echo "$at_srcdir/syn_misc.at:2873: \$COMPILE_ONLY -free -fword-length=60 prog2.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY -free -fword-length=60 prog2.cob" "syn_misc.at:2873" -( $at_check_trace; $COMPILE_ONLY -free -fword-length=60 prog2.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/syn_misc.at:2873" -$at_failed && at_fn_log_failure -$at_traceon; } - - -{ set +x -$as_echo "$at_srcdir/syn_misc.at:2875: \$COMPILE_ONLY -free -fword-length=31 -frelax-syntax-checks prog2.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY -free -fword-length=31 -frelax-syntax-checks prog2.cob" "syn_misc.at:2875" -( $at_check_trace; $COMPILE_ONLY -free -fword-length=31 -frelax-syntax-checks prog2.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog2.cob:11: warning: word length exceeds 31 characters: 'SOME-SPECIAL-VAL-WITH-LENGTH-32C' -prog2.cob:12: warning: word length exceeds 31 characters: 'SOME-SPECIAL-VAL-WITH-LENGTH-58C-WHO-NEEDS-THAT-LONG-NAMES' -prog2.cob: in paragraph 'SOME-SPECIAL-PAR-WITH-LENGTH-31': -prog2.cob:18: warning: word length exceeds 31 characters: 'SOME-SPECIAL-PAR-WITH-LENGTH-32C' -prog2.cob: in paragraph 'SOME-SPECIAL-PAR-WITH-LENGTH-32C': -prog2.cob:19: warning: word length exceeds 31 characters: 'SOME-SPECIAL-VAL-WITH-LENGTH-32C' -prog2.cob:20: warning: word length exceeds 31 characters: 'SOME-SPECIAL-PAR-WITH-LENGTH-58C-WHO-NEEDS-THAT-LONG-NAMES' -prog2.cob: in paragraph 'SOME-SPECIAL-PAR-WITH-LENGTH-58C-WHO-NEEDS-THAT-LONG-NAMES': -prog2.cob:21: warning: word length exceeds 31 characters: 'SOME-SPECIAL-VAL-WITH-LENGTH-58C-WHO-NEEDS-THAT-LONG-NAMES' -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/syn_misc.at:2875" -$at_failed && at_fn_log_failure -$at_traceon; } - - -{ set +x -$as_echo "$at_srcdir/syn_misc.at:2887: \$COMPILE_ONLY -fword-length=59 prog3.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY -fword-length=59 prog3.cob" "syn_misc.at:2887" -( $at_check_trace; $COMPILE_ONLY -fword-length=59 prog3.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog3.cob: in section '00000000000000000000000000000000000000000000000000000000000': -prog3.cob:11: error: word length exceeds 59 characters: '000000000000000000000000000000000000000000000000000000000000' -prog3.cob: in paragraph '000000000000000000000000000000000000000000000000000000000000': -prog3.cob:25: error: word length exceeds 59 characters: '100000000000000000000000000000000000000000000000000000000001' -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/syn_misc.at:2887" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_256 -#AT_START_257 -at_fn_group_banner 257 'syn_misc.at:2897' \ - "Segmentation Module" " " 2 -at_xfail=no -( - $as_echo "257. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - PROCEDURE DIVISION. - - DECLARATIVES. - - DEC-1 SECTION 49. - CONTINUE. - - DEC-2 SECTION 50. - CONTINUE. - - END DECLARATIVES. - - SEC-1 SECTION 00. - CONTINUE. - - SEC-2 SECTION 01. - CONTINUE. - - SEC-3 SECTION -00. - CONTINUE. - - SEC-4 SECTION 100. - CONTINUE. - - SEC-5 SECTION 49. - CONTINUE. - - SEC-6 SECTION 50. - PERFORM SEC-1. - - SEC-7 SECTION 99. - PERFORM SEC-1. - - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/syn_misc.at:2940: \$COMPILE_ONLY prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY prog.cob" "syn_misc.at:2940" -( $at_check_trace; $COMPILE_ONLY prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob: in section 'DEC-1': -prog.cob:9: warning: section segments ignored -prog.cob: in section 'DEC-2': -prog.cob:12: warning: section segments ignored -prog.cob: in section 'SEC-1': -prog.cob:17: warning: section segments ignored -prog.cob: in section 'SEC-2': -prog.cob:20: warning: section segments ignored -prog.cob: in section 'SEC-3': -prog.cob:23: error: unsigned integer value expected -prog.cob:23: warning: section segments ignored -prog.cob: in section 'SEC-4': -prog.cob:26: warning: section segments ignored -prog.cob: in section 'SEC-5': -prog.cob:29: warning: section segments ignored -prog.cob: in section 'SEC-6': -prog.cob:32: warning: section segments ignored -prog.cob: in section 'SEC-7': -prog.cob:35: warning: section segments ignored -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/syn_misc.at:2940" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/syn_misc.at:2961: \$COMPILE_ONLY -std=cobol85 prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY -std=cobol85 prog.cob" "syn_misc.at:2961" -( $at_check_trace; $COMPILE_ONLY -std=cobol85 prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob: in section 'DEC-1': -prog.cob:9: warning: section segments is obsolete in COBOL 85 -prog.cob:9: warning: SECTION segment within DECLARATIVES is not implemented -prog.cob: in section 'DEC-2': -prog.cob:12: warning: section segments is obsolete in COBOL 85 -prog.cob:12: error: SECTION segment-number in DECLARATIVES must be less than 50 -prog.cob:12: warning: SECTION segment within DECLARATIVES is not implemented -prog.cob: in section 'SEC-1': -prog.cob:17: warning: section segments is obsolete in COBOL 85 -prog.cob: in section 'SEC-2': -prog.cob:20: warning: section segments is obsolete in COBOL 85 -prog.cob: in section 'SEC-3': -prog.cob:23: error: unsigned integer value expected -prog.cob:23: warning: section segments is obsolete in COBOL 85 -prog.cob: in section 'SEC-4': -prog.cob:26: warning: section segments is obsolete in COBOL 85 -prog.cob:26: error: SECTION segment-number must be less than or equal to 99 -prog.cob: in section 'SEC-5': -prog.cob:29: warning: section segments is obsolete in COBOL 85 -prog.cob: in section 'SEC-6': -prog.cob:32: warning: section segments is obsolete in COBOL 85 -prog.cob: in section 'SEC-7': -prog.cob:35: warning: section segments is obsolete in COBOL 85 -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/syn_misc.at:2961" -$at_failed && at_fn_log_failure -$at_traceon; } - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_257 -#AT_START_258 -at_fn_group_banner 258 'syn_misc.at:2989' \ - "ACCEPT FROM ESCAPE KEY" " " 2 -at_xfail=no -( - $as_echo "258. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -# TODO: add function test to run_manual_screen.at - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 77 KEYNUM PIC 9(04). - PROCEDURE DIVISION. - - ACCEPT KEYNUM FROM ESCAPE KEY - DISPLAY "Key pressed: " KEYNUM - ACCEPT KEYNUM FROM ESCAPE - DISPLAY "Key pressed: " KEYNUM - ACCEPT OMITTED - - STOP RUN. -_ATEOF - -{ set +x -$as_echo "$at_srcdir/syn_misc.at:3010: \$COMPILE_ONLY prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY prog.cob" "syn_misc.at:3010" -( $at_check_trace; $COMPILE_ONLY prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/syn_misc.at:3010" -$at_failed && at_fn_log_failure -$at_traceon; } - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_258 -#AT_START_259 -at_fn_group_banner 259 'syn_misc.at:3014' \ - "Numeric literals" " " 2 -at_xfail=no -( - $as_echo "259. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 77 COUNTER PIC 9 VALUE 0. - PROCEDURE DIVISION. - - *> No literals at all - 00000000000000000000000000000000000000000000000000000000000 - SECTION. - 000000000000000000000000000000000000000000000000000000000000. - ADD 1 TO COUNTER END-ADD - EVALUATE COUNTER - WHEN 1 - PERFORM - 00000000000000000000000000000000000000000000000000000000000 - WHEN 2 - PERFORM - 000000000000000000000000000000000000000000000000000000000000 - WHEN 3 - MOVE 0 TO COUNTER - END-EVALUATE. - - 100000000000000000000000000000000000000000000000000000000001 - SECTION. - 20000000000000000000000000000000000000000000000000000000002. - ADD 1 TO COUNTER END-ADD - EVALUATE COUNTER - WHEN 1 - PERFORM - 100000000000000000000000000000000000000000000000000000000001 - WHEN 2 - PERFORM - 20000000000000000000000000000000000000000000000000000000002 - WHEN 3 - MOVE 0 TO COUNTER - END-EVALUATE. - - STOP RUN. -_ATEOF - - -cat >prog2.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog2. - ENVIRONMENT DIVISION. - CONFIGURATION SECTION. - SPECIAL-NAMES. - PROCEDURE DIVISION. - - *> Valid literals, depending on numeric literal size - DISPLAY 1.0076, +100000.03, +1.0, -0078, - +.1234567890123456789012345678901234 - .123456789012345678901234567890123450 - END-DISPLAY - - *> Invalid literals - DISPLAY 1.03.0 END-DISPLAY - DISPLAY --123 END-DISPLAY - DISPLAY -123- END-DISPLAY - DISPLAY -123-456 END-DISPLAY - DISPLAY -123-4.56 END-DISPLAY - DISPLAY -12.3-456 END-DISPLAY - DISPLAY -12.3-4.56 END-DISPLAY - DISPLAY 1000003+ END-DISPLAY - DISPLAY 1.000003+ END-DISPLAY - DISPLAY .3+ END-DISPLAY - DISPLAY 3.+ END-DISPLAY - - STOP RUN. -_ATEOF - - -cat >prog3.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog3. - ENVIRONMENT DIVISION. - CONFIGURATION SECTION. - SPECIAL-NAMES. DECIMAL-POINT IS COMMA. - PROCEDURE DIVISION. - - *> Valid literals, depending on numeric literal size - DISPLAY 1,0076, +100000,03, +1,0, -0078, - +,1234567890123456789012345678901234 - ,123456789012345678901234567890123450 - END-DISPLAY - - *> Invalid literals - DISPLAY 1,03,0 END-DISPLAY - DISPLAY --123 END-DISPLAY - DISPLAY -123- END-DISPLAY - DISPLAY -123-456 END-DISPLAY - DISPLAY -123-4,56 END-DISPLAY - DISPLAY -12,3-456 END-DISPLAY - DISPLAY -12,3-4,56 END-DISPLAY - DISPLAY 1000003+ END-DISPLAY - DISPLAY 1,000003+ END-DISPLAY - DISPLAY ,3+ END-DISPLAY - DISPLAY 3,+ END-DISPLAY - - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/syn_misc.at:3119: \$COMPILE_ONLY -fliteral-length=1 -fnumeric-literal-length=1 -fword-length=60 prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY -fliteral-length=1 -fnumeric-literal-length=1 -fword-length=60 prog.cob" "syn_misc.at:3119" -( $at_check_trace; $COMPILE_ONLY -fliteral-length=1 -fnumeric-literal-length=1 -fword-length=60 prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/syn_misc.at:3119" -$at_failed && at_fn_log_failure -$at_traceon; } - - -# result with extended scanner for wrong numeric literals: -#AT_CHECK([$COMPILE_ONLY prog2.cob], [1], [], -#[prog2.cob:16: error: invalid numeric literal: '1.03.0' -#prog2.cob:16: error: literal with more than one decimal point -#prog2.cob:17: error: invalid numeric literal: '--123' -#prog2.cob:17: error: literal with more than one sign character -#prog2.cob:18: error: invalid numeric literal: '-123-' -#prog2.cob:18: error: literal with more than one sign character -#prog2.cob:19: error: invalid numeric literal: '-123-456' -#prog2.cob:19: error: literal with more than one sign character -#prog2.cob:20: error: invalid numeric literal: '-123-4.56' -#prog2.cob:20: error: literal with more than one sign character -#prog2.cob:21: error: invalid numeric literal: '-12.3-456' -#prog2.cob:21: error: literal with more than one sign character -#prog2.cob:22: error: invalid numeric literal: '-12.3-4.56' -#prog2.cob:22: error: literal with more than one sign character -#prog2.cob:22: error: literal with more than one decimal point -#prog2.cob:23: error: invalid numeric literal: '1000003+' -#prog2.cob:23: error: sign must appear as leftmost character -#prog2.cob:24: error: invalid numeric literal: '1.000003+' -#prog2.cob:24: error: sign must appear as leftmost character -#prog2.cob:25: error: invalid numeric literal: '.3+' -#prog2.cob:25: error: sign must appear as leftmost character -#prog2.cob:26: error: invalid numeric literal: '3.+' -#prog2.cob:26: error: sign must appear as leftmost character -#]) -#AT_CHECK([$COMPILE_ONLY prog3.cob], [1], [], -#[prog3.cob:16: error: invalid numeric literal: '1,03,0' -#prog3.cob:16: error: literal with more than one decimal point -#prog3.cob:17: error: invalid numeric literal: '--123' -#prog3.cob:17: error: literal with more than one sign character -#prog3.cob:18: error: invalid numeric literal: '-123-' -#prog3.cob:18: error: literal with more than one sign character -#prog3.cob:19: error: invalid numeric literal: '-123-456' -#prog3.cob:19: error: literal with more than one sign character -#prog3.cob:20: error: invalid numeric literal: '-123-4,56' -#prog3.cob:20: error: literal with more than one sign character -#prog3.cob:21: error: invalid numeric literal: '-12,3-456' -#prog3.cob:21: error: literal with more than one sign character -#prog3.cob:22: error: invalid numeric literal: '-12,3-4,56' -#prog3.cob:22: error: literal with more than one sign character -#prog3.cob:22: error: literal with more than one decimal point -#prog3.cob:23: error: invalid numeric literal: '1000003+' -#prog3.cob:23: error: sign must appear as leftmost character -#prog3.cob:24: error: invalid numeric literal: '1,000003+' -#prog3.cob:24: error: sign must appear as leftmost character -#prog3.cob:25: error: invalid numeric literal: ',3+' -#prog3.cob:25: error: sign must appear as leftmost character -#prog3.cob:26: error: invalid numeric literal: '3,+' -#prog3.cob:26: error: sign must appear as leftmost character -#]) - -{ set +x -$as_echo "$at_srcdir/syn_misc.at:3173: \$COMPILE_ONLY prog2.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY prog2.cob" "syn_misc.at:3173" -( $at_check_trace; $COMPILE_ONLY prog2.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog2.cob:17: error: syntax error, unexpected -, expecting ( -prog2.cob:18: error: syntax error, unexpected - -prog2.cob:23: error: syntax error, unexpected + -prog2.cob:24: error: syntax error, unexpected + -prog2.cob:25: error: syntax error, unexpected + -prog2.cob:26: error: syntax error, unexpected + -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/syn_misc.at:3173" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/syn_misc.at:3181: \$COMPILE_ONLY prog3.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY prog3.cob" "syn_misc.at:3181" -( $at_check_trace; $COMPILE_ONLY prog3.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog3.cob:17: error: syntax error, unexpected -, expecting ( -prog3.cob:18: error: syntax error, unexpected - -prog3.cob:23: error: syntax error, unexpected + -prog3.cob:24: error: syntax error, unexpected + -prog3.cob:25: error: syntax error, unexpected + -prog3.cob:26: error: syntax error, unexpected + -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/syn_misc.at:3181" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_259 -#AT_START_260 -at_fn_group_banner 260 'syn_misc.at:3193' \ - "floating-point literals" " " 2 -at_xfail=no -( - $as_echo "260. $at_setup_line: testing $at_desc ..." - $at_traceon - -# Refer to Section 8.3.1.2.2.2 of COBOL 2014. - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - PROCEDURE DIVISION. - *> Valid literals - DISPLAY 1.0E6144, +1.0E+3, +1.0E-6143, 123.E1, - +.123456789012345678901234567890123456E+0000 - END-DISPLAY - - *> invalid literals - DISPLAY 1.0D3 END-DISPLAY - DISPLAY 1E3 END-DISPLAY - DISPLAY '1.0E3'BLAH END-DISPLAY - DISPLAY 1.0E3.0 END-DISPLAY - DISPLAY -0.0E-0 END-DISPLAY - DISPLAY 1.0E00003 END-DISPLAY - DISPLAY .123456789012345678901234567890123456789E0 - END-DISPLAY - DISPLAY 0.0E3 END-DISPLAY - - *> Implementor-defined invalid literals - DISPLAY 1.0E6145 END-DISPLAY - DISPLAY 1.0E-6144 END-DISPLAY - - STOP RUN. -_ATEOF - - -cat >prog2.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog2. - ENVIRONMENT DIVISION. - CONFIGURATION SECTION. - SPECIAL-NAMES. - DECIMAL-POINT IS COMMA. - PROCEDURE DIVISION. - *> Valid literals - DISPLAY 1,0E6144; +1,0E+3; +1,0E-6143; 123,E1; - +,123456789012345678901234567890123456E+0000 - END-DISPLAY - - *> invalid literals - DISPLAY 1,0D3 END-DISPLAY - DISPLAY 1E3 END-DISPLAY - DISPLAY 1,0E3BLAH END-DISPLAY - DISPLAY 1,0E3,0 END-DISPLAY - DISPLAY -0,0E-0 END-DISPLAY - DISPLAY 1,0E00003 END-DISPLAY - DISPLAY ,123456789012345678901234567890123456789E0 - END-DISPLAY - DISPLAY 0,0E3 END-DISPLAY - - *> Implementor-defined invalid literals - DISPLAY 1,0E6145 END-DISPLAY - DISPLAY 1,0E-6144 END-DISPLAY - - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/syn_misc.at:3255: \$COMPILE_ONLY prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY prog.cob" "syn_misc.at:3255" -( $at_check_trace; $COMPILE_ONLY prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob:11: error: 'D3' is not defined -prog.cob:12: error: '1E3' is not defined -prog.cob:13: error: 'BLAH' is not defined -prog.cob:14: error: invalid floating-point literal: '1.0E3.0' -prog.cob:14: error: exponent has decimal point -prog.cob:15: error: invalid floating-point literal: '-0.0E-0' -prog.cob:15: error: significand of 0 must be positive -prog.cob:15: error: exponent of 0 must be positive -prog.cob:16: error: invalid floating-point literal: '1.0E00003' -prog.cob:16: error: exponent has more than 4 digits -prog.cob:17: error: invalid floating-point literal: '.1234567890123456789012345678901234...' -prog.cob:17: error: significand has more than 36 digits -prog.cob:19: error: invalid floating-point literal: '0.0E3' -prog.cob:19: error: exponent of 0 must be 0 -prog.cob:22: error: invalid floating-point literal: '1.0E6145' -prog.cob:22: error: exponent not between -6143 and 6144 -prog.cob:23: error: invalid floating-point literal: '1.0E-6144' -prog.cob:23: error: exponent not between -6143 and 6144 -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/syn_misc.at:3255" -$at_failed && at_fn_log_failure -$at_traceon; } - - -{ set +x -$as_echo "$at_srcdir/syn_misc.at:3276: \$COMPILE_ONLY prog2.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY prog2.cob" "syn_misc.at:3276" -( $at_check_trace; $COMPILE_ONLY prog2.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog2.cob:15: error: 'D3' is not defined -prog2.cob:16: error: '1E3' is not defined -prog2.cob:17: error: 'BLAH' is not defined -prog2.cob:18: error: invalid floating-point literal: '1,0E3,0' -prog2.cob:18: error: exponent has decimal point -prog2.cob:19: error: invalid floating-point literal: '-0,0E-0' -prog2.cob:19: error: significand of 0 must be positive -prog2.cob:19: error: exponent of 0 must be positive -prog2.cob:20: error: invalid floating-point literal: '1,0E00003' -prog2.cob:20: error: exponent has more than 4 digits -prog2.cob:21: error: invalid floating-point literal: ',1234567890123456789012345678901234...' -prog2.cob:21: error: significand has more than 36 digits -prog2.cob:23: error: invalid floating-point literal: '0,0E3' -prog2.cob:23: error: exponent of 0 must be 0 -prog2.cob:26: error: invalid floating-point literal: '1,0E6145' -prog2.cob:26: error: exponent not between -6143 and 6144 -prog2.cob:27: error: invalid floating-point literal: '1,0E-6144' -prog2.cob:27: error: exponent not between -6143 and 6144 -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/syn_misc.at:3276" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_260 -#AT_START_261 -at_fn_group_banner 261 'syn_misc.at:3300' \ - "X literals" " " 2 -at_xfail=no -( - $as_echo "261. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - PROCEDURE DIVISION. - *> Valid form - DISPLAY X"0123456789ABCDEF" - - *> invalid form - DISPLAY X"GH" - X"1" - END-DISPLAY. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/syn_misc.at:3316: \$COMPILE_ONLY prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY prog.cob" "syn_misc.at:3316" -( $at_check_trace; $COMPILE_ONLY prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob:9: error: invalid X literal: 'GH' -prog.cob:9: error: literal contains invalid character 'G' -prog.cob:9: error: literal contains invalid character 'H' -prog.cob:10: error: invalid X literal: '1' -prog.cob:10: error: literal does not have an even number of digits -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/syn_misc.at:3316" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_261 -#AT_START_262 -at_fn_group_banner 262 'syn_misc.at:3327' \ - "national literals" " " 2 -at_xfail=no -( - $as_echo "262. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - PROCEDURE DIVISION. - DISPLAY N"UTF-16 string". - DISPLAY N'0123456789ABCDEF'. - DISPLAY N"0123456789ABCDEF"- - N"0123456789ABCDEF". - DISPLAY NC"0123456789ABCDEF"- - NC'0123456789ABCDEF'. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/syn_misc.at:3342: \$COMPILE_ONLY prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY prog.cob" "syn_misc.at:3342" -( $at_check_trace; $COMPILE_ONLY prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob:5: warning: handling of national literal is unfinished; implementation is likely to be changed -prog.cob:6: warning: handling of national literal is unfinished; implementation is likely to be changed -prog.cob:7: warning: handling of national literal is unfinished; implementation is likely to be changed -prog.cob:8: warning: handling of national literal is unfinished; implementation is likely to be changed -prog.cob:9: warning: national-character literal used -prog.cob:9: warning: handling of national literal is unfinished; implementation is likely to be changed -prog.cob:10: warning: national-character literal used -prog.cob:10: warning: handling of national literal is unfinished; implementation is likely to be changed -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/syn_misc.at:3342" -$at_failed && at_fn_log_failure -$at_traceon; } - - -{ set +x -$as_echo "$at_srcdir/syn_misc.at:3353: \$COMPILE_ONLY -std=cobol85 prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY -std=cobol85 prog.cob" "syn_misc.at:3353" -( $at_check_trace; $COMPILE_ONLY -std=cobol85 prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob:5: error: national literal does not conform to COBOL 85 -prog.cob:6: error: national literal does not conform to COBOL 85 -prog.cob:7: error: national literal does not conform to COBOL 85 -prog.cob:8: error: national literal does not conform to COBOL 85 -prog.cob:9: error: national-character literal does not conform to COBOL 85 -prog.cob:10: error: national-character literal does not conform to COBOL 85 -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/syn_misc.at:3353" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_262 -#AT_START_263 -at_fn_group_banner 263 'syn_misc.at:3365' \ - "NX literals" " " 2 -at_xfail=no -( - $as_echo "263. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - PROCEDURE DIVISION. - *> Valid form - DISPLAY NX"265E" - DISPLAY NX"0123456789ABCDEF" - - *> invalid form - DISPLAY NX"GH" - NX"1". -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/syn_misc.at:3381: \$COMPILE_ONLY prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY prog.cob" "syn_misc.at:3381" -( $at_check_trace; $COMPILE_ONLY prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob:6: warning: handling of national literal is unfinished; implementation is likely to be changed -prog.cob:7: warning: handling of national literal is unfinished; implementation is likely to be changed -prog.cob:10: warning: handling of national literal is unfinished; implementation is likely to be changed -prog.cob:10: error: invalid NX literal: 'GH' -prog.cob:10: error: literal contains invalid character 'G' -prog.cob:10: error: literal contains invalid character 'H' -prog.cob:11: warning: handling of national literal is unfinished; implementation is likely to be changed -prog.cob:11: error: invalid NX literal: '1' -prog.cob:11: error: literal does not have an even number of digits -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/syn_misc.at:3381" -$at_failed && at_fn_log_failure -$at_traceon; } - - -{ set +x -$as_echo "$at_srcdir/syn_misc.at:3393: \$COMPILE_ONLY -std=cobol85 prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY -std=cobol85 prog.cob" "syn_misc.at:3393" -( $at_check_trace; $COMPILE_ONLY -std=cobol85 prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob:6: error: hexadecimal-national literal does not conform to COBOL 85 -prog.cob:7: error: hexadecimal-national literal does not conform to COBOL 85 -prog.cob:10: error: hexadecimal-national literal does not conform to COBOL 85 -prog.cob:11: error: hexadecimal-national literal does not conform to COBOL 85 -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/syn_misc.at:3393" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_263 -#AT_START_264 -at_fn_group_banner 264 'syn_misc.at:3403' \ - "binary literals" " " 2 -at_xfail=no -( - $as_echo "264. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - PROCEDURE DIVISION. - DISPLAY B"101010" - DISPLAY B"111111111111111111111111111111111111111111111111111 - - "1111111111111" *> " Syntax highlighting hack - - DISPLAY B"23" - DISPLAY B"111111111111111111111111111111111111111111111111111 - - "111111111111111111111111111111111111111111111111111 - - "11111111111111111111111111111111111111111111111111" - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/syn_misc.at:3421: \$COMPILE_ONLY -std=mf prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY -std=mf prog.cob" "syn_misc.at:3421" -( $at_check_trace; $COMPILE_ONLY -std=mf prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob:9: error: invalid B literal: '23' -prog.cob:9: error: literal contains invalid character '2' -prog.cob:9: error: literal contains invalid character '3' -prog.cob:10: error: invalid B literal: '11111111111111111111111111111111111...' -prog.cob:10: error: literal length 152 exceeds 64 characters -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/syn_misc.at:3421" -$at_failed && at_fn_log_failure -$at_traceon; } - - -{ set +x -$as_echo "$at_srcdir/syn_misc.at:3429: \$COMPILE_ONLY -std=cobol85 prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY -std=cobol85 prog.cob" "syn_misc.at:3429" -( $at_check_trace; $COMPILE_ONLY -std=cobol85 prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob:5: error: numeric boolean literal does not conform to COBOL 85 -prog.cob:6: error: numeric boolean literal does not conform to COBOL 85 -prog.cob:9: error: numeric boolean literal does not conform to COBOL 85 -prog.cob:10: error: numeric boolean literal does not conform to COBOL 85 -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/syn_misc.at:3429" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_264 -#AT_START_265 -at_fn_group_banner 265 'syn_misc.at:3439' \ - "binary-hexadecimal literals" " " 2 -at_xfail=no -( - $as_echo "265. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - PROCEDURE DIVISION. - DISPLAY BX"AB05CD0F" - DISPLAY BX"0123456789ABCDEF0123456789ABCDEF0123456789A - - "BCDEF" *> " Syntax highlighting hack - - DISPLAY BX"A" - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/syn_misc.at:3454: \$COMPILE_ONLY prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY prog.cob" "syn_misc.at:3454" -( $at_check_trace; $COMPILE_ONLY prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob:6: error: invalid BX literal: '0123456789ABCDEF0123456789ABCDEF012...' -prog.cob:6: error: literal length 192 exceeds 64 characters -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/syn_misc.at:3454" -$at_failed && at_fn_log_failure -$at_traceon; } - - -{ set +x -$as_echo "$at_srcdir/syn_misc.at:3459: \$COMPILE_ONLY -std=cobol85 prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY -std=cobol85 prog.cob" "syn_misc.at:3459" -( $at_check_trace; $COMPILE_ONLY -std=cobol85 prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob:5: error: hexadecimal-boolean literal does not conform to COBOL 85 -prog.cob:6: error: hexadecimal-boolean literal does not conform to COBOL 85 -prog.cob:9: error: hexadecimal-boolean literal does not conform to COBOL 85 -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/syn_misc.at:3459" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_265 -#AT_START_266 -at_fn_group_banner 266 'syn_misc.at:3468' \ - "HP COBOL octal literals" " " 2 -at_xfail=no -( - $as_echo "266. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - PROCEDURE DIVISION. - *> Valid forms - DISPLAY %17 %37777777777 %456 - - *> invalid forms - DISPLAY %11111111111111111111111 - DISPLAY %89 - - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/syn_misc.at:3485: \$COMPILE_ONLY -Wno-unfinished -fhp-octal-literals=ok prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY -Wno-unfinished -fhp-octal-literals=ok prog.cob" "syn_misc.at:3485" -( $at_check_trace; $COMPILE_ONLY -Wno-unfinished -fhp-octal-literals=ok prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob:9: error: invalid % literal: '11111111111111111111111' -prog.cob:9: error: literal length 23 exceeds 22 characters -prog.cob:10: error: invalid % literal: '89' -prog.cob:10: error: literal contains invalid character '8' -prog.cob:10: error: literal contains invalid character '9' -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/syn_misc.at:3485" -$at_failed && at_fn_log_failure -$at_traceon; } - - -{ set +x -$as_echo "$at_srcdir/syn_misc.at:3493: \$COMPILE_ONLY -std=cobol2014 prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY -std=cobol2014 prog.cob" "syn_misc.at:3493" -( $at_check_trace; $COMPILE_ONLY -std=cobol2014 prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob:6: error: HP COBOL octal literal does not conform to COBOL 2014 -prog.cob:6: error: HP COBOL octal literal does not conform to COBOL 2014 -prog.cob:6: error: HP COBOL octal literal does not conform to COBOL 2014 -prog.cob:9: error: HP COBOL octal literal does not conform to COBOL 2014 -prog.cob:10: error: HP COBOL octal literal does not conform to COBOL 2014 -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/syn_misc.at:3493" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_266 -#AT_START_267 -at_fn_group_banner 267 'syn_misc.at:3504' \ - "ACUCOBOL literals" " " 2 -at_xfail=no -( - $as_echo "267. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - PROCEDURE DIVISION. - *> Valid forms - DISPLAY B#10 O#12345670123 X#12345678 H#90aBcDeF - END-DISPLAY - - *> invalid forms - >>SOURCE FREE - DISPLAY B#11111111111111111111111111111111111111111111111111111111111111111 - O#11111111111111111111111 X#11111111111111111 H#22222222222222222 - >>SOURCE FIXED - DISPLAY B#23 O#89 X#GG H#HH - - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/syn_misc.at:3525: \$COMPILE_ONLY -std=acu prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY -std=acu prog.cob" "syn_misc.at:3525" -( $at_check_trace; $COMPILE_ONLY -std=acu prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob:11: error: invalid B# literal: '11111111111111111111111111111111111...' -prog.cob:11: error: literal length 65 exceeds 64 characters -prog.cob:12: error: invalid O# literal: '11111111111111111111111' -prog.cob:12: error: literal length 23 exceeds 22 characters -prog.cob:12: error: invalid hexadecimal literal: '11111111111111111' -prog.cob:12: error: literal length 17 exceeds 16 characters -prog.cob:12: error: invalid hexadecimal literal: '22222222222222222' -prog.cob:12: error: literal length 17 exceeds 16 characters -prog.cob:14: error: invalid B# literal: '23' -prog.cob:14: error: literal contains invalid character '2' -prog.cob:14: error: literal contains invalid character '3' -prog.cob:14: error: invalid O# literal: '89' -prog.cob:14: error: literal contains invalid character '8' -prog.cob:14: error: literal contains invalid character '9' -prog.cob:14: error: invalid X# literal: 'GG' -prog.cob:14: error: literal contains invalid character 'G' -prog.cob:14: error: literal contains invalid character 'G' -prog.cob:14: error: invalid H# literal: 'HH' -prog.cob:14: error: literal contains invalid character 'H' -prog.cob:14: error: literal contains invalid character 'H' -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/syn_misc.at:3525" -$at_failed && at_fn_log_failure -$at_traceon; } - - -{ set +x -$as_echo "$at_srcdir/syn_misc.at:3548: \$COMPILE_ONLY -std=cobol2014 prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY -std=cobol2014 prog.cob" "syn_misc.at:3548" -( $at_check_trace; $COMPILE_ONLY -std=cobol2014 prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob:6: error: ACUCOBOL numeric literal does not conform to COBOL 2014 -prog.cob:6: error: ACUCOBOL numeric literal does not conform to COBOL 2014 -prog.cob:6: error: ACUCOBOL numeric literal does not conform to COBOL 2014 -prog.cob:6: error: ACUCOBOL numeric literal does not conform to COBOL 2014 -prog.cob:11: error: ACUCOBOL numeric literal does not conform to COBOL 2014 -prog.cob:12: error: ACUCOBOL numeric literal does not conform to COBOL 2014 -prog.cob:12: error: ACUCOBOL numeric literal does not conform to COBOL 2014 -prog.cob:12: error: ACUCOBOL numeric literal does not conform to COBOL 2014 -prog.cob:14: error: ACUCOBOL numeric literal does not conform to COBOL 2014 -prog.cob:14: error: ACUCOBOL numeric literal does not conform to COBOL 2014 -prog.cob:14: error: ACUCOBOL numeric literal does not conform to COBOL 2014 -prog.cob:14: error: ACUCOBOL numeric literal does not conform to COBOL 2014 -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/syn_misc.at:3548" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_267 -#AT_START_268 -at_fn_group_banner 268 'syn_misc.at:3566' \ - "ACUCOBOL 32bit literal size" " " 2 -at_xfail=no -( - $as_echo "268. $at_setup_line: testing $at_desc ..." - $at_traceon - -# ACUCOBOL literal max - the result is system dependent on size of unsigned long int -$as_echo "syn_misc.at:3568" >"$at_check_line_file" -at_fn_check_skip 77 "$at_srcdir/syn_misc.at:3568" - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - PROCEDURE DIVISION. - - >>SOURCE FREE - DISPLAY B#1111111111111111111111111111111111111111111111111111111111111111 - O#1111111111111111111111 X#1111111111111111 - - STOP RUN. -_ATEOF - - -#AT_CHECK([$COMPILE_ONLY -std=acu prog.cob], [0], [], []) -# TODO check the result according to COB_32_BIT_LONG --> 1 should result in the following -{ set +x -$as_echo "$at_srcdir/syn_misc.at:3586: \$COMPILE_ONLY -std=acu prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY -std=acu prog.cob" "syn_misc.at:3586" -( $at_check_trace; $COMPILE_ONLY -std=acu prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob:7: error: invalid B# literal: '11111111111111111111111111111111111...' -prog.cob:7: error: literal exceeds limit 4294967295 -prog.cob:8: error: invalid O# literal: '1111111111111111111111' -prog.cob:8: error: literal exceeds limit 4294967295 -prog.cob:8: error: invalid X# literal: '1111111111111111' -prog.cob:8: error: literal exceeds limit 4294967295 -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/syn_misc.at:3586" -$at_failed && at_fn_log_failure -$at_traceon; } - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_268 -#AT_START_269 -at_fn_group_banner 269 'syn_misc.at:3597' \ - "ACUCOBOL USAGE FLOAT / DOUBLE" " " 2 -at_xfail=no -( - $as_echo "269. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 77 myfloat usage float - value is 3.97E+24. - 77 mydouble usage double - value is 3.97E+44. - PROCEDURE DIVISION. - MAIN. - * - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/syn_misc.at:3615: \$COMPILE_ONLY -std=acu-strict prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY -std=acu-strict prog.cob" "syn_misc.at:3615" -( $at_check_trace; $COMPILE_ONLY -std=acu-strict prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/syn_misc.at:3615" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/syn_misc.at:3616: \$COMPILE_ONLY prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY prog.cob" "syn_misc.at:3616" -( $at_check_trace; $COMPILE_ONLY prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/syn_misc.at:3616" -$at_failed && at_fn_log_failure -$at_traceon; } - - -{ set +x -$as_echo "$at_srcdir/syn_misc.at:3618: \$COMPILE_ONLY -std=mf-strict prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY -std=mf-strict prog.cob" "syn_misc.at:3618" -( $at_check_trace; $COMPILE_ONLY -std=mf-strict prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob:6: error: 'float' is not defined, but is a reserved word in another dialect -prog.cob:8: error: 'double' is not defined, but is a reserved word in another dialect -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/syn_misc.at:3618" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_269 -#AT_START_270 -at_fn_group_banner 270 'syn_misc.at:3626' \ - "ACUCOBOL USAGE HANDLE" " " 2 -at_xfail=no -( - $as_echo "270. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -# TODO: need a better test here -# TODO: maybe add a compiler support configuration to provide better messages - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 78 listdir-open value 1. - 78 listdir-next value 2. - 78 listdir-close value 3. - 77 pattern pic x(5) value "*.cob". - 77 directory pic x(5) value ".". - 77 filename pic x(256). - 77 mydir usage handle. - - 77 mythread usage handle of thread. - 77 unused-thread handle thread. - - 77 mywindow usage handle of window. - - 77 nor-a-handle usage handle bananas. - 77 neither-a-handle usage handle of apes. - 77 control-handle usage handle of label. - - PROCEDURE DIVISION. - MAIN. - * Call LISTDIR-OPEN to get a directory handle. - call "C$LIST-DIRECTORY" - using listdir-open, directory, pattern. - move return-code to mydir. - * Call LISTDIR-NEXT to get the names of the files. - * Repeat this operation until a filename containing only - * spaces is returned. The filenames are not necessarily - * returned in any particular order. Filenames may be - * sorted on some machines and not on others. - perform thread with test after until filename = spaces - handle in mywindow - call "C$LIST-DIRECTORY" - using listdir-next, mydir, filename - end-perform. - stop thread mywindow - * Call LISTDIR-CLOSE to close the directory and deallocate - * memory. Omitting this call will result in memory leaks. - call "C$LIST-DIRECTORY" using listdir-close, mydir. - * - CALL IN THREAD 'NOTHERE' - HANDLE IN mywindow - USING 'STUFF' - NOT ON EXCEPTION DISPLAY 'called in THREAD' - END-CALL - * - * Just to check that the handles are still recognized and usable: - destroy neither-a-handle, control-handle - * - * check for invalid use - add neither-a-handle to control-handle - compute mywindow = 0 - string mydir delimited by size into filename - * - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/syn_misc.at:3692: \$COMPILE_ONLY -std=acu-strict prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY -std=acu-strict prog.cob" "syn_misc.at:3692" -( $at_check_trace; $COMPILE_ONLY -std=acu-strict prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob:19: error: unknown HANDLE type: bananas -prog.cob:20: error: unknown HANDLE type: apes -prog.cob:21: warning: HANDLE OF control-type is not implemented -prog.cob: in paragraph 'MAIN': -prog.cob:34: warning: THREAD is not implemented -prog.cob:36: warning: THREAD is not implemented -prog.cob:35: error: HANDLE must be either a generic or a THREAD HANDLE -prog.cob:39: error: HANDLE must be either a generic or a THREAD HANDLE -prog.cob:39: warning: STOP THREAD is replaced by STOP RUN -prog.cob:44: warning: THREAD is not implemented -prog.cob:46: warning: THREAD is not implemented -prog.cob:45: error: HANDLE must be either a generic or a THREAD HANDLE -prog.cob:51: warning: GRAPHICAL CONTROL is not implemented -prog.cob:54: error: HANDLE item not allowed here: 'neither-a-handle' -prog.cob:55: error: HANDLE item not allowed here: 'mywindow' -prog.cob:56: error: HANDLE item not allowed here: 'mydir' -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/syn_misc.at:3692" -$at_failed && at_fn_log_failure -$at_traceon; } - - -{ set +x -$as_echo "$at_srcdir/syn_misc.at:3711: \$COMPILE_ONLY -std=rm-strict prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY -std=rm-strict prog.cob" "syn_misc.at:3711" -( $at_check_trace; $COMPILE_ONLY -std=rm-strict prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob:12: error: 'handle' is not defined, but is a reserved word in another dialect -prog.cob:14: error: 'handle' is not defined, but is a reserved word in another dialect -prog.cob:15: error: syntax error, unexpected Identifier -prog.cob:17: error: 'handle' is not defined, but is a reserved word in another dialect -prog.cob:19: error: 'handle' is not defined, but is a reserved word in another dialect -prog.cob:20: error: 'handle' is not defined, but is a reserved word in another dialect -prog.cob:21: error: 'handle' is not defined, but is a reserved word in another dialect -prog.cob:15: error: PICTURE clause required for 'unused-thread' -prog.cob: in paragraph 'MAIN': -prog.cob:35: error: 'handle IN mywindow' is not defined -prog.cob:34: error: invalid expression -prog.cob:38: error: syntax error, unexpected END-PERFORM -prog.cob:39: error: 'thread' is not defined, but is a reserved word in another dialect -prog.cob:39: error: syntax error, unexpected Identifier -prog.cob:44: error: syntax error, unexpected Identifier, expecting THREAD -prog.cob:48: error: syntax error, unexpected END-CALL -prog.cob:51: error: syntax error, unexpected Identifier -prog.cob:34: error: 'thread' is not defined, but is a reserved word in another dialect -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/syn_misc.at:3711" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_270 -#AT_START_271 -at_fn_group_banner 271 'syn_misc.at:3735' \ - "ACUCOBOL WINDOW statements" " " 2 -at_xfail=no -( - $as_echo "271. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -# TODO: need a better tests when we implement this, -# likely split into multiple ones - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 77 myhandle usage handle. - 77 mythread usage handle of thread. - 77 WINDOW-HANDLE usage handle of window. - PROCEDURE DIVISION. - MAIN. - DISPLAY WINDOW, LINE 1, COLUMN 29, SIZE 51, LINES 12, - ERASE SCREEN BOXED SHADOW, POP-UP AREA IS WINDOW-HANDLE - END-DISPLAY - DISPLAY "THIS IS TEXT IN A WINDOW" - DISPLAY FLOATING WINDOW UPON WINDOW-HANDLE, - LINE 5, COLUMN 10, SIZE 20, LINES 2, - ERASE SCREEN, POP-UP AREA IS myhandle - END-DISPLAY - DISPLAY "Some text for the floating window" - ACCEPT OMITTED - CLOSE WINDOW myhandle - DISPLAY FLOATING WINDOW, - LINE 5, COLUMN 10, SIZE 20, LINES 2, - ERASE SCREEN, POP-UP AREA mythread - END-DISPLAY - ACCEPT OMITTED - DESTROY WINDOW-HANDLE - DISPLAY WINDOW AT 1020 SIZE 36 LINES 15 BOXED - FOREGROUND-COLOR IS 7 - BACKGROUND-COLOR IS 0 - TOP CENTERED TITLE IS 'SOME TITLE' - pop-up area = WINDOW-HANDLE. - DISPLAY SUBWINDOW UPON WINDOW-HANDLE SHADOW - AT 0505 SIZE 25 LINES 10 - BOTTOM LEFT TITLE = 'buttom left' - BACKGROUND-COLOR IS 10 - FOREGROUND-COLOR IS 5. - DISPLAY WINDOW UPON WINDOW-HANDLE SHADOW - AT 0808 SIZE 18 LINES 5 - RIGHT TITLE 'top right' - BACKGROUND-COLOR 1 - FOREGROUND-COLOR 14. - ACCEPT OMITTED - DESTROY WINDOW-HANDLE - * - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/syn_misc.at:3789: \$COMPILE_ONLY -std=acu-strict prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY -std=acu-strict prog.cob" "syn_misc.at:3789" -( $at_check_trace; $COMPILE_ONLY -std=acu-strict prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob: in paragraph 'MAIN': -prog.cob:11: warning: GRAPHICAL WINDOW is not implemented -prog.cob:15: warning: GRAPHICAL WINDOW is not implemented -prog.cob:21: warning: GRAPHICAL WINDOW is not implemented -prog.cob:22: warning: GRAPHICAL WINDOW is not implemented -prog.cob:24: error: HANDLE must be either a generic or a WINDOW HANDLE or X(10) -prog.cob:27: warning: GRAPHICAL CONTROL is not implemented -prog.cob:28: warning: GRAPHICAL WINDOW is not implemented -prog.cob:33: warning: GRAPHICAL WINDOW is not implemented -prog.cob:38: warning: GRAPHICAL WINDOW is not implemented -prog.cob:44: warning: GRAPHICAL CONTROL is not implemented -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/syn_misc.at:3789" -$at_failed && at_fn_log_failure -$at_traceon; } - - -{ set +x -$as_echo "$at_srcdir/syn_misc.at:3803: \$COMPILE_ONLY prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY prog.cob" "syn_misc.at:3803" -( $at_check_trace; $COMPILE_ONLY prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob: in paragraph 'MAIN': -prog.cob:11: warning: GRAPHICAL WINDOW is not implemented -prog.cob:15: warning: GRAPHICAL WINDOW is not implemented -prog.cob:21: warning: GRAPHICAL WINDOW is not implemented -prog.cob:22: warning: GRAPHICAL WINDOW is not implemented -prog.cob:24: error: HANDLE must be either a generic or a WINDOW HANDLE or X(10) -prog.cob:27: warning: GRAPHICAL CONTROL is not implemented -prog.cob:28: warning: GRAPHICAL WINDOW is not implemented -prog.cob:33: warning: GRAPHICAL WINDOW is not implemented -prog.cob:38: warning: GRAPHICAL WINDOW is not implemented -prog.cob:44: warning: GRAPHICAL CONTROL is not implemented -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/syn_misc.at:3803" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_271 -#AT_START_272 -at_fn_group_banner 272 'syn_misc.at:3820' \ - "ACUCOBOL GRAPHICAL controls" " " 2 -at_xfail=no -( - $as_echo "272. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -# TODO: need a better tests when we implement this, -# likely split into multiple ones - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 77 window-handle USAGE HANDLE OF WINDOW. - 77 lb-row PIC X(10). - 77 lb-color PIC 9(05) VALUE 8192. - 77 lb-num-lines PIC 9(02) VALUE 20. - 77 lb-num-rows PIC 9(02) VALUE 11. - 77 window-lines PIC 9(02) VALUE 22. - 77 window-rows PIC 9(02) VALUE 13. - 77 selection-idx PIC S9(02). - SCREEN SECTION. - 01 lb-screen. - 03 lb-frm LIST-BOX 3-D - * FIXME: the following should be possible in any order - UNSORTED - EXCEPTION-VALUE = 13 - COLOR lb-color - CLINE 1 CCOL 1 - LINES = lb-num-lines - SIZE IS lb-num-rows - * VALUE lb-row raises error as no identifer according - * to cobol2002, but here it is fine - . - PROCEDURE DIVISION. - MAIN. - MODIFY lb-frm ITEM-TO-ADD = 'Row 1' - MODIFY lb-frm ITEM-TO-ADD = 'Row 2' - MODIFY lb-frm ITEM-TO-ADD = 'Row 3' - MODIFY lb-frm ITEM-TO-ADD = 'Row 4' - MODIFY lb-frm ITEM-TO-ADD = 'Row 5' - MODIFY lb-frm ITEM-TO-ADD = 'Row 6' - MODIFY lb-frm ITEM-TO-ADD = 'Row 7' - DISPLAY FLOATING WINDOW - LINE 5 COL 5 - LINES window-lines - SIZE window-rows - BOXED - COLOR lb-color - HANDLE IS window-handle - END-DISPLAY - DISPLAY lb-screen - ACCEPT lb-screen - IF lb-row = SPACES - INQUIRE lb-frm SELECTION-INDEX IN selection-idx - IF selection-idx > ZERO - MODIFY lb-frm QUERY-INDEX = selection-idx - INQUIRE lb-frm ITEM-VALUE IN lb-row - END-IF - END-IF - CLOSE WINDOW window-handle - DISPLAY "chosen row value was '" lb-row "'" - ACCEPT OMITTED - * - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/syn_misc.at:3885: \$COMPILE_ONLY -std=acu-strict prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY -std=acu-strict prog.cob" "syn_misc.at:3885" -( $at_check_trace; $COMPILE_ONLY -std=acu-strict prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob:16: warning: GRAPHICAL CONTROL is not implemented -prog.cob:21: warning: COLOR clause is not implemented -prog.cob:23: warning: LINES clause is not implemented -prog.cob:26: warning: screen positions from data-item is not implemented -prog.cob: in paragraph 'MAIN': -prog.cob:36: warning: GRAPHICAL WINDOW is not implemented -prog.cob:42: warning: COLOR is not implemented -prog.cob:53: warning: GRAPHICAL WINDOW is not implemented -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/syn_misc.at:3885" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_272 -#AT_START_273 -at_fn_group_banner 273 'syn_misc.at:3899' \ - "DISPLAY MESSAGE BOX" " " 2 -at_xfail=no -( - $as_echo "273. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 77 my-text pic x(10) value "TEXT". - 78 MB-OK VALUE 1. - 78 MB-YES-NO VALUE 2. - 78 MB-OK-CANCEL VALUE 3. - 78 MB-YES-NO-CANCEL VALUE 4. - 78 MB-YES VALUE 1. - 78 MB-NO VALUE 2. - 78 MB-CANCEL VALUE 3. - 78 MB-DEFAULT-ICON VALUE 1. - 78 MB-WARNING-ICON VALUE 2. - 78 MB-ERROR-ICON VALUE 3. - PROCEDURE DIVISION. - DISPLAY MESSAGE "Important" - TITLE "Very important" - TYPE = MB-OK - ICON IS MB-WARNING-ICON - DISPLAY MESSAGE "This is" space "my" space my-text - DISPLAY MESSAGE BOX "More messages?" - TYPE MB-YES-NO - TITLE = "box title" - DEFAULT IS MB-YES - RETURNING RETURN-CODE - * - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/syn_misc.at:3933: \$COMPILE_ONLY -std=acu-strict prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY -std=acu-strict prog.cob" "syn_misc.at:3933" -( $at_check_trace; $COMPILE_ONLY -std=acu-strict prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob:18: warning: handling of DISPLAY MESSAGE is unfinished; implementation is likely to be changed -prog.cob:22: warning: handling of DISPLAY MESSAGE is unfinished; implementation is likely to be changed -prog.cob:23: warning: handling of DISPLAY MESSAGE is unfinished; implementation is likely to be changed -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/syn_misc.at:3933" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_273 -#AT_START_274 -at_fn_group_banner 274 'syn_misc.at:3942' \ - "DISPLAY OMITTED" " " 2 -at_xfail=no -( - $as_echo "274. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - PROCEDURE DIVISION. - DISPLAY OMITTED WITH BELL - DISPLAY OMITTED LINE 10 COL 15 ERASE EOL - * - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/syn_misc.at:3955: \$COMPILE_ONLY prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY prog.cob" "syn_misc.at:3955" -( $at_check_trace; $COMPILE_ONLY prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob:5: warning: handling of DISPLAY OMITTED is unfinished; implementation is likely to be changed -prog.cob:6: warning: handling of DISPLAY OMITTED is unfinished; implementation is likely to be changed -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/syn_misc.at:3955" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_274 -#AT_START_275 -at_fn_group_banner 275 'syn_misc.at:3963' \ - "CGI: EXTERNAL-FORM" " " 2 -at_xfail=no -( - $as_echo "275. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -# TODO: need a better tests when we implement this, -# likely split into multiple ones - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 GNUCOBOL-URL IS EXTERNAL-FORM - IDENTIFIED BY "http://www.gnu.org/software/gnucobol/". - 01 WEB-PAGE-1 EXTERNAL-FORM, - IDENTIFIED "cgipage1". - 01 SIMPLE-FORM IS EXTERNAL-FORM. - 03 SIMPLE-FORM-VAR1 PIC X(10). - 03 SIMPLE-FORM-VAR2 PIC 9(5). - 01 MY-FORM EXTERNAL-FORM. - 03 CGI-VAR1 PIC X(20) IDENTIFIED "Name". - 03 CGI-VAR2 PIC X(50) IDENTIFIED BY CGI-VAR1. - - PROCEDURE DIVISION. - MAIN. - *> CGI display of static content (full URL) - DISPLAY GNUCOBOL-URL - *> CGI display of static content (current URL + "cgipage1" + ".html") - DISPLAY WEB-PAGE-1 - *> CGI display of output form - DISPLAY MY-FORM - *> CGI display of input form (docs say: used for debugging purposes) - DISPLAY SIMPLE-FORM - *> CGI accept - ACCEPT SIMPLE-FORM - *> normal accept - ACCEPT SIMPLE-FORM-VAR1 - *> CGI accept with first var (with cgi identifier Name) - *> setting the cgi identifier of the second - ACCEPT MY-FORM - * - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/syn_misc.at:4006: \$COMPILE_ONLY -std=acu-strict prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY -std=acu-strict prog.cob" "syn_misc.at:4006" -( $at_check_trace; $COMPILE_ONLY -std=acu-strict prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob:6: warning: EXTERNAL-FORM is not implemented -prog.cob:8: warning: EXTERNAL-FORM is not implemented -prog.cob:10: warning: EXTERNAL-FORM is not implemented -prog.cob:13: warning: EXTERNAL-FORM is not implemented -prog.cob:14: warning: EXTERNAL-FORM (IDENTIFIED BY) is not implemented -prog.cob:15: warning: EXTERNAL-FORM (IDENTIFIED BY) is not implemented -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/syn_misc.at:4006" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_275 -#AT_START_276 -at_fn_group_banner 276 'syn_misc.at:4018' \ - "adding/removing reserved words" " " 2 -at_xfail=no -( - $as_echo "276. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 hello PIC X. - 01 foo PIC X. - 01 bars PIC X. - 01 file PIC X. - 01 background-color PIC X. - - PROCEDURE DIVISION. - CONTINUE - . -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/syn_misc.at:4038: \$COMPILE_ONLY -freserved=hello,foo,bars,background-color -fnot-reserved=file prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY -freserved=hello,foo,bars,background-color -fnot-reserved=file prog.cob" "syn_misc.at:4038" -( $at_check_trace; $COMPILE_ONLY -freserved=hello,foo,bars,background-color -fnot-reserved=file prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob:7: error: 'hello' is a reserved word, but isn't supported -prog.cob:8: error: 'foo' is a reserved word, but isn't supported -prog.cob:9: error: 'bars' is a reserved word, but isn't supported -prog.cob:11: error: syntax error, unexpected BACKGROUND-COLOR -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/syn_misc.at:4038" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/syn_misc.at:4044: \$COMPILE_ONLY -fnot-reserved=file prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY -fnot-reserved=file prog.cob" "syn_misc.at:4044" -( $at_check_trace; $COMPILE_ONLY -fnot-reserved=file prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/syn_misc.at:4044" -$at_failed && at_fn_log_failure -$at_traceon; } - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_276 -#AT_START_277 -at_fn_group_banner 277 'syn_misc.at:4048' \ - "adding aliases" " " 2 -at_xfail=no -( - $as_echo "277. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - - PROCEDURE DIVISION. - FOO "Hello, world!" - . -_ATEOF - - -# FIXME: user defined words need to store a reference to the name originally defining the word -# otherwise we can't help the user to know where the error came from -# (command line is only a special case, but even then it may be wrapped and not visible -# to the user) -#AT_CHECK([$COMPILE_ONLY -freserved=FOO=DISPLAY* -freserved=BARS:FOO prog.cob], [1], [], -#[configuration warning: -freserved=FOO=DISPLAY*: ignored asterisk at end of alias target -#configuration error: -#-freserved=BARS:FOO: alias target 'FOO' is not a default reserved word -#]) - -{ set +x -$as_echo "$at_srcdir/syn_misc.at:4070: \$COMPILE_ONLY -freserved=FOO=DISPLAY* -freserved=BARS:FOO prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY -freserved=FOO=DISPLAY* -freserved=BARS:FOO prog.cob" "syn_misc.at:4070" -( $at_check_trace; $COMPILE_ONLY -freserved=FOO=DISPLAY* -freserved=BARS:FOO prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "configuration warning: -freserved=FOO=DISPLAY*: ignored asterisk at end of alias target -configuration error: -alias target 'FOO' is not a default reserved word -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/syn_misc.at:4070" -$at_failed && at_fn_log_failure -$at_traceon; } - - -{ set +x -$as_echo "$at_srcdir/syn_misc.at:4076: \$COMPILE_ONLY -freserved=FOO=DISPLAY prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY -freserved=FOO=DISPLAY prog.cob" "syn_misc.at:4076" -( $at_check_trace; $COMPILE_ONLY -freserved=FOO=DISPLAY prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/syn_misc.at:4076" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/syn_misc.at:4077: \$COMPILE_ONLY -freserved=FOO:DISPLAY prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY -freserved=FOO:DISPLAY prog.cob" "syn_misc.at:4077" -( $at_check_trace; $COMPILE_ONLY -freserved=FOO:DISPLAY prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/syn_misc.at:4077" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/syn_misc.at:4078: \$COMPILE_ONLY -freserved=\" FOO = DISPLAY \" prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY -freserved=\" FOO = DISPLAY \" prog.cob" "syn_misc.at:4078" -( $at_check_trace; $COMPILE_ONLY -freserved=" FOO = DISPLAY " prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/syn_misc.at:4078" -$at_failed && at_fn_log_failure -$at_traceon; } - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_277 -#AT_START_278 -at_fn_group_banner 278 'syn_misc.at:4082' \ - "overriding default words" " " 2 -at_xfail=no -( - $as_echo "278. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - - PROCEDURE DIVISION. - COMP-1 "Hello, world!" - DISPLAY "Hello, world!". -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/syn_misc.at:4094: \$COMPILE_ONLY -freserved=COMP-1=DISPLAY prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY -freserved=COMP-1=DISPLAY prog.cob" "syn_misc.at:4094" -( $at_check_trace; $COMPILE_ONLY -freserved=COMP-1=DISPLAY prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/syn_misc.at:4094" -$at_failed && at_fn_log_failure -$at_traceon; } - - -cat >prog2.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog2. - - PROCEDURE DIVISION. - COMP-1 "Hello, world!". - DISPLAY "Hello, world!". -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/syn_misc.at:4105: \$COMPILE_ONLY -fnot-reserved=DISPLAY -freserved=COMP-1=DISPLAY prog2.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY -fnot-reserved=DISPLAY -freserved=COMP-1=DISPLAY prog2.cob" "syn_misc.at:4105" -( $at_check_trace; $COMPILE_ONLY -fnot-reserved=DISPLAY -freserved=COMP-1=DISPLAY prog2.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog2.cob:7: error: unknown statement 'DISPLAY'; it may exist in another dialect -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/syn_misc.at:4105" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_278 -#AT_START_279 -at_fn_group_banner 279 'syn_misc.at:4112' \ - "complete specified word list" " " 2 -at_xfail=no -( - $as_echo "279. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 SQLCA. - 03 SQLCABC USAGE BINARY-LONG VALUE 136. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/syn_misc.at:4124: \$COMPILE_ONLY -std=ibm-strict prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY -std=ibm-strict prog.cob" "syn_misc.at:4124" -( $at_check_trace; $COMPILE_ONLY -std=ibm-strict prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob:7: error: 'BINARY-LONG' is not defined, but is a reserved word in another dialect -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/syn_misc.at:4124" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/syn_misc.at:4127: \$COMPILE_ONLY -std=ibm-strict -freserved=BINARY-LONG prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY -std=ibm-strict -freserved=BINARY-LONG prog.cob" "syn_misc.at:4127" -( $at_check_trace; $COMPILE_ONLY -std=ibm-strict -freserved=BINARY-LONG prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/syn_misc.at:4127" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/syn_misc.at:4128: \$COMPILE_ONLY -std=ibm prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY -std=ibm prog.cob" "syn_misc.at:4128" -( $at_check_trace; $COMPILE_ONLY -std=ibm prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/syn_misc.at:4128" -$at_failed && at_fn_log_failure -$at_traceon; } - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_279 -#AT_START_280 -at_fn_group_banner 280 'syn_misc.at:4132' \ - "ANY LENGTH item as BY VALUE formal parameter" " " 2 -at_xfail=no -( - $as_echo "280. $at_setup_line: testing $at_desc ..." - $at_traceon - - -$as_echo "syn_misc.at:4134" >"$at_check_line_file" -at_fn_check_skip 77 "$at_srcdir/syn_misc.at:4134" - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - - DATA DIVISION. - LINKAGE SECTION. - 01 str ANY LENGTH PIC X. - - PROCEDURE DIVISION USING VALUE str. - GOBACK - . -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/syn_misc.at:4149: \$COMPILE_ONLY prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY prog.cob" "syn_misc.at:4149" -( $at_check_trace; $COMPILE_ONLY prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob:9: error: ANY LENGTH items may only be BY REFERENCE formal parameters -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/syn_misc.at:4149" -$at_failed && at_fn_log_failure -$at_traceon; } - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_280 -#AT_START_281 -at_fn_group_banner 281 'syn_misc.at:4155' \ - "swapped SOURCE- and OBJECT-COMPUTER" " " 2 -at_xfail=no -( - $as_echo "281. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - - ENVIRONMENT DIVISION. - CONFIGURATION SECTION. - OBJECT-COMPUTER. a. - SOURCE-COMPUTER. b. -_ATEOF - - -# MF extension, supported by GnuCOBOL -{ set +x -$as_echo "$at_srcdir/syn_misc.at:4169: \$COMPILE_ONLY prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY prog.cob" "syn_misc.at:4169" -( $at_check_trace; $COMPILE_ONLY prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/syn_misc.at:4169" -$at_failed && at_fn_log_failure -$at_traceon; } - -# note: testing with lax configuration, otherwise there would be an error -{ set +x -$as_echo "$at_srcdir/syn_misc.at:4171: \$COMPILE_ONLY -std=acu prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY -std=acu prog.cob" "syn_misc.at:4171" -( $at_check_trace; $COMPILE_ONLY -std=acu prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob:8: warning: SOURCE-COMPUTER incorrectly after OBJECT-COMPUTER used -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/syn_misc.at:4171" -$at_failed && at_fn_log_failure -$at_traceon; } - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_281 -#AT_START_282 -at_fn_group_banner 282 'syn_misc.at:4177' \ - "CONF. SECTION paragraphs in wrong order" " " 2 -at_xfail=no -( - $as_echo "282. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - - ENVIRONMENT DIVISION. - CONFIGURATION SECTION. - REPOSITORY. - SOURCE-COMPUTER. b. - OBJECT-COMPUTER. a. - SPECIAL-NAMES. - - END PROGRAM prog. - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog2. - - ENVIRONMENT DIVISION. - CONFIGURATION SECTION. - SOURCE-COMPUTER. b. - OBJECT-COMPUTER. a. - REPOSITORY. - SPECIAL-NAMES. - - END PROGRAM prog2. - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog3. - - ENVIRONMENT DIVISION. - CONFIGURATION SECTION. - REPOSITORY. - SOURCE-COMPUTER. b. - OBJECT-COMPUTER. a. - - END PROGRAM prog3. - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog4. - - ENVIRONMENT DIVISION. - CONFIGURATION SECTION. - REPOSITORY. - SPECIAL-NAMES. - SOURCE-COMPUTER. b. - OBJECT-COMPUTER. a. - - END PROGRAM prog4. -_ATEOF - - -# MF extension, supported by GnuCOBOL -{ set +x -$as_echo "$at_srcdir/syn_misc.at:4230: \$COMPILE_ONLY prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY prog.cob" "syn_misc.at:4230" -( $at_check_trace; $COMPILE_ONLY prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/syn_misc.at:4230" -$at_failed && at_fn_log_failure -$at_traceon; } - -# note: testing with lax configuration, otherwise there would be an error -{ set +x -$as_echo "$at_srcdir/syn_misc.at:4232: \$COMPILE_ONLY -std=acu prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY -std=acu prog.cob" "syn_misc.at:4232" -( $at_check_trace; $COMPILE_ONLY -std=acu prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob:8: warning: SOURCE-COMPUTER incorrectly after REPOSITORY used -prog.cob:22: warning: SPECIAL-NAMES incorrectly after REPOSITORY used -prog.cob:32: warning: SOURCE-COMPUTER incorrectly after REPOSITORY used -prog.cob:43: warning: SPECIAL-NAMES incorrectly after REPOSITORY used -prog.cob:44: warning: SOURCE-COMPUTER incorrectly after SPECIAL-NAMES used -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/syn_misc.at:4232" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/syn_misc.at:4239: \$COMPILE_ONLY -std=cobol2014 prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY -std=cobol2014 prog.cob" "syn_misc.at:4239" -( $at_check_trace; $COMPILE_ONLY -std=cobol2014 prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob:8: error: SOURCE-COMPUTER incorrectly after REPOSITORY used -prog.cob:22: error: SPECIAL-NAMES incorrectly after REPOSITORY used -prog.cob:32: error: SOURCE-COMPUTER incorrectly after REPOSITORY used -prog.cob:43: error: SPECIAL-NAMES incorrectly after REPOSITORY used -prog.cob:44: error: SOURCE-COMPUTER incorrectly after SPECIAL-NAMES used -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/syn_misc.at:4239" -$at_failed && at_fn_log_failure -$at_traceon; } - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_282 -#AT_START_283 -at_fn_group_banner 283 'syn_misc.at:4249' \ - "NOT ON EXCEPTION with STATIC CALL convention" " " 2 -at_xfail=no -( - $as_echo "283. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - PROCEDURE DIVISION. - CALL STATIC "stuff" - ON EXCEPTION - CONTINUE - END-CALL - GOBACK. -_ATEOF - - -cat >prog2.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog2. - PROCEDURE DIVISION. - CALL "stuff" - ON EXCEPTION - CONTINUE - END-CALL - GOBACK. -_ATEOF - - -cat >prog3.cob <<'_ATEOF' - - >> CALL-CONVENTION STATIC - IDENTIFICATION DIVISION. - PROGRAM-ID. prog3. - PROCEDURE DIVISION. - CALL "stuff" - ON EXCEPTION - CONTINUE - END-CALL - GOBACK. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/syn_misc.at:4286: \$COMPILE_ONLY prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY prog.cob" "syn_misc.at:4286" -( $at_check_trace; $COMPILE_ONLY prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob:5: warning: ON EXCEPTION ignored because of STATIC CALL -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/syn_misc.at:4286" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/syn_misc.at:4289: \$COMPILE_ONLY prog2.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY prog2.cob" "syn_misc.at:4289" -( $at_check_trace; $COMPILE_ONLY prog2.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/syn_misc.at:4289" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/syn_misc.at:4290: \$COMPILE_ONLY -fstatic-call prog2.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY -fstatic-call prog2.cob" "syn_misc.at:4290" -( $at_check_trace; $COMPILE_ONLY -fstatic-call prog2.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/syn_misc.at:4290" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/syn_misc.at:4291: \$COMPILE_ONLY prog3.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY prog3.cob" "syn_misc.at:4291" -( $at_check_trace; $COMPILE_ONLY prog3.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog3.cob:6: warning: STATIC CALL convention ignored because of ON EXCEPTION -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/syn_misc.at:4291" -$at_failed && at_fn_log_failure -$at_traceon; } - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_283 -#AT_START_284 -at_fn_group_banner 284 'syn_misc.at:4297' \ - "NOT ON EXCEPTION phrases before ON EXCEPTION" " " 2 -at_xfail=no -( - $as_echo "284. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - - ENVIRONMENT DIVISION. - INPUT-OUTPUT SECTION. - FILE-CONTROL. - SELECT f ASSIGN "f.txt" - ORGANIZATION LINE SEQUENTIAL. - - DATA DIVISION. - FILE SECTION. - FD f LINAGE 10. - 01 f-rec PIC X. - - PROCEDURE DIVISION. - WRITE f-rec FROM "x" - NOT END-OF-PAGE - CONTINUE - END-OF-PAGE - CONTINUE - END-WRITE - WRITE f-rec FROM "x" - END-OF-PAGE - CONTINUE - NOT END-OF-PAGE - CONTINUE - END-WRITE - WRITE f-rec FROM "x" - NOT END-OF-PAGE - CONTINUE - END-WRITE - WRITE f-rec FROM "x" - END-OF-PAGE - CONTINUE - END-WRITE - - DISPLAY "blah" - ON EXCEPTION - CALL "err" - NOT ON EXCEPTION - CONTINUE - ON EXCEPTION - CONTINUE. - DISPLAY "blah" - NOT ON EXCEPTION - CALL "err" - ON EXCEPTION - CONTINUE - NOT ON EXCEPTION - CONTINUE. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/syn_misc.at:4353: \$COMPILE_ONLY -std=cobol85 prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY -std=cobol85 prog.cob" "syn_misc.at:4353" -( $at_check_trace; $COMPILE_ONLY -std=cobol85 prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob:22: error: NOT AT END-OF-PAGE before AT END-OF-PAGE does not conform to COBOL 85 -prog.cob:44: error: NOT EXCEPTION before EXCEPTION does not conform to COBOL 85 -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/syn_misc.at:4353" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/syn_misc.at:4357: \$COMPILE_ONLY prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY prog.cob" "syn_misc.at:4357" -( $at_check_trace; $COMPILE_ONLY prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/syn_misc.at:4357" -$at_failed && at_fn_log_failure -$at_traceon; } - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_284 -#AT_START_285 -at_fn_group_banner 285 'syn_misc.at:4361' \ - "wrong dialect hints" " " 2 -at_xfail=no -( - $as_echo "285. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 x PIC X. - - PROCEDURE DIVISION. - DISPLAY x CONVERSION. - TRANSFORM x - . -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/syn_misc.at:4378: \$COMPILE_ONLY -std=cobol85 prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY -std=cobol85 prog.cob" "syn_misc.at:4378" -( $at_check_trace; $COMPILE_ONLY -std=cobol85 prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob:10: error: 'CONVERSION' is not defined, but is a reserved word in another dialect -prog.cob:11: error: unknown statement 'TRANSFORM'; it may exist in another dialect -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/syn_misc.at:4378" -$at_failed && at_fn_log_failure -$at_traceon; } - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_285 -#AT_START_286 -at_fn_group_banner 286 'syn_misc.at:4385' \ - "redundant periods" " " 2 -at_xfail=no -( - $as_echo "286. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >a.cpy <<'_ATEOF' - - 01 var PIC X -_ATEOF - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - - DATA DIVISION. - WORKING-STORAGE SECTION. - REPLACE ==a== BY ==b==.. *> blah blah - . - - COPY a.. - - 78 var VALUE "hello". - * blah blah - . -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/syn_misc.at:4408: \$COMPILE_ONLY prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY prog.cob" "syn_misc.at:4408" -( $at_check_trace; $COMPILE_ONLY prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob:6: warning: ignoring redundant . -prog.cob:12: warning: ignoring redundant . -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/syn_misc.at:4408" -$at_failed && at_fn_log_failure -$at_traceon; } - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_286 -#AT_START_287 -at_fn_group_banner 287 'syn_misc.at:4415' \ - "IF-ELSE statement list with invalid syntax" " " 2 -at_xfail=no -( - $as_echo "287. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 a-variable PIC 9. - - PROCEDURE DIVISION. - IF a-variable = 1 - ACCEPT a-variable, not-a-variable - ON EXCEPTION - CONTINUE - END-ACCEPT - ELSE - CONTINUE - END-IF - . -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/syn_misc.at:4438: \$COMPILE_ONLY prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY prog.cob" "syn_misc.at:4438" -( $at_check_trace; $COMPILE_ONLY prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob:11: error: syntax error, unexpected Identifier -prog.cob:14: error: syntax error, unexpected END-ACCEPT -prog.cob:15: error: syntax error, unexpected ELSE -prog.cob:17: error: syntax error, unexpected END-IF -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/syn_misc.at:4438" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_287 -#AT_START_288 -at_fn_group_banner 288 'syn_misc.at:4448' \ - "EVALUATE statement with invalid syntax" " " 2 -at_xfail=no -( - $as_echo "288. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 a-variable PIC 9. - - PROCEDURE DIVISION. - EVALUATE a-variable - - ALSO true - - WHEN 1 - - ALSO a-variable - CONTINUE - - WHEN 1 OR 2 - CONTINUE - - END-EVALUATE - . - EVALUATE a-variable - - ALSO true - - WHEN 3 - CONTINUE - - WHEN 5 - CONTINUE - - END-EVALUATE - . -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/syn_misc.at:4488: \$COMPILE_ONLY prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY prog.cob" "syn_misc.at:4488" -( $at_check_trace; $COMPILE_ONLY prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob:19: error: invalid conditional expression -prog.cob:16: error: invalid expression -prog.cob:28: error: wrong number of WHEN parameters -prog.cob:31: error: wrong number of WHEN parameters -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/syn_misc.at:4488" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_288 -#AT_START_289 -at_fn_group_banner 289 'syn_misc.at:4498' \ - "MF reserved word directives" " " 2 -at_xfail=no -( - $as_echo "289. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - - *> Valid - $SET ADDRSV"DOG""CAT" - - *> Valid - $SET ADD-SYN "VALUE" = "VA" - *> Bread is not reserved. - $SET ADDSYN "BREAD" = "BARA" - *> ID is already reserved - $SET ADDSYN "IDENTIFICATION" = "ID" - - *> Valid - $SET MAKESYN(PROGRAM) = (FUNCTION) - *> BREAD is not reserved. - $SET MAKESYN "BREAD" = "PROGRAM" - $SET MAKESYN "PROGRAM" = "BREAD" - - *> Valid - $SET OVERRIDE "DIVISION" = "DIV" "JUST" = "JS" - *> Bread is not reserved - $SET OVERRIDE "BREAD"="BARA" - *> ID is already reserved - $SET OVERRIDE "IDENTIFICATION"="ID" - - *> Valid - $SET REMOVE "BREAD" (BARA)REMOVE(DOG) - - DATA DIV. - WORKING-STORAGE SECTION. - *> Check ADDSYN and OVERRIDE work correctly - 01 just PIC XX VA "1" JS. - *> Check ADDRSV - 01 cat PIC 9 VA 1. - *> Check REMOVE - 01 dog PIC 9 VA 1. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/syn_misc.at:4541: \$COMPILE_ONLY prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY prog.cob" "syn_misc.at:4541" -( $at_check_trace; $COMPILE_ONLY prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob:11: error: 'BREAD' is not a default reserved word, so cannot be aliased -prog.cob:13: error: 'ID' is already reserved; you may want MAKESYN instead -prog.cob:18: error: 'BREAD' is not a default reserved word, so cannot be aliased -prog.cob:19: error: 'BREAD' is not a reserved word; you may want ADDSYN or OVERRIDE instead -prog.cob:24: error: 'BREAD' is not a default reserved word, so cannot be aliased -prog.cob:26: error: 'ID' is already reserved; you may want MAKESYN instead -prog.cob:36: error: 'cat' is a reserved word, but isn't supported -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/syn_misc.at:4541" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_289 -#AT_START_290 -at_fn_group_banner 290 'syn_misc.at:4554' \ - "STRING / UNSTRING with invalid syntax" " " 2 -at_xfail=no -( - $as_echo "290. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - - DATA DIVISION. - WORKING-STORAGE SECTION. - 77 a PIC X. - 77 b PIC X. - 77 c PIC XXX. - - PROCEDURE DIVISION. - STRING DELIMITED BY SPACE INTO - END-STRING - STRING a DELIMITED BY SPACE c - END-STRING - STRING a DELIMITED BY SPACE INTO - END-STRING - STRING - DELIMITED BY SPACE - INTO c - END-STRING - STRING a DELIMITED BY SPACE - - DELIMITED BY SIZE - INTO c - END-STRING - STRING a DELIMITED BY SPACE - b DELIMITED BY SIZE - INTO c - END-STRING - * - UNSTRING DELIMITED BY SPACE INTO a - END-UNSTRING - UNSTRING c DELIMITED BY SPACE a - END-UNSTRING - UNSTRING c DELIMITED BY SPACE INTO - END-UNSTRING - UNSTRING DELIMITED BY SPACE INTO a - END-UNSTRING - UNSTRING c DELIMITED BY SPACE INTO a - END-UNSTRING - UNSTRING c DELIMITED BY SPACE - DELIMITED BY SIZE INTO a - END-UNSTRING - . -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/syn_misc.at:4604: \$COMPILE_ONLY prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY prog.cob" "syn_misc.at:4604" -( $at_check_trace; $COMPILE_ONLY prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob:12: error: syntax error, unexpected DELIMITED -prog.cob:15: error: syntax error, unexpected END-STRING, expecting INTO -prog.cob:17: error: syntax error, unexpected END-STRING, expecting Identifier -prog.cob:19: error: syntax error, unexpected DELIMITED -prog.cob:24: error: syntax error, unexpected DELIMITED, expecting INTO -prog.cob:32: error: syntax error, unexpected DELIMITED -prog.cob:34: error: syntax error, unexpected Identifier, expecting INTO -prog.cob:37: error: syntax error, unexpected END-UNSTRING, expecting Identifier -prog.cob:38: error: syntax error, unexpected DELIMITED -prog.cob:43: error: syntax error, unexpected DELIMITED, expecting INTO -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/syn_misc.at:4604" -$at_failed && at_fn_log_failure -$at_traceon; } - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_290 -#AT_START_291 -at_fn_group_banner 291 'syn_misc.at:4619' \ - "use of program-prototypes" " " 2 -at_xfail=no -( - $as_echo "291. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - - ENVIRONMENT DIVISION. - CONFIGURATION SECTION. - REPOSITORY. - PROGRAM test-prog - . - PROCEDURE DIVISION. - CALL test-prog - CANCEL test-prog - . -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/syn_misc.at:4637: \$COMPILE_ONLY -fprogram-prototypes=warning prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY -fprogram-prototypes=warning prog.cob" "syn_misc.at:4637" -( $at_check_trace; $COMPILE_ONLY -fprogram-prototypes=warning prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob:9: warning: PROGRAM phrase used -prog.cob:8: warning: no definition/prototype seen for PROGRAM 'test-prog' -prog.cob:11: warning: CALL/CANCEL with program-prototype-name used -prog.cob:12: warning: CALL/CANCEL with program-prototype-name used -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/syn_misc.at:4637" -$at_failed && at_fn_log_failure -$at_traceon; } - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_291 -#AT_START_292 -at_fn_group_banner 292 'syn_misc.at:4646' \ - "invalid INSPECT/TRANSFORM operands" " " 2 -at_xfail=no -( - $as_echo "292. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - - ENVIRONMENT DIVISION. - INPUT-OUTPUT SECTION. - FILE-CONTROL. - SELECT f ASSIGN "A". - - DATA DIVISION. - FILE SECTION. - FD f. - 01 f-rec PIC X. - - WORKING-STORAGE SECTION. - 01 not-display PIC 9(5) COMP. - 01 not-a-num PIC X(5). - - PROCEDURE DIVISION. - INSPECT f TALLYING not-a-num FOR ALL 3 - REPLACING FIRST "abcde" BY not-display - TRANSFORM f FROM 3 TO 2 - . -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/syn_misc.at:4674: \$COMPILE_ONLY prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY prog.cob" "syn_misc.at:4674" -( $at_check_trace; $COMPILE_ONLY prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob:20: error: 'f' is not a field -prog.cob:20: error: 'not-a-num' is not numeric -prog.cob:20: error: 3 is not an alphanumeric literal -prog.cob:20: error: invalid target for TALLYING -prog.cob:21: error: 'not-display' is not USAGE DISPLAY -prog.cob:20: error: REPLACING operands differ in size -prog.cob:20: error: invalid target for REPLACING -prog.cob:22: error: 'f' is not a field -prog.cob:22: error: 3 is not an alphanumeric literal -prog.cob:22: error: 2 is not an alphanumeric literal -prog.cob:22: error: invalid target for TRANSFORM -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/syn_misc.at:4674" -$at_failed && at_fn_log_failure -$at_traceon; } - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_292 -#AT_START_293 -at_fn_group_banner 293 'syn_misc.at:4690' \ - "SIGN clause checks" " " 2 -at_xfail=no -( - $as_echo "293. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 valid-1 SIGN TRAILING. - 03 x PIC S999. - 03 y PIC S999. - 01 valid-2 PIC S99. - - 01 invalid-1 PIC 99 SIGN LEADING. - 01 invalid-2 PIC S99 SIGN TRAILING, USAGE BINARY. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/syn_misc.at:4708: \$COMPILE_ONLY prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY prog.cob" "syn_misc.at:4708" -( $at_check_trace; $COMPILE_ONLY prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob:12: error: elementary items with SIGN clause must have S in PICTURE -prog.cob:13: error: elementary items with SIGN clause must be USAGE DISPLAY or NATIONAL -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/syn_misc.at:4708" -$at_failed && at_fn_log_failure -$at_traceon; } - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_293 -#AT_START_294 -at_fn_group_banner 294 'syn_misc.at:4715' \ - "conflicting entry conventions" " " 2 -at_xfail=no -( - $as_echo "294. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - OPTIONS. - ENTRY-CONVENTION COBOL. - ENVIRONMENT DIVISION. - CONFIGURATION SECTION. - SPECIAL-NAMES. - CALL-CONVENTION 0 IS EXTERN. - - PROCEDURE DIVISION EXTERN. - CONTINUE - . -_ATEOF - -{ set +x -$as_echo "$at_srcdir/syn_misc.at:4732: \$COMPILE_ONLY prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY prog.cob" "syn_misc.at:4732" -( $at_check_trace; $COMPILE_ONLY prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob:11: warning: overriding convention specified in ENTRY-CONVENTION -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/syn_misc.at:4732" -$at_failed && at_fn_log_failure -$at_traceon; } - - -cat >prog2.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog2. - OPTIONS. - ENTRY-CONVENTION COBOL. - ENVIRONMENT DIVISION. - CONFIGURATION SECTION. - - PROCEDURE DIVISION WITH C LINKAGE. - CONTINUE - . -_ATEOF - -{ set +x -$as_echo "$at_srcdir/syn_misc.at:4748: \$COMPILE_ONLY prog2.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY prog2.cob" "syn_misc.at:4748" -( $at_check_trace; $COMPILE_ONLY prog2.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog2.cob:9: warning: overriding convention specified in ENTRY-CONVENTION -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/syn_misc.at:4748" -$at_failed && at_fn_log_failure -$at_traceon; } - - -cat >prog3.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog3. - ENVIRONMENT DIVISION. - CONFIGURATION SECTION. - SPECIAL-NAMES. - CALL-CONVENTION 0 IS EXTERN. - - PROCEDURE DIVISION - EXTERN - WITH C LINKAGE. - CONTINUE - ENTRY 'ANOTHERSTATEMENT'. - CONTINUE - ENTRY EXTERN 'ANOTHERSTATEMENT2'. - CONTINUE - ENTRY 'ANOTHERSTATEMENT3' WITH C LINKAGE. - CONTINUE - ENTRY - EXTERN - 'ANOTHERSTATEMENT4' - WITH C LINKAGE. - CONTINUE - . -_ATEOF - -{ set +x -$as_echo "$at_srcdir/syn_misc.at:4777: \$COMPILE_ONLY prog3.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY prog3.cob" "syn_misc.at:4777" -( $at_check_trace; $COMPILE_ONLY prog3.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog3.cob:11: error: CALL-CONVENTION and WITH LINKAGE are mutually exclusive -prog3.cob:22: error: CALL-CONVENTION and WITH LINKAGE are mutually exclusive -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/syn_misc.at:4777" -$at_failed && at_fn_log_failure -$at_traceon; } - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_294 -#AT_START_295 -at_fn_group_banner 295 'syn_misc.at:4784' \ - "conflicting call conventions" " " 2 -at_xfail=no -( - $as_echo "295. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - PROCEDURE DIVISION. - CALL EXTERN 'callee'. - CALL 'callee' WITH C LINKAGE. - CALL - EXTERN - 'callee' - WITH C LINKAGE - . - GOBACK. -_ATEOF - -{ set +x -$as_echo "$at_srcdir/syn_misc.at:4800: \$COMPILE_ONLY prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY prog.cob" "syn_misc.at:4800" -( $at_check_trace; $COMPILE_ONLY prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob:10: error: CALL-CONVENTION and WITH LINKAGE are mutually exclusive -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/syn_misc.at:4800" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/syn_misc.at:4803: \$COMPILE_ONLY -std=cobol85 -freserved=EXTERN,C prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY -std=cobol85 -freserved=EXTERN,C prog.cob" "syn_misc.at:4803" -( $at_check_trace; $COMPILE_ONLY -std=cobol85 -freserved=EXTERN,C prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob:5: error: CALL-/ENTRY-CONVENTION does not conform to COBOL 85 -prog.cob:6: error: WITH ... LINKAGE does not conform to COBOL 85 -prog.cob:8: error: CALL-/ENTRY-CONVENTION does not conform to COBOL 85 -prog.cob:10: error: WITH ... LINKAGE does not conform to COBOL 85 -prog.cob:10: error: CALL-CONVENTION and WITH LINKAGE are mutually exclusive -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/syn_misc.at:4803" -$at_failed && at_fn_log_failure -$at_traceon; } - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_295 -#AT_START_296 -at_fn_group_banner 296 'syn_misc.at:4813' \ - "dangling LINKAGE items" " " 2 -at_xfail=no -( - $as_echo "296. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - LINKAGE SECTION. - * constants may occur anywhere but don't belong to LINKAGE - 78 NSIZE VALUE 1. - * - * two variables in USING - 77 A PIC X. - 01 B. - 03 B1 PIC X. - 03 B2 PIC 9(NSIZE). - * variable not referenced anywhere - no warning - 77 C PIC X. - * variable referenced by its REDEFINE - 01 D PIC XX. - 01 filler redefines D. - 03 D1 PIC X. - 03 D2 PIC 9(NSIZE). - * variable referenced by its second REDEFINE - 01 E PIC XX. - 01 filler redefines E. - 03 Ea1 PIC X. - 03 Ea2 PIC 9(NSIZE). - 01 filler redefines E. - 03 Eb1 PIC X. - 03 Eb2 PIC 9(NSIZE). - * variable referenced by its child - 01 F. - 03 F1 PIC X. - 03 F2 PIC 9(NSIZE). - * variable referenced by level 88 (a validation entry) - 01 G. - 03 filler PIC X. - 88 g-val-a value 'a'. - 88 g-val-b value 'b'. - PROCEDURE DIVISION USING A B. - - IF D2 OMITTED OR Eb2 OMITTED or F2 OMITTED - set g-val-b to true - END-IF - . -_ATEOF - -{ set +x -$as_echo "$at_srcdir/syn_misc.at:4860: \$COMPILE_ONLY -Wlinkage prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY -Wlinkage prog.cob" "syn_misc.at:4860" -( $at_check_trace; $COMPILE_ONLY -Wlinkage prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob:17: warning: LINKAGE item 'D' is not a PROCEDURE USING parameter -prog.cob:22: warning: LINKAGE item 'E' is not a PROCEDURE USING parameter -prog.cob:30: warning: LINKAGE item 'F' is not a PROCEDURE USING parameter -prog.cob:34: warning: LINKAGE item 'G' is not a PROCEDURE USING parameter -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/syn_misc.at:4860" -$at_failed && at_fn_log_failure -$at_traceon; } - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_296 -#AT_START_297 -at_fn_group_banner 297 'syn_misc.at:4869' \ - "ADD / SUBTRACT TABLE" " " 2 -at_xfail=no -( - $as_echo "297. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 tab1. - 03 tab1-entry OCCURS 5 PIC S999. - 01 tab2. - 03 tab2-entry OCCURS 7 PIC S99. - 03 tab2b-entry OCCURS 7. - 05 x PIC S99. - 01 tab3. - 03 sub-tab-3 OCCURS 2. - 05 tab3-entry OCCURS 5 PIC S999. - - PROCEDURE DIVISION. - ADD TABLE tab1-entry TO tab2-entry. - SUBTRACT TABLE tab2-entry FROM tab1-entry. - ADD TABLE tab1-entry TO tab3-entry (1). - SUBTRACT TABLE tab2-entry FROM tab3-entry (2). - ADD TABLE tab1-entry TO x. - SUBTRACT TABLE x FROM tab1-entry. - ADD TABLE tab1-entry TO tab2b-entry. - GOBACK. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/syn_misc.at:4899: \$COMPILE_ONLY prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY prog.cob" "syn_misc.at:4899" -( $at_check_trace; $COMPILE_ONLY prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob:18: warning: ADD TABLE is not implemented -prog.cob:19: warning: SUBTRACT TABLE is not implemented -prog.cob:20: warning: ADD TABLE is not implemented -prog.cob:21: warning: SUBTRACT TABLE is not implemented -prog.cob:22: warning: ADD TABLE is not implemented -prog.cob:23: warning: SUBTRACT TABLE is not implemented -prog.cob:24: warning: ADD TABLE is not implemented -prog.cob:24: error: 'tab2b-entry' is not numeric -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/syn_misc.at:4899" -$at_failed && at_fn_log_failure -$at_traceon; } - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_297 -#AT_START_298 -at_fn_group_banner 298 'syn_misc.at:4912' \ - "USE FOR DEBUGGING invalid ref-mod / subscripts" " " 2 -at_xfail=no -( - $as_echo "298. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -# COBOL85 3.2.3 Syntax Rules 10+12 - "no subscripts. not reference-modified" -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - - ENVIRONMENT DIVISION. - CONFIGURATION SECTION. - SOURCE-COMPUTER. - whatever WITH DEBUGGING MODE. - - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 i PIC 9. - 01 FILLER. - 03 x OCCURS 2 PIC 9. - - PROCEDURE DIVISION. - DECLARATIVES. - test-DEBUG SECTION. - USE FOR DEBUGGING ON ALL OF I (1:1). - DISPLAY DEBUG-LINE. - test-DEBUGo SECTION. - USE FOR DEBUGGING ON ALL OF X (1). - DISPLAY DEBUG-LINE. - END DECLARATIVES. - - MAIN SECTION. - MOVE 1 TO i, x(2) - STOP RUN. -_ATEOF - - - -{ set +x -$as_echo "$at_srcdir/syn_misc.at:4947: \$COMPILE_ONLY prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY prog.cob" "syn_misc.at:4947" -( $at_check_trace; $COMPILE_ONLY prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob: in section 'test-DEBUG': -prog.cob:19: error: DEBUGGING target may not be reference modified -prog.cob: in section 'test-DEBUGo': -prog.cob:22: error: DEBUGGING target may not be subscripted -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/syn_misc.at:4947" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_298 -#AT_START_299 -at_fn_group_banner 299 'syn_misc.at:4957' \ - "USE FOR DEBUGGING duplicate targets" " " 2 -at_xfail=no -( - $as_echo "299. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -# TODO: add cd-names and file-names here - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - - ENVIRONMENT DIVISION. - CONFIGURATION SECTION. - SOURCE-COMPUTER. - whatever WITH DEBUGGING MODE. - - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 i PIC 9. - 01 j PIC 9. - - PROCEDURE DIVISION. - DECLARATIVES. - test-DEBUG SECTION. - USE FOR DEBUGGING ON MAIN MAIN. - DISPLAY DEBUG-LINE. - test-DEBUG2 SECTION. - USE FOR DEBUGGING ON ALL I - ALL REFERENCES OF J - ALL PROCEDURES. - DISPLAY DEBUG-LINE. - test-DEBUG3 SECTION. - USE FOR DEBUGGING ON ALL PROCEDURES - J - ALL OF I. - DISPLAY DEBUG-LINE. - END DECLARATIVES. - - MAIN SECTION. - MOVE 1 TO i - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/syn_misc.at:4998: \$COMPILE_ONLY prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY prog.cob" "syn_misc.at:4998" -( $at_check_trace; $COMPILE_ONLY prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob: in section 'test-DEBUG3': -prog.cob:26: error: duplicate USE DEBUGGING ON ALL PROCEDURES -prog.cob:27: error: duplicate DEBUGGING target: 'j' -prog.cob:28: error: duplicate DEBUGGING target: 'i' -prog.cob: in section 'test-DEBUG': -prog.cob:18: error: DEBUGGING target already specified with ALL PROCEDURES: 'MAIN' -prog.cob:18: error: duplicate DEBUGGING target: 'MAIN' -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/syn_misc.at:4998" -$at_failed && at_fn_log_failure -$at_traceon; } - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_299 -#AT_START_300 -at_fn_group_banner 300 'syn_misc.at:5010' \ - "USE FOR DEBUGGING syntax-checks" " " 2 -at_xfail=yes -( - $as_echo "300. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -# TODO: still need tests/checks (3.2.3 Syntax Rules 9+11): -# 09 Identifier must not reference any data item defined in the Report -# Section except sum counters. -# 11 References to the special register DEBUG-ITEM are restricted to -# references from within a debugging section. - - -# we currently fail to detect references into DECLARATIVES and -# references to debugging-procedures other than PERFORM --> both in prog2 - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - - ENVIRONMENT DIVISION. - CONFIGURATION SECTION. - SOURCE-COMPUTER. - whatever WITH DEBUGGING MODE. - - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 i PIC 9. - 01 j PIC 9. - - PROCEDURE DIVISION. - DECLARATIVES. - test-DEBUG SECTION. - USE FOR DEBUGGING ON ALL REFERENCES OF I - TEST-debug - MAIN. - DISPLAY DEBUG-LINE. - PERFORM MAIN. PERFORM TEST-DEBUG2. GO TO TEST-DEBUG2. - test-DEBUG2 SECTION. - USE FOR DEBUGGING ON ALL OF I - TEST-debug. - DISPLAY DEBUG-LINE. - END DECLARATIVES. - - MAIN SECTION. - MOVE 1 TO i, j - PERFORM TesT-DebuG - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/syn_misc.at:5057: \$COMPILE_ONLY prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY prog.cob" "syn_misc.at:5057" -( $at_check_trace; $COMPILE_ONLY prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob: in section 'TEST-DEBUG2': -prog.cob:24: error: duplicate DEBUGGING target: 'i' -prog.cob: in section 'test-DEBUG': -prog.cob:22: warning: 'MAIN' is not in DECLARATIVES -prog.cob:19: error: DEBUGGING target invalid: 'test-DEBUG' -prog.cob: in section 'TEST-DEBUG2': -prog.cob:25: error: DEBUGGING target invalid: 'test-DEBUG' -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/syn_misc.at:5057" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/syn_misc.at:5066: \$COMPILE_ONLY -std=cobol85 prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY -std=cobol85 prog.cob" "syn_misc.at:5066" -( $at_check_trace; $COMPILE_ONLY -std=cobol85 prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob: in section 'TEST-DEBUG2': -prog.cob:24: error: duplicate DEBUGGING target: 'i' -prog.cob: in section 'test-DEBUG': -prog.cob:22: error: 'MAIN' is not in DECLARATIVES -prog.cob:19: error: DEBUGGING target invalid: 'test-DEBUG' -prog.cob: in section 'TEST-DEBUG2': -prog.cob:25: error: DEBUGGING target invalid: 'test-DEBUG' -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/syn_misc.at:5066" -$at_failed && at_fn_log_failure -$at_traceon; } - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_300 -#AT_START_301 -at_fn_group_banner 301 'syn_misc.at:5078' \ - "Empty PERFORM with DEBUGGING MODE" " " 2 -at_xfail=no -( - $as_echo "301. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - - ENVIRONMENT DIVISION. - CONFIGURATION SECTION. - SOURCE-COMPUTER. - whatever WITH DEBUGGING MODE. - - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 i PIC 9. - - PROCEDURE DIVISION. - PERFORM VARYING i FROM 1 BY 1 - UNTIL i = 5 - END-PERFORM - . -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/syn_misc.at:5101: \$COMPILE_ONLY -fmissing-statement=ok prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY -fmissing-statement=ok prog.cob" "syn_misc.at:5101" -( $at_check_trace; $COMPILE_ONLY -fmissing-statement=ok prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/syn_misc.at:5101" -$at_failed && at_fn_log_failure -$at_traceon; } - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_301 -#AT_START_302 -at_fn_group_banner 302 'syn_misc.at:5106' \ - "whitespace handling" " " 2 -at_xfail=no -( - $as_echo "302. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog1.cob <<'_ATEOF' - - IDENTIFICATION - DIVISION - . - author. - tester. - PROGRAM-ID - . - prog1 - . - REMARKS;. Should work.,, - - ENVIRONMENT - DIVISION - . - CONFIGURATION - SECTION - . - SOURCE-COMPUTER - . - whatever - WITH - DEBUGGING - MODE - . - - DDATA - D DIVISION - D . - WORKING-STORAGE - SECTION - . - 01 - i - PIC - 9 - . - - PROCEDURE - DIVISION - . - >> SOURCE FORMAT IS FREE -IF -i -GREATER -THAN -OR -EQUAL - -TO - -5 - -THEN - -GOBACK. - STOP - RUN - . -_ATEOF - - -cat >prog2.cob <<'_ATEOF' - - ID,;DIVISION;,.,; - author,.;tester. - PROGRAM-ID,;.;,prog2;,.;, - REMARKS;. Should work.,, - ENVIRONMENT,;DIVISION;,.,; - CONFIGURATION;;,,SECTION;;,,. - SOURCE-COMPUTER;;.,,whatever;;DEBUGGING,,MODE;,. - - DDATA;DIVISION,. - DWORKING-STORAGE,SECTION;. - 01;i,PIC;9;. - - PROCEDURE;DIVISION,.; - IF;,i;,GREATER,;THAN;,OR,;EQUAL ,;TO;;5; - ,,,THEN;;;GOBACK. - STOP,RUN;., -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/syn_misc.at:5189: \$COMPILE_ONLY -Wno-obsolete prog1.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY -Wno-obsolete prog1.cob" "syn_misc.at:5189" -( $at_check_trace; $COMPILE_ONLY -Wno-obsolete prog1.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/syn_misc.at:5189" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/syn_misc.at:5190: \$COMPILE_ONLY -Wno-obsolete prog2.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY -Wno-obsolete prog2.cob" "syn_misc.at:5190" -( $at_check_trace; $COMPILE_ONLY -Wno-obsolete prog2.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/syn_misc.at:5190" -$at_failed && at_fn_log_failure -$at_traceon; } - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_302 -#AT_START_303 -at_fn_group_banner 303 'syn_misc.at:5194' \ - "STOP identifier" " " 2 -at_xfail=no -( - $as_echo "303. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 x PIC 9(5) VALUE 1. - 01 y CONSTANT "ab". - - PROCEDURE DIVISION. - STOP x - STOP y - . -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/syn_misc.at:5212: \$COMPILE_ONLY prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY prog.cob" "syn_misc.at:5212" -( $at_check_trace; $COMPILE_ONLY prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob:12: warning: STOP identifier is obsolete in GnuCOBOL -prog.cob:12: warning: STOP literal is obsolete in GnuCOBOL -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/syn_misc.at:5212" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/syn_misc.at:5216: \$COMPILE_ONLY -fstop-identifier=ok -fstop-literal=ok prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY -fstop-identifier=ok -fstop-literal=ok prog.cob" "syn_misc.at:5216" -( $at_check_trace; $COMPILE_ONLY -fstop-identifier=ok -fstop-literal=ok prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/syn_misc.at:5216" -$at_failed && at_fn_log_failure -$at_traceon; } - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_303 -#AT_START_304 -at_fn_group_banner 304 'syn_misc.at:5220' \ - "01 CONSTANT" " " 2 -at_xfail=no -( - $as_echo "304. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 NUM2 CONSTANT 3. - 01 CON3 CONSTANT ((1 + 2) * NUM2 - 4. - 01 CON4 CONSTANT (1 + 2) * NUM2 - 4). - 01 CON5 CONSTANT (1 + 2) // NUM2. - 01 CON6 CONSTANT (1 + 2 + 3 + (4)) / (NUM2). - * - PROCEDURE DIVISION. - MAIN. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/syn_misc.at:5239: \$COMPILE_ONLY prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY prog.cob" "syn_misc.at:5239" -( $at_check_trace; $COMPILE_ONLY prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob:7: error: missing right parenthesis -prog.cob:8: error: missing left parenthesis -prog.cob:9: error: '/' operator misplaced -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/syn_misc.at:5239" -$at_failed && at_fn_log_failure -$at_traceon; } - - -{ set +x -$as_echo "$at_srcdir/syn_misc.at:5245: \$COMPILE_ONLY -std=mf-strict prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY -std=mf-strict prog.cob" "syn_misc.at:5245" -( $at_check_trace; $COMPILE_ONLY -std=mf-strict prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob:6: error: syntax error, unexpected Identifier -prog.cob:7: error: syntax error, unexpected Identifier -prog.cob:8: error: syntax error, unexpected Identifier -prog.cob:9: error: syntax error, unexpected Identifier -prog.cob:10: error: syntax error, unexpected Identifier -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/syn_misc.at:5245" -$at_failed && at_fn_log_failure -$at_traceon; } - - -{ set +x -$as_echo "$at_srcdir/syn_misc.at:5253: \$COMPILE_ONLY -std=mf-strict -freserved=CONSTANT prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY -std=mf-strict -freserved=CONSTANT prog.cob" "syn_misc.at:5253" -( $at_check_trace; $COMPILE_ONLY -std=mf-strict -freserved=CONSTANT prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob:6: error: 01 CONSTANT does not conform to Micro Focus COBOL -prog.cob:7: error: 01 CONSTANT does not conform to Micro Focus COBOL -prog.cob:7: error: syntax error, unexpected Identifier, expecting . -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/syn_misc.at:5253" -$at_failed && at_fn_log_failure -$at_traceon; } - - -{ set +x -$as_echo "$at_srcdir/syn_misc.at:5259: \$COMPILE_ONLY -std=mf prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY -std=mf prog.cob" "syn_misc.at:5259" -( $at_check_trace; $COMPILE_ONLY -std=mf prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob:7: error: missing right parenthesis -prog.cob:8: error: missing left parenthesis -prog.cob:9: error: '/' operator misplaced -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/syn_misc.at:5259" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_304 -#AT_START_305 -at_fn_group_banner 305 'syn_misc.at:5268' \ - "78 VALUE" " " 2 -at_xfail=no -( - $as_echo "305. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 78 NUM2 VALUE 3. - 78 NEG1 VALUE -1. - 78 CON3 VALUE ((1 + 2) * NUM2 - 4. - 78 CON4 VALUE (1 + 2) * NUM2 - 4). - 78 CON5 VALUE (1 + 2) // NUM2. - 78 CON6 VALUE (1 + 2 + 3 + (4)) / (NUM2). - * - PROCEDURE DIVISION. - MAIN. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/syn_misc.at:5288: \$COMPILE_ONLY prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY prog.cob" "syn_misc.at:5288" -( $at_check_trace; $COMPILE_ONLY prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob:8: error: missing right parenthesis -prog.cob:9: error: missing left parenthesis -prog.cob:10: error: '/' operator misplaced -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/syn_misc.at:5288" -$at_failed && at_fn_log_failure -$at_traceon; } - - -{ set +x -$as_echo "$at_srcdir/syn_misc.at:5294: \$COMPILE_ONLY -std=ibm-strict prog.cob " -at_fn_check_prepare_dynamic "$COMPILE_ONLY -std=ibm-strict prog.cob " "syn_misc.at:5294" -( $at_check_trace; $COMPILE_ONLY -std=ibm-strict prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob:6: error: 78 VALUE does not conform to IBM COBOL -prog.cob:7: error: 78 VALUE does not conform to IBM COBOL -prog.cob:8: error: 78 VALUE does not conform to IBM COBOL -prog.cob:8: error: missing right parenthesis -prog.cob:9: error: 78 VALUE does not conform to IBM COBOL -prog.cob:9: error: missing left parenthesis -prog.cob:10: error: 78 VALUE does not conform to IBM COBOL -prog.cob:10: error: '/' operator misplaced -prog.cob:11: error: 78 VALUE does not conform to IBM COBOL -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/syn_misc.at:5294" -$at_failed && at_fn_log_failure -$at_traceon; } - - -{ set +x -$as_echo "$at_srcdir/syn_misc.at:5306: \$COMPILE_ONLY -std=ibm prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY -std=ibm prog.cob" "syn_misc.at:5306" -( $at_check_trace; $COMPILE_ONLY -std=ibm prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob:8: error: missing right parenthesis -prog.cob:9: error: missing left parenthesis -prog.cob:10: error: '/' operator misplaced -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/syn_misc.at:5306" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_305 -#AT_START_306 -at_fn_group_banner 306 'syn_misc.at:5315' \ - "level 78 NEXT / START OF" " " 2 -at_xfail=no -( - $as_echo "306. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 78 POS0 VALUE NEXT. - 01 MYREC. - 05 FLD1 PIC 9(2). - 05 FLD2 PIC X(7). - 78 POS3 VALUE NEXT. - 05 FLD3 PIC X(2) OCCURS 5 TIMES. - 78 POS4 VALUE NEXT. - 05 FLD4 PIC X(4). - 78 POS-NEXT VALUE NEXT. - 77 MYREC2 PIC X. - 01 MYREC3 EXTERNAL. - 05 FLD5 PIC X(4). - 78 POS5 VALUE NEXT. - 05 FLD6 PIC X(4). - 01 PICX PIC XXX VALUE 'Abc'. - 78 HUN VALUE 10 * (10 + LENGTH OF PICX) + 12.35-2+3. - 78 HUN2 VALUE HUN * (10 + LENGTH - OF PICX) -4. - 78 DIV1 VALUE 100 / 3. - 78 STRT4 VALUE START OF FLD4. - LINKAGE SECTION. - 01 XMYREC. - 05 XFLD1 PIC 9(2). - 05 XFLD2 PIC X(7). - 78 XPOS3 VALUE NEXT. - 05 XFLD3 PIC X(2) OCCURS 5 TIMES. - 78 XPOS4 VALUE NEXT. - 05 XFLD4 PIC X(4). - 05 XFLD5 PIC X(4). - 78 XSTRT4 VALUE START OF XFLD4. - * - PROCEDURE DIVISION. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/syn_misc.at:5358: \$COMPILE_ONLY prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY prog.cob" "syn_misc.at:5358" -( $at_check_trace; $COMPILE_ONLY prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob:6: error: VALUE of 'POS0': NEXT target is invalid -prog.cob:6: error: no previous data-item found -prog.cob:10: error: VALUE of 'POS3': NEXT target is invalid -prog.cob:10: error: target must be in FILE SECTION or LINKAGE SECTION or have the EXTERNAL clause -prog.cob:12: error: VALUE of 'POS4': NEXT target is invalid -prog.cob:12: error: target must be in FILE SECTION or LINKAGE SECTION or have the EXTERNAL clause -prog.cob:14: error: VALUE of 'POS-NEXT': NEXT target is invalid -prog.cob:14: error: target must be in FILE SECTION or LINKAGE SECTION or have the EXTERNAL clause -prog.cob:25: error: VALUE of 'STRT4': START OF target 'FLD4' is invalid -prog.cob:25: error: target must be in FILE SECTION or LINKAGE SECTION or have the EXTERNAL clause -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/syn_misc.at:5358" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_306 -#AT_START_307 -at_fn_group_banner 307 'syn_misc.at:5374' \ - "SYMBOLIC CONSTANT" " " 2 -at_xfail=no -( - $as_echo "307. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - CONFIGURATION SECTION. - SPECIAL-NAMES. - SYMBOLIC CONSTANT - con-1 IS 1 - 25156c "25156c". - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 NUM2 PIC 9. - 01 SHORT-X PIC X(5). - * - PROCEDURE DIVISION. - MAIN. - MOVE CON-1 TO NUM2. - MOVE 25156C TO SHORT-X - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/syn_misc.at:5398: \$COMPILE_ONLY prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY prog.cob" "syn_misc.at:5398" -( $at_check_trace; $COMPILE_ONLY prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob: in paragraph 'MAIN': -prog.cob:18: warning: value size exceeds data size -prog.cob:18: warning: value size is 6 -prog.cob:13: warning: 'SHORT-X' defined here as PIC X(5) -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/syn_misc.at:5398" -$at_failed && at_fn_log_failure -$at_traceon; } - - -{ set +x -$as_echo "$at_srcdir/syn_misc.at:5405: \$COMPILE_ONLY -std=mf-strict prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY -std=mf-strict prog.cob" "syn_misc.at:5405" -( $at_check_trace; $COMPILE_ONLY -std=mf-strict prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob:9: error: invalid SYMBOLIC clause -prog.cob:9: error: integer value expected -prog.cob: in paragraph 'MAIN': -prog.cob:17: error: 'con-1' is not defined -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/syn_misc.at:5405" -$at_failed && at_fn_log_failure -$at_traceon; } - - -{ set +x -$as_echo "$at_srcdir/syn_misc.at:5412: \$COMPILE_ONLY -std=cobol2014 prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY -std=cobol2014 prog.cob" "syn_misc.at:5412" -( $at_check_trace; $COMPILE_ONLY -std=cobol2014 prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob:9: error: SYMBOLIC CONSTANT does not conform to COBOL 2014 -prog.cob: in paragraph 'MAIN': -prog.cob:18: warning: value size exceeds data size -prog.cob:18: warning: value size is 6 -prog.cob:13: warning: 'SHORT-X' defined here as PIC X(5) -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/syn_misc.at:5412" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_307 -#AT_START_308 -at_fn_group_banner 308 'syn_misc.at:5423' \ - "Constant Expressions (1)" " " 2 -at_xfail=no -( - $as_echo "308. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 var PIC X(200). - 01 othervar PIC X(115). - 01 A PIC 9 VALUE 1. - 01 B PIC 9 VALUE 2. - 01 C PIC 9 VALUE 3. - 78 var-len value 115. - - PROCEDURE DIVISION. - - IF var-len < 16 - move othervar (1:var-len - 8) - to var (17 - var-len:var-len - 8) - ELSE - move othervar to var - END-IF - - IF (2 = 3) - move othervar to var - ELSE - IF 1 = 1 - move var to othervar - ELSE - move othervar (1:var-len - 8) - to var (17 - var-len:var-len - 8) - IF 1 = 1 - move var to othervar - END-IF - END-IF - move A to B - IF 1 = 1 - IF 2 = 1 - move othervar (1:var-len - 8) - to var (17 - var-len:var-len - 8) - . - - PERFORM WITH TEST BEFORE UNTIL 1 = 3 - move othervar to var - END-PERFORM - - PERFORM WITH TEST BEFORE UNTIL 1 = 1 - move othervar (1:var-len - 8) - to var (17 - var-len:var-len - 8) - END-PERFORM - - PERFORM WITH TEST AFTER UNTIL 1 = 3 - move othervar to var - END-PERFORM - - PERFORM WITH TEST AFTER UNTIL 1 = 1 - move othervar to var - END-PERFORM - - EVALUATE TRUE - WHEN var-len < 16 - move othervar (1:var-len - 8) - to var (17 - var-len:var-len - 8) - WHEN var-len > 16 - move othervar to var - WHEN A = B - move var to othervar - WHEN OTHER - CONTINUE - END-EVALUATE - - EVALUATE FALSE - WHEN var-len < 16 - move othervar (1:var-len - 9) - to var (16 - var-len:var-len - 9) - WHEN var-len > 16 - move othervar to var - WHEN A = B - move var to othervar - WHEN OTHER - CONTINUE - END-EVALUATE. - - IF 15 = var-len - move othervar to var. - - IF var-len = 15 - move var to othervar. - - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/syn_misc.at:5516: \$COMPILE_ONLY prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY prog.cob" "syn_misc.at:5516" -( $at_check_trace; $COMPILE_ONLY prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob:15: warning: expression '115' LESS THAN '16' is always FALSE -prog.cob:17: error (ignored): offset must be greater than zero -prog.cob:22: warning: expression '2' EQUALS '3' is always FALSE -prog.cob:25: warning: expression '1' EQUALS '1' is always TRUE -prog.cob:29: error (ignored): offset must be greater than zero -prog.cob:30: warning: expression '1' EQUALS '1' is always TRUE -prog.cob:35: warning: expression '1' EQUALS '1' is always TRUE -prog.cob:36: warning: expression '2' EQUALS '1' is always FALSE -prog.cob:38: error (ignored): offset must be greater than zero -prog.cob:41: warning: expression '1' EQUALS '3' is always FALSE -prog.cob:41: warning: PERFORM FOREVER since UNTIL is always FALSE -prog.cob:45: warning: expression '1' EQUALS '1' is always TRUE -prog.cob:45: warning: PERFORM NEVER since UNTIL is always TRUE -prog.cob:47: error (ignored): offset must be greater than zero -prog.cob:50: warning: expression '1' EQUALS '3' is always FALSE -prog.cob:50: warning: PERFORM FOREVER since UNTIL is always FALSE -prog.cob:54: warning: expression '1' EQUALS '1' is always TRUE -prog.cob:54: warning: PERFORM ONCE since UNTIL is always TRUE -prog.cob:59: warning: expression '115' LESS THAN '16' is always FALSE -prog.cob:61: error (ignored): offset must be greater than zero -prog.cob:62: warning: expression '115' GREATER THAN '16' is always TRUE -prog.cob:71: warning: expression '115' LESS THAN '16' is always FALSE -prog.cob:73: error: offset must be greater than zero -prog.cob:74: warning: expression '115' GREATER THAN '16' is always TRUE -prog.cob:82: warning: expression '15' EQUALS '115' is always FALSE -prog.cob:85: warning: expression '115' EQUALS '15' is always FALSE -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/syn_misc.at:5516" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_308 -#AT_START_309 -at_fn_group_banner 309 'syn_misc.at:5548' \ - "Constant Expressions (2)" " " 2 -at_xfail=no -( - $as_echo "309. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 78 const1 value 115. - 01 const2 CONSTANT 200. - 78 const3 value const2. - 78 const4 value const2 + const1. - 77 othervar PIC X(const1). - 01 var PIC X(const2). - - PROCEDURE DIVISION. - - IF const1 = const2 - OR const2 = const1 - OR const3 = const4 - OR const4 = const3 - DISPLAY 'no way' END-DISPLAY - END-IF - - EVALUATE const1 - WHEN 15 - WHEN 115 - display '1' - WHEN < 16 - move othervar (1:8) - to var (17:8) - WHEN > 16 - display othervar - *> actually WHEN OTHER is also FALSE in this case (115 = 16), - *> but this is too complex to check - WHEN OTHER - display othervar - END-EVALUATE - - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/syn_misc.at:5590: \$COMPILE_ONLY prog.cob " -at_fn_check_prepare_dynamic "$COMPILE_ONLY prog.cob " "syn_misc.at:5590" -( $at_check_trace; $COMPILE_ONLY prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob:15: warning: expression '115' EQUALS '200' is always FALSE -prog.cob:16: warning: expression '200' EQUALS '115' is always FALSE -prog.cob:17: warning: expression '200' EQUALS '315' is always FALSE -prog.cob:18: warning: expression '315' EQUALS '200' is always FALSE -prog.cob:26: warning: expression '115' LESS THAN '16' is always FALSE -prog.cob:29: warning: expression '115' GREATER THAN '16' is always TRUE -prog.cob:23: warning: expression '115' EQUALS '15' is always FALSE -prog.cob:24: warning: expression '115' EQUALS '115' is always TRUE -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/syn_misc.at:5590" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_309 -#AT_START_310 -at_fn_group_banner 310 'syn_misc.at:5604' \ - "Constant Expressions (3)" " " 2 -at_xfail=no -( - $as_echo "310. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -# verify that we do ignore undefined errors where possible -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 var PIC X(200). - 78 var-len value 115. - - PROCEDURE DIVISION. - - IF var-len < 16 - move spaces - to var (17 - var-len:var-len - 8) - END-IF - - IF var-len < 16 - move notdefined to var - END-IF - - IF var-len < 16 - perform notdefined - END-IF - - IF var-len < 16 - if notdefined continue. - - STOP RUN. -_ATEOF - - -# note: the last error message comes from program validation -# and therefore cannot be raised earlier -{ set +x -$as_echo "$at_srcdir/syn_misc.at:5639: \$COMPILE_ONLY prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY prog.cob" "syn_misc.at:5639" -( $at_check_trace; $COMPILE_ONLY prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob:11: warning: expression '115' LESS THAN '16' is always FALSE -prog.cob:13: error (ignored): offset must be greater than zero -prog.cob:16: warning: expression '115' LESS THAN '16' is always FALSE -prog.cob:17: error (ignored): 'notdefined' is not defined -prog.cob:20: warning: expression '115' LESS THAN '16' is always FALSE -prog.cob:24: warning: expression '115' LESS THAN '16' is always FALSE -prog.cob:25: error (ignored): 'notdefined' is not defined -prog.cob:21: error (ignored): 'notdefined' is not defined -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/syn_misc.at:5639" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_310 -#AT_START_311 -at_fn_group_banner 311 'syn_misc.at:5653' \ - "Constant Expressions (4)" " " 2 -at_xfail=no -( - $as_echo "311. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -# verify that we do not ignore parsing errors as -# these are likely to raise issues in codegen - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 var PIC X(200). - 78 var-len value 115. - - PROCEDURE DIVISION. - - IF var-len < 16 - move spaces - to var (17 - var-len:var-len - 8) - IF IF. - - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/syn_misc.at:5677: \$COMPILE_ONLY prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY prog.cob" "syn_misc.at:5677" -( $at_check_trace; $COMPILE_ONLY prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob:11: warning: expression '115' LESS THAN '16' is always FALSE -prog.cob:13: error (ignored): offset must be greater than zero -prog.cob:14: error: syntax error, unexpected IF -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/syn_misc.at:5677" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_311 -#AT_START_312 -at_fn_group_banner 312 'syn_misc.at:5686' \ - "Constant Expressions (5)" " " 2 -at_xfail=no -( - $as_echo "312. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 VAR PIC X(200). - 01 OTHERVAR PIC X(115). - 78 VAR-LEN VALUE 115. - - PROCEDURE DIVISION. - MAIN-10. - MOVE "Peek a boo" TO VAR. - EVALUATE TRUE - ALSO FALSE - ALSO TRUE - WHEN TRUE - ALSO VAR-LEN > 16 AND VAR-LEN < 200 - ALSO TRUE - MOVE OTHERVAR (1 : VAR-LEN - 9) - TO VAR (16 - VAR-LEN : VAR-LEN - 9) - DISPLAY "A: Should NOT be executed" - WHEN TRUE - ALSO VAR-LEN < 16 - ALSO TRUE - MOVE OTHERVAR TO VAR - DISPLAY "A: OK VAR-LEN > 16 AND VAR-LEN < 200" - WHEN TRUE - ALSO VAR = SPACES - ALSO TRUE - MOVE OTHERVAR TO VAR - DISPLAY "A: OK VAR IS SPACES" - END-EVALUATE. - - MOVE "Peek a boo" TO VAR. - EVALUATE 3 EQUALS 7 - WHEN VAR = SPACES - DISPLAY "B: OK VAR IS NOT SPACES" - WHEN VAR NOT = SPACES - DISPLAY "B: FALSE VAR IS SPACES" - END-EVALUATE. - - MOVE SPACES TO VAR. - EVALUATE FALSE - WHEN VAR = SPACES - DISPLAY "C: FALSE VAR IS SPACES" - WHEN VAR NOT = SPACES - DISPLAY "C: OK VAR IS SPACES" - END-EVALUATE. - - MOVE "Peek a boo" TO VAR. - EVALUATE TRUE - WHEN VAR = SPACES - DISPLAY "D: BAD VAR IS SPACES" - WHEN VAR NOT = SPACES - DISPLAY "D: OK VAR IS NOT SPACES" - END-EVALUATE. - - MOVE SPACES TO VAR. - EVALUATE VAR-LEN ALSO VAR - WHEN < 32 ALSO SPACES - DISPLAY "E: OK VAR IS SPACES" - WHEN > 16 ALSO NOT SPACES - DISPLAY "E: BAD VAR IS NOT SPACES" - WHEN OTHER - DISPLAY "E: OK OTHER option taken" - END-EVALUATE. - - STOP RUN. -_ATEOF - - -# Note: ideally this should not result in a difference compared to the next one - -{ set +x -$as_echo "$at_srcdir/syn_misc.at:5761: \$COMPILE_ONLY -C -fno-remove-unreachable prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY -C -fno-remove-unreachable prog.cob" "syn_misc.at:5761" -( $at_check_trace; $COMPILE_ONLY -C -fno-remove-unreachable prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob: in paragraph 'MAIN-10': -prog.cob:17: warning: expression '115' GREATER THAN '16' is always TRUE -prog.cob:17: warning: expression '115' LESS THAN '200' is always TRUE -prog.cob:20: error: offset must be greater than zero -prog.cob:23: warning: expression '115' LESS THAN '16' is always FALSE -prog.cob:35: warning: expression '3' EQUALS '7' is always FALSE -prog.cob:60: warning: expression '115' LESS THAN '32' is always FALSE -prog.cob:62: warning: expression '115' GREATER THAN '16' is always TRUE -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/syn_misc.at:5761" -$at_failed && at_fn_log_failure -$at_traceon; } - - -{ set +x -$as_echo "$at_srcdir/syn_misc.at:5772: \$COMPILE_ONLY -C prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY -C prog.cob" "syn_misc.at:5772" -( $at_check_trace; $COMPILE_ONLY -C prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob: in paragraph 'MAIN-10': -prog.cob:17: warning: expression '115' GREATER THAN '16' is always TRUE -prog.cob:17: warning: expression '115' LESS THAN '200' is always TRUE -prog.cob:20: error (ignored): offset must be greater than zero -prog.cob:23: warning: expression '115' LESS THAN '16' is always FALSE -prog.cob:35: warning: expression '3' EQUALS '7' is always FALSE -prog.cob:60: warning: expression '115' LESS THAN '32' is always FALSE -prog.cob:62: warning: expression '115' GREATER THAN '16' is always TRUE -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/syn_misc.at:5772" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_312 -#AT_START_313 -at_fn_group_banner 313 'syn_misc.at:5786' \ - "Missing imperative statements" " " 2 -at_xfail=no -( - $as_echo "313. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 var PIC X(200). - 01 othervar PIC X(115). - 01 A PIC 9 VALUE 1. - 01 B PIC 9 VALUE 2. - 01 C PIC 9 VALUE 3. - 78 var-len value 115. - - PROCEDURE DIVISION. - - IF var-len < 16 - ELSE - move othervar to var - END-IF - - IF var-len > 16 - ELSE - move othervar to var - END-IF - - IF (2 = 3) - ELSE - IF 1 = 1 - ELSE - IF 1 = 1 - move var to othervar - END-IF - END-IF - . - - EVALUATE TRUE - WHEN A = B - move var to othervar - WHEN OTHER - END-EVALUATE - - PERFORM WITH TEST BEFORE UNTIL 1 <> 3 - END-PERFORM - - EVALUATE FALSE - WHEN A = B - WHEN B = A - END-EVALUATE. - - EVALUATE TRUE - WHEN A = B - move var to othervar - WHEN OTHER - . - - EVALUATE TRUE - WHEN A = B - WHEN B = A - . - - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/syn_misc.at:5851: \$COMPILE_ONLY -w -fmissing-statement=error prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY -w -fmissing-statement=error prog.cob" "syn_misc.at:5851" -( $at_check_trace; $COMPILE_ONLY -w -fmissing-statement=error prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob:18: error: IF without imperative statement used -prog.cob:23: error: IF without imperative statement used -prog.cob:32: error: IF without imperative statement used -prog.cob:33: error: IF without imperative statement used -prog.cob:39: error: WHEN OTHER without imperative statement used -prog.cob:42: error: inline PERFORM without imperative statement used -prog.cob:47: error: WHEN without imperative statement used -prog.cob:53: error: WHEN OTHER without imperative statement used -prog.cob:58: error: WHEN without imperative statement used -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/syn_misc.at:5851" -$at_failed && at_fn_log_failure -$at_traceon; } - - -{ set +x -$as_echo "$at_srcdir/syn_misc.at:5863: \$COMPILE_ONLY -fno-constant-folding -fmissing-statement=warning prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY -fno-constant-folding -fmissing-statement=warning prog.cob" "syn_misc.at:5863" -( $at_check_trace; $COMPILE_ONLY -fno-constant-folding -fmissing-statement=warning prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob:18: warning: IF without imperative statement used -prog.cob:23: warning: IF without imperative statement used -prog.cob:32: warning: IF without imperative statement used -prog.cob:33: warning: IF without imperative statement used -prog.cob:39: warning: WHEN OTHER without imperative statement used -prog.cob:42: warning: inline PERFORM without imperative statement used -prog.cob:47: warning: WHEN without imperative statement used -prog.cob:53: warning: WHEN OTHER without imperative statement used -prog.cob:58: warning: WHEN without imperative statement used -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/syn_misc.at:5863" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_313 -#AT_START_314 -at_fn_group_banner 314 'syn_misc.at:5878' \ - "Fall-Through to WHEN OTHER" " " 2 -at_xfail=yes -( - $as_echo "314. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -# we currently don't do the necessary parsing steps for -# this test to pass - and likely need a different option -# than frelax-syntax-checks.. - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 A PIC 9 VALUE 1. - 01 B PIC 9 VALUE 2. - - PROCEDURE DIVISION. - - EVALUATE TRUE - WHEN A = B - WHEN OTHER - DISPLAY 'other' END-DISPLAY - END-EVALUATE - - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/syn_misc.at:5906: \$COMPILE_ONLY prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY prog.cob" "syn_misc.at:5906" -( $at_check_trace; $COMPILE_ONLY prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob:12: error: fall-through to WHEN OTHER is not allowed -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/syn_misc.at:5906" -$at_failed && at_fn_log_failure -$at_traceon; } - - -{ set +x -$as_echo "$at_srcdir/syn_misc.at:5910: \$COMPILE_ONLY -frelax-syntax-checks prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY -frelax-syntax-checks prog.cob" "syn_misc.at:5910" -( $at_check_trace; $COMPILE_ONLY -frelax-syntax-checks prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob:12: warning: fall-through to WHEN OTHER -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/syn_misc.at:5910" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_314 -#AT_START_315 -at_fn_group_banner 315 'syn_misc.at:5916' \ - "CONSTANT LENGTH / BYTE-LENGTH" " " 2 -at_xfail=no -( - $as_echo "315. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - identification division. - program-id. prog. - environment division. - data division. - working-storage section. - 01 item-01. - 05 item-05-a pointer. - 05 item-05-b pic x(01). - 01 myk-01 constant global as length of item-01. - 01 myk-02 constant is global as length item-05-a. - 01 myk-03 constant global as length of pointer. *> extension - 01 myk-04 constant global as byte-length of item-01. - 01 myk-05 constant is global as byte-length item-05-a. - 01 myk-06 constant global as byte-length of pointer. *> extension -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/syn_misc.at:5936: \$COMPILE_ONLY prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY prog.cob" "syn_misc.at:5936" -( $at_check_trace; $COMPILE_ONLY prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/syn_misc.at:5936" -$at_failed && at_fn_log_failure -$at_traceon; } - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_315 -#AT_START_316 -at_fn_group_banner 316 'syn_misc.at:5940' \ - "ANY LENGTH/NUMERIC with incorrect PIC" " " 2 -at_xfail=no -( - $as_echo "316. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - - DATA DIVISION. - LINKAGE SECTION. - *> Valid - 01 valid-1 PIC X ANY LENGTH. - 01 valid-2 PIC N ANY LENGTH. - 01 valid-3 PIC 9 ANY NUMERIC. - - *> Invalid - 01 invalid-1 PIC A ANY LENGTH. - 01 invalid-2 PIC Z ANY LENGTH. - 01 invalid-3 PIC 9 ANY LENGTH. - 01 invalid-4 PIC X ANY NUMERIC. - 01 invalid-5 PIC XX ANY LENGTH. - 01 invalid-6 PIC NN ANY LENGTH. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/syn_misc.at:5963: \$COMPILE_ONLY prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY prog.cob" "syn_misc.at:5963" -( $at_check_trace; $COMPILE_ONLY prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob:9: warning: handling of USAGE NATIONAL is unfinished; implementation is likely to be changed -prog.cob:18: warning: handling of USAGE NATIONAL is unfinished; implementation is likely to be changed -prog.cob:13: error: 'invalid-1' ANY LENGTH must be PIC X or PIC N -prog.cob:14: error: 'invalid-2' ANY LENGTH must be PIC X or PIC N -prog.cob:15: error: 'invalid-3' ANY LENGTH must be PIC X or PIC N -prog.cob:16: error: 'invalid-4' ANY NUMERIC must be PIC 9 -prog.cob:17: error: 'invalid-5' ANY LENGTH has invalid definition -prog.cob:18: error: 'invalid-6' ANY LENGTH has invalid definition -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/syn_misc.at:5963" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_316 -#AT_START_317 -at_fn_group_banner 317 'syn_misc.at:5977' \ - "VOLATILE clause" " " 2 -at_xfail=no -( - $as_echo "317. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 DATA-COLLECTION. - 03 DATA-ITEMS-A VOLATILE. - 05 DATA-A1 PIC S9(9) BINARY. - 05 DATA-A2 PIC S9(9) BINARY. - 03 VOLATILE. - 05 DATA-FILLER PIC S9(9) BINARY. - 03 DATA-ITEMS-B. - 05 DATA-B1 PIC S9(9). - 05 DATA-B2 PIC S9(9) VOLATILE. - 03 DATA-ITEMS-C. - 05 DATA-C1 PIC S9(9). - 05 DATA-C2 PIC S9(9). - 01 STEP PIC 9(8) BINARY VALUE 0 EXTERNAL VOLATILE. - *01 WRONGY PIC X. - * 88 TESTVAL-A VALUE 'A' VOLATILE. - * 88 TESTVAL-B VOLATILE VALUE 'B'. - LINKAGE SECTION. - 01 XMYREC. - 05 XFLD1 PIC 9(2) VOLATILE. - SCREEN SECTION. - *01 WRONG-SCREEN. - * 05 WRONG-FIELD PIC X VOLATILE. - * - PROCEDURE DIVISION. - MOVE DATA-ITEMS-B TO DATA-ITEMS-C. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/syn_misc.at:6013: \$COMPILE_ONLY -Wno-unfinished prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY -Wno-unfinished prog.cob" "syn_misc.at:6013" -( $at_check_trace; $COMPILE_ONLY -Wno-unfinished prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob:18: warning: initial VALUE clause ignored for EXTERNAL item 'STEP' -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/syn_misc.at:6013" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_317 -#AT_START_318 -at_fn_group_banner 318 'syn_misc.at:6020' \ - "SET SOURCEFORMAT syntax checks" " " 2 -at_xfail=no -( - $as_echo "318. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - *> Valid - $set sourceformat(free) - $SET SOURCEFORMAT"FIXED" - *> Invalid - $SET SOURCEFORMAT"hi!" - $SET SOURCEFORMAT() - $SET sourceformat'mis-matched" -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/syn_misc.at:6033: \$COMPILE_ONLY prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY prog.cob" "syn_misc.at:6033" -( $at_check_trace; $COMPILE_ONLY prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob:6: error: invalid SOURCEFORMAT directive option 'hi!' -prog.cob:7: error: invalid SOURCEFORMAT directive option '' -prog.cob:8: error: syntax error, unexpected Variable, expecting Literal -prog.cob:8: warning: alphanumeric literal has zero length; a SPACE will be assumed -prog.cob:8: error: PROGRAM-ID header missing -prog.cob:8: error: PROCEDURE DIVISION header missing -prog.cob:8: error: syntax error, unexpected Literal -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/syn_misc.at:6033" -$at_failed && at_fn_log_failure -$at_traceon; } - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_318 -#AT_START_319 -at_fn_group_banner 319 'syn_misc.at:6047' \ - "WHEN-COMPILED register in dialect" " " 2 -at_xfail=no -( - $as_echo "319. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - - PROCEDURE DIVISION. - DISPLAY WHEN-COMPILED - . -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/syn_misc.at:6059: \$COMPILE_ONLY -std=cobol2014 prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY -std=cobol2014 prog.cob" "syn_misc.at:6059" -( $at_check_trace; $COMPILE_ONLY -std=cobol2014 prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob:6: error: 'WHEN-COMPILED' is not defined -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/syn_misc.at:6059" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/syn_misc.at:6062: \$COMPILE_ONLY -std=ibm prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY -std=ibm prog.cob" "syn_misc.at:6062" -( $at_check_trace; $COMPILE_ONLY -std=ibm prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/syn_misc.at:6062" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/syn_misc.at:6063: \$COMPILE_ONLY -std=mvs prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY -std=mvs prog.cob" "syn_misc.at:6063" -( $at_check_trace; $COMPILE_ONLY -std=mvs prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/syn_misc.at:6063" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/syn_misc.at:6064: \$COMPILE_ONLY -std=rm prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY -std=rm prog.cob" "syn_misc.at:6064" -( $at_check_trace; $COMPILE_ONLY -std=rm prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/syn_misc.at:6064" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/syn_misc.at:6065: \$COMPILE_ONLY -fregister=WHEN-COMPILED prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY -fregister=WHEN-COMPILED prog.cob" "syn_misc.at:6065" -( $at_check_trace; $COMPILE_ONLY -fregister=WHEN-COMPILED prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/syn_misc.at:6065" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/syn_misc.at:6066: \$COMPILE_ONLY -freserved=WHEN-COMPILED -fregister=WHEN-COMPILED prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY -freserved=WHEN-COMPILED -fregister=WHEN-COMPILED prog.cob" "syn_misc.at:6066" -( $at_check_trace; $COMPILE_ONLY -freserved=WHEN-COMPILED -fregister=WHEN-COMPILED prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/syn_misc.at:6066" -$at_failed && at_fn_log_failure -$at_traceon; } - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_319 -#AT_START_320 -at_fn_group_banner 320 'syn_misc.at:6073' \ - "LIN / COL register" " " 2 -at_xfail=no -( - $as_echo "320. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - - PROCEDURE DIVISION. - MOVE 1 TO LIN, COL - . -_ATEOF - - -# "strict" configuration: -{ set +x -$as_echo "$at_srcdir/syn_misc.at:6086: \$COMPILE_ONLY -std=cobol2014 prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY -std=cobol2014 prog.cob" "syn_misc.at:6086" -( $at_check_trace; $COMPILE_ONLY -std=cobol2014 prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob:6: error: 'LIN' is not defined -prog.cob:6: error: syntax error, unexpected COL -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/syn_misc.at:6086" -$at_failed && at_fn_log_failure -$at_traceon; } - -# "lax" configuration: -{ set +x -$as_echo "$at_srcdir/syn_misc.at:6091: \$COMPILE_ONLY -std=acu prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY -std=acu prog.cob" "syn_misc.at:6091" -( $at_check_trace; $COMPILE_ONLY -std=acu prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob:6: error: 'LIN' is not defined -prog.cob:6: error: syntax error, unexpected COL -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/syn_misc.at:6091" -$at_failed && at_fn_log_failure -$at_traceon; } - -# standard configuration: -{ set +x -$as_echo "$at_srcdir/syn_misc.at:6096: \$COMPILE_ONLY prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY prog.cob" "syn_misc.at:6096" -( $at_check_trace; $COMPILE_ONLY prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob:6: error: 'LIN' is not defined -prog.cob:6: error: syntax error, unexpected COL -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/syn_misc.at:6096" -$at_failed && at_fn_log_failure -$at_traceon; } - -# explicit enabled -{ set +x -$as_echo "$at_srcdir/syn_misc.at:6101: \$COMPILE_ONLY -fregister=LIN,COL prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY -fregister=LIN,COL prog.cob" "syn_misc.at:6101" -( $at_check_trace; $COMPILE_ONLY -fregister=LIN,COL prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/syn_misc.at:6101" -$at_failed && at_fn_log_failure -$at_traceon; } - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_320 -#AT_START_321 -at_fn_group_banner 321 'syn_misc.at:6105' \ - "tokens consisting of multiple words" " " 2 -at_xfail=no -( - $as_echo "321. $at_setup_line: testing $at_desc ..." - $at_traceon - -# note: we actually do not check for all possible cases, but two are better than none... - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 test-var pic xx. - 88 endOfFile value '10'. - 01 todo pic xx. - - PROCEDURE DIVISION. - if not endOfFile - display 'all fine' - end-if - if test-var greater or equal todo - display 'still fine' - end-if - . -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/syn_misc.at:6128: \$COMPILE_ONLY prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY prog.cob" "syn_misc.at:6128" -( $at_check_trace; $COMPILE_ONLY prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/syn_misc.at:6128" -$at_failed && at_fn_log_failure -$at_traceon; } - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_321 -#AT_START_322 -at_fn_group_banner 322 'syn_misc.at:6132' \ - "zero-length literals" " " 2 -at_xfail=no -( - $as_echo "322. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 x PIC X. - 01 nat PIC N. - 01 n PIC 9. - - PROCEDURE DIVISION. - MOVE X'' TO x - MOVE H'' TO x - MOVE Z'' TO x - MOVE L'' TO x - MOVE N"" TO nat - MOVE NX'' TO nat - MOVE B"" TO n - MOVE BX"" TO n - . -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/syn_misc.at:6157: \$COMPILE_ONLY prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY prog.cob" "syn_misc.at:6157" -( $at_check_trace; $COMPILE_ONLY prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob:8: warning: handling of USAGE NATIONAL is unfinished; implementation is likely to be changed -prog.cob:12: warning: hexadecimal literal has zero length; X'00' will be assumed -prog.cob:13: error: H literals must contain at least one character -prog.cob:14: error: invalid Z literal: '' -prog.cob:14: error: Z literals must contain at least one character -prog.cob:15: error: invalid L literal: '' -prog.cob:15: error: L literals must contain at least one character -prog.cob:16: warning: national literal has zero length; a SPACE will be assumed -prog.cob:16: warning: handling of national literal is unfinished; implementation is likely to be changed -prog.cob:17: warning: hexadecimal literal has zero length; X'00' will be assumed -prog.cob:18: warning: Boolean literal has zero length; B'0' will be assumed -prog.cob:19: warning: hexadecimal literal has zero length; X'00' will be assumed -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/syn_misc.at:6157" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/syn_misc.at:6171: \$COMPILE_ONLY -fzero-length-literals=error prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY -fzero-length-literals=error prog.cob" "syn_misc.at:6171" -( $at_check_trace; $COMPILE_ONLY -fzero-length-literals=error prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob:8: warning: handling of USAGE NATIONAL is unfinished; implementation is likely to be changed -prog.cob:12: error: zero-length literal used -prog.cob:12: warning: hexadecimal literal has zero length; X'00' will be assumed -prog.cob:13: error: H literals must contain at least one character -prog.cob:14: error: invalid Z literal: '' -prog.cob:14: error: Z literals must contain at least one character -prog.cob:15: error: invalid L literal: '' -prog.cob:15: error: L literals must contain at least one character -prog.cob:16: error: zero-length literal used -prog.cob:16: warning: national literal has zero length; a SPACE will be assumed -prog.cob:16: warning: handling of national literal is unfinished; implementation is likely to be changed -prog.cob:17: error: zero-length literal used -prog.cob:17: warning: hexadecimal literal has zero length; X'00' will be assumed -prog.cob:18: error: zero-length literal used -prog.cob:18: warning: Boolean literal has zero length; B'0' will be assumed -prog.cob:19: error: zero-length literal used -prog.cob:19: warning: hexadecimal literal has zero length; X'00' will be assumed -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/syn_misc.at:6171" -$at_failed && at_fn_log_failure -$at_traceon; } - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_322 -#AT_START_323 -at_fn_group_banner 323 'syn_misc.at:6193' \ - "@OPTIONS parsing" " " 2 -at_xfail=no -( - $as_echo "323. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -# GnuCOBOL currently only skips these, see FR 305 - -cat >valid.cob <<'_ATEOF' - -000100 @OPTIONS NOMAIN,APOST -000200 IDENTIFICATION DIVISION. -000300 PROGRAM-ID. VALID. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/syn_misc.at:6204: \$COMPILE_ONLY valid.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY valid.cob" "syn_misc.at:6204" -( $at_check_trace; $COMPILE_ONLY valid.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "valid.cob:3: warning: ignoring unknown directive: '@OPTIONS' -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/syn_misc.at:6204" -$at_failed && at_fn_log_failure -$at_traceon; } - - -#AT_DATA([invalid.cob], [ -# @OPTIONS ALPHAL(WORD) -# @OPTIONS INITVALUE(100) -# @OPTIONS INITVALUE(F) -# @OPTIONS INITVALUE(AG) -# @OPTIONS BINARY(WORD,MLBON) INITVALUE(00) NOTRUNC -# @OPTIONS INITVALUE(00) -# @OPTIONS NOTRUNC -# @OPTIONS APOST,MAIN -# @OPTIONS THREAD(SINGLE) -# IDENTIFICATION DIVISION. -# PROGRAM-ID. INVALID. -#]) - -#AT_CHECK([$COMPILE_ONLY valid.cob], [0], [], []) -#AT_CHECK([$COMPILE_ONLY invalid.cob], [1], [], -#[invalid.cob:2: warning: unknown @OPTIONS directive 'ALPHAL' -#invalid.cob:3: error: invalid @OPTIONS INITVALUE value '100' -#invalid.cob:4: error: invalid @OPTIONS INITVALUE value 'F' -#invalid.cob:5: error: invalid @OPTIONS INITVALUE value 'AG' -#invalid.cob:6: warning: skipping line after first space -#invalid.cob:7: error: @OPTIONS MAIN conflicts with command line option '-m' -#]) - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_323 -#AT_START_324 -at_fn_group_banner 324 'syn_misc.at:6235' \ - "system routines with wrong number of parameters" "" 2 -at_xfail=no -( - $as_echo "324. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 VAR1 PIC 9. - 01 VAR2 PIC 9. - 01 VAR3 PIC 9. - 01 VAR4 PIC 9. - PROCEDURE DIVISION. - CALL X"91" USING VAR1 VAR2 VAR3 VAR4. - CALL X"91" USING VAR1. - CALL "C$TOUPPER" USING VAR1 VAR2 VAR3. - CALL "CBL_GC_FORK" USING VAR1. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/syn_misc.at:6254: \$COMPILE_ONLY prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY prog.cob" "syn_misc.at:6254" -( $at_check_trace; $COMPILE_ONLY prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob:11: warning: wrong number of CALL parameters for 'X\"91\"', 4 given, 3 expected -prog.cob:12: error: wrong number of CALL parameters for 'X\"91\"', 1 given, 3 expected -prog.cob:13: warning: wrong number of CALL parameters for 'C\$TOUPPER', 3 given, 2 expected -prog.cob:14: warning: wrong number of CALL parameters for 'CBL_GC_FORK', 1 given, 0 expected -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/syn_misc.at:6254" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_324 -#AT_START_325 -at_fn_group_banner 325 'syn_misc.at:6264' \ - "invalid use of condition-name" " " 2 -at_xfail=no -( - $as_echo "325. $at_setup_line: testing $at_desc ..." - $at_traceon - - -# see Bug #543 "level 88 item not checked in all places for STRING" -# and FR #339 -# Note: we actually check much more here, for example special data types -# like HANDLE, see "ACUCOBOL USAGE HANDLE"; -# condition-name is also checked in syn_file.at "WRITE / REWRITE FROM clause" - -cat >prog.cob <<'_ATEOF' - - identification division. - program-id. prog. - data division. - working-storage section. - 77 p usage pointer. - 01 val pic x(10). - 88 val-i1 value 'some'. - 88 val-i2 value 'val'. - 77 val2 pic x(50). - 77 target pic x(50). - 01 vnum pic 9. - 88 vnum-1 value 1. - 88 vnum-2 values 2 thru 5. - 88 vnum-9 value 9. - 01 filler. - 02 tentry pic x occurs 0 to 6 depending on vnum-1. - procedure division. - string val-i1 delimited by size into target - string val2 delimited by val-i2 into target - string val2 delimited by size into val-i1 - with pointer val-i2 - unstring val-i1 into target - unstring val2 delimited by val-i1 into target - unstring val2 into val-i1 - with pointer val-i2 - move val-i1 - to val-i2, tentry (vnum-9) - compute vnum-1 = vnum - compute vnum = vnum-1 / - vnum-2 - go to val-i1 - set p to val-i1 - set p to address of val-i2. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/syn_misc.at:6308: \$COMPILE_ONLY prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY prog.cob" "syn_misc.at:6308" -( $at_check_trace; $COMPILE_ONLY prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob:17: error: condition-name not allowed here: 'vnum-1' -prog.cob:19: error: condition-name not allowed here: 'val-i1' -prog.cob:20: error: condition-name not allowed here: 'val-i2' -prog.cob:21: error: condition-name not allowed here: 'val-i1' -prog.cob:23: error: condition-name not allowed here: 'val-i1' -prog.cob:24: error: condition-name not allowed here: 'val-i1' -prog.cob:25: error: condition-name not allowed here: 'val-i1' -prog.cob:28: error: condition-name not allowed here: 'vnum-9' -prog.cob:27: error: condition-name not allowed here: 'val-i1' -prog.cob:29: error: condition-name not allowed here: 'vnum-1' -prog.cob:30: error: condition-name not allowed here: 'vnum-1' -prog.cob:31: error: condition-name not allowed here: 'vnum-2' -prog.cob:33: error: condition-name not allowed here: 'val-i1' -prog.cob:34: error: condition-name not allowed here: 'val-i2' -prog.cob:32: error: 'val-i1 (MAIN SECTION:)' is not a procedure name -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/syn_misc.at:6308" -$at_failed && at_fn_log_failure -$at_traceon; } - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_325 -#AT_START_326 -at_fn_group_banner 326 'syn_misc.at:6328' \ - "XML GENERATE syntax checks" " " 2 -at_xfail=no -( - $as_echo "326. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 str. - 03 str-1 PIC XX. - 03 str-2 PIC X. - 66 renames-item RENAMES str-1 THRU str-2. - 01 bool-area. - 03 bool-item PIC 1(30) USAGE BIT. - 03 zoned-decimal PIC 99V99 PACKED-DECIMAL. - 01 just-item PIC X(30) JUST. - 01 table-area. - 03 table-entry PIC X(30) OCCURS 2 TIMES. - 01 long-str PIC X(200). - - 01 float-item FLOAT-SHORT. - 01 pic-p-item PIC 99P(3). - - 01 rec. - 03 child-1 PIC X(30). - 03 child-1a REDEFINES child-1 PIC 9(30). - 03 child-2 PIC X(30). - 03 child-3. - 05 child-3-1 PIC X OCCURS 5 TIMES. - - 01 all-filler-rec. - 03 FILLER PIC XXXX. - 03 FILLER PIC 9999. - - 01 invalid-sub-elt-rec. - 03 non-unique-name PIC X. - 03 valid-sub-rec. - 05 non-unique-name PIC X. - 03 bit-item PIC 1 USAGE BIT. - 03 ptr-item USAGE POINTER. - - 01 with-attrs-does-nothing. - 03 FILLER PIC X. - 03 table-elt PIC X OCCURS 2 TIMES. - 03 with-attrs-group. - 05 with-attrs-group-child PIC X. - 03 with-attrs-child PIC X. - - PROCEDURE DIVISION. - *> Receiving area is not alphanumeric or national. - XML GENERATE bool-item FROM str - *> Receiving area is JUSTIFIED RIGHT. - XML GENERATE just-item FROM str - *> Receiving area is subscripted or ref-mod'd. - XML GENERATE table-entry (1) FROM str - XML GENERATE long-str (1:100) FROM str - - *> Input record cannot be function identifier. - XML GENERATE long-str FROM FUNCTION CHAR(4) - *> Input record cannot be ref-mod'd. - XML GENERATE long-str FROM str (2:1) - *> " " is not RENAMES (children may be RENAMES). - XML GENERATE long-str FROM renames-item - *> Non-ignored items of the input record must: - *> * alphabetic, alphanumeric, national, numeric or index. - *> * there must be at least one item. - *> * each non-FILLER name must be unique within the input record. - XML GENERATE long-str FROM invalid-sub-elt-rec *> XXXXXXXXX ptr element is invalid - XML GENERATE long-str FROM all-filler-rec - - *> COUNT IN field must be an integer. - XML GENERATE long-str FROM str COUNT float-item - *> COUNT IN field must not have P in PIC. - XML GENERATE long-str FROM str COUNT pic-p-item - - *> ENCODING codepage must be unsigned integer. - *> If receiving area is national, codepage must be 1200. - *> " " " alphanumeric, codepage must be 1208 or EBCDIC - *> page supported with XML. - - *> WITH ATTRIBUTES, generated immediate children must be - *> * elementary - *> * be non-FILLER - *> * not be OCCURS - *> * not be subject of a TYPE phrase. - XML GENERATE long-str FROM with-attrs-does-nothing - WITH ATTRIBUTES - TYPE OF with-attrs-child IS ELEMENT - - *> NAMESPACE must be a valid URI. - XML GENERATE long-str FROM str NAMESPACE "<>" - *> NAMESPACE and -PREFIX must be alphanumeric or national. - XML GENERATE long-str FROM str - NAMESPACE bool-item NAMESPACE-PREFIX bool-item - *> " " " may not be figurative constants. - XML GENERATE long-str FROM str - NAMESPACE SPACES NAMESPACE-PREFIX QUOTES - *> NAMESPACE-PREFIX must be a valid XML name. - XML GENERATE long-str FROM str - NAMESPACE "http://www.w3.org/xml" NAMESPACE-PREFIX X"00" - - *> NAME items must reference input record or its children. - XML GENERATE long-str FROM rec - NAME OF child-1 IS "c1", long-str IS "c2", rec IS "r" - *> NAME items cannot be reference modified or subscripted. - XML GENERATE long-str FROM rec - NAME OF child-1 (1:2) IS "c1" - *> NAME items may not be ignored by the statement. - XML GENERATE long-str FROM rec - NAME OF child-1a IS "c1a" - *> NAME literals must be valid XML names. - XML GENERATE long-str FROM rec - NAME OF child-1 IS X"00" - - *> TYPE items must be elementary and children of input record. - XML GENERATE long-str FROM rec - TYPE OF child-3 IS ELEMENT, long-str IS CONTENT, - rec IS CONTENT - *> TYPE items cannot be ref-mod'd or subscripted. - XML GENERATE long-str FROM rec - TYPE OF child-1 (1:3) IS ATTRIBUTE, - child-3-1 (1) IS CONTENT - *> TYPE items may not be ignored by the statement - XML GENERATE long-str FROM rec - TYPE OF child-1a IS ELEMENT - *> TYPE ATTRIBUTE items must satisfy the conditions for WITH - *> ATTRIBUTES. (Covered by the above.) - - *> SUPPRESS WHEN items must be: - *> * elementary - *> * not ignored - *> * child of input record. - XML GENERATE long-str FROM rec - SUPPRESS child-3 WHEN SPACES, child-1a WHEN SPACES, - rec WHEN SPACES - *> All SUPPRESS items must not be functions - XML GENERATE long-str FROM rec - SUPPRESS FUNCTION CHAR(5) WHEN SPACE - *> All SUPPRESS items must not be ref-mod'd or subscripted. - XML GENERATE long-str FROM rec - SUPPRESS child-1 (1:3) WHEN ZERO, - child-3-1 (1) WHEN SPACES - *> If non-WHEN SUPPRESS items may be groups. (No error message here.) - XML GENERATE long-str FROM rec SUPPRESS child-3 - *> If SUPPRESS WHEN ZEROES, item is not DISPLAY-1. - *> If SUPPRESS WHEN SPACES, item must be USAGE DISPLAY, DISPLAY-1 or - *> NATIONAL - XML GENERATE long-str FROM bool-area - SUPPRESS bool-item WHEN SPACES - *> If SUPPRESS WHEN LOW-/HIGH-VALUES, item must be USAGE DISPLAY or - *> NATIONAL. If item is a zoned/national decimal item, it must be - *> an integer. - XML GENERATE long-str FROM bool-area - SUPPRESS bool-item WHEN LOW-VALUES, - zoned-decimal WHEN HIGH-VALUE - *> (For generic WHEN phrases, invalid items above are ignored.) - GOBACK. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/syn_misc.at:6488: \$COMPILE_ONLY prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY prog.cob" "syn_misc.at:6488" -( $at_check_trace; $COMPILE_ONLY prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob:12: warning: USAGE BIT is not implemented -prog.cob:37: warning: USAGE BIT is not implemented -prog.cob:49: error: JSON/XML GENERATE receiving item must be alphanumeric or national -prog.cob:51: error: JSON/XML GENERATE receiving item may not have JUSTIFIED clause -prog.cob:53: error: JSON/XML GENERATE receiving item may not be subscripted -prog.cob:54: error: JSON/XML GENERATE receiving item may not be reference modified -prog.cob:57: error: syntax error, unexpected intrinsic function name, expecting Identifier -prog.cob:59: error: JSON/XML GENERATE input record may not be reference modified -prog.cob:61: error: JSON/XML GENERATE input record may not have RENAMES clause -prog.cob:66: error: JSON/XML GENERATE input record has subrecords with non-unique names -prog.cob:67: error: all the children of 'all-filler-rec' are ignored in JSON/XML GENERATE -prog.cob:70: error: COUNT IN item must be numeric and an integer -prog.cob:72: error: COUNT IN item may not have PICTURE with P in it -prog.cob:89: warning: OCCURS items in JSON/XML GENERATE is not implemented -prog.cob:89: warning: WITH ATTRIBUTES specified, but no attributes can be generated -prog.cob:89: error: NAMESPACE must be a valid URI -prog.cob:92: error: NAMESPACE must be alphanumeric or national -prog.cob:92: error: NAMESPACE-PREFIX must be alphanumeric or national -prog.cob:97: error: NAMESPACE may not be a figurative constant -prog.cob:97: error: NAMESPACE-PREFIX may not be a figurative constant -prog.cob:98: error: NAMESPACE-PREFIX must be a valid XML name -prog.cob:104: warning: OCCURS items in JSON/XML GENERATE is not implemented -prog.cob:102: error: NAME OF item must be the input record or a child of it -prog.cob:107: warning: OCCURS items in JSON/XML GENERATE is not implemented -prog.cob:105: error: NAME OF item may not be reference modified -prog.cob:110: warning: OCCURS items in JSON/XML GENERATE is not implemented -prog.cob:108: error: NAME OF item may not be an ignored item in JSON/XML GENERATE -prog.cob:114: warning: OCCURS items in JSON/XML GENERATE is not implemented -prog.cob:111: error: NAME OF name must be a valid XML name -prog.cob:118: warning: OCCURS items in JSON/XML GENERATE is not implemented -prog.cob:115: error: TYPE OF item must be elementary -prog.cob:115: error: TYPE OF item must be a child of the input record -prog.cob:116: error: TYPE OF item must be elementary -prog.cob:116: error: TYPE OF item must be a child of the input record -prog.cob:122: warning: OCCURS items in JSON/XML GENERATE is not implemented -prog.cob:119: error: TYPE OF item may not be reference modified -prog.cob:120: error: TYPE OF item may not be subscripted -prog.cob:131: warning: OCCURS items in JSON/XML GENERATE is not implemented -prog.cob:123: error: TYPE OF item may not be an ignored item in JSON/XML GENERATE -prog.cob:135: warning: OCCURS items in JSON/XML GENERATE is not implemented -prog.cob:133: error: SUPPRESS item with WHEN clause must be elementary -prog.cob:133: error: SUPPRESS item must be a child of the input record -prog.cob:132: error: SUPPRESS item may not be an ignored item in JSON/XML GENERATE -prog.cob:132: error: SUPPRESS item with WHEN clause must be elementary -prog.cob:136: error: syntax error, unexpected intrinsic function name, expecting EVERY or WHEN or Identifier -prog.cob:142: warning: OCCURS items in JSON/XML GENERATE is not implemented -prog.cob:140: error: SUPPRESS item may not be subscripted -prog.cob:139: error: SUPPRESS item may not be reference modified -prog.cob:146: warning: OCCURS items in JSON/XML GENERATE is not implemented -prog.cob:147: error: SUPPRESS WHEN SPACE item must be USAGE DISPLAY or NATIONAL -prog.cob:153: error: SUPPRESS WHEN HIGH-VALUE item must be USAGE DISPLAY or NATIONAL -prog.cob:153: error: SUPPRESS WHEN HIGH-VALUE item must be an integer -prog.cob:152: error: SUPPRESS WHEN LOW-VALUE item must be USAGE DISPLAY or NATIONAL -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/syn_misc.at:6488" -$at_failed && at_fn_log_failure -$at_traceon; } - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_326 -#AT_START_327 -at_fn_group_banner 327 'syn_misc.at:6546' \ - "IBM Data Division" " " 2 -at_xfail=no -( - $as_echo "327. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - CONFIGURATION SECTION. - DATA DIVISION. - WORKING-STORAGE SECTION. - - 01 DATA-SIZE PIC 999. - 01 MY-DATA. - 03 MY-TABLE OCCURS 20 TIMES. - 05 MY-ELEMENT-1 PIC X(10). - 05 MY-ELEMENT-2 PIC 99. - 78 MY-LEN VALUE LENGTH OF MY-DATA. - - 01 TBLX PIC 99 VALUE 5. - 01 ODO-DATA. - 03 ODO-TABLE OCCURS 1 TO 15 TIMES DEPENDING ON TBLX. - 05 ODO-ELEMENT-1 PIC X(10). - 05 ODO-ELEMENT-2 PIC 99. - 78 ODO-LEN VALUE LENGTH OF ODO-DATA. - - PROCEDURE DIVISION. - DISPLAY "MY-LEN is " MY-LEN. - DISPLAY "ODO-LEN is " ODO-LEN. - MOVE LENGTH OF MY-DATA TO DATA-SIZE. - DISPLAY "MY-DATA is " FUNCTION LENGTH (MY-DATA) - " and " DATA-SIZE. - MOVE LENGTH OF MY-ELEMENT-1 TO DATA-SIZE. - DISPLAY "MY-ELEMENT-1 is " FUNCTION LENGTH (MY-ELEMENT-1) - " and " DATA-SIZE. - MOVE LENGTH OF MY-TABLE TO DATA-SIZE. - DISPLAY "MY-TABLE is " LENGTH OF MY-TABLE - " and " DATA-SIZE. - MOVE LENGTH OF MY-TABLE(1) TO DATA-SIZE. - DISPLAY "MY-TABLE(1) is " FUNCTION LENGTH (MY-TABLE(1)) - " and " DATA-SIZE. - - MOVE LENGTH OF ODO-DATA TO DATA-SIZE. - DISPLAY "ODO-DATA a is " FUNCTION LENGTH (ODO-DATA) - " and " DATA-SIZE. - MOVE FUNCTION LENGTH (ODO-DATA) TO DATA-SIZE. - DISPLAY "ODO-DATA b is " LENGTH OF ODO-DATA - " and " DATA-SIZE. - MOVE LENGTH OF ODO-TABLE TO DATA-SIZE. - DISPLAY "ODO-TABLE is " LENGTH OF ODO-TABLE - " and " DATA-SIZE. - MOVE LENGTH OF ODO-TABLE(1) TO DATA-SIZE. - DISPLAY "ODO-TABLE(1) is " FUNCTION LENGTH (ODO-TABLE(1)) - " and " DATA-SIZE. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/syn_misc.at:6602: \$COMPILE_ONLY -std=ibm prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY -std=ibm prog.cob" "syn_misc.at:6602" -( $at_check_trace; $COMPILE_ONLY -std=ibm prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob:21: error: variable length item not allowed here -prog.cob:21: error: constant item 'ODO-LEN' requires a VALUE clause -prog.cob:30: warning: subscript missing for 'MY-ELEMENT-1' - defaulting to 1 -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/syn_misc.at:6602" -$at_failed && at_fn_log_failure -$at_traceon; } - - -{ set +x -$as_echo "$at_srcdir/syn_misc.at:6608: \$COMPILE_ONLY -std=ibm-strict prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY -std=ibm-strict prog.cob" "syn_misc.at:6608" -( $at_check_trace; $COMPILE_ONLY -std=ibm-strict prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob:14: error: LENGTH OF 'MY-DATA' not allowed outside of Procedure Division -prog.cob:14: error: 78 VALUE does not conform to IBM COBOL -prog.cob:14: error: constant item 'MY-LEN' requires a VALUE clause -prog.cob:21: error: LENGTH OF 'ODO-DATA' not allowed outside of Procedure Division -prog.cob:21: error: 78 VALUE does not conform to IBM COBOL -prog.cob:21: error: constant item 'ODO-LEN' requires a VALUE clause -prog.cob:30: error: 'MY-ELEMENT-1' requires one subscript -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/syn_misc.at:6608" -$at_failed && at_fn_log_failure -$at_traceon; } - - -{ set +x -$as_echo "$at_srcdir/syn_misc.at:6618: \$COMPILE_ONLY prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY prog.cob" "syn_misc.at:6618" -( $at_check_trace; $COMPILE_ONLY prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob:21: error: variable length item not allowed here -prog.cob:21: error: constant item 'ODO-LEN' requires a VALUE clause -prog.cob:30: error: 'MY-ELEMENT-1' requires one subscript -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/syn_misc.at:6618" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_327 -#AT_START_328 -at_fn_group_banner 328 'syn_misc.at:6627' \ - "BASED clause, ALLOCATE / FREE statements" " " 2 -at_xfail=no -( - $as_echo "328. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 str. - 03 str-1 PIC XX BASED. - 01 str-2 BASED. - 03 str-2a PIC X SYNC. - 03 str-2b PIC 9. - 01 one PIC XX BASED. - 77 seven PIC 9 BASED. - 77 var PIC 9. - 77 ptr USAGE POINTER. - SCREEN-STORAGE SECTION. - 01 scrn BASED. - 03 scrn-field pic x. - - PROCEDURE DIVISION. - ALLOCATE one - ALLOCATE seven INITIALIZED - ALLOCATE seven CHARACTERS. - ALLOCATE seven CHARACTERS RETURNING ptr. - ALLOCATE 1 + 2 * 3 CHARACTERS RETURNING ptr. - ALLOCATE 1 + one * 3 CHARACTERS RETURNING ptr. - ALLOCATE one CHARACTERS RETURNING ptr. - ALLOCATE seven CHARACTERS INITIALIZED RETURNING ptr. - ALLOCATE var - FREE var - FREE ADDRESS OF var - FREE one - FREE ADDRESS OF seven - MOVE ADDRESS OF seven TO ptr - FREE ptr - GOBACK. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/syn_misc.at:6668: \$COMPILE_ONLY prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY prog.cob" "syn_misc.at:6668" -( $at_check_trace; $COMPILE_ONLY prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob:8: error: BASED only allowed at 01/77 level -prog.cob:16: error: PROCEDURE DIVISION header missing -prog.cob:16: error: syntax error, unexpected Identifier -prog.cob:17: error: unknown statement '01' -prog.cob:18: error: unknown statement '03' -prog.cob:20: error: syntax error, unexpected PROCEDURE -prog.cob:23: error: ALLOCATE CHARACTERS requires RETURNING clause -prog.cob:26: error: 'one' is not a numeric value -prog.cob:27: error: amount must be specified as a numeric expression -prog.cob:29: error: target of ALLOCATE is not a BASED item -prog.cob:30: error: target 1 of FREE is not a BASED data item -prog.cob:31: error: target 1 of FREE is not a BASED data item -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/syn_misc.at:6668" -$at_failed && at_fn_log_failure -$at_traceon; } - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_328 -#AT_START_329 -at_fn_group_banner 329 'syn_misc.at:6685' \ - "CONTINUE statement" " " 2 -at_xfail=no -( - $as_echo "329. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 one PIC X. - 77 seven PIC 9 BASED. - 77 var PIC 9. - 77 ptr USAGE POINTER. - PROCEDURE DIVISION. - CONTINUE - PERFORM VARYING var FROM 1 BY 1 UNTIL var = 4 - CONTINUE - END-PERFORM - CONTINUE AFTER 42 SECONDS *> COBOL 202x - CONTINUE AFTER 4 + 2 SECONDS - CONTINUE AFTER var + 2 SECONDS - CONTINUE AFTER '1' SECONDS - CONTINUE AFTER ptr SECONDS - CONTINUE AFTER one SECONDS - . -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/syn_misc.at:6712: \$COMPILE_ONLY prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY prog.cob" "syn_misc.at:6712" -( $at_check_trace; $COMPILE_ONLY prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob:19: error: amount must be specified as a numeric expression -prog.cob:20: error: amount must be specified as a numeric expression -prog.cob:21: error: amount must be specified as a numeric expression -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/syn_misc.at:6712" -$at_failed && at_fn_log_failure -$at_traceon; } - - -{ set +x -$as_echo "$at_srcdir/syn_misc.at:6718: \$COMPILE_ONLY -std=cobol2014 prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY -std=cobol2014 prog.cob" "syn_misc.at:6718" -( $at_check_trace; $COMPILE_ONLY -std=cobol2014 prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob:16: error: AFTER phrase in CONTINUE statement does not conform to COBOL 2014 -prog.cob:17: error: AFTER phrase in CONTINUE statement does not conform to COBOL 2014 -prog.cob:18: error: AFTER phrase in CONTINUE statement does not conform to COBOL 2014 -prog.cob:19: error: AFTER phrase in CONTINUE statement does not conform to COBOL 2014 -prog.cob:20: error: AFTER phrase in CONTINUE statement does not conform to COBOL 2014 -prog.cob:21: error: AFTER phrase in CONTINUE statement does not conform to COBOL 2014 -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/syn_misc.at:6718" -$at_failed && at_fn_log_failure -$at_traceon; } - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_329 -#AT_START_330 -at_fn_group_banner 330 'syn_misc.at:6729' \ - "conflict markers" " " 2 -at_xfail=no -( - $as_echo "330. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - - DATA DIVISION. - WORKING-STORAGE SECTION. - *> Verify that we report conflict markers correctly -<<<<<<< HEAD - 01 one-1 PIC X. -======= there may be something here - 01 one-2 PIC X. ->>>>>>> some note - *> Verify that we don't have an issue with unmatched conflict markers - 77 var PIC 9. -<<<<<<< HEAD - 01 var2 PIC X. -======= -<<<<<<< HEAD - *> Verify that we only report conflict markers at the start of lines. - <<<<<<< HEAD - 01 one PIC X. - ======= - 01 two PIC 9. - >>>>>>> some note - PROCEDURE DIVISION. - GOBACK. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/syn_misc.at:6760: \$COMPILE_ONLY prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY prog.cob" "syn_misc.at:6760" -( $at_check_trace; $COMPILE_ONLY prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob:8: error: version control conflict marker in file -prog.cob:10: error: version control conflict marker in file -prog.cob:12: error: version control conflict marker in file -prog.cob:15: error: version control conflict marker in file -prog.cob:17: error: version control conflict marker in file -prog.cob:18: error: version control conflict marker in file -prog.cob:20: error: invalid indicator '<' at column 7 -prog.cob:22: error: invalid indicator '=' at column 7 -prog.cob:24: warning: ignoring invalid directive: '>> some' -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/syn_misc.at:6760" -$at_failed && at_fn_log_failure -$at_traceon; } - - -{ set +x -$as_echo "$at_srcdir/syn_misc.at:6772: \$COMPILE_ONLY -free prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY -free prog.cob" "syn_misc.at:6772" -( $at_check_trace; $COMPILE_ONLY -free prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob:8: error: version control conflict marker in file -prog.cob:10: error: version control conflict marker in file -prog.cob:12: error: version control conflict marker in file -prog.cob:15: error: version control conflict marker in file -prog.cob:17: error: version control conflict marker in file -prog.cob:18: error: version control conflict marker in file -prog.cob:24: warning: ignoring invalid directive -prog.cob:20: error: PROCEDURE DIVISION header missing -prog.cob:20: error: syntax error, unexpected < -prog.cob:22: error: syntax error, unexpected = -prog.cob:25: error: syntax error, unexpected PROCEDURE -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/syn_misc.at:6772" -$at_failed && at_fn_log_failure -$at_traceon; } - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_330 -#AT_START_331 -at_fn_group_banner 331 'syn_misc.at:6788' \ - "SORT syntax" " " 2 -at_xfail=no -( - $as_echo "331. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - - ENVIRONMENT DIVISION. - INPUT-OUTPUT SECTION. - FILE-CONTROL. - SELECT SRTFIL ASSIGN TO "SRTFIL" - ORGANIZATION LINE SEQUENTIAL. - SELECT STFILE ASSIGN TO "STFILE" - ORGANIZATION LINE SEQUENTIAL. - - DATA DIVISION. - FILE SECTION. - FD SRTFIL. - 01 SRTREC PIC X(256). - SD STFILE. - 01 STFREC PIC X(256). - - WORKING-STORAGE SECTION. - 01 G VALUE "d4b2e1a3c5". - 02 TBL OCCURS 5. - 03 X PIC X. - 03 Y PIC 9. - 02 TBL-ORD OCCURS 5 ASCENDING YO. - 03 XO PIC X. - 03 YO PIC 9. - - PROCEDURE DIVISION. - SORT TBL ASCENDING KEY X. - SORT TBL DESCENDING. - SORT TBL. - SORT TBL-ORD ASCENDING. - SORT TBL-ORD. - SORT STFILE DESCENDING KEY SRTREC. - SORT STFILE DESCENDING KEY SRTREC USING SRTFIL GIVING SRTFIL. - SORT STFILE ASCENDING. - SORT STFILE. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/syn_misc.at:6832: \$COMPILE_ONLY prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY prog.cob" "syn_misc.at:6832" -( $at_check_trace; $COMPILE_ONLY prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob:32: error: table SORT requires KEY phrase -prog.cob:35: error: file sort requires USING or INPUT PROCEDURE -prog.cob:35: error: file sort requires GIVING or OUTPUT PROCEDURE -prog.cob:37: error: file sort requires KEY phrase -prog.cob:38: error: file sort requires KEY phrase -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/syn_misc.at:6832" -$at_failed && at_fn_log_failure -$at_traceon; } - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_331 -#AT_START_332 -at_fn_group_banner 332 'syn_misc.at:6842' \ - "Group Usage Error" " " 2 -at_xfail=no -( - $as_echo "332. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - CONFIGURATION SECTION. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 TESTRECORD. - 02 TSTGRP3 COMP-3. - 05 GRP3-1. - 10 FILLER PICTURE X(1). - 10 COM3-FLD1 PICTURE S9(4) COMP-4. - 10 FILLER PICTURE X(1). - 10 COM3-FLD2 PICTURE S9(6). - 10 FILLER PICTURE X(1). - 10 COM3-FLD3 PICTURE S9(6) DISPLAY. - 10 FILLER PICTURE X(1). - 05 GRP3-2. - 10 FILLER USAGE COMP-1. - - PROCEDURE DIVISION. - - MOVE ALL 'x' TO TESTRECORD. - MOVE "12345678" TO COM3-FLD1 (1:). - MOVE "12345678" TO COM3-FLD2 (1:). - DISPLAY TESTRECORD. - STOP RUN. - - -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/syn_misc.at:6876: \$COMPILE_ONLY -std=mf -Wno-truncate prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY -std=mf -Wno-truncate prog.cob" "syn_misc.at:6876" -( $at_check_trace; $COMPILE_ONLY -std=mf -Wno-truncate prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob:12: error: TSTGRP3 USAGE COMP-3 incompatible with COM3-FLD1 USAGE COMP -prog.cob:16: error: TSTGRP3 USAGE COMP-3 incompatible with COM3-FLD3 USAGE DISPLAY -prog.cob:19: error: TSTGRP3 USAGE COMP-3 incompatible with FILLER USAGE COMP-1 -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/syn_misc.at:6876" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_332 -#AT_START_333 -at_fn_group_banner 333 'syn_misc.at:6884' \ - "OSVS I/O extensions" " " 2 -at_xfail=no -( - $as_echo "333. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - - ENVIRONMENT DIVISION. - INPUT-OUTPUT SECTION. - FILE-CONTROL. - SELECT f ASSIGN "f.dat" SEQUENTIAL - FILE-LIMITS ARE 1 THRU 10, 100 THRU f-max - TRACK-AREA 100 CHARACTERS - TRACK-LIMIT 5 TRACKS. - SELECT g ASSIGN "g.dat" RELATIVE - RELATIVE KEY g-key - ACTUAL KEY g-actual-key. - - I-O-CONTROL. - APPLY RECORD-OVERFLOW f, g - APPLY CORE-INDEX core-idx ON f - APPLY CYL-INDEX TO 5 ON f - APPLY CYL-OVERFLOW 10 TRACKS f - APPLY EXTENDED-SEARCH g - APPLY MASTER-INDEX TO 5 on g - APPLY WRITE-VERIFY f, g - APPLY REORG-CRITERIA f-rec, f - RERUN ON "g2.dat" EVERY END REEL g - . - DATA DIVISION. - FILE SECTION. - FD f. - 01 f-rec PIC X(100). - - FD g. - 01 g-rec PIC 9(10). - - WORKING-STORAGE SECTION. - 01 core-idx PIC 999. - 01 f-max PIC 9(5) VALUE 1000. - 01 g-key PIC 999. - 01 g-actual-key PIC XXX. - - PROCEDURE DIVISION. - OPEN INPUT f DISP, INPUT g REREAD - . -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/syn_misc.at:6932: \$COMPILE_ONLY prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY prog.cob" "syn_misc.at:6932" -( $at_check_trace; $COMPILE_ONLY prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob:10: warning: FILE-LIMIT is obsolete in GnuCOBOL -prog.cob:10: warning: TRACK-AREA is obsolete in GnuCOBOL -prog.cob:11: warning: TRACK-LIMIT is obsolete in GnuCOBOL -prog.cob:14: warning: ACTUAL KEY is obsolete in GnuCOBOL -prog.cob:18: warning: DOS/VS APPLY phrase is obsolete in GnuCOBOL -prog.cob:19: warning: DOS/VS APPLY phrase is obsolete in GnuCOBOL -prog.cob:20: warning: DOS/VS APPLY phrase is obsolete in GnuCOBOL -prog.cob:21: warning: DOS/VS APPLY phrase is obsolete in GnuCOBOL -prog.cob:22: warning: DOS/VS APPLY phrase is obsolete in GnuCOBOL -prog.cob:23: warning: DOS/VS APPLY phrase is obsolete in GnuCOBOL -prog.cob:24: warning: DOS/VS APPLY phrase is obsolete in GnuCOBOL -prog.cob:25: warning: DOS/VS APPLY phrase is obsolete in GnuCOBOL -prog.cob:42: warning: OPEN LEAVE/REREAD/DISP is obsolete in GnuCOBOL -prog.cob:42: warning: OPEN LEAVE/REREAD/DISP is obsolete in GnuCOBOL -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/syn_misc.at:6932" -$at_failed && at_fn_log_failure -$at_traceon; } - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_333 -#AT_START_334 -at_fn_group_banner 334 'syn_misc.at:6951' \ - "very long literal in error message" " " 2 -at_xfail=no -( - $as_echo "334. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. tutorial. - PROCEDURE DIVISION. - move low-values to - 'vove length of ex-keydef to key2length'- - 'move 1 to key-count'- - 'vove length of ex-keydef to key2length'- - 'move 1 to key-count'- - 'vove length of ex-keydef to key2length'- - 'move 1 to key-count'- - 'vove length of ex-keydef to key2length'- - 'move 1 to key-count'- - 'vove length of ex-keydef to key2length'- - 'move 1 to key-count'- - 'vove length of ex-keydef to key2length'- - 'move 1 to key-count'- - 'vove length of ex-keydef to key2length'- - 'move 1 to key-count'- - 'vove length of ex-keydef to key2length'- - 'move 1 to key-count'- - 'vove length of ex-keydef to key2length'- - 'move 1 to key-count'- - 'vove length of ex-keydef to key2length'- - 'move 1 to key-count'- - 'vove length of ex-keydef to key2length'- - 'move 1 to key-count'- - 'vove length of ex-keydef to key2length'- - 'move 1 to key-count'- - 'vove length of ex-keydef to key2length'- - 'move 1 to key-count'- - 'vove length of ex-keydef to key2length'- - 'move 1 to key-count'- - 'vove length of ex-keydef to key2length'- - 'move 1 to key-count'- - 'vove length of ex-keydef to key2length'- - 'move 1 to key-count'- - 'vove length of ex-keydef to key2length'- - 'move 1 to key-count'- - 'vove length of ex-keydef to key2length'- - 'move 1 to key-count'- - 'vove length of ex-keydef to key2length'- - 'move 1 to key-count'- - 'vove length of ex-keydef to key2length'- - 'move 1 to key-count'- - 'vove length of ex-keydef to key2length'- - 'move 1 to key-count'- - 'vove length of ex-keydef to key2length'- - 'move 1 to key-count'- - 'vove length of ex-keydef to key2length'- - 'move 1 to key-count'- - 'vove length of ex-keydef to key2length'- - 'move 1 to key-count'- - 'vove length of ex-keydef to key2length'- - 'move 1 to key-count'- - 'vove length of ex-keydef to key2length'- - 'move 1 to key-count'- - 'vove length of ex-keydef to key2length'- - 'move 1 to key-count'- - 'vove length of ex-keydef to key2length'- - 'move 1 to key-count'- - 'vove length of ex-keydef to key2length'- - 'move 1 to key-count'- - 'vove length of ex-keydef to key2length'- - 'move 1 to key-count'- - 'vove length of ex-keydef to key2length'- - 'move 1 to key-count'- - 'vove length of ex-keydef to key2length'- - 'move 1 to key-count'- - 'vove length of ex-keydef to key2length'- - 'move 1 to key-count'- - 'vove length of ex-keydef to key2length'- - 'move 1 to key-count'- - 'vove length of ex-keydef to key2length'- - 'move 1 to key-countaaaaaaaaaaaaaaaaaaa'- - 'aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/syn_misc.at:7032: \$COMPILE_ONLY prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY prog.cob" "syn_misc.at:7032" -( $at_check_trace; $COMPILE_ONLY prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob:5: error: invalid MOVE target: literal 'vove length of ex-keydef to key2len...' -prog.cob:76: error: syntax error, unexpected end of file -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/syn_misc.at:7032" -$at_failed && at_fn_log_failure -$at_traceon; } - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_334 -#AT_START_335 -at_fn_group_banner 335 'syn_move.at:37' \ - "MOVE SPACE TO numeric or numeric-edited item" " " 2 -at_xfail=no -( - $as_echo "335. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 X PIC 9. - 01 Y PIC 09. - PROCEDURE DIVISION. - MOVE SPACE TO X. - MOVE SPACE TO Y. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/syn_move.at:53: \$COMPILE_ONLY prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY prog.cob" "syn_move.at:53" -( $at_check_trace; $COMPILE_ONLY prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob:9: error: MOVE of figurative constant SPACE to numeric item used -prog.cob:10: error: MOVE of figurative constant SPACE to numeric item used -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/syn_move.at:53" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_335 -#AT_START_336 -at_fn_group_banner 336 'syn_move.at:63' \ - "MOVE ZERO TO alphabetic item" " " 2 -at_xfail=no -( - $as_echo "336. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 A PIC A. - PROCEDURE DIVISION. - MOVE ZERO TO A. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/syn_move.at:77: \$COMPILE_ONLY prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY prog.cob" "syn_move.at:77" -( $at_check_trace; $COMPILE_ONLY prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob:8: error: invalid MOVE statement -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/syn_move.at:77" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_336 -#AT_START_337 -at_fn_group_banner 337 'syn_move.at:89' \ - "MOVE alphabetic TO x" " " 2 -at_xfail=no -( - $as_echo "337. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 X PIC A. - 01 Y-A PIC A. - 01 Y-X PIC X. - 01 Y-BX PIC BX. - 01 Y-9 PIC 9. - 01 Y-09 PIC 09. - PROCEDURE DIVISION. - MOVE X TO Y-A. - MOVE X TO Y-X. - MOVE X TO Y-BX. - MOVE X TO Y-9. - MOVE X TO Y-09. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/syn_move.at:112: \$COMPILE_ONLY prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY prog.cob" "syn_move.at:112" -( $at_check_trace; $COMPILE_ONLY prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob:16: error: invalid MOVE statement -prog.cob:17: error: invalid MOVE statement -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/syn_move.at:112" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_337 -#AT_START_338 -at_fn_group_banner 338 'syn_move.at:120' \ - "MOVE alphanumeric TO x" " " 2 -at_xfail=no -( - $as_echo "338. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 X PIC X. - 01 Y-A PIC A. - 01 Y-X PIC X. - 01 Y-BX PIC BX. - 01 Y-9 PIC 9. - 01 Y-09 PIC 09. - PROCEDURE DIVISION. - MOVE X TO Y-A. - MOVE X TO Y-X. - MOVE X TO Y-BX. - MOVE X TO Y-9. - MOVE X TO Y-09. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/syn_move.at:143: \$COMPILE_ONLY prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY prog.cob" "syn_move.at:143" -( $at_check_trace; $COMPILE_ONLY prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/syn_move.at:143" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_338 -#AT_START_339 -at_fn_group_banner 339 'syn_move.at:148' \ - "MOVE alphanumeric-edited TO x" " " 2 -at_xfail=no -( - $as_echo "339. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 X PIC BX. - 01 Y-A PIC A. - 01 Y-X PIC X. - 01 Y-BX PIC BX. - 01 Y-9 PIC 9. - 01 Y-09 PIC 09. - PROCEDURE DIVISION. - MOVE X TO Y-A. - MOVE X TO Y-X. - MOVE X TO Y-BX. - MOVE X TO Y-9. - MOVE X TO Y-09. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/syn_move.at:171: \$COMPILE_ONLY prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY prog.cob" "syn_move.at:171" -( $at_check_trace; $COMPILE_ONLY prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob:16: error: invalid MOVE statement -prog.cob:17: error: invalid MOVE statement -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/syn_move.at:171" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_339 -#AT_START_340 -at_fn_group_banner 340 'syn_move.at:179' \ - "MOVE numeric (integer) TO x" " " 2 -at_xfail=no -( - $as_echo "340. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 X PIC 9. - 01 Y-A PIC A. - 01 Y-X PIC X. - 01 Y-BX PIC BX. - 01 Y-9 PIC 9. - 01 Y-09 PIC 09. - PROCEDURE DIVISION. - MOVE X TO Y-A. - MOVE X TO Y-X. - MOVE X TO Y-BX. - MOVE X TO Y-9. - MOVE X TO Y-09. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/syn_move.at:202: \$COMPILE_ONLY prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY prog.cob" "syn_move.at:202" -( $at_check_trace; $COMPILE_ONLY prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob:13: error: invalid MOVE statement -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/syn_move.at:202" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_340 -#AT_START_341 -at_fn_group_banner 341 'syn_move.at:209' \ - "MOVE numeric (non-integer) TO x" " " 2 -at_xfail=no -( - $as_echo "341. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 X PIC 9V9. - 01 Y-A PIC A. - 01 Y-X PIC X. - 01 Y-BX PIC BX. - 01 Y-9 PIC 9. - 01 Y-09 PIC 09. - PROCEDURE DIVISION. - MOVE X TO Y-A. - MOVE X TO Y-X. - MOVE X TO Y-BX. - MOVE X TO Y-9. - MOVE X TO Y-09. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/syn_move.at:232: \$COMPILE_ONLY prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY prog.cob" "syn_move.at:232" -( $at_check_trace; $COMPILE_ONLY prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob:13: error: invalid MOVE statement -prog.cob:14: error: invalid MOVE statement -prog.cob:15: error: invalid MOVE statement -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/syn_move.at:232" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_341 -#AT_START_342 -at_fn_group_banner 342 'syn_move.at:241' \ - "MOVE numeric-edited TO x" " " 2 -at_xfail=no -( - $as_echo "342. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 X PIC 09. - 01 Y-A PIC A. - 01 Y-X PIC X. - 01 Y-BX PIC BX. - 01 Y-9 PIC 9. - 01 Y-09 PIC 09. - PROCEDURE DIVISION. - MOVE X TO Y-A. - MOVE X TO Y-X. - MOVE X TO Y-BX. - MOVE X TO Y-9. - MOVE X TO Y-09. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/syn_move.at:264: \$COMPILE_ONLY prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY prog.cob" "syn_move.at:264" -( $at_check_trace; $COMPILE_ONLY prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob:13: error: invalid MOVE statement -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/syn_move.at:264" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_342 -#AT_START_343 -at_fn_group_banner 343 'syn_move.at:276' \ - "CORRESPONDING - Operands must be groups" " " 2 -at_xfail=no -( - $as_echo "343. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 G-1. - 02 X PIC X. - 01 G-2. - 02 Y PIC X. - PROCEDURE DIVISION. - MOVE CORR X TO G-1. - MOVE CORR G-1 TO X. - MOVE CORR G-1(1:1) TO G-2. - MOVE CORR G-1 TO G-2(1:1). - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/syn_move.at:296: \$COMPILE_ONLY prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY prog.cob" "syn_move.at:296" -( $at_check_trace; $COMPILE_ONLY prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob:11: error: 'X' is not a group name -prog.cob:12: error: 'X' is not a group name -prog.cob:13: error: 'G-1 (1:1)' is not a group name -prog.cob:14: error: 'G-2 (1:1)' is not a group name -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/syn_move.at:296" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_343 -#AT_START_344 -at_fn_group_banner 344 'syn_move.at:306' \ - "CORRESPONDING - Target has no matching items" " " 2 -at_xfail=no -( - $as_echo "344. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 G-1. - 02 X PIC X. - 01 G-2. - 02 Y PIC X. - PROCEDURE DIVISION. - MOVE CORR G-1 TO G-2. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/syn_move.at:323: \$COMPILE_ONLY prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY prog.cob" "syn_move.at:323" -( $at_check_trace; $COMPILE_ONLY prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob:11: warning: no CORRESPONDING items found -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/syn_move.at:323" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_344 -#AT_START_345 -at_fn_group_banner 345 'syn_move.at:332' \ - "MOVE to erroneous field" " " 2 -at_xfail=no -( - $as_echo "345. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 INVALID-ITEM. - 01 I PIC 9(3). - PROCEDURE DIVISION. - MOVE 1 TO INVALID-ITEM. - MOVE SPACE TO I(1:2). - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/syn_move.at:348: \$COMPILE_ONLY prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY prog.cob" "syn_move.at:348" -( $at_check_trace; $COMPILE_ONLY prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob:6: error: PICTURE clause required for 'INVALID-ITEM' -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/syn_move.at:348" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_345 -#AT_START_346 -at_fn_group_banner 346 'syn_move.at:355' \ - "Overlapping MOVE" " " 2 -at_xfail=no -( - $as_echo "346. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 STRUCTURE1. - 05 FIELD1-1 PIC X(5). - 05 FIELD1-2 PIC X(10). - 01 STRUCTURE2 REDEFINES STRUCTURE1. - 05 FIELD2-1 PIC X(10). - 05 FIELD2-2 PIC X(5). - 01 FILLER REDEFINES STRUCTURE1. - 05 FILLER PIC X(01). - 05 FIELD PIC X(02) OCCURS 7. - 01 FILLER. - 05 FIELDO PIC X(02) OCCURS 7. - 77 NUMVAR PIC 9(02) VALUE 1. - 78 CONST4 VALUE 4. - PROCEDURE DIVISION. - MOVE FIELD1-2 TO STRUCTURE1 - MOVE FIELD1-2 TO FIELD1-1 - MOVE FIELD1-1 TO FIELD1-2, FIELD2-2 - MOVE FIELD1-2 TO FIELD2-1 - MOVE FIELD2-1 TO FIELD2-2 - MOVE FIELD2-1 (2:5) TO FIELD1-2 - MOVE STRUCTURE1 (2:4) TO STRUCTURE1 (5:4) - MOVE STRUCTURE1 (2:4) TO STRUCTURE1 (6:4) - MOVE STRUCTURE1 (1:NUMVAR) TO STRUCTURE1 (3:13) - MOVE STRUCTURE1 (NUMVAR:1) TO STRUCTURE1 (3:13) - MOVE STRUCTURE1 (3:13) TO STRUCTURE1 (1:NUMVAR) - MOVE STRUCTURE1 (3:13) TO STRUCTURE1 (NUMVAR:1) - MOVE STRUCTURE1 (CONST4:2) TO STRUCTURE1 (3:2) - MOVE STRUCTURE1 (6:4) TO STRUCTURE1 (2:4) - MOVE STRUCTURE1 (6:4) TO STRUCTURE1 (2: ) - MOVE FIELD (6) TO STRUCTURE1 (13:2) - MOVE FIELD (5) TO STRUCTURE1 (13:2) - MOVE FIELD (NUMVAR) TO STRUCTURE1 (13:2) - MOVE FIELD (CONST4) TO STRUCTURE1 (13:2) - MOVE FIELDO (1) TO FIELDO (1) - MOVE FIELDO (CONST4) TO FIELDO (CONST4) - MOVE FIELDO (1) TO FIELDO (2) - MOVE FIELDO (4) TO FIELDO (CONST4) - MOVE FIELDO (CONST4) TO FIELDO (4) - MOVE FIELDO (4) TO FIELDO (NUMVAR) - MOVE FIELDO (NUMVAR) TO FIELDO (4) - MOVE FIELDO (NUMVAR) TO FIELDO (NUMVAR) - MOVE FIELDO (NUMVAR) (1:1) TO FIELDO (NUMVAR) (2:1) - MOVE FIELDO (NUMVAR) (2:1) TO FIELDO (NUMVAR) - MOVE FIELDO (4) (2:1) TO FIELDO (CONST4) - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/syn_move.at:410: \$COMPILE -w prog.cob" -at_fn_check_prepare_dynamic "$COMPILE -w prog.cob" "syn_move.at:410" -( $at_check_trace; $COMPILE -w prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/syn_move.at:410" -$at_failed && at_fn_log_failure -$at_traceon; } - - -{ set +x -$as_echo "$at_srcdir/syn_move.at:412: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "syn_move.at:412" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob:20: warning: overlapping MOVE may produce unpredictable results -prog.cob:23: warning: overlapping MOVE may produce unpredictable results -prog.cob:25: warning: overlapping MOVE may produce unpredictable results -prog.cob:26: warning: overlapping MOVE may produce unpredictable results -prog.cob:32: warning: overlapping MOVE may produce unpredictable results -prog.cob:34: warning: overlapping MOVE may produce unpredictable results -prog.cob:39: warning: overlapping MOVE may produce unpredictable results -prog.cob:40: warning: overlapping MOVE may produce unpredictable results -prog.cob:42: warning: overlapping MOVE may produce unpredictable results -prog.cob:43: warning: overlapping MOVE may produce unpredictable results -prog.cob:46: warning: overlapping MOVE may produce unpredictable results -prog.cob:48: warning: overlapping MOVE may produce unpredictable results -prog.cob:49: warning: overlapping MOVE may produce unpredictable results -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/syn_move.at:412" -$at_failed && at_fn_log_failure -$at_traceon; } - - -{ set +x -$as_echo "$at_srcdir/syn_move.at:428: \$COMPILE -Wpossible-overlap prog.cob" -at_fn_check_prepare_dynamic "$COMPILE -Wpossible-overlap prog.cob" "syn_move.at:428" -( $at_check_trace; $COMPILE -Wpossible-overlap prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob:20: warning: overlapping MOVE may produce unpredictable results -prog.cob:23: warning: overlapping MOVE may produce unpredictable results -prog.cob:25: warning: overlapping MOVE may produce unpredictable results -prog.cob:26: warning: overlapping MOVE may produce unpredictable results -prog.cob:28: warning: overlapping MOVE may occur and produce unpredictable results -prog.cob:29: warning: overlapping MOVE may occur and produce unpredictable results -prog.cob:30: warning: overlapping MOVE may occur and produce unpredictable results -prog.cob:31: warning: overlapping MOVE may occur and produce unpredictable results -prog.cob:32: warning: overlapping MOVE may produce unpredictable results -prog.cob:34: warning: overlapping MOVE may produce unpredictable results -prog.cob:39: warning: overlapping MOVE may produce unpredictable results -prog.cob:40: warning: overlapping MOVE may produce unpredictable results -prog.cob:42: warning: overlapping MOVE may produce unpredictable results -prog.cob:43: warning: overlapping MOVE may produce unpredictable results -prog.cob:46: warning: overlapping MOVE may produce unpredictable results -prog.cob:48: warning: overlapping MOVE may produce unpredictable results -prog.cob:49: warning: overlapping MOVE may produce unpredictable results -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/syn_move.at:428" -$at_failed && at_fn_log_failure -$at_traceon; } - -# special case: for GnuCOBOL the result is predictable, -# therefore maybe test in run_misc we have the expected result -# AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [], []) - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_346 -#AT_START_347 -at_fn_group_banner 347 'syn_move.at:454' \ - "invalid source for MOVE" " " 2 -at_xfail=no -( - $as_echo "347. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - CONFIGURATION SECTION. - REPOSITORY. - PROGRAM repo-prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 77 MAIN-VAR PIC X(3). - PROCEDURE DIVISION. - MAIN. - MOVE MAIN TO MAIN-VAR. - MOVE repo-prog TO MAIN. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/syn_move.at:474: \$COMPILE_ONLY prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY prog.cob" "syn_move.at:474" -( $at_check_trace; $COMPILE_ONLY prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob:7: warning: no definition/prototype seen for PROGRAM 'repo-prog' -prog.cob: in paragraph 'MAIN': -prog.cob:13: error: 'MAIN' is not a field -prog.cob:14: error: 'repo-prog' is not a field -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/syn_move.at:474" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_347 -#AT_START_348 -at_fn_group_banner 348 'syn_move.at:484' \ - "invalid target for MOVE" " " 2 -at_xfail=no -( - $as_echo "348. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - CONFIGURATION SECTION. - REPOSITORY. - PROGRAM repo-prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 78 DEFINED-CONST VALUE 'A'. - 77 MAIN-VAR PIC X(3). - PROCEDURE DIVISION. - MAIN. - MOVE 'A' TO MAIN-VAR. - MOVE 'B' TO MAIN. - MOVE 'C' TO repo-prog. - MOVE 'D' TO QUOTE. - MOVE 'E' TO DEFINED-CONST. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/syn_move.at:508: \$COMPILE_ONLY prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY prog.cob" "syn_move.at:508" -( $at_check_trace; $COMPILE_ONLY prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob:7: warning: no definition/prototype seen for PROGRAM 'repo-prog' -prog.cob: in paragraph 'MAIN': -prog.cob:15: error: invalid MOVE target: MAIN -prog.cob:16: error: invalid MOVE target: repo-prog -prog.cob:17: error: invalid MOVE target: QUOTE -prog.cob:18: error: invalid MOVE target: literal 'A' -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/syn_move.at:508" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_348 -#AT_START_349 -at_fn_group_banner 349 'syn_move.at:520' \ - "SET error" " " 2 -at_xfail=no -( - $as_echo "349. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - program-id. prog. - data division. - working-storage section. - 01 default-float usage float-long. - 01 no-pointer pic s9(9) comp. - - linkage section. - 01 float-var usage float-long. - - procedure division . - *> previously generated error message about invalid MOVE statement, - *> see bug #255 and an internal compiler error, see bug #295: - set address of float-var to default-float - set no-pointer to address of default-float - *> all fine... - set address of float-var to address of default-float - goback. - end program prog . -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/syn_move.at:544: \$COMPILE_ONLY prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY prog.cob" "syn_move.at:544" -( $at_check_trace; $COMPILE_ONLY prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob:14: error: invalid SET statement -prog.cob:15: error: invalid SET statement -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/syn_move.at:544" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_349 -#AT_START_350 -at_fn_group_banner 350 'syn_move.at:552' \ - "MOVE FIGURATIVE to NUMERIC" " " 2 -at_xfail=no -( - $as_echo "350. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 MYFLD PIC 9(4) VALUE 96. - 01 BIGFLT COMP-1 VALUE 543.12345E10. - PROCEDURE DIVISION. - MAIN-1. - MOVE BIGFLT TO MYFLD. - MOVE SPACES TO MYFLD. - MOVE LOW-VALUES TO MYFLD. - MOVE HIGH-VALUES TO MYFLD. - MOVE QUOTE TO MYFLD. - MOVE ALL '*' TO MYFLD. - MOVE ALL '0' TO MYFLD. - MOVE ALL 'A1' TO MYFLD. - MOVE ALL '21' TO MYFLD. - SET MYFLD TO HIGH-VALUES. - SET MYFLD TO SPACES. - MOVE HIGH-VALUES TO MYFLD (1:). - - MOVE HIGH-VALUES TO BIGFLT. - MOVE QUOTE TO BIGFLT. - MOVE ALL '*' TO BIGFLT. - MOVE ALL '21' TO BIGFLT. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/syn_move.at:584: \$COMPILE_ONLY -std=cobol2002 -freserved=COMP-1:FLOAT prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY -std=cobol2002 -freserved=COMP-1:FLOAT prog.cob" "syn_move.at:584" -( $at_check_trace; $COMPILE_ONLY -std=cobol2002 -freserved=COMP-1:FLOAT prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob: in paragraph 'MAIN-1': -prog.cob:11: error: MOVE of figurative constant SPACE to numeric item used -prog.cob:12: warning: MOVE of figurative constant to numeric item is archaic in COBOL 2002 -prog.cob:13: warning: MOVE of figurative constant to numeric item is archaic in COBOL 2002 -prog.cob:14: warning: MOVE of figurative constant QUOTE to numeric item is archaic in COBOL 2002 -prog.cob:15: warning: numeric value is expected -prog.cob:6: warning: 'MYFLD' defined here as PIC 9(4) -prog.cob:17: warning: numeric value is expected -prog.cob:6: warning: 'MYFLD' defined here as PIC 9(4) -prog.cob:19: error: invalid SET statement -prog.cob:20: error: invalid SET statement -prog.cob:23: warning: MOVE of figurative constant to numeric item is archaic in COBOL 2002 -prog.cob:24: warning: MOVE of figurative constant QUOTE to numeric item is archaic in COBOL 2002 -prog.cob:25: warning: numeric value is expected -prog.cob:7: warning: 'BIGFLT' defined here as USAGE FLOAT -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/syn_move.at:584" -$at_failed && at_fn_log_failure -$at_traceon; } - - -{ set +x -$as_echo "$at_srcdir/syn_move.at:602: \$COMPILE_ONLY -std=ibm prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY -std=ibm prog.cob" "syn_move.at:602" -( $at_check_trace; $COMPILE_ONLY -std=ibm prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob: in paragraph 'MAIN-1': -prog.cob:11: error: MOVE of figurative constant SPACE to numeric item used -prog.cob:12: warning: MOVE of figurative constant to numeric item is archaic in IBM COBOL (lax) -prog.cob:13: warning: MOVE of figurative constant to numeric item is archaic in IBM COBOL (lax) -prog.cob:14: warning: MOVE of figurative constant QUOTE to numeric item is archaic in IBM COBOL (lax) -prog.cob:15: warning: numeric value is expected -prog.cob:6: warning: 'MYFLD' defined here as PIC 9(4) -prog.cob:17: warning: numeric value is expected -prog.cob:6: warning: 'MYFLD' defined here as PIC 9(4) -prog.cob:19: error: invalid SET statement -prog.cob:20: error: invalid SET statement -prog.cob:23: warning: MOVE of figurative constant to numeric item is archaic in IBM COBOL (lax) -prog.cob:24: warning: MOVE of figurative constant QUOTE to numeric item is archaic in IBM COBOL (lax) -prog.cob:25: warning: numeric value is expected -prog.cob:7: warning: 'BIGFLT' defined here as USAGE FLOAT -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/syn_move.at:602" -$at_failed && at_fn_log_failure -$at_traceon; } - - -{ set +x -$as_echo "$at_srcdir/syn_move.at:620: \$COMPILE_ONLY -std=mf prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY -std=mf prog.cob" "syn_move.at:620" -( $at_check_trace; $COMPILE_ONLY -std=mf prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob: in paragraph 'MAIN-1': -prog.cob:11: warning: source is non-numeric - substituting zero -prog.cob:12: warning: source is non-numeric - substituting zero -prog.cob:13: warning: source is non-numeric - substituting zero -prog.cob:14: warning: source is non-numeric - substituting zero -prog.cob:15: warning: source is non-numeric - substituting zero -prog.cob:17: warning: source is non-numeric - substituting zero -prog.cob:19: error: invalid SET statement -prog.cob:20: error: invalid SET statement -prog.cob:23: warning: source is non-numeric - substituting zero -prog.cob:24: warning: source is non-numeric - substituting zero -prog.cob:25: warning: source is non-numeric - substituting zero -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/syn_move.at:620" -$at_failed && at_fn_log_failure -$at_traceon; } - - -{ set +x -$as_echo "$at_srcdir/syn_move.at:635: \$COMPILE_ONLY prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY prog.cob" "syn_move.at:635" -( $at_check_trace; $COMPILE_ONLY prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob: in paragraph 'MAIN-1': -prog.cob:11: error: MOVE of figurative constant SPACE to numeric item used -prog.cob:12: warning: MOVE of figurative constant to numeric item is archaic in GnuCOBOL -prog.cob:13: warning: MOVE of figurative constant to numeric item is archaic in GnuCOBOL -prog.cob:14: warning: MOVE of figurative constant QUOTE to numeric item is obsolete in GnuCOBOL -prog.cob:14: warning: MOVE of figurative constant to numeric item is archaic in GnuCOBOL -prog.cob:15: warning: numeric value is expected -prog.cob:6: warning: 'MYFLD' defined here as PIC 9(4) -prog.cob:17: warning: numeric value is expected -prog.cob:6: warning: 'MYFLD' defined here as PIC 9(4) -prog.cob:19: error: invalid SET statement -prog.cob:20: error: invalid SET statement -prog.cob:23: warning: MOVE of figurative constant to numeric item is archaic in GnuCOBOL -prog.cob:24: warning: MOVE of figurative constant QUOTE to numeric item is obsolete in GnuCOBOL -prog.cob:24: warning: MOVE of figurative constant to numeric item is archaic in GnuCOBOL -prog.cob:25: warning: numeric value is expected -prog.cob:7: warning: 'BIGFLT' defined here as USAGE FLOAT -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/syn_move.at:635" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_350 -#AT_START_351 -at_fn_group_banner 351 'syn_multiply.at:28' \ - "Category check of Format 1" " " 2 -at_xfail=no -( - $as_echo "351. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 X-X PIC X. - 01 X-9 PIC 9. - 01 X-09 PIC 09. - PROCEDURE DIVISION. - MULTIPLY 123 BY 456 - MULTIPLY "a" BY "b" - MULTIPLY 123 BY "b" - MULTIPLY X-X BY X-9 - MULTIPLY X-9 BY X-09 - MULTIPLY X-09 BY X-X - MULTIPLY 123 BY X-X - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/syn_multiply.at:50: \$COMPILE_ONLY prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY prog.cob" "syn_multiply.at:50" -( $at_check_trace; $COMPILE_ONLY prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob:10: error: '456' is not a numeric name -prog.cob:11: error: '\"a\"' is not a numeric value -prog.cob:12: error: '\"b\"' is not a numeric name -prog.cob:13: error: 'X-X' is not a numeric value -prog.cob:14: error: 'X-09' is not a numeric name -prog.cob:15: error: 'X-09' is not a numeric value -prog.cob:16: error: 'X-X' is not a numeric name -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/syn_multiply.at:50" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_351 -#AT_START_352 -at_fn_group_banner 352 'syn_multiply.at:64' \ - "Category check of Format 2" " " 2 -at_xfail=no -( - $as_echo "352. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 X-X PIC X. - 01 X-9 PIC 9. - 01 X-09 PIC 09. - PROCEDURE DIVISION. - MULTIPLY 123 BY 456 GIVING 789 - MULTIPLY "a" BY "b" GIVING "c" - MULTIPLY 123 BY 456 GIVING "c" - MULTIPLY X-X BY X-9 GIVING X-09 - MULTIPLY X-9 BY X-09 GIVING X-X - MULTIPLY 123 BY 456 GIVING X-X - MULTIPLY X-09 BY X-X GIVING X-9 - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/syn_multiply.at:86: \$COMPILE_ONLY prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY prog.cob" "syn_multiply.at:86" -( $at_check_trace; $COMPILE_ONLY prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob:10: error: '789' is not a numeric or numeric-edited name -prog.cob:11: error: '\"a\"' is not a numeric value -prog.cob:11: error: '\"b\"' is not a numeric value -prog.cob:12: error: '\"c\"' is not a numeric or numeric-edited name -prog.cob:13: error: 'X-X' is not a numeric value -prog.cob:14: error: 'X-09' is not a numeric value -prog.cob:15: error: 'X-X' is not a numeric or numeric-edited name -prog.cob:16: error: 'X-09' is not a numeric value -prog.cob:16: error: 'X-X' is not a numeric value -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/syn_multiply.at:86" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_352 -#AT_START_353 -at_fn_group_banner 353 'syn_multiply.at:102' \ - "Category check of literals" " " 2 -at_xfail=no -( - $as_echo "353. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 X PIC 9. - PROCEDURE DIVISION. - MULTIPLY 123 BY X - END-MULTIPLY. - MULTIPLY "a" BY X - END-MULTIPLY. - MULTIPLY 123 BY 456 GIVING X - END-MULTIPLY. - MULTIPLY "a" BY "b" GIVING X - END-MULTIPLY. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/syn_multiply.at:123: \$COMPILE_ONLY prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY prog.cob" "syn_multiply.at:123" -( $at_check_trace; $COMPILE_ONLY prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob:10: error: '\"a\"' is not a numeric value -prog.cob:14: error: '\"a\"' is not a numeric value -prog.cob:14: error: '\"b\"' is not a numeric value -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/syn_multiply.at:123" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_353 -#AT_START_354 -at_fn_group_banner 354 'syn_screen.at:24' \ - "Flexible ACCEPT/DISPLAY syntax" " " 2 -at_xfail=no -( - $as_echo "354. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - - ENVIRONMENT DIVISION. - CONFIGURATION SECTION. - SPECIAL-NAMES. - SYSERR IS ERR-STREAM - . - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 a-field PIC XXX. - - SCREEN SECTION. - 01 scr. - 03 VALUE "blah" LINE 5 COL 5. - - PROCEDURE DIVISION. - *> Valid statements - DISPLAY "123" "456" "789" NO ADVANCING - DISPLAY "foo" COL 1 HIGHLIGHT AT LINE 1 WITH UNDERLINE, - "bar", "foo" - DISPLAY "a" UPON CRT, "b" LINE 3 COL 3, "c" UPON CRT-UNDER - DISPLAY scr, scr - - ACCEPT a-field LINE 5 SIZE 3 AT COL 1 WITH AUTO WITH - REVERSE-VIDEO, BLINK - - *> invalid statements - DISPLAY scr WITH NO ADVANCING - DISPLAY scr, scr LINE 2 COL 2 UPON ERR-STREAM - DISPLAY "foo" LINE 2 COL 2, scr - DISPLAY "foo" LINE 2 COL 2, "bar" UPON ERR-STREAM - DISPLAY "foo" LINE 1 UPON ERR-STREAM - DISPLAY scr, "foo" - . - END PROGRAM prog. - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog-2. - - ENVIRONMENT DIVISION. - CONFIGURATION SECTION. - SPECIAL-NAMES. - CONSOLE IS CRT - . - PROCEDURE DIVISION. - DISPLAY "foo" NO ADVANCING - . - END PROGRAM prog-2. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/syn_screen.at:79: \$COMPILE_ONLY prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY prog.cob" "syn_screen.at:79" -( $at_check_trace; $COMPILE_ONLY prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob:31: error: cannot specify NO ADVANCING in screen DISPLAY -prog.cob:31: error: screens may only be displayed on CRT -prog.cob:32: error: cannot mix screens and fields in the same DISPLAY statement -prog.cob:33: error: ambiguous DISPLAY; put items to display on device in separate DISPLAY -prog.cob:34: error: screen clauses may only be used for DISPLAY on CRT -prog.cob:35: error: cannot mix screens and fields in the same DISPLAY statement -prog.cob:49: error: cannot specify NO ADVANCING in screen DISPLAY -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/syn_screen.at:79" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_354 -#AT_START_355 -at_fn_group_banner 355 'syn_screen.at:92' \ - "Duplicate ACCEPT/DISPLAY clauses" " " 2 -at_xfail=no -( - $as_echo "355. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 a-field PIC XXX. - PROCEDURE DIVISION. - DISPLAY "foo" LINE 1 COL 1 HIGHLIGHT LINE 1 HIGHLIGHT - AT 0101 MODE IS BLOCK MODE IS BLOCK - ACCEPT a-field LINE 1 COL 1 HIGHLIGHT LINE 1 HIGHLIGHT - AT 0101 - . -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/syn_screen.at:109: \$COMPILE_ONLY prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY prog.cob" "syn_screen.at:109" -( $at_check_trace; $COMPILE_ONLY prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob:8: error: duplicate LINE clause -prog.cob:8: error: duplicate HIGHLIGHT clause -prog.cob:9: error: cannot specify both AT screen-location and LINE or COLUMN -prog.cob:9: error: duplicate MODE IS BLOCK clause -prog.cob:10: error: duplicate LINE clause -prog.cob:10: error: duplicate HIGHLIGHT clause -prog.cob:11: error: cannot specify both AT screen-location and LINE or COLUMN -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/syn_screen.at:109" -$at_failed && at_fn_log_failure -$at_traceon; } - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_355 -#AT_START_356 -at_fn_group_banner 356 'syn_screen.at:121' \ - "AT clause" " " 2 -at_xfail=no -( - $as_echo "356. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 curs-1 PIC 9(4) VALUE 00000000001111. - 01 curs-2. - 03 linee PIC 999. - 03 coll PIC 999. - 01 posc CONSTANT 0101. - - 01 curs-3 PIC 99. - 01 curs-4 PIC 9(8) VALUE 0101. - 01 curs-5 PIC X(4). - - PROCEDURE DIVISION. - *> Valid AT clauses - DISPLAY "a" AT curs-1 - DISPLAY "a" AT curs-2 - DISPLAY "a" AT posc - - *> Invalid AT clauses - DISPLAY "a" AT curs-3 - DISPLAY "a" AT curs-4 - DISPLAY "a" AT curs-5 - DISPLAY "a" AT 101 - DISPLAY "a" AT ZERO - . -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/syn_screen.at:155: \$COMPILE_ONLY prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY prog.cob" "syn_screen.at:155" -( $at_check_trace; $COMPILE_ONLY prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob:24: error: value in AT clause must have 4 or 6 digits -prog.cob:25: error: value in AT clause must have 4 or 6 digits -prog.cob:26: error: value in AT clause is not numeric -prog.cob:27: error: value in AT clause must have 4 or 6 digits -prog.cob:29: error: cannot specify figurative constant ZERO in AT clause -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/syn_screen.at:155" -$at_failed && at_fn_log_failure -$at_traceon; } - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_356 -#AT_START_357 -at_fn_group_banner 357 'syn_screen.at:165' \ - "ACCEPT/DISPLAY extensions detection" " " 2 -at_xfail=no -( - $as_echo "357. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 zero-const CONSTANT 0. - 01 x PIC 99. - - SCREEN SECTION. - 01 scr. - 03 y PIC 99 FROM x LINE 3 COLUMN 5. - - PROCEDURE DIVISION. - DISPLAY "hello" AT 0000 - DISPLAY "world" LINE ZERO COLUMN zero-const - ACCEPT x WITH TIME-OUT 5 - - DISPLAY scr WITH UNDERLINE - ACCEPT scr WITH HIGHLIGHT - - DISPLAY scr, scr - - *> Valid statements - DISPLAY scr UPON CRT-UNDER - ACCEPT scr AT LINE 4 COLUMN 4 - . -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/syn_screen.at:197: \$COMPILE_ONLY -faccept-display-extensions=error prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY -faccept-display-extensions=error prog.cob" "syn_screen.at:197" -( $at_check_trace; $COMPILE_ONLY -faccept-display-extensions=error prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob:15: error: AT clause used -prog.cob:15: error: non-standard DISPLAY used -prog.cob:16: error: LINE 0 used -prog.cob:16: error: COLUMN 0 used -prog.cob:16: error: non-standard DISPLAY used -prog.cob:17: error: non-standard ACCEPT used -prog.cob:19: error: non-standard DISPLAY used -prog.cob:20: error: non-standard ACCEPT used -prog.cob:22: error: non-standard DISPLAY used -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/syn_screen.at:197" -$at_failed && at_fn_log_failure -$at_traceon; } - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_357 -#AT_START_358 -at_fn_group_banner 358 'syn_screen.at:211' \ - "FROM clause" " " 2 -at_xfail=no -( - $as_echo "358. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 X PIC X. - SCREEN SECTION. - 01 SG. - 05 SI1 LINE 1 COL 1 PIC X FROM X. - 05 SI2 LINE 2 COL 1 PIC X FROM SPACE. - 05 SI2-2 LINE 2 COL 5 PIC X(03) FROM ALL SPACES. - 05 SI3 LINE 3 COL 1 PIC 9 FROM ZERO. - 05 SI3-2 LINE 3 COL 5 PIC X(03) FROM ALL ZEROES. - PROCEDURE DIVISION. - DISPLAY SG END-DISPLAY. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/syn_screen.at:232: \$COMPILE_ONLY prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY prog.cob" "syn_screen.at:232" -( $at_check_trace; $COMPILE_ONLY prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/syn_screen.at:232" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_358 -#AT_START_359 -at_fn_group_banner 359 'syn_screen.at:237' \ - "Incorrect USAGE clause" " " 2 -at_xfail=no -( - $as_echo "359. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 X PIC X. - SCREEN SECTION. - 01 SG. - 05 SI1 LINE 1 COL 1 PIC X FROM X. - 05 SI2 LINE 2 COL 1 PIC X FROM SPACE. - 05 SI2-2 LINE 2 COL 5 PIC X(03) FROM ALL SPACES. - 05 BAD1 LINE 4 COL 1 PIC 9 BINARY FROM ZERO. - 05 FILLER LINE 4 COL 10 PIC 9 COMP-5 FROM ZERO. - 05 BAD3 LINE 4 COL 5 COMP-2 FROM ALL ZEROES. - PROCEDURE DIVISION. - DISPLAY SG END-DISPLAY. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/syn_screen.at:259: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "syn_screen.at:259" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob:12: error: SCREEN SECTION item 'BAD1' should be USAGE DISPLAY -prog.cob:13: error: SCREEN SECTION item 'FILLER' should be USAGE DISPLAY -prog.cob:14: error: SCREEN SECTION item 'BAD3' should be USAGE DISPLAY -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/syn_screen.at:259" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_359 -#AT_START_360 -at_fn_group_banner 360 'syn_screen.at:268' \ - "SCREEN SECTION clause numbers" " " 2 -at_xfail=no -( - $as_echo "360. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - SCREEN SECTION. - *> Valid numbers - 01 v1 VALUE "-" LINE 1. - 01 v2 VALUE "-" LINE + 1. - 01 v3 VALUE "-" LINE - 1. - 01 v4 VALUE "-" LINE 0. - - *> invalid numbers - 01 i1 VALUE "-" LINE +1. - 01 i2 VALUE "-" LINE -1. - 01 i3 VALUE "-" LINE 1.0. - PROCEDURE DIVISION. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/syn_screen.at:290: \$COMPILE_ONLY prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY prog.cob" "syn_screen.at:290" -( $at_check_trace; $COMPILE_ONLY prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob:13: error: unsigned integer value expected -prog.cob:14: error: unsigned integer value expected -prog.cob:15: error: unsigned integer value expected -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/syn_screen.at:290" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_360 -#AT_START_361 -at_fn_group_banner 361 'syn_screen.at:300' \ - "Screen clauses" " " 2 -at_xfail=no -( - $as_echo "361. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 foo PIC X. - SCREEN SECTION. - 01 scr. - 03 a PIC X TO foo FULL, LEFTLINE, OVERLINE, REQUIRED, - GRID. - PROCEDURE DIVISION. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/syn_screen.at:317: \$COMPILE_ONLY prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY prog.cob" "syn_screen.at:317" -( $at_check_trace; $COMPILE_ONLY prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob:9: warning: LEFTLINE is not implemented -prog.cob:9: warning: OVERLINE is not implemented -prog.cob:10: warning: GRID is not implemented -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/syn_screen.at:317" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_361 -#AT_START_362 -at_fn_group_banner 362 'syn_screen.at:326' \ - "ACCEPT ON EXCEPTION/ESCAPE" " " 2 -at_xfail=no -( - $as_echo "362. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 foo PIC X. - PROCEDURE DIVISION. - ACCEPT foo - ON EXCEPTION - CONTINUE - NOT EXCEPTION - CONTINUE - END-ACCEPT - - ACCEPT foo - ESCAPE - CONTINUE - NOT ON ESCAPE - CONTINUE - END-ACCEPT - . -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/syn_screen.at:352: \$COMPILE_ONLY prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY prog.cob" "syn_screen.at:352" -( $at_check_trace; $COMPILE_ONLY prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/syn_screen.at:352" -$at_failed && at_fn_log_failure -$at_traceon; } - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_362 -#AT_START_363 -at_fn_group_banner 363 'syn_screen.at:356' \ - "Referencing 88-level" " " 2 -at_xfail=no -( - $as_echo "363. $at_setup_line: testing $at_desc ..." - $at_traceon - -# see bug #178 - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 flag PIC X. - 88 blah VALUE "N". - - SCREEN SECTION. - 01 scr. - 03 PIC X COLUMN blah TO blah FROM blah. - - PROCEDURE DIVISION. - ACCEPT scr - . -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/syn_screen.at:378: \$COMPILE_ONLY prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY prog.cob" "syn_screen.at:378" -( $at_check_trace; $COMPILE_ONLY prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob:12: error: condition-name not allowed here: 'blah' -prog.cob:12: error: condition-name not allowed here: 'blah' -prog.cob:12: error: condition-name not allowed here: 'blah' -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/syn_screen.at:378" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_363 -#AT_START_364 -at_fn_group_banner 364 'syn_screen.at:387' \ - "Conflicting screen clauses" " " 2 -at_xfail=no -( - $as_echo "364. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 x PIC 999. - - SCREEN SECTION. - 01 scr. - 03 VALUE "foo" HIGHLIGHT, LOWLIGHT; - ERASE EOL, ERASE EOS; - BLANK LINE, BLANK SCREEN. - - PROCEDURE DIVISION. - DISPLAY "blah" WITH HIGHLIGHT, LOWLIGHT; - ERASE EOL, ERASE EOS; - BLANK LINE, BLANK SCREEN; - SCROLL UP, SCROLL DOWN; - - ACCEPT x WITH AUTO, TAB; SCROLL UP, SCROLL DOWN; - UPDATE, NO UPDATE - - SET scr ATTRIBUTE HIGHLIGHT ON, LOWLIGHT OFF - . -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/syn_screen.at:417: \$COMPILE_ONLY prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY prog.cob" "syn_screen.at:417" -( $at_check_trace; $COMPILE_ONLY prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob:11: error: cannot specify both LOWLIGHT and HIGHLIGHT -prog.cob:12: error: cannot specify both ERASE EOS and ERASE EOL -prog.cob:13: error: cannot specify both BLANK SCREEN and BLANK LINE -prog.cob:16: error: cannot specify both LOWLIGHT and HIGHLIGHT -prog.cob:17: error: cannot specify both ERASE EOS and ERASE EOL -prog.cob:18: error: cannot specify both BLANK SCREEN and BLANK LINE -prog.cob:21: error: cannot specify both SCROLL DOWN and SCROLL UP -prog.cob:21: error: cannot specify both TAB and AUTO -prog.cob:22: error: cannot specify both SCROLL DOWN and SCROLL UP -prog.cob:22: error: cannot specify both NO UPDATE and UPDATE -prog.cob:24: error: cannot specify both HIGHLIGHT and LOWLIGHT -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/syn_screen.at:417" -$at_failed && at_fn_log_failure -$at_traceon; } - - -{ set +x -$as_echo "$at_srcdir/syn_screen.at:431: \$COMPILE_ONLY -frelax-syntax-checks prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY -frelax-syntax-checks prog.cob" "syn_screen.at:431" -( $at_check_trace; $COMPILE_ONLY -frelax-syntax-checks prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob:11: warning: cannot specify both LOWLIGHT and HIGHLIGHT; LOWLIGHT is ignored -prog.cob:12: warning: cannot specify both ERASE EOS and ERASE EOL; ERASE EOS is ignored -prog.cob:13: warning: cannot specify both BLANK SCREEN and BLANK LINE; BLANK SCREEN is ignored -prog.cob:16: warning: cannot specify both LOWLIGHT and HIGHLIGHT; LOWLIGHT is ignored -prog.cob:17: warning: cannot specify both ERASE EOS and ERASE EOL; ERASE EOS is ignored -prog.cob:18: warning: cannot specify both BLANK SCREEN and BLANK LINE; BLANK SCREEN is ignored -prog.cob:21: warning: cannot specify both SCROLL DOWN and SCROLL UP; SCROLL DOWN is ignored -prog.cob:21: warning: cannot specify both TAB and AUTO; TAB is ignored -prog.cob:22: warning: cannot specify both SCROLL DOWN and SCROLL UP; SCROLL DOWN is ignored -prog.cob:22: warning: cannot specify both NO UPDATE and UPDATE; NO UPDATE is ignored -prog.cob:24: error: cannot specify both HIGHLIGHT and LOWLIGHT -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/syn_screen.at:431" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_364 -#AT_START_365 -at_fn_group_banner 365 'syn_screen.at:448' \ - "Redundant screen clauses" " " 2 -at_xfail=no -( - $as_echo "365. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 x PIC 999. - - SCREEN SECTION. - 01 scr. - 03 HIGHLIGHT FULL. - 05 HIGHLIGHT FULL. - 07 FULL FULL VALUE "foo". - - PROCEDURE DIVISION. - DISPLAY "hello" WITH BACKGROUND-COLOR 2, BACKGROUND-COLOR 2 - ACCEPT x WITH HIGHLIGHT, HIGHLIGHT, UPDATE, DEFAULT - . -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/syn_screen.at:471: \$COMPILE_ONLY prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY prog.cob" "syn_screen.at:471" -( $at_check_trace; $COMPILE_ONLY prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob:13: error: duplicate FULL clause -prog.cob:16: error: duplicate BACKGROUND-COLOR clause -prog.cob:17: error: duplicate HIGHLIGHT clause -prog.cob:17: error: duplicate UPDATE clause -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/syn_screen.at:471" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_365 -#AT_START_366 -at_fn_group_banner 366 'syn_screen.at:481' \ - "Screen item OCCURS w-/wo relative LINE/COL" " " 2 -at_xfail=no -( - $as_echo "366. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - SCREEN SECTION. - 01 x-scr. - 03 x PIC X VALUE "a" OCCURS 10. -_ATEOF - - -cat >prog2.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog2. - DATA DIVISION. - SCREEN SECTION. - 01 x-scr. - 03 x PIC X VALUE "a" OCCURS 10 COL 10. - 01 y-scr. - 03 y PIC X VALUE "a" OCCURS 10 LINE 10. -_ATEOF - - -cat >prog3.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog3. - DATA DIVISION. - SCREEN SECTION. - 01 x-scr. - 03 x PIC X VALUE "a" OCCURS 10 COL + 10. - 01 y-scr. - 03 y PIC X VALUE "a" OCCURS 10 LINE - 10. - 01 a-scr. - 03 a PIC X VALUE "a" OCCURS 10 COL PLUS 10. - 01 b-scr. - 03 b PIC X VALUE "a" OCCURS 10 LINE MINUS 10. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/syn_screen.at:519: \$COMPILE_ONLY prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY prog.cob" "syn_screen.at:519" -( $at_check_trace; $COMPILE_ONLY prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob:7: warning: OCCURS screen items is not implemented -prog.cob:7: error: relative LINE/COLUMN clause required with OCCURS -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/syn_screen.at:519" -$at_failed && at_fn_log_failure -$at_traceon; } - - -{ set +x -$as_echo "$at_srcdir/syn_screen.at:524: \$COMPILE_ONLY prog2.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY prog2.cob" "syn_screen.at:524" -( $at_check_trace; $COMPILE_ONLY prog2.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog2.cob:7: warning: OCCURS screen items is not implemented -prog2.cob:7: error: relative LINE/COLUMN clause required with OCCURS -prog2.cob:9: warning: OCCURS screen items is not implemented -prog2.cob:9: error: relative LINE/COLUMN clause required with OCCURS -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/syn_screen.at:524" -$at_failed && at_fn_log_failure -$at_traceon; } - - -{ set +x -$as_echo "$at_srcdir/syn_screen.at:531: \$COMPILE_ONLY prog3.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY prog3.cob" "syn_screen.at:531" -( $at_check_trace; $COMPILE_ONLY prog3.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog3.cob:7: warning: OCCURS screen items is not implemented -prog3.cob:9: warning: OCCURS screen items is not implemented -prog3.cob:11: warning: OCCURS screen items is not implemented -prog3.cob:13: warning: OCCURS screen items is not implemented -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/syn_screen.at:531" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_366 -#AT_START_367 -at_fn_group_banner 367 'syn_screen.at:541' \ - "VALUE clause missing" " " 2 -at_xfail=no -( - $as_echo "367. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - SCREEN SECTION. - 01 SG. - 05 LINE 21 COL 1 VALUE "TESTING". - 05 " IMPLICIT VALUE " HIGHLIGHT. - PROCEDURE DIVISION. - DISPLAY SG END-DISPLAY. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/syn_screen.at:558: \$COMPILE_ONLY prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY prog.cob" "syn_screen.at:558" -( $at_check_trace; $COMPILE_ONLY prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob:9: error: syntax error, unexpected Literal -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/syn_screen.at:558" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_367 -#AT_START_368 -at_fn_group_banner 368 'syn_screen.at:565' \ - "FULL on numeric item" " " 2 -at_xfail=no -( - $as_echo "368. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 num PIC 999. - - SCREEN SECTION. - 01 scr. - 03 full-pointless PIC 999 TO num FULL. - 03 full-useful PIC ZZZ TO num FULL. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/syn_screen.at:582: \$COMPILE_ONLY prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY prog.cob" "syn_screen.at:582" -( $at_check_trace; $COMPILE_ONLY prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob:11: warning: FULL has no effect on numeric items; you may want REQUIRED or PIC Z -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/syn_screen.at:582" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_368 -#AT_START_369 -at_fn_group_banner 369 'syn_screen.at:589' \ - "Compiler-specific SCREEN SECTION clause rules" " " 2 -at_xfail=no -( - $as_echo "369. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 x PIC X. - 01 num PIC 9. - - SCREEN SECTION. - 01 scr. - 03 no-clauses. - 03 no-required-clauses BACKGROUND-COLOR 1. - 03 only-line LINE 1. - 03 numeric-pic-and-value PIC 999 VALUE 100. - 03 only-pic PIC 9. - 03 from-to-using-without-pic FROM x. - 03 auto-without-from-to-using PIC 9 AUTO. - 03 full-without-to-using PIC X FROM x FULL. - 03 full-and-justified PIC X USING x, FULL, JUST. - 03 secure-with-from PIC X FROM x SECURE. - 03 secure-justified-no-clauses VALUE "Hello" SECURE, JUST. - 03 blank-when-zero-without-pic FROM num, BLANK ZERO. - 03 justified-without-pic FROM x, JUST. - 03 sign-no-clauses PIC S9, SIGN LEADING SEPARATE. - 03 figurative-constant-value VALUE SPACES. - 03 only-erase ERASE EOL. - 03 only-blank BLANK SCREEN. - 03 only-bell BELL. - 03 numeric-value-no-pic VALUE 1. - - 01 always-ok-scr. - 03 my-group LINE 1, COL 1, FULL. - 05 PIC X FROM "x" TO x. - 05 PIC Z USING num. - 05 VALUE "Hello, world!". -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/syn_screen.at:630: \$COMPILE_ONLY -fscreen-section-rules=std prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY -fscreen-section-rules=std prog.cob" "syn_screen.at:630" -( $at_check_trace; $COMPILE_ONLY -fscreen-section-rules=std prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob:12: error: 'no-clauses' needs a PIC, FROM, TO, USING, VALUE, BELL, BLANK or ERASE clause -prog.cob:13: error: 'no-required-clauses' needs a PIC, FROM, TO, USING, VALUE, BELL, BLANK or ERASE clause -prog.cob:14: error: 'only-line' needs a PIC, FROM, TO, USING, VALUE, BELL, BLANK or ERASE clause -prog.cob:16: error: 'only-pic' cannot have PIC without FROM, TO, USING or numeric VALUE -prog.cob:17: warning: 'from-to-using-without-pic' has FROM, TO or USING without PIC; PIC will be implied -prog.cob:18: error: 'auto-without-from-to-using' cannot have PIC without FROM, TO, USING or numeric VALUE -prog.cob:20: error: cannot specify both FULL and JUSTIFIED -prog.cob:23: warning: 'blank-when-zero-without-pic' has FROM, TO or USING without PIC; PIC will be implied -prog.cob:24: warning: 'justified-without-pic' has FROM, TO or USING without PIC; PIC will be implied -prog.cob:25: error: 'sign-no-clauses' cannot have PIC without FROM, TO, USING or numeric VALUE -prog.cob:26: error: VALUE may not contain a figurative constant -prog.cob:30: warning: 'numeric-value-no-pic' has numeric VALUE without PIC; PIC will be implied -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/syn_screen.at:630" -$at_failed && at_fn_log_failure -$at_traceon; } - - -{ set +x -$as_echo "$at_srcdir/syn_screen.at:645: \$COMPILE_ONLY -fscreen-section-rules=acu prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY -fscreen-section-rules=acu prog.cob" "syn_screen.at:645" -( $at_check_trace; $COMPILE_ONLY -fscreen-section-rules=acu prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob:15: error: cannot specify both PIC and VALUE -prog.cob:15: error: cannot have PIC without FROM, TO or USING -prog.cob:15: error: VALUE item may not be numeric -prog.cob:16: error: cannot have PIC without FROM, TO or USING -prog.cob:17: warning: 'from-to-using-without-pic' has FROM, TO or USING without PIC; PIC will be implied -prog.cob:18: error: cannot have PIC without FROM, TO or USING -prog.cob:22: error: cannot have JUSTIFIED without PIC -prog.cob:23: warning: 'blank-when-zero-without-pic' has FROM, TO or USING without PIC; PIC will be implied -prog.cob:23: error: cannot have BLANK WHEN ZERO without PIC -prog.cob:24: warning: 'justified-without-pic' has FROM, TO or USING without PIC; PIC will be implied -prog.cob:24: error: cannot have JUSTIFIED without PIC -prog.cob:25: error: cannot have PIC without FROM, TO or USING -prog.cob:30: error: VALUE item may not be numeric -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/syn_screen.at:645" -$at_failed && at_fn_log_failure -$at_traceon; } - - -{ set +x -$as_echo "$at_srcdir/syn_screen.at:661: \$COMPILE_ONLY -fscreen-section-rules=mf prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY -fscreen-section-rules=mf prog.cob" "syn_screen.at:661" -( $at_check_trace; $COMPILE_ONLY -fscreen-section-rules=mf prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob:12: error: 'no-clauses' needs a PIC, COL, LINE, VALUE, BELL or BLANK clause -prog.cob:13: error: 'no-required-clauses' needs a PIC, COL, LINE, VALUE, BELL or BLANK clause -prog.cob:15: error: cannot specify both PIC and VALUE -prog.cob:15: error: cannot have PIC without FROM, TO or USING -prog.cob:15: error: VALUE item may not be numeric -prog.cob:16: error: cannot have PIC without FROM, TO or USING -prog.cob:17: error: 'from-to-using-without-pic' needs a PIC, COL, LINE, VALUE, BELL or BLANK clause -prog.cob:17: warning: 'from-to-using-without-pic' has FROM, TO or USING without PIC; PIC will be implied -prog.cob:18: error: cannot have PIC without FROM, TO or USING -prog.cob:18: error: cannot use AUTO, FULL, PROMPT, REQUIRED or SECURE on elementary item without TO or USING -prog.cob:19: error: cannot use AUTO, FULL, PROMPT, REQUIRED or SECURE on elementary item without TO or USING -prog.cob:21: error: cannot use AUTO, FULL, PROMPT, REQUIRED or SECURE on elementary item without TO or USING -prog.cob:22: error: cannot use AUTO, FULL, PROMPT, REQUIRED or SECURE on elementary item without TO or USING -prog.cob:22: error: cannot use BLANK WHEN ZERO, JUSTIFIED, OCCURS or SIGN on item without FROM, TO or USING -prog.cob:23: error: 'blank-when-zero-without-pic' needs a PIC, COL, LINE, VALUE, BELL or BLANK clause -prog.cob:23: warning: 'blank-when-zero-without-pic' has FROM, TO or USING without PIC; PIC will be implied -prog.cob:24: error: 'justified-without-pic' needs a PIC, COL, LINE, VALUE, BELL or BLANK clause -prog.cob:24: warning: 'justified-without-pic' has FROM, TO or USING without PIC; PIC will be implied -prog.cob:25: error: cannot have PIC without FROM, TO or USING -prog.cob:25: error: cannot use BLANK WHEN ZERO, JUSTIFIED, OCCURS or SIGN on item without FROM, TO or USING -prog.cob:26: error: VALUE may not contain a figurative constant -prog.cob:27: error: 'only-erase' needs a PIC, COL, LINE, VALUE, BELL or BLANK clause -prog.cob:30: error: VALUE item may not be numeric -prog.cob:36: error: cannot use AUTO, FULL, PROMPT, REQUIRED or SECURE on elementary item without TO or USING -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/syn_screen.at:661" -$at_failed && at_fn_log_failure -$at_traceon; } - - -{ set +x -$as_echo "$at_srcdir/syn_screen.at:688: \$COMPILE_ONLY -fscreen-section-rules=rm prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY -fscreen-section-rules=rm prog.cob" "syn_screen.at:688" -( $at_check_trace; $COMPILE_ONLY -fscreen-section-rules=rm prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob:15: error: cannot specify both PIC and VALUE -prog.cob:15: error: cannot have PIC without FROM, TO or USING -prog.cob:15: error: VALUE item may not be numeric -prog.cob:16: error: cannot have PIC without FROM, TO or USING -prog.cob:17: error: cannot have FROM, TO or USING without PIC -prog.cob:18: error: cannot have PIC without FROM, TO or USING -prog.cob:22: error: cannot use AUTO, FULL, REQUIRED or SECURE on elementary item without FROM, TO or USING -prog.cob:22: error: cannot use BLANK WHEN ZERO, JUSTIFIED or SIGN without FROM, TO or USING -prog.cob:23: error: cannot have FROM, TO or USING without PIC -prog.cob:23: error: cannot use BLANK WHEN ZERO, JUSTIFIED or SIGN without FROM, TO or USING -prog.cob:24: error: cannot have FROM, TO or USING without PIC -prog.cob:24: error: cannot use BLANK WHEN ZERO, JUSTIFIED or SIGN without FROM, TO or USING -prog.cob:25: error: cannot have PIC without FROM, TO or USING -prog.cob:30: error: VALUE item may not be numeric -prog.cob:36: error: cannot use AUTO, FULL, REQUIRED or SECURE on elementary item without FROM, TO or USING -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/syn_screen.at:688" -$at_failed && at_fn_log_failure -$at_traceon; } - - -{ set +x -$as_echo "$at_srcdir/syn_screen.at:706: \$COMPILE_ONLY -fscreen-section-rules=xopen prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY -fscreen-section-rules=xopen prog.cob" "syn_screen.at:706" -( $at_check_trace; $COMPILE_ONLY -fscreen-section-rules=xopen prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob:12: error: 'no-clauses' needs a PIC, COL, LINE, VALUE, BELL or BLANK clause -prog.cob:13: error: 'no-required-clauses' needs a PIC, COL, LINE, VALUE, BELL or BLANK clause -prog.cob:15: error: cannot specify both PIC and VALUE -prog.cob:15: error: cannot have PIC without FROM, TO or USING -prog.cob:15: error: VALUE item may not be numeric -prog.cob:16: error: cannot have PIC without FROM, TO or USING -prog.cob:17: error: 'from-to-using-without-pic' needs a PIC, COL, LINE, VALUE, BELL or BLANK clause -prog.cob:17: error: cannot have FROM, TO or USING without PIC -prog.cob:18: error: cannot have PIC without FROM, TO or USING -prog.cob:18: error: cannot have AUTO without FROM, TO or USING -prog.cob:19: error: cannot use FULL or REQUIRED on item without TO or USING -prog.cob:20: error: cannot specify both FULL and JUSTIFIED -prog.cob:21: error: SECURE can be used with TO only -prog.cob:22: error: SECURE must be used with TO -prog.cob:23: error: 'blank-when-zero-without-pic' needs a PIC, COL, LINE, VALUE, BELL or BLANK clause -prog.cob:23: error: cannot have FROM, TO or USING without PIC -prog.cob:24: error: 'justified-without-pic' needs a PIC, COL, LINE, VALUE, BELL or BLANK clause -prog.cob:24: error: cannot have FROM, TO or USING without PIC -prog.cob:25: error: cannot have PIC without FROM, TO or USING -prog.cob:27: error: 'only-erase' needs a PIC, COL, LINE, VALUE, BELL or BLANK clause -prog.cob:30: error: VALUE item may not be numeric -prog.cob:36: error: cannot use FULL or REQUIRED on item without TO or USING -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/syn_screen.at:706" -$at_failed && at_fn_log_failure -$at_traceon; } - - -{ set +x -$as_echo "$at_srcdir/syn_screen.at:731: \$COMPILE_ONLY -fscreen-section-rules=gc prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY -fscreen-section-rules=gc prog.cob" "syn_screen.at:731" -( $at_check_trace; $COMPILE_ONLY -fscreen-section-rules=gc prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob:12: warning: 'no-clauses' does nothing -prog.cob:13: warning: 'no-required-clauses' does nothing -prog.cob:15: warning: 'numeric-pic-and-value' has numeric VALUE without PIC; PIC will be implied -prog.cob:16: warning: 'only-pic' does nothing -prog.cob:17: warning: 'from-to-using-without-pic' has FROM, TO or USING without PIC; PIC will be implied -prog.cob:18: warning: 'auto-without-from-to-using' does nothing -prog.cob:23: warning: 'blank-when-zero-without-pic' has FROM, TO or USING without PIC; PIC will be implied -prog.cob:24: warning: 'justified-without-pic' has FROM, TO or USING without PIC; PIC will be implied -prog.cob:25: warning: 'sign-no-clauses' does nothing -prog.cob:30: warning: 'numeric-value-no-pic' has numeric VALUE without PIC; PIC will be implied -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/syn_screen.at:731" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_369 -#AT_START_370 -at_fn_group_banner 370 'syn_screen.at:747' \ - "MS-COBOL position-spec" " " 2 -at_xfail=no -( - $as_echo "370. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -# FIXME: WITH clause including a WITH COLUMN (both separate (working) -# and combined - error - must be added - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 FIELD-A PIC X(06) VALUE "ms-cob". - 01 A PIC X. - PROCEDURE DIVISION. - DISPLAY ERASE - MOVE 10 TO LIN. MOVE 15 TO COL. - DISPLAY (LIN , COL - 3) FIELD-A. - DISPLAY (LIN + 1 , COL) FIELD-A. - ACCEPT ( , 10) A. - DISPLAY (08 , 12) FIELD-A. - ACCEPT ( , 08) A WITH NO-ECHO. - DISPLAY FIELD-A AT LINE 06 COLUMN 12. - ACCEPT A AT COLUMN 8. - SUBTRACT 2 FROM LIN. - SUBTRACT 3 FROM COL. - DISPLAY FIELD-A AT LINE LIN COLUMN COL. - ACCEPT ( , 10) A. - DISPLAY ( 1 , 1 ) ERASE. - DISPLAY ( 2 , 1 ) "Field value : ", FIELD-A. - DISPLAY ( 3 , 1 ) A " --> A value" - DISPLAY ( 5 , 1 ) "Press ENTER to exit". - ACCEPT (11 , 1 ) A. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/syn_screen.at:782: \$COMPILE_ONLY prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY prog.cob" "syn_screen.at:782" -( $at_check_trace; $COMPILE_ONLY prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob:10: error: 'LIN' is not defined -prog.cob:10: error: syntax error, unexpected COL -prog.cob:11: error: 'LIN' is not defined -prog.cob:11: error: syntax error, unexpected COL, expecting Literal or ) or Identifier -prog.cob:12: error: 'LIN' is not defined -prog.cob:12: error: syntax error, unexpected COL, expecting Literal or ) or Identifier -prog.cob:18: error: 'LIN' is not defined -prog.cob:19: error: syntax error, unexpected COL -prog.cob:20: error: 'LIN' is not defined -prog.cob:20: error: syntax error, unexpected COL, expecting Literal or Identifier or ZERO -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/syn_screen.at:782" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/syn_screen.at:794: \$COMPILE_ONLY -fregister=LIN,COL prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY -fregister=LIN,COL prog.cob" "syn_screen.at:794" -( $at_check_trace; $COMPILE_ONLY -fregister=LIN,COL prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/syn_screen.at:794" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_370 -#AT_START_371 -at_fn_group_banner 371 'syn_screen.at:799' \ - "Screen with invalid FROM clause" " " 2 -at_xfail=no -( - $as_echo "371. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 some-const CONSTANT AS '123'. - - SCREEN SECTION. - 01 bild. - 05 from-constant-with-size FROM some-const. - 05 from-constant-without-pic FROM ZERO. - 05 LINE 24 COL 1 FROM message. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/syn_screen.at:817: \$COMPILE_ONLY prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY prog.cob" "syn_screen.at:817" -( $at_check_trace; $COMPILE_ONLY prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob:13: error: syntax error, unexpected MESSAGE -prog.cob:11: warning: 'from-constant-with-size' has FROM, TO or USING without PIC; PIC will be implied -prog.cob:12: warning: 'from-constant-without-pic' has FROM, TO or USING without PIC; PIC will be implied -prog.cob:12: error: PICTURE clause required for 'from-constant-without-pic' -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/syn_screen.at:817" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/syn_screen.at:823: \$COMPILE_ONLY -fnot-reserved=MESSAGE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY -fnot-reserved=MESSAGE prog.cob" "syn_screen.at:823" -( $at_check_trace; $COMPILE_ONLY -fnot-reserved=MESSAGE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob:13: error: 'message' is not defined, but is a reserved word in another dialect -prog.cob:11: warning: 'from-constant-with-size' has FROM, TO or USING without PIC; PIC will be implied -prog.cob:12: warning: 'from-constant-without-pic' has FROM, TO or USING without PIC; PIC will be implied -prog.cob:12: error: PICTURE clause required for 'from-constant-without-pic' -prog.cob:13: warning: 'FILLER' has FROM, TO or USING without PIC; PIC will be implied -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/syn_screen.at:823" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_371 -#AT_START_372 -at_fn_group_banner 372 'syn_set.at:24' \ - "SET ADDRESS OF item" " " 2 -at_xfail=no -( - $as_echo "372. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 X PIC X. - - LINKAGE SECTION. - 01 Y BASED. - 03 Z PIC X. - - PROCEDURE DIVISION. - SET ADDRESS OF X TO NULL. - SET ADDRESS OF Z TO NULL. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/syn_set.at:45: \$COMPILE_ONLY prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY prog.cob" "syn_set.at:45" -( $at_check_trace; $COMPILE_ONLY prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob:14: error: cannot change address of 'X', which is not BASED or a LINKAGE item -prog.cob:15: error: cannot change address of 'Z', which is not level 1 or 77 -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/syn_set.at:45" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_372 -#AT_START_373 -at_fn_group_banner 373 'syn_set.at:53' \ - "SET item TO 88-level" " " 2 -at_xfail=no -( - $as_echo "373. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 X PIC 9. - 88 x-wrong-init value space. - 01 Y PIC X. - 88 y-wrong-init value low-value. - - PROCEDURE DIVISION. - SET x-wrong-init TO TRUE. - SET y-wrong-init TO TRUE. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/syn_set.at:73: \$COMPILE_ONLY prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY prog.cob" "syn_set.at:73" -( $at_check_trace; $COMPILE_ONLY prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob:8: error: literal type does not match numeric data type -prog.cob:13: error: invalid SET statement -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/syn_set.at:73" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_373 -#AT_START_374 -at_fn_group_banner 374 'syn_functions.at:22' \ - "ANY LENGTH / NUMERIC as function RETURNING item" "" 2 -at_xfail=no -( - $as_echo "374. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - FUNCTION-ID. func. - - DATA DIVISION. - LINKAGE SECTION. - 01 any-len PIC X ANY LENGTH. - - PROCEDURE DIVISION RETURNING any-len. - CONTINUE - . - END FUNCTION func. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/syn_functions.at:39: \$COMPILE_ONLY prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY prog.cob" "syn_functions.at:39" -( $at_check_trace; $COMPILE_ONLY prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob:9: error: function RETURNING item may not be ANY LENGTH -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/syn_functions.at:39" -$at_failed && at_fn_log_failure -$at_traceon; } - - -cat >prog2.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - FUNCTION-ID. func. - - DATA DIVISION. - LINKAGE SECTION. - 01 any-len PIC 9 ANY NUMERIC. - - PROCEDURE DIVISION RETURNING any-len. - CONTINUE - . - END FUNCTION func. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/syn_functions.at:57: \$COMPILE_ONLY prog2.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY prog2.cob" "syn_functions.at:57" -( $at_check_trace; $COMPILE_ONLY prog2.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog2.cob:9: error: function RETURNING item may not be ANY LENGTH -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/syn_functions.at:57" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_374 -#AT_START_375 -at_fn_group_banner 375 'syn_functions.at:64' \ - "REPOSITORY INTRINSIC phrase" " " 2 -at_xfail=no -( - $as_echo "375. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - CONFIGURATION SECTION. - REPOSITORY. - FUNCTION pi e intrinsic - . - DATA DIVISION. - WORKING-STORAGE SECTION. - PROCEDURE DIVISION. - DISPLAY PI. - DISPLAY E. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/syn_functions.at:83: \$COMPILE_ONLY prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY prog.cob" "syn_functions.at:83" -( $at_check_trace; $COMPILE_ONLY prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/syn_functions.at:83" -$at_failed && at_fn_log_failure -$at_traceon; } - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_375 -#AT_START_376 -at_fn_group_banner 376 'syn_functions.at:87' \ - "REPOSITORY FUNCTION phrase" " " 2 -at_xfail=no -( - $as_echo "376. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - FUNCTION-ID. x AS "y". - - DATA DIVISION. - LINKAGE SECTION. - 01 ret PIC 9(4). - - PROCEDURE DIVISION RETURNING ret. - MOVE 100 TO ret - . - END FUNCTION x. - - IDENTIFICATION DIVISION. - FUNCTION-ID. z. - - DATA DIVISION. - LINKAGE SECTION. - 01 ret PIC 9(5). - - PROCEDURE DIVISION RETURNING ret. - MOVE 1 TO ret - . - END FUNCTION z. - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - - ENVIRONMENT DIVISION. - CONFIGURATION SECTION. - REPOSITORY. - FUNCTION y AS "y" - FUNCTION z - . - PROCEDURE DIVISION. - DISPLAY FUNCTION y - DISPLAY FUNCTION z - . - END PROGRAM prog. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/syn_functions.at:131: \$COMPILE_ONLY prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY prog.cob" "syn_functions.at:131" -( $at_check_trace; $COMPILE_ONLY prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/syn_functions.at:131" -$at_failed && at_fn_log_failure -$at_traceon; } - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_376 -#AT_START_377 -at_fn_group_banner 377 'syn_functions.at:135' \ - "Redundant REPOSITORY entries" " " 2 -at_xfail=no -( - $as_echo "377. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - PROGRAM-ID. prog. - END PROGRAM prog. - - IDENTIFICATION DIVISION. - FUNCTION-ID. alpha. - - ENVIRONMENT DIVISION. - CONFIGURATION SECTION. - SPECIAL-NAMES. - ALPHABET gamma IS ASCII - . - REPOSITORY. - FUNCTION alpha - PROGRAM prog - PROGRAM prog - PROGRAM prog AS "alpha" - FUNCTION prog - FUNCTION gamma - . - END FUNCTION alpha. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/syn_functions.at:161: \$COMPILE_ONLY prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY prog.cob" "syn_functions.at:161" -( $at_check_trace; $COMPILE_ONLY prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob:14: warning: prototype has same name as current function and will be ignored -prog.cob:16: warning: duplicate REPOSITORY entry for 'prog' -prog.cob:17: error: duplicate REPOSITORY entries for 'prog' do not match -prog.cob:18: error: duplicate REPOSITORY entries for 'prog' do not match -prog.cob:19: warning: no definition/prototype seen for FUNCTION 'gamma' -prog.cob:19: error: redefinition of 'gamma' -prog.cob:11: error: 'gamma' previously defined here -prog.cob:21: error: FUNCTION 'alpha' has no PROCEDURE DIVISION -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/syn_functions.at:161" -$at_failed && at_fn_log_failure -$at_traceon; } - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_377 -#AT_START_378 -at_fn_group_banner 378 'syn_functions.at:174' \ - "Missing prototype/definition" " " 2 -at_xfail=no -( - $as_echo "378. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - FUNCTION-ID. blah. - - ENVIRONMENT DIVISION. - CONFIGURATION SECTION. - REPOSITORY. - FUNCTION x - PROGRAM y - . - DATA DIVISION. - LINKAGE SECTION. - 01 ret PIC X. - - PROCEDURE DIVISION RETURNING ret. - MOVE FUNCTION x TO ret - MOVE FUNCTION x TO ret - . - END FUNCTION blah. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/syn_functions.at:198: \$COMPILE_ONLY prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY prog.cob" "syn_functions.at:198" -( $at_check_trace; $COMPILE_ONLY prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob:8: warning: no definition/prototype seen for FUNCTION 'x' -prog.cob:9: warning: no definition/prototype seen for PROGRAM 'y' -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/syn_functions.at:198" -$at_failed && at_fn_log_failure -$at_traceon; } - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_378 -#AT_START_379 -at_fn_group_banner 379 'syn_functions.at:205' \ - "Empty function" " " 2 -at_xfail=no -( - $as_echo "379. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -# Note: Test case for "Function without END FUNCTION" in syn_definition - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - FUNCTION-ID. func. - - END FUNCTION func. - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 x PIC 999 VALUE 124. - END PROGRAM prog. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/syn_functions.at:225: \$COMPILE_ONLY prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY prog.cob" "syn_functions.at:225" -( $at_check_trace; $COMPILE_ONLY prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob:5: error: FUNCTION 'func' has no PROCEDURE DIVISION -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/syn_functions.at:225" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_379 -#AT_START_380 -at_fn_group_banner 380 'syn_functions.at:232' \ - "Function definition inside program" " " 2 -at_xfail=no -( - $as_echo "380. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - - PROCEDURE DIVISION. - CONTINUE - . - - IDENTIFICATION DIVISION. - FUNCTION-ID. f. - END FUNCTION f. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/syn_functions.at:248: \$COMPILE_ONLY prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY prog.cob" "syn_functions.at:248" -( $at_check_trace; $COMPILE_ONLY prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob:10: error: functions may not be defined within a program/function -prog.cob:11: error: FUNCTION 'f' has no PROCEDURE DIVISION -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/syn_functions.at:248" -$at_failed && at_fn_log_failure -$at_traceon; } - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_380 -#AT_START_381 -at_fn_group_banner 381 'syn_functions.at:255' \ - "Intrinsic functions: dialect" " " 2 -at_xfail=no -( - $as_echo "381. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - DATA DIVISION. - WORKING-STORAGE SECTION. - PROCEDURE DIVISION. - DISPLAY FUNCTION ABS (1). - DISPLAY FUNCTION TRIM (" some text here"). - DISPLAY FUNCTION SUBSTITUTE ('some text' 'some' 'nice'). - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/syn_functions.at:271: \$COMPILE_ONLY prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY prog.cob" "syn_functions.at:271" -( $at_check_trace; $COMPILE_ONLY prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/syn_functions.at:271" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/syn_functions.at:272: \$COMPILE_ONLY -std=acu-strict prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY -std=acu-strict prog.cob" "syn_functions.at:272" -( $at_check_trace; $COMPILE_ONLY -std=acu-strict prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob:9: error: FUNCTION 'TRIM' unknown -prog.cob:10: error: FUNCTION 'SUBSTITUTE' unknown -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/syn_functions.at:272" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_381 -#AT_START_382 -at_fn_group_banner 382 'syn_functions.at:280' \ - "Intrinsic functions: replaced" " " 2 -at_xfail=no -( - $as_echo "382. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - FUNCTION-ID. SUBSTITUTE. - - DATA DIVISION. - LINKAGE SECTION. - 01 func-in PIC X(15). - 01 func-sub PIC X. - 01 func-out PIC X(15). - - PROCEDURE DIVISION USING func-in, func-sub RETURNING func-out. - MOVE func-in TO func-out - INSPECT func-out REPLACING ALL '%' BY func-sub - . - END FUNCTION SUBSTITUTE. - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - - ENVIRONMENT DIVISION. - CONFIGURATION SECTION. - REPOSITORY. - FUNCTION SUBSTITUTE - . - PROCEDURE DIVISION. - DISPLAY FUNCTION SUBSTITUTE(" % C%O%B%O%L % ", "_") - DISPLAY FUNCTION SUBSTITUTE(" % C%O%B%O%L % ", "-") - . - END PROGRAM prog. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/syn_functions.at:314: \$COMPILE_ONLY -fnot-intrinsic=substitute prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY -fnot-intrinsic=substitute prog.cob" "syn_functions.at:314" -( $at_check_trace; $COMPILE_ONLY -fnot-intrinsic=substitute prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/syn_functions.at:314" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/syn_functions.at:315: \$COMPILE_ONLY prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY prog.cob" "syn_functions.at:315" -( $at_check_trace; $COMPILE_ONLY prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob:24: error: syntax error, unexpected ., expecting intrinsic function name or INTRINSIC -prog.cob:26: error: FUNCTION 'SUBSTITUTE' has wrong number of arguments -prog.cob:27: error: FUNCTION 'SUBSTITUTE' has wrong number of arguments -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/syn_functions.at:315" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_382 -#AT_START_383 -at_fn_group_banner 383 'syn_functions.at:324' \ - "Intrinsic functions: number of arguments" " " 2 -at_xfail=no -( - $as_echo "383. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - DATA DIVISION. - WORKING-STORAGE SECTION. - PROCEDURE DIVISION. - DISPLAY FUNCTION PI. - DISPLAY FUNCTION PI ( ). - DISPLAY FUNCTION PI (1). - DISPLAY FUNCTION ABS. - DISPLAY FUNCTION ABS (1). - DISPLAY FUNCTION ABS (1, 2). - DISPLAY FUNCTION DAY-TO-YYYYDDD. - DISPLAY FUNCTION DAY-TO-YYYYDDD (6000). - DISPLAY FUNCTION DAY-TO-YYYYDDD (6000,50). - DISPLAY FUNCTION DAY-TO-YYYYDDD (6000,50,1600). - DISPLAY FUNCTION DAY-TO-YYYYDDD (6000,50,1600,500). - DISPLAY FUNCTION MAX (). - DISPLAY FUNCTION MAX (6000). - DISPLAY FUNCTION SUBSTITUTE ('A' 'B' 'C' 'D'). - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/syn_functions.at:351: \$COMPILE_ONLY prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY prog.cob" "syn_functions.at:351" -( $at_check_trace; $COMPILE_ONLY prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob:10: error: FUNCTION 'PI' has wrong number of arguments -prog.cob:11: error: FUNCTION 'ABS' has wrong number of arguments -prog.cob:13: error: FUNCTION 'ABS' has wrong number of arguments -prog.cob:14: error: FUNCTION 'DAY-TO-YYYYDDD' has wrong number of arguments -prog.cob:18: error: FUNCTION 'DAY-TO-YYYYDDD' has wrong number of arguments -prog.cob:19: error: FUNCTION 'MAX' has wrong number of arguments -prog.cob:21: error: FUNCTION 'SUBSTITUTE' has wrong number of arguments -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/syn_functions.at:351" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_383 -#AT_START_384 -at_fn_group_banner 384 'syn_functions.at:364' \ - "Intrinsic functions: reference modification" " " 2 -at_xfail=no -( - $as_echo "384. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -# the following should be checked, currently doesn't work -#AT_DATA([prog.cob], [ -# IDENTIFICATION DIVISION. -# PROGRAM-ID. prog. -# ENVIRONMENT DIVISION. -# DATA DIVISION. -# WORKING-STORAGE SECTION. -# PROCEDURE DIVISION. -# DISPLAY FUNCTION CHAR (66)(1:2). -# DISPLAY FUNCTION NUMVAL-C (123)(1:2). -# DISPLAY FUNCTION REVERSE ("TESTME")(20:1). -# DISPLAY FUNCTION REVERSE ("TESTME")(-1:1). -# DISPLAY FUNCTION REVERSE ("TESTME")(1:0). -# STOP RUN. -#]) -# -#AT_CHECK([$COMPILE_ONLY prog.cob], [1], [], -#[prog.cob:8: error: FUNCTION 'PI' can not have reference modification -#prog.cob:9: error: FUNCTION 'NUMVAL-C' can not have reference modification -#prog.cob:10: error: FUNCTION 'REVERSE' has invalid reference modification -#prog.cob:11: error: FUNCTION 'REVERSE' has invalid reference modification -#prog.cob:12: error: FUNCTION 'REVERSE' has invalid reference modification -#]) - -# test what is in already... -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - DATA DIVISION. - WORKING-STORAGE SECTION. - PROCEDURE DIVISION. - DISPLAY FUNCTION REVERSE ("TESTME")(-1:1). - DISPLAY FUNCTION REVERSE ("TESTME")(1:0). - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/syn_functions.at:404: \$COMPILE_ONLY prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY prog.cob" "syn_functions.at:404" -( $at_check_trace; $COMPILE_ONLY prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob:8: error: FUNCTION 'REVERSE' has invalid reference modification -prog.cob:9: error: FUNCTION 'REVERSE' has invalid reference modification -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/syn_functions.at:404" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_384 -#AT_START_385 -at_fn_group_banner 385 'syn_functions.at:412' \ - "Intrinsic functions: argument type" " " 2 -at_xfail=no -( - $as_echo "385. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -# TODO: Add more tests - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - DATA DIVISION. - WORKING-STORAGE SECTION. - PROCEDURE DIVISION. - DISPLAY FUNCTION ABS ('1'). - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/syn_functions.at:428: \$COMPILE_ONLY prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY prog.cob" "syn_functions.at:428" -( $at_check_trace; $COMPILE_ONLY prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob:8: error: FUNCTION 'ABS' has invalid argument -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/syn_functions.at:428" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_385 -#AT_START_386 -at_fn_group_banner 386 'syn_functions.at:435' \ - "invalid formatted date/time args" " " 2 -at_xfail=no -( - $as_echo "386. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 format-str PIC X(8) VALUE "YYYYMMDD". - 01 Date-Format CONSTANT "YYYYMMDD". - 01 Time-Format CONSTANT "hhmmss". - 01 Datetime-Format CONSTANT "YYYYMMDDThhmmss". - PROCEDURE DIVISION. - *> Test wrong formats - DISPLAY FUNCTION FORMATTED-DATE ( "YYYYWWWD", 1 ) - END-DISPLAY - DISPLAY FUNCTION FORMATTED-TIME ( "HHMMSS", 1) - END-DISPLAY - DISPLAY FUNCTION FORMATTED-DATETIME - ( "YYYYWWWDTHHMMSS", 1, 1) - END-DISPLAY - - *> Test format in variable - DISPLAY FUNCTION FORMATTED-DATE ( format-str, 1) - END-DISPLAY - - *> Test incompatible formats - DISPLAY FUNCTION FORMATTED-CURRENT-DATE (Date-Format) - END-DISPLAY - DISPLAY FUNCTION FORMATTED-CURRENT-DATE (Time-Format) - END-DISPLAY - - DISPLAY FUNCTION FORMATTED-DATE ( Time-Format, 1) - END-DISPLAY - DISPLAY FUNCTION FORMATTED-DATE ( Datetime-Format, 1) - END-DISPLAY - - DISPLAY FUNCTION FORMATTED-TIME ( Date-Format, 1) - END-DISPLAY - DISPLAY FUNCTION FORMATTED-TIME ( Datetime-Format, 1) - END-DISPLAY - - DISPLAY FUNCTION FORMATTED-DATETIME ( Date-Format, 1, 1) - END-DISPLAY - DISPLAY FUNCTION FORMATTED-DATETIME ( Time-Format, 1, 1) - END-DISPLAY - - DISPLAY FUNCTION INTEGER-OF-FORMATTED-DATE ( Time-Format, 1) - END-DISPLAY - - DISPLAY FUNCTION SECONDS-FROM-FORMATTED-TIME - ( Date-Format, 1) - END-DISPLAY - - *> Time format with more than 9 decimal places. - DISPLAY FUNCTION FORMATTED-TIME ( "hhmmss.ssssssssss", 1) - END-DISPLAY - - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/syn_functions.at:496: \$COMPILE_ONLY prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY prog.cob" "syn_functions.at:496" -( $at_check_trace; $COMPILE_ONLY prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob:12: error: FUNCTION 'FORMATTED-DATE' has invalid date/time format -prog.cob:14: error: FUNCTION 'FORMATTED-TIME' has invalid date/time format -prog.cob:16: error: FUNCTION 'FORMATTED-DATETIME' has invalid date/time format -prog.cob:21: warning: FUNCTION 'FORMATTED-DATE' has format in variable -prog.cob:25: error: FUNCTION 'FORMATTED-CURRENT-DATE' has invalid date/time format -prog.cob:27: error: FUNCTION 'FORMATTED-CURRENT-DATE' has invalid date/time format -prog.cob:30: error: FUNCTION 'FORMATTED-DATE' has invalid date/time format -prog.cob:32: error: FUNCTION 'FORMATTED-DATE' has invalid date/time format -prog.cob:35: error: FUNCTION 'FORMATTED-TIME' has invalid date/time format -prog.cob:37: error: FUNCTION 'FORMATTED-TIME' has invalid date/time format -prog.cob:40: error: FUNCTION 'FORMATTED-DATETIME' has invalid date/time format -prog.cob:42: error: FUNCTION 'FORMATTED-DATETIME' has invalid date/time format -prog.cob:45: error: FUNCTION 'INTEGER-OF-FORMATTED-DATE' has invalid date/time format -prog.cob:48: error: FUNCTION 'SECONDS-FROM-FORMATTED-TIME' has invalid date/time format -prog.cob:53: error: FUNCTION 'FORMATTED-TIME' has invalid date/time format -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/syn_functions.at:496" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_386 -#AT_START_387 -at_fn_group_banner 387 'syn_functions.at:516' \ - "invalid formats w/ DECIMAL-POINT IS COMMA" " " 2 -at_xfail=no -( - $as_echo "387. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - CONFIGURATION SECTION. - SPECIAL-NAMES. - DECIMAL-POINT IS COMMA. - PROCEDURE DIVISION. - DISPLAY FUNCTION FORMATTED-TIME ("hhmmss,ss", 1) - END-DISPLAY - DISPLAY FUNCTION FORMATTED-DATETIME - ("YYYYMMDDThhmmss,ss", 1, 1) - END-DISPLAY - - DISPLAY FUNCTION FORMATTED-TIME ("hhmmss.ss", 1) - END-DISPLAY - DISPLAY FUNCTION FORMATTED-DATETIME - ("YYYYMMDDThhmmss.ss", 1, 1) - END-DISPLAY - - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/syn_functions.at:542: \$COMPILE_ONLY prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY prog.cob" "syn_functions.at:542" -( $at_check_trace; $COMPILE_ONLY prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob:15: error: FUNCTION 'FORMATTED-TIME' has invalid date/time format -prog.cob:17: error: FUNCTION 'FORMATTED-DATETIME' has invalid date/time format -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/syn_functions.at:542" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_387 -#AT_START_388 -at_fn_group_banner 388 'syn_functions.at:550' \ - "Specified offset and SYSTEM-OFFSET" " " 2 -at_xfail=no -( - $as_echo "388. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - PROCEDURE DIVISION. - DISPLAY FUNCTION FORMATTED-DATETIME - ("YYYYDDDThhmmssZ", 1, 1, 1, SYSTEM-OFFSET) - END-DISPLAY - DISPLAY FUNCTION FORMATTED-TIME - ("hhmmssZ", 1, 1, SYSTEM-OFFSET) - END-DISPLAY - . -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/syn_functions.at:566: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "syn_functions.at:566" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob:6: error: cannot specify offset and SYSTEM-OFFSET at the same time -prog.cob:9: error: cannot specify offset and SYSTEM-OFFSET at the same time -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/syn_functions.at:566" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_388 -#AT_START_389 -at_fn_group_banner 389 'syn_functions.at:574' \ - "FUNCTION LENGTH / BYTE-LENGTH" " " 2 -at_xfail=no -( - $as_echo "389. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - PROCEDURE DIVISION. - DISPLAY FUNCTION LENGTH ("abcd" & "xyz") - END-DISPLAY - DISPLAY FUNCTION BYTE-LENGTH ("abcd" & "xyz") - END-DISPLAY - DISPLAY FUNCTION LENGTH ("abcd" "xyz") - END-DISPLAY - DISPLAY FUNCTION BYTE-LENGTH (01234) - END-DISPLAY - DISPLAY FUNCTION LENGTH (567) - END-DISPLAY - DISPLAY FUNCTION LENGTH ("abcd" & "xyz" PHYSICAL) - END-DISPLAY - DISPLAY FUNCTION BYTE-LENGTH ("abcd" & "xyz" PHYSICAL) - END-DISPLAY - . -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/syn_functions.at:598: \$COMPILE -Wno-pending prog.cob" -at_fn_check_prepare_dynamic "$COMPILE -Wno-pending prog.cob" "syn_functions.at:598" -( $at_check_trace; $COMPILE -Wno-pending prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob:9: error: syntax error, unexpected Literal, expecting PHYSICAL or ) -prog.cob:11: error: a non-numeric literal is expected here -prog.cob:13: error: a non-numeric literal is expected here -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/syn_functions.at:598" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_389 -#AT_START_390 -at_fn_group_banner 390 'listings.at:21' \ - "Minimal lines per listing pages" " " 3 -at_xfail=no -( - $as_echo "390. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -# note: 2.2 did not use a minmal length, -# a typo like -tlines=2 loops forever - - - -cat >prog.cob <<'_ATEOF' - - * some comments go here - *> and here - *> and finally... here - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 NEWSTUFF PIC X(80). - PROCEDURE DIVISION. - DISPLAY NEWSTUFF " BENEFITS SOME PARTS FROM " - "MANY" "STUFF" ", " "VERY MUCH" "GOOD" NEWSTUFF - "AND STUFF !" - NO ADVANCING - END-DISPLAY. - STOP RUN. -_ATEOF - - -cat >expected.lst <<'_ATEOF' -GnuCOBOL V.R.P prog.cob DDD MMM dd HH:MM:SS YYYY Page 0001 - -LINE PG/LN A...B............................................................ - -000001 -000002 * some comments go here -000003 *> and here -000004 *> and finally... here -000005 IDENTIFICATION DIVISION. -000006 PROGRAM-ID. prog. -000007 DATA DIVISION. -000008 WORKING-STORAGE SECTION. -000009 01 NEWSTUFF PIC X(80). -000010 PROCEDURE DIVISION. -000011 DISPLAY NEWSTUFF " BENEFITS SOME PARTS FROM " -000012 "MANY" "STUFF" ", " "VERY MUCH" "GOOD" NEWSTUFF -000013 "AND STUFF !" -000014 NO ADVANCING -000015 END-DISPLAY. -000016 STOP RUN. - - GnuCOBOL V.R.P prog.cob DDD MMM dd HH:MM:SS YYYY Page 0002 - -0 warnings in compilation group -0 errors in compilation group -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/listings.at:75: \$COMPILE_ONLY -t prog.lst -tlines=2 prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY -t prog.lst -tlines=2 prog.cob" "listings.at:75" -( $at_check_trace; $COMPILE_ONLY -t prog.lst -tlines=2 prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "cobc: warning: 2 lines per listing page specified, using 20 -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/listings.at:75" -$at_failed && at_fn_log_failure \ -"prog.lst" -$at_traceon; } - - -{ set +x -$as_echo "$at_srcdir/listings.at:79: gcdiff -IGnuCOBOL expected.lst prog.lst" -at_fn_check_prepare_trace "listings.at:79" -( $at_check_trace; gcdiff -IGnuCOBOL expected.lst prog.lst -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/listings.at:79" -$at_failed && at_fn_log_failure \ -"prog.lst" -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_390 -#AT_START_391 -at_fn_group_banner 391 'listings.at:84' \ - "COPY within comment" " " 3 -at_xfail=no -( - $as_echo "391. $at_setup_line: testing $at_desc ..." - $at_traceon - - - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - *COPY "copy.inc". - PROCEDURE DIVISION. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/listings.at:99: \$COMPILE_ONLY -t prog.lst -tlines=0 prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY -t prog.lst -tlines=0 prog.cob" "listings.at:99" -( $at_check_trace; $COMPILE_ONLY -t prog.lst -tlines=0 prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/listings.at:99" -$at_failed && at_fn_log_failure \ -"prog.lst" -$at_traceon; } - - -cat >prog1.lst <<'_ATEOF' -GnuCOBOL V.R.P prog.cob DDD MMM dd HH:MM:SS YYYY - -LINE PG/LN A...B............................................................ - -000001 -000002 IDENTIFICATION DIVISION. -000003 PROGRAM-ID. prog. -000004 DATA DIVISION. -000005 WORKING-STORAGE SECTION. -000006 *COPY "copy.inc". -000007 PROCEDURE DIVISION. -000008 STOP RUN. - - -0 warnings in compilation group -0 errors in compilation group -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/listings.at:120: gcdiff -IGnuCOBOL prog1.lst prog.lst" -at_fn_check_prepare_trace "listings.at:120" -( $at_check_trace; gcdiff -IGnuCOBOL prog1.lst prog.lst -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/listings.at:120" -$at_failed && at_fn_log_failure \ -"prog.lst" -$at_traceon; } - - -cat >prog2.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog2. - DATA DIVISION. - WORKING-STORAGE SECTION. - *> COPY "copy.inc". - PROCEDURE DIVISION. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/listings.at:132: \$COMPILE_ONLY -t prog.lst -tlines=0 -free prog2.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY -t prog.lst -tlines=0 -free prog2.cob" "listings.at:132" -( $at_check_trace; $COMPILE_ONLY -t prog.lst -tlines=0 -free prog2.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/listings.at:132" -$at_failed && at_fn_log_failure \ -"prog.lst" -$at_traceon; } - - -cat >prog2.lst <<'_ATEOF' -GnuCOBOL V.R.P prog2.cob DDD MMM dd HH:MM:SS YYYY - -LINE .....................SOURCE............................................. - -000001 -000002 IDENTIFICATION DIVISION. -000003 PROGRAM-ID. prog2. -000004 DATA DIVISION. -000005 WORKING-STORAGE SECTION. -000006 *> COPY "copy.inc". -000007 PROCEDURE DIVISION. -000008 STOP RUN. - - -0 warnings in compilation group -0 errors in compilation group -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/listings.at:153: gcdiff -IGnuCOBOL prog2.lst prog.lst" -at_fn_check_prepare_trace "listings.at:153" -( $at_check_trace; gcdiff -IGnuCOBOL prog2.lst prog.lst -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/listings.at:153" -$at_failed && at_fn_log_failure \ -"prog.lst" -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_391 -#AT_START_392 -at_fn_group_banner 392 'listings.at:158' \ - "Replacement w/o strings" " " 3 -at_xfail=no -( - $as_echo "392. $at_setup_line: testing $at_desc ..." - $at_traceon - - - - - -cat >prog.cob <<'_ATEOF' - - REPLACE =="SOME"== BY =="MANY"== - =='SOME'== BY =="VERY MUCH"== - ==STUFF== BY ==NEWSTUFF==. - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 NEWSTUFF PIC X(80). - PROCEDURE DIVISION. - DISPLAY STUFF " BENEFITS SOME PARTS FROM " - "SOME" "STUFF" ", " 'SOME' "GOOD" STUFF "AND STUFF !" - NO ADVANCING - END-DISPLAY. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/listings.at:180: \$COMPILE_ONLY -t prog.lst -tlines=0 -tsymbols prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY -t prog.lst -tlines=0 -tsymbols prog.cob" "listings.at:180" -( $at_check_trace; $COMPILE_ONLY -t prog.lst -tlines=0 -tsymbols prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/listings.at:180" -$at_failed && at_fn_log_failure \ -"prog.lst" -$at_traceon; } - - -cat >expected.lst <<'_ATEOF' -GnuCOBOL V.R.P prog.cob DDD MMM dd HH:MM:SS YYYY - -LINE PG/LN A...B............................................................ - -000001 -000002 REPLACE =="SOME"== BY =="MANY"== -000003 =='SOME'== BY =="VERY MUCH"== -000004 ==STUFF== BY ==NEWSTUFF==. -000005 IDENTIFICATION DIVISION. -000006 PROGRAM-ID. prog. -000007 DATA DIVISION. -000008 WORKING-STORAGE SECTION. -000009 01 NEWSTUFF PIC X(80). -000010 PROCEDURE DIVISION. -000011 DISPLAY NEWSTUFF " BENEFITS SOME PARTS FROM " -000012 "MANY" "STUFF" ", " "VERY MUCH" "GOOD" NEWSTUFF -000012+ - "AND STUFF !" -000013 NO ADVANCING -000014 END-DISPLAY. -000015 STOP RUN. - -SIZE TYPE LVL NAME PICTURE - - WORKING-STORAGE SECTION - -00080 ALPHANUMERIC 01 NEWSTUFF X(80) - - -0 warnings in compilation group -0 errors in compilation group -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/listings.at:215: gcdiff -IGnuCOBOL expected.lst prog.lst" -at_fn_check_prepare_trace "listings.at:215" -( $at_check_trace; gcdiff -IGnuCOBOL expected.lst prog.lst -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/listings.at:215" -$at_failed && at_fn_log_failure \ -"prog.lst" -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_392 -#AT_START_393 -at_fn_group_banner 393 'listings.at:220' \ - "COPY replacement order" " " 3 -at_xfail=no -( - $as_echo "393. $at_setup_line: testing $at_desc ..." - $at_traceon - - - - - -cat >copy.inc <<'_ATEOF' - - 01 TEST-VAR PIC X(2) VALUE "OK". -_ATEOF - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - COPY "copy.inc" - REPLACING ==TEST-VAR== BY ==FIRST-MATCH== - ==TEST-VAR== BY ==SECOND-MATCH==. - PROCEDURE DIVISION. - DISPLAY FIRST-MATCH NO ADVANCING - END-DISPLAY. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/listings.at:243: \$COMPILE_ONLY -t prog.lst -tlines=0 -tsymbols prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY -t prog.lst -tlines=0 -tsymbols prog.cob" "listings.at:243" -( $at_check_trace; $COMPILE_ONLY -t prog.lst -tlines=0 -tsymbols prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/listings.at:243" -$at_failed && at_fn_log_failure \ -"prog.lst" -$at_traceon; } - - -cat >prog3.lst <<'_ATEOF' -GnuCOBOL V.R.P prog.cob DDD MMM dd HH:MM:SS YYYY - -LINE PG/LN A...B............................................................ - -000001 -000002 IDENTIFICATION DIVISION. -000003 PROGRAM-ID. prog. -000004 DATA DIVISION. -000005 WORKING-STORAGE SECTION. -000006 COPY "copy.inc" -000007 REPLACING ==TEST-VAR== BY ==FIRST-MATCH== -000008 ==TEST-VAR== BY ==SECOND-MATCH==. -000001C -000002C 01 FIRST-MATCH PIC X(2) VALUE "OK". -000009 PROCEDURE DIVISION. -000010 DISPLAY FIRST-MATCH NO ADVANCING -000011 END-DISPLAY. -000012 STOP RUN. - -SIZE TYPE LVL NAME PICTURE - - WORKING-STORAGE SECTION - -00002 ALPHANUMERIC 01 FIRST-MATCH X(2) - - -0 warnings in compilation group -0 errors in compilation group -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/listings.at:276: gcdiff -IGnuCOBOL prog3.lst prog.lst" -at_fn_check_prepare_trace "listings.at:276" -( $at_check_trace; gcdiff -IGnuCOBOL prog3.lst prog.lst -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/listings.at:276" -$at_failed && at_fn_log_failure \ -"prog.lst" -$at_traceon; } - - -{ set +x -$as_echo "$at_srcdir/listings.at:278: \$COBC \$FLAGS -E -o prog.i prog.cob" -at_fn_check_prepare_dynamic "$COBC $FLAGS -E -o prog.i prog.cob" "listings.at:278" -( $at_check_trace; $COBC $FLAGS -E -o prog.i prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/listings.at:278" -$at_failed && at_fn_log_failure \ -"prog.lst" -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/listings.at:279: \$COMPILE_ONLY -t prog.lst -tlines=0 -tsymbols prog.i" -at_fn_check_prepare_dynamic "$COMPILE_ONLY -t prog.lst -tlines=0 -tsymbols prog.i" "listings.at:279" -( $at_check_trace; $COMPILE_ONLY -t prog.lst -tlines=0 -tsymbols prog.i -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/listings.at:279" -$at_failed && at_fn_log_failure \ -"prog.lst" -$at_traceon; } - - -cat >prog4.lst <<'_ATEOF' -GnuCOBOL V.R.P prog.i DDD MMM dd HH:MM:SS YYYY - -LINE PG/LN A...B............................................................ - -000001 #line 1 "prog.cob" -000001 -000002 IDENTIFICATION DIVISION. -000003 PROGRAM-ID. prog. -000004 DATA DIVISION. -000005 WORKING-STORAGE SECTION. -000006 -000007 -000008 -000001 #line 1 "copy.inc" -000001 -000002 01 FIRST-MATCH PIC X(2) VALUE "OK". -000008 #line 8 "prog.cob" -000008 -000009 PROCEDURE DIVISION. -000010 DISPLAY FIRST-MATCH NO ADVANCING -000011 END-DISPLAY. -000012 STOP RUN. - -SIZE TYPE LVL NAME PICTURE - - WORKING-STORAGE SECTION - -00002 ALPHANUMERIC 01 FIRST-MATCH X(2) - - -0 warnings in compilation group -0 errors in compilation group -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/listings.at:316: gcdiff -IGnuCOBOL prog4.lst prog.lst" -at_fn_check_prepare_trace "listings.at:316" -( $at_check_trace; gcdiff -IGnuCOBOL prog4.lst prog.lst -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/listings.at:316" -$at_failed && at_fn_log_failure \ -"prog.lst" -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_393 -#AT_START_394 -at_fn_group_banner 394 'listings.at:321' \ - "COPY separators" " " 3 -at_xfail=no -( - $as_echo "394. $at_setup_line: testing $at_desc ..." - $at_traceon - - - - - -cat >copy.inc <<'_ATEOF' - - 01 TEST-VAR PIC X(2) VALUE "OK". COPY001 -_ATEOF - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. PROG001 - PROGRAM-ID. prog. PROG002 - DATA DIVISION. PROG003 - WORKING-STORAGE SECTION. PROG004 - COPY "copy.inc" PROG005 - REPLACING ==TEST-VAR==, BY ==FIRST-MATCH==, PROG006 - , ==TEST-VAR==; BY ==SECOND-MATCH==; PROG007 - ; ==TEST-VAR== , BY ==THIRD-MATCH== PROG008 - ==TEST-VAR== ; BY ==FOURTH-MATCH==. PROG009 - PROCEDURE DIVISION. PROG010 - DISPLAY FIRST-MATCH NO ADVANCING PROG011 - END-DISPLAY. PROG012 - STOP RUN. PROG013 -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/listings.at:346: \$COMPILE_ONLY -t prog.lst -tlines=0 -tsymbols prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY -t prog.lst -tlines=0 -tsymbols prog.cob" "listings.at:346" -( $at_check_trace; $COMPILE_ONLY -t prog.lst -tlines=0 -tsymbols prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/listings.at:346" -$at_failed && at_fn_log_failure \ -"prog.lst" -$at_traceon; } - - -cat >prog4.lst <<'_ATEOF' -GnuCOBOL V.R.P prog.cob DDD MMM dd HH:MM:SS YYYY - -LINE PG/LN A...B............................................................ - -000001 -000002 IDENTIFICATION DIVISION. -000003 PROGRAM-ID. prog. -000004 DATA DIVISION. -000005 WORKING-STORAGE SECTION. -000006 COPY "copy.inc" -000007 REPLACING ==TEST-VAR==, BY ==FIRST-MATCH==, -000008 , ==TEST-VAR==; BY ==SECOND-MATCH==; -000009 ; ==TEST-VAR== , BY ==THIRD-MATCH== -000010 ==TEST-VAR== ; BY ==FOURTH-MATCH==. -000001C -000002C 01 FIRST-MATCH PIC X(2) VALUE "OK". -000011 PROCEDURE DIVISION. -000012 DISPLAY FIRST-MATCH NO ADVANCING -000013 END-DISPLAY. -000014 STOP RUN. - -SIZE TYPE LVL NAME PICTURE - - WORKING-STORAGE SECTION - -00002 ALPHANUMERIC 01 FIRST-MATCH X(2) - - -0 warnings in compilation group -0 errors in compilation group -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/listings.at:381: gcdiff -IGnuCOBOL prog4.lst prog.lst" -at_fn_check_prepare_trace "listings.at:381" -( $at_check_trace; gcdiff -IGnuCOBOL prog4.lst prog.lst -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/listings.at:381" -$at_failed && at_fn_log_failure \ -"prog.lst" -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_394 -#AT_START_395 -at_fn_group_banner 395 'listings.at:386' \ - "COPY partial replacement" " " 3 -at_xfail=no -( - $as_echo "395. $at_setup_line: testing $at_desc ..." - $at_traceon - - - - - -cat >copy.inc <<'_ATEOF' - - 01 :TEST:-VAR PIC X(2) VALUE "OK". - 01 (TEST)-VAR PIC X(2) VALUE "OK". -_ATEOF - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - COPY "copy.inc" - REPLACING ==:TEST:== BY ==COLON== - ==(TEST)== BY ==PAREN==. - PROCEDURE DIVISION. - DISPLAY COLON-VAR NO ADVANCING - END-DISPLAY. - DISPLAY PAREN-VAR NO ADVANCING - END-DISPLAY. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/listings.at:412: \$COMPILE_ONLY -t prog.lst -tlines=0 -tsymbols prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY -t prog.lst -tlines=0 -tsymbols prog.cob" "listings.at:412" -( $at_check_trace; $COMPILE_ONLY -t prog.lst -tlines=0 -tsymbols prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/listings.at:412" -$at_failed && at_fn_log_failure \ -"prog.lst" -$at_traceon; } - - -cat >prog5.lst <<'_ATEOF' -GnuCOBOL V.R.P prog.cob DDD MMM dd HH:MM:SS YYYY - -LINE PG/LN A...B............................................................ - -000001 -000002 IDENTIFICATION DIVISION. -000003 PROGRAM-ID. prog. -000004 DATA DIVISION. -000005 WORKING-STORAGE SECTION. -000006 COPY "copy.inc" -000007 REPLACING ==:TEST:== BY ==COLON== -000008 ==(TEST)== BY ==PAREN==. -000001C -000002C 01 COLON PIC X(2) VALUE "OK". -000003C 01 PAREN PIC X(2) VALUE "OK". -000009 PROCEDURE DIVISION. -000010 DISPLAY COLON-VAR NO ADVANCING -000011 END-DISPLAY. -000012 DISPLAY PAREN-VAR NO ADVANCING -000013 END-DISPLAY. -000014 STOP RUN. - -SIZE TYPE LVL NAME PICTURE - - WORKING-STORAGE SECTION - -00002 ALPHANUMERIC 01 COLON-VAR X(2) - -00002 ALPHANUMERIC 01 PAREN-VAR X(2) - - -0 warnings in compilation group -0 errors in compilation group -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/listings.at:450: gcdiff -IGnuCOBOL prog5.lst prog.lst" -at_fn_check_prepare_trace "listings.at:450" -( $at_check_trace; gcdiff -IGnuCOBOL prog5.lst prog.lst -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/listings.at:450" -$at_failed && at_fn_log_failure \ -"prog.lst" -$at_traceon; } - - - - -cat >copy1.inc <<'_ATEOF' - - 01 'yyy-'struktur. - 05 'yyy-'hello pic x(30) value 'yyy copy1.inc'. - 05 'yy1-'hello pic x(30) value 'yy1 copy1.inc'. - 05 'yy2-'hello pic x(30) value 'yy2 copy1.inc'. - 05 filler pic x(20). -_ATEOF - - -cat >prog1.cob <<'_ATEOF' - - identification division. - program-id. copytest. - - data division. - working-storage section. - 01 hello pic x(20) value 'Copytest'. - - 01 xx pic x(02). - - copy 'copy1.inc' replacing 'YYY-' by a10- - 'yy1-' by a11- - 'yy2-' by a12-. - - copy 'copy1.inc' replacing 'YYY-' by a20- - 'yy1-' by a21- - 'yy2-' by a22-. - - copy 'copy1.inc' replacing 'YYY-' by a30- - 'yy1-' by a31- - 'yy2-' by a32-. - - procedure division. - - display hello - - display 'a10-struktur' - display a10-struktur - - display 'a20-struktur' - display a20-struktur - - display 'a30-struktur' - display a30-struktur - - goback. - end program copytest. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/listings.at:501: \$COMPILE_ONLY -t prog1.lst -tlines=0 -tsymbols prog1.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY -t prog1.lst -tlines=0 -tsymbols prog1.cob" "listings.at:501" -( $at_check_trace; $COMPILE_ONLY -t prog1.lst -tlines=0 -tsymbols prog1.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/listings.at:501" -$at_failed && at_fn_log_failure \ -"prog.lst" \ -"prog1.lst" -$at_traceon; } - - -cat >prog6.lst <<'_ATEOF' -GnuCOBOL V.R.P prog1.cob DDD MMM dd HH:MM:SS YYYY - -LINE PG/LN A...B............................................................ - -000001 -000002 identification division. -000003 program-id. copytest. -000004 -000005 data division. -000006 working-storage section. -000007 01 hello pic x(20) value 'Copytest'. -000008 -000009 01 xx pic x(02). -000010 -000011 copy 'copy1.inc' replacing 'YYY-' by a10- -000012 'yy1-' by a11- -000013 'yy2-' by a12-. -000001C -000002C 01 a10-struktur. -000003C 05 a10-hello pic x(30) value 'yyy copy1.inc'. -000004C 05 a11-hello pic x(30) value 'yy1 copy1.inc'. -000005C 05 a12-hello pic x(30) value 'yy2 copy1.inc'. -000006C 05 filler pic x(20). -000014 -000015 copy 'copy1.inc' replacing 'YYY-' by a20- -000016 'yy1-' by a21- -000017 'yy2-' by a22-. -000001C -000002C 01 a20-struktur. -000003C 05 a20-hello pic x(30) value 'yyy copy1.inc'. -000004C 05 a21-hello pic x(30) value 'yy1 copy1.inc'. -000005C 05 a22-hello pic x(30) value 'yy2 copy1.inc'. -000006C 05 filler pic x(20). -000018 -000019 copy 'copy1.inc' replacing 'YYY-' by a30- -000020 'yy1-' by a31- -000021 'yy2-' by a32-. -000001C -000002C 01 a30-struktur. -000003C 05 a30-hello pic x(30) value 'yyy copy1.inc'. -000004C 05 a31-hello pic x(30) value 'yy1 copy1.inc'. -000005C 05 a32-hello pic x(30) value 'yy2 copy1.inc'. -000006C 05 filler pic x(20). -000022 -000023 procedure division. -000024 -000025 display hello -000026 -000027 display 'a10-struktur' -000028 display a10-struktur -000029 -000030 display 'a20-struktur' -000031 display a20-struktur -000032 -000033 display 'a30-struktur' -000034 display a30-struktur -000035 -000036 goback. -000037 end program copytest. - -SIZE TYPE LVL NAME PICTURE - - WORKING-STORAGE SECTION - -00020 ALPHANUMERIC 01 hello X(20) - -00002 ALPHANUMERIC 01 xx X(02) - -00110 GROUP 01 a10-struktur -00030 ALPHANUMERIC 05 a10-hello X(30) -00030 ALPHANUMERIC 05 a11-hello X(30) -00030 ALPHANUMERIC 05 a12-hello X(30) -00020 ALPHANUMERIC 05 FILLER X(20) - -00110 GROUP 01 a20-struktur -00030 ALPHANUMERIC 05 a20-hello X(30) -00030 ALPHANUMERIC 05 a21-hello X(30) -00030 ALPHANUMERIC 05 a22-hello X(30) -00020 ALPHANUMERIC 05 FILLER X(20) - -00110 GROUP 01 a30-struktur -00030 ALPHANUMERIC 05 a30-hello X(30) -00030 ALPHANUMERIC 05 a31-hello X(30) -00030 ALPHANUMERIC 05 a32-hello X(30) -00020 ALPHANUMERIC 05 FILLER X(20) - - -0 warnings in compilation group -0 errors in compilation group -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/listings.at:595: gcdiff -IGnuCOBOL prog6.lst prog1.lst" -at_fn_check_prepare_trace "listings.at:595" -( $at_check_trace; gcdiff -IGnuCOBOL prog6.lst prog1.lst -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/listings.at:595" -$at_failed && at_fn_log_failure \ -"prog.lst" \ -"prog1.lst" -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_395 -#AT_START_396 -at_fn_group_banner 396 'listings.at:600' \ - "COPY LEADING replacement" " " 3 -at_xfail=no -( - $as_echo "396. $at_setup_line: testing $at_desc ..." - $at_traceon - - - - - -cat >copy.inc <<'_ATEOF' - - 01 TEST-VAR PIC X(2) VALUE "OK". - 01 NORM-VAR PIC X(2) VALUE "OK". -_ATEOF - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - COPY "copy.inc" - REPLACING LEADING ==TEST== BY ==FIRST== - LEADING ==NORM== BY ==SECOND==. - PROCEDURE DIVISION. - DISPLAY FIRST-VAR NO ADVANCING - END-DISPLAY. - DISPLAY SECOND-VAR NO ADVANCING - END-DISPLAY. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/listings.at:626: \$COMPILE_ONLY -t prog.lst -tlines=0 -tsymbols prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY -t prog.lst -tlines=0 -tsymbols prog.cob" "listings.at:626" -( $at_check_trace; $COMPILE_ONLY -t prog.lst -tlines=0 -tsymbols prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/listings.at:626" -$at_failed && at_fn_log_failure \ -"prog.lst" -$at_traceon; } - - -cat >progl.lst <<'_ATEOF' -GnuCOBOL V.R.P prog.cob DDD MMM dd HH:MM:SS YYYY - -LINE PG/LN A...B............................................................ - -000001 -000002 IDENTIFICATION DIVISION. -000003 PROGRAM-ID. prog. -000004 DATA DIVISION. -000005 WORKING-STORAGE SECTION. -000006 COPY "copy.inc" -000007 REPLACING LEADING ==TEST== BY ==FIRST== -000008 LEADING ==NORM== BY ==SECOND==. -000001C -000002C 01 FIRST-VAR PIC X(2) VALUE "OK". -000003C 01 SECOND-VAR PIC X(2) VALUE "OK". -000009 PROCEDURE DIVISION. -000010 DISPLAY FIRST-VAR NO ADVANCING -000011 END-DISPLAY. -000012 DISPLAY SECOND-VAR NO ADVANCING -000013 END-DISPLAY. -000014 STOP RUN. - -SIZE TYPE LVL NAME PICTURE - - WORKING-STORAGE SECTION - -00002 ALPHANUMERIC 01 FIRST-VAR X(2) - -00002 ALPHANUMERIC 01 SECOND-VAR X(2) - - -0 warnings in compilation group -0 errors in compilation group -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/listings.at:664: gcdiff -IGnuCOBOL progl.lst prog.lst" -at_fn_check_prepare_trace "listings.at:664" -( $at_check_trace; gcdiff -IGnuCOBOL progl.lst prog.lst -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/listings.at:664" -$at_failed && at_fn_log_failure \ -"prog.lst" -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_396 -#AT_START_397 -at_fn_group_banner 397 'listings.at:669' \ - "COPY TRAILING replacement" " " 3 -at_xfail=no -( - $as_echo "397. $at_setup_line: testing $at_desc ..." - $at_traceon - - - - - -cat >copy.inc <<'_ATEOF' - - 01 TEST-FIRST PIC X(2) VALUE "OK". - 01 TEST-SECOND PIC X(2) VALUE "OK". -_ATEOF - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - COPY "copy.inc" - REPLACING TRAILING ==FIRST== BY ==VAR1== - TRAILING ==SECOND== BY ==VAR2==. - PROCEDURE DIVISION. - DISPLAY TEST-VAR1 NO ADVANCING - END-DISPLAY. - DISPLAY TEST-VAR2 NO ADVANCING - END-DISPLAY. - STOP RUN. -_ATEOF - - - -{ set +x -$as_echo "$at_srcdir/listings.at:696: \$COMPILE_ONLY -t prog.lst -tlines=0 -tsymbols prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY -t prog.lst -tlines=0 -tsymbols prog.cob" "listings.at:696" -( $at_check_trace; $COMPILE_ONLY -t prog.lst -tlines=0 -tsymbols prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/listings.at:696" -$at_failed && at_fn_log_failure \ -"prog.lst" -$at_traceon; } - - -cat >progr.lst <<'_ATEOF' -GnuCOBOL V.R.P prog.cob DDD MMM dd HH:MM:SS YYYY - -LINE PG/LN A...B............................................................ - -000001 -000002 IDENTIFICATION DIVISION. -000003 PROGRAM-ID. prog. -000004 DATA DIVISION. -000005 WORKING-STORAGE SECTION. -000006 COPY "copy.inc" -000007 REPLACING TRAILING ==FIRST== BY ==VAR1== -000008 TRAILING ==SECOND== BY ==VAR2==. -000001C -000002C 01 TEST-VAR1 PIC X(2) VALUE "OK". -000003C 01 TEST-VAR2 PIC X(2) VALUE "OK". -000009 PROCEDURE DIVISION. -000010 DISPLAY TEST-VAR1 NO ADVANCING -000011 END-DISPLAY. -000012 DISPLAY TEST-VAR2 NO ADVANCING -000013 END-DISPLAY. -000014 STOP RUN. - -SIZE TYPE LVL NAME PICTURE - - WORKING-STORAGE SECTION - -00002 ALPHANUMERIC 01 TEST-VAR1 X(2) - -00002 ALPHANUMERIC 01 TEST-VAR2 X(2) - - -0 warnings in compilation group -0 errors in compilation group -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/listings.at:734: gcdiff -IGnuCOBOL progr.lst prog.lst" -at_fn_check_prepare_trace "listings.at:734" -( $at_check_trace; gcdiff -IGnuCOBOL progr.lst prog.lst -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/listings.at:734" -$at_failed && at_fn_log_failure \ -"prog.lst" -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_397 -#AT_START_398 -at_fn_group_banner 398 'listings.at:739' \ - "COPY recursive replacement" " " 3 -at_xfail=no -( - $as_echo "398. $at_setup_line: testing $at_desc ..." - $at_traceon - - - - - -cat >copy-2.inc <<'_ATEOF' - - 01 TEST-VAR PIC X(2) VALUE "OK". -_ATEOF - - -cat >copy-1.inc <<'_ATEOF' - - COPY "copy-2.inc". -_ATEOF - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - COPY "copy-1.inc" - REPLACING ==TEST-VAR== BY ==COPY-VAR==. - PROCEDURE DIVISION. - DISPLAY COPY-VAR NO ADVANCING - END-DISPLAY. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/listings.at:765: \$COMPILE_ONLY -t prog.lst -tlines=0 -tsymbols prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY -t prog.lst -tlines=0 -tsymbols prog.cob" "listings.at:765" -( $at_check_trace; $COMPILE_ONLY -t prog.lst -tlines=0 -tsymbols prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/listings.at:765" -$at_failed && at_fn_log_failure \ -"prog.lst" -$at_traceon; } - - -cat >prog6.lst <<'_ATEOF' -GnuCOBOL V.R.P prog.cob DDD MMM dd HH:MM:SS YYYY - -LINE PG/LN A...B............................................................ - -000001 -000002 IDENTIFICATION DIVISION. -000003 PROGRAM-ID. prog. -000004 DATA DIVISION. -000005 WORKING-STORAGE SECTION. -000006 COPY "copy-1.inc" -000007 REPLACING ==TEST-VAR== BY ==COPY-VAR==. -000001C -000002C COPY "copy-2.inc". -000001C -000002C 01 COPY-VAR PIC X(2) VALUE "OK". -000008 PROCEDURE DIVISION. -000009 DISPLAY COPY-VAR NO ADVANCING -000010 END-DISPLAY. -000011 STOP RUN. - -SIZE TYPE LVL NAME PICTURE - - WORKING-STORAGE SECTION - -00002 ALPHANUMERIC 01 COPY-VAR X(2) - - -0 warnings in compilation group -0 errors in compilation group -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/listings.at:799: gcdiff -IGnuCOBOL prog6.lst prog.lst" -at_fn_check_prepare_trace "listings.at:799" -( $at_check_trace; gcdiff -IGnuCOBOL prog6.lst prog.lst -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/listings.at:799" -$at_failed && at_fn_log_failure \ -"prog.lst" -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_398 -#AT_START_399 -at_fn_group_banner 399 'listings.at:804' \ - "COPY multiple files" " " 3 -at_xfail=no -( - $as_echo "399. $at_setup_line: testing $at_desc ..." - $at_traceon - - - - - -cat >copy-fd-1.inc <<'_ATEOF' - - FD TEXTFILE-1 RECORD VARYING 1 TO 999 CHARACTERS - DEPENDING ON TEXTFILE-1-SIZE. - 01 TEXTRECD-1. - 03 FILLER PIC X(999). - * -_ATEOF - - -cat >copy-fd-2.inc <<'_ATEOF' - - FD TEXTFILE-2 RECORD VARYING 1 TO 999 CHARACTERS - DEPENDING ON TEXTFILE-2-SIZE. - 01 TEXTRECD-2. - 03 FILLER PIC X(999). - * -_ATEOF - - -cat >copy-ws-1.inc <<'_ATEOF' - - 01 TEXTFILE-1-NAME PIC X(080) VALUE "TEXTFILE.1". - 01 TEXTFILE-1-OCFG PIC X(001) VALUE "C". - 88 TEXTFILE-1-NOTOPEN VALUE "C". - 88 TEXTFILE-1-IS-OPEN VALUE "I", "O", "U". - 01 TEXTFILE-1-SIZE PIC 9(004). - * -_ATEOF - - -cat >copy-ws-2.inc <<'_ATEOF' - - 01 TEXTFILE-2-NAME PIC X(080) VALUE "TEXTFILE.2". - 01 TEXTFILE-2-OCFG PIC X(001) VALUE "C". - 88 TEXTFILE-2-NOTOPEN VALUE "C". - 88 TEXTFILE-2-IS-OPEN VALUE "I", "O", "U". - 01 TEXTFILE-2-SIZE PIC 9(004). - * -_ATEOF - - -cat >copy-sl-1.inc <<'_ATEOF' - - SELECT TEXTFILE-1 ASSIGN TO DISK TEXTFILE-1-NAME - ORGANIZATION LINE SEQUENTIAL - ACCESS MODE SEQUENTIAL. - * -_ATEOF - - -cat >copy-sl-2.inc <<'_ATEOF' - - SELECT TEXTFILE-2 ASSIGN TO DISK TEXTFILE-2-NAME - ORGANIZATION LINE SEQUENTIAL - ACCESS MODE SEQUENTIAL. - * -_ATEOF - - -cat >tstcpybk.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. tstcpybk. - * - ENVIRONMENT DIVISION. - CONFIGURATION SECTION. - * - SOURCE-COMPUTER. LINUX. - OBJECT-COMPUTER. LINUX. - - INPUT-OUTPUT SECTION. - FILE-CONTROL. - COPY "copy-sl-1.inc". - COPY "copy-sl-2.inc". - - DATA DIVISION. - FILE SECTION. - COPY "copy-fd-1.inc". - COPY "copy-fd-2.inc". - - WORKING-STORAGE SECTION. - 01 FILLER. - 03 FILLER PIC X(016) VALUE 'FCSI CodeWerks:'. - 03 FILLER PIC X(064) VALUE - 'Name:tstcpybk.cbl Version:1.7.1 Date:2017-03-15'. - 03 FILLER PIC X(002) VALUE LOW-VALUES. - * - COPY "copy-ws-1.inc". - COPY "copy-ws-2.inc". - - PROCEDURE DIVISION. - MAIN-PROCEDURE SECTION. - MAIN-PROCEDURE-0000. - CONTINUE. - MAIN-PROCEDURE-EXIT. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/listings.at:895: \$COMPILE_ONLY -t prog.lst -tlines=0 -tsymbols tstcpybk.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY -t prog.lst -tlines=0 -tsymbols tstcpybk.cob" "listings.at:895" -( $at_check_trace; $COMPILE_ONLY -t prog.lst -tlines=0 -tsymbols tstcpybk.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/listings.at:895" -$at_failed && at_fn_log_failure \ -"prog.lst" -$at_traceon; } - - -cat >prog3.lst <<'_ATEOF' -GnuCOBOL V.R.P tstcpybk.cob DDD MMM dd HH:MM:SS YYYY - -LINE PG/LN A...B............................................................ - -000001 -000002 IDENTIFICATION DIVISION. -000003 PROGRAM-ID. tstcpybk. -000004 * -000005 ENVIRONMENT DIVISION. -000006 CONFIGURATION SECTION. -000007 * -000008 SOURCE-COMPUTER. LINUX. -000009 OBJECT-COMPUTER. LINUX. -000010 -000011 INPUT-OUTPUT SECTION. -000012 FILE-CONTROL. -000013 COPY "copy-sl-1.inc". -000001C -000002C SELECT TEXTFILE-1 ASSIGN TO DISK TEXTFILE-1-NAME -000003C ORGANIZATION LINE SEQUENTIAL -000004C ACCESS MODE SEQUENTIAL. -000005C * -000014 COPY "copy-sl-2.inc". -000001C -000002C SELECT TEXTFILE-2 ASSIGN TO DISK TEXTFILE-2-NAME -000003C ORGANIZATION LINE SEQUENTIAL -000004C ACCESS MODE SEQUENTIAL. -000005C * -000015 -000016 DATA DIVISION. -000017 FILE SECTION. -000018 COPY "copy-fd-1.inc". -000001C -000002C FD TEXTFILE-1 RECORD VARYING 1 TO 999 CHARACTERS -000003C DEPENDING ON TEXTFILE-1-SIZE. -000004C 01 TEXTRECD-1. -000005C 03 FILLER PIC X(999). -000006C * -000019 COPY "copy-fd-2.inc". -000001C -000002C FD TEXTFILE-2 RECORD VARYING 1 TO 999 CHARACTERS -000003C DEPENDING ON TEXTFILE-2-SIZE. -000004C 01 TEXTRECD-2. -000005C 03 FILLER PIC X(999). -000006C * -000020 -000021 WORKING-STORAGE SECTION. -000022 01 FILLER. -000023 03 FILLER PIC X(016) VALUE 'FCSI CodeWerks:'. -000024 03 FILLER PIC X(064) VALUE -000025 'Name:tstcpybk.cbl Version:1.7.1 Date:2017-03-15'. -000026 03 FILLER PIC X(002) VALUE LOW-VALUES. -000027 * -000028 COPY "copy-ws-1.inc". -000001C -000002C 01 TEXTFILE-1-NAME PIC X(080) VALUE "TEXTFILE.1". -000003C 01 TEXTFILE-1-OCFG PIC X(001) VALUE "C". -000004C 88 TEXTFILE-1-NOTOPEN VALUE "C". -000005C 88 TEXTFILE-1-IS-OPEN VALUE "I", "O", "U". -000006C 01 TEXTFILE-1-SIZE PIC 9(004). -000007C * -000029 COPY "copy-ws-2.inc". -000001C -000002C 01 TEXTFILE-2-NAME PIC X(080) VALUE "TEXTFILE.2". -000003C 01 TEXTFILE-2-OCFG PIC X(001) VALUE "C". -000004C 88 TEXTFILE-2-NOTOPEN VALUE "C". -000005C 88 TEXTFILE-2-IS-OPEN VALUE "I", "O", "U". -000006C 01 TEXTFILE-2-SIZE PIC 9(004). -000007C * -000030 -000031 PROCEDURE DIVISION. -000032 MAIN-PROCEDURE SECTION. -000033 MAIN-PROCEDURE-0000. -000034 CONTINUE. -000035 MAIN-PROCEDURE-EXIT. -000036 STOP RUN. - -SIZE TYPE LVL NAME PICTURE - -00999 FILE TEXTFILE-1 -00999 GROUP 01 TEXTRECD-1 -00999 ALPHANUMERIC 03 FILLER X(999) - -00999 FILE TEXTFILE-2 -00999 GROUP 01 TEXTRECD-2 -00999 ALPHANUMERIC 03 FILLER X(999) - - WORKING-STORAGE SECTION - -00082 GROUP 01 FILLER -00016 ALPHANUMERIC 03 FILLER X(016) -00064 ALPHANUMERIC 03 FILLER X(064) -00002 ALPHANUMERIC 03 FILLER X(002) - -00080 ALPHANUMERIC 01 TEXTFILE-1-NAME X(080) - -00001 ALPHANUMERIC 01 TEXTFILE-1-OCFG X(001) - CONDITIONAL 88 TEXTFILE-1-NOTOPEN - CONDITIONAL 88 TEXTFILE-1-IS-OPEN - -00004 ALPHANUMERIC 01 TEXTFILE-1-SIZE 9(004) - -00080 ALPHANUMERIC 01 TEXTFILE-2-NAME X(080) - -00001 ALPHANUMERIC 01 TEXTFILE-2-OCFG X(001) - CONDITIONAL 88 TEXTFILE-2-NOTOPEN - CONDITIONAL 88 TEXTFILE-2-IS-OPEN - -00004 ALPHANUMERIC 01 TEXTFILE-2-SIZE 9(004) - - -0 warnings in compilation group -0 errors in compilation group -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/listings.at:1013: gcdiff -IGnuCOBOL prog3.lst prog.lst" -at_fn_check_prepare_trace "listings.at:1013" -( $at_check_trace; gcdiff -IGnuCOBOL prog3.lst prog.lst -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/listings.at:1013" -$at_failed && at_fn_log_failure \ -"prog.lst" -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_399 -#AT_START_400 -at_fn_group_banner 400 'listings.at:1018' \ - "Error/Warning messages" " " 3 -at_xfail=no -( - $as_echo "400. $at_setup_line: testing $at_desc ..." - $at_traceon - - - - - -cat >copy.inc <<'_ATEOF' - - ENVIRONMENT DIVISION. - INPUT-OUTPUT SECTION. - FILE-CONTROL. - SELECT testfile - ASSIGN TO filename - ORGANIZATION RELATIVE - ACCESS IS sequentia - STATUS IS stat. -_ATEOF - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - COPY "copy.inc". - DATA DIVISION. - WORKING-STORAGE SECTION. - PROCEDURE DIVISION. - DISPLAY FIRST-MATCH NO ADVANCING - END-DISPLAY. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/listings.at:1046: \$COMPILE_ONLY -t prog.lst prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY -t prog.lst prog.cob" "listings.at:1046" -( $at_check_trace; $COMPILE_ONLY -t prog.lst prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "copy.inc:8: error: syntax error, unexpected Identifier, expecting DYNAMIC or RANDOM or SEQUENTIAL -copy.inc:5: error: missing file description for FILE testfile -prog.cob:7: warning: variable 'filename' will be implicitly defined -prog.cob:8: error: 'FIRST-MATCH' is not defined -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/listings.at:1046" -$at_failed && at_fn_log_failure \ -"prog.lst" -$at_traceon; } - - -cat >prog12.lst <<'_ATEOF' -GnuCOBOL V.R.P prog.cob DDD MMM dd HH:MM:SS YYYY Page 0001 - -LINE PG/LN A...B............................................................ - -000001 -000002 IDENTIFICATION DIVISION. -000003 PROGRAM-ID. prog. -000004 COPY "copy.inc". -000001C -000002C ENVIRONMENT DIVISION. -000003C INPUT-OUTPUT SECTION. -000004C FILE-CONTROL. -000005C SELECT testfile -error: missing file description for FILE testfile -000006C ASSIGN TO filename -000007C ORGANIZATION RELATIVE -000008C ACCESS IS sequentia -error: syntax error, unexpected Identifier, expecting DYNAMIC or RANDOM or - + SEQUENTIAL -000009C STATUS IS stat. -000005 DATA DIVISION. -000006 WORKING-STORAGE SECTION. -000007 PROCEDURE DIVISION. -warning: variable 'filename' will be implicitly defined -000008 DISPLAY FIRST-MATCH NO ADVANCING -error: 'FIRST-MATCH' is not defined -000009 END-DISPLAY. -000010 STOP RUN. - - - GnuCOBOL V.R.P prog.cob DDD MMM dd HH:MM:SS YYYY Page 0002 - -Error/Warning summary: - -copy.inc:8: error: syntax error, unexpected Identifier, expecting DYNAMIC or RANDOM or SEQUENTIAL -copy.inc:5: error: missing file description for FILE testfile -prog.cob:7: warning: variable 'filename' will be implicitly defined -prog.cob:8: error: 'FIRST-MATCH' is not defined - -1 warning in compilation group -3 errors in compilation group -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/listings.at:1097: gcdiff -IGnuCOBOL prog12.lst prog.lst" -at_fn_check_prepare_trace "listings.at:1097" -( $at_check_trace; gcdiff -IGnuCOBOL prog12.lst prog.lst -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/listings.at:1097" -$at_failed && at_fn_log_failure \ -"prog.lst" -$at_traceon; } - - -{ set +x -$as_echo "$at_srcdir/listings.at:1099: \$COMPILE_ONLY -T prog.lst prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY -T prog.lst prog.cob" "listings.at:1099" -( $at_check_trace; $COMPILE_ONLY -T prog.lst prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "copy.inc:8: error: syntax error, unexpected Identifier, expecting DYNAMIC or RANDOM or SEQUENTIAL -copy.inc:5: error: missing file description for FILE testfile -prog.cob:7: warning: variable 'filename' will be implicitly defined -prog.cob:8: error: 'FIRST-MATCH' is not defined -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/listings.at:1099" -$at_failed && at_fn_log_failure \ -"prog.lst" -$at_traceon; } - - -cat >prog13.lst <<'_ATEOF' -GnuCOBOL V.R.P prog.cob DDD MMM dd HH:MM:SS YYYY Page 0001 - -LINE PG/LN A...B............................................................SEQUENCE - -000001 -000002 IDENTIFICATION DIVISION. -000003 PROGRAM-ID. prog. -000004 COPY "copy.inc". -000001C -000002C ENVIRONMENT DIVISION. -000003C INPUT-OUTPUT SECTION. -000004C FILE-CONTROL. -000005C SELECT testfile -error: missing file description for FILE testfile -000006C ASSIGN TO filename -000007C ORGANIZATION RELATIVE -000008C ACCESS IS sequentia -error: syntax error, unexpected Identifier, expecting DYNAMIC or RANDOM or SEQUENTIAL -000009C STATUS IS stat. -000005 DATA DIVISION. -000006 WORKING-STORAGE SECTION. -000007 PROCEDURE DIVISION. -warning: variable 'filename' will be implicitly defined -000008 DISPLAY FIRST-MATCH NO ADVANCING -error: 'FIRST-MATCH' is not defined -000009 END-DISPLAY. -000010 STOP RUN. - - - GnuCOBOL V.R.P prog.cob DDD MMM dd HH:MM:SS YYYY Page 0002 - -Error/Warning summary: - -copy.inc:8: error: syntax error, unexpected Identifier, expecting DYNAMIC or RANDOM or SEQUENTIAL -copy.inc:5: error: missing file description for FILE testfile -prog.cob:7: warning: variable 'filename' will be implicitly defined -prog.cob:8: error: 'FIRST-MATCH' is not defined - -1 warning in compilation group -3 errors in compilation group -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/listings.at:1149: gcdiff -IGnuCOBOL prog13.lst prog.lst" -at_fn_check_prepare_trace "listings.at:1149" -( $at_check_trace; gcdiff -IGnuCOBOL prog13.lst prog.lst -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/listings.at:1149" -$at_failed && at_fn_log_failure \ -"prog.lst" -$at_traceon; } - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 TEST-VAR PIC 9(2) VALUE 'F1'. - PROCEDURE DIVISION. - DISPLAY TEST-VAR NO ADVANCING - END-DISPLAY. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/listings.at:1163: \$COMPILE_ONLY -t prog.lst -tsymbols prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY -t prog.lst -tsymbols prog.cob" "listings.at:1163" -( $at_check_trace; $COMPILE_ONLY -t prog.lst -tsymbols prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob:6: warning: numeric value is expected -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/listings.at:1163" -$at_failed && at_fn_log_failure \ -"prog.lst" -$at_traceon; } - - -cat >prog14.lst <<'_ATEOF' -GnuCOBOL V.R.P prog.cob DDD MMM dd HH:MM:SS YYYY Page 0001 - -LINE PG/LN A...B............................................................ - -000001 -000002 IDENTIFICATION DIVISION. -000003 PROGRAM-ID. prog. -000004 DATA DIVISION. -000005 WORKING-STORAGE SECTION. -000006 01 TEST-VAR PIC 9(2) VALUE 'F1'. -warning: numeric value is expected -000007 PROCEDURE DIVISION. -000008 DISPLAY TEST-VAR NO ADVANCING -000009 END-DISPLAY. -000010 STOP RUN. - GnuCOBOL V.R.P prog.cob DDD MMM dd HH:MM:SS YYYY Page 0002 - -SIZE TYPE LVL NAME PICTURE - - WORKING-STORAGE SECTION - -00002 NUMERIC 01 TEST-VAR 9(2) - - - GnuCOBOL V.R.P prog.cob DDD MMM dd HH:MM:SS YYYY Page 0003 - -Error/Warning summary: - -prog.cob:6: warning: numeric value is expected - -1 warning in compilation group -0 errors in compilation group -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/listings.at:1202: gcdiff -IGnuCOBOL prog14.lst prog.lst" -at_fn_check_prepare_trace "listings.at:1202" -( $at_check_trace; gcdiff -IGnuCOBOL prog14.lst prog.lst -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/listings.at:1202" -$at_failed && at_fn_log_failure \ -"prog.lst" -$at_traceon; } - - - -{ set +x -$as_echo "$at_srcdir/listings.at:1205: \$COMPILE_ONLY -t prog.lst crud.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY -t prog.lst crud.cob" "listings.at:1205" -( $at_check_trace; $COMPILE_ONLY -t prog.lst crud.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "cobc: crud.cob: No such file or directory -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/listings.at:1205" -$at_failed && at_fn_log_failure \ -"prog.lst" -$at_traceon; } - - -cat >prog15.lst <<'_ATEOF' -GnuCOBOL V.R.P crud.cob DDD MMM dd HH:MM:SS YYYY Page 0001 - - cobc: crud.cob: No such file or directory - - -0 warnings in compilation group -1 error in compilation group -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/listings.at:1219: gcdiff -IGnuCOBOL prog15.lst prog.lst" -at_fn_check_prepare_trace "listings.at:1219" -( $at_check_trace; gcdiff -IGnuCOBOL prog15.lst prog.lst -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/listings.at:1219" -$at_failed && at_fn_log_failure \ -"prog.lst" -$at_traceon; } - - -cat >prog.cpy <<'_ATEOF' - - 78 I VALUE 20. - 78 J VALUE 5000. - 78 M VALUE 5. -_ATEOF - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 TEST-VAR PIC 9(2) VALUE 12. - COPY 'prog.cpy'. - PROCEDURE DIVISION. - DISPLAY TEST-VAR NO ADVANCING - END-DISPLAY - MOVE 'AA' TO TEST-VAR - DISPLAY TEST-VAR NO ADVANCING - END-DISPLAY - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/listings.at:1243: \$COBC \$FLAGS -E -o prog.i prog.cob" -at_fn_check_prepare_dynamic "$COBC $FLAGS -E -o prog.i prog.cob" "listings.at:1243" -( $at_check_trace; $COBC $FLAGS -E -o prog.i prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/listings.at:1243" -$at_failed && at_fn_log_failure \ -"prog.lst" -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/listings.at:1244: \$COMPILE_ONLY -t prog.lst -tlines=0 -tsymbols prog.i" -at_fn_check_prepare_dynamic "$COMPILE_ONLY -t prog.lst -tlines=0 -tsymbols prog.i" "listings.at:1244" -( $at_check_trace; $COMPILE_ONLY -t prog.lst -tlines=0 -tsymbols prog.i -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob:11: warning: numeric value is expected -prog.cob:6: warning: 'TEST-VAR' defined here as PIC 9(2) -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/listings.at:1244" -$at_failed && at_fn_log_failure \ -"prog.lst" -$at_traceon; } - - -cat >prog17.lst <<'_ATEOF' -GnuCOBOL V.R.P prog.i DDD MMM dd HH:MM:SS YYYY - -LINE PG/LN A...B............................................................ - -000001 #line 1 "prog.cob" -000001 -000002 IDENTIFICATION DIVISION. -000003 PROGRAM-ID. prog. -000004 DATA DIVISION. -000005 WORKING-STORAGE SECTION. -000006 01 TEST-VAR PIC 9(2) VALUE 12. -000007 -000001 #line 1 "prog.cpy" -000001 -000002 78 I VALUE 20. -000003 78 J VALUE 5000. -000004 78 M VALUE 5. -000007 #line 7 "prog.cob" -000007 -000008 PROCEDURE DIVISION. -000009 DISPLAY TEST-VAR NO ADVANCING -000010 END-DISPLAY -000011 MOVE 'AA' TO TEST-VAR -warning: numeric value is expected -000012 DISPLAY TEST-VAR NO ADVANCING -000013 END-DISPLAY -000014 STOP RUN. - -SIZE TYPE LVL NAME PICTURE - - WORKING-STORAGE SECTION - -00002 NUMERIC 01 TEST-VAR 9(2) - - - -Error/Warning summary: - -prog.cob:11: warning: numeric value is expected - -1 warning in compilation group -0 errors in compilation group -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/listings.at:1294: gcdiff -IGnuCOBOL prog17.lst prog.lst" -at_fn_check_prepare_trace "listings.at:1294" -( $at_check_trace; gcdiff -IGnuCOBOL prog17.lst prog.lst -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/listings.at:1294" -$at_failed && at_fn_log_failure \ -"prog.lst" -$at_traceon; } - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 TEST-VAR PIC 9(2) VALUE 'A'. - COPY 'CRUD.CPY'. - PROCEDURE DIVISION. - DISPLAY TEST-VAR NO ADVANCING - END-DISPLAY - MOVE 12 TO TEST-VAR - DISPLAY TEST-VAR NO ADVANCING - END-DISPLAY - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/listings.at:1312: \$COMPILE_ONLY -t prog.lst -tlines=0 prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY -t prog.lst -tlines=0 prog.cob" "listings.at:1312" -( $at_check_trace; $COMPILE_ONLY -t prog.lst -tlines=0 prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob:7: error: CRUD.CPY: No such file or directory -prog.cob:6: warning: numeric value is expected -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/listings.at:1312" -$at_failed && at_fn_log_failure \ -"prog.lst" -$at_traceon; } - - -cat >prog16.lst <<'_ATEOF' -GnuCOBOL V.R.P prog.cob DDD MMM dd HH:MM:SS YYYY - -LINE PG/LN A...B............................................................ - -000001 -000002 IDENTIFICATION DIVISION. -000003 PROGRAM-ID. prog. -000004 DATA DIVISION. -000005 WORKING-STORAGE SECTION. -000006 01 TEST-VAR PIC 9(2) VALUE 'A'. -warning: numeric value is expected -000007 COPY 'CRUD.CPY'. -error: CRUD.CPY: No such file or directory -000008 PROCEDURE DIVISION. -000009 DISPLAY TEST-VAR NO ADVANCING -000010 END-DISPLAY -000011 MOVE 12 TO TEST-VAR -000012 DISPLAY TEST-VAR NO ADVANCING -000013 END-DISPLAY -000014 STOP RUN. - - - -Error/Warning summary: - -prog.cob:7: error: CRUD.CPY: No such file or directory -prog.cob:6: warning: numeric value is expected - -1 warning in compilation group -1 error in compilation group -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/listings.at:1350: gcdiff -IGnuCOBOL prog16.lst prog.lst" -at_fn_check_prepare_trace "listings.at:1350" -( $at_check_trace; gcdiff -IGnuCOBOL prog16.lst prog.lst -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/listings.at:1350" -$at_failed && at_fn_log_failure \ -"prog.lst" -$at_traceon; } - - -{ set +x -$as_echo "$at_srcdir/listings.at:1352: \$COMPILE_ONLY -t prog.lst -tlines=0 -fmax-errors=0 prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY -t prog.lst -tlines=0 -fmax-errors=0 prog.cob" "listings.at:1352" -( $at_check_trace; $COMPILE_ONLY -t prog.lst -tlines=0 -fmax-errors=0 prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob:7: error: CRUD.CPY: No such file or directory -cobc: too many errors - -cobc: aborting compile of prog.cob at line 7 (unknown: unknown) -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 97 $at_status "$at_srcdir/listings.at:1352" -$at_failed && at_fn_log_failure \ -"prog.lst" -$at_traceon; } - - -cat >prog17.lst <<'_ATEOF' -GnuCOBOL V.R.P prog.cob DDD MMM dd HH:MM:SS YYYY - -LINE PG/LN A...B............................................................ - -000001 -000002 IDENTIFICATION DIVISION. -000003 PROGRAM-ID. prog. -000004 DATA DIVISION. -000005 WORKING-STORAGE SECTION. -000006 01 TEST-VAR PIC 9(2) VALUE 'A'. -000007 COPY 'CRUD.CPY'. -error: CRUD.CPY: No such file or directory -cobc: too many errors -000008 PROCEDURE DIVISION. -000009 DISPLAY TEST-VAR NO ADVANCING -000010 END-DISPLAY -000011 MOVE 12 TO TEST-VAR -000012 DISPLAY TEST-VAR NO ADVANCING -000013 END-DISPLAY -000014 STOP RUN. - - - -Error/Warning summary: - -prog.cob:7: error: CRUD.CPY: No such file or directory -cobc: too many errors - -0 warnings in compilation group -1 error in compilation group -Too many errors in compilation group: 0 maximum errors -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/listings.at:1393: gcdiff -IGnuCOBOL prog17.lst prog.lst" -at_fn_check_prepare_trace "listings.at:1393" -( $at_check_trace; gcdiff -IGnuCOBOL prog17.lst prog.lst -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/listings.at:1393" -$at_failed && at_fn_log_failure \ -"prog.lst" -$at_traceon; } - - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_400 -#AT_START_401 -at_fn_group_banner 401 'listings.at:1399' \ - "Two source files" " " 3 -at_xfail=no -( - $as_echo "401. $at_setup_line: testing $at_desc ..." - $at_traceon - - - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - *COPY "copy.inc". - PROCEDURE DIVISION. - STOP RUN. -_ATEOF - - -cat >prog1.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog1. - DATA DIVISION. - WORKING-STORAGE SECTION. - *COPY "copy.inc". - PROCEDURE DIVISION. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/listings.at:1424: \$COMPILE_ONLY -t prog.lst prog.cob prog1.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY -t prog.lst prog.cob prog1.cob" "listings.at:1424" -( $at_check_trace; $COMPILE_ONLY -t prog.lst prog.cob prog1.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/listings.at:1424" -$at_failed && at_fn_log_failure \ -"prog.lst" -$at_traceon; } - - -cat >prog11.lst <<'_ATEOF' -GnuCOBOL V.R.P prog.cob DDD MMM dd HH:MM:SS YYYY Page 0001 - -LINE PG/LN A...B............................................................ - -000001 -000002 IDENTIFICATION DIVISION. -000003 PROGRAM-ID. prog. -000004 DATA DIVISION. -000005 WORKING-STORAGE SECTION. -000006 *COPY "copy.inc". -000007 PROCEDURE DIVISION. -000008 STOP RUN. - - -0 warnings in compilation group -0 errors in compilation group - GnuCOBOL V.R.P prog1.cob DDD MMM dd HH:MM:SS YYYY Page 0001 - -LINE PG/LN A...B............................................................ - -000001 -000002 IDENTIFICATION DIVISION. -000003 PROGRAM-ID. prog1. -000004 DATA DIVISION. -000005 WORKING-STORAGE SECTION. -000006 *COPY "copy.inc". -000007 PROCEDURE DIVISION. -000008 STOP RUN. - - -0 warnings in compilation group -0 errors in compilation group -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/listings.at:1461: gcdiff -IGnuCOBOL prog11.lst prog.lst" -at_fn_check_prepare_trace "listings.at:1461" -( $at_check_trace; gcdiff -IGnuCOBOL prog11.lst prog.lst -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/listings.at:1461" -$at_failed && at_fn_log_failure \ -"prog.lst" -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_401 -#AT_START_402 -at_fn_group_banner 402 'listings.at:1466' \ - "Multiple programs in one file" " " 3 -at_xfail=no -( - $as_echo "402. $at_setup_line: testing $at_desc ..." - $at_traceon - - - - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog-1. - - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 blah PIC x. - - END PROGRAM prog-1. - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog-2. - END PROGRAM prog-2. -_ATEOF - - -cat >prog20.lst <<'_ATEOF' -GnuCOBOL V.R.P prog.cob DDD MMM dd HH:MM:SS YYYY Page 0001 - -LINE PG/LN A...B............................................................ - -000001 -000002 IDENTIFICATION DIVISION. -000003 PROGRAM-ID. prog-1. -000004 -000005 DATA DIVISION. -000006 WORKING-STORAGE SECTION. -000007 01 blah PIC x. -000008 -000009 END PROGRAM prog-1. -000010 -000011 IDENTIFICATION DIVISION. -000012 PROGRAM-ID. prog-2. -000013 END PROGRAM prog-2. - GnuCOBOL V.R.P prog.cob DDD MMM dd HH:MM:SS YYYY Page 0002 - -SIZE TYPE LVL NAME PICTURE - - PROGRAM prog-1 - - WORKING-STORAGE SECTION - -00001 ALPHANUMERIC 01 blah X - - PROGRAM prog-2 - - No fields defined. - - -0 warnings in compilation group -0 errors in compilation group -_ATEOF - - -# Check once with $COMPILE and once with $COMPILE_ONLY. -# This tests whether codegen affects the listing. -{ set +x -$as_echo "$at_srcdir/listings.at:1526: \$COMPILE -t prog.lst -tsymbols prog.cob" -at_fn_check_prepare_dynamic "$COMPILE -t prog.lst -tsymbols prog.cob" "listings.at:1526" -( $at_check_trace; $COMPILE -t prog.lst -tsymbols prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/listings.at:1526" -$at_failed && at_fn_log_failure \ -"prog.lst" \ -"prog2.lst" -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/listings.at:1527: gcdiff -IGnuCOBOL prog20.lst prog.lst" -at_fn_check_prepare_trace "listings.at:1527" -( $at_check_trace; gcdiff -IGnuCOBOL prog20.lst prog.lst -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/listings.at:1527" -$at_failed && at_fn_log_failure \ -"prog.lst" \ -"prog2.lst" -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/listings.at:1528: \$COMPILE_ONLY -t prog2.lst -tsymbols prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY -t prog2.lst -tsymbols prog.cob" "listings.at:1528" -( $at_check_trace; $COMPILE_ONLY -t prog2.lst -tsymbols prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/listings.at:1528" -$at_failed && at_fn_log_failure \ -"prog.lst" \ -"prog2.lst" -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/listings.at:1529: gcdiff -IGnuCOBOL prog20.lst prog2.lst" -at_fn_check_prepare_trace "listings.at:1529" -( $at_check_trace; gcdiff -IGnuCOBOL prog20.lst prog2.lst -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/listings.at:1529" -$at_failed && at_fn_log_failure \ -"prog.lst" \ -"prog2.lst" -$at_traceon; } - - -{ set +x -$as_echo "$at_srcdir/listings.at:1531: rm -f prog.lst prog2.lst" -at_fn_check_prepare_trace "listings.at:1531" -( $at_check_trace; rm -f prog.lst prog2.lst -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/listings.at:1531" -$at_failed && at_fn_log_failure \ -"prog.lst" \ -"prog2.lst" -$at_traceon; } - - -cat >progb.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog-1. - - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 blah PIC x. - - PROCEDURE DIVISION. - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog-2. - PROCEDURE DIVISION. - END PROGRAM prog-2. - - END PROGRAM prog-1. -_ATEOF - - -cat >prog20b.lst <<'_ATEOF' -GnuCOBOL V.R.P progb.cob DDD MMM dd HH:MM:SS YYYY Page 0001 - -LINE PG/LN A...B............................................................ - -000001 -000002 IDENTIFICATION DIVISION. -000003 PROGRAM-ID. prog-1. -000004 -000005 DATA DIVISION. -000006 WORKING-STORAGE SECTION. -000007 01 blah PIC x. -000008 -000009 PROCEDURE DIVISION. -000010 -000011 IDENTIFICATION DIVISION. -000012 PROGRAM-ID. prog-2. -000013 PROCEDURE DIVISION. -000014 END PROGRAM prog-2. -000015 -000016 END PROGRAM prog-1. - GnuCOBOL V.R.P progb.cob DDD MMM dd HH:MM:SS YYYY Page 0002 - -SIZE TYPE LVL NAME PICTURE - - PROGRAM prog-1 - - WORKING-STORAGE SECTION - -00001 ALPHANUMERIC 01 blah X - - PROGRAM prog-2 - - No fields defined. - - -0 warnings in compilation group -0 errors in compilation group -_ATEOF - - -# Check once with $COMPILE and once with $COMPILE_ONLY. -# This tests whether codegen affects the listing. -{ set +x -$as_echo "$at_srcdir/listings.at:1593: \$COMPILE -t prog.lst -tsymbols progb.cob" -at_fn_check_prepare_dynamic "$COMPILE -t prog.lst -tsymbols progb.cob" "listings.at:1593" -( $at_check_trace; $COMPILE -t prog.lst -tsymbols progb.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/listings.at:1593" -$at_failed && at_fn_log_failure \ -"prog.lst" \ -"prog2.lst" -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/listings.at:1594: gcdiff -IGnuCOBOL prog20b.lst prog.lst" -at_fn_check_prepare_trace "listings.at:1594" -( $at_check_trace; gcdiff -IGnuCOBOL prog20b.lst prog.lst -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/listings.at:1594" -$at_failed && at_fn_log_failure \ -"prog.lst" \ -"prog2.lst" -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/listings.at:1595: \$COMPILE_ONLY -t prog2.lst -tsymbols progb.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY -t prog2.lst -tsymbols progb.cob" "listings.at:1595" -( $at_check_trace; $COMPILE_ONLY -t prog2.lst -tsymbols progb.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/listings.at:1595" -$at_failed && at_fn_log_failure \ -"prog.lst" \ -"prog2.lst" -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/listings.at:1596: gcdiff -IGnuCOBOL prog20b.lst prog2.lst" -at_fn_check_prepare_trace "listings.at:1596" -( $at_check_trace; gcdiff -IGnuCOBOL prog20b.lst prog2.lst -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/listings.at:1596" -$at_failed && at_fn_log_failure \ -"prog.lst" \ -"prog2.lst" -$at_traceon; } - - -{ set +x -$as_echo "$at_srcdir/listings.at:1598: rm -f prog.lst prog2.lst" -at_fn_check_prepare_trace "listings.at:1598" -( $at_check_trace; rm -f prog.lst prog2.lst -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/listings.at:1598" -$at_failed && at_fn_log_failure \ -"prog.lst" \ -"prog2.lst" -$at_traceon; } - - -cat >progc.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog-1. - - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 blah PIC x. - - PROCEDURE DIVISION. - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog-2. - PROCEDURE. - END PROGRAM prog-2. - - END PROGRAM prog-1. -_ATEOF - - -cat >prog20c.lst <<'_ATEOF' -GnuCOBOL V.R.P progc.cob DDD MMM dd HH:MM:SS YYYY Page 0001 - -LINE PG/LN A...B............................................................ - -000001 -000002 IDENTIFICATION DIVISION. -000003 PROGRAM-ID. prog-1. -000004 -000005 DATA DIVISION. -000006 WORKING-STORAGE SECTION. -000007 01 blah PIC x. -000008 -000009 PROCEDURE DIVISION. -000010 -000011 IDENTIFICATION DIVISION. -000012 PROGRAM-ID. prog-2. -000013 PROCEDURE. -error: syntax error, unexpected ., expecting DIVISION -000014 END PROGRAM prog-2. -000015 -000016 END PROGRAM prog-1. - GnuCOBOL V.R.P progc.cob DDD MMM dd HH:MM:SS YYYY Page 0002 - -SIZE TYPE LVL NAME PICTURE - - PROGRAM prog-1 - - WORKING-STORAGE SECTION - -00001 ALPHANUMERIC 01 blah X - - PROGRAM prog-2 - - No fields defined. - - - GnuCOBOL V.R.P progc.cob DDD MMM dd HH:MM:SS YYYY Page 0003 - -Error/Warning summary: - -progc.cob:13: error: syntax error, unexpected ., expecting DIVISION - -0 warnings in compilation group -1 error in compilation group -_ATEOF - - -# Check once with $COMPILE and once with $COMPILE_ONLY. -# This tests whether codegen affects the listing. -{ set +x -$as_echo "$at_srcdir/listings.at:1667: \$COMPILE -t prog.lst -tsymbols progc.cob" -at_fn_check_prepare_dynamic "$COMPILE -t prog.lst -tsymbols progc.cob" "listings.at:1667" -( $at_check_trace; $COMPILE -t prog.lst -tsymbols progc.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "progc.cob:13: error: syntax error, unexpected ., expecting DIVISION -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/listings.at:1667" -$at_failed && at_fn_log_failure \ -"prog.lst" \ -"prog2.lst" -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/listings.at:1670: gcdiff -IGnuCOBOL prog20c.lst prog.lst" -at_fn_check_prepare_trace "listings.at:1670" -( $at_check_trace; gcdiff -IGnuCOBOL prog20c.lst prog.lst -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/listings.at:1670" -$at_failed && at_fn_log_failure \ -"prog.lst" \ -"prog2.lst" -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/listings.at:1671: \$COMPILE_ONLY -t prog2.lst -tsymbols progc.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY -t prog2.lst -tsymbols progc.cob" "listings.at:1671" -( $at_check_trace; $COMPILE_ONLY -t prog2.lst -tsymbols progc.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "progc.cob:13: error: syntax error, unexpected ., expecting DIVISION -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/listings.at:1671" -$at_failed && at_fn_log_failure \ -"prog.lst" \ -"prog2.lst" -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/listings.at:1674: gcdiff -IGnuCOBOL prog20c.lst prog2.lst" -at_fn_check_prepare_trace "listings.at:1674" -( $at_check_trace; gcdiff -IGnuCOBOL prog20c.lst prog2.lst -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/listings.at:1674" -$at_failed && at_fn_log_failure \ -"prog.lst" \ -"prog2.lst" -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_402 -#AT_START_403 -at_fn_group_banner 403 'listings.at:1679' \ - "Multiple programs in one compilation group" " " 3 -at_xfail=no -( - $as_echo "403. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -# TODO CHECK -# combinations and positions of entries in compilation group, -# the previous test should likely produce a different result, too... - - - -cat >prog-1.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog-1. - - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 blah PIC x. - - PROCEDURE DIVISION. - ACCEPT blah END-ACCEPT - CALL "prog-2" USING blah END-CALL - GO TO EX - - DISPLAY blah. - - EX. STOP RUN. -_ATEOF - - -cat >prog-2.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog-2. - - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 data-b PIC 9. - LINKAGE SECTION. - 01 stuff PIC x. - PROCEDURE DIVISION USING stuff. - - MOVE FUNCTION NUMVAL (stuff) TO data-b - DISPLAY data-b - GO TO EX - - ACCEPT stuff. - - EX. STOP RUN. - -_ATEOF - - -cat >expected.lst <<'_ATEOF' -GnuCOBOL V.R.P prog-1.cob DDD MMM dd HH:MM:SS YYYY Page 0001 - -LINE PG/LN A...B............................................................ - -000001 -000002 IDENTIFICATION DIVISION. -000003 PROGRAM-ID. prog-1. -000004 -000005 DATA DIVISION. -000006 WORKING-STORAGE SECTION. -000007 01 blah PIC x. -000008 -000009 PROCEDURE DIVISION. -000010 ACCEPT blah END-ACCEPT -000011 CALL "prog-2" USING blah END-CALL -000012 GO TO EX -000013 -000014 DISPLAY blah. -warning: unreachable statement 'DISPLAY' -000015 -000016 EX. STOP RUN. - GnuCOBOL V.R.P prog-1.cob DDD MMM dd HH:MM:SS YYYY Page 0002 - -SIZE TYPE LVL NAME PICTURE - - WORKING-STORAGE SECTION - -00001 ALPHANUMERIC 01 blah X - - GnuCOBOL V.R.P prog-1.cob DDD MMM dd HH:MM:SS YYYY Page 0003 - -NAME DEFINED REFERENCES - -blah 7 *10 11 14 - - GnuCOBOL V.R.P prog-1.cob DDD MMM dd HH:MM:SS YYYY Page 0004 - -LABEL DEFINED REFERENCES - -E prog__1 9 -P EX 16 12 - GnuCOBOL V.R.P prog-1.cob DDD MMM dd HH:MM:SS YYYY Page 0005 - -FUNCTION TYPE REFERENCES - -L prog-2 EXTERN 11 - - GnuCOBOL V.R.P prog-1.cob DDD MMM dd HH:MM:SS YYYY Page 0006 - -Error/Warning summary: - -prog-1.cob:14: warning: unreachable statement 'DISPLAY' - -1 warning in compilation group -0 errors in compilation group - GnuCOBOL V.R.P prog-2.cob DDD MMM dd HH:MM:SS YYYY Page 0001 - -LINE PG/LN A...B............................................................ - -000001 -000002 IDENTIFICATION DIVISION. -000003 PROGRAM-ID. prog-2. -000004 -000005 DATA DIVISION. -000006 WORKING-STORAGE SECTION. -000007 01 data-b PIC 9. -000008 LINKAGE SECTION. -000009 01 stuff PIC x. -000010 PROCEDURE DIVISION USING stuff. -000011 -000012 MOVE FUNCTION NUMVAL (stuff) TO data-b -000013 DISPLAY data-b -000014 GO TO EX -000015 -000016 ACCEPT stuff. -warning: unreachable statement 'ACCEPT' -000017 -000018 EX. STOP RUN. -000019 - GnuCOBOL V.R.P prog-2.cob DDD MMM dd HH:MM:SS YYYY Page 0002 - -SIZE TYPE LVL NAME PICTURE - - WORKING-STORAGE SECTION - -00001 NUMERIC 01 data-b 9 - - LINKAGE SECTION - -00001 ALPHANUMERIC 01 stuff X - - GnuCOBOL V.R.P prog-2.cob DDD MMM dd HH:MM:SS YYYY Page 0003 - -NAME DEFINED REFERENCES - -data-b 7 *12 13 - -stuff 9 *10 12 *16 - - GnuCOBOL V.R.P prog-2.cob DDD MMM dd HH:MM:SS YYYY Page 0004 - -LABEL DEFINED REFERENCES - -E prog__2 10 -P EX 18 14 - - GnuCOBOL V.R.P prog-2.cob DDD MMM dd HH:MM:SS YYYY Page 0005 - -Error/Warning summary: - -prog-2.cob:16: warning: unreachable statement 'ACCEPT' - -2 warnings in compilation group -0 errors in compilation group -_ATEOF - - -# Check once with $COMPILE and once with $COMPILE_ONLY. -# This tests whether codegen affects the listing. - -{ set +x -$as_echo "$at_srcdir/listings.at:1847: \$COMPILE -x -Wunreachable -t prog.lst -Xref -tsymbols prog-1.cob prog-2.cob" -at_fn_check_prepare_dynamic "$COMPILE -x -Wunreachable -t prog.lst -Xref -tsymbols prog-1.cob prog-2.cob" "listings.at:1847" -( $at_check_trace; $COMPILE -x -Wunreachable -t prog.lst -Xref -tsymbols prog-1.cob prog-2.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog-1.cob:14: warning: unreachable statement 'DISPLAY' -prog-2.cob:16: warning: unreachable statement 'ACCEPT' -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/listings.at:1847" -$at_failed && at_fn_log_failure \ -"prog.lst" -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/listings.at:1851: gcdiff -IGnuCOBOL expected.lst prog.lst" -at_fn_check_prepare_trace "listings.at:1851" -( $at_check_trace; gcdiff -IGnuCOBOL expected.lst prog.lst -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/listings.at:1851" -$at_failed && at_fn_log_failure \ -"prog.lst" -$at_traceon; } - - -{ set +x -$as_echo "$at_srcdir/listings.at:1853: \$COMPILE_ONLY -Wunreachable -t prog.lst -Xref -tsymbols prog-1.cob prog-2.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY -Wunreachable -t prog.lst -Xref -tsymbols prog-1.cob prog-2.cob" "listings.at:1853" -( $at_check_trace; $COMPILE_ONLY -Wunreachable -t prog.lst -Xref -tsymbols prog-1.cob prog-2.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog-1.cob:14: warning: unreachable statement 'DISPLAY' -prog-2.cob:16: warning: unreachable statement 'ACCEPT' -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/listings.at:1853" -$at_failed && at_fn_log_failure \ -"prog.lst" -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/listings.at:1857: gcdiff -IGnuCOBOL expected.lst prog.lst" -at_fn_check_prepare_trace "listings.at:1857" -( $at_check_trace; gcdiff -IGnuCOBOL expected.lst prog.lst -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/listings.at:1857" -$at_failed && at_fn_log_failure \ -"prog.lst" -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_403 -#AT_START_404 -at_fn_group_banner 404 'listings.at:1862' \ - "Wide listing" " " 3 -at_xfail=no -( - $as_echo "404. $at_setup_line: testing $at_desc ..." - $at_traceon - - - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. PROG001 - PROGRAM-ID. prog. PROG002 - DATA DIVISION. PROG003 - WORKING-STORAGE SECTION. PROG004 - / PROG005 - PROCEDURE DIVISION. PROG006 - STOP RUN. PROG007 -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/listings.at:1877: \$COMPILE_ONLY -T prog.lst prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY -T prog.lst prog.cob" "listings.at:1877" -( $at_check_trace; $COMPILE_ONLY -T prog.lst prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/listings.at:1877" -$at_failed && at_fn_log_failure \ -"prog.lst" -$at_traceon; } - - -cat >prog9.lst <<'_ATEOF' -GnuCOBOL V.R.P prog.cob DDD MMM dd HH:MM:SS YYYY Page 0001 - -LINE PG/LN A...B............................................................SEQUENCE - -000001 -000002 IDENTIFICATION DIVISION. PROG001 -000003 PROGRAM-ID. prog. PROG002 -000004 DATA DIVISION. PROG003 -000005 WORKING-STORAGE SECTION. PROG004 - GnuCOBOL V.R.P prog.cob DDD MMM dd HH:MM:SS YYYY Page 0002 - -LINE PG/LN A...B............................................................SEQUENCE - -000006 / PROG005 -000007 PROCEDURE DIVISION. PROG006 -000008 STOP RUN. PROG007 - - -0 warnings in compilation group -0 errors in compilation group -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/listings.at:1902: gcdiff -IGnuCOBOL prog9.lst prog.lst" -at_fn_check_prepare_trace "listings.at:1902" -( $at_check_trace; gcdiff -IGnuCOBOL prog9.lst prog.lst -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/listings.at:1902" -$at_failed && at_fn_log_failure \ -"prog.lst" -$at_traceon; } - - -cat >prog2.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog2. - DATA DIVISION. - WORKING-STORAGE SECTION. - >> PAGE page feed comment - PROCEDURE DIVISION. - DISPLAY - '3456&'. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/listings.at:1916: \$COMPILE_ONLY -T prog.lst -free prog2.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY -T prog.lst -free prog2.cob" "listings.at:1916" -( $at_check_trace; $COMPILE_ONLY -T prog.lst -free prog2.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/listings.at:1916" -$at_failed && at_fn_log_failure \ -"prog.lst" -$at_traceon; } - - -cat >prog10.lst <<'_ATEOF' -GnuCOBOL V.R.P prog2.cob DDD MMM dd HH:MM:SS YYYY Page 0001 - -LINE .....................................................SOURCE..................................................... - -000001 -000002 IDENTIFICATION DIVISION. -000003 PROGRAM-ID. prog2. -000004 DATA DIVISION. -000005 WORKING-STORAGE SECTION. - GnuCOBOL V.R.P prog2.cob DDD MMM dd HH:MM:SS YYYY Page 0002 - -LINE .....................................................SOURCE..................................................... - -000006 >> PAGE page feed comment -000007 PROCEDURE DIVISION. -000008 DISPLAY -000009 '3456&'. -000010 STOP RUN. - - -0 warnings in compilation group -0 errors in compilation group -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/listings.at:1943: gcdiff -IGnuCOBOL prog10.lst prog.lst" -at_fn_check_prepare_trace "listings.at:1943" -( $at_check_trace; gcdiff -IGnuCOBOL prog10.lst prog.lst -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/listings.at:1943" -$at_failed && at_fn_log_failure \ -"prog.lst" -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_404 -#AT_START_405 -at_fn_group_banner 405 'listings.at:1948' \ - "Symbols: simple" " " 3 -at_xfail=no -( - $as_echo "405. $at_setup_line: testing $at_desc ..." - $at_traceon - - - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 WS-ONE PIC 9(4) VALUE 37. - 01 WS-TWO PIC A(4) VALUE 'HIGH'. - 01 WS-THREE PIC X(4) VALUE 'BAR'. - 01 WS-FOUR COMP-1 VALUE 37. - 01 WS-FIVE COMP-2 VALUE 37. - 01 WS-SIX PIC S999 COMP-3 VALUE -37. - 01 WS-SEVEN PIC $$,$$$,$$9.99 VALUE ZERO. - PROCEDURE DIVISION. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/listings.at:1969: \$COMPILE_ONLY -t prog.lst -tlines=0 -tsymbols prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY -t prog.lst -tlines=0 -tsymbols prog.cob" "listings.at:1969" -( $at_check_trace; $COMPILE_ONLY -t prog.lst -tlines=0 -tsymbols prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/listings.at:1969" -$at_failed && at_fn_log_failure \ -"prog.lst" -$at_traceon; } - - -cat >prog15.lst <<'_ATEOF' -GnuCOBOL V.R.P prog.cob DDD MMM dd HH:MM:SS YYYY - -LINE PG/LN A...B............................................................ - -000001 -000002 IDENTIFICATION DIVISION. -000003 PROGRAM-ID. prog. -000004 DATA DIVISION. -000005 WORKING-STORAGE SECTION. -000006 01 WS-ONE PIC 9(4) VALUE 37. -000007 01 WS-TWO PIC A(4) VALUE 'HIGH'. -000008 01 WS-THREE PIC X(4) VALUE 'BAR'. -000009 01 WS-FOUR COMP-1 VALUE 37. -000010 01 WS-FIVE COMP-2 VALUE 37. -000011 01 WS-SIX PIC S999 COMP-3 VALUE -37. -000012 01 WS-SEVEN PIC $$,$$$,$$9.99 VALUE ZERO. -000013 PROCEDURE DIVISION. -000014 STOP RUN. - -SIZE TYPE LVL NAME PICTURE - - WORKING-STORAGE SECTION - -00004 NUMERIC 01 WS-ONE 9(4) - -00004 ALPHABETIC 01 WS-TWO A(4) - -00004 ALPHANUMERIC 01 WS-THREE X(4) - -00004 NUMERIC 01 WS-FOUR S9(7)V9(8) COMP-1 - -00008 NUMERIC 01 WS-FIVE S9(17)V9(17) COMP-2 - -00002 NUMERIC 01 WS-SIX S999 COMP-3 - -00013 NUMERIC 01 WS-SEVEN $$,$$$,$$9.99 - - -0 warnings in compilation group -0 errors in compilation group -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/listings.at:2014: gcdiff -IGnuCOBOL prog15.lst prog.lst" -at_fn_check_prepare_trace "listings.at:2014" -( $at_check_trace; gcdiff -IGnuCOBOL prog15.lst prog.lst -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/listings.at:2014" -$at_failed && at_fn_log_failure \ -"prog.lst" -$at_traceon; } - - -cat >prog2.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog2. - DATA DIVISION. - LINKAGE SECTION. - 01 WS-ONE PIC 9(4). - 01 WS-TWO PIC A(4). - 01 WS-THREE PIC X(4). - PROCEDURE DIVISION. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/listings.at:2028: \$COMPILE_ONLY -t prog.lst -tlines=0 -tsymbols prog2.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY -t prog.lst -tlines=0 -tsymbols prog2.cob" "listings.at:2028" -( $at_check_trace; $COMPILE_ONLY -t prog.lst -tlines=0 -tsymbols prog2.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/listings.at:2028" -$at_failed && at_fn_log_failure \ -"prog.lst" -$at_traceon; } - - -cat >prog16.lst <<'_ATEOF' -GnuCOBOL V.R.P prog2.cob DDD MMM dd HH:MM:SS YYYY - -LINE PG/LN A...B............................................................ - -000001 -000002 IDENTIFICATION DIVISION. -000003 PROGRAM-ID. prog2. -000004 DATA DIVISION. -000005 LINKAGE SECTION. -000006 01 WS-ONE PIC 9(4). -000007 01 WS-TWO PIC A(4). -000008 01 WS-THREE PIC X(4). -000009 PROCEDURE DIVISION. -000010 STOP RUN. - -SIZE TYPE LVL NAME PICTURE - - LINKAGE SECTION - -00004 ALPHANUMERIC 01 WS-ONE 9(4) - -00004 ALPHANUMERIC 01 WS-TWO A(4) - -00004 ALPHANUMERIC 01 WS-THREE X(4) - - -0 warnings in compilation group -0 errors in compilation group -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/listings.at:2061: gcdiff -IGnuCOBOL prog16.lst prog.lst" -at_fn_check_prepare_trace "listings.at:2061" -( $at_check_trace; gcdiff -IGnuCOBOL prog16.lst prog.lst -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/listings.at:2061" -$at_failed && at_fn_log_failure \ -"prog.lst" -$at_traceon; } - - -cat >prog3.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog3. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 WS-ONE PIC 9(4) VALUE 37. - 01 WS-TWO PIC A(4) VALUE 'HIGH'. - 01 WS-THREE PIC X(4) VALUE 'BAR'. - 01 WS-FOUR COMP-1 VALUE 37. - 01 WS-FIVE COMP-2 VALUE 37. - 01 WS-SIX PIC S999 COMP-3 VALUE -37. - 01 WS-SEVEN PIC $$,$$$,$$9.99 VALUE ZERO. - PROCEDURE DIVISION. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/listings.at:2079: \$COMPILE_ONLY -t prog.lst prog3.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY -t prog.lst prog3.cob" "listings.at:2079" -( $at_check_trace; $COMPILE_ONLY -t prog.lst prog3.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/listings.at:2079" -$at_failed && at_fn_log_failure \ -"prog.lst" -$at_traceon; } - - -cat >prog15-1.lst <<'_ATEOF' -GnuCOBOL V.R.P prog3.cob DDD MMM dd HH:MM:SS YYYY Page 0001 - -LINE PG/LN A...B............................................................ - -000001 -000002 IDENTIFICATION DIVISION. -000003 PROGRAM-ID. prog3. -000004 DATA DIVISION. -000005 WORKING-STORAGE SECTION. -000006 01 WS-ONE PIC 9(4) VALUE 37. -000007 01 WS-TWO PIC A(4) VALUE 'HIGH'. -000008 01 WS-THREE PIC X(4) VALUE 'BAR'. -000009 01 WS-FOUR COMP-1 VALUE 37. -000010 01 WS-FIVE COMP-2 VALUE 37. -000011 01 WS-SIX PIC S999 COMP-3 VALUE -37. -000012 01 WS-SEVEN PIC $$,$$$,$$9.99 VALUE ZERO. -000013 PROCEDURE DIVISION. -000014 STOP RUN. - - -0 warnings in compilation group -0 errors in compilation group -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/listings.at:2106: gcdiff -IGnuCOBOL prog15-1.lst prog.lst" -at_fn_check_prepare_trace "listings.at:2106" -( $at_check_trace; gcdiff -IGnuCOBOL prog15-1.lst prog.lst -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/listings.at:2106" -$at_failed && at_fn_log_failure \ -"prog.lst" -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_405 -#AT_START_406 -at_fn_group_banner 406 'listings.at:2111' \ - "Symbols: pointer" " " 3 -at_xfail=no -( - $as_echo "406. $at_setup_line: testing $at_desc ..." - $at_traceon - - - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 77 WS-Where pic x(512). - - 01 ws-mysql. - 02 ws-mysql-cid usage pointer. - 02 ws-mysql-result usage pointer. - 02 ws-mysql-result-2 usage pointer. - 02 ws-mysql-result-3 usage pointer. - 02 ws-mysql-count-rows pic s9(9) comp. - 02 ws-mysql-error-number pic x(4). - 02 ws-mysql-error-message pic x(80). - 02 ws-mysql-host-name pic x(64). - 02 ws-mysql-implementation pic x(64). - 02 ws-mysql-password pic x(64). - 02 ws-mysql-base-name pic x(64). - 02 ws-mysql-port-number pic x(4). - 02 ws-mysql-socket pic x(64). - 02 ws-mysql-command pic x(4096). - - 01 ws-No-Paragraph pic 9(4). - local-storage section. - 01 subscripts usage comp-5. - 12 J pic s9(4). - 12 K pic s9(4). - 12 L pic s9(4). - - SCREEN SECTION. - 01 Display-Message-1 foreground-color 2. - 03 value "WS-Where=" line 23 col 1. - 03 from WS-Where (1:J) pic x(69) col 10. - 01 Display-Message-2 foreground-color 2. - 03 value "ST004 SQL Err No.=" line 4 col 1. - 03 using ws-mysql-error-number pic x(4) col 19. - 03 value " Para=" col 23. - 03 using WS-No-Paragraph pic 9(3) col 29. - 03 value " SQL Cmd=" col 32. - 03 using ws-mysql-command pic x(199) col 41. - 03 value "SQL Err Msg=" line 7 col 1. - 03 using ws-mysql-error-message pic x(67) col 13. - PROCEDURE DIVISION. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/listings.at:2163: \$COMPILE_ONLY -t prog.lst -tlines=0 -tsymbols prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY -t prog.lst -tlines=0 -tsymbols prog.cob" "listings.at:2163" -( $at_check_trace; $COMPILE_ONLY -t prog.lst -tlines=0 -tsymbols prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/listings.at:2163" -$at_failed && at_fn_log_failure \ -"prog.lst" -$at_traceon; } - - -{ set +x -$as_echo "$at_srcdir/listings.at:2165: test \"\$COB_HAS_64_BIT_POINTER\" = \"yes\"" -at_fn_check_prepare_dynamic "test \"$COB_HAS_64_BIT_POINTER\" = \"yes\"" "listings.at:2165" -( $at_check_trace; test "$COB_HAS_64_BIT_POINTER" = "yes" -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/listings.at:2165" -if $at_failed; then : - # Previous test "failed" --> 32 bit - -cat >prog17-32.lst <<'_ATEOF' -GnuCOBOL V.R.P prog.cob DDD MMM dd HH:MM:SS YYYY - -LINE PG/LN A...B............................................................ - -000001 -000002 IDENTIFICATION DIVISION. -000003 PROGRAM-ID. prog. -000004 DATA DIVISION. -000005 WORKING-STORAGE SECTION. -000006 77 WS-Where pic x(512). -000007 -000008 01 ws-mysql. -000009 02 ws-mysql-cid usage pointer. -000010 02 ws-mysql-result usage pointer. -000011 02 ws-mysql-result-2 usage pointer. -000012 02 ws-mysql-result-3 usage pointer. -000013 02 ws-mysql-count-rows pic s9(9) comp. -000014 02 ws-mysql-error-number pic x(4). -000015 02 ws-mysql-error-message pic x(80). -000016 02 ws-mysql-host-name pic x(64). -000017 02 ws-mysql-implementation pic x(64). -000018 02 ws-mysql-password pic x(64). -000019 02 ws-mysql-base-name pic x(64). -000020 02 ws-mysql-port-number pic x(4). -000021 02 ws-mysql-socket pic x(64). -000022 02 ws-mysql-command pic x(4096). -000023 -000024 01 ws-No-Paragraph pic 9(4). -000025 local-storage section. -000026 01 subscripts usage comp-5. -000027 12 J pic s9(4). -000028 12 K pic s9(4). -000029 12 L pic s9(4). -000030 -000031 SCREEN SECTION. -000032 01 Display-Message-1 foreground-color 2. -000033 03 value "WS-Where=" line 23 col 1. -000034 03 from WS-Where (1:J) pic x(69) col 10. -000035 01 Display-Message-2 foreground-color 2. -000036 03 value "ST004 SQL Err No.=" line 4 col 1. -000037 03 using ws-mysql-error-number pic x(4) col 19. -000038 03 value " Para=" col 23. -000039 03 using WS-No-Paragraph pic 9(3) col 29. -000040 03 value " SQL Cmd=" col 32. -000041 03 using ws-mysql-command pic x(199) col 41. -000042 03 value "SQL Err Msg=" line 7 col 1. -000043 03 using ws-mysql-error-message pic x(67) col 13. -000044 PROCEDURE DIVISION. -000045 STOP RUN. - -SIZE TYPE LVL NAME PICTURE - - WORKING-STORAGE SECTION - -00512 ALPHANUMERIC 77 WS-Where X(512) - -04524 GROUP 01 ws-mysql -00004 POINTER 02 ws-mysql-cid -00004 POINTER 02 ws-mysql-result -00004 POINTER 02 ws-mysql-result-2 -00004 POINTER 02 ws-mysql-result-3 -00004 NUMERIC 02 ws-mysql-count-rows S9(9) COMP -00004 ALPHANUMERIC 02 ws-mysql-error-number X(4) -00080 ALPHANUMERIC 02 ws-mysql-error-message X(80) -00064 ALPHANUMERIC 02 ws-mysql-host-name X(64) -00064 ALPHANUMERIC 02 ws-mysql-implementation X(64) -00064 ALPHANUMERIC 02 ws-mysql-password X(64) -00064 ALPHANUMERIC 02 ws-mysql-base-name X(64) -00004 ALPHANUMERIC 02 ws-mysql-port-number X(4) -00064 ALPHANUMERIC 02 ws-mysql-socket X(64) -04096 ALPHANUMERIC 02 ws-mysql-command X(4096) - -00004 ALPHANUMERIC 01 ws-No-Paragraph 9(4) - - LOCAL-STORAGE SECTION - -00006 GROUP 01 subscripts -00002 NUMERIC 12 J S9(4) COMP-5 -00002 NUMERIC 12 K S9(4) COMP-5 -00002 NUMERIC 12 L S9(4) COMP-5 - - SCREEN SECTION - -00078 GROUP 01 Display-Message-1 -00009 ALPHANUMERIC 03 FILLER X(9) -00069 ALPHANUMERIC 03 FILLER X(69) - -00318 GROUP 01 Display-Message-2 -00018 ALPHANUMERIC 03 FILLER X(18) -00004 ALPHANUMERIC 03 FILLER X(4) -00006 ALPHANUMERIC 03 FILLER X(6) -00003 ALPHANUMERIC 03 FILLER 9(3) -00009 ALPHANUMERIC 03 FILLER X(9) -00199 ALPHANUMERIC 03 FILLER X(199) -00012 ALPHANUMERIC 03 FILLER X(12) -00067 ALPHANUMERIC 03 FILLER X(67) - - -0 warnings in compilation group -0 errors in compilation group -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/listings.at:2165: gcdiff -IGnuCOBOL prog17-32.lst prog.lst" -at_fn_check_prepare_trace "listings.at:2165" -( $at_check_trace; gcdiff -IGnuCOBOL prog17-32.lst prog.lst -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/listings.at:2165" -$at_failed && at_fn_log_failure \ -"prog.lst" -$at_traceon; } - - - -else - # Previous test "passed" --> 64 bit - -cat >prog17-64.lst <<'_ATEOF' -GnuCOBOL V.R.P prog.cob DDD MMM dd HH:MM:SS YYYY - -LINE PG/LN A...B............................................................ - -000001 -000002 IDENTIFICATION DIVISION. -000003 PROGRAM-ID. prog. -000004 DATA DIVISION. -000005 WORKING-STORAGE SECTION. -000006 77 WS-Where pic x(512). -000007 -000008 01 ws-mysql. -000009 02 ws-mysql-cid usage pointer. -000010 02 ws-mysql-result usage pointer. -000011 02 ws-mysql-result-2 usage pointer. -000012 02 ws-mysql-result-3 usage pointer. -000013 02 ws-mysql-count-rows pic s9(9) comp. -000014 02 ws-mysql-error-number pic x(4). -000015 02 ws-mysql-error-message pic x(80). -000016 02 ws-mysql-host-name pic x(64). -000017 02 ws-mysql-implementation pic x(64). -000018 02 ws-mysql-password pic x(64). -000019 02 ws-mysql-base-name pic x(64). -000020 02 ws-mysql-port-number pic x(4). -000021 02 ws-mysql-socket pic x(64). -000022 02 ws-mysql-command pic x(4096). -000023 -000024 01 ws-No-Paragraph pic 9(4). -000025 local-storage section. -000026 01 subscripts usage comp-5. -000027 12 J pic s9(4). -000028 12 K pic s9(4). -000029 12 L pic s9(4). -000030 -000031 SCREEN SECTION. -000032 01 Display-Message-1 foreground-color 2. -000033 03 value "WS-Where=" line 23 col 1. -000034 03 from WS-Where (1:J) pic x(69) col 10. -000035 01 Display-Message-2 foreground-color 2. -000036 03 value "ST004 SQL Err No.=" line 4 col 1. -000037 03 using ws-mysql-error-number pic x(4) col 19. -000038 03 value " Para=" col 23. -000039 03 using WS-No-Paragraph pic 9(3) col 29. -000040 03 value " SQL Cmd=" col 32. -000041 03 using ws-mysql-command pic x(199) col 41. -000042 03 value "SQL Err Msg=" line 7 col 1. -000043 03 using ws-mysql-error-message pic x(67) col 13. -000044 PROCEDURE DIVISION. -000045 STOP RUN. - -SIZE TYPE LVL NAME PICTURE - - WORKING-STORAGE SECTION - -00512 ALPHANUMERIC 77 WS-Where X(512) - -04540 GROUP 01 ws-mysql -00008 POINTER 02 ws-mysql-cid -00008 POINTER 02 ws-mysql-result -00008 POINTER 02 ws-mysql-result-2 -00008 POINTER 02 ws-mysql-result-3 -00004 NUMERIC 02 ws-mysql-count-rows S9(9) COMP -00004 ALPHANUMERIC 02 ws-mysql-error-number X(4) -00080 ALPHANUMERIC 02 ws-mysql-error-message X(80) -00064 ALPHANUMERIC 02 ws-mysql-host-name X(64) -00064 ALPHANUMERIC 02 ws-mysql-implementation X(64) -00064 ALPHANUMERIC 02 ws-mysql-password X(64) -00064 ALPHANUMERIC 02 ws-mysql-base-name X(64) -00004 ALPHANUMERIC 02 ws-mysql-port-number X(4) -00064 ALPHANUMERIC 02 ws-mysql-socket X(64) -04096 ALPHANUMERIC 02 ws-mysql-command X(4096) - -00004 ALPHANUMERIC 01 ws-No-Paragraph 9(4) - - LOCAL-STORAGE SECTION - -00006 GROUP 01 subscripts -00002 NUMERIC 12 J S9(4) COMP-5 -00002 NUMERIC 12 K S9(4) COMP-5 -00002 NUMERIC 12 L S9(4) COMP-5 - - SCREEN SECTION - -00078 GROUP 01 Display-Message-1 -00009 ALPHANUMERIC 03 FILLER X(9) -00069 ALPHANUMERIC 03 FILLER X(69) - -00318 GROUP 01 Display-Message-2 -00018 ALPHANUMERIC 03 FILLER X(18) -00004 ALPHANUMERIC 03 FILLER X(4) -00006 ALPHANUMERIC 03 FILLER X(6) -00003 ALPHANUMERIC 03 FILLER 9(3) -00009 ALPHANUMERIC 03 FILLER X(9) -00199 ALPHANUMERIC 03 FILLER X(199) -00012 ALPHANUMERIC 03 FILLER X(12) -00067 ALPHANUMERIC 03 FILLER X(67) - - -0 warnings in compilation group -0 errors in compilation group -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/listings.at:2165: gcdiff -IGnuCOBOL prog17-64.lst prog.lst" -at_fn_check_prepare_trace "listings.at:2165" -( $at_check_trace; gcdiff -IGnuCOBOL prog17-64.lst prog.lst -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/listings.at:2165" -$at_failed && at_fn_log_failure \ -"prog.lst" -$at_traceon; } - - - -fi -$at_failed && at_fn_log_failure \ -"prog.lst" -$at_traceon; } - - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_406 -#AT_START_407 -at_fn_group_banner 407 'listings.at:2389' \ - "Symbols: multiple programs/functions" " " 3 -at_xfail=no -( - $as_echo "407. $at_setup_line: testing $at_desc ..." - $at_traceon - - - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - FUNCTION-ID. WITHPAR. - DATA DIVISION. - LINKAGE SECTION. - 01 PAR-IN PIC 9. - 01 PAR-OUT PIC 9. - PROCEDURE DIVISION USING PAR-IN RETURNING PAR-OUT. - ADD 1 TO PAR-IN GIVING PAR-OUT END-ADD. - GOBACK. - END FUNCTION WITHPAR. - - IDENTIFICATION DIVISION. - FUNCTION-ID. WITHOUTPAR. - DATA DIVISION. - LINKAGE SECTION. - 01 PAR PIC 9. - PROCEDURE DIVISION RETURNING PAR. - MOVE 1 TO PAR. - GOBACK. - END FUNCTION WITHOUTPAR. - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - CONFIGURATION SECTION. - REPOSITORY. - FUNCTION WITHPAR - FUNCTION WITHOUTPAR. - PROCEDURE DIVISION. - IF WITHPAR(1) NOT = 2 - DISPLAY WITHPAR(1) - END-DISPLAY - END-IF. - IF WITHOUTPAR NOT = 1 - DISPLAY WITHOUTPAR - END-DISPLAY - END-IF. - STOP RUN. - END PROGRAM prog. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/listings.at:2436: \$COMPILE_ONLY -t prog.lst -tsymbols prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY -t prog.lst -tsymbols prog.cob" "listings.at:2436" -( $at_check_trace; $COMPILE_ONLY -t prog.lst -tsymbols prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/listings.at:2436" -$at_failed && at_fn_log_failure \ -"prog.lst" -$at_traceon; } - - -cat >prog18.lst <<'_ATEOF' -GnuCOBOL V.R.P prog.cob DDD MMM dd HH:MM:SS YYYY Page 0001 - -LINE PG/LN A...B............................................................ - -000001 -000002 IDENTIFICATION DIVISION. -000003 FUNCTION-ID. WITHPAR. -000004 DATA DIVISION. -000005 LINKAGE SECTION. -000006 01 PAR-IN PIC 9. -000007 01 PAR-OUT PIC 9. -000008 PROCEDURE DIVISION USING PAR-IN RETURNING PAR-OUT. -000009 ADD 1 TO PAR-IN GIVING PAR-OUT END-ADD. -000010 GOBACK. -000011 END FUNCTION WITHPAR. -000012 -000013 IDENTIFICATION DIVISION. -000014 FUNCTION-ID. WITHOUTPAR. -000015 DATA DIVISION. -000016 LINKAGE SECTION. -000017 01 PAR PIC 9. -000018 PROCEDURE DIVISION RETURNING PAR. -000019 MOVE 1 TO PAR. -000020 GOBACK. -000021 END FUNCTION WITHOUTPAR. -000022 -000023 IDENTIFICATION DIVISION. -000024 PROGRAM-ID. prog. -000025 ENVIRONMENT DIVISION. -000026 CONFIGURATION SECTION. -000027 REPOSITORY. -000028 FUNCTION WITHPAR -000029 FUNCTION WITHOUTPAR. -000030 PROCEDURE DIVISION. -000031 IF WITHPAR(1) NOT = 2 -000032 DISPLAY WITHPAR(1) -000033 END-DISPLAY -000034 END-IF. -000035 IF WITHOUTPAR NOT = 1 -000036 DISPLAY WITHOUTPAR -000037 END-DISPLAY -000038 END-IF. -000039 STOP RUN. -000040 END PROGRAM prog. - GnuCOBOL V.R.P prog.cob DDD MMM dd HH:MM:SS YYYY Page 0002 - -SIZE TYPE LVL NAME PICTURE - - FUNCTION WITHPAR - - LINKAGE SECTION - -00001 NUMERIC 01 PAR-IN 9 - -00001 NUMERIC 01 PAR-OUT 9 - - FUNCTION WITHOUTPAR - - LINKAGE SECTION - -00001 NUMERIC 01 PAR 9 - - PROGRAM prog - - No fields defined. - - -0 warnings in compilation group -0 errors in compilation group -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/listings.at:2510: gcdiff -IGnuCOBOL prog18.lst prog.lst" -at_fn_check_prepare_trace "listings.at:2510" -( $at_check_trace; gcdiff -IGnuCOBOL prog18.lst prog.lst -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/listings.at:2510" -$at_failed && at_fn_log_failure \ -"prog.lst" -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_407 -#AT_START_408 -at_fn_group_banner 408 'listings.at:2515' \ - "Symbols: OCCURS/REDEFINES" " " 3 -at_xfail=no -( - $as_echo "408. $at_setup_line: testing $at_desc ..." - $at_traceon - - - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - CONFIGURATION SECTION. - DATA DIVISION. - WORKING-STORAGE SECTION. - 78 I VALUE 20. - 78 J VALUE 5000. - 78 M VALUE 5. - 01 SETUP-REC. - 05 FL1 PIC X(04). - 05 FL2 PIC ZZZZZ. - 05 FL3 PIC 9(04). - 05 FL4 PIC 9(08) COMP. - 05 FL5 PIC 9(04) COMP-4. - 05 FL6 PIC Z,ZZZ.99. - 05 FL7 PIC S9(05) SIGN LEADING SEPARATE. - 05 FL8 PIC X(04). - 05 FL9 REDEFINES FL8 PIC 9(04). - 05 FLA. - 10 FLB OCCURS I TIMES. - 15 FLC PIC X(02). - 10 FLD PIC X(20). - 05 FLD1 PIC X(100). - 05 FLD2 OCCURS M TO J TIMES DEPENDING ON FL5. - 10 FILLER PIC X(01). - 05 FLD3 PIC X(3). - 05 FLD4 PIC X(4). - PROCEDURE DIVISION. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/listings.at:2553: \$COMPILE_ONLY -fcomplex-odo -t prog.lst -tsymbols prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY -fcomplex-odo -t prog.lst -tsymbols prog.cob" "listings.at:2553" -( $at_check_trace; $COMPILE_ONLY -fcomplex-odo -t prog.lst -tsymbols prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/listings.at:2553" -$at_failed && at_fn_log_failure \ -"prog.lst" -$at_traceon; } - - -cat >prog19.lst <<'_ATEOF' -GnuCOBOL V.R.P prog.cob DDD MMM dd HH:MM:SS YYYY Page 0001 - -LINE PG/LN A...B............................................................ - -000001 -000002 IDENTIFICATION DIVISION. -000003 PROGRAM-ID. prog. -000004 ENVIRONMENT DIVISION. -000005 CONFIGURATION SECTION. -000006 DATA DIVISION. -000007 WORKING-STORAGE SECTION. -000008 78 I VALUE 20. -000009 78 J VALUE 5000. -000010 78 M VALUE 5. -000011 01 SETUP-REC. -000012 05 FL1 PIC X(04). -000013 05 FL2 PIC ZZZZZ. -000014 05 FL3 PIC 9(04). -000015 05 FL4 PIC 9(08) COMP. -000016 05 FL5 PIC 9(04) COMP-4. -000017 05 FL6 PIC Z,ZZZ.99. -000018 05 FL7 PIC S9(05) SIGN LEADING SEPARATE. -000019 05 FL8 PIC X(04). -000020 05 FL9 REDEFINES FL8 PIC 9(04). -000021 05 FLA. -000022 10 FLB OCCURS I TIMES. -000023 15 FLC PIC X(02). -000024 10 FLD PIC X(20). -000025 05 FLD1 PIC X(100). -000026 05 FLD2 OCCURS M TO J TIMES DEPENDING ON FL5. -000027 10 FILLER PIC X(01). -000028 05 FLD3 PIC X(3). -000029 05 FLD4 PIC X(4). -000030 PROCEDURE DIVISION. -000031 STOP RUN. - GnuCOBOL V.R.P prog.cob DDD MMM dd HH:MM:SS YYYY Page 0002 - -SIZE TYPE LVL NAME PICTURE - - WORKING-STORAGE SECTION - -05204 GROUP 01 SETUP-REC -00004 ALPHANUMERIC 05 FL1 X(04) -00005 ALPHANUMERIC 05 FL2 ZZZZZ -00004 ALPHANUMERIC 05 FL3 9(04) -00004 NUMERIC 05 FL4 9(08) COMP -00002 NUMERIC 05 FL5 9(04) COMP -00008 ALPHANUMERIC 05 FL6 Z,ZZZ.99 -00006 ALPHANUMERIC 05 FL7 S9(05) -00004 ALPHANUMERIC 05 FL8 X(04) -00004 ALPHANUMERIC 05 FL9 9(04), REDEFINES FL8 -00060 GROUP 05 FLA -00040 GROUP 10 FLB OCCURS 20 -00002 ALPHANUMERIC 15 FLC X(02) -00020 ALPHANUMERIC 10 FLD X(20) -00100 ALPHANUMERIC 05 FLD1 X(100) -05000 GROUP 05 FLD2 OCCURS 5 TO 5000 -00001 ALPHANUMERIC 10 FILLER X(01) -00003 ALPHANUMERIC 05 FLD3 X(3) -00004 ALPHANUMERIC 05 FLD4 X(4) - - -0 warnings in compilation group -0 errors in compilation group -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/listings.at:2622: gcdiff -IGnuCOBOL prog19.lst prog.lst" -at_fn_check_prepare_trace "listings.at:2622" -( $at_check_trace; gcdiff -IGnuCOBOL prog19.lst prog.lst -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/listings.at:2622" -$at_failed && at_fn_log_failure \ -"prog.lst" -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_408 -#AT_START_409 -at_fn_group_banner 409 'listings.at:2627' \ - "Conditional compilation" " " 3 -at_xfail=no -( - $as_echo "409. $at_setup_line: testing $at_desc ..." - $at_traceon - - - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - PROCEDURE DIVISION. - >>IF ACTIVATE DEFINED - DISPLAY "NOTOK" NO ADVANCING - END-DISPLAY - >>ELIF ACTIVATE2 DEFINED - DISPLAY "OK" NO ADVANCING - END-DISPLAY - >>ELSE - DISPLAY "NOTOK" NO ADVANCING - END-DISPLAY - >>END-IF - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/listings.at:2651: \$COMPILE_ONLY -DACTIVATE2 -t prog.lst prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY -DACTIVATE2 -t prog.lst prog.cob" "listings.at:2651" -( $at_check_trace; $COMPILE_ONLY -DACTIVATE2 -t prog.lst prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/listings.at:2651" -$at_failed && at_fn_log_failure \ -"prog.lst" -$at_traceon; } - - -cat >prog16.lst <<'_ATEOF' -GnuCOBOL V.R.P prog.cob DDD MMM dd HH:MM:SS YYYY Page 0001 - -LINE PG/LN A...B............................................................ - -000001 -000002 IDENTIFICATION DIVISION. -000003 PROGRAM-ID. prog. -000004 DATA DIVISION. -000005 WORKING-STORAGE SECTION. -000006 PROCEDURE DIVISION. -000007 >>IF ACTIVATE DEFINED -000008X DISPLAY "NOTOK" NO ADVANCING -000009X END-DISPLAY -000010 >>ELIF ACTIVATE2 DEFINED -000011 DISPLAY "OK" NO ADVANCING -000012 END-DISPLAY -000013 >>ELSE -000014X DISPLAY "NOTOK" NO ADVANCING -000015X END-DISPLAY -000016 >>END-IF -000017 STOP RUN. - - -0 warnings in compilation group -0 errors in compilation group -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/listings.at:2681: gcdiff -IGnuCOBOL prog16.lst prog.lst" -at_fn_check_prepare_trace "listings.at:2681" -( $at_check_trace; gcdiff -IGnuCOBOL prog16.lst prog.lst -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/listings.at:2681" -$at_failed && at_fn_log_failure \ -"prog.lst" -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_409 -#AT_START_410 -at_fn_group_banner 410 'listings.at:2686' \ - "File descriptions" " " 3 -at_xfail=no -( - $as_echo "410. $at_setup_line: testing $at_desc ..." - $at_traceon - - - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - INPUT-OUTPUT SECTION. - FILE-CONTROL. - SELECT OLD-VERSION ASSIGN TO "SYSUT1" - ORGANIZATION LINE SEQUENTIAL. - SELECT NEW-VERSION ASSIGN TO "SYSUT2" - ORGANIZATION LINE SEQUENTIAL. - SELECT PRT-VERSION ASSIGN TO "SYSUT2" - ORGANIZATION LINE SEQUENTIAL. - SELECT MODIFICATION ASSIGN TO "SYSIN1" - ORGANIZATION LINE SEQUENTIAL. - SELECT COMMENTARY ASSIGN TO "SYSOU1" - ORGANIZATION LINE SEQUENTIAL. - DATA DIVISION. - FILE SECTION. - - FD OLD-VERSION - LABEL RECORDS ARE STANDARD - BLOCK CONTAINS 80 CHARACTERS - DATA RECORD IS OLD-RECORD. - - 01 OLD-RECORD. - 02 OLD-STATEMENT PICTURE X(75). - 02 OLD-NUMBER PICTURE X(5). - - FD NEW-VERSION - LABEL RECORDS ARE STANDARD - BLOCK CONTAINS 80 CHARACTERS - DATA RECORD IS NEW-RECORD. - - 01 NEW-RECORD. - 02 NEW-STATEMENT PICTURE X(75). - 02 NEW-NUMBER PICTURE X(5). - - FD MODIFICATION - LABEL RECORDS ARE OMITTED - BLOCK CONTAINS 80 CHARACTERS - DATA RECORD IS UPDATE-ORDER. - - 01 UPDATE-ORDER. - 02 INSERTION. - 03 COMMAND PICTURE X(6). - 88 ENDJOB VALUE "ENDJOB". - 88 ENDSET VALUE "ENDSET". - 88 REMOVE VALUE "REMOVE". - 88 ADDNEW VALUE "INSERT". - 88 CHANGE VALUE "CHANGE". - 88 DISPLY VALUE "DISPLY". - 03 FILLER PICTURE X. - 03 A-FIELD PICTURE 9(5). - 03 A-ALPHA REDEFINES A-FIELD PICTURE X(5). - 88 A-BLANK VALUE SPACES. - 03 FILLER PICTURE X(4). - 03 B-FIELD PICTURE 9(5). - 03 B-ALPHA REDEFINES B-FIELD PICTURE X(5). - 88 B-BLANK VALUE SPACES. - 03 FILLER PICTURE X(54). - 02 FILLER PICTURE X(5). - - FD COMMENTARY - LABEL RECORDS ARE OMITTED - BLOCK CONTAINS 82 CHARACTERS - DATA RECORD IS COMMENT-LINE. - - 01 COMMENT-LINE. - 02 FILLER PICTURE X(82). - - WORKING-STORAGE SECTION. - - 01 HEADINGS-LINE. - 02 FILLER PICTURE X(15) VALUE "EDITOR VERSION". - 02 FILLER PICTURE X(20) VALUE "1.1 - 206/72". - 02 PHASE PICTURE X(17) VALUE "UPDATING AS OF". - 02 MONTH-RUN PICTURE XX. - 02 FILLER PICTURE X VALUE "/". - 02 DAY-RUN PICTURE XX. - 02 FILLER PICTURE X VALUE "/". - 02 YEAR-RUN PICTURE XX. - 02 FILLER PICTURE X(8) VALUE SPACES. - 02 FILLER PICTURE X(8) VALUE " PAGE: ". - 02 PAGE-NUMBER PICTURE 9(4) VALUE 0. - - 01 COMMAND-LISTING. - 02 FILLER PICTURE X(2) VALUE SPACES. - 02 COMMAND-IMAGE PICTURE X(80). - - 01 ACTIVITIES-LISTING. - 02 DISPOSITION PICTURE X(2). - 02 ACTIVE-IMAGE PICTURE X(80). - - 01 UPSI-BYTE. - 02 UPSI-BIT OCCURS 8 TIMES PICTURE X. - - 01 MESSAGE-LOG. - 02 FILLER PICTURE X(2) VALUE SPACES. - 02 MESSAGE-TEXT PICTURE X(80). - - 01 DISPLAY-MESSAGE. - 02 FILLER PICTURE X(2) VALUE SPACES. - 02 DISPLAY-TEMP PICTURE X(6). - 02 FILLER PICTURE X(2) VALUE SPACES. - 02 DISPLAY-TEXT PICTURE X(60). - - PROCEDURE DIVISION. - OPEN INPUT OLD-VERSION, MODIFICATION, - OUTPUT NEW-VERSION, COMMENTARY. - CLOSE OLD-VERSION, NEW-VERSION, MODIFICATION, COMMENTARY. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/listings.at:2804: \$COMPILE_ONLY -t prog.lst -tlines=0 -tsymbols prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY -t prog.lst -tlines=0 -tsymbols prog.cob" "listings.at:2804" -( $at_check_trace; $COMPILE_ONLY -t prog.lst -tlines=0 -tsymbols prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob:21: warning: LABEL RECORDS is obsolete in GnuCOBOL -prog.cob:23: warning: DATA RECORDS is obsolete in GnuCOBOL -prog.cob:30: warning: LABEL RECORDS is obsolete in GnuCOBOL -prog.cob:32: warning: DATA RECORDS is obsolete in GnuCOBOL -prog.cob:39: warning: LABEL RECORDS is obsolete in GnuCOBOL -prog.cob:41: warning: DATA RECORDS is obsolete in GnuCOBOL -prog.cob:64: warning: LABEL RECORDS is obsolete in GnuCOBOL -prog.cob:66: warning: DATA RECORDS is obsolete in GnuCOBOL -prog.cob:11: error: missing file description for FILE PRT-VERSION -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/listings.at:2804" -$at_failed && at_fn_log_failure \ -"prog.lst" -$at_traceon; } - - - -cat >prog18.lst <<'_ATEOF' -GnuCOBOL V.R.P prog.cob DDD MMM dd HH:MM:SS YYYY - -LINE PG/LN A...B............................................................ - -000001 -000002 IDENTIFICATION DIVISION. -000003 PROGRAM-ID. prog. -000004 ENVIRONMENT DIVISION. -000005 INPUT-OUTPUT SECTION. -000006 FILE-CONTROL. -000007 SELECT OLD-VERSION ASSIGN TO "SYSUT1" -000008 ORGANIZATION LINE SEQUENTIAL. -000009 SELECT NEW-VERSION ASSIGN TO "SYSUT2" -000010 ORGANIZATION LINE SEQUENTIAL. -000011 SELECT PRT-VERSION ASSIGN TO "SYSUT2" -error: missing file description for FILE PRT-VERSION -000012 ORGANIZATION LINE SEQUENTIAL. -000013 SELECT MODIFICATION ASSIGN TO "SYSIN1" -000014 ORGANIZATION LINE SEQUENTIAL. -000015 SELECT COMMENTARY ASSIGN TO "SYSOU1" -000016 ORGANIZATION LINE SEQUENTIAL. -000017 DATA DIVISION. -000018 FILE SECTION. -000019 -000020 FD OLD-VERSION -000021 LABEL RECORDS ARE STANDARD -warning: LABEL RECORDS is obsolete in GnuCOBOL -000022 BLOCK CONTAINS 80 CHARACTERS -000023 DATA RECORD IS OLD-RECORD. -warning: DATA RECORDS is obsolete in GnuCOBOL -000024 -000025 01 OLD-RECORD. -000026 02 OLD-STATEMENT PICTURE X(75). -000027 02 OLD-NUMBER PICTURE X(5). -000028 -000029 FD NEW-VERSION -000030 LABEL RECORDS ARE STANDARD -warning: LABEL RECORDS is obsolete in GnuCOBOL -000031 BLOCK CONTAINS 80 CHARACTERS -000032 DATA RECORD IS NEW-RECORD. -warning: DATA RECORDS is obsolete in GnuCOBOL -000033 -000034 01 NEW-RECORD. -000035 02 NEW-STATEMENT PICTURE X(75). -000036 02 NEW-NUMBER PICTURE X(5). -000037 -000038 FD MODIFICATION -000039 LABEL RECORDS ARE OMITTED -warning: LABEL RECORDS is obsolete in GnuCOBOL -000040 BLOCK CONTAINS 80 CHARACTERS -000041 DATA RECORD IS UPDATE-ORDER. -warning: DATA RECORDS is obsolete in GnuCOBOL -000042 -000043 01 UPDATE-ORDER. -000044 02 INSERTION. -000045 03 COMMAND PICTURE X(6). -000046 88 ENDJOB VALUE "ENDJOB". -000047 88 ENDSET VALUE "ENDSET". -000048 88 REMOVE VALUE "REMOVE". -000049 88 ADDNEW VALUE "INSERT". -000050 88 CHANGE VALUE "CHANGE". -000051 88 DISPLY VALUE "DISPLY". -000052 03 FILLER PICTURE X. -000053 03 A-FIELD PICTURE 9(5). -000054 03 A-ALPHA REDEFINES A-FIELD PICTURE X(5). -000055 88 A-BLANK VALUE SPACES. -000056 03 FILLER PICTURE X(4). -000057 03 B-FIELD PICTURE 9(5). -000058 03 B-ALPHA REDEFINES B-FIELD PICTURE X(5). -000059 88 B-BLANK VALUE SPACES. -000060 03 FILLER PICTURE X(54). -000061 02 FILLER PICTURE X(5). -000062 -000063 FD COMMENTARY -000064 LABEL RECORDS ARE OMITTED -warning: LABEL RECORDS is obsolete in GnuCOBOL -000065 BLOCK CONTAINS 82 CHARACTERS -000066 DATA RECORD IS COMMENT-LINE. -warning: DATA RECORDS is obsolete in GnuCOBOL -000067 -000068 01 COMMENT-LINE. -000069 02 FILLER PICTURE X(82). -000070 -000071 WORKING-STORAGE SECTION. -000072 -000073 01 HEADINGS-LINE. -000074 02 FILLER PICTURE X(15) VALUE "EDITOR VERSION". -000075 02 FILLER PICTURE X(20) VALUE "1.1 - 206/72". -000076 02 PHASE PICTURE X(17) VALUE "UPDATING AS OF". -000077 02 MONTH-RUN PICTURE XX. -000078 02 FILLER PICTURE X VALUE "/". -000079 02 DAY-RUN PICTURE XX. -000080 02 FILLER PICTURE X VALUE "/". -000081 02 YEAR-RUN PICTURE XX. -000082 02 FILLER PICTURE X(8) VALUE SPACES. -000083 02 FILLER PICTURE X(8) VALUE " PAGE: ". -000084 02 PAGE-NUMBER PICTURE 9(4) VALUE 0. -000085 -000086 01 COMMAND-LISTING. -000087 02 FILLER PICTURE X(2) VALUE SPACES. -000088 02 COMMAND-IMAGE PICTURE X(80). -000089 -000090 01 ACTIVITIES-LISTING. -000091 02 DISPOSITION PICTURE X(2). -000092 02 ACTIVE-IMAGE PICTURE X(80). -000093 -000094 01 UPSI-BYTE. -000095 02 UPSI-BIT OCCURS 8 TIMES PICTURE X. -000096 -000097 01 MESSAGE-LOG. -000098 02 FILLER PICTURE X(2) VALUE SPACES. -000099 02 MESSAGE-TEXT PICTURE X(80). -000100 -000101 01 DISPLAY-MESSAGE. -000102 02 FILLER PICTURE X(2) VALUE SPACES. -000103 02 DISPLAY-TEMP PICTURE X(6). -000104 02 FILLER PICTURE X(2) VALUE SPACES. -000105 02 DISPLAY-TEXT PICTURE X(60). -000106 -000107 PROCEDURE DIVISION. -000108 OPEN INPUT OLD-VERSION, MODIFICATION, -000109 OUTPUT NEW-VERSION, COMMENTARY. -000110 CLOSE OLD-VERSION, NEW-VERSION, MODIFICATION, COMMENTARY. -000111 STOP RUN. - -SIZE TYPE LVL NAME PICTURE - -00080 FILE OLD-VERSION -00080 GROUP 01 OLD-RECORD -00075 ALPHANUMERIC 02 OLD-STATEMENT X(75) -00005 ALPHANUMERIC 02 OLD-NUMBER X(5) - -00080 FILE NEW-VERSION -00080 GROUP 01 NEW-RECORD -00075 ALPHANUMERIC 02 NEW-STATEMENT X(75) -00005 ALPHANUMERIC 02 NEW-NUMBER X(5) - -00032 FILE PRT-VERSION - -00080 FILE MODIFICATION -00080 GROUP 01 UPDATE-ORDER -00075 GROUP 02 INSERTION -00006 ALPHANUMERIC 03 COMMAND X(6) - CONDITIONAL 88 ENDJOB - CONDITIONAL 88 ENDSET - CONDITIONAL 88 REMOVE - CONDITIONAL 88 ADDNEW - CONDITIONAL 88 CHANGE - CONDITIONAL 88 DISPLY -00001 ALPHANUMERIC 03 FILLER X -00005 ALPHANUMERIC 03 A-FIELD 9(5) -00005 ALPHANUMERIC 03 A-ALPHA X(5), REDEFINES A-FIELD - CONDITIONAL 88 A-BLANK -00004 ALPHANUMERIC 03 FILLER X(4) -00005 ALPHANUMERIC 03 B-FIELD 9(5) -00005 ALPHANUMERIC 03 B-ALPHA X(5), REDEFINES B-FIELD - CONDITIONAL 88 B-BLANK -00054 ALPHANUMERIC 03 FILLER X(54) -00005 ALPHANUMERIC 02 FILLER X(5) - -00082 FILE COMMENTARY -00082 GROUP 01 COMMENT-LINE -00082 ALPHANUMERIC 02 FILLER X(82) - - WORKING-STORAGE SECTION - -00080 GROUP 01 HEADINGS-LINE -00015 ALPHANUMERIC 02 FILLER X(15) -00020 ALPHANUMERIC 02 FILLER X(20) -00017 ALPHANUMERIC 02 PHASE X(17) -00002 ALPHANUMERIC 02 MONTH-RUN XX -00001 ALPHANUMERIC 02 FILLER X -00002 ALPHANUMERIC 02 DAY-RUN XX -00001 ALPHANUMERIC 02 FILLER X -00002 ALPHANUMERIC 02 YEAR-RUN XX -00008 ALPHANUMERIC 02 FILLER X(8) -00008 ALPHANUMERIC 02 FILLER X(8) -00004 NUMERIC 02 PAGE-NUMBER 9(4) - -00082 GROUP 01 COMMAND-LISTING -00002 ALPHANUMERIC 02 FILLER X(2) -00080 ALPHANUMERIC 02 COMMAND-IMAGE X(80) - -00082 GROUP 01 ACTIVITIES-LISTING -00002 ALPHANUMERIC 02 DISPOSITION X(2) -00080 ALPHANUMERIC 02 ACTIVE-IMAGE X(80) - -00008 GROUP 01 UPSI-BYTE -00001 ALPHANUMERIC 02 UPSI-BIT X, OCCURS 8 - -00082 GROUP 01 MESSAGE-LOG -00002 ALPHANUMERIC 02 FILLER X(2) -00080 ALPHANUMERIC 02 MESSAGE-TEXT X(80) - -00070 GROUP 01 DISPLAY-MESSAGE -00002 ALPHANUMERIC 02 FILLER X(2) -00006 ALPHANUMERIC 02 DISPLAY-TEMP X(6) -00002 ALPHANUMERIC 02 FILLER X(2) -00060 ALPHANUMERIC 02 DISPLAY-TEXT X(60) - - - -Error/Warning summary: - -prog.cob:21: warning: LABEL RECORDS is obsolete in GnuCOBOL -prog.cob:23: warning: DATA RECORDS is obsolete in GnuCOBOL -prog.cob:30: warning: LABEL RECORDS is obsolete in GnuCOBOL -prog.cob:32: warning: DATA RECORDS is obsolete in GnuCOBOL -prog.cob:39: warning: LABEL RECORDS is obsolete in GnuCOBOL -prog.cob:41: warning: DATA RECORDS is obsolete in GnuCOBOL -prog.cob:64: warning: LABEL RECORDS is obsolete in GnuCOBOL -prog.cob:66: warning: DATA RECORDS is obsolete in GnuCOBOL -prog.cob:11: error: missing file description for FILE PRT-VERSION - -8 warnings in compilation group -1 error in compilation group -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/listings.at:3036: gcdiff -IGnuCOBOL prog18.lst prog.lst" -at_fn_check_prepare_trace "listings.at:3036" -( $at_check_trace; gcdiff -IGnuCOBOL prog18.lst prog.lst -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/listings.at:3036" -$at_failed && at_fn_log_failure \ -"prog.lst" -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_410 -#AT_START_411 -at_fn_group_banner 411 'listings.at:3041' \ - "Invalid PICTURE strings" " " 3 -at_xfail=no -( - $as_echo "411. $at_setup_line: testing $at_desc ..." - $at_traceon - - - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 empty-pic PIC. - 01 too-long-pic PIC XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX - -XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX. - 01 too-long-pic2 PIC XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX - -XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX - -XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX - -XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX - -XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX. - 01 multiple-symbols. - 03 PIC 9CRCR. - 03 PIC 9DBDB. - 03 PIC SS99S. - 03 PIC 99..9. - 03 PIC 99VV9. - 03 PIC +$99+. - 03 PIC $+99$-. - 01 non-symbols. - 03 PIC 9K. - 03 PIC 999C. - 03 PIC 999D. - 01 too-many-digits PIC 9(50). - 01 too-long-number-in-parens PIC 9(11111111111111). - 01 nested-parens PIC 9((100)). - 01 unbalanced-parens PIC 9(. - 01 multiple-pairs-of-parens PIC 9(5)(3). - 01 no-digit-in-parens PIC 9(). - 01 mutually-exclusive-symbols. - 03 PIC P(3)9.9. - 03 PIC 9V.9. - 03 PIC Z*. - 03 PIC +(5)--. - 03 PIC $(4)Z(9). - 03 PIC $$B*(4). - 03 PIC NX. - 03 PIC AN. - 03 PIC AZ(3). - 03 PIC 99.99XXXXX. - 03 PIC SA. - 03 PIC $$$B+++B---. - 03 PIC +++9+. - 03 PIC +9(5)CR. - 03 PIC -9(5)DB. - 01 non-rightmost-leftmost-symbols. - 03 PIC BBB+BB99. - 03 PIC 99-B. - 03 PIC 9CRB. - 03 PIC DB9(5). - 03 PIC 99$$$. - 03 PIC 99$B. - 03 PIC 0$99. - 03 PIC PPPVP9. - 01 missing-symbols. - 03 PIC B(5). - 03 PIC +. - 03 PIC $. - - 01 str-constant CONSTANT "hello". - 01 float-constant CONSTANT 1.0. - 01 signed-constant CONSTANT -1. - 01 invalid-constant. - 03 PIC X(str-constant). - 03 PIC X(float-constant). - 03 PIC X(signed-constant). - 03 PIC X(unseen-constant). - - 01 integer-constant CONSTANT 5. - 01 valid-pics. - 03 PIC VP9B. - 03 PIC B9P(3). - 03 PIC B$$$. - 03 PIC 0000+B0+++0B,+. - 03 PIC +(5)P(3). - 03 PIC ++.++. - 03 PIC $(integer-constant). - 03 PIC $$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$ - -(integer-constant). *> CHECKME: should this be really valid? - - - 01 PC-COLOR-BACKGROUND-TABLE. - 05 BIT-BACKGROUND-BLACK PIC 1(8) BIT VALUE B"00000000". - 05 BIT-BACKGROUND-BLUE PIC 1(8) BIT VALUE B"00010000". - 05 BIT-BACKGROUND-GREEN PIC 1(8) BIT VALUE B"00100000". - 05 BIT-BACKGROUND-CYAN PIC 1(8) BIT VALUE B"00110000". - 05 BIT-BACKGROUND-RED PIC 1(8) BIT VALUE B"01000000". - 05 BIT-BACKGROUND-MAGENTA PIC 1(8) BIT VALUE B"01010000". - 05 BIT-BACKGROUND-BROWN PIC 1(8) BIT VALUE B"01100000". - 05 BIT-BACKGROUND-LIGHT-GRAY PIC 1(8) BIT VALUE B"01110000". - 01 FILLER REDEFINES PC-COLOR-BACKGROUND-TABLE. - 05 COLOR-BACKGROUND - OCCURS 8 TIMES PIC 1(8) BIT. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/listings.at:3144: \$COMPILE_ONLY -t prog.lst -tlines=0 -tsymbols -Wno-pending -Wno-unfinished -fword-continuation=ok prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY -t prog.lst -tlines=0 -tsymbols -Wno-pending -Wno-unfinished -fword-continuation=ok prog.cob" "listings.at:3144" -( $at_check_trace; $COMPILE_ONLY -t prog.lst -tlines=0 -tsymbols -Wno-pending -Wno-unfinished -fword-continuation=ok prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob:7: error: missing PICTURE string -prog.cob:10: error: PICTURE string may not contain more than 255 characters; contains 301 characters -prog.cob:16: error: CR or DB may only occur once in a PICTURE string -prog.cob:17: error: CR or DB may only occur once in a PICTURE string -prog.cob:18: error: S may only occur once in a PICTURE string -prog.cob:18: error: S must be at start of PICTURE string -prog.cob:19: error: . may only occur once in a PICTURE string -prog.cob:20: error: V may only occur once in a PICTURE string -prog.cob:21: error: a trailing +/- sign cannot follow a leading +/- sign -prog.cob:22: error: a leading +/- sign cannot follow a leading currency symbol -prog.cob:22: error: a trailing currency symbol cannot follow a leading currency symbol -prog.cob:22: error: a trailing +/- sign cannot follow a leading +/- sign -prog.cob:24: error: invalid PICTURE character 'K' -prog.cob:25: error: C must be followed by R -prog.cob:26: error: D must be followed by B -prog.cob:27: error: numeric field cannot be larger than 38 digits -prog.cob:28: error: only up to 9 significant digits are permitted within parentheses -prog.cob:29: error: parentheses must be preceded by a picture symbol -prog.cob:30: error: unbalanced parentheses -prog.cob:31: error: parentheses must be preceded by a picture symbol -prog.cob:32: error: parentheses must contain an unsigned integer -prog.cob:34: error: . cannot follow a P which is after the decimal point -prog.cob:35: error: . cannot follow V -prog.cob:36: error: cannot have both Z and * in PICTURE string -prog.cob:37: error: a trailing +/- sign cannot follow a floating +/- string which is before the decimal point -prog.cob:37: error: a trailing +/- sign may only occur once in a PICTURE string -prog.cob:38: error: a Z or * which is before the decimal point cannot follow a floating currency symbol string which is before the decimal point -prog.cob:39: error: a Z or * which is before the decimal point cannot follow a floating currency symbol string which is before the decimal point -prog.cob:40: error: A or X cannot follow N -prog.cob:41: error: N cannot follow A or X -prog.cob:42: error: a Z or * which is before the decimal point cannot follow A or X -prog.cob:43: error: A or X cannot follow . -prog.cob:44: error: A or X cannot follow S -prog.cob:45: error: a leading +/- sign cannot follow B, 0 or / -prog.cob:45: error: a leading +/- sign cannot follow a floating currency symbol string which is before the decimal point -prog.cob:45: error: a leading +/- sign may only occur once in a PICTURE string -prog.cob:45: error: a trailing +/- sign cannot follow a leading +/- sign -prog.cob:45: error: a trailing +/- sign may only occur once in a PICTURE string -prog.cob:46: error: a trailing +/- sign cannot follow a floating +/- string which is before the decimal point -prog.cob:47: error: CR or DB cannot follow a leading +/- sign -prog.cob:48: error: CR or DB cannot follow a leading +/- sign -prog.cob:50: error: a leading +/- sign cannot follow B, 0 or / -prog.cob:51: error: a leading +/- sign cannot follow 9 -prog.cob:52: error: B, 0 or / cannot follow CR or DB -prog.cob:53: error: 9 cannot follow CR or DB -prog.cob:54: error: a floating currency symbol string which is before the decimal point cannot follow 9 -prog.cob:55: error: a leading currency symbol cannot follow 9 -prog.cob:56: error: a leading currency symbol cannot follow B, 0 or / -prog.cob:57: error: P must be at start or end of PICTURE string -prog.cob:57: error: V cannot follow a P which is after the decimal point -prog.cob:59: error: PICTURE string must contain at least one of the set A, N, X, Z, 1, 9 and *; or at least two of the set +, - and the currency symbol -prog.cob:60: error: PICTURE string must contain at least one of the set A, N, X, Z, 1, 9 and *; or at least two of the set +, - and the currency symbol -prog.cob:61: error: PICTURE string must contain at least one of the set A, N, X, Z, 1, 9 and *; or at least two of the set +, - and the currency symbol -prog.cob:67: error: 'STR-CONSTANT' is not a numeric literal -prog.cob:68: error: 'FLOAT-CONSTANT' is not an integer -prog.cob:69: error: 'SIGNED-CONSTANT' is not unsigned -prog.cob:70: error: 'UNSEEN-CONSTANT' is not defined -prog.cob:81: warning: uncommon parentheses -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/listings.at:3144" -$at_failed && at_fn_log_failure \ -"prog.lst" -$at_traceon; } - - -cat >prog19.lst <<'_ATEOF' -GnuCOBOL V.R.P prog.cob DDD MMM dd HH:MM:SS YYYY - -LINE PG/LN A...B............................................................ - -000001 -000002 IDENTIFICATION DIVISION. -000003 PROGRAM-ID. prog. -000004 -000005 DATA DIVISION. -000006 WORKING-STORAGE SECTION. -000007 01 empty-pic PIC. -error: missing PICTURE string -000008 01 too-long-pic PIC XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX -000009 -XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX. -000010 01 too-long-pic2 PIC XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX -error: PICTURE string may not contain more than 255 characters; contains 301 - + characters -000011 -XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX -000012 -XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX -000013 -XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX -000014 -XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX. -000015 01 multiple-symbols. -000016 03 PIC 9CRCR. -error: CR or DB may only occur once in a PICTURE string -000017 03 PIC 9DBDB. -error: CR or DB may only occur once in a PICTURE string -000018 03 PIC SS99S. -error: S may only occur once in a PICTURE string -error: S must be at start of PICTURE string -000019 03 PIC 99..9. -error: . may only occur once in a PICTURE string -000020 03 PIC 99VV9. -error: V may only occur once in a PICTURE string -000021 03 PIC +$99+. -error: a trailing +/- sign cannot follow a leading +/- sign -000022 03 PIC $+99$-. -error: a leading +/- sign cannot follow a leading currency symbol -error: a trailing currency symbol cannot follow a leading currency symbol -error: a trailing +/- sign cannot follow a leading +/- sign -000023 01 non-symbols. -000024 03 PIC 9K. -error: invalid PICTURE character 'K' -000025 03 PIC 999C. -error: C must be followed by R -000026 03 PIC 999D. -error: D must be followed by B -000027 01 too-many-digits PIC 9(50). -error: numeric field cannot be larger than 38 digits -000028 01 too-long-number-in-parens PIC 9(11111111111111). -error: only up to 9 significant digits are permitted within parentheses -000029 01 nested-parens PIC 9((100)). -error: parentheses must be preceded by a picture symbol -000030 01 unbalanced-parens PIC 9(. -error: unbalanced parentheses -000031 01 multiple-pairs-of-parens PIC 9(5)(3). -error: parentheses must be preceded by a picture symbol -000032 01 no-digit-in-parens PIC 9(). -error: parentheses must contain an unsigned integer -000033 01 mutually-exclusive-symbols. -000034 03 PIC P(3)9.9. -error: . cannot follow a P which is after the decimal point -000035 03 PIC 9V.9. -error: . cannot follow V -000036 03 PIC Z*. -error: cannot have both Z and * in PICTURE string -000037 03 PIC +(5)--. -error: a trailing +/- sign cannot follow a floating +/- string which is before - + the decimal point -error: a trailing +/- sign may only occur once in a PICTURE string -000038 03 PIC $(4)Z(9). -error: a Z or * which is before the decimal point cannot follow a floating - + currency symbol string which is before the decimal point -000039 03 PIC $$B*(4). -error: a Z or * which is before the decimal point cannot follow a floating - + currency symbol string which is before the decimal point -000040 03 PIC NX. -error: A or X cannot follow N -000041 03 PIC AN. -error: N cannot follow A or X -000042 03 PIC AZ(3). -error: a Z or * which is before the decimal point cannot follow A or X -000043 03 PIC 99.99XXXXX. -error: A or X cannot follow . -000044 03 PIC SA. -error: A or X cannot follow S -000045 03 PIC $$$B+++B---. -error: a leading +/- sign cannot follow B, 0 or / -error: a leading +/- sign cannot follow a floating currency symbol string - + which is before the decimal point -error: a leading +/- sign may only occur once in a PICTURE string -error: a trailing +/- sign cannot follow a leading +/- sign -error: a trailing +/- sign may only occur once in a PICTURE string -000046 03 PIC +++9+. -error: a trailing +/- sign cannot follow a floating +/- string which is before - + the decimal point -000047 03 PIC +9(5)CR. -error: CR or DB cannot follow a leading +/- sign -000048 03 PIC -9(5)DB. -error: CR or DB cannot follow a leading +/- sign -000049 01 non-rightmost-leftmost-symbols. -000050 03 PIC BBB+BB99. -error: a leading +/- sign cannot follow B, 0 or / -000051 03 PIC 99-B. -error: a leading +/- sign cannot follow 9 -000052 03 PIC 9CRB. -error: B, 0 or / cannot follow CR or DB -000053 03 PIC DB9(5). -error: 9 cannot follow CR or DB -000054 03 PIC 99$$$. -error: a floating currency symbol string which is before the decimal point - + cannot follow 9 -000055 03 PIC 99$B. -error: a leading currency symbol cannot follow 9 -000056 03 PIC 0$99. -error: a leading currency symbol cannot follow B, 0 or / -000057 03 PIC PPPVP9. -error: P must be at start or end of PICTURE string -error: V cannot follow a P which is after the decimal point -000058 01 missing-symbols. -000059 03 PIC B(5). -error: PICTURE string must contain at least one of the set A, N, X, Z, 1, 9 - + and *; or at least two of the set +, - and the currency symbol -000060 03 PIC +. -error: PICTURE string must contain at least one of the set A, N, X, Z, 1, 9 - + and *; or at least two of the set +, - and the currency symbol -000061 03 PIC $. -error: PICTURE string must contain at least one of the set A, N, X, Z, 1, 9 - + and *; or at least two of the set +, - and the currency symbol -000062 -000063 01 str-constant CONSTANT "hello". -000064 01 float-constant CONSTANT 1.0. -000065 01 signed-constant CONSTANT -1. -000066 01 invalid-constant. -000067 03 PIC X(str-constant). -error: 'STR-CONSTANT' is not a numeric literal -000068 03 PIC X(float-constant). -error: 'FLOAT-CONSTANT' is not an integer -000069 03 PIC X(signed-constant). -error: 'SIGNED-CONSTANT' is not unsigned -000070 03 PIC X(unseen-constant). -error: 'UNSEEN-CONSTANT' is not defined -000071 -000072 01 integer-constant CONSTANT 5. -000073 01 valid-pics. -000074 03 PIC VP9B. -000075 03 PIC B9P(3). -000076 03 PIC B$$$. -000077 03 PIC 0000+B0+++0B,+. -000078 03 PIC +(5)P(3). -000079 03 PIC ++.++. -000080 03 PIC $(integer-constant). -000081 03 PIC $$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$ -warning: uncommon parentheses -000082 -(integer-constant). *> CHECKME: should this be really valid? -000083 -000084 -000085 01 PC-COLOR-BACKGROUND-TABLE. -000086 05 BIT-BACKGROUND-BLACK PIC 1(8) BIT VALUE B"00000000". -000087 05 BIT-BACKGROUND-BLUE PIC 1(8) BIT VALUE B"00010000". -000088 05 BIT-BACKGROUND-GREEN PIC 1(8) BIT VALUE B"00100000". -000089 05 BIT-BACKGROUND-CYAN PIC 1(8) BIT VALUE B"00110000". -000090 05 BIT-BACKGROUND-RED PIC 1(8) BIT VALUE B"01000000". -000091 05 BIT-BACKGROUND-MAGENTA PIC 1(8) BIT VALUE B"01010000". -000092 05 BIT-BACKGROUND-BROWN PIC 1(8) BIT VALUE B"01100000". -000093 05 BIT-BACKGROUND-LIGHT-GRAY PIC 1(8) BIT VALUE B"01110000". -000094 01 FILLER REDEFINES PC-COLOR-BACKGROUND-TABLE. -000095 05 COLOR-BACKGROUND -000096 OCCURS 8 TIMES PIC 1(8) BIT. - -SIZE TYPE LVL NAME PICTURE - - WORKING-STORAGE SECTION - -00000 ALPHANUMERIC 01 empty-pic INVALID - -00077 ALPHANUMERIC 01 too-long-pic XXXXXXXXXXXXXXXXXXXXXXX - -00000 ALPHANUMERIC 01 too-long-pic2 INVALID - -00000 GROUP 01 multiple-symbols -00000 ALPHANUMERIC 03 FILLER INVALID -00000 ALPHANUMERIC 03 FILLER INVALID -00000 ALPHANUMERIC 03 FILLER INVALID -00000 ALPHANUMERIC 03 FILLER INVALID -00000 ALPHANUMERIC 03 FILLER INVALID -00000 ALPHANUMERIC 03 FILLER INVALID -00000 ALPHANUMERIC 03 FILLER INVALID - -00000 GROUP 01 non-symbols -00000 ALPHANUMERIC 03 FILLER INVALID -00000 ALPHANUMERIC 03 FILLER INVALID -00000 ALPHANUMERIC 03 FILLER INVALID - -00050 ALPHANUMERIC 01 too-many-digits 9(50) - -00000 ALPHANUMERIC 01 too-long-number-in-parens INVALID - -00000 ALPHANUMERIC 01 nested-parens INVALID - -00000 ALPHANUMERIC 01 unbalanced-parens INVALID - -00000 ALPHANUMERIC 01 multiple-pairs-of-parens INVALID - -00000 ALPHANUMERIC 01 no-digit-in-parens INVALID - -00000 GROUP 01 mutually-exclusive-symbols -00000 ALPHANUMERIC 03 FILLER INVALID -00000 ALPHANUMERIC 03 FILLER INVALID -00000 ALPHANUMERIC 03 FILLER INVALID -00000 ALPHANUMERIC 03 FILLER INVALID -00000 ALPHANUMERIC 03 FILLER INVALID -00000 ALPHANUMERIC 03 FILLER INVALID -00000 ALPHANUMERIC 03 FILLER INVALID -00000 ALPHANUMERIC 03 FILLER INVALID -00000 ALPHANUMERIC 03 FILLER INVALID -00000 ALPHANUMERIC 03 FILLER INVALID -00000 ALPHANUMERIC 03 FILLER INVALID -00000 ALPHANUMERIC 03 FILLER INVALID -00000 ALPHANUMERIC 03 FILLER INVALID -00000 ALPHANUMERIC 03 FILLER INVALID -00000 ALPHANUMERIC 03 FILLER INVALID - -00000 GROUP 01 non-rightmost-leftmost-symbols -00000 ALPHANUMERIC 03 FILLER INVALID -00000 ALPHANUMERIC 03 FILLER INVALID -00000 ALPHANUMERIC 03 FILLER INVALID -00000 ALPHANUMERIC 03 FILLER INVALID -00000 ALPHANUMERIC 03 FILLER INVALID -00000 ALPHANUMERIC 03 FILLER INVALID -00000 ALPHANUMERIC 03 FILLER INVALID -00000 ALPHANUMERIC 03 FILLER INVALID - -00000 GROUP 01 missing-symbols -00000 ALPHANUMERIC 03 FILLER INVALID -00000 ALPHANUMERIC 03 FILLER INVALID -00000 ALPHANUMERIC 03 FILLER INVALID - -00000 GROUP 01 invalid-constant -00000 ALPHANUMERIC 03 FILLER INVALID -00000 ALPHANUMERIC 03 FILLER INVALID -00000 ALPHANUMERIC 03 FILLER INVALID -00000 ALPHANUMERIC 03 FILLER INVALID - -00086 GROUP 01 valid-pics -00002 ALPHANUMERIC 03 FILLER VP9B -00002 ALPHANUMERIC 03 FILLER B9P(3) -00004 ALPHANUMERIC 03 FILLER B$$$ -00014 ALPHANUMERIC 03 FILLER 0000+B0+++0B,+ -00005 ALPHANUMERIC 03 FILLER +(5)P(3) -00005 ALPHANUMERIC 03 FILLER ++.++ -00005 ALPHANUMERIC 03 FILLER $(INTEGER-CONSTANT) -00049 ALPHANUMERIC 03 FILLER $$$$$$$$$$$$$$$$$$$$$$$ - -00008 GROUP 01 PC-COLOR-BACKGROUND-TABLE -00001 NUMERIC 05 BIT-BACKGROUND-BLACK 1(8) -00001 NUMERIC 05 BIT-BACKGROUND-BLUE 1(8) -00001 NUMERIC 05 BIT-BACKGROUND-GREEN 1(8) -00001 NUMERIC 05 BIT-BACKGROUND-CYAN 1(8) -00001 NUMERIC 05 BIT-BACKGROUND-RED 1(8) -00001 NUMERIC 05 BIT-BACKGROUND-MAGENTA 1(8) -00001 NUMERIC 05 BIT-BACKGROUND-BROWN 1(8) -00001 NUMERIC 05 BIT-BACKGROUND-LIGHT-GRAY 1(8) - -00008 GROUP 01 FILLER, REDEFINES PC-COLOR-BACKGROUND-TABLE -00001 BOOLEAN 05 COLOR-BACKGROUND 1(8), OCCURS 8 - - - -Error/Warning summary: - -prog.cob:7: error: missing PICTURE string -prog.cob:10: error: PICTURE string may not contain more than 255 characters; contains 301 characters -prog.cob:16: error: CR or DB may only occur once in a PICTURE string -prog.cob:17: error: CR or DB may only occur once in a PICTURE string -prog.cob:18: error: S may only occur once in a PICTURE string -prog.cob:18: error: S must be at start of PICTURE string -prog.cob:19: error: . may only occur once in a PICTURE string -prog.cob:20: error: V may only occur once in a PICTURE string -prog.cob:21: error: a trailing +/- sign cannot follow a leading +/- sign -prog.cob:22: error: a leading +/- sign cannot follow a leading currency symbol -prog.cob:22: error: a trailing currency symbol cannot follow a leading currency symbol -prog.cob:22: error: a trailing +/- sign cannot follow a leading +/- sign -prog.cob:24: error: invalid PICTURE character 'K' -prog.cob:25: error: C must be followed by R -prog.cob:26: error: D must be followed by B -prog.cob:27: error: numeric field cannot be larger than 38 digits -prog.cob:28: error: only up to 9 significant digits are permitted within parentheses -prog.cob:29: error: parentheses must be preceded by a picture symbol -prog.cob:30: error: unbalanced parentheses -prog.cob:31: error: parentheses must be preceded by a picture symbol -prog.cob:32: error: parentheses must contain an unsigned integer -prog.cob:34: error: . cannot follow a P which is after the decimal point -prog.cob:35: error: . cannot follow V -prog.cob:36: error: cannot have both Z and * in PICTURE string -prog.cob:37: error: a trailing +/- sign cannot follow a floating +/- string which is before the decimal point -prog.cob:37: error: a trailing +/- sign may only occur once in a PICTURE string -prog.cob:38: error: a Z or * which is before the decimal point cannot follow a floating currency symbol string which is before the decimal point -prog.cob:39: error: a Z or * which is before the decimal point cannot follow a floating currency symbol string which is before the decimal point -prog.cob:40: error: A or X cannot follow N -prog.cob:41: error: N cannot follow A or X -prog.cob:42: error: a Z or * which is before the decimal point cannot follow A or X -prog.cob:43: error: A or X cannot follow . -prog.cob:44: error: A or X cannot follow S -prog.cob:45: error: a leading +/- sign cannot follow B, 0 or / -prog.cob:45: error: a leading +/- sign cannot follow a floating currency symbol string which is before the decimal point -prog.cob:45: error: a leading +/- sign may only occur once in a PICTURE string -prog.cob:45: error: a trailing +/- sign cannot follow a leading +/- sign -prog.cob:45: error: a trailing +/- sign may only occur once in a PICTURE string -prog.cob:46: error: a trailing +/- sign cannot follow a floating +/- string which is before the decimal point -prog.cob:47: error: CR or DB cannot follow a leading +/- sign -prog.cob:48: error: CR or DB cannot follow a leading +/- sign -prog.cob:50: error: a leading +/- sign cannot follow B, 0 or / -prog.cob:51: error: a leading +/- sign cannot follow 9 -prog.cob:52: error: B, 0 or / cannot follow CR or DB -prog.cob:53: error: 9 cannot follow CR or DB -prog.cob:54: error: a floating currency symbol string which is before the decimal point cannot follow 9 -prog.cob:55: error: a leading currency symbol cannot follow 9 -prog.cob:56: error: a leading currency symbol cannot follow B, 0 or / -prog.cob:57: error: P must be at start or end of PICTURE string -prog.cob:57: error: V cannot follow a P which is after the decimal point -prog.cob:59: error: PICTURE string must contain at least one of the set A, N, X, Z, 1, 9 and *; or at least two of the set +, - and the currency symbol -prog.cob:60: error: PICTURE string must contain at least one of the set A, N, X, Z, 1, 9 and *; or at least two of the set +, - and the currency symbol -prog.cob:61: error: PICTURE string must contain at least one of the set A, N, X, Z, 1, 9 and *; or at least two of the set +, - and the currency symbol -prog.cob:67: error: 'STR-CONSTANT' is not a numeric literal -prog.cob:68: error: 'FLOAT-CONSTANT' is not an integer -prog.cob:69: error: 'SIGNED-CONSTANT' is not unsigned -prog.cob:70: error: 'UNSEEN-CONSTANT' is not defined -prog.cob:81: warning: uncommon parentheses - -1 warning in compilation group -57 errors in compilation group -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/listings.at:3539: gcdiff -IGnuCOBOL prog19.lst prog.lst" -at_fn_check_prepare_trace "listings.at:3539" -( $at_check_trace; gcdiff -IGnuCOBOL prog19.lst prog.lst -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/listings.at:3539" -$at_failed && at_fn_log_failure \ -"prog.lst" -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_411 -#AT_START_412 -at_fn_group_banner 412 'listings.at:3544' \ - "Variable format" " " 3 -at_xfail=no -( - $as_echo "412. $at_setup_line: testing $at_desc ..." - $at_traceon - - - - - -cat >prog.cob <<'_ATEOF' -000001 $SET SOURCEFORMAT "VARIABLE" -000010 IDENTIFICATION DIVISION. -000020 PROGRAM-ID. prog. -000030* blah blah blah -000040 PROCEDURE DIVISION. -000050 DISPLAY "Hello!" -000060 . -000070 END PROGRAM prog. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/listings.at:3560: \$COMPILE_ONLY -t prog.lst -tlines=0 prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY -t prog.lst -tlines=0 prog.cob" "listings.at:3560" -( $at_check_trace; $COMPILE_ONLY -t prog.lst -tlines=0 prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/listings.at:3560" -$at_failed && at_fn_log_failure \ -"prog.lst" -$at_traceon; } - - -cat >prog20.lst <<'_ATEOF' -GnuCOBOL V.R.P prog.cob DDD MMM dd HH:MM:SS YYYY - -LINE PG/LN A...B............................................................ - -000001 000001 $SET SOURCEFORMAT "VARIABLE" -000002 000010 IDENTIFICATION DIVISION. -000003 000020 PROGRAM-ID. prog. -000004 000030* blah blah blah -000005 000040 PROCEDURE DIVISION. -000006 000050 -000006+ DISPLAY "Hello!" -000007 000060 . -000008 000070 END PROGRAM prog. - - -0 warnings in compilation group -0 errors in compilation group -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/listings.at:3582: gcdiff -IGnuCOBOL prog20.lst prog.lst" -at_fn_check_prepare_trace "listings.at:3582" -( $at_check_trace; gcdiff -IGnuCOBOL prog20.lst prog.lst -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/listings.at:3582" -$at_failed && at_fn_log_failure \ -"prog.lst" -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_412 -#AT_START_413 -at_fn_group_banner 413 'listings.at:3587' \ - "LISTING directive" " " 3 -at_xfail=no -( - $as_echo "413. $at_setup_line: testing $at_desc ..." - $at_traceon - - - - - -cat >copy.inc <<'_ATEOF' - - >>LISTING OFF - 01 TEST1-VAR PIC X(2) VALUE "OK". - 01 TEST2-VAR PIC X(2) VALUE "OK". - 01 TEST3-VAR PIC X(2) VALUE "OK". - 01 TEST4-VAR PIC X(2) VALUE "OK". - >>LISTING ON - 01 TEST5-VAR PIC X(2) VALUE "OK". - 01 TEST6-VAR PIC X(2) VALUE "OK". - 01 TEST7-VAR PIC X(2) VALUE "OK". - 01 TEST8-VAR PIC X(2) VALUE "OK". -_ATEOF - - -cat >copy2.inc <<'_ATEOF' - >> LISTING OFF - 01 TEST9-VAR PIC X(2) VALUE "OK". - >>LISTING - 01 TESTA-VAR PIC X(2) VALUE "OK". -_ATEOF - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - COPY "copy.inc". - COPY "copy2.inc". - PROCEDURE DIVISION. - DISPLAY TEST1-VAR NO ADVANCING - END-DISPLAY. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/listings.at:3624: \$COMPILE_ONLY -t prog.lst -tlines=0 -tsymbols prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY -t prog.lst -tlines=0 -tsymbols prog.cob" "listings.at:3624" -( $at_check_trace; $COMPILE_ONLY -t prog.lst -tlines=0 -tsymbols prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/listings.at:3624" -$at_failed && at_fn_log_failure \ -"prog.lst" -$at_traceon; } - - -cat >prog17.lst <<'_ATEOF' -GnuCOBOL V.R.P prog.cob DDD MMM dd HH:MM:SS YYYY - -LINE PG/LN A...B............................................................ - -000001 -000002 IDENTIFICATION DIVISION. -000003 PROGRAM-ID. prog. -000004 DATA DIVISION. -000005 WORKING-STORAGE SECTION. -000006 COPY "copy.inc". -000001C -000002C >>LISTING OFF -000007C >>LISTING ON -000008C 01 TEST5-VAR PIC X(2) VALUE "OK". -000009C 01 TEST6-VAR PIC X(2) VALUE "OK". -000010C 01 TEST7-VAR PIC X(2) VALUE "OK". -000011C 01 TEST8-VAR PIC X(2) VALUE "OK". -000007 COPY "copy2.inc". -000001C >> LISTING OFF -000003C >>LISTING -000004C 01 TESTA-VAR PIC X(2) VALUE "OK". -000008 PROCEDURE DIVISION. -000009 DISPLAY TEST1-VAR NO ADVANCING -000010 END-DISPLAY. -000011 STOP RUN. - -SIZE TYPE LVL NAME PICTURE - - WORKING-STORAGE SECTION - -00002 ALPHANUMERIC 01 TEST1-VAR X(2) - -00002 ALPHANUMERIC 01 TEST2-VAR X(2) - -00002 ALPHANUMERIC 01 TEST3-VAR X(2) - -00002 ALPHANUMERIC 01 TEST4-VAR X(2) - -00002 ALPHANUMERIC 01 TEST5-VAR X(2) - -00002 ALPHANUMERIC 01 TEST6-VAR X(2) - -00002 ALPHANUMERIC 01 TEST7-VAR X(2) - -00002 ALPHANUMERIC 01 TEST8-VAR X(2) - -00002 ALPHANUMERIC 01 TEST9-VAR X(2) - -00002 ALPHANUMERIC 01 TESTA-VAR X(2) - - -0 warnings in compilation group -0 errors in compilation group -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/listings.at:3682: gcdiff -IGnuCOBOL prog17.lst prog.lst" -at_fn_check_prepare_trace "listings.at:3682" -( $at_check_trace; gcdiff -IGnuCOBOL prog17.lst prog.lst -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/listings.at:3682" -$at_failed && at_fn_log_failure \ -"prog.lst" -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_413 -#AT_START_414 -at_fn_group_banner 414 'listings.at:3687' \ - "Listing-directive statements" " " 3 -at_xfail=no -( - $as_echo "414. $at_setup_line: testing $at_desc ..." - $at_traceon - - - - - -cat >prog.cob <<'_ATEOF' - TITLE "GnuCOBOL lists IBM" - IDENTIFICATION DIVISION. - SKIP1 - PROGRAM-ID. prog. - SKIP2 - DATA DIVISION. - SKIP3 - WORKING-STORAGE SECTION. - 01 TITLE-01 PIC X(2). - 01 TITLE-02 PIC X(2). - TITLE "here goes the code" - PROCEDURE DIVISION. - EJECT - MOVE SPACE TO TITLE-01 - TITLE-02. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/listings.at:3710: \$COMPILE_ONLY -t prog.lst -std=ibm prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY -t prog.lst -std=ibm prog.cob" "listings.at:3710" -( $at_check_trace; $COMPILE_ONLY -t prog.lst -std=ibm prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/listings.at:3710" -$at_failed && at_fn_log_failure \ -"prog.lst" -$at_traceon; } - - -cat >expect.lst <<'_ATEOF' -GnuCOBOL lists IBM prog.cob DDD MMM dd HH:MM:SS YYYY Page 0001 - -LINE PG/LN A...B............................................................ - -000002 IDENTIFICATION DIVISION. - - -000004 PROGRAM-ID. prog. - - - -000006 DATA DIVISION. - - - - -000008 WORKING-STORAGE SECTION. -000009 01 TITLE-01 PIC X(2). -000010 01 TITLE-02 PIC X(2). - here goes the code prog.cob DDD MMM dd HH:MM:SS YYYY Page 0002 - -LINE PG/LN A...B............................................................ - -000012 PROCEDURE DIVISION. - here goes the code prog.cob DDD MMM dd HH:MM:SS YYYY Page 0003 - -LINE PG/LN A...B............................................................ - -000014 MOVE SPACE TO TITLE-01 -000015 TITLE-02. -000016 STOP RUN. - - -0 warnings in compilation group -0 errors in compilation group -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/listings.at:3750: gcdiff -IGnuCOBOL -I\"here goes the code\" expect.lst prog.lst" -at_fn_check_prepare_trace "listings.at:3750" -( $at_check_trace; gcdiff -IGnuCOBOL -I"here goes the code" expect.lst prog.lst -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/listings.at:3750" -$at_failed && at_fn_log_failure \ -"prog.lst" -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_414 -#AT_START_415 -at_fn_group_banner 415 'listings.at:3755' \ - "Eject page" " " 3 -at_xfail=no -( - $as_echo "415. $at_setup_line: testing $at_desc ..." - $at_traceon - - - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - / - PROCEDURE DIVISION. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/listings.at:3770: \$COMPILE_ONLY -t prog.lst prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY -t prog.lst prog.cob" "listings.at:3770" -( $at_check_trace; $COMPILE_ONLY -t prog.lst prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/listings.at:3770" -$at_failed && at_fn_log_failure \ -"prog.lis" -$at_traceon; } - - -cat >prog7.lst <<'_ATEOF' -GnuCOBOL V.R.P prog.cob DDD MMM dd HH:MM:SS YYYY Page 0001 - -LINE PG/LN A...B............................................................ - -000001 -000002 IDENTIFICATION DIVISION. -000003 PROGRAM-ID. prog. -000004 DATA DIVISION. -000005 WORKING-STORAGE SECTION. - GnuCOBOL V.R.P prog.cob DDD MMM dd HH:MM:SS YYYY Page 0002 - -LINE PG/LN A...B............................................................ - -000006 / -000007 PROCEDURE DIVISION. -000008 STOP RUN. - - -0 warnings in compilation group -0 errors in compilation group -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/listings.at:3795: gcdiff -IGnuCOBOL prog7.lst prog.lst" -at_fn_check_prepare_trace "listings.at:3795" -( $at_check_trace; gcdiff -IGnuCOBOL prog7.lst prog.lst -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/listings.at:3795" -$at_failed && at_fn_log_failure \ -"prog.lis" -$at_traceon; } - - -cat >prog2.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog2. - DATA DIVISION. - WORKING-STORAGE SECTION. ->>PAGE - PROCEDURE DIVISION. - STOP RUN. -_ATEOF - - - -{ set +x -$as_echo "$at_srcdir/listings.at:3808: \$COMPILE_ONLY -t prog.lst -free prog2.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY -t prog.lst -free prog2.cob" "listings.at:3808" -( $at_check_trace; $COMPILE_ONLY -t prog.lst -free prog2.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/listings.at:3808" -$at_failed && at_fn_log_failure \ -"prog.lis" -$at_traceon; } - - -cat >prog8.lst <<'_ATEOF' -GnuCOBOL V.R.P prog2.cob DDD MMM dd HH:MM:SS YYYY Page 0001 - -LINE .....................SOURCE............................................. - -000001 -000002 IDENTIFICATION DIVISION. -000003 PROGRAM-ID. prog2. -000004 DATA DIVISION. -000005 WORKING-STORAGE SECTION. - GnuCOBOL V.R.P prog2.cob DDD MMM dd HH:MM:SS YYYY Page 0002 - -LINE .....................SOURCE............................................. - -000006 >>PAGE -000007 PROCEDURE DIVISION. -000008 STOP RUN. - - -0 warnings in compilation group -0 errors in compilation group -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/listings.at:3833: gcdiff -IGnuCOBOL prog8.lst prog.lst" -at_fn_check_prepare_trace "listings.at:3833" -( $at_check_trace; gcdiff -IGnuCOBOL prog8.lst prog.lst -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/listings.at:3833" -$at_failed && at_fn_log_failure \ -"prog.lis" -$at_traceon; } - - -cat >prog3.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - - PROGRAM-ID. prog3. - - - DATA DIVISION. - WORKING-STORAGE SECTION. - 77 WS-VAR PIC X(2). - / - 77 WS-VA2 PIC X(2). - - - LOCAL-STORAGE SECTION. - 77 LS-VAR PIC 9(2). - - - PROCEDURE DIVISION. - - DISPLAY WS-VAR - MOVE 99 TO LS-VAR - - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/listings.at:3860: \$COMPILE_ONLY -t prog.lst prog3.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY -t prog.lst prog3.cob" "listings.at:3860" -( $at_check_trace; $COMPILE_ONLY -t prog.lst prog3.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/listings.at:3860" -$at_failed && at_fn_log_failure \ -"prog.lis" -$at_traceon; } - - -cat >prog9.lst <<'_ATEOF' -GnuCOBOL V.R.P prog3.cob DDD MMM dd HH:MM:SS YYYY Page 0001 - -LINE PG/LN A...B............................................................ - -000001 -000002 IDENTIFICATION DIVISION. -000003 -000004 PROGRAM-ID. prog3. -000005 -000006 -000007 DATA DIVISION. -000008 WORKING-STORAGE SECTION. -000009 77 WS-VAR PIC X(2). - GnuCOBOL V.R.P prog3.cob DDD MMM dd HH:MM:SS YYYY Page 0002 - -LINE PG/LN A...B............................................................ - -000010 / -000011 77 WS-VA2 PIC X(2). -000012 -000013 -000014 LOCAL-STORAGE SECTION. -000015 77 LS-VAR PIC 9(2). -000016 -000017 -000018 PROCEDURE DIVISION. -000019 -000020 DISPLAY WS-VAR -000021 MOVE 99 TO LS-VAR -000022 -000023 STOP RUN. - - -0 warnings in compilation group -0 errors in compilation group -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/listings.at:3900: gcdiff -IGnuCOBOL prog9.lst prog.lst" -at_fn_check_prepare_trace "listings.at:3900" -( $at_check_trace; gcdiff -IGnuCOBOL prog9.lst prog.lst -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/listings.at:3900" -$at_failed && at_fn_log_failure \ -"prog.lis" -$at_traceon; } - - -{ set +x -$as_echo "$at_srcdir/listings.at:3902: \$COMPILE_ONLY -t prog.lst -tlines=20 prog3.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY -t prog.lst -tlines=20 prog3.cob" "listings.at:3902" -( $at_check_trace; $COMPILE_ONLY -t prog.lst -tlines=20 prog3.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/listings.at:3902" -$at_failed && at_fn_log_failure \ -"prog.lis" -$at_traceon; } - - -cat >prog10.lst <<'_ATEOF' -GnuCOBOL V.R.P prog3.cob DDD MMM dd HH:MM:SS YYYY Page 0001 - -LINE PG/LN A...B............................................................ - -000001 -000002 IDENTIFICATION DIVISION. -000003 -000004 PROGRAM-ID. prog3. -000005 -000006 -000007 DATA DIVISION. -000008 WORKING-STORAGE SECTION. -000009 77 WS-VAR PIC X(2). - GnuCOBOL V.R.P prog3.cob DDD MMM dd HH:MM:SS YYYY Page 0002 - -LINE PG/LN A...B............................................................ - -000010 / -000011 77 WS-VA2 PIC X(2). -000012 -000013 -000014 LOCAL-STORAGE SECTION. -000015 77 LS-VAR PIC 9(2). -000016 -000017 -000018 PROCEDURE DIVISION. -000019 -000020 DISPLAY WS-VAR -000021 MOVE 99 TO LS-VAR -000022 -000023 STOP RUN. - - -0 warnings in compilation group - GnuCOBOL V.R.P prog3.cob DDD MMM dd HH:MM:SS YYYY Page 0003 - -0 errors in compilation group -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/listings.at:3944: gcdiff -IGnuCOBOL prog10.lst prog.lst" -at_fn_check_prepare_trace "listings.at:3944" -( $at_check_trace; gcdiff -IGnuCOBOL prog10.lst prog.lst -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/listings.at:3944" -$at_failed && at_fn_log_failure \ -"prog.lis" -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_415 -#AT_START_416 -at_fn_group_banner 416 'listings.at:3949' \ - "Cross reference" " " 3 -at_xfail=no -( - $as_echo "416. $at_setup_line: testing $at_desc ..." - $at_traceon - - - - - -cat >EDITOR.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. EDIT0001 - PROGRAM-ID. EDIT0002 - EDITOR. EDIT0003 - EDIT0008 - *NOTE. EDIT0009 - * THIS VERSION OF EDITOR 1 COMPRISES AN ENTIRE RE_WRITE EDIT0010 - * OF THE BASIC EDITOR WITH ONLY ONE CHANGE IN THE COMMAND EDIT0011 - * STRUCTURE, THAT BEING THE ADDITION OF A "CHANGE" COMMAND EDIT0012 - * TO SERVE IN PLACE OF THE INSERT-DELETE COMBINATION WHICH EDIT0013 - * WAS REQUIRED IN PREVIOUS VERSIONS. RECORD NUMBER FIELDS EDIT0014 - * HAVE ALSO BEEN REDUCED FROM 5 DIGITS TO 4. EDIT0015 - * CHANGE 1. EDIT0016 - * MODIFY TO RUN ON TI-990. EDIT0017 - * CHANGE 2. EDIT0018 - * MODIFY TO RUN ON GNUCOBOL. EDIT0019 - EDIT0020 - ENVIRONMENT DIVISION. EDIT0021 - CONFIGURATION SECTION. EDIT0022 - SOURCE-COMPUTER. EDIT0023 - IBM-360. EDIT0024 - OBJECT-COMPUTER. EDIT0025 - IBM-360. EDIT0026 - INPUT-OUTPUT SECTION. EDIT0027 - FILE-CONTROL. EDIT0028 - SELECT OLD-VERSION ASSIGN TO "SYSUT1" EDIT0029 - ORGANIZATION LINE SEQUENTIAL. EDIT0030 - SELECT NEW-VERSION ASSIGN TO "SYSUT2" EDIT0031 - ORGANIZATION LINE SEQUENTIAL. EDIT0032 - SELECT PRT-VERSION ASSIGN TO "SYSUT2" EDIT0033 - ORGANIZATION LINE SEQUENTIAL. EDIT0034 - SELECT MODIFICATION ASSIGN TO "SYSIN1" EDIT0035 - ORGANIZATION LINE SEQUENTIAL. EDIT0036 - SELECT COMMENTARY ASSIGN TO "SYSOU1" EDIT0037 - ORGANIZATION LINE SEQUENTIAL. EDIT0038 - EDIT0039 - DATA DIVISION. EDIT0040 - EDIT0041 - FILE SECTION. EDIT0042 - EDIT0043 - FD OLD-VERSION EDIT0044 - LABEL RECORDS ARE STANDARD EDIT0045 - BLOCK CONTAINS 80 CHARACTERS EDIT0046 - DATA RECORD IS OLD-RECORD. EDIT0047 - EDIT0048 - 01 OLD-RECORD. EDIT0049 - 02 OLD-STATEMENT PICTURE X(75). EDIT0050 - 02 OLD-NUMBER PICTURE X(5). EDIT0051 - EDIT0052 - FD NEW-VERSION EDIT0053 - LABEL RECORDS ARE STANDARD EDIT0054 - BLOCK CONTAINS 80 CHARACTERS EDIT0055 - DATA RECORD IS NEW-RECORD. EDIT0056 - EDIT0057 - 01 NEW-RECORD. EDIT0058 - 02 NEW-STATEMENT PICTURE X(75). EDIT0059 - 02 NEW-NUMBER PICTURE X(5). EDIT0060 - EDIT0061 - FD MODIFICATION EDIT0062 - LABEL RECORDS ARE OMITTED EDIT0063 - BLOCK CONTAINS 80 CHARACTERS EDIT0064 - DATA RECORD IS UPDATE-ORDER. EDIT0065 - EDIT0066 - 01 UPDATE-ORDER. EDIT0067 - 02 INSERTION. EDIT0068 - 03 COMMAND PICTURE X(6). EDIT0069 - 88 ENDJOB VALUE "ENDJOB". EDIT0070 - 88 ENDSET VALUE "ENDSET". EDIT0071 - 88 REMOVE VALUE "REMOVE". EDIT0072 - 88 ADDNEW VALUE "INSERT". EDIT0073 - 88 CHANGE VALUE "CHANGE". EDIT0074 - 88 DISPLY VALUE "DISPLY". EDIT0075 - 03 FILLER PICTURE X. EDIT0076 - 03 A-FIELD PICTURE 9(5). EDIT0077 - 03 A-ALPHA REDEFINES A-FIELD PICTURE X(5). EDIT0078 - 88 A-BLANK VALUE SPACES. EDIT0079 - 03 FILLER PICTURE X(4). EDIT0080 - 03 B-FIELD PICTURE 9(5). EDIT0081 - 03 B-ALPHA REDEFINES B-FIELD PICTURE X(5). EDIT0082 - 88 B-BLANK VALUE SPACES. EDIT0083 - 03 FILLER PICTURE X(54). EDIT0084 - 02 FILLER PICTURE X(5). EDIT0085 - EDIT0086 - FD COMMENTARY EDIT0087 - LABEL RECORDS ARE OMITTED EDIT0088 - BLOCK CONTAINS 82 CHARACTERS EDIT0089 - DATA RECORD IS COMMENT-LINE. EDIT0090 - EDIT0091 - 01 COMMENT-LINE. EDIT0092 - 02 FILLER PICTURE X(82). EDIT0093 - EDIT0094 - WORKING-STORAGE SECTION. EDIT0095 - EDIT0096 - 77 COMMAND-ADDITIONS PICTURE 9(3) COMPUTATIONAL VALUE 0. EDIT0097 - 77 COMMAND-SUBTRACTIONS PICTURE 9(3) COMPUTATIONAL VALUE 0. EDIT0098 - 77 TOTAL-INSERTED PICTURE 9(3) COMPUTATIONAL VALUE 0. EDIT0099 - 77 TOTAL-DELETED PICTURE 9(3) COMPUTATIONAL VALUE 0. EDIT0100 - 77 OUTPUT-COUNT PICTURE 9(5) COMPUTATIONAL VALUE 0. EDIT0101 - 77 LINE-COUNT PICTURE 9(2) COMPUTATIONAL VALUE 0. EDIT0102 - 77 FIELDA PICTURE 9(5) VALUE 0. EDIT0103 - 77 FIELDB PICTURE 9(5) VALUE 0. EDIT0104 - 77 BLANK-LINE PICTURE X(82) VALUE SPACES. EDIT0105 - EDIT0106 - 01 DATE-FROM-SYS. EDIT0107 - 02 DFSYS OCCURS 3 TIMES PICTURE 99. EDIT0108 - EDIT0109 - 01 HEADINGS-LINE. EDIT0110 - 02 FILLER PICTURE X(15) VALUE "EDITOR VERSION". EDIT0111 - 02 FILLER PICTURE X(20) VALUE "1.1 - 206/72". EDIT0112 - 02 PHASE PICTURE X(17) VALUE "UPDATING AS OF". EDIT0113 - 02 MONTH-RUN PICTURE XX. EDIT0114 - 02 FILLER PICTURE X VALUE "/". EDIT0115 - 02 DAY-RUN PICTURE XX. EDIT0116 - 02 FILLER PICTURE X VALUE "/". EDIT0117 - 02 YEAR-RUN PICTURE XX. EDIT0118 - 02 FILLER PICTURE X(8) VALUE SPACES. EDIT0119 - 02 FILLER PICTURE X(8) VALUE " PAGE: ". EDIT0120 - 02 PAGE-NUMBER PICTURE 9(4) VALUE 0. EDIT0121 - EDIT0122 - 01 COMMAND-LISTING. EDIT0123 - 02 FILLER PICTURE X(2) VALUE SPACES. EDIT0124 - 02 COMMAND-IMAGE PICTURE X(80). EDIT0125 - EDIT0126 - 01 ACTIVITIES-LISTING. EDIT0127 - 02 DISPOSITION PICTURE X(2). EDIT0128 - 02 ACTIVE-IMAGE PICTURE X(80). EDIT0129 - EDIT0130 - 01 UPSI-BYTE. EDIT0131 - 02 UPSI-BIT OCCURS 8 TIMES PICTURE X. EDIT0132 - EDIT0133 - 01 MESSAGE-LOG. EDIT0134 - 02 FILLER PICTURE X(2) VALUE SPACES. EDIT0135 - 02 MESSAGE-TEXT PICTURE X(80). EDIT0136 - EDIT0137 - 01 DISPLAY-MESSAGE. EDIT0138 - 02 FILLER PICTURE X(2) VALUE SPACES. EDIT0139 - 02 DISPLAY-TEMP PICTURE X(6). EDIT0140 - 02 FILLER PICTURE X(2) VALUE SPACES. EDIT0141 - 02 DISPLAY-TEXT PICTURE X(60). EDIT0142 - EDIT0143 - 77 END-JOB-PROCESS PICTURE 9 VALUE 0. EDIT0144 - 77 DELETE-PROCESS PICTURE 9 VALUE 1. EDIT0145 - 77 INSERT-PROCESS PICTURE 9 VALUE 2. EDIT0146 - 77 WRITE-PROCESS PICTURE 9 VALUE 3. EDIT0147 - EDIT0148 - 01 SELECTORS. EDIT0149 - 02 RETURN-SELECT PICTURE 9 VALUE 0. EDIT0150 - 02 NEXT-JOB-SELECT PICTURE 9 VALUE 0. EDIT0151 - EDIT0152 - PROCEDURE DIVISION. EDIT0153 - EDIT0154 - START-SECTION. EDIT0155 - OPEN INPUT OLD-VERSION, MODIFICATION, EDIT0156 - OUTPUT NEW-VERSION, COMMENTARY. EDIT0157 - MOVE "F" TO UPSI-BIT (1), UPSI-BIT (2). EDIT0158 - ACCEPT DATE-FROM-SYS FROM DATE. EDIT0159 - MOVE DFSYS (1) TO YEAR-RUN. EDIT0160 - MOVE DFSYS (2) TO MONTH-RUN. EDIT0161 - MOVE DFSYS (3) TO DAY-RUN. EDIT0162 - READ OLD-VERSION AT END EDIT0163 - MOVE "NO OLD VERSION FOUND" TO MESSAGE-TEXT EDIT0164 - WRITE COMMENT-LINE FROM MESSAGE-LOG EDIT0165 - GO TO END-JOB. EDIT0166 - MOVE OLD-STATEMENT TO NEW-STATEMENT. EDIT0167 - PERFORM OUTPUT-A-RECORD. EDIT0168 - EDIT0169 - TOP-OF-PAGE-ROUTINE. EDIT0170 - ADD 1 TO PAGE-NUMBER. EDIT0171 - MOVE ZERO TO LINE-COUNT. EDIT0172 - WRITE COMMENT-LINE FROM HEADINGS-LINE AFTER PAGE. EDIT0173 - WRITE COMMENT-LINE FROM BLANK-LINE. EDIT0174 - EDIT0175 - READ-A-COMMAND. EDIT0176 - READ MODIFICATION AT END EDIT0177 - MOVE "MODIFICATION FILE ENDED " TO MESSAGE-TEXT EDIT0178 - WRITE COMMENT-LINE FROM MESSAGE-LOG EDIT0179 - GO TO FINISH-JOB. EDIT0180 - MOVE UPDATE-ORDER TO COMMAND-IMAGE. EDIT0181 - WRITE COMMENT-LINE FROM COMMAND-LISTING. EDIT0182 - ADD 2 TO LINE-COUNT. EDIT0183 - IF A-BLANK MOVE ZEROES TO A-FIELD. EDIT0184 - IF B-BLANK MOVE ZEROES TO B-FIELD. EDIT0185 - MOVE A-FIELD TO FIELDA. EDIT0186 - MOVE B-FIELD TO FIELDB. EDIT0187 - EDIT0188 - TEST-COMMAND-TYPE. EDIT0189 - IF CHANGE GO TO CHANGE-A-RECORD. EDIT0190 - IF REMOVE GO TO DELETE-A-RECORD. EDIT0191 - IF DISPLY MOVE "T" TO UPSI-BIT (2) EDIT0192 - GO TO FINISH-JOB. EDIT0193 - IF ENDJOB GO TO FINISH-JOB. EDIT0194 - IF ADDNEW GO TO INSERT-A-RECORD. EDIT0195 - MOVE "INVALID COMMAND IGNORED." TO MESSAGE-TEXT. EDIT0196 - WRITE COMMENT-LINE FROM MESSAGE-LOG. EDIT0197 - GO TO READ-A-COMMAND. EDIT0198 - EDIT0199 - CHANGE-A-RECORD. EDIT0200 - ALTER RETURN-TO-USER TO PROCEED TO INSERTION-PROCESS. EDIT0201 - ALTER NEXT-JOB-STEP TO PROCEED TO DELETION-PROCESS. EDIT0202 - EDIT0205 - FIND-FIELDA. EDIT0206 - IF OLD-NUMBER IS GREATER THAN FIELDA EDIT0207 - MOVE "RECORD ALREADY PASSED" TO MESSAGE-TEXT EDIT0208 - WRITE COMMENT-LINE FROM MESSAGE-LOG EDIT0209 - GO TO READ-A-COMMAND. EDIT0210 - READ OLD-VERSION AT END EDIT0211 - MOVE "NOT FOUND IN OLD VERSION" TO DISPLAY-TEXT EDIT0212 - MOVE FIELDA TO DISPLAY-TEMP EDIT0213 - WRITE COMMENT-LINE FROM DISPLAY-MESSAGE EDIT0214 - GO TO END-JOB. EDIT0215 - IF OLD-NUMBER IS LESS THAN FIELDA EDIT0216 - MOVE OLD-STATEMENT TO NEW-STATEMENT EDIT0217 - PERFORM OUTPUT-A-RECORD EDIT0218 - GO TO FIND-FIELDA. EDIT0219 - EDIT0220 - RETURN-TO-USER. EDIT0221 - GO TO END-JOB. EDIT0223 - EDIT0228 - INSERT-A-RECORD. EDIT0229 - ALTER RETURN-TO-USER TO PROCEED TO INSERTION-PROCESS. EDIT0230 - ALTER NEXT-JOB-STEP TO PROCEED TO FORCED-WRITE. EDIT0231 - GO TO FIND-FIELDA. EDIT0234 - EDIT0235 - INSERTION-PROCESS. EDIT0236 - READ MODIFICATION AT END EDIT0237 - MOVE "NO ENDSET FOUND" TO MESSAGE-TEXT EDIT0238 - WRITE COMMENT-LINE FROM MESSAGE-LOG EDIT0239 - GO TO END-JOB. EDIT0240 - IF ENDSET EDIT0241 - MOVE COMMAND-ADDITIONS TO DISPLAY-TEMP EDIT0242 - MOVE "RECORDS INSERTED." TO DISPLAY-TEXT EDIT0243 - WRITE COMMENT-LINE FROM DISPLAY-MESSAGE EDIT0244 - ADD COMMAND-ADDITIONS TO TOTAL-INSERTED EDIT0245 - MOVE ZEROES TO COMMAND-ADDITIONS EDIT0246 - GO TO NEXT-JOB-STEP. EDIT0247 - MOVE INSERTION TO NEW-STATEMENT, ACTIVE-IMAGE. EDIT0248 - MOVE "I " TO DISPOSITION. EDIT0249 - PERFORM OUTPUT-A-RECORD. EDIT0250 - WRITE COMMENT-LINE FROM ACTIVITIES-LISTING. EDIT0251 - ADD 1 TO COMMAND-ADDITIONS. EDIT0252 - ADD 1 TO LINE-COUNT. EDIT0253 - IF LINE-COUNT EQUAL 56 PERFORM TOP-OF-PAGE-ROUTINE. EDIT0254 - GO TO INSERTION-PROCESS. EDIT0255 - EDIT0256 - NEXT-JOB-STEP. EDIT0257 - GO TO END-JOB. EDIT0259 - EDIT0264 - FORCED-WRITE. EDIT0265 - MOVE OLD-STATEMENT TO NEW-STATEMENT. EDIT0266 - PERFORM OUTPUT-A-RECORD. EDIT0267 - GO TO READ-A-COMMAND. EDIT0268 - EDIT0269 - DELETE-A-RECORD. EDIT0270 - ALTER RETURN-TO-USER TO PROCEED TO DELETION-PROCESS. EDIT0271 - GO TO FIND-FIELDA. EDIT0273 - EDIT0274 - DELETION-PROCESS. EDIT0275 - MOVE OLD-RECORD TO ACTIVE-IMAGE. EDIT0276 - MOVE "D " TO DISPOSITION. EDIT0277 - WRITE COMMENT-LINE FROM ACTIVITIES-LISTING. EDIT0278 - ADD 1 TO LINE-COUNT. EDIT0279 - IF LINE-COUNT EQUAL 56 PERFORM TOP-OF-PAGE-ROUTINE. EDIT0280 - ADD 1 TO COMMAND-SUBTRACTIONS. EDIT0281 - IF OLD-NUMBER IS NOT LESS THAN FIELDB EDIT0282 - MOVE COMMAND-SUBTRACTIONS TO DISPLAY-TEMP EDIT0283 - MOVE "RECORDS DELETED." TO DISPLAY-TEXT EDIT0284 - WRITE COMMENT-LINE FROM DISPLAY-MESSAGE EDIT0285 - ADD COMMAND-SUBTRACTIONS TO TOTAL-DELETED EDIT0286 - MOVE OLD-STATEMENT TO NEW-STATEMENT EDIT0287 - MOVE ZEROES TO COMMAND-SUBTRACTIONS EDIT0288 - GO TO READ-A-COMMAND. EDIT0289 - READ OLD-VERSION AT END EDIT0290 - MOVE "NOT FOUND IN OLD VERSION DOING DELETE" EDIT0291 - TO DISPLAY-TEXT EDIT0292 - WRITE COMMENT-LINE FROM DISPLAY-MESSAGE EDIT0293 - GO TO END-JOB. EDIT0294 - GO TO DELETION-PROCESS. EDIT0295 - EDIT0296 - OUTPUT-A-RECORD. EDIT0297 - ADD 1 TO OUTPUT-COUNT. EDIT0298 - MOVE OUTPUT-COUNT TO NEW-NUMBER. EDIT0299 - WRITE NEW-RECORD. EDIT0300 - EDIT0301 - FINISH-JOB. EDIT0302 - READ OLD-VERSION AT END GO TO TEST-FOR-LISTING. EDIT0303 - MOVE OLD-STATEMENT TO NEW-STATEMENT. EDIT0304 - GO TO OUTPUT-A-RECORD. EDIT0305 - EDIT0306 - TEST-FOR-LISTING. EDIT0307 - PERFORM TOP-OF-PAGE-ROUTINE. EDIT0308 - MOVE OLD-NUMBER TO DISPLAY-TEMP. EDIT0309 - MOVE "RECORDS READ." TO DISPLAY-TEXT. EDIT0310 - WRITE COMMENT-LINE FROM DISPLAY-MESSAGE. EDIT0311 - MOVE TOTAL-INSERTED TO DISPLAY-TEMP. EDIT0312 - MOVE "RECORDS ADDED." TO DISPLAY-TEXT. EDIT0313 - WRITE COMMENT-LINE FROM DISPLAY-MESSAGE. EDIT0314 - MOVE TOTAL-DELETED TO DISPLAY-TEMP. EDIT0315 - MOVE "RECORDS DROPPED." TO DISPLAY-TEXT. EDIT0316 - WRITE COMMENT-LINE FROM DISPLAY-MESSAGE. EDIT0317 - MOVE OUTPUT-COUNT TO DISPLAY-TEMP. EDIT0318 - MOVE "RECORDS IN NEW FILE." TO DISPLAY-TEXT. EDIT0319 - WRITE COMMENT-LINE FROM DISPLAY-MESSAGE. EDIT0320 - IF UPSI-BIT (2) EQUAL "F" GO TO END-JOB. EDIT0321 - CLOSE NEW-VERSION. EDIT0322 - OPEN INPUT NEW-VERSION. EDIT0323 - MOVE "UPDATED LISTING" TO PHASE. EDIT0324 - MOVE ZEROES TO PAGE-NUMBER. EDIT0325 - PERFORM TOP-OF-PAGE-ROUTINE. EDIT0326 - MOVE SPACES TO DISPOSITION. EDIT0327 - EDIT0328 - LISTING-LOOP. EDIT0329 - READ NEW-VERSION AT END GO TO END-JOB. EDIT0330 - MOVE NEW-RECORD TO ACTIVE-IMAGE. EDIT0331 - WRITE COMMENT-LINE FROM ACTIVITIES-LISTING. EDIT0332 - ADD 1 TO LINE-COUNT. EDIT0333 - IF LINE-COUNT EQUAL 56 PERFORM TOP-OF-PAGE-ROUTINE. EDIT0334 - GO TO LISTING-LOOP. EDIT0335 - EDIT0336 - END-JOB. EDIT0337 - MOVE "PROGRAM TERMINATION" TO MESSAGE-TEXT. EDIT0338 - WRITE COMMENT-LINE FROM MESSAGE-LOG. EDIT0339 - CLOSE OLD-VERSION, NEW-VERSION, MODIFICATION, COMMENTARY. EDIT0340 - STOP RUN. EDIT0341 - EDIT0342 - END PROGRAM EDITOR. EDIT0343 -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/listings.at:4281: \$COMPILE_ONLY -Xref -t prog.lst -tlines=0 -tsymbols EDITOR.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY -Xref -t prog.lst -tlines=0 -tsymbols EDITOR.cob" "listings.at:4281" -( $at_check_trace; $COMPILE_ONLY -Xref -t prog.lst -tlines=0 -tsymbols EDITOR.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "EDITOR.cob:42: warning: LABEL RECORDS is obsolete in GnuCOBOL -EDITOR.cob:44: warning: DATA RECORDS is obsolete in GnuCOBOL -EDITOR.cob:51: warning: LABEL RECORDS is obsolete in GnuCOBOL -EDITOR.cob:53: warning: DATA RECORDS is obsolete in GnuCOBOL -EDITOR.cob:60: warning: LABEL RECORDS is obsolete in GnuCOBOL -EDITOR.cob:62: warning: DATA RECORDS is obsolete in GnuCOBOL -EDITOR.cob:85: warning: LABEL RECORDS is obsolete in GnuCOBOL -EDITOR.cob:87: warning: DATA RECORDS is obsolete in GnuCOBOL -EDITOR.cob:30: error: missing file description for FILE PRT-VERSION -EDITOR.cob: in paragraph 'CHANGE-A-RECORD': -EDITOR.cob:198: warning: ALTER is obsolete in GnuCOBOL -EDITOR.cob:199: warning: ALTER is obsolete in GnuCOBOL -EDITOR.cob: in paragraph 'INSERT-A-RECORD': -EDITOR.cob:220: warning: ALTER is obsolete in GnuCOBOL -EDITOR.cob:221: warning: ALTER is obsolete in GnuCOBOL -EDITOR.cob: in paragraph 'DELETE-A-RECORD': -EDITOR.cob:254: warning: ALTER is obsolete in GnuCOBOL -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/listings.at:4281" -$at_failed && at_fn_log_failure \ -"prog.lst" -$at_traceon; } - - - -cat >prog18.lst <<'_ATEOF' -GnuCOBOL V.R.P EDITOR.cob DDD MMM dd HH:MM:SS YYYY - -LINE PG/LN A...B............................................................ - -000001 -000002 IDENTIFICATION DIVISION. -000003 PROGRAM-ID. -000004 EDITOR. -000005 -000006 *NOTE. -000007 * THIS VERSION OF EDITOR 1 COMPRISES AN ENTIRE RE_WRITE -000008 * OF THE BASIC EDITOR WITH ONLY ONE CHANGE IN THE COMMAND -000009 * STRUCTURE, THAT BEING THE ADDITION OF A "CHANGE" COMMAND -000010 * TO SERVE IN PLACE OF THE INSERT-DELETE COMBINATION WHICH -000011 * WAS REQUIRED IN PREVIOUS VERSIONS. RECORD NUMBER FIELDS -000012 * HAVE ALSO BEEN REDUCED FROM 5 DIGITS TO 4. -000013 * CHANGE 1. -000014 * MODIFY TO RUN ON TI-990. -000015 * CHANGE 2. -000016 * MODIFY TO RUN ON GNUCOBOL. -000017 -000018 ENVIRONMENT DIVISION. -000019 CONFIGURATION SECTION. -000020 SOURCE-COMPUTER. -000021 IBM-360. -000022 OBJECT-COMPUTER. -000023 IBM-360. -000024 INPUT-OUTPUT SECTION. -000025 FILE-CONTROL. -000026 SELECT OLD-VERSION ASSIGN TO "SYSUT1" -000027 ORGANIZATION LINE SEQUENTIAL. -000028 SELECT NEW-VERSION ASSIGN TO "SYSUT2" -000029 ORGANIZATION LINE SEQUENTIAL. -000030 SELECT PRT-VERSION ASSIGN TO "SYSUT2" -error: missing file description for FILE PRT-VERSION -000031 ORGANIZATION LINE SEQUENTIAL. -000032 SELECT MODIFICATION ASSIGN TO "SYSIN1" -000033 ORGANIZATION LINE SEQUENTIAL. -000034 SELECT COMMENTARY ASSIGN TO "SYSOU1" -000035 ORGANIZATION LINE SEQUENTIAL. -000036 -000037 DATA DIVISION. -000038 -000039 FILE SECTION. -000040 -000041 FD OLD-VERSION -000042 LABEL RECORDS ARE STANDARD -warning: LABEL RECORDS is obsolete in GnuCOBOL -000043 BLOCK CONTAINS 80 CHARACTERS -000044 DATA RECORD IS OLD-RECORD. -warning: DATA RECORDS is obsolete in GnuCOBOL -000045 -000046 01 OLD-RECORD. -000047 02 OLD-STATEMENT PICTURE X(75). -000048 02 OLD-NUMBER PICTURE X(5). -000049 -000050 FD NEW-VERSION -000051 LABEL RECORDS ARE STANDARD -warning: LABEL RECORDS is obsolete in GnuCOBOL -000052 BLOCK CONTAINS 80 CHARACTERS -000053 DATA RECORD IS NEW-RECORD. -warning: DATA RECORDS is obsolete in GnuCOBOL -000054 -000055 01 NEW-RECORD. -000056 02 NEW-STATEMENT PICTURE X(75). -000057 02 NEW-NUMBER PICTURE X(5). -000058 -000059 FD MODIFICATION -000060 LABEL RECORDS ARE OMITTED -warning: LABEL RECORDS is obsolete in GnuCOBOL -000061 BLOCK CONTAINS 80 CHARACTERS -000062 DATA RECORD IS UPDATE-ORDER. -warning: DATA RECORDS is obsolete in GnuCOBOL -000063 -000064 01 UPDATE-ORDER. -000065 02 INSERTION. -000066 03 COMMAND PICTURE X(6). -000067 88 ENDJOB VALUE "ENDJOB". -000068 88 ENDSET VALUE "ENDSET". -000069 88 REMOVE VALUE "REMOVE". -000070 88 ADDNEW VALUE "INSERT". -000071 88 CHANGE VALUE "CHANGE". -000072 88 DISPLY VALUE "DISPLY". -000073 03 FILLER PICTURE X. -000074 03 A-FIELD PICTURE 9(5). -000075 03 A-ALPHA REDEFINES A-FIELD PICTURE X(5). -000076 88 A-BLANK VALUE SPACES. -000077 03 FILLER PICTURE X(4). -000078 03 B-FIELD PICTURE 9(5). -000079 03 B-ALPHA REDEFINES B-FIELD PICTURE X(5). -000080 88 B-BLANK VALUE SPACES. -000081 03 FILLER PICTURE X(54). -000082 02 FILLER PICTURE X(5). -000083 -000084 FD COMMENTARY -000085 LABEL RECORDS ARE OMITTED -warning: LABEL RECORDS is obsolete in GnuCOBOL -000086 BLOCK CONTAINS 82 CHARACTERS -000087 DATA RECORD IS COMMENT-LINE. -warning: DATA RECORDS is obsolete in GnuCOBOL -000088 -000089 01 COMMENT-LINE. -000090 02 FILLER PICTURE X(82). -000091 -000092 WORKING-STORAGE SECTION. -000093 -000094 77 COMMAND-ADDITIONS PICTURE 9(3) COMPUTATIONAL VALUE 0. -000095 77 COMMAND-SUBTRACTIONS PICTURE 9(3) COMPUTATIONAL VALUE 0. -000096 77 TOTAL-INSERTED PICTURE 9(3) COMPUTATIONAL VALUE 0. -000097 77 TOTAL-DELETED PICTURE 9(3) COMPUTATIONAL VALUE 0. -000098 77 OUTPUT-COUNT PICTURE 9(5) COMPUTATIONAL VALUE 0. -000099 77 LINE-COUNT PICTURE 9(2) COMPUTATIONAL VALUE 0. -000100 77 FIELDA PICTURE 9(5) VALUE 0. -000101 77 FIELDB PICTURE 9(5) VALUE 0. -000102 77 BLANK-LINE PICTURE X(82) VALUE SPACES. -000103 -000104 01 DATE-FROM-SYS. -000105 02 DFSYS OCCURS 3 TIMES PICTURE 99. -000106 -000107 01 HEADINGS-LINE. -000108 02 FILLER PICTURE X(15) VALUE "EDITOR VERSION". -000109 02 FILLER PICTURE X(20) VALUE "1.1 - 206/72". -000110 02 PHASE PICTURE X(17) VALUE "UPDATING AS OF". -000111 02 MONTH-RUN PICTURE XX. -000112 02 FILLER PICTURE X VALUE "/". -000113 02 DAY-RUN PICTURE XX. -000114 02 FILLER PICTURE X VALUE "/". -000115 02 YEAR-RUN PICTURE XX. -000116 02 FILLER PICTURE X(8) VALUE SPACES. -000117 02 FILLER PICTURE X(8) VALUE " PAGE: ". -000118 02 PAGE-NUMBER PICTURE 9(4) VALUE 0. -000119 -000120 01 COMMAND-LISTING. -000121 02 FILLER PICTURE X(2) VALUE SPACES. -000122 02 COMMAND-IMAGE PICTURE X(80). -000123 -000124 01 ACTIVITIES-LISTING. -000125 02 DISPOSITION PICTURE X(2). -000126 02 ACTIVE-IMAGE PICTURE X(80). -000127 -000128 01 UPSI-BYTE. -000129 02 UPSI-BIT OCCURS 8 TIMES PICTURE X. -000130 -000131 01 MESSAGE-LOG. -000132 02 FILLER PICTURE X(2) VALUE SPACES. -000133 02 MESSAGE-TEXT PICTURE X(80). -000134 -000135 01 DISPLAY-MESSAGE. -000136 02 FILLER PICTURE X(2) VALUE SPACES. -000137 02 DISPLAY-TEMP PICTURE X(6). -000138 02 FILLER PICTURE X(2) VALUE SPACES. -000139 02 DISPLAY-TEXT PICTURE X(60). -000140 -000141 77 END-JOB-PROCESS PICTURE 9 VALUE 0. -000142 77 DELETE-PROCESS PICTURE 9 VALUE 1. -000143 77 INSERT-PROCESS PICTURE 9 VALUE 2. -000144 77 WRITE-PROCESS PICTURE 9 VALUE 3. -000145 -000146 01 SELECTORS. -000147 02 RETURN-SELECT PICTURE 9 VALUE 0. -000148 02 NEXT-JOB-SELECT PICTURE 9 VALUE 0. -000149 -000150 PROCEDURE DIVISION. -000151 -000152 START-SECTION. -000153 OPEN INPUT OLD-VERSION, MODIFICATION, -000154 OUTPUT NEW-VERSION, COMMENTARY. -000155 MOVE "F" TO UPSI-BIT (1), UPSI-BIT (2). -000156 ACCEPT DATE-FROM-SYS FROM DATE. -000157 MOVE DFSYS (1) TO YEAR-RUN. -000158 MOVE DFSYS (2) TO MONTH-RUN. -000159 MOVE DFSYS (3) TO DAY-RUN. -000160 READ OLD-VERSION AT END -000161 MOVE "NO OLD VERSION FOUND" TO MESSAGE-TEXT -000162 WRITE COMMENT-LINE FROM MESSAGE-LOG -000163 GO TO END-JOB. -000164 MOVE OLD-STATEMENT TO NEW-STATEMENT. -000165 PERFORM OUTPUT-A-RECORD. -000166 -000167 TOP-OF-PAGE-ROUTINE. -000168 ADD 1 TO PAGE-NUMBER. -000169 MOVE ZERO TO LINE-COUNT. -000170 WRITE COMMENT-LINE FROM HEADINGS-LINE AFTER PAGE. -000171 WRITE COMMENT-LINE FROM BLANK-LINE. -000172 -000173 READ-A-COMMAND. -000174 READ MODIFICATION AT END -000175 MOVE "MODIFICATION FILE ENDED " TO MESSAGE-TEXT -000176 WRITE COMMENT-LINE FROM MESSAGE-LOG -000177 GO TO FINISH-JOB. -000178 MOVE UPDATE-ORDER TO COMMAND-IMAGE. -000179 WRITE COMMENT-LINE FROM COMMAND-LISTING. -000180 ADD 2 TO LINE-COUNT. -000181 IF A-BLANK MOVE ZEROES TO A-FIELD. -000182 IF B-BLANK MOVE ZEROES TO B-FIELD. -000183 MOVE A-FIELD TO FIELDA. -000184 MOVE B-FIELD TO FIELDB. -000185 -000186 TEST-COMMAND-TYPE. -000187 IF CHANGE GO TO CHANGE-A-RECORD. -000188 IF REMOVE GO TO DELETE-A-RECORD. -000189 IF DISPLY MOVE "T" TO UPSI-BIT (2) -000190 GO TO FINISH-JOB. -000191 IF ENDJOB GO TO FINISH-JOB. -000192 IF ADDNEW GO TO INSERT-A-RECORD. -000193 MOVE "INVALID COMMAND IGNORED." TO MESSAGE-TEXT. -000194 WRITE COMMENT-LINE FROM MESSAGE-LOG. -000195 GO TO READ-A-COMMAND. -000196 -000197 CHANGE-A-RECORD. -000198 ALTER RETURN-TO-USER TO PROCEED TO INSERTION-PROCESS. -warning: ALTER is obsolete in GnuCOBOL -000199 ALTER NEXT-JOB-STEP TO PROCEED TO DELETION-PROCESS. -warning: ALTER is obsolete in GnuCOBOL -000200 -000201 FIND-FIELDA. -000202 IF OLD-NUMBER IS GREATER THAN FIELDA -000203 MOVE "RECORD ALREADY PASSED" TO MESSAGE-TEXT -000204 WRITE COMMENT-LINE FROM MESSAGE-LOG -000205 GO TO READ-A-COMMAND. -000206 READ OLD-VERSION AT END -000207 MOVE "NOT FOUND IN OLD VERSION" TO DISPLAY-TEXT -000208 MOVE FIELDA TO DISPLAY-TEMP -000209 WRITE COMMENT-LINE FROM DISPLAY-MESSAGE -000210 GO TO END-JOB. -000211 IF OLD-NUMBER IS LESS THAN FIELDA -000212 MOVE OLD-STATEMENT TO NEW-STATEMENT -000213 PERFORM OUTPUT-A-RECORD -000214 GO TO FIND-FIELDA. -000215 -000216 RETURN-TO-USER. -000217 GO TO END-JOB. -000218 -000219 INSERT-A-RECORD. -000220 ALTER RETURN-TO-USER TO PROCEED TO INSERTION-PROCESS. -warning: ALTER is obsolete in GnuCOBOL -000221 ALTER NEXT-JOB-STEP TO PROCEED TO FORCED-WRITE. -warning: ALTER is obsolete in GnuCOBOL -000222 GO TO FIND-FIELDA. -000223 -000224 INSERTION-PROCESS. -000225 READ MODIFICATION AT END -000226 MOVE "NO ENDSET FOUND" TO MESSAGE-TEXT -000227 WRITE COMMENT-LINE FROM MESSAGE-LOG -000228 GO TO END-JOB. -000229 IF ENDSET -000230 MOVE COMMAND-ADDITIONS TO DISPLAY-TEMP -000231 MOVE "RECORDS INSERTED." TO DISPLAY-TEXT -000232 WRITE COMMENT-LINE FROM DISPLAY-MESSAGE -000233 ADD COMMAND-ADDITIONS TO TOTAL-INSERTED -000234 MOVE ZEROES TO COMMAND-ADDITIONS -000235 GO TO NEXT-JOB-STEP. -000236 MOVE INSERTION TO NEW-STATEMENT, ACTIVE-IMAGE. -000237 MOVE "I " TO DISPOSITION. -000238 PERFORM OUTPUT-A-RECORD. -000239 WRITE COMMENT-LINE FROM ACTIVITIES-LISTING. -000240 ADD 1 TO COMMAND-ADDITIONS. -000241 ADD 1 TO LINE-COUNT. -000242 IF LINE-COUNT EQUAL 56 PERFORM TOP-OF-PAGE-ROUTINE. -000243 GO TO INSERTION-PROCESS. -000244 -000245 NEXT-JOB-STEP. -000246 GO TO END-JOB. -000247 -000248 FORCED-WRITE. -000249 MOVE OLD-STATEMENT TO NEW-STATEMENT. -000250 PERFORM OUTPUT-A-RECORD. -000251 GO TO READ-A-COMMAND. -000252 -000253 DELETE-A-RECORD. -000254 ALTER RETURN-TO-USER TO PROCEED TO DELETION-PROCESS. -warning: ALTER is obsolete in GnuCOBOL -000255 GO TO FIND-FIELDA. -000256 -000257 DELETION-PROCESS. -000258 MOVE OLD-RECORD TO ACTIVE-IMAGE. -000259 MOVE "D " TO DISPOSITION. -000260 WRITE COMMENT-LINE FROM ACTIVITIES-LISTING. -000261 ADD 1 TO LINE-COUNT. -000262 IF LINE-COUNT EQUAL 56 PERFORM TOP-OF-PAGE-ROUTINE. -000263 ADD 1 TO COMMAND-SUBTRACTIONS. -000264 IF OLD-NUMBER IS NOT LESS THAN FIELDB -000265 MOVE COMMAND-SUBTRACTIONS TO DISPLAY-TEMP -000266 MOVE "RECORDS DELETED." TO DISPLAY-TEXT -000267 WRITE COMMENT-LINE FROM DISPLAY-MESSAGE -000268 ADD COMMAND-SUBTRACTIONS TO TOTAL-DELETED -000269 MOVE OLD-STATEMENT TO NEW-STATEMENT -000270 MOVE ZEROES TO COMMAND-SUBTRACTIONS -000271 GO TO READ-A-COMMAND. -000272 READ OLD-VERSION AT END -000273 MOVE "NOT FOUND IN OLD VERSION DOING DELETE" -000274 TO DISPLAY-TEXT -000275 WRITE COMMENT-LINE FROM DISPLAY-MESSAGE -000276 GO TO END-JOB. -000277 GO TO DELETION-PROCESS. -000278 -000279 OUTPUT-A-RECORD. -000280 ADD 1 TO OUTPUT-COUNT. -000281 MOVE OUTPUT-COUNT TO NEW-NUMBER. -000282 WRITE NEW-RECORD. -000283 -000284 FINISH-JOB. -000285 READ OLD-VERSION AT END GO TO TEST-FOR-LISTING. -000286 MOVE OLD-STATEMENT TO NEW-STATEMENT. -000287 GO TO OUTPUT-A-RECORD. -000288 -000289 TEST-FOR-LISTING. -000290 PERFORM TOP-OF-PAGE-ROUTINE. -000291 MOVE OLD-NUMBER TO DISPLAY-TEMP. -000292 MOVE "RECORDS READ." TO DISPLAY-TEXT. -000293 WRITE COMMENT-LINE FROM DISPLAY-MESSAGE. -000294 MOVE TOTAL-INSERTED TO DISPLAY-TEMP. -000295 MOVE "RECORDS ADDED." TO DISPLAY-TEXT. -000296 WRITE COMMENT-LINE FROM DISPLAY-MESSAGE. -000297 MOVE TOTAL-DELETED TO DISPLAY-TEMP. -000298 MOVE "RECORDS DROPPED." TO DISPLAY-TEXT. -000299 WRITE COMMENT-LINE FROM DISPLAY-MESSAGE. -000300 MOVE OUTPUT-COUNT TO DISPLAY-TEMP. -000301 MOVE "RECORDS IN NEW FILE." TO DISPLAY-TEXT. -000302 WRITE COMMENT-LINE FROM DISPLAY-MESSAGE. -000303 IF UPSI-BIT (2) EQUAL "F" GO TO END-JOB. -000304 CLOSE NEW-VERSION. -000305 OPEN INPUT NEW-VERSION. -000306 MOVE "UPDATED LISTING" TO PHASE. -000307 MOVE ZEROES TO PAGE-NUMBER. -000308 PERFORM TOP-OF-PAGE-ROUTINE. -000309 MOVE SPACES TO DISPOSITION. -000310 -000311 LISTING-LOOP. -000312 READ NEW-VERSION AT END GO TO END-JOB. -000313 MOVE NEW-RECORD TO ACTIVE-IMAGE. -000314 WRITE COMMENT-LINE FROM ACTIVITIES-LISTING. -000315 ADD 1 TO LINE-COUNT. -000316 IF LINE-COUNT EQUAL 56 PERFORM TOP-OF-PAGE-ROUTINE. -000317 GO TO LISTING-LOOP. -000318 -000319 END-JOB. -000320 MOVE "PROGRAM TERMINATION" TO MESSAGE-TEXT. -000321 WRITE COMMENT-LINE FROM MESSAGE-LOG. -000322 CLOSE OLD-VERSION, NEW-VERSION, MODIFICATION, COMMENTARY. -000323 STOP RUN. -000324 -000325 END PROGRAM EDITOR. - -SIZE TYPE LVL NAME PICTURE - -00080 FILE OLD-VERSION -00080 GROUP 01 OLD-RECORD -00075 ALPHANUMERIC 02 OLD-STATEMENT X(75) -00005 ALPHANUMERIC 02 OLD-NUMBER X(5) - -00080 FILE NEW-VERSION -00080 GROUP 01 NEW-RECORD -00075 ALPHANUMERIC 02 NEW-STATEMENT X(75) -00005 ALPHANUMERIC 02 NEW-NUMBER X(5) - -00032 FILE PRT-VERSION - -00080 FILE MODIFICATION -00080 GROUP 01 UPDATE-ORDER -00075 GROUP 02 INSERTION -00006 ALPHANUMERIC 03 COMMAND X(6) - CONDITIONAL 88 ENDJOB - CONDITIONAL 88 ENDSET - CONDITIONAL 88 REMOVE - CONDITIONAL 88 ADDNEW - CONDITIONAL 88 CHANGE - CONDITIONAL 88 DISPLY -00001 ALPHANUMERIC 03 FILLER X -00005 NUMERIC 03 A-FIELD 9(5) -00005 ALPHANUMERIC 03 A-ALPHA X(5), REDEFINES A-FIELD - CONDITIONAL 88 A-BLANK -00004 ALPHANUMERIC 03 FILLER X(4) -00005 NUMERIC 03 B-FIELD 9(5) -00005 ALPHANUMERIC 03 B-ALPHA X(5), REDEFINES B-FIELD - CONDITIONAL 88 B-BLANK -00054 ALPHANUMERIC 03 FILLER X(54) -00005 ALPHANUMERIC 02 FILLER X(5) - -00082 FILE COMMENTARY -00082 GROUP 01 COMMENT-LINE -00082 ALPHANUMERIC 02 FILLER X(82) - - WORKING-STORAGE SECTION - -00002 NUMERIC 77 COMMAND-ADDITIONS 9(3) COMP -00002 NUMERIC 77 COMMAND-SUBTRACTIONS 9(3) COMP -00002 NUMERIC 77 TOTAL-INSERTED 9(3) COMP -00002 NUMERIC 77 TOTAL-DELETED 9(3) COMP -00004 NUMERIC 77 OUTPUT-COUNT 9(5) COMP -00001 NUMERIC 77 LINE-COUNT 9(2) COMP -00005 NUMERIC 77 FIELDA 9(5) -00005 NUMERIC 77 FIELDB 9(5) -00082 ALPHANUMERIC 77 BLANK-LINE X(82) - -00006 GROUP 01 DATE-FROM-SYS -00002 NUMERIC 02 DFSYS 99, OCCURS 3 - -00080 GROUP 01 HEADINGS-LINE -00015 ALPHANUMERIC 02 FILLER X(15) -00020 ALPHANUMERIC 02 FILLER X(20) -00017 ALPHANUMERIC 02 PHASE X(17) -00002 ALPHANUMERIC 02 MONTH-RUN XX -00001 ALPHANUMERIC 02 FILLER X -00002 ALPHANUMERIC 02 DAY-RUN XX -00001 ALPHANUMERIC 02 FILLER X -00002 ALPHANUMERIC 02 YEAR-RUN XX -00008 ALPHANUMERIC 02 FILLER X(8) -00008 ALPHANUMERIC 02 FILLER X(8) -00004 NUMERIC 02 PAGE-NUMBER 9(4) - -00082 GROUP 01 COMMAND-LISTING -00002 ALPHANUMERIC 02 FILLER X(2) -00080 ALPHANUMERIC 02 COMMAND-IMAGE X(80) - -00082 GROUP 01 ACTIVITIES-LISTING -00002 ALPHANUMERIC 02 DISPOSITION X(2) -00080 ALPHANUMERIC 02 ACTIVE-IMAGE X(80) - -00008 GROUP 01 UPSI-BYTE -00001 ALPHANUMERIC 02 UPSI-BIT X, OCCURS 8 - -00082 GROUP 01 MESSAGE-LOG -00002 ALPHANUMERIC 02 FILLER X(2) -00080 ALPHANUMERIC 02 MESSAGE-TEXT X(80) - -00070 GROUP 01 DISPLAY-MESSAGE -00002 ALPHANUMERIC 02 FILLER X(2) -00006 ALPHANUMERIC 02 DISPLAY-TEMP X(6) -00002 ALPHANUMERIC 02 FILLER X(2) -00060 ALPHANUMERIC 02 DISPLAY-TEXT X(60) - -00001 NUMERIC 77 END-JOB-PROCESS 9 -00001 NUMERIC 77 DELETE-PROCESS 9 -00001 NUMERIC 77 INSERT-PROCESS 9 -00001 NUMERIC 77 WRITE-PROCESS 9 - -00002 GROUP 01 SELECTORS -00001 NUMERIC 02 RETURN-SELECT 9 -00001 NUMERIC 02 NEXT-JOB-SELECT 9 - - -NAME DEFINED REFERENCES - -OLD-VERSION 26 41 153 160 206 272 - 285 322 -OLD-RECORD 46 44 258 -OLD-STATEMENT 47 164 212 249 269 286 -OLD-NUMBER 48 202 211 264 291 - -NEW-VERSION 28 50 *154 *282 304 305 - 312 322 -NEW-RECORD 55 53 282 313 -NEW-STATEMENT 56 *164 *212 *236 *249 *269 - *286 -NEW-NUMBER 57 *281 - -PRT-VERSION 30 not referenced - -MODIFICATION 32 59 153 174 225 322 -UPDATE-ORDER 64 62 178 -INSERTION 65 236 -COMMAND 66 referenced by parent/child -ENDJOB 67 191 -ENDSET 68 229 -REMOVE 69 188 -ADDNEW 70 192 -CHANGE 71 187 -DISPLY 72 189 -A-FIELD 74 *181 183 -A-ALPHA 75 referenced by parent/child -A-BLANK 76 181 -B-FIELD 78 *182 184 -B-ALPHA 79 referenced by parent/child -B-BLANK 80 182 - -COMMENTARY 34 84 *154 *162 *170 *171 - *176 *179 *194 *204 *209 - *227 *232 *239 *260 *267 - *275 *293 *296 *299 *302 - *314 *321 322 -COMMENT-LINE 89 87 *162 *170 *171 *176 - *179 *194 *204 *209 *227 - *232 *239 *260 *267 *275 - *293 *296 *299 *302 *314 - *321 - -COMMAND-ADDITIONS 94 230 233 *234 240 -COMMAND-SUBTRACTIONS 95 263 265 268 *270 -TOTAL-INSERTED 96 233 294 -TOTAL-DELETED 97 268 297 -OUTPUT-COUNT 98 280 281 300 -LINE-COUNT 99 *169 180 241 242 261 - 262 315 316 -FIELDA 100 *183 202 208 211 -FIELDB 101 *184 264 -BLANK-LINE 102 171 -DATE-FROM-SYS 104 *156 -DFSYS 105 157 158 159 -HEADINGS-LINE 107 170 -PHASE 110 *306 -MONTH-RUN 111 *158 -DAY-RUN 113 *159 -YEAR-RUN 115 *157 -PAGE-NUMBER 118 168 *307 -COMMAND-LISTING 120 179 -COMMAND-IMAGE 122 *178 -ACTIVITIES-LISTING 124 239 260 314 -DISPOSITION 125 *237 *259 *309 -ACTIVE-IMAGE 126 *236 *258 *313 -UPSI-BYTE 128 referenced by child -UPSI-BIT 129 *155 *189 303 -MESSAGE-LOG 131 162 176 194 204 227 - 321 -MESSAGE-TEXT 133 *161 *175 *193 *203 *226 - *320 -DISPLAY-MESSAGE 135 209 232 267 275 293 - 296 299 302 -DISPLAY-TEMP 137 *208 *230 *265 *291 *294 - *297 *300 -DISPLAY-TEXT 139 *207 *231 *266 *274 *292 - *295 *298 *301 -END-JOB-PROCESS 141 not referenced -DELETE-PROCESS 142 not referenced -INSERT-PROCESS 143 not referenced -WRITE-PROCESS 144 not referenced -SELECTORS 146 not referenced -RETURN-SELECT 147 not referenced -NEXT-JOB-SELECT 148 not referenced - - -LABEL DEFINED REFERENCES - -E EDITOR 150 -P START-SECTION 152 not referenced -P TOP-OF-PAGE-ROUTINE 167 242 262 290 308 316 -P READ-A-COMMAND 173 195 205 251 271 -P TEST-COMMAND-TYPE 186 not referenced -P CHANGE-A-RECORD 197 187 -P FIND-FIELDA 201 214 222 255 -P RETURN-TO-USER 216 198 220 254 -P INSERT-A-RECORD 219 192 -P INSERTION-PROCESS 224 198 220 243 -P NEXT-JOB-STEP 245 199 221 235 -P FORCED-WRITE 248 221 -P DELETE-A-RECORD 253 188 -P DELETION-PROCESS 257 199 254 277 -P OUTPUT-A-RECORD 279 165 213 238 250 287 -P FINISH-JOB 284 177 190 191 -P TEST-FOR-LISTING 289 285 -P LISTING-LOOP 311 317 -P END-JOB 319 163 210 217 228 246 - 276 303 312 - - -Error/Warning summary: - -EDITOR.cob:42: warning: LABEL RECORDS is obsolete in GnuCOBOL -EDITOR.cob:44: warning: DATA RECORDS is obsolete in GnuCOBOL -EDITOR.cob:51: warning: LABEL RECORDS is obsolete in GnuCOBOL -EDITOR.cob:53: warning: DATA RECORDS is obsolete in GnuCOBOL -EDITOR.cob:60: warning: LABEL RECORDS is obsolete in GnuCOBOL -EDITOR.cob:62: warning: DATA RECORDS is obsolete in GnuCOBOL -EDITOR.cob:85: warning: LABEL RECORDS is obsolete in GnuCOBOL -EDITOR.cob:87: warning: DATA RECORDS is obsolete in GnuCOBOL -EDITOR.cob:30: error: missing file description for FILE PRT-VERSION -EDITOR.cob:198: warning: ALTER is obsolete in GnuCOBOL -EDITOR.cob:199: warning: ALTER is obsolete in GnuCOBOL -EDITOR.cob:220: warning: ALTER is obsolete in GnuCOBOL -EDITOR.cob:221: warning: ALTER is obsolete in GnuCOBOL -EDITOR.cob:254: warning: ALTER is obsolete in GnuCOBOL - -13 warnings in compilation group -1 error in compilation group -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/listings.at:4879: gcdiff -IGnuCOBOL prog18.lst prog.lst" -at_fn_check_prepare_trace "listings.at:4879" -( $at_check_trace; gcdiff -IGnuCOBOL prog18.lst prog.lst -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/listings.at:4879" -$at_failed && at_fn_log_failure \ -"prog.lst" -$at_traceon; } - - -{ set +x -$as_echo "$at_srcdir/listings.at:4881: \$COMPILE_ONLY -Xref -T prog.lst -tlines=0 -tsymbols EDITOR.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY -Xref -T prog.lst -tlines=0 -tsymbols EDITOR.cob" "listings.at:4881" -( $at_check_trace; $COMPILE_ONLY -Xref -T prog.lst -tlines=0 -tsymbols EDITOR.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "EDITOR.cob:42: warning: LABEL RECORDS is obsolete in GnuCOBOL -EDITOR.cob:44: warning: DATA RECORDS is obsolete in GnuCOBOL -EDITOR.cob:51: warning: LABEL RECORDS is obsolete in GnuCOBOL -EDITOR.cob:53: warning: DATA RECORDS is obsolete in GnuCOBOL -EDITOR.cob:60: warning: LABEL RECORDS is obsolete in GnuCOBOL -EDITOR.cob:62: warning: DATA RECORDS is obsolete in GnuCOBOL -EDITOR.cob:85: warning: LABEL RECORDS is obsolete in GnuCOBOL -EDITOR.cob:87: warning: DATA RECORDS is obsolete in GnuCOBOL -EDITOR.cob:30: error: missing file description for FILE PRT-VERSION -EDITOR.cob: in paragraph 'CHANGE-A-RECORD': -EDITOR.cob:198: warning: ALTER is obsolete in GnuCOBOL -EDITOR.cob:199: warning: ALTER is obsolete in GnuCOBOL -EDITOR.cob: in paragraph 'INSERT-A-RECORD': -EDITOR.cob:220: warning: ALTER is obsolete in GnuCOBOL -EDITOR.cob:221: warning: ALTER is obsolete in GnuCOBOL -EDITOR.cob: in paragraph 'DELETE-A-RECORD': -EDITOR.cob:254: warning: ALTER is obsolete in GnuCOBOL -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/listings.at:4881" -$at_failed && at_fn_log_failure \ -"prog.lst" -$at_traceon; } - - - -cat >prog19.lst <<'_ATEOF' -GnuCOBOL V.R.P EDITOR.cob DDD MMM dd HH:MM:SS YYYY - -LINE PG/LN A...B............................................................SEQUENCE - -000001 -000002 IDENTIFICATION DIVISION. EDIT0001 -000003 PROGRAM-ID. EDIT0002 -000004 EDITOR. EDIT0003 -000005 EDIT0008 -000006 *NOTE. EDIT0009 -000007 * THIS VERSION OF EDITOR 1 COMPRISES AN ENTIRE RE_WRITE EDIT0010 -000008 * OF THE BASIC EDITOR WITH ONLY ONE CHANGE IN THE COMMAND EDIT0011 -000009 * STRUCTURE, THAT BEING THE ADDITION OF A "CHANGE" COMMAND EDIT0012 -000010 * TO SERVE IN PLACE OF THE INSERT-DELETE COMBINATION WHICH EDIT0013 -000011 * WAS REQUIRED IN PREVIOUS VERSIONS. RECORD NUMBER FIELDS EDIT0014 -000012 * HAVE ALSO BEEN REDUCED FROM 5 DIGITS TO 4. EDIT0015 -000013 * CHANGE 1. EDIT0016 -000014 * MODIFY TO RUN ON TI-990. EDIT0017 -000015 * CHANGE 2. EDIT0018 -000016 * MODIFY TO RUN ON GNUCOBOL. EDIT0019 -000017 EDIT0020 -000018 ENVIRONMENT DIVISION. EDIT0021 -000019 CONFIGURATION SECTION. EDIT0022 -000020 SOURCE-COMPUTER. EDIT0023 -000021 IBM-360. EDIT0024 -000022 OBJECT-COMPUTER. EDIT0025 -000023 IBM-360. EDIT0026 -000024 INPUT-OUTPUT SECTION. EDIT0027 -000025 FILE-CONTROL. EDIT0028 -000026 SELECT OLD-VERSION ASSIGN TO "SYSUT1" EDIT0029 -000027 ORGANIZATION LINE SEQUENTIAL. EDIT0030 -000028 SELECT NEW-VERSION ASSIGN TO "SYSUT2" EDIT0031 -000029 ORGANIZATION LINE SEQUENTIAL. EDIT0032 -000030 SELECT PRT-VERSION ASSIGN TO "SYSUT2" EDIT0033 -error: missing file description for FILE PRT-VERSION -000031 ORGANIZATION LINE SEQUENTIAL. EDIT0034 -000032 SELECT MODIFICATION ASSIGN TO "SYSIN1" EDIT0035 -000033 ORGANIZATION LINE SEQUENTIAL. EDIT0036 -000034 SELECT COMMENTARY ASSIGN TO "SYSOU1" EDIT0037 -000035 ORGANIZATION LINE SEQUENTIAL. EDIT0038 -000036 EDIT0039 -000037 DATA DIVISION. EDIT0040 -000038 EDIT0041 -000039 FILE SECTION. EDIT0042 -000040 EDIT0043 -000041 FD OLD-VERSION EDIT0044 -000042 LABEL RECORDS ARE STANDARD EDIT0045 -warning: LABEL RECORDS is obsolete in GnuCOBOL -000043 BLOCK CONTAINS 80 CHARACTERS EDIT0046 -000044 DATA RECORD IS OLD-RECORD. EDIT0047 -warning: DATA RECORDS is obsolete in GnuCOBOL -000045 EDIT0048 -000046 01 OLD-RECORD. EDIT0049 -000047 02 OLD-STATEMENT PICTURE X(75). EDIT0050 -000048 02 OLD-NUMBER PICTURE X(5). EDIT0051 -000049 EDIT0052 -000050 FD NEW-VERSION EDIT0053 -000051 LABEL RECORDS ARE STANDARD EDIT0054 -warning: LABEL RECORDS is obsolete in GnuCOBOL -000052 BLOCK CONTAINS 80 CHARACTERS EDIT0055 -000053 DATA RECORD IS NEW-RECORD. EDIT0056 -warning: DATA RECORDS is obsolete in GnuCOBOL -000054 EDIT0057 -000055 01 NEW-RECORD. EDIT0058 -000056 02 NEW-STATEMENT PICTURE X(75). EDIT0059 -000057 02 NEW-NUMBER PICTURE X(5). EDIT0060 -000058 EDIT0061 -000059 FD MODIFICATION EDIT0062 -000060 LABEL RECORDS ARE OMITTED EDIT0063 -warning: LABEL RECORDS is obsolete in GnuCOBOL -000061 BLOCK CONTAINS 80 CHARACTERS EDIT0064 -000062 DATA RECORD IS UPDATE-ORDER. EDIT0065 -warning: DATA RECORDS is obsolete in GnuCOBOL -000063 EDIT0066 -000064 01 UPDATE-ORDER. EDIT0067 -000065 02 INSERTION. EDIT0068 -000066 03 COMMAND PICTURE X(6). EDIT0069 -000067 88 ENDJOB VALUE "ENDJOB". EDIT0070 -000068 88 ENDSET VALUE "ENDSET". EDIT0071 -000069 88 REMOVE VALUE "REMOVE". EDIT0072 -000070 88 ADDNEW VALUE "INSERT". EDIT0073 -000071 88 CHANGE VALUE "CHANGE". EDIT0074 -000072 88 DISPLY VALUE "DISPLY". EDIT0075 -000073 03 FILLER PICTURE X. EDIT0076 -000074 03 A-FIELD PICTURE 9(5). EDIT0077 -000075 03 A-ALPHA REDEFINES A-FIELD PICTURE X(5). EDIT0078 -000076 88 A-BLANK VALUE SPACES. EDIT0079 -000077 03 FILLER PICTURE X(4). EDIT0080 -000078 03 B-FIELD PICTURE 9(5). EDIT0081 -000079 03 B-ALPHA REDEFINES B-FIELD PICTURE X(5). EDIT0082 -000080 88 B-BLANK VALUE SPACES. EDIT0083 -000081 03 FILLER PICTURE X(54). EDIT0084 -000082 02 FILLER PICTURE X(5). EDIT0085 -000083 EDIT0086 -000084 FD COMMENTARY EDIT0087 -000085 LABEL RECORDS ARE OMITTED EDIT0088 -warning: LABEL RECORDS is obsolete in GnuCOBOL -000086 BLOCK CONTAINS 82 CHARACTERS EDIT0089 -000087 DATA RECORD IS COMMENT-LINE. EDIT0090 -warning: DATA RECORDS is obsolete in GnuCOBOL -000088 EDIT0091 -000089 01 COMMENT-LINE. EDIT0092 -000090 02 FILLER PICTURE X(82). EDIT0093 -000091 EDIT0094 -000092 WORKING-STORAGE SECTION. EDIT0095 -000093 EDIT0096 -000094 77 COMMAND-ADDITIONS PICTURE 9(3) COMPUTATIONAL VALUE 0. EDIT0097 -000095 77 COMMAND-SUBTRACTIONS PICTURE 9(3) COMPUTATIONAL VALUE 0. EDIT0098 -000096 77 TOTAL-INSERTED PICTURE 9(3) COMPUTATIONAL VALUE 0. EDIT0099 -000097 77 TOTAL-DELETED PICTURE 9(3) COMPUTATIONAL VALUE 0. EDIT0100 -000098 77 OUTPUT-COUNT PICTURE 9(5) COMPUTATIONAL VALUE 0. EDIT0101 -000099 77 LINE-COUNT PICTURE 9(2) COMPUTATIONAL VALUE 0. EDIT0102 -000100 77 FIELDA PICTURE 9(5) VALUE 0. EDIT0103 -000101 77 FIELDB PICTURE 9(5) VALUE 0. EDIT0104 -000102 77 BLANK-LINE PICTURE X(82) VALUE SPACES. EDIT0105 -000103 EDIT0106 -000104 01 DATE-FROM-SYS. EDIT0107 -000105 02 DFSYS OCCURS 3 TIMES PICTURE 99. EDIT0108 -000106 EDIT0109 -000107 01 HEADINGS-LINE. EDIT0110 -000108 02 FILLER PICTURE X(15) VALUE "EDITOR VERSION". EDIT0111 -000109 02 FILLER PICTURE X(20) VALUE "1.1 - 206/72". EDIT0112 -000110 02 PHASE PICTURE X(17) VALUE "UPDATING AS OF". EDIT0113 -000111 02 MONTH-RUN PICTURE XX. EDIT0114 -000112 02 FILLER PICTURE X VALUE "/". EDIT0115 -000113 02 DAY-RUN PICTURE XX. EDIT0116 -000114 02 FILLER PICTURE X VALUE "/". EDIT0117 -000115 02 YEAR-RUN PICTURE XX. EDIT0118 -000116 02 FILLER PICTURE X(8) VALUE SPACES. EDIT0119 -000117 02 FILLER PICTURE X(8) VALUE " PAGE: ". EDIT0120 -000118 02 PAGE-NUMBER PICTURE 9(4) VALUE 0. EDIT0121 -000119 EDIT0122 -000120 01 COMMAND-LISTING. EDIT0123 -000121 02 FILLER PICTURE X(2) VALUE SPACES. EDIT0124 -000122 02 COMMAND-IMAGE PICTURE X(80). EDIT0125 -000123 EDIT0126 -000124 01 ACTIVITIES-LISTING. EDIT0127 -000125 02 DISPOSITION PICTURE X(2). EDIT0128 -000126 02 ACTIVE-IMAGE PICTURE X(80). EDIT0129 -000127 EDIT0130 -000128 01 UPSI-BYTE. EDIT0131 -000129 02 UPSI-BIT OCCURS 8 TIMES PICTURE X. EDIT0132 -000130 EDIT0133 -000131 01 MESSAGE-LOG. EDIT0134 -000132 02 FILLER PICTURE X(2) VALUE SPACES. EDIT0135 -000133 02 MESSAGE-TEXT PICTURE X(80). EDIT0136 -000134 EDIT0137 -000135 01 DISPLAY-MESSAGE. EDIT0138 -000136 02 FILLER PICTURE X(2) VALUE SPACES. EDIT0139 -000137 02 DISPLAY-TEMP PICTURE X(6). EDIT0140 -000138 02 FILLER PICTURE X(2) VALUE SPACES. EDIT0141 -000139 02 DISPLAY-TEXT PICTURE X(60). EDIT0142 -000140 EDIT0143 -000141 77 END-JOB-PROCESS PICTURE 9 VALUE 0. EDIT0144 -000142 77 DELETE-PROCESS PICTURE 9 VALUE 1. EDIT0145 -000143 77 INSERT-PROCESS PICTURE 9 VALUE 2. EDIT0146 -000144 77 WRITE-PROCESS PICTURE 9 VALUE 3. EDIT0147 -000145 EDIT0148 -000146 01 SELECTORS. EDIT0149 -000147 02 RETURN-SELECT PICTURE 9 VALUE 0. EDIT0150 -000148 02 NEXT-JOB-SELECT PICTURE 9 VALUE 0. EDIT0151 -000149 EDIT0152 -000150 PROCEDURE DIVISION. EDIT0153 -000151 EDIT0154 -000152 START-SECTION. EDIT0155 -000153 OPEN INPUT OLD-VERSION, MODIFICATION, EDIT0156 -000154 OUTPUT NEW-VERSION, COMMENTARY. EDIT0157 -000155 MOVE "F" TO UPSI-BIT (1), UPSI-BIT (2). EDIT0158 -000156 ACCEPT DATE-FROM-SYS FROM DATE. EDIT0159 -000157 MOVE DFSYS (1) TO YEAR-RUN. EDIT0160 -000158 MOVE DFSYS (2) TO MONTH-RUN. EDIT0161 -000159 MOVE DFSYS (3) TO DAY-RUN. EDIT0162 -000160 READ OLD-VERSION AT END EDIT0163 -000161 MOVE "NO OLD VERSION FOUND" TO MESSAGE-TEXT EDIT0164 -000162 WRITE COMMENT-LINE FROM MESSAGE-LOG EDIT0165 -000163 GO TO END-JOB. EDIT0166 -000164 MOVE OLD-STATEMENT TO NEW-STATEMENT. EDIT0167 -000165 PERFORM OUTPUT-A-RECORD. EDIT0168 -000166 EDIT0169 -000167 TOP-OF-PAGE-ROUTINE. EDIT0170 -000168 ADD 1 TO PAGE-NUMBER. EDIT0171 -000169 MOVE ZERO TO LINE-COUNT. EDIT0172 -000170 WRITE COMMENT-LINE FROM HEADINGS-LINE AFTER PAGE. EDIT0173 -000171 WRITE COMMENT-LINE FROM BLANK-LINE. EDIT0174 -000172 EDIT0175 -000173 READ-A-COMMAND. EDIT0176 -000174 READ MODIFICATION AT END EDIT0177 -000175 MOVE "MODIFICATION FILE ENDED " TO MESSAGE-TEXT EDIT0178 -000176 WRITE COMMENT-LINE FROM MESSAGE-LOG EDIT0179 -000177 GO TO FINISH-JOB. EDIT0180 -000178 MOVE UPDATE-ORDER TO COMMAND-IMAGE. EDIT0181 -000179 WRITE COMMENT-LINE FROM COMMAND-LISTING. EDIT0182 -000180 ADD 2 TO LINE-COUNT. EDIT0183 -000181 IF A-BLANK MOVE ZEROES TO A-FIELD. EDIT0184 -000182 IF B-BLANK MOVE ZEROES TO B-FIELD. EDIT0185 -000183 MOVE A-FIELD TO FIELDA. EDIT0186 -000184 MOVE B-FIELD TO FIELDB. EDIT0187 -000185 EDIT0188 -000186 TEST-COMMAND-TYPE. EDIT0189 -000187 IF CHANGE GO TO CHANGE-A-RECORD. EDIT0190 -000188 IF REMOVE GO TO DELETE-A-RECORD. EDIT0191 -000189 IF DISPLY MOVE "T" TO UPSI-BIT (2) EDIT0192 -000190 GO TO FINISH-JOB. EDIT0193 -000191 IF ENDJOB GO TO FINISH-JOB. EDIT0194 -000192 IF ADDNEW GO TO INSERT-A-RECORD. EDIT0195 -000193 MOVE "INVALID COMMAND IGNORED." TO MESSAGE-TEXT. EDIT0196 -000194 WRITE COMMENT-LINE FROM MESSAGE-LOG. EDIT0197 -000195 GO TO READ-A-COMMAND. EDIT0198 -000196 EDIT0199 -000197 CHANGE-A-RECORD. EDIT0200 -000198 ALTER RETURN-TO-USER TO PROCEED TO INSERTION-PROCESS. EDIT0201 -warning: ALTER is obsolete in GnuCOBOL -000199 ALTER NEXT-JOB-STEP TO PROCEED TO DELETION-PROCESS. EDIT0202 -warning: ALTER is obsolete in GnuCOBOL -000200 EDIT0205 -000201 FIND-FIELDA. EDIT0206 -000202 IF OLD-NUMBER IS GREATER THAN FIELDA EDIT0207 -000203 MOVE "RECORD ALREADY PASSED" TO MESSAGE-TEXT EDIT0208 -000204 WRITE COMMENT-LINE FROM MESSAGE-LOG EDIT0209 -000205 GO TO READ-A-COMMAND. EDIT0210 -000206 READ OLD-VERSION AT END EDIT0211 -000207 MOVE "NOT FOUND IN OLD VERSION" TO DISPLAY-TEXT EDIT0212 -000208 MOVE FIELDA TO DISPLAY-TEMP EDIT0213 -000209 WRITE COMMENT-LINE FROM DISPLAY-MESSAGE EDIT0214 -000210 GO TO END-JOB. EDIT0215 -000211 IF OLD-NUMBER IS LESS THAN FIELDA EDIT0216 -000212 MOVE OLD-STATEMENT TO NEW-STATEMENT EDIT0217 -000213 PERFORM OUTPUT-A-RECORD EDIT0218 -000214 GO TO FIND-FIELDA. EDIT0219 -000215 EDIT0220 -000216 RETURN-TO-USER. EDIT0221 -000217 GO TO END-JOB. EDIT0223 -000218 EDIT0228 -000219 INSERT-A-RECORD. EDIT0229 -000220 ALTER RETURN-TO-USER TO PROCEED TO INSERTION-PROCESS. EDIT0230 -warning: ALTER is obsolete in GnuCOBOL -000221 ALTER NEXT-JOB-STEP TO PROCEED TO FORCED-WRITE. EDIT0231 -warning: ALTER is obsolete in GnuCOBOL -000222 GO TO FIND-FIELDA. EDIT0234 -000223 EDIT0235 -000224 INSERTION-PROCESS. EDIT0236 -000225 READ MODIFICATION AT END EDIT0237 -000226 MOVE "NO ENDSET FOUND" TO MESSAGE-TEXT EDIT0238 -000227 WRITE COMMENT-LINE FROM MESSAGE-LOG EDIT0239 -000228 GO TO END-JOB. EDIT0240 -000229 IF ENDSET EDIT0241 -000230 MOVE COMMAND-ADDITIONS TO DISPLAY-TEMP EDIT0242 -000231 MOVE "RECORDS INSERTED." TO DISPLAY-TEXT EDIT0243 -000232 WRITE COMMENT-LINE FROM DISPLAY-MESSAGE EDIT0244 -000233 ADD COMMAND-ADDITIONS TO TOTAL-INSERTED EDIT0245 -000234 MOVE ZEROES TO COMMAND-ADDITIONS EDIT0246 -000235 GO TO NEXT-JOB-STEP. EDIT0247 -000236 MOVE INSERTION TO NEW-STATEMENT, ACTIVE-IMAGE. EDIT0248 -000237 MOVE "I " TO DISPOSITION. EDIT0249 -000238 PERFORM OUTPUT-A-RECORD. EDIT0250 -000239 WRITE COMMENT-LINE FROM ACTIVITIES-LISTING. EDIT0251 -000240 ADD 1 TO COMMAND-ADDITIONS. EDIT0252 -000241 ADD 1 TO LINE-COUNT. EDIT0253 -000242 IF LINE-COUNT EQUAL 56 PERFORM TOP-OF-PAGE-ROUTINE. EDIT0254 -000243 GO TO INSERTION-PROCESS. EDIT0255 -000244 EDIT0256 -000245 NEXT-JOB-STEP. EDIT0257 -000246 GO TO END-JOB. EDIT0259 -000247 EDIT0264 -000248 FORCED-WRITE. EDIT0265 -000249 MOVE OLD-STATEMENT TO NEW-STATEMENT. EDIT0266 -000250 PERFORM OUTPUT-A-RECORD. EDIT0267 -000251 GO TO READ-A-COMMAND. EDIT0268 -000252 EDIT0269 -000253 DELETE-A-RECORD. EDIT0270 -000254 ALTER RETURN-TO-USER TO PROCEED TO DELETION-PROCESS. EDIT0271 -warning: ALTER is obsolete in GnuCOBOL -000255 GO TO FIND-FIELDA. EDIT0273 -000256 EDIT0274 -000257 DELETION-PROCESS. EDIT0275 -000258 MOVE OLD-RECORD TO ACTIVE-IMAGE. EDIT0276 -000259 MOVE "D " TO DISPOSITION. EDIT0277 -000260 WRITE COMMENT-LINE FROM ACTIVITIES-LISTING. EDIT0278 -000261 ADD 1 TO LINE-COUNT. EDIT0279 -000262 IF LINE-COUNT EQUAL 56 PERFORM TOP-OF-PAGE-ROUTINE. EDIT0280 -000263 ADD 1 TO COMMAND-SUBTRACTIONS. EDIT0281 -000264 IF OLD-NUMBER IS NOT LESS THAN FIELDB EDIT0282 -000265 MOVE COMMAND-SUBTRACTIONS TO DISPLAY-TEMP EDIT0283 -000266 MOVE "RECORDS DELETED." TO DISPLAY-TEXT EDIT0284 -000267 WRITE COMMENT-LINE FROM DISPLAY-MESSAGE EDIT0285 -000268 ADD COMMAND-SUBTRACTIONS TO TOTAL-DELETED EDIT0286 -000269 MOVE OLD-STATEMENT TO NEW-STATEMENT EDIT0287 -000270 MOVE ZEROES TO COMMAND-SUBTRACTIONS EDIT0288 -000271 GO TO READ-A-COMMAND. EDIT0289 -000272 READ OLD-VERSION AT END EDIT0290 -000273 MOVE "NOT FOUND IN OLD VERSION DOING DELETE" EDIT0291 -000274 TO DISPLAY-TEXT EDIT0292 -000275 WRITE COMMENT-LINE FROM DISPLAY-MESSAGE EDIT0293 -000276 GO TO END-JOB. EDIT0294 -000277 GO TO DELETION-PROCESS. EDIT0295 -000278 EDIT0296 -000279 OUTPUT-A-RECORD. EDIT0297 -000280 ADD 1 TO OUTPUT-COUNT. EDIT0298 -000281 MOVE OUTPUT-COUNT TO NEW-NUMBER. EDIT0299 -000282 WRITE NEW-RECORD. EDIT0300 -000283 EDIT0301 -000284 FINISH-JOB. EDIT0302 -000285 READ OLD-VERSION AT END GO TO TEST-FOR-LISTING. EDIT0303 -000286 MOVE OLD-STATEMENT TO NEW-STATEMENT. EDIT0304 -000287 GO TO OUTPUT-A-RECORD. EDIT0305 -000288 EDIT0306 -000289 TEST-FOR-LISTING. EDIT0307 -000290 PERFORM TOP-OF-PAGE-ROUTINE. EDIT0308 -000291 MOVE OLD-NUMBER TO DISPLAY-TEMP. EDIT0309 -000292 MOVE "RECORDS READ." TO DISPLAY-TEXT. EDIT0310 -000293 WRITE COMMENT-LINE FROM DISPLAY-MESSAGE. EDIT0311 -000294 MOVE TOTAL-INSERTED TO DISPLAY-TEMP. EDIT0312 -000295 MOVE "RECORDS ADDED." TO DISPLAY-TEXT. EDIT0313 -000296 WRITE COMMENT-LINE FROM DISPLAY-MESSAGE. EDIT0314 -000297 MOVE TOTAL-DELETED TO DISPLAY-TEMP. EDIT0315 -000298 MOVE "RECORDS DROPPED." TO DISPLAY-TEXT. EDIT0316 -000299 WRITE COMMENT-LINE FROM DISPLAY-MESSAGE. EDIT0317 -000300 MOVE OUTPUT-COUNT TO DISPLAY-TEMP. EDIT0318 -000301 MOVE "RECORDS IN NEW FILE." TO DISPLAY-TEXT. EDIT0319 -000302 WRITE COMMENT-LINE FROM DISPLAY-MESSAGE. EDIT0320 -000303 IF UPSI-BIT (2) EQUAL "F" GO TO END-JOB. EDIT0321 -000304 CLOSE NEW-VERSION. EDIT0322 -000305 OPEN INPUT NEW-VERSION. EDIT0323 -000306 MOVE "UPDATED LISTING" TO PHASE. EDIT0324 -000307 MOVE ZEROES TO PAGE-NUMBER. EDIT0325 -000308 PERFORM TOP-OF-PAGE-ROUTINE. EDIT0326 -000309 MOVE SPACES TO DISPOSITION. EDIT0327 -000310 EDIT0328 -000311 LISTING-LOOP. EDIT0329 -000312 READ NEW-VERSION AT END GO TO END-JOB. EDIT0330 -000313 MOVE NEW-RECORD TO ACTIVE-IMAGE. EDIT0331 -000314 WRITE COMMENT-LINE FROM ACTIVITIES-LISTING. EDIT0332 -000315 ADD 1 TO LINE-COUNT. EDIT0333 -000316 IF LINE-COUNT EQUAL 56 PERFORM TOP-OF-PAGE-ROUTINE. EDIT0334 -000317 GO TO LISTING-LOOP. EDIT0335 -000318 EDIT0336 -000319 END-JOB. EDIT0337 -000320 MOVE "PROGRAM TERMINATION" TO MESSAGE-TEXT. EDIT0338 -000321 WRITE COMMENT-LINE FROM MESSAGE-LOG. EDIT0339 -000322 CLOSE OLD-VERSION, NEW-VERSION, MODIFICATION, COMMENTARY. EDIT0340 -000323 STOP RUN. EDIT0341 -000324 EDIT0342 -000325 END PROGRAM EDITOR. EDIT0343 - -SIZE TYPE LVL NAME PICTURE - -00080 FILE OLD-VERSION -00080 GROUP 01 OLD-RECORD -00075 ALPHANUMERIC 02 OLD-STATEMENT X(75) -00005 ALPHANUMERIC 02 OLD-NUMBER X(5) - -00080 FILE NEW-VERSION -00080 GROUP 01 NEW-RECORD -00075 ALPHANUMERIC 02 NEW-STATEMENT X(75) -00005 ALPHANUMERIC 02 NEW-NUMBER X(5) - -00032 FILE PRT-VERSION - -00080 FILE MODIFICATION -00080 GROUP 01 UPDATE-ORDER -00075 GROUP 02 INSERTION -00006 ALPHANUMERIC 03 COMMAND X(6) - CONDITIONAL 88 ENDJOB - CONDITIONAL 88 ENDSET - CONDITIONAL 88 REMOVE - CONDITIONAL 88 ADDNEW - CONDITIONAL 88 CHANGE - CONDITIONAL 88 DISPLY -00001 ALPHANUMERIC 03 FILLER X -00005 NUMERIC 03 A-FIELD 9(5) -00005 ALPHANUMERIC 03 A-ALPHA X(5), REDEFINES A-FIELD - CONDITIONAL 88 A-BLANK -00004 ALPHANUMERIC 03 FILLER X(4) -00005 NUMERIC 03 B-FIELD 9(5) -00005 ALPHANUMERIC 03 B-ALPHA X(5), REDEFINES B-FIELD - CONDITIONAL 88 B-BLANK -00054 ALPHANUMERIC 03 FILLER X(54) -00005 ALPHANUMERIC 02 FILLER X(5) - -00082 FILE COMMENTARY -00082 GROUP 01 COMMENT-LINE -00082 ALPHANUMERIC 02 FILLER X(82) - - WORKING-STORAGE SECTION - -00002 NUMERIC 77 COMMAND-ADDITIONS 9(3) COMP -00002 NUMERIC 77 COMMAND-SUBTRACTIONS 9(3) COMP -00002 NUMERIC 77 TOTAL-INSERTED 9(3) COMP -00002 NUMERIC 77 TOTAL-DELETED 9(3) COMP -00004 NUMERIC 77 OUTPUT-COUNT 9(5) COMP -00001 NUMERIC 77 LINE-COUNT 9(2) COMP -00005 NUMERIC 77 FIELDA 9(5) -00005 NUMERIC 77 FIELDB 9(5) -00082 ALPHANUMERIC 77 BLANK-LINE X(82) - -00006 GROUP 01 DATE-FROM-SYS -00002 NUMERIC 02 DFSYS 99, OCCURS 3 - -00080 GROUP 01 HEADINGS-LINE -00015 ALPHANUMERIC 02 FILLER X(15) -00020 ALPHANUMERIC 02 FILLER X(20) -00017 ALPHANUMERIC 02 PHASE X(17) -00002 ALPHANUMERIC 02 MONTH-RUN XX -00001 ALPHANUMERIC 02 FILLER X -00002 ALPHANUMERIC 02 DAY-RUN XX -00001 ALPHANUMERIC 02 FILLER X -00002 ALPHANUMERIC 02 YEAR-RUN XX -00008 ALPHANUMERIC 02 FILLER X(8) -00008 ALPHANUMERIC 02 FILLER X(8) -00004 NUMERIC 02 PAGE-NUMBER 9(4) - -00082 GROUP 01 COMMAND-LISTING -00002 ALPHANUMERIC 02 FILLER X(2) -00080 ALPHANUMERIC 02 COMMAND-IMAGE X(80) - -00082 GROUP 01 ACTIVITIES-LISTING -00002 ALPHANUMERIC 02 DISPOSITION X(2) -00080 ALPHANUMERIC 02 ACTIVE-IMAGE X(80) - -00008 GROUP 01 UPSI-BYTE -00001 ALPHANUMERIC 02 UPSI-BIT X, OCCURS 8 - -00082 GROUP 01 MESSAGE-LOG -00002 ALPHANUMERIC 02 FILLER X(2) -00080 ALPHANUMERIC 02 MESSAGE-TEXT X(80) - -00070 GROUP 01 DISPLAY-MESSAGE -00002 ALPHANUMERIC 02 FILLER X(2) -00006 ALPHANUMERIC 02 DISPLAY-TEMP X(6) -00002 ALPHANUMERIC 02 FILLER X(2) -00060 ALPHANUMERIC 02 DISPLAY-TEXT X(60) - -00001 NUMERIC 77 END-JOB-PROCESS 9 -00001 NUMERIC 77 DELETE-PROCESS 9 -00001 NUMERIC 77 INSERT-PROCESS 9 -00001 NUMERIC 77 WRITE-PROCESS 9 - -00002 GROUP 01 SELECTORS -00001 NUMERIC 02 RETURN-SELECT 9 -00001 NUMERIC 02 NEXT-JOB-SELECT 9 - - -NAME DEFINED REFERENCES - -OLD-VERSION 26 41 153 160 206 272 285 322 -OLD-RECORD 46 44 258 -OLD-STATEMENT 47 164 212 249 269 286 -OLD-NUMBER 48 202 211 264 291 - -NEW-VERSION 28 50 *154 *282 304 305 312 322 -NEW-RECORD 55 53 282 313 -NEW-STATEMENT 56 *164 *212 *236 *249 *269 *286 -NEW-NUMBER 57 *281 - -PRT-VERSION 30 not referenced - -MODIFICATION 32 59 153 174 225 322 -UPDATE-ORDER 64 62 178 -INSERTION 65 236 -COMMAND 66 referenced by parent/child -ENDJOB 67 191 -ENDSET 68 229 -REMOVE 69 188 -ADDNEW 70 192 -CHANGE 71 187 -DISPLY 72 189 -A-FIELD 74 *181 183 -A-ALPHA 75 referenced by parent/child -A-BLANK 76 181 -B-FIELD 78 *182 184 -B-ALPHA 79 referenced by parent/child -B-BLANK 80 182 - -COMMENTARY 34 84 *154 *162 *170 *171 *176 *179 *194 *204 *209 - *227 *232 *239 *260 *267 *275 *293 *296 *299 *302 - *314 *321 322 -COMMENT-LINE 89 87 *162 *170 *171 *176 *179 *194 *204 *209 *227 - *232 *239 *260 *267 *275 *293 *296 *299 *302 *314 - *321 - -COMMAND-ADDITIONS 94 230 233 *234 240 -COMMAND-SUBTRACTIONS 95 263 265 268 *270 -TOTAL-INSERTED 96 233 294 -TOTAL-DELETED 97 268 297 -OUTPUT-COUNT 98 280 281 300 -LINE-COUNT 99 *169 180 241 242 261 262 315 316 -FIELDA 100 *183 202 208 211 -FIELDB 101 *184 264 -BLANK-LINE 102 171 -DATE-FROM-SYS 104 *156 -DFSYS 105 157 158 159 -HEADINGS-LINE 107 170 -PHASE 110 *306 -MONTH-RUN 111 *158 -DAY-RUN 113 *159 -YEAR-RUN 115 *157 -PAGE-NUMBER 118 168 *307 -COMMAND-LISTING 120 179 -COMMAND-IMAGE 122 *178 -ACTIVITIES-LISTING 124 239 260 314 -DISPOSITION 125 *237 *259 *309 -ACTIVE-IMAGE 126 *236 *258 *313 -UPSI-BYTE 128 referenced by child -UPSI-BIT 129 *155 *189 303 -MESSAGE-LOG 131 162 176 194 204 227 321 -MESSAGE-TEXT 133 *161 *175 *193 *203 *226 *320 -DISPLAY-MESSAGE 135 209 232 267 275 293 296 299 302 -DISPLAY-TEMP 137 *208 *230 *265 *291 *294 *297 *300 -DISPLAY-TEXT 139 *207 *231 *266 *274 *292 *295 *298 *301 -END-JOB-PROCESS 141 not referenced -DELETE-PROCESS 142 not referenced -INSERT-PROCESS 143 not referenced -WRITE-PROCESS 144 not referenced -SELECTORS 146 not referenced -RETURN-SELECT 147 not referenced -NEXT-JOB-SELECT 148 not referenced - - -LABEL DEFINED REFERENCES - -E EDITOR 150 -P START-SECTION 152 not referenced -P TOP-OF-PAGE-ROUTINE 167 242 262 290 308 316 -P READ-A-COMMAND 173 195 205 251 271 -P TEST-COMMAND-TYPE 186 not referenced -P CHANGE-A-RECORD 197 187 -P FIND-FIELDA 201 214 222 255 -P RETURN-TO-USER 216 198 220 254 -P INSERT-A-RECORD 219 192 -P INSERTION-PROCESS 224 198 220 243 -P NEXT-JOB-STEP 245 199 221 235 -P FORCED-WRITE 248 221 -P DELETE-A-RECORD 253 188 -P DELETION-PROCESS 257 199 254 277 -P OUTPUT-A-RECORD 279 165 213 238 250 287 -P FINISH-JOB 284 177 190 191 -P TEST-FOR-LISTING 289 285 -P LISTING-LOOP 311 317 -P END-JOB 319 163 210 217 228 246 276 303 312 - - -Error/Warning summary: - -EDITOR.cob:42: warning: LABEL RECORDS is obsolete in GnuCOBOL -EDITOR.cob:44: warning: DATA RECORDS is obsolete in GnuCOBOL -EDITOR.cob:51: warning: LABEL RECORDS is obsolete in GnuCOBOL -EDITOR.cob:53: warning: DATA RECORDS is obsolete in GnuCOBOL -EDITOR.cob:60: warning: LABEL RECORDS is obsolete in GnuCOBOL -EDITOR.cob:62: warning: DATA RECORDS is obsolete in GnuCOBOL -EDITOR.cob:85: warning: LABEL RECORDS is obsolete in GnuCOBOL -EDITOR.cob:87: warning: DATA RECORDS is obsolete in GnuCOBOL -EDITOR.cob:30: error: missing file description for FILE PRT-VERSION -EDITOR.cob:198: warning: ALTER is obsolete in GnuCOBOL -EDITOR.cob:199: warning: ALTER is obsolete in GnuCOBOL -EDITOR.cob:220: warning: ALTER is obsolete in GnuCOBOL -EDITOR.cob:221: warning: ALTER is obsolete in GnuCOBOL -EDITOR.cob:254: warning: ALTER is obsolete in GnuCOBOL - -13 warnings in compilation group -1 error in compilation group -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/listings.at:5465: gcdiff -IGnuCOBOL prog19.lst prog.lst" -at_fn_check_prepare_trace "listings.at:5465" -( $at_check_trace; gcdiff -IGnuCOBOL prog19.lst prog.lst -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/listings.at:5465" -$at_failed && at_fn_log_failure \ -"prog.lst" -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_416 -#AT_START_417 -at_fn_group_banner 417 'listings.at:5470' \ - "Report Writer" " " 3 -at_xfail=no -( - $as_echo "417. $at_setup_line: testing $at_desc ..." - $at_traceon - - - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - - * ************************************************************* * - * REPORT WRITER EXAMPLE #1. * - * ************************************************************* * - - ENVIRONMENT DIVISION. - CONFIGURATION SECTION. - - INPUT-OUTPUT SECTION. - FILE-CONTROL. - - SELECT TRANSACTION-DATA - ASSIGN TO EXTERNAL DATAIN - ORGANIZATION IS LINE SEQUENTIAL. - - SELECT REPORT-FILE - ASSIGN TO EXTERNAL LINE ADVANCING SYSPRINT. - - DATA DIVISION. - FILE SECTION. - - FD TRANSACTION-DATA. - - 01 TRANSACTION-RECORD. - 03 TR-CUSTOMER-NUMBER PIC 9(04). - 03 FILLER PIC X(01). - 03 TR-CUSTOMER-NAME PIC X(16). - 03 FILLER PIC X(01). - 03 TR-ITEM-NUMBER PIC 9(05). - 03 FILLER REDEFINES TR-ITEM-NUMBER. - 05 TR-ITEM-DEPARTMENT PIC 9(01). - 05 FILLER PIC 9(04). - 03 FILLER PIC X(01). - 03 TR-ITEM-COST PIC 9(03)V99. - 03 FILLER PIC X(47). - - FD REPORT-FILE - REPORT IS CUSTOMER-REPORT. - - WORKING-STORAGE SECTION. - 77 END-OF-FILE-SWITCH PIC X(1) VALUE 'N'. - 88 END-OF-FILE VALUE 'Y'. - - REPORT SECTION. - RD CUSTOMER-REPORT - PAGE LIMIT IS 66 LINES - HEADING 1 - FIRST DETAIL 5 - LAST DETAIL 58. - - 01 PAGE-HEAD-GROUP TYPE PAGE HEADING. - 02 LINE 1. - 03 COLUMN 27 PIC X(41) VALUE - 'C U S T O M E R C H A R G E R E P O R T'. - 02 LINE PLUS 2. - 03 COLUMN 01 PIC X(09) VALUE 'CUST. NO.'. - 03 COLUMN 15 PIC X(10) VALUE 'CUST. NAME'. - 03 COLUMN 30 PIC X(05) VALUE 'DEPT.'. - 03 COLUMN 39 PIC X(08) VALUE 'ITEM NO.'. - 03 COLUMN 51 PIC X(09) VALUE 'ITEM COST'. - - 01 CHARGE-DETAIL TYPE DETAIL. - 02 LINE PLUS 1. - 03 COLUMN 03 PIC Z(04) SOURCE TR-CUSTOMER-NUMBER. - 03 COLUMN 10 PIC X(16) SOURCE TR-CUSTOMER-NAME. - 03 COLUMN 32 PIC 9(01) SOURCE TR-ITEM-DEPARTMENT. - 03 COLUMN 40 PIC 9(05) SOURCE TR-ITEM-NUMBER. - 03 COLUMN 51 PIC $$$$.99 SOURCE TR-ITEM-COST. - - PROCEDURE DIVISION. - - 000-INITIATE. - - OPEN INPUT TRANSACTION-DATA, - OUTPUT REPORT-FILE. - - INITIATE CUSTOMER-REPORT. - - READ TRANSACTION-DATA - AT END - MOVE 'Y' TO END-OF-FILE-SWITCH. - * END-READ. - - PERFORM 100-PROCESS-TRANSACTION-DATA THRU 199-EXIT - UNTIL END-OF-FILE. - - 000-TERMINATE. - TERMINATE CUSTOMER-REPORT. - - CLOSE TRANSACTION-DATA, - REPORT-FILE. - - STOP RUN. - - 100-PROCESS-TRANSACTION-DATA. - GENERATE CHARGE-DETAIL. - READ TRANSACTION-DATA - AT END - MOVE 'Y' TO END-OF-FILE-SWITCH. - * END-READ. - - 199-EXIT. - EXIT. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/listings.at:5583: \$COMPILE_ONLY -t prog.lst -tsymbols -Xref -tlines=0 prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY -t prog.lst -tsymbols -Xref -tlines=0 prog.cob" "listings.at:5583" -( $at_check_trace; $COMPILE_ONLY -t prog.lst -tsymbols -Xref -tlines=0 prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/listings.at:5583" -$at_failed && at_fn_log_failure \ -"prog.lst" -$at_traceon; } - - -cat >prog1.lst <<'_ATEOF' -GnuCOBOL V.R.P prog.cob DDD MMM dd HH:MM:SS YYYY - -LINE PG/LN A...B............................................................ - -000001 -000002 IDENTIFICATION DIVISION. -000003 PROGRAM-ID. prog. -000004 -000005 * ************************************************************* * -000006 * REPORT WRITER EXAMPLE #1. * -000007 * ************************************************************* * -000008 -000009 ENVIRONMENT DIVISION. -000010 CONFIGURATION SECTION. -000011 -000012 INPUT-OUTPUT SECTION. -000013 FILE-CONTROL. -000014 -000015 SELECT TRANSACTION-DATA -000016 ASSIGN TO EXTERNAL DATAIN -000017 ORGANIZATION IS LINE SEQUENTIAL. -000018 -000019 SELECT REPORT-FILE -000020 ASSIGN TO EXTERNAL LINE ADVANCING SYSPRINT. -000021 -000022 DATA DIVISION. -000023 FILE SECTION. -000024 -000025 FD TRANSACTION-DATA. -000026 -000027 01 TRANSACTION-RECORD. -000028 03 TR-CUSTOMER-NUMBER PIC 9(04). -000029 03 FILLER PIC X(01). -000030 03 TR-CUSTOMER-NAME PIC X(16). -000031 03 FILLER PIC X(01). -000032 03 TR-ITEM-NUMBER PIC 9(05). -000033 03 FILLER REDEFINES TR-ITEM-NUMBER. -000034 05 TR-ITEM-DEPARTMENT PIC 9(01). -000035 05 FILLER PIC 9(04). -000036 03 FILLER PIC X(01). -000037 03 TR-ITEM-COST PIC 9(03)V99. -000038 03 FILLER PIC X(47). -000039 -000040 FD REPORT-FILE -000041 REPORT IS CUSTOMER-REPORT. -000042 -000043 WORKING-STORAGE SECTION. -000044 77 END-OF-FILE-SWITCH PIC X(1) VALUE 'N'. -000045 88 END-OF-FILE VALUE 'Y'. -000046 -000047 REPORT SECTION. -000048 RD CUSTOMER-REPORT -000049 PAGE LIMIT IS 66 LINES -000050 HEADING 1 -000051 FIRST DETAIL 5 -000052 LAST DETAIL 58. -000053 -000054 01 PAGE-HEAD-GROUP TYPE PAGE HEADING. -000055 02 LINE 1. -000056 03 COLUMN 27 PIC X(41) VALUE -000057 'C U S T O M E R C H A R G E R E P O R T'. -000058 02 LINE PLUS 2. -000059 03 COLUMN 01 PIC X(09) VALUE 'CUST. NO.'. -000060 03 COLUMN 15 PIC X(10) VALUE 'CUST. NAME'. -000061 03 COLUMN 30 PIC X(05) VALUE 'DEPT.'. -000062 03 COLUMN 39 PIC X(08) VALUE 'ITEM NO.'. -000063 03 COLUMN 51 PIC X(09) VALUE 'ITEM COST'. -000064 -000065 01 CHARGE-DETAIL TYPE DETAIL. -000066 02 LINE PLUS 1. -000067 03 COLUMN 03 PIC Z(04) SOURCE TR-CUSTOMER-NUMBER. -000068 03 COLUMN 10 PIC X(16) SOURCE TR-CUSTOMER-NAME. -000069 03 COLUMN 32 PIC 9(01) SOURCE TR-ITEM-DEPARTMENT. -000070 03 COLUMN 40 PIC 9(05) SOURCE TR-ITEM-NUMBER. -000071 03 COLUMN 51 PIC $$$$.99 SOURCE TR-ITEM-COST. -000072 -000073 PROCEDURE DIVISION. -000074 -000075 000-INITIATE. -000076 -000077 OPEN INPUT TRANSACTION-DATA, -000078 OUTPUT REPORT-FILE. -000079 -000080 INITIATE CUSTOMER-REPORT. -000081 -000082 READ TRANSACTION-DATA -000083 AT END -000084 MOVE 'Y' TO END-OF-FILE-SWITCH. -000085 * END-READ. -000086 -000087 PERFORM 100-PROCESS-TRANSACTION-DATA THRU 199-EXIT -000088 UNTIL END-OF-FILE. -000089 -000090 000-TERMINATE. -000091 TERMINATE CUSTOMER-REPORT. -000092 -000093 CLOSE TRANSACTION-DATA, -000094 REPORT-FILE. -000095 -000096 STOP RUN. -000097 -000098 100-PROCESS-TRANSACTION-DATA. -000099 GENERATE CHARGE-DETAIL. -000100 READ TRANSACTION-DATA -000101 AT END -000102 MOVE 'Y' TO END-OF-FILE-SWITCH. -000103 * END-READ. -000104 -000105 199-EXIT. -000106 EXIT. - -SIZE TYPE LVL NAME PICTURE - -00080 FILE TRANSACTION-DATA -00080 GROUP 01 TRANSACTION-RECORD -00004 ALPHANUMERIC 03 TR-CUSTOMER-NUMBER 9(04) -00001 ALPHANUMERIC 03 FILLER X(01) -00016 ALPHANUMERIC 03 TR-CUSTOMER-NAME X(16) -00001 ALPHANUMERIC 03 FILLER X(01) -00005 ALPHANUMERIC 03 TR-ITEM-NUMBER 9(05) -00005 GROUP 03 FILLER, REDEFINES TR-ITEM-NUMBER -00001 ALPHANUMERIC 05 TR-ITEM-DEPARTMENT 9(01) -00004 ALPHANUMERIC 05 FILLER 9(04) -00001 ALPHANUMERIC 03 FILLER X(01) -00005 ALPHANUMERIC 03 TR-ITEM-COST 9(03)V99 -00047 ALPHANUMERIC 03 FILLER X(47) - -00126 FILE REPORT-FILE - - WORKING-STORAGE SECTION - -00001 ALPHANUMERIC 77 END-OF-FILE-SWITCH X(1) - CONDITIONAL 88 END-OF-FILE - - REPORT SECTION - -00126 GROUP 01 PAGE-HEAD-GROUP -00067 GROUP 02 FILLER -00041 ALPHANUMERIC 03 FILLER X(41) -00059 GROUP 02 FILLER -00009 ALPHANUMERIC 03 FILLER X(09) -00010 ALPHANUMERIC 03 FILLER X(10) -00005 ALPHANUMERIC 03 FILLER X(05) -00008 ALPHANUMERIC 03 FILLER X(08) -00009 ALPHANUMERIC 03 FILLER X(09) - -00126 GROUP 01 CHARGE-DETAIL -00057 GROUP 02 FILLER -00004 ALPHANUMERIC 03 FILLER Z(04) -00016 ALPHANUMERIC 03 FILLER X(16) -00001 ALPHANUMERIC 03 FILLER 9(01) -00005 ALPHANUMERIC 03 FILLER 9(05) -00007 ALPHANUMERIC 03 FILLER $$$$.99 - - -NAME DEFINED REFERENCES - -TRANSACTION-DATA 15 25 77 82 93 100 -TRANSACTION-RECORD 27 referenced by child -TR-CUSTOMER-NUMBER 28 67 -TR-CUSTOMER-NAME 30 68 -TR-ITEM-NUMBER 32 70 -TR-ITEM-DEPARTMENT 34 69 -TR-ITEM-COST 37 71 - -REPORT-FILE 19 40 *78 94 - -END-OF-FILE-SWITCH 44 *84 *102 -END-OF-FILE 45 88 - -PAGE-HEAD-GROUP 54 not referenced -CHARGE-DETAIL 65 99 - - -LABEL DEFINED REFERENCES - -E prog 73 -P 000-INITIATE 75 not referenced -P 000-TERMINATE 90 not referenced -P 100-PROCESS-TRANSACTION-DATA 98 87 -P 199-EXIT 105 87 - -0 warnings in compilation group -0 errors in compilation group -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/listings.at:5772: gcdiff -IGnuCOBOL prog1.lst prog.lst" -at_fn_check_prepare_trace "listings.at:5772" -( $at_check_trace; gcdiff -IGnuCOBOL prog1.lst prog.lst -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/listings.at:5772" -$at_failed && at_fn_log_failure \ -"prog.lst" -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_417 -#AT_START_418 -at_fn_group_banner 418 'listings.at:5777' \ - "huge REPLACE" " " 3 -at_xfail=no -( - $as_echo "418. $at_setup_line: testing $at_desc ..." - $at_traceon - - - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - CONFIGURATION SECTION. - DATA DIVISION. - WORKING-STORAGE SECTION. - PROCEDURE DIVISION. - - REPLACE ==111111111111111111111111111111111111111== - BY ==' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' '==. - - - DISPLAY 111111111111111111111111111111111111111 - DISPLAY 111111111111111111111111111111111111111 - DISPLAY 111111111111111111111111111111111111111 - - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/listings.at:5904: \$COMPILE_ONLY -t prog.lst -tlines=0 prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY -t prog.lst -tlines=0 prog.cob" "listings.at:5904" -( $at_check_trace; $COMPILE_ONLY -t prog.lst -tlines=0 prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/listings.at:5904" -$at_failed && at_fn_log_failure \ -"prog.lst" -$at_traceon; } - - -cat >prog1.lst <<'_ATEOF' -GnuCOBOL V.R.P prog.cob DDD MMM dd HH:MM:SS YYYY - -LINE PG/LN A...B............................................................ - -000001 -000002 IDENTIFICATION DIVISION. -000003 PROGRAM-ID. prog. -000004 ENVIRONMENT DIVISION. -000005 CONFIGURATION SECTION. -000006 DATA DIVISION. -000007 WORKING-STORAGE SECTION. -000008 PROCEDURE DIVISION. -000009 -000010 REPLACE ==111111111111111111111111111111111111111== -000011 BY ==' -000012 - ' -000013 - ' -000014 - ' -000015 - ' -000016 - ' -000017 - ' -000018 - ' -000019 - ' -000020 - ' -000021 - ' -000022 - ' -000023 - ' -000024 - ' -000025 - ' -000026 - ' -000027 - ' -000028 - ' -000029 - ' -000030 - ' -000031 - ' -000032 - ' -000033 - ' -000034 - ' -000035 - ' -000036 - ' -000037 - ' -000038 - ' -000039 - ' -000040 - ' -000041 - ' -000042 - ' -000043 - ' -000044 - ' -000045 - ' -000046 - ' -000047 - ' -000048 - ' -000049 - ' -000050 - ' -000051 - ' -000052 - ' -000053 - ' -000054 - ' -000055 - ' -000056 - ' -000057 - ' -000058 - ' -000059 - ' -000060 - ' -000061 - ' -000062 - ' -000063 - ' -000064 - ' -000065 - ' -000066 - ' -000067 - ' -000068 - ' -000069 - ' -000070 - ' -000071 - ' -000072 - ' -000073 - ' -000074 - ' -000075 - ' -000076 - ' -000077 - ' -000078 - ' -000079 - ' -000080 - ' -000081 - ' -000082 - ' -000083 - ' -000084 - ' -000085 - ' -000086 - ' -000087 - ' -000088 - ' -000089 - ' -000090 - ' -000091 - ' -000092 - ' -000093 - ' -000094 - ' -000095 - ' -000096 - ' -000097 - ' -000098 - ' -000099 - ' -000100 - ' -000101 - ' -000102 - ' -000103 - ' -000104 - ' -000105 - ' -000106 - ' -000107 - ' -000108 - ' -000109 - ' -000110 - ' -000111 - ' -000112 - ' -000113 - ' '==. -000114 -000115 -000116 DISPLAY ' -000116+ - -000116+ - -000116+ - -000116+ - -000116+ - -000116+ - -000116+ - -000116+ - -000116+ - -000116+ - -000116+ - -000116+ - -000116+ - -000116+ - -000116+ - -000116+ - -000116+ - -000116+ - -000116+ - -000116+ - -000116+ - -000116+ - -000116+ - -000116+ - -000116+ - -000116+ - -000116+ - -000116+ - -000116+ - -000116+ - -000116+ - -000116+ - -000116+ - -000116+ - -000116+ - -000116+ - -000116+ - -000116+ - -000116+ - -000116+ - -000116+ - -000116+ - -000116+ - -000116+ - -000116+ - -000116+ - -000116+ - -000116+ - -000116+ - -000116+ - -000116+ - -000116+ - -000116+ - -000116+ - -000116+ - -000116+ - -000116+ - -000116+ - -000116+ - -000116+ - -000116+ - -000116+ - -000116+ - -000116+ - -000116+ - -000116+ - -000116+ - -000116+ - -000116+ - -000116+ - -000116+ - -000116+ - -000116+ - -000116+ - -000116+ - -000116+ - -000116+ - -000116+ - -000116+ - -000116+ - -000116+ - -000116+ - -000116+ - -000116+ - -000116+ - -000116+ - -000116+ - -000116+ - -000116+ - -000116+ - -000116+ - -000116+ - -000116+ - -000116+ - -000116+ - -000116+ - -000116+ - -000116+ - -000116+ - -000116+ - ' -000117 DISPLAY ' -000117+ - -000117+ - -000117+ - -000117+ - -000117+ - -000117+ - -000117+ - -000117+ - -000117+ - -000117+ - -000117+ - -000117+ - -000117+ - -000117+ - -000117+ - -000117+ - -000117+ - -000117+ - -000117+ - -000117+ - -000117+ - -000117+ - -000117+ - -000117+ - -000117+ - -000117+ - -000117+ - -000117+ - -000117+ - -000117+ - -000117+ - -000117+ - -000117+ - -000117+ - -000117+ - -000117+ - -000117+ - -000117+ - -000117+ - -000117+ - -000117+ - -000117+ - -000117+ - -000117+ - -000117+ - -000117+ - -000117+ - -000117+ - -000117+ - -000117+ - -000117+ - -000117+ - -000117+ - -000117+ - -000117+ - -000117+ - -000117+ - -000117+ - -000117+ - -000117+ - -000117+ - -000117+ - -000117+ - -000117+ - -000117+ - -000117+ - -000117+ - -000117+ - -000117+ - -000117+ - -000117+ - -000117+ - -000117+ - -000117+ - -000117+ - -000117+ - -000117+ - -000117+ - -000117+ - -000117+ - -000117+ - -000117+ - -000117+ - -000117+ - -000117+ - -000117+ - -000117+ - -000117+ - -000117+ - -000117+ - -000117+ - -000117+ - -000117+ - -000117+ - -000117+ - -000117+ - -000117+ - -000117+ - -000117+ - -000117+ - ' -000118 DISPLAY ' -000118+ - -000118+ - -000118+ - -000118+ - -000118+ - -000118+ - -000118+ - -000118+ - -000118+ - -000118+ - -000118+ - -000118+ - -000118+ - -000118+ - -000118+ - -000118+ - -000118+ - -000118+ - -000118+ - -000118+ - -000118+ - -000118+ - -000118+ - -000118+ - -000118+ - -000118+ - -000118+ - -000118+ - -000118+ - -000118+ - -000118+ - -000118+ - -000118+ - -000118+ - -000118+ - -000118+ - -000118+ - -000118+ - -000118+ - -000118+ - -000118+ - -000118+ - -000118+ - -000118+ - -000118+ - -000118+ - -000118+ - -000118+ - -000118+ - -000118+ - -000118+ - -000118+ - -000118+ - -000118+ - -000118+ - -000118+ - -000118+ - -000118+ - -000118+ - -000118+ - -000118+ - -000118+ - -000118+ - -000118+ - -000118+ - -000118+ - -000118+ - -000118+ - -000118+ - -000118+ - -000118+ - -000118+ - -000118+ - -000118+ - -000118+ - -000118+ - -000118+ - -000118+ - -000118+ - -000118+ - -000118+ - -000118+ - -000118+ - -000118+ - -000118+ - -000118+ - -000118+ - -000118+ - -000118+ - -000118+ - -000118+ - -000118+ - -000118+ - -000118+ - -000118+ - -000118+ - -000118+ - -000118+ - -000118+ - -000118+ - ' -000119 -000120 STOP RUN. - - -0 warnings in compilation group -0 errors in compilation group -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/listings.at:6337: gcdiff -IGnuCOBOL prog1.lst prog.lst" -at_fn_check_prepare_trace "listings.at:6337" -( $at_check_trace; gcdiff -IGnuCOBOL prog1.lst prog.lst -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/listings.at:6337" -$at_failed && at_fn_log_failure \ -"prog.lst" -$at_traceon; } - - -cat >display.inc <<'_ATEOF' - - DISPLAY 111111111111111111111111111111111111111 -_ATEOF - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - CONFIGURATION SECTION. - DATA DIVISION. - WORKING-STORAGE SECTION. - PROCEDURE DIVISION. - - COPY "display.inc" - REPLACING ==111111111111111111111111111111111111111== - BY ==' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' '==. - - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/listings.at:6461: \$COMPILE_ONLY -t prog.lst -tlines=0 prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY -t prog.lst -tlines=0 prog.cob" "listings.at:6461" -( $at_check_trace; $COMPILE_ONLY -t prog.lst -tlines=0 prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/listings.at:6461" -$at_failed && at_fn_log_failure \ -"prog.lst" -$at_traceon; } - - -cat >prog2.lst <<'_ATEOF' -GnuCOBOL V.R.P prog.cob DDD MMM dd HH:MM:SS YYYY - -LINE PG/LN A...B............................................................ - -000001 -000002 IDENTIFICATION DIVISION. -000003 PROGRAM-ID. prog. -000004 ENVIRONMENT DIVISION. -000005 CONFIGURATION SECTION. -000006 DATA DIVISION. -000007 WORKING-STORAGE SECTION. -000008 PROCEDURE DIVISION. -000009 -000010 COPY "display.inc" -000011 REPLACING ==111111111111111111111111111111111111111== -000012 BY ==' -000013 - ' -000014 - ' -000015 - ' -000016 - ' -000017 - ' -000018 - ' -000019 - ' -000020 - ' -000021 - ' -000022 - ' -000023 - ' -000024 - ' -000025 - ' -000026 - ' -000027 - ' -000028 - ' -000029 - ' -000030 - ' -000031 - ' -000032 - ' -000033 - ' -000034 - ' -000035 - ' -000036 - ' -000037 - ' -000038 - ' -000039 - ' -000040 - ' -000041 - ' -000042 - ' -000043 - ' -000044 - ' -000045 - ' -000046 - ' -000047 - ' -000048 - ' -000049 - ' -000050 - ' -000051 - ' -000052 - ' -000053 - ' -000054 - ' -000055 - ' -000056 - ' -000057 - ' -000058 - ' -000059 - ' -000060 - ' -000061 - ' -000062 - ' -000063 - ' -000064 - ' -000065 - ' -000066 - ' -000067 - ' -000068 - ' -000069 - ' -000070 - ' -000071 - ' -000072 - ' -000073 - ' -000074 - ' -000075 - ' -000076 - ' -000077 - ' -000078 - ' -000079 - ' -000080 - ' -000081 - ' -000082 - ' -000083 - ' -000084 - ' -000085 - ' -000086 - ' -000087 - ' -000088 - ' -000089 - ' -000090 - ' -000091 - ' -000092 - ' -000093 - ' -000094 - ' -000095 - ' -000096 - ' -000097 - ' -000098 - ' -000099 - ' -000100 - ' -000101 - ' -000102 - ' -000103 - ' -000104 - ' -000105 - ' -000106 - ' -000107 - ' -000108 - ' -000109 - ' -000110 - ' -000111 - ' -000112 - ' -000113 - ' -000114 - ' '==. -000001C -000002C DISPLAY ' -000002+ - -000002+ - -000002+ - -000002+ - -000002+ - -000002+ - -000002+ - -000002+ - -000002+ - -000002+ - -000002+ - -000002+ - -000002+ - -000002+ - -000002+ - -000002+ - -000002+ - -000002+ - -000002+ - -000002+ - -000002+ - -000002+ - -000002+ - -000002+ - -000002+ - -000002+ - -000002+ - -000002+ - -000002+ - -000002+ - -000002+ - -000002+ - -000002+ - -000002+ - -000002+ - -000002+ - -000002+ - -000002+ - -000002+ - -000002+ - -000002+ - -000002+ - -000002+ - -000002+ - -000002+ - -000002+ - -000002+ - -000002+ - -000002+ - -000002+ - -000002+ - -000002+ - -000002+ - -000002+ - -000002+ - -000002+ - -000002+ - -000002+ - -000002+ - -000002+ - -000002+ - -000002+ - -000002+ - -000002+ - -000002+ - -000002+ - -000002+ - -000002+ - -000002+ - -000002+ - -000002+ - -000002+ - -000002+ - -000002+ - -000002+ - -000002+ - -000002+ - -000002+ - -000002+ - -000002+ - -000002+ - -000002+ - -000002+ - -000002+ - -000002+ - -000002+ - -000002+ - -000002+ - -000002+ - -000002+ - -000002+ - -000002+ - -000002+ - -000002+ - -000002+ - -000002+ - -000002+ - -000002+ - -000002+ - -000002+ - ' -000115 -000116 STOP RUN. - - -0 warnings in compilation group -0 errors in compilation group -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/listings.at:6692: gcdiff -IGnuCOBOL prog2.lst prog.lst" -at_fn_check_prepare_trace "listings.at:6692" -( $at_check_trace; gcdiff -IGnuCOBOL prog2.lst prog.lst -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/listings.at:6692" -$at_failed && at_fn_log_failure \ -"prog.lst" -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_418 -#AT_START_419 -at_fn_group_banner 419 'run_fundamental.at:24' \ - "DISPLAY literals" " " 4 -at_xfail=no -( - $as_echo "419. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - PROCEDURE DIVISION. - DISPLAY "abc" - END-DISPLAY. - DISPLAY 123 - END-DISPLAY. - DISPLAY +123 - END-DISPLAY. - DISPLAY -123 - END-DISPLAY. - DISPLAY 12.3 - END-DISPLAY. - DISPLAY +12.3 - END-DISPLAY. - DISPLAY -12.3 - END-DISPLAY. - DISPLAY 1.23E0 - END-DISPLAY. - DISPLAY +1.23E0 - END-DISPLAY. - DISPLAY -1.23E0 - END-DISPLAY. - DISPLAY 12.3E-2 - END-DISPLAY. - DISPLAY +12.3E-2 - END-DISPLAY. - DISPLAY -12.3E-2 - END-DISPLAY. - DISPLAY B'0101' - END-DISPLAY. - DISPLAY BX'EC' - END-DISPLAY. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_fundamental.at:64: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_fundamental.at:64" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_fundamental.at:64" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_fundamental.at:65: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_fundamental.at:65" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo "abc -123 -+123 --123 -12.3 -+12.3 --12.3 -1.23 -+1.23 --1.23 -.123 -+.123 --.123 -5 -236 -" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_fundamental.at:65" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_419 -#AT_START_420 -at_fn_group_banner 420 'run_fundamental.at:86' \ - "DISPLAY literals, DECIMAL-POINT is COMMA" " " 4 -at_xfail=no -( - $as_echo "420. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - CONFIGURATION SECTION. - SPECIAL-NAMES. - DECIMAL-POINT IS COMMA. - PROCEDURE DIVISION. - DISPLAY 12,3 - END-DISPLAY. - DISPLAY +12,3 - END-DISPLAY. - DISPLAY -12,3 - END-DISPLAY. - DISPLAY 1,23E0 - END-DISPLAY. - DISPLAY +1,23E0 - END-DISPLAY. - DISPLAY -1,23E0 - END-DISPLAY. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_fundamental.at:112: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_fundamental.at:112" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_fundamental.at:112" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_fundamental.at:113: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_fundamental.at:113" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo "12,3 -+12,3 --12,3 -1,23 -+1,23 --1,23 -" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_fundamental.at:113" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_420 -#AT_START_421 -at_fn_group_banner 421 'run_fundamental.at:125' \ - "Hexadecimal literal" " " 4 -at_xfail=no -( - $as_echo "421. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >dump.c <<'_ATEOF' - -#include -#include - -COB_EXT_EXPORT int -dump (unsigned char *data) -{ - int i; - for (i = 0; i < 4; i++) - printf ("%02x", data[i]); - return 0; -} -_ATEOF - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - PROCEDURE DIVISION. - >>IF CHARSET = 'EBCDIC' - DISPLAY X"F1F2F3" - >>ELSE - DISPLAY X"313233" - >>END-IF - END-DISPLAY. - CALL "dump" USING X"000102" - END-CALL. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_fundamental.at:157: \$COMPILE_MODULE dump.c" -at_fn_check_prepare_dynamic "$COMPILE_MODULE dump.c" "run_fundamental.at:157" -( $at_check_trace; $COMPILE_MODULE dump.c -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_fundamental.at:157" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_fundamental.at:158: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_fundamental.at:158" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_fundamental.at:158" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_fundamental.at:159: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_fundamental.at:159" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo "123 -00010200" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_fundamental.at:159" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_421 -#AT_START_422 -at_fn_group_banner 422 'run_fundamental.at:166' \ - "DISPLAY data items with VALUE clause" " " 4 -at_xfail=no -( - $as_echo "422. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 X-ABC PIC XXX VALUE "abc". - 01 X-123 PIC 999 VALUE 123. - 01 X-P123 PIC S999 VALUE +123. - 01 X-N123 PIC S999 VALUE -123. - 01 X-12-3 PIC 99V9 VALUE 12.3. - 01 X-P12-3 PIC S99V9 VALUE +12.3. - 01 X-N12-3 PIC S99V9 VALUE -12.3. - PROCEDURE DIVISION. - DISPLAY X-ABC - END-DISPLAY. - DISPLAY X-123 - END-DISPLAY. - DISPLAY X-P123 - END-DISPLAY. - DISPLAY X-N123 - END-DISPLAY. - DISPLAY X-12-3 - END-DISPLAY. - DISPLAY X-P12-3 - END-DISPLAY. - DISPLAY X-N12-3 - END-DISPLAY. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_fundamental.at:199: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_fundamental.at:199" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_fundamental.at:199" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_fundamental.at:200: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_fundamental.at:200" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo "abc -123 -+123 --123 -12.3 -+12.3 --12.3 -" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_fundamental.at:200" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_422 -#AT_START_423 -at_fn_group_banner 423 'run_fundamental.at:213' \ - "DISPLAY data items with MOVE statement" " " 4 -at_xfail=no -( - $as_echo "423. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 X-ABC PIC XXX VALUE "abc". - 01 X-123 PIC 999 VALUE 123. - 01 X-P123 PIC S999 VALUE +123. - 01 X-N123 PIC S999 VALUE -123. - 01 X-12-3 PIC 99V9 VALUE 12.3. - 01 X-P12-3 PIC S99V9 VALUE +12.3. - 01 X-N12-3 PIC S99V9 VALUE -12.3. - PROCEDURE DIVISION. - MOVE "abc" TO X-ABC. - DISPLAY X-ABC - END-DISPLAY. - MOVE 123 TO X-123. - DISPLAY X-123 - END-DISPLAY. - MOVE +123 TO X-P123. - DISPLAY X-P123 - END-DISPLAY. - MOVE -123 TO X-N123. - DISPLAY X-N123 - END-DISPLAY. - MOVE 12.3 TO X-12-3. - DISPLAY X-12-3 - END-DISPLAY. - MOVE +12.3 TO X-P12-3. - DISPLAY X-P12-3 - END-DISPLAY. - MOVE -12.3 TO X-N12-3. - DISPLAY X-N12-3 - END-DISPLAY. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_fundamental.at:253: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_fundamental.at:253" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_fundamental.at:253" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_fundamental.at:254: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_fundamental.at:254" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo "abc -123 -+123 --123 -12.3 -+12.3 --12.3 -" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_fundamental.at:254" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_423 -#AT_START_424 -at_fn_group_banner 424 'run_fundamental.at:267' \ - "MOVE to edited item (1)" " " 4 -at_xfail=no -( - $as_echo "424. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 SRC-1 PIC S99V99 VALUE 1.10. - 01 SRC-2 PIC S99V99 VALUE 0.02. - 01 SRC-3 PIC S99V99 VALUE -0.03. - 01 SRC-4 PIC S99V99 VALUE -0.04. - 01 SRC-5 PIC S99V99 VALUE -0.05. - 01 EDT-1 PIC -(04)9. - 01 EDT-2 PIC -(04)9. - 01 EDT-3 PIC -(04)9. - 01 EDT-4 PIC +(04)9. - 01 EDT-5 PIC -(05). - PROCEDURE DIVISION. - MOVE SRC-1 TO EDT-1. - MOVE SRC-2 TO EDT-2. - MOVE SRC-3 TO EDT-3. - MOVE SRC-4 TO EDT-4. - MOVE SRC-5 TO EDT-5. - DISPLAY '>' EDT-1 '<' - END-DISPLAY. - DISPLAY '>' EDT-2 '<' - END-DISPLAY. - DISPLAY '>' EDT-3 '<' - END-DISPLAY. - DISPLAY '>' EDT-4 '<' - END-DISPLAY. - DISPLAY '>' EDT-5 '<' - END-DISPLAY. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_fundamental.at:304: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_fundamental.at:304" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_fundamental.at:304" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_fundamental.at:305: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_fundamental.at:305" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo "> 1< -> 0< -> 0< -> +0< -> < -" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_fundamental.at:305" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_424 -#AT_START_425 -at_fn_group_banner 425 'run_fundamental.at:316' \ - "MOVE to edited item (2)" " " 4 -at_xfail=no -( - $as_echo "425. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 SRC-1 PIC S99V99 VALUE -0.06. - 01 SRC-2 PIC S99V99 VALUE -0.07. - 01 SRC-3 PIC S99V99 VALUE -0.08. - 01 SRC-4 PIC S99V99 VALUE -0.09. - 01 SRC-5 PIC S99V99 VALUE -1.10. - 01 EDT-1 PIC 9(04)-. - 01 EDT-2 PIC 9(04)+. - 01 EDT-3 PIC Z(04)+. - 01 EDT-4 PIC 9(04)DB. - 01 EDT-5 PIC 9(04)DB. - PROCEDURE DIVISION. - MOVE SRC-1 TO EDT-1. - MOVE SRC-2 TO EDT-2. - MOVE SRC-3 TO EDT-3. - MOVE SRC-4 TO EDT-4. - MOVE SRC-5 TO EDT-5. - DISPLAY '>' EDT-1 '<' - END-DISPLAY. - DISPLAY '>' EDT-2 '<' - END-DISPLAY. - DISPLAY '>' EDT-3 '<' - END-DISPLAY. - DISPLAY '>' EDT-4 '<' - END-DISPLAY. - DISPLAY '>' EDT-5 '<' - END-DISPLAY. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_fundamental.at:353: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_fundamental.at:353" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_fundamental.at:353" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_fundamental.at:354: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_fundamental.at:354" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo ">0000 < ->0000+< -> < ->0000 < ->0001DB< -" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_fundamental.at:354" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_425 -#AT_START_426 -at_fn_group_banner 426 'run_fundamental.at:365' \ - "MOVE to item with simple and floating insertion" "" 4 -at_xfail=no -( - $as_echo "426. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 num-1 PIC -*B*99. - 01 num-2 PIC $BB**,***.**. - 01 num-3 PIC $BB--,---.--. - - PROCEDURE DIVISION. - MOVE -123 TO num-1 - DISPLAY ">" num-1 "<" - - MOVE 1234.56 TO num-2 - DISPLAY ">" num-2 "<" - - MOVE 1234.56 TO num-3 - DISPLAY ">" num-3 "<" - . -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_fundamental.at:390: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_fundamental.at:390" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_fundamental.at:390" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_fundamental.at:391: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_fundamental.at:391" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo ">-**123< ->\$ *1,234.56< ->\$ 1,234.56< -" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_fundamental.at:391" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_426 -#AT_START_427 -at_fn_group_banner 427 'run_fundamental.at:400' \ - "MOVE to JUSTIFIED item" " " 4 -at_xfail=no -( - $as_echo "427. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 SRC-1 PIC S9(04) VALUE 11. - 01 SRC-2 PIC S9(04) COMP VALUE 22. - 01 SRC-3 PIC S9(04) COMP-5 VALUE 33. - 01 SRC-4 PIC S9(04)PP VALUE 4400. - 01 SRC-5 PIC S9(04)PPPPP VALUE 55500000. - 01 EDT-FLD PIC X(07) JUSTIFIED RIGHT. - PROCEDURE DIVISION. - MOVE SRC-1 TO EDT-FLD. - DISPLAY '>' EDT-FLD '<' - END-DISPLAY. - MOVE SRC-2 TO EDT-FLD. - DISPLAY '>' EDT-FLD '<' - END-DISPLAY. - MOVE SRC-3 TO EDT-FLD. - DISPLAY '>' EDT-FLD '<' - END-DISPLAY. - MOVE SRC-4 TO EDT-FLD. - DISPLAY '>' EDT-FLD '<' - END-DISPLAY. - MOVE SRC-5 TO EDT-FLD. - DISPLAY '>' EDT-FLD '<' - END-DISPLAY. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_fundamental.at:433: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_fundamental.at:433" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_fundamental.at:433" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_fundamental.at:434: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_fundamental.at:434" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo "> 0011< -> 0022< -> 0033< -> 004400< ->5500000< -" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_fundamental.at:434" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_427 -#AT_START_428 -at_fn_group_banner 428 'run_fundamental.at:445' \ - "MOVE integer literal to alphanumeric" " " 4 -at_xfail=no -( - $as_echo "428. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 X PIC X(04) VALUE SPACES. - PROCEDURE DIVISION. - MOVE 0 TO X. - DISPLAY X NO ADVANCING - END-DISPLAY. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_fundamental.at:461: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_fundamental.at:461" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob:8: warning: alphanumeric value is expected -prog.cob:6: warning: 'X' defined here as PIC X(04) -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_fundamental.at:461" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_fundamental.at:465: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_fundamental.at:465" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo "0 " | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_fundamental.at:465" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_428 -#AT_START_429 -at_fn_group_banner 429 'run_fundamental.at:470' \ - "Compare FLOAT-LONG with floating-point literal" " " 4 -at_xfail=no -( - $as_echo "429. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 VAR FLOAT-LONG VALUE 0.0. - - PROCEDURE DIVISION. - MOVE 9.899999999999E+304 TO VAR - IF VAR < 0 - DISPLAY 'error: compare ' VAR ' < ' 0 - ' failed!' - END-DISPLAY - END-IF. - IF VAR < 9.799999999999E+304 - DISPLAY 'error: compare ' VAR ' < ' 9.799999999999E+304 - ' failed!' - END-DISPLAY - END-IF. - IF VAR > 9.999999999999E+304 - DISPLAY 'error: compare ' VAR ' > ' 9.999999999999E+304 - ' failed!' - END-DISPLAY - END-IF. - MOVE -9.899999999999E+304 TO VAR - IF VAR > 0 - DISPLAY 'error: compare ' VAR ' > ' 0 - ' failed!' - END-DISPLAY - END-IF. - IF VAR < -9.999999999999E+304 - DISPLAY 'error: compare ' VAR ' < ' -9.999999999999E+304 - ' failed!' - END-DISPLAY - END-IF. - IF VAR > -9.799999999999E+304 - DISPLAY 'error: compare ' VAR ' > ' -9.799999999999E+304 - ' failed!' - END-DISPLAY - END-IF. - - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_fundamental.at:517: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_fundamental.at:517" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_fundamental.at:517" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_fundamental.at:518: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_fundamental.at:518" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_fundamental.at:518" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_429 -#AT_START_430 -at_fn_group_banner 430 'run_fundamental.at:523' \ - "Check for equality of FLOAT-SHORT / FLOAT-LONG" " " 4 -at_xfail=no -( - $as_echo "430. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 SRC1 FLOAT-LONG VALUE 11.55. - 01 DST1 FLOAT-SHORT. - 01 SRC2 FLOAT-SHORT VALUE 11.55. - 01 DST2 FLOAT-LONG. - - PROCEDURE DIVISION. - MOVE SRC1 TO DST1. - IF DST1 not = 11.55 - DISPLAY 'error: move/compare FLOAT-LONG to FLOAT-SHORT fa - - 'iled ' DST1 - END-DISPLAY - END-IF. - - MOVE SRC1 TO DST2. - IF DST1 not = 11.55 - DISPLAY 'error: move/compare FLOAT-LONG to FLOAT-LONG fai - - 'led ' DST2 - END-DISPLAY - END-IF. - - MOVE ZERO TO DST1. - MOVE ZERO TO DST2. - - MOVE SRC2 TO DST1. - IF DST1 not = 11.55 - DISPLAY 'error: move/compare FLOAT-SHORT to FLOAT-SHORT f - - 'ailed: ' DST1 - END-DISPLAY - END-IF. - - MOVE SRC2 TO DST2. - IF DST2 not = 11.55 - DISPLAY 'error: move/compare FLOAT-SHORT to FLOAT-LONG fa - - 'iled: ' DST2 - END-DISPLAY - END-IF. - - MOVE ZERO TO DST1. - IF not (DST1 = 0 AND 0.0) - DISPLAY "Zero compare failed: " DST1 END-DISPLAY - END-IF. - - MOVE -0.0 TO DST1. - IF not (DST1 = 0 AND 0.0) - DISPLAY "Negative Zero compare failed: " DST1 - END-DISPLAY - END-IF. - - MOVE 1.1234567 TO DST1. - MOVE DST1 TO DST2. - IF DST2 not = 1.1234567 - DISPLAY "move/compare number to FLOAT to DOUBLE failed: " - DST1 " - " DST2 - END-DISPLAY - END-IF. - - * Check for Tolerance - MOVE 1.1234567 TO DST1. - MOVE 1.1234568 TO DST2. - IF DST1 not = DST2 THEN - DISPLAY 'move/compare of very near numbers failed (not id - - 'entical): ' DST1 " - " DST2 - END-DISPLAY - END-IF. - - * Within tolerance by definition, therefore not checked - * MULTIPLY 10000000000 BY DST1 DST2 END-MULTIPLY. - * IF DST1 = DST2 THEN - * DISPLAY "compare of very near numbers computed failed (id - *- "entical): " DST1 " - " DST2 - * END-DISPLAY - * END-IF. - - MOVE 1.1234567 TO DST1. - MOVE 1.1234569 TO DST2. - IF DST1 = DST2 THEN - DISPLAY 'move/compare of near equal numbers failed (ident - - 'ical): ' DST1 " - " DST2 - END-DISPLAY - END-IF. - - MOVE 0.0001 TO DST1. - MOVE 0.0000 TO DST2. - IF DST1 = DST2 THEN - DISPLAY 'move/compare of nearly equal very small numbers - - 'failed (identical): ' DST1 " - " DST2 - END-DISPLAY - END-IF. - - MOVE 1000001.0 TO DST1. - MOVE 1000000.0 TO DST2. - IF DST1 = DST2 THEN - DISPLAY 'move/compare of nearly equal big numbers failed - - '(identical): ' DST1 " - " DST2 - END-DISPLAY - END-IF. - - * Within tolerance by definition, therefore not checked - * MOVE 1000000000.0 TO DST1. - * MOVE 1000000001.0 TO DST2. - * IF DST1 = DST2 THEN - * DISPLAY 'move/compare of nearly equal very big numbers fa - *- 'iled (identical): ' DST1 " - " DST2 - * END-DISPLAY - * END-IF. - - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_fundamental.at:640: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_fundamental.at:640" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_fundamental.at:640" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_fundamental.at:641: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_fundamental.at:641" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_fundamental.at:641" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_430 -#AT_START_431 -at_fn_group_banner 431 'run_fundamental.at:646' \ - "Overlapping MOVE" " " 4 -at_xfail=no -( - $as_echo "431. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >subprog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. subprog. - DATA DIVISION. - WORKING-STORAGE SECTION. - LINKAGE SECTION. - 01 F1 PIC X(10). - 01 F2 PIC X(15). - - PROCEDURE DIVISION USING F1 F2. - MOVE F2(1:6) TO F1 (1:8). - IF F1 not = "Hallo1 90" - DISPLAY "error:3: " F1 - END-DISPLAY - END-IF - - GOBACK. -_ATEOF - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 STRUCTURE. - 05 FIELD1 PIC X(5). - 05 FIELD2 PIC X(10). - - PROCEDURE DIVISION. - MOVE "Hallo" TO FIELD1. - MOVE "1234567890" TO FIELD2. - - MOVE FIELD2 TO STRUCTURE. - IF FIELD1 not = "12345" - DISPLAY "error:1: " FIELD1 - END-DISPLAY - END-IF - IF FIELD2 not = "67890 " - DISPLAY "error:2: " FIELD2 - END-DISPLAY - END-IF - - - MOVE "Hallo" TO FIELD1. - MOVE "1234567890" TO FIELD2. - - CALL "subprog" USING BY REFERENCE FIELD2 STRUCTURE - END-CALL - - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_fundamental.at:702: \$COMPILE_MODULE subprog.cob" -at_fn_check_prepare_dynamic "$COMPILE_MODULE subprog.cob" "run_fundamental.at:702" -( $at_check_trace; $COMPILE_MODULE subprog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_fundamental.at:702" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_fundamental.at:703: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_fundamental.at:703" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob:15: warning: overlapping MOVE may produce unpredictable results -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_fundamental.at:703" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_fundamental.at:706: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_fundamental.at:706" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_fundamental.at:706" -$at_failed && at_fn_log_failure -$at_traceon; } - - -cat >prog2.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog2. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 FILLER. - 05 TSTMOV1 PIC X(479). - 05 TSTMOV2 PIC X(10). - PROCEDURE DIVISION. - MOVE "0123456789" TO TSTMOV2. - MOVE TSTMOV2 (2:9) TO TSTMOV2 (1:9) - IF TSTMOV2 NOT = "1234567899" - DISPLAY " PROBLEM MOVE: " TSTMOV2 - ELSE - DISPLAY " OK with MOVE: " TSTMOV2. - MOVE "0123456789" TO TSTMOV2. - MOVE TSTMOV2 (1:8) TO TSTMOV2 (2:8) - IF TSTMOV2 = "0000000009" - DISPLAY "IBM style MOVE: " TSTMOV2 - ELSE IF TSTMOV2 NOT = "0012345679" - DISPLAY " PROBLEM MOVE: " TSTMOV2 - ELSE - DISPLAY " OK with MOVE: " TSTMOV2. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_fundamental.at:734: \$COMPILE prog2.cob" -at_fn_check_prepare_dynamic "$COMPILE prog2.cob" "run_fundamental.at:734" -( $at_check_trace; $COMPILE prog2.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog2.cob:11: warning: overlapping MOVE may produce unpredictable results -prog2.cob:17: warning: overlapping MOVE may produce unpredictable results -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_fundamental.at:734" -$at_failed && at_fn_log_failure -$at_traceon; } - - -{ set +x -$as_echo "$at_srcdir/run_fundamental.at:739: \$COBCRUN_DIRECT ./prog2" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog2" "run_fundamental.at:739" -( $at_check_trace; $COBCRUN_DIRECT ./prog2 -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo " OK with MOVE: 1234567899 - OK with MOVE: 0012345679 -" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_fundamental.at:739" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_431 -#AT_START_432 -at_fn_group_banner 432 'run_fundamental.at:747' \ - "Overlapping MOVE" " " 4 -at_xfail=no -( - $as_echo "432. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 FILLER. - 05 TSTMOV1 PIC X(479). - 05 TSTMOV2 PIC X(10). - PROCEDURE DIVISION. - MOVE "0123456789" TO TSTMOV2. - MOVE TSTMOV2 (2:9) TO TSTMOV2 (1:9) - IF TSTMOV2 NOT = "1234567899" - DISPLAY " PROBLEM MOVE: " TSTMOV2 - ELSE - DISPLAY " OK with MOVE: " TSTMOV2. - MOVE "0123456789" TO TSTMOV2. - MOVE TSTMOV2 (1:8) TO TSTMOV2 (2:8) - IF TSTMOV2 = "0000000009" - DISPLAY "IBM style MOVE: " TSTMOV2 - ELSE IF TSTMOV2 NOT = "0012345679" - DISPLAY " PROBLEM MOVE: " TSTMOV2 - ELSE - DISPLAY " OK with MOVE: " TSTMOV2. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_fundamental.at:776: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_fundamental.at:776" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob:11: warning: overlapping MOVE may produce unpredictable results -prog.cob:17: warning: overlapping MOVE may produce unpredictable results -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_fundamental.at:776" -$at_failed && at_fn_log_failure -$at_traceon; } - - -{ set +x -$as_echo "$at_srcdir/run_fundamental.at:781: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_fundamental.at:781" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo " OK with MOVE: 1234567899 - OK with MOVE: 0012345679 -" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_fundamental.at:781" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_432 -#AT_START_433 -at_fn_group_banner 433 'run_fundamental.at:789' \ - "IBM MOVE" " " 4 -at_xfail=no -( - $as_echo "433. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 FILLER. - 05 TSTMOV1 PIC X(479). - 05 TSTMOV2 PIC X(10). - PROCEDURE DIVISION. - MOVE "0123456789" TO TSTMOV2. - MOVE TSTMOV2 (2:9) TO TSTMOV2 (1:9) - IF TSTMOV2 NOT = "1234567899" - DISPLAY " PROBLEM MOVE: " TSTMOV2 - ELSE - DISPLAY " OK with MOVE: " TSTMOV2. - MOVE "0123456789" TO TSTMOV2. - MOVE TSTMOV2 (1:8) TO TSTMOV2 (2:8) - IF TSTMOV2 = "0000000009" - DISPLAY "IBM style MOVE: " TSTMOV2 - ELSE IF TSTMOV2 NOT = "0012345679" - DISPLAY " PROBLEM MOVE: " TSTMOV2 - ELSE - DISPLAY " OK with MOVE: " TSTMOV2. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_fundamental.at:818: \$COMPILE -fmove-ibm prog.cob" -at_fn_check_prepare_dynamic "$COMPILE -fmove-ibm prog.cob" "run_fundamental.at:818" -( $at_check_trace; $COMPILE -fmove-ibm prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_fundamental.at:818" -$at_failed && at_fn_log_failure -$at_traceon; } - - -{ set +x -$as_echo "$at_srcdir/run_fundamental.at:820: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_fundamental.at:820" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo " OK with MOVE: 1234567899 -IBM style MOVE: 0000000009 -" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_fundamental.at:820" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_433 -#AT_START_434 -at_fn_group_banner 434 'run_fundamental.at:828' \ - "ALPHABETIC test" " " 4 -at_xfail=no -( - $as_echo "434. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 X PIC X(04) VALUE "AAAA". - 01 FILLER REDEFINES X. - 03 XBYTE PIC X. - 03 FILLER PIC XXX. - PROCEDURE DIVISION. - MOVE X"0D" TO XBYTE. - IF X ALPHABETIC - DISPLAY "Fail - Alphabetic" - END-DISPLAY - END-IF. - MOVE "A" TO XBYTE. - IF X NOT ALPHABETIC - DISPLAY "Fail - Not Alphabetic" - END-DISPLAY - END-IF. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_fundamental.at:854: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_fundamental.at:854" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_fundamental.at:854" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_fundamental.at:855: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_fundamental.at:855" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_fundamental.at:855" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_434 -#AT_START_435 -at_fn_group_banner 435 'run_fundamental.at:860' \ - "ALPHABETIC-UPPER test" " " 4 -at_xfail=no -( - $as_echo "435. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 X PIC X(04) VALUE "AAAA". - 01 FILLER REDEFINES X. - 03 XBYTE PIC X. - 03 FILLER PIC XXX. - PROCEDURE DIVISION. - MOVE X"0D" TO XBYTE. - IF X ALPHABETIC-UPPER - DISPLAY "Fail - Not alphabetic upper" - END-DISPLAY - END-IF. - MOVE "A" TO XBYTE. - IF X NOT ALPHABETIC-UPPER - DISPLAY "Fail - Alphabetic upper" - END-DISPLAY - END-IF. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_fundamental.at:886: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_fundamental.at:886" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_fundamental.at:886" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_fundamental.at:887: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_fundamental.at:887" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_fundamental.at:887" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_435 -#AT_START_436 -at_fn_group_banner 436 'run_fundamental.at:892' \ - "ALPHABETIC-LOWER test" " " 4 -at_xfail=no -( - $as_echo "436. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 X PIC X(04) VALUE "aaaa". - 01 FILLER REDEFINES X. - 03 XBYTE PIC X. - 03 FILLER PIC XXX. - PROCEDURE DIVISION. - MOVE X"0D" TO XBYTE. - IF X ALPHABETIC-LOWER - DISPLAY "Fail - Not alphabetic lower" - END-DISPLAY - END-IF. - MOVE "a" TO XBYTE. - IF X NOT ALPHABETIC-LOWER - DISPLAY "Fail - Alphabetic lower" - END-DISPLAY - END-IF. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_fundamental.at:918: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_fundamental.at:918" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_fundamental.at:918" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_fundamental.at:919: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_fundamental.at:919" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_fundamental.at:919" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_436 -#AT_START_437 -at_fn_group_banner 437 'run_fundamental.at:924' \ - "GLOBAL at same level" " " 4 -at_xfail=no -( - $as_echo "437. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 X PIC X(5) GLOBAL VALUE "prog1". - PROCEDURE DIVISION. - DISPLAY X - END-DISPLAY. - CALL "prog2" - END-CALL - CALL "prog3" - END-CALL - STOP RUN. - IDENTIFICATION DIVISION. - PROGRAM-ID. prog2. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 X PIC X(5) GLOBAL VALUE "prog2". - PROCEDURE DIVISION. - DISPLAY X - END-DISPLAY. - EXIT PROGRAM. - END PROGRAM prog2. - IDENTIFICATION DIVISION. - PROGRAM-ID. prog3. - DATA DIVISION. - WORKING-STORAGE SECTION. - PROCEDURE DIVISION. - DISPLAY X - END-DISPLAY. - EXIT PROGRAM. - END PROGRAM prog3. - END PROGRAM prog. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_fundamental.at:963: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_fundamental.at:963" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_fundamental.at:963" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_fundamental.at:964: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_fundamental.at:964" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo "prog1 -prog2 -prog1 -" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_fundamental.at:964" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_437 -#AT_START_438 -at_fn_group_banner 438 'run_fundamental.at:973' \ - "GLOBAL at lower level" " " 4 -at_xfail=no -( - $as_echo "438. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 X PIC X(5) GLOBAL VALUE "prog1". - PROCEDURE DIVISION. - DISPLAY X - END-DISPLAY. - CALL "prog2" - END-CALL - STOP RUN. - IDENTIFICATION DIVISION. - PROGRAM-ID. prog2. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 X PIC X(5) GLOBAL VALUE "prog2". - PROCEDURE DIVISION. - DISPLAY X - END-DISPLAY. - CALL "prog3" - END-CALL - EXIT PROGRAM. - IDENTIFICATION DIVISION. - PROGRAM-ID. prog3. - DATA DIVISION. - WORKING-STORAGE SECTION. - PROCEDURE DIVISION. - DISPLAY X - END-DISPLAY. - EXIT PROGRAM. - END PROGRAM prog3. - END PROGRAM prog2. - END PROGRAM prog. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_fundamental.at:1012: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_fundamental.at:1012" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_fundamental.at:1012" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_fundamental.at:1013: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_fundamental.at:1013" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo "prog1 -prog2 -prog2 -" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_fundamental.at:1013" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_438 -#AT_START_439 -at_fn_group_banner 439 'run_fundamental.at:1022' \ - "GLOBAL CONSTANT" " " 4 -at_xfail=no -( - $as_echo "439. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - INPUT-OUTPUT SECTION. - FILE-CONTROL. - SELECT TEST-FILE - ASSIGN GLOB-PATH - . - DATA DIVISION. - FILE SECTION. - FD TEST-FILE GLOBAL. - 01 TEST-REC PIC X(4). - WORKING-STORAGE SECTION. - 78 GLOB-PATH GLOBAL VALUE "GLOBP1". - 01 GLOB-PATH2 CONSTANT GLOBAL "GLOBP2". - * Test global vars because of implicitly defined ASSIGN var, too. - 78 GLOB-VAR GLOBAL VALUE "GLOBV1". - 01 GLOB-VAR2 CONSTANT GLOBAL "GLOBV2". - PROCEDURE DIVISION. - DISPLAY GLOB-PATH GLOB-VAR - END-DISPLAY. - CALL "prog2" - END-CALL. - CALL "prog3" - END-CALL. - STOP RUN. - IDENTIFICATION DIVISION. - PROGRAM-ID. prog2. - ENVIRONMENT DIVISION. - INPUT-OUTPUT SECTION. - FILE-CONTROL. - SELECT TEST2-FILE - ASSIGN GLOB-PATH2 - . - DATA DIVISION. - FILE SECTION. - FD TEST2-FILE GLOBAL. - 01 TEST2-REC PIC X(4). - WORKING-STORAGE SECTION. - PROCEDURE DIVISION. - DISPLAY GLOB-PATH2 GLOB-VAR2 - END-DISPLAY. - EXIT PROGRAM. - END PROGRAM prog2. - END PROGRAM prog. - IDENTIFICATION DIVISION. - PROGRAM-ID. prog3. - ENVIRONMENT DIVISION. - INPUT-OUTPUT SECTION. - FILE-CONTROL. - SELECT TEST3-FILE - ASSIGN GLOB-PATH - . - DATA DIVISION. - FILE SECTION. - FD TEST3-FILE GLOBAL. - 01 TEST3-REC PIC X(4). - WORKING-STORAGE SECTION. - PROCEDURE DIVISION. - DISPLAY 'in prog3' - END-DISPLAY - IF GLOB-PATH NOT = SPACES - DISPLAY GLOB-PATH - END-DISPLAY - END-IF - EXIT PROGRAM. - END PROGRAM prog3. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_fundamental.at:1095: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_fundamental.at:1095" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob:60: warning: variable 'GLOB-PATH' will be implicitly defined -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_fundamental.at:1095" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_fundamental.at:1098: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_fundamental.at:1098" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo "GLOBP1GLOBV1 -GLOBP2GLOBV2 -in prog3 -" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_fundamental.at:1098" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_439 -#AT_START_440 -at_fn_group_banner 440 'run_fundamental.at:1107' \ - "GLOBAL identifiers from ENVIRONMENT DIVISION" " " 4 -at_xfail=no -( - $as_echo "440. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - FUNCTION-ID. f1. - DATA DIVISION. - LINKAGE SECTION. - 01 r BINARY-LONG. - PROCEDURE DIVISION RETURNING r. - move 1 to r - GOBACK - . - END FUNCTION f1. - FUNCTION-ID. f2. - DATA DIVISION. - LINKAGE SECTION. - 01 i BINARY-LONG. - 01 r BINARY-LONG. - PROCEDURE DIVISION USING i RETURNING r. - add i to i giving r - GOBACK - . - END FUNCTION f2. - - PROGRAM-ID. prog. - - ENVIRONMENT DIVISION. - CONFIGURATION SECTION. - REPOSITORY. - FUNCTION f1 - FUNCTION f2. - SPECIAL-NAMES. - CURRENCY SIGN IS "Y" - DECIMAL-POINT IS COMMA. - - PROCEDURE DIVISION. - CALL "prog-nested" - . - - PROGRAM-ID. prog-nested. - - DATA DIVISION. - WORKING-STORAGE SECTION. - 77 n1 BINARY-LONG VALUE 0. - 77 curr PIC 9.9999,99Y. - - PROCEDURE DIVISION. - MOVE f1() TO n1 - IF n1 NOT = 1 - DISPLAY "ERROR 1" GOBACK - END-IF - MOVE f2(n1) TO n1 - IF n1 NOT = 2 - DISPLAY "ERROR 2" GOBACK - END-IF - MOVE f1() TO n1 - IF n1 NOT = 1 - DISPLAY "ERROR 1 2nd" GOBACK - END-IF - MOVE f2(f2(n1)) TO n1 - IF n1 NOT = 4 - DISPLAY "ERROR 4" GOBACK - END-IF - MOVE n1 TO curr - DISPLAY curr - - GOBACK - . - END PROGRAM prog-nested. - END PROGRAM prog. - -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_fundamental.at:1180: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_fundamental.at:1180" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_fundamental.at:1180" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_fundamental.at:1181: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_fundamental.at:1181" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo "0.0004,00Y -" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_fundamental.at:1181" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_440 -#AT_START_441 -at_fn_group_banner 441 'run_fundamental.at:1188' \ - "Entry point visibility (1)" " " 4 -at_xfail=no -( - $as_echo "441. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - PROCEDURE DIVISION. - CALL 'module' - CALL 'modulepart' - STOP RUN. -_ATEOF - - -cat >module.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. module. - DATA DIVISION. - PROCEDURE DIVISION. - DISPLAY 'A' WITH NO ADVANCING - GOBACK. - ENTRY 'modulepart'. - DISPLAY 'B' WITH NO ADVANCING - GOBACK. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_fundamental.at:1213: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_fundamental.at:1213" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_fundamental.at:1213" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_fundamental.at:1214: \$COMPILE_MODULE module.cob" -at_fn_check_prepare_dynamic "$COMPILE_MODULE module.cob" "run_fundamental.at:1214" -( $at_check_trace; $COMPILE_MODULE module.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_fundamental.at:1214" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_fundamental.at:1215: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_fundamental.at:1215" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo "AB" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_fundamental.at:1215" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_441 -#AT_START_442 -at_fn_group_banner 442 'run_fundamental.at:1220' \ - "Entry point visibility (2)" " " 4 -at_xfail=no -( - $as_echo "442. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -# TODO: skip on __OS400__ - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - PROCEDURE DIVISION. - CALL 'module' - STOP RUN. -_ATEOF - - -cat >module.c <<'_ATEOF' - -#include -#include - -COB_EXT_EXPORT int -some (void) -{ - return 0; -} -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_fundamental.at:1245: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_fundamental.at:1245" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_fundamental.at:1245" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_fundamental.at:1246: \$COMPILE_MODULE module.c" -at_fn_check_prepare_dynamic "$COMPILE_MODULE module.c" "run_fundamental.at:1246" -( $at_check_trace; $COMPILE_MODULE module.c -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_fundamental.at:1246" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_fundamental.at:1247: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_fundamental.at:1247" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "libcob: prog.cob:6: error: entry point 'module' not found -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/run_fundamental.at:1247" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_442 -#AT_START_443 -at_fn_group_banner 443 'run_fundamental.at:1254' \ - "Contained program visibility (1)" " " 4 -at_xfail=no -( - $as_echo "443. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 X PIC X(5) GLOBAL VALUE "prog1". - PROCEDURE DIVISION. - IF X NOT = "prog1" - DISPLAY X - END-DISPLAY - END-IF. - CALL "prog2" - END-CALL. - CALL "prog3" - END-CALL. - STOP RUN. - IDENTIFICATION DIVISION. - PROGRAM-ID. prog2. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 X PIC X(5) GLOBAL VALUE "prog2". - PROCEDURE DIVISION. - IF X NOT = "prog2" - DISPLAY X - END-DISPLAY - END-IF. - CALL "prog3" - END-CALL. - EXIT PROGRAM. - IDENTIFICATION DIVISION. - PROGRAM-ID. prog3. - DATA DIVISION. - WORKING-STORAGE SECTION. - PROCEDURE DIVISION. - IF X NOT = "prog2" - DISPLAY X - END-DISPLAY - END-IF - EXIT PROGRAM. - END PROGRAM prog3. - END PROGRAM prog2. - END PROGRAM prog. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_fundamental.at:1301: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_fundamental.at:1301" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_fundamental.at:1301" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_fundamental.at:1302: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_fundamental.at:1302" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "libcob: prog.cob:14: error: module 'prog3' not found -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/run_fundamental.at:1302" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_443 -#AT_START_444 -at_fn_group_banner 444 'run_fundamental.at:1309' \ - "Contained program visibility (2)" " " 4 -at_xfail=no -( - $as_echo "444. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 X PIC X(5) GLOBAL VALUE "prog1". - PROCEDURE DIVISION. - IF X NOT = "prog1" - DISPLAY X - END-DISPLAY - END-IF. - CALL "prog2" - END-CALL. - STOP RUN. - IDENTIFICATION DIVISION. - PROGRAM-ID. prog2. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 X PIC X(5) GLOBAL VALUE "prog2". - PROCEDURE DIVISION. - IF X NOT = "prog2" - DISPLAY X - END-DISPLAY - END-IF. - CALL "prog3" - END-CALL. - EXIT PROGRAM. - END PROGRAM prog2. - IDENTIFICATION DIVISION. - PROGRAM-ID. prog3. - DATA DIVISION. - WORKING-STORAGE SECTION. - PROCEDURE DIVISION. - IF X NOT = "prog2" - DISPLAY X - END-DISPLAY - END-IF. - EXIT PROGRAM. - END PROGRAM prog3. - END PROGRAM prog. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_fundamental.at:1354: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_fundamental.at:1354" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_fundamental.at:1354" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_fundamental.at:1355: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_fundamental.at:1355" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "libcob: prog.cob:25: error: module 'prog3' not found -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/run_fundamental.at:1355" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_444 -#AT_START_445 -at_fn_group_banner 445 'run_fundamental.at:1362' \ - "Contained program visibility (3)" " " 4 -at_xfail=no -( - $as_echo "445. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 X PIC X(5) GLOBAL VALUE "prog1". - PROCEDURE DIVISION. - IF X NOT = "prog1" - DISPLAY X - END-DISPLAY - END-IF. - CALL "prog2" - END-CALL. - STOP RUN. - IDENTIFICATION DIVISION. - PROGRAM-ID. prog2. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 X PIC X(5) GLOBAL VALUE "prog2". - PROCEDURE DIVISION. - IF X NOT = "prog2" - DISPLAY X - END-DISPLAY - END-IF. - CALL "prog3" - END-CALL. - EXIT PROGRAM. - END PROGRAM prog2. - IDENTIFICATION DIVISION. - PROGRAM-ID. prog3 COMMON. - DATA DIVISION. - WORKING-STORAGE SECTION. - PROCEDURE DIVISION. - IF X NOT = "prog1" - DISPLAY X - END-DISPLAY - END-IF. - EXIT PROGRAM. - END PROGRAM prog3. - END PROGRAM prog. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_fundamental.at:1407: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_fundamental.at:1407" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_fundamental.at:1407" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_fundamental.at:1408: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_fundamental.at:1408" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_fundamental.at:1408" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_445 -#AT_START_446 -at_fn_group_banner 446 'run_fundamental.at:1413' \ - "Contained program visibility (4)" " " 4 -at_xfail=no -( - $as_echo "446. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - PROCEDURE DIVISION. - DISPLAY "P1" NO ADVANCING - END-DISPLAY. - CALL "prog2" - END-CALL - CALL "prog3" - END-CALL - STOP RUN. - IDENTIFICATION DIVISION. - PROGRAM-ID. prog2. - DATA DIVISION. - WORKING-STORAGE SECTION. - PROCEDURE DIVISION. - DISPLAY "P2" NO ADVANCING - END-DISPLAY. - EXIT PROGRAM. - END PROGRAM prog2. - END PROGRAM prog. - IDENTIFICATION DIVISION. - PROGRAM-ID. prog3. - DATA DIVISION. - WORKING-STORAGE SECTION. - PROCEDURE DIVISION. - DISPLAY "P3" NO ADVANCING - END-DISPLAY. - CALL "prog2" - END-CALL. - EXIT PROGRAM. - IDENTIFICATION DIVISION. - PROGRAM-ID. prog2. - DATA DIVISION. - WORKING-STORAGE SECTION. - PROCEDURE DIVISION. - DISPLAY "P4" NO ADVANCING - END-DISPLAY. - EXIT PROGRAM. - END PROGRAM prog2. - END PROGRAM prog3. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_fundamental.at:1461: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_fundamental.at:1461" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_fundamental.at:1461" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_fundamental.at:1462: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_fundamental.at:1462" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo "P1P2P3P4" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_fundamental.at:1462" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_446 -#AT_START_447 -at_fn_group_banner 447 'run_fundamental.at:1468' \ - "CALL/CANCEL with program-prototype-name" " " 4 -at_xfail=no -( - $as_echo "447. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - - ENVIRONMENT DIVISION. - CONFIGURATION SECTION. - REPOSITORY. - PROGRAM recursion-test - PROGRAM cancel-test - . - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 num PIC 9 VALUE 0. - - PROCEDURE DIVISION. - CALL recursion-test USING num - DISPLAY "<" - - CALL cancel-test - CALL cancel-test - CANCEL cancel-test - CALL cancel-test - DISPLAY "<" - . - END PROGRAM prog. - - - IDENTIFICATION DIVISION. - PROGRAM-ID. recursion-test RECURSIVE. - - DATA DIVISION. - LINKAGE SECTION. - 01 x PIC 9. - - PROCEDURE DIVISION USING x. - ADD 1 TO x - DISPLAY x NO ADVANCING - IF x = 1 - CALL recursion-test USING x - END-IF - . - END PROGRAM recursion-test. - - - IDENTIFICATION DIVISION. - PROGRAM-ID. cancel-test. - - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 x PIC 9 VALUE 1. - - PROCEDURE DIVISION. - DISPLAY x NO ADVANCING - ADD 1 TO x - . - END PROGRAM cancel-test. -_ATEOF - - -# TO-DO: Fix these warnings when program prototypes are added. -{ set +x -$as_echo "$at_srcdir/run_fundamental.at:1530: \$COMPILE -fno-program-name-redefinition prog.cob" -at_fn_check_prepare_dynamic "$COMPILE -fno-program-name-redefinition prog.cob" "run_fundamental.at:1530" -( $at_check_trace; $COMPILE -fno-program-name-redefinition prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob:8: warning: no definition/prototype seen for PROGRAM 'recursion-test' -prog.cob:9: warning: no definition/prototype seen for PROGRAM 'cancel-test' -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_fundamental.at:1530" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_fundamental.at:1534: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_fundamental.at:1534" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo "12< -121< -" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_fundamental.at:1534" -$at_failed && at_fn_log_failure -$at_traceon; } - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_447 -#AT_START_448 -at_fn_group_banner 448 'run_fundamental.at:1541' \ - "GLOBAL FD (RELATIVE 1)" " " 4 -at_xfail=no -( - $as_echo "448. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - INPUT-OUTPUT SECTION. - FILE-CONTROL. - SELECT TEST-FILE - ASSIGN "TESTFILE" - ACCESS DYNAMIC - ORGANIZATION RELATIVE - STATUS TESTSTAT - RELATIVE KEY TESTKEY - . - DATA DIVISION. - FILE SECTION. - FD TEST-FILE GLOBAL. - 01 TEST-REC PIC X(4). - WORKING-STORAGE SECTION. - 01 GLOBVALS. - 03 TESTKEY PIC 9(4). - 03 TESTSTAT PIC XX. - PROCEDURE DIVISION. - OPEN INPUT TEST-FILE. - CALL "prog2" - END-CALL. - CLOSE TEST-FILE. - STOP RUN. - IDENTIFICATION DIVISION. - PROGRAM-ID. prog2. - DATA DIVISION. - WORKING-STORAGE SECTION. - PROCEDURE DIVISION. - READ TEST-FILE - INVALID KEY - DISPLAY "NOK" - END-DISPLAY - END-READ. - EXIT PROGRAM. - END PROGRAM prog2. - END PROGRAM prog. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_fundamental.at:1586: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_fundamental.at:1586" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_fundamental.at:1586" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_fundamental.at:1587: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_fundamental.at:1587" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_fundamental.at:1587" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_448 -#AT_START_449 -at_fn_group_banner 449 'run_fundamental.at:1592' \ - "GLOBAL FD (INDEXED 1)" " " 4 -at_xfail=no -( - $as_echo "449. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -$as_echo "run_fundamental.at:1595" >"$at_check_line_file" -(test "$COB_HAS_ISAM" = "no") \ - && at_fn_check_skip 77 "$at_srcdir/run_fundamental.at:1595" - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - INPUT-OUTPUT SECTION. - FILE-CONTROL. - SELECT TEST-FILE - ASSIGN "TESTFILE" - ACCESS DYNAMIC - ORGANIZATION INDEXED - STATUS TESTSTAT - RECORD KEY TESTKEY - . - DATA DIVISION. - FILE SECTION. - FD TEST-FILE GLOBAL. - 01 TEST-REC. - 03 TESTKEY PIC X(4). - WORKING-STORAGE SECTION. - 01 GLOBVALS. - 03 TESTSTAT PIC XX. - PROCEDURE DIVISION. - OPEN INPUT TEST-FILE. - CALL "prog2" - END-CALL. - CLOSE TEST-FILE. - STOP RUN. - IDENTIFICATION DIVISION. - PROGRAM-ID. prog2. - DATA DIVISION. - WORKING-STORAGE SECTION. - PROCEDURE DIVISION. - READ TEST-FILE - INVALID KEY - DISPLAY "NOK" - END-DISPLAY - END-READ. - EXIT PROGRAM. - END PROGRAM prog2. - END PROGRAM prog. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_fundamental.at:1639: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_fundamental.at:1639" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_fundamental.at:1639" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_fundamental.at:1640: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_fundamental.at:1640" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_fundamental.at:1640" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_449 -#AT_START_450 -at_fn_group_banner 450 'run_fundamental.at:1645' \ - "GLOBAL FD (RELATIVE 2)" " " 4 -at_xfail=no -( - $as_echo "450. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - INPUT-OUTPUT SECTION. - FILE-CONTROL. - SELECT TEST-FILE - ASSIGN "TESTFILE" - ACCESS DYNAMIC - ORGANIZATION RELATIVE - STATUS TESTSTAT - RELATIVE KEY TESTKEY - . - DATA DIVISION. - FILE SECTION. - FD TEST-FILE GLOBAL. - 01 TEST-REC PIC X(4). - WORKING-STORAGE SECTION. - 01 GLOBVALS. - 03 TESTKEY PIC 9(4). - 03 TESTSTAT PIC XX. - PROCEDURE DIVISION. - MOVE "00" TO TESTSTAT. - CALL "prog2" - END-CALL. - IF TESTSTAT = "00" - DISPLAY "Not OK" - END-DISPLAY - END-IF. - STOP RUN. - IDENTIFICATION DIVISION. - PROGRAM-ID. prog2. - DATA DIVISION. - WORKING-STORAGE SECTION. - PROCEDURE DIVISION. - OPEN INPUT TEST-FILE. - EXIT PROGRAM. - END PROGRAM prog2. - END PROGRAM prog. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_fundamental.at:1689: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_fundamental.at:1689" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_fundamental.at:1689" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_fundamental.at:1690: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_fundamental.at:1690" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_fundamental.at:1690" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_450 -#AT_START_451 -at_fn_group_banner 451 'run_fundamental.at:1695' \ - "GLOBAL FD (INDEXED 2)" " " 4 -at_xfail=no -( - $as_echo "451. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -$as_echo "run_fundamental.at:1698" >"$at_check_line_file" -(test "$COB_HAS_ISAM" = "no") \ - && at_fn_check_skip 77 "$at_srcdir/run_fundamental.at:1698" - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - INPUT-OUTPUT SECTION. - FILE-CONTROL. - SELECT TEST-FILE - ASSIGN "TESTFILE" - ACCESS DYNAMIC - ORGANIZATION INDEXED - STATUS TESTSTAT - RECORD KEY TESTKEY - . - DATA DIVISION. - FILE SECTION. - FD TEST-FILE GLOBAL. - 01 TEST-REC. - 03 TESTKEY PIC X(4). - WORKING-STORAGE SECTION. - 01 GLOBVALS. - 03 TESTSTAT PIC XX. - PROCEDURE DIVISION. - MOVE "00" TO TESTSTAT. - CALL "prog2" - END-CALL. - IF TESTSTAT = "00" - DISPLAY "Not OK" - END-DISPLAY - END-IF. - STOP RUN. - IDENTIFICATION DIVISION. - PROGRAM-ID. prog2. - DATA DIVISION. - WORKING-STORAGE SECTION. - PROCEDURE DIVISION. - OPEN INPUT TEST-FILE. - EXIT PROGRAM. - END PROGRAM prog2. - END PROGRAM prog. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_fundamental.at:1741: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_fundamental.at:1741" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_fundamental.at:1741" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_fundamental.at:1742: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_fundamental.at:1742" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_fundamental.at:1742" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_451 -#AT_START_452 -at_fn_group_banner 452 'run_fundamental.at:1747' \ - "CANCEL test (1)" " " 4 -at_xfail=no -( - $as_echo "452. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - PROCEDURE DIVISION. - CANCEL "notthere". - CANCEL "prog". - DISPLAY "NG" NO ADVANCING - END-DISPLAY. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_fundamental.at:1763: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_fundamental.at:1763" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_fundamental.at:1763" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_fundamental.at:1764: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_fundamental.at:1764" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "libcob: prog.cob:8: error: attempt to CANCEL active program -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/run_fundamental.at:1764" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_fundamental.at:1767: COB_PHYSICAL_CANCEL=1 ./prog" -at_fn_check_prepare_trace "run_fundamental.at:1767" -( $at_check_trace; COB_PHYSICAL_CANCEL=1 ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "libcob: prog.cob:8: error: attempt to CANCEL active program -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/run_fundamental.at:1767" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_452 -#AT_START_453 -at_fn_group_banner 453 'run_fundamental.at:1774' \ - "CANCEL test (2)" " " 4 -at_xfail=no -( - $as_echo "453. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - PROCEDURE DIVISION. - CALL "prog2" - END-CALL. - DISPLAY "NG" NO ADVANCING - END-DISPLAY. - STOP RUN. -_ATEOF - - -cat >prog2.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog2. - DATA DIVISION. - WORKING-STORAGE SECTION. - PROCEDURE DIVISION. - CANCEL "prog". - DISPLAY "NG" NO ADVANCING - END-DISPLAY. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_fundamental.at:1802: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_fundamental.at:1802" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_fundamental.at:1802" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_fundamental.at:1803: \$COMPILE_MODULE prog2.cob" -at_fn_check_prepare_dynamic "$COMPILE_MODULE prog2.cob" "run_fundamental.at:1803" -( $at_check_trace; $COMPILE_MODULE prog2.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_fundamental.at:1803" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_fundamental.at:1804: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_fundamental.at:1804" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "libcob: prog2.cob:7: error: attempt to CANCEL active program -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/run_fundamental.at:1804" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_fundamental.at:1807: COB_PHYSICAL_CANCEL=1 ./prog" -at_fn_check_prepare_trace "run_fundamental.at:1807" -( $at_check_trace; COB_PHYSICAL_CANCEL=1 ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "libcob: prog2.cob:7: error: attempt to CANCEL active program -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/run_fundamental.at:1807" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_453 -#AT_START_454 -at_fn_group_banner 454 'run_fundamental.at:1814' \ - "CANCEL test (3)" " " 4 -at_xfail=no -( - $as_echo "454. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - PROCEDURE DIVISION. - CALL "prog2" - END-CALL. - CALL "prog2" - END-CALL. - CANCEL "prog2". - CALL "prog2" - END-CALL. - CANCEL "prog2". - DISPLAY "NG" NO ADVANCING - END-DISPLAY. - STOP RUN. -_ATEOF - - -cat >prog2.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog2. - DATA DIVISION. - WORKING-STORAGE SECTION. - 77 VAR PIC 9(01) value 1. - PROCEDURE DIVISION. - DISPLAY VAR NO ADVANCING - END-DISPLAY. - ADD 1 TO VAR END-ADD. - GOBACK. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_fundamental.at:1849: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_fundamental.at:1849" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_fundamental.at:1849" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_fundamental.at:1850: \$COMPILE_MODULE prog2.cob" -at_fn_check_prepare_dynamic "$COMPILE_MODULE prog2.cob" "run_fundamental.at:1850" -( $at_check_trace; $COMPILE_MODULE prog2.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_fundamental.at:1850" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_fundamental.at:1851: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_fundamental.at:1851" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo "121NG" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_fundamental.at:1851" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_fundamental.at:1852: COB_PHYSICAL_CANCEL=1 ./prog" -at_fn_check_prepare_trace "run_fundamental.at:1852" -( $at_check_trace; COB_PHYSICAL_CANCEL=1 ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo "121NG" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_fundamental.at:1852" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_454 -#AT_START_455 -at_fn_group_banner 455 'run_fundamental.at:1857' \ - "Separate sign positions (1)" " " 4 -at_xfail=no -( - $as_echo "455. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 X PIC S9 VALUE -1 SIGN LEADING SEPARATE. - 01 Y PIC S9 VALUE -1 SIGN TRAILING SEPARATE. - PROCEDURE DIVISION. - DISPLAY X(1:1) X(2:1) NO ADVANCING - END-DISPLAY. - DISPLAY Y(1:1) Y(2:1) NO ADVANCING - END-DISPLAY. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_fundamental.at:1875: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_fundamental.at:1875" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_fundamental.at:1875" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_fundamental.at:1876: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_fundamental.at:1876" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo "-11-" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_fundamental.at:1876" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_455 -#AT_START_456 -at_fn_group_banner 456 'run_fundamental.at:1881' \ - "Separate sign positions (2)" " " 4 -at_xfail=no -( - $as_echo "456. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 X PIC S9 SIGN LEADING SEPARATE. - 01 Y PIC S9 SIGN TRAILING SEPARATE. - PROCEDURE DIVISION. - MOVE 0 TO X. - DISPLAY X NO ADVANCING - END-DISPLAY. - MOVE ZERO TO X. - DISPLAY X NO ADVANCING - END-DISPLAY. - MOVE 0 TO Y. - DISPLAY Y NO ADVANCING - END-DISPLAY. - MOVE ZERO TO Y. - DISPLAY Y NO ADVANCING - END-DISPLAY. - STOP RUN. -_ATEOF - -{ set +x -$as_echo "$at_srcdir/run_fundamental.at:1906: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_fundamental.at:1906" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_fundamental.at:1906" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_fundamental.at:1907: \$COMPILE_MODULE -fpretty-display prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_MODULE -fpretty-display prog.cob" "run_fundamental.at:1907" -( $at_check_trace; $COMPILE_MODULE -fpretty-display prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_fundamental.at:1907" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_fundamental.at:1908: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_fundamental.at:1908" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo "+0+00+0+" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_fundamental.at:1908" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_fundamental.at:1909: \$COBCRUN prog" -at_fn_check_prepare_dynamic "$COBCRUN prog" "run_fundamental.at:1909" -( $at_check_trace; $COBCRUN prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo "+0+00+0+" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_fundamental.at:1909" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_456 -#AT_START_457 -at_fn_group_banner 457 'run_fundamental.at:1914' \ - "Context sensitive words (1)" " " 4 -at_xfail=no -( - $as_echo "457. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 BYTE-LENGTH PIC 9. - 01 X CONSTANT AS BYTE-LENGTH OF BYTE-LENGTH. - PROCEDURE DIVISION. - MOVE X TO BYTE-LENGTH. - DISPLAY BYTE-LENGTH NO ADVANCING - END-DISPLAY. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_fundamental.at:1931: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_fundamental.at:1931" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_fundamental.at:1931" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_fundamental.at:1932: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_fundamental.at:1932" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo "1" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_fundamental.at:1932" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_457 -#AT_START_458 -at_fn_group_banner 458 'run_fundamental.at:1937' \ - "Context sensitive words (2)" " " 4 -at_xfail=no -( - $as_echo "458. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 YYYYMMDD PIC 9 VALUE 0. - 01 X PIC X(16). - PROCEDURE DIVISION. - ACCEPT X FROM DATE YYYYMMDD - END-ACCEPT. - DISPLAY YYYYMMDD NO ADVANCING - END-DISPLAY. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_fundamental.at:1955: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_fundamental.at:1955" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_fundamental.at:1955" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_fundamental.at:1956: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_fundamental.at:1956" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo "0" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_fundamental.at:1956" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_458 -#AT_START_459 -at_fn_group_banner 459 'run_fundamental.at:1961' \ - "Context sensitive words (3)" " " 4 -at_xfail=no -( - $as_echo "459. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 YYYYDDD PIC 9 VALUE 0. - 01 X PIC X(16). - PROCEDURE DIVISION. - ACCEPT X FROM DAY YYYYDDD - END-ACCEPT. - DISPLAY YYYYDDD NO ADVANCING - END-DISPLAY. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_fundamental.at:1979: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_fundamental.at:1979" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_fundamental.at:1979" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_fundamental.at:1980: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_fundamental.at:1980" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo "0" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_fundamental.at:1980" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_459 -#AT_START_460 -at_fn_group_banner 460 'run_fundamental.at:1985' \ - "Context sensitive words (4)" " " 4 -at_xfail=no -( - $as_echo "460. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - CONFIGURATION SECTION. - REPOSITORY. - FUNCTION ALL INTRINSIC. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 INTRINSIC PIC 9 VALUE 0. - PROCEDURE DIVISION. - DISPLAY INTRINSIC NO ADVANCING - END-DISPLAY. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_fundamental.at:2004: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_fundamental.at:2004" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_fundamental.at:2004" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_fundamental.at:2005: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_fundamental.at:2005" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo "0" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_fundamental.at:2005" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_460 -#AT_START_461 -at_fn_group_banner 461 'run_fundamental.at:2010' \ - "Context sensitive words (5)" " " 4 -at_xfail=no -( - $as_echo "461. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog RECURSIVE. - ENVIRONMENT DIVISION. - CONFIGURATION SECTION. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 RECURSIVE PIC 9 VALUE 0. - PROCEDURE DIVISION. - DISPLAY RECURSIVE NO ADVANCING - END-DISPLAY. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_fundamental.at:2027: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_fundamental.at:2027" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_fundamental.at:2027" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_fundamental.at:2028: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_fundamental.at:2028" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo "0" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_fundamental.at:2028" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_461 -#AT_START_462 -at_fn_group_banner 462 'run_fundamental.at:2033' \ - "Context sensitive words (6)" " " 4 -at_xfail=no -( - $as_echo "462. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - CONFIGURATION SECTION. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 NORMAL PIC 9 VALUE 0. - PROCEDURE DIVISION. - DISPLAY NORMAL NO ADVANCING *> Intentionally no period or END-DISPLAY - STOP RUN NORMAL. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_fundamental.at:2049: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_fundamental.at:2049" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_fundamental.at:2049" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_fundamental.at:2050: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_fundamental.at:2050" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo "0" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_fundamental.at:2050" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_462 -#AT_START_463 -at_fn_group_banner 463 'run_fundamental.at:2055' \ - "Context sensitive words (7)" " " 4 -at_xfail=no -( - $as_echo "463. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - CONFIGURATION SECTION. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 X PIC 9 VALUE 0. - 01 AWAY-FROM-ZERO PIC 9 VALUE 0. - PROCEDURE DIVISION. - COMPUTE X ROUNDED MODE AWAY-FROM-ZERO - AWAY-FROM-ZERO = 1.1 - END-COMPUTE - DISPLAY X AWAY-FROM-ZERO NO ADVANCING - END-DISPLAY. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_fundamental.at:2076: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_fundamental.at:2076" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_fundamental.at:2076" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_fundamental.at:2077: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_fundamental.at:2077" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo "21" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_fundamental.at:2077" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_463 -#AT_START_464 -at_fn_group_banner 464 'run_fundamental.at:2082' \ - "Context sensitive words (8)" " " 4 -at_xfail=no -( - $as_echo "464. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - CONFIGURATION SECTION. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 UNBOUNDED. - 03 ATTRIBUTES PIC 9 VALUE 0. - 01 LOC. - 03 NAMESPACE PIC 9 VALUE 1. - PROCEDURE DIVISION. - DISPLAY UNBOUNDED ATTRIBUTES - NAMESPACE IN LOC - NO ADVANCING. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_fundamental.at:2103: \$COMPILE -std=ibm-strict prog.cob" -at_fn_check_prepare_dynamic "$COMPILE -std=ibm-strict prog.cob" "run_fundamental.at:2103" -( $at_check_trace; $COMPILE -std=ibm-strict prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_fundamental.at:2103" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_fundamental.at:2104: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_fundamental.at:2104" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo "001" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_fundamental.at:2104" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_464 -#AT_START_465 -at_fn_group_banner 465 'run_fundamental.at:2109' \ - "ROUNDED AWAY-FROM-ZERO" " " 4 -at_xfail=no -( - $as_echo "465. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 M PIC S9. - 01 N PIC S9. - 01 O PIC S9. - 01 P PIC S9. - 01 Q PIC S9. - 01 R PIC S9. - 01 S PIC S9. - 01 T PIC S9. - 01 U PIC S9. - 01 V PIC S9. - PROCEDURE DIVISION. - COMPUTE M ROUNDED MODE AWAY-FROM-ZERO - = 2.49 - END-COMPUTE - COMPUTE N ROUNDED MODE AWAY-FROM-ZERO - = -2.49 - END-COMPUTE - COMPUTE O ROUNDED MODE AWAY-FROM-ZERO - = 2.50 - END-COMPUTE - COMPUTE P ROUNDED MODE AWAY-FROM-ZERO - = -2.50 - END-COMPUTE - COMPUTE Q ROUNDED MODE AWAY-FROM-ZERO - = 3.49 - END-COMPUTE - COMPUTE R ROUNDED MODE AWAY-FROM-ZERO - = -3.49 - END-COMPUTE - COMPUTE S ROUNDED MODE AWAY-FROM-ZERO - = 3.50 - END-COMPUTE - COMPUTE T ROUNDED MODE AWAY-FROM-ZERO - = -3.50 - END-COMPUTE - COMPUTE U ROUNDED MODE AWAY-FROM-ZERO - = 3.510 - END-COMPUTE - COMPUTE V ROUNDED MODE AWAY-FROM-ZERO - = -3.510 - END-COMPUTE - DISPLAY M " " N " " O " " P " " Q " " R " " S " " T - " " U " " V - NO ADVANCING - END-DISPLAY - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_fundamental.at:2166: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_fundamental.at:2166" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_fundamental.at:2166" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_fundamental.at:2167: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_fundamental.at:2167" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo "+3 -3 +3 -3 +4 -4 +4 -4 +4 -4" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_fundamental.at:2167" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_465 -#AT_START_466 -at_fn_group_banner 466 'run_fundamental.at:2172' \ - "ROUNDED NEAREST-AWAY-FROM-ZERO" " " 4 -at_xfail=no -( - $as_echo "466. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 M PIC S9. - 01 N PIC S9. - 01 O PIC S9. - 01 P PIC S9. - 01 Q PIC S9. - 01 R PIC S9. - 01 S PIC S9. - 01 T PIC S9. - 01 U PIC S9. - 01 V PIC S9. - PROCEDURE DIVISION. - COMPUTE M ROUNDED MODE NEAREST-AWAY-FROM-ZERO - = 2.49 - END-COMPUTE - COMPUTE N ROUNDED MODE NEAREST-AWAY-FROM-ZERO - = -2.49 - END-COMPUTE - COMPUTE O ROUNDED MODE NEAREST-AWAY-FROM-ZERO - = 2.50 - END-COMPUTE - COMPUTE P ROUNDED MODE NEAREST-AWAY-FROM-ZERO - = -2.50 - END-COMPUTE - COMPUTE Q ROUNDED MODE NEAREST-AWAY-FROM-ZERO - = 3.49 - END-COMPUTE - COMPUTE R ROUNDED MODE NEAREST-AWAY-FROM-ZERO - = -3.49 - END-COMPUTE - COMPUTE S ROUNDED MODE NEAREST-AWAY-FROM-ZERO - = 3.50 - END-COMPUTE - COMPUTE T ROUNDED MODE NEAREST-AWAY-FROM-ZERO - = -3.50 - END-COMPUTE - COMPUTE U ROUNDED MODE NEAREST-AWAY-FROM-ZERO - = 3.510 - END-COMPUTE - COMPUTE V ROUNDED MODE NEAREST-AWAY-FROM-ZERO - = -3.510 - END-COMPUTE - DISPLAY M " " N " " O " " P " " Q " " R " " S " " T - " " U " " V - NO ADVANCING - END-DISPLAY - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_fundamental.at:2229: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_fundamental.at:2229" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_fundamental.at:2229" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_fundamental.at:2230: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_fundamental.at:2230" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo "+2 -2 +3 -3 +3 -3 +4 -4 +4 -4" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_fundamental.at:2230" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_466 -#AT_START_467 -at_fn_group_banner 467 'run_fundamental.at:2235' \ - "ROUNDED NEAREST-EVEN" " " 4 -at_xfail=no -( - $as_echo "467. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 M PIC S9. - 01 N PIC S9. - 01 O PIC S9. - 01 P PIC S9. - 01 Q PIC S9. - 01 R PIC S9. - 01 S PIC S9. - 01 T PIC S9. - 01 U PIC S9. - 01 V PIC S9. - PROCEDURE DIVISION. - COMPUTE M ROUNDED MODE NEAREST-EVEN - = 2.49 - END-COMPUTE - COMPUTE N ROUNDED MODE NEAREST-EVEN - = -2.49 - END-COMPUTE - COMPUTE O ROUNDED MODE NEAREST-EVEN - = 2.50 - END-COMPUTE - COMPUTE P ROUNDED MODE NEAREST-EVEN - = -2.50 - END-COMPUTE - COMPUTE Q ROUNDED MODE NEAREST-EVEN - = 3.49 - END-COMPUTE - COMPUTE R ROUNDED MODE NEAREST-EVEN - = -3.49 - END-COMPUTE - COMPUTE S ROUNDED MODE NEAREST-EVEN - = 3.50 - END-COMPUTE - COMPUTE T ROUNDED MODE NEAREST-EVEN - = -3.50 - END-COMPUTE - COMPUTE U ROUNDED MODE NEAREST-EVEN - = 3.510 - END-COMPUTE - COMPUTE V ROUNDED MODE NEAREST-EVEN - = -3.510 - END-COMPUTE - DISPLAY M " " N " " O " " P " " Q " " R " " S " " T - " " U " " V - NO ADVANCING - END-DISPLAY - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_fundamental.at:2292: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_fundamental.at:2292" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_fundamental.at:2292" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_fundamental.at:2293: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_fundamental.at:2293" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo "+2 -2 +2 -2 +3 -3 +4 -4 +4 -4" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_fundamental.at:2293" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_467 -#AT_START_468 -at_fn_group_banner 468 'run_fundamental.at:2298' \ - "ROUNDED NEAREST-TOWARD-ZERO" " " 4 -at_xfail=no -( - $as_echo "468. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 M PIC S9. - 01 N PIC S9. - 01 O PIC S9. - 01 P PIC S9. - 01 Q PIC S9. - 01 R PIC S9. - 01 S PIC S9. - 01 T PIC S9. - 01 U PIC S9. - 01 V PIC S9. - PROCEDURE DIVISION. - COMPUTE M ROUNDED MODE NEAREST-TOWARD-ZERO - = 2.49 - END-COMPUTE - COMPUTE N ROUNDED MODE NEAREST-TOWARD-ZERO - = -2.49 - END-COMPUTE - COMPUTE O ROUNDED MODE NEAREST-TOWARD-ZERO - = 2.50 - END-COMPUTE - COMPUTE P ROUNDED MODE NEAREST-TOWARD-ZERO - = -2.50 - END-COMPUTE - COMPUTE Q ROUNDED MODE NEAREST-TOWARD-ZERO - = 3.49 - END-COMPUTE - COMPUTE R ROUNDED MODE NEAREST-TOWARD-ZERO - = -3.49 - END-COMPUTE - COMPUTE S ROUNDED MODE NEAREST-TOWARD-ZERO - = 3.50 - END-COMPUTE - COMPUTE T ROUNDED MODE NEAREST-TOWARD-ZERO - = -3.50 - END-COMPUTE - COMPUTE U ROUNDED MODE NEAREST-TOWARD-ZERO - = 3.510 - END-COMPUTE - COMPUTE V ROUNDED MODE NEAREST-TOWARD-ZERO - = -3.510 - END-COMPUTE - DISPLAY M " " N " " O " " P " " Q " " R " " S " " T - " " U " " V - NO ADVANCING - END-DISPLAY - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_fundamental.at:2355: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_fundamental.at:2355" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_fundamental.at:2355" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_fundamental.at:2356: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_fundamental.at:2356" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo "+2 -2 +2 -2 +3 -3 +3 -3 +4 -4" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_fundamental.at:2356" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_468 -#AT_START_469 -at_fn_group_banner 469 'run_fundamental.at:2361' \ - "ROUNDED TOWARD-GREATER" " " 4 -at_xfail=no -( - $as_echo "469. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 M PIC S9. - 01 N PIC S9. - 01 O PIC S9. - 01 P PIC S9. - 01 Q PIC S9. - 01 R PIC S9. - 01 S PIC S9. - 01 T PIC S9. - 01 U PIC S9. - 01 V PIC S9. - PROCEDURE DIVISION. - COMPUTE M ROUNDED MODE TOWARD-GREATER - = 2.49 - END-COMPUTE - COMPUTE N ROUNDED MODE TOWARD-GREATER - = -2.49 - END-COMPUTE - COMPUTE O ROUNDED MODE TOWARD-GREATER - = 2.50 - END-COMPUTE - COMPUTE P ROUNDED MODE TOWARD-GREATER - = -2.50 - END-COMPUTE - COMPUTE Q ROUNDED MODE TOWARD-GREATER - = 3.49 - END-COMPUTE - COMPUTE R ROUNDED MODE TOWARD-GREATER - = -3.49 - END-COMPUTE - COMPUTE S ROUNDED MODE TOWARD-GREATER - = 3.50 - END-COMPUTE - COMPUTE T ROUNDED MODE TOWARD-GREATER - = -3.50 - END-COMPUTE - COMPUTE U ROUNDED MODE TOWARD-GREATER - = 3.510 - END-COMPUTE - COMPUTE V ROUNDED MODE TOWARD-GREATER - = -3.510 - END-COMPUTE - DISPLAY M " " N " " O " " P " " Q " " R " " S " " T - " " U " " V - NO ADVANCING - END-DISPLAY - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_fundamental.at:2418: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_fundamental.at:2418" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_fundamental.at:2418" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_fundamental.at:2419: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_fundamental.at:2419" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo "+3 -2 +3 -2 +4 -3 +4 -3 +4 -3" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_fundamental.at:2419" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_469 -#AT_START_470 -at_fn_group_banner 470 'run_fundamental.at:2424' \ - "ROUNDED TOWARD-LESSER" " " 4 -at_xfail=no -( - $as_echo "470. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 M PIC S9. - 01 N PIC S9. - 01 O PIC S9. - 01 P PIC S9. - 01 Q PIC S9. - 01 R PIC S9. - 01 S PIC S9. - 01 T PIC S9. - 01 U PIC S9. - 01 V PIC S9. - PROCEDURE DIVISION. - COMPUTE M ROUNDED MODE TOWARD-LESSER - = 2.49 - END-COMPUTE - COMPUTE N ROUNDED MODE TOWARD-LESSER - = -2.49 - END-COMPUTE - COMPUTE O ROUNDED MODE TOWARD-LESSER - = 2.50 - END-COMPUTE - COMPUTE P ROUNDED MODE TOWARD-LESSER - = -2.50 - END-COMPUTE - COMPUTE Q ROUNDED MODE TOWARD-LESSER - = 3.49 - END-COMPUTE - COMPUTE R ROUNDED MODE TOWARD-LESSER - = -3.49 - END-COMPUTE - COMPUTE S ROUNDED MODE TOWARD-LESSER - = 3.50 - END-COMPUTE - COMPUTE T ROUNDED MODE TOWARD-LESSER - = -3.50 - END-COMPUTE - COMPUTE U ROUNDED MODE TOWARD-LESSER - = 3.510 - END-COMPUTE - COMPUTE V ROUNDED MODE TOWARD-LESSER - = -3.510 - END-COMPUTE - DISPLAY M " " N " " O " " P " " Q " " R " " S " " T - " " U " " V - NO ADVANCING - END-DISPLAY - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_fundamental.at:2481: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_fundamental.at:2481" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_fundamental.at:2481" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_fundamental.at:2482: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_fundamental.at:2482" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo "+2 -3 +2 -3 +3 -4 +3 -4 +3 -4" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_fundamental.at:2482" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_470 -#AT_START_471 -at_fn_group_banner 471 'run_fundamental.at:2487' \ - "ROUNDED TRUNCATION" " " 4 -at_xfail=no -( - $as_echo "471. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 M PIC S9. - 01 N PIC S9. - 01 O PIC S9. - 01 P PIC S9. - 01 Q PIC S9. - 01 R PIC S9. - 01 S PIC S9. - 01 T PIC S9. - 01 U PIC S9. - 01 V PIC S9. - PROCEDURE DIVISION. - COMPUTE M ROUNDED MODE TRUNCATION - = 2.49 - END-COMPUTE - COMPUTE N ROUNDED MODE TRUNCATION - = -2.49 - END-COMPUTE - COMPUTE O ROUNDED MODE TRUNCATION - = 2.50 - END-COMPUTE - COMPUTE P ROUNDED MODE TRUNCATION - = -2.50 - END-COMPUTE - COMPUTE Q ROUNDED MODE TRUNCATION - = 3.49 - END-COMPUTE - COMPUTE R ROUNDED MODE TRUNCATION - = -3.49 - END-COMPUTE - COMPUTE S ROUNDED MODE TRUNCATION - = 3.50 - END-COMPUTE - COMPUTE T ROUNDED MODE TRUNCATION - = -3.50 - END-COMPUTE - COMPUTE U ROUNDED MODE TRUNCATION - = 3.510 - END-COMPUTE - COMPUTE V ROUNDED MODE TRUNCATION - = -3.510 - END-COMPUTE - DISPLAY M " " N " " O " " P " " Q " " R " " S " " T - " " U " " V - NO ADVANCING - END-DISPLAY - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_fundamental.at:2544: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_fundamental.at:2544" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_fundamental.at:2544" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_fundamental.at:2545: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_fundamental.at:2545" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo "+2 -2 +2 -2 +3 -3 +3 -3 +3 -3" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_fundamental.at:2545" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_471 -#AT_START_472 -at_fn_group_banner 472 'run_fundamental.at:2550' \ - "Numeric operations (1)" " " 4 -at_xfail=no -( - $as_echo "472. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 X PIC S9V9. - 01 Y PIC S9V9 COMP-3. - PROCEDURE DIVISION. - MOVE -0.1 TO X. - ADD 1 TO X. - IF X NOT = 0.9 - DISPLAY X - END-DISPLAY - END-IF. - MOVE 0.1 TO X. - SUBTRACT 1 FROM X. - IF X NOT = -0.9 - DISPLAY X - END-DISPLAY - END-IF. - MOVE -0.1 TO Y. - ADD 1 TO Y. - IF Y NOT = 0.9 - DISPLAY Y - END-DISPLAY - END-IF. - MOVE 0.1 TO Y. - SUBTRACT 1 FROM Y. - IF Y NOT = -0.9 - DISPLAY Y - END-DISPLAY - END-IF. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_fundamental.at:2588: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_fundamental.at:2588" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_fundamental.at:2588" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_fundamental.at:2589: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_fundamental.at:2589" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_fundamental.at:2589" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_472 -#AT_START_473 -at_fn_group_banner 473 'run_fundamental.at:2594' \ - "Numeric operations (2)" " " 4 -at_xfail=no -( - $as_echo "473. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 FIELD PIC S9(1)V9(1). - 01 FELD2 PIC S9(5)V9(5). - 01 FELD3 PIC 9(1)V9(1). - 01 FELD4 PIC S9(1). - PROCEDURE DIVISION. - MOVE 0.2 TO FIELD - ADD 1 TO FIELD - IF FIELD NOT = 1.2 - DISPLAY "Test 1 " FIELD - END-DISPLAY - END-IF. - - MOVE 0.2 TO FIELD - ADD -1 TO FIELD - IF FIELD NOT = -0.8 - DISPLAY "Test 2 " FIELD - END-DISPLAY - END-IF. - - MOVE -0.2 TO FIELD - ADD 1 TO FIELD - IF FIELD NOT = 0.8 - DISPLAY "Test 3 " FIELD - END-DISPLAY - END-IF. - - MOVE -0.2 TO FIELD - ADD -1 TO FIELD - IF FIELD NOT = -1.2 - DISPLAY "Test 4 " FIELD - END-DISPLAY - END-IF. - - MOVE 0.2 TO FIELD - SUBTRACT 1 FROM FIELD - IF FIELD NOT = -0.8 - DISPLAY "Test 5 " FIELD - END-DISPLAY - END-IF. - - MOVE 0.2 TO FIELD - SUBTRACT -1 FROM FIELD - IF FIELD NOT = 1.2 - DISPLAY "Test 6 " FIELD - END-DISPLAY - END-IF. - - MOVE -0.2 TO FIELD - SUBTRACT 1 FROM FIELD - IF FIELD NOT = -1.2 - DISPLAY "Test 7 " FIELD - END-DISPLAY - END-IF. - - MOVE -0.2 TO FIELD - SUBTRACT -1 FROM FIELD - IF FIELD NOT = 0.8 - DISPLAY "Test 8 " FIELD - END-DISPLAY - END-IF. - - MOVE 0.2 TO FELD2 - ADD 1 TO FELD2 - IF FELD2 NOT = 1.2 - DISPLAY "Test 9 " FELD2 - END-DISPLAY - END-IF. - - MOVE 0.2 TO FELD2 - ADD -1 TO FELD2 - IF FELD2 NOT = -0.8 - DISPLAY "Test 10 " FELD2 - END-DISPLAY - END-IF. - - MOVE -0.2 TO FELD2 - ADD 1 TO FELD2 - IF FELD2 NOT = 0.8 - DISPLAY "Test 11 " FELD2 - END-DISPLAY - END-IF. - - MOVE -0.2 TO FELD2 - ADD -1 TO FELD2 - IF FELD2 NOT = -1.2 - DISPLAY "Test 12 " FELD2 - END-DISPLAY - END-IF. - - MOVE 0.2 TO FELD2 - SUBTRACT 1 FROM FELD2 - IF FELD2 NOT = -0.8 - DISPLAY "Test 13 " FELD2 - END-DISPLAY - END-IF. - - MOVE 0.2 TO FELD2 - SUBTRACT -1 FROM FELD2 - IF FELD2 NOT = 1.2 - DISPLAY "Test 14 " FELD2 - END-DISPLAY - END-IF. - - MOVE -0.2 TO FELD2 - SUBTRACT 1 FROM FELD2 - IF FELD2 NOT = -1.2 - DISPLAY "Test 15 " FELD2 - END-DISPLAY - END-IF. - - MOVE -0.2 TO FELD2 - SUBTRACT -1 FROM FELD2 - IF FELD2 NOT = 0.8 - DISPLAY "Test 16 " FELD2 - END-DISPLAY - END-IF. - - MOVE 0.2 TO FELD3 - ADD 1 TO FELD3 - IF FELD3 NOT = 1.2 - DISPLAY "Test 17 " FELD3 - END-DISPLAY - END-IF. - - MOVE 0.2 TO FELD3 - ADD -1 TO FELD3 - IF FELD3 NOT = 0.8 - DISPLAY "Test 18 " FELD3 - END-DISPLAY - END-IF. - - MOVE -0.2 TO FELD3 - ADD 1 TO FELD3 - IF FELD3 NOT = 1.2 - DISPLAY "Test 19 " FELD3 - END-DISPLAY - END-IF. - - MOVE -0.2 TO FELD3 - ADD -1 TO FELD3 - IF FELD3 NOT = 0.8 - DISPLAY "Test 20 " FELD3 - END-DISPLAY - END-IF. - - MOVE 0.2 TO FELD3 - SUBTRACT 1 FROM FELD3 - IF FELD3 NOT = 0.8 - DISPLAY "Test 21 " FELD3 - END-DISPLAY - END-IF. - - MOVE 0.2 TO FELD3 - SUBTRACT -1 FROM FELD3 - IF FELD3 NOT = 1.2 - DISPLAY "Test 22 " FELD3 - END-DISPLAY - END-IF. - - MOVE -0.2 TO FELD3 - SUBTRACT 1 FROM FELD3 - IF FELD3 NOT = 0.8 - DISPLAY "Test 23 " FELD3 - END-DISPLAY - END-IF. - - MOVE -0.2 TO FELD3 - SUBTRACT -1 FROM FELD3 - IF FELD3 NOT = 1.2 - DISPLAY "Test 24 " FELD3 - END-DISPLAY - END-IF. - - MOVE 2 TO FELD4 - ADD 1 TO FELD4 - IF FELD4 NOT = 3 - DISPLAY "Test 25 " FELD4 - END-DISPLAY - END-IF. - - MOVE 2 TO FELD4 - ADD -1 TO FELD4 - IF FELD4 NOT = 1 - DISPLAY "Test 26 " FELD4 - END-DISPLAY - END-IF. - - MOVE -2 TO FELD4 - ADD 1 TO FELD4 - IF FELD4 NOT = -1 - DISPLAY "Test 27 " FELD4 - END-DISPLAY - END-IF. - - MOVE -2 TO FELD4 - ADD -1 TO FELD4 - IF FELD4 NOT = -3 - DISPLAY "Test 28 " FELD4 - END-DISPLAY - END-IF. - - MOVE 2 TO FELD4 - SUBTRACT 1 FROM FELD4 - IF FELD4 NOT = 1 - DISPLAY "Test 29 " FELD4 - END-DISPLAY - END-IF. - - MOVE 2 TO FELD4 - SUBTRACT -1 FROM FELD4 - IF FELD4 NOT = 3 - DISPLAY "Test 30 " FELD4 - END-DISPLAY - END-IF. - - MOVE -2 TO FELD4 - SUBTRACT 1 FROM FELD4 - IF FELD4 NOT = -3 - DISPLAY "Test 31 " FELD4 - END-DISPLAY - END-IF. - - MOVE -2 TO FELD4 - SUBTRACT -1 FROM FELD4 - IF FELD4 NOT = -1 - DISPLAY "Test 32 " FELD4 - END-DISPLAY - END-IF. - - MOVE 1 TO FELD4 - ADD 2 TO FELD4 - IF FELD4 NOT = 3 - DISPLAY "Test 33 " FELD4 - END-DISPLAY - END-IF. - - MOVE 1 TO FELD4 - ADD -2 TO FELD4 - IF FELD4 NOT = -1 - DISPLAY "Test 34 " FELD4 - END-DISPLAY - END-IF. - - MOVE -1 TO FELD4 - ADD 2 TO FELD4 - IF FELD4 NOT = 1 - DISPLAY "Test 35 " FELD4 - END-DISPLAY - END-IF. - - MOVE -1 TO FELD4 - ADD -2 TO FELD4 - IF FELD4 NOT = -3 - DISPLAY "Test 36 " FELD4 - END-DISPLAY - END-IF. - - MOVE 1 TO FELD4 - SUBTRACT 2 FROM FELD4 - IF FELD4 NOT = -1 - DISPLAY "Test 37 " FELD4 - END-DISPLAY - END-IF. - - MOVE 1 TO FELD4 - SUBTRACT -2 FROM FELD4 - IF FELD4 NOT = 3 - DISPLAY "Test 38 " FELD4 - END-DISPLAY - END-IF. - - MOVE -1 TO FELD4 - SUBTRACT 2 FROM FELD4 - IF FELD4 NOT = -3 - DISPLAY "Test 39 " FELD4 - END-DISPLAY - END-IF. - - MOVE -1 TO FELD4 - SUBTRACT -2 FROM FELD4 - IF FELD4 NOT = 1 - DISPLAY "Test 40 " FELD4 - END-DISPLAY - END-IF. - GOBACK. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_fundamental.at:2889: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_fundamental.at:2889" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob:137: warning: ignoring sign -prog.cob:144: warning: ignoring sign -prog.cob:165: warning: ignoring sign -prog.cob:172: warning: ignoring sign -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_fundamental.at:2889" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_fundamental.at:2895: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_fundamental.at:2895" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_fundamental.at:2895" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_473 -#AT_START_474 -at_fn_group_banner 474 'run_fundamental.at:2900' \ - "Numeric operations (3)" " " 4 -at_xfail=no -( - $as_echo "474. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 FIELD PIC S9(1)V9(1) COMP-3. - 01 FELD2 PIC S9(5)V9(5) COMP-3. - 01 FELD3 PIC 9(1)V9(1) COMP-3. - 01 FELD4 PIC S9(1) COMP-3. - PROCEDURE DIVISION. - MOVE 0.2 TO FIELD - ADD 1 TO FIELD - IF FIELD NOT = 1.2 - DISPLAY "Test 1 " FIELD - END-DISPLAY - END-IF. - - MOVE 0.2 TO FIELD - ADD -1 TO FIELD - IF FIELD NOT = -0.8 - DISPLAY "Test 2 " FIELD - END-DISPLAY - END-IF. - - MOVE -0.2 TO FIELD - ADD 1 TO FIELD - IF FIELD NOT = 0.8 - DISPLAY "Test 3 " FIELD - END-DISPLAY - END-IF. - - MOVE -0.2 TO FIELD - ADD -1 TO FIELD - IF FIELD NOT = -1.2 - DISPLAY "Test 4 " FIELD - END-DISPLAY - END-IF. - - MOVE 0.2 TO FIELD - SUBTRACT 1 FROM FIELD - IF FIELD NOT = -0.8 - DISPLAY "Test 5 " FIELD - END-DISPLAY - END-IF. - - MOVE 0.2 TO FIELD - SUBTRACT -1 FROM FIELD - IF FIELD NOT = 1.2 - DISPLAY "Test 6 " FIELD - END-DISPLAY - END-IF. - - MOVE -0.2 TO FIELD - SUBTRACT 1 FROM FIELD - IF FIELD NOT = -1.2 - DISPLAY "Test 7 " FIELD - END-DISPLAY - END-IF. - - MOVE -0.2 TO FIELD - SUBTRACT -1 FROM FIELD - IF FIELD NOT = 0.8 - DISPLAY "Test 8 " FIELD - END-DISPLAY - END-IF. - - MOVE 0.2 TO FELD2 - ADD 1 TO FELD2 - IF FELD2 NOT = 1.2 - DISPLAY "Test 9 " FELD2 - END-DISPLAY - END-IF. - - MOVE 0.2 TO FELD2 - ADD -1 TO FELD2 - IF FELD2 NOT = -0.8 - DISPLAY "Test 10 " FELD2 - END-DISPLAY - END-IF. - - MOVE -0.2 TO FELD2 - ADD 1 TO FELD2 - IF FELD2 NOT = 0.8 - DISPLAY "Test 11 " FELD2 - END-DISPLAY - END-IF. - - MOVE -0.2 TO FELD2 - ADD -1 TO FELD2 - IF FELD2 NOT = -1.2 - DISPLAY "Test 12 " FELD2 - END-DISPLAY - END-IF. - - MOVE 0.2 TO FELD2 - SUBTRACT 1 FROM FELD2 - IF FELD2 NOT = -0.8 - DISPLAY "Test 13 " FELD2 - END-DISPLAY - END-IF. - - MOVE 0.2 TO FELD2 - SUBTRACT -1 FROM FELD2 - IF FELD2 NOT = 1.2 - DISPLAY "Test 14 " FELD2 - END-DISPLAY - END-IF. - - MOVE -0.2 TO FELD2 - SUBTRACT 1 FROM FELD2 - IF FELD2 NOT = -1.2 - DISPLAY "Test 15 " FELD2 - END-DISPLAY - END-IF. - - MOVE -0.2 TO FELD2 - SUBTRACT -1 FROM FELD2 - IF FELD2 NOT = 0.8 - DISPLAY "Test 16 " FELD2 - END-DISPLAY - END-IF. - - MOVE 0.2 TO FELD3 - ADD 1 TO FELD3 - IF FELD3 NOT = 1.2 - DISPLAY "Test 17 " FELD3 - END-DISPLAY - END-IF. - - MOVE 0.2 TO FELD3 - ADD -1 TO FELD3 - IF FELD3 NOT = 0.8 - DISPLAY "Test 18 " FELD3 - END-DISPLAY - END-IF. - - MOVE -0.2 TO FELD3 - ADD 1 TO FELD3 - IF FELD3 NOT = 1.2 - DISPLAY "Test 19 " FELD3 - END-DISPLAY - END-IF. - - MOVE -0.2 TO FELD3 - ADD -1 TO FELD3 - IF FELD3 NOT = 0.8 - DISPLAY "Test 20 " FELD3 - END-DISPLAY - END-IF. - - MOVE 0.2 TO FELD3 - SUBTRACT 1 FROM FELD3 - IF FELD3 NOT = 0.8 - DISPLAY "Test 21 " FELD3 - END-DISPLAY - END-IF. - - MOVE 0.2 TO FELD3 - SUBTRACT -1 FROM FELD3 - IF FELD3 NOT = 1.2 - DISPLAY "Test 22 " FELD3 - END-DISPLAY - END-IF. - - MOVE -0.2 TO FELD3 - SUBTRACT 1 FROM FELD3 - IF FELD3 NOT = 0.8 - DISPLAY "Test 23 " FELD3 - END-DISPLAY - END-IF. - - MOVE -0.2 TO FELD3 - SUBTRACT -1 FROM FELD3 - IF FELD3 NOT = 1.2 - DISPLAY "Test 24 " FELD3 - END-DISPLAY - END-IF. - - MOVE 2 TO FELD4 - ADD 1 TO FELD4 - IF FELD4 NOT = 3 - DISPLAY "Test 25 " FELD4 - END-DISPLAY - END-IF. - - MOVE 2 TO FELD4 - ADD -1 TO FELD4 - IF FELD4 NOT = 1 - DISPLAY "Test 26 " FELD4 - END-DISPLAY - END-IF. - - MOVE -2 TO FELD4 - ADD 1 TO FELD4 - IF FELD4 NOT = -1 - DISPLAY "Test 27 " FELD4 - END-DISPLAY - END-IF. - - MOVE -2 TO FELD4 - ADD -1 TO FELD4 - IF FELD4 NOT = -3 - DISPLAY "Test 28 " FELD4 - END-DISPLAY - END-IF. - - MOVE 2 TO FELD4 - SUBTRACT 1 FROM FELD4 - IF FELD4 NOT = 1 - DISPLAY "Test 29 " FELD4 - END-DISPLAY - END-IF. - - MOVE 2 TO FELD4 - SUBTRACT -1 FROM FELD4 - IF FELD4 NOT = 3 - DISPLAY "Test 30 " FELD4 - END-DISPLAY - END-IF. - - MOVE -2 TO FELD4 - SUBTRACT 1 FROM FELD4 - IF FELD4 NOT = -3 - DISPLAY "Test 31 " FELD4 - END-DISPLAY - END-IF. - - MOVE -2 TO FELD4 - SUBTRACT -1 FROM FELD4 - IF FELD4 NOT = -1 - DISPLAY "Test 32 " FELD4 - END-DISPLAY - END-IF. - - MOVE 1 TO FELD4 - ADD 2 TO FELD4 - IF FELD4 NOT = 3 - DISPLAY "Test 33 " FELD4 - END-DISPLAY - END-IF. - - MOVE 1 TO FELD4 - ADD -2 TO FELD4 - IF FELD4 NOT = -1 - DISPLAY "Test 34 " FELD4 - END-DISPLAY - END-IF. - - MOVE -1 TO FELD4 - ADD 2 TO FELD4 - IF FELD4 NOT = 1 - DISPLAY "Test 35 " FELD4 - END-DISPLAY - END-IF. - - MOVE -1 TO FELD4 - ADD -2 TO FELD4 - IF FELD4 NOT = -3 - DISPLAY "Test 36 " FELD4 - END-DISPLAY - END-IF. - - MOVE 1 TO FELD4 - SUBTRACT 2 FROM FELD4 - IF FELD4 NOT = -1 - DISPLAY "Test 37 " FELD4 - END-DISPLAY - END-IF. - - MOVE 1 TO FELD4 - SUBTRACT -2 FROM FELD4 - IF FELD4 NOT = 3 - DISPLAY "Test 38 " FELD4 - END-DISPLAY - END-IF. - - MOVE -1 TO FELD4 - SUBTRACT 2 FROM FELD4 - IF FELD4 NOT = -3 - DISPLAY "Test 39 " FELD4 - END-DISPLAY - END-IF. - - MOVE -1 TO FELD4 - SUBTRACT -2 FROM FELD4 - IF FELD4 NOT = 1 - DISPLAY "Test 40 " FELD4 - END-DISPLAY - END-IF. - GOBACK. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_fundamental.at:3195: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_fundamental.at:3195" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob:137: warning: ignoring sign -prog.cob:144: warning: ignoring sign -prog.cob:165: warning: ignoring sign -prog.cob:172: warning: ignoring sign -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_fundamental.at:3195" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_fundamental.at:3201: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_fundamental.at:3201" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_fundamental.at:3201" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_474 -#AT_START_475 -at_fn_group_banner 475 'run_fundamental.at:3206' \ - "Numeric operations (4)" " " 4 -at_xfail=no -( - $as_echo "475. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 FIELD PIC S9(1)V9(1) COMP. - 01 FELD2 PIC S9(5)V9(5) COMP. - 01 FELD3 PIC 9(1)V9(1) COMP. - 01 FELD4 PIC S9(1) COMP. - PROCEDURE DIVISION. - MOVE 0.2 TO FIELD - ADD 1 TO FIELD - IF FIELD NOT = 1.2 - DISPLAY "Test 1 " FIELD - END-DISPLAY - END-IF. - - MOVE 0.2 TO FIELD - ADD -1 TO FIELD - IF FIELD NOT = -0.8 - DISPLAY "Test 2 " FIELD - END-DISPLAY - END-IF. - - MOVE -0.2 TO FIELD - ADD 1 TO FIELD - IF FIELD NOT = 0.8 - DISPLAY "Test 3 " FIELD - END-DISPLAY - END-IF. - - MOVE -0.2 TO FIELD - ADD -1 TO FIELD - IF FIELD NOT = -1.2 - DISPLAY "Test 4 " FIELD - END-DISPLAY - END-IF. - - MOVE 0.2 TO FIELD - SUBTRACT 1 FROM FIELD - IF FIELD NOT = -0.8 - DISPLAY "Test 5 " FIELD - END-DISPLAY - END-IF. - - MOVE 0.2 TO FIELD - SUBTRACT -1 FROM FIELD - IF FIELD NOT = 1.2 - DISPLAY "Test 6 " FIELD - END-DISPLAY - END-IF. - - MOVE -0.2 TO FIELD - SUBTRACT 1 FROM FIELD - IF FIELD NOT = -1.2 - DISPLAY "Test 7 " FIELD - END-DISPLAY - END-IF. - - MOVE -0.2 TO FIELD - SUBTRACT -1 FROM FIELD - IF FIELD NOT = 0.8 - DISPLAY "Test 8 " FIELD - END-DISPLAY - END-IF. - - MOVE 0.2 TO FELD2 - ADD 1 TO FELD2 - IF FELD2 NOT = 1.2 - DISPLAY "Test 9 " FELD2 - END-DISPLAY - END-IF. - - MOVE 0.2 TO FELD2 - ADD -1 TO FELD2 - IF FELD2 NOT = -0.8 - DISPLAY "Test 10 " FELD2 - END-DISPLAY - END-IF. - - MOVE -0.2 TO FELD2 - ADD 1 TO FELD2 - IF FELD2 NOT = 0.8 - DISPLAY "Test 11 " FELD2 - END-DISPLAY - END-IF. - - MOVE -0.2 TO FELD2 - ADD -1 TO FELD2 - IF FELD2 NOT = -1.2 - DISPLAY "Test 12 " FELD2 - END-DISPLAY - END-IF. - - MOVE 0.2 TO FELD2 - SUBTRACT 1 FROM FELD2 - IF FELD2 NOT = -0.8 - DISPLAY "Test 13 " FELD2 - END-DISPLAY - END-IF. - - MOVE 0.2 TO FELD2 - SUBTRACT -1 FROM FELD2 - IF FELD2 NOT = 1.2 - DISPLAY "Test 14 " FELD2 - END-DISPLAY - END-IF. - - MOVE -0.2 TO FELD2 - SUBTRACT 1 FROM FELD2 - IF FELD2 NOT = -1.2 - DISPLAY "Test 15 " FELD2 - END-DISPLAY - END-IF. - - MOVE -0.2 TO FELD2 - SUBTRACT -1 FROM FELD2 - IF FELD2 NOT = 0.8 - DISPLAY "Test 16 " FELD2 - END-DISPLAY - END-IF. - - MOVE 0.2 TO FELD3 - ADD 1 TO FELD3 - IF FELD3 NOT = 1.2 - DISPLAY "Test 17 " FELD3 - END-DISPLAY - END-IF. - - MOVE 0.2 TO FELD3 - ADD -1 TO FELD3 - IF FELD3 NOT = 0.8 - DISPLAY "Test 18 " FELD3 - END-DISPLAY - END-IF. - - MOVE -0.2 TO FELD3 - ADD 1 TO FELD3 - IF FELD3 NOT = 1.2 - DISPLAY "Test 19 " FELD3 - END-DISPLAY - END-IF. - - MOVE -0.2 TO FELD3 - ADD -1 TO FELD3 - IF FELD3 NOT = 0.8 - DISPLAY "Test 20 " FELD3 - END-DISPLAY - END-IF. - - MOVE 0.2 TO FELD3 - SUBTRACT 1 FROM FELD3 - IF FELD3 NOT = 0.8 - DISPLAY "Test 21 " FELD3 - END-DISPLAY - END-IF. - - MOVE 0.2 TO FELD3 - SUBTRACT -1 FROM FELD3 - IF FELD3 NOT = 1.2 - DISPLAY "Test 22 " FELD3 - END-DISPLAY - END-IF. - - MOVE -0.2 TO FELD3 - SUBTRACT 1 FROM FELD3 - IF FELD3 NOT = 0.8 - DISPLAY "Test 23 " FELD3 - END-DISPLAY - END-IF. - - MOVE -0.2 TO FELD3 - SUBTRACT -1 FROM FELD3 - IF FELD3 NOT = 1.2 - DISPLAY "Test 24 " FELD3 - END-DISPLAY - END-IF. - - MOVE 2 TO FELD4 - ADD 1 TO FELD4 - IF FELD4 NOT = 3 - DISPLAY "Test 25 " FELD4 - END-DISPLAY - END-IF. - - MOVE 2 TO FELD4 - ADD -1 TO FELD4 - IF FELD4 NOT = 1 - DISPLAY "Test 26 " FELD4 - END-DISPLAY - END-IF. - - MOVE -2 TO FELD4 - ADD 1 TO FELD4 - IF FELD4 NOT = -1 - DISPLAY "Test 27 " FELD4 - END-DISPLAY - END-IF. - - MOVE -2 TO FELD4 - ADD -1 TO FELD4 - IF FELD4 NOT = -3 - DISPLAY "Test 28 " FELD4 - END-DISPLAY - END-IF. - - MOVE 2 TO FELD4 - SUBTRACT 1 FROM FELD4 - IF FELD4 NOT = 1 - DISPLAY "Test 29 " FELD4 - END-DISPLAY - END-IF. - - MOVE 2 TO FELD4 - SUBTRACT -1 FROM FELD4 - IF FELD4 NOT = 3 - DISPLAY "Test 30 " FELD4 - END-DISPLAY - END-IF. - - MOVE -2 TO FELD4 - SUBTRACT 1 FROM FELD4 - IF FELD4 NOT = -3 - DISPLAY "Test 31 " FELD4 - END-DISPLAY - END-IF. - - MOVE -2 TO FELD4 - SUBTRACT -1 FROM FELD4 - IF FELD4 NOT = -1 - DISPLAY "Test 32 " FELD4 - END-DISPLAY - END-IF. - - MOVE 1 TO FELD4 - ADD 2 TO FELD4 - IF FELD4 NOT = 3 - DISPLAY "Test 33 " FELD4 - END-DISPLAY - END-IF. - - MOVE 1 TO FELD4 - ADD -2 TO FELD4 - IF FELD4 NOT = -1 - DISPLAY "Test 34 " FELD4 - END-DISPLAY - END-IF. - - MOVE -1 TO FELD4 - ADD 2 TO FELD4 - IF FELD4 NOT = 1 - DISPLAY "Test 35 " FELD4 - END-DISPLAY - END-IF. - - MOVE -1 TO FELD4 - ADD -2 TO FELD4 - IF FELD4 NOT = -3 - DISPLAY "Test 36 " FELD4 - END-DISPLAY - END-IF. - - MOVE 1 TO FELD4 - SUBTRACT 2 FROM FELD4 - IF FELD4 NOT = -1 - DISPLAY "Test 37 " FELD4 - END-DISPLAY - END-IF. - - MOVE 1 TO FELD4 - SUBTRACT -2 FROM FELD4 - IF FELD4 NOT = 3 - DISPLAY "Test 38 " FELD4 - END-DISPLAY - END-IF. - - MOVE -1 TO FELD4 - SUBTRACT 2 FROM FELD4 - IF FELD4 NOT = -3 - DISPLAY "Test 39 " FELD4 - END-DISPLAY - END-IF. - - MOVE -1 TO FELD4 - SUBTRACT -2 FROM FELD4 - IF FELD4 NOT = 1 - DISPLAY "Test 40 " FELD4 - END-DISPLAY - END-IF. - GOBACK. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_fundamental.at:3501: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_fundamental.at:3501" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob:137: warning: ignoring sign -prog.cob:144: warning: ignoring sign -prog.cob:165: warning: ignoring sign -prog.cob:172: warning: ignoring sign -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_fundamental.at:3501" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_fundamental.at:3507: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_fundamental.at:3507" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_fundamental.at:3507" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_475 -#AT_START_476 -at_fn_group_banner 476 'run_fundamental.at:3512' \ - "Numeric operations (5)" " " 4 -at_xfail=no -( - $as_echo "476. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 FIELD PIC S9(1)V9(1) COMP-5. - 01 FELD2 PIC S9(5)V9(5) COMP-5. - 01 FELD3 PIC 9(1)V9(1) COMP-5. - 01 FELD4 PIC S9(1) COMP-5. - PROCEDURE DIVISION. - MOVE 0.2 TO FIELD - ADD 1 TO FIELD - IF FIELD NOT = 1.2 - DISPLAY "Test 1 " FIELD - END-DISPLAY - END-IF. - - MOVE 0.2 TO FIELD - ADD -1 TO FIELD - IF FIELD NOT = -0.8 - DISPLAY "Test 2 " FIELD - END-DISPLAY - END-IF. - - MOVE -0.2 TO FIELD - ADD 1 TO FIELD - IF FIELD NOT = 0.8 - DISPLAY "Test 3 " FIELD - END-DISPLAY - END-IF. - - MOVE -0.2 TO FIELD - ADD -1 TO FIELD - IF FIELD NOT = -1.2 - DISPLAY "Test 4 " FIELD - END-DISPLAY - END-IF. - - MOVE 0.2 TO FIELD - SUBTRACT 1 FROM FIELD - IF FIELD NOT = -0.8 - DISPLAY "Test 5 " FIELD - END-DISPLAY - END-IF. - - MOVE 0.2 TO FIELD - SUBTRACT -1 FROM FIELD - IF FIELD NOT = 1.2 - DISPLAY "Test 6 " FIELD - END-DISPLAY - END-IF. - - MOVE -0.2 TO FIELD - SUBTRACT 1 FROM FIELD - IF FIELD NOT = -1.2 - DISPLAY "Test 7 " FIELD - END-DISPLAY - END-IF. - - MOVE -0.2 TO FIELD - SUBTRACT -1 FROM FIELD - IF FIELD NOT = 0.8 - DISPLAY "Test 8 " FIELD - END-DISPLAY - END-IF. - - MOVE 0.2 TO FELD2 - ADD 1 TO FELD2 - IF FELD2 NOT = 1.2 - DISPLAY "Test 9 " FELD2 - END-DISPLAY - END-IF. - - MOVE 0.2 TO FELD2 - ADD -1 TO FELD2 - IF FELD2 NOT = -0.8 - DISPLAY "Test 10 " FELD2 - END-DISPLAY - END-IF. - - MOVE -0.2 TO FELD2 - ADD 1 TO FELD2 - IF FELD2 NOT = 0.8 - DISPLAY "Test 11 " FELD2 - END-DISPLAY - END-IF. - - MOVE -0.2 TO FELD2 - ADD -1 TO FELD2 - IF FELD2 NOT = -1.2 - DISPLAY "Test 12 " FELD2 - END-DISPLAY - END-IF. - - MOVE 0.2 TO FELD2 - SUBTRACT 1 FROM FELD2 - IF FELD2 NOT = -0.8 - DISPLAY "Test 13 " FELD2 - END-DISPLAY - END-IF. - - MOVE 0.2 TO FELD2 - SUBTRACT -1 FROM FELD2 - IF FELD2 NOT = 1.2 - DISPLAY "Test 14 " FELD2 - END-DISPLAY - END-IF. - - MOVE -0.2 TO FELD2 - SUBTRACT 1 FROM FELD2 - IF FELD2 NOT = -1.2 - DISPLAY "Test 15 " FELD2 - END-DISPLAY - END-IF. - - MOVE -0.2 TO FELD2 - SUBTRACT -1 FROM FELD2 - IF FELD2 NOT = 0.8 - DISPLAY "Test 16 " FELD2 - END-DISPLAY - END-IF. - - MOVE 0.2 TO FELD3 - ADD 1 TO FELD3 - IF FELD3 NOT = 1.2 - DISPLAY "Test 17 " FELD3 - END-DISPLAY - END-IF. - - MOVE 0.2 TO FELD3 - ADD -1 TO FELD3 - IF FELD3 NOT = 0.8 - DISPLAY "Test 18 " FELD3 - END-DISPLAY - END-IF. - - MOVE -0.2 TO FELD3 - ADD 1 TO FELD3 - IF FELD3 NOT = 1.2 - DISPLAY "Test 19 " FELD3 - END-DISPLAY - END-IF. - - MOVE -0.2 TO FELD3 - ADD -1 TO FELD3 - IF FELD3 NOT = 0.8 - DISPLAY "Test 20 " FELD3 - END-DISPLAY - END-IF. - - MOVE 0.2 TO FELD3 - SUBTRACT 1 FROM FELD3 - IF FELD3 NOT = 0.8 - DISPLAY "Test 21 " FELD3 - END-DISPLAY - END-IF. - - MOVE 0.2 TO FELD3 - SUBTRACT -1 FROM FELD3 - IF FELD3 NOT = 1.2 - DISPLAY "Test 22 " FELD3 - END-DISPLAY - END-IF. - - MOVE -0.2 TO FELD3 - SUBTRACT 1 FROM FELD3 - IF FELD3 NOT = 0.8 - DISPLAY "Test 23 " FELD3 - END-DISPLAY - END-IF. - - MOVE -0.2 TO FELD3 - SUBTRACT -1 FROM FELD3 - IF FELD3 NOT = 1.2 - DISPLAY "Test 24 " FELD3 - END-DISPLAY - END-IF. - - MOVE 2 TO FELD4 - ADD 1 TO FELD4 - IF FELD4 NOT = 3 - DISPLAY "Test 25 " FELD4 - END-DISPLAY - END-IF. - - MOVE 2 TO FELD4 - ADD -1 TO FELD4 - IF FELD4 NOT = 1 - DISPLAY "Test 26 " FELD4 - END-DISPLAY - END-IF. - - MOVE -2 TO FELD4 - ADD 1 TO FELD4 - IF FELD4 NOT = -1 - DISPLAY "Test 27 " FELD4 - END-DISPLAY - END-IF. - - MOVE -2 TO FELD4 - ADD -1 TO FELD4 - IF FELD4 NOT = -3 - DISPLAY "Test 28 " FELD4 - END-DISPLAY - END-IF. - - MOVE 2 TO FELD4 - SUBTRACT 1 FROM FELD4 - IF FELD4 NOT = 1 - DISPLAY "Test 29 " FELD4 - END-DISPLAY - END-IF. - - MOVE 2 TO FELD4 - SUBTRACT -1 FROM FELD4 - IF FELD4 NOT = 3 - DISPLAY "Test 30 " FELD4 - END-DISPLAY - END-IF. - - MOVE -2 TO FELD4 - SUBTRACT 1 FROM FELD4 - IF FELD4 NOT = -3 - DISPLAY "Test 31 " FELD4 - END-DISPLAY - END-IF. - - MOVE -2 TO FELD4 - SUBTRACT -1 FROM FELD4 - IF FELD4 NOT = -1 - DISPLAY "Test 32 " FELD4 - END-DISPLAY - END-IF. - - MOVE 1 TO FELD4 - ADD 2 TO FELD4 - IF FELD4 NOT = 3 - DISPLAY "Test 33 " FELD4 - END-DISPLAY - END-IF. - - MOVE 1 TO FELD4 - ADD -2 TO FELD4 - IF FELD4 NOT = -1 - DISPLAY "Test 34 " FELD4 - END-DISPLAY - END-IF. - - MOVE -1 TO FELD4 - ADD 2 TO FELD4 - IF FELD4 NOT = 1 - DISPLAY "Test 35 " FELD4 - END-DISPLAY - END-IF. - - MOVE -1 TO FELD4 - ADD -2 TO FELD4 - IF FELD4 NOT = -3 - DISPLAY "Test 36 " FELD4 - END-DISPLAY - END-IF. - - MOVE 1 TO FELD4 - SUBTRACT 2 FROM FELD4 - IF FELD4 NOT = -1 - DISPLAY "Test 37 " FELD4 - END-DISPLAY - END-IF. - - MOVE 1 TO FELD4 - SUBTRACT -2 FROM FELD4 - IF FELD4 NOT = 3 - DISPLAY "Test 38 " FELD4 - END-DISPLAY - END-IF. - - MOVE -1 TO FELD4 - SUBTRACT 2 FROM FELD4 - IF FELD4 NOT = -3 - DISPLAY "Test 39 " FELD4 - END-DISPLAY - END-IF. - - MOVE -1 TO FELD4 - SUBTRACT -2 FROM FELD4 - IF FELD4 NOT = 1 - DISPLAY "Test 40 " FELD4 - END-DISPLAY - END-IF. - GOBACK. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_fundamental.at:3807: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_fundamental.at:3807" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob:137: warning: ignoring sign -prog.cob:144: warning: ignoring sign -prog.cob:165: warning: ignoring sign -prog.cob:172: warning: ignoring sign -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_fundamental.at:3807" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_fundamental.at:3813: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_fundamental.at:3813" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_fundamental.at:3813" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_476 -#AT_START_477 -at_fn_group_banner 477 'run_fundamental.at:3818' \ - "Numeric operations (6)" " " 4 -at_xfail=no -( - $as_echo "477. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >dump.c <<'_ATEOF' - -#include -#include - -COB_EXT_EXPORT int -dump (char *p) -{ - printf ("%c%c", p[0], p[1]); - return 0; -} -_ATEOF - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - - DATA DIVISION. - WORKING-STORAGE SECTION. - - 01 P-FIELD1 PIC 99PPP. - 01 P-FIELD2 PIC PPP99. - - PROCEDURE DIVISION. - - MOVE 5000 TO P-FIELD1. - ADD 5 TO P-FIELD1 END-ADD - IF P-FIELD1 NOT = 5000 - DISPLAY "Error: Add 5 to PIC 99PPP." - END-DISPLAY - END-IF - CALL "dump" USING P-FIELD1 END-CALL - - ADD 5000 TO P-FIELD1 END-ADD - IF P-FIELD1 NOT = 10000 - DISPLAY "Error: Add 5000 to PIC 99PPP." - END-DISPLAY - END-IF - CALL "dump" USING P-FIELD1 END-CALL - - MOVE 0.00055 TO P-FIELD2. - ADD 0.00033 TO P-FIELD2 END-ADD - IF P-FIELD2 NOT = 0.00088 - DISPLAY "Error: Add 0.00033 to PIC PPP99." - END-DISPLAY - END-IF - CALL "dump" USING P-FIELD2 END-CALL - - MOVE 0.00055 TO P-FIELD2. - ADD 0.00300 TO P-FIELD2 END-ADD - IF P-FIELD2 NOT = 0.00055 - DISPLAY "Error: Add 0.00300 to PIC PPP99." - END-DISPLAY - END-IF - CALL "dump" USING P-FIELD2 END-CALL - - STOP RUN. - -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_fundamental.at:3880: \$COMPILE_MODULE dump.c" -at_fn_check_prepare_dynamic "$COMPILE_MODULE dump.c" "run_fundamental.at:3880" -( $at_check_trace; $COMPILE_MODULE dump.c -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_fundamental.at:3880" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_fundamental.at:3881: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_fundamental.at:3881" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_fundamental.at:3881" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_fundamental.at:3882: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_fundamental.at:3882" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo "05108855" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_fundamental.at:3882" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_477 -#AT_START_478 -at_fn_group_banner 478 'run_fundamental.at:3887' \ - "Numeric operations (7)" " " 4 -at_xfail=no -( - $as_echo "478. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 FIELD PIC S9(4)V9(2) COMP-5. - 01 FIELD-DISP PIC S9(4)V9(2) DISPLAY. - PROCEDURE DIVISION. - MOVE 0.2 TO FIELD. - ADD 1 - 2 - 3 - 4 - 5 - 6 - 7 - 8 - 9 - 10 - 11 - 12 - 13 - 14 - 15 - 16 - 17 - 18 - 19 - 20 - 21 - 22 - 23 - 24 - 25 - 26 - 27 - 28 - 29 - 30 - 31 - 32 - 33 - 34 - 35 - 36 - 37 - 38 - 39 - 40 - 41 - 42 - 43 - 44 - 45 - 46 - 47 - 48 - 49 - 50 - 51 - 52 - 53 - 54 - 55 - 56 - 57 - 58 - 59 - 60 - 61 - 62 - 63 - 64 - 65 - 66 - 67 - 68 - 69 - 70 - 71 - 72 - 73 - 74 - 75 - 76 - 77 - 78 - 79 - 80 - 81 - 82 - 83 - 84 - 85 - 86 - 87 - 88 - 89 - 90 - 91 - 92 - 93 - 94 - 95 - 96 - 97 - 98 - 99 - 100 - 101 - 102 - 103 - 104 - 105 - 106 - 107 - 108 - 109 - 110 - 111 - 112 - 113 - 114 - 115 - 116 - 117 - 118 - 119 - 120 - 121 - 122 - 123 - 124 - 125 - 126 - 127 - 128 - 129 - TO FIELD - END-ADD. - IF FIELD NOT = 8385.2 - MOVE FIELD TO FIELD-DISP - DISPLAY 'ADD with wrong result: ' FIELD-DISP - END-DISPLAY - END-IF. - COMPUTE FIELD = (0.2 - + 2 - + 3 - + 4 - + 5 - + 6 - + 7 - + 8 - + 9 - + 10 - + 11 - + 12 - + 13 - + 14 - + 15 - + 16 - + 17 - + 18 - + 19 - + 20 - + 21 - + 22 - + 23 - + 24 - + 25 - + 26 - + 27 - + 28 - + 29 - + 30 - + 31 - + 32 - + 33 - + 34 - + 35 - + 36 - + 37 - + 38 - + 39 - + 40 - + 41 - + 42 - + 43 - + 44 - + 45 - + 46 - + 47 - + 48 - + 49 - + 50 - + 51 - + 52 - + 53 - + 54 - + 55 - + 56 - + 57 - + 58 - - 59 - - 60 - - 61 - - 62 - - 63 - - 64 - - 65 - - 66 - - 67 - - 68 - - 69 - - 70 - - 71 - - 72 - - 73 - - 74 - - 75 - - 76 - - 77 - - 78 - - 79 - - 80 - - 81 - - 82 - - 83 - - 84 - - 85 - - 86 - - 87 - - 88 - - 89 - - 90 - - 91 - - 92 - - 93 - - 94 - - 95 - - 96 - - 97 - - 98 - - 99 - - 100 - - 101 - - 102 - - 103 - - 104 - - 105 - - 106 - - 107 - - 108 - - 109 - - 110 - - 111 - - 112 - - 113 - - 114 - - 115 - - 116 - - 117 - - 118 - - 119 - - 120 - - 121 - - 122 - - 123 - - 124 - - 125 - - 126 - - 127) - * 12800000000 - / 12900000000 - END-COMPUTE. - IF FIELD NOT = -4670.31 - MOVE FIELD TO FIELD-DISP - DISPLAY 'COMPUTE with wrong result: ' FIELD-DISP - END-DISPLAY - END-IF. - GOBACK. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_fundamental.at:4173: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_fundamental.at:4173" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_fundamental.at:4173" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_fundamental.at:4174: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_fundamental.at:4174" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_fundamental.at:4174" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_478 -#AT_START_479 -at_fn_group_banner 479 'run_fundamental.at:4179' \ - "Numeric operations (8)" " " 4 -at_xfail=no -( - $as_echo "479. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 1 COMPUTE-DATA. - 2 COMPUTE-8 PICTURE 999 VALUE ZERO. - PROCEDURE DIVISION. - COMPUTE COMPUTE-8 = (((24.0 + 1) * (60 - 10)) / 125) ** 2 - IF COMPUTE-8 NOT = 100 - DISPLAY 'COMPUTE with wrong result: ' COMPUTE-8 - END-DISPLAY - END-IF - COMPUTE COMPUTE-8 = 55 / (1 - 2 + 1) - NOT ON SIZE ERROR - DISPLAY 'SIZE ERROR not set from divide by zero!' - END-DISPLAY - END-COMPUTE - COMPUTE COMPUTE-8 = 0 ** 1 - IF COMPUTE-8 NOT = 0 - DISPLAY '0 ** 1 <> 0: ' COMPUTE-8 - END-DISPLAY - END-IF - COMPUTE COMPUTE-8 = 55 ** 0 - IF COMPUTE-8 NOT = 1 - DISPLAY '55 ** 0 <> 1: ' COMPUTE-8 - END-DISPLAY - END-IF - COMPUTE COMPUTE-8 = 1 ** 55 - IF COMPUTE-8 NOT = 1 - DISPLAY '11 ** 55 <> 1: ' COMPUTE-8 - END-DISPLAY - END-IF - - GOBACK. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_fundamental.at:4219: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_fundamental.at:4219" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob:14: warning: divide by constant ZERO -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_fundamental.at:4219" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_fundamental.at:4222: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_fundamental.at:4222" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_fundamental.at:4222" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_479 -#AT_START_480 -at_fn_group_banner 480 'run_fundamental.at:4229' \ - "ADD CORRESPONDING" " " 4 -at_xfail=no -( - $as_echo "480. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 GROUP-1. - 05 FIELD-A PIC 9 VALUE 1. - 05 FIELD-B USAGE BINARY-CHAR VALUE 2. - 05 INNER-GROUP. - 10 FIELD-C USAGE FLOAT-SHORT VALUE 3. - 05 FIELD-D PIC X VALUE "A". - 01 GROUP-2. - 05 FIELD-A PIC 9. - 05 FIELD-B USAGE BINARY-LONG. - 05 INNER-GROUP. - 10 FIELD-C PIC 9. - 05 FIELD-D PIC 9. - - PROCEDURE DIVISION. - ADD CORRESPONDING GROUP-1 TO GROUP-2. - IF FIELD-A IN GROUP-2 NOT EQUAL 1 THEN - DISPLAY "BAD FIELD-A " FIELD-A IN GROUP-2 - END-DISPLAY - END-IF. - IF FIELD-B IN GROUP-2 NOT EQUAL 2 THEN - DISPLAY "BAD FIELD-B " FIELD-B IN GROUP-2 - END-DISPLAY - END-IF. - IF FIELD-C IN GROUP-2 NOT EQUAL 3 THEN - DISPLAY "BAD FIELD-C " FIELD-C IN GROUP-2 - END-DISPLAY - END-IF. - IF FIELD-D IN GROUP-2 NOT EQUAL 0 THEN - DISPLAY "BAD FIELD-D " FIELD-D IN GROUP-2 - END-DISPLAY - END-IF. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_fundamental.at:4271: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_fundamental.at:4271" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_fundamental.at:4271" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_fundamental.at:4272: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_fundamental.at:4272" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_fundamental.at:4272" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_480 -#AT_START_481 -at_fn_group_banner 481 'run_fundamental.at:4277' \ - "ADD CORRESPONDING no match" " " 4 -at_xfail=no -( - $as_echo "481. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 GROUP-1. - 05 FIELD-A PIC X. - 05 FIELD-B PIC Z9. - 05 INNER-GROUP. - 10 FIELD-C PIC X. - 05 FIELD-D PIC 9. - 01 GROUP-2. - 05 FIELD-A PIC 9 VALUE 1. - 05 FIELD-B USAGE BINARY-CHAR VALUE 2. - 05 INNER-GROUP. - 10 FIELD-C USAGE FLOAT-SHORT VALUE 3. - 05 FIELD-D PIC X VALUE "A". - - PROCEDURE DIVISION. - SUBTRACT CORRESPONDING GROUP-2 FROM GROUP-1. - IF FIELD-A IN GROUP-2 NOT EQUAL 1 THEN - DISPLAY "BAD FIELD-A " FIELD-A IN GROUP-2 - END-DISPLAY - END-IF. - IF FIELD-B IN GROUP-2 NOT EQUAL 2 THEN - DISPLAY "BAD FIELD-B " FIELD-B IN GROUP-2 - END-DISPLAY - END-IF. - IF FIELD-C IN GROUP-2 NOT EQUAL 3 THEN - DISPLAY "BAD FIELD-C " FIELD-C IN GROUP-2 - END-DISPLAY - END-IF. - IF FIELD-D IN GROUP-2 NOT EQUAL "A" THEN - DISPLAY "BAD FIELD-D " FIELD-D IN GROUP-2 - END-DISPLAY - END-IF. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_fundamental.at:4319: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_fundamental.at:4319" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob:20: warning: no CORRESPONDING items found -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_fundamental.at:4319" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_fundamental.at:4322: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_fundamental.at:4322" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_fundamental.at:4322" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_481 -#AT_START_482 -at_fn_group_banner 482 'run_fundamental.at:4327' \ - "SYNC in OCCURS" " " 4 -at_xfail=no -( - $as_echo "482. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 x. - 03 ptrs OCCURS 5 TIMES. - 05 misalign-1 PIC X. - 05 ptr POINTER, SYNC. - 05 ptr-num REDEFINES ptr, - >>IF P64 SET - USAGE BINARY-DOUBLE UNSIGNED. - >>ELSE - USAGE BINARY-LONG UNSIGNED. - >>END-IF - 05 misalign-2 PIC X. - - 01 num BINARY-LONG. - - PROCEDURE DIVISION. - SET ptr (2) TO ADDRESS OF ptr (2) - SET ptr (3) TO ADDRESS OF ptr (3) - - SUBTRACT ptr-num (2) FROM ptr-num (3) GIVING num - DISPLAY FUNCTION MOD (num, FUNCTION LENGTH (ptr (1))) - . -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_fundamental.at:4359: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_fundamental.at:4359" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_fundamental.at:4359" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_fundamental.at:4360: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_fundamental.at:4360" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo "000000000 -" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_fundamental.at:4360" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_482 -#AT_START_483 -at_fn_group_banner 483 'run_fundamental.at:4367' \ - "88 level with THRU" " " 4 -at_xfail=no -( - $as_echo "483. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 VAR-X PIC X VALUE SPACE. - 88 X VALUE "X". - 88 T-Y VALUE "T" THRU "Y". - 01 VAR-9 PIC 9 VALUE ZERO. - 88 V9 VALUE 9. - 88 V2-4 VALUE 2 THRU 4. - PROCEDURE DIVISION. - IF X - DISPLAY "NOT OK '" VAR-X "' IS X" - END-DISPLAY - END-IF - SET X TO TRUE - IF NOT X - DISPLAY "NOT OK '" VAR-X "' IS NOT X" - END-DISPLAY - END-IF - IF NOT T-Y - DISPLAY "NOT OK '" VAR-X "' IS NOT T-Y" - END-DISPLAY - END-IF - SET T-Y TO TRUE - IF NOT T-Y - DISPLAY "NOT OK '" VAR-X "' IS NOT T-Y" - END-DISPLAY - END-IF - MOVE 'Y' TO VAR-X - IF NOT T-Y - DISPLAY "NOT OK '" VAR-X "' IS NOT T-Y" - END-DISPLAY - END-IF - MOVE 'Z' TO VAR-X - IF T-Y - DISPLAY "NOT OK '" VAR-X "' IS T-Y" - END-DISPLAY - END-IF - MOVE 'A' TO VAR-X - IF T-Y - DISPLAY "NOT OK '" VAR-X "' IS T-Y" - END-DISPLAY - END-IF - IF V9 - DISPLAY "NOT OK '" VAR-9 "' IS V9" - END-DISPLAY - END-IF - SET V9 TO TRUE - IF NOT V9 - DISPLAY "NOT OK '" VAR-9 "' IS NOT V9" - END-DISPLAY - END-IF - SET V2-4 TO TRUE - IF V9 - DISPLAY "NOT OK '" VAR-9 "' IS V9" - END-DISPLAY - END-IF - IF NOT V2-4 - DISPLAY "NOT OK '" VAR-9 "' IS NOT V2-4" - END-DISPLAY - END-IF - MOVE 3 TO VAR-9 - IF NOT V2-4 - DISPLAY "NOT OK '" VAR-9 "' IS NOT V2-4" - END-DISPLAY - END-IF - MOVE 4 TO VAR-9 - IF NOT V2-4 - DISPLAY "NOT OK '" VAR-9 "' IS NOT V2-4" - END-DISPLAY - END-IF - MOVE 5 TO VAR-9 - IF V2-4 - DISPLAY "NOT OK '" VAR-9 "' IS V2-4" - END-DISPLAY - END-IF - MOVE 1 TO VAR-9 - IF V2-4 - DISPLAY "NOT OK '" VAR-9 "' IS V2-4" - END-DISPLAY - END-IF - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_fundamental.at:4456: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_fundamental.at:4456" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_fundamental.at:4456" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_fundamental.at:4457: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_fundamental.at:4457" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_fundamental.at:4457" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_483 -#AT_START_484 -at_fn_group_banner 484 'run_fundamental.at:4462' \ - "88 level with FILLER" " " 4 -at_xfail=no -( - $as_echo "484. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 FILLER PIC X VALUE SPACE. - 88 X VALUE "X". - PROCEDURE DIVISION. - IF X - DISPLAY "NOT OK" - END-DISPLAY - END-IF - SET X TO TRUE. - IF NOT X - DISPLAY "NOT OK" - END-DISPLAY - END-IF - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_fundamental.at:4485: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_fundamental.at:4485" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_fundamental.at:4485" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_fundamental.at:4486: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_fundamental.at:4486" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_fundamental.at:4486" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_484 -#AT_START_485 -at_fn_group_banner 485 'run_fundamental.at:4491' \ - "88 level with FALSE IS clause" " " 4 -at_xfail=no -( - $as_echo "485. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 MYFLD PIC X(6) VALUE "ABCDEF". - 88 MYFLD88 VALUE "ABCDEF" - FALSE IS "OKOKOK". - PROCEDURE DIVISION. - ASTART SECTION. - A01. - SET MYFLD88 TO FALSE - IF MYFLD NOT = "OKOKOK" - DISPLAY MYFLD - END-DISPLAY - END-IF - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_fundamental.at:4513: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_fundamental.at:4513" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_fundamental.at:4513" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_fundamental.at:4514: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_fundamental.at:4514" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_fundamental.at:4514" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_485 -#AT_START_486 -at_fn_group_banner 486 'run_fundamental.at:4519' \ - "BLANK WHEN ZERO" " " 4 -at_xfail=no -( - $as_echo "486. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 x PIC 9, BLANK WHEN ZERO, VALUE 1. - - PROCEDURE DIVISION. - DISPLAY x - MOVE 0 TO x - DISPLAY FUNCTION TRIM(x) - MOVE ZERO TO x - DISPLAY FUNCTION TRIM(x) - . -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_fundamental.at:4539: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_fundamental.at:4539" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_fundamental.at:4539" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_fundamental.at:4540: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_fundamental.at:4540" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo "1 - - -" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_fundamental.at:4540" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_486 -#AT_START_487 -at_fn_group_banner 487 'run_fundamental.at:4549' \ - "MULTIPLY BY literal in INITIAL program" " " 4 -at_xfail=no -( - $as_echo "487. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog INITIAL. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 num PIC 9(4) VALUE 5. - 01 result PIC 9(4). - 01 ws-temp PIC 9(8)V99. - 01 ws-temp2 PIC 9(3)V99 VALUE 10.50. - PROCEDURE DIVISION. - MULTIPLY num BY 4 GIVING result - MOVE 1.10 TO WS-TEMP. - MULTIPLY WS-TEMP2 BY WS-TEMP GIVING WS-TEMP. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_fundamental.at:4567: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_fundamental.at:4567" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_fundamental.at:4567" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_fundamental.at:4568: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_fundamental.at:4568" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_fundamental.at:4568" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_487 -#AT_START_488 -at_fn_group_banner 488 'run_fundamental.at:4573' \ - "debugging lines (not active)" " " 4 -at_xfail=no -( - $as_echo "488. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - PROCEDURE DIVISION. - DISPLAY "OK" NO ADVANCING - END-DISPLAY. - D DISPLAY "KO" NO ADVANCING - D END-DISPLAY. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_fundamental.at:4589: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_fundamental.at:4589" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_fundamental.at:4589" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_fundamental.at:4590: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_fundamental.at:4590" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo "OK" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_fundamental.at:4590" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_488 -#AT_START_489 -at_fn_group_banner 489 'run_fundamental.at:4596' \ - "debugging lines (-fdebugging-line)" " " 4 -at_xfail=no -( - $as_echo "489. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - PROCEDURE DIVISION. - DISPLAY "OK" NO ADVANCING - END-DISPLAY. - D DISPLAY "KO" NO ADVANCING - D END-DISPLAY. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_fundamental.at:4612: \$COMPILE -fdebugging-line prog.cob" -at_fn_check_prepare_dynamic "$COMPILE -fdebugging-line prog.cob" "run_fundamental.at:4612" -( $at_check_trace; $COMPILE -fdebugging-line prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_fundamental.at:4612" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_fundamental.at:4613: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_fundamental.at:4613" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo "OKKO" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_fundamental.at:4613" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_489 -#AT_START_490 -at_fn_group_banner 490 'run_fundamental.at:4619' \ - "debugging lines (WITH DEBUGGING MODE)" " " 4 -at_xfail=no -( - $as_echo "490. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - CONFIGURATION SECTION. - SOURCE-COMPUTER. mine WITH DEBUGGING MODE. - DATA DIVISION. - WORKING-STORAGE SECTION. - PROCEDURE DIVISION. - D DISPLAY "KO" NO ADVANCING UPON STDOUT - D END-DISPLAY. - DISPLAY "OK" NO ADVANCING UPON STDOUT - END-DISPLAY. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_fundamental.at:4638: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_fundamental.at:4638" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_fundamental.at:4638" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_fundamental.at:4639: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_fundamental.at:4639" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo "KOOK" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_fundamental.at:4639" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_490 -#AT_START_491 -at_fn_group_banner 491 'run_fundamental.at:4645' \ - "debugging lines, free format (not active)" " " 4 -at_xfail=no -( - $as_echo "491. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - PROCEDURE DIVISION. - DISPLAY "OK" NO ADVANCING - END-DISPLAY. - >>D DISPLAY "KO" NO ADVANCING - >>D END-DISPLAY. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_fundamental.at:4661: \$COMPILE -free prog.cob" -at_fn_check_prepare_dynamic "$COMPILE -free prog.cob" "run_fundamental.at:4661" -( $at_check_trace; $COMPILE -free prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_fundamental.at:4661" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_fundamental.at:4662: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_fundamental.at:4662" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo "OK" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_fundamental.at:4662" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_491 -#AT_START_492 -at_fn_group_banner 492 'run_fundamental.at:4668' \ - "debugging lines, free format (-fdebugging-line)" "" 4 -at_xfail=no -( - $as_echo "492. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - PROCEDURE DIVISION. - DISPLAY "OK" NO ADVANCING - END-DISPLAY. - >>D DISPLAY "KO" NO ADVANCING - >>D END-DISPLAY. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_fundamental.at:4684: \$COMPILE -free -fdebugging-line prog.cob" -at_fn_check_prepare_dynamic "$COMPILE -free -fdebugging-line prog.cob" "run_fundamental.at:4684" -( $at_check_trace; $COMPILE -free -fdebugging-line prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_fundamental.at:4684" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_fundamental.at:4685: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_fundamental.at:4685" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo "OKKO" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_fundamental.at:4685" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_492 -#AT_START_493 -at_fn_group_banner 493 'run_fundamental.at:4691' \ - "USE FOR DEBUGGING (no DEBUGGING MODE)" " " 4 -at_xfail=no -( - $as_echo "493. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - CONFIGURATION SECTION. - SOURCE-COMPUTER. - DATA DIVISION. - WORKING-STORAGE SECTION. - PROCEDURE DIVISION. - DECLARATIVES. - TEST-DEBUG SECTION. USE FOR DEBUGGING ON ALL PROCEDURES. - DISPLAY DEBUG-ITEM END-DISPLAY. - END DECLARATIVES. - FIRST-PAR. - DISPLAY "OK1" END-DISPLAY. - GO TO SECOND-PAR. - SECOND-PAR. - DISPLAY "OK2" END-DISPLAY. - THIRD-PAR. - DISPLAY "OK3" END-DISPLAY. - PERFORM FIRST-PAR THRU SECOND-PAR. - DISPLAY "OK4" END-DISPLAY. - PERFORM SECOND-PAR. - DISPLAY "OK5" END-DISPLAY. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_fundamental.at:4721: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_fundamental.at:4721" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_fundamental.at:4721" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_fundamental.at:4722: COB_SET_DEBUG=1 \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "COB_SET_DEBUG=1 $COBCRUN_DIRECT ./prog" "run_fundamental.at:4722" -( $at_check_trace; COB_SET_DEBUG=1 $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo "OK1 -OK2 -OK3 -OK1 -OK2 -OK4 -OK2 -OK5 -" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_fundamental.at:4722" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_493 -#AT_START_494 -at_fn_group_banner 494 'run_fundamental.at:4736' \ - "USE FOR DEBUGGING (COB_SET_DEBUG deactivated)" " " 4 -at_xfail=no -( - $as_echo "494. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - CONFIGURATION SECTION. - SOURCE-COMPUTER. mine WITH DEBUGGING MODE. - DATA DIVISION. - WORKING-STORAGE SECTION. - PROCEDURE DIVISION. - DECLARATIVES. - TEST-DEBUG SECTION. USE FOR DEBUGGING ON ALL PROCEDURES. - DISPLAY DEBUG-ITEM END-DISPLAY. - END DECLARATIVES. - FIRST-PAR. - DISPLAY "OK1" END-DISPLAY. - GO TO SECOND-PAR. - SECOND-PAR. - DISPLAY "OK2" END-DISPLAY. - THIRD-PAR. - DISPLAY "OK3" END-DISPLAY. - PERFORM FIRST-PAR THRU SECOND-PAR. - DISPLAY "OK4" END-DISPLAY. - PERFORM SECOND-PAR. - DISPLAY "OK5" END-DISPLAY. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_fundamental.at:4766: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_fundamental.at:4766" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_fundamental.at:4766" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_fundamental.at:4767: COB_SET_DEBUG=0 \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "COB_SET_DEBUG=0 $COBCRUN_DIRECT ./prog" "run_fundamental.at:4767" -( $at_check_trace; COB_SET_DEBUG=0 $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo "OK1 -OK2 -OK3 -OK1 -OK2 -OK4 -OK2 -OK5 -" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_fundamental.at:4767" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_494 -#AT_START_495 -at_fn_group_banner 495 'run_fundamental.at:4781' \ - "USE FOR DEBUGGING ON ALL PROCEDURES" " " 4 -at_xfail=no -( - $as_echo "495. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - CONFIGURATION SECTION. - SOURCE-COMPUTER. mine WITH DEBUGGING MODE. - DATA DIVISION. - WORKING-STORAGE SECTION. - PROCEDURE DIVISION. - DECLARATIVES. - TEST-DEBUG SECTION. USE FOR DEBUGGING ON ALL PROCEDURES. - DISPLAY DEBUG-ITEM "|" END-DISPLAY. - END DECLARATIVES. - FIRST-PAR. - DISPLAY "OK1" END-DISPLAY. - GO TO SECOND-PAR. - SECOND-PAR. - DISPLAY "OK2" END-DISPLAY. - THIRD-PAR. - DISPLAY "OK3" END-DISPLAY. - PERFORM FIRST-PAR THRU SECOND-PAR. - DISPLAY "OK4" END-DISPLAY. - PERFORM SECOND-PAR. - DISPLAY "OK5" END-DISPLAY. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_fundamental.at:4811: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_fundamental.at:4811" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_fundamental.at:4811" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_fundamental.at:4812: COB_SET_DEBUG=1 \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "COB_SET_DEBUG=1 $COBCRUN_DIRECT ./prog" "run_fundamental.at:4812" -( $at_check_trace; COB_SET_DEBUG=1 $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo " FIRST-PAR START PROGRAM | -OK1 - 16 SECOND-PAR | -OK2 - 18 THIRD-PAR FALL THROUGH | -OK3 - 21 FIRST-PAR PERFORM LOOP | -OK1 - 16 SECOND-PAR | -OK2 -OK4 - 23 SECOND-PAR PERFORM LOOP | -OK2 -OK5 -" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_fundamental.at:4812" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_495 -#AT_START_496 -at_fn_group_banner 496 'run_fundamental.at:4832' \ - "USE FOR DEBUGGING ON procedure" " " 4 -at_xfail=no -( - $as_echo "496. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - CONFIGURATION SECTION. - SOURCE-COMPUTER. mine WITH DEBUGGING MODE. - DATA DIVISION. - WORKING-STORAGE SECTION. - PROCEDURE DIVISION. - DECLARATIVES. - TEST-DEBUG SECTION. USE FOR DEBUGGING ON SECOND-PAR. - DISPLAY DEBUG-ITEM "|" END-DISPLAY. - END DECLARATIVES. - FIRST-PAR. - DISPLAY "OK1" END-DISPLAY. - GO TO SECOND-PAR. - SECOND-PAR. - DISPLAY "OK2" END-DISPLAY. - THIRD-PAR. - DISPLAY "OK3" END-DISPLAY. - PERFORM FIRST-PAR THRU SECOND-PAR. - DISPLAY "OK4" END-DISPLAY. - PERFORM SECOND-PAR. - DISPLAY "OK5" END-DISPLAY. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_fundamental.at:4862: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_fundamental.at:4862" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_fundamental.at:4862" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_fundamental.at:4863: COB_SET_DEBUG=1 \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "COB_SET_DEBUG=1 $COBCRUN_DIRECT ./prog" "run_fundamental.at:4863" -( $at_check_trace; COB_SET_DEBUG=1 $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo "OK1 - 16 SECOND-PAR | -OK2 -OK3 -OK1 - 16 SECOND-PAR | -OK2 -OK4 - 23 SECOND-PAR PERFORM LOOP | -OK2 -OK5 -" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_fundamental.at:4863" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_496 -#AT_START_497 -at_fn_group_banner 497 'run_fundamental.at:4880' \ - "USE FOR DEBUGGING (COB_SET_DEBUG switched)" " " 4 -at_xfail=no -( - $as_echo "497. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - CONFIGURATION SECTION. - SOURCE-COMPUTER. mine WITH DEBUGGING MODE. - DATA DIVISION. - WORKING-STORAGE SECTION. - PROCEDURE DIVISION. - DECLARATIVES. - TEST-DEBUG SECTION. USE FOR DEBUGGING ON ALL PROCEDURES. - DISPLAY DEBUG-ITEM "|" END-DISPLAY. - END DECLARATIVES. - FIRST-PAR. - SET ENVIRONMENT "COB_SET_DEBUG" TO "false" - DISPLAY "OK1" END-DISPLAY. - GO TO SECOND-PAR. - SECOND-PAR. - DISPLAY "OK2" END-DISPLAY. - THIRD-PAR. - DISPLAY "OK3" END-DISPLAY. - PERFORM FIRST-PAR THRU SECOND-PAR. - DISPLAY "OK4" END-DISPLAY. - SET ENVIRONMENT "COB_SET_DEBUG" TO "Y" - PERFORM SECOND-PAR. - DISPLAY "OK5" END-DISPLAY. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_fundamental.at:4912: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_fundamental.at:4912" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_fundamental.at:4912" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_fundamental.at:4913: COB_SET_DEBUG=1 \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "COB_SET_DEBUG=1 $COBCRUN_DIRECT ./prog" "run_fundamental.at:4913" -( $at_check_trace; COB_SET_DEBUG=1 $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo " FIRST-PAR START PROGRAM | -OK1 -OK2 -OK3 -OK1 -OK2 -OK4 - 25 SECOND-PAR PERFORM LOOP | -OK2 -OK5 -" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_fundamental.at:4913" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_497 -#AT_START_498 -at_fn_group_banner 498 'run_fundamental.at:4929' \ - "USE FOR DEBUGGING ON [ALL] REFERENCES OF field" " " 4 -at_xfail=no -( - $as_echo "498. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - CONFIGURATION SECTION. - SOURCE-COMPUTER. mine WITH DEBUGGING MODE. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 MY-DATA-FIELDS. - 02 MY-DATA-FIELD-1 PIC 9 VALUE 1. - 02 MY-DATA-FIELD-2 PIC 9 VALUE 4. - 01 MY-DATA-FIELD-B PIC X(40) VALUE "ABCD". - PROCEDURE DIVISION. - DECLARATIVES. - TEST-DEBUG SECTION. - USE FOR DEBUGGING ON ALL REFERENCES OF MY-DATA-FIELD-1 - ALL MY-DATA-FIELD-2 - MY-DATA-FIELD-B. - DISPLAY DEBUG-ITEM "|" END-DISPLAY. - END DECLARATIVES. - INIT-PAR. - MOVE 6 TO MY-DATA-FIELD-2. - FIRST-PAR. - PERFORM VARYING MY-DATA-FIELD-1 FROM 1 BY 1 - UNTIL MY-DATA-FIELD-1 > MY-DATA-FIELD-2 - *> empty by design - END-PERFORM. - END-PAR. - MOVE "99" TO MY-DATA-FIELD-B. - MOVE MY-DATA-FIELD-B TO MY-DATA-FIELDS. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_fundamental.at:4965: \$COMPILE -fmissing-statement=ok prog.cob" -at_fn_check_prepare_dynamic "$COMPILE -fmissing-statement=ok prog.cob" "run_fundamental.at:4965" -( $at_check_trace; $COMPILE -fmissing-statement=ok prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_fundamental.at:4965" -$at_failed && at_fn_log_failure -$at_traceon; } - -# TODO: validate against other compilers, especially the line 30; -# likely the second line should be 25 instead of 24: -{ set +x -$as_echo "$at_srcdir/run_fundamental.at:4968: COB_SET_DEBUG=1 \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "COB_SET_DEBUG=1 $COBCRUN_DIRECT ./prog" "run_fundamental.at:4968" -( $at_check_trace; COB_SET_DEBUG=1 $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo " 22 MY-DATA-FIELD-2 6 | - 24 MY-DATA-FIELD-1 1 | - 24 MY-DATA-FIELD-1 1 | - 24 MY-DATA-FIELD-2 6 | - 24 MY-DATA-FIELD-1 2 | - 24 MY-DATA-FIELD-1 2 | - 24 MY-DATA-FIELD-2 6 | - 24 MY-DATA-FIELD-1 3 | - 24 MY-DATA-FIELD-1 3 | - 24 MY-DATA-FIELD-2 6 | - 24 MY-DATA-FIELD-1 4 | - 24 MY-DATA-FIELD-1 4 | - 24 MY-DATA-FIELD-2 6 | - 24 MY-DATA-FIELD-1 5 | - 24 MY-DATA-FIELD-1 5 | - 24 MY-DATA-FIELD-2 6 | - 24 MY-DATA-FIELD-1 6 | - 24 MY-DATA-FIELD-1 6 | - 24 MY-DATA-FIELD-2 6 | - 24 MY-DATA-FIELD-1 7 | - 24 MY-DATA-FIELD-1 7 | - 24 MY-DATA-FIELD-2 6 | - 29 MY-DATA-FIELD-B 99 | -" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_fundamental.at:4968" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_498 -#AT_START_499 -at_fn_group_banner 499 'run_fundamental.at:4997' \ - "USE FOR DEBUGGING, reference within DEBUGGING" " " 4 -at_xfail=no -( - $as_echo "499. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - CONFIGURATION SECTION. - SOURCE-COMPUTER. mine WITH DEBUGGING MODE. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 DATA-FIELD PIC X(40) VALUE "ABCD". - PROCEDURE DIVISION. - DECLARATIVES. - TEST-DEBUG SECTION. - USE FOR DEBUGGING ON ALL REFERENCES OF DATA-FIELD. - DISPLAY DEBUG-ITEM "|". - MOVE "ABCD" TO DATA-FIELD. - DISPLAY DEBUG-ITEM "|". - END DECLARATIVES. - SOME-PAR. - MOVE QUOTE TO DATA-FIELD. - IF DATA-FIELD = QUOTE DISPLAY "NO DEBUG" STOP RUN. - DISPLAY "DEBUG". - STOP RUN. -_ATEOF - -{ set +x -$as_echo "$at_srcdir/run_fundamental.at:5023: \$COMPILE -Wno-terminator prog.cob" -at_fn_check_prepare_dynamic "$COMPILE -Wno-terminator prog.cob" "run_fundamental.at:5023" -( $at_check_trace; $COMPILE -Wno-terminator prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_fundamental.at:5023" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_fundamental.at:5024: COB_SET_DEBUG=1 \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "COB_SET_DEBUG=1 $COBCRUN_DIRECT ./prog" "run_fundamental.at:5024" -( $at_check_trace; COB_SET_DEBUG=1 $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo " 19 DATA-FIELD \"\"\"\"\"\"\"\"\"\"\"\"\"\"\"\"\"\"\"\"\"\"\"\"\"\"\"\"\"\"\"\"\"\"\"\"\"\"\"\"| - 19 DATA-FIELD \"\"\"\"\"\"\"\"\"\"\"\"\"\"\"\"\"\"\"\"\"\"\"\"\"\"\"\"\"\"\"\"\"\"\"\"\"\"\"\"| - 20 DATA-FIELD ABCD | - 20 DATA-FIELD ABCD | -DEBUG -" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_fundamental.at:5024" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_fundamental.at:5031: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_fundamental.at:5031" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo "NO DEBUG -" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_fundamental.at:5031" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_499 -#AT_START_500 -at_fn_group_banner 500 'run_fundamental.at:5038' \ - "USE FOR DEBUGGING, time of execution" " " 4 -at_xfail=yes -( - $as_echo "500. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -# FIXME: the debugging procedure is executed after the statement, -# which is generally fine, but not for "nested" statements -# where DEBUG-ITEM contains wrong data and the -# debugging procedure is called too late - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - CONFIGURATION SECTION. - SOURCE-COMPUTER. mine WITH DEBUGGING MODE. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 DATA-FIELD PIC X(40) VALUE "ABCD". - PROCEDURE DIVISION. - DECLARATIVES. - TEST-DEBUG SECTION. - USE FOR DEBUGGING ON ALL REFERENCES OF DATA-FIELD. - DISPLAY DEBUG-ITEM "|". - MOVE "ABCD" TO DATA-FIELD. - END DECLARATIVES. - SOME-PAR. - MOVE QUOTE TO DATA-FIELD. - IF DATA-FIELD = QUOTE - DISPLAY "NO DEBUG" - ELSE - DISPLAY "DEBUG" - MOVE SPACES TO DATA-FIELD - CALL "NOTHERE" USING DATA-FIELD - ON OVERFLOW - DISPLAY "THIS IS FINE". - STOP RUN. -_ATEOF - -{ set +x -$as_echo "$at_srcdir/run_fundamental.at:5075: \$COMPILE -w prog.cob" -at_fn_check_prepare_dynamic "$COMPILE -w prog.cob" "run_fundamental.at:5075" -( $at_check_trace; $COMPILE -w prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_fundamental.at:5075" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_fundamental.at:5076: COB_SET_DEBUG=1 \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "COB_SET_DEBUG=1 $COBCRUN_DIRECT ./prog" "run_fundamental.at:5076" -( $at_check_trace; COB_SET_DEBUG=1 $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo " 18 DATA-FIELD \"\"\"\"\"\"\"\"\"\"\"\"\"\"\"\"\"\"\"\"\"\"\"\"\"\"\"\"\"\"\"\"\"\"\"\"\"\"\"\"| - 19 DATA-FIELD ABCD | -DEBUG - 23 DATA-FIELD | - 24 DATA-FIELD ABCD | -THIS IS FINE -" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_fundamental.at:5076" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_500 -#AT_START_501 -at_fn_group_banner 501 'run_fundamental.at:5088' \ - "USE FOR DEBUGGING, reference with OCCURS" " " 4 -at_xfail=no -( - $as_echo "501. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - CONFIGURATION SECTION. - SOURCE-COMPUTER. mine WITH DEBUGGING MODE. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 FILLER. - 02 FILLER OCCURS 10. - 03 FILLER OCCURS 5. - 04 DATA-FIELD PIC X(40) VALUE "ABCD" OCCURS 2. - PROCEDURE DIVISION. - DECLARATIVES. - TEST-DEBUG SECTION. - USE FOR DEBUGGING ON ALL REFERENCES OF DATA-FIELD. - DISPLAY DEBUG-ITEM "|" END-DISPLAY. - END DECLARATIVES. - SOME-PAR. - MOVE QUOTE TO DATA-FIELD (4, 2, 1). - STOP RUN. -_ATEOF - -{ set +x -$as_echo "$at_srcdir/run_fundamental.at:5113: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_fundamental.at:5113" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_fundamental.at:5113" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_fundamental.at:5114: COB_SET_DEBUG=1 \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "COB_SET_DEBUG=1 $COBCRUN_DIRECT ./prog" "run_fundamental.at:5114" -( $at_check_trace; COB_SET_DEBUG=1 $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo " 20 DATA-FIELD +0004 +0002 +0001 \"\"\"\"\"\"\"\"\"\"\"\"\"\"\"\"\"\"\"\"\"\"\"\"\"\"\"\"\"\"\"\"\"\"\"\"\"\"\"\"| -" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_fundamental.at:5114" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_501 -#AT_START_502 -at_fn_group_banner 502 'run_fundamental.at:5121' \ - "USE FOR DEBUGGING, referencing BASED item" " " 4 -at_xfail=yes -( - $as_echo "502. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -# uncommon issue but shouldn't SIGSEGV --> TODO: fix later -# TODO: also check "ADDRESS OF" (non)-ALLOCATED field - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - CONFIGURATION SECTION. - SOURCE-COMPUTER. mine WITH DEBUGGING MODE. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 DATA-FIELD PIC X(40) VALUE "ABCD" BASED. - PROCEDURE DIVISION. - DECLARATIVES. - TEST-DEBUG SECTION. - USE FOR DEBUGGING ON ALL REFERENCES OF DATA-FIELD. - DISPLAY DEBUG-ITEM "|" END-DISPLAY. - END DECLARATIVES. - SOME-PAR. - ALLOCATE DATA-FIELD INITIALIZED. - FREE DATA-FIELD. - STOP RUN. -_ATEOF - -{ set +x -$as_echo "$at_srcdir/run_fundamental.at:5148: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_fundamental.at:5148" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_fundamental.at:5148" -$at_failed && at_fn_log_failure -$at_traceon; } - -# not sure about the output, check MF, claiming to support BASED + DEBUGGING -{ set +x -$as_echo "$at_srcdir/run_fundamental.at:5150: COB_SET_DEBUG=1 \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "COB_SET_DEBUG=1 $COBCRUN_DIRECT ./prog" "run_fundamental.at:5150" -( $at_check_trace; COB_SET_DEBUG=1 $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo " 17 DATA-FIELD ABCD | - 18 DATA-FIELD ABCD | -" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_fundamental.at:5150" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_502 -#AT_START_503 -at_fn_group_banner 503 'run_fundamental.at:5158' \ - "USE FOR DEBUGGING file" " " 4 -at_xfail=no -( - $as_echo "503. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - CONFIGURATION SECTION. - SOURCE-COMPUTER. mine WITH DEBUGGING MODE. - INPUT-OUTPUT SECTION. - FILE-CONTROL. - SELECT TEST-FILE ASSIGN "./TEST-FILE" FILE STATUS FS. - DATA DIVISION. - FILE SECTION. - FD TEST-FILE. - 01 TEST-REC PIC X(40). - WORKING-STORAGE SECTION. - 01 FS PIC X(2). - PROCEDURE DIVISION. - DECLARATIVES. - TEST-DEBUG SECTION. - USE FOR DEBUGGING ON TEST-FILE. - DISPLAY DEBUG-ITEM "|" END-DISPLAY. - END DECLARATIVES. - SOME-PAR. - OPEN OUTPUT TEST-FILE. - WRITE TEST-REC FROM "DEF". - CLOSE TEST-FILE. - OPEN INPUT TEST-FILE. - READ TEST-FILE. - CLOSE TEST-FILE. - STOP RUN. -_ATEOF - -{ set +x -$as_echo "$at_srcdir/run_fundamental.at:5191: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_fundamental.at:5191" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_fundamental.at:5191" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_fundamental.at:5192: COB_SET_DEBUG=1 \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "COB_SET_DEBUG=1 $COBCRUN_DIRECT ./prog" "run_fundamental.at:5192" -( $at_check_trace; COB_SET_DEBUG=1 $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo " 23 TEST-FILE | - 25 TEST-FILE | - 26 TEST-FILE | - 27 TEST-FILE DEF | - 28 TEST-FILE | -" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_fundamental.at:5192" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_503 -#AT_START_504 -at_fn_group_banner 504 'run_fundamental.at:5203' \ - "Abbreviated Expressions" " " 4 -at_xfail=no -( - $as_echo "504. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - CONFIGURATION SECTION. - SPECIAL-NAMES. - SWITCH-1 - IS WRK-SWITCH-1 - ON STATUS IS ON-WRK-SWITCH-1 - OFF STATUS IS OFF-WRK-SWITCH-1 - SWITCH-2 - IS WRK-SWITCH-2 - OFF STATUS IS OFF-WRK-SWITCH-2. - DATA DIVISION. - ****************************************************************** - WORKING-STORAGE SECTION. - * - 01 FLD9-0 PIC 9 VALUE 0. - 01 FLD9-1 PIC 9 VALUE 1. - 01 FLD9-2 PIC 9 VALUE 2. - 01 FLD9-5 PIC 9 VALUE 5. - 01 FLD9-7 PIC 9 VALUE 7. - 01 FLD9-9 PIC 9 VALUE 9. - 01 FLDX PIC X VALUE 'X'. - 01 FLDY PIC X VALUE 'Y'. - 01 FLDYY PIC X VALUE 'Y'. - 01 FLDZ PIC X VALUE 'Z'. - 01 TESTNUM PIC 99 VALUE 1. - - PROCEDURE DIVISION. - MAIN-LINE. - - IF FLD9-7 > FLD9-5 AND NOT < FLD9-0 OR FLD9-1 - PERFORM PASS ELSE PERFORM FAIL. - IF FLD9-7 NOT = FLD9-5 OR FLD9-1 - PERFORM PASS ELSE PERFORM FAIL. - IF FLD9-7 NOT = FLD9-5 AND FLD9-1 - PERFORM PASS ELSE PERFORM FAIL. - IF NOT FLD9-7 = FLD9-5 OR FLD9-1 - PERFORM PASS ELSE PERFORM FAIL. - IF NOT (FLD9-5 > FLD9-7 OR < FLD9-1) - PERFORM PASS ELSE PERFORM FAIL. - IF NOT (FLD9-7 NOT > FLD9-5 AND FLD9-2 AND NOT FLD9-1) - PERFORM PASS ELSE PERFORM FAIL. - IF FLD9-9 > FLD9-2 AND FLD9-7 AND FLD9-5 - PERFORM PASS ELSE PERFORM FAIL. - IF FLD9-9 > FLD9-2 AND FLD9-7 OR FLD9-5 - PERFORM PASS ELSE PERFORM FAIL. - IF FLD9-1 < FLD9-2 AND FLD9-5 AND FLD9-7 - PERFORM PASS ELSE PERFORM FAIL. - - * // DISPLAY "***Constant expressions***". - IF 9 > 2 AND 7 AND 5 AND 1 - PERFORM PASS ELSE PERFORM FAIL. - IF 1 < 2 AND 5 AND 7 AND 9 - PERFORM PASS ELSE PERFORM FAIL. - IF 5 < 2 OR 1 OR 9 OR 7 - PERFORM PASS ELSE PERFORM FAIL. - IF 5 > 1 AND < 3 OR 6 - PERFORM PASS ELSE PERFORM FAIL. - - * // DISPLAY "***Switch expressions***". - IF ON-WRK-SWITCH-1 - OR NOT OFF-WRK-SWITCH-2 - AND OFF-WRK-SWITCH-1 - PERFORM FAIL ELSE PERFORM PASS. - DISPLAY "***FINE***" WITH NO ADVANCING. - STOP RUN. - - PASS. - * // DISPLAY 'Test ' TESTNUM ' passed' - ADD 1 TO TESTNUM. - - FAIL. - DISPLAY 'Test ' TESTNUM ' failed!' - ADD 1 TO TESTNUM. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_fundamental.at:5284: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_fundamental.at:5284" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob: in paragraph 'MAIN-LINE': -prog.cob:47: warning: suggest parentheses around AND within OR -prog.cob:53: warning: expression '9' GREATER THAN '2' is always TRUE -prog.cob:53: warning: expression '9' GREATER THAN '7' is always TRUE -prog.cob:53: warning: expression '9' GREATER THAN '5' is always TRUE -prog.cob:53: warning: expression '9' GREATER THAN '1' is always TRUE -prog.cob:55: warning: expression '1' LESS THAN '2' is always TRUE -prog.cob:55: warning: expression '1' LESS THAN '5' is always TRUE -prog.cob:55: warning: expression '1' LESS THAN '7' is always TRUE -prog.cob:55: warning: expression '1' LESS THAN '9' is always TRUE -prog.cob:57: warning: expression '5' LESS THAN '2' is always FALSE -prog.cob:57: warning: expression '5' LESS THAN '1' is always FALSE -prog.cob:57: warning: expression '5' LESS THAN '9' is always TRUE -prog.cob:57: warning: expression '5' LESS THAN '7' is always TRUE -prog.cob:59: warning: expression '5' GREATER THAN '1' is always TRUE -prog.cob:59: warning: expression '5' LESS THAN '3' is always FALSE -prog.cob:59: warning: expression '5' LESS THAN '6' is always TRUE -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_fundamental.at:5284" -$at_failed && at_fn_log_failure -$at_traceon; } - - -{ set +x -$as_echo "$at_srcdir/run_fundamental.at:5304: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_fundamental.at:5304" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo "***FINE***" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_fundamental.at:5304" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_504 -#AT_START_505 -at_fn_group_banner 505 'run_fundamental.at:5309' \ - "integer arithmetic on floating-point var" " " 4 -at_xfail=no -( - $as_echo "505. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 x USAGE FLOAT-SHORT VALUE 123.456. - - PROCEDURE DIVISION. - ADD 360 TO x - IF x <> 483.456 - DISPLAY "ADD wrong: " x - MOVE 483.456 TO x - END-IF - - SUBTRACT 360 FROM x - IF x <> 123.456 - DISPLAY "SUBTRACT wrong: " x - MOVE 123.456 TO x - END-IF - - DIVIDE 2 INTO x - IF x <> 61.728 - DISPLAY "DIVIDE wrong: " x - MOVE 61.728 TO x - END-IF - - MULTIPLY 2 BY x - IF x <> 123.456 - DISPLAY "MULTIPLY wrong: " x - END-IF - . -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_fundamental.at:5346: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_fundamental.at:5346" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_fundamental.at:5346" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_fundamental.at:5347: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_fundamental.at:5347" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_fundamental.at:5347" -$at_failed && at_fn_log_failure -$at_traceon; } - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_505 -#AT_START_506 -at_fn_group_banner 506 'run_subscripts.at:26' \ - "Subscript out of bounds" " " 4 -at_xfail=no -( - $as_echo "506. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 G. - 02 X PIC X OCCURS 10. - 01 I PIC 9 VALUE 0. - PROCEDURE DIVISION. - DISPLAY X(I) - END-DISPLAY. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_subscripts.at:43: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_subscripts.at:43" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_subscripts.at:43" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_subscripts.at:44: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_subscripts.at:44" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "libcob: prog.cob:10: error: subscript of 'X' out of bounds: 0 -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/run_subscripts.at:44" -$at_failed && at_fn_log_failure -$at_traceon; } - - -cat >prog2.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog2. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 G. - 02 X PIC X OCCURS 10. - 01 I PIC 99 VALUE 11. - PROCEDURE DIVISION. - DISPLAY X(I) - END-DISPLAY. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_subscripts.at:62: \$COMPILE prog2.cob" -at_fn_check_prepare_dynamic "$COMPILE prog2.cob" "run_subscripts.at:62" -( $at_check_trace; $COMPILE prog2.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_subscripts.at:62" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_subscripts.at:63: \$COBCRUN_DIRECT ./prog2" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog2" "run_subscripts.at:63" -( $at_check_trace; $COBCRUN_DIRECT ./prog2 -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "libcob: prog2.cob:10: error: subscript of 'X' out of bounds: 11 - maximum subscript for 'X': 10 -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/run_subscripts.at:63" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_506 -#AT_START_507 -at_fn_group_banner 507 'run_subscripts.at:71' \ - "Value of DEPENDING ON N out of bounds" " " 4 -at_xfail=no -( - $as_echo "507. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 G. - 02 X PIC X OCCURS 4 TO 6 DEPENDING ON N. - 01 N PIC 9. - PROCEDURE DIVISION. - MOVE 5 TO N. - MOVE '12345' TO G - DISPLAY X(3) WITH NO ADVANCING - END-DISPLAY. - MOVE 3 TO N. - DISPLAY X(5) - END-DISPLAY. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_subscripts.at:93: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_subscripts.at:93" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_subscripts.at:93" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_subscripts.at:94: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_subscripts.at:94" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "libcob: prog.cob:15: error: OCCURS DEPENDING ON 'N' out of bounds: 3 - minimum subscript for 'X': 4 -" | \ - $at_diff - "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo "3" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/run_subscripts.at:94" -$at_failed && at_fn_log_failure -$at_traceon; } - - -cat >prog2.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog2. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 G. - 02 X PIC X OCCURS 4 TO 6 DEPENDING ON N. - 01 N PIC 9 VALUE 7. - PROCEDURE DIVISION. - DISPLAY X(5) - END-DISPLAY. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_subscripts.at:113: \$COMPILE prog2.cob" -at_fn_check_prepare_dynamic "$COMPILE prog2.cob" "run_subscripts.at:113" -( $at_check_trace; $COMPILE prog2.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_subscripts.at:113" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_subscripts.at:114: \$COBCRUN_DIRECT ./prog2" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog2" "run_subscripts.at:114" -( $at_check_trace; $COBCRUN_DIRECT ./prog2 -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "libcob: prog2.cob:10: error: OCCURS DEPENDING ON 'N' out of bounds: 7 - maximum subscript for 'X': 6 -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/run_subscripts.at:114" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_507 -#AT_START_508 -at_fn_group_banner 508 'run_subscripts.at:122' \ - "Subscript bounds with OCCURS DEPENDING ON" " " 4 -at_xfail=no -( - $as_echo "508. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 G. - 02 X PIC X OCCURS 4 TO 6 DEPENDING ON N. - 01 N PIC 9 VALUE 4. - PROCEDURE DIVISION. - DISPLAY X(5) - END-DISPLAY. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_subscripts.at:139: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_subscripts.at:139" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_subscripts.at:139" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_subscripts.at:140: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_subscripts.at:140" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "libcob: prog.cob:10: error: subscript of 'X' out of bounds: 5 - current maximum subscript for 'X': 4 -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/run_subscripts.at:140" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_508 -#AT_START_509 -at_fn_group_banner 509 'run_subscripts.at:148' \ - "Subscript by arithmetic expression" " " 4 -at_xfail=no -( - $as_echo "509. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 G VALUE "1234". - 02 X PIC X OCCURS 4. - 01 Z PIC X. - PROCEDURE DIVISION. - MOVE X((3 + 1) / 2) TO Z. - IF Z NOT = "2" - DISPLAY Z - END-DISPLAY - END-IF. - MOVE X(2 ** 2) TO Z. - IF Z NOT = "4" - DISPLAY Z - END-DISPLAY - END-IF. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_subscripts.at:173: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_subscripts.at:173" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_subscripts.at:173" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_subscripts.at:174: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_subscripts.at:174" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_subscripts.at:174" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_509 -#AT_START_510 -at_fn_group_banner 510 'run_subscripts.at:179' \ - "length of ODO w/- reference modification" " " 4 -at_xfail=no -( - $as_echo "510. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 PLINE. - 03 PLINE-LEN PIC S9(4) COMP-5. - 03 PLINE-TEXT. - 04 FILLER PIC X(1) OCCURS 1 TO 80 - DEPENDING ON PLINE-LEN. - procedure division. - a-main section. - MOVE 5 TO PLINE-LEN - MOVE 'the first part in' TO PLINE-TEXT - MOVE 30 TO PLINE-LEN - IF PLINE-TEXT NOT = 'the f' - DISPLAY 'text1 wrong: ' PLINE-TEXT - END-DISPLAY - END-IF - MOVE 'the first part in' TO PLINE-TEXT - MOVE 4 TO PLINE-LEN - MOVE 'second' TO PLINE-TEXT - MOVE 14 TO PLINE-LEN - IF PLINE-TEXT NOT = 'secofirst part' - DISPLAY 'text2 wrong: ' PLINE-TEXT - END-DISPLAY - END-IF - MOVE 80 TO PLINE-LEN - MOVE SPACES TO PLINE-TEXT - MOVE 5 TO PLINE-LEN - MOVE 'the first part in' TO PLINE-TEXT (2:) - MOVE 30 TO PLINE-LEN - IF PLINE-TEXT NOT = ' the ' - DISPLAY 'text3 wrong: ' PLINE-TEXT - END-DISPLAY - END-IF - MOVE 'the first part in' TO PLINE-TEXT (2:) - MOVE 4 TO PLINE-LEN - MOVE 'second' TO PLINE-TEXT (2:) - MOVE 14 TO PLINE-LEN - IF PLINE-TEXT NOT = ' sec first par' - DISPLAY 'text4 wrong: ' PLINE-TEXT - END-DISPLAY - END-IF - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_subscripts.at:229: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_subscripts.at:229" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_subscripts.at:229" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_subscripts.at:230: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_subscripts.at:230" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_subscripts.at:230" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_510 -#AT_START_511 -at_fn_group_banner 511 'run_subscripts.at:235' \ - "SEARCH ALL with OCCURS DEPENDING ON" " " 4 -at_xfail=no -( - $as_echo "511. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - * - 77 SCREEN-AKT PIC 9(02) VALUE 0. - 01 SCREEN-TAB. - 03 SCREEN-ENTRY OCCURS 0 TO 20 - DEPENDING ON SCREEN-AKT - ASCENDING KEY SCREEN-NAME - INDEXED BY SCREEN-IDX. - 05 SCREEN-NAME PIC X(02). - - PROCEDURE DIVISION. - - SEARCH ALL SCREEN-ENTRY - AT END - DISPLAY 'END' - WHEN SCREEN-NAME (SCREEN-IDX) = 'AB' - DISPLAY 'FOUND' - END-SEARCH - MOVE 1 TO SCREEN-AKT - MOVE 'AB' TO SCREEN-NAME (1) - SEARCH ALL SCREEN-ENTRY - AT END - DISPLAY 'END' - WHEN SCREEN-NAME (SCREEN-IDX) = 'AB' - DISPLAY 'FOUND' - END-SEARCH - MOVE 2 TO SCREEN-AKT - MOVE 'CD' TO SCREEN-NAME (2) - SEARCH ALL SCREEN-ENTRY - AT END - DISPLAY 'END' - WHEN SCREEN-NAME (SCREEN-IDX) = 'CD' - DISPLAY 'FOUND' - END-SEARCH - EXIT PROGRAM. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_subscripts.at:279: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_subscripts.at:279" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_subscripts.at:279" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_subscripts.at:280: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_subscripts.at:280" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo "END -FOUND -FOUND -" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_subscripts.at:280" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_511 -#AT_START_512 -at_fn_group_banner 512 'run_refmod.at:25' \ - "Static reference modification" " " 4 -at_xfail=no -( - $as_echo "512. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 X PIC X(4) VALUE "abcd". - PROCEDURE DIVISION. - DISPLAY X(1:1) ":" X(1:2) ":" X(1:3) ":" X(1:4) ":" X(1:) - END-DISPLAY. - DISPLAY X(2:1) ":" X(2:2) ":" X(2:3) ":" X(2:) - END-DISPLAY. - DISPLAY X(3:1) ":" X(3:2) ":" X(3:) - END-DISPLAY. - DISPLAY X(4:1) ":" X(4:) - END-DISPLAY. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_refmod.at:46: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_refmod.at:46" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_refmod.at:46" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_refmod.at:47: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_refmod.at:47" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo "a:ab:abc:abcd:abcd -b:bc:bcd:bcd -c:cd:cd -d:d -" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_refmod.at:47" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_512 -#AT_START_513 -at_fn_group_banner 513 'run_refmod.at:57' \ - "Dynamic reference modification" " " 4 -at_xfail=no -( - $as_echo "513. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 X PIC X(4) VALUE "abcd". - 01 I PIC 9. - PROCEDURE DIVISION. - MOVE 1 TO I. - DISPLAY X(I:1) - END-DISPLAY. - MOVE 4 TO I. - DISPLAY X(I:1) - END-DISPLAY. - MOVE 1 TO I. - DISPLAY X(1:I) - END-DISPLAY. - MOVE 4 TO I. - DISPLAY X(1:I) - END-DISPLAY. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_refmod.at:83: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_refmod.at:83" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_refmod.at:83" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_refmod.at:84: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_refmod.at:84" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo "a -d -a -abcd -" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_refmod.at:84" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_513 -#AT_START_514 -at_fn_group_banner 514 'run_refmod.at:94' \ - "Offset underflow" " " 4 -at_xfail=no -( - $as_echo "514. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 X PIC X(4) VALUE "abcd". - 01 I PIC 9 VALUE 0. - PROCEDURE DIVISION. - DISPLAY X(I:1) NO ADVANCING - END-DISPLAY. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_refmod.at:110: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_refmod.at:110" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_refmod.at:110" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_refmod.at:111: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_refmod.at:111" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "libcob: prog.cob:9: error: offset of 'X' out of bounds: 0 -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/run_refmod.at:111" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_514 -#AT_START_515 -at_fn_group_banner 515 'run_refmod.at:118' \ - "Offset overflow" " " 4 -at_xfail=no -( - $as_echo "515. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 X PIC X(4) VALUE "abcd". - 01 I PIC 9 VALUE 5. - PROCEDURE DIVISION. - DISPLAY X(I:1) NO ADVANCING - END-DISPLAY. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_refmod.at:134: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_refmod.at:134" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_refmod.at:134" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_refmod.at:135: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_refmod.at:135" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "libcob: prog.cob:9: error: offset of 'X' out of bounds: 5, maximum: 4 -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/run_refmod.at:135" -$at_failed && at_fn_log_failure -$at_traceon; } - - -cat >prog2.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog2. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 X PIC X(4) VALUE "abcd". - 01 I PIC 9 VALUE 5. - PROCEDURE DIVISION. - DISPLAY X(I:1) NO ADVANCING - END-DISPLAY. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_refmod.at:152: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_refmod.at:152" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_refmod.at:152" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_refmod.at:153: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_refmod.at:153" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "libcob: prog.cob:9: error: offset of 'X' out of bounds: 5, maximum: 4 -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/run_refmod.at:153" -$at_failed && at_fn_log_failure -$at_traceon; } - - -{ set +x -$as_echo "$at_srcdir/run_refmod.at:157: \$COMPILE prog2.cob" -at_fn_check_prepare_dynamic "$COMPILE prog2.cob" "run_refmod.at:157" -( $at_check_trace; $COMPILE prog2.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_refmod.at:157" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_refmod.at:158: \$COBCRUN_DIRECT ./prog2" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog2" "run_refmod.at:158" -( $at_check_trace; $COBCRUN_DIRECT ./prog2 -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "libcob: prog2.cob:9: error: offset of 'X' out of bounds: 5, maximum: 4 -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/run_refmod.at:158" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_515 -#AT_START_516 -at_fn_group_banner 516 'run_refmod.at:165' \ - "Length underflow" " " 4 -at_xfail=no -( - $as_echo "516. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 X PIC X(4) VALUE "abcd". - 01 I PIC 9 VALUE 0. - PROCEDURE DIVISION. - DISPLAY X(1:I) NO ADVANCING - END-DISPLAY. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_refmod.at:181: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_refmod.at:181" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_refmod.at:181" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_refmod.at:182: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_refmod.at:182" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "libcob: prog.cob:9: error: length of 'X' out of bounds: 0 -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/run_refmod.at:182" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_516 -#AT_START_517 -at_fn_group_banner 517 'run_refmod.at:189' \ - "Length overflow" " " 4 -at_xfail=no -( - $as_echo "517. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 X PIC X(4) VALUE "abcd". - 01 I PIC 9 VALUE 5. - PROCEDURE DIVISION. - DISPLAY X(1:I) NO ADVANCING - END-DISPLAY. - STOP RUN. -_ATEOF - - -cat >prog2.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog2. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 X PIC X(4) VALUE "abcd". - 01 I PIC 9 VALUE 5. - PROCEDURE DIVISION. - DISPLAY X(3:I) NO ADVANCING - END-DISPLAY. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_refmod.at:218: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_refmod.at:218" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_refmod.at:218" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_refmod.at:219: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_refmod.at:219" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "libcob: prog.cob:9: error: length of 'X' out of bounds: 5, maximum: 4 -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/run_refmod.at:219" -$at_failed && at_fn_log_failure -$at_traceon; } - - -{ set +x -$as_echo "$at_srcdir/run_refmod.at:223: \$COMPILE prog2.cob" -at_fn_check_prepare_dynamic "$COMPILE prog2.cob" "run_refmod.at:223" -( $at_check_trace; $COMPILE prog2.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_refmod.at:223" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_refmod.at:224: \$COBCRUN_DIRECT ./prog2" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog2" "run_refmod.at:224" -( $at_check_trace; $COBCRUN_DIRECT ./prog2 -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "libcob: prog2.cob:9: error: length of 'X' out of bounds: 5, maximum: 4 -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/run_refmod.at:224" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_517 -#AT_START_518 -at_fn_group_banner 518 'run_refmod.at:231' \ - "Length overflow with offset" " " 4 -at_xfail=no -( - $as_echo "518. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 X PIC X(4) VALUE "abcd". - 01 I PIC 9 VALUE 3. - PROCEDURE DIVISION. - DISPLAY X(3:I) NO ADVANCING - END-DISPLAY. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_refmod.at:247: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_refmod.at:247" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_refmod.at:247" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_refmod.at:248: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_refmod.at:248" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "libcob: prog.cob:9: error: length of 'X' out of bounds: 3, starting at: 3, maximum: 4 -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/run_refmod.at:248" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_518 -#AT_START_519 -at_fn_group_banner 519 'run_refmod.at:254' \ - "Test Reference Modification" " " 4 -at_xfail=no -( - $as_echo "519. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 TSTLEN PIC 99 VALUE 10. - 01 TSTBIN PIC 99 COMP VALUE 10. - 01 TSTBIN10 PIC 9(9) COMP VALUE 825373492. - 01 TSTX4 PIC X(4). - 01 TSTREC. - 05 TSTTAIL2 PIC X. - 05 TSTTAIL3 PIC X. - 05 FILLER PIC X(8). - 05 TSTEND PIC X. - 01 TSTREC2 PIC X(20). - 01 TSTXX PIC X(2). - PROCEDURE DIVISION. - MOVE ALL "x" TO TSTREC. - DISPLAY "MOVEs to TSTTAIL3 (2:8)". - MOVE SPACES TO TSTTAIL3 (2:8). - DISPLAY "SPACES : " TSTREC. - MOVE ALL "x" TO TSTREC. - MOVE ALL " " TO TSTTAIL3 (2:8). - DISPLAY "ALL ' ': " TSTREC. - MOVE ALL "x" TO TSTREC. - MOVE " " TO TSTTAIL3 (2:8). - DISPLAY "' ' : " TSTREC. - MOVE ALL "x" TO TSTREC. - MOVE "ABC" TO TSTTAIL3 (2:8). - DISPLAY "ABC : " TSTREC. - MOVE ALL "x" TO TSTREC. - MOVE X"4142" TO TSTTAIL3 (2:8). - DISPLAY "x4142 : " TSTREC. - IF TSTTAIL3 (2:8) = X"4142" - DISPLAY "IF = 'AB' is good" - ELSE - DISPLAY "IF = 'AB' is Bad!" - END-IF. - - DISPLAY "MOVEs to TSTREC2 (3:15)". - MOVE ALL "x" TO TSTREC2. - MOVE SPACES TO TSTREC2 (3:15). - DISPLAY "SPACE : " TSTREC2. - MOVE ALL "x" TO TSTREC2. - MOVE ALL " " TO TSTREC2 (3:15). - DISPLAY "ALL' ' : " TSTREC2. - MOVE ALL "x" TO TSTREC2. - MOVE " " TO TSTREC2 (3:15). - DISPLAY "' ' : " TSTREC2. - MOVE ALL "x" TO TSTREC2. - MOVE "DEF" TO TSTREC2 (3:15). - DISPLAY "DEF : " TSTREC2. - MOVE ALL "x" TO TSTREC2. - MOVE X"4344" TO TSTREC2 (3:15). - DISPLAY "x4344 : " TSTREC2. - - MOVE SPACES TO TSTREC2. - - MOVE " " TO TSTTAIL2 (1:2). - MOVE ALL "*" TO TSTREC (1:TSTLEN). - MOVE '$' TO TSTEND. - DISPLAY "TSTREC is " TSTREC. - MOVE ALL "+" TO TSTTAIL3 (1:TSTLEN). - MOVE '$' TO TSTEND. - DISPLAY "TSTREC is " TSTREC. - MOVE 11 to TSTLEN. - MOVE SPACES TO TSTTAIL2 (1:TSTLEN). - MOVE '$' TO TSTEND. - DISPLAY "TSTREC is " TSTREC. - MOVE '12' TO TSTXX. - MOVE TSTXX TO TSTLEN. - DISPLAY "TSTLEN is " TSTLEN. - MOVE ' 3' TO TSTXX. - MOVE TSTXX TO TSTLEN. - DISPLAY "TSTLEN is " TSTLEN. - MOVE ' ' TO TSTXX. - MOVE TSTXX TO TSTLEN. - DISPLAY "TSTLEN is " TSTLEN. - MOVE 75 TO TSTLEN. - MOVE TSTLEN TO TSTXX. - DISPLAY "TSTXX is " TSTXX " vs " TSTLEN. - MOVE ' 3' TO TSTXX. - MOVE TSTXX TO TSTBIN. - DISPLAY "TSTBIN is " TSTBIN. - ADD 1 to TSTBIN. - MOVE TSTBIN TO TSTXX. - DISPLAY "TSTXX is " TSTXX " vs " TSTBIN. - MOVE TSTBIN10 (1:4) TO TSTX4 (1:4). - DISPLAY "TSTBIN10 is " TSTBIN10 " vs '" TSTX4 "'". - MOVE 10 TO TSTLEN. - MOVE ALL "x" TO TSTTAIL3 (1:TSTLEN + 2). - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_refmod.at:351: cobc -x -std=mf -debug -Wall prog.cob " -at_fn_check_prepare_trace "run_refmod.at:351" -( $at_check_trace; cobc -x -std=mf -debug -Wall prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_refmod.at:351" -$at_failed && at_fn_log_failure -$at_traceon; } - - -{ set +x -$as_echo "$at_srcdir/run_refmod.at:353: ./prog" -at_fn_check_prepare_trace "run_refmod.at:353" -( $at_check_trace; ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "libcob: prog.cob:91: error: length of 'TSTTAIL3' out of bounds: 12, maximum: 10 -" | \ - $at_diff - "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo "MOVEs to TSTTAIL3 (2:8) -SPACES : xx x -ALL ' ': xx x -' ' : xx x -ABC : xxABC x -x4142 : xxAB x -IF = 'AB' is good -MOVEs to TSTREC2 (3:15) -SPACE : xx xxx -ALL' ' : xx xxx -' ' : xx xxx -DEF : xxDEF xxx -x4344 : xxCD xxx -TSTREC is **********\$ -TSTREC is *+++++++++\$ -TSTREC is \$ -TSTLEN is 12 -TSTLEN is 03 -TSTLEN is 00 -TSTXX is 75 vs 75 -TSTBIN is 03 -TSTXX is 04 vs 04 -TSTBIN10 is 825373492 vs '1234' -" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/run_refmod.at:353" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_519 -#AT_START_520 -at_fn_group_banner 520 'run_accept.at:28' \ - "ACCEPT OMITTED (simple)" " " 4 -at_xfail=no -( - $as_echo "520. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - - DATA DIVISION. - - PROCEDURE DIVISION. - ACCEPT OMITTED - END-ACCEPT. -_ATEOF - - -cat >input.txt <<'_ATEOF' - -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_accept.at:45: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_accept.at:45" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_accept.at:45" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_accept.at:46: \$COBCRUN_DIRECT ./prog < input.txt" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog < input.txt" "run_accept.at:46" -( $at_check_trace; $COBCRUN_DIRECT ./prog < input.txt -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_accept.at:46" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_520 -#AT_START_521 -at_fn_group_banner 521 'run_accept.at:54' \ - "ACCEPT FROM TIME / DATE / DAY / DAY-OF-WEEK (1)" "" 4 -at_xfail=no -( - $as_echo "521. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - *> one byte longer to make sure there is no garbage in - 01 X PIC X(9). - PROCEDURE DIVISION. - ACCEPT X FROM TIME - END-ACCEPT - IF X (1:2) >= "00" AND <= "23" AND - X (3:2) >= "00" AND <= "59" AND - X (5:2) >= "00" AND <= "60" AND - X (7:2) >= "00" AND <= "99" AND - X (9: ) = SPACE - CONTINUE - ELSE - DISPLAY "TIME " X "!" - END-DISPLAY - END-IF - ACCEPT X FROM DATE - END-ACCEPT - INSPECT X CONVERTING "012345678" TO "999999999" - IF X NOT = "999999" - DISPLAY "DATE " X "!" - END-DISPLAY - END-IF - ACCEPT X FROM DATE YYYYMMDD - END-ACCEPT - INSPECT X CONVERTING "012345678" TO "999999999" - IF X NOT = "99999999" - DISPLAY "YYYYMMDD " X "!" - END-DISPLAY - END-IF - ACCEPT X FROM DAY - END-ACCEPT - INSPECT X CONVERTING "012345678" TO "999999999" - IF X NOT = "99999" - DISPLAY "DAY " X "!" - END-DISPLAY - END-IF - ACCEPT X FROM DAY YYYYDDD - END-ACCEPT - INSPECT X CONVERTING "012345678" TO "999999999" - IF X NOT = "9999999" - DISPLAY "YYYYDDD " X "!" - END-DISPLAY - END-IF - ACCEPT X FROM DAY-OF-WEEK - END-ACCEPT - INSPECT X CONVERTING "1234567" TO "9999999" - IF X NOT = "9" - DISPLAY "DAY-OF-WEEK " X "!" - END-DISPLAY - END-IF - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_accept.at:115: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_accept.at:115" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_accept.at:115" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_accept.at:116: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_accept.at:116" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_accept.at:116" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_521 -#AT_START_522 -at_fn_group_banner 522 'run_accept.at:121' \ - "ACCEPT FROM TIME / DATE / DAY / DAY-OF-WEEK (2)" "" 4 -at_xfail=no -( - $as_echo "522. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - *> one byte longer to make sure there is no garbage in - 01 WS-YYYYMMDD PIC X(9). - 01 WS-YYYYDDD PIC X(8). - 01 WS-DAYOFWEEK PIC X(2). - 01 WS-DATE-TODAY. - 05 WS-TODAYS-YY PIC 9(02) VALUE 0. - 05 WS-TODAYS-MM PIC 9(02) VALUE 0. - 05 WS-TODAYS-DD PIC 9(02) VALUE 0. - - 01 WS-DATE. - 05 WS-DATE-MM PIC 9(02) VALUE 0. - 05 FILLER PIC X(01) VALUE '/'. - 05 WS-DATE-DD PIC 9(02) VALUE 0. - 05 FILLER PIC X(01) VALUE '/'. - 05 WS-DATE-YY PIC 9(02) VALUE 0. - - 01 WS-TIME-NOW. - 05 WS-NOW-HH PIC 9(02) VALUE 0. - 05 WS-NOW-MM PIC 9(02) VALUE 0. - 05 WS-NOW-SS PIC 9(02) VALUE 0. - 05 WS-NOW-HS PIC 9(02) VALUE 0. - - 01 WS-TIME. - 05 WS-TIME-HH PIC 9(02) VALUE 0. - 05 FILLER PIC X(01) VALUE ':'. - 05 WS-TIME-MM PIC 9(02) VALUE 0. - 05 FILLER PIC X(01) VALUE ':'. - 05 WS-TIME-SS PIC 9(02) VALUE 0. - - PROCEDURE DIVISION. - ACCEPT WS-DATE-TODAY FROM DATE - ACCEPT WS-TIME-NOW FROM TIME - MOVE WS-TODAYS-YY TO WS-DATE-YY - MOVE WS-TODAYS-MM TO WS-DATE-MM - MOVE WS-TODAYS-DD TO WS-DATE-DD - MOVE WS-NOW-HH TO WS-TIME-HH - MOVE WS-NOW-MM TO WS-TIME-MM - MOVE WS-NOW-SS TO WS-TIME-SS - DISPLAY 'PROCESS DATE/TIME : ' WS-DATE ' ' WS-TIME - WITH NO ADVANCING - END-DISPLAY - ACCEPT WS-YYYYMMDD FROM DATE YYYYMMDD - IF WS-YYYYMMDD not = "20150405" - DISPLAY 'Wrong date DATE YYYYMMDD: ' WS-YYYYMMDD - ' expected: 20150405' - UPON SYSERR - END-DISPLAY - END-IF - ACCEPT WS-YYYYDDD FROM DAY YYYYDDD - IF WS-YYYYDDD not = "2015095" - DISPLAY 'Wrong date YYYYDDD: ' WS-YYYYDDD - ' expected: 2015095' - UPON SYSERR - END-DISPLAY - END-IF - ACCEPT WS-DAYOFWEEK FROM DAY-OF-WEEK - IF WS-DAYOFWEEK not = "7" - DISPLAY 'Wrong date DAYOFWEEK: ' WS-DAYOFWEEK - ' expected: 7' - UPON SYSERR - END-DISPLAY - END-IF - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_accept.at:194: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_accept.at:194" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_accept.at:194" -$at_failed && at_fn_log_failure -$at_traceon; } - - -{ set +x -$as_echo "$at_srcdir/run_accept.at:196: COB_CURRENT_DATE='2015/04/05 18:45:22' \\ -\$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_notrace 'an embedded newline' "run_accept.at:196" -( $at_check_trace; COB_CURRENT_DATE='2015/04/05 18:45:22' \ -$COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo "PROCESS DATE/TIME : 04/05/15 18:45:22" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_accept.at:196" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_522 -#AT_START_523 -at_fn_group_banner 523 'run_accept.at:204' \ - "ACCEPT DATE / DAY and intrinsic functions (1)" " " 4 -at_xfail=no -( - $as_echo "523. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - *> one byte longer to make sure there is no garbage in - 01 WS-YYYYMMDD PIC 9(9). - 01 WS-YYYYDDD PIC 9(8). - PROCEDURE DIVISION. - ACCEPT WS-YYYYMMDD FROM DATE YYYYMMDD - END-ACCEPT - ACCEPT WS-YYYYDDD FROM DAY YYYYDDD - END-ACCEPT - IF FUNCTION INTEGER-OF-DATE (WS-YYYYMMDD) - NOT = FUNCTION INTEGER-OF-DAY (WS-YYYYDDD) - DISPLAY "DIFFERENCES FOUND!" - END-DISPLAY - DISPLAY "YYYYMMDD = " WS-YYYYMMDD ", " - "YYYYDDD = " WS-YYYYDDD - END-DISPLAY - DISPLAY "INTEGER-OF-DATE = " - FUNCTION INTEGER-OF-DATE (WS-YYYYMMDD) ", " - "INTEGER-OF-DAY = " - FUNCTION INTEGER-OF-DAY (WS-YYYYDDD) - END-DISPLAY - MOVE 1 TO RETURN-CODE - END-IF - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_accept.at:237: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_accept.at:237" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_accept.at:237" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_accept.at:238: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_accept.at:238" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_accept.at:238" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_523 -#AT_START_524 -at_fn_group_banner 524 'run_accept.at:241' \ - "ACCEPT DATE / DAY and intrinsic functions (2)" " " 4 -at_xfail=no -( - $as_echo "524. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - *> one byte longer to make sure there is no garbage in - 01 WS-YYYYMMDD PIC 9(9). - 01 WS-YYYYDDD PIC 9(8). - PROCEDURE DIVISION. - ACCEPT WS-YYYYMMDD FROM DATE YYYYMMDD - END-ACCEPT - ACCEPT WS-YYYYDDD FROM DAY YYYYDDD - END-ACCEPT - IF FUNCTION INTEGER-OF-DATE (WS-YYYYMMDD) - NOT = FUNCTION INTEGER-OF-DAY (WS-YYYYDDD) - DISPLAY "DIFFERENCES FOUND!" - END-DISPLAY - DISPLAY "YYYYMMDD = " WS-YYYYMMDD ", " - "YYYYDDD = " WS-YYYYDDD - END-DISPLAY - DISPLAY "INTEGER-OF-DATE = " - FUNCTION INTEGER-OF-DATE (WS-YYYYMMDD) ", " - "INTEGER-OF-DAY = " - FUNCTION INTEGER-OF-DAY (WS-YYYYDDD) - END-DISPLAY - MOVE 1 TO RETURN-CODE - END-IF - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_accept.at:274: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_accept.at:274" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_accept.at:274" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_accept.at:275: COB_CURRENT_DATE='2015/04/05 18:45:22' \\ -\$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_notrace 'an embedded newline' "run_accept.at:275" -( $at_check_trace; COB_CURRENT_DATE='2015/04/05 18:45:22' \ -$COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_accept.at:275" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_524 -#AT_START_525 -at_fn_group_banner 525 'run_accept.at:286' \ - "ACCEPT OMITTED (SCREEN)" " " 4 -at_xfail=no -( - $as_echo "525. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -{ set +x -$as_echo "$at_srcdir/run_accept.at:289: test \"\$COB_HAS_CURSES\" = \"yes\" || exit 77" -at_fn_check_prepare_dynamic "test \"$COB_HAS_CURSES\" = \"yes\" || exit 77" "run_accept.at:289" -( $at_check_trace; test "$COB_HAS_CURSES" = "yes" || exit 77 -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_accept.at:289" -$at_failed && at_fn_log_failure -$at_traceon; } - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - - DATA DIVISION. - SCREEN SECTION. - 01 scr. - 03 VALUE "Hello!" LINE 3 COL 3. - - PROCEDURE DIVISION. - ACCEPT OMITTED - END-ACCEPT. -_ATEOF - - -cat >input.txt <<'_ATEOF' - -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_accept.at:308: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_accept.at:308" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_accept.at:308" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_accept.at:309: \$COBCRUN_DIRECT ./prog < input.txt" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog < input.txt" "run_accept.at:309" -( $at_check_trace; $COBCRUN_DIRECT ./prog < input.txt -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo stdout:; cat "$at_stdout" -at_fn_check_status 0 $at_status "$at_srcdir/run_accept.at:309" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_525 -#AT_START_526 -at_fn_group_banner 526 'run_initialize.at:27' \ - "INITIALIZE group entry with OCCURS" " " 4 -at_xfail=no -( - $as_echo "526. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 G1. - 02 G2 OCCURS 2. - 03 X1 PIC X. - 03 X2 PIC 9. - PROCEDURE DIVISION. - MOVE SPACE TO G1. - INITIALIZE G2 (2). - IF G1 NOT = " 0" - DISPLAY G1 NO ADVANCING - END-DISPLAY - END-IF. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_initialize.at:49: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_initialize.at:49" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_initialize.at:49" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_initialize.at:50: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_initialize.at:50" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_initialize.at:50" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_526 -#AT_START_527 -at_fn_group_banner 527 'run_initialize.at:55' \ - "INITIALIZE OCCURS with numeric edited" " " 4 -at_xfail=no -( - $as_echo "527. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 G1. - 02 G2 OCCURS 5. - 03 X PIC Z9. - PROCEDURE DIVISION. - INITIALIZE G1 - MOVE 5 TO X(1) - MOVE 99 TO X(3) - IF G1 NOT = " 5 099 0 0" - DISPLAY 'MOVE "' G1 '"' - END-DISPLAY - END-IF - INITIALIZE G1 - IF G1 NOT = " 0 0 0 0 0" - DISPLAY 'INIT "' G1 '"' - END-DISPLAY - END-IF - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_initialize.at:82: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_initialize.at:82" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_initialize.at:82" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_initialize.at:83: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_initialize.at:83" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_initialize.at:83" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_527 -#AT_START_528 -at_fn_group_banner 528 'run_initialize.at:88' \ - "INITIALIZE OCCURS with SIGN LEADING / TRAILING" " " 4 -at_xfail=no -( - $as_echo "528. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 G1. - 02 FILLER OCCURS 2. - 03 X PIC S9 SIGN LEADING SEPARATE. - 02 FILLER OCCURS 2. - 03 Y PIC S9 SIGN TRAILING SEPARATE. - *> definition taken from NC1184.2 - 01 MINUS-NAMES SIGN IS TRAILING SEPARATE CHARACTER. - 02 MINUS-NAMES-1. - 03 MINUS-NAME1 PIC S9(18) VALUE -999999999999999999. - 03 EVEN-NAME1 PIC S9(18) VALUE +1. - 03 PLUS-NAME1 PIC S9(18) VALUE +999999999999999999. - 02 MINUS-NAMES-2. - 03 MINUS-NAME3 PIC SV9(18) VALUE -.999999999999999999. - 03 EVEN-NAME2 PIC SV9(18) VALUE +.1. - 03 PLUS-NAME3 PIC SV9(18) VALUE +.999999999999999999. - PROCEDURE DIVISION. - INITIALIZE G1 - MOVE 5 TO X(1), PLUS-NAME1 - MOVE -9 TO Y(2), MINUS-NAME1 - IF G1 NOT = "+5+00+9-" - DISPLAY 'MOVE G "' G1 '"' - END-DISPLAY - END-IF - MOVE .123 TO PLUS-NAME3 - IF MINUS-NAMES-1 NOT = - "000000000000000009-000000000000000001+000000000000000005+" - OR MINUS-NAMES-2 NOT = - "999999999999999999-100000000000000000+123000000000000000+" - DISPLAY 'MOVE MN1 "' MINUS-NAMES-1 '"' - END-DISPLAY - DISPLAY 'MOVE MN2 "' MINUS-NAMES-2 '"' - END-DISPLAY - END-IF - INITIALIZE G1, MINUS-NAMES - IF G1 NOT = "+0+00+0+" - DISPLAY 'INIT G1 "' G1 '"' - END-DISPLAY - END-IF - IF MINUS-NAMES-1 NOT = - "000000000000000000+000000000000000000+000000000000000000+" - OR MINUS-NAMES-2 NOT = - "000000000000000000+000000000000000000+000000000000000000+" - DISPLAY 'MOVE MN1 "' MINUS-NAMES-1 '"' - END-DISPLAY - DISPLAY 'MOVE MN2 "' MINUS-NAMES-2 '"' - END-DISPLAY - END-IF - MOVE .123 TO PLUS-NAME3 - MOVE -.456 TO MINUS-NAME3 - DISPLAY PLUS-NAME3 END-DISPLAY - DISPLAY MINUS-NAME3 END-DISPLAY - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_initialize.at:150: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_initialize.at:150" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_initialize.at:150" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_initialize.at:151: ./prog" -at_fn_check_prepare_trace "run_initialize.at:151" -( $at_check_trace; ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo ".123000000000000000+ -.456000000000000000- -" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_initialize.at:151" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_528 -#AT_START_529 -at_fn_group_banner 529 'run_initialize.at:159' \ - "INITIALIZE complex group (1)" " " 4 -at_xfail=no -( - $as_echo "529. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 G1. - 02 X PIC X. - 02 G2 OCCURS 2. - 03 Y PIC 9. - 02 Z PIC 9. - PROCEDURE DIVISION. - INITIALIZE G1. - IF G1 NOT = " 000" - DISPLAY G1 NO ADVANCING - END-DISPLAY - END-IF. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_initialize.at:181: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_initialize.at:181" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_initialize.at:181" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_initialize.at:182: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_initialize.at:182" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_initialize.at:182" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_529 -#AT_START_530 -at_fn_group_banner 530 'run_initialize.at:187' \ - "INITIALIZE complex group (2)" " " 4 -at_xfail=no -( - $as_echo "530. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 G1. - 02 G2 OCCURS 2. - 03 X PIC 9. - 03 Y PIC X OCCURS 2. - 03 Z PIC X. - PROCEDURE DIVISION. - INITIALIZE G1. - IF G1 NOT = "0 0 " - DISPLAY G1 NO ADVANCING - END-DISPLAY - END-IF. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_initialize.at:209: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_initialize.at:209" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_initialize.at:209" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_initialize.at:210: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_initialize.at:210" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_initialize.at:210" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_530 -#AT_START_531 -at_fn_group_banner 531 'run_initialize.at:215' \ - "INITIALIZE with REDEFINES" " " 4 -at_xfail=no -( - $as_echo "531. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 G1. - 02 X PIC X. - 02 Y REDEFINES X PIC 9. - 02 Z PIC 9. - PROCEDURE DIVISION. - INITIALIZE G1. - IF G1 NOT = " 0" - DISPLAY G1 NO ADVANCING - END-DISPLAY - END-IF. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_initialize.at:236: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_initialize.at:236" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_initialize.at:236" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_initialize.at:237: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_initialize.at:237" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_initialize.at:237" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_531 -#AT_START_532 -at_fn_group_banner 532 'run_initialize.at:242' \ - "INITIALIZE with FILLER" " " 4 -at_xfail=no -( - $as_echo "532. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 G1. - 02 X PIC 99. - 02 FILLER PIC X. - 02 Z PIC 99. - 01 MY-FILLER. - 02 FILLER PIC 9(6) VALUE 12345. - PROCEDURE DIVISION. - MOVE ALL 'A' TO G1. - INITIALIZE G1. - IF G1 NOT = "00A00" - DISPLAY "G1 (INIT): " G1 - END-DISPLAY - END-IF. - MOVE ALL 'A' TO G1. - INITIALIZE G1 WITH FILLER. - IF G1 NOT = "00 00" - DISPLAY "G1 (INIT FILLER):" G1 - END-DISPLAY - END-IF. - - INITIALIZE MY-FILLER - IF MY-FILLER NOT = "012345" - DISPLAY "MY-FILLER (INIT): " MY-FILLER - END-DISPLAY - END-IF - - INITIALIZE MY-FILLER WITH FILLER - IF MY-FILLER NOT = "000000" - DISPLAY "MY-FILLER (INIT FILLER): " MY-FILLER - END-DISPLAY - END-IF - - INITIALIZE MY-FILLER ALL TO VALUE - IF MY-FILLER NOT = "000000" - DISPLAY "MY-FILLER (INIT TO VAL): " MY-FILLER - END-DISPLAY - END-IF - - INITIALIZE MY-FILLER WITH FILLER ALL TO VALUE - IF MY-FILLER NOT = "012345" - DISPLAY "MY-FILLER (INIT FILLER TO VAL): " MY-FILLER - END-DISPLAY - END-IF - - INITIALIZE MY-FILLER (2:3) - IF MY-FILLER NOT = "0 45" - DISPLAY "MY-FILLER (REF-MOD): " MY-FILLER - END-DISPLAY - END-IF - - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_initialize.at:303: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_initialize.at:303" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_initialize.at:303" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_initialize.at:304: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_initialize.at:304" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_initialize.at:304" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_532 -#AT_START_533 -at_fn_group_banner 533 'run_initialize.at:309' \ - "INITIALIZE of EXTERNAL data items" " " 4 -at_xfail=no -( - $as_echo "533. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 EXT-VAR-01 PIC X(5) EXTERNAL. - 01 EXT-VAR-GRP EXTERNAL. - 02 EXT-FIELD1 PIC 999. - 02 EXT-FIELD2 PIC x(4). - 02 EXT-FIELD3 PIC 9(6). - 02 EXT-FIELD4 PIC s9(5)v99. - PROCEDURE DIVISION. - MOVE "MOVE" TO EXT-VAR-01. - MOVE 1 TO EXT-FIELD1. - MOVE "X" TO EXT-FIELD2. - MOVE 123 TO EXT-FIELD3. - MOVE -2.1 TO EXT-FIELD4. - INITIALIZE EXT-VAR-01. - INITIALIZE EXT-VAR-GRP. - IF EXT-VAR-01 NOT = SPACES - DISPLAY "EXT-VAR-01 " EXT-VAR-01 - END-DISPLAY - END-IF. - IF EXT-FIELD1 NOT = ZERO - DISPLAY "EXT-FIELD1 " EXT-FIELD1 - END-DISPLAY - END-IF. - IF EXT-FIELD2 NOT = SPACES - DISPLAY "EXT-FIELD2 " EXT-FIELD2 - END-DISPLAY - END-IF. - IF EXT-FIELD3 NOT = ZERO - DISPLAY "EXT-FIELD3 " EXT-FIELD3 - END-DISPLAY - END-IF. - IF EXT-FIELD4 NOT = ZERO - DISPLAY "EXT-FIELD4 " EXT-FIELD4 - END-DISPLAY - END-IF. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_initialize.at:354: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_initialize.at:354" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_initialize.at:354" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_initialize.at:355: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_initialize.at:355" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_initialize.at:355" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_533 -#AT_START_534 -at_fn_group_banner 534 'run_initialize.at:360' \ - "INITIALIZE with reference modification" " " 4 -at_xfail=no -( - $as_echo "534. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 MY-FLD PIC X(6) VALUE "ABCDEF". - 01 MY-OTHER-FLD PIC 9(4) VALUE ZERO. - PROCEDURE DIVISION. - ASTART SECTION. - A01. - INITIALIZE MY-FLD (1:2). - IF MY-FLD NOT = " CDEF" - DISPLAY "MY-FLD: " MY-FLD - END-DISPLAY - END-IF - - *> note: INITIALIZE with refmod => handle field as alphanumeric - INITIALIZE MY-OTHER-FLD (2:2) - MOVE "0 0" TO MY-FLD - IF MY-OTHER-FLD NOT = MY-FLD (1:4) - DISPLAY "MY-OTHER-FLD: " MY-OTHER-FLD - END-DISPLAY - END-IF - - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_initialize.at:390: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_initialize.at:390" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_initialize.at:390" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_initialize.at:391: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_initialize.at:391" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_initialize.at:391" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_534 -#AT_START_535 -at_fn_group_banner 535 'run_misc.at:23' \ - "Comma separator without space" " " 4 -at_xfail=no -( - $as_echo "535. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - PROCEDURE DIVISION. - DISPLAY 1,1,1 NO ADVANCING - END-DISPLAY. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_misc.at:35: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_misc.at:35" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:35" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_misc.at:36: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_misc.at:36" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo "111" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:36" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_535 -#AT_START_536 -at_fn_group_banner 536 'run_misc.at:44' \ - "DECIMAL-POINT is COMMA (1)" " " 4 -at_xfail=no -( - $as_echo "536. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - CONFIGURATION SECTION. - SPECIAL-NAMES. - DECIMAL-POINT IS COMMA. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 X PIC 99V99. - PROCEDURE DIVISION. - MOVE FUNCTION MIN (3,,,,,,5) TO X. - DISPLAY X - END-DISPLAY. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_misc.at:64: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_misc.at:64" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:64" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_misc.at:65: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_misc.at:65" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo "00,50 -" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:65" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_536 -#AT_START_537 -at_fn_group_banner 537 'run_misc.at:72' \ - "DECIMAL-POINT is COMMA (2)" " " 4 -at_xfail=no -( - $as_echo "537. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - CONFIGURATION SECTION. - SPECIAL-NAMES. - DECIMAL-POINT IS COMMA. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 X PIC 99V99. - PROCEDURE DIVISION. - MOVE FUNCTION MIN (3,,,,,, 5) TO X. - DISPLAY X - END-DISPLAY. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_misc.at:92: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_misc.at:92" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:92" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_misc.at:93: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_misc.at:93" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo "03,00 -" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:93" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_537 -#AT_START_538 -at_fn_group_banner 538 'run_misc.at:100' \ - "DECIMAL-POINT is COMMA (3)" " " 4 -at_xfail=no -( - $as_echo "538. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - CONFIGURATION SECTION. - SPECIAL-NAMES. - DECIMAL-POINT IS COMMA. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 X PIC 99V99. - PROCEDURE DIVISION. - MOVE FUNCTION MIN (3,,,,,, 1,5) TO X. - DISPLAY X - END-DISPLAY. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_misc.at:120: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_misc.at:120" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:120" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_misc.at:121: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_misc.at:121" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo "01,50 -" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:121" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_538 -#AT_START_539 -at_fn_group_banner 539 'run_misc.at:128' \ - "DECIMAL-POINT is COMMA (4)" " " 4 -at_xfail=no -( - $as_echo "539. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - CONFIGURATION SECTION. - SPECIAL-NAMES. - DECIMAL-POINT IS COMMA. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 X PIC 99V99. - PROCEDURE DIVISION. - MOVE FUNCTION MIN (3,,,,,,1,5) TO X. - DISPLAY X - END-DISPLAY. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_misc.at:148: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_misc.at:148" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:148" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_misc.at:149: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_misc.at:149" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo "00,10 -" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:149" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_539 -#AT_START_540 -at_fn_group_banner 540 'run_misc.at:156' \ - "DECIMAL-POINT is COMMA (5)" " " 4 -at_xfail=no -( - $as_echo "540. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - CONFIGURATION SECTION. - SPECIAL-NAMES. - DECIMAL-POINT IS COMMA. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 X PIC 99V99. - PROCEDURE DIVISION. - COMPUTE X=1 + ,1 - END-COMPUTE - DISPLAY X - END-DISPLAY. - COMPUTE X=1*,1 - END-COMPUTE - DISPLAY X - END-DISPLAY. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_misc.at:181: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_misc.at:181" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:181" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_misc.at:182: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_misc.at:182" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo "01,10 -00,10 -" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:182" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_540 -#AT_START_541 -at_fn_group_banner 541 'run_misc.at:190' \ - "CURRENCY SIGN" " " 4 -at_xfail=no -( - $as_echo "541. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - PROGRAM-ID. prog. - - ENVIRONMENT DIVISION. - CONFIGURATION SECTION. - SPECIAL-NAMES. - CURRENCY SIGN IS "Y". - - DATA DIVISION. - WORKING-STORAGE SECTION. - 77 amount pic Y(6)9.99. - - PROCEDURE DIVISION. - Move 1512.34 to Amount - Display "Amount is #" Amount '#' with no advancing. - - GOBACK - . - END PROGRAM prog. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_misc.at:214: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_misc.at:214" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:214" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_misc.at:215: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_misc.at:215" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo "Amount is # Y1512.34#" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:215" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_541 -#AT_START_542 -at_fn_group_banner 542 'run_misc.at:221' \ - "CURRENCY SIGN WITH PICTURE SYMBOL" " " 4 -at_xfail=yes -( - $as_echo "542. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -# FIXME - see FR #246 - - -cat >prog.cob <<'_ATEOF' - - PROGRAM-ID. prog. - - ENVIRONMENT DIVISION. - CONFIGURATION SECTION. - SPECIAL-NAMES. - *> note the space after EUR / before ct. - CURRENCY SIGN IS "EUR " WITH PICTURE SYMBOL "U", - CURRENCY SIGN IS " ct (EUR)" WITH PICTURE SYMBOL "c", - Currency Sign is "$US" with Picture Symbol "$". - - DATA DIVISION. - WORKING-STORAGE SECTION. - 77 EUROS PIC U99v99. - 77 cents PIC c9,999. - 77 DOLLARS Pic $$,$$9.99. - - PROCEDURE DIVISION. - MOVE 12.34 TO EUROS - MULTIPLY euros BY 1000 GIVING cents. - DISPLAY "#" EUROS "# equal #" cents '#'. - Move 1500 to Invoice-Amount - Display "Invoice amount #1 is " Invoice-Amount '.'. - Move 12.34 to Invoice-Amount - Display "Invoice amount #2 is " Invoice-Amount '.'. - - GOBACK - . - END PROGRAM prog. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_misc.at:258: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_misc.at:258" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:258" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_misc.at:259: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_misc.at:259" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo "#EUR 12.34# equal #1,234 ct (EUR)# -Invoice amount #1 is \$US1,500.00. -Invoice amount #2 is \$US12.34. -" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:259" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_542 -#AT_START_543 -at_fn_group_banner 543 'run_misc.at:268' \ - "LOCAL-STORAGE (1)" " " 4 -at_xfail=no -( - $as_echo "543. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >callee.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. callee. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 WRK-X PIC XXX VALUE "abc". - LOCAL-STORAGE SECTION. - 01 LCL-X PIC XXX VALUE "abc". - PROCEDURE DIVISION. - DISPLAY WRK-X LCL-X NO ADVANCING - END-DISPLAY. - MOVE ZERO TO WRK-X LCL-X. - EXIT PROGRAM. -_ATEOF - - -cat >caller.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. caller. - PROCEDURE DIVISION. - CALL "callee" - END-CALL. - CALL "callee" - END-CALL. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_misc.at:297: \$COMPILE_MODULE callee.cob" -at_fn_check_prepare_dynamic "$COMPILE_MODULE callee.cob" "run_misc.at:297" -( $at_check_trace; $COMPILE_MODULE callee.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:297" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_misc.at:298: \$COMPILE -o prog caller.cob" -at_fn_check_prepare_dynamic "$COMPILE -o prog caller.cob" "run_misc.at:298" -( $at_check_trace; $COMPILE -o prog caller.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:298" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_misc.at:299: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_misc.at:299" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo "abcabc000abc" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:299" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_543 -#AT_START_544 -at_fn_group_banner 544 'run_misc.at:304' \ - "LOCAL-STORAGE (2)" " " 4 -at_xfail=no -( - $as_echo "544. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >callee2.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. callee2. - DATA DIVISION. - LINKAGE SECTION. - 01 LNK-X PIC XXX. - PROCEDURE DIVISION USING LNK-X. - DISPLAY LNK-X NO ADVANCING - END-DISPLAY. - EXIT PROGRAM. -_ATEOF - - -cat >callee.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. callee. - DATA DIVISION. - LOCAL-STORAGE SECTION. - 01 LCL-X. - 05 FILLER PIC XXX VALUE "abc". - PROCEDURE DIVISION. - CALL "callee2" USING LCL-X - END-CALL. - MOVE ZERO TO LCL-X. - CALL "callee2" USING LCL-X - END-CALL. - EXIT PROGRAM. -_ATEOF - - -cat >caller.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. caller. - PROCEDURE DIVISION. - CALL "callee" - END-CALL. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_misc.at:344: \$COMPILE_MODULE callee2.cob" -at_fn_check_prepare_dynamic "$COMPILE_MODULE callee2.cob" "run_misc.at:344" -( $at_check_trace; $COMPILE_MODULE callee2.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:344" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_misc.at:345: \$COMPILE_MODULE callee.cob" -at_fn_check_prepare_dynamic "$COMPILE_MODULE callee.cob" "run_misc.at:345" -( $at_check_trace; $COMPILE_MODULE callee.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:345" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_misc.at:346: \$COMPILE -o prog caller.cob" -at_fn_check_prepare_dynamic "$COMPILE -o prog caller.cob" "run_misc.at:346" -( $at_check_trace; $COMPILE -o prog caller.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:346" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_misc.at:347: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_misc.at:347" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo "abc000" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:347" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_544 -#AT_START_545 -at_fn_group_banner 545 'run_misc.at:352' \ - "EXTERNAL data item" " " 4 -at_xfail=no -( - $as_echo "545. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >callee.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. callee. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 EXT-VAR PIC X(5) EXTERNAL. - PROCEDURE DIVISION. - IF EXT-VAR NOT = "Hello" - DISPLAY EXT-VAR - END-DISPLAY - END-IF. - MOVE "World" TO EXT-VAR. - EXIT PROGRAM. -_ATEOF - - -cat >caller.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. caller. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 EXT-VAR PIC X(5) EXTERNAL. - PROCEDURE DIVISION. - MOVE "Hello" TO EXT-VAR. - CALL "callee" - END-CALL. - IF EXT-VAR NOT = "World" - DISPLAY EXT-VAR - END-DISPLAY - END-IF. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_misc.at:387: \$COMPILE_MODULE callee.cob" -at_fn_check_prepare_dynamic "$COMPILE_MODULE callee.cob" "run_misc.at:387" -( $at_check_trace; $COMPILE_MODULE callee.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:387" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_misc.at:388: \$COMPILE caller.cob" -at_fn_check_prepare_dynamic "$COMPILE caller.cob" "run_misc.at:388" -( $at_check_trace; $COMPILE caller.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:388" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_misc.at:389: \$COBCRUN_DIRECT ./caller" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./caller" "run_misc.at:389" -( $at_check_trace; $COBCRUN_DIRECT ./caller -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:389" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_545 -#AT_START_546 -at_fn_group_banner 546 'run_misc.at:394' \ - "EXTERNAL AS data item" " " 4 -at_xfail=no -( - $as_echo "546. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >callee.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. callee. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 PRG-VAR PIC X(5) EXTERNAL AS "WRK-VAR". - 01 EXT-VAR PIC X(5) EXTERNAL. - PROCEDURE DIVISION. - IF PRG-VAR NOT = "Extrn" - DISPLAY PRG-VAR - END-DISPLAY - END-IF. - IF EXT-VAR NOT = "Hello" - DISPLAY EXT-VAR - END-DISPLAY - END-IF. - MOVE "World" TO EXT-VAR. - EXIT PROGRAM. -_ATEOF - - -cat >caller.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. caller. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 MYVAR PIC X(5) EXTERNAL AS "EXT-VAR". - 01 WRK-VAR PIC X(5) EXTERNAL. - PROCEDURE DIVISION. - MOVE "Extrn" TO WRK-VAR. - MOVE "Hello" TO MYVAR. - CALL "callee" - END-CALL. - IF MYVAR NOT = "World" - DISPLAY MYVAR - END-DISPLAY - END-IF. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_misc.at:436: \$COMPILE_MODULE callee.cob" -at_fn_check_prepare_dynamic "$COMPILE_MODULE callee.cob" "run_misc.at:436" -( $at_check_trace; $COMPILE_MODULE callee.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:436" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_misc.at:437: \$COMPILE caller.cob" -at_fn_check_prepare_dynamic "$COMPILE caller.cob" "run_misc.at:437" -( $at_check_trace; $COMPILE caller.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:437" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_misc.at:438: \$COBCRUN_DIRECT ./caller" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./caller" "run_misc.at:438" -( $at_check_trace; $COBCRUN_DIRECT ./caller -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:438" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_546 -#AT_START_547 -at_fn_group_banner 547 'run_misc.at:443' \ - "EXTERNAL data item size mismatch" " " 4 -at_xfail=yes -( - $as_echo "547. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -# FIXME - see Bug #445 - - -cat >callee.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. callee. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 PRG-VAR PIC X(8) EXTERNAL AS "WRK-VAR". - 01 COB-VAR PIC X(8) EXTERNAL. - 01 EXT-VAR PIC X(8) EXTERNAL. - PROCEDURE DIVISION. - IF PRG-VAR NOT = "Extrn" - DISPLAY PRG-VAR - END-DISPLAY - END-IF. - IF EXT-VAR NOT = "Hello" - DISPLAY EXT-VAR - END-DISPLAY - END-IF. - MOVE "World" TO EXT-VAR. - EXIT PROGRAM. -_ATEOF - - -cat >bigger.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. error. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 MYVAR PIC X(10) EXTERNAL AS "COB-VAR". - 01 WRK-VAR PIC X(10) EXTERNAL. - 01 EXT-VAR PIC X(10) EXTERNAL. - PROCEDURE DIVISION. - MOVE "Extrn" TO WRK-VAR. - MOVE "Hello" TO MYVAR. - CALL "callee" - END-CALL. - IF MYVAR NOT = "World" - DISPLAY MYVAR - END-DISPLAY - END-IF. - STOP RUN. -_ATEOF - - -cat >smaller.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. error. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 MYVAR PIC X(5) EXTERNAL AS "COB-VAR". - 01 WRK-VAR PIC X(5) EXTERNAL. - 01 EXT-VAR PIC X(5) EXTERNAL. - PROCEDURE DIVISION. - MOVE "Extrn" TO WRK-VAR. - MOVE "Hello" TO MYVAR. - CALL "callee" - END-CALL. - IF MYVAR NOT = "World" - DISPLAY MYVAR - END-DISPLAY - END-IF. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_misc.at:510: \$COMPILE_MODULE callee.cob" -at_fn_check_prepare_dynamic "$COMPILE_MODULE callee.cob" "run_misc.at:510" -( $at_check_trace; $COMPILE_MODULE callee.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:510" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_misc.at:511: \$COMPILE bigger.cob" -at_fn_check_prepare_dynamic "$COMPILE bigger.cob" "run_misc.at:511" -( $at_check_trace; $COMPILE bigger.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:511" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_misc.at:512: \$COBCRUN_DIRECT ./bigger" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./bigger" "run_misc.at:512" -( $at_check_trace; $COBCRUN_DIRECT ./bigger -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "libcob: callee.cob:6: warning: EXTERNAL item 'WRK-VAR' previously allocated with size 10, requested size is 8 -libcob: callee.cob:7: warning: EXTERNAL item 'EXT-VAR' previously allocated with size 10, requested size is 8 -libcob: callee.cob:8: warning: EXTERNAL item 'EXT-VAR' previously allocated with size 10, requested size is 8 -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:512" -$at_failed && at_fn_log_failure -$at_traceon; } - - -{ set +x -$as_echo "$at_srcdir/run_misc.at:518: \$COMPILE smaller.cob" -at_fn_check_prepare_dynamic "$COMPILE smaller.cob" "run_misc.at:518" -( $at_check_trace; $COMPILE smaller.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:518" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_misc.at:519: \$COBCRUN_DIRECT ./smaller" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./smaller" "run_misc.at:519" -( $at_check_trace; $COBCRUN_DIRECT ./smaller -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "libcob: callee.cob:6: error: EXTERNAL item 'WRK-VAR' previously allocated with size 5, requested size is 8 -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/run_misc.at:519" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_547 -#AT_START_548 -at_fn_group_banner 548 'run_misc.at:528' \ - "MOVE to itself" " " 4 -at_xfail=no -( - $as_echo "548. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 X PIC 99 VALUE 12. - PROCEDURE DIVISION. - MOVE X TO X. - IF X NOT = 12 - DISPLAY X NO ADVANCING - END-DISPLAY - END-IF. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_misc.at:546: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_misc.at:546" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob:8: warning: overlapping MOVE may produce unpredictable results -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:546" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_misc.at:549: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_misc.at:549" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:549" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_548 -#AT_START_549 -at_fn_group_banner 549 'run_misc.at:554' \ - "MOVE with refmod" " " 4 -at_xfail=no -( - $as_echo "549. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 X PIC 9(4) VALUE 0. - PROCEDURE DIVISION. - MOVE "1" TO X(1:1). - IF X NOT = 1000 - DISPLAY X NO ADVANCING - END-DISPLAY - END-IF. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_misc.at:572: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_misc.at:572" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:572" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_misc.at:573: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_misc.at:573" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:573" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_549 -#AT_START_550 -at_fn_group_banner 550 'run_misc.at:578' \ - "MOVE with refmod (variable)" " " 4 -at_xfail=no -( - $as_echo "550. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 X PIC X(4) VALUE "1234". - 01 Y PIC X(4) VALUE "abcd". - 01 I PIC 9 VALUE 1. - PROCEDURE DIVISION. - MOVE X(1:I) TO Y. - IF Y NOT = "1 " - DISPLAY Y NO ADVANCING - END-DISPLAY - END-IF. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_misc.at:598: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_misc.at:598" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:598" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_misc.at:599: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_misc.at:599" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:599" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_550 -#AT_START_551 -at_fn_group_banner 551 'run_misc.at:604' \ - "MOVE with group refmod" " " 4 -at_xfail=no -( - $as_echo "551. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 G. - 02 X PIC 9999 VALUE 1234. - PROCEDURE DIVISION. - MOVE "99" TO G(3:2). - IF G NOT = "1299" - DISPLAY G NO ADVANCING - END-DISPLAY - END-IF. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_misc.at:623: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_misc.at:623" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:623" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_misc.at:624: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_misc.at:624" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:624" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_551 -#AT_START_552 -at_fn_group_banner 552 'run_misc.at:629' \ - "MOVE indexes" " " 4 -at_xfail=no -( - $as_echo "552. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 G. - 02 X PIC X OCCURS 10 INDEXED I. - PROCEDURE DIVISION. - SET I TO ZERO. - MOVE I TO X(1). - IF X(1) NOT = "0" - DISPLAY X(1) NO ADVANCING - END-DISPLAY - END-IF. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_misc.at:649: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_misc.at:649" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:649" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_misc.at:650: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_misc.at:650" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:650" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_552 -#AT_START_553 -at_fn_group_banner 553 'run_misc.at:655' \ - "MOVE X'00'" " " 4 -at_xfail=no -( - $as_echo "553. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >dump.c <<'_ATEOF' - -#include -#include - -COB_EXT_EXPORT int -dump (unsigned char *data) -{ - printf ("%02x%02x%02x", data[0], data[1], data[2]); - return 0; -} -_ATEOF - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 X PIC XXX. - PROCEDURE DIVISION. - MOVE X"000102" TO X. - CALL "dump" USING X - END-CALL. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_misc.at:683: \$COMPILE_MODULE dump.c" -at_fn_check_prepare_dynamic "$COMPILE_MODULE dump.c" "run_misc.at:683" -( $at_check_trace; $COMPILE_MODULE dump.c -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:683" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_misc.at:684: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_misc.at:684" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:684" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_misc.at:685: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_misc.at:685" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo "000102" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:685" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_553 -#AT_START_554 -at_fn_group_banner 554 'run_misc.at:690' \ - "MOVE Z'literal'" " " 4 -at_xfail=no -( - $as_echo "554. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 X PIC XXXX. - 01 XRED REDEFINES X. - 03 XBYTE1 PIC X. - 03 XBYTE2 PIC X. - 03 XBYTE3 PIC X. - 03 XBYTE4 PIC X. - PROCEDURE DIVISION. - MOVE Z"012" TO X. - IF XBYTE1 = "0" AND - XBYTE2 = "1" AND - XBYTE3 = "2" AND - XBYTE4 = LOW-VALUE - DISPLAY "OK" NO ADVANCING - END-DISPLAY - ELSE - DISPLAY "X = " X (1:3) NO ADVANCING - END-DISPLAY - IF XBYTE4 = LOW-VALUE - DISPLAY " WITH LOW-VALUE" - END-DISPLAY - ELSE - DISPLAY " WITHOUT LOW-VALUE BUT '" XBYTE4 "'" - END-DISPLAY - END-IF - END-IF. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_misc.at:726: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_misc.at:726" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:726" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_misc.at:727: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_misc.at:727" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo "OK" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:727" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_554 -#AT_START_555 -at_fn_group_banner 555 'run_misc.at:732' \ - "Floating continuation indicator" " " 4 -at_xfail=no -( - $as_echo "555. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - PROCEDURE DIVISION. - DISPLAY "OK"- - "OK" - NO ADVANCING - END-DISPLAY - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_misc.at:748: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_misc.at:748" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:748" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_misc.at:749: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_misc.at:749" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo "OKOK" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:749" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_555 -#AT_START_556 -at_fn_group_banner 556 'run_misc.at:754' \ - "Fixed continuation indicator" " " 4 -at_xfail=no -( - $as_echo "556. $at_setup_line: testing $at_desc ..." - $at_traceon - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 X PIC X(333) VALUE - '0123456789abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWX - - 'YZ0123456789abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUV - - 'WXYZ0123456789abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRST - - 'UVWXYZ0123456789abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQR - - 'STUVWXYZ0123456789abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOP - - 'QRSTUVWXYZ'. - PROCEDURE DIVISION. - DISPLAY X NO ADVANCING - END-DISPLAY. - DISPLAY '_' - END-DISPLAY. - MOVE - "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ01234567 - - "89abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ012345 - - "6789abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123 - - "456789abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ01 - - "23456789abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXY - - "Z - - "0123456789" TO X. - DISPLAY X NO ADVANCING - END-DISPLAY. - DISPLAY '_' - END-DISPLAY. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_misc.at:788: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_misc.at:788" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:788" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_misc.at:789: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_misc.at:789" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo "0123456789abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ _ -abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789 _ -" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:789" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_556 -#AT_START_557 -at_fn_group_banner 557 'run_misc.at:796' \ - "Concatenation operator" " " 4 -at_xfail=no -( - $as_echo "557. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 77 STR PIC X(05). - PROCEDURE DIVISION. - MOVE "OK" & " " - & "OK" - TO STR - DISPLAY STR NO ADVANCING - END-DISPLAY - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_misc.at:814: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_misc.at:814" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:814" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_misc.at:815: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_misc.at:815" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo "OK OK" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:815" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_557 -#AT_START_558 -at_fn_group_banner 558 'run_misc.at:820' \ - "SOURCE FIXED/FREE directives" " " 4 -at_xfail=no -( - $as_echo "558. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - >>SOURCE FREE - DATA DIVISION. - WORKING-STORAGE SECTION. - >>SOURCE FIXED - PROCEDURE DIVISION. FIXED - DISPLAY "OK" NO ADVANCING - END-DISPLAY. - >>SOURCE FREE - DISPLAY - "OK" - NO ADVANCING - END-DISPLAY. - >>SET SOURCEFORMAT "FIXED" - DISPLAY "OK" NO ADVANCING FIXED - END-DISPLAY. - >>SET SOURCEFORMAT "FREE" - DISPLAY - "OK" - NO ADVANCING - END-DISPLAY. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_misc.at:849: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_misc.at:849" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:849" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_misc.at:850: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_misc.at:850" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo "OKOKOKOK" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:850" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_558 -#AT_START_559 -at_fn_group_banner 559 'run_misc.at:857' \ - "Level 01 subscripts" " " 4 -at_xfail=no -( - $as_echo "559. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 X PIC X OCCURS 10. - PROCEDURE DIVISION. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_misc.at:870: \$COMPILE_ONLY -std=cobol2014 prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY -std=cobol2014 prog.cob" "run_misc.at:870" -( $at_check_trace; $COMPILE_ONLY -std=cobol2014 prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob:6: error: level 01 item 'X' cannot have a OCCURS clause -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/run_misc.at:870" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_559 -#AT_START_560 -at_fn_group_banner 560 'run_misc.at:879' \ - "Class check with reference modification" " " 4 -at_xfail=no -( - $as_echo "560. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 X PIC X(6) VALUE "123 ". - PROCEDURE DIVISION. - IF X(1:3) NUMERIC - STOP RUN - END-IF. - DISPLAY "NG" NO ADVANCING - END-DISPLAY. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_misc.at:897: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_misc.at:897" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:897" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_misc.at:898: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_misc.at:898" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:898" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_560 -#AT_START_561 -at_fn_group_banner 561 'run_misc.at:903' \ - "Index and parenthesized expression" " " 4 -at_xfail=no -( - $as_echo "561. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 G. - 02 X PIC X OCCURS 1 INDEXED BY I. - PROCEDURE DIVISION. - IF I < (I + 2) - DISPLAY "OK" NO ADVANCING - END-DISPLAY - END-IF. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_misc.at:921: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_misc.at:921" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:921" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_misc.at:922: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_misc.at:922" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo "OK" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:922" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_561 -#AT_START_562 -at_fn_group_banner 562 'run_misc.at:927' \ - "Alphanumeric and binary numeric" " " 4 -at_xfail=no -( - $as_echo "562. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 X-X PIC XXXX VALUE "0001". - 01 X-9 PIC 9999 COMP VALUE 1. - PROCEDURE DIVISION. - IF X-X = X-9 - STOP RUN - END-IF. - DISPLAY "NG" NO ADVANCING - END-DISPLAY - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_misc.at:946: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_misc.at:946" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:946" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_misc.at:947: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_misc.at:947" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:947" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_562 -#AT_START_563 -at_fn_group_banner 563 'run_misc.at:952' \ - "Non-numeric data in numeric items" " " 4 -at_xfail=no -( - $as_echo "563. $at_setup_line: testing $at_desc ..." - $at_traceon - - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 X. - 03 X-NUM PIC 9(06) VALUE 123. - 77 NUM PIC 9(06). - PROCEDURE DIVISION. - MOVE x"0000" TO X (2:2) - IF X-NUM NUMERIC - DISPLAY "low-value is numeric" UPON SYSERR - END-DISPLAY - END-IF - MOVE x"01" TO X (3:1) - IF X-NUM NUMERIC - DISPLAY "SOH is numeric" UPON SYSERR - END-DISPLAY - END-IF - MOVE X-NUM TO NUM - DISPLAY "test over" - END-DISPLAY - * - GOBACK. -_ATEOF - - -cat >prog2.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog2. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 X. - 03 X-NUM PIC 9(06) PACKED-DECIMAL VALUE 123. - 77 NUM PIC 9(06). - PROCEDURE DIVISION. - MOVE x"0A" TO X (2:1) - IF X-NUM NUMERIC - DISPLAY "bad prog" - END-DISPLAY - END-IF - MOVE X-NUM TO NUM - DISPLAY "test over" - END-DISPLAY - * - GOBACK. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_misc.at:1003: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_misc.at:1003" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:1003" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_misc.at:1004: \$COBC -x -o unchecked_prog prog.cob" -at_fn_check_prepare_dynamic "$COBC -x -o unchecked_prog prog.cob" "run_misc.at:1004" -( $at_check_trace; $COBC -x -o unchecked_prog prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:1004" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_misc.at:1005: \$COBCRUN_DIRECT ./unchecked_prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./unchecked_prog" "run_misc.at:1005" -( $at_check_trace; $COBCRUN_DIRECT ./unchecked_prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo "test over -" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:1005" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_misc.at:1008: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_misc.at:1008" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "libcob: prog.cob:20: error: 'X-NUM' (Type: NUMERIC DISPLAY) not numeric: '0\\000\\001123' -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/run_misc.at:1008" -$at_failed && at_fn_log_failure -$at_traceon; } - - -{ set +x -$as_echo "$at_srcdir/run_misc.at:1012: \$COMPILE prog2.cob" -at_fn_check_prepare_dynamic "$COMPILE prog2.cob" "run_misc.at:1012" -( $at_check_trace; $COMPILE prog2.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:1012" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_misc.at:1013: \$COBC -x -o unchecked_prog2 prog2.cob" -at_fn_check_prepare_dynamic "$COBC -x -o unchecked_prog2 prog2.cob" "run_misc.at:1013" -( $at_check_trace; $COBC -x -o unchecked_prog2 prog2.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:1013" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_misc.at:1014: \$COBCRUN_DIRECT ./unchecked_prog2" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./unchecked_prog2" "run_misc.at:1014" -( $at_check_trace; $COBCRUN_DIRECT ./unchecked_prog2 -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo "test over -" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:1014" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_misc.at:1017: \$COBCRUN_DIRECT ./prog2" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog2" "run_misc.at:1017" -( $at_check_trace; $COBCRUN_DIRECT ./prog2 -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "libcob: prog2.cob:15: error: 'X-NUM' (Type: PACKED-DECIMAL) not numeric: '0x000a123f' -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/run_misc.at:1017" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_563 -#AT_START_564 -at_fn_group_banner 564 'run_misc.at:1026' \ - "Dynamic call with static linking" " " 4 -at_xfail=no -( - $as_echo "564. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >callee.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. callee. - PROCEDURE DIVISION. - EXIT PROGRAM. -_ATEOF - - -cat >caller.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. caller. - PROCEDURE DIVISION. - CALL "callee" - END-CALL. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_misc.at:1045: \$COMPILE_MODULE -c callee.cob" -at_fn_check_prepare_dynamic "$COMPILE_MODULE -c callee.cob" "run_misc.at:1045" -( $at_check_trace; $COMPILE_MODULE -c callee.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:1045" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_misc.at:1046: \$COMPILE -c caller.cob" -at_fn_check_prepare_dynamic "$COMPILE -c caller.cob" "run_misc.at:1046" -( $at_check_trace; $COMPILE -c caller.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:1046" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_misc.at:1047: \$COMPILE -o prog caller.\$COB_OBJECT_EXT callee.\$COB_OBJECT_EXT" -at_fn_check_prepare_dynamic "$COMPILE -o prog caller.$COB_OBJECT_EXT callee.$COB_OBJECT_EXT" "run_misc.at:1047" -( $at_check_trace; $COMPILE -o prog caller.$COB_OBJECT_EXT callee.$COB_OBJECT_EXT -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:1047" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_misc.at:1048: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_misc.at:1048" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:1048" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_misc.at:1049: \$COMPILE -o prog2 caller.cob callee.cob" -at_fn_check_prepare_dynamic "$COMPILE -o prog2 caller.cob callee.cob" "run_misc.at:1049" -( $at_check_trace; $COMPILE -o prog2 caller.cob callee.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:1049" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_misc.at:1050: \$COBCRUN_DIRECT ./prog2" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog2" "run_misc.at:1050" -( $at_check_trace; $COBCRUN_DIRECT ./prog2 -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:1050" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_564 -#AT_START_565 -at_fn_group_banner 565 'run_misc.at:1055' \ - "Static call with static linking" " " 4 -at_xfail=no -( - $as_echo "565. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >callee.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. callee. - PROCEDURE DIVISION. - EXIT PROGRAM. -_ATEOF - - -cat >caller.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. caller. - PROCEDURE DIVISION. - CALL STATIC "callee" - END-CALL. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_misc.at:1074: \$COMPILE_MODULE -c callee.cob" -at_fn_check_prepare_dynamic "$COMPILE_MODULE -c callee.cob" "run_misc.at:1074" -( $at_check_trace; $COMPILE_MODULE -c callee.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:1074" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_misc.at:1075: \$COMPILE -c caller.cob" -at_fn_check_prepare_dynamic "$COMPILE -c caller.cob" "run_misc.at:1075" -( $at_check_trace; $COMPILE -c caller.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:1075" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_misc.at:1076: \$COMPILE -o prog caller.\$COB_OBJECT_EXT callee.\$COB_OBJECT_EXT" -at_fn_check_prepare_dynamic "$COMPILE -o prog caller.$COB_OBJECT_EXT callee.$COB_OBJECT_EXT" "run_misc.at:1076" -( $at_check_trace; $COMPILE -o prog caller.$COB_OBJECT_EXT callee.$COB_OBJECT_EXT -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:1076" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_misc.at:1077: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_misc.at:1077" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:1077" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_misc.at:1078: \$COMPILE -o prog2 -fstatic-call caller.cob callee.cob" -at_fn_check_prepare_dynamic "$COMPILE -o prog2 -fstatic-call caller.cob callee.cob" "run_misc.at:1078" -( $at_check_trace; $COMPILE -o prog2 -fstatic-call caller.cob callee.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:1078" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_misc.at:1079: \$COBCRUN_DIRECT ./prog2" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog2" "run_misc.at:1079" -( $at_check_trace; $COBCRUN_DIRECT ./prog2 -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:1079" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_misc.at:1080: \$COMPILE -o prog3 caller.cob callee.cob" -at_fn_check_prepare_dynamic "$COMPILE -o prog3 caller.cob callee.cob" "run_misc.at:1080" -( $at_check_trace; $COMPILE -o prog3 caller.cob callee.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:1080" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_misc.at:1081: \$COBCRUN_DIRECT ./prog3" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog3" "run_misc.at:1081" -( $at_check_trace; $COBCRUN_DIRECT ./prog3 -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:1081" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_565 -#AT_START_566 -at_fn_group_banner 566 'run_misc.at:1086' \ - "Dynamic CALL with ON EXCEPTION" " " 4 -at_xfail=no -( - $as_echo "566. $at_setup_line: testing $at_desc ..." - $at_traceon - - - - -cat >caller.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. caller. - PROCEDURE DIVISION. - CALL "callee1" ON EXCEPTION - CALL "callee2" ON EXCEPTION - DISPLAY "neither calee1 nor callee2 found" - END-CALL - END-CALL - GOBACK. -_ATEOF - - -cat >callee2.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. callee2. - PROCEDURE DIVISION. - DISPLAY "this is callee2" NO ADVANCING - GOBACK. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_misc.at:1110: \$COMPILE caller.cob" -at_fn_check_prepare_dynamic "$COMPILE caller.cob" "run_misc.at:1110" -( $at_check_trace; $COMPILE caller.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:1110" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_misc.at:1111: \$COMPILE_MODULE callee2.cob" -at_fn_check_prepare_dynamic "$COMPILE_MODULE callee2.cob" "run_misc.at:1111" -( $at_check_trace; $COMPILE_MODULE callee2.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:1111" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_misc.at:1112: \$COBCRUN_DIRECT ./caller" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./caller" "run_misc.at:1112" -( $at_check_trace; $COBCRUN_DIRECT ./caller -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo "this is callee2" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:1112" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_566 -#AT_START_567 -at_fn_group_banner 567 'run_misc.at:1118' \ - "Static CALL with ON EXCEPTION" " " 4 -at_xfail=no -( - $as_echo "567. $at_setup_line: testing $at_desc ..." - $at_traceon - - - - -cat >caller.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. caller. - PROCEDURE DIVISION. - CALL "callee1" ON EXCEPTION - CALL "callee2" ON EXCEPTION - DISPLAY "neither calee1 nor callee2 found" - END-CALL - END-CALL - GOBACK. -_ATEOF - - -cat >callee2.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. callee2. - PROCEDURE DIVISION. - DISPLAY "this is callee2" NO ADVANCING - GOBACK. -_ATEOF - - - -{ set +x -$as_echo "$at_srcdir/run_misc.at:1143: \$COMPILE_MODULE -c callee2.cob" -at_fn_check_prepare_dynamic "$COMPILE_MODULE -c callee2.cob" "run_misc.at:1143" -( $at_check_trace; $COMPILE_MODULE -c callee2.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:1143" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_misc.at:1144: \$COMPILE -c caller.cob" -at_fn_check_prepare_dynamic "$COMPILE -c caller.cob" "run_misc.at:1144" -( $at_check_trace; $COMPILE -c caller.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:1144" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_misc.at:1145: \$COMPILE -o prog caller.\$COB_OBJECT_EXT callee2.\$COB_OBJECT_EXT" -at_fn_check_prepare_dynamic "$COMPILE -o prog caller.$COB_OBJECT_EXT callee2.$COB_OBJECT_EXT" "run_misc.at:1145" -( $at_check_trace; $COMPILE -o prog caller.$COB_OBJECT_EXT callee2.$COB_OBJECT_EXT -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:1145" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_misc.at:1146: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_misc.at:1146" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo "this is callee2" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:1146" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_misc.at:1148: \$COMPILE -o prog2 -fstatic-call caller.cob callee2.cob" -at_fn_check_prepare_dynamic "$COMPILE -o prog2 -fstatic-call caller.cob callee2.cob" "run_misc.at:1148" -( $at_check_trace; $COMPILE -o prog2 -fstatic-call caller.cob callee2.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:1148" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_misc.at:1149: \$COBCRUN_DIRECT ./prog2" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog2" "run_misc.at:1149" -( $at_check_trace; $COBCRUN_DIRECT ./prog2 -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo "this is callee2" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:1149" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_misc.at:1151: \$COMPILE -o prog3 caller.cob callee2.cob" -at_fn_check_prepare_dynamic "$COMPILE -o prog3 caller.cob callee2.cob" "run_misc.at:1151" -( $at_check_trace; $COMPILE -o prog3 caller.cob callee2.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:1151" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_misc.at:1152: \$COBCRUN_DIRECT ./prog3" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog3" "run_misc.at:1152" -( $at_check_trace; $COBCRUN_DIRECT ./prog3 -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo "this is callee2" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:1152" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_567 -#AT_START_568 -at_fn_group_banner 568 'run_misc.at:1158' \ - "CALL m1. CALL m2. CALL m1." " " 4 -at_xfail=no -( - $as_echo "568. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >m1.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. m1. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 X PIC 9(4). - PROCEDURE DIVISION. - COMPUTE X = 1 + 2 - END-COMPUTE. - IF X NOT = 3 - DISPLAY X - END-DISPLAY - END-IF. -_ATEOF - - -cat >m2.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. m2. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 X PIC 9(4). - PROCEDURE DIVISION. - COMPUTE X = 3 + 4 - END-COMPUTE. - IF X NOT = 7 - DISPLAY X - END-DISPLAY - END-IF. -_ATEOF - - -cat >caller.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. caller. - PROCEDURE DIVISION. - CALL "m1" - END-CALL. - CALL "m2" - END-CALL. - CALL "m1" - END-CALL. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_misc.at:1204: \$COMPILE_MODULE m1.cob" -at_fn_check_prepare_dynamic "$COMPILE_MODULE m1.cob" "run_misc.at:1204" -( $at_check_trace; $COMPILE_MODULE m1.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:1204" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_misc.at:1205: \$COMPILE_MODULE m2.cob" -at_fn_check_prepare_dynamic "$COMPILE_MODULE m2.cob" "run_misc.at:1205" -( $at_check_trace; $COMPILE_MODULE m2.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:1205" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_misc.at:1206: \$COMPILE caller.cob" -at_fn_check_prepare_dynamic "$COMPILE caller.cob" "run_misc.at:1206" -( $at_check_trace; $COMPILE caller.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:1206" -$at_failed && at_fn_log_failure -$at_traceon; } - - -{ set +x -$as_echo "$at_srcdir/run_misc.at:1208: \$COBCRUN_DIRECT ./caller" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./caller" "run_misc.at:1208" -( $at_check_trace; $COBCRUN_DIRECT ./caller -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:1208" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_568 -#AT_START_569 -at_fn_group_banner 569 'run_misc.at:1213' \ - "Recursive CALL of RECURSIVE program" " " 4 -at_xfail=no -( - $as_echo "569. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >caller.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. caller IS RECURSIVE. - ENVIRONMENT DIVISION. - CONFIGURATION SECTION. - DATA DIVISION. - WORKING-STORAGE SECTION. - 77 STOPPER PIC S9 EXTERNAL. - PROCEDURE DIVISION. - MOVE 0 TO STOPPER - CALL "callee" - DISPLAY 'OK' NO ADVANCING END-DISPLAY - CANCEL "callee" , "callee2" - DISPLAY ' + FINE' NO ADVANCING END-DISPLAY - STOP RUN. -_ATEOF - - -cat >callee.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. callee IS RECURSIVE. - DATA DIVISION. - WORKING-STORAGE SECTION. - 77 STOPPER PIC S9 EXTERNAL. - PROCEDURE DIVISION. - IF STOPPER = 9 - MOVE -1 TO STOPPER - ELSE - ADD 1 TO STOPPER - CALL "callee2" - END-IF - GOBACK. -_ATEOF - - -cat >callee2.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. callee2 IS RECURSIVE. - DATA DIVISION. - WORKING-STORAGE SECTION. - 77 STOPPER PIC S9 EXTERNAL. - PROCEDURE DIVISION. - IF STOPPER NOT EQUAL -1 - CALL "callee" - END-IF - GOBACK. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_misc.at:1262: \$COMPILE caller.cob" -at_fn_check_prepare_dynamic "$COMPILE caller.cob" "run_misc.at:1262" -( $at_check_trace; $COMPILE caller.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:1262" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_misc.at:1263: \$COMPILE_MODULE callee.cob" -at_fn_check_prepare_dynamic "$COMPILE_MODULE callee.cob" "run_misc.at:1263" -( $at_check_trace; $COMPILE_MODULE callee.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:1263" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_misc.at:1264: \$COMPILE_MODULE callee2.cob" -at_fn_check_prepare_dynamic "$COMPILE_MODULE callee2.cob" "run_misc.at:1264" -( $at_check_trace; $COMPILE_MODULE callee2.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:1264" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_misc.at:1265: \$COBCRUN_DIRECT ./caller" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./caller" "run_misc.at:1265" -( $at_check_trace; $COBCRUN_DIRECT ./caller -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo "OK + FINE" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:1265" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_569 -#AT_START_570 -at_fn_group_banner 570 'run_misc.at:1270' \ - "Recursive CALL of INITIAL program" " " 4 -at_xfail=no -( - $as_echo "570. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >caller.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. caller. - DATA DIVISION. - WORKING-STORAGE SECTION. - 77 STOPPER PIC 9 EXTERNAL. - PROCEDURE DIVISION. - MOVE 0 TO STOPPER - CALL "callee" END-CALL. - GOBACK. -_ATEOF - - -cat >callee.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. callee IS INITIAL. - DATA DIVISION. - WORKING-STORAGE SECTION. - 77 STOPPER PIC 9 EXTERNAL. - PROCEDURE DIVISION. - IF STOPPER = 1 - DISPLAY 'INITIAL prog was called RECURSIVE' - END-DISPLAY - STOP RUN RETURNING 1 - ELSE - MOVE 1 TO STOPPER - CALL "callee2" END-CALL - END-IF. - GOBACK. -_ATEOF - - -cat >callee2.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. callee2. - PROCEDURE DIVISION. - CALL "callee" END-CALL. - GOBACK. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_misc.at:1311: \$COMPILE caller.cob" -at_fn_check_prepare_dynamic "$COMPILE caller.cob" "run_misc.at:1311" -( $at_check_trace; $COMPILE caller.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:1311" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_misc.at:1312: \$COMPILE_MODULE callee.cob" -at_fn_check_prepare_dynamic "$COMPILE_MODULE callee.cob" "run_misc.at:1312" -( $at_check_trace; $COMPILE_MODULE callee.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:1312" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_misc.at:1313: \$COMPILE_MODULE callee2.cob" -at_fn_check_prepare_dynamic "$COMPILE_MODULE callee2.cob" "run_misc.at:1313" -( $at_check_trace; $COMPILE_MODULE callee2.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:1313" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_misc.at:1314: \$COBCRUN_DIRECT ./caller" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./caller" "run_misc.at:1314" -( $at_check_trace; $COBCRUN_DIRECT ./caller -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "libcob: callee2.cob:5: error: recursive CALL from callee2 to callee which is NOT RECURSIVE -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/run_misc.at:1314" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_570 -#AT_START_571 -at_fn_group_banner 571 'run_misc.at:1321' \ - "Recursive CALL with RECURSIVE assumed" " " 4 -at_xfail=no -( - $as_echo "571. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >caller.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. caller. - DATA DIVISION. - WORKING-STORAGE SECTION. - 77 STOPPER PIC 9 EXTERNAL. - PROCEDURE DIVISION. - MOVE 0 TO STOPPER - CALL "callee" END-CALL. - GOBACK. -_ATEOF - - -cat >callee.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. callee IS INITIAL. - DATA DIVISION. - WORKING-STORAGE SECTION. - 77 STOPPER PIC 9 EXTERNAL. - PROCEDURE DIVISION. - IF STOPPER = 9 - DISPLAY 'OK' NO ADVANCING END-DISPLAY - STOP RUN - ELSE - ADD 1 TO STOPPER END-ADD - CALL "callee2" END-CALL - END-IF. - GOBACK. -_ATEOF - - -cat >callee2.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. callee2. - PROCEDURE DIVISION. - CALL "callee" END-CALL. - GOBACK. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_misc.at:1361: \$COMPILE caller.cob" -at_fn_check_prepare_dynamic "$COMPILE caller.cob" "run_misc.at:1361" -( $at_check_trace; $COMPILE caller.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:1361" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_misc.at:1362: \$COMPILE_MODULE -fno-recursive-check callee.cob" -at_fn_check_prepare_dynamic "$COMPILE_MODULE -fno-recursive-check callee.cob" "run_misc.at:1362" -( $at_check_trace; $COMPILE_MODULE -fno-recursive-check callee.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:1362" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_misc.at:1363: \$COMPILE_MODULE -fno-recursive-check callee2.cob" -at_fn_check_prepare_dynamic "$COMPILE_MODULE -fno-recursive-check callee2.cob" "run_misc.at:1363" -( $at_check_trace; $COMPILE_MODULE -fno-recursive-check callee2.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:1363" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_misc.at:1364: \$COBCRUN_DIRECT ./caller" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./caller" "run_misc.at:1364" -( $at_check_trace; $COBCRUN_DIRECT ./caller -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo "OK" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:1364" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_571 -#AT_START_572 -at_fn_group_banner 572 'run_misc.at:1369' \ - "Recursive CALL with ON EXCEPTION" " " 4 -at_xfail=no -( - $as_echo "572. $at_setup_line: testing $at_desc ..." - $at_traceon - - - - -cat >caller.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. caller. - DATA DIVISION. - WORKING-STORAGE SECTION. - 77 STOPPER PIC 9 EXTERNAL. - PROCEDURE DIVISION. - MOVE 0 TO STOPPER - CALL "callee" END-CALL. - GOBACK. -_ATEOF - - -cat >callee.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. callee IS INITIAL. - DATA DIVISION. - WORKING-STORAGE SECTION. - 77 STOPPER PIC 9 EXTERNAL. - PROCEDURE DIVISION. - IF STOPPER = 1 - DISPLAY 'INITIAL prog was called RECURSIVE' - END-DISPLAY - STOP RUN RETURNING 1 - ELSE - MOVE 1 TO STOPPER - CALL "callee2" END-CALL - END-IF. - GOBACK. -_ATEOF - - -cat >callee2.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. callee2. - PROCEDURE DIVISION. - CALL "callee" - ON EXCEPTION - DISPLAY "Exception " FUNCTION EXCEPTION-STATUS ";" - UPON SYSERR - STOP RUN RETURNING 1 - END-CALL. - GOBACK. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_misc.at:1416: \$COMPILE caller.cob" -at_fn_check_prepare_dynamic "$COMPILE caller.cob" "run_misc.at:1416" -( $at_check_trace; $COMPILE caller.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:1416" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_misc.at:1417: \$COMPILE_MODULE callee.cob" -at_fn_check_prepare_dynamic "$COMPILE_MODULE callee.cob" "run_misc.at:1417" -( $at_check_trace; $COMPILE_MODULE callee.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:1417" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_misc.at:1418: \$COMPILE_MODULE callee2.cob" -at_fn_check_prepare_dynamic "$COMPILE_MODULE callee2.cob" "run_misc.at:1418" -( $at_check_trace; $COMPILE_MODULE callee2.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:1418" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_misc.at:1419: \$COBCRUN_DIRECT ./caller" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./caller" "run_misc.at:1419" -( $at_check_trace; $COBCRUN_DIRECT ./caller -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "Exception EC-PROGRAM-RECURSIVE-CALL ; -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/run_misc.at:1419" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_572 -#AT_START_573 -at_fn_group_banner 573 'run_misc.at:1426' \ - "Multiple calls of INITIAL program" " " 4 -at_xfail=no -( - $as_echo "573. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >caller.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. caller. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 PARAM1 PIC X(08). - 01 PARAM2 PIC 9999 COMP VALUE 08. - PROCEDURE DIVISION. - MOVE ' PARAM 1' TO PARAM1 - PERFORM 10 TIMES - CALL "callee" USING PARAM1 PARAM2 END-CALL - END-PERFORM - DISPLAY 'PARAM1 = ' PARAM1 - END-DISPLAY - STOP RUN. -_ATEOF - - -cat >callee.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. callee IS INITIAL. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 COUNTER PIC 999 VALUE ZERO. - 01 LPARAM PIC 9(8) COMP. - 01 WS-TEMP PIC 9(8)V99. - 01 PRICE-LOW PIC 9(3)V99 VALUE 10.50. - LINKAGE SECTION. - 01 PARAM1 PIC X(08). - 01 PARAM2 PIC 9999 COMP. - PROCEDURE DIVISION USING PARAM1 PARAM2. - ADD 1 TO COUNTER END-ADD - MOVE 1.10 TO WS-TEMP. - MULTIPLY PRICE-LOW BY WS-TEMP GIVING WS-TEMP. - CALL 'C$PARAMSIZE' USING 1 GIVING LPARAM END-CALL - DISPLAY 'COUNTER = ' COUNTER ' LPARAM1 = ' LPARAM - ' PARAM1 = ' PARAM1 - END-DISPLAY - GOBACK. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_misc.at:1469: \$COMPILE caller.cob" -at_fn_check_prepare_dynamic "$COMPILE caller.cob" "run_misc.at:1469" -( $at_check_trace; $COMPILE caller.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:1469" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_misc.at:1470: \$COMPILE_MODULE callee.cob" -at_fn_check_prepare_dynamic "$COMPILE_MODULE callee.cob" "run_misc.at:1470" -( $at_check_trace; $COMPILE_MODULE callee.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:1470" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_misc.at:1471: \$COBCRUN_DIRECT ./caller" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./caller" "run_misc.at:1471" -( $at_check_trace; $COBCRUN_DIRECT ./caller -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo "COUNTER = 001 LPARAM1 = 00000008 PARAM1 = PARAM 1 -COUNTER = 001 LPARAM1 = 00000008 PARAM1 = PARAM 1 -COUNTER = 001 LPARAM1 = 00000008 PARAM1 = PARAM 1 -COUNTER = 001 LPARAM1 = 00000008 PARAM1 = PARAM 1 -COUNTER = 001 LPARAM1 = 00000008 PARAM1 = PARAM 1 -COUNTER = 001 LPARAM1 = 00000008 PARAM1 = PARAM 1 -COUNTER = 001 LPARAM1 = 00000008 PARAM1 = PARAM 1 -COUNTER = 001 LPARAM1 = 00000008 PARAM1 = PARAM 1 -COUNTER = 001 LPARAM1 = 00000008 PARAM1 = PARAM 1 -COUNTER = 001 LPARAM1 = 00000008 PARAM1 = PARAM 1 -PARAM1 = PARAM 1 -" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:1471" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_573 -#AT_START_574 -at_fn_group_banner 574 'run_misc.at:1487' \ - "CALL binary literal parameter/LENGTH OF" " " 4 -at_xfail=no -( - $as_echo "574. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >dump.c <<'_ATEOF' - -#include -#include - -COB_EXT_EXPORT int -dump (unsigned char *p) -{ - if ( *p == 0 ) p++; - if ( *p == 0 ) p++; /* Skip leading bytes for BIG Endian value */ - if ( *p == 0 ) p++; - printf ("%8.8d\n", *p); - return 0; -} -_ATEOF - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 MYOCC PIC 9(8) COMP. - 01 MYTAB. - 03 MYBYTE PIC X OCCURS 1 TO 20 - DEPENDING ON MYOCC. - PROCEDURE DIVISION. - MOVE 9 TO MYOCC. - CALL "dump" USING BY CONTENT 1 - END-CALL. - CALL "dump" USING BY CONTENT LENGTH OF MYTAB - END-CALL. - CALL "dump" USING BY CONTENT LENGTH OF MYOCC - END-CALL. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_misc.at:1525: \$COMPILE_MODULE dump.c" -at_fn_check_prepare_dynamic "$COMPILE_MODULE dump.c" "run_misc.at:1525" -( $at_check_trace; $COMPILE_MODULE dump.c -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:1525" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_misc.at:1526: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_misc.at:1526" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:1526" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_misc.at:1527: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_misc.at:1527" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo "00000001 -00000009 -00000004 -" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:1527" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_misc.at:1532: \$COMPILE -fbinary-byteorder=native prog.cob -o prog2" -at_fn_check_prepare_dynamic "$COMPILE -fbinary-byteorder=native prog.cob -o prog2" "run_misc.at:1532" -( $at_check_trace; $COMPILE -fbinary-byteorder=native prog.cob -o prog2 -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:1532" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_misc.at:1533: \$COBCRUN_DIRECT ./prog2" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog2" "run_misc.at:1533" -( $at_check_trace; $COBCRUN_DIRECT ./prog2 -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo "00000001 -00000009 -00000004 -" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:1533" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_574 -#AT_START_575 -at_fn_group_banner 575 'run_misc.at:1542' \ - "CALL binary literal" " " 4 -at_xfail=no -( - $as_echo "575. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - - DATA DIVISION. - WORKING-STORAGE SECTION. - - PROCEDURE DIVISION. - CALL "SUB" USING 1280 BY VALUE 15. - CALL "SUB" USING 2560 BY VALUE 16. - STOP RUN. - END PROGRAM prog. - - IDENTIFICATION DIVISION. - PROGRAM-ID. "SUB". - - DATA DIVISION. - LINKAGE SECTION. - 01 x PIC 9(9) COMP. - 01 y PIC 9(9) COMP-5. - - PROCEDURE DIVISION USING x, VALUE y. - DISPLAY "COBOL: X is " x " and Y is " y. - END PROGRAM "SUB". -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_misc.at:1570: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_misc.at:1570" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:1570" -$at_failed && at_fn_log_failure -$at_traceon; } - - -{ set +x -$as_echo "$at_srcdir/run_misc.at:1572: ./prog" -at_fn_check_prepare_trace "run_misc.at:1572" -( $at_check_trace; ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo "COBOL: X is 000001280 and Y is 0000000015 -COBOL: X is 000002560 and Y is 0000000016 -" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:1572" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_575 -#AT_START_576 -at_fn_group_banner 576 'run_misc.at:1582' \ - "INSPECT REPLACING LEADING ZEROS BY SPACES" " " 4 -at_xfail=no -( - $as_echo "576. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 X PIC X(4) VALUE "0001". - PROCEDURE DIVISION. - INSPECT X REPLACING LEADING ZEROS BY SPACES. - IF X NOT = " 1" - DISPLAY X NO ADVANCING - END-DISPLAY - END-IF. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_misc.at:1600: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_misc.at:1600" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:1600" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_misc.at:1601: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_misc.at:1601" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:1601" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_576 -#AT_START_577 -at_fn_group_banner 577 'run_misc.at:1606' \ - "INSPECT No repeat conversion check" " " 4 -at_xfail=no -( - $as_echo "577. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 X PIC X(3) VALUE "BCA". - PROCEDURE DIVISION. - INSPECT X CONVERTING "ABC" TO "BCD". - IF X NOT = "CDB" - DISPLAY X NO ADVANCING - END-DISPLAY - END-IF. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_misc.at:1624: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_misc.at:1624" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:1624" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_misc.at:1625: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_misc.at:1625" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:1625" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_577 -#AT_START_578 -at_fn_group_banner 578 'run_misc.at:1630' \ - "INSPECT CONVERTING alphabet" " " 4 -at_xfail=no -( - $as_echo "578. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. charset. - - ENVIRONMENT DIVISION. - CONFIGURATION SECTION. - SPECIAL-NAMES. - ALPHABET ALPHA IS ASCII. - ALPHABET BETA IS EBCDIC. - - DATA DIVISION. - WORKING-STORAGE SECTION. - - 01 TESTHEX PIC X(10) VALUE X'C17BD6F2F0F1F8404040'. - - procedure division. - sample-main. - - INSPECT testhex CONVERTING BETA TO ALPHA - DISPLAY 'Converted: "' TESTHEX '"' WITH NO ADVANCING - - GOBACK. - END PROGRAM charset. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_misc.at:1658: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_misc.at:1658" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:1658" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_misc.at:1659: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_misc.at:1659" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo "Converted: \"A#O2018 \"" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:1659" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_578 -#AT_START_579 -at_fn_group_banner 579 'run_misc.at:1665' \ - "INSPECT CONVERTING TO figurative constant" " " 4 -at_xfail=no -( - $as_echo "579. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 X PIC X(3) VALUE "BCA". - PROCEDURE DIVISION. - INSPECT X CONVERTING "ABC" TO SPACES. - IF X NOT = SPACES - DISPLAY X NO ADVANCING - END-DISPLAY - END-IF. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_misc.at:1683: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_misc.at:1683" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:1683" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_misc.at:1684: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_misc.at:1684" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:1684" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_579 -#AT_START_580 -at_fn_group_banner 580 'run_misc.at:1689' \ - "INSPECT CONVERTING NULL" " " 4 -at_xfail=no -( - $as_echo "580. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 X PIC X(3) VALUE LOW-VALUES. - PROCEDURE DIVISION. - INSPECT X CONVERTING NULL TO "A". - IF X NOT = "AAA" - DISPLAY X NO ADVANCING - END-DISPLAY - END-IF. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_misc.at:1707: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_misc.at:1707" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:1707" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_misc.at:1708: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_misc.at:1708" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:1708" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_580 -#AT_START_581 -at_fn_group_banner 581 'run_misc.at:1713' \ - "INSPECT CONVERTING TO NULL" " " 4 -at_xfail=no -( - $as_echo "581. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 X PIC X(3) VALUE "AAA". - PROCEDURE DIVISION. - INSPECT X CONVERTING "A" TO NULL. - IF X NOT = LOW-VALUES - DISPLAY "NG" NO ADVANCING - END-DISPLAY - END-IF. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_misc.at:1731: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_misc.at:1731" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:1731" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_misc.at:1732: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_misc.at:1732" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:1732" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_581 -#AT_START_582 -at_fn_group_banner 582 'run_misc.at:1737' \ - "INSPECT REPLACING figurative constant" " " 4 -at_xfail=no -( - $as_echo "582. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 X PIC X(3) VALUE "BCA". - PROCEDURE DIVISION. - INSPECT X REPLACING ALL "BC" BY SPACE. - IF X NOT = " A" - DISPLAY X NO ADVANCING - END-DISPLAY - END-IF. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_misc.at:1755: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_misc.at:1755" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:1755" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_misc.at:1756: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_misc.at:1756" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:1756" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_582 -#AT_START_583 -at_fn_group_banner 583 'run_misc.at:1761' \ - "INSPECT TALLYING BEFORE" " " 4 -at_xfail=no -( - $as_echo "583. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 X PIC X(4) VALUE "ABC ". - 01 TAL PIC 999 VALUE 0. - PROCEDURE DIVISION. - MOVE 0 TO TAL. - INSPECT X TALLYING TAL FOR CHARACTERS - BEFORE INITIAL " ". - IF TAL NOT = 3 - DISPLAY TAL NO ADVANCING - END-DISPLAY - END-IF. - MOVE 0 TO TAL. - MOVE " ABC" TO X. - INSPECT X TALLYING TAL FOR CHARACTERS - BEFORE INITIAL " ". - IF TAL NOT = 0 - DISPLAY TAL NO ADVANCING - END-DISPLAY - END-IF. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_misc.at:1790: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_misc.at:1790" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:1790" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_misc.at:1791: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_misc.at:1791" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:1791" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_583 -#AT_START_584 -at_fn_group_banner 584 'run_misc.at:1796' \ - "INSPECT TALLYING AFTER" " " 4 -at_xfail=no -( - $as_echo "584. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 X PIC X(4) VALUE "ABC ". - 01 TAL PIC 999 VALUE 0. - PROCEDURE DIVISION. - MOVE 0 TO TAL. - INSPECT X TALLYING TAL FOR CHARACTERS - AFTER INITIAL " ". - IF TAL NOT = 0 - DISPLAY TAL NO ADVANCING - END-DISPLAY - END-IF. - MOVE 0 TO TAL. - MOVE " ABC" TO X. - INSPECT X TALLYING TAL FOR CHARACTERS - AFTER INITIAL " ". - IF TAL NOT = 3 - DISPLAY TAL NO ADVANCING - END-DISPLAY - END-IF. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_misc.at:1825: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_misc.at:1825" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:1825" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_misc.at:1826: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_misc.at:1826" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:1826" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_584 -#AT_START_585 -at_fn_group_banner 585 'run_misc.at:1831' \ - "INSPECT REPLACING TRAILING ZEROS BY SPACES" " " 4 -at_xfail=no -( - $as_echo "585. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 X PIC X(4) VALUE "1000". - PROCEDURE DIVISION. - INSPECT X REPLACING TRAILING ZEROS BY SPACES. - IF X NOT = "1 " - DISPLAY X NO ADVANCING - END-DISPLAY - END-IF. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_misc.at:1849: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_misc.at:1849" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:1849" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_misc.at:1850: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_misc.at:1850" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:1850" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_585 -#AT_START_586 -at_fn_group_banner 586 'run_misc.at:1855' \ - "INSPECT REPLACING complex" " " 4 -at_xfail=no -( - $as_echo "586. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 X PIC X(12) VALUE "AAABBCDCCCCC". - PROCEDURE DIVISION. - INSPECT X REPLACING - ALL "A" BY "Z" - "B" BY "Y" - TRAILING "C" BY "X". - IF X NOT = "ZZZYYCDXXXXX" - DISPLAY X NO ADVANCING - END-DISPLAY - END-IF. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_misc.at:1876: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_misc.at:1876" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:1876" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_misc.at:1877: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_misc.at:1877" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:1877" -$at_failed && at_fn_log_failure -$at_traceon; } - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_586 -#AT_START_587 -at_fn_group_banner 587 'run_misc.at:1881' \ - "SWITCHES (environment COB_SWITCH_n and SET)" " " 4 -at_xfail=no -( - $as_echo "587. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - CONFIGURATION SECTION. - SPECIAL-NAMES. - SWITCH-1 IS SWIT1 - ON IS SWIT1-ON - OFF IS SWIT1-OFF - SWITCH-2 IS SWIT2 - ON IS SWIT2-ON - OFF IS SWIT2-OFF - SWITCH-3 - ON IS SWIT3-ON - OFF IS SWIT3-OFF - SWITCH-4 IS SWIT4 - OFF IS SWIT4-OFF - SWITCH-31 - ON IS SWIT31-ON - SWITCH-36 IS SWIT36 - OFF IS SWIT36-OFF. - DATA DIVISION. - WORKING-STORAGE SECTION. - PROCEDURE DIVISION. - IF SWIT1-ON - DISPLAY "ON" NO ADVANCING - END-DISPLAY - ELSE - DISPLAY "OFF" NO ADVANCING - END-DISPLAY - END-IF. - IF SWIT2-ON - DISPLAY " ON" NO ADVANCING - END-DISPLAY - ELSE - DISPLAY " OFF" NO ADVANCING - END-DISPLAY - END-IF. - IF SWIT3-ON - DISPLAY " ON" NO ADVANCING - END-DISPLAY - ELSE - DISPLAY " OFF" NO ADVANCING - END-DISPLAY - END-IF. - IF NOT SWIT4-OFF - DISPLAY " ON" NO ADVANCING - END-DISPLAY - ELSE - DISPLAY " OFF" NO ADVANCING - END-DISPLAY - END-IF. - SET SWIT1 TO OFF. - SET SWIT2 TO ON. - IF SWIT1-ON - DISPLAY " ON" NO ADVANCING - END-DISPLAY - ELSE - DISPLAY " OFF" NO ADVANCING - END-DISPLAY - END-IF. - IF SWIT2-ON - DISPLAY " ON" NO ADVANCING - END-DISPLAY - ELSE - DISPLAY " OFF" NO ADVANCING - END-DISPLAY - END-IF - IF SWIT31-ON - DISPLAY " ON" NO ADVANCING - END-DISPLAY - ELSE - DISPLAY " OFF" NO ADVANCING - END-DISPLAY - END-IF. - IF NOT SWIT36-OFF - DISPLAY " ON" NO ADVANCING - END-DISPLAY - ELSE - DISPLAY " OFF" NO ADVANCING - END-DISPLAY - END-IF. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_misc.at:1969: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_misc.at:1969" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:1969" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_misc.at:1970: COB_SWITCH_1=1 COB_SWITCH_2=0 COB_SWITCH_3=OFF COB_SWITCH_4=ON COB_SWITCH_36=ON ./prog" -at_fn_check_prepare_trace "run_misc.at:1970" -( $at_check_trace; COB_SWITCH_1=1 COB_SWITCH_2=0 COB_SWITCH_3=OFF COB_SWITCH_4=ON COB_SWITCH_36=ON ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo "ON OFF OFF ON OFF ON OFF ON" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:1970" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_587 -#AT_START_588 -at_fn_group_banner 588 'run_misc.at:1978' \ - "Nested PERFORM" " " 4 -at_xfail=no -( - $as_echo "588. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - PROCEDURE DIVISION. - PERFORM 2 TIMES - DISPLAY "X" NO ADVANCING - END-DISPLAY - PERFORM 2 TIMES - DISPLAY "Y" NO ADVANCING - END-DISPLAY - END-PERFORM - END-PERFORM. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_misc.at:1996: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_misc.at:1996" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:1996" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_misc.at:1997: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_misc.at:1997" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo "XYYXYY" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:1997" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_588 -#AT_START_589 -at_fn_group_banner 589 'run_misc.at:2002' \ - "PERFORM VARYING BY -0.2" " " 4 -at_xfail=no -( - $as_echo "589. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 77 X PIC 9v9. - PROCEDURE DIVISION. - PERFORM VARYING X FROM 0.8 BY -0.2 - UNTIL X < 0.4 - DISPLAY "X" NO ADVANCING - END-DISPLAY - END-PERFORM. - IF X NOT = 0.2 - DISPLAY "WRONG X: " X END-DISPLAY - END-IF - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_misc.at:2023: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_misc.at:2023" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:2023" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_misc.at:2024: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_misc.at:2024" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo "XXX" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:2024" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_589 -#AT_START_590 -at_fn_group_banner 590 'run_misc.at:2029' \ - "PERFORM VARYING BY phrase omitted" " " 4 -at_xfail=no -( - $as_echo "590. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 77 X PIC 9. - PROCEDURE DIVISION. - PERFORM VARYING X FROM 4 - UNTIL X > 6 - DISPLAY "X" NO ADVANCING - END-PERFORM. - IF X NOT = 7 - DISPLAY "WRONG X: " X - END-IF - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_misc.at:2049: \$COMPILE_ONLY -std=cobol85 prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY -std=cobol85 prog.cob" "run_misc.at:2049" -( $at_check_trace; $COMPILE_ONLY -std=cobol85 prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob:9: error: PERFORM VARYING without BY phrase does not conform to COBOL 85 -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/run_misc.at:2049" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_misc.at:2052: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_misc.at:2052" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:2052" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_misc.at:2053: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_misc.at:2053" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo "XXX" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:2053" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_590 -#AT_START_591 -at_fn_group_banner 591 'run_misc.at:2060' \ - "EXIT PERFORM" " " 4 -at_xfail=no -( - $as_echo "591. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - PROCEDURE DIVISION. - PERFORM 2 TIMES - DISPLAY "OK" NO ADVANCING - END-DISPLAY - EXIT PERFORM - DISPLAY "NOT OK" - END-DISPLAY - END-PERFORM - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_misc.at:2077: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_misc.at:2077" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:2077" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_misc.at:2078: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_misc.at:2078" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo "OK" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:2078" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_591 -#AT_START_592 -at_fn_group_banner 592 'run_misc.at:2085' \ - "EXIT PERFORM CYCLE" " " 4 -at_xfail=no -( - $as_echo "592. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - PROCEDURE DIVISION. - PERFORM 2 TIMES - DISPLAY "OK" NO ADVANCING - END-DISPLAY - EXIT PERFORM CYCLE - DISPLAY "NOT OK" - END-DISPLAY - END-PERFORM - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_misc.at:2102: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_misc.at:2102" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:2102" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_misc.at:2103: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_misc.at:2103" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo "OKOK" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:2103" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_592 -#AT_START_593 -at_fn_group_banner 593 'run_misc.at:2110' \ - "EXIT PARAGRAPH" " " 4 -at_xfail=no -( - $as_echo "593. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 INDVAL PIC 9(4). - PROCEDURE DIVISION. - A01. - PERFORM VARYING INDVAL FROM 1 BY 1 UNTIL INDVAL > 10 - IF INDVAL > 2 - EXIT PARAGRAPH - END-IF - END-PERFORM. - A02. - IF INDVAL NOT = 3 - DISPLAY INDVAL NO ADVANCING - END-DISPLAY - END-IF. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_misc.at:2134: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_misc.at:2134" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:2134" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_misc.at:2135: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_misc.at:2135" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:2135" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_593 -#AT_START_594 -at_fn_group_banner 594 'run_misc.at:2142' \ - "EXIT SECTION" " " 4 -at_xfail=no -( - $as_echo "594. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 INDVAL PIC 9(4). - PROCEDURE DIVISION. - A01 SECTION. - A011. - PERFORM VARYING INDVAL FROM 1 BY 1 UNTIL INDVAL > 10 - IF INDVAL > 2 - EXIT SECTION - END-IF - END-PERFORM. - A012. - DISPLAY INDVAL NO ADVANCING - END-DISPLAY. - A02 SECTION. - IF INDVAL NOT = 3 - DISPLAY INDVAL NO ADVANCING - END-DISPLAY - END-IF. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_misc.at:2170: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_misc.at:2170" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:2170" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_misc.at:2171: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_misc.at:2171" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:2171" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_594 -#AT_START_595 -at_fn_group_banner 595 'run_misc.at:2176' \ - "PERFORM FOREVER / PERFORM UNTIL EXIT" " " 4 -at_xfail=no -( - $as_echo "595. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 INDVAL PIC 9(4). - PROCEDURE DIVISION. - A01. - MOVE 0 TO INDVAL - PERFORM UNTIL EXIT - ADD 1 TO INDVAL - IF INDVAL > 2 - EXIT PERFORM - END-IF - END-PERFORM - IF INDVAL NOT = 3 - DISPLAY "1: " INDVAL - END-DISPLAY - END-IF - PERFORM FOREVER - ADD 1 TO INDVAL - IF INDVAL > 4 - EXIT PERFORM - END-IF - END-PERFORM - IF INDVAL NOT = 5 - DISPLAY "2: " INDVAL - END-DISPLAY - END-IF - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_misc.at:2211: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_misc.at:2211" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:2211" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_misc.at:2212: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_misc.at:2212" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:2212" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_595 -#AT_START_596 -at_fn_group_banner 596 'run_misc.at:2217' \ - "PERFORM inline (1)" " " 4 -at_xfail=no -( - $as_echo "596. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 INDVAL PIC 9(4). - PROCEDURE DIVISION. - PERFORM VARYING INDVAL FROM 1 - BY 1 UNTIL INDVAL > 2 - END-PERFORM - IF INDVAL NOT = 3 - DISPLAY INDVAL NO ADVANCING - END-DISPLAY - END-IF - STOP RUN - . -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_misc.at:2238: \$COMPILE -fmissing-statement=ok prog.cob" -at_fn_check_prepare_dynamic "$COMPILE -fmissing-statement=ok prog.cob" "run_misc.at:2238" -( $at_check_trace; $COMPILE -fmissing-statement=ok prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:2238" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_misc.at:2239: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_misc.at:2239" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:2239" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_596 -#AT_START_597 -at_fn_group_banner 597 'run_misc.at:2244' \ - "PERFORM inline (2)" " " 4 -at_xfail=no -( - $as_echo "597. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 INDVAL PIC 9(4). - PROCEDURE DIVISION. - PERFORM VARYING INDVAL FROM 1 - BY 1 UNTIL INDVAL > 2. - IF INDVAL NOT = 3 - DISPLAY INDVAL NO ADVANCING - END-DISPLAY - END-IF - . -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_misc.at:2263: \$COMPILE -frelax-syntax-checks -w prog.cob" -at_fn_check_prepare_dynamic "$COMPILE -frelax-syntax-checks -w prog.cob" "run_misc.at:2263" -( $at_check_trace; $COMPILE -frelax-syntax-checks -w prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:2263" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_misc.at:2264: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_misc.at:2264" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:2264" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_597 -#AT_START_598 -at_fn_group_banner 598 'run_misc.at:2269' \ - "Non-overflow after overflow" " " 4 -at_xfail=no -( - $as_echo "598. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 X PIC 9(2) VALUE 0. - 01 Y PIC 9(2) VALUE 0. - PROCEDURE DIVISION. - COMPUTE X = 100 - END-COMPUTE. - COMPUTE Y = 99 - END-COMPUTE. - IF Y NOT = 99 - DISPLAY Y NO ADVANCING - END-DISPLAY - END-IF. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_misc.at:2291: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_misc.at:2291" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:2291" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_misc.at:2292: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_misc.at:2292" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:2292" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_598 -#AT_START_599 -at_fn_group_banner 599 'run_misc.at:2299' \ - "PERFORM ... CONTINUE" " " 4 -at_xfail=no -( - $as_echo "599. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - PROCEDURE DIVISION. - PERFORM 2 TIMES - CONTINUE - END-PERFORM. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_misc.at:2311: \$COMPILE_ONLY prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY prog.cob" "run_misc.at:2311" -( $at_check_trace; $COMPILE_ONLY prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:2311" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_599 -#AT_START_600 -at_fn_group_banner 600 'run_misc.at:2316' \ - "STRING with subscript reference" " " 4 -at_xfail=no -( - $as_echo "600. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 G. - 02 X PIC X(3) OCCURS 3. - PROCEDURE DIVISION. - MOVE SPACES TO G. - STRING "abc" INTO X(2) - END-STRING. - IF G NOT = " abc " - DISPLAY X(1) NO ADVANCING - END-DISPLAY - END-IF. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_misc.at:2337: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_misc.at:2337" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:2337" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_misc.at:2338: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_misc.at:2338" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:2338" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_600 -#AT_START_601 -at_fn_group_banner 601 'run_misc.at:2343' \ - "STRING / UNSTRING NOT ON OVERFLOW" " " 4 -at_xfail=no -( - $as_echo "601. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - identification division. - program-id. prog. - data division. - working-storage section. - 77 simple-str pic x(20). - 77 err-str pic x(50). - *----------------------------------------------------------------- - procedure division. - * STRING test - move spaces to simple-str - string 'data' - delimited by size - into simple-str - on overflow - move spaces to err-str - string 'STRING OVERFLOW' - delimited by size - into err-str - end-string - display err-str upon syserr - end-display - display '1 failed' - end-display - not on overflow - display '1 passed' - end-display - end-string - if simple-str not = 'data' - display 'STRING ERROR (1): "' simple-str '"' - end-display - end-if - * - move spaces to simple-str - string 'data is too big here...' - delimited by size - into simple-str - on overflow - display '2 passed' - end-display - not on overflow - display '2 failed' - end-display - move spaces to err-str - string 'missing OVERFLOW' - delimited by size - into err-str - end-string - display err-str upon syserr - end-display - end-string - if simple-str not = 'data is too big here' - display 'STRING ERROR (2): "' simple-str '"' - end-display - end-if - * - * UNSTRING test - move spaces to simple-str - unstring 'data' - into simple-str - on overflow - move spaces to err-str - unstring 'UNSTRING OVERFLOW' - into err-str - end-unstring - display err-str upon syserr - end-display - display '3 failed' - end-display - not on overflow - display '3 passed' - end-display - end-unstring - if simple-str not = 'data' - display 'UNSTRING ERROR (1): "' simple-str '"' - end-display - end-if - * - move spaces to simple-str - unstring 'data is too big here...' - into simple-str - on overflow - display '4 passed' - end-display - not on overflow - display '4 failed' - end-display - move spaces to err-str - string 'missing OVERFLOW' - delimited by size - into err-str - end-string - display err-str upon syserr - end-display - end-unstring - if simple-str not = 'data is too big here' - display 'UNSTRING ERROR (2): "' simple-str '"' - end-display - end-if - * - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_misc.at:2449: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_misc.at:2449" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:2449" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_misc.at:2450: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_misc.at:2450" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo "1 passed -2 passed -3 passed -4 passed -" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:2450" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_601 -#AT_START_602 -at_fn_group_banner 602 'run_misc.at:2460' \ - "UNSTRING DELIMITED ALL LOW-VALUE" " " 4 -at_xfail=no -( - $as_echo "602. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 G. - 03 FILLER PIC XXX VALUE "ABC". - 03 FILLER PIC XX VALUE LOW-VALUES. - 03 FILLER PIC XXX VALUE "DEF". - 01 A PIC XXX. - 01 B PIC XXX. - PROCEDURE DIVISION. - UNSTRING G DELIMITED BY ALL LOW-VALUES - INTO A B - END-UNSTRING. - IF A NOT = "ABC" - DISPLAY A - END-DISPLAY - END-IF. - IF B NOT = "DEF" - DISPLAY B - END-DISPLAY - END-IF. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_misc.at:2489: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_misc.at:2489" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:2489" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_misc.at:2490: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_misc.at:2490" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:2490" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_602 -#AT_START_603 -at_fn_group_banner 603 'run_misc.at:2495' \ - "UNSTRING DELIMITED ALL SPACE-2" " " 4 -at_xfail=no -( - $as_echo "603. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 WS-RECORD. - 02 VALUE SPACE PIC X(04). - 02 VALUE "ABC AND DE" PIC X(10). - 02 VALUE SPACE PIC X(07). - 02 VALUE "FG AND HIJ" PIC X(10). - 02 VALUE SPACE PIC X(08). - 01 SPACE-2 PIC X(02) VALUE SPACE. - 01 WS-DUMMY PIC X(15). - 01 WS-POINTER PIC 99. - PROCEDURE DIVISION. - MOVE 1 TO WS-POINTER. - * - PERFORM 0001-SUB. - IF WS-DUMMY NOT = SPACE - DISPLAY "Expected space - Got " WS-DUMMY - END-DISPLAY - END-IF. - IF WS-POINTER NOT = 5 - DISPLAY "Expected 5 - Got " WS-POINTER - END-DISPLAY - END-IF. - * - PERFORM 0001-SUB. - IF WS-DUMMY NOT = "ABC AND DE" - DISPLAY "Expected ABC AND DE - Got " WS-DUMMY - END-DISPLAY - END-IF. - IF WS-POINTER NOT = 21 - DISPLAY "Expected 21 - Got " WS-POINTER - END-DISPLAY - END-IF. - * - PERFORM 0001-SUB. - IF WS-DUMMY NOT = " FG AND HIJ" - DISPLAY "Expected FG AND HIJ - Got " WS-DUMMY - END-DISPLAY - END-IF. - IF WS-POINTER NOT = 40 - DISPLAY "Expected 40 - Got " WS-POINTER - END-DISPLAY - END-IF. - STOP RUN. - 0001-SUB. - UNSTRING WS-RECORD - DELIMITED BY ALL SPACE-2 - INTO WS-DUMMY - POINTER WS-POINTER - END-UNSTRING. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_misc.at:2554: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_misc.at:2554" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:2554" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_misc.at:2555: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_misc.at:2555" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:2555" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_603 -#AT_START_604 -at_fn_group_banner 604 'run_misc.at:2560' \ - "UNSTRING DELIMITED POINTER" " " 4 -at_xfail=no -( - $as_echo "604. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 WS-LAY-RECORD PIC X(66). - 01 WS-DUMMY PIC X(50). - 01 WS-KEYWORD PIC X(32). - 01 WS-POINTER PIC 99. - PROCEDURE DIVISION. - MOVE - ' 10 AF-RECORD-TYPE-SEQUENCE-04 PIC 9(05) COMP-3.' - TO WS-LAY-RECORD. - MOVE 1 TO WS-POINTER. - PERFORM 0001-SUB. - IF WS-POINTER NOT = 48 - DISPLAY "Expected 48 - Got " WS-POINTER - END-DISPLAY - END-IF. - ADD 7 TO WS-POINTER - END-ADD. - PERFORM 0001-SUB. - IF WS-POINTER NOT = 62 - DISPLAY "Expected 62 - Got " WS-POINTER - END-DISPLAY - END-IF. - PERFORM 0001-SUB. - IF WS-POINTER NOT = 63 - DISPLAY "Expected 63 - Got " WS-POINTER - END-DISPLAY - END-IF. - STOP RUN. - 0001-SUB. - UNSTRING WS-LAY-RECORD - DELIMITED - BY ' PIC ' - OR ' COMP-3' - OR '.' - INTO WS-DUMMY - DELIMITER WS-KEYWORD - POINTER WS-POINTER - END-UNSTRING. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_misc.at:2608: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_misc.at:2608" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:2608" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_misc.at:2609: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_misc.at:2609" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:2609" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_604 -#AT_START_605 -at_fn_group_banner 605 'run_misc.at:2614' \ - "UNSTRING DELIMITER IN" " " 4 -at_xfail=no -( - $as_echo "605. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 WK-CMD PIC X(8) VALUE "WWADDBCC". - 01 FILLER. - 02 WK-SIGNS PIC XX VALUE "AB". - 02 WKS REDEFINES WK-SIGNS. - 03 WK-SIGN PIC X OCCURS 2. - 02 WK-DELIM PIC X OCCURS 2. - 02 WK-DATA PIC X(2) OCCURS 3. - PROCEDURE DIVISION. - UNSTRING WK-CMD DELIMITED BY WK-SIGN(1) OR WK-SIGN(2) - INTO WK-DATA(1) DELIMITER IN WK-DELIM(1) - WK-DATA(2) DELIMITER IN WK-DELIM(2) - WK-DATA(3) - END-UNSTRING - IF WK-DATA(1) NOT = "WW" - OR WK-DATA(2) NOT = "DD" - OR WK-DATA(3) NOT = "CC" - OR WK-DELIM(1) NOT = "A" - OR WK-DELIM(2) NOT = "B" - DISPLAY WK-DATA(1) - WK-DATA(2) - WK-DATA(3) - WK-DELIM(1) - WK-DELIM(2) - END-DISPLAY - END-IF. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_misc.at:2651: \$COMPILE -ftop-level-occurs-clause=ok prog.cob" -at_fn_check_prepare_dynamic "$COMPILE -ftop-level-occurs-clause=ok prog.cob" "run_misc.at:2651" -( $at_check_trace; $COMPILE -ftop-level-occurs-clause=ok prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:2651" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_misc.at:2652: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_misc.at:2652" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:2652" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_605 -#AT_START_606 -at_fn_group_banner 606 'run_misc.at:2657' \ - "UNSTRING with FUNCTION / literal" " " 4 -at_xfail=no -( - $as_echo "606. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 FILLER. - 05 TSTUNS PIC X(479). - 05 PRM PIC X(16) OCCURS 4 TIMES. - PROCEDURE DIVISION. - MOVE "The,Quick,Brown,Fox" TO TSTUNS. - UNSTRING TSTUNS DELIMITED BY ',' - INTO PRM(1), PRM(2), PRM(3), PRM(4). - DISPLAY "PRM(1) is " PRM(1) ":". - DISPLAY "PRM(2) is " PRM(2) ":". - DISPLAY "PRM(3) is " PRM(3) ":". - DISPLAY "PRM(4) is " PRM(4) ":". - UNSTRING FUNCTION UPPER-CASE(TSTUNS) DELIMITED BY ',' - INTO PRM(1), PRM(2), PRM(3), PRM(4). - DISPLAY "Now using UPPER-CASE" - DISPLAY "PRM(1) is " PRM(1) ":". - DISPLAY "PRM(2) is " PRM(2) ":". - DISPLAY "PRM(3) is " PRM(3) ":". - DISPLAY "PRM(4) is " PRM(4) ":". - UNSTRING "Daddy,was,a,Rolling stone" DELIMITED BY ',' - INTO PRM(1), PRM(2), PRM(3), PRM(4). - DISPLAY "Now using Literal" - DISPLAY "PRM(1) is " PRM(1) ":". - DISPLAY "PRM(2) is " PRM(2) ":". - DISPLAY "PRM(3) is " PRM(3) ":". - DISPLAY "PRM(4) is " PRM(4) ":". - UNSTRING FUNCTION LOWER-CASE("Daddy,was,a,Rolling stone") - DELIMITED BY ',' - INTO PRM(1), PRM(2), PRM(3), PRM(4). - DISPLAY "Now using Literal + LOWER-CASE" - DISPLAY "PRM(1) is " PRM(1) ":". - DISPLAY "PRM(2) is " PRM(2) ":". - DISPLAY "PRM(3) is " PRM(3) ":". - DISPLAY "PRM(4) is " PRM(4) ":". - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_misc.at:2701: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_misc.at:2701" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:2701" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_misc.at:2702: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_misc.at:2702" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo "PRM(1) is The : -PRM(2) is Quick : -PRM(3) is Brown : -PRM(4) is Fox : -Now using UPPER-CASE -PRM(1) is THE : -PRM(2) is QUICK : -PRM(3) is BROWN : -PRM(4) is FOX : -Now using Literal -PRM(1) is Daddy : -PRM(2) is was : -PRM(3) is a : -PRM(4) is Rolling stone : -Now using Literal + LOWER-CASE -PRM(1) is daddy : -PRM(2) is was : -PRM(3) is a : -PRM(4) is rolling stone : -" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:2702" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_606 -#AT_START_607 -at_fn_group_banner 607 'run_misc.at:2727' \ - "PICTURE COMP-X" " " 4 -at_xfail=no -( - $as_echo "607. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 TST. - 05 BVAL PIC 9999 BINARY VALUE 512. - 05 XVAL PIC XX COMP-X VALUE 512. - 88 XLOW VALUE 0 THRU 256. - 88 XHIGH VALUE 257 THRU 65536. - 05 VAL9 PIC 99999 COMP-X VALUE 1024. - 88 LOW9 VALUE 0 THRU 256. - 88 HIGH9 VALUE 257 THRU 65536. - 05 XVAL2 PIC XX COMP-X VALUE 16706. - 05 XVALX REDEFINES XVAL2 PIC XX. - 05 YVALX PIC XX VALUE 'A '. - 05 YVAL2 REDEFINES YVALX PIC XX COMP-X. - - PROCEDURE DIVISION. - DISPLAY " XVAL is " XVAL "; Length is " LENGTH OF XVAL. - DISPLAY " VAL9 is " VAL9 "; Length is " LENGTH OF VAL9. - MOVE 10240 TO XVAL. - DISPLAY " XVAL is " XVAL "; Length is " LENGTH OF XVAL. - DISPLAY "XVAL2 is " XVAL2 "; Length is " LENGTH OF XVAL2. - DISPLAY "XVALX is " XVALX "; Length is " LENGTH OF XVALX. - ADD 1 TO XVAL2. - DISPLAY "XVALX is " XVALX " after +1;". - COMPUTE XVAL2 = XVAL2 / 256 + 8192. - DISPLAY "XVALX is " XVALX " after / 256 + 8192;". - MOVE 'DE' TO XVALX. - DISPLAY "Numeric: " XVAL2 " is char " XVALX. - MOVE ZERO TO YVAL2. - MOVE 'D' TO YVALX (1:1) - MOVE LOW-VALUES TO YVALX (2:1) - SUBTRACT YVAL2 FROM XVAL2. - MOVE ' ' TO YVALX (1:1) - MOVE LOW-VALUES TO YVALX (2:1) - ADD YVAL2 TO XVAL2. - DISPLAY "Numeric: " XVAL2 " is char " XVALX. - MOVE 0 TO XVAL. - ADD 10240 TO XVAL. - IF XVAL = 10240 - DISPLAY "XVAL is " XVAL - ELSE - DISPLAY "XVAL is not 10240 but " XVAL - END-IF. - MOVE 0 TO BVAL. - ADD 10240 TO BVAL. - IF BVAL = 0240 - DISPLAY "BVAL is " BVAL - ELSE - DISPLAY "BVAL is not 0240 but " BVAL - END-IF. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_misc.at:2786: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_misc.at:2786" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:2786" -$at_failed && at_fn_log_failure -$at_traceon; } - - -{ set +x -$as_echo "$at_srcdir/run_misc.at:2788: ./prog" -at_fn_check_prepare_trace "run_misc.at:2788" -( $at_check_trace; ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo " XVAL is 00512; Length is 2 - VAL9 is 01024; Length is 3 - XVAL is 10240; Length is 2 -XVAL2 is 16706; Length is 2 -XVALX is AB; Length is 2 -XVALX is AC after +1; -XVALX is A after / 256 + 8192; -Numeric: 17477 is char DE -Numeric: 08261 is char E -XVAL is 10240 -BVAL is 0240 -" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:2788" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_607 -#AT_START_608 -at_fn_group_banner 608 'run_misc.at:2804' \ - "SORT: table sort" " " 4 -at_xfail=no -( - $as_echo "608. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 G VALUE "d4b2e1a3c5". - 02 TBL OCCURS 5. - 03 X PIC X. - 03 Y PIC 9. - PROCEDURE DIVISION. - SORT TBL ASCENDING KEY X. - IF G NOT = "a3b2c5d4e1" - DISPLAY G - END-DISPLAY - END-IF. - SORT TBL DESCENDING KEY Y. - IF G NOT = "c5d4a3b2e1" - DISPLAY G - END-DISPLAY - END-IF. - SORT TBL ASCENDING KEY TBL. - IF G NOT = "a3b2c5d4e1" - DISPLAY G - END-DISPLAY - END-IF. - SORT TBL DESCENDING KEY. - IF G NOT = "e1d4c5b2a3" - DISPLAY G - END-DISPLAY - END-IF. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_misc.at:2840: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_misc.at:2840" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:2840" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_misc.at:2841: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_misc.at:2841" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:2841" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_608 -#AT_START_609 -at_fn_group_banner 609 'run_misc.at:2846' \ - "SORT: table sort (2)" " " 4 -at_xfail=no -( - $as_echo "609. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 K PIC 9(2). - - 01 CNT1 PIC 9(9) COMP-5 VALUE 4. - 01 TAB1. - 05 ROW1 OCCURS 1 TO 4 DEPENDING CNT1 - DESCENDING TAB1-NR. - 10 TAB1-NR PIC 99. - - 01 TAB2. - 05 CNT2 PIC 9(9) COMP-5 VALUE 4. - 05 ROW2 OCCURS 1 TO 4 DEPENDING CNT2 - DESCENDING TAB2-NR. - 10 TAB2-NR PIC 99. - - 01 TAB3. - 05 CNT3 PIC 9(9) COMP-5 VALUE 10. - 05 ROW3 OCCURS 1 TO 10 DEPENDING CNT3 - DESCENDING TAB3-NR - ASCENDING TAB3-DATA. - 10 TAB3-NR PIC 99. - 10 FILLER PIC X(2). - 10 TAB3-DATA PIC X(5). - 10 FILLER PIC X(2). - 10 TAB3-DATA2 PIC X(5). - - - PROCEDURE DIVISION. - A. - PERFORM VARYING K FROM 1 BY 1 UNTIL K > 4 - MOVE K TO TAB1-NR(K), TAB2-NR(K) - END-PERFORM - - MOVE 1 TO TAB3-NR(1). - MOVE 1 TO TAB3-NR(8). - MOVE 1 TO TAB3-NR(4). - MOVE 6 TO TAB3-NR(2). - MOVE 5 TO TAB3-NR(3). - MOVE 5 TO TAB3-NR(9). - MOVE 2 TO TAB3-NR(5). - MOVE 2 TO TAB3-NR(10). - MOVE 4 TO TAB3-NR(6). - MOVE 3 TO TAB3-NR(7). - - MOVE "abcde" TO TAB3-DATA(1). - MOVE "AbCde" TO TAB3-DATA(2). - MOVE "abcde" TO TAB3-DATA(3). - MOVE "zyx" TO TAB3-DATA(4). - MOVE "12345" TO TAB3-DATA(5). - MOVE "zyx" TO TAB3-DATA(6). - MOVE "abcde" TO TAB3-DATA(7). - MOVE "AbCde" TO TAB3-DATA(8). - MOVE "abc" TO TAB3-DATA(9). - MOVE "12346" TO TAB3-DATA(10). - - MOVE "day" TO TAB3-DATA2(1). - MOVE "The" TO TAB3-DATA2(2). - MOVE "eats" TO TAB3-DATA2(3). - MOVE "." TO TAB3-DATA2(4). - MOVE "mooos" TO TAB3-DATA2(5). - MOVE "grass" TO TAB3-DATA2(6). - MOVE "and" TO TAB3-DATA2(7). - MOVE "whole" TO TAB3-DATA2(8). - MOVE "cow" TO TAB3-DATA2(9). - MOVE "the" TO TAB3-DATA2(10). - - SORT ROW1 DESCENDING TAB1-NR - SORT ROW2 DESCENDING TAB2-NR - - DISPLAY "SINGLE TABLE" END-DISPLAY - PERFORM VARYING K FROM 1 BY 1 UNTIL K > 4 - DISPLAY FUNCTION TRIM(TAB1-NR(K)) END-DISPLAY - END-PERFORM - - DISPLAY "LOWER LEVEL TABLE" END-DISPLAY - PERFORM VARYING K FROM 1 BY 1 UNTIL K > 4 - DISPLAY FUNCTION TRIM(TAB2-NR(K)) END-DISPLAY - END-PERFORM - - SORT ROW3 DESCENDING TAB3-NR ASCENDING TAB3-DATA - - DISPLAY "MULTY KEY SORT" END-DISPLAY - PERFORM VARYING K FROM 1 BY 1 UNTIL K > 10 - DISPLAY FUNCTION TRIM(ROW3(K)) - END-DISPLAY - END-PERFORM - - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_misc.at:2944: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_misc.at:2944" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:2944" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_misc.at:2945: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_misc.at:2945" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo "SINGLE TABLE -04 -03 -02 -01 -LOWER LEVEL TABLE -04 -03 -02 -01 -MULTY KEY SORT -06 AbCde The -05 abc cow -05 abcde eats -04 zyx grass -03 abcde and -02 12345 mooos -02 12346 the -01 AbCde whole -01 abcde day -01 zyx . -" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:2945" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_609 -#AT_START_610 -at_fn_group_banner 610 'run_misc.at:2971' \ - "SORT: table sort (3)" " " 4 -at_xfail=no -( - $as_echo "610. $at_setup_line: testing $at_desc ..." - $at_traceon - - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 K PIC 9(2). - - 01 CNT1 PIC 9(9) COMP-5 VALUE 4. - 01 TAB1. - 05 ROW1 OCCURS 1 TO 4 DEPENDING CNT1 - DESCENDING TAB1-NR. - 10 TAB1-NR PIC 99. - 10 TAB-DATA PIC X(5). - 01 TAB2. - 05 ROW2 OCCURS 1 TO 4 DEPENDING CNT1 - ASCENDING ROW2. - 10 TAB2-NR PIC 99. - 10 TAB2-DATA PIC X(5). - - PROCEDURE DIVISION. - A. - PERFORM VARYING K FROM 1 BY 1 UNTIL K > 4 - MOVE K TO TAB1-NR (K) - MOVE 'BLA' TO TAB-DATA(K) - END-PERFORM - - SORT ROW1 - - PERFORM VARYING K FROM 1 BY 1 UNTIL K > 4 - DISPLAY TAB1-NR(K) NO ADVANCING END-DISPLAY - END-PERFORM - - MOVE TAB1 TO TAB2 - SORT ROW2 - - PERFORM VARYING K FROM 1 BY 1 UNTIL K > 4 - DISPLAY TAB2-NR(K) NO ADVANCING END-DISPLAY - END-PERFORM - - STOP RUN. -_ATEOF - - -cat >prog2.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog2. - ENVIRONMENT DIVISION. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 K PIC 9(2). - - 01 CNT1 PIC 9(9) COMP-5 VALUE 4. - 01 TAB1. - 05 ROW1 OCCURS 5 DESCENDING TAB1-NR. - 10 TAB1-NR PIC 99 VALUE ZERO. - 10 TAB-DATA PIC X(5). - 01 TAB2. - 05 ROW1 OCCURS 1 TO 4 DEPENDING CNT1 - DESCENDING TAB1-NR. - 10 TAB1-NR PIC 99. - 10 TAB-DATA PIC X(5). - - PROCEDURE DIVISION. - A. - DISPLAY TAB1-NR OF TAB1 (2) NO ADVANCING END-DISPLAY - - PERFORM VARYING K FROM 1 BY 1 UNTIL K > 4 - MOVE K TO TAB1-NR OF TAB2(K) - MOVE 'BLA' TO TAB-DATA OF TAB2(K) - END-PERFORM - - SORT ROW1 OF TAB2. - - PERFORM VARYING K FROM 1 BY 1 UNTIL K > 4 - DISPLAY TAB1-NR OF TAB2(K) NO ADVANCING END-DISPLAY - END-PERFORM - - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_misc.at:3055: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_misc.at:3055" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:3055" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_misc.at:3056: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_misc.at:3056" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo "0403020101020304" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:3056" -$at_failed && at_fn_log_failure -$at_traceon; } - - -{ set +x -$as_echo "$at_srcdir/run_misc.at:3058: \$COMPILE prog2.cob" -at_fn_check_prepare_dynamic "$COMPILE prog2.cob" "run_misc.at:3058" -( $at_check_trace; $COMPILE prog2.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:3058" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_misc.at:3059: \$COBCRUN_DIRECT ./prog2" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog2" "run_misc.at:3059" -( $at_check_trace; $COBCRUN_DIRECT ./prog2 -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo "0004030201" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:3059" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_610 -#AT_START_611 -at_fn_group_banner 611 'run_misc.at:3064' \ - "SORT: EBCDIC table sort" " " 4 -at_xfail=no -( - $as_echo "611. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - CONFIGURATION SECTION. - SPECIAL-NAMES. - ALPHABET ALPHA IS EBCDIC. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 Z PIC X(10) VALUE "d4b2e1a3c5". - 01 G. - 02 TBL OCCURS 10. - 03 X PIC X. - PROCEDURE DIVISION. - MOVE Z TO G. - SORT TBL ASCENDING KEY X SEQUENCE ALPHA. - IF G NOT = "abcde12345" - DISPLAY G - END-DISPLAY - END-IF. - MOVE Z TO G. - SORT TBL DESCENDING KEY X SEQUENCE ALPHA. - IF G NOT = "54321edcba" - DISPLAY G - END-DISPLAY - END-IF. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_misc.at:3096: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_misc.at:3096" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:3096" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_misc.at:3097: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_misc.at:3097" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:3097" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_611 -#AT_START_612 -at_fn_group_banner 612 'run_misc.at:3102' \ - "PIC ZZZ-, ZZZ+" " " 4 -at_xfail=no -( - $as_echo "612. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 X-ZZZN PIC ZZZ-. - 01 XZN-RED REDEFINES X-ZZZN PIC X(4). - 01 X-ZZZP PIC ZZZ+. - 01 XZP-RED REDEFINES X-ZZZP PIC X(4). - PROCEDURE DIVISION. - MOVE -1 TO X-ZZZN. - IF XZN-RED NOT = " 1-" - DISPLAY "(" X-ZZZN ")" - END-DISPLAY - END-IF. - MOVE 0 TO X-ZZZN. - IF XZN-RED NOT = " " - DISPLAY "(" X-ZZZN ")" - END-DISPLAY - END-IF. - MOVE +1 TO X-ZZZN. - IF XZN-RED NOT = " 1 " - DISPLAY "(" X-ZZZN ")" - END-DISPLAY - END-IF. - - MOVE -1 TO X-ZZZP. - IF XZP-RED NOT = " 1-" - DISPLAY "(" X-ZZZP ")" - END-DISPLAY - END-IF. - MOVE 0 TO X-ZZZP. - IF XZP-RED NOT = " " - DISPLAY "(" X-ZZZP ")" - END-DISPLAY - END-IF. - MOVE +1 TO X-ZZZP. - IF XZP-RED NOT = " 1+" - DISPLAY "(" X-ZZZP ")" - END-DISPLAY - END-IF. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_misc.at:3149: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_misc.at:3149" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:3149" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_misc.at:3150: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_misc.at:3150" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:3150" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_612 -#AT_START_613 -at_fn_group_banner 613 'run_misc.at:3155' \ - "PERFORM type OSVS" " " 4 -at_xfail=no -( - $as_echo "613. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 MYOCC PIC 9(8) COMP VALUE 0. - PROCEDURE DIVISION. - ASTART SECTION. - A01. - PERFORM BTEST. - IF MYOCC NOT = 2 - DISPLAY MYOCC - END-DISPLAY - END-IF. - STOP RUN. - BTEST SECTION. - B01. - PERFORM B02 VARYING MYOCC FROM 1 BY 1 - UNTIL MYOCC > 5. - GO TO B99. - B02. - IF MYOCC > 1 - GO TO B99 - END-IF. - B99. - EXIT. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_misc.at:3186: \$COMPILE -fperform-osvs prog.cob" -at_fn_check_prepare_dynamic "$COMPILE -fperform-osvs prog.cob" "run_misc.at:3186" -( $at_check_trace; $COMPILE -fperform-osvs prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:3186" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_misc.at:3187: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_misc.at:3187" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:3187" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_613 -#AT_START_614 -at_fn_group_banner 614 'run_misc.at:3192' \ - "Sticky LINKAGE" " " 4 -at_xfail=no -( - $as_echo "614. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >callee.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. callee. - DATA DIVISION. - LINKAGE SECTION. - 01 P1 PIC X. - 01 P2 PIC X(6). - 01 P3 PIC X(6). - PROCEDURE DIVISION USING P1 P2. - IF P1 = "A" - SET ADDRESS OF P3 TO ADDRESS OF P2 - ELSE - IF P3 NOT = "OKOKOK" - DISPLAY P3 - END-DISPLAY - END-IF - END-IF. - EXIT PROGRAM. -_ATEOF - - -cat >caller.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. caller. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 P1 PIC X VALUE "A". - 01 P2 PIC X(6) VALUE "NOT OK". - PROCEDURE DIVISION. - CALL "callee" USING P1 P2 - END-CALL. - MOVE "B" TO P1. - MOVE "OKOKOK" TO P2. - CALL "callee" USING P1 - END-CALL. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_misc.at:3232: \$COMPILE_MODULE -fsticky-linkage callee.cob" -at_fn_check_prepare_dynamic "$COMPILE_MODULE -fsticky-linkage callee.cob" "run_misc.at:3232" -( $at_check_trace; $COMPILE_MODULE -fsticky-linkage callee.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:3232" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_misc.at:3233: \$COMPILE -fsticky-linkage caller.cob" -at_fn_check_prepare_dynamic "$COMPILE -fsticky-linkage caller.cob" "run_misc.at:3233" -( $at_check_trace; $COMPILE -fsticky-linkage caller.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:3233" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_misc.at:3234: \$COBCRUN_DIRECT ./caller" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./caller" "run_misc.at:3234" -( $at_check_trace; $COBCRUN_DIRECT ./caller -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:3234" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_614 -#AT_START_615 -at_fn_group_banner 615 'run_misc.at:3239' \ - "COB_PRE_LOAD" " " 4 -at_xfail=no -( - $as_echo "615. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >callee.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. callee2. - PROCEDURE DIVISION. - EXIT PROGRAM. -_ATEOF - - -cat >caller.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. caller. - PROCEDURE DIVISION. - CALL "callee2" - END-CALL. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_misc.at:3258: \$COMPILE_MODULE callee.cob" -at_fn_check_prepare_dynamic "$COMPILE_MODULE callee.cob" "run_misc.at:3258" -( $at_check_trace; $COMPILE_MODULE callee.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:3258" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_misc.at:3259: \$COMPILE caller.cob" -at_fn_check_prepare_dynamic "$COMPILE caller.cob" "run_misc.at:3259" -( $at_check_trace; $COMPILE caller.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:3259" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_misc.at:3260: COB_PRE_LOAD=callee \$COBCRUN_DIRECT ./caller" -at_fn_check_prepare_dynamic "COB_PRE_LOAD=callee $COBCRUN_DIRECT ./caller" "run_misc.at:3260" -( $at_check_trace; COB_PRE_LOAD=callee $COBCRUN_DIRECT ./caller -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:3260" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_615 -#AT_START_616 -at_fn_group_banner 616 'run_misc.at:3265' \ - "COB_PRE_LOAD with entry points" " " 4 -at_xfail=no -( - $as_echo "616. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - - DATA DIVISION. - WORKING-STORAGE SECTION. - - 01 VAR1 PIC X(5) VALUE '12abc'. - 01 VAR2 PIC X(2) VALUE '11'. - - PROCEDURE DIVISION. - - ENTRY 'ent1'. - DISPLAY VAR1 END-DISPLAY - GOBACK. - - ENTRY 'ent2'. - DISPLAY VAR2 END-DISPLAY - GOBACK. -_ATEOF - - -cat >prog1.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog1. - - DATA DIVISION. - WORKING-STORAGE SECTION. - - 01 VAR2 PIC X(2) VALUE '55'. - 01 VAR3 PIC X(5) VALUE 'xxxxx'. - - PROCEDURE DIVISION. - - ENTRY 'ent2'. - DISPLAY VAR2 END-DISPLAY - GOBACK. - - ENTRY 'ent3'. - DISPLAY VAR3 END-DISPLAY - GOBACK. -_ATEOF - - -cat >main-prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. main-prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - PROCEDURE DIVISION. - - CALL 'ent1' END-CALL - CALL 'ent2' END-CALL - CALL 'ent3' END-CALL - - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_misc.at:3324: \$COMPILE_MODULE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_MODULE prog.cob" "run_misc.at:3324" -( $at_check_trace; $COMPILE_MODULE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:3324" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_misc.at:3325: \$COMPILE_MODULE prog1.cob" -at_fn_check_prepare_dynamic "$COMPILE_MODULE prog1.cob" "run_misc.at:3325" -( $at_check_trace; $COMPILE_MODULE prog1.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:3325" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_misc.at:3326: \$COMPILE main-prog.cob" -at_fn_check_prepare_dynamic "$COMPILE main-prog.cob" "run_misc.at:3326" -( $at_check_trace; $COMPILE main-prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:3326" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_misc.at:3327: COB_PRE_LOAD=\"prog\"\$PATHSEP\"prog1\" \$COBCRUN_DIRECT ./main-prog" -at_fn_check_prepare_dynamic "COB_PRE_LOAD=\"prog\"$PATHSEP\"prog1\" $COBCRUN_DIRECT ./main-prog" "run_misc.at:3327" -( $at_check_trace; COB_PRE_LOAD="prog"$PATHSEP"prog1" $COBCRUN_DIRECT ./main-prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo "12abc -11 -xxxxx -" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:3327" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_616 -#AT_START_617 -at_fn_group_banner 617 'run_misc.at:3336' \ - "Lookup ENTRY from main executable" " " 4 -at_xfail=no -( - $as_echo "617. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 PROGRAM-LINK USAGE PROGRAM-POINTER. - - PROCEDURE DIVISION. - SET PROGRAM-LINK TO ENTRY "subprogram" - IF PROGRAM-LINK EQUAL NULL THEN - DISPLAY "error: no subprogram linkage" UPON SYSERR - END-DISPLAY - ELSE - CALL PROGRAM-LINK - ON EXCEPTION - DISPLAY "hard error: unable to invoke subprogram" - UPON SYSERR - END-DISPLAY - END-CALL - DISPLAY RETURN-CODE WITH NO ADVANCING - END-DISPLAY - END-IF - GOBACK. - - ENTRY "subprogram". - DISPLAY "subprogram" WITH NO ADVANCING - END-DISPLAY - SET RETURN-CODE TO 42 - . -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_misc.at:3371: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_misc.at:3371" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:3371" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_misc.at:3372: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_misc.at:3372" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo "subprogram+000000042" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 42 $at_status "$at_srcdir/run_misc.at:3372" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_617 -#AT_START_618 -at_fn_group_banner 618 'run_misc.at:3377' \ - "COB_LOAD_CASE=UPPER test" " " 4 -at_xfail=no -( - $as_echo "618. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >CALLEE.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. callee. - PROCEDURE DIVISION. - EXIT PROGRAM. -_ATEOF - - -cat >caller.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. caller. - PROCEDURE DIVISION. - CALL "callee" - END-CALL. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_misc.at:3396: \$COMPILE_MODULE CALLEE.cob" -at_fn_check_prepare_dynamic "$COMPILE_MODULE CALLEE.cob" "run_misc.at:3396" -( $at_check_trace; $COMPILE_MODULE CALLEE.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:3396" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_misc.at:3397: \$COMPILE caller.cob" -at_fn_check_prepare_dynamic "$COMPILE caller.cob" "run_misc.at:3397" -( $at_check_trace; $COMPILE caller.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:3397" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_misc.at:3398: COB_LOAD_CASE=UPPER ./caller" -at_fn_check_prepare_trace "run_misc.at:3398" -( $at_check_trace; COB_LOAD_CASE=UPPER ./caller -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:3398" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_618 -#AT_START_619 -at_fn_group_banner 619 'run_misc.at:3403' \ - "ALLOCATE / FREE with BASED item (1)" " " 4 -at_xfail=no -( - $as_echo "619. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - LINKAGE SECTION. - 01 MYFLD PIC X(6) BASED VALUE "ABCDEF". - PROCEDURE DIVISION. - ASTART SECTION. - A01. - ALLOCATE MYFLD INITIALIZED. - IF MYFLD NOT = "ABCDEF" - DISPLAY MYFLD - END-DISPLAY - END-IF. - FREE ADDRESS OF MYFLD. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_misc.at:3424: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_misc.at:3424" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:3424" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_misc.at:3425: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_misc.at:3425" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:3425" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_619 -#AT_START_620 -at_fn_group_banner 620 'run_misc.at:3430' \ - "ALLOCATE / FREE with BASED item (2)" " " 4 -at_xfail=no -( - $as_echo "620. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 MYFLD BASED. - 03 MYFLDX PIC X. - 03 MYFLD9 PIC 9. - PROCEDURE DIVISION. - IF ADDRESS OF MYFLD NOT = NULL - DISPLAY "BASED ITEM WITH ADDRESS ON START" - END-DISPLAY - END-IF. - FREE MYFLD. - ALLOCATE MYFLD. - IF ADDRESS OF MYFLD = NULL - DISPLAY "BASED ITEM WITHOUT ADDRESS AFTER ALLOCATE" - END-DISPLAY - END-IF. - INITIALIZE MYFLD. - IF MYFLD NOT = " 0" - DISPLAY "BASED ITEM INITIALIZED WRONG: " - WITH NO ADVANCING - END-DISPLAY - DISPLAY MYFLD - END-DISPLAY - END-IF. - - FREE ADDRESS OF MYFLD. - IF ADDRESS OF MYFLD NOT = NULL - DISPLAY "BASED ITEM WITH ADDRESS AFTER FREE" - END-DISPLAY - END-IF. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_misc.at:3468: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_misc.at:3468" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:3468" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_misc.at:3469: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_misc.at:3469" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:3469" -$at_failed && at_fn_log_failure -$at_traceon; } - -# Run both executable and module as we have a different code generation here -{ set +x -$as_echo "$at_srcdir/run_misc.at:3471: \$COMPILE_MODULE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_MODULE prog.cob" "run_misc.at:3471" -( $at_check_trace; $COMPILE_MODULE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:3471" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_misc.at:3472: \$COBCRUN prog" -at_fn_check_prepare_dynamic "$COBCRUN prog" "run_misc.at:3472" -( $at_check_trace; $COBCRUN prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:3472" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_620 -#AT_START_621 -at_fn_group_banner 621 'run_misc.at:3477' \ - "ALLOCATE CHARACTERS INITIALIZED TO" " " 4 -at_xfail=no -( - $as_echo "621. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 MYPTR USAGE POINTER. - LINKAGE SECTION. - 01 MYFLD PIC X(4). - PROCEDURE DIVISION. - ASTART SECTION. - A01. - ALLOCATE 4 CHARACTERS - INITIALIZED TO "ABCD" - RETURNING MYPTR. - SET ADDRESS OF MYFLD TO MYPTR. - IF MYFLD NOT = "ABCD" - DISPLAY MYFLD - END-DISPLAY - END-IF. - FREE MYPTR. - ALLOCATE 4 CHARACTERS - INITIALIZED TO ALL "Z" - RETURNING MYPTR. - SET ADDRESS OF MYFLD TO MYPTR. - IF MYFLD NOT = "ZZZZ" - DISPLAY MYFLD - END-DISPLAY - END-IF. - FREE MYPTR. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_misc.at:3512: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_misc.at:3512" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:3512" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_misc.at:3513: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_misc.at:3513" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:3513" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_621 -#AT_START_622 -at_fn_group_banner 622 'run_misc.at:3518' \ - "Initialized value with defaultbyte" " " 4 -at_xfail=no -( - $as_echo "622. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 MYFLD PIC X(6). - PROCEDURE DIVISION. - ASTART SECTION. - A01. - IF MYFLD NOT = "AAAAAA" - DISPLAY MYFLD - END-DISPLAY - END-IF. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_misc.at:3537: \$COMPILE -fdefaultbyte=A prog.cob" -at_fn_check_prepare_dynamic "$COMPILE -fdefaultbyte=A prog.cob" "run_misc.at:3537" -( $at_check_trace; $COMPILE -fdefaultbyte=A prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:3537" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_misc.at:3538: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_misc.at:3538" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:3538" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_622 -#AT_START_623 -at_fn_group_banner 623 'run_misc.at:3543' \ - "CALL with OMITTED parameter" " " 4 -at_xfail=no -( - $as_echo "623. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >callee.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. callee. - DATA DIVISION. - LINKAGE SECTION. - 01 P1 PIC X. - 01 P2 PIC X(6). - PROCEDURE DIVISION USING P1 OPTIONAL P2. - IF P2 NOT OMITTED - DISPLAY P2 - END-DISPLAY - END-IF. - EXIT PROGRAM. -_ATEOF - - -cat >caller.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. caller. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 P1 PIC X VALUE "A". - PROCEDURE DIVISION. - CALL "callee" USING P1 - END-CALL. - CALL "callee" USING P1 OMITTED - END-CALL. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_misc.at:3575: \$COMPILE_MODULE callee.cob" -at_fn_check_prepare_dynamic "$COMPILE_MODULE callee.cob" "run_misc.at:3575" -( $at_check_trace; $COMPILE_MODULE callee.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:3575" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_misc.at:3576: \$COMPILE caller.cob" -at_fn_check_prepare_dynamic "$COMPILE caller.cob" "run_misc.at:3576" -( $at_check_trace; $COMPILE caller.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:3576" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_misc.at:3577: \$COBCRUN_DIRECT ./caller" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./caller" "run_misc.at:3577" -( $at_check_trace; $COBCRUN_DIRECT ./caller -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:3577" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_623 -#AT_START_624 -at_fn_group_banner 624 'run_misc.at:3582' \ - "CALL in from C, cob_call_params explicitly set" " " 4 -at_xfail=no -( - $as_echo "624. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >callee.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. callee. - DATA DIVISION. - LINKAGE SECTION. - 01 P1 PIC X. - 01 P2 PIC X(6). - PROCEDURE DIVISION USING P1 OPTIONAL P2. - IF P2 NOT OMITTED - DISPLAY 'UNEXPECTED P2: ' P2 - END-DISPLAY - END-IF - DISPLAY 'P1: ' P1 WITH NO ADVANCING - END-DISPLAY. - EXIT PROGRAM. -_ATEOF - - -cat >caller.c <<'_ATEOF' - -#include -#include - -int callee (char *, char *); - -#ifndef NULL -#define NULL (void*)0 -#endif - -int -main (int argc, char **argv) -{ - /* for storing COBOL return code */ - int cob_ret; - - /* initialize parameters */ - char *p1 = "A"; - - /* initialize the COBOL run-time library */ - cob_init(argc, argv); - - /* setup for COBOL parameter handling */ - cob_set_num_params (1); - - /* call COBOL program */ - cob_ret = callee (p1, NULL); - - /* Clean up and terminate - This does not return */ - cob_stop_run (cob_ret); -} -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_misc.at:3635: \$COMPILE -o caller caller.c callee.cob" -at_fn_check_prepare_dynamic "$COMPILE -o caller caller.c callee.cob" "run_misc.at:3635" -( $at_check_trace; $COMPILE -o caller caller.c callee.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:3635" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_misc.at:3636: \$COBCRUN_DIRECT ./caller" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./caller" "run_misc.at:3636" -( $at_check_trace; $COBCRUN_DIRECT ./caller -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo "P1: A" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:3636" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_624 -#AT_START_625 -at_fn_group_banner 625 'run_misc.at:3641' \ - "CALL in from C, cob_call_params unknown" " " 4 -at_xfail=no -( - $as_echo "625. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >callee.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. callee. - DATA DIVISION. - LINKAGE SECTION. - 01 P1 PIC X. - 01 P2 PIC X(6). - PROCEDURE DIVISION USING P1 P2. - IF P1 NOT EQUAL "A" - DISPLAY P1 - END-DISPLAY - END-IF. - IF P2 NOT EQUAL "FROM C" - DISPLAY P2 - END-DISPLAY - ELSE - DISPLAY "OK" WITH NO ADVANCING - END-DISPLAY - END-IF. - EXIT PROGRAM. -_ATEOF - - -cat >caller.c <<'_ATEOF' - -#include -#include - -int callee (char *, char *); - -int -main (int argc, char **argv) -{ - /* for storing COBOL return code */ - int cob_ret; - - /* initialize parameters */ - char *p1 = "A"; - char *p2 = "FROM C"; - - /* initialize the COBOL run-time library */ - cob_init (argc, argv); - - /* call COBOL program */ - cob_ret = callee (p1, p2); - - /* Clean up and terminate - This does not return */ - cob_stop_run (cob_ret); -} -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_misc.at:3693: \$COMPILE -o caller caller.c callee.cob" -at_fn_check_prepare_dynamic "$COMPILE -o caller caller.c callee.cob" "run_misc.at:3693" -( $at_check_trace; $COMPILE -o caller caller.c callee.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:3693" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_misc.at:3694: \$COBCRUN_DIRECT ./caller" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./caller" "run_misc.at:3694" -( $at_check_trace; $COBCRUN_DIRECT ./caller -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo "OK" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:3694" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_625 -#AT_START_626 -at_fn_group_banner 626 'run_misc.at:3699' \ - "CALL C with callback, PROCEDURE DIVISION EXTERN" "" 4 -at_xfail=no -( - $as_echo "626. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 CB USAGE PROGRAM-POINTER. - PROCEDURE DIVISION. - SET CB TO ENTRY "callback" - CALL STATIC "cprog" USING BY VALUE CB - END-CALL - EXIT PROGRAM. - END PROGRAM prog. - - IDENTIFICATION DIVISION. - PROGRAM-ID. callback. - ENVIRONMENT DIVISION. - CONFIGURATION SECTION. - SPECIAL-NAMES. - CALL-CONVENTION 0 IS EXTERN. - DATA DIVISION. - LINKAGE SECTION. - 01 P1 USAGE POINTER. - 01 P2 USAGE BINARY-LONG. - 01 P3 PIC X(8). - PROCEDURE DIVISION EXTERN USING - BY VALUE P1 P2 BY REFERENCE P3. - IF P1 NOT EQUAL ADDRESS OF P3 - DISPLAY P1 - END-DISPLAY - END-IF - IF P2 NOT EQUAL 42 - DISPLAY P2 - END-DISPLAY - END-IF - IF P3 NOT EQUAL "CALLBACK" - DISPLAY P3 - END-DISPLAY - END-IF - EXIT PROGRAM. -_ATEOF - - -cat >cprog.c <<'_ATEOF' - -#include -#include - -COB_EXT_EXPORT int -cprog (void *cb) -{ - char *p1; - int p2 = 42; - char *p3 = "CALLBACK"; - - p1 = p3; - cob_set_num_params (3); - ((int (*)(char *, int, char *))cb)(p1, p2, p3); - return 0; -} -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_misc.at:3761: \$COMPILE -Wno-unfinished -o prog prog.cob cprog.c" -at_fn_check_prepare_dynamic "$COMPILE -Wno-unfinished -o prog prog.cob cprog.c" "run_misc.at:3761" -( $at_check_trace; $COMPILE -Wno-unfinished -o prog prog.cob cprog.c -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:3761" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_misc.at:3762: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_misc.at:3762" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:3762" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_626 -#AT_START_627 -at_fn_group_banner 627 'run_misc.at:3767' \ - "CALL C with callback, ENTRY-CONVENTION EXTERN" " " 4 -at_xfail=no -( - $as_echo "627. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - OPTIONS. - ENTRY-CONVENTION COBOL. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 CB USAGE PROGRAM-POINTER. - PROCEDURE DIVISION. - SET CB TO ENTRY "callback" - CALL STATIC "cprog" USING BY VALUE CB - END-CALL - EXIT PROGRAM. - END PROGRAM prog. - - IDENTIFICATION DIVISION. - PROGRAM-ID. callback. - OPTIONS. - ENTRY-CONVENTION EXTERN. - DATA DIVISION. - LINKAGE SECTION. - 01 P1 USAGE POINTER. - 01 P2 USAGE BINARY-LONG. - 01 P3 PIC X(8). - PROCEDURE DIVISION USING - BY VALUE P1 P2 BY REFERENCE P3. - IF P1 NOT EQUAL ADDRESS OF P3 - DISPLAY P1 - END-DISPLAY - END-IF - IF P2 NOT EQUAL 42 - DISPLAY P2 - END-DISPLAY - END-IF - IF P3 NOT EQUAL "CALLBACK" - DISPLAY P3 - END-DISPLAY - END-IF - EXIT PROGRAM. -_ATEOF - - -cat >cprog.c <<'_ATEOF' - -#include -#include - -COB_EXT_EXPORT int -cprog (void *cb) -{ - char *p1; - int p2 = 42; - char *p3 = "CALLBACK"; - - p1 = p3; - cob_set_num_params (3); - ((int (*)(char *, int, char *))cb)(p1, p2, p3); - return 0; -} -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_misc.at:3829: \$COMPILE -Wno-unfinished -o prog prog.cob cprog.c" -at_fn_check_prepare_dynamic "$COMPILE -Wno-unfinished -o prog prog.cob cprog.c" "run_misc.at:3829" -( $at_check_trace; $COMPILE -Wno-unfinished -o prog prog.cob cprog.c -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:3829" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_misc.at:3830: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_misc.at:3830" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:3830" -$at_failed && at_fn_log_failure -$at_traceon; } - - -cat >prog2.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 CB USAGE PROGRAM-POINTER. - PROCEDURE DIVISION. - SET CB TO ENTRY "callback" - CALL STATIC "cprog" USING BY VALUE CB - END-CALL - EXIT PROGRAM. - END PROGRAM prog. - - IDENTIFICATION DIVISION. - PROGRAM-ID. callback. - DATA DIVISION. - LINKAGE SECTION. - 01 P1 USAGE POINTER. - 01 P2 USAGE BINARY-LONG. - 01 P3 PIC X(8). - PROCEDURE DIVISION WITH C LINKAGE - USING BY VALUE P1 P2 BY REFERENCE P3. - IF P1 NOT EQUAL ADDRESS OF P3 - DISPLAY P1 - END-DISPLAY - END-IF - IF P2 NOT EQUAL 42 - DISPLAY P2 - END-DISPLAY - END-IF - IF P3 NOT EQUAL "CALLBACK" - DISPLAY P3 - END-DISPLAY - END-IF - EXIT PROGRAM. -_ATEOF - - -cat >prog3.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 CB USAGE PROGRAM-POINTER. - PROCEDURE DIVISION. - SET CB TO ENTRY "callback" - CALL STATIC "cprog" USING BY VALUE CB - END-CALL - EXIT PROGRAM. - END PROGRAM prog. - - IDENTIFICATION DIVISION. - PROGRAM-ID. callback. - ENVIRONMENT DIVISION. - CONFIGURATION SECTION. - SPECIAL-NAMES. - CALL-CONVENTION 0 IS EXTERN. - DATA DIVISION. - LINKAGE SECTION. - 01 P1 USAGE POINTER. - 01 P2 USAGE BINARY-LONG. - 01 P3 PIC X(8). - PROCEDURE DIVISION EXTERN - USING BY VALUE P1 P2 BY REFERENCE P3. - IF P1 NOT EQUAL ADDRESS OF P3 - DISPLAY P1 - END-DISPLAY - END-IF - IF P2 NOT EQUAL 42 - DISPLAY P2 - END-DISPLAY - END-IF - IF P3 NOT EQUAL "CALLBACK" - DISPLAY P3 - END-DISPLAY - END-IF - EXIT PROGRAM. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_misc.at:3910: \$COMPILE -Wno-unfinished -o prog prog2.cob cprog.c" -at_fn_check_prepare_dynamic "$COMPILE -Wno-unfinished -o prog prog2.cob cprog.c" "run_misc.at:3910" -( $at_check_trace; $COMPILE -Wno-unfinished -o prog prog2.cob cprog.c -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:3910" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_misc.at:3911: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_misc.at:3911" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:3911" -$at_failed && at_fn_log_failure -$at_traceon; } - - -{ set +x -$as_echo "$at_srcdir/run_misc.at:3913: \$COMPILE -Wno-unfinished -o prog prog3.cob cprog.c" -at_fn_check_prepare_dynamic "$COMPILE -Wno-unfinished -o prog prog3.cob cprog.c" "run_misc.at:3913" -( $at_check_trace; $COMPILE -Wno-unfinished -o prog prog3.cob cprog.c -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:3913" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_misc.at:3914: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_misc.at:3914" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:3914" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_627 -#AT_START_628 -at_fn_group_banner 628 'run_misc.at:3919' \ - "CALL in from C with init missing / implicit" " " 4 -at_xfail=no -( - $as_echo "628. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >callee.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. callee. - DATA DIVISION. - LINKAGE SECTION. - 01 P1 PIC X. - 01 P2 PIC X(6). - PROCEDURE DIVISION USING P1 P2. - IF P1 NOT EQUAL "A" - DISPLAY P1 - END-DISPLAY - END-IF. - IF P2 NOT EQUAL "FROM C" - DISPLAY P2 - END-DISPLAY - ELSE - DISPLAY "OK" WITH NO ADVANCING - END-DISPLAY - END-IF. - STOP RUN. -_ATEOF - - -cat >caller.c <<'_ATEOF' - -int callee (char *, char *); - -int -main (int argc, char **argv) -{ - /* initialize parameters */ - char *p1 = "A"; - char *p2 = "FROM C"; - - /* call COBOL program (initialization missing) - note: COBOL program terminates the program by STOP RUN */ - (void)callee (p1, p2); - return 0; -} -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_misc.at:3961: \$COMPILE -o caller caller.c callee.cob" -at_fn_check_prepare_dynamic "$COMPILE -o caller caller.c callee.cob" "run_misc.at:3961" -( $at_check_trace; $COMPILE -o caller caller.c callee.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:3961" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_misc.at:3962: \$COBCRUN_DIRECT ./caller" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./caller" "run_misc.at:3962" -( $at_check_trace; $COBCRUN_DIRECT ./caller -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "libcob: error: cob_init() has not been called -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/run_misc.at:3962" -$at_failed && at_fn_log_failure -$at_traceon; } - - -{ set +x -$as_echo "$at_srcdir/run_misc.at:3966: \$COMPILE -fimplicit-init -o caller caller.c callee.cob" -at_fn_check_prepare_dynamic "$COMPILE -fimplicit-init -o caller caller.c callee.cob" "run_misc.at:3966" -( $at_check_trace; $COMPILE -fimplicit-init -o caller caller.c callee.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:3966" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_misc.at:3967: \$COBCRUN_DIRECT ./caller" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./caller" "run_misc.at:3967" -( $at_check_trace; $COBCRUN_DIRECT ./caller -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo "OK" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:3967" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_628 -#AT_START_629 -at_fn_group_banner 629 'run_misc.at:3972' \ - "CALL STATIC C from COBOL" " " 4 -at_xfail=no -( - $as_echo "629. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >caller.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. caller. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 P1 PIC X VALUE "A". - 01 P2 PIC X(7). - 77 P2-COB PIC X(7). - PROCEDURE DIVISION. - CALL STATIC 'callee' USING P1 P2 - IF P1 NOT EQUAL "B" - DISPLAY 'NOT A: ' P1 - END-DISPLAY - END-IF - UNSTRING P2 DELIMITED BY LOW-VALUE - INTO P2-COB - END-UNSTRING - EVALUATE TRUE - WHEN P2-COB NOT EQUAL "FROM C" - DISPLAY P2-COB '-' P2 - END-DISPLAY - WHEN RETURN-CODE NOT = 3 - DISPLAY RETURN-CODE - END-DISPLAY - WHEN OTHER - DISPLAY 'OK' WITH NO ADVANCING - END-DISPLAY - MOVE 0 TO RETURN-CODE - END-EVALUATE - EXIT PROGRAM. -_ATEOF - - -cat >callee.c <<'_ATEOF' - -#include - -int -callee (char *p1, char *p2) -{ - if (p1[0] == 'A') { - p1[0] = 'B'; - } - memcpy (p2, "FROM C", 6); - - return 3; -} -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_misc.at:4022: \$COMPILE -o caller caller.cob callee.c" -at_fn_check_prepare_dynamic "$COMPILE -o caller caller.cob callee.c" "run_misc.at:4022" -( $at_check_trace; $COMPILE -o caller caller.cob callee.c -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:4022" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_misc.at:4023: \$COBCRUN_DIRECT ./caller" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./caller" "run_misc.at:4023" -( $at_check_trace; $COBCRUN_DIRECT ./caller -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo "OK" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:4023" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_629 -#AT_START_630 -at_fn_group_banner 630 'run_misc.at:4028' \ - "ANY LENGTH (1)" " " 4 -at_xfail=no -( - $as_echo "630. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >callee.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. callee. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 P2 PIC 99. - LINKAGE SECTION. - 01 P1 PIC X ANY LENGTH. - PROCEDURE DIVISION USING P1. - MOVE LENGTH OF P1 TO P2. - IF P2 NOT = 6 - DISPLAY P2 - END-DISPLAY - END-IF. - IF P1 NOT = "OKOKOK" - DISPLAY P1 - END-DISPLAY - END-IF. - EXIT PROGRAM. -_ATEOF - - -cat >caller.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. caller. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 P1 PIC X(6) VALUE "OKOKOK". - PROCEDURE DIVISION. - CALL "callee" USING P1 - END-CALL. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_misc.at:4064: \$COMPILE_MODULE callee.cob" -at_fn_check_prepare_dynamic "$COMPILE_MODULE callee.cob" "run_misc.at:4064" -( $at_check_trace; $COMPILE_MODULE callee.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:4064" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_misc.at:4065: \$COMPILE caller.cob" -at_fn_check_prepare_dynamic "$COMPILE caller.cob" "run_misc.at:4065" -( $at_check_trace; $COMPILE caller.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:4065" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_misc.at:4066: \$COBCRUN_DIRECT ./caller" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./caller" "run_misc.at:4066" -( $at_check_trace; $COBCRUN_DIRECT ./caller -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:4066" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_630 -#AT_START_631 -at_fn_group_banner 631 'run_misc.at:4071' \ - "ANY LENGTH (2)" " " 4 -at_xfail=no -( - $as_echo "631. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >callee.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. callee. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 P2 PIC XXX. - LINKAGE SECTION. - 01 P1 PIC X ANY LENGTH. - PROCEDURE DIVISION USING P1. - MOVE P1 TO P2. - IF P2 NOT = "OK " - DISPLAY P2 - END-DISPLAY - END-IF. - MOVE SPACE TO P1. - EXIT PROGRAM. -_ATEOF - - -cat >caller.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. caller. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 P1 PIC X(2) VALUE "OK". - PROCEDURE DIVISION. - CALL "callee" USING P1 - END-CALL. - IF P1 NOT = SPACE - DISPLAY P1 - END-DISPLAY - END-IF. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_misc.at:4108: \$COMPILE_MODULE callee.cob" -at_fn_check_prepare_dynamic "$COMPILE_MODULE callee.cob" "run_misc.at:4108" -( $at_check_trace; $COMPILE_MODULE callee.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:4108" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_misc.at:4109: \$COMPILE caller.cob" -at_fn_check_prepare_dynamic "$COMPILE caller.cob" "run_misc.at:4109" -( $at_check_trace; $COMPILE caller.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:4109" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_misc.at:4110: \$COBCRUN_DIRECT ./caller" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./caller" "run_misc.at:4110" -( $at_check_trace; $COBCRUN_DIRECT ./caller -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:4110" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_631 -#AT_START_632 -at_fn_group_banner 632 'run_misc.at:4115' \ - "ANY LENGTH (3)" " " 4 -at_xfail=no -( - $as_echo "632. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 str PIC X(20) VALUE ALL "X". - - PROCEDURE DIVISION. - CALL "subprog" USING str - . - END PROGRAM prog. - - IDENTIFICATION DIVISION. - PROGRAM-ID. subprog. - - DATA DIVISION. - LINKAGE SECTION. - 01 str PIC X ANY LENGTH. - - PROCEDURE DIVISION USING str. - MOVE "abcd" TO str - DISPLAY FUNCTION TRIM (str) - MOVE "abcd" TO str (5:) - DISPLAY FUNCTION TRIM (str) - MOVE ALL "a" TO str - DISPLAY FUNCTION TRIM (str) - . - END PROGRAM subprog. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_misc.at:4149: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_misc.at:4149" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:4149" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_misc.at:4150: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_misc.at:4150" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo "abcd -abcdabcd -aaaaaaaaaaaaaaaaaaaa -" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:4150" -$at_failed && at_fn_log_failure -$at_traceon; } - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_632 -#AT_START_633 -at_fn_group_banner 633 'run_misc.at:4158' \ - "ANY LENGTH (4)" " " 4 -at_xfail=no -( - $as_echo "633. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -# comparision of any length was done only for first character - see bug 511 - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 str PIC X(20) VALUE ALL "X". - - PROCEDURE DIVISION. - CALL "subprog" USING str - move ' 45' to str - CALL "subprog" USING str - . - END PROGRAM prog. - - IDENTIFICATION DIVISION. - PROGRAM-ID. subprog. - - DATA DIVISION. - LINKAGE SECTION. - 01 str PIC X ANY LENGTH. - - PROCEDURE DIVISION USING str. - IF str = 'X' - DISPLAY 'X is X' - END-IF - IF str = space - DISPLAY 'X is space' - END-IF - . - END PROGRAM subprog. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_misc.at:4196: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_misc.at:4196" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:4196" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_misc.at:4197: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_misc.at:4197" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:4197" -$at_failed && at_fn_log_failure -$at_traceon; } - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_633 -#AT_START_634 -at_fn_group_banner 634 'run_misc.at:4201' \ - "ANY LENGTH (5)" " " 4 -at_xfail=no -( - $as_echo "634. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -# any length variables resulted in SIGSEGV when module was first program called - -cat >subprog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. subprog. - - DATA DIVISION. - LINKAGE SECTION. - 01 str1 PIC X ANY LENGTH. - 01 str2 PIC X ANY LENGTH. - - PROCEDURE DIVISION USING str1 str2. - DISPLAY 'IN' WITH NO ADVANCING - . - END PROGRAM subprog. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_misc.at:4221: \$COMPILE_MODULE subprog.cob" -at_fn_check_prepare_dynamic "$COMPILE_MODULE subprog.cob" "run_misc.at:4221" -( $at_check_trace; $COMPILE_MODULE subprog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:4221" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_misc.at:4222: \$COBCRUN subprog some test stuff" -at_fn_check_prepare_dynamic "$COBCRUN subprog some test stuff" "run_misc.at:4222" -( $at_check_trace; $COBCRUN subprog some test stuff -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo "IN" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:4222" -$at_failed && at_fn_log_failure -$at_traceon; } - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_634 -#AT_START_635 -at_fn_group_banner 635 'run_misc.at:4226' \ - "access to BASED item without allocation" " " 4 -at_xfail=no -( - $as_echo "635. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 X PIC X(4) BASED. - PROCEDURE DIVISION. - DISPLAY X NO ADVANCING - END-DISPLAY. - STOP RUN. -_ATEOF - - -cat >prog2.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog2. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 X BASED. - 05 Y PIC X(4). - PROCEDURE DIVISION. - DISPLAY Y NO ADVANCING - END-DISPLAY. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_misc.at:4254: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_misc.at:4254" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:4254" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_misc.at:4255: \$COMPILE prog2.cob" -at_fn_check_prepare_dynamic "$COMPILE prog2.cob" "run_misc.at:4255" -( $at_check_trace; $COMPILE prog2.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:4255" -$at_failed && at_fn_log_failure -$at_traceon; } - - -{ set +x -$as_echo "$at_srcdir/run_misc.at:4257: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_misc.at:4257" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "libcob: prog.cob:8: error: BASED/LINKAGE item 'X' has NULL address -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/run_misc.at:4257" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_misc.at:4260: \$COBCRUN_DIRECT ./prog2" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog2" "run_misc.at:4260" -( $at_check_trace; $COBCRUN_DIRECT ./prog2 -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "libcob: prog2.cob:9: error: BASED/LINKAGE item 'X' (accessed by 'Y') has NULL address -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/run_misc.at:4260" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_635 -#AT_START_636 -at_fn_group_banner 636 'run_misc.at:4267' \ - "access to OPTIONAL LINKAGE item not passed" " " 4 -at_xfail=no -( - $as_echo "636. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >caller.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. caller. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 X PIC X(4) VALUE '9876'. - PROCEDURE DIVISION. - CALL 'callee' USING X - END-CALL - CALL 'callee' USING OMITTED - END-CALL - STOP RUN. -_ATEOF - - -cat >callee.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. callee. - DATA DIVISION. - LINKAGE SECTION. - 01 X. - 05 Y PIC X(4). - PROCEDURE DIVISION USING OPTIONAL X. - IF Y NOT = '9876' - DISPLAY Y NO ADVANCING - END-DISPLAY - END-IF. - GOBACK. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_misc.at:4299: \$COMPILE caller.cob" -at_fn_check_prepare_dynamic "$COMPILE caller.cob" "run_misc.at:4299" -( $at_check_trace; $COMPILE caller.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:4299" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_misc.at:4300: \$COMPILE_MODULE callee.cob" -at_fn_check_prepare_dynamic "$COMPILE_MODULE callee.cob" "run_misc.at:4300" -( $at_check_trace; $COMPILE_MODULE callee.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:4300" -$at_failed && at_fn_log_failure -$at_traceon; } - - -{ set +x -$as_echo "$at_srcdir/run_misc.at:4302: \$COBCRUN_DIRECT ./caller" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./caller" "run_misc.at:4302" -( $at_check_trace; $COBCRUN_DIRECT ./caller -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "libcob: callee.cob:9: error: LINKAGE item 'X' (accessed by 'Y') not passed by caller -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/run_misc.at:4302" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_636 -#AT_START_637 -at_fn_group_banner 637 'run_misc.at:4309' \ - "STOP RUN WITH NORMAL STATUS" " " 4 -at_xfail=no -( - $as_echo "637. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - PROCEDURE DIVISION. - STOP RUN WITH NORMAL STATUS. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_misc.at:4321: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_misc.at:4321" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:4321" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_misc.at:4322: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_misc.at:4322" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:4322" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_637 -#AT_START_638 -at_fn_group_banner 638 'run_misc.at:4327' \ - "STOP RUN WITH ERROR STATUS" " " 4 -at_xfail=no -( - $as_echo "638. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - PROCEDURE DIVISION. - STOP RUN WITH ERROR STATUS. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_misc.at:4339: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_misc.at:4339" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:4339" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_misc.at:4340: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_misc.at:4340" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/run_misc.at:4340" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_638 -#AT_START_639 -at_fn_group_banner 639 'run_misc.at:4345' \ - "SYMBOLIC clause" " " 4 -at_xfail=no -( - $as_echo "639. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - CONFIGURATION SECTION. - SPECIAL-NAMES. - ALPHABET A-EBC IS EBCDIC - ALPHABET A-ASC IS ASCII - SYMBOLIC Z-EBC IS 241 IN A-EBC - SYMBOLIC Z-ASC IS 49 IN A-ASC - . - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 Z PIC X. - PROCEDURE DIVISION. - MOVE Z-ASC TO Z. - IF Z NOT = "0" - DISPLAY Z - END-DISPLAY - END-IF. - MOVE Z-EBC TO Z. - IF Z NOT = "0" - DISPLAY Z - END-DISPLAY - END-IF. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_misc.at:4376: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_misc.at:4376" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:4376" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_misc.at:4377: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_misc.at:4377" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:4377" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_639 -#AT_START_640 -at_fn_group_banner 640 'run_misc.at:4382' \ - "OCCURS clause with 1 entry" " " 4 -at_xfail=no -( - $as_echo "640. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 D1. - 03 FILLER OCCURS 1. - 05 D1-ENTRY PIC X(03) value '123'. - 01 D2. - 03 D2-ENTRY PIC X(03) value 'ABC' OCCURS 1. - 01 D1TOR. - 03 FILLER PIC X(03) value '456'. - 01 D1-R REDEFINES D1TOR. - 03 FILLER OCCURS 1. - 05 D1-R-ENTRY PIC X(03). - 01 D2TOR. - 03 FILLER PIC X(03) value 'DEF'. - 01 D2-R REDEFINES D2TOR. - 03 D2-R-ENTRY PIC X(03) OCCURS 1. - - PROCEDURE DIVISION. - IF D1-ENTRY (1) NOT = "123" - DISPLAY D1-ENTRY (1) - END-DISPLAY - END-IF. - IF D2-ENTRY (1) NOT = "ABC" - DISPLAY D2-ENTRY (1) - END-DISPLAY - END-IF. - IF D1-R-ENTRY (1) NOT = "456" - DISPLAY D1-R-ENTRY (1) - END-DISPLAY - END-IF. - IF D2-R-ENTRY (1) NOT = "DEF" - DISPLAY D2-R-ENTRY (1) - END-DISPLAY - END-IF. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_misc.at:4425: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_misc.at:4425" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:4425" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_misc.at:4426: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_misc.at:4426" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:4426" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_640 -#AT_START_641 -at_fn_group_banner 641 'run_misc.at:4431' \ - "Computing of different USAGEs w/o decimal point" "" 4 -at_xfail=no -( - $as_echo "641. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. 'prog'. - ENVIRONMENT DIVISION. - DATA DIVISION. - WORKING-STORAGE SECTION. - - * - 77 BCL-A BINARY-C-LONG VALUE 1. - 77 BCL-B BINARY-C-LONG VALUE 10. - 77 BCL-RES BINARY-C-LONG. - * - 77 BC-A BINARY-CHAR VALUE 1. - 77 BC-B BINARY-CHAR VALUE 10. - 77 BC-RES BINARY-CHAR. - * - 77 BD-A BINARY-DOUBLE VALUE 1. - 77 BD-B BINARY-DOUBLE VALUE 10. - 77 BD-RES BINARY-DOUBLE. - * - 77 BL-A BINARY-LONG VALUE 1. - 77 BL-B BINARY-LONG VALUE 10. - 77 BL-RES BINARY-LONG. - * - 77 C-A PIC S99 COMP VALUE 1. - 77 C-B PIC S99 COMP VALUE 10. - 77 C-RES PIC S99 COMP. - * - 77 C1-A COMP-1 VALUE 1. - 77 C1-B COMP-1 VALUE 10. - 77 C1-RES COMP-1. - * - 77 C2-A COMP-2 VALUE 1. - 77 C2-B COMP-2 VALUE 10. - 77 C2-RES COMP-2. - * - 77 C3-A PIC S99 COMP-3 VALUE 1. - 77 C3-B PIC S99 COMP-3 VALUE 10. - 77 C3-RES PIC S99 COMP-3. - * - 77 C5-A PIC S99 COMP-5 VALUE 1. - 77 C5-B PIC S99 COMP-5 VALUE 10. - 77 C5-RES PIC S99 COMP-5. - * - 77 C6-A PIC 99 COMP-6 VALUE 1. - 77 C6-B PIC 99 COMP-6 VALUE 10. - 77 C6-RES PIC 99 COMP-6. - * - 77 CN9-A PIC 99 COMP-N VALUE 1. - 77 CN9-B PIC 99 COMP-N VALUE 10. - 77 CN9-RES PIC 99 COMP-N. - * - 77 CNX-A PIC X COMP-N VALUE 1. - 77 CNX-B PIC X COMP-N VALUE 10. - 77 CNX-RES PIC X COMP-N. - * - 77 CX9-A PIC 99 COMP-X VALUE 1. - 77 CX9-B PIC 99 COMP-X VALUE 10. - 77 CX9-RES PIC 99 COMP-X. - * - 77 CXX-A PIC X COMP-X VALUE 1. - 77 CXX-B PIC X COMP-X VALUE 10. - 77 CXX-RES PIC X COMP-X. - * - 77 D-A PIC S99 VALUE 1. - 77 D-B PIC S99 VALUE 10. - 77 D-RES PIC S99. - * - 77 FD16-A FLOAT-DECIMAL-16 VALUE 1. - 77 FD16-B FLOAT-DECIMAL-16 VALUE 10. - 77 FD16-RES FLOAT-DECIMAL-16. - * - 77 FD34-A FLOAT-DECIMAL-34 VALUE 1. - 77 FD34-B FLOAT-DECIMAL-34 VALUE 10. - 77 FD34-RES FLOAT-DECIMAL-34. - * - 77 FL-A FLOAT-LONG VALUE 1. - 77 FL-B FLOAT-LONG VALUE 10. - 77 FL-RES FLOAT-LONG. - * - 77 FS-A FLOAT-SHORT VALUE 1. - 77 FS-B FLOAT-SHORT VALUE 10. - 77 FS-RES FLOAT-SHORT. - * - PROCEDURE DIVISION. - * - ADD BCL-B TO BCL-A END-ADD. - MOVE BCL-A TO BCL-RES. - IF BCL-RES NOT = 11 - DISPLAY 'ERROR BINARY-C-LONG + BINARY-C-LONG' - END-DISPLAY - END-IF. - MOVE 1 TO BCL-A. - ADD 10 TO BCL-A END-ADD. - MOVE BCL-A TO BCL-RES. - IF BCL-RES NOT = 11 - DISPLAY 'ERROR BINARY-C-LONG + NUM' - END-DISPLAY - END-IF. - MOVE 11 TO BCL-A. - SUBTRACT BCL-B FROM BCL-A END-SUBTRACT. - MOVE BCL-A TO BCL-RES. - IF BCL-RES NOT = 1 - DISPLAY 'ERROR BINARY-C-LONG - BINARY-C-LONG' - END-DISPLAY - END-IF. - MOVE 11 TO BCL-A. - SUBTRACT 10 FROM BCL-A END-SUBTRACT. - MOVE BCL-A TO BCL-RES. - IF BCL-RES NOT = 1 - DISPLAY 'ERROR BINARY-C-LONG - NUM' - END-DISPLAY - END-IF. - * - ADD BC-B TO BC-A END-ADD. - MOVE BC-A TO BC-RES. - IF BC-RES NOT = 11 - DISPLAY 'ERROR BINARY-CHAR + BINARY-CHAR' - END-DISPLAY - END-IF. - MOVE 1 TO BC-A. - ADD 10 TO BC-A END-ADD. - MOVE BC-A TO BC-RES. - IF BC-RES NOT = 11 - DISPLAY 'ERROR BINARY-CHAR + NUM' - END-DISPLAY - END-IF. - MOVE 11 TO BC-A. - SUBTRACT BC-B FROM BC-A END-SUBTRACT. - MOVE BC-A TO BC-RES. - IF BC-RES NOT = 1 - DISPLAY 'ERROR BINARY-CHAR - BINARY-CHAR' - END-DISPLAY - END-IF. - MOVE 11 TO BC-A. - SUBTRACT 10 FROM BC-A END-SUBTRACT. - MOVE BC-A TO BC-RES. - IF BC-RES NOT = 1 - DISPLAY 'ERROR BINARY-CHAR - NUM' - END-DISPLAY - END-IF. - * - ADD BD-B TO BD-A END-ADD. - MOVE BD-A TO BD-RES. - IF BD-RES NOT = 11 - DISPLAY 'ERROR BINARY-DOUBLE + BINARY-DOUBLE' - END-DISPLAY - END-IF. - MOVE 1 TO BD-A. - ADD 10 TO BD-A END-ADD. - MOVE BD-A TO BD-RES. - IF BD-RES NOT = 11 - DISPLAY 'ERROR BINARY-DOUBLE + NUM' - END-DISPLAY - END-IF. - MOVE 11 TO BD-A. - SUBTRACT BD-B FROM BD-A END-SUBTRACT. - MOVE BD-A TO BD-RES. - IF BD-RES NOT = 1 - DISPLAY 'ERROR BINARY-DOUBLE - BINARY-DOUBLE' - END-DISPLAY - END-IF. - MOVE 11 TO BD-A. - SUBTRACT 10 FROM BD-A END-SUBTRACT. - MOVE BD-A TO BD-RES. - IF BD-RES NOT = 1 - DISPLAY 'ERROR BINARY-DOUBLE - NUM' - END-DISPLAY - END-IF. - * - ADD BL-B TO BL-A END-ADD. - MOVE BL-A TO BL-RES. - IF BL-RES NOT = 11 - DISPLAY 'ERROR BINARY-LONG + BINARY-LONG' - END-DISPLAY - END-IF. - MOVE 1 TO BL-A. - ADD 10 TO BL-A END-ADD. - MOVE BL-A TO BL-RES. - IF BL-RES NOT = 11 - DISPLAY 'ERROR BINARY-LONG + NUM' - END-DISPLAY - END-IF. - MOVE 11 TO BL-A. - SUBTRACT BL-B FROM BL-A END-SUBTRACT. - MOVE BL-A TO BL-RES. - IF BL-RES NOT = 1 - DISPLAY 'ERROR BINARY-LONG - BINARY-LONG' - END-DISPLAY - END-IF. - MOVE 11 TO BL-A. - SUBTRACT 10 FROM BL-A END-SUBTRACT. - MOVE BL-A TO BL-RES. - IF BL-RES NOT = 1 - DISPLAY 'ERROR BINARY-LONG - NUM' - END-DISPLAY - END-IF. - * - ADD C-B TO C-A END-ADD. - MOVE C-A TO C-RES. - IF C-RES NOT = 11 - DISPLAY 'ERROR COMP + COMP' - END-DISPLAY - END-IF. - MOVE 1 TO C-A. - ADD 10 TO C-A END-ADD. - MOVE C-A TO C-RES. - IF C-RES NOT = 11 - DISPLAY 'ERROR COMP + NUM' - END-DISPLAY - END-IF. - MOVE 11 TO C-A. - SUBTRACT C-B FROM C-A END-SUBTRACT. - MOVE C-A TO C-RES. - IF C-RES NOT = 1 - DISPLAY 'ERROR COMP - COMP' - END-DISPLAY - END-IF. - MOVE 11 TO C-A. - SUBTRACT 10 FROM C-A END-SUBTRACT. - MOVE C-A TO C-RES. - IF C-RES NOT = 1 - DISPLAY 'ERROR COMP - NUM' - END-DISPLAY - END-IF. - * - ADD C1-B TO C1-A END-ADD. - MOVE C1-A TO C1-RES. - IF C1-RES NOT = 11 - DISPLAY 'ERROR COMP-1 + COMP-1' - END-DISPLAY - END-IF. - MOVE 1 TO C1-A. - ADD 10 TO C1-A END-ADD. - MOVE C1-A TO C1-RES. - IF C1-RES NOT = 11 - DISPLAY 'ERROR COMP-1 + NUM' - END-DISPLAY - END-IF. - MOVE 11 TO C1-A. - SUBTRACT C1-B FROM C1-A END-SUBTRACT. - MOVE C1-A TO C1-RES. - IF C1-RES NOT = 1 - DISPLAY 'ERROR COMP-1 - COMP-1' - END-DISPLAY - END-IF. - MOVE 11 TO C1-A. - SUBTRACT 10 FROM C1-A END-SUBTRACT. - MOVE C1-A TO C1-RES. - IF C1-RES NOT = 1 - DISPLAY 'ERROR COMP-1 - NUM' - END-DISPLAY - END-IF. - * - ADD C2-B TO C2-A END-ADD. - MOVE C2-A TO C2-RES. - IF C2-RES NOT = 11 - DISPLAY 'ERROR COMP-2 + COMP-2' - END-DISPLAY - END-IF. - MOVE 1 TO C2-A. - ADD 10 TO C2-A END-ADD. - MOVE C2-A TO C2-RES. - IF C2-RES NOT = 11 - DISPLAY 'ERROR COMP-2 + NUM' - END-DISPLAY - END-IF. - MOVE 11 TO C2-A. - SUBTRACT C2-B FROM C2-A END-SUBTRACT. - MOVE C2-A TO C2-RES. - IF C2-RES NOT = 1 - DISPLAY 'ERROR COMP-2 - COMP-2' - END-DISPLAY - END-IF. - MOVE 11 TO C2-A. - SUBTRACT 10 FROM C2-A END-SUBTRACT. - MOVE C2-A TO C2-RES. - IF C2-RES NOT = 1 - DISPLAY 'ERROR COMP-2 - NUM' - END-DISPLAY - END-IF. - * - ADD C3-B TO C3-A END-ADD. - MOVE C3-A TO C3-RES. - IF C3-RES NOT = 11 - DISPLAY 'ERROR COMP-3 + COMP-3' - END-DISPLAY - END-IF. - MOVE 1 TO C3-A. - ADD 10 TO C3-A END-ADD. - MOVE C3-A TO C3-RES. - IF C3-RES NOT = 11 - DISPLAY 'ERROR COMP-3 + NUM' - END-DISPLAY - END-IF. - MOVE 11 TO C3-A. - SUBTRACT C3-B FROM C3-A END-SUBTRACT. - MOVE C3-A TO C3-RES. - IF C3-RES NOT = 1 - DISPLAY 'ERROR COMP-3 - COMP-3' - END-DISPLAY - END-IF. - MOVE 11 TO C3-A. - SUBTRACT 10 FROM C3-A END-SUBTRACT. - MOVE C3-A TO C3-RES. - IF C3-RES NOT = 1 - DISPLAY 'ERROR COMP-3 - NUM' - END-DISPLAY - END-IF. - * - ADD C5-B TO C5-A END-ADD. - MOVE C5-A TO C5-RES. - IF C5-RES NOT = 11 - DISPLAY 'ERROR COMP-5 + COMP-5' - END-DISPLAY - END-IF. - MOVE 1 TO C5-A. - ADD 10 TO C5-A END-ADD. - MOVE C5-A TO C5-RES. - IF C5-RES NOT = 11 - DISPLAY 'ERROR COMP-5 + NUM' - END-DISPLAY - END-IF. - MOVE 11 TO C5-A. - SUBTRACT C5-B FROM C5-A END-SUBTRACT. - MOVE C5-A TO C5-RES. - IF C5-RES NOT = 1 - DISPLAY 'ERROR COMP-5 - COMP-5' - END-DISPLAY - END-IF. - MOVE 11 TO C5-A. - SUBTRACT 10 FROM C5-A END-SUBTRACT. - MOVE C5-A TO C5-RES. - IF C5-RES NOT = 1 - DISPLAY 'ERROR COMP-5 - NUM' - END-DISPLAY - END-IF. - * - ADD C6-B TO C6-A END-ADD. - MOVE C6-A TO C6-RES. - IF C6-RES NOT = 11 - DISPLAY 'ERROR COMP-6 + COMP-6' - END-DISPLAY - END-IF. - MOVE 1 TO C6-A. - ADD 10 TO C6-A END-ADD. - MOVE C6-A TO C6-RES. - IF C6-RES NOT = 11 - DISPLAY 'ERROR COMP-6 + NUM' - END-DISPLAY - END-IF. - MOVE 11 TO C6-A. - SUBTRACT C6-B FROM C6-A END-SUBTRACT. - MOVE C6-A TO C6-RES. - IF C6-RES NOT = 1 - DISPLAY 'ERROR COMP-6 - COMP-6' - END-DISPLAY - END-IF. - MOVE 11 TO C6-A. - SUBTRACT 10 FROM C6-A END-SUBTRACT. - MOVE C6-A TO C6-RES. - IF C6-RES NOT = 1 - DISPLAY 'ERROR COMP-6 - NUM' - END-DISPLAY - END-IF. - * - ADD CN9-B TO CN9-A END-ADD. - MOVE CN9-A TO CN9-RES. - IF CN9-RES NOT = 11 - DISPLAY 'ERROR COMP-N + COMP-N' - END-DISPLAY - END-IF. - MOVE 1 TO CN9-A. - ADD 10 TO CN9-A END-ADD. - MOVE CN9-A TO CN9-RES. - IF CN9-RES NOT = 11 - DISPLAY 'ERROR COMP-N + NUM' - END-DISPLAY - END-IF. - MOVE 11 TO CN9-A. - SUBTRACT CN9-B FROM CN9-A END-SUBTRACT. - MOVE CN9-A TO CN9-RES. - IF CN9-RES NOT = 1 - DISPLAY 'ERROR COMP-N - COMP-N' - END-DISPLAY - END-IF. - MOVE 11 TO CN9-A. - SUBTRACT 10 FROM CN9-A END-SUBTRACT. - MOVE CN9-A TO CN9-RES. - IF CN9-RES NOT = 1 - DISPLAY 'ERROR COMP-N - NUM' - END-DISPLAY - END-IF. - * - ADD CNX-B TO CNX-A END-ADD. - MOVE CNX-A TO CNX-RES. - IF CNX-RES NOT = 11 - DISPLAY 'ERROR COMP-N + COMP-N' - END-DISPLAY - END-IF. - MOVE 1 TO CNX-A. - ADD 10 TO CNX-A END-ADD. - MOVE CNX-A TO CNX-RES. - IF CNX-RES NOT = 11 - DISPLAY 'ERROR COMP-N + NUM' - END-DISPLAY - END-IF. - MOVE 11 TO CNX-A. - SUBTRACT CNX-B FROM CNX-A END-SUBTRACT. - MOVE CNX-A TO CNX-RES. - IF CNX-RES NOT = 1 - DISPLAY 'ERROR COMP-N - COMP-N' - END-DISPLAY - END-IF. - MOVE 11 TO CNX-A. - SUBTRACT 10 FROM CNX-A END-SUBTRACT. - MOVE CNX-A TO CNX-RES. - IF CNX-RES NOT = 1 - DISPLAY 'ERROR COMP-N - NUM' - END-DISPLAY - END-IF. - * - ADD CX9-B TO CX9-A END-ADD. - MOVE CX9-A TO CX9-RES. - IF CX9-RES NOT = 11 - DISPLAY 'ERROR COMP-X + COMP-X' - END-DISPLAY - END-IF. - MOVE 1 TO CX9-A. - ADD 10 TO CX9-A END-ADD. - MOVE CX9-A TO CX9-RES. - IF CX9-RES NOT = 11 - DISPLAY 'ERROR COMP-X + NUM' - END-DISPLAY - END-IF. - MOVE 11 TO CX9-A. - SUBTRACT CX9-B FROM CX9-A END-SUBTRACT. - MOVE CX9-A TO CX9-RES. - IF CX9-RES NOT = 1 - DISPLAY 'ERROR COMP-X - COMP-X' - END-DISPLAY - END-IF. - MOVE 11 TO CX9-A. - SUBTRACT 10 FROM CX9-A END-SUBTRACT. - MOVE CX9-A TO CX9-RES. - IF CX9-RES NOT = 1 - DISPLAY 'ERROR COMP-X - NUM' - END-DISPLAY - END-IF. - * - ADD CXX-B TO CXX-A END-ADD. - MOVE CXX-A TO CXX-RES. - IF CXX-RES NOT = 11 - DISPLAY 'ERROR COMP-X + COMP-X' - END-DISPLAY - END-IF. - MOVE 1 TO CXX-A. - ADD 10 TO CXX-A END-ADD. - MOVE CXX-A TO CXX-RES. - IF CXX-RES NOT = 11 - DISPLAY 'ERROR COMP-X + NUM' - END-DISPLAY - END-IF. - MOVE 11 TO CXX-A. - SUBTRACT CXX-B FROM CXX-A END-SUBTRACT. - MOVE CXX-A TO CXX-RES. - IF CXX-RES NOT = 1 - DISPLAY 'ERROR COMP-X - COMP-X' - END-DISPLAY - END-IF. - MOVE 11 TO CXX-A. - SUBTRACT 10 FROM CXX-A END-SUBTRACT. - MOVE CXX-A TO CXX-RES. - IF CXX-RES NOT = 1 - DISPLAY 'ERROR COMP-X - NUM' - END-DISPLAY - END-IF. - * - ADD D-B TO D-A END-ADD. - MOVE D-A TO D-RES. - IF D-RES NOT = 11 - DISPLAY 'ERROR DISPLAY + DISPLAY' - END-DISPLAY - END-IF. - MOVE 1 TO D-A. - ADD 10 TO D-A END-ADD. - MOVE D-A TO D-RES. - IF D-RES NOT = 11 - DISPLAY 'ERROR DISPLAY + NUM' - END-DISPLAY - END-IF. - MOVE 11 TO D-A. - SUBTRACT D-B FROM D-A END-SUBTRACT. - MOVE D-A TO D-RES. - IF D-RES NOT = 1 - DISPLAY 'ERROR DISPLAY - DISPLAY' - END-DISPLAY - END-IF. - MOVE 11 TO D-A. - SUBTRACT 10 FROM D-A END-SUBTRACT. - MOVE D-A TO D-RES. - IF D-RES NOT = 1 - DISPLAY 'ERROR DISPLAY - NUM' - END-DISPLAY - END-IF. - * - ADD FD16-B TO FD16-A END-ADD. - MOVE FD16-A TO FD16-RES. - IF FD16-RES NOT = 11 - DISPLAY 'ERROR FLOAT-DECIMAL-16 + FLOAT-DECIMAL-16' - END-DISPLAY - END-IF. - MOVE 1 TO FD16-A. - ADD 10 TO FD16-A END-ADD. - MOVE FD16-A TO FD16-RES. - IF FD16-RES NOT = 11 - DISPLAY 'ERROR FLOAT-DECIMAL-16 + NUM' - END-DISPLAY - END-IF. - MOVE 11 TO FD16-A. - SUBTRACT FD16-B FROM FD16-A END-SUBTRACT. - MOVE FD16-A TO FD16-RES. - IF FD16-RES NOT = 1 - DISPLAY 'ERROR FLOAT-DECIMAL-16 - FLOAT-DECIMAL-16' - END-DISPLAY - END-IF. - MOVE 11 TO FD16-A. - SUBTRACT 10 FROM FD16-A END-SUBTRACT. - MOVE FD16-A TO FD16-RES. - IF FD16-RES NOT = 1 - DISPLAY 'ERROR FLOAT-DECIMAL-16 - NUM' - END-DISPLAY - END-IF. - * - ADD FD34-B TO FD34-A END-ADD. - MOVE FD34-A TO FD34-RES. - IF FD34-RES NOT = 11 - DISPLAY 'ERROR FLOAT-DECIMAL-34 + FLOAT-DECIMAL-34' - END-DISPLAY - END-IF. - MOVE 1 TO FD34-A. - ADD 10 TO FD34-A END-ADD. - MOVE FD34-A TO FD34-RES. - IF FD34-RES NOT = 11 - DISPLAY 'ERROR FLOAT-DECIMAL-34 + NUM' - END-DISPLAY - END-IF. - MOVE 11 TO FD34-A. - SUBTRACT FD34-B FROM FD34-A END-SUBTRACT. - MOVE FD34-A TO FD34-RES. - IF FD34-RES NOT = 1 - DISPLAY 'ERROR FLOAT-DECIMAL-34 - FLOAT-DECIMAL-34' - END-DISPLAY - END-IF. - MOVE 11 TO FD34-A. - SUBTRACT 10 FROM FD34-A END-SUBTRACT. - MOVE FD34-A TO FD34-RES. - IF FD34-RES NOT = 1 - DISPLAY 'ERROR FLOAT-DECIMAL-34 - NUM' - END-DISPLAY - END-IF. - * - ADD FL-B TO FL-A END-ADD. - MOVE FL-A TO FL-RES. - IF FL-RES NOT = 11 - DISPLAY 'ERROR FLOAT-LONG + FLOAT-LONG' - END-DISPLAY - END-IF. - MOVE 1 TO FL-A. - ADD 10 TO FL-A END-ADD. - MOVE FL-A TO FL-RES. - IF FL-RES NOT = 11 - DISPLAY 'ERROR FLOAT-LONG + NUM' - END-DISPLAY - END-IF. - MOVE 11 TO FL-A. - SUBTRACT FL-B FROM FL-A END-SUBTRACT. - MOVE FL-A TO FL-RES. - IF FL-RES NOT = 1 - DISPLAY 'ERROR FLOAT-LONG - FLOAT-LONG' - END-DISPLAY - END-IF. - MOVE 11 TO FL-A. - SUBTRACT 10 FROM FL-A END-SUBTRACT. - MOVE FL-A TO FL-RES. - IF FL-RES NOT = 1 - DISPLAY 'ERROR FLOAT-LONG - NUM' - END-DISPLAY - END-IF. - * - ADD FS-B TO FS-A END-ADD. - MOVE FS-A TO FS-RES. - IF FS-RES NOT = 11 - DISPLAY 'ERROR FLOAT-SHORT + FLOAT-SHORT' - END-DISPLAY - END-IF. - MOVE 1 TO FS-A. - ADD 10 TO FS-A END-ADD. - MOVE FS-A TO FS-RES. - IF FS-RES NOT = 11 - DISPLAY 'ERROR FLOAT-SHORT + NUM' - END-DISPLAY - END-IF. - MOVE 11 TO FS-A. - SUBTRACT FS-B FROM FS-A END-SUBTRACT. - MOVE FS-A TO FS-RES. - IF FS-RES NOT = 1 - DISPLAY 'ERROR FLOAT-SHORT - FLOAT-SHORT' - END-DISPLAY - END-IF. - MOVE 11 TO FS-A. - SUBTRACT 10 FROM FS-A END-SUBTRACT. - MOVE FS-A TO FS-RES. - IF FS-RES NOT = 1 - DISPLAY 'ERROR FLOAT-SHORT - NUM' - END-DISPLAY - END-IF. - * - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_misc.at:5058: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_misc.at:5058" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:5058" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_misc.at:5059: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_misc.at:5059" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:5059" -$at_failed && at_fn_log_failure -$at_traceon; } - - -{ set +x -$as_echo "$at_srcdir/run_misc.at:5061: \$COMPILE -fnotrunc prog.cob" -at_fn_check_prepare_dynamic "$COMPILE -fnotrunc prog.cob" "run_misc.at:5061" -( $at_check_trace; $COMPILE -fnotrunc prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:5061" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_misc.at:5062: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_misc.at:5062" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:5062" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_641 -#AT_START_642 -at_fn_group_banner 642 'run_misc.at:5067' \ - "Computing of different USAGEs w/- decimal point" "" 4 -at_xfail=no -( - $as_echo "642. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. 'prog'. - ENVIRONMENT DIVISION. - DATA DIVISION. - WORKING-STORAGE SECTION. - * - 77 BCL-A BINARY-C-LONG VALUE 1.0. - 77 BCL-B BINARY-C-LONG VALUE 10.0. - 77 BCL-RES BINARY-C-LONG. - * - 77 BC-A BINARY-CHAR VALUE 1.0. - 77 BC-B BINARY-CHAR VALUE 10.0. - 77 BC-RES BINARY-CHAR. - * - 77 BD-A BINARY-DOUBLE VALUE 1.0. - 77 BD-B BINARY-DOUBLE VALUE 10.0. - 77 BD-RES BINARY-DOUBLE. - * - 77 BL-A BINARY-LONG VALUE 1.0. - 77 BL-B BINARY-LONG VALUE 10.0. - 77 BL-RES BINARY-LONG. - * - 77 C-A PIC S99 COMP VALUE 1.0. - 77 C-B PIC S99 COMP VALUE 10.0. - 77 C-RES PIC S99 COMP. - * - 77 C1-A COMP-1 VALUE 1.0. - 77 C1-B COMP-1 VALUE 10.0. - 77 C1-RES COMP-1. - * - 77 C2-A COMP-2 VALUE 1.0. - 77 C2-B COMP-2 VALUE 10.0. - 77 C2-RES COMP-2. - * - 77 C3-A PIC S99 COMP-3 VALUE 1.0. - 77 C3-B PIC S99 COMP-3 VALUE 10.0. - 77 C3-RES PIC S99 COMP-3. - * - 77 C5-A PIC S99 COMP-5 VALUE 1.0. - 77 C5-B PIC S99 COMP-5 VALUE 10.0. - 77 C5-RES PIC S99 COMP-5. - * - 77 C6-A PIC 99 COMP-6 VALUE 1.0. - 77 C6-B PIC 99 COMP-6 VALUE 10.0. - 77 C6-RES PIC 99 COMP-6. - * - 77 CN9-A PIC 99 COMP-N VALUE 1. - 77 CN9-B PIC 99 COMP-N VALUE 10. - 77 CN9-RES PIC 99 COMP-N. - * - 77 CNX-A PIC X COMP-N VALUE 1. - 77 CNX-B PIC X COMP-N VALUE 10. - 77 CNX-RES PIC X COMP-N. - * - 77 CX9-A PIC 99 COMP-X VALUE 1. - 77 CX9-B PIC 99 COMP-X VALUE 10. - 77 CX9-RES PIC 99 COMP-X. - * - 77 CXX-A PIC X COMP-X VALUE 1. - 77 CXX-B PIC X COMP-X VALUE 10. - 77 CXX-RES PIC X COMP-X. - * - 77 D-A PIC S99 VALUE 1.0. - 77 D-B PIC S99 VALUE 10.0. - 77 D-RES PIC S99. - * - 77 FD16-A FLOAT-DECIMAL-16 VALUE 1.0. - 77 FD16-B FLOAT-DECIMAL-16 VALUE 10.0. - 77 FD16-RES FLOAT-DECIMAL-16. - * - 77 FD34-A FLOAT-DECIMAL-34 VALUE 1.0. - 77 FD34-B FLOAT-DECIMAL-34 VALUE 10.0. - 77 FD34-RES FLOAT-DECIMAL-34. - * - 77 FL-A FLOAT-LONG VALUE 1.0. - 77 FL-B FLOAT-LONG VALUE 10.0. - 77 FL-RES FLOAT-LONG. - * - 77 FS-A FLOAT-SHORT VALUE 1.0. - 77 FS-B FLOAT-SHORT VALUE 10.0. - 77 FS-RES FLOAT-SHORT. - * - PROCEDURE DIVISION. - * - ADD BCL-B TO BCL-A END-ADD. - MOVE BCL-A TO BCL-RES. - IF BCL-RES NOT = 11.0 - DISPLAY 'ERROR BINARY-C-LONG + BINARY-C-LONG' - END-DISPLAY - END-IF. - MOVE 1.0 TO BCL-A. - ADD 10.0 TO BCL-A END-ADD. - MOVE BCL-A TO BCL-RES. - IF BCL-RES NOT = 11.0 - DISPLAY 'ERROR BINARY-C-LONG + NUM' - END-DISPLAY - END-IF. - MOVE 11.0 TO BCL-A. - SUBTRACT BCL-B FROM BCL-A END-SUBTRACT. - MOVE BCL-A TO BCL-RES. - IF BCL-RES NOT = 1.0 - DISPLAY 'ERROR BINARY-C-LONG - BINARY-C-LONG' - END-DISPLAY - END-IF. - MOVE 11.0 TO BCL-A. - SUBTRACT 10.0 FROM BCL-A END-SUBTRACT. - MOVE BCL-A TO BCL-RES. - IF BCL-RES NOT = 1.0 - DISPLAY 'ERROR BINARY-C-LONG - NUM' - END-DISPLAY - END-IF. - * - ADD BC-B TO BC-A END-ADD. - MOVE BC-A TO BC-RES. - IF BC-RES NOT = 11.0 - DISPLAY 'ERROR BINARY-CHAR + BINARY-CHAR' - END-DISPLAY - END-IF. - MOVE 1.0 TO BC-A. - ADD 10.0 TO BC-A END-ADD. - MOVE BC-A TO BC-RES. - IF BC-RES NOT = 11.0 - DISPLAY 'ERROR BINARY-CHAR + NUM' - END-DISPLAY - END-IF. - MOVE 11.0 TO BC-A. - SUBTRACT BC-B FROM BC-A END-SUBTRACT. - MOVE BC-A TO BC-RES. - IF BC-RES NOT = 1.0 - DISPLAY 'ERROR BINARY-CHAR - BINARY-CHAR' - END-DISPLAY - END-IF. - MOVE 11.0 TO BC-A. - SUBTRACT 10.0 FROM BC-A END-SUBTRACT. - MOVE BC-A TO BC-RES. - IF BC-RES NOT = 1.0 - DISPLAY 'ERROR BINARY-CHAR - NUM' - END-DISPLAY - END-IF. - * - ADD BD-B TO BD-A END-ADD. - MOVE BD-A TO BD-RES. - IF BD-RES NOT = 11.0 - DISPLAY 'ERROR BINARY-DOUBLE + BINARY-DOUBLE' - END-DISPLAY - END-IF. - MOVE 1.0 TO BD-A. - ADD 10.0 TO BD-A END-ADD. - MOVE BD-A TO BD-RES. - IF BD-RES NOT = 11.0 - DISPLAY 'ERROR BINARY-DOUBLE + NUM' - END-DISPLAY - END-IF. - MOVE 11.0 TO BD-A. - SUBTRACT BD-B FROM BD-A END-SUBTRACT. - MOVE BD-A TO BD-RES. - IF BD-RES NOT = 1.0 - DISPLAY 'ERROR BINARY-DOUBLE - BINARY-DOUBLE' - END-DISPLAY - END-IF. - MOVE 11.0 TO BD-A. - SUBTRACT 10.0 FROM BD-A END-SUBTRACT. - MOVE BD-A TO BD-RES. - IF BD-RES NOT = 1.0 - DISPLAY 'ERROR BINARY-DOUBLE - NUM' - END-DISPLAY - END-IF. - * - ADD BL-B TO BL-A END-ADD. - MOVE BL-A TO BL-RES. - IF BL-RES NOT = 11.0 - DISPLAY 'ERROR BINARY-LONG + BINARY-LONG' - END-DISPLAY - END-IF. - MOVE 1.0 TO BL-A. - ADD 10.0 TO BL-A END-ADD. - MOVE BL-A TO BL-RES. - IF BL-RES NOT = 11.0 - DISPLAY 'ERROR BINARY-LONG + NUM' - END-DISPLAY - END-IF. - MOVE 11.0 TO BL-A. - SUBTRACT BL-B FROM BL-A END-SUBTRACT. - MOVE BL-A TO BL-RES. - IF BL-RES NOT = 1.0 - DISPLAY 'ERROR BINARY-LONG - BINARY-LONG' - END-DISPLAY - END-IF. - MOVE 11.0 TO BL-A. - SUBTRACT 10.0 FROM BL-A END-SUBTRACT. - MOVE BL-A TO BL-RES. - IF BL-RES NOT = 1.0 - DISPLAY 'ERROR BINARY-LONG - NUM' - END-DISPLAY - END-IF. - * - ADD C-B TO C-A END-ADD. - MOVE C-A TO C-RES. - IF C-RES NOT = 11.0 - DISPLAY 'ERROR COMP + COMP' - END-DISPLAY - END-IF. - MOVE 1.0 TO C-A. - ADD 10.0 TO C-A END-ADD. - MOVE C-A TO C-RES. - IF C-RES NOT = 11.0 - DISPLAY 'ERROR COMP + NUM' - END-DISPLAY - END-IF. - MOVE 11.0 TO C-A. - SUBTRACT C-B FROM C-A END-SUBTRACT. - MOVE C-A TO C-RES. - IF C-RES NOT = 1.0 - DISPLAY 'ERROR COMP - COMP' - END-DISPLAY - END-IF. - MOVE 11.0 TO C-A. - SUBTRACT 10.0 FROM C-A END-SUBTRACT. - MOVE C-A TO C-RES. - IF C-RES NOT = 1.0 - DISPLAY 'ERROR COMP - NUM' - END-DISPLAY - END-IF. - * - ADD C1-B TO C1-A END-ADD. - MOVE C1-A TO C1-RES. - IF C1-RES NOT = 11.0 - DISPLAY 'ERROR COMP-1 + COMP-1' - END-DISPLAY - END-IF. - MOVE 1.0 TO C1-A. - ADD 10.0 TO C1-A END-ADD. - MOVE C1-A TO C1-RES. - IF C1-RES NOT = 11.0 - DISPLAY 'ERROR COMP-1 + NUM' - END-DISPLAY - END-IF. - MOVE 11.0 TO C1-A. - SUBTRACT C1-B FROM C1-A END-SUBTRACT. - MOVE C1-A TO C1-RES. - IF C1-RES NOT = 1.0 - DISPLAY 'ERROR COMP-1 - COMP-1' - END-DISPLAY - END-IF. - MOVE 11.0 TO C1-A. - SUBTRACT 10.0 FROM C1-A END-SUBTRACT. - MOVE C1-A TO C1-RES. - IF C1-RES NOT = 1.0 - DISPLAY 'ERROR COMP-1 - NUM' - END-DISPLAY - END-IF. - * - ADD C2-B TO C2-A END-ADD. - MOVE C2-A TO C2-RES. - IF C2-RES NOT = 11.0 - DISPLAY 'ERROR COMP-2 + COMP-2' - END-DISPLAY - END-IF. - MOVE 1.0 TO C2-A. - ADD 10.0 TO C2-A END-ADD. - MOVE C2-A TO C2-RES. - IF C2-RES NOT = 11.0 - DISPLAY 'ERROR COMP-2 + NUM' - END-DISPLAY - END-IF. - MOVE 11.0 TO C2-A. - SUBTRACT C2-B FROM C2-A END-SUBTRACT. - MOVE C2-A TO C2-RES. - IF C2-RES NOT = 1.0 - DISPLAY 'ERROR COMP-2 - COMP-2' - END-DISPLAY - END-IF. - MOVE 11.0 TO C2-A. - SUBTRACT 10.0 FROM C2-A END-SUBTRACT. - MOVE C2-A TO C2-RES. - IF C2-RES NOT = 1.0 - DISPLAY 'ERROR COMP-2 - NUM' - END-DISPLAY - END-IF. - * - ADD C3-B TO C3-A END-ADD. - MOVE C3-A TO C3-RES. - IF C3-RES NOT = 11.0 - DISPLAY 'ERROR COMP-3 + COMP-3' - END-DISPLAY - END-IF. - MOVE 1.0 TO C3-A. - ADD 10.0 TO C3-A END-ADD. - MOVE C3-A TO C3-RES. - IF C3-RES NOT = 11.0 - DISPLAY 'ERROR COMP-3 + NUM' - END-DISPLAY - END-IF. - MOVE 11.0 TO C3-A. - SUBTRACT C3-B FROM C3-A END-SUBTRACT. - MOVE C3-A TO C3-RES. - IF C3-RES NOT = 1.0 - DISPLAY 'ERROR COMP-3 - COMP-3' - END-DISPLAY - END-IF. - MOVE 11.0 TO C3-A. - SUBTRACT 10.0 FROM C3-A END-SUBTRACT. - MOVE C3-A TO C3-RES. - IF C3-RES NOT = 1.0 - DISPLAY 'ERROR COMP-3 - NUM' - END-DISPLAY - END-IF. - * - ADD C5-B TO C5-A END-ADD. - MOVE C5-A TO C5-RES. - IF C5-RES NOT = 11.0 - DISPLAY 'ERROR COMP-5 + COMP-5' - END-DISPLAY - END-IF. - MOVE 1.0 TO C5-A. - ADD 10.0 TO C5-A END-ADD. - MOVE C5-A TO C5-RES. - IF C5-RES NOT = 11.0 - DISPLAY 'ERROR COMP-5 + NUM' - END-DISPLAY - END-IF. - MOVE 11.0 TO C5-A. - SUBTRACT C5-B FROM C5-A END-SUBTRACT. - MOVE C5-A TO C5-RES. - IF C5-RES NOT = 1.0 - DISPLAY 'ERROR COMP-5 - COMP-5' - END-DISPLAY - END-IF. - MOVE 11.0 TO C5-A. - SUBTRACT 10.0 FROM C5-A END-SUBTRACT. - MOVE C5-A TO C5-RES. - IF C5-RES NOT = 1.0 - DISPLAY 'ERROR COMP-5 - NUM' - END-DISPLAY - END-IF. - * - ADD C6-B TO C6-A END-ADD. - MOVE C6-A TO C6-RES. - IF C6-RES NOT = 11.0 - DISPLAY 'ERROR COMP-6 + COMP-6' - END-DISPLAY - END-IF. - MOVE 1.0 TO C6-A. - ADD 10.0 TO C6-A END-ADD. - MOVE C6-A TO C6-RES. - IF C6-RES NOT = 11.0 - DISPLAY 'ERROR COMP-6 + NUM' - END-DISPLAY - END-IF. - MOVE 11.0 TO C6-A. - SUBTRACT C6-B FROM C6-A END-SUBTRACT. - MOVE C6-A TO C6-RES. - IF C6-RES NOT = 1.0 - DISPLAY 'ERROR COMP-6 - COMP-6' - END-DISPLAY - END-IF. - MOVE 11.0 TO C6-A. - SUBTRACT 10.0 FROM C6-A END-SUBTRACT. - MOVE C6-A TO C6-RES. - IF C6-RES NOT = 1.0 - DISPLAY 'ERROR COMP-6 - NUM' - END-DISPLAY - END-IF. - * - ADD CN9-B TO CN9-A END-ADD. - MOVE CN9-A TO CN9-RES. - IF CN9-RES NOT = 11.0 - DISPLAY 'ERROR COMP-N + COMP-N' - END-DISPLAY - END-IF. - MOVE 1.0 TO CN9-A. - ADD 10.0 TO CN9-A END-ADD. - MOVE CN9-A TO CN9-RES. - IF CN9-RES NOT = 11.0 - DISPLAY 'ERROR COMP-N + NUM' - END-DISPLAY - END-IF. - MOVE 11.0 TO CN9-A. - SUBTRACT CN9-B FROM CN9-A END-SUBTRACT. - MOVE CN9-A TO CN9-RES. - IF CN9-RES NOT = 1.0 - DISPLAY 'ERROR COMP-N - COMP-N' - END-DISPLAY - END-IF. - MOVE 11.0 TO CN9-A. - SUBTRACT 10.0 FROM CN9-A END-SUBTRACT. - MOVE CN9-A TO CN9-RES. - IF CN9-RES NOT = 1.0 - DISPLAY 'ERROR COMP-N - NUM' - END-DISPLAY - END-IF. - * - ADD CNX-B TO CNX-A END-ADD. - MOVE CNX-A TO CNX-RES. - IF CNX-RES NOT = 11.0 - DISPLAY 'ERROR COMP-N + COMP-N' - END-DISPLAY - END-IF. - MOVE 1.0 TO CNX-A. - ADD 10.0 TO CNX-A END-ADD. - MOVE CNX-A TO CNX-RES. - IF CNX-RES NOT = 11.0 - DISPLAY 'ERROR COMP-N + NUM' - END-DISPLAY - END-IF. - MOVE 11.0 TO CNX-A. - SUBTRACT CNX-B FROM CNX-A END-SUBTRACT. - MOVE CNX-A TO CNX-RES. - IF CNX-RES NOT = 1.0 - DISPLAY 'ERROR COMP-N - COMP-N' - END-DISPLAY - END-IF. - MOVE 11.0 TO CNX-A. - SUBTRACT 10.0 FROM CNX-A END-SUBTRACT. - MOVE CNX-A TO CNX-RES. - IF CNX-RES NOT = 1.0 - DISPLAY 'ERROR COMP-N - NUM' - END-DISPLAY - END-IF. - * - ADD CX9-B TO CX9-A END-ADD. - MOVE CX9-A TO CX9-RES. - IF CX9-RES NOT = 11.0 - DISPLAY 'ERROR COMP-X + COMP-X' - END-DISPLAY - END-IF. - MOVE 1.0 TO CX9-A. - ADD 10.0 TO CX9-A END-ADD. - MOVE CX9-A TO CX9-RES. - IF CX9-RES NOT = 11.0 - DISPLAY 'ERROR COMP-X + NUM' - END-DISPLAY - END-IF. - MOVE 11.0 TO CX9-A. - SUBTRACT CX9-B FROM CX9-A END-SUBTRACT. - MOVE CX9-A TO CX9-RES. - IF CX9-RES NOT = 1.0 - DISPLAY 'ERROR COMP-X - COMP-X' - END-DISPLAY - END-IF. - MOVE 11.0 TO CX9-A. - SUBTRACT 10.0 FROM CX9-A END-SUBTRACT. - MOVE CX9-A TO CX9-RES. - IF CX9-RES NOT = 1.0 - DISPLAY 'ERROR COMP-X - NUM' - END-DISPLAY - END-IF. - * - ADD CXX-B TO CXX-A END-ADD. - MOVE CXX-A TO CXX-RES. - IF CXX-RES NOT = 11.0 - DISPLAY 'ERROR COMP-X + COMP-X' - END-DISPLAY - END-IF. - MOVE 1.0 TO CXX-A. - ADD 10.0 TO CXX-A END-ADD. - MOVE CXX-A TO CXX-RES. - IF CXX-RES NOT = 11.0 - DISPLAY 'ERROR COMP-X + NUM' - END-DISPLAY - END-IF. - MOVE 11.0 TO CXX-A. - SUBTRACT CXX-B FROM CXX-A END-SUBTRACT. - MOVE CXX-A TO CXX-RES. - IF CXX-RES NOT = 1.0 - DISPLAY 'ERROR COMP-X - COMP-X' - END-DISPLAY - END-IF. - MOVE 11.0 TO CXX-A. - SUBTRACT 10.0 FROM CXX-A END-SUBTRACT. - MOVE CXX-A TO CXX-RES. - IF CXX-RES NOT = 1.0 - DISPLAY 'ERROR COMP-X - NUM' - END-DISPLAY - END-IF. - * - ADD D-B TO D-A END-ADD. - MOVE D-A TO D-RES. - IF D-RES NOT = 11.0 - DISPLAY 'ERROR DISPLAY + DISPLAY' - END-DISPLAY - END-IF. - MOVE 1.0 TO D-A. - ADD 10.0 TO D-A END-ADD. - MOVE D-A TO D-RES. - IF D-RES NOT = 11.0 - DISPLAY 'ERROR DISPLAY + NUM' - END-DISPLAY - END-IF. - MOVE 11.0 TO D-A. - SUBTRACT D-B FROM D-A END-SUBTRACT. - MOVE D-A TO D-RES. - IF D-RES NOT = 1.0 - DISPLAY 'ERROR DISPLAY - DISPLAY' - END-DISPLAY - END-IF. - MOVE 11.0 TO D-A. - SUBTRACT 10.0 FROM D-A END-SUBTRACT. - MOVE D-A TO D-RES. - IF D-RES NOT = 1.0 - DISPLAY 'ERROR DISPLAY - NUM' - END-DISPLAY - END-IF. - * - ADD FD16-B TO FD16-A END-ADD. - MOVE FD16-A TO FD16-RES. - IF FD16-RES NOT = 11.0 - DISPLAY 'ERROR FLOAT-DECIMAL-16 + FLOAT-DECIMAL-16' - END-DISPLAY - END-IF. - MOVE 1.0 TO FD16-A. - ADD 10.0 TO FD16-A END-ADD. - MOVE FD16-A TO FD16-RES. - IF FD16-RES NOT = 11.0 - DISPLAY 'ERROR FLOAT-DECIMAL-16 + NUM' - END-DISPLAY - END-IF. - MOVE 11.0 TO FD16-A. - SUBTRACT FD16-B FROM FD16-A END-SUBTRACT. - MOVE FD16-A TO FD16-RES. - IF FD16-RES NOT = 1.0 - DISPLAY 'ERROR FLOAT-DECIMAL-16 - FLOAT-DECIMAL-16' - END-DISPLAY - END-IF. - MOVE 11.0 TO FD16-A. - SUBTRACT 10.0 FROM FD16-A END-SUBTRACT. - MOVE FD16-A TO FD16-RES. - IF FD16-RES NOT = 1.0 - DISPLAY 'ERROR FLOAT-DECIMAL-16 - NUM' - END-DISPLAY - END-IF. - * - ADD FD34-B TO FD34-A END-ADD. - MOVE FD34-A TO FD34-RES. - IF FD34-RES NOT = 11.0 - DISPLAY 'ERROR FLOAT-DECIMAL-34 + FLOAT-DECIMAL-34' - END-DISPLAY - END-IF. - MOVE 1.0 TO FD34-A. - ADD 10.0 TO FD34-A END-ADD. - MOVE FD34-A TO FD34-RES. - IF FD34-RES NOT = 11.0 - DISPLAY 'ERROR FLOAT-DECIMAL-34 + NUM' - END-DISPLAY - END-IF. - MOVE 11.0 TO FD34-A. - SUBTRACT FD34-B FROM FD34-A END-SUBTRACT. - MOVE FD34-A TO FD34-RES. - IF FD34-RES NOT = 1.0 - DISPLAY 'ERROR FLOAT-DECIMAL-34 - FLOAT-DECIMAL-34' - END-DISPLAY - END-IF. - MOVE 11.0 TO FD34-A. - SUBTRACT 10.0 FROM FD34-A END-SUBTRACT. - MOVE FD34-A TO FD34-RES. - IF FD34-RES NOT = 1.0 - DISPLAY 'ERROR FLOAT-DECIMAL-34 - NUM' - END-DISPLAY - END-IF. - * - ADD FL-B TO FL-A END-ADD. - MOVE FL-A TO FL-RES. - IF FL-RES NOT = 11.0 - DISPLAY 'ERROR FLOAT-LONG + FLOAT-LONG' - END-DISPLAY - END-IF. - MOVE 1.0 TO FL-A. - ADD 10.0 TO FL-A END-ADD. - MOVE FL-A TO FL-RES. - IF FL-RES NOT = 11.0 - DISPLAY 'ERROR FLOAT-LONG + NUM' - END-DISPLAY - END-IF. - MOVE 11.0 TO FL-A. - SUBTRACT FL-B FROM FL-A END-SUBTRACT. - MOVE FL-A TO FL-RES. - IF FL-RES NOT = 1.0 - DISPLAY 'ERROR FLOAT-LONG - FLOAT-LONG' - END-DISPLAY - END-IF. - MOVE 11.0 TO FL-A. - SUBTRACT 10.0 FROM FL-A END-SUBTRACT. - MOVE FL-A TO FL-RES. - IF FL-RES NOT = 1.0 - DISPLAY 'ERROR FLOAT-LONG - NUM' - END-DISPLAY - END-IF. - * - ADD FS-B TO FS-A END-ADD. - MOVE FS-A TO FS-RES. - IF FS-RES NOT = 11.0 - DISPLAY 'ERROR FLOAT-SHORT + FLOAT-SHORT' - END-DISPLAY - END-IF. - MOVE 1.0 TO FS-A. - ADD 10.0 TO FS-A END-ADD. - MOVE FS-A TO FS-RES. - IF FS-RES NOT = 11.0 - DISPLAY 'ERROR FLOAT-SHORT + NUM' - END-DISPLAY - END-IF. - MOVE 11.0 TO FS-A. - SUBTRACT FS-B FROM FS-A END-SUBTRACT. - MOVE FS-A TO FS-RES. - IF FS-RES NOT = 1.0 - DISPLAY 'ERROR FLOAT-SHORT - FLOAT-SHORT' - END-DISPLAY - END-IF. - MOVE 11.0 TO FS-A. - SUBTRACT 10.0 FROM FS-A END-SUBTRACT. - MOVE FS-A TO FS-RES. - IF FS-RES NOT = 1.0 - DISPLAY 'ERROR FLOAT-SHORT - NUM' - END-DISPLAY - END-IF. - * - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_misc.at:5693: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_misc.at:5693" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:5693" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_misc.at:5694: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_misc.at:5694" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:5694" -$at_failed && at_fn_log_failure -$at_traceon; } - - -{ set +x -$as_echo "$at_srcdir/run_misc.at:5696: \$COMPILE -fnotrunc prog.cob" -at_fn_check_prepare_dynamic "$COMPILE -fnotrunc prog.cob" "run_misc.at:5696" -( $at_check_trace; $COMPILE -fnotrunc prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:5696" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_misc.at:5697: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_misc.at:5697" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:5697" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_642 -#AT_START_643 -at_fn_group_banner 643 'run_misc.at:5702' \ - "C/C++ reserved words/predefined identifiers" " " 4 -at_xfail=no -( - $as_echo "643. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >caller.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. caller. - DATA DIVISION. - WORKING-STORAGE SECTION. - * - * Reserved Words in C (that aren't reserved in COBOL) - * var names MUST BE IN LOWER CASE (!) - * - 77 const PIC X VALUE "A". - 77 double PIC X VALUE "B". - 77 float PIC X VALUE "C". - 77 int PIC X VALUE "D". - 77 short PIC X VALUE "E". - 77 struct PIC X VALUE "F". - 77 break PIC X VALUE "G". - 77 long PIC X VALUE "H". - 77 switch PIC X VALUE "I". - 77 void PIC X VALUE "J". - 77 case PIC X VALUE "K". - 77 enum PIC X VALUE "L". - 77 goto PIC X VALUE "M". - 77 register PIC X VALUE "N". - 77 sizeof PIC X VALUE "O". - 77 volatile PIC X VALUE "P". - 77 char PIC X VALUE "Q". - 77 do PIC X VALUE "R". - 77 extern PIC X VALUE "S". - 77 static PIC X VALUE "T". - 77 union PIC X VALUE "U". - 77 while PIC X VALUE "V". - * - * More Reserved Words in C++ - * var names MUST BE IN LOWER CASE (!) - * - 77 asm PIC X VALUE "W". - 77 dynamic_cast PIC X VALUE "X". - 77 namespace PIC X VALUE "Y". - 77 reinterpret_cast PIC X VALUE "Z". - 77 try PIC X VALUE "a". - 77 bool PIC X VALUE "b". - 77 explicit PIC X VALUE "c". - *77 new PIC X VALUE "d". - 77 static_cast PIC X VALUE "e". - 77 typeid PIC X VALUE "f". - 77 catch PIC X VALUE "g". - 77 operator PIC X VALUE "h". - 77 template PIC X VALUE "i". - 77 typename PIC X VALUE "j". - 77 friend PIC X VALUE "k". - 77 private PIC X VALUE "l". - 77 this PIC X VALUE "m". - 77 const_cast PIC X VALUE "n". - 77 inline PIC X VALUE "o". - 77 public PIC X VALUE "p". - 77 throw PIC X VALUE "q". - 77 virtual PIC X VALUE "r". - 77 mutable PIC X VALUE "s". - 77 protected PIC X VALUE "t". - 77 wchar_t PIC X VALUE "u". - * - * More Reserved Words in C++ (not essential) - * var names MUST BE IN LOWER CASE (!) - * - 77 bitand PIC X VALUE "v". - 77 compl PIC X VALUE "w". - 77 not_eq PIC X VALUE "x". - 77 or_eq PIC X VALUE "y". - 77 xor_eq PIC X VALUE "z". - 77 and_eq PIC X VALUE "0". - 77 bitor PIC X VALUE "1". - 77 xor PIC X VALUE "2". - * - PROCEDURE DIVISION. - CALL "callee" USING const - double - float - int - short - struct - break - long - switch - void - case - enum - goto - register - sizeof - volatile - char - do - *>extern - *>static - union - while - END-CALL. - CALL "callee2" USING asm - dynamic_cast - namespace - reinterpret_cast - try - bool - explicit - * new - static_cast - typeid - catch - operator - template - typename - friend - private - this - const_cast - inline - public - throw - virtual - mutable - protected - wchar_t - bitand - compl - not_eq - or_eq - xor_eq - and_eq - bitor - xor - END-CALL. - MOVE x'00' TO const - double - float - int - short - struct - break - long - switch - void - case - enum - goto - register - sizeof - volatile - char - do - extern - static - union - while - asm - dynamic_cast - namespace - reinterpret_cast - try - bool - explicit - * new - static_cast - typeid - catch - operator - template - typename - friend - private - this - const_cast - inline - public - throw - virtual - mutable - protected - wchar_t - bitand - compl - not_eq - or_eq - xor_eq - and_eq - bitor - xor - . - STOP RUN. -_ATEOF - - -cat >callee.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. callee. - DATA DIVISION. - LINKAGE SECTION. - * - * Reserved Words in C (that aren't reserved in COBOL) - * var names MUST BE IN LOWER CASE (!) - * - 77 const PIC X. - 77 double PIC X. - 77 float PIC X. - 77 int PIC X. - 77 short PIC X. - 77 struct PIC X. - 77 break PIC X. - 77 long PIC X. - 77 switch PIC X. - 77 void PIC X. - 77 case PIC X. - 77 enum PIC X. - 77 goto PIC X. - 77 register PIC X. - 77 sizeof PIC X. - 77 volatile PIC X. - 77 char PIC X. - 77 do PIC X. - *77 extern PIC X. - *77 static PIC X. - 77 union PIC X. - 77 while PIC X. - PROCEDURE DIVISION USING - const - double - float - int - short - struct - break - long - switch - void - case - enum - goto - register - sizeof - volatile - char - do - *>extern - *>static - union - while - . - IF (const NOT = "A") OR - (double NOT = "B") OR - (float NOT = "C") OR - (int NOT = "D") OR - (short NOT = "E") OR - (struct NOT = "F") OR - (break NOT = "G") OR - (long NOT = "H") OR - (switch NOT = "I") OR - (void NOT = "J") OR - (case NOT = "K") OR - (enum NOT = "L") OR - (goto NOT = "M") OR - (register NOT = "N") OR - (sizeof NOT = "O") OR - (volatile NOT = "P") OR - (char NOT = "Q") OR - (do NOT = "R") OR - *>(extern NOT = "S") OR - *>(static NOT = "T") OR - (union NOT = "U") OR - (while NOT = "V") - DISPLAY "At least one var has wrong content!" - END-DISPLAY - END-IF. - MOVE x'FF' TO const - double - float - int - short - struct - break - long - switch - void - case - enum - goto - register - sizeof - volatile - char - do - *>extern - *>static - union - while - . - EXIT PROGRAM. -_ATEOF - - -cat >callee2.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. callee2. - DATA DIVISION. - LINKAGE SECTION. - * - * More Reserved Words in C++ - * var names MUST BE IN LOWER CASE (!) - * - 77 asm PIC X. - 77 dynamic_cast PIC X. - 77 namespace PIC X. - 77 reinterpret_cast PIC X. - 77 try PIC X. - 77 bool PIC X. - 77 explicit PIC X. - *77 new PIC X. - 77 static_cast PIC X. - 77 typeid PIC X. - 77 catch PIC X. - 77 operator PIC X. - 77 template PIC X. - 77 typename PIC X. - 77 friend PIC X. - 77 private PIC X. - 77 this PIC X. - 77 const_cast PIC X. - 77 inline PIC X. - 77 public PIC X. - 77 throw PIC X. - 77 virtual PIC X. - 77 mutable PIC X. - 77 protected PIC X. - 77 wchar_t PIC X. - * - * More Reserved Words in C++ (not essential) - * - 77 bitand PIC X. - 77 compl PIC X. - 77 not_eq PIC X. - 77 or_eq PIC X. - 77 xor_eq PIC X. - 77 and_eq PIC X. - 77 bitor PIC X. - 77 xor PIC X. - PROCEDURE DIVISION USING - asm - dynamic_cast - namespace - reinterpret_cast - try - bool - explicit - * new - static_cast - typeid - catch - operator - template - typename - friend - private - this - const_cast - inline - public - throw - virtual - mutable - protected - wchar_t - bitand - compl - not_eq - or_eq - xor_eq - and_eq - bitor - xor - . - IF (asm NOT = "W") OR - (dynamic_cast NOT = "X") OR - (namespace NOT = "Y") OR - (reinterpret_cast NOT = "Z") OR - (try NOT = "a") OR - (bool NOT = "b") OR - (explicit NOT = "c") OR - * (new NOT = "d") OR - (static_cast NOT = "e") OR - (typeid NOT = "f") OR - (catch NOT = "g") OR - (operator NOT = "h") OR - (template NOT = "i") OR - (typename NOT = "j") OR - (friend NOT = "k") OR - (private NOT = "l") OR - (this NOT = "m") OR - (const_cast NOT = "n") OR - (inline NOT = "o") OR - (public NOT = "p") OR - (throw NOT = "q") OR - (virtual NOT = "r") OR - (mutable NOT = "s") OR - (protected NOT = "t") OR - (wchar_t NOT = "u") OR - (bitand NOT = "v") OR - (compl NOT = "w") OR - (not_eq NOT = "x") OR - (or_eq NOT = "y") OR - (xor_eq NOT = "z") OR - (and_eq NOT = "0") OR - (bitor NOT = "1") OR - (xor NOT = "2") - DISPLAY "At least one var has wrong content!" - END-DISPLAY - END-IF. - MOVE x'FF' TO asm - dynamic_cast - namespace - reinterpret_cast - try - bool - explicit - * new - static_cast - typeid - catch - operator - template - typename - friend - private - this - const_cast - inline - public - throw - virtual - mutable - protected - wchar_t - bitand - compl - not_eq - or_eq - xor_eq - and_eq - bitor - xor - . - EXIT PROGRAM. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_misc.at:6154: \$COMPILE_MODULE -fnot-reserved=double,float,new,volatile callee.cob" -at_fn_check_prepare_dynamic "$COMPILE_MODULE -fnot-reserved=double,float,new,volatile callee.cob" "run_misc.at:6154" -( $at_check_trace; $COMPILE_MODULE -fnot-reserved=double,float,new,volatile callee.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:6154" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_misc.at:6155: \$COMPILE_MODULE -fnot-reserved=double,float,new,volatile callee2.cob" -at_fn_check_prepare_dynamic "$COMPILE_MODULE -fnot-reserved=double,float,new,volatile callee2.cob" "run_misc.at:6155" -( $at_check_trace; $COMPILE_MODULE -fnot-reserved=double,float,new,volatile callee2.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:6155" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_misc.at:6156: \$COMPILE -fnot-reserved=double,float,new,volatile -o prog caller.cob" -at_fn_check_prepare_dynamic "$COMPILE -fnot-reserved=double,float,new,volatile -o prog caller.cob" "run_misc.at:6156" -( $at_check_trace; $COMPILE -fnot-reserved=double,float,new,volatile -o prog caller.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:6156" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_misc.at:6157: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_misc.at:6157" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:6157" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_643 -#AT_START_644 -at_fn_group_banner 644 'run_misc.at:6162' \ - "ON EXCEPTION clause of DISPLAY" " " 4 -at_xfail=no -( - $as_echo "644. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -{ set +x -$as_echo "$at_srcdir/run_misc.at:6165: test \"\$COB_HAS_CURSES\" = \"yes\" || exit 77" -at_fn_check_prepare_dynamic "test \"$COB_HAS_CURSES\" = \"yes\" || exit 77" "run_misc.at:6165" -( $at_check_trace; test "$COB_HAS_CURSES" = "yes" || exit 77 -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:6165" -$at_failed && at_fn_log_failure -$at_traceon; } - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - - PROCEDURE DIVISION. - DISPLAY "hello" AT COLUMN 500 - ON EXCEPTION - GOBACK RETURNING 0 - NOT ON EXCEPTION - GOBACK RETURNING 1 - END-DISPLAY - . -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_misc.at:6181: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_misc.at:6181" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:6181" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_misc.at:6182: COB_EXIT_WAIT=0 ./prog" -at_fn_check_prepare_trace "run_misc.at:6182" -( $at_check_trace; COB_EXIT_WAIT=0 ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo stdout:; cat "$at_stdout" -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:6182" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_644 -#AT_START_645 -at_fn_group_banner 645 'run_misc.at:6187' \ - "EC-SCREEN-LINE-NUMBER and -STARTING-COLUMN" " " 4 -at_xfail=no -( - $as_echo "645. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -{ set +x -$as_echo "$at_srcdir/run_misc.at:6190: test \"\$COB_HAS_CURSES\" = \"yes\" || exit 77" -at_fn_check_prepare_dynamic "test \"$COB_HAS_CURSES\" = \"yes\" || exit 77" "run_misc.at:6190" -( $at_check_trace; test "$COB_HAS_CURSES" = "yes" || exit 77 -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:6190" -$at_failed && at_fn_log_failure -$at_traceon; } - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - - DATA DIVISION. - SCREEN SECTION. - 01 invalid-line. - 03 a VALUE "a" LINE 99999999. - 01 invalid-col. - 03 c VALUE "c" COLUMN 99999999. - - PROCEDURE DIVISION. - DISPLAY invalid-line END-DISPLAY - IF FUNCTION EXCEPTION-STATUS = "EC-SCREEN-LINE-NUMBER" - CONTINUE - ELSE - GOBACK RETURNING 1 - END-IF - - DISPLAY invalid-col END-DISPLAY - IF FUNCTION EXCEPTION-STATUS = "EC-SCREEN-STARTING-COLUMN" - CONTINUE - ELSE - GOBACK RETURNING 2 - END-IF - - GOBACK RETURNING 0 - . -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_misc.at:6222: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_misc.at:6222" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:6222" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_misc.at:6223: COB_EXIT_WAIT=0 ./prog" -at_fn_check_prepare_trace "run_misc.at:6223" -( $at_check_trace; COB_EXIT_WAIT=0 ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo stdout:; cat "$at_stdout" -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:6223" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_645 -#AT_START_646 -at_fn_group_banner 646 'run_misc.at:6228' \ - "LINE/COLUMN 0 exceptions" " " 4 -at_xfail=no -( - $as_echo "646. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -{ set +x -$as_echo "$at_srcdir/run_misc.at:6231: test \"\$COB_HAS_CURSES\" = \"yes\" || exit 77" -at_fn_check_prepare_dynamic "test \"$COB_HAS_CURSES\" = \"yes\" || exit 77" "run_misc.at:6231" -( $at_check_trace; test "$COB_HAS_CURSES" = "yes" || exit 77 -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:6231" -$at_failed && at_fn_log_failure -$at_traceon; } - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 zero-var PIC 9 VALUE 0. - - SCREEN SECTION. - 01 scr. - 03 VALUE "a". - - PROCEDURE DIVISION. - DISPLAY scr AT LINE zero-var - IF FUNCTION EXCEPTION-STATUS <> "EC-SCREEN-LINE-NUMBER" - GOBACK RETURNING 1 - END-IF - - DISPLAY scr AT COLUMN zero-var - IF FUNCTION EXCEPTION-STATUS <> "EC-SCREEN-STARTING-COLUMN" - GOBACK RETURNING 2 - END-IF - - GOBACK RETURNING 0 - . -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_misc.at:6260: \$COMPILE -faccept-display-extensions=error prog.cob" -at_fn_check_prepare_dynamic "$COMPILE -faccept-display-extensions=error prog.cob" "run_misc.at:6260" -( $at_check_trace; $COMPILE -faccept-display-extensions=error prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:6260" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_misc.at:6261: COB_EXIT_WAIT=0 ./prog" -at_fn_check_prepare_trace "run_misc.at:6261" -( $at_check_trace; COB_EXIT_WAIT=0 ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo stdout:; cat "$at_stdout" -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:6261" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_646 -#AT_START_647 -at_fn_group_banner 647 'run_misc.at:6266' \ - "SET LAST EXCEPTION TO OFF" " " 4 -at_xfail=no -( - $as_echo "647. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 x PIC 9. - - PROCEDURE DIVISION. - COMPUTE x = 10 - DISPLAY FUNCTION TRIM(FUNCTION EXCEPTION-STATUS) - DISPLAY FUNCTION TRIM(FUNCTION EXCEPTION-LOCATION) - DISPLAY FUNCTION TRIM(FUNCTION EXCEPTION-STATUS) - DISPLAY FUNCTION TRIM(FUNCTION EXCEPTION-LOCATION) - SET LAST EXCEPTION TO OFF - DISPLAY FUNCTION TRIM(FUNCTION EXCEPTION-STATUS) - DISPLAY FUNCTION TRIM(FUNCTION EXCEPTION-LOCATION) - . -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_misc.at:6289: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_misc.at:6289" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:6289" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_misc.at:6290: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_misc.at:6290" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo "EC-SIZE-OVERFLOW -prog; ; 10 -EC-SIZE-OVERFLOW -prog; ; 10 - - -" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:6290" -$at_failed && at_fn_log_failure -$at_traceon; } - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_647 -#AT_START_648 -at_fn_group_banner 648 'run_misc.at:6302' \ - "void PROCEDURE" " " 4 -at_xfail=no -( - $as_echo "648. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >callee.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. callee. - DATA DIVISION. - PROCEDURE DIVISION RETURNING OMITTED. - MOVE 42 TO RETURN-CODE - EXIT PROGRAM. -_ATEOF - - -cat >caller.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. caller. - PROCEDURE DIVISION. - CALL "callee" RETURNING OMITTED - END-CALL. - DISPLAY RETURN-CODE WITH NO ADVANCING - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_misc.at:6324: \$COMPILE_MODULE callee.cob" -at_fn_check_prepare_dynamic "$COMPILE_MODULE callee.cob" "run_misc.at:6324" -( $at_check_trace; $COMPILE_MODULE callee.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:6324" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_misc.at:6325: \$COMPILE caller.cob" -at_fn_check_prepare_dynamic "$COMPILE caller.cob" "run_misc.at:6325" -( $at_check_trace; $COMPILE caller.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:6325" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_misc.at:6326: \$COBCRUN_DIRECT ./caller" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./caller" "run_misc.at:6326" -( $at_check_trace; $COBCRUN_DIRECT ./caller -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo "+000000000" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:6326" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_648 -#AT_START_649 -at_fn_group_banner 649 'run_misc.at:6331' \ - "Figurative constants to numeric field" " " 4 -at_xfail=no -( - $as_echo "649. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 NUM9 PIC 9(6). - PROCEDURE DIVISION. - MOVE SPACES TO NUM9 - DISPLAY "NUM9 value SPACES is " NUM9 "." UPON SYSOUT - MOVE LOW-VALUES TO NUM9 - IF NUM9 = LOW-VALUES - DISPLAY "9(6) tests OK for LOW-VALUES" UPON SYSOUT - ELSE - DISPLAY "9(6) Does NOT test OK for LOW-VALUES" - UPON SYSOUT - IF NUM9 = ZERO - DISPLAY "9(6) tests as ZERO instead of LOW-VALUES" - UPON SYSOUT - END-IF - END-IF. - MOVE HIGH-VALUES TO NUM9 - IF NUM9 = HIGH-VALUES - DISPLAY "9(6) tests OK for HIGH-VALUES" UPON SYSOUT - ELSE - DISPLAY "9(6) Does NOT test OK for HIGH-VALUES" - UPON SYSOUT - IF NUM9 = ZERO - DISPLAY "9(6) tests as ZERO instead of HIGH-VALUES" - UPON SYSOUT - END-IF - END-IF. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_misc.at:6368: \$COMPILE -std=mf prog.cob" -at_fn_check_prepare_dynamic "$COMPILE -std=mf prog.cob" "run_misc.at:6368" -( $at_check_trace; $COMPILE -std=mf prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob:8: warning: source is non-numeric - substituting zero -prog.cob:10: warning: source is non-numeric - substituting zero -prog.cob:21: warning: source is non-numeric - substituting zero -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:6368" -$at_failed && at_fn_log_failure -$at_traceon; } - - -{ set +x -$as_echo "$at_srcdir/run_misc.at:6374: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_misc.at:6374" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo "NUM9 value SPACES is 000000. -9(6) Does NOT test OK for LOW-VALUES -9(6) tests as ZERO instead of LOW-VALUES -9(6) Does NOT test OK for HIGH-VALUES -9(6) tests as ZERO instead of HIGH-VALUES -" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:6374" -$at_failed && at_fn_log_failure -$at_traceon; } - - -{ set +x -$as_echo "$at_srcdir/run_misc.at:6382: \$COMPILE -std=acu prog.cob -o aprog" -at_fn_check_prepare_dynamic "$COMPILE -std=acu prog.cob -o aprog" "run_misc.at:6382" -( $at_check_trace; $COMPILE -std=acu prog.cob -o aprog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:6382" -$at_failed && at_fn_log_failure -$at_traceon; } - - -{ set +x -$as_echo "$at_srcdir/run_misc.at:6384: \$COBCRUN_DIRECT ./aprog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./aprog" "run_misc.at:6384" -( $at_check_trace; $COBCRUN_DIRECT ./aprog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo "NUM9 value SPACES is . -9(6) tests OK for LOW-VALUES -9(6) tests OK for HIGH-VALUES -" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:6384" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_649 -#AT_START_650 -at_fn_group_banner 650 'run_misc.at:6393' \ - "MF FIGURATIVE to NUMERIC" " " 4 -at_xfail=no -( - $as_echo "650. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -# FIXME: This test will NOT work on EBCDIC machines, -# either add it explicit here and split into two or add -# a pre-test and check the expected "native" result - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 MYFLD PIC 9(4) VALUE 96. - 01 BIGFLT COMP-1 VALUE 543.12345E10. - PROCEDURE DIVISION. - MAIN-1. - DISPLAY "Initial value" - PERFORM SHOW-IT. - DISPLAY "MOVE BIGFLT" - MOVE BIGFLT TO MYFLD. - PERFORM SHOW-IT. - DISPLAY "MOVE SPACES" - MOVE SPACES TO MYFLD. - PERFORM SHOW-IT. - DISPLAY "MOVE LOW-VALUES" - MOVE LOW-VALUES TO MYFLD. - PERFORM SHOW-IT. - DISPLAY "MOVE HIGH-VALUES" - MOVE HIGH-VALUES TO MYFLD. - PERFORM SHOW-IT. - DISPLAY "MOVE QUOTE" - MOVE QUOTE TO MYFLD. - PERFORM SHOW-IT. - DISPLAY "MOVE ALL *" - MOVE ALL '*' TO MYFLD. - PERFORM SHOW-IT. - DISPLAY "MOVE ALL 0" - MOVE ALL '0' TO MYFLD. - PERFORM SHOW-IT. - DISPLAY "MOVE ALL 'A1'" - MOVE ALL 'A1' TO MYFLD. - PERFORM SHOW-IT. - DISPLAY "MOVE ALL '21'" - MOVE ALL '21' TO MYFLD. - PERFORM SHOW-IT. - DISPLAY "MOVE HIGH-VALUES TO (1:)" - MOVE HIGH-VALUES TO MYFLD (1:). - PERFORM SHOW-IT. - - DISPLAY "MOVE HIGH-VALUES TO BIGFLT" - MOVE HIGH-VALUES TO BIGFLT. - PERFORM SHOW-BIG. - CALL "dump" USING BIGFLT. - DISPLAY "MOVE QUOTE TO BIGFLT" - MOVE QUOTE TO BIGFLT. - PERFORM SHOW-BIG. - CALL "dump" USING BIGFLT. - DISPLAY "MOVE ALL * TO BIGFLT" - MOVE ALL '*' TO BIGFLT. - PERFORM SHOW-BIG. - *> Note: the next results are dependant on endianess - *> therefore no dump here - DISPLAY "MOVE ALL '21' TO BIGFLT" - MOVE ALL '21' TO BIGFLT. - PERFORM SHOW-BIG. - STOP RUN. - SHOW-IT. - CALL "dump" USING MYFLD. - SHOW-BIG. - DISPLAY "BIGFLT is " BIGFLT. -_ATEOF - - -cat >cmod.c <<'_ATEOF' - -#include -#include - -COB_EXT_EXPORT int -dump (unsigned char *data) -{ - int i; - for (i = 0; i < 4; i++) - printf ("%02X", data[i]); - puts (" ."); - return 0; -} -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_misc.at:6480: \$COMPILE -std=mf -fno-move-non-numeric-lit-to-numeric-is-zero prog.cob cmod.c" -at_fn_check_prepare_dynamic "$COMPILE -std=mf -fno-move-non-numeric-lit-to-numeric-is-zero prog.cob cmod.c" "run_misc.at:6480" -( $at_check_trace; $COMPILE -std=mf -fno-move-non-numeric-lit-to-numeric-is-zero prog.cob cmod.c -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob: in paragraph 'MAIN-1': -prog.cob:28: warning: numeric value is expected -prog.cob:6: warning: 'MYFLD' defined here as PIC 9(4) -prog.cob:34: warning: numeric value is expected -prog.cob:6: warning: 'MYFLD' defined here as PIC 9(4) -prog.cob:52: warning: numeric value is expected -prog.cob:7: warning: 'BIGFLT' defined here as USAGE FLOAT -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:6480" -$at_failed && at_fn_log_failure -$at_traceon; } - - -{ set +x -$as_echo "$at_srcdir/run_misc.at:6490: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_misc.at:6490" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo "Initial value -30303936 . -MOVE BIGFLT -38333034 . -MOVE SPACES -20202020 . -MOVE LOW-VALUES -00000000 . -MOVE HIGH-VALUES -FFFFFFFF . -MOVE QUOTE -22222222 . -MOVE ALL * -2A2A2A2A . -MOVE ALL 0 -30303030 . -MOVE ALL 'A1' -41314131 . -MOVE ALL '21' -32313231 . -MOVE HIGH-VALUES TO (1:) -FFFFFFFF . -MOVE HIGH-VALUES TO BIGFLT -BIGFLT is NaN -FFFFFFFF . -MOVE QUOTE TO BIGFLT -BIGFLT is 2.1973164E-18 -22222222 . -MOVE ALL * TO BIGFLT -BIGFLT is 5.4312347E+12 -MOVE ALL '21' TO BIGFLT -BIGFLT is 2.1212121E+37 -" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:6490" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_650 -#AT_START_651 -at_fn_group_banner 651 'run_misc.at:6529' \ - "void PROCEDURE, NOTHING return" " " 4 -at_xfail=no -( - $as_echo "651. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >callee.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. callee. - DATA DIVISION. - PROCEDURE DIVISION RETURNING OMITTED. - MOVE 42 TO RETURN-CODE - EXIT PROGRAM. -_ATEOF - - -cat >caller.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. caller. - PROCEDURE DIVISION. - MOVE 42 TO RETURN-CODE - CALL "callee" RETURNING NOTHING - END-CALL. - DISPLAY RETURN-CODE WITH NO ADVANCING - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_misc.at:6552: \$COMPILE_MODULE callee.cob" -at_fn_check_prepare_dynamic "$COMPILE_MODULE callee.cob" "run_misc.at:6552" -( $at_check_trace; $COMPILE_MODULE callee.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:6552" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_misc.at:6553: \$COMPILE caller.cob" -at_fn_check_prepare_dynamic "$COMPILE caller.cob" "run_misc.at:6553" -( $at_check_trace; $COMPILE caller.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:6553" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_misc.at:6554: \$COBCRUN_DIRECT ./caller" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./caller" "run_misc.at:6554" -( $at_check_trace; $COBCRUN_DIRECT ./caller -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo "+000000042" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 42 $at_status "$at_srcdir/run_misc.at:6554" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_651 -#AT_START_652 -at_fn_group_banner 652 'run_misc.at:6559' \ - "C API Test" " " 4 -at_xfail=no -( - $as_echo "652. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 BIN5FLD PIC 9(5) COMP-5 VALUE 5555. - 01 BINFLD5S PIC S9(5) BINARY VALUE 4444. - 01 BINFLD9 PIC 9(9) BINARY VALUE 6666. - 01 COMP3 PIC 9(8) COMP-3 VALUE 3333. - 01 COMP3V99 PIC S9(7)V99 COMP-3 VALUE 12.50. - 01 PIC9 PIC S9(8) DISPLAY VALUE 8888. - 01 NE PIC Z(4)9.99-. - 01 CHRX PIC X(9) VALUE 'Hello'. - 01 GRPX. - 05 FILLER PIC X(9) VALUE 'Hello'. - 05 FILLER PIC X(9) VALUE 'World'. - 01 MYOCC PIC 9(8) COMP. - 01 MYTAB. - 03 MYBYTE PIC XX OCCURS 1 TO 20 - DEPENDING ON MYOCC. - - PROCEDURE DIVISION. - MOVE -512.77 TO NE. - CALL "CAPI" USING BY CONTENT - FUNCTION CONCATENATE("ABC" "DEF"). - CALL "CAPI" USING 2560 BY VALUE 16. - CALL "CAPI" USING BIN5FLD, NE. - CALL "CAPI" USING BINFLD5S. - CALL "CAPI" USING BINFLD9. - CALL "CAPI" USING BY CONTENT BIN5FLD, NE. - CALL "CAPI" USING BY CONTENT BIN5FLD, NE. - CALL "CAPI" USING BY CONTENT BINFLD5S. - CALL "CAPI" USING BY CONTENT BINFLD5S. - CALL "CAPI" USING BY CONTENT BINFLD9. - CALL "CAPI" USING BY CONTENT BINFLD9. - CALL "CAPI" USING BY VALUE BIN5FLD, NE. - CALL "CAPI" USING BY VALUE BIN5FLD, NE. - CALL "CAPI" USING BY VALUE BINFLD5S. - CALL "CAPI" USING BY VALUE BINFLD5S. - CALL "CAPI" USING BY VALUE BINFLD9. - CALL "CAPI" USING BY VALUE BINFLD9. - MOVE 512.77 TO NE. - CALL "CAPI" USING COMP3, NE. - DISPLAY "GRPX was " GRPX ";". - CALL "CAPI" USING PIC9 BINFLD5S CHRX GRPX. - DISPLAY "GRPX is now " GRPX ";". - CALL "CAPI" USING COMP3, NE, CHRX. - CALL "CAPI" USING BIN5FLD, NE. - MOVE "Hello!" TO CHRX. - DISPLAY "BIN5FLD BY VALUE & " CHRX ";". - CALL "CAPI" USING BY VALUE BIN5FLD, CHRX. - CALL "CAPI" USING BY VALUE BIN5FLD, CHRX. - CALL "CAPI" USING LENGTH OF GRPX. - MOVE "Anyone out there?" TO GRPX. - DISPLAY "GRPX was " GRPX ";". - CALL "CAPI" USING BY VALUE GRPX LENGTH OF GRPX. - DISPLAY "GRPX is now " GRPX ";". - CALL "CAPI" USING "Fred Fish", COMP3. - CALL "CAPI" USING COMP3V99. - CALL "CAPI" . - DISPLAY "COMP3 is now " COMP3 ";". - DISPLAY "COMP4 is now " BIN5FLD ";". - DISPLAY "BINFLD5S is now " BINFLD5S ";". - DISPLAY "CHRX is now " CHRX ";". - DISPLAY "NE is now " NE ";". - MOVE 9 TO MYOCC. - CALL "CAPI" USING BY CONTENT 1. - CALL "CAPI" USING BY VALUE 1. - CALL "CAPI" USING BY REFERENCE 1. - DISPLAY "Now BY CONTENT LENGTH OF MYTAB;". - CALL "CAPI" USING BY CONTENT LENGTH OF MYTAB. - DISPLAY "Now BY CONTENT LENGTH OF MYOCC;". - CALL "CAPI" USING BY CONTENT LENGTH OF MYOCC. - MOVE 7 TO MYOCC. - DISPLAY "Now LENGTH OF MYTAB;". - CALL "CAPI" USING LENGTH OF MYTAB. - DISPLAY "Now LENGTH OF MYOCC;". - CALL "CAPI" USING LENGTH OF MYOCC. - MOVE 5 TO MYOCC. - DISPLAY "Now BY VALUE LENGTH OF MYTAB;". - CALL "CAPI" USING BY VALUE LENGTH OF MYTAB. - DISPLAY "Now BY VALUE LENGTH OF MYOCC;". - CALL "CAPI" USING BY VALUE LENGTH OF MYOCC. - STOP RUN. -_ATEOF - - -cat >cmod.c <<'_ATEOF' - -#include -#include -#include - -static char * -getType(int type, int byvalue) -{ - static char wrk[24]; - switch (type) { - case COB_TYPE_GROUP: return "Group"; - case COB_TYPE_NUMERIC_COMP5: return byvalue==2?"COMP-4":"COMP-5"; - case COB_TYPE_NUMERIC_BINARY: return "COMP-4"; - case COB_TYPE_NUMERIC_PACKED: return "COMP-3"; - case COB_TYPE_NUMERIC_FLOAT: return "COMP-1"; - case COB_TYPE_NUMERIC_DOUBLE: return "COMP-2"; - case COB_TYPE_NUMERIC_DISPLAY: return "DISPLAY"; - case COB_TYPE_ALPHANUMERIC: return "X"; - case COB_TYPE_NUMERIC_EDITED: return "EDITED"; - } - sprintf(wrk,"Type %04X",type); - return wrk; -} - -int -CAPI(void *p1, ...) -{ - int k,nargs,type,digits,scale,size,sign,byvalue; - cob_s64_t val; - char *str, wrk[80],pic[24]; - - nargs = cob_get_num_params(); - if ((k = cob_get_name_line (wrk, NULL)) > 0) { - printf("Line%3d: ",k); - } - printf("CALL with %d parameters\n",nargs); - for(k=1; k <= nargs; k++) { - type = cob_get_param_type (k); - digits = cob_get_param_digits (k); - scale = cob_get_param_scale (k); - size = cob_get_param_size (k); - sign = cob_get_param_sign (k); - byvalue = cob_get_param_constant(k); - printf(" P%d: %-8s ",k,getType(type,byvalue)); - if (byvalue == 3) - printf("BY CONTENT "); - else if (byvalue == 2) - printf("BY VALUE "); - else if (byvalue == 1) - printf("LITERAL "); - else - printf("BY REFERENCE "); - if (type == COB_TYPE_ALPHANUMERIC) { - sprintf(pic,"X(%d)",size); - str = cob_get_picx_param (k, NULL, 0); - printf("%-11s '%s'",pic,str); - cob_free ((void*)str); - cob_put_picx_param (k, "Bye!"); - } else if (type == COB_TYPE_GROUP) { - sprintf(pic,"(%d)",size); - str = cob_get_grp_param (k, NULL, 0); - printf("%-11s '%.*s'",pic,size,str); - cob_free ((void*)str); - memset(wrk,' ',sizeof(wrk)); - memcpy(wrk,"Bye-Bye Birdie!",15); - cob_put_grp_param (k, wrk, sizeof(wrk)); - str = cob_get_grp_param (k, NULL, 0); - printf(" --> '%.*s'",size,str); - cob_free ((void*)str); - } else if (type == COB_TYPE_NUMERIC_EDITED) { - if(scale > 0) { - sprintf(pic,"%s9(%d)V9(%d)",sign?"S":"",digits-scale,scale); - } else { - sprintf(pic,"%s9(%d)",sign?"S":"",digits-scale); - } - val = cob_get_s64_param (k); - printf("%-11s %lld ",pic,val); - val = val + 130; - val = -val; - cob_put_s64_param (k, val); - cob_get_grp_param (k, wrk, sizeof(wrk)); - printf(" to %.*s",size,wrk); - } else { - if(scale > 0) { - sprintf(pic,"%s9(%d)V9(%d)",sign?"S":"",digits-scale,scale); - } else { - sprintf(pic,"%s9(%d)",sign?"S":"",digits-scale); - } - val = cob_get_s64_param (k); - printf("%-11s %lld",pic,val); - cob_put_s64_param (k, val + 3); - } - printf(";\n"); - fflush(stdout); - } - if (nargs > 2) - cob_put_s64_param (7, val + 3); - return 0; -} -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_misc.at:6750: cobc -x -std=mf -Wall -debug -fstatic-call prog.cob cmod.c" -at_fn_check_prepare_trace "run_misc.at:6750" -( $at_check_trace; cobc -x -std=mf -Wall -debug -fstatic-call prog.cob cmod.c -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob:37: warning: BY CONTENT assumed for alphanumeric item 'NE' -prog.cob:38: warning: BY CONTENT assumed for alphanumeric item 'NE' -prog.cob:52: warning: BY CONTENT assumed for alphanumeric item 'CHRX' -prog.cob:53: warning: BY CONTENT assumed for alphanumeric item 'CHRX' -prog.cob:57: warning: BY CONTENT assumed for alphanumeric item 'GRPX' -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:6750" -$at_failed && at_fn_log_failure -$at_traceon; } - - -{ set +x -$as_echo "$at_srcdir/run_misc.at:6757: ./prog" -at_fn_check_prepare_trace "run_misc.at:6757" -( $at_check_trace; ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "libcob: prog.cob:27: warning: cob_put_s64_param: attempt to over-write constant parameter 1 with 2563 -libcob: prog.cob:27: warning: cob_put_s64_param: attempt to over-write constant parameter 2 with 19 -libcob: prog.cob:46: warning: cob_put_s64_param: parameter 7 is not within range of 4 -libcob: prog.cob:48: warning: cob_put_s64_param: parameter 7 is not within range of 3 -libcob: prog.cob:54: warning: cob_put_s64_param: attempt to over-write constant parameter 1 with 21 -libcob: prog.cob:57: warning: cob_put_s64_param: attempt to over-write constant parameter 2 with 21 -libcob: prog.cob:59: warning: cob_put_picx_param: attempt to over-write constant parameter 1 with 'Bye!' -libcob: prog.cob:68: warning: cob_put_s64_param: attempt to over-write constant parameter 1 with 4 -libcob: prog.cob:69: warning: cob_put_s64_param: attempt to over-write constant parameter 1 with 4 -libcob: prog.cob:70: warning: cob_put_s64_param: attempt to over-write constant parameter 1 with 4 -libcob: prog.cob:72: warning: cob_put_s64_param: attempt to over-write constant parameter 1 with 21 -libcob: prog.cob:74: warning: cob_put_s64_param: attempt to over-write constant parameter 1 with 7 -libcob: prog.cob:77: warning: cob_put_s64_param: attempt to over-write constant parameter 1 with 17 -libcob: prog.cob:79: warning: cob_put_s64_param: attempt to over-write constant parameter 1 with 7 -libcob: prog.cob:84: warning: cob_put_s64_param: attempt to over-write constant parameter 1 with 7 -" | \ - $at_diff - "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo "Line 25: CALL with 1 parameters - P1: X BY REFERENCE X(6) 'ABCDEF'; -Line 27: CALL with 2 parameters - P1: COMP-4 LITERAL S9(9) 2560; - P2: DISPLAY BY VALUE 9(2) 16; -Line 28: CALL with 2 parameters - P1: COMP-5 BY REFERENCE 9(5) 5555; - P2: EDITED BY REFERENCE S9(5)V9(2) -51277 to 511.47 ; -Line 29: CALL with 1 parameters - P1: COMP-4 BY REFERENCE S9(5) 4444; -Line 30: CALL with 1 parameters - P1: COMP-4 BY REFERENCE 9(9) 6666; -Line 31: CALL with 2 parameters - P1: COMP-5 BY CONTENT 9(5) 5558; - P2: EDITED BY CONTENT S9(5)V9(2) 51147 to 512.77-; -Line 32: CALL with 2 parameters - P1: COMP-5 BY CONTENT 9(5) 5558; - P2: EDITED BY CONTENT S9(5)V9(2) 51147 to 512.77-; -Line 33: CALL with 1 parameters - P1: COMP-4 BY CONTENT S9(5) 4447; -Line 34: CALL with 1 parameters - P1: COMP-4 BY CONTENT S9(5) 4447; -Line 35: CALL with 1 parameters - P1: COMP-4 BY CONTENT 9(9) 6669; -Line 36: CALL with 1 parameters - P1: COMP-4 BY CONTENT 9(9) 6669; -Line 37: CALL with 2 parameters - P1: COMP-4 BY VALUE 9(5) 5558; - P2: EDITED BY CONTENT S9(5)V9(2) 51147 to 512.77-; -Line 38: CALL with 2 parameters - P1: COMP-4 BY VALUE 9(5) 5558; - P2: EDITED BY CONTENT S9(5)V9(2) 51147 to 512.77-; -Line 39: CALL with 1 parameters - P1: COMP-4 BY VALUE S9(5) 4447; -Line 40: CALL with 1 parameters - P1: COMP-4 BY VALUE S9(5) 4447; -Line 41: CALL with 1 parameters - P1: COMP-4 BY VALUE 9(9) 6669; -Line 42: CALL with 1 parameters - P1: COMP-4 BY VALUE 9(9) 6669; -Line 44: CALL with 2 parameters - P1: COMP-3 BY REFERENCE 9(8) 3333; - P2: EDITED BY REFERENCE S9(5)V9(2) 51277 to 514.07-; -GRPX was Hello World ; -Line 46: CALL with 4 parameters - P1: DISPLAY BY REFERENCE S9(8) 8888; - P2: COMP-4 BY REFERENCE S9(5) 4447; - P3: X BY REFERENCE X(9) 'Hello'; - P4: Group BY REFERENCE (18) 'Hello World ' --> 'Bye-Bye Birdie! '; -GRPX is now Bye-Bye Birdie! ; -Line 48: CALL with 3 parameters - P1: COMP-3 BY REFERENCE 9(8) 3336; - P2: EDITED BY REFERENCE S9(5)V9(2) -51407 to 512.77 ; - P3: X BY REFERENCE X(9) 'Bye!'; -Line 49: CALL with 2 parameters - P1: COMP-5 BY REFERENCE 9(5) 5558; - P2: EDITED BY REFERENCE S9(5)V9(2) 51277 to 514.07-; -BIN5FLD BY VALUE & Hello! ; -Line 52: CALL with 2 parameters - P1: COMP-4 BY VALUE 9(5) 5561; - P2: X BY CONTENT X(9) 'Hello!'; -Line 53: CALL with 2 parameters - P1: COMP-4 BY VALUE 9(5) 5561; - P2: X BY CONTENT X(9) 'Hello!'; -Line 54: CALL with 1 parameters - P1: COMP-4 LITERAL S9(9) 18; -GRPX was Anyone out there? ; -Line 57: CALL with 2 parameters - P1: Group BY CONTENT (18) 'Anyone out there? ' --> 'Bye-Bye Birdie! '; - P2: DISPLAY BY VALUE 9(2) 18; -GRPX is now Anyone out there? ; -Line 59: CALL with 2 parameters - P1: X BY CONTENT X(9) 'Fred Fish'; - P2: COMP-3 BY REFERENCE 9(8) 3339; -Line 60: CALL with 1 parameters - P1: COMP-3 BY REFERENCE S9(7)V9(2) 1250; -Line 61: CALL with 0 parameters -COMP3 is now 00003342; -COMP4 is now 00005561; -BINFLD5S is now +04450; -CHRX is now Hello! ; -NE is now 514.07-; -Line 68: CALL with 1 parameters - P1: COMP-4 LITERAL S9(9) 1; -Line 69: CALL with 1 parameters - P1: DISPLAY BY VALUE 9(1) 1; -Line 70: CALL with 1 parameters - P1: COMP-4 LITERAL S9(9) 1; -Now BY CONTENT LENGTH OF MYTAB; -Line 72: CALL with 1 parameters - P1: COMP-4 LITERAL 9(9) 18; -Now BY CONTENT LENGTH OF MYOCC; -Line 74: CALL with 1 parameters - P1: COMP-4 LITERAL S9(9) 4; -Now LENGTH OF MYTAB; -Line 77: CALL with 1 parameters - P1: COMP-4 LITERAL 9(9) 14; -Now LENGTH OF MYOCC; -Line 79: CALL with 1 parameters - P1: COMP-4 LITERAL S9(9) 4; -Now BY VALUE LENGTH OF MYTAB; -Line 82: CALL with 1 parameters - P1: COMP-4 BY VALUE 9(9) 10; -Now BY VALUE LENGTH OF MYOCC; -Line 84: CALL with 1 parameters - P1: DISPLAY BY VALUE 9(1) 4; -" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:6757" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_652 -#AT_START_653 -at_fn_group_banner 653 'run_misc.at:6883' \ - "CALL with program prototypes" " " 4 -at_xfail=no -( - $as_echo "653. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - - PROCEDURE DIVISION. - CALL "c" - . - END PROGRAM prog. - - - IDENTIFICATION DIVISION. - PROGRAM-ID. a AS "blah?Sdk". - - PROCEDURE DIVISION. - DISPLAY "Hello!" - . - END PROGRAM a. - - - IDENTIFICATION DIVISION. - PROGRAM-ID. b. - - PROCEDURE DIVISION. - DISPLAY "Hello again!" - . - END PROGRAM b. - - - IDENTIFICATION DIVISION. - PROGRAM-ID. c. - - ENVIRONMENT DIVISION. - CONFIGURATION SECTION. - REPOSITORY. - PROGRAM d AS "blah?Sdk" - PROGRAM b - . - - PROCEDURE DIVISION. - CALL d - CALL b - . - END PROGRAM c. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_misc.at:6931: \$COMPILE -o prog prog.cob" -at_fn_check_prepare_dynamic "$COMPILE -o prog prog.cob" "run_misc.at:6931" -( $at_check_trace; $COMPILE -o prog prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:6931" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_misc.at:6932: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_misc.at:6932" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo "Hello! -Hello again! -" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:6932" -$at_failed && at_fn_log_failure -$at_traceon; } - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_653 -#AT_START_654 -at_fn_group_banner 654 'run_misc.at:6939' \ - "REDEFINES values on FILLER and INITIALIZE" " " 4 -at_xfail=no -( - $as_echo "654. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 TSRDF. - 05 WS-ASK-ID-DATE PIC X(10) VALUE ALL '*'. - 05 WS-ASK-ID-DATE-R REDEFINES WS-ASK-ID-DATE. - 10 WS-ASK-ID-DATE-YYYY PIC 9(4) VALUE 2017. - 10 FILLER PIC X VALUE '-'. - 10 WS-ASK-ID-DATE-MM PIC 9(2). - 10 FILLER PIC X VALUE '-'. - 10 WS-ASK-ID-DATE-DD PIC 9(2). - PROCEDURE DIVISION. - MOVE 2015 TO WS-ASK-ID-DATE-YYYY - MOVE 08 TO WS-ASK-ID-DATE-MM - MOVE 21 TO WS-ASK-ID-DATE-DD - DISPLAY "The date is " WS-ASK-ID-DATE " Compiled". - - INITIALIZE WS-ASK-ID-DATE-R. - MOVE 08 TO WS-ASK-ID-DATE-MM - MOVE 21 TO WS-ASK-ID-DATE-DD - DISPLAY "The date is " WS-ASK-ID-DATE " INITIALIZE". - - INITIALIZE WS-ASK-ID-DATE-R WITH FILLER. - MOVE 08 TO WS-ASK-ID-DATE-MM - MOVE 21 TO WS-ASK-ID-DATE-DD - DISPLAY "The date is " WS-ASK-ID-DATE " WITH FILLER". - - INITIALIZE WS-ASK-ID-DATE-R WITH FILLER ALL TO VALUE. - MOVE 08 TO WS-ASK-ID-DATE-MM - MOVE 21 TO WS-ASK-ID-DATE-DD - DISPLAY "The date is " WS-ASK-ID-DATE " ALL TO VALUE". - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_misc.at:6978: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_misc.at:6978" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob:9: warning: initial VALUE clause ignored for REDEFINES item 'WS-ASK-ID-DATE-YYYY' -prog.cob:10: warning: initial VALUE clause ignored for REDEFINES item 'FILLER' -prog.cob:12: warning: initial VALUE clause ignored for REDEFINES item 'FILLER' -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:6978" -$at_failed && at_fn_log_failure -$at_traceon; } - - -{ set +x -$as_echo "$at_srcdir/run_misc.at:6984: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_misc.at:6984" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo "The date is 2015*08*21 Compiled -The date is 0000*08*21 INITIALIZE -The date is 0000 08 21 WITH FILLER -The date is 2017-08-21 ALL TO VALUE -" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:6984" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_654 -#AT_START_655 -at_fn_group_banner 655 'run_misc.at:6994' \ - "PICTURE with constant-name" " " 4 -at_xfail=no -( - $as_echo "655. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 foo-bar CONSTANT 8. - 01 x PIC 9(foo-bar)9(foo-bar). - - PROCEDURE DIVISION. - IF FUNCTION LENGTH (x) <> 16 - DISPLAY FUNCTION LENGTH (x) - END-IF - . - END PROGRAM prog. -_ATEOF - -# " <-- comment for fixing syntax highlighting - -{ set +x -$as_echo "$at_srcdir/run_misc.at:7015: \$COMPILE_ONLY prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY prog.cob" "run_misc.at:7015" -( $at_check_trace; $COMPILE_ONLY prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob:11: warning: expression '16' NOT EQUAL '16' is always FALSE -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:7015" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_misc.at:7018: \$COMPILE -fno-constant-folding prog.cob" -at_fn_check_prepare_dynamic "$COMPILE -fno-constant-folding prog.cob" "run_misc.at:7018" -( $at_check_trace; $COMPILE -fno-constant-folding prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:7018" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_misc.at:7019: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_misc.at:7019" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:7019" -$at_failed && at_fn_log_failure -$at_traceon; } - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_655 -#AT_START_656 -at_fn_group_banner 656 'run_misc.at:7023' \ - "Quote marks in comment paragraphs" " " 4 -at_xfail=no -( - $as_echo "656. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATE-written. hello'". - *> Written is intentionally lowercase. - *> extra " to fix syntax highlighting - PROCEDURE DIVISION. - DISPLAY "Hello, world!" - . -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_misc.at:7037: \$COMPILE -o prog prog.cob" -at_fn_check_prepare_dynamic "$COMPILE -o prog prog.cob" "run_misc.at:7037" -( $at_check_trace; $COMPILE -o prog prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob:4: warning: DATE-WRITTEN is obsolete in GnuCOBOL -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:7037" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_misc.at:7040: \$COMPILE -free -o prog prog.cob" -at_fn_check_prepare_dynamic "$COMPILE -free -o prog prog.cob" "run_misc.at:7040" -( $at_check_trace; $COMPILE -free -o prog prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob:3: warning: DATE-WRITTEN is obsolete in GnuCOBOL -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:7040" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_misc.at:7043: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_misc.at:7043" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo "Hello, world! -" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:7043" -$at_failed && at_fn_log_failure -$at_traceon; } - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_656 -#AT_START_657 -at_fn_group_banner 657 'run_misc.at:7049' \ - "Numeric MOVE with/without -fbinary-truncate" " " 4 -at_xfail=no -( - $as_echo "657. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 x PIC 9(4) COMP. - - PROCEDURE DIVISION. - MOVE 30000 TO x - PERFORM check-x-val - - COMPUTE x = 30000 - PERFORM check-x-val - - MOVE ZERO TO x - ADD 30000 TO x - PERFORM check-x-val - - GOBACK - . - check-x-val SECTION. - EVALUATE x - WHEN >= 10000 - DISPLAY "x >= 10000" - - WHEN ZERO - DISPLAY "x IS ZERO" - - WHEN OTHER - CONTINUE - END-EVALUATE - . - END PROGRAM prog. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_misc.at:7088: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_misc.at:7088" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob:10: warning: value size exceeds data size -prog.cob:10: warning: value is 30000 -prog.cob:7: warning: 'x' defined here as PIC 9(4) -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:7088" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_misc.at:7093: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_misc.at:7093" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo "x IS ZERO -x IS ZERO -x IS ZERO -" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:7093" -$at_failed && at_fn_log_failure -$at_traceon; } - - -{ set +x -$as_echo "$at_srcdir/run_misc.at:7099: \$COMPILE -fno-binary-truncate prog.cob" -at_fn_check_prepare_dynamic "$COMPILE -fno-binary-truncate prog.cob" "run_misc.at:7099" -( $at_check_trace; $COMPILE -fno-binary-truncate prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:7099" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_misc.at:7100: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_misc.at:7100" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo "x >= 10000 -x >= 10000 -x >= 10000 -" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:7100" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_657 -#AT_START_658 -at_fn_group_banner 658 'run_misc.at:7109' \ - "Alphanumeric MOVE with truncation" " " 4 -at_xfail=no -( - $as_echo "658. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 x-left PIC X(03). - 01 x-right PIC X(03) JUSTIFIED RIGHT. - - PROCEDURE DIVISION. - MOVE '1234' TO x-left, x-right - IF x-left not = '123' - OR x-right not = '234' - DISPLAY 'error with "1234":' - END-DISPLAY - DISPLAY x-left - END-DISPLAY - DISPLAY x-right - END-DISPLAY - END-IF - MOVE ' 3' TO x-left, x-right - IF x-left not = spaces - OR x-right not = ' 3' - DISPLAY 'error with " 3":' - END-DISPLAY - DISPLAY x-left - END-DISPLAY - DISPLAY x-right - END-DISPLAY - END-IF - MOVE '3 ' TO x-left, x-right - IF x-left not = '3' - OR x-right not = spaces - DISPLAY 'error with "3 ":' - END-DISPLAY - DISPLAY x-left - END-DISPLAY - DISPLAY x-right - END-DISPLAY - END-IF - . -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_misc.at:7155: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_misc.at:7155" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob:11: warning: value size exceeds data size -prog.cob:11: warning: value size is 4 -prog.cob:7: warning: 'x-left' defined here as PIC X(03) -prog.cob:11: warning: value size exceeds data size -prog.cob:11: warning: value size is 4 -prog.cob:8: warning: 'x-right' defined here as PIC X(03) -prog.cob:21: warning: value size exceeds data size -prog.cob:21: warning: value size is 4 -prog.cob:7: warning: 'x-left' defined here as PIC X(03) -prog.cob:31: warning: value size exceeds data size -prog.cob:31: warning: value size is 4 -prog.cob:8: warning: 'x-right' defined here as PIC X(03) -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:7155" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_misc.at:7169: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_misc.at:7169" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:7169" -$at_failed && at_fn_log_failure -$at_traceon; } - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_658 -#AT_START_659 -at_fn_group_banner 659 'run_misc.at:7173' \ - "PROGRAM-ID / CALL literal/variable with spaces" " " 4 -at_xfail=no -( - $as_echo "659. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 MYRTN PIC X(9) VALUE " SUB ". - - PROCEDURE DIVISION. - CALL " SUB " USING 'X'. - MOVE x'00' TO MYRTN (6:1). - CALL MYRTN USING 'Y'. - CALL "SUB" USING 'Z'. - CALL "S U B" USING 'A'. - MOVE " S U B" TO MYRTN. - CALL MYRTN USING 'B'. - STOP RUN. - END PROGRAM prog. - - IDENTIFICATION DIVISION. - PROGRAM-ID. "SUB ". - - DATA DIVISION. - LINKAGE SECTION. - 01 x PIC X. - - PROCEDURE DIVISION USING x. - DISPLAY "SUB GOT " X - END-DISPLAY. - END PROGRAM " SUB". - - IDENTIFICATION DIVISION. - PROGRAM-ID. "S U B". - - DATA DIVISION. - LINKAGE SECTION. - 01 x PIC X. - - PROCEDURE DIVISION USING x. - DISPLAY "S U B GOT " X - END-DISPLAY. - END PROGRAM "S U B". -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_misc.at:7220: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_misc.at:7220" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob:10: warning: ' SUB ' literal includes leading spaces which are omitted -prog.cob:10: warning: ' SUB ' literal includes trailing spaces which are omitted -prog.cob:21: warning: 'SUB ' literal includes trailing spaces which are omitted -prog.cob:30: warning: ' SUB' literal includes leading spaces which are omitted -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:7220" -$at_failed && at_fn_log_failure -$at_traceon; } - - -{ set +x -$as_echo "$at_srcdir/run_misc.at:7227: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_misc.at:7227" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "libcob: prog.cob:12: warning: ' SUB' literal includes leading spaces which are omitted -libcob: prog.cob:16: warning: ' S U B' literal includes leading spaces which are omitted -" | \ - $at_diff - "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo "SUB GOT X -SUB GOT Y -SUB GOT Z -S U B GOT A -S U B GOT B -" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:7227" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_659 -#AT_START_660 -at_fn_group_banner 660 'run_misc.at:7241' \ - "DEFAULT ROUNDED MODE" " " 4 -at_xfail=no -( - $as_echo "660. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - OPTIONS. - DEFAULT ROUNDED NEAREST-EVEN. - - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 x PIC 9. - - PROCEDURE DIVISION. - COMPUTE x ROUNDED = 1.5 - DISPLAY x - COMPUTE x ROUNDED = 2.5 - DISPLAY x - . -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_misc.at:7262: \$COMPILE -o prog prog.cob" -at_fn_check_prepare_dynamic "$COMPILE -o prog prog.cob" "run_misc.at:7262" -( $at_check_trace; $COMPILE -o prog prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:7262" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_misc.at:7263: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_misc.at:7263" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo "2 -2 -" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:7263" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_660 -#AT_START_661 -at_fn_group_banner 661 'run_misc.at:7271' \ - "OCCURS INDEXED ASCENDING" " " 4 -at_xfail=no -( - $as_echo "661. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 DBI-RECORD-NAMEST. - 05 FILLER. - 10 FILLER PIC X(35) - VALUE 'A-F-GEN-LEDGER-ACM 0315 '. - 10 FILLER PIC X(35) - VALUE 'A-F-GEN-LEDGER-MGL 0303 '. - 10 FILLER PIC X(35) - VALUE 'A-F-GEN-LEDGER-ZBL 0304 '. - 10 FILLER PIC X(35) - VALUE 'A-F-GEN-LEDGER-ZCC 0308 '. - 10 FILLER PIC X(35) - VALUE 'A-F-GEN-LEDGER-ZGL 0305 '. - 10 FILLER PIC X(35) - VALUE 'A-F-GEN-LEDGER-ZOO 0306 '. - 10 FILLER PIC X(35) - VALUE 'A-F-GEN-LEDGER-ZTR 0307 '. - 01 DBI-RECORD-NAMESR REDEFINES DBI-RECORD-NAMEST. - 05 DBI-RECORD-NAMES - OCCURS 7 TIMES - INDEXED BY REC-NAME-IDX - ASCENDING KEY IS DBI-RECORD-NAME - . - 10 DBI-RECORD-NAME PIC X(30). - 10 DBI-RECORD-CODE PIC 9(4). - 10 DBI-RECORD-DIR PIC X. - 01 REC-NAME PIC X(30). - 01 DBX-RECORD-NAMEST. - 05 FILLER. - 10 FILLER PIC X(35) - VALUE 'A-F-GEN-LEDGER-ACM 0315 '. - 10 FILLER PIC X(35) - VALUE 'A-F-GEN-LEDGER-MGL 0303 '. - 10 FILLER PIC X(35) - VALUE 'A-F-GEN-LEDGER-ZBL 0304 '. - 10 FILLER PIC X(35) - VALUE 'A-F-GEN-LEDGER-ZCC 0308 '. - 10 FILLER PIC X(35) - VALUE 'A-F-GEN-LEDGER-ZGL 0305 '. - 10 FILLER PIC X(35) - VALUE 'A-F-GEN-LEDGER-ZOO 0306 '. - 10 FILLER PIC X(35) - VALUE 'A-F-GEN-LEDGER-ZTR 0307 '. - 01 DBX-RECORD-NAMESR REDEFINES DBX-RECORD-NAMEST. - 05 DBX-RECORD-NAMES - OCCURS 7 TIMES - ASCENDING KEY IS DBX-RECORD-NAME - INDEXED BY REC-NAME-DBX - . - 10 DBX-RECORD-NAME PIC X(30). - 10 DBX-RECORD-CODE PIC 9(4). - 10 DBX-RECORD-DIR PIC X. - - PROCEDURE DIVISION. - MAIN. - MOVE 'A-F-GEN-LEDGER-ZGL' TO REC-NAME. - PERFORM FINDIT. - MOVE 'JUNK' TO REC-NAME. - PERFORM FINDIT. - STOP RUN. - - FINDIT. - SEARCH DBI-RECORD-NAMES - AT END - DISPLAY 'A ' REC-NAME ' is invalid.' - WHEN REC-NAME = DBI-RECORD-NAME (REC-NAME-IDX) - DISPLAY 'A ' REC-NAME ' is code ' - DBI-RECORD-CODE (REC-NAME-IDX) '.'. - - SEARCH DBX-RECORD-NAMES - AT END - DISPLAY 'B ' REC-NAME ' is invalid.' - WHEN REC-NAME = DBX-RECORD-NAME (REC-NAME-DBX) - DISPLAY 'B ' REC-NAME ' is code ' - DBX-RECORD-CODE (REC-NAME-DBX) '.'. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_misc.at:7355: \$COMPILE -frelax-syntax-checks prog.cob " -at_fn_check_prepare_dynamic "$COMPILE -frelax-syntax-checks prog.cob " "run_misc.at:7355" -( $at_check_trace; $COMPILE -frelax-syntax-checks prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob:26: warning: INDEXED should follow ASCENDING/DESCENDING -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:7355" -$at_failed && at_fn_log_failure -$at_traceon; } - - -{ set +x -$as_echo "$at_srcdir/run_misc.at:7359: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_misc.at:7359" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo "A A-F-GEN-LEDGER-ZGL is code 0305. -B A-F-GEN-LEDGER-ZGL is code 0305. -A JUNK is invalid. -B JUNK is invalid. -" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:7359" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_661 -#AT_START_662 -at_fn_group_banner 662 'run_misc.at:7370' \ - "ZERO unsigned and negative binary subscript" " " 4 -at_xfail=no -( - $as_echo "662. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 77 UBIN PIC 9(8) BINARY. - 77 SBIN PIC S9(8) BINARY. - 77 UNUP PIC 9(8). - 77 SNUP PIC S9(8). - - 01 TSTREC. - 05 TSTX PIC X(4) OCCURS 3 TIMES. - 05 TSTY PIC X(4) OCCURS 3 TIMES. - - PROCEDURE DIVISION. - MOVE ALL 'A' TO TSTX(1). - MOVE ALL 'B' TO TSTX(2). - MOVE ALL 'C' TO TSTX(3). - MOVE ALL '1' TO TSTY(1). - MOVE ALL '2' TO TSTY(2). - MOVE ALL '3' TO TSTY(3). - MOVE 0 TO UNUP. - DISPLAY "UNUP: " UNUP " is :" TSTY(UNUP) ":" UPON CONSOLE. - MOVE 0 TO SNUP. - DISPLAY "SNUP: " SNUP " is :" TSTY(SNUP) ":" UPON CONSOLE. - MOVE 0 TO SBIN. - DISPLAY "SBIN: " SBIN " is :" TSTY(SBIN) ":" UPON CONSOLE. - MOVE -1 TO SBIN. - DISPLAY "SBIN: " SBIN " is :" TSTY(SBIN) ":" UPON CONSOLE. - MOVE 'xxx' TO TSTY(SBIN). - DISPLAY "SBIN: " SBIN " is :" TSTY(SBIN) ":" UPON CONSOLE. - * The following would often core dump - MOVE 0 TO UBIN. - DISPLAY "UBIN: " UBIN " is :" TSTY(UBIN) ":" UPON CONSOLE. - MOVE 'xxx' TO TSTY(UBIN). - MOVE 1 TO UBIN. - DISPLAY "UBIN: " UBIN " is :" TSTY(UBIN) ":" UPON CONSOLE. - STOP RUN. -_ATEOF - - -# Safe run with runtime checks -{ set +x -$as_echo "$at_srcdir/run_misc.at:7414: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_misc.at:7414" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:7414" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_misc.at:7415: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_misc.at:7415" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "libcob: prog.cob:23: error: subscript of 'TSTY' out of bounds: 0 -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/run_misc.at:7415" -$at_failed && at_fn_log_failure -$at_traceon; } - - -# Runtime checks disable, subscript may be zero or even negative -{ set +x -$as_echo "$at_srcdir/run_misc.at:7420: \$COBC -x prog.cob -o prog_unsafe" -at_fn_check_prepare_dynamic "$COBC -x prog.cob -o prog_unsafe" "run_misc.at:7420" -( $at_check_trace; $COBC -x prog.cob -o prog_unsafe -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:7420" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_misc.at:7421: \$COBCRUN_DIRECT ./prog_unsafe" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog_unsafe" "run_misc.at:7421" -( $at_check_trace; $COBCRUN_DIRECT ./prog_unsafe -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo "UNUP: 00000000 is :CCCC: -SNUP: +00000000 is :CCCC: -SBIN: +00000000 is :CCCC: -SBIN: -00000001 is :BBBB: -SBIN: -00000001 is :xxx : -UBIN: 00000000 is :CCCC: -UBIN: 00000001 is :1111: -" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:7421" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_662 -#AT_START_663 -at_fn_group_banner 663 'run_misc.at:7434' \ - "Default Arithmetic (1)" " " 4 -at_xfail=no -( - $as_echo "663. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 NUM-A PIC 9(3) VALUE 399. - 01 NUM-B PIC 9(3) VALUE 211. - 01 NUM-C PIC 9(3)V99 VALUE 212.34. - 01 NUMV1 PIC 9(3)V9. - 01 PICX PIC X VALUE 'A'. - 01 RSLT PIC 9(3). - 01 RSLTV1 PIC 9(3).9. - 01 RSLTV2 PIC 9(3).99. - 01 SGN-INT USAGE SIGNED-INT VALUE 0. - 88 A-ONE VALUE 1. - 88 A-TWO VALUE 2. - * - PROCEDURE DIVISION. - MAIN. - COMPUTE RSLT = NUM-A + 1.1. - DISPLAY 'Simple Compute RSLT IS ' RSLT - COMPUTE RSLT = ((NUM-A / 100) - (NUM-B / 100)) * 100 - DISPLAY 'Single Variable RSLT IS ' RSLT - COMPUTE RSLTV2, RSLT = ((NUM-A / 100) - (NUM-B / 100)) * 100 - DISPLAY 'Compute RSLT IS ' RSLT - DISPLAY 'Compute RSLTv99 IS ' RSLTV2 - COMPUTE RSLTV1, RSLT = ((NUM-A / 100) - (NUM-B / 100)) * 100 - DISPLAY 'Compute RSLT IS ' RSLT - DISPLAY 'Compute RSLTv9 IS ' RSLTV1 - MOVE 0 TO RSLT - ADD NUM-C TO RSLT. - DISPLAY 'Add RSLT IS ' RSLT. - MOVE 0 TO RSLT - ADD NUM-A NUM-C 10 TO RSLT. - DISPLAY 'Add RSLT IS ' RSLT. - SUBTRACT NUM-C FROM RSLT. - DISPLAY 'Subtract RSLT IS ' RSLT. - SUBTRACT NUM-A -10 FROM RSLT. - DISPLAY 'Subtract RSLT IS ' RSLT. - MOVE 0 TO RSLT - ADD NUM-A NUM-C TO RSLT GIVING RSLTV1. - DISPLAY 'Add RSLTv9 IS ' RSLTV1 - MULTIPLY NUM-A BY NUM-C GIVING RSLT. - DISPLAY 'Multiply RSLT IS ' RSLT. - MULTIPLY RSLT BY NUM-C. - DISPLAY 'Multiply RSLT IS ' RSLT. - DIVIDE NUM-A BY 10 GIVING RSLT. - DISPLAY 'Divide RSLT IS ' RSLT. - DIVIDE RSLT BY 4 GIVING RSLTV1. - DISPLAY 'Divide RSLTv9 IS ' RSLTV1. - DIVIDE RSLT BY 4 GIVING RSLT. - DISPLAY 'Divide RSLT IS ' RSLT. - - COMPUTE RSLTV1, RSLT = ((NUM-A / 100) - (NUM-B / 100)) * 100 - DISPLAY 'Simple RSLT IS ' RSLT - ' RSLTv9 IS ' RSLTV1. - - COMPUTE RSLTV1, RSLT = ((NUM-A / (100.55 + -0.550)) - - (NUM-B / (10.11 * 10 - 1.1))) - * (220 / 2.2) - DISPLAY 'Complex RSLT IS ' RSLT - ' RSLTv9 IS ' RSLTV1. - - COMPUTE RSLTV1, RSLT = ((NUM-A / (101 - 1)) - - (NUM-B / (10 * 10))) * (200 / 2) - DISPLAY 'Reduced RSLT IS ' RSLT - ' RSLTv9 IS ' RSLTV1. - MOVE NUM-A TO NUMV1. - IF ((NUMV1 / (101 - 1)) - - (NUM-B / (10 * 10))) * (200 / 2) EQUAL 188 - DISPLAY "Not Using ARITHMETIC-OSVS" - ELSE - DISPLAY "Using ARITHMETIC-OSVS" - END-IF. - IF NOT A-ONE AND NOT A-TWO - DISPLAY '88 test SUCCESS' - ELSE - DISPLAY '88 test FAILED' - END-IF. - STOP RUN. -_ATEOF - -{ set +x -$as_echo "$at_srcdir/run_misc.at:7518: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_misc.at:7518" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:7518" -$at_failed && at_fn_log_failure -$at_traceon; } - - -{ set +x -$as_echo "$at_srcdir/run_misc.at:7520: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_misc.at:7520" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo "Simple Compute RSLT IS 400 -Single Variable RSLT IS 188 -Compute RSLT IS 188 -Compute RSLTv99 IS 188.00 -Compute RSLT IS 188 -Compute RSLTv9 IS 188.0 -Add RSLT IS 212 -Add RSLT IS 621 -Subtract RSLT IS 408 -Subtract RSLT IS 019 -Add RSLTv9 IS 611.3 -Multiply RSLT IS 723 -Multiply RSLT IS 723 -Divide RSLT IS 039 -Divide RSLTv9 IS 009.7 -Divide RSLT IS 009 -Simple RSLT IS 188 RSLTv9 IS 188.0 -Complex RSLT IS 188 RSLTv9 IS 188.0 -Reduced RSLT IS 188 RSLTv9 IS 188.0 -Not Using ARITHMETIC-OSVS -88 test SUCCESS -" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:7520" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_663 -#AT_START_664 -at_fn_group_banner 664 'run_misc.at:7547' \ - "Default Arithmetic Test (2)" " " 4 -at_xfail=no -( - $as_echo "664. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 VAL PIC S9(7)V99 COMP-3 VALUE 20500. - 01 DIV1 PIC S9(7)V99 COMP-3 VALUE 0.9. - 01 DIV2 PIC S9(7)V99 COMP-3 VALUE 33.45. - 01 DIV3 PIC S9(7)V99 COMP-3 VALUE 9. - 01 MUL1 PIC S9(7)V99 COMP-3 VALUE 10. - 01 MUL2 PIC S9(7)V99 COMP-3 VALUE 5. - 01 MUL3 PIC S9(7)V99 COMP-3 VALUE 2. - 01 RES PIC S9(7)V99 COMP-3. - PROCEDURE DIVISION. - COMPUTE RES = VAL / DIV1 / DIV2. - DISPLAY 'RES = ' RES. - COMPUTE RES ROUNDED = VAL / DIV1 / DIV2. - DISPLAY 'RES ROUNDED = ' RES. - COMPUTE RES = VAL * MUL1 / DIV3 / DIV2. - DISPLAY 'RES MULT1 = ' RES. - COMPUTE RES = VAL * MUL2 * MUL3 / DIV3 / DIV2. - DISPLAY 'RES MULT2 = ' RES. - COMPUTE RES = VAL / DIV1. - DISPLAY 'RES 1 = ' RES. - COMPUTE RES = RES / DIV2. - DISPLAY 'RES F = ' RES. - COMPUTE RES ROUNDED MODE AWAY-FROM-ZERO = - VAL / DIV1 / DIV2. - DISPLAY 'RES ROUNDED AWAY = ' RES. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_misc.at:7583: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_misc.at:7583" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:7583" -$at_failed && at_fn_log_failure -$at_traceon; } - - -{ set +x -$as_echo "$at_srcdir/run_misc.at:7585: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_misc.at:7585" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo "RES = +0000680.95 -RES ROUNDED = +0000680.95 -RES MULT1 = +0000680.95 -RES MULT2 = +0000680.95 -RES 1 = +0022777.77 -RES F = +0000680.94 -RES ROUNDED AWAY = +0000680.96 -" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:7585" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_664 -#AT_START_665 -at_fn_group_banner 665 'run_misc.at:7598' \ - "OSVS Arithmetic (1)" " " 4 -at_xfail=no -( - $as_echo "665. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 NUM-A PIC 9(3) VALUE 399. - 01 NUM-B PIC 9(3) VALUE 211. - 01 NUM-C PIC 9(3)V99 VALUE 212.34. - 01 NUMV1 PIC 9(3)V9. - 01 PICX PIC X VALUE 'A'. - 01 RSLT PIC 9(3). - 01 RSLTV1 PIC 9(3).9. - 01 RSLTV2 PIC 9(3).99. - * - PROCEDURE DIVISION. - MAIN. - COMPUTE RSLT = NUM-A + 1.1. - DISPLAY 'Simple Compute RSLT IS ' RSLT - COMPUTE RSLT = ((NUM-A / 100) - (NUM-B / 100)) * 100 - DISPLAY 'Single Variable RSLT IS ' RSLT - COMPUTE RSLTV2, RSLT = ((NUM-A / 100) - (NUM-B / 100)) * 100 - DISPLAY 'Compute RSLT IS ' RSLT - DISPLAY 'Compute RSLTv99 IS ' RSLTV2 - COMPUTE RSLTV1, RSLT = ((NUM-A / 100) - (NUM-B / 100)) * 100 - DISPLAY 'Compute RSLT IS ' RSLT - DISPLAY 'Compute RSLTv9 IS ' RSLTV1 - MOVE 0 TO RSLT - ADD NUM-C TO RSLT. - DISPLAY 'Add RSLT IS ' RSLT. - MOVE 0 TO RSLT - ADD NUM-A NUM-C 10 TO RSLT. - DISPLAY 'Add RSLT IS ' RSLT. - SUBTRACT NUM-C FROM RSLT. - DISPLAY 'Subtract RSLT IS ' RSLT. - SUBTRACT NUM-A -10 FROM RSLT. - DISPLAY 'Subtract RSLT IS ' RSLT. - MOVE 0 TO RSLT - ADD NUM-A NUM-C TO RSLT GIVING RSLTV1. - DISPLAY 'Add RSLTv9 IS ' RSLTV1 - MULTIPLY NUM-A BY NUM-C GIVING RSLT. - DISPLAY 'Multiply RSLT IS ' RSLT. - MULTIPLY RSLT BY NUM-C. - DISPLAY 'Multiply RSLT IS ' RSLT. - DIVIDE NUM-A BY 10 GIVING RSLT. - DISPLAY 'Divide RSLT IS ' RSLT. - DIVIDE RSLT BY 4 GIVING RSLTV1. - DISPLAY 'Divide RSLTv9 IS ' RSLTV1. - DIVIDE RSLT BY 4 GIVING RSLT. - DISPLAY 'Divide RSLT IS ' RSLT. - - COMPUTE RSLTV1, RSLT = ((NUM-A / 100) - (NUM-B / 100)) * 100 - DISPLAY 'Simple RSLT IS ' RSLT - ' RSLTv9 IS ' RSLTV1. - - COMPUTE RSLTV1, RSLT = ((NUM-A / (100.55 + -0.550)) - - (NUM-B / (10.11 * 10 - 1.1))) - * (220 / 2.2) - DISPLAY 'Complex RSLT IS ' RSLT - ' RSLTv9 IS ' RSLTV1. - - COMPUTE RSLTV1, RSLT = ((NUM-A / (101 - 1)) - - (NUM-B / (10 * 10))) * (200 / 2) - DISPLAY 'Reduced RSLT IS ' RSLT - ' RSLTv9 IS ' RSLTV1. - MOVE NUM-A TO NUMV1. - IF ((NUMV1 / (101 - 1)) - - (NUM-B / (10 * 10))) * (200 / 2) EQUAL 188 - DISPLAY "Not Using ARITHMETIC-OSVS" - ELSE - DISPLAY "Using ARITHMETIC-OSVS" - END-IF. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_misc.at:7675: \$COMPILE -farithmetic-osvs prog.cob" -at_fn_check_prepare_dynamic "$COMPILE -farithmetic-osvs prog.cob" "run_misc.at:7675" -( $at_check_trace; $COMPILE -farithmetic-osvs prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob: in paragraph 'MAIN': -prog.cob:19: warning: precision of result may change with arithmetic-osvs -prog.cob:21: warning: precision of result may change with arithmetic-osvs -prog.cob:24: warning: precision of result may change with arithmetic-osvs -prog.cob:31: warning: precision of result may change with arithmetic-osvs -prog.cob:35: warning: precision of result may change with arithmetic-osvs -prog.cob:38: warning: precision of result may change with arithmetic-osvs -prog.cob:51: warning: precision of result may change with arithmetic-osvs -prog.cob:55: warning: precision of result may change with arithmetic-osvs -prog.cob:61: warning: precision of result may change with arithmetic-osvs -prog.cob:66: warning: precision of result may change with arithmetic-osvs -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:7675" -$at_failed && at_fn_log_failure -$at_traceon; } - - -{ set +x -$as_echo "$at_srcdir/run_misc.at:7689: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_misc.at:7689" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo "Simple Compute RSLT IS 400 -Single Variable RSLT IS 100 -Compute RSLT IS 188 -Compute RSLTv99 IS 188.00 -Compute RSLT IS 180 -Compute RSLTv9 IS 180.0 -Add RSLT IS 212 -Add RSLT IS 621 -Subtract RSLT IS 408 -Subtract RSLT IS 019 -Add RSLTv9 IS 611.3 -Multiply RSLT IS 723 -Multiply RSLT IS 723 -Divide RSLT IS 039 -Divide RSLTv9 IS 009.7 -Divide RSLT IS 009 -Simple RSLT IS 180 RSLTv9 IS 180.0 -Complex RSLT IS 188 RSLTv9 IS 188.0 -Reduced RSLT IS 180 RSLTv9 IS 180.0 -Using ARITHMETIC-OSVS -" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:7689" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_665 -#AT_START_666 -at_fn_group_banner 666 'run_misc.at:7715' \ - "OSVS Arithmetic Test (2)" " " 4 -at_xfail=no -( - $as_echo "666. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 VAL PIC S9(7)V99 COMP-3 VALUE 20500. - 01 DIV1 PIC S9(7)V99 COMP-3 VALUE 0.9. - 01 DIV2 PIC S9(7)V99 COMP-3 VALUE 33.45. - 01 DIV3 PIC S9(7)V99 COMP-3 VALUE 9. - 01 MUL1 PIC S9(7)V99 COMP-3 VALUE 10. - 01 MUL2 PIC S9(7)V99 COMP-3 VALUE 5. - 01 MUL3 PIC S9(7)V99 COMP-3 VALUE 2. - 01 RES PIC S9(7)V99 COMP-3. - PROCEDURE DIVISION. - COMPUTE RES = VAL / DIV1 / DIV2. - DISPLAY 'RES = ' RES. - COMPUTE RES ROUNDED = VAL / DIV1 / DIV2. - DISPLAY 'RES ROUNDED = ' RES. - COMPUTE RES = VAL * MUL1 / DIV3 / DIV2. - DISPLAY 'RES MULT1 = ' RES. - COMPUTE RES = VAL * MUL2 * MUL3 / DIV3 / DIV2. - DISPLAY 'RES MULT2 = ' RES. - COMPUTE RES = VAL / DIV1. - DISPLAY 'RES 1 = ' RES. - COMPUTE RES = RES / DIV2. - DISPLAY 'RES F = ' RES. - COMPUTE RES ROUNDED MODE AWAY-FROM-ZERO = - VAL / DIV1 / DIV2. - DISPLAY 'RES ROUNDED AWAY = ' RES. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_misc.at:7751: \$COMPILE -std=ibm prog.cob" -at_fn_check_prepare_dynamic "$COMPILE -std=ibm prog.cob" "run_misc.at:7751" -( $at_check_trace; $COMPILE -std=ibm prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob:16: warning: precision of result may change with arithmetic-osvs -prog.cob:18: warning: precision of result may change with arithmetic-osvs -prog.cob:20: warning: precision of result may change with arithmetic-osvs -prog.cob:22: warning: precision of result may change with arithmetic-osvs -prog.cob:28: warning: precision of result may change with arithmetic-osvs -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:7751" -$at_failed && at_fn_log_failure -$at_traceon; } - - -{ set +x -$as_echo "$at_srcdir/run_misc.at:7759: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_misc.at:7759" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo "RES = +000068094 -RES ROUNDED = +000068095 -RES MULT1 = +000068094 -RES MULT2 = +000068095 -RES 1 = +002277777 -RES F = +000068094 -RES ROUNDED AWAY = +000068095 -" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:7759" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_666 -#AT_START_667 -at_fn_group_banner 667 'run_misc.at:7771' \ - "OSVS Arithmetic Test (3)" " " 4 -at_xfail=no -( - $as_echo "667. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - - 01 PERCENT PIC S9(03)V99. - 01 AMOUNT PIC S9(11)V99. - 01 RESULT PIC S9(11)V99. - 01 D-RESULT PIC -9(5).99. - 01 D-MSG PIC X(37) VALUE " ". - 01 D-RND PIC X(4) VALUE " ". - 01 X-RSLT PIC S9(5). - 01 NUM-A PIC 9(3) VALUE 399. - 01 NUM-B PIC 9(3) VALUE 211. - 01 NUMV1 PIC 9(3)V9. - 01 RSLT PIC 9(3). - 01 RSLTV1 PIC 9(3).9. - - LOCAL-STORAGE SECTION. - PROCEDURE DIVISION. - - DISPLAY '-- TEST COMPUTE WITH ROUNDING --' - - MOVE 24 TO PERCENT - MOVE 123.45 TO AMOUNT - DISPLAY ' AMOUNT: 123.45 ' - ' PERCENT: 24' - - DISPLAY " ALL TESTS HAVE COMPUTE ROUNDED EXCEPT 'NR:'" - - MOVE 'AMOUNT + (AMOUNT * PERCENT / 100)' TO D-MSG - COMPUTE RESULT ROUNDED = AMOUNT + (AMOUNT * PERCENT / 100) - PERFORM SHOW-IT. - - MOVE 'PERCENT / 100 * AMOUNT + AMOUNT' TO D-MSG - COMPUTE RESULT ROUNDED = PERCENT / 100 * AMOUNT + AMOUNT - PERFORM SHOW-IT. - - MOVE 'NR:' TO D-RND - MOVE 'PERCENT / 100 * AMOUNT + AMOUNT' TO D-MSG - COMPUTE RESULT = PERCENT / 100 * AMOUNT + AMOUNT - PERFORM SHOW-IT. - - MOVE '(AMOUNT * PERCENT / 100) + AMOUNT' TO D-MSG - COMPUTE RESULT ROUNDED = (AMOUNT * PERCENT / 100) + AMOUNT - PERFORM SHOW-IT. - - MOVE '(123.45 * 24 / 100) + 123.45' TO D-MSG - COMPUTE RESULT ROUNDED = (123.45 * 24 / 100) + 123.45 - PERFORM SHOW-IT. - - MOVE '123.45 + (123.45 * 24 / 100)' TO D-MSG - COMPUTE RESULT ROUNDED = 123.45 + (123.45 * 24 / 100) - PERFORM SHOW-IT. - - MOVE 'NR:' TO D-RND - MOVE '123.45 + (123.45 * 24 / 100)' TO D-MSG - COMPUTE RESULT = 123.45 + (123.45 * 24 / 100) - PERFORM SHOW-IT. - - MOVE '(AMOUNT * PERCENT / 100) ' TO D-MSG - COMPUTE RESULT = (AMOUNT * PERCENT / 100) - PERFORM SHOW-IT. - - MOVE '(AMOUNT * PERCENT / 100) ROUNDED' TO D-MSG - COMPUTE RESULT ROUNDED = (AMOUNT * PERCENT / 100) - PERFORM SHOW-IT. - - MOVE 399 TO NUMV1. - MOVE 211 TO NUM-B. - COMPUTE X-RSLT = ((NUMV1 / (101 - 1)) - - (NUM-B / (10 * 10))) * (200 / 2) - IF ((NUMV1 / (101 - 1)) - - (NUM-B / (10 * 10))) * (200 / 2) EQUAL 188 - DISPLAY "Not Using ARITHMETIC-OSVS: " X-RSLT - ELSE - DISPLAY "Using ARITHMETIC-OSVS: " X-RSLT - END-IF. - - COMPUTE X-RSLT ROUNDED = ((NUMV1 / (101 - 1)) - - (NUM-B / (10 * 10))) * (200 / 2) - IF ((NUMV1 / (101 - 1)) - - (NUM-B / (10 * 10))) * (200 / 2) EQUAL 188 - DISPLAY "Not Using ARITHMETIC-OSVS: " X-RSLT - ELSE - DISPLAY "Using ARITHMETIC-OSVS: " X-RSLT - END-IF. - - COMPUTE RSLTV1, RSLT = ((NUM-A / 100) - (NUM-B / 100)) * 100 - DISPLAY 'Simple RSLT IS ' RSLT - ' RSLTv9 IS ' RSLTV1. - - COMPUTE RSLTV1, RSLT = ((NUM-A / (100.55 + -0.550)) - - (NUM-B / (10.11 * 10 - 1.1))) - * (220 / 2.2) - DISPLAY 'Complex RSLT IS ' RSLT - ' RSLTv9 IS ' RSLTV1. - - DISPLAY '-- TEST FINISHED --'. - - STOP RUN. - - SHOW-IT. - MOVE RESULT TO D-RESULT - DISPLAY D-RND D-MSG ' = ' D-RESULT. - MOVE SPACES TO D-RND. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_misc.at:7883: \$COBC -x -std=ibm -farithmetic-osvs -w prog.cob " -at_fn_check_prepare_dynamic "$COBC -x -std=ibm -farithmetic-osvs -w prog.cob " "run_misc.at:7883" -( $at_check_trace; $COBC -x -std=ibm -farithmetic-osvs -w prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:7883" -$at_failed && at_fn_log_failure -$at_traceon; } - - -{ set +x -$as_echo "$at_srcdir/run_misc.at:7885: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_misc.at:7885" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo "-- TEST COMPUTE WITH ROUNDING -- - AMOUNT: 123.45 PERCENT: 24 - ALL TESTS HAVE COMPUTE ROUNDED EXCEPT 'NR:' - AMOUNT + (AMOUNT * PERCENT / 100) = 00153.08 - PERCENT / 100 * AMOUNT + AMOUNT = 00153.08 -NR: PERCENT / 100 * AMOUNT + AMOUNT = 00153.07 - (AMOUNT * PERCENT / 100) + AMOUNT = 00153.08 - (123.45 * 24 / 100) + 123.45 = 00153.08 - 123.45 + (123.45 * 24 / 100) = 00153.08 -NR: 123.45 + (123.45 * 24 / 100) = 00153.07 - (AMOUNT * PERCENT / 100) = 00029.62 - (AMOUNT * PERCENT / 100) ROUNDED = 00029.63 -Using ARITHMETIC-OSVS: 00180+ -Using ARITHMETIC-OSVS: 00180+ -Simple RSLT IS 180 RSLTv9 IS 180.0 -Complex RSLT IS 188 RSLTv9 IS 188.0 --- TEST FINISHED -- -" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:7885" -$at_failed && at_fn_log_failure -$at_traceon; } - - -{ set +x -$as_echo "$at_srcdir/run_misc.at:7904: \$COBC -x -std=ibm -w -fno-arithmetic-osvs prog.cob " -at_fn_check_prepare_dynamic "$COBC -x -std=ibm -w -fno-arithmetic-osvs prog.cob " "run_misc.at:7904" -( $at_check_trace; $COBC -x -std=ibm -w -fno-arithmetic-osvs prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:7904" -$at_failed && at_fn_log_failure -$at_traceon; } - - -{ set +x -$as_echo "$at_srcdir/run_misc.at:7906: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_misc.at:7906" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo "-- TEST COMPUTE WITH ROUNDING -- - AMOUNT: 123.45 PERCENT: 24 - ALL TESTS HAVE COMPUTE ROUNDED EXCEPT 'NR:' - AMOUNT + (AMOUNT * PERCENT / 100) = 00153.08 - PERCENT / 100 * AMOUNT + AMOUNT = 00153.08 -NR: PERCENT / 100 * AMOUNT + AMOUNT = 00153.07 - (AMOUNT * PERCENT / 100) + AMOUNT = 00153.08 - (123.45 * 24 / 100) + 123.45 = 00153.08 - 123.45 + (123.45 * 24 / 100) = 00153.08 -NR: 123.45 + (123.45 * 24 / 100) = 00153.07 - (AMOUNT * PERCENT / 100) = 00029.62 - (AMOUNT * PERCENT / 100) ROUNDED = 00029.63 -Not Using ARITHMETIC-OSVS: 00188+ -Not Using ARITHMETIC-OSVS: 00188+ -Simple RSLT IS 188 RSLTv9 IS 188.0 -Complex RSLT IS 188 RSLTv9 IS 188.0 --- TEST FINISHED -- -" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:7906" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_667 -#AT_START_668 -at_fn_group_banner 668 'run_misc.at:7928' \ - "SET CONSTANT directive" " " 4 -at_xfail=no -( - $as_echo "668. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -# The SET CONSTANT directive defines a level78 variable -# for the current compilation unit - -# original MF extension: $SET CONSTANT -cat >prog.cob <<'_ATEOF' - - $SET CONSTANT DOGGY "Barky" - $SET CONSTANT PONY "Blacky" - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 THEDOG PIC X(6) VALUE DOGGY. - 77 MYHORSE PIC X(7) VALUE PONY. - $SET CONSTANT PONY "White" - * - PROCEDURE DIVISION. - MAIN. - DISPLAY "Your Dog's name is " DOGGY ";". - DISPLAY "The Dog's name is " THEDOG ";". - DISPLAY "My Horse is " MYHORSE ";". - DISPLAY "My little pony is " PONY ".". - STOP RUN. -_ATEOF - - -# OpenCOBOL/GnuCOBOL extension: >>SET CONSTANT -cat >prog2.cob <<'_ATEOF' - - >>SET CONSTANT DOGGY "Barky" - >>SET CONSTANT PONY "Blacky" - IDENTIFICATION DIVISION. - PROGRAM-ID. prog2. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 THEDOG PIC X(6) VALUE DOGGY. - 77 MYHORSE PIC X(7) VALUE PONY. - >>SET CONSTANT PONY "White" - * - PROCEDURE DIVISION. - MAIN. - DISPLAY "Your Dog's name is " DOGGY ";". - DISPLAY "The Dog's name is " THEDOG ";". - DISPLAY "My Horse is " MYHORSE ";". - DISPLAY "My little pony is " PONY ".". - STOP RUN. -_ATEOF - - -# OpenCOBOL/GnuCOBOL extension: >>DEFINE CONSTANT -cat >prog3.cob <<'_ATEOF' - - >>DEFINE CONSTANT DOGGY "Barky" - >>DEFINE CONSTANT PONY "Blacky" - IDENTIFICATION DIVISION. - PROGRAM-ID. prog3. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 THEDOG PIC X(6) VALUE DOGGY. - 77 MYHORSE PIC X(7) VALUE PONY. - >>DEFINE CONSTANT PONY "White" OVERRIDE - * - PROCEDURE DIVISION. - MAIN. - DISPLAY "Your Dog's name is " DOGGY ";". - DISPLAY "The Dog's name is " THEDOG ";". - DISPLAY "My Horse is " MYHORSE ";". - DISPLAY "My little pony is " PONY ".". - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_misc.at:7997: \$COMPILE -std=mf prog.cob" -at_fn_check_prepare_dynamic "$COMPILE -std=mf prog.cob" "run_misc.at:7997" -( $at_check_trace; $COMPILE -std=mf prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:7997" -$at_failed && at_fn_log_failure -$at_traceon; } - - -# Note: MF does not redefine a value via SET CONSTANT -# the first definitions wins (we should add a warning) -{ set +x -$as_echo "$at_srcdir/run_misc.at:8001: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_misc.at:8001" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo "Your Dog's name is Barky; -The Dog's name is Barky ; -My Horse is Blacky ; -My little pony is Blacky. -" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:8001" -$at_failed && at_fn_log_failure -$at_traceon; } - - -{ set +x -$as_echo "$at_srcdir/run_misc.at:8008: \$COMPILE prog2.cob" -at_fn_check_prepare_dynamic "$COMPILE prog2.cob" "run_misc.at:8008" -( $at_check_trace; $COMPILE prog2.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:8008" -$at_failed && at_fn_log_failure -$at_traceon; } - - -# Note: MF does not redefine a value via SET CONSTANT -# the first definitions wins (we should add a warning) -{ set +x -$as_echo "$at_srcdir/run_misc.at:8012: \$COBCRUN_DIRECT ./prog2" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog2" "run_misc.at:8012" -( $at_check_trace; $COBCRUN_DIRECT ./prog2 -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo "Your Dog's name is Barky; -The Dog's name is Barky ; -My Horse is Blacky ; -My little pony is Blacky. -" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:8012" -$at_failed && at_fn_log_failure -$at_traceon; } - - -{ set +x -$as_echo "$at_srcdir/run_misc.at:8019: \$COMPILE -fdefine-constant-directive=ok prog3.cob" -at_fn_check_prepare_dynamic "$COMPILE -fdefine-constant-directive=ok prog3.cob" "run_misc.at:8019" -( $at_check_trace; $COMPILE -fdefine-constant-directive=ok prog3.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:8019" -$at_failed && at_fn_log_failure -$at_traceon; } - - -{ set +x -$as_echo "$at_srcdir/run_misc.at:8021: \$COBCRUN_DIRECT ./prog3" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog3" "run_misc.at:8021" -( $at_check_trace; $COBCRUN_DIRECT ./prog3 -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo "Your Dog's name is Barky; -The Dog's name is Barky ; -My Horse is Blacky ; -My little pony is White. -" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:8021" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_668 -#AT_START_669 -at_fn_group_banner 669 'run_misc.at:8031' \ - "DEFINE OVERRIDE" " " 4 -at_xfail=no -( - $as_echo "669. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - >>SET CONSTANT DOGGY "Pluto" - >>SET CONSTANT PONY "Piper" - WORKING-STORAGE SECTION. - 01 THEDOG PIC X(6) VALUE DOGGY. - - >>DEFINE DPONY AS PARAMETER OVERRIDE - >>IF DPONY IS NOT DEFINED - >>DEFINE DPONY AS "No Dpony" - >>END-IF - 01 CNSPONY CONSTANT FROM DPONY. - - >>DEFINE ENVPONY AS PARAMETER OVERRIDE - >>IF ENVPONY IS NOT DEFINED - >>DEFINE ENVPONY AS "No EnvPony" - >>END-IF - 01 HORSE CONSTANT FROM ENVPONY. - 77 MYHORSE PIC X(12) VALUE HORSE . - 77 MYPONYENV PIC X(12). - * - PROCEDURE DIVISION. - MAIN. - DISPLAY "ENVPONY" UPON ENVIRONMENT-NAME - ACCEPT MYPONYENV FROM ENVIRONMENT-VALUE. - DISPLAY "ENVPONY env var set to " MYPONYENV ";". - DISPLAY "1st Dog's name is " DOGGY ";". - DISPLAY "2nd Dog's name is " PONY ";". - >>IF ENVPONY IS DEFINED - DISPLAY "ENVPONY is DEFINED as " HORSE ";". - >>ELSE - DISPLAY "ENVPONY was NOT DEFINED;". - >>END-IF - DISPLAY "DPONY set to " CNSPONY ";". - >>IF ENVPONY = "WHITE" - >>DEFINE CONSTANT PONY AS "White Horse" OVERRIDE - >>ELSE - >>DEFINE CONSTANT PONY AS "default Dirty" OVERRIDE - >>END-IF - DISPLAY "My pony is " PONY ";". - >>IF DPONY IS DEFINED - DISPLAY "DPONY is DEFINED as " CNSPONY ";". - >>END-IF - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_misc.at:8082: ENVPONY=WHITE \$COMPILE prog.cob -fdefine-constant-directive=ok -DDPONY=Stallone" -at_fn_check_prepare_dynamic "ENVPONY=WHITE $COMPILE prog.cob -fdefine-constant-directive=ok -DDPONY=Stallone" "run_misc.at:8082" -( $at_check_trace; ENVPONY=WHITE $COMPILE prog.cob -fdefine-constant-directive=ok -DDPONY=Stallone -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:8082" -$at_failed && at_fn_log_failure -$at_traceon; } - - -{ set +x -$as_echo "$at_srcdir/run_misc.at:8084: ENVPONY=WHITE ./prog" -at_fn_check_prepare_trace "run_misc.at:8084" -( $at_check_trace; ENVPONY=WHITE ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo "ENVPONY env var set to WHITE ; -1st Dog's name is Pluto; -2nd Dog's name is Piper; -ENVPONY is DEFINED as WHITE; -DPONY set to Stallone; -My pony is White Horse; -DPONY is DEFINED as Stallone; -" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:8084" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_669 -#AT_START_670 -at_fn_group_banner 670 'run_misc.at:8097' \ - "DEFINE Defaults" " " 4 -at_xfail=no -( - $as_echo "670. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - >>SET CONSTANT DOGGY "Pluto" - >>SET CONSTANT PONY "Piper" - WORKING-STORAGE SECTION. - 01 THEDOG PIC X(6) VALUE DOGGY. - - >>DEFINE DPONY AS PARAMETER OVERRIDE - >>IF DPONY IS NOT DEFINED - >>DEFINE DPONY AS "No Dpony" - >>END-IF - 01 CNSPONY CONSTANT FROM DPONY. - - >>DEFINE ENVPONY AS PARAMETER OVERRIDE - >>IF ENVPONY IS NOT DEFINED - >>DEFINE ENVPONY AS "No EnvPony" - >>END-IF - 01 HORSE CONSTANT FROM ENVPONY. - 77 MYHORSE PIC X(12) VALUE HORSE . - 77 MYPONYENV PIC X(12). - * - PROCEDURE DIVISION. - MAIN. - DISPLAY "ENVPONY" UPON ENVIRONMENT-NAME - ACCEPT MYPONYENV FROM ENVIRONMENT-VALUE. - DISPLAY "ENVPONY env var set to " MYPONYENV ";". - DISPLAY "1st Dog's name is " DOGGY ";". - DISPLAY "2nd Dog's name is " PONY ";". - >>IF ENVPONY IS DEFINED - DISPLAY "ENVPONY is DEFINED as " HORSE ";". - >>ELSE - DISPLAY "ENVPONY was NOT DEFINED;". - >>END-IF - DISPLAY "DPONY set to " CNSPONY ";". - >>IF ENVPONY = "WHITE" - >>DEFINE CONSTANT PONY AS "White Horse" OVERRIDE - >>ELSE - >>DEFINE CONSTANT PONY AS "default Dirty" OVERRIDE - >>END-IF - DISPLAY "My pony is " PONY ";". - >>IF DPONY IS DEFINED - DISPLAY "DPONY is DEFINED as " CNSPONY ";". - >>END-IF - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_misc.at:8148: \$COMPILE prog.cob -fdefine-constant-directive=ok" -at_fn_check_prepare_dynamic "$COMPILE prog.cob -fdefine-constant-directive=ok" "run_misc.at:8148" -( $at_check_trace; $COMPILE prog.cob -fdefine-constant-directive=ok -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:8148" -$at_failed && at_fn_log_failure -$at_traceon; } - - -{ set +x -$as_echo "$at_srcdir/run_misc.at:8150: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_misc.at:8150" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo "ENVPONY env var set to ; -1st Dog's name is Pluto; -2nd Dog's name is Piper; -ENVPONY is DEFINED as No EnvPony; -DPONY set to No Dpony; -My pony is default Dirty; -DPONY is DEFINED as No Dpony; -" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:8150" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_670 -#AT_START_671 -at_fn_group_banner 671 'run_misc.at:8163' \ - "78 VALUE" " " 4 -at_xfail=no -( - $as_echo "671. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 78 DOGGY VALUE "Barky". - 01 MYREC. - 05 FLD1 PIC 9(2). - 05 FLD2 PIC X(7). - 05 FLD3 PIC X(2) OCCURS 5 TIMES. - 05 FLD4 PIC X(4). - 05 FLD5 PIC X(4). - 01 PICX PIC XXX VALUE 'Abc'. - 78 HUN VALUE 10 * (10 + LENGTH OF PICX) + 12.35-2+3. - 78 HUN2 VALUE HUN * (10 + LENGTH OF PICX) -4. - 01 THEDOG PIC X(6) VALUE DOGGY. - 78 DIV1 VALUE 100 / 3. - 78 NUM2 VALUE 1 + 2 * 3. - LINKAGE SECTION. - 01 XMYREC. - 05 XFLD1 PIC 9(2). - 05 XFLD2 PIC X(7). - 78 XPOS3 VALUE NEXT. - 05 XFLD3 PIC X(2) OCCURS 5 TIMES. - 78 XPOS4 VALUE NEXT. - 05 XFLD4 PIC X(4). - 05 XFLD5 PIC X(4). - 78 XSTRT4 VALUE START OF XFLD4. - * - PROCEDURE DIVISION. - MAIN. - DISPLAY "DIV1 is " DIV1. - DISPLAY "HUN is " HUN. - DISPLAY "HUN2 is " HUN2. - MOVE NUM2 TO FLD1 - IF FLD1 = 9 - DISPLAY "NUM2 is " NUM2 " left to right precedence." - ELSE - DISPLAY "NUM2 is " NUM2 " normal precedence." - END-IF. - DISPLAY "XFLD3 starts at " XPOS3. - DISPLAY "XFLD4 starts at " XSTRT4. - DISPLAY "XFLD4 starts at " XPOS4. - DISPLAY "Your Dog's name is " DOGGY ";". - DISPLAY "The Dog's name is " THEDOG ";". - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_misc.at:8214: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_misc.at:8214" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:8214" -$at_failed && at_fn_log_failure -$at_traceon; } - - -{ set +x -$as_echo "$at_srcdir/run_misc.at:8216: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_misc.at:8216" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo "DIV1 is 33 -HUN is 143 -HUN2 is 1855 -NUM2 is 9 left to right precedence. -XFLD3 starts at 9 -XFLD4 starts at 19 -XFLD4 starts at 11 -Your Dog's name is Barky; -The Dog's name is Barky ; -" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:8216" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_671 -#AT_START_672 -at_fn_group_banner 672 'run_misc.at:8231' \ - "01 CONSTANT" " " 4 -at_xfail=no -( - $as_echo "672. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - >>DEFINE MYDOG AS "Piper" - >>DEFINE MYNUM1 AS 11 - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 MYREC. - 05 FLD1 PIC 9(2). - 05 FLD2 PIC X(7). - 05 FLD3 PIC X(2) OCCURS 5 TIMES. - 05 FLD4 PIC X(4). - 05 FLD5 PIC X(4). - 01 PICX PIC XXX VALUE 'Abc'. - 01 CAT CONSTANT 'Cat '. - 01 DOG CONSTANT 'Dog '. - 01 YARD CONSTANT CAT & "& " & DOG. - 78 HUN VALUE 10 * (10 + LENGTH OF PICX) + 12.35-2+3. - 78 HUN2 VALUE HUN * (10 + LENGTH OF PICX) -4. - 78 DIV1 VALUE 100 / 3. - 78 NUM2 VALUE 1 + 2 * 3. - 01 CON3 CONSTANT (((1 + 2) * NUM2) - 4). - 01 CON4 CONSTANT AS 3.1416 + CON3. - 01 CON5 CONSTANT 1 + 2 * 3. - 01 DOGNAME CONSTANT FROM MYDOG. - 01 NUM1 CONSTANT FROM MYNUM1. - 01 CON6 CONSTANT AS CON5 + NUM1. - >> IF NUM2 DEFINED *> optional passed from command line - 01 NUM2 CONSTANT FROM MYNUM2. - >> END-IF - * - PROCEDURE DIVISION. - MAIN. - DISPLAY "CAT is '" CAT "'". - DISPLAY "Yard is '" YARD "'". - DISPLAY "DIV1 is " DIV1. - DISPLAY "HUN is " HUN. - DISPLAY "HUN2 is " HUN2. - MOVE NUM2 TO FLD1 - IF FLD1 = 9 - DISPLAY "78 VALUE has simple left to right precedence." - ELSE - DISPLAY "78 VALUE is " NUM2 " normal precedence." - END-IF. - MOVE CON5 TO FLD1 - IF FLD1 = 7 - DISPLAY "01 CONSTANT has normal operator precedence." - ELSE - DISPLAY "01 CONSTANT is " CON5 " left to right precedence." - END-IF. - DISPLAY "CON3 is " CON3. - DISPLAY "CON4 is " CON4 " vs " 3.141596 - " & " -2.189 " & " +12. - DISPLAY "CON6 is " CON6 "." - DISPLAY "My Dog's name is " DOGNAME ";". - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_misc.at:8292: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_misc.at:8292" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:8292" -$at_failed && at_fn_log_failure -$at_traceon; } - - -{ set +x -$as_echo "$at_srcdir/run_misc.at:8294: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_misc.at:8294" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo "CAT is 'Cat ' -Yard is 'Cat & Dog ' -DIV1 is 33 -HUN is 143 -HUN2 is 1855 -78 VALUE has simple left to right precedence. -01 CONSTANT has normal operator precedence. -CON3 is 23 -CON4 is 26 vs 3.141596 & -2.189 & +12 -CON6 is 18. -My Dog's name is Piper; -" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:8294" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_672 -#AT_START_673 -at_fn_group_banner 673 'run_misc.at:8311' \ - "DISPLAY UPON" " " 4 -at_xfail=no -( - $as_echo "673. $at_setup_line: testing $at_desc ..." - $at_traceon - -$as_echo "run_misc.at:8312" >"$at_check_line_file" -at_fn_check_skip 77 "$at_srcdir/run_misc.at:8312" - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - CONFIGURATION SECTION. - SPECIAL-NAMES. - PRINTER IS PRINTER. - DATA DIVISION. - WORKING-STORAGE SECTION. - 77 note PIC X(05). - PROCEDURE DIVISION CHAINING note. - DISPLAY "This is sent to CONSOLE " note UPON CONSOLE. - DISPLAY "This is sent to SYSERR " note UPON SYSERR. - DISPLAY "This is sent to PRINTER " note UPON PRINTER. - DISPLAY "This is also sent to CONSOLE " note UPON CONSOLE. - DISPLAY "This is also sent to SYSERR " note UPON SYSERR. - DISPLAY "This is also sent to PRINTER " note UPON PRINTER. - DISPLAY "This is sent to SYSPUNCH " note UPON SYSPUNCH - ON EXCEPTION DISPLAY 'NO ...' UPON SYSERR. - DISPLAY "This is also sent to SYSPUNCH " note UPON SYSPCH - ON EXCEPTION DISPLAY ' ... SYSPUNCH' UPON SYSERR. - STOP RUN RETURNING 0. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_misc.at:8340: \$COMPILE -std=ibm prog.cob" -at_fn_check_prepare_dynamic "$COMPILE -std=ibm prog.cob" "run_misc.at:8340" -( $at_check_trace; $COMPILE -std=ibm prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:8340" -$at_failed && at_fn_log_failure -$at_traceon; } - - -{ set +x -$as_echo "$at_srcdir/run_misc.at:8342: \$COBCRUN_DIRECT ./prog PLAIN" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog PLAIN" "run_misc.at:8342" -( $at_check_trace; $COBCRUN_DIRECT ./prog PLAIN -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "This is sent to SYSERR PLAIN -This is also sent to SYSERR PLAIN -libcob: prog.cob:18: warning: COB_DISPLAY_PUNCH_FILE is invalid, output to SYSPUNCH skipped -NO ... - ... SYSPUNCH -" | \ - $at_diff - "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo "This is sent to CONSOLE PLAIN -This is sent to PRINTER PLAIN -This is also sent to CONSOLE PLAIN -This is also sent to PRINTER PLAIN -" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:8342" -$at_failed && at_fn_log_failure -$at_traceon; } - - -{ set +x -$as_echo "$at_srcdir/run_misc.at:8355: COB_DISPLAY_PRINT_PIPE='cat >>prt.log' \\ -COB_DISPLAY_PUNCH_FILE='punch.out' \\ -\$COBCRUN_DIRECT ./prog PIPE." -at_fn_check_prepare_notrace 'an embedded newline' "run_misc.at:8355" -( $at_check_trace; COB_DISPLAY_PRINT_PIPE='cat >>prt.log' \ -COB_DISPLAY_PUNCH_FILE='punch.out' \ -$COBCRUN_DIRECT ./prog PIPE. -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "This is sent to SYSERR PIPE. -This is also sent to SYSERR PIPE. -" | \ - $at_diff - "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo "This is sent to CONSOLE PIPE. -This is also sent to CONSOLE PIPE. -" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:8355" -$at_failed && at_fn_log_failure -$at_traceon; } - - -{ set +x -$as_echo "$at_srcdir/run_misc.at:8365: COB_DISPLAY_PRINT_FILE='prt.log' \\ -COB_DISPLAY_PUNCH_FILE='punch.out' \\ -\$COBCRUN_DIRECT ./prog PRINT" -at_fn_check_prepare_notrace 'an embedded newline' "run_misc.at:8365" -( $at_check_trace; COB_DISPLAY_PRINT_FILE='prt.log' \ -COB_DISPLAY_PUNCH_FILE='punch.out' \ -$COBCRUN_DIRECT ./prog PRINT -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "This is sent to SYSERR PRINT -This is also sent to SYSERR PRINT -" | \ - $at_diff - "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo "This is sent to CONSOLE PRINT -This is also sent to CONSOLE PRINT -" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:8365" -$at_failed && at_fn_log_failure -$at_traceon; } - - - - -cat >reference <<'_ATEOF' -This is sent to PRINTER PIPE. -This is also sent to PRINTER PIPE. -This is sent to PRINTER PRINT -This is also sent to PRINTER PRINT -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_misc.at:8384: diff reference prt.log" -at_fn_check_prepare_trace "run_misc.at:8384" -( $at_check_trace; diff reference prt.log -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:8384" -if $at_failed; then : - # Previous test "failed" --> check if EOL of PIPE is the issue - -{ set +x -$as_echo "$at_srcdir/run_misc.at:8388: sed -e 's/PIPE.\\r/PIPE./g' prt.log > prt2.log" -at_fn_check_prepare_trace "run_misc.at:8388" -( $at_check_trace; sed -e 's/PIPE.\r/PIPE./g' prt.log > prt2.log -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:8388" -$at_failed && at_fn_log_failure \ -"./prt.log" -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_misc.at:8389: diff reference prt2.log" -at_fn_check_prepare_trace "run_misc.at:8389" -( $at_check_trace; diff reference prt2.log -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:8389" -$at_failed && at_fn_log_failure \ -"./prt.log" -$at_traceon; } - - -fi -$at_failed && at_fn_log_failure \ -"./prt.log" -$at_traceon; } - - - - -cat >reference <<'_ATEOF' -This is sent to SYSPUNCH PRINT -This is also sent to SYSPUNCH PRINT -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_misc.at:8399: diff reference punch.out" -at_fn_check_prepare_trace "run_misc.at:8399" -( $at_check_trace; diff reference punch.out -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:8399" -$at_failed && at_fn_log_failure \ -"./prt.log" \ -"./punch.out" -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_673 -#AT_START_674 -at_fn_group_banner 674 'run_misc.at:8404' \ - "FLOAT-DECIMAL w/o SIZE ERROR" " " 4 -at_xfail=no -( - $as_echo "674. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 FD16 USAGE FLOAT-DECIMAL-16. - 01 SV16 USAGE FLOAT-DECIMAL-16. - 01 FD34 USAGE FLOAT-DECIMAL-34. - 01 SV34 USAGE FLOAT-DECIMAL-34. - - PROCEDURE DIVISION. - CND-000. - DISPLAY "--- FLOAT-DECIMAL-34 ---" - COMPUTE FD34 = (((1.0E7 / 2.1E0) / 3.1E0) - 5.0E-1) * 6.0E0 - DISPLAY "A: " FD34 - - COMPUTE FD34 = (((1.0E7 / 2.9E0) / 3.9E0) - 5.0E-1) * 6.0E0 - DISPLAY "B: " FD34 - MOVE ZERO TO FD34. - COMPUTE FD34 = 1.0E3 / 2.1E0 - ON SIZE ERROR DISPLAY "Z: " FD34 " SIZE ERROR" - NOT ON SIZE ERROR DISPLAY "Z: " FD34 " IS OK" - END-COMPUTE. - - DISPLAY " ..." - DISPLAY "--- FLOAT-DECIMAL-16 ---" - COMPUTE FD16 = (((1.0E7 / 2.1E0) / 3.1E0) - 5.0E-1) * 6.0E0 - DISPLAY "A: " FD16 - - COMPUTE FD16 = (((1.0E7 / 2.9E0) / 3.9E0) - 5.0E-1) * 6.0E0 - DISPLAY "B: " FD16 - MOVE ZERO TO FD16. - COMPUTE FD16 = 1.0E3 / 2.1E0 - ON SIZE ERROR DISPLAY "Z: " FD16 " SIZE ERROR" - NOT ON SIZE ERROR DISPLAY "Z: " FD16 " IS OK" - END-COMPUTE. - - DISPLAY " ..." - DISPLAY "--- 99 + 1 / 3 ---" - MOVE -1 TO FD16, FD34. - COMPUTE FD34 = 99 + 1 / 3 - ON SIZE ERROR DISPLAY "FD34: " FD34 " SIZE ERROR" - NOT ON SIZE ERROR DISPLAY "FD34: " FD34 " IS OK" - END-COMPUTE. - COMPUTE FD16 = 99 + 1 / 3 - ON SIZE ERROR DISPLAY "FD16: " FD16 " SIZE ERROR" - NOT ON SIZE ERROR DISPLAY "FD16: " FD16 " IS OK" - END-COMPUTE. - - DISPLAY " ..." - DISPLAY "--- 99 ---" - MOVE -1 TO FD16, FD34. - COMPUTE FD34 = 99 - ON SIZE ERROR DISPLAY "FD34: " FD34 " SIZE ERROR" - NOT ON SIZE ERROR DISPLAY "FD34: " FD34 " IS OK" - END-COMPUTE. - COMPUTE FD16 = 99 - ON SIZE ERROR DISPLAY "FD16: " FD16 " SIZE ERROR" - NOT ON SIZE ERROR DISPLAY "FD16: " FD16 " IS OK" - END-COMPUTE. - - CND-100-OK. - DISPLAY " ..." - DISPLAY "--- Test overflow ---" - MOVE 9900000000000 TO FD16, FD34. - PERFORM 390 TIMES - MOVE FD16 TO SV16 - COMPUTE FD16 = FD16 * 10 - ON SIZE ERROR GO TO CND-100-ERR - END-COMPUTE - IF FD16 < 9.0 - DISPLAY "FD16: " FD16 " IS Wrong" - GO TO CND-100-ERR - END-IF - END-PERFORM. - DISPLAY "FD16: " FD16 " IS OK". - GO TO CND-200-OK. - CND-100-ERR. - DISPLAY "FD16: after " SV16 " SIZE ERROR". - - CND-200-OK. - MOVE 9900000000000 TO FD16, FD34. - PERFORM 6500 TIMES - MOVE FD34 TO SV34 - COMPUTE FD34 = FD34 * 10 - ON SIZE ERROR GO TO CND-200-ERR - END-COMPUTE - IF FD34 < 9.0 - GO TO CND-200-ERR - END-IF - END-PERFORM. - DISPLAY "FD34: " FD34 " IS OK". - GO TO CND-380-OK. - CND-200-ERR. - DISPLAY "FD34: after " SV34 " SIZE ERROR". - - CND-380-OK. - DISPLAY " ..." - DISPLAY "--- Test underflow ---" - MOVE 0.000000099 TO FD16, FD34. - PERFORM 400 TIMES - MOVE FD16 TO SV16 - COMPUTE FD16 = FD16 / 10 - ON SIZE ERROR GO TO CND-300-ERR - END-COMPUTE - IF FD16 = 0.0 - GO TO CND-300-ERR - END-IF - END-PERFORM. - DISPLAY "FD16: " FD16 " IS OK". - GO TO CND-400-OK. - CND-300-ERR. - DISPLAY "FD16: after " SV16 " SIZE ERROR". - - CND-400-OK. - MOVE 0.000000099 TO FD16, FD34. - PERFORM 6600 TIMES - MOVE FD34 TO SV34 - COMPUTE FD34 = FD34 / 10.0 - ON SIZE ERROR GO TO CND-400-ERR - END-COMPUTE - IF FD34 = 0.0 - GO TO CND-400-ERR - END-IF - END-PERFORM. - DISPLAY "FD34: " FD34 " IS OK". - GO TO CND-999. - CND-400-ERR. - DISPLAY "FD34: after " SV34 " SIZE ERROR". - - CND-999. - STOP RUN. - END PROGRAM prog. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_misc.at:8545: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_misc.at:8545" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:8545" -$at_failed && at_fn_log_failure -$at_traceon; } - - -{ set +x -$as_echo "$at_srcdir/run_misc.at:8547: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_misc.at:8547" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo "--- FLOAT-DECIMAL-34 --- -A: 9216586.861751152073732718894009216 -B: 5305036.78779840848806366047745358 -Z: 476.1904761904761904761904761904761 IS OK - ... ---- FLOAT-DECIMAL-16 --- -A: 9216586.861751152 -B: 5305036.787798408 -Z: 476.1904761904761 IS OK - ... ---- 99 + 1 / 3 --- -FD34: 99.33333333333333333333333333333333 IS OK -FD16: 99.33333333333333 IS OK - ... ---- 99 --- -FD34: 99 IS OK -FD16: 99 IS OK - ... ---- Test overflow --- -FD16: after 99E369 SIZE ERROR -FD34: after 99E6111 SIZE ERROR - ... ---- Test underflow --- -FD16: after 99E-398 SIZE ERROR -FD34: after 99E-6176 SIZE ERROR -" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:8547" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_674 -#AT_START_675 -at_fn_group_banner 675 'run_misc.at:8578' \ - "FLOAT-SHORT / FLOAT-LONG w/o SIZE ERROR" " " 4 -at_xfail=no -( - $as_echo "675. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 CMP1 COMP-1. - 01 SV1 COMP-1. - 01 CMP2 COMP-2. - 01 SV2 COMP-2. - - PROCEDURE DIVISION. - CND-000. - - DISPLAY "--- COMP-1 ---" - COMPUTE CMP1 = (((1.0E7 / 2.1E0) / 3.1E0) - 5.0E-1) * 6.0E0 - DISPLAY "A: " CMP1 - COMPUTE CMP1 = (((1.0E7 / 2.9E0) / 3.9E0) - 5.0E-1) * 6.0E0 - DISPLAY "B: " CMP1 - MOVE ZERO TO CMP1. - COMPUTE CMP1 = 1.0E3 / 2.1E0 - ON SIZE ERROR DISPLAY "Z: " CMP1 " SIZE ERROR" - NOT ON SIZE ERROR DISPLAY "Z: " CMP1 " IS OK" - END-COMPUTE. - - DISPLAY " ..." - DISPLAY "--- COMP-2 ---" - COMPUTE CMP2 = (((1.0E7 / 2.1E0) / 3.1E0) - 5.0E-1) * 6.0E0 - *> because of possible rounding of intermediates and different - *> precision depending on math library / version: plain DISPLAY - IF CMP2 >= 9216586.86175114 AND <= 9216586.86175116 - DISPLAY "A ~ 9216586.86175115" - ELSE - DISPLAY "A: " CMP2 - END-IF - COMPUTE CMP2 = (((1.0E7 / 2.9E0) / 3.9E0) - 5.0E-1) * 6.0E0 - IF CMP2 >= 5305036.7877983 AND <= 5305036.7877985 - DISPLAY "B ~ 5305036.787798408" - ELSE - DISPLAY "B: " CMP2 - END-IF - MOVE ZERO TO CMP2. - COMPUTE CMP2 = 1.0E3 / 2.1E0 - ON SIZE ERROR DISPLAY "Z: " CMP2 " SIZE ERROR" - NOT ON SIZE ERROR - *> see note above - IF CMP2 >= 476.1904761904760 AND <= 476.1904761904763 - DISPLAY "Z ~ 476.1904761904761 IS OK" - ELSE - DISPLAY "Z: " CMP2 " IS OK" - END-IF - END-COMPUTE. - - DISPLAY " ..." - DISPLAY "--- 99 + 1 / 3 ---" - MOVE -1 TO CMP1, CMP2. - COMPUTE CMP1 = 99 + 1 / 3 - ON SIZE ERROR DISPLAY "CMP1: " CMP1 " SIZE ERROR" - NOT ON SIZE ERROR DISPLAY "CMP1: " CMP1 " IS OK" - END-COMPUTE. - COMPUTE CMP2 = 99 + 1 / 3 - ON SIZE ERROR DISPLAY "CMP2: " CMP2 " SIZE ERROR" - NOT ON SIZE ERROR DISPLAY "CMP2: " CMP2 " IS OK" - END-COMPUTE. - - DISPLAY " ..." - DISPLAY "--- 99 ---" - MOVE -1 TO CMP1, CMP2. - COMPUTE CMP1 = 99 - ON SIZE ERROR DISPLAY "CMP1: " CMP1 " SIZE ERROR" - NOT ON SIZE ERROR DISPLAY "CMP1: " CMP1 " IS OK" - END-COMPUTE. - COMPUTE CMP2 = 99 - ON SIZE ERROR DISPLAY "CMP2: " CMP2 " SIZE ERROR" - NOT ON SIZE ERROR DISPLAY "CMP2: " CMP2 " IS OK" - END-COMPUTE. - - CND-100-OK. - DISPLAY " ..." - DISPLAY "--- Test overflow ---" - - MOVE 990000 TO CMP1. - PERFORM 6500 TIMES - MOVE CMP1 TO SV1 - COMPUTE CMP1 = CMP1 * 10 - ON SIZE ERROR GO TO CND-350-ERR - END-COMPUTE - IF CMP1 < 9.0 - GO TO CND-350-ERR - END-IF - END-PERFORM. - DISPLAY "CMP1: " CMP1 " IS OK". - GO TO CND-350-OK. - CND-350-ERR. - DISPLAY "CMP1: after " SV1 " SIZE ERROR". - - CND-350-OK. - MOVE 9900000000 TO CMP2. - PERFORM 6500 TIMES - MOVE CMP2 TO SV2 - COMPUTE CMP2 = CMP2 * 10 - ON SIZE ERROR GO TO CND-380-ERR - END-COMPUTE - IF CMP2 < 9.0 - GO TO CND-380-ERR - END-IF - END-PERFORM. - DISPLAY "CMP2: " CMP2 " IS OK". - GO TO CND-500-OK. - CND-380-ERR. - *> because of possible rounding of intermediates and different - *> precision depending on math library / version: plain DISPLAY - IF SV2 >= 9.899999999999E+307 AND - <= 9.900000000001E+307 - DISPLAY "CMP2: after ~ 9.899999999999781E+307 SIZE ERROR" - ELSE - DISPLAY "CMP2: after " SV2 " SIZE ERROR" - END-IF - . - - CND-500-OK. - MOVE 0.000000099 TO CMP1. - PERFORM 350 TIMES - MOVE CMP1 TO SV1 - COMPUTE CMP1 = CMP1 / 10.0 - ON SIZE ERROR GO TO CND-500-ERR - END-COMPUTE - IF CMP1 = 0.0 - GO TO CND-500-ERR - END-IF - END-PERFORM. - DISPLAY "CMP1: " CMP1 " IS OK". - GO TO CND-600-OK. - CND-500-ERR. - DISPLAY "CMP1: after " SV1 " SIZE ERROR". - - CND-600-OK. - MOVE 0.000000099 TO CMP2. - PERFORM 350 TIMES - MOVE CMP2 TO SV2 - COMPUTE CMP2 = CMP2 / 10.0 - ON SIZE ERROR GO TO CND-600-ERR - END-COMPUTE - IF CMP2 = 0.0 - GO TO CND-600-ERR - END-IF - END-PERFORM. - DISPLAY "CMP2: " CMP2 " IS OK". - GO TO CND-600-XIT. - CND-600-ERR. - IF SV2 >= 9.8813129168249E-324 AND <= 9.881312916825E-324 - DISPLAY "CMP2: after ~ 9.881312916824931E-324 SIZE ERROR" - ELSE - DISPLAY "CMP2: after " SV2 " SIZE ERROR" - END-IF - . - CND-600-XIT. - - CND-999. - STOP RUN. - END PROGRAM prog. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_misc.at:8746: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_misc.at:8746" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:8746" -$at_failed && at_fn_log_failure -$at_traceon; } - - -{ set +x -$as_echo "$at_srcdir/run_misc.at:8748: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_misc.at:8748" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo "--- COMP-1 --- -A: 9216587 -B: 5305037 -Z: 476.19049 IS OK - ... ---- COMP-2 --- -A ~ 9216586.86175115 -B ~ 5305036.787798408 -Z ~ 476.1904761904761 IS OK - ... ---- 99 + 1 / 3 --- -CMP1: 99.333336 IS OK -CMP2: 99.33333333333333 IS OK - ... ---- 99 --- -CMP1: 99 IS OK -CMP2: 99 IS OK - ... ---- Test overflow --- -CMP1: after 9.8999983E+37 SIZE ERROR -CMP2: after ~ 9.899999999999781E+307 SIZE ERROR -CMP1: after 1.4012985E-45 SIZE ERROR -CMP2: after ~ 9.881312916824931E-324 SIZE ERROR -" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:8748" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_675 -#AT_START_676 -at_fn_group_banner 676 'run_misc.at:8777' \ - "FLOAT-SHORT with SIZE ERROR" " " 4 -at_xfail=no -( - $as_echo "676. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - identification division. - program-id. prog. - - data division. - working-storage section. - *------------------------ - 77 counter pic s9(4) binary value zero. - * FLOAT-SHORT (if binary-comp-1 is not active) - 77 floatValue COMP-1 value 2. - 77 lastFloatValue COMP-1. - - ****************************************************************** - procedure division. - main section. - perform varying counter from 1 by 1 until - counter > 130 - *> display 'counter: ' counter ', value: ' floatValue - compute floatValue = floatValue * 2 - ON SIZE ERROR - display 'SIZE ERROR, last value = ' floatValue - exit perform - not ON SIZE ERROR - if floatValue > lastFloatValue - move floatValue to lastFloatValue - else - display 'math ERROR, last value > current: ' - lastFloatValue ' > ' floatValue - exit perform - end-if - end-compute - end-perform - if counter not = 127 - display 'counter is ' counter - end-if - - goback. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_misc.at:8819: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_misc.at:8819" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:8819" -$at_failed && at_fn_log_failure -$at_traceon; } - - -{ set +x -$as_echo "$at_srcdir/run_misc.at:8821: ./prog" -at_fn_check_prepare_trace "run_misc.at:8821" -( $at_check_trace; ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo "SIZE ERROR, last value = 1.7014118E+38 -" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:8821" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_676 -#AT_START_677 -at_fn_group_banner 677 'run_misc.at:8828' \ - "FLOAT-LONG with SIZE ERROR" " " 4 -at_xfail=no -( - $as_echo "677. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - identification division. - program-id. prog. - - data division. - working-storage section. - *------------------------ - 77 counter pic s9(4) binary value zero. - * FLOAT-LONG - 77 doubleValue COMP-2 value 2. - 77 lastDoubleValue COMP-2. - - ****************************************************************** - procedure division. - main section. - perform varying counter from 1 by 1 until - counter > 1060 - *> display 'counter: ' counter ', value: ' doubleValue - compute doubleValue = doubleValue * 2 - ON SIZE ERROR - display 'SIZE ERROR raised' - with no advancing upon syserr - end-display - display 'SIZE ERROR, last value = ' doubleValue - upon sysout - end-display - exit perform - not ON SIZE ERROR - if doubleValue > lastdoubleValue - move doubleValue to lastdoubleValue - else - display 'math ERROR, last value > current: ' - lastdoubleValue ' > ' doubleValue - upon syserr - end-display - exit perform - end-if - end-compute - end-perform - if not (counter >= 1023 and <=1025) - display ' ' upon syserr - display 'counter is ' counter upon syserr - end-if - - goback. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_misc.at:8878: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_misc.at:8878" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:8878" -$at_failed && at_fn_log_failure -$at_traceon; } - -# note: the actual value is not checked as this depends on intermediate rounding -{ set +x -$as_echo "$at_srcdir/run_misc.at:8880: ./prog" -at_fn_check_prepare_trace "run_misc.at:8880" -( $at_check_trace; ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "SIZE ERROR raised" | \ - $at_diff - "$at_stderr" || at_failed=: -echo stdout:; cat "$at_stdout" -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:8880" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_677 -#AT_START_678 -at_fn_group_banner 678 'run_misc.at:8885' \ - "EC-SIZE-ZERO-DIVIDE" " " 4 -at_xfail=no -( - $as_echo "678. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 x PIC 9 VALUE 0. - 01 y PIC 9 VALUE 0. - - PROCEDURE DIVISION. - DIVIDE x BY y GIVING y - ON SIZE ERROR CONTINUE END-DIVIDE - IF FUNCTION TRIM(FUNCTION EXCEPTION-STATUS) - NOT = 'EC-SIZE-ZERO-DIVIDE' - DISPLAY 'Wrong/missing exception: ' - FUNCTION EXCEPTION-STATUS - END-DISPLAY - END-IF - SET LAST EXCEPTION TO OFF - IF FUNCTION EXCEPTION-STATUS NOT = SPACES - DISPLAY 'Exception is not empty after reset: ' - FUNCTION EXCEPTION-STATUS - END-DISPLAY - END-IF - MOVE 0 TO y - COMPUTE y = x - 1 / y + 6.5 - ON SIZE ERROR CONTINUE END-COMPUTE - IF FUNCTION TRIM(FUNCTION EXCEPTION-STATUS) - NOT = 'EC-SIZE-ZERO-DIVIDE' - DISPLAY 'Wrong/missing exception: ' - FUNCTION EXCEPTION-STATUS - END-DISPLAY - END-IF - . -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_misc.at:8925: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_misc.at:8925" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:8925" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_misc.at:8926: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_misc.at:8926" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:8926" -$at_failed && at_fn_log_failure -$at_traceon; } - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_678 -#AT_START_679 -at_fn_group_banner 679 'run_misc.at:8930' \ - "EC-SIZE-OVERFLOW" " " 4 -at_xfail=no -( - $as_echo "679. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 x PIC 9 VALUE 1. - 01 y PIC 9. - - PROCEDURE DIVISION. - * raise exception checked in previous test - * as it may interfere with the expected exception - DIVIDE x BY y GIVING y - ON SIZE ERROR CONTINUE END-DIVIDE - DIVIDE x BY 0.1 GIVING y - ON SIZE ERROR CONTINUE END-DIVIDE - IF FUNCTION TRIM(FUNCTION EXCEPTION-STATUS) - NOT = 'EC-SIZE-OVERFLOW' - DISPLAY 'Wrong/missing exception: ' - FUNCTION EXCEPTION-STATUS - END-DISPLAY - END-IF - . -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_misc.at:8958: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_misc.at:8958" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:8958" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_misc.at:8959: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_misc.at:8959" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:8959" -$at_failed && at_fn_log_failure -$at_traceon; } - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_679 -#AT_START_680 -at_fn_group_banner 680 'run_misc.at:8963' \ - "Constant Expressions" " " 4 -at_xfail=no -( - $as_echo "680. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 VAR PIC X(200). - 01 OTHERVAR PIC X(115). - 78 VAR-LEN VALUE 115. - - PROCEDURE DIVISION. - MAIN-10. - MOVE "Peek a boo" TO VAR. - EVALUATE TRUE - ALSO FALSE - ALSO TRUE - WHEN TRUE - ALSO VAR-LEN > 16 AND VAR-LEN < 200 - ALSO TRUE - MOVE OTHERVAR (1 : VAR-LEN - 9) - TO VAR (16 - VAR-LEN : VAR-LEN - 9) - DISPLAY "A: Should NOT be executed" - WHEN TRUE - ALSO VAR-LEN < 16 - ALSO TRUE - MOVE OTHERVAR TO VAR - DISPLAY "A: OK VAR-LEN > 16 AND VAR-LEN < 200" - WHEN TRUE - ALSO VAR = SPACES - ALSO TRUE - MOVE OTHERVAR TO VAR - DISPLAY "A: OK VAR IS SPACES" - END-EVALUATE. - - MOVE "Peek a boo" TO VAR. - EVALUATE 3 EQUALS 7 - WHEN VAR = SPACES - DISPLAY "B: OK VAR IS NOT SPACES" - WHEN VAR NOT = SPACES - DISPLAY "B: FALSE VAR IS SPACES" - END-EVALUATE. - - MOVE SPACES TO VAR. - EVALUATE FALSE - WHEN VAR = SPACES - DISPLAY "C: FALSE VAR IS SPACES" - WHEN VAR NOT = SPACES - DISPLAY "C: OK VAR IS SPACES" - END-EVALUATE. - - MOVE "Peek a boo" TO VAR. - EVALUATE TRUE - WHEN VAR = SPACES - DISPLAY "D: BAD VAR IS SPACES" - WHEN VAR NOT = SPACES - DISPLAY "D: OK VAR IS NOT SPACES" - END-EVALUATE. - - MOVE SPACES TO VAR. - EVALUATE VAR-LEN ALSO VAR - WHEN < 32 ALSO SPACES - DISPLAY "E: OK VAR IS SPACES" - WHEN > 16 ALSO NOT SPACES - DISPLAY "E: BAD VAR IS NOT SPACES" - WHEN OTHER - DISPLAY "E: OK OTHER option taken" - END-EVALUATE. - - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_misc.at:9036: \$COMPILE prog.cob -w" -at_fn_check_prepare_dynamic "$COMPILE prog.cob -w" "run_misc.at:9036" -( $at_check_trace; $COMPILE prog.cob -w -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob: in paragraph 'MAIN-10': -prog.cob:20: error (ignored): offset must be greater than zero -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:9036" -$at_failed && at_fn_log_failure -$at_traceon; } - - -{ set +x -$as_echo "$at_srcdir/run_misc.at:9041: ./prog" -at_fn_check_prepare_trace "run_misc.at:9041" -( $at_check_trace; ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo "A: OK VAR-LEN > 16 AND VAR-LEN < 200 -B: OK VAR IS NOT SPACES -C: OK VAR IS SPACES -D: OK VAR IS NOT SPACES -E: OK OTHER option taken -" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:9041" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_680 -#AT_START_681 -at_fn_group_banner 681 'run_misc.at:9052' \ - "ENTRY FOR GO TO / GO TO ENTRY" " " 4 -at_xfail=no -( - $as_echo "681. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 JUMP-ENTRY PIC 9 VALUE 6. - 88 EXT-MODUS VALUES 3, 4. - LINKAGE SECTION. - PROCEDURE DIVISION. - GO TO ENTRY 'STMT05'. - MAIN. - GO TO ENTRY 'STMT01' - 'STMT02' - 'STMT03' - 'STMT04' - 'STMT05' - DEPENDING ON JUMP-ENTRY - DISPLAY 'NOT JUMPED' - GOBACK. - ENTRY FOR GO TO 'STMT01' - DISPLAY 'STMT01' - ENTRY FOR GO TO 'STMT02' - PERFORM 3 TIMES - ENTRY FOR GO TO 'STMT03' - DISPLAY 'STMT03' - ENTRY FOR GO TO 'STMT04' DISPLAY 'STMT04' - IF EXT-MODUS EXIT PERFORM END-IF - END-PERFORM - ENTRY FOR GO TO 'STMT05' - DISPLAY 'STMT05' - SUBTRACT 1 FROM JUMP-ENTRY - GO TO MAIN. - -_ATEOF - - -# TODO: move to syntax checks, together with all expected error messages -{ set +x -$as_echo "$at_srcdir/run_misc.at:9091: \$COMPILE -std=mf-strict prog.cob" -at_fn_check_prepare_dynamic "$COMPILE -std=mf-strict prog.cob" "run_misc.at:9091" -( $at_check_trace; $COMPILE -std=mf-strict prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob:10: error: ENTRY FOR GO TO does not conform to Micro Focus COBOL -prog.cob: in paragraph 'MAIN': -prog.cob:18: error: ENTRY FOR GO TO does not conform to Micro Focus COBOL -prog.cob:20: error: ENTRY FOR GO TO does not conform to Micro Focus COBOL -prog.cob:22: error: ENTRY FOR GO TO does not conform to Micro Focus COBOL -prog.cob:24: error: ENTRY FOR GO TO does not conform to Micro Focus COBOL -prog.cob:26: error: ENTRY FOR GO TO does not conform to Micro Focus COBOL -prog.cob:29: error: ENTRY FOR GO TO does not conform to Micro Focus COBOL -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/run_misc.at:9091" -$at_failed && at_fn_log_failure -$at_traceon; } - - -{ set +x -$as_echo "$at_srcdir/run_misc.at:9102: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_misc.at:9102" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob:10: warning: ENTRY FOR GO TO used -prog.cob: in paragraph 'MAIN': -prog.cob:18: warning: ENTRY FOR GO TO used -prog.cob:20: warning: ENTRY FOR GO TO used -prog.cob:22: warning: ENTRY FOR GO TO used -prog.cob:24: warning: ENTRY FOR GO TO used -prog.cob:26: warning: ENTRY FOR GO TO used -prog.cob:29: warning: ENTRY FOR GO TO used -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:9102" -$at_failed && at_fn_log_failure -$at_traceon; } - - -{ set +x -$as_echo "$at_srcdir/run_misc.at:9113: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_misc.at:9113" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo "STMT05 -STMT05 -STMT04 -STMT05 -STMT03 -STMT04 -STMT05 -STMT03 -STMT04 -STMT03 -STMT04 -STMT03 -STMT04 -STMT05 -STMT01 -STMT03 -STMT04 -STMT03 -STMT04 -STMT03 -STMT04 -STMT05 -NOT JUMPED -" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:9113" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_681 -#AT_START_682 -at_fn_group_banner 682 'run_misc.at:9142' \ - "PERFORM VARYING Float" " " 4 -at_xfail=no -( - $as_echo "682. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 i USAGE FLOAT-LONG. - - PROCEDURE DIVISION. - PERFORM VARYING i FROM 1.0 BY 1.0 UNTIL i > 5.0 - DISPLAY i " " NO ADVANCING - END-PERFORM . - DISPLAY "Test Part 1 Completed". - PERFORM VARYING i FROM 1 BY 1 UNTIL i > 5 - DISPLAY i " " NO ADVANCING - END-PERFORM . - DISPLAY "Test Part 2 Completed". - PERFORM VARYING i FROM 5 BY -1 UNTIL i < 1 - DISPLAY i " " NO ADVANCING - END-PERFORM . - DISPLAY "Test Part 3 Completed". - STOP RUN. - END PROGRAM prog. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_misc.at:9170: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_misc.at:9170" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:9170" -$at_failed && at_fn_log_failure -$at_traceon; } - - -{ set +x -$as_echo "$at_srcdir/run_misc.at:9172: ./prog" -at_fn_check_prepare_trace "run_misc.at:9172" -( $at_check_trace; ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo "1 2 3 4 5 Test Part 1 Completed -1 2 3 4 5 Test Part 2 Completed -5 4 3 2 1 Test Part 3 Completed -" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:9172" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_682 -#AT_START_683 -at_fn_group_banner 683 'run_misc.at:9180' \ - "Test PICTURE with Edit mask" " " 4 -at_xfail=no -( - $as_echo "683. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 TST. - 05 DEPT-SUB PIC 9(7)V999 VALUE 18536.232. - 05 DEPT-COST-YTD PIC 9(5)V999 VALUE 18536.232. - 05 DL-PROD-COST PIC $$$,$$9.99. - 77 WFLT PIC $$$,$$9.99. - - PROCEDURE DIVISION. - MOVE 18536.23 TO WFLT. - DISPLAY "WFLT IS " WFLT. - MULTIPLY DEPT-COST-YTD BY 1 GIVING DL-PROD-COST ROUNDED. - DISPLAY "COST IS " DL-PROD-COST. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_misc.at:9202: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_misc.at:9202" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:9202" -$at_failed && at_fn_log_failure -$at_traceon; } - - -{ set +x -$as_echo "$at_srcdir/run_misc.at:9204: ./prog" -at_fn_check_prepare_trace "run_misc.at:9204" -( $at_check_trace; ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo "WFLT IS \$18,536.23 -COST IS \$18,536.23 -" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:9204" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_683 -#AT_START_684 -at_fn_group_banner 684 'run_misc.at:9211' \ - "COMP-3 Index" " " 4 -at_xfail=no -( - $as_echo "684. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 WS-PAGE-NUMBER PIC 9(4) COMP-3 VALUE ZERO. - 01 WS-LINE-NUMBER PIC 9(3) VALUE ZERO. - PROCEDURE DIVISION. - PERFORM VARYING WS-LINE-NUMBER FROM 1 BY 1 - UNTIL WS-LINE-NUMBER > 10 - ADD 1 TO WS-PAGE-NUMBER - DISPLAY WS-PAGE-NUMBER - END-PERFORM. - STOP RUN RETURNING 0. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_misc.at:9230: cobc -x -std=mf -w prog.cob" -at_fn_check_prepare_trace "run_misc.at:9230" -( $at_check_trace; cobc -x -std=mf -w prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:9230" -$at_failed && at_fn_log_failure -$at_traceon; } - - -{ set +x -$as_echo "$at_srcdir/run_misc.at:9232: ./prog" -at_fn_check_prepare_trace "run_misc.at:9232" -( $at_check_trace; ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo "0001 -0002 -0003 -0004 -0005 -0006 -0007 -0008 -0009 -0010 -" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:9232" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_684 -#AT_START_685 -at_fn_group_banner 685 'run_misc.at:9247' \ - "POINTER" " " 4 -at_xfail=no -( - $as_echo "685. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 XX. - 02 XX-1 PIC X(4) VALUE "1234". - 02 XX-2 PIC X(4) VALUE "5678". - 01 P-XX-1 POINTER. - 01 P-XX-2 POINTER. - LINKAGE SECTION. - 01 Y2 PIC X(4). - PROCEDURE DIVISION. - SET P-XX-1 TO ADDRESS OF XX-1 - SET P-XX-2 TO ADDRESS OF XX-2 - SET ADDRESS OF Y2 TO ADDRESS OF XX-1 - SET ADDRESS OF Y2 UP BY 4 - IF Y2 NOT = XX-2 - DISPLAY "Test 2 '" Y2 "'" - END-DISPLAY - END-IF - IF ADDRESS OF Y2 NOT= P-XX-2 - DISPLAY "Pointer test failed" - ELSE - DISPLAY "Pointer test was good" - END-IF - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_misc.at:9279: cobc -x -std=mf -w prog.cob" -at_fn_check_prepare_trace "run_misc.at:9279" -( $at_check_trace; cobc -x -std=mf -w prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:9279" -$at_failed && at_fn_log_failure -$at_traceon; } - - -{ set +x -$as_echo "$at_srcdir/run_misc.at:9281: ./prog" -at_fn_check_prepare_trace "run_misc.at:9281" -( $at_check_trace; ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo "Pointer test was good -" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:9281" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_685 -#AT_START_686 -at_fn_group_banner 686 'run_misc.at:9286' \ - "Figurative constants to numeric field" " " 4 -at_xfail=no -( - $as_echo "686. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 NUM9 PIC 9(6). - PROCEDURE DIVISION. - MOVE SPACES TO NUM9 - DISPLAY "NUM9 value SPACES is " NUM9 "." UPON SYSOUT - MOVE LOW-VALUES TO NUM9 - IF NUM9 = LOW-VALUES - DISPLAY "9(6) tests OK for LOW-VALUES" UPON SYSOUT - ELSE - DISPLAY "9(6) Does NOT test OK for LOW-VALUES" - UPON SYSOUT - IF NUM9 = ZERO - DISPLAY "9(6) tests as ZERO instead of LOW-VALUES" - UPON SYSOUT - END-IF - END-IF. - MOVE HIGH-VALUES TO NUM9 - IF NUM9 = HIGH-VALUES - DISPLAY "9(6) tests OK for HIGH-VALUES" UPON SYSOUT - ELSE - DISPLAY "9(6) Does NOT test OK for HIGH-VALUES" - UPON SYSOUT - IF NUM9 = ZERO - DISPLAY "9(6) tests as ZERO instead of HIGH-VALUES" - UPON SYSOUT - END-IF - END-IF. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_misc.at:9323: \$COMPILE -std=mf prog.cob" -at_fn_check_prepare_dynamic "$COMPILE -std=mf prog.cob" "run_misc.at:9323" -( $at_check_trace; $COMPILE -std=mf prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob:8: warning: source is non-numeric - substituting zero -prog.cob:10: warning: source is non-numeric - substituting zero -prog.cob:21: warning: source is non-numeric - substituting zero -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:9323" -$at_failed && at_fn_log_failure -$at_traceon; } - - -{ set +x -$as_echo "$at_srcdir/run_misc.at:9329: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_misc.at:9329" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo "NUM9 value SPACES is 000000. -9(6) Does NOT test OK for LOW-VALUES -9(6) tests as ZERO instead of LOW-VALUES -9(6) Does NOT test OK for HIGH-VALUES -9(6) tests as ZERO instead of HIGH-VALUES -" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:9329" -$at_failed && at_fn_log_failure -$at_traceon; } - - -{ set +x -$as_echo "$at_srcdir/run_misc.at:9337: \$COMPILE -std=acu prog.cob -o aprog" -at_fn_check_prepare_dynamic "$COMPILE -std=acu prog.cob -o aprog" "run_misc.at:9337" -( $at_check_trace; $COMPILE -std=acu prog.cob -o aprog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:9337" -$at_failed && at_fn_log_failure -$at_traceon; } - - -{ set +x -$as_echo "$at_srcdir/run_misc.at:9339: \$COBCRUN_DIRECT ./aprog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./aprog" "run_misc.at:9339" -( $at_check_trace; $COBCRUN_DIRECT ./aprog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo "NUM9 value SPACES is . -9(6) tests OK for LOW-VALUES -9(6) tests OK for HIGH-VALUES -" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:9339" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_686 -#AT_START_687 -at_fn_group_banner 687 'run_misc.at:9350' \ - "READY TRACE / RESET TRACE" " " 4 -at_xfail=no -( - $as_echo "687. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >caller.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. caller. - * - PROCEDURE DIVISION. - READY TRACE - MOVE 1 TO RETURN-CODE - RESET TRACE - CALL "callee1" - END-CALL - READY TRACE - MOVE 2 TO RETURN-CODE - CALL "callee1" - END-CALL - CALL "callee1" - CANCEL "callee1" - CALL "callrec" - MOVE 0 TO RETURN-CODE - STOP RUN. -_ATEOF - - -cat >callee1.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. callee1. - PROCEDURE DIVISION. - ADD 1 TO RETURN-CODE - NOT ON SIZE ERROR - IF RETURN-CODE = 1 - CONTINUE - ELSE IF RETURN-CODE = 2 - CONTINUE - ELSE - CONTINUE - . - EVALUATE RETURN-CODE - WHEN 1 - CONTINUE - WHEN 2 - WHEN 3 - CONTINUE - WHEN OTHER - CONTINUE - END-EVALUATE - EVALUATE TRUE - WHEN RETURN-CODE = 1 - CONTINUE - WHEN RETURN-CODE = 2 - WHEN RETURN-CODE = 3 - CONTINUE - WHEN OTHER - CONTINUE - END-EVALUATE - CALL "callee2" END-CALL - CANCEL "callee2" CALL "callee2b" END-CALL CANCEL "callee2b" - SUBTRACT 1 FROM RETURN-CODE END-SUBTRACT - EXIT PROGRAM. -_ATEOF - - -cat >callee2.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. callee2. - PROCEDURE DIVISION. - COMPUTE RETURN-CODE - = 1 + 1 - ON SIZE ERROR - MOVE -1 TO RETURN-CODE - NOT ON SIZE ERROR - COMPUTE RETURN-CODE - = 1 + 1 - END-COMPUTE - END-COMPUTE. - CALL "callee2c" END-CALL - CANCEL "callee2c" - MOVE 0 TO RETURN-CODE. - EXIT PROGRAM. -_ATEOF - - -cat >preload.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. callee2b. - PROCEDURE DIVISION. - SOME-SEC SECTION. - SOME-PAR. - PERFORM OTHER-SEC - MOVE 0 TO RETURN-CODE. - ENTRY "LEAVE-ME". - END-PAR. - EXIT PROGRAM. - OTHER-SEC SECTION. - COMPUTE RETURN-CODE = 1 + 2 END-COMPUTE. - EX. EXIT. -_ATEOF - - -cat >preload2.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. callrec IS RECURSIVE. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 filler PIC 9 VALUE 0. - 88 first-call VALUE 0. - 88 called VALUE 1. - PROCEDURE DIVISION. - SOME-SEC SECTION. - IF first-call - SET called TO TRUE - CALL 'callrec' - END-IF - GOBACK. -_ATEOF - - -cat >callee2c.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. callee2c. - PROCEDURE DIVISION. - SOME-SEC SECTION. - SOME-PAR. - PERFORM OTHER-SEC - MOVE 0 TO RETURN-CODE. - END-PAR. - EXIT PROGRAM. - OTHER-SEC SECTION. - COMPUTE RETURN-CODE = 1 + 2 END-COMPUTE. - EX. EXIT. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_misc.at:9480: \$COBC -ftraceall callee1.cob" -at_fn_check_prepare_dynamic "$COBC -ftraceall callee1.cob" "run_misc.at:9480" -( $at_check_trace; $COBC -ftraceall callee1.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:9480" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_misc.at:9481: \$COBC callee2.cob" -at_fn_check_prepare_dynamic "$COBC callee2.cob" "run_misc.at:9481" -( $at_check_trace; $COBC callee2.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:9481" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_misc.at:9482: \$COBC -ftrace preload.cob" -at_fn_check_prepare_dynamic "$COBC -ftrace preload.cob" "run_misc.at:9482" -( $at_check_trace; $COBC -ftrace preload.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:9482" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_misc.at:9483: \$COBC -ftraceall preload2.cob" -at_fn_check_prepare_dynamic "$COBC -ftraceall preload2.cob" "run_misc.at:9483" -( $at_check_trace; $COBC -ftraceall preload2.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:9483" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_misc.at:9484: \$COBC -fsource-location callee2c.cob" -at_fn_check_prepare_dynamic "$COBC -fsource-location callee2c.cob" "run_misc.at:9484" -( $at_check_trace; $COBC -fsource-location callee2c.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:9484" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_misc.at:9485: \$COBC -x -o prog -ftraceall caller.cob" -at_fn_check_prepare_dynamic "$COBC -x -o prog -ftraceall caller.cob" "run_misc.at:9485" -( $at_check_trace; $COBC -x -o prog -ftraceall caller.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:9485" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_misc.at:9486: COB_PHYSICAL_CANCEL=1 COB_PRE_LOAD=\"preload\"\$PATHSEP\"preload2\" \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "COB_PHYSICAL_CANCEL=1 COB_PRE_LOAD=\"preload\"$PATHSEP\"preload2\" $COBCRUN_DIRECT ./prog" "run_misc.at:9486" -( $at_check_trace; COB_PHYSICAL_CANCEL=1 COB_PRE_LOAD="preload"$PATHSEP"preload2" $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "Source: 'caller.cob' -Program-Id: caller -Program-Id: caller MOVE Line: 7 -Program-Id: caller RESET TRACE Line: 8 -Program-Id: caller MOVE Line: 12 -Program-Id: caller CALL Line: 13 -Source: 'callee1.cob' -Program-Id: callee1 -Program-Id: callee1 Entry: callee1 Line: 4 -Program-Id: callee1 ADD Line: 5 -Program-Id: callee1 IF Line: 7 -Program-Id: callee1 IF Line: 9 -Program-Id: callee1 CONTINUE Line: 12 -Program-Id: callee1 EVALUATE Line: 14 -Program-Id: callee1 WHEN Line: 15 -Program-Id: callee1 CONTINUE Line: 21 -Program-Id: callee1 EVALUATE Line: 23 -Program-Id: callee1 WHEN Line: 24 -Program-Id: callee1 WHEN Line: 27 -Program-Id: callee1 CONTINUE Line: 30 -Program-Id: callee1 CALL Line: 32 -Program-Id: callee1 CANCEL Line: 33 -Program-Id: callee1 CALL Line: 33 -Source: 'preload.cob' -Program-Id: callee2b -Program-Id: callee2b Entry: callee2b Line: 4 -Program-Id: callee2b Section: SOME-SEC Line: 5 -Program-Id: callee2b Paragraph: SOME-PAR Line: 6 -Program-Id: callee2b Section: OTHER-SEC Line: 12 -Program-Id: callee2b Paragraph: EX Line: 14 -Program-Id: callee2b Entry: LEAVE-ME Line: 14 -Program-Id: callee2b Paragraph: END-PAR Line: 10 -Program-Id: callee2b Exit: callee2b Line: 10 -Source: 'callee1.cob' -Program-Id: callee1 -Program-Id: callee1 CANCEL Line: 33 -Program-Id: callee1 SUBTRACT Line: 34 -Program-Id: callee1 EXIT PROGRAM Line: 35 -Program-Id: callee1 Exit: callee1 Line: 35 -Source: 'caller.cob' -Program-Id: caller -Program-Id: caller CALL Line: 15 -Source: 'callee1.cob' -Program-Id: callee1 -Program-Id: callee1 Entry: callee1 Line: 4 -Program-Id: callee1 ADD Line: 5 -Program-Id: callee1 IF Line: 7 -Program-Id: callee1 IF Line: 9 -Program-Id: callee1 CONTINUE Line: 12 -Program-Id: callee1 EVALUATE Line: 14 -Program-Id: callee1 WHEN Line: 15 -Program-Id: callee1 CONTINUE Line: 21 -Program-Id: callee1 EVALUATE Line: 23 -Program-Id: callee1 WHEN Line: 24 -Program-Id: callee1 WHEN Line: 27 -Program-Id: callee1 CONTINUE Line: 30 -Program-Id: callee1 CALL Line: 32 -Program-Id: callee1 CANCEL Line: 33 -Program-Id: callee1 CALL Line: 33 -Source: 'preload.cob' -Program-Id: callee2b -Program-Id: callee2b Entry: callee2b Line: 4 -Program-Id: callee2b Section: SOME-SEC Line: 5 -Program-Id: callee2b Paragraph: SOME-PAR Line: 6 -Program-Id: callee2b Section: OTHER-SEC Line: 12 -Program-Id: callee2b Paragraph: EX Line: 14 -Program-Id: callee2b Entry: LEAVE-ME Line: 14 -Program-Id: callee2b Paragraph: END-PAR Line: 10 -Program-Id: callee2b Exit: callee2b Line: 10 -Source: 'callee1.cob' -Program-Id: callee1 -Program-Id: callee1 CANCEL Line: 33 -Program-Id: callee1 SUBTRACT Line: 34 -Program-Id: callee1 EXIT PROGRAM Line: 35 -Program-Id: callee1 Exit: callee1 Line: 35 -Source: 'caller.cob' -Program-Id: caller -Program-Id: caller CANCEL Line: 16 -Program-Id: caller CALL Line: 17 -Source: 'preload2.cob' -Program-Id: callrec -Program-Id: callrec Entry: callrec Line: 9 -Program-Id: callrec Section: SOME-SEC Line: 10 -Program-Id: callrec IF Line: 11 -Program-Id: callrec SET Line: 12 -Program-Id: callrec CALL Line: 13 -Program-Id: callrec Entry: callrec Line: 9 -Program-Id: callrec Section: SOME-SEC Line: 10 -Program-Id: callrec IF Line: 11 -Program-Id: callrec GOBACK Line: 15 -Program-Id: callrec Exit: callrec Line: 15 -Program-Id: callrec GOBACK Line: 15 -Program-Id: callrec Exit: callrec Line: 15 -Source: 'caller.cob' -Program-Id: caller -Program-Id: caller MOVE Line: 18 -Program-Id: caller STOP RUN Line: 19 -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:9486" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_687 -#AT_START_688 -at_fn_group_banner 688 'run_misc.at:9589' \ - "Test dump feature" " " 4 -at_xfail=no -( - $as_echo "688. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >./cpyabrt <<'_ATEOF' - - MOVE "Quick brown fox jumped over the dog" - TO TSTTAILX (1:40). - MOVE CM-COMPANY TO TSTTAILX (42:20). - * DISPLAY ':' X ':'. - * DISPLAY CM-COMPANY. - * DISPLAY '>' CM-COMPANY '<'. -_ATEOF - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - CONFIGURATION SECTION. - - INPUT-OUTPUT SECTION. - FILE-CONTROL. - SELECT FLATFILE ASSIGN EXTERNAL RELFIX - ORGANIZATION RELATIVE - ACCESS IS SEQUENTIAL RELATIVE KEY IS REC-NUM - FILE STATUS IS CUST-STAT. - - DATA DIVISION. - FILE SECTION. - FD FLATFILE - BLOCK CONTAINS 5 RECORDS. - - 01 TSPFL-RECORD. - 10 CM-CUST-NUM PICTURE X(8). - 10 CM-COMPANY PICTURE X(25). - 10 CM-DISK PICTURE X(8). - 10 CM-NO-TERMINALS PICTURE 9(4). - - WORKING-STORAGE SECTION. - 77 MAX-SUB VALUE 6 PICTURE 9(4) COMP SYNC. - 77 CUST-STAT PICTURE X(2). - 77 REC-NUM VALUE 1 PICTURE 9(4). - 01 BIN PIC 9(9) BINARY VALUE 0. - - 01 TEST-DATA. - 02 DATA-CUST-NUM-TBL. - 05 FILLER PIC X(8) VALUE "ALP00000". - 05 FILLER PIC X(8) VALUE "BET00000". - 05 FILLER PIC X(8) VALUE "DEL00000". - 05 FILLER PIC X(8) VALUE "EPS00000". - 05 FILLER PIC X(8) VALUE "FOR00000". - 05 FILLER PIC X(8) VALUE "GAM00000". - - 02 DATA-CUST-NUM REDEFINES DATA-CUST-NUM-TBL - PIC X(8) OCCURS 6. - 02 DATA-COMPANY-TBL. - 05 FILLER PIC X(25) VALUE "ALPHA ELECTRICAL CO. LTD.". - 05 FILLER PIC X(25) VALUE "BETA SHOE MFG. INC. ". - 05 FILLER PIC X(25) VALUE "DELTA LUGGAGE REPAIRS ". - 05 FILLER PIC X(25) VALUE "EPSILON EQUIPMENT SUPPLY ". - 05 FILLER PIC X(25) VALUE "FORTUNE COOKIE COMPANY ". - 05 FILLER PIC X(25) VALUE "GAMMA X-RAY TECHNOLOGY ". - 02 DATA-COMPANY REDEFINES DATA-COMPANY-TBL - PIC X(25) OCCURS 6. - 02 DATA-ADDRESS-2-TBL. - 05 FILLER PIC X(10) VALUE "ATLANTA ". - 05 FILLER PIC X(10) VALUE "CALGARY ". - 05 FILLER PIC X(10) VALUE "NEW YORK ". - 05 FILLER PIC X(10) VALUE "TORONTO ". - 05 FILLER PIC X(10) VALUE "WASHINGTON". - 05 FILLER PIC X(10) VALUE "WHITEPLAIN". - 02 DATA-ADDRESS REDEFINES DATA-ADDRESS-2-TBL - PIC X(10) OCCURS 6. - - 02 DATA-NO-TERMINALS-TBL. - 05 FILLER PIC 9(3) COMP-3 VALUE 10. - 05 FILLER PIC 9(3) COMP-3 VALUE 13. - 05 FILLER PIC 9(3) COMP-3 VALUE 75. - 05 FILLER PIC 9(3) COMP-3 VALUE 10. - 05 FILLER PIC 9(3) COMP-3 VALUE 90. - 05 FILLER PIC 9(3) COMP-3 VALUE 254. - 02 DATA-NO-TERMINALS REDEFINES DATA-NO-TERMINALS-TBL - PIC 9(3) COMP-3 OCCURS 6. - 01 WORK-AREA IS EXTERNAL. - 05 SUB PICTURE 9(4) COMP SYNC. - 88 ODD-RECORD VALUE 1 3 5. - - - PROCEDURE DIVISION. - - PERFORM LOADFILE. - - OPEN INPUT FLATFILE. - READ FLATFILE. - - MAIN-100. - PERFORM CALL-SUB-1. - PERFORM CALL-SUB-2. - PERFORM CALL-IT-OMIT. - STOP RUN. - - LOADFILE. - OPEN OUTPUT FLATFILE. - - PERFORM LOAD-RECORD - VARYING SUB FROM 1 BY 1 - UNTIL SUB > MAX-SUB. - - CLOSE FLATFILE. - - LOAD-RECORD. - - MOVE SPACES TO TSPFL-RECORD. - MOVE DATA-CUST-NUM (SUB) TO CM-CUST-NUM. - MOVE DATA-COMPANY (SUB) TO CM-COMPANY. - MOVE DATA-NO-TERMINALS (SUB) TO CM-NO-TERMINALS. - IF ODD-RECORD - MOVE "8417" TO CM-DISK - ELSE - MOVE "8470" TO CM-DISK. - WRITE TSPFL-RECORD. - - CALL-SUB-1 SECTION. - CALL "sub1" USING bin, TSPFL-RECORD. - - CALL-SUB-2 SECTION. - MOVE 4096 TO bin - CALL "sub2" USING bin, TSPFL-RECORD. - - CALL-IT-OMIT SECTION. - MOVE 5440 TO bin - CALL "sub1" USING bin, OMITTED. - - END PROGRAM prog. - - IDENTIFICATION DIVISION. - PROGRAM-ID. sub1. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 ZRO PIC 9(9) BINARY VALUE 0. - 01 HEXV PIC X COMP-X. - 01 HEXC REDEFINES HEXV PIC X. - - 01 TEST-BASED BASED. - 05 TEST-BASED-SUB PIC X(00000100000). - - 01 TEST-ALLOCED BASED. - 05 TEST-ALLOCED-SUB1 PIC X(010). - 05 TEST-ALLOCED-SUB2 PIC 9(006). - - 01 IDX PIC 9(9) BINARY VALUE 0. - 01 TSTREC. - 05 TSTDEP PIC XXX. - 05 TSTX OCCURS 4 TIMES. - 15 TSTG-1 PIC 99. - 15 TSTX-2 PIC XX OCCURS 4 TIMES. - 05 TSTTAIL1 PIC 99. - 05 TSTCOMP3 PIC 9(5) COMP-3. - 05 TSTLONG PIC X(100). - 05 TSTHEX PIC X(100). - 05 TSTHEX2 PIC X(60). - 05 TSTTAILX PIC X(80). - - LINKAGE SECTION. - 01 X PIC 9(9) BINARY. - 01 TSPFL-RECORD. - 10 CM-CUST-NUM PICTURE X(8). - 10 CM-COMPANY PICTURE X(25). - 10 CM-DISK PICTURE X(8). - 10 CM-NO-TERMINALS PICTURE 9(4). - - PROCEDURE DIVISION USING X, TSPFL-RECORD. - MAIN-1 SECTION. - MOVE ALL "X" TO TSTREC. - MOVE 1 TO TSTG-1 (1). - MOVE 2 TO TSTG-1 (2). - MOVE 3 TO TSTG-1 (3). - MOVE 'A' TO TSTX-2 (1,1). - MOVE 'B' TO TSTX-2 (2,1). - MOVE 'C' TO TSTX-2 (3,1). - MOVE 'xx' TO TSTX-2 (1,4). - MOVE 'yy' TO TSTX-2 (2,4). - MOVE 'zz' TO TSTX-2 (3,4). - MOVE SPACES TO TSTX-2 (1,3). - MOVE HIGH-VALUES TO TSTX (4). - MOVE LOW-VALUES TO TSTX-2 (2,3). - MOVE HIGH-VALUES TO TSTX-2 (3,3). - MOVE "Quick brown fox jumped over the dog" - TO TSTLONG, TSTLONG (50:36). - MOVE "Quicker grey fox jumped the cougar" - TO TSTHEX (1:35). - MAIN-2. - MOVE 17 TO HEXV. - MOVE HEXC TO TSTHEX (39:1). - MOVE HEXC TO TSTTAIL1 (2:1). - MOVE 7 TO HEXV. - MOVE HEXC TO TSTHEX (47:1). - MOVE 13 TO HEXV. - MOVE HEXC TO TSTHEX (59:1). - MOVE 0 TO HEXV. - MOVE HEXC TO TSTHEX2 (39:1), TSTHEX2 (10:1). - MOVE 9 TO HEXV. - MOVE HEXC TO TSTHEX2 (47:1). - MOVE '\' TO TSTHEX2 (32:1). - MOVE 13 TO HEXV. - MOVE HEXC TO TSTHEX2 (59:1). - MOVE 'A' TO TSTHEX2 (54:1). - MOVE LOW-VALUES TO TSTTAILX - ADD 1 TO X. - DISPLAY "X is " X. - ALLOCATE TEST-ALLOCED INITIALIZED. - COPY cpyabrt. - IF ADDRESS OF TEST-BASED NOT = NULL - DISPLAY TEST-BASED-SUB - END-IF. - GOBACK. - END PROGRAM sub1. - - IDENTIFICATION DIVISION. - PROGRAM-ID. sub2. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 ZRO PIC 9(9) BINARY VALUE 0. - 01 HEXV PIC X COMP-X. - 01 HEXC REDEFINES HEXV PIC X. - - 01 IDX PIC 9(9) BINARY VALUE 0. - 01 TSTREC. - 05 TSTDEP PIC XXX. - 05 TSTX OCCURS 4 TIMES. - 15 TSTG-1 PIC 99. - 15 TSTX-2 PIC XX OCCURS 4 TIMES. - 05 TSTTAIL1 PIC 99. - 05 TSTCOMP3 PIC 9(5) COMP-3. - 05 TSTLONG PIC X(100). - 05 TSTHEX PIC X(100). - 05 TSTHEX2 PIC X(60). - 05 TSTTAILX PIC X(80). - - LINKAGE SECTION. - 01 X PIC 9(9) BINARY. - 01 TSPFL-RECORD. - 10 CM-CUST-NUM PICTURE X(8). - 10 CM-COMPANY PICTURE X(25). - 10 CM-DISK PICTURE X(8). - 10 CM-NO-TERMINALS PICTURE 9(4). - - PROCEDURE DIVISION USING X, TSPFL-RECORD. - MOVE ALL "X" TO TSTREC. - MOVE 1 TO TSTG-1 (1). - MOVE 2 TO TSTG-1 (2). - MOVE 3 TO TSTG-1 (3). - MOVE 'A' TO TSTX-2 (1,1). - MOVE 'B' TO TSTX-2 (2,1). - MOVE 'C' TO TSTX-2 (3,1). - MOVE 'xx' TO TSTX-2 (1,4). - MOVE 'yy' TO TSTX-2 (2,4). - MOVE 'zz' TO TSTX-2 (3,4). - MOVE SPACES TO TSTX-2 (1,3). - MOVE HIGH-VALUES TO TSTX (4). - MOVE LOW-VALUES TO TSTX-2 (2,3). - MOVE HIGH-VALUES TO TSTX-2 (3,3). - MOVE "Quick brown fox jumped over the dog" - TO TSTLONG, TSTLONG (50:36). - MOVE "Quicker grey fox jumped the cougar" - TO TSTHEX (1:35). - MOVE 17 TO HEXV. - MOVE HEXC TO TSTHEX (39:1). - MOVE HEXC TO TSTTAIL1 (2:1). - MOVE 7 TO HEXV. - MOVE HEXC TO TSTHEX (47:1). - MOVE 13 TO HEXV. - MOVE HEXC TO TSTHEX (59:1). - MOVE 0 TO HEXV. - MOVE HEXC TO TSTHEX2 (39:1), TSTHEX2 (10:1). - MOVE 9 TO HEXV. - MOVE HEXC TO TSTHEX2 (47:1). - MOVE '\' TO TSTHEX2 (32:1). - MOVE 13 TO HEXV. - MOVE HEXC TO TSTHEX2 (59:1). - MOVE 'A' TO TSTHEX2 (54:1). - MOVE LOW-VALUES TO TSTTAILX. - COPY cpyabrt. - END PROGRAM sub2. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_misc.at:9873: \$COMPILE -fdump=ALL prog.cob" -at_fn_check_prepare_dynamic "$COMPILE -fdump=ALL prog.cob" "run_misc.at:9873" -( $at_check_trace; $COMPILE -fdump=ALL prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:9873" -$at_failed && at_fn_log_failure -$at_traceon; } - - -{ set +x -$as_echo "$at_srcdir/run_misc.at:9875: COB_DUMP_FILE=tstdump.txt \\ -\$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_notrace 'an embedded newline' "run_misc.at:9875" -( $at_check_trace; COB_DUMP_FILE=tstdump.txt \ -$COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "libcob: cpyabrt:4: error: LINKAGE item 'TSPFL-RECORD' (accessed by 'CM-COMPANY') not passed by caller -libcob: cpyabrt:4: warning: implicit CLOSE of FLATFILE ('RELFIX') -" | \ - $at_diff - "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo "X is 000000001 -X is 000005441 -" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/run_misc.at:9875" -$at_failed && at_fn_log_failure -$at_traceon; } - - - - -cat >reference_tmpl <<'_ATEOF' -Module dump due to LINKAGE item 'TSPFL-RECORD' (accessed by 'CM-COMPANY') not passed by caller - Last statement of sub1 was Line 4 of cpyabrt - Last statement of prog was Line 118 of prog.cob - -Dump Program-Id sub1 from prog.cob compiled MMM DD YYYY HH:MM:SS - -WORKING-STORAGE -********************** -01 ZRO 000000000 -01 HEXV 013 -01 TEST-BASED. address -01 TEST-ALLOCED. - 05 TEST-ALLOCED-SUB1 ALL SPACES - 05 TEST-ALLOCED-SUB2 000000 -01 IDX 000000000 -01 TSTREC. - 05 TSTDEP 'XXX' - 05 TSTX. - 15 TSTG-1 (1) 01 - 15 TSTX-2 (1,1) 'A' - 15 TSTX-2 (1,2) 'XX' - 15 TSTX-2 (1,3) ALL SPACES - 15 TSTX-2 (1,4) 'xx' - 15 TSTG-1 (2) 02 - 15 TSTX-2 (2,1) 'B' - 15 TSTX-2 (2,2) 'XX' - 15 TSTX-2 (2,3) ALL LOW-VALUES - 15 TSTX-2 (2,4) 'yy' - 15 TSTG-1 (3) 03 - 15 TSTX-2 (3,1) 'C' - 15 TSTX-2 (3,2) 'XX' - 15 TSTX-2 (3,3) ALL HIGH-VALUES - 15 TSTX-2 (3,4) 'zz' - 15 TSTG-1 (4) ALL HIGH-VALUES - 15 TSTX-2 (4,1) ALL HIGH-VALUES - 15 TSTX-2 (4,2) ALL HIGH-VALUES - 15 TSTX-2 (4,3) ALL HIGH-VALUES - 15 TSTX-2 (4,4) ALL HIGH-VALUES - 05 TSTTAIL1 X _ - 1 x 5811 - 05 TSTCOMP3 58585 - 05 TSTLONG 'Quick brown fox jumped over the dog Quick br' - 'own fox jumped over the dog' - 05 TSTHEX Q u i c k e r g r e y f o x j u m p e d _ - 1 x 51756963 6B657220 67726579 20666F78 206A756D 70656420 _ - t h e c o u g a r X X X X X X X X X X X _ - 25 x 74686520 636F7567 61722058 58581158 58585858 58580758 _ - X X X X X X X X X X X X X X X X X X X X X X X _ - 49 x 58585858 58585858 58580D58 58585858 58585858 58585858 _ - X X X X X X X X X X X X X X X X X X X X X X X X _ - 73 x 58585858 58585858 58585858 58585858 58585858 58585858 _ - X X X X - 97 x 58585858 - 05 TSTHEX2 XXXXXXXXX\0XXXXXXXXXXXXXXXXXXXXX\\XXXXXX\0XXXXXXX\tXXXXXX - 54 : AXXXX\rX - 05 TSTTAILX 'Quick brown fox jumped over the dog ' - trailing LOW-VALUES - -LINKAGE -********************** -01 X 000005441 -01 TSPFL-RECORD. address - -Dump Program-Id prog from prog.cob compiled MMM DD YYYY HH:MM:SS - -FD FLATFILE -********************** - File is OPEN - FILE STATUS '00' -01 TSPFL-RECORD. - 10 CM-CUST-NUM 'ALP00000' - 10 CM-COMPANY 'ALPHA ELECTRICAL CO. LTD.' - 10 CM-DISK '8417' - 10 CM-NO-TERMINALS 0010 - -WORKING-STORAGE -********************** -77 MAX-SUB 0006 -77 CUST-STAT '00' -77 REC-NUM 0001 -01 BIN 000005441 -01 TEST-DATA. - 02 DATA-CUST-NUM-TBL. - 05 FILLER 'ALP00000' - 05 FILLER 'BET00000' - 05 FILLER 'DEL00000' - 05 FILLER 'EPS00000' - 05 FILLER 'FOR00000' - 05 FILLER 'GAM00000' - 02 DATA-COMPANY-TBL. - 05 FILLER 'ALPHA ELECTRICAL CO. LTD.' - 05 FILLER 'BETA SHOE MFG. INC.' - 05 FILLER 'DELTA LUGGAGE REPAIRS' - 05 FILLER 'EPSILON EQUIPMENT SUPPLY' - 05 FILLER 'FORTUNE COOKIE COMPANY' - 05 FILLER 'GAMMA X-RAY TECHNOLOGY' - 02 DATA-ADDRESS-2-TBL. - 05 FILLER 'ATLANTA' - 05 FILLER 'CALGARY' - 05 FILLER 'NEW YORK' - 05 FILLER 'TORONTO' - 05 FILLER 'WASHINGTON' - 05 FILLER 'WHITEPLAIN' - 02 DATA-NO-TERMINALS-TBL. - 05 FILLER 010 - 05 FILLER 013 - 05 FILLER 075 - 05 FILLER 010 - 05 FILLER 090 - 05 FILLER 254 -01 WORK-AREA. - 05 SUB 0007 - -_ATEOF - - -# AT_DATA workaround via sed: -{ set +x -$as_echo "$at_srcdir/run_misc.at:10003: sed -e 's/_\$//' reference_tmpl > reference" -at_fn_check_prepare_dynamic "sed -e 's/_$//' reference_tmpl > reference" "run_misc.at:10003" -( $at_check_trace; sed -e 's/_$//' reference_tmpl > reference -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:10003" -$at_failed && at_fn_log_failure \ -"./tstdump.txt" -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_misc.at:10004: sed -e 's/compiled ... .. .... ..:..:../compiled MMM DD YYYY HH:MM:SS/g' \\ -tstdump.txt > tstdump.sed" -at_fn_check_prepare_notrace 'an embedded newline' "run_misc.at:10004" -( $at_check_trace; sed -e 's/compiled ... .. .... ..:..:../compiled MMM DD YYYY HH:MM:SS/g' \ -tstdump.txt > tstdump.sed -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:10004" -$at_failed && at_fn_log_failure \ -"./tstdump.txt" -$at_traceon; } - - -{ set +x -$as_echo "$at_srcdir/run_misc.at:10007: diff reference tstdump.sed" -at_fn_check_prepare_trace "run_misc.at:10007" -( $at_check_trace; diff reference tstdump.sed -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:10007" -$at_failed && at_fn_log_failure \ -"./tstdump.txt" -$at_traceon; } - - -{ set +x -$as_echo "$at_srcdir/run_misc.at:10009: \$COMPILE -fdump=FD,LS prog.cob -o prog_fdls" -at_fn_check_prepare_dynamic "$COMPILE -fdump=FD,LS prog.cob -o prog_fdls" "run_misc.at:10009" -( $at_check_trace; $COMPILE -fdump=FD,LS prog.cob -o prog_fdls -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:10009" -$at_failed && at_fn_log_failure \ -"./tstdump.txt" -$at_traceon; } - - -{ set +x -$as_echo "$at_srcdir/run_misc.at:10011: COB_DUMP_FILE=tstdump_fdls.txt \\ -\$COBCRUN_DIRECT ./prog_fdls" -at_fn_check_prepare_notrace 'an embedded newline' "run_misc.at:10011" -( $at_check_trace; COB_DUMP_FILE=tstdump_fdls.txt \ -$COBCRUN_DIRECT ./prog_fdls -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "libcob: cpyabrt:4: error: LINKAGE item 'TSPFL-RECORD' (accessed by 'CM-COMPANY') not passed by caller -libcob: cpyabrt:4: warning: implicit CLOSE of FLATFILE ('RELFIX') -" | \ - $at_diff - "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo "X is 000000001 -X is 000005441 -" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/run_misc.at:10011" -$at_failed && at_fn_log_failure \ -"./tstdump.txt" -$at_traceon; } - - - - - -cat >reference_fdls_tmpl <<'_ATEOF' -Module dump due to LINKAGE item 'TSPFL-RECORD' (accessed by 'CM-COMPANY') not passed by caller - Last statement of sub1 was Line 4 of cpyabrt - Last statement of prog was Line 118 of prog.cob - -Dump Program-Id sub1 from prog.cob compiled MMM DD YYYY HH:MM:SS - -LINKAGE -********************** -01 X 000005441 -01 TSPFL-RECORD. address - -Dump Program-Id prog from prog.cob compiled MMM DD YYYY HH:MM:SS - -FD FLATFILE -********************** - File is OPEN - FILE STATUS '00' -01 TSPFL-RECORD. - 10 CM-CUST-NUM 'ALP00000' - 10 CM-COMPANY 'ALPHA ELECTRICAL CO. LTD.' - 10 CM-DISK '8417' - 10 CM-NO-TERMINALS 0010 - -_ATEOF - - -# AT_DATA workaround via sed: -{ set +x -$as_echo "$at_srcdir/run_misc.at:10050: sed -e 's/_\$//' reference_fdls_tmpl > reference" -at_fn_check_prepare_dynamic "sed -e 's/_$//' reference_fdls_tmpl > reference" "run_misc.at:10050" -( $at_check_trace; sed -e 's/_$//' reference_fdls_tmpl > reference -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:10050" -$at_failed && at_fn_log_failure \ -"./tstdump.txt" \ -"./tstdump_fdls.txt" -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_misc.at:10051: sed -e 's/compiled ... .. .... ..:..:../compiled MMM DD YYYY HH:MM:SS/g' \\ -tstdump_fdls.txt > tstdump.sed" -at_fn_check_prepare_notrace 'an embedded newline' "run_misc.at:10051" -( $at_check_trace; sed -e 's/compiled ... .. .... ..:..:../compiled MMM DD YYYY HH:MM:SS/g' \ -tstdump_fdls.txt > tstdump.sed -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:10051" -$at_failed && at_fn_log_failure \ -"./tstdump.txt" \ -"./tstdump_fdls.txt" -$at_traceon; } - - -{ set +x -$as_echo "$at_srcdir/run_misc.at:10054: diff reference tstdump.sed" -at_fn_check_prepare_trace "run_misc.at:10054" -( $at_check_trace; diff reference tstdump.sed -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:10054" -$at_failed && at_fn_log_failure \ -"./tstdump.txt" \ -"./tstdump_fdls.txt" -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_688 -#AT_START_689 -at_fn_group_banner 689 'run_misc.at:10058' \ - "Test COBOL-C interface" " " 4 -at_xfail=no -( - $as_echo "689. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 SUB-NAME PIC X(10) VALUE "SUB2". - 01 FLT9 USAGE COMP-1 VALUE 9.0. - 01 NUMPI PIC 9(6) VALUE 314. - 01 NUM5 PIC 9(5) VALUE 12345. - 01 NUM9 PIC 9(7)V99 VALUE 1234567.88. - 01 NUMED PIC Z(5)9.99CR. - PROCEDURE DIVISION. - CALL "SUB" USING BY VALUE 1, - BY REFERENCE "Fun and games for you". - CALL "SUB" USING BY VALUE 2, - BY REFERENCE "More Fun and games for all". - CALL "SUB2" USING "Fun and games", BY VALUE 3. - CALL SUB-NAME USING "More Fun and games ....", BY VALUE 4. - CALL "SUB3" . - CALL "COBCSUB" USING BY VALUE 6, - BY REFERENCE "Hi to C Code...". - CALL "COBCSUB" USING BY VALUE NUMPI, - BY REFERENCE "Pass PI to C...". - CALL "COBCSUB" USING BY VALUE NUM9, - BY REFERENCE "Pass V99 to C...". - CALL "CSUB4" USING FLT9, "Hi from COBOL!.". - ADD 1.4 TO FLT9. - CALL "CSUB5" USING FLT9, "Called from COBOL instead of C!.". - CALL "SUB6" USING NUM5. - CALL "SUB6" USING NUM9. - CALL "SUB6" USING NUMPI. - CALL "SUB6" USING FLT9. - CALL "SUB6" USING "31415926". - MOVE 10.50 TO NUMED. - CALL "SUB6" USING NUMED. - MOVE -4510.66 TO NUMED. - CALL "SUB6" USING NUMED. - STOP RUN. - END PROGRAM prog. - - IDENTIFICATION DIVISION. - PROGRAM-ID. SUB. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 xn PIC 9(8) BINARY VALUE 99. - 01 xx PIC X(13) VALUE '"x" was NULL!'. - 01 yy PIC X(8) VALUE "Garbage!". - LINKAGE SECTION. - 01 n PIC 9(8). - 01 x PIC X ANY LENGTH. - 01 y PIC X ANY LENGTH. - 01 z PIC X ANY LENGTH. - 01 num PIC 9 ANY NUMERIC. - 01 cn PIC 9(9) COMP-5. - 01 flt1 USAGE COMP-1. - 01 cx PIC X(15). - PROCEDURE DIVISION USING BY VALUE n, x, BY REFERENCE y. - DISPLAY n " '" x "'". - EXIT PROGRAM. - ENTRY "SUB2" USING z, BY VALUE n. - DISPLAY n " '" z "' via SUB2". - EXIT PROGRAM. - ENTRY "SUB3". - IF ADDRESS OF n = NULL - SET ADDRESS OF n TO ADDRESS OF xn. - IF ADDRESS OF x = NULL - SET ADDRESS OF x TO ADDRESS OF xx. - DISPLAY n " '" x "' via SUB3". - EXIT PROGRAM. - ENTRY "CSUB4" USING BY VALUE cn, BY REFERENCE cx. - DISPLAY cn " '" cx "' via CSUB4". - EXIT PROGRAM. - ENTRY "CSUB5" USING BY VALUE cn, BY REFERENCE z. - DISPLAY cn " '" z "' via CSUB5". - EXIT PROGRAM. - ENTRY "SUB6" USING num. - DISPLAY 'ANY NUMERIC is ' num ' Length ' LENGTH OF num. - EXIT PROGRAM. - ENTRY "CSUB7" USING VALUE flt1. - DISPLAY 'Float value is ' flt1 ' via CSUB7'. - EXIT PROGRAM. - ENTRY "CSUB8" USING flt1. - DISPLAY 'Float reference is ' flt1 ' via CSUB8'. - EXIT PROGRAM. - END PROGRAM SUB. -_ATEOF - - -cat >cmod.c <<'_ATEOF' - -#include -#include -extern int CSUB4(); -extern int CSUB5(); -extern int SUB6(); -extern int CSUB7(float f); -extern int CSUB8(float *f); -int -COBCSUB(int y, unsigned char x[15]) -{ - float flt1; - printf("C routine passed: Y is %d; X is '%.15s'\n",y,x); - CSUB4(y, x); - CSUB4(y+1, "A C-String is being passed"); - CSUB5(y+2, "A much longer C-String is being passed"); - SUB6("314159265358"); - SUB6("31415926"); - SUB6("000314"); - flt1 = 3.1415926; - CSUB7(flt1); - flt1 = 2.71828; - CSUB8(&flt1); - return 0; -} - -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_misc.at:10176: cobc -x -std=ibm -debug -Wall prog.cob cmod.c" -at_fn_check_prepare_trace "run_misc.at:10176" -( $at_check_trace; cobc -x -std=ibm -debug -Wall prog.cob cmod.c -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:10176" -$at_failed && at_fn_log_failure -$at_traceon; } - - -{ set +x -$as_echo "$at_srcdir/run_misc.at:10178: ./prog" -at_fn_check_prepare_trace "run_misc.at:10178" -( $at_check_trace; ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo "00000001 'Fun and games for you' -00000002 'More Fun and games for all' -00000003 'Fun and games' via SUB2 -00000004 'More Fun and games ....' via SUB2 -00000004 'More Fun and games for all' via SUB3 -C routine passed: Y is 6; X is 'Hi to C Code...' -0000000006 'Hi to C Code...' via CSUB4 -0000000007 'A C-String is b' via CSUB4 -0000000008 'A much longer C-String is being passed' via CSUB5 -ANY NUMERIC is 314159265358 Length 0000000012 -ANY NUMERIC is 31415926 Length 0000000008 -ANY NUMERIC is 000314 Length 0000000006 -Float value is 3.1415925 via CSUB7 -Float reference is 2.7182801 via CSUB8 -C routine passed: Y is 314; X is 'Pass PI to C...' -0000000314 'Pass PI to C...' via CSUB4 -0000000315 'A C-String is b' via CSUB4 -0000000316 'A much longer C-String is being passed' via CSUB5 -ANY NUMERIC is 314159265358 Length 0000000012 -ANY NUMERIC is 31415926 Length 0000000008 -ANY NUMERIC is 000314 Length 0000000006 -Float value is 3.1415925 via CSUB7 -Float reference is 2.7182801 via CSUB8 -C routine passed: Y is 1234567; X is 'Pass V99 to C..' -0001234567 'Pass V99 to C..' via CSUB4 -0001234568 'A C-String is b' via CSUB4 -0001234569 'A much longer C-String is being passed' via CSUB5 -ANY NUMERIC is 314159265358 Length 0000000012 -ANY NUMERIC is 31415926 Length 0000000008 -ANY NUMERIC is 000314 Length 0000000006 -Float value is 3.1415925 via CSUB7 -Float reference is 2.7182801 via CSUB8 -0000000009 'Hi from COBOL!.' via CSUB4 -0000000010 'Called from COBOL instead of C!.' via CSUB5 -ANY NUMERIC is 12345 Length 0000000005 -ANY NUMERIC is 123456788 Length 0000000009 -ANY NUMERIC is 000314 Length 0000000006 -ANY NUMERIC is 10.4 Length 0000000004 -ANY NUMERIC is 31415926 Length 0000000008 -ANY NUMERIC is 10.50 Length 0000000011 -ANY NUMERIC is 4510.66CR Length 0000000011 -" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:10178" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_689 -#AT_START_690 -at_fn_group_banner 690 'run_misc.at:10223' \ - "Test COBOL-C interface (2)" " " 4 -at_xfail=no -( - $as_echo "690. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. routine1. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 PDUMP POINTER. - 01 PNUM REDEFINES PDUMP BINARY-LONG. - 01 DUMMY PICTURE X(1). - 01 PN PICTURE 9(1). - LINKAGE SECTION. - 01 P1 PICTURE X(1). - 01 P2 PICTURE X(1). - PROCEDURE DIVISION USING P1 P2. - MOVE NUMBER-OF-CALL-PARAMETERS TO PN. - DISPLAY "Now in routine1 with " PN " params" - SET PDUMP TO ADDRESS OF P1. - MOVE PNUM TO PN. - DISPLAY "Expect '1' and got " PN. - SET PDUMP TO ADDRESS OF P2. - MOVE PNUM TO PN. - DISPLAY "Expect '2' and got " PN. - call "one_parameter" USING DUMMY. - GOBACK. - - DISPLAY "Call routine2 with P2" - call "routine2" USING P2. - DISPLAY "Call routine2 with nothing" - call "routine2". - DISPLAY "Call routine2 with P2, P1" - call "routine2" USING P2, P1. - DISPLAY "Leaving routine1". - GOBACK. - END PROGRAM routine1. - - IDENTIFICATION DIVISION. - PROGRAM-ID. routine2. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 PDUMP POINTER. - 01 PNUM REDEFINES PDUMP BINARY-LONG. - 01 DUMMY PICTURE X(1). - 01 PN PICTURE 9(1). - LINKAGE SECTION. - 01 P1 PICTURE X(1). - 01 P2 PICTURE X(1). - PROCEDURE DIVISION USING P1 P2. - MOVE NUMBER-OF-CALL-PARAMETERS TO PN. - DISPLAY "Now in routine2 with " PN " params" - SET PDUMP TO ADDRESS OF P1. - MOVE PNUM TO PN. - DISPLAY "Expect '3' and got " PN. - SET PDUMP TO ADDRESS OF P2. - MOVE PNUM TO PN. - DISPLAY "Expect '4' and got " PN. - DISPLAY "Leaving routine2". - GOBACK. - END PROGRAM routine2. -_ATEOF - - -cat >cmod.c <<'_ATEOF' - -#include -#include - -extern int routine1(void *, void *); -extern int routine2(void *, void *); - -int main() -{ - cob_init(0,NULL); - routine1((void *)(0x1),(void *)(0x2)); - return 0; -} - -void one_parameter(void *dummy) -{ - printf("Now in one_parameter\n"); - routine2((void *)(0x3),(void *)(0x4)); -} -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_misc.at:10306: \$COMPILE -std=ibm -o prog cmod.c prog.cob" -at_fn_check_prepare_dynamic "$COMPILE -std=ibm -o prog cmod.c prog.cob" "run_misc.at:10306" -( $at_check_trace; $COMPILE -std=ibm -o prog cmod.c prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:10306" -$at_failed && at_fn_log_failure -$at_traceon; } - - -{ set +x -$as_echo "$at_srcdir/run_misc.at:10308: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_misc.at:10308" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo "Now in routine1 with 2 params -Expect '1' and got 1 -Expect '2' and got 2 -Now in one_parameter -Now in routine2 with 2 params -Expect '3' and got 3 -Expect '4' and got 4 -Leaving routine2 -" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:10308" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_690 -#AT_START_691 -at_fn_group_banner 691 'run_misc.at:10320' \ - "COBOL2002 SYNC" " " 4 -at_xfail=no -( - $as_echo "691. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - CONFIGURATION SECTION. - DATA DIVISION. - FILE SECTION. - - WORKING-STORAGE SECTION. - - 77 VLEN PIC 99 VALUE 1. - 77 TESTMODE PIC 99 VALUE 1. - 77 TESTIDX PIC 99 VALUE 1. - 77 BIT-MODE PIC 99 VALUE 32. - 77 TESTNUM PIC 99 VALUE 0. - 77 TESTMAX PIC 99 VALUE 23. - 77 TESTCASE PIC 99 VALUE 0. - 77 TESTFAIL PIC 99 VALUE 0. - 77 TESTEND PIC X(15) VALUE " ". - 77 TESTNAME PIC X(10) VALUE " ". - 77 TESTRESULT PIC X(40) VALUE " ". - 77 TESTPTR USAGE POINTER. - - 01 TEST-MODES. - 05 FILLER PIC X(10) VALUE "MF". - 05 FILLER PIC X(10) VALUE "IBMCOMP". - 05 FILLER PIC X(10) VALUE "C2002". - - 01 FILLER REDEFINES TEST-MODES. - 05 FILLER OCCURS 3 TIMES. - 10 TEST-MODE PIC X(10). - - 01 TEST-CASES. - 05 FILLER PIC X(10) VALUE "COMP-FLD1". - 05 FILLER PIC X(40) VALUE "xxxxx1". - 05 FILLER PIC X(40) VALUE "xxxxx11". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - - 05 FILLER PIC X(10) VALUE "COMP-FLD2". - 05 FILLER PIC X(40) VALUE "xxxxx22". - 05 FILLER PIC X(40) VALUE "xxxxxx22". - 05 FILLER PIC X(40) VALUE "xxxxxx22". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - - 05 FILLER PIC X(10) VALUE "COMP-FLDO". - 05 FILLER PIC X(40) VALUE "xxxxxxx11xxx22xxx33". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - - 05 FILLER PIC X(10) VALUE "COMP-FLDS". - 05 FILLER PIC X(40) VALUE "xxxxxxx11xxx22xxx33". - 05 FILLER PIC X(40) VALUE "xxxxxxxx11xxxx22xxxx33". - 05 FILLER PIC X(40) VALUE "xxxxxxxx11xxxx22xxxx33". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - - 05 FILLER PIC X(10) VALUE "COMP-FLD3". - 05 FILLER PIC X(40) VALUE "xxxxx123". - 05 FILLER PIC X(40) VALUE "xxxxxxxx1234". - 05 FILLER PIC X(40) VALUE "xxxxxxxx1234". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - - 05 FILLER PIC X(10) VALUE "COMP-FLDL". - 05 FILLER PIC X(40) VALUE "xxxxx1". - 05 FILLER PIC X(40) VALUE "xxxxxx12". - 05 FILLER PIC X(40) VALUE "xxxxx1". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - - 05 FILLER PIC X(10) VALUE "COMP-FLDR". - 05 FILLER PIC X(40) VALUE "xxxxx1". - 05 FILLER PIC X(40) VALUE "xxxxxx12". - 05 FILLER PIC X(40) VALUE "xxxxx1". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - - 05 FILLER PIC X(10) VALUE "COM1-FLD". - 05 FILLER PIC X(40) VALUE "xxxxx12xxx123xxx12345678". - 05 FILLER PIC X(40) VALUE "xxxxxx12xxxx1234xxxx12345678". - 05 FILLER PIC X(40) VALUE "xxxxxx12xxxx1234xxxxxxxx12345678". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE "xxxxxx12xxxx1234xxxx12345678". - - 05 FILLER PIC X(10) VALUE "COM2-FLD". - 05 FILLER PIC X(40) VALUE "xxxxx12345xxx1234567xxx12345678". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - - 05 FILLER PIC X(10) VALUE "COM3-FLD". - 05 FILLER PIC X(40) VALUE "xxxxx123xxx1234xxx1234567". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - - 05 FILLER PIC X(10) VALUE "COM4-FLD". - 05 FILLER PIC X(40) VALUE "x123456x1234x123456x123". - 05 FILLER PIC X(40) VALUE "xxxx12345678xxxx1234x12345678x1234". - 05 FILLER PIC X(40) - VALUE "xxxxxxxx12345678xxxx1234x12345678x1234". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE "xxxx12345678xxxx1234x12345678x1234". - - 05 FILLER PIC X(10) VALUE "NOSYNC". - 05 FILLER PIC X(40) VALUE "x123456x123". - 05 FILLER PIC X(40) VALUE "x12345678x1234". - 05 FILLER PIC X(40) VALUE "x12345678x1234". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - - 05 FILLER PIC X(10) VALUE "SYNC". - 05 FILLER PIC X(40) VALUE "x123456x1234". - 05 FILLER PIC X(40) VALUE "xxxx12345678xxxx1234". - 05 FILLER PIC X(40) VALUE "xxxxxxxx12345678xxxx1234". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE "xxxx12345678xxxx1234". - - 05 FILLER PIC X(10) VALUE "COMP-3". - 05 FILLER PIC X(40) VALUE "x1234567x1234". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - - 05 FILLER PIC X(10) VALUE "COMP-1". - 05 FILLER PIC X(40) VALUE "12341234". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - - 05 FILLER PIC X(10) VALUE "COMP-2". - 05 FILLER PIC X(40) VALUE "1234567812345678". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - - 05 FILLER PIC X(10) VALUE "SIGN L/T". - 05 FILLER PIC X(40) VALUE "x-01x02-x-03x04-". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - - 05 FILLER PIC X(10) VALUE "COMP-X". - 05 FILLER PIC X(40) VALUE "x123x1234567x1234x12345678". - 05 FILLER PIC X(40) VALUE "x123x1234567xxxx1234xxxx12345678". - 05 FILLER PIC X(40) VALUE "x123x1234567xxxx1234xxxx12345678". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - - 05 FILLER PIC X(10) VALUE "BIN-SHORT". - 05 FILLER PIC X(40) VALUE "x12xx12". - 05 FILLER PIC X(40) VALUE "x12xx12". - 05 FILLER PIC X(40) VALUE "x12xx12". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - - 05 FILLER PIC X(10) VALUE "BIN-DBL". - 05 FILLER PIC X(40) VALUE "x12345678x12345678". - 05 FILLER PIC X(40) VALUE "x12345678x12345678". - 05 FILLER PIC X(40) VALUE "x12345678x12345678". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE "x12345678x12345678". - - 05 FILLER PIC X(10) VALUE "COMP-5". - 05 FILLER PIC X(40) VALUE "x12345678x12345678". - 05 FILLER PIC X(40) VALUE "x12345678xxx12345678". - 05 FILLER PIC X(40) VALUE "x1234x1234". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE "x1234x1234". - - 05 FILLER PIC X(10) VALUE "CMP-1". - 05 FILLER PIC X(40) VALUE "x1234x1234". - 05 FILLER PIC X(40) VALUE "x1234xxx1234". - 05 FILLER PIC X(40) VALUE "x1234xxx1234". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - - 05 FILLER PIC X(10) VALUE "CMP-2". - 05 FILLER PIC X(40) VALUE "x12345678x12345678". - 05 FILLER PIC X(40) VALUE "x12345678xxxxxxx12345678". - 05 FILLER PIC X(40) VALUE "x12345678xxxxxxx12345678". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE "x12345678xxx12345678". - - 01 FILLER REDEFINES TEST-CASES. - 05 FILLER OCCURS 23 TIMES. - 10 TEST-NAME PIC X(10). - 10 TEST-RESULTS. - 15 MF-64RESULT PIC X(40). - 15 IBM-64RESULT PIC X(40). - 15 C2002-64RESULT PIC X(40). - 15 MF-32RESULT PIC X(40). - 15 IBM-32RESULT PIC X(40). - 15 C2002-32RESULT PIC X(40). - 10 FILLER REDEFINES TEST-RESULTS. - 15 TEST-RESULT PIC X(40) OCCURS 6 TIMES. - - 01 TESTRECORD PIC X(40). - - 01 FILLER REDEFINES TESTRECORD. - 02 TSTREC1. - 10 FILLER PICTURE X(5). - 10 COMP-FLD1 PICTURE S9(2) COMP. - 10 FILLER PICTURE X(5). - - 01 FILLER REDEFINES TESTRECORD. - 02 TSTREC2. - 10 FILLER PICTURE X(5). - 10 COMP-FLD2 PICTURE S9(4) COMP SYNC . - - 01 FILLER REDEFINES TESTRECORD. - 02 TSTREC3. - 10 FILLER PICTURE X(5). - 10 COMP-FLD3 PICTURE S9(6) COMP SYNC. - 10 FILLER PICTURE X(5). - - 01 FILLER REDEFINES TESTRECORD. - 02 TSTRECL. - 10 FILLER PICTURE X(5). - 10 COMP-FLDL PICTURE S9(2) COMP SYNC LEFT. - 10 FILLER PICTURE X(5). - - 01 FILLER REDEFINES TESTRECORD. - 02 TSTRECR. - 10 FILLER PICTURE X(5). - 10 COMP-FLDR PICTURE S9(2) COMP SYNC RIGHT. - 10 FILLER PICTURE X(5). - - 01 FILLER REDEFINES TESTRECORD. - 02 TSTRECS. - 10 FILLER PICTURE X(5). - 10 FILLER OCCURS 3 TIMES. - 15 FILLER PICTURE X(2). - 15 COMP-FLDS PICTURE S9(4) COMP SYNC . - 15 FILLER PICTURE X(1). - 10 FILLER PICTURE X(1). - - 01 FILLER REDEFINES TESTRECORD. - 02 TSTRECO. - 10 FILLER PICTURE X(5). - 10 FILLER OCCURS 3 TIMES. - 15 FILLER PICTURE X(2). - 15 COMP-FLDO PICTURE S9(4) COMP. - 15 FILLER PICTURE X(1). - 10 FILLER PICTURE X(1). - - 01 FILLER REDEFINES TESTRECORD. - 02 TSTGRP SYNC COMP. - 05 GRP1. - 10 FILLER PICTURE X(5). - 10 COM1-FLD1 PICTURE S9(4). - 10 FILLER PICTURE X(3). - 10 COM1-FLD2 PICTURE S9(6). - 10 FILLER PICTURE X(3). - 10 COM1-FLD3 PICTURE S9(18). - - 01 FILLER REDEFINES TESTRECORD. - 02 TSTGRP2 SIGN LEADING SEPARATE. - 05 GRP2-1. - 10 FILLER PICTURE X(5). - 10 COM2-FLD1 PICTURE S9(4). - 10 FILLER PICTURE X(3). - 10 COM2-FLD2 PICTURE S9(6) SIGN TRAILING SEPARATE. - 10 FILLER PICTURE X(3). - 10 COM2-FLD3 PICTURE S9(7). - - 01 FILLER REDEFINES TESTRECORD. - 02 TSTGRP3 PACKED-DECIMAL. - 05 GRP3-1. - 10 FILLER PICTURE X(5). - 10 COM3-FLD1 PICTURE S9(4). - 10 FILLER PICTURE X(3). - 10 COM3-FLD2 PICTURE S9(6). - 10 FILLER PICTURE X(3). - 05 GRP3-2. - 10 COM3-FLD3 PICTURE S9(13). - - 01 FILLER REDEFINES TESTRECORD. - 02 TSTGRP4 COMP. - 05 GRP4-1 SYNC. - 10 FILLER PICTURE X(1). - 10 COM4-FLD1 PICTURE S9(13). - 10 FILLER PICTURE X(1). - 10 COM4-FLD2 PICTURE S9(7). - 10 FILLER PICTURE X(1). - 05 GRP4-2. - 10 COM4-FLD3 PICTURE S9(13). - 10 FILLER PICTURE X(1). - 10 COM4-FLD4 PICTURE S9(6). - 10 FILLER PICTURE X(1). - - 01 FILLER REDEFINES TESTRECORD. - 02 TSTGRP5 COMP. - 10 FILLER PICTURE X(1). - 10 COM5-FLD1 PICTURE S9(13). - 10 FILLER PICTURE X(1). - 10 COM5-FLD2 PICTURE S9(6). - 10 FILLER PICTURE X(1). - - 01 FILLER REDEFINES TESTRECORD. - 02 TSTGRP5S COMP SYNC. - 10 FILLER PICTURE X(1). - 10 COM5S-FLD1 PICTURE S9(13). - 10 FILLER PICTURE X(1). - 10 COM5S-FLD2 PICTURE S9(7). - 10 FILLER PICTURE X(1). - - 01 FILLER REDEFINES TESTRECORD. - 02 TSTGRP6 PACKED-DECIMAL. - 10 FILLER PICTURE X(1). - 10 COM6-FLD1 PICTURE S9(13). - 10 FILLER PICTURE X(1). - 10 COM6-FLD2 PICTURE S9(6). - 10 FILLER PICTURE X(1). - - 01 FILLER REDEFINES TESTRECORD. - 02 TSTGRP7 FLOAT-SHORT. - 10 COM7-FLD1 . - 10 COM7-FLD2 . - - 01 FILLER REDEFINES TESTRECORD. - 02 TSTGRP8 FLOAT-LONG. - 10 COM8-FLD1 . - 10 COM8-FLD2 . - - 01 FILLER REDEFINES TESTRECORD. - 02 TSTGRP9. - 05 GRP9-1 SIGN LEADING SEPARATE. - 10 FILLER PICTURE X(1). - 10 COM9-FLD1 PICTURE S9(2). - 10 FILLER PICTURE X(1). - 10 COM9-FLD2 PICTURE S9(2) SIGN TRAILING SEPARATE. - 10 FILLER PICTURE X(1). - 05 GRP9-2 SIGN TRAILING SEPARATE. - 10 COM9-FLD3 PICTURE S9(2) SIGN LEADING SEPARATE. - 10 FILLER PICTURE X(1). - 10 COM9-FLD4 PICTURE S9(2). - 10 FILLER PICTURE X(1). - - 01 FILLER REDEFINES TESTRECORD. - 02 TSTGRPX. - 10 FILLER PICTURE X(1). - 10 COMX-FLD1 PICTURE X(3). - 10 FILLER PICTURE X(1). - 10 COMX-FLD2 PICTURE X(7). - 10 FILLER PICTURE X(1). - 10 COMX-FLT FLOAT-SHORT SYNC. - 10 FILLER PICTURE X(1). - 10 COMX-DBL FLOAT-LONG SYNC. - 10 FILLER PICTURE X(1). - - 01 FILLER REDEFINES TESTRECORD. - 02 TST-BSHORT. - 10 FILLER PICTURE X(1). - 10 COMS-FLD1 BINARY-SHORT. - 10 FILLER PICTURE X(2). - 10 COMS-FLD2 BINARY-SHORT SYNC. - 10 FILLER PICTURE X(1). - - 01 FILLER REDEFINES TESTRECORD. - 02 TST-BLONG. - 10 FILLER PICTURE X(1). - 10 COML-FLD1 BINARY-LONG. - 10 FILLER PICTURE X(1). - 10 COML-FLD2 BINARY-LONG SYNC. - 10 FILLER PICTURE X(1). - - 01 FILLER REDEFINES TESTRECORD. - 02 TST-BDBL. - 10 FILLER PICTURE X(1). - 10 COMD-FLD1 BINARY-DOUBLE. - 10 FILLER PICTURE X(1). - 10 COMD-FLD2 BINARY-DOUBLE UNSIGNED SYNC. - 10 FILLER PICTURE X(1). - - 01 FILLER REDEFINES TESTRECORD. - 02 TST-CMP5. - 10 FILLER PICTURE X(1). - 10 CMP5-FLD1 BINARY-LONG. - 10 FILLER PICTURE X(1). - 10 CMP5-FLD2 BINARY-LONG SYNC. - 10 FILLER PICTURE X(1). - - 01 FILLER REDEFINES TESTRECORD. - 02 TST-CMP1. - 10 FILLER PICTURE X(1). - 10 CMP1-FLD1 FLOAT-SHORT. - 10 FILLER PICTURE X(1). - 10 CMP1-FLD2 FLOAT-SHORT SYNC. - 10 FILLER PICTURE X(1). - - 01 FILLER REDEFINES TESTRECORD. - 02 TST-CMP2. - 10 FILLER PICTURE X(1). - 10 CMP2-FLD1 FLOAT-LONG. - 10 FILLER PICTURE X(1). - 10 CMP2-FLD2 FLOAT-LONG SYNC. - 10 FILLER PICTURE X(1). - - PROCEDURE DIVISION. - - MOVE LENGTH OF TESTPTR TO VLEN. - IF VLEN = 8 - MOVE 64 TO BIT-MODE - ELSE - MOVE 32 TO BIT-MODE. - MOVE ALL "x" TO TESTRECORD. - MOVE 1 TO TESTMODE. - MOVE ALL "x" TO TSTREC2. - MOVE "22" TO COMP-FLD2 (1:). - IF TSTREC2 = 'xxxxxx22' - MOVE 3 TO TESTMODE. - MOVE "12345678" TO COML-FLD2 (1:). - IF COML-FLD2 = 875770417 - MOVE "Little-Endian" TO TESTEND - ELSE - MOVE "Big-Endian" TO TESTEND - END-IF. - MOVE LENGTH OF COMP-FLD1 TO VLEN. - IF VLEN = 2 - MOVE 2 TO TESTMODE. - MOVE ALL "x" TO TESTRECORD. - - MOVE "COMP-FLD1" TO TESTNAME. - MOVE "11" TO COMP-FLD1 (1:). - PERFORM CHECK-IT. - - MOVE "COMP-FLD2" TO TESTNAME. - MOVE "22" TO COMP-FLD2 (1:). - PERFORM CHECK-IT. - - MOVE "COMP-FLDO" TO TESTNAME. - MOVE "11" TO COMP-FLDO (1) (1:2) - MOVE "22" TO COMP-FLDO (2) (1:2) - MOVE "33" TO COMP-FLDO (3) (1:2) - PERFORM CHECK-IT. - - MOVE "COMP-FLDS" TO TESTNAME. - MOVE "11" TO COMP-FLDS (1) (1:2) - MOVE "22" TO COMP-FLDS (2) (1:2) - MOVE "33" TO COMP-FLDS (3) (1:2) - PERFORM CHECK-IT. - - MOVE "COMP-FLD3" TO TESTNAME. - MOVE "1234678" TO COMP-FLD3 (1:). - PERFORM CHECK-IT. - - MOVE "COMP-FLDL" TO TESTNAME. - MOVE "12345678" TO COMP-FLDL (1:). - PERFORM CHECK-IT. - - MOVE "COMP-FLDR" TO TESTNAME. - MOVE "12345678" TO COMP-FLDR (1:). - PERFORM CHECK-IT. - - MOVE "COM1-FLD" TO TESTNAME. - MOVE "12345678" TO COM1-FLD1 (1:). - MOVE "12345678" TO COM1-FLD2 (1:). - MOVE "12345678" TO COM1-FLD3 (1:). - PERFORM CHECK-IT. - - MOVE "COM2-FLD" TO TESTNAME. - MOVE "12345678" TO COM2-FLD1 (1:). - MOVE "12345678" TO COM2-FLD2 (1:). - MOVE "12345678" TO COM2-FLD3 (1:). - PERFORM CHECK-IT. - - MOVE "COM3-FLD" TO TESTNAME. - MOVE "12345678" TO COM3-FLD1 (1:). - MOVE "12345678" TO COM3-FLD2 (1:). - MOVE "12345678" TO COM3-FLD3 (1:). - PERFORM CHECK-IT. - - MOVE "COM4-FLD" TO TESTNAME. - MOVE "12345678" TO COM4-FLD1 (1:). - MOVE "12345678" TO COM4-FLD2 (1:). - MOVE "12345678" TO COM4-FLD3 (1:). - MOVE "12345678" TO COM4-FLD4 (1:). - PERFORM CHECK-IT. - - MOVE "NOSYNC" TO TESTNAME. - MOVE "12345678" TO COM5-FLD1 (1:). - MOVE "12345678" TO COM5-FLD2 (1:). - PERFORM CHECK-IT. - - MOVE "SYNC" TO TESTNAME. - MOVE "12345678" TO COM5S-FLD1 (1:). - MOVE "12345678" TO COM5S-FLD2 (1:). - PERFORM CHECK-IT. - - MOVE "COMP-3" TO TESTNAME. - MOVE "12345678" TO COM6-FLD1 (1:). - MOVE "12345678" TO COM6-FLD2 (1:). - PERFORM CHECK-IT. - - MOVE "COMP-1" TO TESTNAME. - MOVE "12345678" TO COM7-FLD1 (1:). - MOVE "12345678" TO COM7-FLD2 (1:). - PERFORM CHECK-IT. - - MOVE "COMP-2" TO TESTNAME. - MOVE "12345678" TO COM8-FLD1 (1:). - MOVE "12345678" TO COM8-FLD2 (1:). - PERFORM CHECK-IT. - - MOVE "SIGN L/T" TO TESTNAME. - MOVE -1 TO COM9-FLD1 . - MOVE -2 TO COM9-FLD2 . - MOVE -3 TO COM9-FLD3 . - MOVE -4 TO COM9-FLD4 . - PERFORM CHECK-IT. - - MOVE "COMP-X" TO TESTNAME. - MOVE "12345678" TO COMX-FLD1 (1:). - MOVE "12345678" TO COMX-FLD2 (1:). - MOVE "12345678" TO COMX-FLT (1:). - MOVE "12345678" TO COMX-DBL (1:). - PERFORM CHECK-IT. - - MOVE "BIN-SHORT" TO TESTNAME. - MOVE "12345678" TO COMS-FLD1 (1:). - MOVE "12345678" TO COMS-FLD2 (1:). - PERFORM CHECK-IT. - - MOVE "BIN-DBL" TO TESTNAME. - MOVE "12345678" TO COMD-FLD1 (1:). - MOVE "12345678" TO COMD-FLD2 (1:). - PERFORM CHECK-IT. - - MOVE "COMP-5" TO TESTNAME. - MOVE "12345678" TO CMP5-FLD1 (1:). - MOVE "12345678" TO CMP5-FLD2 (1:). - PERFORM CHECK-IT. - - MOVE "CMP-1" TO TESTNAME. - MOVE "12345678" TO CMP1-FLD1 (1:). - MOVE "12345678" TO CMP1-FLD2 (1:). - PERFORM CHECK-IT. - - MOVE "CMP-2" TO TESTNAME. - MOVE "12345678" TO CMP2-FLD1 (1:). - MOVE "12345678" TO CMP2-FLD2 (1:). - PERFORM CHECK-IT. - - DISPLAY TESTCASE " tests & " TESTFAIL " failed". - STOP RUN RETURNING 0. - - CHECK-IT SECTION. - CHECK-01. - INSPECT TESTRECORD REPLACING TRAILING 'x' BY ' '. - ADD 1 TO TESTCASE. - PERFORM VARYING TESTNUM FROM 1 BY 1 - UNTIL TEST-NAME (TESTNUM) = TESTNAME - OR TESTNUM > TESTMAX - CONTINUE - END-PERFORM. - IF TESTNUM > TESTMAX - DISPLAY TESTNAME " :NOT FOUND" - DISPLAY " : GOT: " TESTRECORD ":" - ADD 1 TO TESTFAIL - MOVE ALL "x" TO TESTRECORD - GO TO CHECK-EXIT - END-IF. - MOVE TEST-RESULT (TESTNUM, TESTMODE) TO TESTRESULT. - COMPUTE TESTIDX = TESTMODE + 3. - IF BIT-MODE = 32 - AND TEST-RESULT (TESTNUM, TESTIDX) NOT = SPACES - MOVE TEST-RESULT (TESTNUM, TESTIDX) TO TESTRESULT. - IF TESTRESULT = SPACES - MOVE TEST-RESULT (TESTNUM, 1) TO TESTRESULT. - IF TESTRESULT NOT = TESTRECORD - DISPLAY TESTNAME - " :FAILED: Mode " BIT-MODE - " " TEST-MODE (TESTMODE) - ", Case " TESTCASE ", " TESTEND - DISPLAY " : GOT: " TESTRECORD ":" - DISPLAY " :EXPECT: " TESTRESULT ":" - ADD 1 TO TESTFAIL - END-IF. - MOVE ALL "x" TO TESTRECORD. - CHECK-EXIT. - EXIT. - -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_misc.at:10942: cobc -x -std=cobol2002 -w prog.cob " -at_fn_check_prepare_trace "run_misc.at:10942" -( $at_check_trace; cobc -x -std=cobol2002 -w prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:10942" -$at_failed && at_fn_log_failure -$at_traceon; } - - -{ set +x -$as_echo "$at_srcdir/run_misc.at:10944: ./prog" -at_fn_check_prepare_trace "run_misc.at:10944" -( $at_check_trace; ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo "23 tests & 00 failed -" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:10944" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_691 -#AT_START_692 -at_fn_group_banner 692 'run_misc.at:10948' \ - "NO Subscript" " " 4 -at_xfail=no -( - $as_echo "692. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - CONFIGURATION SECTION. - DATA DIVISION. - WORKING-STORAGE SECTION. - - 01 DATA-SIZE PIC 999. - 01 MY-DATA. - 03 MY-TABLE OCCURS 20 TIMES. - 05 MY-ELEMENT-1 PIC X(10). - 05 MY-ELEMENT-2 PIC 99. - 78 MY-LEN VALUE LENGTH OF MY-DATA. - - 01 TBLX PIC 99 VALUE 5. - 01 ODO-DATA. - 03 ODO-TABLE OCCURS 1 TO 15 TIMES DEPENDING ON TBLX. - 05 ODO-ELEMENT-1 PIC X(10). - 05 ODO-ELEMENT-2 PIC 99. - - PROCEDURE DIVISION. - DISPLAY "MY-LEN is " MY-LEN. - MOVE LENGTH OF MY-DATA TO DATA-SIZE. - DISPLAY "MY-DATA is " FUNCTION LENGTH (MY-DATA) - " and " DATA-SIZE. - MOVE LENGTH OF MY-ELEMENT-1 TO DATA-SIZE. - DISPLAY "MY-ELEMENT-1 is " FUNCTION LENGTH (MY-ELEMENT-1) - " and " DATA-SIZE. - MOVE LENGTH OF MY-TABLE TO DATA-SIZE. - DISPLAY "MY-TABLE is " LENGTH OF MY-TABLE - " and " DATA-SIZE. - MOVE LENGTH OF MY-TABLE(1) TO DATA-SIZE. - DISPLAY "MY-TABLE(1) is " FUNCTION LENGTH (MY-TABLE(1)) - " and " DATA-SIZE. - - MOVE LENGTH OF ODO-DATA TO DATA-SIZE. - DISPLAY "ODO-DATA a is " FUNCTION LENGTH (ODO-DATA) - " and " DATA-SIZE. - MOVE FUNCTION LENGTH (ODO-DATA) TO DATA-SIZE. - DISPLAY "ODO-DATA b is " LENGTH OF ODO-DATA - " and " DATA-SIZE. - MOVE LENGTH OF ODO-TABLE TO DATA-SIZE. - DISPLAY "ODO-TABLE is " LENGTH OF ODO-TABLE - " and " DATA-SIZE. - MOVE LENGTH OF ODO-TABLE(1) TO DATA-SIZE. - DISPLAY "ODO-TABLE(1) is " FUNCTION LENGTH (ODO-TABLE(1)) - " and " DATA-SIZE. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_misc.at:11002: cobc -x -std=mf prog.cob " -at_fn_check_prepare_trace "run_misc.at:11002" -( $at_check_trace; cobc -x -std=mf prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob:28: warning: subscript missing for 'MY-ELEMENT-1' - defaulting to 1 -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:11002" -$at_failed && at_fn_log_failure -$at_traceon; } - - -{ set +x -$as_echo "$at_srcdir/run_misc.at:11005: ./prog" -at_fn_check_prepare_trace "run_misc.at:11005" -( $at_check_trace; ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo "MY-LEN is 240 -MY-DATA is 240 and 240 -MY-ELEMENT-1 is 10 and 010 -MY-TABLE is 12 and 012 -MY-TABLE(1) is 12 and 012 -ODO-DATA a is 60 and 060 -ODO-DATA b is 60 and 060 -ODO-TABLE is 12 and 012 -ODO-TABLE(1) is 12 and 012 -" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:11005" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_692 -#AT_START_693 -at_fn_group_banner 693 'run_misc.at:11019' \ - "NO Subscript ACU" " " 4 -at_xfail=no -( - $as_echo "693. $at_setup_line: testing $at_desc ..." - $at_traceon - - -$as_echo "run_misc.at:11021" >"$at_check_line_file" -at_fn_check_skip 77 "$at_srcdir/run_misc.at:11021" - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - CONFIGURATION SECTION. - DATA DIVISION. - WORKING-STORAGE SECTION. - - 01 DATA-SIZE PIC 999. - 01 MY-DATA. - 03 MY-TABLE OCCURS 20 TIMES. - 05 MY-ELEMENT-1 PIC X(10). - 05 MY-ELEMENT-2 PIC 99. - 78 MY-LEN VALUE LENGTH OF MY-DATA. - - 01 TBLX PIC 99 VALUE 5. - 01 ODO-DATA. - 03 ODO-TABLE OCCURS 1 TO 15 TIMES DEPENDING ON TBLX. - 05 ODO-ELEMENT-1 PIC X(10). - 05 ODO-ELEMENT-2 PIC 99. - - PROCEDURE DIVISION. - DISPLAY "MY-LEN is " MY-LEN. - MOVE LENGTH OF MY-DATA TO DATA-SIZE. - DISPLAY "MY-DATA is " FUNCTION LENGTH (MY-DATA) - " and " DATA-SIZE. - MOVE LENGTH OF MY-ELEMENT-1 TO DATA-SIZE. - DISPLAY "MY-ELEMENT-1 is " FUNCTION LENGTH (MY-ELEMENT-1) - " and " DATA-SIZE. - MOVE LENGTH OF MY-TABLE TO DATA-SIZE. - DISPLAY "MY-TABLE is " LENGTH OF MY-TABLE - " and " DATA-SIZE. - MOVE LENGTH OF MY-TABLE(1) TO DATA-SIZE. - DISPLAY "MY-TABLE(1) is " FUNCTION LENGTH (MY-TABLE(1)) - " and " DATA-SIZE. - - MOVE LENGTH OF ODO-DATA TO DATA-SIZE. - DISPLAY "ODO-DATA a is " FUNCTION LENGTH (ODO-DATA) - " and " DATA-SIZE. - MOVE FUNCTION LENGTH (ODO-DATA) TO DATA-SIZE. - DISPLAY "ODO-DATA b is " LENGTH OF ODO-DATA - " and " DATA-SIZE. - MOVE LENGTH OF ODO-TABLE TO DATA-SIZE. - DISPLAY "ODO-TABLE is " LENGTH OF ODO-TABLE - " and " DATA-SIZE. - MOVE LENGTH OF ODO-TABLE(1) TO DATA-SIZE. - DISPLAY "ODO-TABLE(1) is " FUNCTION LENGTH (ODO-TABLE(1)) - " and " DATA-SIZE. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_misc.at:11074: cobc -x -std=acu prog.cob " -at_fn_check_prepare_trace "run_misc.at:11074" -( $at_check_trace; cobc -x -std=acu prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob:28: warning: subscript missing for 'MY-ELEMENT-1' - defaulting to 1 -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:11074" -$at_failed && at_fn_log_failure -$at_traceon; } - - -{ set +x -$as_echo "$at_srcdir/run_misc.at:11077: ./prog" -at_fn_check_prepare_trace "run_misc.at:11077" -( $at_check_trace; ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo "MY-LEN is 0000000240 -MY-DATA is 0000000240 and 240 -MY-ELEMENT-1 is 0000000010 and 010 -MY-TABLE is 0000000240 and 240 -MY-TABLE(1) is 0000000012 and 012 -ODO-DATA a is 0000000060 and 180 -ODO-DATA b is 0000000180 and 060 -ODO-TABLE is 0000000180 and 180 -ODO-TABLE(1) is 0000000012 and 012 -" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:11077" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_693 -#AT_START_694 -at_fn_group_banner 694 'run_misc.at:11090' \ - "IBM SYNC" " " 4 -at_xfail=no -( - $as_echo "694. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - CONFIGURATION SECTION. - DATA DIVISION. - FILE SECTION. - - WORKING-STORAGE SECTION. - - 77 VLEN PIC 99 VALUE 1. - 77 TESTMODE PIC 99 VALUE 1. - 77 TESTIDX PIC 99 VALUE 1. - 77 BIT-MODE PIC 99 VALUE 32. - 77 TESTNUM PIC 99 VALUE 0. - 77 TESTMAX PIC 99 VALUE 24. - 77 TESTCASE PIC 99 VALUE 0. - 77 TESTFAIL PIC 99 VALUE 0. - 77 TESTEND PIC X(15) VALUE " ". - 77 TESTNAME PIC X(10) VALUE " ". - 77 TESTRESULT PIC X(40) VALUE " ". - 77 TESTPTR USAGE POINTER. - - 01 TEST-MODES. - 05 FILLER PIC X(10) VALUE "MF". - 05 FILLER PIC X(10) VALUE "IBMCOMP". - 05 FILLER PIC X(10) VALUE "DEFAULT". - - 01 FILLER REDEFINES TEST-MODES. - 05 FILLER OCCURS 3 TIMES. - 10 TEST-MODE PIC X(10). - - 01 TEST-CASES. - 05 FILLER PIC X(10) VALUE "COMP-FLD1". - 05 FILLER PIC X(40) VALUE "xxxxx1". - 05 FILLER PIC X(40) VALUE "xxxxx11". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - - 05 FILLER PIC X(10) VALUE "COMP-FLD2". - 05 FILLER PIC X(40) VALUE "xxxxx22". - 05 FILLER PIC X(40) VALUE "xxxxxx22". - 05 FILLER PIC X(40) VALUE "xxxxxx22". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - - 05 FILLER PIC X(10) VALUE "COMP-FLDO". - 05 FILLER PIC X(40) VALUE "xxxxxxx11xxx22xxx33". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - - 05 FILLER PIC X(10) VALUE "COMP-FLDS". - 05 FILLER PIC X(40) VALUE "xxxxxxx11xxx22xxx33". - 05 FILLER PIC X(40) VALUE "xxxxxxxx11xxxx22xxxx33". - 05 FILLER PIC X(40) VALUE "xxxxxxxx11xxxx22xxxx33". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - - 05 FILLER PIC X(10) VALUE "COMP-FLD3". - 05 FILLER PIC X(40) VALUE "xxxxx123". - 05 FILLER PIC X(40) VALUE "xxxxxxxx1234". - 05 FILLER PIC X(40) VALUE "xxxxxxxx1234". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - - 05 FILLER PIC X(10) VALUE "COMP-FLDL". - 05 FILLER PIC X(40) VALUE "xxxxx1". - 05 FILLER PIC X(40) VALUE "xxxxxx12". - 05 FILLER PIC X(40) VALUE "xxxxx1". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - - 05 FILLER PIC X(10) VALUE "COMP-FLDR". - 05 FILLER PIC X(40) VALUE "xxxxx1". - 05 FILLER PIC X(40) VALUE "xxxxxx12". - 05 FILLER PIC X(40) VALUE "xxxxx1". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - - 05 FILLER PIC X(10) VALUE "COM1-FLD". - 05 FILLER PIC X(40) VALUE "xxxxx12xxx123xxx12345678". - 05 FILLER PIC X(40) VALUE "xxxxxx12xxxx1234xxxx12345678". - 05 FILLER PIC X(40) VALUE "xxxxxx12xxxx1234xxxxxxxx12345678". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE "xxxxxx12xxxx1234xxxx12345678". - - 05 FILLER PIC X(10) VALUE "COM2-FLD". - 05 FILLER PIC X(40) VALUE "xxxxx12345xxx1234567xxx12345678". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - - 05 FILLER PIC X(10) VALUE "COM3-FLD". - 05 FILLER PIC X(40) VALUE "xxxxx123xxx1234xxx1234567". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - - 05 FILLER PIC X(10) VALUE "COM4-FLD". - 05 FILLER PIC X(40) VALUE "x123456x1234x123456x123". - 05 FILLER PIC X(40) VALUE "xxxx12345678xxxx1234x12345678x1234". - 05 FILLER PIC X(40) - VALUE "xxxxxxxx12345678xxxx1234x12345678x1234". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE "xxxx12345678xxxx1234x12345678x1234". - - 05 FILLER PIC X(10) VALUE "NOSYNC". - 05 FILLER PIC X(40) VALUE "x123456x123". - 05 FILLER PIC X(40) VALUE "x12345678x1234". - 05 FILLER PIC X(40) VALUE "x12345678x1234". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - - 05 FILLER PIC X(10) VALUE "SYNC". - 05 FILLER PIC X(40) VALUE "x123456x1234". - 05 FILLER PIC X(40) VALUE "xxxx12345678xxxx1234". - 05 FILLER PIC X(40) VALUE "xxxxxxxx12345678xxxx1234". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE "xxxx12345678xxxx1234". - - 05 FILLER PIC X(10) VALUE "COMP-3". - 05 FILLER PIC X(40) VALUE "x1234567x1234". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - - 05 FILLER PIC X(10) VALUE "COMP-1". - 05 FILLER PIC X(40) VALUE "12341234". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - - 05 FILLER PIC X(10) VALUE "COMP-2". - 05 FILLER PIC X(40) VALUE "1234567812345678". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - - 05 FILLER PIC X(10) VALUE "SIGN L/T". - 05 FILLER PIC X(40) VALUE "x-01x02-x-03x04-". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - - 05 FILLER PIC X(10) VALUE "COMP-X". - 05 FILLER PIC X(40) VALUE "x123x1234567x1234x12345678". - 05 FILLER PIC X(40) VALUE "x123x1234567xxxx1234xxxx12345678". - 05 FILLER PIC X(40) VALUE "x123x1234567xxxx1234xxxx12345678". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - - 05 FILLER PIC X(10) VALUE "BIN-SHORT". - 05 FILLER PIC X(40) VALUE "x12xx12". - 05 FILLER PIC X(40) VALUE "x12xx12". - 05 FILLER PIC X(40) VALUE "x12xx12". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - - 05 FILLER PIC X(10) VALUE "BIN-DBL". - 05 FILLER PIC X(40) VALUE "x12345678x12345678". - 05 FILLER PIC X(40) VALUE "x12345678x12345678". - 05 FILLER PIC X(40) VALUE "x12345678x12345678". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE "x12345678xxx12345678". - - 05 FILLER PIC X(10) VALUE "BIN-LNG". - 05 FILLER PIC X(40) VALUE "x1234x1234". - 05 FILLER PIC X(40) VALUE "x1234x1234". - 05 FILLER PIC X(40) VALUE "x1234x1234". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE "x1234xxx1234". - - 05 FILLER PIC X(10) VALUE "COMP-5". - 05 FILLER PIC X(40) VALUE "x12345678x12345678". - 05 FILLER PIC X(40) VALUE "x12345678xxx12345678". - 05 FILLER PIC X(40) VALUE "x12345678xxxxxxx12345678". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE "x12345678xxx12345678". - - 05 FILLER PIC X(10) VALUE "CMP-1". - 05 FILLER PIC X(40) VALUE "x1234x1234". - 05 FILLER PIC X(40) VALUE "x1234xxx1234". - 05 FILLER PIC X(40) VALUE "x1234xxx1234". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - - 05 FILLER PIC X(10) VALUE "CMP-2". - 05 FILLER PIC X(40) VALUE "x12345678x12345678". - 05 FILLER PIC X(40) VALUE "x12345678xxxxxxx12345678". - 05 FILLER PIC X(40) VALUE "x12345678xxxxxxx12345678". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE "x12345678xxx12345678". - - 01 FILLER REDEFINES TEST-CASES. - 05 FILLER OCCURS 24 TIMES. - 10 TEST-NAME PIC X(10). - 10 TEST-RESULTS. - 15 MF-64RESULT PIC X(40). - 15 IBM-64RESULT PIC X(40). - 15 C2002-64RESULT PIC X(40). - 15 MF-32RESULT PIC X(40). - 15 IBM-32RESULT PIC X(40). - 15 C2002-32RESULT PIC X(40). - 10 FILLER REDEFINES TEST-RESULTS. - 15 TEST-RESULT PIC X(40) OCCURS 6 TIMES. - - 01 TESTRECORD PIC X(40). - - 01 FILLER REDEFINES TESTRECORD. - 02 TSTREC1. - 10 FILLER PICTURE X(5). - 10 COMP-FLD1 PICTURE S9(2) COMP-4. - 10 FILLER PICTURE X(5). - - 01 FILLER REDEFINES TESTRECORD. - 02 TSTREC2. - 10 FILLER PICTURE X(5). - 10 COMP-FLD2 PICTURE S9(4) COMP-4 SYNC . - - 01 FILLER REDEFINES TESTRECORD. - 02 TSTREC3. - 10 FILLER PICTURE X(5). - 10 COMP-FLD3 PICTURE S9(6) COMP-4 SYNC. - 10 FILLER PICTURE X(5). - - 01 FILLER REDEFINES TESTRECORD. - 02 TSTRECL. - 10 FILLER PICTURE X(5). - 10 COMP-FLDL PICTURE S9(2) COMP-4 SYNC LEFT. - 10 FILLER PICTURE X(5). - - 01 FILLER REDEFINES TESTRECORD. - 02 TSTRECR. - 10 FILLER PICTURE X(5). - 10 COMP-FLDR PICTURE S9(2) COMP-4 SYNC RIGHT. - 10 FILLER PICTURE X(5). - - 01 FILLER REDEFINES TESTRECORD. - 02 TSTRECS. - 10 FILLER PICTURE X(5). - 10 FILLER OCCURS 3 TIMES. - 15 FILLER PICTURE X(2). - 15 COMP-FLDS PICTURE S9(4) COMP-4 SYNC . - 15 FILLER PICTURE X(1). - 10 FILLER PICTURE X(1). - - 01 FILLER REDEFINES TESTRECORD. - 02 TSTRECO. - 10 FILLER PICTURE X(5). - 10 FILLER OCCURS 3 TIMES. - 15 FILLER PICTURE X(2). - 15 COMP-FLDO PICTURE S9(4) COMP-4 . - 15 FILLER PICTURE X(1). - 10 FILLER PICTURE X(1). - - 01 FILLER REDEFINES TESTRECORD. - 02 TSTGRP. - 05 GRP1. - 10 FILLER PICTURE X(5). - 10 COM1-FLD1 PICTURE S9(4) SYNC COMP-4. - 10 FILLER PICTURE X(3). - 10 COM1-FLD2 PICTURE S9(6) SYNC COMP-4. - 10 FILLER PICTURE X(3). - 10 COM1-FLD3 PICTURE S9(18) SYNC COMP-4. - - 01 FILLER REDEFINES TESTRECORD. - 02 TSTGRP2 SIGN LEADING SEPARATE. - 05 GRP2-1. - 10 FILLER PICTURE X(5). - 10 COM2-FLD1 PICTURE S9(4). - 10 FILLER PICTURE X(3). - 10 COM2-FLD2 PICTURE S9(6) SIGN TRAILING SEPARATE. - 10 FILLER PICTURE X(3). - 10 COM2-FLD3 PICTURE S9(7). - - 01 FILLER REDEFINES TESTRECORD. - 02 TSTGRP3. - 05 GRP3-1. - 10 FILLER PICTURE X(5). - 10 COM3-FLD1 PICTURE S9(4) COMP-3. - 10 FILLER PICTURE X(3). - 10 COM3-FLD2 PICTURE S9(6) COMP-3. - 10 FILLER PICTURE X(3). - 05 GRP3-2. - 10 COM3-FLD3 PICTURE S9(13) COMP-3. - - 01 FILLER REDEFINES TESTRECORD. - 02 TSTGRP4. - 05 GRP4-1. - 10 FILLER PICTURE X(1). - 10 COM4-FLD1 PICTURE S9(13) COMP-4 SYNC. - 10 FILLER PICTURE X(1). - 10 COM4-FLD2 PICTURE S9(7) COMP-4 SYNC. - 10 FILLER PICTURE X(1). - 05 GRP4-2. - 10 COM4-FLD3 PICTURE S9(13) COMP-4. - 10 FILLER PICTURE X(1). - 10 COM4-FLD4 PICTURE S9(6) COMP-4. - 10 FILLER PICTURE X(1). - - 01 FILLER REDEFINES TESTRECORD. - 02 TSTGRP5. - 10 FILLER PICTURE X(1). - 10 COM5-FLD1 PICTURE S9(13) COMP-4. - 10 FILLER PICTURE X(1). - 10 COM5-FLD2 PICTURE S9(6) COMP-4. - 10 FILLER PICTURE X(1). - - 01 FILLER REDEFINES TESTRECORD. - 02 TSTGRP5S. - 10 FILLER PICTURE X(1). - 10 COM5S-FLD1 PICTURE S9(13) COMP-4 SYNC. - 10 FILLER PICTURE X(1). - 10 COM5S-FLD2 PICTURE S9(7) COMP-4 SYNC. - 10 FILLER PICTURE X(1). - - 01 FILLER REDEFINES TESTRECORD. - 02 TSTGRP6 COMP-3. - 10 FILLER PICTURE 9(1). - 10 COM6-FLD1 PICTURE S9(13). - 10 FILLER PICTURE 9(1). - 10 COM6-FLD2 PICTURE S9(6). - 10 FILLER PICTURE 9(1). - - 01 FILLER REDEFINES TESTRECORD. - 02 TSTGRP7 COMP-1. - 10 COM7-FLD1 . - 10 COM7-FLD2 . - - 01 FILLER REDEFINES TESTRECORD. - 02 TSTGRP8 COMP-2. - 10 COM8-FLD1 . - 10 COM8-FLD2 . - - 01 FILLER REDEFINES TESTRECORD. - 02 TSTGRP9. - 05 GRP9-1 SIGN LEADING SEPARATE. - 10 FILLER PICTURE X(1). - 10 COM9-FLD1 PICTURE S9(2). - 10 FILLER PICTURE X(1). - 10 COM9-FLD2 PICTURE S9(2) SIGN TRAILING SEPARATE. - 10 FILLER PICTURE X(1). - 05 GRP9-2 SIGN TRAILING SEPARATE. - 10 COM9-FLD3 PICTURE S9(2) SIGN LEADING SEPARATE. - 10 FILLER PICTURE X(1). - 10 COM9-FLD4 PICTURE S9(2). - 10 FILLER PICTURE X(1). - - 01 FILLER REDEFINES TESTRECORD. - 02 TSTGRPX. - 10 FILLER PICTURE X(1). - 10 COMX-FLD1 PICTURE X(3) COMP-X SYNC. - 10 FILLER PICTURE X(1). - 10 COMX-FLD2 PICTURE X(7) COMP-X. - 10 FILLER PICTURE X(1). - 10 COMX-FLT COMP-1 SYNC. - 10 FILLER PICTURE X(1). - 10 COMX-DBL COMP-2 SYNC. - 10 FILLER PICTURE X(1). - - 01 FILLER REDEFINES TESTRECORD. - 02 TST-BSHORT. - 10 FILLER PICTURE X(1). - 10 COMS-FLD1 BINARY-SHORT. - 10 FILLER PICTURE X(2). - 10 COMS-FLD2 BINARY-SHORT SYNC. - 10 FILLER PICTURE X(1). - - 01 FILLER REDEFINES TESTRECORD. - 02 TST-BLONG. - 10 FILLER PICTURE X(1). - 10 COML-FLD1 BINARY-LONG. - 10 FILLER PICTURE X(1). - 10 COML-FLD2 BINARY-LONG SYNC. - 10 FILLER PICTURE X(1). - - 01 FILLER REDEFINES TESTRECORD. - 02 TST-BDBL. - 10 FILLER PICTURE X(1). - 10 COMD-FLD1 BINARY-DOUBLE. - 10 FILLER PICTURE X(1). - 10 COMD-FLD2 BINARY-DOUBLE SYNC. - 10 FILLER PICTURE X(1). - - 01 FILLER REDEFINES TESTRECORD. - 02 TST-BLNG. - 10 FILLER PICTURE X(1). - 10 COMBL-FLD1 BINARY-LONG. - 10 FILLER PICTURE X(1). - 10 COMBL-FLD2 BINARY-LONG SYNC. - 10 FILLER PICTURE X(1). - - 01 FILLER REDEFINES TESTRECORD. - 02 TST-CMP5. - 10 FILLER PICTURE X(1). - 10 CMP5-FLD1 PIC 9(18) COMP-5. - 10 FILLER PICTURE X(1). - 10 CMP5-FLD2 PIC 9(18) COMP-5 SYNC. - 10 FILLER PICTURE X(1). - - 01 FILLER REDEFINES TESTRECORD. - 02 TST-CMP1. - 10 FILLER PICTURE X(1). - 10 CMP1-FLD1 COMP-1. - 10 FILLER PICTURE X(1). - 10 CMP1-FLD2 COMP-1 SYNC. - 10 FILLER PICTURE X(1). - - 01 FILLER REDEFINES TESTRECORD. - 02 TST-CMP2. - 10 FILLER PICTURE X(1). - 10 CMP2-FLD1 COMP-2. - 10 FILLER PICTURE X(1). - 10 CMP2-FLD2 COMP-2 SYNC. - 10 FILLER PICTURE X(1). - - PROCEDURE DIVISION. - - MOVE LENGTH OF TESTPTR TO VLEN. - IF VLEN EQUAL 8 - MOVE 64 TO BIT-MODE - ELSE - MOVE 32 TO BIT-MODE. - MOVE ALL "x" TO TESTRECORD. - MOVE 1 TO TESTMODE. - MOVE ALL "x" TO TSTREC2. - MOVE "22" TO COMP-FLD2 (1:). - IF TSTREC2 = 'xxxxxx22' - MOVE 3 TO TESTMODE. - MOVE "12345678" TO COML-FLD2 (1:). - IF COML-FLD2 = 875770417 - MOVE "Little-Endian" TO TESTEND - ELSE - MOVE "Big-Endian" TO TESTEND - END-IF. - MOVE LENGTH OF COMP-FLD1 TO VLEN. - IF VLEN = 2 - MOVE 2 TO TESTMODE. - MOVE ALL "x" TO TESTRECORD. - - MOVE "COMP-FLD1" TO TESTNAME. - MOVE "11" TO COMP-FLD1 (1:). - PERFORM CHECK-IT. - - MOVE "COMP-FLD2" TO TESTNAME. - MOVE "22" TO COMP-FLD2 (1:). - PERFORM CHECK-IT. - - MOVE "COMP-FLDO" TO TESTNAME. - MOVE "11" TO COMP-FLDO (1) (1:2) - MOVE "22" TO COMP-FLDO (2) (1:2) - MOVE "33" TO COMP-FLDO (3) (1:2) - PERFORM CHECK-IT. - - MOVE "COMP-FLDS" TO TESTNAME. - MOVE "11" TO COMP-FLDS (1) (1:2) - MOVE "22" TO COMP-FLDS (2) (1:2) - MOVE "33" TO COMP-FLDS (3) (1:2) - PERFORM CHECK-IT. - - MOVE "COMP-FLD3" TO TESTNAME. - MOVE "1234678" TO COMP-FLD3 (1:). - PERFORM CHECK-IT. - - MOVE "COMP-FLDL" TO TESTNAME. - MOVE "12345678" TO COMP-FLDL (1:). - PERFORM CHECK-IT. - - MOVE "COMP-FLDR" TO TESTNAME. - MOVE "12345678" TO COMP-FLDR (1:). - PERFORM CHECK-IT. - - MOVE "COM1-FLD" TO TESTNAME. - MOVE "12345678" TO COM1-FLD1 (1:). - MOVE "12345678" TO COM1-FLD2 (1:). - MOVE "12345678" TO COM1-FLD3 (1:). - PERFORM CHECK-IT. - - MOVE "COM2-FLD" TO TESTNAME. - MOVE "12345678" TO COM2-FLD1 (1:). - MOVE "12345678" TO COM2-FLD2 (1:). - MOVE "12345678" TO COM2-FLD3 (1:). - PERFORM CHECK-IT. - - MOVE "COM3-FLD" TO TESTNAME. - MOVE "12345678" TO COM3-FLD1 (1:). - MOVE "12345678" TO COM3-FLD2 (1:). - MOVE "12345678" TO COM3-FLD3 (1:). - PERFORM CHECK-IT. - - MOVE "COM4-FLD" TO TESTNAME. - MOVE "12345678" TO COM4-FLD1 (1:). - MOVE "12345678" TO COM4-FLD2 (1:). - MOVE "12345678" TO COM4-FLD3 (1:). - MOVE "12345678" TO COM4-FLD4 (1:). - PERFORM CHECK-IT. - - MOVE "NOSYNC" TO TESTNAME. - MOVE "12345678" TO COM5-FLD1 (1:). - MOVE "12345678" TO COM5-FLD2 (1:). - PERFORM CHECK-IT. - - MOVE "SYNC" TO TESTNAME. - MOVE "12345678" TO COM5S-FLD1 (1:). - MOVE "12345678" TO COM5S-FLD2 (1:). - PERFORM CHECK-IT. - - MOVE "COMP-3" TO TESTNAME. - MOVE "12345678" TO COM6-FLD1 (1:). - MOVE "12345678" TO COM6-FLD2 (1:). - PERFORM CHECK-IT. - - MOVE "COMP-1" TO TESTNAME. - MOVE "12345678" TO COM7-FLD1 (1:). - MOVE "12345678" TO COM7-FLD2 (1:). - PERFORM CHECK-IT. - - MOVE "COMP-2" TO TESTNAME. - MOVE "12345678" TO COM8-FLD1 (1:). - MOVE "12345678" TO COM8-FLD2 (1:). - PERFORM CHECK-IT. - - MOVE "SIGN L/T" TO TESTNAME. - MOVE -1 TO COM9-FLD1 . - MOVE -2 TO COM9-FLD2 . - MOVE -3 TO COM9-FLD3 . - MOVE -4 TO COM9-FLD4 . - PERFORM CHECK-IT. - - MOVE "COMP-X" TO TESTNAME. - MOVE "12345678" TO COMX-FLD1 (1:). - MOVE "12345678" TO COMX-FLD2 (1:). - MOVE "12345678" TO COMX-FLT (1:). - MOVE "12345678" TO COMX-DBL (1:). - PERFORM CHECK-IT. - - MOVE "BIN-SHORT" TO TESTNAME. - MOVE "12345678" TO COMS-FLD1 (1:). - MOVE "12345678" TO COMS-FLD2 (1:). - PERFORM CHECK-IT. - - MOVE "BIN-DBL" TO TESTNAME. - MOVE "12345678" TO COMD-FLD1 (1:). - MOVE "12345678" TO COMD-FLD2 (1:). - PERFORM CHECK-IT. - - MOVE "BIN-LNG" TO TESTNAME. - MOVE "12345678" TO COMBL-FLD1 (1:). - MOVE "12345678" TO COMBL-FLD2 (1:). - PERFORM CHECK-IT. - - MOVE "COMP-5" TO TESTNAME. - MOVE "12345678" TO CMP5-FLD1 (1:). - MOVE "12345678" TO CMP5-FLD2 (1:). - PERFORM CHECK-IT. - - MOVE "CMP-1" TO TESTNAME. - MOVE "12345678" TO CMP1-FLD1 (1:). - MOVE "12345678" TO CMP1-FLD2 (1:). - PERFORM CHECK-IT. - - MOVE "CMP-2" TO TESTNAME. - MOVE "12345678" TO CMP2-FLD1 (1:). - MOVE "12345678" TO CMP2-FLD2 (1:). - PERFORM CHECK-IT. - - DISPLAY TEST-MODE (TESTMODE) - TESTCASE " tests with " TESTFAIL " failed". - STOP RUN RETURNING 0. - - CHECK-IT SECTION. - CHECK-01. - INSPECT TESTRECORD REPLACING TRAILING 'x' BY ' '. - ADD 1 TO TESTCASE. - PERFORM VARYING TESTNUM FROM 1 BY 1 - UNTIL TEST-NAME (TESTNUM) = TESTNAME - OR TESTNUM > TESTMAX - CONTINUE - END-PERFORM. - IF TESTNUM > TESTMAX - DISPLAY TESTNAME " :NOT FOUND" - DISPLAY " : GOT: " TESTRECORD ":" - ADD 1 TO TESTFAIL - MOVE ALL "x" TO TESTRECORD - GO TO CHECK-EXIT - END-IF. - MOVE TEST-RESULT (TESTNUM, TESTMODE) TO TESTRESULT. - COMPUTE TESTIDX = TESTMODE + 3. - IF BIT-MODE = 32 - AND TEST-RESULT (TESTNUM, TESTIDX) NOT = SPACES - MOVE TEST-RESULT (TESTNUM, TESTIDX) TO TESTRESULT. - IF TESTRESULT = SPACES - MOVE TEST-RESULT (TESTNUM, 1) TO TESTRESULT. - IF TESTRESULT NOT = TESTRECORD - DISPLAY TESTNAME - " :FAILED: Mode " BIT-MODE - " " TEST-MODE (TESTMODE) - ", Case " TESTCASE ", " TESTEND - DISPLAY " : GOT: " TESTRECORD ":" - DISPLAY " :EXPECT: " TESTRESULT ":" - ADD 1 TO TESTFAIL - END-IF. - MOVE ALL "x" TO TESTRECORD. - CHECK-EXIT. - EXIT. - -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_misc.at:11734: cobc -x -std=ibm -w prog.cob " -at_fn_check_prepare_trace "run_misc.at:11734" -( $at_check_trace; cobc -x -std=ibm -w prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:11734" -$at_failed && at_fn_log_failure -$at_traceon; } - - -{ set +x -$as_echo "$at_srcdir/run_misc.at:11736: ./prog" -at_fn_check_prepare_trace "run_misc.at:11736" -( $at_check_trace; ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo "IBMCOMP 24 tests with 00 failed -" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:11736" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_694 -#AT_START_695 -at_fn_group_banner 695 'run_misc.at:11742' \ - "MF IBMCOMP SYNC" " " 4 -at_xfail=no -( - $as_echo "695. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - CONFIGURATION SECTION. - DATA DIVISION. - FILE SECTION. - - WORKING-STORAGE SECTION. - - 77 VLEN PIC 99 VALUE 1. - 77 TESTMODE PIC 99 VALUE 1. - 77 TESTIDX PIC 99 VALUE 1. - 77 BIT-MODE PIC 99 VALUE 32. - 77 TESTNUM PIC 99 VALUE 0. - 77 TESTMAX PIC 99 VALUE 24. - 77 TESTCASE PIC 99 VALUE 0. - 77 TESTFAIL PIC 99 VALUE 0. - 77 TESTEND PIC X(15) VALUE " ". - 77 TESTNAME PIC X(10) VALUE " ". - 77 TESTRESULT PIC X(40) VALUE " ". - 77 TESTPTR USAGE POINTER. - - 01 TEST-MODES. - 05 FILLER PIC X(10) VALUE "MF". - 05 FILLER PIC X(10) VALUE "IBMCOMP". - 05 FILLER PIC X(10) VALUE "DEFAULT". - - 01 FILLER REDEFINES TEST-MODES. - 05 FILLER OCCURS 3 TIMES. - 10 TEST-MODE PIC X(10). - - 01 TEST-CASES. - 05 FILLER PIC X(10) VALUE "COMP-FLD1". - 05 FILLER PIC X(40) VALUE "xxxxx1". - 05 FILLER PIC X(40) VALUE "xxxxx11". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - - 05 FILLER PIC X(10) VALUE "COMP-FLD2". - 05 FILLER PIC X(40) VALUE "xxxxx22". - 05 FILLER PIC X(40) VALUE "xxxxxx22". - 05 FILLER PIC X(40) VALUE "xxxxxx22". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - - 05 FILLER PIC X(10) VALUE "COMP-FLDO". - 05 FILLER PIC X(40) VALUE "xxxxxxx11xxx22xxx33". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - - 05 FILLER PIC X(10) VALUE "COMP-FLDS". - 05 FILLER PIC X(40) VALUE "xxxxxxx11xxx22xxx33". - 05 FILLER PIC X(40) VALUE "xxxxxxxx11xxxx22xxxx33". - 05 FILLER PIC X(40) VALUE "xxxxxxxx11xxxx22xxxx33". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - - 05 FILLER PIC X(10) VALUE "COMP-FLD3". - 05 FILLER PIC X(40) VALUE "xxxxx123". - 05 FILLER PIC X(40) VALUE "xxxxxxxx1234". - 05 FILLER PIC X(40) VALUE "xxxxxxxx1234". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - - 05 FILLER PIC X(10) VALUE "COMP-FLDL". - 05 FILLER PIC X(40) VALUE "xxxxx1". - 05 FILLER PIC X(40) VALUE "xxxxxx12". - 05 FILLER PIC X(40) VALUE "xxxxx1". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - - 05 FILLER PIC X(10) VALUE "COMP-FLDR". - 05 FILLER PIC X(40) VALUE "xxxxx1". - 05 FILLER PIC X(40) VALUE "xxxxxx12". - 05 FILLER PIC X(40) VALUE "xxxxx1". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - - 05 FILLER PIC X(10) VALUE "COM1-FLD". - 05 FILLER PIC X(40) VALUE "xxxxx12xxx123xxx12345678". - 05 FILLER PIC X(40) VALUE "xxxxxx12xxxx1234xxxx12345678". - 05 FILLER PIC X(40) VALUE "xxxxxx12xxxx1234xxxxxxxx12345678". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE "xxxxxx12xxxx1234xxxx12345678". - - 05 FILLER PIC X(10) VALUE "COM2-FLD". - 05 FILLER PIC X(40) VALUE "xxxxx12345xxx1234567xxx12345678". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - - 05 FILLER PIC X(10) VALUE "COM3-FLD". - 05 FILLER PIC X(40) VALUE "xxxxx123xxx1234xxx1234567". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - - 05 FILLER PIC X(10) VALUE "COM4-FLD". - 05 FILLER PIC X(40) VALUE "x123456x1234x123456x123". - 05 FILLER PIC X(40) VALUE "xxxx12345678xxxx1234x12345678x1234". - 05 FILLER PIC X(40) - VALUE "xxxxxxxx12345678xxxx1234x12345678x1234". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE "xxxx12345678xxxx1234x12345678x1234". - - 05 FILLER PIC X(10) VALUE "NOSYNC". - 05 FILLER PIC X(40) VALUE "x123456x123". - 05 FILLER PIC X(40) VALUE "x12345678x1234". - 05 FILLER PIC X(40) VALUE "x12345678x1234". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - - 05 FILLER PIC X(10) VALUE "SYNC". - 05 FILLER PIC X(40) VALUE "x123456x1234". - 05 FILLER PIC X(40) VALUE "xxxx12345678xxxx1234". - 05 FILLER PIC X(40) VALUE "xxxxxxxx12345678xxxx1234". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE "xxxx12345678xxxx1234". - - 05 FILLER PIC X(10) VALUE "COMP-3". - 05 FILLER PIC X(40) VALUE "x1234567x1234". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - - 05 FILLER PIC X(10) VALUE "COMP-1". - 05 FILLER PIC X(40) VALUE "12341234". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - - 05 FILLER PIC X(10) VALUE "COMP-2". - 05 FILLER PIC X(40) VALUE "1234567812345678". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - - 05 FILLER PIC X(10) VALUE "SIGN L/T". - 05 FILLER PIC X(40) VALUE "x-01x02-x-03x04-". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - - 05 FILLER PIC X(10) VALUE "COMP-X". - 05 FILLER PIC X(40) VALUE "x123x1234567x1234x12345678". - 05 FILLER PIC X(40) VALUE "x123x1234567xxxx1234xxxx12345678". - 05 FILLER PIC X(40) VALUE "x123x1234567xxxx1234xxxx12345678". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - - 05 FILLER PIC X(10) VALUE "BIN-SHORT". - 05 FILLER PIC X(40) VALUE "x12xx12". - 05 FILLER PIC X(40) VALUE "x12xx12". - 05 FILLER PIC X(40) VALUE "x12xx12". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - - 05 FILLER PIC X(10) VALUE "BIN-DBL". - 05 FILLER PIC X(40) VALUE "x12345678x12345678". - 05 FILLER PIC X(40) VALUE "x12345678x12345678". - 05 FILLER PIC X(40) VALUE "x12345678x12345678". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE "x12345678xxx12345678". - - 05 FILLER PIC X(10) VALUE "BIN-LNG". - 05 FILLER PIC X(40) VALUE "x1234x1234". - 05 FILLER PIC X(40) VALUE "x1234x1234". - 05 FILLER PIC X(40) VALUE "x1234x1234". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE "x1234xxx1234". - - 05 FILLER PIC X(10) VALUE "COMP-5". - 05 FILLER PIC X(40) VALUE "x12345678x12345678". - 05 FILLER PIC X(40) VALUE "x12345678xxx12345678". - 05 FILLER PIC X(40) VALUE "x12345678xxxxxxx12345678". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE "x12345678xxx12345678". - - 05 FILLER PIC X(10) VALUE "CMP-1". - 05 FILLER PIC X(40) VALUE "x1234x1234". - 05 FILLER PIC X(40) VALUE "x1234xxx1234". - 05 FILLER PIC X(40) VALUE "x1234xxx1234". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - - 05 FILLER PIC X(10) VALUE "CMP-2". - 05 FILLER PIC X(40) VALUE "x12345678x12345678". - 05 FILLER PIC X(40) VALUE "x12345678xxxxxxx12345678". - 05 FILLER PIC X(40) VALUE "x12345678xxxxxxx12345678". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE "x12345678xxx12345678". - - 01 FILLER REDEFINES TEST-CASES. - 05 FILLER OCCURS 24 TIMES. - 10 TEST-NAME PIC X(10). - 10 TEST-RESULTS. - 15 MF-64RESULT PIC X(40). - 15 IBM-64RESULT PIC X(40). - 15 C2002-64RESULT PIC X(40). - 15 MF-32RESULT PIC X(40). - 15 IBM-32RESULT PIC X(40). - 15 C2002-32RESULT PIC X(40). - 10 FILLER REDEFINES TEST-RESULTS. - 15 TEST-RESULT PIC X(40) OCCURS 6 TIMES. - - 01 TESTRECORD PIC X(40). - - 01 FILLER REDEFINES TESTRECORD. - 02 TSTREC1. - 10 FILLER PICTURE X(5). - 10 COMP-FLD1 PICTURE S9(2) COMP-4. - 10 FILLER PICTURE X(5). - - 01 FILLER REDEFINES TESTRECORD. - 02 TSTREC2. - 10 FILLER PICTURE X(5). - 10 COMP-FLD2 PICTURE S9(4) COMP-4 SYNC . - - 01 FILLER REDEFINES TESTRECORD. - 02 TSTREC3. - 10 FILLER PICTURE X(5). - 10 COMP-FLD3 PICTURE S9(6) COMP-4 SYNC. - 10 FILLER PICTURE X(5). - - 01 FILLER REDEFINES TESTRECORD. - 02 TSTRECL. - 10 FILLER PICTURE X(5). - 10 COMP-FLDL PICTURE S9(2) COMP-4 SYNC LEFT. - 10 FILLER PICTURE X(5). - - 01 FILLER REDEFINES TESTRECORD. - 02 TSTRECR. - 10 FILLER PICTURE X(5). - 10 COMP-FLDR PICTURE S9(2) COMP-4 SYNC RIGHT. - 10 FILLER PICTURE X(5). - - 01 FILLER REDEFINES TESTRECORD. - 02 TSTRECS. - 10 FILLER PICTURE X(5). - 10 FILLER OCCURS 3 TIMES. - 15 FILLER PICTURE X(2). - 15 COMP-FLDS PICTURE S9(4) COMP-4 SYNC . - 15 FILLER PICTURE X(1). - 10 FILLER PICTURE X(1). - - 01 FILLER REDEFINES TESTRECORD. - 02 TSTRECO. - 10 FILLER PICTURE X(5). - 10 FILLER OCCURS 3 TIMES. - 15 FILLER PICTURE X(2). - 15 COMP-FLDO PICTURE S9(4) COMP-4 . - 15 FILLER PICTURE X(1). - 10 FILLER PICTURE X(1). - - 01 FILLER REDEFINES TESTRECORD. - 02 TSTGRP. - 05 GRP1. - 10 FILLER PICTURE X(5). - 10 COM1-FLD1 PICTURE S9(4) SYNC COMP-4. - 10 FILLER PICTURE X(3). - 10 COM1-FLD2 PICTURE S9(6) SYNC COMP-4. - 10 FILLER PICTURE X(3). - 10 COM1-FLD3 PICTURE S9(18) SYNC COMP-4. - - 01 FILLER REDEFINES TESTRECORD. - 02 TSTGRP2 SIGN LEADING SEPARATE. - 05 GRP2-1. - 10 FILLER PICTURE X(5). - 10 COM2-FLD1 PICTURE S9(4). - 10 FILLER PICTURE X(3). - 10 COM2-FLD2 PICTURE S9(6) SIGN TRAILING SEPARATE. - 10 FILLER PICTURE X(3). - 10 COM2-FLD3 PICTURE S9(7). - - 01 FILLER REDEFINES TESTRECORD. - 02 TSTGRP3. - 05 GRP3-1. - 10 FILLER PICTURE X(5). - 10 COM3-FLD1 PICTURE S9(4) COMP-3. - 10 FILLER PICTURE X(3). - 10 COM3-FLD2 PICTURE S9(6) COMP-3. - 10 FILLER PICTURE X(3). - 05 GRP3-2. - 10 COM3-FLD3 PICTURE S9(13) COMP-3. - - 01 FILLER REDEFINES TESTRECORD. - 02 TSTGRP4. - 05 GRP4-1. - 10 FILLER PICTURE X(1). - 10 COM4-FLD1 PICTURE S9(13) COMP-4 SYNC. - 10 FILLER PICTURE X(1). - 10 COM4-FLD2 PICTURE S9(7) COMP-4 SYNC. - 10 FILLER PICTURE X(1). - 05 GRP4-2. - 10 COM4-FLD3 PICTURE S9(13) COMP-4. - 10 FILLER PICTURE X(1). - 10 COM4-FLD4 PICTURE S9(6) COMP-4. - 10 FILLER PICTURE X(1). - - 01 FILLER REDEFINES TESTRECORD. - 02 TSTGRP5. - 10 FILLER PICTURE X(1). - 10 COM5-FLD1 PICTURE S9(13) COMP-4. - 10 FILLER PICTURE X(1). - 10 COM5-FLD2 PICTURE S9(6) COMP-4. - 10 FILLER PICTURE X(1). - - 01 FILLER REDEFINES TESTRECORD. - 02 TSTGRP5S. - 10 FILLER PICTURE X(1). - 10 COM5S-FLD1 PICTURE S9(13) COMP-4 SYNC. - 10 FILLER PICTURE X(1). - 10 COM5S-FLD2 PICTURE S9(7) COMP-4 SYNC. - 10 FILLER PICTURE X(1). - - 01 FILLER REDEFINES TESTRECORD. - 02 TSTGRP6 COMP-3. - 10 FILLER PICTURE 9(1). - 10 COM6-FLD1 PICTURE S9(13). - 10 FILLER PICTURE 9(1). - 10 COM6-FLD2 PICTURE S9(6). - 10 FILLER PICTURE 9(1). - - 01 FILLER REDEFINES TESTRECORD. - 02 TSTGRP7 COMP-1. - 10 COM7-FLD1 . - 10 COM7-FLD2 . - - 01 FILLER REDEFINES TESTRECORD. - 02 TSTGRP8 COMP-2. - 10 COM8-FLD1 . - 10 COM8-FLD2 . - - 01 FILLER REDEFINES TESTRECORD. - 02 TSTGRP9. - 05 GRP9-1 SIGN LEADING SEPARATE. - 10 FILLER PICTURE X(1). - 10 COM9-FLD1 PICTURE S9(2). - 10 FILLER PICTURE X(1). - 10 COM9-FLD2 PICTURE S9(2) SIGN TRAILING SEPARATE. - 10 FILLER PICTURE X(1). - 05 GRP9-2 SIGN TRAILING SEPARATE. - 10 COM9-FLD3 PICTURE S9(2) SIGN LEADING SEPARATE. - 10 FILLER PICTURE X(1). - 10 COM9-FLD4 PICTURE S9(2). - 10 FILLER PICTURE X(1). - - 01 FILLER REDEFINES TESTRECORD. - 02 TSTGRPX. - 10 FILLER PICTURE X(1). - 10 COMX-FLD1 PICTURE X(3) COMP-X SYNC. - 10 FILLER PICTURE X(1). - 10 COMX-FLD2 PICTURE X(7) COMP-X. - 10 FILLER PICTURE X(1). - 10 COMX-FLT COMP-1 SYNC. - 10 FILLER PICTURE X(1). - 10 COMX-DBL COMP-2 SYNC. - 10 FILLER PICTURE X(1). - - 01 FILLER REDEFINES TESTRECORD. - 02 TST-BSHORT. - 10 FILLER PICTURE X(1). - 10 COMS-FLD1 BINARY-SHORT. - 10 FILLER PICTURE X(2). - 10 COMS-FLD2 BINARY-SHORT SYNC. - 10 FILLER PICTURE X(1). - - 01 FILLER REDEFINES TESTRECORD. - 02 TST-BLONG. - 10 FILLER PICTURE X(1). - 10 COML-FLD1 BINARY-LONG. - 10 FILLER PICTURE X(1). - 10 COML-FLD2 BINARY-LONG SYNC. - 10 FILLER PICTURE X(1). - - 01 FILLER REDEFINES TESTRECORD. - 02 TST-BDBL. - 10 FILLER PICTURE X(1). - 10 COMD-FLD1 BINARY-DOUBLE. - 10 FILLER PICTURE X(1). - 10 COMD-FLD2 BINARY-DOUBLE SYNC. - 10 FILLER PICTURE X(1). - - 01 FILLER REDEFINES TESTRECORD. - 02 TST-BLNG. - 10 FILLER PICTURE X(1). - 10 COMBL-FLD1 BINARY-LONG. - 10 FILLER PICTURE X(1). - 10 COMBL-FLD2 BINARY-LONG SYNC. - 10 FILLER PICTURE X(1). - - 01 FILLER REDEFINES TESTRECORD. - 02 TST-CMP5. - 10 FILLER PICTURE X(1). - 10 CMP5-FLD1 PIC 9(18) COMP-5. - 10 FILLER PICTURE X(1). - 10 CMP5-FLD2 PIC 9(18) COMP-5 SYNC. - 10 FILLER PICTURE X(1). - - 01 FILLER REDEFINES TESTRECORD. - 02 TST-CMP1. - 10 FILLER PICTURE X(1). - 10 CMP1-FLD1 COMP-1. - 10 FILLER PICTURE X(1). - 10 CMP1-FLD2 COMP-1 SYNC. - 10 FILLER PICTURE X(1). - - 01 FILLER REDEFINES TESTRECORD. - 02 TST-CMP2. - 10 FILLER PICTURE X(1). - 10 CMP2-FLD1 COMP-2. - 10 FILLER PICTURE X(1). - 10 CMP2-FLD2 COMP-2 SYNC. - 10 FILLER PICTURE X(1). - - PROCEDURE DIVISION. - - MOVE LENGTH OF TESTPTR TO VLEN. - IF VLEN EQUAL 8 - MOVE 64 TO BIT-MODE - ELSE - MOVE 32 TO BIT-MODE. - MOVE ALL "x" TO TESTRECORD. - MOVE 1 TO TESTMODE. - MOVE ALL "x" TO TSTREC2. - MOVE "22" TO COMP-FLD2 (1:). - IF TSTREC2 = 'xxxxxx22' - MOVE 3 TO TESTMODE. - MOVE "12345678" TO COML-FLD2 (1:). - IF COML-FLD2 = 875770417 - MOVE "Little-Endian" TO TESTEND - ELSE - MOVE "Big-Endian" TO TESTEND - END-IF. - MOVE LENGTH OF COMP-FLD1 TO VLEN. - IF VLEN = 2 - MOVE 2 TO TESTMODE. - MOVE ALL "x" TO TESTRECORD. - - MOVE "COMP-FLD1" TO TESTNAME. - MOVE "11" TO COMP-FLD1 (1:). - PERFORM CHECK-IT. - - MOVE "COMP-FLD2" TO TESTNAME. - MOVE "22" TO COMP-FLD2 (1:). - PERFORM CHECK-IT. - - MOVE "COMP-FLDO" TO TESTNAME. - MOVE "11" TO COMP-FLDO (1) (1:2) - MOVE "22" TO COMP-FLDO (2) (1:2) - MOVE "33" TO COMP-FLDO (3) (1:2) - PERFORM CHECK-IT. - - MOVE "COMP-FLDS" TO TESTNAME. - MOVE "11" TO COMP-FLDS (1) (1:2) - MOVE "22" TO COMP-FLDS (2) (1:2) - MOVE "33" TO COMP-FLDS (3) (1:2) - PERFORM CHECK-IT. - - MOVE "COMP-FLD3" TO TESTNAME. - MOVE "1234678" TO COMP-FLD3 (1:). - PERFORM CHECK-IT. - - MOVE "COMP-FLDL" TO TESTNAME. - MOVE "12345678" TO COMP-FLDL (1:). - PERFORM CHECK-IT. - - MOVE "COMP-FLDR" TO TESTNAME. - MOVE "12345678" TO COMP-FLDR (1:). - PERFORM CHECK-IT. - - MOVE "COM1-FLD" TO TESTNAME. - MOVE "12345678" TO COM1-FLD1 (1:). - MOVE "12345678" TO COM1-FLD2 (1:). - MOVE "12345678" TO COM1-FLD3 (1:). - PERFORM CHECK-IT. - - MOVE "COM2-FLD" TO TESTNAME. - MOVE "12345678" TO COM2-FLD1 (1:). - MOVE "12345678" TO COM2-FLD2 (1:). - MOVE "12345678" TO COM2-FLD3 (1:). - PERFORM CHECK-IT. - - MOVE "COM3-FLD" TO TESTNAME. - MOVE "12345678" TO COM3-FLD1 (1:). - MOVE "12345678" TO COM3-FLD2 (1:). - MOVE "12345678" TO COM3-FLD3 (1:). - PERFORM CHECK-IT. - - MOVE "COM4-FLD" TO TESTNAME. - MOVE "12345678" TO COM4-FLD1 (1:). - MOVE "12345678" TO COM4-FLD2 (1:). - MOVE "12345678" TO COM4-FLD3 (1:). - MOVE "12345678" TO COM4-FLD4 (1:). - PERFORM CHECK-IT. - - MOVE "NOSYNC" TO TESTNAME. - MOVE "12345678" TO COM5-FLD1 (1:). - MOVE "12345678" TO COM5-FLD2 (1:). - PERFORM CHECK-IT. - - MOVE "SYNC" TO TESTNAME. - MOVE "12345678" TO COM5S-FLD1 (1:). - MOVE "12345678" TO COM5S-FLD2 (1:). - PERFORM CHECK-IT. - - MOVE "COMP-3" TO TESTNAME. - MOVE "12345678" TO COM6-FLD1 (1:). - MOVE "12345678" TO COM6-FLD2 (1:). - PERFORM CHECK-IT. - - MOVE "COMP-1" TO TESTNAME. - MOVE "12345678" TO COM7-FLD1 (1:). - MOVE "12345678" TO COM7-FLD2 (1:). - PERFORM CHECK-IT. - - MOVE "COMP-2" TO TESTNAME. - MOVE "12345678" TO COM8-FLD1 (1:). - MOVE "12345678" TO COM8-FLD2 (1:). - PERFORM CHECK-IT. - - MOVE "SIGN L/T" TO TESTNAME. - MOVE -1 TO COM9-FLD1 . - MOVE -2 TO COM9-FLD2 . - MOVE -3 TO COM9-FLD3 . - MOVE -4 TO COM9-FLD4 . - PERFORM CHECK-IT. - - MOVE "COMP-X" TO TESTNAME. - MOVE "12345678" TO COMX-FLD1 (1:). - MOVE "12345678" TO COMX-FLD2 (1:). - MOVE "12345678" TO COMX-FLT (1:). - MOVE "12345678" TO COMX-DBL (1:). - PERFORM CHECK-IT. - - MOVE "BIN-SHORT" TO TESTNAME. - MOVE "12345678" TO COMS-FLD1 (1:). - MOVE "12345678" TO COMS-FLD2 (1:). - PERFORM CHECK-IT. - - MOVE "BIN-DBL" TO TESTNAME. - MOVE "12345678" TO COMD-FLD1 (1:). - MOVE "12345678" TO COMD-FLD2 (1:). - PERFORM CHECK-IT. - - MOVE "BIN-LNG" TO TESTNAME. - MOVE "12345678" TO COMBL-FLD1 (1:). - MOVE "12345678" TO COMBL-FLD2 (1:). - PERFORM CHECK-IT. - - MOVE "COMP-5" TO TESTNAME. - MOVE "12345678" TO CMP5-FLD1 (1:). - MOVE "12345678" TO CMP5-FLD2 (1:). - PERFORM CHECK-IT. - - MOVE "CMP-1" TO TESTNAME. - MOVE "12345678" TO CMP1-FLD1 (1:). - MOVE "12345678" TO CMP1-FLD2 (1:). - PERFORM CHECK-IT. - - MOVE "CMP-2" TO TESTNAME. - MOVE "12345678" TO CMP2-FLD1 (1:). - MOVE "12345678" TO CMP2-FLD2 (1:). - PERFORM CHECK-IT. - - DISPLAY TEST-MODE (TESTMODE) - TESTCASE " tests with " TESTFAIL " failed". - STOP RUN RETURNING 0. - - CHECK-IT SECTION. - CHECK-01. - INSPECT TESTRECORD REPLACING TRAILING 'x' BY ' '. - ADD 1 TO TESTCASE. - PERFORM VARYING TESTNUM FROM 1 BY 1 - UNTIL TEST-NAME (TESTNUM) = TESTNAME - OR TESTNUM > TESTMAX - CONTINUE - END-PERFORM. - IF TESTNUM > TESTMAX - DISPLAY TESTNAME " :NOT FOUND" - DISPLAY " : GOT: " TESTRECORD ":" - ADD 1 TO TESTFAIL - MOVE ALL "x" TO TESTRECORD - GO TO CHECK-EXIT - END-IF. - MOVE TEST-RESULT (TESTNUM, TESTMODE) TO TESTRESULT. - COMPUTE TESTIDX = TESTMODE + 3. - IF BIT-MODE = 32 - AND TEST-RESULT (TESTNUM, TESTIDX) NOT = SPACES - MOVE TEST-RESULT (TESTNUM, TESTIDX) TO TESTRESULT. - IF TESTRESULT = SPACES - MOVE TEST-RESULT (TESTNUM, 1) TO TESTRESULT. - IF TESTRESULT NOT = TESTRECORD - DISPLAY TESTNAME - " :FAILED: Mode " BIT-MODE - " " TEST-MODE (TESTMODE) - ", Case " TESTCASE ", " TESTEND - DISPLAY " : GOT: " TESTRECORD ":" - DISPLAY " :EXPECT: " TESTRESULT ":" - ADD 1 TO TESTFAIL - END-IF. - MOVE ALL "x" TO TESTRECORD. - CHECK-EXIT. - EXIT. - -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_misc.at:12386: cobc -x -std=mf -w -fibmcomp prog.cob " -at_fn_check_prepare_trace "run_misc.at:12386" -( $at_check_trace; cobc -x -std=mf -w -fibmcomp prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:12386" -$at_failed && at_fn_log_failure -$at_traceon; } - - -{ set +x -$as_echo "$at_srcdir/run_misc.at:12388: ./prog" -at_fn_check_prepare_trace "run_misc.at:12388" -( $at_check_trace; ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo "IBMCOMP 24 tests with 00 failed -" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:12388" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_695 -#AT_START_696 -at_fn_group_banner 696 'run_misc.at:12394' \ - "MF SYNC" " " 4 -at_xfail=no -( - $as_echo "696. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - CONFIGURATION SECTION. - DATA DIVISION. - FILE SECTION. - - WORKING-STORAGE SECTION. - - 77 VLEN PIC 99 VALUE 1. - 77 TESTMODE PIC 99 VALUE 1. - 77 TESTIDX PIC 99 VALUE 1. - 77 BIT-MODE PIC 99 VALUE 32. - 77 TESTNUM PIC 99 VALUE 0. - 77 TESTMAX PIC 99 VALUE 24. - 77 TESTCASE PIC 99 VALUE 0. - 77 TESTFAIL PIC 99 VALUE 0. - 77 TESTEND PIC X(15) VALUE " ". - 77 TESTNAME PIC X(10) VALUE " ". - 77 TESTRESULT PIC X(40) VALUE " ". - 77 TESTPTR USAGE POINTER. - - 01 TEST-MODES. - 05 FILLER PIC X(10) VALUE "MF". - 05 FILLER PIC X(10) VALUE "IBMCOMP". - 05 FILLER PIC X(10) VALUE "DEFAULT". - - 01 FILLER REDEFINES TEST-MODES. - 05 FILLER OCCURS 3 TIMES. - 10 TEST-MODE PIC X(10). - - 01 TEST-CASES. - 05 FILLER PIC X(10) VALUE "COMP-FLD1". - 05 FILLER PIC X(40) VALUE "xxxxx1". - 05 FILLER PIC X(40) VALUE "xxxxx11". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - - 05 FILLER PIC X(10) VALUE "COMP-FLD2". - 05 FILLER PIC X(40) VALUE "xxxxx22". - 05 FILLER PIC X(40) VALUE "xxxxxx22". - 05 FILLER PIC X(40) VALUE "xxxxxx22". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - - 05 FILLER PIC X(10) VALUE "COMP-FLDO". - 05 FILLER PIC X(40) VALUE "xxxxxxx11xxx22xxx33". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - - 05 FILLER PIC X(10) VALUE "COMP-FLDS". - 05 FILLER PIC X(40) VALUE "xxxxxxx11xxx22xxx33". - 05 FILLER PIC X(40) VALUE "xxxxxxxx11xxxx22xxxx33". - 05 FILLER PIC X(40) VALUE "xxxxxxxx11xxxx22xxxx33". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - - 05 FILLER PIC X(10) VALUE "COMP-FLD3". - 05 FILLER PIC X(40) VALUE "xxxxx123". - 05 FILLER PIC X(40) VALUE "xxxxxxxx1234". - 05 FILLER PIC X(40) VALUE "xxxxxxxx1234". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - - 05 FILLER PIC X(10) VALUE "COMP-FLDL". - 05 FILLER PIC X(40) VALUE "xxxxx1". - 05 FILLER PIC X(40) VALUE "xxxxxx12". - 05 FILLER PIC X(40) VALUE "xxxxx1". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - - 05 FILLER PIC X(10) VALUE "COMP-FLDR". - 05 FILLER PIC X(40) VALUE "xxxxx1". - 05 FILLER PIC X(40) VALUE "xxxxxx12". - 05 FILLER PIC X(40) VALUE "xxxxx1". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - - 05 FILLER PIC X(10) VALUE "COM1-FLD". - 05 FILLER PIC X(40) VALUE "xxxxx12xxx123xxx12345678". - 05 FILLER PIC X(40) VALUE "xxxxxx12xxxx1234xxxx12345678". - 05 FILLER PIC X(40) VALUE "xxxxxx12xxxx1234xxxxxxxx12345678". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE "xxxxxx12xxxx1234xxxx12345678". - - 05 FILLER PIC X(10) VALUE "COM2-FLD". - 05 FILLER PIC X(40) VALUE "xxxxx12345xxx1234567xxx12345678". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - - 05 FILLER PIC X(10) VALUE "COM3-FLD". - 05 FILLER PIC X(40) VALUE "xxxxx123xxx1234xxx1234567". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - - 05 FILLER PIC X(10) VALUE "COM4-FLD". - 05 FILLER PIC X(40) VALUE "x123456x1234x123456x123". - 05 FILLER PIC X(40) VALUE "xxxx12345678xxxx1234x12345678x1234". - 05 FILLER PIC X(40) - VALUE "xxxxxxxx12345678xxxx1234x12345678x1234". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE "xxxx12345678xxxx1234x12345678x1234". - - 05 FILLER PIC X(10) VALUE "NOSYNC". - 05 FILLER PIC X(40) VALUE "x123456x123". - 05 FILLER PIC X(40) VALUE "x12345678x1234". - 05 FILLER PIC X(40) VALUE "x12345678x1234". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - - 05 FILLER PIC X(10) VALUE "SYNC". - 05 FILLER PIC X(40) VALUE "x123456x1234". - 05 FILLER PIC X(40) VALUE "xxxx12345678xxxx1234". - 05 FILLER PIC X(40) VALUE "xxxxxxxx12345678xxxx1234". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE "xxxx12345678xxxx1234". - - 05 FILLER PIC X(10) VALUE "COMP-3". - 05 FILLER PIC X(40) VALUE "x1234567x1234". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - - 05 FILLER PIC X(10) VALUE "COMP-1". - 05 FILLER PIC X(40) VALUE "12341234". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - - 05 FILLER PIC X(10) VALUE "COMP-2". - 05 FILLER PIC X(40) VALUE "1234567812345678". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - - 05 FILLER PIC X(10) VALUE "SIGN L/T". - 05 FILLER PIC X(40) VALUE "x-01x02-x-03x04-". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - - 05 FILLER PIC X(10) VALUE "COMP-X". - 05 FILLER PIC X(40) VALUE "x123x1234567x1234x12345678". - 05 FILLER PIC X(40) VALUE "x123x1234567xxxx1234xxxx12345678". - 05 FILLER PIC X(40) VALUE "x123x1234567xxxx1234xxxx12345678". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - - 05 FILLER PIC X(10) VALUE "BIN-SHORT". - 05 FILLER PIC X(40) VALUE "x12xx12". - 05 FILLER PIC X(40) VALUE "x12xx12". - 05 FILLER PIC X(40) VALUE "x12xx12". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - - 05 FILLER PIC X(10) VALUE "BIN-DBL". - 05 FILLER PIC X(40) VALUE "x12345678x12345678". - 05 FILLER PIC X(40) VALUE "x12345678x12345678". - 05 FILLER PIC X(40) VALUE "x12345678x12345678". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE "x12345678xxx12345678". - - 05 FILLER PIC X(10) VALUE "BIN-LNG". - 05 FILLER PIC X(40) VALUE "x1234x1234". - 05 FILLER PIC X(40) VALUE "x1234x1234". - 05 FILLER PIC X(40) VALUE "x1234x1234". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE "x1234xxx1234". - - 05 FILLER PIC X(10) VALUE "COMP-5". - 05 FILLER PIC X(40) VALUE "x12345678x12345678". - 05 FILLER PIC X(40) VALUE "x12345678xxx12345678". - 05 FILLER PIC X(40) VALUE "x12345678xxxxxxx12345678". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE "x12345678xxx12345678". - - 05 FILLER PIC X(10) VALUE "CMP-1". - 05 FILLER PIC X(40) VALUE "x1234x1234". - 05 FILLER PIC X(40) VALUE "x1234xxx1234". - 05 FILLER PIC X(40) VALUE "x1234xxx1234". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - - 05 FILLER PIC X(10) VALUE "CMP-2". - 05 FILLER PIC X(40) VALUE "x12345678x12345678". - 05 FILLER PIC X(40) VALUE "x12345678xxxxxxx12345678". - 05 FILLER PIC X(40) VALUE "x12345678xxxxxxx12345678". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE "x12345678xxx12345678". - - 01 FILLER REDEFINES TEST-CASES. - 05 FILLER OCCURS 24 TIMES. - 10 TEST-NAME PIC X(10). - 10 TEST-RESULTS. - 15 MF-64RESULT PIC X(40). - 15 IBM-64RESULT PIC X(40). - 15 C2002-64RESULT PIC X(40). - 15 MF-32RESULT PIC X(40). - 15 IBM-32RESULT PIC X(40). - 15 C2002-32RESULT PIC X(40). - 10 FILLER REDEFINES TEST-RESULTS. - 15 TEST-RESULT PIC X(40) OCCURS 6 TIMES. - - 01 TESTRECORD PIC X(40). - - 01 FILLER REDEFINES TESTRECORD. - 02 TSTREC1. - 10 FILLER PICTURE X(5). - 10 COMP-FLD1 PICTURE S9(2) COMP-4. - 10 FILLER PICTURE X(5). - - 01 FILLER REDEFINES TESTRECORD. - 02 TSTREC2. - 10 FILLER PICTURE X(5). - 10 COMP-FLD2 PICTURE S9(4) COMP-4 SYNC . - - 01 FILLER REDEFINES TESTRECORD. - 02 TSTREC3. - 10 FILLER PICTURE X(5). - 10 COMP-FLD3 PICTURE S9(6) COMP-4 SYNC. - 10 FILLER PICTURE X(5). - - 01 FILLER REDEFINES TESTRECORD. - 02 TSTRECL. - 10 FILLER PICTURE X(5). - 10 COMP-FLDL PICTURE S9(2) COMP-4 SYNC LEFT. - 10 FILLER PICTURE X(5). - - 01 FILLER REDEFINES TESTRECORD. - 02 TSTRECR. - 10 FILLER PICTURE X(5). - 10 COMP-FLDR PICTURE S9(2) COMP-4 SYNC RIGHT. - 10 FILLER PICTURE X(5). - - 01 FILLER REDEFINES TESTRECORD. - 02 TSTRECS. - 10 FILLER PICTURE X(5). - 10 FILLER OCCURS 3 TIMES. - 15 FILLER PICTURE X(2). - 15 COMP-FLDS PICTURE S9(4) COMP-4 SYNC . - 15 FILLER PICTURE X(1). - 10 FILLER PICTURE X(1). - - 01 FILLER REDEFINES TESTRECORD. - 02 TSTRECO. - 10 FILLER PICTURE X(5). - 10 FILLER OCCURS 3 TIMES. - 15 FILLER PICTURE X(2). - 15 COMP-FLDO PICTURE S9(4) COMP-4 . - 15 FILLER PICTURE X(1). - 10 FILLER PICTURE X(1). - - 01 FILLER REDEFINES TESTRECORD. - 02 TSTGRP. - 05 GRP1. - 10 FILLER PICTURE X(5). - 10 COM1-FLD1 PICTURE S9(4) SYNC COMP-4. - 10 FILLER PICTURE X(3). - 10 COM1-FLD2 PICTURE S9(6) SYNC COMP-4. - 10 FILLER PICTURE X(3). - 10 COM1-FLD3 PICTURE S9(18) SYNC COMP-4. - - 01 FILLER REDEFINES TESTRECORD. - 02 TSTGRP2 SIGN LEADING SEPARATE. - 05 GRP2-1. - 10 FILLER PICTURE X(5). - 10 COM2-FLD1 PICTURE S9(4). - 10 FILLER PICTURE X(3). - 10 COM2-FLD2 PICTURE S9(6) SIGN TRAILING SEPARATE. - 10 FILLER PICTURE X(3). - 10 COM2-FLD3 PICTURE S9(7). - - 01 FILLER REDEFINES TESTRECORD. - 02 TSTGRP3. - 05 GRP3-1. - 10 FILLER PICTURE X(5). - 10 COM3-FLD1 PICTURE S9(4) COMP-3. - 10 FILLER PICTURE X(3). - 10 COM3-FLD2 PICTURE S9(6) COMP-3. - 10 FILLER PICTURE X(3). - 05 GRP3-2. - 10 COM3-FLD3 PICTURE S9(13) COMP-3. - - 01 FILLER REDEFINES TESTRECORD. - 02 TSTGRP4. - 05 GRP4-1. - 10 FILLER PICTURE X(1). - 10 COM4-FLD1 PICTURE S9(13) COMP-4 SYNC. - 10 FILLER PICTURE X(1). - 10 COM4-FLD2 PICTURE S9(7) COMP-4 SYNC. - 10 FILLER PICTURE X(1). - 05 GRP4-2. - 10 COM4-FLD3 PICTURE S9(13) COMP-4. - 10 FILLER PICTURE X(1). - 10 COM4-FLD4 PICTURE S9(6) COMP-4. - 10 FILLER PICTURE X(1). - - 01 FILLER REDEFINES TESTRECORD. - 02 TSTGRP5. - 10 FILLER PICTURE X(1). - 10 COM5-FLD1 PICTURE S9(13) COMP-4. - 10 FILLER PICTURE X(1). - 10 COM5-FLD2 PICTURE S9(6) COMP-4. - 10 FILLER PICTURE X(1). - - 01 FILLER REDEFINES TESTRECORD. - 02 TSTGRP5S. - 10 FILLER PICTURE X(1). - 10 COM5S-FLD1 PICTURE S9(13) COMP-4 SYNC. - 10 FILLER PICTURE X(1). - 10 COM5S-FLD2 PICTURE S9(7) COMP-4 SYNC. - 10 FILLER PICTURE X(1). - - 01 FILLER REDEFINES TESTRECORD. - 02 TSTGRP6 COMP-3. - 10 FILLER PICTURE 9(1). - 10 COM6-FLD1 PICTURE S9(13). - 10 FILLER PICTURE 9(1). - 10 COM6-FLD2 PICTURE S9(6). - 10 FILLER PICTURE 9(1). - - 01 FILLER REDEFINES TESTRECORD. - 02 TSTGRP7 COMP-1. - 10 COM7-FLD1 . - 10 COM7-FLD2 . - - 01 FILLER REDEFINES TESTRECORD. - 02 TSTGRP8 COMP-2. - 10 COM8-FLD1 . - 10 COM8-FLD2 . - - 01 FILLER REDEFINES TESTRECORD. - 02 TSTGRP9. - 05 GRP9-1 SIGN LEADING SEPARATE. - 10 FILLER PICTURE X(1). - 10 COM9-FLD1 PICTURE S9(2). - 10 FILLER PICTURE X(1). - 10 COM9-FLD2 PICTURE S9(2) SIGN TRAILING SEPARATE. - 10 FILLER PICTURE X(1). - 05 GRP9-2 SIGN TRAILING SEPARATE. - 10 COM9-FLD3 PICTURE S9(2) SIGN LEADING SEPARATE. - 10 FILLER PICTURE X(1). - 10 COM9-FLD4 PICTURE S9(2). - 10 FILLER PICTURE X(1). - - 01 FILLER REDEFINES TESTRECORD. - 02 TSTGRPX. - 10 FILLER PICTURE X(1). - 10 COMX-FLD1 PICTURE X(3) COMP-X SYNC. - 10 FILLER PICTURE X(1). - 10 COMX-FLD2 PICTURE X(7) COMP-X. - 10 FILLER PICTURE X(1). - 10 COMX-FLT COMP-1 SYNC. - 10 FILLER PICTURE X(1). - 10 COMX-DBL COMP-2 SYNC. - 10 FILLER PICTURE X(1). - - 01 FILLER REDEFINES TESTRECORD. - 02 TST-BSHORT. - 10 FILLER PICTURE X(1). - 10 COMS-FLD1 BINARY-SHORT. - 10 FILLER PICTURE X(2). - 10 COMS-FLD2 BINARY-SHORT SYNC. - 10 FILLER PICTURE X(1). - - 01 FILLER REDEFINES TESTRECORD. - 02 TST-BLONG. - 10 FILLER PICTURE X(1). - 10 COML-FLD1 BINARY-LONG. - 10 FILLER PICTURE X(1). - 10 COML-FLD2 BINARY-LONG SYNC. - 10 FILLER PICTURE X(1). - - 01 FILLER REDEFINES TESTRECORD. - 02 TST-BDBL. - 10 FILLER PICTURE X(1). - 10 COMD-FLD1 BINARY-DOUBLE. - 10 FILLER PICTURE X(1). - 10 COMD-FLD2 BINARY-DOUBLE SYNC. - 10 FILLER PICTURE X(1). - - 01 FILLER REDEFINES TESTRECORD. - 02 TST-BLNG. - 10 FILLER PICTURE X(1). - 10 COMBL-FLD1 BINARY-LONG. - 10 FILLER PICTURE X(1). - 10 COMBL-FLD2 BINARY-LONG SYNC. - 10 FILLER PICTURE X(1). - - 01 FILLER REDEFINES TESTRECORD. - 02 TST-CMP5. - 10 FILLER PICTURE X(1). - 10 CMP5-FLD1 PIC 9(18) COMP-5. - 10 FILLER PICTURE X(1). - 10 CMP5-FLD2 PIC 9(18) COMP-5 SYNC. - 10 FILLER PICTURE X(1). - - 01 FILLER REDEFINES TESTRECORD. - 02 TST-CMP1. - 10 FILLER PICTURE X(1). - 10 CMP1-FLD1 COMP-1. - 10 FILLER PICTURE X(1). - 10 CMP1-FLD2 COMP-1 SYNC. - 10 FILLER PICTURE X(1). - - 01 FILLER REDEFINES TESTRECORD. - 02 TST-CMP2. - 10 FILLER PICTURE X(1). - 10 CMP2-FLD1 COMP-2. - 10 FILLER PICTURE X(1). - 10 CMP2-FLD2 COMP-2 SYNC. - 10 FILLER PICTURE X(1). - - PROCEDURE DIVISION. - - MOVE LENGTH OF TESTPTR TO VLEN. - IF VLEN EQUAL 8 - MOVE 64 TO BIT-MODE - ELSE - MOVE 32 TO BIT-MODE. - MOVE ALL "x" TO TESTRECORD. - MOVE 1 TO TESTMODE. - MOVE ALL "x" TO TSTREC2. - MOVE "22" TO COMP-FLD2 (1:). - IF TSTREC2 = 'xxxxxx22' - MOVE 3 TO TESTMODE. - MOVE "12345678" TO COML-FLD2 (1:). - IF COML-FLD2 = 875770417 - MOVE "Little-Endian" TO TESTEND - ELSE - MOVE "Big-Endian" TO TESTEND - END-IF. - MOVE LENGTH OF COMP-FLD1 TO VLEN. - IF VLEN = 2 - MOVE 2 TO TESTMODE. - MOVE ALL "x" TO TESTRECORD. - - MOVE "COMP-FLD1" TO TESTNAME. - MOVE "11" TO COMP-FLD1 (1:). - PERFORM CHECK-IT. - - MOVE "COMP-FLD2" TO TESTNAME. - MOVE "22" TO COMP-FLD2 (1:). - PERFORM CHECK-IT. - - MOVE "COMP-FLDO" TO TESTNAME. - MOVE "11" TO COMP-FLDO (1) (1:2) - MOVE "22" TO COMP-FLDO (2) (1:2) - MOVE "33" TO COMP-FLDO (3) (1:2) - PERFORM CHECK-IT. - - MOVE "COMP-FLDS" TO TESTNAME. - MOVE "11" TO COMP-FLDS (1) (1:2) - MOVE "22" TO COMP-FLDS (2) (1:2) - MOVE "33" TO COMP-FLDS (3) (1:2) - PERFORM CHECK-IT. - - MOVE "COMP-FLD3" TO TESTNAME. - MOVE "1234678" TO COMP-FLD3 (1:). - PERFORM CHECK-IT. - - MOVE "COMP-FLDL" TO TESTNAME. - MOVE "12345678" TO COMP-FLDL (1:). - PERFORM CHECK-IT. - - MOVE "COMP-FLDR" TO TESTNAME. - MOVE "12345678" TO COMP-FLDR (1:). - PERFORM CHECK-IT. - - MOVE "COM1-FLD" TO TESTNAME. - MOVE "12345678" TO COM1-FLD1 (1:). - MOVE "12345678" TO COM1-FLD2 (1:). - MOVE "12345678" TO COM1-FLD3 (1:). - PERFORM CHECK-IT. - - MOVE "COM2-FLD" TO TESTNAME. - MOVE "12345678" TO COM2-FLD1 (1:). - MOVE "12345678" TO COM2-FLD2 (1:). - MOVE "12345678" TO COM2-FLD3 (1:). - PERFORM CHECK-IT. - - MOVE "COM3-FLD" TO TESTNAME. - MOVE "12345678" TO COM3-FLD1 (1:). - MOVE "12345678" TO COM3-FLD2 (1:). - MOVE "12345678" TO COM3-FLD3 (1:). - PERFORM CHECK-IT. - - MOVE "COM4-FLD" TO TESTNAME. - MOVE "12345678" TO COM4-FLD1 (1:). - MOVE "12345678" TO COM4-FLD2 (1:). - MOVE "12345678" TO COM4-FLD3 (1:). - MOVE "12345678" TO COM4-FLD4 (1:). - PERFORM CHECK-IT. - - MOVE "NOSYNC" TO TESTNAME. - MOVE "12345678" TO COM5-FLD1 (1:). - MOVE "12345678" TO COM5-FLD2 (1:). - PERFORM CHECK-IT. - - MOVE "SYNC" TO TESTNAME. - MOVE "12345678" TO COM5S-FLD1 (1:). - MOVE "12345678" TO COM5S-FLD2 (1:). - PERFORM CHECK-IT. - - MOVE "COMP-3" TO TESTNAME. - MOVE "12345678" TO COM6-FLD1 (1:). - MOVE "12345678" TO COM6-FLD2 (1:). - PERFORM CHECK-IT. - - MOVE "COMP-1" TO TESTNAME. - MOVE "12345678" TO COM7-FLD1 (1:). - MOVE "12345678" TO COM7-FLD2 (1:). - PERFORM CHECK-IT. - - MOVE "COMP-2" TO TESTNAME. - MOVE "12345678" TO COM8-FLD1 (1:). - MOVE "12345678" TO COM8-FLD2 (1:). - PERFORM CHECK-IT. - - MOVE "SIGN L/T" TO TESTNAME. - MOVE -1 TO COM9-FLD1 . - MOVE -2 TO COM9-FLD2 . - MOVE -3 TO COM9-FLD3 . - MOVE -4 TO COM9-FLD4 . - PERFORM CHECK-IT. - - MOVE "COMP-X" TO TESTNAME. - MOVE "12345678" TO COMX-FLD1 (1:). - MOVE "12345678" TO COMX-FLD2 (1:). - MOVE "12345678" TO COMX-FLT (1:). - MOVE "12345678" TO COMX-DBL (1:). - PERFORM CHECK-IT. - - MOVE "BIN-SHORT" TO TESTNAME. - MOVE "12345678" TO COMS-FLD1 (1:). - MOVE "12345678" TO COMS-FLD2 (1:). - PERFORM CHECK-IT. - - MOVE "BIN-DBL" TO TESTNAME. - MOVE "12345678" TO COMD-FLD1 (1:). - MOVE "12345678" TO COMD-FLD2 (1:). - PERFORM CHECK-IT. - - MOVE "BIN-LNG" TO TESTNAME. - MOVE "12345678" TO COMBL-FLD1 (1:). - MOVE "12345678" TO COMBL-FLD2 (1:). - PERFORM CHECK-IT. - - MOVE "COMP-5" TO TESTNAME. - MOVE "12345678" TO CMP5-FLD1 (1:). - MOVE "12345678" TO CMP5-FLD2 (1:). - PERFORM CHECK-IT. - - MOVE "CMP-1" TO TESTNAME. - MOVE "12345678" TO CMP1-FLD1 (1:). - MOVE "12345678" TO CMP1-FLD2 (1:). - PERFORM CHECK-IT. - - MOVE "CMP-2" TO TESTNAME. - MOVE "12345678" TO CMP2-FLD1 (1:). - MOVE "12345678" TO CMP2-FLD2 (1:). - PERFORM CHECK-IT. - - DISPLAY TEST-MODE (TESTMODE) - TESTCASE " tests with " TESTFAIL " failed". - STOP RUN RETURNING 0. - - CHECK-IT SECTION. - CHECK-01. - INSPECT TESTRECORD REPLACING TRAILING 'x' BY ' '. - ADD 1 TO TESTCASE. - PERFORM VARYING TESTNUM FROM 1 BY 1 - UNTIL TEST-NAME (TESTNUM) = TESTNAME - OR TESTNUM > TESTMAX - CONTINUE - END-PERFORM. - IF TESTNUM > TESTMAX - DISPLAY TESTNAME " :NOT FOUND" - DISPLAY " : GOT: " TESTRECORD ":" - ADD 1 TO TESTFAIL - MOVE ALL "x" TO TESTRECORD - GO TO CHECK-EXIT - END-IF. - MOVE TEST-RESULT (TESTNUM, TESTMODE) TO TESTRESULT. - COMPUTE TESTIDX = TESTMODE + 3. - IF BIT-MODE = 32 - AND TEST-RESULT (TESTNUM, TESTIDX) NOT = SPACES - MOVE TEST-RESULT (TESTNUM, TESTIDX) TO TESTRESULT. - IF TESTRESULT = SPACES - MOVE TEST-RESULT (TESTNUM, 1) TO TESTRESULT. - IF TESTRESULT NOT = TESTRECORD - DISPLAY TESTNAME - " :FAILED: Mode " BIT-MODE - " " TEST-MODE (TESTMODE) - ", Case " TESTCASE ", " TESTEND - DISPLAY " : GOT: " TESTRECORD ":" - DISPLAY " :EXPECT: " TESTRESULT ":" - ADD 1 TO TESTFAIL - END-IF. - MOVE ALL "x" TO TESTRECORD. - CHECK-EXIT. - EXIT. - -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_misc.at:13038: cobc -x -std=mf -w prog.cob " -at_fn_check_prepare_trace "run_misc.at:13038" -( $at_check_trace; cobc -x -std=mf -w prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:13038" -$at_failed && at_fn_log_failure -$at_traceon; } - - -{ set +x -$as_echo "$at_srcdir/run_misc.at:13040: ./prog" -at_fn_check_prepare_trace "run_misc.at:13040" -( $at_check_trace; ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo "MF 24 tests with 00 failed -" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:13040" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_696 -#AT_START_697 -at_fn_group_banner 697 'run_misc.at:13046' \ - "default SYNC" " " 4 -at_xfail=no -( - $as_echo "697. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - CONFIGURATION SECTION. - DATA DIVISION. - FILE SECTION. - - WORKING-STORAGE SECTION. - - 77 VLEN PIC 99 VALUE 1. - 77 TESTMODE PIC 99 VALUE 1. - 77 TESTIDX PIC 99 VALUE 1. - 77 BIT-MODE PIC 99 VALUE 32. - 77 TESTNUM PIC 99 VALUE 0. - 77 TESTMAX PIC 99 VALUE 24. - 77 TESTCASE PIC 99 VALUE 0. - 77 TESTFAIL PIC 99 VALUE 0. - 77 TESTEND PIC X(15) VALUE " ". - 77 TESTNAME PIC X(10) VALUE " ". - 77 TESTRESULT PIC X(40) VALUE " ". - 77 TESTPTR USAGE POINTER. - - 01 TEST-MODES. - 05 FILLER PIC X(10) VALUE "MF". - 05 FILLER PIC X(10) VALUE "IBMCOMP". - 05 FILLER PIC X(10) VALUE "DEFAULT". - - 01 FILLER REDEFINES TEST-MODES. - 05 FILLER OCCURS 3 TIMES. - 10 TEST-MODE PIC X(10). - - 01 TEST-CASES. - 05 FILLER PIC X(10) VALUE "COMP-FLD1". - 05 FILLER PIC X(40) VALUE "xxxxx1". - 05 FILLER PIC X(40) VALUE "xxxxx11". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - - 05 FILLER PIC X(10) VALUE "COMP-FLD2". - 05 FILLER PIC X(40) VALUE "xxxxx22". - 05 FILLER PIC X(40) VALUE "xxxxxx22". - 05 FILLER PIC X(40) VALUE "xxxxxx22". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - - 05 FILLER PIC X(10) VALUE "COMP-FLDO". - 05 FILLER PIC X(40) VALUE "xxxxxxx11xxx22xxx33". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - - 05 FILLER PIC X(10) VALUE "COMP-FLDS". - 05 FILLER PIC X(40) VALUE "xxxxxxx11xxx22xxx33". - 05 FILLER PIC X(40) VALUE "xxxxxxxx11xxxx22xxxx33". - 05 FILLER PIC X(40) VALUE "xxxxxxxx11xxxx22xxxx33". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - - 05 FILLER PIC X(10) VALUE "COMP-FLD3". - 05 FILLER PIC X(40) VALUE "xxxxx123". - 05 FILLER PIC X(40) VALUE "xxxxxxxx1234". - 05 FILLER PIC X(40) VALUE "xxxxxxxx1234". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - - 05 FILLER PIC X(10) VALUE "COMP-FLDL". - 05 FILLER PIC X(40) VALUE "xxxxx1". - 05 FILLER PIC X(40) VALUE "xxxxxx12". - 05 FILLER PIC X(40) VALUE "xxxxx1". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - - 05 FILLER PIC X(10) VALUE "COMP-FLDR". - 05 FILLER PIC X(40) VALUE "xxxxx1". - 05 FILLER PIC X(40) VALUE "xxxxxx12". - 05 FILLER PIC X(40) VALUE "xxxxx1". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - - 05 FILLER PIC X(10) VALUE "COM1-FLD". - 05 FILLER PIC X(40) VALUE "xxxxx12xxx123xxx12345678". - 05 FILLER PIC X(40) VALUE "xxxxxx12xxxx1234xxxx12345678". - 05 FILLER PIC X(40) VALUE "xxxxxx12xxxx1234xxxxxxxx12345678". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE "xxxxxx12xxxx1234xxxx12345678". - - 05 FILLER PIC X(10) VALUE "COM2-FLD". - 05 FILLER PIC X(40) VALUE "xxxxx12345xxx1234567xxx12345678". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - - 05 FILLER PIC X(10) VALUE "COM3-FLD". - 05 FILLER PIC X(40) VALUE "xxxxx123xxx1234xxx1234567". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - - 05 FILLER PIC X(10) VALUE "COM4-FLD". - 05 FILLER PIC X(40) VALUE "x123456x1234x123456x123". - 05 FILLER PIC X(40) VALUE "xxxx12345678xxxx1234x12345678x1234". - 05 FILLER PIC X(40) - VALUE "xxxxxxxx12345678xxxx1234x12345678x1234". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE "xxxx12345678xxxx1234x12345678x1234". - - 05 FILLER PIC X(10) VALUE "NOSYNC". - 05 FILLER PIC X(40) VALUE "x123456x123". - 05 FILLER PIC X(40) VALUE "x12345678x1234". - 05 FILLER PIC X(40) VALUE "x12345678x1234". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - - 05 FILLER PIC X(10) VALUE "SYNC". - 05 FILLER PIC X(40) VALUE "x123456x1234". - 05 FILLER PIC X(40) VALUE "xxxx12345678xxxx1234". - 05 FILLER PIC X(40) VALUE "xxxxxxxx12345678xxxx1234". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE "xxxx12345678xxxx1234". - - 05 FILLER PIC X(10) VALUE "COMP-3". - 05 FILLER PIC X(40) VALUE "x1234567x1234". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - - 05 FILLER PIC X(10) VALUE "COMP-1". - 05 FILLER PIC X(40) VALUE "12341234". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - - 05 FILLER PIC X(10) VALUE "COMP-2". - 05 FILLER PIC X(40) VALUE "1234567812345678". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - - 05 FILLER PIC X(10) VALUE "SIGN L/T". - 05 FILLER PIC X(40) VALUE "x-01x02-x-03x04-". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - - 05 FILLER PIC X(10) VALUE "COMP-X". - 05 FILLER PIC X(40) VALUE "x123x1234567x1234x12345678". - 05 FILLER PIC X(40) VALUE "x123x1234567xxxx1234xxxx12345678". - 05 FILLER PIC X(40) VALUE "x123x1234567xxxx1234xxxx12345678". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - - 05 FILLER PIC X(10) VALUE "BIN-SHORT". - 05 FILLER PIC X(40) VALUE "x12xx12". - 05 FILLER PIC X(40) VALUE "x12xx12". - 05 FILLER PIC X(40) VALUE "x12xx12". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - - 05 FILLER PIC X(10) VALUE "BIN-DBL". - 05 FILLER PIC X(40) VALUE "x12345678x12345678". - 05 FILLER PIC X(40) VALUE "x12345678x12345678". - 05 FILLER PIC X(40) VALUE "x12345678x12345678". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE "x12345678x12345678". - - 05 FILLER PIC X(10) VALUE "BIN-LNG". - 05 FILLER PIC X(40) VALUE "x1234x1234". - 05 FILLER PIC X(40) VALUE "x1234x1234". - 05 FILLER PIC X(40) VALUE "x1234x1234". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE "x1234x1234". - - 05 FILLER PIC X(10) VALUE "COMP-5". - 05 FILLER PIC X(40) VALUE "x12345678x12345678". - 05 FILLER PIC X(40) VALUE "x12345678xxx12345678". - 05 FILLER PIC X(40) VALUE "x12345678xxxxxxx12345678". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE "x12345678xxx12345678". - - 05 FILLER PIC X(10) VALUE "CMP-1". - 05 FILLER PIC X(40) VALUE "x1234x1234". - 05 FILLER PIC X(40) VALUE "x1234xxx1234". - 05 FILLER PIC X(40) VALUE "x1234xxx1234". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - - 05 FILLER PIC X(10) VALUE "CMP-2". - 05 FILLER PIC X(40) VALUE "x12345678x12345678". - 05 FILLER PIC X(40) VALUE "x12345678xxxxxxx12345678". - 05 FILLER PIC X(40) VALUE "x12345678xxxxxxx12345678". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE "x12345678xxx12345678". - - 01 FILLER REDEFINES TEST-CASES. - 05 FILLER OCCURS 24 TIMES. - 10 TEST-NAME PIC X(10). - 10 TEST-RESULTS. - 15 MF-64RESULT PIC X(40). - 15 IBM-64RESULT PIC X(40). - 15 C2002-64RESULT PIC X(40). - 15 MF-32RESULT PIC X(40). - 15 IBM-32RESULT PIC X(40). - 15 C2002-32RESULT PIC X(40). - 10 FILLER REDEFINES TEST-RESULTS. - 15 TEST-RESULT PIC X(40) OCCURS 6 TIMES. - - 01 TESTRECORD PIC X(40). - - 01 FILLER REDEFINES TESTRECORD. - 02 TSTREC1. - 10 FILLER PICTURE X(5). - 10 COMP-FLD1 PICTURE S9(2) COMP-4. - 10 FILLER PICTURE X(5). - - 01 FILLER REDEFINES TESTRECORD. - 02 TSTREC2. - 10 FILLER PICTURE X(5). - 10 COMP-FLD2 PICTURE S9(4) COMP-4 SYNC . - - 01 FILLER REDEFINES TESTRECORD. - 02 TSTREC3. - 10 FILLER PICTURE X(5). - 10 COMP-FLD3 PICTURE S9(6) COMP-4 SYNC. - 10 FILLER PICTURE X(5). - - 01 FILLER REDEFINES TESTRECORD. - 02 TSTRECL. - 10 FILLER PICTURE X(5). - 10 COMP-FLDL PICTURE S9(2) COMP-4 SYNC LEFT. - 10 FILLER PICTURE X(5). - - 01 FILLER REDEFINES TESTRECORD. - 02 TSTRECR. - 10 FILLER PICTURE X(5). - 10 COMP-FLDR PICTURE S9(2) COMP-4 SYNC RIGHT. - 10 FILLER PICTURE X(5). - - 01 FILLER REDEFINES TESTRECORD. - 02 TSTRECS. - 10 FILLER PICTURE X(5). - 10 FILLER OCCURS 3 TIMES. - 15 FILLER PICTURE X(2). - 15 COMP-FLDS PICTURE S9(4) COMP-4 SYNC . - 15 FILLER PICTURE X(1). - 10 FILLER PICTURE X(1). - - 01 FILLER REDEFINES TESTRECORD. - 02 TSTRECO. - 10 FILLER PICTURE X(5). - 10 FILLER OCCURS 3 TIMES. - 15 FILLER PICTURE X(2). - 15 COMP-FLDO PICTURE S9(4) COMP-4 . - 15 FILLER PICTURE X(1). - 10 FILLER PICTURE X(1). - - 01 FILLER REDEFINES TESTRECORD. - 02 TSTGRP. - 05 GRP1. - 10 FILLER PICTURE X(5). - 10 COM1-FLD1 PICTURE S9(4) SYNC COMP-4. - 10 FILLER PICTURE X(3). - 10 COM1-FLD2 PICTURE S9(6) SYNC COMP-4. - 10 FILLER PICTURE X(3). - 10 COM1-FLD3 PICTURE S9(18) SYNC COMP-4. - - 01 FILLER REDEFINES TESTRECORD. - 02 TSTGRP2 SIGN LEADING SEPARATE. - 05 GRP2-1. - 10 FILLER PICTURE X(5). - 10 COM2-FLD1 PICTURE S9(4). - 10 FILLER PICTURE X(3). - 10 COM2-FLD2 PICTURE S9(6) SIGN TRAILING SEPARATE. - 10 FILLER PICTURE X(3). - 10 COM2-FLD3 PICTURE S9(7). - - 01 FILLER REDEFINES TESTRECORD. - 02 TSTGRP3. - 05 GRP3-1. - 10 FILLER PICTURE X(5). - 10 COM3-FLD1 PICTURE S9(4) COMP-3. - 10 FILLER PICTURE X(3). - 10 COM3-FLD2 PICTURE S9(6) COMP-3. - 10 FILLER PICTURE X(3). - 05 GRP3-2. - 10 COM3-FLD3 PICTURE S9(13) COMP-3. - - 01 FILLER REDEFINES TESTRECORD. - 02 TSTGRP4. - 05 GRP4-1. - 10 FILLER PICTURE X(1). - 10 COM4-FLD1 PICTURE S9(13) COMP-4 SYNC. - 10 FILLER PICTURE X(1). - 10 COM4-FLD2 PICTURE S9(7) COMP-4 SYNC. - 10 FILLER PICTURE X(1). - 05 GRP4-2. - 10 COM4-FLD3 PICTURE S9(13) COMP-4. - 10 FILLER PICTURE X(1). - 10 COM4-FLD4 PICTURE S9(6) COMP-4. - 10 FILLER PICTURE X(1). - - 01 FILLER REDEFINES TESTRECORD. - 02 TSTGRP5. - 10 FILLER PICTURE X(1). - 10 COM5-FLD1 PICTURE S9(13) COMP-4. - 10 FILLER PICTURE X(1). - 10 COM5-FLD2 PICTURE S9(6) COMP-4. - 10 FILLER PICTURE X(1). - - 01 FILLER REDEFINES TESTRECORD. - 02 TSTGRP5S. - 10 FILLER PICTURE X(1). - 10 COM5S-FLD1 PICTURE S9(13) COMP-4 SYNC. - 10 FILLER PICTURE X(1). - 10 COM5S-FLD2 PICTURE S9(7) COMP-4 SYNC. - 10 FILLER PICTURE X(1). - - 01 FILLER REDEFINES TESTRECORD. - 02 TSTGRP6 COMP-3. - 10 FILLER PICTURE 9(1). - 10 COM6-FLD1 PICTURE S9(13). - 10 FILLER PICTURE 9(1). - 10 COM6-FLD2 PICTURE S9(6). - 10 FILLER PICTURE 9(1). - - 01 FILLER REDEFINES TESTRECORD. - 02 TSTGRP7 COMP-1. - 10 COM7-FLD1 . - 10 COM7-FLD2 . - - 01 FILLER REDEFINES TESTRECORD. - 02 TSTGRP8 COMP-2. - 10 COM8-FLD1 . - 10 COM8-FLD2 . - - 01 FILLER REDEFINES TESTRECORD. - 02 TSTGRP9. - 05 GRP9-1 SIGN LEADING SEPARATE. - 10 FILLER PICTURE X(1). - 10 COM9-FLD1 PICTURE S9(2). - 10 FILLER PICTURE X(1). - 10 COM9-FLD2 PICTURE S9(2) SIGN TRAILING SEPARATE. - 10 FILLER PICTURE X(1). - 05 GRP9-2 SIGN TRAILING SEPARATE. - 10 COM9-FLD3 PICTURE S9(2) SIGN LEADING SEPARATE. - 10 FILLER PICTURE X(1). - 10 COM9-FLD4 PICTURE S9(2). - 10 FILLER PICTURE X(1). - - 01 FILLER REDEFINES TESTRECORD. - 02 TSTGRPX. - 10 FILLER PICTURE X(1). - 10 COMX-FLD1 PICTURE X(3) COMP-X SYNC. - 10 FILLER PICTURE X(1). - 10 COMX-FLD2 PICTURE X(7) COMP-X. - 10 FILLER PICTURE X(1). - 10 COMX-FLT COMP-1 SYNC. - 10 FILLER PICTURE X(1). - 10 COMX-DBL COMP-2 SYNC. - 10 FILLER PICTURE X(1). - - 01 FILLER REDEFINES TESTRECORD. - 02 TST-BSHORT. - 10 FILLER PICTURE X(1). - 10 COMS-FLD1 BINARY-SHORT. - 10 FILLER PICTURE X(2). - 10 COMS-FLD2 BINARY-SHORT SYNC. - 10 FILLER PICTURE X(1). - - 01 FILLER REDEFINES TESTRECORD. - 02 TST-BLONG. - 10 FILLER PICTURE X(1). - 10 COML-FLD1 BINARY-LONG. - 10 FILLER PICTURE X(1). - 10 COML-FLD2 BINARY-LONG SYNC. - 10 FILLER PICTURE X(1). - - 01 FILLER REDEFINES TESTRECORD. - 02 TST-BDBL. - 10 FILLER PICTURE X(1). - 10 COMD-FLD1 BINARY-DOUBLE. - 10 FILLER PICTURE X(1). - 10 COMD-FLD2 BINARY-DOUBLE SYNC. - 10 FILLER PICTURE X(1). - - 01 FILLER REDEFINES TESTRECORD. - 02 TST-BLNG. - 10 FILLER PICTURE X(1). - 10 COMBL-FLD1 BINARY-LONG. - 10 FILLER PICTURE X(1). - 10 COMBL-FLD2 BINARY-LONG SYNC. - 10 FILLER PICTURE X(1). - - 01 FILLER REDEFINES TESTRECORD. - 02 TST-CMP5. - 10 FILLER PICTURE X(1). - 10 CMP5-FLD1 PIC 9(18) COMP-5. - 10 FILLER PICTURE X(1). - 10 CMP5-FLD2 PIC 9(18) COMP-5 SYNC. - 10 FILLER PICTURE X(1). - - 01 FILLER REDEFINES TESTRECORD. - 02 TST-CMP1. - 10 FILLER PICTURE X(1). - 10 CMP1-FLD1 COMP-1. - 10 FILLER PICTURE X(1). - 10 CMP1-FLD2 COMP-1 SYNC. - 10 FILLER PICTURE X(1). - - 01 FILLER REDEFINES TESTRECORD. - 02 TST-CMP2. - 10 FILLER PICTURE X(1). - 10 CMP2-FLD1 COMP-2. - 10 FILLER PICTURE X(1). - 10 CMP2-FLD2 COMP-2 SYNC. - 10 FILLER PICTURE X(1). - - PROCEDURE DIVISION. - - MOVE LENGTH OF TESTPTR TO VLEN. - IF VLEN EQUAL 8 - MOVE 64 TO BIT-MODE - ELSE - MOVE 32 TO BIT-MODE. - MOVE ALL "x" TO TESTRECORD. - MOVE 1 TO TESTMODE. - MOVE ALL "x" TO TSTREC2. - MOVE "22" TO COMP-FLD2 (1:). - IF TSTREC2 = 'xxxxxx22' - MOVE 3 TO TESTMODE. - MOVE "12345678" TO COML-FLD2 (1:). - IF COML-FLD2 = 875770417 - MOVE "Little-Endian" TO TESTEND - ELSE - MOVE "Big-Endian" TO TESTEND - END-IF. - MOVE LENGTH OF COMP-FLD1 TO VLEN. - IF VLEN = 2 - MOVE 2 TO TESTMODE. - MOVE ALL "x" TO TESTRECORD. - - MOVE "COMP-FLD1" TO TESTNAME. - MOVE "11" TO COMP-FLD1 (1:). - PERFORM CHECK-IT. - - MOVE "COMP-FLD2" TO TESTNAME. - MOVE "22" TO COMP-FLD2 (1:). - PERFORM CHECK-IT. - - MOVE "COMP-FLDO" TO TESTNAME. - MOVE "11" TO COMP-FLDO (1) (1:2) - MOVE "22" TO COMP-FLDO (2) (1:2) - MOVE "33" TO COMP-FLDO (3) (1:2) - PERFORM CHECK-IT. - - MOVE "COMP-FLDS" TO TESTNAME. - MOVE "11" TO COMP-FLDS (1) (1:2) - MOVE "22" TO COMP-FLDS (2) (1:2) - MOVE "33" TO COMP-FLDS (3) (1:2) - PERFORM CHECK-IT. - - MOVE "COMP-FLD3" TO TESTNAME. - MOVE "1234678" TO COMP-FLD3 (1:). - PERFORM CHECK-IT. - - MOVE "COMP-FLDL" TO TESTNAME. - MOVE "12345678" TO COMP-FLDL (1:). - PERFORM CHECK-IT. - - MOVE "COMP-FLDR" TO TESTNAME. - MOVE "12345678" TO COMP-FLDR (1:). - PERFORM CHECK-IT. - - MOVE "COM1-FLD" TO TESTNAME. - MOVE "12345678" TO COM1-FLD1 (1:). - MOVE "12345678" TO COM1-FLD2 (1:). - MOVE "12345678" TO COM1-FLD3 (1:). - PERFORM CHECK-IT. - - MOVE "COM2-FLD" TO TESTNAME. - MOVE "12345678" TO COM2-FLD1 (1:). - MOVE "12345678" TO COM2-FLD2 (1:). - MOVE "12345678" TO COM2-FLD3 (1:). - PERFORM CHECK-IT. - - MOVE "COM3-FLD" TO TESTNAME. - MOVE "12345678" TO COM3-FLD1 (1:). - MOVE "12345678" TO COM3-FLD2 (1:). - MOVE "12345678" TO COM3-FLD3 (1:). - PERFORM CHECK-IT. - - MOVE "COM4-FLD" TO TESTNAME. - MOVE "12345678" TO COM4-FLD1 (1:). - MOVE "12345678" TO COM4-FLD2 (1:). - MOVE "12345678" TO COM4-FLD3 (1:). - MOVE "12345678" TO COM4-FLD4 (1:). - PERFORM CHECK-IT. - - MOVE "NOSYNC" TO TESTNAME. - MOVE "12345678" TO COM5-FLD1 (1:). - MOVE "12345678" TO COM5-FLD2 (1:). - PERFORM CHECK-IT. - - MOVE "SYNC" TO TESTNAME. - MOVE "12345678" TO COM5S-FLD1 (1:). - MOVE "12345678" TO COM5S-FLD2 (1:). - PERFORM CHECK-IT. - - MOVE "COMP-3" TO TESTNAME. - MOVE "12345678" TO COM6-FLD1 (1:). - MOVE "12345678" TO COM6-FLD2 (1:). - PERFORM CHECK-IT. - - MOVE "COMP-1" TO TESTNAME. - MOVE "12345678" TO COM7-FLD1 (1:). - MOVE "12345678" TO COM7-FLD2 (1:). - PERFORM CHECK-IT. - - MOVE "COMP-2" TO TESTNAME. - MOVE "12345678" TO COM8-FLD1 (1:). - MOVE "12345678" TO COM8-FLD2 (1:). - PERFORM CHECK-IT. - - MOVE "SIGN L/T" TO TESTNAME. - MOVE -1 TO COM9-FLD1 . - MOVE -2 TO COM9-FLD2 . - MOVE -3 TO COM9-FLD3 . - MOVE -4 TO COM9-FLD4 . - PERFORM CHECK-IT. - - MOVE "COMP-X" TO TESTNAME. - MOVE "12345678" TO COMX-FLD1 (1:). - MOVE "12345678" TO COMX-FLD2 (1:). - MOVE "12345678" TO COMX-FLT (1:). - MOVE "12345678" TO COMX-DBL (1:). - PERFORM CHECK-IT. - - MOVE "BIN-SHORT" TO TESTNAME. - MOVE "12345678" TO COMS-FLD1 (1:). - MOVE "12345678" TO COMS-FLD2 (1:). - PERFORM CHECK-IT. - - MOVE "BIN-DBL" TO TESTNAME. - MOVE "12345678" TO COMD-FLD1 (1:). - MOVE "12345678" TO COMD-FLD2 (1:). - PERFORM CHECK-IT. - - MOVE "BIN-LNG" TO TESTNAME. - MOVE "12345678" TO COMBL-FLD1 (1:). - MOVE "12345678" TO COMBL-FLD2 (1:). - PERFORM CHECK-IT. - - MOVE "COMP-5" TO TESTNAME. - MOVE "12345678" TO CMP5-FLD1 (1:). - MOVE "12345678" TO CMP5-FLD2 (1:). - PERFORM CHECK-IT. - - MOVE "CMP-1" TO TESTNAME. - MOVE "12345678" TO CMP1-FLD1 (1:). - MOVE "12345678" TO CMP1-FLD2 (1:). - PERFORM CHECK-IT. - - MOVE "CMP-2" TO TESTNAME. - MOVE "12345678" TO CMP2-FLD1 (1:). - MOVE "12345678" TO CMP2-FLD2 (1:). - PERFORM CHECK-IT. - - DISPLAY TEST-MODE (TESTMODE) - TESTCASE " tests with " TESTFAIL " failed". - STOP RUN RETURNING 0. - - CHECK-IT SECTION. - CHECK-01. - INSPECT TESTRECORD REPLACING TRAILING 'x' BY ' '. - ADD 1 TO TESTCASE. - PERFORM VARYING TESTNUM FROM 1 BY 1 - UNTIL TEST-NAME (TESTNUM) = TESTNAME - OR TESTNUM > TESTMAX - CONTINUE - END-PERFORM. - IF TESTNUM > TESTMAX - DISPLAY TESTNAME " :NOT FOUND" - DISPLAY " : GOT: " TESTRECORD ":" - ADD 1 TO TESTFAIL - MOVE ALL "x" TO TESTRECORD - GO TO CHECK-EXIT - END-IF. - MOVE TEST-RESULT (TESTNUM, TESTMODE) TO TESTRESULT. - COMPUTE TESTIDX = TESTMODE + 3. - IF BIT-MODE = 32 - AND TEST-RESULT (TESTNUM, TESTIDX) NOT = SPACES - MOVE TEST-RESULT (TESTNUM, TESTIDX) TO TESTRESULT. - IF TESTRESULT = SPACES - MOVE TEST-RESULT (TESTNUM, 1) TO TESTRESULT. - IF TESTRESULT NOT = TESTRECORD - DISPLAY TESTNAME - " :FAILED: Mode " BIT-MODE - " " TEST-MODE (TESTMODE) - ", Case " TESTCASE ", " TESTEND - DISPLAY " : GOT: " TESTRECORD ":" - DISPLAY " :EXPECT: " TESTRESULT ":" - ADD 1 TO TESTFAIL - END-IF. - MOVE ALL "x" TO TESTRECORD. - CHECK-EXIT. - EXIT. - -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_misc.at:13690: cobc -x -std=default -w prog.cob " -at_fn_check_prepare_trace "run_misc.at:13690" -( $at_check_trace; cobc -x -std=default -w prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:13690" -$at_failed && at_fn_log_failure -$at_traceon; } - - -{ set +x -$as_echo "$at_srcdir/run_misc.at:13692: ./prog" -at_fn_check_prepare_trace "run_misc.at:13692" -( $at_check_trace; ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo "DEFAULT 24 tests with 00 failed -" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:13692" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_697 -#AT_START_698 -at_fn_group_banner 698 'run_misc.at:13697' \ - "Group Usage 1" " " 4 -at_xfail=no -( - $as_echo "698. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - CONFIGURATION SECTION. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 TESTRECORD. - 02 TSTGRP3 COMP-4. - 05 GRP3-1. - 10 FILLER PICTURE X(1). - 10 COM3-FLD1 PICTURE S9(3). - 10 FILLER PICTURE X(3). - 10 COM3-FLD2 PICTURE S9(6). - 05 GRP3-2 SYNC. - 10 FILLER PICTURE X(1). - 10 COM3-FLD3 PICTURE S9(5). - 10 FILLER PICTURE X. - - PROCEDURE DIVISION. - - MOVE ALL 'x' TO TESTRECORD. - MOVE "12345678" TO COM3-FLD1 (1:). - MOVE "12345678" TO COM3-FLD2 (1:). - MOVE "12345678" TO COM3-FLD3 (1:). - DISPLAY TESTRECORD. - STOP RUN. - - -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_misc.at:13731: cobc -x -std=mf -w prog.cob " -at_fn_check_prepare_trace "run_misc.at:13731" -( $at_check_trace; cobc -x -std=mf -w prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:13731" -$at_failed && at_fn_log_failure -$at_traceon; } - - -{ set +x -$as_echo "$at_srcdir/run_misc.at:13733: ./prog" -at_fn_check_prepare_trace "run_misc.at:13733" -( $at_check_trace; ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo "x12xxx123x123x -" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:13733" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_698 -#AT_START_699 -at_fn_group_banner 699 'run_misc.at:13739' \ - "Group Usage 2" " " 4 -at_xfail=no -( - $as_echo "699. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - CONFIGURATION SECTION. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 TESTRECORD. - 02 TSTGRP3 COMP-4. - 05 GRP3-1. - 10 FILLER PICTURE X(1). - 10 COM3-FLD1 PICTURE S9(3). - 10 FILLER PICTURE X(3). - 10 COM3-FLD2 PICTURE S9(6). - 05 GRP3-2 SYNC. - 10 FILLER PICTURE X(1). - 10 COM3-FLD3 PICTURE S9(5). - 10 FILLER PICTURE X. - - PROCEDURE DIVISION. - - MOVE ALL 'x' TO TESTRECORD. - MOVE "12345678" TO COM3-FLD1 (1:). - MOVE "12345678" TO COM3-FLD2 (1:). - MOVE "12345678" TO COM3-FLD3 (1:). - DISPLAY TESTRECORD. - STOP RUN. - - -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_misc.at:13773: cobc -x -std=mf -w -fibmcomp prog.cob " -at_fn_check_prepare_trace "run_misc.at:13773" -( $at_check_trace; cobc -x -std=mf -w -fibmcomp prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:13773" -$at_failed && at_fn_log_failure -$at_traceon; } - - -{ set +x -$as_echo "$at_srcdir/run_misc.at:13775: ./prog" -at_fn_check_prepare_trace "run_misc.at:13775" -( $at_check_trace; ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo "x12xxx1234xx1234x -" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:13775" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_699 -#AT_START_700 -at_fn_group_banner 700 'run_misc.at:13780' \ - "MF COMP-5 noibmcomp" " " 4 -at_xfail=no -( - $as_echo "700. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - DATA DIVISION. - WORKING-STORAGE SECTION. - 77 CMP4 PIC 99 COMP-4. - 77 CMP5 PIC 99 COMP-5. - 77 CMP4-4 PIC 9(4) COMP-4. - 77 CMP5-4 PIC 9(4) COMP-5. - PROCEDURE DIVISION. - DISPLAY 'LEN PIC 99 COMP-5 is ' LENGTH OF CMP5 " :". - DISPLAY 'LEN PIC 99 COMP-4 is ' LENGTH OF CMP4 " :". - DISPLAY 'LEN PIC 9(4) COMP-5 is ' LENGTH OF CMP5-4 " :". - DISPLAY 'LEN PIC 9(4) COMP-4 is ' LENGTH OF CMP4-4 " :". - STOP RUN RETURNING 0. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_misc.at:13801: cobc -x -std=mf -w prog.cob " -at_fn_check_prepare_trace "run_misc.at:13801" -( $at_check_trace; cobc -x -std=mf -w prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:13801" -$at_failed && at_fn_log_failure -$at_traceon; } - - -{ set +x -$as_echo "$at_srcdir/run_misc.at:13803: ./prog" -at_fn_check_prepare_trace "run_misc.at:13803" -( $at_check_trace; ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo "LEN PIC 99 COMP-5 is 1 : -LEN PIC 99 COMP-4 is 1 : -LEN PIC 9(4) COMP-5 is 2 : -LEN PIC 9(4) COMP-4 is 2 : -" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:13803" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_700 -#AT_START_701 -at_fn_group_banner 701 'run_misc.at:13812' \ - "MF COMP-5" " " 4 -at_xfail=no -( - $as_echo "701. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - DATA DIVISION. - WORKING-STORAGE SECTION. - 77 CMP4 PIC 99 COMP-4. - 77 CMP5 PIC 99 COMP-5. - 77 CMP4-4 PIC 9(4) COMP-4. - 77 CMP5-4 PIC 9(4) COMP-5. - PROCEDURE DIVISION. - DISPLAY 'LEN PIC 99 COMP-5 is ' LENGTH OF CMP5 " :". - DISPLAY 'LEN PIC 99 COMP-4 is ' LENGTH OF CMP4 " :". - DISPLAY 'LEN PIC 9(4) COMP-5 is ' LENGTH OF CMP5-4 " :". - DISPLAY 'LEN PIC 9(4) COMP-4 is ' LENGTH OF CMP4-4 " :". - STOP RUN RETURNING 0. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_misc.at:13833: cobc -x -std=mf -w -fibmcomp prog.cob " -at_fn_check_prepare_trace "run_misc.at:13833" -( $at_check_trace; cobc -x -std=mf -w -fibmcomp prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:13833" -$at_failed && at_fn_log_failure -$at_traceon; } - - -{ set +x -$as_echo "$at_srcdir/run_misc.at:13835: ./prog" -at_fn_check_prepare_trace "run_misc.at:13835" -( $at_check_trace; ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo "LEN PIC 99 COMP-5 is 2 : -LEN PIC 99 COMP-4 is 2 : -LEN PIC 9(4) COMP-5 is 2 : -LEN PIC 9(4) COMP-4 is 2 : -" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:13835" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_701 -#AT_START_702 -at_fn_group_banner 702 'run_misc.at:13844' \ - "Test HEX String" " " 4 -at_xfail=no -( - $as_echo "702. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 var9 PIC 9(5). - 01 varb PIC 9(4) COMP-4. - 01 varx REDEFINES varb PIC XX. - 88 MAXVAL VALUE X"7FFF". - - PROCEDURE DIVISION. - - SET MAXVAL TO TRUE. - MOVE varb TO var9. - DISPLAY varb " vs " var9. - MOVE HIGH-VALUES TO varx. - MOVE varb TO var9. - DISPLAY varb " vs " var9. - - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_misc.at:13869: cobc -x -std=mf -w prog.cob " -at_fn_check_prepare_trace "run_misc.at:13869" -( $at_check_trace; cobc -x -std=mf -w prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:13869" -$at_failed && at_fn_log_failure -$at_traceon; } - - -{ set +x -$as_echo "$at_srcdir/run_misc.at:13871: ./prog" -at_fn_check_prepare_trace "run_misc.at:13871" -( $at_check_trace; ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo "2767 vs 32767 -5535 vs 65535 -" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:13871" -$at_failed && at_fn_log_failure -$at_traceon; } - - -{ set +x -$as_echo "$at_srcdir/run_misc.at:13875: cobc -x -std=mf -fnotrunc -w prog.cob " -at_fn_check_prepare_trace "run_misc.at:13875" -( $at_check_trace; cobc -x -std=mf -fnotrunc -w prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:13875" -$at_failed && at_fn_log_failure -$at_traceon; } - - -{ set +x -$as_echo "$at_srcdir/run_misc.at:13877: ./prog" -at_fn_check_prepare_trace "run_misc.at:13877" -( $at_check_trace; ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo "32767 vs 32767 -65535 vs 65535 -" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_misc.at:13877" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_702 -#AT_START_703 -at_fn_group_banner 703 'run_file.at:23' \ - "READ INTO data item AT-END sequence" " " 4 -at_xfail=no -( - $as_echo "703. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - INPUT-OUTPUT SECTION. - FILE-CONTROL. - SELECT TEST-FILE ASSIGN "./TEST-FILE". - DATA DIVISION. - FILE SECTION. - FD TEST-FILE. - 01 TEST-REC PIC X(10). - WORKING-STORAGE SECTION. - 01 X PIC X(10). - PROCEDURE DIVISION. - OPEN OUTPUT TEST-FILE. - CLOSE TEST-FILE. - OPEN INPUT TEST-FILE. - READ TEST-FILE INTO X - AT END MOVE ALL ZERO TO X - END-READ. - CLOSE TEST-FILE. - IF X NOT = "0000000000" - DISPLAY "Expected zeros - Got " X - END-DISPLAY - END-IF. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_file.at:54: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_file.at:54" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_file.at:54" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_file.at:55: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_file.at:55" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_file.at:55" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_703 -#AT_START_704 -at_fn_group_banner 704 'run_file.at:60' \ - "LINAGE and LINAGE-COUNTER sample" " " 4 -at_xfail=no -( - $as_echo "704. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -# modified version of GC-FAQ: Example of LINAGE File Descriptor -# Author: Brian Tiffin, Date: 10-July-2008 - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - INPUT-OUTPUT SECTION. - FILE-CONTROL. - select optional data-file assign to 'prog.cob' - organization is line sequential - file status is data-file-status. - select mini-report assign to "mini-report". - - DATA DIVISION. - FILE SECTION. - FD data-file. - 01 data-record. - 88 endofdata value high-values. - 02 data-line pic x(80). - FD mini-report - linage is 16 lines - with footing at 15 - lines at top 2 - lines at bottom 2. - 01 report-line pic x(80). - - WORKING-STORAGE SECTION. - 01 command-arguments pic x(1024). - 01 file-name pic x(160). - 01 data-file-status pic xx. - 01 lc pic 99. - 01 report-line-blank. - 02 filler pic x(18) value all "*". - 02 filler pic x(05) value spaces. - 02 filler pic x(34) - VALUE "THIS PAGE INTENTIONALLY LEFT BLANK". - 02 filler pic x(05) value spaces. - 02 filler pic x(18) value all "*". - 01 report-line-data. - 02 body-tag pic 9(6). - 02 line-3 pic x(74). - 01 report-line-header. - 02 filler pic x(6) VALUE "PAGE: ". - 02 page-no pic 9999. - 02 filler pic x(24). - 02 filler pic x(5) VALUE " LC: ". - 02 header-tag pic 9(6). - 02 filler pic x(23). - 02 filler pic x(6) VALUE "DATE: ". - 02 page-date pic x(6). - - 01 page-count pic 9999. - - PROCEDURE DIVISION. - - open input data-file. - read data-file - at end - display "File open error: " data-file-status - stop run - end-read. - - open output mini-report. - - write report-line - from report-line-blank - end-write. - - move 1 to page-count. - accept page-date from date end-accept. - move page-count to page-no. - write report-line - from report-line-header - after advancing page - end-write. - - perform readwrite-loop until endofdata. - - display - "Normal termination, ending status: " - data-file-status - close mini-report. - - close data-file. - stop run. - - **************************************************************** - readwrite-loop. - move data-record to report-line-data - move linage-counter to body-tag - write report-line from report-line-data - end-of-page - add 1 to page-count end-add - move page-count to page-no - move linage-counter to header-tag - write report-line from report-line-header - after advancing page - end-write - end-write - read data-file - at end set endofdata to true - end-read - . -_ATEOF - - - -cat >reference-report <<'_ATEOF' - - -****************** THIS PAGE INTENTIONALLY LEFT BLANK ****************** - - - - - - - - - - - - - - - - - - -PAGE: 0001 LC: 000000 DATE: 150206 -000001 -000002 IDENTIFICATION DIVISION. -000003 PROGRAM-ID. prog. -000004 ENVIRONMENT DIVISION. -000005 INPUT-OUTPUT SECTION. -000006 FILE-CONTROL. -000007 select optional data-file assign to 'prog.cob' -000008 organization is line sequential -000009 file status is data-file-status. -000010 select mini-report assign to "mini-report". -000011 -000012 DATA DIVISION. -000013 FILE SECTION. -000014 FD data-file. - - - - - -PAGE: 0002 LC: 000015 DATE: 150206 -000001 01 data-record. -000002 88 endofdata value high-values. -000003 02 data-line pic x(80). -000004 FD mini-report -000005 linage is 16 lines -000006 with footing at 15 -000007 lines at top 2 -000008 lines at bottom 2. -000009 01 report-line pic x(80). -000010 -000011 WORKING-STORAGE SECTION. -000012 01 command-arguments pic x(1024). -000013 01 file-name pic x(160). -000014 01 data-file-status pic xx. - - - - - -PAGE: 0003 LC: 000015 DATE: 150206 -000001 01 lc pic 99. -000002 01 report-line-blank. -000003 02 filler pic x(18) value all "*". -000004 02 filler pic x(05) value spaces. -000005 02 filler pic x(34) -000006 VALUE "THIS PAGE INTENTIONALLY LEFT BLANK". -000007 02 filler pic x(05) value spaces. -000008 02 filler pic x(18) value all "*". -000009 01 report-line-data. -000010 02 body-tag pic 9(6). -000011 02 line-3 pic x(74). -000012 01 report-line-header. -000013 02 filler pic x(6) VALUE "PAGE: ". -000014 02 page-no pic 9999. - - - - - -PAGE: 0004 LC: 000015 DATE: 150206 -000001 02 filler pic x(24). -000002 02 filler pic x(5) VALUE " LC: ". -000003 02 header-tag pic 9(6). -000004 02 filler pic x(23). -000005 02 filler pic x(6) VALUE "DATE: ". -000006 02 page-date pic x(6). -000007 -000008 01 page-count pic 9999. -000009 -000010 PROCEDURE DIVISION. -000011 -000012 open input data-file. -000013 read data-file -000014 at end - - - - - -PAGE: 0005 LC: 000015 DATE: 150206 -000001 display "File open error: " data-file-status -000002 stop run -000003 end-read. -000004 -000005 open output mini-report. -000006 -000007 write report-line -000008 from report-line-blank -000009 end-write. -000010 -000011 move 1 to page-count. -000012 accept page-date from date end-accept. -000013 move page-count to page-no. -000014 write report-line - - - - - -PAGE: 0006 LC: 000015 DATE: 150206 -000001 from report-line-header -000002 after advancing page -000003 end-write. -000004 -000005 perform readwrite-loop until endofdata. -000006 -000007 display -000008 "Normal termination, ending status: " -000009 data-file-status -000010 close mini-report. -000011 -000012 close data-file. -000013 stop run. -000014 - - - - - -PAGE: 0007 LC: 000015 DATE: 150206 -000001**************************************************************** -000002 readwrite-loop. -000003 move data-record to report-line-data -000004 move linage-counter to body-tag -000005 write report-line from report-line-data -000006 end-of-page -000007 add 1 to page-count end-add -000008 move page-count to page-no -000009 move linage-counter to header-tag -000010 write report-line from report-line-header -000011 after advancing page -000012 end-write -000013 end-write -000014 read data-file - - - - - -PAGE: 0008 LC: 000015 DATE: 150206 -000001 at end set endofdata to true -000002 end-read -000003 . -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_file.at:337: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_file.at:337" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_file.at:337" -$at_failed && at_fn_log_failure \ -"mini-report" -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_file.at:338: COB_CURRENT_DATE=\"2015/02/06 16:40:52\" \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "COB_CURRENT_DATE=\"2015/02/06 16:40:52\" $COBCRUN_DIRECT ./prog" "run_file.at:338" -( $at_check_trace; COB_CURRENT_DATE="2015/02/06 16:40:52" $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo "Normal termination, ending status: 10 -" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_file.at:338" -$at_failed && at_fn_log_failure \ -"mini-report" -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_file.at:341: diff mini-report reference-report" -at_fn_check_prepare_trace "run_file.at:341" -( $at_check_trace; diff mini-report reference-report -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_file.at:341" -$at_failed && at_fn_log_failure \ -"mini-report" -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_704 -#AT_START_705 -at_fn_group_banner 705 'run_file.at:346' \ - "OUTPUT on INDEXED file to missing directory" " " 4 -at_xfail=no -( - $as_echo "705. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -$as_echo "run_file.at:349" >"$at_check_line_file" -(test "$COB_HAS_ISAM" = "no") \ - && at_fn_check_skip 77 "$at_srcdir/run_file.at:349" - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - CONFIGURATION SECTION. - INPUT-OUTPUT SECTION. - FILE-CONTROL. - SELECT FILE0 ASSIGN TO "./nosubhere/MYFILE0" - ORGANIZATION IS INDEXED - RECORD KEY IS F0REC - FILE STATUS IS WSFS. - DATA DIVISION. - FILE SECTION. - FD FILE0. - 01 F0REC PIC X(80). - WORKING-STORAGE SECTION. - 01 WSFS PIC X(2). - PROCEDURE DIVISION. - * - OPEN OUTPUT FILE0 - DISPLAY "STATUS OPENO " WSFS - * - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_file.at:376: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_file.at:376" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_file.at:376" -$at_failed && at_fn_log_failure -$at_traceon; } - - -{ set +x -$as_echo "$at_srcdir/run_file.at:378: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_file.at:378" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo "STATUS OPENO 35 -" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_file.at:378" -$at_failed && at_fn_log_failure -$at_traceon; } - - -{ set +x -$as_echo "$at_srcdir/run_file.at:382: echo Test > ./nosubhere" -at_fn_check_prepare_trace "run_file.at:382" -( $at_check_trace; echo Test > ./nosubhere -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_file.at:382" -$at_failed && at_fn_log_failure -$at_traceon; } - - -{ set +x -$as_echo "$at_srcdir/run_file.at:384: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_file.at:384" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo "STATUS OPENO 30 -" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_file.at:384" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_705 -#AT_START_706 -at_fn_group_banner 706 'run_file.at:391' \ - "First READ on empty SEQUENTIAL INDEXED file" " " 4 -at_xfail=no -( - $as_echo "706. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -$as_echo "run_file.at:394" >"$at_check_line_file" -(test "$COB_HAS_ISAM" = "no") \ - && at_fn_check_skip 77 "$at_srcdir/run_file.at:394" - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - INPUT-OUTPUT SECTION. - FILE-CONTROL. - SELECT TEST-FILE ASSIGN "./TEST-FILE" - ORGANIZATION IS INDEXED - ACCESS MODE IS SEQUENTIAL - RECORD KEY IS TEST-KEY. - DATA DIVISION. - FILE SECTION. - FD TEST-FILE. - 01 TEST-KEY PIC X(10). - PROCEDURE DIVISION. - OPEN OUTPUT TEST-FILE. - CLOSE TEST-FILE. - OPEN INPUT TEST-FILE. - READ TEST-FILE - AT END - CONTINUE - NOT AT END - DISPLAY "NOT OK" - END-DISPLAY - END-READ. - CLOSE TEST-FILE. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_file.at:425: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_file.at:425" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_file.at:425" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_file.at:426: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_file.at:426" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_file.at:426" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_706 -#AT_START_707 -at_fn_group_banner 707 'run_file.at:431' \ - "READ NEXT without previous START" " " 4 -at_xfail=no -( - $as_echo "707. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -$as_echo "run_file.at:434" >"$at_check_line_file" -(test "$COB_HAS_ISAM" = "no") \ - && at_fn_check_skip 77 "$at_srcdir/run_file.at:434" - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - INPUT-OUTPUT SECTION. - FILE-CONTROL. - SELECT TEST-FILE ASSIGN "./TEST-FILE" - ORGANIZATION IS INDEXED - ACCESS MODE IS SEQUENTIAL - RECORD KEY IS TEST-KEY. - DATA DIVISION. - FILE SECTION. - FD TEST-FILE. - 01 TEST-REC. - 05 TEST-KEY PIC X(10). - 05 TEST-DATA PIC X. - PROCEDURE DIVISION. - OPEN OUTPUT TEST-FILE - MOVE '1' TO TEST-KEY - MOVE 'A' TO TEST-DATA - WRITE TEST-REC - MOVE '3' TO TEST-KEY - MOVE 'B' TO TEST-DATA - WRITE TEST-REC - CLOSE TEST-FILE - OPEN INPUT TEST-FILE - READ TEST-FILE NEXT - AT END - DISPLAY "AT END FOR REC1" - END-DISPLAY - CLOSE TEST-FILE - STOP RUN - NOT AT END - CONTINUE - END-READ - IF TEST-DATA NOT = 'A' - DISPLAY "WRONG REC1: '" TEST-REC "'" - END-DISPLAY - END-IF - READ TEST-FILE NEXT - AT END - DISPLAY "AT END FOR REC2" - END-DISPLAY - CLOSE TEST-FILE - STOP RUN - NOT AT END - CONTINUE - END-READ. - IF TEST-DATA NOT = 'B' - DISPLAY "WRONG REC2: '" TEST-REC "'" - END-DISPLAY - END-IF - READ TEST-FILE NEXT - AT END - CONTINUE - NOT AT END - DISPLAY "NOT AT END AFTER REC2" - END-DISPLAY - END-READ - IF TEST-DATA NOT = 'B' - DISPLAY "DATE CHANGED ON EOF: '" TEST-REC "'" - END-DISPLAY - END-IF - CLOSE TEST-FILE - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_file.at:503: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_file.at:503" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_file.at:503" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_file.at:504: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_file.at:504" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_file.at:504" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_707 -#AT_START_708 -at_fn_group_banner 708 'run_file.at:509' \ - "REWRITE a RELATIVE file with RANDOM access" " " 4 -at_xfail=no -( - $as_echo "708. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - INPUT-OUTPUT SECTION. - FILE-CONTROL. - SELECT TEST-FILE ASSIGN "./TEST-FILE" - ORGANIZATION IS RELATIVE - ACCESS MODE IS RANDOM - RELATIVE KEY IS TEST-KEY. - DATA DIVISION. - FILE SECTION. - FD TEST-FILE. - 01 TEST-REC PIC X. - WORKING-STORAGE SECTION. - 01 TEST-KEY PIC 9. - PROCEDURE DIVISION. - * - OPEN OUTPUT TEST-FILE. - MOVE 1 TO TEST-KEY. - MOVE "A" TO TEST-REC. - WRITE TEST-REC - END-WRITE. - MOVE 2 TO TEST-KEY. - MOVE "B" TO TEST-REC. - WRITE TEST-REC - END-WRITE. - CLOSE TEST-FILE. - * - OPEN I-O TEST-FILE. - MOVE 1 TO TEST-KEY. - READ TEST-FILE - END-READ. - MOVE 2 TO TEST-KEY. - MOVE "C" TO TEST-REC. - REWRITE TEST-REC - END-REWRITE. - CLOSE TEST-FILE. - * - OPEN INPUT TEST-FILE. - MOVE 1 TO TEST-KEY. - READ TEST-FILE - END-READ. - IF TEST-REC NOT = "A" - DISPLAY "Expected 'A' - Got " TEST-REC - END-DISPLAY - END-IF. - MOVE 2 TO TEST-KEY. - READ TEST-FILE - END-READ. - IF TEST-REC NOT = "C" - DISPLAY "Expected 'C' - Got " TEST-REC - END-DISPLAY - END-IF. - CLOSE TEST-FILE. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_file.at:570: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_file.at:570" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_file.at:570" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_file.at:571: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_file.at:571" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_file.at:571" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_708 -#AT_START_709 -at_fn_group_banner 709 'run_file.at:576' \ - "error status RELATIVE file" " " 4 -at_xfail=no -( - $as_echo "709. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - INPUT-OUTPUT SECTION. - FILE-CONTROL. - SELECT TEST-FILE ASSIGN "./TEST-FILE" - ORGANIZATION IS RELATIVE - ACCESS MODE IS RANDOM - RELATIVE KEY IS TEST-KEY - FILE STATUS IS FILE-STATUS. - DATA DIVISION. - FILE SECTION. - FD TEST-FILE. - 01 TEST-REC PIC X. - WORKING-STORAGE SECTION. - 01 TEST-KEY PIC 9. - 01 FILE-STATUS PIC XX. - PROCEDURE DIVISION. - - DECLARATIVES. - ERR-DISP SECTION. - USE AFTER ERROR PROCEDURE ON TEST-FILE. - DISPLAY FILE-STATUS WITH NO ADVANCING. - END DECLARATIVES. - * - OPEN OUTPUT TEST-FILE. - MOVE 1 TO TEST-KEY. - MOVE "A" TO TEST-REC. - WRITE TEST-REC - END-WRITE. - MOVE 2 TO TEST-KEY. - MOVE "B" TO TEST-REC. - WRITE TEST-REC - END-WRITE. - CLOSE TEST-FILE. - * - OPEN INPUT TEST-FILE. - MOVE 1 TO TEST-KEY. - READ TEST-FILE - END-READ. - MOVE 2 TO TEST-KEY. - MOVE "C" TO TEST-REC. - REWRITE TEST-REC - END-REWRITE. - CLOSE TEST-FILE. - * - OPEN INPUT TEST-FILE. - MOVE 3 TO TEST-KEY. - WRITE TEST-REC - END-WRITE. - CLOSE TEST-FILE. - * - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_file.at:635: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_file.at:635" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_file.at:635" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_file.at:636: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_file.at:636" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo "4948" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_file.at:636" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_709 -#AT_START_710 -at_fn_group_banner 710 'run_file.at:641' \ - "File SORT, SEQUENTIAL" " " 4 -at_xfail=no -( - $as_echo "710. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -# Note: We shouldn't use AT_DATA to create sequential record -# data, because AT_DATA needs a \n at the end - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - INPUT-OUTPUT SECTION. - FILE-CONTROL. - SELECT SORT-IN ASSIGN "test.txt". - SELECT SORT-OUT ASSIGN "result.txt". - SELECT SORT-WRK ASSIGN "SORT-WRK". - DATA DIVISION. - FILE SECTION. - FD SORT-IN. - 01 IN-REC PIC X(6). - FD SORT-OUT. - 01 OUT-REC PIC X(6). - SD SORT-WRK. - 01 WRK-REC PIC X(6). - PROCEDURE DIVISION. - - * Special case: write test data in COBOL, see note above - OPEN OUTPUT SORT-IN. - WRITE IN-REC FROM SPACES END-WRITE. - WRITE IN-REC FROM SPACES END-WRITE. - WRITE IN-REC FROM "world " END-WRITE. - WRITE IN-REC FROM SPACES END-WRITE. - WRITE IN-REC FROM "hello " END-WRITE. - WRITE IN-REC FROM SPACES END-WRITE. - WRITE IN-REC FROM SPACES END-WRITE. - CLOSE SORT-IN. - - SORT SORT-WRK - ASCENDING KEY WRK-REC - USING SORT-IN - GIVING SORT-OUT. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_file.at:684: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_file.at:684" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_file.at:684" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_file.at:685: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_file.at:685" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_file.at:685" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_file.at:686: cat result.txt" -at_fn_check_prepare_trace "run_file.at:686" -( $at_check_trace; cat result.txt -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo " hello world " | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_file.at:686" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_710 -#AT_START_711 -at_fn_group_banner 711 'run_file.at:691' \ - "File SORT, SEQUENTIAL variable records" " " 4 -at_xfail=no -( - $as_echo "711. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - INPUT-OUTPUT SECTION. - FILE-CONTROL. - SELECT file1 ORGANIZATION SEQUENTIAL - ASSIGN "./file1". - SELECT file2 ORGANIZATION SEQUENTIAL - ASSIGN "./file2". - SELECT file3 ASSIGN DISK. - DATA DIVISION. - FILE SECTION. - FD file1 RECORD VARYING FROM 3 TO 12 DEPENDING rsz. - 1 file1-rec pic x(12). - FD file2 RECORD VARYING FROM 3 TO 12 DEPENDING rsz. - 1 file2-rec pic x(12). - SD file3 RECORD VARYING FROM 3 TO 12 DEPENDING rsz. - 1 file3-rec. - 2 file3-key1 pic x. - 2 file3-key2 pic 9. - 2 filler pic x(10). - WORKING-STORAGE SECTION. - 77 rsz pic 99. - 1 1-data. - 2 filler pic x(14) VALUE "03A4X". - 2 filler pic x(14) VALUE "04A3XX". - 2 filler pic x(14) VALUE "05A2XXX". - 2 filler pic x(14) VALUE "06A1XXXX". - 2 filler pic x(14) VALUE "07A0XXXXX". - 2 filler pic x(14) VALUE "08B2XXXXXX". - 2 filler pic x(14) VALUE "09B1XXXXXXX". - 2 filler pic x(14) VALUE "10C2XXXXXXXX". - 2 filler pic x(14) VALUE "11C1XXXXXXXXX". - 2 filler pic x(14) VALUE "12Z9XXXXXXXXXX". - * - 1 filler redefines 1-data. - 2 filler occurs 10 times indexed by ix-1. - 3 1-rsz pic 99. - 3 1-rec pic x(12). - - PROCEDURE DIVISION. - OPEN OUTPUT file1. - PERFORM VARYING ix-1 FROM 1 BY 2 UNTIL ix-1 > 10 - MOVE 1-rsz(ix-1) TO rsz - MOVE 1-rec(ix-1) TO file1-rec - WRITE file1-rec - END-PERFORM. - PERFORM VARYING ix-1 FROM 2 BY 2 UNTIL ix-1 > 10 - MOVE 1-rsz(ix-1) TO rsz - MOVE 1-rec(ix-1) TO file1-rec - WRITE file1-rec - END-PERFORM. - CLOSE file1. - SORT file3 ON ASCENDING file3-key1 - DESCENDING file3-key2 - USING file1 - GIVING file2. - OPEN INPUT file2. - PERFORM VARYING ix-1 FROM 1 BY 1 UNTIL ix-1 > 10 - READ file2 - *>> fileio-sort currently returns constant length records - MOVE 1-rsz(ix-1) TO rsz - *>> END-OF-DETOUR - IF (1-rsz(ix-1) <> rsz) or - (1-rec(ix-1) <> file2-rec) - DISPLAY "FAILED" - END-IF - END-PERFORM. - CLOSE file2. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_file.at:767: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_file.at:767" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_file.at:767" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_file.at:768: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_file.at:768" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_file.at:768" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_711 -#AT_START_712 -at_fn_group_banner 712 'run_file.at:773' \ - "INDEXED File KEYCHECK" " " 4 -at_xfail=no -( - $as_echo "712. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -$as_echo "run_file.at:776" >"$at_check_line_file" -(test "$COB_HAS_ISAM" = "no") \ - && at_fn_check_skip 77 "$at_srcdir/run_file.at:776" - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - - PROGRAM-ID. prog. - - ENVIRONMENT DIVISION. - CONFIGURATION SECTION. - - INPUT-OUTPUT SECTION. - FILE-CONTROL. - SELECT OPTIONAL TSPFILE - ASSIGN TO "testisam" - ORGANIZATION INDEXED ACCESS DYNAMIC - RECORD KEY IS PRIME-KEY - SOURCE IS CM-CUST-NUM, CM-COMPANY - - ALTERNATE RECORD KEY IS SPLIT-KEY2 - SOURCE IS CM-TELEPHONE,CM-MACHINE WITH DUPLICATES - - ALTERNATE RECORD KEY IS SPLIT-KEY3 - SOURCE IS CM-DISK,CM-TAPE WITH DUPLICATES - SUPPRESS WHEN ALL "*" - FILE STATUS IS CUST-STAT - . - - SELECT TSTFILE - ASSIGN TO "testisam" - ORGANIZATION INDEXED ACCESS DYNAMIC - RECORD KEY IS TST-KEY - SOURCE IS TS-CUST-NUM, TS-COMPANY - - ALTERNATE RECORD KEY IS TST-KEY2 - SOURCE IS TS-TELEPHONE,TS-MACHINE WITH DUPLICATES - - ALTERNATE RECORD KEY IS TST-KEY3 - SOURCE IS TS-DISK,TS-TAPE WITH DUPLICATES - SUPPRESS WHEN ALL "*" - - FILE STATUS IS CUST-STAT - . - - SELECT BADFILE - ASSIGN TO "testisam" - ORGANIZATION INDEXED ACCESS DYNAMIC - RECORD KEY IS BAD-KEY - SOURCE IS BD-CUST-NUM, BD-COMPANY - - ALTERNATE RECORD KEY IS BAD-KEY2 - SOURCE IS BD-DISK,BD-TAPE WITH DUPLICATES - SUPPRESS WHEN ALL "*" - FILE STATUS IS CUST-STAT - . - - DATA DIVISION. - FILE SECTION. - FD TSPFILE - BLOCK CONTAINS 5 RECORDS. - - 01 TSPFL-RECORD. - 05 TSPFL-REC. - 10 CM-CUST-NUM. - 15 CM-CUST-PRE PICTURE X(3). - 15 CM-CUST-NNN PICTURE X(5). - 10 CM-STATUS PICTURE X. - 10 CM-COMPANY PICTURE X(25). - 10 CM-ADDRESS-1 PICTURE X(25). - 10 CM-ADDRESS-2 PICTURE X(25). - 10 CM-ADDRESS-3 PICTURE X(25). - 10 CM-TELEPHONE PICTURE 9(10). - 10 CM-DP-MGR PICTURE X(25). - 10 CM-MACHINE PICTURE X(8). - 10 CM-MEMORY PICTURE X(4). - 10 CM-DISK PICTURE X(8). - 10 CM-TAPE PICTURE X(8). - 10 CM-NO-TERMINALS PICTURE 9(5). - - FD BADFILE - BLOCK CONTAINS 5 RECORDS. - - 01 BAD-RECORD. - 05 BAD-REC. - 10 BD-CUST-NUM PICTURE X(8). - 10 BD-STATUS PICTURE X. - 10 BD-COMPANY PICTURE X(25). - 10 BD-ADDRESS-1 PICTURE X(25). - 10 BD-ADDRESS-2 PICTURE X(25). - 10 BD-ADDRESS-3 PICTURE X(25). - 10 BD-TELEPHONE PICTURE 9(10). - 10 BD-DP-MGR PICTURE X(25). - 10 BD-MACHINE PICTURE X(8). - 10 BD-MEMORY PICTURE X(4). - 10 BD-DISK PICTURE X(8). - 10 BD-TAPE PICTURE X(8). - 10 BD-NO-TERMINALS PICTURE 9(5). - 10 BD-XTRA PICTURE 9(5). - - FD TSTFILE - BLOCK CONTAINS 5 RECORDS. - - 01 TSTFL-RECORD. - 05 TSTFL-REC. - 10 TS-CUST-NUM PICTURE X(8). - 10 TS-STATUS PICTURE X. - 10 TS-COMPANY PICTURE X(25). - 10 TS-ADDRESS-1 PICTURE X(25). - 10 TS-ADDRESS-2 PICTURE X(25). - 10 TS-ADDRESS-3 PICTURE X(25). - 10 TS-TELEPHONE PICTURE 9(10). - 10 TS-DP-MGR PICTURE X(25). - 10 TS-MACHINE PICTURE X(8). - 10 TS-MEMORY PICTURE X(4). - 10 TS-DISK PICTURE X(8). - 10 TS-TAPE PICTURE X(8). - - - WORKING-STORAGE SECTION. - - 01 CUST-STAT. - 05 STAT-1 PICTURE 9(4) COMP SYNC. - 05 FILLER REDEFINES STAT-1. - 10 STAT-X1 PIC X COMP-X. - 10 STAT-X2 PIC X COMP-X. - 77 BYTE-1 PICTURE 9(3). - 77 BYTE-2 PICTURE 9(3). - 77 MAX-SUB VALUE 16 PICTURE 9(5) COMP SYNC. - 77 DO-REWRITE PICTURE X VALUE 'N'. - 77 ENVVAR-IN PICTURE X(30). - 77 ENVVAR-OUT PICTURE X(60). - - 01 TEST-DATA. - - 02 DATA-CUST-NUM-TBL. - - 05 FILLER PIC X(8) VALUE "ALP00000". - 05 FILLER PIC X(8) VALUE "BET00000". - 05 FILLER PIC X(8) VALUE "GAM00000". - 05 FILLER PIC X(8) VALUE "DEL00000". - 05 FILLER PIC X(8) VALUE "EPS00000". - 05 FILLER PIC X(8) VALUE "FOR00000". - 05 FILLER PIC X(8) VALUE "GIB00000". - 05 FILLER PIC X(8) VALUE "H&J00000". - 05 FILLER PIC X(8) VALUE "INC00000". - 05 FILLER PIC X(8) VALUE "JOH00000". - 05 FILLER PIC X(8) VALUE "KON00000". - 05 FILLER PIC X(8) VALUE "LEW00000". - 05 FILLER PIC X(8) VALUE "MOR00000". - 05 FILLER PIC X(8) VALUE "NEW00000". - 05 FILLER PIC X(8) VALUE "OLD00000". - 05 FILLER PIC X(8) VALUE "PRE00000". - - 02 DATA-CUST-NUM REDEFINES DATA-CUST-NUM-TBL - PIC X(8) OCCURS 16. - 02 DATA-COMPANY-TBL. - - 05 FILLER PIC X(25) VALUE "ALPHA ELECTRICAL CO. LTD.". - 05 FILLER PIC X(25) VALUE "BETA SHOE MFG. INC. ". - 05 FILLER PIC X(25) VALUE "GAMMA X-RAY TECHNOLOGY ". - 05 FILLER PIC X(25) VALUE "DELTA LUGGAGE REPAIRS ". - 05 FILLER PIC X(25) VALUE "EPSILON EQUIPMENT SUPPLY ". - 05 FILLER PIC X(25) VALUE "FORTUNE COOKIE COMPANY ". - 05 FILLER PIC X(25) VALUE "GIBRALTER LIFE INSURANCE ". - 05 FILLER PIC X(25) VALUE "H & J PLUMBING SUPPLIES ". - 05 FILLER PIC X(25) VALUE "INCREMENTAL BACKUP CORP. ". - 05 FILLER PIC X(25) VALUE "JOHNSON BOATING SUPPLIES ". - 05 FILLER PIC X(25) VALUE "KONFLAB PLASTIC PRODUCTS.". - 05 FILLER PIC X(25) VALUE "LEWISTON GRAPHICS LTD. ". - 05 FILLER PIC X(25) VALUE "MORNINGSIDE CARPENTRY. ". - 05 FILLER PIC X(25) VALUE "NEW WAVE SURF SHOPS INC. ". - 05 FILLER PIC X(25) VALUE "OLD TYME PIZZA MFG. CO. ". - 05 FILLER PIC X(25) VALUE "PRESTIGE OFFICE FURNITURE". - - 02 DATA-COMPANY REDEFINES DATA-COMPANY-TBL - PIC X(25) OCCURS 16. - 02 DATA-ADDRESS-1-TBL. - - 05 FILLER PIC X(25) VALUE "123 MAIN STREET ". - 05 FILLER PIC X(25) VALUE "1090 2ND AVE. WEST ". - 05 FILLER PIC X(25) VALUE "1401 JEFFERSON BLVD. ". - 05 FILLER PIC X(25) VALUE "1620 ARIZONA WAY ". - 05 FILLER PIC X(25) VALUE "1184 EAST FIRST STREET ". - 05 FILLER PIC X(25) VALUE "114 JOHN F. KENNEDY AVE. ". - 05 FILLER PIC X(25) VALUE "650 LIBERTY CRESCENT ". - 05 FILLER PIC X(25) VALUE "77 SUNSET BLVD. ". - 05 FILLER PIC X(25) VALUE "10908 SANTA MONICA BLVD. ". - 05 FILLER PIC X(25) VALUE "1134 PARIS ROAD ". - 05 FILLER PIC X(25) VALUE "808 NORTHWEST MAIN ST. ". - 05 FILLER PIC X(25) VALUE "9904 QUEEN STREET ". - 05 FILLER PIC X(25) VALUE "1709 DUNDAS CRESCENT W. ". - 05 FILLER PIC X(25) VALUE "3240 MARIS AVENUE ". - 05 FILLER PIC X(25) VALUE "1705 WISCONSIN ROAD ". - 05 FILLER PIC X(25) VALUE "114A MAPLE GROVE ". - - 02 DATA-ADDRESS-1 REDEFINES DATA-ADDRESS-1-TBL - PIC X(25) OCCURS 16. - 02 DATA-ADDRESS-2-TBL. - - 05 FILLER PIC X(10) VALUE "NEW YORK ". - 05 FILLER PIC X(10) VALUE "ATLANTA ". - 05 FILLER PIC X(10) VALUE "WASHINGTON". - 05 FILLER PIC X(10) VALUE "TORONTO ". - 05 FILLER PIC X(10) VALUE "CALGARY ". - 05 FILLER PIC X(10) VALUE "SAN DIEGO ". - 05 FILLER PIC X(10) VALUE "LOS RIOS ". - 05 FILLER PIC X(10) VALUE "MADISON ". - 05 FILLER PIC X(10) VALUE "WILBUR ". - 05 FILLER PIC X(10) VALUE "TOPEKA ". - 05 FILLER PIC X(10) VALUE "SEATTLE ". - 05 FILLER PIC X(10) VALUE "NEW JERSEY". - 05 FILLER PIC X(10) VALUE "FORT WAYNE". - 05 FILLER PIC X(10) VALUE "COLUMBUS ". - 05 FILLER PIC X(10) VALUE "RICHMOND ". - 05 FILLER PIC X(10) VALUE "WHITEPLAIN". - - 02 DATA-ADDRESS-2 REDEFINES DATA-ADDRESS-2-TBL - PIC X(10) OCCURS 16. - 02 DATA-ADDRESS-3-TBL. - - 05 FILLER PIC X(10) VALUE "N.Y. ". - 05 FILLER PIC X(10) VALUE "GEORGIA ". - 05 FILLER PIC X(10) VALUE "D.C. ". - 05 FILLER PIC X(10) VALUE "CANADA ". - 05 FILLER PIC X(10) VALUE "CANADA ". - 05 FILLER PIC X(10) VALUE "CALIFORNIA". - 05 FILLER PIC X(10) VALUE "NEW MEXICO". - 05 FILLER PIC X(10) VALUE "WISCONSIN ". - 05 FILLER PIC X(10) VALUE "DELAWARE ". - 05 FILLER PIC X(10) VALUE "KANSAS ". - 05 FILLER PIC X(10) VALUE "WASHINGTON". - 05 FILLER PIC X(10) VALUE "N.J. ". - 05 FILLER PIC X(10) VALUE "COLORADO ". - 05 FILLER PIC X(10) VALUE "OHIO ". - 05 FILLER PIC X(10) VALUE "VIRGINIA ". - 05 FILLER PIC X(10) VALUE "N.Y. ". - - 02 DATA-ADDRESS-3 REDEFINES DATA-ADDRESS-3-TBL - PIC X(10) OCCURS 16. - 02 DATA-TELEPHONE-TBL. - - 05 FILLER PIC 9(10) VALUE 3131234432. - 05 FILLER PIC 9(10) VALUE 4082938498. - 05 FILLER PIC 9(10) VALUE 8372487274. - 05 FILLER PIC 9(10) VALUE 4169898509. - 05 FILLER PIC 9(10) VALUE 5292398745. - 05 FILLER PIC 9(10) VALUE 8009329492. - 05 FILLER PIC 9(10) VALUE 6456445643. - 05 FILLER PIC 9(10) VALUE 6546456333. - 05 FILLER PIC 9(10) VALUE 3455445444. - 05 FILLER PIC 9(10) VALUE 6456445643. - 05 FILLER PIC 9(10) VALUE 7456434355. - 05 FILLER PIC 9(10) VALUE 6554456433. - 05 FILLER PIC 9(10) VALUE 4169898509. - 05 FILLER PIC 9(10) VALUE 7534587453. - 05 FILLER PIC 9(10) VALUE 8787458374. - 05 FILLER PIC 9(10) VALUE 4169898509. - - 02 DATA-TELEPHONE REDEFINES DATA-TELEPHONE-TBL - PIC 9(10) OCCURS 16. - 02 DATA-DP-MGR-TBL. - - 05 FILLER PIC X(20) VALUE "MR. DAVE HARRIS ". - 05 FILLER PIC X(20) VALUE "MS. JANICE SILCOX ". - 05 FILLER PIC X(20) VALUE "MR. ALLAN JONES ". - 05 FILLER PIC X(20) VALUE "MR. PETER MACKAY ". - 05 FILLER PIC X(20) VALUE "MRS. DONNA BREWER ". - 05 FILLER PIC X(20) VALUE "MR. MICHAEL SMYTHE ". - 05 FILLER PIC X(20) VALUE "MR. D.A. MORRISON ". - 05 FILLER PIC X(20) VALUE "MR. BRIAN PATTERSON ". - 05 FILLER PIC X(20) VALUE "MR. DARRYL TOWNSEND ". - 05 FILLER PIC X(20) VALUE "MS. VALERIE HARPER ". - 05 FILLER PIC X(20) VALUE "MR. FRED MILLER ". - 05 FILLER PIC X(20) VALUE "MR. DONALD FISCHER ". - 05 FILLER PIC X(20) VALUE "MR. STEVEN YOURDIN ". - 05 FILLER PIC X(20) VALUE "MS. Goldie Hawn ". - 05 FILLER PIC X(20) VALUE "MS. ALICE WINSTON ". - 05 FILLER PIC X(20) VALUE "MR. THOMAS JEFFERSON". - - 02 DATA-DP-MGR REDEFINES DATA-DP-MGR-TBL - PIC X(20) OCCURS 16. - 02 DATA-MACHINE-TBL. - - 05 FILLER PIC X(8) VALUE "UNI-9030". - 05 FILLER PIC X(8) VALUE "UNI-9040". - 05 FILLER PIC X(8) VALUE "UNI-80/3". - 05 FILLER PIC X(8) VALUE "UNI-80/5". - 05 FILLER PIC X(8) VALUE "UNI-80/6". - 05 FILLER PIC X(8) VALUE "UNI-80/6". - 05 FILLER PIC X(8) VALUE "UNI-80/6". - 05 FILLER PIC X(8) VALUE "UNI-80/8". - 05 FILLER PIC X(8) VALUE "UNI-80/8". - 05 FILLER PIC X(8) VALUE "UNI-80/8". - 05 FILLER PIC X(8) VALUE "UNI-80/8". - 05 FILLER PIC X(8) VALUE "UNI-80/8". - 05 FILLER PIC X(8) VALUE "UNI-80/8". - 05 FILLER PIC X(8) VALUE "UNI-80/8". - 05 FILLER PIC X(8) VALUE "UNI-9040". - 05 FILLER PIC X(8) VALUE "UNI-9040". - - 02 DATA-MACHINE REDEFINES DATA-MACHINE-TBL - PIC X(8) OCCURS 16. - 02 DATA-NO-TERMINALS-TBL. - - 05 FILLER PIC 9(3) COMP-3 VALUE 85. - 05 FILLER PIC 9(3) COMP-3 VALUE 34. - 05 FILLER PIC 9(3) COMP-3 VALUE 75. - 05 FILLER PIC 9(3) COMP-3 VALUE 45. - 05 FILLER PIC 9(3) COMP-3 VALUE 90. - 05 FILLER PIC 9(3) COMP-3 VALUE 107. - 05 FILLER PIC 9(3) COMP-3 VALUE 67. - 05 FILLER PIC 9(3) COMP-3 VALUE 32. - 05 FILLER PIC 9(3) COMP-3 VALUE 16. - 05 FILLER PIC 9(3) COMP-3 VALUE 34. - 05 FILLER PIC 9(3) COMP-3 VALUE 128. - 05 FILLER PIC 9(3) COMP-3 VALUE 64. - 05 FILLER PIC 9(3) COMP-3 VALUE 110. - 05 FILLER PIC 9(3) COMP-3 VALUE 324. - 05 FILLER PIC 9(3) COMP-3 VALUE 124. - 05 FILLER PIC 9(3) COMP-3 VALUE 86. - - 02 DATA-NO-TERMINALS REDEFINES DATA-NO-TERMINALS-TBL - PIC 9(3) COMP-3 OCCURS 16. - - 01 WORK-AREA. - 05 REC-NUM PICTURE 9(6) VALUE 0. - 05 REC-MAX PICTURE 9(6) VALUE 10. - 05 SUB PICTURE 9(4) COMP SYNC. - 88 ODD-RECORD VALUE 1 3 5 7 9 10 11. - 88 NULL-KEY VALUE 4 5 8 12 14. - - 05 TSPFL-KEY PICTURE X(8). - - PROCEDURE DIVISION. - - MAINFILE. - PERFORM LOADFILE. - PERFORM LOADFILE. - PERFORM REWRFILE. - PERFORM LISTFILE. - OPEN INPUT TSTFILE - IF CUST-STAT NOT = "00" - DISPLAY "A: Expected ERROR " CUST-STAT - " opening TSTFILE, Record size different" - UPON CONSOLE - ELSE - DISPLAY "A: Un-Expected open " - "TSTFILE, Record size different" UPON CONSOLE - CLOSE TSTFILE - END-IF. - OPEN INPUT BADFILE - IF CUST-STAT NOT = "00" - DISPLAY "B: Expected ERROR " CUST-STAT - " opening BADFILE, Index mismatch" UPON CONSOLE - ELSE - DISPLAY "B: Un-Expected open BADFILE, Index mismatch" - UPON CONSOLE - CLOSE BADFILE - END-IF. - - DISPLAY "IX_OPTIONS" UPON ENVIRONMENT-NAME. - ACCEPT ENVVAR-IN FROM ENVIRONMENT-VALUE. - IF ENVVAR-IN NOT = SPACES - STRING ENVVAR-IN DELIMITED BY SPACE - ",keycheck=off" INTO ENVVAR-OUT - DISPLAY "IX_OPTIONS" UPON ENVIRONMENT-NAME - DISPLAY ENVVAR-OUT UPON ENVIRONMENT-VALUE - * DISPLAY "IX_OPTIONS = '" ENVVAR-OUT "'" UPON CONSOLE - ELSE - DISPLAY "IX_OPTIONS" UPON ENVIRONMENT-NAME - DISPLAY "keycheck=off" UPON ENVIRONMENT-VALUE - END-IF - DISPLAY "IO_TESTISAM" UPON ENVIRONMENT-NAME. - ACCEPT ENVVAR-IN FROM ENVIRONMENT-VALUE. - IF ENVVAR-IN NOT = SPACES - STRING ENVVAR-IN DELIMITED BY SPACE - ",keycheck=off" INTO ENVVAR-OUT - DISPLAY "IO_TESTISAM" UPON ENVIRONMENT-NAME - DISPLAY ENVVAR-OUT UPON ENVIRONMENT-VALUE - DISPLAY "IO_TESTISAM = '" ENVVAR-OUT "'" UPON CONSOLE - END-IF - OPEN INPUT BADFILE - IF CUST-STAT NOT = "00" - DISPLAY "C: Un-Expected ERROR " CUST-STAT - " opening BADFILE, Index mismatch" - UPON CONSOLE - ELSE - DISPLAY "C: Expected open BADFILE, with Index mismatch" - UPON CONSOLE - MOVE SPACES TO BAD-RECORD - START BADFILE KEY GREATER THAN BAD-KEY2 - READ BADFILE NEXT RECORD WITH NO LOCK - DISPLAY "Key: " BD-CUST-NUM " is " BD-DISK " : " BD-TAPE - READ BADFILE NEXT RECORD WITH NO LOCK - DISPLAY "Key: " BD-CUST-NUM " is " BD-DISK " : " BD-TAPE - READ BADFILE NEXT RECORD WITH NO LOCK - DISPLAY "Key: " BD-CUST-NUM " is " BD-DISK " : " BD-TAPE - CLOSE BADFILE - END-IF. - STOP RUN. - - LOADFILE. - DISPLAY "Loading sample data file." - UPON CONSOLE. - - OPEN OUTPUT TSPFILE - IF CUST-STAT NOT = "00" - AND CUST-STAT NOT = "05" - DIVIDE STAT-1 BY 256 GIVING BYTE-1 REMAINDER BYTE-2 - DISPLAY "Error " CUST-STAT " " BYTE-1 " " BYTE-2 - " opening 'testisam' file" - UPON CONSOLE - STOP RUN - END-IF. - - PERFORM 1000-LOAD-RECORD - VARYING SUB FROM 1 BY 1 - UNTIL SUB > MAX-SUB. - - DISPLAY "Sample data file load complete." - UPON CONSOLE. - CLOSE TSPFILE. - - REWRFILE. - DELETE FILE TSPFILE. - DISPLAY "Rewrite sample data file: " CUST-STAT - UPON CONSOLE. - - OPEN I-O TSPFILE - IF CUST-STAT NOT = "00" - AND CUST-STAT NOT = "05" - DIVIDE STAT-1 BY 256 GIVING BYTE-1 REMAINDER BYTE-2 - DISPLAY "Error " CUST-STAT " " BYTE-1 " " BYTE-2 - " opening 'testisam' file" - UPON CONSOLE - STOP RUN - END-IF. - - MOVE 'N' TO DO-REWRITE. - PERFORM 1000-LOAD-RECORD - VARYING SUB FROM 1 BY 1 - UNTIL SUB > MAX-SUB. - MOVE 'Y' TO DO-REWRITE. - PERFORM 1000-LOAD-RECORD - VARYING SUB FROM 1 BY 2 - UNTIL SUB > MAX-SUB. - MOVE 'N' TO DO-REWRITE. - - DISPLAY "Sample data file rewrite complete." - UPON CONSOLE. - CLOSE TSPFILE. - - *---------------------------------------------------------------* - * LOAD A RECORD FROM DATA TABLES * - *---------------------------------------------------------------* - - 1000-LOAD-RECORD. - - MOVE SPACES TO TSPFL-RECORD. - MOVE DATA-CUST-NUM (SUB) TO CM-CUST-NUM. - MOVE CM-CUST-NUM TO TSPFL-KEY. - IF DO-REWRITE = 'Y' - READ TSPFILE WITH LOCK - MOVE DATA-CUST-NUM (SUB) TO CM-CUST-NUM - MOVE CM-CUST-NUM TO TSPFL-KEY - END-IF - MOVE DATA-COMPANY (SUB) TO CM-COMPANY. - MOVE DATA-ADDRESS-1 (SUB) TO CM-ADDRESS-1. - MOVE DATA-ADDRESS-2 (SUB) TO CM-ADDRESS-2. - MOVE DATA-ADDRESS-3 (SUB) TO CM-ADDRESS-3. - MOVE DATA-TELEPHONE (SUB) TO CM-TELEPHONE. - MOVE DATA-DP-MGR (SUB) TO CM-DP-MGR. - MOVE DATA-MACHINE (SUB) TO CM-MACHINE. - MOVE DATA-NO-TERMINALS (SUB) TO CM-NO-TERMINALS. - - IF ODD-RECORD - MOVE "8417" TO CM-DISK - MOVE "1600 BPI" TO CM-TAPE - MOVE "1MEG" TO CM-MEMORY - ELSE - MOVE "8470" TO CM-DISK - MOVE "6250 BPI" TO CM-TAPE - MOVE "3MEG" TO CM-MEMORY. - IF NULL-KEY - MOVE ALL "*" TO CM-DISK - MOVE ALL "*" TO CM-TAPE. - IF SUB = 1 OR 6 - MOVE "2417" TO CM-DISK - MOVE "549 mmm" TO CM-TAPE. - - IF DO-REWRITE = 'Y' - IF SUB NOT = 1 AND SUB NOT = 6 - MOVE "REWRITE" TO CM-DISK - END-IF - REWRITE TSPFL-RECORD - IF CUST-STAT NOT = "00" - AND CUST-STAT NOT = "02" - DISPLAY "REWRITE: " TSPFL-KEY ", Status: " - CUST-STAT UPON CONSOLE - END-IF - ELSE - WRITE TSPFL-RECORD - IF CUST-STAT NOT = "00" - AND CUST-STAT NOT = "02" - DISPLAY "WRITE: " TSPFL-KEY ", Status: " - CUST-STAT UPON CONSOLE - END-IF - END-IF. - - LISTFILE. - DISPLAY "LIST SAMPLE FILE" UPON CONSOLE. - MOVE ZERO TO REC-NUM - OPEN INPUT TSPFILE - IF CUST-STAT NOT = "00" - DISPLAY "ERROR " CUST-STAT " OPENING INPUT FILE" - UPON CONSOLE - IF CUST-STAT (1:1) = "9" - DISPLAY "Sub Error " STAT-X2 UPON CONSOLE - END-IF - STOP RUN - END-IF. - MOVE SPACES TO TSPFL-RECORD. - START TSPFILE KEY GREATER THAN PRIME-KEY - WITH SIZE 8 - START TSPFILE KEY GREATER THAN PRIME-KEY - WITH LENGTH 8 - START TSPFILE KEY GREATER THAN PRIME-KEY - WITH SIZE 8 - START TSPFILE KEY GREATER THAN PRIME-KEY - WITH LENGTH 8 - START TSPFILE KEY GREATER THAN PRIME-KEY - IF CUST-STAT NOT = "00" - DISPLAY "Error " CUST-STAT " starting file" - UPON CONSOLE - IF CUST-STAT (1:1) = "9" - DISPLAY "Sub Error " STAT-X2 UPON CONSOLE - END-IF - STOP RUN - END-IF. - READ TSPFILE NEXT RECORD WITH NO LOCK - IF CUST-STAT NOT = "00" - DISPLAY "Error " CUST-STAT " on 1st read of file" - UPON CONSOLE - IF CUST-STAT (1:1) = "9" - DISPLAY "Sub Error " STAT-X2 UPON CONSOLE - END-IF - STOP RUN - END-IF. - PERFORM UNTIL CUST-STAT NOT = "00" - OR REC-NUM > REC-MAX - DISPLAY "Key: " CM-CUST-NUM " is " CM-COMPANY - " Disk=" CM-DISK "." - UPON CONSOLE - READ TSPFILE NEXT RECORD - AT END - MOVE "99" TO CUST-STAT - END-READ - ADD 1 TO REC-NUM - END-PERFORM - IF CUST-STAT = "99" - DISPLAY "Hit End of File" UPON CONSOLE - END-IF. - - DISPLAY "LIST SAMPLE FILE DESCENDING" UPON CONSOLE. - MOVE ZERO TO REC-NUM - START TSPFILE KEY LESS THAN PRIME-KEY - IF CUST-STAT NOT = "00" - DISPLAY "Error " CUST-STAT " starting file" - UPON CONSOLE - STOP RUN - END-IF. - READ TSPFILE PREVIOUS RECORD WITH NO LOCK - IF CUST-STAT NOT = "00" - DISPLAY "Error " CUST-STAT " on 1st read of file" - UPON CONSOLE - STOP RUN - END-IF. - PERFORM UNTIL CUST-STAT NOT = "00" - OR REC-NUM > REC-MAX - DISPLAY "Key: " CM-CUST-NUM " is " CM-COMPANY - " Disk=" CM-DISK "." - UPON CONSOLE - READ TSPFILE PREVIOUS RECORD - AT END - MOVE "99" TO CUST-STAT - END-READ - ADD 1 TO REC-NUM - END-PERFORM. - - DISPLAY "LIST SAMPLE FILE BY KEY3" UPON CONSOLE. - MOVE ZERO TO REC-NUM - MOVE SPACES TO TSPFL-RECORD. - START TSPFILE KEY GREATER THAN OR EQUAL TO SPLIT-KEY3 - IF CUST-STAT NOT = "00" - AND CUST-STAT NOT = "02" - DISPLAY "Error " CUST-STAT " starting file" - UPON CONSOLE - STOP RUN - END-IF. - READ TSPFILE NEXT RECORD WITH NO LOCK - IF CUST-STAT NOT = "00" - AND CUST-STAT NOT = "02" - DISPLAY "Error " CUST-STAT " on 1st read of file" - UPON CONSOLE - STOP RUN - END-IF. - PERFORM UNTIL (CUST-STAT NOT = "00" - AND CUST-STAT NOT = "02") - OR REC-NUM > REC-MAX - DISPLAY "Key: " CM-CUST-NUM " is " CM-COMPANY - " Disk=" CM-DISK "." - UPON CONSOLE - READ TSPFILE NEXT RECORD - AT END - MOVE "99" TO CUST-STAT - END-READ - ADD 1 TO REC-NUM - END-PERFORM. - CLOSE TSPFILE. - - OPEN I-O TSPFILE. - MOVE SPACES TO TSPFL-RECORD. - MOVE DATA-CUST-NUM (2) TO CM-CUST-NUM. - READ TSPFILE KEY IS PRIME-KEY - IF CUST-STAT NOT = "23" - DISPLAY "Error " CUST-STAT " instead of 23" - UPON CONSOLE - END-IF. - MOVE DATA-COMPANY (2) TO CM-COMPANY. - READ TSPFILE KEY IS PRIME-KEY - IF CUST-STAT NOT = "00" - DISPLAY "Error " CUST-STAT " on primary read" - UPON CONSOLE - ELSE - DISPLAY "Got: " CM-CUST-NUM " is " CM-COMPANY - " Disk=" CM-DISK "." - UPON CONSOLE - END-IF. - READ TSPFILE NEXT RECORD - IF CUST-STAT NOT = "00" - DISPLAY "Error " CUST-STAT " on next read" - UPON CONSOLE - ELSE - DISPLAY "Nxt: " CM-CUST-NUM " is " CM-COMPANY - " Disk=" CM-DISK "." - UPON CONSOLE - END-IF. - MOVE DATA-TELEPHONE (7) TO CM-TELEPHONE. - MOVE DATA-MACHINE (7) TO CM-MACHINE. - READ TSPFILE KEY IS SPLIT-KEY2 - IF CUST-STAT NOT = "00" - DISPLAY "Error " CUST-STAT " instead of 23" - UPON CONSOLE - ELSE - DISPLAY "Ky2: " CM-CUST-NUM " is " CM-COMPANY - " Mach=" CM-MACHINE - UPON CONSOLE - END-IF. - WRITE TSPFL-RECORD - IF CUST-STAT NOT = "22" - DISPLAY "Error " CUST-STAT " instead of 22" - UPON CONSOLE - ELSE - DISPLAY " Write: " CM-CUST-NUM " got 22 as expected" - UPON CONSOLE - END-IF. - MOVE DATA-CUST-NUM (3) TO CM-CUST-NUM. - MOVE DATA-COMPANY (3) TO CM-COMPANY. - READ TSPFILE KEY IS PRIME-KEY - DISPLAY " Read: " CM-CUST-NUM " got " - CUST-STAT " as expected " - CM-NO-TERMINALS " terminals" - UPON CONSOLE. - ADD 5 TO CM-NO-TERMINALS - REWRITE TSPFL-RECORD - IF CUST-STAT NOT = "02" - AND CUST-STAT NOT = "00" - DISPLAY "Error " CUST-STAT " instead of 02" - UPON CONSOLE - ELSE - DISPLAY "ReWrite: " CM-CUST-NUM " got 00/02" - " as expected " - CM-NO-TERMINALS " terminals" - UPON CONSOLE - END-IF. - MOVE DATA-CUST-NUM (2) TO CM-CUST-NUM. - MOVE DATA-COMPANY (2) TO CM-COMPANY. - READ TSPFILE KEY IS PRIME-KEY - DISPLAY " Read: " CM-CUST-NUM " got " - CUST-STAT " as expected " - CM-NO-TERMINALS " terminals" - UPON CONSOLE. - MOVE DATA-CUST-NUM (3) TO CM-CUST-NUM. - MOVE DATA-COMPANY (3) TO CM-COMPANY. - REWRITE TSPFL-RECORD - IF CUST-STAT NOT = "02" - AND CUST-STAT NOT = "00" - DISPLAY "Error " CUST-STAT " instead of 02" - UPON CONSOLE - ELSE - DISPLAY "ReWrite: " CM-CUST-NUM " got 00/02" - " as expected" - UPON CONSOLE - END-IF. - MOVE DATA-CUST-NUM (6) TO CM-CUST-NUM. - MOVE DATA-COMPANY (6) TO CM-COMPANY. - READ TSPFILE KEY IS PRIME-KEY - MOVE DATA-TELEPHONE (7) TO CM-TELEPHONE. - MOVE DATA-MACHINE (7) TO CM-MACHINE. - REWRITE TSPFL-RECORD - IF CUST-STAT NOT = "02" - AND CUST-STAT NOT = "00" - DISPLAY "Error " CUST-STAT " instead of 02" - UPON CONSOLE - ELSE - DISPLAY "ReWrite: " CM-CUST-NUM " got 00/02" - " as expected" - UPON CONSOLE - END-IF. - CLOSE TSPFILE. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_file.at:1497: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_file.at:1497" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_file.at:1497" -$at_failed && at_fn_log_failure -$at_traceon; } - - -{ set +x -$as_echo "$at_srcdir/run_file.at:1499: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_file.at:1499" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo "Loading sample data file. -Sample data file load complete. -Loading sample data file. -Sample data file load complete. -Rewrite sample data file: 00 -Sample data file rewrite complete. -LIST SAMPLE FILE -Key: ALP00000 is ALPHA ELECTRICAL CO. LTD. Disk=2417 . -Key: BET00000 is BETA SHOE MFG. INC. Disk=8470 . -Key: DEL00000 is DELTA LUGGAGE REPAIRS Disk=********. -Key: EPS00000 is EPSILON EQUIPMENT SUPPLY Disk=REWRITE . -Key: FOR00000 is FORTUNE COOKIE COMPANY Disk=2417 . -Key: GAM00000 is GAMMA X-RAY TECHNOLOGY Disk=REWRITE . -Key: GIB00000 is GIBRALTER LIFE INSURANCE Disk=REWRITE . -Key: H&J00000 is H & J PLUMBING SUPPLIES Disk=********. -Key: INC00000 is INCREMENTAL BACKUP CORP. Disk=REWRITE . -Key: JOH00000 is JOHNSON BOATING SUPPLIES Disk=8417 . -Key: KON00000 is KONFLAB PLASTIC PRODUCTS. Disk=REWRITE . -LIST SAMPLE FILE DESCENDING -Key: KON00000 is KONFLAB PLASTIC PRODUCTS. Disk=REWRITE . -Key: JOH00000 is JOHNSON BOATING SUPPLIES Disk=8417 . -Key: INC00000 is INCREMENTAL BACKUP CORP. Disk=REWRITE . -Key: H&J00000 is H & J PLUMBING SUPPLIES Disk=********. -Key: GIB00000 is GIBRALTER LIFE INSURANCE Disk=REWRITE . -Key: GAM00000 is GAMMA X-RAY TECHNOLOGY Disk=REWRITE . -Key: FOR00000 is FORTUNE COOKIE COMPANY Disk=2417 . -Key: EPS00000 is EPSILON EQUIPMENT SUPPLY Disk=REWRITE . -Key: DEL00000 is DELTA LUGGAGE REPAIRS Disk=********. -Key: BET00000 is BETA SHOE MFG. INC. Disk=8470 . -Key: ALP00000 is ALPHA ELECTRICAL CO. LTD. Disk=2417 . -LIST SAMPLE FILE BY KEY3 -Key: ALP00000 is ALPHA ELECTRICAL CO. LTD. Disk=2417 . -Key: FOR00000 is FORTUNE COOKIE COMPANY Disk=2417 . -Key: JOH00000 is JOHNSON BOATING SUPPLIES Disk=8417 . -Key: BET00000 is BETA SHOE MFG. INC. Disk=8470 . -Key: PRE00000 is PRESTIGE OFFICE FURNITURE Disk=8470 . -Key: EPS00000 is EPSILON EQUIPMENT SUPPLY Disk=REWRITE . -Key: GAM00000 is GAMMA X-RAY TECHNOLOGY Disk=REWRITE . -Key: GIB00000 is GIBRALTER LIFE INSURANCE Disk=REWRITE . -Key: INC00000 is INCREMENTAL BACKUP CORP. Disk=REWRITE . -Key: KON00000 is KONFLAB PLASTIC PRODUCTS. Disk=REWRITE . -Key: MOR00000 is MORNINGSIDE CARPENTRY. Disk=REWRITE . -Got: BET00000 is BETA SHOE MFG. INC. Disk=8470 . -Nxt: DEL00000 is DELTA LUGGAGE REPAIRS Disk=********. -Ky2: GIB00000 is GIBRALTER LIFE INSURANCE Mach=UNI-80/6 - Write: GIB00000 got 22 as expected - Read: GAM00000 got 00 as expected 00075 terminals -ReWrite: GAM00000 got 00/02 as expected 00080 terminals - Read: BET00000 got 00 as expected 00034 terminals -ReWrite: GAM00000 got 00/02 as expected -ReWrite: FOR00000 got 00/02 as expected -A: Expected ERROR 39 opening TSTFILE, Record size different -B: Expected ERROR 39 opening BADFILE, Index mismatch -C: Expected open BADFILE, with Index mismatch -Key: ALP00000 is 2417 : 549 mmm -Key: FOR00000 is 2417 : 549 mmm -Key: JOH00000 is 8417 : 1600 BPI -" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_file.at:1499" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_712 -#AT_START_713 -at_fn_group_banner 713 'run_file.at:1562' \ - "SUPPRESS WHEN string" " " 4 -at_xfail=no -( - $as_echo "713. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - - PROGRAM-ID. prog. - - ENVIRONMENT DIVISION. - CONFIGURATION SECTION. - - INPUT-OUTPUT SECTION. - FILE-CONTROL. - SELECT OPTIONAL TSPFILE - ASSIGN TO "testisam" - ORGANIZATION INDEXED ACCESS DYNAMIC - RECORD KEY IS CM-CUST-NUM - - ALTERNATE RECORD KEY IS CM-TELEPHONE - SUPPRESS WHEN "90055569" - - ALTERNATE RECORD KEY IS SPLIT-KEY3 - SOURCE IS CM-DISK,CM-TAPE WITH DUPLICATES - SUPPRESS WHEN "8417" - FILE STATUS IS CUST-STAT - . - - DATA DIVISION. - FILE SECTION. - FD TSPFILE - BLOCK CONTAINS 5 RECORDS. - - 01 TSPFL-RECORD. - 05 TSPFL-REC. - 10 CM-CUST-NUM. - 15 CM-CUST-PRE PICTURE X(3). - 15 CM-CUST-NNN PICTURE X(5). - 10 CM-STATUS PICTURE X. - 10 CM-COMPANY PICTURE X(25). - 10 CM-ADDRESS-1 PICTURE X(25). - 10 CM-ADDRESS-2 PICTURE X(25). - 10 CM-ADDRESS-3 PICTURE X(25). - 10 CM-TELEPHONE PICTURE 9(10). - 10 CM-DP-MGR PICTURE X(25). - 10 CM-MACHINE PICTURE X(8). - 10 CM-MEMORY PICTURE X(4). - 10 CM-DISK PICTURE X(4). - 10 CM-TAPE PICTURE X(8). - - WORKING-STORAGE SECTION. - - 01 CUST-STAT PIC XX. - 77 MAX-SUB VALUE 16 PICTURE 9(5) COMP. - - 01 TEST-DATA. - 02 DATA-CUST-NUM-TBL. - 05 FILLER PIC X(8) VALUE "ALP00000". - 05 FILLER PIC X(8) VALUE "BET00000". - 05 FILLER PIC X(8) VALUE "GAM00000". - 05 FILLER PIC X(8) VALUE "DEL00000". - 05 FILLER PIC X(8) VALUE "EPS00000". - 05 FILLER PIC X(8) VALUE "FOR00000". - 05 FILLER PIC X(8) VALUE "GIB00000". - 05 FILLER PIC X(8) VALUE "H&J00000". - 05 FILLER PIC X(8) VALUE "INC00000". - 05 FILLER PIC X(8) VALUE "JOH00000". - 05 FILLER PIC X(8) VALUE "KON00000". - 05 FILLER PIC X(8) VALUE "LEW00000". - 05 FILLER PIC X(8) VALUE "MOR00000". - 05 FILLER PIC X(8) VALUE "NEW00000". - 05 FILLER PIC X(8) VALUE "OLD00000". - 05 FILLER PIC X(8) VALUE "PRE00000". - - 02 DATA-CUST-NUM REDEFINES DATA-CUST-NUM-TBL - PIC X(8) OCCURS 16. - 02 DATA-COMPANY-TBL. - 05 FILLER PIC X(25) VALUE "ALPHA ELECTRICAL CO. LTD.". - 05 FILLER PIC X(25) VALUE "BETA SHOE MFG. INC. ". - 05 FILLER PIC X(25) VALUE "GAMMA X-RAY TECHNOLOGY ". - 05 FILLER PIC X(25) VALUE "DELTA LUGGAGE REPAIRS ". - 05 FILLER PIC X(25) VALUE "EPSILON EQUIPMENT SUPPLY ". - 05 FILLER PIC X(25) VALUE "FORTUNE COOKIE COMPANY ". - 05 FILLER PIC X(25) VALUE "GIBRALTER LIFE INSURANCE ". - 05 FILLER PIC X(25) VALUE "H & J PLUMBING SUPPLIES ". - 05 FILLER PIC X(25) VALUE "INCREMENTAL BACKUP CORP. ". - 05 FILLER PIC X(25) VALUE "JOHNSON BOATING SUPPLIES ". - 05 FILLER PIC X(25) VALUE "KONFLAB PLASTIC PRODUCTS.". - 05 FILLER PIC X(25) VALUE "LEWISTON GRAPHICS LTD. ". - 05 FILLER PIC X(25) VALUE "MORNINGSIDE CARPENTRY. ". - 05 FILLER PIC X(25) VALUE "NEW WAVE SURF SHOPS INC. ". - 05 FILLER PIC X(25) VALUE "OLD TYME PIZZA MFG. CO. ". - 05 FILLER PIC X(25) VALUE "PRESTIGE OFFICE FURNITURE". - - 02 DATA-COMPANY REDEFINES DATA-COMPANY-TBL - PIC X(25) OCCURS 16. - 02 DATA-ADDRESS-1-TBL. - 05 FILLER PIC X(25) VALUE "123 MAIN STREET ". - 05 FILLER PIC X(25) VALUE "1090 2ND AVE. WEST ". - 05 FILLER PIC X(25) VALUE "1401 JEFFERSON BLVD. ". - 05 FILLER PIC X(25) VALUE "1620 ARIZONA WAY ". - 05 FILLER PIC X(25) VALUE "1184 EAST FIRST STREET ". - 05 FILLER PIC X(25) VALUE "114 JOHN F. KENNEDY AVE. ". - 05 FILLER PIC X(25) VALUE "650 LIBERTY CRESCENT ". - 05 FILLER PIC X(25) VALUE "77 SUNSET BLVD. ". - 05 FILLER PIC X(25) VALUE "10908 SANTA MONICA BLVD. ". - 05 FILLER PIC X(25) VALUE "1134 PARIS ROAD ". - 05 FILLER PIC X(25) VALUE "808 NORTHWEST MAIN ST. ". - 05 FILLER PIC X(25) VALUE "9904 QUEEN STREET ". - 05 FILLER PIC X(25) VALUE "1709 DUNDAS CRESCENT W. ". - 05 FILLER PIC X(25) VALUE "3240 MARIS AVENUE ". - 05 FILLER PIC X(25) VALUE "1705 WISCONSIN ROAD ". - 05 FILLER PIC X(25) VALUE "114A MAPLE GROVE ". - - 02 DATA-ADDRESS-1 REDEFINES DATA-ADDRESS-1-TBL - PIC X(25) OCCURS 16. - 02 DATA-ADDRESS-2-TBL. - 05 FILLER PIC X(10) VALUE "NEW YORK ". - 05 FILLER PIC X(10) VALUE "ATLANTA ". - 05 FILLER PIC X(10) VALUE "WASHINGTON". - 05 FILLER PIC X(10) VALUE "TORONTO ". - 05 FILLER PIC X(10) VALUE "CALGARY ". - 05 FILLER PIC X(10) VALUE "SAN DIEGO ". - 05 FILLER PIC X(10) VALUE "LOS RIOS ". - 05 FILLER PIC X(10) VALUE "MADISON ". - 05 FILLER PIC X(10) VALUE "WILBUR ". - 05 FILLER PIC X(10) VALUE "TOPEKA ". - 05 FILLER PIC X(10) VALUE "SEATTLE ". - 05 FILLER PIC X(10) VALUE "NEW JERSEY". - 05 FILLER PIC X(10) VALUE "FORT WAYNE". - 05 FILLER PIC X(10) VALUE "COLUMBUS ". - 05 FILLER PIC X(10) VALUE "RICHMOND ". - 05 FILLER PIC X(10) VALUE "WHITEPLAIN". - - 02 DATA-ADDRESS-2 REDEFINES DATA-ADDRESS-2-TBL - PIC X(10) OCCURS 16. - 02 DATA-ADDRESS-3-TBL. - 05 FILLER PIC X(10) VALUE "N.Y. ". - 05 FILLER PIC X(10) VALUE "GEORGIA ". - 05 FILLER PIC X(10) VALUE "D.C. ". - 05 FILLER PIC X(10) VALUE "CANADA ". - 05 FILLER PIC X(10) VALUE "CANADA ". - 05 FILLER PIC X(10) VALUE "CALIFORNIA". - 05 FILLER PIC X(10) VALUE "NEW MEXICO". - 05 FILLER PIC X(10) VALUE "WISCONSIN ". - 05 FILLER PIC X(10) VALUE "DELAWARE ". - 05 FILLER PIC X(10) VALUE "KANSAS ". - 05 FILLER PIC X(10) VALUE "WASHINGTON". - 05 FILLER PIC X(10) VALUE "N.J. ". - 05 FILLER PIC X(10) VALUE "COLORADO ". - 05 FILLER PIC X(10) VALUE "OHIO ". - 05 FILLER PIC X(10) VALUE "VIRGINIA ". - 05 FILLER PIC X(10) VALUE "N.Y. ". - - 02 DATA-ADDRESS-3 REDEFINES DATA-ADDRESS-3-TBL - PIC X(10) OCCURS 16. - 02 DATA-TELEPHONE-TBL. - 05 FILLER PIC 9(10) VALUE 3131234432. - 05 FILLER PIC 9(10) VALUE 4082938498. - 05 FILLER PIC 9(10) VALUE 8009329492. - 05 FILLER PIC 9(10) VALUE 7169898509. - 05 FILLER PIC 9(10) VALUE 5292398745. - 05 FILLER PIC 9(10) VALUE 8009329492. - 05 FILLER PIC 9(10) VALUE 6456445643. - 05 FILLER PIC 9(10) VALUE 9005556969. - 05 FILLER PIC 9(10) VALUE 9005556970. - 05 FILLER PIC 9(10) VALUE 6456445649. - 05 FILLER PIC 9(10) VALUE 7456434355. - 05 FILLER PIC 9(10) VALUE 9005556969. - 05 FILLER PIC 9(10) VALUE 4169898507. - 05 FILLER PIC 9(10) VALUE 7534587453. - 05 FILLER PIC 9(10) VALUE 9005556969. - 05 FILLER PIC 9(10) VALUE 4169898509. - - 02 DATA-TELEPHONE REDEFINES DATA-TELEPHONE-TBL - PIC 9(10) OCCURS 16. - 02 DATA-DP-MGR-TBL. - 05 FILLER PIC X(20) VALUE "MR. DAVE HARRIS ". - 05 FILLER PIC X(20) VALUE "MS. JANICE SILCOX ". - 05 FILLER PIC X(20) VALUE "MR. ALLAN JONES ". - 05 FILLER PIC X(20) VALUE "MR. PETER MACKAY ". - 05 FILLER PIC X(20) VALUE "MRS. DONNA BREWER ". - 05 FILLER PIC X(20) VALUE "MR. MICHAEL SMYTHE ". - 05 FILLER PIC X(20) VALUE "MR. D.A. MORRISON ". - 05 FILLER PIC X(20) VALUE "MR. BRIAN PATTERSON ". - 05 FILLER PIC X(20) VALUE "MR. DARRYL TOWNSEND ". - 05 FILLER PIC X(20) VALUE "MS. VALERIE HARPER ". - 05 FILLER PIC X(20) VALUE "MR. FRED MILLER ". - 05 FILLER PIC X(20) VALUE "MR. DONALD FISCHER ". - 05 FILLER PIC X(20) VALUE "MR. STEVEN YOURDIN ". - 05 FILLER PIC X(20) VALUE "MS. Goldie Hawn ". - 05 FILLER PIC X(20) VALUE "MS. ALICE WINSTON ". - 05 FILLER PIC X(20) VALUE "MR. THOMAS JEFFERSON". - - 02 DATA-DP-MGR REDEFINES DATA-DP-MGR-TBL - PIC X(20) OCCURS 16. - 02 DATA-MACHINE-TBL. - 05 FILLER PIC X(8) VALUE "UNI-9030". - 05 FILLER PIC X(8) VALUE "UNI-9040". - 05 FILLER PIC X(8) VALUE "UNI-80/3". - 05 FILLER PIC X(8) VALUE "UNI-80/5". - 05 FILLER PIC X(8) VALUE "UNI-80/6". - 05 FILLER PIC X(8) VALUE "UNI-80/6". - 05 FILLER PIC X(8) VALUE "UNI-80/6". - 05 FILLER PIC X(8) VALUE "UNI-80/8". - 05 FILLER PIC X(8) VALUE "UNI-80/8". - 05 FILLER PIC X(8) VALUE "UNI-80/8". - 05 FILLER PIC X(8) VALUE "UNI-80/8". - 05 FILLER PIC X(8) VALUE "UNI-80/8". - 05 FILLER PIC X(8) VALUE "UNI-80/8". - 05 FILLER PIC X(8) VALUE "UNI-80/8". - 05 FILLER PIC X(8) VALUE "UNI-9040". - 05 FILLER PIC X(8) VALUE "UNI-9040". - - 02 DATA-MACHINE REDEFINES DATA-MACHINE-TBL - PIC X(8) OCCURS 16. - 01 WORK-AREA. - 05 REC-NUM PICTURE 9(2) VALUE 0. - 05 SUB PICTURE 9(4) COMP. - 88 ODD-RECORD VALUE 1 3 5 7 9 10 11. - - 05 TSPFL-KEY PICTURE X(8). - - PROCEDURE DIVISION. - - MAINFILE. - PERFORM LOADFILE. - PERFORM LISTFILE. - STOP RUN. - - LOADFILE. - DISPLAY "Loading sample data file." - UPON CONSOLE. - - OPEN OUTPUT TSPFILE - IF CUST-STAT NOT = "00" - AND CUST-STAT NOT = "05" - DISPLAY "Error " CUST-STAT - " opening 'testisam' file" UPON CONSOLE - STOP RUN - END-IF. - - PERFORM 1000-LOAD-RECORD - VARYING SUB FROM 1 BY 1 - UNTIL SUB > MAX-SUB. - - DISPLAY "Sample data file load complete." - UPON CONSOLE. - CLOSE TSPFILE. - - *---------------------------------------------------------------* - * LOAD A RECORD FROM DATA TABLES * - *---------------------------------------------------------------* - - 1000-LOAD-RECORD. - MOVE SPACES TO TSPFL-RECORD. - MOVE DATA-CUST-NUM (SUB) TO CM-CUST-NUM. - MOVE CM-CUST-NUM TO TSPFL-KEY. - MOVE DATA-COMPANY (SUB) TO CM-COMPANY. - MOVE DATA-ADDRESS-1 (SUB) TO CM-ADDRESS-1. - MOVE DATA-ADDRESS-2 (SUB) TO CM-ADDRESS-2. - MOVE DATA-ADDRESS-3 (SUB) TO CM-ADDRESS-3. - MOVE DATA-TELEPHONE (SUB) TO CM-TELEPHONE. - MOVE DATA-DP-MGR (SUB) TO CM-DP-MGR. - MOVE DATA-MACHINE (SUB) TO CM-MACHINE. - - IF ODD-RECORD - MOVE "8417" TO CM-DISK - MOVE "1600 BPI" TO CM-TAPE - MOVE "1MEG" TO CM-MEMORY - ELSE - MOVE "8470" TO CM-DISK - MOVE "6250 BPI" TO CM-TAPE - MOVE "3MEG" TO CM-MEMORY - END-IF. - IF SUB = 1 OR 6 OR 12 - MOVE "2417" TO CM-DISK - MOVE "549 mmm" TO CM-TAPE - END-IF. - IF SUB = 6 - MOVE "749 mmm" TO CM-TAPE - END-IF. - - WRITE TSPFL-RECORD - IF CUST-STAT = "22" - DISPLAY "WRITE: " TSPFL-KEY ", Duplicate Status: " - CUST-STAT " Phone=" CM-TELEPHONE "." - UPON CONSOLE - ELSE - IF CUST-STAT NOT = "00" - AND CUST-STAT NOT = "02" - DISPLAY "WRITE: " TSPFL-KEY ", Status: " - CUST-STAT UPON CONSOLE - END-IF. - - LISTFILE. - DISPLAY "LIST SAMPLE FILE" UPON CONSOLE. - MOVE ZERO TO REC-NUM - OPEN INPUT TSPFILE - IF CUST-STAT NOT = "00" - DISPLAY "ERROR " CUST-STAT " OPENING INPUT FILE" - UPON CONSOLE - STOP RUN - END-IF. - MOVE SPACES TO TSPFL-RECORD. - START TSPFILE KEY GREATER THAN CM-CUST-NUM - IF CUST-STAT NOT = "00" - DISPLAY "Error " CUST-STAT " starting file" - UPON CONSOLE - STOP RUN - END-IF. - READ TSPFILE NEXT RECORD WITH NO LOCK - IF CUST-STAT NOT = "00" - DISPLAY "Error " CUST-STAT " on 1st read of file" - UPON CONSOLE - STOP RUN - END-IF. - PERFORM UNTIL CUST-STAT NOT = "00" - DISPLAY "Key: " CM-CUST-NUM " is " CM-COMPANY - " Disk=" CM-DISK - " Phone=" CM-TELEPHONE "." - UPON CONSOLE - READ TSPFILE NEXT RECORD - AT END - MOVE "99" TO CUST-STAT - END-READ - ADD 1 TO REC-NUM - END-PERFORM - IF CUST-STAT = "99" - DISPLAY "Hit End of File after " REC-NUM UPON CONSOLE - END-IF. - - MOVE ZERO TO REC-NUM - OPEN INPUT TSPFILE - DISPLAY "LIST SAMPLE FILE BY KEY2" UPON CONSOLE. - MOVE ZERO TO REC-NUM - MOVE SPACES TO TSPFL-RECORD. - START TSPFILE KEY GREATER THAN OR EQUAL TO CM-TELEPHONE - IF CUST-STAT NOT = "00" - AND CUST-STAT NOT = "02" - DISPLAY "Error " CUST-STAT " starting file" - UPON CONSOLE - STOP RUN - END-IF. - READ TSPFILE NEXT RECORD - IF CUST-STAT NOT = "00" - AND CUST-STAT NOT = "02" - DISPLAY "Error " CUST-STAT " on 1st read of file" - UPON CONSOLE - STOP RUN - END-IF. - PERFORM UNTIL (CUST-STAT NOT = "00" - AND CUST-STAT NOT = "02") - DISPLAY "Key: " CM-CUST-NUM " is " CM-COMPANY - " Phone=" CM-TELEPHONE "." - UPON CONSOLE - READ TSPFILE NEXT RECORD - AT END - MOVE "99" TO CUST-STAT - END-READ - ADD 1 TO REC-NUM - END-PERFORM. - IF CUST-STAT = "99" - DISPLAY "Hit End of File after " REC-NUM UPON CONSOLE - END-IF. - CLOSE TSPFILE. - MOVE ZERO TO REC-NUM - OPEN INPUT TSPFILE - DISPLAY "LIST SAMPLE FILE BY KEY3" UPON CONSOLE. - MOVE ZERO TO REC-NUM - MOVE SPACES TO TSPFL-RECORD. - START TSPFILE KEY GREATER THAN OR EQUAL TO SPLIT-KEY3 - IF CUST-STAT NOT = "00" - AND CUST-STAT NOT = "02" - DISPLAY "Error " CUST-STAT " starting file" - UPON CONSOLE - STOP RUN - END-IF. - READ TSPFILE NEXT RECORD - IF CUST-STAT NOT = "00" - AND CUST-STAT NOT = "02" - DISPLAY "Error " CUST-STAT " on 1st read of file" - UPON CONSOLE - STOP RUN - END-IF. - PERFORM UNTIL (CUST-STAT NOT = "00" - AND CUST-STAT NOT = "02") - DISPLAY "Key: " CM-CUST-NUM " is " CM-COMPANY - " Disk=" CM-DISK - " Tape=" CM-TAPE "." - UPON CONSOLE - READ TSPFILE NEXT RECORD - AT END - MOVE "99" TO CUST-STAT - END-READ - ADD 1 TO REC-NUM - END-PERFORM. - IF CUST-STAT = "99" - DISPLAY "Hit End of File after " REC-NUM UPON CONSOLE - END-IF. - CLOSE TSPFILE. -_ATEOF - - -# FIXME: the syntax check part should be in syn_file.at, allowing to -# skip this test early and remove -Wno-unsupported. -{ set +x -$as_echo "$at_srcdir/run_file.at:1966: \$COMPILE -Wno-unsupported prog.cob" -at_fn_check_prepare_dynamic "$COMPILE -Wno-unsupported prog.cob" "run_file.at:1966" -( $at_check_trace; $COMPILE -Wno-unsupported prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_file.at:1966" -$at_failed && at_fn_log_failure -$at_traceon; } - - -$as_echo "run_file.at:1968" >"$at_check_line_file" -(test "$COB_HAS_ISAM" = "no") \ - && at_fn_check_skip 77 "$at_srcdir/run_file.at:1968" - -{ set +x -$as_echo "$at_srcdir/run_file.at:1970: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_file.at:1970" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo "Loading sample data file. -WRITE: FOR00000, Duplicate Status: 22 Phone=8009329492. -Sample data file load complete. -LIST SAMPLE FILE -Key: ALP00000 is ALPHA ELECTRICAL CO. LTD. Disk=2417 Phone=3131234432. -Key: BET00000 is BETA SHOE MFG. INC. Disk=8470 Phone=4082938498. -Key: DEL00000 is DELTA LUGGAGE REPAIRS Disk=8470 Phone=7169898509. -Key: EPS00000 is EPSILON EQUIPMENT SUPPLY Disk=8417 Phone=5292398745. -Key: GAM00000 is GAMMA X-RAY TECHNOLOGY Disk=8417 Phone=8009329492. -Key: GIB00000 is GIBRALTER LIFE INSURANCE Disk=8417 Phone=6456445643. -Key: H&J00000 is H & J PLUMBING SUPPLIES Disk=8470 Phone=9005556969. -Key: INC00000 is INCREMENTAL BACKUP CORP. Disk=8417 Phone=9005556970. -Key: JOH00000 is JOHNSON BOATING SUPPLIES Disk=8417 Phone=6456445649. -Key: KON00000 is KONFLAB PLASTIC PRODUCTS. Disk=8417 Phone=7456434355. -Key: LEW00000 is LEWISTON GRAPHICS LTD. Disk=2417 Phone=9005556969. -Key: MOR00000 is MORNINGSIDE CARPENTRY. Disk=8470 Phone=4169898507. -Key: NEW00000 is NEW WAVE SURF SHOPS INC. Disk=8470 Phone=7534587453. -Key: OLD00000 is OLD TYME PIZZA MFG. CO. Disk=8470 Phone=9005556969. -Key: PRE00000 is PRESTIGE OFFICE FURNITURE Disk=8470 Phone=4169898509. -Hit End of File after 15 -LIST SAMPLE FILE BY KEY2 -Key: ALP00000 is ALPHA ELECTRICAL CO. LTD. Phone=3131234432. -Key: BET00000 is BETA SHOE MFG. INC. Phone=4082938498. -Key: MOR00000 is MORNINGSIDE CARPENTRY. Phone=4169898507. -Key: PRE00000 is PRESTIGE OFFICE FURNITURE Phone=4169898509. -Key: EPS00000 is EPSILON EQUIPMENT SUPPLY Phone=5292398745. -Key: GIB00000 is GIBRALTER LIFE INSURANCE Phone=6456445643. -Key: JOH00000 is JOHNSON BOATING SUPPLIES Phone=6456445649. -Key: DEL00000 is DELTA LUGGAGE REPAIRS Phone=7169898509. -Key: KON00000 is KONFLAB PLASTIC PRODUCTS. Phone=7456434355. -Key: NEW00000 is NEW WAVE SURF SHOPS INC. Phone=7534587453. -Key: GAM00000 is GAMMA X-RAY TECHNOLOGY Phone=8009329492. -Hit End of File after 11 -LIST SAMPLE FILE BY KEY3 -Key: ALP00000 is ALPHA ELECTRICAL CO. LTD. Disk=2417 Tape=549 mmm. -Key: LEW00000 is LEWISTON GRAPHICS LTD. Disk=2417 Tape=549 mmm. -Key: BET00000 is BETA SHOE MFG. INC. Disk=8470 Tape=6250 BPI. -Key: DEL00000 is DELTA LUGGAGE REPAIRS Disk=8470 Tape=6250 BPI. -Key: H&J00000 is H & J PLUMBING SUPPLIES Disk=8470 Tape=6250 BPI. -Key: MOR00000 is MORNINGSIDE CARPENTRY. Disk=8470 Tape=6250 BPI. -Key: NEW00000 is NEW WAVE SURF SHOPS INC. Disk=8470 Tape=6250 BPI. -Key: OLD00000 is OLD TYME PIZZA MFG. CO. Disk=8470 Tape=6250 BPI. -Key: PRE00000 is PRESTIGE OFFICE FURNITURE Disk=8470 Tape=6250 BPI. -Hit End of File after 09 -" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_file.at:1970" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_713 -#AT_START_714 -at_fn_group_banner 714 'run_file.at:2019' \ - "INDEXED File Sparse/Split keys" " " 4 -at_xfail=no -( - $as_echo "714. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - INPUT-OUTPUT SECTION. - FILE-CONTROL. - SELECT file1 ORGANIZATION SEQUENTIAL - ASSIGN "./file1". - SELECT file2 ORGANIZATION SEQUENTIAL - ASSIGN "./file2". - SELECT file3 ASSIGN DISK. - DATA DIVISION. - FILE SECTION. - FD file1 RECORD VARYING FROM 3 TO 12 DEPENDING rsz. - 1 file1-rec pic x(12). - FD file2 RECORD VARYING FROM 3 TO 12 DEPENDING rsz. - 1 file2-rec pic x(12). - SD file3 RECORD VARYING FROM 3 TO 12 DEPENDING rsz. - 1 file3-rec. - 2 file3-key1 pic x. - 2 file3-key2 pic 9. - 2 filler pic x(10). - WORKING-STORAGE SECTION. - 77 rsz pic 99. - 1 1-data. - 2 filler pic x(14) VALUE "03A4X". - 2 filler pic x(14) VALUE "04A3XX". - 2 filler pic x(14) VALUE "05A2XXX". - 2 filler pic x(14) VALUE "06A1XXXX". - 2 filler pic x(14) VALUE "07A0XXXXX". - 2 filler pic x(14) VALUE "08B2XXXXXX". - 2 filler pic x(14) VALUE "09B1XXXXXXX". - 2 filler pic x(14) VALUE "10C2XXXXXXXX". - 2 filler pic x(14) VALUE "11C1XXXXXXXXX". - 2 filler pic x(14) VALUE "12Z9XXXXXXXXXX". - * - 1 filler redefines 1-data. - 2 filler occurs 10 times indexed by ix-1. - 3 1-rsz pic 99. - 3 1-rec pic x(12). - - PROCEDURE DIVISION. - OPEN OUTPUT file1. - PERFORM VARYING ix-1 FROM 1 BY 2 UNTIL ix-1 > 10 - MOVE 1-rsz(ix-1) TO rsz - MOVE 1-rec(ix-1) TO file1-rec - WRITE file1-rec - END-PERFORM. - PERFORM VARYING ix-1 FROM 2 BY 2 UNTIL ix-1 > 10 - MOVE 1-rsz(ix-1) TO rsz - MOVE 1-rec(ix-1) TO file1-rec - WRITE file1-rec - END-PERFORM. - CLOSE file1. - SORT file3 ON ASCENDING file3-key1 - DESCENDING file3-key2 - USING file1 - GIVING file2. - OPEN INPUT file2. - PERFORM VARYING ix-1 FROM 1 BY 1 UNTIL ix-1 > 10 - READ file2 - *>> fileio-sort currently returns constant length records - MOVE 1-rsz(ix-1) TO rsz - *>> END-OF-DETOUR - IF (1-rsz(ix-1) <> rsz) or - (1-rec(ix-1) <> file2-rec) - DISPLAY "FAILED" - END-IF - END-PERFORM. - CLOSE file2. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_file.at:2095: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_file.at:2095" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_file.at:2095" -$at_failed && at_fn_log_failure -$at_traceon; } - - -$as_echo "run_file.at:2097" >"$at_check_line_file" -(test "$COB_HAS_ISAM" = "no") \ - && at_fn_check_skip 77 "$at_srcdir/run_file.at:2097" - -{ set +x -$as_echo "$at_srcdir/run_file.at:2099: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_file.at:2099" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_file.at:2099" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_714 -#AT_START_715 -at_fn_group_banner 715 'run_file.at:2104' \ - "File SORT, LINE SEQUENTIAL" " " 4 -at_xfail=no -( - $as_echo "715. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -# Note: We shouldn't use AT_DATA to create sequential record -# data, because AT_DATA needs a \n at the end - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - INPUT-OUTPUT SECTION. - FILE-CONTROL. - SELECT SORT-IN ASSIGN "test.txt" - ORGANISATION LINE SEQUENTIAL. - SELECT SORT-OUT ASSIGN "result.txt" - ORGANISATION LINE SEQUENTIAL. - SELECT SORT-WRK ASSIGN "SORT-WRK". - DATA DIVISION. - FILE SECTION. - FD SORT-IN. - 01 IN-REC PIC X(20). - FD SORT-OUT. - 01 OUT-REC PIC X(20). - SD SORT-WRK. - 01 WRK-REC PIC X(6). - PROCEDURE DIVISION. - - * Special case: write test data in COBOL, see note above - OPEN OUTPUT SORT-IN. - WRITE IN-REC FROM SPACES END-WRITE. - WRITE IN-REC FROM SPACES END-WRITE. - WRITE IN-REC FROM "world " END-WRITE. - WRITE IN-REC FROM SPACES END-WRITE. - WRITE IN-REC FROM "hello " END-WRITE. - WRITE IN-REC FROM SPACES END-WRITE. - WRITE IN-REC FROM SPACES END-WRITE. - CLOSE SORT-IN. - - SORT SORT-WRK - ASCENDING KEY WRK-REC - USING SORT-IN - GIVING SORT-OUT. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_file.at:2149: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_file.at:2149" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_file.at:2149" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_file.at:2150: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_file.at:2150" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_file.at:2150" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_file.at:2151: cat result.txt" -at_fn_check_prepare_trace "run_file.at:2151" -( $at_check_trace; cat result.txt -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo " - - - - -hello -world -" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_file.at:2151" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_715 -#AT_START_716 -at_fn_group_banner 716 'run_file.at:2163' \ - "File SORT, LINE SEQUENTIAL same file" " " 4 -at_xfail=no -( - $as_echo "716. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >test.txt <<'_ATEOF' - -bla -world -hello - -blubb -_ATEOF - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - INPUT-OUTPUT SECTION. - FILE-CONTROL. - SELECT SORT-IN ASSIGN "test.txt" - ORGANISATION LINE SEQUENTIAL. - SELECT SORT-WRK ASSIGN "dummy". - DATA DIVISION. - FILE SECTION. - FD SORT-IN. - 01 IN-REC PIC X(6). - SD SORT-WRK. - 01 sort-entry PIC X(6). - PROCEDURE DIVISION. - SORT SORT-WRK - ASCENDING sort-entry - USING SORT-IN - GIVING SORT-IN. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_file.at:2197: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_file.at:2197" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_file.at:2197" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_file.at:2198: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_file.at:2198" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_file.at:2198" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_file.at:2199: cat test.txt" -at_fn_check_prepare_trace "run_file.at:2199" -( $at_check_trace; cat test.txt -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo " - -bla -blubb -hello -world -" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_file.at:2199" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_716 -#AT_START_717 -at_fn_group_banner 717 'run_file.at:2210' \ - "File SORT, LINE SEQUENTIAL variable records" " " 4 -at_xfail=no -( - $as_echo "717. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >file1 <<'_ATEOF' -A1XXXX -A2XXX -A3XX -Z9XXXXXXXXXX -A4X -B1XXXXXXX -B2XXXXXX -A0XXXXX -C1XXXXXXXXX -C2XXXXXXXX -_ATEOF - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - INPUT-OUTPUT SECTION. - FILE-CONTROL. - SELECT file1 ORGANIZATION LINE SEQUENTIAL - ASSIGN "./file1". - SELECT file2 ORGANIZATION LINE SEQUENTIAL - ASSIGN "./file2". - SELECT file3 ASSIGN DISK. - DATA DIVISION. - FILE SECTION. - FD file1. - 1 file1-rec pic x(12). - FD file2. - 1 file2-rec pic x(12). - SD file3. - 1 file3-rec. - 2 file3-key1 pic x. - 2 file3-key2 pic 9. - 2 filler pic x(10). - PROCEDURE DIVISION. - SORT file3 ON ASCENDING file3-key1 - DESCENDING file3-key2 - USING file1 - GIVING file2. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_file.at:2256: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_file.at:2256" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_file.at:2256" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_file.at:2257: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_file.at:2257" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_file.at:2257" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_file.at:2258: cat file2" -at_fn_check_prepare_trace "run_file.at:2258" -( $at_check_trace; cat file2 -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo "A4X -A3XX -A2XXX -A1XXXX -A0XXXXX -B2XXXXXX -B1XXXXXXX -C2XXXXXXXX -C1XXXXXXXXX -Z9XXXXXXXXXX -" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_file.at:2258" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_717 -#AT_START_718 -at_fn_group_banner 718 'run_file.at:2274' \ - "File MERGE, LINE SEQUENTIAL variable records" " " 4 -at_xfail=no -( - $as_echo "718. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >file1 <<'_ATEOF' -A1XXXX -A2XXX -A3XX -Z9XXXXXXXXXX -A4X -B1XXXXXXX -B2XXXXXX -A0XXXXX -C1XXXXXXXXX -C2XXXXXXXX -_ATEOF - - -cat >file2 <<'_ATEOF' -A1**** -A2*** -A3** -Z9********** -A4* -B1******* -B2****** -A0***** -C1********* -C2******** -_ATEOF - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - INPUT-OUTPUT SECTION. - FILE-CONTROL. - SELECT file1 ORGANIZATION LINE SEQUENTIAL - ASSIGN "./file1". - SELECT file2 ORGANIZATION LINE SEQUENTIAL - ASSIGN "./file2". - SELECT file3 ORGANIZATION LINE SEQUENTIAL - ASSIGN "./file3". - SELECT file4 ASSIGN DISK. - DATA DIVISION. - FILE SECTION. - FD file1. - 1 file1-rec pic x(12). - FD file2. - 1 file2-rec pic x(12). - FD file3. - 1 file3-rec pic x(12). - SD file4. - 1 file4-rec. - 2 file4-key1 pic x. - 2 file4-key2 pic 9. - 2 filler pic x(10). - PROCEDURE DIVISION. - MERGE file4 ON ASCENDING file4-key1 - DESCENDING file4-key2 - USING file1 file2 - GIVING file3. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_file.at:2337: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_file.at:2337" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_file.at:2337" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_file.at:2338: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_file.at:2338" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_file.at:2338" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_file.at:2339: cat file3" -at_fn_check_prepare_trace "run_file.at:2339" -( $at_check_trace; cat file3 -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo "A4X -A4* -A3XX -A3** -A2XXX -A2*** -A1XXXX -A1**** -A0XXXXX -A0***** -B2XXXXXX -B2****** -B1XXXXXXX -B1******* -C2XXXXXXXX -C2******** -C1XXXXXXXXX -C1********* -Z9XXXXXXXXXX -Z9********** -" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_file.at:2339" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_718 -#AT_START_719 -at_fn_group_banner 719 'run_file.at:2365' \ - "SORT nonexistent file" " " 4 -at_xfail=no -( - $as_echo "719. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - INPUT-OUTPUT SECTION. - FILE-CONTROL. - SELECT SORT-IN ASSIGN "SORT-IN". - SELECT SORT-OUT ASSIGN "SORT-OUT". - SELECT SORT-WRK ASSIGN "SORT-WRK". - DATA DIVISION. - FILE SECTION. - FD SORT-IN. - 01 IN-REC PIC X(100). - FD SORT-OUT. - 01 OUT-REC PIC X(100). - SD SORT-WRK. - 01 WRK-REC PIC X(100). - PROCEDURE DIVISION. - SORT SORT-WRK - ASCENDING KEY WRK-REC - USING SORT-IN - GIVING SORT-OUT. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_file.at:2393: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_file.at:2393" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_file.at:2393" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_file.at:2394: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_file.at:2394" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_file.at:2394" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_file.at:2395: cat SORT-OUT" -at_fn_check_prepare_trace "run_file.at:2395" -( $at_check_trace; cat SORT-OUT -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_file.at:2395" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_719 -#AT_START_720 -at_fn_group_banner 720 'run_file.at:2400' \ - "SORT with INPUT/OUTPUT PROCEDUREs" " " 4 -at_xfail=no -( - $as_echo "720. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - INPUT-OUTPUT SECTION. - FILE-CONTROL. - SELECT file1 ASSIGN DISK. - DATA DIVISION. - FILE SECTION. - SD file1. - 1 file1-rec. - 2 file1-key pic 9(4). - 2 file1-data pic x(10). - WORKING-STORAGE SECTION. - 77 w-eof pic 9 value 0. - 1 1-values. - 2 filler pic x(14) value "0001A--------A". - 2 filler pic x(14) value "0002B--------B". - 2 filler pic x(14) value "0003C--------C". - 2 filler pic x(14) value "0004D--------D". - 2 filler pic x(14) value "0005E--------E". - 2 filler pic x(14) value "0006F--------F". - 2 filler pic x(14) value "0007G--------G". - 2 filler pic x(14) value "0008H--------H". - 2 filler pic x(14) value "0009I--------I". - 2 filler pic x(14) value "0010J--------J". - 2 filler pic x(14) value "0011K--------K". - 2 filler pic x(14) value "0012L--------L". - 2 filler pic x(14) value "0013M--------M". - 2 filler pic x(14) value "0014N--------N". - 2 filler pic x(14) value "0015O--------O". - 2 filler pic x(14) value "0016P--------P". - 2 filler pic x(14) value "0017Q--------Q". - 2 filler pic x(14) value "0018R--------R". - 2 filler pic x(14) value "0019S--------S". - 2 filler pic x(14) value "0020T--------T". - 2 filler pic x(14) value "0021U--------U". - 2 filler pic x(14) value "0022V--------V". - 2 filler pic x(14) value "0023W--------W". - 2 filler pic x(14) value "0024X--------X". - 2 filler pic x(14) value "0025Y--------Y". - 2 filler pic x(14) value "0026Z--------Z". - 1 filler redefines 1-values. - 2 1-record occurs 26 times indexed by ix-1. - 3 1-key pic 9(4). - 3 1-data pic x(10). - PROCEDURE DIVISION. - a01-main. - SORT file1 ON ASCENDING file1-key - INPUT PROCEDURE a02-release-to-sort - OUTPUT PROCEDURE a03-return-from-sort. - STOP RUN. - * - a02-release-to-sort. - PERFORM VARYING ix-1 FROM 1 BY 2 UNTIL ix-1 > 26 - RELEASE file1-rec from 1-record(ix-1) - END-PERFORM. - PERFORM VARYING ix-1 FROM 2 BY 2 UNTIL ix-1 > 26 - RELEASE file1-rec from 1-record(ix-1) - END-PERFORM. - * - a03-return-from-sort. - PERFORM VARYING ix-1 FROM 1 BY 1 - UNTIL (ix-1 > 26) OR (w-eof = 1) - RETURN file1 RECORD - AT END MOVE 1 TO w-eof - END-RETURN - IF (file1-rec <> 1-record(ix-1)) - MOVE 1 TO w-eof - END-IF - END-PERFORM. - IF (w-eof = 1) - DISPLAY "FAILED: unexpected eof" - ELSE - RETURN file1 RECORD - AT END CONTINUE - NOT AT END DISPLAY "FAILED: expected eof" - END-RETURN - END-IF. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_file.at:2484: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_file.at:2484" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_file.at:2484" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_file.at:2485: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_file.at:2485" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_file.at:2485" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_720 -#AT_START_721 -at_fn_group_banner 721 'run_file.at:2490' \ - "SORT with key1 ASCENDING, key2 DESCENDING" " " 4 -at_xfail=no -( - $as_echo "721. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >file1 <<'_ATEOF' -A1 -A2 -A3 -Z9 -A4 -B1 -B2 -A0 -C1 -C2 -_ATEOF - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - INPUT-OUTPUT SECTION. - FILE-CONTROL. - SELECT file1 ORGANIZATION LINE SEQUENTIAL - ASSIGN "./file1". - SELECT file2 ORGANIZATION LINE SEQUENTIAL - ASSIGN "./file2". - SELECT file3 ASSIGN DISK. - DATA DIVISION. - FILE SECTION. - FD file1. - 1 file1-rec pic xxx. - FD file2. - 1 file2-rec pic xxx. - SD file3. - 1 file3-rec. - 2 file3-key1 pic x. - 2 file3-key2 pic 9. - 2 file3-dot pic x. - PROCEDURE DIVISION. - SORT file3 ON ASCENDING file3-key1 - DESCENDING file3-key2 - USING file1 - GIVING file2. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_file.at:2536: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_file.at:2536" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_file.at:2536" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_file.at:2537: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_file.at:2537" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_file.at:2537" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_file.at:2538: cat file2" -at_fn_check_prepare_trace "run_file.at:2538" -( $at_check_trace; cat file2 -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo "A4 -A3 -A2 -A1 -A0 -B2 -B1 -C2 -C1 -Z9 -" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_file.at:2538" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_721 -#AT_START_722 -at_fn_group_banner 722 'run_file.at:2554' \ - "ASSIGN with LOCAL-STORAGE item" " " 4 -at_xfail=no -( - $as_echo "722. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >test.txt <<'_ATEOF' -hello -_ATEOF - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - INPUT-OUTPUT SECTION. - FILE-CONTROL. - SELECT test-file ASSIGN path - ORGANIZATION LINE SEQUENTIAL. - DATA DIVISION. - FILE SECTION. - FD test-file. - 01 test-rec PIC X(5). - LOCAL-STORAGE SECTION. - 01 path PIC X(10) VALUE "test.txt". - PROCEDURE DIVISION. - OPEN INPUT test-file - READ test-file END-READ - IF test-rec NOT = "hello" - DISPLAY test-rec END-DISPLAY - END-IF - CLOSE test-file - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_file.at:2585: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_file.at:2585" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_file.at:2585" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_file.at:2586: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_file.at:2586" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_file.at:2586" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_722 -#AT_START_723 -at_fn_group_banner 723 'run_file.at:2591' \ - "ASSIGN with LOCAL-STORAGE item and INITIAL prog" "" 4 -at_xfail=no -( - $as_echo "723. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -# Files are initialised in a different location in INITIAL program, hence the -# need for a separate test. - -cat >test.txt <<'_ATEOF' -hello -_ATEOF - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog INITIAL. - ENVIRONMENT DIVISION. - INPUT-OUTPUT SECTION. - FILE-CONTROL. - SELECT test-file ASSIGN path - ORGANIZATION LINE SEQUENTIAL. - DATA DIVISION. - FILE SECTION. - FD test-file. - 01 test-rec PIC X(5). - LOCAL-STORAGE SECTION. - 01 path PIC X(10) VALUE "test.txt". - PROCEDURE DIVISION. - OPEN INPUT test-file - READ test-file END-READ - IF test-rec NOT = "hello" - DISPLAY test-rec END-DISPLAY - END-IF - CLOSE test-file - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_file.at:2625: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_file.at:2625" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_file.at:2625" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_file.at:2626: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_file.at:2626" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_file.at:2626" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_723 -#AT_START_724 -at_fn_group_banner 724 'run_file.at:2631' \ - "ASSIGN with BASED data item and CHAINING" " " 4 -at_xfail=no -( - $as_echo "724. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >TEST-FILE <<'_ATEOF' -hello -_ATEOF - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - INPUT-OUTPUT SECTION. - FILE-CONTROL. - SELECT test-file ASSIGN path - ORGANIZATION LINE SEQUENTIAL. - DATA DIVISION. - FILE SECTION. - FD test-file. - 01 test-rec PIC X(5). - WORKING-STORAGE SECTION. - 01 path BASED PIC X(10). - 01 x PIC X. - PROCEDURE DIVISION CHAINING x. - IF x NOT = SPACES - ALLOCATE path - MOVE "TEST-FILE" TO path - OPEN INPUT test-file - FREE path - ELSE - OPEN INPUT test-file - END-IF - READ test-file END-READ - IF test-rec NOT = "hello" - DISPLAY test-rec END-DISPLAY - END-IF - CLOSE test-file - STOP RUN. -_ATEOF - - -cat >prog2.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog2. - ENVIRONMENT DIVISION. - INPUT-OUTPUT SECTION. - FILE-CONTROL. - SELECT test-file ASSIGN path - ORGANIZATION LINE SEQUENTIAL - FILE STATUS TEST-STAT. - DATA DIVISION. - FILE SECTION. - FD test-file. - 01 test-rec PIC X(5). - WORKING-STORAGE SECTION. - 01 path BASED PIC X(10). - 01 test-stat PIC X(2) VALUE "XX". - PROCEDURE DIVISION. - OPEN INPUT test-file - IF TEST-STAT NOT = '31' - DISPLAY 'BAD OPEN, STATUS "' test-stat '"' END-DISPLAY - END-IF - READ test-file END-READ - IF TEST-STAT NOT = '47' - DISPLAY 'BAD READ, STATUS "' test-stat '"' END-DISPLAY - END-IF - CLOSE test-file - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_file.at:2699: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_file.at:2699" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_file.at:2699" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_file.at:2700: \$COBCRUN_DIRECT ./prog X" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog X" "run_file.at:2700" -( $at_check_trace; $COBCRUN_DIRECT ./prog X -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_file.at:2700" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_file.at:2701: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_file.at:2701" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "libcob: prog.cob:23: error: inconsistant file name (status = 31) for file test-file ('field with NULL address') on OPEN -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/run_file.at:2701" -$at_failed && at_fn_log_failure -$at_traceon; } - - -{ set +x -$as_echo "$at_srcdir/run_file.at:2705: \$COMPILE prog2.cob" -at_fn_check_prepare_dynamic "$COMPILE prog2.cob" "run_file.at:2705" -( $at_check_trace; $COMPILE prog2.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_file.at:2705" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_file.at:2706: \$COBCRUN_DIRECT ./prog2" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog2" "run_file.at:2706" -( $at_check_trace; $COBCRUN_DIRECT ./prog2 -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_file.at:2706" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_724 -#AT_START_725 -at_fn_group_banner 725 'run_file.at:2711' \ - "ASSIGN with data item in LINKAGE" " " 4 -at_xfail=no -( - $as_echo "725. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - - ENVIRONMENT DIVISION. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 f-path PIC X(80) VALUE "fooasg.txt". - 01 x-path PIC X(80) VALUE "foxasg.txt". - 01 y-path PIC X(80) VALUE "foyasg.txt". - 01 REC1 PIC 9(4) VALUE 1. - 01 REC2 PIC 9(4) VALUE 2. - 01 CUST-STAT PIC X(2) VALUE "XX". - - PROCEDURE DIVISION. - CALL "TSTOPN" USING OMITTED. - CALL "TSTOPN" USING y-path. - CALL "TSTOPEN" USING f-path REC1 CUST-STAT. - CALL "TSTOPEN" USING x-path REC1 CUST-STAT. - CALL "TSTOPEN" USING OMITTED REC1 CUST-STAT. - CALL "TSTOPEN" USING f-path REC2 CUST-STAT. - CALL "TSTOPEN" USING x-path REC2 CUST-STAT. - STOP RUN. - END PROGRAM prog. - - IDENTIFICATION DIVISION. - PROGRAM-ID. TSTOPEN. - - ENVIRONMENT DIVISION. - INPUT-OUTPUT SECTION. - FILE-CONTROL. - SELECT f ASSIGN s-path - ORGANIZATION RELATIVE - ACCESS IS RANDOM - RELATIVE KEY IS REC-NUM - FILE STATUS IS CUST-STAT. - - DATA DIVISION. - FILE SECTION. - FD f. - 01 f-line PIC X(79). - - WORKING-STORAGE SECTION. - 01 z-path PIC X(80) VALUE "foozzz.txt". - - LINKAGE SECTION. - 01 s-path PIC X(80). - 01 REC-NUM PIC 9(4). - 01 CUST-STAT PIC X(2). - - PROCEDURE DIVISION USING s-path, REC-NUM, CUST-STAT. - IF ADDRESS OF s-path = NULL - SET ADDRESS OF s-path TO ADDRESS OF z-path - END-IF. - IF REC-NUM > 1 - OPEN I-O f - DISPLAY "Extend file: " s-path(1:10) - " - " CUST-STAT " #" REC-NUM "." - ELSE - OPEN OUTPUT f - DISPLAY "Output file: " s-path(1:10) - " - " CUST-STAT " #" REC-NUM "." - END-IF. - IF CUST-STAT NOT = "00" - DISPLAY "Opened error: " CUST-STAT "." - GOBACK - END-IF. - MOVE "Hello World" TO f-line. - MOVE REC-NUM TO f-line (20:4). - WRITE f-line. - IF CUST-STAT NOT = "00" - DISPLAY "WRITE error: " CUST-STAT "." - END-IF. - CLOSE f. - GOBACK. - END PROGRAM TSTOPEN. - - IDENTIFICATION DIVISION. - PROGRAM-ID. TSTOPN. - - ENVIRONMENT DIVISION. - INPUT-OUTPUT SECTION. - FILE-CONTROL. - SELECT f ASSIGN s-path - ORGANIZATION LINE SEQUENTIAL - FILE STATUS IS IO-STS. - - DATA DIVISION. - FILE SECTION. - FD f. - 01 f-line PIC X(80). - - WORKING-STORAGE SECTION. - 01 IO-STS PIC X(2) VALUE "00". - - LINKAGE SECTION. - 01 s-path PIC X(80). - - PROCEDURE DIVISION USING s-path. - OPEN OUTPUT f - IF IO-STS NOT = "00" - DISPLAY "Opened error: " IO-STS "." - GOBACK - END-IF. - DISPLAY "Opened file: " s-path(1:10) ".". - MOVE "Hello World" TO f-line. - WRITE f-line. - CLOSE f. - GOBACK. - END PROGRAM TSTOPN. -_ATEOF - - -cat >prog2.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog2. - - ENVIRONMENT DIVISION. - DATA DIVISION. - WORKING-STORAGE SECTION. - - PROCEDURE DIVISION. - CALL "TSTOPEN" USING OMITTED. - STOP RUN. - END PROGRAM prog2. - - IDENTIFICATION DIVISION. - PROGRAM-ID. TSTOPEN. - - ENVIRONMENT DIVISION. - INPUT-OUTPUT SECTION. - FILE-CONTROL. - SELECT f ASSIGN s-path - ORGANIZATION SEQUENTIAL. - - DATA DIVISION. - FILE SECTION. - FD f. - 01 f-line PIC X(79). - - LINKAGE SECTION. - 01 s-path PIC X(80). - - PROCEDURE DIVISION USING s-path. - OPEN OUTPUT f - GOBACK. - END PROGRAM TSTOPEN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_file.at:2862: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_file.at:2862" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_file.at:2862" -$at_failed && at_fn_log_failure -$at_traceon; } - - -{ set +x -$as_echo "$at_srcdir/run_file.at:2864: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_file.at:2864" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo "Opened error: 31. -Opened file: foyasg.txt. -Output file: fooasg.txt - 00 #0001. -Output file: foxasg.txt - 00 #0001. -Output file: foozzz.txt - 00 #0001. -Extend file: fooasg.txt - 00 #0002. -Extend file: foxasg.txt - 00 #0002. -" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_file.at:2864" -$at_failed && at_fn_log_failure -$at_traceon; } - - -{ set +x -$as_echo "$at_srcdir/run_file.at:2874: \$COMPILE prog2.cob" -at_fn_check_prepare_dynamic "$COMPILE prog2.cob" "run_file.at:2874" -( $at_check_trace; $COMPILE prog2.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_file.at:2874" -$at_failed && at_fn_log_failure -$at_traceon; } - - -{ set +x -$as_echo "$at_srcdir/run_file.at:2876: \$COBCRUN_DIRECT ./prog2" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog2" "run_file.at:2876" -( $at_check_trace; $COBCRUN_DIRECT ./prog2 -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "libcob: prog2.cob:32: error: inconsistant file name (status = 31) for file f ('field with NULL address') on OPEN -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/run_file.at:2876" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_725 -#AT_START_726 -at_fn_group_banner 726 'run_file.at:2883' \ - "INDEXED file sparse/split keys" " " 4 -at_xfail=no -( - $as_echo "726. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -# FIXME: separate both test parts - -$as_echo "run_file.at:2888" >"$at_check_line_file" -(test "$COB_HAS_ISAM" = "no") \ - && at_fn_check_skip 77 "$at_srcdir/run_file.at:2888" - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - - PROGRAM-ID. prog. - - ENVIRONMENT DIVISION. - CONFIGURATION SECTION. - - INPUT-OUTPUT SECTION. - FILE-CONTROL. - SELECT TSPFILE - ASSIGN TO "testisam" - ORGANIZATION INDEXED ACCESS DYNAMIC - RECORD KEY IS PRIME-KEY - SOURCE IS CM-CUST-NUM, CM-COMPANY - - ALTERNATE RECORD KEY IS SPLIT-KEY2 - SOURCE IS CM-TELEPHONE,CM-MACHINE WITH DUPLICATES - - ALTERNATE RECORD KEY IS SPLIT-KEY3 - SOURCE IS CM-DISK,CM-TAPE WITH DUPLICATES - SUPPRESS WHEN ALL "*" - FILE STATUS IS CUST-STAT - . - - DATA DIVISION. - FILE SECTION. - FD TSPFILE - BLOCK CONTAINS 5 RECORDS. - - 01 TSPFL-RECORD. - 05 TSPFL-REC. - 10 CM-CUST-NUM PICTURE X(8). - 10 CM-STATUS PICTURE X. - 10 CM-COMPANY PICTURE X(25). - 10 CM-ADDRESS-1 PICTURE X(25). - 10 CM-ADDRESS-2 PICTURE X(25). - 10 CM-ADDRESS-3 PICTURE X(25). - 10 CM-TELEPHONE PICTURE 9(10). - 10 CM-DP-MGR PICTURE X(25). - 10 CM-MACHINE PICTURE X(8). - 10 CM-MEMORY PICTURE X(4). - 10 CM-DISK PICTURE X(8). - 10 CM-TAPE PICTURE X(8). - 10 CM-NO-TERMINALS PICTURE 9(5). - - WORKING-STORAGE SECTION. - - 01 CUST-STAT. - 05 STAT-1 PICTURE 9(4) COMP SYNC. - 05 FILLER REDEFINES STAT-1. - 10 STAT-X1 PIC X COMP-X. - 10 STAT-X2 PIC X COMP-X. - 77 BYTE-1 PICTURE 9(3). - 77 BYTE-2 PICTURE 9(3). - 77 MAX-SUB VALUE 16 PICTURE 9(5) COMP SYNC. - - 01 TEST-DATA. - - 02 DATA-CUST-NUM-TBL. - - 05 FILLER PIC X(8) VALUE "ALP00000". - 05 FILLER PIC X(8) VALUE "BET00000". - 05 FILLER PIC X(8) VALUE "GAM00000". - 05 FILLER PIC X(8) VALUE "DEL00000". - 05 FILLER PIC X(8) VALUE "EPS00000". - 05 FILLER PIC X(8) VALUE "FOR00000". - 05 FILLER PIC X(8) VALUE "GIB00000". - 05 FILLER PIC X(8) VALUE "H&J00000". - 05 FILLER PIC X(8) VALUE "INC00000". - 05 FILLER PIC X(8) VALUE "JOH00000". - 05 FILLER PIC X(8) VALUE "KON00000". - 05 FILLER PIC X(8) VALUE "LEW00000". - 05 FILLER PIC X(8) VALUE "MOR00000". - 05 FILLER PIC X(8) VALUE "NEW00000". - 05 FILLER PIC X(8) VALUE "OLD00000". - 05 FILLER PIC X(8) VALUE "PRE00000". - - 02 DATA-CUST-NUM REDEFINES DATA-CUST-NUM-TBL - PIC X(8) OCCURS 16. - 02 DATA-COMPANY-TBL. - - 05 FILLER PIC X(25) VALUE "ALPHA ELECTRICAL CO. LTD.". - 05 FILLER PIC X(25) VALUE "BETA SHOE MFG. INC. ". - 05 FILLER PIC X(25) VALUE "GAMMA X-RAY TECHNOLOGY ". - 05 FILLER PIC X(25) VALUE "DELTA LUGGAGE REPAIRS ". - 05 FILLER PIC X(25) VALUE "EPSILON EQUIPMENT SUPPLY ". - 05 FILLER PIC X(25) VALUE "FORTUNE COOKIE COMPANY ". - 05 FILLER PIC X(25) VALUE "GIBRALTER LIFE INSURANCE ". - 05 FILLER PIC X(25) VALUE "H & J PLUMBING SUPPLIES ". - 05 FILLER PIC X(25) VALUE "INCREMENTAL BACKUP CORP. ". - 05 FILLER PIC X(25) VALUE "JOHNSON BOATING SUPPLIES ". - 05 FILLER PIC X(25) VALUE "KONFLAB PLASTIC PRODUCTS.". - 05 FILLER PIC X(25) VALUE "LEWISTON GRAPHICS LTD. ". - 05 FILLER PIC X(25) VALUE "MORNINGSIDE CARPENTRY. ". - 05 FILLER PIC X(25) VALUE "NEW WAVE SURF SHOPS INC. ". - 05 FILLER PIC X(25) VALUE "OLD TYME PIZZA MFG. CO. ". - 05 FILLER PIC X(25) VALUE "PRESTIGE OFFICE FURNITURE". - - 02 DATA-COMPANY REDEFINES DATA-COMPANY-TBL - PIC X(25) OCCURS 16. - 02 DATA-ADDRESS-1-TBL. - - 05 FILLER PIC X(25) VALUE "123 MAIN STREET ". - 05 FILLER PIC X(25) VALUE "1090 2ND AVE. WEST ". - 05 FILLER PIC X(25) VALUE "1401 JEFFERSON BLVD. ". - 05 FILLER PIC X(25) VALUE "1620 ARIZONA WAY ". - 05 FILLER PIC X(25) VALUE "1184 EAST FIRST STREET ". - 05 FILLER PIC X(25) VALUE "114 JOHN F. KENNEDY AVE. ". - 05 FILLER PIC X(25) VALUE "650 LIBERTY CRESCENT ". - 05 FILLER PIC X(25) VALUE "77 SUNSET BLVD. ". - 05 FILLER PIC X(25) VALUE "10908 SANTA MONICA BLVD. ". - 05 FILLER PIC X(25) VALUE "1134 PARIS ROAD ". - 05 FILLER PIC X(25) VALUE "808 NORTHWEST MAIN ST. ". - 05 FILLER PIC X(25) VALUE "9904 QUEEN STREET ". - 05 FILLER PIC X(25) VALUE "1709 DUNDAS CRESCENT W. ". - 05 FILLER PIC X(25) VALUE "3240 MARIS AVENUE ". - 05 FILLER PIC X(25) VALUE "1705 WISCONSIN ROAD ". - 05 FILLER PIC X(25) VALUE "114A MAPLE GROVE ". - - 02 DATA-ADDRESS-1 REDEFINES DATA-ADDRESS-1-TBL - PIC X(25) OCCURS 16. - 02 DATA-ADDRESS-2-TBL. - - 05 FILLER PIC X(10) VALUE "NEW YORK ". - 05 FILLER PIC X(10) VALUE "ATLANTA ". - 05 FILLER PIC X(10) VALUE "WASHINGTON". - 05 FILLER PIC X(10) VALUE "TORONTO ". - 05 FILLER PIC X(10) VALUE "CALGARY ". - 05 FILLER PIC X(10) VALUE "SAN DIEGO ". - 05 FILLER PIC X(10) VALUE "LOS RIOS ". - 05 FILLER PIC X(10) VALUE "MADISON ". - 05 FILLER PIC X(10) VALUE "WILBUR ". - 05 FILLER PIC X(10) VALUE "TOPEKA ". - 05 FILLER PIC X(10) VALUE "SEATTLE ". - 05 FILLER PIC X(10) VALUE "NEW JERSEY". - 05 FILLER PIC X(10) VALUE "FORT WAYNE". - 05 FILLER PIC X(10) VALUE "COLUMBUS ". - 05 FILLER PIC X(10) VALUE "RICHMOND ". - 05 FILLER PIC X(10) VALUE "WHITEPLAIN". - - 02 DATA-ADDRESS-2 REDEFINES DATA-ADDRESS-2-TBL - PIC X(10) OCCURS 16. - 02 DATA-ADDRESS-3-TBL. - - 05 FILLER PIC X(10) VALUE "N.Y. ". - 05 FILLER PIC X(10) VALUE "GEORGIA ". - 05 FILLER PIC X(10) VALUE "D.C. ". - 05 FILLER PIC X(10) VALUE "CANADA ". - 05 FILLER PIC X(10) VALUE "CANADA ". - 05 FILLER PIC X(10) VALUE "CALIFORNIA". - 05 FILLER PIC X(10) VALUE "NEW MEXICO". - 05 FILLER PIC X(10) VALUE "WISCONSIN ". - 05 FILLER PIC X(10) VALUE "DELAWARE ". - 05 FILLER PIC X(10) VALUE "KANSAS ". - 05 FILLER PIC X(10) VALUE "WASHINGTON". - 05 FILLER PIC X(10) VALUE "N.J. ". - 05 FILLER PIC X(10) VALUE "COLORADO ". - 05 FILLER PIC X(10) VALUE "OHIO ". - 05 FILLER PIC X(10) VALUE "VIRGINIA ". - 05 FILLER PIC X(10) VALUE "N.Y. ". - - 02 DATA-ADDRESS-3 REDEFINES DATA-ADDRESS-3-TBL - PIC X(10) OCCURS 16. - 02 DATA-TELEPHONE-TBL. - - 05 FILLER PIC 9(10) VALUE 3131234432. - 05 FILLER PIC 9(10) VALUE 4082938498. - 05 FILLER PIC 9(10) VALUE 8372487274. - 05 FILLER PIC 9(10) VALUE 4169898509. - 05 FILLER PIC 9(10) VALUE 5292398745. - 05 FILLER PIC 9(10) VALUE 8009329492. - 05 FILLER PIC 9(10) VALUE 6456445643. - 05 FILLER PIC 9(10) VALUE 6546456333. - 05 FILLER PIC 9(10) VALUE 3455445444. - 05 FILLER PIC 9(10) VALUE 6456445643. - 05 FILLER PIC 9(10) VALUE 7456434355. - 05 FILLER PIC 9(10) VALUE 6554456433. - 05 FILLER PIC 9(10) VALUE 4169898509. - 05 FILLER PIC 9(10) VALUE 7534587453. - 05 FILLER PIC 9(10) VALUE 8787458374. - 05 FILLER PIC 9(10) VALUE 4169898509. - - 02 DATA-TELEPHONE REDEFINES DATA-TELEPHONE-TBL - PIC 9(10) OCCURS 16. - 02 DATA-DP-MGR-TBL. - - 05 FILLER PIC X(20) VALUE "MR. DAVE HARRIS ". - 05 FILLER PIC X(20) VALUE "MS. JANICE SILCOX ". - 05 FILLER PIC X(20) VALUE "MR. ALLAN JONES ". - 05 FILLER PIC X(20) VALUE "MR. PETER MACKAY ". - 05 FILLER PIC X(20) VALUE "MRS. DONNA BREWER ". - 05 FILLER PIC X(20) VALUE "MR. MICHAEL SMYTHE ". - 05 FILLER PIC X(20) VALUE "MR. D.A. MORRISON ". - 05 FILLER PIC X(20) VALUE "MR. BRIAN PATTERSON ". - 05 FILLER PIC X(20) VALUE "MR. DARRYL TOWNSEND ". - 05 FILLER PIC X(20) VALUE "MS. VALERIE HARPER ". - 05 FILLER PIC X(20) VALUE "MR. FRED MILLER ". - 05 FILLER PIC X(20) VALUE "MR. DONALD FISCHER ". - 05 FILLER PIC X(20) VALUE "MR. STEVEN YOURDIN ". - 05 FILLER PIC X(20) VALUE "MS. Goldie Hawn ". - 05 FILLER PIC X(20) VALUE "MS. ALICE WINSTON ". - 05 FILLER PIC X(20) VALUE "MR. THOMAS JEFFERSON". - - 02 DATA-DP-MGR REDEFINES DATA-DP-MGR-TBL - PIC X(20) OCCURS 16. - 02 DATA-MACHINE-TBL. - - 05 FILLER PIC X(8) VALUE "UNI-9030". - 05 FILLER PIC X(8) VALUE "UNI-9040". - 05 FILLER PIC X(8) VALUE "UNI-80/3". - 05 FILLER PIC X(8) VALUE "UNI-80/5". - 05 FILLER PIC X(8) VALUE "UNI-80/6". - 05 FILLER PIC X(8) VALUE "UNI-80/6". - 05 FILLER PIC X(8) VALUE "UNI-80/6". - 05 FILLER PIC X(8) VALUE "UNI-80/8". - 05 FILLER PIC X(8) VALUE "UNI-80/8". - 05 FILLER PIC X(8) VALUE "UNI-80/8". - 05 FILLER PIC X(8) VALUE "UNI-80/8". - 05 FILLER PIC X(8) VALUE "UNI-80/8". - 05 FILLER PIC X(8) VALUE "UNI-80/8". - 05 FILLER PIC X(8) VALUE "UNI-80/8". - 05 FILLER PIC X(8) VALUE "UNI-9040". - 05 FILLER PIC X(8) VALUE "UNI-9040". - - 02 DATA-MACHINE REDEFINES DATA-MACHINE-TBL - PIC X(8) OCCURS 16. - 02 DATA-NO-TERMINALS-TBL. - - 05 FILLER PIC 9(3) COMP-3 VALUE 85. - 05 FILLER PIC 9(3) COMP-3 VALUE 34. - 05 FILLER PIC 9(3) COMP-3 VALUE 75. - 05 FILLER PIC 9(3) COMP-3 VALUE 45. - 05 FILLER PIC 9(3) COMP-3 VALUE 90. - 05 FILLER PIC 9(3) COMP-3 VALUE 107. - 05 FILLER PIC 9(3) COMP-3 VALUE 67. - 05 FILLER PIC 9(3) COMP-3 VALUE 32. - 05 FILLER PIC 9(3) COMP-3 VALUE 16. - 05 FILLER PIC 9(3) COMP-3 VALUE 34. - 05 FILLER PIC 9(3) COMP-3 VALUE 128. - 05 FILLER PIC 9(3) COMP-3 VALUE 64. - 05 FILLER PIC 9(3) COMP-3 VALUE 110. - 05 FILLER PIC 9(3) COMP-3 VALUE 324. - 05 FILLER PIC 9(3) COMP-3 VALUE 124. - 05 FILLER PIC 9(3) COMP-3 VALUE 86. - - 02 DATA-NO-TERMINALS REDEFINES DATA-NO-TERMINALS-TBL - PIC 9(3) COMP-3 OCCURS 16. - - 01 WORK-AREA. - 05 REC-NUM PICTURE 9(6) VALUE 0. - 05 REC-MAX PICTURE 9(6) VALUE 10. - 05 SUB PICTURE 9(4) COMP SYNC. - 88 ODD-RECORD VALUE 1 3 5 7 9 10 11. - 88 NULL-KEY VALUE 4 5 8 12 14. - - 05 TSPFL-KEY PICTURE X(8). - - PROCEDURE DIVISION. - - MAINFILE. - PERFORM LOADFILE. - PERFORM LISTFILE. - STOP RUN. - - LOADFILE. - DISPLAY "Loading sample data file." - UPON CONSOLE. - - OPEN OUTPUT TSPFILE - IF CUST-STAT NOT = "00" - DIVIDE STAT-1 BY 256 GIVING BYTE-1 REMAINDER BYTE-2 - DISPLAY "Error " CUST-STAT " " BYTE-1 " " BYTE-2 - " opening 'testisam' file" - UPON CONSOLE - STOP RUN - END-IF. - - PERFORM 1000-LOAD-RECORD - VARYING SUB FROM 1 BY 1 - UNTIL SUB > MAX-SUB. - - DISPLAY "Sample data file load complete." - UPON CONSOLE. - CLOSE TSPFILE. - - *---------------------------------------------------------------* - * LOAD A RECORD FROM DATA TABLES * - *---------------------------------------------------------------* - - 1000-LOAD-RECORD. - - MOVE SPACES TO TSPFL-RECORD. - MOVE DATA-CUST-NUM (SUB) TO CM-CUST-NUM. - MOVE CM-CUST-NUM TO TSPFL-KEY. - MOVE DATA-COMPANY (SUB) TO CM-COMPANY. - MOVE DATA-ADDRESS-1 (SUB) TO CM-ADDRESS-1. - MOVE DATA-ADDRESS-2 (SUB) TO CM-ADDRESS-2. - MOVE DATA-ADDRESS-3 (SUB) TO CM-ADDRESS-3. - MOVE DATA-TELEPHONE (SUB) TO CM-TELEPHONE. - MOVE DATA-DP-MGR (SUB) TO CM-DP-MGR. - MOVE DATA-MACHINE (SUB) TO CM-MACHINE. - MOVE DATA-NO-TERMINALS (SUB) TO CM-NO-TERMINALS. - - IF ODD-RECORD - MOVE "8417" TO CM-DISK - MOVE "1600 BPI" TO CM-TAPE - MOVE "1MEG" TO CM-MEMORY - ELSE - MOVE "8470" TO CM-DISK - MOVE "6250 BPI" TO CM-TAPE - MOVE "3MEG" TO CM-MEMORY. - IF NULL-KEY - MOVE ALL "*" TO CM-DISK - MOVE ALL "*" TO CM-TAPE. - - WRITE TSPFL-RECORD. - IF CUST-STAT NOT = "00" - AND CUST-STAT NOT = "02" - DISPLAY "Key: " TSPFL-KEY ", Status: " CUST-STAT - UPON CONSOLE. - - LISTFILE. - DISPLAY "LIST SAMPLE FILE" UPON CONSOLE. - MOVE ZERO TO REC-NUM - OPEN INPUT TSPFILE - IF CUST-STAT NOT = "00" - DISPLAY "ERROR " CUST-STAT " OPENING INPUT FILE " - UPON CONSOLE - IF CUST-STAT (1:1) = "9" - DISPLAY "Sub Error " STAT-X2 UPON CONSOLE - END-IF - STOP RUN - END-IF. - MOVE SPACES TO TSPFL-RECORD. - START TSPFILE KEY GREATER THAN PRIME-KEY - IF CUST-STAT NOT = "00" - DISPLAY "Error " CUST-STAT " starting file" - UPON CONSOLE - IF CUST-STAT (1:1) = "9" - DISPLAY "Sub Error " STAT-X2 UPON CONSOLE - END-IF - STOP RUN - END-IF. - READ TSPFILE NEXT RECORD WITH NO LOCK - IF CUST-STAT NOT = "00" - DISPLAY "Error " CUST-STAT " on 1st read of file" - UPON CONSOLE - IF CUST-STAT (1:1) = "9" - DISPLAY "Sub Error " STAT-X2 UPON CONSOLE - END-IF - STOP RUN - END-IF. - PERFORM UNTIL CUST-STAT NOT = "00" - OR REC-NUM > REC-MAX - DISPLAY "Key: " CM-CUST-NUM " is " CM-COMPANY - " Disk=" CM-DISK ":" - UPON CONSOLE - READ TSPFILE NEXT RECORD - AT END - MOVE "99" TO CUST-STAT - END-READ - ADD 1 TO REC-NUM - END-PERFORM - IF CUST-STAT = "99" - DISPLAY "Hit End of File" UPON CONSOLE - END-IF. - - DISPLAY "LIST SAMPLE FILE DESCENDING" UPON CONSOLE. - MOVE ZERO TO REC-NUM - START TSPFILE KEY LESS THAN PRIME-KEY - IF CUST-STAT NOT = "00" - DISPLAY "Error " CUST-STAT " starting file" - UPON CONSOLE - STOP RUN - END-IF. - READ TSPFILE PREVIOUS RECORD WITH NO LOCK - IF CUST-STAT NOT = "00" - DISPLAY "Error " CUST-STAT " on 1st read of file" - UPON CONSOLE - STOP RUN - END-IF. - PERFORM UNTIL CUST-STAT NOT = "00" - OR REC-NUM > REC-MAX - DISPLAY "Key: " CM-CUST-NUM " is " CM-COMPANY - " Disk=" CM-DISK ":" - UPON CONSOLE - READ TSPFILE PREVIOUS RECORD - AT END - MOVE "99" TO CUST-STAT - END-READ - ADD 1 TO REC-NUM - END-PERFORM. - - DISPLAY "LIST SAMPLE FILE BY KEY3" UPON CONSOLE. - MOVE ZERO TO REC-NUM - MOVE SPACES TO TSPFL-RECORD. - START TSPFILE KEY GREATER THAN OR EQUAL TO SPLIT-KEY3 - IF CUST-STAT NOT = "00" - AND CUST-STAT NOT = "02" - DISPLAY "Error " CUST-STAT " starting file" - UPON CONSOLE - STOP RUN - END-IF. - READ TSPFILE NEXT RECORD WITH NO LOCK - IF CUST-STAT NOT = "00" - AND CUST-STAT NOT = "02" - DISPLAY "Error " CUST-STAT " on 1st read of file" - UPON CONSOLE - STOP RUN - END-IF. - PERFORM UNTIL (CUST-STAT NOT = "00" - AND CUST-STAT NOT = "02") - OR REC-NUM > REC-MAX - DISPLAY "Key: " CM-CUST-NUM " is " CM-COMPANY - " Disk=" CM-DISK ":" - UPON CONSOLE - READ TSPFILE NEXT RECORD - AT END - MOVE "99" TO CUST-STAT - END-READ - ADD 1 TO REC-NUM - END-PERFORM. - *---- Some results may be different with VB-ISAM ------* - MOVE SPACES TO TSPFL-RECORD. - MOVE DATA-CUST-NUM (2) TO CM-CUST-NUM. - READ TSPFILE KEY IS PRIME-KEY - IF CUST-STAT NOT = "23" - DISPLAY "Error " CUST-STAT " instead of 23" - UPON CONSOLE - END-IF. - MOVE DATA-COMPANY (2) TO CM-COMPANY. - READ TSPFILE KEY IS PRIME-KEY - IF CUST-STAT NOT = "00" - DISPLAY "Error " CUST-STAT " on primary read " - UPON CONSOLE - ELSE - DISPLAY "Got: " CM-CUST-NUM " is " CM-COMPANY - " Disk=" CM-DISK ":" - UPON CONSOLE - END-IF. - READ TSPFILE NEXT RECORD - IF CUST-STAT NOT = "00" - DISPLAY "Error " CUST-STAT " on next read " - UPON CONSOLE - ELSE - DISPLAY "Nxt: " CM-CUST-NUM " is " CM-COMPANY - " Disk=" CM-DISK ":" - UPON CONSOLE - END-IF. - MOVE DATA-TELEPHONE (7) TO CM-TELEPHONE. - MOVE DATA-MACHINE (7) TO CM-MACHINE. - READ TSPFILE KEY IS SPLIT-KEY2 - IF CUST-STAT NOT = "00" - DISPLAY "Error " CUST-STAT " instead of 23" - UPON CONSOLE - ELSE - DISPLAY "Ky2: " CM-CUST-NUM " is " CM-COMPANY - " Mach=" CM-MACHINE ":" - UPON CONSOLE - END-IF. - CLOSE TSPFILE. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_file.at:3354: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_file.at:3354" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_file.at:3354" -$at_failed && at_fn_log_failure -$at_traceon; } - - -{ set +x -$as_echo "$at_srcdir/run_file.at:3356: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_file.at:3356" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo "Loading sample data file. -Sample data file load complete. -LIST SAMPLE FILE -Key: ALP00000 is ALPHA ELECTRICAL CO. LTD. Disk=8417 : -Key: BET00000 is BETA SHOE MFG. INC. Disk=8470 : -Key: DEL00000 is DELTA LUGGAGE REPAIRS Disk=********: -Key: EPS00000 is EPSILON EQUIPMENT SUPPLY Disk=********: -Key: FOR00000 is FORTUNE COOKIE COMPANY Disk=8470 : -Key: GAM00000 is GAMMA X-RAY TECHNOLOGY Disk=8417 : -Key: GIB00000 is GIBRALTER LIFE INSURANCE Disk=8417 : -Key: H&J00000 is H & J PLUMBING SUPPLIES Disk=********: -Key: INC00000 is INCREMENTAL BACKUP CORP. Disk=8417 : -Key: JOH00000 is JOHNSON BOATING SUPPLIES Disk=8417 : -Key: KON00000 is KONFLAB PLASTIC PRODUCTS. Disk=8417 : -LIST SAMPLE FILE DESCENDING -Key: KON00000 is KONFLAB PLASTIC PRODUCTS. Disk=8417 : -Key: JOH00000 is JOHNSON BOATING SUPPLIES Disk=8417 : -Key: INC00000 is INCREMENTAL BACKUP CORP. Disk=8417 : -Key: H&J00000 is H & J PLUMBING SUPPLIES Disk=********: -Key: GIB00000 is GIBRALTER LIFE INSURANCE Disk=8417 : -Key: GAM00000 is GAMMA X-RAY TECHNOLOGY Disk=8417 : -Key: FOR00000 is FORTUNE COOKIE COMPANY Disk=8470 : -Key: EPS00000 is EPSILON EQUIPMENT SUPPLY Disk=********: -Key: DEL00000 is DELTA LUGGAGE REPAIRS Disk=********: -Key: BET00000 is BETA SHOE MFG. INC. Disk=8470 : -Key: ALP00000 is ALPHA ELECTRICAL CO. LTD. Disk=8417 : -LIST SAMPLE FILE BY KEY3 -Key: ALP00000 is ALPHA ELECTRICAL CO. LTD. Disk=8417 : -Key: GAM00000 is GAMMA X-RAY TECHNOLOGY Disk=8417 : -Key: GIB00000 is GIBRALTER LIFE INSURANCE Disk=8417 : -Key: INC00000 is INCREMENTAL BACKUP CORP. Disk=8417 : -Key: JOH00000 is JOHNSON BOATING SUPPLIES Disk=8417 : -Key: KON00000 is KONFLAB PLASTIC PRODUCTS. Disk=8417 : -Key: BET00000 is BETA SHOE MFG. INC. Disk=8470 : -Key: FOR00000 is FORTUNE COOKIE COMPANY Disk=8470 : -Key: MOR00000 is MORNINGSIDE CARPENTRY. Disk=8470 : -Key: OLD00000 is OLD TYME PIZZA MFG. CO. Disk=8470 : -Key: PRE00000 is PRESTIGE OFFICE FURNITURE Disk=8470 : -Got: BET00000 is BETA SHOE MFG. INC. Disk=8470 : -Nxt: DEL00000 is DELTA LUGGAGE REPAIRS Disk=********: -Ky2: GIB00000 is GIBRALTER LIFE INSURANCE Mach=UNI-80/6: -" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_file.at:3356" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_726 -#AT_START_727 -at_fn_group_banner 727 'run_file.at:3403' \ - "INDEXED file split keys WITH DUPLICATES" " " 4 -at_xfail=no -( - $as_echo "727. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -$as_echo "run_file.at:3406" >"$at_check_line_file" -(test "$COB_HAS_ISAM" = "no") \ - && at_fn_check_skip 77 "$at_srcdir/run_file.at:3406" -## Note: The order in which secondary records with duplicate keys -## are returnded is not guaranteed. - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - - ENVIRONMENT DIVISION. - INPUT-OUTPUT SECTION. - FILE-CONTROL. - SELECT test-file - ASSIGN "TESTFILE" - ACCESS DYNAMIC - ORGANIZATION INDEXED - RECORD KEY test-key-1 SOURCE IS test-key-p1 - ALTERNATE RECORD KEY test-key-2 SOURCE IS test-key-p2, - test-key-p3 - WITH DUPLICATES - . - - DATA DIVISION. - FILE SECTION. - FD test-file. - 01 test-rec. - 03 test-key-p1 PIC X(4). - 03 test-key-p2 PIC 9(4). - 03 test-data PIC X(4). - 03 test-key-p3 PIC X(4). - - WORKING-STORAGE SECTION. - 01 found PIC X(03). - - PROCEDURE DIVISION. - OPEN OUTPUT test-file - WRITE test-rec FROM "BBBB0001dat1aaaa" - WRITE test-rec FROM "AAAA0001dat2aaaa" - WRITE test-rec FROM "CCCC0002dat3aaaa" - WRITE test-rec FROM "DDDD0002dat4bbbb" - WRITE test-rec FROM "EEEE0002dat5bbbb" - CLOSE test-file - - OPEN INPUT test-file - - MOVE "CCCC" TO test-key-p1 - READ test-file KEY IS test-key-1 - INVALID KEY - DISPLAY "READ with CCCC found no record" - NOT INVALID KEY - IF test-data NOT = "dat3" - DISPLAY "READ with wrong result: " - test-rec - END-READ - - MOVE SPACES TO found - - MOVE 0001 TO test-key-p2 - MOVE "aaaa" TO test-key-p3 - START test-file KEY >= test-key-2 - INVALID KEY - DISPLAY "START >= 0001/aaaa found no record" - NOT INVALID KEY - READ test-file NEXT - AT END - DISPLAY "READ NEXT (1) found no record" - NOT AT END - EVALUATE test-data - WHEN "dat1" - MOVE 'X' TO found (1:1) - WHEN "dat2" - MOVE 'X' TO found (2:1) - WHEN OTHER - DISPLAY "READ NEXT (1) " - "with wrong result: " - test-data - END-READ - READ test-file NEXT - AT END - DISPLAY "READ NEXT (2) found no record" - NOT AT END - EVALUATE test-data - WHEN "dat1" - MOVE 'X' TO found (1:1) - WHEN "dat2" - MOVE 'X' TO found (2:1) - WHEN OTHER - DISPLAY "READ NEXT (2) " - "with wrong result: " - test-data - END-READ - IF found NOT = 'XX ' - DISPLAY "START >= + READ NEXT * 2 " - "with wrong result: " found - END-START - MOVE 0001 TO test-key-p2 - MOVE "aaaa" TO test-key-p3 - START test-file KEY > test-key-2 - INVALID KEY - DISPLAY "START > 0001/aaaa found no record" - NOT INVALID KEY - READ test-file NEXT - AT END - DISPLAY "READ NEXT (3) found no record" - NOT AT END - IF test-data NOT = "dat3" - DISPLAY "READ NEXT (3) " - "with wrong result: " - test-data - END-READ - END-START - - MOVE 0002 TO test-key-p2 - MOVE ALL "z" TO test-key-p3 - START test-file KEY IS < test-key-2 - INVALID KEY - DISPLAY "START < 0002/zzzz found no record" - NOT INVALID KEY - READ test-file PREVIOUS - AT END - DISPLAY "READ PREVIOUS (1) found no record" - NOT AT END - IF test-data NOT = "dat5" - DISPLAY "READ PREVIOUS (1) " - "with wrong result: " - test-data - END-READ - READ test-file PREVIOUS - AT END - DISPLAY "READ PREVIOUS (2) found no record" - NOT AT END - IF test-data NOT = "dat4" - DISPLAY "READ PREVIOUS (2) " - "with wrong result: " - test-data - END-READ - READ test-file PREVIOUS - AT END - DISPLAY "READ PREVIOUS (3) found no record" - NOT AT END - IF test-data NOT = "dat3" - DISPLAY "READ PREVIOUS (3) " - "with wrong result: " - test-data - END-READ - END-START - - CLOSE test-file - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_file.at:3556: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_file.at:3556" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_file.at:3556" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_file.at:3557: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_file.at:3557" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_file.at:3557" -$at_failed && at_fn_log_failure -$at_traceon; } - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_727 -#AT_START_728 -at_fn_group_banner 728 'run_file.at:3561' \ - "INDEXED file variable length record" " " 4 -at_xfail=no -( - $as_echo "728. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -$as_echo "run_file.at:3564" >"$at_check_line_file" -(test "$COB_HAS_ISAM" = "no") \ - && at_fn_check_skip 77 "$at_srcdir/run_file.at:3564" - -cat >prog.cob <<'_ATEOF' - - Identification division. - Program-id. prog. - * - Environment division. - - Input-output section. - File-control. - * - Select optional tbw - assign to path-tbw - organization is indexed - access mode is dynamic - record key is tbw-key - alternate record key is tbw-alt - suppress when space - sharing with no other - file status is fs-file-status. - * - I-o-control. - * - Data division. - File section. - * - FD tbw - record is varying in size - from 107 to 362 characters - depending on end-tbw-record - . - 01 tbw-record. - 02 tbw-key pic x(100). - 02 tbw-alt. - 03 tbw-alt-1 pic 9(02). - 03 tbw-alt-2 pic 9(04). - 02 tbw-f1 pic x(01). - 02 tbw-f2 pic x(255). - * - Working-storage section. - - 01 fs-file-status pic x(02). - - 01 end-tbw-record pic 9(09) binary. - - 01 flag-tbw pic x(01) value low-value. - 88 flag-tbw-open value high-value. - 88 flag-tbw-closed value low-value. - - 01 path-tbw pic x(255) value space. - - Procedure division. - - * Prepare. - Move "tbw" to path-tbw. - - * First test. - Perform tbw-delete-file thru tbw-exit. - - Perform tbw-open-i-o thru tbw-exit. - - Move low-values to tbw-key. - Perform tbw-start-primary-greater thru tbw-exit. - - Perform tbw-read-next thru tbw-exit. - - Move 122 to end-tbw-record. - Move "aaaaa" to tbw-key. - Move spaces to tbw-alt - tbw-f1 - tbw-f2. - Perform tbw-write thru tbw-exit. - - Move low-values to tbw-alt. - Perform tbw-start-alternate thru tbw-exit. - - Move low-values to tbw-key. - Perform tbw-start-primary-greater thru tbw-exit. - - Perform tbw-read-next thru tbw-exit. - - Perform tbw-read-next thru tbw-exit. - - * Second test. - Perform tbw-close thru tbw-exit. - - Perform tbw-delete-file thru tbw-exit. - - Perform tbw-open-i-o thru tbw-exit. - - Move low-values to tbw-key. - Perform tbw-start-primary-greater thru tbw-exit. - - Perform tbw-read-next thru tbw-exit. - - Move 163 to end-tbw-record. - Move "aaaaa" to tbw-key. - Move 1 to tbw-alt-1 - tbw-alt-2. - Move spaces to tbw-f1 - tbw-f2. - Perform tbw-write thru tbw-exit. - - Move 122 to end-tbw-record. - Move "aaaab" to tbw-key. - Move spaces to tbw-alt - tbw-f1 - tbw-f2. - Perform tbw-write thru tbw-exit. - - Move low-values to tbw-alt. - Perform tbw-start-alternate thru tbw-exit. - - Perform tbw-read-next thru tbw-exit. - - Move spaces to tbw-alt. - Perform tbw-rewrite thru tbw-exit. - - * Finish. - Perform tbw-close thru tbw-exit. - Display "Test completed". - Stop run. - - * I/O. - tbw-Open-I-O. - If flag-tbw-open - Perform tbw-Close thru tbw-Close-exit - end-if. - Display "open". - Open i-o tbw. - Display "open". - If fs-file-status is less than "10" - Set flag-tbw-open to true - end-if. - Go to tbw-exit. - * - tbw-Start-Primary-Greater. - Display "start > tbw-key". - Start tbw - key is greater than tbw-key - invalid key Continue - end-start. - Display "start > tbw-key". - Go to tbw-exit. - * - tbw-Start-Alternate. - Display "start >= tbw-alt". - Start tbw - key is not less than tbw-alt - invalid key Continue - end-start. - Display "start >= tbw-alt". - Go to tbw-exit. - * - tbw-Read-Next. - Display "read next". - Read tbw - next record - at end Continue - end-read. - Display "read next done". - Go to tbw-exit. - * - tbw-Write. - Display "write". - Write tbw-record - invalid key Continue - end-write. - Display "write". - Go to tbw-exit. - * - tbw-Rewrite. - Display "rewrite". - Rewrite tbw-record - invalid key Continue - end-rewrite. - Display "rewrite " fs-file-status. - Go to tbw-exit. - * - tbw-Delete-File. - If flag-tbw-open - Perform tbw-Close thru tbw-Close-exit - end-if. - Move "xx" to fs-file-status. - Display "delete file". - Delete file tbw - end-delete. - Display "delete file". - Go to tbw-exit. - * - tbw-Close. - If flag-tbw-open - Display "close" - Close tbw - Display "close" - Set flag-tbw-closed to true - end-if. - tbw-Close-exit. - Exit. - tbw-exit. - Exit. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_file.at:3767: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_file.at:3767" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_file.at:3767" -$at_failed && at_fn_log_failure -$at_traceon; } - - -{ set +x -$as_echo "$at_srcdir/run_file.at:3769: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_file.at:3769" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo "delete file -delete file -open -open -start > tbw-key -start > tbw-key -read next -read next done -write -write -start >= tbw-alt -start >= tbw-alt -start > tbw-key -start > tbw-key -read next -read next done -read next -read next done -close -close -delete file -delete file -open -open -start > tbw-key -start > tbw-key -read next -read next done -write -write -write -write -start >= tbw-alt -start >= tbw-alt -read next -read next done -rewrite -rewrite 00 -close -close -Test completed -" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_file.at:3769" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_728 -#AT_START_729 -at_fn_group_banner 729 'run_file.at:3816' \ - "INDEXED sample" " " 4 -at_xfail=no -( - $as_echo "729. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -# modified version of GC-FAQ: indexing example -# Author: Brian Tiffin, Date: 17-Feb-2009, 28-Jan-2014 - -$as_echo "run_file.at:3822" >"$at_check_line_file" -(test "$COB_HAS_ISAM" = "no") \ - && at_fn_check_skip 77 "$at_srcdir/run_file.at:3822" - -cat >prog.cob <<'_ATEOF' - - - identification division. - program-id. linage. - - environment division. - configuration section. - - input-output section. - file-control. - select optional indexed-file - assign to "indexed-file.dat" - status is indexing-status - organization is indexed - access mode is dynamic - record key is keyfield of indexing-record - alternate record key is altkey of indexing-record - with duplicates - . - - data division. - file section. - fd indexed-file. - 01 indexing-record. - 03 keyfield pic x(8). - 03 filler pic x. - 03 altkey. - 05 first-part pic 99. - 05 middle-part pic x. - 05 last-part pic 99. - 03 filler pic x. - 03 data-part pic x(18). - - working-storage section. - 01 indexing-status. - 03 high-status-code pic xx. - 03 high-status redefines high-status-code pic 99. - 88 indexing-ok values 0 thru 10. - 03 low-status-code pic xx. - 03 low-status redefines low-status-code pic 99. - - 78 line-separator value - '-----------------------------------------'. - 01 display-record. - 03 filler pic x(4) value spaces. - 03 keyfield pic x(8). - 03 filler pic xx value spaces. - 03 altkey. - 05 first-part pic 99. - 05 filler pic x value space. - 05 middle-part pic x. - 05 filler pic x value space. - 05 last-part pic 99. - 03 filler pic xx value ", ". - 03 data-part pic x(18). - 77 safety-net pic 99. - - *> control break - 01 oldkey pic 99x99. - - *> read control fields - 01 duplicate-flag pic x. - 88 no-more-duplicates value high-value - when set to false low-value. - 01 record-flag pic x. - 88 no-more-records value high-value - when set to false low-value. - - *> *************************************************************** - procedure division. - main. - *> Populate a sample database, create or overwrite keys - perform populate-sample - - *> clear the record space for this example - move spaces to indexing-record - - *> open the data file again - open i-o indexed-file - perform indexing-check - if not indexing-ok - stop run returning 1 - end-if - - *> read all the duplicate 00b02 keys - move 00 to first-part of indexing-record - move "b" to middle-part of indexing-record - move 02 to last-part of indexing-record - - *> using read key and then next key / last key compare - set no-more-duplicates to false - - display "Read all 00b02 keys sequentially" end-display - perform read-indexing-record - perform read-next-record - *> this is only here for safety... - varying safety-net from 1 by 1 - until no-more-duplicates - *> s a f e against broken indexed i/o - or safety-net > 40 - if safety-net > 40 - display "Safety kicked in!" end-display - end-if - display line-separator end-display - - *> read by key of reference ... the cool stuff - move 00 to first-part of indexing-record - move "a" to middle-part of indexing-record - move 02 to last-part of indexing-record - set no-more-records to false - - *> using start and read next - display "Read all alternate keys greater than 00a02" - end-display - perform start-at-key - perform read-next-by-key - *> this is only here for safety... - varying safety-net from 1 by 1 - until no-more-records - *> s a f e against broken indexed i/o - or safety-net > 40 - if safety-net > 40 - display "Safety kicked in!" end-display - end-if - display line-separator end-display - - *> read by primary key of reference - move "87654321" to keyfield of indexing-record - set no-more-records to false - - *> using start and previous by key - display - "Read all primary keys less than " - function trim (keyfield of indexing-record) - end-display - perform start-prime-key - perform read-previous-by-key - *> this is only here for safety... - varying safety-net from 1 by 1 - until no-more-records - *> s a f e against broken indexed i/o - or safety-net > 40 - if safety-net > 40 - display "Safety kicked in!" end-display - end-if - display line-separator end-display - - *> and with that we are done with indexing sample - close indexed-file - - goback - . - *> *************************************************************** - - *> *************************************************************** - *><* read by alternate key paragraph - read-indexing-record. - display "Reading: " altkey of indexing-record end-display - read indexed-file key is altkey of indexing-record - invalid key - display - "bad read key: " - function trim (altkey of indexing-record) - upon syserr - end-display - set no-more-duplicates to true - end-read - perform indexing-check - . - - *><* read next sequential paragraph - read-next-record. - move corresponding indexing-record to display-record - display display-record end-display - move altkey of indexing-record to oldkey - - read indexed-file next record - at end set no-more-duplicates to true - not at end - if oldkey not equal altkey of indexing-record - set no-more-duplicates to true - end-if - end-read - perform indexing-check - . - - *><* start primary key of reference paragraph - start-prime-key. - display "Prime < " keyfield of indexing-record end-display - start indexed-file - key is less than - keyfield of indexing-record - invalid key - display - "bad start: " - function trim (keyfield of indexing-record) - upon syserr - end-display - set no-more-records to true - not invalid key - read indexed-file previous record - at end set no-more-records to true - end-read - end-start - perform indexing-check - . - - *><* read previous by key of reference paragraph - read-previous-by-key. - move corresponding indexing-record to display-record - display display-record end-display - - read indexed-file previous record - at end set no-more-records to true - end-read - perform indexing-check - . - *><* start alternate key of reference paragraph - start-at-key. - display "Seeking >= " altkey of indexing-record end-display - start indexed-file - key is greater than or equal to - altkey of indexing-record - invalid key - display - "bad start: " - function trim (altkey of indexing-record) - upon syserr - end-display - set no-more-records to true - not invalid key - read indexed-file next record - at end set no-more-records to true - end-read - end-start - perform indexing-check - . - - *><* read next by key of reference paragraph - read-next-by-key. - move corresponding indexing-record to display-record - display display-record end-display - - read indexed-file next record - at end set no-more-records to true - end-read - perform indexing-check - . - - *><* populate a sample database - populate-sample. - - *> Open optional index file for read write - open i-o indexed-file - perform indexing-check - - move "12345678 00a01 some 12345678 data" to indexing-record - perform write-indexing-record - move "87654321 00a01 some 87654321 data" to indexing-record - perform write-indexing-record - move "12348765 00a01 some 12348765 data" to indexing-record - perform write-indexing-record - move "87651234 00a01 some 87651234 data" to indexing-record - perform write-indexing-record - - move "12345679 00b02 some 12345679 data" to indexing-record - perform write-indexing-record - move "97654321 00b02 some 97654321 data" to indexing-record - perform write-indexing-record - move "12349765 00b02 some 12349765 data" to indexing-record - perform write-indexing-record - move "97651234 00b02 some 97651234 data" to indexing-record - perform write-indexing-record - - move "12345689 00c13 some 12345689 data" to indexing-record - perform write-indexing-record - move "98654321 00c13 some 98654321 data" to indexing-record - perform write-indexing-record - move "12349865 00c13 some 12349865 data" to indexing-record - perform write-indexing-record - move "98651234 00c13 some 98651234 data" to indexing-record - perform write-indexing-record - - *> close it ... not necessary, but for the example we will - close indexed-file - perform indexing-check - . - - *><* Write paragraph - write-indexing-record. - write indexing-record - invalid key - display - "rewriting key: " - function trim (keyfield of indexing-record) - upon syserr - end-display - rewrite indexing-record - invalid key - display - "really bad key: " - function trim (keyfield of indexing-record) - upon syserr - end-display - end-rewrite - end-write - . - - *><* file status quick check. For this sample, keep running - indexing-check. - if not indexing-ok then - display - "isam file io problem: " indexing-status - upon syserr - end-display - end-if - . -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_file.at:4143: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_file.at:4143" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_file.at:4143" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_file.at:4144: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_file.at:4144" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo "Read all 00b02 keys sequentially -Reading: 00b02 - 12345679 00 b 02, some 12345679 data - 97654321 00 b 02, some 97654321 data - 12349765 00 b 02, some 12349765 data - 97651234 00 b 02, some 97651234 data ------------------------------------------ -Read all alternate keys greater than 00a02 -Seeking >= 00a02 - 12345679 00 b 02, some 12345679 data - 97654321 00 b 02, some 97654321 data - 12349765 00 b 02, some 12349765 data - 97651234 00 b 02, some 97651234 data - 12345689 00 c 13, some 12345689 data - 98654321 00 c 13, some 98654321 data - 12349865 00 c 13, some 12349865 data - 98651234 00 c 13, some 98651234 data ------------------------------------------ -Read all primary keys less than 87654321 -Prime < 87654321 - 87651234 00 a 01, some 87651234 data - 12349865 00 c 13, some 12349865 data - 12349765 00 b 02, some 12349765 data - 12348765 00 a 01, some 12348765 data - 12345689 00 c 13, some 12345689 data - 12345679 00 b 02, some 12345679 data - 12345678 00 a 01, some 12345678 data ------------------------------------------ -" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_file.at:4144" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_file.at:4174: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_file.at:4174" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "rewriting key: 12345678 -rewriting key: 87654321 -rewriting key: 12348765 -rewriting key: 87651234 -rewriting key: 12345679 -rewriting key: 97654321 -rewriting key: 12349765 -rewriting key: 97651234 -rewriting key: 12345689 -rewriting key: 98654321 -rewriting key: 12349865 -rewriting key: 98651234 -" | \ - $at_diff - "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo "Read all 00b02 keys sequentially -Reading: 00b02 - 12345679 00 b 02, some 12345679 data - 97654321 00 b 02, some 97654321 data - 12349765 00 b 02, some 12349765 data - 97651234 00 b 02, some 97651234 data ------------------------------------------ -Read all alternate keys greater than 00a02 -Seeking >= 00a02 - 12345679 00 b 02, some 12345679 data - 97654321 00 b 02, some 97654321 data - 12349765 00 b 02, some 12349765 data - 97651234 00 b 02, some 97651234 data - 12345689 00 c 13, some 12345689 data - 98654321 00 c 13, some 98654321 data - 12349865 00 c 13, some 12349865 data - 98651234 00 c 13, some 98651234 data ------------------------------------------ -Read all primary keys less than 87654321 -Prime < 87654321 - 87651234 00 a 01, some 87651234 data - 12349865 00 c 13, some 12349865 data - 12349765 00 b 02, some 12349765 data - 12348765 00 a 01, some 12348765 data - 12345689 00 c 13, some 12345689 data - 12345679 00 b 02, some 12345679 data - 12345678 00 a 01, some 12345678 data ------------------------------------------ -" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_file.at:4174" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_729 -#AT_START_730 -at_fn_group_banner 730 'run_file.at:4221' \ - "WRITE + REWRITE FILE name" " " 4 -at_xfail=no -( - $as_echo "730. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - CONFIGURATION SECTION. - - INPUT-OUTPUT SECTION. - FILE-CONTROL. - SELECT FLATFILE ASSIGN EXTERNAL RELFIX - ORGANIZATION RELATIVE - ACCESS IS SEQUENTIAL RELATIVE KEY IS REC-NUM - FILE STATUS IS CUST-STAT. - - SELECT FLATFILE2 ASSIGN EXTERNAL RELFIX - ORGANIZATION RELATIVE - ACCESS IS RANDOM RELATIVE KEY IS REC-NUM - FILE STATUS IS CUST-STAT. - - DATA DIVISION. - FILE SECTION. - FD FLATFILE - BLOCK CONTAINS 5 RECORDS. - - 01 TSPFL-RECORD. - 10 CM-CUST-NUM PICTURE X(8). - 10 CM-COMPANY PICTURE X(25). - 10 CM-DISK PICTURE X(8). - 10 CM-NO-TERMINALS PICTURE 9(4). - - FD FLATFILE2 - BLOCK CONTAINS 5 RECORDS. - - 01 TSP2-RECORD. - 10 C2-CUST-NUM PICTURE X(8). - 10 C2-COMPANY PICTURE X(25). - 10 C2-DISK PICTURE X(8). - 10 C2-NO-TERMINALS PICTURE 9(4). - - WORKING-STORAGE SECTION. - - 77 MAX-SUB VALUE 6 PICTURE 9(4) COMP SYNC. - 77 CUST-STAT PICTURE X(2). - 77 REC-NUM VALUE 1 PICTURE 9(4). - - 01 TEST-DATA. - - 02 DATA-CUST-NUM-TBL. - - 05 FILLER PIC X(8) VALUE "ALP00000". - 05 FILLER PIC X(8) VALUE "BET00000". - 05 FILLER PIC X(8) VALUE "DEL00000". - 05 FILLER PIC X(8) VALUE "EPS00000". - 05 FILLER PIC X(8) VALUE "FOR00000". - 05 FILLER PIC X(8) VALUE "GAM00000". - - 02 DATA-CUST-NUM REDEFINES DATA-CUST-NUM-TBL - PIC X(8) OCCURS 6. - 02 DATA-COMPANY-TBL. - - 05 FILLER PIC X(25) VALUE "ALPHA ELECTRICAL CO. LTD.". - 05 FILLER PIC X(25) VALUE "BETA SHOE MFG. INC. ". - 05 FILLER PIC X(25) VALUE "DELTA LUGGAGE REPAIRS ". - 05 FILLER PIC X(25) VALUE "EPSILON EQUIPMENT SUPPLY ". - 05 FILLER PIC X(25) VALUE "FORTUNE COOKIE COMPANY ". - 05 FILLER PIC X(25) VALUE "GAMMA X-RAY TECHNOLOGY ". - 02 DATA-COMPANY REDEFINES DATA-COMPANY-TBL - PIC X(25) OCCURS 6. - 02 DATA-ADDRESS-2-TBL. - - 05 FILLER PIC X(10) VALUE "ATLANTA ". - 05 FILLER PIC X(10) VALUE "CALGARY ". - 05 FILLER PIC X(10) VALUE "NEW YORK ". - 05 FILLER PIC X(10) VALUE "TORONTO ". - 05 FILLER PIC X(10) VALUE "WASHINGTON". - 05 FILLER PIC X(10) VALUE "WHITEPLAIN". - 02 DATA-ADDRESS REDEFINES DATA-ADDRESS-2-TBL - PIC X(10) OCCURS 6. - - 02 DATA-NO-TERMINALS-TBL. - - 05 FILLER PIC 9(3) COMP-3 VALUE 10. - 05 FILLER PIC 9(3) COMP-3 VALUE 13. - 05 FILLER PIC 9(3) COMP-3 VALUE 75. - 05 FILLER PIC 9(3) COMP-3 VALUE 10. - 05 FILLER PIC 9(3) COMP-3 VALUE 90. - 05 FILLER PIC 9(3) COMP-3 VALUE 254. - - 02 DATA-NO-TERMINALS REDEFINES DATA-NO-TERMINALS-TBL - PIC 9(3) COMP-3 OCCURS 6. - 01 WORK-AREA. - 05 SUB PICTURE 9(4) COMP SYNC. - 88 ODD-RECORD VALUE 1 3 5. - - - PROCEDURE DIVISION. - - PERFORM LOADFILE. - - OPEN I-O FLATFILE2. - MOVE 2 TO REC-NUM - READ FLATFILE2 - DISPLAY "Read " C2-CUST-NUM " Sts:" CUST-STAT - " Trms:" C2-NO-TERMINALS. - ADD 1 TO C2-NO-TERMINALS - REWRITE FILE FLATFILE2 FROM TSP2-RECORD - READ FLATFILE2 - DISPLAY "REWROTE " C2-CUST-NUM " Sts:" CUST-STAT - " Trms:" C2-NO-TERMINALS. - CLOSE FLATFILE2. - STOP RUN. - - LOADFILE. - DISPLAY "Loading sample program data file." - UPON CONSOLE. - - OPEN OUTPUT FLATFILE. - - PERFORM LOAD-RECORD - VARYING SUB FROM 1 BY 1 - UNTIL SUB > MAX-SUB. - - DISPLAY "Sample program data file load complete." - UPON CONSOLE. - CLOSE FLATFILE. - - LOAD-RECORD. - - MOVE SPACES TO TSPFL-RECORD. - MOVE DATA-CUST-NUM (SUB) TO CM-CUST-NUM. - MOVE DATA-COMPANY (SUB) TO CM-COMPANY. - MOVE DATA-NO-TERMINALS (SUB) TO CM-NO-TERMINALS. - IF ODD-RECORD - MOVE "8417" TO CM-DISK - ELSE - MOVE "8470" TO CM-DISK. - WRITE FILE FLATFILE FROM TSPFL-RECORD. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_file.at:4362: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_file.at:4362" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_file.at:4362" -$at_failed && at_fn_log_failure -$at_traceon; } - - -{ set +x -$as_echo "$at_srcdir/run_file.at:4364: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_file.at:4364" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo "Loading sample program data file. -Sample program data file load complete. -Read BET00000 Sts:00 Trms:0013 -REWROTE BET00000 Sts:00 Trms:0014 -" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_file.at:4364" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_730 -#AT_START_731 -at_fn_group_banner 731 'run_file.at:4374' \ - "START RELATIVE (1)" " " 4 -at_xfail=no -( - $as_echo "731. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - INPUT-OUTPUT SECTION. - FILE-CONTROL. - SELECT OPTIONAL TEST-FILE - ASSIGN "TESTFILE" - ACCESS DYNAMIC - ORGANIZATION RELATIVE - STATUS TESTSTAT - RELATIVE KEY TESTKEY - . - DATA DIVISION. - FILE SECTION. - FD TEST-FILE. - 01 TEST-REC PIC X(4). - WORKING-STORAGE SECTION. - 01 TESTKEY USAGE BINARY-LONG UNSIGNED. - 01 TESTSTAT PIC XX. - 88 V-OK VALUE "00" "05". - PROCEDURE DIVISION. - DELETE FILE TEST-FILE. - OPEN I-O TEST-FILE. - IF NOT V-OK - DISPLAY "OPEN " TESTSTAT - END-DISPLAY - GOBACK - END-IF. - MOVE 99 TO TESTKEY. - START TEST-FILE KEY < TESTKEY - END-START. - IF TESTSTAT NOT = "23" - DISPLAY "START " TESTSTAT - END-DISPLAY - END-IF. - CLOSE TEST-FILE. - END PROGRAM prog. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_file.at:4417: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_file.at:4417" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_file.at:4417" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_file.at:4418: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_file.at:4418" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_file.at:4418" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_731 -#AT_START_732 -at_fn_group_banner 732 'run_file.at:4423' \ - "START RELATIVE (2)" " " 4 -at_xfail=no -( - $as_echo "732. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - INPUT-OUTPUT SECTION. - FILE-CONTROL. - SELECT OPTIONAL TEST-FILE - ASSIGN "TESTFILE" - ACCESS DYNAMIC - ORGANIZATION RELATIVE - STATUS TESTSTAT - RELATIVE KEY TESTKEY - . - DATA DIVISION. - FILE SECTION. - FD TEST-FILE. - 01 TEST-REC PIC X(4). - WORKING-STORAGE SECTION. - 01 TESTKEY USAGE BINARY-LONG UNSIGNED. - 01 TESTSTAT PIC XX. - 88 V-OK VALUE "00" "05". - 88 V-ZERO VALUE "00". - PROCEDURE DIVISION. - OPEN OUTPUT TEST-FILE. - CLOSE TEST-FILE. - OPEN I-O TEST-FILE. - IF NOT V-OK - DISPLAY "OPEN " TESTSTAT - END-DISPLAY - GOBACK - END-IF. - MOVE 3 TO TESTKEY. - MOVE "0003" TO TEST-REC. - WRITE TEST-REC INVALID KEY - DISPLAY "WRITE " TESTSTAT - END-DISPLAY - END-WRITE. - MOVE 2 TO TESTKEY. - MOVE "0002" TO TEST-REC. - WRITE TEST-REC INVALID KEY - DISPLAY "WRITE " TESTSTAT - END-DISPLAY - END-WRITE. - MOVE 99 TO TESTKEY. - START TEST-FILE KEY < TESTKEY - END-START. - IF NOT V-ZERO - DISPLAY "START " TESTSTAT - END-DISPLAY - END-IF. - IF TESTKEY NOT = 99 - DISPLAY "TESTKEY " TESTKEY - END-DISPLAY - END-IF. - MOVE SPACE TO TEST-REC. - READ TEST-FILE NEXT - END-READ. - IF NOT V-ZERO - DISPLAY "READ " TESTSTAT - END-DISPLAY - END-IF. - IF TEST-REC NOT = "0003" - DISPLAY "READ RECORD " TEST-REC - END-DISPLAY - END-IF. - CLOSE TEST-FILE. - END PROGRAM prog. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_file.at:4495: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_file.at:4495" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_file.at:4495" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_file.at:4496: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_file.at:4496" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_file.at:4496" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_732 -#AT_START_733 -at_fn_group_banner 733 'run_file.at:4501' \ - "START RELATIVE (3)" " " 4 -at_xfail=no -( - $as_echo "733. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - INPUT-OUTPUT SECTION. - FILE-CONTROL. - SELECT file1 ASSIGN TO DISK - ORGANIZATION RELATIVE - ACCESS DYNAMIC RELATIVE KEY file1-key. - DATA DIVISION. - FILE SECTION. - FD file1. - 1 file1-rec pic 999. - WORKING-STORAGE SECTION. - 77 file1-key pic 9(6). - PROCEDURE DIVISION. - OPEN OUTPUT file1. - CLOSE file1. - OPEN I-O file1. - MOVE 10 TO file1-key file1-rec. - WRITE file1-rec. - MOVE 11 TO file1-key file1-rec. - WRITE file1-rec. - MOVE 12 TO file1-key file1-rec. - WRITE file1-rec. - MOVE 13 TO file1-key file1-rec. - WRITE file1-rec. - * - MOVE 0 TO file1-key. - START file1 KEY > file1-key. - READ file1 NEXT. - IF (file1-rec <> 10) - DISPLAY "FAILED: START key > 0". - * - MOVE 99 TO file1-key. - START file1 KEY < file1-key. - READ file1 NEXT. - IF (file1-rec <> 13) - DISPLAY "FAILED: START key < 99". - * - MOVE 0 TO file1-key. - START file1 FIRST. - READ file1 NEXT. - IF (file1-rec <> 10) - DISPLAY "FAILED: START key FIRST". - * - MOVE 0 TO file1-key. - START file1 LAST. - READ file1 NEXT. - IF (file1-rec <> 13) - DISPLAY "FAILED: START key LAST". - * - MOVE 0 TO file1-key. - START file1 KEY >= file1-key. - READ file1 NEXT. - IF (file1-rec <> 10) - DISPLAY "FAILED: START key >= 0". - * - MOVE 99 TO file1-key. - START file1 KEY <= file1-key. - READ file1 NEXT. - IF (file1-rec <> 13) - DISPLAY "FAILED: START key <= 99". - * - CLOSE file1. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_file.at:4572: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_file.at:4572" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_file.at:4572" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_file.at:4573: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_file.at:4573" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_file.at:4573" -$at_failed && at_fn_log_failure -$at_traceon; } - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_733 -#AT_START_734 -at_fn_group_banner 734 'run_file.at:4577' \ - "READ on OPTIONAL missing RELATIVE / SEQUENTIAL" " " 4 -at_xfail=no -( - $as_echo "734. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - CONFIGURATION SECTION. - INPUT-OUTPUT SECTION. - FILE-CONTROL. - SELECT OPTIONAL INFILE ASSIGN TO - "missing.txt" - ORGANIZATION IS RELATIVE - ACCESS IS SEQUENTIAL - FILE STATUS IS WSFS. - SELECT OPTIONAL INFILES ASSIGN TO - "missings.txt" - ORGANIZATION IS SEQUENTIAL - ACCESS IS SEQUENTIAL - FILE STATUS IS WSFS. - DATA DIVISION. - FILE SECTION. - FD INFILE. - 01 INREC PIC X(80). - FD INFILES. - 01 INRECS PIC X(80). - WORKING-STORAGE SECTION. - 01 WSFS PIC X(2). - 88 RECORDFOUND VALUE "00". - 01 WSINREC PIC X(80). - PROCEDURE DIVISION. - MAIN-PROCEDURE. - * Open missing file - OPEN INPUT INFILE - DISPLAY "R: OPEN INPUT on missing optional file = " WSFS " " - NO ADVANCING - IF WSFS = '05' - DISPLAY "OK" - ELSE - DISPLAY "Bad" - END-IF. - OPEN INPUT INFILES - DISPLAY "S: OPEN INPUT on missing optional file = " WSFS " " - NO ADVANCING - IF WSFS = '05' - DISPLAY "OK" - ELSE - DISPLAY "Bad" - END-IF. - * First read, raise a FS 10 (AT END) which is expected - READ INFILE INTO WSINREC - DISPLAY "R: 1st READ on missing optional file = " WSFS " " - NO ADVANCING - IF WSFS = '10' - DISPLAY "OK" - ELSE - DISPLAY "Bad" - END-IF. - READ INFILES INTO WSINREC - DISPLAY "S: 1st READ on missing optional file = " WSFS " " - NO ADVANCING - IF WSFS = '10' - DISPLAY "OK" - ELSE - DISPLAY "Bad" - END-IF. - - * Second read, should raise a FS 46 (READ AFTER AT END). - READ INFILE INTO WSINREC - DISPLAY "R: 2nd READ on missing optional file = " WSFS " " - NO ADVANCING - IF WSFS = '46' - DISPLAY "OK" - ELSE - DISPLAY "Bad" - END-IF. - READ INFILES INTO WSINREC - DISPLAY "S: 2nd READ on missing optional file = " WSFS " " - NO ADVANCING - IF WSFS = '46' - DISPLAY "OK" - ELSE - DISPLAY "Bad" - END-IF. - READ INFILE - DISPLAY "R: 3rd READ on missing optional file = " WSFS " " - NO ADVANCING - IF WSFS = '46' - DISPLAY "OK" - ELSE - DISPLAY "Bad" - END-IF. - READ INFILES - DISPLAY "S: 3rd READ on missing optional file = " WSFS " " - NO ADVANCING - IF WSFS = '46' - DISPLAY "OK" - ELSE - DISPLAY "Bad" - END-IF. - - CLOSE INFILE - CLOSE INFILES - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_file.at:4683: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_file.at:4683" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_file.at:4683" -$at_failed && at_fn_log_failure -$at_traceon; } - - -{ set +x -$as_echo "$at_srcdir/run_file.at:4685: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_file.at:4685" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo "R: OPEN INPUT on missing optional file = 05 OK -S: OPEN INPUT on missing optional file = 05 OK -R: 1st READ on missing optional file = 10 OK -S: 1st READ on missing optional file = 10 OK -R: 2nd READ on missing optional file = 46 OK -S: 2nd READ on missing optional file = 46 OK -R: 3rd READ on missing optional file = 46 OK -S: 3rd READ on missing optional file = 46 OK -" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_file.at:4685" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_734 -#AT_START_735 -at_fn_group_banner 735 'run_file.at:4699' \ - "READ on OPTIONAL missing INDEXED file" " " 4 -at_xfail=no -( - $as_echo "735. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -$as_echo "run_file.at:4702" >"$at_check_line_file" -(test "$COB_HAS_ISAM" = "no") \ - && at_fn_check_skip 77 "$at_srcdir/run_file.at:4702" - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - - ENVIRONMENT DIVISION. - INPUT-OUTPUT SECTION. - FILE-CONTROL. - SELECT OPTIONAL file1 ASSIGN "fileX" - ORGANIZATION IS INDEXED - RECORD KEY IS file1-key - STATUS f-status. - - DATA DIVISION. - FILE SECTION. - FD file1. - 01 file1-key PIC X. - - WORKING-STORAGE SECTION. - 01 f-status PIC XX. - - PROCEDURE DIVISION. - DELETE FILE file1. - OPEN INPUT file1. - IF (f-status <> "05") - DISPLAY "FAILED OPEN: fs=" f-status - END-IF - READ file1 - AT END - IF (f-status <> "10") - DISPLAY "FAILED READ AT END: fs=" f-status - END-IF - - NOT AT END - DISPLAY "FAILED READ NO AT END: status " f-status - END-READ - CLOSE file1 - . -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_file.at:4743: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_file.at:4743" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_file.at:4743" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_file.at:4744: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_file.at:4744" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_file.at:4744" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_735 -#AT_START_736 -at_fn_group_banner 736 'run_file.at:4749' \ - "EXTERNAL RELATIVE file" " " 4 -at_xfail=no -( - $as_echo "736. $at_setup_line: testing $at_desc ..." - $at_traceon - -# FIXME: Check the function of the EXTERNAL file using a second program, too - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - - ENVIRONMENT DIVISION. - INPUT-OUTPUT SECTION. - FILE-CONTROL. - SELECT my-file - ASSIGN TO "somefile" - ORGANIZATION IS RELATIVE - RELATIVE KEY IS my-key. - - DATA DIVISION. - FILE SECTION. - FD my-file EXTERNAL. - 01 my-record. - 03 my-record-data PIC X(80). - - WORKING-STORAGE SECTION. - 01 my-key PIC 9. - - PROCEDURE DIVISION. - CONTINUE - . -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_file.at:4779: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_file.at:4779" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_file.at:4779" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_file.at:4780: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_file.at:4780" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_file.at:4780" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_736 -#AT_START_737 -at_fn_group_banner 737 'run_file.at:4785' \ - "DECLARATIVES procedure referencing" " " 4 -at_xfail=no -( - $as_echo "737. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - INPUT-OUTPUT SECTION. - FILE-CONTROL. - SELECT TEST-FILE ASSIGN "./TEST-FILE". - DATA DIVISION. - FILE SECTION. - FD TEST-FILE. - 01 TEST-REC PIC X(10). - WORKING-STORAGE SECTION. - 01 Z USAGE BINARY-LONG VALUE 0. - PROCEDURE DIVISION. - DECLARATIVES. - P01 SECTION. - USE AFTER ERROR PROCEDURE ON TEST-FILE. - P0101. - ADD 1 TO Z. - END DECLARATIVES. - MP01 SECTION. - MP0101. - OPEN INPUT TEST-FILE. - PERFORM P0101. - IF Z NOT = 2 - DISPLAY Z - END-DISPLAY - END-IF. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_file.at:4819: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_file.at:4819" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_file.at:4819" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_file.at:4820: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_file.at:4820" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_file.at:4820" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_737 -#AT_START_738 -at_fn_group_banner 738 'run_file.at:4825' \ - "DECLARATIVES procedure referencing (multiple)" " " 4 -at_xfail=no -( - $as_echo "738. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - INPUT-OUTPUT SECTION. - FILE-CONTROL. - SELECT TEST-FILE ASSIGN "./TEST-FILE". - DATA DIVISION. - FILE SECTION. - FD TEST-FILE. - 01 TEST-REC PIC X(10). - WORKING-STORAGE SECTION. - 01 Z USAGE BINARY-LONG VALUE 0. - PROCEDURE DIVISION. - DECLARATIVES. - P01 SECTION. - USE AFTER ERROR PROCEDURE ON TEST-FILE. - P0101. - ADD 1 TO Z. - P02 SECTION. - USE AFTER ERROR PROCEDURE ON OUTPUT. - P0201. - ADD 1 TO Z. - END DECLARATIVES. - MP01 SECTION. - MP0101. - OPEN INPUT TEST-FILE. - PERFORM P01 THRU P02. - IF Z NOT = 3 - DISPLAY Z - END-DISPLAY - END-IF. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_file.at:4863: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_file.at:4863" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_file.at:4863" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_file.at:4864: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_file.at:4864" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_file.at:4864" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_738 -#AT_START_739 -at_fn_group_banner 739 'run_file.at:4869' \ - "System routines for directories (1)" " " 4 -at_xfail=no -( - $as_echo "739. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 DIR PIC X(4) VALUE 'ABCD'. - - PROCEDURE DIVISION. - CALL 'CBL_CREATE_DIR' USING DIR END-CALL - IF RETURN-CODE NOT = 0 - DISPLAY 'error creating dir ...' END-DISPLAY - END-IF - - CALL 'CBL_CHANGE_DIR' USING DIR END-CALL - IF RETURN-CODE NOT = 0 - DISPLAY 'error changing dir ...' END-DISPLAY - END-IF - - CALL 'CBL_CHANGE_DIR' USING '..' END-CALL - IF RETURN-CODE NOT = 0 - DISPLAY 'error changing dir up ...' END-DISPLAY - END-IF - - CALL 'CBL_DELETE_DIR' USING DIR END-CALL - IF RETURN-CODE NOT = 0 - DISPLAY 'error deleting dir' END-DISPLAY - END-IF - - STOP RUN. -_ATEOF - - - -{ set +x -$as_echo "$at_srcdir/run_file.at:4904: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_file.at:4904" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_file.at:4904" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_file.at:4905: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_file.at:4905" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_file.at:4905" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_file.at:4906: test -e abcd" -at_fn_check_prepare_trace "run_file.at:4906" -( $at_check_trace; test -e abcd -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/run_file.at:4906" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_739 -#AT_START_740 -at_fn_group_banner 740 'run_file.at:4911' \ - "System routines for directories (2)" " " 4 -at_xfail=no -( - $as_echo "740. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 fh PIC X(4) COMP-5. - 01 rb PIC X(8) COMP-X. - 01 cb-bfr PIC X(4) COMP-X VALUE 16. - 01 w-dirname-1 PIC X(4) VALUE "tmp1". - 01 w-dirname-2 PIC X(9) VALUE "tmp1/tmp2". - 01 w-dirname-3 PIC X(14) VALUE "tmp1/tmp2/tmp3". - 01 w-filename PIC X(20) VALUE "tmp1/tmp2/tmp3/file1". - 01 w-finfo PIC X(16). - - PROCEDURE DIVISION. - CALL "CBL_CREATE_DIR" USING w-dirname-1. - IF RETURN-CODE <> 0 - DISPLAY "FAILED 1: CBL_CREATE_DIR (res=" RETURN-CODE ")" - END-IF - - CALL "CBL_CREATE_DIR" USING w-dirname-2. - IF RETURN-CODE <> 0 - DISPLAY "FAILED 2: CBL_CREATE_DIR (res=" RETURN-CODE ")" - END-IF - - * Should fail because directory does NOT exists yet. - CALL "CBL_CREATE_FILE" - USING w-filename, 1, 0, 0, fh. - IF RETURN-CODE <> 35 - DISPLAY "FAILED 3: CBL_CREATE_FILE expected fail (res=" - RETURN-CODE ")" - IF RETURN-CODE = ZERO - CALL "CBL_CLOSE_FILE" USING fh - END-IF - END-IF - - CALL "CBL_CREATE_DIR" USING w-dirname-3. - IF RETURN-CODE <> 0 - DISPLAY "FAILED 4: CBL_CREATE_DIR (res=" RETURN-CODE ")" - END-IF - - CALL "CBL_CREATE_FILE" - USING w-filename, 1, 0, 0, fh. - IF RETURN-CODE <> 0 - DISPLAY "FAILED 5: CBL_CREATE_FILE (res=" - RETURN-CODE ")" - END-IF - - CALL "CBL_CLOSE_FILE" USING fh. - IF RETURN-CODE <> 0 - DISPLAY "FAILED 6: CBL_CLOSE_FILE (res=" - RETURN-CODE ")" - END-IF - - CALL "CBL_CHECK_FILE_EXIST" USING w-filename, w-finfo. - IF RETURN-CODE <> 0 - DISPLAY "FAILED 7: CBL_CHECK_FILE_EXIST (res=" - RETURN-CODE ")" - END-IF - - - * Should fail because directory is NOT empty. - CALL "CBL_DELETE_DIR" USING w-dirname-1. - IF RETURN-CODE = 0 - DISPLAY "FAILED 8: CBL_DELETE_DIR EXPECTED TO FAIL" - END-IF - *********************** - * TO-DO: IMPLEMENT CBL_PURGE_DIR? NOT IN MF OR ACU. - *********************** - * Remove all files (including sub-directories) in tmp1 - * CALL "CBL_PURGE_DIR" USING w-dirname-1. - * IF RETURN-CODE <> 0 - * DISPLAY "FAILED 9: CBL_PURGE_DIR (res=" RETURN-CODE ")" - * END-IF - * - * Should succeed because directory is NOW empty. - * CALL "CBL_DELETE_DIR" USING w-dirname-1. - * IF RETURN-CODE <> 0 - * DISPLAY "FAILED 10: CBL_DELETE_DIR (res=" RETURN-CODE ")" - * END-IF - - STOP RUN NORMAL - . -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_file.at:5002: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_file.at:5002" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_file.at:5002" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_file.at:5003: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_file.at:5003" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_file.at:5003" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_740 -#AT_START_741 -at_fn_group_banner 741 'run_file.at:5008' \ - "System routines for files" " " 4 -at_xfail=no -( - $as_echo "741. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >file1 <<'_ATEOF' - -dummy -_ATEOF - -cat >file2 <<'_ATEOF' - -test -_ATEOF - -cat >file3 <<'_ATEOF' - -data -_ATEOF - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 FNAME PIC X(256) VALUE 'testtext.txt'. - 01 ACCESS-MODE PIC X USAGE COMP-X VALUE 2. - 01 FHANDLE PIC X(4) USAGE COMP-X. - - 01 OFFSET PIC X(8) USAGE COMP-X. - 01 NBYTES PIC X(4) USAGE COMP-X. - 01 WRITE-BUFFER PIC X(20). - - PROCEDURE DIVISION. - CALL 'CBL_CREATE_FILE' USING FNAME 55 11 22 FHANDLE - END-CALL - IF RETURN-CODE NOT = -1 - DISPLAY 'Wrong return codes ...' END-DISPLAY - END-IF - MOVE 0 TO RETURN-CODE - - CALL 'CBL_CREATE_FILE' USING - FNAME ACCESS-MODE 0 0 FHANDLE - END-CALL - IF RETURN-CODE NOT = 0 - DISPLAY 'error creating file ...' END-DISPLAY - MOVE 0 TO RETURN-CODE - END-IF - - MOVE 'TestText.ABCD' TO WRITE-BUFFER. - MOVE 0 TO OFFSET. - MOVE 9 TO NBYTES. - - CALL 'CBL_WRITE_FILE' USING - FHANDLE OFFSET NBYTES '0' WRITE-BUFFER - END-CALL - IF RETURN-CODE NOT = 0 - DISPLAY 'error writing file ...' END-DISPLAY - MOVE 0 TO RETURN-CODE - END-IF - - CALL 'CBL_FLUSH_FILE' USING FHANDLE END-CALL - IF RETURN-CODE NOT = 0 - DISPLAY 'error flushing file ...' END-DISPLAY - MOVE 0 TO RETURN-CODE - END-IF - - CALL 'CBL_CLOSE_FILE' USING FHANDLE END-CALL - IF RETURN-CODE NOT = 0 - DISPLAY 'error closing file ...' END-DISPLAY - MOVE 0 TO RETURN-CODE - END-IF - - STOP RUN. -_ATEOF - - -cat >prog2.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog2. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 FNAME PIC X(256) VALUE 'testtext.txt'. - 01 RET PIC -9. - 01 FHANDLE PIC X(4) USAGE COMP-X. - - 01 OFFSET PIC X(8) USAGE COMP-X. - 01 NBYTES PIC X(4) USAGE COMP-X. - 01 READ-BUFFER PIC X(10). - - PROCEDURE DIVISION. - CALL 'CBL_OPEN_FILE' USING FNAME 1 0 0 FHANDLE - END-CALL - IF RETURN-CODE NOT = 0 - DISPLAY 'error opening file ...' END-DISPLAY - END-IF - - MOVE SPACES TO READ-BUFFER. - MOVE 2 TO OFFSET. - MOVE 9 TO NBYTES. - - CALL 'CBL_READ_FILE' USING - FHANDLE OFFSET NBYTES 0 READ-BUFFER - END-CALL - IF RETURN-CODE NOT = 0 - DISPLAY 'error reading file ...' - return-code - END-DISPLAY - MOVE 0 TO RETURN-CODE - END-IF - IF READ-BUFFER NOT = 'stText.' *> text from first test - DISPLAY 'Wrong readbuffer ...' END-DISPLAY - END-IF - - CALL 'CBL_CLOSE_FILE' USING FHANDLE END-CALL - IF RETURN-CODE NOT = 0 - DISPLAY 'error closing file ...' - return-code - END-DISPLAY - MOVE 0 TO RETURN-CODE - END-IF - - CALL 'CBL_RENAME_FILE' USING FNAME 'foo.txt' END-CALL - IF RETURN-CODE NOT = 0 - DISPLAY 'error renaming file ...' - return-code - END-DISPLAY - MOVE 0 TO RETURN-CODE - END-IF - - CALL 'CBL_DELETE_FILE' USING 'file1' END-CALL - IF RETURN-CODE NOT = 0 - DISPLAY 'error deleting file1 ...' - return-code - END-DISPLAY - MOVE 0 TO RETURN-CODE - END-IF - CALL 'CBL_DELETE_FILE' USING 'file1' END-CALL - IF RETURN-CODE = 0 - DISPLAY 'no error on deleting file1 for the second time...' - return-code - END-DISPLAY - END-IF - MOVE 0 TO RETURN-CODE - - CALL 'C$DELETE' USING 'file2' 'S' END-CALL - IF RETURN-CODE NOT = 0 - DISPLAY 'error deleting file2 ...' - return-code - END-DISPLAY - MOVE 0 TO RETURN-CODE - END-IF - CALL 'CBL_DELETE_FILE' USING 'file2' END-CALL - IF RETURN-CODE = 0 *> note: should only return 0 or 1 when in ACUCOBOL mode - DISPLAY 'no error on deleting file2 for the second time...' - return-code - END-DISPLAY - END-IF - MOVE 0 TO RETURN-CODE - - STOP RUN. -_ATEOF - - - -{ set +x -$as_echo "$at_srcdir/run_file.at:5166: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_file.at:5166" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_file.at:5166" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_file.at:5167: \$COMPILE prog2.cob" -at_fn_check_prepare_dynamic "$COMPILE prog2.cob" "run_file.at:5167" -( $at_check_trace; $COMPILE prog2.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_file.at:5167" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_file.at:5168: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_file.at:5168" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "libcob: prog.cob:15: warning: call to CBL_CREATE_FILE with wrong file_lock: 11 -libcob: prog.cob:15: warning: call to CBL_CREATE_FILE with wrong file_dev: 22 -libcob: prog.cob:15: warning: call to CBL_OPEN_FILE with wrong access mode: 55 -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_file.at:5168" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_file.at:5173: \$COBCRUN_DIRECT ./prog2" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog2" "run_file.at:5173" -( $at_check_trace; $COBCRUN_DIRECT ./prog2 -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_file.at:5173" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_741 -#AT_START_742 -at_fn_group_banner 742 'run_file.at:5178' \ - "System routine CBL_COPY_FILE" " " 4 -at_xfail=no -( - $as_echo "742. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - PROCEDURE DIVISION. - DISPLAY "test" END-DISPLAY - STOP RUN. -_ATEOF - - -cat >prog2.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog2. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 FILE1 PIC X(8) VALUE 'prog.cob'. - 01 FILE2 PIC X(9) VALUE 'prog3.cob'. - - PROCEDURE DIVISION. - CALL 'CBL_COPY_FILE' USING - FILE1 FILE2 - END-CALL - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_file.at:5206: \$COMPILE prog2.cob" -at_fn_check_prepare_dynamic "$COMPILE prog2.cob" "run_file.at:5206" -( $at_check_trace; $COMPILE prog2.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_file.at:5206" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_file.at:5207: \$COBCRUN_DIRECT ./prog2" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog2" "run_file.at:5207" -( $at_check_trace; $COBCRUN_DIRECT ./prog2 -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_file.at:5207" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_file.at:5208: diff prog.cob prog3.cob" -at_fn_check_prepare_trace "run_file.at:5208" -( $at_check_trace; diff prog.cob prog3.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_file.at:5208" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_742 -#AT_START_743 -at_fn_group_banner 743 'run_file.at:5213' \ - "Default file external name" " " 4 -at_xfail=no -( - $as_echo "743. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >fexists_signed.c <<'_ATEOF' - - -#include -#include -#include -#include - -/* - * Check file is present and correct by comparing - * its content to a given signature. - */ -COB_EXT_EXPORT int -fexists_signed (char *fid, char *signature, int signature_size) -{ - char *bfr; - FILE *f; - int res = -1; - - f = fopen (fid, "r"); - if (f != NULL) { - bfr = (char *) malloc (signature_size); - if (1 == fread (bfr, signature_size, 1, f)) { - if (!memcmp (signature, bfr, signature_size)) { - res = 0; - } - } - free (bfr); - } - return res; -} -_ATEOF - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - INPUT-OUTPUT SECTION. - FILE-CONTROL. - SELECT file1 ASSIGN DISK. - DATA DIVISION. - FILE SECTION. - FD file1. - 1 file1-rec. - 2 file1-date pic x(8). - 2 file1-time pic x(8). - WORKING-STORAGE SECTION. - 77 erc PIC 9(8) COMP. - 77 rec-size PIC 9(8) COMP VALUE 16. - PROCEDURE DIVISION. - ACCEPT file1-date FROM DATE YYYYMMDD. - ACCEPT file1-time FROM TIME. - OPEN OUTPUT file1. - WRITE file1-rec. - CLOSE file1. - CALL "fexists_signed" USING - BY REFERENCE "./file1" file1-rec - BY VALUE rec-size - RETURNING erc. - IF (erc <> 0) - DISPLAY "FAILED file1". - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_file.at:5278: \$COMPILE_MODULE fexists_signed.c" -at_fn_check_prepare_dynamic "$COMPILE_MODULE fexists_signed.c" "run_file.at:5278" -( $at_check_trace; $COMPILE_MODULE fexists_signed.c -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_file.at:5278" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_file.at:5279: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_file.at:5279" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_file.at:5279" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_file.at:5280: unset COB_FILE_PATH; ./prog" -at_fn_check_prepare_trace "run_file.at:5280" -( $at_check_trace; unset COB_FILE_PATH; ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_file.at:5280" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_743 -#AT_START_744 -at_fn_group_banner 744 'run_file.at:5287' \ - "SEQUENTIAL basic I/O" " " 4 -at_xfail=no -( - $as_echo "744. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - INPUT-OUTPUT SECTION. - FILE-CONTROL. - SELECT file1 ASSIGN DISK ORGANIZATION SEQUENTIAL. - DATA DIVISION. - FILE SECTION. - FD file1. - 1 file1-rec pic x. - PROCEDURE DIVISION. - DELETE FILE file1. - OPEN OUTPUT file1. - MOVE "A" TO file1-rec. - WRITE file1-rec. - CLOSE file1. - OPEN INPUT file1. - READ file1. - IF (file1-rec <> "A") - display "FAILED". - CLOSE file1. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_file.at:5315: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_file.at:5315" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_file.at:5315" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_file.at:5316: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_file.at:5316" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_file.at:5316" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_744 -#AT_START_745 -at_fn_group_banner 745 'run_file.at:5321' \ - "LINE SEQUENTIAL basic I/O" " " 4 -at_xfail=no -( - $as_echo "745. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - INPUT-OUTPUT SECTION. - FILE-CONTROL. - SELECT file1 ASSIGN DISK ORGANIZATION LINE SEQUENTIAL. - SELECT file2 ASSIGN DISK ORGANIZATION LINE SEQUENTIAL. - DATA DIVISION. - FILE SECTION. - FD file1. - 1 file1-rec pic x. - FD file2. - 1 file2-rec pic xx. - PROCEDURE DIVISION. - DELETE FILE file1, file2 - OPEN OUTPUT file1, file2 - MOVE "A" TO file1-rec, file2-rec - WRITE file1-rec - WRITE file2-rec - MOVE " " TO file1-rec, file2-rec - WRITE file1-rec - WRITE file2-rec - WRITE file1-rec FROM "A" - WRITE file2-rec FROM "AA" - WRITE file1-rec FROM " " - WRITE file2-rec FROM " A" - CLOSE file1, file2 - OPEN INPUT file1, file2 - READ file1 - IF file1-rec NOT = "A" - display "FAILED 1 file1 - '" file1-rec "'". - READ file2 - IF file2-rec NOT = "A" - display "FAILED 1 file2 - '" file2-rec "'". - READ file1 - IF file1-rec NOT = SPACE - display "FAILED 2 file1 - '" file1-rec "'". - READ file2 - IF file2-rec NOT = SPACES - display "FAILED 2 file2 - '" file2-rec "'". - READ file1 - IF file1-rec NOT = "A" - display "FAILED 3 file1 - '" file1-rec "'". - READ file2 - IF file2-rec NOT = "AA" - display "FAILED 3 file2 - '" file2-rec "'". - READ file1 - IF file1-rec NOT = SPACE - display "FAILED 4 file1 - '" file1-rec "'". - READ file2 - IF file2-rec NOT = " A" - display "FAILED 4 file2 - '" file2-rec "'". - CLOSE file1, file2. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_file.at:5381: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_file.at:5381" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_file.at:5381" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_file.at:5382: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_file.at:5382" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_file.at:5382" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_745 -#AT_START_746 -at_fn_group_banner 746 'run_file.at:5387' \ - "LINE SEQUENTIAL record truncation" " " 4 -at_xfail=no -( - $as_echo "746. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >TEST-FILE <<'_ATEOF' -a -ab -abc -abcd -abcde -abcdef -_ATEOF - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - INPUT-OUTPUT SECTION. - FILE-CONTROL. - SELECT TEST-FILE ASSIGN "./TEST-FILE" - ORGANIZATION IS LINE SEQUENTIAL. - DATA DIVISION. - FILE SECTION. - FD TEST-FILE. - 01 TEST-REC PIC X(4). - PROCEDURE DIVISION. - OPEN INPUT TEST-FILE. - PERFORM 6 TIMES - READ TEST-FILE - DISPLAY "(" TEST-REC ")" - END-PERFORM - CLOSE TEST-FILE. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_file.at:5421: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_file.at:5421" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_file.at:5421" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_file.at:5422: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_file.at:5422" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo "(a ) -(ab ) -(abc ) -(abcd) -(abcd) -(abcd) -" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_file.at:5422" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_746 -#AT_START_747 -at_fn_group_banner 747 'run_file.at:5434' \ - "SEQUENTIAL file I/O with variable records" " " 4 -at_xfail=no -( - $as_echo "747. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - - ENVIRONMENT DIVISION. - INPUT-OUTPUT SECTION. - FILE-CONTROL. - SELECT f ASSIGN DISK. - - DATA DIVISION. - FILE SECTION. - FD f RECORD VARYING FROM 10 TO 20 DEPENDING rec-size. - 01 f-rec. - 02 f-x OCCURS 20 PIC X. - - WORKING-STORAGE SECTION. - 01 rec-size PIC 99. - 01 i PIC 99. - 01 1-template VALUE "+12345678++12345678+". - 02 1-x OCCURS 20 PIC X. - - PROCEDURE DIVISION. - OPEN OUTPUT f - PERFORM VARYING rec-size FROM 20 BY -1 UNTIL rec-size < 10 - WRITE f-rec FROM 1-template - END-PERFORM - CLOSE f - - OPEN INPUT f - * rec-size should not influence READ - MOVE 15 TO rec-size - PERFORM VARYING i FROM 20 BY -1 UNTIL i < 10 - READ f - AT END - DISPLAY "Failed: EOF" - STOP RUN ERROR - END-READ - - * Note the characters f-rec (rec-size + 1:) are all undefined, - * hence the refmod (1:rec-size). - DISPLAY rec-size ": >" f-rec (1:rec-size) "<" - IF rec-size NOT = i - DISPLAY "Failed: bad record size" - STOP RUN ERROR - END-IF - IF f-x (rec-size) NOT = 1-x (rec-size) - DISPLAY "Failed: bad data" - STOP RUN ERROR - END-IF - END-PERFORM - CLOSE f - . -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_file.at:5491: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_file.at:5491" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_file.at:5491" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_file.at:5492: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_file.at:5492" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo "20: >+12345678++12345678+< -19: >+12345678++12345678< -18: >+12345678++1234567< -17: >+12345678++123456< -16: >+12345678++12345< -15: >+12345678++1234< -14: >+12345678++123< -13: >+12345678++12< -12: >+12345678++1< -11: >+12345678++< -10: >+12345678+< -" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_file.at:5492" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_747 -#AT_START_748 -at_fn_group_banner 748 'run_file.at:5509' \ - "LINE SEQUENTIAL file I/O with variable records" " " 4 -at_xfail=no -( - $as_echo "748. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - - ENVIRONMENT DIVISION. - INPUT-OUTPUT SECTION. - FILE-CONTROL. - SELECT f ASSIGN DISK - LINE SEQUENTIAL. - - DATA DIVISION. - FILE SECTION. - FD f RECORD VARYING FROM 10 TO 20 DEPENDING rec-size. - 01 f-rec. - 02 f-x OCCURS 20 PIC X. - - WORKING-STORAGE SECTION. - 01 rec-size PIC 99. - 01 i PIC 99. - 01 1-template VALUE "+12345678++12345678+". - 02 1-x OCCURS 20 PIC X. - - PROCEDURE DIVISION. - OPEN OUTPUT f - PERFORM VARYING rec-size FROM 20 BY -1 UNTIL rec-size < 10 - WRITE f-rec FROM 1-template - END-PERFORM - CLOSE f - - OPEN INPUT f - * rec-size should not influence READ - MOVE 15 TO rec-size - PERFORM VARYING i FROM 20 BY -1 UNTIL i < 10 - READ f - AT END - DISPLAY "Failed: EOF" - STOP RUN ERROR - END-READ - - DISPLAY rec-size ": >" f-rec (1:rec-size) "<" - IF rec-size NOT = i - DISPLAY "Failed: bad record size" - STOP RUN ERROR - END-IF - IF f-x (rec-size) NOT = 1-x (rec-size) - DISPLAY "Failed: bad data" - STOP RUN ERROR - END-IF - END-PERFORM - CLOSE f - . -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_file.at:5565: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_file.at:5565" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_file.at:5565" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_file.at:5566: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_file.at:5566" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo "20: >+12345678++12345678+< -19: >+12345678++12345678< -18: >+12345678++1234567< -17: >+12345678++123456< -16: >+12345678++12345< -15: >+12345678++1234< -14: >+12345678++123< -13: >+12345678++12< -12: >+12345678++1< -11: >+12345678++< -10: >+12345678+< -" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_file.at:5566" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_748 -#AT_START_749 -at_fn_group_banner 749 'run_file.at:5583' \ - "SEQUENTIAL file REWRITE" " " 4 -at_xfail=no -( - $as_echo "749. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - - ENVIRONMENT DIVISION. - CONFIGURATION SECTION. - INPUT-OUTPUT SECTION. - FILE-CONTROL. - SELECT file1 ASSIGN DISK. - - DATA DIVISION. - FILE SECTION. - FD file1. - 01 file1-rec. - 02 file1-serial-1 PIC 9(6). - 02 file1-xseen PIC 9(4). - 02 file1-serial-2 PIC 9(6). - - WORKING-STORAGE SECTION. - 01 w-count PIC 9(6) VALUE 0. - 01 w-eof PIC 9 VALUE 0. - 88 eof VALUE 1 FALSE 0. - 01 w-abort PIC 9 VALUE 0. - 88 abort VALUE 1 FALSE 0. - - PROCEDURE DIVISION. - OPEN OUTPUT file1 - PERFORM VARYING w-count FROM 1 BY 1 - UNTIL w-count > 20 - MOVE w-count TO file1-serial-1 - MOVE 0 TO file1-xseen - ADD 100 w-count GIVING file1-serial-2 - WRITE file1-rec - END-PERFORM - CLOSE file1 - - OPEN I-O file1 - SET eof TO FALSE - PERFORM VARYING w-count FROM 1 BY 1 - UNTIL eof OR abort - READ file1 - AT END - SET eof TO TRUE - - NOT AT END - IF (file1-serial-1 <> w-count) - DISPLAY "FAIL 1: " w-count " :: " - file1-serial-1 - SET abort TO TRUE - ELSE IF (file1-serial-2 <> (100 + w-count)) - DISPLAY "FAIL 2: " w-count " :: " - file1-serial-2 - SET abort TO TRUE - ELSE IF (file1-xseen <> 0) - DISPLAY "FAIL 3: " w-count " :: " file1-xseen - SET abort TO TRUE - ELSE IF (w-count = 5 OR 10 OR 15 OR 20) - ADD 1000 w-count GIVING file1-serial-2 - ADD 1 TO file1-xseen - REWRITE file1-rec - END-IF - END-READ - END-PERFORM - IF NOT ((w-count = 22) AND eof) - DISPLAY "FAIL 4" - END-IF - CLOSE file1 - - OPEN INPUT file1 - SET eof TO FALSE - SET abort TO FALSE - PERFORM VARYING w-count FROM 1 BY 1 - UNTIL eof OR abort - READ file1 - AT END - SET eof TO TRUE - - NOT AT END - IF (file1-serial-1 <> w-count) - DISPLAY "FAIL 5" - SET abort TO TRUE - ELSE IF (w-count = 5 OR 10 OR 15 OR 20) - IF NOT ((file1-serial-2 = (1000 + w-count)) - AND (file1-xseen = 1)) - DISPLAY "FAIL 6" - SET abort TO TRUE - END-IF - ELSE - IF NOT ((file1-serial-2 = (100 + w-count)) - AND (file1-xseen = 0)) - DISPLAY "FAIL 7" - SET abort TO TRUE - END-IF - END-IF - END-READ - END-PERFORM - CLOSE file1 - . -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_file.at:5686: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_file.at:5686" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_file.at:5686" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_file.at:5687: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_file.at:5687" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_file.at:5687" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_749 -#AT_START_750 -at_fn_group_banner 750 'run_file.at:5692' \ - "SEQUENTIAL file with LOCK MODE EXCLUSIVE" " " 4 -at_xfail=no -( - $as_echo "750. $at_setup_line: testing $at_desc ..." - $at_traceon - - - - - -cat >prog1.cob <<'_ATEOF' - - identification division. - program-id. prog1. - environment division. - input-output section. - file-control. - select file1 assign disk - lock mode is exclusive - status is fs. - data division. - file section. - fd file1. - 1 file1-rec pic x. - working-storage section. - 1 fs pic xx. - 1 os-check pic x(7). - 88 os-is-windows-or-dos values 'WINDOWS' 'FREEDOS'. - 78 callee value "./prog2". - 78 callee-wdos value ".\prog2". - procedure division. - open output file1. - close file1. - open input file1. - accept os-check from environment "OS". - if os-check = spaces - accept os-check from environment "OS_NAME". - inspect os-check converting "werfdosin" to "WERFDOSIN". - if os-is-windows-or-dos - call "SYSTEM" using callee-wdos - else - call "SYSTEM" using callee. - close file1. - stop run. -_ATEOF - -cat >prog2.cob <<'_ATEOF' - - identification division. - program-id. prog2. - environment division. - input-output section. - file-control. - select file1 assign disk status is fs. - data division. - file section. - fd file1. - 1 file1-rec pic x. - working-storage section. - 1 fs pic xx. - procedure division. - open input file1. - if fs not = "61" - display "FAILED: " fs - close file1 - end-if. - stop run. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_file.at:5753: \$COMPILE prog1.cob" -at_fn_check_prepare_dynamic "$COMPILE prog1.cob" "run_file.at:5753" -( $at_check_trace; $COMPILE prog1.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_file.at:5753" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_file.at:5754: \$COMPILE prog2.cob" -at_fn_check_prepare_dynamic "$COMPILE prog2.cob" "run_file.at:5754" -( $at_check_trace; $COMPILE prog2.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_file.at:5754" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_file.at:5755: \$COBCRUN_DIRECT ./prog1" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog1" "run_file.at:5755" -( $at_check_trace; $COBCRUN_DIRECT ./prog1 -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_file.at:5755" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_750 -#AT_START_751 -at_fn_group_banner 751 'run_file.at:5760' \ - "SEQUENTIAL file with OPEN WITH LOCK" " " 4 -at_xfail=no -( - $as_echo "751. $at_setup_line: testing $at_desc ..." - $at_traceon - - - - - -cat >prog1.cob <<'_ATEOF' - - identification division. - program-id. prog1. - environment division. - input-output section. - file-control. - select file1 assign disk status is fs. - data division. - file section. - fd file1. - 1 file1-rec pic x. - working-storage section. - 1 fs pic xx. - 1 os-check pic x(7). - 88 os-is-windows-or-dos values 'WINDOWS' 'FREEDOS'. - 78 callee value "./prog2". - 78 callee-wdos value ".\prog2". - procedure division. - open output file1. - close file1. - open i-o file1 with lock. - accept os-check from environment "OS". - if os-check = spaces - accept os-check from environment "OS_NAME". - inspect os-check converting "werfdosin" to "WERFDOSIN". - if os-is-windows-or-dos - call "SYSTEM" using callee-wdos - else - call "SYSTEM" using callee. - close file1. - stop run. -_ATEOF - -cat >prog2.cob <<'_ATEOF' - - identification division. - program-id. prog2. - environment division. - input-output section. - file-control. - select file1 assign disk status is fs. - data division. - file section. - fd file1. - 1 file1-rec pic x. - working-storage section. - 1 fs pic xx. - procedure division. - open input file1. - if fs not = "61" - display "FAILED: " fs - close file1 - end-if. - stop run. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_file.at:5819: \$COMPILE prog1.cob" -at_fn_check_prepare_dynamic "$COMPILE prog1.cob" "run_file.at:5819" -( $at_check_trace; $COMPILE prog1.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_file.at:5819" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_file.at:5820: \$COMPILE prog2.cob" -at_fn_check_prepare_dynamic "$COMPILE prog2.cob" "run_file.at:5820" -( $at_check_trace; $COMPILE prog2.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_file.at:5820" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_file.at:5821: \$COBCRUN_DIRECT ./prog1" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog1" "run_file.at:5821" -( $at_check_trace; $COBCRUN_DIRECT ./prog1 -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_file.at:5821" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_751 -#AT_START_752 -at_fn_group_banner 752 'run_file.at:5826' \ - "SEQUENTIAL file with SHARING NO" " " 4 -at_xfail=no -( - $as_echo "752. $at_setup_line: testing $at_desc ..." - $at_traceon - - - - - -cat >prog1.cob <<'_ATEOF' - - identification division. - program-id. prog1. - environment division. - input-output section. - file-control. - select file1 assign disk - sharing no - status is fs. - data division. - file section. - fd file1. - 1 file1-rec pic x. - working-storage section. - 1 fs pic xx. - 1 os-check pic x(7). - 88 os-is-windows-or-dos values 'WINDOWS' 'FREEDOS'. - 78 callee value "./prog2". - 78 callee-wdos value ".\prog2". - procedure division. - open output file1. - close file1. - open input file1. - accept os-check from environment "OS". - if os-check = spaces - accept os-check from environment "OS_NAME". - inspect os-check converting "werfdosin" to "WERFDOSIN". - if os-is-windows-or-dos - call "SYSTEM" using callee-wdos - else - call "SYSTEM" using callee. - close file1. - stop run. -_ATEOF - -cat >prog2.cob <<'_ATEOF' - - identification division. - program-id. prog2. - environment division. - input-output section. - file-control. - select file1 assign disk status is fs. - data division. - file section. - fd file1. - 1 file1-rec pic x. - working-storage section. - 1 fs pic xx. - procedure division. - open input file1. - if fs not = "61" - display "FAILED: " fs - close file1 - end-if. - stop run. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_file.at:5887: \$COMPILE prog1.cob" -at_fn_check_prepare_dynamic "$COMPILE prog1.cob" "run_file.at:5887" -( $at_check_trace; $COMPILE prog1.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_file.at:5887" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_file.at:5888: \$COMPILE prog2.cob" -at_fn_check_prepare_dynamic "$COMPILE prog2.cob" "run_file.at:5888" -( $at_check_trace; $COMPILE prog2.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_file.at:5888" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_file.at:5889: \$COBCRUN_DIRECT ./prog1" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog1" "run_file.at:5889" -( $at_check_trace; $COBCRUN_DIRECT ./prog1 -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_file.at:5889" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_752 -#AT_START_753 -at_fn_group_banner 753 'run_file.at:5894' \ - "SEQUENTIAL file with SHARING READ ONLY" " " 4 -at_xfail=no -( - $as_echo "753. $at_setup_line: testing $at_desc ..." - $at_traceon - - - - - -cat >prog1.cob <<'_ATEOF' - - identification division. - program-id. prog1. - environment division. - input-output section. - file-control. - select file1 assign disk - sharing read only - status is fs. - data division. - file section. - fd file1. - 1 file1-rec pic x. - working-storage section. - 1 fs pic xx. - 1 os-check pic x(7). - 88 os-is-windows-or-dos values 'WINDOWS' 'FREEDOS'. - 78 callee value "./prog2". - 78 callee-wdos value ".\prog2". - procedure division. - open output file1. - close file1. - open input file1. - accept os-check from environment "OS". - if os-check = spaces - accept os-check from environment "OS_NAME". - inspect os-check converting "werfdosin" to "WERFDOSIN". - if os-is-windows-or-dos - call "SYSTEM" using callee-wdos - else - call "SYSTEM" using callee. - close file1. - stop run. -_ATEOF - -cat >prog2.cob <<'_ATEOF' - - identification division. - program-id. prog2. - environment division. - input-output section. - file-control. - select file1 assign disk status is fs. - data division. - file section. - fd file1. - 1 file1-rec pic x. - working-storage section. - 1 fs pic xx. - procedure division. - open i-o file1. - if fs not = "61" - display "FAILED: " fs - close file1 - end-if. - open input file1. - if fs not = "00" - display "FAILED: " fs - else - close file1 - end-if. - stop run. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_file.at:5961: \$COMPILE prog1.cob" -at_fn_check_prepare_dynamic "$COMPILE prog1.cob" "run_file.at:5961" -( $at_check_trace; $COMPILE prog1.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_file.at:5961" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_file.at:5962: \$COMPILE prog2.cob" -at_fn_check_prepare_dynamic "$COMPILE prog2.cob" "run_file.at:5962" -( $at_check_trace; $COMPILE prog2.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_file.at:5962" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_file.at:5963: \$COBCRUN_DIRECT ./prog1" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog1" "run_file.at:5963" -( $at_check_trace; $COBCRUN_DIRECT ./prog1 -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_file.at:5963" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_753 -#AT_START_754 -at_fn_group_banner 754 'run_file.at:5969' \ - "SEQUENTIAL file with blocked lock" " " 4 -at_xfail=yes -( - $as_echo "754. $at_setup_line: testing $at_desc ..." - $at_traceon - - - - - -cat >prog1.cob <<'_ATEOF' - - identification division. - program-id. prog1. - environment division. - input-output section. - file-control. - select file1 assign disk. - data division. - file section. - fd file1. - 1 file1-rec pic x. - working-storage section. - 1 os-check pic x(7). - 88 os-is-windows-or-dos values 'WINDOWS' 'FREEDOS'. - 78 callee value "./prog2". - 78 callee-wdos value ".\prog2". - procedure division. - open output file1. - close file1. - open i-o file1. - accept os-check from environment "OS". - if os-check = spaces - accept os-check from environment "OS_NAME". - inspect os-check converting "werfdosin" to "WERFDOSIN". - if os-is-windows-or-dos - call "SYSTEM" using callee-wdos - else - call "SYSTEM" using callee. - close file1. - stop run. -_ATEOF - -cat >prog2.cob <<'_ATEOF' - - identification division. - program-id. prog2. - environment division. - input-output section. - file-control. - select file1 assign disk status is fs. - data division. - file section. - fd file1. - 1 file1-rec pic x. - working-storage section. - 1 fs pic xx. - procedure division. - open input file1. - if fs not = "00" - display "FAILED: " fs - stop run - end-if. - close file1 - open input file1 with lock. - if fs not = "61" - display "FAILED: " fs - close file1 - end-if. - stop run. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_file.at:6033: \$COMPILE prog1.cob" -at_fn_check_prepare_dynamic "$COMPILE prog1.cob" "run_file.at:6033" -( $at_check_trace; $COMPILE prog1.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_file.at:6033" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_file.at:6034: \$COMPILE prog2.cob" -at_fn_check_prepare_dynamic "$COMPILE prog2.cob" "run_file.at:6034" -( $at_check_trace; $COMPILE prog2.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_file.at:6034" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_file.at:6035: \$COBCRUN_DIRECT ./prog1" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog1" "run_file.at:6035" -( $at_check_trace; $COBCRUN_DIRECT ./prog1 -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_file.at:6035" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_754 -#AT_START_755 -at_fn_group_banner 755 'run_file.at:6040' \ - "RELATIVE SEQUENTIAL basic I/O" " " 4 -at_xfail=no -( - $as_echo "755. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - INPUT-OUTPUT SECTION. - FILE-CONTROL. - SELECT file1 ASSIGN DISK ORGANIZATION RELATIVE. - DATA DIVISION. - FILE SECTION. - FD file1. - 1 file1-rec pic x. - PROCEDURE DIVISION. - DELETE FILE file1. - OPEN OUTPUT file1. - MOVE "A" TO file1-rec. - WRITE file1-rec. - CLOSE file1. - OPEN INPUT file1. - READ file1. - IF (file1-rec <> "A") - display "FAILED". - CLOSE file1. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_file.at:6068: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_file.at:6068" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_file.at:6068" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_file.at:6069: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_file.at:6069" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_file.at:6069" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_755 -#AT_START_756 -at_fn_group_banner 756 'run_file.at:6074' \ - "RELATIVE RANDOM basic I/O" " " 4 -at_xfail=no -( - $as_echo "756. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - INPUT-OUTPUT SECTION. - FILE-CONTROL. - SELECT file1 ASSIGN DISK - ORGANIZATION RELATIVE - ACCESS RANDOM RELATIVE KEY file1-key. - DATA DIVISION. - FILE SECTION. - FD file1. - 1 file1-rec pic x. - WORKING-STORAGE SECTION. - 77 file1-key pic 99. - PROCEDURE DIVISION. - DELETE FILE file1. - OPEN OUTPUT file1. - MOVE 1 to file1-key. - MOVE "A" TO file1-rec. - WRITE file1-rec. - MOVE 2 to file1-key. - MOVE "B" TO file1-rec. - WRITE file1-rec. - MOVE 3 to file1-key. - MOVE "C" TO file1-rec. - WRITE file1-rec. - CLOSE file1. - OPEN INPUT file1. - MOVE 2 to file1-key. - READ file1. - IF (file1-rec <> "B") - display "FAILED". - MOVE 1 to file1-key. - READ file1. - IF (file1-rec <> "A") - display "FAILED". - CLOSE file1. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_file.at:6118: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_file.at:6118" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_file.at:6118" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_file.at:6119: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_file.at:6119" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_file.at:6119" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_756 -#AT_START_757 -at_fn_group_banner 757 'run_file.at:6124' \ - "RELATIVE SEQUENTIAL with variable records" " " 4 -at_xfail=no -( - $as_echo "757. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - - ENVIRONMENT DIVISION. - INPUT-OUTPUT SECTION. - FILE-CONTROL. - SELECT f ASSIGN DISK - ORGANIZATION RELATIVE. - - DATA DIVISION. - FILE SECTION. - FD f RECORD VARYING FROM 10 TO 20 DEPENDING rec-size. - 01 f-rec. - 02 f-x OCCURS 20 PIC X. - - WORKING-STORAGE SECTION. - 01 rec-size PIC 99. - 01 i PIC 99. - 01 1-template VALUE "+12345678++12345678+". - 02 1-x OCCURS 20 PIC X. - - PROCEDURE DIVISION. - OPEN OUTPUT f - PERFORM VARYING rec-size FROM 20 BY -1 UNTIL rec-size < 10 - WRITE f-rec FROM 1-template - END-PERFORM - CLOSE f - - OPEN INPUT f - * rec-size should not influence READ - MOVE 15 TO rec-size - PERFORM VARYING i FROM 20 BY -1 UNTIL i < 10 - READ f - AT END - DISPLAY "Failed: EOF" - STOP RUN ERROR - END-READ - - DISPLAY rec-size ": >" f-rec (1:rec-size) "<" - IF rec-size NOT = i - DISPLAY "Failed: bad record size" - STOP RUN ERROR - END-IF - IF f-x (rec-size) NOT = 1-x (rec-size) - DISPLAY "Failed: bad data" - STOP RUN ERROR - END-IF - END-PERFORM - CLOSE f - . -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_file.at:6180: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_file.at:6180" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_file.at:6180" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_file.at:6181: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_file.at:6181" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo "20: >+12345678++12345678+< -19: >+12345678++12345678< -18: >+12345678++1234567< -17: >+12345678++123456< -16: >+12345678++12345< -15: >+12345678++1234< -14: >+12345678++123< -13: >+12345678++12< -12: >+12345678++1< -11: >+12345678++< -10: >+12345678+< -" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_file.at:6181" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_757 -#AT_START_758 -at_fn_group_banner 758 'run_file.at:6198' \ - "INDEXED SEQUENTIAL basic I/O" " " 4 -at_xfail=no -( - $as_echo "758. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -$as_echo "run_file.at:6201" >"$at_check_line_file" -(test "$COB_HAS_ISAM" = "no") \ - && at_fn_check_skip 77 "$at_srcdir/run_file.at:6201" - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - INPUT-OUTPUT SECTION. - FILE-CONTROL. - SELECT fileX ASSIGN DISK ORGANIZATION INDEXED - RECORD KEY fileX-key. - DATA DIVISION. - FILE SECTION. - FD fileX. - 1 fileX-rec. - 2 fileX-key pic x(6). - 2 fileX-data pic x(10). - PROCEDURE DIVISION. - OPEN OUTPUT fileX. - MOVE ALL "A" TO fileX-rec. - WRITE fileX-rec. - CLOSE fileX. - OPEN INPUT fileX. - READ fileX. - IF (fileX-rec <> ALL "A") - display "FAILED". - CLOSE fileX. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_file.at:6230: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_file.at:6230" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_file.at:6230" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_file.at:6231: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_file.at:6231" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_file.at:6231" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_758 -#AT_START_759 -at_fn_group_banner 759 'run_file.at:6236' \ - "INDEXED SEQUENTIAL with variable records" " " 4 -at_xfail=no -( - $as_echo "759. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -$as_echo "run_file.at:6239" >"$at_check_line_file" -(test "$COB_HAS_ISAM" = "no") \ - && at_fn_check_skip 77 "$at_srcdir/run_file.at:6239" -$as_echo "run_file.at:6240" >"$at_check_line_file" -(test "$COB_HAS_ISAM" = "disam") \ - && at_fn_check_skip 77 "$at_srcdir/run_file.at:6240" - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - - ENVIRONMENT DIVISION. - INPUT-OUTPUT SECTION. - FILE-CONTROL. - SELECT f ASSIGN DISK - INDEXED - RECORD KEY f-key - ACCESS RANDOM. - - DATA DIVISION. - FILE SECTION. - FD f RECORD VARYING FROM 12 TO 22 DEPENDING rec-size. - 01 f-rec. - 02 f-key PIC 99. - 02 f-data. - 03 f-x OCCURS 20 PIC X. - - WORKING-STORAGE SECTION. - 01 rec-size PIC 99. - 01 1-template VALUE "+12345678++12345678+". - 02 1-x OCCURS 20 PIC X. - - PROCEDURE DIVISION. - OPEN OUTPUT f - MOVE 1 TO f-key - PERFORM VARYING rec-size FROM 22 BY -1 UNTIL rec-size < 12 - MOVE 1-template TO f-data - WRITE f-rec - ADD 1 TO f-key - END-PERFORM - CLOSE f - - OPEN INPUT f - * rec-size should not influence READ - MOVE 15 TO rec-size - PERFORM VARYING f-key FROM 1 BY 1 UNTIL f-key > 11 - READ f - AT END - DISPLAY "Failed: EOF" - STOP RUN ERROR - END-READ - - DISPLAY rec-size ": >" f-rec (3:rec-size - 2) "<" - IF rec-size NOT = (22 - f-key) + 1 - DISPLAY "Failed: bad record size - " rec-size - STOP RUN ERROR - END-IF - IF f-x (rec-size - 2) NOT = 1-x (rec-size - 2) - DISPLAY "Failed: bad data - " f-data - STOP RUN ERROR - END-IF - END-PERFORM - CLOSE f - . -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_file.at:6301: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_file.at:6301" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_file.at:6301" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_file.at:6302: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_file.at:6302" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo "22: >+12345678++12345678+< -21: >+12345678++12345678< -20: >+12345678++1234567< -19: >+12345678++123456< -18: >+12345678++12345< -17: >+12345678++1234< -16: >+12345678++123< -15: >+12345678++12< -14: >+12345678++1< -13: >+12345678++< -12: >+12345678+< -" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_file.at:6302" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_759 -#AT_START_760 -at_fn_group_banner 760 'run_file.at:6319' \ - "INDEXED file with LOCK MODE EXCLUSIVE" " " 4 -at_xfail=no -( - $as_echo "760. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -## TO-DO: Support INDEXED file sharing/locking. -$as_echo "run_file.at:6323" >"$at_check_line_file" -(test "$COB_HAS_ISAM" = "no") \ - && at_fn_check_skip 77 "$at_srcdir/run_file.at:6323" - - -cat >prog1.cob <<'_ATEOF' - - identification division. - program-id. prog1. - environment division. - input-output section. - file-control. - select file1 assign disk - organization indexed - record key file1-key - lock mode is exclusive - status is fs. - data division. - file section. - fd file1. - 1 file1-rec. - 2 file1-key pic x. - working-storage section. - 1 fs pic xx. - 1 os-check pic x(7). - 88 os-is-windows-or-dos values 'WINDOWS' 'FREEDOS'. - 78 callee value "./prog2". - 78 callee-wdos value ".\prog2". - procedure division. - open output file1. - close file1. - open input file1. - accept os-check from environment "OS". - if os-check = spaces - accept os-check from environment "OS_NAME". - inspect os-check converting "werfdosin" to "WERFDOSIN". - if os-is-windows-or-dos - call "SYSTEM" using callee-wdos - else - call "SYSTEM" using callee. - close file1. - stop run. -_ATEOF - -cat >prog2.cob <<'_ATEOF' - - identification division. - program-id. prog2. - environment division. - input-output section. - file-control. - select file1 assign disk - organization indexed - record key file1-key - status is fs. - data division. - file section. - fd file1. - 1 file1-rec. - 2 file1-key pic x. - working-storage section. - 1 fs pic xx. - procedure division. - open input file1. - if fs not = "61" - display "FAILED: " fs - close file1 - end-if. - stop run. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_file.at:6389: \$COMPILE prog1.cob" -at_fn_check_prepare_dynamic "$COMPILE prog1.cob" "run_file.at:6389" -( $at_check_trace; $COMPILE prog1.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_file.at:6389" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_file.at:6390: \$COMPILE prog2.cob" -at_fn_check_prepare_dynamic "$COMPILE prog2.cob" "run_file.at:6390" -( $at_check_trace; $COMPILE prog2.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_file.at:6390" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_file.at:6391: \$COBCRUN_DIRECT ./prog1" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog1" "run_file.at:6391" -( $at_check_trace; $COBCRUN_DIRECT ./prog1 -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_file.at:6391" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_760 -#AT_START_761 -at_fn_group_banner 761 'run_file.at:6396' \ - "INDEXED file with OPEN WITH LOCK" " " 4 -at_xfail=yes -( - $as_echo "761. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -## TO-DO: Support INDEXED file sharing/locking. -$as_echo "run_file.at:6400" >"$at_check_line_file" -(test "$COB_HAS_ISAM" = "no") \ - && at_fn_check_skip 77 "$at_srcdir/run_file.at:6400" - - -cat >prog1.cob <<'_ATEOF' - - identification division. - program-id. prog1. - environment division. - input-output section. - file-control. - select file1 assign disk - organization indexed - record key file1-key - status is fs. - data division. - file section. - fd file1. - 1 file1-rec. - 2 file1-key pic x. - working-storage section. - 1 fs pic xx. - 1 os-check pic x(7). - 88 os-is-windows-or-dos values 'WINDOWS' 'FREEDOS'. - 78 callee value "./prog2". - 78 callee-wdos value ".\prog2". - procedure division. - open output file1. - close file1. - open input file1 with lock. - accept os-check from environment "OS". - if os-check = spaces - accept os-check from environment "OS_NAME". - inspect os-check converting "werfdosin" to "WERFDOSIN". - if os-is-windows-or-dos - call "SYSTEM" using callee-wdos - else - call "SYSTEM" using callee. - close file1. - stop run. -_ATEOF - -cat >prog2.cob <<'_ATEOF' - - identification division. - program-id. prog2. - environment division. - input-output section. - file-control. - select file1 assign disk - organization indexed - record key file1-key - status is fs. - data division. - file section. - fd file1. - 1 file1-rec. - 2 file1-key pic x. - working-storage section. - 1 fs pic xx. - procedure division. - open input file1. - if fs not = "61" - display "FAILED: " fs - close file1 - end-if. - stop run. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_file.at:6465: \$COMPILE prog1.cob" -at_fn_check_prepare_dynamic "$COMPILE prog1.cob" "run_file.at:6465" -( $at_check_trace; $COMPILE prog1.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_file.at:6465" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_file.at:6466: \$COMPILE prog2.cob" -at_fn_check_prepare_dynamic "$COMPILE prog2.cob" "run_file.at:6466" -( $at_check_trace; $COMPILE prog2.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_file.at:6466" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_file.at:6467: \$COBCRUN_DIRECT ./prog1" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog1" "run_file.at:6467" -( $at_check_trace; $COBCRUN_DIRECT ./prog1 -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_file.at:6467" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_761 -#AT_START_762 -at_fn_group_banner 762 'run_file.at:6472' \ - "INDEXED file with SHARING NO" " " 4 -at_xfail=no -( - $as_echo "762. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -## TO-DO: Support INDEXED file sharing/locking. -$as_echo "run_file.at:6476" >"$at_check_line_file" -(test "$COB_HAS_ISAM" = "no") \ - && at_fn_check_skip 77 "$at_srcdir/run_file.at:6476" - - -cat >prog1.cob <<'_ATEOF' - - identification division. - program-id. prog1. - environment division. - input-output section. - file-control. - select file1 assign disk - organization indexed - record key file1-key - sharing no - status is fs. - data division. - file section. - fd file1. - 1 file1-rec. - 2 file1-key pic x. - working-storage section. - 1 fs pic xx. - 1 os-check pic x(7). - 88 os-is-windows-or-dos values 'WINDOWS' 'FREEDOS'. - 78 callee value "./prog2". - 78 callee-wdos value ".\prog2". - procedure division. - open output file1. - close file1. - open input file1. - accept os-check from environment "OS". - if os-check = spaces - accept os-check from environment "OS_NAME". - inspect os-check converting "werfdosin" to "WERFDOSIN". - if os-is-windows-or-dos - call "SYSTEM" using callee-wdos - else - call "SYSTEM" using callee. - close file1. - stop run. -_ATEOF - -cat >prog2.cob <<'_ATEOF' - - identification division. - program-id. prog2. - environment division. - input-output section. - file-control. - select file1 assign disk - organization indexed - record key file1-key - status is fs. - data division. - file section. - fd file1. - 1 file1-rec. - 2 file1-key pic x. - working-storage section. - 1 fs pic xx. - procedure division. - open input file1. - if fs not = "61" - display "FAILED: " fs - close file1 - end-if. - stop run. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_file.at:6542: \$COMPILE prog1.cob" -at_fn_check_prepare_dynamic "$COMPILE prog1.cob" "run_file.at:6542" -( $at_check_trace; $COMPILE prog1.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_file.at:6542" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_file.at:6543: \$COMPILE prog2.cob" -at_fn_check_prepare_dynamic "$COMPILE prog2.cob" "run_file.at:6543" -( $at_check_trace; $COMPILE prog2.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_file.at:6543" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_file.at:6544: \$COBCRUN_DIRECT ./prog1" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog1" "run_file.at:6544" -( $at_check_trace; $COBCRUN_DIRECT ./prog1 -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_file.at:6544" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_762 -#AT_START_763 -at_fn_group_banner 763 'run_file.at:6549' \ - "INDEXED file with SHARING READ ONLY" " " 4 -at_xfail=no -( - $as_echo "763. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -## TO-DO: Support INDEXED file sharing/locking. -$as_echo "run_file.at:6553" >"$at_check_line_file" -(test "$COB_HAS_ISAM" = "no") \ - && at_fn_check_skip 77 "$at_srcdir/run_file.at:6553" - - -cat >prog1.cob <<'_ATEOF' - - identification division. - program-id. prog1. - environment division. - input-output section. - file-control. - select file1 assign disk - organization indexed - record key file1-key - sharing read only - status is fs. - data division. - file section. - fd file1. - 1 file1-rec. - 2 file1-key pic x. - working-storage section. - 1 fs pic xx. - 1 os-check pic x(7). - 88 os-is-windows-or-dos values 'WINDOWS' 'FREEDOS'. - 78 callee value "./prog2". - 78 callee-wdos value ".\prog2". - procedure division. - open output file1. - close file1. - open input file1. - accept os-check from environment "OS". - if os-check = spaces - accept os-check from environment "OS_NAME". - inspect os-check converting "werfdosin" to "WERFDOSIN". - if os-is-windows-or-dos - call "SYSTEM" using callee-wdos - else - call "SYSTEM" using callee. - close file1. - stop run. -_ATEOF - -cat >prog2.cob <<'_ATEOF' - - identification division. - program-id. prog2. - environment division. - input-output section. - file-control. - select file1 assign disk - organization indexed - record key file1-key - status is fs. - data division. - file section. - fd file1. - 1 file1-rec. - 2 file1-key pic x. - working-storage section. - 1 fs pic xx. - procedure division. - open i-o file1. - if fs not = "61" - display "FAILED: " fs - close file1 - end-if. - open input file1. - if fs not = "00" - display "FAILED: " fs - else - close file1 - end-if. - stop run. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_file.at:6625: \$COMPILE prog1.cob" -at_fn_check_prepare_dynamic "$COMPILE prog1.cob" "run_file.at:6625" -( $at_check_trace; $COMPILE prog1.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_file.at:6625" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_file.at:6626: \$COMPILE prog2.cob" -at_fn_check_prepare_dynamic "$COMPILE prog2.cob" "run_file.at:6626" -( $at_check_trace; $COMPILE prog2.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_file.at:6626" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_file.at:6627: \$COBCRUN_DIRECT ./prog1" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog1" "run_file.at:6627" -( $at_check_trace; $COBCRUN_DIRECT ./prog1 -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_file.at:6627" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_763 -#AT_START_764 -at_fn_group_banner 764 'run_file.at:6633' \ - "INDEXED file with blocked lock" " " 4 -at_xfail=yes -( - $as_echo "764. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -## TO-DO: Support INDEXED file sharing/locking. -$as_echo "run_file.at:6637" >"$at_check_line_file" -(test "$COB_HAS_ISAM" = "no") \ - && at_fn_check_skip 77 "$at_srcdir/run_file.at:6637" - - -cat >prog1.cob <<'_ATEOF' - - identification division. - program-id. prog1. - environment division. - input-output section. - file-control. - select file1 assign disk - organization indexed - record key file1-key. - data division. - file section. - fd file1. - 1 file1-rec. - 2 file1-key pic x. - working-storage section. - 1 os-check pic x(7). - 88 os-is-windows-or-dos values 'WINDOWS' 'FREEDOS'. - 78 callee value "./prog2". - 78 callee-wdos value ".\prog2". - procedure division. - open output file1. - close file1. - open input file1. - accept os-check from environment "OS". - if os-check = spaces - accept os-check from environment "OS_NAME". - inspect os-check converting "werfdosin" to "WERFDOSIN". - if os-is-windows-or-dos - call "SYSTEM" using callee-wdos - else - call "SYSTEM" using callee. - close file1. - stop run. -_ATEOF - -cat >prog2.cob <<'_ATEOF' - - identification division. - program-id. prog2. - environment division. - input-output section. - file-control. - select file1 assign disk - organization indexed - record key file1-key - status is fs. - data division. - file section. - fd file1. - 1 file1-rec. - 2 file1-key pic x. - working-storage section. - 1 fs pic xx. - procedure division. - open input file1. - if fs not = "00" - display "FAILED: " fs - stop run - end-if. - close file1 - open input file1 with lock. - if fs not = "61" - display "FAILED: " fs - close file1 - end-if. - stop run. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_file.at:6706: \$COMPILE prog1.cob" -at_fn_check_prepare_dynamic "$COMPILE prog1.cob" "run_file.at:6706" -( $at_check_trace; $COMPILE prog1.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_file.at:6706" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_file.at:6707: \$COMPILE prog2.cob" -at_fn_check_prepare_dynamic "$COMPILE prog2.cob" "run_file.at:6707" -( $at_check_trace; $COMPILE prog2.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_file.at:6707" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_file.at:6708: \$COBCRUN_DIRECT ./prog1" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog1" "run_file.at:6708" -( $at_check_trace; $COBCRUN_DIRECT ./prog1 -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_file.at:6708" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_764 -#AT_START_765 -at_fn_group_banner 765 'run_file.at:6713' \ - "INDEXED file with LOCK AUTOMATIC (1)" " " 4 -at_xfail=yes -( - $as_echo "765. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -$as_echo "run_file.at:6716" >"$at_check_line_file" -(test "$COB_HAS_ISAM" = "no") \ - && at_fn_check_skip 77 "$at_srcdir/run_file.at:6716" - - -cat >prog1.cob <<'_ATEOF' - - identification division. - program-id. prog1. - environment division. - input-output section. - file-control. - select file1 assign disk - access mode is random - organization indexed - record key file1-key - lock mode is automatic - status is fs. - data division. - file section. - fd file1. - 1 file1-rec. - 2 file1-key pic x. - working-storage section. - 1 fs pic xx. - 1 os-check pic x(7). - 88 os-is-windows-or-dos values 'WINDOWS' 'FREEDOS'. - 78 callee value "./prog2". - 78 callee-wdos value ".\prog2". - procedure division. - open output file1. - move "X" to file1-key. - write file1-rec. - if fs not = "00" - display "FAILED 1::w fs=" fs. - close file1. - open i-o file1. - move "X" to file1-key. - read file1. - if fs not = "00" - display "FAILED 1::r fs=" fs. - accept os-check from environment "OS". - if os-check = spaces - accept os-check from environment "OS_NAME". - inspect os-check converting "werfdosin" to "WERFDOSIN". - if os-is-windows-or-dos - call "SYSTEM" using callee-wdos - else - call "SYSTEM" using callee. - close file1. - stop run. -_ATEOF - -cat >prog2.cob <<'_ATEOF' - - identification division. - program-id. prog2. - environment division. - input-output section. - file-control. - select file1 assign disk - access mode is random - organization indexed - record key file1-key - lock mode is automatic - status is fs. - data division. - file section. - fd file1. - 1 file1-rec. - 2 file1-key pic x. - working-storage section. - 1 fs pic xx. - procedure division. - open i-o file1. - move "X" to file1-key. - read file1. - if fs not = "61" - display "FAILED 2::r " fs. - close file1 - stop run. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_file.at:6794: \$COMPILE prog1.cob" -at_fn_check_prepare_dynamic "$COMPILE prog1.cob" "run_file.at:6794" -( $at_check_trace; $COMPILE prog1.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_file.at:6794" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_file.at:6795: \$COMPILE prog2.cob" -at_fn_check_prepare_dynamic "$COMPILE prog2.cob" "run_file.at:6795" -( $at_check_trace; $COMPILE prog2.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_file.at:6795" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_file.at:6796: \$COBCRUN_DIRECT ./prog1" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog1" "run_file.at:6796" -( $at_check_trace; $COBCRUN_DIRECT ./prog1 -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_file.at:6796" -$at_failed && at_fn_log_failure -$at_traceon; } - - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_765 -#AT_START_766 -at_fn_group_banner 766 'run_file.at:6802' \ - "INDEXED file with LOCK AUTOMATIC (2)" " " 4 -at_xfail=no -( - $as_echo "766. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -$as_echo "run_file.at:6805" >"$at_check_line_file" -(test "$COB_HAS_ISAM" = "no") \ - && at_fn_check_skip 77 "$at_srcdir/run_file.at:6805" - -cat >prog1.cob <<'_ATEOF' - - identification division. - program-id. prog1. - environment division. - input-output section. - file-control. - select file1 assign disk - access mode is random - organization indexed - record key file1-key - lock mode is automatic - status is fs. - data division. - file section. - fd file1. - 1 file1-rec. - 2 file1-key pic x. - working-storage section. - 1 fs pic xx. - 1 os-check pic x(7). - 88 os-is-windows-or-dos values 'WINDOWS' 'FREEDOS'. - 78 callee value "./prog2". - 78 callee-wdos value ".\prog2". - procedure division. - open output file1. - move "X" to file1-key. - write file1-rec. - if fs not = "00" - display "FAILED 1::w fs=" fs. - close file1. - open i-o file1. - move "X" to file1-key. - read file1. - if fs not = "00" - display "FAILED 1::r fs=" fs. - rewrite file1-rec. - if fs not = "00" - display "FAILED 1::rw fs=" fs. - accept os-check from environment "OS". - if os-check = spaces - accept os-check from environment "OS_NAME". - inspect os-check converting "werfdosin" to "WERFDOSIN". - if os-is-windows-or-dos - call "SYSTEM" using callee-wdos - else - call "SYSTEM" using callee. - close file1. - stop run. -_ATEOF - -cat >prog2.cob <<'_ATEOF' - - identification division. - program-id. prog2. - environment division. - input-output section. - file-control. - select file1 assign disk - access mode is random - organization indexed - record key file1-key - status is fs. - data division. - file section. - fd file1. - 1 file1-rec. - 2 file1-key pic x. - working-storage section. - 1 fs pic xx. - procedure division. - open input file1. - move "X" to file1-key. - read file1. - if fs not = "00" - display "FAILED 2::r " fs - end-if. - close file1 - stop run. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_file.at:6885: \$COMPILE prog1.cob" -at_fn_check_prepare_dynamic "$COMPILE prog1.cob" "run_file.at:6885" -( $at_check_trace; $COMPILE prog1.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_file.at:6885" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_file.at:6886: \$COMPILE prog2.cob" -at_fn_check_prepare_dynamic "$COMPILE prog2.cob" "run_file.at:6886" -( $at_check_trace; $COMPILE prog2.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_file.at:6886" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_file.at:6887: \$COBCRUN_DIRECT ./prog1" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog1" "run_file.at:6887" -( $at_check_trace; $COBCRUN_DIRECT ./prog1 -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_file.at:6887" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_766 -#AT_START_767 -at_fn_group_banner 767 'run_file.at:6892' \ - "INDEXED file with LOCK MANUAL" " " 4 -at_xfail=no -( - $as_echo "767. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -$as_echo "run_file.at:6895" >"$at_check_line_file" -(test "$COB_HAS_ISAM" = "no") \ - && at_fn_check_skip 77 "$at_srcdir/run_file.at:6895" - -cat >prog1.cob <<'_ATEOF' - - identification division. - program-id. prog1. - environment division. - input-output section. - file-control. - select file1 assign disk - access mode is random - organization indexed - record key file1-key - lock mode is manual - status is fs. - data division. - file section. - fd file1. - 1 file1-rec. - 2 file1-key pic x. - working-storage section. - 1 fs pic xx. - 1 os-check pic x(7). - 88 os-is-windows-or-dos values 'WINDOWS' 'FREEDOS'. - 78 callee value "./prog2". - 78 callee-wdos value ".\prog2". - procedure division. - open output file1. - move "X" to file1-key. - write file1-rec. - if fs not = "00" - display "FAILED 1::w fs=" fs. - close file1. - open i-o file1. - move "X" to file1-key. - read file1 with lock. - if fs not = "00" - display "FAILED 1::r fs=" fs. - accept os-check from environment "OS". - if os-check = spaces - accept os-check from environment "OS_NAME". - inspect os-check converting "werfdosin" to "WERFDOSIN". - if os-is-windows-or-dos - call "SYSTEM" using callee-wdos - else - call "SYSTEM" using callee. - close file1. - stop run. -_ATEOF - -cat >prog2.cob <<'_ATEOF' - - identification division. - program-id. prog2. - environment division. - input-output section. - file-control. - select file1 assign disk - access mode is random - organization indexed - record key file1-key - status is fs. - data division. - file section. - fd file1. - 1 file1-rec. - 2 file1-key pic x. - working-storage section. - 1 fs pic xx. - procedure division. - open i-o file1. - if fs not = "61" - display "FAILED 2::r " fs - end-if. - move "X" to file1-key. - read file1. - close file1 - stop run. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_file.at:6972: \$COMPILE prog1.cob" -at_fn_check_prepare_dynamic "$COMPILE prog1.cob" "run_file.at:6972" -( $at_check_trace; $COMPILE prog1.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_file.at:6972" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_file.at:6973: \$COMPILE prog2.cob" -at_fn_check_prepare_dynamic "$COMPILE prog2.cob" "run_file.at:6973" -( $at_check_trace; $COMPILE prog2.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_file.at:6973" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_file.at:6974: \$COBCRUN_DIRECT ./prog1" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog1" "run_file.at:6974" -( $at_check_trace; $COBCRUN_DIRECT ./prog1 -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_file.at:6974" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_767 -#AT_START_768 -at_fn_group_banner 768 'run_file.at:6979' \ - "START INDEXED" " " 4 -at_xfail=no -( - $as_echo "768. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -$as_echo "run_file.at:6982" >"$at_check_line_file" -(test "$COB_HAS_ISAM" = "no") \ - && at_fn_check_skip 77 "$at_srcdir/run_file.at:6982" - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - INPUT-OUTPUT SECTION. - FILE-CONTROL. - SELECT file1 ASSIGN TO "./file1X" - ORGANIZATION INDEXED - ACCESS DYNAMIC RECORD KEY file1-key. - DATA DIVISION. - FILE SECTION. - FD file1. - 1 file1-rec. - 2 file1-key pic 999. - 2 file1-data pic 999. - PROCEDURE DIVISION. - OPEN OUTPUT file1. - CLOSE file1. - OPEN I-O file1. - MOVE 10 TO file1-key file1-data. - WRITE file1-rec. - MOVE 11 TO file1-key file1-data. - WRITE file1-rec. - MOVE 12 TO file1-key file1-data. - WRITE file1-rec. - MOVE 13 TO file1-key file1-data. - WRITE file1-rec. - * - MOVE 0 TO file1-key. - START file1 KEY > file1-key. - READ file1 NEXT. - IF (file1-data <> 10) - DISPLAY "FAILED: START key > 0". - * - MOVE 99 TO file1-key. - START file1 KEY < file1-key. - READ file1 NEXT. - IF (file1-data <> 13) - DISPLAY "FAILED: START key < 99". - * - MOVE 999 TO file1-key. - START file1 FIRST. - READ file1 NEXT. - IF (file1-data <> 10) - DISPLAY "FAILED: START key FIRST". - * - MOVE 0 TO file1-key. - START file1 LAST. - READ file1 NEXT. - IF (file1-data <> 13) - DISPLAY "FAILED: START key LAST". - * - MOVE 0 TO file1-key. - START file1 KEY >= file1-key. - READ file1 NEXT. - IF (file1-data <> 10) - DISPLAY "FAILED: START key >= 0". - * - MOVE 99 TO file1-key. - START file1 KEY <= file1-key. - READ file1 NEXT. - IF (file1-data <> 13) - DISPLAY "FAILED: START key <= 99". - - CLOSE file1. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_file.at:7052: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_file.at:7052" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_file.at:7052" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_file.at:7053: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_file.at:7053" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_file.at:7053" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_768 -#AT_START_769 -at_fn_group_banner 769 'run_file.at:7058' \ - "INDEXED partial keys" " " 4 -at_xfail=no -( - $as_echo "769. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -$as_echo "run_file.at:7061" >"$at_check_line_file" -(test "$COB_HAS_ISAM" = "no") \ - && at_fn_check_skip 77 "$at_srcdir/run_file.at:7061" - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - - ENVIRONMENT DIVISION. - INPUT-OUTPUT SECTION. - FILE-CONTROL. - SELECT OPTIONAL f ASSIGN "fileX" - ORGANIZATION INDEXED - ACCESS DYNAMIC - RECORD KEY f-key1 - ALTERNATE RECORD f-key2 - ALTERNATE RECORD f-key3 DUPLICATES - STATUS f-status. - - DATA DIVISION. - FILE SECTION. - FD f. - 01 f-rec. - 02 f-key1. - 03 f-key1-1 PIC X(3). - 03 f-key1-2 PIC X(3). - 02 f-key2. - 03 f-key2-1 PIC X(3). - 03 f-key2-2 PIC X(3). - 02 f-key3. - 03 f-key3-1 PIC X(3). - 03 f-key3-2 PIC X(3). - 02 file1-serial PIC 99. - - WORKING-STORAGE SECTION. - 01 f-status PIC XX. - 01 w-serial PIC 99 VALUE 0. - - PROCEDURE DIVISION. - DELETE FILE f - OPEN I-O f - MOVE "AAAAAAaaaaaaXX----" TO f-rec - PERFORM write-f - MOVE "AAAAABaaaaabXX----" TO f-rec - PERFORM write-f - MOVE "AAAABBaaaabbXX----" TO f-rec - PERFORM write-f - MOVE "AAABBBaaabbbXXX---" TO f-rec - PERFORM write-f - MOVE "AABBBBaabbbbXXX---" TO f-rec - PERFORM write-f - MOVE "ABBBBBabbbbbXXX---" TO f-rec - PERFORM write-f - MOVE "BBBBBBbbbbbbXXX---" TO f-rec - PERFORM write-f - - MOVE "AAB" TO f-key1-1 - MOVE "~~~" TO f-key1-2 - START f KEY = f-key1-1 - READ f NEXT - IF (f-status <> "00") OR - (file1-serial <> 4) - DISPLAY "FAILED 1: status " f-status - END-IF - - MOVE "AAB" TO f-key1-1 - MOVE "~~~" TO f-key1-2 - START f KEY < f-key1-1 - READ f PREVIOUS - IF (f-status <> "00") OR - (file1-serial <> 3) - DISPLAY "FAILED 2: status " f-status - END-IF - - MOVE "AAA" TO f-key1-1 - MOVE "~~~" TO f-key1-2 - START f KEY > f-key1-1 - READ f NEXT - IF (f-status <> "00") OR - (file1-serial <> 4) - DISPLAY "FAILED 3: status " f-status - "serial: " file1-serial - END-IF - - MOVE "aab" TO f-key2-1 - MOVE "~~~" TO f-key2-2 - START f KEY = f-key2-1 - READ f NEXT - IF (f-status <> "00") OR - (file1-serial <> 4) - DISPLAY "FAILED 4: status " f-status - "serial: " file1-serial - END-IF - - MOVE "aab" TO f-key2-1 - MOVE "~~~" TO f-key2-2 - START f KEY < f-key2-1 - READ f PREVIOUS - IF (f-status <> "00") OR - (file1-serial <> 3) - DISPLAY "FAILED 5: status " f-status - "serial: " file1-serial - END-IF - - MOVE "aaa" TO f-key2-1 - MOVE "~~~" TO f-key2-2 - START f KEY > f-key2-1 - READ f NEXT - IF (f-status <> "00") OR - (file1-serial <> 4) - DISPLAY "FAILED 6: status " f-status - "serial: " file1-serial - END-IF - - MOVE "XX-" TO f-key3-1 - START f KEY > f-key3-1 - READ f NEXT - * Not yet implemented: Return file-status "02" if duplicates exist - * IF (f-status <> "02") OR - IF (f-status <> "00") OR - (file1-serial <> 3) - DISPLAY "FAILED 7: status " f-status - "serial: " file1-serial - END-IF - CLOSE f - STOP RUN - . - write-f. - MOVE w-serial TO file1-serial - WRITE f-rec - ADD 1 TO w-serial - . -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_file.at:7193: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_file.at:7193" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_file.at:7193" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_file.at:7194: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_file.at:7194" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_file.at:7194" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_769 -#AT_START_770 -at_fn_group_banner 770 'run_file.at:7202' \ - "INDEXED undeclared keys" " " 4 -at_xfail=no -( - $as_echo "770. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -$as_echo "run_file.at:7205" >"$at_check_line_file" -(test "$COB_HAS_ISAM" = "no") \ - && at_fn_check_skip 77 "$at_srcdir/run_file.at:7205" - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - INPUT-OUTPUT SECTION. - FILE-CONTROL. - SELECT file1 ASSIGN TO "./fileX" - ORGANIZATION INDEXED - ACCESS RANDOM - RECORD KEY file1-key1 - ALTERNATE RECORD KEY file1-key2 - ALTERNATE RECORD KEY file1-key3. - SELECT file2 ASSIGN TO "./fileX" - ORGANIZATION INDEXED - ACCESS RANDOM - RECORD KEY file2-key1 - ALTERNATE RECORD KEY file2-key2. - SELECT file3 ASSIGN TO "./fileX" - ORGANIZATION INDEXED - ACCESS RANDOM - RECORD KEY file3-key1. - DATA DIVISION. - FILE SECTION. - FD file1. - 1 file1-rec. - 2 file1-key1 pic 999. - 2 file1-key2 pic 999. - 2 file1-key3 pic 999. - 2 file1-data pic 999. - FD file2. - 1 file2-rec. - 2 file2-key1 pic 999. - 2 file2-key2 pic 999. - 2 file2-key3 pic 999. - 2 file2-data pic 999. - FD file3. - 1 file3-rec. - 2 file3-key1 pic 999. - 2 file3-key2 pic 999. - 2 file3-key3 pic 999. - 2 file3-data pic 999. - WORKING-STORAGE SECTION. - 77 ix pic 9(6). - PROCEDURE DIVISION. - OPEN OUTPUT file1. - PERFORM VARYING ix FROM 1 BY 1 - UNTIL ix > 10 - MOVE ix TO file1-key1 file1-data - ADD 100 TO ix GIVING file1-key2 - ADD 200 TO ix GIVING file1-key3 - WRITE file1-rec - END-PERFORM. - CLOSE file1. - * - OPEN INPUT file1. - PERFORM VARYING ix FROM 1 BY 1 - UNTIL ix > 10 - MOVE ix TO file1-key1 - READ file1 KEY file1-key1 - IF (file1-data <> ix) - DISPLAY "FAILED 1-1" - END-IF - END-PERFORM. - PERFORM VARYING ix FROM 1 BY 1 - UNTIL ix > 10 - ADD 100 TO ix GIVING file1-key2 - READ file1 KEY file1-key2 - IF (file1-data <> ix) - DISPLAY "FAILED 1-2" - END-IF - END-PERFORM. - PERFORM VARYING ix FROM 1 BY 1 - UNTIL ix > 10 - ADD 200 TO ix GIVING file1-key3 - READ file1 KEY file1-key3 - IF (file1-data <> ix) - DISPLAY "FAILED 1-3" - END-IF - END-PERFORM. - CLOSE file1. - * - OPEN INPUT file2. - PERFORM VARYING ix FROM 1 BY 1 - UNTIL ix > 10 - MOVE ix TO file2-key1 - READ file2 KEY file2-key1 - IF (file2-data <> ix) - DISPLAY "FAILED 2-1" - END-IF - END-PERFORM. - PERFORM VARYING ix FROM 1 BY 1 - UNTIL ix > 10 - ADD 100 TO ix GIVING file2-key2 - READ file2 KEY file2-key2 - IF (file2-data <> ix) - DISPLAY "FAILED 2-2" - END-IF - END-PERFORM. - CLOSE file2. - * - OPEN INPUT file3. - PERFORM VARYING ix FROM 1 BY 1 - UNTIL ix > 10 - MOVE ix TO file3-key1 - READ file3 KEY file3-key1 - IF (file3-data <> ix) - DISPLAY "FAILED 3-1" - END-IF - END-PERFORM. - CLOSE file3. - * - * Insert rec via file with only 1 index declared - OPEN I-O file3. - MOVE 20 TO ix. - MOVE ix TO file3-key1 file3-data - ADD 100 TO ix GIVING file3-key2 - ADD 200 TO ix GIVING file3-key3 - WRITE file3-rec - CLOSE file3 - * - * Check new rec is visible in other files - OPEN INPUT file1. - MOVE 10 TO file1-key1. - READ file1 KEY file1-key1. - IF (file1-data <> 10) - DISPLAY "FAILED 1-4". - MOVE SPACES TO file1-rec. - MOVE 110 TO file1-key2. - READ file1 KEY file1-key2. - IF (file1-data <> 10) - DISPLAY "FAILED 1-5". - MOVE SPACES TO file1-rec. - MOVE 210 TO file1-key3. - READ file1 KEY file1-key3. - IF (file1-data <> 10) - DISPLAY "FAILED 1-6". - CLOSE file1. - * - OPEN INPUT file2. - MOVE 10 TO file2-key1. - READ file2 KEY file2-key1. - IF (file2-data <> 10) - DISPLAY "FAILED 2-3". - MOVE SPACES TO file2-rec. - MOVE 110 TO file2-key2. - READ file2 KEY file2-key2. - IF (file2-data <> 10) - DISPLAY "FAILED 2-4". - CLOSE file2. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_file.at:7359: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_file.at:7359" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_file.at:7359" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_file.at:7360: export IX_OPTIONS='keycheck=off' -\$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_notrace 'an embedded newline' "run_file.at:7360" -( $at_check_trace; export IX_OPTIONS='keycheck=off' -$COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_file.at:7360" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_770 -#AT_START_771 -at_fn_group_banner 771 'run_file.at:7366' \ - "READ INPUT pipe & WRITE OUTPUT pipe" " " 4 -at_xfail=no -( - $as_echo "771. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >test-data-in <<'_ATEOF' -NAME -STREET -TOWN -COUNTRY -_ATEOF - - -cat >provider <<'_ATEOF' - -cat $1 -_ATEOF - - -cat >consumer <<'_ATEOF' - -cat -_ATEOF - - -cat >prog.cob <<'_ATEOF' - - identification division. - program-id. prog. - environment division. - configuration section. - input-output section. - file-control. - select pipe-in - organization line sequential - access sequential - assign to w-command - status is f-status. - select pipe-out - organization line sequential - access sequential - assign to w-command - status is f-status. - data division. - file section. - fd pipe-in. - 1 pipe-msg-in pic x(132). - fd pipe-out. - 1 pipe-msg-out pic x(132). - working-storage section. - 77 f-status pic xx. - 88 f-status-ok value "00". - 77 w-command pic x(100). - procedure division. - move "< sh ./provider ./test-data-in" - to w-command. - open input pipe-in. - if not f-status-ok - display "FAILED: OPEN INPUT" - stop run - end-if. - move "> sh ./consumer > ./test-data-out" - to w-command. - open output pipe-out. - if not f-status-ok - display "FAILED: OPEN OUTPUT" - stop run - end-if. - perform until not f-status-ok - read pipe-in - if f-status-ok - perform x01-100-map - write pipe-msg-out - end-if - end-perform. - close pipe-in. - close pipe-out. - stop run. - * - x01-100-map. - move "*** Jacques Tati ***" to pipe-msg-out. - if (pipe-msg-in = "COUNTRY") - move "Country: FRANCE" to pipe-msg-out. - if (pipe-msg-in = "TOWN") - move "Town: DEAUVILLE" to pipe-msg-out. - if (pipe-msg-in = "NAME") - move "Name: M. Hulot" to pipe-msg-out. - if (pipe-msg-in = "STREET") - move "Street: Rue des Anglais" to pipe-msg-out. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_file.at:7449: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_file.at:7449" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_file.at:7449" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_file.at:7450: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_file.at:7450" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_file.at:7450" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_file.at:7451: cat test-data-out" -at_fn_check_prepare_trace "run_file.at:7451" -( $at_check_trace; cat test-data-out -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo "Name: M. Hulot -Street: Rue des Anglais -Town: DEAUVILLE -Country: FRANCE -" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_file.at:7451" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_771 -#AT_START_772 -at_fn_group_banner 772 'run_file.at:7461' \ - "EXTFH: using ISAM callback" " " 4 -at_xfail=no -( - $as_echo "772. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -$as_echo "run_file.at:7464" >"$at_check_line_file" -(test "$COB_HAS_ISAM" = "no") \ - && at_fn_check_skip 77 "$at_srcdir/run_file.at:7464" - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - - ENVIRONMENT DIVISION. - CONFIGURATION SECTION. - - INPUT-OUTPUT SECTION. - FILE-CONTROL. - SELECT OPTIONAL TSPFILE - ASSIGN TO "testisam" - ORGANIZATION INDEXED ACCESS DYNAMIC - RECORD KEY IS CM-CUST-NUM - ALTERNATE RECORD KEY IS CM-TELEPHONE WITH DUPLICATES - ALTERNATE RECORD KEY IS CM-DISK WITH DUPLICATES - FILE STATUS IS CUST-STAT . - - SELECT TSTFILE - ASSIGN TO "testisam" - ORGANIZATION INDEXED ACCESS DYNAMIC - RECORD KEY IS TS-CUST-NUM - ALTERNATE RECORD KEY IS TS-TELEPHONE WITH DUPLICATES - ALTERNATE RECORD KEY IS TS-DISK WITH DUPLICATES - FILE STATUS IS CUST-STAT . - - SELECT FLATFILE ASSIGN EXTERNAL RELFIX - ORGANIZATION RELATIVE - ACCESS IS RANDOM RELATIVE KEY IS REC-NUM - FILE STATUS IS CUST-STAT. - - DATA DIVISION. - FILE SECTION. - FD TSPFILE - BLOCK CONTAINS 5 RECORDS. - - 01 TSPFL-RECORD. - 05 TSPFL-REC. - 10 CM-CUST-NUM. - 15 CM-CUST-PRE PICTURE X(3). - 15 CM-CUST-NNN PICTURE X(5). - 10 CM-STATUS PICTURE X. - 10 CM-COMPANY PICTURE X(25). - 10 CM-ADDRESS-1 PICTURE X(25). - 10 CM-ADDRESS-2 PICTURE X(25). - 10 CM-ADDRESS-3 PICTURE X(25). - 10 CM-TELEPHONE PICTURE 9(10). - 10 CM-DP-MGR PICTURE X(25). - 10 CM-MACHINE PICTURE X(8). - 10 CM-MEMORY PICTURE X(4). - 10 CM-DISK PICTURE X(8). - 10 CM-TAPE PICTURE X(8). - 10 CM-NO-TERMINALS PICTURE 9(5). - - FD TSTFILE - BLOCK CONTAINS 5 RECORDS. - - 01 TSTFL-RECORD. - 05 TSTFL-REC. - 10 TS-CUST-NUM PICTURE X(8). - 10 TS-STATUS PICTURE X. - 10 TS-COMPANY PICTURE X(25). - 10 TS-ADDRESS-1 PICTURE X(25). - 10 TS-ADDRESS-2 PICTURE X(25). - 10 TS-ADDRESS-3 PICTURE X(25). - 10 TS-TELEPHONE PICTURE 9(10). - 10 TS-DP-MGR PICTURE X(25). - 10 TS-MACHINE PICTURE X(8). - 10 TS-MEMORY PICTURE X(4). - 10 TS-DISK PICTURE X(8). - 10 TS-TAPE PICTURE X(8). - - FD FLATFILE - BLOCK CONTAINS 5 RECORDS. - - 01 TSP2-RECORD. - 10 C2-CUST-NUM PICTURE X(8). - 10 C2-COMPANY PICTURE X(25). - 10 C2-DISK PICTURE X(8). - 10 C2-NO-TERMINALS PICTURE 9(4) COMP-4. - 10 C2-PK-DATE PICTURE S9(14) COMP-3. - - WORKING-STORAGE SECTION. - - 01 CUST-STAT. - 05 FILLER PICTURE XX. - 77 MAX-SUB VALUE 16 PICTURE 9(5) COMP SYNC. - - 01 TEST-DATA. - - 02 DATA-CUST-NUM-TBL. - - 05 FILLER PIC X(8) VALUE "ALP00000". - 05 FILLER PIC X(8) VALUE "BET00000". - 05 FILLER PIC X(8) VALUE "GAM00000". - 05 FILLER PIC X(8) VALUE "DEL00000". - 05 FILLER PIC X(8) VALUE "EPS00000". - 05 FILLER PIC X(8) VALUE "FOR00000". - 05 FILLER PIC X(8) VALUE "GIB00000". - 05 FILLER PIC X(8) VALUE "H&J00000". - 05 FILLER PIC X(8) VALUE "INC00000". - 05 FILLER PIC X(8) VALUE "JOH00000". - 05 FILLER PIC X(8) VALUE "KON00000". - 05 FILLER PIC X(8) VALUE "LEW00000". - 05 FILLER PIC X(8) VALUE "MOR00000". - 05 FILLER PIC X(8) VALUE "NEW00000". - 05 FILLER PIC X(8) VALUE "OLD00000". - 05 FILLER PIC X(8) VALUE "PRE00000". - - 02 DATA-CUST-NUM REDEFINES DATA-CUST-NUM-TBL - PIC X(8) OCCURS 16. - 02 DATA-COMPANY-TBL. - - 05 FILLER PIC X(25) VALUE "ALPHA ELECTRICAL CO. LTD.". - 05 FILLER PIC X(25) VALUE "BETA SHOE MFG. INC. ". - 05 FILLER PIC X(25) VALUE "GAMMA X-RAY TECHNOLOGY ". - 05 FILLER PIC X(25) VALUE "DELTA LUGGAGE REPAIRS ". - 05 FILLER PIC X(25) VALUE "EPSILON EQUIPMENT SUPPLY ". - 05 FILLER PIC X(25) VALUE "FORTUNE COOKIE COMPANY ". - 05 FILLER PIC X(25) VALUE "GIBRALTER LIFE INSURANCE ". - 05 FILLER PIC X(25) VALUE "H & J PLUMBING SUPPLIES ". - 05 FILLER PIC X(25) VALUE "INCREMENTAL BACKUP CORP. ". - 05 FILLER PIC X(25) VALUE "JOHNSON BOATING SUPPLIES ". - 05 FILLER PIC X(25) VALUE "KONFLAB PLASTIC PRODUCTS.". - 05 FILLER PIC X(25) VALUE "LEWISTON GRAPHICS LTD. ". - 05 FILLER PIC X(25) VALUE "MORNINGSIDE CARPENTRY. ". - 05 FILLER PIC X(25) VALUE "NEW WAVE SURF SHOPS INC. ". - 05 FILLER PIC X(25) VALUE "OLD TYME PIZZA MFG. CO. ". - 05 FILLER PIC X(25) VALUE "PRESTIGE OFFICE FURNITURE". - - 02 DATA-COMPANY REDEFINES DATA-COMPANY-TBL - PIC X(25) OCCURS 16. - 02 DATA-ADDRESS-1-TBL. - - 05 FILLER PIC X(25) VALUE "123 MAIN STREET ". - 05 FILLER PIC X(25) VALUE "1090 2ND AVE. WEST ". - 05 FILLER PIC X(25) VALUE "1401 JEFFERSON BLVD. ". - 05 FILLER PIC X(25) VALUE "1620 ARIZONA WAY ". - 05 FILLER PIC X(25) VALUE "1184 EAST FIRST STREET ". - 05 FILLER PIC X(25) VALUE "114 JOHN F. KENNEDY AVE. ". - 05 FILLER PIC X(25) VALUE "650 LIBERTY CRESCENT ". - 05 FILLER PIC X(25) VALUE "77 SUNSET BLVD. ". - 05 FILLER PIC X(25) VALUE "10908 SANTA MONICA BLVD. ". - 05 FILLER PIC X(25) VALUE "1134 PARIS ROAD ". - 05 FILLER PIC X(25) VALUE "808 NORTHWEST MAIN ST. ". - 05 FILLER PIC X(25) VALUE "9904 QUEEN STREET ". - 05 FILLER PIC X(25) VALUE "1709 DUNDAS CRESCENT W. ". - 05 FILLER PIC X(25) VALUE "3240 MARIS AVENUE ". - 05 FILLER PIC X(25) VALUE "1705 WISCONSIN ROAD ". - 05 FILLER PIC X(25) VALUE "114A MAPLE GROVE ". - - 02 DATA-ADDRESS-1 REDEFINES DATA-ADDRESS-1-TBL - PIC X(25) OCCURS 16. - 02 DATA-ADDRESS-2-TBL. - - 05 FILLER PIC X(10) VALUE "NEW YORK ". - 05 FILLER PIC X(10) VALUE "ATLANTA ". - 05 FILLER PIC X(10) VALUE "WASHINGTON". - 05 FILLER PIC X(10) VALUE "TORONTO ". - 05 FILLER PIC X(10) VALUE "CALGARY ". - 05 FILLER PIC X(10) VALUE "SAN DIEGO ". - 05 FILLER PIC X(10) VALUE "LOS RIOS ". - 05 FILLER PIC X(10) VALUE "MADISON ". - 05 FILLER PIC X(10) VALUE "WILBUR ". - 05 FILLER PIC X(10) VALUE "TOPEKA ". - 05 FILLER PIC X(10) VALUE "SEATTLE ". - 05 FILLER PIC X(10) VALUE "NEW JERSEY". - 05 FILLER PIC X(10) VALUE "FORT WAYNE". - 05 FILLER PIC X(10) VALUE "COLUMBUS ". - 05 FILLER PIC X(10) VALUE "RICHMOND ". - 05 FILLER PIC X(10) VALUE "WHITEPLAIN". - - 02 DATA-ADDRESS-2 REDEFINES DATA-ADDRESS-2-TBL - PIC X(10) OCCURS 16. - 02 DATA-ADDRESS-3-TBL. - - 05 FILLER PIC X(10) VALUE "N.Y. ". - 05 FILLER PIC X(10) VALUE "GEORGIA ". - 05 FILLER PIC X(10) VALUE "D.C. ". - 05 FILLER PIC X(10) VALUE "CANADA ". - 05 FILLER PIC X(10) VALUE "CANADA ". - 05 FILLER PIC X(10) VALUE "CALIFORNIA". - 05 FILLER PIC X(10) VALUE "NEW MEXICO". - 05 FILLER PIC X(10) VALUE "WISCONSIN ". - 05 FILLER PIC X(10) VALUE "DELAWARE ". - 05 FILLER PIC X(10) VALUE "KANSAS ". - 05 FILLER PIC X(10) VALUE "WASHINGTON". - 05 FILLER PIC X(10) VALUE "N.J. ". - 05 FILLER PIC X(10) VALUE "COLORADO ". - 05 FILLER PIC X(10) VALUE "OHIO ". - 05 FILLER PIC X(10) VALUE "VIRGINIA ". - 05 FILLER PIC X(10) VALUE "N.Y. ". - - 02 DATA-ADDRESS-3 REDEFINES DATA-ADDRESS-3-TBL - PIC X(10) OCCURS 16. - 02 DATA-TELEPHONE-TBL. - - 05 FILLER PIC 9(10) VALUE 3131234432. - 05 FILLER PIC 9(10) VALUE 4082938498. - 05 FILLER PIC 9(10) VALUE 8372487274. - 05 FILLER PIC 9(10) VALUE 4169898509. - 05 FILLER PIC 9(10) VALUE 5292398745. - 05 FILLER PIC 9(10) VALUE 8009329492. - 05 FILLER PIC 9(10) VALUE 6456445643. - 05 FILLER PIC 9(10) VALUE 6546456333. - 05 FILLER PIC 9(10) VALUE 3455445444. - 05 FILLER PIC 9(10) VALUE 6456445643. - 05 FILLER PIC 9(10) VALUE 7456434355. - 05 FILLER PIC 9(10) VALUE 6554456433. - 05 FILLER PIC 9(10) VALUE 4169898509. - 05 FILLER PIC 9(10) VALUE 7534587453. - 05 FILLER PIC 9(10) VALUE 8787458374. - 05 FILLER PIC 9(10) VALUE 4169898509. - - 02 DATA-TELEPHONE REDEFINES DATA-TELEPHONE-TBL - PIC 9(10) OCCURS 16. - 02 DATA-DP-MGR-TBL. - - 05 FILLER PIC X(20) VALUE "MR. DAVE HARRIS ". - 05 FILLER PIC X(20) VALUE "MS. JANICE SILCOX ". - 05 FILLER PIC X(20) VALUE "MR. ALLAN JONES ". - 05 FILLER PIC X(20) VALUE "MR. PETER MACKAY ". - 05 FILLER PIC X(20) VALUE "MRS. DONNA BREWER ". - 05 FILLER PIC X(20) VALUE "MR. MICHAEL SMYTHE ". - 05 FILLER PIC X(20) VALUE "MR. D.A. MORRISON ". - 05 FILLER PIC X(20) VALUE "MR. BRIAN PATTERSON ". - 05 FILLER PIC X(20) VALUE "MR. DARRYL TOWNSEND ". - 05 FILLER PIC X(20) VALUE "MS. VALERIE HARPER ". - 05 FILLER PIC X(20) VALUE "MR. FRED MILLER ". - 05 FILLER PIC X(20) VALUE "MR. DONALD FISCHER ". - 05 FILLER PIC X(20) VALUE "MR. STEVEN YOURDIN ". - 05 FILLER PIC X(20) VALUE "MS. Goldie Hawn ". - 05 FILLER PIC X(20) VALUE "MS. ALICE WINSTON ". - 05 FILLER PIC X(20) VALUE "MR. THOMAS JEFFERSON". - - 02 DATA-DP-MGR REDEFINES DATA-DP-MGR-TBL - PIC X(20) OCCURS 16. - 02 DATA-MACHINE-TBL. - - 05 FILLER PIC X(8) VALUE "UNI-9030". - 05 FILLER PIC X(8) VALUE "UNI-9040". - 05 FILLER PIC X(8) VALUE "UNI-80/3". - 05 FILLER PIC X(8) VALUE "UNI-80/5". - 05 FILLER PIC X(8) VALUE "UNI-80/6". - 05 FILLER PIC X(8) VALUE "UNI-80/6". - 05 FILLER PIC X(8) VALUE "UNI-80/6". - 05 FILLER PIC X(8) VALUE "UNI-80/8". - 05 FILLER PIC X(8) VALUE "UNI-80/8". - 05 FILLER PIC X(8) VALUE "UNI-80/8". - 05 FILLER PIC X(8) VALUE "UNI-80/8". - 05 FILLER PIC X(8) VALUE "UNI-80/8". - 05 FILLER PIC X(8) VALUE "UNI-80/8". - 05 FILLER PIC X(8) VALUE "UNI-80/8". - 05 FILLER PIC X(8) VALUE "UNI-9040". - 05 FILLER PIC X(8) VALUE "UNI-9040". - - 02 DATA-MACHINE REDEFINES DATA-MACHINE-TBL - PIC X(8) OCCURS 16. - 02 DATA-NO-TERMINALS-TBL. - - 05 FILLER PIC 9(3) COMP-3 VALUE 85. - 05 FILLER PIC 9(3) COMP-3 VALUE 34. - 05 FILLER PIC 9(3) COMP-3 VALUE 75. - 05 FILLER PIC 9(3) COMP-3 VALUE 45. - 05 FILLER PIC 9(3) COMP-3 VALUE 90. - 05 FILLER PIC 9(3) COMP-3 VALUE 107. - 05 FILLER PIC 9(3) COMP-3 VALUE 67. - 05 FILLER PIC 9(3) COMP-3 VALUE 32. - 05 FILLER PIC 9(3) COMP-3 VALUE 16. - 05 FILLER PIC 9(3) COMP-3 VALUE 34. - 05 FILLER PIC 9(3) COMP-3 VALUE 128. - 05 FILLER PIC 9(3) COMP-3 VALUE 64. - 05 FILLER PIC 9(3) COMP-3 VALUE 110. - 05 FILLER PIC 9(3) COMP-3 VALUE 324. - 05 FILLER PIC 9(3) COMP-3 VALUE 124. - 05 FILLER PIC 9(3) COMP-3 VALUE 86. - - 02 DATA-NO-TERMINALS REDEFINES DATA-NO-TERMINALS-TBL - PIC 9(3) COMP-3 OCCURS 16. - - 01 WORK-AREA. - 05 REC-NUM PICTURE 9(6) VALUE 0. - 05 REC-MAX PICTURE 9(6) VALUE 10. - 05 SUB PICTURE 9(4) COMP SYNC. - 88 ODD-RECORD VALUE 1 3 5 7 9 10 11. - - 05 TSPFL-KEY PICTURE X(8). - - PROCEDURE DIVISION. - - MAINFILE. - OPEN OUTPUT TSPFILE - CLOSE TSPFILE. - - OPEN I-O TSPFILE - MOVE '99' TO CUST-STAT - READ TSPFILE NEXT RECORD WITH NO LOCK - IF CUST-STAT NOT = "10" - DISPLAY "Error " CUST-STAT " on read of empty file" - UPON CONSOLE - STOP RUN - END-IF. - MOVE LOW-VALUES TO TSPFL-RECORD. - START TSPFILE KEY GREATER THAN CM-CUST-NUM - IF CUST-STAT NOT = "23" - DISPLAY "Error " CUST-STAT " starting empty file" - UPON CONSOLE - STOP RUN - END-IF. - READ TSPFILE NEXT RECORD WITH NO LOCK - IF CUST-STAT NOT = "46" - DISPLAY "Error " CUST-STAT " start/read of empty file" - UPON CONSOLE - STOP RUN - END-IF. - DISPLAY "OK: Operations on empty file" - CLOSE TSPFILE. - - PERFORM LOADFILE. - PERFORM LISTFILE. - OPEN INPUT TSTFILE - IF CUST-STAT NOT = "00" - DISPLAY "Expected ERROR " CUST-STAT - " opening TSTFILE, Record size different" - UPON CONSOLE - ELSE - DISPLAY "Un-Expected open TSTFILE, Record size different" - UPON CONSOLE - CLOSE TSTFILE - END-IF. - PERFORM LOADFLAT. - STOP RUN. - - LOADFILE. - DISPLAY "Loading sample data file." - UPON CONSOLE. - - OPEN OUTPUT TSPFILE - IF CUST-STAT NOT = "00" - DISPLAY "Error " CUST-STAT - " opening 'testisam' file" UPON CONSOLE - STOP RUN - END-IF. - - PERFORM 1000-LOAD-RECORD - VARYING SUB FROM 1 BY 1 - UNTIL SUB > MAX-SUB. - - DISPLAY "Sample data file load complete." - UPON CONSOLE. - CLOSE TSPFILE. - - *---------------------------------------------------------------* - * LOAD A RECORD FROM DATA TABLES * - *---------------------------------------------------------------* - - 1000-LOAD-RECORD. - - MOVE SPACES TO TSPFL-RECORD. - MOVE DATA-CUST-NUM (SUB) TO CM-CUST-NUM. - MOVE CM-CUST-NUM TO TSPFL-KEY. - MOVE DATA-COMPANY (SUB) TO CM-COMPANY. - MOVE DATA-ADDRESS-1 (SUB) TO CM-ADDRESS-1. - MOVE DATA-ADDRESS-2 (SUB) TO CM-ADDRESS-2. - MOVE DATA-ADDRESS-3 (SUB) TO CM-ADDRESS-3. - MOVE DATA-TELEPHONE (SUB) TO CM-TELEPHONE. - MOVE DATA-DP-MGR (SUB) TO CM-DP-MGR. - MOVE DATA-MACHINE (SUB) TO CM-MACHINE. - MOVE DATA-NO-TERMINALS (SUB) TO CM-NO-TERMINALS. - - IF ODD-RECORD - MOVE "8417" TO CM-DISK - MOVE "1600 BPI" TO CM-TAPE - MOVE "1MEG" TO CM-MEMORY - ELSE - MOVE "8470" TO CM-DISK - MOVE "6250 BPI" TO CM-TAPE - MOVE "3MEG" TO CM-MEMORY. - - WRITE TSPFL-RECORD. - IF CUST-STAT NOT = "00" - AND CUST-STAT NOT = "02" - DISPLAY "Load - Key: " TSPFL-KEY ", Status: " CUST-STAT - UPON CONSOLE. - - LISTFILE. - DISPLAY "LIST SAMPLE FILE" UPON CONSOLE. - OPEN INPUT TSTFILE - MOVE SPACES TO TSTFL-RECORD. - MOVE "PRE00000" TO CM-CUST-NUM. - START TSTFILE KEY GREATER THAN OR EQUAL TO TS-CUST-NUM - READ TSTFILE NEXT RECORD - READ TSTFILE NEXT RECORD - CLOSE TSTFILE. - - MOVE ZERO TO REC-NUM - OPEN INPUT TSPFILE - IF CUST-STAT NOT = "00" - DISPLAY "ERROR " CUST-STAT " OPENING INPUT FILE" - UPON CONSOLE - STOP RUN - END-IF. - MOVE SPACES TO TSPFL-RECORD. - MOVE "PRE00000" TO CM-CUST-NUM. - START TSPFILE KEY GREATER THAN OR EQUAL TO CM-CUST-NUM - READ TSPFILE NEXT RECORD - READ TSPFILE NEXT RECORD - - MOVE SPACES TO TSPFL-RECORD. - MOVE "DEL00000" TO CM-CUST-NUM. - START TSPFILE KEY GREATER THAN CM-CUST-NUM - IF CUST-STAT NOT = "00" - DISPLAY "Error " CUST-STAT " starting file" - UPON CONSOLE - STOP RUN - END-IF. - READ TSPFILE NEXT RECORD WITH NO LOCK - IF CUST-STAT NOT = "00" - DISPLAY "Error " CUST-STAT " on 1st read of file" - UPON CONSOLE - STOP RUN - END-IF. - PERFORM UNTIL CUST-STAT NOT = "00" - OR REC-NUM > REC-MAX - DISPLAY "Key: " CM-CUST-NUM " is " CM-COMPANY - " Disk=" CM-DISK "." - UPON CONSOLE - READ TSPFILE NEXT RECORD - AT END - MOVE "99" TO CUST-STAT - END-READ - ADD 1 TO REC-NUM - END-PERFORM - IF CUST-STAT = "99" - DISPLAY "Hit End of File" UPON CONSOLE - END-IF. - - DISPLAY "LIST SAMPLE FILE DESCENDING" UPON CONSOLE. - MOVE ZERO TO REC-NUM - START TSPFILE KEY LESS THAN CM-CUST-NUM - IF CUST-STAT NOT = "00" - DISPLAY "Error " CUST-STAT " starting file" - UPON CONSOLE - STOP RUN - END-IF. - READ TSPFILE PREVIOUS RECORD WITH NO LOCK - IF CUST-STAT NOT = "00" - DISPLAY "Error " CUST-STAT " on 1st read of file" - UPON CONSOLE - STOP RUN - END-IF. - PERFORM UNTIL CUST-STAT NOT = "00" - OR REC-NUM > REC-MAX - DISPLAY "Key: " CM-CUST-NUM " is " CM-COMPANY - " Disk=" CM-DISK "." - UPON CONSOLE - READ TSPFILE PREVIOUS RECORD - AT END - MOVE "99" TO CUST-STAT - END-READ - ADD 1 TO REC-NUM - END-PERFORM. - - CLOSE TSPFILE. - - OPEN I-O TSPFILE. - MOVE SPACES TO TSPFL-RECORD. - MOVE DATA-CUST-NUM (2) TO CM-CUST-NUM. - MOVE 'X' TO CM-CUST-NUM (5:1). - READ TSPFILE KEY IS CM-CUST-NUM - IF CUST-STAT NOT = "23" - DISPLAY "Error " CUST-STAT " instead of 23." - UPON CONSOLE - END-IF. - MOVE DATA-CUST-NUM (2) TO CM-CUST-NUM. - MOVE DATA-COMPANY (2) TO CM-COMPANY. - READ TSPFILE KEY IS CM-CUST-NUM - IF CUST-STAT NOT = "00" - DISPLAY "Error " CUST-STAT " on primary read ." - UPON CONSOLE - ELSE - DISPLAY "Got: " CM-CUST-NUM " is " CM-COMPANY - " Disk=" CM-DISK "." - UPON CONSOLE - END-IF. - READ TSPFILE NEXT RECORD - IF CUST-STAT NOT = "00" - DISPLAY "Error " CUST-STAT " on next read" - UPON CONSOLE - ELSE - DISPLAY "Nxt: " CM-CUST-NUM " is " CM-COMPANY - " Disk=" CM-DISK "." - UPON CONSOLE - END-IF. - MOVE DATA-TELEPHONE (7) TO CM-TELEPHONE. - MOVE DATA-MACHINE (7) TO CM-MACHINE. - READ TSPFILE KEY IS CM-TELEPHONE - IF CUST-STAT NOT = "00" - DISPLAY "Error " CUST-STAT " instead of 23" - UPON CONSOLE - ELSE - DISPLAY "Ky2: " CM-CUST-NUM " is " CM-COMPANY - " Mach=" CM-MACHINE "." - UPON CONSOLE - END-IF. - WRITE TSPFL-RECORD - IF CUST-STAT NOT = "22" - DISPLAY "Error " CUST-STAT " instead of 22" - UPON CONSOLE - ELSE - DISPLAY " Write: " CM-CUST-NUM " got 22 as expected" - UPON CONSOLE - END-IF. - MOVE DATA-CUST-NUM (3) TO CM-CUST-NUM. - MOVE DATA-COMPANY (3) TO CM-COMPANY. - READ TSPFILE KEY IS CM-CUST-NUM - DISPLAY " Read: " CM-CUST-NUM " got " - CUST-STAT " as expected " - CM-NO-TERMINALS " terminals" - UPON CONSOLE. - ADD 5 TO CM-NO-TERMINALS - REWRITE TSPFL-RECORD - IF CUST-STAT NOT = "02" - AND CUST-STAT NOT = "00" - DISPLAY "Error " CUST-STAT " instead of 02" - UPON CONSOLE - ELSE - DISPLAY "ReWrite: " CM-CUST-NUM " got " - "00/02 as expected " - CM-NO-TERMINALS " terminals" - UPON CONSOLE - END-IF. - MOVE DATA-CUST-NUM (2) TO CM-CUST-NUM. - MOVE DATA-COMPANY (2) TO CM-COMPANY. - READ TSPFILE KEY IS CM-CUST-NUM - DISPLAY " Read: " CM-CUST-NUM " got " - CUST-STAT " as expected " - CM-NO-TERMINALS " terminals" - UPON CONSOLE. - MOVE DATA-CUST-NUM (3) TO CM-CUST-NUM. - MOVE DATA-COMPANY (3) TO CM-COMPANY. - REWRITE TSPFL-RECORD - IF CUST-STAT NOT = "02" - AND CUST-STAT NOT = "00" - DISPLAY "Error " CUST-STAT " instead of 02" - UPON CONSOLE - ELSE - DISPLAY "ReWrite: " CM-CUST-NUM " got " - "00/02 as expected" - UPON CONSOLE - END-IF. - MOVE DATA-CUST-NUM (6) TO CM-CUST-NUM. - MOVE DATA-COMPANY (6) TO CM-COMPANY. - READ TSPFILE KEY IS CM-CUST-NUM - MOVE DATA-TELEPHONE (7) TO CM-TELEPHONE. - MOVE DATA-MACHINE (7) TO CM-MACHINE. - REWRITE TSPFL-RECORD - IF CUST-STAT NOT = "02" - AND CUST-STAT NOT = "00" - DISPLAY "Error " CUST-STAT " instead of 02" - UPON CONSOLE - ELSE - DISPLAY "ReWrite: " CM-CUST-NUM " got " - "00/02 as expected" - UPON CONSOLE - END-IF. - DELETE TSPFILE. - CLOSE TSPFILE. - - LOADFLAT. - OPEN OUTPUT FLATFILE. - PERFORM FLAT-RECORD - VARYING SUB FROM 1 BY 1 - UNTIL SUB > MAX-SUB - OR SUB > 5. - CLOSE FLATFILE. - OPEN INPUT FLATFILE. - MOVE 3 TO REC-NUM - READ FLATFILE - MOVE 999 TO REC-NUM - READ FLATFILE - CLOSE FLATFILE. - - FLAT-RECORD. - - MOVE SPACES TO TSP2-RECORD. - MOVE SUB TO REC-NUM. - MOVE DATA-CUST-NUM (SUB) TO C2-CUST-NUM. - MOVE DATA-COMPANY (SUB) TO C2-COMPANY. - MOVE DATA-NO-TERMINALS (SUB) TO C2-NO-TERMINALS. - MOVE 20070319 TO C2-PK-DATE. - IF ODD-RECORD - MOVE "8417" TO C2-DISK - ELSE - MOVE "8470" TO C2-DISK. - WRITE TSP2-RECORD. -_ATEOF - - -cat >cmod.c <<'_ATEOF' - -#include -#include - -/********************************************************* - * TSTFH - External File Handler entry point. -*********************************************************/ - -COB_EXT_EXPORT int -TSTFH (unsigned char *opCodep, FCD3 *fcd) -{ - unsigned int opCode; - - if (*opCodep == 0xfa) - opCode = 0xfa00 + opCodep[1]; - else - opCode = opCodep[1]; - - if (fcd->fileOrg == ORG_LINE_SEQ - || fcd->fileOrg == ORG_SEQ - || fcd->fileOrg == ORG_INDEXED - || fcd->fileOrg == ORG_RELATIVE) { - switch (opCode) { - case OP_OPEN_OUTPUT: - case OP_OPEN_IO: - case OP_OPEN_EXTEND: - case OP_OPEN_OUTPUT_NOREWIND: - return EXTFH(opCodep, fcd); - break; - - case OP_OPEN_INPUT: - case OP_OPEN_INPUT_NOREWIND: - case OP_OPEN_INPUT_REVERSED: - return EXTFH(opCodep, fcd); - break; - - default: - break; - } - - } - - if (opCode == OP_CLOSE - && (fcd->openMode & OPEN_NOT_OPEN) ) { - return 0; - } - - return EXTFH(opCodep, fcd); -} -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_file.at:8114: \$COMPILE -fcallfh=TSTFH prog.cob cmod.c" -at_fn_check_prepare_dynamic "$COMPILE -fcallfh=TSTFH prog.cob cmod.c" "run_file.at:8114" -( $at_check_trace; $COMPILE -fcallfh=TSTFH prog.cob cmod.c -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_file.at:8114" -$at_failed && at_fn_log_failure -$at_traceon; } - - -{ set +x -$as_echo "$at_srcdir/run_file.at:8116: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_file.at:8116" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo "OK: Operations on empty file -Loading sample data file. -Sample data file load complete. -LIST SAMPLE FILE -Key: EPS00000 is EPSILON EQUIPMENT SUPPLY Disk=8417 . -Key: FOR00000 is FORTUNE COOKIE COMPANY Disk=8470 . -Key: GAM00000 is GAMMA X-RAY TECHNOLOGY Disk=8417 . -Key: GIB00000 is GIBRALTER LIFE INSURANCE Disk=8417 . -Key: H&J00000 is H & J PLUMBING SUPPLIES Disk=8470 . -Key: INC00000 is INCREMENTAL BACKUP CORP. Disk=8417 . -Key: JOH00000 is JOHNSON BOATING SUPPLIES Disk=8417 . -Key: KON00000 is KONFLAB PLASTIC PRODUCTS. Disk=8417 . -Key: LEW00000 is LEWISTON GRAPHICS LTD. Disk=8470 . -Key: MOR00000 is MORNINGSIDE CARPENTRY. Disk=8470 . -Key: NEW00000 is NEW WAVE SURF SHOPS INC. Disk=8470 . -LIST SAMPLE FILE DESCENDING -Key: NEW00000 is NEW WAVE SURF SHOPS INC. Disk=8470 . -Key: MOR00000 is MORNINGSIDE CARPENTRY. Disk=8470 . -Key: LEW00000 is LEWISTON GRAPHICS LTD. Disk=8470 . -Key: KON00000 is KONFLAB PLASTIC PRODUCTS. Disk=8417 . -Key: JOH00000 is JOHNSON BOATING SUPPLIES Disk=8417 . -Key: INC00000 is INCREMENTAL BACKUP CORP. Disk=8417 . -Key: H&J00000 is H & J PLUMBING SUPPLIES Disk=8470 . -Key: GIB00000 is GIBRALTER LIFE INSURANCE Disk=8417 . -Key: GAM00000 is GAMMA X-RAY TECHNOLOGY Disk=8417 . -Key: FOR00000 is FORTUNE COOKIE COMPANY Disk=8470 . -Key: EPS00000 is EPSILON EQUIPMENT SUPPLY Disk=8417 . -Got: BET00000 is BETA SHOE MFG. INC. Disk=8470 . -Nxt: DEL00000 is DELTA LUGGAGE REPAIRS Disk=8470 . -Ky2: GIB00000 is GIBRALTER LIFE INSURANCE Mach=UNI-80/6. - Write: GIB00000 got 22 as expected - Read: GAM00000 got 00 as expected 00075 terminals -ReWrite: GAM00000 got 00/02 as expected 00080 terminals - Read: BET00000 got 00 as expected 00034 terminals -ReWrite: GAM00000 got 00/02 as expected -ReWrite: FOR00000 got 00/02 as expected -Expected ERROR 39 opening TSTFILE, Record size different -" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_file.at:8116" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_772 -#AT_START_773 -at_fn_group_banner 773 'run_file.at:8159' \ - "EXTFH: SEQUENTIAL files" " " 4 -at_xfail=no -( - $as_echo "773. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - - ENVIRONMENT DIVISION. - CONFIGURATION SECTION. - - INPUT-OUTPUT SECTION. - FILE-CONTROL. - SELECT FLATFILE ASSIGN EXTERNAL SEQFIX - ORGANIZATION SEQUENTIAL - FILE STATUS IS CUST-STAT . - - DATA DIVISION. - FILE SECTION. - FD FLATFILE - BLOCK CONTAINS 5 RECORDS. - - 01 TSPFL-RECORD. - 10 CM-CUST-NUM PICTURE X(8). - 10 CM-COMPANY PICTURE X(25). - 10 CM-DISK PICTURE X(8). - 10 CM-NO-TERMINALS PICTURE 9(4) COMP-4. - 10 CM-PK-DATE PICTURE S9(14) COMP-3. - 10 CM-TRAILER PICTURE X(8). - - WORKING-STORAGE SECTION. - - 77 MAX-SUB VALUE 6 PICTURE 9(4) COMP SYNC. - 77 CUST-STAT PICTURE X(2). - - 01 TEST-DATA. - - 02 DATA-CUST-NUM-TBL. - - 05 FILLER PIC X(8) VALUE "ALP00000". - 05 FILLER PIC X(8) VALUE "BET00000". - 05 FILLER PIC X(8) VALUE "GAM00000". - 05 FILLER PIC X(8) VALUE "DEL00000". - 05 FILLER PIC X(8) VALUE "EPS00000". - 05 FILLER PIC X(8) VALUE "FOR00000". - - 02 DATA-CUST-NUM REDEFINES DATA-CUST-NUM-TBL - PIC X(8) OCCURS 6. - 02 DATA-COMPANY-TBL. - - 05 FILLER PIC X(25) VALUE "ALPHA ELECTRICAL CO. LTD.". - 05 FILLER PIC X(25) VALUE "BETA SHOE MFG. INC. ". - 05 FILLER PIC X(25) VALUE "GAMMA X-RAY TECHNOLOGY ". - 05 FILLER PIC X(25) VALUE "DELTA LUGGAGE REPAIRS ". - 05 FILLER PIC X(25) VALUE "EPSILON EQUIPMENT SUPPLY ". - 05 FILLER PIC X(25) VALUE "FORTUNE COOKIE COMPANY ". - 02 DATA-COMPANY REDEFINES DATA-COMPANY-TBL - PIC X(25) OCCURS 6. - 02 DATA-ADDRESS-2-TBL. - - 05 FILLER PIC X(10) VALUE "NEW YORK ". - 05 FILLER PIC X(10) VALUE "ATLANTA ". - 05 FILLER PIC X(10) VALUE "WASHINGTON". - 05 FILLER PIC X(10) VALUE "TORONTO ". - 05 FILLER PIC X(10) VALUE "CALGARY ". - 05 FILLER PIC X(10) VALUE "WHITEPLAIN". - - 02 DATA-ADDRESS REDEFINES DATA-ADDRESS-2-TBL - PIC X(10) OCCURS 6. - - 02 DATA-NO-TERMINALS-TBL. - - 05 FILLER PIC 9(3) COMP-3 VALUE 10. - 05 FILLER PIC 9(3) COMP-3 VALUE 13. - 05 FILLER PIC 9(3) COMP-3 VALUE 75. - 05 FILLER PIC 9(3) COMP-3 VALUE 10. - 05 FILLER PIC 9(3) COMP-3 VALUE 90. - 05 FILLER PIC 9(3) COMP-3 VALUE 254. - - 02 DATA-NO-TERMINALS REDEFINES DATA-NO-TERMINALS-TBL - PIC 9(3) COMP-3 OCCURS 6. - 01 WORK-AREA. - 05 SUB PICTURE 9(4) COMP SYNC. - 88 ODD-RECORD VALUE 1 3 5. - - - PROCEDURE DIVISION. - - OPEN INPUT FLATFILE. - DISPLAY "Open Input when no file Sts:" CUST-STAT - OPEN EXTEND FLATFILE. - DISPLAY "Open Extend when no file Sts:" CUST-STAT - CLOSE FLATFILE. - DISPLAY "Close when no open file Sts:" CUST-STAT - OPEN OUTPUT FLATFILE. - CLOSE FLATFILE. - OPEN EXTEND FLATFILE. - DISPLAY "Open Extend when empty file Sts:" CUST-STAT - CLOSE FLATFILE. - - PERFORM LOADFILE. - OPEN INPUT FLATFILE. - DISPLAY "Open Sts:" CUST-STAT - READ FLATFILE - DISPLAY "Read " CM-CUST-NUM " Sts:" CUST-STAT. - READ FLATFILE - DISPLAY "Read " CM-CUST-NUM " Sts:" CUST-STAT. - CLOSE FLATFILE. - - OPEN I-O FLATFILE. - READ FLATFILE - DISPLAY "Read " CM-CUST-NUM " Sts:" CUST-STAT. - ADD 1 TO CM-NO-TERMINALS - REWRITE TSPFL-RECORD - DISPLAY "REWRITE " CM-CUST-NUM " Sts " CUST-STAT - " Trms:" CM-NO-TERMINALS. - CLOSE FLATFILE. - - OPEN I-O FLATFILE. - READ FLATFILE - DISPLAY "Read " CM-CUST-NUM " Sts:" CUST-STAT. - ADD 1 TO CM-NO-TERMINALS - REWRITE TSPFL-RECORD - DISPLAY "REWRITE " CM-CUST-NUM " Sts " CUST-STAT - " Trms:" CM-NO-TERMINALS. - READ FLATFILE WITH LOCK - DISPLAY "Read " CM-CUST-NUM - * DELETE FLATFILE - * DISPLAY "DELETE " CM-CUST-NUM " Sts " CUST-STAT. - CLOSE FLATFILE. - OPEN INPUT FLATFILE. - DISPLAY "Re-list File Open Sts:" CUST-STAT - PERFORM UNTIL CUST-STAT NOT = "00" - PERFORM READ-RECORD - END-PERFORM. - CLOSE FLATFILE. - OPEN EXTEND FLATFILE. - MOVE 2 TO SUB - PERFORM LOAD-RECORD - CLOSE FLATFILE. - OPEN INPUT FLATFILE. - DISPLAY "List File afer EXTEND Open Sts:" CUST-STAT - PERFORM UNTIL CUST-STAT NOT = "00" - PERFORM READ-RECORD - END-PERFORM. - CLOSE FLATFILE. - STOP RUN RETURNING 0. - - READ-RECORD. - MOVE SPACES TO TSPFL-RECORD. - READ FLATFILE - IF CUST-STAT NOT = "00" - DISPLAY "Read Status: " CUST-STAT - ELSE - DISPLAY "Read " CM-CUST-NUM - " Trms:" CM-NO-TERMINALS - END-IF. - - LOADFILE. - DISPLAY "Loading sample data file.". - - OPEN OUTPUT FLATFILE. - - PERFORM LOAD-RECORD - VARYING SUB FROM 1 BY 1 - UNTIL SUB > MAX-SUB. - - DISPLAY "Sample data file load complete.". - CLOSE FLATFILE. - - LOAD-RECORD. - - MOVE SPACES TO TSPFL-RECORD. - MOVE DATA-CUST-NUM (SUB) TO CM-CUST-NUM. - MOVE DATA-COMPANY (SUB) TO CM-COMPANY. - MOVE DATA-NO-TERMINALS (SUB) TO CM-NO-TERMINALS. - MOVE 20070319 TO CM-PK-DATE. - IF SUB = 1 OR 4 OR 6 - MOVE -20070319 TO CM-PK-DATE. - - IF ODD-RECORD - MOVE "8417" TO CM-DISK - ELSE - MOVE "8470" TO CM-DISK. - WRITE TSPFL-RECORD. -_ATEOF - - -cat >cmod.c <<'_ATEOF' - -#include -#include - -static char *txtOpCode(int opCode); - -static int -doOpenFile( - unsigned char *opCodep, - FCD3 *fcd, - char *opmsg) -{ - int sts; - - sts = EXTFH( opCodep, fcd ); - printf("EXFTH did %s; Status=%c%c; File now %s\n", - opmsg, fcd->fileStatus[0], fcd->fileStatus[1], - (fcd->openMode & OPEN_NOT_OPEN) ? "Closed" : "Open"); - return sts; -} - -/********************************************************* - * TSTFH - External File Handler entry point. -*********************************************************/ - -COB_EXT_EXPORT int -TSTFH (unsigned char *opCodep, FCD3 *fcd) -{ - unsigned int opCode; - int sts; - - if (*opCodep == 0xfa) - opCode = 0xfa00 + opCodep[1]; - else - opCode = opCodep[1]; - - if (fcd->fileOrg == ORG_LINE_SEQ - || fcd->fileOrg == ORG_SEQ - || fcd->fileOrg == ORG_INDEXED - || fcd->fileOrg == ORG_RELATIVE) { - switch (opCode) { - case OP_OPEN_OUTPUT: - case OP_OPEN_IO: - case OP_OPEN_EXTEND: - case OP_OPEN_OUTPUT_NOREWIND: - return doOpenFile( opCodep, fcd, txtOpCode(opCode)); - break; - - case OP_OPEN_INPUT: - case OP_OPEN_INPUT_NOREWIND: - case OP_OPEN_INPUT_REVERSED: - return doOpenFile( opCodep, fcd, txtOpCode(opCode)); - break; - - case OP_CLOSE: - return doOpenFile( opCodep, fcd, txtOpCode(opCode)); - break; - - default: - break; - } - - } - - if (opCode == OP_CLOSE - && (fcd->openMode & OPEN_NOT_OPEN) ) { - return 0; - } - - sts = EXTFH(opCodep, fcd); - printf("EXFTH did %s; Status=%c%c\n", txtOpCode(opCode), - fcd->fileStatus[0], fcd->fileStatus[1]); - return sts; -} - -static char * /* Return Text name of function */ -txtOpCode(int opCode) -{ - static char tmp[32]; - switch (opCode) { - case OP_OPEN_INPUT: return "OPEN_IN"; - case OP_OPEN_OUTPUT: return "OPEN_OUT"; - case OP_OPEN_IO: return "OPEN_IO"; - case OP_OPEN_EXTEND: return "OPEN_EXT"; - case OP_OPEN_INPUT_NOREWIND: return "OPEN_IN_NOREW"; - case OP_OPEN_OUTPUT_NOREWIND: return "OPEN_OUT_NOREW"; - case OP_OPEN_INPUT_REVERSED: return "OPEN_IN_REV"; - case OP_CLOSE: return "CLOSE"; - case OP_CLOSE_LOCK: return "CLOSE_LOCK"; - case OP_CLOSE_NOREWIND: return "CLOSE_NORED"; - case OP_CLOSE_REEL: return "CLOSE_REEL"; - case OP_CLOSE_REMOVE: return "CLOSE_REMOVE"; - case OP_CLOSE_NO_REWIND: return "CLOSE_NO_REW"; - case OP_START_EQ: return "START_EQ"; - case OP_START_EQ_ANY: return "START_EQ_ANY"; - case OP_START_GT: return "START_GT"; - case OP_START_GE: return "START_GE"; - case OP_START_LT: return "START_LT"; - case OP_START_LE: return "START_LE"; - case OP_READ_SEQ_NO_LOCK: return "READ_SEQ_NO_LK"; - case OP_READ_SEQ: return "READ_SEQ"; - case OP_READ_SEQ_LOCK: return "READ_SEQ_LK"; - case OP_READ_SEQ_KEPT_LOCK: return "READ_SEQ_KEPT_LK"; - case OP_READ_PREV_NO_LOCK: return "READ_PREV_NO_LK"; - case OP_READ_PREV: return "READ_PREV"; - case OP_READ_PREV_LOCK: return "READ_PREV_LK"; - case OP_READ_PREV_KEPT_LOCK: return "READ_PREV_KEPT_LK"; - case OP_READ_RAN: return "READ_RAN"; - case OP_READ_RAN_NO_LOCK: return "READ_RAN_NO_LK"; - case OP_READ_RAN_KEPT_LOCK: return "READ_RAN_KEPT_LK"; - case OP_READ_RAN_LOCK: return "READ_RAN_LK"; - case OP_READ_DIR: return "READ_DIR"; - case OP_READ_DIR_NO_LOCK: return "READ_DIR_NO_LK"; - case OP_READ_DIR_KEPT_LOCK: return "READ_DIR_KEPT_LK"; - case OP_READ_DIR_LOCK: return "READ_DIR_LK"; - case OP_READ_POSITION: return "READ_POSITION"; - case OP_WRITE: return "WRITE"; - case OP_REWRITE: return "REWRITE"; - case OP_DELETE: return "DELETE"; - case OP_DELETE_FILE: return "DELETE_FILE"; - case OP_UNLOCK: return "UNLOCK"; - case OP_ROLLBACK: return "ROLLBACK"; - case OP_COMMIT: return "COMMIT"; - case OP_WRITE_BEFORE: return "WRITE_BEFORE"; - case OP_WRITE_BEFORE_TAB: return "WRITE_BEFORE_TAB"; - case OP_WRITE_BEFORE_PAGE: return "WRITE_BEFORE_PAGE"; - case OP_WRITE_AFTER: return "WRITE_AFTER"; - case OP_WRITE_AFTER_TAB: return "WRITE_AFTER_TAB"; - case OP_WRITE_AFTER_PAGE: return "WRITE_AFTER_PAGE"; - } - sprintf(tmp, "Func 0x%02X:", opCode); - return tmp; -} -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_file.at:8480: \$COMPILE -fcallfh=TSTFH prog.cob cmod.c" -at_fn_check_prepare_dynamic "$COMPILE -fcallfh=TSTFH prog.cob cmod.c" "run_file.at:8480" -( $at_check_trace; $COMPILE -fcallfh=TSTFH prog.cob cmod.c -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_file.at:8480" -$at_failed && at_fn_log_failure -$at_traceon; } - - -{ set +x -$as_echo "$at_srcdir/run_file.at:8482: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_file.at:8482" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo "EXFTH did OPEN_IN; Status=35; File now Closed -Open Input when no file Sts:35 -EXFTH did OPEN_EXT; Status=35; File now Closed -Open Extend when no file Sts:35 -EXFTH did CLOSE; Status=42; File now Closed -Close when no open file Sts:42 -EXFTH did OPEN_OUT; Status=00; File now Open -EXFTH did CLOSE; Status=00; File now Closed -EXFTH did OPEN_EXT; Status=00; File now Open -Open Extend when empty file Sts:00 -EXFTH did CLOSE; Status=00; File now Closed -Loading sample data file. -EXFTH did OPEN_OUT; Status=00; File now Open -EXFTH did WRITE; Status=00 -EXFTH did WRITE; Status=00 -EXFTH did WRITE; Status=00 -EXFTH did WRITE; Status=00 -EXFTH did WRITE; Status=00 -EXFTH did WRITE; Status=00 -Sample data file load complete. -EXFTH did CLOSE; Status=00; File now Closed -EXFTH did OPEN_IN; Status=00; File now Open -Open Sts:00 -EXFTH did READ_SEQ; Status=00 -Read ALP00000 Sts:00 -EXFTH did READ_SEQ; Status=00 -Read BET00000 Sts:00 -EXFTH did CLOSE; Status=00; File now Closed -EXFTH did OPEN_IO; Status=00; File now Open -EXFTH did READ_SEQ; Status=00 -Read ALP00000 Sts:00 -EXFTH did REWRITE; Status=00 -REWRITE ALP00000 Sts 00 Trms:0011 -EXFTH did CLOSE; Status=00; File now Closed -EXFTH did OPEN_IO; Status=00; File now Open -EXFTH did READ_SEQ; Status=00 -Read ALP00000 Sts:00 -EXFTH did REWRITE; Status=00 -REWRITE ALP00000 Sts 00 Trms:0012 -EXFTH did READ_SEQ; Status=00 -Read BET00000 -EXFTH did CLOSE; Status=00; File now Closed -EXFTH did OPEN_IN; Status=00; File now Open -Re-list File Open Sts:00 -EXFTH did READ_SEQ; Status=00 -Read ALP00000 Trms:0012 -EXFTH did READ_SEQ; Status=00 -Read BET00000 Trms:0013 -EXFTH did READ_SEQ; Status=00 -Read GAM00000 Trms:0075 -EXFTH did READ_SEQ; Status=00 -Read DEL00000 Trms:0010 -EXFTH did READ_SEQ; Status=00 -Read EPS00000 Trms:0090 -EXFTH did READ_SEQ; Status=00 -Read FOR00000 Trms:0254 -EXFTH did READ_SEQ; Status=10 -Read Status: 10 -EXFTH did CLOSE; Status=00; File now Closed -EXFTH did OPEN_EXT; Status=00; File now Open -EXFTH did WRITE; Status=00 -EXFTH did CLOSE; Status=00; File now Closed -EXFTH did OPEN_IN; Status=00; File now Open -List File afer EXTEND Open Sts:00 -EXFTH did READ_SEQ; Status=00 -Read ALP00000 Trms:0012 -EXFTH did READ_SEQ; Status=00 -Read BET00000 Trms:0013 -EXFTH did READ_SEQ; Status=00 -Read GAM00000 Trms:0075 -EXFTH did READ_SEQ; Status=00 -Read DEL00000 Trms:0010 -EXFTH did READ_SEQ; Status=00 -Read EPS00000 Trms:0090 -EXFTH did READ_SEQ; Status=00 -Read FOR00000 Trms:0254 -EXFTH did READ_SEQ; Status=00 -Read BET00000 Trms:0013 -EXFTH did READ_SEQ; Status=10 -Read Status: 10 -EXFTH did CLOSE; Status=00; File now Closed -" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_file.at:8482" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_773 -#AT_START_774 -at_fn_group_banner 774 'run_file.at:8569' \ - "EXTFH: LINE SEQUENTIAL files, direct EXTFH" " " 4 -at_xfail=no -( - $as_echo "774. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - CONFIGURATION SECTION. - INPUT-OUTPUT SECTION. - FILE-CONTROL. - DATA DIVISION. - FILE SECTION. - WORKING-STORAGE SECTION. - - 01 I PIC XX COMP-X. - - 01 WS-FCD-DDNAME PIC X(8) VALUE SPACES. - 01 WS-FCD-PTR POINTER VALUE NULL. - - 01 WS-FCD-SIZE PIC 9(04) VALUE 0 COMP-5. - 01 WS-FCD-FLAGS PIC 9(04) VALUE 0 COMP-5. - - 01 DISPLAY-BYTE. - 05 DISPLAY-XXX PIC X(03). - 05 DISPLAY-ZZ9 REDEFINES DISPLAY-XXX - PIC ZZ9. - 01 ACTION-CODE pic x(2). - 78 OP-OPEN-INPUT value x"fa00". - 78 OP-OPEN-OUTPUT value x"fa01". - 78 OP-OPEN-I-O value x"fa02". - 78 OP-WRITE value x"faf3". - 78 OP-RELEASE value x"faf3". - 78 OP-REWRITE value x"faf4". - 78 OP-READ-NEXT value x"faf5". - 78 OP-START-EQUAL value x"fae9". - 78 OP-CLOSE value x"fa80". - 78 OP-QUERY-FILE value x"0006". - - 01 ACTION-CODE-WORK redefines ACTION-CODE. - 05 ACTION-CODE-1 PIC x(01) COMP-X. - 05 ACTION-CODE-2 PIC x(01) COMP-X. - - 01 DISPLAY-A1-XXX PIC X(03). - 01 DISPLAY-A1-ZZ9 REDEFINES DISPLAY-A1-XXX - PIC ZZ9. - 01 DISPLAY-A2-XXX PIC X(03). - 01 DISPLAY-A2-ZZ9 REDEFINES DISPLAY-A2-XXX - PIC ZZ9. - - 01 FCD-FILENAME PIC X(80) value "test.out". - 01 FCD-RECORD PIC X(512) value spaces. - - LINKAGE SECTION. - - 01 FCD-MAP. - copy 'xfhfcd3.cpy'. - - *================================================================* - PROCEDURE DIVISION. - *----------------------------------------------------------------* - 000-MAIN. - - PERFORM 100-OPEN. - - PERFORM VARYING I FROM 1 BY 1 UNTIL I > 10 - MOVE I TO DISPLAY-A1-ZZ9 - MOVE DISPLAY-A1-ZZ9 TO FCD-RECORD - PERFORM 300-WRITE - END-PERFORM. - - PERFORM 400-CLOSE. - STOP RUN. - - *----------------------------------------------------------------* - * Process the open request - * - 100-OPEN. - - MOVE "TESTOUT" TO WS-FCD-DDNAME - - MOVE LENGTH OF FCD-MAP TO WS-FCD-SIZE - DISPLAY "FCD SIZE " WS-FCD-SIZE. - - IF WS-FCD-PTR EQUAL NULL - ALLOCATE ws-fcd-size characters - returning WS-FCD-PTR - - SET ADDRESS OF FCD-MAP TO WS-FCD-PTR - MOVE LOW-VALUES TO FCD-MAP - MOVE WS-FCD-SIZE TO FCD-LENGTH - move fcd--version-number TO FCD-VERSION - MOVE "00" TO FCD-FILE-STATUS - move fcd--status-defined to FCD-ACCESS-MODE - move fcd--open-closed to FCD-OPEN-MODE - move fcd--external-name to FCD-OTHER-FLAGS - SET FCD-HANDLE TO NULL - MOVE 8 TO FCD-NAME-LENGTH - SET FCD-FILENAME-ADDRESS TO ADDRESS - OF WS-FCD-DDNAME - SET FCD-KEY-DEF-ADDRESS TO NULL - move fcd--allow-readers to FCD-LOCKTYPES - ELSE - SET ADDRESS OF FCD-MAP TO WS-FCD-PTR - IF FCD-OPEN-MODE NOT = fcd--open-closed - DISPLAY "ERRROR - FILE ALREADY OPEN" - STOP RUN - END-IF - END-IF - - move fcd--line-sequential-org to FCD-ORGANIZATION - move fcd--recmode-fixed to FCD-RECORDING-MODE - move 10 to FCD-MIN-REC-LENGTH, FCD-MAX-REC-LENGTH - SET FCD-RECORD-ADDRESS TO ADDRESS OF FCD-RECORD - - * Move fcd--cr-delimiter for CR LF after each record - * move fcd--cr-delimiter to FCD-STATUS-TYPE - - move op-open-output to action-code - - PERFORM 800-CALL-EXTFH - . - - *----------------------------------------------------------------* - * Process the write request - * - 300-WRITE. - - move 10 to FCD-CURRENT-REC-LEN - move op-write to action-code - PERFORM 800-CALL-EXTFH - . - *----------------------------------------------------------------* - * Process the close request - * - 400-CLOSE. - MOVE "00" TO FCD-FILE-STATUS - move op-close to action-code - PERFORM 800-CALL-EXTFH - . - *----------------------------------------------------------------* - * External file handler interface -- all I/O goes through here - * - 800-CALL-EXTFH. - - CALL "EXTFH" USING ACTION-CODE, FCD-MAP - - IF FCD-STATUS-KEY-1 = "9" AND FCD-BINARY = 199 - MOVE "10" TO FCD-FILE-STATUS - END-IF - . -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_file.at:8721: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_file.at:8721" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_file.at:8721" -$at_failed && at_fn_log_failure -$at_traceon; } - - -{ set +x -$as_echo "$at_srcdir/run_file.at:8723: TESTOUT=TEST-OUT \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "TESTOUT=TEST-OUT $COBCRUN_DIRECT ./prog" "run_file.at:8723" -( $at_check_trace; TESTOUT=TEST-OUT $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo "FCD SIZE 00216 -" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_file.at:8723" -$at_failed && at_fn_log_failure -$at_traceon; } - - - - - -# note: currently with the same behaviour as MF -# (ignoring minimal record length for line-sequential) -# this may change in the future... -cat >reference <<'_ATEOF' - 1 - 2 - 3 - 4 - 5 - 6 - 7 - 8 - 9 - 10 -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_file.at:8746: diff reference TEST-OUT" -at_fn_check_prepare_trace "run_file.at:8746" -( $at_check_trace; diff reference TEST-OUT -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_file.at:8746" -$at_failed && at_fn_log_failure \ -"./TEST-OUT" -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_774 -#AT_START_775 -at_fn_group_banner 775 'run_file.at:8751' \ - "RELATIVE Multi-Record" " " 4 -at_xfail=no -( - $as_echo "775. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - CONFIGURATION SECTION. - - INPUT-OUTPUT SECTION. - FILE-CONTROL. - SELECT FLATFILE ASSIGN EXTERNAL RELVAR - ORGANIZATION RELATIVE - ACCESS IS SEQUENTIAL - RELATIVE KEY IS REC-NUM - FILE STATUS IS CUST-STAT. - - DATA DIVISION. - FILE SECTION. - FD FLATFILE - BLOCK CONTAINS 5 RECORDS. - - 01 TSPFL-RECORD. - 10 CM-CUST-NUM PICTURE X(8). - 10 CM-TYPE PICTURE X. - 10 CM-COMPANY PICTURE X(25). - 10 CM-DISK PICTURE X(8). - 10 CM-NO-TERMINALS PICTURE 9(4) COMP-4. - 10 CM-PK-DATE PICTURE S9(14) COMP-3. - 10 CM-TRAILER PICTURE X(251). - - 01 TSP2-RECORD. - 10 C2-CUST-NUM PICTURE X(8). - 10 C2-TYPE PICTURE X. - 10 C2-COMPANY PICTURE X(25). - 10 C2-ADDRESS PICTURE X(25). - 10 C2-DISK PICTURE X(8). - 10 C2-NO-TERMINALS PICTURE 9(4) COMP-4. - 10 C2-PK-DATE PICTURE S9(14) COMP-3. - - - WORKING-STORAGE SECTION. - - 77 MAX-SUB VALUE 6 PICTURE 9(4) COMP SYNC. - 77 ZRO VALUE 1 PICTURE 9(4) COMP SYNC. - 77 CUST-STAT PICTURE X(2). - 77 REC-NUM VALUE 1 PICTURE 9(4) COMP SYNC. - - 01 TEST-DATA. - - 02 DATA-CUST-NUM-TBL. - - 05 FILLER PIC X(8) VALUE "ALP00000". - 05 FILLER PIC X(8) VALUE "BET00000". - 05 FILLER PIC X(8) VALUE "GAM00000". - 05 FILLER PIC X(8) VALUE "DEL00000". - 05 FILLER PIC X(8) VALUE "EPS00000". - 05 FILLER PIC X(8) VALUE "FOR00000". - - 02 DATA-CUST-NUM REDEFINES DATA-CUST-NUM-TBL - PIC X(8) OCCURS 6. - 02 DATA-COMPANY-TBL. - - 05 FILLER PIC X(25) VALUE "ALPHA ELECTRICAL CO. LTD.". - 05 FILLER PIC X(25) VALUE "BETA SHOE MFG. INC. ". - 05 FILLER PIC X(25) VALUE "GAMMA X-RAY TECHNOLOGY ". - 05 FILLER PIC X(25) VALUE "DELTA LUGGAGE REPAIRS ". - 05 FILLER PIC X(25) VALUE "EPSILON EQUIPMENT SUPPLY ". - 05 FILLER PIC X(25) VALUE "FORTUNE COOKIE COMPANY ". - 02 DATA-COMPANY REDEFINES DATA-COMPANY-TBL - PIC X(25) OCCURS 6. - 02 DATA-ADDRESS-2-TBL. - - 05 FILLER PIC X(10) VALUE "NEW YORK ". - 05 FILLER PIC X(10) VALUE "ATLANTA ". - 05 FILLER PIC X(10) VALUE "WASHINGTON". - 05 FILLER PIC X(10) VALUE "TORONTO ". - 05 FILLER PIC X(10) VALUE "CALGARY ". - 05 FILLER PIC X(10) VALUE "WHITEPLAIN". - - 02 DATA-ADDRESS REDEFINES DATA-ADDRESS-2-TBL - PIC X(10) OCCURS 6. - - 02 DATA-NO-TERMINALS-TBL. - - 05 FILLER PIC 9(3) COMP-3 VALUE 10. - 05 FILLER PIC 9(3) COMP-3 VALUE 13. - 05 FILLER PIC 9(3) COMP-3 VALUE 75. - 05 FILLER PIC 9(3) COMP-3 VALUE 10. - 05 FILLER PIC 9(3) COMP-3 VALUE 90. - 05 FILLER PIC 9(3) COMP-3 VALUE 254. - - 02 DATA-NO-TERMINALS REDEFINES DATA-NO-TERMINALS-TBL - PIC 9(3) COMP-3 OCCURS 6. - 01 WORK-AREA. - 05 SUB PICTURE 9(4) COMP SYNC. - 88 ODD-RECORD VALUE 1 3 5. - - - PROCEDURE DIVISION. - - PERFORM LOADFILE. - OPEN INPUT FLATFILE. - DISPLAY "Initial Re-Read Open Sts:" CUST-STAT - PERFORM UNTIL CUST-STAT NOT = "00" - PERFORM READ-RECORD - END-PERFORM. - IF CUST-STAT = "30" - CLOSE FLATFILE - STOP RUN - END-IF - CLOSE FLATFILE. - - OPEN I-O FLATFILE. - DISPLAY "For Rewrite Open I-O Sts:" CUST-STAT - PERFORM READ-RECORD - ADD 1 TO C2-NO-TERMINALS - REWRITE TSP2-RECORD - DISPLAY "REWRITE " CM-CUST-NUM " Sts " CUST-STAT - " Trms:" C2-NO-TERMINALS. - CLOSE FLATFILE. - - OPEN I-O FLATFILE. - DISPLAY "For Rewrite/Delete Open I-O Sts:" CUST-STAT - PERFORM READ-RECORD - ADD 1 TO C2-NO-TERMINALS - REWRITE TSP2-RECORD - DISPLAY "REWRITE " CM-CUST-NUM " Sts " CUST-STAT - " Trms:" C2-NO-TERMINALS. - PERFORM READ-RECORD - DELETE FLATFILE - DISPLAY "DELETE " CM-CUST-NUM " Sts " CUST-STAT. - CLOSE FLATFILE. - - OPEN INPUT FLATFILE. - DISPLAY "Re-list Open Sts:" CUST-STAT - PERFORM UNTIL CUST-STAT NOT = "00" - PERFORM READ-RECORD - END-PERFORM. - CLOSE FLATFILE. - - OPEN EXTEND FLATFILE. - PERFORM LOAD-RECORD - VARYING SUB FROM 1 BY 1 - UNTIL SUB > 2. - CLOSE FLATFILE. - - OPEN INPUT FLATFILE. - DISPLAY "Re-list afer Extend Open Sts:" CUST-STAT - PERFORM UNTIL CUST-STAT NOT = "00" - PERFORM READ-RECORD - END-PERFORM. - CLOSE FLATFILE. - STOP RUN RETURNING 0. - - LOADFILE. - DISPLAY "Loading sample program data file." - UPON CONSOLE. - - OPEN OUTPUT FLATFILE. - - PERFORM LOAD-RECORD - VARYING SUB FROM 1 BY 1 - UNTIL SUB > MAX-SUB. - - DISPLAY "Sample program data file load complete." - UPON CONSOLE. - CLOSE FLATFILE. - - READ-RECORD. - MOVE SPACES TO TSPFL-RECORD. - MOVE SPACES TO TSP2-RECORD. - READ FLATFILE - IF CUST-STAT NOT = "00" - DISPLAY "Read Status: " CUST-STAT - ELSE - IF CM-TYPE = SPACES - DISPLAY "Read " CM-CUST-NUM " #:" REC-NUM - " Trms:" CM-NO-TERMINALS - ELSE - DISPLAY "Read2 " C2-CUST-NUM " #:" REC-NUM - " Trms:" C2-NO-TERMINALS - END-IF. - * - LOAD-RECORD. - MOVE SPACES TO TSPFL-RECORD. - MOVE SPACES TO TSP2-RECORD. - MOVE DATA-CUST-NUM (SUB) TO CM-CUST-NUM. - MOVE DATA-COMPANY (SUB) TO CM-COMPANY. - MOVE DATA-NO-TERMINALS (SUB) TO CM-NO-TERMINALS. - MOVE 20070319 TO CM-PK-DATE. - IF SUB = 1 OR 4 OR 6 - MOVE -20070319 TO CM-PK-DATE. - * - IF ODD-RECORD - MOVE "8417" TO C2-DISK - * MOVE CM-CUST-NUM TO C2-CUST-NUM - MOVE '2' TO C2-TYPE - * MOVE CM-COMPANY TO C2-COMPANY - MOVE CM-PK-DATE TO C2-PK-DATE - MOVE CM-NO-TERMINALS TO C2-NO-TERMINALS - MOVE DATA-ADDRESS (SUB) TO C2-ADDRESS - WRITE TSP2-RECORD - ELSE - MOVE "8470" TO CM-DISK - MOVE ' ' TO CM-TYPE - WRITE TSPFL-RECORD. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_file.at:8960: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_file.at:8960" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_file.at:8960" -$at_failed && at_fn_log_failure -$at_traceon; } - - -{ set +x -$as_echo "$at_srcdir/run_file.at:8962: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_file.at:8962" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo "Loading sample program data file. -Sample program data file load complete. -Initial Re-Read Open Sts:00 -Read2 ALP00000 #:0001 Trms:0010 -Read BET00000 #:0002 Trms:0013 -Read2 GAM00000 #:0003 Trms:0075 -Read DEL00000 #:0004 Trms:0010 -Read2 EPS00000 #:0005 Trms:0090 -Read FOR00000 #:0006 Trms:0254 -Read Status: 10 -For Rewrite Open I-O Sts:00 -Read2 ALP00000 #:0001 Trms:0010 -REWRITE ALP00000 Sts 00 Trms:0011 -For Rewrite/Delete Open I-O Sts:00 -Read2 ALP00000 #:0001 Trms:0011 -REWRITE ALP00000 Sts 00 Trms:0012 -Read BET00000 #:0002 Trms:0013 -DELETE BET00000 Sts 00 -Re-list Open Sts:00 -Read2 ALP00000 #:0001 Trms:0012 -Read2 GAM00000 #:0003 Trms:0075 -Read DEL00000 #:0004 Trms:0010 -Read2 EPS00000 #:0005 Trms:0090 -Read FOR00000 #:0006 Trms:0254 -Read Status: 10 -Re-list afer Extend Open Sts:00 -Read2 ALP00000 #:0001 Trms:0012 -Read2 GAM00000 #:0003 Trms:0075 -Read DEL00000 #:0004 Trms:0010 -Read2 EPS00000 #:0005 Trms:0090 -Read FOR00000 #:0006 Trms:0254 -Read2 ALP00000 #:0007 Trms:0010 -Read BET00000 #:0008 Trms:0013 -Read Status: 10 -" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_file.at:8962" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_775 -#AT_START_776 -at_fn_group_banner 776 'run_file.at:9002' \ - "RELATIVE one Record" " " 4 -at_xfail=no -( - $as_echo "776. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - CONFIGURATION SECTION. - - INPUT-OUTPUT SECTION. - FILE-CONTROL. - SELECT FLATFILE ASSIGN EXTERNAL RELFIX - ORGANIZATION RELATIVE - ACCESS IS SEQUENTIAL RELATIVE KEY IS REC-NUM - FILE STATUS IS CUST-STAT. - - SELECT FLATFILE2 ASSIGN EXTERNAL RELFIX - ORGANIZATION RELATIVE - ACCESS IS RANDOM RELATIVE KEY IS REC-NUM - FILE STATUS IS CUST-STAT. - - DATA DIVISION. - FILE SECTION. - FD FLATFILE - BLOCK CONTAINS 5 RECORDS. - - 01 TSPFL-RECORD. - 10 CM-CUST-NUM PICTURE X(8). - 10 CM-COMPANY PICTURE X(25). - 10 CM-DISK PICTURE X(8). - 10 CM-NO-TERMINALS PICTURE 9(4) COMP-4. - 10 CM-PK-DATE PICTURE S9(14) COMP-3. - 10 CM-TRAILER PICTURE X(252). - - FD FLATFILE2 - BLOCK CONTAINS 5 RECORDS. - - 01 TSP2-RECORD. - 10 C2-CUST-NUM PICTURE X(8). - 10 C2-COMPANY PICTURE X(25). - 10 C2-DISK PICTURE X(8). - 10 C2-NO-TERMINALS PICTURE 9(4) COMP-4. - 10 C2-PK-DATE PICTURE S9(14) COMP-3. - 10 C2-TRAILER PICTURE X(252). - - WORKING-STORAGE SECTION. - - 77 MAX-SUB VALUE 6 PICTURE 9(4) COMP SYNC. - 77 CUST-STAT PICTURE X(2). - 77 REC-NUM VALUE 1 PICTURE 9(4) COMP SYNC. - - 01 TEST-DATA. - - 02 DATA-CUST-NUM-TBL. - - 05 FILLER PIC X(8) VALUE "ALP00000". - 05 FILLER PIC X(8) VALUE "BET00000". - 05 FILLER PIC X(8) VALUE "DEL00000". - 05 FILLER PIC X(8) VALUE "EPS00000". - 05 FILLER PIC X(8) VALUE "FOR00000". - 05 FILLER PIC X(8) VALUE "GAM00000". - - 02 DATA-CUST-NUM REDEFINES DATA-CUST-NUM-TBL - PIC X(8) OCCURS 6. - 02 DATA-COMPANY-TBL. - - 05 FILLER PIC X(25) VALUE "ALPHA ELECTRICAL CO. LTD.". - 05 FILLER PIC X(25) VALUE "BETA SHOE MFG. INC. ". - 05 FILLER PIC X(25) VALUE "DELTA LUGGAGE REPAIRS ". - 05 FILLER PIC X(25) VALUE "EPSILON EQUIPMENT SUPPLY ". - 05 FILLER PIC X(25) VALUE "FORTUNE COOKIE COMPANY ". - 05 FILLER PIC X(25) VALUE "GAMMA X-RAY TECHNOLOGY ". - 02 DATA-COMPANY REDEFINES DATA-COMPANY-TBL - PIC X(25) OCCURS 6. - 02 DATA-ADDRESS-2-TBL. - - 05 FILLER PIC X(10) VALUE "ATLANTA ". - 05 FILLER PIC X(10) VALUE "CALGARY ". - 05 FILLER PIC X(10) VALUE "NEW YORK ". - 05 FILLER PIC X(10) VALUE "TORONTO ". - 05 FILLER PIC X(10) VALUE "WASHINGTON". - 05 FILLER PIC X(10) VALUE "WHITEPLAIN". - 02 DATA-ADDRESS REDEFINES DATA-ADDRESS-2-TBL - PIC X(10) OCCURS 6. - - 02 DATA-NO-TERMINALS-TBL. - - 05 FILLER PIC 9(3) COMP-3 VALUE 10. - 05 FILLER PIC 9(3) COMP-3 VALUE 13. - 05 FILLER PIC 9(3) COMP-3 VALUE 75. - 05 FILLER PIC 9(3) COMP-3 VALUE 10. - 05 FILLER PIC 9(3) COMP-3 VALUE 90. - 05 FILLER PIC 9(3) COMP-3 VALUE 254. - - 02 DATA-NO-TERMINALS REDEFINES DATA-NO-TERMINALS-TBL - PIC 9(3) COMP-3 OCCURS 6. - 01 WORK-AREA. - 05 SUB PICTURE 9(4) COMP SYNC. - 88 ODD-RECORD VALUE 1 3 5. - - - PROCEDURE DIVISION. - - PERFORM LOADFILE. - - OPEN INPUT FLATFILE. - DISPLAY "Open Sts:" CUST-STAT - PERFORM 4 TIMES - PERFORM READ-NEXT - END-PERFORM. - CLOSE FLATFILE. - - DISPLAY "*** Test Update of file ***". - OPEN I-O FLATFILE. - PERFORM READ-NEXT - ADD 1 TO CM-NO-TERMINALS - REWRITE TSPFL-RECORD - DISPLAY "REWRITE " CM-CUST-NUM " Sts " CUST-STAT - " Trms:" CM-NO-TERMINALS. - CLOSE FLATFILE. - - OPEN I-O FLATFILE. - READ FLATFILE - DISPLAY "Read " CM-CUST-NUM " Sts:" CUST-STAT. - ADD 1 TO CM-NO-TERMINALS - REWRITE TSPFL-RECORD - DISPLAY "REWRITE " CM-CUST-NUM " Sts " CUST-STAT - " Trms:" CM-NO-TERMINALS. - READ FLATFILE WITH LOCK - DISPLAY "Read " CM-CUST-NUM - DELETE FLATFILE - DISPLAY "DELETE " CM-CUST-NUM " Sts " CUST-STAT. - CLOSE FLATFILE. - - DISPLAY "*** List file afer Update/Delete ***". - OPEN INPUT FLATFILE. - PERFORM 4 TIMES - READ FLATFILE - DISPLAY "Read " CM-CUST-NUM " Sts " CUST-STAT - " Trms:" CM-NO-TERMINALS - END-PERFORM. - CLOSE FLATFILE. - OPEN I-O FLATFILE2. - MOVE SPACES TO TSP2-RECORD. - MOVE 5 TO REC-NUM. - PERFORM READ2. - MOVE 3 TO REC-NUM. - PERFORM READ2. - WRITE TSP2-RECORD. - DISPLAY "Write of " REC-NUM " Sts " CUST-STAT - PERFORM READ2. - MOVE SPACES TO TSP2-RECORD. - MOVE 2 TO REC-NUM. - READ FLATFILE2. - DISPLAY " Read of deleted " REC-NUM " Sts " CUST-STAT - MOVE SPACES TO TSP2-RECORD. - MOVE DATA-CUST-NUM (2) TO C2-CUST-NUM. - MOVE DATA-COMPANY (2) TO C2-COMPANY. - MOVE DATA-NO-TERMINALS (2) TO C2-NO-TERMINALS. - MOVE 20070319 TO C2-PK-DATE. - MOVE "8440" TO C2-DISK - MOVE 2 TO REC-NUM. - REWRITE TSP2-RECORD. - DISPLAY "ReWrite deleted " C2-CUST-NUM " Sts " CUST-STAT - MOVE SPACES TO TSP2-RECORD. - MOVE DATA-CUST-NUM (2) TO C2-CUST-NUM. - MOVE DATA-COMPANY (2) TO C2-COMPANY. - MOVE DATA-NO-TERMINALS (2) TO C2-NO-TERMINALS. - MOVE 20070319 TO C2-PK-DATE. - MOVE "8440" TO C2-DISK - MOVE 2 TO REC-NUM. - WRITE TSP2-RECORD. - DISPLAY "Write of deleted " C2-CUST-NUM " Sts " CUST-STAT - CLOSE FLATFILE2. - - DISPLAY "*** List file afer Re-Add ***". - OPEN INPUT FLATFILE. - PERFORM 4 TIMES - PERFORM READ-RECORD - END-PERFORM. - PERFORM READ-PREV - PERFORM READ-PREV - PERFORM READ-PREV - PERFORM READ-PREV - START FLATFILE LAST - DISPLAY "Start Last Sts " CUST-STAT " Rec#" REC-NUM. - PERFORM READ-PREV - PERFORM READ-PREV - START FLATFILE FIRST - DISPLAY "Start First Sts " CUST-STAT " Rec#" REC-NUM. - PERFORM READ-NEXT - PERFORM READ-NEXT - MOVE 4 TO REC-NUM. - START FLATFILE KEY GREATER OR EQUAL REC-NUM. - DISPLAY "Start GE 4:" REC-NUM - " Sts " CUST-STAT " Rec#" REC-NUM. - PERFORM READ-NEXT - PERFORM READ-NEXT - MOVE 4 TO REC-NUM. - START FLATFILE KEY GREATER REC-NUM. - DISPLAY "Start GT 4:" REC-NUM - " Sts " CUST-STAT " Rec#" REC-NUM. - PERFORM READ-NEXT - PERFORM READ-NEXT - MOVE 5 TO REC-NUM. - START FLATFILE KEY LESS REC-NUM. - DISPLAY "Start LT 5: " REC-NUM - " Sts " CUST-STAT " Rec#" REC-NUM. - PERFORM READ-RECORD. - PERFORM READ-PREV - MOVE 5 TO REC-NUM. - START FLATFILE KEY LESS OR EQUAL REC-NUM. - DISPLAY "Start LE 5:" REC-NUM - " Sts " CUST-STAT " Rec#" REC-NUM. - PERFORM READ-RECORD. - PERFORM READ-PREV - CLOSE FLATFILE. - - OPEN INPUT FLATFILE. - DISPLAY "Re-list Open Sts:" CUST-STAT - PERFORM UNTIL CUST-STAT NOT = "00" - PERFORM READ-RECORD - END-PERFORM. - CLOSE FLATFILE. - - OPEN EXTEND FLATFILE. - MOVE 2 TO SUB - PERFORM LOAD-RECORD . - CLOSE FLATFILE. - - OPEN INPUT FLATFILE. - DISPLAY "Re-list after Extend Open Sts:" CUST-STAT - PERFORM UNTIL CUST-STAT NOT = "00" - PERFORM READ-RECORD - END-PERFORM. - CLOSE FLATFILE. - OPEN INPUT FLATFILE2. - PERFORM READ2 - VARYING REC-NUM FROM 1 BY 1 - UNTIL REC-NUM > MAX-SUB + 5 - OR CUST-STAT NOT = "00". - CLOSE FLATFILE2. - STOP RUN RETURNING 0. - - READ2. - MOVE SPACES TO TSP2-RECORD. - READ FLATFILE2 - INVALID KEY - DISPLAY "Invalid Read2 " REC-NUM - " Status: " CUST-STAT - END-READ - IF CUST-STAT NOT = "00" - DISPLAY "Read2 Status: " CUST-STAT - ELSE - DISPLAY "Read2 " C2-CUST-NUM - " #" REC-NUM - " Trms:" C2-NO-TERMINALS - END-IF. - - READ-RECORD. - MOVE SPACES TO TSPFL-RECORD. - READ FLATFILE - IF CUST-STAT NOT = "00" - DISPLAY "Read Status: " CUST-STAT - ELSE - DISPLAY "Read " CM-CUST-NUM - " #" REC-NUM - " Trms:" CM-NO-TERMINALS - END-IF. - - READ-PREV. - MOVE SPACES TO TSPFL-RECORD. - READ FLATFILE PREVIOUS - IF CUST-STAT NOT = "00" - DISPLAY "Read Prev Status: " CUST-STAT - ELSE - DISPLAY "Prev " CM-CUST-NUM - " #" REC-NUM - " Trms:" CM-NO-TERMINALS - END-IF. - - READ-NEXT. - MOVE SPACES TO TSPFL-RECORD. - READ FLATFILE NEXT - IF CUST-STAT NOT = "00" - DISPLAY "Read Next Status: " CUST-STAT - ELSE - DISPLAY "Next " CM-CUST-NUM - " #" REC-NUM - " Trms:" CM-NO-TERMINALS - END-IF. - - LOADFILE. - DISPLAY "Loading sample program data file." - UPON CONSOLE. - - OPEN OUTPUT FLATFILE. - - PERFORM LOAD-RECORD - VARYING SUB FROM 1 BY 1 - UNTIL SUB > MAX-SUB. - - DISPLAY "Sample program data file load complete." - UPON CONSOLE. - CLOSE FLATFILE. - - LOAD-RECORD. - - MOVE SPACES TO TSPFL-RECORD. - MOVE DATA-CUST-NUM (SUB) TO CM-CUST-NUM. - MOVE DATA-COMPANY (SUB) TO CM-COMPANY. - MOVE DATA-NO-TERMINALS (SUB) TO CM-NO-TERMINALS. - MOVE 20070319 TO CM-PK-DATE. - IF SUB = 1 OR 4 OR 6 - MOVE -20070319 TO CM-PK-DATE. - - IF ODD-RECORD - MOVE "8417" TO CM-DISK - ELSE - MOVE "8470" TO CM-DISK. - WRITE TSPFL-RECORD. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_file.at:9325: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_file.at:9325" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_file.at:9325" -$at_failed && at_fn_log_failure -$at_traceon; } - - -{ set +x -$as_echo "$at_srcdir/run_file.at:9327: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_file.at:9327" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo "Loading sample program data file. -Sample program data file load complete. -Open Sts:00 -Next ALP00000 #0001 Trms:0010 -Next BET00000 #0002 Trms:0013 -Next DEL00000 #0003 Trms:0075 -Next EPS00000 #0004 Trms:0010 -*** Test Update of file *** -Next ALP00000 #0001 Trms:0010 -REWRITE ALP00000 Sts 00 Trms:0011 -Read ALP00000 Sts:00 -REWRITE ALP00000 Sts 00 Trms:0012 -Read BET00000 -DELETE BET00000 Sts 00 -*** List file afer Update/Delete *** -Read ALP00000 Sts 00 Trms:0012 -Read DEL00000 Sts 00 Trms:0075 -Read EPS00000 Sts 00 Trms:0010 -Read FOR00000 Sts 00 Trms:0090 -Read2 FOR00000 #0005 Trms:0090 -Read2 DEL00000 #0003 Trms:0075 -Write of 0003 Sts 22 -Read2 DEL00000 #0003 Trms:0075 - Read of deleted 0002 Sts 23 -ReWrite deleted BET00000 Sts 23 -Write of deleted BET00000 Sts 00 -*** List file afer Re-Add *** -Read ALP00000 #0001 Trms:0012 -Read BET00000 #0002 Trms:0013 -Read DEL00000 #0003 Trms:0075 -Read EPS00000 #0004 Trms:0010 -Prev DEL00000 #0003 Trms:0075 -Prev BET00000 #0002 Trms:0013 -Prev ALP00000 #0001 Trms:0012 -Read Prev Status: 10 -Start Last Sts 00 Rec#0006 -Prev GAM00000 #0006 Trms:0254 -Prev FOR00000 #0005 Trms:0090 -Start First Sts 00 Rec#0001 -Next ALP00000 #0001 Trms:0012 -Next BET00000 #0002 Trms:0013 -Start GE 4:0004 Sts 00 Rec#0004 -Next EPS00000 #0004 Trms:0010 -Next FOR00000 #0005 Trms:0090 -Start GT 4:0005 Sts 00 Rec#0005 -Next FOR00000 #0005 Trms:0090 -Next GAM00000 #0006 Trms:0254 -Start LT 5: 0004 Sts 00 Rec#0004 -Read EPS00000 #0004 Trms:0010 -Prev DEL00000 #0003 Trms:0075 -Start LE 5:0005 Sts 00 Rec#0005 -Read FOR00000 #0005 Trms:0090 -Prev EPS00000 #0004 Trms:0010 -Re-list Open Sts:00 -Read ALP00000 #0001 Trms:0012 -Read BET00000 #0002 Trms:0013 -Read DEL00000 #0003 Trms:0075 -Read EPS00000 #0004 Trms:0010 -Read FOR00000 #0005 Trms:0090 -Read GAM00000 #0006 Trms:0254 -Read Status: 10 -Re-list after Extend Open Sts:00 -Read ALP00000 #0001 Trms:0012 -Read BET00000 #0002 Trms:0013 -Read DEL00000 #0003 Trms:0075 -Read EPS00000 #0004 Trms:0010 -Read FOR00000 #0005 Trms:0090 -Read GAM00000 #0006 Trms:0254 -Read BET00000 #0007 Trms:0013 -Read Status: 10 -Read2 ALP00000 #0001 Trms:0012 -Read2 BET00000 #0002 Trms:0013 -Read2 DEL00000 #0003 Trms:0075 -Read2 EPS00000 #0004 Trms:0010 -Read2 FOR00000 #0005 Trms:0090 -Read2 GAM00000 #0006 Trms:0254 -Read2 BET00000 #0007 Trms:0013 -Invalid Read2 0008 Status: 23 -Read2 Status: 23 -" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_file.at:9327" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_776 -#AT_START_777 -at_fn_group_banner 777 'run_file.at:9412' \ - "SEQUENTIAL Multi-Record" " " 4 -at_xfail=no -( - $as_echo "777. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - - ENVIRONMENT DIVISION. - CONFIGURATION SECTION. - - INPUT-OUTPUT SECTION. - FILE-CONTROL. - SELECT FLATFILE ASSIGN EXTERNAL SEQVAR - ORGANIZATION SEQUENTIAL - FILE STATUS IS CUST-STAT . - - DATA DIVISION. - FILE SECTION. - FD FLATFILE - BLOCK CONTAINS 5 RECORDS. - - 01 TSPFL-RECORD. - 10 CM-CUST-NUM PICTURE X(8). - 10 CM-TYPE PICTURE X. - 10 CM-COMPANY PICTURE X(25). - 10 CM-DISK PICTURE X(8). - 10 CM-NO-TERMINALS PICTURE 9(4) COMP-4. - 10 CM-PK-DATE PICTURE S9(14) COMP-3. - 10 CM-TRAILER PICTURE X(251). - - 01 TSP2-RECORD. - 10 C2-CUST-NUM PICTURE X(8). - 10 C2-TYPE PICTURE X. - 10 C2-COMPANY PICTURE X(25). - 10 C2-ADDRESS PICTURE X(25). - 10 C2-DISK PICTURE X(8). - 10 C2-NO-TERMINALS PICTURE 9(4) COMP-4. - 10 C2-PK-DATE PICTURE S9(14) COMP-3. - - WORKING-STORAGE SECTION. - - 77 MAX-SUB VALUE 6 PICTURE 9(4) COMP. - 77 ZRO VALUE 1 PICTURE 9(4) COMP. - 77 CUST-STAT PICTURE X(2). - 77 REC-NUM VALUE 1 PICTURE 9(8) COMP. - - 01 TEST-DATA. - - 02 DATA-CUST-NUM-TBL. - - 05 FILLER PIC X(8) VALUE "ALP00000". - 05 FILLER PIC X(8) VALUE "BET00000". - 05 FILLER PIC X(8) VALUE "GAM00000". - 05 FILLER PIC X(8) VALUE "DEL00000". - 05 FILLER PIC X(8) VALUE "EPS00000". - 05 FILLER PIC X(8) VALUE "FOR00000". - - 02 DATA-CUST-NUM REDEFINES DATA-CUST-NUM-TBL - PIC X(8) OCCURS 6. - 02 DATA-COMPANY-TBL. - - 05 FILLER PIC X(25) VALUE "ALPHA ELECTRICAL CO. LTD.". - 05 FILLER PIC X(25) VALUE "BETA SHOE MFG. INC. ". - 05 FILLER PIC X(25) VALUE "GAMMA X-RAY TECHNOLOGY ". - 05 FILLER PIC X(25) VALUE "DELTA LUGGAGE REPAIRS ". - 05 FILLER PIC X(25) VALUE "EPSILON EQUIPMENT SUPPLY ". - 05 FILLER PIC X(25) VALUE "FORTUNE COOKIE COMPANY ". - 02 DATA-COMPANY REDEFINES DATA-COMPANY-TBL - PIC X(25) OCCURS 6. - 02 DATA-ADDRESS-2-TBL. - - 05 FILLER PIC X(10) VALUE "NEW YORK ". - 05 FILLER PIC X(10) VALUE "ATLANTA ". - 05 FILLER PIC X(10) VALUE "WASHINGTON". - 05 FILLER PIC X(10) VALUE "TORONTO ". - 05 FILLER PIC X(10) VALUE "CALGARY ". - 05 FILLER PIC X(10) VALUE "WHITEPLAIN". - - 02 DATA-ADDRESS REDEFINES DATA-ADDRESS-2-TBL - PIC X(10) OCCURS 6. - - 02 DATA-NO-TERMINALS-TBL. - - 05 FILLER PIC 9(4) COMP-4 VALUE 10. - 05 FILLER PIC 9(4) COMP-4 VALUE 13. - 05 FILLER PIC 9(4) COMP-4 VALUE 75. - 05 FILLER PIC 9(4) COMP-4 VALUE 10. - 05 FILLER PIC 9(4) COMP-4 VALUE 90. - 05 FILLER PIC 9(4) COMP-4 VALUE 254. - - 02 DATA-NO-TERMINALS REDEFINES DATA-NO-TERMINALS-TBL - PIC 9(4) COMP-4 OCCURS 6. - 01 WORK-AREA. - 05 SUB PICTURE 9(4) COMP. - 88 ODD-RECORD VALUE 1 3 5. - - - PROCEDURE DIVISION. - - PERFORM LOADFILE. - OPEN INPUT FLATFILE. - DISPLAY "Open Sts:" CUST-STAT - PERFORM READ-RECORD - PERFORM READ-RECORD - CLOSE FLATFILE. - - OPEN I-O FLATFILE. - PERFORM READ-RECORD - ADD 1 TO C2-NO-TERMINALS - REWRITE TSP2-RECORD - DISPLAY "REWRITE " CM-CUST-NUM " Sts " CUST-STAT - " Trms:" C2-NO-TERMINALS. - CLOSE FLATFILE. - - OPEN I-O FLATFILE. - PERFORM READ-RECORD - ADD 1 TO C2-NO-TERMINALS - REWRITE TSP2-RECORD - DISPLAY "REWRITE " C2-CUST-NUM " Sts " CUST-STAT - " Trms:" C2-NO-TERMINALS. - PERFORM READ-RECORD - * DELETE should cause compiler error - * DELETE FLATFILE - * DISPLAY "DELETE " CM-CUST-NUM " Sts " CUST-STAT. - CLOSE FLATFILE. - - OPEN I-O FLATFILE. - PERFORM READ-RECORD. - PERFORM READ-RECORD. - ADD 1 TO C2-NO-TERMINALS - REWRITE TSP2-RECORD - DISPLAY "REWRITE2 " C2-CUST-NUM " Sts " CUST-STAT - " Trms:" C2-NO-TERMINALS. - CLOSE FLATFILE. - - OPEN I-O FLATFILE. - PERFORM READ-RECORD. - ADD 1 TO CM-NO-TERMINALS - REWRITE TSPFL-RECORD - DISPLAY "REWRITE " CM-CUST-NUM " Sts " CUST-STAT - " Trms:" CM-NO-TERMINALS. - CLOSE FLATFILE. - - - OPEN INPUT FLATFILE. - DISPLAY "Reread file after updates Open Sts:" CUST-STAT. - PERFORM UNTIL CUST-STAT NOT = "00" - PERFORM READ-RECORD - END-PERFORM. - CLOSE FLATFILE. - - OPEN EXTEND FLATFILE. - MOVE 1 TO SUB - PERFORM LOAD-RECORD - CLOSE FLATFILE. - - OPEN INPUT FLATFILE. - DISPLAY "Re-list after extend Open Sts:" CUST-STAT - PERFORM UNTIL CUST-STAT NOT = "00" - PERFORM READ-RECORD - END-PERFORM. - CLOSE FLATFILE. - STOP RUN RETURNING 0. - - LOADFILE. - DISPLAY "Loading sample program data file." - UPON CONSOLE. - - OPEN OUTPUT FLATFILE. - - PERFORM LOAD-RECORD - VARYING SUB FROM 1 BY 1 - UNTIL SUB > MAX-SUB. - - DISPLAY "Sample program data file load complete." - UPON CONSOLE. - CLOSE FLATFILE. - - READ-RECORD. - MOVE SPACES TO TSPFL-RECORD. - MOVE SPACES TO TSP2-RECORD. - READ FLATFILE - IF CUST-STAT NOT = "00" - DISPLAY "Read status: " CUST-STAT - ELSE - IF CM-TYPE = SPACES - DISPLAY "Read " CM-CUST-NUM - " Trms:" CM-NO-TERMINALS - ELSE - DISPLAY "Read2 " C2-CUST-NUM - " Trms:" C2-NO-TERMINALS - END-IF. - * - LOAD-RECORD. - MOVE SPACES TO TSPFL-RECORD. - MOVE SPACES TO TSP2-RECORD. - MOVE DATA-CUST-NUM (SUB) TO CM-CUST-NUM. - MOVE DATA-COMPANY (SUB) TO CM-COMPANY. - MOVE DATA-NO-TERMINALS (SUB) TO CM-NO-TERMINALS. - MOVE 20070319 TO CM-PK-DATE. - IF SUB = 1 OR 4 OR 6 - MOVE -20070319 TO CM-PK-DATE. - * - IF ODD-RECORD - MOVE "8417" TO CM-DISK - ELSE - MOVE "8470" TO CM-DISK. - IF ODD-RECORD - * MOVE CM-CUST-NUM TO C2-CUST-NUM - * MOVE CM-COMPANY TO C2-COMPANY - MOVE CM-DISK TO C2-DISK - MOVE CM-PK-DATE TO C2-PK-DATE - MOVE CM-NO-TERMINALS TO C2-NO-TERMINALS - MOVE DATA-ADDRESS (SUB) TO C2-ADDRESS - MOVE '2' TO C2-TYPE - WRITE TSP2-RECORD - ELSE - WRITE TSPFL-RECORD. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_file.at:9632: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_file.at:9632" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_file.at:9632" -$at_failed && at_fn_log_failure -$at_traceon; } - - -{ set +x -$as_echo "$at_srcdir/run_file.at:9634: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_file.at:9634" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo "Loading sample program data file. -Sample program data file load complete. -Open Sts:00 -Read2 ALP00000 Trms:0010 -Read BET00000 Trms:0013 -Read2 ALP00000 Trms:0010 -REWRITE ALP00000 Sts 00 Trms:0011 -Read2 ALP00000 Trms:0011 -REWRITE ALP00000 Sts 00 Trms:0012 -Read BET00000 Trms:0013 -Read2 ALP00000 Trms:0012 -Read BET00000 Trms:0013 -REWRITE2 BET00000 Sts 44 Trms:8225 -Read2 ALP00000 Trms:0012 -REWRITE ALP00000 Sts 44 Trms:8225 -Reread file after updates Open Sts:00 -Read2 ALP00000 Trms:0012 -Read BET00000 Trms:0013 -Read2 GAM00000 Trms:0075 -Read DEL00000 Trms:0010 -Read2 EPS00000 Trms:0090 -Read FOR00000 Trms:0254 -Read status: 10 -Re-list after extend Open Sts:00 -Read2 ALP00000 Trms:0012 -Read BET00000 Trms:0013 -Read2 GAM00000 Trms:0075 -Read DEL00000 Trms:0010 -Read2 EPS00000 Trms:0090 -Read FOR00000 Trms:0254 -Read2 ALP00000 Trms:0010 -Read status: 10 -" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_file.at:9634" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_777 -#AT_START_778 -at_fn_group_banner 778 'run_file.at:9672' \ - "SEQUENTIAL one Record" " " 4 -at_xfail=no -( - $as_echo "778. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - - ENVIRONMENT DIVISION. - CONFIGURATION SECTION. - - INPUT-OUTPUT SECTION. - FILE-CONTROL. - SELECT FLATFILE ASSIGN EXTERNAL SEQFIX - ORGANIZATION SEQUENTIAL - FILE STATUS IS CUST-STAT . - - DATA DIVISION. - FILE SECTION. - FD FLATFILE - BLOCK CONTAINS 5 RECORDS. - - 01 TSPFL-RECORD. - 10 CM-CUST-NUM PICTURE X(8). - 10 CM-COMPANY PICTURE X(25). - 10 CM-DISK PICTURE X(8). - 10 CM-NO-TERMINALS PICTURE 9(4) COMP-4. - 10 CM-PK-DATE PICTURE S9(14) COMP-3. - 10 CM-TRAILER PICTURE X(8). - - WORKING-STORAGE SECTION. - - 77 MAX-SUB VALUE 6 PICTURE 9(4) COMP SYNC. - 77 CUST-STAT PICTURE X(2). - - 01 TEST-DATA. - - 02 DATA-CUST-NUM-TBL. - - 05 FILLER PIC X(8) VALUE "ALP00000". - 05 FILLER PIC X(8) VALUE "BET00000". - 05 FILLER PIC X(8) VALUE "GAM00000". - 05 FILLER PIC X(8) VALUE "DEL00000". - 05 FILLER PIC X(8) VALUE "EPS00000". - 05 FILLER PIC X(8) VALUE "FOR00000". - - 02 DATA-CUST-NUM REDEFINES DATA-CUST-NUM-TBL - PIC X(8) OCCURS 6. - 02 DATA-COMPANY-TBL. - - 05 FILLER PIC X(25) VALUE "ALPHA ELECTRICAL CO. LTD.". - 05 FILLER PIC X(25) VALUE "BETA SHOE MFG. INC. ". - 05 FILLER PIC X(25) VALUE "GAMMA X-RAY TECHNOLOGY ". - 05 FILLER PIC X(25) VALUE "DELTA LUGGAGE REPAIRS ". - 05 FILLER PIC X(25) VALUE "EPSILON EQUIPMENT SUPPLY ". - 05 FILLER PIC X(25) VALUE "FORTUNE COOKIE COMPANY ". - 02 DATA-COMPANY REDEFINES DATA-COMPANY-TBL - PIC X(25) OCCURS 6. - 02 DATA-ADDRESS-2-TBL. - - 05 FILLER PIC X(10) VALUE "NEW YORK ". - 05 FILLER PIC X(10) VALUE "ATLANTA ". - 05 FILLER PIC X(10) VALUE "WASHINGTON". - 05 FILLER PIC X(10) VALUE "TORONTO ". - 05 FILLER PIC X(10) VALUE "CALGARY ". - 05 FILLER PIC X(10) VALUE "WHITEPLAIN". - - 02 DATA-ADDRESS REDEFINES DATA-ADDRESS-2-TBL - PIC X(10) OCCURS 6. - - 02 DATA-NO-TERMINALS-TBL. - - 05 FILLER PIC 9(3) COMP-3 VALUE 10. - 05 FILLER PIC 9(3) COMP-3 VALUE 13. - 05 FILLER PIC 9(3) COMP-3 VALUE 75. - 05 FILLER PIC 9(3) COMP-3 VALUE 10. - 05 FILLER PIC 9(3) COMP-3 VALUE 90. - 05 FILLER PIC 9(3) COMP-3 VALUE 254. - - 02 DATA-NO-TERMINALS REDEFINES DATA-NO-TERMINALS-TBL - PIC 9(3) COMP-3 OCCURS 6. - 01 WORK-AREA. - 05 SUB PICTURE 9(4) COMP SYNC. - 88 ODD-RECORD VALUE 1 3 5. - - - PROCEDURE DIVISION. - - PERFORM LOADFILE. - OPEN INPUT FLATFILE. - DISPLAY "Open Sts:" CUST-STAT - READ FLATFILE - DISPLAY "Read " CM-CUST-NUM " Sts:" CUST-STAT. - READ FLATFILE - DISPLAY "Read " CM-CUST-NUM " Sts:" CUST-STAT. - CLOSE FLATFILE. - - OPEN I-O FLATFILE. - READ FLATFILE - DISPLAY "Read " CM-CUST-NUM " Sts:" CUST-STAT. - ADD 1 TO CM-NO-TERMINALS - REWRITE TSPFL-RECORD - DISPLAY "REWRITE " CM-CUST-NUM " Sts " CUST-STAT - " Trms:" CM-NO-TERMINALS. - CLOSE FLATFILE. - - OPEN I-O FLATFILE. - READ FLATFILE - DISPLAY "Read " CM-CUST-NUM " Sts:" CUST-STAT. - ADD 1 TO CM-NO-TERMINALS - REWRITE TSPFL-RECORD - DISPLAY "REWRITE " CM-CUST-NUM " Sts " CUST-STAT - " Trms:" CM-NO-TERMINALS. - READ FLATFILE WITH LOCK - DISPLAY "Read " CM-CUST-NUM - * DELETE FLATFILE - * DISPLAY "DELETE " CM-CUST-NUM " Sts " CUST-STAT. - CLOSE FLATFILE. - OPEN INPUT FLATFILE. - DISPLAY "Re-list File Open Sts:" CUST-STAT - PERFORM UNTIL CUST-STAT NOT = "00" - PERFORM READ-RECORD - END-PERFORM. - CLOSE FLATFILE. - OPEN EXTEND FLATFILE. - MOVE 2 TO SUB - PERFORM LOAD-RECORD - CLOSE FLATFILE. - OPEN INPUT FLATFILE. - DISPLAY "List File afer EXTEND Open Sts:" CUST-STAT - PERFORM UNTIL CUST-STAT NOT = "00" - PERFORM READ-RECORD - END-PERFORM. - CLOSE FLATFILE. - STOP RUN RETURNING 0. - - READ-RECORD. - MOVE SPACES TO TSPFL-RECORD. - READ FLATFILE - IF CUST-STAT NOT = "00" - DISPLAY "Read Status: " CUST-STAT - ELSE - DISPLAY "Read " CM-CUST-NUM - " Trms:" CM-NO-TERMINALS - END-IF. - - LOADFILE. - DISPLAY "Loading sample data file.". - - OPEN OUTPUT FLATFILE. - - PERFORM LOAD-RECORD - VARYING SUB FROM 1 BY 1 - UNTIL SUB > MAX-SUB. - - DISPLAY "Sample data file load complete.". - CLOSE FLATFILE. - - LOAD-RECORD. - - MOVE SPACES TO TSPFL-RECORD. - MOVE DATA-CUST-NUM (SUB) TO CM-CUST-NUM. - MOVE DATA-COMPANY (SUB) TO CM-COMPANY. - MOVE DATA-NO-TERMINALS (SUB) TO CM-NO-TERMINALS. - MOVE 20070319 TO CM-PK-DATE. - IF SUB = 1 OR 4 OR 6 - MOVE -20070319 TO CM-PK-DATE. - - IF ODD-RECORD - MOVE "8417" TO CM-DISK - ELSE - MOVE "8470" TO CM-DISK. - WRITE TSPFL-RECORD. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_file.at:9846: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_file.at:9846" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_file.at:9846" -$at_failed && at_fn_log_failure -$at_traceon; } - - -{ set +x -$as_echo "$at_srcdir/run_file.at:9848: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_file.at:9848" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo "Loading sample data file. -Sample data file load complete. -Open Sts:00 -Read ALP00000 Sts:00 -Read BET00000 Sts:00 -Read ALP00000 Sts:00 -REWRITE ALP00000 Sts 00 Trms:0011 -Read ALP00000 Sts:00 -REWRITE ALP00000 Sts 00 Trms:0012 -Read BET00000 -Re-list File Open Sts:00 -Read ALP00000 Trms:0012 -Read BET00000 Trms:0013 -Read GAM00000 Trms:0075 -Read DEL00000 Trms:0010 -Read EPS00000 Trms:0090 -Read FOR00000 Trms:0254 -Read Status: 10 -List File afer EXTEND Open Sts:00 -Read ALP00000 Trms:0012 -Read BET00000 Trms:0013 -Read GAM00000 Trms:0075 -Read DEL00000 Trms:0010 -Read EPS00000 Trms:0090 -Read FOR00000 Trms:0254 -Read BET00000 Trms:0013 -Read Status: 10 -" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_file.at:9848" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_778 -#AT_START_779 -at_fn_group_banner 779 'run_file.at:9881' \ - "trace feature" " " 4 -at_xfail=no -( - $as_echo "779. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -# FIXME: this test should use line sequential or relative files, -# possibly add a second one for INDEXED! -$as_echo "run_file.at:9886" >"$at_check_line_file" -(test "$COB_HAS_ISAM" = "no") \ - && at_fn_check_skip 77 "$at_srcdir/run_file.at:9886" - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - - ENVIRONMENT DIVISION. - CONFIGURATION SECTION. - - INPUT-OUTPUT SECTION. - FILE-CONTROL. - SELECT TSPFILE - ASSIGN TO "testisam" - ORGANIZATION INDEXED ACCESS DYNAMIC - RECORD KEY IS CM-CUST-NUM - ALTERNATE RECORD KEY IS CM-TELEPHONE WITH DUPLICATES - ALTERNATE RECORD KEY IS CM-DISK WITH DUPLICATES - FILE STATUS IS CUST-STAT . - - SELECT TSTFILE - ASSIGN TO "testisam" - ORGANIZATION INDEXED ACCESS DYNAMIC - RECORD KEY IS TS-CUST-NUM - ALTERNATE RECORD KEY IS TS-TELEPHONE WITH DUPLICATES - ALTERNATE RECORD KEY IS TS-DISK WITH DUPLICATES - FILE STATUS IS CUST-STAT . - - DATA DIVISION. - FILE SECTION. - FD TSPFILE - BLOCK CONTAINS 5 RECORDS. - - 01 TSPFL-RECORD. - 05 TSPFL-REC. - 10 CM-CUST-NUM. - 15 CM-CUST-PRE PICTURE X(3). - 15 CM-CUST-NNN PICTURE X(5). - 10 CM-STATUS PICTURE X. - 10 CM-COMPANY PICTURE X(25). - 10 CM-ADDRESS-1 PICTURE X(25). - 10 CM-ADDRESS-2 PICTURE X(25). - 10 CM-ADDRESS-3 PICTURE X(25). - 10 CM-TELEPHONE PICTURE 9(10). - 10 CM-DP-MGR PICTURE X(25). - 10 CM-MACHINE PICTURE X(8). - 10 CM-MEMORY PICTURE X(4). - 10 CM-DISK PICTURE X(8). - 10 CM-TAPE PICTURE X(8). - 10 CM-NO-TERMINALS PICTURE 9(5). - - FD TSTFILE - BLOCK CONTAINS 5 RECORDS. - - 01 TSTFL-RECORD. - 05 TSTFL-REC. - 10 TS-CUST-NUM PICTURE X(8). - 10 TS-STATUS PICTURE X. - 10 TS-COMPANY PICTURE X(25). - 10 TS-ADDRESS-1 PICTURE X(25). - 10 TS-ADDRESS-2 PICTURE X(25). - 10 TS-ADDRESS-3 PICTURE X(25). - 10 TS-TELEPHONE PICTURE 9(10). - 10 TS-DP-MGR PICTURE X(25). - 10 TS-MACHINE PICTURE X(8). - 10 TS-MEMORY PICTURE X(4). - 10 TS-DISK PICTURE X(8). - 10 TS-TAPE PICTURE X(8). - - - WORKING-STORAGE SECTION. - - 01 CUST-STAT. - 05 STAT-1 PICTURE 9(4) COMP SYNC. - 05 FILLER REDEFINES STAT-1. - 10 STAT-X1 PIC X COMP-X. - 10 STAT-X2 PIC X COMP-X. - 77 BYTE-1 PICTURE 9(3). - 77 BYTE-2 PICTURE 9(3). - 77 MAX-SUB VALUE 16 PICTURE 9(5) COMP SYNC. - - 01 TEST-DATA. - - 02 DATA-CUST-NUM-TBL. - - 05 FILLER PIC X(8) VALUE "ALP00000". - 05 FILLER PIC X(8) VALUE "BET00000". - 05 FILLER PIC X(8) VALUE "GAM00000". - 05 FILLER PIC X(8) VALUE "DEL00000". - 05 FILLER PIC X(8) VALUE "EPS00000". - 05 FILLER PIC X(8) VALUE "FOR00000". - 05 FILLER PIC X(8) VALUE "GIB00000". - 05 FILLER PIC X(8) VALUE "H&J00000". - 05 FILLER PIC X(8) VALUE "INC00000". - 05 FILLER PIC X(8) VALUE "JOH00000". - 05 FILLER PIC X(8) VALUE "KON00000". - 05 FILLER PIC X(8) VALUE "LEW00000". - 05 FILLER PIC X(8) VALUE "MOR00000". - 05 FILLER PIC X(8) VALUE "NEW00000". - 05 FILLER PIC X(8) VALUE "OLD00000". - 05 FILLER PIC X(8) VALUE "PRE00000". - - 02 DATA-CUST-NUM REDEFINES DATA-CUST-NUM-TBL - PIC X(8) OCCURS 16. - 02 DATA-COMPANY-TBL. - - 05 FILLER PIC X(25) VALUE "ALPHA ELECTRICAL CO. LTD.". - 05 FILLER PIC X(25) VALUE "BETA SHOE MFG. INC. ". - 05 FILLER PIC X(25) VALUE "GAMMA X-RAY TECHNOLOGY ". - 05 FILLER PIC X(25) VALUE "DELTA LUGGAGE REPAIRS ". - 05 FILLER PIC X(25) VALUE "EPSILON EQUIPMENT SUPPLY ". - 05 FILLER PIC X(25) VALUE "FORTUNE COOKIE COMPANY ". - 05 FILLER PIC X(25) VALUE "GIBRALTER LIFE INSURANCE ". - 05 FILLER PIC X(25) VALUE "H & J PLUMBING SUPPLIES ". - 05 FILLER PIC X(25) VALUE "INCREMENTAL BACKUP CORP. ". - 05 FILLER PIC X(25) VALUE "JOHNSON BOATING SUPPLIES ". - 05 FILLER PIC X(25) VALUE "KONFLAB PLASTIC PRODUCTS.". - 05 FILLER PIC X(25) VALUE "LEWISTON GRAPHICS LTD. ". - 05 FILLER PIC X(25) VALUE "MORNINGSIDE CARPENTRY. ". - 05 FILLER PIC X(25) VALUE "NEW WAVE SURF SHOPS INC. ". - 05 FILLER PIC X(25) VALUE "OLD TYME PIZZA MFG. CO. ". - 05 FILLER PIC X(25) VALUE "PRESTIGE OFFICE FURNITURE". - - 02 DATA-COMPANY REDEFINES DATA-COMPANY-TBL - PIC X(25) OCCURS 16. - 02 DATA-ADDRESS-1-TBL. - - 05 FILLER PIC X(25) VALUE "123 MAIN STREET ". - 05 FILLER PIC X(25) VALUE "1090 2ND AVE. WEST ". - 05 FILLER PIC X(25) VALUE "1401 JEFFERSON BLVD. ". - 05 FILLER PIC X(25) VALUE "1620 ARIZONA WAY ". - 05 FILLER PIC X(25) VALUE "1184 EAST FIRST STREET ". - 05 FILLER PIC X(25) VALUE "114 JOHN F. KENNEDY AVE. ". - 05 FILLER PIC X(25) VALUE "650 LIBERTY CRESCENT ". - 05 FILLER PIC X(25) VALUE "77 SUNSET BLVD. ". - 05 FILLER PIC X(25) VALUE "10908 SANTA MONICA BLVD. ". - 05 FILLER PIC X(25) VALUE "1134 PARIS ROAD ". - 05 FILLER PIC X(25) VALUE "808 NORTHWEST MAIN ST. ". - 05 FILLER PIC X(25) VALUE "9904 QUEEN STREET ". - 05 FILLER PIC X(25) VALUE "1709 DUNDAS CRESCENT W. ". - 05 FILLER PIC X(25) VALUE "3240 MARIS AVENUE ". - 05 FILLER PIC X(25) VALUE "1705 WISCONSIN ROAD ". - 05 FILLER PIC X(25) VALUE "114A MAPLE GROVE ". - - 02 DATA-ADDRESS-1 REDEFINES DATA-ADDRESS-1-TBL - PIC X(25) OCCURS 16. - 02 DATA-ADDRESS-2-TBL. - - 05 FILLER PIC X(10) VALUE "NEW YORK ". - 05 FILLER PIC X(10) VALUE "ATLANTA ". - 05 FILLER PIC X(10) VALUE "WASHINGTON". - 05 FILLER PIC X(10) VALUE "TORONTO ". - 05 FILLER PIC X(10) VALUE "CALGARY ". - 05 FILLER PIC X(10) VALUE "SAN DIEGO ". - 05 FILLER PIC X(10) VALUE "LOS RIOS ". - 05 FILLER PIC X(10) VALUE "MADISON ". - 05 FILLER PIC X(10) VALUE "WILBUR ". - 05 FILLER PIC X(10) VALUE "TOPEKA ". - 05 FILLER PIC X(10) VALUE "SEATTLE ". - 05 FILLER PIC X(10) VALUE "NEW JERSEY". - 05 FILLER PIC X(10) VALUE "FORT WAYNE". - 05 FILLER PIC X(10) VALUE "COLUMBUS ". - 05 FILLER PIC X(10) VALUE "RICHMOND ". - 05 FILLER PIC X(10) VALUE "WHITEPLAIN". - - 02 DATA-ADDRESS-2 REDEFINES DATA-ADDRESS-2-TBL - PIC X(10) OCCURS 16. - 02 DATA-ADDRESS-3-TBL. - - 05 FILLER PIC X(10) VALUE "N.Y. ". - 05 FILLER PIC X(10) VALUE "GEORGIA ". - 05 FILLER PIC X(10) VALUE "D.C. ". - 05 FILLER PIC X(10) VALUE "CANADA ". - 05 FILLER PIC X(10) VALUE "CANADA ". - 05 FILLER PIC X(10) VALUE "CALIFORNIA". - 05 FILLER PIC X(10) VALUE "NEW MEXICO". - 05 FILLER PIC X(10) VALUE "WISCONSIN ". - 05 FILLER PIC X(10) VALUE "DELAWARE ". - 05 FILLER PIC X(10) VALUE "KANSAS ". - 05 FILLER PIC X(10) VALUE "WASHINGTON". - 05 FILLER PIC X(10) VALUE "N.J. ". - 05 FILLER PIC X(10) VALUE "COLORADO ". - 05 FILLER PIC X(10) VALUE "OHIO ". - 05 FILLER PIC X(10) VALUE "VIRGINIA ". - 05 FILLER PIC X(10) VALUE "N.Y. ". - - 02 DATA-ADDRESS-3 REDEFINES DATA-ADDRESS-3-TBL - PIC X(10) OCCURS 16. - 02 DATA-TELEPHONE-TBL. - - 05 FILLER PIC 9(10) VALUE 3131234432. - 05 FILLER PIC 9(10) VALUE 4082938498. - 05 FILLER PIC 9(10) VALUE 8372487274. - 05 FILLER PIC 9(10) VALUE 4169898509. - 05 FILLER PIC 9(10) VALUE 5292398745. - 05 FILLER PIC 9(10) VALUE 8009329492. - 05 FILLER PIC 9(10) VALUE 6456445643. - 05 FILLER PIC 9(10) VALUE 6546456333. - 05 FILLER PIC 9(10) VALUE 3455445444. - 05 FILLER PIC 9(10) VALUE 6456445643. - 05 FILLER PIC 9(10) VALUE 7456434355. - 05 FILLER PIC 9(10) VALUE 6554456433. - 05 FILLER PIC 9(10) VALUE 4169898509. - 05 FILLER PIC 9(10) VALUE 7534587453. - 05 FILLER PIC 9(10) VALUE 8787458374. - 05 FILLER PIC 9(10) VALUE 4169898509. - - 02 DATA-TELEPHONE REDEFINES DATA-TELEPHONE-TBL - PIC 9(10) OCCURS 16. - 02 DATA-DP-MGR-TBL. - - 05 FILLER PIC X(20) VALUE "MR. DAVE HARRIS ". - 05 FILLER PIC X(20) VALUE "MS. JANICE SILCOX ". - 05 FILLER PIC X(20) VALUE "MR. ALLAN JONES ". - 05 FILLER PIC X(20) VALUE "MR. PETER MACKAY ". - 05 FILLER PIC X(20) VALUE "MRS. DONNA BREWER ". - 05 FILLER PIC X(20) VALUE "MR. MICHAEL SMYTHE ". - 05 FILLER PIC X(20) VALUE "MR. D.A. MORRISON ". - 05 FILLER PIC X(20) VALUE "MR. BRIAN PATTERSON ". - 05 FILLER PIC X(20) VALUE "MR. DARRYL TOWNSEND ". - 05 FILLER PIC X(20) VALUE "MS. VALERIE HARPER ". - 05 FILLER PIC X(20) VALUE "MR. FRED MILLER ". - 05 FILLER PIC X(20) VALUE "MR. DONALD FISCHER ". - 05 FILLER PIC X(20) VALUE "MR. STEVEN YOURDIN ". - 05 FILLER PIC X(20) VALUE "MS. Goldie Hawn ". - 05 FILLER PIC X(20) VALUE "MS. ALICE WINSTON ". - 05 FILLER PIC X(20) VALUE "MR. THOMAS JEFFERSON". - - 02 DATA-DP-MGR REDEFINES DATA-DP-MGR-TBL - PIC X(20) OCCURS 16. - 02 DATA-MACHINE-TBL. - - 05 FILLER PIC X(8) VALUE "UNI-9030". - 05 FILLER PIC X(8) VALUE "UNI-9040". - 05 FILLER PIC X(8) VALUE "UNI-80/3". - 05 FILLER PIC X(8) VALUE "UNI-80/5". - 05 FILLER PIC X(8) VALUE "UNI-80/6". - 05 FILLER PIC X(8) VALUE "UNI-80/6". - 05 FILLER PIC X(8) VALUE "UNI-80/6". - 05 FILLER PIC X(8) VALUE "UNI-80/8". - 05 FILLER PIC X(8) VALUE "UNI-80/8". - 05 FILLER PIC X(8) VALUE "UNI-80/8". - 05 FILLER PIC X(8) VALUE "UNI-80/8". - 05 FILLER PIC X(8) VALUE "UNI-80/8". - 05 FILLER PIC X(8) VALUE "UNI-80/8". - 05 FILLER PIC X(8) VALUE "UNI-80/8". - 05 FILLER PIC X(8) VALUE "UNI-9040". - 05 FILLER PIC X(8) VALUE "UNI-9040". - - 02 DATA-MACHINE REDEFINES DATA-MACHINE-TBL - PIC X(8) OCCURS 16. - 02 DATA-NO-TERMINALS-TBL. - - 05 FILLER PIC 9(3) COMP-3 VALUE 85. - 05 FILLER PIC 9(3) COMP-3 VALUE 34. - 05 FILLER PIC 9(3) COMP-3 VALUE 75. - 05 FILLER PIC 9(3) COMP-3 VALUE 45. - 05 FILLER PIC 9(3) COMP-3 VALUE 90. - 05 FILLER PIC 9(3) COMP-3 VALUE 107. - 05 FILLER PIC 9(3) COMP-3 VALUE 67. - 05 FILLER PIC 9(3) COMP-3 VALUE 32. - 05 FILLER PIC 9(3) COMP-3 VALUE 16. - 05 FILLER PIC 9(3) COMP-3 VALUE 34. - 05 FILLER PIC 9(3) COMP-3 VALUE 128. - 05 FILLER PIC 9(3) COMP-3 VALUE 64. - 05 FILLER PIC 9(3) COMP-3 VALUE 110. - 05 FILLER PIC 9(3) COMP-3 VALUE 324. - 05 FILLER PIC 9(3) COMP-3 VALUE 124. - 05 FILLER PIC 9(3) COMP-3 VALUE 86. - - 02 DATA-NO-TERMINALS REDEFINES DATA-NO-TERMINALS-TBL - PIC 9(3) COMP-3 OCCURS 16. - - 01 WORK-AREA. - 05 REC-NUM PICTURE 9(6) VALUE 0. - 05 REC-MAX PICTURE 9(6) VALUE 10. - 05 SUB PICTURE 9(4) COMP SYNC. - 88 ODD-RECORD VALUE 1 3 5 7 9 10 11. - - 05 TSPFL-KEY PICTURE X(8). - - PROCEDURE DIVISION. - - MAINFILE. - OPEN OUTPUT TSPFILE - CLOSE TSPFILE. - - OPEN I-O TSPFILE - READ TSPFILE NEXT RECORD WITH NO LOCK - IF CUST-STAT NOT = "10" - DISPLAY "Error " CUST-STAT " on read of empty file" - UPON CONSOLE - STOP RUN - END-IF. - MOVE LOW-VALUES TO TSPFL-RECORD. - START TSPFILE KEY GREATER THAN CM-CUST-NUM - IF CUST-STAT NOT = "23" - DISPLAY "Error " CUST-STAT " starting empty file" - UPON CONSOLE - STOP RUN - END-IF. - READ TSPFILE NEXT RECORD WITH NO LOCK - IF CUST-STAT NOT = "46" - DISPLAY "Error " CUST-STAT " start/read of empty file" - UPON CONSOLE - STOP RUN - END-IF. - DISPLAY "OK: Operations on empty file" - CLOSE TSPFILE. - - PERFORM LOADFILE. - PERFORM LISTFILE. - OPEN INPUT TSTFILE - IF CUST-STAT NOT = "00" - DISPLAY "Expected ERROR " CUST-STAT - " opening TSTFILE, Record size different" - UPON CONSOLE - ELSE - DISPLAY "Un-Expected open TSTFILE, Record size different" - UPON CONSOLE - CLOSE TSTFILE - END-IF. - STOP RUN. - - LOADFILE. - DISPLAY "Loading sample data file." - UPON CONSOLE. - - OPEN OUTPUT TSPFILE - IF CUST-STAT NOT = "00" - DIVIDE STAT-1 BY 256 GIVING BYTE-1 REMAINDER BYTE-2 - DISPLAY "Error " CUST-STAT " " BYTE-1 " " BYTE-2 - " opening 'testisam' file" - UPON CONSOLE - STOP RUN - END-IF. - - PERFORM 1000-LOAD-RECORD - VARYING SUB FROM 1 BY 1 - UNTIL SUB > MAX-SUB. - - DISPLAY "Sample data file load complete." - UPON CONSOLE. - CLOSE TSPFILE. - - *---------------------------------------------------------------* - * LOAD A RECORD FROM DATA TABLES * - *---------------------------------------------------------------* - - 1000-LOAD-RECORD. - - MOVE SPACES TO TSPFL-RECORD. - MOVE DATA-CUST-NUM (SUB) TO CM-CUST-NUM. - MOVE CM-CUST-NUM TO TSPFL-KEY. - MOVE DATA-COMPANY (SUB) TO CM-COMPANY. - MOVE DATA-ADDRESS-1 (SUB) TO CM-ADDRESS-1. - MOVE DATA-ADDRESS-2 (SUB) TO CM-ADDRESS-2. - MOVE DATA-ADDRESS-3 (SUB) TO CM-ADDRESS-3. - MOVE DATA-TELEPHONE (SUB) TO CM-TELEPHONE. - MOVE DATA-DP-MGR (SUB) TO CM-DP-MGR. - MOVE DATA-MACHINE (SUB) TO CM-MACHINE. - MOVE DATA-NO-TERMINALS (SUB) TO CM-NO-TERMINALS. - - IF ODD-RECORD - MOVE "8417" TO CM-DISK - MOVE "1600 BPI" TO CM-TAPE - MOVE "1MEG" TO CM-MEMORY - ELSE - MOVE "8470" TO CM-DISK - MOVE "6250 BPI" TO CM-TAPE - MOVE "3MEG" TO CM-MEMORY. - - WRITE TSPFL-RECORD. - IF CUST-STAT NOT = "00" - AND CUST-STAT NOT = "02" - DISPLAY "Load - Key: " TSPFL-KEY ", Status: " CUST-STAT - UPON CONSOLE. - - LISTFILE. - DISPLAY "LIST SAMPLE FILE" UPON CONSOLE. - OPEN INPUT TSTFILE - MOVE SPACES TO TSTFL-RECORD. - MOVE "PRE00000" TO CM-CUST-NUM. - START TSTFILE KEY GREATER THAN OR EQUAL TO TS-CUST-NUM - READ TSTFILE NEXT RECORD - READ TSTFILE NEXT RECORD - CLOSE TSTFILE. - - MOVE ZERO TO REC-NUM - OPEN INPUT TSPFILE - IF CUST-STAT NOT = "00" - DISPLAY "ERROR " CUST-STAT " OPENING INPUT FILE" - UPON CONSOLE - IF CUST-STAT (1:1) = "9" - DISPLAY "Sub Error " STAT-X2 UPON CONSOLE - END-IF - STOP RUN - END-IF. - MOVE SPACES TO TSPFL-RECORD. - MOVE "PRE00000" TO CM-CUST-NUM. - START TSPFILE KEY GREATER THAN OR EQUAL TO CM-CUST-NUM - READ TSPFILE NEXT RECORD - READ TSPFILE NEXT RECORD - - MOVE SPACES TO TSPFL-RECORD. - MOVE "DEL00000" TO CM-CUST-NUM. - START TSPFILE KEY GREATER THAN CM-CUST-NUM - IF CUST-STAT NOT = "00" - DISPLAY "Error " CUST-STAT " starting file" - UPON CONSOLE - IF CUST-STAT (1:1) = "9" - DISPLAY "Sub Error " STAT-X2 UPON CONSOLE - END-IF - STOP RUN - END-IF. - READ TSPFILE NEXT RECORD WITH NO LOCK - IF CUST-STAT NOT = "00" - DISPLAY "Error " CUST-STAT " on 1st read of file" - UPON CONSOLE - IF CUST-STAT (1:1) = "9" - DISPLAY "Sub Error " STAT-X2 UPON CONSOLE - END-IF - STOP RUN - END-IF. - PERFORM UNTIL CUST-STAT NOT = "00" - OR REC-NUM > REC-MAX - DISPLAY "Key: " CM-CUST-NUM " is " CM-COMPANY - " Disk=" CM-DISK "." - UPON CONSOLE - READ TSPFILE NEXT RECORD - AT END - MOVE "99" TO CUST-STAT - END-READ - ADD 1 TO REC-NUM - END-PERFORM - IF CUST-STAT = "99" - DISPLAY "Hit End of File" UPON CONSOLE - END-IF. - - DISPLAY "LIST SAMPLE FILE DESCENDING" UPON CONSOLE. - MOVE ZERO TO REC-NUM - START TSPFILE KEY LESS THAN CM-CUST-NUM - IF CUST-STAT NOT = "00" - DISPLAY "Error " CUST-STAT " starting file" - UPON CONSOLE - STOP RUN - END-IF. - READ TSPFILE PREVIOUS RECORD WITH NO LOCK - IF CUST-STAT NOT = "00" - DISPLAY "Error " CUST-STAT " on 1st read of file" - UPON CONSOLE - STOP RUN - END-IF. - PERFORM UNTIL CUST-STAT NOT = "00" - OR REC-NUM > REC-MAX - DISPLAY "Key: " CM-CUST-NUM " is " CM-COMPANY - " Disk=" CM-DISK "." - UPON CONSOLE - READ TSPFILE PREVIOUS RECORD - AT END - MOVE "99" TO CUST-STAT - END-READ - ADD 1 TO REC-NUM - END-PERFORM. - - CLOSE TSPFILE. - - OPEN I-O TSPFILE. - MOVE SPACES TO TSPFL-RECORD. - MOVE DATA-CUST-NUM (2) TO CM-CUST-NUM. - MOVE 'X' TO CM-CUST-NUM (5:1). - READ TSPFILE KEY IS CM-CUST-NUM - IF CUST-STAT NOT = "23" - DISPLAY "Error " CUST-STAT " instead of 23." - UPON CONSOLE - END-IF. - MOVE DATA-CUST-NUM (2) TO CM-CUST-NUM. - MOVE DATA-COMPANY (2) TO CM-COMPANY. - READ TSPFILE KEY IS CM-CUST-NUM - IF CUST-STAT NOT = "00" - DISPLAY "Error " CUST-STAT " on primary read ." - UPON CONSOLE - ELSE - DISPLAY "Got: " CM-CUST-NUM " is " CM-COMPANY - " Disk=" CM-DISK "." - UPON CONSOLE - END-IF. - READ TSPFILE NEXT RECORD - IF CUST-STAT NOT = "00" - DISPLAY "Error " CUST-STAT " on next read" - UPON CONSOLE - ELSE - DISPLAY "Nxt: " CM-CUST-NUM " is " CM-COMPANY - " Disk=" CM-DISK "." - UPON CONSOLE - END-IF. - MOVE DATA-TELEPHONE (7) TO CM-TELEPHONE. - MOVE DATA-MACHINE (7) TO CM-MACHINE. - READ TSPFILE KEY IS CM-TELEPHONE - IF CUST-STAT NOT = "00" - DISPLAY "Error " CUST-STAT " instead of 23" - UPON CONSOLE - ELSE - DISPLAY "Ky2: " CM-CUST-NUM " is " CM-COMPANY - " Mach=" CM-MACHINE "." - UPON CONSOLE - END-IF. - WRITE TSPFL-RECORD - IF CUST-STAT NOT = "22" - DISPLAY "Error " CUST-STAT " instead of 22" - UPON CONSOLE - ELSE - DISPLAY " Write: " CM-CUST-NUM " got 22 as expected" - UPON CONSOLE - END-IF. - MOVE DATA-CUST-NUM (3) TO CM-CUST-NUM. - MOVE DATA-COMPANY (3) TO CM-COMPANY. - READ TSPFILE KEY IS CM-CUST-NUM - DISPLAY " Read: " CM-CUST-NUM " got " - CUST-STAT " as expected " - CM-NO-TERMINALS " terminals" - UPON CONSOLE. - ADD 5 TO CM-NO-TERMINALS - REWRITE TSPFL-RECORD - IF CUST-STAT NOT = "02" - AND CUST-STAT NOT = "00" - DISPLAY "Error " CUST-STAT " instead of 02" - UPON CONSOLE - ELSE - DISPLAY "ReWrite: " CM-CUST-NUM " got " - CUST-STAT " as expected " - CM-NO-TERMINALS " terminals" - UPON CONSOLE - END-IF. - MOVE DATA-CUST-NUM (2) TO CM-CUST-NUM. - MOVE DATA-COMPANY (2) TO CM-COMPANY. - READ TSPFILE KEY IS CM-CUST-NUM - DISPLAY " Read: " CM-CUST-NUM " got " - CUST-STAT " as expected " - CM-NO-TERMINALS " terminals" - UPON CONSOLE. - MOVE DATA-CUST-NUM (3) TO CM-CUST-NUM. - MOVE DATA-COMPANY (3) TO CM-COMPANY. - REWRITE TSPFL-RECORD - IF CUST-STAT NOT = "02" - AND CUST-STAT NOT = "00" - DISPLAY "Error " CUST-STAT " instead of 02" - UPON CONSOLE - ELSE - DISPLAY "ReWrite: " CM-CUST-NUM " got 00/02" - " as expected" - UPON CONSOLE - END-IF. - MOVE DATA-CUST-NUM (6) TO CM-CUST-NUM. - MOVE DATA-COMPANY (6) TO CM-COMPANY. - READ TSPFILE KEY IS CM-CUST-NUM - MOVE DATA-TELEPHONE (7) TO CM-TELEPHONE. - MOVE DATA-MACHINE (7) TO CM-MACHINE. - REWRITE TSPFL-RECORD - IF CUST-STAT NOT = "02" - AND CUST-STAT NOT = "00" - DISPLAY "Error " CUST-STAT " instead of 02" - UPON CONSOLE - ELSE - DISPLAY "ReWrite: " CM-CUST-NUM " got 00/02" - " as expected" - UPON CONSOLE - END-IF. - CLOSE TSPFILE. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_file.at:10456: \$COMPILE -ftraceall prog.cob " -at_fn_check_prepare_dynamic "$COMPILE -ftraceall prog.cob " "run_file.at:10456" -( $at_check_trace; $COMPILE -ftraceall prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_file.at:10456" -$at_failed && at_fn_log_failure -$at_traceon; } - - -{ set +x -$as_echo "$at_srcdir/run_file.at:10458: export COB_TRACE_FILE=trace.txt -export COB_TRACE_IO=Y -export COB_SET_TRACE=Y -export COB_TRACE_FORMAT=' Line: %L%S' -export IO_TSPFILE=trace -export IO_TSTFILE=no-trace -./prog" -at_fn_check_prepare_notrace 'an embedded newline' "run_file.at:10458" -( $at_check_trace; export COB_TRACE_FILE=trace.txt -export COB_TRACE_IO=Y -export COB_SET_TRACE=Y -export COB_TRACE_FORMAT=' Line: %L%S' -export IO_TSPFILE=trace -export IO_TSTFILE=no-trace -./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo "OK: Operations on empty file -Loading sample data file. -Sample data file load complete. -LIST SAMPLE FILE -Key: EPS00000 is EPSILON EQUIPMENT SUPPLY Disk=8417 . -Key: FOR00000 is FORTUNE COOKIE COMPANY Disk=8470 . -Key: GAM00000 is GAMMA X-RAY TECHNOLOGY Disk=8417 . -Key: GIB00000 is GIBRALTER LIFE INSURANCE Disk=8417 . -Key: H&J00000 is H & J PLUMBING SUPPLIES Disk=8470 . -Key: INC00000 is INCREMENTAL BACKUP CORP. Disk=8417 . -Key: JOH00000 is JOHNSON BOATING SUPPLIES Disk=8417 . -Key: KON00000 is KONFLAB PLASTIC PRODUCTS. Disk=8417 . -Key: LEW00000 is LEWISTON GRAPHICS LTD. Disk=8470 . -Key: MOR00000 is MORNINGSIDE CARPENTRY. Disk=8470 . -Key: NEW00000 is NEW WAVE SURF SHOPS INC. Disk=8470 . -LIST SAMPLE FILE DESCENDING -Key: NEW00000 is NEW WAVE SURF SHOPS INC. Disk=8470 . -Key: MOR00000 is MORNINGSIDE CARPENTRY. Disk=8470 . -Key: LEW00000 is LEWISTON GRAPHICS LTD. Disk=8470 . -Key: KON00000 is KONFLAB PLASTIC PRODUCTS. Disk=8417 . -Key: JOH00000 is JOHNSON BOATING SUPPLIES Disk=8417 . -Key: INC00000 is INCREMENTAL BACKUP CORP. Disk=8417 . -Key: H&J00000 is H & J PLUMBING SUPPLIES Disk=8470 . -Key: GIB00000 is GIBRALTER LIFE INSURANCE Disk=8417 . -Key: GAM00000 is GAMMA X-RAY TECHNOLOGY Disk=8417 . -Key: FOR00000 is FORTUNE COOKIE COMPANY Disk=8470 . -Key: EPS00000 is EPSILON EQUIPMENT SUPPLY Disk=8417 . -Got: BET00000 is BETA SHOE MFG. INC. Disk=8470 . -Nxt: DEL00000 is DELTA LUGGAGE REPAIRS Disk=8470 . -Ky2: GIB00000 is GIBRALTER LIFE INSURANCE Mach=UNI-80/6. - Write: GIB00000 got 22 as expected - Read: GAM00000 got 00 as expected 00075 terminals -ReWrite: GAM00000 got 00 as expected 00080 terminals - Read: BET00000 got 00 as expected 00034 terminals -ReWrite: GAM00000 got 00/02 as expected -ReWrite: FOR00000 got 00/02 as expected -Expected ERROR 39 opening TSTFILE, Record size different -" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_file.at:10458" -$at_failed && at_fn_log_failure -$at_traceon; } - - - - - -cat >reference <<'_ATEOF' -Source: 'prog.cob' -Program-Id: prog - Line: 279 Entry: prog - Line: 281Paragraph: MAINFILE - Line: 282 OPEN - OPEN OUTPUT TSPFILE -> 'testisam' Status: 00 - Line: 283 CLOSE - CLOSE TSPFILE Status: 00 - Line: 285 OPEN - OPEN I_O TSPFILE -> 'testisam' Status: 00 - Line: 286 READ - READ Sequential TSPFILE Status: 10 - Line: 287 IF - Line: 292 MOVE - Line: 293 START - START TSPFILE Status: 23 - Key : ALL LOW-VALUES - Line: 294 IF - Line: 299 READ - READ Sequential TSPFILE Status: 46 - Line: 300 IF - Line: 305 DISPLAY - Line: 306 CLOSE - CLOSE TSPFILE Status: 00 - Line: 308 PERFORM - Line: 322Paragraph: LOADFILE - Line: 323 DISPLAY - Line: 326 OPEN - OPEN OUTPUT TSPFILE -> 'testisam' Status: 00 - Line: 327 IF - Line: 335 PERFORM - Line: 347Paragraph: 1000-LOAD-RECORD - Line: 349 MOVE - Line: 350 MOVE - Line: 351 MOVE - Line: 352 MOVE - Line: 353 MOVE - Line: 354 MOVE - Line: 355 MOVE - Line: 356 MOVE - Line: 357 MOVE - Line: 358 MOVE - Line: 359 MOVE - Line: 361 IF - Line: 362 MOVE - Line: 363 MOVE - Line: 364 MOVE - Line: 370 WRITE - WRITE TSPFILE Status: 00 - Record : 'ALP00000 ALPHA ELECTRICAL CO. LTD.123 MAIN STREET NEW YORK ' - ' N.Y. 3131234432MR. DAVE HARRIS UNI-90301MEG8417' - ' 1600 BPI00085' - Line: 371 IF - Line: 347Paragraph: 1000-LOAD-RECORD - Line: 349 MOVE - Line: 350 MOVE - Line: 351 MOVE - Line: 352 MOVE - Line: 353 MOVE - Line: 354 MOVE - Line: 355 MOVE - Line: 356 MOVE - Line: 357 MOVE - Line: 358 MOVE - Line: 359 MOVE - Line: 361 IF - Line: 366 MOVE - Line: 367 MOVE - Line: 368 MOVE - Line: 370 WRITE - WRITE TSPFILE Status: 00 - Record : 'BET00000 BETA SHOE MFG. INC. 1090 2ND AVE. WEST ATLANTA ' - ' GEORGIA 4082938498MS. JANICE SILCOX UNI-90403MEG8470' - ' 6250 BPI00034' - Line: 371 IF - Line: 347Paragraph: 1000-LOAD-RECORD - Line: 349 MOVE - Line: 350 MOVE - Line: 351 MOVE - Line: 352 MOVE - Line: 353 MOVE - Line: 354 MOVE - Line: 355 MOVE - Line: 356 MOVE - Line: 357 MOVE - Line: 358 MOVE - Line: 359 MOVE - Line: 361 IF - Line: 362 MOVE - Line: 363 MOVE - Line: 364 MOVE - Line: 370 WRITE - WRITE TSPFILE Status: 02 - Record : 'GAM00000 GAMMA X-RAY TECHNOLOGY 1401 JEFFERSON BLVD. WASHINGTON ' - ' D.C. 8372487274MR. ALLAN JONES UNI-80/31MEG8417' - ' 1600 BPI00075' - Line: 371 IF - Line: 347Paragraph: 1000-LOAD-RECORD - Line: 349 MOVE - Line: 350 MOVE - Line: 351 MOVE - Line: 352 MOVE - Line: 353 MOVE - Line: 354 MOVE - Line: 355 MOVE - Line: 356 MOVE - Line: 357 MOVE - Line: 358 MOVE - Line: 359 MOVE - Line: 361 IF - Line: 366 MOVE - Line: 367 MOVE - Line: 368 MOVE - Line: 370 WRITE - WRITE TSPFILE Status: 02 - Record : 'DEL00000 DELTA LUGGAGE REPAIRS 1620 ARIZONA WAY TORONTO ' - ' CANADA 4169898509MR. PETER MACKAY UNI-80/53MEG8470' - ' 6250 BPI00045' - Line: 371 IF - Line: 347Paragraph: 1000-LOAD-RECORD - Line: 349 MOVE - Line: 350 MOVE - Line: 351 MOVE - Line: 352 MOVE - Line: 353 MOVE - Line: 354 MOVE - Line: 355 MOVE - Line: 356 MOVE - Line: 357 MOVE - Line: 358 MOVE - Line: 359 MOVE - Line: 361 IF - Line: 362 MOVE - Line: 363 MOVE - Line: 364 MOVE - Line: 370 WRITE - WRITE TSPFILE Status: 02 - Record : 'EPS00000 EPSILON EQUIPMENT SUPPLY 1184 EAST FIRST STREET CALGARY ' - ' CANADA 5292398745MRS. DONNA BREWER UNI-80/61MEG8417' - ' 1600 BPI00090' - Line: 371 IF - Line: 347Paragraph: 1000-LOAD-RECORD - Line: 349 MOVE - Line: 350 MOVE - Line: 351 MOVE - Line: 352 MOVE - Line: 353 MOVE - Line: 354 MOVE - Line: 355 MOVE - Line: 356 MOVE - Line: 357 MOVE - Line: 358 MOVE - Line: 359 MOVE - Line: 361 IF - Line: 366 MOVE - Line: 367 MOVE - Line: 368 MOVE - Line: 370 WRITE - WRITE TSPFILE Status: 02 - Record : 'FOR00000 FORTUNE COOKIE COMPANY 114 JOHN F. KENNEDY AVE. SAN DIEGO ' - ' CALIFORNIA 8009329492MR. MICHAEL SMYTHE UNI-80/63MEG8470' - ' 6250 BPI00107' - Line: 371 IF - Line: 347Paragraph: 1000-LOAD-RECORD - Line: 349 MOVE - Line: 350 MOVE - Line: 351 MOVE - Line: 352 MOVE - Line: 353 MOVE - Line: 354 MOVE - Line: 355 MOVE - Line: 356 MOVE - Line: 357 MOVE - Line: 358 MOVE - Line: 359 MOVE - Line: 361 IF - Line: 362 MOVE - Line: 363 MOVE - Line: 364 MOVE - Line: 370 WRITE - WRITE TSPFILE Status: 02 - Record : 'GIB00000 GIBRALTER LIFE INSURANCE 650 LIBERTY CRESCENT LOS RIOS ' - ' NEW MEXICO 6456445643MR. D.A. MORRISON UNI-80/61MEG8417' - ' 1600 BPI00067' - Line: 371 IF - Line: 347Paragraph: 1000-LOAD-RECORD - Line: 349 MOVE - Line: 350 MOVE - Line: 351 MOVE - Line: 352 MOVE - Line: 353 MOVE - Line: 354 MOVE - Line: 355 MOVE - Line: 356 MOVE - Line: 357 MOVE - Line: 358 MOVE - Line: 359 MOVE - Line: 361 IF - Line: 366 MOVE - Line: 367 MOVE - Line: 368 MOVE - Line: 370 WRITE - WRITE TSPFILE Status: 02 - Record : 'H&J00000 H & J PLUMBING SUPPLIES 77 SUNSET BLVD. MADISON ' - ' WISCONSIN 6546456333MR. BRIAN PATTERSON UNI-80/83MEG8470' - ' 6250 BPI00032' - Line: 371 IF - Line: 347Paragraph: 1000-LOAD-RECORD - Line: 349 MOVE - Line: 350 MOVE - Line: 351 MOVE - Line: 352 MOVE - Line: 353 MOVE - Line: 354 MOVE - Line: 355 MOVE - Line: 356 MOVE - Line: 357 MOVE - Line: 358 MOVE - Line: 359 MOVE - Line: 361 IF - Line: 362 MOVE - Line: 363 MOVE - Line: 364 MOVE - Line: 370 WRITE - WRITE TSPFILE Status: 02 - Record : 'INC00000 INCREMENTAL BACKUP CORP. 10908 SANTA MONICA BLVD. WILBUR ' - ' DELAWARE 3455445444MR. DARRYL TOWNSEND UNI-80/81MEG8417' - ' 1600 BPI00016' - Line: 371 IF - Line: 347Paragraph: 1000-LOAD-RECORD - Line: 349 MOVE - Line: 350 MOVE - Line: 351 MOVE - Line: 352 MOVE - Line: 353 MOVE - Line: 354 MOVE - Line: 355 MOVE - Line: 356 MOVE - Line: 357 MOVE - Line: 358 MOVE - Line: 359 MOVE - Line: 361 IF - Line: 362 MOVE - Line: 363 MOVE - Line: 364 MOVE - Line: 370 WRITE - WRITE TSPFILE Status: 02 - Record : 'JOH00000 JOHNSON BOATING SUPPLIES 1134 PARIS ROAD TOPEKA ' - ' KANSAS 6456445643MS. VALERIE HARPER UNI-80/81MEG8417' - ' 1600 BPI00034' - Line: 371 IF - Line: 347Paragraph: 1000-LOAD-RECORD - Line: 349 MOVE - Line: 350 MOVE - Line: 351 MOVE - Line: 352 MOVE - Line: 353 MOVE - Line: 354 MOVE - Line: 355 MOVE - Line: 356 MOVE - Line: 357 MOVE - Line: 358 MOVE - Line: 359 MOVE - Line: 361 IF - Line: 362 MOVE - Line: 363 MOVE - Line: 364 MOVE - Line: 370 WRITE - WRITE TSPFILE Status: 02 - Record : 'KON00000 KONFLAB PLASTIC PRODUCTS.808 NORTHWEST MAIN ST. SEATTLE ' - ' WASHINGTON 7456434355MR. FRED MILLER UNI-80/81MEG8417' - ' 1600 BPI00128' - Line: 371 IF - Line: 347Paragraph: 1000-LOAD-RECORD - Line: 349 MOVE - Line: 350 MOVE - Line: 351 MOVE - Line: 352 MOVE - Line: 353 MOVE - Line: 354 MOVE - Line: 355 MOVE - Line: 356 MOVE - Line: 357 MOVE - Line: 358 MOVE - Line: 359 MOVE - Line: 361 IF - Line: 366 MOVE - Line: 367 MOVE - Line: 368 MOVE - Line: 370 WRITE - WRITE TSPFILE Status: 02 - Record : 'LEW00000 LEWISTON GRAPHICS LTD. 9904 QUEEN STREET NEW JERSEY ' - ' N.J. 6554456433MR. DONALD FISCHER UNI-80/83MEG8470' - ' 6250 BPI00064' - Line: 371 IF - Line: 347Paragraph: 1000-LOAD-RECORD - Line: 349 MOVE - Line: 350 MOVE - Line: 351 MOVE - Line: 352 MOVE - Line: 353 MOVE - Line: 354 MOVE - Line: 355 MOVE - Line: 356 MOVE - Line: 357 MOVE - Line: 358 MOVE - Line: 359 MOVE - Line: 361 IF - Line: 366 MOVE - Line: 367 MOVE - Line: 368 MOVE - Line: 370 WRITE - WRITE TSPFILE Status: 02 - Record : 'MOR00000 MORNINGSIDE CARPENTRY. 1709 DUNDAS CRESCENT W. FORT WAYNE ' - ' COLORADO 4169898509MR. STEVEN YOURDIN UNI-80/83MEG8470' - ' 6250 BPI00110' - Line: 371 IF - Line: 347Paragraph: 1000-LOAD-RECORD - Line: 349 MOVE - Line: 350 MOVE - Line: 351 MOVE - Line: 352 MOVE - Line: 353 MOVE - Line: 354 MOVE - Line: 355 MOVE - Line: 356 MOVE - Line: 357 MOVE - Line: 358 MOVE - Line: 359 MOVE - Line: 361 IF - Line: 366 MOVE - Line: 367 MOVE - Line: 368 MOVE - Line: 370 WRITE - WRITE TSPFILE Status: 02 - Record : 'NEW00000 NEW WAVE SURF SHOPS INC. 3240 MARIS AVENUE COLUMBUS ' - ' OHIO 7534587453MS. Goldie Hawn UNI-80/83MEG8470' - ' 6250 BPI00324' - Line: 371 IF - Line: 347Paragraph: 1000-LOAD-RECORD - Line: 349 MOVE - Line: 350 MOVE - Line: 351 MOVE - Line: 352 MOVE - Line: 353 MOVE - Line: 354 MOVE - Line: 355 MOVE - Line: 356 MOVE - Line: 357 MOVE - Line: 358 MOVE - Line: 359 MOVE - Line: 361 IF - Line: 366 MOVE - Line: 367 MOVE - Line: 368 MOVE - Line: 370 WRITE - WRITE TSPFILE Status: 02 - Record : 'OLD00000 OLD TYME PIZZA MFG. CO. 1705 WISCONSIN ROAD RICHMOND ' - ' VIRGINIA 8787458374MS. ALICE WINSTON UNI-90403MEG8470' - ' 6250 BPI00124' - Line: 371 IF - Line: 347Paragraph: 1000-LOAD-RECORD - Line: 349 MOVE - Line: 350 MOVE - Line: 351 MOVE - Line: 352 MOVE - Line: 353 MOVE - Line: 354 MOVE - Line: 355 MOVE - Line: 356 MOVE - Line: 357 MOVE - Line: 358 MOVE - Line: 359 MOVE - Line: 361 IF - Line: 366 MOVE - Line: 367 MOVE - Line: 368 MOVE - Line: 370 WRITE - WRITE TSPFILE Status: 02 - Record : 'PRE00000 PRESTIGE OFFICE FURNITURE114A MAPLE GROVE WHITEPLAIN ' - ' N.Y. 4169898509MR. THOMAS JEFFERSON UNI-90403MEG8470' - ' 6250 BPI00086' - Line: 371 IF - Line: 339 DISPLAY - Line: 341 CLOSE - CLOSE TSPFILE Status: 00 - Line: 309 PERFORM - Line: 376Paragraph: LISTFILE - Line: 377 DISPLAY - Line: 378 OPEN - Line: 379 MOVE - Line: 380 MOVE - Line: 381 START - Line: 382 READ - Line: 383 READ - Line: 384 CLOSE - Line: 386 MOVE - Line: 387 OPEN - OPEN INPUT TSPFILE -> 'testisam' Status: 00 - Line: 388 IF - Line: 396 MOVE - Line: 397 MOVE - Line: 398 START - START TSPFILE Status: 00 - Key : 'PRE00000' - Line: 399 READ - READ Sequential TSPFILE Status: 00 - Record : 'PRE00000 PRESTIGE OFFICE FURNITURE114A MAPLE GROVE WHITEPLAIN ' - ' N.Y. 4169898509MR. THOMAS JEFFERSON UNI-90403MEG8470' - ' 6250 BPI00086' - Line: 400 READ - READ Sequential TSPFILE Status: 10 - Line: 402 MOVE - Line: 403 MOVE - Line: 404 START - START TSPFILE Status: 00 - Key : 'DEL00000' - Line: 405 IF - Line: 413 READ - READ Sequential TSPFILE Status: 00 - Record : 'EPS00000 EPSILON EQUIPMENT SUPPLY 1184 EAST FIRST STREET CALGARY ' - ' CANADA 5292398745MRS. DONNA BREWER UNI-80/61MEG8417' - ' 1600 BPI00090' - Line: 414 IF - Line: 422 PERFORM - Line: 424 DISPLAY - Line: 427 READ - READ Sequential TSPFILE Status: 00 - Record : 'FOR00000 FORTUNE COOKIE COMPANY 114 JOHN F. KENNEDY AVE. SAN DIEGO ' - ' CALIFORNIA 8009329492MR. MICHAEL SMYTHE UNI-80/63MEG8470' - ' 6250 BPI00107' - Line: 431 ADD - Line: 424 DISPLAY - Line: 427 READ - READ Sequential TSPFILE Status: 00 - Record : 'GAM00000 GAMMA X-RAY TECHNOLOGY 1401 JEFFERSON BLVD. WASHINGTON ' - ' D.C. 8372487274MR. ALLAN JONES UNI-80/31MEG8417' - ' 1600 BPI00075' - Line: 431 ADD - Line: 424 DISPLAY - Line: 427 READ - READ Sequential TSPFILE Status: 00 - Record : 'GIB00000 GIBRALTER LIFE INSURANCE 650 LIBERTY CRESCENT LOS RIOS ' - ' NEW MEXICO 6456445643MR. D.A. MORRISON UNI-80/61MEG8417' - ' 1600 BPI00067' - Line: 431 ADD - Line: 424 DISPLAY - Line: 427 READ - READ Sequential TSPFILE Status: 00 - Record : 'H&J00000 H & J PLUMBING SUPPLIES 77 SUNSET BLVD. MADISON ' - ' WISCONSIN 6546456333MR. BRIAN PATTERSON UNI-80/83MEG8470' - ' 6250 BPI00032' - Line: 431 ADD - Line: 424 DISPLAY - Line: 427 READ - READ Sequential TSPFILE Status: 00 - Record : 'INC00000 INCREMENTAL BACKUP CORP. 10908 SANTA MONICA BLVD. WILBUR ' - ' DELAWARE 3455445444MR. DARRYL TOWNSEND UNI-80/81MEG8417' - ' 1600 BPI00016' - Line: 431 ADD - Line: 424 DISPLAY - Line: 427 READ - READ Sequential TSPFILE Status: 00 - Record : 'JOH00000 JOHNSON BOATING SUPPLIES 1134 PARIS ROAD TOPEKA ' - ' KANSAS 6456445643MS. VALERIE HARPER UNI-80/81MEG8417' - ' 1600 BPI00034' - Line: 431 ADD - Line: 424 DISPLAY - Line: 427 READ - READ Sequential TSPFILE Status: 00 - Record : 'KON00000 KONFLAB PLASTIC PRODUCTS.808 NORTHWEST MAIN ST. SEATTLE ' - ' WASHINGTON 7456434355MR. FRED MILLER UNI-80/81MEG8417' - ' 1600 BPI00128' - Line: 431 ADD - Line: 424 DISPLAY - Line: 427 READ - READ Sequential TSPFILE Status: 00 - Record : 'LEW00000 LEWISTON GRAPHICS LTD. 9904 QUEEN STREET NEW JERSEY ' - ' N.J. 6554456433MR. DONALD FISCHER UNI-80/83MEG8470' - ' 6250 BPI00064' - Line: 431 ADD - Line: 424 DISPLAY - Line: 427 READ - READ Sequential TSPFILE Status: 00 - Record : 'MOR00000 MORNINGSIDE CARPENTRY. 1709 DUNDAS CRESCENT W. FORT WAYNE ' - ' COLORADO 4169898509MR. STEVEN YOURDIN UNI-80/83MEG8470' - ' 6250 BPI00110' - Line: 431 ADD - Line: 424 DISPLAY - Line: 427 READ - READ Sequential TSPFILE Status: 00 - Record : 'NEW00000 NEW WAVE SURF SHOPS INC. 3240 MARIS AVENUE COLUMBUS ' - ' OHIO 7534587453MS. Goldie Hawn UNI-80/83MEG8470' - ' 6250 BPI00324' - Line: 431 ADD - Line: 424 DISPLAY - Line: 427 READ - READ Sequential TSPFILE Status: 00 - Record : 'OLD00000 OLD TYME PIZZA MFG. CO. 1705 WISCONSIN ROAD RICHMOND ' - ' VIRGINIA 8787458374MS. ALICE WINSTON UNI-90403MEG8470' - ' 6250 BPI00124' - Line: 431 ADD - Line: 433 IF - Line: 437 DISPLAY - Line: 438 MOVE - Line: 439 START - START TSPFILE Status: 00 - Key : 'OLD00000' - Line: 440 IF - Line: 445 READ - READ Sequential TSPFILE Status: 00 - Record : 'NEW00000 NEW WAVE SURF SHOPS INC. 3240 MARIS AVENUE COLUMBUS ' - ' OHIO 7534587453MS. Goldie Hawn UNI-80/83MEG8470' - ' 6250 BPI00324' - Line: 446 IF - Line: 451 PERFORM - Line: 453 DISPLAY - Line: 456 READ - READ Sequential TSPFILE Status: 00 - Record : 'MOR00000 MORNINGSIDE CARPENTRY. 1709 DUNDAS CRESCENT W. FORT WAYNE ' - ' COLORADO 4169898509MR. STEVEN YOURDIN UNI-80/83MEG8470' - ' 6250 BPI00110' - Line: 460 ADD - Line: 453 DISPLAY - Line: 456 READ - READ Sequential TSPFILE Status: 00 - Record : 'LEW00000 LEWISTON GRAPHICS LTD. 9904 QUEEN STREET NEW JERSEY ' - ' N.J. 6554456433MR. DONALD FISCHER UNI-80/83MEG8470' - ' 6250 BPI00064' - Line: 460 ADD - Line: 453 DISPLAY - Line: 456 READ - READ Sequential TSPFILE Status: 00 - Record : 'KON00000 KONFLAB PLASTIC PRODUCTS.808 NORTHWEST MAIN ST. SEATTLE ' - ' WASHINGTON 7456434355MR. FRED MILLER UNI-80/81MEG8417' - ' 1600 BPI00128' - Line: 460 ADD - Line: 453 DISPLAY - Line: 456 READ - READ Sequential TSPFILE Status: 00 - Record : 'JOH00000 JOHNSON BOATING SUPPLIES 1134 PARIS ROAD TOPEKA ' - ' KANSAS 6456445643MS. VALERIE HARPER UNI-80/81MEG8417' - ' 1600 BPI00034' - Line: 460 ADD - Line: 453 DISPLAY - Line: 456 READ - READ Sequential TSPFILE Status: 00 - Record : 'INC00000 INCREMENTAL BACKUP CORP. 10908 SANTA MONICA BLVD. WILBUR ' - ' DELAWARE 3455445444MR. DARRYL TOWNSEND UNI-80/81MEG8417' - ' 1600 BPI00016' - Line: 460 ADD - Line: 453 DISPLAY - Line: 456 READ - READ Sequential TSPFILE Status: 00 - Record : 'H&J00000 H & J PLUMBING SUPPLIES 77 SUNSET BLVD. MADISON ' - ' WISCONSIN 6546456333MR. BRIAN PATTERSON UNI-80/83MEG8470' - ' 6250 BPI00032' - Line: 460 ADD - Line: 453 DISPLAY - Line: 456 READ - READ Sequential TSPFILE Status: 00 - Record : 'GIB00000 GIBRALTER LIFE INSURANCE 650 LIBERTY CRESCENT LOS RIOS ' - ' NEW MEXICO 6456445643MR. D.A. MORRISON UNI-80/61MEG8417' - ' 1600 BPI00067' - Line: 460 ADD - Line: 453 DISPLAY - Line: 456 READ - READ Sequential TSPFILE Status: 00 - Record : 'GAM00000 GAMMA X-RAY TECHNOLOGY 1401 JEFFERSON BLVD. WASHINGTON ' - ' D.C. 8372487274MR. ALLAN JONES UNI-80/31MEG8417' - ' 1600 BPI00075' - Line: 460 ADD - Line: 453 DISPLAY - Line: 456 READ - READ Sequential TSPFILE Status: 00 - Record : 'FOR00000 FORTUNE COOKIE COMPANY 114 JOHN F. KENNEDY AVE. SAN DIEGO ' - ' CALIFORNIA 8009329492MR. MICHAEL SMYTHE UNI-80/63MEG8470' - ' 6250 BPI00107' - Line: 460 ADD - Line: 453 DISPLAY - Line: 456 READ - READ Sequential TSPFILE Status: 00 - Record : 'EPS00000 EPSILON EQUIPMENT SUPPLY 1184 EAST FIRST STREET CALGARY ' - ' CANADA 5292398745MRS. DONNA BREWER UNI-80/61MEG8417' - ' 1600 BPI00090' - Line: 460 ADD - Line: 453 DISPLAY - Line: 456 READ - READ Sequential TSPFILE Status: 00 - Record : 'DEL00000 DELTA LUGGAGE REPAIRS 1620 ARIZONA WAY TORONTO ' - ' CANADA 4169898509MR. PETER MACKAY UNI-80/53MEG8470' - ' 6250 BPI00045' - Line: 460 ADD - Line: 463 CLOSE - CLOSE TSPFILE Status: 00 - Line: 465 OPEN - OPEN I_O TSPFILE -> 'testisam' Status: 00 - Line: 466 MOVE - Line: 467 MOVE - Line: 468 MOVE - Line: 469 READ - READ TSPFILE Status: 23 - Key : 'BET0X000' - Line: 470 IF - Line: 474 MOVE - Line: 475 MOVE - Line: 476 READ - READ TSPFILE Status: 00 - Record : 'BET00000 BETA SHOE MFG. INC. 1090 2ND AVE. WEST ATLANTA ' - ' GEORGIA 4082938498MS. JANICE SILCOX UNI-90403MEG8470' - ' 6250 BPI00034' - Key : 'BET00000' - Line: 477 IF - Line: 481 DISPLAY - Line: 485 READ - READ Sequential TSPFILE Status: 00 - Record : 'DEL00000 DELTA LUGGAGE REPAIRS 1620 ARIZONA WAY TORONTO ' - ' CANADA 4169898509MR. PETER MACKAY UNI-80/53MEG8470' - ' 6250 BPI00045' - Line: 486 IF - Line: 490 DISPLAY - Line: 494 MOVE - Line: 495 MOVE - Line: 496 READ - READ TSPFILE Status: 00 - Record : 'GIB00000 GIBRALTER LIFE INSURANCE 650 LIBERTY CRESCENT LOS RIOS ' - ' NEW MEXICO 6456445643MR. D.A. MORRISON UNI-80/61MEG8417' - ' 1600 BPI00067' - Key : 6456445643 - Line: 497 IF - Line: 501 DISPLAY - Line: 505 WRITE - WRITE TSPFILE Status: 22 - Record : 'GIB00000 GIBRALTER LIFE INSURANCE 650 LIBERTY CRESCENT LOS RIOS ' - ' NEW MEXICO 6456445643MR. D.A. MORRISON UNI-80/61MEG8417' - ' 1600 BPI00067' - Line: 506 IF - Line: 510 DISPLAY - Line: 513 MOVE - Line: 514 MOVE - Line: 515 READ - READ TSPFILE Status: 00 - Record : 'GAM00000 GAMMA X-RAY TECHNOLOGY 1401 JEFFERSON BLVD. WASHINGTON ' - ' D.C. 8372487274MR. ALLAN JONES UNI-80/31MEG8417' - ' 1600 BPI00075' - Key : 'GAM00000' - Line: 516 DISPLAY - Line: 520 ADD - Line: 521 REWRITE - REWRITE TSPFILE Status: 00 - Record : 'GAM00000 GAMMA X-RAY TECHNOLOGY 1401 JEFFERSON BLVD. WASHINGTON ' - ' D.C. 8372487274MR. ALLAN JONES UNI-80/31MEG8417' - ' 1600 BPI00080' - Line: 522 IF - Line: 527 DISPLAY - Line: 532 MOVE - Line: 533 MOVE - Line: 534 READ - READ TSPFILE Status: 00 - Record : 'BET00000 BETA SHOE MFG. INC. 1090 2ND AVE. WEST ATLANTA ' - ' GEORGIA 4082938498MS. JANICE SILCOX UNI-90403MEG8470' - ' 6250 BPI00034' - Key : 'BET00000' - Line: 535 DISPLAY - Line: 539 MOVE - Line: 540 MOVE - Line: 541 REWRITE - REWRITE TSPFILE Status: 02 - Record : 'GAM00000 GAMMA X-RAY TECHNOLOGY 1090 2ND AVE. WEST ATLANTA ' - ' GEORGIA 4082938498MS. JANICE SILCOX UNI-90403MEG8470' - ' 6250 BPI00034' - Line: 542 IF - Line: 547 DISPLAY - Line: 551 MOVE - Line: 552 MOVE - Line: 553 READ - READ TSPFILE Status: 00 - Record : 'FOR00000 FORTUNE COOKIE COMPANY 114 JOHN F. KENNEDY AVE. SAN DIEGO ' - ' CALIFORNIA 8009329492MR. MICHAEL SMYTHE UNI-80/63MEG8470' - ' 6250 BPI00107' - Key : 'FOR00000' - Line: 554 MOVE - Line: 555 MOVE - Line: 556 REWRITE - REWRITE TSPFILE Status: 02 - Record : 'FOR00000 FORTUNE COOKIE COMPANY 114 JOHN F. KENNEDY AVE. SAN DIEGO ' - ' CALIFORNIA 6456445643MR. MICHAEL SMYTHE UNI-80/63MEG8470' - ' 6250 BPI00107' - Line: 557 IF - Line: 562 DISPLAY - Line: 566 CLOSE - CLOSE TSPFILE Status: 00 - Line: 310 OPEN - Line: 311 IF - Line: 312 DISPLAY - Line: 320 STOP RUN -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_file.at:11204: gcdiff -I'WRITE TSPFILE Status' reference trace.txt" -at_fn_check_prepare_trace "run_file.at:11204" -( $at_check_trace; gcdiff -I'WRITE TSPFILE Status' reference trace.txt -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_file.at:11204" -$at_failed && at_fn_log_failure \ -"./trace.txt" -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_779 -#AT_START_780 -at_fn_group_banner 780 'run_file.at:11209' \ - "trace feature with subroutine" " " 4 -at_xfail=no -( - $as_echo "780. $at_setup_line: testing $at_desc ..." - $at_traceon - - -# FIXME: this test should use line sequential or relative files! -$as_echo "run_file.at:11212" >"$at_check_line_file" -(test "$COB_HAS_ISAM" = "no") \ - && at_fn_check_skip 77 "$at_srcdir/run_file.at:11212" - - -cat >callsub.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. callsub. - - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 NUM-A PIC 9(3) VALUE 399. - 01 NUM-B PIC 9(3) VALUE 211. - 01 RSLT PIC 9(5)V99. - - LINKAGE SECTION. - 01 n PIC 99. - - PROCEDURE DIVISION USING n. - MAIN-10. - ADD 1 TO n. - COMPUTE RSLT = ((NUM-A / (100.55 + -0.550)) - - (NUM-B / (10.11 * 10 - 1.1))) - * (220 / 2.2) * n. - END PROGRAM callsub. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_file.at:11237: \$COMPILE_MODULE -m -o callsub callsub.cob " -at_fn_check_prepare_dynamic "$COMPILE_MODULE -m -o callsub callsub.cob " "run_file.at:11237" -( $at_check_trace; $COMPILE_MODULE -m -o callsub callsub.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_file.at:11237" -$at_failed && at_fn_log_failure -$at_traceon; } - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - - ENVIRONMENT DIVISION. - CONFIGURATION SECTION. - - INPUT-OUTPUT SECTION. - FILE-CONTROL. - SELECT OPTIONAL TSPFILE - ASSIGN TO "testisam" - ORGANIZATION INDEXED ACCESS DYNAMIC - RECORD KEY IS CM-CUST-NUM - ALTERNATE RECORD KEY IS CM-TELEPHONE WITH DUPLICATES - ALTERNATE RECORD KEY IS CM-DISK WITH DUPLICATES - FILE STATUS IS CUST-STAT . - - SELECT TSTFILE - ASSIGN TO "testisam" - ORGANIZATION INDEXED ACCESS DYNAMIC - RECORD KEY IS TS-CUST-NUM - ALTERNATE RECORD KEY IS TS-TELEPHONE WITH DUPLICATES - ALTERNATE RECORD KEY IS TS-DISK WITH DUPLICATES - FILE STATUS IS CUST-STAT . - - SELECT FLATFILE - ASSIGN EXTERNAL RELFIX - ORGANIZATION RELATIVE - ACCESS IS RANDOM RELATIVE KEY IS REC-NUM - FILE STATUS IS CUST-STAT. - - DATA DIVISION. - FILE SECTION. - FD TSPFILE - BLOCK CONTAINS 5 RECORDS. - - 01 TSPFL-RECORD. - 05 TSPFL-REC. - 10 CM-CUST-NUM. - 15 CM-CUST-PRE PICTURE X(3). - 15 CM-CUST-NNN PICTURE X(5). - 10 CM-STATUS PICTURE X. - 10 CM-COMPANY PICTURE X(25). - 10 CM-ADDRESS-1 PICTURE X(25). - 10 CM-ADDRESS-2 PICTURE X(25). - 10 CM-ADDRESS-3 PICTURE X(25). - 10 CM-TELEPHONE PICTURE 9(10). - 10 CM-DP-MGR PICTURE X(25). - 10 CM-MACHINE PICTURE X(8). - 10 CM-MEMORY PICTURE X(4). - 10 CM-DISK PICTURE X(8). - 10 CM-TAPE PICTURE X(8). - 10 CM-NO-TERMINALS PICTURE 9(5). - - FD TSTFILE - BLOCK CONTAINS 5 RECORDS. - - 01 TSTFL-RECORD. - 05 TSTFL-REC. - 10 TS-CUST-NUM PICTURE X(8). - 10 TS-STATUS PICTURE X. - 10 TS-COMPANY PICTURE X(25). - 10 TS-ADDRESS-1 PICTURE X(25). - 10 TS-ADDRESS-2 PICTURE X(25). - 10 TS-ADDRESS-3 PICTURE X(25). - 10 TS-TELEPHONE PICTURE 9(10). - 10 TS-DP-MGR PICTURE X(25). - 10 TS-MACHINE PICTURE X(8). - 10 TS-MEMORY PICTURE X(4). - 10 TS-DISK PICTURE X(8). - 10 TS-TAPE PICTURE X(8). - - FD FLATFILE - BLOCK CONTAINS 5 RECORDS. - - 01 TSP2-RECORD. - 10 C2-CUST-NUM PICTURE X(8). - 10 C2-COMPANY PICTURE X(25). - 10 C2-DISK PICTURE X(8). - 10 C2-NO-TERMINALS PICTURE 9(4) COMP-4. - 10 C2-PK-DATE PICTURE S9(14) COMP-3. - - WORKING-STORAGE SECTION. - - 01 CUST-STAT. - 05 FILLER PICTURE XX. - 77 MAX-SUB VALUE 16 PICTURE 9(5) COMP SYNC. - 77 CALL-NUM VALUE 00 PICTURE 99. - - 01 TEST-DATA. - - 02 DATA-CUST-NUM-TBL. - - 05 FILLER PIC X(8) VALUE "ALP00000". - 05 FILLER PIC X(8) VALUE "BET00000". - 05 FILLER PIC X(8) VALUE "GAM00000". - 05 FILLER PIC X(8) VALUE "DEL00000". - 05 FILLER PIC X(8) VALUE "EPS00000". - 05 FILLER PIC X(8) VALUE "FOR00000". - 05 FILLER PIC X(8) VALUE "GIB00000". - 05 FILLER PIC X(8) VALUE "H&J00000". - 05 FILLER PIC X(8) VALUE "INC00000". - 05 FILLER PIC X(8) VALUE "JOH00000". - 05 FILLER PIC X(8) VALUE "KON00000". - 05 FILLER PIC X(8) VALUE "LEW00000". - 05 FILLER PIC X(8) VALUE "MOR00000". - 05 FILLER PIC X(8) VALUE "NEW00000". - 05 FILLER PIC X(8) VALUE "OLD00000". - 05 FILLER PIC X(8) VALUE "PRE00000". - - 02 DATA-CUST-NUM REDEFINES DATA-CUST-NUM-TBL - PIC X(8) OCCURS 16. - 02 DATA-COMPANY-TBL. - - 05 FILLER PIC X(25) VALUE "ALPHA ELECTRICAL CO. LTD.". - 05 FILLER PIC X(25) VALUE "BETA SHOE MFG. INC. ". - 05 FILLER PIC X(25) VALUE "GAMMA X-RAY TECHNOLOGY ". - 05 FILLER PIC X(25) VALUE "DELTA LUGGAGE REPAIRS ". - 05 FILLER PIC X(25) VALUE "EPSILON EQUIPMENT SUPPLY ". - 05 FILLER PIC X(25) VALUE "FORTUNE COOKIE COMPANY ". - 05 FILLER PIC X(25) VALUE "GIBRALTER LIFE INSURANCE ". - 05 FILLER PIC X(25) VALUE "H & J PLUMBING SUPPLIES ". - 05 FILLER PIC X(25) VALUE "INCREMENTAL BACKUP CORP. ". - 05 FILLER PIC X(25) VALUE "JOHNSON BOATING SUPPLIES ". - 05 FILLER PIC X(25) VALUE "KONFLAB PLASTIC PRODUCTS.". - 05 FILLER PIC X(25) VALUE "LEWISTON GRAPHICS LTD. ". - 05 FILLER PIC X(25) VALUE "MORNINGSIDE CARPENTRY. ". - 05 FILLER PIC X(25) VALUE "NEW WAVE SURF SHOPS INC. ". - 05 FILLER PIC X(25) VALUE "OLD TYME PIZZA MFG. CO. ". - 05 FILLER PIC X(25) VALUE "PRESTIGE OFFICE FURNITURE". - - 02 DATA-COMPANY REDEFINES DATA-COMPANY-TBL - PIC X(25) OCCURS 16. - 02 DATA-ADDRESS-1-TBL. - - 05 FILLER PIC X(25) VALUE "123 MAIN STREET ". - 05 FILLER PIC X(25) VALUE "1090 2ND AVE. WEST ". - 05 FILLER PIC X(25) VALUE "1401 JEFFERSON BLVD. ". - 05 FILLER PIC X(25) VALUE "1620 ARIZONA WAY ". - 05 FILLER PIC X(25) VALUE "1184 EAST FIRST STREET ". - 05 FILLER PIC X(25) VALUE "114 JOHN F. KENNEDY AVE. ". - 05 FILLER PIC X(25) VALUE "650 LIBERTY CRESCENT ". - 05 FILLER PIC X(25) VALUE "77 SUNSET BLVD. ". - 05 FILLER PIC X(25) VALUE "10908 SANTA MONICA BLVD. ". - 05 FILLER PIC X(25) VALUE "1134 PARIS ROAD ". - 05 FILLER PIC X(25) VALUE "808 NORTHWEST MAIN ST. ". - 05 FILLER PIC X(25) VALUE "9904 QUEEN STREET ". - 05 FILLER PIC X(25) VALUE "1709 DUNDAS CRESCENT W. ". - 05 FILLER PIC X(25) VALUE "3240 MARIS AVENUE ". - 05 FILLER PIC X(25) VALUE "1705 WISCONSIN ROAD ". - 05 FILLER PIC X(25) VALUE "114A MAPLE GROVE ". - - 02 DATA-ADDRESS-1 REDEFINES DATA-ADDRESS-1-TBL - PIC X(25) OCCURS 16. - 02 DATA-ADDRESS-2-TBL. - - 05 FILLER PIC X(10) VALUE "NEW YORK ". - 05 FILLER PIC X(10) VALUE "ATLANTA ". - 05 FILLER PIC X(10) VALUE "WASHINGTON". - 05 FILLER PIC X(10) VALUE "TORONTO ". - 05 FILLER PIC X(10) VALUE "CALGARY ". - 05 FILLER PIC X(10) VALUE "SAN DIEGO ". - 05 FILLER PIC X(10) VALUE "LOS RIOS ". - 05 FILLER PIC X(10) VALUE "MADISON ". - 05 FILLER PIC X(10) VALUE "WILBUR ". - 05 FILLER PIC X(10) VALUE "TOPEKA ". - 05 FILLER PIC X(10) VALUE "SEATTLE ". - 05 FILLER PIC X(10) VALUE "NEW JERSEY". - 05 FILLER PIC X(10) VALUE "FORT WAYNE". - 05 FILLER PIC X(10) VALUE "COLUMBUS ". - 05 FILLER PIC X(10) VALUE "RICHMOND ". - 05 FILLER PIC X(10) VALUE "WHITEPLAIN". - - 02 DATA-ADDRESS-2 REDEFINES DATA-ADDRESS-2-TBL - PIC X(10) OCCURS 16. - 02 DATA-ADDRESS-3-TBL. - - 05 FILLER PIC X(10) VALUE "N.Y. ". - 05 FILLER PIC X(10) VALUE "GEORGIA ". - 05 FILLER PIC X(10) VALUE "D.C. ". - 05 FILLER PIC X(10) VALUE "CANADA ". - 05 FILLER PIC X(10) VALUE "CANADA ". - 05 FILLER PIC X(10) VALUE "CALIFORNIA". - 05 FILLER PIC X(10) VALUE "NEW MEXICO". - 05 FILLER PIC X(10) VALUE "WISCONSIN ". - 05 FILLER PIC X(10) VALUE "DELAWARE ". - 05 FILLER PIC X(10) VALUE "KANSAS ". - 05 FILLER PIC X(10) VALUE "WASHINGTON". - 05 FILLER PIC X(10) VALUE "N.J. ". - 05 FILLER PIC X(10) VALUE "COLORADO ". - 05 FILLER PIC X(10) VALUE "OHIO ". - 05 FILLER PIC X(10) VALUE "VIRGINIA ". - 05 FILLER PIC X(10) VALUE "N.Y. ". - - 02 DATA-ADDRESS-3 REDEFINES DATA-ADDRESS-3-TBL - PIC X(10) OCCURS 16. - 02 DATA-TELEPHONE-TBL. - - 05 FILLER PIC 9(10) VALUE 3131234432. - 05 FILLER PIC 9(10) VALUE 4082938498. - 05 FILLER PIC 9(10) VALUE 8372487274. - 05 FILLER PIC 9(10) VALUE 4169898509. - 05 FILLER PIC 9(10) VALUE 5292398745. - 05 FILLER PIC 9(10) VALUE 8009329492. - 05 FILLER PIC 9(10) VALUE 6456445643. - 05 FILLER PIC 9(10) VALUE 6546456333. - 05 FILLER PIC 9(10) VALUE 3455445444. - 05 FILLER PIC 9(10) VALUE 6456445643. - 05 FILLER PIC 9(10) VALUE 7456434355. - 05 FILLER PIC 9(10) VALUE 6554456433. - 05 FILLER PIC 9(10) VALUE 4169898509. - 05 FILLER PIC 9(10) VALUE 7534587453. - 05 FILLER PIC 9(10) VALUE 8787458374. - 05 FILLER PIC 9(10) VALUE 4169898509. - - 02 DATA-TELEPHONE REDEFINES DATA-TELEPHONE-TBL - PIC 9(10) OCCURS 16. - 02 DATA-DP-MGR-TBL. - - 05 FILLER PIC X(20) VALUE "MR. DAVE HARRIS ". - 05 FILLER PIC X(20) VALUE "MS. JANICE SILCOX ". - 05 FILLER PIC X(20) VALUE "MR. ALLAN JONES ". - 05 FILLER PIC X(20) VALUE "MR. PETER MACKAY ". - 05 FILLER PIC X(20) VALUE "MRS. DONNA BREWER ". - 05 FILLER PIC X(20) VALUE "MR. MICHAEL SMYTHE ". - 05 FILLER PIC X(20) VALUE "MR. D.A. MORRISON ". - 05 FILLER PIC X(20) VALUE "MR. BRIAN PATTERSON ". - 05 FILLER PIC X(20) VALUE "MR. DARRYL TOWNSEND ". - 05 FILLER PIC X(20) VALUE "MS. VALERIE HARPER ". - 05 FILLER PIC X(20) VALUE "MR. FRED MILLER ". - 05 FILLER PIC X(20) VALUE "MR. DONALD FISCHER ". - 05 FILLER PIC X(20) VALUE "MR. STEVEN YOURDIN ". - 05 FILLER PIC X(20) VALUE "MS. Goldie Hawn ". - 05 FILLER PIC X(20) VALUE "MS. ALICE WINSTON ". - 05 FILLER PIC X(20) VALUE "MR. THOMAS JEFFERSON". - - 02 DATA-DP-MGR REDEFINES DATA-DP-MGR-TBL - PIC X(20) OCCURS 16. - 02 DATA-MACHINE-TBL. - - 05 FILLER PIC X(8) VALUE "UNI-9030". - 05 FILLER PIC X(8) VALUE "UNI-9040". - 05 FILLER PIC X(8) VALUE "UNI-80/3". - 05 FILLER PIC X(8) VALUE "UNI-80/5". - 05 FILLER PIC X(8) VALUE "UNI-80/6". - 05 FILLER PIC X(8) VALUE "UNI-80/6". - 05 FILLER PIC X(8) VALUE "UNI-80/6". - 05 FILLER PIC X(8) VALUE "UNI-80/8". - 05 FILLER PIC X(8) VALUE "UNI-80/8". - 05 FILLER PIC X(8) VALUE "UNI-80/8". - 05 FILLER PIC X(8) VALUE "UNI-80/8". - 05 FILLER PIC X(8) VALUE "UNI-80/8". - 05 FILLER PIC X(8) VALUE "UNI-80/8". - 05 FILLER PIC X(8) VALUE "UNI-80/8". - 05 FILLER PIC X(8) VALUE "UNI-9040". - 05 FILLER PIC X(8) VALUE "UNI-9040". - - 02 DATA-MACHINE REDEFINES DATA-MACHINE-TBL - PIC X(8) OCCURS 16. - 02 DATA-NO-TERMINALS-TBL. - - 05 FILLER PIC 9(3) COMP-3 VALUE 85. - 05 FILLER PIC 9(3) COMP-3 VALUE 34. - 05 FILLER PIC 9(3) COMP-3 VALUE 75. - 05 FILLER PIC 9(3) COMP-3 VALUE 45. - 05 FILLER PIC 9(3) COMP-3 VALUE 90. - 05 FILLER PIC 9(3) COMP-3 VALUE 107. - 05 FILLER PIC 9(3) COMP-3 VALUE 67. - 05 FILLER PIC 9(3) COMP-3 VALUE 32. - 05 FILLER PIC 9(3) COMP-3 VALUE 16. - 05 FILLER PIC 9(3) COMP-3 VALUE 34. - 05 FILLER PIC 9(3) COMP-3 VALUE 128. - 05 FILLER PIC 9(3) COMP-3 VALUE 64. - 05 FILLER PIC 9(3) COMP-3 VALUE 110. - 05 FILLER PIC 9(3) COMP-3 VALUE 324. - 05 FILLER PIC 9(3) COMP-3 VALUE 124. - 05 FILLER PIC 9(3) COMP-3 VALUE 86. - - 02 DATA-NO-TERMINALS REDEFINES DATA-NO-TERMINALS-TBL - PIC 9(3) COMP-3 OCCURS 16. - - 01 WORK-AREA. - 05 REC-NUM PICTURE 9(6) VALUE 0. - 05 REC-MAX PICTURE 9(6) VALUE 10. - 05 SUB PICTURE 9(4) COMP SYNC. - 88 ODD-RECORD VALUE 1 3 5 7 9 10 11. - - 05 TSPFL-KEY PICTURE X(8). - - PROCEDURE DIVISION. - - MAINFILE. - OPEN OUTPUT TSPFILE - CLOSE TSPFILE. - - OPEN I-O TSPFILE - MOVE '99' TO CUST-STAT - READ TSPFILE NEXT RECORD WITH NO LOCK - IF CUST-STAT NOT = "10" - DISPLAY "Error " CUST-STAT " on read of empty file" - UPON CONSOLE - STOP RUN - END-IF. - MOVE LOW-VALUES TO TSPFL-RECORD. - START TSPFILE KEY GREATER THAN CM-CUST-NUM - IF CUST-STAT NOT = "23" - DISPLAY "Error " CUST-STAT " starting empty file" - UPON CONSOLE - STOP RUN - END-IF. - READ TSPFILE NEXT RECORD WITH NO LOCK - IF CUST-STAT NOT = "46" - DISPLAY "Error " CUST-STAT " start/read of empty file" - UPON CONSOLE - STOP RUN - END-IF. - DISPLAY "OK: Operations on empty file" - CLOSE TSPFILE. - - PERFORM LOADFILE. - PERFORM LISTFILE. - OPEN INPUT TSTFILE - IF CUST-STAT NOT = "00" - DISPLAY "Expected ERROR " CUST-STAT - " opening TSTFILE, Record size different" - UPON CONSOLE - ELSE - DISPLAY "Un-Expected open TSTFILE, Record size different" - UPON CONSOLE - CLOSE TSTFILE - END-IF. - PERFORM LOADFLAT. - STOP RUN. - - LOADFILE. - DISPLAY "Loading sample data file." - UPON CONSOLE. - - OPEN OUTPUT TSPFILE - IF CUST-STAT NOT = "00" - DISPLAY "Error " CUST-STAT - " opening 'testisam' file" UPON CONSOLE - STOP RUN - END-IF. - - PERFORM 1000-LOAD-RECORD - VARYING SUB FROM 1 BY 1 - UNTIL SUB > MAX-SUB. - - DISPLAY "Sample data file load complete." - UPON CONSOLE. - CLOSE TSPFILE. - - *---------------------------------------------------------------* - * LOAD A RECORD FROM DATA TABLES * - *---------------------------------------------------------------* - - 1000-LOAD-RECORD. - - MOVE SPACES TO TSPFL-RECORD. - MOVE DATA-CUST-NUM (SUB) TO CM-CUST-NUM. - MOVE CM-CUST-NUM TO TSPFL-KEY. - MOVE DATA-COMPANY (SUB) TO CM-COMPANY. - MOVE DATA-ADDRESS-1 (SUB) TO CM-ADDRESS-1. - MOVE DATA-ADDRESS-2 (SUB) TO CM-ADDRESS-2. - MOVE DATA-ADDRESS-3 (SUB) TO CM-ADDRESS-3. - MOVE DATA-TELEPHONE (SUB) TO CM-TELEPHONE. - MOVE DATA-DP-MGR (SUB) TO CM-DP-MGR. - MOVE DATA-MACHINE (SUB) TO CM-MACHINE. - MOVE DATA-NO-TERMINALS (SUB) TO CM-NO-TERMINALS. - - IF ODD-RECORD - MOVE "8417" TO CM-DISK - MOVE "1600 BPI" TO CM-TAPE - MOVE "1MEG" TO CM-MEMORY - ELSE - MOVE "8470" TO CM-DISK - MOVE "6250 BPI" TO CM-TAPE - MOVE "3MEG" TO CM-MEMORY. - - WRITE TSPFL-RECORD. - IF CUST-STAT NOT = "00" - AND CUST-STAT NOT = "02" - DISPLAY "Load - Key: " TSPFL-KEY ", Status: " CUST-STAT - UPON CONSOLE. - - LISTFILE. - DISPLAY "LIST SAMPLE FILE" UPON CONSOLE. - OPEN INPUT TSTFILE - MOVE SPACES TO TSTFL-RECORD. - MOVE "PRE00000" TO CM-CUST-NUM. - START TSTFILE KEY GREATER THAN OR EQUAL TO TS-CUST-NUM - READ TSTFILE NEXT RECORD - READ TSTFILE NEXT RECORD - CLOSE TSTFILE. - - MOVE ZERO TO REC-NUM - OPEN INPUT TSPFILE - IF CUST-STAT NOT = "00" - DISPLAY "ERROR " CUST-STAT " OPENING INPUT FILE" - UPON CONSOLE - STOP RUN - END-IF. - MOVE SPACES TO TSPFL-RECORD. - MOVE "PRE00000" TO CM-CUST-NUM. - START TSPFILE KEY GREATER THAN OR EQUAL TO CM-CUST-NUM - READ TSPFILE NEXT RECORD - READ TSPFILE NEXT RECORD - - MOVE SPACES TO TSPFL-RECORD. - MOVE "DEL00000" TO CM-CUST-NUM. - START TSPFILE KEY GREATER THAN CM-CUST-NUM - IF CUST-STAT NOT = "00" - DISPLAY "Error " CUST-STAT " starting file" - UPON CONSOLE - STOP RUN - END-IF. - READ TSPFILE NEXT RECORD WITH NO LOCK - IF CUST-STAT NOT = "00" - DISPLAY "Error " CUST-STAT " on 1st read of file" - UPON CONSOLE - STOP RUN - END-IF. - PERFORM UNTIL CUST-STAT NOT = "00" - OR REC-NUM > REC-MAX - DISPLAY "Key: " CM-CUST-NUM " is " CM-COMPANY - " Disk=" CM-DISK "." - UPON CONSOLE - CALL "callsub" USING CALL-NUM - READ TSPFILE NEXT RECORD - AT END - MOVE "99" TO CUST-STAT - END-READ - ADD 1 TO REC-NUM - END-PERFORM - IF CUST-STAT = "99" - DISPLAY "Hit End of File: " CALL-NUM UPON CONSOLE - ELSE - DISPLAY "Stop read after: " CALL-NUM UPON CONSOLE - END-IF. - - DISPLAY "LIST SAMPLE FILE DESCENDING" UPON CONSOLE. - MOVE ZERO TO REC-NUM - START TSPFILE KEY LESS THAN CM-CUST-NUM - IF CUST-STAT NOT = "00" - DISPLAY "Error " CUST-STAT " starting file" - UPON CONSOLE - STOP RUN - END-IF. - READ TSPFILE PREVIOUS RECORD WITH NO LOCK - IF CUST-STAT NOT = "00" - DISPLAY "Error " CUST-STAT " on 1st read of file" - UPON CONSOLE - STOP RUN - END-IF. - PERFORM UNTIL CUST-STAT NOT = "00" - OR REC-NUM > REC-MAX - DISPLAY "Key: " CM-CUST-NUM " is " CM-COMPANY - " Disk=" CM-DISK "." - UPON CONSOLE - READ TSPFILE PREVIOUS RECORD - AT END - MOVE "99" TO CUST-STAT - END-READ - ADD 1 TO REC-NUM - END-PERFORM. - - CLOSE TSPFILE. - - OPEN I-O TSPFILE. - MOVE SPACES TO TSPFL-RECORD. - MOVE DATA-CUST-NUM (2) TO CM-CUST-NUM. - MOVE 'X' TO CM-CUST-NUM (5:1). - READ TSPFILE KEY IS CM-CUST-NUM - IF CUST-STAT NOT = "23" - DISPLAY "Error " CUST-STAT " instead of 23." - UPON CONSOLE - END-IF. - MOVE DATA-CUST-NUM (2) TO CM-CUST-NUM. - MOVE DATA-COMPANY (2) TO CM-COMPANY. - READ TSPFILE KEY IS CM-CUST-NUM - IF CUST-STAT NOT = "00" - DISPLAY "Error " CUST-STAT " on primary read ." - UPON CONSOLE - ELSE - DISPLAY "Got: " CM-CUST-NUM " is " CM-COMPANY - " Disk=" CM-DISK "." - UPON CONSOLE - END-IF. - READ TSPFILE NEXT RECORD - IF CUST-STAT NOT = "00" - DISPLAY "Error " CUST-STAT " on next read" - UPON CONSOLE - ELSE - DISPLAY "Nxt: " CM-CUST-NUM " is " CM-COMPANY - " Disk=" CM-DISK "." - UPON CONSOLE - END-IF. - MOVE DATA-TELEPHONE (7) TO CM-TELEPHONE. - MOVE DATA-MACHINE (7) TO CM-MACHINE. - READ TSPFILE KEY IS CM-TELEPHONE - IF CUST-STAT NOT = "00" - DISPLAY "Error " CUST-STAT " instead of 23" - UPON CONSOLE - ELSE - DISPLAY "Ky2: " CM-CUST-NUM " is " CM-COMPANY - " Mach=" CM-MACHINE "." - UPON CONSOLE - END-IF. - WRITE TSPFL-RECORD - IF CUST-STAT NOT = "22" - DISPLAY "Error " CUST-STAT " instead of 22" - UPON CONSOLE - ELSE - DISPLAY " Write: " CM-CUST-NUM " got 22 as expected" - UPON CONSOLE - END-IF. - MOVE DATA-CUST-NUM (3) TO CM-CUST-NUM. - MOVE DATA-COMPANY (3) TO CM-COMPANY. - READ TSPFILE KEY IS CM-CUST-NUM - DISPLAY " Read: " CM-CUST-NUM " got " - CUST-STAT " as expected " - CM-NO-TERMINALS " terminals" - UPON CONSOLE. - ADD 5 TO CM-NO-TERMINALS - REWRITE TSPFL-RECORD - IF CUST-STAT NOT = "00" - DISPLAY "Error " CUST-STAT - " instead of 00" - UPON CONSOLE - ELSE - DISPLAY "ReWrite: " CM-CUST-NUM " got " - CUST-STAT " as expected " - CM-NO-TERMINALS " terminals" - UPON CONSOLE - END-IF. - MOVE DATA-CUST-NUM (2) TO CM-CUST-NUM. - MOVE DATA-COMPANY (2) TO CM-COMPANY. - READ TSPFILE KEY IS CM-CUST-NUM - DISPLAY " Read: " CM-CUST-NUM " got " - CUST-STAT " as expected " - CM-NO-TERMINALS " terminals" - UPON CONSOLE. - MOVE DATA-CUST-NUM (3) TO CM-CUST-NUM. - MOVE DATA-COMPANY (3) TO CM-COMPANY. - REWRITE TSPFL-RECORD - IF CUST-STAT NOT = "02" - AND CUST-STAT NOT = "00" - DISPLAY "Error " CUST-STAT " instead of 00/02" - UPON CONSOLE - ELSE - DISPLAY "ReWrite: " CM-CUST-NUM " got " - "00/02 as expected" - UPON CONSOLE - END-IF. - MOVE DATA-CUST-NUM (6) TO CM-CUST-NUM. - MOVE DATA-COMPANY (6) TO CM-COMPANY. - READ TSPFILE KEY IS CM-CUST-NUM - MOVE DATA-TELEPHONE (7) TO CM-TELEPHONE. - MOVE DATA-MACHINE (7) TO CM-MACHINE. - REWRITE TSPFL-RECORD - IF CUST-STAT NOT = "02" - AND CUST-STAT NOT = "00" - DISPLAY "Error " CUST-STAT " instead of 00/02" - UPON CONSOLE - ELSE - DISPLAY "ReWrite: " CM-CUST-NUM " got " - "00/02 as expected" - UPON CONSOLE - END-IF. - DELETE TSPFILE. - CLOSE TSPFILE. - - LOADFLAT. - OPEN OUTPUT FLATFILE. - PERFORM FLAT-RECORD - VARYING SUB FROM 1 BY 1 - UNTIL SUB > MAX-SUB - OR SUB > 5. - CLOSE FLATFILE. - OPEN INPUT FLATFILE. - MOVE 3 TO REC-NUM - READ FLATFILE - MOVE 999 TO REC-NUM - READ FLATFILE - CLOSE FLATFILE. - - FLAT-RECORD. - - MOVE SPACES TO TSP2-RECORD. - MOVE SUB TO REC-NUM. - MOVE DATA-CUST-NUM (SUB) TO C2-CUST-NUM. - MOVE DATA-COMPANY (SUB) TO C2-COMPANY. - MOVE DATA-NO-TERMINALS (SUB) TO C2-NO-TERMINALS. - MOVE 20070319 TO C2-PK-DATE. - IF ODD-RECORD - MOVE "8417" TO C2-DISK - ELSE - MOVE "8470" TO C2-DISK. - WRITE TSP2-RECORD. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_file.at:11842: \$COMPILE -ftraceall prog.cob " -at_fn_check_prepare_dynamic "$COMPILE -ftraceall prog.cob " "run_file.at:11842" -( $at_check_trace; $COMPILE -ftraceall prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_file.at:11842" -$at_failed && at_fn_log_failure -$at_traceon; } - - -{ set +x -$as_echo "$at_srcdir/run_file.at:11844: COB_TRACE_FILE=trace.txt \\ -COB_TRACE_IO=Y \\ -COB_SET_TRACE=Y \\ -COB_TRACE_FORMAT=' Line: %L %S' \\ -IO_TSPFILE=trace \\ -IO_TSTFILE=no-trace \\ -./prog" -at_fn_check_prepare_notrace 'an embedded newline' "run_file.at:11844" -( $at_check_trace; COB_TRACE_FILE=trace.txt \ -COB_TRACE_IO=Y \ -COB_SET_TRACE=Y \ -COB_TRACE_FORMAT=' Line: %L %S' \ -IO_TSPFILE=trace \ -IO_TSTFILE=no-trace \ -./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo "OK: Operations on empty file -Loading sample data file. -Sample data file load complete. -LIST SAMPLE FILE -Key: EPS00000 is EPSILON EQUIPMENT SUPPLY Disk=8417 . -Key: FOR00000 is FORTUNE COOKIE COMPANY Disk=8470 . -Key: GAM00000 is GAMMA X-RAY TECHNOLOGY Disk=8417 . -Key: GIB00000 is GIBRALTER LIFE INSURANCE Disk=8417 . -Key: H&J00000 is H & J PLUMBING SUPPLIES Disk=8470 . -Key: INC00000 is INCREMENTAL BACKUP CORP. Disk=8417 . -Key: JOH00000 is JOHNSON BOATING SUPPLIES Disk=8417 . -Key: KON00000 is KONFLAB PLASTIC PRODUCTS. Disk=8417 . -Key: LEW00000 is LEWISTON GRAPHICS LTD. Disk=8470 . -Key: MOR00000 is MORNINGSIDE CARPENTRY. Disk=8470 . -Key: NEW00000 is NEW WAVE SURF SHOPS INC. Disk=8470 . -Stop read after: 11 -LIST SAMPLE FILE DESCENDING -Key: NEW00000 is NEW WAVE SURF SHOPS INC. Disk=8470 . -Key: MOR00000 is MORNINGSIDE CARPENTRY. Disk=8470 . -Key: LEW00000 is LEWISTON GRAPHICS LTD. Disk=8470 . -Key: KON00000 is KONFLAB PLASTIC PRODUCTS. Disk=8417 . -Key: JOH00000 is JOHNSON BOATING SUPPLIES Disk=8417 . -Key: INC00000 is INCREMENTAL BACKUP CORP. Disk=8417 . -Key: H&J00000 is H & J PLUMBING SUPPLIES Disk=8470 . -Key: GIB00000 is GIBRALTER LIFE INSURANCE Disk=8417 . -Key: GAM00000 is GAMMA X-RAY TECHNOLOGY Disk=8417 . -Key: FOR00000 is FORTUNE COOKIE COMPANY Disk=8470 . -Key: EPS00000 is EPSILON EQUIPMENT SUPPLY Disk=8417 . -Got: BET00000 is BETA SHOE MFG. INC. Disk=8470 . -Nxt: DEL00000 is DELTA LUGGAGE REPAIRS Disk=8470 . -Ky2: GIB00000 is GIBRALTER LIFE INSURANCE Mach=UNI-80/6. - Write: GIB00000 got 22 as expected - Read: GAM00000 got 00 as expected 00075 terminals -ReWrite: GAM00000 got 00 as expected 00080 terminals - Read: BET00000 got 00 as expected 00034 terminals -ReWrite: GAM00000 got 00/02 as expected -ReWrite: FOR00000 got 00/02 as expected -Expected ERROR 39 opening TSTFILE, Record size different -" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_file.at:11844" -$at_failed && at_fn_log_failure -$at_traceon; } - - - - - -cat >reference <<'_ATEOF' -Source: 'prog.cob' -Program-Id: prog - Line: 290 Entry: prog - Line: 292 Paragraph: MAINFILE - Line: 293 OPEN - OPEN OUTPUT TSPFILE -> 'testisam' Status: 00 - Line: 294 CLOSE - CLOSE TSPFILE Status: 00 - Line: 296 OPEN - OPEN I_O TSPFILE -> 'testisam' Status: 00 - Line: 297 MOVE - Line: 298 READ - READ Sequential TSPFILE Status: 10 - Line: 299 IF - Line: 304 MOVE - Line: 305 START - START TSPFILE Status: 23 - Key : ALL LOW-VALUES - Line: 306 IF - Line: 311 READ - READ Sequential TSPFILE Status: 46 - Line: 312 IF - Line: 317 DISPLAY - Line: 318 CLOSE - CLOSE TSPFILE Status: 00 - Line: 320 PERFORM - Line: 335 Paragraph: LOADFILE - Line: 336 DISPLAY - Line: 339 OPEN - OPEN OUTPUT TSPFILE -> 'testisam' Status: 00 - Line: 340 IF - Line: 346 PERFORM - Line: 358 Paragraph: 1000-LOAD-RECORD - Line: 360 MOVE - Line: 361 MOVE - Line: 362 MOVE - Line: 363 MOVE - Line: 364 MOVE - Line: 365 MOVE - Line: 366 MOVE - Line: 367 MOVE - Line: 368 MOVE - Line: 369 MOVE - Line: 370 MOVE - Line: 372 IF - Line: 373 MOVE - Line: 374 MOVE - Line: 375 MOVE - Line: 381 WRITE - WRITE TSPFILE Status: 00 - Record : 'ALP00000 ALPHA ELECTRICAL CO. LTD.123 MAIN STREET NEW YORK ' - ' N.Y. 3131234432MR. DAVE HARRIS UNI-90301MEG8417' - ' 1600 BPI00085' - Line: 382 IF - Line: 358 Paragraph: 1000-LOAD-RECORD - Line: 360 MOVE - Line: 361 MOVE - Line: 362 MOVE - Line: 363 MOVE - Line: 364 MOVE - Line: 365 MOVE - Line: 366 MOVE - Line: 367 MOVE - Line: 368 MOVE - Line: 369 MOVE - Line: 370 MOVE - Line: 372 IF - Line: 377 MOVE - Line: 378 MOVE - Line: 379 MOVE - Line: 381 WRITE - WRITE TSPFILE Status: 00 - Record : 'BET00000 BETA SHOE MFG. INC. 1090 2ND AVE. WEST ATLANTA ' - ' GEORGIA 4082938498MS. JANICE SILCOX UNI-90403MEG8470' - ' 6250 BPI00034' - Line: 382 IF - Line: 358 Paragraph: 1000-LOAD-RECORD - Line: 360 MOVE - Line: 361 MOVE - Line: 362 MOVE - Line: 363 MOVE - Line: 364 MOVE - Line: 365 MOVE - Line: 366 MOVE - Line: 367 MOVE - Line: 368 MOVE - Line: 369 MOVE - Line: 370 MOVE - Line: 372 IF - Line: 373 MOVE - Line: 374 MOVE - Line: 375 MOVE - Line: 381 WRITE - WRITE TSPFILE Status: 02 - Record : 'GAM00000 GAMMA X-RAY TECHNOLOGY 1401 JEFFERSON BLVD. WASHINGTON ' - ' D.C. 8372487274MR. ALLAN JONES UNI-80/31MEG8417' - ' 1600 BPI00075' - Line: 382 IF - Line: 358 Paragraph: 1000-LOAD-RECORD - Line: 360 MOVE - Line: 361 MOVE - Line: 362 MOVE - Line: 363 MOVE - Line: 364 MOVE - Line: 365 MOVE - Line: 366 MOVE - Line: 367 MOVE - Line: 368 MOVE - Line: 369 MOVE - Line: 370 MOVE - Line: 372 IF - Line: 377 MOVE - Line: 378 MOVE - Line: 379 MOVE - Line: 381 WRITE - WRITE TSPFILE Status: 02 - Record : 'DEL00000 DELTA LUGGAGE REPAIRS 1620 ARIZONA WAY TORONTO ' - ' CANADA 4169898509MR. PETER MACKAY UNI-80/53MEG8470' - ' 6250 BPI00045' - Line: 382 IF - Line: 358 Paragraph: 1000-LOAD-RECORD - Line: 360 MOVE - Line: 361 MOVE - Line: 362 MOVE - Line: 363 MOVE - Line: 364 MOVE - Line: 365 MOVE - Line: 366 MOVE - Line: 367 MOVE - Line: 368 MOVE - Line: 369 MOVE - Line: 370 MOVE - Line: 372 IF - Line: 373 MOVE - Line: 374 MOVE - Line: 375 MOVE - Line: 381 WRITE - WRITE TSPFILE Status: 02 - Record : 'EPS00000 EPSILON EQUIPMENT SUPPLY 1184 EAST FIRST STREET CALGARY ' - ' CANADA 5292398745MRS. DONNA BREWER UNI-80/61MEG8417' - ' 1600 BPI00090' - Line: 382 IF - Line: 358 Paragraph: 1000-LOAD-RECORD - Line: 360 MOVE - Line: 361 MOVE - Line: 362 MOVE - Line: 363 MOVE - Line: 364 MOVE - Line: 365 MOVE - Line: 366 MOVE - Line: 367 MOVE - Line: 368 MOVE - Line: 369 MOVE - Line: 370 MOVE - Line: 372 IF - Line: 377 MOVE - Line: 378 MOVE - Line: 379 MOVE - Line: 381 WRITE - WRITE TSPFILE Status: 02 - Record : 'FOR00000 FORTUNE COOKIE COMPANY 114 JOHN F. KENNEDY AVE. SAN DIEGO ' - ' CALIFORNIA 8009329492MR. MICHAEL SMYTHE UNI-80/63MEG8470' - ' 6250 BPI00107' - Line: 382 IF - Line: 358 Paragraph: 1000-LOAD-RECORD - Line: 360 MOVE - Line: 361 MOVE - Line: 362 MOVE - Line: 363 MOVE - Line: 364 MOVE - Line: 365 MOVE - Line: 366 MOVE - Line: 367 MOVE - Line: 368 MOVE - Line: 369 MOVE - Line: 370 MOVE - Line: 372 IF - Line: 373 MOVE - Line: 374 MOVE - Line: 375 MOVE - Line: 381 WRITE - WRITE TSPFILE Status: 02 - Record : 'GIB00000 GIBRALTER LIFE INSURANCE 650 LIBERTY CRESCENT LOS RIOS ' - ' NEW MEXICO 6456445643MR. D.A. MORRISON UNI-80/61MEG8417' - ' 1600 BPI00067' - Line: 382 IF - Line: 358 Paragraph: 1000-LOAD-RECORD - Line: 360 MOVE - Line: 361 MOVE - Line: 362 MOVE - Line: 363 MOVE - Line: 364 MOVE - Line: 365 MOVE - Line: 366 MOVE - Line: 367 MOVE - Line: 368 MOVE - Line: 369 MOVE - Line: 370 MOVE - Line: 372 IF - Line: 377 MOVE - Line: 378 MOVE - Line: 379 MOVE - Line: 381 WRITE - WRITE TSPFILE Status: 02 - Record : 'H&J00000 H & J PLUMBING SUPPLIES 77 SUNSET BLVD. MADISON ' - ' WISCONSIN 6546456333MR. BRIAN PATTERSON UNI-80/83MEG8470' - ' 6250 BPI00032' - Line: 382 IF - Line: 358 Paragraph: 1000-LOAD-RECORD - Line: 360 MOVE - Line: 361 MOVE - Line: 362 MOVE - Line: 363 MOVE - Line: 364 MOVE - Line: 365 MOVE - Line: 366 MOVE - Line: 367 MOVE - Line: 368 MOVE - Line: 369 MOVE - Line: 370 MOVE - Line: 372 IF - Line: 373 MOVE - Line: 374 MOVE - Line: 375 MOVE - Line: 381 WRITE - WRITE TSPFILE Status: 02 - Record : 'INC00000 INCREMENTAL BACKUP CORP. 10908 SANTA MONICA BLVD. WILBUR ' - ' DELAWARE 3455445444MR. DARRYL TOWNSEND UNI-80/81MEG8417' - ' 1600 BPI00016' - Line: 382 IF - Line: 358 Paragraph: 1000-LOAD-RECORD - Line: 360 MOVE - Line: 361 MOVE - Line: 362 MOVE - Line: 363 MOVE - Line: 364 MOVE - Line: 365 MOVE - Line: 366 MOVE - Line: 367 MOVE - Line: 368 MOVE - Line: 369 MOVE - Line: 370 MOVE - Line: 372 IF - Line: 373 MOVE - Line: 374 MOVE - Line: 375 MOVE - Line: 381 WRITE - WRITE TSPFILE Status: 02 - Record : 'JOH00000 JOHNSON BOATING SUPPLIES 1134 PARIS ROAD TOPEKA ' - ' KANSAS 6456445643MS. VALERIE HARPER UNI-80/81MEG8417' - ' 1600 BPI00034' - Line: 382 IF - Line: 358 Paragraph: 1000-LOAD-RECORD - Line: 360 MOVE - Line: 361 MOVE - Line: 362 MOVE - Line: 363 MOVE - Line: 364 MOVE - Line: 365 MOVE - Line: 366 MOVE - Line: 367 MOVE - Line: 368 MOVE - Line: 369 MOVE - Line: 370 MOVE - Line: 372 IF - Line: 373 MOVE - Line: 374 MOVE - Line: 375 MOVE - Line: 381 WRITE - WRITE TSPFILE Status: 02 - Record : 'KON00000 KONFLAB PLASTIC PRODUCTS.808 NORTHWEST MAIN ST. SEATTLE ' - ' WASHINGTON 7456434355MR. FRED MILLER UNI-80/81MEG8417' - ' 1600 BPI00128' - Line: 382 IF - Line: 358 Paragraph: 1000-LOAD-RECORD - Line: 360 MOVE - Line: 361 MOVE - Line: 362 MOVE - Line: 363 MOVE - Line: 364 MOVE - Line: 365 MOVE - Line: 366 MOVE - Line: 367 MOVE - Line: 368 MOVE - Line: 369 MOVE - Line: 370 MOVE - Line: 372 IF - Line: 377 MOVE - Line: 378 MOVE - Line: 379 MOVE - Line: 381 WRITE - WRITE TSPFILE Status: 02 - Record : 'LEW00000 LEWISTON GRAPHICS LTD. 9904 QUEEN STREET NEW JERSEY ' - ' N.J. 6554456433MR. DONALD FISCHER UNI-80/83MEG8470' - ' 6250 BPI00064' - Line: 382 IF - Line: 358 Paragraph: 1000-LOAD-RECORD - Line: 360 MOVE - Line: 361 MOVE - Line: 362 MOVE - Line: 363 MOVE - Line: 364 MOVE - Line: 365 MOVE - Line: 366 MOVE - Line: 367 MOVE - Line: 368 MOVE - Line: 369 MOVE - Line: 370 MOVE - Line: 372 IF - Line: 377 MOVE - Line: 378 MOVE - Line: 379 MOVE - Line: 381 WRITE - WRITE TSPFILE Status: 02 - Record : 'MOR00000 MORNINGSIDE CARPENTRY. 1709 DUNDAS CRESCENT W. FORT WAYNE ' - ' COLORADO 4169898509MR. STEVEN YOURDIN UNI-80/83MEG8470' - ' 6250 BPI00110' - Line: 382 IF - Line: 358 Paragraph: 1000-LOAD-RECORD - Line: 360 MOVE - Line: 361 MOVE - Line: 362 MOVE - Line: 363 MOVE - Line: 364 MOVE - Line: 365 MOVE - Line: 366 MOVE - Line: 367 MOVE - Line: 368 MOVE - Line: 369 MOVE - Line: 370 MOVE - Line: 372 IF - Line: 377 MOVE - Line: 378 MOVE - Line: 379 MOVE - Line: 381 WRITE - WRITE TSPFILE Status: 02 - Record : 'NEW00000 NEW WAVE SURF SHOPS INC. 3240 MARIS AVENUE COLUMBUS ' - ' OHIO 7534587453MS. Goldie Hawn UNI-80/83MEG8470' - ' 6250 BPI00324' - Line: 382 IF - Line: 358 Paragraph: 1000-LOAD-RECORD - Line: 360 MOVE - Line: 361 MOVE - Line: 362 MOVE - Line: 363 MOVE - Line: 364 MOVE - Line: 365 MOVE - Line: 366 MOVE - Line: 367 MOVE - Line: 368 MOVE - Line: 369 MOVE - Line: 370 MOVE - Line: 372 IF - Line: 377 MOVE - Line: 378 MOVE - Line: 379 MOVE - Line: 381 WRITE - WRITE TSPFILE Status: 02 - Record : 'OLD00000 OLD TYME PIZZA MFG. CO. 1705 WISCONSIN ROAD RICHMOND ' - ' VIRGINIA 8787458374MS. ALICE WINSTON UNI-90403MEG8470' - ' 6250 BPI00124' - Line: 382 IF - Line: 358 Paragraph: 1000-LOAD-RECORD - Line: 360 MOVE - Line: 361 MOVE - Line: 362 MOVE - Line: 363 MOVE - Line: 364 MOVE - Line: 365 MOVE - Line: 366 MOVE - Line: 367 MOVE - Line: 368 MOVE - Line: 369 MOVE - Line: 370 MOVE - Line: 372 IF - Line: 377 MOVE - Line: 378 MOVE - Line: 379 MOVE - Line: 381 WRITE - WRITE TSPFILE Status: 02 - Record : 'PRE00000 PRESTIGE OFFICE FURNITURE114A MAPLE GROVE WHITEPLAIN ' - ' N.Y. 4169898509MR. THOMAS JEFFERSON UNI-90403MEG8470' - ' 6250 BPI00086' - Line: 382 IF - Line: 350 DISPLAY - Line: 352 CLOSE - CLOSE TSPFILE Status: 00 - Line: 321 PERFORM - Line: 387 Paragraph: LISTFILE - Line: 388 DISPLAY - Line: 389 OPEN - Line: 390 MOVE - Line: 391 MOVE - Line: 392 START - Line: 393 READ - Line: 394 READ - Line: 395 CLOSE - Line: 397 MOVE - Line: 398 OPEN - OPEN INPUT TSPFILE -> 'testisam' Status: 00 - Line: 399 IF - Line: 404 MOVE - Line: 405 MOVE - Line: 406 START - START TSPFILE Status: 00 - Key : 'PRE00000' - Line: 407 READ - READ Sequential TSPFILE Status: 00 - Record : 'PRE00000 PRESTIGE OFFICE FURNITURE114A MAPLE GROVE WHITEPLAIN ' - ' N.Y. 4169898509MR. THOMAS JEFFERSON UNI-90403MEG8470' - ' 6250 BPI00086' - Line: 408 READ - READ Sequential TSPFILE Status: 10 - Line: 410 MOVE - Line: 411 MOVE - Line: 412 START - START TSPFILE Status: 00 - Key : 'DEL00000' - Line: 413 IF - Line: 418 READ - READ Sequential TSPFILE Status: 00 - Record : 'EPS00000 EPSILON EQUIPMENT SUPPLY 1184 EAST FIRST STREET CALGARY ' - ' CANADA 5292398745MRS. DONNA BREWER UNI-80/61MEG8417' - ' 1600 BPI00090' - Line: 419 IF - Line: 424 PERFORM - Line: 426 DISPLAY - Line: 429 CALL - Line: 430 READ - READ Sequential TSPFILE Status: 00 - Record : 'FOR00000 FORTUNE COOKIE COMPANY 114 JOHN F. KENNEDY AVE. SAN DIEGO ' - ' CALIFORNIA 8009329492MR. MICHAEL SMYTHE UNI-80/63MEG8470' - ' 6250 BPI00107' - Line: 434 ADD - Line: 426 DISPLAY - Line: 429 CALL - Line: 430 READ - READ Sequential TSPFILE Status: 00 - Record : 'GAM00000 GAMMA X-RAY TECHNOLOGY 1401 JEFFERSON BLVD. WASHINGTON ' - ' D.C. 8372487274MR. ALLAN JONES UNI-80/31MEG8417' - ' 1600 BPI00075' - Line: 434 ADD - Line: 426 DISPLAY - Line: 429 CALL - Line: 430 READ - READ Sequential TSPFILE Status: 00 - Record : 'GIB00000 GIBRALTER LIFE INSURANCE 650 LIBERTY CRESCENT LOS RIOS ' - ' NEW MEXICO 6456445643MR. D.A. MORRISON UNI-80/61MEG8417' - ' 1600 BPI00067' - Line: 434 ADD - Line: 426 DISPLAY - Line: 429 CALL - Line: 430 READ - READ Sequential TSPFILE Status: 00 - Record : 'H&J00000 H & J PLUMBING SUPPLIES 77 SUNSET BLVD. MADISON ' - ' WISCONSIN 6546456333MR. BRIAN PATTERSON UNI-80/83MEG8470' - ' 6250 BPI00032' - Line: 434 ADD - Line: 426 DISPLAY - Line: 429 CALL - Line: 430 READ - READ Sequential TSPFILE Status: 00 - Record : 'INC00000 INCREMENTAL BACKUP CORP. 10908 SANTA MONICA BLVD. WILBUR ' - ' DELAWARE 3455445444MR. DARRYL TOWNSEND UNI-80/81MEG8417' - ' 1600 BPI00016' - Line: 434 ADD - Line: 426 DISPLAY - Line: 429 CALL - Line: 430 READ - READ Sequential TSPFILE Status: 00 - Record : 'JOH00000 JOHNSON BOATING SUPPLIES 1134 PARIS ROAD TOPEKA ' - ' KANSAS 6456445643MS. VALERIE HARPER UNI-80/81MEG8417' - ' 1600 BPI00034' - Line: 434 ADD - Line: 426 DISPLAY - Line: 429 CALL - Line: 430 READ - READ Sequential TSPFILE Status: 00 - Record : 'KON00000 KONFLAB PLASTIC PRODUCTS.808 NORTHWEST MAIN ST. SEATTLE ' - ' WASHINGTON 7456434355MR. FRED MILLER UNI-80/81MEG8417' - ' 1600 BPI00128' - Line: 434 ADD - Line: 426 DISPLAY - Line: 429 CALL - Line: 430 READ - READ Sequential TSPFILE Status: 00 - Record : 'LEW00000 LEWISTON GRAPHICS LTD. 9904 QUEEN STREET NEW JERSEY ' - ' N.J. 6554456433MR. DONALD FISCHER UNI-80/83MEG8470' - ' 6250 BPI00064' - Line: 434 ADD - Line: 426 DISPLAY - Line: 429 CALL - Line: 430 READ - READ Sequential TSPFILE Status: 00 - Record : 'MOR00000 MORNINGSIDE CARPENTRY. 1709 DUNDAS CRESCENT W. FORT WAYNE ' - ' COLORADO 4169898509MR. STEVEN YOURDIN UNI-80/83MEG8470' - ' 6250 BPI00110' - Line: 434 ADD - Line: 426 DISPLAY - Line: 429 CALL - Line: 430 READ - READ Sequential TSPFILE Status: 00 - Record : 'NEW00000 NEW WAVE SURF SHOPS INC. 3240 MARIS AVENUE COLUMBUS ' - ' OHIO 7534587453MS. Goldie Hawn UNI-80/83MEG8470' - ' 6250 BPI00324' - Line: 434 ADD - Line: 426 DISPLAY - Line: 429 CALL - Line: 430 READ - READ Sequential TSPFILE Status: 00 - Record : 'OLD00000 OLD TYME PIZZA MFG. CO. 1705 WISCONSIN ROAD RICHMOND ' - ' VIRGINIA 8787458374MS. ALICE WINSTON UNI-90403MEG8470' - ' 6250 BPI00124' - Line: 434 ADD - Line: 436 IF - Line: 439 DISPLAY - Line: 442 DISPLAY - Line: 443 MOVE - Line: 444 START - START TSPFILE Status: 00 - Key : 'OLD00000' - Line: 445 IF - Line: 450 READ - READ Sequential TSPFILE Status: 00 - Record : 'NEW00000 NEW WAVE SURF SHOPS INC. 3240 MARIS AVENUE COLUMBUS ' - ' OHIO 7534587453MS. Goldie Hawn UNI-80/83MEG8470' - ' 6250 BPI00324' - Line: 451 IF - Line: 456 PERFORM - Line: 458 DISPLAY - Line: 461 READ - READ Sequential TSPFILE Status: 00 - Record : 'MOR00000 MORNINGSIDE CARPENTRY. 1709 DUNDAS CRESCENT W. FORT WAYNE ' - ' COLORADO 4169898509MR. STEVEN YOURDIN UNI-80/83MEG8470' - ' 6250 BPI00110' - Line: 465 ADD - Line: 458 DISPLAY - Line: 461 READ - READ Sequential TSPFILE Status: 00 - Record : 'LEW00000 LEWISTON GRAPHICS LTD. 9904 QUEEN STREET NEW JERSEY ' - ' N.J. 6554456433MR. DONALD FISCHER UNI-80/83MEG8470' - ' 6250 BPI00064' - Line: 465 ADD - Line: 458 DISPLAY - Line: 461 READ - READ Sequential TSPFILE Status: 00 - Record : 'KON00000 KONFLAB PLASTIC PRODUCTS.808 NORTHWEST MAIN ST. SEATTLE ' - ' WASHINGTON 7456434355MR. FRED MILLER UNI-80/81MEG8417' - ' 1600 BPI00128' - Line: 465 ADD - Line: 458 DISPLAY - Line: 461 READ - READ Sequential TSPFILE Status: 00 - Record : 'JOH00000 JOHNSON BOATING SUPPLIES 1134 PARIS ROAD TOPEKA ' - ' KANSAS 6456445643MS. VALERIE HARPER UNI-80/81MEG8417' - ' 1600 BPI00034' - Line: 465 ADD - Line: 458 DISPLAY - Line: 461 READ - READ Sequential TSPFILE Status: 00 - Record : 'INC00000 INCREMENTAL BACKUP CORP. 10908 SANTA MONICA BLVD. WILBUR ' - ' DELAWARE 3455445444MR. DARRYL TOWNSEND UNI-80/81MEG8417' - ' 1600 BPI00016' - Line: 465 ADD - Line: 458 DISPLAY - Line: 461 READ - READ Sequential TSPFILE Status: 00 - Record : 'H&J00000 H & J PLUMBING SUPPLIES 77 SUNSET BLVD. MADISON ' - ' WISCONSIN 6546456333MR. BRIAN PATTERSON UNI-80/83MEG8470' - ' 6250 BPI00032' - Line: 465 ADD - Line: 458 DISPLAY - Line: 461 READ - READ Sequential TSPFILE Status: 00 - Record : 'GIB00000 GIBRALTER LIFE INSURANCE 650 LIBERTY CRESCENT LOS RIOS ' - ' NEW MEXICO 6456445643MR. D.A. MORRISON UNI-80/61MEG8417' - ' 1600 BPI00067' - Line: 465 ADD - Line: 458 DISPLAY - Line: 461 READ - READ Sequential TSPFILE Status: 00 - Record : 'GAM00000 GAMMA X-RAY TECHNOLOGY 1401 JEFFERSON BLVD. WASHINGTON ' - ' D.C. 8372487274MR. ALLAN JONES UNI-80/31MEG8417' - ' 1600 BPI00075' - Line: 465 ADD - Line: 458 DISPLAY - Line: 461 READ - READ Sequential TSPFILE Status: 00 - Record : 'FOR00000 FORTUNE COOKIE COMPANY 114 JOHN F. KENNEDY AVE. SAN DIEGO ' - ' CALIFORNIA 8009329492MR. MICHAEL SMYTHE UNI-80/63MEG8470' - ' 6250 BPI00107' - Line: 465 ADD - Line: 458 DISPLAY - Line: 461 READ - READ Sequential TSPFILE Status: 00 - Record : 'EPS00000 EPSILON EQUIPMENT SUPPLY 1184 EAST FIRST STREET CALGARY ' - ' CANADA 5292398745MRS. DONNA BREWER UNI-80/61MEG8417' - ' 1600 BPI00090' - Line: 465 ADD - Line: 458 DISPLAY - Line: 461 READ - READ Sequential TSPFILE Status: 00 - Record : 'DEL00000 DELTA LUGGAGE REPAIRS 1620 ARIZONA WAY TORONTO ' - ' CANADA 4169898509MR. PETER MACKAY UNI-80/53MEG8470' - ' 6250 BPI00045' - Line: 465 ADD - Line: 468 CLOSE - CLOSE TSPFILE Status: 00 - Line: 470 OPEN - OPEN I_O TSPFILE -> 'testisam' Status: 00 - Line: 471 MOVE - Line: 472 MOVE - Line: 473 MOVE - Line: 474 READ - READ TSPFILE Status: 23 - Key : 'BET0X000' - Line: 475 IF - Line: 479 MOVE - Line: 480 MOVE - Line: 481 READ - READ TSPFILE Status: 00 - Record : 'BET00000 BETA SHOE MFG. INC. 1090 2ND AVE. WEST ATLANTA ' - ' GEORGIA 4082938498MS. JANICE SILCOX UNI-90403MEG8470' - ' 6250 BPI00034' - Key : 'BET00000' - Line: 482 IF - Line: 486 DISPLAY - Line: 490 READ - READ Sequential TSPFILE Status: 00 - Record : 'DEL00000 DELTA LUGGAGE REPAIRS 1620 ARIZONA WAY TORONTO ' - ' CANADA 4169898509MR. PETER MACKAY UNI-80/53MEG8470' - ' 6250 BPI00045' - Line: 491 IF - Line: 495 DISPLAY - Line: 499 MOVE - Line: 500 MOVE - Line: 501 READ - READ TSPFILE Status: 00 - Record : 'GIB00000 GIBRALTER LIFE INSURANCE 650 LIBERTY CRESCENT LOS RIOS ' - ' NEW MEXICO 6456445643MR. D.A. MORRISON UNI-80/61MEG8417' - ' 1600 BPI00067' - Key : 6456445643 - Line: 502 IF - Line: 506 DISPLAY - Line: 510 WRITE - WRITE TSPFILE Status: 22 - Record : 'GIB00000 GIBRALTER LIFE INSURANCE 650 LIBERTY CRESCENT LOS RIOS ' - ' NEW MEXICO 6456445643MR. D.A. MORRISON UNI-80/61MEG8417' - ' 1600 BPI00067' - Line: 511 IF - Line: 515 DISPLAY - Line: 518 MOVE - Line: 519 MOVE - Line: 520 READ - READ TSPFILE Status: 00 - Record : 'GAM00000 GAMMA X-RAY TECHNOLOGY 1401 JEFFERSON BLVD. WASHINGTON ' - ' D.C. 8372487274MR. ALLAN JONES UNI-80/31MEG8417' - ' 1600 BPI00075' - Key : 'GAM00000' - Line: 521 DISPLAY - Line: 525 ADD - Line: 526 REWRITE - REWRITE TSPFILE Status: 00 - Record : 'GAM00000 GAMMA X-RAY TECHNOLOGY 1401 JEFFERSON BLVD. WASHINGTON ' - ' D.C. 8372487274MR. ALLAN JONES UNI-80/31MEG8417' - ' 1600 BPI00080' - Line: 527 IF - Line: 532 DISPLAY - Line: 537 MOVE - Line: 538 MOVE - Line: 539 READ - READ TSPFILE Status: 00 - Record : 'BET00000 BETA SHOE MFG. INC. 1090 2ND AVE. WEST ATLANTA ' - ' GEORGIA 4082938498MS. JANICE SILCOX UNI-90403MEG8470' - ' 6250 BPI00034' - Key : 'BET00000' - Line: 540 DISPLAY - Line: 544 MOVE - Line: 545 MOVE - Line: 546 REWRITE - REWRITE TSPFILE Status: 02 - Record : 'GAM00000 GAMMA X-RAY TECHNOLOGY 1090 2ND AVE. WEST ATLANTA ' - ' GEORGIA 4082938498MS. JANICE SILCOX UNI-90403MEG8470' - ' 6250 BPI00034' - Line: 547 IF - Line: 552 DISPLAY - Line: 556 MOVE - Line: 557 MOVE - Line: 558 READ - READ TSPFILE Status: 00 - Record : 'FOR00000 FORTUNE COOKIE COMPANY 114 JOHN F. KENNEDY AVE. SAN DIEGO ' - ' CALIFORNIA 8009329492MR. MICHAEL SMYTHE UNI-80/63MEG8470' - ' 6250 BPI00107' - Key : 'FOR00000' - Line: 559 MOVE - Line: 560 MOVE - Line: 561 REWRITE - REWRITE TSPFILE Status: 02 - Record : 'FOR00000 FORTUNE COOKIE COMPANY 114 JOHN F. KENNEDY AVE. SAN DIEGO ' - ' CALIFORNIA 6456445643MR. MICHAEL SMYTHE UNI-80/63MEG8470' - ' 6250 BPI00107' - Line: 562 IF - Line: 567 DISPLAY - Line: 571 DELETE - DELETE TSPFILE Status: 00 - Record : 'FOR00000 FORTUNE COOKIE COMPANY 114 JOHN F. KENNEDY AVE. SAN DIEGO ' - ' CALIFORNIA 6456445643MR. MICHAEL SMYTHE UNI-80/63MEG8470' - ' 6250 BPI00107' - Line: 572 CLOSE - CLOSE TSPFILE Status: 00 - Line: 322 OPEN - Line: 323 IF - Line: 324 DISPLAY - Line: 332 PERFORM - Line: 574 Paragraph: LOADFLAT - Line: 575 OPEN - OPEN OUTPUT FLATFILE -> 'RELFIX' Status: 00 - Line: 576 PERFORM - Line: 588 Paragraph: FLAT-RECORD - Line: 590 MOVE - Line: 591 MOVE - Line: 592 MOVE - Line: 593 MOVE - Line: 594 MOVE - Line: 595 MOVE - Line: 596 IF - Line: 597 MOVE - Line: 600 WRITE - WRITE FLATFILE Status: 00 - Record : A L P 0 0 0 0 0 A L P H A E L E C T R I C A L C O . L T D - 1 x 414C5030 30303030 414C5048 4120454C 45435452 4943414C 20434F2E 204C5444 - . 8 4 1 7 U p 1 - 33 x 2E383431 37202020 20005500 00000200 70319C - Record# : 000001 - Line: 588 Paragraph: FLAT-RECORD - Line: 590 MOVE - Line: 591 MOVE - Line: 592 MOVE - Line: 593 MOVE - Line: 594 MOVE - Line: 595 MOVE - Line: 596 IF - Line: 599 MOVE - Line: 600 WRITE - WRITE FLATFILE Status: 00 - Record : B E T 0 0 0 0 0 B E T A S H O E M F G . I N C . - 1 x 42455430 30303030 42455441 2053484F 45204D46 472E2049 4E432E20 20202020 - 8 4 7 0 " p 1 - 33 x 20383437 30202020 20002200 00000200 70319C - Record# : 000002 - Line: 588 Paragraph: FLAT-RECORD - Line: 590 MOVE - Line: 591 MOVE - Line: 592 MOVE - Line: 593 MOVE - Line: 594 MOVE - Line: 595 MOVE - Line: 596 IF - Line: 597 MOVE - Line: 600 WRITE - WRITE FLATFILE Status: 00 - Record : G A M 0 0 0 0 0 G A M M A X - R A Y T E C H N O L O G Y - 1 x 47414D30 30303030 47414D4D 4120582D 52415920 54454348 4E4F4C4F 47592020 - 8 4 1 7 K p 1 - 33 x 20383431 37202020 20004B00 00000200 70319C - Record# : 000003 - Line: 588 Paragraph: FLAT-RECORD - Line: 590 MOVE - Line: 591 MOVE - Line: 592 MOVE - Line: 593 MOVE - Line: 594 MOVE - Line: 595 MOVE - Line: 596 IF - Line: 599 MOVE - Line: 600 WRITE - WRITE FLATFILE Status: 00 - Record : D E L 0 0 0 0 0 D E L T A L U G G A G E R E P A I R S - 1 x 44454C30 30303030 44454C54 41204C55 47474147 45205245 50414952 53202020 - 8 4 7 0 - p 1 - 33 x 20383437 30202020 20002D00 00000200 70319C - Record# : 000004 - Line: 588 Paragraph: FLAT-RECORD - Line: 590 MOVE - Line: 591 MOVE - Line: 592 MOVE - Line: 593 MOVE - Line: 594 MOVE - Line: 595 MOVE - Line: 596 IF - Line: 597 MOVE - Line: 600 WRITE - WRITE FLATFILE Status: 00 - Record : E P S 0 0 0 0 0 E P S I L O N E Q U I P M E N T S U P P L Y - 1 x 45505330 30303030 45505349 4C4F4E20 45515549 504D454E 54205355 50504C59 - 8 4 1 7 Z p 1 - 33 x 20383431 37202020 20005A00 00000200 70319C - Record# : 000005 - Line: 580 CLOSE - CLOSE FLATFILE Status: 00 - Line: 581 OPEN - OPEN INPUT FLATFILE -> 'RELFIX' Status: 00 - Line: 582 MOVE - Line: 583 READ - READ FLATFILE Status: 00 - Record : G A M 0 0 0 0 0 G A M M A X - R A Y T E C H N O L O G Y - 1 x 47414D30 30303030 47414D4D 4120582D 52415920 54454348 4E4F4C4F 47592020 - 8 4 1 7 K p 1 - 33 x 20383431 37202020 20004B00 00000200 70319C - Record# : 000003 - Line: 584 MOVE - Line: 585 READ - READ FLATFILE Status: 23 - Record# : 000999 - Line: 586 CLOSE - CLOSE FLATFILE Status: 00 - Line: 333 STOP RUN -_ATEOF - -# " <-- comment for fixing syntax highlighting - -# hack for not checking Status 02 as this isn't returned by all -# ISAM implementations - -{ set +x -$as_echo "$at_srcdir/run_file.at:12717: sed -e 's/WRITE TSPFILE Status: 02/WRITE TSPFILE Status: 00/g' \\ -reference > references" -at_fn_check_prepare_notrace 'an embedded newline' "run_file.at:12717" -( $at_check_trace; sed -e 's/WRITE TSPFILE Status: 02/WRITE TSPFILE Status: 00/g' \ -reference > references -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_file.at:12717" -$at_failed && at_fn_log_failure \ -"./trace.txt" -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_file.at:12719: sed -e 's/WRITE TSPFILE Status: 02/WRITE TSPFILE Status: 00/g' \\ --e 's/'\"OPEN OUTPUT TSPFILE -> 'testisam' Status: 05\"'/'\"OPEN OUTPUT TSPFILE -> 'testisam' Status: 00\"'/g' \\ -trace.txt > traces.txt" -at_fn_check_prepare_notrace 'an embedded newline' "run_file.at:12719" -( $at_check_trace; sed -e 's/WRITE TSPFILE Status: 02/WRITE TSPFILE Status: 00/g' \ --e 's/'"OPEN OUTPUT TSPFILE -> 'testisam' Status: 05"'/'"OPEN OUTPUT TSPFILE -> 'testisam' Status: 00"'/g' \ -trace.txt > traces.txt -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_file.at:12719" -$at_failed && at_fn_log_failure \ -"./trace.txt" -$at_traceon; } - - -{ set +x -$as_echo "$at_srcdir/run_file.at:12723: gcdiff references traces.txt" -at_fn_check_prepare_trace "run_file.at:12723" -( $at_check_trace; gcdiff references traces.txt -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_file.at:12723" -$at_failed && at_fn_log_failure \ -"./trace.txt" -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_780 -#AT_START_781 -at_fn_group_banner 781 'run_file.at:12728' \ - "trace feature with indexed EXTFH" " " 4 -at_xfail=no -( - $as_echo "781. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -$as_echo "run_file.at:12731" >"$at_check_line_file" -(test "$COB_HAS_ISAM" = "no") \ - && at_fn_check_skip 77 "$at_srcdir/run_file.at:12731" - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - - ENVIRONMENT DIVISION. - CONFIGURATION SECTION. - - INPUT-OUTPUT SECTION. - FILE-CONTROL. - SELECT OPTIONAL TSPFILE - ASSIGN TO "testisam" - ORGANIZATION INDEXED ACCESS DYNAMIC - RECORD KEY IS CM-CUST-NUM - ALTERNATE RECORD KEY IS CM-TELEPHONE WITH DUPLICATES - ALTERNATE RECORD KEY IS CM-DISK WITH DUPLICATES - FILE STATUS IS CUST-STAT. - - SELECT TSTFILE - ASSIGN TO "testisam" - ORGANIZATION INDEXED ACCESS DYNAMIC - RECORD KEY IS TS-CUST-NUM - ALTERNATE RECORD KEY IS TS-TELEPHONE WITH DUPLICATES - ALTERNATE RECORD KEY IS TS-DISK WITH DUPLICATES - FILE STATUS IS CUST-STAT. - - SELECT FLATFILE - ASSIGN EXTERNAL RELFIX - ORGANIZATION RELATIVE - ACCESS IS RANDOM RELATIVE KEY IS REC-NUM - FILE STATUS IS CUST-STAT. - - DATA DIVISION. - FILE SECTION. - FD TSPFILE - BLOCK CONTAINS 5 RECORDS. - - 01 TSPFL-RECORD. - 05 TSPFL-REC. - 10 CM-CUST-NUM. - 15 CM-CUST-PRE PICTURE X(3). - 15 CM-CUST-NNN PICTURE X(5). - 10 CM-STATUS PICTURE X. - 10 CM-COMPANY PICTURE X(25). - 10 CM-ADDRESS-1 PICTURE X(25). - 10 CM-ADDRESS-2 PICTURE X(25). - 10 CM-ADDRESS-3 PICTURE X(25). - 10 CM-TELEPHONE PICTURE 9(10). - 10 CM-DP-MGR PICTURE X(25). - 10 CM-MACHINE PICTURE X(8). - 10 CM-MEMORY PICTURE X(4). - 10 CM-DISK PICTURE X(8). - 10 CM-TAPE PICTURE X(8). - 10 CM-NO-TERMINALS PICTURE 9(5). - - FD TSTFILE - BLOCK CONTAINS 5 RECORDS. - - 01 TSTFL-RECORD. - 05 TSTFL-REC. - 10 TS-CUST-NUM PICTURE X(8). - 10 TS-STATUS PICTURE X. - 10 TS-COMPANY PICTURE X(25). - 10 TS-ADDRESS-1 PICTURE X(25). - 10 TS-ADDRESS-2 PICTURE X(25). - 10 TS-ADDRESS-3 PICTURE X(25). - 10 TS-TELEPHONE PICTURE 9(10). - 10 TS-DP-MGR PICTURE X(25). - 10 TS-MACHINE PICTURE X(8). - 10 TS-MEMORY PICTURE X(4). - 10 TS-DISK PICTURE X(8). - 10 TS-TAPE PICTURE X(8). - - FD FLATFILE - BLOCK CONTAINS 5 RECORDS. - - 01 TSP2-RECORD. - 10 C2-CUST-NUM PICTURE X(8). - 10 C2-COMPANY PICTURE X(25). - 10 C2-DISK PICTURE X(8). - 10 C2-NO-TERMINALS PICTURE 9(4) COMP-4. - 10 C2-PK-DATE PICTURE S9(14) COMP-3. - - WORKING-STORAGE SECTION. - - 01 CUST-STAT. - 05 FILLER PICTURE XX. - 77 MAX-SUB VALUE 16 PICTURE 9(5) COMP SYNC. - 77 CALL-NUM VALUE 00 PICTURE 99. - - 01 TEST-DATA. - - 02 DATA-CUST-NUM-TBL. - - 05 FILLER PIC X(8) VALUE "ALP00000". - 05 FILLER PIC X(8) VALUE "BET00000". - 05 FILLER PIC X(8) VALUE "GAM00000". - 05 FILLER PIC X(8) VALUE "DEL00000". - 05 FILLER PIC X(8) VALUE "EPS00000". - 05 FILLER PIC X(8) VALUE "FOR00000". - 05 FILLER PIC X(8) VALUE "GIB00000". - 05 FILLER PIC X(8) VALUE "H&J00000". - 05 FILLER PIC X(8) VALUE "INC00000". - 05 FILLER PIC X(8) VALUE "JOH00000". - 05 FILLER PIC X(8) VALUE "KON00000". - 05 FILLER PIC X(8) VALUE "LEW00000". - 05 FILLER PIC X(8) VALUE "MOR00000". - 05 FILLER PIC X(8) VALUE "NEW00000". - 05 FILLER PIC X(8) VALUE "OLD00000". - 05 FILLER PIC X(8) VALUE "PRE00000". - - 02 DATA-CUST-NUM REDEFINES DATA-CUST-NUM-TBL - PIC X(8) OCCURS 16. - 02 DATA-COMPANY-TBL. - - 05 FILLER PIC X(25) VALUE "ALPHA ELECTRICAL CO. LTD.". - 05 FILLER PIC X(25) VALUE "BETA SHOE MFG. INC. ". - 05 FILLER PIC X(25) VALUE "GAMMA X-RAY TECHNOLOGY ". - 05 FILLER PIC X(25) VALUE "DELTA LUGGAGE REPAIRS ". - 05 FILLER PIC X(25) VALUE "EPSILON EQUIPMENT SUPPLY ". - 05 FILLER PIC X(25) VALUE "FORTUNE COOKIE COMPANY ". - 05 FILLER PIC X(25) VALUE "GIBRALTER LIFE INSURANCE ". - 05 FILLER PIC X(25) VALUE "H & J PLUMBING SUPPLIES ". - 05 FILLER PIC X(25) VALUE "INCREMENTAL BACKUP CORP. ". - 05 FILLER PIC X(25) VALUE "JOHNSON BOATING SUPPLIES ". - 05 FILLER PIC X(25) VALUE "KONFLAB PLASTIC PRODUCTS.". - 05 FILLER PIC X(25) VALUE "LEWISTON GRAPHICS LTD. ". - 05 FILLER PIC X(25) VALUE "MORNINGSIDE CARPENTRY. ". - 05 FILLER PIC X(25) VALUE "NEW WAVE SURF SHOPS INC. ". - 05 FILLER PIC X(25) VALUE "OLD TYME PIZZA MFG. CO. ". - 05 FILLER PIC X(25) VALUE "PRESTIGE OFFICE FURNITURE". - - 02 DATA-COMPANY REDEFINES DATA-COMPANY-TBL - PIC X(25) OCCURS 16. - 02 DATA-ADDRESS-1-TBL. - - 05 FILLER PIC X(25) VALUE "123 MAIN STREET ". - 05 FILLER PIC X(25) VALUE "1090 2ND AVE. WEST ". - 05 FILLER PIC X(25) VALUE "1401 JEFFERSON BLVD. ". - 05 FILLER PIC X(25) VALUE "1620 ARIZONA WAY ". - 05 FILLER PIC X(25) VALUE "1184 EAST FIRST STREET ". - 05 FILLER PIC X(25) VALUE "114 JOHN F. KENNEDY AVE. ". - 05 FILLER PIC X(25) VALUE "650 LIBERTY CRESCENT ". - 05 FILLER PIC X(25) VALUE "77 SUNSET BLVD. ". - 05 FILLER PIC X(25) VALUE "10908 SANTA MONICA BLVD. ". - 05 FILLER PIC X(25) VALUE "1134 PARIS ROAD ". - 05 FILLER PIC X(25) VALUE "808 NORTHWEST MAIN ST. ". - 05 FILLER PIC X(25) VALUE "9904 QUEEN STREET ". - 05 FILLER PIC X(25) VALUE "1709 DUNDAS CRESCENT W. ". - 05 FILLER PIC X(25) VALUE "3240 MARIS AVENUE ". - 05 FILLER PIC X(25) VALUE "1705 WISCONSIN ROAD ". - 05 FILLER PIC X(25) VALUE "114A MAPLE GROVE ". - - 02 DATA-ADDRESS-1 REDEFINES DATA-ADDRESS-1-TBL - PIC X(25) OCCURS 16. - 02 DATA-ADDRESS-2-TBL. - - 05 FILLER PIC X(10) VALUE "NEW YORK ". - 05 FILLER PIC X(10) VALUE "ATLANTA ". - 05 FILLER PIC X(10) VALUE "WASHINGTON". - 05 FILLER PIC X(10) VALUE "TORONTO ". - 05 FILLER PIC X(10) VALUE "CALGARY ". - 05 FILLER PIC X(10) VALUE "SAN DIEGO ". - 05 FILLER PIC X(10) VALUE "LOS RIOS ". - 05 FILLER PIC X(10) VALUE "MADISON ". - 05 FILLER PIC X(10) VALUE "WILBUR ". - 05 FILLER PIC X(10) VALUE "TOPEKA ". - 05 FILLER PIC X(10) VALUE "SEATTLE ". - 05 FILLER PIC X(10) VALUE "NEW JERSEY". - 05 FILLER PIC X(10) VALUE "FORT WAYNE". - 05 FILLER PIC X(10) VALUE "COLUMBUS ". - 05 FILLER PIC X(10) VALUE "RICHMOND ". - 05 FILLER PIC X(10) VALUE "WHITEPLAIN". - - 02 DATA-ADDRESS-2 REDEFINES DATA-ADDRESS-2-TBL - PIC X(10) OCCURS 16. - 02 DATA-ADDRESS-3-TBL. - - 05 FILLER PIC X(10) VALUE "N.Y. ". - 05 FILLER PIC X(10) VALUE "GEORGIA ". - 05 FILLER PIC X(10) VALUE "D.C. ". - 05 FILLER PIC X(10) VALUE "CANADA ". - 05 FILLER PIC X(10) VALUE "CANADA ". - 05 FILLER PIC X(10) VALUE "CALIFORNIA". - 05 FILLER PIC X(10) VALUE "NEW MEXICO". - 05 FILLER PIC X(10) VALUE "WISCONSIN ". - 05 FILLER PIC X(10) VALUE "DELAWARE ". - 05 FILLER PIC X(10) VALUE "KANSAS ". - 05 FILLER PIC X(10) VALUE "WASHINGTON". - 05 FILLER PIC X(10) VALUE "N.J. ". - 05 FILLER PIC X(10) VALUE "COLORADO ". - 05 FILLER PIC X(10) VALUE "OHIO ". - 05 FILLER PIC X(10) VALUE "VIRGINIA ". - 05 FILLER PIC X(10) VALUE "N.Y. ". - - 02 DATA-ADDRESS-3 REDEFINES DATA-ADDRESS-3-TBL - PIC X(10) OCCURS 16. - 02 DATA-TELEPHONE-TBL. - - 05 FILLER PIC 9(10) VALUE 3131234432. - 05 FILLER PIC 9(10) VALUE 4082938498. - 05 FILLER PIC 9(10) VALUE 8372487274. - 05 FILLER PIC 9(10) VALUE 4169898509. - 05 FILLER PIC 9(10) VALUE 5292398745. - 05 FILLER PIC 9(10) VALUE 8009329492. - 05 FILLER PIC 9(10) VALUE 6456445643. - 05 FILLER PIC 9(10) VALUE 6546456333. - 05 FILLER PIC 9(10) VALUE 3455445444. - 05 FILLER PIC 9(10) VALUE 6456445643. - 05 FILLER PIC 9(10) VALUE 7456434355. - 05 FILLER PIC 9(10) VALUE 6554456433. - 05 FILLER PIC 9(10) VALUE 4169898509. - 05 FILLER PIC 9(10) VALUE 7534587453. - 05 FILLER PIC 9(10) VALUE 8787458374. - 05 FILLER PIC 9(10) VALUE 4169898509. - - 02 DATA-TELEPHONE REDEFINES DATA-TELEPHONE-TBL - PIC 9(10) OCCURS 16. - 02 DATA-DP-MGR-TBL. - - 05 FILLER PIC X(20) VALUE "MR. DAVE HARRIS ". - 05 FILLER PIC X(20) VALUE "MS. JANICE SILCOX ". - 05 FILLER PIC X(20) VALUE "MR. ALLAN JONES ". - 05 FILLER PIC X(20) VALUE "MR. PETER MACKAY ". - 05 FILLER PIC X(20) VALUE "MRS. DONNA BREWER ". - 05 FILLER PIC X(20) VALUE "MR. MICHAEL SMYTHE ". - 05 FILLER PIC X(20) VALUE "MR. D.A. MORRISON ". - 05 FILLER PIC X(20) VALUE "MR. BRIAN PATTERSON ". - 05 FILLER PIC X(20) VALUE "MR. DARRYL TOWNSEND ". - 05 FILLER PIC X(20) VALUE "MS. VALERIE HARPER ". - 05 FILLER PIC X(20) VALUE "MR. FRED MILLER ". - 05 FILLER PIC X(20) VALUE "MR. DONALD FISCHER ". - 05 FILLER PIC X(20) VALUE "MR. STEVEN YOURDIN ". - 05 FILLER PIC X(20) VALUE "MS. Goldie Hawn ". - 05 FILLER PIC X(20) VALUE "MS. ALICE WINSTON ". - 05 FILLER PIC X(20) VALUE "MR. THOMAS JEFFERSON". - - 02 DATA-DP-MGR REDEFINES DATA-DP-MGR-TBL - PIC X(20) OCCURS 16. - 02 DATA-MACHINE-TBL. - - 05 FILLER PIC X(8) VALUE "UNI-9030". - 05 FILLER PIC X(8) VALUE "UNI-9040". - 05 FILLER PIC X(8) VALUE "UNI-80/3". - 05 FILLER PIC X(8) VALUE "UNI-80/5". - 05 FILLER PIC X(8) VALUE "UNI-80/6". - 05 FILLER PIC X(8) VALUE "UNI-80/6". - 05 FILLER PIC X(8) VALUE "UNI-80/6". - 05 FILLER PIC X(8) VALUE "UNI-80/8". - 05 FILLER PIC X(8) VALUE "UNI-80/8". - 05 FILLER PIC X(8) VALUE "UNI-80/8". - 05 FILLER PIC X(8) VALUE "UNI-80/8". - 05 FILLER PIC X(8) VALUE "UNI-80/8". - 05 FILLER PIC X(8) VALUE "UNI-80/8". - 05 FILLER PIC X(8) VALUE "UNI-80/8". - 05 FILLER PIC X(8) VALUE "UNI-9040". - 05 FILLER PIC X(8) VALUE "UNI-9040". - - 02 DATA-MACHINE REDEFINES DATA-MACHINE-TBL - PIC X(8) OCCURS 16. - 02 DATA-NO-TERMINALS-TBL. - - 05 FILLER PIC 9(3) COMP-3 VALUE 85. - 05 FILLER PIC 9(3) COMP-3 VALUE 34. - 05 FILLER PIC 9(3) COMP-3 VALUE 75. - 05 FILLER PIC 9(3) COMP-3 VALUE 45. - 05 FILLER PIC 9(3) COMP-3 VALUE 90. - 05 FILLER PIC 9(3) COMP-3 VALUE 107. - 05 FILLER PIC 9(3) COMP-3 VALUE 67. - 05 FILLER PIC 9(3) COMP-3 VALUE 32. - 05 FILLER PIC 9(3) COMP-3 VALUE 16. - 05 FILLER PIC 9(3) COMP-3 VALUE 34. - 05 FILLER PIC 9(3) COMP-3 VALUE 128. - 05 FILLER PIC 9(3) COMP-3 VALUE 64. - 05 FILLER PIC 9(3) COMP-3 VALUE 110. - 05 FILLER PIC 9(3) COMP-3 VALUE 324. - 05 FILLER PIC 9(3) COMP-3 VALUE 124. - 05 FILLER PIC 9(3) COMP-3 VALUE 86. - - 02 DATA-NO-TERMINALS REDEFINES DATA-NO-TERMINALS-TBL - PIC 9(3) COMP-3 OCCURS 16. - - 01 WORK-AREA. - 05 REC-NUM PICTURE 9(6) VALUE 0. - 05 REC-MAX PICTURE 9(6) VALUE 10. - 05 SUB PICTURE 9(4) COMP SYNC. - 88 ODD-RECORD VALUE 1 3 5 7 9 10 11. - - 05 TSPFL-KEY PICTURE X(8). - - PROCEDURE DIVISION. - - MAINFILE. - OPEN OUTPUT TSPFILE - CLOSE TSPFILE. - - OPEN I-O TSPFILE - MOVE '99' TO CUST-STAT - READ TSPFILE NEXT RECORD WITH NO LOCK - IF CUST-STAT NOT = "10" - DISPLAY "Error " CUST-STAT " on read of empty file" - UPON CONSOLE - STOP RUN - END-IF. - MOVE LOW-VALUES TO TSPFL-RECORD. - START TSPFILE KEY GREATER THAN CM-CUST-NUM - IF CUST-STAT NOT = "23" - DISPLAY "Error " CUST-STAT " starting empty file" - UPON CONSOLE - STOP RUN - END-IF. - READ TSPFILE NEXT RECORD WITH NO LOCK - IF CUST-STAT NOT = "46" - DISPLAY "Error " CUST-STAT " start/read of empty file" - UPON CONSOLE - STOP RUN - END-IF. - DISPLAY "OK: Operations on empty file" - CLOSE TSPFILE. - - PERFORM LOADFILE. - PERFORM LISTFILE. - OPEN INPUT TSTFILE - IF CUST-STAT NOT = "00" - DISPLAY "Expected ERROR " CUST-STAT - " opening TSTFILE, Record size different" - UPON CONSOLE - ELSE - DISPLAY "Un-Expected open TSTFILE, Record size different" - UPON CONSOLE - CLOSE TSTFILE - END-IF. - PERFORM LOADFLAT. - STOP RUN. - - LOADFILE. - DISPLAY "Loading sample data file." - UPON CONSOLE. - - OPEN OUTPUT TSPFILE - IF NOT (CUST-STAT = "00" or "05") *> the file may exist - DISPLAY "Error " CUST-STAT - " opening 'testisam' file" UPON CONSOLE - STOP RUN - END-IF. - - PERFORM 1000-LOAD-RECORD - VARYING SUB FROM 1 BY 1 - UNTIL SUB > MAX-SUB. - - DISPLAY "Sample data file load complete." - UPON CONSOLE. - CLOSE TSPFILE. - - *---------------------------------------------------------------* - * LOAD A RECORD FROM DATA TABLES * - *---------------------------------------------------------------* - - 1000-LOAD-RECORD. - - MOVE SPACES TO TSPFL-RECORD. - MOVE DATA-CUST-NUM (SUB) TO CM-CUST-NUM. - MOVE CM-CUST-NUM TO TSPFL-KEY. - MOVE DATA-COMPANY (SUB) TO CM-COMPANY. - MOVE DATA-ADDRESS-1 (SUB) TO CM-ADDRESS-1. - MOVE DATA-ADDRESS-2 (SUB) TO CM-ADDRESS-2. - MOVE DATA-ADDRESS-3 (SUB) TO CM-ADDRESS-3. - MOVE DATA-TELEPHONE (SUB) TO CM-TELEPHONE. - MOVE DATA-DP-MGR (SUB) TO CM-DP-MGR. - MOVE DATA-MACHINE (SUB) TO CM-MACHINE. - MOVE DATA-NO-TERMINALS (SUB) TO CM-NO-TERMINALS. - - IF ODD-RECORD - MOVE "8417" TO CM-DISK - MOVE "1600 BPI" TO CM-TAPE - MOVE "1MEG" TO CM-MEMORY - ELSE - MOVE "8470" TO CM-DISK - MOVE "6250 BPI" TO CM-TAPE - MOVE "3MEG" TO CM-MEMORY. - - WRITE TSPFL-RECORD. - IF CUST-STAT NOT = "00" - AND CUST-STAT NOT = "02" - DISPLAY "Load - Key: " TSPFL-KEY ", Status: " CUST-STAT - UPON CONSOLE. - - LISTFILE. - DISPLAY "LIST SAMPLE FILE" UPON CONSOLE. - OPEN INPUT TSTFILE - MOVE SPACES TO TSTFL-RECORD. - MOVE "PRE00000" TO CM-CUST-NUM. - START TSTFILE KEY GREATER THAN OR EQUAL TO TS-CUST-NUM - READ TSTFILE NEXT RECORD - READ TSTFILE NEXT RECORD - CLOSE TSTFILE. - - MOVE ZERO TO REC-NUM - OPEN INPUT TSPFILE - IF CUST-STAT NOT = "00" - DISPLAY "ERROR " CUST-STAT " OPENING INPUT FILE" - UPON CONSOLE - STOP RUN - END-IF. - MOVE SPACES TO TSPFL-RECORD. - MOVE "PRE00000" TO CM-CUST-NUM. - START TSPFILE KEY GREATER THAN OR EQUAL TO CM-CUST-NUM - READ TSPFILE NEXT RECORD - READ TSPFILE NEXT RECORD - - MOVE SPACES TO TSPFL-RECORD. - MOVE "DEL00000" TO CM-CUST-NUM. - START TSPFILE KEY GREATER THAN CM-CUST-NUM - IF CUST-STAT NOT = "00" - DISPLAY "Error " CUST-STAT " starting file" - UPON CONSOLE - STOP RUN - END-IF. - READ TSPFILE NEXT RECORD WITH NO LOCK - IF CUST-STAT NOT = "00" - DISPLAY "Error " CUST-STAT " on 1st read of file" - UPON CONSOLE - STOP RUN - END-IF. - PERFORM UNTIL CUST-STAT NOT = "00" - OR REC-NUM > REC-MAX - DISPLAY "Key: " CM-CUST-NUM " is " CM-COMPANY - " Disk=" CM-DISK "." - UPON CONSOLE - ADD 1 TO CALL-NUM - READ TSPFILE NEXT RECORD - AT END - MOVE "99" TO CUST-STAT - END-READ - ADD 1 TO REC-NUM - END-PERFORM - IF CUST-STAT = "99" - DISPLAY "Hit End of File: " CALL-NUM UPON CONSOLE - ELSE - DISPLAY "Stop read after: " CALL-NUM UPON CONSOLE - END-IF. - - DISPLAY "LIST SAMPLE FILE DESCENDING" UPON CONSOLE. - MOVE ZERO TO REC-NUM - START TSPFILE KEY LESS THAN CM-CUST-NUM - IF CUST-STAT NOT = "00" - DISPLAY "Error " CUST-STAT " starting file" - UPON CONSOLE - STOP RUN - END-IF. - READ TSPFILE PREVIOUS RECORD WITH NO LOCK - IF CUST-STAT NOT = "00" - DISPLAY "Error " CUST-STAT " on 1st read of file" - UPON CONSOLE - STOP RUN - END-IF. - PERFORM UNTIL CUST-STAT NOT = "00" - OR REC-NUM > REC-MAX - DISPLAY "Key: " CM-CUST-NUM " is " CM-COMPANY - " Disk=" CM-DISK "." - UPON CONSOLE - READ TSPFILE PREVIOUS RECORD - AT END - MOVE "99" TO CUST-STAT - END-READ - ADD 1 TO REC-NUM - END-PERFORM. - - CLOSE TSPFILE. - - OPEN I-O TSPFILE. - MOVE SPACES TO TSPFL-RECORD. - MOVE DATA-CUST-NUM (2) TO CM-CUST-NUM. - MOVE 'X' TO CM-CUST-NUM (5:1). - READ TSPFILE KEY IS CM-CUST-NUM - IF CUST-STAT NOT = "23" - DISPLAY "Error " CUST-STAT " instead of 23." - UPON CONSOLE - END-IF. - MOVE DATA-CUST-NUM (2) TO CM-CUST-NUM. - MOVE DATA-COMPANY (2) TO CM-COMPANY. - READ TSPFILE KEY IS CM-CUST-NUM - IF CUST-STAT NOT = "00" - DISPLAY "Error " CUST-STAT " on primary read ." - UPON CONSOLE - ELSE - DISPLAY "Got: " CM-CUST-NUM " is " CM-COMPANY - " Disk=" CM-DISK "." - UPON CONSOLE - END-IF. - READ TSPFILE NEXT RECORD - IF CUST-STAT NOT = "00" - DISPLAY "Error " CUST-STAT " on next read" - UPON CONSOLE - ELSE - DISPLAY "Nxt: " CM-CUST-NUM " is " CM-COMPANY - " Disk=" CM-DISK "." - UPON CONSOLE - END-IF. - MOVE DATA-TELEPHONE (7) TO CM-TELEPHONE. - MOVE DATA-MACHINE (7) TO CM-MACHINE. - READ TSPFILE KEY IS CM-TELEPHONE - IF CUST-STAT NOT = "00" - DISPLAY "Error " CUST-STAT " instead of 23" - UPON CONSOLE - ELSE - DISPLAY "Ky2: " CM-CUST-NUM " is " CM-COMPANY - " Mach=" CM-MACHINE "." - UPON CONSOLE - END-IF. - WRITE TSPFL-RECORD - IF CUST-STAT NOT = "22" - DISPLAY "Error " CUST-STAT " instead of 22" - UPON CONSOLE - ELSE - DISPLAY " Write: " CM-CUST-NUM " got 22 as expected" - UPON CONSOLE - END-IF. - MOVE DATA-CUST-NUM (3) TO CM-CUST-NUM. - MOVE DATA-COMPANY (3) TO CM-COMPANY. - READ TSPFILE KEY IS CM-CUST-NUM - DISPLAY " Read: " CM-CUST-NUM " got " - CUST-STAT " as expected " - CM-NO-TERMINALS " terminals" - UPON CONSOLE. - ADD 5 TO CM-NO-TERMINALS - REWRITE TSPFL-RECORD - IF CUST-STAT NOT = "02" - AND CUST-STAT NOT = "00" - DISPLAY "Error " CUST-STAT " instead of 00/02" - UPON CONSOLE - ELSE - - DISPLAY "ReWrite: " CM-CUST-NUM " got 00/02" - " as expected " - CM-NO-TERMINALS " terminals" - UPON CONSOLE - END-IF. - MOVE DATA-CUST-NUM (2) TO CM-CUST-NUM. - MOVE DATA-COMPANY (2) TO CM-COMPANY. - READ TSPFILE KEY IS CM-CUST-NUM - DISPLAY " Read: " CM-CUST-NUM " got " - CUST-STAT " as expected " - CM-NO-TERMINALS " terminals" - UPON CONSOLE. - MOVE DATA-CUST-NUM (3) TO CM-CUST-NUM. - MOVE DATA-COMPANY (3) TO CM-COMPANY. - REWRITE TSPFL-RECORD - IF CUST-STAT NOT = "02" - AND CUST-STAT NOT = "00" - DISPLAY "Error " CUST-STAT " instead of 00/02" - UPON CONSOLE - ELSE - DISPLAY "ReWrite: " CM-CUST-NUM " got 00/02" - " as expected" - UPON CONSOLE - END-IF. - MOVE DATA-CUST-NUM (6) TO CM-CUST-NUM. - MOVE DATA-COMPANY (6) TO CM-COMPANY. - READ TSPFILE KEY IS CM-CUST-NUM - MOVE DATA-TELEPHONE (7) TO CM-TELEPHONE. - MOVE DATA-MACHINE (7) TO CM-MACHINE. - REWRITE TSPFL-RECORD - IF CUST-STAT NOT = "02" - AND CUST-STAT NOT = "00" - DISPLAY "Error " CUST-STAT " instead of 00/02" - UPON CONSOLE - ELSE - DISPLAY "ReWrite: " CM-CUST-NUM " got 00/02" - " as expected" - UPON CONSOLE - END-IF. - DELETE TSPFILE. - CLOSE TSPFILE. - - LOADFLAT. - OPEN OUTPUT FLATFILE. - PERFORM FLAT-RECORD - VARYING SUB FROM 1 BY 1 - UNTIL SUB > MAX-SUB - OR SUB > 5. - CLOSE FLATFILE. - OPEN INPUT FLATFILE. - MOVE 3 TO REC-NUM - READ FLATFILE - MOVE 999 TO REC-NUM - READ FLATFILE - CLOSE FLATFILE. - - FLAT-RECORD. - - MOVE SPACES TO TSP2-RECORD. - MOVE SUB TO REC-NUM. - MOVE DATA-CUST-NUM (SUB) TO C2-CUST-NUM. - MOVE DATA-COMPANY (SUB) TO C2-COMPANY. - MOVE DATA-NO-TERMINALS (SUB) TO C2-NO-TERMINALS. - MOVE 20070319 TO C2-PK-DATE. - IF ODD-RECORD - MOVE "8417" TO C2-DISK - ELSE - MOVE "8470" TO C2-DISK. - WRITE TSP2-RECORD. -_ATEOF - - -cat >cmod.c <<'_ATEOF' - -/****************************************************************************** -* 2017, Ron Norman * -* Source for a Micro Focus COBOL External File Handler. * -* * -* For GnuCOBOL add -fcallfh=TSTFH as a compile option * -* * -* This is a sample module for GnuCOBOL, but it does not do very much * -******************************************************************************/ - -#include -#include -#include -#include - -#ifndef TRUE -#define TRUE 1 -#endif -#ifndef FALSE -#define FALSE 0 -#endif -#define MIN(a,b) (a < b ? a : b) - -static char *txtOpCode(int opCode); - -/************************************************************************* - Replace filename with environment variable value, then open the file - This is required as MF Cobol seems to have pre-read the ENV Variables -*************************************************************************/ -static int -doOpenFile( - unsigned char *opCodep, - FCD3 *fcd, - char *opmsg) -{ - int sts,oldlen,j,k; - char *oldFptr,*env,wrk[64]; - unsigned char svOther; - unsigned int opCode; - - oldFptr = fcd->fnamePtr; /* Save values */ - oldlen = LDCOMPX2(fcd->fnameLen); - fcd->otherFlags &= ~OTH_DOLSREAD; - svOther = fcd->otherFlags; - - return EXTFH( opCodep, fcd ); /* No DD_, so use normal MF File Open */ -} - -/********************************************************* - * TSTFH - External File Handler entry point. -*********************************************************/ -int -TSTFH( unsigned char *opCodep, FCD3 *fcd) -{ - unsigned int opCode; - char *fname; - int sts, ky, j, k; - - if(*opCodep == 0xfa) - opCode = 0xfa00 + opCodep[1]; - else - opCode = opCodep[1]; - - if(fcd->fileOrg == ORG_LINE_SEQ - || fcd->fileOrg == ORG_SEQ - || fcd->fileOrg == ORG_INDEXED - || fcd->fileOrg == ORG_RELATIVE) { - switch (opCode) { - case OP_OPEN_OUTPUT: - case OP_OPEN_IO: - case OP_OPEN_EXTEND: - case OP_OPEN_OUTPUT_NOREWIND: - return doOpenFile( opCodep, fcd, txtOpCode(opCode)); - break; - - case OP_OPEN_INPUT: - case OP_OPEN_INPUT_NOREWIND: - case OP_OPEN_INPUT_REVERSED: - return doOpenFile( opCodep, fcd, txtOpCode(opCode)); - break; - - default: - break; - } - - } - - if(opCode == OP_CLOSE - && (fcd->openMode & OPEN_NOT_OPEN) ) { - return 0; - } - - sts = EXTFH( opCodep, fcd ); - return sts; -} - -static char * /* Return Text name of function */ -txtOpCode(int opCode) -{ - static char tmp[32]; - switch (opCode) { - case OP_OPEN_INPUT: return "OPEN_IN"; - case OP_OPEN_OUTPUT: return "OPEN_OUT"; - case OP_OPEN_IO: return "OPEN_IO"; - case OP_OPEN_EXTEND: return "OPEN_EXT"; - case OP_OPEN_INPUT_NOREWIND: return "OPEN_IN_NOREW"; - case OP_OPEN_OUTPUT_NOREWIND: return "OPEN_OUT_NOREW"; - case OP_OPEN_INPUT_REVERSED: return "OPEN_IN_REV"; - case OP_CLOSE: return "CLOSE"; - case OP_CLOSE_LOCK: return "CLOSE_LOCK"; - case OP_CLOSE_NOREWIND: return "CLOSE_NORED"; - case OP_CLOSE_REEL: return "CLOSE_REEL"; - case OP_CLOSE_REMOVE: return "CLOSE_REMOVE"; - case OP_CLOSE_NO_REWIND: return "CLOSE_NO_REW"; - case OP_START_EQ: return "START_EQ"; - case OP_START_EQ_ANY: return "START_EQ_ANY"; - case OP_START_GT: return "START_GT"; - case OP_START_GE: return "START_GE"; - case OP_START_LT: return "START_LT"; - case OP_START_LE: return "START_LE"; - case OP_READ_SEQ_NO_LOCK: return "READ_SEQ_NO_LK"; - case OP_READ_SEQ: return "READ_SEQ"; - case OP_READ_SEQ_LOCK: return "READ_SEQ_LK"; - case OP_READ_SEQ_KEPT_LOCK: return "READ_SEQ_KEPT_LK"; - case OP_READ_PREV_NO_LOCK: return "READ_PREV_NO_LK"; - case OP_READ_PREV: return "READ_PREV"; - case OP_READ_PREV_LOCK: return "READ_PREV_LK"; - case OP_READ_PREV_KEPT_LOCK: return "READ_PREV_KEPT_LK"; - case OP_READ_RAN: return "READ_RAN"; - case OP_READ_RAN_NO_LOCK: return "READ_RAN_NO_LK"; - case OP_READ_RAN_KEPT_LOCK: return "READ_RAN_KEPT_LK"; - case OP_READ_RAN_LOCK: return "READ_RAN_LK"; - case OP_READ_DIR: return "READ_DIR"; - case OP_READ_DIR_NO_LOCK: return "READ_DIR_NO_LK"; - case OP_READ_DIR_KEPT_LOCK: return "READ_DIR_KEPT_LK"; - case OP_READ_DIR_LOCK: return "READ_DIR_LK"; - case OP_READ_POSITION: return "READ_POSITION"; - case OP_WRITE: return "WRITE"; - case OP_REWRITE: return "REWRITE"; - case OP_DELETE: return "DELETE"; - case OP_DELETE_FILE: return "DELETE_FILE"; - case OP_UNLOCK: return "UNLOCK"; - case OP_ROLLBACK: return "ROLLBACK"; - case OP_COMMIT: return "COMMIT"; - case OP_WRITE_BEFORE: return "WRITE_BEFORE"; - case OP_WRITE_BEFORE_TAB: return "WRITE_BEFORE_TAB"; - case OP_WRITE_BEFORE_PAGE: return "WRITE_BEFORE_PAGE"; - case OP_WRITE_AFTER: return "WRITE_AFTER"; - case OP_WRITE_AFTER_TAB: return "WRITE_AFTER_TAB"; - case OP_WRITE_AFTER_PAGE: return "WRITE_AFTER_PAGE"; - } - sprintf(tmp,"Func 0x%02X:",opCode); - return tmp; -} -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_file.at:13492: \$COMPILE -fcallfh=TSTFH -ftraceall prog.cob cmod.c" -at_fn_check_prepare_dynamic "$COMPILE -fcallfh=TSTFH -ftraceall prog.cob cmod.c" "run_file.at:13492" -( $at_check_trace; $COMPILE -fcallfh=TSTFH -ftraceall prog.cob cmod.c -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_file.at:13492" -$at_failed && at_fn_log_failure -$at_traceon; } - - -# first run without runtime tracing -{ set +x -$as_echo "$at_srcdir/run_file.at:13495: export COB_TRACE_FILE=trace.txt -export COB_TRACE_IO=Y -export COB_SET_TRACE=Y -export COB_TRACE_FORMAT=%L%S -export IO_TSPFILE=trace -export IO_TSTFILE=no-trace -./prog" -at_fn_check_prepare_notrace 'an embedded newline' "run_file.at:13495" -( $at_check_trace; export COB_TRACE_FILE=trace.txt -export COB_TRACE_IO=Y -export COB_SET_TRACE=Y -export COB_TRACE_FORMAT=%L%S -export IO_TSPFILE=trace -export IO_TSTFILE=no-trace -./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo "OK: Operations on empty file -Loading sample data file. -Sample data file load complete. -LIST SAMPLE FILE -Key: EPS00000 is EPSILON EQUIPMENT SUPPLY Disk=8417 . -Key: FOR00000 is FORTUNE COOKIE COMPANY Disk=8470 . -Key: GAM00000 is GAMMA X-RAY TECHNOLOGY Disk=8417 . -Key: GIB00000 is GIBRALTER LIFE INSURANCE Disk=8417 . -Key: H&J00000 is H & J PLUMBING SUPPLIES Disk=8470 . -Key: INC00000 is INCREMENTAL BACKUP CORP. Disk=8417 . -Key: JOH00000 is JOHNSON BOATING SUPPLIES Disk=8417 . -Key: KON00000 is KONFLAB PLASTIC PRODUCTS. Disk=8417 . -Key: LEW00000 is LEWISTON GRAPHICS LTD. Disk=8470 . -Key: MOR00000 is MORNINGSIDE CARPENTRY. Disk=8470 . -Key: NEW00000 is NEW WAVE SURF SHOPS INC. Disk=8470 . -Stop read after: 11 -LIST SAMPLE FILE DESCENDING -Key: NEW00000 is NEW WAVE SURF SHOPS INC. Disk=8470 . -Key: MOR00000 is MORNINGSIDE CARPENTRY. Disk=8470 . -Key: LEW00000 is LEWISTON GRAPHICS LTD. Disk=8470 . -Key: KON00000 is KONFLAB PLASTIC PRODUCTS. Disk=8417 . -Key: JOH00000 is JOHNSON BOATING SUPPLIES Disk=8417 . -Key: INC00000 is INCREMENTAL BACKUP CORP. Disk=8417 . -Key: H&J00000 is H & J PLUMBING SUPPLIES Disk=8470 . -Key: GIB00000 is GIBRALTER LIFE INSURANCE Disk=8417 . -Key: GAM00000 is GAMMA X-RAY TECHNOLOGY Disk=8417 . -Key: FOR00000 is FORTUNE COOKIE COMPANY Disk=8470 . -Key: EPS00000 is EPSILON EQUIPMENT SUPPLY Disk=8417 . -Got: BET00000 is BETA SHOE MFG. INC. Disk=8470 . -Nxt: DEL00000 is DELTA LUGGAGE REPAIRS Disk=8470 . -Ky2: GIB00000 is GIBRALTER LIFE INSURANCE Mach=UNI-80/6. - Write: GIB00000 got 22 as expected - Read: GAM00000 got 00 as expected 00075 terminals -ReWrite: GAM00000 got 00/02 as expected 00080 terminals - Read: BET00000 got 00 as expected 00034 terminals -ReWrite: GAM00000 got 00/02 as expected -ReWrite: FOR00000 got 00/02 as expected -Expected ERROR 39 opening TSTFILE, Record size different -" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_file.at:13495" -$at_failed && at_fn_log_failure -$at_traceon; } - - -# not merged yet: -#export COB_TRACE_IO=Y -#export IO_TSPFILE=trace -#export IO_TSTFILE=no-trace - -{ set +x -$as_echo "$at_srcdir/run_file.at:13547: COB_TRACE_FILE=trace.txt \\ -COB_SET_TRACE=Y \\ -COB_TRACE_FORMAT=\" Line: %L %S\" \\ -\$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_notrace 'an embedded newline' "run_file.at:13547" -( $at_check_trace; COB_TRACE_FILE=trace.txt \ -COB_SET_TRACE=Y \ -COB_TRACE_FORMAT=" Line: %L %S" \ -$COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo "OK: Operations on empty file -Loading sample data file. -Sample data file load complete. -LIST SAMPLE FILE -Key: EPS00000 is EPSILON EQUIPMENT SUPPLY Disk=8417 . -Key: FOR00000 is FORTUNE COOKIE COMPANY Disk=8470 . -Key: GAM00000 is GAMMA X-RAY TECHNOLOGY Disk=8417 . -Key: GIB00000 is GIBRALTER LIFE INSURANCE Disk=8417 . -Key: H&J00000 is H & J PLUMBING SUPPLIES Disk=8470 . -Key: INC00000 is INCREMENTAL BACKUP CORP. Disk=8417 . -Key: JOH00000 is JOHNSON BOATING SUPPLIES Disk=8417 . -Key: KON00000 is KONFLAB PLASTIC PRODUCTS. Disk=8417 . -Key: LEW00000 is LEWISTON GRAPHICS LTD. Disk=8470 . -Key: MOR00000 is MORNINGSIDE CARPENTRY. Disk=8470 . -Key: NEW00000 is NEW WAVE SURF SHOPS INC. Disk=8470 . -Stop read after: 11 -LIST SAMPLE FILE DESCENDING -Key: NEW00000 is NEW WAVE SURF SHOPS INC. Disk=8470 . -Key: MOR00000 is MORNINGSIDE CARPENTRY. Disk=8470 . -Key: LEW00000 is LEWISTON GRAPHICS LTD. Disk=8470 . -Key: KON00000 is KONFLAB PLASTIC PRODUCTS. Disk=8417 . -Key: JOH00000 is JOHNSON BOATING SUPPLIES Disk=8417 . -Key: INC00000 is INCREMENTAL BACKUP CORP. Disk=8417 . -Key: H&J00000 is H & J PLUMBING SUPPLIES Disk=8470 . -Key: GIB00000 is GIBRALTER LIFE INSURANCE Disk=8417 . -Key: GAM00000 is GAMMA X-RAY TECHNOLOGY Disk=8417 . -Key: FOR00000 is FORTUNE COOKIE COMPANY Disk=8470 . -Key: EPS00000 is EPSILON EQUIPMENT SUPPLY Disk=8417 . -Got: BET00000 is BETA SHOE MFG. INC. Disk=8470 . -Nxt: DEL00000 is DELTA LUGGAGE REPAIRS Disk=8470 . -Ky2: GIB00000 is GIBRALTER LIFE INSURANCE Mach=UNI-80/6. - Write: GIB00000 got 22 as expected - Read: GAM00000 got 00 as expected 00075 terminals -ReWrite: GAM00000 got 00/02 as expected 00080 terminals - Read: BET00000 got 00 as expected 00034 terminals -ReWrite: GAM00000 got 00/02 as expected -ReWrite: FOR00000 got 00/02 as expected -Expected ERROR 39 opening TSTFILE, Record size different -" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_file.at:13547" -$at_failed && at_fn_log_failure -$at_traceon; } - - - - - -cat >reference <<'_ATEOF' -Source: 'prog.cob' -Program-Id: prog - Line: 290 Entry: prog - Line: 292 Paragraph: MAINFILE - Line: 293 OPEN - Line: 294 CLOSE - Line: 296 OPEN - Line: 297 MOVE - Line: 298 READ - Line: 299 IF - Line: 304 MOVE - Line: 305 START - Line: 306 IF - Line: 311 READ - Line: 312 IF - Line: 317 DISPLAY - Line: 318 CLOSE - Line: 320 PERFORM - Line: 335 Paragraph: LOADFILE - Line: 336 DISPLAY - Line: 339 OPEN - Line: 340 IF - Line: 346 PERFORM - Line: 358 Paragraph: 1000-LOAD-RECORD - Line: 360 MOVE - Line: 361 MOVE - Line: 362 MOVE - Line: 363 MOVE - Line: 364 MOVE - Line: 365 MOVE - Line: 366 MOVE - Line: 367 MOVE - Line: 368 MOVE - Line: 369 MOVE - Line: 370 MOVE - Line: 372 IF - Line: 373 MOVE - Line: 374 MOVE - Line: 375 MOVE - Line: 381 WRITE - Line: 382 IF - Line: 358 Paragraph: 1000-LOAD-RECORD - Line: 360 MOVE - Line: 361 MOVE - Line: 362 MOVE - Line: 363 MOVE - Line: 364 MOVE - Line: 365 MOVE - Line: 366 MOVE - Line: 367 MOVE - Line: 368 MOVE - Line: 369 MOVE - Line: 370 MOVE - Line: 372 IF - Line: 377 MOVE - Line: 378 MOVE - Line: 379 MOVE - Line: 381 WRITE - Line: 382 IF - Line: 358 Paragraph: 1000-LOAD-RECORD - Line: 360 MOVE - Line: 361 MOVE - Line: 362 MOVE - Line: 363 MOVE - Line: 364 MOVE - Line: 365 MOVE - Line: 366 MOVE - Line: 367 MOVE - Line: 368 MOVE - Line: 369 MOVE - Line: 370 MOVE - Line: 372 IF - Line: 373 MOVE - Line: 374 MOVE - Line: 375 MOVE - Line: 381 WRITE - Line: 382 IF - Line: 358 Paragraph: 1000-LOAD-RECORD - Line: 360 MOVE - Line: 361 MOVE - Line: 362 MOVE - Line: 363 MOVE - Line: 364 MOVE - Line: 365 MOVE - Line: 366 MOVE - Line: 367 MOVE - Line: 368 MOVE - Line: 369 MOVE - Line: 370 MOVE - Line: 372 IF - Line: 377 MOVE - Line: 378 MOVE - Line: 379 MOVE - Line: 381 WRITE - Line: 382 IF - Line: 358 Paragraph: 1000-LOAD-RECORD - Line: 360 MOVE - Line: 361 MOVE - Line: 362 MOVE - Line: 363 MOVE - Line: 364 MOVE - Line: 365 MOVE - Line: 366 MOVE - Line: 367 MOVE - Line: 368 MOVE - Line: 369 MOVE - Line: 370 MOVE - Line: 372 IF - Line: 373 MOVE - Line: 374 MOVE - Line: 375 MOVE - Line: 381 WRITE - Line: 382 IF - Line: 358 Paragraph: 1000-LOAD-RECORD - Line: 360 MOVE - Line: 361 MOVE - Line: 362 MOVE - Line: 363 MOVE - Line: 364 MOVE - Line: 365 MOVE - Line: 366 MOVE - Line: 367 MOVE - Line: 368 MOVE - Line: 369 MOVE - Line: 370 MOVE - Line: 372 IF - Line: 377 MOVE - Line: 378 MOVE - Line: 379 MOVE - Line: 381 WRITE - Line: 382 IF - Line: 358 Paragraph: 1000-LOAD-RECORD - Line: 360 MOVE - Line: 361 MOVE - Line: 362 MOVE - Line: 363 MOVE - Line: 364 MOVE - Line: 365 MOVE - Line: 366 MOVE - Line: 367 MOVE - Line: 368 MOVE - Line: 369 MOVE - Line: 370 MOVE - Line: 372 IF - Line: 373 MOVE - Line: 374 MOVE - Line: 375 MOVE - Line: 381 WRITE - Line: 382 IF - Line: 358 Paragraph: 1000-LOAD-RECORD - Line: 360 MOVE - Line: 361 MOVE - Line: 362 MOVE - Line: 363 MOVE - Line: 364 MOVE - Line: 365 MOVE - Line: 366 MOVE - Line: 367 MOVE - Line: 368 MOVE - Line: 369 MOVE - Line: 370 MOVE - Line: 372 IF - Line: 377 MOVE - Line: 378 MOVE - Line: 379 MOVE - Line: 381 WRITE - Line: 382 IF - Line: 358 Paragraph: 1000-LOAD-RECORD - Line: 360 MOVE - Line: 361 MOVE - Line: 362 MOVE - Line: 363 MOVE - Line: 364 MOVE - Line: 365 MOVE - Line: 366 MOVE - Line: 367 MOVE - Line: 368 MOVE - Line: 369 MOVE - Line: 370 MOVE - Line: 372 IF - Line: 373 MOVE - Line: 374 MOVE - Line: 375 MOVE - Line: 381 WRITE - Line: 382 IF - Line: 358 Paragraph: 1000-LOAD-RECORD - Line: 360 MOVE - Line: 361 MOVE - Line: 362 MOVE - Line: 363 MOVE - Line: 364 MOVE - Line: 365 MOVE - Line: 366 MOVE - Line: 367 MOVE - Line: 368 MOVE - Line: 369 MOVE - Line: 370 MOVE - Line: 372 IF - Line: 373 MOVE - Line: 374 MOVE - Line: 375 MOVE - Line: 381 WRITE - Line: 382 IF - Line: 358 Paragraph: 1000-LOAD-RECORD - Line: 360 MOVE - Line: 361 MOVE - Line: 362 MOVE - Line: 363 MOVE - Line: 364 MOVE - Line: 365 MOVE - Line: 366 MOVE - Line: 367 MOVE - Line: 368 MOVE - Line: 369 MOVE - Line: 370 MOVE - Line: 372 IF - Line: 373 MOVE - Line: 374 MOVE - Line: 375 MOVE - Line: 381 WRITE - Line: 382 IF - Line: 358 Paragraph: 1000-LOAD-RECORD - Line: 360 MOVE - Line: 361 MOVE - Line: 362 MOVE - Line: 363 MOVE - Line: 364 MOVE - Line: 365 MOVE - Line: 366 MOVE - Line: 367 MOVE - Line: 368 MOVE - Line: 369 MOVE - Line: 370 MOVE - Line: 372 IF - Line: 377 MOVE - Line: 378 MOVE - Line: 379 MOVE - Line: 381 WRITE - Line: 382 IF - Line: 358 Paragraph: 1000-LOAD-RECORD - Line: 360 MOVE - Line: 361 MOVE - Line: 362 MOVE - Line: 363 MOVE - Line: 364 MOVE - Line: 365 MOVE - Line: 366 MOVE - Line: 367 MOVE - Line: 368 MOVE - Line: 369 MOVE - Line: 370 MOVE - Line: 372 IF - Line: 377 MOVE - Line: 378 MOVE - Line: 379 MOVE - Line: 381 WRITE - Line: 382 IF - Line: 358 Paragraph: 1000-LOAD-RECORD - Line: 360 MOVE - Line: 361 MOVE - Line: 362 MOVE - Line: 363 MOVE - Line: 364 MOVE - Line: 365 MOVE - Line: 366 MOVE - Line: 367 MOVE - Line: 368 MOVE - Line: 369 MOVE - Line: 370 MOVE - Line: 372 IF - Line: 377 MOVE - Line: 378 MOVE - Line: 379 MOVE - Line: 381 WRITE - Line: 382 IF - Line: 358 Paragraph: 1000-LOAD-RECORD - Line: 360 MOVE - Line: 361 MOVE - Line: 362 MOVE - Line: 363 MOVE - Line: 364 MOVE - Line: 365 MOVE - Line: 366 MOVE - Line: 367 MOVE - Line: 368 MOVE - Line: 369 MOVE - Line: 370 MOVE - Line: 372 IF - Line: 377 MOVE - Line: 378 MOVE - Line: 379 MOVE - Line: 381 WRITE - Line: 382 IF - Line: 358 Paragraph: 1000-LOAD-RECORD - Line: 360 MOVE - Line: 361 MOVE - Line: 362 MOVE - Line: 363 MOVE - Line: 364 MOVE - Line: 365 MOVE - Line: 366 MOVE - Line: 367 MOVE - Line: 368 MOVE - Line: 369 MOVE - Line: 370 MOVE - Line: 372 IF - Line: 377 MOVE - Line: 378 MOVE - Line: 379 MOVE - Line: 381 WRITE - Line: 382 IF - Line: 350 DISPLAY - Line: 352 CLOSE - Line: 321 PERFORM - Line: 387 Paragraph: LISTFILE - Line: 388 DISPLAY - Line: 389 OPEN - Line: 390 MOVE - Line: 391 MOVE - Line: 392 START - Line: 393 READ - Line: 394 READ - Line: 395 CLOSE - Line: 397 MOVE - Line: 398 OPEN - Line: 399 IF - Line: 404 MOVE - Line: 405 MOVE - Line: 406 START - Line: 407 READ - Line: 408 READ - Line: 410 MOVE - Line: 411 MOVE - Line: 412 START - Line: 413 IF - Line: 418 READ - Line: 419 IF - Line: 424 PERFORM - Line: 426 DISPLAY - Line: 429 ADD - Line: 430 READ - Line: 434 ADD - Line: 426 DISPLAY - Line: 429 ADD - Line: 430 READ - Line: 434 ADD - Line: 426 DISPLAY - Line: 429 ADD - Line: 430 READ - Line: 434 ADD - Line: 426 DISPLAY - Line: 429 ADD - Line: 430 READ - Line: 434 ADD - Line: 426 DISPLAY - Line: 429 ADD - Line: 430 READ - Line: 434 ADD - Line: 426 DISPLAY - Line: 429 ADD - Line: 430 READ - Line: 434 ADD - Line: 426 DISPLAY - Line: 429 ADD - Line: 430 READ - Line: 434 ADD - Line: 426 DISPLAY - Line: 429 ADD - Line: 430 READ - Line: 434 ADD - Line: 426 DISPLAY - Line: 429 ADD - Line: 430 READ - Line: 434 ADD - Line: 426 DISPLAY - Line: 429 ADD - Line: 430 READ - Line: 434 ADD - Line: 426 DISPLAY - Line: 429 ADD - Line: 430 READ - Line: 434 ADD - Line: 436 IF - Line: 439 DISPLAY - Line: 442 DISPLAY - Line: 443 MOVE - Line: 444 START - Line: 445 IF - Line: 450 READ - Line: 451 IF - Line: 456 PERFORM - Line: 458 DISPLAY - Line: 461 READ - Line: 465 ADD - Line: 458 DISPLAY - Line: 461 READ - Line: 465 ADD - Line: 458 DISPLAY - Line: 461 READ - Line: 465 ADD - Line: 458 DISPLAY - Line: 461 READ - Line: 465 ADD - Line: 458 DISPLAY - Line: 461 READ - Line: 465 ADD - Line: 458 DISPLAY - Line: 461 READ - Line: 465 ADD - Line: 458 DISPLAY - Line: 461 READ - Line: 465 ADD - Line: 458 DISPLAY - Line: 461 READ - Line: 465 ADD - Line: 458 DISPLAY - Line: 461 READ - Line: 465 ADD - Line: 458 DISPLAY - Line: 461 READ - Line: 465 ADD - Line: 458 DISPLAY - Line: 461 READ - Line: 465 ADD - Line: 468 CLOSE - Line: 470 OPEN - Line: 471 MOVE - Line: 472 MOVE - Line: 473 MOVE - Line: 474 READ - Line: 475 IF - Line: 479 MOVE - Line: 480 MOVE - Line: 481 READ - Line: 482 IF - Line: 486 DISPLAY - Line: 490 READ - Line: 491 IF - Line: 495 DISPLAY - Line: 499 MOVE - Line: 500 MOVE - Line: 501 READ - Line: 502 IF - Line: 506 DISPLAY - Line: 510 WRITE - Line: 511 IF - Line: 515 DISPLAY - Line: 518 MOVE - Line: 519 MOVE - Line: 520 READ - Line: 521 DISPLAY - Line: 525 ADD - Line: 526 REWRITE - Line: 527 IF - Line: 533 DISPLAY - Line: 538 MOVE - Line: 539 MOVE - Line: 540 READ - Line: 541 DISPLAY - Line: 545 MOVE - Line: 546 MOVE - Line: 547 REWRITE - Line: 548 IF - Line: 553 DISPLAY - Line: 557 MOVE - Line: 558 MOVE - Line: 559 READ - Line: 560 MOVE - Line: 561 MOVE - Line: 562 REWRITE - Line: 563 IF - Line: 568 DISPLAY - Line: 572 DELETE - Line: 573 CLOSE - Line: 322 OPEN - Line: 323 IF - Line: 324 DISPLAY - Line: 332 PERFORM - Line: 575 Paragraph: LOADFLAT - Line: 576 OPEN - Line: 577 PERFORM - Line: 589 Paragraph: FLAT-RECORD - Line: 591 MOVE - Line: 592 MOVE - Line: 593 MOVE - Line: 594 MOVE - Line: 595 MOVE - Line: 596 MOVE - Line: 597 IF - Line: 598 MOVE - Line: 601 WRITE - Line: 589 Paragraph: FLAT-RECORD - Line: 591 MOVE - Line: 592 MOVE - Line: 593 MOVE - Line: 594 MOVE - Line: 595 MOVE - Line: 596 MOVE - Line: 597 IF - Line: 600 MOVE - Line: 601 WRITE - Line: 589 Paragraph: FLAT-RECORD - Line: 591 MOVE - Line: 592 MOVE - Line: 593 MOVE - Line: 594 MOVE - Line: 595 MOVE - Line: 596 MOVE - Line: 597 IF - Line: 598 MOVE - Line: 601 WRITE - Line: 589 Paragraph: FLAT-RECORD - Line: 591 MOVE - Line: 592 MOVE - Line: 593 MOVE - Line: 594 MOVE - Line: 595 MOVE - Line: 596 MOVE - Line: 597 IF - Line: 600 MOVE - Line: 601 WRITE - Line: 589 Paragraph: FLAT-RECORD - Line: 591 MOVE - Line: 592 MOVE - Line: 593 MOVE - Line: 594 MOVE - Line: 595 MOVE - Line: 596 MOVE - Line: 597 IF - Line: 598 MOVE - Line: 601 WRITE - Line: 581 CLOSE - Line: 582 OPEN - Line: 583 MOVE - Line: 584 READ - Line: 585 MOVE - Line: 586 READ - Line: 587 CLOSE - Line: 333 STOP RUN -_ATEOF - -# hack for not checking Status 02 as this isn't returned by all -# ISAM implementations - -{ set +x -$as_echo "$at_srcdir/run_file.at:14138: sed -e 's/WRITE TSPFILE Status: 02/WRITE TSPFILE Status: 00/g' \\ -reference > references" -at_fn_check_prepare_notrace 'an embedded newline' "run_file.at:14138" -( $at_check_trace; sed -e 's/WRITE TSPFILE Status: 02/WRITE TSPFILE Status: 00/g' \ -reference > references -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_file.at:14138" -$at_failed && at_fn_log_failure \ -"./trace.txt" -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_file.at:14140: sed -e 's/WRITE TSPFILE Status: 02/WRITE TSPFILE Status: 00/g' \\ --e 's/'\"OPEN OUTPUT TSPFILE -> 'testisam' Status: 05\"'/'\"OPEN OUTPUT TSPFILE -> 'testisam' Status: 00\"'/g' \\ -trace.txt > traces.txt" -at_fn_check_prepare_notrace 'an embedded newline' "run_file.at:14140" -( $at_check_trace; sed -e 's/WRITE TSPFILE Status: 02/WRITE TSPFILE Status: 00/g' \ --e 's/'"OPEN OUTPUT TSPFILE -> 'testisam' Status: 05"'/'"OPEN OUTPUT TSPFILE -> 'testisam' Status: 00"'/g' \ -trace.txt > traces.txt -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_file.at:14140" -$at_failed && at_fn_log_failure \ -"./trace.txt" -$at_traceon; } - - -{ set +x -$as_echo "$at_srcdir/run_file.at:14144: gcdiff references traces.txt" -at_fn_check_prepare_trace "run_file.at:14144" -( $at_check_trace; gcdiff references traces.txt -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_file.at:14144" -$at_failed && at_fn_log_failure \ -"./trace.txt" -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_781 -#AT_START_782 -at_fn_group_banner 782 'run_file.at:14149' \ - "RELATIVE File Locking" " " 4 -at_xfail=no -( - $as_echo "782. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -# has timing issues - just skip until resolved later -$as_echo "run_file.at:14153" >"$at_check_line_file" -at_fn_check_skip 77 "$at_srcdir/run_file.at:14153" - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - CONFIGURATION SECTION. - - INPUT-OUTPUT SECTION. - FILE-CONTROL. - SELECT FLATFILE ASSIGN EXTERNAL RELFIX - ORGANIZATION RELATIVE - ACCESS IS SEQUENTIAL RELATIVE KEY IS REC-NUM - FILE STATUS IS CUST-STAT. - - SELECT FLATFILE2 ASSIGN EXTERNAL RELFIX - ORGANIZATION RELATIVE - ACCESS IS RANDOM RELATIVE KEY IS REC-NUM - FILE STATUS IS CUST-STAT. - - SELECT LOCKFILE ASSIGN EXTERNAL RELLCK - ORGANIZATION RELATIVE - SHARING READ ONLY - ACCESS IS RANDOM RELATIVE KEY IS LCK-REC - FILE STATUS IS CUST-STAT. - - SELECT OPTIONAL REPORTIT ASSIGN TO REPORT-FILE - ORGANIZATION LINE SEQUENTIAL. - - DATA DIVISION. - FILE SECTION. - FD REPORTIT - BLOCK CONTAINS 5 RECORDS. - - 01 REPORT-RECORD PIC X(80). - - FD FLATFILE - BLOCK CONTAINS 5 RECORDS. - - 01 TSPFL-RECORD. - 10 CM-CUST-NUM PICTURE X(8). - 10 CM-COMPANY PICTURE X(25). - 10 CM-DISK PICTURE X(8). - 10 CM-NO-TERMINALS PICTURE 9(4). - - FD FLATFILE2 - BLOCK CONTAINS 5 RECORDS. - - 01 TSP2-RECORD. - 10 C2-CUST-NUM PICTURE X(8). - 10 C2-COMPANY PICTURE X(25). - 10 C2-DISK PICTURE X(8). - 10 C2-NO-TERMINALS PICTURE S9(4). - - FD LOCKFILE - BLOCK CONTAINS 5 RECORDS. - - 01 LCK-RECORD. - 10 LCK-NUM PICTURE 9(3). - 10 LCK-TBL PICTURE X OCCURS 4 TIMES. - 10 LCK-MESSAGE PICTURE X(25). - - WORKING-STORAGE SECTION. - - 77 MAX-SUB PICTURE 9(4) VALUE 6. - 77 CUST-STAT PICTURE X(2). - 77 REC-NUM PICTURE 9(4) VALUE 1. - 77 LCK-REC PICTURE 9(4) VALUE 1. - 77 SLP-TIME PICTURE 9(9) BINARY VALUE 1. - 77 REPORT-FILE PICTURE X(32) VALUE "parent.txt". - - 01 TEST-DATA. - - 02 DATA-CUST-NUM-TBL. - - 05 FILLER PIC X(8) VALUE "ALP00000". - 05 FILLER PIC X(8) VALUE "BET00000". - 05 FILLER PIC X(8) VALUE "DEL00000". - 05 FILLER PIC X(8) VALUE "EPS00000". - 05 FILLER PIC X(8) VALUE "FOR00000". - 05 FILLER PIC X(8) VALUE "GAM00000". - - 02 DATA-CUST-NUM REDEFINES DATA-CUST-NUM-TBL - PIC X(8) OCCURS 6. - 02 DATA-COMPANY-TBL. - - 05 FILLER PIC X(25) VALUE "ALPHA ELECTRICAL CO. LTD.". - 05 FILLER PIC X(25) VALUE "BETA SHOE MFG. INC. ". - 05 FILLER PIC X(25) VALUE "DELTA LUGGAGE REPAIRS ". - 05 FILLER PIC X(25) VALUE "EPSILON EQUIPMENT SUPPLY ". - 05 FILLER PIC X(25) VALUE "FORTUNE COOKIE COMPANY ". - 05 FILLER PIC X(25) VALUE "GAMMA X-RAY TECHNOLOGY ". - 02 DATA-COMPANY REDEFINES DATA-COMPANY-TBL - PIC X(25) OCCURS 6. - 02 DATA-ADDRESS-2-TBL. - - 05 FILLER PIC X(10) VALUE "ATLANTA ". - 05 FILLER PIC X(10) VALUE "CALGARY ". - 05 FILLER PIC X(10) VALUE "NEW YORK ". - 05 FILLER PIC X(10) VALUE "TORONTO ". - 05 FILLER PIC X(10) VALUE "WASHINGTON". - 05 FILLER PIC X(10) VALUE "WHITEPLAIN". - 02 DATA-ADDRESS REDEFINES DATA-ADDRESS-2-TBL - PIC X(10) OCCURS 6. - - 01 WORK-AREA. - 05 SUB PICTURE 9(4) COMP SYNC. - 88 ODD-RECORD VALUE 1 3 5. - - 01 CMD-LINE PIC X(64). - 01 WMI PIC X(7). - 01 SEQ PIC 9(2) VALUE 0. - 01 MSG PIC X(64) VALUE " ". - - PROCEDURE DIVISION. - - ACCEPT CMD-LINE FROM COMMAND-LINE. - CALL "C$TOUPPER" USING CMD-LINE BY VALUE LENGTH OF CMD-LINE. - MOVE SPACES TO REPORT-RECORD. - EVALUATE CMD-LINE - WHEN SPACES - MOVE "control.txt" TO REPORT-FILE - OPEN EXTEND REPORTIT - MOVE "Control" TO WMI - PERFORM LOADFILE - PERFORM LOCK-EXCLUSIVE - CALL "SYSTEM" USING "./prog PARENT &" - CALL "SYSTEM" USING "./prog CHILD &" - CALL "C$SLEEP" USING 2 - MOVE "continue test " TO MSG - PERFORM DISPLAY-IT - PERFORM LOCK-RELEASE - CALL "C$SLEEP" USING 2 - PERFORM LOCK-EXCLUSIVE - MOVE "waiting step 1 completion " TO MSG - PERFORM DISPLAY-IT - CALL "C$SLEEP" USING 1 - PERFORM LOCK-RELEASE - CALL "C$SLEEP" USING 1 - PERFORM LOCK-EXCLUSIVE - CALL "C$SLEEP" USING 1 - PERFORM LOCK-RELEASE - CALL "C$SLEEP" USING 1 - CALL "SYSTEM" USING "./prog LOCK &" - CALL "SYSTEM" USING "./prog READADV &" - CALL "C$SLEEP" USING 6 - MOVE "waiting step 2 completion " TO MSG - PERFORM DISPLAY-IT - PERFORM LOCK-EXCLUSIVE - CALL "SYSTEM" USING "./prog UPDT &" - CALL "SYSTEM" USING "./prog CHILDUP &" - PERFORM LOCK-RELEASE - CALL "C$SLEEP" USING 3 - PERFORM LOCK-EXCLUSIVE - MOVE "waiting step 3 completion " TO MSG - PERFORM DISPLAY-IT - CALL "C$SLEEP" USING 1 - PERFORM LOCK-RELEASE - WHEN "PARENT" - MOVE "parent.txt" TO REPORT-FILE - OPEN EXTEND REPORTIT - MOVE " PARENT" TO WMI - PERFORM LOCK-SHARED - CALL "C$SLEEP" USING 1 - PERFORM READ-FILE - PERFORM LOCK-RELEASE - CALL "C$SLEEP" USING 2 - PERFORM LOCK-SHARED - PERFORM READ-FILE-NO-SHARE - PERFORM READ-FILE-RETRY-SHARE - PERFORM READ-FILE-RETRY-SHORT - PERFORM LOCK-RELEASE - WHEN "CHILD" - MOVE "child.txt" TO REPORT-FILE - OPEN EXTEND REPORTIT - MOVE " CHILD" TO WMI - PERFORM LOCK-SHARED - CALL "C$SLEEP" USING 2 - PERFORM READ-FILE - PERFORM LOCK-RELEASE - CALL "C$SLEEP" USING 2 - PERFORM LOCK-SHARED - PERFORM READ-FILE-NO-SHARE - PERFORM READ-FILE-RETRY-SHARE - PERFORM READ-FILE-RETRY-SHARE - PERFORM LOCK-RELEASE - WHEN "UPDT" - MOVE "parent.txt" TO REPORT-FILE - OPEN EXTEND REPORTIT - MOVE "Par Upd" TO WMI - PERFORM LOCK-SHARED - PERFORM UPDT-SHARE - PERFORM LOCK-RELEASE - WHEN "CHILDUP" - MOVE "child.txt" TO REPORT-FILE - OPEN EXTEND REPORTIT - MOVE "Cld Upd" TO WMI - MOVE 1 TO SLP-TIME - PERFORM LOCK-SHARED - PERFORM UPDT-SHARE - PERFORM LOCK-RELEASE - WHEN "LOCK" - MOVE "parent.txt" TO REPORT-FILE - OPEN EXTEND REPORTIT - MOVE "Par Lck" TO WMI - PERFORM READ-FILE-ADV - OPEN I-O SHARING ALL OTHER FLATFILE2 - MOVE 1 TO REC-NUM - READ FLATFILE2 WITH LOCK - DELETE FLATFILE2 - STRING "Deleted " C2-CUST-NUM " 1 Sts:" - CUST-STAT INTO MSG - PERFORM DISPLAY-IT - MOVE 3 TO REC-NUM - READ FLATFILE2 WITH LOCK - STRING "Read " C2-CUST-NUM " Locked 3 Sts:" - CUST-STAT INTO MSG - PERFORM DISPLAY-IT - CALL "C$SLEEP" USING 4 - CLOSE FLATFILE2 - WHEN "READADV" - MOVE "child.txt" TO REPORT-FILE - OPEN EXTEND REPORTIT - MOVE "Cld Adv" TO WMI - CALL "C$SLEEP" USING 2 - PERFORM READ-FILE-ADV - MOVE "Cld Ign" TO WMI - PERFORM READ-FILE-IGN - END-EVALUATE. - MOVE "ending " TO MSG - PERFORM DISPLAY-IT - CLOSE REPORTIT. - STOP RUN. - - READ-FILE. - OPEN INPUT FLATFILE. - STRING "READ Open Sts:" CUST-STAT INTO MSG - PERFORM DISPLAY-IT - PERFORM 2 TIMES - PERFORM READ-NEXT - CALL "C$SLEEP" USING 1 - END-PERFORM. - CLOSE FLATFILE. - - READ-FILE-NO-SHARE. - OPEN INPUT SHARING NO OTHER FLATFILE. - STRING "NO SHARE Open Sts:" CUST-STAT INTO MSG - PERFORM DISPLAY-IT - IF CUST-STAT = "00" - PERFORM 2 TIMES - PERFORM READ-NEXT - CALL "C$SLEEP" USING 1 - END-PERFORM - CLOSE FLATFILE - ELSE - PERFORM READ-NEXT - CALL "C$SLEEP" USING 1 - CLOSE FLATFILE - CALL "C$SLEEP" USING 1 - END-IF. - - READ-FILE-RETRY-SHARE. - OPEN INPUT SHARING NO OTHER RETRY 10 SECONDS FLATFILE. - STRING "RETRY SHARE Open Sts:" CUST-STAT INTO MSG - PERFORM DISPLAY-IT - IF CUST-STAT = "00" - PERFORM 2 TIMES - PERFORM READ-NEXT - CALL "C$SLEEP" USING 1 - END-PERFORM - CLOSE FLATFILE - ELSE - PERFORM READ-NEXT - CALL "C$SLEEP" USING 1 - CLOSE FLATFILE - CALL "C$SLEEP" USING 1 - END-IF. - - READ-FILE-RETRY-SHORT. - OPEN INPUT SHARING NO OTHER RETRY 2 SECONDS FLATFILE. - STRING "RETRY SHORT Open Sts:" CUST-STAT INTO MSG - PERFORM DISPLAY-IT - IF CUST-STAT = "00" - PERFORM 2 TIMES - PERFORM READ-NEXT - CALL "C$SLEEP" USING 1 - END-PERFORM - CLOSE FLATFILE - ELSE - PERFORM READ-NEXT - CALL "C$SLEEP" USING 1 - CLOSE FLATFILE - CALL "C$SLEEP" USING 1 - END-IF. - - UPDT-SHARE. - OPEN I-O SHARING ALL OTHER FLATFILE2. - MOVE 3 TO REC-NUM. - CALL "C$SLEEP" USING SLP-TIME - READ FLATFILE2 - STRING "Read " C2-CUST-NUM " no lock Sts:" CUST-STAT - INTO MSG - PERFORM DISPLAY-IT. - ADD 1 TO C2-NO-TERMINALS - REWRITE FILE FLATFILE2 FROM TSP2-RECORD WITH NO LOCK - * REWRITE TSP2-RECORD WITH NO LOCK - STRING "REWRITE " C2-CUST-NUM " Trms:" C2-NO-TERMINALS - " Sts:" CUST-STAT INTO MSG - PERFORM DISPLAY-IT - - READ FLATFILE2 WITH LOCK - STRING "Read " C2-CUST-NUM " with LOCK Sts:" CUST-STAT - INTO MSG - PERFORM DISPLAY-IT. - CALL "C$SLEEP" USING 2 - READ FLATFILE2 WITH LOCK - STRING "Re-Read " C2-CUST-NUM " with LOCK Sts:" CUST-STAT - INTO MSG - PERFORM DISPLAY-IT. - REWRITE TSP2-RECORD WITH NO LOCK - STRING "REWRITE " C2-CUST-NUM " Trms:" C2-NO-TERMINALS - " Sts:" CUST-STAT INTO MSG - PERFORM DISPLAY-IT - - READ FLATFILE2 WITH LOCK - STRING "Read " C2-CUST-NUM " and LOCK Sts:" CUST-STAT - INTO MSG - PERFORM DISPLAY-IT. - - MOVE 2 TO REC-NUM. - MOVE DATA-CUST-NUM (REC-NUM) TO C2-CUST-NUM - MOVE WMI TO C2-CUST-NUM (3:6) - REWRITE TSP2-RECORD RETRY 10 SECONDS WITH NO LOCK - STRING "REWRITE " C2-CUST-NUM " No read! " - " Sts:" CUST-STAT INTO MSG - PERFORM DISPLAY-IT - CLOSE FLATFILE2. - - READ-NEXT. - MOVE SPACES TO TSPFL-RECORD. - READ FLATFILE NEXT - IF CUST-STAT NOT = "00" - STRING "Read Next Sts:" CUST-STAT - INTO MSG - ELSE - STRING "Next " CM-CUST-NUM " Trms:" CM-NO-TERMINALS - " #" REC-NUM INTO MSG - END-IF. - PERFORM DISPLAY-IT. - - READ-FILE-ADV. - OPEN INPUT SHARING ALL OTHER FLATFILE - STRING "READ Open Sts:" CUST-STAT INTO MSG - PERFORM DISPLAY-IT - PERFORM 4 TIMES - PERFORM READ-NEXT-ADV - END-PERFORM. - CLOSE FLATFILE. - - READ-NEXT-ADV. - MOVE SPACES TO TSPFL-RECORD. - READ FLATFILE NEXT ADVANCING ON LOCK - IF CUST-STAT NOT = "00" - STRING "Read Next adv Sts:" CUST-STAT - INTO MSG - ELSE - STRING "Nextadv " CM-CUST-NUM " Trms:" CM-NO-TERMINALS - " #" REC-NUM INTO MSG - END-IF. - PERFORM DISPLAY-IT. - - READ-FILE-IGN. - OPEN INPUT SHARING ALL OTHER FLATFILE - STRING "READ Open Sts:" CUST-STAT INTO MSG - PERFORM DISPLAY-IT - PERFORM 4 TIMES - PERFORM READ-NEXT-IGN - END-PERFORM. - CLOSE FLATFILE. - - READ-NEXT-IGN. - MOVE SPACES TO TSPFL-RECORD. - READ FLATFILE NEXT IGNORE LOCK - IF CUST-STAT NOT = "00" - STRING "Read Next ign Sts:" CUST-STAT - INTO MSG - ELSE - STRING "Nextign " CM-CUST-NUM " Trms:" CM-NO-TERMINALS - " #" REC-NUM INTO MSG - END-IF. - PERFORM DISPLAY-IT. - - DISPLAY-IT. - ADD 1 TO SEQ. - STRING WMI " :" SEQ ": " MSG INTO REPORT-RECORD. - WRITE REPORT-RECORD. - MOVE SPACES TO MSG. - MOVE SPACES TO REPORT-RECORD. - - LOCK-EXCLUSIVE. - OPEN I-O SHARING NO OTHER RETRY FOREVER LOCKFILE. - - LOCK-SHARED. - OPEN INPUT SHARING READ ONLY RETRY FOREVER LOCKFILE. - - LOCK-RELEASE. - CLOSE LOCKFILE. - - LOADFILE. - STRING WMI " . . Loading sample program data file" - INTO REPORT-RECORD. - WRITE REPORT-RECORD. - MOVE SPACES TO REPORT-RECORD. - - OPEN OUTPUT LOCKFILE. - MOVE SPACES TO LCK-RECORD. - MOVE ZERO TO LCK-NUM. - MOVE "Lock control" TO LCK-MESSAGE. - WRITE FILE LOCKFILE FROM LCK-RECORD - * WRITE LCK-RECORD. - CLOSE LOCKFILE. - - OPEN OUTPUT FLATFILE. - PERFORM LOAD-RECORD - VARYING SUB FROM 1 BY 1 - UNTIL SUB > MAX-SUB. - - CLOSE FLATFILE. - - LOAD-RECORD. - MOVE SPACES TO TSPFL-RECORD. - MOVE DATA-CUST-NUM (SUB) TO CM-CUST-NUM. - MOVE DATA-COMPANY (SUB) TO CM-COMPANY. - MOVE 10 TO CM-NO-TERMINALS. - IF ODD-RECORD - MOVE "8417" TO CM-DISK - ELSE - MOVE "8470" TO CM-DISK. - WRITE TSPFL-RECORD. -_ATEOF - - -# CHECKME: do we need -std/-fmf-files here? -{ set +x -$as_echo "$at_srcdir/run_file.at:14595: \$COMPILE -std=mf -fmf-files prog.cob" -at_fn_check_prepare_dynamic "$COMPILE -std=mf -fmf-files prog.cob" "run_file.at:14595" -( $at_check_trace; $COMPILE -std=mf -fmf-files prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_file.at:14595" -$at_failed && at_fn_log_failure -$at_traceon; } - - -{ set +x -$as_echo "$at_srcdir/run_file.at:14597: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_file.at:14597" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_file.at:14597" -$at_failed && at_fn_log_failure -$at_traceon; } - - - - - -cat >reference <<'_ATEOF' -Control . . Loading sample program data file -Control :01: continue test -Control :02: waiting step 1 completion -Control :03: waiting step 2 completion -Control :04: waiting step 3 completion -Control :05: ending -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_file.at:14611: diff reference control.txt" -at_fn_check_prepare_trace "run_file.at:14611" -( $at_check_trace; diff reference control.txt -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_file.at:14611" -$at_failed && at_fn_log_failure \ -"./control.txt" -$at_traceon; } - - - - - -cat >reference <<'_ATEOF' - PARENT :01: READ Open Sts:00 - PARENT :02: Next ALP00000 Trms:0010 #0001 - PARENT :03: Next BET00000 Trms:0010 #0002 - PARENT :04: NO SHARE Open Sts:00 - PARENT :05: Next ALP00000 Trms:0010 #0001 - PARENT :06: Next BET00000 Trms:0010 #0002 - PARENT :07: RETRY SHARE Open Sts:00 - PARENT :08: Next ALP00000 Trms:0010 #0001 - PARENT :09: Next BET00000 Trms:0010 #0002 - PARENT :10: RETRY SHORT Open Sts:61 - PARENT :11: Read Next Sts:47 - PARENT :12: ending -Par Lck :01: READ Open Sts:00 -Par Lck :02: Nextadv ALP00000 Trms:0010 #0001 -Par Lck :03: Nextadv BET00000 Trms:0010 #0002 -Par Lck :04: Nextadv DEL00000 Trms:0010 #0003 -Par Lck :05: Nextadv EPS00000 Trms:0010 #0004 -Par Lck :06: Deleted ALP00000 1 Sts:00 -Par Lck :07: Read DEL00000 Locked 3 Sts:00 -Par Lck :08: ending -Par Upd :01: Read DEL00000 no lock Sts:00 -Par Upd :02: REWRITE DEL00000 Trms:0011 Sts:00 -Par Upd :03: Read DEL00000 with LOCK Sts:00 -Par Upd :04: Re-Read DEL00000 with LOCK Sts:00 -Par Upd :05: REWRITE DEL00000 Trms:0011 Sts:00 -Par Upd :06: Read DEL00000 and LOCK Sts:00 -Par Upd :07: REWRITE BEPar Up No read! Sts:00 -Par Upd :08: ending -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_file.at:14647: diff reference parent.txt" -at_fn_check_prepare_trace "run_file.at:14647" -( $at_check_trace; diff reference parent.txt -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_file.at:14647" -$at_failed && at_fn_log_failure \ -"./control.txt" \ -"./parent.txt" -$at_traceon; } - - - - - -cat >reference <<'_ATEOF' - CHILD :01: READ Open Sts:00 - CHILD :02: Next ALP00000 Trms:0010 #0001 - CHILD :03: Next BET00000 Trms:0010 #0002 - CHILD :04: NO SHARE Open Sts:61 - CHILD :05: Read Next Sts:47 - CHILD :06: RETRY SHARE Open Sts:00 - CHILD :07: Next ALP00000 Trms:0010 #0001 - CHILD :08: Next BET00000 Trms:0010 #0002 - CHILD :09: RETRY SHARE Open Sts:00 - CHILD :10: Next ALP00000 Trms:0010 #0001 - CHILD :11: Next BET00000 Trms:0010 #0002 - CHILD :12: ending -Cld Adv :01: READ Open Sts:00 -Cld Adv :02: Nextadv BET00000 Trms:0010 #0002 -Cld Adv :03: Nextadv EPS00000 Trms:0010 #0004 -Cld Adv :04: Nextadv FOR00000 Trms:0010 #0005 -Cld Adv :05: Nextadv GAM00000 Trms:0010 #0006 -Cld Ign :06: READ Open Sts:00 -Cld Ign :07: Nextign BET00000 Trms:0010 #0002 -Cld Ign :08: Nextign DEL00000 Trms:0010 #0003 -Cld Ign :09: Nextign EPS00000 Trms:0010 #0004 -Cld Ign :10: Nextign FOR00000 Trms:0010 #0005 -Cld Ign :11: ending -Cld Upd :01: Read DEL00000 no lock Sts:00 -Cld Upd :02: REWRITE DEL00000 Trms:0012 Sts:51 -Cld Upd :03: Read DEL00000 with LOCK Sts:51 -Cld Upd :04: Re-Read DEL00000 with LOCK Sts:00 -Cld Upd :05: REWRITE DEL00000 Trms:0011 Sts:00 -Cld Upd :06: Read DEL00000 and LOCK Sts:00 -Cld Upd :07: REWRITE BECld Up No read! Sts:00 -Cld Upd :08: ending -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_file.at:14686: diff reference child.txt" -at_fn_check_prepare_trace "run_file.at:14686" -( $at_check_trace; diff reference child.txt -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_file.at:14686" -$at_failed && at_fn_log_failure \ -"./control.txt" \ -"./parent.txt" \ -"./child.txt" -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_782 -#AT_START_783 -at_fn_group_banner 783 'run_file.at:14691' \ - "WRITE and REWRITE FILE name " " " 4 -at_xfail=no -( - $as_echo "783. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - CONFIGURATION SECTION. - - INPUT-OUTPUT SECTION. - FILE-CONTROL. - SELECT FLATFILE ASSIGN EXTERNAL RELFIX - ORGANIZATION RELATIVE - ACCESS IS SEQUENTIAL RELATIVE KEY IS REC-NUM - FILE STATUS IS CUST-STAT. - - SELECT FLATFILE2 ASSIGN EXTERNAL RELFIX - ORGANIZATION RELATIVE - ACCESS IS RANDOM RELATIVE KEY IS REC-NUM - FILE STATUS IS CUST-STAT. - - DATA DIVISION. - FILE SECTION. - FD FLATFILE - BLOCK CONTAINS 5 RECORDS. - - 01 TSPFL-RECORD. - 10 CM-CUST-NUM PICTURE X(8). - 10 CM-COMPANY PICTURE X(25). - 10 CM-DISK PICTURE X(8). - 10 CM-NO-TERMINALS PICTURE 9(4). - - FD FLATFILE2 - BLOCK CONTAINS 5 RECORDS. - - 01 TSP2-RECORD. - 10 C2-CUST-NUM PICTURE X(8). - 10 C2-COMPANY PICTURE X(25). - 10 C2-DISK PICTURE X(8). - 10 C2-NO-TERMINALS PICTURE 9(4). - - WORKING-STORAGE SECTION. - - 77 MAX-SUB VALUE 6 PICTURE 9(4) COMP SYNC. - 77 CUST-STAT PICTURE X(2). - 77 REC-NUM VALUE 1 PICTURE 9(4). - - 01 TEST-DATA. - - 02 DATA-CUST-NUM-TBL. - - 05 FILLER PIC X(8) VALUE "ALP00000". - 05 FILLER PIC X(8) VALUE "BET00000". - 05 FILLER PIC X(8) VALUE "DEL00000". - 05 FILLER PIC X(8) VALUE "EPS00000". - 05 FILLER PIC X(8) VALUE "FOR00000". - 05 FILLER PIC X(8) VALUE "GAM00000". - - 02 DATA-CUST-NUM REDEFINES DATA-CUST-NUM-TBL - PIC X(8) OCCURS 6. - 02 DATA-COMPANY-TBL. - - 05 FILLER PIC X(25) VALUE "ALPHA ELECTRICAL CO. LTD.". - 05 FILLER PIC X(25) VALUE "BETA SHOE MFG. INC. ". - 05 FILLER PIC X(25) VALUE "DELTA LUGGAGE REPAIRS ". - 05 FILLER PIC X(25) VALUE "EPSILON EQUIPMENT SUPPLY ". - 05 FILLER PIC X(25) VALUE "FORTUNE COOKIE COMPANY ". - 05 FILLER PIC X(25) VALUE "GAMMA X-RAY TECHNOLOGY ". - 02 DATA-COMPANY REDEFINES DATA-COMPANY-TBL - PIC X(25) OCCURS 6. - 02 DATA-ADDRESS-2-TBL. - - 05 FILLER PIC X(10) VALUE "ATLANTA ". - 05 FILLER PIC X(10) VALUE "CALGARY ". - 05 FILLER PIC X(10) VALUE "NEW YORK ". - 05 FILLER PIC X(10) VALUE "TORONTO ". - 05 FILLER PIC X(10) VALUE "WASHINGTON". - 05 FILLER PIC X(10) VALUE "WHITEPLAIN". - 02 DATA-ADDRESS REDEFINES DATA-ADDRESS-2-TBL - PIC X(10) OCCURS 6. - - 02 DATA-NO-TERMINALS-TBL. - - 05 FILLER PIC 9(3) COMP-3 VALUE 10. - 05 FILLER PIC 9(3) COMP-3 VALUE 13. - 05 FILLER PIC 9(3) COMP-3 VALUE 75. - 05 FILLER PIC 9(3) COMP-3 VALUE 10. - 05 FILLER PIC 9(3) COMP-3 VALUE 90. - 05 FILLER PIC 9(3) COMP-3 VALUE 254. - - 02 DATA-NO-TERMINALS REDEFINES DATA-NO-TERMINALS-TBL - PIC 9(3) COMP-3 OCCURS 6. - 01 WORK-AREA. - 05 SUB PICTURE 9(4) COMP SYNC. - 88 ODD-RECORD VALUE 1 3 5. - - - PROCEDURE DIVISION. - - PERFORM LOADFILE. - - OPEN I-O FLATFILE2. - MOVE 2 TO REC-NUM - READ FLATFILE2 - DISPLAY "Read " C2-CUST-NUM " Sts:" CUST-STAT - " Trms:" C2-NO-TERMINALS. - ADD 1 TO C2-NO-TERMINALS - REWRITE FILE FLATFILE2 FROM TSP2-RECORD - READ FLATFILE2 - DISPLAY "REWROTE " C2-CUST-NUM " Sts:" CUST-STAT - " Trms:" C2-NO-TERMINALS. - CLOSE FLATFILE2. - STOP RUN. - - LOADFILE. - DISPLAY "Loading sample program data file." - UPON CONSOLE. - - OPEN OUTPUT FLATFILE. - - PERFORM LOAD-RECORD - VARYING SUB FROM 1 BY 1 - UNTIL SUB > MAX-SUB. - - DISPLAY "Sample program data file load complete." - UPON CONSOLE. - CLOSE FLATFILE. - - LOAD-RECORD. - - MOVE SPACES TO TSPFL-RECORD. - MOVE DATA-CUST-NUM (SUB) TO CM-CUST-NUM. - MOVE DATA-COMPANY (SUB) TO CM-COMPANY. - MOVE DATA-NO-TERMINALS (SUB) TO CM-NO-TERMINALS. - IF ODD-RECORD - MOVE "8417" TO CM-DISK - ELSE - MOVE "8470" TO CM-DISK. - WRITE FILE FLATFILE FROM TSPFL-RECORD. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_file.at:14832: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_file.at:14832" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_file.at:14832" -$at_failed && at_fn_log_failure -$at_traceon; } - - -{ set +x -$as_echo "$at_srcdir/run_file.at:14834: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_file.at:14834" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo "Loading sample program data file. -Sample program data file load complete. -Read BET00000 Sts:00 Trms:0013 -REWROTE BET00000 Sts:00 Trms:0014 -" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_file.at:14834" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_783 -#AT_START_784 -at_fn_group_banner 784 'run_file.at:14844' \ - "INDEXED File Locking" " " 4 -at_xfail=no -( - $as_echo "784. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -# has timing issues - just skip until resolved later -$as_echo "run_file.at:14848" >"$at_check_line_file" -at_fn_check_skip 77 "$at_srcdir/run_file.at:14848" - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - - PROGRAM-ID. prog. - - ENVIRONMENT DIVISION. - CONFIGURATION SECTION. - - INPUT-OUTPUT SECTION. - FILE-CONTROL. - SELECT TSPFILE ASSIGN TO "testisam" - ORGANIZATION INDEXED ACCESS DYNAMIC - LOCK MANUAL - * LOCK AUTOMATIC - WITH LOCK ON MULTIPLE RECORDS - * WITH LOCK ON RECORD - SHARING WITH ALL OTHER - RECORD KEY IS PRIME-KEY - SOURCE IS CM-CUST-NUM - - FILE STATUS IS CUST-STAT . - - SELECT LOCKFILE ASSIGN EXTERNAL RELLCK - ORGANIZATION RELATIVE - ACCESS IS RANDOM RELATIVE KEY IS LCK-REC - FILE STATUS IS CUST-STAT. - - SELECT OPTIONAL REPORTIT ASSIGN TO REPORT-FILE - ORGANIZATION LINE SEQUENTIAL. - - DATA DIVISION. - FILE SECTION. - FD LOCKFILE - BLOCK CONTAINS 5 RECORDS. - - 01 LCK-RECORD. - 10 LCK-NUM PICTURE 9(3). - 10 LCK-TBL PICTURE X OCCURS 4 TIMES. - 10 LCK-MESSAGE PICTURE X(25). - - FD REPORTIT - BLOCK CONTAINS 5 RECORDS. - - 01 REPORT-RECORD PICTURE X(80). - - FD TSPFILE - BLOCK CONTAINS 5 RECORDS. - - 01 TSPFL-RECORD. - 05 TSPFL-REC. - 10 CM-CUST-NUM PICTURE X(8). - 10 CM-COMPANY PICTURE X(25). - 10 CM-DISK PICTURE X(8). - 10 CM-NO-TERMINALS PICTURE 9(4). - - WORKING-STORAGE SECTION. - - 01 WS-TIME-NOW. - 05 WS-NOW-HH PIC 9(02) VALUE 0. - 05 WS-NOW-MM PIC 9(02) VALUE 0. - 05 WS-NOW-SS PIC 9(02) VALUE 0. - 05 WS-NOW-HS PIC 9(02) VALUE 0. - - 01 CUST-STAT PIC XX. - 77 BYTE-1 PICTURE 9(3). - 77 BYTE-2 PICTURE 9(3). - 77 MAX-SUB PICTURE 9(2) VALUE 8. - 77 REPORT-FILE PICTURE X(32) VALUE "control.txt". - 77 MSG PICTURE X(70) VALUE SPACES. - 77 CMD-LINE PICTURE X(80) VALUE SPACES. - 77 SEQ PICTURE 99 VALUE 0. - 77 LCK-REC PICTURE 9(4) VALUE 1. - - 01 SAVE-REC PIC X(250). - - 01 TEST-DATA. - 02 DATA-CUST-NUM-TBL. - 05 FILLER PIC X(8) VALUE "ALP00000". - 05 FILLER PIC X(8) VALUE "BET00000". - 05 FILLER PIC X(8) VALUE "CAM00000". - 05 FILLER PIC X(8) VALUE "DEL00000". - 05 FILLER PIC X(8) VALUE "EPS00000". - 05 FILLER PIC X(8) VALUE "FOR00000". - 05 FILLER PIC X(8) VALUE "GIB00000". - 05 FILLER PIC X(8) VALUE "HIJ00000". - - 02 DATA-CUST-NUM REDEFINES DATA-CUST-NUM-TBL - PIC X(8) OCCURS 8. - 02 DATA-COMPANY-TBL. - 05 FILLER PIC X(25) VALUE "ALPHA ELECTRICAL CO. LTD.". - 05 FILLER PIC X(25) VALUE "BETA SHOE MFG. INC. ". - 05 FILLER PIC X(25) VALUE "CAMERA X-RAY TECHNOLOGY ". - 05 FILLER PIC X(25) VALUE "DELTA LUGGAGE REPAIRS ". - 05 FILLER PIC X(25) VALUE "EPSILON EQUIPMENT SUPPLY ". - 05 FILLER PIC X(25) VALUE "FORTUNE COOKIE COMPANY ". - 05 FILLER PIC X(25) VALUE "GIBRALTER LIFE INSURANCE ". - 05 FILLER PIC X(25) VALUE "HECKLE PLUMBING SUPPLIES ". - - 02 DATA-COMPANY REDEFINES DATA-COMPANY-TBL - PIC X(25) OCCURS 8. - - 01 WORK-AREA. - 05 SLP-TIME PICTURE 9(9) BINARY VALUE 1. - 05 SLP-SHORT PICTURE 9(18) BINARY VALUE 20000000. - 05 SLP-LONG PICTURE 9(18) BINARY VALUE 320000000. - 05 LCK-IDX PICTURE 9(4) BINARY VALUE 1. - 05 REC-NUM PICTURE 9(4) VALUE 0. - 05 REC-MAX PICTURE 9(5) COMP VALUE 10. - 05 SUB PICTURE 9(4) COMP SYNC. - 88 ODD-RECORD VALUE 1 3 5 7 9 10 11. - - 05 TSPFL-KEY PICTURE X(8). - 05 WMI PICTURE X(8). - - PROCEDURE DIVISION. - - MAINFILE. - ACCEPT CMD-LINE FROM COMMAND-LINE. - CALL "C$TOUPPER" USING CMD-LINE BY VALUE LENGTH OF CMD-LINE. - MOVE SPACES TO REPORT-RECORD. - EVALUATE CMD-LINE - WHEN SPACES - MOVE "control.txt" TO REPORT-FILE - OPEN EXTEND REPORTIT - MOVE "Control" TO WMI - PERFORM LOADFILE - PERFORM LOCK-INIT - CALL "SYSTEM" USING "./prog PARENT &" - CALL "SYSTEM" USING "./prog CHILD &" - PERFORM LOCK-WAIT-READY - MOVE "continue test " TO MSG - PERFORM DISPLAY-IT - PERFORM LOCK-WAIT-COMPLETE 2 TIMES - MOVE "waiting step 1 completion " TO MSG - PERFORM DISPLAY-IT - PERFORM LOCK-WAIT-COMPLETE 2 TIMES - PERFORM LOCK-INIT - CALL "SYSTEM" USING "./prog LOCK &" - CALL "SYSTEM" USING "./prog READADV &" - PERFORM LOCK-WAIT-READY - MOVE "waiting step 2 completion " TO MSG - PERFORM DISPLAY-IT - PERFORM LOCK-WAIT-COMPLETE - PERFORM LOCK-INIT - CALL "SYSTEM" USING "./prog UPDT &" - CALL "SYSTEM" USING "./prog CHILDUP &" - PERFORM LOCK-WAIT-READY - MOVE "waiting step 3 completion " TO MSG - PERFORM DISPLAY-IT - PERFORM LOCK-WAIT-COMPLETE - WHEN "PARENT" - MOVE "parent.txt" TO REPORT-FILE - OPEN EXTEND REPORTIT - MOVE " PARENT" TO WMI - PERFORM LOCK-READY-AND-GO - PERFORM READ-FILE - PERFORM LOCK-COMPLETE-AND-GO - PERFORM READ-FILE-NO-SHARE - PERFORM LOCK-COMPLETE-AND-GO - PERFORM READ-FILE-RETRY-SHARE - PERFORM LOCK-COMPLETE-AND-GO - PERFORM READ-FILE-RETRY-SHORT - PERFORM LOCK-MARK-COMPLETE - WHEN "CHILD" - MOVE 2 TO LCK-IDX - MOVE "child.txt" TO REPORT-FILE - OPEN EXTEND REPORTIT - MOVE " CHILD" TO WMI - PERFORM LOCK-READY-AND-GO - PERFORM READ-FILE - PERFORM LOCK-COMPLETE-AND-GO - CALL "C$SLEEP" USING 1 - PERFORM READ-FILE-NO-SHARE - PERFORM LOCK-COMPLETE-AND-GO - PERFORM READ-FILE-RETRY-SHARE - PERFORM LOCK-COMPLETE-AND-GO - PERFORM READ-FILE-RETRY-SHARE - PERFORM LOCK-MARK-COMPLETE - WHEN "UPDT" - MOVE "parent.txt" TO REPORT-FILE - OPEN EXTEND REPORTIT - MOVE "Par Upd" TO WMI - PERFORM LOCK-READY-AND-GO - CALL "C$SLEEP" USING 1 - PERFORM UPDT-SHARE - PERFORM LOCK-MARK-COMPLETE - WHEN "CHILDUP" - MOVE 2 TO LCK-IDX - MOVE "child.txt" TO REPORT-FILE - OPEN EXTEND REPORTIT - MOVE "Cld Upd" TO WMI - PERFORM LOCK-READY-AND-GO - MOVE 2 TO SLP-TIME - PERFORM UPDT-SHARE - PERFORM LOCK-MARK-COMPLETE - WHEN "LOCK" - MOVE "parent.txt" TO REPORT-FILE - OPEN EXTEND REPORTIT - MOVE "Par Lck" TO WMI - PERFORM LOCK-READY-AND-GO - PERFORM READ-FILE-ADV - OPEN I-O SHARING ALL OTHER TSPFILE - MOVE DATA-CUST-NUM (1) TO CM-CUST-NUM - READ TSPFILE WITH LOCK - DELETE TSPFILE - STRING "Deleted " CM-CUST-NUM " Sts:" - CUST-STAT INTO MSG - PERFORM DISPLAY-IT - MOVE DATA-CUST-NUM (3) TO CM-CUST-NUM - READ TSPFILE WITH LOCK - STRING "Read " CM-CUST-NUM " Locked Sts:" - CUST-STAT INTO MSG - PERFORM DISPLAY-IT - MOVE DATA-CUST-NUM (6) TO CM-CUST-NUM - READ TSPFILE WITH LOCK - MOVE DATA-CUST-NUM (6) TO CM-CUST-NUM - READ TSPFILE WITH LOCK - STRING "Read " CM-CUST-NUM " Locked Sts:" - CUST-STAT INTO MSG - PERFORM DISPLAY-IT - CALL "C$SLEEP" USING 9 - READ TSPFILE - CLOSE TSPFILE - PERFORM LOCK-MARK-COMPLETE - WHEN "READADV" - MOVE 2 TO LCK-IDX - MOVE "child.txt" TO REPORT-FILE - OPEN EXTEND REPORTIT - PERFORM LOCK-READY-AND-GO - MOVE "Cld Adv" TO WMI - CALL "C$SLEEP" USING 2 - PERFORM READ-FILE-ADV - MOVE "Cld Ign" TO WMI - PERFORM READ-FILE-IGN - PERFORM LOCK-MARK-COMPLETE - WHEN OTHER - DISPLAY "Bad cmd:" CMD-LINE - END-EVALUATE. - MOVE "ending " TO MSG - PERFORM DISPLAY-IT - CLOSE REPORTIT. - STOP RUN. - - LOADFILE. - - MOVE "Loading test data file." TO MSG - PERFORM DISPLAY-IT. - - OPEN OUTPUT TSPFILE - IF CUST-STAT NOT = "00" - STRING "Error " CUST-STAT " opening 'testisam' file" - INTO MSG - PERFORM DISPLAY-IT - STOP RUN - END-IF. - - PERFORM 1000-LOAD-RECORD - VARYING SUB FROM 1 BY 1 - UNTIL SUB > MAX-SUB. - - CLOSE TSPFILE. - - *---------------------------------------------------------------* - * LOAD A RECORD FROM DATA TABLES * - *---------------------------------------------------------------* - - 1000-LOAD-RECORD. - - MOVE SPACES TO TSPFL-RECORD. - MOVE DATA-CUST-NUM (SUB) TO CM-CUST-NUM. - MOVE CM-CUST-NUM TO TSPFL-KEY. - MOVE DATA-COMPANY (SUB) TO CM-COMPANY. - MOVE 10 TO CM-NO-TERMINALS. - - IF ODD-RECORD - MOVE "8417" TO CM-DISK - ELSE - MOVE "8470" TO CM-DISK. - - WRITE TSPFL-RECORD. - IF CUST-STAT NOT = "00" - AND CUST-STAT NOT = "02" - STRING "Key: " TSPFL-KEY ", Status: " CUST-STAT - INTO MSG - PERFORM DISPLAY-IT. - - READ-FILE. - OPEN INPUT TSPFILE. - STRING "READ Open Sts:" CUST-STAT INTO MSG - PERFORM DISPLAY-IT - PERFORM 2 TIMES - PERFORM READ-NEXT - CALL "C$SLEEP" USING 1 - END-PERFORM. - CLOSE TSPFILE. - - READ-FILE-NO-SHARE. - OPEN INPUT SHARING NO OTHER TSPFILE. - STRING "OPEN NO SHARE Sts:" CUST-STAT INTO MSG - PERFORM DISPLAY-IT - IF CUST-STAT = "00" - PERFORM 2 TIMES - PERFORM READ-NEXT - CALL "C$SLEEP" USING 1 - END-PERFORM - ELSE - PERFORM READ-NEXT - END-IF. - CALL "C$SLEEP" USING 2 - CLOSE TSPFILE. - - READ-FILE-RETRY-SHARE. - OPEN INPUT SHARING NO OTHER RETRY 15 SECONDS TSPFILE. - STRING "OPEN NO SHARE RETRY 15 Sts:" CUST-STAT INTO MSG - PERFORM DISPLAY-IT - IF CUST-STAT = "00" - PERFORM 2 TIMES - PERFORM READ-NEXT - CALL "C$SLEEP" USING 1 - END-PERFORM - ELSE - PERFORM READ-NEXT - END-IF. - CALL "C$SLEEP" USING 4 - CLOSE TSPFILE. - - READ-FILE-RETRY-SHORT. - CALL "C$SLEEP" USING 1. - OPEN INPUT SHARING NO OTHER RETRY 2 SECONDS TSPFILE. - STRING "OPEN NO SHARE RETRY 2 Sts:" CUST-STAT INTO MSG - PERFORM DISPLAY-IT - IF CUST-STAT = "00" - PERFORM 2 TIMES - PERFORM READ-NEXT - CALL "C$SLEEP" USING 1 - END-PERFORM - ELSE - PERFORM READ-NEXT - END-IF. - CLOSE TSPFILE. - - UPDT-SHARE. - OPEN I-O SHARING ALL OTHER TSPFILE. - MOVE 3 TO REC-NUM. - MOVE DATA-CUST-NUM (REC-NUM) TO CM-CUST-NUM - READ TSPFILE WITH NO LOCK - STRING "Read " CM-CUST-NUM " no lock Sts:" CUST-STAT - INTO MSG - PERFORM DISPLAY-IT. - ADD 1 TO CM-NO-TERMINALS - REWRITE TSPFL-RECORD RETRY 25 SECONDS WITH NO LOCK - STRING "REWRITE " CM-CUST-NUM " Trms:" CM-NO-TERMINALS - " Sts:" CUST-STAT INTO MSG - PERFORM DISPLAY-IT. - CALL "C$SLEEP" USING SLP-TIME - - READ TSPFILE RETRY 2 SECONDS WITH LOCK - STRING "Read " CM-CUST-NUM " with LOCK Sts:" CUST-STAT - INTO MSG - PERFORM DISPLAY-IT. - IF CUST-STAT = "51" - READ TSPFILE RETRY 15 SECONDS WITH LOCK - STRING "Read " CM-CUST-NUM " retry LCK Sts:" - CUST-STAT INTO MSG - PERFORM DISPLAY-IT - ELSE - CALL "C$SLEEP" USING 5 - END-IF - READ TSPFILE WITH LOCK - STRING "Re-Read " CM-CUST-NUM " with LOCK Sts:" CUST-STAT - INTO MSG - PERFORM DISPLAY-IT. - REWRITE TSPFL-RECORD WITH NO LOCK - STRING "REWRITE " CM-CUST-NUM " Trms:" CM-NO-TERMINALS - " Sts:" CUST-STAT INTO MSG - PERFORM DISPLAY-IT - - READ TSPFILE WITH LOCK - STRING "Read " CM-CUST-NUM " and LOCK Sts:" CUST-STAT - INTO MSG - PERFORM DISPLAY-IT. - - MOVE 2 TO REC-NUM. - MOVE DATA-CUST-NUM (REC-NUM) TO CM-CUST-NUM - REWRITE TSPFL-RECORD RETRY 10 SECONDS WITH NO LOCK - STRING "REWRITE " CM-CUST-NUM " No read! " - " Sts:" CUST-STAT INTO MSG - PERFORM DISPLAY-IT - CLOSE TSPFILE. - - READ-NEXT. - MOVE SPACES TO TSPFL-RECORD. - READ TSPFILE NEXT - IF CUST-STAT NOT = "00" - STRING "Read Next Sts:" CUST-STAT - INTO MSG - ELSE - STRING "Next " CM-CUST-NUM " Trms:" CM-NO-TERMINALS - INTO MSG - END-IF. - PERFORM DISPLAY-IT. - - READ-FILE-ADV. - OPEN INPUT SHARING ALL OTHER TSPFILE - STRING "READ Open Sts:" CUST-STAT INTO MSG - PERFORM DISPLAY-IT - PERFORM 4 TIMES - PERFORM READ-NEXT-ADV - END-PERFORM. - START TSPFILE LAST - PERFORM 4 TIMES - PERFORM READ-PREV-ADV - END-PERFORM. - CLOSE TSPFILE. - - READ-NEXT-ADV. - MOVE SPACES TO TSPFL-RECORD. - READ TSPFILE NEXT ADVANCING ON LOCK - IF CUST-STAT NOT = "00" - STRING "Read Next adv Sts:" CUST-STAT - INTO MSG - ELSE - STRING "Nextadv " CM-CUST-NUM " Trms:" CM-NO-TERMINALS - INTO MSG - END-IF. - PERFORM DISPLAY-IT. - - READ-PREV-ADV. - MOVE SPACES TO TSPFL-RECORD. - READ TSPFILE PREVIOUS ADVANCING ON LOCK - IF CUST-STAT NOT = "00" - STRING "Read Prev adv Sts:" CUST-STAT - INTO MSG - ELSE - STRING "Prevadv " CM-CUST-NUM " Trms:" CM-NO-TERMINALS - INTO MSG - END-IF. - PERFORM DISPLAY-IT. - - READ-FILE-IGN. - OPEN INPUT SHARING ALL OTHER TSPFILE - STRING "READ Open Sts:" CUST-STAT INTO MSG - PERFORM DISPLAY-IT - PERFORM 7 TIMES - PERFORM READ-NEXT-IGN - END-PERFORM. - CLOSE TSPFILE. - - READ-NEXT-IGN. - MOVE SPACES TO TSPFL-RECORD. - READ TSPFILE NEXT IGNORE LOCK - IF CUST-STAT NOT = "00" - STRING "Read Next ign Sts:" CUST-STAT - INTO MSG - ELSE - STRING "Nextign " CM-CUST-NUM " Trms:" CM-NO-TERMINALS - INTO MSG - END-IF. - PERFORM DISPLAY-IT. - - LOCK-INIT. - OPEN OUTPUT LOCKFILE. - MOVE SPACES TO LCK-RECORD. - MOVE ZERO TO LCK-NUM. - MOVE "Lock control" TO LCK-MESSAGE. - WRITE LCK-RECORD. - CLOSE LOCKFILE. - - LOCK-WAIT-READY. - OPEN I-O SHARING ALL OTHER RETRY FOREVER LOCKFILE. - PERFORM UNTIL LCK-TBL (1) = 'R' - AND LCK-TBL (2) = 'R' - READ LOCKFILE - IF LCK-TBL (1) NOT = 'R' - OR LCK-TBL (2) NOT = 'R' - CALL "CBL_GC_NANOSLEEP" USING SLP-SHORT - END-IF - END-PERFORM. - READ LOCKFILE RETRY FOREVER WITH LOCK - MOVE 'G' TO LCK-TBL (1), LCK-TBL (2) - REWRITE LCK-RECORD. - CLOSE LOCKFILE. - - LOCK-WAIT-COMPLETE. - OPEN I-O SHARING ALL OTHER RETRY FOREVER LOCKFILE. - PERFORM UNTIL LCK-TBL (1) = 'C' - AND LCK-TBL (2) = 'C' - READ LOCKFILE - IF LCK-TBL (1) NOT = 'C' - OR LCK-TBL (2) NOT = 'C' - CALL "CBL_GC_NANOSLEEP" USING SLP-LONG - END-IF - END-PERFORM. - READ LOCKFILE RETRY FOREVER WITH LOCK - MOVE 'G' TO LCK-TBL (1), LCK-TBL (2) - REWRITE LCK-RECORD. - CLOSE LOCKFILE. - - LOCK-WAIT-FOR-GO. - OPEN I-O SHARING ALL OTHER RETRY FOREVER LOCKFILE. - PERFORM UNTIL LCK-TBL (LCK-IDX) = 'G' - READ LOCKFILE - IF LCK-TBL (LCK-IDX) NOT = 'G' - CALL "CBL_GC_NANOSLEEP" USING SLP-SHORT - END-IF - END-PERFORM. - READ LOCKFILE RETRY FOREVER WITH LOCK - MOVE 'X' TO LCK-TBL (LCK-IDX) - REWRITE LCK-RECORD. - CLOSE LOCKFILE. - - LOCK-MARK-READY. - OPEN I-O SHARING ALL OTHER RETRY FOREVER LOCKFILE. - READ LOCKFILE RETRY FOREVER WITH LOCK - MOVE 'R' TO LCK-TBL (LCK-IDX) - REWRITE LCK-RECORD. - CLOSE LOCKFILE. - - LOCK-MARK-COMPLETE. - OPEN I-O SHARING ALL OTHER RETRY FOREVER LOCKFILE. - READ LOCKFILE RETRY FOREVER WITH LOCK - MOVE 'C' TO LCK-TBL (LCK-IDX) - REWRITE LCK-RECORD. - CLOSE LOCKFILE. - - LOCK-COMPLETE-AND-GO. - PERFORM LOCK-MARK-COMPLETE - PERFORM LOCK-WAIT-FOR-GO. - - LOCK-READY-AND-GO. - PERFORM LOCK-MARK-READY - PERFORM LOCK-WAIT-FOR-GO. - - DISPLAY-IT. - ADD 1 TO SEQ. - IF MSG (1:1) = '*' - ACCEPT WS-TIME-NOW FROM TIME - STRING WMI " :" SEQ ": " - WS-NOW-MM ":" WS-NOW-SS "." WS-NOW-HS " : " - MSG (2:) INTO REPORT-RECORD - ELSE - STRING WMI " :" SEQ ": " MSG INTO REPORT-RECORD - END-IF. - WRITE REPORT-RECORD. - MOVE SPACES TO MSG. - MOVE SPACES TO REPORT-RECORD. -_ATEOF - - -# CHECKME: do we need -std/-fmf-files here? -{ set +x -$as_echo "$at_srcdir/run_file.at:15399: \$COMPILE -std=mf -fmf-files prog.cob" -at_fn_check_prepare_dynamic "$COMPILE -std=mf -fmf-files prog.cob" "run_file.at:15399" -( $at_check_trace; $COMPILE -std=mf -fmf-files prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_file.at:15399" -$at_failed && at_fn_log_failure -$at_traceon; } - - -{ set +x -$as_echo "$at_srcdir/run_file.at:15401: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_file.at:15401" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_file.at:15401" -$at_failed && at_fn_log_failure -$at_traceon; } - - - - - -cat >reference <<'_ATEOF' -Control :01: Loading test data file. -Control :02: continue test -Control :03: waiting step 1 completion -Control :04: waiting step 2 completion -Control :05: waiting step 3 completion -Control :06: ending -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_file.at:15415: diff reference control.txt" -at_fn_check_prepare_trace "run_file.at:15415" -( $at_check_trace; diff reference control.txt -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_file.at:15415" -$at_failed && at_fn_log_failure \ -"./control.txt" -$at_traceon; } - - - - - -cat >reference <<'_ATEOF' - PARENT :01: READ Open Sts:00 - PARENT :02: Next ALP00000 Trms:0010 - PARENT :03: Next BET00000 Trms:0010 - PARENT :04: OPEN NO SHARE Sts:00 - PARENT :05: Next ALP00000 Trms:0010 - PARENT :06: Next BET00000 Trms:0010 - PARENT :07: OPEN NO SHARE RETRY 15 Sts:00 - PARENT :08: Next ALP00000 Trms:0010 - PARENT :09: Next BET00000 Trms:0010 - PARENT :10: OPEN NO SHARE RETRY 2 Sts:61 - PARENT :11: Read Next Sts:47 - PARENT :12: ending -Par Lck :01: READ Open Sts:00 -Par Lck :02: Nextadv ALP00000 Trms:0010 -Par Lck :03: Nextadv BET00000 Trms:0010 -Par Lck :04: Nextadv CAM00000 Trms:0010 -Par Lck :05: Nextadv DEL00000 Trms:0010 -Par Lck :06: Prevadv HIJ00000 Trms:0010 -Par Lck :07: Prevadv GIB00000 Trms:0010 -Par Lck :08: Prevadv FOR00000 Trms:0010 -Par Lck :09: Prevadv EPS00000 Trms:0010 -Par Lck :10: Deleted ALP00000 Sts:00 -Par Lck :11: Read CAM00000 Locked Sts:00 -Par Lck :12: Read FOR00000 Locked Sts:00 -Par Lck :13: ending -Par Upd :01: Read CAM00000 no lock Sts:00 -Par Upd :02: REWRITE CAM00000 Trms:0012 Sts:00 -Par Upd :03: Read CAM00000 with LOCK Sts:00 -Par Upd :04: Re-Read CAM00000 with LOCK Sts:00 -Par Upd :05: REWRITE CAM00000 Trms:0012 Sts:00 -Par Upd :06: Read CAM00000 and LOCK Sts:00 -Par Upd :07: REWRITE BET00000 No read! Sts:00 -Par Upd :08: ending -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_file.at:15456: diff reference parent.txt" -at_fn_check_prepare_trace "run_file.at:15456" -( $at_check_trace; diff reference parent.txt -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_file.at:15456" -$at_failed && at_fn_log_failure \ -"./control.txt" \ -"./parent.txt" -$at_traceon; } - - - - - -cat >reference <<'_ATEOF' - CHILD :01: READ Open Sts:00 - CHILD :02: Next ALP00000 Trms:0010 - CHILD :03: Next BET00000 Trms:0010 - CHILD :04: OPEN NO SHARE Sts:61 - CHILD :05: Read Next Sts:47 - CHILD :06: OPEN NO SHARE RETRY 15 Sts:00 - CHILD :07: Next ALP00000 Trms:0010 - CHILD :08: Next BET00000 Trms:0010 - CHILD :09: OPEN NO SHARE RETRY 15 Sts:00 - CHILD :10: Next ALP00000 Trms:0010 - CHILD :11: Next BET00000 Trms:0010 - CHILD :12: ending -Cld Adv :01: READ Open Sts:00 -Cld Adv :02: Nextadv BET00000 Trms:0010 -Cld Adv :03: Nextadv DEL00000 Trms:0010 -Cld Adv :04: Nextadv EPS00000 Trms:0010 -Cld Adv :05: Nextadv GIB00000 Trms:0010 -Cld Adv :06: Prevadv HIJ00000 Trms:0010 -Cld Adv :07: Prevadv GIB00000 Trms:0010 -Cld Adv :08: Prevadv EPS00000 Trms:0010 -Cld Adv :09: Prevadv DEL00000 Trms:0010 -Cld Ign :10: READ Open Sts:00 -Cld Ign :11: Nextign BET00000 Trms:0010 -Cld Ign :12: Nextign CAM00000 Trms:0010 -Cld Ign :13: Nextign DEL00000 Trms:0010 -Cld Ign :14: Nextign EPS00000 Trms:0010 -Cld Ign :15: Nextign FOR00000 Trms:0010 -Cld Ign :16: Nextign GIB00000 Trms:0010 -Cld Ign :17: Nextign HIJ00000 Trms:0010 -Cld Ign :18: ending -Cld Upd :01: Read CAM00000 no lock Sts:00 -Cld Upd :02: REWRITE CAM00000 Trms:0011 Sts:00 -Cld Upd :03: Read CAM00000 with LOCK Sts:51 -Cld Upd :04: Read CAM00000 retry LCK Sts:00 -Cld Upd :05: Re-Read CAM00000 with LOCK Sts:00 -Cld Upd :06: REWRITE CAM00000 Trms:0012 Sts:00 -Cld Upd :07: Read CAM00000 and LOCK Sts:00 -Cld Upd :08: REWRITE BET00000 No read! Sts:00 -Cld Upd :09: ending -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_file.at:15503: diff reference child.txt" -at_fn_check_prepare_trace "run_file.at:15503" -( $at_check_trace; diff reference child.txt -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_file.at:15503" -$at_failed && at_fn_log_failure \ -"./control.txt" \ -"./parent.txt" \ -"./child.txt" -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_784 -#AT_START_785 -at_fn_group_banner 785 'run_file.at:15508' \ - "RELATIVE File Locking" " " 4 -at_xfail=no -( - $as_echo "785. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -# has timing issues - just skip until resolved later -$as_echo "run_file.at:15512" >"$at_check_line_file" -at_fn_check_skip 77 "$at_srcdir/run_file.at:15512" - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - CONFIGURATION SECTION. - - INPUT-OUTPUT SECTION. - FILE-CONTROL. - SELECT FLATFILE ASSIGN EXTERNAL RELFIX - ORGANIZATION RELATIVE - ACCESS IS SEQUENTIAL RELATIVE KEY IS REC-NUM - FILE STATUS IS CUST-STAT. - - SELECT FLATFILE2 ASSIGN EXTERNAL RELFIX - ORGANIZATION RELATIVE - ACCESS IS RANDOM RELATIVE KEY IS REC-NUM - FILE STATUS IS CUST-STAT. - - SELECT LOCKFILE ASSIGN EXTERNAL RELLCK - ORGANIZATION RELATIVE - SHARING READ ONLY - ACCESS IS RANDOM RELATIVE KEY IS LCK-REC - FILE STATUS IS CUST-STAT. - - SELECT OPTIONAL REPORTIT ASSIGN TO REPORT-FILE - ORGANIZATION LINE SEQUENTIAL. - - DATA DIVISION. - FILE SECTION. - FD REPORTIT - BLOCK CONTAINS 5 RECORDS. - - 01 REPORT-RECORD PIC X(80). - - FD FLATFILE - BLOCK CONTAINS 5 RECORDS. - - 01 TSPFL-RECORD. - 10 CM-CUST-NUM PICTURE X(8). - 10 CM-COMPANY PICTURE X(25). - 10 CM-DISK PICTURE X(8). - 10 CM-NO-TERMINALS PICTURE 9(4). - - FD FLATFILE2 - BLOCK CONTAINS 5 RECORDS. - - 01 TSP2-RECORD. - 10 C2-CUST-NUM PICTURE X(8). - 10 C2-COMPANY PICTURE X(25). - 10 C2-DISK PICTURE X(8). - 10 C2-NO-TERMINALS PICTURE S9(4). - - FD LOCKFILE - BLOCK CONTAINS 5 RECORDS. - - 01 LCK-RECORD. - 10 LCK-NUM PICTURE 9(3). - 10 LCK-TBL PICTURE X OCCURS 4 TIMES. - 10 LCK-MESSAGE PICTURE X(25). - - WORKING-STORAGE SECTION. - - 77 MAX-SUB PICTURE 9(4) VALUE 6. - 77 CUST-STAT PICTURE X(2). - 77 REC-NUM PICTURE 9(4) VALUE 1. - 77 LCK-REC PICTURE 9(4) VALUE 1. - 77 SLP-TIME PICTURE 9(9) BINARY VALUE 1. - 77 REPORT-FILE PICTURE X(32) VALUE "parent.txt". - - 01 TEST-DATA. - - 02 DATA-CUST-NUM-TBL. - - 05 FILLER PIC X(8) VALUE "ALP00000". - 05 FILLER PIC X(8) VALUE "BET00000". - 05 FILLER PIC X(8) VALUE "DEL00000". - 05 FILLER PIC X(8) VALUE "EPS00000". - 05 FILLER PIC X(8) VALUE "FOR00000". - 05 FILLER PIC X(8) VALUE "GAM00000". - - 02 DATA-CUST-NUM REDEFINES DATA-CUST-NUM-TBL - PIC X(8) OCCURS 6. - 02 DATA-COMPANY-TBL. - - 05 FILLER PIC X(25) VALUE "ALPHA ELECTRICAL CO. LTD.". - 05 FILLER PIC X(25) VALUE "BETA SHOE MFG. INC. ". - 05 FILLER PIC X(25) VALUE "DELTA LUGGAGE REPAIRS ". - 05 FILLER PIC X(25) VALUE "EPSILON EQUIPMENT SUPPLY ". - 05 FILLER PIC X(25) VALUE "FORTUNE COOKIE COMPANY ". - 05 FILLER PIC X(25) VALUE "GAMMA X-RAY TECHNOLOGY ". - 02 DATA-COMPANY REDEFINES DATA-COMPANY-TBL - PIC X(25) OCCURS 6. - 02 DATA-ADDRESS-2-TBL. - - 05 FILLER PIC X(10) VALUE "ATLANTA ". - 05 FILLER PIC X(10) VALUE "CALGARY ". - 05 FILLER PIC X(10) VALUE "NEW YORK ". - 05 FILLER PIC X(10) VALUE "TORONTO ". - 05 FILLER PIC X(10) VALUE "WASHINGTON". - 05 FILLER PIC X(10) VALUE "WHITEPLAIN". - 02 DATA-ADDRESS REDEFINES DATA-ADDRESS-2-TBL - PIC X(10) OCCURS 6. - - 01 WORK-AREA. - 05 SUB PICTURE 9(4) COMP SYNC. - 88 ODD-RECORD VALUE 1 3 5. - - 01 CMD-LINE PIC X(64). - 01 WMI PIC X(7). - 01 SEQ PIC 9(2) VALUE 0. - 01 MSG PIC X(64) VALUE " ". - - PROCEDURE DIVISION. - - ACCEPT CMD-LINE FROM COMMAND-LINE. - CALL "C$TOUPPER" USING CMD-LINE BY VALUE LENGTH OF CMD-LINE. - MOVE SPACES TO REPORT-RECORD. - EVALUATE CMD-LINE - WHEN SPACES - MOVE "control.txt" TO REPORT-FILE - OPEN EXTEND REPORTIT - MOVE "Control" TO WMI - PERFORM LOADFILE - PERFORM LOCK-EXCLUSIVE - CALL "SYSTEM" USING "./prog PARENT &" - CALL "SYSTEM" USING "./prog CHILD &" - CALL "C$SLEEP" USING 2 - MOVE "continue test " TO MSG - PERFORM DISPLAY-IT - PERFORM LOCK-RELEASE - CALL "C$SLEEP" USING 2 - PERFORM LOCK-EXCLUSIVE - PERFORM LOCK-RELEASE - CALL "C$SLEEP" USING 2 - PERFORM LOCK-EXCLUSIVE - MOVE "waiting step 1 completion " TO MSG - PERFORM DISPLAY-IT - CALL "C$SLEEP" USING 1 - PERFORM LOCK-RELEASE - CALL "C$SLEEP" USING 2 - PERFORM LOCK-EXCLUSIVE - CALL "C$SLEEP" USING 2 - PERFORM LOCK-RELEASE - CALL "C$SLEEP" USING 1 - CALL "SYSTEM" USING "./prog LOCK &" - CALL "SYSTEM" USING "./prog READADV &" - CALL "C$SLEEP" USING 6 - MOVE "waiting step 2 completion " TO MSG - PERFORM DISPLAY-IT - PERFORM LOCK-EXCLUSIVE - CALL "SYSTEM" USING "./prog UPDT &" - CALL "SYSTEM" USING "./prog CHILDUP &" - PERFORM LOCK-RELEASE - CALL "C$SLEEP" USING 3 - PERFORM LOCK-EXCLUSIVE - MOVE "waiting step 3 completion " TO MSG - PERFORM DISPLAY-IT - CALL "C$SLEEP" USING 1 - PERFORM LOCK-RELEASE - WHEN "PARENT" - MOVE "parent.txt" TO REPORT-FILE - OPEN EXTEND REPORTIT - MOVE " PARENT" TO WMI - PERFORM LOCK-SHARED - CALL "C$SLEEP" USING 1 - PERFORM READ-FILE - PERFORM LOCK-RELEASE - CALL "C$SLEEP" USING 3 - PERFORM LOCK-SHARED - PERFORM READ-FILE-NO-SHARE - PERFORM READ-FILE-RETRY-SHARE - PERFORM LOCK-RELEASE - CALL "C$SLEEP" USING 4 - PERFORM LOCK-SHARED - PERFORM READ-FILE-RETRY-SHORT - PERFORM LOCK-RELEASE - WHEN "CHILD" - MOVE "child.txt" TO REPORT-FILE - OPEN EXTEND REPORTIT - MOVE " CHILD" TO WMI - PERFORM LOCK-SHARED - CALL "C$SLEEP" USING 2 - PERFORM READ-FILE - PERFORM LOCK-RELEASE - CALL "C$SLEEP" USING 3 - PERFORM LOCK-SHARED - PERFORM READ-FILE-NO-SHARE - PERFORM READ-FILE-RETRY-SHARE - PERFORM LOCK-RELEASE - CALL "C$SLEEP" USING 4 - PERFORM LOCK-SHARED - PERFORM READ-FILE-RETRY-SHARE - PERFORM LOCK-RELEASE - WHEN "UPDT" - MOVE "parent.txt" TO REPORT-FILE - OPEN EXTEND REPORTIT - MOVE "Par Upd" TO WMI - PERFORM LOCK-SHARED - PERFORM UPDT-SHARE - PERFORM LOCK-RELEASE - WHEN "CHILDUP" - MOVE "child.txt" TO REPORT-FILE - OPEN EXTEND REPORTIT - MOVE "Cld Upd" TO WMI - MOVE 1 TO SLP-TIME - PERFORM LOCK-SHARED - PERFORM UPDT-SHARE - PERFORM LOCK-RELEASE - WHEN "LOCK" - MOVE "parent.txt" TO REPORT-FILE - OPEN EXTEND REPORTIT - MOVE "Par Lck" TO WMI - PERFORM READ-FILE-ADV - OPEN I-O SHARING ALL OTHER FLATFILE2 - MOVE 1 TO REC-NUM - READ FLATFILE2 WITH LOCK - DELETE FLATFILE2 - STRING "Deleted " C2-CUST-NUM " 1 Sts:" - CUST-STAT INTO MSG - PERFORM DISPLAY-IT - MOVE 3 TO REC-NUM - READ FLATFILE2 WITH LOCK - STRING "Read " C2-CUST-NUM " Locked 3 Sts:" - CUST-STAT INTO MSG - PERFORM DISPLAY-IT - CALL "C$SLEEP" USING 4 - CLOSE FLATFILE2 - WHEN "READADV" - MOVE "child.txt" TO REPORT-FILE - OPEN EXTEND REPORTIT - MOVE "Cld Adv" TO WMI - CALL "C$SLEEP" USING 2 - PERFORM READ-FILE-ADV - MOVE "Cld Ign" TO WMI - PERFORM READ-FILE-IGN - END-EVALUATE. - MOVE "ending " TO MSG - PERFORM DISPLAY-IT - CLOSE REPORTIT. - STOP RUN. - - READ-FILE. - OPEN INPUT FLATFILE. - STRING "READ Open Sts:" CUST-STAT INTO MSG - PERFORM DISPLAY-IT - PERFORM 2 TIMES - PERFORM READ-NEXT - CALL "C$SLEEP" USING 1 - END-PERFORM. - CLOSE FLATFILE. - - READ-FILE-NO-SHARE. - OPEN INPUT SHARING NO OTHER FLATFILE. - STRING "NO SHARE Open Sts:" CUST-STAT INTO MSG - PERFORM DISPLAY-IT - IF CUST-STAT = "00" - PERFORM 2 TIMES - PERFORM READ-NEXT - CALL "C$SLEEP" USING 1 - END-PERFORM - CLOSE FLATFILE - ELSE - PERFORM READ-NEXT - CALL "C$SLEEP" USING 1 - CLOSE FLATFILE - CALL "C$SLEEP" USING 1 - END-IF. - - READ-FILE-RETRY-SHARE. - OPEN INPUT SHARING NO OTHER RETRY 10 SECONDS FLATFILE. - STRING "RETRY SHARE Open Sts:" CUST-STAT INTO MSG - PERFORM DISPLAY-IT - CALL "C$SLEEP" USING 2 - IF CUST-STAT = "00" - PERFORM 2 TIMES - PERFORM READ-NEXT - CALL "C$SLEEP" USING 1 - END-PERFORM - CALL "C$SLEEP" USING 2 - CLOSE FLATFILE - ELSE - PERFORM READ-NEXT - CALL "C$SLEEP" USING 2 - CLOSE FLATFILE - CALL "C$SLEEP" USING 1 - END-IF. - - READ-FILE-RETRY-SHORT. - OPEN INPUT SHARING NO OTHER RETRY 2 SECONDS FLATFILE. - STRING "RETRY SHORT Open Sts:" CUST-STAT INTO MSG - PERFORM DISPLAY-IT - IF CUST-STAT = "00" - PERFORM 2 TIMES - PERFORM READ-NEXT - CALL "C$SLEEP" USING 1 - END-PERFORM - CLOSE FLATFILE - ELSE - PERFORM READ-NEXT - CALL "C$SLEEP" USING 1 - CLOSE FLATFILE - CALL "C$SLEEP" USING 1 - END-IF. - - UPDT-SHARE. - OPEN I-O SHARING ALL OTHER FLATFILE2. - MOVE 3 TO REC-NUM. - CALL "C$SLEEP" USING SLP-TIME - READ FLATFILE2 - STRING "Read " C2-CUST-NUM " no lock Sts:" CUST-STAT - INTO MSG - PERFORM DISPLAY-IT. - ADD 1 TO C2-NO-TERMINALS - REWRITE FILE FLATFILE2 FROM TSP2-RECORD WITH NO LOCK - * REWRITE TSP2-RECORD WITH NO LOCK - STRING "REWRITE " C2-CUST-NUM " Trms:" C2-NO-TERMINALS - " Sts:" CUST-STAT INTO MSG - PERFORM DISPLAY-IT - - READ FLATFILE2 WITH LOCK - STRING "Read " C2-CUST-NUM " with LOCK Sts:" CUST-STAT - INTO MSG - PERFORM DISPLAY-IT. - CALL "C$SLEEP" USING 2 - READ FLATFILE2 WITH LOCK - STRING "Re-Read " C2-CUST-NUM " with LOCK Sts:" CUST-STAT - INTO MSG - PERFORM DISPLAY-IT. - REWRITE TSP2-RECORD WITH NO LOCK - STRING "REWRITE " C2-CUST-NUM " Trms:" C2-NO-TERMINALS - " Sts:" CUST-STAT INTO MSG - PERFORM DISPLAY-IT - - READ FLATFILE2 WITH LOCK - STRING "Read " C2-CUST-NUM " and LOCK Sts:" CUST-STAT - INTO MSG - PERFORM DISPLAY-IT. - - MOVE 2 TO REC-NUM. - MOVE DATA-CUST-NUM (REC-NUM) TO C2-CUST-NUM - MOVE WMI TO C2-CUST-NUM (3:6) - REWRITE TSP2-RECORD RETRY 10 SECONDS WITH NO LOCK - STRING "REWRITE " C2-CUST-NUM " No read! " - " Sts:" CUST-STAT INTO MSG - PERFORM DISPLAY-IT - CLOSE FLATFILE2. - - READ-NEXT. - MOVE SPACES TO TSPFL-RECORD. - READ FLATFILE NEXT - IF CUST-STAT NOT = "00" - STRING "Read Next Sts:" CUST-STAT - INTO MSG - ELSE - STRING "Next " CM-CUST-NUM " Trms:" CM-NO-TERMINALS - " #" REC-NUM INTO MSG - END-IF. - PERFORM DISPLAY-IT. - - READ-FILE-ADV. - OPEN INPUT SHARING ALL OTHER FLATFILE - STRING "READ Open Sts:" CUST-STAT INTO MSG - PERFORM DISPLAY-IT - PERFORM 4 TIMES - PERFORM READ-NEXT-ADV - END-PERFORM. - CLOSE FLATFILE. - - READ-NEXT-ADV. - MOVE SPACES TO TSPFL-RECORD. - READ FLATFILE NEXT ADVANCING ON LOCK - IF CUST-STAT NOT = "00" - STRING "Read Next adv Sts:" CUST-STAT - INTO MSG - ELSE - STRING "Nextadv " CM-CUST-NUM " Trms:" CM-NO-TERMINALS - " #" REC-NUM INTO MSG - END-IF. - PERFORM DISPLAY-IT. - - READ-FILE-IGN. - OPEN INPUT SHARING ALL OTHER FLATFILE - STRING "READ Open Sts:" CUST-STAT INTO MSG - PERFORM DISPLAY-IT - PERFORM 4 TIMES - PERFORM READ-NEXT-IGN - END-PERFORM. - CLOSE FLATFILE. - - READ-NEXT-IGN. - MOVE SPACES TO TSPFL-RECORD. - READ FLATFILE NEXT IGNORE LOCK - IF CUST-STAT NOT = "00" - STRING "Read Next ign Sts:" CUST-STAT - INTO MSG - ELSE - STRING "Nextign " CM-CUST-NUM " Trms:" CM-NO-TERMINALS - " #" REC-NUM INTO MSG - END-IF. - PERFORM DISPLAY-IT. - - DISPLAY-IT. - ADD 1 TO SEQ. - STRING WMI " :" SEQ ": " MSG INTO REPORT-RECORD. - WRITE REPORT-RECORD. - MOVE SPACES TO MSG. - MOVE SPACES TO REPORT-RECORD. - - LOCK-EXCLUSIVE. - OPEN I-O SHARING NO OTHER RETRY FOREVER LOCKFILE. - - LOCK-SHARED. - OPEN INPUT SHARING READ ONLY RETRY FOREVER LOCKFILE. - - LOCK-RELEASE. - CLOSE LOCKFILE. - - LOADFILE. - STRING WMI " . . Loading sample program data file" - INTO REPORT-RECORD. - WRITE REPORT-RECORD. - MOVE SPACES TO REPORT-RECORD. - - OPEN OUTPUT LOCKFILE. - MOVE SPACES TO LCK-RECORD. - MOVE ZERO TO LCK-NUM. - MOVE "Lock control" TO LCK-MESSAGE. - WRITE FILE LOCKFILE FROM LCK-RECORD - * WRITE LCK-RECORD. - CLOSE LOCKFILE. - - OPEN OUTPUT FLATFILE. - PERFORM LOAD-RECORD - VARYING SUB FROM 1 BY 1 - UNTIL SUB > MAX-SUB. - - CLOSE FLATFILE. - - LOAD-RECORD. - MOVE SPACES TO TSPFL-RECORD. - MOVE DATA-CUST-NUM (SUB) TO CM-CUST-NUM. - MOVE DATA-COMPANY (SUB) TO CM-COMPANY. - MOVE 10 TO CM-NO-TERMINALS. - IF ODD-RECORD - MOVE "8417" TO CM-DISK - ELSE - MOVE "8470" TO CM-DISK. - WRITE TSPFL-RECORD. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_file.at:15964: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_file.at:15964" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_file.at:15964" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_file.at:15965: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_file.at:15965" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_file.at:15965" -$at_failed && at_fn_log_failure -$at_traceon; } - - - - - -cat >reference <<'_ATEOF' -Control . . Loading sample program data file -Control :01: continue test -Control :02: waiting step 1 completion -Control :03: waiting step 2 completion -Control :04: waiting step 3 completion -Control :05: ending -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_file.at:15979: diff reference control.txt" -at_fn_check_prepare_trace "run_file.at:15979" -( $at_check_trace; diff reference control.txt -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_file.at:15979" -$at_failed && at_fn_log_failure \ -"./control.txt" -$at_traceon; } - - - - - -cat >reference <<'_ATEOF' - PARENT :01: READ Open Sts:00 - PARENT :02: Next ALP00000 Trms:0010 #0001 - PARENT :03: Next BET00000 Trms:0010 #0002 - PARENT :04: NO SHARE Open Sts:00 - PARENT :05: Next ALP00000 Trms:0010 #0001 - PARENT :06: Next BET00000 Trms:0010 #0002 - PARENT :07: RETRY SHARE Open Sts:00 - PARENT :08: Next ALP00000 Trms:0010 #0001 - PARENT :09: Next BET00000 Trms:0010 #0002 - PARENT :10: RETRY SHORT Open Sts:61 - PARENT :11: Read Next Sts:47 - PARENT :12: ending -Par Lck :01: READ Open Sts:00 -Par Lck :02: Nextadv ALP00000 Trms:0010 #0001 -Par Lck :03: Nextadv BET00000 Trms:0010 #0002 -Par Lck :04: Nextadv DEL00000 Trms:0010 #0003 -Par Lck :05: Nextadv EPS00000 Trms:0010 #0004 -Par Lck :06: Deleted ALP00000 1 Sts:00 -Par Lck :07: Read DEL00000 Locked 3 Sts:00 -Par Lck :08: ending -Par Upd :01: Read DEL00000 no lock Sts:00 -Par Upd :02: REWRITE DEL00000 Trms:0011 Sts:00 -Par Upd :03: Read DEL00000 with LOCK Sts:00 -Par Upd :04: Re-Read DEL00000 with LOCK Sts:00 -Par Upd :05: REWRITE DEL00000 Trms:0011 Sts:00 -Par Upd :06: Read DEL00000 and LOCK Sts:00 -Par Upd :07: REWRITE BEPar Up No read! Sts:00 -Par Upd :08: ending -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_file.at:16015: diff reference parent.txt" -at_fn_check_prepare_trace "run_file.at:16015" -( $at_check_trace; diff reference parent.txt -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_file.at:16015" -$at_failed && at_fn_log_failure \ -"./control.txt" \ -"./parent.txt" -$at_traceon; } - - - - - -cat >reference <<'_ATEOF' - CHILD :01: READ Open Sts:00 - CHILD :02: Next ALP00000 Trms:0010 #0001 - CHILD :03: Next BET00000 Trms:0010 #0002 - CHILD :04: NO SHARE Open Sts:61 - CHILD :05: Read Next Sts:47 - CHILD :06: RETRY SHARE Open Sts:00 - CHILD :07: Next ALP00000 Trms:0010 #0001 - CHILD :08: Next BET00000 Trms:0010 #0002 - CHILD :09: RETRY SHARE Open Sts:00 - CHILD :10: Next ALP00000 Trms:0010 #0001 - CHILD :11: Next BET00000 Trms:0010 #0002 - CHILD :12: ending -Cld Adv :01: READ Open Sts:00 -Cld Adv :02: Nextadv BET00000 Trms:0010 #0002 -Cld Adv :03: Nextadv EPS00000 Trms:0010 #0004 -Cld Adv :04: Nextadv FOR00000 Trms:0010 #0005 -Cld Adv :05: Nextadv GAM00000 Trms:0010 #0006 -Cld Ign :06: READ Open Sts:00 -Cld Ign :07: Nextign BET00000 Trms:0010 #0002 -Cld Ign :08: Nextign DEL00000 Trms:0010 #0003 -Cld Ign :09: Nextign EPS00000 Trms:0010 #0004 -Cld Ign :10: Nextign FOR00000 Trms:0010 #0005 -Cld Ign :11: ending -Cld Upd :01: Read DEL00000 no lock Sts:00 -Cld Upd :02: REWRITE DEL00000 Trms:0012 Sts:51 -Cld Upd :03: Read DEL00000 with LOCK Sts:51 -Cld Upd :04: Re-Read DEL00000 with LOCK Sts:00 -Cld Upd :05: REWRITE DEL00000 Trms:0011 Sts:00 -Cld Upd :06: Read DEL00000 and LOCK Sts:00 -Cld Upd :07: REWRITE BECld Up No read! Sts:00 -Cld Upd :08: ending -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_file.at:16054: diff reference child.txt" -at_fn_check_prepare_trace "run_file.at:16054" -( $at_check_trace; diff reference child.txt -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_file.at:16054" -$at_failed && at_fn_log_failure \ -"./control.txt" \ -"./parent.txt" \ -"./child.txt" -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_785 -#AT_START_786 -at_fn_group_banner 786 'run_file.at:16059' \ - "Read on optional missing file" " " 4 -at_xfail=no -( - $as_echo "786. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - CONFIGURATION SECTION. - INPUT-OUTPUT SECTION. - FILE-CONTROL. - SELECT OPTIONAL INFILE ASSIGN TO - "missing.txt" - ORGANIZATION IS RELATIVE - ACCESS IS SEQUENTIAL - FILE STATUS IS WSFS. - DATA DIVISION. - FILE SECTION. - FD INFILE. - 01 INREC PIC X(80). - WORKING-STORAGE SECTION. - 01 WSFS PIC X(2). - 88 RECORDFOUND VALUE "00". - 01 WSINREC PIC X(80). - PROCEDURE DIVISION. - MAIN-PROCEDURE. - * Open missing file - OPEN INPUT INFILE - * First read, raise a FS 10 (AT END) which is expected - READ INFILE INTO WSINREC - END-READ - IF WSFS = '10' - DISPLAY "1st Read on missing optional file = " WSFS " OK" - ELSE - DISPLAY "1st Read on missing optional file = " WSFS " Bad" - END-IF. - - * Second read, should raise a FS 46 (READ AFTER AT END) - * but a FS 23 is raised instead. - READ INFILE INTO WSINREC - END-READ - - IF WSFS = '46' - DISPLAY "2nd Read on missing optional file = " WSFS " OK" - ELSE - DISPLAY "2nd Read on missing optional file = " WSFS " Bad" - END-IF. - - CLOSE INFILE - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_file.at:16110: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_file.at:16110" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_file.at:16110" -$at_failed && at_fn_log_failure -$at_traceon; } - - -{ set +x -$as_echo "$at_srcdir/run_file.at:16112: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_file.at:16112" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo "1st Read on missing optional file = 10 OK -2nd Read on missing optional file = 46 OK -" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_file.at:16112" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_786 -#AT_START_787 -at_fn_group_banner 787 'run_file.at:16120' \ - "SELECT with ASSIGN in LINKAGE" " " 4 -at_xfail=no -( - $as_echo "787. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - - ENVIRONMENT DIVISION. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 f-path PIC X(80) VALUE "fooasg.txt". - 01 x-path PIC X(80) VALUE "foxasg.txt". - 01 y-path PIC X(80) VALUE "foyasg.txt". - 01 REC1 PIC 9(4) VALUE 1. - 01 REC2 PIC 9(4) VALUE 2. - 01 CUST-STAT PIC X(2) VALUE "XX". - - PROCEDURE DIVISION. - CALL "TSTOPN" USING OMITTED. - CALL "TSTOPN" USING y-path. - CALL "TSTOPEN" USING f-path REC1 CUST-STAT. - CALL "TSTOPEN" USING x-path REC1 CUST-STAT. - CALL "TSTOPEN" USING OMITTED REC1 CUST-STAT. - CALL "TSTOPEN" USING f-path REC2 CUST-STAT. - CALL "TSTOPEN" USING x-path REC2 CUST-STAT. - STOP RUN. - END PROGRAM prog. - - IDENTIFICATION DIVISION. - PROGRAM-ID. TSTOPEN. - - ENVIRONMENT DIVISION. - INPUT-OUTPUT SECTION. - FILE-CONTROL. - SELECT f ASSIGN s-path - ORGANIZATION RELATIVE - ACCESS IS RANDOM - RELATIVE KEY IS REC-NUM - FILE STATUS IS CUST-STAT. - - DATA DIVISION. - FILE SECTION. - FD f. - 01 f-line PIC X(79). - - WORKING-STORAGE SECTION. - 01 z-path PIC X(80) VALUE "foozzz.txt". - - LINKAGE SECTION. - 01 s-path PIC X(80). - 01 REC-NUM PIC 9(4). - 01 CUST-STAT PIC X(2). - - PROCEDURE DIVISION USING s-path, REC-NUM, CUST-STAT. - IF ADDRESS OF s-path = NULL - SET ADDRESS OF s-path TO ADDRESS OF z-path - END-IF. - IF REC-NUM > 1 - OPEN I-O f - DISPLAY "Extend file: " s-path(1:10) - " - " CUST-STAT " #" REC-NUM "." - ELSE - OPEN OUTPUT f - DISPLAY "Output file: " s-path(1:10) - " - " CUST-STAT " #" REC-NUM "." - END-IF. - IF CUST-STAT NOT = "00" - DISPLAY "Opened error: " CUST-STAT "." - GOBACK - END-IF. - MOVE "Hello World" TO f-line. - MOVE REC-NUM TO f-line (20:4). - WRITE f-line. - IF CUST-STAT NOT = "00" - DISPLAY "WRITE error: " CUST-STAT "." - END-IF. - CLOSE f. - GOBACK. - END PROGRAM TSTOPEN. - - IDENTIFICATION DIVISION. - PROGRAM-ID. TSTOPN. - - ENVIRONMENT DIVISION. - INPUT-OUTPUT SECTION. - FILE-CONTROL. - SELECT f ASSIGN b-path - ORGANIZATION LINE SEQUENTIAL - FILE STATUS IS IO-STS. - - DATA DIVISION. - FILE SECTION. - FD f. - 01 f-line PIC X(80). - - WORKING-STORAGE SECTION. - 01 IO-STS PIC X(2) VALUE "00". - 01 b-path PIC X(80) BASED. - - LINKAGE SECTION. - 01 s-path PIC X(80). - - PROCEDURE DIVISION USING s-path. - SET ADDRESS OF b-path TO ADDRESS OF s-path - OPEN OUTPUT f - IF IO-STS NOT = "00" - DISPLAY "Opened error: " IO-STS "." - GOBACK - END-IF. - DISPLAY "Opened file: " s-path(1:10) ".". - MOVE "Hello World" TO f-line. - WRITE f-line. - CLOSE f. - GOBACK. - END PROGRAM TSTOPN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_file.at:16237: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_file.at:16237" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_file.at:16237" -$at_failed && at_fn_log_failure -$at_traceon; } - - -{ set +x -$as_echo "$at_srcdir/run_file.at:16239: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_file.at:16239" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo "Opened error: 31. -Opened file: foyasg.txt. -Output file: fooasg.txt - 00 #0001. -Output file: foxasg.txt - 00 #0001. -Output file: foozzz.txt - 00 #0001. -Extend file: fooasg.txt - 00 #0002. -Extend file: foxasg.txt - 00 #0002. -" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_file.at:16239" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_787 -#AT_START_788 -at_fn_group_banner 788 'run_file.at:16252' \ - "INDEXED File Variable len record" " " 4 -at_xfail=no -( - $as_echo "788. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -$as_echo "run_file.at:16255" >"$at_check_line_file" -(test "$COB_HAS_ISAM" = "no") \ - && at_fn_check_skip 77 "$at_srcdir/run_file.at:16255" - -cat >prog.cob <<'_ATEOF' - - Identification division. - Program-id. tb is initial program. - * - Environment division. - Configuration section. - * - Source-computer. GNU-Cobol. - Object-computer. GNU-Cobol. - - Special-names. - * - * Display x upon std-out, to get 1>file1.txt. - console is std-out - * Display x upon std-err, to get 2>file2.txt - syserr is std-err - . - - Input-output section. - File-control. - * - Select optional tbw - assign to path-tbw - organization is indexed - access mode is dynamic - record key is tbw-key - alternate record key is tbw-alt - suppress when space - sharing with no other - file status is fs-file-status. - * - I-o-control. - * - Data division. - File section. - * - FD tbw - record is varying in size - from 107 to 362 characters - depending on end-tbw-record - . - 01 tbw-record. - 02 tbw-key pic x(100). - 02 tbw-alt. - 03 tbw-alt-1 pic 9(02). - 03 tbw-alt-2 pic 9(04). - 02 tbw-f1 pic x(01). - 02 tbw-f2 pic x(255). - * - Working-storage section. - - 01 fs-file-status pic x(02). - - 01 end-tbw-record pic 9(09) binary. - - 01 flag-tbw pic x(01) value low-value. - 88 flag-tbw-open value high-value. - 88 flag-tbw-closed value low-value. - - 01 path-tbw pic x(255) value space. - - Procedure division. - - * Prepare. - Move "tbw" to path-tbw. - - * First test. - Perform tbw-delete-file thru tbw-exit. - - Perform tbw-open-i-o thru tbw-exit. - - Move low-values to tbw-key. - Perform tbw-start-primary-greater thru tbw-exit. - - Perform tbw-read-next thru tbw-exit. - - Move 122 to end-tbw-record. - Move "aaaaa" to tbw-key. - Move spaces to tbw-alt - tbw-f1 - tbw-f2. - Perform tbw-write thru tbw-exit. - - Move low-values to tbw-alt. - Perform tbw-start-alternate thru tbw-exit. - - Move low-values to tbw-key. - Perform tbw-start-primary-greater thru tbw-exit. - - Perform tbw-read-next thru tbw-exit. - - Perform tbw-read-next thru tbw-exit. - - * Second test. - Perform tbw-close thru tbw-exit. - - Perform tbw-delete-file thru tbw-exit. - - Perform tbw-open-i-o thru tbw-exit. - - Move low-values to tbw-key. - Perform tbw-start-primary-greater thru tbw-exit. - - Perform tbw-read-next thru tbw-exit. - - Move 163 to end-tbw-record. - Move "aaaaa" to tbw-key. - Move 1 to tbw-alt-1 - tbw-alt-2. - Move spaces to tbw-f1 - tbw-f2. - Perform tbw-write thru tbw-exit. - - Move 122 to end-tbw-record. - Move "aaaab" to tbw-key. - Move spaces to tbw-alt - tbw-f1 - tbw-f2. - Perform tbw-write thru tbw-exit. - - Move low-values to tbw-alt. - Perform tbw-start-alternate thru tbw-exit. - - Perform tbw-read-next thru tbw-exit. - - Move spaces to tbw-alt. - Perform tbw-rewrite thru tbw-exit. - - * Finish. - Perform tbw-close thru tbw-exit. - Display "Test completed". - Stop run. - - * I/O. - tbw-Open-I-O. - If flag-tbw-open - Perform tbw-Close thru tbw-Close-exit - end-if. - Display "open". - Open i-o tbw. - Display "open". - If fs-file-status is less than "10" - Set flag-tbw-open to true - end-if. - Go to tbw-exit. - * - tbw-Start-Primary-Greater. - Display "start > tbw-key". - Start tbw - key is greater than tbw-key - invalid key Continue - end-start. - Display "start > tbw-key". - Go to tbw-exit. - * - tbw-Start-Alternate. - Display "start >= tbw-alt". - Start tbw - key is not less than tbw-alt - invalid key Continue - end-start. - Display "start >= tbw-alt". - Go to tbw-exit. - * - tbw-Read-Next. - Display "read next". - Read tbw - next record - at end Continue - end-read. - Display "read next done". - Go to tbw-exit. - * - tbw-Write. - Display "write". - Write tbw-record - invalid key Continue - end-write. - Display "write". - Go to tbw-exit. - * - tbw-Rewrite. - Display "rewrite". - Rewrite tbw-record - invalid key Continue - end-rewrite. - Display "rewrite " fs-file-status. - Go to tbw-exit. - * - tbw-Delete-File. - If flag-tbw-open - Perform tbw-Close thru tbw-Close-exit - end-if. - Move "xx" to fs-file-status. - Display "delete file". - Delete file tbw - end-delete. - Display "delete file". - Go to tbw-exit. - * - tbw-Close. - If flag-tbw-open - Display "close" - Close tbw - Display "close" - Set flag-tbw-closed to true - end-if. - tbw-Close-exit. - Exit. - tbw-exit. - Exit. -_ATEOF - - -# CHECKME: do we need -std=mf here? -{ set +x -$as_echo "$at_srcdir/run_file.at:16471: \$COMPILE -std=mf prog.cob" -at_fn_check_prepare_dynamic "$COMPILE -std=mf prog.cob" "run_file.at:16471" -( $at_check_trace; $COMPILE -std=mf prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_file.at:16471" -$at_failed && at_fn_log_failure -$at_traceon; } - - -{ set +x -$as_echo "$at_srcdir/run_file.at:16473: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_file.at:16473" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo "delete file -delete file -open -open -start > tbw-key -start > tbw-key -read next -read next done -write -write -start >= tbw-alt -start >= tbw-alt -start > tbw-key -start > tbw-key -read next -read next done -read next -read next done -close -close -delete file -delete file -open -open -start > tbw-key -start > tbw-key -read next -read next done -write -write -write -write -start >= tbw-alt -start >= tbw-alt -read next -read next done -rewrite -rewrite 00 -close -close -Test completed -" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_file.at:16473" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_788 -#AT_START_789 -at_fn_group_banner 789 'run_file.at:16519' \ - "GC LINE SEQUENTIAL Long-Record" " " 4 -at_xfail=no -( - $as_echo "789. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >inp_data <<'_ATEOF' -Record 1................................X....... -Record 2.....................X -Record 3................................X... -_ATEOF - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - INPUT-OUTPUT SECTION. - FILE-CONTROL. - SELECT INFILE ASSIGN TO EXTERNAL INFILE - ORGANIZATION IS LINE SEQUENTIAL - FILE STATUS IS INPUT-STATUS . - - SELECT OUTFILE ASSIGN TO EXTERNAL OUTFILE - ORGANIZATION IS LINE SEQUENTIAL - FILE STATUS IS INPUT-STATUS . - - DATA DIVISION. - FILE SECTION. - FD INFILE - RECORD IS VARYING IN SIZE FROM 18 TO 40 CHARACTERS - DEPENDING ON INPUT-LEN - . - 01 INPUT-REC PIC X(40). - - FD OUTFILE - RECORD IS VARYING IN SIZE FROM 18 TO 40 CHARACTERS - DEPENDING ON INPUT-LEN - . - 01 OUTPUT-REC PIC X(40). - - WORKING-STORAGE SECTION. - - 01 OUTPUT-FILE PIC X(19) VALUE 'TEST-FILE'. - 01 INPUT-FILE PIC X(19) VALUE 'TEST-INP'. - 01 INPUT-STATUS PIC XX. - 01 INPUT-LEN PIC 999 VALUE 18 . - - PROCEDURE DIVISION. - A000-BEGIN. - OPEN INPUT INFILE. - READ INFILE - DISPLAY " Read 1: STATUS IS " INPUT-STATUS - " LENGTH IS " INPUT-LEN - DISPLAY " :" INPUT-REC ":" - READ INFILE - DISPLAY " Read 2: STATUS IS " INPUT-STATUS - " LENGTH IS " INPUT-LEN - DISPLAY " :" INPUT-REC ":" - MOVE 0 TO INPUT-LEN - READ INFILE - DISPLAY " Read 3: STATUS IS " INPUT-STATUS - " LENGTH IS " INPUT-LEN - DISPLAY " :" INPUT-REC ":" - MOVE SPACES TO INPUT-REC - MOVE 0 TO INPUT-LEN - READ INFILE - DISPLAY " Read 4: STATUS IS " INPUT-STATUS - " LENGTH IS " INPUT-LEN - IF INPUT-STATUS = "00" - DISPLAY " :" INPUT-REC ":" - END-IF - CLOSE INFILE - - OPEN OUTPUT OUTFILE - MOVE 9 TO INPUT-LEN - MOVE "Record 1............." TO OUTPUT-REC - WRITE OUTPUT-REC - DISPLAY "Write 1: STATUS IS " INPUT-STATUS - " LENGTH IS " INPUT-LEN - UPON CONSOLE - MOVE 64 TO INPUT-LEN - MOVE ALL '.' TO OUTPUT-REC - MOVE "Record 2" TO OUTPUT-REC (1:8) - WRITE OUTPUT-REC - DISPLAY "Write 2: STATUS IS " INPUT-STATUS - " LENGTH IS " INPUT-LEN - UPON CONSOLE - CLOSE OUTFILE - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_file.at:16607: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_file.at:16607" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_file.at:16607" -$at_failed && at_fn_log_failure -$at_traceon; } - - -{ set +x -$as_echo "$at_srcdir/run_file.at:16609: export DD_INFILE=./inp_data -export OUTFILE=TEST-FILE -./prog" -at_fn_check_prepare_notrace 'an embedded newline' "run_file.at:16609" -( $at_check_trace; export DD_INFILE=./inp_data -export OUTFILE=TEST-FILE -./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo " Read 1: STATUS IS 00 LENGTH IS 040 - :Record 1................................: - Read 2: STATUS IS 00 LENGTH IS 030 - :Record 2.....................X : - Read 3: STATUS IS 00 LENGTH IS 040 - :Record 3................................: - Read 4: STATUS IS 10 LENGTH IS 000 -Write 1: STATUS IS 00 LENGTH IS 009 -Write 2: STATUS IS 00 LENGTH IS 064 -" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_file.at:16609" -$at_failed && at_fn_log_failure -$at_traceon; } - - - - - -cat >reference <<'_ATEOF' -Record 1. -Record 2................................ -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_file.at:16630: gcdiff reference TEST-FILE" -at_fn_check_prepare_trace "run_file.at:16630" -( $at_check_trace; gcdiff reference TEST-FILE -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_file.at:16630" -$at_failed && at_fn_log_failure \ -"./TEST-FILE" -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_789 -#AT_START_790 -at_fn_group_banner 790 'run_file.at:16635' \ - "MF LINE SEQUENTIAL Long-Record" " " 4 -at_xfail=no -( - $as_echo "790. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >inp_data <<'_ATEOF' -Record 1................................X....... -Record 2.....................X -Record 3................................X... -_ATEOF - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - INPUT-OUTPUT SECTION. - FILE-CONTROL. - SELECT INFILE ASSIGN TO EXTERNAL INFILE - ORGANIZATION IS LINE SEQUENTIAL - FILE STATUS IS INPUT-STATUS . - - SELECT OUTFILE ASSIGN TO EXTERNAL OUTFILE - ORGANIZATION IS LINE SEQUENTIAL - FILE STATUS IS INPUT-STATUS . - - DATA DIVISION. - FILE SECTION. - FD INFILE - RECORD IS VARYING IN SIZE FROM 18 TO 40 CHARACTERS - DEPENDING ON INPUT-LEN - . - 01 INPUT-REC PIC X(40). - - FD OUTFILE - RECORD IS VARYING IN SIZE FROM 18 TO 40 CHARACTERS - DEPENDING ON INPUT-LEN - . - 01 OUTPUT-REC PIC X(40). - - WORKING-STORAGE SECTION. - - 01 OUTPUT-FILE PIC X(19) VALUE 'TEST-FILE'. - 01 INPUT-FILE PIC X(19) VALUE 'TEST-INP'. - 01 INPUT-STATUS PIC XX. - 01 INPUT-LEN PIC 999 VALUE 18 . - - PROCEDURE DIVISION. - A000-BEGIN. - OPEN INPUT INFILE. - READ INFILE - DISPLAY " Read 1: STATUS IS " INPUT-STATUS - " LENGTH IS " INPUT-LEN - DISPLAY " :" INPUT-REC ":" - READ INFILE - DISPLAY " Read 2: STATUS IS " INPUT-STATUS - " LENGTH IS " INPUT-LEN - DISPLAY " :" INPUT-REC ":" - MOVE 0 TO INPUT-LEN - READ INFILE - DISPLAY " Read 3: STATUS IS " INPUT-STATUS - " LENGTH IS " INPUT-LEN - DISPLAY " :" INPUT-REC ":" - MOVE SPACES TO INPUT-REC - MOVE 0 TO INPUT-LEN - READ INFILE - DISPLAY " Read 4: STATUS IS " INPUT-STATUS - " LENGTH IS " INPUT-LEN - IF INPUT-STATUS = "00" - DISPLAY " :" INPUT-REC ":" - END-IF - CLOSE INFILE - - OPEN OUTPUT OUTFILE - MOVE 9 TO INPUT-LEN - MOVE "Record 1............." TO OUTPUT-REC - WRITE OUTPUT-REC - DISPLAY "Write 1: STATUS IS " INPUT-STATUS - " LENGTH IS " INPUT-LEN - UPON CONSOLE - MOVE 64 TO INPUT-LEN - MOVE ALL '.' TO OUTPUT-REC - MOVE "Record 2" TO OUTPUT-REC (1:8) - WRITE OUTPUT-REC - DISPLAY "Write 2: STATUS IS " INPUT-STATUS - " LENGTH IS " INPUT-LEN - UPON CONSOLE - CLOSE OUTFILE - STOP RUN. -_ATEOF - - -# FIXME: must work with -std=mf alone --> -fmf-files split and included as configuration options! -# AT_CHECK([$COMPILE -std=mf prog.cob], [0], [], []) -{ set +x -$as_echo "$at_srcdir/run_file.at:16725: \$COMPILE -std=mf -fmf-files prog.cob" -at_fn_check_prepare_dynamic "$COMPILE -std=mf -fmf-files prog.cob" "run_file.at:16725" -( $at_check_trace; $COMPILE -std=mf -fmf-files prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_file.at:16725" -$at_failed && at_fn_log_failure -$at_traceon; } - - -{ set +x -$as_echo "$at_srcdir/run_file.at:16727: export DD_INFILE=./inp_data -export OUTFILE=TEST-FILE -\$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_notrace 'an embedded newline' "run_file.at:16727" -( $at_check_trace; export DD_INFILE=./inp_data -export OUTFILE=TEST-FILE -$COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo " Read 1: STATUS IS 00 LENGTH IS 040 - :Record 1................................: - Read 2: STATUS IS 00 LENGTH IS 008 - :X....... : - Read 3: STATUS IS 00 LENGTH IS 030 - :Record 2.....................X : - Read 4: STATUS IS 00 LENGTH IS 040 - :Record 3................................: -Write 1: STATUS IS 00 LENGTH IS 009 -Write 2: STATUS IS 00 LENGTH IS 064 -" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_file.at:16727" -$at_failed && at_fn_log_failure -$at_traceon; } - - - - - -cat >reference <<'_ATEOF' -Record 1. -Record 2................................ -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_file.at:16750: gcdiff reference TEST-FILE" -at_fn_check_prepare_trace "run_file.at:16750" -( $at_check_trace; gcdiff reference TEST-FILE -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_file.at:16750" -$at_failed && at_fn_log_failure \ -"./TEST-FILE" -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_790 -#AT_START_791 -at_fn_group_banner 791 'run_file.at:16755' \ - "Indexed with FH--FCD" " " 4 -at_xfail=no -( - $as_echo "791. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -$as_echo "run_file.at:16758" >"$at_check_line_file" -(test "$COB_HAS_ISAM" = "no") \ - && at_fn_check_skip 77 "$at_srcdir/run_file.at:16758" - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - - PROGRAM-ID. prog. - - ENVIRONMENT DIVISION. - CONFIGURATION SECTION. - - $set fcdreg - INPUT-OUTPUT SECTION. - FILE-CONTROL. - SELECT TSPFILE - ASSIGN TO "mytstisam" - ORGANIZATION INDEXED ACCESS DYNAMIC - RECORD KEY IS PRIME-KEY - SOURCE IS CM-CUST-NUM - - ALTERNATE RECORD KEY IS SPLIT-KEY2 - SOURCE IS CM-TELEPHONE,CM-MACHINE - * WITH DUPLICATES - - ALTERNATE RECORD KEY IS SPLIT-KEY3 - SOURCE IS CM-DISK,CM-TAPE - * WITH DUPLICATES - * SUPPRESS WHEN ALL "*" - FILE STATUS IS CUST-STAT - . - - DATA DIVISION. - FILE SECTION. - FD TSPFILE - BLOCK CONTAINS 5 RECORDS. - - 01 TSPFL-RECORD. - 05 TSPFL-REC. - 10 CM-CUST-NUM. - 15 CM-CUST-PRE PICTURE X(3). - 15 CM-CUST-NNN PICTURE X(5). - 10 CM-STATUS PICTURE X. - 10 CM-COMPANY PICTURE X(25). - 10 CM-ADDRESS-1 PICTURE X(25). - 10 CM-ADDRESS-2 PICTURE X(25). - 10 CM-ADDRESS-3 PICTURE X(25). - 10 CM-TELEPHONE PICTURE 9(10). - 10 CM-DP-MGR PICTURE X(25). - 10 CM-MACHINE PICTURE X(8). - 10 CM-MEMORY PICTURE X(4). - 10 CM-DISK PICTURE X(8). - 10 CM-TAPE PICTURE X(8). - 10 CM-NO-TERMINALS PICTURE 9(5). - - WORKING-STORAGE SECTION. - 01 CUST-STAT. - 05 STAT-1 PICTURE 9(4) COMP SYNC. - 05 FILLER REDEFINES STAT-1. - 10 STAT-X1 PIC X COMP-X. - 10 STAT-X2 PIC X COMP-X. - 77 BYTE-1 PICTURE 9(3). - 77 BYTE-2 PICTURE 9(3). - 77 MAX-SUB VALUE 16 PICTURE 9(2). - 77 IDX PICTURE 9. - 77 IDX2 PICTURE 9. - 77 OUT-FILE-NAME PICTURE X(9) - VALUE "myextisam". - - 01 TEST-DATA. - - 02 DATA-CUST-NUM-TBL. - - 05 FILLER PIC X(8) VALUE "ALP00000". - 05 FILLER PIC X(8) VALUE "BET00000". - 05 FILLER PIC X(8) VALUE "GAM00000". - 05 FILLER PIC X(8) VALUE "DEL00000". - 05 FILLER PIC X(8) VALUE "EPS00000". - 05 FILLER PIC X(8) VALUE "FOR00000". - 05 FILLER PIC X(8) VALUE "GIB00000". - 05 FILLER PIC X(8) VALUE "H&J00000". - 05 FILLER PIC X(8) VALUE "INC00000". - 05 FILLER PIC X(8) VALUE "JOH00000". - 05 FILLER PIC X(8) VALUE "KON00000". - 05 FILLER PIC X(8) VALUE "LEW00000". - 05 FILLER PIC X(8) VALUE "MOR00000". - 05 FILLER PIC X(8) VALUE "NEW00000". - 05 FILLER PIC X(8) VALUE "OLD00000". - 05 FILLER PIC X(8) VALUE "PRE00000". - - 02 DATA-CUST-NUM REDEFINES DATA-CUST-NUM-TBL - PIC X(8) OCCURS 16. - 02 DATA-COMPANY-TBL. - - 05 FILLER PIC X(25) VALUE "ALPHA ELECTRICAL CO. LTD.". - 05 FILLER PIC X(25) VALUE "BETA SHOE MFG. INC. ". - 05 FILLER PIC X(25) VALUE "GAMMA X-RAY TECHNOLOGY ". - 05 FILLER PIC X(25) VALUE "DELTA LUGGAGE REPAIRS ". - 05 FILLER PIC X(25) VALUE "EPSILON EQUIPMENT SUPPLY ". - 05 FILLER PIC X(25) VALUE "FORTUNE COOKIE COMPANY ". - 05 FILLER PIC X(25) VALUE "GIBRALTER LIFE INSURANCE ". - 05 FILLER PIC X(25) VALUE "H & J PLUMBING SUPPLIES ". - 05 FILLER PIC X(25) VALUE "INCREMENTAL BACKUP CORP. ". - 05 FILLER PIC X(25) VALUE "JOHNSON BOATING SUPPLIES ". - 05 FILLER PIC X(25) VALUE "KONFLAB PLASTIC PRODUCTS.". - 05 FILLER PIC X(25) VALUE "LEWISTON GRAPHICS LTD. ". - 05 FILLER PIC X(25) VALUE "MORNINGSIDE CARPENTRY. ". - 05 FILLER PIC X(25) VALUE "NEW WAVE SURF SHOPS INC. ". - 05 FILLER PIC X(25) VALUE "OLD TYME PIZZA MFG. CO. ". - 05 FILLER PIC X(25) VALUE "PRESTIGE OFFICE FURNITURE". - - 02 DATA-COMPANY REDEFINES DATA-COMPANY-TBL - PIC X(25) OCCURS 16. - 02 DATA-ADDRESS-1-TBL. - - 05 FILLER PIC X(25) VALUE "123 MAIN STREET ". - 05 FILLER PIC X(25) VALUE "1090 2ND AVE. WEST ". - 05 FILLER PIC X(25) VALUE "1401 JEFFERSON BLVD. ". - 05 FILLER PIC X(25) VALUE "1620 ARIZONA WAY ". - 05 FILLER PIC X(25) VALUE "1184 EAST FIRST STREET ". - 05 FILLER PIC X(25) VALUE "114 JOHN F. KENNEDY AVE. ". - 05 FILLER PIC X(25) VALUE "650 LIBERTY CRESCENT ". - 05 FILLER PIC X(25) VALUE "77 SUNSET BLVD. ". - 05 FILLER PIC X(25) VALUE "10908 SANTA MONICA BLVD. ". - 05 FILLER PIC X(25) VALUE "1134 PARIS ROAD ". - 05 FILLER PIC X(25) VALUE "808 NORTHWEST MAIN ST. ". - 05 FILLER PIC X(25) VALUE "9904 QUEEN STREET ". - 05 FILLER PIC X(25) VALUE "1709 DUNDAS CRESCENT W. ". - 05 FILLER PIC X(25) VALUE "3240 MARIS AVENUE ". - 05 FILLER PIC X(25) VALUE "1705 WISCONSIN ROAD ". - 05 FILLER PIC X(25) VALUE "114A MAPLE GROVE ". - - 02 DATA-ADDRESS-1 REDEFINES DATA-ADDRESS-1-TBL - PIC X(25) OCCURS 16. - 02 DATA-ADDRESS-2-TBL. - - 05 FILLER PIC X(10) VALUE "NEW YORK ". - 05 FILLER PIC X(10) VALUE "ATLANTA ". - 05 FILLER PIC X(10) VALUE "WASHINGTON". - 05 FILLER PIC X(10) VALUE "TORONTO ". - 05 FILLER PIC X(10) VALUE "CALGARY ". - 05 FILLER PIC X(10) VALUE "SAN DIEGO ". - 05 FILLER PIC X(10) VALUE "LOS RIOS ". - 05 FILLER PIC X(10) VALUE "MADISON ". - 05 FILLER PIC X(10) VALUE "WILBUR ". - 05 FILLER PIC X(10) VALUE "TOPEKA ". - 05 FILLER PIC X(10) VALUE "SEATTLE ". - 05 FILLER PIC X(10) VALUE "NEW JERSEY". - 05 FILLER PIC X(10) VALUE "FORT WAYNE". - 05 FILLER PIC X(10) VALUE "COLUMBUS ". - 05 FILLER PIC X(10) VALUE "RICHMOND ". - 05 FILLER PIC X(10) VALUE "WHITEPLAIN". - - 02 DATA-ADDRESS-2 REDEFINES DATA-ADDRESS-2-TBL - PIC X(10) OCCURS 16. - 02 DATA-ADDRESS-3-TBL. - - 05 FILLER PIC X(10) VALUE "N.Y. ". - 05 FILLER PIC X(10) VALUE "GEORGIA ". - 05 FILLER PIC X(10) VALUE "D.C. ". - 05 FILLER PIC X(10) VALUE "CANADA ". - 05 FILLER PIC X(10) VALUE "CANADA ". - 05 FILLER PIC X(10) VALUE "CALIFORNIA". - 05 FILLER PIC X(10) VALUE "NEW MEXICO". - 05 FILLER PIC X(10) VALUE "WISCONSIN ". - 05 FILLER PIC X(10) VALUE "DELAWARE ". - 05 FILLER PIC X(10) VALUE "KANSAS ". - 05 FILLER PIC X(10) VALUE "WASHINGTON". - 05 FILLER PIC X(10) VALUE "N.J. ". - 05 FILLER PIC X(10) VALUE "COLORADO ". - 05 FILLER PIC X(10) VALUE "OHIO ". - 05 FILLER PIC X(10) VALUE "VIRGINIA ". - 05 FILLER PIC X(10) VALUE "N.Y. ". - - 02 DATA-ADDRESS-3 REDEFINES DATA-ADDRESS-3-TBL - PIC X(10) OCCURS 16. - 02 DATA-TELEPHONE-TBL. - - 05 FILLER PIC 9(10) VALUE 3131234432. - 05 FILLER PIC 9(10) VALUE 4082938498. - 05 FILLER PIC 9(10) VALUE 8372487274. - 05 FILLER PIC 9(10) VALUE 4169898509. - 05 FILLER PIC 9(10) VALUE 5292398745. - 05 FILLER PIC 9(10) VALUE 8009329492. - 05 FILLER PIC 9(10) VALUE 6456445643. - 05 FILLER PIC 9(10) VALUE 6546456333. - 05 FILLER PIC 9(10) VALUE 3455445444. - 05 FILLER PIC 9(10) VALUE 6456445643. - 05 FILLER PIC 9(10) VALUE 7456434355. - 05 FILLER PIC 9(10) VALUE 6554456433. - 05 FILLER PIC 9(10) VALUE 4169898509. - 05 FILLER PIC 9(10) VALUE 7534587453. - 05 FILLER PIC 9(10) VALUE 8787458374. - 05 FILLER PIC 9(10) VALUE 4169898509. - - 02 DATA-TELEPHONE REDEFINES DATA-TELEPHONE-TBL - PIC 9(10) OCCURS 16. - 02 DATA-DP-MGR-TBL. - - 05 FILLER PIC X(20) VALUE "MR. DAVE HARRIS ". - 05 FILLER PIC X(20) VALUE "MS. JANICE SILCOX ". - 05 FILLER PIC X(20) VALUE "MR. ALLAN JONES ". - 05 FILLER PIC X(20) VALUE "MR. PETER MACKAY ". - 05 FILLER PIC X(20) VALUE "MRS. DONNA BREWER ". - 05 FILLER PIC X(20) VALUE "MR. MICHAEL SMYTHE ". - 05 FILLER PIC X(20) VALUE "MR. D.A. MORRISON ". - 05 FILLER PIC X(20) VALUE "MR. BRIAN PATTERSON ". - 05 FILLER PIC X(20) VALUE "MR. DARRYL TOWNSEND ". - 05 FILLER PIC X(20) VALUE "MS. VALERIE HARPER ". - 05 FILLER PIC X(20) VALUE "MR. FRED MILLER ". - 05 FILLER PIC X(20) VALUE "MR. DONALD FISCHER ". - 05 FILLER PIC X(20) VALUE "MR. STEVEN YOURDIN ". - 05 FILLER PIC X(20) VALUE "MS. Goldie Hawn ". - 05 FILLER PIC X(20) VALUE "MS. ALICE WINSTON ". - 05 FILLER PIC X(20) VALUE "MR. THOMAS JEFFERSON". - - 02 DATA-DP-MGR REDEFINES DATA-DP-MGR-TBL - PIC X(20) OCCURS 16. - 02 DATA-MACHINE-TBL. - - 05 FILLER PIC X(8) VALUE "UNI-9030". - 05 FILLER PIC X(8) VALUE "UNI-9040". - 05 FILLER PIC X(8) VALUE "UNI-80/3". - 05 FILLER PIC X(8) VALUE "UNI-80/5". - 05 FILLER PIC X(8) VALUE "UNI-80/6". - 05 FILLER PIC X(8) VALUE "UNI-80/6". - 05 FILLER PIC X(8) VALUE "UNI-80/6". - 05 FILLER PIC X(8) VALUE "UNI-80/8". - 05 FILLER PIC X(8) VALUE "UNI-80/8". - 05 FILLER PIC X(8) VALUE "UNI-80/8". - 05 FILLER PIC X(8) VALUE "UNI-80/8". - 05 FILLER PIC X(8) VALUE "UNI-80/8". - 05 FILLER PIC X(8) VALUE "UNI-80/8". - 05 FILLER PIC X(8) VALUE "UNI-80/8". - 05 FILLER PIC X(8) VALUE "UNI-9040". - 05 FILLER PIC X(8) VALUE "UNI-9040". - - 02 DATA-MACHINE REDEFINES DATA-MACHINE-TBL - PIC X(8) OCCURS 16. - 02 DATA-NO-TERMINALS-TBL. - - 05 FILLER PIC 9(3) COMP-3 VALUE 85. - 05 FILLER PIC 9(3) COMP-3 VALUE 34. - 05 FILLER PIC 9(3) COMP-3 VALUE 75. - 05 FILLER PIC 9(3) COMP-3 VALUE 45. - 05 FILLER PIC 9(3) COMP-3 VALUE 90. - 05 FILLER PIC 9(3) COMP-3 VALUE 107. - 05 FILLER PIC 9(3) COMP-3 VALUE 67. - 05 FILLER PIC 9(3) COMP-3 VALUE 32. - 05 FILLER PIC 9(3) COMP-3 VALUE 16. - 05 FILLER PIC 9(3) COMP-3 VALUE 34. - 05 FILLER PIC 9(3) COMP-3 VALUE 128. - 05 FILLER PIC 9(3) COMP-3 VALUE 64. - 05 FILLER PIC 9(3) COMP-3 VALUE 110. - 05 FILLER PIC 9(3) COMP-3 VALUE 324. - 05 FILLER PIC 9(3) COMP-3 VALUE 124. - 05 FILLER PIC 9(3) COMP-3 VALUE 86. - - 02 DATA-NO-TERMINALS REDEFINES DATA-NO-TERMINALS-TBL - PIC 9(3) COMP-3 OCCURS 16. - - 01 WORK-AREA. - 05 REC-NUM PICTURE 9(2) VALUE 0. - 05 SUB PICTURE 9(4) COMP SYNC. - 88 ODD-RECORD VALUE 1 3 5 7 9 10 11. - 88 NULL-KEY VALUE 4 5 8 12 14. - - 05 TSPFL-KEY PICTURE X(8). - 05 KC-PTR USAGE POINTER. - - LINKAGE SECTION. - - 01 TSP-FCD. - COPY "xfhfcd.cpy". - - 01 key-def. - 03 kdb-len pic 9(4) comp-x. - 03 filler pic x(4). - 03 key-nkeys pic 9(4) comp-x. - 03 filler pic x(6). - 03 key-defs occurs 1 to 8 times depending on key-nkeys. - 05 key-count pic 9(3) comp-x. - 05 key-offset pic 9(3) comp-x. - 05 key-flags pic X comp-x. - 05 key-compression pic X comp-x. - 05 key-sparse pic x. - 05 filler pic x(9). - - 01 key-comp. - 03 kc-desc pic X comp-x. - 03 kc-type pic X comp-x. - 03 kc-pos pic 9(9) comp-x. - 03 kc-len pic 9(9) comp-x. - - 01 TSP-FILENAME PIC X(256). - PROCEDURE DIVISION. - - MAINFILE. - SET ADDRESS OF TSP-FCD TO ADDRESS OF FH--FCD OF TSPFILE. - SET ADDRESS OF KEY-DEF TO ADDRESS OF FH--KEYDEF OF TSPFILE. - DISPLAY "Other Flags " FCD-OTHER-FLAGS "." - DISPLAY "File has " key-nkeys " keys." - DISPLAY "Key def " kdb-len " bytes." - SET ADDRESS OF TSP-FILENAME TO FCD-FILENAME-ADDRESS. - DISPLAY "File assigned is '" - TSP-FILENAME (1:FCD-NAME-LENGTH) "'". - SET FCD-FILENAME-ADDRESS TO ADDRESS OF OUT-FILE-NAME. - MOVE LENGTH OF OUT-FILE-NAME TO FCD-NAME-LENGTH. - DISPLAY "*** Dump FCD before changes" - PERFORM DUMP-FCD. - MOVE 64 TO KEY-FLAGS (2) - MOVE 66 TO KEY-FLAGS (3) - MOVE '*' TO KEY-SPARSE (3) - DISPLAY "*** Dump FCD after changes" - PERFORM DUMP-FCD. - PERFORM LOADFILE. - PERFORM LISTFILE. - STOP RUN. - - DUMP-FCD. - PERFORM VARYING IDX FROM 1 BY 1 - UNTIL IDX > key-nkeys - IF key-sparse (idx) < ' ' - MOVE ' ' TO key-sparse (idx) - END-IF - DISPLAY "Key" IDX " has " key-count (idx) " parts," - " Offset " key-offset (idx) - " Flags " key-flags (idx) - " Comp " key-compression (idx) - " Sparse " key-sparse (idx) "." - SET KC-PTR TO ADDRESS OF KEY-DEF - SET KC-PTR UP BY key-offset (idx) - PERFORM VARYING IDX2 FROM 1 BY 1 - UNTIL IDX2 > key-count (idx) - SET ADDRESS OF KEY-COMP TO KC-PTR - DISPLAY " Pos " kc-pos " Len " kc-len - SET KC-PTR UP BY LENGTH OF KEY-COMP - END-PERFORM - END-PERFORM. - - LOADFILE. - OPEN OUTPUT TSPFILE - SET ADDRESS OF TSP-FILENAME TO FCD-FILENAME-ADDRESS. - DISPLAY "Loading sample file '" - TSP-FILENAME (1:FCD-NAME-LENGTH) "'" - UPON CONSOLE. - - IF CUST-STAT NOT = "00" - AND CUST-STAT NOT = "05" - DISPLAY "Error " CUST-STAT " opening '" - TSP-FILENAME (1:FCD-NAME-LENGTH) "' file" - UPON CONSOLE - STOP RUN - END-IF. - - PERFORM 1000-LOAD-RECORD - VARYING SUB FROM 1 BY 1 - UNTIL SUB > MAX-SUB. - - DISPLAY "Sample data file load complete." - UPON CONSOLE. - CLOSE TSPFILE. - - *---------------------------------------------------------------* - * LOAD A RECORD FROM DATA TABLES * - *---------------------------------------------------------------* - - 1000-LOAD-RECORD. - - MOVE SPACES TO TSPFL-RECORD. - MOVE DATA-CUST-NUM (SUB) TO CM-CUST-NUM. - MOVE CM-CUST-NUM TO TSPFL-KEY. - MOVE DATA-COMPANY (SUB) TO CM-COMPANY. - MOVE DATA-ADDRESS-1 (SUB) TO CM-ADDRESS-1. - MOVE DATA-ADDRESS-2 (SUB) TO CM-ADDRESS-2. - MOVE DATA-ADDRESS-3 (SUB) TO CM-ADDRESS-3. - MOVE DATA-TELEPHONE (SUB) TO CM-TELEPHONE. - MOVE DATA-DP-MGR (SUB) TO CM-DP-MGR. - MOVE DATA-MACHINE (SUB) TO CM-MACHINE. - MOVE DATA-NO-TERMINALS (SUB) TO CM-NO-TERMINALS. - - IF ODD-RECORD - MOVE "8417" TO CM-DISK - MOVE "1600 BPI" TO CM-TAPE - MOVE "1MEG" TO CM-MEMORY - ELSE - MOVE "8470" TO CM-DISK - MOVE "6250 BPI" TO CM-TAPE - MOVE "3MEG" TO CM-MEMORY. - IF NULL-KEY - MOVE ALL "*" TO CM-DISK - MOVE ALL "*" TO CM-TAPE. - IF SUB = 1 OR 6 - MOVE "2417" TO CM-DISK - MOVE "549 mmm" TO CM-TAPE. - - WRITE TSPFL-RECORD - IF CUST-STAT NOT = "00" - AND CUST-STAT NOT = "02" - DISPLAY "WRITE: " TSPFL-KEY ", Status: " - CUST-STAT UPON CONSOLE - END-IF. - - LISTFILE. - MOVE ZERO TO REC-NUM - OPEN INPUT TSPFILE - SET ADDRESS OF TSP-FILENAME TO FCD-FILENAME-ADDRESS. - DISPLAY "List sample file '" - TSP-FILENAME (1:FCD-NAME-LENGTH) "'" - UPON CONSOLE. - IF CUST-STAT NOT = "00" - DISPLAY "ERROR " CUST-STAT " OPENING INPUT FILE" - UPON CONSOLE - IF CUST-STAT (1:1) = "9" - DISPLAY "Sub Error " STAT-X2 UPON CONSOLE - END-IF - STOP RUN - END-IF. - MOVE SPACES TO TSPFL-RECORD. - START TSPFILE KEY GREATER THAN PRIME-KEY - IF CUST-STAT NOT = "00" - DISPLAY "Error " CUST-STAT " starting file" - UPON CONSOLE - IF CUST-STAT (1:1) = "9" - DISPLAY "Sub Error " STAT-X2 UPON CONSOLE - END-IF - STOP RUN - END-IF. - READ TSPFILE NEXT RECORD WITH NO LOCK - IF CUST-STAT NOT = "00" - DISPLAY "Error " CUST-STAT " on 1st read of file" - UPON CONSOLE - IF CUST-STAT (1:1) = "9" - DISPLAY "Sub Error " STAT-X2 UPON CONSOLE - END-IF - STOP RUN - END-IF. - PERFORM UNTIL CUST-STAT NOT = "00" - OR REC-NUM > MAX-SUB - DISPLAY "Key: " CM-CUST-NUM " is " CM-COMPANY - " Disk=" CM-DISK "." - UPON CONSOLE - READ TSPFILE NEXT RECORD - AT END - MOVE "99" TO CUST-STAT - END-READ - ADD 1 TO REC-NUM - END-PERFORM - IF CUST-STAT = "99" - DISPLAY "Hit End of File after " REC-NUM UPON CONSOLE - END-IF. - - DISPLAY "LIST SAMPLE FILE DESCENDING" UPON CONSOLE. - MOVE ZERO TO REC-NUM - MOVE ALL 'Z' TO TSPFL-RECORD. - START TSPFILE KEY LESS THAN PRIME-KEY - IF CUST-STAT NOT = "00" - DISPLAY "Error " CUST-STAT " starting file" - UPON CONSOLE - STOP RUN - END-IF. - READ TSPFILE PREVIOUS RECORD WITH NO LOCK - IF CUST-STAT NOT = "00" - DISPLAY "Error " CUST-STAT " on 1st read of file" - UPON CONSOLE - STOP RUN - END-IF. - PERFORM UNTIL CUST-STAT NOT = "00" - OR REC-NUM > MAX-SUB - DISPLAY "Key: " CM-CUST-NUM " is " CM-COMPANY - " Disk=" CM-DISK "." - UPON CONSOLE - READ TSPFILE PREVIOUS RECORD - AT END - MOVE "99" TO CUST-STAT - END-READ - ADD 1 TO REC-NUM - END-PERFORM. - IF CUST-STAT = "99" - DISPLAY "Hit End of File after " REC-NUM UPON CONSOLE - END-IF. - - DISPLAY "LIST SAMPLE FILE BY KEY3" UPON CONSOLE. - MOVE ZERO TO REC-NUM - MOVE SPACES TO TSPFL-RECORD. - START TSPFILE KEY GREATER THAN OR EQUAL TO SPLIT-KEY3 - IF CUST-STAT NOT = "00" - AND CUST-STAT NOT = "02" - DISPLAY "Error " CUST-STAT " starting file" - UPON CONSOLE - STOP RUN - END-IF. - READ TSPFILE NEXT RECORD WITH NO LOCK - IF CUST-STAT NOT = "00" - AND CUST-STAT NOT = "02" - DISPLAY "Error " CUST-STAT " on 1st read of file" - UPON CONSOLE - STOP RUN - END-IF. - PERFORM UNTIL (CUST-STAT NOT = "00" - AND CUST-STAT NOT = "02") - OR REC-NUM > MAX-SUB - DISPLAY "Key: " CM-CUST-NUM " is " CM-COMPANY - " Disk=" CM-DISK "." - UPON CONSOLE - READ TSPFILE NEXT RECORD - AT END - MOVE "99" TO CUST-STAT - END-READ - ADD 1 TO REC-NUM - END-PERFORM. - IF CUST-STAT = "99" - DISPLAY "Hit End of File after " REC-NUM UPON CONSOLE - END-IF. - CLOSE TSPFILE. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_file.at:17273: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_file.at:17273" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_file.at:17273" -$at_failed && at_fn_log_failure -$at_traceon; } - - -{ set +x -$as_echo "$at_srcdir/run_file.at:17275: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_file.at:17275" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo "Other Flags 000. -File has 0003 keys. -Key def 0320 bytes. -File assigned is 'mytstisam' -*** Dump FCD before changes -Key1 has 001 parts, Offset 062 Flags 000 Comp 000 Sparse . - Pos 000000000 Len 000000008 -Key2 has 002 parts, Offset 072 Flags 000 Comp 000 Sparse . - Pos 000000109 Len 000000010 - Pos 000000144 Len 000000008 -Key3 has 002 parts, Offset 092 Flags 000 Comp 000 Sparse . - Pos 000000156 Len 000000008 - Pos 000000164 Len 000000008 -*** Dump FCD after changes -Key1 has 001 parts, Offset 062 Flags 000 Comp 000 Sparse . - Pos 000000000 Len 000000008 -Key2 has 002 parts, Offset 072 Flags 064 Comp 000 Sparse . - Pos 000000109 Len 000000010 - Pos 000000144 Len 000000008 -Key3 has 002 parts, Offset 092 Flags 066 Comp 000 Sparse *. - Pos 000000156 Len 000000008 - Pos 000000164 Len 000000008 -Loading sample file 'myextisam' -Sample data file load complete. -List sample file 'myextisam' -Key: ALP00000 is ALPHA ELECTRICAL CO. LTD. Disk=2417 . -Key: BET00000 is BETA SHOE MFG. INC. Disk=8470 . -Key: DEL00000 is DELTA LUGGAGE REPAIRS Disk=********. -Key: EPS00000 is EPSILON EQUIPMENT SUPPLY Disk=********. -Key: FOR00000 is FORTUNE COOKIE COMPANY Disk=2417 . -Key: GAM00000 is GAMMA X-RAY TECHNOLOGY Disk=8417 . -Key: GIB00000 is GIBRALTER LIFE INSURANCE Disk=8417 . -Key: H&J00000 is H & J PLUMBING SUPPLIES Disk=********. -Key: INC00000 is INCREMENTAL BACKUP CORP. Disk=8417 . -Key: JOH00000 is JOHNSON BOATING SUPPLIES Disk=8417 . -Key: KON00000 is KONFLAB PLASTIC PRODUCTS. Disk=8417 . -Key: LEW00000 is LEWISTON GRAPHICS LTD. Disk=********. -Key: MOR00000 is MORNINGSIDE CARPENTRY. Disk=8470 . -Key: NEW00000 is NEW WAVE SURF SHOPS INC. Disk=********. -Key: OLD00000 is OLD TYME PIZZA MFG. CO. Disk=8470 . -Key: PRE00000 is PRESTIGE OFFICE FURNITURE Disk=8470 . -Hit End of File after 16 -LIST SAMPLE FILE DESCENDING -Key: PRE00000 is PRESTIGE OFFICE FURNITURE Disk=8470 . -Key: OLD00000 is OLD TYME PIZZA MFG. CO. Disk=8470 . -Key: NEW00000 is NEW WAVE SURF SHOPS INC. Disk=********. -Key: MOR00000 is MORNINGSIDE CARPENTRY. Disk=8470 . -Key: LEW00000 is LEWISTON GRAPHICS LTD. Disk=********. -Key: KON00000 is KONFLAB PLASTIC PRODUCTS. Disk=8417 . -Key: JOH00000 is JOHNSON BOATING SUPPLIES Disk=8417 . -Key: INC00000 is INCREMENTAL BACKUP CORP. Disk=8417 . -Key: H&J00000 is H & J PLUMBING SUPPLIES Disk=********. -Key: GIB00000 is GIBRALTER LIFE INSURANCE Disk=8417 . -Key: GAM00000 is GAMMA X-RAY TECHNOLOGY Disk=8417 . -Key: FOR00000 is FORTUNE COOKIE COMPANY Disk=2417 . -Key: EPS00000 is EPSILON EQUIPMENT SUPPLY Disk=********. -Key: DEL00000 is DELTA LUGGAGE REPAIRS Disk=********. -Key: BET00000 is BETA SHOE MFG. INC. Disk=8470 . -Key: ALP00000 is ALPHA ELECTRICAL CO. LTD. Disk=2417 . -Hit End of File after 16 -LIST SAMPLE FILE BY KEY3 -Key: ALP00000 is ALPHA ELECTRICAL CO. LTD. Disk=2417 . -Key: FOR00000 is FORTUNE COOKIE COMPANY Disk=2417 . -Key: GAM00000 is GAMMA X-RAY TECHNOLOGY Disk=8417 . -Key: GIB00000 is GIBRALTER LIFE INSURANCE Disk=8417 . -Key: INC00000 is INCREMENTAL BACKUP CORP. Disk=8417 . -Key: JOH00000 is JOHNSON BOATING SUPPLIES Disk=8417 . -Key: KON00000 is KONFLAB PLASTIC PRODUCTS. Disk=8417 . -Key: BET00000 is BETA SHOE MFG. INC. Disk=8470 . -Key: MOR00000 is MORNINGSIDE CARPENTRY. Disk=8470 . -Key: OLD00000 is OLD TYME PIZZA MFG. CO. Disk=8470 . -Key: PRE00000 is PRESTIGE OFFICE FURNITURE Disk=8470 . -Hit End of File after 11 -" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_file.at:17275" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_791 -#AT_START_792 -at_fn_group_banner 792 'run_file.at:17352' \ - "PIPE I/O" " " 4 -at_xfail=no -( - $as_echo "792. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - CONFIGURATION SECTION. - - INPUT-OUTPUT SECTION. - FILE-CONTROL. - SELECT PIPEIO - ASSIGN TO PIPE-CMD - ORGANIZATION LINE SEQUENTIAL - FILE STATUS IS CUST-STAT . - - DATA DIVISION. - FILE SECTION. - FD PIPEIO - BLOCK CONTAINS 5 RECORDS. - 01 INP-RECORD PIC X(16). - - WORKING-STORAGE SECTION. - 01 PIPE-CMD PIC X(40). - 01 CUST-STAT PIC XX. - 01 SUB PIC 9(2). - 01 OPRN1 PIC 9(3). - 01 OPRN2 PIC 9(3). - 01 RSLT PIC 9(4). - 01 CMD-LINE. - 05 CMD PICTURE X(8). - 05 FILLER PICTURE X. - 05 CMD-KEY PICTURE X(8). - 01 ADD-LINE. - 05 NUM PICTURE 9(3). - 05 FILLER PICTURE X(8). - - PROCEDURE DIVISION. - - MAINFILE. - ACCEPT CMD-LINE FROM COMMAND-LINE. - IF CMD = 'HELLO' - DISPLAY "Bye Bye" - DISPLAY "Birdie" - STOP RUN - END-IF. - IF CMD = 'ECHO' - ACCEPT CMD-LINE FROM CONSOLE - DISPLAY "Echo: " CMD-LINE ":" - ACCEPT CMD-LINE FROM CONSOLE - DISPLAY "Echo: " CMD-LINE ":" - STOP RUN - END-IF. - IF CMD = 'ADD' - ACCEPT ADD-LINE FROM CONSOLE - MOVE NUM TO OPRN1 - ACCEPT ADD-LINE FROM CONSOLE - MOVE NUM TO OPRN2 - COMPUTE RSLT = OPRN1 + OPRN2 - DISPLAY "Result: " OPRN1 " + " OPRN2 " is " RSLT - STOP RUN - END-IF. - - PERFORM READPIPE. - PERFORM WRITEPIPE. - PERFORM ADD-PIPE. - PERFORM BAD-MODE. - PERFORM BAD-PIPE. - STOP RUN. - - READPIPE. - MOVE "<./prog HELLO" TO PIPE-CMD - DISPLAY "Show input from pipe". - OPEN INPUT PIPEIO. - PERFORM VARYING SUB FROM 1 BY 1 - UNTIL SUB > 50 - OR CUST-STAT NOT = "00" - READ PIPEIO - IF CUST-STAT = '00' - DISPLAY SUB ": " INP-RECORD ":" - END-IF - END-PERFORM. - CLOSE PIPEIO. - - WRITEPIPE. - MOVE ">./prog ECHO " TO PIPE-CMD - DISPLAY "Send data out pipe". - OPEN OUTPUT PIPEIO. - MOVE "Having" TO INP-RECORD - WRITE INP-RECORD. - MOVE "Fun Yet?" TO INP-RECORD - WRITE INP-RECORD. - CLOSE PIPEIO. - - ADD-PIPE. - MOVE "|./prog ADD " TO PIPE-CMD - DISPLAY "Exchange data via pipe". - OPEN I-O PIPEIO. - MOVE "001" TO INP-RECORD - WRITE INP-RECORD. - MOVE "003" TO INP-RECORD - WRITE INP-RECORD. - READ PIPEIO. - DISPLAY "Answer :" INP-RECORD ":" - CLOSE PIPEIO. - - BAD-PIPE. - MOVE "<./saywhat Foobar " TO PIPE-CMD - DISPLAY "Pipe read from unknown program.". - MOVE 'Peek a Boo' TO INP-RECORD - OPEN INPUT PIPEIO. - IF CUST-STAT NOT = '00' - DISPLAY "Bad Open status:" CUST-STAT - ELSE - READ PIPEIO - DISPLAY "Stat:" CUST-STAT ", Answer :" INP-RECORD ":" - CLOSE PIPEIO - END-IF. - MOVE ">./saywhat Foobar " TO PIPE-CMD - DISPLAY "Pipe write to unknown program.". - OPEN INPUT PIPEIO. - IF CUST-STAT NOT = '00' - DISPLAY "Bad Open status:" CUST-STAT - ELSE - MOVE 'Peek a Boo' TO INP-RECORD - WRITE INP-RECORD - DISPLAY "Stat:" CUST-STAT ", Sent :" INP-RECORD ":" - CLOSE PIPEIO - END-IF. - MOVE "|./saywhat Foobar " TO PIPE-CMD - DISPLAY "Pipe to unknown program.". - OPEN I-O PIPEIO. - IF CUST-STAT NOT = '00' - DISPLAY "Bad Open status:" CUST-STAT - ELSE - MOVE "001" TO INP-RECORD - WRITE INP-RECORD - IF CUST-STAT NOT = '00' - DISPLAY "Bad Write status:" CUST-STAT - END-IF - MOVE "003" TO INP-RECORD - WRITE INP-RECORD - READ PIPEIO - IF CUST-STAT NOT = '00' - DISPLAY "Bad Read status:" CUST-STAT - ELSE - DISPLAY "Answer :" INP-RECORD ":" - END-IF - CLOSE PIPEIO - END-IF. - - BAD-MODE. - MOVE "<./prog ECHO " TO PIPE-CMD - DISPLAY "Open pipe output mode mismatch". - OPEN OUTPUT PIPEIO. - IF CUST-STAT NOT = '00' - DISPLAY "Bad Mode Open status:" CUST-STAT - ELSE - MOVE "How did" TO INP-RECORD - WRITE INP-RECORD - MOVE "I get here" TO INP-RECORD - WRITE INP-RECORD - END-IF. - CLOSE PIPEIO. - - MOVE ">./prog HELLO " TO PIPE-CMD - DISPLAY "Open pipe input mode mismatch". - OPEN INPUT PIPEIO. - IF CUST-STAT NOT = '00' - DISPLAY "Bad Mode Open status:" CUST-STAT - ELSE - READ PIPEIO - DISPLAY "Got : " INP-RECORD ":" - CLOSE PIPEIO - END-IF. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_file.at:17529: \$COBC -x -std=default -w prog.cob " -at_fn_check_prepare_dynamic "$COBC -x -std=default -w prog.cob " "run_file.at:17529" -( $at_check_trace; $COBC -x -std=default -w prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_file.at:17529" -$at_failed && at_fn_log_failure -$at_traceon; } - - -{ set +x -$as_echo "$at_srcdir/run_file.at:17531: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_file.at:17531" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo stderr:; cat "$at_stderr" -echo >>"$at_stdout"; $as_echo "Show input from pipe -01: Bye Bye : -02: Birdie : -Send data out pipe -Echo: Having : -Echo: Fun Yet? : -Exchange data via pipe -Answer :Result: 001 + 00: -Open pipe output mode mismatch -Bad Mode Open status:37 -Open pipe input mode mismatch -Bad Mode Open status:37 -Pipe read from unknown program. -Stat:10, Answer :Peek a Boo : -Pipe write to unknown program. -Bad Open status:37 -Pipe to unknown program. -Bad Read status:10 -" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_file.at:17531" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_792 -#AT_START_793 -at_fn_group_banner 793 'run_file.at:17553' \ - "LINE SEQUENTIAL one Record" " " 4 -at_xfail=no -( - $as_echo "793. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - - ENVIRONMENT DIVISION. - CONFIGURATION SECTION. - - INPUT-OUTPUT SECTION. - FILE-CONTROL. - SELECT FLATFILE ASSIGN EXTERNAL SEQFIX - ORGANIZATION LINE SEQUENTIAL - FILE STATUS IS CUST-STAT . - - DATA DIVISION. - FILE SECTION. - FD FLATFILE - BLOCK CONTAINS 5 RECORDS. - - 01 TSPFL-RECORD. - 10 CM-CUST-NUM PICTURE X(8). - 10 CM-COMPANY PICTURE X(25). - 10 CM-DISK PICTURE X(8). - 10 CM-NO-TERMINALS PICTURE 9(5) COMP-4. - 10 CM-PK-DATE PICTURE S9(14) COMP-3. - 10 CM-TRAILER PICTURE X(52). - - WORKING-STORAGE SECTION. - - 77 MAX-SUB VALUE 6 PICTURE 9(4) COMP SYNC. - 77 CUST-STAT PICTURE X(2). - 77 REC-NUM VALUE 1 PICTURE 9(8) COMP SYNC. - - 01 TEST-DATA. - - 02 DATA-CUST-NUM-TBL. - - 05 FILLER PIC X(8) VALUE "ALP00000". - 05 FILLER PIC X(8) VALUE "BET00000". - 05 FILLER PIC X(8) VALUE "GAM00000". - 05 FILLER PIC X(8) VALUE "DEL00000". - 05 FILLER PIC X(8) VALUE "EPS00000". - 05 FILLER PIC X(8) VALUE "FOR00000". - - 02 DATA-CUST-NUM REDEFINES DATA-CUST-NUM-TBL - PIC X(8) OCCURS 6. - 02 DATA-COMPANY-TBL. - - 05 FILLER PIC X(25) VALUE "ALPHA ELECTRICAL CO. LTD.". - 05 FILLER PIC X(25) VALUE "BETA SHOE MFG. INC. ". - 05 FILLER PIC X(25) VALUE "GAMMA X-RAY TECHNOLOGY ". - 05 FILLER PIC X(25) VALUE "DELTA LUGGAGE REPAIRS ". - 05 FILLER PIC X(25) VALUE "EPSILON EQUIPMENT SUPPLY ". - 05 FILLER PIC X(25) VALUE "FORTUNE COOKIE COMPANY ". - 02 DATA-COMPANY REDEFINES DATA-COMPANY-TBL - PIC X(25) OCCURS 6. - 02 DATA-ADDRESS-2-TBL. - - 05 FILLER PIC X(10) VALUE "NEW YORK ". - 05 FILLER PIC X(10) VALUE "ATLANTA ". - 05 FILLER PIC X(10) VALUE "WASHINGTON". - 05 FILLER PIC X(10) VALUE "TORONTO ". - 05 FILLER PIC X(10) VALUE "CALGARY ". - 05 FILLER PIC X(10) VALUE "WHITEPLAIN". - - 02 DATA-ADDRESS REDEFINES DATA-ADDRESS-2-TBL - PIC X(10) OCCURS 6. - - 02 DATA-NO-TERMINALS-TBL. - - 05 FILLER PIC 9(5) COMP-3 VALUE 8240. - 05 FILLER PIC 9(5) COMP-3 VALUE 10. - 05 FILLER PIC 9(5) COMP-3 VALUE 13. - 05 FILLER PIC 9(5) COMP-3 VALUE 65535. - 05 FILLER PIC 9(5) COMP-3 VALUE 10. - 05 FILLER PIC 9(5) COMP-3 VALUE 254. - - 02 DATA-NO-TERMINALS REDEFINES DATA-NO-TERMINALS-TBL - PIC 9(5) COMP-3 OCCURS 6. - 01 WORK-AREA. - 05 SUB PICTURE 9(4) COMP SYNC. - 88 ODD-RECORD VALUE 1 3 5. - - - PROCEDURE DIVISION. - - PERFORM LOADFILE. - OPEN INPUT FLATFILE. - DISPLAY "Open Sts:" CUST-STAT - PERFORM READ-RECORD - PERFORM READ-RECORD - PERFORM READ-RECORD - PERFORM READ-RECORD - CLOSE FLATFILE. - - OPEN I-O FLATFILE. - PERFORM READ-RECORD - MOVE 10 TO CM-NO-TERMINALS - REWRITE TSPFL-RECORD - DISPLAY "REWRITE " CM-CUST-NUM " Sts " CUST-STAT - " Trms:" CM-NO-TERMINALS. - CLOSE FLATFILE. - - OPEN I-O FLATFILE. - PERFORM READ-RECORD - PERFORM READ-RECORD - ADD 1 TO CM-NO-TERMINALS - REWRITE TSPFL-RECORD - DISPLAY "REWRITE " CM-CUST-NUM " Sts " CUST-STAT - " Trms:" CM-NO-TERMINALS. - PERFORM READ-RECORD - CLOSE FLATFILE. - - OPEN I-O FLATFILE. - READ FLATFILE - READ FLATFILE - READ FLATFILE - READ FLATFILE - READ FLATFILE - DISPLAY "Read " CM-CUST-NUM " Sts:" CUST-STAT. - MOVE 8240 TO CM-NO-TERMINALS - REWRITE TSPFL-RECORD - DISPLAY "REWRITE " CM-CUST-NUM " Sts " CUST-STAT - " Trms:" CM-NO-TERMINALS. - CLOSE FLATFILE. - - OPEN INPUT FLATFILE. - DISPLAY "List back Open Sts:" CUST-STAT - PERFORM UNTIL CUST-STAT NOT = "00" - PERFORM READ-RECORD - END-PERFORM. - CLOSE FLATFILE. - - OPEN EXTEND FLATFILE. - PERFORM LOAD-RECORD - VARYING SUB FROM 1 BY 1 - UNTIL SUB > 2 - CLOSE FLATFILE. - - OPEN INPUT FLATFILE. - DISPLAY "List after extend Open Sts:" CUST-STAT - PERFORM UNTIL CUST-STAT NOT = "00" - PERFORM READ-RECORD - END-PERFORM. - CLOSE FLATFILE. - STOP RUN RETURNING 0. - - READ-RECORD. - MOVE SPACES TO TSPFL-RECORD. - READ FLATFILE - IF CUST-STAT NOT = "00" - DISPLAY "Read Status: " CUST-STAT - ELSE - DISPLAY "Read " CM-CUST-NUM - " Trms:" CM-NO-TERMINALS - END-IF. - - LOADFILE. - DISPLAY "Loading sample program data file." - UPON CONSOLE. - - OPEN OUTPUT FLATFILE. - - PERFORM LOAD-RECORD - VARYING SUB FROM 1 BY 1 - UNTIL SUB > MAX-SUB. - - DISPLAY "Sample program data file load complete." - UPON CONSOLE. - CLOSE FLATFILE. - - LOAD-RECORD. - - MOVE SPACES TO TSPFL-RECORD. - MOVE DATA-CUST-NUM (SUB) TO CM-CUST-NUM. - MOVE DATA-COMPANY (SUB) TO CM-COMPANY. - MOVE DATA-NO-TERMINALS (SUB) TO CM-NO-TERMINALS. - MOVE 20070319 TO CM-PK-DATE. - IF SUB = 5 - MOVE "Freddy Kruger" TO CM-TRAILER. - IF SUB = 1 OR 4 OR 6 - MOVE -20070319 TO CM-PK-DATE. - - IF ODD-RECORD - MOVE "8417" TO CM-DISK - ELSE - MOVE "8470" TO CM-DISK. - WRITE TSPFL-RECORD. - IF CUST-STAT NOT = "00" - DISPLAY "Write Error " CUST-STAT. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_file.at:17747: \$COBC -x -std=mf -w -fmf-files prog.cob " -at_fn_check_prepare_dynamic "$COBC -x -std=mf -w -fmf-files prog.cob " "run_file.at:17747" -( $at_check_trace; $COBC -x -std=mf -w -fmf-files prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_file.at:17747" -$at_failed && at_fn_log_failure -$at_traceon; } - - -{ set +x -$as_echo "$at_srcdir/run_file.at:17749: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_file.at:17749" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo "Loading sample program data file. -Sample program data file load complete. -Open Sts:00 -Read ALP00000 Trms:08240 -Read BET00000 Trms:00010 -Read GAM00000 Trms:00013 -Read DEL00000 Trms:65535 -Read ALP00000 Trms:08240 -REWRITE ALP00000 Sts 44 Trms:00010 -Read ALP00000 Trms:08240 -Read BET00000 Trms:00010 -REWRITE BET00000 Sts 00 Trms:00011 -Read GAM00000 Trms:00013 -Read EPS00000 Sts:00 -REWRITE EPS00000 Sts 00 Trms:08240 -List back Open Sts:00 -Read ALP00000 Trms:08240 -Read BET00000 Trms:00011 -Read GAM00000 Trms:00013 -Read DEL00000 Trms:65535 -Read EPS00000 Trms:08240 -Read FOR00000 Trms:00254 -Read Status: 10 -List after extend Open Sts:00 -Read ALP00000 Trms:08240 -Read BET00000 Trms:00011 -Read GAM00000 Trms:00013 -Read DEL00000 Trms:65535 -Read EPS00000 Trms:08240 -Read FOR00000 Trms:00254 -Read ALP00000 Trms:08240 -Read BET00000 Trms:00010 -Read Status: 10 -" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_file.at:17749" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_793 -#AT_START_794 -at_fn_group_banner 794 'run_file.at:17786' \ - "INDEXED File READ/DELETE/READ" " " 4 -at_xfail=no -( - $as_echo "794. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -$as_echo "run_file.at:17789" >"$at_check_line_file" -(test "$COB_HAS_ISAM" = "no") \ - && at_fn_check_skip 77 "$at_srcdir/run_file.at:17789" - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - - PROGRAM-ID. prog. - - ENVIRONMENT DIVISION. - CONFIGURATION SECTION. - - INPUT-OUTPUT SECTION. - FILE-CONTROL. - SELECT TSPFILE - ASSIGN TO EXTERNAL TSPFILE - ORGANIZATION INDEXED ACCESS DYNAMIC - RECORD KEY IS CM-CUST-NUM - - ALTERNATE RECORD KEY IS SPLIT-KEY2 - SOURCE IS CM-TELEPHONE WITH DUPLICATES - - ALTERNATE RECORD KEY IS SPLIT-KEY3 - SOURCE IS CM-DISK,CM-TAPE WITH DUPLICATES - * SUPPRESS WHEN ALL "*" - SUPPRESS WHEN "8417" - FILE STATUS IS CUST-STAT - . - - DATA DIVISION. - FILE SECTION. - FD TSPFILE - BLOCK CONTAINS 5 RECORDS. - - 01 TSPFL-RECORD. - 05 TSPFL-REC. - 10 CM-CUST-NUM. - 15 CM-CUST-PRE PICTURE X(3). - 15 CM-CUST-NNN PICTURE X(5). - 10 CM-STATUS PICTURE X. - 10 CM-COMPANY PICTURE X(25). - 10 CM-ADDRESS-1 PICTURE X(25). - 10 CM-ADDRESS-2 PICTURE X(25). - 10 CM-ADDRESS-3 PICTURE X(25). - 10 CM-TELEPHONE PICTURE 9(10). - 10 CM-DP-MGR PICTURE X(25). - 10 CM-MACHINE PICTURE X(8). - 10 CM-MEMORY PICTURE X(4). - 10 CM-DISK PICTURE X(8). - 10 CM-TAPE PICTURE X(8). - 10 CM-NO-TERMINALS PICTURE 9(5). - - WORKING-STORAGE SECTION. - - 01 CUST-STAT. - 05 STAT-1 PICTURE 9(4) COMP SYNC. - 05 FILLER REDEFINES STAT-1. - 10 STAT-X1 PIC X COMP-X. - 10 STAT-X2 PIC X COMP-X. - 77 DATA-STAT PICTURE XX. - 77 ISAM-STAT PICTURE XX. - 77 BYTE-1 PICTURE 9(3). - 77 BYTE-2 PICTURE 9(3). - 77 MAX-SUB VALUE 16 PICTURE 9(5) COMP SYNC. - 77 SAV-KEY PIC X(8). - - 01 TEST-DATA. - - 02 DATA-CUST-NUM-TBL. - - 05 FILLER PIC X(8) VALUE "ALP00000". - 05 FILLER PIC X(8) VALUE "BET00000". - 05 FILLER PIC X(8) VALUE "GAM00000". - 05 FILLER PIC X(8) VALUE "DEL00000". - 05 FILLER PIC X(8) VALUE "EPS00000". - 05 FILLER PIC X(8) VALUE "FOR00000". - 05 FILLER PIC X(8) VALUE "GIB00000". - 05 FILLER PIC X(8) VALUE "H&J00000". - 05 FILLER PIC X(8) VALUE "INC00000". - 05 FILLER PIC X(8) VALUE "JOH00000". - 05 FILLER PIC X(8) VALUE "KON00000". - 05 FILLER PIC X(8) VALUE "LEW00000". - 05 FILLER PIC X(8) VALUE "MOR00000". - 05 FILLER PIC X(8) VALUE "NEW00000". - 05 FILLER PIC X(8) VALUE "OLD00000". - 05 FILLER PIC X(8) VALUE "PRE00000". - - 02 DATA-CUST-NUM REDEFINES DATA-CUST-NUM-TBL - PIC X(8) OCCURS 16. - 02 DATA-COMPANY-TBL. - - 05 FILLER PIC X(25) VALUE "ALPHA ELECTRICAL CO. LTD.". - 05 FILLER PIC X(25) VALUE "BETA SHOE MFG. INC. ". - 05 FILLER PIC X(25) VALUE "GAMMA X-RAY TECHNOLOGY ". - 05 FILLER PIC X(25) VALUE "DELTA LUGGAGE REPAIRS ". - 05 FILLER PIC X(25) VALUE "EPSILON EQUIPMENT SUPPLY ". - 05 FILLER PIC X(25) VALUE "FORTUNE COOKIE COMPANY ". - 05 FILLER PIC X(25) VALUE "GIBRALTER LIFE INSURANCE ". - 05 FILLER PIC X(25) VALUE "H & J PLUMBING SUPPLIES ". - 05 FILLER PIC X(25) VALUE "INCREMENTAL BACKUP CORP. ". - 05 FILLER PIC X(25) VALUE "JOHNSON BOATING SUPPLIES ". - 05 FILLER PIC X(25) VALUE "KONFLAB PLASTIC PRODUCTS.". - 05 FILLER PIC X(25) VALUE "LEWISTON GRAPHICS LTD. ". - 05 FILLER PIC X(25) VALUE "MORNINGSIDE CARPENTRY. ". - 05 FILLER PIC X(25) VALUE "NEW WAVE SURF SHOPS INC. ". - 05 FILLER PIC X(25) VALUE "OLD TYME PIZZA MFG. CO. ". - 05 FILLER PIC X(25) VALUE "PRESTIGE OFFICE FURNITURE". - - 02 DATA-COMPANY REDEFINES DATA-COMPANY-TBL - PIC X(25) OCCURS 16. - 02 DATA-ADDRESS-1-TBL. - - 05 FILLER PIC X(25) VALUE "123 MAIN STREET ". - 05 FILLER PIC X(25) VALUE "1090 2ND AVE. WEST ". - 05 FILLER PIC X(25) VALUE "1401 JEFFERSON BLVD. ". - 05 FILLER PIC X(25) VALUE "1620 ARIZONA WAY ". - 05 FILLER PIC X(25) VALUE "1184 EAST FIRST STREET ". - 05 FILLER PIC X(25) VALUE "114 JOHN F. KENNEDY AVE. ". - 05 FILLER PIC X(25) VALUE "650 LIBERTY CRESCENT ". - 05 FILLER PIC X(25) VALUE "77 SUNSET BLVD. ". - 05 FILLER PIC X(25) VALUE "10908 SANTA MONICA BLVD. ". - 05 FILLER PIC X(25) VALUE "1134 PARIS ROAD ". - 05 FILLER PIC X(25) VALUE "808 NORTHWEST MAIN ST. ". - 05 FILLER PIC X(25) VALUE "9904 QUEEN STREET ". - 05 FILLER PIC X(25) VALUE "1709 DUNDAS CRESCENT W. ". - 05 FILLER PIC X(25) VALUE "3240 MARIS AVENUE ". - 05 FILLER PIC X(25) VALUE "1705 WISCONSIN ROAD ". - 05 FILLER PIC X(25) VALUE "114A MAPLE GROVE ". - - 02 DATA-ADDRESS-1 REDEFINES DATA-ADDRESS-1-TBL - PIC X(25) OCCURS 16. - 02 DATA-ADDRESS-2-TBL. - - 05 FILLER PIC X(10) VALUE "NEW YORK ". - 05 FILLER PIC X(10) VALUE "ATLANTA ". - 05 FILLER PIC X(10) VALUE "WASHINGTON". - 05 FILLER PIC X(10) VALUE "TORONTO ". - 05 FILLER PIC X(10) VALUE "CALGARY ". - 05 FILLER PIC X(10) VALUE "SAN DIEGO ". - 05 FILLER PIC X(10) VALUE "LOS RIOS ". - 05 FILLER PIC X(10) VALUE "MADISON ". - 05 FILLER PIC X(10) VALUE "WILBUR ". - 05 FILLER PIC X(10) VALUE "TOPEKA ". - 05 FILLER PIC X(10) VALUE "SEATTLE ". - 05 FILLER PIC X(10) VALUE "NEW JERSEY". - 05 FILLER PIC X(10) VALUE "FORT WAYNE". - 05 FILLER PIC X(10) VALUE "COLUMBUS ". - 05 FILLER PIC X(10) VALUE "RICHMOND ". - 05 FILLER PIC X(10) VALUE "WHITEPLAIN". - - 02 DATA-ADDRESS-2 REDEFINES DATA-ADDRESS-2-TBL - PIC X(10) OCCURS 16. - 02 DATA-ADDRESS-3-TBL. - - 05 FILLER PIC X(10) VALUE "N.Y. ". - 05 FILLER PIC X(10) VALUE "GEORGIA ". - 05 FILLER PIC X(10) VALUE "D.C. ". - 05 FILLER PIC X(10) VALUE "CANADA ". - 05 FILLER PIC X(10) VALUE "CANADA ". - 05 FILLER PIC X(10) VALUE "CALIFORNIA". - 05 FILLER PIC X(10) VALUE "NEW MEXICO". - 05 FILLER PIC X(10) VALUE "WISCONSIN ". - 05 FILLER PIC X(10) VALUE "DELAWARE ". - 05 FILLER PIC X(10) VALUE "KANSAS ". - 05 FILLER PIC X(10) VALUE "WASHINGTON". - 05 FILLER PIC X(10) VALUE "N.J. ". - 05 FILLER PIC X(10) VALUE "COLORADO ". - 05 FILLER PIC X(10) VALUE "OHIO ". - 05 FILLER PIC X(10) VALUE "VIRGINIA ". - 05 FILLER PIC X(10) VALUE "N.Y. ". - - 02 DATA-ADDRESS-3 REDEFINES DATA-ADDRESS-3-TBL - PIC X(10) OCCURS 16. - 02 DATA-TELEPHONE-TBL. - - 05 FILLER PIC 9(10) VALUE 3131234432. - 05 FILLER PIC 9(10) VALUE 4169898509. - 05 FILLER PIC 9(10) VALUE 8372487274. - 05 FILLER PIC 9(10) VALUE 4169898509. - 05 FILLER PIC 9(10) VALUE 5292398745. - 05 FILLER PIC 9(10) VALUE 8009329492. - 05 FILLER PIC 9(10) VALUE 6456445643. - 05 FILLER PIC 9(10) VALUE 6546456333. - 05 FILLER PIC 9(10) VALUE 3455445444. - 05 FILLER PIC 9(10) VALUE 6456445643. - 05 FILLER PIC 9(10) VALUE 7456434355. - 05 FILLER PIC 9(10) VALUE 6554456433. - 05 FILLER PIC 9(10) VALUE 4169898509. - 05 FILLER PIC 9(10) VALUE 7534587453. - 05 FILLER PIC 9(10) VALUE 8787458374. - 05 FILLER PIC 9(10) VALUE 4169898509. - - 02 DATA-TELEPHONE REDEFINES DATA-TELEPHONE-TBL - PIC 9(10) OCCURS 16. - 02 DATA-DP-MGR-TBL. - - 05 FILLER PIC X(20) VALUE "MR. DAVE HARRIS ". - 05 FILLER PIC X(20) VALUE "MS. JANICE SILCOX ". - 05 FILLER PIC X(20) VALUE "MR. ALLAN JONES ". - 05 FILLER PIC X(20) VALUE "MR. PETER MACKAY ". - 05 FILLER PIC X(20) VALUE "MRS. DONNA BREWER ". - 05 FILLER PIC X(20) VALUE "MR. MICHAEL SMYTHE ". - 05 FILLER PIC X(20) VALUE "MR. D.A. MORRISON ". - 05 FILLER PIC X(20) VALUE "MR. BRIAN PATTERSON ". - 05 FILLER PIC X(20) VALUE "MR. DARRYL TOWNSEND ". - 05 FILLER PIC X(20) VALUE "MS. VALERIE HARPER ". - 05 FILLER PIC X(20) VALUE "MR. FRED MILLER ". - 05 FILLER PIC X(20) VALUE "MR. DONALD FISCHER ". - 05 FILLER PIC X(20) VALUE "MR. STEVEN YOURDIN ". - 05 FILLER PIC X(20) VALUE "MS. Goldie Hawn ". - 05 FILLER PIC X(20) VALUE "MS. ALICE WINSTON ". - 05 FILLER PIC X(20) VALUE "MR. THOMAS JEFFERSON". - - 02 DATA-DP-MGR REDEFINES DATA-DP-MGR-TBL - PIC X(20) OCCURS 16. - 02 DATA-MACHINE-TBL. - - 05 FILLER PIC X(8) VALUE "UNI-9030". - 05 FILLER PIC X(8) VALUE "UNI-9040". - 05 FILLER PIC X(8) VALUE "UNI-80/3". - 05 FILLER PIC X(8) VALUE "UNI-80/5". - 05 FILLER PIC X(8) VALUE "UNI-80/6". - 05 FILLER PIC X(8) VALUE "UNI-80/6". - 05 FILLER PIC X(8) VALUE "UNI-80/6". - 05 FILLER PIC X(8) VALUE "UNI-80/8". - 05 FILLER PIC X(8) VALUE "UNI-80/8". - 05 FILLER PIC X(8) VALUE "UNI-80/8". - 05 FILLER PIC X(8) VALUE "UNI-80/8". - 05 FILLER PIC X(8) VALUE "UNI-80/8". - 05 FILLER PIC X(8) VALUE "UNI-80/8". - 05 FILLER PIC X(8) VALUE "UNI-80/8". - 05 FILLER PIC X(8) VALUE "UNI-9040". - 05 FILLER PIC X(8) VALUE "UNI-9040". - - 02 DATA-MACHINE REDEFINES DATA-MACHINE-TBL - PIC X(8) OCCURS 16. - 02 DATA-NO-TERMINALS-TBL. - - 05 FILLER PIC 9(3) COMP-3 VALUE 85. - 05 FILLER PIC 9(3) COMP-3 VALUE 34. - 05 FILLER PIC 9(3) COMP-3 VALUE 75. - 05 FILLER PIC 9(3) COMP-3 VALUE 45. - 05 FILLER PIC 9(3) COMP-3 VALUE 90. - 05 FILLER PIC 9(3) COMP-3 VALUE 107. - 05 FILLER PIC 9(3) COMP-3 VALUE 67. - 05 FILLER PIC 9(3) COMP-3 VALUE 32. - 05 FILLER PIC 9(3) COMP-3 VALUE 16. - 05 FILLER PIC 9(3) COMP-3 VALUE 34. - 05 FILLER PIC 9(3) COMP-3 VALUE 128. - 05 FILLER PIC 9(3) COMP-3 VALUE 64. - 05 FILLER PIC 9(3) COMP-3 VALUE 110. - 05 FILLER PIC 9(3) COMP-3 VALUE 324. - 05 FILLER PIC 9(3) COMP-3 VALUE 124. - 05 FILLER PIC 9(3) COMP-3 VALUE 86. - - 02 DATA-NO-TERMINALS REDEFINES DATA-NO-TERMINALS-TBL - PIC 9(3) COMP-3 OCCURS 16. - - 01 WORK-AREA. - 05 REC-NUM PICTURE 9(8) COMP VALUE 0. - 05 REC-COUNT PICTURE 9(8) COMP VALUE 0. - 05 REC-MAX PICTURE 9(6) VALUE 16. - 05 SUB PICTURE 9(4) COMP SYNC. - 88 ODD-RECORD VALUE 1 3 5 7 9 10 11. - 88 NULL-KEY VALUE 4 5 8 12 14. - - 05 TSPFL-KEY PICTURE X(8). - - PROCEDURE DIVISION. - - MAINFILE. - DISPLAY "Loading sample data file." - UPON CONSOLE. - PERFORM LOADFILE. - DISPLAY "Sample data file load complete." - UPON CONSOLE. - PERFORM LIST-FILE. - PERFORM LIST-PHONE. - PERFORM DELSEQ-FILE. - PERFORM LIST-PHONE. - PERFORM LOADFILE. - PERFORM LIST-PHONE. - PERFORM DELPRV-FILE. - PERFORM LIST-PHONE. - * PERFORM DEL-FILE. - STOP RUN. - - LOADFILE. - OPEN OUTPUT TSPFILE - IF CUST-STAT NOT = "00" - AND CUST-STAT NOT = "05" - DIVIDE STAT-1 BY 256 GIVING BYTE-1 REMAINDER BYTE-2 - DISPLAY "Error " CUST-STAT " " BYTE-1 " " BYTE-2 - " opening 'testisam' file" - UPON CONSOLE - STOP RUN - END-IF. - - PERFORM 1000-LOAD-RECORD - VARYING SUB FROM 1 BY 1 - UNTIL SUB > MAX-SUB. - - CLOSE TSPFILE. - - DEL-FILE. - DISPLAY "Rewrite sample data file: " CUST-STAT - UPON CONSOLE. - - OPEN I-O TSPFILE - IF CUST-STAT NOT = "00" - AND CUST-STAT NOT = "05" - DIVIDE STAT-1 BY 256 GIVING BYTE-1 REMAINDER BYTE-2 - DISPLAY "Error " CUST-STAT " " BYTE-1 " " BYTE-2 - " opening 'testisam' file" - UPON CONSOLE - STOP RUN - END-IF. - MOVE "DEL00000" TO CM-CUST-NUM - READ TSPFILE - IF CUST-STAT NOT = "00" - DISPLAY "Error " CUST-STAT " read lock " CM-CUST-NUM - END-IF - DELETE TSPFILE - IF CUST-STAT NOT = "00" - DISPLAY "Error " CUST-STAT " delete " CM-CUST-NUM - END-IF - MOVE "INC00000" TO CM-CUST-NUM - READ TSPFILE - IF CUST-STAT NOT = "00" - DISPLAY "Error " CUST-STAT " read lock " CM-CUST-NUM - END-IF - DELETE TSPFILE - IF CUST-STAT NOT = "00" - DISPLAY "Error " CUST-STAT " delete " CM-CUST-NUM - END-IF - - DISPLAY "Sample data file rewrite complete." - UPON CONSOLE. - CLOSE TSPFILE. - - DELSEQ-FILE. - DISPLAY "Test Read/Delete" UPON CONSOLE. - MOVE "00" TO CUST-STAT. - OPEN I-O TSPFILE - IF CUST-STAT NOT = "00" - AND CUST-STAT NOT = "05" - DIVIDE STAT-1 BY 256 GIVING BYTE-1 REMAINDER BYTE-2 - DISPLAY "Error " CUST-STAT " " BYTE-1 " " BYTE-2 - " opening 'testisam' file" - UPON CONSOLE - STOP RUN - END-IF. - MOVE "INC00000" TO CM-CUST-NUM - READ TSPFILE - IF CUST-STAT NOT = "00" - DISPLAY "Error " CUST-STAT " read " CM-CUST-NUM - END-IF - DELETE TSPFILE - IF CUST-STAT NOT = "00" - AND CUST-STAT NOT = "02" - DISPLAY "Error " CUST-STAT " delete " CM-CUST-NUM - ELSE - DISPLAY " Delete: " CM-CUST-NUM " random" - END-IF - MOVE "ALP00000" TO CM-CUST-NUM - READ TSPFILE - IF CUST-STAT NOT = "00" - AND CUST-STAT NOT = "02" - DISPLAY "Error " CUST-STAT " read " CM-CUST-NUM - END-IF - DELETE TSPFILE - IF CUST-STAT NOT = "00" - AND CUST-STAT NOT = "02" - DISPLAY "Error " CUST-STAT " delete " CM-CUST-NUM - ELSE - DISPLAY " Delete: " CM-CUST-NUM " random" - END-IF - READ TSPFILE NEXT RECORD - IF CUST-STAT NOT = "00" - AND CUST-STAT NOT = "02" - DISPLAY "Error " CUST-STAT " read " CM-CUST-NUM - ELSE - DISPLAY " Read: " CM-CUST-NUM " " CM-TELEPHONE - END-IF - MOVE "PRE00000" TO CM-CUST-NUM - READ TSPFILE - IF CUST-STAT NOT = "00" - AND CUST-STAT NOT = "02" - DISPLAY "Error " CUST-STAT " read " CM-CUST-NUM - END-IF - DELETE TSPFILE - IF CUST-STAT NOT = "00" - AND CUST-STAT NOT = "02" - DISPLAY "Error " CUST-STAT " delete " CM-CUST-NUM - ELSE - DISPLAY " Delete: " CM-CUST-NUM " random" - END-IF - READ TSPFILE NEXT RECORD - IF CUST-STAT NOT = "00" - AND CUST-STAT NOT = "02" - DISPLAY "Expected " CUST-STAT - " after delete " CM-CUST-NUM - ELSE - DISPLAY " Read: " CM-CUST-NUM " " CM-TELEPHONE - END-IF - - MOVE SPACES TO TSPFL-RECORD - MOVE '4169898509' TO CM-TELEPHONE - START TSPFILE KEY GREATER THAN OR EQUAL TO SPLIT-KEY2 - IF CUST-STAT NOT = "00" - DISPLAY "Error " CUST-STAT " read " CM-CUST-NUM - END-IF - PERFORM 4 TIMES - READ TSPFILE NEXT RECORD - IF CUST-STAT NOT = "00" - AND CUST-STAT NOT = "02" - DISPLAY "Error " CUST-STAT " start " CM-CUST-NUM - ELSE - DISPLAY "Initial: " CM-CUST-NUM " " CM-TELEPHONE - IF CM-TELEPHONE = '4169898509' - MOVE CM-CUST-NUM TO SAV-KEY - END-IF - END-IF - END-PERFORM - MOVE SPACES TO TSPFL-RECORD - MOVE '4169898509' TO CM-TELEPHONE - START TSPFILE KEY GREATER THAN OR EQUAL TO SPLIT-KEY2 - IF CUST-STAT NOT = "00" - DISPLAY "Error " CUST-STAT " read " CM-CUST-NUM - END-IF - READ TSPFILE NEXT RECORD - IF CUST-STAT NOT = "00" - AND CUST-STAT NOT = "02" - DISPLAY "Error " CUST-STAT " start " CM-CUST-NUM - ELSE - DISPLAY " Start: " CM-CUST-NUM " " CM-TELEPHONE - END-IF - READ TSPFILE NEXT RECORD - IF CUST-STAT NOT = "00" - AND CUST-STAT NOT = "02" - DISPLAY "Error " CUST-STAT " read " CM-CUST-NUM - ELSE - DISPLAY " Next: " CM-CUST-NUM " " CM-TELEPHONE - END-IF - DELETE TSPFILE - IF CUST-STAT NOT = "00" - AND CUST-STAT NOT = "02" - DISPLAY "Error " CUST-STAT " delete " CM-CUST-NUM - ELSE - DISPLAY " Delete: " CM-CUST-NUM " sequential" - END-IF - READ TSPFILE NEXT RECORD - IF CUST-STAT NOT = "00" - AND CUST-STAT NOT = "02" - DISPLAY "Error " CUST-STAT " read " CM-CUST-NUM - ELSE - DISPLAY " Next: " CM-CUST-NUM " " CM-TELEPHONE - IF CM-CUST-NUM NOT = SAV-KEY - DISPLAY "Problem! Expected:" SAV-KEY - END-IF - END-IF - READ TSPFILE NEXT RECORD - IF CUST-STAT NOT = "00" - AND CUST-STAT NOT = "02" - DISPLAY "Error " CUST-STAT " read " CM-CUST-NUM - ELSE - DISPLAY " Next: " CM-CUST-NUM " " CM-TELEPHONE - END-IF - DELETE TSPFILE - IF CUST-STAT NOT = "00" - AND CUST-STAT NOT = "02" - DISPLAY "Error " CUST-STAT " delete " CM-CUST-NUM - ELSE - DISPLAY " Delete: " CM-CUST-NUM " sequential" - END-IF - - CLOSE TSPFILE. - - DELPRV-FILE. - DISPLAY "Read Prev/Delete" UPON CONSOLE. - MOVE "00" TO CUST-STAT. - OPEN I-O TSPFILE - IF CUST-STAT NOT = "00" - AND CUST-STAT NOT = "05" - DIVIDE STAT-1 BY 256 GIVING BYTE-1 REMAINDER BYTE-2 - DISPLAY "Error " CUST-STAT " " BYTE-1 " " BYTE-2 - " opening 'testisam' file" - UPON CONSOLE - STOP RUN - END-IF. - - MOVE SPACES TO TSPFL-RECORD - MOVE '5292398745' TO CM-TELEPHONE - START TSPFILE KEY LESS THAN SPLIT-KEY2 - IF CUST-STAT NOT = "00" - DISPLAY "Error " CUST-STAT " read " CM-CUST-NUM - END-IF - PERFORM VARYING REC-NUM FROM 1 BY 1 - UNTIL REC-NUM > 4 - READ TSPFILE PREVIOUS RECORD - IF CUST-STAT NOT = "00" - AND CUST-STAT NOT = "02" - DISPLAY "Error " CUST-STAT " start " CM-CUST-NUM - ELSE - DISPLAY REC-NUM " Initial: " CM-CUST-NUM - " " CM-TELEPHONE - IF REC-NUM = 3 - MOVE CM-CUST-NUM TO SAV-KEY - END-IF - END-IF - END-PERFORM - MOVE SPACES TO TSPFL-RECORD - MOVE '5292398745' TO CM-TELEPHONE - START TSPFILE KEY LESS THAN SPLIT-KEY2 - IF CUST-STAT NOT = "00" - DISPLAY "Error " CUST-STAT " read " CM-CUST-NUM - END-IF - READ TSPFILE PREVIOUS RECORD - IF CUST-STAT NOT = "00" - AND CUST-STAT NOT = "02" - DISPLAY "Error " CUST-STAT " start " CM-CUST-NUM - ELSE - DISPLAY " Start: " CM-CUST-NUM " " CM-TELEPHONE - END-IF - READ TSPFILE PREVIOUS RECORD - IF CUST-STAT NOT = "00" - AND CUST-STAT NOT = "02" - DISPLAY "Error " CUST-STAT " read " CM-CUST-NUM - ELSE - DISPLAY " Prev: " CM-CUST-NUM " " CM-TELEPHONE - END-IF - DELETE TSPFILE - IF CUST-STAT NOT = "00" - AND CUST-STAT NOT = "02" - DISPLAY "Error " CUST-STAT " delete " CM-CUST-NUM - ELSE - DISPLAY " Delete: " CM-CUST-NUM " sequential" - END-IF - READ TSPFILE PREVIOUS RECORD - IF CUST-STAT NOT = "00" - AND CUST-STAT NOT = "02" - DISPLAY "Error " CUST-STAT " read prev " CM-CUST-NUM - CLOSE TSPFILE - STOP RUN - ELSE - DISPLAY " Prev: " CM-CUST-NUM " " CM-TELEPHONE - IF CM-CUST-NUM NOT = SAV-KEY - DISPLAY "Problem! Expected:" SAV-KEY - CLOSE TSPFILE - STOP RUN - END-IF - END-IF - READ TSPFILE PREVIOUS RECORD - IF CUST-STAT NOT = "00" - AND CUST-STAT NOT = "02" - DISPLAY "Error " CUST-STAT " read prev " CM-CUST-NUM - ELSE - DISPLAY " Prev: " CM-CUST-NUM " " CM-TELEPHONE - END-IF - DELETE TSPFILE - IF CUST-STAT NOT = "00" - AND CUST-STAT NOT = "02" - DISPLAY "Error " CUST-STAT " delete " CM-CUST-NUM - ELSE - DISPLAY " Delete: " CM-CUST-NUM " sequential" - END-IF - - CLOSE TSPFILE. - - LIST-FILE. - DISPLAY "List sample data file" - UPON CONSOLE. - MOVE "00" TO CUST-STAT. - MOVE 0 TO REC-NUM. - OPEN I-O TSPFILE - MOVE " " TO CM-CUST-NUM - START TSPFILE KEY GREATER THAN OR EQUAL TO CM-CUST-NUM - IF CUST-STAT NOT = "00" - DISPLAY "Error " CUST-STAT " read " CM-CUST-NUM - END-IF - READ TSPFILE NEXT RECORD - AT END - MOVE "99" TO CUST-STAT - END-READ. - IF CUST-STAT NOT = "00" - DISPLAY "Error " CUST-STAT " first read " CM-CUST-NUM - END-IF - PERFORM UNTIL CUST-STAT NOT = "00" - OR REC-NUM > REC-MAX - DISPLAY "Key: " CM-CUST-NUM " is " CM-COMPANY - " Disk=" CM-DISK - "." UPON CONSOLE - READ TSPFILE NEXT RECORD - AT END - MOVE "99" TO CUST-STAT - END-READ - ADD 1 TO REC-NUM - END-PERFORM. - IF CUST-STAT = "99" - DISPLAY "Hit End of File" UPON CONSOLE - END-IF. - CLOSE TSPFILE. - - LIST-PHONE. - DISPLAY "List sample data file by Phone" - UPON CONSOLE. - MOVE "00" TO CUST-STAT. - MOVE 0 TO REC-NUM. - OPEN I-O TSPFILE - MOVE SPACES TO TSPFL-RECORD - START TSPFILE KEY GREATER THAN OR EQUAL TO SPLIT-KEY2 - IF CUST-STAT NOT = "00" - AND CUST-STAT NOT = "02" - DISPLAY "Error " CUST-STAT " read " CM-CUST-NUM - END-IF - READ TSPFILE NEXT RECORD - AT END - MOVE "99" TO CUST-STAT - END-READ. - IF CUST-STAT NOT = "00" - AND CUST-STAT NOT = "02" - DISPLAY "Error " CUST-STAT " first read " CM-CUST-NUM - END-IF - PERFORM UNTIL CUST-STAT NOT = "00" - AND CUST-STAT NOT = "02" - DISPLAY "Ph=" CM-TELEPHONE - " Key: " CM-CUST-NUM " is " CM-COMPANY - "." UPON CONSOLE - READ TSPFILE NEXT RECORD - AT END - MOVE "99" TO CUST-STAT - END-READ - ADD 1 TO REC-NUM - END-PERFORM. - IF CUST-STAT = "99" - DISPLAY "Hit End of File" UPON CONSOLE - END-IF. - CLOSE TSPFILE. - - *---------------------------------------------------------------* - * LOAD A RECORD FROM DATA TABLES * - *---------------------------------------------------------------* - - 1000-LOAD-RECORD. - - MOVE SPACES TO TSPFL-RECORD. - MOVE DATA-CUST-NUM (SUB) TO CM-CUST-NUM. - MOVE CM-CUST-NUM TO TSPFL-KEY. - MOVE DATA-COMPANY (SUB) TO CM-COMPANY. - MOVE DATA-ADDRESS-1 (SUB) TO CM-ADDRESS-1. - MOVE DATA-ADDRESS-2 (SUB) TO CM-ADDRESS-2. - MOVE DATA-ADDRESS-3 (SUB) TO CM-ADDRESS-3. - MOVE DATA-TELEPHONE (SUB) TO CM-TELEPHONE. - MOVE DATA-DP-MGR (SUB) TO CM-DP-MGR. - MOVE DATA-MACHINE (SUB) TO CM-MACHINE. - MOVE DATA-NO-TERMINALS (SUB) TO CM-NO-TERMINALS. - - IF ODD-RECORD - MOVE "8417" TO CM-DISK - MOVE "1600 BPI" TO CM-TAPE - MOVE "1MEG" TO CM-MEMORY - ELSE - MOVE "8470" TO CM-DISK - MOVE "6250 BPI" TO CM-TAPE - MOVE "3MEG" TO CM-MEMORY. - IF NULL-KEY - MOVE ALL "*" TO CM-DISK - MOVE ALL "*" TO CM-TAPE. - - WRITE TSPFL-RECORD - IF CUST-STAT NOT = "00" - AND CUST-STAT NOT = "02" - DISPLAY "WRITE: " TSPFL-KEY ", Status: " - CUST-STAT UPON CONSOLE - END-IF. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_file.at:18464: \$COBC -x -std=mf -w prog.cob " -at_fn_check_prepare_dynamic "$COBC -x -std=mf -w prog.cob " "run_file.at:18464" -( $at_check_trace; $COBC -x -std=mf -w prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_file.at:18464" -$at_failed && at_fn_log_failure -$at_traceon; } - - -{ set +x -$as_echo "$at_srcdir/run_file.at:18466: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_file.at:18466" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo "Loading sample data file. -Sample data file load complete. -List sample data file -Key: ALP00000 is ALPHA ELECTRICAL CO. LTD. Disk=8417 . -Key: BET00000 is BETA SHOE MFG. INC. Disk=8470 . -Key: DEL00000 is DELTA LUGGAGE REPAIRS Disk=********. -Key: EPS00000 is EPSILON EQUIPMENT SUPPLY Disk=********. -Key: FOR00000 is FORTUNE COOKIE COMPANY Disk=8470 . -Key: GAM00000 is GAMMA X-RAY TECHNOLOGY Disk=8417 . -Key: GIB00000 is GIBRALTER LIFE INSURANCE Disk=8417 . -Key: H&J00000 is H & J PLUMBING SUPPLIES Disk=********. -Key: INC00000 is INCREMENTAL BACKUP CORP. Disk=8417 . -Key: JOH00000 is JOHNSON BOATING SUPPLIES Disk=8417 . -Key: KON00000 is KONFLAB PLASTIC PRODUCTS. Disk=8417 . -Key: LEW00000 is LEWISTON GRAPHICS LTD. Disk=********. -Key: MOR00000 is MORNINGSIDE CARPENTRY. Disk=8470 . -Key: NEW00000 is NEW WAVE SURF SHOPS INC. Disk=********. -Key: OLD00000 is OLD TYME PIZZA MFG. CO. Disk=8470 . -Key: PRE00000 is PRESTIGE OFFICE FURNITURE Disk=8470 . -Hit End of File -List sample data file by Phone -Ph=3131234432 Key: ALP00000 is ALPHA ELECTRICAL CO. LTD.. -Ph=3455445444 Key: INC00000 is INCREMENTAL BACKUP CORP. . -Ph=4169898509 Key: BET00000 is BETA SHOE MFG. INC. . -Ph=4169898509 Key: DEL00000 is DELTA LUGGAGE REPAIRS . -Ph=4169898509 Key: MOR00000 is MORNINGSIDE CARPENTRY. . -Ph=4169898509 Key: PRE00000 is PRESTIGE OFFICE FURNITURE. -Ph=5292398745 Key: EPS00000 is EPSILON EQUIPMENT SUPPLY . -Ph=6456445643 Key: GIB00000 is GIBRALTER LIFE INSURANCE . -Ph=6456445643 Key: JOH00000 is JOHNSON BOATING SUPPLIES . -Ph=6546456333 Key: H&J00000 is H & J PLUMBING SUPPLIES . -Ph=6554456433 Key: LEW00000 is LEWISTON GRAPHICS LTD. . -Ph=7456434355 Key: KON00000 is KONFLAB PLASTIC PRODUCTS.. -Ph=7534587453 Key: NEW00000 is NEW WAVE SURF SHOPS INC. . -Ph=8009329492 Key: FOR00000 is FORTUNE COOKIE COMPANY . -Ph=8372487274 Key: GAM00000 is GAMMA X-RAY TECHNOLOGY . -Ph=8787458374 Key: OLD00000 is OLD TYME PIZZA MFG. CO. . -Hit End of File -Test Read/Delete - Delete: INC00000 random - Delete: ALP00000 random - Read: BET00000 4169898509 - Delete: PRE00000 random -Expected 10 after delete PRE00000 -Initial: BET00000 4169898509 -Initial: DEL00000 4169898509 -Initial: MOR00000 4169898509 -Initial: EPS00000 5292398745 - Start: BET00000 4169898509 - Next: DEL00000 4169898509 - Delete: DEL00000 sequential - Next: MOR00000 4169898509 - Next: EPS00000 5292398745 - Delete: EPS00000 sequential -List sample data file by Phone -Ph=4169898509 Key: BET00000 is BETA SHOE MFG. INC. . -Ph=4169898509 Key: MOR00000 is MORNINGSIDE CARPENTRY. . -Ph=6456445643 Key: GIB00000 is GIBRALTER LIFE INSURANCE . -Ph=6456445643 Key: JOH00000 is JOHNSON BOATING SUPPLIES . -Ph=6546456333 Key: H&J00000 is H & J PLUMBING SUPPLIES . -Ph=6554456433 Key: LEW00000 is LEWISTON GRAPHICS LTD. . -Ph=7456434355 Key: KON00000 is KONFLAB PLASTIC PRODUCTS.. -Ph=7534587453 Key: NEW00000 is NEW WAVE SURF SHOPS INC. . -Ph=8009329492 Key: FOR00000 is FORTUNE COOKIE COMPANY . -Ph=8372487274 Key: GAM00000 is GAMMA X-RAY TECHNOLOGY . -Ph=8787458374 Key: OLD00000 is OLD TYME PIZZA MFG. CO. . -Hit End of File -List sample data file by Phone -Ph=3131234432 Key: ALP00000 is ALPHA ELECTRICAL CO. LTD.. -Ph=3455445444 Key: INC00000 is INCREMENTAL BACKUP CORP. . -Ph=4169898509 Key: BET00000 is BETA SHOE MFG. INC. . -Ph=4169898509 Key: DEL00000 is DELTA LUGGAGE REPAIRS . -Ph=4169898509 Key: MOR00000 is MORNINGSIDE CARPENTRY. . -Ph=4169898509 Key: PRE00000 is PRESTIGE OFFICE FURNITURE. -Ph=5292398745 Key: EPS00000 is EPSILON EQUIPMENT SUPPLY . -Ph=6456445643 Key: GIB00000 is GIBRALTER LIFE INSURANCE . -Ph=6456445643 Key: JOH00000 is JOHNSON BOATING SUPPLIES . -Ph=6546456333 Key: H&J00000 is H & J PLUMBING SUPPLIES . -Ph=6554456433 Key: LEW00000 is LEWISTON GRAPHICS LTD. . -Ph=7456434355 Key: KON00000 is KONFLAB PLASTIC PRODUCTS.. -Ph=7534587453 Key: NEW00000 is NEW WAVE SURF SHOPS INC. . -Ph=8009329492 Key: FOR00000 is FORTUNE COOKIE COMPANY . -Ph=8372487274 Key: GAM00000 is GAMMA X-RAY TECHNOLOGY . -Ph=8787458374 Key: OLD00000 is OLD TYME PIZZA MFG. CO. . -Hit End of File -Read Prev/Delete -00000001 Initial: PRE00000 4169898509 -00000002 Initial: MOR00000 4169898509 -00000003 Initial: DEL00000 4169898509 -00000004 Initial: BET00000 4169898509 - Start: PRE00000 4169898509 - Prev: MOR00000 4169898509 - Delete: MOR00000 sequential - Prev: DEL00000 4169898509 - Prev: BET00000 4169898509 - Delete: BET00000 sequential -List sample data file by Phone -Ph=3131234432 Key: ALP00000 is ALPHA ELECTRICAL CO. LTD.. -Ph=3455445444 Key: INC00000 is INCREMENTAL BACKUP CORP. . -Ph=4169898509 Key: DEL00000 is DELTA LUGGAGE REPAIRS . -Ph=4169898509 Key: PRE00000 is PRESTIGE OFFICE FURNITURE. -Ph=5292398745 Key: EPS00000 is EPSILON EQUIPMENT SUPPLY . -Ph=6456445643 Key: GIB00000 is GIBRALTER LIFE INSURANCE . -Ph=6456445643 Key: JOH00000 is JOHNSON BOATING SUPPLIES . -Ph=6546456333 Key: H&J00000 is H & J PLUMBING SUPPLIES . -Ph=6554456433 Key: LEW00000 is LEWISTON GRAPHICS LTD. . -Ph=7456434355 Key: KON00000 is KONFLAB PLASTIC PRODUCTS.. -Ph=7534587453 Key: NEW00000 is NEW WAVE SURF SHOPS INC. . -Ph=8009329492 Key: FOR00000 is FORTUNE COOKIE COMPANY . -Ph=8372487274 Key: GAM00000 is GAMMA X-RAY TECHNOLOGY . -Ph=8787458374 Key: OLD00000 is OLD TYME PIZZA MFG. CO. . -Hit End of File -" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_file.at:18466" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_794 -#AT_START_795 -at_fn_group_banner 795 'run_reportwriter.at:23' \ - "Report Line Order" " " 4 -at_xfail=no -( - $as_echo "795. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - *>**************************************************************** - *> 11NOV2013 BUG 001 - RWCS Presents RF before it presents the ** - *> last PF ** - *>**************************************************************** - ENVIRONMENT DIVISION. - INPUT-OUTPUT SECTION. - FILE-CONTROL. - SELECT REPORT-FILE ASSIGN TO EXTERNAL PRINTOUT - LINE SEQUENTIAL. - DATA DIVISION. - FILE SECTION. - FD REPORT-FILE - REPORT IS RWCS-Report. - WORKING-STORAGE SECTION. - REPORT SECTION. - RD RWCS-Report - PAGE LIMIT 12 - HEADING 1 - FIRST DETAIL 4 - LAST DETAIL 7. - - 01 TYPE REPORT HEADING LINE 1. - 05 COL 1 VALUE 'RH'. - - 01 TYPE PAGE HEADING LINE PLUS 1. - 05 COL 1 VALUE 'PH'. - - 01 Detail-Line TYPE DETAIL LINE PLUS 1. - 05 COL 1 VALUE 'DE'. - - 01 TYPE PAGE FOOTING LINE NUMBER 10. - 05 COL 1 VALUE 'PF'. - - 01 TYPE REPORT FOOTING LINE NUMBER PLUS 1. - 05 COL 1 VALUE 'RF'. - - PROCEDURE DIVISION. - 010-Main SECTION. - 1. OPEN OUTPUT REPORT-FILE - INITIATE RWCS-Report - GENERATE Detail-Line - GENERATE Detail-Line - GENERATE Detail-Line - GENERATE Detail-Line - GENERATE Detail-Line - GENERATE Detail-Line - GENERATE Detail-Line - GENERATE Detail-Line - TERMINATE RWCS-Report - CLOSE REPORT-FILE - . -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_reportwriter.at:82: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_reportwriter.at:82" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_reportwriter.at:82" -$at_failed && at_fn_log_failure -$at_traceon; } - - -{ set +x -$as_echo "$at_srcdir/run_reportwriter.at:84: DD_PRINTOUT=\"./report.txt\" \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "DD_PRINTOUT=\"./report.txt\" $COBCRUN_DIRECT ./prog" "run_reportwriter.at:84" -( $at_check_trace; DD_PRINTOUT="./report.txt" $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_reportwriter.at:84" -$at_failed && at_fn_log_failure -$at_traceon; } - - - - - -cat >reference <<'_ATEOF' -RH -PH - -DE -DE -DE -DE - - -PF - -PH - - -DE -DE -DE -DE - - - -PF - -RF -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_reportwriter.at:115: diff reference report.txt" -at_fn_check_prepare_trace "run_reportwriter.at:115" -( $at_check_trace; diff reference report.txt -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_reportwriter.at:115" -$at_failed && at_fn_log_failure \ -"./report.txt" -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_795 -#AT_START_796 -at_fn_group_banner 796 'run_reportwriter.at:120' \ - "REPORT COL PLUS" " " 4 -at_xfail=no -( - $as_echo "796. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - *>**************************************************************** - *> 11NOV2013 BUG 002 - RWCS Treats "COL PLUS n" the same as ** - *> "COL n". ** - *>**************************************************************** - ENVIRONMENT DIVISION. - INPUT-OUTPUT SECTION. - FILE-CONTROL. - SELECT REPORT-FILE ASSIGN TO EXTERNAL PRINTOUT - LINE SEQUENTIAL. - DATA DIVISION. - FILE SECTION. - FD REPORT-FILE - REPORT IS RWCS-Report. - WORKING-STORAGE SECTION. - REPORT SECTION. - RD RWCS-Report - PAGE LIMIT 12 - HEADING 1 - FIRST DETAIL 4 - LAST DETAIL 7. - - 01 Detail-Line TYPE DETAIL. - 05 LINE NUMBER PLUS 1. - 10 COL 1 PIC X(20) VALUE '12345678901234567890'. - 10 COL PLUS 3 PIC X(4) VALUE 'ABCD'. - 10 COL 30 PIC X(1) VALUE '!'. - - PROCEDURE DIVISION. - 010-Main SECTION. - 1. OPEN OUTPUT REPORT-FILE - INITIATE RWCS-Report - GENERATE Detail-Line - TERMINATE RWCS-Report - CLOSE REPORT-FILE - . -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_reportwriter.at:163: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_reportwriter.at:163" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_reportwriter.at:163" -$at_failed && at_fn_log_failure -$at_traceon; } - - -{ set +x -$as_echo "$at_srcdir/run_reportwriter.at:165: DD_PRINTOUT=\"./report.txt\" \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "DD_PRINTOUT=\"./report.txt\" $COBCRUN_DIRECT ./prog" "run_reportwriter.at:165" -( $at_check_trace; DD_PRINTOUT="./report.txt" $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_reportwriter.at:165" -$at_failed && at_fn_log_failure -$at_traceon; } - - - - - -cat >reference <<'_ATEOF' - - - -12345678901234567890 ABCD ! - - - - - - - - -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_reportwriter.at:184: diff reference report.txt" -at_fn_check_prepare_trace "run_reportwriter.at:184" -( $at_check_trace; diff reference report.txt -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_reportwriter.at:184" -$at_failed && at_fn_log_failure \ -"./report.txt" -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_796 -#AT_START_797 -at_fn_group_banner 797 'run_reportwriter.at:189' \ - "Report Overlapping Fields" " " 4 -at_xfail=no -( - $as_echo "797. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - *>**************************************************************** - *> 11NOV2013 BUG 003 - RWCS causes "Abort trap 6" if an attempt ** - *> is made to overwrite previous field on ** - *> a line ** - *>**************************************************************** - ENVIRONMENT DIVISION. - INPUT-OUTPUT SECTION. - FILE-CONTROL. - SELECT REPORT-FILE ASSIGN TO EXTERNAL PRINTOUT - LINE SEQUENTIAL. - DATA DIVISION. - FILE SECTION. - FD REPORT-FILE - REPORT IS RWCS-Report. - WORKING-STORAGE SECTION. - REPORT SECTION. - RD RWCS-Report - PAGE LIMIT 12 - HEADING 1 - FIRST DETAIL 4 - LAST DETAIL 7. - - 01 Detail-Line TYPE DETAIL. - 05 LINE NUMBER PLUS 1. - 10 COL 1 PIC X(20) VALUE '12345678901234567890'. - 10 COL 10 PIC X(4) VALUE 'ABCD'. - - PROCEDURE DIVISION. - 010-Main SECTION. - 1. OPEN OUTPUT REPORT-FILE - INITIATE RWCS-Report - GENERATE Detail-Line - TERMINATE RWCS-Report - CLOSE REPORT-FILE - . -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_reportwriter.at:232: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_reportwriter.at:232" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_reportwriter.at:232" -$at_failed && at_fn_log_failure -$at_traceon; } - - -{ set +x -$as_echo "$at_srcdir/run_reportwriter.at:234: DD_PRINTOUT=\"./report.txt\" \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "DD_PRINTOUT=\"./report.txt\" $COBCRUN_DIRECT ./prog" "run_reportwriter.at:234" -( $at_check_trace; DD_PRINTOUT="./report.txt" $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_reportwriter.at:234" -$at_failed && at_fn_log_failure -$at_traceon; } - - - - - -cat >reference <<'_ATEOF' - - - -123456789ABCD4567890 - - - - - - - - -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_reportwriter.at:253: diff reference report.txt" -at_fn_check_prepare_trace "run_reportwriter.at:253" -( $at_check_trace; diff reference report.txt -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_reportwriter.at:253" -$at_failed && at_fn_log_failure \ -"./report.txt" -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_797 -#AT_START_798 -at_fn_group_banner 798 'run_reportwriter.at:258' \ - "EMPTY REPORT" " " 4 -at_xfail=no -( - $as_echo "798. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - *>**************************************************************** - *> 11NOV2013 BUG 004 - RWCS INITIATE TERMINATE W/O GENERATE ** - *> IS NOT SUPPOSED TO PRODUCE ANY OUTPUT ** - *>**************************************************************** - ENVIRONMENT DIVISION. - INPUT-OUTPUT SECTION. - FILE-CONTROL. - SELECT REPORT-FILE ASSIGN TO EXTERNAL PRINTOUT - LINE SEQUENTIAL. - DATA DIVISION. - FILE SECTION. - FD REPORT-FILE - REPORT IS RWCS-Report. - WORKING-STORAGE SECTION. - REPORT SECTION. - RD RWCS-Report - PAGE LIMIT 12 - HEADING 1 - FIRST DETAIL 4 - LAST DETAIL 7 - CONTROL IS FINAL. - - 01 TYPE REPORT HEADING LINE 1. - 05 COL 1 VALUE 'RH'. - - 01 TYPE PAGE HEADING LINE PLUS 1. - 05 COL 1 VALUE 'PH'. - - 01 Detail-Line TYPE DETAIL LINE PLUS 1. - 05 COL 1 VALUE 'DE'. - - 01 TYPE CONTROL FOOTING FINAL. - 05 COL 1 VALUE 'CFF'. - - 01 TYPE PAGE FOOTING LINE NUMBER 10. - 05 COL 1 VALUE 'PF'. - - 01 TYPE REPORT FOOTING LINE NUMBER 1. - 05 COL 1 VALUE 'RF'. - - PROCEDURE DIVISION. - 010-Main SECTION. - 1. OPEN OUTPUT REPORT-FILE - INITIATE RWCS-Report - TERMINATE RWCS-Report - CLOSE REPORT-FILE - . -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_reportwriter.at:313: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_reportwriter.at:313" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_reportwriter.at:313" -$at_failed && at_fn_log_failure -$at_traceon; } - - -{ set +x -$as_echo "$at_srcdir/run_reportwriter.at:315: DD_PRINTOUT=\"./report.txt\" \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "DD_PRINTOUT=\"./report.txt\" $COBCRUN_DIRECT ./prog" "run_reportwriter.at:315" -( $at_check_trace; DD_PRINTOUT="./report.txt" $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_reportwriter.at:315" -$at_failed && at_fn_log_failure -$at_traceon; } - - - - - -: >reference - -{ set +x -$as_echo "$at_srcdir/run_reportwriter.at:322: diff reference report.txt" -at_fn_check_prepare_trace "run_reportwriter.at:322" -( $at_check_trace; diff reference report.txt -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_reportwriter.at:322" -$at_failed && at_fn_log_failure \ -"./report.txt" -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_798 -#AT_START_799 -at_fn_group_banner 799 'run_reportwriter.at:327' \ - "PAGE LIMIT REPORT" " " 4 -at_xfail=no -( - $as_echo "799. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - - ENVIRONMENT DIVISION. - INPUT-OUTPUT SECTION. - FILE-CONTROL. - SELECT report-file ASSIGN EXTERNAL PRINTOUT - ORGANIZATION LINE SEQUENTIAL. - - DATA DIVISION. - FILE SECTION. - FD report-file REPORT rp. - - WORKING-STORAGE SECTION. - 01 foo PIC X(20). - 01 hedpos PIC 99 VALUE 10. - - REPORT SECTION. - RD rp PAGE LIMIT 3. - - 01 rp-detail TYPE DE. - 02 LINE + 1. - 03 COL 1; SOURCE foo, PIC X(30). - 03 COL + 2 PIC X(6) VALUE "<--->". - - PROCEDURE DIVISION. - OPEN OUTPUT report-file. - INITIATE rp. - - MOVE "hello" TO foo. - GENERATE rp-detail. - - MOVE "goodbye" TO foo. - GENERATE rp-detail. - - TERMINATE rp. - CLOSE report-file. - STOP RUN. - END PROGRAM prog. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_reportwriter.at:372: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_reportwriter.at:372" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_reportwriter.at:372" -$at_failed && at_fn_log_failure -$at_traceon; } - - -{ set +x -$as_echo "$at_srcdir/run_reportwriter.at:374: DD_PRINTOUT=./report.txt \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "DD_PRINTOUT=./report.txt $COBCRUN_DIRECT ./prog" "run_reportwriter.at:374" -( $at_check_trace; DD_PRINTOUT=./report.txt $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_reportwriter.at:374" -$at_failed && at_fn_log_failure -$at_traceon; } - - - - - -cat >reference <<'_ATEOF' -hello <---> -goodbye <---> - -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_reportwriter.at:384: diff reference report.txt" -at_fn_check_prepare_trace "run_reportwriter.at:384" -( $at_check_trace; diff reference report.txt -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_reportwriter.at:384" -$at_failed && at_fn_log_failure \ -"./report.txt" -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_799 -#AT_START_800 -at_fn_group_banner 800 'run_reportwriter.at:389' \ - "PAGE LIMIT REPORT 2" " " 4 -at_xfail=no -( - $as_echo "800. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - INPUT-OUTPUT SECTION. - FILE-CONTROL. - SELECT report-file ASSIGN EXTERNAL PRINTOUT - ORGANIZATION LINE SEQUENTIAL. - - DATA DIVISION. - FILE SECTION. - FD report-file REPORT rp. - - WORKING-STORAGE SECTION. - 01 foo PIC X(20). - - REPORT SECTION. - RD rp PAGE LIMIT 3 LINES. - - 01 rp-detail TYPE DE. - 02 LINE + 1. - 03 SOURCE foo, PIC X(30). - 03 COL + 2 PIC X(6) VALUE "<--->". - - PROCEDURE DIVISION. - OPEN OUTPUT report-file. - INITIATE rp. - - MOVE "hello" TO foo. - GENERATE rp-detail. - - MOVE "world" TO foo. - GENERATE rp-detail. - - MOVE "from" TO foo. - GENERATE rp-detail. - - MOVE "REPORT WRITER" TO foo. - GENERATE rp-detail. - - MOVE "goodbye" TO foo. - GENERATE rp-detail. - - TERMINATE rp - CLOSE report-file. - - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_reportwriter.at:441: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_reportwriter.at:441" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_reportwriter.at:441" -$at_failed && at_fn_log_failure -$at_traceon; } - - -{ set +x -$as_echo "$at_srcdir/run_reportwriter.at:443: DD_PRINTOUT=./report.txt \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "DD_PRINTOUT=./report.txt $COBCRUN_DIRECT ./prog" "run_reportwriter.at:443" -( $at_check_trace; DD_PRINTOUT=./report.txt $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_reportwriter.at:443" -$at_failed && at_fn_log_failure -$at_traceon; } - - - - - -cat >reference <<'_ATEOF' -hello <---> -world <---> -from <---> -REPORT WRITER <---> -goodbye <---> - -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_reportwriter.at:456: diff reference report.txt" -at_fn_check_prepare_trace "run_reportwriter.at:456" -( $at_check_trace; diff reference report.txt -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_reportwriter.at:456" -$at_failed && at_fn_log_failure \ -"./report.txt" -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_800 -#AT_START_801 -at_fn_group_banner 801 'run_reportwriter.at:461' \ - "Sample Customer Report" " " 4 -at_xfail=no -( - $as_echo "801. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >inp_data <<'_ATEOF' -0152 J. LANGDON 87653 02475 -0152 J. LANGDON 64025 00945 -0152 J. LANGDON 41915 01370 -0152 J. LANGDON 17410 00251 -2468 L. MORRISEY 18520 00375 -2468 L. MORRISEY 20012 00420 -2468 L. MORRISEY 31572 01015 -2468 L. MORRISEY 48792 03750 -2468 L. MORRISEY 50407 01515 -2468 L. MORRISEY 61575 02010 -2468 L. MORRISEY 79204 05170 -2468 L. MORRISEY 85075 03784 -2468 L. MORRISEY 98476 08794 -3451 M. JACKSON 37847 02790 -3451 M. JACKSON 58492 06850 -3451 M. JACKSON 60010 02040 -3451 M. JACKSON 85260 07852 -3451 M. JACKSON 90520 02752 -4512 S. LEVITT 24680 03050 -4512 S. LEVITT 56784 05253 -4512 S. LEVITT 60410 01215 -4512 S. LEVITT 78952 08925 -4512 S. LEVITT 85278 04975 -4512 S. LEVITT 87492 06425 -4512 S. LEVITT 97204 08475 -5417 K. CONKLIN 13579 03572 -5417 K. CONKLIN 24615 01875 -5417 K. CONKLIN 34928 03745 -5417 K. CONKLIN 48527 08750 -5417 K. CONKLIN 50150 01895 -5417 K. CONKLIN 54652 03892 -5417 K. CONKLIN 59765 09895 -5417 K. CONKLIN 71572 01895 -5417 K. CONKLIN 85175 08010 -5417 K. CONKLIN 90275 00460 -5417 K. CONKLIN 91572 01857 -5417 K. CONKLIN 97576 08495 -6213 Z. HAMPTON 15792 06425 -6213 Z. HAMPTON 19975 09875 -6213 Z. HAMPTON 34576 05115 -6213 Z. HAMPTON 49512 08520 -7545 M. LARSON 14676 03845 -7545 M. LARSON 18592 08251 -7545 M. LARSON 19994 09898 -7545 M. LARSON 21214 01515 -7545 M. LARSON 37515 08212 -7545 M. LARSON 38592 09615 -7545 M. LARSON 48485 08714 -7545 M. LARSON 52762 03792 -7545 M. LARSON 57684 08015 -7545 M. LARSON 79015 09625 -7545 M. LARSON 80123 00560 -7545 M. LARSON 82462 02015 -7545 M. LARSON 91520 01815 -7545 M. LARSON 93715 04015 -_ATEOF - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - - * ************************************************************* * - * REPORT WRITER EXAMPLE #1. * - * ************************************************************* * - - ENVIRONMENT DIVISION. - CONFIGURATION SECTION. - - INPUT-OUTPUT SECTION. - FILE-CONTROL. - - SELECT TRANSACTION-DATA - ASSIGN TO EXTERNAL DATAIN - ORGANIZATION IS LINE SEQUENTIAL. - - SELECT REPORT-FILE - ASSIGN TO EXTERNAL LINE ADVANCING SYSPRINT. - - DATA DIVISION. - FILE SECTION. - - FD TRANSACTION-DATA. - - 01 TRANSACTION-RECORD. - 03 TR-CUSTOMER-NUMBER PIC 9(04). - 03 FILLER PIC X(01). - 03 TR-CUSTOMER-NAME PIC X(16). - 03 FILLER PIC X(01). - 03 TR-ITEM-NUMBER PIC 9(05). - 03 FILLER REDEFINES TR-ITEM-NUMBER. - 05 TR-ITEM-DEPARTMENT PIC 9(01). - 05 FILLER PIC 9(04). - 03 FILLER PIC X(01). - 03 TR-ITEM-COST PIC 9(03)V99. - 03 FILLER PIC X(47). - - FD REPORT-FILE - REPORT IS CUSTOMER-REPORT. - - WORKING-STORAGE SECTION. - 77 END-OF-FILE-SWITCH PIC X(1) VALUE 'N'. - 88 END-OF-FILE VALUE 'Y'. - - REPORT SECTION. - RD CUSTOMER-REPORT - PAGE LIMIT IS 66 LINES - HEADING 1 - FIRST DETAIL 5 - LAST DETAIL 58. - - 01 PAGE-HEAD-GROUP TYPE PAGE HEADING. - 02 LINE 1. - 03 COLUMN 27 PIC X(41) VALUE - 'C U S T O M E R C H A R G E R E P O R T'. - 02 LINE PLUS 2. - 03 COLUMN 01 PIC X(09) VALUE 'CUST. NO.'. - 03 COLUMN 15 PIC X(10) VALUE 'CUST. NAME'. - 03 COLUMN 30 PIC X(05) VALUE 'DEPT.'. - 03 COLUMN 39 PIC X(08) VALUE 'ITEM NO.'. - 03 COLUMN 51 PIC X(09) VALUE 'ITEM COST'. - - 01 CHARGE-DETAIL TYPE DETAIL. - 02 LINE PLUS 1. - 03 COLUMN 03 PIC Z(04) SOURCE TR-CUSTOMER-NUMBER. - 03 COLUMN 10 PIC X(16) SOURCE TR-CUSTOMER-NAME. - 03 COLUMN 32 PIC 9(01) SOURCE TR-ITEM-DEPARTMENT. - 03 COLUMN 40 PIC 9(05) SOURCE TR-ITEM-NUMBER. - 03 COLUMN 51 PIC $$$$.99 SOURCE TR-ITEM-COST. - - PROCEDURE DIVISION. - - 000-INITIATE. - - OPEN INPUT TRANSACTION-DATA, - OUTPUT REPORT-FILE. - - INITIATE CUSTOMER-REPORT. - - READ TRANSACTION-DATA - AT END - MOVE 'Y' TO END-OF-FILE-SWITCH. - * END-READ. - - PERFORM 100-PROCESS-TRANSACTION-DATA THRU 199-EXIT - UNTIL END-OF-FILE. - - 000-TERMINATE. - TERMINATE CUSTOMER-REPORT. - - CLOSE TRANSACTION-DATA, - REPORT-FILE. - - STOP RUN. - - 100-PROCESS-TRANSACTION-DATA. - GENERATE CHARGE-DETAIL. - READ TRANSACTION-DATA - AT END - MOVE 'Y' TO END-OF-FILE-SWITCH. - * END-READ. - - 199-EXIT. - EXIT. - - -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_reportwriter.at:631: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_reportwriter.at:631" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_reportwriter.at:631" -$at_failed && at_fn_log_failure -$at_traceon; } - - -{ set +x -$as_echo "$at_srcdir/run_reportwriter.at:633: DD_DATAIN=\"./inp_data\" DD_SYSPRINT=\"./report.txt\" \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "DD_DATAIN=\"./inp_data\" DD_SYSPRINT=\"./report.txt\" $COBCRUN_DIRECT ./prog" "run_reportwriter.at:633" -( $at_check_trace; DD_DATAIN="./inp_data" DD_SYSPRINT="./report.txt" $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_reportwriter.at:633" -$at_failed && at_fn_log_failure -$at_traceon; } - - - - - -cat >reference <<'_ATEOF' - C U S T O M E R C H A R G E R E P O R T - -CUST. NO. CUST. NAME DEPT. ITEM NO. ITEM COST - - 152 J. LANGDON 8 87653 $24.75 - 152 J. LANGDON 6 64025 $9.45 - 152 J. LANGDON 4 41915 $13.70 - 152 J. LANGDON 1 17410 $2.51 - 2468 L. MORRISEY 1 18520 $3.75 - 2468 L. MORRISEY 2 20012 $4.20 - 2468 L. MORRISEY 3 31572 $10.15 - 2468 L. MORRISEY 4 48792 $37.50 - 2468 L. MORRISEY 5 50407 $15.15 - 2468 L. MORRISEY 6 61575 $20.10 - 2468 L. MORRISEY 7 79204 $51.70 - 2468 L. MORRISEY 8 85075 $37.84 - 2468 L. MORRISEY 9 98476 $87.94 - 3451 M. JACKSON 3 37847 $27.90 - 3451 M. JACKSON 5 58492 $68.50 - 3451 M. JACKSON 6 60010 $20.40 - 3451 M. JACKSON 8 85260 $78.52 - 3451 M. JACKSON 9 90520 $27.52 - 4512 S. LEVITT 2 24680 $30.50 - 4512 S. LEVITT 5 56784 $52.53 - 4512 S. LEVITT 6 60410 $12.15 - 4512 S. LEVITT 7 78952 $89.25 - 4512 S. LEVITT 8 85278 $49.75 - 4512 S. LEVITT 8 87492 $64.25 - 4512 S. LEVITT 9 97204 $84.75 - 5417 K. CONKLIN 1 13579 $35.72 - 5417 K. CONKLIN 2 24615 $18.75 - 5417 K. CONKLIN 3 34928 $37.45 - 5417 K. CONKLIN 4 48527 $87.50 - 5417 K. CONKLIN 5 50150 $18.95 - 5417 K. CONKLIN 5 54652 $38.92 - 5417 K. CONKLIN 5 59765 $98.95 - 5417 K. CONKLIN 7 71572 $18.95 - 5417 K. CONKLIN 8 85175 $80.10 - 5417 K. CONKLIN 9 90275 $4.60 - 5417 K. CONKLIN 9 91572 $18.57 - 5417 K. CONKLIN 9 97576 $84.95 - 6213 Z. HAMPTON 1 15792 $64.25 - 6213 Z. HAMPTON 1 19975 $98.75 - 6213 Z. HAMPTON 3 34576 $51.15 - 6213 Z. HAMPTON 4 49512 $85.20 - 7545 M. LARSON 1 14676 $38.45 - 7545 M. LARSON 1 18592 $82.51 - 7545 M. LARSON 1 19994 $98.98 - 7545 M. LARSON 2 21214 $15.15 - 7545 M. LARSON 3 37515 $82.12 - 7545 M. LARSON 3 38592 $96.15 - 7545 M. LARSON 4 48485 $87.14 - 7545 M. LARSON 5 52762 $37.92 - 7545 M. LARSON 5 57684 $80.15 - 7545 M. LARSON 7 79015 $96.25 - 7545 M. LARSON 8 80123 $5.60 - 7545 M. LARSON 8 82462 $20.15 - 7545 M. LARSON 9 91520 $18.15 - - - - - - - - C U S T O M E R C H A R G E R E P O R T - -CUST. NO. CUST. NAME DEPT. ITEM NO. ITEM COST - - 7545 M. LARSON 9 93715 $40.15 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_reportwriter.at:771: diff reference report.txt" -at_fn_check_prepare_trace "run_reportwriter.at:771" -( $at_check_trace; diff reference report.txt -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_reportwriter.at:771" -$at_failed && at_fn_log_failure \ -"./report.txt" -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_801 -#AT_START_802 -at_fn_group_banner 802 'run_reportwriter.at:776' \ - "Sample Charge Report" " " 4 -at_xfail=no -( - $as_echo "802. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >inp_data <<'_ATEOF' -0152 J. LANGDON 87653 02475 -0152 J. LANGDON 64025 00945 -0152 J. LANGDON 41915 01370 -0152 J. LANGDON 17410 00251 -2468 L. MORRISEY 18520 00375 -2468 L. MORRISEY 20012 00420 -2468 L. MORRISEY 31572 01015 -2468 L. MORRISEY 48792 03750 -2468 L. MORRISEY 50407 01515 -2468 L. MORRISEY 61575 02010 -2468 L. MORRISEY 79204 05170 -2468 L. MORRISEY 85075 03784 -2468 L. MORRISEY 98476 08794 -3451 M. JACKSON 37847 02790 -3451 M. JACKSON 58492 06850 -3451 M. JACKSON 60010 02040 -3451 M. JACKSON 85260 07852 -3451 M. JACKSON 90520 02752 -4512 S. LEVITT 24680 03050 -4512 S. LEVITT 56784 05253 -4512 S. LEVITT 60410 01215 -4512 S. LEVITT 78952 08925 -4512 S. LEVITT 85278 04975 -4512 S. LEVITT 87492 06425 -4512 S. LEVITT 97204 08475 -5417 K. CONKLIN 13579 03572 -5417 K. CONKLIN 24615 01875 -5417 K. CONKLIN 34928 03745 -5417 K. CONKLIN 48527 08750 -5417 K. CONKLIN 50150 01895 -5417 K. CONKLIN 54652 03892 -5417 K. CONKLIN 59765 09895 -5417 K. CONKLIN 71572 01895 -5417 K. CONKLIN 85175 08010 -5417 K. CONKLIN 90275 00460 -5417 K. CONKLIN 91572 01857 -5417 K. CONKLIN 97576 08495 -6213 Z. HAMPTON 15792 06425 -6213 Z. HAMPTON 19975 09875 -6213 Z. HAMPTON 34576 05115 -6213 Z. HAMPTON 49512 08520 -7545 M. LARSON 14676 03845 -7545 M. LARSON 18592 08251 -7545 M. LARSON 19994 09898 -7545 M. LARSON 21214 01515 -7545 M. LARSON 37515 08212 -7545 M. LARSON 38592 09615 -7545 M. LARSON 48485 08714 -7545 M. LARSON 52762 03792 -7545 M. LARSON 57684 08015 -7545 M. LARSON 79015 09625 -7545 M. LARSON 80123 00560 -7545 M. LARSON 82462 02015 -7545 M. LARSON 91520 01815 -7545 M. LARSON 93715 04015 -_ATEOF - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - * ************************************************************* * - * REPORT WRITER EXAMPLE #2. * - * ************************************************************* * - - ENVIRONMENT DIVISION. - CONFIGURATION SECTION. - - INPUT-OUTPUT SECTION. - FILE-CONTROL. - - SELECT TRANSACTION-DATA - ASSIGN TO EXTERNAL DATAIN - ORGANIZATION IS LINE SEQUENTIAL. - - SELECT REPORT-FILE - ASSIGN TO EXTERNAL LINE ADVANCING SYSPRINT. - - DATA DIVISION. - FILE SECTION. - - FD TRANSACTION-DATA. - - 01 TRANSACTION-RECORD. - 03 TR-CUSTOMER-NUMBER PIC 9(04). - 03 FILLER PIC X(01). - 03 TR-CUSTOMER-NAME PIC X(16). - 03 FILLER PIC X(01). - 03 TR-ITEM-NUMBER PIC 9(05). - 03 FILLER REDEFINES TR-ITEM-NUMBER. - 05 TR-ITEM-DEPARTMENT PIC 9(01). - 05 FILLER PIC 9(04). - 03 FILLER PIC X(01). - 03 TR-ITEM-COST PIC 9(03)V99. - 03 FILLER PIC X(47). - - FD REPORT-FILE - REPORT IS CUSTOMER-REPORT. - - WORKING-STORAGE SECTION. - 77 END-OF-FILE-SWITCH PIC X(1) VALUE 'N'. - 88 END-OF-FILE VALUE 'Y'. - - 01 DISCOUNT-TABLE. - 02 FILLER PIC 99 VALUE 05. - 02 FILLER PIC 99 VALUE 07. - 02 FILLER PIC 99 VALUE 10. - 02 FILLER PIC 99 VALUE 15. - 02 FILLER PIC 99 VALUE 06. - 02 FILLER PIC 99 VALUE 22. - 02 FILLER PIC 99 VALUE 12. - 02 FILLER PIC 99 VALUE 09. - 02 FILLER PIC 99 VALUE 20. - 01 FILLER REDEFINES DISCOUNT-TABLE. - 02 DISCOUNT OCCURS 9 TIMES - INDEXED BY DISCOUNT-IX - PIC V99. - - 01 CALCULATED-FIELDS. - 03 WS-DISCOUNT-AMT PIC 9(3)V99. - 03 WS-CHARGE-AMT PIC 9(3)V99. - - REPORT SECTION. - RD CUSTOMER-REPORT - CONTROL IS TR-CUSTOMER-NUMBER - PAGE LIMIT IS 66 LINES - HEADING 1 - FIRST DETAIL 5 - LAST DETAIL 58. - - 01 PAGE-HEAD-GROUP TYPE PAGE HEADING. - 02 LINE 1. - 03 COLUMN 27 PIC X(41) VALUE - 'C U S T O M E R C H A R G E R E P O R T'. - 03 COLUMN 90 PIC X(04) VALUE 'PAGE'. - 03 COLUMN 95 PIC ZZZZ9 SOURCE PAGE-COUNTER. - 02 LINE PLUS 2. - 03 COLUMN 01 PIC X(09) VALUE 'CUST. NO.'. - 03 COLUMN 15 PIC X(10) VALUE 'CUST. NAME'. - 03 COLUMN 30 PIC X(05) VALUE 'DEPT.'. - 03 COLUMN 39 PIC X(08) VALUE 'ITEM NO.'. - 03 COLUMN 51 PIC X(09) VALUE 'ITEM COST'. - 03 COLUMN 64 PIC X(08) VALUE 'DISCT. %'. - 03 COLUMN 76 PIC X(11) VALUE 'DISCT. AMT.'. - 03 COLUMN 91 PIC X(06) VALUE 'CHARGE'. - - 01 CHARGE-DETAIL TYPE DETAIL. - 02 LINE PLUS 1. - 03 COLUMN 03 PIC Z(04) SOURCE TR-CUSTOMER-NUMBER. - 03 COLUMN 10 PIC X(16) SOURCE TR-CUSTOMER-NAME. - 03 COLUMN 32 PIC 9(01) SOURCE TR-ITEM-DEPARTMENT. - 03 COLUMN 40 PIC 9(05) SOURCE TR-ITEM-NUMBER. - 03 COLUMN 51 PIC $$$$.99 SOURCE TR-ITEM-COST. - 03 COLUMN 67 PIC V99 SOURCE DISCOUNT (DISCOUNT-IX). - 03 COLUMN 69 PIC X(01) VALUE '%'. - 03 COLUMN 78 PIC $$$$.99 SOURCE WS-DISCOUNT-AMT. - 03 COLUMN 93 PIC $$$$.99 SOURCE WS-CHARGE-AMT. - - 01 CUSTOMER-TOTAL TYPE CONTROL FOOTING TR-CUSTOMER-NUMBER - NEXT GROUP IS PLUS 2. - 02 LINE PLUS 1. - 03 COLUMN 92 PIC $$$$$.99 SUM WS-CHARGE-AMT. - 03 COLUMN 101 PIC X VALUE '*'. - - PROCEDURE DIVISION. - - 000-INITIATE. - - OPEN INPUT TRANSACTION-DATA, - OUTPUT REPORT-FILE. - - INITIATE CUSTOMER-REPORT. - - READ TRANSACTION-DATA - AT END - MOVE 'Y' TO END-OF-FILE-SWITCH - END-READ. - - PERFORM 100-PROCESS-TRANSACTION-DATA THRU 199-EXIT - UNTIL END-OF-FILE. - - 000-TERMINATE. - TERMINATE CUSTOMER-REPORT. - - CLOSE TRANSACTION-DATA, - REPORT-FILE. - - STOP RUN. - - 100-PROCESS-TRANSACTION-DATA. - SET DISCOUNT-IX TO TR-ITEM-DEPARTMENT. - COMPUTE WS-DISCOUNT-AMT ROUNDED = - TR-ITEM-COST * DISCOUNT (DISCOUNT-IX). - COMPUTE WS-CHARGE-AMT = - TR-ITEM-COST - WS-DISCOUNT-AMT. - GENERATE CHARGE-DETAIL. - READ TRANSACTION-DATA - AT END - MOVE 'Y' TO END-OF-FILE-SWITCH - END-READ. - - 199-EXIT. - EXIT. - -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_reportwriter.at:984: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_reportwriter.at:984" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_reportwriter.at:984" -$at_failed && at_fn_log_failure -$at_traceon; } - - -{ set +x -$as_echo "$at_srcdir/run_reportwriter.at:986: DD_DATAIN=\"./inp_data\" DD_SYSPRINT=\"./report.txt\" \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "DD_DATAIN=\"./inp_data\" DD_SYSPRINT=\"./report.txt\" $COBCRUN_DIRECT ./prog" "run_reportwriter.at:986" -( $at_check_trace; DD_DATAIN="./inp_data" DD_SYSPRINT="./report.txt" $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_reportwriter.at:986" -$at_failed && at_fn_log_failure -$at_traceon; } - - - - - -cat >reference <<'_ATEOF' - C U S T O M E R C H A R G E R E P O R T PAGE 1 - -CUST. NO. CUST. NAME DEPT. ITEM NO. ITEM COST DISCT. % DISCT. AMT. CHARGE - - 152 J. LANGDON 8 87653 $24.75 09% $2.23 $22.52 - 152 J. LANGDON 6 64025 $9.45 22% $2.08 $7.37 - 152 J. LANGDON 4 41915 $13.70 15% $2.06 $11.64 - 152 J. LANGDON 1 17410 $2.51 05% $.13 $2.38 - $43.91 * - - - 2468 L. MORRISEY 1 18520 $3.75 05% $.19 $3.56 - 2468 L. MORRISEY 2 20012 $4.20 07% $.29 $3.91 - 2468 L. MORRISEY 3 31572 $10.15 10% $1.02 $9.13 - 2468 L. MORRISEY 4 48792 $37.50 15% $5.63 $31.87 - 2468 L. MORRISEY 5 50407 $15.15 06% $.91 $14.24 - 2468 L. MORRISEY 6 61575 $20.10 22% $4.42 $15.68 - 2468 L. MORRISEY 7 79204 $51.70 12% $6.20 $45.50 - 2468 L. MORRISEY 8 85075 $37.84 09% $3.41 $34.43 - 2468 L. MORRISEY 9 98476 $87.94 20% $17.59 $70.35 - $228.67 * - - - 3451 M. JACKSON 3 37847 $27.90 10% $2.79 $25.11 - 3451 M. JACKSON 5 58492 $68.50 06% $4.11 $64.39 - 3451 M. JACKSON 6 60010 $20.40 22% $4.49 $15.91 - 3451 M. JACKSON 8 85260 $78.52 09% $7.07 $71.45 - 3451 M. JACKSON 9 90520 $27.52 20% $5.50 $22.02 - $198.88 * - - - 4512 S. LEVITT 2 24680 $30.50 07% $2.14 $28.36 - 4512 S. LEVITT 5 56784 $52.53 06% $3.15 $49.38 - 4512 S. LEVITT 6 60410 $12.15 22% $2.67 $9.48 - 4512 S. LEVITT 7 78952 $89.25 12% $10.71 $78.54 - 4512 S. LEVITT 8 85278 $49.75 09% $4.48 $45.27 - 4512 S. LEVITT 8 87492 $64.25 09% $5.78 $58.47 - 4512 S. LEVITT 9 97204 $84.75 20% $16.95 $67.80 - $337.30 * - - - 5417 K. CONKLIN 1 13579 $35.72 05% $1.79 $33.93 - 5417 K. CONKLIN 2 24615 $18.75 07% $1.31 $17.44 - 5417 K. CONKLIN 3 34928 $37.45 10% $3.75 $33.70 - 5417 K. CONKLIN 4 48527 $87.50 15% $13.13 $74.37 - 5417 K. CONKLIN 5 50150 $18.95 06% $1.14 $17.81 - 5417 K. CONKLIN 5 54652 $38.92 06% $2.34 $36.58 - 5417 K. CONKLIN 5 59765 $98.95 06% $5.94 $93.01 - 5417 K. CONKLIN 7 71572 $18.95 12% $2.27 $16.68 - 5417 K. CONKLIN 8 85175 $80.10 09% $7.21 $72.89 - 5417 K. CONKLIN 9 90275 $4.60 20% $.92 $3.68 - 5417 K. CONKLIN 9 91572 $18.57 20% $3.71 $14.86 - 5417 K. CONKLIN 9 97576 $84.95 20% $16.99 $67.96 - $482.91 * - - - 6213 Z. HAMPTON 1 15792 $64.25 05% $3.21 $61.04 - 6213 Z. HAMPTON 1 19975 $98.75 05% $4.94 $93.81 - - - - - - - - C U S T O M E R C H A R G E R E P O R T PAGE 2 - -CUST. NO. CUST. NAME DEPT. ITEM NO. ITEM COST DISCT. % DISCT. AMT. CHARGE - - 6213 Z. HAMPTON 3 34576 $51.15 10% $5.12 $46.03 - 6213 Z. HAMPTON 4 49512 $85.20 15% $12.78 $72.42 - $273.30 * - - - 7545 M. LARSON 1 14676 $38.45 05% $1.92 $36.53 - 7545 M. LARSON 1 18592 $82.51 05% $4.13 $78.38 - 7545 M. LARSON 1 19994 $98.98 05% $4.95 $94.03 - 7545 M. LARSON 2 21214 $15.15 07% $1.06 $14.09 - 7545 M. LARSON 3 37515 $82.12 10% $8.21 $73.91 - 7545 M. LARSON 3 38592 $96.15 10% $9.62 $86.53 - 7545 M. LARSON 4 48485 $87.14 15% $13.07 $74.07 - 7545 M. LARSON 5 52762 $37.92 06% $2.28 $35.64 - 7545 M. LARSON 5 57684 $80.15 06% $4.81 $75.34 - 7545 M. LARSON 7 79015 $96.25 12% $11.55 $84.70 - 7545 M. LARSON 8 80123 $5.60 09% $.50 $5.10 - 7545 M. LARSON 8 82462 $20.15 09% $1.81 $18.34 - 7545 M. LARSON 9 91520 $18.15 20% $3.63 $14.52 - 7545 M. LARSON 9 93715 $40.15 20% $8.03 $32.12 - $723.30 * - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_reportwriter.at:1124: diff reference report.txt" -at_fn_check_prepare_trace "run_reportwriter.at:1124" -( $at_check_trace; diff reference report.txt -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_reportwriter.at:1124" -$at_failed && at_fn_log_failure \ -"./report.txt" -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_802 -#AT_START_803 -at_fn_group_banner 803 'run_reportwriter.at:1129' \ - "Sample Charge Report 2" " " 4 -at_xfail=no -( - $as_echo "803. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >inp_data <<'_ATEOF' -0152 J. LANGDON 87653 02475 -0152 J. LANGDON 64025 00945 -0152 J. LANGDON 41915 01370 -0152 J. LANGDON 17410 00251 -2468 L. MORRISEY 18520 00375 -2468 L. MORRISEY 20012 00420 -2468 L. MORRISEY 31572 01015 -2468 L. MORRISEY 48792 03750 -2468 L. MORRISEY 50407 01515 -2468 L. MORRISEY 61575 02010 -2468 L. MORRISEY 79204 05170 -2468 L. MORRISEY 85075 03784 -2468 L. MORRISEY 98476 08794 -3451 M. JACKSON 37847 02790 -3451 M. JACKSON 58492 06850 -3451 M. JACKSON 60010 02040 -3451 M. JACKSON 85260 07852 -3451 M. JACKSON 90520 02752 -4512 S. LEVITT 24680 03050 -4512 S. LEVITT 56784 05253 -4512 S. LEVITT 60410 01215 -4512 S. LEVITT 78952 08925 -4512 S. LEVITT 85278 04975 -4512 S. LEVITT 87492 06425 -4512 S. LEVITT 97204 08475 -5417 K. CONKLIN 13579 03572 -5417 K. CONKLIN 24615 01875 -5417 K. CONKLIN 34928 03745 -5417 K. CONKLIN 48527 08750 -5417 K. CONKLIN 50150 01895 -5417 K. CONKLIN 54652 03892 -5417 K. CONKLIN 59765 09895 -5417 K. CONKLIN 71572 01895 -5417 K. CONKLIN 85175 08010 -5417 K. CONKLIN 90275 00460 -5417 K. CONKLIN 91572 01857 -5417 K. CONKLIN 97576 08495 -6213 Z. HAMPTON 15792 06425 -6213 Z. HAMPTON 19975 09875 -6213 Z. HAMPTON 34576 05115 -6213 Z. HAMPTON 49512 08520 -7545 M. LARSON 14676 03845 -7545 M. LARSON 18592 08251 -7545 M. LARSON 19994 09898 -7545 M. LARSON 21214 01515 -7545 M. LARSON 37515 08212 -7545 M. LARSON 38592 09615 -7545 M. LARSON 48485 08714 -7545 M. LARSON 52762 03792 -7545 M. LARSON 57684 08015 -7545 M. LARSON 79015 09625 -7545 M. LARSON 80123 00560 -7545 M. LARSON 82462 02015 -7545 M. LARSON 91520 01815 -7545 M. LARSON 93715 04015 -_ATEOF - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - * ************************************************************* * - * REPORT WRITER EXAMPLE #3. * - * ************************************************************* * - - ENVIRONMENT DIVISION. - CONFIGURATION SECTION. - - INPUT-OUTPUT SECTION. - FILE-CONTROL. - - SELECT TRANSACTION-DATA - ASSIGN TO EXTERNAL DATAIN - ORGANIZATION IS LINE SEQUENTIAL. - - SELECT REPORT-FILE - ASSIGN TO EXTERNAL LINE ADVANCING SYSPRINT. - - DATA DIVISION. - FILE SECTION. - - FD TRANSACTION-DATA. - - 01 TRANSACTION-RECORD. - 03 TR-CUSTOMER-NUMBER PIC 9(04). - 03 FILLER PIC X(01). - 03 TR-CUSTOMER-NAME PIC X(16). - 03 FILLER PIC X(01). - 03 TR-ITEM-NUMBER PIC 9(05). - 03 FILLER REDEFINES TR-ITEM-NUMBER. - 05 TR-ITEM-DEPARTMENT PIC 9(01). - 05 FILLER PIC 9(04). - 03 FILLER PIC X(01). - 03 TR-ITEM-COST PIC 9(03)V99. - 03 FILLER PIC X(47). - - FD REPORT-FILE - REPORT IS CUSTOMER-REPORT. - - WORKING-STORAGE SECTION. - 77 END-OF-FILE-SWITCH PIC X(1) VALUE 'N'. - 88 END-OF-FILE VALUE 'Y'. - - 01 DISCOUNT-TABLE. - 02 FILLER PIC 99 VALUE 05. - 02 FILLER PIC 99 VALUE 07. - 02 FILLER PIC 99 VALUE 10. - 02 FILLER PIC 99 VALUE 15. - 02 FILLER PIC 99 VALUE 06. - 02 FILLER PIC 99 VALUE 22. - 02 FILLER PIC 99 VALUE 12. - 02 FILLER PIC 99 VALUE 09. - 02 FILLER PIC 99 VALUE 20. - 01 FILLER REDEFINES DISCOUNT-TABLE. - 02 DISCOUNT OCCURS 9 TIMES - INDEXED BY DISCOUNT-IX - PIC V99. - - 01 CALCULATED-FIELDS. - 03 WS-DISCOUNT-AMT PIC 9(3)V99. - 03 WS-CHARGE-AMT PIC 9(3)V99. - - REPORT SECTION. - RD CUSTOMER-REPORT - CONTROLS ARE FINAL, TR-CUSTOMER-NUMBER - PAGE LIMIT IS 66 LINES - HEADING 1 - FIRST DETAIL 5 - LAST DETAIL 58. - - 01 PAGE-HEAD-GROUP TYPE PAGE HEADING. - 02 LINE 1. - 03 COLUMN 27 PIC X(41) VALUE - 'C U S T O M E R C H A R G E R E P O R T'. - 03 COLUMN 90 PIC X(04) VALUE 'PAGE'. - 03 COLUMN 95 PIC ZZZZ9 SOURCE PAGE-COUNTER. - 02 LINE PLUS 2. - 03 COLUMN 01 PIC X(09) VALUE 'CUST. NO.'. - 03 COLUMN 15 PIC X(10) VALUE 'CUST. NAME'. - 03 COLUMN 30 PIC X(05) VALUE 'DEPT.'. - 03 COLUMN 39 PIC X(08) VALUE 'ITEM NO.'. - 03 COLUMN 51 PIC X(09) VALUE 'ITEM COST'. - 03 COLUMN 64 PIC X(08) VALUE 'DISCT. %'. - 03 COLUMN 76 PIC X(11) VALUE 'DISCT. AMT.'. - 03 COLUMN 91 PIC X(06) VALUE 'CHARGE'. - - 01 CHARGE-DETAIL TYPE DETAIL. - 02 LINE PLUS 1. - 03 COLUMN 03 PIC Z(04) SOURCE TR-CUSTOMER-NUMBER - GROUP INDICATE. - 03 COLUMN 10 PIC X(16) SOURCE TR-CUSTOMER-NAME - GROUP INDICATE. - 03 COLUMN 32 PIC 9(01) SOURCE TR-ITEM-DEPARTMENT. - 03 COLUMN 40 PIC 9(05) SOURCE TR-ITEM-NUMBER. - 03 COLUMN 51 PIC $$$$.99 SOURCE TR-ITEM-COST. - 03 COLUMN 67 PIC V99 SOURCE DISCOUNT (DISCOUNT-IX). - 03 COLUMN 69 PIC X(01) VALUE '%'. - 03 COLUMN 78 PIC $$$$.99 SOURCE WS-DISCOUNT-AMT. - 03 COLUMN 93 PIC $$$$.99 SOURCE WS-CHARGE-AMT. - - 01 CUSTOMER-TOTAL TYPE CONTROL FOOTING TR-CUSTOMER-NUMBER - NEXT GROUP IS PLUS 2. - 02 LINE PLUS 1. - 03 COLUMN 50 PIC $$$$$.99 SUM TR-ITEM-COST. - 03 COLUMN 59 PIC X VALUE '*'. - 03 COLUMN 77 PIC $$$$$.99 SUM WS-DISCOUNT-AMT. - 03 COLUMN 86 PIC X VALUE '*'. - 03 COLUMN 92 PIC $$$$$.99 SUM WS-CHARGE-AMT. - 03 COLUMN 101 PIC X VALUE '*'. - - 01 FINAL-TOTAL TYPE CONTROL FOOTING FINAL. - 02 LINE PLUS 1. - 03 COLUMN 10 PIC X(12) VALUE 'GRAND TOTALS'. - 03 COLUMN 48 PIC $$$,$$$.99 SUM TR-ITEM-COST. - 03 COLUMN 59 PIC XX VALUE '**'. - 03 COLUMN 75 PIC $$$,$$$.99 SUM WS-DISCOUNT-AMT. - 03 COLUMN 86 PIC XX VALUE '**'. - 03 COLUMN 90 PIC $$$,$$$.99 SUM WS-CHARGE-AMT. - 03 COLUMN 101 PIC XX VALUE '**'. - - PROCEDURE DIVISION. - - 000-INITIATE. - - OPEN INPUT TRANSACTION-DATA, - OUTPUT REPORT-FILE. - - INITIATE CUSTOMER-REPORT. - - READ TRANSACTION-DATA - AT END - MOVE 'Y' TO END-OF-FILE-SWITCH. - * END-READ. - - PERFORM 100-PROCESS-TRANSACTION-DATA THRU 199-EXIT - UNTIL END-OF-FILE. - - 000-TERMINATE. - TERMINATE CUSTOMER-REPORT. - - CLOSE TRANSACTION-DATA, - REPORT-FILE. - - STOP RUN. - - 100-PROCESS-TRANSACTION-DATA. - SET DISCOUNT-IX TO TR-ITEM-DEPARTMENT. - COMPUTE WS-DISCOUNT-AMT ROUNDED = - TR-ITEM-COST * DISCOUNT (DISCOUNT-IX). - COMPUTE WS-CHARGE-AMT = - TR-ITEM-COST - WS-DISCOUNT-AMT. - GENERATE CHARGE-DETAIL. - READ TRANSACTION-DATA - AT END - MOVE 'Y' TO END-OF-FILE-SWITCH. - * END-READ. - - 199-EXIT. - EXIT. - - -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_reportwriter.at:1354: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_reportwriter.at:1354" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_reportwriter.at:1354" -$at_failed && at_fn_log_failure -$at_traceon; } - - -{ set +x -$as_echo "$at_srcdir/run_reportwriter.at:1356: DD_DATAIN=\"./inp_data\" DD_SYSPRINT=\"./report.txt\" \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "DD_DATAIN=\"./inp_data\" DD_SYSPRINT=\"./report.txt\" $COBCRUN_DIRECT ./prog" "run_reportwriter.at:1356" -( $at_check_trace; DD_DATAIN="./inp_data" DD_SYSPRINT="./report.txt" $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_reportwriter.at:1356" -$at_failed && at_fn_log_failure -$at_traceon; } - - - - - -cat >reference <<'_ATEOF' - C U S T O M E R C H A R G E R E P O R T PAGE 1 - -CUST. NO. CUST. NAME DEPT. ITEM NO. ITEM COST DISCT. % DISCT. AMT. CHARGE - - 152 J. LANGDON 8 87653 $24.75 09% $2.23 $22.52 - 6 64025 $9.45 22% $2.08 $7.37 - 4 41915 $13.70 15% $2.06 $11.64 - 1 17410 $2.51 05% $.13 $2.38 - $50.41 * $6.50 * $43.91 * - - - 2468 L. MORRISEY 1 18520 $3.75 05% $.19 $3.56 - 2 20012 $4.20 07% $.29 $3.91 - 3 31572 $10.15 10% $1.02 $9.13 - 4 48792 $37.50 15% $5.63 $31.87 - 5 50407 $15.15 06% $.91 $14.24 - 6 61575 $20.10 22% $4.42 $15.68 - 7 79204 $51.70 12% $6.20 $45.50 - 8 85075 $37.84 09% $3.41 $34.43 - 9 98476 $87.94 20% $17.59 $70.35 - $268.33 * $39.66 * $228.67 * - - - 3451 M. JACKSON 3 37847 $27.90 10% $2.79 $25.11 - 5 58492 $68.50 06% $4.11 $64.39 - 6 60010 $20.40 22% $4.49 $15.91 - 8 85260 $78.52 09% $7.07 $71.45 - 9 90520 $27.52 20% $5.50 $22.02 - $222.84 * $23.96 * $198.88 * - - - 4512 S. LEVITT 2 24680 $30.50 07% $2.14 $28.36 - 5 56784 $52.53 06% $3.15 $49.38 - 6 60410 $12.15 22% $2.67 $9.48 - 7 78952 $89.25 12% $10.71 $78.54 - 8 85278 $49.75 09% $4.48 $45.27 - 8 87492 $64.25 09% $5.78 $58.47 - 9 97204 $84.75 20% $16.95 $67.80 - $383.18 * $45.88 * $337.30 * - - - 5417 K. CONKLIN 1 13579 $35.72 05% $1.79 $33.93 - 2 24615 $18.75 07% $1.31 $17.44 - 3 34928 $37.45 10% $3.75 $33.70 - 4 48527 $87.50 15% $13.13 $74.37 - 5 50150 $18.95 06% $1.14 $17.81 - 5 54652 $38.92 06% $2.34 $36.58 - 5 59765 $98.95 06% $5.94 $93.01 - 7 71572 $18.95 12% $2.27 $16.68 - 8 85175 $80.10 09% $7.21 $72.89 - 9 90275 $4.60 20% $.92 $3.68 - 9 91572 $18.57 20% $3.71 $14.86 - 9 97576 $84.95 20% $16.99 $67.96 - $543.41 * $60.50 * $482.91 * - - - 6213 Z. HAMPTON 1 15792 $64.25 05% $3.21 $61.04 - 1 19975 $98.75 05% $4.94 $93.81 - - - - - - - - C U S T O M E R C H A R G E R E P O R T PAGE 2 - -CUST. NO. CUST. NAME DEPT. ITEM NO. ITEM COST DISCT. % DISCT. AMT. CHARGE - - 6213 Z. HAMPTON 3 34576 $51.15 10% $5.12 $46.03 - 4 49512 $85.20 15% $12.78 $72.42 - $299.35 * $26.05 * $273.30 * - - - 7545 M. LARSON 1 14676 $38.45 05% $1.92 $36.53 - 1 18592 $82.51 05% $4.13 $78.38 - 1 19994 $98.98 05% $4.95 $94.03 - 2 21214 $15.15 07% $1.06 $14.09 - 3 37515 $82.12 10% $8.21 $73.91 - 3 38592 $96.15 10% $9.62 $86.53 - 4 48485 $87.14 15% $13.07 $74.07 - 5 52762 $37.92 06% $2.28 $35.64 - 5 57684 $80.15 06% $4.81 $75.34 - 7 79015 $96.25 12% $11.55 $84.70 - 8 80123 $5.60 09% $.50 $5.10 - 8 82462 $20.15 09% $1.81 $18.34 - 9 91520 $18.15 20% $3.63 $14.52 - 9 93715 $40.15 20% $8.03 $32.12 - $798.87 * $75.57 * $723.30 * - GRAND TOTALS $2,566.39 ** $278.12 ** $2,288.27 ** - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_reportwriter.at:1494: diff reference report.txt" -at_fn_check_prepare_trace "run_reportwriter.at:1494" -( $at_check_trace; diff reference report.txt -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_reportwriter.at:1494" -$at_failed && at_fn_log_failure \ -"./report.txt" -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_803 -#AT_START_804 -at_fn_group_banner 804 'run_reportwriter.at:1499' \ - "Sample Charge Report 3" " " 4 -at_xfail=no -( - $as_echo "804. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >inp_data <<'_ATEOF' -0152 J. LANGDON 87653 02475 -0152 J. LANGDON 64025 00945 -0152 J. LANGDON 41915 01370 -0152 J. LANGDON 17410 00251 -2468 L. MORRISEY 18520 00375 -2468 L. MORRISEY 20012 00420 -2468 L. MORRISEY 31572 01015 -2468 L. MORRISEY 48792 03750 -2468 L. MORRISEY 50407 01515 -2468 L. MORRISEY 61575 02010 -2468 L. MORRISEY 79204 05170 -2468 L. MORRISEY 85075 03784 -2468 L. MORRISEY 98476 08794 -3451 M. JACKSON 37847 02790 -3451 M. JACKSON 58492 06850 -3451 M. JACKSON 60010 02040 -3451 M. JACKSON 85260 07852 -3451 M. JACKSON 90520 02752 -4512 S. LEVITT 24680 03050 -4512 S. LEVITT 56784 05253 -4512 S. LEVITT 60410 01215 -4512 S. LEVITT 78952 08925 -4512 S. LEVITT 85278 04975 -4512 S. LEVITT 87492 06425 -4512 S. LEVITT 97204 08475 -5417 K. CONKLIN 13579 03572 -5417 K. CONKLIN 24615 01875 -5417 K. CONKLIN 34928 03745 -5417 K. CONKLIN 48527 08750 -5417 K. CONKLIN 50150 01895 -5417 K. CONKLIN 54652 03892 -5417 K. CONKLIN 59765 09895 -5417 K. CONKLIN 71572 01895 -5417 K. CONKLIN 85175 08010 -5417 K. CONKLIN 90275 00460 -5417 K. CONKLIN 91572 01857 -5417 K. CONKLIN 97576 08495 -6213 Z. HAMPTON 15792 06425 -6213 Z. HAMPTON 19975 09875 -6213 Z. HAMPTON 34576 05115 -6213 Z. HAMPTON 49512 08520 -7545 M. LARSON 14676 03845 -7545 M. LARSON 18592 08251 -7545 M. LARSON 19994 09898 -7545 M. LARSON 21214 01515 -7545 M. LARSON 37515 08212 -7545 M. LARSON 38592 09615 -7545 M. LARSON 48485 08714 -7545 M. LARSON 52762 03792 -7545 M. LARSON 57684 08015 -7545 M. LARSON 79015 09625 -7545 M. LARSON 80123 00560 -7545 M. LARSON 82462 02015 -7545 M. LARSON 91520 01815 -7545 M. LARSON 93715 04015 -_ATEOF - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - * ************************************************************* * - * * MODIFICATIONS: * - * * ADDED GROUP ITEM TO INPUT RECORD DEFINITION AND CHANGED * 20110227 - * * REPORT SECTION REFERENCES TO ELEMENTS UNDER GROUP TO FIX * 20110227 - * * MISMATCHED CUSTOMER NAME/NUMBER ON REPORT. * 20110227 - * ************************************************************* * - - * ************************************************************* * - * REPORT WRITER EXAMPLE #4. * - * ************************************************************* * - - ENVIRONMENT DIVISION. - CONFIGURATION SECTION. - - INPUT-OUTPUT SECTION. - FILE-CONTROL. - - SELECT TRANSACTION-DATA - ASSIGN TO EXTERNAL DATAIN - ORGANIZATION IS LINE SEQUENTIAL. - - SELECT REPORT-FILE - ASSIGN TO EXTERNAL LINE ADVANCING SYSPRINT. - - DATA DIVISION. - FILE SECTION. - - FD TRANSACTION-DATA. - - 01 TRANSACTION-RECORD. - 03 TR-CUSTOMER. 20110227 - 05 TR-CUSTOMER-NUMBER PIC 9(04). 20110227 - 05 FILLER PIC X(01). 20110227 - 05 TR-CUSTOMER-NAME PIC X(16). 20110227 - 03 FILLER PIC X(01). - 03 TR-ITEM-NUMBER PIC 9(05). - 03 FILLER REDEFINES TR-ITEM-NUMBER. - 05 TR-ITEM-DEPARTMENT PIC 9(01). - 05 FILLER PIC 9(04). - 03 FILLER PIC X(01). - 03 TR-ITEM-COST PIC 9(03)V99. - 03 FILLER PIC X(47). - - FD REPORT-FILE - REPORT IS CUSTOMER-REPORT. - - WORKING-STORAGE SECTION. - 77 END-OF-FILE-SWITCH PIC X(1) VALUE 'N'. - 88 END-OF-FILE VALUE 'Y'. - - 01 DISCOUNT-TABLE. - 02 FILLER PIC 99 VALUE 05. - 02 FILLER PIC 99 VALUE 07. - 02 FILLER PIC 99 VALUE 10. - 02 FILLER PIC 99 VALUE 15. - 02 FILLER PIC 99 VALUE 06. - 02 FILLER PIC 99 VALUE 22. - 02 FILLER PIC 99 VALUE 12. - 02 FILLER PIC 99 VALUE 09. - 02 FILLER PIC 99 VALUE 20. - 01 FILLER REDEFINES DISCOUNT-TABLE. - 02 DISCOUNT OCCURS 9 TIMES - INDEXED BY DISCOUNT-IX - PIC V99. - - 01 CALCULATED-FIELDS. - 03 WS-DISCOUNT-AMT PIC 9(3)V99. - 03 WS-CHARGE-AMT PIC 9(3)V99. - - REPORT SECTION. - RD CUSTOMER-REPORT - CONTROLS ARE FINAL, TR-CUSTOMER - PAGE LIMIT IS 66 LINES - HEADING 1 - FIRST DETAIL 5 - LAST DETAIL 58. - - 01 PAGE-HEAD-GROUP TYPE PAGE HEADING. - 02 LINE 1. - 03 COLUMN 27 PIC X(41) VALUE - 'C U S T O M E R C H A R G E R E P O R T'. - 03 COLUMN 90 PIC X(04) VALUE 'PAGE'. - 03 COLUMN +2 PIC ZZZZ9 SOURCE PAGE-COUNTER. - 02 LINE +2. - 03 COLUMN 01 PIC X(09) VALUE 'CUST. NO.'. - 03 COLUMN 15 PIC X(10) VALUE 'CUST. NAME'. - 03 COLUMN 51 PIC X(09) VALUE 'ITEM COST'. - 03 COLUMN 76 PIC X(11) VALUE 'DISCT. AMT.'. - 03 COLUMN 91 PIC X(06) VALUE 'CHARGE'. - - 01 CHARGE-DETAIL TYPE DETAIL. - 02 LINE PLUS 1. - 03 COLUMN 51 PIC $$$$.99 SOURCE TR-ITEM-COST. - 03 COLUMN 78 PIC $$$$.99 SOURCE WS-DISCOUNT-AMT. - 03 COLUMN 93 PIC $$$$.99 SOURCE WS-CHARGE-AMT. - - 01 CUSTOMER-TOTAL TYPE CONTROL FOOTING TR-CUSTOMER 20110227 - NEXT GROUP IS PLUS 2. - 02 LINE PLUS 1. - 03 COLUMN 03 PIC Z(04) SOURCE TR-CUSTOMER-NUMBER. - 03 COLUMN 10 PIC X(16) SOURCE TR-CUSTOMER-NAME. - 03 COLUMN 50 PIC $$$$$.99 SUM TR-ITEM-COST. - 03 COLUMN 77 PIC $$$$$.99 SUM WS-DISCOUNT-AMT. - 03 COLUMN 92 PIC $$$$$.99 SUM WS-CHARGE-AMT. - - 01 FINAL-TOTAL TYPE CONTROL FOOTING FINAL. - 02 LINE PLUS 1. - 03 COLUMN 10 PIC X(12) VALUE 'GRAND TOTALS'. - 03 COLUMN 48 PIC $$$,$$$.99 SUM TR-ITEM-COST. - 03 COLUMN 59 PIC X VALUE '*'. - 03 COLUMN 75 PIC $$$,$$$.99 SUM WS-DISCOUNT-AMT. - 03 COLUMN 86 PIC X VALUE '*'. - 03 COLUMN 90 PIC $$$,$$$.99 SUM WS-CHARGE-AMT. - 03 COLUMN 101 PIC X VALUE '*'. - - PROCEDURE DIVISION. - - 000-INITIATE. - - OPEN INPUT TRANSACTION-DATA, - OUTPUT REPORT-FILE. - - INITIATE CUSTOMER-REPORT. - - READ TRANSACTION-DATA - AT END - MOVE 'Y' TO END-OF-FILE-SWITCH - END-READ. - - PERFORM 100-PROCESS-TRANSACTION-DATA THRU 199-EXIT - UNTIL END-OF-FILE. - - 000-TERMINATE. - TERMINATE CUSTOMER-REPORT. - - CLOSE TRANSACTION-DATA, - REPORT-FILE. - - STOP RUN. - - 100-PROCESS-TRANSACTION-DATA. - SET DISCOUNT-IX TO TR-ITEM-DEPARTMENT. - COMPUTE WS-DISCOUNT-AMT ROUNDED = - TR-ITEM-COST * DISCOUNT (DISCOUNT-IX). - COMPUTE WS-CHARGE-AMT = - TR-ITEM-COST - WS-DISCOUNT-AMT. - GENERATE CUSTOMER-REPORT. - READ TRANSACTION-DATA - AT END - MOVE 'Y' TO END-OF-FILE-SWITCH. - * END-READ. - - 199-EXIT. - EXIT. - -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_reportwriter.at:1719: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_reportwriter.at:1719" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_reportwriter.at:1719" -$at_failed && at_fn_log_failure -$at_traceon; } - - -{ set +x -$as_echo "$at_srcdir/run_reportwriter.at:1721: DD_DATAIN=\"./inp_data\" DD_SYSPRINT=\"./report.txt\" \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "DD_DATAIN=\"./inp_data\" DD_SYSPRINT=\"./report.txt\" $COBCRUN_DIRECT ./prog" "run_reportwriter.at:1721" -( $at_check_trace; DD_DATAIN="./inp_data" DD_SYSPRINT="./report.txt" $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_reportwriter.at:1721" -$at_failed && at_fn_log_failure -$at_traceon; } - - - - - -cat >reference <<'_ATEOF' - C U S T O M E R C H A R G E R E P O R T PAGE 1 - -CUST. NO. CUST. NAME ITEM COST DISCT. AMT. CHARGE - - 152 J. LANGDON $50.41 $6.50 $43.91 - - - 2468 L. MORRISEY $268.33 $39.66 $228.67 - - - 3451 M. JACKSON $222.84 $23.96 $198.88 - - - 4512 S. LEVITT $383.18 $45.88 $337.30 - - - 5417 K. CONKLIN $543.41 $60.50 $482.91 - - - 6213 Z. HAMPTON $299.35 $26.05 $273.30 - - - 7545 M. LARSON $798.87 $75.57 $723.30 - GRAND TOTALS $2,566.39 * $278.12 * $2,288.27 * - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_reportwriter.at:1794: diff reference report.txt" -at_fn_check_prepare_trace "run_reportwriter.at:1794" -( $at_check_trace; diff reference report.txt -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_reportwriter.at:1794" -$at_failed && at_fn_log_failure \ -"./report.txt" -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_804 -#AT_START_805 -at_fn_group_banner 805 'run_reportwriter.at:1799' \ - "Sample Charge Report 4" " " 4 -at_xfail=no -( - $as_echo "805. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >inp_data <<'_ATEOF' -05 A 007328 -05 A 090620 -05 A 034602 -05 A 017837 -13 A 005035 -13 A 049851 -13 A 012139 -22 A 077572 -29 A 013491 -33 A 050628 -33 A 044987 -33 A 050162 -39 A 068745 -39 A 058384 -39 A 053005 -44 A 085669 -44 A 057891 -49 A 065134 -03 B 032035 -03 B 054694 -03 B 069591 -03 B 046023 -03 B 025725 -19 B 045550 -19 B 099371 -19 B 049703 -25 B 047000 -25 B 087106 -31 B 049157 -34 B 005994 -09 C 007980 -14 C 092224 -14 C 062942 -23 C 002974 -28 C 042394 -28 C 014745 -34 C 053467 -34 C 054332 -42 C 089295 -42 C 073826 -04 D 029685 -04 D 060676 -06 D 013230 -06 D 042290 -15 D 013076 -15 D 024104 -15 D 013078 -38 D 078771 -38 D 085871 -11 E 099350 -17 E 066301 -27 E 038144 -27 E 097807 -27 E 008055 -08 F 073201 -09 F 008278 -09 F 040898 -09 F 039688 -16 F 019308 -16 F 015173 -16 F 022865 -16 F 003568 -36 F 029276 -40 F 078631 -40 F 010249 -40 F 059583 -48 F 043877 -48 F 006755 -01 G 018347 -20 G 098123 -21 G 077346 -22 G 025953 -26 G 009587 -41 G 083126 -41 G 073046 -32 H 038823 -32 H 009989 -32 H 065838 -32 H 024994 -32 H 016065 -32 H 097042 -43 H 077895 -45 H 038692 -46 H 088151 -46 H 069538 -09 J 039764 -18 J 088890 -18 J 039421 -37 J 044560 -45 J 018770 -45 J 032993 -45 J 089631 -45 J 072659 -02 K 075925 -02 K 072909 -02 K 040544 -12 K 002138 -12 K 029239 -35 K 065936 -35 K 093046 -_ATEOF - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - - * ************************************************************* * - * REPORT WRITER EXAMPLE #5. * - * ************************************************************* * - - ENVIRONMENT DIVISION. - CONFIGURATION SECTION. - - INPUT-OUTPUT SECTION. - FILE-CONTROL. - - SELECT SALES-DATA - ASSIGN TO EXTERNAL DATAIN - ORGANIZATION IS LINE SEQUENTIAL. - - SELECT REPORT-FILE - ASSIGN TO EXTERNAL LINE ADVANCING SYSPRINT. - - DATA DIVISION. - FILE SECTION. - - FD SALES-DATA. - - 01 SALES-RECORD. - 03 SR-SALESMAN-NUMBER PIC 9(02). - 03 FILLER PIC X(01). - 03 SR-DISTRICT-CODE PIC X(01). - 03 FILLER PIC X(01). - 03 SR-SALE-AMOUNT PIC 9(04)V99. - 03 FILLER PIC X(69). - - FD REPORT-FILE - REPORT IS DISTRICT-SALES-REPORT. - - WORKING-STORAGE SECTION. - 77 END-OF-FILE-SWITCH PIC X(1) VALUE 'N'. - 88 END-OF-FILE VALUE 'Y'. - - 01 COMMISSION-TABLE. - 02 FILLER PIC X(03) VALUE 'A20'. - 02 FILLER PIC X(03) VALUE 'B18'. - 02 FILLER PIC X(03) VALUE 'C15'. - 02 FILLER PIC X(03) VALUE 'D12'. - 02 FILLER PIC X(03) VALUE 'E10'. - 02 FILLER PIC X(03) VALUE 'F12'. - 02 FILLER PIC X(03) VALUE 'G10'. - 02 FILLER PIC X(03) VALUE 'H08'. - 02 FILLER PIC X(03) VALUE 'J05'. - 02 FILLER PIC X(03) VALUE 'K07'. - 01 FILLER REDEFINES COMMISSION-TABLE. - 02 COMMISSION-ENTRY OCCURS 10 TIMES - INDEXED BY COMMISSION-IX. - 03 CE-DISTRICT PIC X(01). - 03 CE-RATE PIC V99. - - 01 CALCULATED-FIELDS. - 03 WS-COMMISSION PIC 9(5)V99. - - REPORT SECTION. - RD DISTRICT-SALES-REPORT - CONTROLS ARE FINAL, SR-DISTRICT-CODE, SR-SALESMAN-NUMBER - PAGE LIMIT IS 66 LINES - HEADING 1 - FIRST DETAIL 5 - LAST DETAIL 58. - - 01 PAGE-HEAD-GROUP TYPE PAGE HEADING. - 02 LINE 1. - 03 COLUMN 27 PIC X(41) VALUE - 'D I S T R I C T S A L E S R E P O R T'. - 03 COLUMN 90 PIC X(04) VALUE 'PAGE'. - 03 COLUMN 95 PIC ZZZZ9 SOURCE PAGE-COUNTER. - 02 LINE 3. - 03 COLUMN 20 PIC X(26) VALUE - '-------- SALESMAN --------'. - 03 COLUMN 54 PIC X(15) VALUE - '-- DISTRICT --'. - 02 LINE 4. - 03 COLUMN 20 PIC X(03) VALUE 'NO.'. - 03 COLUMN 28 PIC X(05) VALUE 'SALES'. - 03 COLUMN 37 PIC X(10) VALUE 'COMMISSION'. - 03 COLUMN 54 PIC X(03) VALUE 'NO.'. - 03 COLUMN 61 PIC X(05) VALUE 'SALES'. - - 01 SALE-DETAIL TYPE DETAIL. - 02 LINE PLUS 1. - 03 COLUMN 01 PIC 99 SOURCE SR-SALESMAN-NUMBER. - 03 COLUMN 04 PIC X SOURCE SR-DISTRICT-CODE. - 03 COLUMN 06 PIC 9999.99 SOURCE SR-SALE-AMOUNT. - - 01 SALESMAN-TOTAL TYPE CONTROL FOOTING SR-SALESMAN-NUMBER. - 02 LINE PLUS 1. - 03 COLUMN 20 PIC 99 SOURCE SR-SALESMAN-NUMBER. - 03 ST-SALES-AMT COLUMN 24 PIC $$$,$$9.99 SUM - SR-SALE-AMOUNT. - 03 COLUMN 37 PIC $$$,$$9.99 SOURCE WS-COMMISSION. - - 01 DISTRICT-TOTAL TYPE CONTROL FOOTING SR-DISTRICT-CODE - NEXT GROUP PLUS 2. - 02 LINE PLUS 1. - 03 COLUMN 54 PIC X SOURCE SR-DISTRICT-CODE. - 03 COLUMN 58 PIC $$$,$$9.99 SUM ST-SALES-AMT. - - 01 FINAL-TOTAL TYPE CONTROL FOOTING FINAL. - 02 LINE PLUS 2. - 03 COLUMN 15 PIC X(19) VALUE - 'MONTHLY TOTAL SALES'. - 03 COLUMN 57 PIC $$$$,$$9.99 SUM ST-SALES-AMT. - 03 COLUMN 69 PIC XX VALUE '**'. - - PROCEDURE DIVISION. - - DECLARATIVES. - USE-SALESMAN-TOTAL SECTION. USE BEFORE REPORTING SALESMAN-TOTAL. - USE-SALESMAN-TOTAL-PROC. - SET COMMISSION-IX TO 1. - SEARCH COMMISSION-ENTRY - AT END - MOVE 0.00 TO WS-COMMISSION - WHEN CE-DISTRICT (COMMISSION-IX) = SR-DISTRICT-CODE - COMPUTE WS-COMMISSION ROUNDED = - CE-RATE (COMMISSION-IX) * ST-SALES-AMT. - - USE-SALESMAN-TOTAL-EXIT. - EXIT. - - END DECLARATIVES. - - 000-INITIATE. - - OPEN INPUT SALES-DATA, - OUTPUT REPORT-FILE. - - INITIATE DISTRICT-SALES-REPORT. - - READ SALES-DATA - AT END - MOVE 'Y' TO END-OF-FILE-SWITCH - END-READ. - - PERFORM 100-PROCESS-SALES-DATA THRU 199-EXIT - UNTIL END-OF-FILE. - - 000-TERMINATE. - TERMINATE DISTRICT-SALES-REPORT. - - CLOSE SALES-DATA, - REPORT-FILE. - - STOP RUN. - - 100-PROCESS-SALES-DATA. - GENERATE DISTRICT-SALES-REPORT. - READ SALES-DATA - AT END - MOVE 'Y' TO END-OF-FILE-SWITCH - END-READ. - - 199-EXIT. - EXIT. - -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_reportwriter.at:2070: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_reportwriter.at:2070" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_reportwriter.at:2070" -$at_failed && at_fn_log_failure -$at_traceon; } - - -{ set +x -$as_echo "$at_srcdir/run_reportwriter.at:2072: DD_DATAIN=\"./inp_data\" DD_SYSPRINT=\"./report.txt\" \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "DD_DATAIN=\"./inp_data\" DD_SYSPRINT=\"./report.txt\" $COBCRUN_DIRECT ./prog" "run_reportwriter.at:2072" -( $at_check_trace; DD_DATAIN="./inp_data" DD_SYSPRINT="./report.txt" $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_reportwriter.at:2072" -$at_failed && at_fn_log_failure -$at_traceon; } - - - - - -cat >reference <<'_ATEOF' - D I S T R I C T S A L E S R E P O R T PAGE 1 - - -------- SALESMAN -------- -- DISTRICT -- - NO. SALES COMMISSION NO. SALES - 05 $1,503.87 $300.77 - 13 $670.25 $134.05 - 22 $775.72 $155.14 - 29 $134.91 $26.98 - 33 $1,457.77 $291.55 - 39 $1,801.34 $360.27 - 44 $1,435.60 $287.12 - 49 $651.34 $130.27 - A $8,430.80 - - - 03 $2,280.68 $410.52 - 19 $1,946.24 $350.32 - 25 $1,341.06 $241.39 - 31 $491.57 $88.48 - 34 $59.94 $10.79 - B $6,119.49 - - - 09 $79.80 $11.97 - 14 $1,551.66 $232.75 - 23 $29.74 $4.46 - 28 $571.39 $85.71 - 34 $1,077.99 $161.70 - 42 $1,631.21 $244.68 - C $4,941.79 - - - 04 $903.61 $108.43 - 06 $555.20 $66.62 - 15 $502.58 $60.31 - 38 $1,646.42 $197.57 - D $3,607.81 - - - 11 $993.50 $99.35 - 17 $663.01 $66.30 - 27 $1,440.06 $144.01 - E $3,096.57 - - - 08 $732.01 $87.84 - 09 $888.64 $106.64 - 16 $609.14 $73.10 - 36 $292.76 $35.13 - 40 $1,484.63 $178.16 - 48 $506.32 $60.76 - F $4,513.50 - - - 01 $183.47 $18.35 - 20 $981.23 $98.12 - 21 $773.46 $77.35 - 22 $259.53 $25.95 - - - - - - - - D I S T R I C T S A L E S R E P O R T PAGE 2 - - -------- SALESMAN -------- -- DISTRICT -- - NO. SALES COMMISSION NO. SALES - 26 $95.87 $9.59 - 41 $1,561.72 $156.17 - G $3,855.28 - - - 32 $2,527.51 $202.20 - 43 $778.95 $62.32 - 45 $386.92 $30.95 - 46 $1,576.89 $126.15 - H $5,270.27 - - - 09 $397.64 $19.88 - 18 $1,283.11 $64.16 - 37 $445.60 $22.28 - 45 $2,140.53 $107.03 - J $4,266.88 - - - 02 $1,893.78 $132.56 - 12 $313.77 $21.96 - 35 $1,589.82 $111.29 - K $3,797.37 - - MONTHLY TOTAL SALES $47,899.76 ** - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_reportwriter.at:2210: diff reference report.txt" -at_fn_check_prepare_trace "run_reportwriter.at:2210" -( $at_check_trace; diff reference report.txt -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_reportwriter.at:2210" -$at_failed && at_fn_log_failure \ -"./report.txt" -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_805 -#AT_START_806 -at_fn_group_banner 806 'run_reportwriter.at:2215' \ - "Sample Payroll Report" " " 4 -at_xfail=no -( - $as_echo "806. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >inp_data <<'_ATEOF' -01 6622 M GAVIN SHAFER 19740201 026000 01521 03362 00075 021042 -01 6622 M GAVIN SHAFER 19740215 026000 01521 03362 00175 020942 -01 6622 M GAVIN SHAFER 19740301 026000 01521 03362 00175 020942 -01 6622 M GAVIN SHAFER 19740315 026000 01521 03362 00050 021067 -01 7078 F VERA ALSTON 19740101 030000 01755 02304 00050 025891 -01 7078 F VERA ALSTON 19740115 030000 01755 02304 00100 025841 -01 7078 F VERA ALSTON 19740201 030000 01755 02304 00050 025891 -01 7078 F VERA ALSTON 19740215 030000 01755 02304 00000 025941 -01 7078 F VERA ALSTON 19740301 030000 01755 02304 00075 025866 -01 7078 F VERA ALSTON 19740315 030000 01755 02304 00100 025841 -01 8093 M GRADY KAISER 19740101 045000 02633 05819 00175 036374 -01 8093 M GRADY KAISER 19740115 045000 02633 05819 00100 036449 -01 8093 M GRADY KAISER 19740201 045000 02633 05819 00100 036449 -01 8093 M GRADY KAISER 19740215 047500 02779 03648 00100 040973 -01 8093 M GRADY KAISER 19740301 047500 02779 03648 00175 040898 -05 1720 F PAULINE WINSTON 19740101 013000 00761 20110 00050 010080 -05 1720 F PAULINE WINSTON 19740115 013000 00761 02110 00000 010130 -05 1720 F PAULINE WINSTON 19740201 014000 00819 02272 00075 010834 -05 1720 F PAULINE WINSTON 19740215 014000 00819 02272 00175 010734 -05 1720 F PAULINE WINSTON 19740301 014000 00819 02272 00050 010859 -05 2116 M HERMAN COX 19740101 010000 00585 01293 00175 007947 -05 2116 M HERMAN COX 19740115 010000 00585 01293 00175 007947 -05 2116 M HERMAN COX 19740201 010000 00585 01293 00100 008022 -05 2116 M HERMAN COX 19740215 010000 00585 01293 00100 008022 -05 2116 M HERMAN COX 19740301 010000 00585 01293 00075 008047 -05 2116 M HERMAN COX 19740315 011000 00644 01187 00100 009070 -05 6925 M ADOLF TRUJILLO 19740115 012500 00731 02379 00050 009340 -05 6925 M ADOLF TRUJILLO 19740201 012500 00731 02379 00100 009290 -05 6925 M ADOLF TRUJILLO 19740215 012500 00731 02379 00175 009215 -05 6925 M ADOLF TRUJILLO 19740301 012500 00731 02379 00075 009315 -05 6925 M ADOLF TRUJILLO 19740315 012500 00731 02379 00000 009390 -10 1504 F TIFFANY KEIR 19740101 029000 01697 03129 00050 024124 -10 1504 F TIFFANY KEIR 19740115 029000 01697 03129 00000 024174 -10 1504 F TIFFANY KEIR 19740201 029000 01697 03129 00075 024099 -10 1504 F TIFFANY KEIR 19740215 029000 01697 03129 00000 024174 -10 1504 F TIFFANY KEIR 19740301 029000 01697 03129 00000 024174 -10 1504 F TIFFANY KEIR 19740315 029000 01697 03129 00050 024124 -10 6640 M ALEXANDER CATHEY 19740101 032500 01901 06185 00000 024414 -10 6640 M ALEXANDER CATHEY 19740115 032500 01901 06185 00175 024239 -10 6640 M ALEXANDER CATHEY 19740201 032500 01901 06185 00175 024239 -10 6640 M ALEXANDER CATHEY 19740215 032500 01901 06185 00175 024239 -10 6640 M ALEXANDER CATHEY 19740301 032500 01901 06185 00100 024314 -10 6640 M ALEXANDER CATHEY 19740315 032500 01901 06185 00100 024314 -10 9465 M STEVE HUGHES 19740101 029500 01726 04788 00175 022811 -10 9465 M STEVE HUGHES 19740115 029500 01726 04788 00000 022986 -10 9465 M STEVE HUGHES 19740201 029500 01726 04788 00000 022986 -10 9465 M STEVE HUGHES 19740215 029500 01726 04788 00050 022936 -10 9465 M STEVE HUGHES 19740301 029500 01726 04788 00075 022911 -15 2903 F KAYLA VERBECK 19740101 014000 00819 02272 00050 010859 -15 2903 F KAYLA VERBECK 19740115 014000 00819 02272 00175 010734 -15 2903 F KAYLA VERBECK 19740201 014000 00819 02272 00050 010859 -15 2903 F KAYLA VERBECK 19740215 014000 00819 02272 00175 010734 -15 2903 F KAYLA VERBECK 19740301 014000 00819 02272 00000 010909 -15 2903 F KAYLA VERBECK 19740315 014000 00819 02272 00075 010834 -15 5196 F CLAIRE KELLAR 19740101 014500 00848 01114 00075 012463 -15 5196 F CLAIRE KELLAR 19740115 014500 00848 01114 00100 012438 -15 5196 F CLAIRE KELLAR 19740201 014500 00848 01114 00175 012363 -15 5196 F CLAIRE KELLAR 19740215 014500 00848 01114 00050 012488 -15 5196 F CLAIRE KELLAR 19740301 015300 00895 02912 00175 011318 -15 5196 F CLAIRE KELLAR 19740315 015300 00895 02912 00100 011393 -20 5190 F MARYANN GLAZENER 19740101 009000 00527 01164 00050 007260 -20 5190 F MARYANN GLAZENER 19740115 009000 00527 01164 00075 007235 -20 5190 F MARYANN GLAZENER 19740201 009000 00527 01164 00000 007310 -20 5190 F MARYANN GLAZENER 19740215 009000 00527 01164 00075 007235 -20 5190 F MARYANN GLAZENER 19740301 009000 00527 01164 00050 007260 -20 5190 F MARYANN GLAZENER 19740315 009000 00527 01164 00100 007210 -20 6580 F CAROLINE TROMBETTA 19740101 008000 00468 00863 00000 006669 -20 6580 F CAROLINE TROMBETTA 19740115 008000 00468 00863 00075 006594 -20 6580 F CAROLINE TROMBETTA 19740201 008000 00468 00863 00000 006569 -20 6580 F CAROLINE TROMBETTA 19740215 008000 00468 00863 00075 006594 -20 6580 F CAROLINE TROMBETTA 19740301 008000 00468 00863 00050 006619 -20 6580 F CAROLINE TROMBETTA 19740315 008000 00468 00863 00075 006594 -20 9507 F ADRIANA CHANGAZI 19740101 008300 00486 01347 00075 006392 -20 9507 F ADRIANA CHANGAZI 19740115 008300 00486 01347 00175 006292 -20 9507 F ADRIANA CHANGAZI 19740201 008300 00486 01347 00075 006392 -20 9507 F ADRIANA CHANGAZI 19740215 008300 00486 01347 00175 006292 -20 9507 F ADRIANA CHANGAZI 19740301 008300 00486 01347 00000 006467 -20 9507 F ADRIANA CHANGAZI 19740315 008300 00486 01347 00175 006292 -25 0428 M MELVIN BEHRENS 19740101 007800 00456 00842 00000 006502 -25 0428 M MELVIN BEHRENS 19740115 007800 00456 00842 00175 006327 -25 0428 M MELVIN BEHRENS 19740201 007800 00456 00842 00175 006327 -25 0428 M MELVIN BEHRENS 19740215 007800 00456 00842 00075 006427 -25 0428 M MELVIN BEHRENS 19740301 007800 00456 00842 00000 006502 -25 0428 M MELVIN BEHRENS 19740315 007800 00456 00842 00075 006427 -25 2003 M BALDWIN SIMONSEN 19740101 011000 00644 02093 00050 008213 -25 2003 M BALDWIN SIMONSEN 19740115 011000 00644 02093 00075 008188 -25 2003 M BALDWIN SIMONSEN 19740201 011000 00644 02093 00000 008263 -25 2003 M BALDWIN SIMONSEN 19740215 011000 00644 02093 00100 008163 -25 2003 M BALDWIN SIMONSEN 19740301 011500 00673 01487 00075 009265 -25 2003 M BALDWIN SIMONSEN 19740315 011500 00673 01487 00175 009165 -25 6491 M LEO TILLEY 19740101 010100 00591 00776 00050 008683 -25 6491 M LEO TILLEY 19740115 010100 00591 00776 00075 008658 -25 6491 M LEO TILLEY 19740201 010100 00591 00776 00050 008683 -25 6491 M LEO TILLEY 19740215 010100 00591 00776 00075 008658 -25 6491 M LEO TILLEY 19740301 010100 00591 00776 00100 008633 -25 6491 M LEO TILLEY 19740315 010100 00591 00776 00000 008733 -_ATEOF - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - * ************************************************************* * - * * MODIFICATIONS: * - * * CORRECT PARAGRAPH NAME AND GO TO CODING ERRORS. * - * ************************************************************* * - - * ************************************************************* * - * REPORT WRITER EXAMPLE #6. * - * ************************************************************* * - - ENVIRONMENT DIVISION. - CONFIGURATION SECTION. - - INPUT-OUTPUT SECTION. - FILE-CONTROL. - - SELECT PAYROLL-REGISTER-DATA - ASSIGN TO EXTERNAL DATAIN - ORGANIZATION IS LINE SEQUENTIAL. - - SELECT REPORT-FILE - ASSIGN TO EXTERNAL LINE ADVANCING SYSPRINT. - - DATA DIVISION. - FILE SECTION. - - FD PAYROLL-REGISTER-DATA. - - 01 PAYROLL-REGISTER-RECORD. - 03 PRR-DEPARTMENT-NUMBER PIC 9(02). - 03 FILLER PIC X(01). - 03 PRR-EMPLOYEE-KEY. - 05 PRR-EMPLOYEE-NO PIC 9(04). - 05 FILLER PIC X(01). - 05 PRR-GENDER PIC X(01). - 05 FILLER PIC X(01). - 05 PRR-EMPLOYEE-NAME PIC X(20). - 03 FILLER PIC X(01). - 03 PRR-PAY-DATE PIC 9(08). - 03 FILLER REDEFINES PRR-PAY-DATE. - 05 PRR-PAY-DATE-YEAR PIC 9(04). - 05 PRR-PAY-DATE-MONTH PIC 9(02). - 05 PRR-PAY-DATE-DAY PIC 9(02). - 03 FILLER PIC X(01). - 03 PRR-GROSS-PAY PIC 9(04)V99. - 03 FILLER PIC X(01). - 03 PRR-FICA-WH PIC 9(03)V99. - 03 FILLER PIC X(01). - 03 PRR-FED-WH PIC 9(03)V99. - 03 FILLER PIC X(01). - 03 PRR-MISC-DED PIC 9(03)V99. - 03 FILLER PIC X(01). - 03 PRR-NET-PAY PIC 9(04)V99. - 03 FILLER PIC X(09). - - FD REPORT-FILE - REPORT IS QUARTERLY-PAY-REGISTER. - - WORKING-STORAGE SECTION. - 77 END-OF-FILE-SWITCH PIC X(1) VALUE 'N'. - 88 END-OF-FILE VALUE 'Y'. - 77 PR-SW PIC X(1) VALUE 'N'. - 77 SUM-FED-WH PIC 9(04)V99 VALUE 0. - 77 HI-GROSS PIC 9(05) VALUE 2000. - - 01 WS-EMPLOYEE-KEY. - 03 WS-EMPLOYEE-NUMBER PIC 9(04). - 03 FILLER PIC X(03). - 03 WS-EMPLOYEE-NAME PIC X(20). - - 01 WS-PERCENTS-COMPUTED. - 03 WPC-DEPT OCCURS 6 TIMES - INDEXED BY WPCD-IX. - 05 WPC-PERCENT OCCURS 5 TIMES - INDEXED BY WPCC-IX - PIC 9(3)V99. - - 01 DEPARTMENT-TABLE. - 03 FILLER PIC X(17) VALUE '01MANAGEMENT '. - 03 FILLER PIC X(50) VALUE ZEROS. - 03 FILLER PIC X(17) VALUE '05ADMINISTRATIVE '. - 03 FILLER PIC X(50) VALUE ZEROS. - 03 FILLER PIC X(17) VALUE '10SKILLED NURSING'. - 03 FILLER PIC X(50) VALUE ZEROS. - 03 FILLER PIC X(17) VALUE '15PATIENT SUPPORT'. - 03 FILLER PIC X(50) VALUE ZEROS. - 03 FILLER PIC X(17) VALUE '20HOUSEKEEPING '. - 03 FILLER PIC X(50) VALUE ZEROS. - 03 FILLER PIC X(17) VALUE '25MAINTENANCE '. - 03 FILLER PIC X(50) VALUE ZEROS. - 01 FILLER REDEFINES DEPARTMENT-TABLE. - 03 DEPARTMENT-ENTRY OCCURS 6 TIMES - INDEXED BY DE-IX. - 05 DE-NUMBER PIC 9(02). - 05 DE-NAME PIC X(15). - 05 DE-GROSS PIC 9(08)V99. - 05 DE-FICA PIC 9(08)V99. - 05 DE-FWT PIC 9(08)V99. - 05 DE-MISC PIC 9(08)V99. - 05 DE-NET PIC 9(08)V99. - - REPORT SECTION. - RD QUARTERLY-PAY-REGISTER - CONTROLS ARE FINAL, PRR-DEPARTMENT-NUMBER, - PRR-EMPLOYEE-KEY - PAGE LIMIT IS 66 LINES - HEADING 1 - FIRST DETAIL 7 - LAST DETAIL 60. - - 01 TYPE PAGE HEADING. - 02 LINE 1. - 03 COLUMN 39 PIC X(13) VALUE 'C E N T U R Y'. - 03 COLUMN 55 PIC X(13) VALUE 'M E D I C A L'. - 03 COLUMN 71 PIC X(11) VALUE 'C E N T E R'. - 02 LINE 2. - 03 COLUMN 35 PIC X(17) VALUE 'Q U A R T E R L Y'. - 03 COLUMN 55 PIC X(13) VALUE 'P A Y R O L L'. - 03 COLUMN 71 PIC X(15) VALUE 'R E G I S T E R'. - 03 COLUMN 111 PIC X(04) VALUE 'PAGE'. - 03 COLUMN 116 PIC ZZZZ9 SOURCE PAGE-COUNTER. - 02 LINE 4. - 03 COLUMN 06 PIC X(9) VALUE ALL '-'. - 03 COLUMN 15 PIC X(28) VALUE - ' EMPLOYEE ---------'. - 03 COLUMN 40 PIC X(05) VALUE 'GROSS'. - 03 COLUMN 54 PIC X(04) VALUE 'FICA'. - 03 COLUMN 66 PIC X(07) VALUE 'FED W/H'. - 03 COLUMN 80 PIC X(05) VALUE 'MISC.'. - 03 COLUMN 95 PIC X(03) VALUE 'NET'. - 02 LINE 5. - 03 COLUMN 07 PIC X(02) VALUE 'NO'. - 03 COLUMN 22 PIC X(04) VALUE 'NAME'. - 03 COLUMN 41 PIC X(03) VALUE 'PAY'. - 03 COLUMN 55 PIC X(03) VALUE 'TAX'. - 03 COLUMN 68 PIC X(03) VALUE 'TAX'. - 03 COLUMN 79 PIC X(07) VALUE 'DEDUCT.'. - 03 COLUMN 95 PIC X(03) VALUE 'PAY'. - - 01 DEPT-HEAD TYPE CONTROL HEADING PRR-DEPARTMENT-NUMBER - NEXT GROUP + 1. - 02 LINE PLUS 1. - 03 COLUMN 01 PIC X(18) VALUE - 'DEPARTMENT NUMBER:'. - 03 COLUMN 21 PIC 9(02) SOURCE PRR-DEPARTMENT-NUMBER. - 03 COLUMN 24 PIC X(15) SOURCE DE-NAME (DE-IX). - - 01 EMPLOYEE-DETAIL TYPE DETAIL. - 02 LINE + 1. - 03 COLUMN 01 PIC X(27) SOURCE PRR-EMPLOYEE-KEY. - 03 COLUMN 30 PIC X(5) VALUE "Hello" - PRESENT AFTER NEW PRR-EMPLOYEE-KEY - OR PAGE. - 03 COLUMN 30 PIC X(5) VALUE " '' " - ABSENT AFTER NEW PRR-EMPLOYEE-KEY - OR PAGE. - 03 COLUMN 50 PIC 9(04).99 SOURCE PRR-GROSS-PAY. - 03 COLUMN 60 PIC 9(03).99 SOURCE PRR-FICA-WH. - 03 COLUMN 70 PIC 9(03).99 SOURCE PRR-FED-WH. - 03 COLUMN 80 PIC 9(03).99 SOURCE PRR-MISC-DED. - 03 COLUMN 90 PIC 9(04).99 SOURCE PRR-NET-PAY. - - 01 EMPL-FOOT TYPE CONTROL FOOTING PRR-EMPLOYEE-KEY. - 02 LINE PLUS 1 - PRESENT WHEN SUM-FED-WH > 80.00 - . - 03 COLUMN 06 PIC ZZZ9 SOURCE WS-EMPLOYEE-NUMBER. - 03 COLUMN 14 PIC X(20) SOURCE WS-EMPLOYEE-NAME. - 03 COLUMN 38 PIC $$,$$9.99 SUM PRR-GROSS-PAY. - 03 COLUMN 53 PIC $$$9.99 SUM PRR-FICA-WH. - 03 COLUMN 66 PIC $$$9.99 SUM PRR-FED-WH. - 03 COLUMN 79 PIC $$$9.99 SUM PRR-MISC-DED. - 03 COLUMN 92 PIC $$,$$9.99 SUM PRR-NET-PAY. - - 01 DEPT-FOOT TYPE CONTROL FOOTING PRR-DEPARTMENT-NUMBER - NEXT GROUP PLUS 2. - 02 LINE PLUS 2. - 03 COLUMN 14 PIC X(20) VALUE - 'DEPARTMENT TOTALS'. - 03 DEPT-FOOT-GROSS COLUMN 38 PIC $$,$$9.99 - SUM PRR-GROSS-PAY. - 03 COLUMN 48 PIC X VALUE '*'. - 03 DEPT-FOOT-FICA COLUMN 53 PIC $$$9.99 - SUM PRR-FICA-WH. - 03 COLUMN 61 PIC X VALUE '*'. - 03 DEPT-FOOT-FWT COLUMN 66 PIC $$$9.99 - SUM PRR-FED-WH. - 03 COLUMN 74 PIC X VALUE '*'. - 03 DEPT-FOOT-MISC COLUMN 79 PIC $$$9.99 - SUM PRR-MISC-DED. - 03 COLUMN 87 PIC X VALUE '*'. - 03 DEPT-FOOT-NET COLUMN 92 PIC $$,$$9.99 - SUM PRR-NET-PAY. - 03 COLUMN 102 PIC X VALUE '*'. - - 01 COMP-FOOT TYPE CONTROL FOOTING FINAL. - 02 LINE PLUS 2. - 03 COLUMN 14 PIC X(20) VALUE - 'COMPANY TOTALS'. - 03 CO-GROSS COLUMN 37 PIC $$$,$$9.99 - SUM PRR-GROSS-PAY. - 03 COLUMN 48 PIC XX VALUE '**'. - 03 CO-FICA COLUMN 51 PIC $$,$$9.99 - SUM PRR-FICA-WH. - 03 COLUMN 61 PIC XX VALUE '**'. - 03 CO-FWT COLUMN 64 PIC $$,$$9.99 - SUM PRR-FED-WH. - 03 COLUMN 74 PIC XX VALUE '**'. - 03 CO-MISC COLUMN 77 PIC $$,$$9.99 - SUM PRR-MISC-DED. - 03 COLUMN 87 PIC XX VALUE '**'. - 03 CO-NET COLUMN 91 PIC $$$,$$9.99 - SUM PRR-NET-PAY. - 03 COLUMN 102 PIC XX VALUE '**'. - - 01 REPORT-FOOT TYPE REPORT FOOTING. - 02 LINE 1. - 03 COLUMN 39 PIC X(13) VALUE 'C e n t u r y'. - 03 COLUMN 55 PIC X(13) VALUE 'M e d i c a l'. - 03 COLUMN 71 PIC X(11) VALUE 'C e n t e r'. - 02 LINE 2. - 03 COLUMN 35 PIC X(17) VALUE 'Q u a r t e r l y'. - 03 COLUMN 55 PIC X(13) VALUE 'P a y r o l l'. - 03 COLUMN 71 PIC X(15) VALUE 'R e g i s t e r'. - 03 COLUMN 111 PIC X(04) VALUE 'PAGE'. - 03 COLUMN 116 PIC ZZZZ9 SOURCE PAGE-COUNTER. - 02 LINE 4. - 03 COLUMN 40 PIC X(05) VALUE 'GROSS'. - 03 COLUMN 58 PIC X(04) VALUE 'FICA'. - 03 COLUMN 74 PIC X(07) VALUE 'FED W/H'. - 03 COLUMN 92 PIC X(05) VALUE 'MISC.'. - 03 COLUMN 111 PIC X(03) VALUE 'NET'. - 02 LINE 5. - 03 COLUMN 41 PIC X(03) VALUE 'PAY'. - 03 COLUMN 59 PIC X(03) VALUE 'TAX'. - 03 COLUMN 76 PIC X(03) VALUE 'TAX'. - 03 COLUMN 91 PIC X(07) VALUE 'DEDUCT.'. - 03 COLUMN 111 PIC X(03) VALUE 'PAY'. - - 02 LINE PLUS 2. - 03 COLUMN 05 PIC X(29) VALUE - '* * * DEPARTMENT TOTALS * * *'. - 02 LINE PLUS 2. - 03 COLUMN 05 PIC 9(02) SOURCE DE-NUMBER (1). - 03 COLUMN 08 PIC X(15) SOURCE DE-NAME (1). - 03 FILLER PRESENT WHEN DE-GROSS (1) > HI-GROSS. - 05 COLUMN 30 PIC X(4) VALUE "High". - 03 COLUMN 38 PIC $$,$$9.99 SOURCE DE-GROSS (1). - 03 COLUMN 48 PIC ZZ9 SOURCE WPC-PERCENT (1 1). - 03 COLUMN 51 PIC X VALUE '%'. - 03 COLUMN 57 PIC $$$9.99 SOURCE DE-FICA (1). - 03 COLUMN 65 PIC ZZ9 SOURCE WPC-PERCENT (1 2). - 03 COLUMN 68 PIC X VALUE '%'. - 03 COLUMN 74 PIC $$$9.99 SOURCE DE-FWT (1). - 03 COLUMN 82 PIC ZZ9 SOURCE WPC-PERCENT (1 3). - 03 COLUMN 85 PIC X VALUE '%'. - 03 COLUMN 91 PIC $$$9.99 SOURCE DE-MISC (1). - 03 COLUMN 99 PIC ZZ9 SOURCE WPC-PERCENT (1 4). - 03 COLUMN 102 PIC X VALUE '%'. - 03 COLUMN 108 PIC $$,$$9.99 SOURCE DE-NET (1). - 03 COLUMN 118 PIC ZZ9 SOURCE WPC-PERCENT (1 5). - 03 COLUMN 121 PIC X VALUE '%'. - 03 FILLER PRESENT WHEN WPC-PERCENT (1 5) < 15 . - 05 COLUMN PLUS 1 PIC X(2) VALUE "Lo". - 02 LINE PLUS 2. - 03 COLUMN 05 PIC 9(02) SOURCE DE-NUMBER (2). - 03 COLUMN 08 PIC X(15) SOURCE DE-NAME (2). - 03 FILLER PRESENT WHEN DE-GROSS (2) > HI-GROSS. - 05 COLUMN 30 PIC X(4) VALUE "High". - 03 COLUMN 38 PIC $$,$$9.99 SOURCE DE-GROSS (2). - 03 COLUMN 48 PIC ZZ9 SOURCE WPC-PERCENT (2 1). - 03 COLUMN 51 PIC X VALUE '%'. - 03 COLUMN 57 PIC $$$9.99 SOURCE DE-FICA (2). - 03 COLUMN 65 PIC ZZ9 SOURCE WPC-PERCENT (2 2). - 03 COLUMN 68 PIC X VALUE '%'. - 03 COLUMN 74 PIC $$$9.99 SOURCE DE-FWT (2). - 03 COLUMN 82 PIC ZZ9 SOURCE WPC-PERCENT (2 3). - 03 COLUMN 85 PIC X VALUE '%'. - 03 COLUMN 91 PIC $$$9.99 SOURCE DE-MISC (2). - 03 COLUMN 99 PIC ZZ9 SOURCE WPC-PERCENT (2 4). - 03 COLUMN 102 PIC X VALUE '%'. - 03 COLUMN 108 PIC $$,$$9.99 SOURCE DE-NET (2). - 03 COLUMN 118 PIC ZZ9 SOURCE WPC-PERCENT (2 5). - 03 COLUMN 121 PIC X VALUE '%'. - 03 FILLER PRESENT WHEN WPC-PERCENT (2 5) < 15 . - 05 COLUMN PLUS 1 PIC X(2) VALUE "Lo". - 02 LINE PLUS 2. - 03 COLUMN 05 PIC 9(02) SOURCE DE-NUMBER (3). - 03 COLUMN 08 PIC X(15) SOURCE DE-NAME (3). - 03 FILLER PRESENT WHEN DE-GROSS (3) > HI-GROSS. - 05 COLUMN 30 PIC X(4) VALUE "High". - 03 COLUMN 38 PIC $$,$$9.99 SOURCE DE-GROSS (3). - 03 COLUMN 48 PIC ZZ9 SOURCE WPC-PERCENT (3 1). - 03 COLUMN 51 PIC X VALUE '%'. - 03 COLUMN 57 PIC $$$9.99 SOURCE DE-FICA (3). - 03 COLUMN 65 PIC ZZ9 SOURCE WPC-PERCENT (3 2). - 03 COLUMN 68 PIC X VALUE '%'. - 03 COLUMN 74 PIC $$$9.99 SOURCE DE-FWT (3). - 03 COLUMN 82 PIC ZZ9 SOURCE WPC-PERCENT (3 3). - 03 COLUMN 85 PIC X VALUE '%'. - 03 COLUMN 91 PIC $$$9.99 SOURCE DE-MISC (3). - 03 COLUMN 99 PIC ZZ9 SOURCE WPC-PERCENT (3 4). - 03 COLUMN 102 PIC X VALUE '%'. - 03 COLUMN 108 PIC $$,$$9.99 SOURCE DE-NET (3). - 03 COLUMN 118 PIC ZZ9 SOURCE WPC-PERCENT (3 5). - 03 COLUMN 121 PIC X VALUE '%'. - 03 FILLER PRESENT WHEN WPC-PERCENT (3 5) < 15 . - 05 COLUMN PLUS 1 PIC X(2) VALUE "Lo". - 02 LINE PLUS 2. - 03 COLUMN 05 PIC 9(02) SOURCE DE-NUMBER (4). - 03 COLUMN 08 PIC X(15) SOURCE DE-NAME (4). - 03 COLUMN 38 PIC $$,$$9.99 SOURCE DE-GROSS (4). - 03 COLUMN 48 PIC ZZ9 SOURCE WPC-PERCENT (4 1). - 03 COLUMN 51 PIC X VALUE '%'. - 03 COLUMN 57 PIC $$$9.99 SOURCE DE-FICA (4). - 03 COLUMN 65 PIC ZZ9 SOURCE WPC-PERCENT (4 2). - 03 COLUMN 68 PIC X VALUE '%'. - 03 COLUMN 74 PIC $$$9.99 SOURCE DE-FWT (4). - 03 COLUMN 82 PIC ZZ9 SOURCE WPC-PERCENT (4 3). - 03 COLUMN 85 PIC X VALUE '%'. - 03 COLUMN 91 PIC $$$9.99 SOURCE DE-MISC (4). - 03 COLUMN 99 PIC ZZ9 SOURCE WPC-PERCENT (4 4). - 03 COLUMN 102 PIC X VALUE '%'. - 03 COLUMN 108 PIC $$,$$9.99 SOURCE DE-NET (4). - 03 COLUMN 118 PIC ZZ9 SOURCE WPC-PERCENT (4 5). - 03 COLUMN 121 PIC X VALUE '%'. - 02 LINE PLUS 2. - 03 COLUMN 05 PIC 9(02) SOURCE DE-NUMBER (5). - 03 COLUMN 08 PIC X(15) SOURCE DE-NAME (5). - 03 COLUMN 38 PIC $$,$$9.99 SOURCE DE-GROSS (5). - 03 COLUMN 48 PIC ZZ9 SOURCE WPC-PERCENT (5 1). - 03 COLUMN 51 PIC X VALUE '%'. - 03 COLUMN 57 PIC $$$9.99 SOURCE DE-FICA (5). - 03 COLUMN 65 PIC ZZ9 SOURCE WPC-PERCENT (5 2). - 03 COLUMN 68 PIC X VALUE '%'. - 03 COLUMN 74 PIC $$$9.99 SOURCE DE-FWT (5). - 03 COLUMN 82 PIC ZZ9 SOURCE WPC-PERCENT (5 3). - 03 COLUMN 85 PIC X VALUE '%'. - 03 COLUMN 91 PIC $$$9.99 SOURCE DE-MISC (5). - 03 COLUMN 99 PIC ZZ9 SOURCE WPC-PERCENT (5 4). - 03 COLUMN 102 PIC X VALUE '%'. - 03 COLUMN 108 PIC $$,$$9.99 SOURCE DE-NET (5). - 03 COLUMN 118 PIC ZZ9 SOURCE WPC-PERCENT (5 5). - 03 COLUMN 121 PIC X VALUE '%'. - 02 LINE PLUS 2. - 03 COLUMN 05 PIC 9(02) SOURCE DE-NUMBER (6). - 03 COLUMN 08 PIC X(15) SOURCE DE-NAME (6). - 03 COLUMN 38 PIC $$,$$9.99 SOURCE DE-GROSS (6). - 03 COLUMN 48 PIC ZZ9 SOURCE WPC-PERCENT (6 1). - 03 COLUMN 51 PIC X VALUE '%'. - 03 COLUMN 57 PIC $$$9.99 SOURCE DE-FICA (6). - 03 COLUMN 65 PIC ZZ9 SOURCE WPC-PERCENT (6 2). - 03 COLUMN 68 PIC X VALUE '%'. - 03 COLUMN 74 PIC $$$9.99 SOURCE DE-FWT (6). - 03 COLUMN 82 PIC ZZ9 SOURCE WPC-PERCENT (6 3). - 03 COLUMN 85 PIC X VALUE '%'. - 03 COLUMN 91 PIC $$$9.99 SOURCE DE-MISC (6). - 03 COLUMN 99 PIC ZZ9 SOURCE WPC-PERCENT (6 4). - 03 COLUMN 102 PIC X VALUE '%'. - 03 COLUMN 108 PIC $$,$$9.99 SOURCE DE-NET (6). - 03 COLUMN 118 PIC ZZ9 SOURCE WPC-PERCENT (6 5). - 03 COLUMN 121 PIC X VALUE '%'. - 02 LINE PLUS 2. - 03 COLUMN 37 PIC $$$,$$9.99 SOURCE CO-GROSS. - 03 COLUMN 48 PIC X(5) VALUE '100%'. - 03 COLUMN 55 PIC $$,$$9.99 SOURCE CO-FICA. - 03 COLUMN 65 PIC X(5) VALUE '100%'. - 03 COLUMN 72 PIC $$,$$9.99 SOURCE CO-FWT. - 03 COLUMN 82 PIC X(5) VALUE '100%'. - 03 COLUMN 89 PIC $$,$$9.99 SOURCE CO-MISC. - 03 COLUMN 99 PIC X(5) VALUE '100%'. - 03 COLUMN 107 PIC $$$,$$9.99 SOURCE CO-NET. - 03 COLUMN 118 PIC X(5) VALUE '100%'. - - PROCEDURE DIVISION. - - DECLARATIVES. - - DEPT-HEAD-USE SECTION. USE BEFORE REPORTING DEPT-HEAD. - DEPT-HEAD-PROC. - SET DE-IX TO +1. - SEARCH DEPARTMENT-ENTRY - WHEN DE-NUMBER (DE-IX) = PRR-DEPARTMENT-NUMBER - MOVE ZEROS TO DE-GROSS (DE-IX), DE-FICA (DE-IX), - DE-FWT (DE-IX), DE-MISC (DE-IX), - DE-NET (DE-IX). - - DEPT-HEAD-EXIT. - EXIT. - - EMPL-FOOT-USE SECTION. USE BEFORE REPORTING EMPL-FOOT. - EMPL-FOOT-PROC. - MOVE PRR-EMPLOYEE-KEY TO WS-EMPLOYEE-KEY. - MOVE 'Y' TO PR-SW. - - EMPL-FOOT-EXIT. - EXIT. - - DEPT-FOOT-USE SECTION. USE BEFORE REPORTING DEPT-FOOT. - DEPT-FOOT-PROC. - MOVE DEPT-FOOT-GROSS TO DE-GROSS (DE-IX). - MOVE DEPT-FOOT-FICA TO DE-FICA (DE-IX). - MOVE DEPT-FOOT-FWT TO DE-FWT (DE-IX). - MOVE DEPT-FOOT-MISC TO DE-MISC (DE-IX). - MOVE DEPT-FOOT-NET TO DE-NET (DE-IX). - * SUPPRESS PRINTING. - - DEPT-FOOT-EXIT. - EXIT. - - COMP-FOOT-USE SECTION. USE BEFORE REPORTING COMP-FOOT. - COMP-FOOT-PROC. - PERFORM COMP-FOOT-CALC - VARYING WPCD-IX FROM +1 BY +1 - UNTIL WPCD-IX > +6. - GO TO COMP-FOOT-EXIT. - - COMP-FOOT-CALC. - SET DE-IX TO WPCD-IX. - SET WPCC-IX TO +1. - COMPUTE WPC-PERCENT (WPCD-IX WPCC-IX) ROUNDED = - ((DE-GROSS (DE-IX) / CO-GROSS) * 100) + .5. - SET WPCC-IX TO +2. - COMPUTE WPC-PERCENT (WPCD-IX WPCC-IX) ROUNDED = - ((DE-FICA (DE-IX) / CO-FICA) * 100) + .5. - SET WPCC-IX TO +3. - COMPUTE WPC-PERCENT (WPCD-IX WPCC-IX) ROUNDED = - ((DE-FWT (DE-IX) / CO-FWT) * 100) + .5. - SET WPCC-IX TO +4. - COMPUTE WPC-PERCENT (WPCD-IX WPCC-IX) ROUNDED = - ((DE-MISC (DE-IX) / CO-MISC) * 100) + .5. - SET WPCC-IX TO +5. - COMPUTE WPC-PERCENT (WPCD-IX WPCC-IX) ROUNDED = - ((DE-NET (DE-IX) / CO-NET) * 100) + .5. - - COMP-FOOT-EXIT. - EXIT. - - END DECLARATIVES. - - 000-INITIATE. - - OPEN INPUT PAYROLL-REGISTER-DATA, - OUTPUT REPORT-FILE. - - INITIATE QUARTERLY-PAY-REGISTER. - - READ PAYROLL-REGISTER-DATA - AT END - MOVE 'Y' TO END-OF-FILE-SWITCH. - - PERFORM 100-PROCESS-PAYROLL-DATA THRU 199-EXIT - UNTIL END-OF-FILE. - - 000-TERMINATE. - TERMINATE QUARTERLY-PAY-REGISTER. - - CLOSE PAYROLL-REGISTER-DATA, - REPORT-FILE. - - STOP RUN. - - 100-PROCESS-PAYROLL-DATA. - ADD PRR-FED-WH TO SUM-FED-WH. - GENERATE QUARTERLY-PAY-REGISTER. - IF PR-SW = 'Y' - MOVE 'N' TO PR-SW - MOVE ZERO TO SUM-FED-WH. - READ PAYROLL-REGISTER-DATA - AT END - MOVE 'Y' TO END-OF-FILE-SWITCH. - - 199-EXIT. - EXIT. - -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_reportwriter.at:2795: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_reportwriter.at:2795" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob:266: warning: PLUS is ignored on first field of line -prog.cob:288: warning: PLUS is ignored on first field of line -prog.cob:310: warning: PLUS is ignored on first field of line -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_reportwriter.at:2795" -$at_failed && at_fn_log_failure -$at_traceon; } - - -{ set +x -$as_echo "$at_srcdir/run_reportwriter.at:2801: DD_DATAIN=\"./inp_data\" DD_SYSPRINT=\"./report.txt\" \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "DD_DATAIN=\"./inp_data\" DD_SYSPRINT=\"./report.txt\" $COBCRUN_DIRECT ./prog" "run_reportwriter.at:2801" -( $at_check_trace; DD_DATAIN="./inp_data" DD_SYSPRINT="./report.txt" $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_reportwriter.at:2801" -$at_failed && at_fn_log_failure -$at_traceon; } - - - - - -cat >reference <<'_ATEOF' - C E N T U R Y M E D I C A L C E N T E R - Q U A R T E R L Y P A Y R O L L R E G I S T E R PAGE 1 - - --------- EMPLOYEE --------- GROSS FICA FED W/H MISC. NET - NO NAME PAY TAX TAX DEDUCT. PAY - -DEPARTMENT NUMBER: 01 MANAGEMENT - - 6622 GAVIN SHAFER $1,040.00 $60.84 $134.48 $4.75 $839.93 - 7078 VERA ALSTON $1,800.00 $105.30 $138.24 $3.75 $1,552.71 - 8093 GRADY KAISER $2,300.00 $134.57 $247.53 $6.50 $1,911.43 - - DEPARTMENT TOTALS $5,140.00 * $300.71 * $520.25 * $15.00 * $4,304.07 * - - -DEPARTMENT NUMBER: 05 ADMINISTRATIVE - - 1720 PAULINE WINSTON $680.00 $39.79 $290.36 $3.50 $526.37 - 2116 HERMAN COX $610.00 $35.69 $76.52 $7.25 $490.55 - 6925 ADOLF TRUJILLO $625.00 $36.55 $118.95 $4.00 $465.50 - - DEPARTMENT TOTALS $1,915.00 * $112.03 * $485.83 * $14.75 * $1,482.42 * - - -DEPARTMENT NUMBER: 10 SKILLED NURSING - - 1504 TIFFANY KEIR $1,740.00 $101.82 $187.74 $1.75 $1,448.69 - 6640 ALEXANDER CATHEY $1,950.00 $114.06 $371.10 $7.25 $1,457.59 - 9465 STEVE HUGHES $1,475.00 $86.30 $239.40 $3.00 $1,146.30 - - DEPARTMENT TOTALS $5,165.00 * $302.18 * $798.24 * $12.00 * $4,052.58 * - - -DEPARTMENT NUMBER: 15 PATIENT SUPPORT - - 2903 KAYLA VERBECK $840.00 $49.14 $136.32 $5.25 $649.29 - 5196 CLAIRE KELLAR $886.00 $51.82 $102.80 $6.75 $724.63 - - DEPARTMENT TOTALS $1,726.00 * $100.96 * $239.12 * $12.00 * $1,373.92 * - - -DEPARTMENT NUMBER: 20 HOUSEKEEPING - - - DEPARTMENT TOTALS $1,518.00 * $88.86 * $202.44 * $13.00 * $1,212.76 * - - -DEPARTMENT NUMBER: 25 MAINTENANCE - - 2003 BALDWIN SIMONSEN $670.00 $39.22 $113.46 $4.75 $512.57 - - DEPARTMENT TOTALS $1,744.00 * $102.04 * $210.54 * $13.25 * $1,418.17 * - - COMPANY TOTALS $17,208.00 ** $1,006.78 ** $2,456.42 ** $80.00 ** $13,843.92 ** - - - - - - - - - - - - - C e n t u r y M e d i c a l C e n t e r - Q u a r t e r l y P a y r o l l R e g i s t e r PAGE 2 - - GROSS FICA FED W/H MISC. NET - PAY TAX TAX DEDUCT. PAY - - * * * DEPARTMENT TOTALS * * * - - 01 MANAGEMENT High $5,140.00 30% $300.71 30% $520.25 21% $15.00 19% $4,304.07 31% - -Lo 05 ADMINISTRATIVE $1,915.00 11% $112.03 11% $485.83 20% $14.75 18% $1,482.42 11% - - 10 SKILLED NURSING High $5,165.00 30% $302.18 30% $798.24 33% $12.00 15% $4,052.58 29% - - 15 PATIENT SUPPORT $1,726.00 10% $100.96 10% $239.12 10% $12.00 15% $1,373.92 10% - - 20 HOUSEKEEPING $1,518.00 9% $88.86 9% $202.44 8% $13.00 16% $1,212.76 9% - - 25 MAINTENANCE $1,744.00 10% $102.04 10% $210.54 9% $13.25 17% $1,418.17 10% - - $17,208.00 100% $1,006.78 100% $2,456.42 100% $80.00 100% $13,843.92 100% -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_reportwriter.at:2895: diff reference report.txt" -at_fn_check_prepare_trace "run_reportwriter.at:2895" -( $at_check_trace; diff reference report.txt -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_reportwriter.at:2895" -$at_failed && at_fn_log_failure \ -"./report.txt" -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_806 -#AT_START_807 -at_fn_group_banner 807 'run_reportwriter.at:2900' \ - "Sample REPORT with RIGHT/CENTER" " " 4 -at_xfail=no -( - $as_echo "807. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >inp_data <<'_ATEOF' -00099Dorken, Keith CS 000008 -00007Allinson, Sandy MA 000118 -00125Allinson, Nina MA 012308 -00126Allinson, Natalia MA 000008 -00127Allinson, Kristina MBA000008 -00131Norman, Nancy SC 000006 -00132Norman, Becky SC 000116 -00133Norman, Michelle SC 112306 -00134Norman, James AM 000006 -12345Norman, Ron CS 000008 -_ATEOF - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - CONFIGURATION SECTION. - INPUT-OUTPUT SECTION. - - FILE-CONTROL. - SELECT INPUT-FILE ASSIGN TO EXTERNAL STUDENT - ORGANIZATION IS LINE SEQUENTIAL. - SELECT PRINT-FILE ASSIGN TO EXTERNAL - LINE ADVANCING REPORT1. - - DATA DIVISION. - FILE SECTION. - FD INPUT-FILE. - 01 INPUT-REC. - 05 STUDENT-ID PIC 9(5). - 05 STUDENT-NAME PIC X(20). - 05 MAJOR PIC XXX. - 05 NUM-COURSES PIC 9(6). - - FD PRINT-FILE - BLOCK CONTAINS 0 RECORDS - RECORDING MODE IS F - RECORD CONTAINS 132 CHARACTERS - REPORT IS STUDENT-REPORT. - 01 RW-REC PIC X(90). - - WORKING-STORAGE SECTION. - 01 ARE-THERE-MORE-RECORDS PIC XXX VALUE "YES". - - REPORT SECTION. - RD STUDENT-REPORT - PAGE LIMIT 30 - HEADING 1 - FIRST DETAIL 5 - LAST DETAIL 25 - FOOTING 28 - LINE LIMIT 90 - . - 01 HEADING-LINE. - 02 TYPE PAGE HEADING LINE PLUS 1. - 05 COLUMN 1 PIC X(50) VALUE - " 1 2 3 4 5". - 05 COLUMN 51 PIC X(20) VALUE " 6 7". - 02 TYPE PAGE HEADING LINE PLUS 1. - 05 COLUMN 1 PIC X(50) VALUE - "12345678901234567890123456789012345678901234567890". - 05 COLUMN 51 PIC X(20) VALUE "12345678901234567890". - 02 TYPE PAGE HEADING LINE PLUS 1. - 05 COLUMN 1 PIC X(2) VALUE "Ln". - 05 COLUMN 5 PIC X(6) VALUE "--ID--". - 05 COLUMN 16 PIC X(20) VALUE "--------Name--------". - 05 COLUMN 39 PIC X(5) VALUE "Major". - 05 COLUMN 45 PIC XXX VALUE "*-*". - 05 COLUMN 54 PIC X(5) VALUE "+Odd+". - 05 COLUMN 61 PIC X(6) VALUE "+Even+". - - 01 REPORT-LINE - TYPE DETAIL LINE PLUS 1. - 05 COLUMN PLUS 1 PIC Z9 - SOURCE LINE-COUNTER OF STUDENT-REPORT. - 05 COLUMN LEFT PLUS 3 PIC Z(5)9 SOURCE STUDENT-ID. - 05 COLUMN CENTER 25 PIC X(20) SOURCE STUDENT-NAME. - 05 COLUMN RIGHT 43 PIC X(5) SOURCE MAJOR. - 05 COLUMN 45 PIC XXX VALUE ":-:". - 05 COLUMN CENTER 56 PIC Z(4)9 SOURCE NUM-COURSES. - 05 COLUMN CENTER 63 PIC Z(5)9 SOURCE NUM-COURSES. - 05 COLUMN 68 PIC X VALUE ":". - - PROCEDURE DIVISION. - A000-MAINLINE. - OPEN INPUT INPUT-FILE - OUTPUT PRINT-FILE - PERFORM DO-INIT. - READ INPUT-FILE - AT END - MOVE "NO" TO ARE-THERE-MORE-RECORDS. - PERFORM A001-LOOP - UNTIL ARE-THERE-MORE-RECORDS = "NO ". - PERFORM DO-TERM. - CLOSE INPUT-FILE - PRINT-FILE. - STOP RUN. - - A001-LOOP. - GENERATE REPORT-LINE. - READ INPUT-FILE - AT END - MOVE "NO " TO ARE-THERE-MORE-RECORDS. - DO-INIT. - INITIATE STUDENT-REPORT. - - DO-TERM. - TERMINATE STUDENT-REPORT. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_reportwriter.at:3014: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_reportwriter.at:3014" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob:62: warning: PLUS is ignored on first field of line -prog.cob:64: error: PLUS is not allowed with LEFT, RIGHT or CENTER -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/run_reportwriter.at:3014" -$at_failed && at_fn_log_failure -$at_traceon; } - - -{ set +x -$as_echo "$at_srcdir/run_reportwriter.at:3019: \$COMPILE -std=mf prog.cob" -at_fn_check_prepare_dynamic "$COMPILE -std=mf prog.cob" "run_reportwriter.at:3019" -( $at_check_trace; $COMPILE -std=mf prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob:62: warning: PLUS is ignored on first field of line -prog.cob:64: warning: PLUS is not recommended with LEFT, RIGHT or CENTER -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_reportwriter.at:3019" -$at_failed && at_fn_log_failure -$at_traceon; } - - -{ set +x -$as_echo "$at_srcdir/run_reportwriter.at:3024: DD_STUDENT=./inp_data DD_REPORT1=./report.txt \\ -\$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_notrace 'an embedded newline' "run_reportwriter.at:3024" -( $at_check_trace; DD_STUDENT=./inp_data DD_REPORT1=./report.txt \ -$COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_reportwriter.at:3024" -$at_failed && at_fn_log_failure -$at_traceon; } - - - - - -cat >reference <<'_ATEOF' - 1 2 3 4 5 6 7 -1234567890123456789012345678901234567890123456789012345678901234567890 -Ln --ID-- --------Name-------- Major *-* +Odd+ +Even+ - - 5 99 Dorken, Keith CS :-: 8 8 : - 6 7 Allinson, Sandy MA :-: 118 118 : - 7 125 Allinson, Nina MA :-: 12308 12308 : - 8 126 Allinson, Natalia MA :-: 8 8 : - 9 127 Allinson, Kristina MBA :-: 8 8 : -10 131 Norman, Nancy SC :-: 6 6 : -11 132 Norman, Becky SC :-: 116 116 : -12 133 Norman, Michelle SC :-: 12306 112306 : -13 134 Norman, James AM :-: 6 6 : -14 12345 Norman, Ron CS :-: 8 8 : - - - - - - - - - - - - - - - - -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_reportwriter.at:3063: diff reference report.txt" -at_fn_check_prepare_trace "run_reportwriter.at:3063" -( $at_check_trace; diff reference report.txt -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_reportwriter.at:3063" -$at_failed && at_fn_log_failure \ -"./report.txt" -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_807 -#AT_START_808 -at_fn_group_banner 808 'run_reportwriter.at:3068' \ - "STUDENT REPORT with INITIAL" " " 4 -at_xfail=no -( - $as_echo "808. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >inp_data <<'_ATEOF' -00123Dorken, Keith CS 08 -00124Allinson, Sandy MA 08 -00125Allinson, Nina MA 08 -00126Allinson, Natalia MA 08 -00127Allinson, Kristina MBA08 -00131Norman, Nancy SC 06 -00132Norman, Becky SC 06 -00133Norman, Michelle SC 06 -00134Norman, James AM 06 -12345Norman, Ron CS 08 -_ATEOF - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog INITIAL. - ENVIRONMENT DIVISION. - CONFIGURATION SECTION. - INPUT-OUTPUT SECTION. - FILE-CONTROL. - SELECT INPUT-FILE ASSIGN TO EXTERNAL STUDENT - ORGANIZATION IS LINE SEQUENTIAL. - SELECT PRINT-FILE ASSIGN TO EXTERNAL - LINE ADVANCING REPORT1. - - DATA DIVISION. - FILE SECTION. - FD INPUT-FILE. - 01 INPUT-REC. - 05 STUDENT-ID PIC 9(5). - 05 STUDENT-NAME PIC X(20). - 05 MAJOR PIC XXX. - 05 NUM-COURSES PIC 99. - - FD PRINT-FILE - REPORT IS STUDENT-REPORT STUDENT-REPORT2. - - WORKING-STORAGE SECTION. - 01 ARE-THERE-MORE-RECORDS PIC XXX VALUE "YES". - - REPORT SECTION. - RD STUDENT-REPORT - PAGE LIMIT 30 LINES - HEADING 2 - FIRST DETAIL 3 - LAST DETAIL 25 - FOOTING 28. - 01 REPORT-LINE - TYPE DETAIL - LINE PLUS 1. - 05 COLUMN 1 PIC 9(2) - SOURCE LINE-COUNTER OF STUDENT-REPORT. - 05 COLUMN 4 PIC 9(6) SOURCE STUDENT-ID. - 05 COLUMN 15 PIC X(20) SOURCE STUDENT-NAME. - 05 COLUMN 40 PIC XXX SOURCE MAJOR. - 05 COLUMN 45 PIC XXX VALUE "-*-". - 05 COLUMN 52 PIC 99 SOURCE NUM-COURSES. - - RD STUDENT-REPORT2 - PAGE LIMIT 60 LINES - HEADING 2 - FIRST DETAIL 5 - LAST DETAIL 55 - FOOTING 58. - 01 REPORT-LINE2 - TYPE DETAIL - LINE PLUS 1. - 05 COLUMN 4 PIC 9(6) SOURCE STUDENT-ID. - 05 COLUMN 15 PIC X(20) SOURCE STUDENT-NAME. - 05 COLUMN 40 PIC XXX SOURCE MAJOR. - 05 COLUMN 45 PIC 99 SOURCE NUM-COURSES. - 01 REPORT-LINE3 - TYPE DETAIL - LINE PLUS 2. - 05 COLUMN 4 PIC 9(6) SOURCE STUDENT-ID. - 05 COLUMN 15 PIC X(20) SOURCE STUDENT-NAME. - 05 COLUMN 40 PIC XXX SOURCE MAJOR. - - PROCEDURE DIVISION. - A000-MAINLINE. - OPEN INPUT INPUT-FILE - OUTPUT PRINT-FILE - PERFORM DO-INIT. - READ INPUT-FILE - AT END - MOVE "NO" TO ARE-THERE-MORE-RECORDS. - PERFORM A001-LOOP - UNTIL ARE-THERE-MORE-RECORDS = "NO ". - PERFORM DO-TERM. - CLOSE INPUT-FILE - PRINT-FILE. - STOP RUN. - - A001-LOOP. - GENERATE REPORT-LINE. - READ INPUT-FILE - AT END - MOVE "NO " TO ARE-THERE-MORE-RECORDS. - DO-INIT. - INITIATE STUDENT-REPORT. - - DO-TERM. - TERMINATE STUDENT-REPORT. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_reportwriter.at:3176: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_reportwriter.at:3176" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_reportwriter.at:3176" -$at_failed && at_fn_log_failure -$at_traceon; } - - -{ set +x -$as_echo "$at_srcdir/run_reportwriter.at:3178: DD_STUDENT=\"./inp_data\" DD_REPORT1=\"./report.txt\" \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "DD_STUDENT=\"./inp_data\" DD_REPORT1=\"./report.txt\" $COBCRUN_DIRECT ./prog" "run_reportwriter.at:3178" -( $at_check_trace; DD_STUDENT="./inp_data" DD_REPORT1="./report.txt" $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_reportwriter.at:3178" -$at_failed && at_fn_log_failure -$at_traceon; } - - - - - -cat >reference <<'_ATEOF' - - -03 000123 Dorken, Keith CS -*- 08 -04 000124 Allinson, Sandy MA -*- 08 -05 000125 Allinson, Nina MA -*- 08 -06 000126 Allinson, Natalia MA -*- 08 -07 000127 Allinson, Kristina MBA -*- 08 -08 000131 Norman, Nancy SC -*- 06 -09 000132 Norman, Becky SC -*- 06 -10 000133 Norman, Michelle SC -*- 06 -11 000134 Norman, James AM -*- 06 -12 012345 Norman, Ron CS -*- 08 - - - - - - - - - - - - - - - - - - -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_reportwriter.at:3215: diff reference report.txt" -at_fn_check_prepare_trace "run_reportwriter.at:3215" -( $at_check_trace; diff reference report.txt -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_reportwriter.at:3215" -$at_failed && at_fn_log_failure \ -"./report.txt" -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_808 -#AT_START_809 -at_fn_group_banner 809 'run_reportwriter.at:3220' \ - "ORDER REPORT; Test substring" " " 4 -at_xfail=no -( - $as_echo "809. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >inp_data <<'_ATEOF' -10001090001012010590416 $ -10001090002013016950416 $ -10002090002023016950416 $ -10002090001022010590416 $ -10003090007023016950417 $ -10003090008032010590417 $ -10003090009023016950417 $ -10003090010032010590417 $ -10004090007023016950417 $ -10004090008032010590417 $ -10004090009023016950417 $ -10004090010032010590417 $ -10004090011032010590417 $ -10004090012032010590417 $ -10004090013032010590417 $ -10004090014032010590417 $ -10004090015032010590417 $ -10005090007023016950417 $ -10005090008032010590417 $ -10005090009023016950417 $ -10005090010032010590417 $ -10005090011032010590417 $ -10005090012032010590417 $ -10005090013032010590417 $ -10005090014032010590417 $ -10005090015032010590417 $ -10005090016032010590417 $ -10005090017032010590417 $ -10005090018032010590417 $ -10006090007023016950417 $ -10006090008032010590417 $ -10006090009023016950417 $ -10006090010032010590417 $ -10006090011032010590417 $ -10006090012032010590417 $ -10006090013032010590417 $ -10006090014032010590417 $ -10006090015032010590417 $ -10006090016032010590417 $ -10006090017032010590417 $ -10006090018032010590417 $ -10006090019032010590417 $ -10006090020032010590417 $ -10007090007023016950417 $ -10007090008032010590417 $ -10007090009023016950417 $ -10007090010032010590417 $ -10007090011032010590417 $ -10007090012032010590417 $ -10007090013032010590417 $ -10007090014032010590417 $ -10007090015032010590417 $ -10007090016032010590417 $ -10007090017032010590417 $ -10007090018032010590417 $ -10007090019032010590417 $ -10007090020032010590417 $ -10007090021032010590417 $ -10007090022032010590417 $ -10008090007023016950417 $ -10008090008032010590417 $ -10008090009023016950417 $ -10008090010032010590417 $ -10008090011032010590417 $ -10008090012032010590417 $ -10008090013032010590417 $ -10008090014032010590417 $ -10008090015032010590417 $ -10008090016032010590417 $ -10008090017032010590417 $ -10008090018032010590417 $ -10008090019032010590417 $ -10008090020032010590417 $ -10008090021032010590417 $ -10008090022032010590417 $ -10009090007023016950417 $ -10009090008032010590417 $ -10009090009023016950417 $ -10009090010032010590417 $ -10009090011032010590417 $ -10009090012032010590417 $ -10009090013032010590417 $ -10009090014032010590417 $ -10009090015032010590417 $ -10009090016032010590417 $ -10009090017032010590417 $ -10009090018032010590417 $ -10009090019032010590417 $ -10009090020032010590417 $ -10009090021032010590417 $ -10009090022032010590417 $ -_ATEOF - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - CONFIGURATION SECTION. - INPUT-OUTPUT SECTION. - FILE-CONTROL. - SELECT CUST-ORDER-FILE ASSIGN TO EXTERNAL CUSTORD - ORGANIZATION IS LINE SEQUENTIAL. - SELECT CUST-PRINT-FILE ASSIGN TO EXTERNAL - LINE ADVANCING REPORT2. - - DATA DIVISION. - FILE SECTION. - FD CUST-ORDER-FILE. - 01 CUST-ORDER-REC. - 05 CUST-NUM PIC 9(5). - 05 ITEM-NUM PIC 9(6). - 05 NUM-ORD PIC 999. - 05 PRICE PIC 999V99. - 05 SHIPPING PIC 99V99. - 05 FILLER PIC X(7). - - FD CUST-PRINT-FILE - REPORT IS ORDER-REPORT. - - WORKING-STORAGE SECTION. - 01 INDICATORS. - 05 ARE-THERE-MORE-RECORDS PIC XXX VALUE 'YES'. - 88 THERE-ARE-NO-MORE-RECORDS VALUE 'NO '. - 01 CONSTANTS. - 05 SALES-TAX PIC 9V99 VALUE 0.05. - 01 WORK-AREAS. - 05 AMT-TAX PIC 9999V99 VALUE 0. - 05 AMT-ORDER PIC 9(5)V99 VALUE 0. - 05 TOT-ORDER PIC 9(6)V99 VALUE 0. - 05 CURRENT-TIME PIC 9(8) VALUE 14301275. - - REPORT SECTION. - RD ORDER-REPORT - CONTROLS ARE FINAL - PAGE 55 LINES - FIRST DETAIL 6. - 01 TYPE REPORT HEADING - LINE 1. - 10 COLUMN 44 PIC X(21) - VALUE 'CUSTOMER ORDER REPORT'. - 01 TYPE PAGE HEADING. - 05 LINE 2. - 10 COLUMN 10 PIC X(8) VALUE " Time:". - 10 COLUMN 20 PIC 99 SOURCE CURRENT-TIME (1:2). - 10 COLUMN 22 PIC X VALUE ':'. - 10 COLUMN 23 PIC 99 SOURCE CURRENT-TIME (3:2). - 10 COLUMN 25 PIC X VALUE ':'. - 10 COLUMN 26 PIC 99 SOURCE CURRENT-TIME (5:2). - 10 COLUMN 94 PIC X(5) VALUE 'Page'. - 10 COLUMN 106 PIC ZZ9 - SOURCE PAGE-COUNTER. - 05 LINE 4. - 10 COLUMN 11 PIC X(8) VALUE 'CUST NUM'. - 10 COLUMN 26 PIC XXXX VALUE 'PART'. - 10 COLUMN 39 PIC X(7) VALUE '# ITEMS'. - 10 COLUMN 50 PIC X(5) VALUE 'PRICE'. - 10 COLUMN 66 PIC X(8) VALUE 'QUANTITY'. - 10 COLUMN 82 PIC XXX VALUE 'TAX'. - 10 COLUMN 91 PIC X(8) VALUE 'SHIPPING'. - 10 COLUMN 108 PIC X(5) VALUE 'TOTAL'. - - 01 DETAIL-LINE TYPE IS DETAIL - LINE PLUS 1. - 05 COLUMN 12 PIC 9(5) - SOURCE CUST-NUM. - 05 COLUMN 25 PIC 9(6) - SOURCE ITEM-NUM. - 05 COLUMN 41 PIC 999 - SOURCE NUM-ORD. - 05 COLUMN 49 PIC ZZZ.99 - SOURCE PRICE. - 05 COLUMN 64 PIC ZZ,ZZZ.99 - SOURCE AMT-ORDER. - 05 COLUMN 80 PIC Z,ZZZ.99 - SOURCE AMT-TAX. - 05 COLUMN 93 PIC ZZ.99 - SOURCE SHIPPING. - 05 COLUMN 104 PIC ZZZ,ZZZ.99 - SOURCE TOT-ORDER. - - - 01 TYPE CONTROL FOOTING FINAL - LINE PLUS 2. - 05 COLUMN 42 PIC X(12) - VALUE 'FINAL TOTALS'. - 05 COLUMN 63 PIC ZZZ,ZZZ.99 - SOURCE AMT-ORDER. - 05 COLUMN 79 PIC ZZ,ZZZ.99 - SUM AMT-TAX. - 05 COLUMN 92 PIC ZZZ.99 - SUM SHIPPING. - 05 COLUMN 102 PIC Z,ZZZ,ZZZ.99 - SUM TOT-ORDER. - - PROCEDURE DIVISION. - A000-MAINLINE. - * Use hard coded time value so test is repeatable - * ACCEPT CURRENT-TIME FROM TIME. - OPEN INPUT CUST-ORDER-FILE - OUTPUT CUST-PRINT-FILE. - INITIATE ORDER-REPORT. - READ CUST-ORDER-FILE - AT END - MOVE 'NO' TO ARE-THERE-MORE-RECORDS. - PERFORM A001-LOOP - UNTIL THERE-ARE-NO-MORE-RECORDS. - TERMINATE ORDER-REPORT. - CLOSE CUST-ORDER-FILE - CUST-PRINT-FILE. - STOP RUN. - A001-LOOP. - MULTIPLY NUM-ORD BY PRICE GIVING AMT-ORDER. - MULTIPLY AMT-ORDER BY SALES-TAX GIVING AMT-TAX. - ADD AMT-ORDER SHIPPING AMT-TAX GIVING TOT-ORDER. - GENERATE DETAIL-LINE. - READ CUST-ORDER-FILE - AT END - MOVE 'NO' TO ARE-THERE-MORE-RECORDS. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_reportwriter.at:3444: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_reportwriter.at:3444" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_reportwriter.at:3444" -$at_failed && at_fn_log_failure -$at_traceon; } - - -{ set +x -$as_echo "$at_srcdir/run_reportwriter.at:3446: DD_CUSTORD=\"./inp_data\" DD_REPORT2=\"./report.txt\" \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "DD_CUSTORD=\"./inp_data\" DD_REPORT2=\"./report.txt\" $COBCRUN_DIRECT ./prog" "run_reportwriter.at:3446" -( $at_check_trace; DD_CUSTORD="./inp_data" DD_REPORT2="./report.txt" $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_reportwriter.at:3446" -$at_failed && at_fn_log_failure -$at_traceon; } - - - - - -cat >reference <<'_ATEOF' - CUSTOMER ORDER REPORT - Time: 14:30:12 Page 1 - - CUST NUM PART # ITEMS PRICE QUANTITY TAX SHIPPING TOTAL - - 10001 090001 012 10.59 127.08 6.35 4.16 137.59 - 10001 090002 013 16.95 220.35 11.01 4.16 235.52 - 10002 090002 023 16.95 389.85 19.49 4.16 413.50 - 10002 090001 022 10.59 232.98 11.64 4.16 248.78 - 10003 090007 023 16.95 389.85 19.49 4.17 413.51 - 10003 090008 032 10.59 338.88 16.94 4.17 359.99 - 10003 090009 023 16.95 389.85 19.49 4.17 413.51 - 10003 090010 032 10.59 338.88 16.94 4.17 359.99 - 10004 090007 023 16.95 389.85 19.49 4.17 413.51 - 10004 090008 032 10.59 338.88 16.94 4.17 359.99 - 10004 090009 023 16.95 389.85 19.49 4.17 413.51 - 10004 090010 032 10.59 338.88 16.94 4.17 359.99 - 10004 090011 032 10.59 338.88 16.94 4.17 359.99 - 10004 090012 032 10.59 338.88 16.94 4.17 359.99 - 10004 090013 032 10.59 338.88 16.94 4.17 359.99 - 10004 090014 032 10.59 338.88 16.94 4.17 359.99 - 10004 090015 032 10.59 338.88 16.94 4.17 359.99 - 10005 090007 023 16.95 389.85 19.49 4.17 413.51 - 10005 090008 032 10.59 338.88 16.94 4.17 359.99 - 10005 090009 023 16.95 389.85 19.49 4.17 413.51 - 10005 090010 032 10.59 338.88 16.94 4.17 359.99 - 10005 090011 032 10.59 338.88 16.94 4.17 359.99 - 10005 090012 032 10.59 338.88 16.94 4.17 359.99 - 10005 090013 032 10.59 338.88 16.94 4.17 359.99 - 10005 090014 032 10.59 338.88 16.94 4.17 359.99 - 10005 090015 032 10.59 338.88 16.94 4.17 359.99 - 10005 090016 032 10.59 338.88 16.94 4.17 359.99 - 10005 090017 032 10.59 338.88 16.94 4.17 359.99 - 10005 090018 032 10.59 338.88 16.94 4.17 359.99 - 10006 090007 023 16.95 389.85 19.49 4.17 413.51 - 10006 090008 032 10.59 338.88 16.94 4.17 359.99 - 10006 090009 023 16.95 389.85 19.49 4.17 413.51 - 10006 090010 032 10.59 338.88 16.94 4.17 359.99 - 10006 090011 032 10.59 338.88 16.94 4.17 359.99 - 10006 090012 032 10.59 338.88 16.94 4.17 359.99 - 10006 090013 032 10.59 338.88 16.94 4.17 359.99 - 10006 090014 032 10.59 338.88 16.94 4.17 359.99 - 10006 090015 032 10.59 338.88 16.94 4.17 359.99 - 10006 090016 032 10.59 338.88 16.94 4.17 359.99 - 10006 090017 032 10.59 338.88 16.94 4.17 359.99 - 10006 090018 032 10.59 338.88 16.94 4.17 359.99 - 10006 090019 032 10.59 338.88 16.94 4.17 359.99 - 10006 090020 032 10.59 338.88 16.94 4.17 359.99 - 10007 090007 023 16.95 389.85 19.49 4.17 413.51 - 10007 090008 032 10.59 338.88 16.94 4.17 359.99 - 10007 090009 023 16.95 389.85 19.49 4.17 413.51 - 10007 090010 032 10.59 338.88 16.94 4.17 359.99 - 10007 090011 032 10.59 338.88 16.94 4.17 359.99 - 10007 090012 032 10.59 338.88 16.94 4.17 359.99 - 10007 090013 032 10.59 338.88 16.94 4.17 359.99 - - Time: 14:30:12 Page 2 - - CUST NUM PART # ITEMS PRICE QUANTITY TAX SHIPPING TOTAL - - 10007 090014 032 10.59 338.88 16.94 4.17 359.99 - 10007 090015 032 10.59 338.88 16.94 4.17 359.99 - 10007 090016 032 10.59 338.88 16.94 4.17 359.99 - 10007 090017 032 10.59 338.88 16.94 4.17 359.99 - 10007 090018 032 10.59 338.88 16.94 4.17 359.99 - 10007 090019 032 10.59 338.88 16.94 4.17 359.99 - 10007 090020 032 10.59 338.88 16.94 4.17 359.99 - 10007 090021 032 10.59 338.88 16.94 4.17 359.99 - 10007 090022 032 10.59 338.88 16.94 4.17 359.99 - 10008 090007 023 16.95 389.85 19.49 4.17 413.51 - 10008 090008 032 10.59 338.88 16.94 4.17 359.99 - 10008 090009 023 16.95 389.85 19.49 4.17 413.51 - 10008 090010 032 10.59 338.88 16.94 4.17 359.99 - 10008 090011 032 10.59 338.88 16.94 4.17 359.99 - 10008 090012 032 10.59 338.88 16.94 4.17 359.99 - 10008 090013 032 10.59 338.88 16.94 4.17 359.99 - 10008 090014 032 10.59 338.88 16.94 4.17 359.99 - 10008 090015 032 10.59 338.88 16.94 4.17 359.99 - 10008 090016 032 10.59 338.88 16.94 4.17 359.99 - 10008 090017 032 10.59 338.88 16.94 4.17 359.99 - 10008 090018 032 10.59 338.88 16.94 4.17 359.99 - 10008 090019 032 10.59 338.88 16.94 4.17 359.99 - 10008 090020 032 10.59 338.88 16.94 4.17 359.99 - 10008 090021 032 10.59 338.88 16.94 4.17 359.99 - 10008 090022 032 10.59 338.88 16.94 4.17 359.99 - 10009 090007 023 16.95 389.85 19.49 4.17 413.51 - 10009 090008 032 10.59 338.88 16.94 4.17 359.99 - 10009 090009 023 16.95 389.85 19.49 4.17 413.51 - 10009 090010 032 10.59 338.88 16.94 4.17 359.99 - 10009 090011 032 10.59 338.88 16.94 4.17 359.99 - 10009 090012 032 10.59 338.88 16.94 4.17 359.99 - 10009 090013 032 10.59 338.88 16.94 4.17 359.99 - 10009 090014 032 10.59 338.88 16.94 4.17 359.99 - 10009 090015 032 10.59 338.88 16.94 4.17 359.99 - 10009 090016 032 10.59 338.88 16.94 4.17 359.99 - 10009 090017 032 10.59 338.88 16.94 4.17 359.99 - 10009 090018 032 10.59 338.88 16.94 4.17 359.99 - 10009 090019 032 10.59 338.88 16.94 4.17 359.99 - 10009 090020 032 10.59 338.88 16.94 4.17 359.99 - 10009 090021 032 10.59 338.88 16.94 4.17 359.99 - 10009 090022 032 10.59 338.88 16.94 4.17 359.99 - - FINAL TOTALS 338.88 1,557.97 379.43 33,103.80 - - - - - - - -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_reportwriter.at:3563: diff reference report.txt" -at_fn_check_prepare_trace "run_reportwriter.at:3563" -( $at_check_trace; diff reference report.txt -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_reportwriter.at:3563" -$at_failed && at_fn_log_failure \ -"./report.txt" -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_809 -#AT_START_810 -at_fn_group_banner 810 'run_reportwriter.at:3568' \ - "Sample Control Break" " " 4 -at_xfail=no -( - $as_echo "810. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >inp_data <<'_ATEOF' -Norman, Ronald J 25CS Malcolm, Mike Waterloo -Dorken, Keith A 35CS Malcolm, Mike Waterloo -Norman, James J 25CS Manning, Eric Waterloo -Dorken, Kevin 35CS Manning, Eric Waterloo -Allinson, A R 25EC Manning, Eric Whistler -Norman, Michelle 27EC Manning, Donna Toronto -Dorken, Melissa 37EC Manning, Donna Toronto -Norseman, Ben01 27EC DiMetri, Gary Toronto -Norseman, Ben02 27EC DiMetri, Gary Toronto -Norseman, Ben03 27EC DiMetri, Gary Toronto -Norseman, Ben04 27EC DiMetri, Gary Toronto -Norseman, Ben05 27EC DiMetri, Gary Toronto -Norseman, Ben06 27EC DiMetri, Gary Toronto -Norseman, Ben07 27EC DiMetri, Gary Toronto -Norseman, Ben08 27EC DiMetri, Gary Toronto -Norseman, Ben09 27EC DiMetri, Gary Toronto -Norseman, Ben10 27EC DiMetri, Gary Toronto -_ATEOF - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - CONFIGURATION SECTION. - INPUT-OUTPUT SECTION. - FILE-CONTROL. - SELECT STUDENT-FILE ASSIGN TO EXTERNAL STUDREC - ORGANIZATION IS LINE SEQUENTIAL. - SELECT PRINT-FILE ASSIGN TO EXTERNAL - LINE ADVANCING REPORT3. - - DATA DIVISION. - FILE SECTION. - FD STUDENT-FILE. - 01 STUDENT-REC PIC X(60). - - FD PRINT-FILE - REPORT IS CONTROL-BREAK. - - WORKING-STORAGE SECTION. - 01 INDICATORS. - 05 ARE-THERE-MORE-RECORDS PIC XXX VALUE 'YES'. - 88 THERE-ARE-NO-MORE-RECORDS VALUE 'NO'. - - 01 CONSTANTS. - 05 NUM PIC 99 VALUE 1. - - 01 STUDENT-AREA. - 05 STUDENT-NAME PIC X(20). - 05 COURSE-PTS PIC 99. - 05 MAJOR PIC XXX. - 05 ADVISOR PIC X(20). - 05 CAMPUS PIC X(15). - - REPORT SECTION. - RD CONTROL-BREAK - CONTROLS ARE MAJOR ADVISOR - PAGE LIMIT 25 LINES - HEADING 1 - FIRST DETAIL 5 - FOOTING 23. - 01 TYPE IS PAGE HEADING. - 05 LINE 1. - 10 COLUMN 61 PIC X(4) VALUE 'PAGE'. - 10 COLUMN 66 PIC ZZZ9 SOURCE PAGE-COUNTER. - 05 LINE PLUS 2. - 10 COLUMN 26 PIC X(23) - VALUE 'STUDENT ADVISEMENT LIST'. - - 01 TYPE IS CONTROL HEADING MAJOR. - 05 LINE 5 ON NEXT PAGE . - 10 COLUMN 37 PIC X(5) VALUE 'MAJOR'. - 10 COLUMN 44 PIC X(20) SOURCE MAJOR. - - 05 LINE 7. - 10 COLUMN 4 PIC X(12) VALUE 'STUDENT NAME'. - 10 COLUMN 25 PIC XXX VALUE 'PTS'. - 10 COLUMN 34 PIC X(6) VALUE 'CAMPUS'. - 10 COLUMN 60 PIC X(8) VALUE 'ADVISOR'. - 05 LINE PLUS 1. - 10 COLUMN 4 PIC X(68) VALUE ALL '-'. - - 01 TRANS-LINE TYPE IS DETAIL. - 05 LINE NUMBER PLUS 1. - 10 COLUMN 3 PIC X(20) SOURCE STUDENT-NAME. - 10 COLUMN 26 PIC 99 SOURCE COURSE-PTS. - 10 COLUMN 34 PIC X(15) SOURCE CAMPUS. - 10 COLUMN 51 PIC X(5) VALUE "Hello" - PRESENT AFTER PAGE OR ADVISOR. - 10 COLUMN 51 PIC X(5) VALUE ' " ' - ABSENT AFTER PAGE OR ADVISOR. - 10 COLUMN 60 PIC X(20) SOURCE ADVISOR - GROUP INDICATE. - - 01 TYPE IS CONTROL FOOTING ADVISOR. - 05 LINE PLUS 2. - 10 COLUMN 5 PIC X(8) VALUE 'ADVISOR'. - 10 COLUMN 13 PIC X(20) SOURCE ADVISOR. - 10 COLUMN 34 PIC X(6) VALUE 'TOTAL'. - 10 ADV-TOTAL - COLUMN 40 PIC ZZ9 SUM NUM. - 05 LINE PLUS 1. - 10 COLUMN 1 PIC X(8) VALUE ' '. - - 01 TYPE IS CONTROL FOOTING MAJOR. - 05 LINE PLUS 2. - 10 COLUMN 5 PIC X(11) VALUE 'MAJOR TOTAL'. - 10 MAJ-TOTAL - COLUMN 22 PIC ZZ9 SUM ADV-TOTAL. - - 01 TYPE IS CONTROL FOOTING FINAL. - 05 LINE PLUS 3. - 10 COLUMN 10 PIC X(11) VALUE 'FINAL TOTAL'. - 10 STU-TOTAL - COLUMN 21 PIC ZZZ9 SUM MAJ-TOTAL. - - PROCEDURE DIVISION. - A000-CREATE-REPORTS. - OPEN INPUT STUDENT-FILE - OUTPUT PRINT-FILE. - INITIATE CONTROL-BREAK. - READ STUDENT-FILE INTO STUDENT-AREA - AT END - MOVE 'NO ' TO ARE-THERE-MORE-RECORDS. - PERFORM A001-LOOP - UNTIL THERE-ARE-NO-MORE-RECORDS. - TERMINATE CONTROL-BREAK. - CLOSE STUDENT-FILE - PRINT-FILE. - STOP RUN. - - A001-LOOP. - GENERATE TRANS-LINE. - READ STUDENT-FILE INTO STUDENT-AREA - AT END - MOVE 'NO ' TO ARE-THERE-MORE-RECORDS. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_reportwriter.at:3709: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_reportwriter.at:3709" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_reportwriter.at:3709" -$at_failed && at_fn_log_failure -$at_traceon; } - - -{ set +x -$as_echo "$at_srcdir/run_reportwriter.at:3711: DD_STUDREC=\"./inp_data\" DD_REPORT3=\"./report.txt\" \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "DD_STUDREC=\"./inp_data\" DD_REPORT3=\"./report.txt\" $COBCRUN_DIRECT ./prog" "run_reportwriter.at:3711" -( $at_check_trace; DD_STUDREC="./inp_data" DD_REPORT3="./report.txt" $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_reportwriter.at:3711" -$at_failed && at_fn_log_failure -$at_traceon; } - - - - - -cat >reference <<'_ATEOF' - PAGE 1 - - STUDENT ADVISEMENT LIST - - MAJOR CS - - STUDENT NAME PTS CAMPUS ADVISOR - -------------------------------------------------------------------- - Norman, Ronald J 25 Waterloo Hello Malcolm, Mike - Dorken, Keith A 35 Waterloo " - - ADVISOR Malcolm, Mike TOTAL 2 - - Norman, James J 25 Waterloo Hello Manning, Eric - Dorken, Kevin 35 Waterloo " - - ADVISOR Manning, Eric TOTAL 2 - - - MAJOR TOTAL 4 - - - - - - PAGE 2 - - STUDENT ADVISEMENT LIST - - MAJOR EC - - STUDENT NAME PTS CAMPUS ADVISOR - -------------------------------------------------------------------- - Allinson, A R 25 Whistler Hello Manning, Eric - - ADVISOR Manning, Eric TOTAL 1 - - Norman, Michelle 27 Toronto Hello Manning, Donna - Dorken, Melissa 37 Toronto " - - ADVISOR Manning, Donna TOTAL 2 - - Norseman, Ben01 27 Toronto Hello DiMetri, Gary - Norseman, Ben02 27 Toronto " - Norseman, Ben03 27 Toronto " - Norseman, Ben04 27 Toronto " - Norseman, Ben05 27 Toronto " - Norseman, Ben06 27 Toronto " - - PAGE 3 - - STUDENT ADVISEMENT LIST - - Norseman, Ben07 27 Toronto Hello DiMetri, Gary - Norseman, Ben08 27 Toronto " - Norseman, Ben09 27 Toronto " - Norseman, Ben10 27 Toronto " - - ADVISOR DiMetri, Gary TOTAL 10 - - - MAJOR TOTAL 13 - - - FINAL TOTAL 17 - - - - - - - - - -_ATEOF - -#" <- fix code highlighting -{ set +x -$as_echo "$at_srcdir/run_reportwriter.at:3792: diff reference report.txt" -at_fn_check_prepare_trace "run_reportwriter.at:3792" -( $at_check_trace; diff reference report.txt -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_reportwriter.at:3792" -$at_failed && at_fn_log_failure \ -"./report.txt" -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_810 -#AT_START_811 -at_fn_group_banner 811 'run_reportwriter.at:3796' \ - "Sample Inventory Report" " " 4 -at_xfail=no -( - $as_echo "811. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >inp_data <<'_ATEOF' -01Data Processing 02000500012388 -02Cow Milking 02000600054398 -03Grass Cutting 03000600054397 -03Lawn mowing 03000600054397 -_ATEOF - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - CONFIGURATION SECTION. - INPUT-OUTPUT SECTION. - FILE-CONTROL. - SELECT INV-FILE ASSIGN TO EXTERNAL INVFILE - ORGANIZATION IS LINE SEQUENTIAL. - SELECT REPORT-FILE ASSIGN TO EXTERNAL - LINE ADVANCING REPORT4. - - DATA DIVISION. - FILE SECTION. - FD INV-FILE. - 01 INV-REC. - 05 DEPT-IN PIC 99. - 05 DEPT-NAM-IN PIC X(18). - 05 MONTH-IN PIC 99. - 05 ITEM-NO-IN PIC 9(5). - 05 INV-TOT-IN PIC 9(6)V99. - - FD REPORT-FILE - REPORT IS INV-REPORT. - - WORKING-STORAGE SECTION. - 01 INDICATORS. - 05 ARE-THERE-MORE-RECORDS PIC XXX VALUE 'YES'. - - REPORT SECTION. - RD INV-REPORT - CONTROLS ARE FINAL DEPT-IN MONTH-IN - PAGE LIMIT 25 LINES - HEADING 2 - FIRST DETAIL 5 - LAST DETAIL 18 - FOOTING 20. - 01 TYPE IS REPORT HEADING. - 05 LINE 2 COLUMN 50 PIC X(16) VALUE 'INVENTORY REPORT'. - 05 LINE 2 COLUMN 80 PIC X VALUE ' '. - - 01 TYPE IS CONTROL HEADING DEPT-IN - LINE NUMBER IS PLUS 2 - NEXT GROUP IS PLUS 2. - 05 COLUMN 2 PIC X(13) VALUE 'DEPARTMENT #:'. - 05 COLUMN 27 PIC 99 SOURCE DEPT-IN. - 05 COLUMN 31 PIC X(16) VALUE 'DEPARTMENT NAME:'. - 05 COLUMN 50 PIC X(18) SOURCE DEPT-NAM-IN. - - 01 INV-DETAIL TYPE IS DETAIL - LINE PLUS 2. - 05 COLUMN 10 PIC 99 SOURCE MONTH-IN GROUP INDICATE. - 05 COLUMN 25 PIC 9(5) SOURCE ITEM-NO-IN. - 05 COLUMN 40 PIC ZZZ,ZZZ.99 SOURCE IS INV-TOT-IN. - - 01 TYPE IS CONTROL FOOTING MONTH-IN - LINE PLUS 2. - 05 MONTH-TOTAL COLUMN 55 PIC Z,ZZZ,ZZZ.99 SUM INV-TOT-IN. - - 01 TYPE IS CONTROL FOOTING DEPT-IN - LINE PLUS 2. - 05 DEPT-TOTAL COLUMN 75 PIC ZZ,ZZZ,ZZZ.99 SUM MONTH-TOTAL. - - 01 TYPE IS CONTROL FOOTING FINAL - LINE PLUS 2. - 05 FINAL-TOTAL COLUMN 95 PIC ZZZ,ZZZ,ZZZ.99 SUM DEPT-TOTAL. - - 01 TYPE IS PAGE FOOTING LINE 24. - 05 COLUMN 30 PIC X(30) VALUE "-+* End of Page *+-". - 05 COLUMN 55 PIC X(12) VALUE "************". - 05 COLUMN 75 PIC X(13) VALUE "*************". - 05 COLUMN 95 PIC X(14) VALUE "**************". - - PROCEDURE DIVISION. - A000-MAINLINE. - OPEN INPUT INV-FILE - OUTPUT REPORT-FILE. - INITIATE INV-REPORT. - READ INV-FILE - AT END - MOVE 'NO ' TO ARE-THERE-MORE-RECORDS. - PERFORM A001-LOOP - UNTIL ARE-THERE-MORE-RECORDS = 'NO '. - TERMINATE INV-REPORT. - CLOSE INV-FILE - REPORT-FILE. - STOP RUN. - A001-LOOP. - GENERATE INV-DETAIL. - READ INV-FILE - AT END - MOVE 'NO ' TO ARE-THERE-MORE-RECORDS. - -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_reportwriter.at:3900: \$COMPILE -std=cobol2002 -fassign-ext-dyn=ok prog.cob " -at_fn_check_prepare_dynamic "$COMPILE -std=cobol2002 -fassign-ext-dyn=ok prog.cob " "run_reportwriter.at:3900" -( $at_check_trace; $COMPILE -std=cobol2002 -fassign-ext-dyn=ok prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob:40: warning: duplicate LINE 2 ignored -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_reportwriter.at:3900" -$at_failed && at_fn_log_failure -$at_traceon; } - - -{ set +x -$as_echo "$at_srcdir/run_reportwriter.at:3904: DD_INVFILE=\"./inp_data\" DD_REPORT4=\"./report.txt\" \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "DD_INVFILE=\"./inp_data\" DD_REPORT4=\"./report.txt\" $COBCRUN_DIRECT ./prog" "run_reportwriter.at:3904" -( $at_check_trace; DD_INVFILE="./inp_data" DD_REPORT4="./report.txt" $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_reportwriter.at:3904" -$at_failed && at_fn_log_failure -$at_traceon; } - - - - - -cat >reference <<'_ATEOF' - - INVENTORY REPORT - - - DEPARTMENT #: 01 DEPARTMENT NAME: Data Processing - - - - 02 00050 1,238.80 - - 1,238.80 - - 1,238.80 - - DEPARTMENT #: 02 DEPARTMENT NAME: Cow Milking - - - - - - - - - -+* End of Page *+- ************ ************* ************** - - - - - 02 00060 5,439.80 - - 5,439.80 - - 5,439.80 - - DEPARTMENT #: 03 DEPARTMENT NAME: Grass Cutting - - - - 03 00060 5,439.70 - - 00060 5,439.70 - - 10,879.40 - - - - - - -+* End of Page *+- ************ ************* ************** - - - - - 10,879.40 - - 17,558.00 - - - - - - - - - - - - - - - - - -+* End of Page *+- ************ ************* ************** -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_reportwriter.at:3984: diff reference report.txt" -at_fn_check_prepare_trace "run_reportwriter.at:3984" -( $at_check_trace; diff reference report.txt -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_reportwriter.at:3984" -$at_failed && at_fn_log_failure \ -"./report.txt" -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_811 -#AT_START_812 -at_fn_group_banner 812 'run_reportwriter.at:3989' \ - "Duplicate Detail Line" " " 4 -at_xfail=no -( - $as_echo "812. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - CONFIGURATION SECTION. - INPUT-OUTPUT SECTION. - FILE-CONTROL. - SELECT REPORT-FILE - LINE SEQUENTIAL - ASSIGN TO EXTERNAL DUPDTL. - DATA DIVISION. - FILE SECTION. - FD REPORT-FILE - REPORT IS MYREPORT. - WORKING-STORAGE SECTION. - 01 SAVE-ITEM PIC X. - - REPORT SECTION. - RD MYREPORT - CONTROLS ARE SAVE-ITEM - PAGE LIMIT IS 15 LINES - FIRST DETAIL 1 - LAST DETAIL 12. - - 01 TYPE IS CONTROL HEADING SAVE-ITEM. - 05 LINE NUMBER IS 1. - 10 COLUMN 1 PIC X(20) VALUE "HEADING SAVE-ITEM". - - 01 DETAIL-LINE TYPE IS DETAIL. - 05 LINE NUMBER PLUS 1. - 10 COLUMN 1 PIC X SOURCE SAVE-ITEM. - 10 COLUMN 10 PIC X(15) VALUE "1st Detail". - - 01 SND-DETAIL-LINE TYPE IS DETAIL. - 05 LINE NUMBER PLUS 1. - 10 COLUMN 1 PIC X SOURCE SAVE-ITEM. - 10 COLUMN 10 PIC X(15) VALUE "2nd Detail". - - 01 TRD-DETAIL-LINE TYPE IS DETAIL. - 05 LINE NUMBER PLUS 1. - 10 COLUMN 1 PIC X SOURCE SAVE-ITEM. - 10 COLUMN 10 PIC X(15) VALUE "3rd Detail 1". - 05 LINE NUMBER PLUS 1. - 10 COLUMN 1 PIC X SOURCE SAVE-ITEM. - 10 COLUMN 10 PIC X(15) VALUE "3rd Detail 2". - - 01 TYPE IS CONTROL FOOTING SAVE-ITEM. - 03 LINE NUMBER IS PLUS 1. - 05 COLUMN 07 PIC X(27) VALUE "FOOTING SAVE-ITEM". - - PROCEDURE DIVISION. - OPEN OUTPUT REPORT-FILE. - INITIATE MYREPORT. - MOVE "A" TO SAVE-ITEM. - GENERATE DETAIL-LINE. - MOVE "B" TO SAVE-ITEM. - GENERATE DETAIL-LINE. - GENERATE SND-DETAIL-LINE. - GENERATE TRD-DETAIL-LINE. - MOVE "C" TO SAVE-ITEM. - GENERATE TRD-DETAIL-LINE. - TERMINATE MYREPORT. - CLOSE REPORT-FILE. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_reportwriter.at:4058: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_reportwriter.at:4058" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_reportwriter.at:4058" -$at_failed && at_fn_log_failure -$at_traceon; } - - -{ set +x -$as_echo "$at_srcdir/run_reportwriter.at:4060: DD_DUPDTL=./report.txt \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "DD_DUPDTL=./report.txt $COBCRUN_DIRECT ./prog" "run_reportwriter.at:4060" -( $at_check_trace; DD_DUPDTL=./report.txt $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_reportwriter.at:4060" -$at_failed && at_fn_log_failure -$at_traceon; } - - - - - -cat >reference <<'_ATEOF' -HEADING SAVE-ITEM -A 1st Detail - FOOTING SAVE-ITEM - - - - - - - - - - - - -HEADING SAVE-ITEM -B 1st Detail -B 2nd Detail -B 3rd Detail 1 -B 3rd Detail 2 - FOOTING SAVE-ITEM - - - - - - - - - -HEADING SAVE-ITEM -C 3rd Detail 1 -C 3rd Detail 2 - FOOTING SAVE-ITEM - - - - - - - - - - - -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_reportwriter.at:4112: diff reference report.txt" -at_fn_check_prepare_trace "run_reportwriter.at:4112" -( $at_check_trace; diff reference report.txt -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_reportwriter.at:4112" -$at_failed && at_fn_log_failure \ -"./report.txt" -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_812 -#AT_START_813 -at_fn_group_banner 813 'run_reportwriter.at:4117' \ - "Report with OCCURS" " " 4 -at_xfail=no -( - $as_echo "813. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - - ENVIRONMENT DIVISION. - INPUT-OUTPUT SECTION. - FILE-CONTROL. - SELECT rp-file ASSIGN EXTERNAL PRINTOUT - ORGANIZATION LINE SEQUENTIAL. - - DATA DIVISION. - FILE SECTION. - FD rp-file REPORT rp. - - REPORT SECTION. - RD RP - PAGE LIMIT 10 LINES - HEADING 1 - FIRST DETAIL 4. - 01 HEADING-LINE. - 02 TYPE PAGE HEADING LINE PLUS 1. - 05 COLUMN 1 PIC X(50) VALUE - " 1 2 3 4 5". - 02 TYPE PAGE HEADING LINE PLUS 1. - 05 COLUMN 1 PIC X(50) VALUE - "12345678901234567890123456789012345678901234567890". - - 01 RP-DTL1 TYPE DETAIL, LINE + 1. - 03 NUMS COLUMN 1 PIC 999 OCCURS 3 TIMES STEP 10. - 03 MARK COLUMN +3 PIC X(4). - - 01 rp-dtl2 TYPE DETAIL, LINE + 1. - 03 grps COLUMN 1 OCCURS 3 TIMES. - 05 tag1 PIC X(5). - 05 FILLER PIC X. - 05 tag2 PIC X(5). - 05 FILLER PIC XX. - - 01 RP-DTL3 TYPE DETAIL, LINE + 1. - 03 NNNS COLUMN 1, 11, 21, 27 PIC 999. - 03 TAGP COLUMN PLUS 4 PIC X(4). - - 01 RP-DTL4 TYPE DETAIL, LINE + 1. - 03 NUM4A PIC 999. - 03 NUM4B COLUMN PLUS 8 PIC 999 OCCURS 3 STEP 10. - 03 MRK4 COLUMN + 3 PIC X(4). - - PROCEDURE DIVISION. - OPEN OUTPUT rp-file - INITIATE rp - - MOVE 100 TO NUMS (1), NUMS (2), NUMS (3) - MOVE "<1>" TO MARK. - GENERATE rp-dtl1 - - MOVE ALL '*' TO grps(1), grps(2), grps(3) - MOVE "Tag1" to tag1 (1), tag1 (2), tag1 (3) - MOVE "Tag2" to tag2 (1), tag2 (2), tag2 (3) - GENERATE rp-dtl2 - - MOVE 200 TO NNNS (1), NNNS (2), NNNS (3) NNNS (4) - MOVE "<3>" TO TAGP. - GENERATE RP-DTL3. - - MOVE 400 TO NUM4A - MOVE 401 TO NUM4B (1) - MOVE 402 TO NUM4B (2) - MOVE 403 TO NUM4B (3) - MOVE "<4>" TO MRK4. - GENERATE RP-DTL4 - - TERMINATE rp - CLOSE rp-file - - STOP RUN. - END PROGRAM prog. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_reportwriter.at:4198: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_reportwriter.at:4198" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_reportwriter.at:4198" -$at_failed && at_fn_log_failure -$at_traceon; } - - -{ set +x -$as_echo "$at_srcdir/run_reportwriter.at:4200: DD_PRINTOUT=./report.txt \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "DD_PRINTOUT=./report.txt $COBCRUN_DIRECT ./prog" "run_reportwriter.at:4200" -( $at_check_trace; DD_PRINTOUT=./report.txt $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_reportwriter.at:4200" -$at_failed && at_fn_log_failure -$at_traceon; } - - - - - -cat >reference <<'_ATEOF' - 1 2 3 4 5 -12345678901234567890123456789012345678901234567890 - -100 100 100 <1> -Tag1 *Tag2 **Tag1 *Tag2 **Tag1 *Tag2 ** -200 200 200 200 <3> -400 401 402 403 <4> - - - -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_reportwriter.at:4217: diff reference report.txt" -at_fn_check_prepare_trace "run_reportwriter.at:4217" -( $at_check_trace; diff reference report.txt -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_reportwriter.at:4217" -$at_failed && at_fn_log_failure \ -"./report.txt" -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_813 -#AT_START_814 -at_fn_group_banner 814 'run_reportwriter.at:4222' \ - "Report CODE and LIMIT COLUMNS" " " 4 -at_xfail=no -( - $as_echo "814. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >progv.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. progv. - - ENVIRONMENT DIVISION. - INPUT-OUTPUT SECTION. - FILE-CONTROL. - SELECT RP-FILE ASSIGN EXTERNAL PRINTOUT - ORGANIZATION LINE SEQUENTIAL. - - DATA DIVISION. - FILE SECTION. - FD RP-FILE REPORT RP. - - WORKING-STORAGE SECTION. - 01 IDX1 PIC 99 VALUE 1. - 01 MAXCOL PIC 99 VALUE 50. - 01 MYCODE PIC X(6) VALUE "Hi-Q:". - 01 DIGX PIC X(50) VALUE - "123456789b123456789c123456789d123456789e123456789f". - 01 FILLER REDEFINES DIGX. - 05 DIGS PIC X(10) OCCURS 5 TIMES. - - REPORT SECTION. - RD RP - CODE IS MYCODE *> variable - PAGE LIMIT 10 LINES - MAXCOL COLUMNS *> variable - HEADING 1 - FIRST DETAIL 4. - 01 HEADING-LINE. - 02 TYPE PAGE HEADING LINE PLUS 1. - 05 COLUMN 1 PIC X(50) VALUE - " 1 2 3 4 5". - 02 TYPE PAGE HEADING LINE PLUS 1. - * 05 COLUMN 1 PIC X(50) VALUE - * "12345678901234567890123456789012345678901234567890". - 05 COLUMN 1 OCCURS 5 TIMES - VARYING IDX1 FROM 1 BY 1. - 10 FILLER PIC X(10) SOURCE DIGS (IDX1). - - 01 RP-DTL1 TYPE DETAIL, LINE + 1. - 03 NUMS COLUMN 1 PIC 999 OCCURS 3 TIMES STEP 10. - 03 MARK COLUMN + 3 PIC X(4). - - 01 RP-DTL2 TYPE DETAIL, LINE + 1. - 03 GRPS COLUMN 1 OCCURS 3 TIMES. - 05 TAG1 PIC X(5). - 05 FILLER PIC X. - 05 TAG2 PIC X(5). - 05 FILLER PIC XX. - - 01 RP-DTL3 TYPE DETAIL, LINE + 1. - 03 NNNS COLUMN 1, 11, 21, 27 PIC 999. - 03 TAGP COLUMN PLUS 4 PIC X(4). - - 01 RP-DTL4 TYPE DETAIL, LINE + 1. - 03 NUM4A PIC 999. - 03 NUM4B COLUMN 11 PIC 999 OCCURS 3 STEP 10. - 03 MRK4 COLUMN + 3 PIC X(4). - - PROCEDURE DIVISION. - OPEN OUTPUT RP-FILE - INITIATE RP - - MOVE 100 TO NUMS (1), NUMS (2), NUMS (3) - MOVE "<1>" TO MARK. - GENERATE rp-dtl1 - - MOVE ALL '*' TO GRPS(1), GRPS(2), GRPS(3) - MOVE "Tag1" TO TAG1 (1), TAG1 (2), TAG1 (3) - MOVE "Tag2" TO TAG2 (1), TAG2 (2), TAG2 (3) - GENERATE RP-DTL2 - - MOVE 200 TO NNNS (1), NNNS (2), NNNS (3) NNNS (4) - MOVE "<3>" TO TAGP. - GENERATE RP-DTL3. - - MOVE 400 TO NUM4A - MOVE 401 TO NUM4B (1) - MOVE 402 TO NUM4B (2) - MOVE 403 TO NUM4B (3) - MOVE "<4>" TO MRK4. - GENERATE RP-DTL4 - - TERMINATE rp - CLOSE RP-FILE - - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_reportwriter.at:4316: \$COMPILE -std=cobol2002 -fassign-ext-dyn=ok progv.cob" -at_fn_check_prepare_dynamic "$COMPILE -std=cobol2002 -fassign-ext-dyn=ok progv.cob" "run_reportwriter.at:4316" -( $at_check_trace; $COMPILE -std=cobol2002 -fassign-ext-dyn=ok progv.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "progv.cob:39: warning: RW VARYING clause is not implemented -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_reportwriter.at:4316" -$at_failed && at_fn_log_failure -$at_traceon; } - - -{ set +x -$as_echo "$at_srcdir/run_reportwriter.at:4320: DD_PRINTOUT=./report_var.txt \\ -\$COBCRUN_DIRECT ./progv" -at_fn_check_prepare_notrace 'an embedded newline' "run_reportwriter.at:4320" -( $at_check_trace; DD_PRINTOUT=./report_var.txt \ -$COBCRUN_DIRECT ./progv -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_reportwriter.at:4320" -$at_failed && at_fn_log_failure -$at_traceon; } - - -cat >progl.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. progl. - - ENVIRONMENT DIVISION. - INPUT-OUTPUT SECTION. - FILE-CONTROL. - SELECT RP-FILE ASSIGN EXTERNAL PRINTOUT - ORGANIZATION LINE SEQUENTIAL. - - DATA DIVISION. - FILE SECTION. - FD RP-FILE REPORT RP. - - WORKING-STORAGE SECTION. - 01 IDX1 PIC 99 VALUE 1. - 01 DIGX PIC X(50) VALUE - "123456789b123456789c123456789d123456789e123456789f". - 01 FILLER REDEFINES DIGX. - 05 DIGS PIC X(10) OCCURS 5 TIMES. - - REPORT SECTION. - RD RP - CODE IS "Hi-Q: " *> literal - PAGE LIMIT 10 LINES - 50 COLUMNS *> literal - HEADING 1 - FIRST DETAIL 4. - 01 HEADING-LINE. - 02 TYPE PAGE HEADING LINE PLUS 1. - 05 COLUMN 1 PIC X(50) VALUE - " 1 2 3 4 5". - 02 TYPE PAGE HEADING LINE PLUS 1. - * 05 COLUMN 1 PIC X(50) VALUE - * "12345678901234567890123456789012345678901234567890". - 05 COLUMN 1 OCCURS 5 TIMES - VARYING IDX1 FROM 1 BY 1. - 10 FILLER PIC X(10) SOURCE DIGS (IDX1). - - 01 RP-DTL1 TYPE DETAIL, LINE + 1. - 03 NUMS COLUMN 1 PIC 999 OCCURS 3 TIMES STEP 10. - 03 MARK COLUMN + 3 PIC X(4). - - 01 RP-DTL2 TYPE DETAIL, LINE + 1. - 03 GRPS COLUMN 1 OCCURS 3 TIMES. - 05 TAG1 PIC X(5). - 05 FILLER PIC X. - 05 TAG2 PIC X(5). - 05 FILLER PIC XX. - - 01 RP-DTL3 TYPE DETAIL, LINE + 1. - 03 NNNS COLUMN 1, 11, 21, 27 PIC 999. - 03 TAGP COLUMN PLUS 4 PIC X(4). - - 01 RP-DTL4 TYPE DETAIL, LINE + 1. - 03 NUM4A PIC 999. - 03 NUM4B COLUMN 11 PIC 999 OCCURS 3 STEP 10. - 03 MRK4 COLUMN + 3 PIC X(4). - - PROCEDURE DIVISION. - OPEN OUTPUT RP-FILE - INITIATE RP - - MOVE 100 TO NUMS (1), NUMS (2), NUMS (3) - MOVE "<1>" TO MARK. - GENERATE rp-dtl1 - - MOVE ALL '*' TO GRPS(1), GRPS(2), GRPS(3) - MOVE "Tag1" TO TAG1 (1), TAG1 (2), TAG1 (3) - MOVE "Tag2" TO TAG2 (1), TAG2 (2), TAG2 (3) - GENERATE RP-DTL2 - - MOVE 200 TO NNNS (1), NNNS (2), NNNS (3) NNNS (4) - MOVE "<3>" TO TAGP. - GENERATE RP-DTL3. - - MOVE 400 TO NUM4A - MOVE 401 TO NUM4B (1) - MOVE 402 TO NUM4B (2) - MOVE 403 TO NUM4B (3) - MOVE "<4>" TO MRK4. - GENERATE RP-DTL4 - - TERMINATE rp - CLOSE RP-FILE - - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_reportwriter.at:4412: \$COMPILE -std=cobol2002 -fdump=all -fassign-ext-dyn=ok progl.cob" -at_fn_check_prepare_dynamic "$COMPILE -std=cobol2002 -fdump=all -fassign-ext-dyn=ok progl.cob" "run_reportwriter.at:4412" -( $at_check_trace; $COMPILE -std=cobol2002 -fdump=all -fassign-ext-dyn=ok progl.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "progl.cob:37: warning: RW VARYING clause is not implemented -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_reportwriter.at:4412" -$at_failed && at_fn_log_failure -$at_traceon; } - - -{ set +x -$as_echo "$at_srcdir/run_reportwriter.at:4416: DD_PRINTOUT=./report_lit.txt \\ -\$COBCRUN_DIRECT ./progl" -at_fn_check_prepare_notrace 'an embedded newline' "run_reportwriter.at:4416" -( $at_check_trace; DD_PRINTOUT=./report_lit.txt \ -$COBCRUN_DIRECT ./progl -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_reportwriter.at:4416" -$at_failed && at_fn_log_failure -$at_traceon; } - - - - - - -cat >reference.at <<'_ATEOF' -Hi-Q: 1 2 3 4 5 -Hi-Q: 1 2 3 4 5 -Hi-Q: _ -Hi-Q: 100 100 100 <1> -Hi-Q: Tag1 *Tag2 **Tag1 *Tag2 **Tag1 *Tag2 ** -Hi-Q: 200 200 200 200 <3> -Hi-Q: 400 401 402 403 <4> -Hi-Q: _ -Hi-Q: _ -Hi-Q: _ -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_reportwriter.at:4436: cat reference.at | tr -d _ > reference" -at_fn_check_prepare_notrace 'a shell pipeline' "run_reportwriter.at:4436" -( $at_check_trace; cat reference.at | tr -d _ > reference -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_reportwriter.at:4436" -$at_failed && at_fn_log_failure \ -"./report_var.txt" \ -"./report_lit.txt" -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_reportwriter.at:4437: diff reference report_var.txt" -at_fn_check_prepare_trace "run_reportwriter.at:4437" -( $at_check_trace; diff reference report_var.txt -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_reportwriter.at:4437" -$at_failed && at_fn_log_failure \ -"./report_var.txt" \ -"./report_lit.txt" -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_reportwriter.at:4438: diff reference report_lit.txt" -at_fn_check_prepare_trace "run_reportwriter.at:4438" -( $at_check_trace; diff reference report_lit.txt -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_reportwriter.at:4438" -$at_failed && at_fn_log_failure \ -"./report_var.txt" \ -"./report_lit.txt" -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_814 -#AT_START_815 -at_fn_group_banner 815 'run_reportwriter.at:4443' \ - "Duplicate INITIATE" " " 4 -at_xfail=no -( - $as_echo "815. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - - ENVIRONMENT DIVISION. - INPUT-OUTPUT SECTION. - FILE-CONTROL. - SELECT report-file ASSIGN EXTERNAL PRINTOUT - ORGANIZATION LINE SEQUENTIAL. - - DATA DIVISION. - FILE SECTION. - FD report-file REPORT rp. - - WORKING-STORAGE SECTION. - 01 foo PIC X(20). - 01 hedpos PIC 99 VALUE 10. - - REPORT SECTION. - RD rp PAGE LIMIT 3. - - 01 rp-detail TYPE DE. - 02 LINE + 1. - 03 COL 1; SOURCE foo, PIC X(30). - 03 COL +2 PIC X(6) VALUE "<--->". - - PROCEDURE DIVISION. - OPEN OUTPUT report-file. - INITIATE rp. - - MOVE "hello" TO foo. - GENERATE rp-detail. - - INITIATE rp. - - MOVE "goodbye" TO foo. - GENERATE rp-detail. - - TERMINATE rp. - CLOSE report-file. - STOP RUN. - END PROGRAM prog. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_reportwriter.at:4490: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_reportwriter.at:4490" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_reportwriter.at:4490" -$at_failed && at_fn_log_failure -$at_traceon; } - - -{ set +x -$as_echo "$at_srcdir/run_reportwriter.at:4492: DD_PRINTOUT=./report.txt \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "DD_PRINTOUT=./report.txt $COBCRUN_DIRECT ./prog" "run_reportwriter.at:4492" -( $at_check_trace; DD_PRINTOUT=./report.txt $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "libcob: prog.cob:34: error: INITIATE rp was already done -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_reportwriter.at:4492" -$at_failed && at_fn_log_failure -$at_traceon; } - - - - - -cat >reference <<'_ATEOF' -hello <---> -goodbye <---> - -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_reportwriter.at:4504: diff reference report.txt" -at_fn_check_prepare_trace "run_reportwriter.at:4504" -( $at_check_trace; diff reference report.txt -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_reportwriter.at:4504" -$at_failed && at_fn_log_failure \ -"./report.txt" -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_815 -#AT_START_816 -at_fn_group_banner 816 'run_reportwriter.at:4509' \ - "Missing INITIATE and GENERATE" " " 4 -at_xfail=no -( - $as_echo "816. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - - ENVIRONMENT DIVISION. - INPUT-OUTPUT SECTION. - FILE-CONTROL. - SELECT report-file ASSIGN EXTERNAL PRINTOUT - ORGANIZATION LINE SEQUENTIAL. - - DATA DIVISION. - FILE SECTION. - FD report-file REPORT rp. - - WORKING-STORAGE SECTION. - 01 foo PIC X(20). - 01 hedpos PIC 99 VALUE 10. - - REPORT SECTION. - RD rp PAGE LIMIT 3. - - 01 rp-detail TYPE DE. - 02 LINE + 1. - 03 COL 1; SOURCE foo, PIC X(30). - 03 COL +2 PIC X(6) VALUE "<--->". - - PROCEDURE DIVISION. - OPEN OUTPUT report-file. - - MOVE "hello" TO foo. - GENERATE rp-detail. - - MOVE "goodbye" TO foo. - GENERATE rp-detail. - - TERMINATE rp. - CLOSE report-file. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_reportwriter.at:4552: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_reportwriter.at:4552" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_reportwriter.at:4552" -$at_failed && at_fn_log_failure -$at_traceon; } - - -{ set +x -$as_echo "$at_srcdir/run_reportwriter.at:4554: DD_PRINTOUT=./report.txt \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "DD_PRINTOUT=./report.txt $COBCRUN_DIRECT ./prog" "run_reportwriter.at:4554" -( $at_check_trace; DD_PRINTOUT=./report.txt $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "libcob: prog.cob:31: error: GENERATE rp but no INITIATE was done -libcob: prog.cob:31: warning: implicit CLOSE of report-file ('PRINTOUT') -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/run_reportwriter.at:4554" -$at_failed && at_fn_log_failure -$at_traceon; } - - - - - -: >reference - -{ set +x -$as_echo "$at_srcdir/run_reportwriter.at:4564: diff reference report.txt" -at_fn_check_prepare_trace "run_reportwriter.at:4564" -( $at_check_trace; diff reference report.txt -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_reportwriter.at:4564" -$at_failed && at_fn_log_failure \ -"./report.txt" -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_816 -#AT_START_817 -at_fn_group_banner 817 'run_reportwriter.at:4569' \ - "Missing INITIATE and TERMINATE" " " 4 -at_xfail=no -( - $as_echo "817. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - - ENVIRONMENT DIVISION. - INPUT-OUTPUT SECTION. - FILE-CONTROL. - SELECT report-file ASSIGN EXTERNAL PRINTOUT - ORGANIZATION LINE SEQUENTIAL. - - DATA DIVISION. - FILE SECTION. - FD report-file REPORT rp. - - WORKING-STORAGE SECTION. - 01 foo PIC X(20). - 01 hedpos PIC 99 VALUE 10. - - REPORT SECTION. - RD rp PAGE LIMIT 3. - - 01 rp-detail TYPE DE. - 02 LINE + 1. - 03 COL 1; SOURCE foo, PIC X(30). - 03 COL + 2 PIC X(6) VALUE "<--->". - - PROCEDURE DIVISION. - OPEN OUTPUT report-file. - - TERMINATE rp. - CLOSE report-file. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_reportwriter.at:4606: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_reportwriter.at:4606" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_reportwriter.at:4606" -$at_failed && at_fn_log_failure -$at_traceon; } - - -{ set +x -$as_echo "$at_srcdir/run_reportwriter.at:4608: DD_PRINTOUT=./report.txt \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "DD_PRINTOUT=./report.txt $COBCRUN_DIRECT ./prog" "run_reportwriter.at:4608" -( $at_check_trace; DD_PRINTOUT=./report.txt $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "libcob: prog.cob:30: error: TERMINATE rp but no INITIATE was done -libcob: prog.cob:30: warning: implicit CLOSE of report-file ('PRINTOUT') -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/run_reportwriter.at:4608" -$at_failed && at_fn_log_failure -$at_traceon; } - - - - - -: >reference - -{ set +x -$as_echo "$at_srcdir/run_reportwriter.at:4618: diff reference report.txt" -at_fn_check_prepare_trace "run_reportwriter.at:4618" -( $at_check_trace; diff reference report.txt -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_reportwriter.at:4618" -$at_failed && at_fn_log_failure \ -"./report.txt" -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_817 -#AT_START_818 -at_fn_group_banner 818 'run_reportwriter.at:4623' \ - "Next Group Next Page" " " 4 -at_xfail=no -( - $as_echo "818. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >inp_data <<'_ATEOF' -MW1000051IN15021220150212OR150212043ITEM_NUMBER_22 0000002800002999 -MW1000051IN15022220150222OR150226020ITEM_NUMBER_06 0000004300000999 -MW1000071IN15021420150214OR150212057ITEM_NUMBER_51 0000007000005999 -MW1000071IN15022820150228OR150225098ITEM_NUMBER_92 0000001400009999 -MW1000201IN15020920150209OR150216083ITEM_NUMBER_77 0000007700007999 -MW1000201IN15022720150227OR150223079ITEM_NUMBER_20 0000009600002999 -MW1000291IN15021720150217OR150218088ITEM_NUMBER_86 0000001900008999 -MW1000411IN15022320150223OR150210063ITEM_NUMBER_66 0000008800006999 -MW1000451IN15021720150217OR150202053ITEM_NUMBER_60 0000005100006999 -MW1000471IN15022420150224OR150201036ITEM_NUMBER_45 0000003800004999 -MW1000831IN15021020150210OR150227042ITEM_NUMBER_70 0000007200007999 -MW1000831IN15021420150214OR150228090ITEM_NUMBER_07 0000002300000999 -MW1000831IN15022020150220OR150226048ITEM_NUMBER_61 0000005900006999 -MW1000891IN15022120150221OR150219018ITEM_NUMBER_72 0000007300007999 -MW1000891IN15022320150223OR150227069ITEM_NUMBER_73 0000007400007999 -NE1000001IN15021020150210OR150217060ITEM_NUMBER_38 0000009800003999 -NE1000201IN15021920150219OR150209035ITEM_NUMBER_94 0000009600009999 -NE1000431IN15021520150215OR150227047ITEM_NUMBER_64 0000008700006999 -NE1000431IN15022220150222OR150213062ITEM_NUMBER_97 0000007300009999 -NE1000451IN15020320150203OR150213087ITEM_NUMBER_85 0000005300008999 -NE1000471IN15022120150221OR150222034ITEM_NUMBER_74 0000008400007999 -NE1000471IN15022120150221OR150225077ITEM_NUMBER_78 0000002400007999 -NE1000491IN15021720150217OR150210037ITEM_NUMBER_17 0000000700001999 -NE1000601IN15021520150215OR150211070ITEM_NUMBER_06 0000004400000999 -NE1000631IN15022720150227OR150209051ITEM_NUMBER_09 0000005400000999 -NE1000671IN15020620150206OR150220045ITEM_NUMBER_56 0000006600005999 -NE1000811IN15022020150220OR150212086ITEM_NUMBER_27 0000001700002999 -NE1000811IN15022820150228OR150222075ITEM_NUMBER_66 0000008600006999 -NE1000831IN15021620150216OR150224004ITEM_NUMBER_52 0000004200005999 -NW1000001IN15022420150224OR150215029ITEM_NUMBER_79 0000003500007999 -NW1000011IN15022820150228OR150209023ITEM_NUMBER_62 0000009800006999 -NW1000051IN15021020150210OR150225076ITEM_NUMBER_50 0000003900005999 -NW1000051IN15021820150218OR150229093ITEM_NUMBER_94 0000003700009999 -NW1000051IN15022020150220OR150221050ITEM_NUMBER_89 0000003800008999 -NW1000071IN15020220150202OR150223014ITEM_NUMBER_54 0000004800005999 -NW1000091IN15020820150208OR150229094ITEM_NUMBER_17 0000007200001999 -NW1000091IN15021220150212OR150222096ITEM_NUMBER_89 0000004900008999 -NW1000091IN15022420150224OR150211074ITEM_NUMBER_90 0000004300009999 -NW1000091IN15022720150227OR150219030ITEM_NUMBER_12 0000001900001999 -NW1000201IN15020820150208OR150210061ITEM_NUMBER_34 0000001200003999 -NW1000231IN15021420150214OR150210044ITEM_NUMBER_89 0000005400008999 -NW1000251IN15021220150212OR150204059ITEM_NUMBER_39 0000006000003999 -NW1000401IN15021520150215OR150222049ITEM_NUMBER_40 0000008100004999 -NW1000401IN15021720150217OR150203085ITEM_NUMBER_77 0000003700007999 -NW1000411IN15020720150207OR150224056ITEM_NUMBER_99 0000005400009999 -NW1000411IN15022820150228OR150221008ITEM_NUMBER_68 0000009000006999 -NW1000491IN15022820150228OR150201002ITEM_NUMBER_47 0000008600004999 -NW1000611IN15022720150227OR150224097ITEM_NUMBER_11 0000008000001999 -NW1000631IN15020720150207OR150206031ITEM_NUMBER_49 0000001500004999 -NW1000631IN15021420150214OR150210054ITEM_NUMBER_40 0000004200004999 -NW1000631IN15022420150224OR150218024ITEM_NUMBER_84 0000003300008999 -NW1000651IN15020620150206OR150225099ITEM_NUMBER_57 0000004300005999 -NW1000671IN15021320150213OR150224041ITEM_NUMBER_22 0000000200002999 -NW1000691IN15020420150204OR150211092ITEM_NUMBER_13 0000009400001999 -NW1000811IN15022720150227OR150217081ITEM_NUMBER_45 0000001600004999 -NW1000851IN15020820150208OR150203091ITEM_NUMBER_63 0000006600006999 -NW1000871IN15021820150218OR150209082ITEM_NUMBER_30 0000005500003999 -NW1000871IN15022820150228OR150222015ITEM_NUMBER_73 0000005100007999 -NW1000891IN15022520150225OR150201026ITEM_NUMBER_80 0000004700008999 -SE1000001IN15022320150223OR150203064ITEM_NUMBER_03 0000007100000999 -SE1000011IN15020120150201OR150213017ITEM_NUMBER_09 0000000600000999 -SE1000011IN15021220150212OR150209066ITEM_NUMBER_06 0000004000000999 -SE1000091IN15020420150204OR150201001ITEM_NUMBER_68 0000001900006999 -SE1000091IN15021020150210OR150223084ITEM_NUMBER_11 0000009300001999 -SE1000091IN15022620150226OR150219038ITEM_NUMBER_97 0000003700009999 -SE1000211IN15020620150206OR150221089ITEM_NUMBER_05 0000004500000999 -SE1000411IN15021220150212OR150208012ITEM_NUMBER_46 0000002300004999 -SE1000431IN15020720150207OR150214072ITEM_NUMBER_25 0000004600002999 -SE1000431IN15022520150225OR150220040ITEM_NUMBER_01 0000006100000999 -SE1000451IN15021420150214OR150204022ITEM_NUMBER_34 0000004700003999 -SE1000471IN15020320150203OR150217010ITEM_NUMBER_25 0000003400002999 -SE1000471IN15021120150211OR150213025ITEM_NUMBER_54 0000009200005999 -SE1000491IN15020220150202OR150202013ITEM_NUMBER_19 0000007800001999 -SE1000601IN15022420150224OR150210039ITEM_NUMBER_19 0000005600001999 -SE1000631IN15020120150201OR150216003ITEM_NUMBER_65 0000001100006999 -SE1000671IN15020320150203OR150205071ITEM_NUMBER_64 0000009400006999 -SE1000671IN15022020150220OR150214032ITEM_NUMBER_53 0000005900005999 -SE1000891IN15022620150226OR150229068ITEM_NUMBER_75 0000008400007999 -SW1000011IN15020220150202OR150206000ITEM_NUMBER_30 0000005900003999 -SW1000031IN15020320150203OR150214033ITEM_NUMBER_09 0000006000000999 -SW1000031IN15020620150206OR150206021ITEM_NUMBER_91 0000005400009999 -SW1000091IN15022320150223OR150221028ITEM_NUMBER_67 0000003900006999 -SW1000201IN15020920150209OR150205065ITEM_NUMBER_21 0000007000002999 -SW1000201IN15022520150225OR150203052ITEM_NUMBER_55 0000007500005999 -SW1000201IN15022520150225OR150210067ITEM_NUMBER_83 0000001500008999 -SW1000211IN15020220150202OR150221055ITEM_NUMBER_16 0000001300001999 -SW1000211IN15020820150208OR150215007ITEM_NUMBER_97 0000008900009999 -SW1000271IN15021120150211OR150228080ITEM_NUMBER_45 0000005200004999 -SW1000271IN15021320150213OR150207095ITEM_NUMBER_09 0000005400000999 -SW1000401IN15022820150228OR150202027ITEM_NUMBER_83 0000000100008999 -SW1000411IN15021020150210OR150220073ITEM_NUMBER_63 0000001400006999 -SW1000431IN15020820150208OR150227078ITEM_NUMBER_23 0000005200002999 -SW1000431IN15022020150220OR150227006ITEM_NUMBER_50 0000008500005999 -SW1000601IN15020620150206OR150201011ITEM_NUMBER_73 0000008400007999 -SW1000611IN15020620150206OR150218019ITEM_NUMBER_67 0000006100006999 -SW1000651IN15020920150209OR150224009ITEM_NUMBER_23 0000001800002999 -SW1000831IN15020120150201OR150221046ITEM_NUMBER_44 0000006900004999 -SW1000831IN15022020150220OR150213005ITEM_NUMBER_44 0000003700004999 -SW1000831IN15022220150222OR150213058ITEM_NUMBER_86 0000008300008999 -SW1000871IN15020220150202OR150216016ITEM_NUMBER_62 0000008300006999 -_ATEOF - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - *AUTHOR. Gerard Robinson. - *DATE-WRITTEN. February 25, 2015. - - ENVIRONMENT DIVISION. - - INPUT-OUTPUT SECTION. - - FILE-CONTROL. - - SELECT REPORT-FILE - ASSIGN TO EXTERNAL REPORTFILE - ORGANIZATION IS LINE SEQUENTIAL. - - SELECT TEMP-FILE - ASSIGN TO EXTERNAL TEMPFILE - ORGANIZATION IS LINE SEQUENTIAL. - - DATA DIVISION. - - FILE SECTION. - - FD REPORT-FILE - REPORT IS RPTA. - - FD TEMP-FILE. - - 01 TEMP-REC. - 03 TEMP-REGION PIC X(2). - 03 TEMP-BRANCH PIC X(7). - 03 TEMP-INVOICE PIC X(8). - 03 TEMP-DATE PIC X(8). - 03 TEMP-ORDER PIC X(8). - 03 TEMP-LINE-NO PIC X(3). - 03 TEMP-ITEM PIC X(20). - 03 TEMP-TX-QTY PIC S9(8). - 03 TEMP-COST PIC 999999V99. - - WORKING-STORAGE SECTION. - - 01 WS-CURRENT-DATE PIC X(23). - - 01 WS-SYSTEM-DATE-R REDEFINES WS-CURRENT-DATE. - 05 WS-DATE-YYYY PIC X(4). - 05 WS-DATE-MM PIC X(2). - 05 WS-DATE-DD PIC X(2). - 05 WS-TIME PIC X(6). - 05 WS-REST PIC X(9). - - 01 TEMP-FILE-EOF PIC 9 VALUE 0. - - REPORT SECTION. - - RD RPTA - CONTROLS ARE - FINAL, - TEMP-REGION, - TEMP-BRANCH, - TEMP-INVOICE - - PAGE LIMIT IS 60 LINES - HEADING 1 - FIRST DETAIL 8 - LAST DETAIL 48. - - 01 RPTA-PAGE-HEADING TYPE PAGE HEADING. - 03 LINE NUMBER IS 1. - 05 COLUMN 1 PIC X(4) VALUE "Run:". - 05 COLUMN 5 PIC X(2) SOURCE WS-DATE-MM. - 05 COLUMN 7 PIC X VALUE "/". - 05 COLUMN 8 PIC X(2) SOURCE WS-DATE-DD. - 05 COLUMN 10 PIC X VALUE "/". - 05 COLUMN 11 PIC X(4) SOURCE WS-DATE-YYYY. - 05 COLUMN 16 PIC X(6) SOURCE WS-TIME. - 05 COLUMN 40 PIC X(16) VALUE "NEXT PAGE ISSUE". - 05 COLUMN 61 PIC X(4) VALUE 'Page'. - 05 COLUMN 66 PIC ZZZ9 SOURCE PAGE-COUNTER. - - 03 LINE NUMBER IS 2. - 05 COLUMN 1 PIC X(08) VALUE "Region: ". - 05 COLUMN 12 PIC XX SOURCE TEMP-REGION. - - 03 LINE NUMBER IS 3. - 05 COLUMN 1 PIC X(21) VALUE "Location: ". - 05 COLUMN 22 PIC X(7) SOURCE TEMP-BRANCH. - - 03 LINE NUMBER IS 4. - 05 COLUMN 1 PIC X(8) VALUE "Invoice#". - 05 COLUMN 12 PIC X(4) VALUE "Date". - 05 COLUMN 46 PIC X(6) VALUE "Order#". - 05 COLUMN 62 PIC X(5) VALUE "Line#". - 05 COLUMN 69 PIC X(5) VALUE "Item#". - 05 COLUMN 102 PIC X(6) VALUE "TX Qty". - 05 COLUMN 114 PIC X(4) VALUE "Cost". - - 03 LINE NUMBER IS 5. - 05 COLUMN 1 PIC X(128) VALUE ALL "-". - - 01 RPTA-DETAIL-LINE TYPE DETAIL. - 05 LINE PLUS 1. - 07 COLUMN 1 PIC X(8) GROUP INDICATE - SOURCE TEMP-INVOICE. - 07 COLUMN 12 PIC X(8) GROUP INDICATE - SOURCE TEMP-DATE. - 07 COLUMN 46 PIC X(8) GROUP INDICATE - SOURCE TEMP-ORDER. - 07 COLUMN 64 PIC X(3) SOURCE TEMP-LINE-NO. - 07 COLUMN 69 PIC X(20) SOURCE TEMP-ITEM. - 07 COLUMN 102 PIC S9(8) SOURCE TEMP-TX-QTY. - 07 COLUMN 114 PIC ZZZZZZ9.99 SOURCE TEMP-COST. - - 01 RPTA-INVOICE-FOOTING TYPE CONTROL FOOTING TEMP-INVOICE - NEXT GROUP PLUS 1. - 03 LINE NUMBER IS PLUS 1. - 05 COLUMN 69 PIC X(15) VALUE "Invoice Total: ". - 05 COLUMN 101 PIC S9(9) SUM TEMP-TX-QTY. - 05 COLUMN 113 PIC ZZZZZZZ9.99 SUM TEMP-COST. - - 01 RPTA-BRANCH-FOOTING TYPE CONTROL FOOTING TEMP-BRANCH - NEXT GROUP NEXT PAGE. - 03 LINE NUMBER IS PLUS 2. - 05 COLUMN 69 PIC X(15) VALUE "Branch Total: ". - 05 COLUMN 101 PIC S9(9) SUM TEMP-TX-QTY. - 05 COLUMN 113 PIC ZZZZZZZ9.99 SUM TEMP-COST. - - 01 RPTA-REGION-FOOTING TYPE CONTROL FOOTING TEMP-REGION - NEXT GROUP NEXT PAGE. - 03 LINE NUMBER IS PLUS 2. - 05 COLUMN 69 PIC X(15) VALUE "Region Total: ". - 05 COLUMN 101 PIC S9(9) SUM TEMP-TX-QTY. - 05 COLUMN 113 PIC ZZZZZZZ9.99 SUM TEMP-COST. - - 01 RPTA-FINAL-FOOTING TYPE CONTROL FOOTING FINAL. - 03 LINE NUMBER IS PLUS 2. - 05 COLUMN 69 PIC X(15) VALUE "Grand Total: ". - 05 COLUMN 101 PIC S9(9) SUM TEMP-TX-QTY. - 05 COLUMN 113 PIC ZZZZZZZ9.99 SUM TEMP-COST. - - PROCEDURE DIVISION. - - OPEN INPUT TEMP-FILE. - OPEN OUTPUT REPORT-FILE. - - MOVE "20150225153000000000000" TO WS-CURRENT-DATE. - - INITIATE RPTA. - - PERFORM PROCESS-DETAIL-LEVEL-REPORT THRU PDLR-EXIT. - - TERMINATE RPTA. - - CLOSE TEMP-FILE. - CLOSE REPORT-FILE. - - STOP RUN. - - - PROCESS-DETAIL-LEVEL-REPORT. - PERFORM READ-NEXT-TEMP-REC THRU RNTR-EXIT. - - IF TEMP-FILE-EOF EQUALS 1 - GO TO PDLR-EXIT - END-IF. - - GENERATE RPTA-DETAIL-LINE. - - GO TO PROCESS-DETAIL-LEVEL-REPORT. - - PDLR-EXIT. - EXIT. - - - READ-NEXT-TEMP-REC. - READ TEMP-FILE NEXT RECORD - AT END - MOVE 1 TO TEMP-FILE-EOF - END-READ. - - RNTR-EXIT. - EXIT. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_reportwriter.at:4912: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_reportwriter.at:4912" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_reportwriter.at:4912" -$at_failed && at_fn_log_failure -$at_traceon; } - - -{ set +x -$as_echo "$at_srcdir/run_reportwriter.at:4914: DD_TEMPFILE=./inp_data DD_REPORTFILE=./report.txt \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "DD_TEMPFILE=./inp_data DD_REPORTFILE=./report.txt $COBCRUN_DIRECT ./prog" "run_reportwriter.at:4914" -( $at_check_trace; DD_TEMPFILE=./inp_data DD_REPORTFILE=./report.txt $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_reportwriter.at:4914" -$at_failed && at_fn_log_failure -$at_traceon; } - - - - - -cat >reference <<'_ATEOF' -Run:02/25/2015 153000 NEXT PAGE ISSUE Page 1 -Region: MW -Location: 1000051 -Invoice# Date Order# Line# Item# TX Qty Cost --------------------------------------------------------------------------------------------------------------------------------- - - -IN150212 20150212 OR150212 043 ITEM_NUMBER_22 00000028 29.99 - Invoice Total: 000000028 29.99 - -IN150222 20150222 OR150226 020 ITEM_NUMBER_06 00000043 9.99 - Invoice Total: 000000043 9.99 - - - Branch Total: 000000071 39.98 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -Run:02/25/2015 153000 NEXT PAGE ISSUE Page 2 -Region: MW -Location: 1000071 -Invoice# Date Order# Line# Item# TX Qty Cost --------------------------------------------------------------------------------------------------------------------------------- - - -IN150214 20150214 OR150212 057 ITEM_NUMBER_51 00000070 59.99 - Invoice Total: 000000070 59.99 - -IN150228 20150228 OR150225 098 ITEM_NUMBER_92 00000014 99.99 - Invoice Total: 000000014 99.99 - - - Branch Total: 000000084 159.98 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -Run:02/25/2015 153000 NEXT PAGE ISSUE Page 3 -Region: MW -Location: 1000201 -Invoice# Date Order# Line# Item# TX Qty Cost --------------------------------------------------------------------------------------------------------------------------------- - - -IN150209 20150209 OR150216 083 ITEM_NUMBER_77 00000077 79.99 - Invoice Total: 000000077 79.99 - -IN150227 20150227 OR150223 079 ITEM_NUMBER_20 00000096 29.99 - Invoice Total: 000000096 29.99 - - - Branch Total: 000000173 109.98 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -Run:02/25/2015 153000 NEXT PAGE ISSUE Page 4 -Region: MW -Location: 1000291 -Invoice# Date Order# Line# Item# TX Qty Cost --------------------------------------------------------------------------------------------------------------------------------- - - -IN150217 20150217 OR150218 088 ITEM_NUMBER_86 00000019 89.99 - Invoice Total: 000000019 89.99 - - - Branch Total: 000000019 89.99 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -Run:02/25/2015 153000 NEXT PAGE ISSUE Page 5 -Region: MW -Location: 1000411 -Invoice# Date Order# Line# Item# TX Qty Cost --------------------------------------------------------------------------------------------------------------------------------- - - -IN150223 20150223 OR150210 063 ITEM_NUMBER_66 00000088 69.99 - Invoice Total: 000000088 69.99 - - - Branch Total: 000000088 69.99 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -Run:02/25/2015 153000 NEXT PAGE ISSUE Page 6 -Region: MW -Location: 1000451 -Invoice# Date Order# Line# Item# TX Qty Cost --------------------------------------------------------------------------------------------------------------------------------- - - -IN150217 20150217 OR150202 053 ITEM_NUMBER_60 00000051 69.99 - Invoice Total: 000000051 69.99 - - - Branch Total: 000000051 69.99 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -Run:02/25/2015 153000 NEXT PAGE ISSUE Page 7 -Region: MW -Location: 1000471 -Invoice# Date Order# Line# Item# TX Qty Cost --------------------------------------------------------------------------------------------------------------------------------- - - -IN150224 20150224 OR150201 036 ITEM_NUMBER_45 00000038 49.99 - Invoice Total: 000000038 49.99 - - - Branch Total: 000000038 49.99 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -Run:02/25/2015 153000 NEXT PAGE ISSUE Page 8 -Region: MW -Location: 1000831 -Invoice# Date Order# Line# Item# TX Qty Cost --------------------------------------------------------------------------------------------------------------------------------- - - -IN150210 20150210 OR150227 042 ITEM_NUMBER_70 00000072 79.99 - Invoice Total: 000000072 79.99 - -IN150214 20150214 OR150228 090 ITEM_NUMBER_07 00000023 9.99 - Invoice Total: 000000023 9.99 - -IN150220 20150220 OR150226 048 ITEM_NUMBER_61 00000059 69.99 - Invoice Total: 000000059 69.99 - - - Branch Total: 000000154 159.97 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -Run:02/25/2015 153000 NEXT PAGE ISSUE Page 9 -Region: MW -Location: 1000891 -Invoice# Date Order# Line# Item# TX Qty Cost --------------------------------------------------------------------------------------------------------------------------------- - - -IN150221 20150221 OR150219 018 ITEM_NUMBER_72 00000073 79.99 - Invoice Total: 000000073 79.99 - -IN150223 20150223 OR150227 069 ITEM_NUMBER_73 00000074 79.99 - Invoice Total: 000000074 79.99 - - - Branch Total: 000000147 159.98 - - Region Total: 000000825 909.85 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -Run:02/25/2015 153000 NEXT PAGE ISSUE Page 10 -Region: NE -Location: 1000001 -Invoice# Date Order# Line# Item# TX Qty Cost --------------------------------------------------------------------------------------------------------------------------------- - - -IN150210 20150210 OR150217 060 ITEM_NUMBER_38 00000098 39.99 - Invoice Total: 000000098 39.99 - - - Branch Total: 000000098 39.99 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -Run:02/25/2015 153000 NEXT PAGE ISSUE Page 11 -Region: NE -Location: 1000201 -Invoice# Date Order# Line# Item# TX Qty Cost --------------------------------------------------------------------------------------------------------------------------------- - - -IN150219 20150219 OR150209 035 ITEM_NUMBER_94 00000096 99.99 - Invoice Total: 000000096 99.99 - - - Branch Total: 000000096 99.99 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -Run:02/25/2015 153000 NEXT PAGE ISSUE Page 12 -Region: NE -Location: 1000431 -Invoice# Date Order# Line# Item# TX Qty Cost --------------------------------------------------------------------------------------------------------------------------------- - - -IN150215 20150215 OR150227 047 ITEM_NUMBER_64 00000087 69.99 - Invoice Total: 000000087 69.99 - -IN150222 20150222 OR150213 062 ITEM_NUMBER_97 00000073 99.99 - Invoice Total: 000000073 99.99 - - - Branch Total: 000000160 169.98 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -Run:02/25/2015 153000 NEXT PAGE ISSUE Page 13 -Region: NE -Location: 1000451 -Invoice# Date Order# Line# Item# TX Qty Cost --------------------------------------------------------------------------------------------------------------------------------- - - -IN150203 20150203 OR150213 087 ITEM_NUMBER_85 00000053 89.99 - Invoice Total: 000000053 89.99 - - - Branch Total: 000000053 89.99 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -Run:02/25/2015 153000 NEXT PAGE ISSUE Page 14 -Region: NE -Location: 1000471 -Invoice# Date Order# Line# Item# TX Qty Cost --------------------------------------------------------------------------------------------------------------------------------- - - -IN150221 20150221 OR150222 034 ITEM_NUMBER_74 00000084 79.99 - 077 ITEM_NUMBER_78 00000024 79.99 - Invoice Total: 000000108 159.98 - - - Branch Total: 000000108 159.98 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -Run:02/25/2015 153000 NEXT PAGE ISSUE Page 15 -Region: NE -Location: 1000491 -Invoice# Date Order# Line# Item# TX Qty Cost --------------------------------------------------------------------------------------------------------------------------------- - - -IN150217 20150217 OR150210 037 ITEM_NUMBER_17 00000007 19.99 - Invoice Total: 000000007 19.99 - - - Branch Total: 000000007 19.99 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -Run:02/25/2015 153000 NEXT PAGE ISSUE Page 16 -Region: NE -Location: 1000601 -Invoice# Date Order# Line# Item# TX Qty Cost --------------------------------------------------------------------------------------------------------------------------------- - - -IN150215 20150215 OR150211 070 ITEM_NUMBER_06 00000044 9.99 - Invoice Total: 000000044 9.99 - - - Branch Total: 000000044 9.99 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -Run:02/25/2015 153000 NEXT PAGE ISSUE Page 17 -Region: NE -Location: 1000631 -Invoice# Date Order# Line# Item# TX Qty Cost --------------------------------------------------------------------------------------------------------------------------------- - - -IN150227 20150227 OR150209 051 ITEM_NUMBER_09 00000054 9.99 - Invoice Total: 000000054 9.99 - - - Branch Total: 000000054 9.99 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -Run:02/25/2015 153000 NEXT PAGE ISSUE Page 18 -Region: NE -Location: 1000671 -Invoice# Date Order# Line# Item# TX Qty Cost --------------------------------------------------------------------------------------------------------------------------------- - - -IN150206 20150206 OR150220 045 ITEM_NUMBER_56 00000066 59.99 - Invoice Total: 000000066 59.99 - - - Branch Total: 000000066 59.99 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -Run:02/25/2015 153000 NEXT PAGE ISSUE Page 19 -Region: NE -Location: 1000811 -Invoice# Date Order# Line# Item# TX Qty Cost --------------------------------------------------------------------------------------------------------------------------------- - - -IN150220 20150220 OR150212 086 ITEM_NUMBER_27 00000017 29.99 - Invoice Total: 000000017 29.99 - -IN150228 20150228 OR150222 075 ITEM_NUMBER_66 00000086 69.99 - Invoice Total: 000000086 69.99 - - - Branch Total: 000000103 99.98 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -Run:02/25/2015 153000 NEXT PAGE ISSUE Page 20 -Region: NE -Location: 1000831 -Invoice# Date Order# Line# Item# TX Qty Cost --------------------------------------------------------------------------------------------------------------------------------- - - -IN150216 20150216 OR150224 004 ITEM_NUMBER_52 00000042 59.99 - Invoice Total: 000000042 59.99 - - - Branch Total: 000000042 59.99 - - Region Total: 000000831 819.86 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -Run:02/25/2015 153000 NEXT PAGE ISSUE Page 21 -Region: NW -Location: 1000001 -Invoice# Date Order# Line# Item# TX Qty Cost --------------------------------------------------------------------------------------------------------------------------------- - - -IN150224 20150224 OR150215 029 ITEM_NUMBER_79 00000035 79.99 - Invoice Total: 000000035 79.99 - - - Branch Total: 000000035 79.99 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -Run:02/25/2015 153000 NEXT PAGE ISSUE Page 22 -Region: NW -Location: 1000011 -Invoice# Date Order# Line# Item# TX Qty Cost --------------------------------------------------------------------------------------------------------------------------------- - - -IN150228 20150228 OR150209 023 ITEM_NUMBER_62 00000098 69.99 - Invoice Total: 000000098 69.99 - - - Branch Total: 000000098 69.99 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -Run:02/25/2015 153000 NEXT PAGE ISSUE Page 23 -Region: NW -Location: 1000051 -Invoice# Date Order# Line# Item# TX Qty Cost --------------------------------------------------------------------------------------------------------------------------------- - - -IN150210 20150210 OR150225 076 ITEM_NUMBER_50 00000039 59.99 - Invoice Total: 000000039 59.99 - -IN150218 20150218 OR150229 093 ITEM_NUMBER_94 00000037 99.99 - Invoice Total: 000000037 99.99 - -IN150220 20150220 OR150221 050 ITEM_NUMBER_89 00000038 89.99 - Invoice Total: 000000038 89.99 - - - Branch Total: 000000114 249.97 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -Run:02/25/2015 153000 NEXT PAGE ISSUE Page 24 -Region: NW -Location: 1000071 -Invoice# Date Order# Line# Item# TX Qty Cost --------------------------------------------------------------------------------------------------------------------------------- - - -IN150202 20150202 OR150223 014 ITEM_NUMBER_54 00000048 59.99 - Invoice Total: 000000048 59.99 - - - Branch Total: 000000048 59.99 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -Run:02/25/2015 153000 NEXT PAGE ISSUE Page 25 -Region: NW -Location: 1000091 -Invoice# Date Order# Line# Item# TX Qty Cost --------------------------------------------------------------------------------------------------------------------------------- - - -IN150208 20150208 OR150229 094 ITEM_NUMBER_17 00000072 19.99 - Invoice Total: 000000072 19.99 - -IN150212 20150212 OR150222 096 ITEM_NUMBER_89 00000049 89.99 - Invoice Total: 000000049 89.99 - -IN150224 20150224 OR150211 074 ITEM_NUMBER_90 00000043 99.99 - Invoice Total: 000000043 99.99 - -IN150227 20150227 OR150219 030 ITEM_NUMBER_12 00000019 19.99 - Invoice Total: 000000019 19.99 - - - Branch Total: 000000183 229.96 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -Run:02/25/2015 153000 NEXT PAGE ISSUE Page 26 -Region: NW -Location: 1000201 -Invoice# Date Order# Line# Item# TX Qty Cost --------------------------------------------------------------------------------------------------------------------------------- - - -IN150208 20150208 OR150210 061 ITEM_NUMBER_34 00000012 39.99 - Invoice Total: 000000012 39.99 - - - Branch Total: 000000012 39.99 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -Run:02/25/2015 153000 NEXT PAGE ISSUE Page 27 -Region: NW -Location: 1000231 -Invoice# Date Order# Line# Item# TX Qty Cost --------------------------------------------------------------------------------------------------------------------------------- - - -IN150214 20150214 OR150210 044 ITEM_NUMBER_89 00000054 89.99 - Invoice Total: 000000054 89.99 - - - Branch Total: 000000054 89.99 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -Run:02/25/2015 153000 NEXT PAGE ISSUE Page 28 -Region: NW -Location: 1000251 -Invoice# Date Order# Line# Item# TX Qty Cost --------------------------------------------------------------------------------------------------------------------------------- - - -IN150212 20150212 OR150204 059 ITEM_NUMBER_39 00000060 39.99 - Invoice Total: 000000060 39.99 - - - Branch Total: 000000060 39.99 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -Run:02/25/2015 153000 NEXT PAGE ISSUE Page 29 -Region: NW -Location: 1000401 -Invoice# Date Order# Line# Item# TX Qty Cost --------------------------------------------------------------------------------------------------------------------------------- - - -IN150215 20150215 OR150222 049 ITEM_NUMBER_40 00000081 49.99 - Invoice Total: 000000081 49.99 - -IN150217 20150217 OR150203 085 ITEM_NUMBER_77 00000037 79.99 - Invoice Total: 000000037 79.99 - - - Branch Total: 000000118 129.98 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -Run:02/25/2015 153000 NEXT PAGE ISSUE Page 30 -Region: NW -Location: 1000411 -Invoice# Date Order# Line# Item# TX Qty Cost --------------------------------------------------------------------------------------------------------------------------------- - - -IN150207 20150207 OR150224 056 ITEM_NUMBER_99 00000054 99.99 - Invoice Total: 000000054 99.99 - -IN150228 20150228 OR150221 008 ITEM_NUMBER_68 00000090 69.99 - Invoice Total: 000000090 69.99 - - - Branch Total: 000000144 169.98 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -Run:02/25/2015 153000 NEXT PAGE ISSUE Page 31 -Region: NW -Location: 1000491 -Invoice# Date Order# Line# Item# TX Qty Cost --------------------------------------------------------------------------------------------------------------------------------- - - -IN150228 20150228 OR150201 002 ITEM_NUMBER_47 00000086 49.99 - Invoice Total: 000000086 49.99 - - - Branch Total: 000000086 49.99 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -Run:02/25/2015 153000 NEXT PAGE ISSUE Page 32 -Region: NW -Location: 1000611 -Invoice# Date Order# Line# Item# TX Qty Cost --------------------------------------------------------------------------------------------------------------------------------- - - -IN150227 20150227 OR150224 097 ITEM_NUMBER_11 00000080 19.99 - Invoice Total: 000000080 19.99 - - - Branch Total: 000000080 19.99 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -Run:02/25/2015 153000 NEXT PAGE ISSUE Page 33 -Region: NW -Location: 1000631 -Invoice# Date Order# Line# Item# TX Qty Cost --------------------------------------------------------------------------------------------------------------------------------- - - -IN150207 20150207 OR150206 031 ITEM_NUMBER_49 00000015 49.99 - Invoice Total: 000000015 49.99 - -IN150214 20150214 OR150210 054 ITEM_NUMBER_40 00000042 49.99 - Invoice Total: 000000042 49.99 - -IN150224 20150224 OR150218 024 ITEM_NUMBER_84 00000033 89.99 - Invoice Total: 000000033 89.99 - - - Branch Total: 000000090 189.97 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -Run:02/25/2015 153000 NEXT PAGE ISSUE Page 34 -Region: NW -Location: 1000651 -Invoice# Date Order# Line# Item# TX Qty Cost --------------------------------------------------------------------------------------------------------------------------------- - - -IN150206 20150206 OR150225 099 ITEM_NUMBER_57 00000043 59.99 - Invoice Total: 000000043 59.99 - - - Branch Total: 000000043 59.99 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -Run:02/25/2015 153000 NEXT PAGE ISSUE Page 35 -Region: NW -Location: 1000671 -Invoice# Date Order# Line# Item# TX Qty Cost --------------------------------------------------------------------------------------------------------------------------------- - - -IN150213 20150213 OR150224 041 ITEM_NUMBER_22 00000002 29.99 - Invoice Total: 000000002 29.99 - - - Branch Total: 000000002 29.99 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -Run:02/25/2015 153000 NEXT PAGE ISSUE Page 36 -Region: NW -Location: 1000691 -Invoice# Date Order# Line# Item# TX Qty Cost --------------------------------------------------------------------------------------------------------------------------------- - - -IN150204 20150204 OR150211 092 ITEM_NUMBER_13 00000094 19.99 - Invoice Total: 000000094 19.99 - - - Branch Total: 000000094 19.99 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -Run:02/25/2015 153000 NEXT PAGE ISSUE Page 37 -Region: NW -Location: 1000811 -Invoice# Date Order# Line# Item# TX Qty Cost --------------------------------------------------------------------------------------------------------------------------------- - - -IN150227 20150227 OR150217 081 ITEM_NUMBER_45 00000016 49.99 - Invoice Total: 000000016 49.99 - - - Branch Total: 000000016 49.99 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -Run:02/25/2015 153000 NEXT PAGE ISSUE Page 38 -Region: NW -Location: 1000851 -Invoice# Date Order# Line# Item# TX Qty Cost --------------------------------------------------------------------------------------------------------------------------------- - - -IN150208 20150208 OR150203 091 ITEM_NUMBER_63 00000066 69.99 - Invoice Total: 000000066 69.99 - - - Branch Total: 000000066 69.99 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -Run:02/25/2015 153000 NEXT PAGE ISSUE Page 39 -Region: NW -Location: 1000871 -Invoice# Date Order# Line# Item# TX Qty Cost --------------------------------------------------------------------------------------------------------------------------------- - - -IN150218 20150218 OR150209 082 ITEM_NUMBER_30 00000055 39.99 - Invoice Total: 000000055 39.99 - -IN150228 20150228 OR150222 015 ITEM_NUMBER_73 00000051 79.99 - Invoice Total: 000000051 79.99 - - - Branch Total: 000000106 119.98 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -Run:02/25/2015 153000 NEXT PAGE ISSUE Page 40 -Region: NW -Location: 1000891 -Invoice# Date Order# Line# Item# TX Qty Cost --------------------------------------------------------------------------------------------------------------------------------- - - -IN150225 20150225 OR150201 026 ITEM_NUMBER_80 00000047 89.99 - Invoice Total: 000000047 89.99 - - - Branch Total: 000000047 89.99 - - Region Total: 000001496 1859.70 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -Run:02/25/2015 153000 NEXT PAGE ISSUE Page 41 -Region: SE -Location: 1000001 -Invoice# Date Order# Line# Item# TX Qty Cost --------------------------------------------------------------------------------------------------------------------------------- - - -IN150223 20150223 OR150203 064 ITEM_NUMBER_03 00000071 9.99 - Invoice Total: 000000071 9.99 - - - Branch Total: 000000071 9.99 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -Run:02/25/2015 153000 NEXT PAGE ISSUE Page 42 -Region: SE -Location: 1000011 -Invoice# Date Order# Line# Item# TX Qty Cost --------------------------------------------------------------------------------------------------------------------------------- - - -IN150201 20150201 OR150213 017 ITEM_NUMBER_09 00000006 9.99 - Invoice Total: 000000006 9.99 - -IN150212 20150212 OR150209 066 ITEM_NUMBER_06 00000040 9.99 - Invoice Total: 000000040 9.99 - - - Branch Total: 000000046 19.98 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -Run:02/25/2015 153000 NEXT PAGE ISSUE Page 43 -Region: SE -Location: 1000091 -Invoice# Date Order# Line# Item# TX Qty Cost --------------------------------------------------------------------------------------------------------------------------------- - - -IN150204 20150204 OR150201 001 ITEM_NUMBER_68 00000019 69.99 - Invoice Total: 000000019 69.99 - -IN150210 20150210 OR150223 084 ITEM_NUMBER_11 00000093 19.99 - Invoice Total: 000000093 19.99 - -IN150226 20150226 OR150219 038 ITEM_NUMBER_97 00000037 99.99 - Invoice Total: 000000037 99.99 - - - Branch Total: 000000149 189.97 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -Run:02/25/2015 153000 NEXT PAGE ISSUE Page 44 -Region: SE -Location: 1000211 -Invoice# Date Order# Line# Item# TX Qty Cost --------------------------------------------------------------------------------------------------------------------------------- - - -IN150206 20150206 OR150221 089 ITEM_NUMBER_05 00000045 9.99 - Invoice Total: 000000045 9.99 - - - Branch Total: 000000045 9.99 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -Run:02/25/2015 153000 NEXT PAGE ISSUE Page 45 -Region: SE -Location: 1000411 -Invoice# Date Order# Line# Item# TX Qty Cost --------------------------------------------------------------------------------------------------------------------------------- - - -IN150212 20150212 OR150208 012 ITEM_NUMBER_46 00000023 49.99 - Invoice Total: 000000023 49.99 - - - Branch Total: 000000023 49.99 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -Run:02/25/2015 153000 NEXT PAGE ISSUE Page 46 -Region: SE -Location: 1000431 -Invoice# Date Order# Line# Item# TX Qty Cost --------------------------------------------------------------------------------------------------------------------------------- - - -IN150207 20150207 OR150214 072 ITEM_NUMBER_25 00000046 29.99 - Invoice Total: 000000046 29.99 - -IN150225 20150225 OR150220 040 ITEM_NUMBER_01 00000061 9.99 - Invoice Total: 000000061 9.99 - - - Branch Total: 000000107 39.98 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -Run:02/25/2015 153000 NEXT PAGE ISSUE Page 47 -Region: SE -Location: 1000451 -Invoice# Date Order# Line# Item# TX Qty Cost --------------------------------------------------------------------------------------------------------------------------------- - - -IN150214 20150214 OR150204 022 ITEM_NUMBER_34 00000047 39.99 - Invoice Total: 000000047 39.99 - - - Branch Total: 000000047 39.99 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -Run:02/25/2015 153000 NEXT PAGE ISSUE Page 48 -Region: SE -Location: 1000471 -Invoice# Date Order# Line# Item# TX Qty Cost --------------------------------------------------------------------------------------------------------------------------------- - - -IN150203 20150203 OR150217 010 ITEM_NUMBER_25 00000034 29.99 - Invoice Total: 000000034 29.99 - -IN150211 20150211 OR150213 025 ITEM_NUMBER_54 00000092 59.99 - Invoice Total: 000000092 59.99 - - - Branch Total: 000000126 89.98 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -Run:02/25/2015 153000 NEXT PAGE ISSUE Page 49 -Region: SE -Location: 1000491 -Invoice# Date Order# Line# Item# TX Qty Cost --------------------------------------------------------------------------------------------------------------------------------- - - -IN150202 20150202 OR150202 013 ITEM_NUMBER_19 00000078 19.99 - Invoice Total: 000000078 19.99 - - - Branch Total: 000000078 19.99 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -Run:02/25/2015 153000 NEXT PAGE ISSUE Page 50 -Region: SE -Location: 1000601 -Invoice# Date Order# Line# Item# TX Qty Cost --------------------------------------------------------------------------------------------------------------------------------- - - -IN150224 20150224 OR150210 039 ITEM_NUMBER_19 00000056 19.99 - Invoice Total: 000000056 19.99 - - - Branch Total: 000000056 19.99 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -Run:02/25/2015 153000 NEXT PAGE ISSUE Page 51 -Region: SE -Location: 1000631 -Invoice# Date Order# Line# Item# TX Qty Cost --------------------------------------------------------------------------------------------------------------------------------- - - -IN150201 20150201 OR150216 003 ITEM_NUMBER_65 00000011 69.99 - Invoice Total: 000000011 69.99 - - - Branch Total: 000000011 69.99 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -Run:02/25/2015 153000 NEXT PAGE ISSUE Page 52 -Region: SE -Location: 1000671 -Invoice# Date Order# Line# Item# TX Qty Cost --------------------------------------------------------------------------------------------------------------------------------- - - -IN150203 20150203 OR150205 071 ITEM_NUMBER_64 00000094 69.99 - Invoice Total: 000000094 69.99 - -IN150220 20150220 OR150214 032 ITEM_NUMBER_53 00000059 59.99 - Invoice Total: 000000059 59.99 - - - Branch Total: 000000153 129.98 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -Run:02/25/2015 153000 NEXT PAGE ISSUE Page 53 -Region: SE -Location: 1000891 -Invoice# Date Order# Line# Item# TX Qty Cost --------------------------------------------------------------------------------------------------------------------------------- - - -IN150226 20150226 OR150229 068 ITEM_NUMBER_75 00000084 79.99 - Invoice Total: 000000084 79.99 - - - Branch Total: 000000084 79.99 - - Region Total: 000000996 769.81 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -Run:02/25/2015 153000 NEXT PAGE ISSUE Page 54 -Region: SW -Location: 1000011 -Invoice# Date Order# Line# Item# TX Qty Cost --------------------------------------------------------------------------------------------------------------------------------- - - -IN150202 20150202 OR150206 000 ITEM_NUMBER_30 00000059 39.99 - Invoice Total: 000000059 39.99 - - - Branch Total: 000000059 39.99 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -Run:02/25/2015 153000 NEXT PAGE ISSUE Page 55 -Region: SW -Location: 1000031 -Invoice# Date Order# Line# Item# TX Qty Cost --------------------------------------------------------------------------------------------------------------------------------- - - -IN150203 20150203 OR150214 033 ITEM_NUMBER_09 00000060 9.99 - Invoice Total: 000000060 9.99 - -IN150206 20150206 OR150206 021 ITEM_NUMBER_91 00000054 99.99 - Invoice Total: 000000054 99.99 - - - Branch Total: 000000114 109.98 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -Run:02/25/2015 153000 NEXT PAGE ISSUE Page 56 -Region: SW -Location: 1000091 -Invoice# Date Order# Line# Item# TX Qty Cost --------------------------------------------------------------------------------------------------------------------------------- - - -IN150223 20150223 OR150221 028 ITEM_NUMBER_67 00000039 69.99 - Invoice Total: 000000039 69.99 - - - Branch Total: 000000039 69.99 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -Run:02/25/2015 153000 NEXT PAGE ISSUE Page 57 -Region: SW -Location: 1000201 -Invoice# Date Order# Line# Item# TX Qty Cost --------------------------------------------------------------------------------------------------------------------------------- - - -IN150209 20150209 OR150205 065 ITEM_NUMBER_21 00000070 29.99 - Invoice Total: 000000070 29.99 - -IN150225 20150225 OR150203 052 ITEM_NUMBER_55 00000075 59.99 - 067 ITEM_NUMBER_83 00000015 89.99 - Invoice Total: 000000090 149.98 - - - Branch Total: 000000160 179.97 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -Run:02/25/2015 153000 NEXT PAGE ISSUE Page 58 -Region: SW -Location: 1000211 -Invoice# Date Order# Line# Item# TX Qty Cost --------------------------------------------------------------------------------------------------------------------------------- - - -IN150202 20150202 OR150221 055 ITEM_NUMBER_16 00000013 19.99 - Invoice Total: 000000013 19.99 - -IN150208 20150208 OR150215 007 ITEM_NUMBER_97 00000089 99.99 - Invoice Total: 000000089 99.99 - - - Branch Total: 000000102 119.98 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -Run:02/25/2015 153000 NEXT PAGE ISSUE Page 59 -Region: SW -Location: 1000271 -Invoice# Date Order# Line# Item# TX Qty Cost --------------------------------------------------------------------------------------------------------------------------------- - - -IN150211 20150211 OR150228 080 ITEM_NUMBER_45 00000052 49.99 - Invoice Total: 000000052 49.99 - -IN150213 20150213 OR150207 095 ITEM_NUMBER_09 00000054 9.99 - Invoice Total: 000000054 9.99 - - - Branch Total: 000000106 59.98 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -Run:02/25/2015 153000 NEXT PAGE ISSUE Page 60 -Region: SW -Location: 1000401 -Invoice# Date Order# Line# Item# TX Qty Cost --------------------------------------------------------------------------------------------------------------------------------- - - -IN150228 20150228 OR150202 027 ITEM_NUMBER_83 00000001 89.99 - Invoice Total: 000000001 89.99 - - - Branch Total: 000000001 89.99 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -Run:02/25/2015 153000 NEXT PAGE ISSUE Page 61 -Region: SW -Location: 1000411 -Invoice# Date Order# Line# Item# TX Qty Cost --------------------------------------------------------------------------------------------------------------------------------- - - -IN150210 20150210 OR150220 073 ITEM_NUMBER_63 00000014 69.99 - Invoice Total: 000000014 69.99 - - - Branch Total: 000000014 69.99 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -Run:02/25/2015 153000 NEXT PAGE ISSUE Page 62 -Region: SW -Location: 1000431 -Invoice# Date Order# Line# Item# TX Qty Cost --------------------------------------------------------------------------------------------------------------------------------- - - -IN150208 20150208 OR150227 078 ITEM_NUMBER_23 00000052 29.99 - Invoice Total: 000000052 29.99 - -IN150220 20150220 OR150227 006 ITEM_NUMBER_50 00000085 59.99 - Invoice Total: 000000085 59.99 - - - Branch Total: 000000137 89.98 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -Run:02/25/2015 153000 NEXT PAGE ISSUE Page 63 -Region: SW -Location: 1000601 -Invoice# Date Order# Line# Item# TX Qty Cost --------------------------------------------------------------------------------------------------------------------------------- - - -IN150206 20150206 OR150201 011 ITEM_NUMBER_73 00000084 79.99 - Invoice Total: 000000084 79.99 - - - Branch Total: 000000084 79.99 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -Run:02/25/2015 153000 NEXT PAGE ISSUE Page 64 -Region: SW -Location: 1000611 -Invoice# Date Order# Line# Item# TX Qty Cost --------------------------------------------------------------------------------------------------------------------------------- - - -IN150206 20150206 OR150218 019 ITEM_NUMBER_67 00000061 69.99 - Invoice Total: 000000061 69.99 - - - Branch Total: 000000061 69.99 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -Run:02/25/2015 153000 NEXT PAGE ISSUE Page 65 -Region: SW -Location: 1000651 -Invoice# Date Order# Line# Item# TX Qty Cost --------------------------------------------------------------------------------------------------------------------------------- - - -IN150209 20150209 OR150224 009 ITEM_NUMBER_23 00000018 29.99 - Invoice Total: 000000018 29.99 - - - Branch Total: 000000018 29.99 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -Run:02/25/2015 153000 NEXT PAGE ISSUE Page 66 -Region: SW -Location: 1000831 -Invoice# Date Order# Line# Item# TX Qty Cost --------------------------------------------------------------------------------------------------------------------------------- - - -IN150201 20150201 OR150221 046 ITEM_NUMBER_44 00000069 49.99 - Invoice Total: 000000069 49.99 - -IN150220 20150220 OR150213 005 ITEM_NUMBER_44 00000037 49.99 - Invoice Total: 000000037 49.99 - -IN150222 20150222 OR150213 058 ITEM_NUMBER_86 00000083 89.99 - Invoice Total: 000000083 89.99 - - - Branch Total: 000000189 189.97 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -Run:02/25/2015 153000 NEXT PAGE ISSUE Page 67 -Region: SW -Location: 1000871 -Invoice# Date Order# Line# Item# TX Qty Cost --------------------------------------------------------------------------------------------------------------------------------- - - -IN150202 20150202 OR150216 016 ITEM_NUMBER_62 00000083 69.99 - Invoice Total: 000000083 69.99 - - Branch Total: 000000083 69.99 - - Region Total: 000001167 1269.78 - - Grand Total: 000005315 5629.00 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_reportwriter.at:8941: diff reference report.txt" -at_fn_check_prepare_trace "run_reportwriter.at:8941" -( $at_check_trace; diff reference report.txt -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_reportwriter.at:8941" -$at_failed && at_fn_log_failure \ -"./report.txt" -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_818 -#AT_START_819 -at_fn_group_banner 819 'run_reportwriter.at:8946' \ - "Report PRESENT AFTER" " " 4 -at_xfail=no -( - $as_echo "819. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >inp_data <<'_ATEOF' -SAINATH KOTGIRE 30/03/201611029473 20 00100000 00000100 -UDAY PRATIVADI 30/03/201604547552 20 00100000 00000200 -MILIND PARDESHI 30/03/201611256856 20 00100000 00000300 -AJIT PATIL 30/03/201610503086 20 00000500 00000400 -VINOD KAMBLE 30/03/201615487558 20 00100000 00000500 -SACHIN TENDUNLKAR 30/03/201614645425 20 00500000 00000600 -_ATEOF - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - INPUT-OUTPUT SECTION. - FILE-CONTROL. - - SELECT IN-FILE ASSIGN TO EXTERNAL INFILE - LINE SEQUENTIAL - FILE STATUS IS WS-INPUT-STATUS. - - SELECT OUT-FILE ASSIGN TO EXTERNAL OREPORT - LINE SEQUENTIAL - FILE STATUS IS WS-OUTPUT-STATUS. - - DATA DIVISION. - - FILE SECTION. - - FD IN-FILE - RECORDING MODE IS F - BLOCK 0. - - 01 IN-REC. - 05 IN-EMP-NAME PIC X(25). - 05 IN-REPORT-PERIOD PIC X(10). - 05 IN-EMP-USERID PIC X(10). - 05 IN-BILL-DAYS PIC X(3). - 05 IN-SALARY PIC 9(8). - 05 FILLER PIC X(34). - - FD OUT-FILE - RECORDING MODE IS F - REPORT IS REPORT1. - - 01 REP-REC PIC X(100). - - WORKING-STORAGE SECTION. - 01 WS-FILE-FLAGS. - 05 WS-INPUT-STATUS PIC XX. - 88 WS-INPUT-OK VALUE '00'. - 88 WS-INPUT-EOF VALUE '10'. - 05 WS-OUTPUT-STATUS PIC XX. - 88 WS-OUTPUT-OK VALUE '00'. - *-----------------------------------------------------------* - * MISCELLANOUS FIELDS * - *-----------------------------------------------------------* - 01 WS-MISC. - 05 WS-EMP-NAME PIC X(25). - 05 WS-REPORT-PERIOD PIC X(10). - 05 WS-EMP-USERID PIC X(10). - 05 WS-BILL-DAYS PIC X(3). - 05 WS-SALARY PIC 9(8). - - 01 WS-MISC-DATE. - 05 WS-DATE PIC 9(8) VALUE 20160422. - 05 WS-TIME PIC 9(8) VALUE 10550000. - 05 FILLER REDEFINES WS-TIME. - 10 WS-HH PIC 99. - 10 WS-MI PIC 99. - 10 WS-SS PIC 99. - 10 WS-HU PIC 99. - - REPORT SECTION. - - RD REPORT1 - PAGE LIMIT IS 65 LINES - LINE LIMIT 132 - HEADING 1 - CONTROL ARE WS-SALARY. - - 01 MAIN-HEADER TYPE IS PAGE HEADING. - 05 LINE 1. - 10 COLUMN CENTER 45 PIC X(35) VALUE - 'STARK TECHNOLOGIES MONTHLY REPORT'. - - 05 LINE 2. - 10 COLUMN CENTER 45 PIC X(50) VALUE ALL '-'. - - 05 LINE 3. - 10 COLUMN 02 PIC X(14) VALUE 'REPORT PERIOD:'. - 10 COLUMN 20 PIC 9999/99/99 SOURCE WS-DATE. - 10 COLUMN 32 PIC 99 SOURCE WS-HH. - 10 COLUMN 34 PIC X VALUE ':'. - 10 COLUMN 35 PIC 99 SOURCE WS-MI. - - 01 TYPE IS CONTROL HEADING - FOR WS-SALARY OR PAGE. - 05 LINE PLUS 2 PRESENT AFTER NEW WS-SALARY. - 10 COLUMN 6 PIC X(9) VALUE 'EMP NAME:'. - 10 COLUMN 30 PIC X(13) VALUE 'EMP USERID:'. - 10 COLUMN 60 PIC X(13) VALUE 'BILLING DAYS'. - 10 COLUMN 80 PIC X(15) VALUE 'SALARY CREDITED'. - 05 LINE PLUS 1 PRESENT AFTER NEW WS-SALARY. - 10 COLUMN 2 PIC X(100) VALUE ALL '+'. - - 01 DETAIL-1 TYPE DETAIL. - 05 LINE PLUS 1. - 10 COLUMN 6 PIC X(25) SOURCE WS-EMP-NAME. - 10 COLUMN 30 PIC X(08) SOURCE WS-EMP-USERID. - 10 COLUMN 60 PIC X(3) SOURCE WS-BILL-DAYS. - 10 COLUMN 80 PIC Z(7)9 SOURCE WS-SALARY. - - 01 REP-FOOTER TYPE DETAIL. - 05 LINE PLUS 2. - 10 COLUMN 2 PIC X(100) VALUE ALL '*'. - 05 LINE PLUS 1. - 10 COLUMN 30 PIC X(23) VALUE 'END OF SALARY REPORT'. - 05 LINE PLUS 1. - 10 COLUMN 2 PIC X(100) VALUE ALL '*'. - - PROCEDURE DIVISION. - - * ACCEPT WS-DATE FROM DATE YYYYMMDD. - * ACCEPT WS-TIME FROM TIME. - - INITIATE REPORT1 - - * GENERATE MAIN-HEADER - - PERFORM 100-OPEN-FILES - PERFORM 200-MAIN-PROCESS - - TERMINATE REPORT1 - - CLOSE IN-FILE - CLOSE OUT-FILE - STOP RUN. - - 100-OPEN-FILES. - - OPEN INPUT IN-FILE - - IF WS-INPUT-OK - CONTINUE - ELSE - DISPLAY 'ERROR OPENING INFILE FILE.STATUS = ' - WS-INPUT-STATUS - STOP RUN - END-IF - - OPEN OUTPUT OUT-FILE - - IF WS-OUTPUT-OK - INITIALIZE REP-REC - ELSE - DISPLAY 'ERROR OPENING OREPORT FILE.STATUS = ' - WS-OUTPUT-STATUS - STOP RUN - END-IF. - - 200-MAIN-PROCESS. - * GENERATE HEADER-1 - - PERFORM UNTIL WS-INPUT-EOF - READ IN-FILE - MOVE IN-REC TO WS-MISC - EVALUATE WS-INPUT-STATUS - WHEN '00' - GENERATE DETAIL-1 - WHEN '10' - GENERATE REP-FOOTER - WHEN OTHER - DISPLAY ':ERROR READING INFILE FILE.STATUS = ' - WS-INPUT-STATUS - STOP RUN - END-EVALUATE - END-PERFORM. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_reportwriter.at:9128: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_reportwriter.at:9128" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_reportwriter.at:9128" -$at_failed && at_fn_log_failure -$at_traceon; } - - -{ set +x -$as_echo "$at_srcdir/run_reportwriter.at:9130: DD_INFILE=./inp_data DD_OREPORT=./report.txt \\ -\$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_notrace 'an embedded newline' "run_reportwriter.at:9130" -( $at_check_trace; DD_INFILE=./inp_data DD_OREPORT=./report.txt \ -$COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_reportwriter.at:9130" -$at_failed && at_fn_log_failure -$at_traceon; } - - - - - -cat >reference <<'_ATEOF' - STARK TECHNOLOGIES MONTHLY REPORT - -------------------------------------------------- - REPORT PERIOD: 2016/04/22 10:55 - - EMP NAME: EMP USERID: BILLING DAYS SALARY CREDITED - ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - SAINATH KOTGIRE 11029473 20 100000 - UDAY PRATIVADI 04547552 20 100000 - MILIND PARDESHI 11256856 20 100000 - - EMP NAME: EMP USERID: BILLING DAYS SALARY CREDITED - ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - AJIT PATIL 10503086 20 500 - - EMP NAME: EMP USERID: BILLING DAYS SALARY CREDITED - ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - VINOD KAMBLE 15487558 20 100000 - - EMP NAME: EMP USERID: BILLING DAYS SALARY CREDITED - ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - SACHIN TENDUNLKAR 14645425 20 500000 - - **************************************************************************************************** - END OF SALARY REPORT - **************************************************************************************************** - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_reportwriter.at:9203: diff reference report.txt" -at_fn_check_prepare_trace "run_reportwriter.at:9203" -( $at_check_trace; diff reference report.txt -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_reportwriter.at:9203" -$at_failed && at_fn_log_failure \ -"./report.txt" -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_819 -#AT_START_820 -at_fn_group_banner 820 'run_returncode.at:23' \ - "RETURN-CODE moving" " " 4 -at_xfail=no -( - $as_echo "820. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 I PIC 99 COMP. - PROCEDURE DIVISION. - INITIALIZE RETURN-CODE. - MOVE ZERO TO RETURN-CODE. - MOVE 1 TO RETURN-CODE. - MOVE RETURN-CODE TO I. - IF I NOT = 1 - DISPLAY I NO ADVANCING - END-DISPLAY - END-IF. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_returncode.at:44: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_returncode.at:44" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_returncode.at:44" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_returncode.at:45: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_returncode.at:45" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/run_returncode.at:45" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_820 -#AT_START_821 -at_fn_group_banner 821 'run_returncode.at:49' \ - "RETURN-CODE passing" " " 4 -at_xfail=no -( - $as_echo "821. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >mod1.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. mod1. - PROCEDURE DIVISION. - IF RETURN-CODE NOT = 0 - DISPLAY RETURN-CODE NO ADVANCING - END-DISPLAY - END-IF. - MOVE 1 TO RETURN-CODE. - IF RETURN-CODE NOT = 1 - DISPLAY RETURN-CODE NO ADVANCING - END-DISPLAY - END-IF. - EXIT PROGRAM. -_ATEOF - - -cat >mod2.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. mod2. - PROCEDURE DIVISION. - EXIT PROGRAM. -_ATEOF - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - PROCEDURE DIVISION. - CALL "mod1" - END-CALL. - IF RETURN-CODE NOT = 1 - DISPLAY RETURN-CODE NO ADVANCING - END-DISPLAY - END-IF. - CALL "mod2" - END-CALL. - IF RETURN-CODE NOT = 0 - DISPLAY RETURN-CODE NO ADVANCING - END-DISPLAY - END-IF. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_returncode.at:94: \$COMPILE_MODULE mod1.cob" -at_fn_check_prepare_dynamic "$COMPILE_MODULE mod1.cob" "run_returncode.at:94" -( $at_check_trace; $COMPILE_MODULE mod1.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_returncode.at:94" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_returncode.at:95: \$COMPILE_MODULE mod2.cob" -at_fn_check_prepare_dynamic "$COMPILE_MODULE mod2.cob" "run_returncode.at:95" -( $at_check_trace; $COMPILE_MODULE mod2.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_returncode.at:95" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_returncode.at:96: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_returncode.at:96" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_returncode.at:96" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_returncode.at:97: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_returncode.at:97" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_returncode.at:97" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_821 -#AT_START_822 -at_fn_group_banner 822 'run_returncode.at:101' \ - "RETURN-CODE nested" " " 4 -at_xfail=no -( - $as_echo "822. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - PROCEDURE DIVISION. - MOVE 1 TO RETURN-CODE. - IF RETURN-CODE NOT = 1 - DISPLAY RETURN-CODE NO ADVANCING - END-DISPLAY - END-IF. - CALL "mod1" - END-CALL. - IF RETURN-CODE NOT = 2 - DISPLAY RETURN-CODE NO ADVANCING - END-DISPLAY - END-IF. - MOVE ZERO TO RETURN-CODE. - STOP RUN. - PROGRAM-ID. mod1. - PROCEDURE DIVISION. - IF RETURN-CODE NOT = 1 - DISPLAY RETURN-CODE NO ADVANCING - END-DISPLAY - END-IF. - MOVE 2 TO RETURN-CODE. - EXIT PROGRAM. - END PROGRAM mod1. - END PROGRAM prog. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_returncode.at:133: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_returncode.at:133" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_returncode.at:133" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_returncode.at:134: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_returncode.at:134" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_returncode.at:134" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_822 -#AT_START_823 -at_fn_group_banner 823 'run_functions.at:24' \ - "FUNCTION ABS" " " 4 -at_xfail=no -( - $as_echo "823. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 X PIC S9(4)V9(4) VALUE -1.2345. - PROCEDURE DIVISION. - DISPLAY FUNCTION ABS ( X ) NO ADVANCING - END-DISPLAY. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_functions.at:39: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_functions.at:39" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_functions.at:39" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_functions.at:40: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_functions.at:40" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo "+0001.2345" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_functions.at:40" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_823 -#AT_START_824 -at_fn_group_banner 824 'run_functions.at:46' \ - "FUNCTION ACOS" " " 4 -at_xfail=no -( - $as_echo "824. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 Z PIC S9V9(35). - PROCEDURE DIVISION. - MOVE FUNCTION ACOS ( -0.2345 ) TO Z. - IF Z NOT = 1.80750052110824343510150043852321026 - DISPLAY Z - END-DISPLAY - END-IF. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_functions.at:64: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_functions.at:64" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_functions.at:64" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_functions.at:65: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_functions.at:65" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_functions.at:65" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_824 -#AT_START_825 -at_fn_group_banner 825 'run_functions.at:70' \ - "FUNCTION ANNUITY" " " 4 -at_xfail=no -( - $as_echo "825. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 Z PIC S9V9(35). - PROCEDURE DIVISION. - MOVE FUNCTION ANNUITY ( 3, 5 ) TO Z. - IF Z NOT = 3.00293255131964809384164222873900293 - DISPLAY Z - END-DISPLAY - END-IF. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_functions.at:88: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_functions.at:88" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_functions.at:88" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_functions.at:89: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_functions.at:89" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_functions.at:89" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_825 -#AT_START_826 -at_fn_group_banner 826 'run_functions.at:94' \ - "FUNCTION ASIN" " " 4 -at_xfail=no -( - $as_echo "826. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 Y PIC S9V9(35). - PROCEDURE DIVISION. - MOVE FUNCTION ASIN ( -0.2345 ) TO Y. - IF Y NOT = -0.23670419431334681587017874688345882 - DISPLAY Y - END-DISPLAY - END-IF. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_functions.at:112: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_functions.at:112" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_functions.at:112" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_functions.at:113: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_functions.at:113" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_functions.at:113" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_826 -#AT_START_827 -at_fn_group_banner 827 'run_functions.at:118' \ - "FUNCTION ATAN" " " 4 -at_xfail=no -( - $as_echo "827. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 Y PIC S9V9(35). - PROCEDURE DIVISION. - MOVE FUNCTION ATAN ( 1 ) TO Y. - IF Y NOT = 0.78539816339744830961566084581987572 - DISPLAY Y - END-DISPLAY - END-IF. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_functions.at:136: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_functions.at:136" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_functions.at:136" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_functions.at:137: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_functions.at:137" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_functions.at:137" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_827 -#AT_START_828 -at_fn_group_banner 828 'run_functions.at:142' \ - "FUNCTION BYTE-LENGTH" " " 4 -at_xfail=no -( - $as_echo "828. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 X PIC X(4). - 01 Z PIC N(4). - 01 TEST-FLD PIC S9(04)V9(08). - PROCEDURE DIVISION. - MOVE FUNCTION BYTE-LENGTH ( X ) - TO TEST-FLD. - IF TEST-FLD NOT = 4 - DISPLAY 'BYTE-LENGTH X(4) wrong: ' TEST-FLD - END-DISPLAY - END-IF - MOVE FUNCTION BYTE-LENGTH ( Z ) - TO TEST-FLD - IF TEST-FLD NOT = 8 - DISPLAY 'BYTE-LENGTH N(4) wrong: ' TEST-FLD - END-DISPLAY - END-IF - - MOVE FUNCTION BYTE-LENGTH ( '00128' ) - TO TEST-FLD - IF TEST-FLD NOT = 5 - DISPLAY 'BYTE-LENGTH "00128" wrong: ' TEST-FLD - END-DISPLAY - END-IF - * note: we currently do not support items of category boolean... - *> MOVE FUNCTION BYTE-LENGTH ( b'100' ) - *> TO TEST-FLD - *> IF TEST-FLD NOT = 3 - *> DISPLAY 'BYTE-LENGTH b"100" wrong: ' TEST-FLD - *> END-DISPLAY - *> END-IF - MOVE FUNCTION BYTE-LENGTH ( x'a0' ) - TO TEST-FLD - IF TEST-FLD NOT = 1 - DISPLAY 'BYTE-LENGTH x"a0" wrong: ' TEST-FLD - END-DISPLAY - END-IF - MOVE FUNCTION BYTE-LENGTH ( z'a0' ) - TO TEST-FLD - IF TEST-FLD NOT = 3 - DISPLAY 'BYTE-LENGTH z"a0" wrong: ' TEST-FLD - END-DISPLAY - END-IF - * we currently generate national constants as - * alphanumeric constants... - * MOVE FUNCTION BYTE-LENGTH ( n'a0' ) - * TO TEST-FLD - * IF TEST-FLD NOT = 4 - * DISPLAY 'BYTE-LENGTH n"a0" wrong: ' TEST-FLD - * END-DISPLAY - * END-IF - - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_functions.at:204: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_functions.at:204" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob:7: warning: handling of USAGE NATIONAL is unfinished; implementation is likely to be changed -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_functions.at:204" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_functions.at:207: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_functions.at:207" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_functions.at:207" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_828 -#AT_START_829 -at_fn_group_banner 829 'run_functions.at:212' \ - "FUNCTION CHAR" " " 4 -at_xfail=no -( - $as_echo "829. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 X PIC S9(4)V9(4) VALUE 108. - 01 TEST-FLD. - 05 TEST-DATA PIC X(01). - 88 VALID-DATA VALUE 'k'. - 05 TEST-UNSET PIC X VALUE '_'. - 88 VALID-UNSET VALUE '_'. - PROCEDURE DIVISION. - STRING FUNCTION CHAR ( X ) - DELIMITED BY SIZE - INTO TEST-FLD - END-STRING. - EVALUATE TRUE - WHEN NOT VALID-UNSET - DISPLAY "FUNCTION result too long" - END-DISPLAY - WHEN VALID-DATA - CONTINUE - WHEN OTHER - DISPLAY TEST-DATA - END-DISPLAY - END-EVALUATE. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_functions.at:244: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_functions.at:244" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_functions.at:244" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_functions.at:245: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_functions.at:245" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_functions.at:245" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_829 -#AT_START_830 -at_fn_group_banner 830 'run_functions.at:250' \ - "FUNCTION COMBINED-DATETIME" " " 4 -at_xfail=no -( - $as_echo "830. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 TEST-FLD PIC S9(04)V9(08). - PROCEDURE DIVISION. - MOVE FUNCTION COMBINED-DATETIME ( 987, 345.6 ) - TO TEST-FLD. - IF TEST-FLD NOT = 987.003456 - DISPLAY TEST-FLD - END-DISPLAY - END-IF. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_functions.at:269: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_functions.at:269" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_functions.at:269" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_functions.at:270: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_functions.at:270" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_functions.at:270" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_830 -#AT_START_831 -at_fn_group_banner 831 'run_functions.at:275' \ - "FUNCTION CONCAT / CONCATENATE" " " 4 -at_xfail=no -( - $as_echo "831. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -# note: CONCAT was added in COBOL 202x with GnuCOBOL's CONCATENATE -# as blueprint -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 Y PIC X(4). - 01 TEST-FLD. - 05 TEST-DATA PIC X(14). - 88 VALID-DATA VALUE 'defxabczz55666'. - 05 TEST-UNSET PIC X VALUE '_'. - 88 VALID-UNSET VALUE '_'. - PROCEDURE DIVISION. - MOVE "defx" TO Y. - STRING FUNCTION CONCATENATE ( Y "abc" "zz" "55" "666" ) - DELIMITED BY SIZE - INTO TEST-FLD - END-STRING. - EVALUATE TRUE - WHEN NOT VALID-UNSET - DISPLAY "FUNCTION result too long" - END-DISPLAY - WHEN TEST-DATA - <> FUNCTION CONCAT ( Y "abc" "zz" "55" "666" ) - DISPLAY "CONCAT issue, '" TEST-DATA - "' vs. '" - FUNCTION CONCAT ( Y "abc" "zz" "55" "666" ) "'" - END-DISPLAY - WHEN VALID-DATA - CONTINUE - WHEN OTHER - DISPLAY TEST-DATA - END-DISPLAY - END-EVALUATE. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_functions.at:316: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_functions.at:316" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_functions.at:316" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_functions.at:317: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_functions.at:317" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_functions.at:317" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_831 -#AT_START_832 -at_fn_group_banner 832 'run_functions.at:322' \ - "FUNCTION CONCATENATE with reference modding" " " 4 -at_xfail=no -( - $as_echo "832. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 Y PIC X(4). - 01 TEST-FLD PIC X(9) VALUE SPACES. - PROCEDURE DIVISION. - MOVE 'defx' TO Y. - MOVE FUNCTION CONCATENATE - ( Y "abc" "zz" "55" "666" ) (2 : 9) - TO TEST-FLD. - IF TEST-FLD NOT = 'efxabczz5' - DISPLAY TEST-FLD - END-DISPLAY - END-IF. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_functions.at:344: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_functions.at:344" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_functions.at:344" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_functions.at:345: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_functions.at:345" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_functions.at:345" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_832 -#AT_START_833 -at_fn_group_banner 833 'run_functions.at:350' \ - "FUNCTION CONTENT-LENGTH" " " 4 -at_xfail=no -( - $as_echo "833. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 P USAGE POINTER. - 01 X PIC X(4) VALUE Z"ABC". - 01 TEST-FLD USAGE BINARY-LONG. - PROCEDURE DIVISION. - MOVE FUNCTION CONTENT-LENGTH ( P ) - TO TEST-FLD. - IF TEST-FLD NOT = 0 - DISPLAY 'CONTENT-LENGTH NULL wrong: ' TEST-FLD - END-DISPLAY - END-IF - SET P TO ADDRESS OF X - MOVE FUNCTION CONTENT-LENGTH ( P ) - TO TEST-FLD - IF TEST-FLD NOT = 3 - DISPLAY 'CONTENT-LENGTH z"abc" wrong: ' TEST-FLD - END-DISPLAY - END-IF - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_functions.at:378: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_functions.at:378" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_functions.at:378" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_functions.at:379: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_functions.at:379" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_functions.at:379" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_833 -#AT_START_834 -at_fn_group_banner 834 'run_functions.at:384' \ - "FUNCTION CONTENT-OF" " " 4 -at_xfail=no -( - $as_echo "834. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 P USAGE POINTER. - 01 X PIC X(4) VALUE Z"ABC". - 01 B PIC X(10) BASED. - PROCEDURE DIVISION. - SET P TO ADDRESS OF X - IF FUNCTION CONTENT-OF ( P ) NOT EQUAL 'ABC' THEN - DISPLAY 'CONTENT-OF(ptr) wrong' END-DISPLAY - END-IF - IF FUNCTION CONTENT-OF ( P, 2 ) NOT EQUAL 'AB' THEN - DISPLAY 'CONTENT-OF(ptr, len) wrong' END-DISPLAY - END-IF - IF FUNCTION EXCEPTION-STATUS NOT = SPACES THEN - DISPLAY 'unexpected exception (1): ' - FUNCTION EXCEPTION-STATUS - END-DISPLAY - END-IF - SET P TO NULL - MOVE 'PPPP' TO X - STRING FUNCTION CONTENT-OF ( P ) - DELIMITED BY SIZE - INTO X - END-STRING - *> Note: result *should* depend on dialect option zero-length literals - IF X NOT EQUAL 'PPPP' THEN - DISPLAY 'CONTENT-OF empty POINTER wrong: "' X "'" - END-DISPLAY - END-IF - IF FUNCTION EXCEPTION-STATUS NOT = "EC-DATA-PTR-NULL" THEN - DISPLAY 'missing exception (1)' - END-DISPLAY - END-IF - ALLOCATE B INITIALIZED - SET P TO ADDRESS OF B - IF FUNCTION CONTENT-OF ( P, 1 ) NOT EQUAL SPACES THEN - DISPLAY 'CONTENT-OF allocated BASED item wrong' - END-DISPLAY - END-IF - IF FUNCTION EXCEPTION-STATUS NOT = SPACES THEN - DISPLAY 'unexpected exception (2): ' - FUNCTION EXCEPTION-STATUS - END-DISPLAY - END-IF - FREE B - SET P TO ADDRESS OF B - MOVE 'BBBB' TO X - STRING FUNCTION CONTENT-OF ( P ) - DELIMITED BY SIZE - INTO X - END-STRING - *> Note: result *should* depend on dialect option zero-length literals - IF X NOT EQUAL 'BBBB' THEN - DISPLAY 'CONTENT-OF unallocated BASED item wrong: "' X '"' - END-DISPLAY - END-IF - IF FUNCTION EXCEPTION-STATUS NOT = "EC-DATA-PTR-NULL" THEN - DISPLAY 'missing exception (2)' - END-DISPLAY - END-IF - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_functions.at:453: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_functions.at:453" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_functions.at:453" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_functions.at:454: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_functions.at:454" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_functions.at:454" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_834 -#AT_START_835 -at_fn_group_banner 835 'run_functions.at:459' \ - "FUNCTION as CALL parameter BY CONTENT" " " 4 -at_xfail=no -( - $as_echo "835. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - - PROCEDURE DIVISION. - PROG-MAIN. - CALL "subprog" USING BY CONTENT - FUNCTION CONCATENATE("Abc" "D") - STOP RUN. - END PROGRAM prog. - - *> ***************************** - IDENTIFICATION DIVISION. - PROGRAM-ID. subprog. - - DATA DIVISION. - LINKAGE SECTION. - 01 TESTING PIC X ANY LENGTH. - - PROCEDURE DIVISION USING TESTING. - SUBPROG-MAIN. - DISPLAY TESTING - GOBACK. - END PROGRAM subprog. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_functions.at:488: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_functions.at:488" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_functions.at:488" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_functions.at:489: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_functions.at:489" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo "AbcD -" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_functions.at:489" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_835 -#AT_START_836 -at_fn_group_banner 836 'run_functions.at:495' \ - "FUNCTION COS" " " 4 -at_xfail=no -( - $as_echo "836. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 Y PIC S9V9(35). - PROCEDURE DIVISION. - MOVE FUNCTION COS ( -0.2345 ) TO Y. - IF Y NOT = 0.97263064125625818471341696241456141 - DISPLAY Y - END-DISPLAY - END-IF. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_functions.at:513: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_functions.at:513" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_functions.at:513" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_functions.at:514: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_functions.at:514" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_functions.at:514" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_836 -#AT_START_837 -at_fn_group_banner 837 'run_functions.at:519' \ - "FUNCTION CURRENCY-SYMBOL" " " 4 -at_xfail=no -( - $as_echo "837. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 TEST-FLD PIC X(8) VALUE SPACES. - PROCEDURE DIVISION. - MOVE FUNCTION CURRENCY-SYMBOL TO TEST-FLD. - DISPLAY "OK" NO ADVANCING - END-DISPLAY - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_functions.at:536: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_functions.at:536" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_functions.at:536" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_functions.at:537: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_functions.at:537" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo "OK" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_functions.at:537" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_837 -#AT_START_838 -at_fn_group_banner 838 'run_functions.at:542' \ - "FUNCTION CURRENT-DATE" " " 4 -at_xfail=no -( - $as_echo "838. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 TEST-FLD. - 02 WS-YEAR PIC 9(04). - 88 VALID-YEAR VALUE 1980 THRU 9999. - 02 WS-MONTH PIC 9(02). - 88 VALID-MONTH VALUE 01 THRU 12. - 02 WS-DAY PIC 9(02). - 88 VALID-DAY VALUE 01 THRU 31. - 02 WS-HOUR PIC 9(02). - 88 VALID-HOUR VALUE 00 THRU 23. - 02 WS-MIN PIC 9(02). - 88 VALID-MIN VALUE 00 THRU 59. - 02 WS-SEVALIDD PIC 9(02). - 88 VALID-SEC VALUE 00 THRU 59. - 02 WS-HUNDSEC PIC 9(02). - 88 VALID-HUNDSEC VALUE 00 THRU 99. - 02 WS-GREENW PIC X. - 88 VALID-GREENW VALUE "-", "+", "0". - 88 ZERO-GREENW VALUE "0". - 02 WS-OFFSET PIC 9(02). - 88 VALID-OFFSET VALUE 00 THRU 13. - 88 ZERO-OFFSET VALUE 00. - 02 WS-OFFSET2 PIC 9(02). - 88 VALID-OFFSET2 VALUE 00 THRU 59. - 88 ZERO-OFFSET2 VALUE 00. - 02 WS-UNSET PIC X VALUE '_'. - 88 VALID-UNSET VALUE '_'. - PROCEDURE DIVISION. - STRING FUNCTION CURRENT-DATE - DELIMITED BY SIZE - INTO TEST-FLD - END-STRING. - EVALUATE TRUE - WHEN NOT VALID-UNSET - DISPLAY "FUNCTION result too long" - END-DISPLAY - WHEN VALID-YEAR AND - VALID-MONTH AND - VALID-DAY AND - VALID-HOUR AND - VALID-MIN AND - VALID-SEC AND - VALID-HUNDSEC AND - VALID-GREENW AND - VALID-OFFSET AND - VALID-OFFSET2 AND - VALID-UNSET AND - ((NOT ZERO-GREENW) OR (ZERO-OFFSET AND ZERO-OFFSET2)) - CONTINUE - WHEN OTHER - DISPLAY "CURRENT-DATE with wrong format: " - TEST-FLD (01:21) - END-DISPLAY - END-EVALUATE. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_functions.at:607: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_functions.at:607" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_functions.at:607" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_functions.at:608: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_functions.at:608" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_functions.at:608" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_838 -#AT_START_839 -at_fn_group_banner 839 'run_functions.at:613' \ - "FUNCTION DATE-OF-INTEGER" " " 4 -at_xfail=no -( - $as_echo "839. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 TEST-FLD PIC S9(09)V9(02). - PROCEDURE DIVISION. - MOVE FUNCTION DATE-OF-INTEGER ( 146000 ) - TO TEST-FLD. - IF TEST-FLD NOT = 20000925 - DISPLAY TEST-FLD - END-DISPLAY - END-IF. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_functions.at:632: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_functions.at:632" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_functions.at:632" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_functions.at:633: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_functions.at:633" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_functions.at:633" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_839 -#AT_START_840 -at_fn_group_banner 840 'run_functions.at:638' \ - "FUNCTION DATE-TO-YYYYMMDD" " " 4 -at_xfail=no -( - $as_echo "840. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 TEST-FLD PIC S9(09)V9(02). - PROCEDURE DIVISION. - MOVE FUNCTION DATE-TO-YYYYMMDD ( 981002, -10, 1994 ) - TO TEST-FLD. - IF TEST-FLD NOT = 018981002 - DISPLAY TEST-FLD - END-DISPLAY - END-IF. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_functions.at:657: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_functions.at:657" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_functions.at:657" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_functions.at:658: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_functions.at:658" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_functions.at:658" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_840 -#AT_START_841 -at_fn_group_banner 841 'run_functions.at:663' \ - "FUNCTION DAY-OF-INTEGER" " " 4 -at_xfail=no -( - $as_echo "841. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 TEST-FLD PIC S9(09)V9(02). - PROCEDURE DIVISION. - MOVE FUNCTION DAY-OF-INTEGER ( 146000 ) - TO TEST-FLD. - IF TEST-FLD NOT = 2000269 - DISPLAY TEST-FLD - END-DISPLAY - END-IF. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_functions.at:682: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_functions.at:682" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_functions.at:682" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_functions.at:683: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_functions.at:683" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_functions.at:683" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_841 -#AT_START_842 -at_fn_group_banner 842 'run_functions.at:688' \ - "FUNCTION DAY-TO-YYYYDDD" " " 4 -at_xfail=no -( - $as_echo "842. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 TEST-FLD PIC S9(09)V9(02). - PROCEDURE DIVISION. - MOVE FUNCTION DAY-TO-YYYYDDD ( 95005, -10, 2013 ) - TO TEST-FLD. - IF TEST-FLD NOT = 001995005 - DISPLAY TEST-FLD - END-DISPLAY - END-IF. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_functions.at:707: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_functions.at:707" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_functions.at:707" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_functions.at:708: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_functions.at:708" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_functions.at:708" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_842 -#AT_START_843 -at_fn_group_banner 843 'run_functions.at:713' \ - "FUNCTION E" " " 4 -at_xfail=no -( - $as_echo "843. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 Y PIC 9V9(35). - PROCEDURE DIVISION. - MOVE FUNCTION E TO Y. - IF Y NOT = 2.71828182845904523536028747135266249 - DISPLAY Y - END-DISPLAY - END-IF. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_functions.at:731: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_functions.at:731" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_functions.at:731" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_functions.at:732: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_functions.at:732" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_functions.at:732" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_843 -#AT_START_844 -at_fn_group_banner 844 'run_functions.at:737' \ - "FUNCTION EXCEPTION-FILE" " " 4 -at_xfail=no -( - $as_echo "844. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - INPUT-OUTPUT SECTION. - FILE-CONTROL. - SELECT TEST-FILE ASSIGN "NOTEXIST" - FILE STATUS IS TEST-STATUS. - DATA DIVISION. - FILE SECTION. - FD TEST-FILE. - 01 TEST-REC PIC X(4). - WORKING-STORAGE SECTION. - 01 TEST-STATUS PIC XX. - PROCEDURE DIVISION. - DISPLAY FUNCTION EXCEPTION-FILE '|' - NO ADVANCING - END-DISPLAY. - OPEN INPUT TEST-FILE. - DISPLAY FUNCTION EXCEPTION-FILE - NO ADVANCING - END-DISPLAY. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_functions.at:765: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_functions.at:765" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_functions.at:765" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_functions.at:766: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_functions.at:766" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo "00|35TEST-FILE" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_functions.at:766" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_844 -#AT_START_845 -at_fn_group_banner 845 'run_functions.at:772' \ - "FUNCTION EXCEPTION-LOCATION" " " 4 -at_xfail=no -( - $as_echo "845. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - INPUT-OUTPUT SECTION. - FILE-CONTROL. - SELECT TEST-FILE ASSIGN "NOTEXIST" - FILE STATUS IS TEST-STATUS. - DATA DIVISION. - FILE SECTION. - FD TEST-FILE. - 01 TEST-REC PIC X(4). - WORKING-STORAGE SECTION. - 01 TEST-STATUS PIC XX. - PROCEDURE DIVISION. - A00-MAIN SECTION. - A00. - DISPLAY FUNCTION EXCEPTION-LOCATION '|' - NO ADVANCING - END-DISPLAY. - OPEN INPUT TEST-FILE. - B00-MAIN SECTION. - B00. - DISPLAY FUNCTION EXCEPTION-LOCATION - NO ADVANCING - END-DISPLAY. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_functions.at:804: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_functions.at:804" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_functions.at:804" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_functions.at:805: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_functions.at:805" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo " |prog; A00 OF A00-MAIN; 21" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_functions.at:805" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_845 -#AT_START_846 -at_fn_group_banner 846 'run_functions.at:811' \ - "FUNCTION EXCEPTION-STATEMENT" " " 4 -at_xfail=no -( - $as_echo "846. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - INPUT-OUTPUT SECTION. - FILE-CONTROL. - SELECT TEST-FILE ASSIGN "NOTEXIST" - FILE STATUS IS TEST-STATUS. - DATA DIVISION. - FILE SECTION. - FD TEST-FILE. - 01 TEST-REC PIC X(4). - WORKING-STORAGE SECTION. - 01 TEST-STATUS PIC XX. - PROCEDURE DIVISION. - DISPLAY FUNCTION EXCEPTION-STATEMENT '|' - NO ADVANCING - END-DISPLAY. - OPEN INPUT TEST-FILE. - DISPLAY FUNCTION EXCEPTION-STATEMENT - NO ADVANCING - END-DISPLAY. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_functions.at:839: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_functions.at:839" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_functions.at:839" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_functions.at:840: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_functions.at:840" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo " |OPEN " | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_functions.at:840" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_846 -#AT_START_847 -at_fn_group_banner 847 'run_functions.at:846' \ - "FUNCTION EXCEPTION-STATUS" " " 4 -at_xfail=no -( - $as_echo "847. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - INPUT-OUTPUT SECTION. - FILE-CONTROL. - SELECT TEST-FILE ASSIGN "NOTEXIST" - FILE STATUS IS TEST-STATUS. - DATA DIVISION. - FILE SECTION. - FD TEST-FILE. - 01 TEST-REC PIC X(4). - WORKING-STORAGE SECTION. - 01 TEST-STATUS PIC XX. - PROCEDURE DIVISION. - DISPLAY FUNCTION EXCEPTION-STATUS '|' - NO ADVANCING - END-DISPLAY. - OPEN INPUT TEST-FILE. - DISPLAY FUNCTION EXCEPTION-STATUS - NO ADVANCING - END-DISPLAY. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_functions.at:874: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_functions.at:874" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_functions.at:874" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_functions.at:875: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_functions.at:875" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo " |EC-I-O-PERMANENT-ERROR " | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_functions.at:875" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_847 -#AT_START_848 -at_fn_group_banner 848 'run_functions.at:881' \ - "FUNCTION EXP" " " 4 -at_xfail=no -( - $as_echo "848. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 Y PIC S99V9(34). - PROCEDURE DIVISION. - MOVE FUNCTION EXP ( 3 ) TO Y. - IF Y NOT = 20.0855369231876677409285296545817178 - DISPLAY Y - END-DISPLAY - END-IF. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_functions.at:899: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_functions.at:899" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_functions.at:899" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_functions.at:900: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_functions.at:900" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_functions.at:900" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_848 -#AT_START_849 -at_fn_group_banner 849 'run_functions.at:905' \ - "FUNCTION EXP10" " " 4 -at_xfail=no -( - $as_echo "849. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 TEST-FLD PIC S9(09)V9(02). - PROCEDURE DIVISION. - MOVE FUNCTION EXP10 ( 4 ) - TO TEST-FLD. - IF TEST-FLD NOT = 000010000 - DISPLAY TEST-FLD - END-DISPLAY - END-IF. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_functions.at:924: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_functions.at:924" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_functions.at:924" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_functions.at:925: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_functions.at:925" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_functions.at:925" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_849 -#AT_START_850 -at_fn_group_banner 850 'run_functions.at:930' \ - "FUNCTION FACTORIAL" " " 4 -at_xfail=no -( - $as_echo "850. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 TEST-FLD PIC S9(09)V9(02). - PROCEDURE DIVISION. - MOVE FUNCTION FACTORIAL ( 6 ) - TO TEST-FLD. - IF TEST-FLD NOT = 000000720 - DISPLAY TEST-FLD - END-DISPLAY - END-IF. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_functions.at:949: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_functions.at:949" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_functions.at:949" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_functions.at:950: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_functions.at:950" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_functions.at:950" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_850 -#AT_START_851 -at_fn_group_banner 851 'run_functions.at:955' \ - "FUNCTION FORMATTED-CURRENT-DATE" " " 4 -at_xfail=no -( - $as_echo "851. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 Datetime-Format CONSTANT "YYYYMMDDThhmmss.ss+hhmm". - 01 str PIC X(25). - PROCEDURE DIVISION. - *> Test normal inputs. - MOVE FUNCTION FORMATTED-CURRENT-DATE ( Datetime-Format ) - TO str - IF FUNCTION TEST-FORMATTED-DATETIME ( Datetime-Format, str) - <> 0 - DISPLAY "Test 1 failed: " str END-DISPLAY - END-IF. - - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_functions.at:977: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_functions.at:977" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_functions.at:977" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_functions.at:978: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_functions.at:978" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_functions.at:978" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_851 -#AT_START_852 -at_fn_group_banner 852 'run_functions.at:983' \ - "FUNCTION FORMATTED-DATE" " " 4 -at_xfail=no -( - $as_echo "852. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 str PIC X(10). - PROCEDURE DIVISION. - *> Test normal inputs. - MOVE FUNCTION FORMATTED-DATE ( "YYYYMMDD", 1 ) TO str - IF str <> "16010101" - DISPLAY "Test 1 failed: " str END-DISPLAY - END-IF - - MOVE FUNCTION FORMATTED-DATE ( "YYYY-MM-DD", 1 ) TO str - IF str <> "1601-01-01" - DISPLAY "Test 2 failed: " str END-DISPLAY - END-IF - - MOVE FUNCTION FORMATTED-DATE ( "YYYYDDD", 1 ) TO str - IF str <> "1601001" - DISPLAY "Test 3 failed: " str END-DISPLAY - END-IF - - MOVE FUNCTION FORMATTED-DATE ( "YYYY-DDD", 1 ) TO str - IF str <> "1601-001" - DISPLAY "Test 4 failed: " str END-DISPLAY - END-IF - - MOVE FUNCTION FORMATTED-DATE ( "YYYYWwwD", 1 ) TO str - IF str <> "1601W011" - DISPLAY "Test 5 failed: " str END-DISPLAY - END-IF - - MOVE FUNCTION FORMATTED-DATE ( "YYYY-Www-D", 1 ) TO str - IF str <> "1601-W01-1" - DISPLAY "Test 6 failed: " str END-DISPLAY - END-IF - - *> Test week number edge cases. - *> For 2012-01-01. - MOVE FUNCTION FORMATTED-DATE ( "YYYYWwwD", 150115 ) TO str - IF str <> "2011W527" - DISPLAY "Test 7 failed: " str END-DISPLAY - END-IF - - *> and for 2013-12-30. - MOVE FUNCTION FORMATTED-DATE ( "YYYYWwwD", 150844 ) TO str - IF str <> "2014W011" - DISPLAY "Test 8 failed: " str END-DISPLAY - END-IF - - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_functions.at:1040: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_functions.at:1040" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_functions.at:1040" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_functions.at:1041: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_functions.at:1041" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_functions.at:1041" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_852 -#AT_START_853 -at_fn_group_banner 853 'run_functions.at:1046' \ - "FUNCTION FORMATTED-DATE with ref modding" " " 4 -at_xfail=no -( - $as_echo "853. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 str PIC X(04). - PROCEDURE DIVISION. - MOVE FUNCTION FORMATTED-DATE ("YYYYMMDD", 1) (3:4) - TO STR - IF STR NOT = '0101' - DISPLAY STR - END-DISPLAY - END-IF - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_functions.at:1065: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_functions.at:1065" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_functions.at:1065" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_functions.at:1066: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_functions.at:1066" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_functions.at:1066" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_853 -#AT_START_854 -at_fn_group_banner 854 'run_functions.at:1071' \ - "FUNCTION FORMATTED-DATETIME" " " 4 -at_xfail=no -( - $as_echo "854. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 str PIC X(40). - PROCEDURE DIVISION. - *> Test normal inputs. - MOVE FUNCTION FORMATTED-DATETIME - ("YYYYMMDDThhmmss", 1, 45296) - TO str - IF str <> "16010101T123456" - DISPLAY "Test 1 failed: " str END-DISPLAY - END-IF - - MOVE FUNCTION FORMATTED-DATETIME - ("YYYY-MM-DDThh:mm:ss", 1, 45296) - TO str - IF str <> "1601-01-01T12:34:56" - DISPLAY "Test 2 failed: " str END-DISPLAY - END-IF - - MOVE FUNCTION FORMATTED-DATETIME - ("YYYYDDDThhmmss+hhmm", 1, 45296, -754) - TO str - IF str <> "1601001T123456-1234" - DISPLAY "Test 3 failed: " str END-DISPLAY - END-IF - - MOVE FUNCTION FORMATTED-DATETIME - ("YYYYDDDThhmmss+hhmm", 1, 45296) - TO str - IF str <> "1601001T123456+0000" - DISPLAY "Test 4 failed: " str END-DISPLAY - END-IF - - *> Test underflow to next day due to offset - MOVE FUNCTION FORMATTED-DATETIME - ("YYYYDDDThhmmss.sssssssssZ", 150846, 0, - 1) - TO str - IF str <> "2013365T235900.000000000Z" - DISPLAY "Test 5 failed: " str END-DISPLAY - END-IF - - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_functions.at:1122: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_functions.at:1122" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_functions.at:1122" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_functions.at:1123: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_functions.at:1123" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_functions.at:1123" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_854 -#AT_START_855 -at_fn_group_banner 855 'run_functions.at:1128' \ - "FUNCTION FORMATTED-DATETIME with ref modding" " " 4 -at_xfail=no -( - $as_echo "855. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 str PIC X(04). - PROCEDURE DIVISION. - MOVE FUNCTION FORMATTED-DATETIME - ("YYYYMMDDThhmmss", 1, 1) (3:4) - TO STR - IF STR NOT = '0101' - DISPLAY STR - END-DISPLAY - END-IF - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_functions.at:1148: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_functions.at:1148" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_functions.at:1148" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_functions.at:1149: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_functions.at:1149" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_functions.at:1149" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_855 -#AT_START_856 -at_fn_group_banner 856 'run_functions.at:1154' \ - "FUNCTION FORMATTED-TIME" " " 4 -at_xfail=no -( - $as_echo "856. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 str PIC X(20). - PROCEDURE DIVISION. - *> Test normal inputs. - MOVE FUNCTION FORMATTED-TIME ( "hhmmss", 45296 ) TO str - IF str <> "123456" - DISPLAY "Test 1 failed: " str END-DISPLAY - END-IF - - MOVE FUNCTION FORMATTED-TIME ( "hh:mm:ss", 45296 ) TO str - IF str <> "12:34:56" - DISPLAY "Test 2 failed: " str END-DISPLAY - END-IF - - MOVE FUNCTION FORMATTED-TIME ( "hhmmssZ", 86399, -1 ) TO str - IF str <> "000059Z" - DISPLAY "Test 3 failed: " str END-DISPLAY - END-IF - - MOVE FUNCTION FORMATTED-TIME ( "hh:mm:ssZ", 45296) - TO str - IF str <> "12:34:56Z" - DISPLAY "Test 4 failed: " str END-DISPLAY - END-IF - - MOVE FUNCTION FORMATTED-TIME ( "hhmmss.ss", 45296.78 ) TO str - IF str <> "123456.78" - DISPLAY "Test 5 failed: " str END-DISPLAY - END-IF - - MOVE FUNCTION FORMATTED-TIME ( "hh:mm:ss.ssZ", 0, 120) - TO str - IF str <> "22:00:00.00Z" - DISPLAY "Test 6 failed: " str END-DISPLAY - END-IF - - MOVE FUNCTION FORMATTED-TIME ( "hhmmss+hhmm", 45296) - TO str - IF str <> "123456+0000" - DISPLAY "Test 7 failed: " str END-DISPLAY - END-IF - - MOVE FUNCTION FORMATTED-TIME ( "hh:mm:ss+hh:mm", 45296, 0 ) - TO str - IF str <> "12:34:56+00:00" - DISPLAY "Test 8 failed: " str END-DISPLAY - END-IF - - MOVE FUNCTION FORMATTED-TIME ( "hhmmss+hhmm", 45296, -754) - TO str - IF str <> "123456-1234" - DISPLAY "Test 9 failed: " str END-DISPLAY - END-IF - - *> Test with invalid/missing offset times. - MOVE FUNCTION FORMATTED-TIME ( "hhmmss+hhmm", 1, 3000 ) - TO str - IF str <> SPACES - OR FUNCTION EXCEPTION-STATUS <> "EC-ARGUMENT-FUNCTION" - OR FUNCTION EXCEPTION-LOCATION <> "prog; ; 60" - DISPLAY "Test 10 failed: " str END-DISPLAY - END-IF - - MOVE FUNCTION FORMATTED-TIME ( "hhmmss+hhmm", 1, -3000 ) - TO str - IF str <> SPACES - OR FUNCTION EXCEPTION-STATUS <> "EC-ARGUMENT-FUNCTION" - OR FUNCTION EXCEPTION-LOCATION <> "prog; ; 68" - DISPLAY "Test 11 failed: " str END-DISPLAY - END-IF - - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_functions.at:1235: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_functions.at:1235" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_functions.at:1235" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_functions.at:1236: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_functions.at:1236" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_functions.at:1236" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_856 -#AT_START_857 -at_fn_group_banner 857 'run_functions.at:1241' \ - "FUNCTION FORMATTED-TIME DP.COMMA" " " 4 -at_xfail=no -( - $as_echo "857. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - - ENVIRONMENT DIVISION. - CONFIGURATION SECTION. - SPECIAL-NAMES. - DECIMAL-POINT IS COMMA. - - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 str PIC X(11). - - PROCEDURE DIVISION. - MOVE FUNCTION FORMATTED-TIME ("hh:mm:ss,ss", 45296) TO str - IF str <> "12:34:56,00" - DISPLAY "Test 1 failed: " str END-DISPLAY - END-IF - - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_functions.at:1266: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_functions.at:1266" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_functions.at:1266" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_functions.at:1267: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_functions.at:1267" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_functions.at:1267" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_857 -#AT_START_858 -at_fn_group_banner 858 'run_functions.at:1272' \ - "FUNCTION FORMATTED-TIME with ref modding" " " 4 -at_xfail=no -( - $as_echo "858. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 str PIC X(04). - PROCEDURE DIVISION. - MOVE FUNCTION FORMATTED-TIME ("hhmmss", 45296) (3:4) - TO STR - IF STR NOT = '3456' - DISPLAY STR - END-DISPLAY - END-IF - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_functions.at:1291: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_functions.at:1291" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_functions.at:1291" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_functions.at:1292: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_functions.at:1292" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_functions.at:1292" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_858 -#AT_START_859 -at_fn_group_banner 859 'run_functions.at:1297' \ - "FUNCTION FRACTION-PART" " " 4 -at_xfail=no -( - $as_echo "859. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 TEST-FLD PIC S9(04)V9(08). - PROCEDURE DIVISION. - MOVE FUNCTION FRACTION-PART ( 3.12345 ) - TO TEST-FLD. - IF TEST-FLD NOT = +0000.12345 - DISPLAY 'FRACTION-PART ( +3.12345 ) wrong: ' TEST-FLD - END-DISPLAY - END-IF. - MOVE FUNCTION FRACTION-PART ( -3.12345 ) - TO TEST-FLD. - IF TEST-FLD NOT = -0000.12345 - DISPLAY 'FRACTION-PART ( -3.12345 ) wrong: ' TEST-FLD - END-DISPLAY - END-IF. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_functions.at:1322: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_functions.at:1322" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_functions.at:1322" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_functions.at:1323: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_functions.at:1323" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_functions.at:1323" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_859 -#AT_START_860 -at_fn_group_banner 860 'run_functions.at:1328' \ - "FUNCTION HIGHEST-ALGEBRAIC" " " 4 -at_xfail=no -( - $as_echo "860. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 F1 PIC S999. - 01 F2 PIC S9(4) BINARY. - 01 F3 PIC 99V9(3). - 01 F4 PIC $**,**9.99BCR. - 01 F5 PIC $**,**9.99. - 01 F6 USAGE BINARY-CHAR SIGNED. - 01 F7 USAGE BINARY-CHAR UNSIGNED. - 01 TEST-FLD PIC S9(08)V9(04). - PROCEDURE DIVISION. - MOVE FUNCTION HIGHEST-ALGEBRAIC (F1) - TO TEST-FLD. - IF TEST-FLD NOT = 999 - DISPLAY "Test 1 fail: " TEST-FLD - END-DISPLAY - END-IF. - MOVE FUNCTION HIGHEST-ALGEBRAIC (F2) - TO TEST-FLD. - IF TEST-FLD NOT = 9999 - DISPLAY "Test 2 fail: " TEST-FLD - END-DISPLAY - END-IF. - MOVE FUNCTION HIGHEST-ALGEBRAIC (F3) - TO TEST-FLD. - IF TEST-FLD NOT = 99.999 - DISPLAY "Test 3 fail: " TEST-FLD - END-DISPLAY - END-IF. - MOVE FUNCTION HIGHEST-ALGEBRAIC (F4) - TO TEST-FLD. - IF TEST-FLD NOT = 99999.99 - DISPLAY "Test 4 fail: " TEST-FLD - END-DISPLAY - END-IF. - MOVE FUNCTION HIGHEST-ALGEBRAIC (F5) - TO TEST-FLD. - IF TEST-FLD NOT = 99999.99 - DISPLAY "Test 5 fail: " TEST-FLD - END-DISPLAY - END-IF. - MOVE FUNCTION HIGHEST-ALGEBRAIC (F6) - TO TEST-FLD. - IF TEST-FLD NOT = 127 - DISPLAY "Test 6 fail: " TEST-FLD - END-DISPLAY - END-IF. - MOVE FUNCTION HIGHEST-ALGEBRAIC (F7) - TO TEST-FLD. - IF TEST-FLD NOT = 255 - DISPLAY "Test 7 fail: " TEST-FLD - END-DISPLAY - END-IF. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_functions.at:1390: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_functions.at:1390" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_functions.at:1390" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_functions.at:1391: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_functions.at:1391" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_functions.at:1391" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_860 -#AT_START_861 -at_fn_group_banner 861 'run_functions.at:1396' \ - "FUNCTION INTEGER" " " 4 -at_xfail=no -( - $as_echo "861. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 X PIC S9(4)V9(4) VALUE -1.5. - 01 Y PIC 9(12) VALUE 600851475143. - 01 TEST-FLD PIC S9(14)V9(08). - PROCEDURE DIVISION. - MOVE FUNCTION INTEGER ( X ) - TO TEST-FLD. - IF TEST-FLD NOT = -2 - DISPLAY 'INTEGER ( X ) wrong: ' TEST-FLD - END-DISPLAY - END-IF. - MOVE FUNCTION INTEGER ( Y / 71 ) - TO TEST-FLD. - IF TEST-FLD NOT = 8462696833 - DISPLAY 'INTEGER ( Y / 71 ) wrong: ' TEST-FLD - END-DISPLAY - END-IF. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_functions.at:1423: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_functions.at:1423" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_functions.at:1423" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_functions.at:1424: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_functions.at:1424" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_functions.at:1424" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_861 -#AT_START_862 -at_fn_group_banner 862 'run_functions.at:1429' \ - "FUNCTION INTEGER-OF-DATE" " " 4 -at_xfail=no -( - $as_echo "862. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 TEST-FLD PIC S9(09)V9(02). - PROCEDURE DIVISION. - MOVE FUNCTION INTEGER-OF-DATE ( 20000925 ) - TO TEST-FLD. - IF TEST-FLD NOT = 000146000 - DISPLAY TEST-FLD - END-DISPLAY - END-IF. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_functions.at:1448: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_functions.at:1448" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_functions.at:1448" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_functions.at:1449: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_functions.at:1449" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_functions.at:1449" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_862 -#AT_START_863 -at_fn_group_banner 863 'run_functions.at:1454' \ - "FUNCTION INTEGER-OF-DAY" " " 4 -at_xfail=no -( - $as_echo "863. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 TEST-FLD PIC S9(09)V9(02). - PROCEDURE DIVISION. - MOVE FUNCTION INTEGER-OF-DAY ( 2000269 ) - TO TEST-FLD. - IF TEST-FLD NOT = 000146000 - DISPLAY TEST-FLD - END-DISPLAY - END-IF. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_functions.at:1473: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_functions.at:1473" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_functions.at:1473" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_functions.at:1474: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_functions.at:1474" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_functions.at:1474" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_863 -#AT_START_864 -at_fn_group_banner 864 'run_functions.at:1479' \ - "FUNCTION INTEGER-OF-FORMATTED-DATE" " " 4 -at_xfail=no -( - $as_echo "864. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 day-int PIC 9(9). - - PROCEDURE DIVISION. - *> The date 2013-12-30 is used as it can also be used to - *> check the conversion of dates in week form. - MOVE FUNCTION INTEGER-OF-FORMATTED-DATE - ("YYYY-MM-DD", "2013-12-30") - TO day-int - IF day-int <> 150844 - DISPLAY "Test 1 failed: " day-int END-DISPLAY - END-IF - - MOVE FUNCTION INTEGER-OF-FORMATTED-DATE - ("YYYY-DDD", "2013-364") - TO day-int - IF day-int <> 150844 - DISPLAY "Test 2 failed: " day-int END-DISPLAY - END-IF - - MOVE FUNCTION INTEGER-OF-FORMATTED-DATE - ("YYYY-Www-D", "2014-W01-1") - TO day-int - IF day-int <> 150844 - DISPLAY "Test 3 failed: " day-int END-DISPLAY - END-IF - - MOVE FUNCTION INTEGER-OF-FORMATTED-DATE - ("YYYY-MM-DDThh:mm:ss", "2013-12-30T12:34:56") - TO day-int - IF day-int <> 150844 - DISPLAY "Test 4 failed: " day-int END-DISPLAY - END-IF - - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_functions.at:1523: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_functions.at:1523" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_functions.at:1523" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_functions.at:1524: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_functions.at:1524" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_functions.at:1524" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_864 -#AT_START_865 -at_fn_group_banner 865 'run_functions.at:1529' \ - "FUNCTION INTEGER-PART" " " 4 -at_xfail=no -( - $as_echo "865. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 X PIC S9(4)V9(4) VALUE -1.5. - 01 TEST-FLD PIC S9(04)V9(02). - PROCEDURE DIVISION. - MOVE FUNCTION INTEGER-PART ( X ) - TO TEST-FLD. - IF TEST-FLD NOT = -1 - DISPLAY TEST-FLD - END-DISPLAY - END-IF. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_functions.at:1549: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_functions.at:1549" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_functions.at:1549" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_functions.at:1550: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_functions.at:1550" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_functions.at:1550" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_865 -#AT_START_866 -at_fn_group_banner 866 'run_functions.at:1555' \ - "FUNCTION LENGTH" " " 4 -at_xfail=no -( - $as_echo "866. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 X PIC S9(4)V9(4) VALUE -1.5. - 01 N PIC N(9). - 01 TEST-FLD PIC S9(04)V9(02). - PROCEDURE DIVISION. - MOVE FUNCTION LENGTH ( X ) - TO TEST-FLD - IF TEST-FLD NOT = 8 - DISPLAY 'LENGTH "00128" wrong: ' TEST-FLD - END-DISPLAY - END-IF - MOVE FUNCTION LENGTH ( N ) - TO TEST-FLD - IF TEST-FLD NOT = 9 - DISPLAY 'LENGTH N(9) wrong: ' TEST-FLD - END-DISPLAY - END-IF - - MOVE FUNCTION LENGTH ( '00128' ) - TO TEST-FLD - IF TEST-FLD NOT = 5 - DISPLAY 'LENGTH "00128" wrong: ' TEST-FLD - END-DISPLAY - END-IF - * note: we currently do not support items of category boolean... - *> MOVE FUNCTION LENGTH ( b'100' ) - *> TO TEST-FLD - *> IF TEST-FLD NOT = 3 - *> DISPLAY 'LENGTH b"100" wrong: ' TEST-FLD - *> END-DISPLAY - *> END-IF - MOVE FUNCTION LENGTH ( x'a0' ) - TO TEST-FLD - IF TEST-FLD NOT = 1 - DISPLAY 'LENGTH x"a0" wrong: ' TEST-FLD - END-DISPLAY - END-IF - MOVE FUNCTION LENGTH ( z'a0' ) - TO TEST-FLD - IF TEST-FLD NOT = 3 - DISPLAY 'LENGTH z"a0" wrong: ' TEST-FLD - END-DISPLAY - END-IF - MOVE FUNCTION LENGTH ( n'a0' ) - TO TEST-FLD - IF TEST-FLD NOT = 2 - DISPLAY 'LENGTH n"a0" wrong: ' TEST-FLD - END-DISPLAY - END-IF - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_functions.at:1614: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_functions.at:1614" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob:7: warning: handling of USAGE NATIONAL is unfinished; implementation is likely to be changed -prog.cob:48: warning: handling of national literal is unfinished; implementation is likely to be changed -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_functions.at:1614" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_functions.at:1618: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_functions.at:1618" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_functions.at:1618" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_866 -#AT_START_867 -at_fn_group_banner 867 'run_functions.at:1623' \ - "FUNCTION LOCALE-COMPARE" " " 4 -at_xfail=no -( - $as_echo "867. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - PROCEDURE DIVISION. - IF FUNCTION LOCALE-COMPARE ("A", "B") NOT = "<" - DISPLAY "Test 1 fail" - END-DISPLAY - END-IF. - IF FUNCTION LOCALE-COMPARE ("B", "A") NOT = ">" - DISPLAY "Test 2 fail" - END-DISPLAY - END-IF. - IF FUNCTION LOCALE-COMPARE ("A", "A") NOT = "=" - DISPLAY "Test 3 fail" - END-DISPLAY - END-IF. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_functions.at:1647: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_functions.at:1647" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_functions.at:1647" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_functions.at:1648: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_functions.at:1648" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_functions.at:1648" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_867 -#AT_START_868 -at_fn_group_banner 868 'run_functions.at:1653' \ - "FUNCTION LOCALE-DATE" " " 4 -at_xfail=no -( - $as_echo "868. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 X PIC X(32) VALUE SPACES. - PROCEDURE DIVISION. - MOVE FUNCTION LOCALE-DATE ( "19630302" ) TO X. - IF X NOT = SPACES - DISPLAY "OK" - END-DISPLAY - END-IF. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_functions.at:1671: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_functions.at:1671" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_functions.at:1671" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_functions.at:1672: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_functions.at:1672" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo "OK -" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_functions.at:1672" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_868 -#AT_START_869 -at_fn_group_banner 869 'run_functions.at:1679' \ - "FUNCTION LOCALE-TIME" " " 4 -at_xfail=no -( - $as_echo "869. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 X PIC X(32) VALUE SPACES. - PROCEDURE DIVISION. - MOVE FUNCTION LOCALE-TIME ( "233012" ) TO X. - IF X NOT = SPACES - DISPLAY "OK" - END-DISPLAY - END-IF. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_functions.at:1697: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_functions.at:1697" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_functions.at:1697" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_functions.at:1698: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_functions.at:1698" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo "OK -" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_functions.at:1698" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_869 -#AT_START_870 -at_fn_group_banner 870 'run_functions.at:1705' \ - "FUNCTION LOCALE-TIME-FROM-SECONDS" " " 4 -at_xfail=no -( - $as_echo "870. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 X PIC X(32) VALUE SPACES. - PROCEDURE DIVISION. - MOVE FUNCTION LOCALE-TIME-FROM-SECONDS ( 33012 ) TO X. - IF X NOT = SPACES - DISPLAY "OK" - END-DISPLAY - END-IF. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_functions.at:1723: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_functions.at:1723" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_functions.at:1723" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_functions.at:1724: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_functions.at:1724" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo "OK -" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_functions.at:1724" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_870 -#AT_START_871 -at_fn_group_banner 871 'run_functions.at:1731' \ - "FUNCTION LOG" " " 4 -at_xfail=no -( - $as_echo "871. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 Y PIC S9V9(35). - PROCEDURE DIVISION. - MOVE FUNCTION LOG ( 1.5 ) TO Y. - IF Y NOT = 0.40546510810816438197801311546434913 - DISPLAY Y - END-DISPLAY - END-IF. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_functions.at:1749: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_functions.at:1749" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_functions.at:1749" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_functions.at:1750: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_functions.at:1750" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_functions.at:1750" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_871 -#AT_START_872 -at_fn_group_banner 872 'run_functions.at:1755' \ - "FUNCTION LOG10" " " 4 -at_xfail=no -( - $as_echo "872. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 Y PIC S9V9(35). - PROCEDURE DIVISION. - MOVE FUNCTION LOG10 ( 1.5 ) TO Y. - IF Y NOT = 0.17609125905568124208128900853062228 - DISPLAY Y - END-DISPLAY - END-IF. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_functions.at:1773: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_functions.at:1773" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_functions.at:1773" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_functions.at:1774: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_functions.at:1774" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_functions.at:1774" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_872 -#AT_START_873 -at_fn_group_banner 873 'run_functions.at:1779' \ - "FUNCTION LOWER-CASE" " " 4 -at_xfail=no -( - $as_echo "873. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 X PIC X(10) VALUE "A#B.C%D+E$". - 01 TEST-FLD PIC X(12) VALUE ALL '_'. - PROCEDURE DIVISION. - STRING FUNCTION LOWER-CASE ( X ) - DELIMITED BY SIZE - INTO TEST-FLD - END-STRING - IF TEST-FLD NOT = 'a#b.c%d+e$__' - DISPLAY TEST-FLD - END-DISPLAY - END-IF. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_functions.at:1801: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_functions.at:1801" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_functions.at:1801" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_functions.at:1802: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_functions.at:1802" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_functions.at:1802" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_873 -#AT_START_874 -at_fn_group_banner 874 'run_functions.at:1807' \ - "FUNCTION LOWER-CASE with reference modding" " " 4 -at_xfail=no -( - $as_echo "874. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 X PIC X(10) VALUE "A#B.C%D+E$". - 01 TEST-FLD PIC X(03). - PROCEDURE DIVISION. - MOVE FUNCTION LOWER-CASE ( X ) (1 : 3) - TO TEST-FLD - IF TEST-FLD NOT = 'a#b' - DISPLAY TEST-FLD - END-DISPLAY - END-IF. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_functions.at:1827: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_functions.at:1827" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_functions.at:1827" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_functions.at:1828: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_functions.at:1828" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_functions.at:1828" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_874 -#AT_START_875 -at_fn_group_banner 875 'run_functions.at:1833' \ - "FUNCTION LOWEST-ALGEBRAIC" " " 4 -at_xfail=no -( - $as_echo "875. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 F1 PIC S999. - 01 F2 PIC S9(4) BINARY. - 01 F3 PIC 99V9(3). - 01 F4 PIC $**,**9.99BCR. - 01 F5 PIC $**,**9.99. - 01 F6 USAGE BINARY-CHAR SIGNED. - 01 F7 USAGE BINARY-CHAR UNSIGNED. - PROCEDURE DIVISION. - IF FUNCTION LOWEST-ALGEBRAIC (F1) NOT = -999 - DISPLAY "Test 1 fail" - END-DISPLAY - END-IF. - IF FUNCTION LOWEST-ALGEBRAIC (F2) NOT = -9999 - DISPLAY "Test 2 fail" - END-DISPLAY - END-IF. - IF FUNCTION LOWEST-ALGEBRAIC (F3) NOT = 0 - DISPLAY "Test 3 fail" - END-DISPLAY - END-IF. - IF FUNCTION LOWEST-ALGEBRAIC (F4) NOT = -99999.99 - DISPLAY "Test 4 fail" - END-DISPLAY - END-IF. - IF FUNCTION LOWEST-ALGEBRAIC (F5) NOT = 0 - DISPLAY "Test 5 fail" - END-DISPLAY - END-IF. - IF FUNCTION LOWEST-ALGEBRAIC (F6) NOT = -128 - DISPLAY "Test 6 fail" - END-DISPLAY - END-IF. - IF FUNCTION LOWEST-ALGEBRAIC (F7) NOT = 0 - DISPLAY "Test 7 fail" - END-DISPLAY - END-IF. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_functions.at:1880: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_functions.at:1880" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_functions.at:1880" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_functions.at:1881: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_functions.at:1881" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_functions.at:1881" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_875 -#AT_START_876 -at_fn_group_banner 876 'run_functions.at:1886' \ - "FUNCTION MAX" " " 4 -at_xfail=no -( - $as_echo "876. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - PROCEDURE DIVISION. - DISPLAY FUNCTION MAX ( 3 -14 0 8 -3 ) - END-DISPLAY. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_functions.at:1900: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_functions.at:1900" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_functions.at:1900" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_functions.at:1901: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_functions.at:1901" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo "8 -" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_functions.at:1901" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_876 -#AT_START_877 -at_fn_group_banner 877 'run_functions.at:1908' \ - "FUNCTION MEAN" " " 4 -at_xfail=no -( - $as_echo "877. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - PROCEDURE DIVISION. - DISPLAY FUNCTION MEAN ( 3 -14 0 8 -3 ) - END-DISPLAY. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_functions.at:1922: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_functions.at:1922" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_functions.at:1922" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_functions.at:1923: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_functions.at:1923" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo "-00000001.2 -" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_functions.at:1923" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_877 -#AT_START_878 -at_fn_group_banner 878 'run_functions.at:1930' \ - "FUNCTION MEDIAN" " " 4 -at_xfail=no -( - $as_echo "878. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - PROCEDURE DIVISION. - DISPLAY FUNCTION MEDIAN ( 3 -14 0 8 -3 ) - END-DISPLAY. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_functions.at:1944: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_functions.at:1944" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_functions.at:1944" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_functions.at:1945: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_functions.at:1945" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo "0 -" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_functions.at:1945" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_878 -#AT_START_879 -at_fn_group_banner 879 'run_functions.at:1952' \ - "FUNCTION MIDRANGE" " " 4 -at_xfail=no -( - $as_echo "879. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - PROCEDURE DIVISION. - DISPLAY FUNCTION MIDRANGE ( 3 -14 0 8 -3 ) - END-DISPLAY. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_functions.at:1966: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_functions.at:1966" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_functions.at:1966" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_functions.at:1967: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_functions.at:1967" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo "-000000003 -" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_functions.at:1967" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_879 -#AT_START_880 -at_fn_group_banner 880 'run_functions.at:1974' \ - "FUNCTION MIN" " " 4 -at_xfail=no -( - $as_echo "880. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - PROCEDURE DIVISION. - DISPLAY FUNCTION MIN ( 3 -14 0 8 -3 ) - END-DISPLAY. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_functions.at:1988: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_functions.at:1988" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_functions.at:1988" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_functions.at:1989: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_functions.at:1989" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo "-14 -" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_functions.at:1989" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_880 -#AT_START_881 -at_fn_group_banner 881 'run_functions.at:1996' \ - "FUNCTION MOD (valid)" " " 4 -at_xfail=no -( - $as_echo "881. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 Y PIC 9(12) VALUE 600851475143. - 01 R PIC S9(4)V9(4) VALUE 0. - PROCEDURE DIVISION. - MOVE FUNCTION MOD ( -11 5 ) TO R - IF R NOT = 4 - DISPLAY 'first one wrong: ' R - END-DISPLAY - END-IF - MOVE FUNCTION MOD ( Y, 71 ) TO R - IF R NOT = 0 - DISPLAY 'second one wrong: ' R - END-DISPLAY - END-IF - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_functions.at:2020: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_functions.at:2020" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_functions.at:2020" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_functions.at:2021: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_functions.at:2021" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_functions.at:2021" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_881 -#AT_START_882 -at_fn_group_banner 882 'run_functions.at:2026' \ - "FUNCTION MOD (invalid)" " " 4 -at_xfail=no -( - $as_echo "882. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 Z PIC 9 VALUE 0. - 01 R PIC S9(4)V9(4) VALUE 1. - PROCEDURE DIVISION. - MOVE FUNCTION MOD ( -11 Z ) TO R - IF FUNCTION TRIM(FUNCTION EXCEPTION-STATUS) - NOT = 'EC-ARGUMENT-FUNCTION' - DISPLAY 'Wrong/missing exception: ' - FUNCTION EXCEPTION-STATUS - END-DISPLAY - END-IF - IF R NOT = 0 - DISPLAY 'result is not zero: ' R - END-DISPLAY - END-IF - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_functions.at:2051: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_functions.at:2051" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_functions.at:2051" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_functions.at:2052: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_functions.at:2052" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_functions.at:2052" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_882 -#AT_START_883 -at_fn_group_banner 883 'run_functions.at:2057' \ - "FUNCTION MODULE-CALLER-ID" " " 4 -at_xfail=no -( - $as_echo "883. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - DATA DIVISION. - WORKING-STORAGE SECTION. - PROCEDURE DIVISION. - CALL "prog2" - END-CALL. - STOP RUN. -_ATEOF - - -cat >prog2.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog2. - ENVIRONMENT DIVISION. - DATA DIVISION. - WORKING-STORAGE SECTION. - PROCEDURE DIVISION. - DISPLAY FUNCTION MODULE-CALLER-ID NO ADVANCING - END-DISPLAY. - EXIT PROGRAM. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_functions.at:2084: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_functions.at:2084" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_functions.at:2084" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_functions.at:2085: \$COMPILE_MODULE prog2.cob" -at_fn_check_prepare_dynamic "$COMPILE_MODULE prog2.cob" "run_functions.at:2085" -( $at_check_trace; $COMPILE_MODULE prog2.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_functions.at:2085" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_functions.at:2086: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_functions.at:2086" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo "prog" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_functions.at:2086" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_883 -#AT_START_884 -at_fn_group_banner 884 'run_functions.at:2091' \ - "FUNCTION MODULE-DATE" " " 4 -at_xfail=no -( - $as_echo "884. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 TEST-DATE PIC 9(8) VALUE 0. - PROCEDURE DIVISION. - MOVE FUNCTION MODULE-DATE TO TEST-DATE. - IF TEST-DATE NOT = 0 - DISPLAY "OK" NO ADVANCING - END-DISPLAY - END-IF. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_functions.at:2110: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_functions.at:2110" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_functions.at:2110" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_functions.at:2111: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_functions.at:2111" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo "OK" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_functions.at:2111" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_884 -#AT_START_885 -at_fn_group_banner 885 'run_functions.at:2116' \ - "FUNCTION MODULE-FORMATTED-DATE" " " 4 -at_xfail=no -( - $as_echo "885. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 TEST-DATE PIC X(16) VALUE SPACES. - PROCEDURE DIVISION. - MOVE FUNCTION MODULE-FORMATTED-DATE TO TEST-DATE. - IF TEST-DATE NOT = SPACES - DISPLAY "OK" NO ADVANCING - END-DISPLAY - END-IF. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_functions.at:2135: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_functions.at:2135" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_functions.at:2135" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_functions.at:2136: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_functions.at:2136" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo "OK" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_functions.at:2136" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_885 -#AT_START_886 -at_fn_group_banner 886 'run_functions.at:2141' \ - "FUNCTION MODULE-ID" " " 4 -at_xfail=no -( - $as_echo "886. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - DATA DIVISION. - WORKING-STORAGE SECTION. - PROCEDURE DIVISION. - DISPLAY FUNCTION MODULE-ID NO ADVANCING - END-DISPLAY. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_functions.at:2156: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_functions.at:2156" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_functions.at:2156" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_functions.at:2157: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_functions.at:2157" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo "prog" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_functions.at:2157" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_886 -#AT_START_887 -at_fn_group_banner 887 'run_functions.at:2162' \ - "FUNCTION MODULE-PATH" " " 4 -at_xfail=no -( - $as_echo "887. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 TEST-PATH PIC X(16) VALUE SPACES. - PROCEDURE DIVISION. - MOVE FUNCTION MODULE-PATH TO TEST-PATH. - IF TEST-PATH NOT = SPACES - DISPLAY "OK" NO ADVANCING - END-DISPLAY - END-IF. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_functions.at:2181: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_functions.at:2181" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_functions.at:2181" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_functions.at:2182: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_functions.at:2182" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo "OK" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_functions.at:2182" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_887 -#AT_START_888 -at_fn_group_banner 888 'run_functions.at:2187' \ - "FUNCTION MODULE-SOURCE" " " 4 -at_xfail=no -( - $as_echo "888. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - DATA DIVISION. - WORKING-STORAGE SECTION. - PROCEDURE DIVISION. - DISPLAY FUNCTION MODULE-SOURCE NO ADVANCING - END-DISPLAY. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_functions.at:2202: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_functions.at:2202" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_functions.at:2202" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_functions.at:2203: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_functions.at:2203" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo "prog.cob" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_functions.at:2203" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_888 -#AT_START_889 -at_fn_group_banner 889 'run_functions.at:2208' \ - "FUNCTION MODULE-TIME" " " 4 -at_xfail=no -( - $as_echo "889. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 TEST-TIME PIC 9(6) VALUE 0. - PROCEDURE DIVISION. - MOVE FUNCTION MODULE-TIME TO TEST-TIME. - IF TEST-TIME NOT = 0 - DISPLAY "OK" NO ADVANCING - END-DISPLAY - END-IF. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_functions.at:2227: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_functions.at:2227" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_functions.at:2227" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_functions.at:2228: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_functions.at:2228" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo "OK" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_functions.at:2228" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_889 -#AT_START_890 -at_fn_group_banner 890 'run_functions.at:2233' \ - "FUNCTION MONETARY-DECIMAL-POINT" " " 4 -at_xfail=no -( - $as_echo "890. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 TEST-FLD PIC X(8) VALUE SPACES. - PROCEDURE DIVISION. - MOVE FUNCTION MONETARY-DECIMAL-POINT TO TEST-FLD. - DISPLAY "OK" NO ADVANCING - END-DISPLAY - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_functions.at:2250: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_functions.at:2250" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_functions.at:2250" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_functions.at:2251: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_functions.at:2251" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo "OK" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_functions.at:2251" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_890 -#AT_START_891 -at_fn_group_banner 891 'run_functions.at:2256' \ - "FUNCTION MONETARY-THOUSANDS-SEPARATOR" " " 4 -at_xfail=no -( - $as_echo "891. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 TEST-FLD PIC X(8) VALUE SPACES. - PROCEDURE DIVISION. - MOVE FUNCTION MONETARY-THOUSANDS-SEPARATOR TO TEST-FLD. - DISPLAY "OK" NO ADVANCING - END-DISPLAY - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_functions.at:2273: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_functions.at:2273" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_functions.at:2273" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_functions.at:2274: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_functions.at:2274" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo "OK" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_functions.at:2274" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_891 -#AT_START_892 -at_fn_group_banner 892 'run_functions.at:2279' \ - "FUNCTION NUMERIC-DECIMAL-POINT" " " 4 -at_xfail=no -( - $as_echo "892. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 TEST-FLD PIC X(8) VALUE SPACES. - PROCEDURE DIVISION. - MOVE FUNCTION NUMERIC-DECIMAL-POINT TO TEST-FLD. - DISPLAY "OK" NO ADVANCING - END-DISPLAY - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_functions.at:2296: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_functions.at:2296" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_functions.at:2296" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_functions.at:2297: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_functions.at:2297" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo "OK" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_functions.at:2297" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_892 -#AT_START_893 -at_fn_group_banner 893 'run_functions.at:2302' \ - "FUNCTION NUMERIC-THOUSANDS-SEPARATOR" " " 4 -at_xfail=no -( - $as_echo "893. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 TEST-FLD PIC X(8) VALUE SPACES. - PROCEDURE DIVISION. - MOVE FUNCTION NUMERIC-THOUSANDS-SEPARATOR TO TEST-FLD. - DISPLAY "OK" NO ADVANCING - END-DISPLAY - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_functions.at:2319: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_functions.at:2319" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_functions.at:2319" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_functions.at:2320: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_functions.at:2320" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo "OK" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_functions.at:2320" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_893 -#AT_START_894 -at_fn_group_banner 894 'run_functions.at:2325' \ - "FUNCTION NUMVAL" " " 4 -at_xfail=no -( - $as_echo "894. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 X1 PIC X(12) VALUE " -9876.1234 ". - 01 X2 PIC X(18) VALUE " 19876.1234 CR". - 01 N PIC s9(5)v9(5). - PROCEDURE DIVISION. - MOVE FUNCTION NUMVAL ( X1 ) TO N - IF N NOT = -9876.1234 - DISPLAY N - END-DISPLAY - END-IF - MOVE FUNCTION NUMVAL ( X2 ) TO N - IF N NOT = -19876.1234 - DISPLAY N - END-DISPLAY - END-IF - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_functions.at:2350: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_functions.at:2350" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_functions.at:2350" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_functions.at:2351: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_functions.at:2351" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_functions.at:2351" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_894 -#AT_START_895 -at_fn_group_banner 895 'run_functions.at:2356' \ - "FUNCTION NUMVAL-C" " " 4 -at_xfail=no -( - $as_echo "895. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 X1 PIC X(14) VALUE " % -9876.1234 ". - 01 X2 PIC X(20) VALUE " % 19,876.1234 DB". - 01 N PIC s9(5)v9(5). - PROCEDURE DIVISION. - MOVE FUNCTION NUMVAL-C ( X1 , "%" ) TO N - IF N NOT = -9876.1234 - DISPLAY N - END-DISPLAY - END-IF - MOVE FUNCTION NUMVAL-C ( X2 , "%" ) TO N - IF N NOT = -19876.1234 - DISPLAY N - END-DISPLAY - END-IF - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_functions.at:2381: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_functions.at:2381" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_functions.at:2381" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_functions.at:2382: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_functions.at:2382" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_functions.at:2382" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_895 -#AT_START_896 -at_fn_group_banner 896 'run_functions.at:2387' \ - "FUNCTION NUMVAL-C DP.COMMA" " " 4 -at_xfail=no -( - $as_echo "896. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - CONFIGURATION SECTION. - SPECIAL-NAMES. - DECIMAL-POINT IS COMMA - . - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 X1 PIC X(20) VALUE " % 19.876,1234 DB". - 01 N PIC s9(5)v9(5). - PROCEDURE DIVISION. - MOVE FUNCTION NUMVAL-C ( X1 , "%" ) TO N - IF N NOT = -19876,1234 - DISPLAY N - END-DISPLAY - END-IF - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_functions.at:2411: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_functions.at:2411" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_functions.at:2411" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_functions.at:2412: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_functions.at:2412" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_functions.at:2412" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_896 -#AT_START_897 -at_fn_group_banner 897 'run_functions.at:2417' \ - "FUNCTION NUMVAL-F" " " 4 -at_xfail=no -( - $as_echo "897. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 X PIC X(12) VALUE " -0.1234E+4 ". - PROCEDURE DIVISION. - DISPLAY FUNCTION NUMVAL-F ( X ) - END-DISPLAY. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_functions.at:2432: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_functions.at:2432" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_functions.at:2432" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_functions.at:2433: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_functions.at:2433" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo "-000001234 -" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_functions.at:2433" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_897 -#AT_START_898 -at_fn_group_banner 898 'run_functions.at:2440' \ - "FUNCTION ORD" " " 4 -at_xfail=no -( - $as_echo "898. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - PROCEDURE DIVISION. - DISPLAY FUNCTION ORD ( "k" ) - END-DISPLAY. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_functions.at:2454: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_functions.at:2454" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_functions.at:2454" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_functions.at:2455: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_functions.at:2455" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo "0000000108 -" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_functions.at:2455" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_898 -#AT_START_899 -at_fn_group_banner 899 'run_functions.at:2462' \ - "FUNCTION ORD-MAX" " " 4 -at_xfail=no -( - $as_echo "899. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - PROCEDURE DIVISION. - DISPLAY FUNCTION ORD-MAX ( 3 -14 0 8 -3 ) - END-DISPLAY. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_functions.at:2476: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_functions.at:2476" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_functions.at:2476" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_functions.at:2477: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_functions.at:2477" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo "0000000004 -" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_functions.at:2477" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_899 -#AT_START_900 -at_fn_group_banner 900 'run_functions.at:2484' \ - "FUNCTION ORD-MIN" " " 4 -at_xfail=no -( - $as_echo "900. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - PROCEDURE DIVISION. - DISPLAY FUNCTION ORD-MIN ( 3 -14 0 8 -3 ) - END-DISPLAY. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_functions.at:2498: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_functions.at:2498" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_functions.at:2498" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_functions.at:2499: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_functions.at:2499" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo "0000000002 -" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_functions.at:2499" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_900 -#AT_START_901 -at_fn_group_banner 901 'run_functions.at:2506' \ - "FUNCTION PI" " " 4 -at_xfail=no -( - $as_echo "901. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 Y PIC 9V9(35). - PROCEDURE DIVISION. - MOVE FUNCTION PI TO Y. - IF Y NOT = 3.14159265358979323846264338327950288 - DISPLAY Y - END-DISPLAY - END-IF. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_functions.at:2524: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_functions.at:2524" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_functions.at:2524" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_functions.at:2525: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_functions.at:2525" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_functions.at:2525" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_901 -#AT_START_902 -at_fn_group_banner 902 'run_functions.at:2530' \ - "FUNCTION PRESENT-VALUE" " " 4 -at_xfail=no -( - $as_echo "902. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - PROCEDURE DIVISION. - DISPLAY FUNCTION PRESENT-VALUE ( 3 2 1 ) - END-DISPLAY. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_functions.at:2544: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_functions.at:2544" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_functions.at:2544" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_functions.at:2545: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_functions.at:2545" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo "00000.5625 -" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_functions.at:2545" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_902 -#AT_START_903 -at_fn_group_banner 903 'run_functions.at:2552' \ - "FUNCTION RANDOM" " " 4 -at_xfail=no -( - $as_echo "903. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 Y PIC S99V99 COMP VALUE -1.0. - PROCEDURE DIVISION. - MOVE FUNCTION RANDOM ( ) TO Y. - IF Y < 0 - DISPLAY Y - END-DISPLAY - END-IF. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_functions.at:2570: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_functions.at:2570" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_functions.at:2570" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_functions.at:2571: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_functions.at:2571" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_functions.at:2571" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_903 -#AT_START_904 -at_fn_group_banner 904 'run_functions.at:2576' \ - "FUNCTION RANGE" " " 4 -at_xfail=no -( - $as_echo "904. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 Z PIC S9(4)V9(4) COMP-5. - PROCEDURE DIVISION. - MOVE FUNCTION RANGE ( 3 -14 0 8 -3 ) TO Z. - IF Z NOT = 22 - DISPLAY Z - END-DISPLAY - END-IF. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_functions.at:2594: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_functions.at:2594" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_functions.at:2594" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_functions.at:2595: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_functions.at:2595" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_functions.at:2595" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_904 -#AT_START_905 -at_fn_group_banner 905 'run_functions.at:2600' \ - "FUNCTION REM (valid)" " " 4 -at_xfail=no -( - $as_echo "905. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 R PIC S9(4)V9(4) COMP-5 VALUE 0. - PROCEDURE DIVISION. - MOVE FUNCTION REM ( -11 5 ) TO R - IF R NOT = -1 - DISPLAY R END-DISPLAY - END-IF - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_functions.at:2617: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_functions.at:2617" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_functions.at:2617" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_functions.at:2618: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_functions.at:2618" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_functions.at:2618" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_905 -#AT_START_906 -at_fn_group_banner 906 'run_functions.at:2623' \ - "FUNCTION REM (invalid)" " " 4 -at_xfail=no -( - $as_echo "906. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 R PIC S9(4)V9(4) COMP-5 VALUE 4.1. - 01 Z PIC 9 COMP-5 VALUE 0. - PROCEDURE DIVISION. - MOVE FUNCTION REM ( -11 Z ) TO R - IF FUNCTION TRIM(FUNCTION EXCEPTION-STATUS) - NOT = 'EC-ARGUMENT-FUNCTION' - DISPLAY 'Wrong/missing exception: ' - FUNCTION EXCEPTION-STATUS - END-DISPLAY - END-IF - IF R NOT = 0 - DISPLAY 'result is not zero: ' R - END-DISPLAY - END-IF - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_functions.at:2648: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_functions.at:2648" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_functions.at:2648" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_functions.at:2649: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_functions.at:2649" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_functions.at:2649" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_906 -#AT_START_907 -at_fn_group_banner 907 'run_functions.at:2654' \ - "FUNCTION REVERSE" " " 4 -at_xfail=no -( - $as_echo "907. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 X PIC X(10) VALUE "A#B.C%D+E$". - 01 Z PIC X(10). - PROCEDURE DIVISION. - MOVE FUNCTION REVERSE ( X ) TO Z. - IF Z NOT = "$E+D%C.B#A" - DISPLAY Z - END-DISPLAY - END-IF. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_functions.at:2673: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_functions.at:2673" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_functions.at:2673" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_functions.at:2674: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_functions.at:2674" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_functions.at:2674" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_907 -#AT_START_908 -at_fn_group_banner 908 'run_functions.at:2679' \ - "FUNCTION REVERSE with reference modding" " " 4 -at_xfail=no -( - $as_echo "908. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 X PIC X(10) VALUE "A#B.C%D+E$". - 01 Z PIC X(10). - PROCEDURE DIVISION. - MOVE FUNCTION REVERSE ( X ) (1 : 4) TO Z. - IF Z NOT = "$E+D " - DISPLAY Z - END-DISPLAY - END-IF. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_functions.at:2698: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_functions.at:2698" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_functions.at:2698" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_functions.at:2699: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_functions.at:2699" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_functions.at:2699" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_908 -#AT_START_909 -at_fn_group_banner 909 'run_functions.at:2704' \ - "FUNCTION SECONDS-FROM-FORMATTED-TIME" " " 4 -at_xfail=no -( - $as_echo "909. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 result PIC 9(8)V9(9) COMP-5. - PROCEDURE DIVISION. - MOVE FUNCTION SECONDS-FROM-FORMATTED-TIME - ("hhmmss", "010203") - TO result. - IF result NOT = 3723 - DISPLAY "Test 1 failed: " result - END-DISPLAY - END-IF. - - MOVE FUNCTION SECONDS-FROM-FORMATTED-TIME - ("hh:mm:ss", "01:02:03") - TO result. - IF result NOT = 3723 - DISPLAY "Test 2 failed: " result - END-DISPLAY - END-IF. - - MOVE FUNCTION SECONDS-FROM-FORMATTED-TIME - ("hhmmss.ssssssss", "010203.04050607") - TO result. - IF result NOT = 3723.04050607 - DISPLAY "Test 3 failed: " result - END-DISPLAY - END-IF. - - MOVE FUNCTION SECONDS-FROM-FORMATTED-TIME - ("hhmmssZ", "010203Z") - TO result. - IF result NOT = 3723 - DISPLAY "Test 4 failed: " result - END-DISPLAY - END-IF. - - MOVE FUNCTION SECONDS-FROM-FORMATTED-TIME - ("hhmmss+hhmm", "010203+0405") - TO result. - IF result NOT = 3723 - DISPLAY "Test 5 failed: " result - END-DISPLAY - END-IF. - - MOVE FUNCTION SECONDS-FROM-FORMATTED-TIME - ("YYYYMMDDThhmmss", "16010101T010203") - TO result. - IF result NOT = 3723 - DISPLAY "Test 6 failed: " result - END-DISPLAY - END-IF. - - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_functions.at:2765: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_functions.at:2765" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_functions.at:2765" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_functions.at:2766: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_functions.at:2766" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_functions.at:2766" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_909 -#AT_START_910 -at_fn_group_banner 910 'run_functions.at:2771' \ - "FUNCTION SECONDS-PAST-MIDNIGHT" " " 4 -at_xfail=no -( - $as_echo "910. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 Y PIC 9(8) COMP-5. - PROCEDURE DIVISION. - MOVE FUNCTION SECONDS-PAST-MIDNIGHT TO Y. - IF Y NOT < 86402 - DISPLAY Y - END-DISPLAY - END-IF. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_functions.at:2789: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_functions.at:2789" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_functions.at:2789" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_functions.at:2790: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_functions.at:2790" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_functions.at:2790" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_910 -#AT_START_911 -at_fn_group_banner 911 'run_functions.at:2795' \ - "FUNCTION SIGN" " " 4 -at_xfail=no -( - $as_echo "911. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 Z USAGE BINARY-LONG SIGNED. - PROCEDURE DIVISION. - MOVE FUNCTION SIGN ( 3.12345 ) TO Z. - IF Z NOT = 1 - DISPLAY "Sign 1 " Z - END-DISPLAY - END-IF. - MOVE FUNCTION SIGN ( -0.0 ) TO Z. - IF Z NOT = 0 - DISPLAY "Sign 2 " Z - END-DISPLAY - END-IF. - MOVE FUNCTION SIGN ( 0.0 ) TO Z. - IF Z NOT = 0 - DISPLAY "Sign 3 " Z - END-DISPLAY - END-IF. - MOVE FUNCTION SIGN ( -3.12345 ) TO Z. - IF Z NOT = -1 - DISPLAY "Sign 4 " Z - END-DISPLAY - END-IF. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_functions.at:2828: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_functions.at:2828" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_functions.at:2828" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_functions.at:2829: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_functions.at:2829" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_functions.at:2829" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_911 -#AT_START_912 -at_fn_group_banner 912 'run_functions.at:2834' \ - "FUNCTION SIN" " " 4 -at_xfail=no -( - $as_echo "912. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 Y PIC S9V9(35). - PROCEDURE DIVISION. - MOVE FUNCTION SIN ( 1.5 ) TO Y. - IF Y NOT = 0.99749498660405443094172337114148732 - DISPLAY Y - END-DISPLAY - END-IF. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_functions.at:2852: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_functions.at:2852" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_functions.at:2852" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_functions.at:2853: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_functions.at:2853" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_functions.at:2853" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_912 -#AT_START_913 -at_fn_group_banner 913 'run_functions.at:2858' \ - "FUNCTION SQRT" " " 4 -at_xfail=no -( - $as_echo "913. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 Y PIC S9V9(35). - PROCEDURE DIVISION. - MOVE FUNCTION SQRT ( 1.5 ) TO Y. - IF Y NOT = 1.22474487139158904909864203735294569 - DISPLAY Y - END-DISPLAY - END-IF. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_functions.at:2876: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_functions.at:2876" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_functions.at:2876" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_functions.at:2877: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_functions.at:2877" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_functions.at:2877" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_913 -#AT_START_914 -at_fn_group_banner 914 'run_functions.at:2882' \ - "FUNCTION STANDARD-DEVIATION" " " 4 -at_xfail=no -( - $as_echo "914. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 Y PIC S9V9(35). - PROCEDURE DIVISION. - MOVE FUNCTION STANDARD-DEVIATION ( 3 -14 0 8 -3 ) TO Y. - IF Y NOT = 7.35934779718963954877237043574538183 - DISPLAY Y - END-DISPLAY - END-IF. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_functions.at:2900: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_functions.at:2900" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_functions.at:2900" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_functions.at:2901: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_functions.at:2901" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_functions.at:2901" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_914 -#AT_START_915 -at_fn_group_banner 915 'run_functions.at:2906' \ - "FUNCTION STORED-CHAR-LENGTH" " " 4 -at_xfail=no -( - $as_echo "915. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 Y PIC X(24). - 01 Z USAGE BINARY-LONG. - PROCEDURE DIVISION. - MOVE "123456789012" TO Y. - MOVE FUNCTION STORED-CHAR-LENGTH ( Y ) TO Z. - IF Z NOT = 12 - DISPLAY Z - END-DISPLAY - END-IF. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_functions.at:2926: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_functions.at:2926" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_functions.at:2926" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_functions.at:2927: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_functions.at:2927" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_functions.at:2927" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_915 -#AT_START_916 -at_fn_group_banner 916 'run_functions.at:2932' \ - "FUNCTION SUBSTITUTE" " " 4 -at_xfail=no -( - $as_echo "916. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 Y PIC X(20). - 01 Z PIC X(20) VALUE ALL '_'. - PROCEDURE DIVISION. - MOVE "abc111444555defxxabc" TO Y. - STRING FUNCTION SUBSTITUTE ( Y "abc" "zz" "55" "666" ) - DELIMITED BY SIZE - INTO Z - END-STRING - IF Z NOT = "zz1114446665defxxzz_" - DISPLAY Z - END-DISPLAY - END-IF. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_functions.at:2955: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_functions.at:2955" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_functions.at:2955" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_functions.at:2956: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_functions.at:2956" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_functions.at:2956" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_916 -#AT_START_917 -at_fn_group_banner 917 'run_functions.at:2961' \ - "FUNCTION SUBSTITUTE with reference modding" " " 4 -at_xfail=no -( - $as_echo "917. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 Y PIC X(20). - 01 Z PIC X(20). - PROCEDURE DIVISION. - MOVE "abc111444555defxxabc" TO Y. - MOVE FUNCTION SUBSTITUTE - ( Y "abc" "zz" "55" "666" ) (2 : 9) - TO Z. - IF Z NOT = "z11144466" - DISPLAY Z - END-DISPLAY - END-IF. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_functions.at:2983: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_functions.at:2983" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_functions.at:2983" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_functions.at:2984: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_functions.at:2984" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_functions.at:2984" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_917 -#AT_START_918 -at_fn_group_banner 918 'run_functions.at:2989' \ - "FUNCTION SUBSTITUTE-CASE" " " 4 -at_xfail=no -( - $as_echo "918. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 Y PIC X(20). - 01 Z PIC X(20). - PROCEDURE DIVISION. - MOVE "ABC111444555defxxabc" TO Y. - MOVE FUNCTION SUBSTITUTE-CASE (Y "abc" "zz" "55" "666") - TO Z. - IF Z NOT = "zz1114446665defxxzz" - DISPLAY Z - END-DISPLAY - END-IF. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_functions.at:3010: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_functions.at:3010" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_functions.at:3010" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_functions.at:3011: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_functions.at:3011" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_functions.at:3011" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_918 -#AT_START_919 -at_fn_group_banner 919 'run_functions.at:3016' \ - "FUNCTION SUBSTITUTE-CASE with reference mod" " " 4 -at_xfail=no -( - $as_echo "919. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 Y PIC X(20). - 01 Z PIC X(20). - PROCEDURE DIVISION. - MOVE "abc111444555defxxabc" TO Y. - MOVE FUNCTION SUBSTITUTE-CASE - ( Y "ABC" "zz" "55" "666" ) (2 : 9) - TO Z. - IF Z NOT = "z11144466" - DISPLAY Z - END-DISPLAY - END-IF. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_functions.at:3038: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_functions.at:3038" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_functions.at:3038" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_functions.at:3039: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_functions.at:3039" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_functions.at:3039" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_919 -#AT_START_920 -at_fn_group_banner 920 'run_functions.at:3044' \ - "FUNCTION SUM" " " 4 -at_xfail=no -( - $as_echo "920. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 Z USAGE BINARY-LONG. - PROCEDURE DIVISION. - MOVE FUNCTION SUM ( 3 -14 0 8 -3 ) TO Z. - IF Z NOT = -6 - DISPLAY Z - END-DISPLAY - END-IF. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_functions.at:3062: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_functions.at:3062" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_functions.at:3062" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_functions.at:3063: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_functions.at:3063" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_functions.at:3063" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_920 -#AT_START_921 -at_fn_group_banner 921 'run_functions.at:3068' \ - "FUNCTION TAN" " " 4 -at_xfail=no -( - $as_echo "921. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 Y PIC S99V9(34). - PROCEDURE DIVISION. - MOVE FUNCTION TAN ( 1.5 ) TO Y. - IF Y NOT = 14.1014199471717193876460836519877564 - DISPLAY Y - END-DISPLAY - END-IF. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_functions.at:3086: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_functions.at:3086" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_functions.at:3086" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_functions.at:3087: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_functions.at:3087" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_functions.at:3087" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_921 -#AT_START_922 -at_fn_group_banner 922 'run_functions.at:3092' \ - "FUNCTION TEST-DATE-YYYYMMDD" " " 4 -at_xfail=no -( - $as_echo "922. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - PROCEDURE DIVISION. - DISPLAY FUNCTION TEST-DATE-YYYYMMDD ( 20020231 ) - END-DISPLAY. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_functions.at:3106: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_functions.at:3106" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_functions.at:3106" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_functions.at:3107: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_functions.at:3107" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo "0000000003 -" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_functions.at:3107" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_922 -#AT_START_923 -at_fn_group_banner 923 'run_functions.at:3114' \ - "FUNCTION TEST-DAY-YYYYDDD" " " 4 -at_xfail=no -( - $as_echo "923. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - PROCEDURE DIVISION. - DISPLAY FUNCTION TEST-DAY-YYYYDDD ( 2002400 ) - END-DISPLAY. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_functions.at:3128: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_functions.at:3128" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_functions.at:3128" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_functions.at:3129: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_functions.at:3129" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo "0000000002 -" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_functions.at:3129" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_923 -#AT_START_924 -at_fn_group_banner 924 'run_functions.at:3136' \ - "FUNCTION TEST-FORMATTED-DATETIME with dates" " " 4 -at_xfail=no -( - $as_echo "924. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - PROCEDURE DIVISION. - IF FUNCTION TEST-FORMATTED-DATETIME - ("YYYYMMDD", "16010101") <> 0 - DISPLAY "Test 1 failed" END-DISPLAY - END-IF - IF FUNCTION TEST-FORMATTED-DATETIME - ("YYYY-MM-DD", "1601-01-01") <> 0 - DISPLAY "Test 2 failed" END-DISPLAY - END-IF - IF FUNCTION TEST-FORMATTED-DATETIME - ("YYYYDDD", "1601001") <> 0 - DISPLAY "Test 3 failed" END-DISPLAY - END-IF - IF FUNCTION TEST-FORMATTED-DATETIME - ("YYYY-DDD", "1601-001") <> 0 - DISPLAY "Test 4 failed" END-DISPLAY - END-IF - IF FUNCTION TEST-FORMATTED-DATETIME - ("YYYYWwwD", "1601W011") <> 0 - DISPLAY "Test 5 failed" END-DISPLAY - END-IF - IF FUNCTION TEST-FORMATTED-DATETIME - ("YYYY-Www-D", "1601-W01-1") <> 0 - DISPLAY "Test 6 failed" END-DISPLAY - END-IF - - - *> How will this work with zero-length items? - IF FUNCTION TEST-FORMATTED-DATETIME - ("YYYYMMDD", "1") <> 2 - DISPLAY "Test 7 failed" END-DISPLAY - END-IF - IF FUNCTION TEST-FORMATTED-DATETIME - ("YYYYMMDD", "160A0101") <> 4 - DISPLAY "Test 8 failed" END-DISPLAY - END-IF - IF FUNCTION TEST-FORMATTED-DATETIME - ("YYYYMMDD", "00000101") <> 1 - DISPLAY "Test 9 failed" END-DISPLAY - END-IF - IF FUNCTION TEST-FORMATTED-DATETIME - ("YYYYMMDD", "16000101") <> 4 - DISPLAY "Test 10 failed" END-DISPLAY - END-IF - IF FUNCTION TEST-FORMATTED-DATETIME - ("YYYYMMDD", "16010001") <> 6 - DISPLAY "Test 11 failed" END-DISPLAY - END-IF - IF FUNCTION TEST-FORMATTED-DATETIME - ("YYYYMMDD", "16011301") <> 6 - DISPLAY "Test 12 failed" END-DISPLAY - END-IF - IF FUNCTION TEST-FORMATTED-DATETIME - ("YYYYMMDD", "16010190") <> 7 - DISPLAY "Test 13 failed" END-DISPLAY - END-IF - IF FUNCTION TEST-FORMATTED-DATETIME - ("YYYYMMDD", "18000229") <> 8 - DISPLAY "Test 14 failed" END-DISPLAY - END-IF - IF FUNCTION TEST-FORMATTED-DATETIME - ("YYYY-MM-DD", "1601 01 01") <> 5 - DISPLAY "Test 15 failed" END-DISPLAY - END-IF - IF FUNCTION TEST-FORMATTED-DATETIME - ("YYYYMMDD", "160101010") <> 9 - DISPLAY "Test 16 failed" END-DISPLAY - END-IF - IF FUNCTION TEST-FORMATTED-DATETIME - ("YYYYWwwD", "1601A011") <> 5 - DISPLAY "Test 17 failed" END-DISPLAY - END-IF - IF FUNCTION TEST-FORMATTED-DATETIME - ("YYYYWwwD", "1601W531") <> 7 - DISPLAY "Test 18 failed" END-DISPLAY - END-IF - IF FUNCTION TEST-FORMATTED-DATETIME - ("YYYYWwwD", "1601W601") <> 6 - DISPLAY "Test 19 failed" END-DISPLAY - END-IF - IF FUNCTION TEST-FORMATTED-DATETIME - ("YYYYWwwD", "2009W531") <> 0 - DISPLAY "Test 20 failed" END-DISPLAY - END-IF - IF FUNCTION TEST-FORMATTED-DATETIME - ("YYYYWwwD", "1601W018") <> 8 - DISPLAY "Test 21 failed" END-DISPLAY - END-IF - IF FUNCTION TEST-FORMATTED-DATETIME - ("YYYYDDD", "1601366") <> 7 - DISPLAY "Test 22 failed" END-DISPLAY - END-IF - IF FUNCTION TEST-FORMATTED-DATETIME - ("YYYYDDD", "1601370") <> 6 - DISPLAY "Test 23 failed" END-DISPLAY - END-IF - IF FUNCTION TEST-FORMATTED-DATETIME - ("YYYYDDD", "1601400") <> 5 - DISPLAY "Test 24 failed" END-DISPLAY - END-IF - IF FUNCTION TEST-FORMATTED-DATETIME - ("YYYYMMDD", "01") <> 1 - DISPLAY "Test 25 failed" END-DISPLAY - END-IF - IF FUNCTION TEST-FORMATTED-DATETIME - ("YYYYMMDD", "1601010") <> 8 - DISPLAY "Test 26 failed" END-DISPLAY - END-IF - - STOP RUN - . -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_functions.at:3257: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_functions.at:3257" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_functions.at:3257" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_functions.at:3258: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_functions.at:3258" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_functions.at:3258" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_924 -#AT_START_925 -at_fn_group_banner 925 'run_functions.at:3263' \ - "FUNCTION TEST-FORMATTED-DATETIME with times" " " 4 -at_xfail=no -( - $as_echo "925. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - PROCEDURE DIVISION. - IF FUNCTION TEST-FORMATTED-DATETIME - ("hhmmss.sssssssssZ", "000000.000000000Z") <> 0 - DISPLAY "Test 1 failed" END-DISPLAY - END-IF - IF FUNCTION TEST-FORMATTED-DATETIME - ("hh:mm:ss.sssssssssZ", "00:00:00.000000000Z") <> 0 - DISPLAY "Test 2 failed" END-DISPLAY - END-IF - *> 0 instead of +/- valid in sending fields with offset of zero. - IF FUNCTION TEST-FORMATTED-DATETIME - ("hhmmss.sssssssss+hhmm", "000000.00000000000000") - <> 0 - DISPLAY "Test 3 failed" END-DISPLAY - END-IF - IF FUNCTION TEST-FORMATTED-DATETIME - ("hh:mm:ss.sssssssss+hh:mm", - "00:00:00.000000000+00:00") - <> 0 - DISPLAY "Test 4 failed" END-DISPLAY - END-IF - - IF FUNCTION TEST-FORMATTED-DATETIME - ("hhmmss", "300000") <> 1 - DISPLAY "Test 5 failed" END-DISPLAY - END-IF - IF FUNCTION TEST-FORMATTED-DATETIME - ("hhmmss", "250000") <> 2 - DISPLAY "Test 6 failed" END-DISPLAY - END-IF - IF FUNCTION TEST-FORMATTED-DATETIME - ("hhmmss", "006000") <> 3 - DISPLAY "Test 7 failed" END-DISPLAY - END-IF - IF FUNCTION TEST-FORMATTED-DATETIME - ("hhmmss", "000060") <> 5 - DISPLAY "Test 8 failed" END-DISPLAY - END-IF - IF FUNCTION TEST-FORMATTED-DATETIME - ("hh:mm:ss", "00-00-00") <> 3 - DISPLAY "Test 9 failed" END-DISPLAY - END-IF - IF FUNCTION TEST-FORMATTED-DATETIME - ("hhmmss.ss", "000000,00") <> 7 - DISPLAY "Test 10 failed" END-DISPLAY - END-IF - IF FUNCTION TEST-FORMATTED-DATETIME - ("hhmmss+hhmm", "000000 0000") <> 7 - DISPLAY "Test 11 failed" END-DISPLAY - END-IF - IF FUNCTION TEST-FORMATTED-DATETIME - ("hhmmss+hhmm", "00000000001") <> 11 - DISPLAY "Test 12 failed" END-DISPLAY - END-IF - IF FUNCTION TEST-FORMATTED-DATETIME - ("hhmmssZ", "000000A") <> 7 - DISPLAY "Test 13 failed" END-DISPLAY - END-IF - IF FUNCTION TEST-FORMATTED-DATETIME - ("hhmmss", SPACE) <> 1 - DISPLAY "Test 14 failed" END-DISPLAY - END-IF - - STOP RUN - . -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_functions.at:3338: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_functions.at:3338" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_functions.at:3338" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_functions.at:3339: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_functions.at:3339" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_functions.at:3339" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_925 -#AT_START_926 -at_fn_group_banner 926 'run_functions.at:3344' \ - "FUNCTION TEST-FORMATTED-DATETIME with datetimes" "" 4 -at_xfail=no -( - $as_echo "926. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 77 RESULT PIC 9(02). - PROCEDURE DIVISION. - MOVE FUNCTION TEST-FORMATTED-DATETIME - ("YYYYMMDDThhmmss", "16010101T000000") - TO RESULT - IF RESULT <> 0 - DISPLAY "Test 1 failed: " RESULT END-DISPLAY - END-IF - MOVE FUNCTION TEST-FORMATTED-DATETIME - ("YYYY-MM-DDThh:mm:ss.sssssssss+hh:mm", - "1601-01-01T00:00:00.000000000+00:00") - TO RESULT - IF RESULT <> 0 - DISPLAY "Test 2 failed: " RESULT END-DISPLAY - END-IF - - MOVE FUNCTION TEST-FORMATTED-DATETIME - ("YYYYMMDDThhmmss", "16010101 000000") - TO RESULT - IF RESULT <> 9 - DISPLAY "Test 3 failed: " RESULT END-DISPLAY - END-IF - MOVE FUNCTION TEST-FORMATTED-DATETIME - ("YYYYMMDDThhmmss", SPACE) - TO RESULT - IF RESULT <> 1 - DISPLAY "Test 4 failed: " RESULT END-DISPLAY - END-IF - MOVE FUNCTION TEST-FORMATTED-DATETIME - ("YYYYMMDDThhmmss", "16010101T ") - TO RESULT - IF RESULT <> 10 - DISPLAY "Test 5 failed: " RESULT END-DISPLAY - END-IF - - STOP RUN - . -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_functions.at:3391: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_functions.at:3391" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_functions.at:3391" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_functions.at:3392: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_functions.at:3392" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_functions.at:3392" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_926 -#AT_START_927 -at_fn_group_banner 927 'run_functions.at:3397' \ - "FUNCTION TEST-FORMATTED-DATETIME DP.COMMA" " " 4 -at_xfail=no -( - $as_echo "927. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - CONFIGURATION SECTION. - SPECIAL-NAMES. - DECIMAL-POINT IS COMMA. - DATA DIVISION. - WORKING-STORAGE SECTION. - PROCEDURE DIVISION. - IF FUNCTION TEST-FORMATTED-DATETIME - ("hhmmss,ss", "000000,00") <> 0 - DISPLAY "Test 1 failed" END-DISPLAY - END-IF - IF FUNCTION TEST-FORMATTED-DATETIME - ("YYYYMMDDThhmmss,ss", "16010101T000000,00") <> 0 - DISPLAY "Test 2 failed" END-DISPLAY - END-IF - - IF FUNCTION TEST-FORMATTED-DATETIME - ("hhmmss,ss", "000000.00") <> 7 - DISPLAY "Test 3 failed" END-DISPLAY - END-IF - IF FUNCTION TEST-FORMATTED-DATETIME - ("YYYYMMDDThhmmss,ss", "16010101T000000.00") <> 16 - DISPLAY "Test 4 failed" END-DISPLAY - END-IF - - STOP RUN - . -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_functions.at:3432: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_functions.at:3432" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_functions.at:3432" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_functions.at:3433: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_functions.at:3433" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_functions.at:3433" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_927 -#AT_START_928 -at_fn_group_banner 928 'run_functions.at:3438' \ - "FUNCTION TEST-NUMVAL" " " 4 -at_xfail=no -( - $as_echo "928. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - PROCEDURE DIVISION. - IF FUNCTION TEST-NUMVAL ("+ 1") NOT = 0 - DISPLAY "Test 1 fail" - END-DISPLAY - END-IF. - IF FUNCTION TEST-NUMVAL (" + 1") NOT = 0 - DISPLAY "Test 2 fail" - END-DISPLAY - END-IF. - IF FUNCTION TEST-NUMVAL ("- 1") NOT = 0 - DISPLAY "Test 3 fail" - END-DISPLAY - END-IF. - IF FUNCTION TEST-NUMVAL (" - 1") NOT = 0 - DISPLAY "Test 4 fail" - END-DISPLAY - END-IF. - IF FUNCTION TEST-NUMVAL ("+- 1") NOT = 2 - DISPLAY "Test 5 fail" - END-DISPLAY - END-IF. - IF FUNCTION TEST-NUMVAL ("1 +") NOT = 0 - DISPLAY "Test 6 fail" - END-DISPLAY - END-IF. - IF FUNCTION TEST-NUMVAL ("1 -") NOT = 0 - DISPLAY "Test 7 fail" - END-DISPLAY - END-IF. - IF FUNCTION TEST-NUMVAL ("1 +-") NOT = 4 - DISPLAY "Test 8 fail" - END-DISPLAY - END-IF. - IF FUNCTION TEST-NUMVAL ("1 -+") NOT = 4 - DISPLAY "Test 9 fail" - END-DISPLAY - END-IF. - IF FUNCTION TEST-NUMVAL ("+ 1.1") NOT = 0 - DISPLAY "Test 10 fail" - END-DISPLAY - END-IF. - IF FUNCTION TEST-NUMVAL ("- 1.1") NOT = 0 - DISPLAY "Test 11 fail" - END-DISPLAY - END-IF. - IF FUNCTION TEST-NUMVAL ("1.1 +") NOT = 0 - DISPLAY "Test 12 fail" - END-DISPLAY - END-IF. - IF FUNCTION TEST-NUMVAL ("1.1 -") NOT = 0 - DISPLAY "Test 13 fail" - END-DISPLAY - END-IF. - IF FUNCTION TEST-NUMVAL ("1.1 CR") NOT = 0 - DISPLAY "Test 14 fail" - END-DISPLAY - END-IF. - IF FUNCTION TEST-NUMVAL ("1.1 DB") NOT = 0 - DISPLAY "Test 15 fail" - END-DISPLAY - END-IF. - IF FUNCTION TEST-NUMVAL ("1.1 -CR") NOT = 6 - DISPLAY "Test 16 fail" - END-DISPLAY - END-IF. - IF FUNCTION TEST-NUMVAL ("1.1 +DB") NOT = 6 - DISPLAY "Test 17 fail" - END-DISPLAY - END-IF. - IF FUNCTION TEST-NUMVAL ("1.1 CDB") NOT = 6 - DISPLAY "Test 18 fail" - END-DISPLAY - END-IF. - IF FUNCTION TEST-NUMVAL ("+1.1 CR") NOT = 6 - DISPLAY "Test 19 fail" - END-DISPLAY - END-IF. - IF FUNCTION TEST-NUMVAL ("+ ") NOT = 8 - DISPLAY "Test 20 fail" - END-DISPLAY - END-IF. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_functions.at:3530: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_functions.at:3530" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_functions.at:3530" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_functions.at:3531: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_functions.at:3531" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_functions.at:3531" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_928 -#AT_START_929 -at_fn_group_banner 929 'run_functions.at:3536' \ - "FUNCTION TEST-NUMVAL-C" " " 4 -at_xfail=no -( - $as_echo "929. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - PROCEDURE DIVISION. - IF FUNCTION TEST-NUMVAL-C ("+ 1") NOT = 0 - DISPLAY "Test 1 fail" - END-DISPLAY - END-IF. - IF FUNCTION TEST-NUMVAL-C (" + 1") NOT = 0 - DISPLAY "Test 2 fail" - END-DISPLAY - END-IF. - IF FUNCTION TEST-NUMVAL-C ("- 1") NOT = 0 - DISPLAY "Test 3 fail" - END-DISPLAY - END-IF. - IF FUNCTION TEST-NUMVAL-C (" - 1") NOT = 0 - DISPLAY "Test 4 fail" - END-DISPLAY - END-IF. - IF FUNCTION TEST-NUMVAL-C ("+- 1") NOT = 2 - DISPLAY "Test 5 fail" - END-DISPLAY - END-IF. - IF FUNCTION TEST-NUMVAL-C ("1 +") NOT = 0 - DISPLAY "Test 6 fail" - END-DISPLAY - END-IF. - IF FUNCTION TEST-NUMVAL-C ("1 -") NOT = 0 - DISPLAY "Test 7 fail" - END-DISPLAY - END-IF. - IF FUNCTION TEST-NUMVAL-C ("1 +-") NOT = 4 - DISPLAY "Test 8 fail" - END-DISPLAY - END-IF. - IF FUNCTION TEST-NUMVAL-C ("1 -+") NOT = 4 - DISPLAY "Test 9 fail" - END-DISPLAY - END-IF. - IF FUNCTION TEST-NUMVAL-C ("+ 1.1") NOT = 0 - DISPLAY "Test 10 fail" - END-DISPLAY - END-IF. - IF FUNCTION TEST-NUMVAL-C ("- 1.1") NOT = 0 - DISPLAY "Test 11 fail" - END-DISPLAY - END-IF. - IF FUNCTION TEST-NUMVAL-C ("1.1 +") NOT = 0 - DISPLAY "Test 12 fail" - END-DISPLAY - END-IF. - IF FUNCTION TEST-NUMVAL-C ("1.1 -") NOT = 0 - DISPLAY "Test 13 fail" - END-DISPLAY - END-IF. - IF FUNCTION TEST-NUMVAL-C ("1.1 CR") NOT = 0 - DISPLAY "Test 14 fail" - END-DISPLAY - END-IF. - IF FUNCTION TEST-NUMVAL-C ("1.1 DB") NOT = 0 - DISPLAY "Test 15 fail" - END-DISPLAY - END-IF. - IF FUNCTION TEST-NUMVAL-C ("1.1 -CR") NOT = 6 - DISPLAY "Test 16 fail" - END-DISPLAY - END-IF. - IF FUNCTION TEST-NUMVAL-C ("+ $1.1 ") NOT = 0 - DISPLAY "Test 17 fail" - END-DISPLAY - END-IF. - IF FUNCTION TEST-NUMVAL-C ("- $1.1 ") NOT = 0 - DISPLAY "Test 18 fail" - END-DISPLAY - END-IF. - IF FUNCTION TEST-NUMVAL-C ("+ X1.1 ", "X") NOT = 0 - DISPLAY "Test 19 fail" - END-DISPLAY - END-IF. - IF FUNCTION TEST-NUMVAL-C ("- X1.1 ", "X") NOT = 0 - DISPLAY "Test 20 fail" - END-DISPLAY - END-IF. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_functions.at:3628: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_functions.at:3628" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_functions.at:3628" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_functions.at:3629: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_functions.at:3629" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_functions.at:3629" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_929 -#AT_START_930 -at_fn_group_banner 930 'run_functions.at:3634' \ - "FUNCTION TEST-NUMVAL-F" " " 4 -at_xfail=no -( - $as_echo "930. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - PROCEDURE DIVISION. - IF FUNCTION TEST-NUMVAL-F ("+ 1") NOT = 0 - DISPLAY "Test 1 fail" - END-DISPLAY - END-IF. - IF FUNCTION TEST-NUMVAL-F (" + 1") NOT = 0 - DISPLAY "Test 2 fail" - END-DISPLAY - END-IF. - IF FUNCTION TEST-NUMVAL-F ("- 1") NOT = 0 - DISPLAY "Test 3 fail" - END-DISPLAY - END-IF. - IF FUNCTION TEST-NUMVAL-F (" - 1") NOT = 0 - DISPLAY "Test 4 fail" - END-DISPLAY - END-IF. - IF FUNCTION TEST-NUMVAL-F ("+- 1") NOT = 2 - DISPLAY "Test 5 fail" - END-DISPLAY - END-IF. - IF FUNCTION TEST-NUMVAL-F ("1 +") NOT = 0 - DISPLAY "Test 6 fail" - END-DISPLAY - END-IF. - IF FUNCTION TEST-NUMVAL-F ("1 -") NOT = 0 - DISPLAY "Test 7 fail" - END-DISPLAY - END-IF. - IF FUNCTION TEST-NUMVAL-F ("1 +-") NOT = 4 - DISPLAY "Test 8 fail" - END-DISPLAY - END-IF. - IF FUNCTION TEST-NUMVAL-F ("1 -+") NOT = 4 - DISPLAY "Test 9 fail" - END-DISPLAY - END-IF. - IF FUNCTION TEST-NUMVAL-F ("+ 1.1") NOT = 0 - DISPLAY "Test 10 fail" - END-DISPLAY - END-IF. - IF FUNCTION TEST-NUMVAL-F ("- 1.1") NOT = 0 - DISPLAY "Test 11 fail" - END-DISPLAY - END-IF. - IF FUNCTION TEST-NUMVAL-F ("1.1 +") NOT = 0 - DISPLAY "Test 12 fail" - END-DISPLAY - END-IF. - IF FUNCTION TEST-NUMVAL-F ("1.1 -") NOT = 0 - DISPLAY "Test 13 fail" - END-DISPLAY - END-IF. - IF FUNCTION TEST-NUMVAL-F ("1.1 ") NOT = 0 - DISPLAY "Test 14 fail" - END-DISPLAY - END-IF. - IF FUNCTION TEST-NUMVAL-F ("1.1 ") NOT = 0 - DISPLAY "Test 15 fail" - END-DISPLAY - END-IF. - IF FUNCTION TEST-NUMVAL-F ("1.1 -CR") NOT = 6 - DISPLAY "Test 16 fail" - END-DISPLAY - END-IF. - IF FUNCTION TEST-NUMVAL-F ("1.1 E+1") NOT = 0 - DISPLAY "Test 17 fail" - END-DISPLAY - END-IF. - IF FUNCTION TEST-NUMVAL-F ("1.1 E -1") NOT = 0 - DISPLAY "Test 18 fail" - END-DISPLAY - END-IF. - IF FUNCTION TEST-NUMVAL-F ("1.1 EE") NOT = 6 - DISPLAY "Test 19 fail" - END-DISPLAY - END-IF. - IF FUNCTION TEST-NUMVAL-F ("+1.1 E001") NOT = 7 - DISPLAY "Test 20 fail" - END-DISPLAY - END-IF. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_functions.at:3726: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_functions.at:3726" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_functions.at:3726" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_functions.at:3727: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_functions.at:3727" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_functions.at:3727" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_930 -#AT_START_931 -at_fn_group_banner 931 'run_functions.at:3732' \ - "FUNCTION TRIM" " " 4 -at_xfail=no -( - $as_echo "931. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 X PIC X(12) VALUE " a#b.c%d+e$ ". - PROCEDURE DIVISION. - DISPLAY FUNCTION TRIM ( X ) - END-DISPLAY. - DISPLAY FUNCTION TRIM ( X TRAILING ) - END-DISPLAY. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_functions.at:3749: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_functions.at:3749" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_functions.at:3749" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_functions.at:3750: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_functions.at:3750" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo "a#b.c%d+e\$ - a#b.c%d+e\$ -" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_functions.at:3750" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_931 -#AT_START_932 -at_fn_group_banner 932 'run_functions.at:3758' \ - "FUNCTION TRIM with reference modding" " " 4 -at_xfail=no -( - $as_echo "932. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 X PIC X(12) VALUE " a#b.c%d+e$ ". - PROCEDURE DIVISION. - DISPLAY FUNCTION TRIM ( X ) (2 : 3) - END-DISPLAY. - DISPLAY FUNCTION TRIM ( X TRAILING ) (2 : 3) - END-DISPLAY. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_functions.at:3775: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_functions.at:3775" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_functions.at:3775" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_functions.at:3776: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_functions.at:3776" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo "#b. -a#b -" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_functions.at:3776" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_932 -#AT_START_933 -at_fn_group_banner 933 'run_functions.at:3784' \ - "FUNCTION TRIM zero length" " " 4 -at_xfail=no -( - $as_echo "933. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 X PIC X(4) VALUE "NOOK". - PROCEDURE DIVISION. - MOVE FUNCTION TRIM ( " " ) TO X. - DISPLAY ">" X "<" - END-DISPLAY. - DISPLAY ">" FUNCTION TRIM ( " " ) "<" - END-DISPLAY. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_functions.at:3802: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_functions.at:3802" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_functions.at:3802" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_functions.at:3803: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_functions.at:3803" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo "> < ->< -" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_functions.at:3803" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_933 -#AT_START_934 -at_fn_group_banner 934 'run_functions.at:3811' \ - "FUNCTION UPPER-CASE" " " 4 -at_xfail=no -( - $as_echo "934. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 X PIC X(10) VALUE "a#b.c%d+e$". - 01 Z PIC X(10). - PROCEDURE DIVISION. - MOVE FUNCTION UPPER-CASE ( X ) TO Z. - IF Z NOT = "A#B.C%D+E$" - DISPLAY Z - END-DISPLAY - END-IF. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_functions.at:3830: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_functions.at:3830" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_functions.at:3830" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_functions.at:3831: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_functions.at:3831" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_functions.at:3831" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_934 -#AT_START_935 -at_fn_group_banner 935 'run_functions.at:3836' \ - "FUNCTION UPPER-CASE with reference modding" " " 4 -at_xfail=no -( - $as_echo "935. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 X PIC X(10) VALUE "a#b.c%d+e$". - 01 Z PIC X(4). - PROCEDURE DIVISION. - MOVE FUNCTION UPPER-CASE ( X ) (1 : 3) TO Z. - IF Z NOT = "A#B " - DISPLAY Z - END-DISPLAY - END-IF. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_functions.at:3855: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_functions.at:3855" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_functions.at:3855" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_functions.at:3856: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_functions.at:3856" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_functions.at:3856" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_935 -#AT_START_936 -at_fn_group_banner 936 'run_functions.at:3861' \ - "FUNCTION VARIANCE" " " 4 -at_xfail=no -( - $as_echo "936. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 Z PIC S9(4)V9(4) COMP-5. - PROCEDURE DIVISION. - MOVE FUNCTION VARIANCE ( 3 -14 0 8 -3 ) TO Z. - IF Z NOT = 54.16 - DISPLAY Z - END-DISPLAY - END-IF. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_functions.at:3879: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_functions.at:3879" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_functions.at:3879" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_functions.at:3880: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_functions.at:3880" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_functions.at:3880" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_936 -#AT_START_937 -at_fn_group_banner 937 'run_functions.at:3885' \ - "FUNCTION WHEN-COMPILED" " " 4 -at_xfail=no -( - $as_echo "937. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 compiled-datetime. - 03 compiled-date. - 05 millennium PIC X. - 05 FILLER PIC X(15). - 03 timezone PIC X(5). - PROCEDURE DIVISION. - *> Check millennium. - MOVE FUNCTION WHEN-COMPILED TO compiled-datetime. - IF millennium NOT = "2" - DISPLAY "Millennium NOT OK: " millennium - END-DISPLAY - END-IF. - - *> Check timezone. - IF timezone NOT = FUNCTION CURRENT-DATE (17:5) - DISPLAY "Timezone NOT OK: " timezone - END-DISPLAY - END-IF. - - *> Check date format. - INSPECT compiled-date CONVERTING "0123456789" - TO "9999999999". - IF compiled-date NOT = ALL "9" - DISPLAY "Date format NOT OK: " compiled-date - END-DISPLAY - END-IF. - - *> Check timezone format. - IF timezone NOT = "00000" - INSPECT timezone CONVERTING "0123456789" - TO "9999999999" - IF timezone NOT = "+9999" AND "-9999" - DISPLAY "Timezone format NOT OK: " timezone - END-DISPLAY - END-IF - END-IF. - - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_functions.at:3933: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_functions.at:3933" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_functions.at:3933" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_functions.at:3934: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_functions.at:3934" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_functions.at:3934" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_937 -#AT_START_938 -at_fn_group_banner 938 'run_functions.at:3939' \ - "FUNCTION YEAR-TO-YYYY" " " 4 -at_xfail=no -( - $as_echo "938. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 Z USAGE BINARY-LONG. - PROCEDURE DIVISION. - MOVE FUNCTION YEAR-TO-YYYY ( 50 ) TO Z. - IF Z NOT = 2050 - DISPLAY Z - END-DISPLAY - END-IF. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_functions.at:3957: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_functions.at:3957" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_functions.at:3957" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_functions.at:3958: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_functions.at:3958" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_functions.at:3958" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_938 -#AT_START_939 -at_fn_group_banner 939 'run_functions.at:3963' \ - "Formatted funcs w/ invalid variable format" " " 4 -at_xfail=no -( - $as_echo "939. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 invalid-date-format PIC X(10) VALUE "yyyymmdd". - 01 invalid-datetime-format PIC X(17) - VALUE "yyyymmddtHHMMSS". - 01 invalid-time-format PIC X(6) VALUE "HHMMSS". - PROCEDURE DIVISION. - IF FUNCTION FORMATTED-CURRENT-DATE - (invalid-date-format) <> SPACES - OR FUNCTION EXCEPTION-STATUS <> "EC-ARGUMENT-FUNCTION" - OR FUNCTION EXCEPTION-LOCATION <> "prog; ; 11" - DISPLAY "Test 1 failed" END-DISPLAY - END-IF - - IF FUNCTION FORMATTED-DATE (invalid-date-format, 1) <> SPACES - OR FUNCTION EXCEPTION-STATUS <> "EC-ARGUMENT-FUNCTION" - OR FUNCTION EXCEPTION-LOCATION <> "prog; ; 18" - DISPLAY "Test 2 failed" END-DISPLAY - END-IF - - IF FUNCTION FORMATTED-DATETIME - (invalid-datetime-format, 1, 1) <> SPACES - OR FUNCTION EXCEPTION-STATUS <> "EC-ARGUMENT-FUNCTION" - OR FUNCTION EXCEPTION-LOCATION <> "prog; ; 24" - DISPLAY "Test 3 failed" END-DISPLAY - END-IF - - IF FUNCTION FORMATTED-TIME (invalid-time-format, 1) <> SPACES - OR FUNCTION EXCEPTION-STATUS <> "EC-ARGUMENT-FUNCTION" - OR FUNCTION EXCEPTION-LOCATION <> "prog; ; 31" - DISPLAY "Test 4 failed" END-DISPLAY - END-IF - - IF FUNCTION INTEGER-OF-FORMATTED-DATE - (invalid-date-format, 1) <> ZERO - OR FUNCTION EXCEPTION-STATUS <> "EC-ARGUMENT-FUNCTION" - OR FUNCTION EXCEPTION-LOCATION <> "prog; ; 37" - DISPLAY "Test 5 failed" END-DISPLAY - END-IF - - IF FUNCTION SECONDS-FROM-FORMATTED-TIME - (invalid-time-format, 1) <> ZERO - OR FUNCTION EXCEPTION-STATUS <> "EC-ARGUMENT-FUNCTION" - OR FUNCTION EXCEPTION-LOCATION <> "prog; ; 44" - DISPLAY "Test 6 failed" END-DISPLAY - END-IF - - IF FUNCTION TEST-FORMATTED-DATETIME - (invalid-datetime-format, 1) <> ZERO - OR FUNCTION EXCEPTION-STATUS <> "EC-ARGUMENT-FUNCTION" - OR FUNCTION EXCEPTION-LOCATION <> "prog; ; 51" - DISPLAY "Test 7 failed" END-DISPLAY - END-IF - - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_functions.at:4027: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_functions.at:4027" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob:11: warning: FUNCTION 'FORMATTED-CURRENT-DATE' has format in variable -prog.cob:18: warning: FUNCTION 'FORMATTED-DATE' has format in variable -prog.cob:24: warning: FUNCTION 'FORMATTED-DATETIME' has format in variable -prog.cob:31: warning: FUNCTION 'FORMATTED-TIME' has format in variable -prog.cob:37: warning: FUNCTION 'INTEGER-OF-FORMATTED-DATE' has format in variable -prog.cob:44: warning: FUNCTION 'SECONDS-FROM-FORMATTED-TIME' has format in variable -prog.cob:51: warning: FUNCTION 'TEST-FORMATTED-DATETIME' has format in variable -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_functions.at:4027" -$at_failed && at_fn_log_failure -$at_traceon; } - - -# running the program -{ set +x -$as_echo "$at_srcdir/run_functions.at:4038: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_functions.at:4038" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_functions.at:4038" -$at_failed && at_fn_log_failure -$at_traceon; } - - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_939 -#AT_START_940 -at_fn_group_banner 940 'run_functions.at:4044' \ - "FORMATTED-(DATE)TIME with SYSTEM-OFFSET" " " 4 -at_xfail=no -( - $as_echo "940. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 str PIC X(30). - 77 val pic 9(02). - - PROCEDURE DIVISION. - MOVE FUNCTION FORMATTED-DATETIME - ("YYYYDDDThhmmss+hhmm", 1, 45296, SYSTEM-OFFSET) - TO str - MOVE FUNCTION TEST-FORMATTED-DATETIME - ("YYYYDDDThhmmss+hhmm", str) TO val - IF val not = 0 - DISPLAY "Test 1 failed: " str ' - ' val END-DISPLAY - END-IF - - MOVE FUNCTION FORMATTED-TIME - ("hhmmss.ssZ", 45296, SYSTEM-OFFSET) - TO str - MOVE FUNCTION TEST-FORMATTED-DATETIME - ("hhmmss.ssZ", str) TO val - IF val not = 0 - DISPLAY "Test 2 failed: " str ' - ' val END-DISPLAY - END-IF - . -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_functions.at:4076: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_functions.at:4076" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_functions.at:4076" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_functions.at:4077: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_functions.at:4077" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_functions.at:4077" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_940 -#AT_START_941 -at_fn_group_banner 941 'run_functions.at:4082' \ - "Intrinsics without FUNCTION keyword (1)" " " 4 -at_xfail=no -( - $as_echo "941. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 Z PIC 99V99. - PROCEDURE DIVISION. - MOVE PI TO Z. - MOVE E TO Z. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_functions.at:4097: \$COMPILE -w -fintrinsics=all prog.cob" -at_fn_check_prepare_dynamic "$COMPILE -w -fintrinsics=all prog.cob" "run_functions.at:4097" -( $at_check_trace; $COMPILE -w -fintrinsics=all prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_functions.at:4097" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_functions.at:4098: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_functions.at:4098" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_functions.at:4098" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_941 -#AT_START_942 -at_fn_group_banner 942 'run_functions.at:4103' \ - "Intrinsics without FUNCTION keyword (2)" " " 4 -at_xfail=no -( - $as_echo "942. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 Z PIC 99V99. - PROCEDURE DIVISION. - MOVE PI TO Z. - MOVE E TO Z. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_functions.at:4118: \$COMPILE -w -fintrinsics=pi,e prog.cob" -at_fn_check_prepare_dynamic "$COMPILE -w -fintrinsics=pi,e prog.cob" "run_functions.at:4118" -( $at_check_trace; $COMPILE -w -fintrinsics=pi,e prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_functions.at:4118" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_functions.at:4119: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_functions.at:4119" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_functions.at:4119" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_942 -#AT_START_943 -at_fn_group_banner 943 'run_functions.at:4126' \ - "User-Defined FUNCTION with/without parameter" " " 4 -at_xfail=no -( - $as_echo "943. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - FUNCTION-ID. WITHPAR. - DATA DIVISION. - LINKAGE SECTION. - 01 PAR-IN PIC 9. - 01 PAR-OUT PIC 9. - PROCEDURE DIVISION USING PAR-IN RETURNING PAR-OUT. - ADD 1 TO PAR-IN GIVING PAR-OUT END-ADD. - GOBACK. - END FUNCTION WITHPAR. - - IDENTIFICATION DIVISION. - FUNCTION-ID. WITHOUTPAR. - DATA DIVISION. - LINKAGE SECTION. - 01 PAR PIC 9. - PROCEDURE DIVISION RETURNING PAR. - MOVE 1 TO PAR. - GOBACK. - END FUNCTION WITHOUTPAR. - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - CONFIGURATION SECTION. - REPOSITORY. - FUNCTION WITHPAR - FUNCTION WITHOUTPAR. - PROCEDURE DIVISION. - IF WITHPAR(1) NOT = 2 - DISPLAY WITHPAR(1) - END-DISPLAY - END-IF. - IF WITHOUTPAR NOT = 1 - DISPLAY WITHOUTPAR - END-DISPLAY - END-IF. - STOP RUN. - END PROGRAM prog. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_functions.at:4171: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_functions.at:4171" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_functions.at:4171" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_functions.at:4172: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_functions.at:4172" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_functions.at:4172" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_943 -#AT_START_944 -at_fn_group_banner 944 'run_functions.at:4177' \ - "UDF in COMPUTE" " " 4 -at_xfail=no -( - $as_echo "944. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - FUNCTION-ID. func. - - DATA DIVISION. - LINKAGE SECTION. - 01 num PIC 999. - - PROCEDURE DIVISION RETURNING num. - MOVE 100 TO num - . - END FUNCTION func. - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - - ENVIRONMENT DIVISION. - CONFIGURATION SECTION. - REPOSITORY. - FUNCTION func. - - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 x PIC 999. - - PROCEDURE DIVISION. - COMPUTE x = 101 + FUNCTION func - DISPLAY x - . - END PROGRAM prog. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_functions.at:4212: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_functions.at:4212" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_functions.at:4212" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_functions.at:4213: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_functions.at:4213" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo "201 -" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_functions.at:4213" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_944 -#AT_START_945 -at_fn_group_banner 945 'run_functions.at:4220' \ - "UDF replacing intrinsic function" " " 4 -at_xfail=no -( - $as_echo "945. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - FUNCTION-ID. SUBSTITUTE. - - DATA DIVISION. - LINKAGE SECTION. - 01 func-in PIC X(15). - 01 func-sub PIC X. - 01 func-out PIC X(15). - - PROCEDURE DIVISION USING func-in, func-sub RETURNING func-out. - MOVE func-in TO func-out - INSPECT func-out REPLACING ALL '%' BY func-sub - . - END FUNCTION SUBSTITUTE. - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - - ENVIRONMENT DIVISION. - CONFIGURATION SECTION. - REPOSITORY. - FUNCTION SUBSTITUTE - . - PROCEDURE DIVISION. - DISPLAY '"' FUNCTION SUBSTITUTE(" % C%O%B%O%L % ", "_") '"' - DISPLAY '"' FUNCTION SUBSTITUTE(" % C%O%B%O%L % ", "-") '"' - . - END PROGRAM prog. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_functions.at:4254: \$COMPILE -fnot-intrinsic=substitute prog.cob" -at_fn_check_prepare_dynamic "$COMPILE -fnot-intrinsic=substitute prog.cob" "run_functions.at:4254" -( $at_check_trace; $COMPILE -fnot-intrinsic=substitute prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_functions.at:4254" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_functions.at:4255: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_functions.at:4255" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo "\" _ C_O_B_O_L _ \" -\" - C-O-B-O-L - \" -" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_functions.at:4255" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_945 -#AT_START_946 -at_fn_group_banner 946 'run_functions.at:4263' \ - "UDF with recursion (1)" " " 4 -at_xfail=no -( - $as_echo "946. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -$as_echo "run_functions.at:4266" >"$at_check_line_file" -at_fn_check_skip 77 "$at_srcdir/run_functions.at:4266" # see bug #222 and r2291 - postponed - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - FUNCTION-ID. foo. - - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 ttl PIC 9 VALUE 1. - - LOCAL-STORAGE SECTION. - 01 num PIC 9. - - LINKAGE SECTION. - 01 arg PIC 9. - 01 ret PIC 9. - - PROCEDURE DIVISION USING arg RETURNING ret. - IF arg < 5 - ADD 1 TO arg GIVING num END-ADD - MOVE FUNCTION foo (num) TO ret - ELSE - MOVE arg TO ret - END-IF - DISPLAY "Step: " ttl ", Arg: " arg ", Return: " ret - END-DISPLAY - ADD 1 to ttl END-ADD - GOBACK. - END FUNCTION foo. - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - - ENVIRONMENT DIVISION. - CONFIGURATION SECTION. - REPOSITORY. - FUNCTION foo. - - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 num PIC 9 VALUE 1. - - PROCEDURE DIVISION. - DISPLAY "Return value '" FUNCTION foo (num) "'" - WITH NO ADVANCING - END-DISPLAY - GOBACK. - END PROGRAM prog. - -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_functions.at:4317: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_functions.at:4317" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_functions.at:4317" -$at_failed && at_fn_log_failure -$at_traceon; } - - -{ set +x -$as_echo "$at_srcdir/run_functions.at:4319: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_functions.at:4319" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo "Step: 1, Arg: 5, Return: 5 -Step: 2, Arg: 4, Return: 5 -Step: 3, Arg: 3, Return: 5 -Step: 4, Arg: 2, Return: 5 -Step: 5, Arg: 1, Return: 5 -Return value '5'" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_functions.at:4319" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_946 -#AT_START_947 -at_fn_group_banner 947 'run_functions.at:4330' \ - "UDF with recursion (2)" " " 4 -at_xfail=no -( - $as_echo "947. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - - ENVIRONMENT DIVISION. - CONFIGURATION SECTION. - REPOSITORY. - FUNCTION foo. - - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 num PIC 9 VALUE 1. - - PROCEDURE DIVISION. - DISPLAY "Begin recursive function test". - DISPLAY "Return value '" FUNCTION foo (num) "'". - DISPLAY "End of test". - END PROGRAM prog. - - IDENTIFICATION DIVISION. - FUNCTION-ID. foo. - ENVIRONMENT DIVISION. - CONFIGURATION SECTION. - REPOSITORY. - FUNCTION foo. - - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 ttl PIC 9 VALUE 1. - - LOCAL-STORAGE SECTION. - 01 num PIC 9. - - LINKAGE SECTION. - 01 arg PIC 9. - 01 ret PIC 9. - - PROCEDURE DIVISION USING arg RETURNING ret. - IF arg < 5 - ADD 1 TO arg GIVING num - MOVE FUNCTION foo (num) TO ret - ELSE - MOVE arg TO ret - END-IF. - DISPLAY "Step: " ttl ", Arg: " arg ", '" ret "'". - ADD 1 to ttl. - END FUNCTION foo. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_functions.at:4382: cobc -x -std=mf -w prog.cob " -at_fn_check_prepare_trace "run_functions.at:4382" -( $at_check_trace; cobc -x -std=mf -w prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_functions.at:4382" -$at_failed && at_fn_log_failure -$at_traceon; } - - -{ set +x -$as_echo "$at_srcdir/run_functions.at:4384: ./prog" -at_fn_check_prepare_trace "run_functions.at:4384" -( $at_check_trace; ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo "Begin recursive function test -Step: 1, Arg: 5, '5' -Step: 2, Arg: 4, '5' -Step: 3, Arg: 3, '5' -Step: 4, Arg: 2, '5' -Step: 5, Arg: 1, '5' -Return value '5' -End of test -" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_functions.at:4384" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_947 -#AT_START_948 -at_fn_group_banner 948 'run_extensions.at:25' \ - "CALL BY CONTENT binary and literal" " " 4 -at_xfail=no -( - $as_echo "948. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >dump.c <<'_ATEOF' - -#include -#include - -COB_EXT_EXPORT int -dump (unsigned char *data, char *p) -{ - int i; - if ( *p == 0 ) p++; - if ( *p == 0 ) p++; /* Skip for BIG Endian system */ - if ( *p == 0 ) p++; - if ( *p == 1 ) { - for (i = 0; i < 4; i++) - printf ("%02x", data[i]); - } else { - printf ("%8.8d", *((int *)data)); - } - puts (""); - return 0; -} -_ATEOF - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 X-1 PIC 9(9) VALUE 4660 COMP. - 01 X-2 PIC 9(9) VALUE 4660 COMP-5. - PROCEDURE DIVISION. - CALL "dump" USING X-1 BY CONTENT 1 - END-CALL. - CALL "dump" USING X-2 BY CONTENT 2 - END-CALL. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_extensions.at:65: \$COMPILE_MODULE dump.c" -at_fn_check_prepare_dynamic "$COMPILE_MODULE dump.c" "run_extensions.at:65" -( $at_check_trace; $COMPILE_MODULE dump.c -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_extensions.at:65" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_extensions.at:66: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_extensions.at:66" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_extensions.at:66" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_extensions.at:67: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_extensions.at:67" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo "00001234 -00004660 -" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_extensions.at:67" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_948 -#AT_START_949 -at_fn_group_banner 949 'run_extensions.at:75' \ - "Numeric Boolean literals" " " 4 -at_xfail=no -( - $as_echo "949. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 X-1 PIC 9(2) VALUE B"010101". - 01 X-2 PIC 9(20) VALUE B"111111111111111111111111111111 - - "111111111111111111111111111111 - - "1111". - PROCEDURE DIVISION. - DISPLAY X-1 - END-DISPLAY. - DISPLAY X-2 - END-DISPLAY. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_extensions.at:95: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_extensions.at:95" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_extensions.at:95" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_extensions.at:96: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_extensions.at:96" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo "21 -18446744073709551615 -" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_extensions.at:96" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_949 -#AT_START_950 -at_fn_group_banner 950 'run_extensions.at:104' \ - "ACUCOBOL literals" " " 4 -at_xfail=no -( - $as_echo "950. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - PROCEDURE DIVISION. - DISPLAY B#101 UPON STDOUT - DISPLAY O#17777777777 UPON STDOUT - DISPLAY X#ffFFFFff UPON STDOUT - DISPLAY H#ffFFFFff UPON STDOUT - - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_extensions.at:119: \$COMPILE -facu-literals=ok prog.cob" -at_fn_check_prepare_dynamic "$COMPILE -facu-literals=ok prog.cob" "run_extensions.at:119" -( $at_check_trace; $COMPILE -facu-literals=ok prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_extensions.at:119" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_extensions.at:120: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_extensions.at:120" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo "5 -2147483647 -4294967295 -4294967295 -" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_extensions.at:120" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_950 -#AT_START_951 -at_fn_group_banner 951 'run_extensions.at:130' \ - "HP COBOL octal literals" " " 4 -at_xfail=yes -( - $as_echo "951. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -# FIXME: the type of octal literals must be context-sensitive, see below -# currently hard-wired as numeric (may be switched in scanner.l to alphanumeric) - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - *> Octal literal is "AB" in ASCII. - 01 ITEM-ALPHA PIC XX VALUE %40502. - *> Octal literal is 39. - 01 ITEM-NUMERIC PIC 99 BINARY VALUE %47. - *> Octal literal is ASCII 12. - 01 ITEM-NUM PIC 99 VALUE %30462. - PROCEDURE DIVISION. - *> Octal literal is "XY". - DISPLAY %54131. - IF ITEM-ALPHA NOT = "AB" - DISPLAY "VALUE %40502 is not ""AB"" (ASCII) but " - ITEM-ALPHA - END-IF - IF ITEM-NUMERIC NOT = 39 - DISPLAY "VALUE %47 BINARY is not 39 but " ITEM-NUMERIC - END-IF - IF ITEM-NUM NOT = 12 - DISPLAY "VALUE %30462 is not 12 (ASCII) but " ITEM-NUM - END-IF - *> Adds octal 23 (decimal 19, as it is an arithmetic expression). - ADD %23 TO ITEM-NUM. - IF ITEM-NUM NOT = 31 - DISPLAY "12 + %23 (19) is not 31 but " ITEM-NUM - END-IF - *> Sets the data to octal 30462 (ASCII 12). - MOVE %30462 TO ITEM-NUM - IF ITEM-NUM NOT = 12 - DISPLAY "%30462 is not 12 (ASCII) but " ITEM-NUM - END-IF - *> Sets the data to x'4100' (octal 101 -> ASCII A + right-pad NULL) - MOVE %101 TO ITEM-ALPHA - IF ITEM-ALPHA NOT = x"4100" - DISPLAY "%101 is not x""4100"" = Anull (ASCII) but " - ITEM-ALPHA - END-IF - - - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_extensions.at:183: \$COMPILE -fhp-octal-literals=ok prog.cob" -at_fn_check_prepare_dynamic "$COMPILE -fhp-octal-literals=ok prog.cob" "run_extensions.at:183" -( $at_check_trace; $COMPILE -fhp-octal-literals=ok prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_extensions.at:183" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_extensions.at:184: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_extensions.at:184" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo "XY -" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_extensions.at:184" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_951 -#AT_START_952 -at_fn_group_banner 952 'run_extensions.at:191' \ - "Hexadecimal numeric literals" " " 4 -at_xfail=no -( - $as_echo "952. $at_setup_line: testing $at_desc ..." - $at_traceon - # FIXME: needs a dialect configuration - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 X-1 PIC 9(8) VALUE H"012345". - 01 X-2 PIC 9(8) VALUE H"FFFFFF". - PROCEDURE DIVISION. - DISPLAY X-1 - END-DISPLAY. - DISPLAY X-2 - END-DISPLAY. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_extensions.at:209: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_extensions.at:209" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_extensions.at:209" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_extensions.at:210: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_extensions.at:210" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo "00074565 -16777215 -" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_extensions.at:210" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_952 -#AT_START_953 -at_fn_group_banner 953 'run_extensions.at:218' \ - "CALL USING numeric literal" " " 4 -at_xfail=no -( - $as_echo "953. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 MYRTN PIC X(9) VALUE "SUB ". - 01 BINFLD PIC S9(9) BINARY VALUE 1280. - - PROCEDURE DIVISION. - CALL "SUB" USING LENGTH OF MYRTN BY VALUE 10. - CALL "SUB" USING BINFLD BY VALUE 11. - CALL "SUB" USING BY CONTENT BINFLD BY VALUE 12. - CALL "SUB" USING BINFLD BY VALUE 13. - CALL "SUB" USING 1280 BY VALUE 14. - CALL "SUB" USING -1280 BY VALUE 15. - CALL "SUB" USING BY CONTENT 1280 BY VALUE 16. - CALL "SUB" USING BY CONTENT -1280 BY VALUE 17. - CALL "SUB" USING BY REFERENCE 1280 BY VALUE 18. - CALL "SUB" USING BY REFERENCE -1280 BY VALUE 19. - CALL "SUB" USING BY CONTENT BINFLD BY VALUE 20. - CALL "SUB" USING BY REFERENCE BINFLD BY VALUE 21. - CALL "SUB" USING 1665431892 BY VALUE 22. - CALL "SUB" USING 1665.892 BY VALUE 23. - CALL "SUB" USING 1665.89200 BY VALUE 24. - STOP RUN. - END PROGRAM prog. - - IDENTIFICATION DIVISION. - PROGRAM-ID. "SUB". - - DATA DIVISION. - LINKAGE SECTION. - 01 x PIC S9(9) BINARY. - 01 y PIC 9(9) COMP-5. - - PROCEDURE DIVISION USING x, VALUE y. - DISPLAY "COBOL: X is " x " and Y is " y. - ADD 1 TO x. - END PROGRAM "SUB". -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_extensions.at:262: cobc -x -std=mf -debug -Wall prog.cob" -at_fn_check_prepare_trace "run_extensions.at:262" -( $at_check_trace; cobc -x -std=mf -debug -Wall prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_extensions.at:262" -$at_failed && at_fn_log_failure -$at_traceon; } - - -{ set +x -$as_echo "$at_srcdir/run_extensions.at:264: ./prog" -at_fn_check_prepare_trace "run_extensions.at:264" -( $at_check_trace; ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo "COBOL: X is +000000009 and Y is 0000000010 -COBOL: X is +000001280 and Y is 0000000011 -COBOL: X is +000001281 and Y is 0000000012 -COBOL: X is +000001281 and Y is 0000000013 -COBOL: X is +000001280 and Y is 0000000014 -COBOL: X is -000001280 and Y is 0000000015 -COBOL: X is +000001280 and Y is 0000000016 -COBOL: X is -000001280 and Y is 0000000017 -COBOL: X is +000001280 and Y is 0000000018 -COBOL: X is -000001280 and Y is 0000000019 -COBOL: X is +000001282 and Y is 0000000020 -COBOL: X is +000001282 and Y is 0000000021 -COBOL: X is +665431892 and Y is 0000000022 -COBOL: X is +001665892 and Y is 0000000023 -COBOL: X is +166589200 and Y is 0000000024 -" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_extensions.at:264" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_953 -#AT_START_954 -at_fn_group_banner 954 'run_extensions.at:286' \ - "Semi-parenthesized condition" " " 4 -at_xfail=no -( - $as_echo "954. $at_setup_line: testing $at_desc ..." - $at_traceon - - # Shouldn't this be in run_fundamentals? - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - PROCEDURE DIVISION. - IF 1 = (1 OR 2) - DISPLAY "OK" NO ADVANCING - END-DISPLAY - END-IF. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_extensions.at:300: \$COMPILE -Wno-constant-expression prog.cob" -at_fn_check_prepare_dynamic "$COMPILE -Wno-constant-expression prog.cob" "run_extensions.at:300" -( $at_check_trace; $COMPILE -Wno-constant-expression prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_extensions.at:300" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_extensions.at:301: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_extensions.at:301" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo "OK" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_extensions.at:301" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_954 -#AT_START_955 -at_fn_group_banner 955 'run_extensions.at:306' \ - "ADDRESS OF" " " 4 -at_xfail=no -( - $as_echo "955. $at_setup_line: testing $at_desc ..." - $at_traceon - # Shouldn't this be in run_fundamentals? - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 X-1 PIC X(3) VALUE "X-1". - 01 X-2 PIC X(3) VALUE "X-2". - 01 G. - 02 PTR-1 USAGE POINTER VALUE NULL. - 02 PTR-2 USAGE POINTER VALUE NULL. - LINKAGE SECTION. - 01 Y PIC X(3). - PROCEDURE DIVISION. - SET ADDRESS OF Y TO ADDRESS OF X-1. - IF Y NOT = "X-1" - DISPLAY "Test 1 " Y - END-DISPLAY - END-IF. - SET PTR-1 TO ADDRESS OF X-2. - SET PTR-2 TO PTR-1 - SET ADDRESS OF Y TO PTR-2. - IF Y NOT = "X-2" - DISPLAY "Test 2 " Y - END-DISPLAY - END-IF - INITIALIZE PTR-1. - IF PTR-1 NOT = NULL - DISPLAY "NG 1" - END-DISPLAY - END-IF. - SET ADDRESS OF Y TO NULL. - IF PTR-1 NOT = ADDRESS OF Y - DISPLAY "NG 2" - END-DISPLAY - END-IF. - IF ADDRESS OF Y NOT = PTR-1 - DISPLAY "NG 3" - END-DISPLAY - END-IF. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_extensions.at:350: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_extensions.at:350" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_extensions.at:350" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_extensions.at:351: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_extensions.at:351" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_extensions.at:351" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_955 -#AT_START_956 -at_fn_group_banner 956 'run_extensions.at:356' \ - "LENGTH OF" " " 4 -at_xfail=no -( - $as_echo "956. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 X PIC X(2). - 01 G. - 02 Y PIC X(2) OCCURS 10. - 02 G-GROUP. - 03 G-SGROUP. - 04 G1 PIC X(05). - 04 G2 PIC X(06). - 04 G3 PIC X(22). - 03 FILLER PIC XX OCCURS 5. - 66 RENAME-STD-G RENAMES G-GROUP. - 66 RENAME-STD-SG RENAMES G-SGROUP. - 66 RENAME-STD RENAMES G1 THROUGH G3. - 66 RENAME-G RENAMES G. - 01 L PIC s9(4)v99. - 01 I PIC 9(2) VALUE 10. - 78 I-LEN VALUE LENGTH OF I. - * TODO: check size of FILLER here - 01 TSTDISP. - 02 FILLER OCCURS 5000. - 10 T1 PIC X(11). - 10 T2 PIC X(22). - 78 var-length-l value length of '00128'. - 78 var-length-x value length of x'a0'. - 78 var-length-z value length of z'a0'. - *78 var-length-n value length of n'001'. - PROCEDURE DIVISION. - move var-length-l TO L - IF L NOT = 5 - DISPLAY "Length '00128'" L - END-DISPLAY - END-IF - move var-length-x TO L - IF L NOT = 1 - DISPLAY "Length x'a0'" L - END-DISPLAY - END-IF - move var-length-z TO L - IF L NOT = 3 - DISPLAY "Length z'a0'" L - END-DISPLAY - END-IF - * What does MF reports here? - *> move var-length-n TO L - *> IF L NOT = 3 - *> DISPLAY "Length n'001'" L - *> END-DISPLAY - *> END-IF - MOVE LENGTH OF X TO L - IF L NOT = 2 - DISPLAY "Length 1 " L - END-DISPLAY - END-IF - MOVE LENGTH OF X TO L - IF L NOT = 2 - DISPLAY "Length 1a " L LENGTH X - END-DISPLAY - END-IF - MOVE LENGTH OF Y TO L - IF L NOT = 2 - DISPLAY "Length 2 " L - END-DISPLAY - END-IF - IF L NOT = 2 - DISPLAY "Length 2a " L LENGTH OF Y - END-DISPLAY - END-IF - MOVE LENGTH OF Y(1) TO L - IF L NOT = 2 - DISPLAY "Length 3 " L - END-DISPLAY - END-IF - MOVE LENGTH Y(1) TO L - IF L NOT = 2 - DISPLAY "Length 3a " L LENGTH OF Y(1) - END-DISPLAY - END-IF - IF I-LEN NOT = 2 - DISPLAY "Length 4 " I-LEN - END-DISPLAY - END-IF - IF LENGTH OF L + 2 NOT = 8 - ADD 2 TO LENGTH OF L GIVING L - DISPLAY "Length 5 + 2" L - END-DISPLAY - END-IF - IF LENGTH L + 2 NOT = 8 - ADD 2 TO LENGTH L GIVING L - DISPLAY "Length 5a + 2 " L - END-DISPLAY - END-IF - MOVE 0 TO L - PERFORM LENGTH OF L TIMES - ADD 1 TO L - END-PERFORM - PERFORM LENGTH L TIMES - ADD 1 TO L - END-PERFORM - IF L NOT = 12 - DISPLAY "Length 6 " L - END-DISPLAY - END-IF - MOVE 0 TO L - PERFORM VARME - VARYING I FROM LENGTH OF I - BY LENGTH OF X - UNTIL I > LENGTH OF L - IF ((L NOT = 3) OR - (I NOT = 8) ) - DISPLAY "Length 7 " L " - " I - END-DISPLAY - END-IF - MOVE 0 TO L - PERFORM VARME - VARYING I FROM LENGTH I - BY LENGTH X - UNTIL I > LENGTH L - IF ((L NOT = 3) OR - (I NOT = 8) ) - DISPLAY "Length 7a " L " - " I - END-DISPLAY - END-IF - MOVE LENGTH OF RENAME-STD-SG TO L - IF L NOT = 33 - DISPLAY "Length 8a " L - END-DISPLAY - END-IF - MOVE LENGTH OF RENAME-STD-G TO L - IF L NOT = 43 - DISPLAY "Length 8b " L - END-DISPLAY - END-IF - MOVE LENGTH OF RENAME-STD TO L - IF L NOT = 33 - DISPLAY "Length 8c " L - END-DISPLAY - END-IF - MOVE LENGTH OF RENAME-G TO L - IF L NOT = 63 - DISPLAY "Length 8d " L - END-DISPLAY - END-IF - *> one display test - DISPLAY LENGTH OF TSTDISP WITH NO ADVANCING - END-DISPLAY - STOP RUN. - VARME. - ADD 1 TO L - . -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_extensions.at:514: \$COMPILE -Wno-constant-expression prog.cob" -at_fn_check_prepare_dynamic "$COMPILE -Wno-constant-expression prog.cob" "run_extensions.at:514" -( $at_check_trace; $COMPILE -Wno-constant-expression prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_extensions.at:514" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_extensions.at:515: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_extensions.at:515" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo "165000" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_extensions.at:515" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_956 -#AT_START_957 -at_fn_group_banner 957 'run_extensions.at:520' \ - "SET TO SIZE OF" " " 4 -at_xfail=no -( - $as_echo "957. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - CONFIGURATION SECTION. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 TST PIC X(10) VALUE "abcdefghij". - 01 TST2. - 05 FILLER OCCURS 5000. - 10 T2-1 PIC X(11). - 10 T2-2 PIC X(22). - 01 LN PIC 9(06). - - PROCEDURE DIVISION. - SET LN TO SIZE OF TST - IF LN NOT = 10 - DISPLAY "SIZE OF TST is " LN UPON SYSERR - END-DISPLAY - END-IF - SET LN TO SIZE OF TST2 - IF LN NOT = 165000 - DISPLAY "SIZE OF TST2 is " LN UPON SYSERR - END-DISPLAY - END-IF - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_extensions.at:551: \$COMPILE prog.cob " -at_fn_check_prepare_dynamic "$COMPILE prog.cob " "run_extensions.at:551" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_extensions.at:551" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_extensions.at:552: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_extensions.at:552" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_extensions.at:552" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_957 -#AT_START_958 -at_fn_group_banner 958 'run_extensions.at:557' \ - "WHEN-COMPILED" " " 4 -at_xfail=no -( - $as_echo "958. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 X PIC X(20). - PROCEDURE DIVISION. - MOVE WHEN-COMPILED TO X. - INSPECT X CONVERTING "0123456789" TO "9999999999". - IF X NOT = "99/99/9999.99.99 " - CALL 'CBL_OC_DUMP' USING X - ON EXCEPTION - DISPLAY X NO ADVANCING - END-DISPLAY - END-CALL - END-IF - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_extensions.at:579: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_extensions.at:579" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_extensions.at:579" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_extensions.at:580: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_extensions.at:580" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_extensions.at:580" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_958 -#AT_START_959 -at_fn_group_banner 959 'run_extensions.at:586' \ - "Complex OCCURS DEPENDING ON (1)" " " 4 -at_xfail=no -( - $as_echo "959. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 I PIC 9. - 01 G-1 VALUE "123456789". - 02 G-2. - 03 X PIC X OCCURS 1 TO 3 DEPENDING ON I. - 02 G-3. - 03 G-4. - 04 X PIC X OCCURS 1 TO 3 DEPENDING ON I. - 03 G-5. - 04 X PIC X OCCURS 1 TO 3 DEPENDING ON I. - PROCEDURE DIVISION. - MOVE 2 TO I. - DISPLAY G-1 ":" G-4 ":" G-5 NO ADVANCING - . -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_extensions.at:609: \$COMPILE -std=mvs prog.cob" -at_fn_check_prepare_dynamic "$COMPILE -std=mvs prog.cob" "run_extensions.at:609" -( $at_check_trace; $COMPILE -std=mvs prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_extensions.at:609" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_extensions.at:610: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_extensions.at:610" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo "123456:34:56" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_extensions.at:610" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_959 -#AT_START_960 -at_fn_group_banner 960 'run_extensions.at:615' \ - "Complex OCCURS DEPENDING ON (2)" " " 4 -at_xfail=no -( - $as_echo "960. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 I PIC 99. - 01 J PIC 99. - 01 K PIC 99. - 01 VLEN PIC 99. - 01 VTOP. - 03 VGROUP. - 05 VX OCCURS 1 TO 5 DEPENDING ON I. - 10 VXX PIC X(1). - 05 VY OCCURS 1 TO 5 DEPENDING ON J. - 10 VYY PIC X(2). - 05 ZZ OCCURS 1 TO 5 DEPENDING ON K. - 10 VZZ PIC X(3). - PROCEDURE DIVISION. - MOVE 1 TO I. - MOVE 1 TO J. - MOVE 1 TO K. - MOVE '1' TO VXX (1). - MOVE '22' TO VYY (1). - MOVE '333' TO VZZ (1). - MOVE LENGTH OF VGROUP TO VLEN. - DISPLAY VLEN NO ADVANCING - END-DISPLAY. - MOVE FUNCTION LENGTH (VGROUP) TO VLEN. - DISPLAY VLEN NO ADVANCING - END-DISPLAY. - DISPLAY VGROUP - END-DISPLAY. - INITIALIZE VTOP. - MOVE 3 TO I. - MOVE 2 TO J. - MOVE 1 TO K. - MOVE '3' TO VXX (3). - MOVE '22' TO VYY (2). - MOVE '111' TO VZZ (1). - MOVE LENGTH OF VGROUP TO VLEN. - DISPLAY VLEN NO ADVANCING - END-DISPLAY. - MOVE FUNCTION LENGTH (VGROUP) TO VLEN. - DISPLAY VLEN NO ADVANCING - END-DISPLAY. - DISPLAY VGROUP - END-DISPLAY. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_extensions.at:669: \$COMPILE -std=mf prog.cob" -at_fn_check_prepare_dynamic "$COMPILE -std=mf prog.cob" "run_extensions.at:669" -( $at_check_trace; $COMPILE -std=mf prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_extensions.at:669" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_extensions.at:670: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_extensions.at:670" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo "18181 22 333 -1818 3 22 111 -" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_extensions.at:670" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_960 -#AT_START_961 -at_fn_group_banner 961 'run_extensions.at:678' \ - "Complex OCCURS DEPENDING ON (3)" " " 4 -at_xfail=no -( - $as_echo "961. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 I PIC 99. - 01 J PIC 99. - 01 K PIC 99. - 01 VLEN PIC 99. - 01 VTOP. - 03 VGROUP. - 05 VX OCCURS 1 TO 5 DEPENDING ON I. - 10 VXX PIC X(1). - 05 VY OCCURS 1 TO 5 DEPENDING ON J. - 10 VYY PIC X(2). - 05 ZZ OCCURS 1 TO 5 DEPENDING ON K. - 10 VZZ PIC X(3). - PROCEDURE DIVISION. - MOVE 1 TO I. - MOVE 1 TO J. - MOVE 1 TO K. - MOVE '1' TO VXX (1). - MOVE '22' TO VYY (1). - MOVE '333' TO VZZ (1). - MOVE LENGTH OF VGROUP TO VLEN. - DISPLAY VLEN NO ADVANCING - END-DISPLAY. - MOVE FUNCTION LENGTH (VGROUP) TO VLEN. - DISPLAY VLEN NO ADVANCING - END-DISPLAY. - DISPLAY VGROUP - END-DISPLAY. - INITIALIZE VTOP. - MOVE 3 TO I. - MOVE 2 TO J. - MOVE 1 TO K. - MOVE '3' TO VXX (3). - MOVE '22' TO VYY (2). - MOVE '111' TO VZZ (1). - MOVE LENGTH OF VGROUP TO VLEN. - DISPLAY VLEN NO ADVANCING - END-DISPLAY. - MOVE FUNCTION LENGTH (VGROUP) TO VLEN. - DISPLAY VLEN NO ADVANCING - END-DISPLAY. - DISPLAY VGROUP - END-DISPLAY. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_extensions.at:732: \$COMPILE -fcomplex-odo -fodoslide prog.cob" -at_fn_check_prepare_dynamic "$COMPILE -fcomplex-odo -fodoslide prog.cob" "run_extensions.at:732" -( $at_check_trace; $COMPILE -fcomplex-odo -fodoslide prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_extensions.at:732" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_extensions.at:733: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_extensions.at:733" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo "0606122333 -1010 3 22111 -" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_extensions.at:733" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_961 -#AT_START_962 -at_fn_group_banner 962 'run_extensions.at:741' \ - "Complex OCCURS DEPENDING ON (4)" " " 4 -at_xfail=no -( - $as_echo "962. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 I PIC 99. - 01 J PIC 99. - 01 K PIC 99. - 01 VLEN PIC 99. - 01 VTOP. - 03 VGROUP. - 05 VX OCCURS 1 TO 5 DEPENDING ON I. - 10 VXX PIC X(1). - 05 VY OCCURS 1 TO 5 DEPENDING ON J. - 10 VYY PIC X(2). - 05 ZZ OCCURS 1 TO 5 DEPENDING ON K. - 10 VZZ PIC X(3). - 05 VFIX PIC X(3). - PROCEDURE DIVISION. - MOVE 1 TO I. - MOVE 1 TO J. - MOVE 1 TO K. - MOVE '1' TO VXX (1). - MOVE '22' TO VYY (1). - MOVE '333' TO VZZ (1). - MOVE '444' TO VFIX. - MOVE LENGTH OF VGROUP TO VLEN. - DISPLAY VLEN NO ADVANCING - END-DISPLAY. - MOVE FUNCTION LENGTH (VGROUP) TO VLEN. - DISPLAY VLEN NO ADVANCING - END-DISPLAY. - DISPLAY VGROUP - END-DISPLAY. - INITIALIZE VTOP. - MOVE 3 TO I. - MOVE 2 TO J. - MOVE 1 TO K. - MOVE '3' TO VXX (3). - MOVE '22' TO VYY (2). - MOVE '111' TO VZZ (1). - MOVE '000' TO VFIX. - MOVE LENGTH OF VGROUP TO VLEN. - DISPLAY VLEN NO ADVANCING - END-DISPLAY. - MOVE FUNCTION LENGTH (VGROUP) TO VLEN. - DISPLAY VLEN NO ADVANCING - END-DISPLAY. - DISPLAY VGROUP - END-DISPLAY. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_extensions.at:798: \$COMPILE -fcomplex-odo prog.cob" -at_fn_check_prepare_dynamic "$COMPILE -fcomplex-odo prog.cob" "run_extensions.at:798" -( $at_check_trace; $COMPILE -fcomplex-odo prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_extensions.at:798" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_extensions.at:799: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_extensions.at:799" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo "33331 22 333 444 -3333 3 22 111 000 -" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_extensions.at:799" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_962 -#AT_START_963 -at_fn_group_banner 963 'run_extensions.at:807' \ - "Complex OCCURS DEPENDING ON (5)" " " 4 -at_xfail=no -( - $as_echo "963. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 I PIC 99. - 01 J PIC 99. - 01 K PIC 99. - 01 VLEN PIC 99. - 01 VTOP. - 03 VGROUP. - 05 VX OCCURS 1 TO 5 DEPENDING ON I. - 10 VXX PIC X(1). - 05 VY OCCURS 1 TO 5 DEPENDING ON J. - 10 VYY PIC X(2). - 05 ZZ OCCURS 1 TO 5 DEPENDING ON K. - 10 VZZ PIC X(3). - 05 VFIX PIC X(3). - PROCEDURE DIVISION. - MOVE 1 TO I. - MOVE 1 TO J. - MOVE 1 TO K. - MOVE '1' TO VXX (1). - MOVE '22' TO VYY (1). - MOVE '333' TO VZZ (1). - MOVE '444' TO VFIX. - MOVE LENGTH OF VGROUP TO VLEN. - DISPLAY VLEN NO ADVANCING - END-DISPLAY. - MOVE FUNCTION LENGTH (VGROUP) TO VLEN. - DISPLAY VLEN NO ADVANCING - END-DISPLAY. - DISPLAY VGROUP - END-DISPLAY. - INITIALIZE VTOP. - MOVE 3 TO I. - MOVE 2 TO J. - MOVE 1 TO K. - MOVE '3' TO VXX (3). - MOVE '22' TO VYY (2). - MOVE '111' TO VZZ (1). - MOVE '000' TO VFIX. - MOVE LENGTH OF VGROUP TO VLEN. - DISPLAY VLEN NO ADVANCING - END-DISPLAY. - MOVE FUNCTION LENGTH (VGROUP) TO VLEN. - DISPLAY VLEN NO ADVANCING - END-DISPLAY. - DISPLAY VGROUP - END-DISPLAY. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_extensions.at:864: \$COMPILE -fcomplex-odo -fodoslide prog.cob" -at_fn_check_prepare_dynamic "$COMPILE -fcomplex-odo -fodoslide prog.cob" "run_extensions.at:864" -( $at_check_trace; $COMPILE -fcomplex-odo -fodoslide prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_extensions.at:864" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_extensions.at:865: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_extensions.at:865" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo "0909122333444 -1313 3 22111000 -" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_extensions.at:865" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_963 -#AT_START_964 -at_fn_group_banner 964 'run_extensions.at:873' \ - "Complex OCCURS DEPENDING ON (6)" " " 4 -at_xfail=no -( - $as_echo "964. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 n PIC 9 VALUE 2. - 01 m PIC 9 VALUE 3. - - 01 a-table VALUE "ABCDEFGHIJ". - 03 rows OCCURS 0 TO 2 TIMES - DEPENDING ON n. - 05 chars OCCURS 0 TO 5 TIMES - DEPENDING ON m - PIC X. - - 01 vals PIC X(3). - - PROCEDURE DIVISION. - MOVE chars (1, 2) TO vals (1:1) - MOVE chars (2, 1) TO vals (2:1) - MOVE chars (2, 3) TO vals (3:1) - IF vals NOT = "BDF" - DISPLAY "Vals (slided) wrong: " vals - END-DISPLAY - END-IF - IF a-table NOT = "ABCDEF" - DISPLAY "Table (slided) wrong: " a-table - END-DISPLAY - END-IF - . -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_extensions.at:908: \$COMPILE -fcomplex-odo -fodoslide prog.cob" -at_fn_check_prepare_dynamic "$COMPILE -fcomplex-odo -fodoslide prog.cob" "run_extensions.at:908" -( $at_check_trace; $COMPILE -fcomplex-odo -fodoslide prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_extensions.at:908" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_extensions.at:909: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_extensions.at:909" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_extensions.at:909" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_964 -#AT_START_965 -at_fn_group_banner 965 'run_extensions.at:914' \ - "OCCURS UNBOUNDED (1)" " " 4 -at_xfail=no -( - $as_echo "965. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 n PIC 9(03) VALUE 123. - 01 p USAGE POINTER. - - LINKAGE SECTION. - 01 a-table. - 03 rows OCCURS 0 TO UNBOUNDED TIMES - DEPENDING ON n. - 05 col1 PIC X. - 05 col2 PIC X(02). - - PROCEDURE DIVISION. - IF FUNCTION LENGTH (a-table) NOT = 369 - DISPLAY 'WRONG LENGTH: ' FUNCTION LENGTH (a-table) - END-DISPLAY - END-IF - ALLOCATE FUNCTION LENGTH (a-table) CHARACTERS - INITIALIZED TO ALL "ABCDE" - RETURNING p - SET ADDRESS OF a-table TO p - IF col2(1) NOT = "BC" - DISPLAY "col2(1) wrong: " col2(1) - END-DISPLAY - END-IF - IF rows(2) NOT = "DEA" - DISPLAY "rows(2) wrong: " rows(2) - END-DISPLAY - END-IF - . -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_extensions.at:952: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_extensions.at:952" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_extensions.at:952" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_extensions.at:953: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_extensions.at:953" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_extensions.at:953" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_965 -#AT_START_966 -at_fn_group_banner 966 'run_extensions.at:958' \ - "OCCURS UNBOUNDED (2)" " " 4 -at_xfail=no -( - $as_echo "966. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -# note: the following example is from IBM's Language Reference -# for Enterprise COBOL for z/OS 6.1, but with fixed use -# of old-size (+ removing some binary zeros for output) - -cat >ALLOC.cob <<'_ATEOF' - - ID DIVISION. - PROGRAM-ID. ALLOC. - ENVIRONMENT DIVISION. - DATA DIVISION. - WORKING-STORAGE SECTION. - 77 X PIC 9(2) PACKED-DECIMAL. - 77 NUM-ELEMENTS PIC 9(4) BINARY. - 77 SIZE-NEEDED PIC 9(4) BINARY. - 77 old-size pic 9(4) binary. - 77 VPTR POINTER. - 77 VPTR2 POINTER. - 77 VPTR3 POINTER. - - LINKAGE SECTION. - - 01 VARGRP. - 02 OBJ PIC 9(4) COMP. - 02 TABGRP. - 03 VARTAB OCCURS 1 TO UNBOUNDED DEPENDING ON OBJ. - 04 T1 PIC 9(4). - 04 T2 PIC X(8). - 04 T3 PIC 9(4). *> changed from COMP because of output - 01 BUFFER PIC X(1000). - - PROCEDURE DIVISION. - - *> DISPLAY 'Starting testcase ALLOC' - - SET VPTR VPTR2 VPTR3 To NULL - - ************************************************************* - * Allocate a table with 20 elements - ************************************************************* - COMPUTE NUM-ELEMENTS = 20 - PERFORM ALLOC-VARGRP - - ************************************************************* - * Set some 'test' values to validate re-allocated table - ************************************************************* - initialize vartab(12), vartab(17) - COMPUTE T1(12) = 9999 - MOVE 'HI MOM' TO T2 (17) - *> DISPLAY ' ' - DISPLAY 'VARTAB(12) = "' VARTAB(12) '"' - DISPLAY 'VARTAB(17) = "' VARTAB(17) '"' - *> DISPLAY ' ' - - ************************************************************* - * Need a bigger table! Allocate a larger one and copy data - ************************************************************* - COMPUTE NUM-ELEMENTS = 30 - PERFORM ALLOC-VARGRP - - ************************************************************* - * Ensure that new table has correct data from original - ************************************************************* - DISPLAY 'VARTAB(12) = "' VARTAB(12) '"' - DISPLAY 'VARTAB(17) = "' VARTAB(17) '"' - - GOBACK. - - ************************************************************* - * The first time allocate the original table. If the table - * has already been allocated, assume that we are allocating - * a larger one and want to copy the data over to it - ************************************************************* - ALLOC-VARGRP. - - If VPTR = NULL Then *> If first time, allocate the table - COMPUTE SIZE-NEEDED = LENGTH OF OBJ + - LENGTH OF VARTAB * NUM-ELEMENTS - display 'First allocation, using ' size-needed ' bytes.' - ALLOCATE SIZE-NEEDED CHARACTERS INITIALIZED RETURNING VPTR - - SET ADDRESS OF VARGRP TO VPTR - MOVE NUM-ELEMENTS TO OBJ - - Else *> If already have a table, doing re-size - ********************************************************************* - * Re-size it! - * First, allocate space for data save area and move data in - ********************************************************************* - - ALLOCATE SIZE-NEEDED CHARACTERS INITIALIZED RETURNING VPTR2 - SET ADDRESS OF BUFFER TO VPTR2 - MOVE VARGRP TO BUFFER(1:SIZE-NEEDED) - inspect BUFFER(3:SIZE-NEEDED - 3) - replacing all x'00' by space - DISPLAY 'BUFFER = "' BUFFER(170:66) '"' - DISPLAY ' "' BUFFER(226:66) '"' - move size-needed to old-size - - ********************************************************************* - * Calculate new size from NUM-ElEMENTS - ********************************************************************* - COMPUTE SIZE-NEEDED = LENGTH OF OBJ + - LENGTH OF VARTAB * NUM-ELEMENTS - - display 'Re-allocation, using ' size-needed ' bytes.' - *> ALLOCATE SIZE-NEEDED CHARACTERS INITIALIZED RETURNING VPTR3 - if size-needed < 2097152 - ALLOCATE SIZE-NEEDED CHARACTERS INITIALIZED - loc 24 - RETURNING VPTR3 - else - ALLOCATE SIZE-NEEDED CHARACTERS INITIALIZED - loc 31 - RETURNING VPTR3 - end-if - - ************************************************************* - * Move data from data save area to new larger table - ************************************************************* - SET ADDRESS OF VARGRP TO VPTR3 - MOVE NUM-ELEMENTS TO OBJ - MOVE BUFFER(1:old-size) TO VARGRP - ************************************************************* - * Free the original table and temp copy - ************************************************************* - FREE VPTR VPTR2 - SET VPTR TO VPTR2 - . -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_extensions.at:1090: \$COMPILE -std=ibm-strict -w ALLOC.cob" -at_fn_check_prepare_dynamic "$COMPILE -std=ibm-strict -w ALLOC.cob" "run_extensions.at:1090" -( $at_check_trace; $COMPILE -std=ibm-strict -w ALLOC.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_extensions.at:1090" -$at_failed && at_fn_log_failure -$at_traceon; } - - -{ set +x -$as_echo "$at_srcdir/run_extensions.at:1092: \$COBCRUN_DIRECT ./ALLOC" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./ALLOC" "run_extensions.at:1092" -( $at_check_trace; $COBCRUN_DIRECT ./ALLOC -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo "First allocation, using 00322 bytes. -VARTAB(12) = \"9999 0000\" -VARTAB(17) = \"0000HI MOM 0000\" -BUFFER = \" 9999 0000 \" - \" 0000HI MOM 0000 \" -Re-allocation, using 00482 bytes. -VARTAB(12) = \"9999 0000\" -VARTAB(17) = \"0000HI MOM 0000\" -" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_extensions.at:1092" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_966 -#AT_START_967 -at_fn_group_banner 967 'run_extensions.at:1106' \ - "DEPENDING ON with ODOSLIDE" " " 4 -at_xfail=no -( - $as_echo "967. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - CONFIGURATION SECTION. - INPUT-OUTPUT SECTION. - FILE-CONTROL. - SELECT FLATFILE - ASSIGN "SEQODO" - ORGANIZATION LINE SEQUENTIAL - FILE STATUS IS CUST-STAT . - - DATA DIVISION. - FILE SECTION. - FD FLATFILE - BLOCK CONTAINS 5 RECORDS. - - 01 TSTREC. - 05 SEQ PIC 99. - 05 DEP-X PIC 99. - 05 DEP-Y PIC 99. - 05 HELLO PIC X(5) VALUE 'World'. - 05 TSTGRP. - 10 TSTGRP1. - 15 TSTX OCCURS 1 TO 3 TIMES - DEPENDING ON DEP-X. - 20 TSTG-1 PIC Z9. - 15 TSTTAIL1 PIC XXXX. - 10 TSTY-ALL. - 15 TSTY OCCURS 1 TO 3 TIMES - DEPENDING ON DEP-X. - 20 TSTY-1 PIC 99. - 20 TSTY-2 PIC XXX. - 20 TSTY-3 PIC X - OCCURS 1 TO 12 TIMES - DEPENDING ON DEP-Y. - 20 TSTY-4 PIC XX. - 20 TSTY-5 OCCURS 1 TO 3 TIMES - DEPENDING ON DEP-X. - 25 TSTY-6 OCCURS 1 TO 3 TIMES - DEPENDING ON DEP-X. - 30 TSTY-7 PIC X. - 10 TSTTAIL2 PIC XX. - - WORKING-STORAGE SECTION. - 77 CUST-STAT PIC X(2). - 01 LN PIC 9(3). - 01 IX PIC 9(9) BINARY. - 01 IY PIC 9(9) BINARY. - 01 IZ PIC 9(9) BINARY. - 01 TSTXXX PIC X(26) VALUE "Abcdefghijklmnopqrstuvwxyz". - 01 TSTALPHA REDEFINES TSTXXX. - 05 ALPH-CHR PIC X OCCURS 26 TIMES. - 01 TSTHEX PIC X(15) VALUE "123456789ABCDEF". - 01 FILLER REDEFINES TSTHEX. - 05 HEX-CHR PIC X OCCURS 15 TIMES. - - 01 TSTREC2. - 05 DEP-X2 PIC 99. - 05 TSTGRP2. - 10 TSTX2 OCCURS 1 TO 3 TIMES DEPENDING ON DEP-X2. - 15 TSTG2-1 PIC Z9. - 10 TST2TAIL1 PIC XXX. - - 01 TSTREC3. - 05 DEP-X3 PIC 99. - 05 TSTGRP3. - 10 TSTX3 OCCURS 1 TO 6 TIMES DEPENDING ON DEP-X3. - 15 TSTG3-1 PIC 9. - 01 TSTWRK PIC X(24). - - PROCEDURE DIVISION. - MAIN-10. - MOVE 6 TO DEP-X3. - MOVE 1 TO TSTG3-1 (1). - MOVE 2 TO TSTG3-1 (2). - MOVE 3 TO TSTG3-1 (3). - MOVE 4 TO TSTG3-1 (4). - MOVE 5 TO TSTG3-1 (5). - MOVE 6 TO TSTG3-1 (6). - MOVE 3 TO DEP-X3. - STRING TSTGRP3 "-TRAILER" DELIMITED BY SIZE - INTO TSTWRK. - DISPLAY "'" TSTWRK "'". - OPEN OUTPUT FLATFILE. - MOVE "Howdy" TO HELLO. - MOVE 0 TO SEQ. - MOVE 2 TO DEP-X. - MOVE 5 TO DEP-Y. - PERFORM WRITE-REC. - MOVE 1 TO DEP-X. - MOVE 2 TO DEP-Y. - PERFORM WRITE-REC. - MOVE 3 TO DEP-X. - MOVE 3 TO DEP-Y. - PERFORM WRITE-REC. - MOVE 3 TO DEP-X. - MOVE 10 TO DEP-Y. - PERFORM WRITE-REC. - CLOSE FLATFILE. - OPEN INPUT FLATFILE. - PERFORM READ-REC. - CLOSE FLATFILE. - STOP RUN. - - WRITE-REC SECTION. - ADD 1 TO SEQ. - MOVE LENGTH OF TSTREC TO LN. - DISPLAY "Write SEQ " SEQ ", DEP-X = " DEP-X - " & DEP-Y = " DEP-Y - ", TSTREC len:" LN. - MOVE ALL "*" TO TSTGRP. - MOVE "<>" TO TSTTAIL1, TSTTAIL2. - PERFORM VARYING IX FROM 1 BY 1 - UNTIL IX > DEP-X - MOVE IX TO TSTG-1 (IX) - END-PERFORM. - MOVE LENGTH OF TSTGRP1 TO LN. - DISPLAY "Group1: '" TSTGRP1 "' len:" LN. - PERFORM VARYING IX FROM 1 BY 1 - UNTIL IX > DEP-X - MOVE IX TO TSTY-1 (IX) - MOVE "." TO TSTY-4 (IX) - PERFORM VARYING IY FROM 1 BY 1 - UNTIL IY > DEP-Y - MOVE ALPH-CHR (IY) TO TSTY-3 (IX, IY) - END-PERFORM - END-PERFORM. - PERFORM VARYING IX FROM 1 BY 1 - UNTIL IX > DEP-X - PERFORM VARYING IY FROM 1 BY 1 - UNTIL IY > DEP-X - PERFORM VARYING IZ FROM 1 BY 1 - UNTIL IZ > DEP-X - MOVE HEX-CHR (IX+IY+IZ) TO TSTY-7 (IX, IY, IZ) - END-PERFORM - END-PERFORM - END-PERFORM. - DISPLAY " Data: '" TSTGRP "'". - - MOVE ALL "*" TO TSTGRP2. - MOVE DEP-X TO DEP-X2. - PERFORM VARYING IX FROM 1 BY 1 - UNTIL IX > DEP-X2 - MOVE IX TO TSTG2-1 (IX) - END-PERFORM. - MOVE "<>" TO TST2TAIL1. - MOVE LENGTH OF TSTGRP2 TO LN. - DISPLAY "Group2: '" TSTGRP2 "' len:" LN. - WRITE TSTREC. - - READ-REC SECTION. - READ-10. - READ FLATFILE AT END GO TO READ-99. - MOVE LENGTH OF TSTREC TO LN. - DISPLAY "Read SEQ " SEQ ", DEP-X = " DEP-X - " & DEP-Y = " DEP-Y - ", TSTREC len:" LN. - DISPLAY " Data: '" TSTGRP "'". - GO TO READ-10. - READ-99. - EXIT . -_ATEOF - - -# FIXME: odo-checks (-debug) must be adjusted, either with -fodoslide or with a possibly new -# compiler configuration flag as IBM seems to only check against the field-founder's -# bounds, not the subscript (which is the reason to use "$COBC -x" instead of "$COMPILE") -{ set +x -$as_echo "$at_srcdir/run_extensions.at:1276: \$COBC -x -fodoslide prog.cob" -at_fn_check_prepare_dynamic "$COBC -x -fodoslide prog.cob" "run_extensions.at:1276" -( $at_check_trace; $COBC -x -fodoslide prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_extensions.at:1276" -$at_failed && at_fn_log_failure -$at_traceon; } - - -{ set +x -$as_echo "$at_srcdir/run_extensions.at:1278: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_extensions.at:1278" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo "'123-TRAILER ' -Write SEQ 01, DEP-X = 02 & DEP-Y = 05, TSTREC len:053 -Group1: ' 1 2<> ' len:008 - Data: ' 1 2<> 01***Abcde. 344502***Abcde. 4556<>' -Group2: ' 1 2<> ' len:007 -Write SEQ 02, DEP-X = 01 & DEP-Y = 02, TSTREC len:029 -Group1: ' 1<> ' len:006 - Data: ' 1<> 01***Ab. 3<>' -Group2: ' 1<> ' len:005 -Write SEQ 03, DEP-X = 03 & DEP-Y = 03, TSTREC len:080 -Group1: ' 1 2 3<> ' len:010 - Data: ' 1 2 3<> 01***Abc. 34545656702***Abc. 45656767803***Abc. 567678789<>' -Group2: ' 1 2 3<> ' len:009 -Write SEQ 04, DEP-X = 03 & DEP-Y = 10, TSTREC len:101 -Group1: ' 1 2 3<> ' len:010 - Data: ' 1 2 3<> 01***Abcdefghij. 34545656702***Abcdefghij. 45656767803***Abcdefghij. 567678789<>' -Group2: ' 1 2 3<> ' len:009 -Read SEQ 01, DEP-X = 02 & DEP-Y = 05, TSTREC len:053 - Data: ' 1 2<> 01***Abcde. 344502***Abcde. 4556<>' -Read SEQ 02, DEP-X = 01 & DEP-Y = 02, TSTREC len:029 - Data: ' 1<> 01***Ab. 3<>' -Read SEQ 03, DEP-X = 03 & DEP-Y = 03, TSTREC len:080 - Data: ' 1 2 3<> 01***Abc. 34545656702***Abc. 45656767803***Abc. 567678789<>' -Read SEQ 04, DEP-X = 03 & DEP-Y = 10, TSTREC len:101 - Data: ' 1 2 3<> 01***Abcdefghij. 34545656702***Abcdefghij. 45656767803***Abcdefghij. 567678789<>' -" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_extensions.at:1278" -$at_failed && at_fn_log_failure -$at_traceon; } - - - - - -cat >reference <<'_ATEOF' -010205Howdy 1 2<> 01***Abcde. 344502***Abcde. 4556<> -020102Howdy 1<> 01***Ab. 3<> -030303Howdy 1 2 3<> 01***Abc. 34545656702***Abc. 45656767803***Abc. 567678789<> -040310Howdy 1 2 3<> 01***Abcdefghij. 34545656702***Abcdefghij. 45656767803***Abcdefghij. 567678789<> -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_extensions.at:1316: diff reference SEQODO" -at_fn_check_prepare_trace "run_extensions.at:1316" -( $at_check_trace; diff reference SEQODO -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_extensions.at:1316" -$at_failed && at_fn_log_failure \ -"./SEQODO" -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_967 -#AT_START_968 -at_fn_group_banner 968 'run_extensions.at:1321' \ - "DEPENDING ON with ODOSLIDE for IBM" " " 4 -at_xfail=no -( - $as_echo "968. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 L1-1-2-S PIC 99. - 01 L1-1-2-1-S PIC 99. - 01 L1-2-S PIC 99. - 01 L1-3-S PIC 99. - 01 L1-3-2-S PIC 99. - 01 BUFFER PIC X(370). - - PROCEDURE DIVISION. - MOVE ALL '0123456789' TO BUFFER. - MOVE 3 TO L1-1-2-S. - MOVE 4 TO L1-1-2-1-S. - MOVE 0 TO L1-2-S. - MOVE 6 TO L1-3-S. - MOVE 1 TO L1-3-2-S. - CALL 'IBM-ODO-TEST' USING BUFFER - L1-1-2-S - L1-1-2-1-S - L1-2-S - L1-3-S - L1-3-2-S. - - MOVE ALL '0123456789' TO BUFFER. - MOVE 2 TO L1-1-2-S. - MOVE 3 TO L1-1-2-1-S. - MOVE 1 TO L1-2-S. - MOVE 4 TO L1-3-S. - MOVE 0 TO L1-3-2-S. - CALL 'IBM-ODO-TEST' USING BUFFER - L1-1-2-S - L1-1-2-1-S - L1-2-S - L1-3-S - L1-3-2-S. - STOP RUN. - END PROGRAM prog. - - IDENTIFICATION DIVISION. - PROGRAM-ID. IBM-ODO-TEST. - - DATA DIVISION. - WORKING-STORAGE SECTION. - - LINKAGE SECTION. - 01 L1-1-2-S PIC 99. - 01 L1-1-2-1-S PIC 99. - 01 L1-2-S PIC 99. - 01 L1-3-S PIC 99. - 01 L1-3-2-S PIC 99. - 01 BASE. - 10 ARRAY OCCURS 2 TIMES. - 20 L1-1. - 25 L1-1-1 PIC X(3). - 25 L1-1-2 OCCURS 4 TIMES DEPENDING ON L1-1-2-S. - 30 L1-1-2-1 OCCURS 5 TIMES DEPENDING ON L1-1-2-1-S - PIC XXX. - 20 L1-2 OCCURS 0 TO 1 TIMES DEPENDING ON L1-2-S PIC XX. - 20 L1-3 OCCURS 1 TO 10 TIMES DEPENDING ON L1-3-S. - 25 L1-3-1. - 30 L1-3-1-1 PIC X(5). - 30 L1-3-1-2 PIC X. - 30 L1-3-1-3 PIC X(5). - 25 L1-3-2 OCCURS 0 TO 1 TIMES DEPENDING ON L1-3-2-S PIC X. - - PROCEDURE DIVISION USING BASE - L1-1-2-S - L1-1-2-1-S - L1-2-S - L1-3-S - L1-3-2-S. - DISPLAY "Length is " LENGTH OF BASE - " with " L1-1-2-S - ", " L1-1-2-1-S - ", " L1-2-S - ", " L1-3-S - ", " L1-3-2-S. - MOVE '.' TO L1-3-2(1, 5, 1). - MOVE '--' TO L1-2(2, 1). - MOVE '+++' TO L1-1-2-1(2, 1, 5). - DISPLAY '"' BASE '"'. - END PROGRAM IBM-ODO-TEST. -_ATEOF - -# FIXME: odo-checks (-debug) must be adjusted, either with -fodoslide or with a possibly new -# compiler configuration flag as IBM seems to only check against the field-founder's -# bounds, not the subscript (which is the reason to use "$COBC -x" instead of "$COMPILE") -{ set +x -$as_echo "$at_srcdir/run_extensions.at:1414: \$COBC -x -std=ibm -fodoslide prog.cob" -at_fn_check_prepare_dynamic "$COBC -x -std=ibm -fodoslide prog.cob" "run_extensions.at:1414" -( $at_check_trace; $COBC -x -std=ibm -fodoslide prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_extensions.at:1414" -$at_failed && at_fn_log_failure -$at_traceon; } - - -{ set +x -$as_echo "$at_srcdir/run_extensions.at:1416: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_extensions.at:1416" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo "Length is 0000000222 with 03, 04, 00, 06, 01 -\"01234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567.901234567890123456789012345+++901234567890123456789--2345678901234567890123456789012345678901234567890123456789012345678901\" -Length is 0000000134 with 02, 03, 01, 04, 00 -\"012345678901234567890123456789012345678901234567890123456789012345678901234567.901+++567--01234567890123456789012345678901234567890123\" -" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_extensions.at:1416" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_968 -#AT_START_969 -at_fn_group_banner 969 'run_extensions.at:1425' \ - "DEPENDING ON with ODOSLIDE" " " 4 -at_xfail=no -( - $as_echo "969. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ****************************************************************** - ENVIRONMENT DIVISION. - DATA DIVISION. - ****************************************************************** - WORKING-STORAGE SECTION. - * - 01 WITHOUT-ODO. - 02 DATA1 PIC X(1). - 02 DEP1 PIC 9(1) VALUE 0. - 02 DEP2 PIC 9(1) VALUE 0. - 02 GROUP1 OCCURS 2 TIMES. - 03 DATA11 PIC X(1). - 02 GROUP2 OCCURS 3 TIMES. - 03 DATA21 PIC X(1). - 02 DATA3 PIC X(2). - - * - 01 WITH-ODO. - 02 ODO-DATA1 PIC X(1). - 02 ODO-DEP1 PIC 9(1) VALUE 0. - 02 ODO-DEP2 PIC 9(1) VALUE 0. - 02 ODO-GROUP1 OCCURS 0 TO 2 TIMES DEPENDING ON ODO-DEP1. - 03 ODO-DATA11 PIC X(1). - 02 ODO-GROUP2 OCCURS 0 TO 3 TIMES DEPENDING ON ODO-DEP2. - 03 ODO-DATA21 PIC X(1). - 02 ODO-DATA3 PIC X(2). - - 77 IX PIC 9. - 01 DAT. - 02 ODO-1 PIC 9. - 02 ODO-1-DATA OCCURS 1 TO 6 TIMES DEPENDING ON ODO-1 - PIC 9. - 02 ODO-2 PIC 9. - 02 ODO-2-DATA OCCURS 1 TO 6 TIMES DEPENDING ON ODO-2 - PIC 9. - 02 ODO-3 PIC XXX. - - ****************************************************************** - PROCEDURE DIVISION. - ****************************************************************** - * - TEST1. - MOVE "A01 B CD" TO WITHOUT-ODO - DISPLAY "********" - DISPLAY "TEST WITHOUT ODO: '" WITHOUT-ODO "'" - DISPLAY "DATA1=" DATA1 - DISPLAY "DEP1=" DEP1. - DISPLAY "DEP2=" DEP2 - DISPLAY "DATA21(1)=" DATA21 (1) - DISPLAY "DATA3=" DATA3 - . - - TEST2. - MOVE "A01BCD" TO WITH-ODO - DISPLAY "TEST WITH ODO: '" WITH-ODO - "' Len:" LENGTH OF WITH-ODO - DISPLAY "ODO-DATA1=" ODO-DATA1 "." - DISPLAY "ODO-DEP1=" ODO-DEP1 "." - DISPLAY "ODO-DEP2=" ODO-DEP2 "." - DISPLAY "ODO-DATA21(1)=" ODO-DATA21 (1) "." - DISPLAY "ODO-DATA3=" ODO-DATA3 "." - - MOVE "12BCDEF" TO WITH-ODO (2:) - DISPLAY "TEST WITH ODO: '" WITH-ODO - "' Len:" LENGTH OF WITH-ODO - DISPLAY "ODO-DATA1=" ODO-DATA1 "." - DISPLAY "ODO-DEP1=" ODO-DEP1 "." - DISPLAY "ODO-DEP2=" ODO-DEP2 "." - DISPLAY "ODO-DATA11(1)=" ODO-DATA11 (1) "." - DISPLAY "ODO-DATA21(1)=" ODO-DATA21 (1) "." - DISPLAY "ODO-DATA21(2)=" ODO-DATA21 (2) "." - DISPLAY "ODO-DATA3=" ODO-DATA3 "." - - MOVE "A23BCDEFGH" TO WITH-ODO (1:) - DISPLAY "TEST WITH ODO: '" WITH-ODO - "' Len:" LENGTH OF WITH-ODO. - DISPLAY "ODO-DATA1=" ODO-DATA1 "." - DISPLAY "ODO-DEP1=" ODO-DEP1 "." - DISPLAY "ODO-DEP2=" ODO-DEP2 "." - DISPLAY "ODO-DATA11(1)=" ODO-DATA11 (1) "." - DISPLAY "ODO-DATA11(2)=" ODO-DATA11 (2) "." - DISPLAY "ODO-DATA21(1)=" ODO-DATA21 (1) "." - DISPLAY "ODO-DATA21(2)=" ODO-DATA21 (2) "." - DISPLAY "ODO-DATA21(3)=" ODO-DATA21 (3) "." - DISPLAY "ODO-DATA3=" ODO-DATA3 "." - . - - TEST3. - MOVE "A01" TO WITH-ODO (1:3) - MOVE "BCD" TO WITH-ODO (4:3) - DISPLAY "********" - DISPLAY "TEST WITH ODO, SEPERATED: '" WITH-ODO "'" - DISPLAY "ODO-DATA1=" ODO-DATA1 "." - DISPLAY "ODO-DEP1=" ODO-DEP1 "." - DISPLAY "ODO-DEP2=" ODO-DEP2 "." - DISPLAY "ODO-DATA21(1)=" ODO-DATA21 (1) "." - DISPLAY "ODO-DATA3=" ODO-DATA3 "." - . - - - DISPLAY "********" - MOVE 2 TO ODO-1 - MOVE 3 TO ODO-2 - MOVE "End" TO ODO-3 - PERFORM SHOW-ODO - MOVE 2 TO ODO-1 - MOVE 6 TO ODO-2 - MOVE "End" TO ODO-3 - PERFORM SHOW-ODO - STOP RUN - . - - SHOW-ODO. - PERFORM VARYING IX FROM 1 BY 1 - UNTIL IX > ODO-1 - MOVE IX TO ODO-1-DATA (IX) - END-PERFORM - PERFORM VARYING IX FROM 1 BY 1 - UNTIL IX > ODO-2 - MOVE IX TO ODO-2-DATA (IX) - END-PERFORM - DISPLAY "Slided ODO : '" DAT "'" - . -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_extensions.at:1556: \$COMPILE -std=default -fodoslide prog.cob " -at_fn_check_prepare_dynamic "$COMPILE -std=default -fodoslide prog.cob " "run_extensions.at:1556" -( $at_check_trace; $COMPILE -std=default -fodoslide prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob:36: warning: ODO-2 does not have a fixed location -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_extensions.at:1556" -$at_failed && at_fn_log_failure -$at_traceon; } - - -{ set +x -$as_echo "$at_srcdir/run_extensions.at:1559: ./prog" -at_fn_check_prepare_trace "run_extensions.at:1559" -( $at_check_trace; ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo "******** -TEST WITHOUT ODO: 'A01 B CD' -DATA1=A -DEP1=0 -DEP2=1 -DATA21(1)=B -DATA3=CD -TEST WITH ODO: 'A01BCD' Len:6 -ODO-DATA1=A. -ODO-DEP1=0. -ODO-DEP2=1. -ODO-DATA21(1)=B. -ODO-DATA3=CD. -TEST WITH ODO: 'A12BCDEF' Len:8 -ODO-DATA1=A. -ODO-DEP1=1. -ODO-DEP2=2. -ODO-DATA11(1)=B. -ODO-DATA21(1)=C. -ODO-DATA21(2)=D. -ODO-DATA3=EF. -TEST WITH ODO: 'A23BCDEFGH' Len:10 -ODO-DATA1=A. -ODO-DEP1=2. -ODO-DEP2=3. -ODO-DATA11(1)=B. -ODO-DATA11(2)=C. -ODO-DATA21(1)=D. -ODO-DATA21(2)=E. -ODO-DATA21(3)=F. -ODO-DATA3=GH. -******** -TEST WITH ODO, SEPERATED: 'A01BCD' -ODO-DATA1=A. -ODO-DEP1=0. -ODO-DEP2=1. -ODO-DATA21(1)=B. -ODO-DATA3=CD. -******** -Slided ODO : '2123123End' -Slided ODO : '2126123456End' -" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_extensions.at:1559" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_969 -#AT_START_970 -at_fn_group_banner 970 'run_extensions.at:1605' \ - "DEPENDING ON with ODOSLIDE" " " 4 -at_xfail=no -( - $as_echo "970. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 WS-LINE. - 03 WS-LINE-LEN PIC 9(5). - 03 WS-LINE-TEXT. - 04 WS-BYTE PIC X(1) OCCURS 1 TO 132 DEPENDING WS-LINE-LEN. - 03 WS-LINE-LEN2 PIC 9(5). - 03 WS-LINE-TEXT2. - 04 WS-BYTE2 PIC X(1) OCCURS 1 TO 132 DEPENDING WS-LINE-LEN2. - - PROCEDURE DIVISION. - A-MAIN SECTION. - - MOVE 5 TO WS-LINE-LEN - MOVE 'Hello' TO WS-LINE-TEXT ( 1 : ) - MOVE 5 TO WS-LINE-LEN2 - MOVE 'BYE!!' TO WS-LINE-TEXT2 ( 1 : ) - DISPLAY '1. Pre CALL DATA :' WS-LINE ': ' - 'LEN ' LENGTH OF WS-LINE - MOVE '00003BYE00003Now..' TO WS-LINE - DISPLAY '2. Pre CALL DATA :' WS-LINE ': ' - 'LEN ' LENGTH OF WS-LINE - - CALL 'BUGSUB' USING WS-LINE - - DISPLAY '3. Post CALL DATA :' WS-LINE-TEXT ': ' - 'LEN ' LENGTH OF WS-LINE-TEXT - - STOP RUN. - - IDENTIFICATION DIVISION. - PROGRAM-ID. BUGSUB. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 WS-CON PIC X(8) VALUE '005Hello'. - 01 WS-CON2 PIC X(15) VALUE '00009Hello Dog'. - LINKAGE SECTION. - 01 GENERIC-AREA. - 03 GENERIC-AREA-LEN PIC 9(5). - 03 GENERIC-AREA-TEXT. - 04 GEN-BYTE PIC X(1) OCCURS 1 TO 32000 - DEPENDING GENERIC-AREA-LEN. - 03 GENERIC-AREA-LEN2 PIC 9(5). - 03 GENERIC-AREA-TEXT2. - 04 GEN-BYTE2 PIC X(1) OCCURS 1 TO 32000 - DEPENDING GENERIC-AREA-LEN2. - - PROCEDURE DIVISION USING GENERIC-AREA. - A-MAIN SECTION. - - DISPLAY 'In subroutine, Clear' - MOVE SPACES TO GENERIC-AREA-TEXT - DISPLAY 'In subroutine, Fill hdr' - MOVE WS-CON2 TO GENERIC-AREA - DISPLAY '4. Test Move DATA :' GENERIC-AREA ': ' - 'LEN ' LENGTH OF GENERIC-AREA - DISPLAY 'In subroutine, Fill partial' - MOVE WS-CON TO GENERIC-AREA (3:) - DISPLAY '5. Test Move DATA :' GENERIC-AREA ': ' - 'LEN ' LENGTH OF GENERIC-AREA - MOVE 'Bye Bye' TO GENERIC-AREA-TEXT - MOVE 7 TO GENERIC-AREA-LEN - MOVE 'Bye Bye' TO GENERIC-AREA-TEXT - GOBACK. - - END PROGRAM BUGSUB. - END PROGRAM prog. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_extensions.at:1680: cobc -x -std=ibm -w -fodoslide prog.cob " -at_fn_check_prepare_trace "run_extensions.at:1680" -( $at_check_trace; cobc -x -std=ibm -w -fodoslide prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_extensions.at:1680" -$at_failed && at_fn_log_failure -$at_traceon; } - - -{ set +x -$as_echo "$at_srcdir/run_extensions.at:1682: ./prog" -at_fn_check_prepare_trace "run_extensions.at:1682" -( $at_check_trace; ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo "1. Pre CALL DATA :00005Hello00005BYE!!: LEN 0000000020 -2. Pre CALL DATA :00003BYE00003Now: LEN 0000000016 -In subroutine, Clear -In subroutine, Fill hdr -4. Test Move DATA :00009Hello Dog : LEN 0000000019 -In subroutine, Fill partial -5. Test Move DATA :00005Hello : LEN 0000000015 -3. Post CALL DATA :Bye Bye: LEN 0000000007 -" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_extensions.at:1682" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_970 -#AT_START_971 -at_fn_group_banner 971 'run_extensions.at:1695' \ - "INITIALIZE level 01" " " 4 -at_xfail=no -( - $as_echo "971. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 L1 OCCURS 1000 TIMES. - 05 L2 PIC S9(9) COMP-5 VALUE 5. - 05 L3 PIC S9(9) VALUE 5. - PROCEDURE DIVISION. - IF L2(3) not = 5 - DISPLAY '0 VALUE(3) = ' L2(3) - END-DISPLAY - END-IF. - INITIALIZE L1(1). - IF L2(1) not = 0 - DISPLAY '1 VALUE(1) = ' L2(1) - END-DISPLAY - END-IF. - IF L2(3) not = 5 - DISPLAY '1 VALUE(3) = ' L2(3) - END-DISPLAY - END-IF. - INITIALIZE L1(1) DEFAULT. - IF L2(1) not = 0 - DISPLAY '2 VALUE(1) = ' L2(1) - END-DISPLAY - END-IF. - IF L2(3) not = 5 - DISPLAY '2 VALUE(3) = ' L2(3) - END-DISPLAY - END-IF. - INITIALIZE L1(1) ALL VALUE. - IF L2(1) not = 5 - DISPLAY '3 VALUE(1) = ' L2(1) - END-DISPLAY - END-IF. - IF L2(3) not = 5 - DISPLAY '3 VALUE(3) = ' L2(3) - END-DISPLAY - END-IF. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_extensions.at:1741: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_extensions.at:1741" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_extensions.at:1741" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_extensions.at:1742: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_extensions.at:1742" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_extensions.at:1742" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_971 -#AT_START_972 -at_fn_group_banner 972 'run_extensions.at:1747' \ - "MOVE of non-integer to alphanumeric" " " 4 -at_xfail=no -( - $as_echo "972. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 INTEGER PIC 9(4) VALUE 1289 . - 01 SIGNED-INTEGER PIC S9(4) VALUE -1289 . - - 01 ALPHA-FIELD PIC X(4). - - 01 NON-INTEGER PIC 9(2)V99 VALUE 12.89 . - 01 NON-INTEGER-2 PIC 9(2)V99 - USAGE BINARY VALUE 12.89 . - 01 NON-INTEGER-3 PIC 9(2)V99 - USAGE PACKED-DECIMAL VALUE 12.89 . - 01 SIGNED-NON-INTEGER PIC S9(2)V99 VALUE -12.89 . - 01 SIGNED-NON-INTEGER-2 PIC S9(2)V99 - USAGE BINARY VALUE -12.89 . - 01 SIGNED-NON-INTEGER-3 PIC S9(2)V99 - USAGE PACKED-DECIMAL VALUE -12.89 . - - PROCEDURE DIVISION. -* * MOVE NON-INTEGER TO ALPHA-NUMERIC --> ignore Decimal Point! - S-01. - MOVE SPACES TO ALPHA-FIELD. - MOVE INTEGER TO ALPHA-FIELD. - DISPLAY ALPHA-FIELD NO ADVANCING - END-DISPLAY. - S-02. - MOVE SPACES TO ALPHA-FIELD. - MOVE SIGNED-INTEGER TO ALPHA-FIELD. - DISPLAY ALPHA-FIELD NO ADVANCING - END-DISPLAY. - S-03. - MOVE SPACES TO ALPHA-FIELD. - MOVE NON-INTEGER TO ALPHA-FIELD. - DISPLAY ALPHA-FIELD NO ADVANCING - END-DISPLAY. - S-10. - MOVE SPACES TO ALPHA-FIELD. - MOVE NON-INTEGER-2 TO ALPHA-FIELD. - DISPLAY ALPHA-FIELD NO ADVANCING - END-DISPLAY. - S-20. - MOVE SPACES TO ALPHA-FIELD. - MOVE NON-INTEGER-3 TO ALPHA-FIELD. - DISPLAY ALPHA-FIELD NO ADVANCING - END-DISPLAY. - S-30. - MOVE SPACES TO ALPHA-FIELD. - MOVE SIGNED-NON-INTEGER TO ALPHA-FIELD. - DISPLAY ALPHA-FIELD NO ADVANCING - END-DISPLAY. - S-40. - MOVE SPACES TO ALPHA-FIELD. - MOVE SIGNED-NON-INTEGER-2 TO ALPHA-FIELD. - DISPLAY ALPHA-FIELD NO ADVANCING - END-DISPLAY. - S-50. - MOVE SPACES TO ALPHA-FIELD. - MOVE SIGNED-NON-INTEGER-3 TO ALPHA-FIELD. - DISPLAY ALPHA-FIELD NO ADVANCING - END-DISPLAY. - - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_extensions.at:1817: \$COMPILE -std=mf prog.cob" -at_fn_check_prepare_dynamic "$COMPILE -std=mf prog.cob" "run_extensions.at:1817" -( $at_check_trace; $COMPILE -std=mf prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob: in paragraph 'S-03': -prog.cob:36: warning: MOVE of non-integer to alphanumeric -prog.cob: in paragraph 'S-10': -prog.cob:41: warning: MOVE of non-integer to alphanumeric -prog.cob: in paragraph 'S-20': -prog.cob:46: warning: MOVE of non-integer to alphanumeric -prog.cob: in paragraph 'S-30': -prog.cob:51: warning: MOVE of non-integer to alphanumeric -prog.cob: in paragraph 'S-40': -prog.cob:56: warning: MOVE of non-integer to alphanumeric -prog.cob: in paragraph 'S-50': -prog.cob:61: warning: MOVE of non-integer to alphanumeric -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_extensions.at:1817" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_extensions.at:1831: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_extensions.at:1831" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo "12891289128912891289128912891289" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_extensions.at:1831" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_972 -#AT_START_973 -at_fn_group_banner 973 'run_extensions.at:1837' \ - "CALL USING file-name" " " 4 -at_xfail=no -( - $as_echo "973. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >setfilename.c <<'_ATEOF' - -#include -#include -#include - -COB_EXT_EXPORT int -setfilename (cob_file *f, unsigned char *name) -{ - memcpy (f->assign->data, name, strlen ((char *)name)); - return 0; -} -_ATEOF - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - INPUT-OUTPUT SECTION. - FILE-CONTROL. - SELECT TEST-FILE ASSIGN FILENAME. - DATA DIVISION. - FILE SECTION. - FD TEST-FILE. - 01 TEST-REC PIC X(4). - WORKING-STORAGE SECTION. - 01 FILENAME PIC X(8). - PROCEDURE DIVISION. - INITIALIZE FILENAME. - CALL "setfilename" USING TEST-FILE "TESTFILE" - END-CALL. - OPEN OUTPUT TEST-FILE. - CLOSE TEST-FILE. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_extensions.at:1875: \$COMPILE_MODULE setfilename.c" -at_fn_check_prepare_dynamic "$COMPILE_MODULE setfilename.c" "run_extensions.at:1875" -( $at_check_trace; $COMPILE_MODULE setfilename.c -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_extensions.at:1875" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_extensions.at:1876: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_extensions.at:1876" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_extensions.at:1876" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_extensions.at:1877: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_extensions.at:1877" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_extensions.at:1877" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_extensions.at:1878: test -e TESTFILE" -at_fn_check_prepare_trace "run_extensions.at:1878" -( $at_check_trace; test -e TESTFILE -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_extensions.at:1878" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_973 -#AT_START_974 -at_fn_group_banner 974 'run_extensions.at:1882' \ - "CALL unusual PROGRAM-ID." " " 4 -at_xfail=no -( - $as_echo "974. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >A@B.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. "A@B". - PROCEDURE DIVISION. - DISPLAY "P1" NO ADVANCING - END-DISPLAY. - EXIT PROGRAM. -_ATEOF - - -cat >A#B.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. "A#B". - PROCEDURE DIVISION. - DISPLAY "P2" NO ADVANCING - END-DISPLAY. - EXIT PROGRAM. -_ATEOF - - -cat >A-B.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. "A-B". - PROCEDURE DIVISION. - DISPLAY "P3" NO ADVANCING - END-DISPLAY. - EXIT PROGRAM. -_ATEOF - - -cat >A_B.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. "A_B". - PROCEDURE DIVISION. - DISPLAY "P4" NO ADVANCING - END-DISPLAY. - EXIT PROGRAM. -_ATEOF - - -cat >caller.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. caller. - PROCEDURE DIVISION. - CALL "A@B" - END-CALL. - CALL "A#B" - END-CALL. - CALL "A-B" - END-CALL. - CALL "A_B" - END-CALL. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_extensions.at:1936: \$COMPILE_MODULE A@B.cob" -at_fn_check_prepare_dynamic "$COMPILE_MODULE A@B.cob" "run_extensions.at:1936" -( $at_check_trace; $COMPILE_MODULE A@B.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_extensions.at:1936" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_extensions.at:1937: \$COMPILE_MODULE A#B.cob" -at_fn_check_prepare_dynamic "$COMPILE_MODULE A#B.cob" "run_extensions.at:1937" -( $at_check_trace; $COMPILE_MODULE A#B.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_extensions.at:1937" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_extensions.at:1938: \$COMPILE_MODULE A-B.cob" -at_fn_check_prepare_dynamic "$COMPILE_MODULE A-B.cob" "run_extensions.at:1938" -( $at_check_trace; $COMPILE_MODULE A-B.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_extensions.at:1938" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_extensions.at:1939: \$COMPILE_MODULE A_B.cob" -at_fn_check_prepare_dynamic "$COMPILE_MODULE A_B.cob" "run_extensions.at:1939" -( $at_check_trace; $COMPILE_MODULE A_B.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_extensions.at:1939" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_extensions.at:1940: \$COMPILE -o caller caller.cob" -at_fn_check_prepare_dynamic "$COMPILE -o caller caller.cob" "run_extensions.at:1940" -( $at_check_trace; $COMPILE -o caller caller.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_extensions.at:1940" -$at_failed && at_fn_log_failure -$at_traceon; } - - -{ set +x -$as_echo "$at_srcdir/run_extensions.at:1942: \$COBCRUN_DIRECT ./caller" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./caller" "run_extensions.at:1942" -( $at_check_trace; $COBCRUN_DIRECT ./caller -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo "P1P2P3P4" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_extensions.at:1942" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_974 -#AT_START_975 -at_fn_group_banner 975 'run_extensions.at:1946' \ - "CALL / GOBACK with LOCAL-STORAGE" " " 4 -at_xfail=no -( - $as_echo "975. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -# Testcase introduced when Bug #91 occurred. -# Will fail if memory is freed which was -# allocated by mpir/gmp. -cat >prog_a.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog_a. - DATA DIVISION. - WORKING-STORAGE SECTION. - 77 WS-STRINGA PIC X(10). - PROCEDURE DIVISION. - MOVE "hi there" TO WS-STRINGA - CALL "prog_b" USING WS-STRINGA - DISPLAY "back in prog_a" - GOBACK. -_ATEOF - - -cat >prog_b.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog_b. - DATA DIVISION. - WORKING-STORAGE SECTION. - 77 WS-STRINGB PIC X(10). - 77 WS-CALLSB PIC 9(03). - LOCAL-STORAGE SECTION. - 77 LS-STRING PIC X(10). - LINKAGE SECTION. - 77 LK-STRING PIC X(10). - - PROCEDURE DIVISION USING LK-STRING. - DISPLAY "entered prog_b" - ADD 1 TO WS-CALLSB - MOVE LK-STRING TO WS-STRINGB - MOVE LK-STRING TO LS-STRING - DISPLAY "exiting prog_b" - GOBACK. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_extensions.at:1986: \$COMPILE prog_a.cob" -at_fn_check_prepare_dynamic "$COMPILE prog_a.cob" "run_extensions.at:1986" -( $at_check_trace; $COMPILE prog_a.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_extensions.at:1986" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_extensions.at:1987: \$COMPILE_MODULE prog_b.cob" -at_fn_check_prepare_dynamic "$COMPILE_MODULE prog_b.cob" "run_extensions.at:1987" -( $at_check_trace; $COMPILE_MODULE prog_b.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_extensions.at:1987" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_extensions.at:1988: \$COBCRUN_DIRECT ./prog_a" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog_a" "run_extensions.at:1988" -( $at_check_trace; $COBCRUN_DIRECT ./prog_a -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo "entered prog_b -exiting prog_b -back in prog_a -" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_extensions.at:1988" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_975 -#AT_START_976 -at_fn_group_banner 976 'run_extensions.at:1996' \ - "CALL BY VALUE alphanumeric item" " " 4 -at_xfail=no -( - $as_echo "976. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 X PIC XX VALUE "OK". - PROCEDURE DIVISION. - CALL "prog2" USING BY VALUE X - END-CALL. - IF X NOT = "OK" - DISPLAY X NO ADVANCING - END-DISPLAY - END-IF. - STOP RUN. - PROGRAM-ID. prog2. - DATA DIVISION. - LINKAGE SECTION. - 01 Y PIC XX. - PROCEDURE DIVISION USING BY VALUE Y. - MOVE "KO" TO Y. - EXIT PROGRAM. - END PROGRAM prog2. - END PROGRAM prog. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_extensions.at:2024: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_extensions.at:2024" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob:8: warning: BY CONTENT assumed for alphanumeric item 'X' -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_extensions.at:2024" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_extensions.at:2027: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_extensions.at:2027" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_extensions.at:2027" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_976 -#AT_START_977 -at_fn_group_banner 977 'run_extensions.at:2032' \ - "CALL BY VALUE numeric literal WITH SIZE" " " 4 -at_xfail=no -( - $as_echo "977. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - PROCEDURE DIVISION. - *> Test of auto size, identical to SIZE AUTO - CALL "prog2" USING BY VALUE 4 0 0 1 0 - END-CALL - - *> Test of explicit SIZE syntax - CALL "prog2" USING BY VALUE 1 SIZE 1 2 0 0 0 - END-CALL - CALL "prog2" USING BY VALUE 2 0 SIZE 2 3 0 0 - END-CALL - CALL "prog2" USING BY VALUE 4 0 0 SIZE 4 4 0 - END-CALL - CALL "prog2" USING BY VALUE 8 0 0 0 SIZE 8 5 - END-CALL - CALL "prog2" USING BY VALUE 4 0 0 SIZE DEFAULT 6 0 - END-CALL - CALL "prog2" USING BY VALUE 4 0 0 SIZE AUTO 7 0 - END-CALL - *> test for SIZE AUTO with VALUE > INT_MAX is non-portable - - *> Test of explicit UNSIGNED SIZE syntax - CALL "prog2" USING BY VALUE 1 UNSIGNED SIZE 1 2 0 0 0 - END-CALL - CALL "prog2" USING BY VALUE 2 0 UNSIGNED SIZE 2 3 0 0 - END-CALL - CALL "prog2" USING BY VALUE 4 0 0 UNSIGNED SIZE 4 4 0 - END-CALL - CALL "prog2" USING BY VALUE 8 0 0 0 UNSIGNED SIZE 8 5 0 - END-CALL - CALL "prog2" USING BY VALUE 4 0 0 UNSIGNED SIZE AUTO 6 0 - END-CALL - *> test for SIZE AUTO with VALUE > INT_MAX is non-portable - - *> Test of MF size syntax - *>CALL "prog2" USING BY VALUE 2 SIZE 1 - *>END-CALL - *>CALL "prog2" USING BY VALUE 3 SIZE 2 - *>END-CALL - *>CALL "prog2" USING BY VALUE 4 SIZE 4 - *>END-CALL - *>CALL "prog2" USING BY VALUE 5 SIZE 8 - *>END-CALL - - STOP RUN. - PROGRAM-ID. prog2. - DATA DIVISION. - LINKAGE SECTION. - 01 LEN USAGE BINARY-LONG. - 01 VAR-1 USAGE BINARY-CHAR. - 01 VAR-2 USAGE BINARY-SHORT. - 01 VAR-4 USAGE BINARY-LONG. - 01 VAR-8 USAGE BINARY-DOUBLE. - PROCEDURE DIVISION USING BY VALUE LEN - SIZE 1 VAR-1 - SIZE 2 VAR-2 - SIZE 4 VAR-4 - SIZE 8 VAR-8. - EVALUATE len - WHEN 1 - DISPLAY '1: ' VAR-1 END-DISPLAY - WHEN 2 - DISPLAY '2: ' VAR-2 END-DISPLAY - WHEN 4 - DISPLAY '4: ' VAR-4 END-DISPLAY - WHEN 8 - DISPLAY '8: ' VAR-8 END-DISPLAY - END-EVALUATE - EXIT PROGRAM. - END PROGRAM prog2. - END PROGRAM prog. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_extensions.at:2112: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_extensions.at:2112" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo stderr:; cat "$at_stderr" -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_extensions.at:2112" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_extensions.at:2113: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_extensions.at:2113" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo "4: +0000000001 -1: +002 -2: +00003 -4: +0000000004 -8: +00000000000000000005 -4: +0000000006 -4: +0000000007 -1: +002 -2: +00003 -4: +0000000004 -8: +00000000000000000005 -4: +0000000006 -" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_extensions.at:2113" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_977 -#AT_START_978 -at_fn_group_banner 978 'run_extensions.at:2132' \ - "Case-sensitive PROGRAM-ID" " " 4 -at_xfail=no -( - $as_echo "978. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. PROG. - PROCEDURE DIVISION. - CALL "prog" - END-CALL. - STOP RUN. - PROGRAM-ID. prog. - PROCEDURE DIVISION. - EXIT PROGRAM. - END PROGRAM prog. - END PROGRAM PROG. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_extensions.at:2149: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_extensions.at:2149" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_extensions.at:2149" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_extensions.at:2150: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_extensions.at:2150" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_extensions.at:2150" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_978 -#AT_START_979 -at_fn_group_banner 979 'run_extensions.at:2157' \ - "Quoted PROGRAM-ID" " " 4 -at_xfail=no -( - $as_echo "979. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. "caller". - PROCEDURE DIVISION. - CALL "callee" - END-CALL. - STOP RUN. - PROGRAM-ID. "callee". - PROCEDURE DIVISION. - EXIT PROGRAM. - END PROGRAM callee. - END PROGRAM caller. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_extensions.at:2174: \$COMPILE -w prog.cob" -at_fn_check_prepare_dynamic "$COMPILE -w prog.cob" "run_extensions.at:2174" -( $at_check_trace; $COMPILE -w prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_extensions.at:2174" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_extensions.at:2175: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_extensions.at:2175" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_extensions.at:2175" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_979 -#AT_START_980 -at_fn_group_banner 980 'run_extensions.at:2180' \ - "PROGRAM-ID AS clause" " " 4 -at_xfail=no -( - $as_echo "980. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. caller AS "PROG". - PROCEDURE DIVISION. - CALL "prog" - END-CALL. - STOP RUN. - PROGRAM-ID. callee AS "prog". - PROCEDURE DIVISION. - EXIT PROGRAM. - END PROGRAM callee. - END PROGRAM caller. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_extensions.at:2197: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_extensions.at:2197" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_extensions.at:2197" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_extensions.at:2198: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_extensions.at:2198" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_extensions.at:2198" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_980 -#AT_START_981 -at_fn_group_banner 981 'run_extensions.at:2204' \ - "ASSIGN DYNAMIC and EXTERNAL" " " 4 -at_xfail=no -( - $as_echo "981. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - - ENVIRONMENT DIVISION. - INPUT-OUTPUT SECTION. - FILE-CONTROL. - SELECT f ASSIGN whatever - ORGANIZATION LINE SEQUENTIAL. - - DATA DIVISION. - FILE SECTION. - FD f. - 01 f-rec PIC XXX. - - WORKING-STORAGE SECTION. - 01 whatever PIC X(10) VALUE "out.txt". - - PROCEDURE DIVISION. - OPEN OUTPUT f - WRITE f-rec FROM "hi" - CLOSE f - . -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_extensions.at:2232: \$COMPILE -fassign-clause=external prog.cob" -at_fn_check_prepare_dynamic "$COMPILE -fassign-clause=external prog.cob" "run_extensions.at:2232" -( $at_check_trace; $COMPILE -fassign-clause=external prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_extensions.at:2232" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_extensions.at:2233: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_extensions.at:2233" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_extensions.at:2233" -$at_failed && at_fn_log_failure -$at_traceon; } - - -cat >reference <<'_ATEOF' -hi -_ATEOF - -{ set +x -$as_echo "$at_srcdir/run_extensions.at:2238: diff reference whatever" -at_fn_check_prepare_trace "run_extensions.at:2238" -( $at_check_trace; diff reference whatever -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_extensions.at:2238" -$at_failed && at_fn_log_failure \ -"./whatever" -$at_traceon; } - - -{ set +x -$as_echo "$at_srcdir/run_extensions.at:2240: \$COMPILE -fassign-clause=dynamic -fno-implicit-assign-dynamic-var prog.cob" -at_fn_check_prepare_dynamic "$COMPILE -fassign-clause=dynamic -fno-implicit-assign-dynamic-var prog.cob" "run_extensions.at:2240" -( $at_check_trace; $COMPILE -fassign-clause=dynamic -fno-implicit-assign-dynamic-var prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_extensions.at:2240" -$at_failed && at_fn_log_failure \ -"./whatever" -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_extensions.at:2241: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_extensions.at:2241" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_extensions.at:2241" -$at_failed && at_fn_log_failure \ -"./whatever" -$at_traceon; } - - -{ set +x -$as_echo "$at_srcdir/run_extensions.at:2243: diff reference whatever" -at_fn_check_prepare_trace "run_extensions.at:2243" -( $at_check_trace; diff reference whatever -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_extensions.at:2243" -$at_failed && at_fn_log_failure \ -"./whatever" -$at_traceon; } - - -{ set +x -$as_echo "$at_srcdir/run_extensions.at:2245: \$COMPILE -fassign-clause=dynamic prog.cob" -at_fn_check_prepare_dynamic "$COMPILE -fassign-clause=dynamic prog.cob" "run_extensions.at:2245" -( $at_check_trace; $COMPILE -fassign-clause=dynamic prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_extensions.at:2245" -$at_failed && at_fn_log_failure \ -"./whatever" -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_extensions.at:2246: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_extensions.at:2246" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_extensions.at:2246" -$at_failed && at_fn_log_failure \ -"./whatever" -$at_traceon; } - - -{ set +x -$as_echo "$at_srcdir/run_extensions.at:2248: diff reference out.txt" -at_fn_check_prepare_trace "run_extensions.at:2248" -( $at_check_trace; diff reference out.txt -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_extensions.at:2248" -$at_failed && at_fn_log_failure \ -"./whatever" \ -"./out.txt" -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_981 -#AT_START_982 -at_fn_group_banner 982 'run_extensions.at:2253' \ - "ASSIGN DYNAMIC implicit variable" " " 4 -at_xfail=no -( - $as_echo "982. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - - ENVIRONMENT DIVISION. - INPUT-OUTPUT SECTION. - FILE-CONTROL. - SELECT f ASSIGN whatever - ORGANIZATION LINE SEQUENTIAL. - - DATA DIVISION. - FILE SECTION. - FD f. - 01 f-rec PIC XXX. - - PROCEDURE DIVISION. - MOVE "out.txt" TO whatever - OPEN OUTPUT f - WRITE f-rec FROM "hi" - CLOSE f - . -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_extensions.at:2279: \$COMPILE -fassign-clause=dynamic prog.cob" -at_fn_check_prepare_dynamic "$COMPILE -fassign-clause=dynamic prog.cob" "run_extensions.at:2279" -( $at_check_trace; $COMPILE -fassign-clause=dynamic prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob:16: warning: variable 'whatever' will be implicitly defined -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_extensions.at:2279" -$at_failed && at_fn_log_failure -$at_traceon; } - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_982 -#AT_START_983 -at_fn_group_banner 983 'run_extensions.at:2285' \ - "ASSIGN EXTERNAL parsing" " " 4 -at_xfail=no -( - $as_echo "983. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - INPUT-OUTPUT SECTION. - FILE-CONTROL. - *> Labels should be removed from EXTERNAL name. - SELECT TEST-FILE ASSIGN DA-S-FILENAME. - *> EXTERNAL name allowed to duplicate FD name. - SELECT TESTFILE2 ASSIGN TESTFILE2. - DATA DIVISION. - FILE SECTION. - FD TEST-FILE. - 01 TEST-REC PIC X(4). - FD TESTFILE2. - 01 TESTREC2 PIC X(4). - PROCEDURE DIVISION. - OPEN OUTPUT TEST-FILE. - CLOSE TEST-FILE. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_extensions.at:2310: \$COMPILE -fassign-clause=external prog.cob" -at_fn_check_prepare_dynamic "$COMPILE -fassign-clause=external prog.cob" "run_extensions.at:2310" -( $at_check_trace; $COMPILE -fassign-clause=external prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob:8: warning: ASSIGN DA-S-FILENAME interpreted as 'FILENAME' -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_extensions.at:2310" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_extensions.at:2313: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_extensions.at:2313" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_extensions.at:2313" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_extensions.at:2314: test -f FILENAME" -at_fn_check_prepare_trace "run_extensions.at:2314" -( $at_check_trace; test -f FILENAME -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_extensions.at:2314" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_983 -#AT_START_984 -at_fn_group_banner 984 'run_extensions.at:2319' \ - "ASSIGN directive" " " 4 -at_xfail=no -( - $as_echo "984. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - - ENVIRONMENT DIVISION. - INPUT-OUTPUT SECTION. - FILE-CONTROL. - SELECT f ASSIGN whatever - ORGANIZATION LINE SEQUENTIAL. - $SET ASSIGN "EXTERNAL" - SELECT g ASSIGN whatever - ORGANIZATION LINE SEQUENTIAL. - - DATA DIVISION. - FILE SECTION. - FD f. - 01 f-rec PIC XXX. - FD g. - 01 g-rec PIC XXX. - - PROCEDURE DIVISION. - MOVE "out.txt" TO whatever - - OPEN OUTPUT f - WRITE f-rec FROM "hi" - CLOSE f - - OPEN OUTPUT g - WRITE g-rec FROM "hi" - CLOSE g - . - END PROGRAM prog. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_extensions.at:2356: \$COMPILE -fassign-clause=dynamic prog.cob" -at_fn_check_prepare_dynamic "$COMPILE -fassign-clause=dynamic prog.cob" "run_extensions.at:2356" -( $at_check_trace; $COMPILE -fassign-clause=dynamic prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob:21: warning: variable 'whatever' will be implicitly defined -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_extensions.at:2356" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_extensions.at:2359: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_extensions.at:2359" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_extensions.at:2359" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_984 -#AT_START_985 -at_fn_group_banner 985 'run_extensions.at:2364' \ - "ASSIGN expansion" " " 4 -at_xfail=no -( - $as_echo "985. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - INPUT-OUTPUT SECTION. - FILE-CONTROL. - SELECT TEST-FILE ASSIGN "$DIR/FILENAME". - DATA DIVISION. - FILE SECTION. - FD TEST-FILE. - 01 TEST-REC PIC X(4). - PROCEDURE DIVISION. - OPEN OUTPUT TEST-FILE. - CLOSE TEST-FILE. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_extensions.at:2384: \$COMPILE -ffilename-mapping prog.cob" -at_fn_check_prepare_dynamic "$COMPILE -ffilename-mapping prog.cob" "run_extensions.at:2384" -( $at_check_trace; $COMPILE -ffilename-mapping prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_extensions.at:2384" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_extensions.at:2385: DIR=\".\" \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "DIR=\".\" $COBCRUN_DIRECT ./prog" "run_extensions.at:2385" -( $at_check_trace; DIR="." $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_extensions.at:2385" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_extensions.at:2386: test -f \"./FILENAME\" && rm -f \"./FILENAME\"" -at_fn_check_prepare_trace "run_extensions.at:2386" -( $at_check_trace; test -f "./FILENAME" && rm -f "./FILENAME" -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_extensions.at:2386" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_985 -#AT_START_986 -at_fn_group_banner 986 'run_extensions.at:2390' \ - "ASSIGN mapping" " " 4 -at_xfail=no -( - $as_echo "986. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - INPUT-OUTPUT SECTION. - FILE-CONTROL. - SELECT TEST-FILE ASSIGN "FILENAME". - DATA DIVISION. - FILE SECTION. - FD TEST-FILE. - 01 TEST-REC PIC X(4). - PROCEDURE DIVISION. - OPEN OUTPUT TEST-FILE. - CLOSE TEST-FILE. - STOP RUN. -_ATEOF - - -cat >prog2.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog2. - ENVIRONMENT DIVISION. - INPUT-OUTPUT SECTION. - FILE-CONTROL. - SELECT TEST-FILE ASSIGN "FILENAME2". - DATA DIVISION. - FILE SECTION. - FD TEST-FILE. - 01 TEST-REC PIC X(4). - PROCEDURE DIVISION. - OPEN OUTPUT TEST-FILE. - CLOSE TEST-FILE. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_extensions.at:2427: \$COMPILE -fno-filename-mapping prog.cob" -at_fn_check_prepare_dynamic "$COMPILE -fno-filename-mapping prog.cob" "run_extensions.at:2427" -( $at_check_trace; $COMPILE -fno-filename-mapping prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_extensions.at:2427" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_extensions.at:2428: DD_FILENAME=\"x\" \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "DD_FILENAME=\"x\" $COBCRUN_DIRECT ./prog" "run_extensions.at:2428" -( $at_check_trace; DD_FILENAME="x" $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_extensions.at:2428" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_extensions.at:2429: test -f \"x\"" -at_fn_check_prepare_trace "run_extensions.at:2429" -( $at_check_trace; test -f "x" -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/run_extensions.at:2429" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_extensions.at:2430: test -f \"FILENAME\"" -at_fn_check_prepare_trace "run_extensions.at:2430" -( $at_check_trace; test -f "FILENAME" -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_extensions.at:2430" -$at_failed && at_fn_log_failure -$at_traceon; } - - -{ set +x -$as_echo "$at_srcdir/run_extensions.at:2432: \$COMPILE -ffilename-mapping prog2.cob" -at_fn_check_prepare_dynamic "$COMPILE -ffilename-mapping prog2.cob" "run_extensions.at:2432" -( $at_check_trace; $COMPILE -ffilename-mapping prog2.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_extensions.at:2432" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_extensions.at:2433: DD_FILENAME2=\"x\" \$COBCRUN_DIRECT ./prog2" -at_fn_check_prepare_dynamic "DD_FILENAME2=\"x\" $COBCRUN_DIRECT ./prog2" "run_extensions.at:2433" -( $at_check_trace; DD_FILENAME2="x" $COBCRUN_DIRECT ./prog2 -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_extensions.at:2433" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_extensions.at:2434: test -f \"FILENAME2\"" -at_fn_check_prepare_trace "run_extensions.at:2434" -( $at_check_trace; test -f "FILENAME2" -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/run_extensions.at:2434" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_extensions.at:2435: test -f \"x\"" -at_fn_check_prepare_trace "run_extensions.at:2435" -( $at_check_trace; test -f "x" -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_extensions.at:2435" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_extensions.at:2436: dd_FILENAME2=\"y\" \$COBCRUN_DIRECT ./prog2" -at_fn_check_prepare_dynamic "dd_FILENAME2=\"y\" $COBCRUN_DIRECT ./prog2" "run_extensions.at:2436" -( $at_check_trace; dd_FILENAME2="y" $COBCRUN_DIRECT ./prog2 -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_extensions.at:2436" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_extensions.at:2437: test -f \"y\"" -at_fn_check_prepare_trace "run_extensions.at:2437" -( $at_check_trace; test -f "y" -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_extensions.at:2437" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_extensions.at:2438: FILENAME2=\"z\" \$COBCRUN_DIRECT ./prog2" -at_fn_check_prepare_dynamic "FILENAME2=\"z\" $COBCRUN_DIRECT ./prog2" "run_extensions.at:2438" -( $at_check_trace; FILENAME2="z" $COBCRUN_DIRECT ./prog2 -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_extensions.at:2438" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_extensions.at:2439: test -f \"z\"" -at_fn_check_prepare_trace "run_extensions.at:2439" -( $at_check_trace; test -f "z" -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_extensions.at:2439" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_extensions.at:2440: \$COBCRUN_DIRECT ./prog2" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog2" "run_extensions.at:2440" -( $at_check_trace; $COBCRUN_DIRECT ./prog2 -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_extensions.at:2440" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_extensions.at:2441: test -f \"FILENAME2\"" -at_fn_check_prepare_trace "run_extensions.at:2441" -( $at_check_trace; test -f "FILENAME2" -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_extensions.at:2441" -$at_failed && at_fn_log_failure -$at_traceon; } - - -cat >prog3.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog3. - ENVIRONMENT DIVISION. - CONFIGURATION SECTION. - INPUT-OUTPUT SECTION. - FILE-CONTROL. - SELECT OPTIONAL INFILE ASSIGN TO "MYFILE" - ORGANIZATION IS RELATIVE - ACCESS IS SEQUENTIAL - FILE STATUS IS WSFS. - DATA DIVISION. - FILE SECTION. - FD INFILE. - 01 INREC PIC X(80). - WORKING-STORAGE SECTION. - 01 WSFS PIC X(2). - PROCEDURE DIVISION. - * - * open missing file - OPEN INPUT INFILE - DISPLAY "STATUS OPENI " WSFS - CLOSE INFILE - * - * create missing file - OPEN OUTPUT INFILE - DISPLAY "STATUS OPENO " WSFS - CLOSE INFILE - * - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_extensions.at:2475: \$COMPILE prog3.cob" -at_fn_check_prepare_dynamic "$COMPILE prog3.cob" "run_extensions.at:2475" -( $at_check_trace; $COMPILE prog3.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_extensions.at:2475" -$at_failed && at_fn_log_failure -$at_traceon; } - - -{ set +x -$as_echo "$at_srcdir/run_extensions.at:2477: \$COBCRUN_DIRECT ./prog3" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog3" "run_extensions.at:2477" -( $at_check_trace; $COBCRUN_DIRECT ./prog3 -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo "STATUS OPENI 05 -STATUS OPENO 00 -" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_extensions.at:2477" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_extensions.at:2481: test -f \"MYFILE\"" -at_fn_check_prepare_trace "run_extensions.at:2481" -( $at_check_trace; test -f "MYFILE" -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_extensions.at:2481" -$at_failed && at_fn_log_failure -$at_traceon; } - - -{ set +x -$as_echo "$at_srcdir/run_extensions.at:2483: \$COBCRUN_DIRECT ./prog3" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog3" "run_extensions.at:2483" -( $at_check_trace; $COBCRUN_DIRECT ./prog3 -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo "STATUS OPENI 00 -STATUS OPENO 00 -" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_extensions.at:2483" -$at_failed && at_fn_log_failure -$at_traceon; } - - -{ set +x -$as_echo "$at_srcdir/run_extensions.at:2488: MYFILE=\"TSTFILE\" \$COBCRUN_DIRECT ./prog3" -at_fn_check_prepare_dynamic "MYFILE=\"TSTFILE\" $COBCRUN_DIRECT ./prog3" "run_extensions.at:2488" -( $at_check_trace; MYFILE="TSTFILE" $COBCRUN_DIRECT ./prog3 -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo "STATUS OPENI 05 -STATUS OPENO 00 -" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_extensions.at:2488" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_extensions.at:2492: test -f \"TSTFILE\"" -at_fn_check_prepare_trace "run_extensions.at:2492" -( $at_check_trace; test -f "TSTFILE" -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_extensions.at:2492" -$at_failed && at_fn_log_failure -$at_traceon; } - - -{ set +x -$as_echo "$at_srcdir/run_extensions.at:2494: dd_MYFILE=\"TSTFILE2\" \$COBCRUN_DIRECT ./prog3" -at_fn_check_prepare_dynamic "dd_MYFILE=\"TSTFILE2\" $COBCRUN_DIRECT ./prog3" "run_extensions.at:2494" -( $at_check_trace; dd_MYFILE="TSTFILE2" $COBCRUN_DIRECT ./prog3 -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo "STATUS OPENI 05 -STATUS OPENO 00 -" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_extensions.at:2494" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_extensions.at:2498: test -f \"TSTFILE2\"" -at_fn_check_prepare_trace "run_extensions.at:2498" -( $at_check_trace; test -f "TSTFILE2" -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_extensions.at:2498" -$at_failed && at_fn_log_failure -$at_traceon; } - - -{ set +x -$as_echo "$at_srcdir/run_extensions.at:2500: DD_MYFILE=\"TSTFILE3\" \$COBCRUN_DIRECT ./prog3" -at_fn_check_prepare_dynamic "DD_MYFILE=\"TSTFILE3\" $COBCRUN_DIRECT ./prog3" "run_extensions.at:2500" -( $at_check_trace; DD_MYFILE="TSTFILE3" $COBCRUN_DIRECT ./prog3 -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo "STATUS OPENI 05 -STATUS OPENO 00 -" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_extensions.at:2500" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_extensions.at:2504: test -f \"TSTFILE3\"" -at_fn_check_prepare_trace "run_extensions.at:2504" -( $at_check_trace; test -f "TSTFILE3" -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_extensions.at:2504" -$at_failed && at_fn_log_failure -$at_traceon; } - - -{ set +x -$as_echo "$at_srcdir/run_extensions.at:2506: DD_MYFILE=\"./nosubhere/TSTFILE\" \$COBCRUN_DIRECT ./prog3" -at_fn_check_prepare_dynamic "DD_MYFILE=\"./nosubhere/TSTFILE\" $COBCRUN_DIRECT ./prog3" "run_extensions.at:2506" -( $at_check_trace; DD_MYFILE="./nosubhere/TSTFILE" $COBCRUN_DIRECT ./prog3 -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo "STATUS OPENI 05 -STATUS OPENO 30 -" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_extensions.at:2506" -$at_failed && at_fn_log_failure -$at_traceon; } - - -cat >prog4.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog4. - ENVIRONMENT DIVISION. - CONFIGURATION SECTION. - INPUT-OUTPUT SECTION. - FILE-CONTROL. - SELECT FILE0 ASSIGN TO "./nosubhere/MYFILE0" - ORGANIZATION IS LINE SEQUENTIAL - FILE STATUS IS WSFS. - SELECT FILE1 ASSIGN TO "MYFILE1" - ORGANIZATION IS LINE SEQUENTIAL - FILE STATUS IS WSFS. - SELECT FILE2 ASSIGN TO FILENAME - ORGANIZATION IS LINE SEQUENTIAL - FILE STATUS IS WSFS. - DATA DIVISION. - FILE SECTION. - FD FILE0. - 01 F0REC PIC X(80). - FD FILE1. - 01 F1REC PIC X(80). - FD FILE2. - 01 F2REC PIC X(80). - WORKING-STORAGE SECTION. - 77 FILENAME PIC X(80) VALUE "MYFILE2". - 01 WSFS PIC X(2). - PROCEDURE DIVISION. - * - OPEN OUTPUT FILE0 - DISPLAY "STATUS OPENO 0 " WSFS - OPEN OUTPUT FILE1 - DISPLAY "STATUS OPENO 1 " WSFS - OPEN OUTPUT FILE2 - DISPLAY "STATUS OPENO 2 " WSFS - * - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_extensions.at:2550: \$COMPILE prog4.cob" -at_fn_check_prepare_dynamic "$COMPILE prog4.cob" "run_extensions.at:2550" -( $at_check_trace; $COMPILE prog4.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_extensions.at:2550" -$at_failed && at_fn_log_failure -$at_traceon; } - - -{ set +x -$as_echo "$at_srcdir/run_extensions.at:2552: DD_MYFILE1=\"./nosubhere/NOFILE1\" DD_MYFILE2=\"./nosubhere/NOFILE2\" \\ -\$COBCRUN_DIRECT ./prog4" -at_fn_check_prepare_notrace 'an embedded newline' "run_extensions.at:2552" -( $at_check_trace; DD_MYFILE1="./nosubhere/NOFILE1" DD_MYFILE2="./nosubhere/NOFILE2" \ -$COBCRUN_DIRECT ./prog4 -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo "STATUS OPENO 0 30 -STATUS OPENO 1 30 -STATUS OPENO 2 30 -" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_extensions.at:2552" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_986 -#AT_START_987 -at_fn_group_banner 987 'run_extensions.at:2561' \ - "ASSIGN with COB_FILE_PATH" " " 4 -at_xfail=no -( - $as_echo "987. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - INPUT-OUTPUT SECTION. - FILE-CONTROL. - SELECT TEST-FILE ASSIGN "FILENAMEX". - DATA DIVISION. - FILE SECTION. - FD TEST-FILE. - 01 TEST-REC PIC X(4). - PROCEDURE DIVISION. - OPEN OUTPUT TEST-FILE. - CLOSE TEST-FILE. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_extensions.at:2581: \$COMPILE -ffilename-mapping prog.cob" -at_fn_check_prepare_dynamic "$COMPILE -ffilename-mapping prog.cob" "run_extensions.at:2581" -( $at_check_trace; $COMPILE -ffilename-mapping prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_extensions.at:2581" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_extensions.at:2582: COB_FILE_PATH=\"..\" \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "COB_FILE_PATH=\"..\" $COBCRUN_DIRECT ./prog" "run_extensions.at:2582" -( $at_check_trace; COB_FILE_PATH=".." $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_extensions.at:2582" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_extensions.at:2583: test -f \"../FILENAMEX\" && rm -f \"../FILENAMEX\"" -at_fn_check_prepare_trace "run_extensions.at:2583" -( $at_check_trace; test -f "../FILENAMEX" && rm -f "../FILENAMEX" -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_extensions.at:2583" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_extensions.at:2584: COB_FILE_PATH=\"../\" \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "COB_FILE_PATH=\"../\" $COBCRUN_DIRECT ./prog" "run_extensions.at:2584" -( $at_check_trace; COB_FILE_PATH="../" $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_extensions.at:2584" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_extensions.at:2585: test -f \"../FILENAMEX\" && rm -f \"../FILENAMEX\"" -at_fn_check_prepare_trace "run_extensions.at:2585" -( $at_check_trace; test -f "../FILENAMEX" && rm -f "../FILENAMEX" -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_extensions.at:2585" -$at_failed && at_fn_log_failure -$at_traceon; } - - -# FIXME: on OPEN we should also output the full filename (if any) leading to the error -{ set +x -$as_echo "$at_srcdir/run_extensions.at:2588: COB_FILE_PATH=\"./nosubhere\" \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "COB_FILE_PATH=\"./nosubhere\" $COBCRUN_DIRECT ./prog" "run_extensions.at:2588" -( $at_check_trace; COB_FILE_PATH="./nosubhere" $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "libcob: prog.cob:13: error: permanent file error (status = 30) for file TEST-FILE ('FILENAMEX' => ./nosubhere/FILENAMEX) on OPEN -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/run_extensions.at:2588" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_987 -#AT_START_988 -at_fn_group_banner 988 'run_extensions.at:2595' \ - "NUMBER-OF-CALL-PARAMETERS" " " 4 -at_xfail=no -( - $as_echo "988. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >callee.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. callee. - DATA DIVISION. - LINKAGE SECTION. - 01 W PIC X. - 01 X PIC X. - 01 Y PIC X. - 01 Z PIC X. - PROCEDURE DIVISION - USING W X Y Z. - DISPLAY NUMBER-OF-CALL-PARAMETERS - END-DISPLAY. - EXIT PROGRAM. -_ATEOF - - -cat >caller.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. caller. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 W PIC X. - 01 X PIC X. - 01 Y PIC X. - 01 Z PIC X. - PROCEDURE DIVISION. - CALL "callee" - END-CALL. - CALL "callee" USING W - END-CALL. - CALL "callee" USING W X - END-CALL. - CALL "callee" USING W X Y - END-CALL. - CALL "callee" USING W X Y Z - END-CALL. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_extensions.at:2637: \$COMPILE caller.cob" -at_fn_check_prepare_dynamic "$COMPILE caller.cob" "run_extensions.at:2637" -( $at_check_trace; $COMPILE caller.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_extensions.at:2637" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_extensions.at:2638: \$COMPILE_MODULE callee.cob" -at_fn_check_prepare_dynamic "$COMPILE_MODULE callee.cob" "run_extensions.at:2638" -( $at_check_trace; $COMPILE_MODULE callee.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_extensions.at:2638" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_extensions.at:2639: \$COBCRUN_DIRECT ./caller" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./caller" "run_extensions.at:2639" -( $at_check_trace; $COBCRUN_DIRECT ./caller -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo "+000000000 -+000000001 -+000000002 -+000000003 -+000000004 -" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_extensions.at:2639" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_988 -#AT_START_989 -at_fn_group_banner 989 'run_extensions.at:2650' \ - "TALLY register" " " 4 -at_xfail=no -( - $as_echo "989. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. callee. - PROCEDURE DIVISION. - ADD 1 TO TALLY END-ADD - CALL "nested" END-CALL - STOP RUN. - - IDENTIFICATION DIVISION. - PROGRAM-ID. nested. - PROCEDURE DIVISION. - DISPLAY tally END-DISPLAY - STOP RUN. - END PROGRAM nested. -_ATEOF - - -#FIXME: Should get a dialect check in syntax checks, -# along with all other special registers -{ set +x -$as_echo "$at_srcdir/run_extensions.at:2671: \$COMPILE_ONLY -fnot-register=TALLY prog.cob" -at_fn_check_prepare_dynamic "$COMPILE_ONLY -fnot-register=TALLY prog.cob" "run_extensions.at:2671" -( $at_check_trace; $COMPILE_ONLY -fnot-register=TALLY prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob:5: error: 'TALLY' is not defined -prog.cob:12: error: 'tally' is not defined -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/run_extensions.at:2671" -$at_failed && at_fn_log_failure -$at_traceon; } - - -{ set +x -$as_echo "$at_srcdir/run_extensions.at:2676: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_extensions.at:2676" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_extensions.at:2676" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_extensions.at:2677: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_extensions.at:2677" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo "00001 -" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_extensions.at:2677" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_989 -#AT_START_990 -at_fn_group_banner 990 'run_extensions.at:2684' \ - "Redefining TALLY" " " 4 -at_xfail=no -( - $as_echo "990. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 tally PIC 999 VALUE 1. - - PROCEDURE DIVISION. - ADD 1 TO tally - DISPLAY tally UPON SYSOUT - . -_ATEOF - - - -#FIXME: Should get a dialect check in syntax checks, -# along with all other special registers -{ set +x -$as_echo "$at_srcdir/run_extensions.at:2704: \$COMPILE -std=ibm-strict prog.cob" -at_fn_check_prepare_dynamic "$COMPILE -std=ibm-strict prog.cob" "run_extensions.at:2704" -( $at_check_trace; $COMPILE -std=ibm-strict prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo stderr:; cat "$at_stderr" -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/run_extensions.at:2704" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_extensions.at:2705: \$COMPILE -std=acu-strict prog.cob" -at_fn_check_prepare_dynamic "$COMPILE -std=acu-strict prog.cob" "run_extensions.at:2705" -( $at_check_trace; $COMPILE -std=acu-strict prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_extensions.at:2705" -$at_failed && at_fn_log_failure -$at_traceon; } - -#AT_CHECK([$COMPILE -std=ibm prog.cob], [0], [], []) -#AT_CHECK([$COMPILE -std=ibm-strict prog.cob], [1], [], -#[prog.cob:7: error: redefinition of register 'TALLY' -#]) -#AT_CHECK([$COMPILE prog.cob], [0], [], []) -{ set +x -$as_echo "$at_srcdir/run_extensions.at:2711: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_extensions.at:2711" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo "002 -" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_extensions.at:2711" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_990 -#AT_START_991 -at_fn_group_banner 991 'run_extensions.at:2720' \ - "PROCEDURE DIVISION USING BY ..." " " 4 -at_xfail=no -( - $as_echo "991. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >callee.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. callee. - DATA DIVISION. - LINKAGE SECTION. - 01 X PIC X. - 01 Y PIC 99. - 01 Z PIC 99 USAGE COMP. - PROCEDURE DIVISION - USING BY VALUE X BY REFERENCE Y Z. - MOVE "Z" TO X. - MOVE 56 TO Y. - MOVE 78 TO Z. - EXIT PROGRAM. -_ATEOF - - -cat >caller.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. caller. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 X PIC X. - 01 Y PIC 99. - 01 Z PIC 99 USAGE COMP. - PROCEDURE DIVISION. - MOVE "X" TO X. - MOVE 12 TO Y. - MOVE 34 TO Z. - CALL "callee" USING BY CONTENT X - BY REFERENCE Y - BY CONTENT Z - END-CALL. - IF X NOT = "X" OR - Y NOT = 56 OR - Z NOT = 34 - DISPLAY "X = " X " Y = " Y " Z = " Z - END-DISPLAY - END-IF - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_extensions.at:2764: \$COMPILE caller.cob" -at_fn_check_prepare_dynamic "$COMPILE caller.cob" "run_extensions.at:2764" -( $at_check_trace; $COMPILE caller.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_extensions.at:2764" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_extensions.at:2765: \$COMPILE_MODULE callee.cob" -at_fn_check_prepare_dynamic "$COMPILE_MODULE callee.cob" "run_extensions.at:2765" -( $at_check_trace; $COMPILE_MODULE callee.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_extensions.at:2765" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_extensions.at:2766: \$COBCRUN_DIRECT ./caller" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./caller" "run_extensions.at:2766" -( $at_check_trace; $COBCRUN_DIRECT ./caller -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_extensions.at:2766" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_991 -#AT_START_992 -at_fn_group_banner 992 'run_extensions.at:2771' \ - "PROCEDURE DIVISION CHAINING" " " 4 -at_xfail=no -( - $as_echo "992. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 X PIC X. - 01 ABCD PIC X(4). - 01 NUM PIC 9 VALUE 7. - PROCEDURE DIVISION - CHAINING X ABCD NUM. - IF X NOT = "X" OR - ABCD NOT = "ABCD" - DISPLAY "X = " X " ABCD = " ABCD - END-DISPLAY - END-IF - IF NUM NOT = 7 - DISPLAY "NUM not INITIALIZED: " NUM - END-DISPLAY - END-IF - STOP RUN. -_ATEOF - - -cat >prog2.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog2. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 VAR. - 03 X PIC X VALUE 'a'. - 03 ABCD PIC X(4). - 03 NUM PIC 9 VALUE 7. - PROCEDURE DIVISION - CHAINING VAR. - DISPLAY '-' VAR '-' WITH NO ADVANCING - END-DISPLAY - STOP RUN. -_ATEOF - - -cat >prog3.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog3. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 X PIC X. - 01 ABCD PIC X(4). - 01 NUM PIC 9 VALUE 7. - PROCEDURE DIVISION - CHAINING X ABCD NUM. - IF X NOT = "X" OR - ABCD NOT = "ABCD" - DISPLAY "X = " X " ABCD = " ABCD - END-DISPLAY - END-IF - IF NUM NOT = 7 - DISPLAY "NUM not INITIALIZED: " NUM - END-DISPLAY - END-IF - STOP RUN. -_ATEOF - - -cat >caller.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. caller. - DATA DIVISION. - PROCEDURE DIVISION. - CALL "prog3" USING "X ABCD" END-CALL - STOP RUN. -_ATEOF - - -cat >init.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. init. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 VAR. - 03 X PIC X VALUE 'a'. - 03 ABCD PIC X(4). - 03 NUM PIC 9 VALUE 7. - 77 NUM2 PIC 99 VALUE 2. - PROCEDURE DIVISION - CHAINING VAR. - DISPLAY '-' VAR NUM2 '-' WITH NO ADVANCING - END-DISPLAY - INITIALIZE VAR NUM2 - DISPLAY '-' VAR NUM2 '-' WITH NO ADVANCING - MOVE 'XXXX' TO ABCD - INITIALIZE VAR NUM2 ALL TO VALUE - DISPLAY '-' VAR NUM2 '-' WITH NO ADVANCING - MOVE ALL 'b' TO ABCD - INITIALIZE VAR NUM2 ALL TO VALUE THEN TO DEFAULT - DISPLAY '-' VAR NUM2 '-' WITH NO ADVANCING - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_extensions.at:2868: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_extensions.at:2868" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_extensions.at:2868" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_extensions.at:2869: \$COBCRUN_DIRECT ./prog X ABCD" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog X ABCD" "run_extensions.at:2869" -( $at_check_trace; $COBCRUN_DIRECT ./prog X ABCD -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_extensions.at:2869" -$at_failed && at_fn_log_failure -$at_traceon; } - - -# note: sticky linkage and CHAINING produced compiler errors -# --> additional test -{ set +x -$as_echo "$at_srcdir/run_extensions.at:2873: \$COMPILE prog.cob -fsticky-linkage -o prog_sticky" -at_fn_check_prepare_dynamic "$COMPILE prog.cob -fsticky-linkage -o prog_sticky" "run_extensions.at:2873" -( $at_check_trace; $COMPILE prog.cob -fsticky-linkage -o prog_sticky -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_extensions.at:2873" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_extensions.at:2874: \$COBCRUN_DIRECT ./prog_sticky X ABCD" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog_sticky X ABCD" "run_extensions.at:2874" -( $at_check_trace; $COBCRUN_DIRECT ./prog_sticky X ABCD -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_extensions.at:2874" -$at_failed && at_fn_log_failure -$at_traceon; } - - -{ set +x -$as_echo "$at_srcdir/run_extensions.at:2876: \$COMPILE prog2.cob" -at_fn_check_prepare_dynamic "$COMPILE prog2.cob" "run_extensions.at:2876" -( $at_check_trace; $COMPILE prog2.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_extensions.at:2876" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_extensions.at:2877: \$COBCRUN_DIRECT ./prog2 X" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog2 X" "run_extensions.at:2877" -( $at_check_trace; $COBCRUN_DIRECT ./prog2 X -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo "-X -" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_extensions.at:2877" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_extensions.at:2878: \$COBCRUN_DIRECT ./prog2" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog2" "run_extensions.at:2878" -( $at_check_trace; $COBCRUN_DIRECT ./prog2 -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo "-a 7-" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_extensions.at:2878" -$at_failed && at_fn_log_failure -$at_traceon; } - - -{ set +x -$as_echo "$at_srcdir/run_extensions.at:2880: \$COMPILE_MODULE prog3.cob" -at_fn_check_prepare_dynamic "$COMPILE_MODULE prog3.cob" "run_extensions.at:2880" -( $at_check_trace; $COMPILE_MODULE prog3.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_extensions.at:2880" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_extensions.at:2881: \$COBCRUN prog3 X ABCD" -at_fn_check_prepare_dynamic "$COBCRUN prog3 X ABCD" "run_extensions.at:2881" -( $at_check_trace; $COBCRUN prog3 X ABCD -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_extensions.at:2881" -$at_failed && at_fn_log_failure -$at_traceon; } - - -{ set +x -$as_echo "$at_srcdir/run_extensions.at:2883: \$COMPILE caller.cob" -at_fn_check_prepare_dynamic "$COMPILE caller.cob" "run_extensions.at:2883" -( $at_check_trace; $COMPILE caller.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_extensions.at:2883" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_extensions.at:2884: \$COBCRUN_DIRECT ./caller X ABCD" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./caller X ABCD" "run_extensions.at:2884" -( $at_check_trace; $COBCRUN_DIRECT ./caller X ABCD -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "libcob: caller.cob:6: error: CALL of program with CHAINING clause -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/run_extensions.at:2884" -$at_failed && at_fn_log_failure -$at_traceon; } - - -{ set +x -$as_echo "$at_srcdir/run_extensions.at:2888: \$COMPILE init.cob" -at_fn_check_prepare_dynamic "$COMPILE init.cob" "run_extensions.at:2888" -( $at_check_trace; $COMPILE init.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_extensions.at:2888" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_extensions.at:2889: \$COBCRUN_DIRECT ./init X" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./init X" "run_extensions.at:2889" -( $at_check_trace; $COBCRUN_DIRECT ./init X -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo "-X 02-- 000--aXXXX702--a 702-" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_extensions.at:2889" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_992 -#AT_START_993 -at_fn_group_banner 993 'run_extensions.at:2894' \ - "STOP RUN RETURNING/GIVING" " " 4 -at_xfail=no -( - $as_echo "993. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog1.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog1. - DATA DIVISION. - WORKING-STORAGE SECTION. - 77 RET PIC 99 USAGE DISPLAY. - PROCEDURE DIVISION. - MOVE 11 TO RET - STOP RUN RETURNING RET. -_ATEOF - - -cat >prog2.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog2. - DATA DIVISION. - WORKING-STORAGE SECTION. - 77 RET PIC 99 USAGE PACKED-DECIMAL. - PROCEDURE DIVISION. - MOVE 22 TO RET - STOP RUN GIVING RET. -_ATEOF - - -cat >prog3.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog3. - DATA DIVISION. - WORKING-STORAGE SECTION. - PROCEDURE DIVISION. - STOP RUN 33. -_ATEOF - - -cat >prog4.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog4. - PROCEDURE DIVISION. - STOP RUN RETURNING 44. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_extensions.at:2935: \$COMPILE prog1.cob" -at_fn_check_prepare_dynamic "$COMPILE prog1.cob" "run_extensions.at:2935" -( $at_check_trace; $COMPILE prog1.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_extensions.at:2935" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_extensions.at:2936: \$COBCRUN_DIRECT ./prog1" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog1" "run_extensions.at:2936" -( $at_check_trace; $COBCRUN_DIRECT ./prog1 -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 11 $at_status "$at_srcdir/run_extensions.at:2936" -$at_failed && at_fn_log_failure -$at_traceon; } - - -{ set +x -$as_echo "$at_srcdir/run_extensions.at:2938: \$COMPILE prog2.cob" -at_fn_check_prepare_dynamic "$COMPILE prog2.cob" "run_extensions.at:2938" -( $at_check_trace; $COMPILE prog2.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_extensions.at:2938" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_extensions.at:2939: \$COBCRUN_DIRECT ./prog2" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog2" "run_extensions.at:2939" -( $at_check_trace; $COBCRUN_DIRECT ./prog2 -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 22 $at_status "$at_srcdir/run_extensions.at:2939" -$at_failed && at_fn_log_failure -$at_traceon; } - - -{ set +x -$as_echo "$at_srcdir/run_extensions.at:2941: \$COMPILE prog3.cob" -at_fn_check_prepare_dynamic "$COMPILE prog3.cob" "run_extensions.at:2941" -( $at_check_trace; $COMPILE prog3.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_extensions.at:2941" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_extensions.at:2942: \$COBCRUN_DIRECT ./prog3" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog3" "run_extensions.at:2942" -( $at_check_trace; $COBCRUN_DIRECT ./prog3 -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 33 $at_status "$at_srcdir/run_extensions.at:2942" -$at_failed && at_fn_log_failure -$at_traceon; } - - -{ set +x -$as_echo "$at_srcdir/run_extensions.at:2944: \$COMPILE prog4.cob" -at_fn_check_prepare_dynamic "$COMPILE prog4.cob" "run_extensions.at:2944" -( $at_check_trace; $COMPILE prog4.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_extensions.at:2944" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_extensions.at:2945: \$COBCRUN_DIRECT ./prog4" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog4" "run_extensions.at:2945" -( $at_check_trace; $COBCRUN_DIRECT ./prog4 -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 44 $at_status "$at_srcdir/run_extensions.at:2945" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_993 -#AT_START_994 -at_fn_group_banner 994 'run_extensions.at:2950' \ - "GOBACK/EXIT PROGRAM RETURNING/GIVING" " " 4 -at_xfail=no -( - $as_echo "994. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 77 RETURN-DISP PIC S9(08). - PROCEDURE DIVISION. - CALL 'prog1' END-CALL - IF RETURN-CODE NOT = -1 - MOVE RETURN-CODE TO RETURN-DISP - DISPLAY 'RETURN-CODE ' RETURN-DISP - ' INSTEAD OF -1' - END-DISPLAY - END-IF - CALL 'prog2' END-CALL - IF RETURN-CODE NOT = 2 - MOVE RETURN-CODE TO RETURN-DISP - DISPLAY 'RETURN-CODE ' RETURN-DISP - ' INSTEAD OF 2' - END-DISPLAY - END-IF - STOP RUN. -_ATEOF - - -cat >prog1.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog1. - PROCEDURE DIVISION. - EXIT PROGRAM RETURNING -1. -_ATEOF - - - -cat >prog2.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog2. - PROCEDURE DIVISION. - GOBACK GIVING 2. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_extensions.at:2992: \$COMPILE prog.cob prog1.cob prog2.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob prog1.cob prog2.cob" "run_extensions.at:2992" -( $at_check_trace; $COMPILE prog.cob prog1.cob prog2.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_extensions.at:2992" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_extensions.at:2993: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_extensions.at:2993" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 2 $at_status "$at_srcdir/run_extensions.at:2993" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_994 -#AT_START_995 -at_fn_group_banner 995 'run_extensions.at:3000' \ - "ENTRY" " " 4 -at_xfail=no -( - $as_echo "995. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >caller.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. caller. - PROCEDURE DIVISION. - CALL "hello" USING "COBOL" - END-CALL. - CALL "bye" USING "COBOL" - END-CALL. - STOP RUN. -_ATEOF - - -cat >hello.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. hello. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 MSG-HELLO PIC X(7) VALUE "Hello, ". - 01 MSG-BYE PIC X(5) VALUE "Bye, ". - LINKAGE SECTION. - 01 X PIC X(5). - 01 Y PIC X(5). - PROCEDURE DIVISION USING X. - DISPLAY MSG-HELLO X "!". - EXIT PROGRAM. - - ENTRY "bye" USING Y. - DISPLAY MSG-BYE Y "!". - EXIT PROGRAM. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_extensions.at:3033: \$COMPILE caller.cob" -at_fn_check_prepare_dynamic "$COMPILE caller.cob" "run_extensions.at:3033" -( $at_check_trace; $COMPILE caller.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_extensions.at:3033" -$at_failed && at_fn_log_failure -$at_traceon; } - -# TODO: Doesn't work without sticky-linkage which is likely a bug! -{ set +x -$as_echo "$at_srcdir/run_extensions.at:3035: \$COMPILE_MODULE -fentry-statement=ok -fsticky-linkage hello.cob" -at_fn_check_prepare_dynamic "$COMPILE_MODULE -fentry-statement=ok -fsticky-linkage hello.cob" "run_extensions.at:3035" -( $at_check_trace; $COMPILE_MODULE -fentry-statement=ok -fsticky-linkage hello.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_extensions.at:3035" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_extensions.at:3036: \$COBCRUN_DIRECT ./caller" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./caller" "run_extensions.at:3036" -( $at_check_trace; $COBCRUN_DIRECT ./caller -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo "Hello, COBOL! -Bye, COBOL! -" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_extensions.at:3036" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_995 -#AT_START_996 -at_fn_group_banner 996 'run_extensions.at:3046' \ - "LINE SEQUENTIAL write" " " 4 -at_xfail=no -( - $as_echo "996. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - INPUT-OUTPUT SECTION. - FILE-CONTROL. - SELECT TEST-FILE ASSIGN "./TEST-FILE" - ORGANIZATION IS LINE SEQUENTIAL. - DATA DIVISION. - FILE SECTION. - FD TEST-FILE. - 01 TEST-REC PIC X(4). - PROCEDURE DIVISION. - OPEN OUTPUT TEST-FILE. - MOVE "a" TO TEST-REC. - WRITE TEST-REC - END-WRITE. - MOVE "ab" TO TEST-REC. - WRITE TEST-REC AFTER 1 LINES - END-WRITE. - MOVE "abc" TO TEST-REC. - WRITE TEST-REC BEFORE 2 LINES - END-WRITE. - MOVE "abcd" TO TEST-REC. - WRITE TEST-REC - END-WRITE. - CLOSE TEST-FILE. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_extensions.at:3079: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_extensions.at:3079" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_extensions.at:3079" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_extensions.at:3080: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_extensions.at:3080" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_extensions.at:3080" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_extensions.at:3081: cat TEST-FILE" -at_fn_check_prepare_trace "run_extensions.at:3081" -( $at_check_trace; cat TEST-FILE -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo "a - -ababc - -abcd -" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_extensions.at:3081" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_996 -#AT_START_997 -at_fn_group_banner 997 'run_extensions.at:3092' \ - "LINE SEQUENTIAL read" " " 4 -at_xfail=no -( - $as_echo "997. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >TEST-FILE <<'_ATEOF' -a -ab -abc -abcd -abcde -abcdef -_ATEOF - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - INPUT-OUTPUT SECTION. - FILE-CONTROL. - SELECT TEST-FILE ASSIGN "./TEST-FILE" - ORGANIZATION IS LINE SEQUENTIAL. - DATA DIVISION. - FILE SECTION. - FD TEST-FILE. - 01 TEST-REC PIC X(4). - PROCEDURE DIVISION. - OPEN INPUT TEST-FILE. - READ TEST-FILE - END-READ. - DISPLAY "(" TEST-REC ")" - END-DISPLAY. - READ TEST-FILE - END-READ. - DISPLAY "(" TEST-REC ")" - END-DISPLAY. - READ TEST-FILE - END-READ. - DISPLAY "(" TEST-REC ")" - END-DISPLAY. - READ TEST-FILE - END-READ. - DISPLAY "(" TEST-REC ")" - END-DISPLAY. - READ TEST-FILE - END-READ. - DISPLAY "(" TEST-REC ")" - END-DISPLAY. - READ TEST-FILE - END-READ. - DISPLAY "(" TEST-REC ")" - END-DISPLAY. - CLOSE TEST-FILE. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_extensions.at:3146: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_extensions.at:3146" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_extensions.at:3146" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_extensions.at:3147: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_extensions.at:3147" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo "(a ) -(ab ) -(abc ) -(abcd) -(abcd) -(abcd) -" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_extensions.at:3147" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_997 -#AT_START_998 -at_fn_group_banner 998 'run_extensions.at:3159' \ - "ASSIGN to KEYBOARD/DISPLAY" " " 4 -at_xfail=no -( - $as_echo "998. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >TEST-FILE <<'_ATEOF' -a -ab -abc -abcd -abcde -abcdef -_ATEOF - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - INPUT-OUTPUT SECTION. - FILE-CONTROL. - SELECT TEST-FILE ASSIGN KEYBOARD - ORGANIZATION IS LINE SEQUENTIAL. - SELECT TEST-OUT ASSIGN DISPLAY - ORGANIZATION IS LINE SEQUENTIAL. - DATA DIVISION. - FILE SECTION. - FD TEST-FILE. - 01 TEST-REC PIC X(80). - FD TEST-OUT. - 01 TEST-REC-OUT PIC X(80). - PROCEDURE DIVISION. - A00. - OPEN INPUT TEST-FILE. - OPEN OUTPUT TEST-OUT. - A01. - READ TEST-FILE AT END - GO TO Z99 - END-READ. - WRITE TEST-REC-OUT FROM TEST-REC - END-WRITE. - GO TO A01. - Z99. - CLOSE TEST-FILE. - CLOSE TEST-OUT. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_extensions.at:3204: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_extensions.at:3204" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_extensions.at:3204" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_extensions.at:3205: cat TEST-FILE | \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_notrace 'a shell pipeline' "run_extensions.at:3205" -( $at_check_trace; cat TEST-FILE | $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo "a -ab -abc -abcd -abcde -abcdef -" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_extensions.at:3205" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_998 -#AT_START_999 -at_fn_group_banner 999 'run_extensions.at:3217' \ - "SORT ASSIGN KEYBOARD to ASSIGN DISPLAY" " " 4 -at_xfail=yes -( - $as_echo "999. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -# GC has an extension "SORT FILES always in memory" and therefore didn't -# used the ASSIGN clause (which should be mandatory) for SORT files at all. -# We should add an according test and change the test here after cleanup, -# officially documenting the "ASSIGN clause not necessary for SORT FILES" -# extension and enable it only with a conf entry (set only in default.conf). - - -cat >TEST-FILE <<'_ATEOF' -9 -22 -11 -0 -00 -8 -77 -_ATEOF - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - INPUT-OUTPUT SECTION. - FILE-CONTROL. - SELECT TEST-FILE ASSIGN KEYBOARD - ORGANIZATION IS LINE SEQUENTIAL. - SELECT TEST-OUT ASSIGN DISPLAY - ORGANIZATION IS LINE SEQUENTIAL. - SELECT SORT-FILE. - DATA DIVISION. - FILE SECTION. - FD TEST-FILE. - 01 TEST-REC PIC X(80). - FD TEST-OUT. - 01 TEST-REC-OUT PIC X(80). - SD SORT-FILE. - 01 SORT-REC PIC X(80). - PROCEDURE DIVISION. - A00. - SORT SORT-FILE - ON ASCENDING SORT-REC - USING TEST-FILE - GIVING TEST-OUT. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_extensions.at:3265: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_extensions.at:3265" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_extensions.at:3265" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_extensions.at:3266: cat TEST-FILE | \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_notrace 'a shell pipeline' "run_extensions.at:3266" -( $at_check_trace; cat TEST-FILE | $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo "0 -00 -11 -22 -77 -8 -9 -" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_extensions.at:3266" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_999 -#AT_START_1000 -at_fn_group_banner 1000 'run_extensions.at:3279' \ - "Environment/Argument variable" " " 4 -at_xfail=no -( - $as_echo "1000. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 X PIC X(4). - 01 Y PIC X(8). - 01 Z PIC 9(4). - PROCEDURE DIVISION. - DISPLAY "TEST_ENV" UPON ENVIRONMENT-NAME - END-DISPLAY. - ACCEPT X FROM ENVIRONMENT-VALUE - END-ACCEPT. - DISPLAY "(" X ")" - END-DISPLAY. - DISPLAY "RXW" UPON ENVIRONMENT-VALUE - END-DISPLAY. - ACCEPT X FROM ENVIRONMENT-VALUE - END-ACCEPT. - DISPLAY "(" X ")" - END-DISPLAY. - ACCEPT Y FROM ARGUMENT-VALUE - END-ACCEPT. - DISPLAY "(" Y ")" - END-DISPLAY. - ACCEPT Z FROM ARGUMENT-NUMBER - END-ACCEPT. - DISPLAY "(" Z ")" - END-DISPLAY. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_extensions.at:3314: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_extensions.at:3314" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_extensions.at:3314" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_extensions.at:3315: TEST_ENV=OK \$COBCRUN_DIRECT ./prog CHECKPAR" -at_fn_check_prepare_dynamic "TEST_ENV=OK $COBCRUN_DIRECT ./prog CHECKPAR" "run_extensions.at:3315" -( $at_check_trace; TEST_ENV=OK $COBCRUN_DIRECT ./prog CHECKPAR -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo "(OK ) -(RXW ) -(CHECKPAR) -(0001) -" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_extensions.at:3315" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_1000 -#AT_START_1001 -at_fn_group_banner 1001 'run_extensions.at:3325' \ - "78 Level (1)" " " 4 -at_xfail=no -( - $as_echo "1001. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 78 X VALUE "OK". - PROCEDURE DIVISION. - DISPLAY X - END-DISPLAY. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_extensions.at:3340: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_extensions.at:3340" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_extensions.at:3340" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_extensions.at:3341: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_extensions.at:3341" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo "OK -" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_extensions.at:3341" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_1001 -#AT_START_1002 -at_fn_group_banner 1002 'run_extensions.at:3348' \ - "78 Level (2)" " " 4 -at_xfail=no -( - $as_echo "1002. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 Z. - 78 X VALUE "OK". - 78 Y VALUE "OK". - 03 FILLER PIC XX VALUE "OK". - PROCEDURE DIVISION. - DISPLAY X Z Y - END-DISPLAY. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_extensions.at:3366: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_extensions.at:3366" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_extensions.at:3366" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_extensions.at:3367: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_extensions.at:3367" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo "OKOKOK -" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_extensions.at:3367" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_1002 -#AT_START_1003 -at_fn_group_banner 1003 'run_extensions.at:3374' \ - "78 Level (3)" " " 4 -at_xfail=no -( - $as_echo "1003. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 78 X VALUE "OK". - 01 Z PIC XX VALUE "OK". - PROCEDURE DIVISION. - DISPLAY Z X - END-DISPLAY. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_extensions.at:3390: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_extensions.at:3390" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_extensions.at:3390" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_extensions.at:3391: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_extensions.at:3391" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo "OKOK -" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_extensions.at:3391" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_1003 -#AT_START_1004 -at_fn_group_banner 1004 'run_extensions.at:3398' \ - "SWITCHES with non-standard names" " " 4 -at_xfail=no -( - $as_echo "1004. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - CONFIGURATION SECTION. - SPECIAL-NAMES. - SW1 - ON IS SWIT1-ON - OFF IS SWIT1-OFF - . - SWITCH B IS SWITCH-B - ON IS SWIT2-ON - OFF IS SWIT2-OFF - . - SWITCH 25 - ON IS SWIT25-ON - OFF IS SWIT25-OFF - . - SWITCH Z - ON IS SWIT26-ON - OFF IS SWIT26-OFF - . - USW-31 - ON IS SWIT31-ON - OFF IS SWIT31-OFF - . - SWITCH-32 - ON IS SWIT32-ON - OFF IS SWIT32-OFF - . - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 SWITCH PIC 99 VALUE 12. - 78 Z VALUE 11. - PROCEDURE DIVISION. - ADD SWITCH 1 GIVING SWITCH - END-ADD. - IF SWITCH NOT = 13 - DISPLAY "SWITCH (variable) + 1 WRONG: " - SWITCH - END-DISPLAY - END-IF. - ADD SWITCH Z GIVING SWITCH - END-ADD. - IF SWITCH NOT = 24 - DISPLAY "SWITCH (variable) + Z WRONG: " - SWITCH - END-DISPLAY - END-IF. - IF SWIT1-ON - DISPLAY "ON" NO ADVANCING - END-DISPLAY - ELSE - DISPLAY "OFF" NO ADVANCING - END-DISPLAY - END-IF. - IF SWIT2-ON - DISPLAY " ON" NO ADVANCING - END-DISPLAY - ELSE - DISPLAY " OFF" NO ADVANCING - END-DISPLAY - END-IF. - SET SWITCH-B TO OFF - IF SWIT2-ON - DISPLAY " ON" NO ADVANCING - END-DISPLAY - ELSE - DISPLAY " OFF" NO ADVANCING - END-DISPLAY - END-IF. - IF SWIT25-ON - DISPLAY " ON" NO ADVANCING - END-DISPLAY - ELSE - DISPLAY " OFF" NO ADVANCING - END-DISPLAY - END-IF. - IF SWIT26-ON - DISPLAY " ON" NO ADVANCING - END-DISPLAY - ELSE - DISPLAY " OFF" NO ADVANCING - END-DISPLAY - END-IF. - IF SWIT31-ON - DISPLAY " ON" NO ADVANCING - END-DISPLAY - ELSE - DISPLAY " OFF" NO ADVANCING - END-DISPLAY - END-IF. - IF SWIT32-ON - DISPLAY " ON" NO ADVANCING - END-DISPLAY - ELSE - DISPLAY " OFF" NO ADVANCING - END-DISPLAY - END-IF. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_extensions.at:3503: \$COMPILE -fsystem-name=\"sw1, SwItCh\\ b, SWITCH\\ 25\" \\ --fsystem-name=SWITCH-32 -fsystem-name=\"SWITCH\\ Z\" -fsystem-name=USW-31 prog.cob" -at_fn_check_prepare_notrace 'an embedded newline' "run_extensions.at:3503" -( $at_check_trace; $COMPILE -fsystem-name="sw1, SwItCh\ b, SWITCH\ 25" \ --fsystem-name=SWITCH-32 -fsystem-name="SWITCH\ Z" -fsystem-name=USW-31 prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_extensions.at:3503" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_extensions.at:3505: COB_SWITCH_2=1 COB_SWITCH_26=1 COB_SWITCH_31=1 COB_SWITCH_32=1 ./prog" -at_fn_check_prepare_trace "run_extensions.at:3505" -( $at_check_trace; COB_SWITCH_2=1 COB_SWITCH_26=1 COB_SWITCH_31=1 COB_SWITCH_32=1 ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo "OFF ON OFF OFF ON ON ON" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_extensions.at:3505" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_1004 -#AT_START_1005 -at_fn_group_banner 1005 'run_extensions.at:3511' \ - "Larger REDEFINES lengths" " " 4 -at_xfail=no -( - $as_echo "1005. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 Z PIC 99. - 01 XMAIN PIC X(8). - 01 XMAINRED REDEFINES XMAIN. - 03 FILLER PIC X(4). - 03 XMAIN03. - 05 XMAIN0501 PIC X(4). - 05 XMAIN0502 REDEFINES XMAIN0501 PIC X(5). - 01 USE-VARS. - 05 USE-VALUE PIC 9 - VALUE ZERO. - 88 USE-ACTIVE-FIRST VALUE 1. - 88 USE-ACTIVE-SECOND VALUE 2. - 05 USE-FIRST. - 10 FIRST-DATA. - 20 FIRST-DATA-VAR PIC X(033). - 10 FIRST-VARIANT-A REDEFINES FIRST-DATA. - 20 PART-A-FIRST PIC X(33211). - 10 FIRST-VARIANT-B REDEFINES FIRST-DATA. - 20 PART-B-FIRST PIC X(24561). - 10 FIRST-VARIANT-C REDEFINES FIRST-DATA. - 20 PART-C-FIRST PIC X(3421). - 05 USE-SECOND REDEFINES USE-FIRST. - 10 SECOND-HEADER. - 20 SECOND-DATA PIC 9(015). - 20 SECOND-CONTROL-SUM PIC 9(015)V9(003). - 10 SECOND-VARIANT-A REDEFINES SECOND-HEADER. - 20 PART-A-SECOND PIC X(27241). - 10 SECOND-VARIANT-B REDEFINES SECOND-HEADER. - 20 PART-B-SECOND PIC X(3879). - PROCEDURE DIVISION. - MOVE LENGTH OF XMAIN TO Z. - IF Z NOT = 8 - DISPLAY "Test 1 " Z - END-DISPLAY - END-IF. - MOVE LENGTH OF XMAINRED TO Z. - IF Z NOT = 9 - DISPLAY "Test 2 " Z - END-DISPLAY - END-IF. - MOVE LENGTH OF XMAIN03 TO Z. - IF Z NOT = 5 - DISPLAY "Test 3 " Z - END-DISPLAY - END-IF. - MOVE LENGTH OF XMAIN0501 TO Z. - IF Z NOT = 4 - DISPLAY "Test 4 " Z - END-DISPLAY - END-IF. - MOVE LENGTH OF XMAIN0502 TO Z. - IF Z NOT = 5 - DISPLAY "Test 5 " Z - END-DISPLAY - END-IF. - IF LENGTH OF USE-FIRST NOT = 33211 - DISPLAY LENGTH OF USE-FIRST END-DISPLAY - END-IF. - IF LENGTH OF USE-SECOND NOT = 27241 - DISPLAY LENGTH OF USE-SECOND END-DISPLAY - END-IF. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_extensions.at:3583: \$COMPILE -flarger-redefines-ok -Wno-constant-expression prog.cob" -at_fn_check_prepare_dynamic "$COMPILE -flarger-redefines-ok -Wno-constant-expression prog.cob" "run_extensions.at:3583" -( $at_check_trace; $COMPILE -flarger-redefines-ok -Wno-constant-expression prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob:12: warning: size of 'XMAIN0502' larger than size of 'XMAIN0501' -prog.cob:21: warning: size of 'FIRST-VARIANT-A' larger than size of 'FIRST-DATA' -prog.cob:23: warning: size of 'FIRST-VARIANT-B' larger than size of 'FIRST-DATA' -prog.cob:25: warning: size of 'FIRST-VARIANT-C' larger than size of 'FIRST-DATA' -prog.cob:31: warning: size of 'SECOND-VARIANT-A' larger than size of 'SECOND-HEADER' -prog.cob:33: warning: size of 'SECOND-VARIANT-B' larger than size of 'SECOND-HEADER' -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_extensions.at:3583" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_extensions.at:3591: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_extensions.at:3591" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_extensions.at:3591" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_1005 -#AT_START_1006 -at_fn_group_banner 1006 'run_extensions.at:3596' \ - "Obsolete 2002 keywords with COBOL2014" " " 4 -at_xfail=no -( - $as_echo "1006. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 TERMINAL PIC XX VALUE "OK". - 01 SEND PIC XX VALUE "OK". - PROCEDURE DIVISION. - DISPLAY TERMINAL SEND. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_extensions.at:3611: \$COMPILE -std=cobol2002 prog.cob" -at_fn_check_prepare_dynamic "$COMPILE -std=cobol2002 prog.cob" "run_extensions.at:3611" -( $at_check_trace; $COMPILE -std=cobol2002 prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob:6: error: syntax error, unexpected TERMINAL -prog.cob:7: error: syntax error, unexpected SEND -prog.cob:9: error: syntax error, unexpected TERMINAL, expecting ( -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/run_extensions.at:3611" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_extensions.at:3616: \$COMPILE -std=cobol2014 prog.cob" -at_fn_check_prepare_dynamic "$COMPILE -std=cobol2014 prog.cob" "run_extensions.at:3616" -( $at_check_trace; $COMPILE -std=cobol2014 prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_extensions.at:3616" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_extensions.at:3617: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_extensions.at:3617" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo "OKOK -" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_extensions.at:3617" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_1006 -#AT_START_1007 -at_fn_group_banner 1007 'run_extensions.at:3626' \ - "System routine with wrong number of parameters" " " 4 -at_xfail=no -( - $as_echo "1007. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 N PIC 9 USAGE BINARY. - 77 X PIC X. - PROCEDURE DIVISION. - CALL "C$NARG" USING N X - END-CALL - IF N NOT = 2 - DISPLAY "NOTOK " N - END-DISPLAY - END-IF - STOP RUN. -_ATEOF - - -cat >wrong.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. wrong. - DATA DIVISION. - WORKING-STORAGE SECTION. - 77 X PIC X. - PROCEDURE DIVISION. - CALL "CBL_OR" USING X - END-CALL - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_extensions.at:3658: \$COMPILE wrong.cob" -at_fn_check_prepare_dynamic "$COMPILE wrong.cob" "run_extensions.at:3658" -( $at_check_trace; $COMPILE wrong.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "wrong.cob:8: error: wrong number of CALL parameters for 'CBL_OR', 1 given, 3 expected -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/run_extensions.at:3658" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_extensions.at:3661: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_extensions.at:3661" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog.cob:9: warning: wrong number of CALL parameters for 'C\$NARG', 2 given, 1 expected -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_extensions.at:3661" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_extensions.at:3664: \$COBCRUN_DIRECT ./prog 1 2" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog 1 2" "run_extensions.at:3664" -( $at_check_trace; $COBCRUN_DIRECT ./prog 1 2 -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_extensions.at:3664" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_1007 -#AT_START_1008 -at_fn_group_banner 1008 'run_extensions.at:3669' \ - "System routine C\$NARG" " " 4 -at_xfail=no -( - $as_echo "1008. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >callee.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. callee. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 X USAGE BINARY-LONG. - LINKAGE SECTION. - 01 Y PIC X. - PROCEDURE DIVISION USING Y. - CALL "C$NARG" USING X - END-CALL - IF X NOT = 1 - DISPLAY "NOTOK callee " X - END-DISPLAY - END-IF - EXIT PROGRAM. -_ATEOF - - -cat >caller.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. caller. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 X PIC X VALUE "X". - 01 N PIC 9 USAGE BINARY. - LINKAGE SECTION. - 77 Y PIC X. - 77 Z PIC X. - PROCEDURE DIVISION. - CALL "C$NARG" USING N - END-CALL - IF N NOT = 2 - DISPLAY "NOTOK caller (1) " N - END-DISPLAY - END-IF - CALL "callee" USING X - END-CALL - CALL "C$NARG" USING N - END-CALL - IF N NOT = 2 - DISPLAY "NOTOK caller (2) " N - END-DISPLAY - END-IF - STOP RUN. -_ATEOF - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 N PIC 9 USAGE BINARY. - LINKAGE SECTION. - 77 X PIC X. - 77 Y PIC X. - 77 Z PIC X. - PROCEDURE DIVISION. - CALL "C$NARG" USING N - END-CALL - DISPLAY N WITH NO ADVANCING - END-DISPLAY - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_extensions.at:3736: \$COMPILE caller.cob" -at_fn_check_prepare_dynamic "$COMPILE caller.cob" "run_extensions.at:3736" -( $at_check_trace; $COMPILE caller.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_extensions.at:3736" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_extensions.at:3737: \$COMPILE_MODULE callee.cob" -at_fn_check_prepare_dynamic "$COMPILE_MODULE callee.cob" "run_extensions.at:3737" -( $at_check_trace; $COMPILE_MODULE callee.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_extensions.at:3737" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_extensions.at:3738: \$COBCRUN_DIRECT ./caller 1 2" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./caller 1 2" "run_extensions.at:3738" -( $at_check_trace; $COBCRUN_DIRECT ./caller 1 2 -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_extensions.at:3738" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_extensions.at:3739: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_extensions.at:3739" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_extensions.at:3739" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_extensions.at:3740: \$COBCRUN_DIRECT ./prog \"1 2\"" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog \"1 2\"" "run_extensions.at:3740" -( $at_check_trace; $COBCRUN_DIRECT ./prog "1 2" -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo "1" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_extensions.at:3740" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_extensions.at:3741: \$COBCRUN_DIRECT ./prog 1 2 3" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog 1 2 3" "run_extensions.at:3741" -( $at_check_trace; $COBCRUN_DIRECT ./prog 1 2 3 -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo "3" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_extensions.at:3741" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_1008 -#AT_START_1009 -at_fn_group_banner 1009 'run_extensions.at:3746' \ - "System routine C\$PARAMSIZE" " " 4 -at_xfail=no -( - $as_echo "1009. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >callee.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. callee. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 X USAGE BINARY-LONG. - LINKAGE SECTION. - 01 Y PIC X ANY LENGTH. - PROCEDURE DIVISION USING Y. - MOVE 1 TO X. - CALL "C$PARAMSIZE" USING X - END-CALL. - IF RETURN-CODE NOT = 2 - DISPLAY "NOTOK " RETURN-CODE - END-DISPLAY - END-IF. - MOVE 0 TO RETURN-CODE. - EXIT PROGRAM. -_ATEOF - - -cat >caller.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. caller. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 X PIC XX VALUE "XY". - PROCEDURE DIVISION. - CALL "callee" USING X - END-CALL. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_extensions.at:3781: \$COMPILE caller.cob" -at_fn_check_prepare_dynamic "$COMPILE caller.cob" "run_extensions.at:3781" -( $at_check_trace; $COMPILE caller.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_extensions.at:3781" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_extensions.at:3782: \$COMPILE_MODULE callee.cob" -at_fn_check_prepare_dynamic "$COMPILE_MODULE callee.cob" "run_extensions.at:3782" -( $at_check_trace; $COMPILE_MODULE callee.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_extensions.at:3782" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_extensions.at:3783: \$COBCRUN_DIRECT ./caller" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./caller" "run_extensions.at:3783" -( $at_check_trace; $COBCRUN_DIRECT ./caller -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_extensions.at:3783" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_1009 -#AT_START_1010 -at_fn_group_banner 1010 'run_extensions.at:3788' \ - "System routine C\$CALLEDBY" " " 4 -at_xfail=no -( - $as_echo "1010. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >callee.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. callee. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 X PIC X(6) VALUE "X". - PROCEDURE DIVISION. - CALL "C$CALLEDBY" USING X - END-CALL. - IF RETURN-CODE = 1 AND - X = "caller" - DISPLAY "OK" NO ADVANCING - END-DISPLAY - END-IF. - EXIT PROGRAM. -_ATEOF - - -cat >caller.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. caller. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 X PIC X(6) VALUE "X". - PROCEDURE DIVISION. - CALL "C$CALLEDBY" USING X - END-CALL. - IF RETURN-CODE = 0 AND - X = SPACES - DISPLAY "OK" NO ADVANCING - END-DISPLAY - END-IF. - CALL "callee" - END-CALL. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_extensions.at:3827: \$COMPILE caller.cob" -at_fn_check_prepare_dynamic "$COMPILE caller.cob" "run_extensions.at:3827" -( $at_check_trace; $COMPILE caller.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_extensions.at:3827" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_extensions.at:3828: \$COMPILE_MODULE callee.cob" -at_fn_check_prepare_dynamic "$COMPILE_MODULE callee.cob" "run_extensions.at:3828" -( $at_check_trace; $COMPILE_MODULE callee.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_extensions.at:3828" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_extensions.at:3829: \$COBCRUN_DIRECT ./caller" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./caller" "run_extensions.at:3829" -( $at_check_trace; $COBCRUN_DIRECT ./caller -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo "OKOK" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/run_extensions.at:3829" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_1010 -#AT_START_1011 -at_fn_group_banner 1011 'run_extensions.at:3834' \ - "System routine C\$JUSTIFY" " " 4 -at_xfail=no -( - $as_echo "1011. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 X PIC X(4) VALUE " OK ". - PROCEDURE DIVISION. - CALL "C$JUSTIFY" USING X "L" - END-CALL. - IF X NOT = "OK " - DISPLAY X NO ADVANCING - END-DISPLAY - END-IF. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_extensions.at:3853: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_extensions.at:3853" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_extensions.at:3853" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_extensions.at:3854: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_extensions.at:3854" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_extensions.at:3854" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_1011 -#AT_START_1012 -at_fn_group_banner 1012 'run_extensions.at:3859' \ - "System routine C\$PRINTABLE" " " 4 -at_xfail=no -( - $as_echo "1012. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 X. - 03 X1 PIC X. - 03 X234 PIC XXX. - PROCEDURE DIVISION. - MOVE LOW-VALUE TO X1. - MOVE "BCD" TO X234. - CALL "C$PRINTABLE" USING X - END-CALL. - IF X NOT = ".BCD" - DISPLAY X NO ADVANCING - END-DISPLAY - END-IF. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_extensions.at:3882: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_extensions.at:3882" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_extensions.at:3882" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_extensions.at:3883: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_extensions.at:3883" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_extensions.at:3883" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_1012 -#AT_START_1013 -at_fn_group_banner 1013 'run_extensions.at:3888' \ - "System routine C\$MAKEDIR" " " 4 -at_xfail=no -( - $as_echo "1013. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - PROCEDURE DIVISION. - CALL "C$MAKEDIR" USING "TMP" - END-CALL. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_extensions.at:3902: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_extensions.at:3902" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_extensions.at:3902" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_extensions.at:3903: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_extensions.at:3903" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_extensions.at:3903" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_extensions.at:3904: test -d \"TMP\" && rmdir \"TMP\"" -at_fn_check_prepare_trace "run_extensions.at:3904" -( $at_check_trace; test -d "TMP" && rmdir "TMP" -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_extensions.at:3904" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_1013 -#AT_START_1014 -at_fn_group_banner 1014 'run_extensions.at:3909' \ - "System routine C\$GETPID" " " 4 -at_xfail=no -( - $as_echo "1014. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - PROCEDURE DIVISION. - CALL "C$GETPID" - END-CALL. - IF RETURN-CODE = 0 - DISPLAY "C$GETPID returned zero!" - END-DISPLAY - END-IF. - MOVE 0 TO RETURN-CODE. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_extensions.at:3928: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_extensions.at:3928" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_extensions.at:3928" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_extensions.at:3929: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_extensions.at:3929" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_extensions.at:3929" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_1014 -#AT_START_1015 -at_fn_group_banner 1015 'run_extensions.at:3934' \ - "System routine C\$TOUPPER" " " 4 -at_xfail=no -( - $as_echo "1015. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 X PIC X(2) VALUE "ok". - PROCEDURE DIVISION. - CALL "C$TOUPPER" USING X BY VALUE 2 - END-CALL. - IF X NOT = "OK" - DISPLAY X NO ADVANCING - END-DISPLAY - END-IF. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_extensions.at:3953: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_extensions.at:3953" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_extensions.at:3953" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_extensions.at:3954: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_extensions.at:3954" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_extensions.at:3954" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_1015 -#AT_START_1016 -at_fn_group_banner 1016 'run_extensions.at:3959' \ - "System routine C\$TOLOWER" " " 4 -at_xfail=no -( - $as_echo "1016. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 X PIC X(2) VALUE "OK". - PROCEDURE DIVISION. - CALL "C$TOLOWER" USING X BY VALUE 2 - END-CALL. - IF X NOT = "ok" - DISPLAY X NO ADVANCING - END-DISPLAY - END-IF. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_extensions.at:3978: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_extensions.at:3978" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_extensions.at:3978" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_extensions.at:3979: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_extensions.at:3979" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_extensions.at:3979" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_1016 -#AT_START_1017 -at_fn_group_banner 1017 'run_extensions.at:3984' \ - "System routine CBL_OR" " " 4 -at_xfail=no -( - $as_echo "1017. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 X PIC X(4) VALUE "0000". - 01 Z PIC X(4) VALUE X"01010101". - PROCEDURE DIVISION. - CALL "CBL_OR" USING X Z - BY VALUE LENGTH OF Z - END-CALL. - IF Z NOT = "1111" - DISPLAY Z NO ADVANCING - END-DISPLAY - END-IF. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_extensions.at:4005: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_extensions.at:4005" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_extensions.at:4005" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_extensions.at:4006: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_extensions.at:4006" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_extensions.at:4006" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_1017 -#AT_START_1018 -at_fn_group_banner 1018 'run_extensions.at:4011' \ - "System routine CBL_NOR" " " 4 -at_xfail=no -( - $as_echo "1018. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 X PIC X(4) VALUE X"03030303". - 01 Z PIC X(4) VALUE X"05050505". - PROCEDURE DIVISION. - CALL "CBL_NOR" USING X Z - BY VALUE LENGTH OF Z - END-CALL. - IF Z NOT = X"F8F8F8F8" - DISPLAY "NG" NO ADVANCING - END-DISPLAY - END-IF. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_extensions.at:4032: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_extensions.at:4032" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_extensions.at:4032" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_extensions.at:4033: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_extensions.at:4033" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_extensions.at:4033" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_1018 -#AT_START_1019 -at_fn_group_banner 1019 'run_extensions.at:4038' \ - "System routine CBL_AND" " " 4 -at_xfail=no -( - $as_echo "1019. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 X PIC X(4) VALUE "3333". - 01 Z PIC X(4) VALUE "5555". - PROCEDURE DIVISION. - CALL "CBL_AND" USING X Z - BY VALUE LENGTH OF Z - END-CALL. - IF Z NOT = "1111" - DISPLAY Z NO ADVANCING - END-DISPLAY - END-IF. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_extensions.at:4059: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_extensions.at:4059" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_extensions.at:4059" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_extensions.at:4060: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_extensions.at:4060" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_extensions.at:4060" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_1019 -#AT_START_1020 -at_fn_group_banner 1020 'run_extensions.at:4065' \ - "System routine CBL_XOR" " " 4 -at_xfail=no -( - $as_echo "1020. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 X PIC X(4) VALUE "3333". - 01 Z PIC X(4) VALUE X"02020202". - PROCEDURE DIVISION. - CALL "CBL_XOR" USING X Z - BY VALUE LENGTH OF Z - END-CALL. - IF Z NOT = "1111" - DISPLAY Z NO ADVANCING - END-DISPLAY - END-IF. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_extensions.at:4086: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_extensions.at:4086" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_extensions.at:4086" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_extensions.at:4087: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_extensions.at:4087" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_extensions.at:4087" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_1020 -#AT_START_1021 -at_fn_group_banner 1021 'run_extensions.at:4092' \ - "System routine CBL_IMP" " " 4 -at_xfail=no -( - $as_echo "1021. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 X PIC X(4) VALUE HIGH-VALUE. - 01 Z PIC X(4) VALUE "1111". - PROCEDURE DIVISION. - CALL "CBL_IMP" USING X Z - BY VALUE LENGTH OF Z - END-CALL. - IF Z NOT = "1111" - DISPLAY Z NO ADVANCING - END-DISPLAY - END-IF. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_extensions.at:4113: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_extensions.at:4113" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_extensions.at:4113" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_extensions.at:4114: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_extensions.at:4114" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_extensions.at:4114" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_1021 -#AT_START_1022 -at_fn_group_banner 1022 'run_extensions.at:4119' \ - "System routine CBL_NIMP" " " 4 -at_xfail=no -( - $as_echo "1022. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 X PIC X(4) VALUE "1111". - 01 Z PIC X(4) VALUE LOW-VALUE. - PROCEDURE DIVISION. - CALL "CBL_NIMP" USING X Z - BY VALUE LENGTH OF Z - END-CALL. - IF Z NOT = "1111" - DISPLAY Z NO ADVANCING - END-DISPLAY - END-IF. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_extensions.at:4140: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_extensions.at:4140" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_extensions.at:4140" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_extensions.at:4141: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_extensions.at:4141" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_extensions.at:4141" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_1022 -#AT_START_1023 -at_fn_group_banner 1023 'run_extensions.at:4146' \ - "System routine CBL_NOT" " " 4 -at_xfail=no -( - $as_echo "1023. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 X PIC X(4) VALUE HIGH-VALUE. - PROCEDURE DIVISION. - CALL "CBL_NOT" USING X - BY VALUE LENGTH OF X - END-CALL. - IF X NOT = LOW-VALUE - DISPLAY "NG" NO ADVANCING - END-DISPLAY - END-IF. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_extensions.at:4166: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_extensions.at:4166" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_extensions.at:4166" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_extensions.at:4167: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_extensions.at:4167" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_extensions.at:4167" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_1023 -#AT_START_1024 -at_fn_group_banner 1024 'run_extensions.at:4172' \ - "System routine CBL_EQ" " " 4 -at_xfail=no -( - $as_echo "1024. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 X PIC X(4) VALUE HIGH-VALUE. - 01 Z PIC X(4) VALUE "1111". - PROCEDURE DIVISION. - CALL "CBL_EQ" USING X Z - BY VALUE LENGTH OF Z - END-CALL. - IF Z NOT = "1111" - DISPLAY Z NO ADVANCING - END-DISPLAY - END-IF. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_extensions.at:4193: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_extensions.at:4193" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_extensions.at:4193" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_extensions.at:4194: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_extensions.at:4194" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_extensions.at:4194" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_1024 -#AT_START_1025 -at_fn_group_banner 1025 'run_extensions.at:4199' \ - "System routine CBL_GC_GETOPT" " " 4 -at_xfail=no -( - $as_echo "1025. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - *> check combination of long and short options - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 LO. - 05 OPTIONRECORD OCCURS 2 TIMES. - 10 ONAME PIC X(25). - 10 HAS-VALUE PIC 9. - 10 VALPOINT POINTER VALUE NULL. - 10 VAL PIC X(4). - - 01 SO PIC X(256). - 01 LONGIND PIC 99. - 01 LONG-ONLY PIC 9 VALUE 1. - 01 RETURN-CHAR PIC X(4). - 01 OPT-VAL PIC X(10). - 01 RET-DISP PIC S9 VALUE 0. - - 01 COUNTER PIC 9 VALUE 0. - PROCEDURE DIVISION. - MOVE "jkl" TO SO. - - MOVE "version" TO ONAME (1). - MOVE 0 TO HAS-VALUE (1). - MOVE "v" TO VAL (1). - - MOVE "verbose" TO ONAME (2). - MOVE 0 TO HAS-VALUE (2). - MOVE "V" TO VAL (2). - - PERFORM WITH TEST AFTER - VARYING COUNTER FROM 0 BY 1 - UNTIL RETURN-CODE = -1 - CALL 'CBL_GC_GETOPT' USING - BY REFERENCE SO LO LONGIND - BY VALUE LONG-ONLY - BY REFERENCE RETURN-CHAR OPT-VAL - END-CALL - - EVALUATE COUNTER - WHEN 0 - IF RETURN-CHAR NOT = 'v' THEN - DISPLAY '0-ERROR: ' RETURN-CHAR END-DISPLAY - END-IF - WHEN 1 - IF RETURN-CHAR NOT = 'V' THEN - DISPLAY '1-ERROR: ' RETURN-CHAR END-DISPLAY - END-IF - WHEN 2 - IF RETURN-CHAR NOT = 'j' THEN - DISPLAY '2-ERROR: ' RETURN-CHAR END-DISPLAY - END-IF - WHEN 3 - IF RETURN-CHAR NOT = 'k' THEN - DISPLAY '3-ERROR: ' RETURN-CHAR END-DISPLAY - END-IF - WHEN 4 - IF RETURN-CHAR NOT = 'l' THEN - DISPLAY '4-ERROR: ' RETURN-CHAR END-DISPLAY - END-IF - WHEN 5 - IF RETURN-CODE NOT = -1 THEN - MOVE RETURN-CODE TO RET-DISP - DISPLAY 'last RETURN-CODE wrong: ' RET-DISP - END-DISPLAY - END-IF - EXIT PERFORM - END-EVALUATE - END-PERFORM. - - MOVE 0 TO RETURN-CODE. - - IF COUNTER NOT = 5 THEN - MOVE RETURN-CODE TO RET-DISP - DISPLAY 'CBL_GC_GETOPT returned -1 too early: ' COUNTER - END-DISPLAY - END-IF. - - STOP RUN. -_ATEOF - - -cat >prog2.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog2. - *> check if partial options work correct - DATA DIVISION. - WORKING-STORAGE SECTION. - *> Check with wrong record count - - - 01 LO. - 05 OPTIONRECORD OCCURS 3 TIMES. - 10 ONAME PIC X(25). - 10 HAS-VALUE PIC 9. - 10 VALPOINT POINTER VALUE NULL. - 10 VAL PIC X(4). - - 78 SO VALUE "jkl". - 01 LONGIND PIC 99. - 01 LONG-ONLY PIC 9 VALUE 1. - 01 RETURN-CHAR PIC X(4). - 01 OPT-VAL PIC X(10). - 01 RET-DISP PIC S9 VALUE 0. - - 01 COUNTER PIC 9 VALUE 0. - PROCEDURE DIVISION. - MOVE "version" TO ONAME (1). - MOVE 0 TO HAS-VALUE (1). - MOVE "v" TO VAL (1). - - MOVE "verbose" TO ONAME (2). - MOVE 0 TO HAS-VALUE (2). - MOVE "V" TO VAL (2). - - PERFORM WITH TEST AFTER - VARYING COUNTER FROM 0 BY 1 - UNTIL RETURN-CODE = -1 - CALL 'CBL_GC_GETOPT' USING - BY REFERENCE SO LO LONGIND - BY VALUE LONG-ONLY - BY REFERENCE RETURN-CHAR OPT-VAL - END-CALL - - EVALUATE COUNTER - WHEN 0 - IF RETURN-CHAR NOT = '?' THEN - DISPLAY '0-ERROR: ' RETURN-CHAR END-DISPLAY - END-IF - WHEN 1 - IF RETURN-CHAR NOT = 'v' THEN - DISPLAY '1-ERROR: ' RETURN-CHAR END-DISPLAY - END-IF - WHEN 2 - IF RETURN-CODE NOT = -1 THEN - MOVE RETURN-CODE TO RET-DISP - DISPLAY 'last RETURN-CODE wrong: ' RET-DISP - END-DISPLAY - END-IF - EXIT PERFORM - END-EVALUATE - END-PERFORM. - - MOVE 0 TO RETURN-CODE. - - IF COUNTER NOT = 2 THEN - MOVE RETURN-CODE TO RET-DISP - DISPLAY 'CBL_GC_GETOPT returned -1 too early: ' COUNTER - END-DISPLAY - END-IF. - - STOP RUN. -_ATEOF - - -cat >prog3.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog3. - *> check for optional and mandatory parameters - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 SO PIC X(128). - 01 LO. - 05 OPTIONRECORD OCCURS 3 TIMES. - 10 ONAME PIC X(25). - 10 HAS-VALUE PIC 9. - 10 VALPOINT POINTER VALUE NULL. - 10 VAL PIC X(4). - 01 LONGIND PIC 99. - 01 LONG-ONLY PIC 9 VALUE 0. - 01 RETURN-CHAR PIC X(4). - 01 OPT-VAL PIC X(10). - 01 RET-DISP PIC S9 VALUE 0. - - 01 COUNTER PIC 9 VALUE 0. - PROCEDURE DIVISION. - MOVE "j:k::l" TO SO. - - MOVE "version" TO ONAME (1). - MOVE 1 TO HAS-VALUE (1). - MOVE "v" TO VAL (1). - - MOVE "verbose" TO ONAME (2). - MOVE 2 TO HAS-VALUE (2). - MOVE "V" TO VAL (2). - - MOVE "usage" TO ONAME (3). - MOVE 0 TO HAS-VALUE (3). - MOVE "u" TO VAL (3). - - PERFORM WITH TEST AFTER - VARYING COUNTER FROM 0 BY 1 - UNTIL RETURN-CODE = -1 - CALL 'CBL_GC_GETOPT' USING - BY REFERENCE SO LO LONGIND - BY VALUE LONG-ONLY - BY REFERENCE RETURN-CHAR OPT-VAL - END-CALL - - EVALUATE COUNTER - WHEN 0 - IF OPT-VAL(1:4) NOT = 'lang' THEN - DISPLAY '0-ERROR: ' OPT-VAL END-DISPLAY - END-IF - WHEN 1 - IF (OPT-VAL(1:1) NOT = 'k' OR - RETURN-CHAR NOT = 'V' OR - OPT-VAL(1:4) = 'kang') THEN - DISPLAY '1-ERROR: ' OPT-VAL ' ' RETURN-CHAR - END-DISPLAY - END-IF - WHEN 2 - IF RETURN-CHAR NOT = 'u' THEN - DISPLAY '2-ERROR: ' RETURN-CHAR END-DISPLAY - END-IF - WHEN 3 - IF OPT-VAL(1:1) NOT = '5' OR - RETURN-CHAR NOT = 'j' THEN - DISPLAY '3-ERROR: ' OPT-VAL ' ' RETURN-CHAR - END-DISPLAY - END-IF - WHEN 4 - IF OPT-VAL(1:1) NOT = '6' OR - RETURN-CHAR NOT = 'k' THEN - DISPLAY '4-ERROR: ' OPT-VAL ' ' RETURN-CHAR - END-DISPLAY - END-IF - WHEN 5 - IF RETURN-CHAR NOT = 'l' THEN - DISPLAY '5-ERROR: ' RETURN-CHAR END-DISPLAY - END-IF - WHEN 6 - IF RETURN-CODE NOT = -1 THEN - MOVE RETURN-CODE TO RET-DISP - DISPLAY 'last RETURN-CODE wrong: ' RET-DISP - END-DISPLAY - END-IF - EXIT PERFORM - END-EVALUATE - END-PERFORM. - - MOVE 0 TO RETURN-CODE. - - IF COUNTER NOT = 6 THEN - MOVE RETURN-CODE TO RET-DISP - DISPLAY 'CBL_GC_GETOPT returned -1 too early: ' COUNTER - END-DISPLAY - END-IF. - - STOP RUN. -_ATEOF - - -cat >prog4.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog4. - *> check use of value pointer and trimming of opt-val - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 SO PIC X(12). - 01 LO. - 05 OPTIONRECORD OCCURS 3 TIMES. - 10 ONAME PIC X(25). - 10 HAS-VALUE PIC 9. - 10 VALPOINT POINTER VALUE NULL. - 10 VAL PIC X(4). - 01 LONGIND PIC 99. - 01 LONG-ONLY PIC 9 VALUE 1. - 01 RETURN-CHAR PIC X(4). - 01 OPT-VAL PIC X(10). - 01 RET-DISP PIC S999 VALUE 0. - - 01 COUNTER PIC 9 VALUE 0. - - 01 FLAG-VAL PIC X(4). - procedure division. - MOVE "jkl" TO SO. - - MOVE "static" TO ONAME (1). - MOVE 0 TO HAS-VALUE (1). - SET VALPOINT(1) TO ADDRESS OF FLAG-VAL. - MOVE '1' TO VAL (1). - - MOVE "dynamic" TO ONAME (2). - MOVE 0 TO HAS-VALUE (2). - SET VALPOINT(2) TO ADDRESS OF FLAG-VAL. - MOVE '0' TO VAL (2). - - MOVE "usage" TO ONAME (3). - MOVE 1 TO HAS-VALUE (3). - MOVE 'u' TO VAL (3). - - PERFORM WITH TEST AFTER - VARYING COUNTER FROM 0 BY 1 - UNTIL RETURN-CODE = -1 - CALL 'CBL_GC_GETOPT' USING - BY REFERENCE SO LO LONGIND - BY VALUE LONG-ONLY - BY REFERENCE RETURN-CHAR OPT-VAL - END-CALL - - EVALUATE COUNTER - WHEN 0 - IF RETURN-CODE NOT = 0 OR - FLAG-VAL NOT = '1' THEN - DISPLAY '0-ERROR: ' RET-DISP ' ' FLAG-VAL - END-DISPLAY - END-IF - WHEN 1 - IF RETURN-CODE NOT = 0 OR - FLAG-VAL NOT = '0' THEN - DISPLAY '1-ERROR: ' RET-DISP ' ' FLAG-VAL - END-DISPLAY - END-IF - WHEN 2 - IF RETURN-CHAR NOT = 'u' OR - RETURN-CODE NOT = 2 THEN - DISPLAY '2-ERROR: ' RET-DISP ' ' FLAG-VAL - END-DISPLAY - END-IF - WHEN 3 - IF RETURN-CODE NOT = -1 THEN - MOVE RETURN-CODE TO RET-DISP - DISPLAY 'last RETURN-CODE wrong: ' RET-DISP - END-DISPLAY - END-IF - EXIT PERFORM - END-EVALUATE - END-PERFORM. - - MOVE 0 TO RETURN-CODE. - - IF COUNTER NOT = 3 THEN - MOVE RETURN-CODE TO RET-DISP - DISPLAY 'CBL_GC_GETOPT returned -1 too early: ' COUNTER - END-DISPLAY - END-IF. - - STOP RUN. -_ATEOF - - -cat >prog5.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog5. - *> check for wrong longoption structure - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 SO PIC X. - 01 LO. - 05 OPTIONRECORD OCCURS 2 TIMES. - 10 ONAME PIC X(45). - 10 HAS-VALUE PIC 9. - 10 VALPOINT POINTER VALUE NULL. - 10 VAL PIC X(4). - 01 LONGIND PIC 99. - 01 LONG-ONLY PIC 9 VALUE 1. - 01 RETURN-CHAR PIC X(4). - 01 OPT-VAL PIC X(10). - 01 RET-DISP PIC S999 VALUE 0. - - 01 COUNTER PIC 9 VALUE 0. - - 01 FLAG-VAL PIC 9. - PROCEDURE DIVISION. - MOVE "super-long-option-with-more-than-25-bytes" - TO ONAME(1). - MOVE 0 TO HAS-VALUE(1). - MOVE '1' TO VAL(1). - - MOVE "stupid-long-option-with-more-than-25-bytes" - TO ONAME(2). - MOVE 0 TO HAS-VALUE(2). - MOVE '0' TO VAL(2). - - PERFORM WITH TEST AFTER - VARYING COUNTER FROM 0 BY 1 - UNTIL RETURN-CODE = -1 - CALL 'CBL_GC_GETOPT' USING - BY REFERENCE SO LO LONGIND - BY VALUE LONG-ONLY - BY REFERENCE RETURN-CHAR OPT-VAL - END-CALL - - EVALUATE COUNTER - WHEN 0 - WHEN 1 - WHEN 2 - CONTINUE - - *> MOVE RETURN-CODE TO RET-DISP - - *> IF COUNTER = 0 AND RETURN-CODE NOT = 1 THEN - *> DISPLAY 'RETURN VALUE: ' RET-DISP ' ' FLAG-VAL - *> END-IF - WHEN 3 - IF RETURN-CODE NOT = -1 THEN - MOVE RETURN-CODE TO RET-DISP - DISPLAY 'last RETURN-CODE wrong: ' RET-DISP - END-DISPLAY - END-IF - EXIT PERFORM - END-EVALUATE - END-PERFORM. - - MOVE 0 TO RETURN-CODE. - - IF COUNTER NOT = 3 THEN - MOVE RETURN-CODE TO RET-DISP - DISPLAY 'CBL_GC_GETOPT returned -1 too early: ' COUNTER - END-DISPLAY - END-IF. - - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_extensions.at:4616: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_extensions.at:4616" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_extensions.at:4616" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_extensions.at:4617: \$COBCRUN_DIRECT ./prog --version --verbose -jkl" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog --version --verbose -jkl" "run_extensions.at:4617" -( $at_check_trace; $COBCRUN_DIRECT ./prog --version --verbose -jkl -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_extensions.at:4617" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_extensions.at:4618: \$COMPILE_MODULE prog2.cob" -at_fn_check_prepare_dynamic "$COMPILE_MODULE prog2.cob" "run_extensions.at:4618" -( $at_check_trace; $COMPILE_MODULE prog2.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_extensions.at:4618" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_extensions.at:4619: \$COBCRUN prog2 --ver --vers" -at_fn_check_prepare_dynamic "$COBCRUN prog2 --ver --vers" "run_extensions.at:4619" -( $at_check_trace; $COBCRUN prog2 --ver --vers -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "prog2: option '--ver' is ambiguous; possibilities: '--version' '--verbose' -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_extensions.at:4619" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_extensions.at:4622: \$COMPILE prog3.cob" -at_fn_check_prepare_dynamic "$COMPILE prog3.cob" "run_extensions.at:4622" -( $at_check_trace; $COMPILE prog3.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_extensions.at:4622" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_extensions.at:4623: \$COBCRUN_DIRECT ./prog3 --version=lang --verbose=k --usage -j 5 -k6 -l" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog3 --version=lang --verbose=k --usage -j 5 -k6 -l" "run_extensions.at:4623" -( $at_check_trace; $COBCRUN_DIRECT ./prog3 --version=lang --verbose=k --usage -j 5 -k6 -l -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_extensions.at:4623" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_extensions.at:4624: \$COMPILE prog4.cob --free" -at_fn_check_prepare_dynamic "$COMPILE prog4.cob --free" "run_extensions.at:4624" -( $at_check_trace; $COMPILE prog4.cob --free -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_extensions.at:4624" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_extensions.at:4625: \$COBCRUN_DIRECT ./prog4 --static --dynamic --usage=boringandtoolongtext" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog4 --static --dynamic --usage=boringandtoolongtext" "run_extensions.at:4625" -( $at_check_trace; $COBCRUN_DIRECT ./prog4 --static --dynamic --usage=boringandtoolongtext -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_extensions.at:4625" -$at_failed && at_fn_log_failure -$at_traceon; } - -# Again a long and system specific error message which we ignore. -# Return code 1 is sufficient as proof of hard return (as wanted). -{ set +x -$as_echo "$at_srcdir/run_extensions.at:4628: \$COMPILE prog5.cob" -at_fn_check_prepare_dynamic "$COMPILE prog5.cob" "run_extensions.at:4628" -( $at_check_trace; $COMPILE prog5.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_extensions.at:4628" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_extensions.at:4629: \$COBCRUN_DIRECT ./prog5 --static" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog5 --static" "run_extensions.at:4629" -( $at_check_trace; $COBCRUN_DIRECT ./prog5 --static -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "libcob: prog5.cob:37: error: Call to CBL_GC_GETOPT with wrong longoption size. -" | \ - $at_diff - "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/run_extensions.at:4629" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_1025 -#AT_START_1026 -at_fn_group_banner 1026 'run_extensions.at:4636' \ - "System routine CBL_GC_FORK" " " 4 -at_xfail=no -( - $as_echo "1026. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 77 CHILD-PID USAGE BINARY-LONG. - 77 PARENT-PID USAGE BINARY-LONG. - PROCEDURE DIVISION. - - CALL "C$GETPID" RETURNING PARENT-PID - CALL "CBL_GC_FORK" END-CALL - EVALUATE RETURN-CODE - WHEN ZERO - PERFORM CHILD-CODE - WHEN -1 - STOP RUN RETURNING 77 *> skip test - WHEN OTHER - PERFORM PARENT-CODE - END-EVALUATE - - STOP RUN. - - CHILD-CODE. - CALL "C$SLEEP" USING 1. - DISPLAY "Hello, I am the child". - CALL "C$GETPID" RETURNING CHILD-PID. - IF CHILD-PID = PARENT-PID - DISPLAY "CHILD: parent and child have same PID: " - "'" CHILD-PID "'" UPON SYSERR - END-DISPLAY - END-IF. - MOVE 0 TO RETURN-CODE. - - PARENT-CODE. - DISPLAY "Hello, I am the parent". - CALL "C$SLEEP" USING 4. - DISPLAY "Parent again". - IF RETURN-CODE = PARENT-PID - DISPLAY "PARENT: parent and child have same PID: " - "'" PARENT-PID "'" UPON SYSERR - END-DISPLAY - END-IF. - CALL "C$GETPID". - IF RETURN-CODE NOT = PARENT-PID - DISPLAY "PARENT: parent PID has changed: " - "'" PARENT-PID "' -> '" RETURN-CODE "'" - UPON SYSERR - END-DISPLAY - END-IF. - MOVE 0 TO RETURN-CODE. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_extensions.at:4691: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_extensions.at:4691" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_extensions.at:4691" -$at_failed && at_fn_log_failure -$at_traceon; } - - -{ set +x -$as_echo "$at_srcdir/run_extensions.at:4693: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_extensions.at:4693" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo "Hello, I am the parent -Hello, I am the child -Parent again -" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_extensions.at:4693" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_1026 -#AT_START_1027 -at_fn_group_banner 1027 'run_extensions.at:4704' \ - "System routine CBL_GC_WAITPID" " " 4 -at_xfail=no -( - $as_echo "1027. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 CHILD-PID PIC S9(9) BINARY. - 01 WAIT-STS PIC S9(9) BINARY VALUE -3. - PROCEDURE DIVISION. - - CALL "CBL_GC_FORK" RETURNING CHILD-PID. - EVALUATE CHILD-PID - WHEN ZERO - PERFORM CHILD-CODE - WHEN -1 - STOP RUN RETURNING 77 *> skip test - WHEN OTHER - PERFORM PARENT-CODE - END-EVALUATE. - - STOP RUN. - - CHILD-CODE. - CALL "C$SLEEP" USING 1. - DISPLAY "Hello, I am the child". - MOVE 2 TO RETURN-CODE. - - PARENT-CODE. - DISPLAY "Hello, I am the parent". - CALL "CBL_GC_WAITPID" USING CHILD-PID - RETURNING WAIT-STS - END-CALL - MOVE 0 TO RETURN-CODE - IF WAIT-STS = -1 - STOP RUN RETURNING 77 *> skip test - END-IF - DISPLAY "Child ended status " WAIT-STS - END-DISPLAY. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_extensions.at:4746: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_extensions.at:4746" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_extensions.at:4746" -$at_failed && at_fn_log_failure -$at_traceon; } - - -{ set +x -$as_echo "$at_srcdir/run_extensions.at:4748: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_extensions.at:4748" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo "Hello, I am the parent -Hello, I am the child -Child ended status +000000002 -" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_extensions.at:4748" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_1027 -#AT_START_1028 -at_fn_group_banner 1028 'run_extensions.at:4756' \ - "System routine CBL_GC_HOSTED" " " 4 -at_xfail=no -( - $as_echo "1028. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >test_errno.c <<'_ATEOF' - -#include -#include - -#include - -COB_EXT_EXPORT int -test_errno(void) -{ - FILE *fail; - fail = fopen("file-not-found", "r"); - if (errno != 2) { - printf("BAD ERRNO %d", errno); - } else { - if (fail) fclose(fail); - } - return 0; -} -_ATEOF - - -cat >test_stdio.c <<'_ATEOF' - -#include - -#include -COB_EXT_EXPORT int -test_stdio(FILE *si, FILE *so, FILE *se) -{ - if (feof(si)) { - fprintf(se, "BAD STDIN EOF\n"); - } - fprintf(so, "OUT"); - return fprintf(se, "ERR"); -} -_ATEOF - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 STDIN USAGE POINTER. - 01 STDOUT USAGE POINTER. - 01 STDERR USAGE POINTER. - 01 CELL USAGE BINARY-LONG. - 01 ARGC USAGE BINARY-LONG. - 01 ARGV USAGE POINTER. - 01 ERRPTR USAGE POINTER. - 01 ERRNO USAGE BINARY-LONG BASED. - 01 TZNAME USAGE POINTER. - 01 TZNAMES USAGE POINTER BASED. - 05 TZS USAGE POINTER OCCURS 2 TIMES. - 01 TIMEZONE USAGE BINARY-C-LONG. - 01 DAYLIGHT USAGE BINARY-LONG. - - PROCEDURE DIVISION. - CALL "CBL_GC_HOSTED" USING STDIN "stdin" END-CALL - CALL "CBL_GC_HOSTED" USING STDOUT "stdout" END-CALL - CALL "CBL_GC_HOSTED" USING STDERR "stderr" END-CALL - CALL "CBL_GC_HOSTED" USING ARGC "argc" END-CALL - CALL "CBL_GC_HOSTED" USING ARGV "argv" END-CALL - CALL "CBL_GC_HOSTED" USING CELL "cell" END-CALL - CALL "CBL_GC_HOSTED" USING ERRPTR "errno" END-CALL - CALL "CBL_GC_HOSTED" USING ARGC "arg" END-CALL - CALL "CBL_GC_HOSTED" USING NULL "argc" END-CALL - SET ADDRESS OF ERRNO TO ERRPTR - CALL "CBL_GC_HOSTED" USING TZNAME "tzname" END-CALL - CALL "CBL_GC_HOSTED" USING TIMEZONE "timezone" END-CALL - CALL "CBL_GC_HOSTED" USING DAYLIGHT "daylight" END-CALL - - CALL "test_errno" - END-CALL - IF ERRNO NOT EQUAL 2 THEN - DISPLAY "BAD ERRNO " ERRNO END-DISPLAY - END-IF - - IF ARGC NOT EQUAL 2 THEN - DISPLAY "BAD ARGC " ARGC END-DISPLAY - END-IF - IF ARGV EQUAL NULL THEN - DISPLAY "BAD ARGV" END-DISPLAY - END-IF - - IF CELL LESS THAN 0 OR GREATER THAN 8 THEN - DISPLAY "UNK CELL " CELL END-DISPLAY - END-IF - - SET ENVIRONMENT "TZ" TO "PST8PDT" - CALL "tzset" RETURNING OMITTED - ON EXCEPTION CONTINUE - END-CALL - IF TZNAME NOT EQUAL NULL THEN - SET ADDRESS OF TZNAMES TO TZNAME - IF TZS(1) EQUAL NULL THEN - DISPLAY "BAD TZNAME" END-DISPLAY - END-IF - END-IF - - *> Test assumes return-code will be 3, chars output by last fprintf - CALL "test_stdio" USING BY VALUE STDIN STDOUT STDERR - END-CALL - - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_extensions.at:4862: \$COMPILE_MODULE test_errno.c" -at_fn_check_prepare_dynamic "$COMPILE_MODULE test_errno.c" "run_extensions.at:4862" -( $at_check_trace; $COMPILE_MODULE test_errno.c -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_extensions.at:4862" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_extensions.at:4863: \$COMPILE_MODULE test_stdio.c" -at_fn_check_prepare_dynamic "$COMPILE_MODULE test_stdio.c" "run_extensions.at:4863" -( $at_check_trace; $COMPILE_MODULE test_stdio.c -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_extensions.at:4863" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_extensions.at:4864: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_extensions.at:4864" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_extensions.at:4864" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_extensions.at:4865: \$COBCRUN_DIRECT ./prog 1ARG" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog 1ARG" "run_extensions.at:4865" -( $at_check_trace; $COBCRUN_DIRECT ./prog 1ARG -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "ERR" | \ - $at_diff - "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo "OUT" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 3 $at_status "$at_srcdir/run_extensions.at:4865" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_1028 -#AT_START_1029 -at_fn_group_banner 1029 'run_extensions.at:4870' \ - "System routine SYSTEM, parameter handling" " " 4 -at_xfail=no -( - $as_echo "1029. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - - DATA DIVISION. - WORKING-STORAGE SECTION. - * - 77 test-no PIC 9 VALUE 0. - 77 chaining-param PIC X(20). - 77 chaining-param-2 PIC X(20). - * - PROCEDURE DIVISION CHAINING chaining-param, chaining-param-2. - * - main. - EVALUATE chaining-param ALSO chaining-param-2 - WHEN SPACES ALSO SPACES - DISPLAY "started without options - closing" - WHEN "1" ALSO SPACES - WHEN '"1"' ALSO SPACES - WHEN "a v" ALSO SPACES - WHEN '"a v"' ALSO SPACES - DISPLAY " called with -" - function trim (chaining-param) "-" - WHEN "a" ALSO "v" - DISPLAY " called with -" - FUNCTION TRIM (chaining-param) "-" - " and with -" - FUNCTION TRIM (chaining-param-2) "-" - WHEN "start" ALSO SPACES - MOVE 'prog 1' TO chaining-param - PERFORM callme - MOVE 'prog "1"' TO chaining-param - PERFORM callme - MOVE '"prog" 1' TO chaining-param - PERFORM callme - MOVE '"prog" "1"' TO chaining-param - PERFORM callme - MOVE 'prog a v' TO chaining-param - PERFORM callme - MOVE 'prog "a v"' TO chaining-param - PERFORM callme - MOVE '"prog" a v' TO chaining-param - PERFORM callme - MOVE '"prog" "a v"' TO chaining-param - PERFORM callme - MOVE '"prog" "a" "v"' TO chaining-param - PERFORM callme - DISPLAY "tests finished" - WHEN OTHER - DISPLAY "called with unexpected -" - FUNCTION TRIM (chaining-param) "-" - END-EVALUATE - STOP RUN. - * - callme. - ADD 1 TO test-no. - DISPLAY "Test #" test-no ":" - DISPLAY " CALL 'SYSTEM' with " - FUNCTION TRIM (chaining-param) ":" - CALL "SYSTEM" USING FUNCTION TRIM (chaining-param) - DISPLAY " --> return of the given CALL 'SYSTEM': " - return-code. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_extensions.at:4937: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_extensions.at:4937" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_extensions.at:4937" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_extensions.at:4938: PATH=.:\$PATH \$COBCRUN_DIRECT prog \"start\"" -at_fn_check_prepare_dynamic "PATH=.:$PATH $COBCRUN_DIRECT prog \"start\"" "run_extensions.at:4938" -( $at_check_trace; PATH=.:$PATH $COBCRUN_DIRECT prog "start" -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo "Test #1: - CALL 'SYSTEM' with prog 1: - called with -1- - --> return of the given CALL 'SYSTEM': +000000000 -Test #2: - CALL 'SYSTEM' with prog \"1\": - called with -1- - --> return of the given CALL 'SYSTEM': +000000000 -Test #3: - CALL 'SYSTEM' with \"prog\" 1: - called with -1- - --> return of the given CALL 'SYSTEM': +000000000 -Test #4: - CALL 'SYSTEM' with \"prog\" \"1\": - called with -1- - --> return of the given CALL 'SYSTEM': +000000000 -Test #5: - CALL 'SYSTEM' with prog a v: - called with -a- and with -v- - --> return of the given CALL 'SYSTEM': +000000000 -Test #6: - CALL 'SYSTEM' with prog \"a v\": - called with -a v- - --> return of the given CALL 'SYSTEM': +000000000 -Test #7: - CALL 'SYSTEM' with \"prog\" a v: - called with -a- and with -v- - --> return of the given CALL 'SYSTEM': +000000000 -Test #8: - CALL 'SYSTEM' with \"prog\" \"a v\": - called with -a v- - --> return of the given CALL 'SYSTEM': +000000000 -Test #9: - CALL 'SYSTEM' with \"prog\" \"a\" \"v\": - called with -a- and with -v- - --> return of the given CALL 'SYSTEM': +000000000 -tests finished -" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_extensions.at:4938" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_1029 -#AT_START_1030 -at_fn_group_banner 1030 'run_extensions.at:4981' \ - "System routine CBL_ERROR_PROC" " " 4 -at_xfail=no -( - $as_echo "1030. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. DemoErrProc. - ENVIRONMENT DIVISION. - DATA DIVISION. - WORKING-STORAGE SECTION. - 77 Err-Proc-Address USAGE PROGRAM-POINTER. - 77 Err-Message-Len PIC 9(04) USAGE COMP-5. - LINKAGE SECTION. - 77 Err-Message-From-Runtime PIC X(1023). - PROCEDURE DIVISION. - S1. - DISPLAY 'Program is starting' - SET Err-Proc-Address TO ENTRY 'ErrProc' - CALL 'CBL_ERROR_PROC' USING 0, Err-Proc-Address - SET Err-Proc-Address TO ENTRY 'ErrProc-internal' - CALL 'CBL_ERROR_PROC' USING 0, Err-Proc-Address - SET Err-Proc-Address TO NULL - CALL 'Tilt' *> THIS DOESN'T EXIST!!!! - DISPLAY 'Program is stopping' - STOP RUN - . - ENTRY 'ErrProc-internal' USING Err-Message-From-Runtime. - DISPLAY 'Error (interal): ' FUNCTION EXCEPTION-LOCATION '-' - DISPLAY ' ' FUNCTION EXCEPTION-STATEMENT '-' - DISPLAY ' ' FUNCTION EXCEPTION-STATUS '-' - *> NOTE: the error message is *EXPLICIT* specified to end with x'00' - MOVE 0 TO Err-Message-Len - INSPECT Err-Message-From-Runtime - TALLYING Err-Message-Len FOR CHARACTERS BEFORE x'00' - DISPLAY 'Error-Message: ' Err-Message-From-Runtime - (1:Err-Message-Len) - DISPLAY '-*- Returning to Next Error Routine -*-' - EXIT PROGRAM - . - END PROGRAM DemoErrProc. - - IDENTIFICATION DIVISION. - PROGRAM-ID. ErrProc. - PROCEDURE DIVISION. - 000-Main. - DISPLAY 'Error: ' FUNCTION EXCEPTION-LOCATION '-' - DISPLAY ' ' FUNCTION EXCEPTION-STATEMENT '-' - DISPLAY ' ' FUNCTION EXCEPTION-STATUS '-' - DISPLAY '-*- Returning to Standard Error Routine -*-' - EXIT PROGRAM - . - END PROGRAM ErrProc. -_ATEOF - -{ set +x -$as_echo "$at_srcdir/run_extensions.at:5034: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_extensions.at:5034" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_extensions.at:5034" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_extensions.at:5035: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_extensions.at:5035" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "libcob: prog.cob:19: error: module 'Tilt' not found -" | \ - $at_diff - "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo "Program is starting -Error (interal): DemoErrProc; S1; 19- - CALL - - EC-PROGRAM-NOT-FOUND - -Error-Message: prog.cob:19: module 'Tilt' not found --*- Returning to Next Error Routine -*- -Error: DemoErrProc; S1; 19- - CALL - - EC-PROGRAM-NOT-FOUND - --*- Returning to Standard Error Routine -*- -" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/run_extensions.at:5035" -$at_failed && at_fn_log_failure -$at_traceon; } - - -{ set +x -$as_echo "$at_srcdir/run_extensions.at:5050: \$COBC -x -o prog_noloc prog.cob" -at_fn_check_prepare_dynamic "$COBC -x -o prog_noloc prog.cob" "run_extensions.at:5050" -( $at_check_trace; $COBC -x -o prog_noloc prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_extensions.at:5050" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_extensions.at:5051: \$COBCRUN_DIRECT ./prog_noloc" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog_noloc" "run_extensions.at:5051" -( $at_check_trace; $COBCRUN_DIRECT ./prog_noloc -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -echo >>"$at_stderr"; $as_echo "libcob: error: module 'Tilt' not found -" | \ - $at_diff - "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo "Program is starting -Error (interal): - - - - EC-PROGRAM-NOT-FOUND - -Error-Message: module 'Tilt' not found --*- Returning to Next Error Routine -*- -Error: - - - - EC-PROGRAM-NOT-FOUND - --*- Returning to Standard Error Routine -*- -" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 1 $at_status "$at_srcdir/run_extensions.at:5051" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_1030 -#AT_START_1031 -at_fn_group_banner 1031 'run_extensions.at:5069' \ - "DISPLAY DIRECTIVE and \$DISPLAY" " " 4 -at_xfail=no -( - $as_echo "1031. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - PROCEDURE DIVISION. - >> DISPLAY some text - >> DISPLAY other text #2 *> comment - >> DISPLAY "literal text *> no comment" - $DISPLAY MF compile time text *> without comment - GOBACK. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_extensions.at:5085: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_extensions.at:5085" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo "some text -other text #2 -literal text *> no comment -MF compile time text -" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_extensions.at:5085" -$at_failed && at_fn_log_failure -$at_traceon; } - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_1031 -#AT_START_1032 -at_fn_group_banner 1032 'run_extensions.at:5094' \ - "Conditional/define directives (1)" " " 4 -at_xfail=no -( - $as_echo "1032. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - PROCEDURE DIVISION. - >>IF ACTIVATE NOT DEFINED - DISPLAY "OK" NO ADVANCING - END-DISPLAY - >>ELSE - DISPLAY "NOTOK" NO ADVANCING - END-DISPLAY - >>END-IF - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_extensions.at:5113: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_extensions.at:5113" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_extensions.at:5113" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_extensions.at:5114: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_extensions.at:5114" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo "OK" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_extensions.at:5114" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_1032 -#AT_START_1033 -at_fn_group_banner 1033 'run_extensions.at:5119' \ - "Conditional/define directives (2)" " " 4 -at_xfail=no -( - $as_echo "1033. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - PROCEDURE DIVISION. - >>IF ACTIVATE DEFINED - DISPLAY "OK" NO ADVANCING - END-DISPLAY - >>ELSE - DISPLAY "NOTOK" NO ADVANCING - END-DISPLAY - >>END-IF - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_extensions.at:5138: \$COMPILE -DACTIVATE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE -DACTIVATE prog.cob" "run_extensions.at:5138" -( $at_check_trace; $COMPILE -DACTIVATE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_extensions.at:5138" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_extensions.at:5139: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_extensions.at:5139" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo "OK" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_extensions.at:5139" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_1033 -#AT_START_1034 -at_fn_group_banner 1034 'run_extensions.at:5144' \ - "Conditional/define directives (3)" " " 4 -at_xfail=no -( - $as_echo "1034. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - PROCEDURE DIVISION. - >>IF ACTIVATE DEFINED - DISPLAY "NOTOK" NO ADVANCING - END-DISPLAY - >>ELIF ACTIVATE2 DEFINED - DISPLAY "OK" NO ADVANCING - END-DISPLAY - >>ELSE - DISPLAY "NOTOK" NO ADVANCING - END-DISPLAY - >>END-IF - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_extensions.at:5166: \$COMPILE -DACTIVATE2 prog.cob" -at_fn_check_prepare_dynamic "$COMPILE -DACTIVATE2 prog.cob" "run_extensions.at:5166" -( $at_check_trace; $COMPILE -DACTIVATE2 prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_extensions.at:5166" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_extensions.at:5167: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_extensions.at:5167" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo "OK" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_extensions.at:5167" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_1034 -#AT_START_1035 -at_fn_group_banner 1035 'run_extensions.at:5172' \ - "Conditional/define directives (4)" " " 4 -at_xfail=no -( - $as_echo "1035. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - PROCEDURE DIVISION. - >>IF ACTIVATE DEFINED - DISPLAY "NOTOK" NO ADVANCING - END-DISPLAY - >>ELIF ACTIVATE2 DEFINED - >>ELSE - DISPLAY "NOTOK" NO ADVANCING - END-DISPLAY - >>END-IF - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_extensions.at:5192: \$COMPILE -DACTIVATE2 prog.cob" -at_fn_check_prepare_dynamic "$COMPILE -DACTIVATE2 prog.cob" "run_extensions.at:5192" -( $at_check_trace; $COMPILE -DACTIVATE2 prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_extensions.at:5192" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_extensions.at:5193: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_extensions.at:5193" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_extensions.at:5193" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_1035 -#AT_START_1036 -at_fn_group_banner 1036 'run_extensions.at:5198' \ - "Conditional/define directives (5)" " " 4 -at_xfail=no -( - $as_echo "1036. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - PROCEDURE DIVISION. - >>IF ACTIVATE DEFINED - >>DISPLAY NOTOK - >>ELIF ACTIVATE2 DEFINED - >>DISPLAY OK - >>ELSE - >>DISPLAY NOTOK - >>END-IF - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_extensions.at:5217: \$COMPILE -DACTIVATE2 prog.cob" -at_fn_check_prepare_dynamic "$COMPILE -DACTIVATE2 prog.cob" "run_extensions.at:5217" -( $at_check_trace; $COMPILE -DACTIVATE2 prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo "OK -" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_extensions.at:5217" -$at_failed && at_fn_log_failure -$at_traceon; } - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_1036 -#AT_START_1037 -at_fn_group_banner 1037 'run_extensions.at:5223' \ - "Conditional/define directives (6)" " " 4 -at_xfail=no -( - $as_echo "1037. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - PROCEDURE DIVISION. - >>IF X DEFINED - >>DISPLAY X defined - >>ELSE - >>DISPLAY X not defined - >>DEFINE X 1 - >>END-IF - CONTINUE - . -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_extensions.at:5240: \$COMPILE -D X prog.cob" -at_fn_check_prepare_dynamic "$COMPILE -D X prog.cob" "run_extensions.at:5240" -( $at_check_trace; $COMPILE -D X prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo "X defined -" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_extensions.at:5240" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_extensions.at:5243: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_extensions.at:5243" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo "X not defined -" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_extensions.at:5243" -$at_failed && at_fn_log_failure -$at_traceon; } - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_1037 -#AT_START_1038 -at_fn_group_banner 1038 'run_extensions.at:5249' \ - "Conditional/define directives (7)" " " 4 -at_xfail=no -( - $as_echo "1038. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - PROCEDURE DIVISION. - >>IF A IS DEFINED - >>IF B IS DEFINED - CONTINUE - . - >>ELSE - CONTINUE - . - >>END-IF - >>END-IF -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_extensions.at:5267: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_extensions.at:5267" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_extensions.at:5267" -$at_failed && at_fn_log_failure -$at_traceon; } - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_1038 -#AT_START_1039 -at_fn_group_banner 1039 'run_extensions.at:5271' \ - "Conditional/define directives (8)" " " 4 -at_xfail=no -( - $as_echo "1039. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - PROCEDURE DIVISION. - >>IF A IS DEFINED - CONTINUE - . - >>else - CONTINUE - . - >>eNd-If -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_extensions.at:5287: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_extensions.at:5287" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_extensions.at:5287" -$at_failed && at_fn_log_failure -$at_traceon; } - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_1039 -#AT_START_1040 -at_fn_group_banner 1040 'run_extensions.at:5291' \ - "Variable format" " " 4 -at_xfail=no -( - $as_echo "1040. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - >>SOURCE FORMAT VARIABLE -000010 IDENTIFICATION DIVISION. -000020 PROGRAM-ID. prog. -000030* blah blah blah -000040 PROCEDURE DIVISION. -000050 DISPLAY "Hello!" -000060 . -000070 END PROGRAM prog. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_extensions.at:5305: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_extensions.at:5305" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_extensions.at:5305" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_extensions.at:5306: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_extensions.at:5306" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo "Hello! -" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_extensions.at:5306" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_1040 -#AT_START_1041 -at_fn_group_banner 1041 'run_extensions.at:5313' \ - "Binary COMP-1 (1)" " " 4 -at_xfail=no -( - $as_echo "1041. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 comp1 COMP-1. - 01 num PIC 9.9. - - PROCEDURE DIVISION. - COMPUTE comp1 = 7 / 2 - MOVE comp1 TO num - DISPLAY num - . -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_extensions.at:5332: \$COMPILE -fbinary-comp-1 prog.cob" -at_fn_check_prepare_dynamic "$COMPILE -fbinary-comp-1 prog.cob" "run_extensions.at:5332" -( $at_check_trace; $COMPILE -fbinary-comp-1 prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_extensions.at:5332" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_extensions.at:5333: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_extensions.at:5333" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo "3.0 -" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_extensions.at:5333" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_extensions.at:5336: \$COMPILE -fno-binary-comp-1 prog.cob" -at_fn_check_prepare_dynamic "$COMPILE -fno-binary-comp-1 prog.cob" "run_extensions.at:5336" -( $at_check_trace; $COMPILE -fno-binary-comp-1 prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_extensions.at:5336" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_extensions.at:5337: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_extensions.at:5337" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo "3.5 -" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_extensions.at:5337" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_1041 -#AT_START_1042 -at_fn_group_banner 1042 'run_extensions.at:5344' \ - "Binary COMP-1 (2)" " " 4 -at_xfail=no -( - $as_echo "1042. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - >>IF BINARY-COMP-1 IS DEFINED - $SET COMP-1(BINARY) - >>ELSE - $SET COMP1 "float" - >>END-IF - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 comp1 COMP-1. - 01 num PIC 9.9. - - PROCEDURE DIVISION. - COMPUTE comp1 = 7 / 2 - MOVE comp1 TO num - DISPLAY num - . -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_extensions.at:5368: \$COMPILE -DBINARY-COMP-1 prog.cob" -at_fn_check_prepare_dynamic "$COMPILE -DBINARY-COMP-1 prog.cob" "run_extensions.at:5368" -( $at_check_trace; $COMPILE -DBINARY-COMP-1 prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_extensions.at:5368" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_extensions.at:5369: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_extensions.at:5369" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo "3.0 -" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_extensions.at:5369" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_extensions.at:5372: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_extensions.at:5372" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_extensions.at:5372" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_extensions.at:5373: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_extensions.at:5373" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo "3.5 -" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_extensions.at:5373" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_1042 -#AT_START_1043 -at_fn_group_banner 1043 'run_ml.at:19' \ - "XML GENERATE general" " " 4 -at_xfail=no -( - $as_echo "1043. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -$as_echo "run_ml.at:22" >"$at_check_line_file" -(test "$COB_HAS_XML2" = "no") \ - && at_fn_check_skip 77 "$at_srcdir/run_ml.at:22" - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 namespace-str PIC X(100) - VALUE 'http://www.w3.org/1999/xhtml'. - 01 prefix-str PIC X(100) VALUE 'pre'. - - 01 out PIC X(200). - 01 rec. - 03 a PIC X(3) VALUE 'A'. - 03 b PIC X(3) VALUE ALL 'B'. - 03 c. - 05 d PIC X(3) VALUE SPACES. - - 01 0SpecialTAGName PIC X(3) VALUE "abc". - - 01 employee. - 05 id PIC 9(1) value 1. - 05 name PIC X(10) value "Someone". - 05 dept PIC X(10) value "Marketing". - - PROCEDURE DIVISION. - XML GENERATE out - FROM rec - WITH XML-DECLARATION - NAME OF a IS 'alpha', d IS 'ABCDEF'; - TYPE OF a IS ATTRIBUTE - SUPPRESS WHEN SPACES - IF out <> '' & X'0A' - & 'BBB' - DISPLAY 'Test 1 failed: ' FUNCTION TRIM (out) - END-IF - - XML GENERATE out FROM d - IF out <> ' ' - DISPLAY 'Test 2 failed: ' FUNCTION TRIM (out) - END-IF - - XML GENERATE out FROM c, WITH ATTRIBUTES. - IF out <> '' - DISPLAY 'Test 3 failed: ' FUNCTION TRIM (out) - END-IF - - MOVE ALL 'A' TO a - MOVE ALL 'C' TO c - XML GENERATE out FROM rec, TYPE OF a IS CONTENT, - b IS CONTENT, d IS CONTENT - IF out <> 'AAABBBCCC' - DISPLAY 'Test 4 failed: ' FUNCTION TRIM (out) - END-IF - - XML GENERATE out FROM rec, TYPE OF a IS CONTENT, d IS CONTENT - IF out <> 'AAABBBCCC' - DISPLAY 'Test 5 failed: ' FUNCTION TRIM (out) - END-IF - - XML GENERATE out FROM c, NAMESPACE namespace-str, - NAMESPACE-PREFIX prefix-str - IF out <> ''- - 'CCC' - DISPLAY 'Test 6 failed: ' FUNCTION TRIM (out) - " " XML-CODE - END-IF - - MOVE SPACES TO namespace-str, prefix-str - XML GENERATE out FROM c, NAMESPACE namespace-str, - NAMESPACE-PREFIX prefix-str - IF out <> 'CCC' - DISPLAY 'Test 7 failed: ' FUNCTION TRIM (out) - END-IF - - MOVE ALL "&" TO d - XML GENERATE out FROM d - IF out <> '&&&' - DISPLAY 'Test 8 failed: ' FUNCTION TRIM (out) - END-IF - - *> Test the case of the id in the DATA DIVISION is preserved. - XML GENERATE out FROM 0specialtagname - IF out <> '<_0SpecialTAGName>abc' - DISPLAY 'Test 9 failed: ' FUNCTION TRIM (out) - END-IF - . - - *> Another test with mixed attributes and values - XML GENERATE out FROM EMPLOYEE TYPE OF ID IS ATTRIBUTE - IF out <> ''- - 'Someone'- - 'Marketing'- - '' - DISPLAY 'Test 10 failed: ' FUNCTION TRIM (out) - END-IF - . -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_ml.at:122: \$COMPILE -fnot-reserved=ID prog.cob" -at_fn_check_prepare_dynamic "$COMPILE -fnot-reserved=ID prog.cob" "run_ml.at:122" -( $at_check_trace; $COMPILE -fnot-reserved=ID prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_ml.at:122" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_ml.at:123: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_ml.at:123" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_ml.at:123" -$at_failed && at_fn_log_failure -$at_traceon; } - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_1043 -#AT_START_1044 -at_fn_group_banner 1044 'run_ml.at:127' \ - "XML GENERATE SUPPRESS" " " 4 -at_xfail=no -( - $as_echo "1044. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -$as_echo "run_ml.at:130" >"$at_check_line_file" -(test "$COB_HAS_XML2" = "no") \ - && at_fn_check_skip 77 "$at_srcdir/run_ml.at:130" - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 a. - 03 b PIC X(3) VALUE SPACES. - 03 c PIC X(3) VALUE SPACES. - - 01 p. - 03 q PIC 9(3) VALUE ZERO. - 03 r PIC X(3) VALUE "abc". - - 01 x. - 03 y. - 05 z PIC X VALUE SPACE. - - 01 out PIC X(100). - - PROCEDURE DIVISION. - XML GENERATE out FROM a SUPPRESS WHEN SPACES - IF out <> '' - DISPLAY 'Test 1 failed: ' out - END-IF - - XML GENERATE out FROM a SUPPRESS b WHEN SPACES - IF out <> ' ' - DISPLAY 'Test 2 failed: ' out - END-IF - - XML GENERATE out FROM a SUPPRESS EVERY NONNUMERIC WHEN SPACES - IF out <> '' - DISPLAY 'Test 3 failed: ' out - END-IF - - XML GENERATE out FROM p - WITH ATTRIBUTES - SUPPRESS EVERY ATTRIBUTE WHEN ZERO - IF out <> '

' - DISPLAY 'Test 4 failed: ' out - END-IF - - XML GENERATE out FROM a - SUPPRESS c WHEN LOW-VALUES, c WHEN SPACES, - c WHEN LOW-VALUES, - EVERY ELEMENT WHEN SPACES - IF out <> ' ' - DISPLAY 'Test 5 failed: ' out - END-IF - - MOVE HIGH-VALUES TO b - MOVE LOW-VALUES TO c - XML GENERATE out FROM a - SUPPRESS EVERY ELEMENT WHEN HIGH-VALUES OR LOW-VALUES - OR ZEROES OR SPACES - IF out <> '' - DISPLAY 'Test 6 failed: ' out - END-IF - - XML GENERATE out FROM x SUPPRESS z WHEN SPACE - IF out <> '' - DISPLAY 'Test 7 failed: ' out - END-IF - . -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_ml.at:199: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_ml.at:199" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_ml.at:199" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_ml.at:200: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_ml.at:200" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_ml.at:200" -$at_failed && at_fn_log_failure -$at_traceon; } - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_1044 -#AT_START_1045 -at_fn_group_banner 1045 'run_ml.at:204' \ - "XML GENERATE exceptions" " " 4 -at_xfail=no -( - $as_echo "1045. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -$as_echo "run_ml.at:207" >"$at_check_line_file" -(test "$COB_HAS_XML2" = "no") \ - && at_fn_check_skip 77 "$at_srcdir/run_ml.at:207" - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 normal-str PIC X(200). - - 01 valid-rec. - 03 a PIC XX VALUE "aa". - 03 b PIC XX VALUE "bb". - 01 short-str PIC X(5). - 01 xml-len PIC 99. - - 01 valid-namespace CONSTANT "http://www.w3.org/1999/xhtml". - 01 invalid-namespace CONSTANT X"00". - 01 invalid-prefix PIC XXX VALUE "#<>". - 01 invalid-content PIC X(3) VALUE X"8AFF00". - 01 count-in-too-small PIC 9. - - PROCEDURE DIVISION. - XML GENERATE short-str FROM valid-rec - COUNT IN xml-len - IF short-str <> " 42 - OR XML-CODE <> 400 - DISPLAY "Failed 1: " short-str " " xml-len " " XML-CODE - END-IF - - XML GENERATE normal-str FROM valid-rec - NAMESPACE invalid-namespace - IF XML-CODE <> 416 - DISPLAY "Failed 2: " FUNCTION TRIM (normal-str) - " " XML-CODE - END-IF - - XML GENERATE normal-str FROM invalid-content - IF normal-str <> '8aff00' - OR XML-CODE <> 417 - DISPLAY "Failed 3: " FUNCTION TRIM (normal-str) - " " XML-CODE - END-IF - - XML GENERATE normal-str FROM valid-rec - NAMESPACE "http://www.w3.org/1999/xhtml" - NAMESPACE-PREFIX invalid-prefix - IF XML-CODE <> 419 - DISPLAY "Failed 4: " FUNCTION TRIM (normal-str) - " " XML-CODE - END-IF - - XML GENERATE normal-str FROM valid-rec - ON EXCEPTION - DISPLAY "Failed 5: EXCEPTION " - FUNCTION TRIM (normal-str) - " " XML-CODE - END-DISPLAY - *> The END-DISPLAY is important! Otherwise the DISPLAY will - *> take the NOT ON EXCEPTION. - - NOT ON EXCEPTION - IF XML-CODE <> 0 - DISPLAY "Failed 5: NOT EXCEPTION " - FUNCTION TRIM (normal-str) - " " XML-CODE - END-IF - END-XML - - XML GENERATE short-str FROM valid-rec - NOT EXCEPTION - DISPLAY "Failed 6: NOT EXCEPTION " - FUNCTION TRIM (normal-str) - " " XML-CODE - END-DISPLAY - - EXCEPTION - IF XML-CODE <> 400 - DISPLAY "Failed 6: ON EXCEPTION " - FUNCTION TRIM (normal-str) - " " XML-CODE - END-IF - END-XML - . -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_ml.at:295: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_ml.at:295" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_ml.at:295" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_ml.at:296: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_ml.at:296" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_ml.at:296" -$at_failed && at_fn_log_failure -$at_traceon; } - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_1045 -#AT_START_1046 -at_fn_group_banner 1046 'run_ml.at:300' \ - "XML GENERATE record selection" " " 4 -at_xfail=no -( - $as_echo "1046. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -$as_echo "run_ml.at:303" >"$at_check_line_file" -(test "$COB_HAS_XML2" = "no") \ - && at_fn_check_skip 77 "$at_srcdir/run_ml.at:303" - -# TO-DO: Add support for generating OCCURS items. - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 a. - 03 b. - 05 c1 PIC X(3) VALUE "abc". - 05 c2 PIC 9(3) VALUE 0. - 03 d REDEFINES b. - 05 e PIC X(6). - 03 f PIC X OCCURS 3 VALUE "f". - - 66 h RENAMES c1 THRU c2. - - 01 out PIC X(60). - - PROCEDURE DIVISION. - *> XML GENERATE out FROM a - *> IF out <> 'abc0ff'- - *> 'f' - *> DISPLAY "Failed 1: " FUNCTION TRIM (out) - *> END-IF - - XML GENERATE out FROM d - IF out <> 'abc000' - DISPLAY "Failed 2: " FUNCTION TRIM (out) - END-IF - . - END PROGRAM prog. -_ATEOF - -{ set +x -$as_echo "$at_srcdir/run_ml.at:339: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_ml.at:339" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_ml.at:339" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_ml.at:340: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_ml.at:340" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_ml.at:340" -$at_failed && at_fn_log_failure -$at_traceon; } - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_1046 -#AT_START_1047 -at_fn_group_banner 1047 'run_ml.at:344' \ - "XML GENERATE trimming" " " 4 -at_xfail=no -( - $as_echo "1047. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -$as_echo "run_ml.at:347" >"$at_check_line_file" -(test "$COB_HAS_XML2" = "no") \ - && at_fn_check_skip 77 "$at_srcdir/run_ml.at:347" - -# TO-DO: Add support for IBM/COBOL 2002 edited floating point (e.g. PIC 9(3)E+99). - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 str PIC X(3) VALUE "ab". - 01 num-edited PIC 99.99 VALUE "01.00". - 01 leading-zeroes PIC 9(5) VALUE 5. - 01 decimal-num PIC 99V999 PACKED-DECIMAL VALUE 0.12. - 01 signed-decimal-num PIC S999 COMP-X VALUE -1. - 01 comp-5-item PIC 9(10) COMP-5 VALUE 5. - 01 index-item INDEX. - 01 float-short-item FLOAT-SHORT VALUE 100. - 01 float-long-item FLOAT-LONG VALUE 123.0E-10. - 01 just-item PIC X(10) JUST. - 01 integer-with-p PIC 999PPP VALUE 10000. - 01 decimal-with-p PIC VPP99 VALUE 0.0004. - - 01 out PIC X(300). - - PROCEDURE DIVISION. - XML GENERATE out FROM str - IF out <> 'ab' - DISPLAY "Failed 1: " FUNCTION TRIM (out) - END-IF - - XML GENERATE out FROM num-edited - IF out <> '01.00' - DISPLAY "Failed 2: " FUNCTION TRIM (out) - END-IF - - XML GENERATE out FROM leading-zeroes - IF out <> '5' - DISPLAY "Failed 3: " FUNCTION TRIM (out) - END-IF - - XML GENERATE out FROM decimal-num - IF out <> '0.120' - DISPLAY "Failed 4: " FUNCTION TRIM (out) - END-IF - - XML GENERATE out FROM signed-decimal-num - IF out <> '-1' - DISPLAY "Failed 5: " FUNCTION TRIM (out) - END-IF - - XML GENERATE out FROM comp-5-item - IF out <> '5' - DISPLAY "Failed 6: " FUNCTION TRIM (out) - END-IF - - SET index-item TO 500 - XML GENERATE out FROM index-item - IF out <> '500' - DISPLAY "Failed 7: " FUNCTION TRIM (out) - END-IF - - *> XML GENERATE out FROM float-short-item - *> IF out <> '1E+02' - *> DISPLAY "Failed 8: " FUNCTION TRIM (out) - *> END-IF - - *> XML GENERATE out FROM float-long-item - *> IF out <> '123E-10' - *> DISPLAY "Failed 9: " FUNCTION TRIM (out) - *> END-IF - - MOVE "blah " TO just-item - XML GENERATE out FROM just-item - IF out <> 'blah ' - DISPLAY "Failed 10: " FUNCTION TRIM (out) - END-IF - - XML GENERATE out FROM integer-with-p - IF out <> '10000' - DISPLAY "Failed 11: " FUNCTION TRIM (out) - END-IF - - XML GENERATE out FROM decimal-with-p - IF out <> '0.0004' - DISPLAY "Failed 12: " FUNCTION TRIM (out) - END-IF - . -_ATEOF - -{ set +x -$as_echo "$at_srcdir/run_ml.at:436: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_ml.at:436" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_ml.at:436" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_ml.at:437: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_ml.at:437" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_ml.at:437" -$at_failed && at_fn_log_failure -$at_traceon; } - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_1047 -#AT_START_1048 -at_fn_group_banner 1048 'run_ml.at:441' \ - "JSON GENERATE general" " " 4 -at_xfail=no -( - $as_echo "1048. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -$as_echo "run_ml.at:444" >"$at_check_line_file" -(test "$COB_HAS_CJSON" = "no") \ - && at_fn_check_skip 77 "$at_srcdir/run_ml.at:444" - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 out PIC X(200). - 01 rec. - 03 a PIC X(3) VALUE 'A'. - 03 b PIC X(3) VALUE ALL 'B'. - 03 c. - 05 d PIC X(3) VALUE SPACES. - - PROCEDURE DIVISION. - JSON GENERATE out - FROM rec - NAME OF a IS 'alpha', d IS 'ABCDEF' - SUPPRESS c - IF out <> '{"rec":{"alpha":"A","b":"BBB"}}' - DISPLAY 'Test 1 failed: ' FUNCTION TRIM (out) - END-IF - - JSON GENERATE out FROM d - IF out <> '{"d":" "}' - DISPLAY 'Test 2 failed: ' FUNCTION TRIM (out) - END-IF - - JSON GENERATE out FROM c - IF out <> '{"c":{"d":" "}}' - DISPLAY 'Test 3 failed: ' FUNCTION TRIM (out) - END-IF - - MOVE ALL QUOTES TO d - JSON GENERATE out FROM d - IF out <> '{"d":"\"\"\""}' - DISPLAY 'Test 4 failed: ' FUNCTION TRIM (out) - END-IF - . -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_ml.at:486: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_ml.at:486" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_ml.at:486" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_ml.at:487: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_ml.at:487" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_ml.at:487" -$at_failed && at_fn_log_failure -$at_traceon; } - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_1048 -#AT_START_1049 -at_fn_group_banner 1049 'run_ml.at:491' \ - "JSON GENERATE SUPPRESS" " " 4 -at_xfail=no -( - $as_echo "1049. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -$as_echo "run_ml.at:494" >"$at_check_line_file" -(test "$COB_HAS_CJSON" = "no") \ - && at_fn_check_skip 77 "$at_srcdir/run_ml.at:494" - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 a. - 03 b PIC X(3) VALUE SPACES. - 03 c PIC X(3) VALUE SPACES. - - 01 x. - 03 y. - 05 z PIC X VALUE SPACE. - - 01 out PIC X(100). - - PROCEDURE DIVISION. - JSON GENERATE out FROM a SUPPRESS b - IF out <> '{"a":{"c":" "}}' - DISPLAY 'Test 1 failed: ' out - END-IF - - JSON GENERATE out FROM x SUPPRESS z - IF out <> '{"x":{}}' - DISPLAY 'Test 2 failed: ' out - END-IF - . -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_ml.at:525: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_ml.at:525" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_ml.at:525" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_ml.at:526: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_ml.at:526" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_ml.at:526" -$at_failed && at_fn_log_failure -$at_traceon; } - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_1049 -#AT_START_1050 -at_fn_group_banner 1050 'run_ml.at:530' \ - "JSON GENERATE exceptions" " " 4 -at_xfail=no -( - $as_echo "1050. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -$as_echo "run_ml.at:533" >"$at_check_line_file" -(test "$COB_HAS_CJSON" = "no") \ - && at_fn_check_skip 77 "$at_srcdir/run_ml.at:533" - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 normal-str PIC X(200). - - 01 valid-rec. - 03 a PIC XX VALUE "aa". - 03 b PIC XX VALUE "bb". - 01 short-str PIC X(5). - 01 json-len PIC 99. - - PROCEDURE DIVISION. - JSON GENERATE short-str FROM valid-rec - COUNT IN json-len - IF short-str <> '{"val' - OR json-len <> 33 - OR JSON-CODE <> 1 - DISPLAY "Failed 1: " short-str " " json-len " " JSON-CODE - END-IF - - JSON GENERATE normal-str FROM valid-rec - ON EXCEPTION - DISPLAY "Failed 2: EXCEPTION " - FUNCTION TRIM (normal-str) - " " JSON-CODE - END-DISPLAY - - NOT ON EXCEPTION - IF JSON-CODE <> 0 - DISPLAY "Failed 2: NOT EXCEPTION " - FUNCTION TRIM (normal-str) - " " JSON-CODE - END-IF - END-JSON - - JSON GENERATE short-str FROM valid-rec - NOT EXCEPTION - DISPLAY "Failed 3: NOT EXCEPTION " - FUNCTION TRIM (normal-str) - " " JSON-CODE - END-DISPLAY - - EXCEPTION - IF JSON-CODE <> 1 - DISPLAY "Failed 3: ON EXCEPTION " - FUNCTION TRIM (normal-str) - " " JSON-CODE - END-IF - END-JSON - . -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_ml.at:590: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_ml.at:590" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_ml.at:590" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_ml.at:591: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_ml.at:591" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_ml.at:591" -$at_failed && at_fn_log_failure -$at_traceon; } - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_1050 -#AT_START_1051 -at_fn_group_banner 1051 'run_ml.at:595' \ - "JSON GENERATE record selection" " " 4 -at_xfail=no -( - $as_echo "1051. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -$as_echo "run_ml.at:598" >"$at_check_line_file" -(test "$COB_HAS_CJSON" = "no") \ - && at_fn_check_skip 77 "$at_srcdir/run_ml.at:598" - -# TO-DO: Add support for generating OCCURS items. - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 a. - 03 b. - 05 c1 PIC X(3) VALUE "abc". - 05 c2 PIC 9(3) VALUE 0. - 03 d REDEFINES b. - 05 e PIC X(6). - 03 f PIC X OCCURS 3 VALUE "f". - - 66 h RENAMES c1 THRU c2. - - 01 out PIC X(60). - - PROCEDURE DIVISION. - *> JSON GENERATE out FROM a - *> IF out <> 'abc0ff'- - *> 'f' - *> DISPLAY "Failed 1: " FUNCTION TRIM (out) - *> END-IF - - JSON GENERATE out FROM d - IF out <> '{"d":{"e":"abc000"}}' - DISPLAY "Failed 2: " FUNCTION TRIM (out) - END-IF - . - END PROGRAM prog. -_ATEOF - -{ set +x -$as_echo "$at_srcdir/run_ml.at:634: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_ml.at:634" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_ml.at:634" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_ml.at:635: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_ml.at:635" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_ml.at:635" -$at_failed && at_fn_log_failure -$at_traceon; } - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_1051 -#AT_START_1052 -at_fn_group_banner 1052 'run_ml.at:639' \ - "JSON GENERATE trimming" " " 4 -at_xfail=no -( - $as_echo "1052. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -$as_echo "run_ml.at:642" >"$at_check_line_file" -(test "$COB_HAS_CJSON" = "no") \ - && at_fn_check_skip 77 "$at_srcdir/run_ml.at:642" - -# TO-DO: Add support for IBM/COBOL 2002 edited floating point (e.g. PIC 9(3)E+99). - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 str PIC X(3) VALUE "ab". - 01 num-edited PIC 99.99 VALUE "01.00". - 01 leading-zeroes PIC 9(5) VALUE 5. - 01 decimal-num PIC 99V999 PACKED-DECIMAL VALUE 0.12. - 01 signed-decimal-num PIC S999 COMP-X VALUE -1. - 01 comp-5-item PIC 9(10) COMP-5 VALUE 5. - 01 index-item INDEX. - 01 float-short-item FLOAT-SHORT VALUE 100. - 01 float-long-item FLOAT-LONG VALUE 123.0E-10. - 01 just-item PIC X(10) JUST. - 01 integer-with-p PIC 999PPP VALUE 10000. - 01 decimal-with-p PIC VPP99 VALUE 0.0004. - - 01 out PIC X(300). - - PROCEDURE DIVISION. - JSON GENERATE out FROM str - IF out <> '{"str":"ab"}' - DISPLAY "Failed 1: " FUNCTION TRIM (out) - END-IF - - JSON GENERATE out FROM num-edited - IF out <> '{"num-edited":"01.00"}' - DISPLAY "Failed 2: " FUNCTION TRIM (out) - END-IF - - JSON GENERATE out FROM leading-zeroes - IF out <> '{"leading-zeroes":5}' - DISPLAY "Failed 3: " FUNCTION TRIM (out) - END-IF - - JSON GENERATE out FROM decimal-num - IF out <> '{"decimal-num":0.120}' - DISPLAY "Failed 4: " FUNCTION TRIM (out) - END-IF - - JSON GENERATE out FROM signed-decimal-num - IF out <> '{"signed-decimal-num":-1}' - DISPLAY "Failed 5: " FUNCTION TRIM (out) - END-IF - - JSON GENERATE out FROM comp-5-item - IF out <> '{"comp-5-item":5}' - DISPLAY "Failed 6: " FUNCTION TRIM (out) - END-IF - - SET index-item TO 500 - JSON GENERATE out FROM index-item - IF out <> '{"index-item":500}' - DISPLAY "Failed 7: " FUNCTION TRIM (out) - END-IF - - *> JSON GENERATE out FROM float-short-item - *> IF out <> '{"float-short-item":1E+02}' - *> DISPLAY "Failed 8: " FUNCTION TRIM (out) - *> END-IF - - *> JSON GENERATE out FROM float-long-item - *> IF out <> '{"float-long-item":123E-10}' - *> DISPLAY "Failed 9: " FUNCTION TRIM (out) - *> END-IF - - MOVE "blah " TO just-item - JSON GENERATE out FROM just-item - IF out <> '{"just-item":"blah "}' - DISPLAY "Failed 10: " FUNCTION TRIM (out) - END-IF - - JSON GENERATE out FROM integer-with-p - IF out <> '{"integer-with-p":10000}' - DISPLAY "Failed 11: " FUNCTION TRIM (out) - END-IF - - JSON GENERATE out FROM decimal-with-p - IF out <> '{"decimal-with-p":0.0004}' - DISPLAY "Failed 12: " FUNCTION TRIM (out) - END-IF - . -_ATEOF - -{ set +x -$as_echo "$at_srcdir/run_ml.at:731: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_ml.at:731" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_ml.at:731" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_ml.at:732: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "run_ml.at:732" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_ml.at:732" -$at_failed && at_fn_log_failure -$at_traceon; } - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_1052 -#AT_START_1053 -at_fn_group_banner 1053 'data_binary.at:23' \ - "BINARY: 2-4-8 big-endian" " " 5 -at_xfail=no -( - $as_echo "1053. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >dump.c <<'_ATEOF' - -#include -#include - -COB_EXT_EXPORT int -dump (unsigned char *data) -{ - int i; - for (i = 0; i < 8; i++) - printf ("%02x", data[i]); - puts (""); - return 0; -} -_ATEOF - - -sed -e 's/@USAGE@/BINARY/' "${TEMPLATE}/numeric-dump.cob" > prog.cob - -{ set +x -$as_echo "$at_srcdir/data_binary.at:43: \$COMPILE_MODULE dump.c" -at_fn_check_prepare_dynamic "$COMPILE_MODULE dump.c" "data_binary.at:43" -( $at_check_trace; $COMPILE_MODULE dump.c -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/data_binary.at:43" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/data_binary.at:44: \$COMPILE -fbinary-size=2-4-8 \\ - -fbinary-byteorder=big-endian prog.cob" -at_fn_check_prepare_notrace 'an embedded newline' "data_binary.at:44" -( $at_check_trace; $COMPILE -fbinary-size=2-4-8 \ - -fbinary-byteorder=big-endian prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/data_binary.at:44" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/data_binary.at:46: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "data_binary.at:46" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo "0001202020202020 -000c202020202020 -007b202020202020 -04d2202020202020 -0000303920202020 -0001e24020202020 -0012d68720202020 -00bc614e20202020 -075bcd1520202020 -00000000499602d2 -00000002dfdc1c35 -0000001cbe991a14 -0000011f71fb04cb -00000b3a73ce2ff2 -00007048860ddf79 -000462d53c8abac0 -002bdc545d6b4b87 -01b69b4ba630f34e -ffff202020202020 -fff4202020202020 -ff85202020202020 -fb2e202020202020 -ffffcfc720202020 -fffe1dc020202020 -ffed297920202020 -ff439eb220202020 -f8a432eb20202020 -ffffffffb669fd2e -fffffffd2023e3cb -ffffffe34166e5ec -fffffee08e04fb35 -fffff4c58c31d00e -ffff8fb779f22087 -fffb9d2ac3754540 -ffd423aba294b479 -fe4964b459cf0cb2 -0000202020202020 -0000202020202020 -0000202020202020 -0000202020202020 -0000000020202020 -0000000020202020 -0000000020202020 -0000000020202020 -0000000020202020 -0000000000000000 -0000000000000000 -0000000000000000 -0000000000000000 -0000000000000000 -0000000000000000 -0000000000000000 -0000000000000000 -0000000000000000 -0000202020202020 -0000202020202020 -0000202020202020 -0000202020202020 -0000000020202020 -0000000020202020 -0000000020202020 -0000000020202020 -0000000020202020 -0000000000000000 -0000000000000000 -0000000000000000 -0000000000000000 -0000000000000000 -0000000000000000 -0000000000000000 -0000000000000000 -0000000000000000 -0000202020202020 -0000202020202020 -0000202020202020 -0000202020202020 -0000000020202020 -0000000020202020 -0000000020202020 -0000000020202020 -0000000020202020 -0000000000000000 -0000000000000000 -0000000000000000 -0000000000000000 -0000000000000000 -0000000000000000 -0000000000000000 -0000000000000000 -0000000000000000 -0000202020202020 -0000202020202020 -0000202020202020 -0000202020202020 -0000000020202020 -0000000020202020 -0000000020202020 -0000000020202020 -0000000020202020 -0000000000000000 -0000000000000000 -0000000000000000 -0000000000000000 -0000000000000000 -0000000000000000 -0000000000000000 -0000000000000000 -0000000000000000 -" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/data_binary.at:46" -$at_failed && at_fn_log_failure -$at_traceon; } - - -sed -e 's/@USAGE@/BINARY/' "${TEMPLATE}/numeric-display.cob" > prog.cob - -{ set +x -$as_echo "$at_srcdir/data_binary.at:159: \$COMPILE -fbinary-size=2-4-8 \\ - -fbinary-byteorder=big-endian prog.cob -o prog2" -at_fn_check_prepare_notrace 'an embedded newline' "data_binary.at:159" -( $at_check_trace; $COMPILE -fbinary-size=2-4-8 \ - -fbinary-byteorder=big-endian prog.cob -o prog2 -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/data_binary.at:159" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/data_binary.at:161: \$COBCRUN_DIRECT ./prog2" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog2" "data_binary.at:161" -( $at_check_trace; $COBCRUN_DIRECT ./prog2 -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo "1 -12 -123 -1234 -12345 -123456 -1234567 -12345678 -123456789 -1234567890 -12345678901 -123456789012 -1234567890123 -12345678901234 -123456789012345 -1234567890123456 -12345678901234567 -123456789012345678 --1 --12 --123 --1234 --12345 --123456 --1234567 --12345678 --123456789 --1234567890 --12345678901 --123456789012 --1234567890123 --12345678901234 --123456789012345 --1234567890123456 --12345678901234567 --123456789012345678 -" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/data_binary.at:161" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_1053 -#AT_START_1054 -at_fn_group_banner 1054 'data_binary.at:205' \ - "BINARY: 2-4-8 native" " " 5 -at_xfail=no -( - $as_echo "1054. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -if test "x$COB_BIGENDIAN" = "xyes"; then -{ set +x -$as_echo "$at_srcdir/data_binary.at:209: true" -at_fn_check_prepare_trace "data_binary.at:209" -( $at_check_trace; true -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/data_binary.at:209" -$at_failed && at_fn_log_failure -$at_traceon; } - -else - - -cat >dump.c <<'_ATEOF' - -#include -#include - -COB_EXT_EXPORT int -dump (unsigned char *data) -{ - int i; - for (i = 0; i < 8; i++) - printf ("%02x", data[i]); - puts (""); - return 0; -} -_ATEOF - - -sed -e 's/@USAGE@/BINARY/' "${TEMPLATE}/numeric-dump.cob" > prog.cob - -{ set +x -$as_echo "$at_srcdir/data_binary.at:230: \$COMPILE_MODULE dump.c" -at_fn_check_prepare_dynamic "$COMPILE_MODULE dump.c" "data_binary.at:230" -( $at_check_trace; $COMPILE_MODULE dump.c -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/data_binary.at:230" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/data_binary.at:231: \$COMPILE -fbinary-size=2-4-8 \\ - -fbinary-byteorder=native prog.cob" -at_fn_check_prepare_notrace 'an embedded newline' "data_binary.at:231" -( $at_check_trace; $COMPILE -fbinary-size=2-4-8 \ - -fbinary-byteorder=native prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/data_binary.at:231" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/data_binary.at:233: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "data_binary.at:233" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo "0100202020202020 -0c00202020202020 -7b00202020202020 -d204202020202020 -3930000020202020 -40e2010020202020 -87d6120020202020 -4e61bc0020202020 -15cd5b0720202020 -d202964900000000 -351cdcdf02000000 -141a99be1c000000 -cb04fb711f010000 -f22fce733a0b0000 -79df0d8648700000 -c0ba8a3cd5620400 -874b6b5d54dc2b00 -4ef330a64b9bb601 -ffff202020202020 -f4ff202020202020 -85ff202020202020 -2efb202020202020 -c7cfffff20202020 -c01dfeff20202020 -7929edff20202020 -b29e43ff20202020 -eb32a4f820202020 -2efd69b6ffffffff -cbe32320fdffffff -ece56641e3ffffff -35fb048ee0feffff -0ed0318cc5f4ffff -8720f279b78fffff -404575c32a9dfbff -79b494a2ab23d4ff -b20ccf59b46449fe -0000202020202020 -0000202020202020 -0000202020202020 -0000202020202020 -0000000020202020 -0000000020202020 -0000000020202020 -0000000020202020 -0000000020202020 -0000000000000000 -0000000000000000 -0000000000000000 -0000000000000000 -0000000000000000 -0000000000000000 -0000000000000000 -0000000000000000 -0000000000000000 -0000202020202020 -0000202020202020 -0000202020202020 -0000202020202020 -0000000020202020 -0000000020202020 -0000000020202020 -0000000020202020 -0000000020202020 -0000000000000000 -0000000000000000 -0000000000000000 -0000000000000000 -0000000000000000 -0000000000000000 -0000000000000000 -0000000000000000 -0000000000000000 -0000202020202020 -0000202020202020 -0000202020202020 -0000202020202020 -0000000020202020 -0000000020202020 -0000000020202020 -0000000020202020 -0000000020202020 -0000000000000000 -0000000000000000 -0000000000000000 -0000000000000000 -0000000000000000 -0000000000000000 -0000000000000000 -0000000000000000 -0000000000000000 -0000202020202020 -0000202020202020 -0000202020202020 -0000202020202020 -0000000020202020 -0000000020202020 -0000000020202020 -0000000020202020 -0000000020202020 -0000000000000000 -0000000000000000 -0000000000000000 -0000000000000000 -0000000000000000 -0000000000000000 -0000000000000000 -0000000000000000 -0000000000000000 -" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/data_binary.at:233" -$at_failed && at_fn_log_failure -$at_traceon; } - - -sed -e 's/@USAGE@/BINARY/' "${TEMPLATE}/numeric-display.cob" > prog.cob - -{ set +x -$as_echo "$at_srcdir/data_binary.at:346: \$COMPILE -fbinary-size=2-4-8 \\ - -fbinary-byteorder=native prog.cob -o prog2" -at_fn_check_prepare_notrace 'an embedded newline' "data_binary.at:346" -( $at_check_trace; $COMPILE -fbinary-size=2-4-8 \ - -fbinary-byteorder=native prog.cob -o prog2 -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/data_binary.at:346" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/data_binary.at:348: \$COBCRUN_DIRECT ./prog2" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog2" "data_binary.at:348" -( $at_check_trace; $COBCRUN_DIRECT ./prog2 -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo "1 -12 -123 -1234 -12345 -123456 -1234567 -12345678 -123456789 -1234567890 -12345678901 -123456789012 -1234567890123 -12345678901234 -123456789012345 -1234567890123456 -12345678901234567 -123456789012345678 --1 --12 --123 --1234 --12345 --123456 --1234567 --12345678 --123456789 --1234567890 --12345678901 --123456789012 --1234567890123 --12345678901234 --123456789012345 --1234567890123456 --12345678901234567 --123456789012345678 -" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/data_binary.at:348" -$at_failed && at_fn_log_failure -$at_traceon; } - -fi - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_1054 -#AT_START_1055 -at_fn_group_banner 1055 'data_binary.at:393' \ - "BINARY: 1-2-4-8 big-endian" " " 5 -at_xfail=no -( - $as_echo "1055. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >dump.c <<'_ATEOF' - -#include -#include - -COB_EXT_EXPORT int -dump (unsigned char *data) -{ - int i; - for (i = 0; i < 8; i++) - printf ("%02x", data[i]); - puts (""); - return 0; -} -_ATEOF - - -sed -e 's/@USAGE@/BINARY/' "${TEMPLATE}/numeric-dump.cob" > prog.cob - -{ set +x -$as_echo "$at_srcdir/data_binary.at:413: \$COMPILE_MODULE dump.c" -at_fn_check_prepare_dynamic "$COMPILE_MODULE dump.c" "data_binary.at:413" -( $at_check_trace; $COMPILE_MODULE dump.c -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/data_binary.at:413" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/data_binary.at:414: \$COMPILE -fbinary-size=1-2-4-8 \\ - -fbinary-byteorder=big-endian prog.cob" -at_fn_check_prepare_notrace 'an embedded newline' "data_binary.at:414" -( $at_check_trace; $COMPILE -fbinary-size=1-2-4-8 \ - -fbinary-byteorder=big-endian prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/data_binary.at:414" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/data_binary.at:416: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "data_binary.at:416" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo "0120202020202020 -0c20202020202020 -007b202020202020 -04d2202020202020 -0000303920202020 -0001e24020202020 -0012d68720202020 -00bc614e20202020 -075bcd1520202020 -00000000499602d2 -00000002dfdc1c35 -0000001cbe991a14 -0000011f71fb04cb -00000b3a73ce2ff2 -00007048860ddf79 -000462d53c8abac0 -002bdc545d6b4b87 -01b69b4ba630f34e -ff20202020202020 -f420202020202020 -ff85202020202020 -fb2e202020202020 -ffffcfc720202020 -fffe1dc020202020 -ffed297920202020 -ff439eb220202020 -f8a432eb20202020 -ffffffffb669fd2e -fffffffd2023e3cb -ffffffe34166e5ec -fffffee08e04fb35 -fffff4c58c31d00e -ffff8fb779f22087 -fffb9d2ac3754540 -ffd423aba294b479 -fe4964b459cf0cb2 -0020202020202020 -0020202020202020 -0000202020202020 -0000202020202020 -0000000020202020 -0000000020202020 -0000000020202020 -0000000020202020 -0000000020202020 -0000000000000000 -0000000000000000 -0000000000000000 -0000000000000000 -0000000000000000 -0000000000000000 -0000000000000000 -0000000000000000 -0000000000000000 -0020202020202020 -0020202020202020 -0000202020202020 -0000202020202020 -0000000020202020 -0000000020202020 -0000000020202020 -0000000020202020 -0000000020202020 -0000000000000000 -0000000000000000 -0000000000000000 -0000000000000000 -0000000000000000 -0000000000000000 -0000000000000000 -0000000000000000 -0000000000000000 -0020202020202020 -0020202020202020 -0000202020202020 -0000202020202020 -0000000020202020 -0000000020202020 -0000000020202020 -0000000020202020 -0000000020202020 -0000000000000000 -0000000000000000 -0000000000000000 -0000000000000000 -0000000000000000 -0000000000000000 -0000000000000000 -0000000000000000 -0000000000000000 -0020202020202020 -0020202020202020 -0000202020202020 -0000202020202020 -0000000020202020 -0000000020202020 -0000000020202020 -0000000020202020 -0000000020202020 -0000000000000000 -0000000000000000 -0000000000000000 -0000000000000000 -0000000000000000 -0000000000000000 -0000000000000000 -0000000000000000 -0000000000000000 -" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/data_binary.at:416" -$at_failed && at_fn_log_failure -$at_traceon; } - - -sed -e 's/@USAGE@/BINARY/' "${TEMPLATE}/numeric-display.cob" > prog.cob - -{ set +x -$as_echo "$at_srcdir/data_binary.at:529: \$COMPILE -fbinary-size=1-2-4-8 \\ - -fbinary-byteorder=big-endian prog.cob -o prog2" -at_fn_check_prepare_notrace 'an embedded newline' "data_binary.at:529" -( $at_check_trace; $COMPILE -fbinary-size=1-2-4-8 \ - -fbinary-byteorder=big-endian prog.cob -o prog2 -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/data_binary.at:529" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/data_binary.at:531: \$COBCRUN_DIRECT ./prog2" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog2" "data_binary.at:531" -( $at_check_trace; $COBCRUN_DIRECT ./prog2 -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo "1 -12 -123 -1234 -12345 -123456 -1234567 -12345678 -123456789 -1234567890 -12345678901 -123456789012 -1234567890123 -12345678901234 -123456789012345 -1234567890123456 -12345678901234567 -123456789012345678 --1 --12 --123 --1234 --12345 --123456 --1234567 --12345678 --123456789 --1234567890 --12345678901 --123456789012 --1234567890123 --12345678901234 --123456789012345 --1234567890123456 --12345678901234567 --123456789012345678 -" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/data_binary.at:531" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_1055 -#AT_START_1056 -at_fn_group_banner 1056 'data_binary.at:575' \ - "BINARY: 1-2-4-8 native" " " 5 -at_xfail=no -( - $as_echo "1056. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -if test "x$COB_BIGENDIAN" = "xyes"; then -{ set +x -$as_echo "$at_srcdir/data_binary.at:579: true" -at_fn_check_prepare_trace "data_binary.at:579" -( $at_check_trace; true -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/data_binary.at:579" -$at_failed && at_fn_log_failure -$at_traceon; } - -else - -cat >dump.c <<'_ATEOF' - -#include -#include - -COB_EXT_EXPORT int -dump (unsigned char *data) -{ - int i; - for (i = 0; i < 8; i++) - printf ("%02x", data[i]); - puts (""); - return 0; -} -_ATEOF - - -sed -e 's/@USAGE@/BINARY/' "${TEMPLATE}/numeric-dump.cob" > prog.cob - -{ set +x -$as_echo "$at_srcdir/data_binary.at:599: \$COMPILE_MODULE dump.c" -at_fn_check_prepare_dynamic "$COMPILE_MODULE dump.c" "data_binary.at:599" -( $at_check_trace; $COMPILE_MODULE dump.c -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/data_binary.at:599" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/data_binary.at:600: \$COMPILE -fbinary-size=1-2-4-8 \\ - -fbinary-byteorder=native prog.cob" -at_fn_check_prepare_notrace 'an embedded newline' "data_binary.at:600" -( $at_check_trace; $COMPILE -fbinary-size=1-2-4-8 \ - -fbinary-byteorder=native prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/data_binary.at:600" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/data_binary.at:602: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "data_binary.at:602" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo "0120202020202020 -0c20202020202020 -7b00202020202020 -d204202020202020 -3930000020202020 -40e2010020202020 -87d6120020202020 -4e61bc0020202020 -15cd5b0720202020 -d202964900000000 -351cdcdf02000000 -141a99be1c000000 -cb04fb711f010000 -f22fce733a0b0000 -79df0d8648700000 -c0ba8a3cd5620400 -874b6b5d54dc2b00 -4ef330a64b9bb601 -ff20202020202020 -f420202020202020 -85ff202020202020 -2efb202020202020 -c7cfffff20202020 -c01dfeff20202020 -7929edff20202020 -b29e43ff20202020 -eb32a4f820202020 -2efd69b6ffffffff -cbe32320fdffffff -ece56641e3ffffff -35fb048ee0feffff -0ed0318cc5f4ffff -8720f279b78fffff -404575c32a9dfbff -79b494a2ab23d4ff -b20ccf59b46449fe -0020202020202020 -0020202020202020 -0000202020202020 -0000202020202020 -0000000020202020 -0000000020202020 -0000000020202020 -0000000020202020 -0000000020202020 -0000000000000000 -0000000000000000 -0000000000000000 -0000000000000000 -0000000000000000 -0000000000000000 -0000000000000000 -0000000000000000 -0000000000000000 -0020202020202020 -0020202020202020 -0000202020202020 -0000202020202020 -0000000020202020 -0000000020202020 -0000000020202020 -0000000020202020 -0000000020202020 -0000000000000000 -0000000000000000 -0000000000000000 -0000000000000000 -0000000000000000 -0000000000000000 -0000000000000000 -0000000000000000 -0000000000000000 -0020202020202020 -0020202020202020 -0000202020202020 -0000202020202020 -0000000020202020 -0000000020202020 -0000000020202020 -0000000020202020 -0000000020202020 -0000000000000000 -0000000000000000 -0000000000000000 -0000000000000000 -0000000000000000 -0000000000000000 -0000000000000000 -0000000000000000 -0000000000000000 -0020202020202020 -0020202020202020 -0000202020202020 -0000202020202020 -0000000020202020 -0000000020202020 -0000000020202020 -0000000020202020 -0000000020202020 -0000000000000000 -0000000000000000 -0000000000000000 -0000000000000000 -0000000000000000 -0000000000000000 -0000000000000000 -0000000000000000 -0000000000000000 -" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/data_binary.at:602" -$at_failed && at_fn_log_failure -$at_traceon; } - - -sed -e 's/@USAGE@/BINARY/' "${TEMPLATE}/numeric-display.cob" > prog.cob - -{ set +x -$as_echo "$at_srcdir/data_binary.at:715: \$COMPILE -fbinary-size=1-2-4-8 \\ - -fbinary-byteorder=native prog.cob -o prog2" -at_fn_check_prepare_notrace 'an embedded newline' "data_binary.at:715" -( $at_check_trace; $COMPILE -fbinary-size=1-2-4-8 \ - -fbinary-byteorder=native prog.cob -o prog2 -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/data_binary.at:715" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/data_binary.at:717: \$COBCRUN_DIRECT ./prog2" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog2" "data_binary.at:717" -( $at_check_trace; $COBCRUN_DIRECT ./prog2 -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo "1 -12 -123 -1234 -12345 -123456 -1234567 -12345678 -123456789 -1234567890 -12345678901 -123456789012 -1234567890123 -12345678901234 -123456789012345 -1234567890123456 -12345678901234567 -123456789012345678 --1 --12 --123 --1234 --12345 --123456 --1234567 --12345678 --123456789 --1234567890 --12345678901 --123456789012 --1234567890123 --12345678901234 --123456789012345 --1234567890123456 --12345678901234567 --123456789012345678 -" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/data_binary.at:717" -$at_failed && at_fn_log_failure -$at_traceon; } - - -fi - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_1056 -#AT_START_1057 -at_fn_group_banner 1057 'data_binary.at:763' \ - "BINARY: 1--8 big-endian" " " 5 -at_xfail=no -( - $as_echo "1057. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >dump.c <<'_ATEOF' - -#include -#include - -COB_EXT_EXPORT int -dump (unsigned char *data) -{ - int i; - for (i = 0; i < 8; i++) - printf ("%02x", data[i]); - puts (""); - return 0; -} -_ATEOF - - -sed -e 's/@USAGE@/BINARY/' "${TEMPLATE}/numeric-dump.cob" > prog.cob - -{ set +x -$as_echo "$at_srcdir/data_binary.at:783: \$COMPILE_MODULE dump.c" -at_fn_check_prepare_dynamic "$COMPILE_MODULE dump.c" "data_binary.at:783" -( $at_check_trace; $COMPILE_MODULE dump.c -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/data_binary.at:783" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/data_binary.at:784: \$COMPILE -fbinary-size=1--8 \\ - -fbinary-byteorder=big-endian prog.cob" -at_fn_check_prepare_notrace 'an embedded newline' "data_binary.at:784" -( $at_check_trace; $COMPILE -fbinary-size=1--8 \ - -fbinary-byteorder=big-endian prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/data_binary.at:784" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/data_binary.at:786: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "data_binary.at:786" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo "0120202020202020 -0c20202020202020 -007b202020202020 -04d2202020202020 -0030392020202020 -01e2402020202020 -12d6872020202020 -00bc614e20202020 -075bcd1520202020 -00499602d2202020 -02dfdc1c35202020 -1cbe991a14202020 -011f71fb04cb2020 -0b3a73ce2ff22020 -007048860ddf7920 -0462d53c8abac020 -002bdc545d6b4b87 -01b69b4ba630f34e -ff20202020202020 -f420202020202020 -ff85202020202020 -fb2e202020202020 -ffcfc72020202020 -fe1dc02020202020 -ffed297920202020 -ff439eb220202020 -f8a432eb20202020 -ffb669fd2e202020 -fd2023e3cb202020 -ffe34166e5ec2020 -fee08e04fb352020 -f4c58c31d00e2020 -ff8fb779f2208720 -fb9d2ac375454020 -ffd423aba294b479 -fe4964b459cf0cb2 -0020202020202020 -0020202020202020 -0000202020202020 -0000202020202020 -0000002020202020 -0000002020202020 -0000002020202020 -0000000020202020 -0000000020202020 -0000000000202020 -0000000000202020 -0000000000202020 -0000000000002020 -0000000000002020 -0000000000000020 -0000000000000020 -0000000000000000 -0000000000000000 -0020202020202020 -0020202020202020 -0000202020202020 -0000202020202020 -0000002020202020 -0000002020202020 -0000000020202020 -0000000020202020 -0000000020202020 -0000000000202020 -0000000000202020 -0000000000002020 -0000000000002020 -0000000000002020 -0000000000000020 -0000000000000020 -0000000000000000 -0000000000000000 -0020202020202020 -0020202020202020 -0000202020202020 -0000202020202020 -0000002020202020 -0000002020202020 -0000002020202020 -0000000020202020 -0000000020202020 -0000000000202020 -0000000000202020 -0000000000202020 -0000000000002020 -0000000000002020 -0000000000000020 -0000000000000020 -0000000000000000 -0000000000000000 -0020202020202020 -0020202020202020 -0000202020202020 -0000202020202020 -0000002020202020 -0000002020202020 -0000000020202020 -0000000020202020 -0000000020202020 -0000000000202020 -0000000000202020 -0000000000002020 -0000000000002020 -0000000000002020 -0000000000000020 -0000000000000020 -0000000000000000 -0000000000000000 -" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/data_binary.at:786" -$at_failed && at_fn_log_failure -$at_traceon; } - - -sed -e 's/@USAGE@/BINARY/' "${TEMPLATE}/numeric-display.cob" > prog.cob - -{ set +x -$as_echo "$at_srcdir/data_binary.at:899: \$COMPILE -fbinary-size=1--8 \\ - -fbinary-byteorder=big-endian prog.cob -o prog2" -at_fn_check_prepare_notrace 'an embedded newline' "data_binary.at:899" -( $at_check_trace; $COMPILE -fbinary-size=1--8 \ - -fbinary-byteorder=big-endian prog.cob -o prog2 -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/data_binary.at:899" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/data_binary.at:901: \$COBCRUN_DIRECT ./prog2" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog2" "data_binary.at:901" -( $at_check_trace; $COBCRUN_DIRECT ./prog2 -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo "1 -12 -123 -1234 -12345 -123456 -1234567 -12345678 -123456789 -1234567890 -12345678901 -123456789012 -1234567890123 -12345678901234 -123456789012345 -1234567890123456 -12345678901234567 -123456789012345678 --1 --12 --123 --1234 --12345 --123456 --1234567 --12345678 --123456789 --1234567890 --12345678901 --123456789012 --1234567890123 --12345678901234 --123456789012345 --1234567890123456 --12345678901234567 --123456789012345678 -" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/data_binary.at:901" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_1057 -#AT_START_1058 -at_fn_group_banner 1058 'data_binary.at:945' \ - "BINARY: 1--8 native" " " 5 -at_xfail=no -( - $as_echo "1058. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -if test "x$COB_BIGENDIAN" = "xyes"; then -{ set +x -$as_echo "$at_srcdir/data_binary.at:949: true" -at_fn_check_prepare_trace "data_binary.at:949" -( $at_check_trace; true -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/data_binary.at:949" -$at_failed && at_fn_log_failure -$at_traceon; } - -else - -cat >dump.c <<'_ATEOF' - -#include -#include - -COB_EXT_EXPORT int -dump (unsigned char *data) -{ - int i; - for (i = 0; i < 8; i++) - printf ("%02x", data[i]); - puts (""); - return 0; -} -_ATEOF - - -sed -e 's/@USAGE@/BINARY/' "${TEMPLATE}/numeric-dump.cob" > prog.cob - -{ set +x -$as_echo "$at_srcdir/data_binary.at:969: \$COMPILE_MODULE dump.c" -at_fn_check_prepare_dynamic "$COMPILE_MODULE dump.c" "data_binary.at:969" -( $at_check_trace; $COMPILE_MODULE dump.c -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/data_binary.at:969" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/data_binary.at:970: \$COMPILE -fbinary-size=1--8 \\ - -fbinary-byteorder=native prog.cob" -at_fn_check_prepare_notrace 'an embedded newline' "data_binary.at:970" -( $at_check_trace; $COMPILE -fbinary-size=1--8 \ - -fbinary-byteorder=native prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/data_binary.at:970" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/data_binary.at:972: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "data_binary.at:972" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo "0120202020202020 -0c20202020202020 -7b00202020202020 -d204202020202020 -3930002020202020 -40e2012020202020 -87d6122020202020 -4e61bc0020202020 -15cd5b0720202020 -d202964900202020 -351cdcdf02202020 -141a99be1c202020 -cb04fb711f012020 -f22fce733a0b2020 -79df0d8648700020 -c0ba8a3cd5620420 -874b6b5d54dc2b00 -4ef330a64b9bb601 -ff20202020202020 -f420202020202020 -85ff202020202020 -2efb202020202020 -c7cfff2020202020 -c01dfe2020202020 -7929edff20202020 -b29e43ff20202020 -eb32a4f820202020 -2efd69b6ff202020 -cbe32320fd202020 -ece56641e3ff2020 -35fb048ee0fe2020 -0ed0318cc5f42020 -8720f279b78fff20 -404575c32a9dfb20 -79b494a2ab23d4ff -b20ccf59b46449fe -0020202020202020 -0020202020202020 -0000202020202020 -0000202020202020 -0000002020202020 -0000002020202020 -0000002020202020 -0000000020202020 -0000000020202020 -0000000000202020 -0000000000202020 -0000000000202020 -0000000000002020 -0000000000002020 -0000000000000020 -0000000000000020 -0000000000000000 -0000000000000000 -0020202020202020 -0020202020202020 -0000202020202020 -0000202020202020 -0000002020202020 -0000002020202020 -0000000020202020 -0000000020202020 -0000000020202020 -0000000000202020 -0000000000202020 -0000000000002020 -0000000000002020 -0000000000002020 -0000000000000020 -0000000000000020 -0000000000000000 -0000000000000000 -0020202020202020 -0020202020202020 -0000202020202020 -0000202020202020 -0000002020202020 -0000002020202020 -0000002020202020 -0000000020202020 -0000000020202020 -0000000000202020 -0000000000202020 -0000000000202020 -0000000000002020 -0000000000002020 -0000000000000020 -0000000000000020 -0000000000000000 -0000000000000000 -0020202020202020 -0020202020202020 -0000202020202020 -0000202020202020 -0000002020202020 -0000002020202020 -0000000020202020 -0000000020202020 -0000000020202020 -0000000000202020 -0000000000202020 -0000000000002020 -0000000000002020 -0000000000002020 -0000000000000020 -0000000000000020 -0000000000000000 -0000000000000000 -" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/data_binary.at:972" -$at_failed && at_fn_log_failure -$at_traceon; } - - -sed -e 's/@USAGE@/BINARY/' "${TEMPLATE}/numeric-display.cob" > prog.cob - -{ set +x -$as_echo "$at_srcdir/data_binary.at:1085: \$COMPILE -fbinary-size=1--8 \\ - -fbinary-byteorder=native prog.cob -o prog2" -at_fn_check_prepare_notrace 'an embedded newline' "data_binary.at:1085" -( $at_check_trace; $COMPILE -fbinary-size=1--8 \ - -fbinary-byteorder=native prog.cob -o prog2 -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/data_binary.at:1085" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/data_binary.at:1087: \$COBCRUN_DIRECT ./prog2" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog2" "data_binary.at:1087" -( $at_check_trace; $COBCRUN_DIRECT ./prog2 -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo "1 -12 -123 -1234 -12345 -123456 -1234567 -12345678 -123456789 -1234567890 -12345678901 -123456789012 -1234567890123 -12345678901234 -123456789012345 -1234567890123456 -12345678901234567 -123456789012345678 --1 --12 --123 --1234 --12345 --123456 --1234567 --12345678 --123456789 --1234567890 --12345678901 --123456789012 --1234567890123 --12345678901234 --123456789012345 --1234567890123456 --12345678901234567 --123456789012345678 -" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/data_binary.at:1087" -$at_failed && at_fn_log_failure -$at_traceon; } - - -fi - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_1058 -#AT_START_1059 -at_fn_group_banner 1059 'data_binary.at:1133' \ - "BINARY: full-print" " " 5 -at_xfail=no -( - $as_echo "1059. $at_setup_line: testing $at_desc ..." - $at_traceon - - - - -sed -e 's/@USAGE@/BINARY/' "${TEMPLATE}/numeric-display.cob" > prog.cob - -{ set +x -$as_echo "$at_srcdir/data_binary.at:1139: \$COMPILE -fbinary-size=1--8 \\ - -fno-pretty-display prog.cob" -at_fn_check_prepare_notrace 'an embedded newline' "data_binary.at:1139" -( $at_check_trace; $COMPILE -fbinary-size=1--8 \ - -fno-pretty-display prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/data_binary.at:1139" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/data_binary.at:1141: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "data_binary.at:1141" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo "001 -012 -00123 -01234 -00012345 -00123456 -01234567 -0012345678 -0123456789 -0001234567890 -0012345678901 -0123456789012 -001234567890123 -012345678901234 -00123456789012345 -01234567890123456 -00012345678901234567 -00123456789012345678 --001 --012 --00123 --01234 --00012345 --00123456 --0001234567 --0012345678 --0123456789 --0001234567890 --0012345678901 --000123456789012 --001234567890123 --012345678901234 --00123456789012345 --01234567890123456 --00012345678901234567 --00123456789012345678 -" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/data_binary.at:1141" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_1059 -#AT_START_1060 -at_fn_group_banner 1060 'data_binary.at:1185' \ - "BINARY: 64bit unsigned compare" " " 5 -at_xfail=no -( - $as_echo "1060. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 BDU-1 USAGE BINARY-DOUBLE UNSIGNED. - 01 BDU-2 USAGE BINARY-DOUBLE UNSIGNED. - PROCEDURE DIVISION. - MOVE 18446744073709551615 TO BDU-1 BDU-2 - IF BDU-1 NOT EQUAL BDU-2 THEN - DISPLAY "FAIL" - END-DISPLAY. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/data_binary.at:1203: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "data_binary.at:1203" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/data_binary.at:1203" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/data_binary.at:1204: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "data_binary.at:1204" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/data_binary.at:1204" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_1060 -#AT_START_1061 -at_fn_group_banner 1061 'data_binary.at:1210' \ - "BINARY: 64bit unsigned arithmetic notrunc" " " 5 -at_xfail=no -( - $as_echo "1061. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 WORK-UDWORD-1 PIC 9(18) COMP. - PROCEDURE DIVISION. - MOVE 18446744073709551615 TO WORK-UDWORD-1. - DISPLAY WORK-UDWORD-1 - END-DISPLAY. - COMPUTE WORK-UDWORD-1 = WORK-UDWORD-1 / 2 - END-COMPUTE. - DISPLAY WORK-UDWORD-1 - END-DISPLAY. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/data_binary.at:1230: \$COMPILE -fnotrunc prog.cob" -at_fn_check_prepare_dynamic "$COMPILE -fnotrunc prog.cob" "data_binary.at:1230" -( $at_check_trace; $COMPILE -fnotrunc prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/data_binary.at:1230" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/data_binary.at:1231: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "data_binary.at:1231" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo "18446744073709551615 -09223372036854775807 -" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/data_binary.at:1231" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_1061 -#AT_START_1062 -at_fn_group_banner 1062 'data_binary.at:1239' \ - "BINARY: 64bit signed negative constant range" " " 5 -at_xfail=no -( - $as_echo "1062. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 WORK-DWORD-1 PIC S9(18) COMP-5 VALUE -9223372036854775808. - PROCEDURE DIVISION. - DISPLAY WORK-DWORD-1 WITH NO ADVANCING - END-DISPLAY. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/data_binary.at:1254: \$COMPILE -fnotrunc prog.cob" -at_fn_check_prepare_dynamic "$COMPILE -fnotrunc prog.cob" "data_binary.at:1254" -( $at_check_trace; $COMPILE -fnotrunc prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/data_binary.at:1254" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/data_binary.at:1255: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "data_binary.at:1255" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo "-09223372036854775808" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/data_binary.at:1255" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_1062 -#AT_START_1063 -at_fn_group_banner 1063 'data_binary.at:1260' \ - "COMP-4 Truncate" " " 5 -at_xfail=no -( - $as_echo "1063. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 RANDOM-ORIGIN-B PIC 9V99 COMP-4. - 01 RANDOM-TARGET-B PIC V99 COMP-4. - 01 RANDOM-ORIGIN-D PIC 9V99 DISPLAY. - 01 RANDOM-TARGET-D PIC V99 DISPLAY. - - PROCEDURE DIVISION. - MOVE 0.12 TO RANDOM-ORIGIN-D - MOVE RANDOM-ORIGIN-D TO RANDOM-TARGET-D - MOVE 0.12 TO RANDOM-ORIGIN-B - MOVE RANDOM-ORIGIN-B TO RANDOM-TARGET-B - IF RANDOM-ORIGIN-D <> RANDOM-ORIGIN-B - DISPLAY "ORIGIN 0.12 WRONG" - DISPLAY "DISPLAY: " RANDOM-ORIGIN-D - " != BINARY : " RANDOM-ORIGIN-B - END-IF. - IF RANDOM-TARGET-D <> RANDOM-TARGET-B - DISPLAY "TARGET .12 WRONG" - DISPLAY "DISPLAY: " RANDOM-TARGET-D - " != BINARY : " RANDOM-TARGET-B - ELSE - DISPLAY "Ok with " RANDOM-TARGET-D " == " RANDOM-TARGET-B - END-IF. - - MOVE 9.85 TO RANDOM-ORIGIN-D - MOVE RANDOM-ORIGIN-D TO RANDOM-TARGET-D - MOVE 9.85 TO RANDOM-ORIGIN-B - MOVE RANDOM-ORIGIN-B TO RANDOM-TARGET-B - IF RANDOM-ORIGIN-D <> RANDOM-ORIGIN-B - DISPLAY "ORIGIN 9.85 WRONG" - DISPLAY "DISPLAY: " RANDOM-ORIGIN-D - " != BINARY : " RANDOM-ORIGIN-B - END-IF. - IF RANDOM-TARGET-D <> RANDOM-TARGET-B - DISPLAY "TARGET .85 WRONG" - DISPLAY "DISPLAY: " RANDOM-TARGET-D - " != BINARY : " RANDOM-TARGET-B - ELSE - DISPLAY "Ok with " RANDOM-TARGET-D " == " RANDOM-TARGET-B - END-IF. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/data_binary.at:1311: \$COMPILE -w prog.cob" -at_fn_check_prepare_dynamic "$COMPILE -w prog.cob" "data_binary.at:1311" -( $at_check_trace; $COMPILE -w prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/data_binary.at:1311" -$at_failed && at_fn_log_failure -$at_traceon; } - - -{ set +x -$as_echo "$at_srcdir/data_binary.at:1313: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "data_binary.at:1313" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo "Ok with .12 == .12 -Ok with .85 == .85 -" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/data_binary.at:1313" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_1063 -#AT_START_1064 -at_fn_group_banner 1064 'data_binary.at:1321' \ - "COMP-4 No Truncate" " " 5 -at_xfail=no -( - $as_echo "1064. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 RANDOM-ORIGIN-B PIC 9V99 COMP-4. - 01 RANDOM-TARGET-B PIC V99 COMP-4. - 01 RANDOM-ORIGIN-D PIC 9V99 DISPLAY. - 01 RANDOM-TARGET-D PIC V99 DISPLAY. - - PROCEDURE DIVISION. - MOVE 0.12 TO RANDOM-ORIGIN-D - MOVE RANDOM-ORIGIN-D TO RANDOM-TARGET-D - MOVE 0.12 TO RANDOM-ORIGIN-B - MOVE RANDOM-ORIGIN-B TO RANDOM-TARGET-B - IF RANDOM-ORIGIN-D <> RANDOM-ORIGIN-B - DISPLAY "ORIGIN 0.12 WRONG" - DISPLAY "DISPLAY: " RANDOM-ORIGIN-D - " != BINARY : " RANDOM-ORIGIN-B - END-IF. - IF RANDOM-TARGET-D <> RANDOM-TARGET-B - DISPLAY "TARGET .12 WRONG" - DISPLAY "DISPLAY: " RANDOM-TARGET-D - " != BINARY : " RANDOM-TARGET-B - ELSE - DISPLAY "Ok with " RANDOM-TARGET-D " == " RANDOM-TARGET-B - END-IF. - - MOVE 9.85 TO RANDOM-ORIGIN-D - MOVE RANDOM-ORIGIN-D TO RANDOM-TARGET-D - MOVE 9.85 TO RANDOM-ORIGIN-B - MOVE RANDOM-ORIGIN-B TO RANDOM-TARGET-B - IF RANDOM-ORIGIN-D <> RANDOM-ORIGIN-B - DISPLAY "ORIGIN 9.85 WRONG" - DISPLAY "DISPLAY: " RANDOM-ORIGIN-D - " != BINARY : " RANDOM-ORIGIN-B - END-IF. - IF RANDOM-TARGET-D <> RANDOM-TARGET-B - DISPLAY "TARGET .85 WRONG" - DISPLAY "DISPLAY: " RANDOM-TARGET-D - " != BINARY : " RANDOM-TARGET-B - ELSE - DISPLAY "Ok with " RANDOM-TARGET-D " == " RANDOM-TARGET-B - END-IF. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/data_binary.at:1372: \$COMPILE -w -fnotrunc prog.cob" -at_fn_check_prepare_dynamic "$COMPILE -w -fnotrunc prog.cob" "data_binary.at:1372" -( $at_check_trace; $COMPILE -w -fnotrunc prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/data_binary.at:1372" -$at_failed && at_fn_log_failure -$at_traceon; } - - -{ set +x -$as_echo "$at_srcdir/data_binary.at:1374: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "data_binary.at:1374" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo "Ok with 12 == 012 -TARGET .85 WRONG -DISPLAY: 85 != BINARY : 217 -" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/data_binary.at:1374" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_1064 -#AT_START_1065 -at_fn_group_banner 1065 'data_display.at:21' \ - "DISPLAY: Sign ASCII" " " 5 -at_xfail=no -( - $as_echo "1065. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 G. - 02 X PIC X(5). - 02 X-9 REDEFINES X PIC 9(4). - 02 X-S9 REDEFINES X PIC S9(4). - 02 X-S9-L REDEFINES X PIC S9(4) LEADING. - 02 X-S9-LS REDEFINES X PIC S9(4) LEADING SEPARATE. - 02 X-S9-T REDEFINES X PIC S9(4) TRAILING. - 02 X-S9-TS REDEFINES X PIC S9(4) TRAILING SEPARATE. - PROCEDURE DIVISION. - MOVE ZERO TO X. MOVE 1234 TO X-9. DISPLAY X - END-DISPLAY. - MOVE ZERO TO X. MOVE 1234 TO X-S9. DISPLAY X - END-DISPLAY. - MOVE ZERO TO X. MOVE -1234 TO X-S9. DISPLAY X - END-DISPLAY. - MOVE ZERO TO X. MOVE 1234 TO X-S9-L. DISPLAY X - END-DISPLAY. - MOVE ZERO TO X. MOVE -1234 TO X-S9-L. DISPLAY X - END-DISPLAY. - MOVE ZERO TO X. MOVE 1234 TO X-S9-LS. DISPLAY X - END-DISPLAY. - MOVE ZERO TO X. MOVE -1234 TO X-S9-LS. DISPLAY X - END-DISPLAY. - MOVE ZERO TO X. MOVE 1234 TO X-S9-T. DISPLAY X - END-DISPLAY. - MOVE ZERO TO X. MOVE -1234 TO X-S9-T. DISPLAY X - END-DISPLAY. - MOVE ZERO TO X. MOVE 1234 TO X-S9-TS. DISPLAY X - END-DISPLAY. - MOVE ZERO TO X. MOVE -1234 TO X-S9-TS. DISPLAY X - END-DISPLAY. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/data_display.at:63: \$COMPILE -fsign=ascii prog.cob" -at_fn_check_prepare_dynamic "$COMPILE -fsign=ascii prog.cob" "data_display.at:63" -( $at_check_trace; $COMPILE -fsign=ascii prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/data_display.at:63" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/data_display.at:64: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "data_display.at:64" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo "12340 -12340 -123t0 -12340 -q2340 -+1234 --1234 -12340 -123t0 -1234+ -1234- -" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/data_display.at:64" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_1065 -#AT_START_1066 -at_fn_group_banner 1066 'data_display.at:80' \ - "DISPLAY: Sign ASCII (2)" " " 5 -at_xfail=no -( - $as_echo "1066. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 G. - 02 X PIC X(10). - 02 X-S99 REDEFINES X PIC S99. - 02 X-S9 REDEFINES X PIC S9 OCCURS 10. - PROCEDURE DIVISION. - MOVE 0 TO X-S9(1). - MOVE 1 TO X-S9(2). - MOVE 2 TO X-S9(3). - MOVE 3 TO X-S9(4). - MOVE 4 TO X-S9(5). - MOVE 5 TO X-S9(6). - MOVE 6 TO X-S9(7). - MOVE 7 TO X-S9(8). - MOVE 8 TO X-S9(9). - MOVE 9 TO X-S9(10). - DISPLAY X NO ADVANCING - END-DISPLAY. - MOVE -10 TO X-S99. MOVE X(2:1) TO X(1:1). - MOVE -1 TO X-S9(2). - MOVE -2 TO X-S9(3). - MOVE -3 TO X-S9(4). - MOVE -4 TO X-S9(5). - MOVE -5 TO X-S9(6). - MOVE -6 TO X-S9(7). - MOVE -7 TO X-S9(8). - MOVE -8 TO X-S9(9). - MOVE -9 TO X-S9(10). - DISPLAY X NO ADVANCING - END-DISPLAY. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/data_display.at:120: \$COMPILE -fsign=ascii prog.cob" -at_fn_check_prepare_dynamic "$COMPILE -fsign=ascii prog.cob" "data_display.at:120" -( $at_check_trace; $COMPILE -fsign=ascii prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/data_display.at:120" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/data_display.at:121: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "data_display.at:121" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo "0123456789pqrstuvwxy" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/data_display.at:121" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_1066 -#AT_START_1067 -at_fn_group_banner 1067 'data_display.at:126' \ - "DISPLAY: Sign EBCDIC" " " 5 -at_xfail=no -( - $as_echo "1067. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 G. - 02 X PIC X(10). - 02 X-S99 REDEFINES X PIC S99. - 02 X-S9 REDEFINES X PIC S9 OCCURS 10. - PROCEDURE DIVISION. - MOVE 0 TO X-S9(1). - MOVE 1 TO X-S9(2). - MOVE 2 TO X-S9(3). - MOVE 3 TO X-S9(4). - MOVE 4 TO X-S9(5). - MOVE 5 TO X-S9(6). - MOVE 6 TO X-S9(7). - MOVE 7 TO X-S9(8). - MOVE 8 TO X-S9(9). - MOVE 9 TO X-S9(10). - DISPLAY X NO ADVANCING - END-DISPLAY. - MOVE -10 TO X-S99. MOVE X(2:1) TO X(1:1). - MOVE -1 TO X-S9(2). - MOVE -2 TO X-S9(3). - MOVE -3 TO X-S9(4). - MOVE -4 TO X-S9(5). - MOVE -5 TO X-S9(6). - MOVE -6 TO X-S9(7). - MOVE -7 TO X-S9(8). - MOVE -8 TO X-S9(9). - MOVE -9 TO X-S9(10). - DISPLAY X NO ADVANCING - END-DISPLAY. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/data_display.at:166: \$COMPILE -fsign=ebcdic prog.cob" -at_fn_check_prepare_dynamic "$COMPILE -fsign=ebcdic prog.cob" "data_display.at:166" -( $at_check_trace; $COMPILE -fsign=ebcdic prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/data_display.at:166" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/data_display.at:167: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "data_display.at:167" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo "{ABCDEFGHI}JKLMNOPQR" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/data_display.at:167" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_1067 -#AT_START_1068 -at_fn_group_banner 1068 'data_display.at:171' \ - "DISPLAY: unsigned" " " 5 -at_xfail=no -( - $as_echo "1068. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 X-BCU BINARY-CHAR UNSIGNED. - 01 X-BSU BINARY-SHORT UNSIGNED. - 01 X-BIU BINARY-INT UNSIGNED. - 01 X-BLU BINARY-LONG UNSIGNED. - 01 X-BDU BINARY-DOUBLE UNSIGNED. - 01 X-US UNSIGNED-SHORT. - 01 X-UI UNSIGNED-INT. - PROCEDURE DIVISION. - MOVE 127 TO X-BCU. DISPLAY X-BCU END-DISPLAY. - ADD 1 TO X-BCU END-ADD. DISPLAY X-BCU END-DISPLAY. - MOVE 32767 TO X-BSU. DISPLAY X-BSU END-DISPLAY. - ADD 1 TO X-BSU END-ADD. DISPLAY X-BSU END-DISPLAY. - MOVE 2147483647 TO X-BIU. DISPLAY X-BIU END-DISPLAY. - ADD 1 TO X-BIU END-ADD. DISPLAY X-BIU END-DISPLAY. - MOVE 2147483647 TO X-BLU. DISPLAY X-BLU END-DISPLAY. - ADD 1 TO X-BLU END-ADD. DISPLAY X-BLU END-DISPLAY. - MOVE 9223372036854775807 TO X-BDU. DISPLAY X-BDU END-DISPLAY. - ADD 1 TO X-BDU END-ADD. DISPLAY X-BDU END-DISPLAY. - MOVE 32767 TO X-US. DISPLAY X-US END-DISPLAY. - ADD 1 TO X-US END-ADD. DISPLAY X-US END-DISPLAY. - MOVE 2147483647 TO X-UI. DISPLAY X-UI END-DISPLAY. - ADD 1 TO X-UI END-ADD. DISPLAY X-UI END-DISPLAY. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/data_display.at:204: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "data_display.at:204" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/data_display.at:204" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/data_display.at:205: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "data_display.at:205" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo "127 -128 -32767 -32768 -2147483647 -2147483648 -2147483647 -2147483648 -09223372036854775807 -09223372036854775808 -32767 -32768 -2147483647 -2147483648 -" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/data_display.at:205" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_1068 -#AT_START_1069 -at_fn_group_banner 1069 'data_packed.at:25' \ - "PACKED-DECIMAL dump" " " 5 -at_xfail=no -( - $as_echo "1069. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >dump.c <<'_ATEOF' - -#include -#include - -COB_EXT_EXPORT int -dump (unsigned char *data) -{ - int i; - for (i = 0; i < 10; i++) - printf ("%02x", data[i]); - puts (""); - return 0; -} -_ATEOF - - -sed -e 's/@USAGE@/PACKED-DECIMAL/' "${TEMPLATE}/numeric-dump.cob" > prog.cob - -{ set +x -$as_echo "$at_srcdir/data_packed.at:45: \$COMPILE_MODULE dump.c" -at_fn_check_prepare_dynamic "$COMPILE_MODULE dump.c" "data_packed.at:45" -( $at_check_trace; $COMPILE_MODULE dump.c -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/data_packed.at:45" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/data_packed.at:46: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "data_packed.at:46" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/data_packed.at:46" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/data_packed.at:47: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "data_packed.at:47" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo "1f202020202020202020 -012f2020202020202020 -123f2020202020202020 -01234f20202020202020 -12345f20202020202020 -0123456f202020202020 -1234567f202020202020 -012345678f2020202020 -123456789f2020202020 -01234567890f20202020 -12345678901f20202020 -0123456789012f202020 -1234567890123f202020 -012345678901234f2020 -123456789012345f2020 -01234567890123456f20 -12345678901234567f20 -0123456789012345678f -1d202020202020202020 -012d2020202020202020 -123d2020202020202020 -01234d20202020202020 -12345d20202020202020 -0123456d202020202020 -1234567d202020202020 -012345678d2020202020 -123456789d2020202020 -01234567890d20202020 -12345678901d20202020 -0123456789012d202020 -1234567890123d202020 -012345678901234d2020 -123456789012345d2020 -01234567890123456d20 -12345678901234567d20 -0123456789012345678d -0f202020202020202020 -000f2020202020202020 -000f2020202020202020 -00000f20202020202020 -00000f20202020202020 -0000000f202020202020 -0000000f202020202020 -000000000f2020202020 -000000000f2020202020 -00000000000f20202020 -00000000000f20202020 -0000000000000f202020 -0000000000000f202020 -000000000000000f2020 -000000000000000f2020 -00000000000000000f20 -00000000000000000f20 -0000000000000000000f -0c202020202020202020 -000c2020202020202020 -000c2020202020202020 -00000c20202020202020 -00000c20202020202020 -0000000c202020202020 -0000000c202020202020 -000000000c2020202020 -000000000c2020202020 -00000000000c20202020 -00000000000c20202020 -0000000000000c202020 -0000000000000c202020 -000000000000000c2020 -000000000000000c2020 -00000000000000000c20 -00000000000000000c20 -0000000000000000000c -0f202020202020202020 -000f2020202020202020 -000f2020202020202020 -00000f20202020202020 -00000f20202020202020 -0000000f202020202020 -0000000f202020202020 -000000000f2020202020 -000000000f2020202020 -00000000000f20202020 -00000000000f20202020 -0000000000000f202020 -0000000000000f202020 -000000000000000f2020 -000000000000000f2020 -00000000000000000f20 -00000000000000000f20 -0000000000000000000f -0c202020202020202020 -000c2020202020202020 -000c2020202020202020 -00000c20202020202020 -00000c20202020202020 -0000000c202020202020 -0000000c202020202020 -000000000c2020202020 -000000000c2020202020 -00000000000c20202020 -00000000000c20202020 -0000000000000c202020 -0000000000000c202020 -000000000000000c2020 -000000000000000c2020 -00000000000000000c20 -00000000000000000c20 -0000000000000000000c -" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/data_packed.at:47" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_1069 -#AT_START_1070 -at_fn_group_banner 1070 'data_packed.at:161' \ - "PACKED-DECIMAL used with DISPLAY" " " 5 -at_xfail=no -( - $as_echo "1070. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 X-99 PIC 99 USAGE PACKED-DECIMAL. - 01 X-S99 PIC S99 USAGE PACKED-DECIMAL. - 01 X-999 PIC 999 USAGE PACKED-DECIMAL. - 01 X-S999 PIC S999 USAGE PACKED-DECIMAL. - PROCEDURE DIVISION. - MOVE 0 TO X-99. - DISPLAY X-99 - END-DISPLAY. - MOVE 99 TO X-99. - DISPLAY X-99 - END-DISPLAY. - MOVE 0 TO X-S99. - DISPLAY X-S99 - END-DISPLAY. - MOVE -1 TO X-S99. - DISPLAY X-S99 - END-DISPLAY. - MOVE 0 TO X-999. - DISPLAY X-999 - END-DISPLAY. - MOVE 123 TO X-999. - DISPLAY X-999 - END-DISPLAY. - MOVE 0 TO X-S999. - DISPLAY X-S999 - END-DISPLAY. - MOVE -123 TO X-S999. - DISPLAY X-S999 - END-DISPLAY. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/data_packed.at:201: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "data_packed.at:201" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/data_packed.at:201" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/data_packed.at:202: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "data_packed.at:202" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo "00 -99 -+00 --01 -000 -123 -+000 --123 -" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/data_packed.at:202" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_1070 -#AT_START_1071 -at_fn_group_banner 1071 'data_packed.at:216' \ - "PACKED-DECIMAL used with MOVE" " " 5 -at_xfail=no -( - $as_echo "1071. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 X-99 PIC 99 USAGE PACKED-DECIMAL. - 01 X-S99 PIC S99 USAGE PACKED-DECIMAL. - 01 X-999 PIC 999 USAGE PACKED-DECIMAL. - 01 X-S999 PIC S999 USAGE PACKED-DECIMAL. - 01 C-P1234 PIC 9999 VALUE 1234. - 01 C-N1234 PIC S9999 VALUE -1234. - PROCEDURE DIVISION. - MOVE C-P1234 TO X-99. - DISPLAY X-99 - END-DISPLAY. - MOVE C-P1234 TO X-S99. - DISPLAY X-S99 - END-DISPLAY. - MOVE C-P1234 TO X-999. - DISPLAY X-999 - END-DISPLAY. - MOVE C-P1234 TO X-S999. - DISPLAY X-S999 - END-DISPLAY. - MOVE C-N1234 TO X-99. - DISPLAY X-99 - END-DISPLAY. - MOVE C-N1234 TO X-S99. - DISPLAY X-S99 - END-DISPLAY. - MOVE C-N1234 TO X-999. - DISPLAY X-999 - END-DISPLAY. - MOVE C-N1234 TO X-S999. - DISPLAY X-S999 - END-DISPLAY. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/data_packed.at:258: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "data_packed.at:258" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/data_packed.at:258" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/data_packed.at:259: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "data_packed.at:259" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo "34 -+34 -234 -+234 -34 --34 -234 --234 -" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/data_packed.at:259" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_1071 -#AT_START_1072 -at_fn_group_banner 1072 'data_packed.at:273' \ - "PACKED-DECIMAL used with INITIALIZE" " " 5 -at_xfail=no -( - $as_echo "1072. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 X-99 PIC 99 USAGE PACKED-DECIMAL. - 01 X-S99 PIC S99 USAGE PACKED-DECIMAL. - 01 X-999 PIC 999 USAGE PACKED-DECIMAL. - 01 X-S999 PIC S999 USAGE PACKED-DECIMAL. - PROCEDURE DIVISION. - INITIALIZE X-99. - DISPLAY X-99 - END-DISPLAY. - INITIALIZE X-S99. - DISPLAY X-S99 - END-DISPLAY. - INITIALIZE X-999. - DISPLAY X-999 - END-DISPLAY. - INITIALIZE X-S999. - DISPLAY X-S999 - END-DISPLAY. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/data_packed.at:301: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "data_packed.at:301" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/data_packed.at:301" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/data_packed.at:302: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "data_packed.at:302" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo "00 -+00 -000 -+000 -" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/data_packed.at:302" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_1072 -#AT_START_1073 -at_fn_group_banner 1073 'data_packed.at:312' \ - "PACKED-DECIMAL arithmetic" " " 5 -at_xfail=no -( - $as_echo "1073. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 X PIC 99 USAGE PACKED-DECIMAL VALUE 0. - 01 Y PIC 99 USAGE PACKED-DECIMAL VALUE 9. - PROCEDURE DIVISION. - COMPUTE X = 1 - END-COMPUTE. - DISPLAY X - END-DISPLAY. - COMPUTE X = Y - END-COMPUTE. - DISPLAY X - END-DISPLAY. - COMPUTE X = X + Y - END-COMPUTE. - DISPLAY X - END-DISPLAY. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/data_packed.at:338: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "data_packed.at:338" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/data_packed.at:338" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/data_packed.at:339: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "data_packed.at:339" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo "01 -09 -18 -" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/data_packed.at:339" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_1073 -#AT_START_1074 -at_fn_group_banner 1074 'data_packed.at:348' \ - "PACKED-DECIMAL numeric test (1)" " " 5 -at_xfail=no -( - $as_echo "1074. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 G. - 02 X-2 PIC X(2). - 02 N-2 REDEFINES X-2 PIC 999 USAGE PACKED-DECIMAL. - 02 N-S2 REDEFINES X-2 PIC S999 USAGE PACKED-DECIMAL. - PROCEDURE DIVISION. - MOVE X"0000" TO X-2. - IF N-2 IS NUMERIC - DISPLAY "NG" - END-DISPLAY - ELSE - DISPLAY "OK" - END-DISPLAY - END-IF. - IF N-S2 IS NUMERIC - DISPLAY "NG" - END-DISPLAY - ELSE - DISPLAY "OK" - END-DISPLAY - END-IF. - MOVE X"000c" TO X-2. - IF N-2 IS NUMERIC - DISPLAY "NG" - END-DISPLAY - ELSE - DISPLAY "OK" - END-DISPLAY - END-IF. - IF N-S2 IS NUMERIC - DISPLAY "OK" - END-DISPLAY - ELSE - DISPLAY "NG" - END-DISPLAY - END-IF. - MOVE X"000d" TO X-2. - IF N-2 IS NUMERIC - DISPLAY "NG" - END-DISPLAY - ELSE - DISPLAY "OK" - END-DISPLAY - END-IF. - IF N-S2 IS NUMERIC - DISPLAY "OK" - END-DISPLAY - ELSE - DISPLAY "NG" - END-DISPLAY - END-IF. - MOVE X"000f" TO X-2. - IF N-2 IS NUMERIC - DISPLAY "OK" - END-DISPLAY - ELSE - DISPLAY "NG" - END-DISPLAY - END-IF. - IF N-S2 IS NUMERIC - DISPLAY "NG" - END-DISPLAY - ELSE - DISPLAY "OK" - END-DISPLAY - END-IF. - MOVE X"1234" TO X-2. - IF N-2 IS NUMERIC - DISPLAY "NG" - END-DISPLAY - ELSE - DISPLAY "OK" - END-DISPLAY - END-IF. - IF N-S2 IS NUMERIC - DISPLAY "NG" - END-DISPLAY - ELSE - DISPLAY "OK" - END-DISPLAY - END-IF. - MOVE X"999f" TO X-2. - IF N-2 IS NUMERIC - DISPLAY "OK" - END-DISPLAY - ELSE - DISPLAY "NG" - END-DISPLAY - END-IF. - IF N-S2 IS NUMERIC - DISPLAY "NG" - END-DISPLAY - ELSE - DISPLAY "OK" - END-DISPLAY - END-IF. - MOVE X"ffff" TO X-2. - IF N-2 IS NUMERIC - DISPLAY "NG" - END-DISPLAY - ELSE - DISPLAY "OK" - END-DISPLAY - END-IF. - IF N-S2 IS NUMERIC - DISPLAY "NG" - END-DISPLAY - ELSE - DISPLAY "OK" - END-DISPLAY - END-IF. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/data_packed.at:469: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "data_packed.at:469" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/data_packed.at:469" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/data_packed.at:470: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "data_packed.at:470" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo "OK -OK -OK -OK -OK -OK -OK -OK -OK -OK -OK -OK -OK -OK -" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/data_packed.at:470" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_1074 -#AT_START_1075 -at_fn_group_banner 1075 'data_packed.at:490' \ - "PACKED-DECIMAL numeric test (2)" " " 5 -at_xfail=no -( - $as_echo "1075. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 G. - 02 X-2 PIC X(2). - 02 N-2 REDEFINES X-2 PIC 999 USAGE PACKED-DECIMAL. - 02 N-S2 REDEFINES X-2 PIC S999 USAGE PACKED-DECIMAL. - PROCEDURE DIVISION. - MOVE X"0000" TO X-2. - IF N-2 IS NUMERIC - DISPLAY "NG" - ELSE - DISPLAY "OK" - END-IF. - IF N-S2 IS NUMERIC - DISPLAY "NG" - ELSE - DISPLAY "OK" - END-IF. - MOVE X"000c" TO X-2. - IF N-2 IS NUMERIC - DISPLAY "NG" - ELSE - DISPLAY "OK" - END-IF. - IF N-S2 IS NUMERIC - DISPLAY "OK" - ELSE - DISPLAY "NG" - END-IF. - MOVE X"000d" TO X-2. - IF N-2 IS NUMERIC - DISPLAY "NG" - ELSE - DISPLAY "OK" - END-IF. - IF N-S2 IS NUMERIC - DISPLAY "OK" - ELSE - DISPLAY "NG" - END-IF. - MOVE X"000f" TO X-2. - IF N-2 IS NUMERIC - DISPLAY "OK" - ELSE - DISPLAY "NG" - END-IF. - IF N-S2 IS NUMERIC - DISPLAY "OK" - ELSE - DISPLAY "NG" - END-IF. - MOVE X"1234" TO X-2. - IF N-2 IS NUMERIC - DISPLAY "NG" - ELSE - DISPLAY "OK" - END-IF. - IF N-S2 IS NUMERIC - DISPLAY "NG" - ELSE - DISPLAY "OK" - END-IF. - MOVE X"999f" TO X-2. - IF N-2 IS NUMERIC - DISPLAY "OK" - ELSE - DISPLAY "NG" - END-IF. - IF N-S2 IS NUMERIC - DISPLAY "OK" - ELSE - DISPLAY "NG" - END-IF. - MOVE X"ffff" TO X-2. - IF N-2 IS NUMERIC - DISPLAY "NG" - ELSE - DISPLAY "OK" - END-IF. - IF N-S2 IS NUMERIC - DISPLAY "NG" - ELSE - DISPLAY "OK" - END-IF. - STOP RUN. -_ATEOF - - -# TODO: Check what actual option is tested here -# and directly use it -{ set +x -$as_echo "$at_srcdir/data_packed.at:585: \$COMPILE -std=ibm prog.cob" -at_fn_check_prepare_dynamic "$COMPILE -std=ibm prog.cob" "data_packed.at:585" -( $at_check_trace; $COMPILE -std=ibm prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/data_packed.at:585" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/data_packed.at:586: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "data_packed.at:586" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo "OK -OK -OK -OK -OK -OK -OK -OK -OK -OK -OK -OK -OK -OK -" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/data_packed.at:586" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_1075 -#AT_START_1076 -at_fn_group_banner 1076 'data_packed.at:606' \ - "COMP-6 used with DISPLAY" " " 5 -at_xfail=no -( - $as_echo "1076. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 X-99 PIC 99 USAGE COMP-6. - 01 X-999 PIC 999 USAGE COMP-6. - PROCEDURE DIVISION. - MOVE 0 TO X-99. - DISPLAY X-99 - END-DISPLAY. - MOVE 99 TO X-99. - DISPLAY X-99 - END-DISPLAY. - MOVE 0 TO X-999. - DISPLAY X-999 - END-DISPLAY. - MOVE 123 TO X-999. - DISPLAY X-999 - END-DISPLAY. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/data_packed.at:632: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "data_packed.at:632" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/data_packed.at:632" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/data_packed.at:633: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "data_packed.at:633" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo "00 -99 -000 -123 -" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/data_packed.at:633" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_1076 -#AT_START_1077 -at_fn_group_banner 1077 'data_packed.at:643' \ - "COMP-6 used with MOVE" " " 5 -at_xfail=no -( - $as_echo "1077. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 X-99 PIC 99 USAGE COMP-6. - 01 X-999 PIC 999 USAGE COMP-6. - 01 B-99 USAGE BINARY-LONG. - 01 B-999 USAGE BINARY-LONG. - PROCEDURE DIVISION. - MOVE 0 TO B-99. - MOVE B-99 TO X-99. - DISPLAY X-99 - END-DISPLAY. - MOVE 99 TO B-99. - MOVE B-99 TO X-99. - DISPLAY X-99 - END-DISPLAY. - MOVE 0 TO B-999. - MOVE B-999 TO X-999. - DISPLAY X-999 - END-DISPLAY. - MOVE 123 TO B-999. - MOVE B-999 TO X-999. - DISPLAY X-999 - END-DISPLAY. - MOVE B-999 TO X-99. - DISPLAY X-99 - END-DISPLAY. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/data_packed.at:678: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "data_packed.at:678" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/data_packed.at:678" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/data_packed.at:679: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "data_packed.at:679" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo "00 -99 -000 -123 -23 -" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/data_packed.at:679" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_1077 -#AT_START_1078 -at_fn_group_banner 1078 'data_packed.at:690' \ - "COMP-6 arithmetic" " " 5 -at_xfail=no -( - $as_echo "1078. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 X-99 PIC 99 USAGE COMP-6. - 01 X-999 PIC 999 USAGE COMP-6. - 01 B-99 USAGE BINARY-LONG UNSIGNED. - 01 B-999 USAGE BINARY-LONG UNSIGNED. - PROCEDURE DIVISION. - MOVE 99 TO B-99 - MOVE B-99 TO X-99 - MOVE 123 TO B-999 - MOVE B-999 TO X-999 - ADD X-99 X-999 GIVING B-99 - END-ADD - DISPLAY B-99 - END-DISPLAY - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/data_packed.at:714: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "data_packed.at:714" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/data_packed.at:714" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/data_packed.at:715: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "data_packed.at:715" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo "0000000222 -" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/data_packed.at:715" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_1078 -#AT_START_1079 -at_fn_group_banner 1079 'data_packed.at:722' \ - "COMP-6 numeric test" " " 5 -at_xfail=no -( - $as_echo "1079. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 G. - 02 X-2 PIC X(2). - 02 N-3 REDEFINES X-2 PIC 999 USAGE COMP-6. - 02 N-4 REDEFINES X-2 PIC 9999 USAGE COMP-6. - PROCEDURE DIVISION. - MOVE X"0000" TO X-2. - IF N-3 IS NUMERIC - DISPLAY "OK" - END-DISPLAY - ELSE - DISPLAY "NG" - END-DISPLAY - END-IF. - IF N-4 IS NUMERIC - DISPLAY "OK" - END-DISPLAY - ELSE - DISPLAY "NG" - END-DISPLAY - END-IF. - MOVE X"000c" TO X-2. - IF N-3 IS NUMERIC - DISPLAY "NG" - END-DISPLAY - ELSE - DISPLAY "OK" - END-DISPLAY - END-IF. - IF N-4 IS NUMERIC - DISPLAY "NG" - END-DISPLAY - ELSE - DISPLAY "OK" - END-DISPLAY - END-IF. - MOVE X"1234" TO X-2. - IF N-3 IS NUMERIC - DISPLAY "OK" - END-DISPLAY - ELSE - DISPLAY "NG" - END-DISPLAY - END-IF. - IF N-4 IS NUMERIC - DISPLAY "OK" - END-DISPLAY - ELSE - DISPLAY "NG" - END-DISPLAY - END-IF. - MOVE X"ffff" TO X-2. - IF N-3 IS NUMERIC - DISPLAY "NG" - END-DISPLAY - ELSE - DISPLAY "OK" - END-DISPLAY - END-IF. - IF N-4 IS NUMERIC - DISPLAY "NG" - END-DISPLAY - ELSE - DISPLAY "OK" - END-DISPLAY - END-IF. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/data_packed.at:798: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "data_packed.at:798" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/data_packed.at:798" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/data_packed.at:799: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "data_packed.at:799" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo "OK -OK -OK -OK -OK -OK -OK -OK -" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/data_packed.at:799" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_1079 -#AT_START_1080 -at_fn_group_banner 1080 'data_pointer.at:21' \ - "POINTER: display" " " 5 -at_xfail=no -( - $as_echo "1080. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 PTR USAGE POINTER VALUE NULL. - PROCEDURE DIVISION. - DISPLAY PTR - END-DISPLAY. - SET PTR UP BY 1 - DISPLAY PTR - SET PTR DOWN BY 1 - DISPLAY PTR - END-DISPLAY. - STOP RUN. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/data_pointer.at:41: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "data_pointer.at:41" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/data_pointer.at:41" -$at_failed && at_fn_log_failure -$at_traceon; } - - -{ set +x -$as_echo "$at_srcdir/data_pointer.at:43: test \"\$COB_HAS_64_BIT_POINTER\" = \"yes\"" -at_fn_check_prepare_dynamic "test \"$COB_HAS_64_BIT_POINTER\" = \"yes\"" "data_pointer.at:43" -( $at_check_trace; test "$COB_HAS_64_BIT_POINTER" = "yes" -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/data_pointer.at:43" -if $at_failed; then : - # Previous test "failed" --> 32 bit - -{ set +x -$as_echo "$at_srcdir/data_pointer.at:43: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "data_pointer.at:43" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo "0x00000000 -0x00000001 -0x00000000 -" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/data_pointer.at:43" -$at_failed && at_fn_log_failure -$at_traceon; } - - - -else - # Previous test "passed" --> 64 bit - -{ set +x -$as_echo "$at_srcdir/data_pointer.at:43: \$COBCRUN_DIRECT ./prog" -at_fn_check_prepare_dynamic "$COBCRUN_DIRECT ./prog" "data_pointer.at:43" -( $at_check_trace; $COBCRUN_DIRECT ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -echo >>"$at_stdout"; $as_echo "0x0000000000000000 -0x0000000000000001 -0x0000000000000000 -" | \ - $at_diff - "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/data_pointer.at:43" -$at_failed && at_fn_log_failure -$at_traceon; } - -fi -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_1080 diff -Nru gnucobol-4.0~early~20200606/tests/testsuite.at gnucobol-5/tests/testsuite.at --- gnucobol-4.0~early~20200606/tests/testsuite.at 2020-06-06 20:52:00.000000000 +0000 +++ gnucobol-5/tests/testsuite.at 1970-01-01 00:00:00.000000000 +0000 @@ -1,82 +0,0 @@ -## Copyright (C) 2003-2012, 2014-2020 Free Software Foundation, Inc. -## Written by Keisuke Nishida, Roger While, Simon Sobisch -## -## This file is part of GnuCOBOL. -## -## The GnuCOBOL compiler is free software: you can redistribute it -## and/or modify it under the terms of the GNU General Public License -## as published by the Free Software Foundation, either version 3 of the -## License, or (at your option) any later version. -## -## GnuCOBOL is distributed in the hope that it will be useful, -## but WITHOUT ANY WARRANTY; without even the implied warranty of -## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -## GNU General Public License for more details. -## -## You should have received a copy of the GNU General Public License -## along with GnuCOBOL. If not, see . - -AT_COPYRIGHT([Test cases Copyright (C) 2020 Free Software Foundation, Inc. - -Written by Keisuke Nishida, Roger While, Simon Sobisch, Edward Hart, -Ron Norman, Brian Tiffin, Dave Pitts]) - -### GnuCOBOL Test Suite - -AT_INIT([GnuCOBOL Tests]) -AT_COLOR_TESTS - -AT_TESTED([cobc cobcrun]) - -## General tests of used binaries -AT_BANNER([General tests of used binaries]) -m4_include([used_binaries.at]) -m4_include([configuration.at]) - -## Syntax tests -AT_BANNER([Syntax tests]) - -m4_include([syn_copy.at]) -m4_include([syn_definition.at]) -m4_include([syn_subscripts.at]) # 8.4.1.2 Subscripts -m4_include([syn_occurs.at]) # 13.16.36 OCCURS clause -m4_include([syn_redefines.at]) # 13.16.42 REDEFINES clause -m4_include([syn_value.at]) # 13.16.61 VALUE clause -m4_include([syn_file.at]) # Files (SELECT, ASSIGN, ...) without RW -m4_include([syn_reportwriter.at]) # REPORT WRITER -m4_include([syn_refmod.at]) # 8.4.2.3 Reference-modification -m4_include([syn_misc.at]) # Miscellaneous -m4_include([syn_move.at]) # 14.8.24 MOVE statement -m4_include([syn_multiply.at]) # 14.8.25 MULTIPLY statement -m4_include([syn_screen.at]) # 13.9 SCREEN section -m4_include([syn_set.at]) # 14.8.35 SET statement -m4_include([syn_functions.at]) # 15 Intrinsic functions - -## Listings tests -AT_BANNER([Listing tests]) - -m4_include([listings.at]) # Listings - -## Run tests -AT_BANNER([Run tests]) - -m4_include([run_fundamental.at]) -m4_include([run_subscripts.at]) # 8.4.1.2 Subscripts -m4_include([run_refmod.at]) # 8.4.2.3 Reference-modification -m4_include([run_accept.at]) # 14.8.1 ACCEPT statement -m4_include([run_initialize.at]) # 14.8.19 INITIALIZE statement -m4_include([run_misc.at]) # Miscellaneous -m4_include([run_file.at]) # Files (SELECT, ASSIGN, ...) without RW -m4_include([run_reportwriter.at]) # REPORT WRITER -m4_include([run_returncode.at]) -m4_include([run_functions.at]) # 15 Intrinsic Functions / 9.4 User-Defined Functions -m4_include([run_extensions.at]) -m4_include([run_ml.at]) - -## Data Representation -AT_BANNER([Data Representation]) - -m4_include([data_binary.at]) # USAGE BINARY -m4_include([data_display.at]) # USAGE DISPLAY -m4_include([data_packed.at]) # USAGE PACKED-DECIMAL -m4_include([data_pointer.at]) # USAGE POINTER diff -Nru gnucobol-4.0~early~20200606/tests/testsuite_manual gnucobol-5/tests/testsuite_manual --- gnucobol-4.0~early~20200606/tests/testsuite_manual 2020-06-06 20:53:03.000000000 +0000 +++ gnucobol-5/tests/testsuite_manual 1970-01-01 00:00:00.000000000 +0000 @@ -1,6242 +0,0 @@ -#! /bin/sh -# Generated from testsuite_manual.at by GNU Autoconf 2.69. -# -# Test cases Copyright (C) 2018 Free Software Foundation, Inc. -# -# Written by Edward Hart, Simon Sobisch -# -# Copyright (C) 2009-2012 Free Software Foundation, Inc. -# -# This test suite is free software; the Free Software Foundation gives -# unlimited permission to copy, distribute and modify it. -## -------------------- ## -## M4sh Initialization. ## -## -------------------- ## - -# Be more Bourne compatible -DUALCASE=1; export DUALCASE # for MKS sh -if test -n "${ZSH_VERSION+set}" && (emulate sh) >/dev/null 2>&1; then : - emulate sh - NULLCMD=: - # Pre-4.2 versions of Zsh do word splitting on ${1+"$@"}, which - # is contrary to our usage. Disable this feature. - alias -g '${1+"$@"}'='"$@"' - setopt NO_GLOB_SUBST -else - case `(set -o) 2>/dev/null` in #( - *posix*) : - set -o posix ;; #( - *) : - ;; -esac -fi - - -as_nl=' -' -export as_nl -# Printing a long string crashes Solaris 7 /usr/bin/printf. -as_echo='\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\' -as_echo=$as_echo$as_echo$as_echo$as_echo$as_echo -as_echo=$as_echo$as_echo$as_echo$as_echo$as_echo$as_echo -# Prefer a ksh shell builtin over an external printf program on Solaris, -# but without wasting forks for bash or zsh. -if test -z "$BASH_VERSION$ZSH_VERSION" \ - && (test "X`print -r -- $as_echo`" = "X$as_echo") 2>/dev/null; then - as_echo='print -r --' - as_echo_n='print -rn --' -elif (test "X`printf %s $as_echo`" = "X$as_echo") 2>/dev/null; then - as_echo='printf %s\n' - as_echo_n='printf %s' -else - if test "X`(/usr/ucb/echo -n -n $as_echo) 2>/dev/null`" = "X-n $as_echo"; then - as_echo_body='eval /usr/ucb/echo -n "$1$as_nl"' - as_echo_n='/usr/ucb/echo -n' - else - as_echo_body='eval expr "X$1" : "X\\(.*\\)"' - as_echo_n_body='eval - arg=$1; - case $arg in #( - *"$as_nl"*) - expr "X$arg" : "X\\(.*\\)$as_nl"; - arg=`expr "X$arg" : ".*$as_nl\\(.*\\)"`;; - esac; - expr "X$arg" : "X\\(.*\\)" | tr -d "$as_nl" - ' - export as_echo_n_body - as_echo_n='sh -c $as_echo_n_body as_echo' - fi - export as_echo_body - as_echo='sh -c $as_echo_body as_echo' -fi - -# The user is always right. -if test "${PATH_SEPARATOR+set}" != set; then - PATH_SEPARATOR=: - (PATH='/bin;/bin'; FPATH=$PATH; sh -c :) >/dev/null 2>&1 && { - (PATH='/bin:/bin'; FPATH=$PATH; sh -c :) >/dev/null 2>&1 || - PATH_SEPARATOR=';' - } -fi - - -# IFS -# We need space, tab and new line, in precisely that order. Quoting is -# there to prevent editors from complaining about space-tab. -# (If _AS_PATH_WALK were called with IFS unset, it would disable word -# splitting by setting IFS to empty value.) -IFS=" "" $as_nl" - -# Find who we are. Look in the path if we contain no directory separator. -as_myself= -case $0 in #(( - *[\\/]* ) as_myself=$0 ;; - *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR -for as_dir in $PATH -do - IFS=$as_save_IFS - test -z "$as_dir" && as_dir=. - test -r "$as_dir/$0" && as_myself=$as_dir/$0 && break - done -IFS=$as_save_IFS - - ;; -esac -# We did not find ourselves, most probably we were run as `sh COMMAND' -# in which case we are not to be found in the path. -if test "x$as_myself" = x; then - as_myself=$0 -fi -if test ! -f "$as_myself"; then - $as_echo "$as_myself: error: cannot find myself; rerun with an absolute file name" >&2 - exit 1 -fi - -# Unset variables that we do not need and which cause bugs (e.g. in -# pre-3.0 UWIN ksh). But do not cause bugs in bash 2.01; the "|| exit 1" -# suppresses any "Segmentation fault" message there. '((' could -# trigger a bug in pdksh 5.2.14. -for as_var in BASH_ENV ENV MAIL MAILPATH -do eval test x\${$as_var+set} = xset \ - && ( (unset $as_var) || exit 1) >/dev/null 2>&1 && unset $as_var || : -done -PS1='$ ' -PS2='> ' -PS4='+ ' - -# NLS nuisances. -LC_ALL=C -export LC_ALL -LANGUAGE=C -export LANGUAGE - -# CDPATH. -(unset CDPATH) >/dev/null 2>&1 && unset CDPATH - -if test "x$CONFIG_SHELL" = x; then - as_bourne_compatible="if test -n \"\${ZSH_VERSION+set}\" && (emulate sh) >/dev/null 2>&1; then : - emulate sh - NULLCMD=: - # Pre-4.2 versions of Zsh do word splitting on \${1+\"\$@\"}, which - # is contrary to our usage. Disable this feature. - alias -g '\${1+\"\$@\"}'='\"\$@\"' - setopt NO_GLOB_SUBST -else - case \`(set -o) 2>/dev/null\` in #( - *posix*) : - set -o posix ;; #( - *) : - ;; -esac -fi -" - as_required="as_fn_return () { (exit \$1); } -as_fn_success () { as_fn_return 0; } -as_fn_failure () { as_fn_return 1; } -as_fn_ret_success () { return 0; } -as_fn_ret_failure () { return 1; } - -exitcode=0 -as_fn_success || { exitcode=1; echo as_fn_success failed.; } -as_fn_failure && { exitcode=1; echo as_fn_failure succeeded.; } -as_fn_ret_success || { exitcode=1; echo as_fn_ret_success failed.; } -as_fn_ret_failure && { exitcode=1; echo as_fn_ret_failure succeeded.; } -if ( set x; as_fn_ret_success y && test x = \"\$1\" ); then : - -else - exitcode=1; echo positional parameters were not saved. -fi -test x\$exitcode = x0 || exit 1 -test -x / || exit 1" - as_suggested=" as_lineno_1=";as_suggested=$as_suggested$LINENO;as_suggested=$as_suggested" as_lineno_1a=\$LINENO - as_lineno_2=";as_suggested=$as_suggested$LINENO;as_suggested=$as_suggested" as_lineno_2a=\$LINENO - eval 'test \"x\$as_lineno_1'\$as_run'\" != \"x\$as_lineno_2'\$as_run'\" && - test \"x\`expr \$as_lineno_1'\$as_run' + 1\`\" = \"x\$as_lineno_2'\$as_run'\"' || exit 1 -test \$(( 1 + 1 )) = 2 || exit 1" - if (eval "$as_required") 2>/dev/null; then : - as_have_required=yes -else - as_have_required=no -fi - if test x$as_have_required = xyes && (eval "$as_suggested") 2>/dev/null; then : - -else - as_save_IFS=$IFS; IFS=$PATH_SEPARATOR -as_found=false -for as_dir in /bin$PATH_SEPARATOR/usr/bin$PATH_SEPARATOR$PATH -do - IFS=$as_save_IFS - test -z "$as_dir" && as_dir=. - as_found=: - case $as_dir in #( - /*) - for as_base in sh bash ksh sh5; do - # Try only shells that exist, to save several forks. - as_shell=$as_dir/$as_base - if { test -f "$as_shell" || test -f "$as_shell.exe"; } && - { $as_echo "$as_bourne_compatible""$as_required" | as_run=a "$as_shell"; } 2>/dev/null; then : - CONFIG_SHELL=$as_shell as_have_required=yes - if { $as_echo "$as_bourne_compatible""$as_suggested" | as_run=a "$as_shell"; } 2>/dev/null; then : - break 2 -fi -fi - done;; - esac - as_found=false -done -$as_found || { if { test -f "$SHELL" || test -f "$SHELL.exe"; } && - { $as_echo "$as_bourne_compatible""$as_required" | as_run=a "$SHELL"; } 2>/dev/null; then : - CONFIG_SHELL=$SHELL as_have_required=yes -fi; } -IFS=$as_save_IFS - - - if test "x$CONFIG_SHELL" != x; then : - export CONFIG_SHELL - # We cannot yet assume a decent shell, so we have to provide a -# neutralization value for shells without unset; and this also -# works around shells that cannot unset nonexistent variables. -# Preserve -v and -x to the replacement shell. -BASH_ENV=/dev/null -ENV=/dev/null -(unset BASH_ENV) >/dev/null 2>&1 && unset BASH_ENV ENV -case $- in # (((( - *v*x* | *x*v* ) as_opts=-vx ;; - *v* ) as_opts=-v ;; - *x* ) as_opts=-x ;; - * ) as_opts= ;; -esac -exec $CONFIG_SHELL $as_opts "$as_myself" ${1+"$@"} -# Admittedly, this is quite paranoid, since all the known shells bail -# out after a failed `exec'. -$as_echo "$0: could not re-execute with $CONFIG_SHELL" >&2 -exit 255 -fi - - if test x$as_have_required = xno; then : - $as_echo "$0: This script requires a shell more modern than all" - $as_echo "$0: the shells that I found on your system." - if test x${ZSH_VERSION+set} = xset ; then - $as_echo "$0: In particular, zsh $ZSH_VERSION has bugs and should" - $as_echo "$0: be upgraded to zsh 4.3.4 or later." - else - $as_echo "$0: Please tell bug-autoconf@gnu.org about your system, -$0: including any error possibly output before this -$0: message. Then install a modern shell, or manually run -$0: the script under such a shell if you do have one." - fi - exit 1 -fi -fi -fi -SHELL=${CONFIG_SHELL-/bin/sh} -export SHELL -# Unset more variables known to interfere with behavior of common tools. -CLICOLOR_FORCE= GREP_OPTIONS= -unset CLICOLOR_FORCE GREP_OPTIONS - -## --------------------- ## -## M4sh Shell Functions. ## -## --------------------- ## -# as_fn_unset VAR -# --------------- -# Portably unset VAR. -as_fn_unset () -{ - { eval $1=; unset $1;} -} -as_unset=as_fn_unset - -# as_fn_set_status STATUS -# ----------------------- -# Set $? to STATUS, without forking. -as_fn_set_status () -{ - return $1 -} # as_fn_set_status - -# as_fn_exit STATUS -# ----------------- -# Exit the shell with STATUS, even in a "trap 0" or "set -e" context. -as_fn_exit () -{ - set +e - as_fn_set_status $1 - exit $1 -} # as_fn_exit - -# as_fn_mkdir_p -# ------------- -# Create "$as_dir" as a directory, including parents if necessary. -as_fn_mkdir_p () -{ - - case $as_dir in #( - -*) as_dir=./$as_dir;; - esac - test -d "$as_dir" || eval $as_mkdir_p || { - as_dirs= - while :; do - case $as_dir in #( - *\'*) as_qdir=`$as_echo "$as_dir" | sed "s/'/'\\\\\\\\''/g"`;; #'( - *) as_qdir=$as_dir;; - esac - as_dirs="'$as_qdir' $as_dirs" - as_dir=`$as_dirname -- "$as_dir" || -$as_expr X"$as_dir" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \ - X"$as_dir" : 'X\(//\)[^/]' \| \ - X"$as_dir" : 'X\(//\)$' \| \ - X"$as_dir" : 'X\(/\)' \| . 2>/dev/null || -$as_echo X"$as_dir" | - sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{ - s//\1/ - q - } - /^X\(\/\/\)[^/].*/{ - s//\1/ - q - } - /^X\(\/\/\)$/{ - s//\1/ - q - } - /^X\(\/\).*/{ - s//\1/ - q - } - s/.*/./; q'` - test -d "$as_dir" && break - done - test -z "$as_dirs" || eval "mkdir $as_dirs" - } || test -d "$as_dir" || as_fn_error $? "cannot create directory $as_dir" - - -} # as_fn_mkdir_p - -# as_fn_executable_p FILE -# ----------------------- -# Test if FILE is an executable regular file. -as_fn_executable_p () -{ - test -f "$1" && test -x "$1" -} # as_fn_executable_p -# as_fn_append VAR VALUE -# ---------------------- -# Append the text in VALUE to the end of the definition contained in VAR. Take -# advantage of any shell optimizations that allow amortized linear growth over -# repeated appends, instead of the typical quadratic growth present in naive -# implementations. -if (eval "as_var=1; as_var+=2; test x\$as_var = x12") 2>/dev/null; then : - eval 'as_fn_append () - { - eval $1+=\$2 - }' -else - as_fn_append () - { - eval $1=\$$1\$2 - } -fi # as_fn_append - -# as_fn_arith ARG... -# ------------------ -# Perform arithmetic evaluation on the ARGs, and store the result in the -# global $as_val. Take advantage of shells that can avoid forks. The arguments -# must be portable across $(()) and expr. -if (eval "test \$(( 1 + 1 )) = 2") 2>/dev/null; then : - eval 'as_fn_arith () - { - as_val=$(( $* )) - }' -else - as_fn_arith () - { - as_val=`expr "$@" || test $? -eq 1` - } -fi # as_fn_arith - - -# as_fn_error STATUS ERROR [LINENO LOG_FD] -# ---------------------------------------- -# Output "`basename $0`: error: ERROR" to stderr. If LINENO and LOG_FD are -# provided, also output the error to LOG_FD, referencing LINENO. Then exit the -# script with STATUS, using 1 if that was 0. -as_fn_error () -{ - as_status=$1; test $as_status -eq 0 && as_status=1 - if test "$4"; then - as_lineno=${as_lineno-"$3"} as_lineno_stack=as_lineno_stack=$as_lineno_stack - $as_echo "$as_me:${as_lineno-$LINENO}: error: $2" >&$4 - fi - $as_echo "$as_me: error: $2" >&2 - as_fn_exit $as_status -} # as_fn_error - -if expr a : '\(a\)' >/dev/null 2>&1 && - test "X`expr 00001 : '.*\(...\)'`" = X001; then - as_expr=expr -else - as_expr=false -fi - -if (basename -- /) >/dev/null 2>&1 && test "X`basename -- / 2>&1`" = "X/"; then - as_basename=basename -else - as_basename=false -fi - -as_me=`$as_basename -- "$0" || -$as_expr X/"$0" : '.*/\([^/][^/]*\)/*$' \| \ - X"$0" : 'X\(//\)$' \| \ - X"$0" : 'X\(/\)' \| . 2>/dev/null || -$as_echo X/"$0" | - sed '/^.*\/\([^/][^/]*\)\/*$/{ - s//\1/ - q - } - /^X\/\(\/\/\)$/{ - s//\1/ - q - } - /^X\/\(\/\).*/{ - s//\1/ - q - } - s/.*/./; q'` - -if (as_dir=`dirname -- /` && test "X$as_dir" = X/) >/dev/null 2>&1; then - as_dirname=dirname -else - as_dirname=false -fi - -# Avoid depending upon Character Ranges. -as_cr_letters='abcdefghijklmnopqrstuvwxyz' -as_cr_LETTERS='ABCDEFGHIJKLMNOPQRSTUVWXYZ' -as_cr_Letters=$as_cr_letters$as_cr_LETTERS -as_cr_digits='0123456789' -as_cr_alnum=$as_cr_Letters$as_cr_digits - - - as_lineno_1=$LINENO as_lineno_1a=$LINENO - as_lineno_2=$LINENO as_lineno_2a=$LINENO - eval 'test "x$as_lineno_1'$as_run'" != "x$as_lineno_2'$as_run'" && - test "x`expr $as_lineno_1'$as_run' + 1`" = "x$as_lineno_2'$as_run'"' || { - # Blame Lee E. McMahon (1931-1989) for sed's syntax. :-) - sed -n ' - p - /[$]LINENO/= - ' <$as_myself | - sed ' - s/[$]LINENO.*/&-/ - t lineno - b - :lineno - N - :loop - s/[$]LINENO\([^'$as_cr_alnum'_].*\n\)\(.*\)/\2\1\2/ - t loop - s/-\n.*// - ' >$as_me.lineno && - chmod +x "$as_me.lineno" || - { $as_echo "$as_me: error: cannot create $as_me.lineno; rerun with a POSIX shell" >&2; as_fn_exit 1; } - - # If we had to re-execute with $CONFIG_SHELL, we're ensured to have - # already done that, so ensure we don't try to do so again and fall - # in an infinite loop. This has already happened in practice. - _as_can_reexec=no; export _as_can_reexec - # Don't try to exec as it changes $[0], causing all sort of problems - # (the dirname of $[0] is not the place where we might find the - # original and so on. Autoconf is especially sensitive to this). - . "./$as_me.lineno" - # Exit status is that of the last command. - exit -} - -ECHO_C= ECHO_N= ECHO_T= -case `echo -n x` in #((((( --n*) - case `echo 'xy\c'` in - *c*) ECHO_T=' ';; # ECHO_T is single tab character. - xy) ECHO_C='\c';; - *) echo `echo ksh88 bug on AIX 6.1` > /dev/null - ECHO_T=' ';; - esac;; -*) - ECHO_N='-n';; -esac - -rm -f conf$$ conf$$.exe conf$$.file -if test -d conf$$.dir; then - rm -f conf$$.dir/conf$$.file -else - rm -f conf$$.dir - mkdir conf$$.dir 2>/dev/null -fi -if (echo >conf$$.file) 2>/dev/null; then - if ln -s conf$$.file conf$$ 2>/dev/null; then - as_ln_s='ln -s' - # ... but there are two gotchas: - # 1) On MSYS, both `ln -s file dir' and `ln file dir' fail. - # 2) DJGPP < 2.04 has no symlinks; `ln -s' creates a wrapper executable. - # In both cases, we have to default to `cp -pR'. - ln -s conf$$.file conf$$.dir 2>/dev/null && test ! -f conf$$.exe || - as_ln_s='cp -pR' - elif ln conf$$.file conf$$ 2>/dev/null; then - as_ln_s=ln - else - as_ln_s='cp -pR' - fi -else - as_ln_s='cp -pR' -fi -rm -f conf$$ conf$$.exe conf$$.dir/conf$$.file conf$$.file -rmdir conf$$.dir 2>/dev/null - -if mkdir -p . 2>/dev/null; then - as_mkdir_p='mkdir -p "$as_dir"' -else - test -d ./-p && rmdir ./-p - as_mkdir_p=false -fi - -as_test_x='test -x' -as_executable_p=as_fn_executable_p - -# Sed expression to map a string onto a valid CPP name. -as_tr_cpp="eval sed 'y%*$as_cr_letters%P$as_cr_LETTERS%;s%[^_$as_cr_alnum]%_%g'" - -# Sed expression to map a string onto a valid variable name. -as_tr_sh="eval sed 'y%*+%pp%;s%[^_$as_cr_alnum]%_%g'" - - - - - -SHELL=${CONFIG_SHELL-/bin/sh} - -# How were we run? -at_cli_args="$@" - - -# Not all shells have the 'times' builtin; the subshell is needed to make -# sure we discard the 'times: not found' message from the shell. -at_times_p=false -(times) >/dev/null 2>&1 && at_times_p=: - -# CLI Arguments to pass to the debugging scripts. -at_debug_args= -# -e sets to true -at_errexit_p=false -# Shall we be verbose? ':' means no, empty means yes. -at_verbose=: -at_quiet= -# Running several jobs in parallel, 0 means as many as test groups. -at_jobs=1 -at_traceon=: -at_trace_echo=: -at_check_filter_trace=: - -# Shall we keep the debug scripts? Must be `:' when the suite is -# run by a debug script, so that the script doesn't remove itself. -at_debug_p=false -# Display help message? -at_help_p=false -# Display the version message? -at_version_p=false -# List test groups? -at_list_p=false -# --clean -at_clean=false -# Test groups to run -at_groups= -# Whether to rerun failed tests. -at_recheck= -# Whether a write failure occurred -at_write_fail=0 - -# The directory we run the suite in. Default to . if no -C option. -at_dir=`pwd` -# An absolute reference to this testsuite script. -case $as_myself in - [\\/]* | ?:[\\/]* ) at_myself=$as_myself ;; - * ) at_myself=$at_dir/$as_myself ;; -esac -# Whether -C is in effect. -at_change_dir=false - -# Whether to enable colored test results. -at_color=auto -# List of the tested programs. -at_tested='cobc -cobcrun' -# As many question marks as there are digits in the last test group number. -# Used to normalize the test group numbers so that `ls' lists them in -# numerical order. -at_format='??' -# Description of all the test groups. -at_help_all="1;run_manual_screen.at:24;LINE;screen; -2;run_manual_screen.at:71;COLUMN (1);col; -3;run_manual_screen.at:121;COLUMN (2);col; -4;run_manual_screen.at:168;LINE non-zero, COLUMN zero;col extensions; -5;run_manual_screen.at:207;LINE zero, COLUMN non-zero;col zero extensions; -6;run_manual_screen.at:247;LINE zero, COLUMN zero;col extensions; -7;run_manual_screen.at:289;DISPLAY AT;extensions; -8;run_manual_screen.at:332;DISPLAY LOW-VALUES (one statement);low-value extensions; -9;run_manual_screen.at:370;DISPLAY LOW-VALUES (two statements);low-value extensions; -10;run_manual_screen.at:409;DISPLAY SPACES;space extensions; -11;run_manual_screen.at:464;DISPLAY ALL X'01';soh extensions; -12;run_manual_screen.at:519;DISPLAY ALL X'02';stx extensions; -13;run_manual_screen.at:580;DISPLAY ALL X'07';bell beep extensions; -14;run_manual_screen.at:637;Screen position after field display;line column; -15;run_manual_screen.at:677;Overridden clauses (1);line column col; -16;run_manual_screen.at:725;Overridden clauses (2);highlight lowlight; -17;run_manual_screen.at:766;AUTO;position; -18;run_manual_screen.at:818;BACKGROUND- / FOREGROUND-COLOUR;background-color background-colour foreground-color; -19;run_manual_screen.at:889;BEEP;bell flash; -20;run_manual_screen.at:946;BLANK LINE;screen; -21;run_manual_screen.at:1004;BLANK SCREEN;screen; -22;run_manual_screen.at:1061;BLANK ignored in ACCEPT;screen; -23;run_manual_screen.at:1103;BLINK;screen; -24;run_manual_screen.at:1142;ERASE EOS;screen; -25;run_manual_screen.at:1200;ERASE EOL;screen; -26;run_manual_screen.at:1258;ERASE ignored in ACCEPT;eos; -27;run_manual_screen.at:1313;FULL and REQUIRED;screen; -28;run_manual_screen.at:1354;HIGHLIGHT;screen; -29;run_manual_screen.at:1394;INITIAL;screen; -30;run_manual_screen.at:1441;LEFTLINE;grid; -31;run_manual_screen.at:1484;LOWLIGHT;screen; -32;run_manual_screen.at:1523;OVERLINE;screen; -33;run_manual_screen.at:1565;REVERSE-VIDEO;screen; -34;run_manual_screen.at:1606;SECURE;password; -35;run_manual_screen.at:1648;SIZE with items;protected extensions; -36;run_manual_screen.at:1692;SIZE with figurative constants;protected extensions; -37;run_manual_screen.at:1733;UPDATE;extensions; -38;run_manual_screen.at:1774;UNDERLINE;screen; -39;run_manual_screen.at:1813;HOME key;home size; -40;run_manual_screen.at:1860;END key;end size; -41;run_manual_screen.at:1907;INSERT key;insert size; -42;run_manual_screen.at:1956;BACKSPACE key;backspace size; -43;run_manual_screen.at:2005;DELETE key;delete size; -44;run_manual_screen.at:2054;ALT DELETE key;alt-delete size; -45;run_manual_screen.at:2101;ALT LEFT-ARROW key;alt-left-arrow size; -46;run_manual_screen.at:2148;ALT RIGHT-ARROW key;size; -47;run_manual_screen.at:2195;CURSOR clause;special-names; -48;run_manual_screen.at:2294;CRT STATUS clause;special-names; -" -# List of the all the test groups. -at_groups_all=`$as_echo "$at_help_all" | sed 's/;.*//'` - -# at_fn_validate_ranges NAME... -# ----------------------------- -# Validate and normalize the test group number contained in each variable -# NAME. Leading zeroes are treated as decimal. -at_fn_validate_ranges () -{ - for at_grp - do - eval at_value=\$$at_grp - if test $at_value -lt 1 || test $at_value -gt 48; then - $as_echo "invalid test group: $at_value" >&2 - exit 1 - fi - case $at_value in - 0*) # We want to treat leading 0 as decimal, like expr and test, but - # AS_VAR_ARITH treats it as octal if it uses $(( )). - # With XSI shells, ${at_value#${at_value%%[1-9]*}} avoids the - # expr fork, but it is not worth the effort to determine if the - # shell supports XSI when the user can just avoid leading 0. - eval $at_grp='`expr $at_value + 0`' ;; - esac - done -} - -at_prev= -for at_option -do - # If the previous option needs an argument, assign it. - if test -n "$at_prev"; then - at_option=$at_prev=$at_option - at_prev= - fi - - case $at_option in - *=?*) at_optarg=`expr "X$at_option" : '[^=]*=\(.*\)'` ;; - *) at_optarg= ;; - esac - - # Accept the important Cygnus configure options, so we can diagnose typos. - - case $at_option in - --help | -h ) - at_help_p=: - ;; - - --list | -l ) - at_list_p=: - ;; - - --version | -V ) - at_version_p=: - ;; - - --clean | -c ) - at_clean=: - ;; - - --color ) - at_color=always - ;; - --color=* ) - case $at_optarg in - no | never | none) at_color=never ;; - auto | tty | if-tty) at_color=auto ;; - always | yes | force) at_color=always ;; - *) at_optname=`echo " $at_option" | sed 's/^ //; s/=.*//'` - as_fn_error $? "unrecognized argument to $at_optname: $at_optarg" ;; - esac - ;; - - --debug | -d ) - at_debug_p=: - ;; - - --errexit | -e ) - at_debug_p=: - at_errexit_p=: - ;; - - --verbose | -v ) - at_verbose=; at_quiet=: - ;; - - --trace | -x ) - at_traceon='set -x' - at_trace_echo=echo - at_check_filter_trace=at_fn_filter_trace - ;; - - [0-9] | [0-9][0-9] | [0-9][0-9][0-9] | [0-9][0-9][0-9][0-9]) - at_fn_validate_ranges at_option - as_fn_append at_groups "$at_option$as_nl" - ;; - - # Ranges - [0-9]- | [0-9][0-9]- | [0-9][0-9][0-9]- | [0-9][0-9][0-9][0-9]-) - at_range_start=`echo $at_option |tr -d X-` - at_fn_validate_ranges at_range_start - at_range=`$as_echo "$at_groups_all" | \ - sed -ne '/^'$at_range_start'$/,$p'` - as_fn_append at_groups "$at_range$as_nl" - ;; - - -[0-9] | -[0-9][0-9] | -[0-9][0-9][0-9] | -[0-9][0-9][0-9][0-9]) - at_range_end=`echo $at_option |tr -d X-` - at_fn_validate_ranges at_range_end - at_range=`$as_echo "$at_groups_all" | \ - sed -ne '1,/^'$at_range_end'$/p'` - as_fn_append at_groups "$at_range$as_nl" - ;; - - [0-9]-[0-9] | [0-9]-[0-9][0-9] | [0-9]-[0-9][0-9][0-9] | \ - [0-9]-[0-9][0-9][0-9][0-9] | [0-9][0-9]-[0-9][0-9] | \ - [0-9][0-9]-[0-9][0-9][0-9] | [0-9][0-9]-[0-9][0-9][0-9][0-9] | \ - [0-9][0-9][0-9]-[0-9][0-9][0-9] | \ - [0-9][0-9][0-9]-[0-9][0-9][0-9][0-9] | \ - [0-9][0-9][0-9][0-9]-[0-9][0-9][0-9][0-9] ) - at_range_start=`expr $at_option : '\(.*\)-'` - at_range_end=`expr $at_option : '.*-\(.*\)'` - if test $at_range_start -gt $at_range_end; then - at_tmp=$at_range_end - at_range_end=$at_range_start - at_range_start=$at_tmp - fi - at_fn_validate_ranges at_range_start at_range_end - at_range=`$as_echo "$at_groups_all" | \ - sed -ne '/^'$at_range_start'$/,/^'$at_range_end'$/p'` - as_fn_append at_groups "$at_range$as_nl" - ;; - - # Directory selection. - --directory | -C ) - at_prev=--directory - ;; - --directory=* ) - at_change_dir=: - at_dir=$at_optarg - if test x- = "x$at_dir" ; then - at_dir=./- - fi - ;; - - # Parallel execution. - --jobs | -j ) - at_jobs=0 - ;; - --jobs=* | -j[0-9]* ) - if test -n "$at_optarg"; then - at_jobs=$at_optarg - else - at_jobs=`expr X$at_option : 'X-j\(.*\)'` - fi - case $at_jobs in *[!0-9]*) - at_optname=`echo " $at_option" | sed 's/^ //; s/[0-9=].*//'` - as_fn_error $? "non-numeric argument to $at_optname: $at_jobs" ;; - esac - ;; - - # Keywords. - --keywords | -k ) - at_prev=--keywords - ;; - --keywords=* ) - at_groups_selected=$at_help_all - at_save_IFS=$IFS - IFS=, - set X $at_optarg - shift - IFS=$at_save_IFS - for at_keyword - do - at_invert= - case $at_keyword in - '!'*) - at_invert="-v" - at_keyword=`expr "X$at_keyword" : 'X!\(.*\)'` - ;; - esac - # It is on purpose that we match the test group titles too. - at_groups_selected=`$as_echo "$at_groups_selected" | - grep -i $at_invert "^[1-9][^;]*;.*[; ]$at_keyword[ ;]"` - done - # Smash the keywords. - at_groups_selected=`$as_echo "$at_groups_selected" | sed 's/;.*//'` - as_fn_append at_groups "$at_groups_selected$as_nl" - ;; - --recheck) - at_recheck=: - ;; - - *=*) - at_envvar=`expr "x$at_option" : 'x\([^=]*\)='` - # Reject names that are not valid shell variable names. - case $at_envvar in - '' | [0-9]* | *[!_$as_cr_alnum]* ) - as_fn_error $? "invalid variable name: \`$at_envvar'" ;; - esac - at_value=`$as_echo "$at_optarg" | sed "s/'/'\\\\\\\\''/g"` - # Export now, but save eval for later and for debug scripts. - export $at_envvar - as_fn_append at_debug_args " $at_envvar='$at_value'" - ;; - - *) $as_echo "$as_me: invalid option: $at_option" >&2 - $as_echo "Try \`$0 --help' for more information." >&2 - exit 1 - ;; - esac -done - -# Verify our last option didn't require an argument -if test -n "$at_prev"; then : - as_fn_error $? "\`$at_prev' requires an argument" -fi - -# The file containing the suite. -at_suite_log=$at_dir/$as_me.log - -# Selected test groups. -if test -z "$at_groups$at_recheck"; then - at_groups=$at_groups_all -else - if test -n "$at_recheck" && test -r "$at_suite_log"; then - at_oldfails=`sed -n ' - /^Failed tests:$/,/^Skipped tests:$/{ - s/^[ ]*\([1-9][0-9]*\):.*/\1/p - } - /^Unexpected passes:$/,/^## Detailed failed tests/{ - s/^[ ]*\([1-9][0-9]*\):.*/\1/p - } - /^## Detailed failed tests/q - ' "$at_suite_log"` - as_fn_append at_groups "$at_oldfails$as_nl" - fi - # Sort the tests, removing duplicates. - at_groups=`$as_echo "$at_groups" | sort -nu | sed '/^$/d'` -fi - -if test x"$at_color" = xalways \ - || { test x"$at_color" = xauto && test -t 1; }; then - at_red=`printf '\033[0;31m'` - at_grn=`printf '\033[0;32m'` - at_lgn=`printf '\033[1;32m'` - at_blu=`printf '\033[1;34m'` - at_std=`printf '\033[m'` -else - at_red= at_grn= at_lgn= at_blu= at_std= -fi - -# Help message. -if $at_help_p; then - cat <<_ATEOF || at_write_fail=1 -Usage: $0 [OPTION]... [VARIABLE=VALUE]... [TESTS] - -Run all the tests, or the selected TESTS, given by numeric ranges, and -save a detailed log file. Upon failure, create debugging scripts. - -Do not change environment variables directly. Instead, set them via -command line arguments. Set \`AUTOTEST_PATH' to select the executables -to exercise. Each relative directory is expanded as build and source -directories relative to the top level of this distribution. -E.g., from within the build directory /tmp/foo-1.0, invoking this: - - $ $0 AUTOTEST_PATH=bin - -is equivalent to the following, assuming the source directory is /src/foo-1.0: - - PATH=/tmp/foo-1.0/bin:/src/foo-1.0/bin:\$PATH $0 -_ATEOF -cat <<_ATEOF || at_write_fail=1 - -Operation modes: - -h, --help print the help message, then exit - -V, --version print version number, then exit - -c, --clean remove all the files this test suite might create and exit - -l, --list describes all the tests, or the selected TESTS -_ATEOF -cat <<_ATEOF || at_write_fail=1 - -Execution tuning: - -C, --directory=DIR - change to directory DIR before starting - --color[=never|auto|always] - disable colored test results, or enable even without terminal - -j, --jobs[=N] - Allow N jobs at once; infinite jobs with no arg (default 1) - -k, --keywords=KEYWORDS - select the tests matching all the comma-separated KEYWORDS - multiple \`-k' accumulate; prefixed \`!' negates a KEYWORD - --recheck select all tests that failed or passed unexpectedly last time - -e, --errexit abort as soon as a test fails; implies --debug - -v, --verbose force more detailed output - default for debugging scripts - -d, --debug inhibit clean up and top-level logging - default for debugging scripts - -x, --trace enable tests shell tracing -_ATEOF -cat <<_ATEOF || at_write_fail=1 - -Report bugs to . -GnuCOBOL home page: . -_ATEOF - exit $at_write_fail -fi - -# List of tests. -if $at_list_p; then - cat <<_ATEOF || at_write_fail=1 -GnuCOBOL 4.0-early-dev test suite: GnuCOBOL Manual Tests test groups: - - NUM: FILE-NAME:LINE TEST-GROUP-NAME - KEYWORDS - -_ATEOF - # Pass an empty line as separator between selected groups and help. - $as_echo "$at_groups$as_nl$as_nl$at_help_all" | - awk 'NF == 1 && FS != ";" { - selected[$ 1] = 1 - next - } - /^$/ { FS = ";" } - NF > 0 { - if (selected[$ 1]) { - printf " %3d: %-18s %s\n", $ 1, $ 2, $ 3 - if ($ 4) { - lmax = 79 - indent = " " - line = indent - len = length (line) - n = split ($ 4, a, " ") - for (i = 1; i <= n; i++) { - l = length (a[i]) + 1 - if (i > 1 && len + l > lmax) { - print line - line = indent " " a[i] - len = length (line) - } else { - line = line " " a[i] - len += l - } - } - if (n) - print line - } - } - }' || at_write_fail=1 - exit $at_write_fail -fi -if $at_version_p; then - $as_echo "$as_me (GnuCOBOL 4.0-early-dev)" && - cat <<\_ATEOF || at_write_fail=1 - -Test cases Copyright (C) 2018 Free Software Foundation, Inc. - -Written by Edward Hart, Simon Sobisch - -Copyright (C) 2012 Free Software Foundation, Inc. -This test suite is free software; the Free Software Foundation gives -unlimited permission to copy, distribute and modify it. -_ATEOF - exit $at_write_fail -fi - -# Should we print banners? Yes if more than one test is run. -case $at_groups in #( - *$as_nl* ) - at_print_banners=: ;; #( - * ) at_print_banners=false ;; -esac -# Text for banner N, set to a single space once printed. -# Banner 1. testsuite_manual.at:32 -# Category starts at test group 1. -at_banner_text_1="Run screen tests" - -# Take any -C into account. -if $at_change_dir ; then - test x != "x$at_dir" && cd "$at_dir" \ - || as_fn_error $? "unable to change directory" - at_dir=`pwd` -fi - -# Load the config files for any default variable assignments. -for at_file in atconfig atlocal -do - test -r $at_file || continue - . ./$at_file || as_fn_error $? "invalid content: $at_file" -done - -# Autoconf <=2.59b set at_top_builddir instead of at_top_build_prefix: -: "${at_top_build_prefix=$at_top_builddir}" - -# Perform any assignments requested during argument parsing. -eval "$at_debug_args" - -# atconfig delivers names relative to the directory the test suite is -# in, but the groups themselves are run in testsuite-dir/group-dir. -if test -n "$at_top_srcdir"; then - builddir=../.. - for at_dir_var in srcdir top_srcdir top_build_prefix - do - eval at_val=\$at_$at_dir_var - case $at_val in - [\\/$]* | ?:[\\/]* ) at_prefix= ;; - *) at_prefix=../../ ;; - esac - eval "$at_dir_var=\$at_prefix\$at_val" - done -fi - -## -------------------- ## -## Directory structure. ## -## -------------------- ## - -# This is the set of directories and files used by this script -# (non-literals are capitalized): -# -# TESTSUITE - the testsuite -# TESTSUITE.log - summarizes the complete testsuite run -# TESTSUITE.dir/ - created during a run, remains after -d or failed test -# + at-groups/ - during a run: status of all groups in run -# | + NNN/ - during a run: meta-data about test group NNN -# | | + check-line - location (source file and line) of current AT_CHECK -# | | + status - exit status of current AT_CHECK -# | | + stdout - stdout of current AT_CHECK -# | | + stder1 - stderr, including trace -# | | + stderr - stderr, with trace filtered out -# | | + test-source - portion of testsuite that defines group -# | | + times - timestamps for computing duration -# | | + pass - created if group passed -# | | + xpass - created if group xpassed -# | | + fail - created if group failed -# | | + xfail - created if group xfailed -# | | + skip - created if group skipped -# + at-stop - during a run: end the run if this file exists -# + at-source-lines - during a run: cache of TESTSUITE line numbers for extraction -# + 0..NNN/ - created for each group NNN, remains after -d or failed test -# | + TESTSUITE.log - summarizes the group results -# | + ... - files created during the group - -# The directory the whole suite works in. -# Should be absolute to let the user `cd' at will. -at_suite_dir=$at_dir/$as_me.dir -# The file containing the suite ($at_dir might have changed since earlier). -at_suite_log=$at_dir/$as_me.log -# The directory containing helper files per test group. -at_helper_dir=$at_suite_dir/at-groups -# Stop file: if it exists, do not start new jobs. -at_stop_file=$at_suite_dir/at-stop -# The fifo used for the job dispatcher. -at_job_fifo=$at_suite_dir/at-job-fifo - -if $at_clean; then - test -d "$at_suite_dir" && - find "$at_suite_dir" -type d ! -perm -700 -exec chmod u+rwx \{\} \; - rm -f -r "$at_suite_dir" "$at_suite_log" - exit $? -fi - -# Don't take risks: use only absolute directories in PATH. -# -# For stand-alone test suites (ie. atconfig was not found), -# AUTOTEST_PATH is relative to `.'. -# -# For embedded test suites, AUTOTEST_PATH is relative to the top level -# of the package. Then expand it into build/src parts, since users -# may create executables in both places. -AUTOTEST_PATH=`$as_echo "$AUTOTEST_PATH" | sed "s|:|$PATH_SEPARATOR|g"` -at_path= -as_save_IFS=$IFS; IFS=$PATH_SEPARATOR -for as_dir in $AUTOTEST_PATH $PATH -do - IFS=$as_save_IFS - test -z "$as_dir" && as_dir=. - test -n "$at_path" && as_fn_append at_path $PATH_SEPARATOR -case $as_dir in - [\\/]* | ?:[\\/]* ) - as_fn_append at_path "$as_dir" - ;; - * ) - if test -z "$at_top_build_prefix"; then - # Stand-alone test suite. - as_fn_append at_path "$as_dir" - else - # Embedded test suite. - as_fn_append at_path "$at_top_build_prefix$as_dir$PATH_SEPARATOR" - as_fn_append at_path "$at_top_srcdir/$as_dir" - fi - ;; -esac - done -IFS=$as_save_IFS - - -# Now build and simplify PATH. -# -# There might be directories that don't exist, but don't redirect -# builtins' (eg., cd) stderr directly: Ultrix's sh hates that. -at_new_path= -as_save_IFS=$IFS; IFS=$PATH_SEPARATOR -for as_dir in $at_path -do - IFS=$as_save_IFS - test -z "$as_dir" && as_dir=. - test -d "$as_dir" || continue -case $as_dir in - [\\/]* | ?:[\\/]* ) ;; - * ) as_dir=`(cd "$as_dir" && pwd) 2>/dev/null` ;; -esac -case $PATH_SEPARATOR$at_new_path$PATH_SEPARATOR in - *$PATH_SEPARATOR$as_dir$PATH_SEPARATOR*) ;; - $PATH_SEPARATOR$PATH_SEPARATOR) at_new_path=$as_dir ;; - *) as_fn_append at_new_path "$PATH_SEPARATOR$as_dir" ;; -esac - done -IFS=$as_save_IFS - -PATH=$at_new_path -export PATH - -# Setting up the FDs. - - - -# 5 is the log file. Not to be overwritten if `-d'. -if $at_debug_p; then - at_suite_log=/dev/null -else - : >"$at_suite_log" -fi -exec 5>>"$at_suite_log" - -# Banners and logs. -$as_echo "## --------------------------------------------------------- ## -## GnuCOBOL 4.0-early-dev test suite: GnuCOBOL Manual Tests. ## -## --------------------------------------------------------- ##" -{ - $as_echo "## --------------------------------------------------------- ## -## GnuCOBOL 4.0-early-dev test suite: GnuCOBOL Manual Tests. ## -## --------------------------------------------------------- ##" - echo - - $as_echo "$as_me: command line was:" - $as_echo " \$ $0 $at_cli_args" - echo - - # If ChangeLog exists, list a few lines in case it might help determining - # the exact version. - if test -n "$at_top_srcdir" && test -f "$at_top_srcdir/ChangeLog"; then - $as_echo "## ---------- ## -## ChangeLog. ## -## ---------- ##" - echo - sed 's/^/| /;10q' "$at_top_srcdir/ChangeLog" - echo - fi - - { -cat <<_ASUNAME -## --------- ## -## Platform. ## -## --------- ## - -hostname = `(hostname || uname -n) 2>/dev/null | sed 1q` -uname -m = `(uname -m) 2>/dev/null || echo unknown` -uname -r = `(uname -r) 2>/dev/null || echo unknown` -uname -s = `(uname -s) 2>/dev/null || echo unknown` -uname -v = `(uname -v) 2>/dev/null || echo unknown` - -/usr/bin/uname -p = `(/usr/bin/uname -p) 2>/dev/null || echo unknown` -/bin/uname -X = `(/bin/uname -X) 2>/dev/null || echo unknown` - -/bin/arch = `(/bin/arch) 2>/dev/null || echo unknown` -/usr/bin/arch -k = `(/usr/bin/arch -k) 2>/dev/null || echo unknown` -/usr/convex/getsysinfo = `(/usr/convex/getsysinfo) 2>/dev/null || echo unknown` -/usr/bin/hostinfo = `(/usr/bin/hostinfo) 2>/dev/null || echo unknown` -/bin/machine = `(/bin/machine) 2>/dev/null || echo unknown` -/usr/bin/oslevel = `(/usr/bin/oslevel) 2>/dev/null || echo unknown` -/bin/universe = `(/bin/universe) 2>/dev/null || echo unknown` - -_ASUNAME - -as_save_IFS=$IFS; IFS=$PATH_SEPARATOR -for as_dir in $PATH -do - IFS=$as_save_IFS - test -z "$as_dir" && as_dir=. - $as_echo "PATH: $as_dir" - done -IFS=$as_save_IFS - -} - echo - - # Contents of the config files. - for at_file in atconfig atlocal - do - test -r $at_file || continue - $as_echo "$as_me: $at_file:" - sed 's/^/| /' $at_file - echo - done -} >&5 - - -## ------------------------- ## -## Autotest shell functions. ## -## ------------------------- ## - -# at_fn_banner NUMBER -# ------------------- -# Output banner NUMBER, provided the testsuite is running multiple groups and -# this particular banner has not yet been printed. -at_fn_banner () -{ - $at_print_banners || return 0 - eval at_banner_text=\$at_banner_text_$1 - test "x$at_banner_text" = "x " && return 0 - eval "at_banner_text_$1=\" \"" - if test -z "$at_banner_text"; then - $at_first || echo - else - $as_echo "$as_nl$at_banner_text$as_nl" - fi -} # at_fn_banner - -# at_fn_check_prepare_notrace REASON LINE -# --------------------------------------- -# Perform AT_CHECK preparations for the command at LINE for an untraceable -# command; REASON is the reason for disabling tracing. -at_fn_check_prepare_notrace () -{ - $at_trace_echo "Not enabling shell tracing (command contains $1)" - $as_echo "$2" >"$at_check_line_file" - at_check_trace=: at_check_filter=: - : >"$at_stdout"; : >"$at_stderr" -} - -# at_fn_check_prepare_trace LINE -# ------------------------------ -# Perform AT_CHECK preparations for the command at LINE for a traceable -# command. -at_fn_check_prepare_trace () -{ - $as_echo "$1" >"$at_check_line_file" - at_check_trace=$at_traceon at_check_filter=$at_check_filter_trace - : >"$at_stdout"; : >"$at_stderr" -} - -# at_fn_check_prepare_dynamic COMMAND LINE -# ---------------------------------------- -# Decide if COMMAND at LINE is traceable at runtime, and call the appropriate -# preparation function. -at_fn_check_prepare_dynamic () -{ - case $1 in - *$as_nl*) - at_fn_check_prepare_notrace 'an embedded newline' "$2" ;; - *) - at_fn_check_prepare_trace "$2" ;; - esac -} - -# at_fn_filter_trace -# ------------------ -# Remove the lines in the file "$at_stderr" generated by "set -x" and print -# them to stderr. -at_fn_filter_trace () -{ - mv "$at_stderr" "$at_stder1" - grep '^ *+' "$at_stder1" >&2 - grep -v '^ *+' "$at_stder1" >"$at_stderr" -} - -# at_fn_log_failure FILE-LIST -# --------------------------- -# Copy the files in the list on stdout with a "> " prefix, and exit the shell -# with a failure exit code. -at_fn_log_failure () -{ - for file - do $as_echo "$file:"; sed 's/^/> /' "$file"; done - echo 1 > "$at_status_file" - exit 1 -} - -# at_fn_check_skip EXIT-CODE LINE -# ------------------------------- -# Check whether EXIT-CODE is a special exit code (77 or 99), and if so exit -# the test group subshell with that same exit code. Use LINE in any report -# about test failure. -at_fn_check_skip () -{ - case $1 in - 99) echo 99 > "$at_status_file"; at_failed=: - $as_echo "$2: hard failure"; exit 99;; - 77) echo 77 > "$at_status_file"; exit 77;; - esac -} - -# at_fn_check_status EXPECTED EXIT-CODE LINE -# ------------------------------------------ -# Check whether EXIT-CODE is the EXPECTED exit code, and if so do nothing. -# Otherwise, if it is 77 or 99, exit the test group subshell with that same -# exit code; if it is anything else print an error message referring to LINE, -# and fail the test. -at_fn_check_status () -{ - case $2 in - $1 ) ;; - 77) echo 77 > "$at_status_file"; exit 77;; - 99) echo 99 > "$at_status_file"; at_failed=: - $as_echo "$3: hard failure"; exit 99;; - *) $as_echo "$3: exit code was $2, expected $1" - at_failed=:;; - esac -} - -# at_fn_diff_devnull FILE -# ----------------------- -# Emit a diff between /dev/null and FILE. Uses "test -s" to avoid useless diff -# invocations. -at_fn_diff_devnull () -{ - test -s "$1" || return 0 - $at_diff "$at_devnull" "$1" -} - -# at_fn_test NUMBER -# ----------------- -# Parse out test NUMBER from the tail of this file. -at_fn_test () -{ - eval at_sed=\$at_sed$1 - sed "$at_sed" "$at_myself" > "$at_test_source" -} - -# at_fn_create_debugging_script -# ----------------------------- -# Create the debugging script $at_group_dir/run which will reproduce the -# current test group. -at_fn_create_debugging_script () -{ - { - echo "#! /bin/sh" && - echo 'test "${ZSH_VERSION+set}" = set && alias -g '\''${1+"$@"}'\''='\''"$@"'\''' && - $as_echo "cd '$at_dir'" && - $as_echo "exec \${CONFIG_SHELL-$SHELL} \"$at_myself\" -v -d $at_debug_args $at_group \${1+\"\$@\"}" && - echo 'exit 1' - } >"$at_group_dir/run" && - chmod +x "$at_group_dir/run" -} - -## -------------------------------- ## -## End of autotest shell functions. ## -## -------------------------------- ## -{ - $as_echo "## ---------------- ## -## Tested programs. ## -## ---------------- ##" - echo -} >&5 - -# Report what programs are being tested. -for at_program in : $at_tested -do - test "$at_program" = : && continue - case $at_program in - [\\/]* | ?:[\\/]* ) $at_program_=$at_program ;; - * ) - as_save_IFS=$IFS; IFS=$PATH_SEPARATOR -for as_dir in $PATH -do - IFS=$as_save_IFS - test -z "$as_dir" && as_dir=. - test -f "$as_dir/$at_program" && break - done -IFS=$as_save_IFS - - at_program_=$as_dir/$at_program ;; - esac - if test -f "$at_program_"; then - { - $as_echo "$at_srcdir/testsuite_manual.at:25: $at_program_ --version" - "$at_program_" --version &5 2>&1 - else - as_fn_error $? "cannot find $at_program" "$LINENO" 5 - fi -done - -{ - $as_echo "## ------------------ ## -## Running the tests. ## -## ------------------ ##" -} >&5 - -at_start_date=`date` -at_start_time=`date +%s 2>/dev/null` -$as_echo "$as_me: starting at: $at_start_date" >&5 - -# Create the master directory if it doesn't already exist. -as_dir="$at_suite_dir"; as_fn_mkdir_p || - as_fn_error $? "cannot create \`$at_suite_dir'" "$LINENO" 5 - -# Can we diff with `/dev/null'? DU 5.0 refuses. -if diff /dev/null /dev/null >/dev/null 2>&1; then - at_devnull=/dev/null -else - at_devnull=$at_suite_dir/devnull - >"$at_devnull" -fi - -# Use `diff -u' when possible. -if at_diff=`diff -u "$at_devnull" "$at_devnull" 2>&1` && test -z "$at_diff" -then - at_diff='diff -u' -else - at_diff=diff -fi - -# Get the last needed group. -for at_group in : $at_groups; do :; done - -# Extract the start and end lines of each test group at the tail -# of this file -awk ' -BEGIN { FS="" } -/^#AT_START_/ { - start = NR -} -/^#AT_STOP_/ { - test = substr ($ 0, 10) - print "at_sed" test "=\"1," start "d;" (NR-1) "q\"" - if (test == "'"$at_group"'") exit -}' "$at_myself" > "$at_suite_dir/at-source-lines" && -. "$at_suite_dir/at-source-lines" || - as_fn_error $? "cannot create test line number cache" "$LINENO" 5 -rm -f "$at_suite_dir/at-source-lines" - -# Set number of jobs for `-j'; avoid more jobs than test groups. -set X $at_groups; shift; at_max_jobs=$# -if test $at_max_jobs -eq 0; then - at_jobs=1 -fi -if test $at_jobs -ne 1 && - { test $at_jobs -eq 0 || test $at_jobs -gt $at_max_jobs; }; then - at_jobs=$at_max_jobs -fi - -# If parallel mode, don't output banners, don't split summary lines. -if test $at_jobs -ne 1; then - at_print_banners=false - at_quiet=: -fi - -# Set up helper dirs. -rm -rf "$at_helper_dir" && -mkdir "$at_helper_dir" && -cd "$at_helper_dir" && -{ test -z "$at_groups" || mkdir $at_groups; } || -as_fn_error $? "testsuite directory setup failed" "$LINENO" 5 - -# Functions for running a test group. We leave the actual -# test group execution outside of a shell function in order -# to avoid hitting zsh 4.x exit status bugs. - -# at_fn_group_prepare -# ------------------- -# Prepare for running a test group. -at_fn_group_prepare () -{ - # The directory for additional per-group helper files. - at_job_dir=$at_helper_dir/$at_group - # The file containing the location of the last AT_CHECK. - at_check_line_file=$at_job_dir/check-line - # The file containing the exit status of the last command. - at_status_file=$at_job_dir/status - # The files containing the output of the tested commands. - at_stdout=$at_job_dir/stdout - at_stder1=$at_job_dir/stder1 - at_stderr=$at_job_dir/stderr - # The file containing the code for a test group. - at_test_source=$at_job_dir/test-source - # The file containing dates. - at_times_file=$at_job_dir/times - - # Be sure to come back to the top test directory. - cd "$at_suite_dir" - - # Clearly separate the test groups when verbose. - $at_first || $at_verbose echo - - at_group_normalized=$at_group - - eval 'while :; do - case $at_group_normalized in #( - '"$at_format"'*) break;; - esac - at_group_normalized=0$at_group_normalized - done' - - - # Create a fresh directory for the next test group, and enter. - # If one already exists, the user may have invoked ./run from - # within that directory; we remove the contents, but not the - # directory itself, so that we aren't pulling the rug out from - # under the shell's notion of the current directory. - at_group_dir=$at_suite_dir/$at_group_normalized - at_group_log=$at_group_dir/$as_me.log - if test -d "$at_group_dir"; then - find "$at_group_dir" -type d ! -perm -700 -exec chmod u+rwx {} \; - rm -fr "$at_group_dir"/* "$at_group_dir"/.[!.] "$at_group_dir"/.??* -fi || - { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: test directory for $at_group_normalized could not be cleaned" >&5 -$as_echo "$as_me: WARNING: test directory for $at_group_normalized could not be cleaned" >&2;} - # Be tolerant if the above `rm' was not able to remove the directory. - as_dir="$at_group_dir"; as_fn_mkdir_p - - echo 0 > "$at_status_file" - - # In verbose mode, append to the log file *and* show on - # the standard output; in quiet mode only write to the log. - if test -z "$at_verbose"; then - at_tee_pipe='tee -a "$at_group_log"' - else - at_tee_pipe='cat >> "$at_group_log"' - fi -} - -# at_fn_group_banner ORDINAL LINE DESC PAD [BANNER] -# ------------------------------------------------- -# Declare the test group ORDINAL, located at LINE with group description DESC, -# and residing under BANNER. Use PAD to align the status column. -at_fn_group_banner () -{ - at_setup_line="$2" - test -n "$5" && at_fn_banner $5 - at_desc="$3" - case $1 in - [0-9]) at_desc_line=" $1: ";; - [0-9][0-9]) at_desc_line=" $1: " ;; - *) at_desc_line="$1: " ;; - esac - as_fn_append at_desc_line "$3$4" - $at_quiet $as_echo_n "$at_desc_line" - echo "# -*- compilation -*-" >> "$at_group_log" -} - -# at_fn_group_postprocess -# ----------------------- -# Perform cleanup after running a test group. -at_fn_group_postprocess () -{ - # Be sure to come back to the suite directory, in particular - # since below we might `rm' the group directory we are in currently. - cd "$at_suite_dir" - - if test ! -f "$at_check_line_file"; then - sed "s/^ */$as_me: WARNING: /" <<_ATEOF - A failure happened in a test group before any test could be - run. This means that test suite is improperly designed. Please - report this failure to . -_ATEOF - $as_echo "$at_setup_line" >"$at_check_line_file" - at_status=99 - fi - $at_verbose $as_echo_n "$at_group. $at_setup_line: " - $as_echo_n "$at_group. $at_setup_line: " >> "$at_group_log" - case $at_xfail:$at_status in - yes:0) - at_msg="UNEXPECTED PASS" - at_res=xpass - at_errexit=$at_errexit_p - at_color=$at_red - ;; - no:0) - at_msg="ok" - at_res=pass - at_errexit=false - at_color=$at_grn - ;; - *:77) - at_msg='skipped ('`cat "$at_check_line_file"`')' - at_res=skip - at_errexit=false - at_color=$at_blu - ;; - no:* | *:99) - at_msg='FAILED ('`cat "$at_check_line_file"`')' - at_res=fail - at_errexit=$at_errexit_p - at_color=$at_red - ;; - yes:*) - at_msg='expected failure ('`cat "$at_check_line_file"`')' - at_res=xfail - at_errexit=false - at_color=$at_lgn - ;; - esac - echo "$at_res" > "$at_job_dir/$at_res" - # In parallel mode, output the summary line only afterwards. - if test $at_jobs -ne 1 && test -n "$at_verbose"; then - $as_echo "$at_desc_line $at_color$at_msg$at_std" - else - # Make sure there is a separator even with long titles. - $as_echo " $at_color$at_msg$at_std" - fi - at_log_msg="$at_group. $at_desc ($at_setup_line): $at_msg" - case $at_status in - 0|77) - # $at_times_file is only available if the group succeeded. - # We're not including the group log, so the success message - # is written in the global log separately. But we also - # write to the group log in case they're using -d. - if test -f "$at_times_file"; then - at_log_msg="$at_log_msg ("`sed 1d "$at_times_file"`')' - rm -f "$at_times_file" - fi - $as_echo "$at_log_msg" >> "$at_group_log" - $as_echo "$at_log_msg" >&5 - - # Cleanup the group directory, unless the user wants the files - # or the success was unexpected. - if $at_debug_p || test $at_res = xpass; then - at_fn_create_debugging_script - if test $at_res = xpass && $at_errexit; then - echo stop > "$at_stop_file" - fi - else - if test -d "$at_group_dir"; then - find "$at_group_dir" -type d ! -perm -700 -exec chmod u+rwx \{\} \; - rm -fr "$at_group_dir" - fi - rm -f "$at_test_source" - fi - ;; - *) - # Upon failure, include the log into the testsuite's global - # log. The failure message is written in the group log. It - # is later included in the global log. - $as_echo "$at_log_msg" >> "$at_group_log" - - # Upon failure, keep the group directory for autopsy, and create - # the debugging script. With -e, do not start any further tests. - at_fn_create_debugging_script - if $at_errexit; then - echo stop > "$at_stop_file" - fi - ;; - esac -} - - -## ------------ ## -## Driver loop. ## -## ------------ ## - - -if (set -m && set +m && set +b) >/dev/null 2>&1; then - set +b - at_job_control_on='set -m' at_job_control_off='set +m' at_job_group=- -else - at_job_control_on=: at_job_control_off=: at_job_group= -fi - -for at_signal in 1 2 15; do - trap 'set +x; set +e - $at_job_control_off - at_signal='"$at_signal"' - echo stop > "$at_stop_file" - trap "" $at_signal - at_pgids= - for at_pgid in `jobs -p 2>/dev/null`; do - at_pgids="$at_pgids $at_job_group$at_pgid" - done - test -z "$at_pgids" || kill -$at_signal $at_pgids 2>/dev/null - wait - if test "$at_jobs" -eq 1 || test -z "$at_verbose"; then - echo >&2 - fi - at_signame=`kill -l $at_signal 2>&1 || echo $at_signal` - set x $at_signame - test 1 -gt 2 && at_signame=$at_signal - { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: caught signal $at_signame, bailing out" >&5 -$as_echo "$as_me: WARNING: caught signal $at_signame, bailing out" >&2;} - as_fn_arith 128 + $at_signal && exit_status=$as_val - as_fn_exit $exit_status' $at_signal -done - -rm -f "$at_stop_file" -at_first=: - -if test $at_jobs -ne 1 && - rm -f "$at_job_fifo" && - test -n "$at_job_group" && - ( mkfifo "$at_job_fifo" && trap 'exit 1' PIPE STOP TSTP ) 2>/dev/null -then - # FIFO job dispatcher. - - trap 'at_pids= - for at_pid in `jobs -p`; do - at_pids="$at_pids $at_job_group$at_pid" - done - if test -n "$at_pids"; then - at_sig=TSTP - test "${TMOUT+set}" = set && at_sig=STOP - kill -$at_sig $at_pids 2>/dev/null - fi - kill -STOP $$ - test -z "$at_pids" || kill -CONT $at_pids 2>/dev/null' TSTP - - echo - # Turn jobs into a list of numbers, starting from 1. - at_joblist=`$as_echo "$at_groups" | sed -n 1,${at_jobs}p` - - set X $at_joblist - shift - for at_group in $at_groups; do - $at_job_control_on 2>/dev/null - ( - # Start one test group. - $at_job_control_off - if $at_first; then - exec 7>"$at_job_fifo" - else - exec 6<&- - fi - trap 'set +x; set +e - trap "" PIPE - echo stop > "$at_stop_file" - echo >&7 - as_fn_exit 141' PIPE - at_fn_group_prepare - if cd "$at_group_dir" && - at_fn_test $at_group && - . "$at_test_source" - then :; else - { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: unable to parse test group: $at_group" >&5 -$as_echo "$as_me: WARNING: unable to parse test group: $at_group" >&2;} - at_failed=: - fi - at_fn_group_postprocess - echo >&7 - ) & - $at_job_control_off - if $at_first; then - at_first=false - exec 6<"$at_job_fifo" 7>"$at_job_fifo" - fi - shift # Consume one token. - if test $# -gt 0; then :; else - read at_token <&6 || break - set x $* - fi - test -f "$at_stop_file" && break - done - exec 7>&- - # Read back the remaining ($at_jobs - 1) tokens. - set X $at_joblist - shift - if test $# -gt 0; then - shift - for at_job - do - read at_token - done <&6 - fi - exec 6<&- - wait -else - # Run serially, avoid forks and other potential surprises. - for at_group in $at_groups; do - at_fn_group_prepare - if cd "$at_group_dir" && - at_fn_test $at_group && - . "$at_test_source"; then :; else - { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: unable to parse test group: $at_group" >&5 -$as_echo "$as_me: WARNING: unable to parse test group: $at_group" >&2;} - at_failed=: - fi - at_fn_group_postprocess - test -f "$at_stop_file" && break - at_first=false - done -fi - -# Wrap up the test suite with summary statistics. -cd "$at_helper_dir" - -# Use ?..???? when the list must remain sorted, the faster * otherwise. -at_pass_list=`for f in */pass; do echo $f; done | sed '/\*/d; s,/pass,,'` -at_skip_list=`for f in */skip; do echo $f; done | sed '/\*/d; s,/skip,,'` -at_xfail_list=`for f in */xfail; do echo $f; done | sed '/\*/d; s,/xfail,,'` -at_xpass_list=`for f in ?/xpass ??/xpass ???/xpass ????/xpass; do - echo $f; done | sed '/?/d; s,/xpass,,'` -at_fail_list=`for f in ?/fail ??/fail ???/fail ????/fail; do - echo $f; done | sed '/?/d; s,/fail,,'` - -set X $at_pass_list $at_xpass_list $at_xfail_list $at_fail_list $at_skip_list -shift; at_group_count=$# -set X $at_xpass_list; shift; at_xpass_count=$#; at_xpass_list=$* -set X $at_xfail_list; shift; at_xfail_count=$# -set X $at_fail_list; shift; at_fail_count=$#; at_fail_list=$* -set X $at_skip_list; shift; at_skip_count=$# - -as_fn_arith $at_group_count - $at_skip_count && at_run_count=$as_val -as_fn_arith $at_xpass_count + $at_fail_count && at_unexpected_count=$as_val -as_fn_arith $at_xfail_count + $at_fail_count && at_total_fail_count=$as_val - -# Back to the top directory. -cd "$at_dir" -rm -rf "$at_helper_dir" - -# Compute the duration of the suite. -at_stop_date=`date` -at_stop_time=`date +%s 2>/dev/null` -$as_echo "$as_me: ending at: $at_stop_date" >&5 -case $at_start_time,$at_stop_time in - [0-9]*,[0-9]*) - as_fn_arith $at_stop_time - $at_start_time && at_duration_s=$as_val - as_fn_arith $at_duration_s / 60 && at_duration_m=$as_val - as_fn_arith $at_duration_m / 60 && at_duration_h=$as_val - as_fn_arith $at_duration_s % 60 && at_duration_s=$as_val - as_fn_arith $at_duration_m % 60 && at_duration_m=$as_val - at_duration="${at_duration_h}h ${at_duration_m}m ${at_duration_s}s" - $as_echo "$as_me: test suite duration: $at_duration" >&5 - ;; -esac - -echo -$as_echo "## ------------- ## -## Test results. ## -## ------------- ##" -echo -{ - echo - $as_echo "## ------------- ## -## Test results. ## -## ------------- ##" - echo -} >&5 - -if test $at_run_count = 1; then - at_result="1 test" - at_were=was -else - at_result="$at_run_count tests" - at_were=were -fi -if $at_errexit_p && test $at_unexpected_count != 0; then - if test $at_xpass_count = 1; then - at_result="$at_result $at_were run, one passed" - else - at_result="$at_result $at_were run, one failed" - fi - at_result="$at_result unexpectedly and inhibited subsequent tests." - at_color=$at_red -else - # Don't you just love exponential explosion of the number of cases? - at_color=$at_red - case $at_xpass_count:$at_fail_count:$at_xfail_count in - # So far, so good. - 0:0:0) at_result="$at_result $at_were successful." at_color=$at_grn ;; - 0:0:*) at_result="$at_result behaved as expected." at_color=$at_lgn ;; - - # Some unexpected failures - 0:*:0) at_result="$at_result $at_were run, -$at_fail_count failed unexpectedly." ;; - - # Some failures, both expected and unexpected - 0:*:1) at_result="$at_result $at_were run, -$at_total_fail_count failed ($at_xfail_count expected failure)." ;; - 0:*:*) at_result="$at_result $at_were run, -$at_total_fail_count failed ($at_xfail_count expected failures)." ;; - - # No unexpected failures, but some xpasses - *:0:*) at_result="$at_result $at_were run, -$at_xpass_count passed unexpectedly." ;; - - # No expected failures, but failures and xpasses - *:1:0) at_result="$at_result $at_were run, -$at_unexpected_count did not behave as expected ($at_fail_count unexpected failure)." ;; - *:*:0) at_result="$at_result $at_were run, -$at_unexpected_count did not behave as expected ($at_fail_count unexpected failures)." ;; - - # All of them. - *:*:1) at_result="$at_result $at_were run, -$at_xpass_count passed unexpectedly, -$at_total_fail_count failed ($at_xfail_count expected failure)." ;; - *:*:*) at_result="$at_result $at_were run, -$at_xpass_count passed unexpectedly, -$at_total_fail_count failed ($at_xfail_count expected failures)." ;; - esac - - if test $at_skip_count = 0 && test $at_run_count -gt 1; then - at_result="All $at_result" - fi -fi - -# Now put skips in the mix. -case $at_skip_count in - 0) ;; - 1) at_result="$at_result -1 test was skipped." ;; - *) at_result="$at_result -$at_skip_count tests were skipped." ;; -esac - -if test $at_unexpected_count = 0; then - echo "$at_color$at_result$at_std" - echo "$at_result" >&5 -else - echo "${at_color}ERROR: $at_result$at_std" >&2 - echo "ERROR: $at_result" >&5 - { - echo - $as_echo "## ------------------------ ## -## Summary of the failures. ## -## ------------------------ ##" - - # Summary of failed and skipped tests. - if test $at_fail_count != 0; then - echo "Failed tests:" - $SHELL "$at_myself" $at_fail_list --list - echo - fi - if test $at_skip_count != 0; then - echo "Skipped tests:" - $SHELL "$at_myself" $at_skip_list --list - echo - fi - if test $at_xpass_count != 0; then - echo "Unexpected passes:" - $SHELL "$at_myself" $at_xpass_list --list - echo - fi - if test $at_fail_count != 0; then - $as_echo "## ---------------------- ## -## Detailed failed tests. ## -## ---------------------- ##" - echo - for at_group in $at_fail_list - do - at_group_normalized=$at_group - - eval 'while :; do - case $at_group_normalized in #( - '"$at_format"'*) break;; - esac - at_group_normalized=0$at_group_normalized - done' - - cat "$at_suite_dir/$at_group_normalized/$as_me.log" - echo - done - echo - fi - if test -n "$at_top_srcdir"; then - sed 'h;s/./-/g;s/^.../## /;s/...$/ ##/;p;x;p;x' <<_ASBOX -## ${at_top_build_prefix}config.log ## -_ASBOX - sed 's/^/| /' ${at_top_build_prefix}config.log - echo - fi - } >&5 - - sed 'h;s/./-/g;s/^.../## /;s/...$/ ##/;p;x;p;x' <<_ASBOX -## $as_me.log was created. ## -_ASBOX - - echo - if $at_debug_p; then - at_msg='per-test log files' - else - at_msg="\`${at_testdir+${at_testdir}/}$as_me.log'" - fi - $as_echo "Please send $at_msg and all information you think might help: - - To: - Subject: [GnuCOBOL 4.0-early-dev] $as_me: $at_fail_list${at_fail_list:+ failed${at_xpass_list:+, }}$at_xpass_list${at_xpass_list:+ passed unexpectedly} - -You may investigate any problem if you feel able to do so, in which -case the test suite provides a good starting point. Its output may -be found below \`${at_testdir+${at_testdir}/}$as_me.dir'. -" - exit 1 -fi - -exit 0 - -## ------------- ## -## Actual tests. ## -## ------------- ## -#AT_START_1 -at_fn_group_banner 1 'run_manual_screen.at:24' \ - "LINE" " " 1 -at_xfail=no -( - $as_echo "1. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -$as_echo "run_manual_screen.at:27" >"$at_check_line_file" -(test "$COB_HAS_CURSES" != "yes") \ - && at_fn_check_skip 77 "$at_srcdir/run_manual_screen.at:27" - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 success-flag PIC X VALUE 'Y'. - 88 success VALUE 'Y', 'y'. - - SCREEN SECTION. - 01 scr. - 03 LINE 1 VALUE 'Enter "y" if the numbers below correspond ' - & 'to their line number and are in the '. - 03 LINE 2 VALUE 'first column. (This is line 2.)'. - 03 LINE 3 VALUE '3'. - 03 LINE 4 VALUE '4'. - 03 LINE 5 VALUE '5'. - 03 group-1 LINE - 3. - 05 group-2 COL 5. - 07 LINE PLUS 6 VALUE '8'. - 07 LINE MINUS 2 VALUE '6'. - 03 group-3 LINE + 1. - 05 COL 1 VALUE '7'. - 03 LINE + 3 PIC X, REQUIRED USING success-flag. - - PROCEDURE DIVISION. - DISPLAY scr - ACCEPT scr - - IF success AND COB-CRT-STATUS = 0 - GOBACK RETURNING 0 - ELSE - GOBACK RETURNING 1 - END-IF - . -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_manual_screen.at:65: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_manual_screen.at:65" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_manual_screen.at:65" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_manual_screen.at:66: \$RUN_PROG_MANUAL ./prog" -at_fn_check_prepare_dynamic "$RUN_PROG_MANUAL ./prog" "run_manual_screen.at:66" -( $at_check_trace; $RUN_PROG_MANUAL ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_manual_screen.at:66" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_1 -#AT_START_2 -at_fn_group_banner 2 'run_manual_screen.at:71' \ - "COLUMN (1)" " " 1 -at_xfail=no -( - $as_echo "2. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -$as_echo "run_manual_screen.at:74" >"$at_check_line_file" -(test "$COB_HAS_CURSES" != "yes") \ - && at_fn_check_skip 77 "$at_srcdir/run_manual_screen.at:74" - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 dummy PIC X(5). - 01 success-flag PIC X VALUE 'Y'. - 88 success VALUE 'Y', 'y'. - - SCREEN SECTION. - 01 scr. - 03 VALUE 'Enter "y" if the numbers below correspond to ' - & 'their column number.'. - 03 LINE 2 VALUE '123456789'. - 03 LINE 3 COLUMN 2. - 05 COL 1 VALUE '1'. - 05 COL 5 VALUE '5'. - 05 COL MINUS 2 VALUE '3'. - 05 COL PLUS 1 VALUE '4'. - 05 group-1 LINE 3. - 07 VALUE '2'. - 07 group-2 COLUMN + 4. - 09 group-3. - 11 COL + 0 VALUE '6'. - 05 COLUMN + 1, VALUE '7'. - 03 LINE 5 PIC X, REQUIRED, USING success-flag. - - PROCEDURE DIVISION. - DISPLAY scr - ACCEPT scr - - IF success AND COB-CRT-STATUS = 0 - GOBACK RETURNING 0 - ELSE - GOBACK RETURNING 1 - END-IF - . -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_manual_screen.at:115: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_manual_screen.at:115" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_manual_screen.at:115" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_manual_screen.at:116: \$RUN_PROG_MANUAL ./prog" -at_fn_check_prepare_dynamic "$RUN_PROG_MANUAL ./prog" "run_manual_screen.at:116" -( $at_check_trace; $RUN_PROG_MANUAL ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_manual_screen.at:116" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_2 -#AT_START_3 -at_fn_group_banner 3 'run_manual_screen.at:121' \ - "COLUMN (2)" " " 1 -at_xfail=no -( - $as_echo "3. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -$as_echo "run_manual_screen.at:124" >"$at_check_line_file" -(test "$COB_HAS_CURSES" != "yes") \ - && at_fn_check_skip 77 "$at_srcdir/run_manual_screen.at:124" - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 dummy-1 PIC X(10). - 01 dummy-2 PIC X(10). - 01 dummy-3 PIC X(10). - - 01 success-flag PIC X VALUE 'Y'. - 88 success VALUE 'Y', 'y'. - - SCREEN SECTION. - 01 scr. - 03 PIC X(80) VALUE 'Enter "y" if there are three non-'- - 'overlapping input fields on one line below.'. - 03 LINE + 1, PIC X(80) VALUE 'field.'. - 03 LINE + 2, PIC X(10) TO dummy-1. - 03 COL + 2, PIC X(10) TO dummy-2. - 03 COL + 2, PIC X(10) TO dummy-3. - 03 success-field LINE + 2, PIC X, REQUIRED, - USING success-flag. - - PROCEDURE DIVISION. - DISPLAY scr - ACCEPT scr - - IF success AND COB-CRT-STATUS = 0 - GOBACK RETURNING 0 - ELSE - GOBACK RETURNING 1 - END-IF - . -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_manual_screen.at:162: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_manual_screen.at:162" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_manual_screen.at:162" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_manual_screen.at:163: \$RUN_PROG_MANUAL ./prog" -at_fn_check_prepare_dynamic "$RUN_PROG_MANUAL ./prog" "run_manual_screen.at:163" -( $at_check_trace; $RUN_PROG_MANUAL ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_manual_screen.at:163" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_3 -#AT_START_4 -at_fn_group_banner 4 'run_manual_screen.at:168' \ - "LINE non-zero, COLUMN zero" " " 1 -at_xfail=no -( - $as_echo "4. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -$as_echo "run_manual_screen.at:171" >"$at_check_line_file" -(test "$COB_HAS_CURSES" != "yes") \ - && at_fn_check_skip 77 "$at_srcdir/run_manual_screen.at:171" - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 success-flag PIC X VALUE 'Y'. - 88 success VALUE 'Y', 'y'. - - SCREEN SECTION. - 01 scr. - 03 LINE 1 VALUE 'Enter "y" if you see 123 on the line '- - 'below starting at column 1.'. - 03 LINE + 3 PIC X, REQUIRED USING success-flag. - 03 LINE 2 VALUE '1'. - - PROCEDURE DIVISION. - DISPLAY scr - DISPLAY '2' LINE 2, COLUMN 0; '3' - ACCEPT scr - - IF success AND COB-CRT-STATUS = 0 - GOBACK RETURNING 0 - ELSE - GOBACK RETURNING 1 - END-IF - . -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_manual_screen.at:201: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_manual_screen.at:201" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_manual_screen.at:201" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_manual_screen.at:202: \$RUN_PROG_MANUAL ./prog" -at_fn_check_prepare_dynamic "$RUN_PROG_MANUAL ./prog" "run_manual_screen.at:202" -( $at_check_trace; $RUN_PROG_MANUAL ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_manual_screen.at:202" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_4 -#AT_START_5 -at_fn_group_banner 5 'run_manual_screen.at:207' \ - "LINE zero, COLUMN non-zero" " " 1 -at_xfail=no -( - $as_echo "5. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -$as_echo "run_manual_screen.at:210" >"$at_check_line_file" -(test "$COB_HAS_CURSES" != "yes") \ - && at_fn_check_skip 77 "$at_srcdir/run_manual_screen.at:210" - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 success-flag PIC X VALUE 'Y'. - 88 success VALUE 'Y', 'y'. - - SCREEN SECTION. - 01 scr. - 03 LINE 1 VALUE 'Enter "y" if you see 123 on the line '- - 'below starting at column 1.'. - 03 LINE + 3 PIC X, REQUIRED USING success-flag. - 03 LINE 2 COL 3, VALUE '3'. - 03 LINE 1 COL 80 VALUE ' '. - - PROCEDURE DIVISION. - DISPLAY scr - DISPLAY '1' LINE 0, COLUMN 1; '2' - ACCEPT scr - - IF success AND COB-CRT-STATUS = 0 - GOBACK RETURNING 0 - ELSE - GOBACK RETURNING 1 - END-IF - . -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_manual_screen.at:241: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_manual_screen.at:241" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_manual_screen.at:241" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_manual_screen.at:242: \$RUN_PROG_MANUAL ./prog" -at_fn_check_prepare_dynamic "$RUN_PROG_MANUAL ./prog" "run_manual_screen.at:242" -( $at_check_trace; $RUN_PROG_MANUAL ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_manual_screen.at:242" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_5 -#AT_START_6 -at_fn_group_banner 6 'run_manual_screen.at:247' \ - "LINE zero, COLUMN zero" " " 1 -at_xfail=no -( - $as_echo "6. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -$as_echo "run_manual_screen.at:250" >"$at_check_line_file" -(test "$COB_HAS_CURSES" != "yes") \ - && at_fn_check_skip 77 "$at_srcdir/run_manual_screen.at:250" - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 success-flag PIC X VALUE 'Y'. - 88 success VALUE 'Y', 'y'. - - SCREEN SECTION. - 01 scr. - 03 LINE 1 VALUE 'Enter "y" if you see 1234 on the line '- - 'below starting at column 1.'. - 03 LINE + 3 PIC X, REQUIRED USING success-flag. - 03 LINE 2 VALUE '1'. - - PROCEDURE DIVISION. - DISPLAY scr - DISPLAY '2' LINE 0, COLUMN 0 - DISPLAY '3' LINE 2, COLUMN 3 - DISPLAY '4' AT 0000 - - ACCEPT scr - - IF success AND COB-CRT-STATUS = 0 - GOBACK RETURNING 0 - ELSE - GOBACK RETURNING 1 - END-IF - . -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_manual_screen.at:283: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_manual_screen.at:283" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_manual_screen.at:283" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_manual_screen.at:284: \$RUN_PROG_MANUAL ./prog" -at_fn_check_prepare_dynamic "$RUN_PROG_MANUAL ./prog" "run_manual_screen.at:284" -( $at_check_trace; $RUN_PROG_MANUAL ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_manual_screen.at:284" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_6 -#AT_START_7 -at_fn_group_banner 7 'run_manual_screen.at:289' \ - "DISPLAY AT" " " 1 -at_xfail=no -( - $as_echo "7. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -$as_echo "run_manual_screen.at:292" >"$at_check_line_file" -(test "$COB_HAS_CURSES" != "yes") \ - && at_fn_check_skip 77 "$at_srcdir/run_manual_screen.at:292" - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 success-flag PIC X VALUE 'Y'. - 88 success VALUE 'Y', 'y'. - - 01 screen-loc PIC 9(6) VALUE 4004. - - SCREEN SECTION. - 01 scr. - 03 VALUE 'Enter "y" if the numbers 1-3 are in a diagonal'- - ' line from line 2, column 2.'. - 03 success-field PIC X, LINE 6, REQUIRED, - USING success-flag. - - PROCEDURE DIVISION. - DISPLAY '1' AT 0202 - DISPLAY '2' AT 003003 - DISPLAY '3' AT screen-loc - DISPLAY scr - ACCEPT scr - - IF success AND COB-CRT-STATUS = 0 - GOBACK RETURNING 0 - ELSE - GOBACK RETURNING 1 - END-IF - . -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_manual_screen.at:326: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_manual_screen.at:326" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_manual_screen.at:326" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_manual_screen.at:327: \$RUN_PROG_MANUAL ./prog" -at_fn_check_prepare_dynamic "$RUN_PROG_MANUAL ./prog" "run_manual_screen.at:327" -( $at_check_trace; $RUN_PROG_MANUAL ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_manual_screen.at:327" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_7 -#AT_START_8 -at_fn_group_banner 8 'run_manual_screen.at:332' \ - "DISPLAY LOW-VALUES (one statement)" " " 1 -at_xfail=no -( - $as_echo "8. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -$as_echo "run_manual_screen.at:335" >"$at_check_line_file" -(test "$COB_HAS_CURSES" != "yes") \ - && at_fn_check_skip 77 "$at_srcdir/run_manual_screen.at:335" - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 success-flag PIC X VALUE 'Y'. - 88 success VALUE 'Y', 'y'. - - SCREEN SECTION. - 01 scr. - 03 LINE 1 VALUE 'Enter "y" if the word below starts at line' - & ' 3, column 3.'. - 03 LINE + 4 PIC X, REQUIRED USING success-flag. - - PROCEDURE DIVISION. - DISPLAY scr - DISPLAY LOW-VALUES AT LINE 3, COL 3; 'Hello!' - ACCEPT scr - - IF success AND COB-CRT-STATUS = 0 - GOBACK RETURNING 0 - ELSE - GOBACK RETURNING 1 - END-IF - . -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_manual_screen.at:364: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_manual_screen.at:364" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_manual_screen.at:364" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_manual_screen.at:365: \$RUN_PROG_MANUAL ./prog" -at_fn_check_prepare_dynamic "$RUN_PROG_MANUAL ./prog" "run_manual_screen.at:365" -( $at_check_trace; $RUN_PROG_MANUAL ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_manual_screen.at:365" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_8 -#AT_START_9 -at_fn_group_banner 9 'run_manual_screen.at:370' \ - "DISPLAY LOW-VALUES (two statements)" " " 1 -at_xfail=no -( - $as_echo "9. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -$as_echo "run_manual_screen.at:373" >"$at_check_line_file" -(test "$COB_HAS_CURSES" != "yes") \ - && at_fn_check_skip 77 "$at_srcdir/run_manual_screen.at:373" - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 success-flag PIC X VALUE 'Y'. - 88 success VALUE 'Y', 'y'. - - SCREEN SECTION. - 01 scr. - 03 LINE 1 VALUE 'Enter "y" if the word below starts at line' - & ' 3, column 3.'. - 03 LINE + 4 PIC X, REQUIRED USING success-flag. - - PROCEDURE DIVISION. - DISPLAY scr - DISPLAY LOW-VALUES AT LINE 3, COL 3 - DISPLAY 'Hello!' UPON CRT - ACCEPT scr - - IF success AND COB-CRT-STATUS = 0 - GOBACK RETURNING 0 - ELSE - GOBACK RETURNING 1 - END-IF - . -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_manual_screen.at:403: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_manual_screen.at:403" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_manual_screen.at:403" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_manual_screen.at:404: \$RUN_PROG_MANUAL ./prog" -at_fn_check_prepare_dynamic "$RUN_PROG_MANUAL ./prog" "run_manual_screen.at:404" -( $at_check_trace; $RUN_PROG_MANUAL ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_manual_screen.at:404" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_9 -#AT_START_10 -at_fn_group_banner 10 'run_manual_screen.at:409' \ - "DISPLAY SPACES" " " 1 -at_xfail=no -( - $as_echo "10. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -$as_echo "run_manual_screen.at:412" >"$at_check_line_file" -(test "$COB_HAS_CURSES" != "yes") \ - && at_fn_check_skip 77 "$at_srcdir/run_manual_screen.at:412" - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 success-flag PIC X VALUE 'Y'. - 88 success VALUE 'Y', 'y'. - - SCREEN SECTION. - 01 scr-1. - 03 LINE 1 VALUE 'Enter "y" if all the text after foo in the' - & ' screen has been erased.'. - 03 LINE 3 VALUE 'Lorem ipsum dolor sit amet, consectetur ad' - & 'ipiscing elit. Curabitur dapibus dui'. - 03 LINE 4 VALUE 'vitae augue lobortis, non tempor diam tris' - & 'tique. Donec dignissim ex velit, ut'. - 03 LINE 5 VALUE 'efficitur tellus pharetra at. Curabitur at' - & ' condimentum nunc, nec accumsan'. - 03 LINE 6 VALUE 'nulla. Nulla at feugiat elit, eget condime' - & 'ntum justo. Nam lorem lectus,'. - 03 LINE 7 VALUE 'imperdiet sit amet odio eu, eleifend conse' - & 'ctetur ligula. Duis diam felis, porta'. - 03 LINE 8 VALUE 'id diam id, ultrices finibus augue. Mauris' - & ' imperdiet, dolor sed sodales porta,'. - 03 LINE 9 VALUE 'justo nunc consequat nulla, iaculis venena' - & 'tis lorem libero sit amet'. - 03 LINE 10 VALUE 'magna. Nullam pulvinar nullam.'. - 03 success-field LINE + 2, PIC X, REQUIRED, - USING success-flag. - - PROCEDURE DIVISION. - DISPLAY scr-1 - DISPLAY SPACES AT LINE 6, COL 8; 'foo' HIGHLIGHT - ACCEPT success-field - - IF success AND COB-CRT-STATUS = 0 - GOBACK RETURNING 0 - ELSE - GOBACK RETURNING 1 - END-IF - . -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_manual_screen.at:458: \$COMPILE -fdisplay-special-fig-consts prog.cob" -at_fn_check_prepare_dynamic "$COMPILE -fdisplay-special-fig-consts prog.cob" "run_manual_screen.at:458" -( $at_check_trace; $COMPILE -fdisplay-special-fig-consts prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_manual_screen.at:458" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_manual_screen.at:459: \$RUN_PROG_MANUAL ./prog" -at_fn_check_prepare_dynamic "$RUN_PROG_MANUAL ./prog" "run_manual_screen.at:459" -( $at_check_trace; $RUN_PROG_MANUAL ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_manual_screen.at:459" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_10 -#AT_START_11 -at_fn_group_banner 11 'run_manual_screen.at:464' \ - "DISPLAY ALL X'01'" " " 1 -at_xfail=no -( - $as_echo "11. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -$as_echo "run_manual_screen.at:467" >"$at_check_line_file" -(test "$COB_HAS_CURSES" != "yes") \ - && at_fn_check_skip 77 "$at_srcdir/run_manual_screen.at:467" - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 success-flag PIC X VALUE 'Y'. - 88 success VALUE 'Y', 'y'. - - SCREEN SECTION. - 01 scr-1. - 03 LINE 1 VALUE 'Enter "y" if all the text after foo on ' - & 'that line alone has been erased.'. - 03 LINE 3 VALUE 'Lorem ipsum dolor sit amet, consectetur ad' - & 'ipiscing elit. Curabitur dapibus dui'. - 03 LINE 4 VALUE 'vitae augue lobortis, non tempor diam tris' - & 'tique. Donec dignissim ex velit, ut'. - 03 LINE 5 VALUE 'efficitur tellus pharetra at. Curabitur at' - & ' condimentum nunc, nec accumsan'. - 03 LINE 6 VALUE 'nulla. Nulla at feugiat elit, eget condime' - & 'ntum justo. Nam lorem lectus,'. - 03 LINE 7 VALUE 'imperdiet sit amet odio eu, eleifend conse' - & 'ctetur ligula. Duis diam felis, porta'. - 03 LINE 8 VALUE 'id diam id, ultrices finibus augue. Mauris' - & ' imperdiet, dolor sed sodales porta,'. - 03 LINE 9 VALUE 'justo nunc consequat nulla, iaculis venena' - & 'tis lorem libero sit amet'. - 03 LINE 10 VALUE 'magna. Nullam pulvinar nullam.'. - 03 success-field LINE + 2, PIC X, REQUIRED, - USING success-flag. - - PROCEDURE DIVISION. - DISPLAY scr-1 - DISPLAY ALL X'01', LINE 6, COLUMN 8; 'foo' HIGHLIGHT - ACCEPT success-field - - IF success AND COB-CRT-STATUS = 0 - GOBACK RETURNING 0 - ELSE - GOBACK RETURNING 1 - END-IF - . -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_manual_screen.at:513: \$COMPILE -fdisplay-special-fig-consts prog.cob" -at_fn_check_prepare_dynamic "$COMPILE -fdisplay-special-fig-consts prog.cob" "run_manual_screen.at:513" -( $at_check_trace; $COMPILE -fdisplay-special-fig-consts prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_manual_screen.at:513" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_manual_screen.at:514: \$RUN_PROG_MANUAL ./prog" -at_fn_check_prepare_dynamic "$RUN_PROG_MANUAL ./prog" "run_manual_screen.at:514" -( $at_check_trace; $RUN_PROG_MANUAL ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_manual_screen.at:514" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_11 -#AT_START_12 -at_fn_group_banner 12 'run_manual_screen.at:519' \ - "DISPLAY ALL X'02'" " " 1 -at_xfail=no -( - $as_echo "12. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -$as_echo "run_manual_screen.at:522" >"$at_check_line_file" -(test "$COB_HAS_CURSES" != "yes") \ - && at_fn_check_skip 77 "$at_srcdir/run_manual_screen.at:522" - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 success-flag PIC X VALUE 'Y'. - 88 success VALUE 'Y', 'y'. - - SCREEN SECTION. - 01 scr-1. - 03 LINE 3 VALUE 'Lorem ipsum dolor sit amet, consectetur ad' - & 'ipiscing elit. Curabitur dapibus dui'. - 03 LINE 4 VALUE 'vitae augue lobortis, non tempor diam tris' - & 'tique. Donec dignissim ex velit, ut'. - 03 LINE 5 VALUE 'efficitur tellus pharetra at. Curabitur at' - & ' condimentum nunc, nec accumsan'. - 03 LINE 6 VALUE 'nulla. Nulla at feugiat elit, eget condime' - & 'ntum justo. Nam lorem lectus,'. - 03 LINE 7 VALUE 'imperdiet sit amet odio eu, eleifend conse' - & 'ctetur ligula. Duis diam felis, porta'. - 03 LINE 8 VALUE 'id diam id, ultrices finibus augue. Mauris' - & ' imperdiet, dolor sed sodales porta,'. - 03 LINE 9 VALUE 'justo nunc consequat nulla, iaculis venena' - & 'tis lorem libero sit amet'. - 03 LINE 10 VALUE 'magna. Nullam pulvinar nullam.'. - - 01 scr-2. - 03 LINE 6 COL 8 VALUE 'foo' BLANK SCREEN, HIGHLIGHT. - 03 LINE 1 VALUE 'Enter "y" if foo is the only word below.'. - - 01 scr-3. - 03 VALUE 'Enter "y" if foo is the only word below.'. - 03 success-field COL + 2, PIC X, REQUIRED, - USING success-flag. - - PROCEDURE DIVISION. - DISPLAY scr-1 - DISPLAY ALL X'02' AT LINE 6 COL 8; 'foo' HIGHLIGHT - DISPLAY scr-3 - ACCEPT scr-3 - - IF success AND COB-CRT-STATUS = 0 - GOBACK RETURNING 0 - ELSE - GOBACK RETURNING 1 - END-IF - . -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_manual_screen.at:574: \$COMPILE -fdisplay-special-fig-consts prog.cob" -at_fn_check_prepare_dynamic "$COMPILE -fdisplay-special-fig-consts prog.cob" "run_manual_screen.at:574" -( $at_check_trace; $COMPILE -fdisplay-special-fig-consts prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_manual_screen.at:574" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_manual_screen.at:575: \$RUN_PROG_MANUAL ./prog" -at_fn_check_prepare_dynamic "$RUN_PROG_MANUAL ./prog" "run_manual_screen.at:575" -( $at_check_trace; $RUN_PROG_MANUAL ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_manual_screen.at:575" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_12 -#AT_START_13 -at_fn_group_banner 13 'run_manual_screen.at:580' \ - "DISPLAY ALL X'07'" " " 1 -at_xfail=no -( - $as_echo "13. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -$as_echo "run_manual_screen.at:583" >"$at_check_line_file" -(test "$COB_HAS_CURSES" != "yes") \ - && at_fn_check_skip 77 "$at_srcdir/run_manual_screen.at:583" - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 success-flag PIC X. - 88 success VALUE 'Y', 'y'. - - SCREEN SECTION. - 01 scr. - 03 VALUE 'Enter "y" if you heard a beep:'. - 03 success-field PIC X, COL + 2, REQUIRED, TO success-flag - FROM 'Y'. - 01 scr2. - 03 LINE 4 VALUE 'system beep may be turned off ' & - 'on this system.'. - 03 LINE 5 VALUE 'Retesting with COB_BELL=FLASH...'. - 03 LINE + 2 - VALUE 'Enter "y" if you''ve seen your terminal flash'. - 03 success-field PIC X, COL + 2, REQUIRED, TO success-flag - FROM 'Y'. - - PROCEDURE DIVISION. - DISPLAY scr - DISPLAY ALL X'07' UPON CRT - ACCEPT scr - - IF success AND COB-CRT-STATUS = 0 - GOBACK RETURNING 0 - END-IF - - SET ENVIRONMENT 'COB_BELL' TO 'FLASH' - CALL 'C$SLEEP' USING '1' - - DISPLAY scr2 - DISPLAY ALL X'07' UPON CRT - ACCEPT scr2 - - IF success AND COB-CRT-STATUS = 0 - GOBACK RETURNING 0 - ELSE - GOBACK RETURNING 1 - END-IF - . -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_manual_screen.at:631: \$COMPILE -fdisplay-special-fig-consts prog.cob" -at_fn_check_prepare_dynamic "$COMPILE -fdisplay-special-fig-consts prog.cob" "run_manual_screen.at:631" -( $at_check_trace; $COMPILE -fdisplay-special-fig-consts prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_manual_screen.at:631" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_manual_screen.at:632: \$RUN_PROG_MANUAL ./prog" -at_fn_check_prepare_dynamic "$RUN_PROG_MANUAL ./prog" "run_manual_screen.at:632" -( $at_check_trace; $RUN_PROG_MANUAL ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_manual_screen.at:632" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_13 -#AT_START_14 -at_fn_group_banner 14 'run_manual_screen.at:637' \ - "Screen position after field display" " " 1 -at_xfail=no -( - $as_echo "14. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -$as_echo "run_manual_screen.at:640" >"$at_check_line_file" -(test "$COB_HAS_CURSES" != "yes") \ - && at_fn_check_skip 77 "$at_srcdir/run_manual_screen.at:640" - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 success-flag PIC X VALUE 'Y'. - 88 success VALUE 'Y', 'y'. - - SCREEN SECTION. - 01 scr. - 03 VALUE 'Enter "y" if this sentence starts at line 1,'- - ' column 1:'. - 03 success-field PIC X, COL + 2, REQUIRED, - USING success-flag. - - PROCEDURE DIVISION. - DISPLAY 'ignore this' AT LINE 4 COL 4 - DISPLAY scr - ACCEPT success-field - - IF success AND COB-CRT-STATUS = 0 - GOBACK RETURNING 0 - ELSE - GOBACK RETURNING 1 - END-IF - . -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_manual_screen.at:670: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_manual_screen.at:670" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_manual_screen.at:670" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_manual_screen.at:671: \$RUN_PROG_MANUAL ./prog" -at_fn_check_prepare_dynamic "$RUN_PROG_MANUAL ./prog" "run_manual_screen.at:671" -( $at_check_trace; $RUN_PROG_MANUAL ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_manual_screen.at:671" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_14 -#AT_START_15 -at_fn_group_banner 15 'run_manual_screen.at:677' \ - "Overridden clauses (1)" " " 1 -at_xfail=no -( - $as_echo "15. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -$as_echo "run_manual_screen.at:680" >"$at_check_line_file" -(test "$COB_HAS_CURSES" != "yes") \ - && at_fn_check_skip 77 "$at_srcdir/run_manual_screen.at:680" - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 dummy PIC X(5). - 01 success-flag PIC X VALUE 'Y'. - 88 success VALUE 'Y', 'y'. - - SCREEN SECTION. - 01 scr. - 03 VALUE 'Enter "y" if the numbers below correspond to their' - & ' column number and all on'. - 03 LINE 2 VALUE 'lines 3 and 4.'. - 03 LINE 3 VALUE '123456789'. - 03 LINE 4 VALUE ' 34'. - 03 FILLER LINE + 6. - 05 COL 3. - 07 COL 1. - 09 LINE 4 VALUE '1'. - 09 VALUE '2'. - 05 LINE + 1, COL + 2. - 07 LINE 4, COL + 1, VALUE '5'. - 03 LINE 6 PIC X, REQUIRED, USING success-flag. - - PROCEDURE DIVISION. - DISPLAY scr - ACCEPT scr - - IF success AND COB-CRT-STATUS = 0 - GOBACK RETURNING 0 - ELSE - GOBACK RETURNING 1 - END-IF - . -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_manual_screen.at:719: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_manual_screen.at:719" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_manual_screen.at:719" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_manual_screen.at:720: \$RUN_PROG_MANUAL ./prog" -at_fn_check_prepare_dynamic "$RUN_PROG_MANUAL ./prog" "run_manual_screen.at:720" -( $at_check_trace; $RUN_PROG_MANUAL ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_manual_screen.at:720" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_15 -#AT_START_16 -at_fn_group_banner 16 'run_manual_screen.at:725' \ - "Overridden clauses (2)" " " 1 -at_xfail=no -( - $as_echo "16. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -$as_echo "run_manual_screen.at:728" >"$at_check_line_file" -(test "$COB_HAS_CURSES" != "yes") \ - && at_fn_check_skip 77 "$at_srcdir/run_manual_screen.at:728" - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 dummy PIC X(5). - 01 success-flag PIC X VALUE 'Y'. - 88 success VALUE 'Y', 'y'. - - SCREEN SECTION. - 01 scr. - 03 VALUE 'Enter "y" if the word below is not dim and has' - & ' black background.'. - 03 LINE + 1, LOWLIGHT BACKGROUND-COLOR 3. - 05 HIGHLIGHT BACKGROUND-COLOR 0. - 07 VALUE 'Highlight'. - 03 LINE + 2, PIC X USING success-flag. - - PROCEDURE DIVISION. - DISPLAY scr - ACCEPT scr - - IF success AND COB-CRT-STATUS = 0 - GOBACK RETURNING 0 - ELSE - GOBACK RETURNING 1 - END-IF - . -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_manual_screen.at:760: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_manual_screen.at:760" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_manual_screen.at:760" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_manual_screen.at:761: \$RUN_PROG_MANUAL ./prog" -at_fn_check_prepare_dynamic "$RUN_PROG_MANUAL ./prog" "run_manual_screen.at:761" -( $at_check_trace; $RUN_PROG_MANUAL ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_manual_screen.at:761" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_16 -#AT_START_17 -at_fn_group_banner 17 'run_manual_screen.at:766' \ - "AUTO" " " 1 -at_xfail=no -( - $as_echo "17. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -$as_echo "run_manual_screen.at:769" >"$at_check_line_file" -(test "$COB_HAS_CURSES" != "yes") \ - && at_fn_check_skip 77 "$at_srcdir/run_manual_screen.at:769" - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 dummy PIC X(5). - 01 success-flag PIC X. - 88 success VALUE 'Y', 'y'. - - SCREEN SECTION. - 01 scr. - 03 PIC X(80) VALUE 'Enter "y" in the bottom' - & ' field if:'. - 03 LINE + 1, PIC X(80) VALUE ' * when the left field is' - & ' full, the cursor automatically moves'. - 03 LINE + 1, PIC X(80) VALUE ' to the next field.'. - 03 LINE + 1, PIC X(80) VALUE ' * this does not happen' - & ' with the other fields.'. - 03 LINE + 1, PIC X(80) VALUE ' * the fields below are' - & ' on one line and separated by a single' - & ' column.'. - - 03 test-fields LINE + 2. - 05 field-1 COL 1, PIC X(5) AUTO TO dummy. - 05 field-2 COL + 2, PIC X(5) TO dummy. - 05 field-3 COL + 2, PIC X(5) TO dummy. - 03 success-field LINE + 2, COLUMN 1; PIC X, REQUIRED - TO success-flag FROM 'Y'. - - PROCEDURE DIVISION. - DISPLAY scr - ACCEPT scr - - IF success AND COB-CRT-STATUS = 0 - GOBACK RETURNING 0 - ELSE - GOBACK RETURNING 1 - END-IF - . -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_manual_screen.at:812: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_manual_screen.at:812" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_manual_screen.at:812" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_manual_screen.at:813: \$RUN_PROG_MANUAL ./prog" -at_fn_check_prepare_dynamic "$RUN_PROG_MANUAL ./prog" "run_manual_screen.at:813" -( $at_check_trace; $RUN_PROG_MANUAL ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_manual_screen.at:813" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_17 -#AT_START_18 -at_fn_group_banner 18 'run_manual_screen.at:818' \ - "BACKGROUND- / FOREGROUND-COLOUR" " " 1 -at_xfail=no -( - $as_echo "18. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -$as_echo "run_manual_screen.at:821" >"$at_check_line_file" -(test "$COB_HAS_CURSES" != "yes") \ - && at_fn_check_skip 77 "$at_srcdir/run_manual_screen.at:821" - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 dummy PIC X(10). - 01 success-flag PIC X. - 88 success VALUE 'Y', 'y'. - - SCREEN SECTION. - 01 scr. - 03 PIC X(80) - VALUE 'Enter "y" if the text below matches the colour ' - & 'of the background/text.'. - 03 LINE + 1, COL 1, PIC X(80) - VALUE 'Note: the black text is on white background/the ' - & 'white background has black text'. - 03 LINE + 1, COL 1, PIC X(80) - VALUE 'to make the text visible.'. - - 03 LINE + 1. - 05 COL 1, PIC X(8) VALUE 'Black' FOREGROUND-COLOR 0 - BACKGROUND-COLOR 7. - 05 COL + 2, PIC X(8) VALUE 'Blue' FOREGROUND-COLOR 1. - 05 COL + 2, PIC X(8) VALUE 'Green' FOREGROUND-COLOR 2. - 05 COL + 2, PIC X(8) VALUE 'Cyan' FOREGROUND-COLOR 3. - 05 COL + 2, PIC X(8) VALUE 'Red' FOREGROUND-COLOR 4. - 05 COL + 2, PIC X(8) VALUE 'Magenta' FOREGROUND-COLOR 5. - 05 COL + 2, PIC X(15) VALUE 'Brown/Yellow' - FOREGROUND-COLOR 6. - 05 COL + 2, PIC X(8) VALUE 'White' FOREGROUND-COLOR 7. - - 03 LINE + 1. - 05 COL 1, PIC X(8) VALUE 'Black' BACKGROUND-COLOR 0 - FOREGROUND-COLOR 7. - 05 COL + 2, PIC X(8) VALUE 'Blue' BACKGROUND-COLOR 1. - 05 COL + 2, PIC X(8) VALUE 'Green' BACKGROUND-COLOR 2. - 05 COL + 2, PIC X(8) VALUE 'Cyan' BACKGROUND-COLOR 3. - 05 COL + 2, PIC X(8) VALUE 'Red' BACKGROUND-COLOR 4. - 05 COL + 2, PIC X(8) VALUE 'Magenta' BACKGROUND-COLOR 5. - 05 COL + 2, PIC X(15) VALUE 'Brown/Yellow' - BACKGROUND-COLOR 6. - 05 COL + 2, PIC X(8) VALUE 'White' BACKGROUND-COLOR 7 - FOREGROUND-COLOR 0. - - 03 success-field LINE + 2, COL 1, PIC X, REQUIRED, - TO success-flag FROM 'Y'. - - PROCEDURE DIVISION. - DISPLAY scr - ACCEPT scr - - IF success AND COB-CRT-STATUS = 0 - GOBACK RETURNING 0 - ELSE - GOBACK RETURNING 1 - END-IF - . -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_manual_screen.at:883: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_manual_screen.at:883" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_manual_screen.at:883" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_manual_screen.at:884: \$RUN_PROG_MANUAL ./prog" -at_fn_check_prepare_dynamic "$RUN_PROG_MANUAL ./prog" "run_manual_screen.at:884" -( $at_check_trace; $RUN_PROG_MANUAL ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_manual_screen.at:884" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_18 -#AT_START_19 -at_fn_group_banner 19 'run_manual_screen.at:889' \ - "BEEP" " " 1 -at_xfail=no -( - $as_echo "19. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -$as_echo "run_manual_screen.at:892" >"$at_check_line_file" -(test "$COB_HAS_CURSES" != "yes") \ - && at_fn_check_skip 77 "$at_srcdir/run_manual_screen.at:892" - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 success-flag PIC X. - 88 success VALUE 'Y', 'y'. - - SCREEN SECTION. - 01 scr. - 03 BELL. - 03 VALUE 'Enter "y" if you heard a beep:'. - 03 success-field PIC X, COL + 2, REQUIRED, TO success-flag - FROM 'Y'. - 01 scr2. - 03 LINE 4 VALUE 'system beep may be turned off ' & - 'on this system.'. - 03 LINE 5 VALUE 'Retesting with COB_BELL=FLASH...'. - 03 LINE + 2, - VALUE 'Enter "y" if you''ve seen your terminal flash'. - 03 success-field PIC X, COL + 2, REQUIRED, TO success-flag - FROM 'Y'. - - PROCEDURE DIVISION. - DISPLAY scr - ACCEPT scr - - IF success AND COB-CRT-STATUS = 0 - GOBACK RETURNING 0 - END-IF - - SET ENVIRONMENT 'COB_BELL' TO 'FLASH' - CALL 'C$SLEEP' USING '1' - - DISPLAY scr2 - DISPLAY ALL X'07' UPON CRT - ACCEPT scr2 - - IF success AND COB-CRT-STATUS = 0 - GOBACK RETURNING 0 - ELSE - GOBACK RETURNING 1 - END-IF - . -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_manual_screen.at:940: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_manual_screen.at:940" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_manual_screen.at:940" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_manual_screen.at:941: \$RUN_PROG_MANUAL ./prog" -at_fn_check_prepare_dynamic "$RUN_PROG_MANUAL ./prog" "run_manual_screen.at:941" -( $at_check_trace; $RUN_PROG_MANUAL ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_manual_screen.at:941" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_19 -#AT_START_20 -at_fn_group_banner 20 'run_manual_screen.at:946' \ - "BLANK LINE" " " 1 -at_xfail=no -( - $as_echo "20. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -$as_echo "run_manual_screen.at:949" >"$at_check_line_file" -(test "$COB_HAS_CURSES" != "yes") \ - && at_fn_check_skip 77 "$at_srcdir/run_manual_screen.at:949" - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 success-flag PIC X VALUE 'Y'. - 88 success VALUE 'Y', 'y'. - - SCREEN SECTION. - 01 scr-1. - 03 LINE 3 VALUE 'Lorem ipsum dolor sit amet, consectetur ad' - & 'ipiscing elit. Curabitur dapibus dui'. - 03 LINE 4 VALUE 'vitae augue lobortis, non tempor diam tris' - & 'tique. Donec dignissim ex velit, ut'. - 03 LINE 5 VALUE 'efficitur tellus pharetra at. Curabitur at' - & ' condimentum nunc, nec accumsan'. - 03 LINE 6 VALUE 'nulla. Nulla at feugiat elit, eget condime' - & 'ntum justo. Nam lorem lectus,'. - 03 LINE 7 VALUE 'imperdiet sit amet odio eu, eleifend conse' - & 'ctetur ligula. Duis diam felis, porta'. - 03 LINE 8 VALUE 'id diam id, ultrices finibus augue. Mauris' - & ' imperdiet, dolor sed sodales porta,'. - 03 LINE 9 VALUE 'justo nunc consequat nulla, iaculis venena' - & 'tis lorem libero sit amet'. - 03 LINE 10 VALUE 'magna. Nullam pulvinar nullam.'. - 03 success-field LINE + 2, PIC X, REQUIRED, - USING success-flag. - - 01 scr-2. - 03 LINE 6 COL 8 VALUE 'foo' BLANK LINE, HIGHLIGHT. - 03 LINE 1 VALUE 'Enter "y" if foo is the only word on one' - & ' line.'. - - PROCEDURE DIVISION. - DISPLAY scr-1 - DISPLAY scr-2 - ACCEPT success-field - - IF success AND COB-CRT-STATUS = 0 - GOBACK RETURNING 0 - ELSE - GOBACK RETURNING 1 - END-IF - . -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_manual_screen.at:998: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_manual_screen.at:998" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_manual_screen.at:998" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_manual_screen.at:999: \$RUN_PROG_MANUAL ./prog" -at_fn_check_prepare_dynamic "$RUN_PROG_MANUAL ./prog" "run_manual_screen.at:999" -( $at_check_trace; $RUN_PROG_MANUAL ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_manual_screen.at:999" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_20 -#AT_START_21 -at_fn_group_banner 21 'run_manual_screen.at:1004' \ - "BLANK SCREEN" " " 1 -at_xfail=no -( - $as_echo "21. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -$as_echo "run_manual_screen.at:1007" >"$at_check_line_file" -(test "$COB_HAS_CURSES" != "yes") \ - && at_fn_check_skip 77 "$at_srcdir/run_manual_screen.at:1007" - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 success-flag PIC X VALUE 'Y'. - 88 success VALUE 'Y', 'y'. - - SCREEN SECTION. - 01 scr-1. - 03 LINE 3 VALUE 'Lorem ipsum dolor sit amet, consectetur ad' - & 'ipiscing elit. Curabitur dapibus dui'. - 03 LINE 4 VALUE 'vitae augue lobortis, non tempor diam tris' - & 'tique. Donec dignissim ex velit, ut'. - 03 LINE 5 VALUE 'efficitur tellus pharetra at. Curabitur at' - & ' condimentum nunc, nec accumsan'. - 03 LINE 6 VALUE 'nulla. Nulla at feugiat elit, eget condime' - & 'ntum justo. Nam lorem lectus,'. - 03 LINE 7 VALUE 'imperdiet sit amet odio eu, eleifend conse' - & 'ctetur ligula. Duis diam felis, porta'. - 03 LINE 8 VALUE 'id diam id, ultrices finibus augue. Mauris' - & ' imperdiet, dolor sed sodales porta,'. - 03 LINE 9 VALUE 'justo nunc consequat nulla, iaculis venena' - & 'tis lorem libero sit amet'. - 03 LINE 10 VALUE 'magna. Nullam pulvinar nullam.'. - 03 success-field LINE + 2, PIC X, REQUIRED, - USING success-flag. - - 01 scr-2. - 03 LINE 6 COL 8 VALUE 'foo' BLANK SCREEN, HIGHLIGHT. - 03 LINE 1 VALUE 'Enter "y" if foo is the only word below.'. - - PROCEDURE DIVISION. - DISPLAY scr-1 - DISPLAY scr-2 - ACCEPT success-field - - IF success AND COB-CRT-STATUS = 0 - GOBACK RETURNING 0 - ELSE - GOBACK RETURNING 1 - END-IF - . -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_manual_screen.at:1055: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_manual_screen.at:1055" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_manual_screen.at:1055" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_manual_screen.at:1056: \$RUN_PROG_MANUAL ./prog" -at_fn_check_prepare_dynamic "$RUN_PROG_MANUAL ./prog" "run_manual_screen.at:1056" -( $at_check_trace; $RUN_PROG_MANUAL ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_manual_screen.at:1056" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_21 -#AT_START_22 -at_fn_group_banner 22 'run_manual_screen.at:1061' \ - "BLANK ignored in ACCEPT" " " 1 -at_xfail=no -( - $as_echo "22. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -$as_echo "run_manual_screen.at:1064" >"$at_check_line_file" -(test "$COB_HAS_CURSES" != "yes") \ - && at_fn_check_skip 77 "$at_srcdir/run_manual_screen.at:1064" - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 success-flag PIC X VALUE 'Y'. - 88 success VALUE 'Y', 'y'. - - SCREEN SECTION. - 01 scr. - 03 LINE 1 VALUE 'Enter "y" if you can see lorem ipsum ' - & 'filler text.'. - 03 LINE 3 COL 3 VALUE 'Lorem ipsum dolor sit amet,' - & ' consectetur ad ipiscing elit.'. - - 01 success-scr. - 03 LINE 3, BLANK LINE, PIC X, REQUIRED, USING success-flag. - - PROCEDURE DIVISION. - DISPLAY scr - ACCEPT success-scr - - IF success AND COB-CRT-STATUS = 0 - GOBACK RETURNING 0 - ELSE - GOBACK RETURNING 1 - END-IF - . -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_manual_screen.at:1097: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_manual_screen.at:1097" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_manual_screen.at:1097" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_manual_screen.at:1098: \$RUN_PROG_MANUAL ./prog" -at_fn_check_prepare_dynamic "$RUN_PROG_MANUAL ./prog" "run_manual_screen.at:1098" -( $at_check_trace; $RUN_PROG_MANUAL ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_manual_screen.at:1098" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_22 -#AT_START_23 -at_fn_group_banner 23 'run_manual_screen.at:1103' \ - "BLINK" " " 1 -at_xfail=no -( - $as_echo "23. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -$as_echo "run_manual_screen.at:1106" >"$at_check_line_file" -(test "$COB_HAS_CURSES" != "yes") \ - && at_fn_check_skip 77 "$at_srcdir/run_manual_screen.at:1106" - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 success-flag PIC X VALUE 'Y'. - 88 success VALUE 'Y', 'y'. - - SCREEN SECTION. - 01 scr. - 03 PIC X(80) - VALUE 'Enter "y" if the string below is blinking:'. - 03 LINE + 1, PIC X(10) VALUE 'Blink' BLINK. - 03 success-field LINE + 2, PIC X, REQUIRED, - USING success-flag. - - PROCEDURE DIVISION. - DISPLAY scr - ACCEPT scr - - IF success AND COB-CRT-STATUS = 0 - GOBACK RETURNING 0 - ELSE - GOBACK RETURNING 1 - END-IF - . -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_manual_screen.at:1136: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_manual_screen.at:1136" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_manual_screen.at:1136" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_manual_screen.at:1137: \$RUN_PROG_MANUAL ./prog" -at_fn_check_prepare_dynamic "$RUN_PROG_MANUAL ./prog" "run_manual_screen.at:1137" -( $at_check_trace; $RUN_PROG_MANUAL ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_manual_screen.at:1137" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_23 -#AT_START_24 -at_fn_group_banner 24 'run_manual_screen.at:1142' \ - "ERASE EOS" " " 1 -at_xfail=no -( - $as_echo "24. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -$as_echo "run_manual_screen.at:1145" >"$at_check_line_file" -(test "$COB_HAS_CURSES" != "yes") \ - && at_fn_check_skip 77 "$at_srcdir/run_manual_screen.at:1145" - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 success-flag PIC X VALUE 'Y'. - 88 success VALUE 'Y', 'y'. - - SCREEN SECTION. - 01 scr-1. - 03 LINE 1 VALUE 'Enter "y" if all the text after foo in the' - & ' screen has been erased.'. - 03 LINE 3 VALUE 'Lorem ipsum dolor sit amet, consectetur ad' - & 'ipiscing elit. Curabitur dapibus dui'. - 03 LINE 4 VALUE 'vitae augue lobortis, non tempor diam tris' - & 'tique. Donec dignissim ex velit, ut'. - 03 LINE 5 VALUE 'efficitur tellus pharetra at. Curabitur at' - & ' condimentum nunc, nec accumsan'. - 03 LINE 6 VALUE 'nulla. Nulla at feugiat elit, eget condime' - & 'ntum justo. Nam lorem lectus,'. - 03 LINE 7 VALUE 'imperdiet sit amet odio eu, eleifend conse' - & 'ctetur ligula. Duis diam felis, porta'. - 03 LINE 8 VALUE 'id diam id, ultrices finibus augue. Mauris' - & ' imperdiet, dolor sed sodales porta,'. - 03 LINE 9 VALUE 'justo nunc consequat nulla, iaculis venena' - & 'tis lorem libero sit amet'. - 03 LINE 10 VALUE 'magna. Nullam pulvinar nullam.'. - 03 success-field LINE + 2, PIC X, REQUIRED, - USING success-flag. - - 01 scr-2. - 03 LINE 6 COL 8 VALUE 'foo' ERASE EOS, HIGHLIGHT. - - PROCEDURE DIVISION. - DISPLAY scr-1 - DISPLAY scr-2 - ACCEPT success-field - - IF success AND COB-CRT-STATUS = 0 - GOBACK RETURNING 0 - ELSE - GOBACK RETURNING 1 - END-IF - . -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_manual_screen.at:1194: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_manual_screen.at:1194" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_manual_screen.at:1194" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_manual_screen.at:1195: \$RUN_PROG_MANUAL ./prog" -at_fn_check_prepare_dynamic "$RUN_PROG_MANUAL ./prog" "run_manual_screen.at:1195" -( $at_check_trace; $RUN_PROG_MANUAL ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_manual_screen.at:1195" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_24 -#AT_START_25 -at_fn_group_banner 25 'run_manual_screen.at:1200' \ - "ERASE EOL" " " 1 -at_xfail=no -( - $as_echo "25. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -$as_echo "run_manual_screen.at:1203" >"$at_check_line_file" -(test "$COB_HAS_CURSES" != "yes") \ - && at_fn_check_skip 77 "$at_srcdir/run_manual_screen.at:1203" - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 success-flag PIC X VALUE 'Y'. - 88 success VALUE 'Y', 'y'. - - SCREEN SECTION. - 01 scr-1. - 03 LINE 1 VALUE 'Enter "y" if all the text after foo on ' - & 'that line alone has been erased.'. - 03 LINE 3 VALUE 'Lorem ipsum dolor sit amet, consectetur ad' - & 'ipiscing elit. Curabitur dapibus dui'. - 03 LINE 4 VALUE 'vitae augue lobortis, non tempor diam tris' - & 'tique. Donec dignissim ex velit, ut'. - 03 LINE 5 VALUE 'efficitur tellus pharetra at. Curabitur at' - & ' condimentum nunc, nec accumsan'. - 03 LINE 6 VALUE 'nulla. Nulla at feugiat elit, eget condime' - & 'ntum justo. Nam lorem lectus,'. - 03 LINE 7 VALUE 'imperdiet sit amet odio eu, eleifend conse' - & 'ctetur ligula. Duis diam felis, porta'. - 03 LINE 8 VALUE 'id diam id, ultrices finibus augue. Mauris' - & ' imperdiet, dolor sed sodales porta,'. - 03 LINE 9 VALUE 'justo nunc consequat nulla, iaculis venena' - & 'tis lorem libero sit amet'. - 03 LINE 10 VALUE 'magna. Nullam pulvinar nullam.'. - 03 success-field LINE + 2, PIC X, REQUIRED, - USING success-flag. - - 01 scr-2. - 03 LINE 6 COL 8 VALUE 'foo' ERASE EOL, HIGHLIGHT. - - PROCEDURE DIVISION. - DISPLAY scr-1 - DISPLAY scr-2 - ACCEPT success-field - - IF success AND COB-CRT-STATUS = 0 - GOBACK RETURNING 0 - ELSE - GOBACK RETURNING 1 - END-IF - . -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_manual_screen.at:1252: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_manual_screen.at:1252" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_manual_screen.at:1252" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_manual_screen.at:1253: \$RUN_PROG_MANUAL ./prog" -at_fn_check_prepare_dynamic "$RUN_PROG_MANUAL ./prog" "run_manual_screen.at:1253" -( $at_check_trace; $RUN_PROG_MANUAL ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_manual_screen.at:1253" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_25 -#AT_START_26 -at_fn_group_banner 26 'run_manual_screen.at:1258' \ - "ERASE ignored in ACCEPT" " " 1 -at_xfail=no -( - $as_echo "26. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -$as_echo "run_manual_screen.at:1261" >"$at_check_line_file" -(test "$COB_HAS_CURSES" != "yes") \ - && at_fn_check_skip 77 "$at_srcdir/run_manual_screen.at:1261" - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 success-flag PIC X VALUE 'Y'. - 88 success VALUE 'Y', 'y'. - - SCREEN SECTION. - 01 scr. - 03 LINE 1 VALUE 'Enter "y" if you can see lorem ipsum ' - & 'filler text.'. - 03 LINE 3 VALUE 'Lorem ipsum dolor sit amet, consectetur ad' - & 'ipiscing elit. Curabitur dapibus dui'. - 03 LINE 4 VALUE 'vitae augue lobortis, non tempor diam tris' - & 'tique. Donec dignissim ex velit, ut'. - 03 LINE 5 VALUE 'efficitur tellus pharetra at. Curabitur at' - & ' condimentum nunc, nec accumsan'. - 03 LINE 6 VALUE 'nulla. Nulla at feugiat elit, eget condime' - & 'ntum justo. Nam lorem lectus,'. - 03 LINE 7 VALUE 'imperdiet sit amet odio eu, eleifend conse' - & 'ctetur ligula. Duis diam felis, porta'. - 03 LINE 8 VALUE 'id diam id, ultrices finibus augue. Mauris' - & ' imperdiet, dolor sed sodales porta,'. - 03 LINE 9 VALUE 'justo nunc consequat nulla, iaculis venena' - & 'tis lorem libero sit amet'. - 03 LINE 10 VALUE 'magna. Nullam pulvinar nullam.'. - 03 LINE 3 ERASE EOS. - 03 success-field LINE 12, PIC X, REQUIRED, - USING success-flag. - - PROCEDURE DIVISION. - DISPLAY scr - ACCEPT scr - - IF success AND COB-CRT-STATUS = 0 - GOBACK RETURNING 0 - ELSE - GOBACK RETURNING 1 - END-IF - . -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_manual_screen.at:1307: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_manual_screen.at:1307" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_manual_screen.at:1307" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_manual_screen.at:1308: \$RUN_PROG_MANUAL ./prog" -at_fn_check_prepare_dynamic "$RUN_PROG_MANUAL ./prog" "run_manual_screen.at:1308" -( $at_check_trace; $RUN_PROG_MANUAL ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_manual_screen.at:1308" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_26 -#AT_START_27 -at_fn_group_banner 27 'run_manual_screen.at:1313' \ - "FULL and REQUIRED" " " 1 -at_xfail=no -( - $as_echo "27. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -$as_echo "run_manual_screen.at:1316" >"$at_check_line_file" -(test "$COB_HAS_CURSES" != "yes") \ - && at_fn_check_skip 77 "$at_srcdir/run_manual_screen.at:1316" - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 dummy PIC X(10). - 01 success-flag PIC X. - 88 success VALUE 'Y', 'y'. - - SCREEN SECTION. - 01 scr. - 03 PIC X(80) - VALUE 'Enter "y" if you cannot continue without filling ' - & 'all of the below field:'. - 03 LINE + 1, PIC X(10), FULL, REQUIRED, TO dummy. - *> no initial value for success as we request input - 03 success-field LINE + 2, PIC X, REQUIRED, TO success-flag. - - PROCEDURE DIVISION. - DISPLAY scr - ACCEPT scr - - IF success AND COB-CRT-STATUS = 0 - GOBACK RETURNING 0 - ELSE - GOBACK RETURNING 1 - END-IF - . -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_manual_screen.at:1348: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_manual_screen.at:1348" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_manual_screen.at:1348" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_manual_screen.at:1349: \$RUN_PROG_MANUAL ./prog" -at_fn_check_prepare_dynamic "$RUN_PROG_MANUAL ./prog" "run_manual_screen.at:1349" -( $at_check_trace; $RUN_PROG_MANUAL ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_manual_screen.at:1349" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_27 -#AT_START_28 -at_fn_group_banner 28 'run_manual_screen.at:1354' \ - "HIGHLIGHT" " " 1 -at_xfail=no -( - $as_echo "28. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -$as_echo "run_manual_screen.at:1357" >"$at_check_line_file" -(test "$COB_HAS_CURSES" != "yes") \ - && at_fn_check_skip 77 "$at_srcdir/run_manual_screen.at:1357" - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 success-flag PIC X VALUE 'Y'. - 88 success VALUE 'Y', 'y'. - - SCREEN SECTION. - 01 scr. - 03 PIC X(80) - VALUE 'Enter "y" if the text below is bright ' - & '(highlighted):'. - 03 LINE + 1, PIC X(10) VALUE 'Highlight' HIGHLIGHT. - 03 success-field LINE + 2, PIC X, REQUIRED, - USING success-flag. - - PROCEDURE DIVISION. - DISPLAY scr - ACCEPT scr - - IF success AND COB-CRT-STATUS = 0 - GOBACK RETURNING 0 - ELSE - GOBACK RETURNING 1 - END-IF - . -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_manual_screen.at:1388: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_manual_screen.at:1388" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_manual_screen.at:1388" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_manual_screen.at:1389: \$RUN_PROG_MANUAL ./prog" -at_fn_check_prepare_dynamic "$RUN_PROG_MANUAL ./prog" "run_manual_screen.at:1389" -( $at_check_trace; $RUN_PROG_MANUAL ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_manual_screen.at:1389" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_28 -#AT_START_29 -at_fn_group_banner 29 'run_manual_screen.at:1394' \ - "INITIAL" " " 1 -at_xfail=no -( - $as_echo "29. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -$as_echo "run_manual_screen.at:1397" >"$at_check_line_file" -(test "$COB_HAS_CURSES" != "yes") \ - && at_fn_check_skip 77 "$at_srcdir/run_manual_screen.at:1397" - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 dummy-1 PIC X(10). - 01 dummy-2 PIC X(10). - 01 dummy-3 PIC X(10). - - 01 success-flag PIC X VALUE 'Y'. - 88 success VALUE 'Y', 'y'. - - SCREEN SECTION. - 01 scr. - 03 PIC X(80) VALUE 'Enter "y" if the cursor is initially '- - 'located at the start of the rightmost'. - 03 LINE + 1, PIC X(80) VALUE 'field.'. - 03 LINE + 2, PIC X(10) TO dummy-1. - 03 COL + 2, PIC X(10) TO dummy-2. - 03 COL + 2, PIC X(10) TO dummy-3, INITIAL. - 03 success-field LINE + 2, PIC X, REQUIRED, - USING success-flag. - - PROCEDURE DIVISION. - DISPLAY scr - ACCEPT scr - - IF success AND COB-CRT-STATUS = 0 - GOBACK RETURNING 0 - ELSE - GOBACK RETURNING 1 - END-IF - . -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_manual_screen.at:1435: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_manual_screen.at:1435" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_manual_screen.at:1435" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_manual_screen.at:1436: \$RUN_PROG_MANUAL ./prog" -at_fn_check_prepare_dynamic "$RUN_PROG_MANUAL ./prog" "run_manual_screen.at:1436" -( $at_check_trace; $RUN_PROG_MANUAL ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_manual_screen.at:1436" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_29 -#AT_START_30 -at_fn_group_banner 30 'run_manual_screen.at:1441' \ - "LEFTLINE" " " 1 -at_xfail=yes -( - $as_echo "30. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -$as_echo "run_manual_screen.at:1444" >"$at_check_line_file" -(test "$COB_HAS_CURSES" != "yes") \ - && at_fn_check_skip 77 "$at_srcdir/run_manual_screen.at:1444" - -# Currently not implemented - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 success-flag PIC X VALUE 'Y'. - 88 success VALUE 'Y', 'y'. - - SCREEN SECTION. - 01 scr. - 03 PIC X(80) - VALUE 'Enter "y" if the string has a vertical line to ' - & 'its left:'. - 03 LINE + 1, COL 2, PIC X(10) VALUE 'Leftline' LEFTLINE. - 03 success-field LINE + 2, PIC X, REQUIRED, - USING success-flag. - - PROCEDURE DIVISION. - DISPLAY scr - ACCEPT scr - - IF success AND COB-CRT-STATUS = 0 - GOBACK RETURNING 0 - ELSE - GOBACK RETURNING 1 - END-IF - . -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_manual_screen.at:1478: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_manual_screen.at:1478" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_manual_screen.at:1478" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_manual_screen.at:1479: \$RUN_PROG_MANUAL ./prog" -at_fn_check_prepare_dynamic "$RUN_PROG_MANUAL ./prog" "run_manual_screen.at:1479" -( $at_check_trace; $RUN_PROG_MANUAL ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_manual_screen.at:1479" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_30 -#AT_START_31 -at_fn_group_banner 31 'run_manual_screen.at:1484' \ - "LOWLIGHT" " " 1 -at_xfail=no -( - $as_echo "31. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -$as_echo "run_manual_screen.at:1487" >"$at_check_line_file" -(test "$COB_HAS_CURSES" != "yes") \ - && at_fn_check_skip 77 "$at_srcdir/run_manual_screen.at:1487" - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 success-flag PIC X VALUE 'Y'. - 88 success VALUE 'Y', 'y'. - - SCREEN SECTION. - 01 scr. - 03 PIC X(80) - VALUE 'Enter "y" if the string below is dim (lowlight):'. - 03 LINE + 1, PIC X(10) VALUE 'Lowlight' LOWLIGHT. - 03 success-field LINE + 2, PIC X, REQUIRED, - USING success-flag. - - PROCEDURE DIVISION. - DISPLAY scr - ACCEPT scr - - IF success AND COB-CRT-STATUS = 0 - GOBACK RETURNING 0 - ELSE - GOBACK RETURNING 1 - END-IF - . -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_manual_screen.at:1517: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_manual_screen.at:1517" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_manual_screen.at:1517" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_manual_screen.at:1518: \$RUN_PROG_MANUAL ./prog" -at_fn_check_prepare_dynamic "$RUN_PROG_MANUAL ./prog" "run_manual_screen.at:1518" -( $at_check_trace; $RUN_PROG_MANUAL ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_manual_screen.at:1518" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_31 -#AT_START_32 -at_fn_group_banner 32 'run_manual_screen.at:1523' \ - "OVERLINE" " " 1 -at_xfail=yes -( - $as_echo "32. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -$as_echo "run_manual_screen.at:1526" >"$at_check_line_file" -(test "$COB_HAS_CURSES" != "yes") \ - && at_fn_check_skip 77 "$at_srcdir/run_manual_screen.at:1526" - -# Currently not implemented - - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 success-flag PIC X VALUE 'Y'. - 88 success VALUE 'Y', 'y'. - - SCREEN SECTION. - 01 scr. - 03 PIC X(80) - VALUE 'Enter "y" if the string below is overlined:'. - 03 LINE + 1, PIC X(10) VALUE 'Overline' OVERLINE. - 03 success-field LINE + 2, PIC X, REQUIRED, - USING success-flag. - - PROCEDURE DIVISION. - DISPLAY scr - ACCEPT scr - - IF success AND COB-CRT-STATUS = 0 - GOBACK RETURNING 0 - ELSE - GOBACK RETURNING 1 - END-IF - . -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_manual_screen.at:1559: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_manual_screen.at:1559" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_manual_screen.at:1559" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_manual_screen.at:1560: \$RUN_PROG_MANUAL ./prog" -at_fn_check_prepare_dynamic "$RUN_PROG_MANUAL ./prog" "run_manual_screen.at:1560" -( $at_check_trace; $RUN_PROG_MANUAL ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_manual_screen.at:1560" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_32 -#AT_START_33 -at_fn_group_banner 33 'run_manual_screen.at:1565' \ - "REVERSE-VIDEO" " " 1 -at_xfail=no -( - $as_echo "33. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -$as_echo "run_manual_screen.at:1568" >"$at_check_line_file" -(test "$COB_HAS_CURSES" != "yes") \ - && at_fn_check_skip 77 "$at_srcdir/run_manual_screen.at:1568" - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 success-flag PIC X VALUE 'Y'. - 88 success VALUE 'Y', 'y'. - - SCREEN SECTION. - 01 scr. - 03 PIC X(80) - VALUE 'Enter "y" if the background and foreground ' - & 'colours of the string below have'. - 03 LINE + 1, PIC X(80) VALUE 'swapped:'. - 03 LINE + 1, PIC X(20) VALUE 'Reversed colours' - REVERSE-VIDEO. - 03 success-field LINE + 2, PIC X USING success-flag. - - PROCEDURE DIVISION. - DISPLAY scr - ACCEPT scr - - IF success AND COB-CRT-STATUS = 0 - GOBACK RETURNING 0 - ELSE - GOBACK RETURNING 1 - END-IF - . -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_manual_screen.at:1600: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_manual_screen.at:1600" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_manual_screen.at:1600" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_manual_screen.at:1601: \$RUN_PROG_MANUAL ./prog" -at_fn_check_prepare_dynamic "$RUN_PROG_MANUAL ./prog" "run_manual_screen.at:1601" -( $at_check_trace; $RUN_PROG_MANUAL ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_manual_screen.at:1601" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_33 -#AT_START_34 -at_fn_group_banner 34 'run_manual_screen.at:1606' \ - "SECURE" " " 1 -at_xfail=no -( - $as_echo "34. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -$as_echo "run_manual_screen.at:1609" >"$at_check_line_file" -(test "$COB_HAS_CURSES" != "yes") \ - && at_fn_check_skip 77 "$at_srcdir/run_manual_screen.at:1609" - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 dummy PIC X(10). - 01 success-flag PIC X VALUE 'Y'. - 88 success VALUE 'Y', 'y'. - - SCREEN SECTION. - 01 scr. - 03 PIC X(80) - VALUE 'Enter "y" if text in the field below is replaced ' - & 'with asterisks:'. - 03 LINE + 1, PIC X(10) SECURE TO dummy, PROMPT CHARACTER - "-". - 03 success-field LINE + 2, PIC X, REQUIRED, - USING success-flag. - - PROCEDURE DIVISION. - DISPLAY scr - ACCEPT scr - - IF success AND COB-CRT-STATUS = 0 - GOBACK RETURNING 0 - ELSE - GOBACK RETURNING 1 - END-IF - . -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_manual_screen.at:1642: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_manual_screen.at:1642" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_manual_screen.at:1642" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_manual_screen.at:1643: \$RUN_PROG_MANUAL ./prog" -at_fn_check_prepare_dynamic "$RUN_PROG_MANUAL ./prog" "run_manual_screen.at:1643" -( $at_check_trace; $RUN_PROG_MANUAL ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_manual_screen.at:1643" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_34 -#AT_START_35 -at_fn_group_banner 35 'run_manual_screen.at:1648' \ - "SIZE with items" " " 1 -at_xfail=no -( - $as_echo "35. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -$as_echo "run_manual_screen.at:1651" >"$at_check_line_file" -(test "$COB_HAS_CURSES" != "yes") \ - && at_fn_check_skip 77 "$at_srcdir/run_manual_screen.at:1651" - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 success-flag PIC X VALUE 'Y'. - 88 success VALUE 'Y', 'y'. - - 01 num-1 PIC 9(5) VALUE 12345. - 01 num-2 PIC X(10) VALUE '12345'. - 01 num-3 PIC 9(4) VALUE 1234. - - 01 four PIC 9 VALUE 4. - - PROCEDURE DIVISION. - DISPLAY 'Enter "y" if you see exactly four rows of 1234, all' - & ' aligned.' LINE 1 - - DISPLAY num-1 LINE 3 COL 3, SIZE 4; - num-2 LINE 4 COL 3, SIZE four; - num-3 LINE 5 COL 3, SIZE 8; - '1234' LINE 6 COL 3, SIZE ZERO - - ACCEPT success-flag LINE 8, REQUIRED UPDATE - - IF success AND COB-CRT-STATUS = 0 - GOBACK RETURNING 0 - ELSE - GOBACK RETURNING 1 - END-IF - . -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_manual_screen.at:1686: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_manual_screen.at:1686" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_manual_screen.at:1686" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_manual_screen.at:1687: \$RUN_PROG_MANUAL ./prog" -at_fn_check_prepare_dynamic "$RUN_PROG_MANUAL ./prog" "run_manual_screen.at:1687" -( $at_check_trace; $RUN_PROG_MANUAL ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_manual_screen.at:1687" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_35 -#AT_START_36 -at_fn_group_banner 36 'run_manual_screen.at:1692' \ - "SIZE with figurative constants" " " 1 -at_xfail=no -( - $as_echo "36. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -$as_echo "run_manual_screen.at:1695" >"$at_check_line_file" -(test "$COB_HAS_CURSES" != "yes") \ - && at_fn_check_skip 77 "$at_srcdir/run_manual_screen.at:1695" - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 success-flag PIC X VALUE 'Y'. - 88 success VALUE 'Y', 'y'. - - PROCEDURE DIVISION. - DISPLAY 'Enter "y" if you see exactly three rows of quotes, ' - & 'zeroes and ''abc'',', LINE 1 - DISPLAY '8 characters long, all aligned.', LINE 2 - - DISPLAY QUOTES LINE 4 COL 3, SIZE 8; - ZEROES LINE 5 COL 3, SIZE 8; - ALL 'abc' LINE 6 COL 3, SIZE 8 - - DISPLAY '123456789' LINE 7 COL 3 - DISPLAY SPACE LINE 7 COL 3, SIZE 9 - - ACCEPT success-flag LINE 8, REQUIRED UPDATE - - IF success AND COB-CRT-STATUS = 0 - GOBACK RETURNING 0 - ELSE - GOBACK RETURNING 1 - END-IF - . -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_manual_screen.at:1727: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_manual_screen.at:1727" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_manual_screen.at:1727" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_manual_screen.at:1728: \$RUN_PROG_MANUAL ./prog" -at_fn_check_prepare_dynamic "$RUN_PROG_MANUAL ./prog" "run_manual_screen.at:1728" -( $at_check_trace; $RUN_PROG_MANUAL ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_manual_screen.at:1728" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_36 -#AT_START_37 -at_fn_group_banner 37 'run_manual_screen.at:1733' \ - "UPDATE" " " 1 -at_xfail=no -( - $as_echo "37. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -$as_echo "run_manual_screen.at:1736" >"$at_check_line_file" -(test "$COB_HAS_CURSES" != "yes") \ - && at_fn_check_skip 77 "$at_srcdir/run_manual_screen.at:1736" - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 n-str PIC X(12) VALUE SPACES. - 01 success-flag PIC X. - 88 success VALUE 'Y', 'y'. - - SCREEN SECTION. - 01 scr. - 03 VALUE 'Enter "y" if the entry field below is filled with' - & ' N''s'. - 03 n-field, LINE + 1, PIC X(12) USING n-str. - 03 success-field, LINE + 2, PIC X, REQUIRED, - TO success-flag, FROM 'Y'. - - PROCEDURE DIVISION. - DISPLAY scr - MOVE ALL 'N' TO n-str - ACCEPT scr - - IF success AND COB-CRT-STATUS = 0 - GOBACK RETURNING 0 - ELSE - GOBACK RETURNING 1 - END-IF - . -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_manual_screen.at:1768: \$COMPILE -fno-accept-update prog.cob" -at_fn_check_prepare_dynamic "$COMPILE -fno-accept-update prog.cob" "run_manual_screen.at:1768" -( $at_check_trace; $COMPILE -fno-accept-update prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_manual_screen.at:1768" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_manual_screen.at:1769: \$RUN_PROG_MANUAL ./prog" -at_fn_check_prepare_dynamic "$RUN_PROG_MANUAL ./prog" "run_manual_screen.at:1769" -( $at_check_trace; $RUN_PROG_MANUAL ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_manual_screen.at:1769" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_37 -#AT_START_38 -at_fn_group_banner 38 'run_manual_screen.at:1774' \ - "UNDERLINE" " " 1 -at_xfail=no -( - $as_echo "38. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -$as_echo "run_manual_screen.at:1777" >"$at_check_line_file" -(test "$COB_HAS_CURSES" != "yes") \ - && at_fn_check_skip 77 "$at_srcdir/run_manual_screen.at:1777" - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 success-flag PIC X VALUE 'Y'. - 88 success VALUE 'Y', 'y'. - - SCREEN SECTION. - 01 scr. - 03 PIC X(80) - VALUE 'Enter "y" if the string below is underlined:'. - 03 LINE + 1, PIC X(10) VALUE 'Underline' UNDERLINE. - 03 success-field LINE + 2, PIC X, REQUIRED, - USING success-flag. - - PROCEDURE DIVISION. - DISPLAY scr - ACCEPT scr - - IF success AND COB-CRT-STATUS = 0 - GOBACK RETURNING 0 - ELSE - GOBACK RETURNING 1 - END-IF - . -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_manual_screen.at:1807: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_manual_screen.at:1807" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_manual_screen.at:1807" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_manual_screen.at:1808: \$RUN_PROG_MANUAL ./prog" -at_fn_check_prepare_dynamic "$RUN_PROG_MANUAL ./prog" "run_manual_screen.at:1808" -( $at_check_trace; $RUN_PROG_MANUAL ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_manual_screen.at:1808" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_38 -#AT_START_39 -at_fn_group_banner 39 'run_manual_screen.at:1813' \ - "HOME key" " " 1 -at_xfail=no -( - $as_echo "39. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -$as_echo "run_manual_screen.at:1816" >"$at_check_line_file" -(test "$COB_HAS_CURSES" != "yes") \ - && at_fn_check_skip 77 "$at_srcdir/run_manual_screen.at:1816" - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 success-flag PIC X VALUE 'Y'. - 88 success VALUE 'Y', 'y'. - 01 ws-x-20 PIC X(20). - PROCEDURE DIVISION. - DISPLAY "Enter 'y' if multiple presses of the HOME key" - LINE 1 COLUMN 1. - DISPLAY "go to the beginning of the field and the beginning" - LINE 2 COLUMN 1. - DISPLAY "of the characters." - LINE 3 COLUMN 1. - - MOVE " ABC " TO WS-X-20. - ACCEPT WS-X-20 - LINE 5 COLUMN 1 - WITH - AUTO-SKIP - SIZE 10 - UPDATE. - - ACCEPT SUCCESS-FLAG - LINE 7 COLUMN 1 - WITH UPDATE. - - IF success AND COB-CRT-STATUS = 0 - GOBACK RETURNING 0 - ELSE - GOBACK RETURNING 1 - END-IF - . -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_manual_screen.at:1854: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_manual_screen.at:1854" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_manual_screen.at:1854" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_manual_screen.at:1855: \$RUN_PROG_MANUAL ./prog" -at_fn_check_prepare_dynamic "$RUN_PROG_MANUAL ./prog" "run_manual_screen.at:1855" -( $at_check_trace; $RUN_PROG_MANUAL ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_manual_screen.at:1855" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_39 -#AT_START_40 -at_fn_group_banner 40 'run_manual_screen.at:1860' \ - "END key" " " 1 -at_xfail=no -( - $as_echo "40. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -$as_echo "run_manual_screen.at:1863" >"$at_check_line_file" -(test "$COB_HAS_CURSES" != "yes") \ - && at_fn_check_skip 77 "$at_srcdir/run_manual_screen.at:1863" - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 success-flag PIC X VALUE 'Y'. - 88 success VALUE 'Y', 'y'. - 01 ws-x-20 PIC X(20). - PROCEDURE DIVISION. - DISPLAY "Enter 'y' if multiple presses of the END key" - LINE 1 COLUMN 1. - DISPLAY "go to the end of the field and just after the end" - LINE 2 COLUMN 1. - DISPLAY "of the characters." - LINE 3 COLUMN 1. - - MOVE " ABC " TO WS-X-20. - ACCEPT WS-X-20 - LINE 5 COLUMN 1 - WITH - AUTO-SKIP - SIZE 10 - UPDATE. - - ACCEPT SUCCESS-FLAG - LINE 7 COLUMN 1 - WITH UPDATE. - - IF success AND COB-CRT-STATUS = 0 - GOBACK RETURNING 0 - ELSE - GOBACK RETURNING 1 - END-IF - . -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_manual_screen.at:1901: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_manual_screen.at:1901" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_manual_screen.at:1901" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_manual_screen.at:1902: \$RUN_PROG_MANUAL ./prog" -at_fn_check_prepare_dynamic "$RUN_PROG_MANUAL ./prog" "run_manual_screen.at:1902" -( $at_check_trace; $RUN_PROG_MANUAL ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_manual_screen.at:1902" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_40 -#AT_START_41 -at_fn_group_banner 41 'run_manual_screen.at:1907' \ - "INSERT key" " " 1 -at_xfail=no -( - $as_echo "41. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -$as_echo "run_manual_screen.at:1910" >"$at_check_line_file" -(test "$COB_HAS_CURSES" != "yes") \ - && at_fn_check_skip 77 "$at_srcdir/run_manual_screen.at:1910" - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 success-flag PIC X VALUE 'Y'. - 88 success VALUE 'Y', 'y'. - 01 ws-x-20 PIC X(20). - PROCEDURE DIVISION. - DISPLAY "Enter 'y' if multiple presses of the INSERT key" - LINE 1 COLUMN 1. - DISPLAY "go back and forth between" - LINE 2 COLUMN 1. - DISPLAY "Insert Mode ON (characters move to the right)" - LINE 3 COLUMN 1. - DISPLAY "and Insert Mode OFF (characters type over)." - LINE 4 COLUMN 1. - - MOVE "ABCD " TO WS-X-20. - ACCEPT WS-X-20 - LINE 6 COLUMN 1 - WITH - AUTO-SKIP - SIZE 10 - UPDATE. - - ACCEPT SUCCESS-FLAG - LINE 8 COLUMN 1 - WITH UPDATE. - - IF success AND COB-CRT-STATUS = 0 - GOBACK RETURNING 0 - ELSE - GOBACK RETURNING 1 - END-IF - . -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_manual_screen.at:1950: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_manual_screen.at:1950" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_manual_screen.at:1950" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_manual_screen.at:1951: \$RUN_PROG_MANUAL ./prog" -at_fn_check_prepare_dynamic "$RUN_PROG_MANUAL ./prog" "run_manual_screen.at:1951" -( $at_check_trace; $RUN_PROG_MANUAL ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_manual_screen.at:1951" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_41 -#AT_START_42 -at_fn_group_banner 42 'run_manual_screen.at:1956' \ - "BACKSPACE key" " " 1 -at_xfail=no -( - $as_echo "42. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -$as_echo "run_manual_screen.at:1959" >"$at_check_line_file" -(test "$COB_HAS_CURSES" != "yes") \ - && at_fn_check_skip 77 "$at_srcdir/run_manual_screen.at:1959" - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 success-flag PIC X VALUE 'Y'. - 88 success VALUE 'Y', 'y'. - 01 ws-x-20 PIC X(20). - PROCEDURE DIVISION. - DISPLAY "Enter 'y' if each press of the BACKSPACE key" - LINE 1 COLUMN 1. - DISPLAY "deletes the character to the left and moves the" - LINE 2 COLUMN 1. - DISPLAY "cursor and remaining characters one space to the" - LINE 3 COLUMN 1. - DISPLAY "left." - LINE 4 COLUMN 1. - - MOVE "ABCD " TO WS-X-20. - ACCEPT WS-X-20 - LINE 6 COLUMN 1 - WITH - AUTO-SKIP - SIZE 10 - UPDATE. - - ACCEPT SUCCESS-FLAG - LINE 8 COLUMN 1 - WITH UPDATE. - - IF success AND COB-CRT-STATUS = 0 - GOBACK RETURNING 0 - ELSE - GOBACK RETURNING 1 - END-IF - . -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_manual_screen.at:1999: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_manual_screen.at:1999" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_manual_screen.at:1999" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_manual_screen.at:2000: \$RUN_PROG_MANUAL ./prog" -at_fn_check_prepare_dynamic "$RUN_PROG_MANUAL ./prog" "run_manual_screen.at:2000" -( $at_check_trace; $RUN_PROG_MANUAL ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_manual_screen.at:2000" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_42 -#AT_START_43 -at_fn_group_banner 43 'run_manual_screen.at:2005' \ - "DELETE key" " " 1 -at_xfail=no -( - $as_echo "43. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -$as_echo "run_manual_screen.at:2008" >"$at_check_line_file" -(test "$COB_HAS_CURSES" != "yes") \ - && at_fn_check_skip 77 "$at_srcdir/run_manual_screen.at:2008" - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 success-flag PIC X VALUE 'Y'. - 88 success VALUE 'Y', 'y'. - 01 ws-x-20 PIC X(20). - PROCEDURE DIVISION. - DISPLAY "Enter 'y' if each press of the DELETE key deletes" - LINE 1 COLUMN 1. - DISPLAY "the cursor character and moves the remaining" - LINE 2 COLUMN 1. - DISPLAY "characters one space to the left. And the cursor" - LINE 3 COLUMN 1. - DISPLAY "does not move." - LINE 4 COLUMN 1. - - MOVE "ABCD " TO WS-X-20. - ACCEPT WS-X-20 - LINE 6 COLUMN 1 - WITH - AUTO-SKIP - SIZE 10 - UPDATE. - - ACCEPT SUCCESS-FLAG - LINE 8 COLUMN 1 - WITH UPDATE. - - IF success AND COB-CRT-STATUS = 0 - GOBACK RETURNING 0 - ELSE - GOBACK RETURNING 1 - END-IF - . -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_manual_screen.at:2048: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_manual_screen.at:2048" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_manual_screen.at:2048" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_manual_screen.at:2049: \$RUN_PROG_MANUAL ./prog" -at_fn_check_prepare_dynamic "$RUN_PROG_MANUAL ./prog" "run_manual_screen.at:2049" -( $at_check_trace; $RUN_PROG_MANUAL ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_manual_screen.at:2049" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_43 -#AT_START_44 -at_fn_group_banner 44 'run_manual_screen.at:2054' \ - "ALT DELETE key" " " 1 -at_xfail=no -( - $as_echo "44. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -$as_echo "run_manual_screen.at:2057" >"$at_check_line_file" -(test "$COB_HAS_CURSES" != "yes") \ - && at_fn_check_skip 77 "$at_srcdir/run_manual_screen.at:2057" - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 success-flag PIC X VALUE 'Y'. - 88 success VALUE 'Y', 'y'. - 01 ws-x-20 PIC X(20). - PROCEDURE DIVISION. - DISPLAY "Enter 'y' if pressing the ALT and DELETE keys" - LINE 1 COLUMN 1. - DISPLAY "deletes all characters from the cursor to the end" - LINE 2 COLUMN 1. - DISPLAY "of the field. And the cursor does not move." - LINE 3 COLUMN 1. - - MOVE "ABCD " TO WS-X-20. - ACCEPT WS-X-20 - LINE 5 COLUMN 1 - WITH - AUTO-SKIP - SIZE 10 - UPDATE. - - ACCEPT SUCCESS-FLAG - LINE 7 COLUMN 1 - WITH UPDATE. - - IF success AND COB-CRT-STATUS = 0 - GOBACK RETURNING 0 - ELSE - GOBACK RETURNING 1 - END-IF - . -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_manual_screen.at:2095: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_manual_screen.at:2095" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_manual_screen.at:2095" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_manual_screen.at:2096: \$RUN_PROG_MANUAL ./prog" -at_fn_check_prepare_dynamic "$RUN_PROG_MANUAL ./prog" "run_manual_screen.at:2096" -( $at_check_trace; $RUN_PROG_MANUAL ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_manual_screen.at:2096" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_44 -#AT_START_45 -at_fn_group_banner 45 'run_manual_screen.at:2101' \ - "ALT LEFT-ARROW key" " " 1 -at_xfail=no -( - $as_echo "45. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -$as_echo "run_manual_screen.at:2104" >"$at_check_line_file" -(test "$COB_HAS_CURSES" != "yes") \ - && at_fn_check_skip 77 "$at_srcdir/run_manual_screen.at:2104" - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 success-flag PIC X VALUE 'Y'. - 88 success VALUE 'Y', 'y'. - 01 ws-x-20 PIC X(20). - PROCEDURE DIVISION. - DISPLAY "Enter 'y' if pressing the ALT and LEFT-ARROW keys" - LINE 1 COLUMN 1. - DISPLAY "at the first column does not exit the field." - LINE 2 COLUMN 1. - DISPLAY "But the LEFT-ARROW without ALT does exit." - LINE 3 COLUMN 1. - - MOVE "ABCD " TO WS-X-20. - ACCEPT WS-X-20 - LINE 5 COLUMN 1 - WITH - AUTO-SKIP - SIZE 10 - UPDATE. - - ACCEPT SUCCESS-FLAG - LINE 7 COLUMN 1 - WITH UPDATE. - - IF success AND COB-CRT-STATUS = 0 - GOBACK RETURNING 0 - ELSE - GOBACK RETURNING 1 - END-IF - . -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_manual_screen.at:2142: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_manual_screen.at:2142" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_manual_screen.at:2142" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_manual_screen.at:2143: \$RUN_PROG_MANUAL ./prog" -at_fn_check_prepare_dynamic "$RUN_PROG_MANUAL ./prog" "run_manual_screen.at:2143" -( $at_check_trace; $RUN_PROG_MANUAL ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_manual_screen.at:2143" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_45 -#AT_START_46 -at_fn_group_banner 46 'run_manual_screen.at:2148' \ - "ALT RIGHT-ARROW key" " " 1 -at_xfail=no -( - $as_echo "46. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -$as_echo "run_manual_screen.at:2151" >"$at_check_line_file" -(test "$COB_HAS_CURSES" != "yes") \ - && at_fn_check_skip 77 "$at_srcdir/run_manual_screen.at:2151" - -cat >prog.cob <<'_ATEOF' - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 success-flag PIC X VALUE 'Y'. - 88 success VALUE 'Y', 'y'. - 01 ws-x-10 PIC X(10). - PROCEDURE DIVISION. - DISPLAY "Enter 'y' if pressing the ALT and RIGHT-ARROW keys" - LINE 1 COLUMN 1. - DISPLAY "at the last column does not exit the field." - LINE 2 COLUMN 1. - DISPLAY "But the RIGHT-ARROW without ALT does exit." - LINE 3 COLUMN 1. - - MOVE "ABCDE" TO WS-X-10. - ACCEPT WS-X-10 - LINE 5 COLUMN 1 - WITH - AUTO-SKIP - SIZE 5 - UPDATE. - - ACCEPT SUCCESS-FLAG - LINE 7 COLUMN 1 - WITH UPDATE. - - IF success AND COB-CRT-STATUS = 0 - GOBACK RETURNING 0 - ELSE - GOBACK RETURNING 1 - END-IF - . -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_manual_screen.at:2189: \$COMPILE prog.cob" -at_fn_check_prepare_dynamic "$COMPILE prog.cob" "run_manual_screen.at:2189" -( $at_check_trace; $COMPILE prog.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_manual_screen.at:2189" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_manual_screen.at:2190: \$RUN_PROG_MANUAL ./prog" -at_fn_check_prepare_dynamic "$RUN_PROG_MANUAL ./prog" "run_manual_screen.at:2190" -( $at_check_trace; $RUN_PROG_MANUAL ./prog -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_manual_screen.at:2190" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_46 -#AT_START_47 -at_fn_group_banner 47 'run_manual_screen.at:2195' \ - "CURSOR clause" " " 1 -at_xfail=no -( - $as_echo "47. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -$as_echo "run_manual_screen.at:2198" >"$at_check_line_file" -(test "$COB_HAS_CURSES" != "yes") \ - && at_fn_check_skip 77 "$at_srcdir/run_manual_screen.at:2198" - -cat >prog1.cob <<'_ATEOF' - - identification division. - program-id. prog. - - environment division. - configuration section. - special-names. - cursor is my-cur. - data division. - working-storage section. - - 01 my-cur. - 05 my-row pic 9(3) value 0. - 05 my-col pic 9(3) value 0. - - 77 loop pic 99. - 77 cursor-moves-here pic x(20). - - screen section. - - 01 screen-example . - 05 message1 value is "row (view only) is " line 1 col 10. - 05 filler from my-row. - - 05 message2 value is "col (adjust only) is " line 2 col 10. - 05 filler using my-col. - - 05 filler using cursor-moves-here line 3 col 14. - - procedure division. - - perform varying loop from 1 by 1 - until loop > 10 - display "screen accept no. " - at line 10 col 4 - loop "/10" - display screen-example - accept screen-example - end-perform - - goback. -_ATEOF - - -cat >prog2.cob <<'_ATEOF' - - identification division. - program-id. prog. - - data division. - working-storage section. - - 01 my-cur is special-names cursor. - 05 my-row pic 9(3) value 0. - 05 my-col pic 9(3) value 0. - - 77 loop pic 99. - 77 cursor-moves-here pic x(20). - - screen section. - - 01 screen-example . - 05 message1 value is "row (view only) is " line 1 col 10. - 05 filler from my-row. - - 05 message2 value is "col (adjust only) is " line 2 col 10. - 05 filler using my-col. - - 05 filler using cursor-moves-here line 3 col 14. - - procedure division. - - perform varying loop from 1 by 1 - until loop > 10 - display "screen accept no. " - at line 10 col 4 - loop "/10" - display screen-example - accept screen-example - end-perform - - goback. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_manual_screen.at:2282: \$COMPILE prog1.cob" -at_fn_check_prepare_dynamic "$COMPILE prog1.cob" "run_manual_screen.at:2282" -( $at_check_trace; $COMPILE prog1.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_manual_screen.at:2282" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_manual_screen.at:2283: \$COMPILE prog2.cob" -at_fn_check_prepare_dynamic "$COMPILE prog2.cob" "run_manual_screen.at:2283" -( $at_check_trace; $COMPILE prog2.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_manual_screen.at:2283" -$at_failed && at_fn_log_failure -$at_traceon; } - - -# user-instructions what to test is missing -$as_echo "run_manual_screen.at:2286" >"$at_check_line_file" -at_fn_check_skip 77 "$at_srcdir/run_manual_screen.at:2286" - -{ set +x -$as_echo "$at_srcdir/run_manual_screen.at:2288: \$RUN_PROG_MANUAL ./prog1" -at_fn_check_prepare_dynamic "$RUN_PROG_MANUAL ./prog1" "run_manual_screen.at:2288" -( $at_check_trace; $RUN_PROG_MANUAL ./prog1 -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_manual_screen.at:2288" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_manual_screen.at:2289: \$RUN_PROG_MANUAL ./prog2" -at_fn_check_prepare_dynamic "$RUN_PROG_MANUAL ./prog2" "run_manual_screen.at:2289" -( $at_check_trace; $RUN_PROG_MANUAL ./prog2 -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_manual_screen.at:2289" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_47 -#AT_START_48 -at_fn_group_banner 48 'run_manual_screen.at:2294' \ - "CRT STATUS clause" " " 1 -at_xfail=no -( - $as_echo "48. $at_setup_line: testing $at_desc ..." - $at_traceon - - - -$as_echo "run_manual_screen.at:2297" >"$at_check_line_file" -(test "$COB_HAS_CURSES" != "yes") \ - && at_fn_check_skip 77 "$at_srcdir/run_manual_screen.at:2297" - -cat >prog1.cob <<'_ATEOF' - - identification division. - program-id. prog. - - environment division. - configuration section. - special-names. - crt status is my-status. - data division. - working-storage section. - - 01 my-status. - 05 one pic X. - 05 two pic X. - 05 three pic X. - 05 four pic X. - - 77 loop pic 99. - 77 test-field pic x(5). - - screen section. - - 01 screen-example . - 05 message1 value is "status: " line 1 col 10. - 05 filler from my-status. - - 05 message2 value is "test-field: " line 2 col 10. - 05 filler using test-field. - - procedure division. - - set environment 'COB_SCREEN_EXCEPTIONS' to 'TRUE' - set environment 'COB_SCREEN_ESC' to 'TRUE' - perform varying loop from 1 by 1 - until loop > 10 - display "screen accept no. " - at line 10 col 4 - loop "/10" - display screen-example - accept screen-example - end-perform - - goback. -_ATEOF - - -cat >prog2.cob <<'_ATEOF' - - identification division. - program-id. prog. - - data division. - working-storage section. - - 77 my-status pic 9(05) is special-names crt status. - - 77 loop pic 99. - 77 test-field pic x(5). - - screen section. - - 01 screen-example . - 05 message1 value is "status: " line 1 col 10. - 05 filler from my-status. - - 05 message2 value is "test-field: " line 2 col 10. - 05 filler using test-field. - - procedure division. - - set environment 'COB_SCREEN_EXCEPTIONS' to 'TRUE' - set environment 'COB_SCREEN_ESC' to 'TRUE' - perform varying loop from 1 by 1 - until loop > 10 - display "screen accept no. " - at line 10 col 4 - loop "/10" - display screen-example - accept screen-example - end-perform - - goback. -_ATEOF - - -{ set +x -$as_echo "$at_srcdir/run_manual_screen.at:2381: \$COMPILE prog1.cob" -at_fn_check_prepare_dynamic "$COMPILE prog1.cob" "run_manual_screen.at:2381" -( $at_check_trace; $COMPILE prog1.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_manual_screen.at:2381" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_manual_screen.at:2382: \$COMPILE prog2.cob" -at_fn_check_prepare_dynamic "$COMPILE prog2.cob" "run_manual_screen.at:2382" -( $at_check_trace; $COMPILE prog2.cob -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_manual_screen.at:2382" -$at_failed && at_fn_log_failure -$at_traceon; } - - -# user-instructions what to test is missing -$as_echo "run_manual_screen.at:2385" >"$at_check_line_file" -at_fn_check_skip 77 "$at_srcdir/run_manual_screen.at:2385" - -{ set +x -$as_echo "$at_srcdir/run_manual_screen.at:2387: \$RUN_PROG_MANUAL ./prog1" -at_fn_check_prepare_dynamic "$RUN_PROG_MANUAL ./prog1" "run_manual_screen.at:2387" -( $at_check_trace; $RUN_PROG_MANUAL ./prog1 -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_manual_screen.at:2387" -$at_failed && at_fn_log_failure -$at_traceon; } - -{ set +x -$as_echo "$at_srcdir/run_manual_screen.at:2388: \$RUN_PROG_MANUAL ./prog2" -at_fn_check_prepare_dynamic "$RUN_PROG_MANUAL ./prog2" "run_manual_screen.at:2388" -( $at_check_trace; $RUN_PROG_MANUAL ./prog2 -) >>"$at_stdout" 2>>"$at_stderr" 5>&- -at_status=$? at_failed=false -$at_check_filter -at_fn_diff_devnull "$at_stderr" || at_failed=: -at_fn_diff_devnull "$at_stdout" || at_failed=: -at_fn_check_status 0 $at_status "$at_srcdir/run_manual_screen.at:2388" -$at_failed && at_fn_log_failure -$at_traceon; } - - - set +x - $at_times_p && times >"$at_times_file" -) 5>&1 2>&1 7>&- | eval $at_tee_pipe -read at_status <"$at_status_file" -#AT_STOP_48 diff -Nru gnucobol-4.0~early~20200606/tests/testsuite_manual.at gnucobol-5/tests/testsuite_manual.at --- gnucobol-4.0~early~20200606/tests/testsuite_manual.at 2020-06-06 20:52:00.000000000 +0000 +++ gnucobol-5/tests/testsuite_manual.at 1970-01-01 00:00:00.000000000 +0000 @@ -1,34 +0,0 @@ -## Copyright (C) 2014-2018 Free Software Foundation, Inc. -## Written by Edward Hart, Simon Sobisch -## -## This file is part of GnuCOBOL. -## -## The GnuCOBOL compiler is free software: you can redistribute it -## and/or modify it under the terms of the GNU General Public License -## as published by the Free Software Foundation, either version 3 of the -## License, or (at your option) any later version. -## -## GnuCOBOL is distributed in the hope that it will be useful, -## but WITHOUT ANY WARRANTY; without even the implied warranty of -## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -## GNU General Public License for more details. -## -## You should have received a copy of the GNU General Public License -## along with GnuCOBOL. If not, see . - -AT_COPYRIGHT([Test cases Copyright (C) 2018 Free Software Foundation, Inc. - -Written by Edward Hart, Simon Sobisch]) - -### GnuCOBOL Test Suite - -AT_INIT([GnuCOBOL Manual Tests]) -AT_COLOR_TESTS - -AT_TESTED([cobc cobcrun]) - - -## Run screen tests -AT_BANNER([Run screen tests]) - -m4_include([run_manual_screen.at]) diff -Nru gnucobol-4.0~early~20200606/tests/testsuite.src/configuration.at gnucobol-5/tests/testsuite.src/configuration.at --- gnucobol-4.0~early~20200606/tests/testsuite.src/configuration.at 2020-06-06 20:52:00.000000000 +0000 +++ gnucobol-5/tests/testsuite.src/configuration.at 1970-01-01 00:00:00.000000000 +0000 @@ -1,802 +0,0 @@ -## Copyright (C) 2014-2020 Free Software Foundation, Inc. -## Written by Simon Sobisch -## -## This file is part of GnuCOBOL. -## -## The GnuCOBOL compiler is free software: you can redistribute it -## and/or modify it under the terms of the GNU General Public License -## as published by the Free Software Foundation, either version 3 of the -## License, or (at your option) any later version. -## -## GnuCOBOL is distributed in the hope that it will be useful, -## but WITHOUT ANY WARRANTY; without even the implied warranty of -## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -## GNU General Public License for more details. -## -## You should have received a copy of the GNU General Public License -## along with GnuCOBOL. If not, see . - -### GnuCOBOL Test Suite - - -AT_SETUP([cobc with standard configuration file]) -AT_KEYWORDS([configuration misc]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - AUTHOR. tester. - DATA DIVISION. - WORKING-STORAGE SECTION. - PROCEDURE DIVISION. - STOP RUN. -]) - -# default configuration permits this extension -AT_CHECK([$COMPILE_ONLY prog.cob], [0], [], -[prog.cob:4: warning: AUTHOR is obsolete in GnuCOBOL -]) - -AT_CLEANUP - - -AT_SETUP([cobc dialect features for all -std]) -AT_KEYWORDS([configuration misc]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - AUTHOR. tester. - DATA DIVISION. - WORKING-STORAGE SECTION. - PROCEDURE DIVISION. - STOP RUN. -]) - -AT_CHECK([$COMPILE_ONLY -std=default prog.cob], [0], [], -[prog.cob:4: warning: AUTHOR is obsolete in GnuCOBOL -]) -AT_CHECK([$COMPILE_ONLY -std=cobol85 prog.cob], [0], [], -[prog.cob:4: warning: AUTHOR is obsolete in COBOL 85 -]) -AT_CHECK([$COMPILE_ONLY -std=cobol2002 prog.cob], [1], [], -[prog.cob:4: error: AUTHOR does not conform to COBOL 2002 -]) -AT_CHECK([$COMPILE_ONLY -std=cobol2014 prog.cob], [1], [], -[prog.cob:4: error: AUTHOR does not conform to COBOL 2014 -]) -AT_CHECK([$COMPILE_ONLY -std=xopen prog.cob], [0], [], -[prog.cob:4: warning: AUTHOR used -]) -AT_CHECK([$COMPILE_ONLY -std=acu-strict prog.cob], [0], [], -[prog.cob:4: warning: AUTHOR is obsolete in ACUCOBOL-GT -]) -AT_CHECK([$COMPILE_ONLY -std=bs2000-strict prog.cob], [1], [], -[prog.cob:4: error: AUTHOR does not conform to BS2000 COBOL -]) -AT_CHECK([$COMPILE_ONLY -std=ibm-strict prog.cob], [0], [], -[prog.cob:4: warning: AUTHOR is obsolete in IBM COBOL -]) -AT_CHECK([$COMPILE_ONLY -std=mf-strict prog.cob], [0], [], -[prog.cob:4: warning: AUTHOR is obsolete in Micro Focus COBOL -]) -AT_CHECK([$COMPILE_ONLY -std=rm-strict prog.cob], [0], [], -[prog.cob:4: warning: AUTHOR is obsolete in RM-COBOL -]) -AT_CHECK([$COMPILE_ONLY -std=realia-strict prog.cob], [0], [], []) -AT_CHECK([$COMPILE_ONLY -std=mvs-strict prog.cob], [0], [], -[prog.cob:4: warning: AUTHOR is obsolete in MVS/VM COBOL -]) -AT_CHECK([$COMPILE_ONLY -std=acu prog.cob], [0], [], []) -AT_CHECK([$COMPILE_ONLY -std=bs2000 prog.cob], [0], [], []) -AT_CHECK([$COMPILE_ONLY -std=ibm prog.cob], [0], [], []) -AT_CHECK([$COMPILE_ONLY -std=mf prog.cob], [0], [], []) -AT_CHECK([$COMPILE_ONLY -std=rm prog.cob], [0], [], []) -AT_CHECK([$COMPILE_ONLY -std=realia prog.cob], [0], [], []) -AT_CHECK([$COMPILE_ONLY -std=mvs prog.cob], [0], [], []) - -AT_CLEANUP - - -AT_SETUP([cobc with configuration file via -std]) -AT_KEYWORDS([configuration misc]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - AUTHOR. tester. - DATA DIVISION. - WORKING-STORAGE SECTION. - PROCEDURE DIVISION. - STOP RUN. -]) - -# check if -std loads configuration file and if override works -AT_CHECK([$COMPILE_ONLY -std=cobol2014 prog.cob], [1], [], -[prog.cob:4: error: AUTHOR does not conform to COBOL 2014 -]) - -AT_CLEANUP - - -AT_SETUP([cobc with standard configuration file via -conf]) -AT_KEYWORDS([configuration misc]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - AUTHOR. tester. - DATA DIVISION. - WORKING-STORAGE SECTION. - PROCEDURE DIVISION. - STOP RUN. -]) - -# check if override via -conf works -AT_CHECK([$COMPILE_ONLY -conf=cobol2014.conf prog.cob], [1], [], -[prog.cob:4: error: AUTHOR does not conform to COBOL 2014 -]) - -AT_CLEANUP - - -AT_SETUP([cobc with own configuration file via -conf]) -AT_KEYWORDS([configuration misc]) - -AT_DATA([test.conf], [ -include "default.conf" -name: "Sample Conf" -comment-paragraphs: ok -]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - AUTHOR. tester. - DATA DIVISION. - WORKING-STORAGE SECTION. - PROCEDURE DIVISION. - STOP RUN. -]) - -# check if override via -conf works and if include works -AT_CHECK([$COMPILE_ONLY -conf=test.conf prog.cob], [0], [], []) - -# check if configuration file loading with full path works -AT_CHECK([$COMPILE_ONLY \ --conf="$(_return_path "$(pwd)/test.conf")" prog.cob], [0], [], []) - -AT_CLEANUP - - -AT_SETUP([cobc configuration: recursive include]) -AT_KEYWORDS([configuration misc]) - -AT_DATA([test.conf], [ -# different line for "include" to check the line number -include "test2.conf" -]) - -AT_DATA([test2.conf], [ -# include in -# line 4 -include "test3.conf" -]) - -AT_DATA([test3.conf], [ -include "test.conf" -]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - PROCEDURE DIVISION. - STOP RUN. -]) - -AT_CHECK([$COMPILE_ONLY -conf=test.conf prog.cob], [1], [], -[configuration error: -test.conf: recursive inclusion -test3.conf:2: configuration file was included here -test2.conf:4: configuration file was included here -test.conf:3: configuration file was included here -]) - -AT_CLEANUP - - -AT_SETUP([cobc with -std and -conf]) -AT_KEYWORDS([configuration misc]) - -AT_DATA([test.conf], [ -include "mf.conf" -name: "Sample Conf" -comment-paragraphs: ok -]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - AUTHOR. tester. - DATA DIVISION. - WORKING-STORAGE SECTION. - PROCEDURE DIVISION. - STOP RUN. -]) - -# check if override via -conf works and if include works -AT_CHECK([$COMPILE_ONLY -std=default -conf=test.conf prog.cob], [0], [], -[configuration warning: test.conf: The previous loaded configuration 'GnuCOBOL' will be discarded. -]) - -AT_CLEANUP - - -AT_SETUP([cobc compiler flag on command line]) -AT_KEYWORDS([configuration misc]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - AUTHOR. tester. - DATA DIVISION. - WORKING-STORAGE SECTION. - PROCEDURE DIVISION. - STOP RUN. -]) - -AT_CHECK([$COMPILE_ONLY -fcomment-paragraphs=ok prog.cob], -[0], [], []) - -AT_CLEANUP - - -AT_SETUP([cobc compiler flag on command line (priority)]) -AT_KEYWORDS([configuration misc]) - -AT_DATA([test.conf], [ -include "default.conf" -name: "Sample Conf" -comment-paragraphs: unconformable -]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - AUTHOR. tester. - DATA DIVISION. - WORKING-STORAGE SECTION. - PROCEDURE DIVISION. - STOP RUN. -]) - -# configuration flags must work -AT_CHECK([$COMPILE_ONLY \ --fcomment-paragraphs=ok prog.cob], [0], [], []) - -# configuration flag on command line must override all (no matter where it's used) -AT_CHECK([$COMPILE_ONLY \ --fcomment-paragraphs=ok -conf=test.conf prog.cob], [0], [], []) -AT_CHECK([$COMPILE_ONLY \ --conf=test.conf -fcomment-paragraphs=ok prog.cob], -[0], [], []) - -AT_CLEANUP - - -AT_SETUP([cobc configuration: entries]) -AT_KEYWORDS([configuration misc]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - PROCEDURE DIVISION. - STOP RUN. -]) - -# conf entries must be clean -AT_CHECK([$COMPILE_ONLY -q \ --fcomment-paragraphsok prog.cob], [1], [], -[cobc: unrecognized option '-fcomment-paragraphsok' -]) -AT_CHECK([$COMPILE_ONLY \ --fassign-clause=cobol-2002 prog.cob], [1], [], -[configuration error: --fassign-clause=cobol-2002: invalid value 'cobol-2002' for configuration tag 'assign-clause'; - should be one of the following values: dynamic, external, mf, ibm -]) -AT_CHECK([$COMPILE_ONLY \ --freserved-words=default prog.cob], [0], [], []) -AT_CHECK([$COMPILE_ONLY \ --freserved-words=defaults prog.cob], [1], [], -[configuration error: --freserved-words=defaults: Could not access word list for 'defaults' -defaults.words: No such file or directory -]) -AT_CHECK([$COMPILE_ONLY \ --fword-length=thirty prog.cob], [1], [], -[configuration error: --fword-length=thirty: invalid value 'thirty' for configuration tag 'word-length'; - must be numeric -]) -AT_CHECK([$COMPILE_ONLY \ --fstandard-define=99 prog.cob], [1], [], -[configuration error: --fstandard-define=99: invalid value '99' for configuration tag 'standard-define'; - maximum value: 9 -]) - -AT_CLEANUP - - -AT_SETUP([cobc configuration: conf missing]) -AT_KEYWORDS([configuration misc]) - -AT_DATA([defunc.conf], [ -include "notthere.conf" -]) - -AT_DATA([defunc2.conf], [ -include -]) - -AT_CHECK([$COMPILE_ONLY -conf=notthere.conf prog.cob], [1], [], -[configuration error: -notthere.conf: No such file or directory -]) -AT_CHECK([$COMPILE_ONLY -conf=defunc.conf prog.cob], [1], [], -[configuration error: -notthere.conf: No such file or directory -defunc.conf:2: configuration file was included here -]) -AT_CHECK([$COMPILE_ONLY -conf=defunc2.conf prog.cob], [1], [], -[configuration error: -defunc2.conf:2: invalid configuration tag 'include' -]) - -AT_CLEANUP - - -AT_SETUP([cobc configuration: conf optional]) -AT_KEYWORDS([configuration misc]) - -AT_DATA([defunc.conf], [ -include "default.conf" -includeif "notthere.conf" -]) - -AT_DATA([test.conf], [ -include "default.conf" -include "test2.conf" -]) - -AT_DATA([test2.conf], [ -name: "Sample Conf" -comment-paragraphs: ok -]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - AUTHOR. tester. - DATA DIVISION. - WORKING-STORAGE SECTION. - PROCEDURE DIVISION. - STOP RUN. -]) - -AT_CHECK([$COMPILE_ONLY -conf=defunc.conf prog.cob], [0], [], -[prog.cob:4: warning: AUTHOR is obsolete in GnuCOBOL -]) -AT_CHECK([$COMPILE_ONLY -conf=test.conf prog.cob], [0], [], []) - -AT_CLEANUP - - -AT_SETUP([cobc configuration: incomplete]) -AT_KEYWORDS([configuration misc]) - -AT_DATA([test.conf], [ -name: "Empty Conf" -]) - -# check if incomplete configuration result in error -AT_CHECK([$COMPILE_ONLY -conf=test.conf prog.cob], [1], [], -[configuration error: -test.conf: missing definitions: - no definition of 'reserved-words' - no definition of 'tab-width' - no definition of 'text-column' - no definition of 'pic-length' - no definition of 'word-length' - no definition of 'literal-length' - no definition of 'numeric-literal-length' - no definition of 'align-record' - no definition of 'align-opt' - no definition of 'standard-define' - no definition of 'binary-size' - no definition of 'binary-byteorder' - no definition of 'assign-clause' - no definition of 'screen-section-rules' - no definition of 'filename-mapping' - no definition of 'pretty-display' - no definition of 'binary-truncate' - no definition of 'complex-odo' - no definition of 'indirect-redefines' - no definition of 'larger-redefines-ok' - no definition of 'relax-syntax-checks' - no definition of 'relax-level-hierarchy' - no definition of 'sticky-linkage' - no definition of 'move-ibm' - no definition of 'perform-osvs' - no definition of 'arithmetic-osvs' - no definition of 'constant-folding' - no definition of 'hostsign' - no definition of 'program-name-redefinition' - no definition of 'accept-update' - no definition of 'accept-auto' - no definition of 'console-is-crt' - no definition of 'no-echo-means-secure' - no definition of 'line-col-zero-default' - no definition of 'report-column-plus' - no definition of 'display-special-fig-consts' - no definition of 'binary-comp-1' - no definition of 'move-non-numeric-lit-to-numeric-is-zero' - no definition of 'implicit-assign-dynamic-var' - no definition of 'comment-paragraphs' - no definition of 'memory-size-clause' - no definition of 'multiple-file-tape-clause' - no definition of 'label-records-clause' - no definition of 'value-of-clause' - no definition of 'data-records-clause' - no definition of 'top-level-occurs-clause' - no definition of 'same-as-clause' - no definition of 'synchronized-clause' - no definition of 'sync-left-right' - no definition of 'special-names-clause' - no definition of 'goto-statement-without-name' - no definition of 'stop-literal-statement' - no definition of 'stop-identifier-statement' - no definition of 'debugging-mode' - no definition of 'use-for-debugging' - no definition of 'padding-character-clause' - no definition of 'next-sentence-phrase' - no definition of 'listing-statements' - no definition of 'title-statement' - no definition of 'entry-statement' - no definition of 'move-noninteger-to-alphanumeric' - no definition of 'occurs-max-length-without-subscript' - no definition of 'length-in-data-division' - no definition of 'move-figurative-constant-to-numeric' - no definition of 'move-figurative-space-to-numeric' - no definition of 'move-figurative-quote-to-numeric' - no definition of 'odo-without-to' - no definition of 'section-segments' - no definition of 'alter-statement' - no definition of 'call-overflow' - no definition of 'numeric-boolean' - no definition of 'hexadecimal-boolean' - no definition of 'national-literals' - no definition of 'hexadecimal-national-literals' - no definition of 'national-character-literals' - no definition of 'hp-octal-literals' - no definition of 'acu-literals' - no definition of 'word-continuation' - no definition of 'not-exception-before-exception' - no definition of 'accept-display-extensions' - no definition of 'renames-uncommon-levels' - no definition of 'symbolic-constant' - no definition of 'constant-78' - no definition of 'constant-01' - no definition of 'perform-varying-without-by' - no definition of 'reference-out-of-declaratives' - no definition of 'reference-bounds-check' - no definition of 'program-prototypes' - no definition of 'call-convention-mnemonic' - no definition of 'call-convention-linkage' - no definition of 'numeric-value-for-edited-item' - no definition of 'incorrect-conf-sec-order' - no definition of 'define-constant-directive' - no definition of 'free-redefines-position' - no definition of 'records-mismatch-record-clause' - no definition of 'record-delimiter' - no definition of 'sequential-delimiters' - no definition of 'record-delim-with-fixed-recs' - no definition of 'missing-statement' - no definition of 'zero-length-literals' - no definition of 'xml-generate-extra-phrases' - no definition of 'continue-after' - no definition of 'goto-entry' - no definition of 'depending-on-not-fixed' - no definition of 'binary-sync-clause' - no definition of 'nonnumeric-with-numeric-group-usage' - no definition of 'assign-variable' - no definition of 'assign-using-variable' - no definition of 'assign-ext-dyn' - no definition of 'assign-disk-from' -]) - -AT_CLEANUP - - -AT_SETUP([runtime configuration]) -AT_KEYWORDS([configuration misc]) - -# check if --runtime-conf exits without error -# don't compare stdout -AT_CHECK([$COBCRUN --runtime-conf], [0], ignore, []) - -# check if --runtime-conf points to a file called "runtime_empty.cfg" -# use tr to remove newlines and spaces as the path likely is split -# into two lines -AT_CHECK([$COBCRUN --runtime-conf | tr -d '\n ' | \ -grep "runtime_empty.cfg"], [0], ignore, []) -AT_CHECK([COB_RUNTIME_CONFIG="" $COBCRUN --runtime-conf | tr -d '\n ' \ -| grep "runtime.cfg"], -[0], ignore, []) - -AT_CLEANUP - - -AT_SETUP([runtime configuration file]) -AT_KEYWORDS([configuration misc]) - -AT_DATA([test.cfg], [ -include "test2.cfg" -]) - -AT_DATA([test2.cfg], [ -physical_cancel true -]) - -AT_DATA([test3.cfg], [ -setenv COB_PHYSICAL_CANCEL=true -]) - - -# verify that default for physical cancel is still "no" -AT_CHECK([$COBCRUN --runtime-conf | \ -grep "COB_PHYSICAL_CANCEL" | grep "no" | grep "default"], [0], ignore, []) - -# verify that override via -c works and if include works -AT_CHECK([$COBCRUN -c test2.cfg --runtime-conf | \ -grep "physical_cancel" | grep "yes"], [0], ignore, []) -AT_CHECK([$COBCRUN -c test.cfg --runtime-conf | \ -grep "physical_cancel" | grep "yes"], [0], ignore, []) -AT_CHECK([$COBCRUN -c test3.cfg --runtime-conf | \ -grep "COB_PHYSICAL_CANCEL" | grep "yes"], [0], ignore, []) - -# verify that that long option works -AT_CHECK([$COBCRUN --config=test3.cfg --runtime-conf | \ -grep "COB_PHYSICAL_CANCEL" | grep "yes"], [0], ignore, []) - -# verify that that environment setting works -AT_CHECK([COB_RUNTIME_CONFIG=test3.cfg $COBCRUN --runtime-conf | \ -grep "COB_PHYSICAL_CANCEL" | grep "yes"], [0], ignore, []) - -# verify that configuration file loading with full path works -AT_CHECK([$COBCRUN -c "$(_return_path "$(pwd)/test.cfg")" --runtime-conf], -[0], ignore, []) - -AT_CLEANUP - - -AT_SETUP([runtime configuration: recursive include]) -AT_KEYWORDS([configuration misc]) - -AT_DATA([test.cfg], [ -# different line for "include" to check the line number -include "test2.cfg" -]) - -AT_DATA([test2.cfg], [ -# include in -# line 4 -include "test3.cfg" -]) - -AT_DATA([test3.cfg], [ -include "test.cfg" -]) - -AT_CHECK([$COBCRUN -c test.cfg -r], [1], [], -[configuration error: -test.cfg: recursive inclusion -test3.cfg:2: configuration file was included here -test2.cfg:4: configuration file was included here -test.cfg:3: configuration file was included here -]) - -AT_CLEANUP - - -AT_SETUP([runtime configuration: environment priority]) -AT_KEYWORDS([configuration misc]) - -AT_DATA([test.cfg], [ -physical_cancel true -]) - -AT_CHECK([COB_PHYSICAL_CANCEL=false $COBCRUN -c test.cfg --runtime-conf | \ -grep "COB_PHYSICAL_CANCEL" | grep "no"], [0], ignore, []) - -AT_CLEANUP - - -AT_SETUP([runtime configuration: entries]) -AT_KEYWORDS([configuration misc]) - -AT_CHECK([echo "$PATHSEP"], [0], [; -], [], - -# Previous test "failed" --> PATHSEP isn't ; - -AT_DATA([defunc.cfg], [ -novar -physical_cancel notwithme -load_case insensitive -varseq_format big -sort_chunk 4K -sort_memory 4G # too big by some byte -setenv nothing -sort_chunk -trace_file /tmp:/temp -]) - -# conf entries must be clean -AT_CHECK([$COBCRUN -c defunc.cfg --runtime-conf], [1], [], -[configuration error: -defunc.cfg:2: unknown configuration tag 'novar' -defunc.cfg:3: invalid value 'notwithme' for configuration tag 'physical_cancel'; - should be one of the following values: true, false -defunc.cfg:4: invalid value 'insensitive' for configuration tag 'load_case'; - should be one of the following values: LOWER(1), UPPER(2), not set(0) -defunc.cfg:5: invalid value 'big' for configuration tag 'varseq_format'; - should be one of the following values: 0, 1, 2, 3, mf, gc, b4, b32, l4, l32 -defunc.cfg:6: invalid value '4K' for configuration tag 'sort_chunk'; - minimum value: 131072 -defunc.cfg:7: invalid value '4G' for configuration tag 'sort_memory'; - maximum value: 4294967294 -defunc.cfg:8: WARNING - 'setenv nothing' without a value - ignored! -defunc.cfg:9: WARNING - 'sort_chunk' without a value - ignored! -defunc.cfg:10: invalid value '/tmp:/temp' for configuration tag 'trace_file'; - should not contain ':' -]) - -, - -# Previous test "passed" --> PATHSEP is ; - -AT_DATA([defunc.cfg], [ -novar -physical_cancel notwithme -load_case insensitive -varseq_format big -sort_chunk 4K -sort_memory 4G # too big by some byte -setenv nothing -sort_chunk -trace_file C:\tmp;C:\temp -]) - -# conf entries must be clean -AT_CHECK([$COBCRUN -c defunc.cfg --runtime-conf], [1], [], -[configuration error: -defunc.cfg:2: unknown configuration tag 'novar' -defunc.cfg:3: invalid value 'notwithme' for configuration tag 'physical_cancel'; - should be one of the following values: true, false -defunc.cfg:4: invalid value 'insensitive' for configuration tag 'load_case'; - should be one of the following values: LOWER(1), UPPER(2), not set(0) -defunc.cfg:5: invalid value 'big' for configuration tag 'varseq_format'; - should be one of the following values: 0, 1, 2, 3, mf, gc, b4, b32, l4, l32 -defunc.cfg:6: invalid value '4K' for configuration tag 'sort_chunk'; - minimum value: 131072 -defunc.cfg:7: invalid value '4G' for configuration tag 'sort_memory'; - maximum value: 4294967294 -defunc.cfg:8: WARNING - 'setenv nothing' without a value - ignored! -defunc.cfg:9: WARNING - 'sort_chunk' without a value - ignored! -defunc.cfg:10: invalid value 'C:\tmp;C:\temp' for configuration tag 'trace_file'; - should not contain ';' -]) - -) - -AT_CLEANUP - - -AT_SETUP([runtime configuration: conf missing]) -AT_KEYWORDS([configuration misc]) - -AT_DATA([defunc.cfg], [ -include "notthere.cfg" -]) - -AT_DATA([defunc2.cfg], [ -include -]) - -AT_CHECK([$COBCRUN -c notthere.cfg --runtime-conf], [1], [], -[configuration error: -notthere.cfg: No such file or directory -]) -AT_CHECK([$COBCRUN -c defunc.cfg --runtime-conf], [1], [], -[configuration error: -notthere.cfg: No such file or directory -defunc.cfg:2: configuration file was included here -]) - -AT_CHECK([$COBCRUN -c defunc2.cfg --runtime-conf], [1], [], -[configuration error: -defunc2.cfg:2: 'include' without a value! -]) - -AT_CLEANUP - - -AT_SETUP([runtime configuration: conf optional]) -AT_KEYWORDS([configuration misc]) - -AT_DATA([defunc.cfg], [ -include "runtime_empty.cfg" -includeif "notthere.cfg" -]) - -AT_CHECK([$COBCRUN -c defunc.cfg --runtime-conf], [0], ignore, []) - -AT_CLEANUP - - -AT_SETUP([runtime configuration: strings and environment]) -AT_KEYWORDS([configuration environment variable]) - -AT_CHECK([unset greet name; \ -TESTME="this is a test" COB_EXIT_MSG='${greet:Bye} ${name:-user}, ${TESTME}' $COBCRUN --runtime-conf | \ -grep "COB_EXIT_MSG" | grep "Bye user, this is a test"], [0], ignore, []) -AT_CHECK([$COBCRUN --runtime-conf | \ -grep "COB_EXIT_MSG" | grep "end of program, please press a key to exit"], [0], ignore, []) - -AT_CLEANUP - - -AT_SETUP([validation of COB_CONFIG_DIR]) -AT_KEYWORDS([runtime configuration environment variable]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - PROCEDURE DIVISION. - STOP RUN. -]) - -AT_CHECK([echo "$PATHSEP"], [0], [; -], [], - -# Previous test "failed" --> PATHSEP isn't ; - -AT_CHECK([COB_CONFIG_DIR="/temp:/tmp" \ -$COMPILE prog.cob], [1], [], -[cobc: environment variable 'COB_CONFIG_DIR' is '/temp:/tmp'; should not contain ':' -configuration error: -default.conf: No such file or directory -cobc: error: please check environment variables as noted above -]) - -, - -# Previous test "passed" --> PATHSEP is ; - -AT_CHECK([COB_CONFIG_DIR="C:\temp;C:\tmp" \ -$COMPILE prog.cob], [1], [], -[cobc: environment variable 'COB_CONFIG_DIR' is 'C:\temp;C:\tmp'; should not contain ';' -configuration error: -default.conf: No such file or directory -cobc: error: please check environment variables as noted above -]) - -) - -AT_CLEANUP diff -Nru gnucobol-4.0~early~20200606/tests/testsuite.src/data_binary.at gnucobol-5/tests/testsuite.src/data_binary.at --- gnucobol-4.0~early~20200606/tests/testsuite.src/data_binary.at 2020-06-06 20:52:00.000000000 +0000 +++ gnucobol-5/tests/testsuite.src/data_binary.at 1970-01-01 00:00:00.000000000 +0000 @@ -1,1380 +0,0 @@ -## Copyright (C) 2003-2012, 2014-2019 Free Software Foundation, Inc. -## Written by Keisuke Nishida, Roger While, Simon Sobisch, Ron Norman -## -## This file is part of GnuCOBOL. -## -## The GnuCOBOL compiler is free software: you can redistribute it -## and/or modify it under the terms of the GNU General Public License -## as published by the Free Software Foundation, either version 3 of the -## License, or (at your option) any later version. -## -## GnuCOBOL is distributed in the hope that it will be useful, -## but WITHOUT ANY WARRANTY; without even the implied warranty of -## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -## GNU General Public License for more details. -## -## You should have received a copy of the GNU General Public License -## along with GnuCOBOL. If not, see . - -### GnuCOBOL Test Suite - -# 2-4-8 big-endian - -AT_SETUP([BINARY: 2-4-8 big-endian]) -AT_KEYWORDS([binary]) - -AT_DATA([dump.c], [ -#include -#include - -COB_EXT_EXPORT int -dump (unsigned char *data) -{ - int i; - for (i = 0; i < 8; i++) - printf ("%02x", data[[i]]); - puts (""); - return 0; -} -]) - -sed -e 's/@USAGE@/BINARY/' "${TEMPLATE}/numeric-dump.cob" > prog.cob - -AT_CHECK([$COMPILE_MODULE dump.c], [0], [], []) -AT_CHECK([$COMPILE -fbinary-size=2-4-8 \ - -fbinary-byteorder=big-endian prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], -[0001202020202020 -000c202020202020 -007b202020202020 -04d2202020202020 -0000303920202020 -0001e24020202020 -0012d68720202020 -00bc614e20202020 -075bcd1520202020 -00000000499602d2 -00000002dfdc1c35 -0000001cbe991a14 -0000011f71fb04cb -00000b3a73ce2ff2 -00007048860ddf79 -000462d53c8abac0 -002bdc545d6b4b87 -01b69b4ba630f34e -ffff202020202020 -fff4202020202020 -ff85202020202020 -fb2e202020202020 -ffffcfc720202020 -fffe1dc020202020 -ffed297920202020 -ff439eb220202020 -f8a432eb20202020 -ffffffffb669fd2e -fffffffd2023e3cb -ffffffe34166e5ec -fffffee08e04fb35 -fffff4c58c31d00e -ffff8fb779f22087 -fffb9d2ac3754540 -ffd423aba294b479 -fe4964b459cf0cb2 -0000202020202020 -0000202020202020 -0000202020202020 -0000202020202020 -0000000020202020 -0000000020202020 -0000000020202020 -0000000020202020 -0000000020202020 -0000000000000000 -0000000000000000 -0000000000000000 -0000000000000000 -0000000000000000 -0000000000000000 -0000000000000000 -0000000000000000 -0000000000000000 -0000202020202020 -0000202020202020 -0000202020202020 -0000202020202020 -0000000020202020 -0000000020202020 -0000000020202020 -0000000020202020 -0000000020202020 -0000000000000000 -0000000000000000 -0000000000000000 -0000000000000000 -0000000000000000 -0000000000000000 -0000000000000000 -0000000000000000 -0000000000000000 -0000202020202020 -0000202020202020 -0000202020202020 -0000202020202020 -0000000020202020 -0000000020202020 -0000000020202020 -0000000020202020 -0000000020202020 -0000000000000000 -0000000000000000 -0000000000000000 -0000000000000000 -0000000000000000 -0000000000000000 -0000000000000000 -0000000000000000 -0000000000000000 -0000202020202020 -0000202020202020 -0000202020202020 -0000202020202020 -0000000020202020 -0000000020202020 -0000000020202020 -0000000020202020 -0000000020202020 -0000000000000000 -0000000000000000 -0000000000000000 -0000000000000000 -0000000000000000 -0000000000000000 -0000000000000000 -0000000000000000 -0000000000000000 -]) - -sed -e 's/@USAGE@/BINARY/' "${TEMPLATE}/numeric-display.cob" > prog.cob - -AT_CHECK([$COMPILE -fbinary-size=2-4-8 \ - -fbinary-byteorder=big-endian prog.cob -o prog2], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog2], [0], -[1 -12 -123 -1234 -12345 -123456 -1234567 -12345678 -123456789 -1234567890 -12345678901 -123456789012 -1234567890123 -12345678901234 -123456789012345 -1234567890123456 -12345678901234567 -123456789012345678 --1 --12 --123 --1234 --12345 --123456 --1234567 --12345678 --123456789 --1234567890 --12345678901 --123456789012 --1234567890123 --12345678901234 --123456789012345 --1234567890123456 --12345678901234567 --123456789012345678 -]) - -AT_CLEANUP - - -# 2-4-8 native - -AT_SETUP([BINARY: 2-4-8 native]) -AT_KEYWORDS([binary]) - -if test "x$COB_BIGENDIAN" = "xyes"; then -AT_CHECK([true]) -else - - -AT_DATA([dump.c], [ -#include -#include - -COB_EXT_EXPORT int -dump (unsigned char *data) -{ - int i; - for (i = 0; i < 8; i++) - printf ("%02x", data[[i]]); - puts (""); - return 0; -} -]) - -sed -e 's/@USAGE@/BINARY/' "${TEMPLATE}/numeric-dump.cob" > prog.cob - -AT_CHECK([$COMPILE_MODULE dump.c], [0], [], []) -AT_CHECK([$COMPILE -fbinary-size=2-4-8 \ - -fbinary-byteorder=native prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], -[0100202020202020 -0c00202020202020 -7b00202020202020 -d204202020202020 -3930000020202020 -40e2010020202020 -87d6120020202020 -4e61bc0020202020 -15cd5b0720202020 -d202964900000000 -351cdcdf02000000 -141a99be1c000000 -cb04fb711f010000 -f22fce733a0b0000 -79df0d8648700000 -c0ba8a3cd5620400 -874b6b5d54dc2b00 -4ef330a64b9bb601 -ffff202020202020 -f4ff202020202020 -85ff202020202020 -2efb202020202020 -c7cfffff20202020 -c01dfeff20202020 -7929edff20202020 -b29e43ff20202020 -eb32a4f820202020 -2efd69b6ffffffff -cbe32320fdffffff -ece56641e3ffffff -35fb048ee0feffff -0ed0318cc5f4ffff -8720f279b78fffff -404575c32a9dfbff -79b494a2ab23d4ff -b20ccf59b46449fe -0000202020202020 -0000202020202020 -0000202020202020 -0000202020202020 -0000000020202020 -0000000020202020 -0000000020202020 -0000000020202020 -0000000020202020 -0000000000000000 -0000000000000000 -0000000000000000 -0000000000000000 -0000000000000000 -0000000000000000 -0000000000000000 -0000000000000000 -0000000000000000 -0000202020202020 -0000202020202020 -0000202020202020 -0000202020202020 -0000000020202020 -0000000020202020 -0000000020202020 -0000000020202020 -0000000020202020 -0000000000000000 -0000000000000000 -0000000000000000 -0000000000000000 -0000000000000000 -0000000000000000 -0000000000000000 -0000000000000000 -0000000000000000 -0000202020202020 -0000202020202020 -0000202020202020 -0000202020202020 -0000000020202020 -0000000020202020 -0000000020202020 -0000000020202020 -0000000020202020 -0000000000000000 -0000000000000000 -0000000000000000 -0000000000000000 -0000000000000000 -0000000000000000 -0000000000000000 -0000000000000000 -0000000000000000 -0000202020202020 -0000202020202020 -0000202020202020 -0000202020202020 -0000000020202020 -0000000020202020 -0000000020202020 -0000000020202020 -0000000020202020 -0000000000000000 -0000000000000000 -0000000000000000 -0000000000000000 -0000000000000000 -0000000000000000 -0000000000000000 -0000000000000000 -0000000000000000 -]) - -sed -e 's/@USAGE@/BINARY/' "${TEMPLATE}/numeric-display.cob" > prog.cob - -AT_CHECK([$COMPILE -fbinary-size=2-4-8 \ - -fbinary-byteorder=native prog.cob -o prog2], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog2], [0], -[1 -12 -123 -1234 -12345 -123456 -1234567 -12345678 -123456789 -1234567890 -12345678901 -123456789012 -1234567890123 -12345678901234 -123456789012345 -1234567890123456 -12345678901234567 -123456789012345678 --1 --12 --123 --1234 --12345 --123456 --1234567 --12345678 --123456789 --1234567890 --12345678901 --123456789012 --1234567890123 --12345678901234 --123456789012345 --1234567890123456 --12345678901234567 --123456789012345678 -]) -fi - -AT_CLEANUP - - -# 1-2-4-8 big-endian - -AT_SETUP([BINARY: 1-2-4-8 big-endian]) -AT_KEYWORDS([binary]) - -AT_DATA([dump.c], [ -#include -#include - -COB_EXT_EXPORT int -dump (unsigned char *data) -{ - int i; - for (i = 0; i < 8; i++) - printf ("%02x", data[[i]]); - puts (""); - return 0; -} -]) - -sed -e 's/@USAGE@/BINARY/' "${TEMPLATE}/numeric-dump.cob" > prog.cob - -AT_CHECK([$COMPILE_MODULE dump.c], [0], [], []) -AT_CHECK([$COMPILE -fbinary-size=1-2-4-8 \ - -fbinary-byteorder=big-endian prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], -[0120202020202020 -0c20202020202020 -007b202020202020 -04d2202020202020 -0000303920202020 -0001e24020202020 -0012d68720202020 -00bc614e20202020 -075bcd1520202020 -00000000499602d2 -00000002dfdc1c35 -0000001cbe991a14 -0000011f71fb04cb -00000b3a73ce2ff2 -00007048860ddf79 -000462d53c8abac0 -002bdc545d6b4b87 -01b69b4ba630f34e -ff20202020202020 -f420202020202020 -ff85202020202020 -fb2e202020202020 -ffffcfc720202020 -fffe1dc020202020 -ffed297920202020 -ff439eb220202020 -f8a432eb20202020 -ffffffffb669fd2e -fffffffd2023e3cb -ffffffe34166e5ec -fffffee08e04fb35 -fffff4c58c31d00e -ffff8fb779f22087 -fffb9d2ac3754540 -ffd423aba294b479 -fe4964b459cf0cb2 -0020202020202020 -0020202020202020 -0000202020202020 -0000202020202020 -0000000020202020 -0000000020202020 -0000000020202020 -0000000020202020 -0000000020202020 -0000000000000000 -0000000000000000 -0000000000000000 -0000000000000000 -0000000000000000 -0000000000000000 -0000000000000000 -0000000000000000 -0000000000000000 -0020202020202020 -0020202020202020 -0000202020202020 -0000202020202020 -0000000020202020 -0000000020202020 -0000000020202020 -0000000020202020 -0000000020202020 -0000000000000000 -0000000000000000 -0000000000000000 -0000000000000000 -0000000000000000 -0000000000000000 -0000000000000000 -0000000000000000 -0000000000000000 -0020202020202020 -0020202020202020 -0000202020202020 -0000202020202020 -0000000020202020 -0000000020202020 -0000000020202020 -0000000020202020 -0000000020202020 -0000000000000000 -0000000000000000 -0000000000000000 -0000000000000000 -0000000000000000 -0000000000000000 -0000000000000000 -0000000000000000 -0000000000000000 -0020202020202020 -0020202020202020 -0000202020202020 -0000202020202020 -0000000020202020 -0000000020202020 -0000000020202020 -0000000020202020 -0000000020202020 -0000000000000000 -0000000000000000 -0000000000000000 -0000000000000000 -0000000000000000 -0000000000000000 -0000000000000000 -0000000000000000 -0000000000000000 -]) - -sed -e 's/@USAGE@/BINARY/' "${TEMPLATE}/numeric-display.cob" > prog.cob - -AT_CHECK([$COMPILE -fbinary-size=1-2-4-8 \ - -fbinary-byteorder=big-endian prog.cob -o prog2], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog2], [0], -[1 -12 -123 -1234 -12345 -123456 -1234567 -12345678 -123456789 -1234567890 -12345678901 -123456789012 -1234567890123 -12345678901234 -123456789012345 -1234567890123456 -12345678901234567 -123456789012345678 --1 --12 --123 --1234 --12345 --123456 --1234567 --12345678 --123456789 --1234567890 --12345678901 --123456789012 --1234567890123 --12345678901234 --123456789012345 --1234567890123456 --12345678901234567 --123456789012345678 -]) - -AT_CLEANUP - - -# 1-2-4-8 native - -AT_SETUP([BINARY: 1-2-4-8 native]) -AT_KEYWORDS([binary]) - -if test "x$COB_BIGENDIAN" = "xyes"; then -AT_CHECK([true]) -else - -AT_DATA([dump.c], [ -#include -#include - -COB_EXT_EXPORT int -dump (unsigned char *data) -{ - int i; - for (i = 0; i < 8; i++) - printf ("%02x", data[[i]]); - puts (""); - return 0; -} -]) - -sed -e 's/@USAGE@/BINARY/' "${TEMPLATE}/numeric-dump.cob" > prog.cob - -AT_CHECK([$COMPILE_MODULE dump.c], [0], [], []) -AT_CHECK([$COMPILE -fbinary-size=1-2-4-8 \ - -fbinary-byteorder=native prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], -[0120202020202020 -0c20202020202020 -7b00202020202020 -d204202020202020 -3930000020202020 -40e2010020202020 -87d6120020202020 -4e61bc0020202020 -15cd5b0720202020 -d202964900000000 -351cdcdf02000000 -141a99be1c000000 -cb04fb711f010000 -f22fce733a0b0000 -79df0d8648700000 -c0ba8a3cd5620400 -874b6b5d54dc2b00 -4ef330a64b9bb601 -ff20202020202020 -f420202020202020 -85ff202020202020 -2efb202020202020 -c7cfffff20202020 -c01dfeff20202020 -7929edff20202020 -b29e43ff20202020 -eb32a4f820202020 -2efd69b6ffffffff -cbe32320fdffffff -ece56641e3ffffff -35fb048ee0feffff -0ed0318cc5f4ffff -8720f279b78fffff -404575c32a9dfbff -79b494a2ab23d4ff -b20ccf59b46449fe -0020202020202020 -0020202020202020 -0000202020202020 -0000202020202020 -0000000020202020 -0000000020202020 -0000000020202020 -0000000020202020 -0000000020202020 -0000000000000000 -0000000000000000 -0000000000000000 -0000000000000000 -0000000000000000 -0000000000000000 -0000000000000000 -0000000000000000 -0000000000000000 -0020202020202020 -0020202020202020 -0000202020202020 -0000202020202020 -0000000020202020 -0000000020202020 -0000000020202020 -0000000020202020 -0000000020202020 -0000000000000000 -0000000000000000 -0000000000000000 -0000000000000000 -0000000000000000 -0000000000000000 -0000000000000000 -0000000000000000 -0000000000000000 -0020202020202020 -0020202020202020 -0000202020202020 -0000202020202020 -0000000020202020 -0000000020202020 -0000000020202020 -0000000020202020 -0000000020202020 -0000000000000000 -0000000000000000 -0000000000000000 -0000000000000000 -0000000000000000 -0000000000000000 -0000000000000000 -0000000000000000 -0000000000000000 -0020202020202020 -0020202020202020 -0000202020202020 -0000202020202020 -0000000020202020 -0000000020202020 -0000000020202020 -0000000020202020 -0000000020202020 -0000000000000000 -0000000000000000 -0000000000000000 -0000000000000000 -0000000000000000 -0000000000000000 -0000000000000000 -0000000000000000 -0000000000000000 -]) - -sed -e 's/@USAGE@/BINARY/' "${TEMPLATE}/numeric-display.cob" > prog.cob - -AT_CHECK([$COMPILE -fbinary-size=1-2-4-8 \ - -fbinary-byteorder=native prog.cob -o prog2], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog2], [0], -[1 -12 -123 -1234 -12345 -123456 -1234567 -12345678 -123456789 -1234567890 -12345678901 -123456789012 -1234567890123 -12345678901234 -123456789012345 -1234567890123456 -12345678901234567 -123456789012345678 --1 --12 --123 --1234 --12345 --123456 --1234567 --12345678 --123456789 --1234567890 --12345678901 --123456789012 --1234567890123 --12345678901234 --123456789012345 --1234567890123456 --12345678901234567 --123456789012345678 -]) - -fi - -AT_CLEANUP - - -# 1--8 big-endian - -AT_SETUP([BINARY: 1--8 big-endian]) -AT_KEYWORDS([binary]) - -AT_DATA([dump.c], [ -#include -#include - -COB_EXT_EXPORT int -dump (unsigned char *data) -{ - int i; - for (i = 0; i < 8; i++) - printf ("%02x", data[[i]]); - puts (""); - return 0; -} -]) - -sed -e 's/@USAGE@/BINARY/' "${TEMPLATE}/numeric-dump.cob" > prog.cob - -AT_CHECK([$COMPILE_MODULE dump.c], [0], [], []) -AT_CHECK([$COMPILE -fbinary-size=1--8 \ - -fbinary-byteorder=big-endian prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], -[0120202020202020 -0c20202020202020 -007b202020202020 -04d2202020202020 -0030392020202020 -01e2402020202020 -12d6872020202020 -00bc614e20202020 -075bcd1520202020 -00499602d2202020 -02dfdc1c35202020 -1cbe991a14202020 -011f71fb04cb2020 -0b3a73ce2ff22020 -007048860ddf7920 -0462d53c8abac020 -002bdc545d6b4b87 -01b69b4ba630f34e -ff20202020202020 -f420202020202020 -ff85202020202020 -fb2e202020202020 -ffcfc72020202020 -fe1dc02020202020 -ffed297920202020 -ff439eb220202020 -f8a432eb20202020 -ffb669fd2e202020 -fd2023e3cb202020 -ffe34166e5ec2020 -fee08e04fb352020 -f4c58c31d00e2020 -ff8fb779f2208720 -fb9d2ac375454020 -ffd423aba294b479 -fe4964b459cf0cb2 -0020202020202020 -0020202020202020 -0000202020202020 -0000202020202020 -0000002020202020 -0000002020202020 -0000002020202020 -0000000020202020 -0000000020202020 -0000000000202020 -0000000000202020 -0000000000202020 -0000000000002020 -0000000000002020 -0000000000000020 -0000000000000020 -0000000000000000 -0000000000000000 -0020202020202020 -0020202020202020 -0000202020202020 -0000202020202020 -0000002020202020 -0000002020202020 -0000000020202020 -0000000020202020 -0000000020202020 -0000000000202020 -0000000000202020 -0000000000002020 -0000000000002020 -0000000000002020 -0000000000000020 -0000000000000020 -0000000000000000 -0000000000000000 -0020202020202020 -0020202020202020 -0000202020202020 -0000202020202020 -0000002020202020 -0000002020202020 -0000002020202020 -0000000020202020 -0000000020202020 -0000000000202020 -0000000000202020 -0000000000202020 -0000000000002020 -0000000000002020 -0000000000000020 -0000000000000020 -0000000000000000 -0000000000000000 -0020202020202020 -0020202020202020 -0000202020202020 -0000202020202020 -0000002020202020 -0000002020202020 -0000000020202020 -0000000020202020 -0000000020202020 -0000000000202020 -0000000000202020 -0000000000002020 -0000000000002020 -0000000000002020 -0000000000000020 -0000000000000020 -0000000000000000 -0000000000000000 -]) - -sed -e 's/@USAGE@/BINARY/' "${TEMPLATE}/numeric-display.cob" > prog.cob - -AT_CHECK([$COMPILE -fbinary-size=1--8 \ - -fbinary-byteorder=big-endian prog.cob -o prog2], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog2], [0], -[1 -12 -123 -1234 -12345 -123456 -1234567 -12345678 -123456789 -1234567890 -12345678901 -123456789012 -1234567890123 -12345678901234 -123456789012345 -1234567890123456 -12345678901234567 -123456789012345678 --1 --12 --123 --1234 --12345 --123456 --1234567 --12345678 --123456789 --1234567890 --12345678901 --123456789012 --1234567890123 --12345678901234 --123456789012345 --1234567890123456 --12345678901234567 --123456789012345678 -]) - -AT_CLEANUP - - -# 1--8 native - -AT_SETUP([BINARY: 1--8 native]) -AT_KEYWORDS([binary]) - -if test "x$COB_BIGENDIAN" = "xyes"; then -AT_CHECK([true]) -else - -AT_DATA([dump.c], [ -#include -#include - -COB_EXT_EXPORT int -dump (unsigned char *data) -{ - int i; - for (i = 0; i < 8; i++) - printf ("%02x", data[[i]]); - puts (""); - return 0; -} -]) - -sed -e 's/@USAGE@/BINARY/' "${TEMPLATE}/numeric-dump.cob" > prog.cob - -AT_CHECK([$COMPILE_MODULE dump.c], [0], [], []) -AT_CHECK([$COMPILE -fbinary-size=1--8 \ - -fbinary-byteorder=native prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], -[0120202020202020 -0c20202020202020 -7b00202020202020 -d204202020202020 -3930002020202020 -40e2012020202020 -87d6122020202020 -4e61bc0020202020 -15cd5b0720202020 -d202964900202020 -351cdcdf02202020 -141a99be1c202020 -cb04fb711f012020 -f22fce733a0b2020 -79df0d8648700020 -c0ba8a3cd5620420 -874b6b5d54dc2b00 -4ef330a64b9bb601 -ff20202020202020 -f420202020202020 -85ff202020202020 -2efb202020202020 -c7cfff2020202020 -c01dfe2020202020 -7929edff20202020 -b29e43ff20202020 -eb32a4f820202020 -2efd69b6ff202020 -cbe32320fd202020 -ece56641e3ff2020 -35fb048ee0fe2020 -0ed0318cc5f42020 -8720f279b78fff20 -404575c32a9dfb20 -79b494a2ab23d4ff -b20ccf59b46449fe -0020202020202020 -0020202020202020 -0000202020202020 -0000202020202020 -0000002020202020 -0000002020202020 -0000002020202020 -0000000020202020 -0000000020202020 -0000000000202020 -0000000000202020 -0000000000202020 -0000000000002020 -0000000000002020 -0000000000000020 -0000000000000020 -0000000000000000 -0000000000000000 -0020202020202020 -0020202020202020 -0000202020202020 -0000202020202020 -0000002020202020 -0000002020202020 -0000000020202020 -0000000020202020 -0000000020202020 -0000000000202020 -0000000000202020 -0000000000002020 -0000000000002020 -0000000000002020 -0000000000000020 -0000000000000020 -0000000000000000 -0000000000000000 -0020202020202020 -0020202020202020 -0000202020202020 -0000202020202020 -0000002020202020 -0000002020202020 -0000002020202020 -0000000020202020 -0000000020202020 -0000000000202020 -0000000000202020 -0000000000202020 -0000000000002020 -0000000000002020 -0000000000000020 -0000000000000020 -0000000000000000 -0000000000000000 -0020202020202020 -0020202020202020 -0000202020202020 -0000202020202020 -0000002020202020 -0000002020202020 -0000000020202020 -0000000020202020 -0000000020202020 -0000000000202020 -0000000000202020 -0000000000002020 -0000000000002020 -0000000000002020 -0000000000000020 -0000000000000020 -0000000000000000 -0000000000000000 -]) - -sed -e 's/@USAGE@/BINARY/' "${TEMPLATE}/numeric-display.cob" > prog.cob - -AT_CHECK([$COMPILE -fbinary-size=1--8 \ - -fbinary-byteorder=native prog.cob -o prog2], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog2], [0], -[1 -12 -123 -1234 -12345 -123456 -1234567 -12345678 -123456789 -1234567890 -12345678901 -123456789012 -1234567890123 -12345678901234 -123456789012345 -1234567890123456 -12345678901234567 -123456789012345678 --1 --12 --123 --1234 --12345 --123456 --1234567 --12345678 --123456789 --1234567890 --12345678901 --123456789012 --1234567890123 --12345678901234 --123456789012345 --1234567890123456 --12345678901234567 --123456789012345678 -]) - -fi - -AT_CLEANUP - - -# full-print - -AT_SETUP([BINARY: full-print]) -AT_KEYWORDS([binary]) - - -sed -e 's/@USAGE@/BINARY/' "${TEMPLATE}/numeric-display.cob" > prog.cob - -AT_CHECK([$COMPILE -fbinary-size=1--8 \ - -fno-pretty-display prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], -[001 -012 -00123 -01234 -00012345 -00123456 -01234567 -0012345678 -0123456789 -0001234567890 -0012345678901 -0123456789012 -001234567890123 -012345678901234 -00123456789012345 -01234567890123456 -00012345678901234567 -00123456789012345678 --001 --012 --00123 --01234 --00012345 --00123456 --0001234567 --0012345678 --0123456789 --0001234567890 --0012345678901 --000123456789012 --001234567890123 --012345678901234 --00123456789012345 --01234567890123456 --00012345678901234567 --00123456789012345678 -]) - -AT_CLEANUP - - -# 64bit unsigned - -AT_SETUP([BINARY: 64bit unsigned compare]) -AT_KEYWORDS([binary]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 BDU-1 USAGE BINARY-DOUBLE UNSIGNED. - 01 BDU-2 USAGE BINARY-DOUBLE UNSIGNED. - PROCEDURE DIVISION. - MOVE 18446744073709551615 TO BDU-1 BDU-2 - IF BDU-1 NOT EQUAL BDU-2 THEN - DISPLAY "FAIL" - END-DISPLAY. - STOP RUN. -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [], []) - -AT_CLEANUP - - -# bug #173 unsigned values were treated as signed -AT_SETUP([BINARY: 64bit unsigned arithmetic notrunc]) -AT_KEYWORDS([binary]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 WORK-UDWORD-1 PIC 9(18) COMP. - PROCEDURE DIVISION. - MOVE 18446744073709551615 TO WORK-UDWORD-1. - DISPLAY WORK-UDWORD-1 - END-DISPLAY. - COMPUTE WORK-UDWORD-1 = WORK-UDWORD-1 / 2 - END-COMPUTE. - DISPLAY WORK-UDWORD-1 - END-DISPLAY. - STOP RUN. -]) - -AT_CHECK([$COMPILE -fnotrunc prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [18446744073709551615 -09223372036854775807 -], []) - -AT_CLEANUP - - -# bug #197 64bit signed values did not accept min value constant -AT_SETUP([BINARY: 64bit signed negative constant range]) -AT_KEYWORDS([binary]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 WORK-DWORD-1 PIC S9(18) COMP-5 VALUE -9223372036854775808. - PROCEDURE DIVISION. - DISPLAY WORK-DWORD-1 WITH NO ADVANCING - END-DISPLAY. - STOP RUN. -]) - -AT_CHECK([$COMPILE -fnotrunc prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [-09223372036854775808], []) - -AT_CLEANUP - - -AT_SETUP([COMP-4 Truncate]) -AT_KEYWORDS([Numeric]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 RANDOM-ORIGIN-B PIC 9V99 COMP-4. - 01 RANDOM-TARGET-B PIC V99 COMP-4. - 01 RANDOM-ORIGIN-D PIC 9V99 DISPLAY. - 01 RANDOM-TARGET-D PIC V99 DISPLAY. - - PROCEDURE DIVISION. - MOVE 0.12 TO RANDOM-ORIGIN-D - MOVE RANDOM-ORIGIN-D TO RANDOM-TARGET-D - MOVE 0.12 TO RANDOM-ORIGIN-B - MOVE RANDOM-ORIGIN-B TO RANDOM-TARGET-B - IF RANDOM-ORIGIN-D <> RANDOM-ORIGIN-B - DISPLAY "ORIGIN 0.12 WRONG" - DISPLAY "DISPLAY: " RANDOM-ORIGIN-D - " != BINARY : " RANDOM-ORIGIN-B - END-IF. - IF RANDOM-TARGET-D <> RANDOM-TARGET-B - DISPLAY "TARGET .12 WRONG" - DISPLAY "DISPLAY: " RANDOM-TARGET-D - " != BINARY : " RANDOM-TARGET-B - ELSE - DISPLAY "Ok with " RANDOM-TARGET-D " == " RANDOM-TARGET-B - END-IF. - - MOVE 9.85 TO RANDOM-ORIGIN-D - MOVE RANDOM-ORIGIN-D TO RANDOM-TARGET-D - MOVE 9.85 TO RANDOM-ORIGIN-B - MOVE RANDOM-ORIGIN-B TO RANDOM-TARGET-B - IF RANDOM-ORIGIN-D <> RANDOM-ORIGIN-B - DISPLAY "ORIGIN 9.85 WRONG" - DISPLAY "DISPLAY: " RANDOM-ORIGIN-D - " != BINARY : " RANDOM-ORIGIN-B - END-IF. - IF RANDOM-TARGET-D <> RANDOM-TARGET-B - DISPLAY "TARGET .85 WRONG" - DISPLAY "DISPLAY: " RANDOM-TARGET-D - " != BINARY : " RANDOM-TARGET-B - ELSE - DISPLAY "Ok with " RANDOM-TARGET-D " == " RANDOM-TARGET-B - END-IF. - STOP RUN. -]) - -AT_CHECK([$COMPILE -w prog.cob], [0], [], []) - -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], -[Ok with .12 == .12 -Ok with .85 == .85 -], []) - -AT_CLEANUP - - -AT_SETUP([COMP-4 No Truncate]) -AT_KEYWORDS([Numeric]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 RANDOM-ORIGIN-B PIC 9V99 COMP-4. - 01 RANDOM-TARGET-B PIC V99 COMP-4. - 01 RANDOM-ORIGIN-D PIC 9V99 DISPLAY. - 01 RANDOM-TARGET-D PIC V99 DISPLAY. - - PROCEDURE DIVISION. - MOVE 0.12 TO RANDOM-ORIGIN-D - MOVE RANDOM-ORIGIN-D TO RANDOM-TARGET-D - MOVE 0.12 TO RANDOM-ORIGIN-B - MOVE RANDOM-ORIGIN-B TO RANDOM-TARGET-B - IF RANDOM-ORIGIN-D <> RANDOM-ORIGIN-B - DISPLAY "ORIGIN 0.12 WRONG" - DISPLAY "DISPLAY: " RANDOM-ORIGIN-D - " != BINARY : " RANDOM-ORIGIN-B - END-IF. - IF RANDOM-TARGET-D <> RANDOM-TARGET-B - DISPLAY "TARGET .12 WRONG" - DISPLAY "DISPLAY: " RANDOM-TARGET-D - " != BINARY : " RANDOM-TARGET-B - ELSE - DISPLAY "Ok with " RANDOM-TARGET-D " == " RANDOM-TARGET-B - END-IF. - - MOVE 9.85 TO RANDOM-ORIGIN-D - MOVE RANDOM-ORIGIN-D TO RANDOM-TARGET-D - MOVE 9.85 TO RANDOM-ORIGIN-B - MOVE RANDOM-ORIGIN-B TO RANDOM-TARGET-B - IF RANDOM-ORIGIN-D <> RANDOM-ORIGIN-B - DISPLAY "ORIGIN 9.85 WRONG" - DISPLAY "DISPLAY: " RANDOM-ORIGIN-D - " != BINARY : " RANDOM-ORIGIN-B - END-IF. - IF RANDOM-TARGET-D <> RANDOM-TARGET-B - DISPLAY "TARGET .85 WRONG" - DISPLAY "DISPLAY: " RANDOM-TARGET-D - " != BINARY : " RANDOM-TARGET-B - ELSE - DISPLAY "Ok with " RANDOM-TARGET-D " == " RANDOM-TARGET-B - END-IF. - STOP RUN. -]) - -AT_CHECK([$COMPILE -w -fnotrunc prog.cob], [0], [], []) - -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], -[Ok with 12 == 012 -TARGET .85 WRONG -DISPLAY: 85 != BINARY : 217 -], []) - -AT_CLEANUP diff -Nru gnucobol-4.0~early~20200606/tests/testsuite.src/data_display.at gnucobol-5/tests/testsuite.src/data_display.at --- gnucobol-4.0~early~20200606/tests/testsuite.src/data_display.at 2020-06-06 20:52:00.000000000 +0000 +++ gnucobol-5/tests/testsuite.src/data_display.at 1970-01-01 00:00:00.000000000 +0000 @@ -1,222 +0,0 @@ -## Copyright (C) 2003-2012, 2014-2015 Free Software Foundation, Inc. -## Written by Keisuke Nishida, Roger While, Simon Sobisch, Brian Tiffin -## -## This file is part of GnuCOBOL. -## -## The GnuCOBOL compiler is free software: you can redistribute it -## and/or modify it under the terms of the GNU General Public License -## as published by the Free Software Foundation, either version 3 of the -## License, or (at your option) any later version. -## -## GnuCOBOL is distributed in the hope that it will be useful, -## but WITHOUT ANY WARRANTY; without even the implied warranty of -## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -## GNU General Public License for more details. -## -## You should have received a copy of the GNU General Public License -## along with GnuCOBOL. If not, see . - -### GnuCOBOL Test Suite - -AT_SETUP([DISPLAY: Sign ASCII]) -AT_KEYWORDS([display]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 G. - 02 X PIC X(5). - 02 X-9 REDEFINES X PIC 9(4). - 02 X-S9 REDEFINES X PIC S9(4). - 02 X-S9-L REDEFINES X PIC S9(4) LEADING. - 02 X-S9-LS REDEFINES X PIC S9(4) LEADING SEPARATE. - 02 X-S9-T REDEFINES X PIC S9(4) TRAILING. - 02 X-S9-TS REDEFINES X PIC S9(4) TRAILING SEPARATE. - PROCEDURE DIVISION. - MOVE ZERO TO X. MOVE 1234 TO X-9. DISPLAY X - END-DISPLAY. - MOVE ZERO TO X. MOVE 1234 TO X-S9. DISPLAY X - END-DISPLAY. - MOVE ZERO TO X. MOVE -1234 TO X-S9. DISPLAY X - END-DISPLAY. - MOVE ZERO TO X. MOVE 1234 TO X-S9-L. DISPLAY X - END-DISPLAY. - MOVE ZERO TO X. MOVE -1234 TO X-S9-L. DISPLAY X - END-DISPLAY. - MOVE ZERO TO X. MOVE 1234 TO X-S9-LS. DISPLAY X - END-DISPLAY. - MOVE ZERO TO X. MOVE -1234 TO X-S9-LS. DISPLAY X - END-DISPLAY. - MOVE ZERO TO X. MOVE 1234 TO X-S9-T. DISPLAY X - END-DISPLAY. - MOVE ZERO TO X. MOVE -1234 TO X-S9-T. DISPLAY X - END-DISPLAY. - MOVE ZERO TO X. MOVE 1234 TO X-S9-TS. DISPLAY X - END-DISPLAY. - MOVE ZERO TO X. MOVE -1234 TO X-S9-TS. DISPLAY X - END-DISPLAY. - STOP RUN. -]) - -AT_CHECK([$COMPILE -fsign=ascii prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], -[12340 -12340 -123t0 -12340 -q2340 -+1234 --1234 -12340 -123t0 -1234+ -1234- -]) - -AT_CLEANUP - -AT_SETUP([DISPLAY: Sign ASCII (2)]) -AT_KEYWORDS([display]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 G. - 02 X PIC X(10). - 02 X-S99 REDEFINES X PIC S99. - 02 X-S9 REDEFINES X PIC S9 OCCURS 10. - PROCEDURE DIVISION. - MOVE 0 TO X-S9(1). - MOVE 1 TO X-S9(2). - MOVE 2 TO X-S9(3). - MOVE 3 TO X-S9(4). - MOVE 4 TO X-S9(5). - MOVE 5 TO X-S9(6). - MOVE 6 TO X-S9(7). - MOVE 7 TO X-S9(8). - MOVE 8 TO X-S9(9). - MOVE 9 TO X-S9(10). - DISPLAY X NO ADVANCING - END-DISPLAY. - MOVE -10 TO X-S99. MOVE X(2:1) TO X(1:1). - MOVE -1 TO X-S9(2). - MOVE -2 TO X-S9(3). - MOVE -3 TO X-S9(4). - MOVE -4 TO X-S9(5). - MOVE -5 TO X-S9(6). - MOVE -6 TO X-S9(7). - MOVE -7 TO X-S9(8). - MOVE -8 TO X-S9(9). - MOVE -9 TO X-S9(10). - DISPLAY X NO ADVANCING - END-DISPLAY. - STOP RUN. -]) - -AT_CHECK([$COMPILE -fsign=ascii prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [0123456789pqrstuvwxy]) - -AT_CLEANUP - - -AT_SETUP([DISPLAY: Sign EBCDIC]) -AT_KEYWORDS([display]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 G. - 02 X PIC X(10). - 02 X-S99 REDEFINES X PIC S99. - 02 X-S9 REDEFINES X PIC S9 OCCURS 10. - PROCEDURE DIVISION. - MOVE 0 TO X-S9(1). - MOVE 1 TO X-S9(2). - MOVE 2 TO X-S9(3). - MOVE 3 TO X-S9(4). - MOVE 4 TO X-S9(5). - MOVE 5 TO X-S9(6). - MOVE 6 TO X-S9(7). - MOVE 7 TO X-S9(8). - MOVE 8 TO X-S9(9). - MOVE 9 TO X-S9(10). - DISPLAY X NO ADVANCING - END-DISPLAY. - MOVE -10 TO X-S99. MOVE X(2:1) TO X(1:1). - MOVE -1 TO X-S9(2). - MOVE -2 TO X-S9(3). - MOVE -3 TO X-S9(4). - MOVE -4 TO X-S9(5). - MOVE -5 TO X-S9(6). - MOVE -6 TO X-S9(7). - MOVE -7 TO X-S9(8). - MOVE -8 TO X-S9(9). - MOVE -9 TO X-S9(10). - DISPLAY X NO ADVANCING - END-DISPLAY. - STOP RUN. -]) - -AT_CHECK([$COMPILE -fsign=ebcdic prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [{ABCDEFGHI}JKLMNOPQR]) - -AT_CLEANUP - -AT_SETUP([DISPLAY: unsigned]) -AT_KEYWORDS([display]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 X-BCU BINARY-CHAR UNSIGNED. - 01 X-BSU BINARY-SHORT UNSIGNED. - 01 X-BIU BINARY-INT UNSIGNED. - 01 X-BLU BINARY-LONG UNSIGNED. - 01 X-BDU BINARY-DOUBLE UNSIGNED. - 01 X-US UNSIGNED-SHORT. - 01 X-UI UNSIGNED-INT. - PROCEDURE DIVISION. - MOVE 127 TO X-BCU. DISPLAY X-BCU END-DISPLAY. - ADD 1 TO X-BCU END-ADD. DISPLAY X-BCU END-DISPLAY. - MOVE 32767 TO X-BSU. DISPLAY X-BSU END-DISPLAY. - ADD 1 TO X-BSU END-ADD. DISPLAY X-BSU END-DISPLAY. - MOVE 2147483647 TO X-BIU. DISPLAY X-BIU END-DISPLAY. - ADD 1 TO X-BIU END-ADD. DISPLAY X-BIU END-DISPLAY. - MOVE 2147483647 TO X-BLU. DISPLAY X-BLU END-DISPLAY. - ADD 1 TO X-BLU END-ADD. DISPLAY X-BLU END-DISPLAY. - MOVE 9223372036854775807 TO X-BDU. DISPLAY X-BDU END-DISPLAY. - ADD 1 TO X-BDU END-ADD. DISPLAY X-BDU END-DISPLAY. - MOVE 32767 TO X-US. DISPLAY X-US END-DISPLAY. - ADD 1 TO X-US END-ADD. DISPLAY X-US END-DISPLAY. - MOVE 2147483647 TO X-UI. DISPLAY X-UI END-DISPLAY. - ADD 1 TO X-UI END-ADD. DISPLAY X-UI END-DISPLAY. - STOP RUN. -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], -[127 -128 -32767 -32768 -2147483647 -2147483648 -2147483647 -2147483648 -09223372036854775807 -09223372036854775808 -32767 -32768 -2147483647 -2147483648 -]) - -AT_CLEANUP diff -Nru gnucobol-4.0~early~20200606/tests/testsuite.src/data_packed.at gnucobol-5/tests/testsuite.src/data_packed.at --- gnucobol-4.0~early~20200606/tests/testsuite.src/data_packed.at 2020-06-06 20:52:00.000000000 +0000 +++ gnucobol-5/tests/testsuite.src/data_packed.at 1970-01-01 00:00:00.000000000 +0000 @@ -1,811 +0,0 @@ -## Copyright (C) 2003-2012, 2014-2016, 2018-2019 Free Software Foundation, Inc. -## Written by Keisuke Nishida, Roger While, Edward Hart, Simon Sobisch -## -## This file is part of GnuCOBOL. -## -## The GnuCOBOL compiler is free software: you can redistribute it -## and/or modify it under the terms of the GNU General Public License -## as published by the Free Software Foundation, either version 3 of the -## License, or (at your option) any later version. -## -## GnuCOBOL is distributed in the hope that it will be useful, -## but WITHOUT ANY WARRANTY; without even the implied warranty of -## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -## GNU General Public License for more details. -## -## You should have received a copy of the GNU General Public License -## along with GnuCOBOL. If not, see . - -### GnuCOBOL Test Suite - -### PACKED-DECIMAL - - -# dump -AT_SETUP([PACKED-DECIMAL dump]) -AT_KEYWORDS([packed]) - -AT_DATA([dump.c], [ -#include -#include - -COB_EXT_EXPORT int -dump (unsigned char *data) -{ - int i; - for (i = 0; i < 10; i++) - printf ("%02x", data[[i]]); - puts (""); - return 0; -} -]) - -sed -e 's/@USAGE@/PACKED-DECIMAL/' "${TEMPLATE}/numeric-dump.cob" > prog.cob - -AT_CHECK([$COMPILE_MODULE dump.c], [0], [], []) -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], -[1f202020202020202020 -012f2020202020202020 -123f2020202020202020 -01234f20202020202020 -12345f20202020202020 -0123456f202020202020 -1234567f202020202020 -012345678f2020202020 -123456789f2020202020 -01234567890f20202020 -12345678901f20202020 -0123456789012f202020 -1234567890123f202020 -012345678901234f2020 -123456789012345f2020 -01234567890123456f20 -12345678901234567f20 -0123456789012345678f -1d202020202020202020 -012d2020202020202020 -123d2020202020202020 -01234d20202020202020 -12345d20202020202020 -0123456d202020202020 -1234567d202020202020 -012345678d2020202020 -123456789d2020202020 -01234567890d20202020 -12345678901d20202020 -0123456789012d202020 -1234567890123d202020 -012345678901234d2020 -123456789012345d2020 -01234567890123456d20 -12345678901234567d20 -0123456789012345678d -0f202020202020202020 -000f2020202020202020 -000f2020202020202020 -00000f20202020202020 -00000f20202020202020 -0000000f202020202020 -0000000f202020202020 -000000000f2020202020 -000000000f2020202020 -00000000000f20202020 -00000000000f20202020 -0000000000000f202020 -0000000000000f202020 -000000000000000f2020 -000000000000000f2020 -00000000000000000f20 -00000000000000000f20 -0000000000000000000f -0c202020202020202020 -000c2020202020202020 -000c2020202020202020 -00000c20202020202020 -00000c20202020202020 -0000000c202020202020 -0000000c202020202020 -000000000c2020202020 -000000000c2020202020 -00000000000c20202020 -00000000000c20202020 -0000000000000c202020 -0000000000000c202020 -000000000000000c2020 -000000000000000c2020 -00000000000000000c20 -00000000000000000c20 -0000000000000000000c -0f202020202020202020 -000f2020202020202020 -000f2020202020202020 -00000f20202020202020 -00000f20202020202020 -0000000f202020202020 -0000000f202020202020 -000000000f2020202020 -000000000f2020202020 -00000000000f20202020 -00000000000f20202020 -0000000000000f202020 -0000000000000f202020 -000000000000000f2020 -000000000000000f2020 -00000000000000000f20 -00000000000000000f20 -0000000000000000000f -0c202020202020202020 -000c2020202020202020 -000c2020202020202020 -00000c20202020202020 -00000c20202020202020 -0000000c202020202020 -0000000c202020202020 -000000000c2020202020 -000000000c2020202020 -00000000000c20202020 -00000000000c20202020 -0000000000000c202020 -0000000000000c202020 -000000000000000c2020 -000000000000000c2020 -00000000000000000c20 -00000000000000000c20 -0000000000000000000c -]) - -AT_CLEANUP - - -AT_SETUP([PACKED-DECIMAL used with DISPLAY]) -AT_KEYWORDS([packed]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 X-99 PIC 99 USAGE PACKED-DECIMAL. - 01 X-S99 PIC S99 USAGE PACKED-DECIMAL. - 01 X-999 PIC 999 USAGE PACKED-DECIMAL. - 01 X-S999 PIC S999 USAGE PACKED-DECIMAL. - PROCEDURE DIVISION. - MOVE 0 TO X-99. - DISPLAY X-99 - END-DISPLAY. - MOVE 99 TO X-99. - DISPLAY X-99 - END-DISPLAY. - MOVE 0 TO X-S99. - DISPLAY X-S99 - END-DISPLAY. - MOVE -1 TO X-S99. - DISPLAY X-S99 - END-DISPLAY. - MOVE 0 TO X-999. - DISPLAY X-999 - END-DISPLAY. - MOVE 123 TO X-999. - DISPLAY X-999 - END-DISPLAY. - MOVE 0 TO X-S999. - DISPLAY X-S999 - END-DISPLAY. - MOVE -123 TO X-S999. - DISPLAY X-S999 - END-DISPLAY. - STOP RUN. -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], -[00 -99 -+00 --01 -000 -123 -+000 --123 -]) - -AT_CLEANUP - - -AT_SETUP([PACKED-DECIMAL used with MOVE]) -AT_KEYWORDS([packed]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 X-99 PIC 99 USAGE PACKED-DECIMAL. - 01 X-S99 PIC S99 USAGE PACKED-DECIMAL. - 01 X-999 PIC 999 USAGE PACKED-DECIMAL. - 01 X-S999 PIC S999 USAGE PACKED-DECIMAL. - 01 C-P1234 PIC 9999 VALUE 1234. - 01 C-N1234 PIC S9999 VALUE -1234. - PROCEDURE DIVISION. - MOVE C-P1234 TO X-99. - DISPLAY X-99 - END-DISPLAY. - MOVE C-P1234 TO X-S99. - DISPLAY X-S99 - END-DISPLAY. - MOVE C-P1234 TO X-999. - DISPLAY X-999 - END-DISPLAY. - MOVE C-P1234 TO X-S999. - DISPLAY X-S999 - END-DISPLAY. - MOVE C-N1234 TO X-99. - DISPLAY X-99 - END-DISPLAY. - MOVE C-N1234 TO X-S99. - DISPLAY X-S99 - END-DISPLAY. - MOVE C-N1234 TO X-999. - DISPLAY X-999 - END-DISPLAY. - MOVE C-N1234 TO X-S999. - DISPLAY X-S999 - END-DISPLAY. - STOP RUN. -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], -[34 -+34 -234 -+234 -34 --34 -234 --234 -]) - -AT_CLEANUP - - -AT_SETUP([PACKED-DECIMAL used with INITIALIZE]) -AT_KEYWORDS([packed]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 X-99 PIC 99 USAGE PACKED-DECIMAL. - 01 X-S99 PIC S99 USAGE PACKED-DECIMAL. - 01 X-999 PIC 999 USAGE PACKED-DECIMAL. - 01 X-S999 PIC S999 USAGE PACKED-DECIMAL. - PROCEDURE DIVISION. - INITIALIZE X-99. - DISPLAY X-99 - END-DISPLAY. - INITIALIZE X-S99. - DISPLAY X-S99 - END-DISPLAY. - INITIALIZE X-999. - DISPLAY X-999 - END-DISPLAY. - INITIALIZE X-S999. - DISPLAY X-S999 - END-DISPLAY. - STOP RUN. -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], -[00 -+00 -000 -+000 -]) - -AT_CLEANUP - - -AT_SETUP([PACKED-DECIMAL arithmetic]) -AT_KEYWORDS([packed]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 X PIC 99 USAGE PACKED-DECIMAL VALUE 0. - 01 Y PIC 99 USAGE PACKED-DECIMAL VALUE 9. - PROCEDURE DIVISION. - COMPUTE X = 1 - END-COMPUTE. - DISPLAY X - END-DISPLAY. - COMPUTE X = Y - END-COMPUTE. - DISPLAY X - END-DISPLAY. - COMPUTE X = X + Y - END-COMPUTE. - DISPLAY X - END-DISPLAY. - STOP RUN. -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], -[01 -09 -18 -]) - -AT_CLEANUP - - -AT_SETUP([PACKED-DECIMAL numeric test (1)]) -AT_KEYWORDS([packed]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 G. - 02 X-2 PIC X(2). - 02 N-2 REDEFINES X-2 PIC 999 USAGE PACKED-DECIMAL. - 02 N-S2 REDEFINES X-2 PIC S999 USAGE PACKED-DECIMAL. - PROCEDURE DIVISION. - MOVE X"0000" TO X-2. - IF N-2 IS NUMERIC - DISPLAY "NG" - END-DISPLAY - ELSE - DISPLAY "OK" - END-DISPLAY - END-IF. - IF N-S2 IS NUMERIC - DISPLAY "NG" - END-DISPLAY - ELSE - DISPLAY "OK" - END-DISPLAY - END-IF. - MOVE X"000c" TO X-2. - IF N-2 IS NUMERIC - DISPLAY "NG" - END-DISPLAY - ELSE - DISPLAY "OK" - END-DISPLAY - END-IF. - IF N-S2 IS NUMERIC - DISPLAY "OK" - END-DISPLAY - ELSE - DISPLAY "NG" - END-DISPLAY - END-IF. - MOVE X"000d" TO X-2. - IF N-2 IS NUMERIC - DISPLAY "NG" - END-DISPLAY - ELSE - DISPLAY "OK" - END-DISPLAY - END-IF. - IF N-S2 IS NUMERIC - DISPLAY "OK" - END-DISPLAY - ELSE - DISPLAY "NG" - END-DISPLAY - END-IF. - MOVE X"000f" TO X-2. - IF N-2 IS NUMERIC - DISPLAY "OK" - END-DISPLAY - ELSE - DISPLAY "NG" - END-DISPLAY - END-IF. - IF N-S2 IS NUMERIC - DISPLAY "NG" - END-DISPLAY - ELSE - DISPLAY "OK" - END-DISPLAY - END-IF. - MOVE X"1234" TO X-2. - IF N-2 IS NUMERIC - DISPLAY "NG" - END-DISPLAY - ELSE - DISPLAY "OK" - END-DISPLAY - END-IF. - IF N-S2 IS NUMERIC - DISPLAY "NG" - END-DISPLAY - ELSE - DISPLAY "OK" - END-DISPLAY - END-IF. - MOVE X"999f" TO X-2. - IF N-2 IS NUMERIC - DISPLAY "OK" - END-DISPLAY - ELSE - DISPLAY "NG" - END-DISPLAY - END-IF. - IF N-S2 IS NUMERIC - DISPLAY "NG" - END-DISPLAY - ELSE - DISPLAY "OK" - END-DISPLAY - END-IF. - MOVE X"ffff" TO X-2. - IF N-2 IS NUMERIC - DISPLAY "NG" - END-DISPLAY - ELSE - DISPLAY "OK" - END-DISPLAY - END-IF. - IF N-S2 IS NUMERIC - DISPLAY "NG" - END-DISPLAY - ELSE - DISPLAY "OK" - END-DISPLAY - END-IF. - STOP RUN. -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], -[OK -OK -OK -OK -OK -OK -OK -OK -OK -OK -OK -OK -OK -OK -]) - -AT_CLEANUP - - -AT_SETUP([PACKED-DECIMAL numeric test (2)]) -AT_KEYWORDS([packed]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 G. - 02 X-2 PIC X(2). - 02 N-2 REDEFINES X-2 PIC 999 USAGE PACKED-DECIMAL. - 02 N-S2 REDEFINES X-2 PIC S999 USAGE PACKED-DECIMAL. - PROCEDURE DIVISION. - MOVE X"0000" TO X-2. - IF N-2 IS NUMERIC - DISPLAY "NG" - ELSE - DISPLAY "OK" - END-IF. - IF N-S2 IS NUMERIC - DISPLAY "NG" - ELSE - DISPLAY "OK" - END-IF. - MOVE X"000c" TO X-2. - IF N-2 IS NUMERIC - DISPLAY "NG" - ELSE - DISPLAY "OK" - END-IF. - IF N-S2 IS NUMERIC - DISPLAY "OK" - ELSE - DISPLAY "NG" - END-IF. - MOVE X"000d" TO X-2. - IF N-2 IS NUMERIC - DISPLAY "NG" - ELSE - DISPLAY "OK" - END-IF. - IF N-S2 IS NUMERIC - DISPLAY "OK" - ELSE - DISPLAY "NG" - END-IF. - MOVE X"000f" TO X-2. - IF N-2 IS NUMERIC - DISPLAY "OK" - ELSE - DISPLAY "NG" - END-IF. - IF N-S2 IS NUMERIC - DISPLAY "OK" - ELSE - DISPLAY "NG" - END-IF. - MOVE X"1234" TO X-2. - IF N-2 IS NUMERIC - DISPLAY "NG" - ELSE - DISPLAY "OK" - END-IF. - IF N-S2 IS NUMERIC - DISPLAY "NG" - ELSE - DISPLAY "OK" - END-IF. - MOVE X"999f" TO X-2. - IF N-2 IS NUMERIC - DISPLAY "OK" - ELSE - DISPLAY "NG" - END-IF. - IF N-S2 IS NUMERIC - DISPLAY "OK" - ELSE - DISPLAY "NG" - END-IF. - MOVE X"ffff" TO X-2. - IF N-2 IS NUMERIC - DISPLAY "NG" - ELSE - DISPLAY "OK" - END-IF. - IF N-S2 IS NUMERIC - DISPLAY "NG" - ELSE - DISPLAY "OK" - END-IF. - STOP RUN. -]) - -# TODO: Check what actual option is tested here -# and directly use it -AT_CHECK([$COMPILE -std=ibm prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], -[OK -OK -OK -OK -OK -OK -OK -OK -OK -OK -OK -OK -OK -OK -]) - -AT_CLEANUP - - -AT_SETUP([COMP-6 used with DISPLAY]) -AT_KEYWORDS([packed]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 X-99 PIC 99 USAGE COMP-6. - 01 X-999 PIC 999 USAGE COMP-6. - PROCEDURE DIVISION. - MOVE 0 TO X-99. - DISPLAY X-99 - END-DISPLAY. - MOVE 99 TO X-99. - DISPLAY X-99 - END-DISPLAY. - MOVE 0 TO X-999. - DISPLAY X-999 - END-DISPLAY. - MOVE 123 TO X-999. - DISPLAY X-999 - END-DISPLAY. - STOP RUN. -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], -[00 -99 -000 -123 -]) - -AT_CLEANUP - - -AT_SETUP([COMP-6 used with MOVE]) -AT_KEYWORDS([packed]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 X-99 PIC 99 USAGE COMP-6. - 01 X-999 PIC 999 USAGE COMP-6. - 01 B-99 USAGE BINARY-LONG. - 01 B-999 USAGE BINARY-LONG. - PROCEDURE DIVISION. - MOVE 0 TO B-99. - MOVE B-99 TO X-99. - DISPLAY X-99 - END-DISPLAY. - MOVE 99 TO B-99. - MOVE B-99 TO X-99. - DISPLAY X-99 - END-DISPLAY. - MOVE 0 TO B-999. - MOVE B-999 TO X-999. - DISPLAY X-999 - END-DISPLAY. - MOVE 123 TO B-999. - MOVE B-999 TO X-999. - DISPLAY X-999 - END-DISPLAY. - MOVE B-999 TO X-99. - DISPLAY X-99 - END-DISPLAY. - STOP RUN. -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], -[00 -99 -000 -123 -23 -]) - -AT_CLEANUP - - -AT_SETUP([COMP-6 arithmetic]) -AT_KEYWORDS([packed]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 X-99 PIC 99 USAGE COMP-6. - 01 X-999 PIC 999 USAGE COMP-6. - 01 B-99 USAGE BINARY-LONG UNSIGNED. - 01 B-999 USAGE BINARY-LONG UNSIGNED. - PROCEDURE DIVISION. - MOVE 99 TO B-99 - MOVE B-99 TO X-99 - MOVE 123 TO B-999 - MOVE B-999 TO X-999 - ADD X-99 X-999 GIVING B-99 - END-ADD - DISPLAY B-99 - END-DISPLAY - STOP RUN. -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], -[0000000222 -]) - -AT_CLEANUP - - -AT_SETUP([COMP-6 numeric test]) -AT_KEYWORDS([packed]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 G. - 02 X-2 PIC X(2). - 02 N-3 REDEFINES X-2 PIC 999 USAGE COMP-6. - 02 N-4 REDEFINES X-2 PIC 9999 USAGE COMP-6. - PROCEDURE DIVISION. - MOVE X"0000" TO X-2. - IF N-3 IS NUMERIC - DISPLAY "OK" - END-DISPLAY - ELSE - DISPLAY "NG" - END-DISPLAY - END-IF. - IF N-4 IS NUMERIC - DISPLAY "OK" - END-DISPLAY - ELSE - DISPLAY "NG" - END-DISPLAY - END-IF. - MOVE X"000c" TO X-2. - IF N-3 IS NUMERIC - DISPLAY "NG" - END-DISPLAY - ELSE - DISPLAY "OK" - END-DISPLAY - END-IF. - IF N-4 IS NUMERIC - DISPLAY "NG" - END-DISPLAY - ELSE - DISPLAY "OK" - END-DISPLAY - END-IF. - MOVE X"1234" TO X-2. - IF N-3 IS NUMERIC - DISPLAY "OK" - END-DISPLAY - ELSE - DISPLAY "NG" - END-DISPLAY - END-IF. - IF N-4 IS NUMERIC - DISPLAY "OK" - END-DISPLAY - ELSE - DISPLAY "NG" - END-DISPLAY - END-IF. - MOVE X"ffff" TO X-2. - IF N-3 IS NUMERIC - DISPLAY "NG" - END-DISPLAY - ELSE - DISPLAY "OK" - END-DISPLAY - END-IF. - IF N-4 IS NUMERIC - DISPLAY "NG" - END-DISPLAY - ELSE - DISPLAY "OK" - END-DISPLAY - END-IF. - STOP RUN. -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], -[OK -OK -OK -OK -OK -OK -OK -OK -]) - -AT_CLEANUP - diff -Nru gnucobol-4.0~early~20200606/tests/testsuite.src/data_pointer.at gnucobol-5/tests/testsuite.src/data_pointer.at --- gnucobol-4.0~early~20200606/tests/testsuite.src/data_pointer.at 2020-06-06 20:52:00.000000000 +0000 +++ gnucobol-5/tests/testsuite.src/data_pointer.at 1970-01-01 00:00:00.000000000 +0000 @@ -1,61 +0,0 @@ -## Copyright (C) 2003-2012, 2014-2016 Free Software Foundation, Inc. -## Written by Keisuke Nishida, Roger While, Simon Sobisch -## -## This file is part of GnuCOBOL. -## -## The GnuCOBOL compiler is free software: you can redistribute it -## and/or modify it under the terms of the GNU General Public License -## as published by the Free Software Foundation, either version 3 of the -## License, or (at your option) any later version. -## -## GnuCOBOL is distributed in the hope that it will be useful, -## but WITHOUT ANY WARRANTY; without even the implied warranty of -## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -## GNU General Public License for more details. -## -## You should have received a copy of the GNU General Public License -## along with GnuCOBOL. If not, see . - -### GnuCOBOL Test Suite - -AT_SETUP([POINTER: display]) -AT_KEYWORDS([pointer 64bit]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 PTR USAGE POINTER VALUE NULL. - PROCEDURE DIVISION. - DISPLAY PTR - END-DISPLAY. - SET PTR UP BY 1 - DISPLAY PTR - SET PTR DOWN BY 1 - DISPLAY PTR - END-DISPLAY. - STOP RUN. -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) - -AT_CHECK([test "$COB_HAS_64_BIT_POINTER" = "yes"], [0], [], [], - -# Previous test "failed" --> 32 bit - -[AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [0x00000000 -0x00000001 -0x00000000 -])] - -, - -# Previous test "passed" --> 64 bit - -[AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [0x0000000000000000 -0x0000000000000001 -0x0000000000000000 -])]) - -AT_CLEANUP diff -Nru gnucobol-4.0~early~20200606/tests/testsuite.src/listings.at gnucobol-5/tests/testsuite.src/listings.at --- gnucobol-4.0~early~20200606/tests/testsuite.src/listings.at 2020-06-06 20:52:00.000000000 +0000 +++ gnucobol-5/tests/testsuite.src/listings.at 1970-01-01 00:00:00.000000000 +0000 @@ -1,6694 +0,0 @@ -## Copyright (C) 2015-2020 Free Software Foundation, Inc. -## Written by Dave Pitts, Simon Sobisch -## -## This file is part of GnuCOBOL. -## -## The GnuCOBOL compiler is free software: you can redistribute it -## and/or modify it under the terms of the GNU General Public License -## as published by the Free Software Foundation, either version 3 of the -## License, or (at your option) any later version. -## -## GnuCOBOL is distributed in the hope that it will be useful, -## but WITHOUT ANY WARRANTY; without even the implied warranty of -## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -## GNU General Public License for more details. -## -## You should have received a copy of the GNU General Public License -## along with GnuCOBOL. If not, see . - -### GnuCOBOL Test Suite - -AT_SETUP([Minimal lines per listing pages]) -AT_KEYWORDS([listing symbols options]) - -# note: 2.2 did not use a minmal length, -# a typo like -tlines=2 loops forever - -AT_CAPTURE_FILE([prog.lst]) - -AT_DATA([prog.cob], [ - * some comments go here - *> and here - *> and finally... here - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 NEWSTUFF PIC X(80). - PROCEDURE DIVISION. - DISPLAY NEWSTUFF " BENEFITS SOME PARTS FROM " - "MANY" "STUFF" ", " "VERY MUCH" "GOOD" NEWSTUFF - "AND STUFF !" - NO ADVANCING - END-DISPLAY. - STOP RUN. -]) - -AT_DATA([expected.lst], -[GnuCOBOL V.R.P prog.cob DDD MMM dd HH:MM:SS YYYY Page 0001 - -LINE PG/LN A...B............................................................ - -000001 -000002 * some comments go here -000003 *> and here -000004 *> and finally... here -000005 IDENTIFICATION DIVISION. -000006 PROGRAM-ID. prog. -000007 DATA DIVISION. -000008 WORKING-STORAGE SECTION. -000009 01 NEWSTUFF PIC X(80). -000010 PROCEDURE DIVISION. -000011 DISPLAY NEWSTUFF " BENEFITS SOME PARTS FROM " -000012 "MANY" "STUFF" ", " "VERY MUCH" "GOOD" NEWSTUFF -000013 "AND STUFF !" -000014 NO ADVANCING -000015 END-DISPLAY. -000016 STOP RUN. - - GnuCOBOL V.R.P prog.cob DDD MMM dd HH:MM:SS YYYY Page 0002 - -0 warnings in compilation group -0 errors in compilation group -]) - -AT_CHECK([$COMPILE_ONLY -t prog.lst -tlines=2 prog.cob], [0], [], -[cobc: warning: 2 lines per listing page specified, using 20 -]) - -AT_CHECK([gcdiff -IGnuCOBOL expected.lst prog.lst], [0], [], []) - -AT_CLEANUP - - -AT_SETUP([COPY within comment]) -AT_KEYWORDS([listing]) - -AT_CAPTURE_FILE([prog.lst]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - *COPY "copy.inc". - PROCEDURE DIVISION. - STOP RUN. -]) - -AT_CHECK([$COMPILE_ONLY -t prog.lst -tlines=0 prog.cob], [0], [], []) - -AT_DATA([prog1.lst], -[GnuCOBOL V.R.P prog.cob DDD MMM dd HH:MM:SS YYYY - -LINE PG/LN A...B............................................................ - -000001 -000002 IDENTIFICATION DIVISION. -000003 PROGRAM-ID. prog. -000004 DATA DIVISION. -000005 WORKING-STORAGE SECTION. -000006 *COPY "copy.inc". -000007 PROCEDURE DIVISION. -000008 STOP RUN. - - -0 warnings in compilation group -0 errors in compilation group -]) - -AT_CHECK([gcdiff -IGnuCOBOL prog1.lst prog.lst], [0], [], []) - -AT_DATA([prog2.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog2. - DATA DIVISION. - WORKING-STORAGE SECTION. - *> COPY "copy.inc". - PROCEDURE DIVISION. - STOP RUN. -]) - -AT_CHECK([$COMPILE_ONLY -t prog.lst -tlines=0 -free prog2.cob], [0], [], []) - -AT_DATA([prog2.lst], -[GnuCOBOL V.R.P prog2.cob DDD MMM dd HH:MM:SS YYYY - -LINE .....................SOURCE............................................. - -000001 -000002 IDENTIFICATION DIVISION. -000003 PROGRAM-ID. prog2. -000004 DATA DIVISION. -000005 WORKING-STORAGE SECTION. -000006 *> COPY "copy.inc". -000007 PROCEDURE DIVISION. -000008 STOP RUN. - - -0 warnings in compilation group -0 errors in compilation group -]) - -AT_CHECK([gcdiff -IGnuCOBOL prog2.lst prog.lst], [0], [], []) - -AT_CLEANUP - - -AT_SETUP([Replacement w/o strings]) -AT_KEYWORDS([listing symbols]) - -AT_CAPTURE_FILE([prog.lst]) - -AT_DATA([prog.cob], [ - REPLACE =="SOME"== BY =="MANY"== - =='SOME'== BY =="VERY MUCH"== - ==STUFF== BY ==NEWSTUFF==. - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 NEWSTUFF PIC X(80). - PROCEDURE DIVISION. - DISPLAY STUFF " BENEFITS SOME PARTS FROM " - "SOME" "STUFF" ", " 'SOME' "GOOD" STUFF "AND STUFF !" - NO ADVANCING - END-DISPLAY. - STOP RUN. -]) - -AT_CHECK([$COMPILE_ONLY -t prog.lst -tlines=0 -tsymbols prog.cob], [0], [], []) - -AT_DATA([expected.lst], -[GnuCOBOL V.R.P prog.cob DDD MMM dd HH:MM:SS YYYY - -LINE PG/LN A...B............................................................ - -000001 -000002 REPLACE =="SOME"== BY =="MANY"== -000003 =='SOME'== BY =="VERY MUCH"== -000004 ==STUFF== BY ==NEWSTUFF==. -000005 IDENTIFICATION DIVISION. -000006 PROGRAM-ID. prog. -000007 DATA DIVISION. -000008 WORKING-STORAGE SECTION. -000009 01 NEWSTUFF PIC X(80). -000010 PROCEDURE DIVISION. -000011 DISPLAY NEWSTUFF " BENEFITS SOME PARTS FROM " -000012 "MANY" "STUFF" ", " "VERY MUCH" "GOOD" NEWSTUFF -000012+ - "AND STUFF !" -000013 NO ADVANCING -000014 END-DISPLAY. -000015 STOP RUN. - -SIZE TYPE LVL NAME PICTURE - - WORKING-STORAGE SECTION - -00080 ALPHANUMERIC 01 NEWSTUFF X(80) - - -0 warnings in compilation group -0 errors in compilation group -]) - -AT_CHECK([gcdiff -IGnuCOBOL expected.lst prog.lst], [0], [], []) - -AT_CLEANUP - - -AT_SETUP([COPY replacement order]) -AT_KEYWORDS([listing symbols]) - -AT_CAPTURE_FILE([prog.lst]) - -AT_DATA([copy.inc], [ - 01 TEST-VAR PIC X(2) VALUE "OK". -]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - COPY "copy.inc" - REPLACING ==TEST-VAR== BY ==FIRST-MATCH== - ==TEST-VAR== BY ==SECOND-MATCH==. - PROCEDURE DIVISION. - DISPLAY FIRST-MATCH NO ADVANCING - END-DISPLAY. - STOP RUN. -]) - -AT_CHECK([$COMPILE_ONLY -t prog.lst -tlines=0 -tsymbols prog.cob], [0], [], []) - -AT_DATA([prog3.lst], -[GnuCOBOL V.R.P prog.cob DDD MMM dd HH:MM:SS YYYY - -LINE PG/LN A...B............................................................ - -000001 -000002 IDENTIFICATION DIVISION. -000003 PROGRAM-ID. prog. -000004 DATA DIVISION. -000005 WORKING-STORAGE SECTION. -000006 COPY "copy.inc" -000007 REPLACING ==TEST-VAR== BY ==FIRST-MATCH== -000008 ==TEST-VAR== BY ==SECOND-MATCH==. -000001C -000002C 01 FIRST-MATCH PIC X(2) VALUE "OK". -000009 PROCEDURE DIVISION. -000010 DISPLAY FIRST-MATCH NO ADVANCING -000011 END-DISPLAY. -000012 STOP RUN. - -SIZE TYPE LVL NAME PICTURE - - WORKING-STORAGE SECTION - -00002 ALPHANUMERIC 01 FIRST-MATCH X(2) - - -0 warnings in compilation group -0 errors in compilation group -]) - -AT_CHECK([gcdiff -IGnuCOBOL prog3.lst prog.lst], [0], [], []) - -AT_CHECK([$COBC $FLAGS -E -o prog.i prog.cob], [0], [], []) -AT_CHECK([$COMPILE_ONLY -t prog.lst -tlines=0 -tsymbols prog.i], [0], [], []) - -AT_DATA([prog4.lst], -[GnuCOBOL V.R.P prog.i DDD MMM dd HH:MM:SS YYYY - -LINE PG/LN A...B............................................................ - -000001 #line 1 "prog.cob" -000001 -000002 IDENTIFICATION DIVISION. -000003 PROGRAM-ID. prog. -000004 DATA DIVISION. -000005 WORKING-STORAGE SECTION. -000006 -000007 -000008 -000001 #line 1 "copy.inc" -000001 -000002 01 FIRST-MATCH PIC X(2) VALUE "OK". -000008 #line 8 "prog.cob" -000008 -000009 PROCEDURE DIVISION. -000010 DISPLAY FIRST-MATCH NO ADVANCING -000011 END-DISPLAY. -000012 STOP RUN. - -SIZE TYPE LVL NAME PICTURE - - WORKING-STORAGE SECTION - -00002 ALPHANUMERIC 01 FIRST-MATCH X(2) - - -0 warnings in compilation group -0 errors in compilation group -]) - -AT_CHECK([gcdiff -IGnuCOBOL prog4.lst prog.lst], [0], [], []) - -AT_CLEANUP - - -AT_SETUP([COPY separators]) -AT_KEYWORDS([listing symbols]) - -AT_CAPTURE_FILE([prog.lst]) - -AT_DATA([copy.inc], [ - 01 TEST-VAR PIC X(2) VALUE "OK". COPY001 -]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. PROG001 - PROGRAM-ID. prog. PROG002 - DATA DIVISION. PROG003 - WORKING-STORAGE SECTION. PROG004 - COPY "copy.inc" PROG005 - REPLACING ==TEST-VAR==, BY ==FIRST-MATCH==, PROG006 - , ==TEST-VAR==; BY ==SECOND-MATCH==; PROG007 - ; ==TEST-VAR== , BY ==THIRD-MATCH== PROG008 - ==TEST-VAR== ; BY ==FOURTH-MATCH==. PROG009 - PROCEDURE DIVISION. PROG010 - DISPLAY FIRST-MATCH NO ADVANCING PROG011 - END-DISPLAY. PROG012 - STOP RUN. PROG013 -]) - -AT_CHECK([$COMPILE_ONLY -t prog.lst -tlines=0 -tsymbols prog.cob], [0], [], []) - -AT_DATA([prog4.lst], -[GnuCOBOL V.R.P prog.cob DDD MMM dd HH:MM:SS YYYY - -LINE PG/LN A...B............................................................ - -000001 -000002 IDENTIFICATION DIVISION. -000003 PROGRAM-ID. prog. -000004 DATA DIVISION. -000005 WORKING-STORAGE SECTION. -000006 COPY "copy.inc" -000007 REPLACING ==TEST-VAR==, BY ==FIRST-MATCH==, -000008 , ==TEST-VAR==; BY ==SECOND-MATCH==; -000009 ; ==TEST-VAR== , BY ==THIRD-MATCH== -000010 ==TEST-VAR== ; BY ==FOURTH-MATCH==. -000001C -000002C 01 FIRST-MATCH PIC X(2) VALUE "OK". -000011 PROCEDURE DIVISION. -000012 DISPLAY FIRST-MATCH NO ADVANCING -000013 END-DISPLAY. -000014 STOP RUN. - -SIZE TYPE LVL NAME PICTURE - - WORKING-STORAGE SECTION - -00002 ALPHANUMERIC 01 FIRST-MATCH X(2) - - -0 warnings in compilation group -0 errors in compilation group -]) - -AT_CHECK([gcdiff -IGnuCOBOL prog4.lst prog.lst], [0], [], []) - -AT_CLEANUP - - -AT_SETUP([COPY partial replacement]) -AT_KEYWORDS([listing symbols]) - -AT_CAPTURE_FILE([prog.lst]) - -AT_DATA([copy.inc], [ - 01 :TEST:-VAR PIC X(2) VALUE "OK". - 01 (TEST)-VAR PIC X(2) VALUE "OK". -]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - COPY "copy.inc" - REPLACING ==:TEST:== BY ==COLON== - ==(TEST)== BY ==PAREN==. - PROCEDURE DIVISION. - DISPLAY COLON-VAR NO ADVANCING - END-DISPLAY. - DISPLAY PAREN-VAR NO ADVANCING - END-DISPLAY. - STOP RUN. -]) - -AT_CHECK([$COMPILE_ONLY -t prog.lst -tlines=0 -tsymbols prog.cob], [0], [], []) - -AT_DATA([prog5.lst], -[GnuCOBOL V.R.P prog.cob DDD MMM dd HH:MM:SS YYYY - -LINE PG/LN A...B............................................................ - -000001 -000002 IDENTIFICATION DIVISION. -000003 PROGRAM-ID. prog. -000004 DATA DIVISION. -000005 WORKING-STORAGE SECTION. -000006 COPY "copy.inc" -000007 REPLACING ==:TEST:== BY ==COLON== -000008 ==(TEST)== BY ==PAREN==. -000001C -000002C 01 COLON PIC X(2) VALUE "OK". -000003C 01 PAREN PIC X(2) VALUE "OK". -000009 PROCEDURE DIVISION. -000010 DISPLAY COLON-VAR NO ADVANCING -000011 END-DISPLAY. -000012 DISPLAY PAREN-VAR NO ADVANCING -000013 END-DISPLAY. -000014 STOP RUN. - -SIZE TYPE LVL NAME PICTURE - - WORKING-STORAGE SECTION - -00002 ALPHANUMERIC 01 COLON-VAR X(2) - -00002 ALPHANUMERIC 01 PAREN-VAR X(2) - - -0 warnings in compilation group -0 errors in compilation group -]) - -AT_CHECK([gcdiff -IGnuCOBOL prog5.lst prog.lst], [0], [], []) - -AT_CAPTURE_FILE([prog1.lst]) - -AT_DATA([copy1.inc], [ - 01 'yyy-'struktur. - 05 'yyy-'hello pic x(30) value 'yyy copy1.inc'. - 05 'yy1-'hello pic x(30) value 'yy1 copy1.inc'. - 05 'yy2-'hello pic x(30) value 'yy2 copy1.inc'. - 05 filler pic x(20). -]) - -AT_DATA([prog1.cob], [ - identification division. - program-id. copytest. - - data division. - working-storage section. - 01 hello pic x(20) value 'Copytest'. - - 01 xx pic x(02). - - copy 'copy1.inc' replacing 'YYY-' by a10- - 'yy1-' by a11- - 'yy2-' by a12-. - - copy 'copy1.inc' replacing 'YYY-' by a20- - 'yy1-' by a21- - 'yy2-' by a22-. - - copy 'copy1.inc' replacing 'YYY-' by a30- - 'yy1-' by a31- - 'yy2-' by a32-. - - procedure division. - - display hello - - display 'a10-struktur' - display a10-struktur - - display 'a20-struktur' - display a20-struktur - - display 'a30-struktur' - display a30-struktur - - goback. - end program copytest. -]) - -AT_CHECK([$COMPILE_ONLY -t prog1.lst -tlines=0 -tsymbols prog1.cob], [0], [], []) - -AT_DATA([prog6.lst], -[GnuCOBOL V.R.P prog1.cob DDD MMM dd HH:MM:SS YYYY - -LINE PG/LN A...B............................................................ - -000001 -000002 identification division. -000003 program-id. copytest. -000004 -000005 data division. -000006 working-storage section. -000007 01 hello pic x(20) value 'Copytest'. -000008 -000009 01 xx pic x(02). -000010 -000011 copy 'copy1.inc' replacing 'YYY-' by a10- -000012 'yy1-' by a11- -000013 'yy2-' by a12-. -000001C -000002C 01 a10-struktur. -000003C 05 a10-hello pic x(30) value 'yyy copy1.inc'. -000004C 05 a11-hello pic x(30) value 'yy1 copy1.inc'. -000005C 05 a12-hello pic x(30) value 'yy2 copy1.inc'. -000006C 05 filler pic x(20). -000014 -000015 copy 'copy1.inc' replacing 'YYY-' by a20- -000016 'yy1-' by a21- -000017 'yy2-' by a22-. -000001C -000002C 01 a20-struktur. -000003C 05 a20-hello pic x(30) value 'yyy copy1.inc'. -000004C 05 a21-hello pic x(30) value 'yy1 copy1.inc'. -000005C 05 a22-hello pic x(30) value 'yy2 copy1.inc'. -000006C 05 filler pic x(20). -000018 -000019 copy 'copy1.inc' replacing 'YYY-' by a30- -000020 'yy1-' by a31- -000021 'yy2-' by a32-. -000001C -000002C 01 a30-struktur. -000003C 05 a30-hello pic x(30) value 'yyy copy1.inc'. -000004C 05 a31-hello pic x(30) value 'yy1 copy1.inc'. -000005C 05 a32-hello pic x(30) value 'yy2 copy1.inc'. -000006C 05 filler pic x(20). -000022 -000023 procedure division. -000024 -000025 display hello -000026 -000027 display 'a10-struktur' -000028 display a10-struktur -000029 -000030 display 'a20-struktur' -000031 display a20-struktur -000032 -000033 display 'a30-struktur' -000034 display a30-struktur -000035 -000036 goback. -000037 end program copytest. - -SIZE TYPE LVL NAME PICTURE - - WORKING-STORAGE SECTION - -00020 ALPHANUMERIC 01 hello X(20) - -00002 ALPHANUMERIC 01 xx X(02) - -00110 GROUP 01 a10-struktur -00030 ALPHANUMERIC 05 a10-hello X(30) -00030 ALPHANUMERIC 05 a11-hello X(30) -00030 ALPHANUMERIC 05 a12-hello X(30) -00020 ALPHANUMERIC 05 FILLER X(20) - -00110 GROUP 01 a20-struktur -00030 ALPHANUMERIC 05 a20-hello X(30) -00030 ALPHANUMERIC 05 a21-hello X(30) -00030 ALPHANUMERIC 05 a22-hello X(30) -00020 ALPHANUMERIC 05 FILLER X(20) - -00110 GROUP 01 a30-struktur -00030 ALPHANUMERIC 05 a30-hello X(30) -00030 ALPHANUMERIC 05 a31-hello X(30) -00030 ALPHANUMERIC 05 a32-hello X(30) -00020 ALPHANUMERIC 05 FILLER X(20) - - -0 warnings in compilation group -0 errors in compilation group -]) - -AT_CHECK([gcdiff -IGnuCOBOL prog6.lst prog1.lst], [0], [], []) - -AT_CLEANUP - - -AT_SETUP([COPY LEADING replacement]) -AT_KEYWORDS([listing symbols]) - -AT_CAPTURE_FILE([prog.lst]) - -AT_DATA([copy.inc], [ - 01 TEST-VAR PIC X(2) VALUE "OK". - 01 NORM-VAR PIC X(2) VALUE "OK". -]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - COPY "copy.inc" - REPLACING LEADING ==TEST== BY ==FIRST== - LEADING ==NORM== BY ==SECOND==. - PROCEDURE DIVISION. - DISPLAY FIRST-VAR NO ADVANCING - END-DISPLAY. - DISPLAY SECOND-VAR NO ADVANCING - END-DISPLAY. - STOP RUN. -]) - -AT_CHECK([$COMPILE_ONLY -t prog.lst -tlines=0 -tsymbols prog.cob], [0], [], []) - -AT_DATA([progl.lst], -[GnuCOBOL V.R.P prog.cob DDD MMM dd HH:MM:SS YYYY - -LINE PG/LN A...B............................................................ - -000001 -000002 IDENTIFICATION DIVISION. -000003 PROGRAM-ID. prog. -000004 DATA DIVISION. -000005 WORKING-STORAGE SECTION. -000006 COPY "copy.inc" -000007 REPLACING LEADING ==TEST== BY ==FIRST== -000008 LEADING ==NORM== BY ==SECOND==. -000001C -000002C 01 FIRST-VAR PIC X(2) VALUE "OK". -000003C 01 SECOND-VAR PIC X(2) VALUE "OK". -000009 PROCEDURE DIVISION. -000010 DISPLAY FIRST-VAR NO ADVANCING -000011 END-DISPLAY. -000012 DISPLAY SECOND-VAR NO ADVANCING -000013 END-DISPLAY. -000014 STOP RUN. - -SIZE TYPE LVL NAME PICTURE - - WORKING-STORAGE SECTION - -00002 ALPHANUMERIC 01 FIRST-VAR X(2) - -00002 ALPHANUMERIC 01 SECOND-VAR X(2) - - -0 warnings in compilation group -0 errors in compilation group -]) - -AT_CHECK([gcdiff -IGnuCOBOL progl.lst prog.lst], [0], [], []) - -AT_CLEANUP - - -AT_SETUP([COPY TRAILING replacement]) -AT_KEYWORDS([listing symbols]) - -AT_CAPTURE_FILE([prog.lst]) - -AT_DATA([copy.inc], [ - 01 TEST-FIRST PIC X(2) VALUE "OK". - 01 TEST-SECOND PIC X(2) VALUE "OK". -]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - COPY "copy.inc" - REPLACING TRAILING ==FIRST== BY ==VAR1== - TRAILING ==SECOND== BY ==VAR2==. - PROCEDURE DIVISION. - DISPLAY TEST-VAR1 NO ADVANCING - END-DISPLAY. - DISPLAY TEST-VAR2 NO ADVANCING - END-DISPLAY. - STOP RUN. -]) - - -AT_CHECK([$COMPILE_ONLY -t prog.lst -tlines=0 -tsymbols prog.cob], [0], [], []) - -AT_DATA([progr.lst], -[GnuCOBOL V.R.P prog.cob DDD MMM dd HH:MM:SS YYYY - -LINE PG/LN A...B............................................................ - -000001 -000002 IDENTIFICATION DIVISION. -000003 PROGRAM-ID. prog. -000004 DATA DIVISION. -000005 WORKING-STORAGE SECTION. -000006 COPY "copy.inc" -000007 REPLACING TRAILING ==FIRST== BY ==VAR1== -000008 TRAILING ==SECOND== BY ==VAR2==. -000001C -000002C 01 TEST-VAR1 PIC X(2) VALUE "OK". -000003C 01 TEST-VAR2 PIC X(2) VALUE "OK". -000009 PROCEDURE DIVISION. -000010 DISPLAY TEST-VAR1 NO ADVANCING -000011 END-DISPLAY. -000012 DISPLAY TEST-VAR2 NO ADVANCING -000013 END-DISPLAY. -000014 STOP RUN. - -SIZE TYPE LVL NAME PICTURE - - WORKING-STORAGE SECTION - -00002 ALPHANUMERIC 01 TEST-VAR1 X(2) - -00002 ALPHANUMERIC 01 TEST-VAR2 X(2) - - -0 warnings in compilation group -0 errors in compilation group -]) - -AT_CHECK([gcdiff -IGnuCOBOL progr.lst prog.lst], [0], [], []) - -AT_CLEANUP - - -AT_SETUP([COPY recursive replacement]) -AT_KEYWORDS([listing symbols]) - -AT_CAPTURE_FILE([prog.lst]) - -AT_DATA([copy-2.inc], [ - 01 TEST-VAR PIC X(2) VALUE "OK". -]) - -AT_DATA([copy-1.inc], [ - COPY "copy-2.inc". -]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - COPY "copy-1.inc" - REPLACING ==TEST-VAR== BY ==COPY-VAR==. - PROCEDURE DIVISION. - DISPLAY COPY-VAR NO ADVANCING - END-DISPLAY. - STOP RUN. -]) - -AT_CHECK([$COMPILE_ONLY -t prog.lst -tlines=0 -tsymbols prog.cob], [0], [], []) - -AT_DATA([prog6.lst], -[GnuCOBOL V.R.P prog.cob DDD MMM dd HH:MM:SS YYYY - -LINE PG/LN A...B............................................................ - -000001 -000002 IDENTIFICATION DIVISION. -000003 PROGRAM-ID. prog. -000004 DATA DIVISION. -000005 WORKING-STORAGE SECTION. -000006 COPY "copy-1.inc" -000007 REPLACING ==TEST-VAR== BY ==COPY-VAR==. -000001C -000002C COPY "copy-2.inc". -000001C -000002C 01 COPY-VAR PIC X(2) VALUE "OK". -000008 PROCEDURE DIVISION. -000009 DISPLAY COPY-VAR NO ADVANCING -000010 END-DISPLAY. -000011 STOP RUN. - -SIZE TYPE LVL NAME PICTURE - - WORKING-STORAGE SECTION - -00002 ALPHANUMERIC 01 COPY-VAR X(2) - - -0 warnings in compilation group -0 errors in compilation group -]) - -AT_CHECK([gcdiff -IGnuCOBOL prog6.lst prog.lst], [0], [], []) - -AT_CLEANUP - - -AT_SETUP([COPY multiple files]) -AT_KEYWORDS([listing symbols]) - -AT_CAPTURE_FILE([prog.lst]) - -AT_DATA([copy-fd-1.inc], [ - FD TEXTFILE-1 RECORD VARYING 1 TO 999 CHARACTERS - DEPENDING ON TEXTFILE-1-SIZE. - 01 TEXTRECD-1. - 03 FILLER PIC X(999). - * -]) - -AT_DATA([copy-fd-2.inc], [ - FD TEXTFILE-2 RECORD VARYING 1 TO 999 CHARACTERS - DEPENDING ON TEXTFILE-2-SIZE. - 01 TEXTRECD-2. - 03 FILLER PIC X(999). - * -]) - -AT_DATA([copy-ws-1.inc], [ - 01 TEXTFILE-1-NAME PIC X(080) VALUE "TEXTFILE.1". - 01 TEXTFILE-1-OCFG PIC X(001) VALUE "C". - 88 TEXTFILE-1-NOTOPEN VALUE "C". - 88 TEXTFILE-1-IS-OPEN VALUE "I", "O", "U". - 01 TEXTFILE-1-SIZE PIC 9(004). - * -]) - -AT_DATA([copy-ws-2.inc], [ - 01 TEXTFILE-2-NAME PIC X(080) VALUE "TEXTFILE.2". - 01 TEXTFILE-2-OCFG PIC X(001) VALUE "C". - 88 TEXTFILE-2-NOTOPEN VALUE "C". - 88 TEXTFILE-2-IS-OPEN VALUE "I", "O", "U". - 01 TEXTFILE-2-SIZE PIC 9(004). - * -]) - -AT_DATA([copy-sl-1.inc], [ - SELECT TEXTFILE-1 ASSIGN TO DISK TEXTFILE-1-NAME - ORGANIZATION LINE SEQUENTIAL - ACCESS MODE SEQUENTIAL. - * -]) - -AT_DATA([copy-sl-2.inc], [ - SELECT TEXTFILE-2 ASSIGN TO DISK TEXTFILE-2-NAME - ORGANIZATION LINE SEQUENTIAL - ACCESS MODE SEQUENTIAL. - * -]) - -AT_DATA([tstcpybk.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. tstcpybk. - * - ENVIRONMENT DIVISION. - CONFIGURATION SECTION. - * - SOURCE-COMPUTER. LINUX. - OBJECT-COMPUTER. LINUX. - - INPUT-OUTPUT SECTION. - FILE-CONTROL. - COPY "copy-sl-1.inc". - COPY "copy-sl-2.inc". - - DATA DIVISION. - FILE SECTION. - COPY "copy-fd-1.inc". - COPY "copy-fd-2.inc". - - WORKING-STORAGE SECTION. - 01 FILLER. - 03 FILLER PIC X(016) VALUE 'FCSI CodeWerks:'. - 03 FILLER PIC X(064) VALUE - 'Name:tstcpybk.cbl Version:1.7.1 Date:2017-03-15'. - 03 FILLER PIC X(002) VALUE LOW-VALUES. - * - COPY "copy-ws-1.inc". - COPY "copy-ws-2.inc". - - PROCEDURE DIVISION. - MAIN-PROCEDURE SECTION. - MAIN-PROCEDURE-0000. - CONTINUE. - MAIN-PROCEDURE-EXIT. - STOP RUN. -]) - -AT_CHECK([$COMPILE_ONLY -t prog.lst -tlines=0 -tsymbols tstcpybk.cob], [0], [], []) - -AT_DATA([prog3.lst], -[GnuCOBOL V.R.P tstcpybk.cob DDD MMM dd HH:MM:SS YYYY - -LINE PG/LN A...B............................................................ - -000001 -000002 IDENTIFICATION DIVISION. -000003 PROGRAM-ID. tstcpybk. -000004 * -000005 ENVIRONMENT DIVISION. -000006 CONFIGURATION SECTION. -000007 * -000008 SOURCE-COMPUTER. LINUX. -000009 OBJECT-COMPUTER. LINUX. -000010 -000011 INPUT-OUTPUT SECTION. -000012 FILE-CONTROL. -000013 COPY "copy-sl-1.inc". -000001C -000002C SELECT TEXTFILE-1 ASSIGN TO DISK TEXTFILE-1-NAME -000003C ORGANIZATION LINE SEQUENTIAL -000004C ACCESS MODE SEQUENTIAL. -000005C * -000014 COPY "copy-sl-2.inc". -000001C -000002C SELECT TEXTFILE-2 ASSIGN TO DISK TEXTFILE-2-NAME -000003C ORGANIZATION LINE SEQUENTIAL -000004C ACCESS MODE SEQUENTIAL. -000005C * -000015 -000016 DATA DIVISION. -000017 FILE SECTION. -000018 COPY "copy-fd-1.inc". -000001C -000002C FD TEXTFILE-1 RECORD VARYING 1 TO 999 CHARACTERS -000003C DEPENDING ON TEXTFILE-1-SIZE. -000004C 01 TEXTRECD-1. -000005C 03 FILLER PIC X(999). -000006C * -000019 COPY "copy-fd-2.inc". -000001C -000002C FD TEXTFILE-2 RECORD VARYING 1 TO 999 CHARACTERS -000003C DEPENDING ON TEXTFILE-2-SIZE. -000004C 01 TEXTRECD-2. -000005C 03 FILLER PIC X(999). -000006C * -000020 -000021 WORKING-STORAGE SECTION. -000022 01 FILLER. -000023 03 FILLER PIC X(016) VALUE 'FCSI CodeWerks:'. -000024 03 FILLER PIC X(064) VALUE -000025 'Name:tstcpybk.cbl Version:1.7.1 Date:2017-03-15'. -000026 03 FILLER PIC X(002) VALUE LOW-VALUES. -000027 * -000028 COPY "copy-ws-1.inc". -000001C -000002C 01 TEXTFILE-1-NAME PIC X(080) VALUE "TEXTFILE.1". -000003C 01 TEXTFILE-1-OCFG PIC X(001) VALUE "C". -000004C 88 TEXTFILE-1-NOTOPEN VALUE "C". -000005C 88 TEXTFILE-1-IS-OPEN VALUE "I", "O", "U". -000006C 01 TEXTFILE-1-SIZE PIC 9(004). -000007C * -000029 COPY "copy-ws-2.inc". -000001C -000002C 01 TEXTFILE-2-NAME PIC X(080) VALUE "TEXTFILE.2". -000003C 01 TEXTFILE-2-OCFG PIC X(001) VALUE "C". -000004C 88 TEXTFILE-2-NOTOPEN VALUE "C". -000005C 88 TEXTFILE-2-IS-OPEN VALUE "I", "O", "U". -000006C 01 TEXTFILE-2-SIZE PIC 9(004). -000007C * -000030 -000031 PROCEDURE DIVISION. -000032 MAIN-PROCEDURE SECTION. -000033 MAIN-PROCEDURE-0000. -000034 CONTINUE. -000035 MAIN-PROCEDURE-EXIT. -000036 STOP RUN. - -SIZE TYPE LVL NAME PICTURE - -00999 FILE TEXTFILE-1 -00999 GROUP 01 TEXTRECD-1 -00999 ALPHANUMERIC 03 FILLER X(999) - -00999 FILE TEXTFILE-2 -00999 GROUP 01 TEXTRECD-2 -00999 ALPHANUMERIC 03 FILLER X(999) - - WORKING-STORAGE SECTION - -00082 GROUP 01 FILLER -00016 ALPHANUMERIC 03 FILLER X(016) -00064 ALPHANUMERIC 03 FILLER X(064) -00002 ALPHANUMERIC 03 FILLER X(002) - -00080 ALPHANUMERIC 01 TEXTFILE-1-NAME X(080) - -00001 ALPHANUMERIC 01 TEXTFILE-1-OCFG X(001) - CONDITIONAL 88 TEXTFILE-1-NOTOPEN - CONDITIONAL 88 TEXTFILE-1-IS-OPEN - -00004 ALPHANUMERIC 01 TEXTFILE-1-SIZE 9(004) - -00080 ALPHANUMERIC 01 TEXTFILE-2-NAME X(080) - -00001 ALPHANUMERIC 01 TEXTFILE-2-OCFG X(001) - CONDITIONAL 88 TEXTFILE-2-NOTOPEN - CONDITIONAL 88 TEXTFILE-2-IS-OPEN - -00004 ALPHANUMERIC 01 TEXTFILE-2-SIZE 9(004) - - -0 warnings in compilation group -0 errors in compilation group -]) - -AT_CHECK([gcdiff -IGnuCOBOL prog3.lst prog.lst], [0], [], []) - -AT_CLEANUP - - -AT_SETUP([Error/Warning messages]) -AT_KEYWORDS([listing error warning symbols]) - -AT_CAPTURE_FILE([prog.lst]) - -AT_DATA([copy.inc], [ - ENVIRONMENT DIVISION. - INPUT-OUTPUT SECTION. - FILE-CONTROL. - SELECT testfile - ASSIGN TO filename - ORGANIZATION RELATIVE - ACCESS IS sequentia - STATUS IS stat. -]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - COPY "copy.inc". - DATA DIVISION. - WORKING-STORAGE SECTION. - PROCEDURE DIVISION. - DISPLAY FIRST-MATCH NO ADVANCING - END-DISPLAY. - STOP RUN. -]) - -AT_CHECK([$COMPILE_ONLY -t prog.lst prog.cob], [1], [], -[copy.inc:8: error: syntax error, unexpected Identifier, expecting DYNAMIC or RANDOM or SEQUENTIAL -copy.inc:5: error: missing file description for FILE testfile -prog.cob:7: warning: variable 'filename' will be implicitly defined -prog.cob:8: error: 'FIRST-MATCH' is not defined -]) - -AT_DATA([prog12.lst], -[GnuCOBOL V.R.P prog.cob DDD MMM dd HH:MM:SS YYYY Page 0001 - -LINE PG/LN A...B............................................................ - -000001 -000002 IDENTIFICATION DIVISION. -000003 PROGRAM-ID. prog. -000004 COPY "copy.inc". -000001C -000002C ENVIRONMENT DIVISION. -000003C INPUT-OUTPUT SECTION. -000004C FILE-CONTROL. -000005C SELECT testfile -error: missing file description for FILE testfile -000006C ASSIGN TO filename -000007C ORGANIZATION RELATIVE -000008C ACCESS IS sequentia -error: syntax error, unexpected Identifier, expecting DYNAMIC or RANDOM or - + SEQUENTIAL -000009C STATUS IS stat. -000005 DATA DIVISION. -000006 WORKING-STORAGE SECTION. -000007 PROCEDURE DIVISION. -warning: variable 'filename' will be implicitly defined -000008 DISPLAY FIRST-MATCH NO ADVANCING -error: 'FIRST-MATCH' is not defined -000009 END-DISPLAY. -000010 STOP RUN. - - - GnuCOBOL V.R.P prog.cob DDD MMM dd HH:MM:SS YYYY Page 0002 - -Error/Warning summary: - -copy.inc:8: error: syntax error, unexpected Identifier, expecting DYNAMIC or RANDOM or SEQUENTIAL -copy.inc:5: error: missing file description for FILE testfile -prog.cob:7: warning: variable 'filename' will be implicitly defined -prog.cob:8: error: 'FIRST-MATCH' is not defined - -1 warning in compilation group -3 errors in compilation group -]) - -AT_CHECK([gcdiff -IGnuCOBOL prog12.lst prog.lst], [0], [], []) - -AT_CHECK([$COMPILE_ONLY -T prog.lst prog.cob], [1], [], -[copy.inc:8: error: syntax error, unexpected Identifier, expecting DYNAMIC or RANDOM or SEQUENTIAL -copy.inc:5: error: missing file description for FILE testfile -prog.cob:7: warning: variable 'filename' will be implicitly defined -prog.cob:8: error: 'FIRST-MATCH' is not defined -]) - -AT_DATA([prog13.lst], -[GnuCOBOL V.R.P prog.cob DDD MMM dd HH:MM:SS YYYY Page 0001 - -LINE PG/LN A...B............................................................SEQUENCE - -000001 -000002 IDENTIFICATION DIVISION. -000003 PROGRAM-ID. prog. -000004 COPY "copy.inc". -000001C -000002C ENVIRONMENT DIVISION. -000003C INPUT-OUTPUT SECTION. -000004C FILE-CONTROL. -000005C SELECT testfile -error: missing file description for FILE testfile -000006C ASSIGN TO filename -000007C ORGANIZATION RELATIVE -000008C ACCESS IS sequentia -error: syntax error, unexpected Identifier, expecting DYNAMIC or RANDOM or SEQUENTIAL -000009C STATUS IS stat. -000005 DATA DIVISION. -000006 WORKING-STORAGE SECTION. -000007 PROCEDURE DIVISION. -warning: variable 'filename' will be implicitly defined -000008 DISPLAY FIRST-MATCH NO ADVANCING -error: 'FIRST-MATCH' is not defined -000009 END-DISPLAY. -000010 STOP RUN. - - - GnuCOBOL V.R.P prog.cob DDD MMM dd HH:MM:SS YYYY Page 0002 - -Error/Warning summary: - -copy.inc:8: error: syntax error, unexpected Identifier, expecting DYNAMIC or RANDOM or SEQUENTIAL -copy.inc:5: error: missing file description for FILE testfile -prog.cob:7: warning: variable 'filename' will be implicitly defined -prog.cob:8: error: 'FIRST-MATCH' is not defined - -1 warning in compilation group -3 errors in compilation group -]) - -AT_CHECK([gcdiff -IGnuCOBOL prog13.lst prog.lst], [0], [], []) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 TEST-VAR PIC 9(2) VALUE 'F1'. - PROCEDURE DIVISION. - DISPLAY TEST-VAR NO ADVANCING - END-DISPLAY. - STOP RUN. -]) - -AT_CHECK([$COMPILE_ONLY -t prog.lst -tsymbols prog.cob], [0], [], -[prog.cob:6: warning: numeric value is expected -]) - -AT_DATA([prog14.lst], -[GnuCOBOL V.R.P prog.cob DDD MMM dd HH:MM:SS YYYY Page 0001 - -LINE PG/LN A...B............................................................ - -000001 -000002 IDENTIFICATION DIVISION. -000003 PROGRAM-ID. prog. -000004 DATA DIVISION. -000005 WORKING-STORAGE SECTION. -000006 01 TEST-VAR PIC 9(2) VALUE 'F1'. -warning: numeric value is expected -000007 PROCEDURE DIVISION. -000008 DISPLAY TEST-VAR NO ADVANCING -000009 END-DISPLAY. -000010 STOP RUN. - GnuCOBOL V.R.P prog.cob DDD MMM dd HH:MM:SS YYYY Page 0002 - -SIZE TYPE LVL NAME PICTURE - - WORKING-STORAGE SECTION - -00002 NUMERIC 01 TEST-VAR 9(2) - - - GnuCOBOL V.R.P prog.cob DDD MMM dd HH:MM:SS YYYY Page 0003 - -Error/Warning summary: - -prog.cob:6: warning: numeric value is expected - -1 warning in compilation group -0 errors in compilation group -]) - -AT_CHECK([gcdiff -IGnuCOBOL prog14.lst prog.lst], [0], [], []) - - -AT_CHECK([$COMPILE_ONLY -t prog.lst crud.cob], [1], [], -[cobc: crud.cob: No such file or directory -]) - -AT_DATA([prog15.lst], -[GnuCOBOL V.R.P crud.cob DDD MMM dd HH:MM:SS YYYY Page 0001 - - cobc: crud.cob: No such file or directory - - -0 warnings in compilation group -1 error in compilation group -]) - -AT_CHECK([gcdiff -IGnuCOBOL prog15.lst prog.lst], [0], [], []) - -AT_DATA([prog.cpy], [ - 78 I VALUE 20. - 78 J VALUE 5000. - 78 M VALUE 5. -]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 TEST-VAR PIC 9(2) VALUE 12. - COPY 'prog.cpy'. - PROCEDURE DIVISION. - DISPLAY TEST-VAR NO ADVANCING - END-DISPLAY - MOVE 'AA' TO TEST-VAR - DISPLAY TEST-VAR NO ADVANCING - END-DISPLAY - STOP RUN. -]) - -AT_CHECK([$COBC $FLAGS -E -o prog.i prog.cob], [0], [], []) -AT_CHECK([$COMPILE_ONLY -t prog.lst -tlines=0 -tsymbols prog.i], [0], [], -[prog.cob:11: warning: numeric value is expected -prog.cob:6: warning: 'TEST-VAR' defined here as PIC 9(2) -]) - -AT_DATA([prog17.lst], -[GnuCOBOL V.R.P prog.i DDD MMM dd HH:MM:SS YYYY - -LINE PG/LN A...B............................................................ - -000001 #line 1 "prog.cob" -000001 -000002 IDENTIFICATION DIVISION. -000003 PROGRAM-ID. prog. -000004 DATA DIVISION. -000005 WORKING-STORAGE SECTION. -000006 01 TEST-VAR PIC 9(2) VALUE 12. -000007 -000001 #line 1 "prog.cpy" -000001 -000002 78 I VALUE 20. -000003 78 J VALUE 5000. -000004 78 M VALUE 5. -000007 #line 7 "prog.cob" -000007 -000008 PROCEDURE DIVISION. -000009 DISPLAY TEST-VAR NO ADVANCING -000010 END-DISPLAY -000011 MOVE 'AA' TO TEST-VAR -warning: numeric value is expected -000012 DISPLAY TEST-VAR NO ADVANCING -000013 END-DISPLAY -000014 STOP RUN. - -SIZE TYPE LVL NAME PICTURE - - WORKING-STORAGE SECTION - -00002 NUMERIC 01 TEST-VAR 9(2) - - - -Error/Warning summary: - -prog.cob:11: warning: numeric value is expected - -1 warning in compilation group -0 errors in compilation group -]) - -AT_CHECK([gcdiff -IGnuCOBOL prog17.lst prog.lst], [0], [], []) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 TEST-VAR PIC 9(2) VALUE 'A'. - COPY 'CRUD.CPY'. - PROCEDURE DIVISION. - DISPLAY TEST-VAR NO ADVANCING - END-DISPLAY - MOVE 12 TO TEST-VAR - DISPLAY TEST-VAR NO ADVANCING - END-DISPLAY - STOP RUN. -]) - -AT_CHECK([$COMPILE_ONLY -t prog.lst -tlines=0 prog.cob], [1], [], -[prog.cob:7: error: CRUD.CPY: No such file or directory -prog.cob:6: warning: numeric value is expected -]) - -AT_DATA([prog16.lst], -[GnuCOBOL V.R.P prog.cob DDD MMM dd HH:MM:SS YYYY - -LINE PG/LN A...B............................................................ - -000001 -000002 IDENTIFICATION DIVISION. -000003 PROGRAM-ID. prog. -000004 DATA DIVISION. -000005 WORKING-STORAGE SECTION. -000006 01 TEST-VAR PIC 9(2) VALUE 'A'. -warning: numeric value is expected -000007 COPY 'CRUD.CPY'. -error: CRUD.CPY: No such file or directory -000008 PROCEDURE DIVISION. -000009 DISPLAY TEST-VAR NO ADVANCING -000010 END-DISPLAY -000011 MOVE 12 TO TEST-VAR -000012 DISPLAY TEST-VAR NO ADVANCING -000013 END-DISPLAY -000014 STOP RUN. - - - -Error/Warning summary: - -prog.cob:7: error: CRUD.CPY: No such file or directory -prog.cob:6: warning: numeric value is expected - -1 warning in compilation group -1 error in compilation group -]) - -AT_CHECK([gcdiff -IGnuCOBOL prog16.lst prog.lst], [0], [], []) - -AT_CHECK([$COMPILE_ONLY -t prog.lst -tlines=0 -fmax-errors=0 prog.cob], [97], [], -[prog.cob:7: error: CRUD.CPY: No such file or directory -cobc: too many errors - -cobc: aborting compile of prog.cob at line 7 (unknown: unknown) -]) - -AT_DATA([prog17.lst], -[GnuCOBOL V.R.P prog.cob DDD MMM dd HH:MM:SS YYYY - -LINE PG/LN A...B............................................................ - -000001 -000002 IDENTIFICATION DIVISION. -000003 PROGRAM-ID. prog. -000004 DATA DIVISION. -000005 WORKING-STORAGE SECTION. -000006 01 TEST-VAR PIC 9(2) VALUE 'A'. -000007 COPY 'CRUD.CPY'. -error: CRUD.CPY: No such file or directory -cobc: too many errors -000008 PROCEDURE DIVISION. -000009 DISPLAY TEST-VAR NO ADVANCING -000010 END-DISPLAY -000011 MOVE 12 TO TEST-VAR -000012 DISPLAY TEST-VAR NO ADVANCING -000013 END-DISPLAY -000014 STOP RUN. - - - -Error/Warning summary: - -prog.cob:7: error: CRUD.CPY: No such file or directory -cobc: too many errors - -0 warnings in compilation group -1 error in compilation group -Too many errors in compilation group: 0 maximum errors -]) - -AT_CHECK([gcdiff -IGnuCOBOL prog17.lst prog.lst], [0], [], []) - - -AT_CLEANUP - - -AT_SETUP([Two source files]) -AT_KEYWORDS([listing]) - -AT_CAPTURE_FILE([prog.lst]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - *COPY "copy.inc". - PROCEDURE DIVISION. - STOP RUN. -]) - -AT_DATA([prog1.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog1. - DATA DIVISION. - WORKING-STORAGE SECTION. - *COPY "copy.inc". - PROCEDURE DIVISION. - STOP RUN. -]) - -AT_CHECK([$COMPILE_ONLY -t prog.lst prog.cob prog1.cob], [0], [], []) - -AT_DATA([prog11.lst], -[GnuCOBOL V.R.P prog.cob DDD MMM dd HH:MM:SS YYYY Page 0001 - -LINE PG/LN A...B............................................................ - -000001 -000002 IDENTIFICATION DIVISION. -000003 PROGRAM-ID. prog. -000004 DATA DIVISION. -000005 WORKING-STORAGE SECTION. -000006 *COPY "copy.inc". -000007 PROCEDURE DIVISION. -000008 STOP RUN. - - -0 warnings in compilation group -0 errors in compilation group - GnuCOBOL V.R.P prog1.cob DDD MMM dd HH:MM:SS YYYY Page 0001 - -LINE PG/LN A...B............................................................ - -000001 -000002 IDENTIFICATION DIVISION. -000003 PROGRAM-ID. prog1. -000004 DATA DIVISION. -000005 WORKING-STORAGE SECTION. -000006 *COPY "copy.inc". -000007 PROCEDURE DIVISION. -000008 STOP RUN. - - -0 warnings in compilation group -0 errors in compilation group -]) - -AT_CHECK([gcdiff -IGnuCOBOL prog11.lst prog.lst], [0], [], []) - -AT_CLEANUP - - -AT_SETUP([Multiple programs in one file]) -AT_KEYWORDS([listing symbols]) - -AT_CAPTURE_FILE([prog.lst]) -AT_CAPTURE_FILE([prog2.lst]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog-1. - - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 blah PIC x. - - END PROGRAM prog-1. - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog-2. - END PROGRAM prog-2. -]) - -AT_DATA([prog20.lst], -[GnuCOBOL V.R.P prog.cob DDD MMM dd HH:MM:SS YYYY Page 0001 - -LINE PG/LN A...B............................................................ - -000001 -000002 IDENTIFICATION DIVISION. -000003 PROGRAM-ID. prog-1. -000004 -000005 DATA DIVISION. -000006 WORKING-STORAGE SECTION. -000007 01 blah PIC x. -000008 -000009 END PROGRAM prog-1. -000010 -000011 IDENTIFICATION DIVISION. -000012 PROGRAM-ID. prog-2. -000013 END PROGRAM prog-2. - GnuCOBOL V.R.P prog.cob DDD MMM dd HH:MM:SS YYYY Page 0002 - -SIZE TYPE LVL NAME PICTURE - - PROGRAM prog-1 - - WORKING-STORAGE SECTION - -00001 ALPHANUMERIC 01 blah X - - PROGRAM prog-2 - - No fields defined. - - -0 warnings in compilation group -0 errors in compilation group -]) - -# Check once with $COMPILE and once with $COMPILE_ONLY. -# This tests whether codegen affects the listing. -AT_CHECK([$COMPILE -t prog.lst -tsymbols prog.cob], [0], [], []) -AT_CHECK([gcdiff -IGnuCOBOL prog20.lst prog.lst], [0], [], []) -AT_CHECK([$COMPILE_ONLY -t prog2.lst -tsymbols prog.cob], [0], [], []) -AT_CHECK([gcdiff -IGnuCOBOL prog20.lst prog2.lst], [0], [], []) - -AT_CHECK([rm -f prog.lst prog2.lst], [0], [], []) - -AT_DATA([progb.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog-1. - - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 blah PIC x. - - PROCEDURE DIVISION. - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog-2. - PROCEDURE DIVISION. - END PROGRAM prog-2. - - END PROGRAM prog-1. -]) - -AT_DATA([prog20b.lst], -[GnuCOBOL V.R.P progb.cob DDD MMM dd HH:MM:SS YYYY Page 0001 - -LINE PG/LN A...B............................................................ - -000001 -000002 IDENTIFICATION DIVISION. -000003 PROGRAM-ID. prog-1. -000004 -000005 DATA DIVISION. -000006 WORKING-STORAGE SECTION. -000007 01 blah PIC x. -000008 -000009 PROCEDURE DIVISION. -000010 -000011 IDENTIFICATION DIVISION. -000012 PROGRAM-ID. prog-2. -000013 PROCEDURE DIVISION. -000014 END PROGRAM prog-2. -000015 -000016 END PROGRAM prog-1. - GnuCOBOL V.R.P progb.cob DDD MMM dd HH:MM:SS YYYY Page 0002 - -SIZE TYPE LVL NAME PICTURE - - PROGRAM prog-1 - - WORKING-STORAGE SECTION - -00001 ALPHANUMERIC 01 blah X - - PROGRAM prog-2 - - No fields defined. - - -0 warnings in compilation group -0 errors in compilation group -]) - -# Check once with $COMPILE and once with $COMPILE_ONLY. -# This tests whether codegen affects the listing. -AT_CHECK([$COMPILE -t prog.lst -tsymbols progb.cob], [0], [], []) -AT_CHECK([gcdiff -IGnuCOBOL prog20b.lst prog.lst], [0], [], []) -AT_CHECK([$COMPILE_ONLY -t prog2.lst -tsymbols progb.cob], [0], [], []) -AT_CHECK([gcdiff -IGnuCOBOL prog20b.lst prog2.lst], [0], [], []) - -AT_CHECK([rm -f prog.lst prog2.lst], [0], [], []) - -AT_DATA([progc.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog-1. - - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 blah PIC x. - - PROCEDURE DIVISION. - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog-2. - PROCEDURE. - END PROGRAM prog-2. - - END PROGRAM prog-1. -]) - -AT_DATA([prog20c.lst], -[GnuCOBOL V.R.P progc.cob DDD MMM dd HH:MM:SS YYYY Page 0001 - -LINE PG/LN A...B............................................................ - -000001 -000002 IDENTIFICATION DIVISION. -000003 PROGRAM-ID. prog-1. -000004 -000005 DATA DIVISION. -000006 WORKING-STORAGE SECTION. -000007 01 blah PIC x. -000008 -000009 PROCEDURE DIVISION. -000010 -000011 IDENTIFICATION DIVISION. -000012 PROGRAM-ID. prog-2. -000013 PROCEDURE. -error: syntax error, unexpected ., expecting DIVISION -000014 END PROGRAM prog-2. -000015 -000016 END PROGRAM prog-1. - GnuCOBOL V.R.P progc.cob DDD MMM dd HH:MM:SS YYYY Page 0002 - -SIZE TYPE LVL NAME PICTURE - - PROGRAM prog-1 - - WORKING-STORAGE SECTION - -00001 ALPHANUMERIC 01 blah X - - PROGRAM prog-2 - - No fields defined. - - - GnuCOBOL V.R.P progc.cob DDD MMM dd HH:MM:SS YYYY Page 0003 - -Error/Warning summary: - -progc.cob:13: error: syntax error, unexpected ., expecting DIVISION - -0 warnings in compilation group -1 error in compilation group -]) - -# Check once with $COMPILE and once with $COMPILE_ONLY. -# This tests whether codegen affects the listing. -AT_CHECK([$COMPILE -t prog.lst -tsymbols progc.cob], [1], [], -[progc.cob:13: error: syntax error, unexpected ., expecting DIVISION -]) -AT_CHECK([gcdiff -IGnuCOBOL prog20c.lst prog.lst], [0], [], []) -AT_CHECK([$COMPILE_ONLY -t prog2.lst -tsymbols progc.cob], [1], [], -[progc.cob:13: error: syntax error, unexpected ., expecting DIVISION -]) -AT_CHECK([gcdiff -IGnuCOBOL prog20c.lst prog2.lst], [0], [], []) - -AT_CLEANUP - - -AT_SETUP([Multiple programs in one compilation group]) -AT_KEYWORDS([listing]) - -# TODO CHECK -# combinations and positions of entries in compilation group, -# the previous test should likely produce a different result, too... - -AT_CAPTURE_FILE([prog.lst]) - -AT_DATA([prog-1.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog-1. - - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 blah PIC x. - - PROCEDURE DIVISION. - ACCEPT blah END-ACCEPT - CALL "prog-2" USING blah END-CALL - GO TO EX - - DISPLAY blah. - - EX. STOP RUN. -]) - -AT_DATA([prog-2.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog-2. - - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 data-b PIC 9. - LINKAGE SECTION. - 01 stuff PIC x. - PROCEDURE DIVISION USING stuff. - - MOVE FUNCTION NUMVAL (stuff) TO data-b - DISPLAY data-b - GO TO EX - - ACCEPT stuff. - - EX. STOP RUN. - -]) - -AT_DATA([expected.lst], -[GnuCOBOL V.R.P prog-1.cob DDD MMM dd HH:MM:SS YYYY Page 0001 - -LINE PG/LN A...B............................................................ - -000001 -000002 IDENTIFICATION DIVISION. -000003 PROGRAM-ID. prog-1. -000004 -000005 DATA DIVISION. -000006 WORKING-STORAGE SECTION. -000007 01 blah PIC x. -000008 -000009 PROCEDURE DIVISION. -000010 ACCEPT blah END-ACCEPT -000011 CALL "prog-2" USING blah END-CALL -000012 GO TO EX -000013 -000014 DISPLAY blah. -warning: unreachable statement 'DISPLAY' -000015 -000016 EX. STOP RUN. - GnuCOBOL V.R.P prog-1.cob DDD MMM dd HH:MM:SS YYYY Page 0002 - -SIZE TYPE LVL NAME PICTURE - - WORKING-STORAGE SECTION - -00001 ALPHANUMERIC 01 blah X - - GnuCOBOL V.R.P prog-1.cob DDD MMM dd HH:MM:SS YYYY Page 0003 - -NAME DEFINED REFERENCES - -blah 7 *10 11 14 - - GnuCOBOL V.R.P prog-1.cob DDD MMM dd HH:MM:SS YYYY Page 0004 - -LABEL DEFINED REFERENCES - -E prog__1 9 -P EX 16 12 - GnuCOBOL V.R.P prog-1.cob DDD MMM dd HH:MM:SS YYYY Page 0005 - -FUNCTION TYPE REFERENCES - -L prog-2 EXTERN 11 - - GnuCOBOL V.R.P prog-1.cob DDD MMM dd HH:MM:SS YYYY Page 0006 - -Error/Warning summary: - -prog-1.cob:14: warning: unreachable statement 'DISPLAY' - -1 warning in compilation group -0 errors in compilation group - GnuCOBOL V.R.P prog-2.cob DDD MMM dd HH:MM:SS YYYY Page 0001 - -LINE PG/LN A...B............................................................ - -000001 -000002 IDENTIFICATION DIVISION. -000003 PROGRAM-ID. prog-2. -000004 -000005 DATA DIVISION. -000006 WORKING-STORAGE SECTION. -000007 01 data-b PIC 9. -000008 LINKAGE SECTION. -000009 01 stuff PIC x. -000010 PROCEDURE DIVISION USING stuff. -000011 -000012 MOVE FUNCTION NUMVAL (stuff) TO data-b -000013 DISPLAY data-b -000014 GO TO EX -000015 -000016 ACCEPT stuff. -warning: unreachable statement 'ACCEPT' -000017 -000018 EX. STOP RUN. -000019 - GnuCOBOL V.R.P prog-2.cob DDD MMM dd HH:MM:SS YYYY Page 0002 - -SIZE TYPE LVL NAME PICTURE - - WORKING-STORAGE SECTION - -00001 NUMERIC 01 data-b 9 - - LINKAGE SECTION - -00001 ALPHANUMERIC 01 stuff X - - GnuCOBOL V.R.P prog-2.cob DDD MMM dd HH:MM:SS YYYY Page 0003 - -NAME DEFINED REFERENCES - -data-b 7 *12 13 - -stuff 9 *10 12 *16 - - GnuCOBOL V.R.P prog-2.cob DDD MMM dd HH:MM:SS YYYY Page 0004 - -LABEL DEFINED REFERENCES - -E prog__2 10 -P EX 18 14 - - GnuCOBOL V.R.P prog-2.cob DDD MMM dd HH:MM:SS YYYY Page 0005 - -Error/Warning summary: - -prog-2.cob:16: warning: unreachable statement 'ACCEPT' - -2 warnings in compilation group -0 errors in compilation group -]) - -# Check once with $COMPILE and once with $COMPILE_ONLY. -# This tests whether codegen affects the listing. - -AT_CHECK([$COMPILE -x -Wunreachable -t prog.lst -Xref -tsymbols prog-1.cob prog-2.cob], [0], [], -[prog-1.cob:14: warning: unreachable statement 'DISPLAY' -prog-2.cob:16: warning: unreachable statement 'ACCEPT' -]) -AT_CHECK([gcdiff -IGnuCOBOL expected.lst prog.lst], [0], [], []) - -AT_CHECK([$COMPILE_ONLY -Wunreachable -t prog.lst -Xref -tsymbols prog-1.cob prog-2.cob], [0], [], -[prog-1.cob:14: warning: unreachable statement 'DISPLAY' -prog-2.cob:16: warning: unreachable statement 'ACCEPT' -]) -AT_CHECK([gcdiff -IGnuCOBOL expected.lst prog.lst], [0], [], []) - -AT_CLEANUP - - -AT_SETUP([Wide listing]) -AT_KEYWORDS([listing]) - -AT_CAPTURE_FILE([prog.lst]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. PROG001 - PROGRAM-ID. prog. PROG002 - DATA DIVISION. PROG003 - WORKING-STORAGE SECTION. PROG004 - / PROG005 - PROCEDURE DIVISION. PROG006 - STOP RUN. PROG007 -]) - -AT_CHECK([$COMPILE_ONLY -T prog.lst prog.cob], [0], [], []) - -AT_DATA([prog9.lst], -[GnuCOBOL V.R.P prog.cob DDD MMM dd HH:MM:SS YYYY Page 0001 - -LINE PG/LN A...B............................................................SEQUENCE - -000001 -000002 IDENTIFICATION DIVISION. PROG001 -000003 PROGRAM-ID. prog. PROG002 -000004 DATA DIVISION. PROG003 -000005 WORKING-STORAGE SECTION. PROG004 - GnuCOBOL V.R.P prog.cob DDD MMM dd HH:MM:SS YYYY Page 0002 - -LINE PG/LN A...B............................................................SEQUENCE - -000006 / PROG005 -000007 PROCEDURE DIVISION. PROG006 -000008 STOP RUN. PROG007 - - -0 warnings in compilation group -0 errors in compilation group -]) - -AT_CHECK([gcdiff -IGnuCOBOL prog9.lst prog.lst], [0], [], []) - -AT_DATA([prog2.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog2. - DATA DIVISION. - WORKING-STORAGE SECTION. - >> PAGE page feed comment - PROCEDURE DIVISION. - DISPLAY - '3456&'. - STOP RUN. -]) - -AT_CHECK([$COMPILE_ONLY -T prog.lst -free prog2.cob], [0], [], []) - -AT_DATA([prog10.lst], -[GnuCOBOL V.R.P prog2.cob DDD MMM dd HH:MM:SS YYYY Page 0001 - -LINE .....................................................SOURCE..................................................... - -000001 -000002 IDENTIFICATION DIVISION. -000003 PROGRAM-ID. prog2. -000004 DATA DIVISION. -000005 WORKING-STORAGE SECTION. - GnuCOBOL V.R.P prog2.cob DDD MMM dd HH:MM:SS YYYY Page 0002 - -LINE .....................................................SOURCE..................................................... - -000006 >> PAGE page feed comment -000007 PROCEDURE DIVISION. -000008 DISPLAY -000009 '3456&'. -000010 STOP RUN. - - -0 warnings in compilation group -0 errors in compilation group -]) - -AT_CHECK([gcdiff -IGnuCOBOL prog10.lst prog.lst], [0], [], []) - -AT_CLEANUP - - -AT_SETUP([Symbols: simple]) -AT_KEYWORDS([listing COMP]) - -AT_CAPTURE_FILE([prog.lst]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 WS-ONE PIC 9(4) VALUE 37. - 01 WS-TWO PIC A(4) VALUE 'HIGH'. - 01 WS-THREE PIC X(4) VALUE 'BAR'. - 01 WS-FOUR COMP-1 VALUE 37. - 01 WS-FIVE COMP-2 VALUE 37. - 01 WS-SIX PIC S999 COMP-3 VALUE -37. - 01 WS-SEVEN PIC $$,$$$,$$9.99 VALUE ZERO. - PROCEDURE DIVISION. - STOP RUN. -]) - -AT_CHECK([$COMPILE_ONLY -t prog.lst -tlines=0 -tsymbols prog.cob], [0], [], []) - -AT_DATA([prog15.lst], -[GnuCOBOL V.R.P prog.cob DDD MMM dd HH:MM:SS YYYY - -LINE PG/LN A...B............................................................ - -000001 -000002 IDENTIFICATION DIVISION. -000003 PROGRAM-ID. prog. -000004 DATA DIVISION. -000005 WORKING-STORAGE SECTION. -000006 01 WS-ONE PIC 9(4) VALUE 37. -000007 01 WS-TWO PIC A(4) VALUE 'HIGH'. -000008 01 WS-THREE PIC X(4) VALUE 'BAR'. -000009 01 WS-FOUR COMP-1 VALUE 37. -000010 01 WS-FIVE COMP-2 VALUE 37. -000011 01 WS-SIX PIC S999 COMP-3 VALUE -37. -000012 01 WS-SEVEN PIC $$,$$$,$$9.99 VALUE ZERO. -000013 PROCEDURE DIVISION. -000014 STOP RUN. - -SIZE TYPE LVL NAME PICTURE - - WORKING-STORAGE SECTION - -00004 NUMERIC 01 WS-ONE 9(4) - -00004 ALPHABETIC 01 WS-TWO A(4) - -00004 ALPHANUMERIC 01 WS-THREE X(4) - -00004 NUMERIC 01 WS-FOUR S9(7)V9(8) COMP-1 - -00008 NUMERIC 01 WS-FIVE S9(17)V9(17) COMP-2 - -00002 NUMERIC 01 WS-SIX S999 COMP-3 - -00013 NUMERIC 01 WS-SEVEN $$,$$$,$$9.99 - - -0 warnings in compilation group -0 errors in compilation group -]) - -AT_CHECK([gcdiff -IGnuCOBOL prog15.lst prog.lst], [0], [], []) - -AT_DATA([prog2.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog2. - DATA DIVISION. - LINKAGE SECTION. - 01 WS-ONE PIC 9(4). - 01 WS-TWO PIC A(4). - 01 WS-THREE PIC X(4). - PROCEDURE DIVISION. - STOP RUN. -]) - -AT_CHECK([$COMPILE_ONLY -t prog.lst -tlines=0 -tsymbols prog2.cob], [0], [], []) - -AT_DATA([prog16.lst], -[GnuCOBOL V.R.P prog2.cob DDD MMM dd HH:MM:SS YYYY - -LINE PG/LN A...B............................................................ - -000001 -000002 IDENTIFICATION DIVISION. -000003 PROGRAM-ID. prog2. -000004 DATA DIVISION. -000005 LINKAGE SECTION. -000006 01 WS-ONE PIC 9(4). -000007 01 WS-TWO PIC A(4). -000008 01 WS-THREE PIC X(4). -000009 PROCEDURE DIVISION. -000010 STOP RUN. - -SIZE TYPE LVL NAME PICTURE - - LINKAGE SECTION - -00004 ALPHANUMERIC 01 WS-ONE 9(4) - -00004 ALPHANUMERIC 01 WS-TWO A(4) - -00004 ALPHANUMERIC 01 WS-THREE X(4) - - -0 warnings in compilation group -0 errors in compilation group -]) - -AT_CHECK([gcdiff -IGnuCOBOL prog16.lst prog.lst], [0], [], []) - -AT_DATA([prog3.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog3. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 WS-ONE PIC 9(4) VALUE 37. - 01 WS-TWO PIC A(4) VALUE 'HIGH'. - 01 WS-THREE PIC X(4) VALUE 'BAR'. - 01 WS-FOUR COMP-1 VALUE 37. - 01 WS-FIVE COMP-2 VALUE 37. - 01 WS-SIX PIC S999 COMP-3 VALUE -37. - 01 WS-SEVEN PIC $$,$$$,$$9.99 VALUE ZERO. - PROCEDURE DIVISION. - STOP RUN. -]) - -AT_CHECK([$COMPILE_ONLY -t prog.lst prog3.cob], [0], [], []) - -AT_DATA([prog15-1.lst], -[GnuCOBOL V.R.P prog3.cob DDD MMM dd HH:MM:SS YYYY Page 0001 - -LINE PG/LN A...B............................................................ - -000001 -000002 IDENTIFICATION DIVISION. -000003 PROGRAM-ID. prog3. -000004 DATA DIVISION. -000005 WORKING-STORAGE SECTION. -000006 01 WS-ONE PIC 9(4) VALUE 37. -000007 01 WS-TWO PIC A(4) VALUE 'HIGH'. -000008 01 WS-THREE PIC X(4) VALUE 'BAR'. -000009 01 WS-FOUR COMP-1 VALUE 37. -000010 01 WS-FIVE COMP-2 VALUE 37. -000011 01 WS-SIX PIC S999 COMP-3 VALUE -37. -000012 01 WS-SEVEN PIC $$,$$$,$$9.99 VALUE ZERO. -000013 PROCEDURE DIVISION. -000014 STOP RUN. - - -0 warnings in compilation group -0 errors in compilation group -]) - -AT_CHECK([gcdiff -IGnuCOBOL prog15-1.lst prog.lst], [0], [], []) - -AT_CLEANUP - - -AT_SETUP([Symbols: pointer]) -AT_KEYWORDS([listing 64bit]) - -AT_CAPTURE_FILE([prog.lst]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 77 WS-Where pic x(512). - - 01 ws-mysql. - 02 ws-mysql-cid usage pointer. - 02 ws-mysql-result usage pointer. - 02 ws-mysql-result-2 usage pointer. - 02 ws-mysql-result-3 usage pointer. - 02 ws-mysql-count-rows pic s9(9) comp. - 02 ws-mysql-error-number pic x(4). - 02 ws-mysql-error-message pic x(80). - 02 ws-mysql-host-name pic x(64). - 02 ws-mysql-implementation pic x(64). - 02 ws-mysql-password pic x(64). - 02 ws-mysql-base-name pic x(64). - 02 ws-mysql-port-number pic x(4). - 02 ws-mysql-socket pic x(64). - 02 ws-mysql-command pic x(4096). - - 01 ws-No-Paragraph pic 9(4). - local-storage section. - 01 subscripts usage comp-5. - 12 J pic s9(4). - 12 K pic s9(4). - 12 L pic s9(4). - - SCREEN SECTION. - 01 Display-Message-1 foreground-color 2. - 03 value "WS-Where=" line 23 col 1. - 03 from WS-Where (1:J) pic x(69) col 10. - 01 Display-Message-2 foreground-color 2. - 03 value "ST004 SQL Err No.=" line 4 col 1. - 03 using ws-mysql-error-number pic x(4) col 19. - 03 value " Para=" col 23. - 03 using WS-No-Paragraph pic 9(3) col 29. - 03 value " SQL Cmd=" col 32. - 03 using ws-mysql-command pic x(199) col 41. - 03 value "SQL Err Msg=" line 7 col 1. - 03 using ws-mysql-error-message pic x(67) col 13. - PROCEDURE DIVISION. - STOP RUN. -]) - -AT_CHECK([$COMPILE_ONLY -t prog.lst -tlines=0 -tsymbols prog.cob], [0], [], []) - -AT_CHECK([test "$COB_HAS_64_BIT_POINTER" = "yes"], [0], [], [], - -# Previous test "failed" --> 32 bit - -AT_DATA([prog17-32.lst], -[GnuCOBOL V.R.P prog.cob DDD MMM dd HH:MM:SS YYYY - -LINE PG/LN A...B............................................................ - -000001 -000002 IDENTIFICATION DIVISION. -000003 PROGRAM-ID. prog. -000004 DATA DIVISION. -000005 WORKING-STORAGE SECTION. -000006 77 WS-Where pic x(512). -000007 -000008 01 ws-mysql. -000009 02 ws-mysql-cid usage pointer. -000010 02 ws-mysql-result usage pointer. -000011 02 ws-mysql-result-2 usage pointer. -000012 02 ws-mysql-result-3 usage pointer. -000013 02 ws-mysql-count-rows pic s9(9) comp. -000014 02 ws-mysql-error-number pic x(4). -000015 02 ws-mysql-error-message pic x(80). -000016 02 ws-mysql-host-name pic x(64). -000017 02 ws-mysql-implementation pic x(64). -000018 02 ws-mysql-password pic x(64). -000019 02 ws-mysql-base-name pic x(64). -000020 02 ws-mysql-port-number pic x(4). -000021 02 ws-mysql-socket pic x(64). -000022 02 ws-mysql-command pic x(4096). -000023 -000024 01 ws-No-Paragraph pic 9(4). -000025 local-storage section. -000026 01 subscripts usage comp-5. -000027 12 J pic s9(4). -000028 12 K pic s9(4). -000029 12 L pic s9(4). -000030 -000031 SCREEN SECTION. -000032 01 Display-Message-1 foreground-color 2. -000033 03 value "WS-Where=" line 23 col 1. -000034 03 from WS-Where (1:J) pic x(69) col 10. -000035 01 Display-Message-2 foreground-color 2. -000036 03 value "ST004 SQL Err No.=" line 4 col 1. -000037 03 using ws-mysql-error-number pic x(4) col 19. -000038 03 value " Para=" col 23. -000039 03 using WS-No-Paragraph pic 9(3) col 29. -000040 03 value " SQL Cmd=" col 32. -000041 03 using ws-mysql-command pic x(199) col 41. -000042 03 value "SQL Err Msg=" line 7 col 1. -000043 03 using ws-mysql-error-message pic x(67) col 13. -000044 PROCEDURE DIVISION. -000045 STOP RUN. - -SIZE TYPE LVL NAME PICTURE - - WORKING-STORAGE SECTION - -00512 ALPHANUMERIC 77 WS-Where X(512) - -04524 GROUP 01 ws-mysql -00004 POINTER 02 ws-mysql-cid -00004 POINTER 02 ws-mysql-result -00004 POINTER 02 ws-mysql-result-2 -00004 POINTER 02 ws-mysql-result-3 -00004 NUMERIC 02 ws-mysql-count-rows S9(9) COMP -00004 ALPHANUMERIC 02 ws-mysql-error-number X(4) -00080 ALPHANUMERIC 02 ws-mysql-error-message X(80) -00064 ALPHANUMERIC 02 ws-mysql-host-name X(64) -00064 ALPHANUMERIC 02 ws-mysql-implementation X(64) -00064 ALPHANUMERIC 02 ws-mysql-password X(64) -00064 ALPHANUMERIC 02 ws-mysql-base-name X(64) -00004 ALPHANUMERIC 02 ws-mysql-port-number X(4) -00064 ALPHANUMERIC 02 ws-mysql-socket X(64) -04096 ALPHANUMERIC 02 ws-mysql-command X(4096) - -00004 ALPHANUMERIC 01 ws-No-Paragraph 9(4) - - LOCAL-STORAGE SECTION - -00006 GROUP 01 subscripts -00002 NUMERIC 12 J S9(4) COMP-5 -00002 NUMERIC 12 K S9(4) COMP-5 -00002 NUMERIC 12 L S9(4) COMP-5 - - SCREEN SECTION - -00078 GROUP 01 Display-Message-1 -00009 ALPHANUMERIC 03 FILLER X(9) -00069 ALPHANUMERIC 03 FILLER X(69) - -00318 GROUP 01 Display-Message-2 -00018 ALPHANUMERIC 03 FILLER X(18) -00004 ALPHANUMERIC 03 FILLER X(4) -00006 ALPHANUMERIC 03 FILLER X(6) -00003 ALPHANUMERIC 03 FILLER 9(3) -00009 ALPHANUMERIC 03 FILLER X(9) -00199 ALPHANUMERIC 03 FILLER X(199) -00012 ALPHANUMERIC 03 FILLER X(12) -00067 ALPHANUMERIC 03 FILLER X(67) - - -0 warnings in compilation group -0 errors in compilation group -]) - -[AT_CHECK([gcdiff -IGnuCOBOL prog17-32.lst prog.lst], [0], [], [])] - -, - -# Previous test "passed" --> 64 bit - -AT_DATA([prog17-64.lst], -[GnuCOBOL V.R.P prog.cob DDD MMM dd HH:MM:SS YYYY - -LINE PG/LN A...B............................................................ - -000001 -000002 IDENTIFICATION DIVISION. -000003 PROGRAM-ID. prog. -000004 DATA DIVISION. -000005 WORKING-STORAGE SECTION. -000006 77 WS-Where pic x(512). -000007 -000008 01 ws-mysql. -000009 02 ws-mysql-cid usage pointer. -000010 02 ws-mysql-result usage pointer. -000011 02 ws-mysql-result-2 usage pointer. -000012 02 ws-mysql-result-3 usage pointer. -000013 02 ws-mysql-count-rows pic s9(9) comp. -000014 02 ws-mysql-error-number pic x(4). -000015 02 ws-mysql-error-message pic x(80). -000016 02 ws-mysql-host-name pic x(64). -000017 02 ws-mysql-implementation pic x(64). -000018 02 ws-mysql-password pic x(64). -000019 02 ws-mysql-base-name pic x(64). -000020 02 ws-mysql-port-number pic x(4). -000021 02 ws-mysql-socket pic x(64). -000022 02 ws-mysql-command pic x(4096). -000023 -000024 01 ws-No-Paragraph pic 9(4). -000025 local-storage section. -000026 01 subscripts usage comp-5. -000027 12 J pic s9(4). -000028 12 K pic s9(4). -000029 12 L pic s9(4). -000030 -000031 SCREEN SECTION. -000032 01 Display-Message-1 foreground-color 2. -000033 03 value "WS-Where=" line 23 col 1. -000034 03 from WS-Where (1:J) pic x(69) col 10. -000035 01 Display-Message-2 foreground-color 2. -000036 03 value "ST004 SQL Err No.=" line 4 col 1. -000037 03 using ws-mysql-error-number pic x(4) col 19. -000038 03 value " Para=" col 23. -000039 03 using WS-No-Paragraph pic 9(3) col 29. -000040 03 value " SQL Cmd=" col 32. -000041 03 using ws-mysql-command pic x(199) col 41. -000042 03 value "SQL Err Msg=" line 7 col 1. -000043 03 using ws-mysql-error-message pic x(67) col 13. -000044 PROCEDURE DIVISION. -000045 STOP RUN. - -SIZE TYPE LVL NAME PICTURE - - WORKING-STORAGE SECTION - -00512 ALPHANUMERIC 77 WS-Where X(512) - -04540 GROUP 01 ws-mysql -00008 POINTER 02 ws-mysql-cid -00008 POINTER 02 ws-mysql-result -00008 POINTER 02 ws-mysql-result-2 -00008 POINTER 02 ws-mysql-result-3 -00004 NUMERIC 02 ws-mysql-count-rows S9(9) COMP -00004 ALPHANUMERIC 02 ws-mysql-error-number X(4) -00080 ALPHANUMERIC 02 ws-mysql-error-message X(80) -00064 ALPHANUMERIC 02 ws-mysql-host-name X(64) -00064 ALPHANUMERIC 02 ws-mysql-implementation X(64) -00064 ALPHANUMERIC 02 ws-mysql-password X(64) -00064 ALPHANUMERIC 02 ws-mysql-base-name X(64) -00004 ALPHANUMERIC 02 ws-mysql-port-number X(4) -00064 ALPHANUMERIC 02 ws-mysql-socket X(64) -04096 ALPHANUMERIC 02 ws-mysql-command X(4096) - -00004 ALPHANUMERIC 01 ws-No-Paragraph 9(4) - - LOCAL-STORAGE SECTION - -00006 GROUP 01 subscripts -00002 NUMERIC 12 J S9(4) COMP-5 -00002 NUMERIC 12 K S9(4) COMP-5 -00002 NUMERIC 12 L S9(4) COMP-5 - - SCREEN SECTION - -00078 GROUP 01 Display-Message-1 -00009 ALPHANUMERIC 03 FILLER X(9) -00069 ALPHANUMERIC 03 FILLER X(69) - -00318 GROUP 01 Display-Message-2 -00018 ALPHANUMERIC 03 FILLER X(18) -00004 ALPHANUMERIC 03 FILLER X(4) -00006 ALPHANUMERIC 03 FILLER X(6) -00003 ALPHANUMERIC 03 FILLER 9(3) -00009 ALPHANUMERIC 03 FILLER X(9) -00199 ALPHANUMERIC 03 FILLER X(199) -00012 ALPHANUMERIC 03 FILLER X(12) -00067 ALPHANUMERIC 03 FILLER X(67) - - -0 warnings in compilation group -0 errors in compilation group -]) - -[AT_CHECK([gcdiff -IGnuCOBOL prog17-64.lst prog.lst], [0], [], [])] - -) - - -AT_CLEANUP - - -AT_SETUP([Symbols: multiple programs/functions]) -AT_KEYWORDS([listing program function]) - -AT_CAPTURE_FILE([prog.lst]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - FUNCTION-ID. WITHPAR. - DATA DIVISION. - LINKAGE SECTION. - 01 PAR-IN PIC 9. - 01 PAR-OUT PIC 9. - PROCEDURE DIVISION USING PAR-IN RETURNING PAR-OUT. - ADD 1 TO PAR-IN GIVING PAR-OUT END-ADD. - GOBACK. - END FUNCTION WITHPAR. - - IDENTIFICATION DIVISION. - FUNCTION-ID. WITHOUTPAR. - DATA DIVISION. - LINKAGE SECTION. - 01 PAR PIC 9. - PROCEDURE DIVISION RETURNING PAR. - MOVE 1 TO PAR. - GOBACK. - END FUNCTION WITHOUTPAR. - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - CONFIGURATION SECTION. - REPOSITORY. - FUNCTION WITHPAR - FUNCTION WITHOUTPAR. - PROCEDURE DIVISION. - IF WITHPAR(1) NOT = 2 - DISPLAY WITHPAR(1) - END-DISPLAY - END-IF. - IF WITHOUTPAR NOT = 1 - DISPLAY WITHOUTPAR - END-DISPLAY - END-IF. - STOP RUN. - END PROGRAM prog. -]) - -AT_CHECK([$COMPILE_ONLY -t prog.lst -tsymbols prog.cob], [0], [], []) - -AT_DATA([prog18.lst], -[GnuCOBOL V.R.P prog.cob DDD MMM dd HH:MM:SS YYYY Page 0001 - -LINE PG/LN A...B............................................................ - -000001 -000002 IDENTIFICATION DIVISION. -000003 FUNCTION-ID. WITHPAR. -000004 DATA DIVISION. -000005 LINKAGE SECTION. -000006 01 PAR-IN PIC 9. -000007 01 PAR-OUT PIC 9. -000008 PROCEDURE DIVISION USING PAR-IN RETURNING PAR-OUT. -000009 ADD 1 TO PAR-IN GIVING PAR-OUT END-ADD. -000010 GOBACK. -000011 END FUNCTION WITHPAR. -000012 -000013 IDENTIFICATION DIVISION. -000014 FUNCTION-ID. WITHOUTPAR. -000015 DATA DIVISION. -000016 LINKAGE SECTION. -000017 01 PAR PIC 9. -000018 PROCEDURE DIVISION RETURNING PAR. -000019 MOVE 1 TO PAR. -000020 GOBACK. -000021 END FUNCTION WITHOUTPAR. -000022 -000023 IDENTIFICATION DIVISION. -000024 PROGRAM-ID. prog. -000025 ENVIRONMENT DIVISION. -000026 CONFIGURATION SECTION. -000027 REPOSITORY. -000028 FUNCTION WITHPAR -000029 FUNCTION WITHOUTPAR. -000030 PROCEDURE DIVISION. -000031 IF WITHPAR(1) NOT = 2 -000032 DISPLAY WITHPAR(1) -000033 END-DISPLAY -000034 END-IF. -000035 IF WITHOUTPAR NOT = 1 -000036 DISPLAY WITHOUTPAR -000037 END-DISPLAY -000038 END-IF. -000039 STOP RUN. -000040 END PROGRAM prog. - GnuCOBOL V.R.P prog.cob DDD MMM dd HH:MM:SS YYYY Page 0002 - -SIZE TYPE LVL NAME PICTURE - - FUNCTION WITHPAR - - LINKAGE SECTION - -00001 NUMERIC 01 PAR-IN 9 - -00001 NUMERIC 01 PAR-OUT 9 - - FUNCTION WITHOUTPAR - - LINKAGE SECTION - -00001 NUMERIC 01 PAR 9 - - PROGRAM prog - - No fields defined. - - -0 warnings in compilation group -0 errors in compilation group -]) - -AT_CHECK([gcdiff -IGnuCOBOL prog18.lst prog.lst], [0], [], []) - -AT_CLEANUP - - -AT_SETUP([Symbols: OCCURS/REDEFINES]) -AT_KEYWORDS([listing]) - -AT_CAPTURE_FILE([prog.lst]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - CONFIGURATION SECTION. - DATA DIVISION. - WORKING-STORAGE SECTION. - 78 I VALUE 20. - 78 J VALUE 5000. - 78 M VALUE 5. - 01 SETUP-REC. - 05 FL1 PIC X(04). - 05 FL2 PIC ZZZZZ. - 05 FL3 PIC 9(04). - 05 FL4 PIC 9(08) COMP. - 05 FL5 PIC 9(04) COMP-4. - 05 FL6 PIC Z,ZZZ.99. - 05 FL7 PIC S9(05) SIGN LEADING SEPARATE. - 05 FL8 PIC X(04). - 05 FL9 REDEFINES FL8 PIC 9(04). - 05 FLA. - 10 FLB OCCURS I TIMES. - 15 FLC PIC X(02). - 10 FLD PIC X(20). - 05 FLD1 PIC X(100). - 05 FLD2 OCCURS M TO J TIMES DEPENDING ON FL5. - 10 FILLER PIC X(01). - 05 FLD3 PIC X(3). - 05 FLD4 PIC X(4). - PROCEDURE DIVISION. - STOP RUN. -]) - -AT_CHECK([$COMPILE_ONLY -fcomplex-odo -t prog.lst -tsymbols prog.cob], [0], [], []) - -AT_DATA([prog19.lst], -[GnuCOBOL V.R.P prog.cob DDD MMM dd HH:MM:SS YYYY Page 0001 - -LINE PG/LN A...B............................................................ - -000001 -000002 IDENTIFICATION DIVISION. -000003 PROGRAM-ID. prog. -000004 ENVIRONMENT DIVISION. -000005 CONFIGURATION SECTION. -000006 DATA DIVISION. -000007 WORKING-STORAGE SECTION. -000008 78 I VALUE 20. -000009 78 J VALUE 5000. -000010 78 M VALUE 5. -000011 01 SETUP-REC. -000012 05 FL1 PIC X(04). -000013 05 FL2 PIC ZZZZZ. -000014 05 FL3 PIC 9(04). -000015 05 FL4 PIC 9(08) COMP. -000016 05 FL5 PIC 9(04) COMP-4. -000017 05 FL6 PIC Z,ZZZ.99. -000018 05 FL7 PIC S9(05) SIGN LEADING SEPARATE. -000019 05 FL8 PIC X(04). -000020 05 FL9 REDEFINES FL8 PIC 9(04). -000021 05 FLA. -000022 10 FLB OCCURS I TIMES. -000023 15 FLC PIC X(02). -000024 10 FLD PIC X(20). -000025 05 FLD1 PIC X(100). -000026 05 FLD2 OCCURS M TO J TIMES DEPENDING ON FL5. -000027 10 FILLER PIC X(01). -000028 05 FLD3 PIC X(3). -000029 05 FLD4 PIC X(4). -000030 PROCEDURE DIVISION. -000031 STOP RUN. - GnuCOBOL V.R.P prog.cob DDD MMM dd HH:MM:SS YYYY Page 0002 - -SIZE TYPE LVL NAME PICTURE - - WORKING-STORAGE SECTION - -05204 GROUP 01 SETUP-REC -00004 ALPHANUMERIC 05 FL1 X(04) -00005 ALPHANUMERIC 05 FL2 ZZZZZ -00004 ALPHANUMERIC 05 FL3 9(04) -00004 NUMERIC 05 FL4 9(08) COMP -00002 NUMERIC 05 FL5 9(04) COMP -00008 ALPHANUMERIC 05 FL6 Z,ZZZ.99 -00006 ALPHANUMERIC 05 FL7 S9(05) -00004 ALPHANUMERIC 05 FL8 X(04) -00004 ALPHANUMERIC 05 FL9 9(04), REDEFINES FL8 -00060 GROUP 05 FLA -00040 GROUP 10 FLB OCCURS 20 -00002 ALPHANUMERIC 15 FLC X(02) -00020 ALPHANUMERIC 10 FLD X(20) -00100 ALPHANUMERIC 05 FLD1 X(100) -05000 GROUP 05 FLD2 OCCURS 5 TO 5000 -00001 ALPHANUMERIC 10 FILLER X(01) -00003 ALPHANUMERIC 05 FLD3 X(3) -00004 ALPHANUMERIC 05 FLD4 X(4) - - -0 warnings in compilation group -0 errors in compilation group -]) - -AT_CHECK([gcdiff -IGnuCOBOL prog19.lst prog.lst], [0], [], []) - -AT_CLEANUP - - -AT_SETUP([Conditional compilation]) -AT_KEYWORDS([listing]) - -AT_CAPTURE_FILE([prog.lst]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - PROCEDURE DIVISION. - >>IF ACTIVATE DEFINED - DISPLAY "NOTOK" NO ADVANCING - END-DISPLAY - >>ELIF ACTIVATE2 DEFINED - DISPLAY "OK" NO ADVANCING - END-DISPLAY - >>ELSE - DISPLAY "NOTOK" NO ADVANCING - END-DISPLAY - >>END-IF - STOP RUN. -]) - -AT_CHECK([$COMPILE_ONLY -DACTIVATE2 -t prog.lst prog.cob], [0], [], []) - -AT_DATA([prog16.lst], -[GnuCOBOL V.R.P prog.cob DDD MMM dd HH:MM:SS YYYY Page 0001 - -LINE PG/LN A...B............................................................ - -000001 -000002 IDENTIFICATION DIVISION. -000003 PROGRAM-ID. prog. -000004 DATA DIVISION. -000005 WORKING-STORAGE SECTION. -000006 PROCEDURE DIVISION. -000007 >>IF ACTIVATE DEFINED -000008X DISPLAY "NOTOK" NO ADVANCING -000009X END-DISPLAY -000010 >>ELIF ACTIVATE2 DEFINED -000011 DISPLAY "OK" NO ADVANCING -000012 END-DISPLAY -000013 >>ELSE -000014X DISPLAY "NOTOK" NO ADVANCING -000015X END-DISPLAY -000016 >>END-IF -000017 STOP RUN. - - -0 warnings in compilation group -0 errors in compilation group -]) - -AT_CHECK([gcdiff -IGnuCOBOL prog16.lst prog.lst], [0], [], []) - -AT_CLEANUP - - -AT_SETUP([File descriptions]) -AT_KEYWORDS([listing]) - -AT_CAPTURE_FILE([prog.lst]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - INPUT-OUTPUT SECTION. - FILE-CONTROL. - SELECT OLD-VERSION ASSIGN TO "SYSUT1" - ORGANIZATION LINE SEQUENTIAL. - SELECT NEW-VERSION ASSIGN TO "SYSUT2" - ORGANIZATION LINE SEQUENTIAL. - SELECT PRT-VERSION ASSIGN TO "SYSUT2" - ORGANIZATION LINE SEQUENTIAL. - SELECT MODIFICATION ASSIGN TO "SYSIN1" - ORGANIZATION LINE SEQUENTIAL. - SELECT COMMENTARY ASSIGN TO "SYSOU1" - ORGANIZATION LINE SEQUENTIAL. - DATA DIVISION. - FILE SECTION. - - FD OLD-VERSION - LABEL RECORDS ARE STANDARD - BLOCK CONTAINS 80 CHARACTERS - DATA RECORD IS OLD-RECORD. - - 01 OLD-RECORD. - 02 OLD-STATEMENT PICTURE X(75). - 02 OLD-NUMBER PICTURE X(5). - - FD NEW-VERSION - LABEL RECORDS ARE STANDARD - BLOCK CONTAINS 80 CHARACTERS - DATA RECORD IS NEW-RECORD. - - 01 NEW-RECORD. - 02 NEW-STATEMENT PICTURE X(75). - 02 NEW-NUMBER PICTURE X(5). - - FD MODIFICATION - LABEL RECORDS ARE OMITTED - BLOCK CONTAINS 80 CHARACTERS - DATA RECORD IS UPDATE-ORDER. - - 01 UPDATE-ORDER. - 02 INSERTION. - 03 COMMAND PICTURE X(6). - 88 ENDJOB VALUE "ENDJOB". - 88 ENDSET VALUE "ENDSET". - 88 REMOVE VALUE "REMOVE". - 88 ADDNEW VALUE "INSERT". - 88 CHANGE VALUE "CHANGE". - 88 DISPLY VALUE "DISPLY". - 03 FILLER PICTURE X. - 03 A-FIELD PICTURE 9(5). - 03 A-ALPHA REDEFINES A-FIELD PICTURE X(5). - 88 A-BLANK VALUE SPACES. - 03 FILLER PICTURE X(4). - 03 B-FIELD PICTURE 9(5). - 03 B-ALPHA REDEFINES B-FIELD PICTURE X(5). - 88 B-BLANK VALUE SPACES. - 03 FILLER PICTURE X(54). - 02 FILLER PICTURE X(5). - - FD COMMENTARY - LABEL RECORDS ARE OMITTED - BLOCK CONTAINS 82 CHARACTERS - DATA RECORD IS COMMENT-LINE. - - 01 COMMENT-LINE. - 02 FILLER PICTURE X(82). - - WORKING-STORAGE SECTION. - - 01 HEADINGS-LINE. - 02 FILLER PICTURE X(15) VALUE "EDITOR VERSION". - 02 FILLER PICTURE X(20) VALUE "1.1 - 206/72". - 02 PHASE PICTURE X(17) VALUE "UPDATING AS OF". - 02 MONTH-RUN PICTURE XX. - 02 FILLER PICTURE X VALUE "/". - 02 DAY-RUN PICTURE XX. - 02 FILLER PICTURE X VALUE "/". - 02 YEAR-RUN PICTURE XX. - 02 FILLER PICTURE X(8) VALUE SPACES. - 02 FILLER PICTURE X(8) VALUE " PAGE: ". - 02 PAGE-NUMBER PICTURE 9(4) VALUE 0. - - 01 COMMAND-LISTING. - 02 FILLER PICTURE X(2) VALUE SPACES. - 02 COMMAND-IMAGE PICTURE X(80). - - 01 ACTIVITIES-LISTING. - 02 DISPOSITION PICTURE X(2). - 02 ACTIVE-IMAGE PICTURE X(80). - - 01 UPSI-BYTE. - 02 UPSI-BIT OCCURS 8 TIMES PICTURE X. - - 01 MESSAGE-LOG. - 02 FILLER PICTURE X(2) VALUE SPACES. - 02 MESSAGE-TEXT PICTURE X(80). - - 01 DISPLAY-MESSAGE. - 02 FILLER PICTURE X(2) VALUE SPACES. - 02 DISPLAY-TEMP PICTURE X(6). - 02 FILLER PICTURE X(2) VALUE SPACES. - 02 DISPLAY-TEXT PICTURE X(60). - - PROCEDURE DIVISION. - OPEN INPUT OLD-VERSION, MODIFICATION, - OUTPUT NEW-VERSION, COMMENTARY. - CLOSE OLD-VERSION, NEW-VERSION, MODIFICATION, COMMENTARY. - STOP RUN. -]) - -AT_CHECK([$COMPILE_ONLY -t prog.lst -tlines=0 -tsymbols prog.cob], [1], [], -[prog.cob:21: warning: LABEL RECORDS is obsolete in GnuCOBOL -prog.cob:23: warning: DATA RECORDS is obsolete in GnuCOBOL -prog.cob:30: warning: LABEL RECORDS is obsolete in GnuCOBOL -prog.cob:32: warning: DATA RECORDS is obsolete in GnuCOBOL -prog.cob:39: warning: LABEL RECORDS is obsolete in GnuCOBOL -prog.cob:41: warning: DATA RECORDS is obsolete in GnuCOBOL -prog.cob:64: warning: LABEL RECORDS is obsolete in GnuCOBOL -prog.cob:66: warning: DATA RECORDS is obsolete in GnuCOBOL -prog.cob:11: error: missing file description for FILE PRT-VERSION -]) - - -AT_DATA([prog18.lst], -[GnuCOBOL V.R.P prog.cob DDD MMM dd HH:MM:SS YYYY - -LINE PG/LN A...B............................................................ - -000001 -000002 IDENTIFICATION DIVISION. -000003 PROGRAM-ID. prog. -000004 ENVIRONMENT DIVISION. -000005 INPUT-OUTPUT SECTION. -000006 FILE-CONTROL. -000007 SELECT OLD-VERSION ASSIGN TO "SYSUT1" -000008 ORGANIZATION LINE SEQUENTIAL. -000009 SELECT NEW-VERSION ASSIGN TO "SYSUT2" -000010 ORGANIZATION LINE SEQUENTIAL. -000011 SELECT PRT-VERSION ASSIGN TO "SYSUT2" -error: missing file description for FILE PRT-VERSION -000012 ORGANIZATION LINE SEQUENTIAL. -000013 SELECT MODIFICATION ASSIGN TO "SYSIN1" -000014 ORGANIZATION LINE SEQUENTIAL. -000015 SELECT COMMENTARY ASSIGN TO "SYSOU1" -000016 ORGANIZATION LINE SEQUENTIAL. -000017 DATA DIVISION. -000018 FILE SECTION. -000019 -000020 FD OLD-VERSION -000021 LABEL RECORDS ARE STANDARD -warning: LABEL RECORDS is obsolete in GnuCOBOL -000022 BLOCK CONTAINS 80 CHARACTERS -000023 DATA RECORD IS OLD-RECORD. -warning: DATA RECORDS is obsolete in GnuCOBOL -000024 -000025 01 OLD-RECORD. -000026 02 OLD-STATEMENT PICTURE X(75). -000027 02 OLD-NUMBER PICTURE X(5). -000028 -000029 FD NEW-VERSION -000030 LABEL RECORDS ARE STANDARD -warning: LABEL RECORDS is obsolete in GnuCOBOL -000031 BLOCK CONTAINS 80 CHARACTERS -000032 DATA RECORD IS NEW-RECORD. -warning: DATA RECORDS is obsolete in GnuCOBOL -000033 -000034 01 NEW-RECORD. -000035 02 NEW-STATEMENT PICTURE X(75). -000036 02 NEW-NUMBER PICTURE X(5). -000037 -000038 FD MODIFICATION -000039 LABEL RECORDS ARE OMITTED -warning: LABEL RECORDS is obsolete in GnuCOBOL -000040 BLOCK CONTAINS 80 CHARACTERS -000041 DATA RECORD IS UPDATE-ORDER. -warning: DATA RECORDS is obsolete in GnuCOBOL -000042 -000043 01 UPDATE-ORDER. -000044 02 INSERTION. -000045 03 COMMAND PICTURE X(6). -000046 88 ENDJOB VALUE "ENDJOB". -000047 88 ENDSET VALUE "ENDSET". -000048 88 REMOVE VALUE "REMOVE". -000049 88 ADDNEW VALUE "INSERT". -000050 88 CHANGE VALUE "CHANGE". -000051 88 DISPLY VALUE "DISPLY". -000052 03 FILLER PICTURE X. -000053 03 A-FIELD PICTURE 9(5). -000054 03 A-ALPHA REDEFINES A-FIELD PICTURE X(5). -000055 88 A-BLANK VALUE SPACES. -000056 03 FILLER PICTURE X(4). -000057 03 B-FIELD PICTURE 9(5). -000058 03 B-ALPHA REDEFINES B-FIELD PICTURE X(5). -000059 88 B-BLANK VALUE SPACES. -000060 03 FILLER PICTURE X(54). -000061 02 FILLER PICTURE X(5). -000062 -000063 FD COMMENTARY -000064 LABEL RECORDS ARE OMITTED -warning: LABEL RECORDS is obsolete in GnuCOBOL -000065 BLOCK CONTAINS 82 CHARACTERS -000066 DATA RECORD IS COMMENT-LINE. -warning: DATA RECORDS is obsolete in GnuCOBOL -000067 -000068 01 COMMENT-LINE. -000069 02 FILLER PICTURE X(82). -000070 -000071 WORKING-STORAGE SECTION. -000072 -000073 01 HEADINGS-LINE. -000074 02 FILLER PICTURE X(15) VALUE "EDITOR VERSION". -000075 02 FILLER PICTURE X(20) VALUE "1.1 - 206/72". -000076 02 PHASE PICTURE X(17) VALUE "UPDATING AS OF". -000077 02 MONTH-RUN PICTURE XX. -000078 02 FILLER PICTURE X VALUE "/". -000079 02 DAY-RUN PICTURE XX. -000080 02 FILLER PICTURE X VALUE "/". -000081 02 YEAR-RUN PICTURE XX. -000082 02 FILLER PICTURE X(8) VALUE SPACES. -000083 02 FILLER PICTURE X(8) VALUE " PAGE: ". -000084 02 PAGE-NUMBER PICTURE 9(4) VALUE 0. -000085 -000086 01 COMMAND-LISTING. -000087 02 FILLER PICTURE X(2) VALUE SPACES. -000088 02 COMMAND-IMAGE PICTURE X(80). -000089 -000090 01 ACTIVITIES-LISTING. -000091 02 DISPOSITION PICTURE X(2). -000092 02 ACTIVE-IMAGE PICTURE X(80). -000093 -000094 01 UPSI-BYTE. -000095 02 UPSI-BIT OCCURS 8 TIMES PICTURE X. -000096 -000097 01 MESSAGE-LOG. -000098 02 FILLER PICTURE X(2) VALUE SPACES. -000099 02 MESSAGE-TEXT PICTURE X(80). -000100 -000101 01 DISPLAY-MESSAGE. -000102 02 FILLER PICTURE X(2) VALUE SPACES. -000103 02 DISPLAY-TEMP PICTURE X(6). -000104 02 FILLER PICTURE X(2) VALUE SPACES. -000105 02 DISPLAY-TEXT PICTURE X(60). -000106 -000107 PROCEDURE DIVISION. -000108 OPEN INPUT OLD-VERSION, MODIFICATION, -000109 OUTPUT NEW-VERSION, COMMENTARY. -000110 CLOSE OLD-VERSION, NEW-VERSION, MODIFICATION, COMMENTARY. -000111 STOP RUN. - -SIZE TYPE LVL NAME PICTURE - -00080 FILE OLD-VERSION -00080 GROUP 01 OLD-RECORD -00075 ALPHANUMERIC 02 OLD-STATEMENT X(75) -00005 ALPHANUMERIC 02 OLD-NUMBER X(5) - -00080 FILE NEW-VERSION -00080 GROUP 01 NEW-RECORD -00075 ALPHANUMERIC 02 NEW-STATEMENT X(75) -00005 ALPHANUMERIC 02 NEW-NUMBER X(5) - -00032 FILE PRT-VERSION - -00080 FILE MODIFICATION -00080 GROUP 01 UPDATE-ORDER -00075 GROUP 02 INSERTION -00006 ALPHANUMERIC 03 COMMAND X(6) - CONDITIONAL 88 ENDJOB - CONDITIONAL 88 ENDSET - CONDITIONAL 88 REMOVE - CONDITIONAL 88 ADDNEW - CONDITIONAL 88 CHANGE - CONDITIONAL 88 DISPLY -00001 ALPHANUMERIC 03 FILLER X -00005 ALPHANUMERIC 03 A-FIELD 9(5) -00005 ALPHANUMERIC 03 A-ALPHA X(5), REDEFINES A-FIELD - CONDITIONAL 88 A-BLANK -00004 ALPHANUMERIC 03 FILLER X(4) -00005 ALPHANUMERIC 03 B-FIELD 9(5) -00005 ALPHANUMERIC 03 B-ALPHA X(5), REDEFINES B-FIELD - CONDITIONAL 88 B-BLANK -00054 ALPHANUMERIC 03 FILLER X(54) -00005 ALPHANUMERIC 02 FILLER X(5) - -00082 FILE COMMENTARY -00082 GROUP 01 COMMENT-LINE -00082 ALPHANUMERIC 02 FILLER X(82) - - WORKING-STORAGE SECTION - -00080 GROUP 01 HEADINGS-LINE -00015 ALPHANUMERIC 02 FILLER X(15) -00020 ALPHANUMERIC 02 FILLER X(20) -00017 ALPHANUMERIC 02 PHASE X(17) -00002 ALPHANUMERIC 02 MONTH-RUN XX -00001 ALPHANUMERIC 02 FILLER X -00002 ALPHANUMERIC 02 DAY-RUN XX -00001 ALPHANUMERIC 02 FILLER X -00002 ALPHANUMERIC 02 YEAR-RUN XX -00008 ALPHANUMERIC 02 FILLER X(8) -00008 ALPHANUMERIC 02 FILLER X(8) -00004 NUMERIC 02 PAGE-NUMBER 9(4) - -00082 GROUP 01 COMMAND-LISTING -00002 ALPHANUMERIC 02 FILLER X(2) -00080 ALPHANUMERIC 02 COMMAND-IMAGE X(80) - -00082 GROUP 01 ACTIVITIES-LISTING -00002 ALPHANUMERIC 02 DISPOSITION X(2) -00080 ALPHANUMERIC 02 ACTIVE-IMAGE X(80) - -00008 GROUP 01 UPSI-BYTE -00001 ALPHANUMERIC 02 UPSI-BIT X, OCCURS 8 - -00082 GROUP 01 MESSAGE-LOG -00002 ALPHANUMERIC 02 FILLER X(2) -00080 ALPHANUMERIC 02 MESSAGE-TEXT X(80) - -00070 GROUP 01 DISPLAY-MESSAGE -00002 ALPHANUMERIC 02 FILLER X(2) -00006 ALPHANUMERIC 02 DISPLAY-TEMP X(6) -00002 ALPHANUMERIC 02 FILLER X(2) -00060 ALPHANUMERIC 02 DISPLAY-TEXT X(60) - - - -Error/Warning summary: - -prog.cob:21: warning: LABEL RECORDS is obsolete in GnuCOBOL -prog.cob:23: warning: DATA RECORDS is obsolete in GnuCOBOL -prog.cob:30: warning: LABEL RECORDS is obsolete in GnuCOBOL -prog.cob:32: warning: DATA RECORDS is obsolete in GnuCOBOL -prog.cob:39: warning: LABEL RECORDS is obsolete in GnuCOBOL -prog.cob:41: warning: DATA RECORDS is obsolete in GnuCOBOL -prog.cob:64: warning: LABEL RECORDS is obsolete in GnuCOBOL -prog.cob:66: warning: DATA RECORDS is obsolete in GnuCOBOL -prog.cob:11: error: missing file description for FILE PRT-VERSION - -8 warnings in compilation group -1 error in compilation group -]) - -AT_CHECK([gcdiff -IGnuCOBOL prog18.lst prog.lst], [0], [], []) - -AT_CLEANUP - - -AT_SETUP([Invalid PICTURE strings]) -AT_KEYWORDS([listing]) - -AT_CAPTURE_FILE([prog.lst]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 empty-pic PIC. - 01 too-long-pic PIC XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX - -XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX. - 01 too-long-pic2 PIC XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX - -XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX - -XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX - -XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX - -XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX. - 01 multiple-symbols. - 03 PIC 9CRCR. - 03 PIC 9DBDB. - 03 PIC SS99S. - 03 PIC 99..9. - 03 PIC 99VV9. - 03 PIC +$99+. - 03 PIC $+99$-. - 01 non-symbols. - 03 PIC 9K. - 03 PIC 999C. - 03 PIC 999D. - 01 too-many-digits PIC 9(50). - 01 too-long-number-in-parens PIC 9(11111111111111). - 01 nested-parens PIC 9((100)). - 01 unbalanced-parens PIC 9(. - 01 multiple-pairs-of-parens PIC 9(5)(3). - 01 no-digit-in-parens PIC 9(). - 01 mutually-exclusive-symbols. - 03 PIC P(3)9.9. - 03 PIC 9V.9. - 03 PIC Z*. - 03 PIC +(5)--. - 03 PIC $(4)Z(9). - 03 PIC $$B*(4). - 03 PIC NX. - 03 PIC AN. - 03 PIC AZ(3). - 03 PIC 99.99XXXXX. - 03 PIC SA. - 03 PIC $$$B+++B---. - 03 PIC +++9+. - 03 PIC +9(5)CR. - 03 PIC -9(5)DB. - 01 non-rightmost-leftmost-symbols. - 03 PIC BBB+BB99. - 03 PIC 99-B. - 03 PIC 9CRB. - 03 PIC DB9(5). - 03 PIC 99$$$. - 03 PIC 99$B. - 03 PIC 0$99. - 03 PIC PPPVP9. - 01 missing-symbols. - 03 PIC B(5). - 03 PIC +. - 03 PIC $. - - 01 str-constant CONSTANT "hello". - 01 float-constant CONSTANT 1.0. - 01 signed-constant CONSTANT -1. - 01 invalid-constant. - 03 PIC X(str-constant). - 03 PIC X(float-constant). - 03 PIC X(signed-constant). - 03 PIC X(unseen-constant). - - 01 integer-constant CONSTANT 5. - 01 valid-pics. - 03 PIC VP9B. - 03 PIC B9P(3). - 03 PIC B$$$. - 03 PIC 0000+B0+++0B,+. - 03 PIC +(5)P(3). - 03 PIC ++.++. - 03 PIC $(integer-constant). - 03 PIC $$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$ - -(integer-constant). *> CHECKME: should this be really valid? - - - 01 PC-COLOR-BACKGROUND-TABLE. - 05 BIT-BACKGROUND-BLACK PIC 1(8) BIT VALUE B"00000000". - 05 BIT-BACKGROUND-BLUE PIC 1(8) BIT VALUE B"00010000". - 05 BIT-BACKGROUND-GREEN PIC 1(8) BIT VALUE B"00100000". - 05 BIT-BACKGROUND-CYAN PIC 1(8) BIT VALUE B"00110000". - 05 BIT-BACKGROUND-RED PIC 1(8) BIT VALUE B"01000000". - 05 BIT-BACKGROUND-MAGENTA PIC 1(8) BIT VALUE B"01010000". - 05 BIT-BACKGROUND-BROWN PIC 1(8) BIT VALUE B"01100000". - 05 BIT-BACKGROUND-LIGHT-GRAY PIC 1(8) BIT VALUE B"01110000". - 01 FILLER REDEFINES PC-COLOR-BACKGROUND-TABLE. - 05 COLOR-BACKGROUND - OCCURS 8 TIMES PIC 1(8) BIT. -]) - -AT_CHECK([$COMPILE_ONLY -t prog.lst -tlines=0 -tsymbols -Wno-pending -Wno-unfinished -fword-continuation=ok prog.cob], [1], [], -[prog.cob:7: error: missing PICTURE string -prog.cob:10: error: PICTURE string may not contain more than 255 characters; contains 301 characters -prog.cob:16: error: CR or DB may only occur once in a PICTURE string -prog.cob:17: error: CR or DB may only occur once in a PICTURE string -prog.cob:18: error: S may only occur once in a PICTURE string -prog.cob:18: error: S must be at start of PICTURE string -prog.cob:19: error: . may only occur once in a PICTURE string -prog.cob:20: error: V may only occur once in a PICTURE string -prog.cob:21: error: a trailing +/- sign cannot follow a leading +/- sign -prog.cob:22: error: a leading +/- sign cannot follow a leading currency symbol -prog.cob:22: error: a trailing currency symbol cannot follow a leading currency symbol -prog.cob:22: error: a trailing +/- sign cannot follow a leading +/- sign -prog.cob:24: error: invalid PICTURE character 'K' -prog.cob:25: error: C must be followed by R -prog.cob:26: error: D must be followed by B -prog.cob:27: error: numeric field cannot be larger than 38 digits -prog.cob:28: error: only up to 9 significant digits are permitted within parentheses -prog.cob:29: error: parentheses must be preceded by a picture symbol -prog.cob:30: error: unbalanced parentheses -prog.cob:31: error: parentheses must be preceded by a picture symbol -prog.cob:32: error: parentheses must contain an unsigned integer -prog.cob:34: error: . cannot follow a P which is after the decimal point -prog.cob:35: error: . cannot follow V -prog.cob:36: error: cannot have both Z and * in PICTURE string -prog.cob:37: error: a trailing +/- sign cannot follow a floating +/- string which is before the decimal point -prog.cob:37: error: a trailing +/- sign may only occur once in a PICTURE string -prog.cob:38: error: a Z or * which is before the decimal point cannot follow a floating currency symbol string which is before the decimal point -prog.cob:39: error: a Z or * which is before the decimal point cannot follow a floating currency symbol string which is before the decimal point -prog.cob:40: error: A or X cannot follow N -prog.cob:41: error: N cannot follow A or X -prog.cob:42: error: a Z or * which is before the decimal point cannot follow A or X -prog.cob:43: error: A or X cannot follow . -prog.cob:44: error: A or X cannot follow S -prog.cob:45: error: a leading +/- sign cannot follow B, 0 or / -prog.cob:45: error: a leading +/- sign cannot follow a floating currency symbol string which is before the decimal point -prog.cob:45: error: a leading +/- sign may only occur once in a PICTURE string -prog.cob:45: error: a trailing +/- sign cannot follow a leading +/- sign -prog.cob:45: error: a trailing +/- sign may only occur once in a PICTURE string -prog.cob:46: error: a trailing +/- sign cannot follow a floating +/- string which is before the decimal point -prog.cob:47: error: CR or DB cannot follow a leading +/- sign -prog.cob:48: error: CR or DB cannot follow a leading +/- sign -prog.cob:50: error: a leading +/- sign cannot follow B, 0 or / -prog.cob:51: error: a leading +/- sign cannot follow 9 -prog.cob:52: error: B, 0 or / cannot follow CR or DB -prog.cob:53: error: 9 cannot follow CR or DB -prog.cob:54: error: a floating currency symbol string which is before the decimal point cannot follow 9 -prog.cob:55: error: a leading currency symbol cannot follow 9 -prog.cob:56: error: a leading currency symbol cannot follow B, 0 or / -prog.cob:57: error: P must be at start or end of PICTURE string -prog.cob:57: error: V cannot follow a P which is after the decimal point -prog.cob:59: error: PICTURE string must contain at least one of the set A, N, X, Z, 1, 9 and *; or at least two of the set +, - and the currency symbol -prog.cob:60: error: PICTURE string must contain at least one of the set A, N, X, Z, 1, 9 and *; or at least two of the set +, - and the currency symbol -prog.cob:61: error: PICTURE string must contain at least one of the set A, N, X, Z, 1, 9 and *; or at least two of the set +, - and the currency symbol -prog.cob:67: error: 'STR-CONSTANT' is not a numeric literal -prog.cob:68: error: 'FLOAT-CONSTANT' is not an integer -prog.cob:69: error: 'SIGNED-CONSTANT' is not unsigned -prog.cob:70: error: 'UNSEEN-CONSTANT' is not defined -prog.cob:81: warning: uncommon parentheses -]) - -AT_DATA([prog19.lst], -[GnuCOBOL V.R.P prog.cob DDD MMM dd HH:MM:SS YYYY - -LINE PG/LN A...B............................................................ - -000001 -000002 IDENTIFICATION DIVISION. -000003 PROGRAM-ID. prog. -000004 -000005 DATA DIVISION. -000006 WORKING-STORAGE SECTION. -000007 01 empty-pic PIC. -error: missing PICTURE string -000008 01 too-long-pic PIC XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX -000009 -XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX. -000010 01 too-long-pic2 PIC XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX -error: PICTURE string may not contain more than 255 characters; contains 301 - + characters -000011 -XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX -000012 -XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX -000013 -XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX -000014 -XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX. -000015 01 multiple-symbols. -000016 03 PIC 9CRCR. -error: CR or DB may only occur once in a PICTURE string -000017 03 PIC 9DBDB. -error: CR or DB may only occur once in a PICTURE string -000018 03 PIC SS99S. -error: S may only occur once in a PICTURE string -error: S must be at start of PICTURE string -000019 03 PIC 99..9. -error: . may only occur once in a PICTURE string -000020 03 PIC 99VV9. -error: V may only occur once in a PICTURE string -000021 03 PIC +$99+. -error: a trailing +/- sign cannot follow a leading +/- sign -000022 03 PIC $+99$-. -error: a leading +/- sign cannot follow a leading currency symbol -error: a trailing currency symbol cannot follow a leading currency symbol -error: a trailing +/- sign cannot follow a leading +/- sign -000023 01 non-symbols. -000024 03 PIC 9K. -error: invalid PICTURE character 'K' -000025 03 PIC 999C. -error: C must be followed by R -000026 03 PIC 999D. -error: D must be followed by B -000027 01 too-many-digits PIC 9(50). -error: numeric field cannot be larger than 38 digits -000028 01 too-long-number-in-parens PIC 9(11111111111111). -error: only up to 9 significant digits are permitted within parentheses -000029 01 nested-parens PIC 9((100)). -error: parentheses must be preceded by a picture symbol -000030 01 unbalanced-parens PIC 9(. -error: unbalanced parentheses -000031 01 multiple-pairs-of-parens PIC 9(5)(3). -error: parentheses must be preceded by a picture symbol -000032 01 no-digit-in-parens PIC 9(). -error: parentheses must contain an unsigned integer -000033 01 mutually-exclusive-symbols. -000034 03 PIC P(3)9.9. -error: . cannot follow a P which is after the decimal point -000035 03 PIC 9V.9. -error: . cannot follow V -000036 03 PIC Z*. -error: cannot have both Z and * in PICTURE string -000037 03 PIC +(5)--. -error: a trailing +/- sign cannot follow a floating +/- string which is before - + the decimal point -error: a trailing +/- sign may only occur once in a PICTURE string -000038 03 PIC $(4)Z(9). -error: a Z or * which is before the decimal point cannot follow a floating - + currency symbol string which is before the decimal point -000039 03 PIC $$B*(4). -error: a Z or * which is before the decimal point cannot follow a floating - + currency symbol string which is before the decimal point -000040 03 PIC NX. -error: A or X cannot follow N -000041 03 PIC AN. -error: N cannot follow A or X -000042 03 PIC AZ(3). -error: a Z or * which is before the decimal point cannot follow A or X -000043 03 PIC 99.99XXXXX. -error: A or X cannot follow . -000044 03 PIC SA. -error: A or X cannot follow S -000045 03 PIC $$$B+++B---. -error: a leading +/- sign cannot follow B, 0 or / -error: a leading +/- sign cannot follow a floating currency symbol string - + which is before the decimal point -error: a leading +/- sign may only occur once in a PICTURE string -error: a trailing +/- sign cannot follow a leading +/- sign -error: a trailing +/- sign may only occur once in a PICTURE string -000046 03 PIC +++9+. -error: a trailing +/- sign cannot follow a floating +/- string which is before - + the decimal point -000047 03 PIC +9(5)CR. -error: CR or DB cannot follow a leading +/- sign -000048 03 PIC -9(5)DB. -error: CR or DB cannot follow a leading +/- sign -000049 01 non-rightmost-leftmost-symbols. -000050 03 PIC BBB+BB99. -error: a leading +/- sign cannot follow B, 0 or / -000051 03 PIC 99-B. -error: a leading +/- sign cannot follow 9 -000052 03 PIC 9CRB. -error: B, 0 or / cannot follow CR or DB -000053 03 PIC DB9(5). -error: 9 cannot follow CR or DB -000054 03 PIC 99$$$. -error: a floating currency symbol string which is before the decimal point - + cannot follow 9 -000055 03 PIC 99$B. -error: a leading currency symbol cannot follow 9 -000056 03 PIC 0$99. -error: a leading currency symbol cannot follow B, 0 or / -000057 03 PIC PPPVP9. -error: P must be at start or end of PICTURE string -error: V cannot follow a P which is after the decimal point -000058 01 missing-symbols. -000059 03 PIC B(5). -error: PICTURE string must contain at least one of the set A, N, X, Z, 1, 9 - + and *; or at least two of the set +, - and the currency symbol -000060 03 PIC +. -error: PICTURE string must contain at least one of the set A, N, X, Z, 1, 9 - + and *; or at least two of the set +, - and the currency symbol -000061 03 PIC $. -error: PICTURE string must contain at least one of the set A, N, X, Z, 1, 9 - + and *; or at least two of the set +, - and the currency symbol -000062 -000063 01 str-constant CONSTANT "hello". -000064 01 float-constant CONSTANT 1.0. -000065 01 signed-constant CONSTANT -1. -000066 01 invalid-constant. -000067 03 PIC X(str-constant). -error: 'STR-CONSTANT' is not a numeric literal -000068 03 PIC X(float-constant). -error: 'FLOAT-CONSTANT' is not an integer -000069 03 PIC X(signed-constant). -error: 'SIGNED-CONSTANT' is not unsigned -000070 03 PIC X(unseen-constant). -error: 'UNSEEN-CONSTANT' is not defined -000071 -000072 01 integer-constant CONSTANT 5. -000073 01 valid-pics. -000074 03 PIC VP9B. -000075 03 PIC B9P(3). -000076 03 PIC B$$$. -000077 03 PIC 0000+B0+++0B,+. -000078 03 PIC +(5)P(3). -000079 03 PIC ++.++. -000080 03 PIC $(integer-constant). -000081 03 PIC $$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$ -warning: uncommon parentheses -000082 -(integer-constant). *> CHECKME: should this be really valid? -000083 -000084 -000085 01 PC-COLOR-BACKGROUND-TABLE. -000086 05 BIT-BACKGROUND-BLACK PIC 1(8) BIT VALUE B"00000000". -000087 05 BIT-BACKGROUND-BLUE PIC 1(8) BIT VALUE B"00010000". -000088 05 BIT-BACKGROUND-GREEN PIC 1(8) BIT VALUE B"00100000". -000089 05 BIT-BACKGROUND-CYAN PIC 1(8) BIT VALUE B"00110000". -000090 05 BIT-BACKGROUND-RED PIC 1(8) BIT VALUE B"01000000". -000091 05 BIT-BACKGROUND-MAGENTA PIC 1(8) BIT VALUE B"01010000". -000092 05 BIT-BACKGROUND-BROWN PIC 1(8) BIT VALUE B"01100000". -000093 05 BIT-BACKGROUND-LIGHT-GRAY PIC 1(8) BIT VALUE B"01110000". -000094 01 FILLER REDEFINES PC-COLOR-BACKGROUND-TABLE. -000095 05 COLOR-BACKGROUND -000096 OCCURS 8 TIMES PIC 1(8) BIT. - -SIZE TYPE LVL NAME PICTURE - - WORKING-STORAGE SECTION - -00000 ALPHANUMERIC 01 empty-pic INVALID - -00077 ALPHANUMERIC 01 too-long-pic XXXXXXXXXXXXXXXXXXXXXXX - -00000 ALPHANUMERIC 01 too-long-pic2 INVALID - -00000 GROUP 01 multiple-symbols -00000 ALPHANUMERIC 03 FILLER INVALID -00000 ALPHANUMERIC 03 FILLER INVALID -00000 ALPHANUMERIC 03 FILLER INVALID -00000 ALPHANUMERIC 03 FILLER INVALID -00000 ALPHANUMERIC 03 FILLER INVALID -00000 ALPHANUMERIC 03 FILLER INVALID -00000 ALPHANUMERIC 03 FILLER INVALID - -00000 GROUP 01 non-symbols -00000 ALPHANUMERIC 03 FILLER INVALID -00000 ALPHANUMERIC 03 FILLER INVALID -00000 ALPHANUMERIC 03 FILLER INVALID - -00050 ALPHANUMERIC 01 too-many-digits 9(50) - -00000 ALPHANUMERIC 01 too-long-number-in-parens INVALID - -00000 ALPHANUMERIC 01 nested-parens INVALID - -00000 ALPHANUMERIC 01 unbalanced-parens INVALID - -00000 ALPHANUMERIC 01 multiple-pairs-of-parens INVALID - -00000 ALPHANUMERIC 01 no-digit-in-parens INVALID - -00000 GROUP 01 mutually-exclusive-symbols -00000 ALPHANUMERIC 03 FILLER INVALID -00000 ALPHANUMERIC 03 FILLER INVALID -00000 ALPHANUMERIC 03 FILLER INVALID -00000 ALPHANUMERIC 03 FILLER INVALID -00000 ALPHANUMERIC 03 FILLER INVALID -00000 ALPHANUMERIC 03 FILLER INVALID -00000 ALPHANUMERIC 03 FILLER INVALID -00000 ALPHANUMERIC 03 FILLER INVALID -00000 ALPHANUMERIC 03 FILLER INVALID -00000 ALPHANUMERIC 03 FILLER INVALID -00000 ALPHANUMERIC 03 FILLER INVALID -00000 ALPHANUMERIC 03 FILLER INVALID -00000 ALPHANUMERIC 03 FILLER INVALID -00000 ALPHANUMERIC 03 FILLER INVALID -00000 ALPHANUMERIC 03 FILLER INVALID - -00000 GROUP 01 non-rightmost-leftmost-symbols -00000 ALPHANUMERIC 03 FILLER INVALID -00000 ALPHANUMERIC 03 FILLER INVALID -00000 ALPHANUMERIC 03 FILLER INVALID -00000 ALPHANUMERIC 03 FILLER INVALID -00000 ALPHANUMERIC 03 FILLER INVALID -00000 ALPHANUMERIC 03 FILLER INVALID -00000 ALPHANUMERIC 03 FILLER INVALID -00000 ALPHANUMERIC 03 FILLER INVALID - -00000 GROUP 01 missing-symbols -00000 ALPHANUMERIC 03 FILLER INVALID -00000 ALPHANUMERIC 03 FILLER INVALID -00000 ALPHANUMERIC 03 FILLER INVALID - -00000 GROUP 01 invalid-constant -00000 ALPHANUMERIC 03 FILLER INVALID -00000 ALPHANUMERIC 03 FILLER INVALID -00000 ALPHANUMERIC 03 FILLER INVALID -00000 ALPHANUMERIC 03 FILLER INVALID - -00086 GROUP 01 valid-pics -00002 ALPHANUMERIC 03 FILLER VP9B -00002 ALPHANUMERIC 03 FILLER B9P(3) -00004 ALPHANUMERIC 03 FILLER B$$$ -00014 ALPHANUMERIC 03 FILLER 0000+B0+++0B,+ -00005 ALPHANUMERIC 03 FILLER +(5)P(3) -00005 ALPHANUMERIC 03 FILLER ++.++ -00005 ALPHANUMERIC 03 FILLER $(INTEGER-CONSTANT) -00049 ALPHANUMERIC 03 FILLER $$$$$$$$$$$$$$$$$$$$$$$ - -00008 GROUP 01 PC-COLOR-BACKGROUND-TABLE -00001 NUMERIC 05 BIT-BACKGROUND-BLACK 1(8) -00001 NUMERIC 05 BIT-BACKGROUND-BLUE 1(8) -00001 NUMERIC 05 BIT-BACKGROUND-GREEN 1(8) -00001 NUMERIC 05 BIT-BACKGROUND-CYAN 1(8) -00001 NUMERIC 05 BIT-BACKGROUND-RED 1(8) -00001 NUMERIC 05 BIT-BACKGROUND-MAGENTA 1(8) -00001 NUMERIC 05 BIT-BACKGROUND-BROWN 1(8) -00001 NUMERIC 05 BIT-BACKGROUND-LIGHT-GRAY 1(8) - -00008 GROUP 01 FILLER, REDEFINES PC-COLOR-BACKGROUND-TABLE -00001 BOOLEAN 05 COLOR-BACKGROUND 1(8), OCCURS 8 - - - -Error/Warning summary: - -prog.cob:7: error: missing PICTURE string -prog.cob:10: error: PICTURE string may not contain more than 255 characters; contains 301 characters -prog.cob:16: error: CR or DB may only occur once in a PICTURE string -prog.cob:17: error: CR or DB may only occur once in a PICTURE string -prog.cob:18: error: S may only occur once in a PICTURE string -prog.cob:18: error: S must be at start of PICTURE string -prog.cob:19: error: . may only occur once in a PICTURE string -prog.cob:20: error: V may only occur once in a PICTURE string -prog.cob:21: error: a trailing +/- sign cannot follow a leading +/- sign -prog.cob:22: error: a leading +/- sign cannot follow a leading currency symbol -prog.cob:22: error: a trailing currency symbol cannot follow a leading currency symbol -prog.cob:22: error: a trailing +/- sign cannot follow a leading +/- sign -prog.cob:24: error: invalid PICTURE character 'K' -prog.cob:25: error: C must be followed by R -prog.cob:26: error: D must be followed by B -prog.cob:27: error: numeric field cannot be larger than 38 digits -prog.cob:28: error: only up to 9 significant digits are permitted within parentheses -prog.cob:29: error: parentheses must be preceded by a picture symbol -prog.cob:30: error: unbalanced parentheses -prog.cob:31: error: parentheses must be preceded by a picture symbol -prog.cob:32: error: parentheses must contain an unsigned integer -prog.cob:34: error: . cannot follow a P which is after the decimal point -prog.cob:35: error: . cannot follow V -prog.cob:36: error: cannot have both Z and * in PICTURE string -prog.cob:37: error: a trailing +/- sign cannot follow a floating +/- string which is before the decimal point -prog.cob:37: error: a trailing +/- sign may only occur once in a PICTURE string -prog.cob:38: error: a Z or * which is before the decimal point cannot follow a floating currency symbol string which is before the decimal point -prog.cob:39: error: a Z or * which is before the decimal point cannot follow a floating currency symbol string which is before the decimal point -prog.cob:40: error: A or X cannot follow N -prog.cob:41: error: N cannot follow A or X -prog.cob:42: error: a Z or * which is before the decimal point cannot follow A or X -prog.cob:43: error: A or X cannot follow . -prog.cob:44: error: A or X cannot follow S -prog.cob:45: error: a leading +/- sign cannot follow B, 0 or / -prog.cob:45: error: a leading +/- sign cannot follow a floating currency symbol string which is before the decimal point -prog.cob:45: error: a leading +/- sign may only occur once in a PICTURE string -prog.cob:45: error: a trailing +/- sign cannot follow a leading +/- sign -prog.cob:45: error: a trailing +/- sign may only occur once in a PICTURE string -prog.cob:46: error: a trailing +/- sign cannot follow a floating +/- string which is before the decimal point -prog.cob:47: error: CR or DB cannot follow a leading +/- sign -prog.cob:48: error: CR or DB cannot follow a leading +/- sign -prog.cob:50: error: a leading +/- sign cannot follow B, 0 or / -prog.cob:51: error: a leading +/- sign cannot follow 9 -prog.cob:52: error: B, 0 or / cannot follow CR or DB -prog.cob:53: error: 9 cannot follow CR or DB -prog.cob:54: error: a floating currency symbol string which is before the decimal point cannot follow 9 -prog.cob:55: error: a leading currency symbol cannot follow 9 -prog.cob:56: error: a leading currency symbol cannot follow B, 0 or / -prog.cob:57: error: P must be at start or end of PICTURE string -prog.cob:57: error: V cannot follow a P which is after the decimal point -prog.cob:59: error: PICTURE string must contain at least one of the set A, N, X, Z, 1, 9 and *; or at least two of the set +, - and the currency symbol -prog.cob:60: error: PICTURE string must contain at least one of the set A, N, X, Z, 1, 9 and *; or at least two of the set +, - and the currency symbol -prog.cob:61: error: PICTURE string must contain at least one of the set A, N, X, Z, 1, 9 and *; or at least two of the set +, - and the currency symbol -prog.cob:67: error: 'STR-CONSTANT' is not a numeric literal -prog.cob:68: error: 'FLOAT-CONSTANT' is not an integer -prog.cob:69: error: 'SIGNED-CONSTANT' is not unsigned -prog.cob:70: error: 'UNSEEN-CONSTANT' is not defined -prog.cob:81: warning: uncommon parentheses - -1 warning in compilation group -57 errors in compilation group -]) - -AT_CHECK([gcdiff -IGnuCOBOL prog19.lst prog.lst], [0], [], []) - -AT_CLEANUP - - -AT_SETUP([Variable format]) -AT_KEYWORDS([listing]) - -AT_CAPTURE_FILE([prog.lst]) - -AT_DATA([prog.cob], -[000001 $SET SOURCEFORMAT "VARIABLE" -000010 IDENTIFICATION DIVISION. -000020 PROGRAM-ID. prog. -000030* blah blah blah -000040 PROCEDURE DIVISION. -000050 DISPLAY "Hello!" -000060 . -000070 END PROGRAM prog. -]) - -AT_CHECK([$COMPILE_ONLY -t prog.lst -tlines=0 prog.cob], [0], [], []) - -AT_DATA([prog20.lst], -[GnuCOBOL V.R.P prog.cob DDD MMM dd HH:MM:SS YYYY - -LINE PG/LN A...B............................................................ - -000001 000001 $SET SOURCEFORMAT "VARIABLE" -000002 000010 IDENTIFICATION DIVISION. -000003 000020 PROGRAM-ID. prog. -000004 000030* blah blah blah -000005 000040 PROCEDURE DIVISION. -000006 000050 -000006+ DISPLAY "Hello!" -000007 000060 . -000008 000070 END PROGRAM prog. - - -0 warnings in compilation group -0 errors in compilation group -]) - -AT_CHECK([gcdiff -IGnuCOBOL prog20.lst prog.lst], [0], [], []) - -AT_CLEANUP - - -AT_SETUP([LISTING directive]) -AT_KEYWORDS([listing]) - -AT_CAPTURE_FILE([prog.lst]) - -AT_DATA([copy.inc], [ - >>LISTING OFF - 01 TEST1-VAR PIC X(2) VALUE "OK". - 01 TEST2-VAR PIC X(2) VALUE "OK". - 01 TEST3-VAR PIC X(2) VALUE "OK". - 01 TEST4-VAR PIC X(2) VALUE "OK". - >>LISTING ON - 01 TEST5-VAR PIC X(2) VALUE "OK". - 01 TEST6-VAR PIC X(2) VALUE "OK". - 01 TEST7-VAR PIC X(2) VALUE "OK". - 01 TEST8-VAR PIC X(2) VALUE "OK". -]) - -AT_DATA([copy2.inc], [ >> LISTING OFF - 01 TEST9-VAR PIC X(2) VALUE "OK". - >>LISTING - 01 TESTA-VAR PIC X(2) VALUE "OK". -]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - COPY "copy.inc". - COPY "copy2.inc". - PROCEDURE DIVISION. - DISPLAY TEST1-VAR NO ADVANCING - END-DISPLAY. - STOP RUN. -]) - -AT_CHECK([$COMPILE_ONLY -t prog.lst -tlines=0 -tsymbols prog.cob], [0], [], []) - -AT_DATA([prog17.lst], -[GnuCOBOL V.R.P prog.cob DDD MMM dd HH:MM:SS YYYY - -LINE PG/LN A...B............................................................ - -000001 -000002 IDENTIFICATION DIVISION. -000003 PROGRAM-ID. prog. -000004 DATA DIVISION. -000005 WORKING-STORAGE SECTION. -000006 COPY "copy.inc". -000001C -000002C >>LISTING OFF -000007C >>LISTING ON -000008C 01 TEST5-VAR PIC X(2) VALUE "OK". -000009C 01 TEST6-VAR PIC X(2) VALUE "OK". -000010C 01 TEST7-VAR PIC X(2) VALUE "OK". -000011C 01 TEST8-VAR PIC X(2) VALUE "OK". -000007 COPY "copy2.inc". -000001C >> LISTING OFF -000003C >>LISTING -000004C 01 TESTA-VAR PIC X(2) VALUE "OK". -000008 PROCEDURE DIVISION. -000009 DISPLAY TEST1-VAR NO ADVANCING -000010 END-DISPLAY. -000011 STOP RUN. - -SIZE TYPE LVL NAME PICTURE - - WORKING-STORAGE SECTION - -00002 ALPHANUMERIC 01 TEST1-VAR X(2) - -00002 ALPHANUMERIC 01 TEST2-VAR X(2) - -00002 ALPHANUMERIC 01 TEST3-VAR X(2) - -00002 ALPHANUMERIC 01 TEST4-VAR X(2) - -00002 ALPHANUMERIC 01 TEST5-VAR X(2) - -00002 ALPHANUMERIC 01 TEST6-VAR X(2) - -00002 ALPHANUMERIC 01 TEST7-VAR X(2) - -00002 ALPHANUMERIC 01 TEST8-VAR X(2) - -00002 ALPHANUMERIC 01 TEST9-VAR X(2) - -00002 ALPHANUMERIC 01 TESTA-VAR X(2) - - -0 warnings in compilation group -0 errors in compilation group -]) - -AT_CHECK([gcdiff -IGnuCOBOL prog17.lst prog.lst], [0], [], []) - -AT_CLEANUP - - -AT_SETUP([Listing-directive statements]) -AT_KEYWORDS([listing directive EJECT SKIP1 SKIP2 SKIP3 TITLE]) - -AT_CAPTURE_FILE([prog.lst]) - -AT_DATA([prog.cob], [ TITLE "GnuCOBOL lists IBM" - IDENTIFICATION DIVISION. - SKIP1 - PROGRAM-ID. prog. - SKIP2 - DATA DIVISION. - SKIP3 - WORKING-STORAGE SECTION. - 01 TITLE-01 PIC X(2). - 01 TITLE-02 PIC X(2). - TITLE "here goes the code" - PROCEDURE DIVISION. - EJECT - MOVE SPACE TO TITLE-01 - TITLE-02. - STOP RUN. -]) - -AT_CHECK([$COMPILE_ONLY -t prog.lst -std=ibm prog.cob], [0], [], []) - -AT_DATA([expect.lst], -[GnuCOBOL lists IBM prog.cob DDD MMM dd HH:MM:SS YYYY Page 0001 - -LINE PG/LN A...B............................................................ - -000002 IDENTIFICATION DIVISION. - - -000004 PROGRAM-ID. prog. - - - -000006 DATA DIVISION. - - - - -000008 WORKING-STORAGE SECTION. -000009 01 TITLE-01 PIC X(2). -000010 01 TITLE-02 PIC X(2). - here goes the code prog.cob DDD MMM dd HH:MM:SS YYYY Page 0002 - -LINE PG/LN A...B............................................................ - -000012 PROCEDURE DIVISION. - here goes the code prog.cob DDD MMM dd HH:MM:SS YYYY Page 0003 - -LINE PG/LN A...B............................................................ - -000014 MOVE SPACE TO TITLE-01 -000015 TITLE-02. -000016 STOP RUN. - - -0 warnings in compilation group -0 errors in compilation group -]) - -AT_CHECK([gcdiff -IGnuCOBOL -I"here goes the code" expect.lst prog.lst], [0], [], []) - -AT_CLEANUP - - -AT_SETUP([Eject page]) -AT_KEYWORDS([listing directive]) - -AT_CAPTURE_FILE([prog.lis]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - / - PROCEDURE DIVISION. - STOP RUN. -]) - -AT_CHECK([$COMPILE_ONLY -t prog.lst prog.cob], [0], [], []) - -AT_DATA([prog7.lst], -[GnuCOBOL V.R.P prog.cob DDD MMM dd HH:MM:SS YYYY Page 0001 - -LINE PG/LN A...B............................................................ - -000001 -000002 IDENTIFICATION DIVISION. -000003 PROGRAM-ID. prog. -000004 DATA DIVISION. -000005 WORKING-STORAGE SECTION. - GnuCOBOL V.R.P prog.cob DDD MMM dd HH:MM:SS YYYY Page 0002 - -LINE PG/LN A...B............................................................ - -000006 / -000007 PROCEDURE DIVISION. -000008 STOP RUN. - - -0 warnings in compilation group -0 errors in compilation group -]) - -AT_CHECK([gcdiff -IGnuCOBOL prog7.lst prog.lst], [0], [], []) - -AT_DATA([prog2.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog2. - DATA DIVISION. - WORKING-STORAGE SECTION. ->>PAGE - PROCEDURE DIVISION. - STOP RUN. -]) - - -AT_CHECK([$COMPILE_ONLY -t prog.lst -free prog2.cob], [0], [], []) - -AT_DATA([prog8.lst], -[GnuCOBOL V.R.P prog2.cob DDD MMM dd HH:MM:SS YYYY Page 0001 - -LINE .....................SOURCE............................................. - -000001 -000002 IDENTIFICATION DIVISION. -000003 PROGRAM-ID. prog2. -000004 DATA DIVISION. -000005 WORKING-STORAGE SECTION. - GnuCOBOL V.R.P prog2.cob DDD MMM dd HH:MM:SS YYYY Page 0002 - -LINE .....................SOURCE............................................. - -000006 >>PAGE -000007 PROCEDURE DIVISION. -000008 STOP RUN. - - -0 warnings in compilation group -0 errors in compilation group -]) - -AT_CHECK([gcdiff -IGnuCOBOL prog8.lst prog.lst], [0], [], []) - -AT_DATA([prog3.cob], [ - IDENTIFICATION DIVISION. - - PROGRAM-ID. prog3. - - - DATA DIVISION. - WORKING-STORAGE SECTION. - 77 WS-VAR PIC X(2). - / - 77 WS-VA2 PIC X(2). - - - LOCAL-STORAGE SECTION. - 77 LS-VAR PIC 9(2). - - - PROCEDURE DIVISION. - - DISPLAY WS-VAR - MOVE 99 TO LS-VAR - - STOP RUN. -]) - -AT_CHECK([$COMPILE_ONLY -t prog.lst prog3.cob], [0], [], []) - -AT_DATA([prog9.lst], -[GnuCOBOL V.R.P prog3.cob DDD MMM dd HH:MM:SS YYYY Page 0001 - -LINE PG/LN A...B............................................................ - -000001 -000002 IDENTIFICATION DIVISION. -000003 -000004 PROGRAM-ID. prog3. -000005 -000006 -000007 DATA DIVISION. -000008 WORKING-STORAGE SECTION. -000009 77 WS-VAR PIC X(2). - GnuCOBOL V.R.P prog3.cob DDD MMM dd HH:MM:SS YYYY Page 0002 - -LINE PG/LN A...B............................................................ - -000010 / -000011 77 WS-VA2 PIC X(2). -000012 -000013 -000014 LOCAL-STORAGE SECTION. -000015 77 LS-VAR PIC 9(2). -000016 -000017 -000018 PROCEDURE DIVISION. -000019 -000020 DISPLAY WS-VAR -000021 MOVE 99 TO LS-VAR -000022 -000023 STOP RUN. - - -0 warnings in compilation group -0 errors in compilation group -]) - -AT_CHECK([gcdiff -IGnuCOBOL prog9.lst prog.lst], [0], [], []) - -AT_CHECK([$COMPILE_ONLY -t prog.lst -tlines=20 prog3.cob], [0], [], []) - -AT_DATA([prog10.lst], -[GnuCOBOL V.R.P prog3.cob DDD MMM dd HH:MM:SS YYYY Page 0001 - -LINE PG/LN A...B............................................................ - -000001 -000002 IDENTIFICATION DIVISION. -000003 -000004 PROGRAM-ID. prog3. -000005 -000006 -000007 DATA DIVISION. -000008 WORKING-STORAGE SECTION. -000009 77 WS-VAR PIC X(2). - GnuCOBOL V.R.P prog3.cob DDD MMM dd HH:MM:SS YYYY Page 0002 - -LINE PG/LN A...B............................................................ - -000010 / -000011 77 WS-VA2 PIC X(2). -000012 -000013 -000014 LOCAL-STORAGE SECTION. -000015 77 LS-VAR PIC 9(2). -000016 -000017 -000018 PROCEDURE DIVISION. -000019 -000020 DISPLAY WS-VAR -000021 MOVE 99 TO LS-VAR -000022 -000023 STOP RUN. - - -0 warnings in compilation group - GnuCOBOL V.R.P prog3.cob DDD MMM dd HH:MM:SS YYYY Page 0003 - -0 errors in compilation group -]) - -AT_CHECK([gcdiff -IGnuCOBOL prog10.lst prog.lst], [0], [], []) - -AT_CLEANUP - - -AT_SETUP([Cross reference]) -AT_KEYWORDS([listing]) - -AT_CAPTURE_FILE([prog.lst]) - -AT_DATA([EDITOR.cob], [ - IDENTIFICATION DIVISION. EDIT0001 - PROGRAM-ID. EDIT0002 - EDITOR. EDIT0003 - EDIT0008 - *NOTE. EDIT0009 - * THIS VERSION OF EDITOR 1 COMPRISES AN ENTIRE RE_WRITE EDIT0010 - * OF THE BASIC EDITOR WITH ONLY ONE CHANGE IN THE COMMAND EDIT0011 - * STRUCTURE, THAT BEING THE ADDITION OF A "CHANGE" COMMAND EDIT0012 - * TO SERVE IN PLACE OF THE INSERT-DELETE COMBINATION WHICH EDIT0013 - * WAS REQUIRED IN PREVIOUS VERSIONS. RECORD NUMBER FIELDS EDIT0014 - * HAVE ALSO BEEN REDUCED FROM 5 DIGITS TO 4. EDIT0015 - * CHANGE 1. EDIT0016 - * MODIFY TO RUN ON TI-990. EDIT0017 - * CHANGE 2. EDIT0018 - * MODIFY TO RUN ON GNUCOBOL. EDIT0019 - EDIT0020 - ENVIRONMENT DIVISION. EDIT0021 - CONFIGURATION SECTION. EDIT0022 - SOURCE-COMPUTER. EDIT0023 - IBM-360. EDIT0024 - OBJECT-COMPUTER. EDIT0025 - IBM-360. EDIT0026 - INPUT-OUTPUT SECTION. EDIT0027 - FILE-CONTROL. EDIT0028 - SELECT OLD-VERSION ASSIGN TO "SYSUT1" EDIT0029 - ORGANIZATION LINE SEQUENTIAL. EDIT0030 - SELECT NEW-VERSION ASSIGN TO "SYSUT2" EDIT0031 - ORGANIZATION LINE SEQUENTIAL. EDIT0032 - SELECT PRT-VERSION ASSIGN TO "SYSUT2" EDIT0033 - ORGANIZATION LINE SEQUENTIAL. EDIT0034 - SELECT MODIFICATION ASSIGN TO "SYSIN1" EDIT0035 - ORGANIZATION LINE SEQUENTIAL. EDIT0036 - SELECT COMMENTARY ASSIGN TO "SYSOU1" EDIT0037 - ORGANIZATION LINE SEQUENTIAL. EDIT0038 - EDIT0039 - DATA DIVISION. EDIT0040 - EDIT0041 - FILE SECTION. EDIT0042 - EDIT0043 - FD OLD-VERSION EDIT0044 - LABEL RECORDS ARE STANDARD EDIT0045 - BLOCK CONTAINS 80 CHARACTERS EDIT0046 - DATA RECORD IS OLD-RECORD. EDIT0047 - EDIT0048 - 01 OLD-RECORD. EDIT0049 - 02 OLD-STATEMENT PICTURE X(75). EDIT0050 - 02 OLD-NUMBER PICTURE X(5). EDIT0051 - EDIT0052 - FD NEW-VERSION EDIT0053 - LABEL RECORDS ARE STANDARD EDIT0054 - BLOCK CONTAINS 80 CHARACTERS EDIT0055 - DATA RECORD IS NEW-RECORD. EDIT0056 - EDIT0057 - 01 NEW-RECORD. EDIT0058 - 02 NEW-STATEMENT PICTURE X(75). EDIT0059 - 02 NEW-NUMBER PICTURE X(5). EDIT0060 - EDIT0061 - FD MODIFICATION EDIT0062 - LABEL RECORDS ARE OMITTED EDIT0063 - BLOCK CONTAINS 80 CHARACTERS EDIT0064 - DATA RECORD IS UPDATE-ORDER. EDIT0065 - EDIT0066 - 01 UPDATE-ORDER. EDIT0067 - 02 INSERTION. EDIT0068 - 03 COMMAND PICTURE X(6). EDIT0069 - 88 ENDJOB VALUE "ENDJOB". EDIT0070 - 88 ENDSET VALUE "ENDSET". EDIT0071 - 88 REMOVE VALUE "REMOVE". EDIT0072 - 88 ADDNEW VALUE "INSERT". EDIT0073 - 88 CHANGE VALUE "CHANGE". EDIT0074 - 88 DISPLY VALUE "DISPLY". EDIT0075 - 03 FILLER PICTURE X. EDIT0076 - 03 A-FIELD PICTURE 9(5). EDIT0077 - 03 A-ALPHA REDEFINES A-FIELD PICTURE X(5). EDIT0078 - 88 A-BLANK VALUE SPACES. EDIT0079 - 03 FILLER PICTURE X(4). EDIT0080 - 03 B-FIELD PICTURE 9(5). EDIT0081 - 03 B-ALPHA REDEFINES B-FIELD PICTURE X(5). EDIT0082 - 88 B-BLANK VALUE SPACES. EDIT0083 - 03 FILLER PICTURE X(54). EDIT0084 - 02 FILLER PICTURE X(5). EDIT0085 - EDIT0086 - FD COMMENTARY EDIT0087 - LABEL RECORDS ARE OMITTED EDIT0088 - BLOCK CONTAINS 82 CHARACTERS EDIT0089 - DATA RECORD IS COMMENT-LINE. EDIT0090 - EDIT0091 - 01 COMMENT-LINE. EDIT0092 - 02 FILLER PICTURE X(82). EDIT0093 - EDIT0094 - WORKING-STORAGE SECTION. EDIT0095 - EDIT0096 - 77 COMMAND-ADDITIONS PICTURE 9(3) COMPUTATIONAL VALUE 0. EDIT0097 - 77 COMMAND-SUBTRACTIONS PICTURE 9(3) COMPUTATIONAL VALUE 0. EDIT0098 - 77 TOTAL-INSERTED PICTURE 9(3) COMPUTATIONAL VALUE 0. EDIT0099 - 77 TOTAL-DELETED PICTURE 9(3) COMPUTATIONAL VALUE 0. EDIT0100 - 77 OUTPUT-COUNT PICTURE 9(5) COMPUTATIONAL VALUE 0. EDIT0101 - 77 LINE-COUNT PICTURE 9(2) COMPUTATIONAL VALUE 0. EDIT0102 - 77 FIELDA PICTURE 9(5) VALUE 0. EDIT0103 - 77 FIELDB PICTURE 9(5) VALUE 0. EDIT0104 - 77 BLANK-LINE PICTURE X(82) VALUE SPACES. EDIT0105 - EDIT0106 - 01 DATE-FROM-SYS. EDIT0107 - 02 DFSYS OCCURS 3 TIMES PICTURE 99. EDIT0108 - EDIT0109 - 01 HEADINGS-LINE. EDIT0110 - 02 FILLER PICTURE X(15) VALUE "EDITOR VERSION". EDIT0111 - 02 FILLER PICTURE X(20) VALUE "1.1 - 206/72". EDIT0112 - 02 PHASE PICTURE X(17) VALUE "UPDATING AS OF". EDIT0113 - 02 MONTH-RUN PICTURE XX. EDIT0114 - 02 FILLER PICTURE X VALUE "/". EDIT0115 - 02 DAY-RUN PICTURE XX. EDIT0116 - 02 FILLER PICTURE X VALUE "/". EDIT0117 - 02 YEAR-RUN PICTURE XX. EDIT0118 - 02 FILLER PICTURE X(8) VALUE SPACES. EDIT0119 - 02 FILLER PICTURE X(8) VALUE " PAGE: ". EDIT0120 - 02 PAGE-NUMBER PICTURE 9(4) VALUE 0. EDIT0121 - EDIT0122 - 01 COMMAND-LISTING. EDIT0123 - 02 FILLER PICTURE X(2) VALUE SPACES. EDIT0124 - 02 COMMAND-IMAGE PICTURE X(80). EDIT0125 - EDIT0126 - 01 ACTIVITIES-LISTING. EDIT0127 - 02 DISPOSITION PICTURE X(2). EDIT0128 - 02 ACTIVE-IMAGE PICTURE X(80). EDIT0129 - EDIT0130 - 01 UPSI-BYTE. EDIT0131 - 02 UPSI-BIT OCCURS 8 TIMES PICTURE X. EDIT0132 - EDIT0133 - 01 MESSAGE-LOG. EDIT0134 - 02 FILLER PICTURE X(2) VALUE SPACES. EDIT0135 - 02 MESSAGE-TEXT PICTURE X(80). EDIT0136 - EDIT0137 - 01 DISPLAY-MESSAGE. EDIT0138 - 02 FILLER PICTURE X(2) VALUE SPACES. EDIT0139 - 02 DISPLAY-TEMP PICTURE X(6). EDIT0140 - 02 FILLER PICTURE X(2) VALUE SPACES. EDIT0141 - 02 DISPLAY-TEXT PICTURE X(60). EDIT0142 - EDIT0143 - 77 END-JOB-PROCESS PICTURE 9 VALUE 0. EDIT0144 - 77 DELETE-PROCESS PICTURE 9 VALUE 1. EDIT0145 - 77 INSERT-PROCESS PICTURE 9 VALUE 2. EDIT0146 - 77 WRITE-PROCESS PICTURE 9 VALUE 3. EDIT0147 - EDIT0148 - 01 SELECTORS. EDIT0149 - 02 RETURN-SELECT PICTURE 9 VALUE 0. EDIT0150 - 02 NEXT-JOB-SELECT PICTURE 9 VALUE 0. EDIT0151 - EDIT0152 - PROCEDURE DIVISION. EDIT0153 - EDIT0154 - START-SECTION. EDIT0155 - OPEN INPUT OLD-VERSION, MODIFICATION, EDIT0156 - OUTPUT NEW-VERSION, COMMENTARY. EDIT0157 - MOVE "F" TO UPSI-BIT (1), UPSI-BIT (2). EDIT0158 - ACCEPT DATE-FROM-SYS FROM DATE. EDIT0159 - MOVE DFSYS (1) TO YEAR-RUN. EDIT0160 - MOVE DFSYS (2) TO MONTH-RUN. EDIT0161 - MOVE DFSYS (3) TO DAY-RUN. EDIT0162 - READ OLD-VERSION AT END EDIT0163 - MOVE "NO OLD VERSION FOUND" TO MESSAGE-TEXT EDIT0164 - WRITE COMMENT-LINE FROM MESSAGE-LOG EDIT0165 - GO TO END-JOB. EDIT0166 - MOVE OLD-STATEMENT TO NEW-STATEMENT. EDIT0167 - PERFORM OUTPUT-A-RECORD. EDIT0168 - EDIT0169 - TOP-OF-PAGE-ROUTINE. EDIT0170 - ADD 1 TO PAGE-NUMBER. EDIT0171 - MOVE ZERO TO LINE-COUNT. EDIT0172 - WRITE COMMENT-LINE FROM HEADINGS-LINE AFTER PAGE. EDIT0173 - WRITE COMMENT-LINE FROM BLANK-LINE. EDIT0174 - EDIT0175 - READ-A-COMMAND. EDIT0176 - READ MODIFICATION AT END EDIT0177 - MOVE "MODIFICATION FILE ENDED " TO MESSAGE-TEXT EDIT0178 - WRITE COMMENT-LINE FROM MESSAGE-LOG EDIT0179 - GO TO FINISH-JOB. EDIT0180 - MOVE UPDATE-ORDER TO COMMAND-IMAGE. EDIT0181 - WRITE COMMENT-LINE FROM COMMAND-LISTING. EDIT0182 - ADD 2 TO LINE-COUNT. EDIT0183 - IF A-BLANK MOVE ZEROES TO A-FIELD. EDIT0184 - IF B-BLANK MOVE ZEROES TO B-FIELD. EDIT0185 - MOVE A-FIELD TO FIELDA. EDIT0186 - MOVE B-FIELD TO FIELDB. EDIT0187 - EDIT0188 - TEST-COMMAND-TYPE. EDIT0189 - IF CHANGE GO TO CHANGE-A-RECORD. EDIT0190 - IF REMOVE GO TO DELETE-A-RECORD. EDIT0191 - IF DISPLY MOVE "T" TO UPSI-BIT (2) EDIT0192 - GO TO FINISH-JOB. EDIT0193 - IF ENDJOB GO TO FINISH-JOB. EDIT0194 - IF ADDNEW GO TO INSERT-A-RECORD. EDIT0195 - MOVE "INVALID COMMAND IGNORED." TO MESSAGE-TEXT. EDIT0196 - WRITE COMMENT-LINE FROM MESSAGE-LOG. EDIT0197 - GO TO READ-A-COMMAND. EDIT0198 - EDIT0199 - CHANGE-A-RECORD. EDIT0200 - ALTER RETURN-TO-USER TO PROCEED TO INSERTION-PROCESS. EDIT0201 - ALTER NEXT-JOB-STEP TO PROCEED TO DELETION-PROCESS. EDIT0202 - EDIT0205 - FIND-FIELDA. EDIT0206 - IF OLD-NUMBER IS GREATER THAN FIELDA EDIT0207 - MOVE "RECORD ALREADY PASSED" TO MESSAGE-TEXT EDIT0208 - WRITE COMMENT-LINE FROM MESSAGE-LOG EDIT0209 - GO TO READ-A-COMMAND. EDIT0210 - READ OLD-VERSION AT END EDIT0211 - MOVE "NOT FOUND IN OLD VERSION" TO DISPLAY-TEXT EDIT0212 - MOVE FIELDA TO DISPLAY-TEMP EDIT0213 - WRITE COMMENT-LINE FROM DISPLAY-MESSAGE EDIT0214 - GO TO END-JOB. EDIT0215 - IF OLD-NUMBER IS LESS THAN FIELDA EDIT0216 - MOVE OLD-STATEMENT TO NEW-STATEMENT EDIT0217 - PERFORM OUTPUT-A-RECORD EDIT0218 - GO TO FIND-FIELDA. EDIT0219 - EDIT0220 - RETURN-TO-USER. EDIT0221 - GO TO END-JOB. EDIT0223 - EDIT0228 - INSERT-A-RECORD. EDIT0229 - ALTER RETURN-TO-USER TO PROCEED TO INSERTION-PROCESS. EDIT0230 - ALTER NEXT-JOB-STEP TO PROCEED TO FORCED-WRITE. EDIT0231 - GO TO FIND-FIELDA. EDIT0234 - EDIT0235 - INSERTION-PROCESS. EDIT0236 - READ MODIFICATION AT END EDIT0237 - MOVE "NO ENDSET FOUND" TO MESSAGE-TEXT EDIT0238 - WRITE COMMENT-LINE FROM MESSAGE-LOG EDIT0239 - GO TO END-JOB. EDIT0240 - IF ENDSET EDIT0241 - MOVE COMMAND-ADDITIONS TO DISPLAY-TEMP EDIT0242 - MOVE "RECORDS INSERTED." TO DISPLAY-TEXT EDIT0243 - WRITE COMMENT-LINE FROM DISPLAY-MESSAGE EDIT0244 - ADD COMMAND-ADDITIONS TO TOTAL-INSERTED EDIT0245 - MOVE ZEROES TO COMMAND-ADDITIONS EDIT0246 - GO TO NEXT-JOB-STEP. EDIT0247 - MOVE INSERTION TO NEW-STATEMENT, ACTIVE-IMAGE. EDIT0248 - MOVE "I " TO DISPOSITION. EDIT0249 - PERFORM OUTPUT-A-RECORD. EDIT0250 - WRITE COMMENT-LINE FROM ACTIVITIES-LISTING. EDIT0251 - ADD 1 TO COMMAND-ADDITIONS. EDIT0252 - ADD 1 TO LINE-COUNT. EDIT0253 - IF LINE-COUNT EQUAL 56 PERFORM TOP-OF-PAGE-ROUTINE. EDIT0254 - GO TO INSERTION-PROCESS. EDIT0255 - EDIT0256 - NEXT-JOB-STEP. EDIT0257 - GO TO END-JOB. EDIT0259 - EDIT0264 - FORCED-WRITE. EDIT0265 - MOVE OLD-STATEMENT TO NEW-STATEMENT. EDIT0266 - PERFORM OUTPUT-A-RECORD. EDIT0267 - GO TO READ-A-COMMAND. EDIT0268 - EDIT0269 - DELETE-A-RECORD. EDIT0270 - ALTER RETURN-TO-USER TO PROCEED TO DELETION-PROCESS. EDIT0271 - GO TO FIND-FIELDA. EDIT0273 - EDIT0274 - DELETION-PROCESS. EDIT0275 - MOVE OLD-RECORD TO ACTIVE-IMAGE. EDIT0276 - MOVE "D " TO DISPOSITION. EDIT0277 - WRITE COMMENT-LINE FROM ACTIVITIES-LISTING. EDIT0278 - ADD 1 TO LINE-COUNT. EDIT0279 - IF LINE-COUNT EQUAL 56 PERFORM TOP-OF-PAGE-ROUTINE. EDIT0280 - ADD 1 TO COMMAND-SUBTRACTIONS. EDIT0281 - IF OLD-NUMBER IS NOT LESS THAN FIELDB EDIT0282 - MOVE COMMAND-SUBTRACTIONS TO DISPLAY-TEMP EDIT0283 - MOVE "RECORDS DELETED." TO DISPLAY-TEXT EDIT0284 - WRITE COMMENT-LINE FROM DISPLAY-MESSAGE EDIT0285 - ADD COMMAND-SUBTRACTIONS TO TOTAL-DELETED EDIT0286 - MOVE OLD-STATEMENT TO NEW-STATEMENT EDIT0287 - MOVE ZEROES TO COMMAND-SUBTRACTIONS EDIT0288 - GO TO READ-A-COMMAND. EDIT0289 - READ OLD-VERSION AT END EDIT0290 - MOVE "NOT FOUND IN OLD VERSION DOING DELETE" EDIT0291 - TO DISPLAY-TEXT EDIT0292 - WRITE COMMENT-LINE FROM DISPLAY-MESSAGE EDIT0293 - GO TO END-JOB. EDIT0294 - GO TO DELETION-PROCESS. EDIT0295 - EDIT0296 - OUTPUT-A-RECORD. EDIT0297 - ADD 1 TO OUTPUT-COUNT. EDIT0298 - MOVE OUTPUT-COUNT TO NEW-NUMBER. EDIT0299 - WRITE NEW-RECORD. EDIT0300 - EDIT0301 - FINISH-JOB. EDIT0302 - READ OLD-VERSION AT END GO TO TEST-FOR-LISTING. EDIT0303 - MOVE OLD-STATEMENT TO NEW-STATEMENT. EDIT0304 - GO TO OUTPUT-A-RECORD. EDIT0305 - EDIT0306 - TEST-FOR-LISTING. EDIT0307 - PERFORM TOP-OF-PAGE-ROUTINE. EDIT0308 - MOVE OLD-NUMBER TO DISPLAY-TEMP. EDIT0309 - MOVE "RECORDS READ." TO DISPLAY-TEXT. EDIT0310 - WRITE COMMENT-LINE FROM DISPLAY-MESSAGE. EDIT0311 - MOVE TOTAL-INSERTED TO DISPLAY-TEMP. EDIT0312 - MOVE "RECORDS ADDED." TO DISPLAY-TEXT. EDIT0313 - WRITE COMMENT-LINE FROM DISPLAY-MESSAGE. EDIT0314 - MOVE TOTAL-DELETED TO DISPLAY-TEMP. EDIT0315 - MOVE "RECORDS DROPPED." TO DISPLAY-TEXT. EDIT0316 - WRITE COMMENT-LINE FROM DISPLAY-MESSAGE. EDIT0317 - MOVE OUTPUT-COUNT TO DISPLAY-TEMP. EDIT0318 - MOVE "RECORDS IN NEW FILE." TO DISPLAY-TEXT. EDIT0319 - WRITE COMMENT-LINE FROM DISPLAY-MESSAGE. EDIT0320 - IF UPSI-BIT (2) EQUAL "F" GO TO END-JOB. EDIT0321 - CLOSE NEW-VERSION. EDIT0322 - OPEN INPUT NEW-VERSION. EDIT0323 - MOVE "UPDATED LISTING" TO PHASE. EDIT0324 - MOVE ZEROES TO PAGE-NUMBER. EDIT0325 - PERFORM TOP-OF-PAGE-ROUTINE. EDIT0326 - MOVE SPACES TO DISPOSITION. EDIT0327 - EDIT0328 - LISTING-LOOP. EDIT0329 - READ NEW-VERSION AT END GO TO END-JOB. EDIT0330 - MOVE NEW-RECORD TO ACTIVE-IMAGE. EDIT0331 - WRITE COMMENT-LINE FROM ACTIVITIES-LISTING. EDIT0332 - ADD 1 TO LINE-COUNT. EDIT0333 - IF LINE-COUNT EQUAL 56 PERFORM TOP-OF-PAGE-ROUTINE. EDIT0334 - GO TO LISTING-LOOP. EDIT0335 - EDIT0336 - END-JOB. EDIT0337 - MOVE "PROGRAM TERMINATION" TO MESSAGE-TEXT. EDIT0338 - WRITE COMMENT-LINE FROM MESSAGE-LOG. EDIT0339 - CLOSE OLD-VERSION, NEW-VERSION, MODIFICATION, COMMENTARY. EDIT0340 - STOP RUN. EDIT0341 - EDIT0342 - END PROGRAM EDITOR. EDIT0343 -]) - -AT_CHECK([$COMPILE_ONLY -Xref -t prog.lst -tlines=0 -tsymbols EDITOR.cob], [1], [], -[EDITOR.cob:42: warning: LABEL RECORDS is obsolete in GnuCOBOL -EDITOR.cob:44: warning: DATA RECORDS is obsolete in GnuCOBOL -EDITOR.cob:51: warning: LABEL RECORDS is obsolete in GnuCOBOL -EDITOR.cob:53: warning: DATA RECORDS is obsolete in GnuCOBOL -EDITOR.cob:60: warning: LABEL RECORDS is obsolete in GnuCOBOL -EDITOR.cob:62: warning: DATA RECORDS is obsolete in GnuCOBOL -EDITOR.cob:85: warning: LABEL RECORDS is obsolete in GnuCOBOL -EDITOR.cob:87: warning: DATA RECORDS is obsolete in GnuCOBOL -EDITOR.cob:30: error: missing file description for FILE PRT-VERSION -EDITOR.cob: in paragraph 'CHANGE-A-RECORD': -EDITOR.cob:198: warning: ALTER is obsolete in GnuCOBOL -EDITOR.cob:199: warning: ALTER is obsolete in GnuCOBOL -EDITOR.cob: in paragraph 'INSERT-A-RECORD': -EDITOR.cob:220: warning: ALTER is obsolete in GnuCOBOL -EDITOR.cob:221: warning: ALTER is obsolete in GnuCOBOL -EDITOR.cob: in paragraph 'DELETE-A-RECORD': -EDITOR.cob:254: warning: ALTER is obsolete in GnuCOBOL -]) - - -AT_DATA([prog18.lst], -[GnuCOBOL V.R.P EDITOR.cob DDD MMM dd HH:MM:SS YYYY - -LINE PG/LN A...B............................................................ - -000001 -000002 IDENTIFICATION DIVISION. -000003 PROGRAM-ID. -000004 EDITOR. -000005 -000006 *NOTE. -000007 * THIS VERSION OF EDITOR 1 COMPRISES AN ENTIRE RE_WRITE -000008 * OF THE BASIC EDITOR WITH ONLY ONE CHANGE IN THE COMMAND -000009 * STRUCTURE, THAT BEING THE ADDITION OF A "CHANGE" COMMAND -000010 * TO SERVE IN PLACE OF THE INSERT-DELETE COMBINATION WHICH -000011 * WAS REQUIRED IN PREVIOUS VERSIONS. RECORD NUMBER FIELDS -000012 * HAVE ALSO BEEN REDUCED FROM 5 DIGITS TO 4. -000013 * CHANGE 1. -000014 * MODIFY TO RUN ON TI-990. -000015 * CHANGE 2. -000016 * MODIFY TO RUN ON GNUCOBOL. -000017 -000018 ENVIRONMENT DIVISION. -000019 CONFIGURATION SECTION. -000020 SOURCE-COMPUTER. -000021 IBM-360. -000022 OBJECT-COMPUTER. -000023 IBM-360. -000024 INPUT-OUTPUT SECTION. -000025 FILE-CONTROL. -000026 SELECT OLD-VERSION ASSIGN TO "SYSUT1" -000027 ORGANIZATION LINE SEQUENTIAL. -000028 SELECT NEW-VERSION ASSIGN TO "SYSUT2" -000029 ORGANIZATION LINE SEQUENTIAL. -000030 SELECT PRT-VERSION ASSIGN TO "SYSUT2" -error: missing file description for FILE PRT-VERSION -000031 ORGANIZATION LINE SEQUENTIAL. -000032 SELECT MODIFICATION ASSIGN TO "SYSIN1" -000033 ORGANIZATION LINE SEQUENTIAL. -000034 SELECT COMMENTARY ASSIGN TO "SYSOU1" -000035 ORGANIZATION LINE SEQUENTIAL. -000036 -000037 DATA DIVISION. -000038 -000039 FILE SECTION. -000040 -000041 FD OLD-VERSION -000042 LABEL RECORDS ARE STANDARD -warning: LABEL RECORDS is obsolete in GnuCOBOL -000043 BLOCK CONTAINS 80 CHARACTERS -000044 DATA RECORD IS OLD-RECORD. -warning: DATA RECORDS is obsolete in GnuCOBOL -000045 -000046 01 OLD-RECORD. -000047 02 OLD-STATEMENT PICTURE X(75). -000048 02 OLD-NUMBER PICTURE X(5). -000049 -000050 FD NEW-VERSION -000051 LABEL RECORDS ARE STANDARD -warning: LABEL RECORDS is obsolete in GnuCOBOL -000052 BLOCK CONTAINS 80 CHARACTERS -000053 DATA RECORD IS NEW-RECORD. -warning: DATA RECORDS is obsolete in GnuCOBOL -000054 -000055 01 NEW-RECORD. -000056 02 NEW-STATEMENT PICTURE X(75). -000057 02 NEW-NUMBER PICTURE X(5). -000058 -000059 FD MODIFICATION -000060 LABEL RECORDS ARE OMITTED -warning: LABEL RECORDS is obsolete in GnuCOBOL -000061 BLOCK CONTAINS 80 CHARACTERS -000062 DATA RECORD IS UPDATE-ORDER. -warning: DATA RECORDS is obsolete in GnuCOBOL -000063 -000064 01 UPDATE-ORDER. -000065 02 INSERTION. -000066 03 COMMAND PICTURE X(6). -000067 88 ENDJOB VALUE "ENDJOB". -000068 88 ENDSET VALUE "ENDSET". -000069 88 REMOVE VALUE "REMOVE". -000070 88 ADDNEW VALUE "INSERT". -000071 88 CHANGE VALUE "CHANGE". -000072 88 DISPLY VALUE "DISPLY". -000073 03 FILLER PICTURE X. -000074 03 A-FIELD PICTURE 9(5). -000075 03 A-ALPHA REDEFINES A-FIELD PICTURE X(5). -000076 88 A-BLANK VALUE SPACES. -000077 03 FILLER PICTURE X(4). -000078 03 B-FIELD PICTURE 9(5). -000079 03 B-ALPHA REDEFINES B-FIELD PICTURE X(5). -000080 88 B-BLANK VALUE SPACES. -000081 03 FILLER PICTURE X(54). -000082 02 FILLER PICTURE X(5). -000083 -000084 FD COMMENTARY -000085 LABEL RECORDS ARE OMITTED -warning: LABEL RECORDS is obsolete in GnuCOBOL -000086 BLOCK CONTAINS 82 CHARACTERS -000087 DATA RECORD IS COMMENT-LINE. -warning: DATA RECORDS is obsolete in GnuCOBOL -000088 -000089 01 COMMENT-LINE. -000090 02 FILLER PICTURE X(82). -000091 -000092 WORKING-STORAGE SECTION. -000093 -000094 77 COMMAND-ADDITIONS PICTURE 9(3) COMPUTATIONAL VALUE 0. -000095 77 COMMAND-SUBTRACTIONS PICTURE 9(3) COMPUTATIONAL VALUE 0. -000096 77 TOTAL-INSERTED PICTURE 9(3) COMPUTATIONAL VALUE 0. -000097 77 TOTAL-DELETED PICTURE 9(3) COMPUTATIONAL VALUE 0. -000098 77 OUTPUT-COUNT PICTURE 9(5) COMPUTATIONAL VALUE 0. -000099 77 LINE-COUNT PICTURE 9(2) COMPUTATIONAL VALUE 0. -000100 77 FIELDA PICTURE 9(5) VALUE 0. -000101 77 FIELDB PICTURE 9(5) VALUE 0. -000102 77 BLANK-LINE PICTURE X(82) VALUE SPACES. -000103 -000104 01 DATE-FROM-SYS. -000105 02 DFSYS OCCURS 3 TIMES PICTURE 99. -000106 -000107 01 HEADINGS-LINE. -000108 02 FILLER PICTURE X(15) VALUE "EDITOR VERSION". -000109 02 FILLER PICTURE X(20) VALUE "1.1 - 206/72". -000110 02 PHASE PICTURE X(17) VALUE "UPDATING AS OF". -000111 02 MONTH-RUN PICTURE XX. -000112 02 FILLER PICTURE X VALUE "/". -000113 02 DAY-RUN PICTURE XX. -000114 02 FILLER PICTURE X VALUE "/". -000115 02 YEAR-RUN PICTURE XX. -000116 02 FILLER PICTURE X(8) VALUE SPACES. -000117 02 FILLER PICTURE X(8) VALUE " PAGE: ". -000118 02 PAGE-NUMBER PICTURE 9(4) VALUE 0. -000119 -000120 01 COMMAND-LISTING. -000121 02 FILLER PICTURE X(2) VALUE SPACES. -000122 02 COMMAND-IMAGE PICTURE X(80). -000123 -000124 01 ACTIVITIES-LISTING. -000125 02 DISPOSITION PICTURE X(2). -000126 02 ACTIVE-IMAGE PICTURE X(80). -000127 -000128 01 UPSI-BYTE. -000129 02 UPSI-BIT OCCURS 8 TIMES PICTURE X. -000130 -000131 01 MESSAGE-LOG. -000132 02 FILLER PICTURE X(2) VALUE SPACES. -000133 02 MESSAGE-TEXT PICTURE X(80). -000134 -000135 01 DISPLAY-MESSAGE. -000136 02 FILLER PICTURE X(2) VALUE SPACES. -000137 02 DISPLAY-TEMP PICTURE X(6). -000138 02 FILLER PICTURE X(2) VALUE SPACES. -000139 02 DISPLAY-TEXT PICTURE X(60). -000140 -000141 77 END-JOB-PROCESS PICTURE 9 VALUE 0. -000142 77 DELETE-PROCESS PICTURE 9 VALUE 1. -000143 77 INSERT-PROCESS PICTURE 9 VALUE 2. -000144 77 WRITE-PROCESS PICTURE 9 VALUE 3. -000145 -000146 01 SELECTORS. -000147 02 RETURN-SELECT PICTURE 9 VALUE 0. -000148 02 NEXT-JOB-SELECT PICTURE 9 VALUE 0. -000149 -000150 PROCEDURE DIVISION. -000151 -000152 START-SECTION. -000153 OPEN INPUT OLD-VERSION, MODIFICATION, -000154 OUTPUT NEW-VERSION, COMMENTARY. -000155 MOVE "F" TO UPSI-BIT (1), UPSI-BIT (2). -000156 ACCEPT DATE-FROM-SYS FROM DATE. -000157 MOVE DFSYS (1) TO YEAR-RUN. -000158 MOVE DFSYS (2) TO MONTH-RUN. -000159 MOVE DFSYS (3) TO DAY-RUN. -000160 READ OLD-VERSION AT END -000161 MOVE "NO OLD VERSION FOUND" TO MESSAGE-TEXT -000162 WRITE COMMENT-LINE FROM MESSAGE-LOG -000163 GO TO END-JOB. -000164 MOVE OLD-STATEMENT TO NEW-STATEMENT. -000165 PERFORM OUTPUT-A-RECORD. -000166 -000167 TOP-OF-PAGE-ROUTINE. -000168 ADD 1 TO PAGE-NUMBER. -000169 MOVE ZERO TO LINE-COUNT. -000170 WRITE COMMENT-LINE FROM HEADINGS-LINE AFTER PAGE. -000171 WRITE COMMENT-LINE FROM BLANK-LINE. -000172 -000173 READ-A-COMMAND. -000174 READ MODIFICATION AT END -000175 MOVE "MODIFICATION FILE ENDED " TO MESSAGE-TEXT -000176 WRITE COMMENT-LINE FROM MESSAGE-LOG -000177 GO TO FINISH-JOB. -000178 MOVE UPDATE-ORDER TO COMMAND-IMAGE. -000179 WRITE COMMENT-LINE FROM COMMAND-LISTING. -000180 ADD 2 TO LINE-COUNT. -000181 IF A-BLANK MOVE ZEROES TO A-FIELD. -000182 IF B-BLANK MOVE ZEROES TO B-FIELD. -000183 MOVE A-FIELD TO FIELDA. -000184 MOVE B-FIELD TO FIELDB. -000185 -000186 TEST-COMMAND-TYPE. -000187 IF CHANGE GO TO CHANGE-A-RECORD. -000188 IF REMOVE GO TO DELETE-A-RECORD. -000189 IF DISPLY MOVE "T" TO UPSI-BIT (2) -000190 GO TO FINISH-JOB. -000191 IF ENDJOB GO TO FINISH-JOB. -000192 IF ADDNEW GO TO INSERT-A-RECORD. -000193 MOVE "INVALID COMMAND IGNORED." TO MESSAGE-TEXT. -000194 WRITE COMMENT-LINE FROM MESSAGE-LOG. -000195 GO TO READ-A-COMMAND. -000196 -000197 CHANGE-A-RECORD. -000198 ALTER RETURN-TO-USER TO PROCEED TO INSERTION-PROCESS. -warning: ALTER is obsolete in GnuCOBOL -000199 ALTER NEXT-JOB-STEP TO PROCEED TO DELETION-PROCESS. -warning: ALTER is obsolete in GnuCOBOL -000200 -000201 FIND-FIELDA. -000202 IF OLD-NUMBER IS GREATER THAN FIELDA -000203 MOVE "RECORD ALREADY PASSED" TO MESSAGE-TEXT -000204 WRITE COMMENT-LINE FROM MESSAGE-LOG -000205 GO TO READ-A-COMMAND. -000206 READ OLD-VERSION AT END -000207 MOVE "NOT FOUND IN OLD VERSION" TO DISPLAY-TEXT -000208 MOVE FIELDA TO DISPLAY-TEMP -000209 WRITE COMMENT-LINE FROM DISPLAY-MESSAGE -000210 GO TO END-JOB. -000211 IF OLD-NUMBER IS LESS THAN FIELDA -000212 MOVE OLD-STATEMENT TO NEW-STATEMENT -000213 PERFORM OUTPUT-A-RECORD -000214 GO TO FIND-FIELDA. -000215 -000216 RETURN-TO-USER. -000217 GO TO END-JOB. -000218 -000219 INSERT-A-RECORD. -000220 ALTER RETURN-TO-USER TO PROCEED TO INSERTION-PROCESS. -warning: ALTER is obsolete in GnuCOBOL -000221 ALTER NEXT-JOB-STEP TO PROCEED TO FORCED-WRITE. -warning: ALTER is obsolete in GnuCOBOL -000222 GO TO FIND-FIELDA. -000223 -000224 INSERTION-PROCESS. -000225 READ MODIFICATION AT END -000226 MOVE "NO ENDSET FOUND" TO MESSAGE-TEXT -000227 WRITE COMMENT-LINE FROM MESSAGE-LOG -000228 GO TO END-JOB. -000229 IF ENDSET -000230 MOVE COMMAND-ADDITIONS TO DISPLAY-TEMP -000231 MOVE "RECORDS INSERTED." TO DISPLAY-TEXT -000232 WRITE COMMENT-LINE FROM DISPLAY-MESSAGE -000233 ADD COMMAND-ADDITIONS TO TOTAL-INSERTED -000234 MOVE ZEROES TO COMMAND-ADDITIONS -000235 GO TO NEXT-JOB-STEP. -000236 MOVE INSERTION TO NEW-STATEMENT, ACTIVE-IMAGE. -000237 MOVE "I " TO DISPOSITION. -000238 PERFORM OUTPUT-A-RECORD. -000239 WRITE COMMENT-LINE FROM ACTIVITIES-LISTING. -000240 ADD 1 TO COMMAND-ADDITIONS. -000241 ADD 1 TO LINE-COUNT. -000242 IF LINE-COUNT EQUAL 56 PERFORM TOP-OF-PAGE-ROUTINE. -000243 GO TO INSERTION-PROCESS. -000244 -000245 NEXT-JOB-STEP. -000246 GO TO END-JOB. -000247 -000248 FORCED-WRITE. -000249 MOVE OLD-STATEMENT TO NEW-STATEMENT. -000250 PERFORM OUTPUT-A-RECORD. -000251 GO TO READ-A-COMMAND. -000252 -000253 DELETE-A-RECORD. -000254 ALTER RETURN-TO-USER TO PROCEED TO DELETION-PROCESS. -warning: ALTER is obsolete in GnuCOBOL -000255 GO TO FIND-FIELDA. -000256 -000257 DELETION-PROCESS. -000258 MOVE OLD-RECORD TO ACTIVE-IMAGE. -000259 MOVE "D " TO DISPOSITION. -000260 WRITE COMMENT-LINE FROM ACTIVITIES-LISTING. -000261 ADD 1 TO LINE-COUNT. -000262 IF LINE-COUNT EQUAL 56 PERFORM TOP-OF-PAGE-ROUTINE. -000263 ADD 1 TO COMMAND-SUBTRACTIONS. -000264 IF OLD-NUMBER IS NOT LESS THAN FIELDB -000265 MOVE COMMAND-SUBTRACTIONS TO DISPLAY-TEMP -000266 MOVE "RECORDS DELETED." TO DISPLAY-TEXT -000267 WRITE COMMENT-LINE FROM DISPLAY-MESSAGE -000268 ADD COMMAND-SUBTRACTIONS TO TOTAL-DELETED -000269 MOVE OLD-STATEMENT TO NEW-STATEMENT -000270 MOVE ZEROES TO COMMAND-SUBTRACTIONS -000271 GO TO READ-A-COMMAND. -000272 READ OLD-VERSION AT END -000273 MOVE "NOT FOUND IN OLD VERSION DOING DELETE" -000274 TO DISPLAY-TEXT -000275 WRITE COMMENT-LINE FROM DISPLAY-MESSAGE -000276 GO TO END-JOB. -000277 GO TO DELETION-PROCESS. -000278 -000279 OUTPUT-A-RECORD. -000280 ADD 1 TO OUTPUT-COUNT. -000281 MOVE OUTPUT-COUNT TO NEW-NUMBER. -000282 WRITE NEW-RECORD. -000283 -000284 FINISH-JOB. -000285 READ OLD-VERSION AT END GO TO TEST-FOR-LISTING. -000286 MOVE OLD-STATEMENT TO NEW-STATEMENT. -000287 GO TO OUTPUT-A-RECORD. -000288 -000289 TEST-FOR-LISTING. -000290 PERFORM TOP-OF-PAGE-ROUTINE. -000291 MOVE OLD-NUMBER TO DISPLAY-TEMP. -000292 MOVE "RECORDS READ." TO DISPLAY-TEXT. -000293 WRITE COMMENT-LINE FROM DISPLAY-MESSAGE. -000294 MOVE TOTAL-INSERTED TO DISPLAY-TEMP. -000295 MOVE "RECORDS ADDED." TO DISPLAY-TEXT. -000296 WRITE COMMENT-LINE FROM DISPLAY-MESSAGE. -000297 MOVE TOTAL-DELETED TO DISPLAY-TEMP. -000298 MOVE "RECORDS DROPPED." TO DISPLAY-TEXT. -000299 WRITE COMMENT-LINE FROM DISPLAY-MESSAGE. -000300 MOVE OUTPUT-COUNT TO DISPLAY-TEMP. -000301 MOVE "RECORDS IN NEW FILE." TO DISPLAY-TEXT. -000302 WRITE COMMENT-LINE FROM DISPLAY-MESSAGE. -000303 IF UPSI-BIT (2) EQUAL "F" GO TO END-JOB. -000304 CLOSE NEW-VERSION. -000305 OPEN INPUT NEW-VERSION. -000306 MOVE "UPDATED LISTING" TO PHASE. -000307 MOVE ZEROES TO PAGE-NUMBER. -000308 PERFORM TOP-OF-PAGE-ROUTINE. -000309 MOVE SPACES TO DISPOSITION. -000310 -000311 LISTING-LOOP. -000312 READ NEW-VERSION AT END GO TO END-JOB. -000313 MOVE NEW-RECORD TO ACTIVE-IMAGE. -000314 WRITE COMMENT-LINE FROM ACTIVITIES-LISTING. -000315 ADD 1 TO LINE-COUNT. -000316 IF LINE-COUNT EQUAL 56 PERFORM TOP-OF-PAGE-ROUTINE. -000317 GO TO LISTING-LOOP. -000318 -000319 END-JOB. -000320 MOVE "PROGRAM TERMINATION" TO MESSAGE-TEXT. -000321 WRITE COMMENT-LINE FROM MESSAGE-LOG. -000322 CLOSE OLD-VERSION, NEW-VERSION, MODIFICATION, COMMENTARY. -000323 STOP RUN. -000324 -000325 END PROGRAM EDITOR. - -SIZE TYPE LVL NAME PICTURE - -00080 FILE OLD-VERSION -00080 GROUP 01 OLD-RECORD -00075 ALPHANUMERIC 02 OLD-STATEMENT X(75) -00005 ALPHANUMERIC 02 OLD-NUMBER X(5) - -00080 FILE NEW-VERSION -00080 GROUP 01 NEW-RECORD -00075 ALPHANUMERIC 02 NEW-STATEMENT X(75) -00005 ALPHANUMERIC 02 NEW-NUMBER X(5) - -00032 FILE PRT-VERSION - -00080 FILE MODIFICATION -00080 GROUP 01 UPDATE-ORDER -00075 GROUP 02 INSERTION -00006 ALPHANUMERIC 03 COMMAND X(6) - CONDITIONAL 88 ENDJOB - CONDITIONAL 88 ENDSET - CONDITIONAL 88 REMOVE - CONDITIONAL 88 ADDNEW - CONDITIONAL 88 CHANGE - CONDITIONAL 88 DISPLY -00001 ALPHANUMERIC 03 FILLER X -00005 NUMERIC 03 A-FIELD 9(5) -00005 ALPHANUMERIC 03 A-ALPHA X(5), REDEFINES A-FIELD - CONDITIONAL 88 A-BLANK -00004 ALPHANUMERIC 03 FILLER X(4) -00005 NUMERIC 03 B-FIELD 9(5) -00005 ALPHANUMERIC 03 B-ALPHA X(5), REDEFINES B-FIELD - CONDITIONAL 88 B-BLANK -00054 ALPHANUMERIC 03 FILLER X(54) -00005 ALPHANUMERIC 02 FILLER X(5) - -00082 FILE COMMENTARY -00082 GROUP 01 COMMENT-LINE -00082 ALPHANUMERIC 02 FILLER X(82) - - WORKING-STORAGE SECTION - -00002 NUMERIC 77 COMMAND-ADDITIONS 9(3) COMP -00002 NUMERIC 77 COMMAND-SUBTRACTIONS 9(3) COMP -00002 NUMERIC 77 TOTAL-INSERTED 9(3) COMP -00002 NUMERIC 77 TOTAL-DELETED 9(3) COMP -00004 NUMERIC 77 OUTPUT-COUNT 9(5) COMP -00001 NUMERIC 77 LINE-COUNT 9(2) COMP -00005 NUMERIC 77 FIELDA 9(5) -00005 NUMERIC 77 FIELDB 9(5) -00082 ALPHANUMERIC 77 BLANK-LINE X(82) - -00006 GROUP 01 DATE-FROM-SYS -00002 NUMERIC 02 DFSYS 99, OCCURS 3 - -00080 GROUP 01 HEADINGS-LINE -00015 ALPHANUMERIC 02 FILLER X(15) -00020 ALPHANUMERIC 02 FILLER X(20) -00017 ALPHANUMERIC 02 PHASE X(17) -00002 ALPHANUMERIC 02 MONTH-RUN XX -00001 ALPHANUMERIC 02 FILLER X -00002 ALPHANUMERIC 02 DAY-RUN XX -00001 ALPHANUMERIC 02 FILLER X -00002 ALPHANUMERIC 02 YEAR-RUN XX -00008 ALPHANUMERIC 02 FILLER X(8) -00008 ALPHANUMERIC 02 FILLER X(8) -00004 NUMERIC 02 PAGE-NUMBER 9(4) - -00082 GROUP 01 COMMAND-LISTING -00002 ALPHANUMERIC 02 FILLER X(2) -00080 ALPHANUMERIC 02 COMMAND-IMAGE X(80) - -00082 GROUP 01 ACTIVITIES-LISTING -00002 ALPHANUMERIC 02 DISPOSITION X(2) -00080 ALPHANUMERIC 02 ACTIVE-IMAGE X(80) - -00008 GROUP 01 UPSI-BYTE -00001 ALPHANUMERIC 02 UPSI-BIT X, OCCURS 8 - -00082 GROUP 01 MESSAGE-LOG -00002 ALPHANUMERIC 02 FILLER X(2) -00080 ALPHANUMERIC 02 MESSAGE-TEXT X(80) - -00070 GROUP 01 DISPLAY-MESSAGE -00002 ALPHANUMERIC 02 FILLER X(2) -00006 ALPHANUMERIC 02 DISPLAY-TEMP X(6) -00002 ALPHANUMERIC 02 FILLER X(2) -00060 ALPHANUMERIC 02 DISPLAY-TEXT X(60) - -00001 NUMERIC 77 END-JOB-PROCESS 9 -00001 NUMERIC 77 DELETE-PROCESS 9 -00001 NUMERIC 77 INSERT-PROCESS 9 -00001 NUMERIC 77 WRITE-PROCESS 9 - -00002 GROUP 01 SELECTORS -00001 NUMERIC 02 RETURN-SELECT 9 -00001 NUMERIC 02 NEXT-JOB-SELECT 9 - - -NAME DEFINED REFERENCES - -OLD-VERSION 26 41 153 160 206 272 - 285 322 -OLD-RECORD 46 44 258 -OLD-STATEMENT 47 164 212 249 269 286 -OLD-NUMBER 48 202 211 264 291 - -NEW-VERSION 28 50 *154 *282 304 305 - 312 322 -NEW-RECORD 55 53 282 313 -NEW-STATEMENT 56 *164 *212 *236 *249 *269 - *286 -NEW-NUMBER 57 *281 - -PRT-VERSION 30 not referenced - -MODIFICATION 32 59 153 174 225 322 -UPDATE-ORDER 64 62 178 -INSERTION 65 236 -COMMAND 66 referenced by parent/child -ENDJOB 67 191 -ENDSET 68 229 -REMOVE 69 188 -ADDNEW 70 192 -CHANGE 71 187 -DISPLY 72 189 -A-FIELD 74 *181 183 -A-ALPHA 75 referenced by parent/child -A-BLANK 76 181 -B-FIELD 78 *182 184 -B-ALPHA 79 referenced by parent/child -B-BLANK 80 182 - -COMMENTARY 34 84 *154 *162 *170 *171 - *176 *179 *194 *204 *209 - *227 *232 *239 *260 *267 - *275 *293 *296 *299 *302 - *314 *321 322 -COMMENT-LINE 89 87 *162 *170 *171 *176 - *179 *194 *204 *209 *227 - *232 *239 *260 *267 *275 - *293 *296 *299 *302 *314 - *321 - -COMMAND-ADDITIONS 94 230 233 *234 240 -COMMAND-SUBTRACTIONS 95 263 265 268 *270 -TOTAL-INSERTED 96 233 294 -TOTAL-DELETED 97 268 297 -OUTPUT-COUNT 98 280 281 300 -LINE-COUNT 99 *169 180 241 242 261 - 262 315 316 -FIELDA 100 *183 202 208 211 -FIELDB 101 *184 264 -BLANK-LINE 102 171 -DATE-FROM-SYS 104 *156 -DFSYS 105 157 158 159 -HEADINGS-LINE 107 170 -PHASE 110 *306 -MONTH-RUN 111 *158 -DAY-RUN 113 *159 -YEAR-RUN 115 *157 -PAGE-NUMBER 118 168 *307 -COMMAND-LISTING 120 179 -COMMAND-IMAGE 122 *178 -ACTIVITIES-LISTING 124 239 260 314 -DISPOSITION 125 *237 *259 *309 -ACTIVE-IMAGE 126 *236 *258 *313 -UPSI-BYTE 128 referenced by child -UPSI-BIT 129 *155 *189 303 -MESSAGE-LOG 131 162 176 194 204 227 - 321 -MESSAGE-TEXT 133 *161 *175 *193 *203 *226 - *320 -DISPLAY-MESSAGE 135 209 232 267 275 293 - 296 299 302 -DISPLAY-TEMP 137 *208 *230 *265 *291 *294 - *297 *300 -DISPLAY-TEXT 139 *207 *231 *266 *274 *292 - *295 *298 *301 -END-JOB-PROCESS 141 not referenced -DELETE-PROCESS 142 not referenced -INSERT-PROCESS 143 not referenced -WRITE-PROCESS 144 not referenced -SELECTORS 146 not referenced -RETURN-SELECT 147 not referenced -NEXT-JOB-SELECT 148 not referenced - - -LABEL DEFINED REFERENCES - -E EDITOR 150 -P START-SECTION 152 not referenced -P TOP-OF-PAGE-ROUTINE 167 242 262 290 308 316 -P READ-A-COMMAND 173 195 205 251 271 -P TEST-COMMAND-TYPE 186 not referenced -P CHANGE-A-RECORD 197 187 -P FIND-FIELDA 201 214 222 255 -P RETURN-TO-USER 216 198 220 254 -P INSERT-A-RECORD 219 192 -P INSERTION-PROCESS 224 198 220 243 -P NEXT-JOB-STEP 245 199 221 235 -P FORCED-WRITE 248 221 -P DELETE-A-RECORD 253 188 -P DELETION-PROCESS 257 199 254 277 -P OUTPUT-A-RECORD 279 165 213 238 250 287 -P FINISH-JOB 284 177 190 191 -P TEST-FOR-LISTING 289 285 -P LISTING-LOOP 311 317 -P END-JOB 319 163 210 217 228 246 - 276 303 312 - - -Error/Warning summary: - -EDITOR.cob:42: warning: LABEL RECORDS is obsolete in GnuCOBOL -EDITOR.cob:44: warning: DATA RECORDS is obsolete in GnuCOBOL -EDITOR.cob:51: warning: LABEL RECORDS is obsolete in GnuCOBOL -EDITOR.cob:53: warning: DATA RECORDS is obsolete in GnuCOBOL -EDITOR.cob:60: warning: LABEL RECORDS is obsolete in GnuCOBOL -EDITOR.cob:62: warning: DATA RECORDS is obsolete in GnuCOBOL -EDITOR.cob:85: warning: LABEL RECORDS is obsolete in GnuCOBOL -EDITOR.cob:87: warning: DATA RECORDS is obsolete in GnuCOBOL -EDITOR.cob:30: error: missing file description for FILE PRT-VERSION -EDITOR.cob:198: warning: ALTER is obsolete in GnuCOBOL -EDITOR.cob:199: warning: ALTER is obsolete in GnuCOBOL -EDITOR.cob:220: warning: ALTER is obsolete in GnuCOBOL -EDITOR.cob:221: warning: ALTER is obsolete in GnuCOBOL -EDITOR.cob:254: warning: ALTER is obsolete in GnuCOBOL - -13 warnings in compilation group -1 error in compilation group -]) - -AT_CHECK([gcdiff -IGnuCOBOL prog18.lst prog.lst], [0], [], []) - -AT_CHECK([$COMPILE_ONLY -Xref -T prog.lst -tlines=0 -tsymbols EDITOR.cob], [1], [], -[EDITOR.cob:42: warning: LABEL RECORDS is obsolete in GnuCOBOL -EDITOR.cob:44: warning: DATA RECORDS is obsolete in GnuCOBOL -EDITOR.cob:51: warning: LABEL RECORDS is obsolete in GnuCOBOL -EDITOR.cob:53: warning: DATA RECORDS is obsolete in GnuCOBOL -EDITOR.cob:60: warning: LABEL RECORDS is obsolete in GnuCOBOL -EDITOR.cob:62: warning: DATA RECORDS is obsolete in GnuCOBOL -EDITOR.cob:85: warning: LABEL RECORDS is obsolete in GnuCOBOL -EDITOR.cob:87: warning: DATA RECORDS is obsolete in GnuCOBOL -EDITOR.cob:30: error: missing file description for FILE PRT-VERSION -EDITOR.cob: in paragraph 'CHANGE-A-RECORD': -EDITOR.cob:198: warning: ALTER is obsolete in GnuCOBOL -EDITOR.cob:199: warning: ALTER is obsolete in GnuCOBOL -EDITOR.cob: in paragraph 'INSERT-A-RECORD': -EDITOR.cob:220: warning: ALTER is obsolete in GnuCOBOL -EDITOR.cob:221: warning: ALTER is obsolete in GnuCOBOL -EDITOR.cob: in paragraph 'DELETE-A-RECORD': -EDITOR.cob:254: warning: ALTER is obsolete in GnuCOBOL -]) - - -AT_DATA([prog19.lst], -[GnuCOBOL V.R.P EDITOR.cob DDD MMM dd HH:MM:SS YYYY - -LINE PG/LN A...B............................................................SEQUENCE - -000001 -000002 IDENTIFICATION DIVISION. EDIT0001 -000003 PROGRAM-ID. EDIT0002 -000004 EDITOR. EDIT0003 -000005 EDIT0008 -000006 *NOTE. EDIT0009 -000007 * THIS VERSION OF EDITOR 1 COMPRISES AN ENTIRE RE_WRITE EDIT0010 -000008 * OF THE BASIC EDITOR WITH ONLY ONE CHANGE IN THE COMMAND EDIT0011 -000009 * STRUCTURE, THAT BEING THE ADDITION OF A "CHANGE" COMMAND EDIT0012 -000010 * TO SERVE IN PLACE OF THE INSERT-DELETE COMBINATION WHICH EDIT0013 -000011 * WAS REQUIRED IN PREVIOUS VERSIONS. RECORD NUMBER FIELDS EDIT0014 -000012 * HAVE ALSO BEEN REDUCED FROM 5 DIGITS TO 4. EDIT0015 -000013 * CHANGE 1. EDIT0016 -000014 * MODIFY TO RUN ON TI-990. EDIT0017 -000015 * CHANGE 2. EDIT0018 -000016 * MODIFY TO RUN ON GNUCOBOL. EDIT0019 -000017 EDIT0020 -000018 ENVIRONMENT DIVISION. EDIT0021 -000019 CONFIGURATION SECTION. EDIT0022 -000020 SOURCE-COMPUTER. EDIT0023 -000021 IBM-360. EDIT0024 -000022 OBJECT-COMPUTER. EDIT0025 -000023 IBM-360. EDIT0026 -000024 INPUT-OUTPUT SECTION. EDIT0027 -000025 FILE-CONTROL. EDIT0028 -000026 SELECT OLD-VERSION ASSIGN TO "SYSUT1" EDIT0029 -000027 ORGANIZATION LINE SEQUENTIAL. EDIT0030 -000028 SELECT NEW-VERSION ASSIGN TO "SYSUT2" EDIT0031 -000029 ORGANIZATION LINE SEQUENTIAL. EDIT0032 -000030 SELECT PRT-VERSION ASSIGN TO "SYSUT2" EDIT0033 -error: missing file description for FILE PRT-VERSION -000031 ORGANIZATION LINE SEQUENTIAL. EDIT0034 -000032 SELECT MODIFICATION ASSIGN TO "SYSIN1" EDIT0035 -000033 ORGANIZATION LINE SEQUENTIAL. EDIT0036 -000034 SELECT COMMENTARY ASSIGN TO "SYSOU1" EDIT0037 -000035 ORGANIZATION LINE SEQUENTIAL. EDIT0038 -000036 EDIT0039 -000037 DATA DIVISION. EDIT0040 -000038 EDIT0041 -000039 FILE SECTION. EDIT0042 -000040 EDIT0043 -000041 FD OLD-VERSION EDIT0044 -000042 LABEL RECORDS ARE STANDARD EDIT0045 -warning: LABEL RECORDS is obsolete in GnuCOBOL -000043 BLOCK CONTAINS 80 CHARACTERS EDIT0046 -000044 DATA RECORD IS OLD-RECORD. EDIT0047 -warning: DATA RECORDS is obsolete in GnuCOBOL -000045 EDIT0048 -000046 01 OLD-RECORD. EDIT0049 -000047 02 OLD-STATEMENT PICTURE X(75). EDIT0050 -000048 02 OLD-NUMBER PICTURE X(5). EDIT0051 -000049 EDIT0052 -000050 FD NEW-VERSION EDIT0053 -000051 LABEL RECORDS ARE STANDARD EDIT0054 -warning: LABEL RECORDS is obsolete in GnuCOBOL -000052 BLOCK CONTAINS 80 CHARACTERS EDIT0055 -000053 DATA RECORD IS NEW-RECORD. EDIT0056 -warning: DATA RECORDS is obsolete in GnuCOBOL -000054 EDIT0057 -000055 01 NEW-RECORD. EDIT0058 -000056 02 NEW-STATEMENT PICTURE X(75). EDIT0059 -000057 02 NEW-NUMBER PICTURE X(5). EDIT0060 -000058 EDIT0061 -000059 FD MODIFICATION EDIT0062 -000060 LABEL RECORDS ARE OMITTED EDIT0063 -warning: LABEL RECORDS is obsolete in GnuCOBOL -000061 BLOCK CONTAINS 80 CHARACTERS EDIT0064 -000062 DATA RECORD IS UPDATE-ORDER. EDIT0065 -warning: DATA RECORDS is obsolete in GnuCOBOL -000063 EDIT0066 -000064 01 UPDATE-ORDER. EDIT0067 -000065 02 INSERTION. EDIT0068 -000066 03 COMMAND PICTURE X(6). EDIT0069 -000067 88 ENDJOB VALUE "ENDJOB". EDIT0070 -000068 88 ENDSET VALUE "ENDSET". EDIT0071 -000069 88 REMOVE VALUE "REMOVE". EDIT0072 -000070 88 ADDNEW VALUE "INSERT". EDIT0073 -000071 88 CHANGE VALUE "CHANGE". EDIT0074 -000072 88 DISPLY VALUE "DISPLY". EDIT0075 -000073 03 FILLER PICTURE X. EDIT0076 -000074 03 A-FIELD PICTURE 9(5). EDIT0077 -000075 03 A-ALPHA REDEFINES A-FIELD PICTURE X(5). EDIT0078 -000076 88 A-BLANK VALUE SPACES. EDIT0079 -000077 03 FILLER PICTURE X(4). EDIT0080 -000078 03 B-FIELD PICTURE 9(5). EDIT0081 -000079 03 B-ALPHA REDEFINES B-FIELD PICTURE X(5). EDIT0082 -000080 88 B-BLANK VALUE SPACES. EDIT0083 -000081 03 FILLER PICTURE X(54). EDIT0084 -000082 02 FILLER PICTURE X(5). EDIT0085 -000083 EDIT0086 -000084 FD COMMENTARY EDIT0087 -000085 LABEL RECORDS ARE OMITTED EDIT0088 -warning: LABEL RECORDS is obsolete in GnuCOBOL -000086 BLOCK CONTAINS 82 CHARACTERS EDIT0089 -000087 DATA RECORD IS COMMENT-LINE. EDIT0090 -warning: DATA RECORDS is obsolete in GnuCOBOL -000088 EDIT0091 -000089 01 COMMENT-LINE. EDIT0092 -000090 02 FILLER PICTURE X(82). EDIT0093 -000091 EDIT0094 -000092 WORKING-STORAGE SECTION. EDIT0095 -000093 EDIT0096 -000094 77 COMMAND-ADDITIONS PICTURE 9(3) COMPUTATIONAL VALUE 0. EDIT0097 -000095 77 COMMAND-SUBTRACTIONS PICTURE 9(3) COMPUTATIONAL VALUE 0. EDIT0098 -000096 77 TOTAL-INSERTED PICTURE 9(3) COMPUTATIONAL VALUE 0. EDIT0099 -000097 77 TOTAL-DELETED PICTURE 9(3) COMPUTATIONAL VALUE 0. EDIT0100 -000098 77 OUTPUT-COUNT PICTURE 9(5) COMPUTATIONAL VALUE 0. EDIT0101 -000099 77 LINE-COUNT PICTURE 9(2) COMPUTATIONAL VALUE 0. EDIT0102 -000100 77 FIELDA PICTURE 9(5) VALUE 0. EDIT0103 -000101 77 FIELDB PICTURE 9(5) VALUE 0. EDIT0104 -000102 77 BLANK-LINE PICTURE X(82) VALUE SPACES. EDIT0105 -000103 EDIT0106 -000104 01 DATE-FROM-SYS. EDIT0107 -000105 02 DFSYS OCCURS 3 TIMES PICTURE 99. EDIT0108 -000106 EDIT0109 -000107 01 HEADINGS-LINE. EDIT0110 -000108 02 FILLER PICTURE X(15) VALUE "EDITOR VERSION". EDIT0111 -000109 02 FILLER PICTURE X(20) VALUE "1.1 - 206/72". EDIT0112 -000110 02 PHASE PICTURE X(17) VALUE "UPDATING AS OF". EDIT0113 -000111 02 MONTH-RUN PICTURE XX. EDIT0114 -000112 02 FILLER PICTURE X VALUE "/". EDIT0115 -000113 02 DAY-RUN PICTURE XX. EDIT0116 -000114 02 FILLER PICTURE X VALUE "/". EDIT0117 -000115 02 YEAR-RUN PICTURE XX. EDIT0118 -000116 02 FILLER PICTURE X(8) VALUE SPACES. EDIT0119 -000117 02 FILLER PICTURE X(8) VALUE " PAGE: ". EDIT0120 -000118 02 PAGE-NUMBER PICTURE 9(4) VALUE 0. EDIT0121 -000119 EDIT0122 -000120 01 COMMAND-LISTING. EDIT0123 -000121 02 FILLER PICTURE X(2) VALUE SPACES. EDIT0124 -000122 02 COMMAND-IMAGE PICTURE X(80). EDIT0125 -000123 EDIT0126 -000124 01 ACTIVITIES-LISTING. EDIT0127 -000125 02 DISPOSITION PICTURE X(2). EDIT0128 -000126 02 ACTIVE-IMAGE PICTURE X(80). EDIT0129 -000127 EDIT0130 -000128 01 UPSI-BYTE. EDIT0131 -000129 02 UPSI-BIT OCCURS 8 TIMES PICTURE X. EDIT0132 -000130 EDIT0133 -000131 01 MESSAGE-LOG. EDIT0134 -000132 02 FILLER PICTURE X(2) VALUE SPACES. EDIT0135 -000133 02 MESSAGE-TEXT PICTURE X(80). EDIT0136 -000134 EDIT0137 -000135 01 DISPLAY-MESSAGE. EDIT0138 -000136 02 FILLER PICTURE X(2) VALUE SPACES. EDIT0139 -000137 02 DISPLAY-TEMP PICTURE X(6). EDIT0140 -000138 02 FILLER PICTURE X(2) VALUE SPACES. EDIT0141 -000139 02 DISPLAY-TEXT PICTURE X(60). EDIT0142 -000140 EDIT0143 -000141 77 END-JOB-PROCESS PICTURE 9 VALUE 0. EDIT0144 -000142 77 DELETE-PROCESS PICTURE 9 VALUE 1. EDIT0145 -000143 77 INSERT-PROCESS PICTURE 9 VALUE 2. EDIT0146 -000144 77 WRITE-PROCESS PICTURE 9 VALUE 3. EDIT0147 -000145 EDIT0148 -000146 01 SELECTORS. EDIT0149 -000147 02 RETURN-SELECT PICTURE 9 VALUE 0. EDIT0150 -000148 02 NEXT-JOB-SELECT PICTURE 9 VALUE 0. EDIT0151 -000149 EDIT0152 -000150 PROCEDURE DIVISION. EDIT0153 -000151 EDIT0154 -000152 START-SECTION. EDIT0155 -000153 OPEN INPUT OLD-VERSION, MODIFICATION, EDIT0156 -000154 OUTPUT NEW-VERSION, COMMENTARY. EDIT0157 -000155 MOVE "F" TO UPSI-BIT (1), UPSI-BIT (2). EDIT0158 -000156 ACCEPT DATE-FROM-SYS FROM DATE. EDIT0159 -000157 MOVE DFSYS (1) TO YEAR-RUN. EDIT0160 -000158 MOVE DFSYS (2) TO MONTH-RUN. EDIT0161 -000159 MOVE DFSYS (3) TO DAY-RUN. EDIT0162 -000160 READ OLD-VERSION AT END EDIT0163 -000161 MOVE "NO OLD VERSION FOUND" TO MESSAGE-TEXT EDIT0164 -000162 WRITE COMMENT-LINE FROM MESSAGE-LOG EDIT0165 -000163 GO TO END-JOB. EDIT0166 -000164 MOVE OLD-STATEMENT TO NEW-STATEMENT. EDIT0167 -000165 PERFORM OUTPUT-A-RECORD. EDIT0168 -000166 EDIT0169 -000167 TOP-OF-PAGE-ROUTINE. EDIT0170 -000168 ADD 1 TO PAGE-NUMBER. EDIT0171 -000169 MOVE ZERO TO LINE-COUNT. EDIT0172 -000170 WRITE COMMENT-LINE FROM HEADINGS-LINE AFTER PAGE. EDIT0173 -000171 WRITE COMMENT-LINE FROM BLANK-LINE. EDIT0174 -000172 EDIT0175 -000173 READ-A-COMMAND. EDIT0176 -000174 READ MODIFICATION AT END EDIT0177 -000175 MOVE "MODIFICATION FILE ENDED " TO MESSAGE-TEXT EDIT0178 -000176 WRITE COMMENT-LINE FROM MESSAGE-LOG EDIT0179 -000177 GO TO FINISH-JOB. EDIT0180 -000178 MOVE UPDATE-ORDER TO COMMAND-IMAGE. EDIT0181 -000179 WRITE COMMENT-LINE FROM COMMAND-LISTING. EDIT0182 -000180 ADD 2 TO LINE-COUNT. EDIT0183 -000181 IF A-BLANK MOVE ZEROES TO A-FIELD. EDIT0184 -000182 IF B-BLANK MOVE ZEROES TO B-FIELD. EDIT0185 -000183 MOVE A-FIELD TO FIELDA. EDIT0186 -000184 MOVE B-FIELD TO FIELDB. EDIT0187 -000185 EDIT0188 -000186 TEST-COMMAND-TYPE. EDIT0189 -000187 IF CHANGE GO TO CHANGE-A-RECORD. EDIT0190 -000188 IF REMOVE GO TO DELETE-A-RECORD. EDIT0191 -000189 IF DISPLY MOVE "T" TO UPSI-BIT (2) EDIT0192 -000190 GO TO FINISH-JOB. EDIT0193 -000191 IF ENDJOB GO TO FINISH-JOB. EDIT0194 -000192 IF ADDNEW GO TO INSERT-A-RECORD. EDIT0195 -000193 MOVE "INVALID COMMAND IGNORED." TO MESSAGE-TEXT. EDIT0196 -000194 WRITE COMMENT-LINE FROM MESSAGE-LOG. EDIT0197 -000195 GO TO READ-A-COMMAND. EDIT0198 -000196 EDIT0199 -000197 CHANGE-A-RECORD. EDIT0200 -000198 ALTER RETURN-TO-USER TO PROCEED TO INSERTION-PROCESS. EDIT0201 -warning: ALTER is obsolete in GnuCOBOL -000199 ALTER NEXT-JOB-STEP TO PROCEED TO DELETION-PROCESS. EDIT0202 -warning: ALTER is obsolete in GnuCOBOL -000200 EDIT0205 -000201 FIND-FIELDA. EDIT0206 -000202 IF OLD-NUMBER IS GREATER THAN FIELDA EDIT0207 -000203 MOVE "RECORD ALREADY PASSED" TO MESSAGE-TEXT EDIT0208 -000204 WRITE COMMENT-LINE FROM MESSAGE-LOG EDIT0209 -000205 GO TO READ-A-COMMAND. EDIT0210 -000206 READ OLD-VERSION AT END EDIT0211 -000207 MOVE "NOT FOUND IN OLD VERSION" TO DISPLAY-TEXT EDIT0212 -000208 MOVE FIELDA TO DISPLAY-TEMP EDIT0213 -000209 WRITE COMMENT-LINE FROM DISPLAY-MESSAGE EDIT0214 -000210 GO TO END-JOB. EDIT0215 -000211 IF OLD-NUMBER IS LESS THAN FIELDA EDIT0216 -000212 MOVE OLD-STATEMENT TO NEW-STATEMENT EDIT0217 -000213 PERFORM OUTPUT-A-RECORD EDIT0218 -000214 GO TO FIND-FIELDA. EDIT0219 -000215 EDIT0220 -000216 RETURN-TO-USER. EDIT0221 -000217 GO TO END-JOB. EDIT0223 -000218 EDIT0228 -000219 INSERT-A-RECORD. EDIT0229 -000220 ALTER RETURN-TO-USER TO PROCEED TO INSERTION-PROCESS. EDIT0230 -warning: ALTER is obsolete in GnuCOBOL -000221 ALTER NEXT-JOB-STEP TO PROCEED TO FORCED-WRITE. EDIT0231 -warning: ALTER is obsolete in GnuCOBOL -000222 GO TO FIND-FIELDA. EDIT0234 -000223 EDIT0235 -000224 INSERTION-PROCESS. EDIT0236 -000225 READ MODIFICATION AT END EDIT0237 -000226 MOVE "NO ENDSET FOUND" TO MESSAGE-TEXT EDIT0238 -000227 WRITE COMMENT-LINE FROM MESSAGE-LOG EDIT0239 -000228 GO TO END-JOB. EDIT0240 -000229 IF ENDSET EDIT0241 -000230 MOVE COMMAND-ADDITIONS TO DISPLAY-TEMP EDIT0242 -000231 MOVE "RECORDS INSERTED." TO DISPLAY-TEXT EDIT0243 -000232 WRITE COMMENT-LINE FROM DISPLAY-MESSAGE EDIT0244 -000233 ADD COMMAND-ADDITIONS TO TOTAL-INSERTED EDIT0245 -000234 MOVE ZEROES TO COMMAND-ADDITIONS EDIT0246 -000235 GO TO NEXT-JOB-STEP. EDIT0247 -000236 MOVE INSERTION TO NEW-STATEMENT, ACTIVE-IMAGE. EDIT0248 -000237 MOVE "I " TO DISPOSITION. EDIT0249 -000238 PERFORM OUTPUT-A-RECORD. EDIT0250 -000239 WRITE COMMENT-LINE FROM ACTIVITIES-LISTING. EDIT0251 -000240 ADD 1 TO COMMAND-ADDITIONS. EDIT0252 -000241 ADD 1 TO LINE-COUNT. EDIT0253 -000242 IF LINE-COUNT EQUAL 56 PERFORM TOP-OF-PAGE-ROUTINE. EDIT0254 -000243 GO TO INSERTION-PROCESS. EDIT0255 -000244 EDIT0256 -000245 NEXT-JOB-STEP. EDIT0257 -000246 GO TO END-JOB. EDIT0259 -000247 EDIT0264 -000248 FORCED-WRITE. EDIT0265 -000249 MOVE OLD-STATEMENT TO NEW-STATEMENT. EDIT0266 -000250 PERFORM OUTPUT-A-RECORD. EDIT0267 -000251 GO TO READ-A-COMMAND. EDIT0268 -000252 EDIT0269 -000253 DELETE-A-RECORD. EDIT0270 -000254 ALTER RETURN-TO-USER TO PROCEED TO DELETION-PROCESS. EDIT0271 -warning: ALTER is obsolete in GnuCOBOL -000255 GO TO FIND-FIELDA. EDIT0273 -000256 EDIT0274 -000257 DELETION-PROCESS. EDIT0275 -000258 MOVE OLD-RECORD TO ACTIVE-IMAGE. EDIT0276 -000259 MOVE "D " TO DISPOSITION. EDIT0277 -000260 WRITE COMMENT-LINE FROM ACTIVITIES-LISTING. EDIT0278 -000261 ADD 1 TO LINE-COUNT. EDIT0279 -000262 IF LINE-COUNT EQUAL 56 PERFORM TOP-OF-PAGE-ROUTINE. EDIT0280 -000263 ADD 1 TO COMMAND-SUBTRACTIONS. EDIT0281 -000264 IF OLD-NUMBER IS NOT LESS THAN FIELDB EDIT0282 -000265 MOVE COMMAND-SUBTRACTIONS TO DISPLAY-TEMP EDIT0283 -000266 MOVE "RECORDS DELETED." TO DISPLAY-TEXT EDIT0284 -000267 WRITE COMMENT-LINE FROM DISPLAY-MESSAGE EDIT0285 -000268 ADD COMMAND-SUBTRACTIONS TO TOTAL-DELETED EDIT0286 -000269 MOVE OLD-STATEMENT TO NEW-STATEMENT EDIT0287 -000270 MOVE ZEROES TO COMMAND-SUBTRACTIONS EDIT0288 -000271 GO TO READ-A-COMMAND. EDIT0289 -000272 READ OLD-VERSION AT END EDIT0290 -000273 MOVE "NOT FOUND IN OLD VERSION DOING DELETE" EDIT0291 -000274 TO DISPLAY-TEXT EDIT0292 -000275 WRITE COMMENT-LINE FROM DISPLAY-MESSAGE EDIT0293 -000276 GO TO END-JOB. EDIT0294 -000277 GO TO DELETION-PROCESS. EDIT0295 -000278 EDIT0296 -000279 OUTPUT-A-RECORD. EDIT0297 -000280 ADD 1 TO OUTPUT-COUNT. EDIT0298 -000281 MOVE OUTPUT-COUNT TO NEW-NUMBER. EDIT0299 -000282 WRITE NEW-RECORD. EDIT0300 -000283 EDIT0301 -000284 FINISH-JOB. EDIT0302 -000285 READ OLD-VERSION AT END GO TO TEST-FOR-LISTING. EDIT0303 -000286 MOVE OLD-STATEMENT TO NEW-STATEMENT. EDIT0304 -000287 GO TO OUTPUT-A-RECORD. EDIT0305 -000288 EDIT0306 -000289 TEST-FOR-LISTING. EDIT0307 -000290 PERFORM TOP-OF-PAGE-ROUTINE. EDIT0308 -000291 MOVE OLD-NUMBER TO DISPLAY-TEMP. EDIT0309 -000292 MOVE "RECORDS READ." TO DISPLAY-TEXT. EDIT0310 -000293 WRITE COMMENT-LINE FROM DISPLAY-MESSAGE. EDIT0311 -000294 MOVE TOTAL-INSERTED TO DISPLAY-TEMP. EDIT0312 -000295 MOVE "RECORDS ADDED." TO DISPLAY-TEXT. EDIT0313 -000296 WRITE COMMENT-LINE FROM DISPLAY-MESSAGE. EDIT0314 -000297 MOVE TOTAL-DELETED TO DISPLAY-TEMP. EDIT0315 -000298 MOVE "RECORDS DROPPED." TO DISPLAY-TEXT. EDIT0316 -000299 WRITE COMMENT-LINE FROM DISPLAY-MESSAGE. EDIT0317 -000300 MOVE OUTPUT-COUNT TO DISPLAY-TEMP. EDIT0318 -000301 MOVE "RECORDS IN NEW FILE." TO DISPLAY-TEXT. EDIT0319 -000302 WRITE COMMENT-LINE FROM DISPLAY-MESSAGE. EDIT0320 -000303 IF UPSI-BIT (2) EQUAL "F" GO TO END-JOB. EDIT0321 -000304 CLOSE NEW-VERSION. EDIT0322 -000305 OPEN INPUT NEW-VERSION. EDIT0323 -000306 MOVE "UPDATED LISTING" TO PHASE. EDIT0324 -000307 MOVE ZEROES TO PAGE-NUMBER. EDIT0325 -000308 PERFORM TOP-OF-PAGE-ROUTINE. EDIT0326 -000309 MOVE SPACES TO DISPOSITION. EDIT0327 -000310 EDIT0328 -000311 LISTING-LOOP. EDIT0329 -000312 READ NEW-VERSION AT END GO TO END-JOB. EDIT0330 -000313 MOVE NEW-RECORD TO ACTIVE-IMAGE. EDIT0331 -000314 WRITE COMMENT-LINE FROM ACTIVITIES-LISTING. EDIT0332 -000315 ADD 1 TO LINE-COUNT. EDIT0333 -000316 IF LINE-COUNT EQUAL 56 PERFORM TOP-OF-PAGE-ROUTINE. EDIT0334 -000317 GO TO LISTING-LOOP. EDIT0335 -000318 EDIT0336 -000319 END-JOB. EDIT0337 -000320 MOVE "PROGRAM TERMINATION" TO MESSAGE-TEXT. EDIT0338 -000321 WRITE COMMENT-LINE FROM MESSAGE-LOG. EDIT0339 -000322 CLOSE OLD-VERSION, NEW-VERSION, MODIFICATION, COMMENTARY. EDIT0340 -000323 STOP RUN. EDIT0341 -000324 EDIT0342 -000325 END PROGRAM EDITOR. EDIT0343 - -SIZE TYPE LVL NAME PICTURE - -00080 FILE OLD-VERSION -00080 GROUP 01 OLD-RECORD -00075 ALPHANUMERIC 02 OLD-STATEMENT X(75) -00005 ALPHANUMERIC 02 OLD-NUMBER X(5) - -00080 FILE NEW-VERSION -00080 GROUP 01 NEW-RECORD -00075 ALPHANUMERIC 02 NEW-STATEMENT X(75) -00005 ALPHANUMERIC 02 NEW-NUMBER X(5) - -00032 FILE PRT-VERSION - -00080 FILE MODIFICATION -00080 GROUP 01 UPDATE-ORDER -00075 GROUP 02 INSERTION -00006 ALPHANUMERIC 03 COMMAND X(6) - CONDITIONAL 88 ENDJOB - CONDITIONAL 88 ENDSET - CONDITIONAL 88 REMOVE - CONDITIONAL 88 ADDNEW - CONDITIONAL 88 CHANGE - CONDITIONAL 88 DISPLY -00001 ALPHANUMERIC 03 FILLER X -00005 NUMERIC 03 A-FIELD 9(5) -00005 ALPHANUMERIC 03 A-ALPHA X(5), REDEFINES A-FIELD - CONDITIONAL 88 A-BLANK -00004 ALPHANUMERIC 03 FILLER X(4) -00005 NUMERIC 03 B-FIELD 9(5) -00005 ALPHANUMERIC 03 B-ALPHA X(5), REDEFINES B-FIELD - CONDITIONAL 88 B-BLANK -00054 ALPHANUMERIC 03 FILLER X(54) -00005 ALPHANUMERIC 02 FILLER X(5) - -00082 FILE COMMENTARY -00082 GROUP 01 COMMENT-LINE -00082 ALPHANUMERIC 02 FILLER X(82) - - WORKING-STORAGE SECTION - -00002 NUMERIC 77 COMMAND-ADDITIONS 9(3) COMP -00002 NUMERIC 77 COMMAND-SUBTRACTIONS 9(3) COMP -00002 NUMERIC 77 TOTAL-INSERTED 9(3) COMP -00002 NUMERIC 77 TOTAL-DELETED 9(3) COMP -00004 NUMERIC 77 OUTPUT-COUNT 9(5) COMP -00001 NUMERIC 77 LINE-COUNT 9(2) COMP -00005 NUMERIC 77 FIELDA 9(5) -00005 NUMERIC 77 FIELDB 9(5) -00082 ALPHANUMERIC 77 BLANK-LINE X(82) - -00006 GROUP 01 DATE-FROM-SYS -00002 NUMERIC 02 DFSYS 99, OCCURS 3 - -00080 GROUP 01 HEADINGS-LINE -00015 ALPHANUMERIC 02 FILLER X(15) -00020 ALPHANUMERIC 02 FILLER X(20) -00017 ALPHANUMERIC 02 PHASE X(17) -00002 ALPHANUMERIC 02 MONTH-RUN XX -00001 ALPHANUMERIC 02 FILLER X -00002 ALPHANUMERIC 02 DAY-RUN XX -00001 ALPHANUMERIC 02 FILLER X -00002 ALPHANUMERIC 02 YEAR-RUN XX -00008 ALPHANUMERIC 02 FILLER X(8) -00008 ALPHANUMERIC 02 FILLER X(8) -00004 NUMERIC 02 PAGE-NUMBER 9(4) - -00082 GROUP 01 COMMAND-LISTING -00002 ALPHANUMERIC 02 FILLER X(2) -00080 ALPHANUMERIC 02 COMMAND-IMAGE X(80) - -00082 GROUP 01 ACTIVITIES-LISTING -00002 ALPHANUMERIC 02 DISPOSITION X(2) -00080 ALPHANUMERIC 02 ACTIVE-IMAGE X(80) - -00008 GROUP 01 UPSI-BYTE -00001 ALPHANUMERIC 02 UPSI-BIT X, OCCURS 8 - -00082 GROUP 01 MESSAGE-LOG -00002 ALPHANUMERIC 02 FILLER X(2) -00080 ALPHANUMERIC 02 MESSAGE-TEXT X(80) - -00070 GROUP 01 DISPLAY-MESSAGE -00002 ALPHANUMERIC 02 FILLER X(2) -00006 ALPHANUMERIC 02 DISPLAY-TEMP X(6) -00002 ALPHANUMERIC 02 FILLER X(2) -00060 ALPHANUMERIC 02 DISPLAY-TEXT X(60) - -00001 NUMERIC 77 END-JOB-PROCESS 9 -00001 NUMERIC 77 DELETE-PROCESS 9 -00001 NUMERIC 77 INSERT-PROCESS 9 -00001 NUMERIC 77 WRITE-PROCESS 9 - -00002 GROUP 01 SELECTORS -00001 NUMERIC 02 RETURN-SELECT 9 -00001 NUMERIC 02 NEXT-JOB-SELECT 9 - - -NAME DEFINED REFERENCES - -OLD-VERSION 26 41 153 160 206 272 285 322 -OLD-RECORD 46 44 258 -OLD-STATEMENT 47 164 212 249 269 286 -OLD-NUMBER 48 202 211 264 291 - -NEW-VERSION 28 50 *154 *282 304 305 312 322 -NEW-RECORD 55 53 282 313 -NEW-STATEMENT 56 *164 *212 *236 *249 *269 *286 -NEW-NUMBER 57 *281 - -PRT-VERSION 30 not referenced - -MODIFICATION 32 59 153 174 225 322 -UPDATE-ORDER 64 62 178 -INSERTION 65 236 -COMMAND 66 referenced by parent/child -ENDJOB 67 191 -ENDSET 68 229 -REMOVE 69 188 -ADDNEW 70 192 -CHANGE 71 187 -DISPLY 72 189 -A-FIELD 74 *181 183 -A-ALPHA 75 referenced by parent/child -A-BLANK 76 181 -B-FIELD 78 *182 184 -B-ALPHA 79 referenced by parent/child -B-BLANK 80 182 - -COMMENTARY 34 84 *154 *162 *170 *171 *176 *179 *194 *204 *209 - *227 *232 *239 *260 *267 *275 *293 *296 *299 *302 - *314 *321 322 -COMMENT-LINE 89 87 *162 *170 *171 *176 *179 *194 *204 *209 *227 - *232 *239 *260 *267 *275 *293 *296 *299 *302 *314 - *321 - -COMMAND-ADDITIONS 94 230 233 *234 240 -COMMAND-SUBTRACTIONS 95 263 265 268 *270 -TOTAL-INSERTED 96 233 294 -TOTAL-DELETED 97 268 297 -OUTPUT-COUNT 98 280 281 300 -LINE-COUNT 99 *169 180 241 242 261 262 315 316 -FIELDA 100 *183 202 208 211 -FIELDB 101 *184 264 -BLANK-LINE 102 171 -DATE-FROM-SYS 104 *156 -DFSYS 105 157 158 159 -HEADINGS-LINE 107 170 -PHASE 110 *306 -MONTH-RUN 111 *158 -DAY-RUN 113 *159 -YEAR-RUN 115 *157 -PAGE-NUMBER 118 168 *307 -COMMAND-LISTING 120 179 -COMMAND-IMAGE 122 *178 -ACTIVITIES-LISTING 124 239 260 314 -DISPOSITION 125 *237 *259 *309 -ACTIVE-IMAGE 126 *236 *258 *313 -UPSI-BYTE 128 referenced by child -UPSI-BIT 129 *155 *189 303 -MESSAGE-LOG 131 162 176 194 204 227 321 -MESSAGE-TEXT 133 *161 *175 *193 *203 *226 *320 -DISPLAY-MESSAGE 135 209 232 267 275 293 296 299 302 -DISPLAY-TEMP 137 *208 *230 *265 *291 *294 *297 *300 -DISPLAY-TEXT 139 *207 *231 *266 *274 *292 *295 *298 *301 -END-JOB-PROCESS 141 not referenced -DELETE-PROCESS 142 not referenced -INSERT-PROCESS 143 not referenced -WRITE-PROCESS 144 not referenced -SELECTORS 146 not referenced -RETURN-SELECT 147 not referenced -NEXT-JOB-SELECT 148 not referenced - - -LABEL DEFINED REFERENCES - -E EDITOR 150 -P START-SECTION 152 not referenced -P TOP-OF-PAGE-ROUTINE 167 242 262 290 308 316 -P READ-A-COMMAND 173 195 205 251 271 -P TEST-COMMAND-TYPE 186 not referenced -P CHANGE-A-RECORD 197 187 -P FIND-FIELDA 201 214 222 255 -P RETURN-TO-USER 216 198 220 254 -P INSERT-A-RECORD 219 192 -P INSERTION-PROCESS 224 198 220 243 -P NEXT-JOB-STEP 245 199 221 235 -P FORCED-WRITE 248 221 -P DELETE-A-RECORD 253 188 -P DELETION-PROCESS 257 199 254 277 -P OUTPUT-A-RECORD 279 165 213 238 250 287 -P FINISH-JOB 284 177 190 191 -P TEST-FOR-LISTING 289 285 -P LISTING-LOOP 311 317 -P END-JOB 319 163 210 217 228 246 276 303 312 - - -Error/Warning summary: - -EDITOR.cob:42: warning: LABEL RECORDS is obsolete in GnuCOBOL -EDITOR.cob:44: warning: DATA RECORDS is obsolete in GnuCOBOL -EDITOR.cob:51: warning: LABEL RECORDS is obsolete in GnuCOBOL -EDITOR.cob:53: warning: DATA RECORDS is obsolete in GnuCOBOL -EDITOR.cob:60: warning: LABEL RECORDS is obsolete in GnuCOBOL -EDITOR.cob:62: warning: DATA RECORDS is obsolete in GnuCOBOL -EDITOR.cob:85: warning: LABEL RECORDS is obsolete in GnuCOBOL -EDITOR.cob:87: warning: DATA RECORDS is obsolete in GnuCOBOL -EDITOR.cob:30: error: missing file description for FILE PRT-VERSION -EDITOR.cob:198: warning: ALTER is obsolete in GnuCOBOL -EDITOR.cob:199: warning: ALTER is obsolete in GnuCOBOL -EDITOR.cob:220: warning: ALTER is obsolete in GnuCOBOL -EDITOR.cob:221: warning: ALTER is obsolete in GnuCOBOL -EDITOR.cob:254: warning: ALTER is obsolete in GnuCOBOL - -13 warnings in compilation group -1 error in compilation group -]) - -AT_CHECK([gcdiff -IGnuCOBOL prog19.lst prog.lst], [0], [], []) - -AT_CLEANUP - - -AT_SETUP([Report Writer]) -AT_KEYWORDS([listing]) - -AT_CAPTURE_FILE([prog.lst]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - - * ************************************************************* * - * REPORT WRITER EXAMPLE #1. * - * ************************************************************* * - - ENVIRONMENT DIVISION. - CONFIGURATION SECTION. - - INPUT-OUTPUT SECTION. - FILE-CONTROL. - - SELECT TRANSACTION-DATA - ASSIGN TO EXTERNAL DATAIN - ORGANIZATION IS LINE SEQUENTIAL. - - SELECT REPORT-FILE - ASSIGN TO EXTERNAL LINE ADVANCING SYSPRINT. - - DATA DIVISION. - FILE SECTION. - - FD TRANSACTION-DATA. - - 01 TRANSACTION-RECORD. - 03 TR-CUSTOMER-NUMBER PIC 9(04). - 03 FILLER PIC X(01). - 03 TR-CUSTOMER-NAME PIC X(16). - 03 FILLER PIC X(01). - 03 TR-ITEM-NUMBER PIC 9(05). - 03 FILLER REDEFINES TR-ITEM-NUMBER. - 05 TR-ITEM-DEPARTMENT PIC 9(01). - 05 FILLER PIC 9(04). - 03 FILLER PIC X(01). - 03 TR-ITEM-COST PIC 9(03)V99. - 03 FILLER PIC X(47). - - FD REPORT-FILE - REPORT IS CUSTOMER-REPORT. - - WORKING-STORAGE SECTION. - 77 END-OF-FILE-SWITCH PIC X(1) VALUE 'N'. - 88 END-OF-FILE VALUE 'Y'. - - REPORT SECTION. - RD CUSTOMER-REPORT - PAGE LIMIT IS 66 LINES - HEADING 1 - FIRST DETAIL 5 - LAST DETAIL 58. - - 01 PAGE-HEAD-GROUP TYPE PAGE HEADING. - 02 LINE 1. - 03 COLUMN 27 PIC X(41) VALUE - 'C U S T O M E R C H A R G E R E P O R T'. - 02 LINE PLUS 2. - 03 COLUMN 01 PIC X(09) VALUE 'CUST. NO.'. - 03 COLUMN 15 PIC X(10) VALUE 'CUST. NAME'. - 03 COLUMN 30 PIC X(05) VALUE 'DEPT.'. - 03 COLUMN 39 PIC X(08) VALUE 'ITEM NO.'. - 03 COLUMN 51 PIC X(09) VALUE 'ITEM COST'. - - 01 CHARGE-DETAIL TYPE DETAIL. - 02 LINE PLUS 1. - 03 COLUMN 03 PIC Z(04) SOURCE TR-CUSTOMER-NUMBER. - 03 COLUMN 10 PIC X(16) SOURCE TR-CUSTOMER-NAME. - 03 COLUMN 32 PIC 9(01) SOURCE TR-ITEM-DEPARTMENT. - 03 COLUMN 40 PIC 9(05) SOURCE TR-ITEM-NUMBER. - 03 COLUMN 51 PIC $$$$.99 SOURCE TR-ITEM-COST. - - PROCEDURE DIVISION. - - 000-INITIATE. - - OPEN INPUT TRANSACTION-DATA, - OUTPUT REPORT-FILE. - - INITIATE CUSTOMER-REPORT. - - READ TRANSACTION-DATA - AT END - MOVE 'Y' TO END-OF-FILE-SWITCH. - * END-READ. - - PERFORM 100-PROCESS-TRANSACTION-DATA THRU 199-EXIT - UNTIL END-OF-FILE. - - 000-TERMINATE. - TERMINATE CUSTOMER-REPORT. - - CLOSE TRANSACTION-DATA, - REPORT-FILE. - - STOP RUN. - - 100-PROCESS-TRANSACTION-DATA. - GENERATE CHARGE-DETAIL. - READ TRANSACTION-DATA - AT END - MOVE 'Y' TO END-OF-FILE-SWITCH. - * END-READ. - - 199-EXIT. - EXIT. -]) - -AT_CHECK([$COMPILE_ONLY -t prog.lst -tsymbols -Xref -tlines=0 prog.cob], [0], [], []) - -AT_DATA([prog1.lst], -[GnuCOBOL V.R.P prog.cob DDD MMM dd HH:MM:SS YYYY - -LINE PG/LN A...B............................................................ - -000001 -000002 IDENTIFICATION DIVISION. -000003 PROGRAM-ID. prog. -000004 -000005 * ************************************************************* * -000006 * REPORT WRITER EXAMPLE #1. * -000007 * ************************************************************* * -000008 -000009 ENVIRONMENT DIVISION. -000010 CONFIGURATION SECTION. -000011 -000012 INPUT-OUTPUT SECTION. -000013 FILE-CONTROL. -000014 -000015 SELECT TRANSACTION-DATA -000016 ASSIGN TO EXTERNAL DATAIN -000017 ORGANIZATION IS LINE SEQUENTIAL. -000018 -000019 SELECT REPORT-FILE -000020 ASSIGN TO EXTERNAL LINE ADVANCING SYSPRINT. -000021 -000022 DATA DIVISION. -000023 FILE SECTION. -000024 -000025 FD TRANSACTION-DATA. -000026 -000027 01 TRANSACTION-RECORD. -000028 03 TR-CUSTOMER-NUMBER PIC 9(04). -000029 03 FILLER PIC X(01). -000030 03 TR-CUSTOMER-NAME PIC X(16). -000031 03 FILLER PIC X(01). -000032 03 TR-ITEM-NUMBER PIC 9(05). -000033 03 FILLER REDEFINES TR-ITEM-NUMBER. -000034 05 TR-ITEM-DEPARTMENT PIC 9(01). -000035 05 FILLER PIC 9(04). -000036 03 FILLER PIC X(01). -000037 03 TR-ITEM-COST PIC 9(03)V99. -000038 03 FILLER PIC X(47). -000039 -000040 FD REPORT-FILE -000041 REPORT IS CUSTOMER-REPORT. -000042 -000043 WORKING-STORAGE SECTION. -000044 77 END-OF-FILE-SWITCH PIC X(1) VALUE 'N'. -000045 88 END-OF-FILE VALUE 'Y'. -000046 -000047 REPORT SECTION. -000048 RD CUSTOMER-REPORT -000049 PAGE LIMIT IS 66 LINES -000050 HEADING 1 -000051 FIRST DETAIL 5 -000052 LAST DETAIL 58. -000053 -000054 01 PAGE-HEAD-GROUP TYPE PAGE HEADING. -000055 02 LINE 1. -000056 03 COLUMN 27 PIC X(41) VALUE -000057 'C U S T O M E R C H A R G E R E P O R T'. -000058 02 LINE PLUS 2. -000059 03 COLUMN 01 PIC X(09) VALUE 'CUST. NO.'. -000060 03 COLUMN 15 PIC X(10) VALUE 'CUST. NAME'. -000061 03 COLUMN 30 PIC X(05) VALUE 'DEPT.'. -000062 03 COLUMN 39 PIC X(08) VALUE 'ITEM NO.'. -000063 03 COLUMN 51 PIC X(09) VALUE 'ITEM COST'. -000064 -000065 01 CHARGE-DETAIL TYPE DETAIL. -000066 02 LINE PLUS 1. -000067 03 COLUMN 03 PIC Z(04) SOURCE TR-CUSTOMER-NUMBER. -000068 03 COLUMN 10 PIC X(16) SOURCE TR-CUSTOMER-NAME. -000069 03 COLUMN 32 PIC 9(01) SOURCE TR-ITEM-DEPARTMENT. -000070 03 COLUMN 40 PIC 9(05) SOURCE TR-ITEM-NUMBER. -000071 03 COLUMN 51 PIC $$$$.99 SOURCE TR-ITEM-COST. -000072 -000073 PROCEDURE DIVISION. -000074 -000075 000-INITIATE. -000076 -000077 OPEN INPUT TRANSACTION-DATA, -000078 OUTPUT REPORT-FILE. -000079 -000080 INITIATE CUSTOMER-REPORT. -000081 -000082 READ TRANSACTION-DATA -000083 AT END -000084 MOVE 'Y' TO END-OF-FILE-SWITCH. -000085 * END-READ. -000086 -000087 PERFORM 100-PROCESS-TRANSACTION-DATA THRU 199-EXIT -000088 UNTIL END-OF-FILE. -000089 -000090 000-TERMINATE. -000091 TERMINATE CUSTOMER-REPORT. -000092 -000093 CLOSE TRANSACTION-DATA, -000094 REPORT-FILE. -000095 -000096 STOP RUN. -000097 -000098 100-PROCESS-TRANSACTION-DATA. -000099 GENERATE CHARGE-DETAIL. -000100 READ TRANSACTION-DATA -000101 AT END -000102 MOVE 'Y' TO END-OF-FILE-SWITCH. -000103 * END-READ. -000104 -000105 199-EXIT. -000106 EXIT. - -SIZE TYPE LVL NAME PICTURE - -00080 FILE TRANSACTION-DATA -00080 GROUP 01 TRANSACTION-RECORD -00004 ALPHANUMERIC 03 TR-CUSTOMER-NUMBER 9(04) -00001 ALPHANUMERIC 03 FILLER X(01) -00016 ALPHANUMERIC 03 TR-CUSTOMER-NAME X(16) -00001 ALPHANUMERIC 03 FILLER X(01) -00005 ALPHANUMERIC 03 TR-ITEM-NUMBER 9(05) -00005 GROUP 03 FILLER, REDEFINES TR-ITEM-NUMBER -00001 ALPHANUMERIC 05 TR-ITEM-DEPARTMENT 9(01) -00004 ALPHANUMERIC 05 FILLER 9(04) -00001 ALPHANUMERIC 03 FILLER X(01) -00005 ALPHANUMERIC 03 TR-ITEM-COST 9(03)V99 -00047 ALPHANUMERIC 03 FILLER X(47) - -00126 FILE REPORT-FILE - - WORKING-STORAGE SECTION - -00001 ALPHANUMERIC 77 END-OF-FILE-SWITCH X(1) - CONDITIONAL 88 END-OF-FILE - - REPORT SECTION - -00126 GROUP 01 PAGE-HEAD-GROUP -00067 GROUP 02 FILLER -00041 ALPHANUMERIC 03 FILLER X(41) -00059 GROUP 02 FILLER -00009 ALPHANUMERIC 03 FILLER X(09) -00010 ALPHANUMERIC 03 FILLER X(10) -00005 ALPHANUMERIC 03 FILLER X(05) -00008 ALPHANUMERIC 03 FILLER X(08) -00009 ALPHANUMERIC 03 FILLER X(09) - -00126 GROUP 01 CHARGE-DETAIL -00057 GROUP 02 FILLER -00004 ALPHANUMERIC 03 FILLER Z(04) -00016 ALPHANUMERIC 03 FILLER X(16) -00001 ALPHANUMERIC 03 FILLER 9(01) -00005 ALPHANUMERIC 03 FILLER 9(05) -00007 ALPHANUMERIC 03 FILLER $$$$.99 - - -NAME DEFINED REFERENCES - -TRANSACTION-DATA 15 25 77 82 93 100 -TRANSACTION-RECORD 27 referenced by child -TR-CUSTOMER-NUMBER 28 67 -TR-CUSTOMER-NAME 30 68 -TR-ITEM-NUMBER 32 70 -TR-ITEM-DEPARTMENT 34 69 -TR-ITEM-COST 37 71 - -REPORT-FILE 19 40 *78 94 - -END-OF-FILE-SWITCH 44 *84 *102 -END-OF-FILE 45 88 - -PAGE-HEAD-GROUP 54 not referenced -CHARGE-DETAIL 65 99 - - -LABEL DEFINED REFERENCES - -E prog 73 -P 000-INITIATE 75 not referenced -P 000-TERMINATE 90 not referenced -P 100-PROCESS-TRANSACTION-DATA 98 87 -P 199-EXIT 105 87 - -0 warnings in compilation group -0 errors in compilation group -]) - -AT_CHECK([gcdiff -IGnuCOBOL prog1.lst prog.lst], [0], [], []) - -AT_CLEANUP - - -AT_SETUP([huge REPLACE]) -AT_KEYWORDS([listing]) - -AT_CAPTURE_FILE([prog.lst]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - CONFIGURATION SECTION. - DATA DIVISION. - WORKING-STORAGE SECTION. - PROCEDURE DIVISION. - - REPLACE ==111111111111111111111111111111111111111== - BY ==' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' '==. - - - DISPLAY 111111111111111111111111111111111111111 - DISPLAY 111111111111111111111111111111111111111 - DISPLAY 111111111111111111111111111111111111111 - - STOP RUN. -]) - -AT_CHECK([$COMPILE_ONLY -t prog.lst -tlines=0 prog.cob], [0], [], []) - -AT_DATA([prog1.lst], -[GnuCOBOL V.R.P prog.cob DDD MMM dd HH:MM:SS YYYY - -LINE PG/LN A...B............................................................ - -000001 -000002 IDENTIFICATION DIVISION. -000003 PROGRAM-ID. prog. -000004 ENVIRONMENT DIVISION. -000005 CONFIGURATION SECTION. -000006 DATA DIVISION. -000007 WORKING-STORAGE SECTION. -000008 PROCEDURE DIVISION. -000009 -000010 REPLACE ==111111111111111111111111111111111111111== -000011 BY ==' -000012 - ' -000013 - ' -000014 - ' -000015 - ' -000016 - ' -000017 - ' -000018 - ' -000019 - ' -000020 - ' -000021 - ' -000022 - ' -000023 - ' -000024 - ' -000025 - ' -000026 - ' -000027 - ' -000028 - ' -000029 - ' -000030 - ' -000031 - ' -000032 - ' -000033 - ' -000034 - ' -000035 - ' -000036 - ' -000037 - ' -000038 - ' -000039 - ' -000040 - ' -000041 - ' -000042 - ' -000043 - ' -000044 - ' -000045 - ' -000046 - ' -000047 - ' -000048 - ' -000049 - ' -000050 - ' -000051 - ' -000052 - ' -000053 - ' -000054 - ' -000055 - ' -000056 - ' -000057 - ' -000058 - ' -000059 - ' -000060 - ' -000061 - ' -000062 - ' -000063 - ' -000064 - ' -000065 - ' -000066 - ' -000067 - ' -000068 - ' -000069 - ' -000070 - ' -000071 - ' -000072 - ' -000073 - ' -000074 - ' -000075 - ' -000076 - ' -000077 - ' -000078 - ' -000079 - ' -000080 - ' -000081 - ' -000082 - ' -000083 - ' -000084 - ' -000085 - ' -000086 - ' -000087 - ' -000088 - ' -000089 - ' -000090 - ' -000091 - ' -000092 - ' -000093 - ' -000094 - ' -000095 - ' -000096 - ' -000097 - ' -000098 - ' -000099 - ' -000100 - ' -000101 - ' -000102 - ' -000103 - ' -000104 - ' -000105 - ' -000106 - ' -000107 - ' -000108 - ' -000109 - ' -000110 - ' -000111 - ' -000112 - ' -000113 - ' '==. -000114 -000115 -000116 DISPLAY ' -000116+ - -000116+ - -000116+ - -000116+ - -000116+ - -000116+ - -000116+ - -000116+ - -000116+ - -000116+ - -000116+ - -000116+ - -000116+ - -000116+ - -000116+ - -000116+ - -000116+ - -000116+ - -000116+ - -000116+ - -000116+ - -000116+ - -000116+ - -000116+ - -000116+ - -000116+ - -000116+ - -000116+ - -000116+ - -000116+ - -000116+ - -000116+ - -000116+ - -000116+ - -000116+ - -000116+ - -000116+ - -000116+ - -000116+ - -000116+ - -000116+ - -000116+ - -000116+ - -000116+ - -000116+ - -000116+ - -000116+ - -000116+ - -000116+ - -000116+ - -000116+ - -000116+ - -000116+ - -000116+ - -000116+ - -000116+ - -000116+ - -000116+ - -000116+ - -000116+ - -000116+ - -000116+ - -000116+ - -000116+ - -000116+ - -000116+ - -000116+ - -000116+ - -000116+ - -000116+ - -000116+ - -000116+ - -000116+ - -000116+ - -000116+ - -000116+ - -000116+ - -000116+ - -000116+ - -000116+ - -000116+ - -000116+ - -000116+ - -000116+ - -000116+ - -000116+ - -000116+ - -000116+ - -000116+ - -000116+ - -000116+ - -000116+ - -000116+ - -000116+ - -000116+ - -000116+ - -000116+ - -000116+ - -000116+ - -000116+ - ' -000117 DISPLAY ' -000117+ - -000117+ - -000117+ - -000117+ - -000117+ - -000117+ - -000117+ - -000117+ - -000117+ - -000117+ - -000117+ - -000117+ - -000117+ - -000117+ - -000117+ - -000117+ - -000117+ - -000117+ - -000117+ - -000117+ - -000117+ - -000117+ - -000117+ - -000117+ - -000117+ - -000117+ - -000117+ - -000117+ - -000117+ - -000117+ - -000117+ - -000117+ - -000117+ - -000117+ - -000117+ - -000117+ - -000117+ - -000117+ - -000117+ - -000117+ - -000117+ - -000117+ - -000117+ - -000117+ - -000117+ - -000117+ - -000117+ - -000117+ - -000117+ - -000117+ - -000117+ - -000117+ - -000117+ - -000117+ - -000117+ - -000117+ - -000117+ - -000117+ - -000117+ - -000117+ - -000117+ - -000117+ - -000117+ - -000117+ - -000117+ - -000117+ - -000117+ - -000117+ - -000117+ - -000117+ - -000117+ - -000117+ - -000117+ - -000117+ - -000117+ - -000117+ - -000117+ - -000117+ - -000117+ - -000117+ - -000117+ - -000117+ - -000117+ - -000117+ - -000117+ - -000117+ - -000117+ - -000117+ - -000117+ - -000117+ - -000117+ - -000117+ - -000117+ - -000117+ - -000117+ - -000117+ - -000117+ - -000117+ - -000117+ - -000117+ - ' -000118 DISPLAY ' -000118+ - -000118+ - -000118+ - -000118+ - -000118+ - -000118+ - -000118+ - -000118+ - -000118+ - -000118+ - -000118+ - -000118+ - -000118+ - -000118+ - -000118+ - -000118+ - -000118+ - -000118+ - -000118+ - -000118+ - -000118+ - -000118+ - -000118+ - -000118+ - -000118+ - -000118+ - -000118+ - -000118+ - -000118+ - -000118+ - -000118+ - -000118+ - -000118+ - -000118+ - -000118+ - -000118+ - -000118+ - -000118+ - -000118+ - -000118+ - -000118+ - -000118+ - -000118+ - -000118+ - -000118+ - -000118+ - -000118+ - -000118+ - -000118+ - -000118+ - -000118+ - -000118+ - -000118+ - -000118+ - -000118+ - -000118+ - -000118+ - -000118+ - -000118+ - -000118+ - -000118+ - -000118+ - -000118+ - -000118+ - -000118+ - -000118+ - -000118+ - -000118+ - -000118+ - -000118+ - -000118+ - -000118+ - -000118+ - -000118+ - -000118+ - -000118+ - -000118+ - -000118+ - -000118+ - -000118+ - -000118+ - -000118+ - -000118+ - -000118+ - -000118+ - -000118+ - -000118+ - -000118+ - -000118+ - -000118+ - -000118+ - -000118+ - -000118+ - -000118+ - -000118+ - -000118+ - -000118+ - -000118+ - -000118+ - -000118+ - ' -000119 -000120 STOP RUN. - - -0 warnings in compilation group -0 errors in compilation group -]) - -AT_CHECK([gcdiff -IGnuCOBOL prog1.lst prog.lst], [0], [], []) - -AT_DATA([display.inc], [ - DISPLAY 111111111111111111111111111111111111111 -]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - CONFIGURATION SECTION. - DATA DIVISION. - WORKING-STORAGE SECTION. - PROCEDURE DIVISION. - - COPY "display.inc" - REPLACING ==111111111111111111111111111111111111111== - BY ==' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' '==. - - STOP RUN. -]) - -AT_CHECK([$COMPILE_ONLY -t prog.lst -tlines=0 prog.cob], [0], [], []) - -AT_DATA([prog2.lst], -[GnuCOBOL V.R.P prog.cob DDD MMM dd HH:MM:SS YYYY - -LINE PG/LN A...B............................................................ - -000001 -000002 IDENTIFICATION DIVISION. -000003 PROGRAM-ID. prog. -000004 ENVIRONMENT DIVISION. -000005 CONFIGURATION SECTION. -000006 DATA DIVISION. -000007 WORKING-STORAGE SECTION. -000008 PROCEDURE DIVISION. -000009 -000010 COPY "display.inc" -000011 REPLACING ==111111111111111111111111111111111111111== -000012 BY ==' -000013 - ' -000014 - ' -000015 - ' -000016 - ' -000017 - ' -000018 - ' -000019 - ' -000020 - ' -000021 - ' -000022 - ' -000023 - ' -000024 - ' -000025 - ' -000026 - ' -000027 - ' -000028 - ' -000029 - ' -000030 - ' -000031 - ' -000032 - ' -000033 - ' -000034 - ' -000035 - ' -000036 - ' -000037 - ' -000038 - ' -000039 - ' -000040 - ' -000041 - ' -000042 - ' -000043 - ' -000044 - ' -000045 - ' -000046 - ' -000047 - ' -000048 - ' -000049 - ' -000050 - ' -000051 - ' -000052 - ' -000053 - ' -000054 - ' -000055 - ' -000056 - ' -000057 - ' -000058 - ' -000059 - ' -000060 - ' -000061 - ' -000062 - ' -000063 - ' -000064 - ' -000065 - ' -000066 - ' -000067 - ' -000068 - ' -000069 - ' -000070 - ' -000071 - ' -000072 - ' -000073 - ' -000074 - ' -000075 - ' -000076 - ' -000077 - ' -000078 - ' -000079 - ' -000080 - ' -000081 - ' -000082 - ' -000083 - ' -000084 - ' -000085 - ' -000086 - ' -000087 - ' -000088 - ' -000089 - ' -000090 - ' -000091 - ' -000092 - ' -000093 - ' -000094 - ' -000095 - ' -000096 - ' -000097 - ' -000098 - ' -000099 - ' -000100 - ' -000101 - ' -000102 - ' -000103 - ' -000104 - ' -000105 - ' -000106 - ' -000107 - ' -000108 - ' -000109 - ' -000110 - ' -000111 - ' -000112 - ' -000113 - ' -000114 - ' '==. -000001C -000002C DISPLAY ' -000002+ - -000002+ - -000002+ - -000002+ - -000002+ - -000002+ - -000002+ - -000002+ - -000002+ - -000002+ - -000002+ - -000002+ - -000002+ - -000002+ - -000002+ - -000002+ - -000002+ - -000002+ - -000002+ - -000002+ - -000002+ - -000002+ - -000002+ - -000002+ - -000002+ - -000002+ - -000002+ - -000002+ - -000002+ - -000002+ - -000002+ - -000002+ - -000002+ - -000002+ - -000002+ - -000002+ - -000002+ - -000002+ - -000002+ - -000002+ - -000002+ - -000002+ - -000002+ - -000002+ - -000002+ - -000002+ - -000002+ - -000002+ - -000002+ - -000002+ - -000002+ - -000002+ - -000002+ - -000002+ - -000002+ - -000002+ - -000002+ - -000002+ - -000002+ - -000002+ - -000002+ - -000002+ - -000002+ - -000002+ - -000002+ - -000002+ - -000002+ - -000002+ - -000002+ - -000002+ - -000002+ - -000002+ - -000002+ - -000002+ - -000002+ - -000002+ - -000002+ - -000002+ - -000002+ - -000002+ - -000002+ - -000002+ - -000002+ - -000002+ - -000002+ - -000002+ - -000002+ - -000002+ - -000002+ - -000002+ - -000002+ - -000002+ - -000002+ - -000002+ - -000002+ - -000002+ - -000002+ - -000002+ - -000002+ - -000002+ - ' -000115 -000116 STOP RUN. - - -0 warnings in compilation group -0 errors in compilation group -]) - -AT_CHECK([gcdiff -IGnuCOBOL prog2.lst prog.lst], [0], [], []) - -AT_CLEANUP diff -Nru gnucobol-4.0~early~20200606/tests/testsuite.src/numeric-display.cob gnucobol-5/tests/testsuite.src/numeric-display.cob --- gnucobol-4.0~early~20200606/tests/testsuite.src/numeric-display.cob 2020-06-06 20:52:00.000000000 +0000 +++ gnucobol-5/tests/testsuite.src/numeric-display.cob 1970-01-01 00:00:00.000000000 +0000 @@ -1,166 +0,0 @@ - *> This file is part of GnuCOBOL. - *> - *> The GnuCOBOL compiler is free software: you can redistribute - *> it and/or modify it under the terms of the GNU General Public - *> License as published by the Free Software Foundation, either - *> version 3 of the License, or (at your option) any later - *> version. - *> - *> GnuCOBOL is distributed in the hope that it will be useful, - *> but WITHOUT ANY WARRANTY; without even the implied warranty of - *> MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - *> GNU General Public License for more details. - *> - *> You should have received a copy of the GNU General Public - *> License along with GnuCOBOL. - *> If not, see . - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 X-P1 PIC 9(1) VALUE 1 - @USAGE@. - 01 X-P2 PIC 9(2) VALUE 12 - @USAGE@. - 01 X-P3 PIC 9(3) VALUE 123 - @USAGE@. - 01 X-P4 PIC 9(4) VALUE 1234 - @USAGE@. - 01 X-P5 PIC 9(5) VALUE 12345 - @USAGE@. - 01 X-P6 PIC 9(6) VALUE 123456 - @USAGE@. - 01 X-P7 PIC 9(7) VALUE 1234567 - @USAGE@. - 01 X-P8 PIC 9(8) VALUE 12345678 - @USAGE@. - 01 X-P9 PIC 9(9) VALUE 123456789 - @USAGE@. - 01 X-P10 PIC 9(10) VALUE 1234567890 - @USAGE@. - 01 X-P11 PIC 9(11) VALUE 12345678901 - @USAGE@. - 01 X-P12 PIC 9(12) VALUE 123456789012 - @USAGE@. - 01 X-P13 PIC 9(13) VALUE 1234567890123 - @USAGE@. - 01 X-P14 PIC 9(14) VALUE 12345678901234 - @USAGE@. - 01 X-P15 PIC 9(15) VALUE 123456789012345 - @USAGE@. - 01 X-P16 PIC 9(16) VALUE 1234567890123456 - @USAGE@. - 01 X-P17 PIC 9(17) VALUE 12345678901234567 - @USAGE@. - 01 X-P18 PIC 9(18) VALUE 123456789012345678 - @USAGE@. - 01 X-N1 PIC S9(1) VALUE -1 - @USAGE@. - 01 X-N2 PIC S9(2) VALUE -12 - @USAGE@. - 01 X-N3 PIC S9(3) VALUE -123 - @USAGE@. - 01 X-N4 PIC S9(4) VALUE -1234 - @USAGE@. - 01 X-N5 PIC S9(5) VALUE -12345 - @USAGE@. - 01 X-N6 PIC S9(6) VALUE -123456 - @USAGE@. - 01 X-N7 PIC S9(7) VALUE -1234567 - @USAGE@. - 01 X-N8 PIC S9(8) VALUE -12345678 - @USAGE@. - 01 X-N9 PIC S9(9) VALUE -123456789 - @USAGE@. - 01 X-N10 PIC S9(10) VALUE -1234567890 - @USAGE@. - 01 X-N11 PIC S9(11) VALUE -12345678901 - @USAGE@. - 01 X-N12 PIC S9(12) VALUE -123456789012 - @USAGE@. - 01 X-N13 PIC S9(13) VALUE -1234567890123 - @USAGE@. - 01 X-N14 PIC S9(14) VALUE -12345678901234 - @USAGE@. - 01 X-N15 PIC S9(15) VALUE -123456789012345 - @USAGE@. - 01 X-N16 PIC S9(16) VALUE -1234567890123456 - @USAGE@. - 01 X-N17 PIC S9(17) VALUE -12345678901234567 - @USAGE@. - 01 X-N18 PIC S9(18) VALUE -123456789012345678 - @USAGE@. - PROCEDURE DIVISION. - DISPLAY X-P1 - END-DISPLAY. - DISPLAY X-P2 - END-DISPLAY. - DISPLAY X-P3 - END-DISPLAY. - DISPLAY X-P4 - END-DISPLAY. - DISPLAY X-P5 - END-DISPLAY. - DISPLAY X-P6 - END-DISPLAY. - DISPLAY X-P7 - END-DISPLAY. - DISPLAY X-P8 - END-DISPLAY. - DISPLAY X-P9 - END-DISPLAY. - DISPLAY X-P10 - END-DISPLAY. - DISPLAY X-P11 - END-DISPLAY. - DISPLAY X-P12 - END-DISPLAY. - DISPLAY X-P13 - END-DISPLAY. - DISPLAY X-P14 - END-DISPLAY. - DISPLAY X-P15 - END-DISPLAY. - DISPLAY X-P16 - END-DISPLAY. - DISPLAY X-P17 - END-DISPLAY. - DISPLAY X-P18 - END-DISPLAY. - DISPLAY X-N1 - END-DISPLAY. - DISPLAY X-N2 - END-DISPLAY. - DISPLAY X-N3 - END-DISPLAY. - DISPLAY X-N4 - END-DISPLAY. - DISPLAY X-N5 - END-DISPLAY. - DISPLAY X-N6 - END-DISPLAY. - DISPLAY X-N7 - END-DISPLAY. - DISPLAY X-N8 - END-DISPLAY. - DISPLAY X-N9 - END-DISPLAY. - DISPLAY X-N10 - END-DISPLAY. - DISPLAY X-N11 - END-DISPLAY. - DISPLAY X-N12 - END-DISPLAY. - DISPLAY X-N13 - END-DISPLAY. - DISPLAY X-N14 - END-DISPLAY. - DISPLAY X-N15 - END-DISPLAY. - DISPLAY X-N16 - END-DISPLAY. - DISPLAY X-N17 - END-DISPLAY. - DISPLAY X-N18 - END-DISPLAY. - STOP RUN. diff -Nru gnucobol-4.0~early~20200606/tests/testsuite.src/numeric-dump.cob gnucobol-5/tests/testsuite.src/numeric-dump.cob --- gnucobol-4.0~early~20200606/tests/testsuite.src/numeric-dump.cob 2020-06-06 20:52:00.000000000 +0000 +++ gnucobol-5/tests/testsuite.src/numeric-dump.cob 1970-01-01 00:00:00.000000000 +0000 @@ -1,455 +0,0 @@ - *> This file is part of GnuCOBOL. - *> - *> The GnuCOBOL compiler is free software: you can redistribute - *> it and/or modify it under the terms of the GNU General Public - *> License as published by the Free Software Foundation, either - *> version 3 of the License, or (at your option) any later - *> version. - *> - *> GnuCOBOL is distributed in the hope that it will be useful, - *> but WITHOUT ANY WARRANTY; without even the implied warranty of - *> MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - *> GNU General Public License for more details. - *> - *> You should have received a copy of the GNU General Public - *> License along with GnuCOBOL. - *> If not, see . - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 G-1. - 02 X-1 PIC 9(1) VALUE 1 - @USAGE@. - 02 FILLER PIC X(18) VALUE SPACE. - 01 G-2. - 02 X-2 PIC 9(2) VALUE 12 - @USAGE@. - 02 FILLER PIC X(18) VALUE SPACE. - 01 G-3. - 02 X-3 PIC 9(3) VALUE 123 - @USAGE@. - 02 FILLER PIC X(18) VALUE SPACE. - 01 G-4. - 02 X-4 PIC 9(4) VALUE 1234 - @USAGE@. - 02 FILLER PIC X(18) VALUE SPACE. - 01 G-5. - 02 X-5 PIC 9(5) VALUE 12345 - @USAGE@. - 02 FILLER PIC X(18) VALUE SPACE. - 01 G-6. - 02 X-6 PIC 9(6) VALUE 123456 - @USAGE@. - 02 FILLER PIC X(18) VALUE SPACE. - 01 G-7. - 02 X-7 PIC 9(7) VALUE 1234567 - @USAGE@. - 02 FILLER PIC X(18) VALUE SPACE. - 01 G-8. - 02 X-8 PIC 9(8) VALUE 12345678 - @USAGE@. - 02 FILLER PIC X(18) VALUE SPACE. - 01 G-9. - 02 X-9 PIC 9(9) VALUE 123456789 - @USAGE@. - 02 FILLER PIC X(18) VALUE SPACE. - 01 G-10. - 02 X-10 PIC 9(10) VALUE 1234567890 - @USAGE@. - 02 FILLER PIC X(18) VALUE SPACE. - 01 G-11. - 02 X-11 PIC 9(11) VALUE 12345678901 - @USAGE@. - 02 FILLER PIC X(18) VALUE SPACE. - 01 G-12. - 02 X-12 PIC 9(12) VALUE 123456789012 - @USAGE@. - 02 FILLER PIC X(18) VALUE SPACE. - 01 G-13. - 02 X-13 PIC 9(13) VALUE 1234567890123 - @USAGE@. - 02 FILLER PIC X(18) VALUE SPACE. - 01 G-14. - 02 X-14 PIC 9(14) VALUE 12345678901234 - @USAGE@. - 02 FILLER PIC X(18) VALUE SPACE. - 01 G-15. - 02 X-15 PIC 9(15) VALUE 123456789012345 - @USAGE@. - 02 FILLER PIC X(18) VALUE SPACE. - 01 G-16. - 02 X-16 PIC 9(16) VALUE 1234567890123456 - @USAGE@. - 02 FILLER PIC X(18) VALUE SPACE. - 01 G-17. - 02 X-17 PIC 9(17) VALUE 12345678901234567 - @USAGE@. - 02 FILLER PIC X(18) VALUE SPACE. - 01 G-18. - 02 X-18 PIC 9(18) VALUE 123456789012345678 - @USAGE@. - 02 FILLER PIC X(18) VALUE SPACE. - 01 G-S1. - 02 X-S1 PIC S9(1) VALUE -1 - @USAGE@. - 02 FILLER PIC X(18) VALUE SPACE. - 01 G-S2. - 02 X-S2 PIC S9(2) VALUE -12 - @USAGE@. - 02 FILLER PIC X(18) VALUE SPACE. - 01 G-S3. - 02 X-S3 PIC S9(3) VALUE -123 - @USAGE@. - 02 FILLER PIC X(18) VALUE SPACE. - 01 G-S4. - 02 X-S4 PIC S9(4) VALUE -1234 - @USAGE@. - 02 FILLER PIC X(18) VALUE SPACE. - 01 G-S5. - 02 X-S5 PIC S9(5) VALUE -12345 - @USAGE@. - 02 FILLER PIC X(18) VALUE SPACE. - 01 G-S6. - 02 X-S6 PIC S9(6) VALUE -123456 - @USAGE@. - 02 FILLER PIC X(18) VALUE SPACE. - 01 G-S7. - 02 X-S7 PIC S9(7) VALUE -1234567 - @USAGE@. - 02 FILLER PIC X(18) VALUE SPACE. - 01 G-S8. - 02 X-S8 PIC S9(8) VALUE -12345678 - @USAGE@. - 02 FILLER PIC X(18) VALUE SPACE. - 01 G-S9. - 02 X-S9 PIC S9(9) VALUE -123456789 - @USAGE@. - 02 FILLER PIC X(18) VALUE SPACE. - 01 G-S10. - 02 X-S10 PIC S9(10) VALUE -1234567890 - @USAGE@. - 02 FILLER PIC X(18) VALUE SPACE. - 01 G-S11. - 02 X-S11 PIC S9(11) VALUE -12345678901 - @USAGE@. - 02 FILLER PIC X(18) VALUE SPACE. - 01 G-S12. - 02 X-S12 PIC S9(12) VALUE -123456789012 - @USAGE@. - 02 FILLER PIC X(18) VALUE SPACE. - 01 G-S13. - 02 X-S13 PIC S9(13) VALUE -1234567890123 - @USAGE@. - 02 FILLER PIC X(18) VALUE SPACE. - 01 G-S14. - 02 X-S14 PIC S9(14) VALUE -12345678901234 - @USAGE@. - 02 FILLER PIC X(18) VALUE SPACE. - 01 G-S15. - 02 X-S15 PIC S9(15) VALUE -123456789012345 - @USAGE@. - 02 FILLER PIC X(18) VALUE SPACE. - 01 G-S16. - 02 X-S16 PIC S9(16) VALUE -1234567890123456 - @USAGE@. - 02 FILLER PIC X(18) VALUE SPACE. - 01 G-S17. - 02 X-S17 PIC S9(17) VALUE -12345678901234567 - @USAGE@. - 02 FILLER PIC X(18) VALUE SPACE. - 01 G-S18. - 02 X-S18 PIC S9(18) VALUE -123456789012345678 - @USAGE@. - 02 FILLER PIC X(18) VALUE SPACE. - PROCEDURE DIVISION. - *> Dump all values - CALL "dump" USING G-1 - END-CALL. - CALL "dump" USING G-2 - END-CALL. - CALL "dump" USING G-3 - END-CALL. - CALL "dump" USING G-4 - END-CALL. - CALL "dump" USING G-5 - END-CALL. - CALL "dump" USING G-6 - END-CALL. - CALL "dump" USING G-7 - END-CALL. - CALL "dump" USING G-8 - END-CALL. - CALL "dump" USING G-9 - END-CALL. - CALL "dump" USING G-10 - END-CALL. - CALL "dump" USING G-11 - END-CALL. - CALL "dump" USING G-12 - END-CALL. - CALL "dump" USING G-13 - END-CALL. - CALL "dump" USING G-14 - END-CALL. - CALL "dump" USING G-15 - END-CALL. - CALL "dump" USING G-16 - END-CALL. - CALL "dump" USING G-17 - END-CALL. - CALL "dump" USING G-18 - END-CALL. - CALL "dump" USING G-S1 - END-CALL. - CALL "dump" USING G-S2 - END-CALL. - CALL "dump" USING G-S3 - END-CALL. - CALL "dump" USING G-S4 - END-CALL. - CALL "dump" USING G-S5 - END-CALL. - CALL "dump" USING G-S6 - END-CALL. - CALL "dump" USING G-S7 - END-CALL. - CALL "dump" USING G-S8 - END-CALL. - CALL "dump" USING G-S9 - END-CALL. - CALL "dump" USING G-S10 - END-CALL. - CALL "dump" USING G-S11 - END-CALL. - CALL "dump" USING G-S12 - END-CALL. - CALL "dump" USING G-S13 - END-CALL. - CALL "dump" USING G-S14 - END-CALL. - CALL "dump" USING G-S15 - END-CALL. - CALL "dump" USING G-S16 - END-CALL. - CALL "dump" USING G-S17 - END-CALL. - CALL "dump" USING G-S18 - END-CALL. - INITIALIZE X-1. - CALL "dump" USING G-1 - END-CALL. - INITIALIZE X-2. - CALL "dump" USING G-2 - END-CALL. - INITIALIZE X-3. - CALL "dump" USING G-3 - END-CALL. - INITIALIZE X-4. - CALL "dump" USING G-4 - END-CALL. - INITIALIZE X-5. - CALL "dump" USING G-5 - END-CALL. - INITIALIZE X-6. - CALL "dump" USING G-6 - END-CALL. - INITIALIZE X-7. - CALL "dump" USING G-7 - END-CALL. - INITIALIZE X-8. - CALL "dump" USING G-8 - END-CALL. - INITIALIZE X-9. - CALL "dump" USING G-9 - END-CALL. - INITIALIZE X-10. - CALL "dump" USING G-10 - END-CALL. - INITIALIZE X-11. - CALL "dump" USING G-11 - END-CALL. - INITIALIZE X-12. - CALL "dump" USING G-12 - END-CALL. - INITIALIZE X-13. - CALL "dump" USING G-13 - END-CALL. - INITIALIZE X-14. - CALL "dump" USING G-14 - END-CALL. - INITIALIZE X-15. - CALL "dump" USING G-15 - END-CALL. - INITIALIZE X-16. - CALL "dump" USING G-16 - END-CALL. - INITIALIZE X-17. - CALL "dump" USING G-17 - END-CALL. - INITIALIZE X-18. - CALL "dump" USING G-18 - END-CALL. - INITIALIZE X-S1. - CALL "dump" USING G-S1 - END-CALL. - INITIALIZE X-S2. - CALL "dump" USING G-S2 - END-CALL. - INITIALIZE X-S3. - CALL "dump" USING G-S3 - END-CALL. - INITIALIZE X-S4. - CALL "dump" USING G-S4 - END-CALL. - INITIALIZE X-S5. - CALL "dump" USING G-S5 - END-CALL. - INITIALIZE X-S6. - CALL "dump" USING G-S6 - END-CALL. - INITIALIZE X-S7. - CALL "dump" USING G-S7 - END-CALL. - INITIALIZE X-S8. - CALL "dump" USING G-S8 - END-CALL. - INITIALIZE X-S9. - CALL "dump" USING G-S9 - END-CALL. - INITIALIZE X-S10. - CALL "dump" USING G-S10 - END-CALL. - INITIALIZE X-S11. - CALL "dump" USING G-S11 - END-CALL. - INITIALIZE X-S12. - CALL "dump" USING G-S12 - END-CALL. - INITIALIZE X-S13. - CALL "dump" USING G-S13 - END-CALL. - INITIALIZE X-S14. - CALL "dump" USING G-S14 - END-CALL. - INITIALIZE X-S15. - CALL "dump" USING G-S15 - END-CALL. - INITIALIZE X-S16. - CALL "dump" USING G-S16 - END-CALL. - INITIALIZE X-S17. - CALL "dump" USING G-S17 - END-CALL. - INITIALIZE X-S18. - CALL "dump" USING G-S18 - END-CALL. - MOVE ZERO TO X-1. - CALL "dump" USING G-1 - END-CALL. - MOVE ZERO TO X-2. - CALL "dump" USING G-2 - END-CALL. - MOVE ZERO TO X-3. - CALL "dump" USING G-3 - END-CALL. - MOVE ZERO TO X-4. - CALL "dump" USING G-4 - END-CALL. - MOVE ZERO TO X-5. - CALL "dump" USING G-5 - END-CALL. - MOVE ZERO TO X-6. - CALL "dump" USING G-6 - END-CALL. - MOVE ZERO TO X-7. - CALL "dump" USING G-7 - END-CALL. - MOVE ZERO TO X-8. - CALL "dump" USING G-8 - END-CALL. - MOVE ZERO TO X-9. - CALL "dump" USING G-9 - END-CALL. - MOVE ZERO TO X-10. - CALL "dump" USING G-10 - END-CALL. - MOVE ZERO TO X-11. - CALL "dump" USING G-11 - END-CALL. - MOVE ZERO TO X-12. - CALL "dump" USING G-12 - END-CALL. - MOVE ZERO TO X-13. - CALL "dump" USING G-13 - END-CALL. - MOVE ZERO TO X-14. - CALL "dump" USING G-14 - END-CALL. - MOVE ZERO TO X-15. - CALL "dump" USING G-15 - END-CALL. - MOVE ZERO TO X-16. - CALL "dump" USING G-16 - END-CALL. - MOVE ZERO TO X-17. - CALL "dump" USING G-17 - END-CALL. - MOVE ZERO TO X-18. - CALL "dump" USING G-18 - END-CALL. - MOVE ZERO TO X-S1. - CALL "dump" USING G-S1 - END-CALL. - MOVE ZERO TO X-S2. - CALL "dump" USING G-S2 - END-CALL. - MOVE ZERO TO X-S3. - CALL "dump" USING G-S3 - END-CALL. - MOVE ZERO TO X-S4. - CALL "dump" USING G-S4 - END-CALL. - MOVE ZERO TO X-S5. - CALL "dump" USING G-S5 - END-CALL. - MOVE ZERO TO X-S6. - CALL "dump" USING G-S6 - END-CALL. - MOVE ZERO TO X-S7. - CALL "dump" USING G-S7 - END-CALL. - MOVE ZERO TO X-S8. - CALL "dump" USING G-S8 - END-CALL. - MOVE ZERO TO X-S9. - CALL "dump" USING G-S9 - END-CALL. - MOVE ZERO TO X-S10. - CALL "dump" USING G-S10 - END-CALL. - MOVE ZERO TO X-S11. - CALL "dump" USING G-S11 - END-CALL. - MOVE ZERO TO X-S12. - CALL "dump" USING G-S12 - END-CALL. - MOVE ZERO TO X-S13. - CALL "dump" USING G-S13 - END-CALL. - MOVE ZERO TO X-S14. - CALL "dump" USING G-S14 - END-CALL. - MOVE ZERO TO X-S15. - CALL "dump" USING G-S15 - END-CALL. - MOVE ZERO TO X-S16. - CALL "dump" USING G-S16 - END-CALL. - MOVE ZERO TO X-S17. - CALL "dump" USING G-S17 - END-CALL. - MOVE ZERO TO X-S18. - CALL "dump" USING G-S18 - END-CALL. - STOP RUN. diff -Nru gnucobol-4.0~early~20200606/tests/testsuite.src/run_accept.at gnucobol-5/tests/testsuite.src/run_accept.at --- gnucobol-4.0~early~20200606/tests/testsuite.src/run_accept.at 2020-06-06 20:52:00.000000000 +0000 +++ gnucobol-5/tests/testsuite.src/run_accept.at 1970-01-01 00:00:00.000000000 +0000 @@ -1,312 +0,0 @@ -## Copyright (C) 2003-2012, 2014-2017 Free Software Foundation, Inc. -## Written by Keisuke Nishida, Roger While, Simon Sobisch -## -## This file is part of GnuCOBOL. -## -## The GnuCOBOL compiler is free software: you can redistribute it -## and/or modify it under the terms of the GNU General Public License -## as published by the Free Software Foundation, either version 3 of the -## License, or (at your option) any later version. -## -## GnuCOBOL is distributed in the hope that it will be useful, -## but WITHOUT ANY WARRANTY; without even the implied warranty of -## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -## GNU General Public License for more details. -## -## You should have received a copy of the GNU General Public License -## along with GnuCOBOL. If not, see . - -### GnuCOBOL Test Suite - -### ISO+IEC+1989-2002 14.8.1 ACCEPT statement -### ISO+IEC+1989-2014 14.9.1 ACCEPT statement - -# Format 1: hardware / device - -## TODO - only omitted tested so far - -AT_SETUP([ACCEPT OMITTED (simple)]) -AT_KEYWORDS([accept extensions]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - - DATA DIVISION. - - PROCEDURE DIVISION. - ACCEPT OMITTED - END-ACCEPT. -]) - -AT_DATA([input.txt], [ -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog < input.txt], [0], [], []) - -AT_CLEANUP - -# -## Format 2: chronological / temporal -# - -AT_SETUP([ACCEPT FROM TIME / DATE / DAY / DAY-OF-WEEK (1)]) -AT_KEYWORDS([accept]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - *> one byte longer to make sure there is no garbage in - 01 X PIC X(9). - PROCEDURE DIVISION. - ACCEPT X FROM TIME - END-ACCEPT - IF X (1:2) >= "00" AND <= "23" AND - X (3:2) >= "00" AND <= "59" AND - X (5:2) >= "00" AND <= "60" AND - X (7:2) >= "00" AND <= "99" AND - X (9: ) = SPACE - CONTINUE - ELSE - DISPLAY "TIME " X "!" - END-DISPLAY - END-IF - ACCEPT X FROM DATE - END-ACCEPT - INSPECT X CONVERTING "012345678" TO "999999999" - IF X NOT = "999999" - DISPLAY "DATE " X "!" - END-DISPLAY - END-IF - ACCEPT X FROM DATE YYYYMMDD - END-ACCEPT - INSPECT X CONVERTING "012345678" TO "999999999" - IF X NOT = "99999999" - DISPLAY "YYYYMMDD " X "!" - END-DISPLAY - END-IF - ACCEPT X FROM DAY - END-ACCEPT - INSPECT X CONVERTING "012345678" TO "999999999" - IF X NOT = "99999" - DISPLAY "DAY " X "!" - END-DISPLAY - END-IF - ACCEPT X FROM DAY YYYYDDD - END-ACCEPT - INSPECT X CONVERTING "012345678" TO "999999999" - IF X NOT = "9999999" - DISPLAY "YYYYDDD " X "!" - END-DISPLAY - END-IF - ACCEPT X FROM DAY-OF-WEEK - END-ACCEPT - INSPECT X CONVERTING "1234567" TO "9999999" - IF X NOT = "9" - DISPLAY "DAY-OF-WEEK " X "!" - END-DISPLAY - END-IF - STOP RUN. -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [], []) - -AT_CLEANUP - - -AT_SETUP([ACCEPT FROM TIME / DATE / DAY / DAY-OF-WEEK (2)]) -AT_KEYWORDS([accept configuration COB_CURRENT_DATE]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - *> one byte longer to make sure there is no garbage in - 01 WS-YYYYMMDD PIC X(9). - 01 WS-YYYYDDD PIC X(8). - 01 WS-DAYOFWEEK PIC X(2). - 01 WS-DATE-TODAY. - 05 WS-TODAYS-YY PIC 9(02) VALUE 0. - 05 WS-TODAYS-MM PIC 9(02) VALUE 0. - 05 WS-TODAYS-DD PIC 9(02) VALUE 0. - - 01 WS-DATE. - 05 WS-DATE-MM PIC 9(02) VALUE 0. - 05 FILLER PIC X(01) VALUE '/'. - 05 WS-DATE-DD PIC 9(02) VALUE 0. - 05 FILLER PIC X(01) VALUE '/'. - 05 WS-DATE-YY PIC 9(02) VALUE 0. - - 01 WS-TIME-NOW. - 05 WS-NOW-HH PIC 9(02) VALUE 0. - 05 WS-NOW-MM PIC 9(02) VALUE 0. - 05 WS-NOW-SS PIC 9(02) VALUE 0. - 05 WS-NOW-HS PIC 9(02) VALUE 0. - - 01 WS-TIME. - 05 WS-TIME-HH PIC 9(02) VALUE 0. - 05 FILLER PIC X(01) VALUE ':'. - 05 WS-TIME-MM PIC 9(02) VALUE 0. - 05 FILLER PIC X(01) VALUE ':'. - 05 WS-TIME-SS PIC 9(02) VALUE 0. - - PROCEDURE DIVISION. - ACCEPT WS-DATE-TODAY FROM DATE - ACCEPT WS-TIME-NOW FROM TIME - MOVE WS-TODAYS-YY TO WS-DATE-YY - MOVE WS-TODAYS-MM TO WS-DATE-MM - MOVE WS-TODAYS-DD TO WS-DATE-DD - MOVE WS-NOW-HH TO WS-TIME-HH - MOVE WS-NOW-MM TO WS-TIME-MM - MOVE WS-NOW-SS TO WS-TIME-SS - DISPLAY 'PROCESS DATE/TIME : ' WS-DATE ' ' WS-TIME - WITH NO ADVANCING - END-DISPLAY - ACCEPT WS-YYYYMMDD FROM DATE YYYYMMDD - IF WS-YYYYMMDD not = "20150405" - DISPLAY 'Wrong date DATE YYYYMMDD: ' WS-YYYYMMDD - ' expected: 20150405' - UPON SYSERR - END-DISPLAY - END-IF - ACCEPT WS-YYYYDDD FROM DAY YYYYDDD - IF WS-YYYYDDD not = "2015095" - DISPLAY 'Wrong date YYYYDDD: ' WS-YYYYDDD - ' expected: 2015095' - UPON SYSERR - END-DISPLAY - END-IF - ACCEPT WS-DAYOFWEEK FROM DAY-OF-WEEK - IF WS-DAYOFWEEK not = "7" - DISPLAY 'Wrong date DAYOFWEEK: ' WS-DAYOFWEEK - ' expected: 7' - UPON SYSERR - END-DISPLAY - END-IF - STOP RUN. -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) - -AT_CHECK([COB_CURRENT_DATE='2015/04/05 18:45:22' \ -$COBCRUN_DIRECT ./prog], [0], [PROCESS DATE/TIME : 04/05/15 18:45:22], []) - -AT_CLEANUP - - -# verify that the current date between ACCEPT DATE and DAY matches -# using the intrinsic conversion FUNCTIONs -AT_SETUP([ACCEPT DATE / DAY and intrinsic functions (1)]) -AT_KEYWORDS([accept FUNCTION INTEGER-OF-DATE DAY-OF-INTEGER]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - *> one byte longer to make sure there is no garbage in - 01 WS-YYYYMMDD PIC 9(9). - 01 WS-YYYYDDD PIC 9(8). - PROCEDURE DIVISION. - ACCEPT WS-YYYYMMDD FROM DATE YYYYMMDD - END-ACCEPT - ACCEPT WS-YYYYDDD FROM DAY YYYYDDD - END-ACCEPT - IF FUNCTION INTEGER-OF-DATE (WS-YYYYMMDD) - NOT = FUNCTION INTEGER-OF-DAY (WS-YYYYDDD) - DISPLAY "DIFFERENCES FOUND!" - END-DISPLAY - DISPLAY "YYYYMMDD = " WS-YYYYMMDD ", " - "YYYYDDD = " WS-YYYYDDD - END-DISPLAY - DISPLAY "INTEGER-OF-DATE = " - FUNCTION INTEGER-OF-DATE (WS-YYYYMMDD) ", " - "INTEGER-OF-DAY = " - FUNCTION INTEGER-OF-DAY (WS-YYYYDDD) - END-DISPLAY - MOVE 1 TO RETURN-CODE - END-IF - STOP RUN. -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [], []) - -AT_CLEANUP -AT_SETUP([ACCEPT DATE / DAY and intrinsic functions (2)]) -AT_KEYWORDS([accept configuration FUNCTION INTEGER-OF-DATE DAY-OF-INTEGER]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - *> one byte longer to make sure there is no garbage in - 01 WS-YYYYMMDD PIC 9(9). - 01 WS-YYYYDDD PIC 9(8). - PROCEDURE DIVISION. - ACCEPT WS-YYYYMMDD FROM DATE YYYYMMDD - END-ACCEPT - ACCEPT WS-YYYYDDD FROM DAY YYYYDDD - END-ACCEPT - IF FUNCTION INTEGER-OF-DATE (WS-YYYYMMDD) - NOT = FUNCTION INTEGER-OF-DAY (WS-YYYYDDD) - DISPLAY "DIFFERENCES FOUND!" - END-DISPLAY - DISPLAY "YYYYMMDD = " WS-YYYYMMDD ", " - "YYYYDDD = " WS-YYYYDDD - END-DISPLAY - DISPLAY "INTEGER-OF-DATE = " - FUNCTION INTEGER-OF-DATE (WS-YYYYMMDD) ", " - "INTEGER-OF-DAY = " - FUNCTION INTEGER-OF-DAY (WS-YYYYDDD) - END-DISPLAY - MOVE 1 TO RETURN-CODE - END-IF - STOP RUN. -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([COB_CURRENT_DATE='2015/04/05 18:45:22' \ -$COBCRUN_DIRECT ./prog], [0], [], []) - -AT_CLEANUP - -# -## Format 3: screen -# - -## TODO - only omitted tested so far - -AT_SETUP([ACCEPT OMITTED (SCREEN)]) -AT_KEYWORDS([accept extensions]) - -AT_CHECK([test "$COB_HAS_CURSES" = "yes" || exit 77]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - - DATA DIVISION. - SCREEN SECTION. - 01 scr. - 03 VALUE "Hello!" LINE 3 COL 3. - - PROCEDURE DIVISION. - ACCEPT OMITTED - END-ACCEPT. -]) - -AT_DATA([input.txt], [ -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog < input.txt], [0], ignore, []) - -AT_CLEANUP - diff -Nru gnucobol-4.0~early~20200606/tests/testsuite.src/run_extensions.at gnucobol-5/tests/testsuite.src/run_extensions.at --- gnucobol-4.0~early~20200606/tests/testsuite.src/run_extensions.at 2020-06-06 20:52:00.000000000 +0000 +++ gnucobol-5/tests/testsuite.src/run_extensions.at 1970-01-01 00:00:00.000000000 +0000 @@ -1,5377 +0,0 @@ -## Copyright (C) 2003-2012, 2014-2020 Free Software Foundation, Inc. -## Written by Keisuke Nishida, Roger While, Simon Sobisch, Edward Hart, -## Ron Norman -## -## This file is part of GnuCOBOL. -## -## The GnuCOBOL compiler is free software: you can redistribute it -## and/or modify it under the terms of the GNU General Public License -## as published by the Free Software Foundation, either version 3 of the -## License, or (at your option) any later version. -## -## GnuCOBOL is distributed in the hope that it will be useful, -## but WITHOUT ANY WARRANTY; without even the implied warranty of -## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -## GNU General Public License for more details. -## -## You should have received a copy of the GNU General Public License -## along with GnuCOBOL. If not, see . - -### GnuCOBOL Test Suite - -### Non-standard extensions - - -AT_SETUP([CALL BY CONTENT binary and literal]) -AT_KEYWORDS([extensions literals]) - -AT_DATA([dump.c], [ -#include -#include - -COB_EXT_EXPORT int -dump (unsigned char *data, char *p) -{ - int i; - if ( *p == 0 ) p++; - if ( *p == 0 ) p++; /* Skip for BIG Endian system */ - if ( *p == 0 ) p++; - if ( *p == 1 ) { - for (i = 0; i < 4; i++) - printf ("%02x", data[[i]]); - } else { - printf ("%8.8d", *((int *)data)); - } - puts (""); - return 0; -} -]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 X-1 PIC 9(9) VALUE 4660 COMP. - 01 X-2 PIC 9(9) VALUE 4660 COMP-5. - PROCEDURE DIVISION. - CALL "dump" USING X-1 BY CONTENT 1 - END-CALL. - CALL "dump" USING X-2 BY CONTENT 2 - END-CALL. - STOP RUN. -]) - -AT_CHECK([$COMPILE_MODULE dump.c], [0], [], []) -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], -[00001234 -00004660 -]) - -AT_CLEANUP - - -AT_SETUP([Numeric Boolean literals]) -AT_KEYWORDS([extensions]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 X-1 PIC 9(2) VALUE B"010101". - 01 X-2 PIC 9(20) VALUE B"111111111111111111111111111111 - - "111111111111111111111111111111 - - "1111". - PROCEDURE DIVISION. - DISPLAY X-1 - END-DISPLAY. - DISPLAY X-2 - END-DISPLAY. - STOP RUN. -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], -[21 -18446744073709551615 -]) - -AT_CLEANUP - - -AT_SETUP([ACUCOBOL literals]) -AT_KEYWORDS([extensions acu binary octal hexadecimal]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - PROCEDURE DIVISION. - DISPLAY B#101 UPON STDOUT - DISPLAY O#17777777777 UPON STDOUT - DISPLAY X#ffFFFFff UPON STDOUT - DISPLAY H#ffFFFFff UPON STDOUT - - STOP RUN. -]) - -AT_CHECK([$COMPILE -facu-literals=ok prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], -[5 -2147483647 -4294967295 -4294967295 -]) - -AT_CLEANUP - - -AT_SETUP([HP COBOL octal literals]) -AT_KEYWORDS([extensions]) - -# FIXME: the type of octal literals must be context-sensitive, see below -# currently hard-wired as numeric (may be switched in scanner.l to alphanumeric) - -AT_XFAIL_IF(true) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - *> Octal literal is "AB" in ASCII. - 01 ITEM-ALPHA PIC XX VALUE %40502. - *> Octal literal is 39. - 01 ITEM-NUMERIC PIC 99 BINARY VALUE %47. - *> Octal literal is ASCII 12. - 01 ITEM-NUM PIC 99 VALUE %30462. - PROCEDURE DIVISION. - *> Octal literal is "XY". - DISPLAY %54131. - IF ITEM-ALPHA NOT = "AB" - DISPLAY "VALUE %40502 is not ""AB"" (ASCII) but " - ITEM-ALPHA - END-IF - IF ITEM-NUMERIC NOT = 39 - DISPLAY "VALUE %47 BINARY is not 39 but " ITEM-NUMERIC - END-IF - IF ITEM-NUM NOT = 12 - DISPLAY "VALUE %30462 is not 12 (ASCII) but " ITEM-NUM - END-IF - *> Adds octal 23 (decimal 19, as it is an arithmetic expression). - ADD %23 TO ITEM-NUM. - IF ITEM-NUM NOT = 31 - DISPLAY "12 + %23 (19) is not 31 but " ITEM-NUM - END-IF - *> Sets the data to octal 30462 (ASCII 12). - MOVE %30462 TO ITEM-NUM - IF ITEM-NUM NOT = 12 - DISPLAY "%30462 is not 12 (ASCII) but " ITEM-NUM - END-IF - *> Sets the data to x'4100' (octal 101 -> ASCII A + right-pad NULL) - MOVE %101 TO ITEM-ALPHA - IF ITEM-ALPHA NOT = x"4100" - DISPLAY "%101 is not x""4100"" = Anull (ASCII) but " - ITEM-ALPHA - END-IF - - - STOP RUN. -]) - -AT_CHECK([$COMPILE -fhp-octal-literals=ok prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], -[XY -]) - -AT_CLEANUP - - -AT_SETUP([Hexadecimal numeric literals]) # FIXME: needs a dialect configuration -AT_KEYWORDS([extensions]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 X-1 PIC 9(8) VALUE H"012345". - 01 X-2 PIC 9(8) VALUE H"FFFFFF". - PROCEDURE DIVISION. - DISPLAY X-1 - END-DISPLAY. - DISPLAY X-2 - END-DISPLAY. - STOP RUN. -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], -[00074565 -16777215 -]) - -AT_CLEANUP - - -AT_SETUP([CALL USING numeric literal]) -AT_KEYWORDS([CALL]) - -AT_DATA([prog.cob], [ IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 MYRTN PIC X(9) VALUE "SUB ". - 01 BINFLD PIC S9(9) BINARY VALUE 1280. - - PROCEDURE DIVISION. - CALL "SUB" USING LENGTH OF MYRTN BY VALUE 10. - CALL "SUB" USING BINFLD BY VALUE 11. - CALL "SUB" USING BY CONTENT BINFLD BY VALUE 12. - CALL "SUB" USING BINFLD BY VALUE 13. - CALL "SUB" USING 1280 BY VALUE 14. - CALL "SUB" USING -1280 BY VALUE 15. - CALL "SUB" USING BY CONTENT 1280 BY VALUE 16. - CALL "SUB" USING BY CONTENT -1280 BY VALUE 17. - CALL "SUB" USING BY REFERENCE 1280 BY VALUE 18. - CALL "SUB" USING BY REFERENCE -1280 BY VALUE 19. - CALL "SUB" USING BY CONTENT BINFLD BY VALUE 20. - CALL "SUB" USING BY REFERENCE BINFLD BY VALUE 21. - CALL "SUB" USING 1665431892 BY VALUE 22. - CALL "SUB" USING 1665.892 BY VALUE 23. - CALL "SUB" USING 1665.89200 BY VALUE 24. - STOP RUN. - END PROGRAM prog. - - IDENTIFICATION DIVISION. - PROGRAM-ID. "SUB". - - DATA DIVISION. - LINKAGE SECTION. - 01 x PIC S9(9) BINARY. - 01 y PIC 9(9) COMP-5. - - PROCEDURE DIVISION USING x, VALUE y. - DISPLAY "COBOL: X is " x " and Y is " y. - ADD 1 TO x. - END PROGRAM "SUB". -]) - -AT_CHECK([cobc -x -std=mf -debug -Wall prog.cob], [0], [], []) - -AT_CHECK([./prog], [0], [COBOL: X is +000000009 and Y is 0000000010 -COBOL: X is +000001280 and Y is 0000000011 -COBOL: X is +000001281 and Y is 0000000012 -COBOL: X is +000001281 and Y is 0000000013 -COBOL: X is +000001280 and Y is 0000000014 -COBOL: X is -000001280 and Y is 0000000015 -COBOL: X is +000001280 and Y is 0000000016 -COBOL: X is -000001280 and Y is 0000000017 -COBOL: X is +000001280 and Y is 0000000018 -COBOL: X is -000001280 and Y is 0000000019 -COBOL: X is +000001282 and Y is 0000000020 -COBOL: X is +000001282 and Y is 0000000021 -COBOL: X is +665431892 and Y is 0000000022 -COBOL: X is +001665892 and Y is 0000000023 -COBOL: X is +166589200 and Y is 0000000024 -], []) - -AT_CLEANUP - - -## Expression - -AT_SETUP([Semi-parenthesized condition]) -AT_KEYWORDS([extensions]) # Shouldn't this be in run_fundamentals? - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - PROCEDURE DIVISION. - IF 1 = (1 OR 2) - DISPLAY "OK" NO ADVANCING - END-DISPLAY - END-IF. - STOP RUN. -]) - -AT_CHECK([$COMPILE -Wno-constant-expression prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [OK], []) - -AT_CLEANUP - - -AT_SETUP([ADDRESS OF]) # Shouldn't this be in run_fundamentals? -AT_KEYWORDS([extensions]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 X-1 PIC X(3) VALUE "X-1". - 01 X-2 PIC X(3) VALUE "X-2". - 01 G. - 02 PTR-1 USAGE POINTER VALUE NULL. - 02 PTR-2 USAGE POINTER VALUE NULL. - LINKAGE SECTION. - 01 Y PIC X(3). - PROCEDURE DIVISION. - SET ADDRESS OF Y TO ADDRESS OF X-1. - IF Y NOT = "X-1" - DISPLAY "Test 1 " Y - END-DISPLAY - END-IF. - SET PTR-1 TO ADDRESS OF X-2. - SET PTR-2 TO PTR-1 - SET ADDRESS OF Y TO PTR-2. - IF Y NOT = "X-2" - DISPLAY "Test 2 " Y - END-DISPLAY - END-IF - INITIALIZE PTR-1. - IF PTR-1 NOT = NULL - DISPLAY "NG 1" - END-DISPLAY - END-IF. - SET ADDRESS OF Y TO NULL. - IF PTR-1 NOT = ADDRESS OF Y - DISPLAY "NG 2" - END-DISPLAY - END-IF. - IF ADDRESS OF Y NOT = PTR-1 - DISPLAY "NG 3" - END-DISPLAY - END-IF. -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [], []) - -AT_CLEANUP - - -AT_SETUP([LENGTH OF]) -AT_KEYWORDS([extensions VALUE RENAMES]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 X PIC X(2). - 01 G. - 02 Y PIC X(2) OCCURS 10. - 02 G-GROUP. - 03 G-SGROUP. - 04 G1 PIC X(05). - 04 G2 PIC X(06). - 04 G3 PIC X(22). - 03 FILLER PIC XX OCCURS 5. - 66 RENAME-STD-G RENAMES G-GROUP. - 66 RENAME-STD-SG RENAMES G-SGROUP. - 66 RENAME-STD RENAMES G1 THROUGH G3. - 66 RENAME-G RENAMES G. - 01 L PIC s9(4)v99. - 01 I PIC 9(2) VALUE 10. - 78 I-LEN VALUE LENGTH OF I. - * TODO: check size of FILLER here - 01 TSTDISP. - 02 FILLER OCCURS 5000. - 10 T1 PIC X(11). - 10 T2 PIC X(22). - 78 var-length-l value length of '00128'. - 78 var-length-x value length of x'a0'. - 78 var-length-z value length of z'a0'. - *78 var-length-n value length of n'001'. - PROCEDURE DIVISION. - move var-length-l TO L - IF L NOT = 5 - DISPLAY "Length '00128'" L - END-DISPLAY - END-IF - move var-length-x TO L - IF L NOT = 1 - DISPLAY "Length x'a0'" L - END-DISPLAY - END-IF - move var-length-z TO L - IF L NOT = 3 - DISPLAY "Length z'a0'" L - END-DISPLAY - END-IF - * What does MF reports here? - *> move var-length-n TO L - *> IF L NOT = 3 - *> DISPLAY "Length n'001'" L - *> END-DISPLAY - *> END-IF - MOVE LENGTH OF X TO L - IF L NOT = 2 - DISPLAY "Length 1 " L - END-DISPLAY - END-IF - MOVE LENGTH OF X TO L - IF L NOT = 2 - DISPLAY "Length 1a " L LENGTH X - END-DISPLAY - END-IF - MOVE LENGTH OF Y TO L - IF L NOT = 2 - DISPLAY "Length 2 " L - END-DISPLAY - END-IF - IF L NOT = 2 - DISPLAY "Length 2a " L LENGTH OF Y - END-DISPLAY - END-IF - MOVE LENGTH OF Y(1) TO L - IF L NOT = 2 - DISPLAY "Length 3 " L - END-DISPLAY - END-IF - MOVE LENGTH Y(1) TO L - IF L NOT = 2 - DISPLAY "Length 3a " L LENGTH OF Y(1) - END-DISPLAY - END-IF - IF I-LEN NOT = 2 - DISPLAY "Length 4 " I-LEN - END-DISPLAY - END-IF - IF LENGTH OF L + 2 NOT = 8 - ADD 2 TO LENGTH OF L GIVING L - DISPLAY "Length 5 + 2" L - END-DISPLAY - END-IF - IF LENGTH L + 2 NOT = 8 - ADD 2 TO LENGTH L GIVING L - DISPLAY "Length 5a + 2 " L - END-DISPLAY - END-IF - MOVE 0 TO L - PERFORM LENGTH OF L TIMES - ADD 1 TO L - END-PERFORM - PERFORM LENGTH L TIMES - ADD 1 TO L - END-PERFORM - IF L NOT = 12 - DISPLAY "Length 6 " L - END-DISPLAY - END-IF - MOVE 0 TO L - PERFORM VARME - VARYING I FROM LENGTH OF I - BY LENGTH OF X - UNTIL I > LENGTH OF L - IF ((L NOT = 3) OR - (I NOT = 8) ) - DISPLAY "Length 7 " L " - " I - END-DISPLAY - END-IF - MOVE 0 TO L - PERFORM VARME - VARYING I FROM LENGTH I - BY LENGTH X - UNTIL I > LENGTH L - IF ((L NOT = 3) OR - (I NOT = 8) ) - DISPLAY "Length 7a " L " - " I - END-DISPLAY - END-IF - MOVE LENGTH OF RENAME-STD-SG TO L - IF L NOT = 33 - DISPLAY "Length 8a " L - END-DISPLAY - END-IF - MOVE LENGTH OF RENAME-STD-G TO L - IF L NOT = 43 - DISPLAY "Length 8b " L - END-DISPLAY - END-IF - MOVE LENGTH OF RENAME-STD TO L - IF L NOT = 33 - DISPLAY "Length 8c " L - END-DISPLAY - END-IF - MOVE LENGTH OF RENAME-G TO L - IF L NOT = 63 - DISPLAY "Length 8d " L - END-DISPLAY - END-IF - *> one display test - DISPLAY LENGTH OF TSTDISP WITH NO ADVANCING - END-DISPLAY - STOP RUN. - VARME. - ADD 1 TO L - . -]) - -AT_CHECK([$COMPILE -Wno-constant-expression prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [165000], []) - -AT_CLEANUP - - -AT_SETUP([SET TO SIZE OF]) -AT_KEYWORDS([extensions acu LENGTH]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - CONFIGURATION SECTION. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 TST PIC X(10) VALUE "abcdefghij". - 01 TST2. - 05 FILLER OCCURS 5000. - 10 T2-1 PIC X(11). - 10 T2-2 PIC X(22). - 01 LN PIC 9(06). - - PROCEDURE DIVISION. - SET LN TO SIZE OF TST - IF LN NOT = 10 - DISPLAY "SIZE OF TST is " LN UPON SYSERR - END-DISPLAY - END-IF - SET LN TO SIZE OF TST2 - IF LN NOT = 165000 - DISPLAY "SIZE OF TST2 is " LN UPON SYSERR - END-DISPLAY - END-IF - STOP RUN. -]) - -AT_CHECK([$COMPILE prog.cob ], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [], []) - -AT_CLEANUP - - -AT_SETUP([WHEN-COMPILED]) -AT_KEYWORDS([extensions]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 X PIC X(20). - PROCEDURE DIVISION. - MOVE WHEN-COMPILED TO X. - INSPECT X CONVERTING "0123456789" TO "9999999999". - IF X NOT = "99/99/9999.99.99 " - CALL 'CBL_OC_DUMP' USING X - ON EXCEPTION - DISPLAY X NO ADVANCING - END-DISPLAY - END-CALL - END-IF - STOP RUN. -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [], []) - -AT_CLEANUP - -## OCCURS - -AT_SETUP([Complex OCCURS DEPENDING ON (1)]) -AT_KEYWORDS([extensions]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 I PIC 9. - 01 G-1 VALUE "123456789". - 02 G-2. - 03 X PIC X OCCURS 1 TO 3 DEPENDING ON I. - 02 G-3. - 03 G-4. - 04 X PIC X OCCURS 1 TO 3 DEPENDING ON I. - 03 G-5. - 04 X PIC X OCCURS 1 TO 3 DEPENDING ON I. - PROCEDURE DIVISION. - MOVE 2 TO I. - DISPLAY G-1 ":" G-4 ":" G-5 NO ADVANCING - . -]) - -AT_CHECK([$COMPILE -std=mvs prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [123456:34:56]) - -AT_CLEANUP - - -AT_SETUP([Complex OCCURS DEPENDING ON (2)]) -AT_KEYWORDS([extensions]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 I PIC 99. - 01 J PIC 99. - 01 K PIC 99. - 01 VLEN PIC 99. - 01 VTOP. - 03 VGROUP. - 05 VX OCCURS 1 TO 5 DEPENDING ON I. - 10 VXX PIC X(1). - 05 VY OCCURS 1 TO 5 DEPENDING ON J. - 10 VYY PIC X(2). - 05 ZZ OCCURS 1 TO 5 DEPENDING ON K. - 10 VZZ PIC X(3). - PROCEDURE DIVISION. - MOVE 1 TO I. - MOVE 1 TO J. - MOVE 1 TO K. - MOVE '1' TO VXX (1). - MOVE '22' TO VYY (1). - MOVE '333' TO VZZ (1). - MOVE LENGTH OF VGROUP TO VLEN. - DISPLAY VLEN NO ADVANCING - END-DISPLAY. - MOVE FUNCTION LENGTH (VGROUP) TO VLEN. - DISPLAY VLEN NO ADVANCING - END-DISPLAY. - DISPLAY VGROUP - END-DISPLAY. - INITIALIZE VTOP. - MOVE 3 TO I. - MOVE 2 TO J. - MOVE 1 TO K. - MOVE '3' TO VXX (3). - MOVE '22' TO VYY (2). - MOVE '111' TO VZZ (1). - MOVE LENGTH OF VGROUP TO VLEN. - DISPLAY VLEN NO ADVANCING - END-DISPLAY. - MOVE FUNCTION LENGTH (VGROUP) TO VLEN. - DISPLAY VLEN NO ADVANCING - END-DISPLAY. - DISPLAY VGROUP - END-DISPLAY. - STOP RUN. -]) - -AT_CHECK([$COMPILE -std=mf prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], -[18181 22 333 -1818 3 22 111 -]) - -AT_CLEANUP - - -AT_SETUP([Complex OCCURS DEPENDING ON (3)]) -AT_KEYWORDS([extensions]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 I PIC 99. - 01 J PIC 99. - 01 K PIC 99. - 01 VLEN PIC 99. - 01 VTOP. - 03 VGROUP. - 05 VX OCCURS 1 TO 5 DEPENDING ON I. - 10 VXX PIC X(1). - 05 VY OCCURS 1 TO 5 DEPENDING ON J. - 10 VYY PIC X(2). - 05 ZZ OCCURS 1 TO 5 DEPENDING ON K. - 10 VZZ PIC X(3). - PROCEDURE DIVISION. - MOVE 1 TO I. - MOVE 1 TO J. - MOVE 1 TO K. - MOVE '1' TO VXX (1). - MOVE '22' TO VYY (1). - MOVE '333' TO VZZ (1). - MOVE LENGTH OF VGROUP TO VLEN. - DISPLAY VLEN NO ADVANCING - END-DISPLAY. - MOVE FUNCTION LENGTH (VGROUP) TO VLEN. - DISPLAY VLEN NO ADVANCING - END-DISPLAY. - DISPLAY VGROUP - END-DISPLAY. - INITIALIZE VTOP. - MOVE 3 TO I. - MOVE 2 TO J. - MOVE 1 TO K. - MOVE '3' TO VXX (3). - MOVE '22' TO VYY (2). - MOVE '111' TO VZZ (1). - MOVE LENGTH OF VGROUP TO VLEN. - DISPLAY VLEN NO ADVANCING - END-DISPLAY. - MOVE FUNCTION LENGTH (VGROUP) TO VLEN. - DISPLAY VLEN NO ADVANCING - END-DISPLAY. - DISPLAY VGROUP - END-DISPLAY. - STOP RUN. -]) - -AT_CHECK([$COMPILE -fcomplex-odo -fodoslide prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], -[0606122333 -1010 3 22111 -]) - -AT_CLEANUP - - -AT_SETUP([Complex OCCURS DEPENDING ON (4)]) -AT_KEYWORDS([extensions]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 I PIC 99. - 01 J PIC 99. - 01 K PIC 99. - 01 VLEN PIC 99. - 01 VTOP. - 03 VGROUP. - 05 VX OCCURS 1 TO 5 DEPENDING ON I. - 10 VXX PIC X(1). - 05 VY OCCURS 1 TO 5 DEPENDING ON J. - 10 VYY PIC X(2). - 05 ZZ OCCURS 1 TO 5 DEPENDING ON K. - 10 VZZ PIC X(3). - 05 VFIX PIC X(3). - PROCEDURE DIVISION. - MOVE 1 TO I. - MOVE 1 TO J. - MOVE 1 TO K. - MOVE '1' TO VXX (1). - MOVE '22' TO VYY (1). - MOVE '333' TO VZZ (1). - MOVE '444' TO VFIX. - MOVE LENGTH OF VGROUP TO VLEN. - DISPLAY VLEN NO ADVANCING - END-DISPLAY. - MOVE FUNCTION LENGTH (VGROUP) TO VLEN. - DISPLAY VLEN NO ADVANCING - END-DISPLAY. - DISPLAY VGROUP - END-DISPLAY. - INITIALIZE VTOP. - MOVE 3 TO I. - MOVE 2 TO J. - MOVE 1 TO K. - MOVE '3' TO VXX (3). - MOVE '22' TO VYY (2). - MOVE '111' TO VZZ (1). - MOVE '000' TO VFIX. - MOVE LENGTH OF VGROUP TO VLEN. - DISPLAY VLEN NO ADVANCING - END-DISPLAY. - MOVE FUNCTION LENGTH (VGROUP) TO VLEN. - DISPLAY VLEN NO ADVANCING - END-DISPLAY. - DISPLAY VGROUP - END-DISPLAY. - STOP RUN. -]) - -AT_CHECK([$COMPILE -fcomplex-odo prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], -[33331 22 333 444 -3333 3 22 111 000 -]) - -AT_CLEANUP - - -AT_SETUP([Complex OCCURS DEPENDING ON (5)]) -AT_KEYWORDS([extensions]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 I PIC 99. - 01 J PIC 99. - 01 K PIC 99. - 01 VLEN PIC 99. - 01 VTOP. - 03 VGROUP. - 05 VX OCCURS 1 TO 5 DEPENDING ON I. - 10 VXX PIC X(1). - 05 VY OCCURS 1 TO 5 DEPENDING ON J. - 10 VYY PIC X(2). - 05 ZZ OCCURS 1 TO 5 DEPENDING ON K. - 10 VZZ PIC X(3). - 05 VFIX PIC X(3). - PROCEDURE DIVISION. - MOVE 1 TO I. - MOVE 1 TO J. - MOVE 1 TO K. - MOVE '1' TO VXX (1). - MOVE '22' TO VYY (1). - MOVE '333' TO VZZ (1). - MOVE '444' TO VFIX. - MOVE LENGTH OF VGROUP TO VLEN. - DISPLAY VLEN NO ADVANCING - END-DISPLAY. - MOVE FUNCTION LENGTH (VGROUP) TO VLEN. - DISPLAY VLEN NO ADVANCING - END-DISPLAY. - DISPLAY VGROUP - END-DISPLAY. - INITIALIZE VTOP. - MOVE 3 TO I. - MOVE 2 TO J. - MOVE 1 TO K. - MOVE '3' TO VXX (3). - MOVE '22' TO VYY (2). - MOVE '111' TO VZZ (1). - MOVE '000' TO VFIX. - MOVE LENGTH OF VGROUP TO VLEN. - DISPLAY VLEN NO ADVANCING - END-DISPLAY. - MOVE FUNCTION LENGTH (VGROUP) TO VLEN. - DISPLAY VLEN NO ADVANCING - END-DISPLAY. - DISPLAY VGROUP - END-DISPLAY. - STOP RUN. -]) - -AT_CHECK([$COMPILE -fcomplex-odo -fodoslide prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], -[0909122333444 -1313 3 22111000 -]) - -AT_CLEANUP - - -AT_SETUP([Complex OCCURS DEPENDING ON (6)]) -AT_KEYWORDS([extensions runsubscripts nested subscripts]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 n PIC 9 VALUE 2. - 01 m PIC 9 VALUE 3. - - 01 a-table VALUE "ABCDEFGHIJ". - 03 rows OCCURS 0 TO 2 TIMES - DEPENDING ON n. - 05 chars OCCURS 0 TO 5 TIMES - DEPENDING ON m - PIC X. - - 01 vals PIC X(3). - - PROCEDURE DIVISION. - MOVE chars (1, 2) TO vals (1:1) - MOVE chars (2, 1) TO vals (2:1) - MOVE chars (2, 3) TO vals (3:1) - IF vals NOT = "BDF" - DISPLAY "Vals (slided) wrong: " vals - END-DISPLAY - END-IF - IF a-table NOT = "ABCDEF" - DISPLAY "Table (slided) wrong: " a-table - END-DISPLAY - END-IF - . -]) - -AT_CHECK([$COMPILE -fcomplex-odo -fodoslide prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [], []) - -AT_CLEANUP - - -AT_SETUP([OCCURS UNBOUNDED (1)]) -AT_KEYWORDS([extensions runsubscripts subscripts]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 n PIC 9(03) VALUE 123. - 01 p USAGE POINTER. - - LINKAGE SECTION. - 01 a-table. - 03 rows OCCURS 0 TO UNBOUNDED TIMES - DEPENDING ON n. - 05 col1 PIC X. - 05 col2 PIC X(02). - - PROCEDURE DIVISION. - IF FUNCTION LENGTH (a-table) NOT = 369 - DISPLAY 'WRONG LENGTH: ' FUNCTION LENGTH (a-table) - END-DISPLAY - END-IF - ALLOCATE FUNCTION LENGTH (a-table) CHARACTERS - INITIALIZED TO ALL "ABCDE" - RETURNING p - SET ADDRESS OF a-table TO p - IF col2(1) NOT = "BC" - DISPLAY "col2(1) wrong: " col2(1) - END-DISPLAY - END-IF - IF rows(2) NOT = "DEA" - DISPLAY "rows(2) wrong: " rows(2) - END-DISPLAY - END-IF - . -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [], []) - -AT_CLEANUP - - -AT_SETUP([OCCURS UNBOUNDED (2)]) -AT_KEYWORDS([extensions runsubscripts DEPENDING odo subscripts]) - -# note: the following example is from IBM's Language Reference -# for Enterprise COBOL for z/OS 6.1, but with fixed use -# of old-size (+ removing some binary zeros for output) - -AT_DATA([ALLOC.cob], [ - ID DIVISION. - PROGRAM-ID. ALLOC. - ENVIRONMENT DIVISION. - DATA DIVISION. - WORKING-STORAGE SECTION. - 77 X PIC 9(2) PACKED-DECIMAL. - 77 NUM-ELEMENTS PIC 9(4) BINARY. - 77 SIZE-NEEDED PIC 9(4) BINARY. - 77 old-size pic 9(4) binary. - 77 VPTR POINTER. - 77 VPTR2 POINTER. - 77 VPTR3 POINTER. - - LINKAGE SECTION. - - 01 VARGRP. - 02 OBJ PIC 9(4) COMP. - 02 TABGRP. - 03 VARTAB OCCURS 1 TO UNBOUNDED DEPENDING ON OBJ. - 04 T1 PIC 9(4). - 04 T2 PIC X(8). - 04 T3 PIC 9(4). *> changed from COMP because of output - 01 BUFFER PIC X(1000). - - PROCEDURE DIVISION. - - *> DISPLAY 'Starting testcase ALLOC' - - SET VPTR VPTR2 VPTR3 To NULL - - ************************************************************* - * Allocate a table with 20 elements - ************************************************************* - COMPUTE NUM-ELEMENTS = 20 - PERFORM ALLOC-VARGRP - - ************************************************************* - * Set some 'test' values to validate re-allocated table - ************************************************************* - initialize vartab(12), vartab(17) - COMPUTE T1(12) = 9999 - MOVE 'HI MOM' TO T2 (17) - *> DISPLAY ' ' - DISPLAY 'VARTAB(12) = "' VARTAB(12) '"' - DISPLAY 'VARTAB(17) = "' VARTAB(17) '"' - *> DISPLAY ' ' - - ************************************************************* - * Need a bigger table! Allocate a larger one and copy data - ************************************************************* - COMPUTE NUM-ELEMENTS = 30 - PERFORM ALLOC-VARGRP - - ************************************************************* - * Ensure that new table has correct data from original - ************************************************************* - DISPLAY 'VARTAB(12) = "' VARTAB(12) '"' - DISPLAY 'VARTAB(17) = "' VARTAB(17) '"' - - GOBACK. - - ************************************************************* - * The first time allocate the original table. If the table - * has already been allocated, assume that we are allocating - * a larger one and want to copy the data over to it - ************************************************************* - ALLOC-VARGRP. - - If VPTR = NULL Then *> If first time, allocate the table - COMPUTE SIZE-NEEDED = LENGTH OF OBJ + - LENGTH OF VARTAB * NUM-ELEMENTS - display 'First allocation, using ' size-needed ' bytes.' - ALLOCATE SIZE-NEEDED CHARACTERS INITIALIZED RETURNING VPTR - - SET ADDRESS OF VARGRP TO VPTR - MOVE NUM-ELEMENTS TO OBJ - - Else *> If already have a table, doing re-size - ********************************************************************* - * Re-size it! - * First, allocate space for data save area and move data in - ********************************************************************* - - ALLOCATE SIZE-NEEDED CHARACTERS INITIALIZED RETURNING VPTR2 - SET ADDRESS OF BUFFER TO VPTR2 - MOVE VARGRP TO BUFFER(1:SIZE-NEEDED) - inspect BUFFER(3:SIZE-NEEDED - 3) - replacing all x'00' by space - DISPLAY 'BUFFER = "' BUFFER(170:66) '"' - DISPLAY ' "' BUFFER(226:66) '"' - move size-needed to old-size - - ********************************************************************* - * Calculate new size from NUM-ElEMENTS - ********************************************************************* - COMPUTE SIZE-NEEDED = LENGTH OF OBJ + - LENGTH OF VARTAB * NUM-ELEMENTS - - display 'Re-allocation, using ' size-needed ' bytes.' - *> ALLOCATE SIZE-NEEDED CHARACTERS INITIALIZED RETURNING VPTR3 - if size-needed < 2097152 - ALLOCATE SIZE-NEEDED CHARACTERS INITIALIZED - loc 24 - RETURNING VPTR3 - else - ALLOCATE SIZE-NEEDED CHARACTERS INITIALIZED - loc 31 - RETURNING VPTR3 - end-if - - ************************************************************* - * Move data from data save area to new larger table - ************************************************************* - SET ADDRESS OF VARGRP TO VPTR3 - MOVE NUM-ELEMENTS TO OBJ - MOVE BUFFER(1:old-size) TO VARGRP - ************************************************************* - * Free the original table and temp copy - ************************************************************* - FREE VPTR VPTR2 - SET VPTR TO VPTR2 - . -]) - -AT_CHECK([$COMPILE -std=ibm-strict -w ALLOC.cob], [0], [], []) - -AT_CHECK([$COBCRUN_DIRECT ./ALLOC], [0], -[First allocation, using 00322 bytes. -VARTAB(12) = "9999 0000" -VARTAB(17) = "0000HI MOM 0000" -BUFFER = " 9999 0000 " - " 0000HI MOM 0000 " -Re-allocation, using 00482 bytes. -VARTAB(12) = "9999 0000" -VARTAB(17) = "0000HI MOM 0000" -], []) - -AT_CLEANUP - - -AT_SETUP([DEPENDING ON with ODOSLIDE]) -AT_KEYWORDS([nested ODO]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - CONFIGURATION SECTION. - INPUT-OUTPUT SECTION. - FILE-CONTROL. - SELECT FLATFILE - ASSIGN "SEQODO" - ORGANIZATION LINE SEQUENTIAL - FILE STATUS IS CUST-STAT . - - DATA DIVISION. - FILE SECTION. - FD FLATFILE - BLOCK CONTAINS 5 RECORDS. - - 01 TSTREC. - 05 SEQ PIC 99. - 05 DEP-X PIC 99. - 05 DEP-Y PIC 99. - 05 HELLO PIC X(5) VALUE 'World'. - 05 TSTGRP. - 10 TSTGRP1. - 15 TSTX OCCURS 1 TO 3 TIMES - DEPENDING ON DEP-X. - 20 TSTG-1 PIC Z9. - 15 TSTTAIL1 PIC XXXX. - 10 TSTY-ALL. - 15 TSTY OCCURS 1 TO 3 TIMES - DEPENDING ON DEP-X. - 20 TSTY-1 PIC 99. - 20 TSTY-2 PIC XXX. - 20 TSTY-3 PIC X - OCCURS 1 TO 12 TIMES - DEPENDING ON DEP-Y. - 20 TSTY-4 PIC XX. - 20 TSTY-5 OCCURS 1 TO 3 TIMES - DEPENDING ON DEP-X. - 25 TSTY-6 OCCURS 1 TO 3 TIMES - DEPENDING ON DEP-X. - 30 TSTY-7 PIC X. - 10 TSTTAIL2 PIC XX. - - WORKING-STORAGE SECTION. - 77 CUST-STAT PIC X(2). - 01 LN PIC 9(3). - 01 IX PIC 9(9) BINARY. - 01 IY PIC 9(9) BINARY. - 01 IZ PIC 9(9) BINARY. - 01 TSTXXX PIC X(26) VALUE "Abcdefghijklmnopqrstuvwxyz". - 01 TSTALPHA REDEFINES TSTXXX. - 05 ALPH-CHR PIC X OCCURS 26 TIMES. - 01 TSTHEX PIC X(15) VALUE "123456789ABCDEF". - 01 FILLER REDEFINES TSTHEX. - 05 HEX-CHR PIC X OCCURS 15 TIMES. - - 01 TSTREC2. - 05 DEP-X2 PIC 99. - 05 TSTGRP2. - 10 TSTX2 OCCURS 1 TO 3 TIMES DEPENDING ON DEP-X2. - 15 TSTG2-1 PIC Z9. - 10 TST2TAIL1 PIC XXX. - - 01 TSTREC3. - 05 DEP-X3 PIC 99. - 05 TSTGRP3. - 10 TSTX3 OCCURS 1 TO 6 TIMES DEPENDING ON DEP-X3. - 15 TSTG3-1 PIC 9. - 01 TSTWRK PIC X(24). - - PROCEDURE DIVISION. - MAIN-10. - MOVE 6 TO DEP-X3. - MOVE 1 TO TSTG3-1 (1). - MOVE 2 TO TSTG3-1 (2). - MOVE 3 TO TSTG3-1 (3). - MOVE 4 TO TSTG3-1 (4). - MOVE 5 TO TSTG3-1 (5). - MOVE 6 TO TSTG3-1 (6). - MOVE 3 TO DEP-X3. - STRING TSTGRP3 "-TRAILER" DELIMITED BY SIZE - INTO TSTWRK. - DISPLAY "'" TSTWRK "'". - OPEN OUTPUT FLATFILE. - MOVE "Howdy" TO HELLO. - MOVE 0 TO SEQ. - MOVE 2 TO DEP-X. - MOVE 5 TO DEP-Y. - PERFORM WRITE-REC. - MOVE 1 TO DEP-X. - MOVE 2 TO DEP-Y. - PERFORM WRITE-REC. - MOVE 3 TO DEP-X. - MOVE 3 TO DEP-Y. - PERFORM WRITE-REC. - MOVE 3 TO DEP-X. - MOVE 10 TO DEP-Y. - PERFORM WRITE-REC. - CLOSE FLATFILE. - OPEN INPUT FLATFILE. - PERFORM READ-REC. - CLOSE FLATFILE. - STOP RUN. - - WRITE-REC SECTION. - ADD 1 TO SEQ. - MOVE LENGTH OF TSTREC TO LN. - DISPLAY "Write SEQ " SEQ ", DEP-X = " DEP-X - " & DEP-Y = " DEP-Y - ", TSTREC len:" LN. - MOVE ALL "*" TO TSTGRP. - MOVE "<>" TO TSTTAIL1, TSTTAIL2. - PERFORM VARYING IX FROM 1 BY 1 - UNTIL IX > DEP-X - MOVE IX TO TSTG-1 (IX) - END-PERFORM. - MOVE LENGTH OF TSTGRP1 TO LN. - DISPLAY "Group1: '" TSTGRP1 "' len:" LN. - PERFORM VARYING IX FROM 1 BY 1 - UNTIL IX > DEP-X - MOVE IX TO TSTY-1 (IX) - MOVE "." TO TSTY-4 (IX) - PERFORM VARYING IY FROM 1 BY 1 - UNTIL IY > DEP-Y - MOVE ALPH-CHR (IY) TO TSTY-3 (IX, IY) - END-PERFORM - END-PERFORM. - PERFORM VARYING IX FROM 1 BY 1 - UNTIL IX > DEP-X - PERFORM VARYING IY FROM 1 BY 1 - UNTIL IY > DEP-X - PERFORM VARYING IZ FROM 1 BY 1 - UNTIL IZ > DEP-X - MOVE HEX-CHR (IX+IY+IZ) TO TSTY-7 (IX, IY, IZ) - END-PERFORM - END-PERFORM - END-PERFORM. - DISPLAY " Data: '" TSTGRP "'". - - MOVE ALL "*" TO TSTGRP2. - MOVE DEP-X TO DEP-X2. - PERFORM VARYING IX FROM 1 BY 1 - UNTIL IX > DEP-X2 - MOVE IX TO TSTG2-1 (IX) - END-PERFORM. - MOVE "<>" TO TST2TAIL1. - MOVE LENGTH OF TSTGRP2 TO LN. - DISPLAY "Group2: '" TSTGRP2 "' len:" LN. - WRITE TSTREC. - - READ-REC SECTION. - READ-10. - READ FLATFILE AT END GO TO READ-99. - MOVE LENGTH OF TSTREC TO LN. - DISPLAY "Read SEQ " SEQ ", DEP-X = " DEP-X - " & DEP-Y = " DEP-Y - ", TSTREC len:" LN. - DISPLAY " Data: '" TSTGRP "'". - GO TO READ-10. - READ-99. - EXIT . -]) - -# FIXME: odo-checks (-debug) must be adjusted, either with -fodoslide or with a possibly new -# compiler configuration flag as IBM seems to only check against the field-founder's -# bounds, not the subscript (which is the reason to use "$COBC -x" instead of "$COMPILE") -AT_CHECK([$COBC -x -fodoslide prog.cob], [0], [], []) - -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], -['123-TRAILER ' -Write SEQ 01, DEP-X = 02 & DEP-Y = 05, TSTREC len:053 -Group1: ' 1 2<> ' len:008 - Data: ' 1 2<> 01***Abcde. 344502***Abcde. 4556<>' -Group2: ' 1 2<> ' len:007 -Write SEQ 02, DEP-X = 01 & DEP-Y = 02, TSTREC len:029 -Group1: ' 1<> ' len:006 - Data: ' 1<> 01***Ab. 3<>' -Group2: ' 1<> ' len:005 -Write SEQ 03, DEP-X = 03 & DEP-Y = 03, TSTREC len:080 -Group1: ' 1 2 3<> ' len:010 - Data: ' 1 2 3<> 01***Abc. 34545656702***Abc. 45656767803***Abc. 567678789<>' -Group2: ' 1 2 3<> ' len:009 -Write SEQ 04, DEP-X = 03 & DEP-Y = 10, TSTREC len:101 -Group1: ' 1 2 3<> ' len:010 - Data: ' 1 2 3<> 01***Abcdefghij. 34545656702***Abcdefghij. 45656767803***Abcdefghij. 567678789<>' -Group2: ' 1 2 3<> ' len:009 -Read SEQ 01, DEP-X = 02 & DEP-Y = 05, TSTREC len:053 - Data: ' 1 2<> 01***Abcde. 344502***Abcde. 4556<>' -Read SEQ 02, DEP-X = 01 & DEP-Y = 02, TSTREC len:029 - Data: ' 1<> 01***Ab. 3<>' -Read SEQ 03, DEP-X = 03 & DEP-Y = 03, TSTREC len:080 - Data: ' 1 2 3<> 01***Abc. 34545656702***Abc. 45656767803***Abc. 567678789<>' -Read SEQ 04, DEP-X = 03 & DEP-Y = 10, TSTREC len:101 - Data: ' 1 2 3<> 01***Abcdefghij. 34545656702***Abcdefghij. 45656767803***Abcdefghij. 567678789<>' -], []) - - -AT_CAPTURE_FILE(./SEQODO) - -AT_DATA([reference], -[010205Howdy 1 2<> 01***Abcde. 344502***Abcde. 4556<> -020102Howdy 1<> 01***Ab. 3<> -030303Howdy 1 2 3<> 01***Abc. 34545656702***Abc. 45656767803***Abc. 567678789<> -040310Howdy 1 2 3<> 01***Abcdefghij. 34545656702***Abcdefghij. 45656767803***Abcdefghij. 567678789<> -]) - -AT_CHECK([diff reference SEQODO], [0], [], []) - -AT_CLEANUP - - -AT_SETUP([DEPENDING ON with ODOSLIDE for IBM]) -AT_KEYWORDS([OCCURS ODO]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 L1-1-2-S PIC 99. - 01 L1-1-2-1-S PIC 99. - 01 L1-2-S PIC 99. - 01 L1-3-S PIC 99. - 01 L1-3-2-S PIC 99. - 01 BUFFER PIC X(370). - - PROCEDURE DIVISION. - MOVE ALL '0123456789' TO BUFFER. - MOVE 3 TO L1-1-2-S. - MOVE 4 TO L1-1-2-1-S. - MOVE 0 TO L1-2-S. - MOVE 6 TO L1-3-S. - MOVE 1 TO L1-3-2-S. - CALL 'IBM-ODO-TEST' USING BUFFER - L1-1-2-S - L1-1-2-1-S - L1-2-S - L1-3-S - L1-3-2-S. - - MOVE ALL '0123456789' TO BUFFER. - MOVE 2 TO L1-1-2-S. - MOVE 3 TO L1-1-2-1-S. - MOVE 1 TO L1-2-S. - MOVE 4 TO L1-3-S. - MOVE 0 TO L1-3-2-S. - CALL 'IBM-ODO-TEST' USING BUFFER - L1-1-2-S - L1-1-2-1-S - L1-2-S - L1-3-S - L1-3-2-S. - STOP RUN. - END PROGRAM prog. - - IDENTIFICATION DIVISION. - PROGRAM-ID. IBM-ODO-TEST. - - DATA DIVISION. - WORKING-STORAGE SECTION. - - LINKAGE SECTION. - 01 L1-1-2-S PIC 99. - 01 L1-1-2-1-S PIC 99. - 01 L1-2-S PIC 99. - 01 L1-3-S PIC 99. - 01 L1-3-2-S PIC 99. - 01 BASE. - 10 ARRAY OCCURS 2 TIMES. - 20 L1-1. - 25 L1-1-1 PIC X(3). - 25 L1-1-2 OCCURS 4 TIMES DEPENDING ON L1-1-2-S. - 30 L1-1-2-1 OCCURS 5 TIMES DEPENDING ON L1-1-2-1-S - PIC XXX. - 20 L1-2 OCCURS 0 TO 1 TIMES DEPENDING ON L1-2-S PIC XX. - 20 L1-3 OCCURS 1 TO 10 TIMES DEPENDING ON L1-3-S. - 25 L1-3-1. - 30 L1-3-1-1 PIC X(5). - 30 L1-3-1-2 PIC X. - 30 L1-3-1-3 PIC X(5). - 25 L1-3-2 OCCURS 0 TO 1 TIMES DEPENDING ON L1-3-2-S PIC X. - - PROCEDURE DIVISION USING BASE - L1-1-2-S - L1-1-2-1-S - L1-2-S - L1-3-S - L1-3-2-S. - DISPLAY "Length is " LENGTH OF BASE - " with " L1-1-2-S - ", " L1-1-2-1-S - ", " L1-2-S - ", " L1-3-S - ", " L1-3-2-S. - MOVE '.' TO L1-3-2(1, 5, 1). - MOVE '--' TO L1-2(2, 1). - MOVE '+++' TO L1-1-2-1(2, 1, 5). - DISPLAY '"' BASE '"'. - END PROGRAM IBM-ODO-TEST. -]) -# FIXME: odo-checks (-debug) must be adjusted, either with -fodoslide or with a possibly new -# compiler configuration flag as IBM seems to only check against the field-founder's -# bounds, not the subscript (which is the reason to use "$COBC -x" instead of "$COMPILE") -AT_CHECK([$COBC -x -std=ibm -fodoslide prog.cob], [0], [], []) - -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], -[Length is 0000000222 with 03, 04, 00, 06, 01 -"01234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567.901234567890123456789012345+++901234567890123456789--2345678901234567890123456789012345678901234567890123456789012345678901" -Length is 0000000134 with 02, 03, 01, 04, 00 -"012345678901234567890123456789012345678901234567890123456789012345678901234567.901+++567--01234567890123456789012345678901234567890123" -], []) - -AT_CLEANUP - -AT_SETUP([DEPENDING ON with ODOSLIDE]) -AT_KEYWORDS([MOVE]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ****************************************************************** - ENVIRONMENT DIVISION. - DATA DIVISION. - ****************************************************************** - WORKING-STORAGE SECTION. - * - 01 WITHOUT-ODO. - 02 DATA1 PIC X(1). - 02 DEP1 PIC 9(1) VALUE 0. - 02 DEP2 PIC 9(1) VALUE 0. - 02 GROUP1 OCCURS 2 TIMES. - 03 DATA11 PIC X(1). - 02 GROUP2 OCCURS 3 TIMES. - 03 DATA21 PIC X(1). - 02 DATA3 PIC X(2). - - * - 01 WITH-ODO. - 02 ODO-DATA1 PIC X(1). - 02 ODO-DEP1 PIC 9(1) VALUE 0. - 02 ODO-DEP2 PIC 9(1) VALUE 0. - 02 ODO-GROUP1 OCCURS 0 TO 2 TIMES DEPENDING ON ODO-DEP1. - 03 ODO-DATA11 PIC X(1). - 02 ODO-GROUP2 OCCURS 0 TO 3 TIMES DEPENDING ON ODO-DEP2. - 03 ODO-DATA21 PIC X(1). - 02 ODO-DATA3 PIC X(2). - - 77 IX PIC 9. - 01 DAT. - 02 ODO-1 PIC 9. - 02 ODO-1-DATA OCCURS 1 TO 6 TIMES DEPENDING ON ODO-1 - PIC 9. - 02 ODO-2 PIC 9. - 02 ODO-2-DATA OCCURS 1 TO 6 TIMES DEPENDING ON ODO-2 - PIC 9. - 02 ODO-3 PIC XXX. - - ****************************************************************** - PROCEDURE DIVISION. - ****************************************************************** - * - TEST1. - MOVE "A01 B CD" TO WITHOUT-ODO - DISPLAY "********" - DISPLAY "TEST WITHOUT ODO: '" WITHOUT-ODO "'" - DISPLAY "DATA1=" DATA1 - DISPLAY "DEP1=" DEP1. - DISPLAY "DEP2=" DEP2 - DISPLAY "DATA21(1)=" DATA21 (1) - DISPLAY "DATA3=" DATA3 - . - - TEST2. - MOVE "A01BCD" TO WITH-ODO - DISPLAY "TEST WITH ODO: '" WITH-ODO - "' Len:" LENGTH OF WITH-ODO - DISPLAY "ODO-DATA1=" ODO-DATA1 "." - DISPLAY "ODO-DEP1=" ODO-DEP1 "." - DISPLAY "ODO-DEP2=" ODO-DEP2 "." - DISPLAY "ODO-DATA21(1)=" ODO-DATA21 (1) "." - DISPLAY "ODO-DATA3=" ODO-DATA3 "." - - MOVE "12BCDEF" TO WITH-ODO (2:) - DISPLAY "TEST WITH ODO: '" WITH-ODO - "' Len:" LENGTH OF WITH-ODO - DISPLAY "ODO-DATA1=" ODO-DATA1 "." - DISPLAY "ODO-DEP1=" ODO-DEP1 "." - DISPLAY "ODO-DEP2=" ODO-DEP2 "." - DISPLAY "ODO-DATA11(1)=" ODO-DATA11 (1) "." - DISPLAY "ODO-DATA21(1)=" ODO-DATA21 (1) "." - DISPLAY "ODO-DATA21(2)=" ODO-DATA21 (2) "." - DISPLAY "ODO-DATA3=" ODO-DATA3 "." - - MOVE "A23BCDEFGH" TO WITH-ODO (1:) - DISPLAY "TEST WITH ODO: '" WITH-ODO - "' Len:" LENGTH OF WITH-ODO. - DISPLAY "ODO-DATA1=" ODO-DATA1 "." - DISPLAY "ODO-DEP1=" ODO-DEP1 "." - DISPLAY "ODO-DEP2=" ODO-DEP2 "." - DISPLAY "ODO-DATA11(1)=" ODO-DATA11 (1) "." - DISPLAY "ODO-DATA11(2)=" ODO-DATA11 (2) "." - DISPLAY "ODO-DATA21(1)=" ODO-DATA21 (1) "." - DISPLAY "ODO-DATA21(2)=" ODO-DATA21 (2) "." - DISPLAY "ODO-DATA21(3)=" ODO-DATA21 (3) "." - DISPLAY "ODO-DATA3=" ODO-DATA3 "." - . - - TEST3. - MOVE "A01" TO WITH-ODO (1:3) - MOVE "BCD" TO WITH-ODO (4:3) - DISPLAY "********" - DISPLAY "TEST WITH ODO, SEPERATED: '" WITH-ODO "'" - DISPLAY "ODO-DATA1=" ODO-DATA1 "." - DISPLAY "ODO-DEP1=" ODO-DEP1 "." - DISPLAY "ODO-DEP2=" ODO-DEP2 "." - DISPLAY "ODO-DATA21(1)=" ODO-DATA21 (1) "." - DISPLAY "ODO-DATA3=" ODO-DATA3 "." - . - - - DISPLAY "********" - MOVE 2 TO ODO-1 - MOVE 3 TO ODO-2 - MOVE "End" TO ODO-3 - PERFORM SHOW-ODO - MOVE 2 TO ODO-1 - MOVE 6 TO ODO-2 - MOVE "End" TO ODO-3 - PERFORM SHOW-ODO - STOP RUN - . - - SHOW-ODO. - PERFORM VARYING IX FROM 1 BY 1 - UNTIL IX > ODO-1 - MOVE IX TO ODO-1-DATA (IX) - END-PERFORM - PERFORM VARYING IX FROM 1 BY 1 - UNTIL IX > ODO-2 - MOVE IX TO ODO-2-DATA (IX) - END-PERFORM - DISPLAY "Slided ODO : '" DAT "'" - . -]) - -AT_CHECK([$COMPILE -std=default -fodoslide prog.cob ], [0], [], [prog.cob:36: warning: ODO-2 does not have a fixed location -]) - -AT_CHECK([./prog], [0], [******** -TEST WITHOUT ODO: 'A01 B CD' -DATA1=A -DEP1=0 -DEP2=1 -DATA21(1)=B -DATA3=CD -TEST WITH ODO: 'A01BCD' Len:6 -ODO-DATA1=A. -ODO-DEP1=0. -ODO-DEP2=1. -ODO-DATA21(1)=B. -ODO-DATA3=CD. -TEST WITH ODO: 'A12BCDEF' Len:8 -ODO-DATA1=A. -ODO-DEP1=1. -ODO-DEP2=2. -ODO-DATA11(1)=B. -ODO-DATA21(1)=C. -ODO-DATA21(2)=D. -ODO-DATA3=EF. -TEST WITH ODO: 'A23BCDEFGH' Len:10 -ODO-DATA1=A. -ODO-DEP1=2. -ODO-DEP2=3. -ODO-DATA11(1)=B. -ODO-DATA11(2)=C. -ODO-DATA21(1)=D. -ODO-DATA21(2)=E. -ODO-DATA21(3)=F. -ODO-DATA3=GH. -******** -TEST WITH ODO, SEPERATED: 'A01BCD' -ODO-DATA1=A. -ODO-DEP1=0. -ODO-DEP2=1. -ODO-DATA21(1)=B. -ODO-DATA3=CD. -******** -Slided ODO : '2123123End' -Slided ODO : '2126123456End' -], []) - -AT_CLEANUP - - -AT_SETUP([DEPENDING ON with ODOSLIDE]) -AT_KEYWORDS([Subroutine]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 WS-LINE. - 03 WS-LINE-LEN PIC 9(5). - 03 WS-LINE-TEXT. - 04 WS-BYTE PIC X(1) OCCURS 1 TO 132 DEPENDING WS-LINE-LEN. - 03 WS-LINE-LEN2 PIC 9(5). - 03 WS-LINE-TEXT2. - 04 WS-BYTE2 PIC X(1) OCCURS 1 TO 132 DEPENDING WS-LINE-LEN2. - - PROCEDURE DIVISION. - A-MAIN SECTION. - - MOVE 5 TO WS-LINE-LEN - MOVE 'Hello' TO WS-LINE-TEXT ( 1 : ) - MOVE 5 TO WS-LINE-LEN2 - MOVE 'BYE!!' TO WS-LINE-TEXT2 ( 1 : ) - DISPLAY '1. Pre CALL DATA :' WS-LINE ': ' - 'LEN ' LENGTH OF WS-LINE - MOVE '00003BYE00003Now..' TO WS-LINE - DISPLAY '2. Pre CALL DATA :' WS-LINE ': ' - 'LEN ' LENGTH OF WS-LINE - - CALL 'BUGSUB' USING WS-LINE - - DISPLAY '3. Post CALL DATA :' WS-LINE-TEXT ': ' - 'LEN ' LENGTH OF WS-LINE-TEXT - - STOP RUN. - - IDENTIFICATION DIVISION. - PROGRAM-ID. BUGSUB. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 WS-CON PIC X(8) VALUE '005Hello'. - 01 WS-CON2 PIC X(15) VALUE '00009Hello Dog'. - LINKAGE SECTION. - 01 GENERIC-AREA. - 03 GENERIC-AREA-LEN PIC 9(5). - 03 GENERIC-AREA-TEXT. - 04 GEN-BYTE PIC X(1) OCCURS 1 TO 32000 - DEPENDING GENERIC-AREA-LEN. - 03 GENERIC-AREA-LEN2 PIC 9(5). - 03 GENERIC-AREA-TEXT2. - 04 GEN-BYTE2 PIC X(1) OCCURS 1 TO 32000 - DEPENDING GENERIC-AREA-LEN2. - - PROCEDURE DIVISION USING GENERIC-AREA. - A-MAIN SECTION. - - DISPLAY 'In subroutine, Clear' - MOVE SPACES TO GENERIC-AREA-TEXT - DISPLAY 'In subroutine, Fill hdr' - MOVE WS-CON2 TO GENERIC-AREA - DISPLAY '4. Test Move DATA :' GENERIC-AREA ': ' - 'LEN ' LENGTH OF GENERIC-AREA - DISPLAY 'In subroutine, Fill partial' - MOVE WS-CON TO GENERIC-AREA (3:) - DISPLAY '5. Test Move DATA :' GENERIC-AREA ': ' - 'LEN ' LENGTH OF GENERIC-AREA - MOVE 'Bye Bye' TO GENERIC-AREA-TEXT - MOVE 7 TO GENERIC-AREA-LEN - MOVE 'Bye Bye' TO GENERIC-AREA-TEXT - GOBACK. - - END PROGRAM BUGSUB. - END PROGRAM prog. -]) - -AT_CHECK([cobc -x -std=ibm -w -fodoslide prog.cob ], [0], [], []) - -AT_CHECK([./prog], [0], [1. Pre CALL DATA :00005Hello00005BYE!!: LEN 0000000020 -2. Pre CALL DATA :00003BYE00003Now: LEN 0000000016 -In subroutine, Clear -In subroutine, Fill hdr -4. Test Move DATA :00009Hello Dog : LEN 0000000019 -In subroutine, Fill partial -5. Test Move DATA :00005Hello : LEN 0000000015 -3. Post CALL DATA :Bye Bye: LEN 0000000007 -], []) - -AT_CLEANUP - - -AT_SETUP([INITIALIZE level 01]) -AT_KEYWORDS([initialize]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 L1 OCCURS 1000 TIMES. - 05 L2 PIC S9(9) COMP-5 VALUE 5. - 05 L3 PIC S9(9) VALUE 5. - PROCEDURE DIVISION. - IF L2(3) not = 5 - DISPLAY '0 VALUE(3) = ' L2(3) - END-DISPLAY - END-IF. - INITIALIZE L1(1). - IF L2(1) not = 0 - DISPLAY '1 VALUE(1) = ' L2(1) - END-DISPLAY - END-IF. - IF L2(3) not = 5 - DISPLAY '1 VALUE(3) = ' L2(3) - END-DISPLAY - END-IF. - INITIALIZE L1(1) DEFAULT. - IF L2(1) not = 0 - DISPLAY '2 VALUE(1) = ' L2(1) - END-DISPLAY - END-IF. - IF L2(3) not = 5 - DISPLAY '2 VALUE(3) = ' L2(3) - END-DISPLAY - END-IF. - INITIALIZE L1(1) ALL VALUE. - IF L2(1) not = 5 - DISPLAY '3 VALUE(1) = ' L2(1) - END-DISPLAY - END-IF. - IF L2(3) not = 5 - DISPLAY '3 VALUE(3) = ' L2(3) - END-DISPLAY - END-IF. - STOP RUN. -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [], []) - -AT_CLEANUP - - -AT_SETUP([MOVE of non-integer to alphanumeric]) -AT_KEYWORDS([extensions]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 INTEGER PIC 9(4) VALUE 1289 . - 01 SIGNED-INTEGER PIC S9(4) VALUE -1289 . - - 01 ALPHA-FIELD PIC X(4). - - 01 NON-INTEGER PIC 9(2)V99 VALUE 12.89 . - 01 NON-INTEGER-2 PIC 9(2)V99 - USAGE BINARY VALUE 12.89 . - 01 NON-INTEGER-3 PIC 9(2)V99 - USAGE PACKED-DECIMAL VALUE 12.89 . - 01 SIGNED-NON-INTEGER PIC S9(2)V99 VALUE -12.89 . - 01 SIGNED-NON-INTEGER-2 PIC S9(2)V99 - USAGE BINARY VALUE -12.89 . - 01 SIGNED-NON-INTEGER-3 PIC S9(2)V99 - USAGE PACKED-DECIMAL VALUE -12.89 . - - PROCEDURE DIVISION. -* * MOVE NON-INTEGER TO ALPHA-NUMERIC --> ignore Decimal Point! - S-01. - MOVE SPACES TO ALPHA-FIELD. - MOVE INTEGER TO ALPHA-FIELD. - DISPLAY ALPHA-FIELD NO ADVANCING - END-DISPLAY. - S-02. - MOVE SPACES TO ALPHA-FIELD. - MOVE SIGNED-INTEGER TO ALPHA-FIELD. - DISPLAY ALPHA-FIELD NO ADVANCING - END-DISPLAY. - S-03. - MOVE SPACES TO ALPHA-FIELD. - MOVE NON-INTEGER TO ALPHA-FIELD. - DISPLAY ALPHA-FIELD NO ADVANCING - END-DISPLAY. - S-10. - MOVE SPACES TO ALPHA-FIELD. - MOVE NON-INTEGER-2 TO ALPHA-FIELD. - DISPLAY ALPHA-FIELD NO ADVANCING - END-DISPLAY. - S-20. - MOVE SPACES TO ALPHA-FIELD. - MOVE NON-INTEGER-3 TO ALPHA-FIELD. - DISPLAY ALPHA-FIELD NO ADVANCING - END-DISPLAY. - S-30. - MOVE SPACES TO ALPHA-FIELD. - MOVE SIGNED-NON-INTEGER TO ALPHA-FIELD. - DISPLAY ALPHA-FIELD NO ADVANCING - END-DISPLAY. - S-40. - MOVE SPACES TO ALPHA-FIELD. - MOVE SIGNED-NON-INTEGER-2 TO ALPHA-FIELD. - DISPLAY ALPHA-FIELD NO ADVANCING - END-DISPLAY. - S-50. - MOVE SPACES TO ALPHA-FIELD. - MOVE SIGNED-NON-INTEGER-3 TO ALPHA-FIELD. - DISPLAY ALPHA-FIELD NO ADVANCING - END-DISPLAY. - - STOP RUN. -]) - -AT_CHECK([$COMPILE -std=mf prog.cob], [0], [], -[prog.cob: in paragraph 'S-03': -prog.cob:36: warning: MOVE of non-integer to alphanumeric -prog.cob: in paragraph 'S-10': -prog.cob:41: warning: MOVE of non-integer to alphanumeric -prog.cob: in paragraph 'S-20': -prog.cob:46: warning: MOVE of non-integer to alphanumeric -prog.cob: in paragraph 'S-30': -prog.cob:51: warning: MOVE of non-integer to alphanumeric -prog.cob: in paragraph 'S-40': -prog.cob:56: warning: MOVE of non-integer to alphanumeric -prog.cob: in paragraph 'S-50': -prog.cob:61: warning: MOVE of non-integer to alphanumeric -]) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [12891289128912891289128912891289]) - -AT_CLEANUP - -## CALL - -AT_SETUP([CALL USING file-name]) -AT_KEYWORDS([extensions]) - -AT_DATA([setfilename.c], [ -#include -#include -#include - -COB_EXT_EXPORT int -setfilename (cob_file *f, unsigned char *name) -{ - memcpy (f->assign->data, name, strlen ((char *)name)); - return 0; -} -]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - INPUT-OUTPUT SECTION. - FILE-CONTROL. - SELECT TEST-FILE ASSIGN FILENAME. - DATA DIVISION. - FILE SECTION. - FD TEST-FILE. - 01 TEST-REC PIC X(4). - WORKING-STORAGE SECTION. - 01 FILENAME PIC X(8). - PROCEDURE DIVISION. - INITIALIZE FILENAME. - CALL "setfilename" USING TEST-FILE "TESTFILE" - END-CALL. - OPEN OUTPUT TEST-FILE. - CLOSE TEST-FILE. - STOP RUN. -]) - -AT_CHECK([$COMPILE_MODULE setfilename.c], [0], [], []) -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [], []) -AT_CHECK([test -e TESTFILE], [0], [], []) - -AT_CLEANUP - -AT_SETUP([CALL unusual PROGRAM-ID.]) -AT_KEYWORDS([extensions]) - -AT_DATA([A@B.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. "A@B". - PROCEDURE DIVISION. - DISPLAY "P1" NO ADVANCING - END-DISPLAY. - EXIT PROGRAM. -]) - -AT_DATA([A@%:@B.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. "A@%:@B". - PROCEDURE DIVISION. - DISPLAY "P2" NO ADVANCING - END-DISPLAY. - EXIT PROGRAM. -]) - -AT_DATA([A-B.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. "A-B". - PROCEDURE DIVISION. - DISPLAY "P3" NO ADVANCING - END-DISPLAY. - EXIT PROGRAM. -]) - -AT_DATA([A_B.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. "A_B". - PROCEDURE DIVISION. - DISPLAY "P4" NO ADVANCING - END-DISPLAY. - EXIT PROGRAM. -]) - -AT_DATA([caller.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. caller. - PROCEDURE DIVISION. - CALL "A@B" - END-CALL. - CALL "A@%:@B" - END-CALL. - CALL "A-B" - END-CALL. - CALL "A_B" - END-CALL. - STOP RUN. -]) - -AT_CHECK([$COMPILE_MODULE A@B.cob], [0], [], []) -AT_CHECK([$COMPILE_MODULE A@%:@B.cob], [0], [], []) -AT_CHECK([$COMPILE_MODULE A-B.cob], [0], [], []) -AT_CHECK([$COMPILE_MODULE A_B.cob], [0], [], []) -AT_CHECK([$COMPILE -o caller caller.cob], [0], [], []) - -AT_CHECK([$COBCRUN_DIRECT ./caller], [0], [P1P2P3P4]) - -AT_CLEANUP - -AT_SETUP([CALL / GOBACK with LOCAL-STORAGE]) -AT_KEYWORDS([extensions]) - -# Testcase introduced when Bug #91 occurred. -# Will fail if memory is freed which was -# allocated by mpir/gmp. -AT_DATA([prog_a.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog_a. - DATA DIVISION. - WORKING-STORAGE SECTION. - 77 WS-STRINGA PIC X(10). - PROCEDURE DIVISION. - MOVE "hi there" TO WS-STRINGA - CALL "prog_b" USING WS-STRINGA - DISPLAY "back in prog_a" - GOBACK. -]) - -AT_DATA([prog_b.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog_b. - DATA DIVISION. - WORKING-STORAGE SECTION. - 77 WS-STRINGB PIC X(10). - 77 WS-CALLSB PIC 9(03). - LOCAL-STORAGE SECTION. - 77 LS-STRING PIC X(10). - LINKAGE SECTION. - 77 LK-STRING PIC X(10). - - PROCEDURE DIVISION USING LK-STRING. - DISPLAY "entered prog_b" - ADD 1 TO WS-CALLSB - MOVE LK-STRING TO WS-STRINGB - MOVE LK-STRING TO LS-STRING - DISPLAY "exiting prog_b" - GOBACK. -]) - -AT_CHECK([$COMPILE prog_a.cob], [0], [], []) -AT_CHECK([$COMPILE_MODULE prog_b.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog_a], [0], [entered prog_b -exiting prog_b -back in prog_a -], []) - -AT_CLEANUP - - -AT_SETUP([CALL BY VALUE alphanumeric item]) -AT_KEYWORDS([extensions]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 X PIC XX VALUE "OK". - PROCEDURE DIVISION. - CALL "prog2" USING BY VALUE X - END-CALL. - IF X NOT = "OK" - DISPLAY X NO ADVANCING - END-DISPLAY - END-IF. - STOP RUN. - PROGRAM-ID. prog2. - DATA DIVISION. - LINKAGE SECTION. - 01 Y PIC XX. - PROCEDURE DIVISION USING BY VALUE Y. - MOVE "KO" TO Y. - EXIT PROGRAM. - END PROGRAM prog2. - END PROGRAM prog. -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], -[prog.cob:8: warning: BY CONTENT assumed for alphanumeric item 'X' -]) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [], []) - -AT_CLEANUP - - -AT_SETUP([CALL BY VALUE numeric literal WITH SIZE]) -AT_KEYWORDS([extensions]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - PROCEDURE DIVISION. - *> Test of auto size, identical to SIZE AUTO - CALL "prog2" USING BY VALUE 4 0 0 1 0 - END-CALL - - *> Test of explicit SIZE syntax - CALL "prog2" USING BY VALUE 1 SIZE 1 2 0 0 0 - END-CALL - CALL "prog2" USING BY VALUE 2 0 SIZE 2 3 0 0 - END-CALL - CALL "prog2" USING BY VALUE 4 0 0 SIZE 4 4 0 - END-CALL - CALL "prog2" USING BY VALUE 8 0 0 0 SIZE 8 5 - END-CALL - CALL "prog2" USING BY VALUE 4 0 0 SIZE DEFAULT 6 0 - END-CALL - CALL "prog2" USING BY VALUE 4 0 0 SIZE AUTO 7 0 - END-CALL - *> test for SIZE AUTO with VALUE > INT_MAX is non-portable - - *> Test of explicit UNSIGNED SIZE syntax - CALL "prog2" USING BY VALUE 1 UNSIGNED SIZE 1 2 0 0 0 - END-CALL - CALL "prog2" USING BY VALUE 2 0 UNSIGNED SIZE 2 3 0 0 - END-CALL - CALL "prog2" USING BY VALUE 4 0 0 UNSIGNED SIZE 4 4 0 - END-CALL - CALL "prog2" USING BY VALUE 8 0 0 0 UNSIGNED SIZE 8 5 0 - END-CALL - CALL "prog2" USING BY VALUE 4 0 0 UNSIGNED SIZE AUTO 6 0 - END-CALL - *> test for SIZE AUTO with VALUE > INT_MAX is non-portable - - *> Test of MF size syntax - *>CALL "prog2" USING BY VALUE 2 SIZE 1 - *>END-CALL - *>CALL "prog2" USING BY VALUE 3 SIZE 2 - *>END-CALL - *>CALL "prog2" USING BY VALUE 4 SIZE 4 - *>END-CALL - *>CALL "prog2" USING BY VALUE 5 SIZE 8 - *>END-CALL - - STOP RUN. - PROGRAM-ID. prog2. - DATA DIVISION. - LINKAGE SECTION. - 01 LEN USAGE BINARY-LONG. - 01 VAR-1 USAGE BINARY-CHAR. - 01 VAR-2 USAGE BINARY-SHORT. - 01 VAR-4 USAGE BINARY-LONG. - 01 VAR-8 USAGE BINARY-DOUBLE. - PROCEDURE DIVISION USING BY VALUE LEN - SIZE 1 VAR-1 - SIZE 2 VAR-2 - SIZE 4 VAR-4 - SIZE 8 VAR-8. - EVALUATE len - WHEN 1 - DISPLAY '1: ' VAR-1 END-DISPLAY - WHEN 2 - DISPLAY '2: ' VAR-2 END-DISPLAY - WHEN 4 - DISPLAY '4: ' VAR-4 END-DISPLAY - WHEN 8 - DISPLAY '8: ' VAR-8 END-DISPLAY - END-EVALUATE - EXIT PROGRAM. - END PROGRAM prog2. - END PROGRAM prog. -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], ignore) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], -[4: +0000000001 -1: +002 -2: +00003 -4: +0000000004 -8: +00000000000000000005 -4: +0000000006 -4: +0000000007 -1: +002 -2: +00003 -4: +0000000004 -8: +00000000000000000005 -4: +0000000006 -], []) - -AT_CLEANUP - - -# extension, should normally be *not* case sensitive -AT_SETUP([Case-sensitive PROGRAM-ID]) -AT_KEYWORDS([extensions]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. PROG. - PROCEDURE DIVISION. - CALL "prog" - END-CALL. - STOP RUN. - PROGRAM-ID. prog. - PROCEDURE DIVISION. - EXIT PROGRAM. - END PROGRAM prog. - END PROGRAM PROG. -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [], []) - -AT_CLEANUP - - -# note: this is an extension while PROGAM-ID. name AS 'lit' -# is standard -AT_SETUP([Quoted PROGRAM-ID]) -AT_KEYWORDS([extensions]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. "caller". - PROCEDURE DIVISION. - CALL "callee" - END-CALL. - STOP RUN. - PROGRAM-ID. "callee". - PROCEDURE DIVISION. - EXIT PROGRAM. - END PROGRAM callee. - END PROGRAM caller. -]) - -AT_CHECK([$COMPILE -w prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [], []) - -AT_CLEANUP - - -AT_SETUP([PROGRAM-ID AS clause]) -AT_KEYWORDS([extensions]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. caller AS "PROG". - PROCEDURE DIVISION. - CALL "prog" - END-CALL. - STOP RUN. - PROGRAM-ID. callee AS "prog". - PROCEDURE DIVISION. - EXIT PROGRAM. - END PROGRAM callee. - END PROGRAM caller. -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [], []) - -AT_CLEANUP - -## ASSIGN - -AT_SETUP([ASSIGN DYNAMIC and EXTERNAL]) -AT_KEYWORDS([extensions runfile]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - - ENVIRONMENT DIVISION. - INPUT-OUTPUT SECTION. - FILE-CONTROL. - SELECT f ASSIGN whatever - ORGANIZATION LINE SEQUENTIAL. - - DATA DIVISION. - FILE SECTION. - FD f. - 01 f-rec PIC XXX. - - WORKING-STORAGE SECTION. - 01 whatever PIC X(10) VALUE "out.txt". - - PROCEDURE DIVISION. - OPEN OUTPUT f - WRITE f-rec FROM "hi" - CLOSE f - . -]) - -AT_CHECK([$COMPILE -fassign-clause=external prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [], []) -AT_CAPTURE_FILE(./whatever) -AT_DATA([reference], -[hi -]) -AT_CHECK([diff reference whatever], [0], [], []) - -AT_CHECK([$COMPILE -fassign-clause=dynamic -fno-implicit-assign-dynamic-var prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [], []) -AT_CAPTURE_FILE(./whatever) -AT_CHECK([diff reference whatever], [0], [], []) - -AT_CHECK([$COMPILE -fassign-clause=dynamic prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [], []) -AT_CAPTURE_FILE(./out.txt) -AT_CHECK([diff reference out.txt], [0], [], []) - -AT_CLEANUP - - -AT_SETUP([ASSIGN DYNAMIC implicit variable]) -AT_KEYWORDS([extensions runfile]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - - ENVIRONMENT DIVISION. - INPUT-OUTPUT SECTION. - FILE-CONTROL. - SELECT f ASSIGN whatever - ORGANIZATION LINE SEQUENTIAL. - - DATA DIVISION. - FILE SECTION. - FD f. - 01 f-rec PIC XXX. - - PROCEDURE DIVISION. - MOVE "out.txt" TO whatever - OPEN OUTPUT f - WRITE f-rec FROM "hi" - CLOSE f - . -]) - -AT_CHECK([$COMPILE -fassign-clause=dynamic prog.cob], [0], [], -[prog.cob:16: warning: variable 'whatever' will be implicitly defined -]) -AT_CLEANUP - - -AT_SETUP([ASSIGN EXTERNAL parsing]) -AT_KEYWORDS([extensions runfile]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - INPUT-OUTPUT SECTION. - FILE-CONTROL. - *> Labels should be removed from EXTERNAL name. - SELECT TEST-FILE ASSIGN DA-S-FILENAME. - *> EXTERNAL name allowed to duplicate FD name. - SELECT TESTFILE2 ASSIGN TESTFILE2. - DATA DIVISION. - FILE SECTION. - FD TEST-FILE. - 01 TEST-REC PIC X(4). - FD TESTFILE2. - 01 TESTREC2 PIC X(4). - PROCEDURE DIVISION. - OPEN OUTPUT TEST-FILE. - CLOSE TEST-FILE. - STOP RUN. -]) - -AT_CHECK([$COMPILE -fassign-clause=external prog.cob], [0], [], -[prog.cob:8: warning: ASSIGN DA-S-FILENAME interpreted as 'FILENAME' -]) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [], []) -AT_CHECK([test -f FILENAME], [0], [], []) - -AT_CLEANUP - - -AT_SETUP([ASSIGN directive]) -AT_KEYWORDS([extensions runfile]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - - ENVIRONMENT DIVISION. - INPUT-OUTPUT SECTION. - FILE-CONTROL. - SELECT f ASSIGN whatever - ORGANIZATION LINE SEQUENTIAL. - $SET ASSIGN "EXTERNAL" - SELECT g ASSIGN whatever - ORGANIZATION LINE SEQUENTIAL. - - DATA DIVISION. - FILE SECTION. - FD f. - 01 f-rec PIC XXX. - FD g. - 01 g-rec PIC XXX. - - PROCEDURE DIVISION. - MOVE "out.txt" TO whatever - - OPEN OUTPUT f - WRITE f-rec FROM "hi" - CLOSE f - - OPEN OUTPUT g - WRITE g-rec FROM "hi" - CLOSE g - . - END PROGRAM prog. -]) - -AT_CHECK([$COMPILE -fassign-clause=dynamic prog.cob], [0], [], -[prog.cob:21: warning: variable 'whatever' will be implicitly defined -]) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [], []) - -AT_CLEANUP - - -AT_SETUP([ASSIGN expansion]) -AT_KEYWORDS([extensions runfile]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - INPUT-OUTPUT SECTION. - FILE-CONTROL. - SELECT TEST-FILE ASSIGN "$DIR/FILENAME". - DATA DIVISION. - FILE SECTION. - FD TEST-FILE. - 01 TEST-REC PIC X(4). - PROCEDURE DIVISION. - OPEN OUTPUT TEST-FILE. - CLOSE TEST-FILE. - STOP RUN. -]) - -AT_CHECK([$COMPILE -ffilename-mapping prog.cob], [0], [], []) -AT_CHECK([DIR="." $COBCRUN_DIRECT ./prog], [0], [], []) -AT_CHECK([test -f "./FILENAME" && rm -f "./FILENAME"], [0], [], []) - -AT_CLEANUP - -AT_SETUP([ASSIGN mapping]) -AT_KEYWORDS([extensions runfile optional]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - INPUT-OUTPUT SECTION. - FILE-CONTROL. - SELECT TEST-FILE ASSIGN "FILENAME". - DATA DIVISION. - FILE SECTION. - FD TEST-FILE. - 01 TEST-REC PIC X(4). - PROCEDURE DIVISION. - OPEN OUTPUT TEST-FILE. - CLOSE TEST-FILE. - STOP RUN. -]) - -AT_DATA([prog2.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog2. - ENVIRONMENT DIVISION. - INPUT-OUTPUT SECTION. - FILE-CONTROL. - SELECT TEST-FILE ASSIGN "FILENAME2". - DATA DIVISION. - FILE SECTION. - FD TEST-FILE. - 01 TEST-REC PIC X(4). - PROCEDURE DIVISION. - OPEN OUTPUT TEST-FILE. - CLOSE TEST-FILE. - STOP RUN. -]) - -AT_CHECK([$COMPILE -fno-filename-mapping prog.cob], [0], [], []) -AT_CHECK([DD_FILENAME="x" $COBCRUN_DIRECT ./prog], [0], [], []) -AT_CHECK([test -f "x"], [1]) -AT_CHECK([test -f "FILENAME"], [0], [], []) - -AT_CHECK([$COMPILE -ffilename-mapping prog2.cob], [0], [], []) -AT_CHECK([DD_FILENAME2="x" $COBCRUN_DIRECT ./prog2], [0], [], []) -AT_CHECK([test -f "FILENAME2"], [1]) -AT_CHECK([test -f "x"], [0], [], []) -AT_CHECK([dd_FILENAME2="y" $COBCRUN_DIRECT ./prog2], [0], [], []) -AT_CHECK([test -f "y"], [0], [], []) -AT_CHECK([FILENAME2="z" $COBCRUN_DIRECT ./prog2], [0], [], []) -AT_CHECK([test -f "z"], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog2], [0], [], []) -AT_CHECK([test -f "FILENAME2"], [0], [], []) - -AT_DATA([prog3.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog3. - ENVIRONMENT DIVISION. - CONFIGURATION SECTION. - INPUT-OUTPUT SECTION. - FILE-CONTROL. - SELECT OPTIONAL INFILE ASSIGN TO "MYFILE" - ORGANIZATION IS RELATIVE - ACCESS IS SEQUENTIAL - FILE STATUS IS WSFS. - DATA DIVISION. - FILE SECTION. - FD INFILE. - 01 INREC PIC X(80). - WORKING-STORAGE SECTION. - 01 WSFS PIC X(2). - PROCEDURE DIVISION. - * - * open missing file - OPEN INPUT INFILE - DISPLAY "STATUS OPENI " WSFS - CLOSE INFILE - * - * create missing file - OPEN OUTPUT INFILE - DISPLAY "STATUS OPENO " WSFS - CLOSE INFILE - * - STOP RUN. -]) - -AT_CHECK([$COMPILE prog3.cob], [0], [], []) - -AT_CHECK([$COBCRUN_DIRECT ./prog3], [0], -[STATUS OPENI 05 -STATUS OPENO 00 -], []) -AT_CHECK([test -f "MYFILE"], [0], [], []) - -AT_CHECK([$COBCRUN_DIRECT ./prog3], [0], -[STATUS OPENI 00 -STATUS OPENO 00 -], []) - -AT_CHECK([MYFILE="TSTFILE" $COBCRUN_DIRECT ./prog3], [0], -[STATUS OPENI 05 -STATUS OPENO 00 -], []) -AT_CHECK([test -f "TSTFILE"], [0], [], []) - -AT_CHECK([dd_MYFILE="TSTFILE2" $COBCRUN_DIRECT ./prog3], [0], -[STATUS OPENI 05 -STATUS OPENO 00 -], []) -AT_CHECK([test -f "TSTFILE2"], [0], [], []) - -AT_CHECK([DD_MYFILE="TSTFILE3" $COBCRUN_DIRECT ./prog3], [0], -[STATUS OPENI 05 -STATUS OPENO 00 -], []) -AT_CHECK([test -f "TSTFILE3"], [0], [], []) - -AT_CHECK([DD_MYFILE="./nosubhere/TSTFILE" $COBCRUN_DIRECT ./prog3], [0], -[STATUS OPENI 05 -STATUS OPENO 30 -], []) - -AT_DATA([prog4.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog4. - ENVIRONMENT DIVISION. - CONFIGURATION SECTION. - INPUT-OUTPUT SECTION. - FILE-CONTROL. - SELECT FILE0 ASSIGN TO "./nosubhere/MYFILE0" - ORGANIZATION IS LINE SEQUENTIAL - FILE STATUS IS WSFS. - SELECT FILE1 ASSIGN TO "MYFILE1" - ORGANIZATION IS LINE SEQUENTIAL - FILE STATUS IS WSFS. - SELECT FILE2 ASSIGN TO FILENAME - ORGANIZATION IS LINE SEQUENTIAL - FILE STATUS IS WSFS. - DATA DIVISION. - FILE SECTION. - FD FILE0. - 01 F0REC PIC X(80). - FD FILE1. - 01 F1REC PIC X(80). - FD FILE2. - 01 F2REC PIC X(80). - WORKING-STORAGE SECTION. - 77 FILENAME PIC X(80) VALUE "MYFILE2". - 01 WSFS PIC X(2). - PROCEDURE DIVISION. - * - OPEN OUTPUT FILE0 - DISPLAY "STATUS OPENO 0 " WSFS - OPEN OUTPUT FILE1 - DISPLAY "STATUS OPENO 1 " WSFS - OPEN OUTPUT FILE2 - DISPLAY "STATUS OPENO 2 " WSFS - * - STOP RUN. -]) - -AT_CHECK([$COMPILE prog4.cob], [0], [], []) - -AT_CHECK([DD_MYFILE1="./nosubhere/NOFILE1" DD_MYFILE2="./nosubhere/NOFILE2" \ -$COBCRUN_DIRECT ./prog4], [0], -[STATUS OPENO 0 30 -STATUS OPENO 1 30 -STATUS OPENO 2 30 -], []) - -AT_CLEANUP - -AT_SETUP([ASSIGN with COB_FILE_PATH]) -AT_KEYWORDS([extensions runfile]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - INPUT-OUTPUT SECTION. - FILE-CONTROL. - SELECT TEST-FILE ASSIGN "FILENAMEX". - DATA DIVISION. - FILE SECTION. - FD TEST-FILE. - 01 TEST-REC PIC X(4). - PROCEDURE DIVISION. - OPEN OUTPUT TEST-FILE. - CLOSE TEST-FILE. - STOP RUN. -]) - -AT_CHECK([$COMPILE -ffilename-mapping prog.cob], [0], [], []) -AT_CHECK([COB_FILE_PATH=".." $COBCRUN_DIRECT ./prog], [0], [], []) -AT_CHECK([test -f "../FILENAMEX" && rm -f "../FILENAMEX"], [0], [], []) -AT_CHECK([COB_FILE_PATH="../" $COBCRUN_DIRECT ./prog], [0], [], []) -AT_CHECK([test -f "../FILENAMEX" && rm -f "../FILENAMEX"], [0], [], []) - -# FIXME: on OPEN we should also output the full filename (if any) leading to the error -AT_CHECK([COB_FILE_PATH="./nosubhere" $COBCRUN_DIRECT ./prog], [1], [], -[libcob: prog.cob:13: error: permanent file error (status = 30) for file TEST-FILE ('FILENAMEX' => ./nosubhere/FILENAMEX) on OPEN -]) - -AT_CLEANUP - - -AT_SETUP([NUMBER-OF-CALL-PARAMETERS]) -AT_KEYWORDS([extensions]) - -AT_DATA([callee.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. callee. - DATA DIVISION. - LINKAGE SECTION. - 01 W PIC X. - 01 X PIC X. - 01 Y PIC X. - 01 Z PIC X. - PROCEDURE DIVISION - USING W X Y Z. - DISPLAY NUMBER-OF-CALL-PARAMETERS - END-DISPLAY. - EXIT PROGRAM. -]) - -AT_DATA([caller.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. caller. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 W PIC X. - 01 X PIC X. - 01 Y PIC X. - 01 Z PIC X. - PROCEDURE DIVISION. - CALL "callee" - END-CALL. - CALL "callee" USING W - END-CALL. - CALL "callee" USING W X - END-CALL. - CALL "callee" USING W X Y - END-CALL. - CALL "callee" USING W X Y Z - END-CALL. - STOP RUN. -]) - -AT_CHECK([$COMPILE caller.cob], [0], [], []) -AT_CHECK([$COMPILE_MODULE callee.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./caller], [0], -[+000000000 -+000000001 -+000000002 -+000000003 -+000000004 -]) - -AT_CLEANUP - - -AT_SETUP([TALLY register]) -AT_KEYWORDS([extensions]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. callee. - PROCEDURE DIVISION. - ADD 1 TO TALLY END-ADD - CALL "nested" END-CALL - STOP RUN. - - IDENTIFICATION DIVISION. - PROGRAM-ID. nested. - PROCEDURE DIVISION. - DISPLAY tally END-DISPLAY - STOP RUN. - END PROGRAM nested. -]) - -#FIXME: Should get a dialect check in syntax checks, -# along with all other special registers -AT_CHECK([$COMPILE_ONLY -fnot-register=TALLY prog.cob], [1], [], -[prog.cob:5: error: 'TALLY' is not defined -prog.cob:12: error: 'tally' is not defined -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], -[00001 -]) - -AT_CLEANUP - - -AT_SETUP([Redefining TALLY]) -AT_KEYWORDS([extensions register]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 tally PIC 999 VALUE 1. - - PROCEDURE DIVISION. - ADD 1 TO tally - DISPLAY tally UPON SYSOUT - . -]) - - -#FIXME: Should get a dialect check in syntax checks, -# along with all other special registers -AT_CHECK([$COMPILE -std=ibm-strict prog.cob], [1], [], [ignore]) -AT_CHECK([$COMPILE -std=acu-strict prog.cob], [0], [], []) -#AT_CHECK([$COMPILE -std=ibm prog.cob], [0], [], []) -#AT_CHECK([$COMPILE -std=ibm-strict prog.cob], [1], [], -#[prog.cob:7: error: redefinition of register 'TALLY' -#]) -#AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], -[002 -]) - -AT_CLEANUP - - -# Program parameters - -AT_SETUP([PROCEDURE DIVISION USING BY ...]) -AT_KEYWORDS([extensions]) - -AT_DATA([callee.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. callee. - DATA DIVISION. - LINKAGE SECTION. - 01 X PIC X. - 01 Y PIC 99. - 01 Z PIC 99 USAGE COMP. - PROCEDURE DIVISION - USING BY VALUE X BY REFERENCE Y Z. - MOVE "Z" TO X. - MOVE 56 TO Y. - MOVE 78 TO Z. - EXIT PROGRAM. -]) - -AT_DATA([caller.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. caller. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 X PIC X. - 01 Y PIC 99. - 01 Z PIC 99 USAGE COMP. - PROCEDURE DIVISION. - MOVE "X" TO X. - MOVE 12 TO Y. - MOVE 34 TO Z. - CALL "callee" USING BY CONTENT X - BY REFERENCE Y - BY CONTENT Z - END-CALL. - IF X NOT = "X" OR - Y NOT = 56 OR - Z NOT = 34 - DISPLAY "X = " X " Y = " Y " Z = " Z - END-DISPLAY - END-IF - STOP RUN. -]) - -AT_CHECK([$COMPILE caller.cob], [0], [], []) -AT_CHECK([$COMPILE_MODULE callee.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./caller], [0], [], []) - -AT_CLEANUP - - -AT_SETUP([PROCEDURE DIVISION CHAINING]) -AT_KEYWORDS([extensions CALL INITIALIZE]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 X PIC X. - 01 ABCD PIC X(4). - 01 NUM PIC 9 VALUE 7. - PROCEDURE DIVISION - CHAINING X ABCD NUM. - IF X NOT = "X" OR - ABCD NOT = "ABCD" - DISPLAY "X = " X " ABCD = " ABCD - END-DISPLAY - END-IF - IF NUM NOT = 7 - DISPLAY "NUM not INITIALIZED: " NUM - END-DISPLAY - END-IF - STOP RUN. -]) - -AT_DATA([prog2.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog2. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 VAR. - 03 X PIC X VALUE 'a'. - 03 ABCD PIC X(4). - 03 NUM PIC 9 VALUE 7. - PROCEDURE DIVISION - CHAINING VAR. - DISPLAY '-' VAR '-' WITH NO ADVANCING - END-DISPLAY - STOP RUN. -]) - -AT_DATA([prog3.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog3. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 X PIC X. - 01 ABCD PIC X(4). - 01 NUM PIC 9 VALUE 7. - PROCEDURE DIVISION - CHAINING X ABCD NUM. - IF X NOT = "X" OR - ABCD NOT = "ABCD" - DISPLAY "X = " X " ABCD = " ABCD - END-DISPLAY - END-IF - IF NUM NOT = 7 - DISPLAY "NUM not INITIALIZED: " NUM - END-DISPLAY - END-IF - STOP RUN. -]) - -AT_DATA([caller.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. caller. - DATA DIVISION. - PROCEDURE DIVISION. - CALL "prog3" USING "X ABCD" END-CALL - STOP RUN. -]) - -AT_DATA([init.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. init. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 VAR. - 03 X PIC X VALUE 'a'. - 03 ABCD PIC X(4). - 03 NUM PIC 9 VALUE 7. - 77 NUM2 PIC 99 VALUE 2. - PROCEDURE DIVISION - CHAINING VAR. - DISPLAY '-' VAR NUM2 '-' WITH NO ADVANCING - END-DISPLAY - INITIALIZE VAR NUM2 - DISPLAY '-' VAR NUM2 '-' WITH NO ADVANCING - MOVE 'XXXX' TO ABCD - INITIALIZE VAR NUM2 ALL TO VALUE - DISPLAY '-' VAR NUM2 '-' WITH NO ADVANCING - MOVE ALL 'b' TO ABCD - INITIALIZE VAR NUM2 ALL TO VALUE THEN TO DEFAULT - DISPLAY '-' VAR NUM2 '-' WITH NO ADVANCING - STOP RUN. -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog X ABCD], [0], [], []) - -# note: sticky linkage and CHAINING produced compiler errors -# --> additional test -AT_CHECK([$COMPILE prog.cob -fsticky-linkage -o prog_sticky], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog_sticky X ABCD], [0], [], []) - -AT_CHECK([$COMPILE prog2.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog2 X], [0], [-X -], []) -AT_CHECK([$COBCRUN_DIRECT ./prog2], [0], [-a 7-], []) - -AT_CHECK([$COMPILE_MODULE prog3.cob], [0], [], []) -AT_CHECK([$COBCRUN prog3 X ABCD], [0], [], []) - -AT_CHECK([$COMPILE caller.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./caller X ABCD], [1], [], -[libcob: caller.cob:6: error: CALL of program with CHAINING clause -]) - -AT_CHECK([$COMPILE init.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./init X], [0], [-X 02-- 000--aXXXX702--a 702-], []) - -AT_CLEANUP - - -AT_SETUP([STOP RUN RETURNING/GIVING]) -AT_KEYWORDS([extensions]) - -AT_DATA([prog1.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog1. - DATA DIVISION. - WORKING-STORAGE SECTION. - 77 RET PIC 99 USAGE DISPLAY. - PROCEDURE DIVISION. - MOVE 11 TO RET - STOP RUN RETURNING RET. -]) - -AT_DATA([prog2.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog2. - DATA DIVISION. - WORKING-STORAGE SECTION. - 77 RET PIC 99 USAGE PACKED-DECIMAL. - PROCEDURE DIVISION. - MOVE 22 TO RET - STOP RUN GIVING RET. -]) - -AT_DATA([prog3.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog3. - DATA DIVISION. - WORKING-STORAGE SECTION. - PROCEDURE DIVISION. - STOP RUN 33. -]) - -AT_DATA([prog4.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog4. - PROCEDURE DIVISION. - STOP RUN RETURNING 44. -]) - -AT_CHECK([$COMPILE prog1.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog1], [11]) - -AT_CHECK([$COMPILE prog2.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog2], [22]) - -AT_CHECK([$COMPILE prog3.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog3], [33]) - -AT_CHECK([$COMPILE prog4.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog4], [44]) - -AT_CLEANUP - - -AT_SETUP([GOBACK/EXIT PROGRAM RETURNING/GIVING]) -AT_KEYWORDS([extensions]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 77 RETURN-DISP PIC S9(08). - PROCEDURE DIVISION. - CALL 'prog1' END-CALL - IF RETURN-CODE NOT = -1 - MOVE RETURN-CODE TO RETURN-DISP - DISPLAY 'RETURN-CODE ' RETURN-DISP - ' INSTEAD OF -1' - END-DISPLAY - END-IF - CALL 'prog2' END-CALL - IF RETURN-CODE NOT = 2 - MOVE RETURN-CODE TO RETURN-DISP - DISPLAY 'RETURN-CODE ' RETURN-DISP - ' INSTEAD OF 2' - END-DISPLAY - END-IF - STOP RUN. -]) - -AT_DATA([prog1.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog1. - PROCEDURE DIVISION. - EXIT PROGRAM RETURNING -1. -]) - - -AT_DATA([prog2.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog2. - PROCEDURE DIVISION. - GOBACK GIVING 2. -]) - -AT_CHECK([$COMPILE prog.cob prog1.cob prog2.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [2]) - -AT_CLEANUP - - -# ENTRY - -AT_SETUP([ENTRY]) -AT_KEYWORDS([extensions]) - -AT_DATA([caller.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. caller. - PROCEDURE DIVISION. - CALL "hello" USING "COBOL" - END-CALL. - CALL "bye" USING "COBOL" - END-CALL. - STOP RUN. -]) - -AT_DATA([hello.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. hello. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 MSG-HELLO PIC X(7) VALUE "Hello, ". - 01 MSG-BYE PIC X(5) VALUE "Bye, ". - LINKAGE SECTION. - 01 X PIC X(5). - 01 Y PIC X(5). - PROCEDURE DIVISION USING X. - DISPLAY MSG-HELLO X "!". - EXIT PROGRAM. - - ENTRY "bye" USING Y. - DISPLAY MSG-BYE Y "!". - EXIT PROGRAM. -]) - -AT_CHECK([$COMPILE caller.cob], [0], [], []) -# TODO: Doesn't work without sticky-linkage which is likely a bug! -AT_CHECK([$COMPILE_MODULE -fentry-statement=ok -fsticky-linkage hello.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./caller], [0], -[Hello, COBOL! -Bye, COBOL! -]) - -AT_CLEANUP - - -## LINE SEQUENTIAL - -AT_SETUP([LINE SEQUENTIAL write]) -AT_KEYWORDS([extensions]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - INPUT-OUTPUT SECTION. - FILE-CONTROL. - SELECT TEST-FILE ASSIGN "./TEST-FILE" - ORGANIZATION IS LINE SEQUENTIAL. - DATA DIVISION. - FILE SECTION. - FD TEST-FILE. - 01 TEST-REC PIC X(4). - PROCEDURE DIVISION. - OPEN OUTPUT TEST-FILE. - MOVE "a" TO TEST-REC. - WRITE TEST-REC - END-WRITE. - MOVE "ab" TO TEST-REC. - WRITE TEST-REC AFTER 1 LINES - END-WRITE. - MOVE "abc" TO TEST-REC. - WRITE TEST-REC BEFORE 2 LINES - END-WRITE. - MOVE "abcd" TO TEST-REC. - WRITE TEST-REC - END-WRITE. - CLOSE TEST-FILE. - STOP RUN. -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog]) -AT_CHECK([cat TEST-FILE], [0], -[a - -ababc - -abcd -]) - -AT_CLEANUP - - -AT_SETUP([LINE SEQUENTIAL read]) -AT_KEYWORDS([extensions]) - -AT_DATA([TEST-FILE], -[a -ab -abc -abcd -abcde -abcdef -]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - INPUT-OUTPUT SECTION. - FILE-CONTROL. - SELECT TEST-FILE ASSIGN "./TEST-FILE" - ORGANIZATION IS LINE SEQUENTIAL. - DATA DIVISION. - FILE SECTION. - FD TEST-FILE. - 01 TEST-REC PIC X(4). - PROCEDURE DIVISION. - OPEN INPUT TEST-FILE. - READ TEST-FILE - END-READ. - DISPLAY "(" TEST-REC ")" - END-DISPLAY. - READ TEST-FILE - END-READ. - DISPLAY "(" TEST-REC ")" - END-DISPLAY. - READ TEST-FILE - END-READ. - DISPLAY "(" TEST-REC ")" - END-DISPLAY. - READ TEST-FILE - END-READ. - DISPLAY "(" TEST-REC ")" - END-DISPLAY. - READ TEST-FILE - END-READ. - DISPLAY "(" TEST-REC ")" - END-DISPLAY. - READ TEST-FILE - END-READ. - DISPLAY "(" TEST-REC ")" - END-DISPLAY. - CLOSE TEST-FILE. - STOP RUN. -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], -[(a ) -(ab ) -(abc ) -(abcd) -(abcd) -(abcd) -]) - -AT_CLEANUP - - -AT_SETUP([ASSIGN to KEYBOARD/DISPLAY]) -AT_KEYWORDS([extensions]) - -AT_DATA([TEST-FILE], -[a -ab -abc -abcd -abcde -abcdef -]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - INPUT-OUTPUT SECTION. - FILE-CONTROL. - SELECT TEST-FILE ASSIGN KEYBOARD - ORGANIZATION IS LINE SEQUENTIAL. - SELECT TEST-OUT ASSIGN DISPLAY - ORGANIZATION IS LINE SEQUENTIAL. - DATA DIVISION. - FILE SECTION. - FD TEST-FILE. - 01 TEST-REC PIC X(80). - FD TEST-OUT. - 01 TEST-REC-OUT PIC X(80). - PROCEDURE DIVISION. - A00. - OPEN INPUT TEST-FILE. - OPEN OUTPUT TEST-OUT. - A01. - READ TEST-FILE AT END - GO TO Z99 - END-READ. - WRITE TEST-REC-OUT FROM TEST-REC - END-WRITE. - GO TO A01. - Z99. - CLOSE TEST-FILE. - CLOSE TEST-OUT. - STOP RUN. -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([cat TEST-FILE | $COBCRUN_DIRECT ./prog], [0], -[a -ab -abc -abcd -abcde -abcdef -]) - -AT_CLEANUP - - -AT_SETUP([SORT ASSIGN KEYBOARD to ASSIGN DISPLAY]) -AT_KEYWORDS([extensions]) - -# GC has an extension "SORT FILES always in memory" and therefore didn't -# used the ASSIGN clause (which should be mandatory) for SORT files at all. -# We should add an according test and change the test here after cleanup, -# officially documenting the "ASSIGN clause not necessary for SORT FILES" -# extension and enable it only with a conf entry (set only in default.conf). -AT_XFAIL_IF(true) - -AT_DATA([TEST-FILE], -[9 -22 -11 -0 -00 -8 -77 -]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - INPUT-OUTPUT SECTION. - FILE-CONTROL. - SELECT TEST-FILE ASSIGN KEYBOARD - ORGANIZATION IS LINE SEQUENTIAL. - SELECT TEST-OUT ASSIGN DISPLAY - ORGANIZATION IS LINE SEQUENTIAL. - SELECT SORT-FILE. - DATA DIVISION. - FILE SECTION. - FD TEST-FILE. - 01 TEST-REC PIC X(80). - FD TEST-OUT. - 01 TEST-REC-OUT PIC X(80). - SD SORT-FILE. - 01 SORT-REC PIC X(80). - PROCEDURE DIVISION. - A00. - SORT SORT-FILE - ON ASCENDING SORT-REC - USING TEST-FILE - GIVING TEST-OUT. - STOP RUN. -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([cat TEST-FILE | $COBCRUN_DIRECT ./prog], [0], -[0 -00 -11 -22 -77 -8 -9 -]) - -AT_CLEANUP - - -AT_SETUP([Environment/Argument variable]) -AT_KEYWORDS([extensions]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 X PIC X(4). - 01 Y PIC X(8). - 01 Z PIC 9(4). - PROCEDURE DIVISION. - DISPLAY "TEST_ENV" UPON ENVIRONMENT-NAME - END-DISPLAY. - ACCEPT X FROM ENVIRONMENT-VALUE - END-ACCEPT. - DISPLAY "(" X ")" - END-DISPLAY. - DISPLAY "RXW" UPON ENVIRONMENT-VALUE - END-DISPLAY. - ACCEPT X FROM ENVIRONMENT-VALUE - END-ACCEPT. - DISPLAY "(" X ")" - END-DISPLAY. - ACCEPT Y FROM ARGUMENT-VALUE - END-ACCEPT. - DISPLAY "(" Y ")" - END-DISPLAY. - ACCEPT Z FROM ARGUMENT-NUMBER - END-ACCEPT. - DISPLAY "(" Z ")" - END-DISPLAY. - STOP RUN. -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([TEST_ENV=OK $COBCRUN_DIRECT ./prog CHECKPAR], [0], -[(OK ) -(RXW ) -(CHECKPAR) -(0001) -]) - -AT_CLEANUP - - -AT_SETUP([78 Level (1)]) -AT_KEYWORDS([extensions]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 78 X VALUE "OK". - PROCEDURE DIVISION. - DISPLAY X - END-DISPLAY. - STOP RUN. -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], -[OK -]) - -AT_CLEANUP - - -AT_SETUP([78 Level (2)]) -AT_KEYWORDS([extensions]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 Z. - 78 X VALUE "OK". - 78 Y VALUE "OK". - 03 FILLER PIC XX VALUE "OK". - PROCEDURE DIVISION. - DISPLAY X Z Y - END-DISPLAY. - STOP RUN. -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], -[OKOKOK -]) - -AT_CLEANUP - - -AT_SETUP([78 Level (3)]) -AT_KEYWORDS([extensions]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 78 X VALUE "OK". - 01 Z PIC XX VALUE "OK". - PROCEDURE DIVISION. - DISPLAY Z X - END-DISPLAY. - STOP RUN. -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], -[OKOK -]) - -AT_CLEANUP - - -AT_SETUP([SWITCHES with non-standard names]) -AT_KEYWORDS([runmisc extensions]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - CONFIGURATION SECTION. - SPECIAL-NAMES. - SW1 - ON IS SWIT1-ON - OFF IS SWIT1-OFF - . - SWITCH B IS SWITCH-B - ON IS SWIT2-ON - OFF IS SWIT2-OFF - . - SWITCH 25 - ON IS SWIT25-ON - OFF IS SWIT25-OFF - . - SWITCH Z - ON IS SWIT26-ON - OFF IS SWIT26-OFF - . - USW-31 - ON IS SWIT31-ON - OFF IS SWIT31-OFF - . - SWITCH-32 - ON IS SWIT32-ON - OFF IS SWIT32-OFF - . - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 SWITCH PIC 99 VALUE 12. - 78 Z VALUE 11. - PROCEDURE DIVISION. - ADD SWITCH 1 GIVING SWITCH - END-ADD. - IF SWITCH NOT = 13 - DISPLAY "SWITCH (variable) + 1 WRONG: " - SWITCH - END-DISPLAY - END-IF. - ADD SWITCH Z GIVING SWITCH - END-ADD. - IF SWITCH NOT = 24 - DISPLAY "SWITCH (variable) + Z WRONG: " - SWITCH - END-DISPLAY - END-IF. - IF SWIT1-ON - DISPLAY "ON" NO ADVANCING - END-DISPLAY - ELSE - DISPLAY "OFF" NO ADVANCING - END-DISPLAY - END-IF. - IF SWIT2-ON - DISPLAY " ON" NO ADVANCING - END-DISPLAY - ELSE - DISPLAY " OFF" NO ADVANCING - END-DISPLAY - END-IF. - SET SWITCH-B TO OFF - IF SWIT2-ON - DISPLAY " ON" NO ADVANCING - END-DISPLAY - ELSE - DISPLAY " OFF" NO ADVANCING - END-DISPLAY - END-IF. - IF SWIT25-ON - DISPLAY " ON" NO ADVANCING - END-DISPLAY - ELSE - DISPLAY " OFF" NO ADVANCING - END-DISPLAY - END-IF. - IF SWIT26-ON - DISPLAY " ON" NO ADVANCING - END-DISPLAY - ELSE - DISPLAY " OFF" NO ADVANCING - END-DISPLAY - END-IF. - IF SWIT31-ON - DISPLAY " ON" NO ADVANCING - END-DISPLAY - ELSE - DISPLAY " OFF" NO ADVANCING - END-DISPLAY - END-IF. - IF SWIT32-ON - DISPLAY " ON" NO ADVANCING - END-DISPLAY - ELSE - DISPLAY " OFF" NO ADVANCING - END-DISPLAY - END-IF. - STOP RUN. -]) - -AT_CHECK([$COMPILE -fsystem-name="sw1, SwItCh\ b, SWITCH\ 25" \ --fsystem-name=SWITCH-32 -fsystem-name="SWITCH\ Z" -fsystem-name=USW-31 prog.cob], [0], [], []) -AT_CHECK([COB_SWITCH_2=1 COB_SWITCH_26=1 COB_SWITCH_31=1 COB_SWITCH_32=1 ./prog], [0], -[OFF ON OFF OFF ON ON ON], []) - -AT_CLEANUP - - -AT_SETUP([Larger REDEFINES lengths]) -AT_KEYWORDS([extensions]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 Z PIC 99. - 01 XMAIN PIC X(8). - 01 XMAINRED REDEFINES XMAIN. - 03 FILLER PIC X(4). - 03 XMAIN03. - 05 XMAIN0501 PIC X(4). - 05 XMAIN0502 REDEFINES XMAIN0501 PIC X(5). - 01 USE-VARS. - 05 USE-VALUE PIC 9 - VALUE ZERO. - 88 USE-ACTIVE-FIRST VALUE 1. - 88 USE-ACTIVE-SECOND VALUE 2. - 05 USE-FIRST. - 10 FIRST-DATA. - 20 FIRST-DATA-VAR PIC X(033). - 10 FIRST-VARIANT-A REDEFINES FIRST-DATA. - 20 PART-A-FIRST PIC X(33211). - 10 FIRST-VARIANT-B REDEFINES FIRST-DATA. - 20 PART-B-FIRST PIC X(24561). - 10 FIRST-VARIANT-C REDEFINES FIRST-DATA. - 20 PART-C-FIRST PIC X(3421). - 05 USE-SECOND REDEFINES USE-FIRST. - 10 SECOND-HEADER. - 20 SECOND-DATA PIC 9(015). - 20 SECOND-CONTROL-SUM PIC 9(015)V9(003). - 10 SECOND-VARIANT-A REDEFINES SECOND-HEADER. - 20 PART-A-SECOND PIC X(27241). - 10 SECOND-VARIANT-B REDEFINES SECOND-HEADER. - 20 PART-B-SECOND PIC X(3879). - PROCEDURE DIVISION. - MOVE LENGTH OF XMAIN TO Z. - IF Z NOT = 8 - DISPLAY "Test 1 " Z - END-DISPLAY - END-IF. - MOVE LENGTH OF XMAINRED TO Z. - IF Z NOT = 9 - DISPLAY "Test 2 " Z - END-DISPLAY - END-IF. - MOVE LENGTH OF XMAIN03 TO Z. - IF Z NOT = 5 - DISPLAY "Test 3 " Z - END-DISPLAY - END-IF. - MOVE LENGTH OF XMAIN0501 TO Z. - IF Z NOT = 4 - DISPLAY "Test 4 " Z - END-DISPLAY - END-IF. - MOVE LENGTH OF XMAIN0502 TO Z. - IF Z NOT = 5 - DISPLAY "Test 5 " Z - END-DISPLAY - END-IF. - IF LENGTH OF USE-FIRST NOT = 33211 - DISPLAY LENGTH OF USE-FIRST END-DISPLAY - END-IF. - IF LENGTH OF USE-SECOND NOT = 27241 - DISPLAY LENGTH OF USE-SECOND END-DISPLAY - END-IF. - STOP RUN. -]) - -AT_CHECK([$COMPILE -flarger-redefines-ok -Wno-constant-expression prog.cob], [0], [], -[prog.cob:12: warning: size of 'XMAIN0502' larger than size of 'XMAIN0501' -prog.cob:21: warning: size of 'FIRST-VARIANT-A' larger than size of 'FIRST-DATA' -prog.cob:23: warning: size of 'FIRST-VARIANT-B' larger than size of 'FIRST-DATA' -prog.cob:25: warning: size of 'FIRST-VARIANT-C' larger than size of 'FIRST-DATA' -prog.cob:31: warning: size of 'SECOND-VARIANT-A' larger than size of 'SECOND-HEADER' -prog.cob:33: warning: size of 'SECOND-VARIANT-B' larger than size of 'SECOND-HEADER' -]) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [], []) - -AT_CLEANUP - - -AT_SETUP([Obsolete 2002 keywords with COBOL2014]) -AT_KEYWORDS([extensions]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 TERMINAL PIC XX VALUE "OK". - 01 SEND PIC XX VALUE "OK". - PROCEDURE DIVISION. - DISPLAY TERMINAL SEND. - STOP RUN. -]) - -AT_CHECK([$COMPILE -std=cobol2002 prog.cob], [1], [], -[prog.cob:6: error: syntax error, unexpected TERMINAL -prog.cob:7: error: syntax error, unexpected SEND -prog.cob:9: error: syntax error, unexpected TERMINAL, expecting [(] -]) -AT_CHECK([$COMPILE -std=cobol2014 prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], -[OKOK -]) - -AT_CLEANUP - - -# System routines - -AT_SETUP([System routine with wrong number of parameters]) -AT_KEYWORDS([extensions narg]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 N PIC 9 USAGE BINARY. - 77 X PIC X. - PROCEDURE DIVISION. - CALL "C$NARG" USING N X - END-CALL - IF N NOT = 2 - DISPLAY "NOTOK " N - END-DISPLAY - END-IF - STOP RUN. -]) - -AT_DATA([wrong.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. wrong. - DATA DIVISION. - WORKING-STORAGE SECTION. - 77 X PIC X. - PROCEDURE DIVISION. - CALL "CBL_OR" USING X - END-CALL - STOP RUN. -]) - -AT_CHECK([$COMPILE wrong.cob], [1], [], -[wrong.cob:8: error: wrong number of CALL parameters for 'CBL_OR', 1 given, 3 expected -]) -AT_CHECK([$COMPILE prog.cob], [0], [], -[prog.cob:9: warning: wrong number of CALL parameters for 'C$NARG', 2 given, 1 expected -]) -AT_CHECK([$COBCRUN_DIRECT ./prog 1 2], [0], [], []) - -AT_CLEANUP - - -AT_SETUP([System routine C$NARG]) -AT_KEYWORDS([extensions narg]) - -AT_DATA([callee.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. callee. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 X USAGE BINARY-LONG. - LINKAGE SECTION. - 01 Y PIC X. - PROCEDURE DIVISION USING Y. - CALL "C$NARG" USING X - END-CALL - IF X NOT = 1 - DISPLAY "NOTOK callee " X - END-DISPLAY - END-IF - EXIT PROGRAM. -]) - -AT_DATA([caller.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. caller. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 X PIC X VALUE "X". - 01 N PIC 9 USAGE BINARY. - LINKAGE SECTION. - 77 Y PIC X. - 77 Z PIC X. - PROCEDURE DIVISION. - CALL "C$NARG" USING N - END-CALL - IF N NOT = 2 - DISPLAY "NOTOK caller (1) " N - END-DISPLAY - END-IF - CALL "callee" USING X - END-CALL - CALL "C$NARG" USING N - END-CALL - IF N NOT = 2 - DISPLAY "NOTOK caller (2) " N - END-DISPLAY - END-IF - STOP RUN. -]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 N PIC 9 USAGE BINARY. - LINKAGE SECTION. - 77 X PIC X. - 77 Y PIC X. - 77 Z PIC X. - PROCEDURE DIVISION. - CALL "C$NARG" USING N - END-CALL - DISPLAY N WITH NO ADVANCING - END-DISPLAY - STOP RUN. -]) - -AT_CHECK([$COMPILE caller.cob], [0], [], []) -AT_CHECK([$COMPILE_MODULE callee.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./caller 1 2], [0], [], []) -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog "1 2"], [0], [1], []) -AT_CHECK([$COBCRUN_DIRECT ./prog 1 2 3], [0], [3], []) - -AT_CLEANUP - - -AT_SETUP([System routine C$PARAMSIZE]) -AT_KEYWORDS([extensions]) - -AT_DATA([callee.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. callee. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 X USAGE BINARY-LONG. - LINKAGE SECTION. - 01 Y PIC X ANY LENGTH. - PROCEDURE DIVISION USING Y. - MOVE 1 TO X. - CALL "C$PARAMSIZE" USING X - END-CALL. - IF RETURN-CODE NOT = 2 - DISPLAY "NOTOK " RETURN-CODE - END-DISPLAY - END-IF. - MOVE 0 TO RETURN-CODE. - EXIT PROGRAM. -]) - -AT_DATA([caller.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. caller. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 X PIC XX VALUE "XY". - PROCEDURE DIVISION. - CALL "callee" USING X - END-CALL. - STOP RUN. -]) - -AT_CHECK([$COMPILE caller.cob], [0], [], []) -AT_CHECK([$COMPILE_MODULE callee.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./caller], [0], [], []) - -AT_CLEANUP - - -AT_SETUP([System routine C$CALLEDBY]) -AT_KEYWORDS([extensions]) - -AT_DATA([callee.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. callee. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 X PIC X(6) VALUE "X". - PROCEDURE DIVISION. - CALL "C$CALLEDBY" USING X - END-CALL. - IF RETURN-CODE = 1 AND - X = "caller" - DISPLAY "OK" NO ADVANCING - END-DISPLAY - END-IF. - EXIT PROGRAM. -]) - -AT_DATA([caller.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. caller. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 X PIC X(6) VALUE "X". - PROCEDURE DIVISION. - CALL "C$CALLEDBY" USING X - END-CALL. - IF RETURN-CODE = 0 AND - X = SPACES - DISPLAY "OK" NO ADVANCING - END-DISPLAY - END-IF. - CALL "callee" - END-CALL. - STOP RUN. -]) - -AT_CHECK([$COMPILE caller.cob], [0], [], []) -AT_CHECK([$COMPILE_MODULE callee.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./caller], [1], [OKOK]) - -AT_CLEANUP - - -AT_SETUP([System routine C$JUSTIFY]) -AT_KEYWORDS([extensions]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 X PIC X(4) VALUE " OK ". - PROCEDURE DIVISION. - CALL "C$JUSTIFY" USING X "L" - END-CALL. - IF X NOT = "OK " - DISPLAY X NO ADVANCING - END-DISPLAY - END-IF. - STOP RUN. -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [], []) - -AT_CLEANUP - - -AT_SETUP([System routine C$PRINTABLE]) -AT_KEYWORDS([extensions]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 X. - 03 X1 PIC X. - 03 X234 PIC XXX. - PROCEDURE DIVISION. - MOVE LOW-VALUE TO X1. - MOVE "BCD" TO X234. - CALL "C$PRINTABLE" USING X - END-CALL. - IF X NOT = ".BCD" - DISPLAY X NO ADVANCING - END-DISPLAY - END-IF. - STOP RUN. -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [], []) - -AT_CLEANUP - - -AT_SETUP([System routine C$MAKEDIR]) -AT_KEYWORDS([extensions]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - PROCEDURE DIVISION. - CALL "C$MAKEDIR" USING "TMP" - END-CALL. - STOP RUN. -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [], []) -AT_CHECK([test -d "TMP" && rmdir "TMP"], [0], [], []) - -AT_CLEANUP - - -AT_SETUP([System routine C$GETPID]) -AT_KEYWORDS([extensions]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - PROCEDURE DIVISION. - CALL "C$GETPID" - END-CALL. - IF RETURN-CODE = 0 - DISPLAY "C$GETPID returned zero!" - END-DISPLAY - END-IF. - MOVE 0 TO RETURN-CODE. - STOP RUN. -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [], []) - -AT_CLEANUP - - -AT_SETUP([System routine C$TOUPPER]) -AT_KEYWORDS([extensions]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 X PIC X(2) VALUE "ok". - PROCEDURE DIVISION. - CALL "C$TOUPPER" USING X BY VALUE 2 - END-CALL. - IF X NOT = "OK" - DISPLAY X NO ADVANCING - END-DISPLAY - END-IF. - STOP RUN. -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [], []) - -AT_CLEANUP - - -AT_SETUP([System routine C$TOLOWER]) -AT_KEYWORDS([extensions]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 X PIC X(2) VALUE "OK". - PROCEDURE DIVISION. - CALL "C$TOLOWER" USING X BY VALUE 2 - END-CALL. - IF X NOT = "ok" - DISPLAY X NO ADVANCING - END-DISPLAY - END-IF. - STOP RUN. -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [], []) - -AT_CLEANUP - - -AT_SETUP([System routine CBL_OR]) -AT_KEYWORDS([extensions]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 X PIC X(4) VALUE "0000". - 01 Z PIC X(4) VALUE X"01010101". - PROCEDURE DIVISION. - CALL "CBL_OR" USING X Z - BY VALUE LENGTH OF Z - END-CALL. - IF Z NOT = "1111" - DISPLAY Z NO ADVANCING - END-DISPLAY - END-IF. - STOP RUN. -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [], []) - -AT_CLEANUP - - -AT_SETUP([System routine CBL_NOR]) -AT_KEYWORDS([extensions]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 X PIC X(4) VALUE X"03030303". - 01 Z PIC X(4) VALUE X"05050505". - PROCEDURE DIVISION. - CALL "CBL_NOR" USING X Z - BY VALUE LENGTH OF Z - END-CALL. - IF Z NOT = X"F8F8F8F8" - DISPLAY "NG" NO ADVANCING - END-DISPLAY - END-IF. - STOP RUN. -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [], []) - -AT_CLEANUP - - -AT_SETUP([System routine CBL_AND]) -AT_KEYWORDS([extensions]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 X PIC X(4) VALUE "3333". - 01 Z PIC X(4) VALUE "5555". - PROCEDURE DIVISION. - CALL "CBL_AND" USING X Z - BY VALUE LENGTH OF Z - END-CALL. - IF Z NOT = "1111" - DISPLAY Z NO ADVANCING - END-DISPLAY - END-IF. - STOP RUN. -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [], []) - -AT_CLEANUP - - -AT_SETUP([System routine CBL_XOR]) -AT_KEYWORDS([extensions]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 X PIC X(4) VALUE "3333". - 01 Z PIC X(4) VALUE X"02020202". - PROCEDURE DIVISION. - CALL "CBL_XOR" USING X Z - BY VALUE LENGTH OF Z - END-CALL. - IF Z NOT = "1111" - DISPLAY Z NO ADVANCING - END-DISPLAY - END-IF. - STOP RUN. -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [], []) - -AT_CLEANUP - - -AT_SETUP([System routine CBL_IMP]) -AT_KEYWORDS([extensions]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 X PIC X(4) VALUE HIGH-VALUE. - 01 Z PIC X(4) VALUE "1111". - PROCEDURE DIVISION. - CALL "CBL_IMP" USING X Z - BY VALUE LENGTH OF Z - END-CALL. - IF Z NOT = "1111" - DISPLAY Z NO ADVANCING - END-DISPLAY - END-IF. - STOP RUN. -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [], []) - -AT_CLEANUP - - -AT_SETUP([System routine CBL_NIMP]) -AT_KEYWORDS([extensions]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 X PIC X(4) VALUE "1111". - 01 Z PIC X(4) VALUE LOW-VALUE. - PROCEDURE DIVISION. - CALL "CBL_NIMP" USING X Z - BY VALUE LENGTH OF Z - END-CALL. - IF Z NOT = "1111" - DISPLAY Z NO ADVANCING - END-DISPLAY - END-IF. - STOP RUN. -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [], []) - -AT_CLEANUP - - -AT_SETUP([System routine CBL_NOT]) -AT_KEYWORDS([extensions]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 X PIC X(4) VALUE HIGH-VALUE. - PROCEDURE DIVISION. - CALL "CBL_NOT" USING X - BY VALUE LENGTH OF X - END-CALL. - IF X NOT = LOW-VALUE - DISPLAY "NG" NO ADVANCING - END-DISPLAY - END-IF. - STOP RUN. -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [], []) - -AT_CLEANUP - - -AT_SETUP([System routine CBL_EQ]) -AT_KEYWORDS([extensions]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 X PIC X(4) VALUE HIGH-VALUE. - 01 Z PIC X(4) VALUE "1111". - PROCEDURE DIVISION. - CALL "CBL_EQ" USING X Z - BY VALUE LENGTH OF Z - END-CALL. - IF Z NOT = "1111" - DISPLAY Z NO ADVANCING - END-DISPLAY - END-IF. - STOP RUN. -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [], []) - -AT_CLEANUP - - -AT_SETUP([System routine CBL_GC_GETOPT]) -AT_KEYWORDS([extensions]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - *> check combination of long and short options - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 LO. - 05 OPTIONRECORD OCCURS 2 TIMES. - 10 ONAME PIC X(25). - 10 HAS-VALUE PIC 9. - 10 VALPOINT POINTER VALUE NULL. - 10 VAL PIC X(4). - - 01 SO PIC X(256). - 01 LONGIND PIC 99. - 01 LONG-ONLY PIC 9 VALUE 1. - 01 RETURN-CHAR PIC X(4). - 01 OPT-VAL PIC X(10). - 01 RET-DISP PIC S9 VALUE 0. - - 01 COUNTER PIC 9 VALUE 0. - PROCEDURE DIVISION. - MOVE "jkl" TO SO. - - MOVE "version" TO ONAME (1). - MOVE 0 TO HAS-VALUE (1). - MOVE "v" TO VAL (1). - - MOVE "verbose" TO ONAME (2). - MOVE 0 TO HAS-VALUE (2). - MOVE "V" TO VAL (2). - - PERFORM WITH TEST AFTER - VARYING COUNTER FROM 0 BY 1 - UNTIL RETURN-CODE = -1 - CALL 'CBL_GC_GETOPT' USING - BY REFERENCE SO LO LONGIND - BY VALUE LONG-ONLY - BY REFERENCE RETURN-CHAR OPT-VAL - END-CALL - - EVALUATE COUNTER - WHEN 0 - IF RETURN-CHAR NOT = 'v' THEN - DISPLAY '0-ERROR: ' RETURN-CHAR END-DISPLAY - END-IF - WHEN 1 - IF RETURN-CHAR NOT = 'V' THEN - DISPLAY '1-ERROR: ' RETURN-CHAR END-DISPLAY - END-IF - WHEN 2 - IF RETURN-CHAR NOT = 'j' THEN - DISPLAY '2-ERROR: ' RETURN-CHAR END-DISPLAY - END-IF - WHEN 3 - IF RETURN-CHAR NOT = 'k' THEN - DISPLAY '3-ERROR: ' RETURN-CHAR END-DISPLAY - END-IF - WHEN 4 - IF RETURN-CHAR NOT = 'l' THEN - DISPLAY '4-ERROR: ' RETURN-CHAR END-DISPLAY - END-IF - WHEN 5 - IF RETURN-CODE NOT = -1 THEN - MOVE RETURN-CODE TO RET-DISP - DISPLAY 'last RETURN-CODE wrong: ' RET-DISP - END-DISPLAY - END-IF - EXIT PERFORM - END-EVALUATE - END-PERFORM. - - MOVE 0 TO RETURN-CODE. - - IF COUNTER NOT = 5 THEN - MOVE RETURN-CODE TO RET-DISP - DISPLAY 'CBL_GC_GETOPT returned -1 too early: ' COUNTER - END-DISPLAY - END-IF. - - STOP RUN. -]) - -AT_DATA([prog2.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog2. - *> check if partial options work correct - DATA DIVISION. - WORKING-STORAGE SECTION. - *> Check with wrong record count - - - 01 LO. - 05 OPTIONRECORD OCCURS 3 TIMES. - 10 ONAME PIC X(25). - 10 HAS-VALUE PIC 9. - 10 VALPOINT POINTER VALUE NULL. - 10 VAL PIC X(4). - - 78 SO VALUE "jkl". - 01 LONGIND PIC 99. - 01 LONG-ONLY PIC 9 VALUE 1. - 01 RETURN-CHAR PIC X(4). - 01 OPT-VAL PIC X(10). - 01 RET-DISP PIC S9 VALUE 0. - - 01 COUNTER PIC 9 VALUE 0. - PROCEDURE DIVISION. - MOVE "version" TO ONAME (1). - MOVE 0 TO HAS-VALUE (1). - MOVE "v" TO VAL (1). - - MOVE "verbose" TO ONAME (2). - MOVE 0 TO HAS-VALUE (2). - MOVE "V" TO VAL (2). - - PERFORM WITH TEST AFTER - VARYING COUNTER FROM 0 BY 1 - UNTIL RETURN-CODE = -1 - CALL 'CBL_GC_GETOPT' USING - BY REFERENCE SO LO LONGIND - BY VALUE LONG-ONLY - BY REFERENCE RETURN-CHAR OPT-VAL - END-CALL - - EVALUATE COUNTER - WHEN 0 - IF RETURN-CHAR NOT = '?' THEN - DISPLAY '0-ERROR: ' RETURN-CHAR END-DISPLAY - END-IF - WHEN 1 - IF RETURN-CHAR NOT = 'v' THEN - DISPLAY '1-ERROR: ' RETURN-CHAR END-DISPLAY - END-IF - WHEN 2 - IF RETURN-CODE NOT = -1 THEN - MOVE RETURN-CODE TO RET-DISP - DISPLAY 'last RETURN-CODE wrong: ' RET-DISP - END-DISPLAY - END-IF - EXIT PERFORM - END-EVALUATE - END-PERFORM. - - MOVE 0 TO RETURN-CODE. - - IF COUNTER NOT = 2 THEN - MOVE RETURN-CODE TO RET-DISP - DISPLAY 'CBL_GC_GETOPT returned -1 too early: ' COUNTER - END-DISPLAY - END-IF. - - STOP RUN. -]) - -AT_DATA([prog3.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog3. - *> check for optional and mandatory parameters - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 SO PIC X(128). - 01 LO. - 05 OPTIONRECORD OCCURS 3 TIMES. - 10 ONAME PIC X(25). - 10 HAS-VALUE PIC 9. - 10 VALPOINT POINTER VALUE NULL. - 10 VAL PIC X(4). - 01 LONGIND PIC 99. - 01 LONG-ONLY PIC 9 VALUE 0. - 01 RETURN-CHAR PIC X(4). - 01 OPT-VAL PIC X(10). - 01 RET-DISP PIC S9 VALUE 0. - - 01 COUNTER PIC 9 VALUE 0. - PROCEDURE DIVISION. - MOVE "j:k::l" TO SO. - - MOVE "version" TO ONAME (1). - MOVE 1 TO HAS-VALUE (1). - MOVE "v" TO VAL (1). - - MOVE "verbose" TO ONAME (2). - MOVE 2 TO HAS-VALUE (2). - MOVE "V" TO VAL (2). - - MOVE "usage" TO ONAME (3). - MOVE 0 TO HAS-VALUE (3). - MOVE "u" TO VAL (3). - - PERFORM WITH TEST AFTER - VARYING COUNTER FROM 0 BY 1 - UNTIL RETURN-CODE = -1 - CALL 'CBL_GC_GETOPT' USING - BY REFERENCE SO LO LONGIND - BY VALUE LONG-ONLY - BY REFERENCE RETURN-CHAR OPT-VAL - END-CALL - - EVALUATE COUNTER - WHEN 0 - IF OPT-VAL(1:4) NOT = 'lang' THEN - DISPLAY '0-ERROR: ' OPT-VAL END-DISPLAY - END-IF - WHEN 1 - IF (OPT-VAL(1:1) NOT = 'k' OR - RETURN-CHAR NOT = 'V' OR - OPT-VAL(1:4) = 'kang') THEN - DISPLAY '1-ERROR: ' OPT-VAL ' ' RETURN-CHAR - END-DISPLAY - END-IF - WHEN 2 - IF RETURN-CHAR NOT = 'u' THEN - DISPLAY '2-ERROR: ' RETURN-CHAR END-DISPLAY - END-IF - WHEN 3 - IF OPT-VAL(1:1) NOT = '5' OR - RETURN-CHAR NOT = 'j' THEN - DISPLAY '3-ERROR: ' OPT-VAL ' ' RETURN-CHAR - END-DISPLAY - END-IF - WHEN 4 - IF OPT-VAL(1:1) NOT = '6' OR - RETURN-CHAR NOT = 'k' THEN - DISPLAY '4-ERROR: ' OPT-VAL ' ' RETURN-CHAR - END-DISPLAY - END-IF - WHEN 5 - IF RETURN-CHAR NOT = 'l' THEN - DISPLAY '5-ERROR: ' RETURN-CHAR END-DISPLAY - END-IF - WHEN 6 - IF RETURN-CODE NOT = -1 THEN - MOVE RETURN-CODE TO RET-DISP - DISPLAY 'last RETURN-CODE wrong: ' RET-DISP - END-DISPLAY - END-IF - EXIT PERFORM - END-EVALUATE - END-PERFORM. - - MOVE 0 TO RETURN-CODE. - - IF COUNTER NOT = 6 THEN - MOVE RETURN-CODE TO RET-DISP - DISPLAY 'CBL_GC_GETOPT returned -1 too early: ' COUNTER - END-DISPLAY - END-IF. - - STOP RUN. -]) - -AT_DATA([prog4.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog4. - *> check use of value pointer and trimming of opt-val - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 SO PIC X(12). - 01 LO. - 05 OPTIONRECORD OCCURS 3 TIMES. - 10 ONAME PIC X(25). - 10 HAS-VALUE PIC 9. - 10 VALPOINT POINTER VALUE NULL. - 10 VAL PIC X(4). - 01 LONGIND PIC 99. - 01 LONG-ONLY PIC 9 VALUE 1. - 01 RETURN-CHAR PIC X(4). - 01 OPT-VAL PIC X(10). - 01 RET-DISP PIC S999 VALUE 0. - - 01 COUNTER PIC 9 VALUE 0. - - 01 FLAG-VAL PIC X(4). - procedure division. - MOVE "jkl" TO SO. - - MOVE "static" TO ONAME (1). - MOVE 0 TO HAS-VALUE (1). - SET VALPOINT(1) TO ADDRESS OF FLAG-VAL. - MOVE '1' TO VAL (1). - - MOVE "dynamic" TO ONAME (2). - MOVE 0 TO HAS-VALUE (2). - SET VALPOINT(2) TO ADDRESS OF FLAG-VAL. - MOVE '0' TO VAL (2). - - MOVE "usage" TO ONAME (3). - MOVE 1 TO HAS-VALUE (3). - MOVE 'u' TO VAL (3). - - PERFORM WITH TEST AFTER - VARYING COUNTER FROM 0 BY 1 - UNTIL RETURN-CODE = -1 - CALL 'CBL_GC_GETOPT' USING - BY REFERENCE SO LO LONGIND - BY VALUE LONG-ONLY - BY REFERENCE RETURN-CHAR OPT-VAL - END-CALL - - EVALUATE COUNTER - WHEN 0 - IF RETURN-CODE NOT = 0 OR - FLAG-VAL NOT = '1' THEN - DISPLAY '0-ERROR: ' RET-DISP ' ' FLAG-VAL - END-DISPLAY - END-IF - WHEN 1 - IF RETURN-CODE NOT = 0 OR - FLAG-VAL NOT = '0' THEN - DISPLAY '1-ERROR: ' RET-DISP ' ' FLAG-VAL - END-DISPLAY - END-IF - WHEN 2 - IF RETURN-CHAR NOT = 'u' OR - RETURN-CODE NOT = 2 THEN - DISPLAY '2-ERROR: ' RET-DISP ' ' FLAG-VAL - END-DISPLAY - END-IF - WHEN 3 - IF RETURN-CODE NOT = -1 THEN - MOVE RETURN-CODE TO RET-DISP - DISPLAY 'last RETURN-CODE wrong: ' RET-DISP - END-DISPLAY - END-IF - EXIT PERFORM - END-EVALUATE - END-PERFORM. - - MOVE 0 TO RETURN-CODE. - - IF COUNTER NOT = 3 THEN - MOVE RETURN-CODE TO RET-DISP - DISPLAY 'CBL_GC_GETOPT returned -1 too early: ' COUNTER - END-DISPLAY - END-IF. - - STOP RUN. -]) - -AT_DATA([prog5.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog5. - *> check for wrong longoption structure - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 SO PIC X. - 01 LO. - 05 OPTIONRECORD OCCURS 2 TIMES. - 10 ONAME PIC X(45). - 10 HAS-VALUE PIC 9. - 10 VALPOINT POINTER VALUE NULL. - 10 VAL PIC X(4). - 01 LONGIND PIC 99. - 01 LONG-ONLY PIC 9 VALUE 1. - 01 RETURN-CHAR PIC X(4). - 01 OPT-VAL PIC X(10). - 01 RET-DISP PIC S999 VALUE 0. - - 01 COUNTER PIC 9 VALUE 0. - - 01 FLAG-VAL PIC 9. - PROCEDURE DIVISION. - MOVE "super-long-option-with-more-than-25-bytes" - TO ONAME(1). - MOVE 0 TO HAS-VALUE(1). - MOVE '1' TO VAL(1). - - MOVE "stupid-long-option-with-more-than-25-bytes" - TO ONAME(2). - MOVE 0 TO HAS-VALUE(2). - MOVE '0' TO VAL(2). - - PERFORM WITH TEST AFTER - VARYING COUNTER FROM 0 BY 1 - UNTIL RETURN-CODE = -1 - CALL 'CBL_GC_GETOPT' USING - BY REFERENCE SO LO LONGIND - BY VALUE LONG-ONLY - BY REFERENCE RETURN-CHAR OPT-VAL - END-CALL - - EVALUATE COUNTER - WHEN 0 - WHEN 1 - WHEN 2 - CONTINUE - - *> MOVE RETURN-CODE TO RET-DISP - - *> IF COUNTER = 0 AND RETURN-CODE NOT = 1 THEN - *> DISPLAY 'RETURN VALUE: ' RET-DISP ' ' FLAG-VAL - *> END-IF - WHEN 3 - IF RETURN-CODE NOT = -1 THEN - MOVE RETURN-CODE TO RET-DISP - DISPLAY 'last RETURN-CODE wrong: ' RET-DISP - END-DISPLAY - END-IF - EXIT PERFORM - END-EVALUATE - END-PERFORM. - - MOVE 0 TO RETURN-CODE. - - IF COUNTER NOT = 3 THEN - MOVE RETURN-CODE TO RET-DISP - DISPLAY 'CBL_GC_GETOPT returned -1 too early: ' COUNTER - END-DISPLAY - END-IF. - - STOP RUN. -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog --version --verbose -jkl], [0], []) -AT_CHECK([$COMPILE_MODULE prog2.cob], [0], [], []) -AT_CHECK([$COBCRUN prog2 --ver --vers], [0], [], -[prog2: option '--ver' is ambiguous; possibilities: '--version' '--verbose' -]) -AT_CHECK([$COMPILE prog3.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog3 --version=lang --verbose=k --usage -j 5 -k6 -l], [0], []) -AT_CHECK([$COMPILE prog4.cob --free], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog4 --static --dynamic --usage=boringandtoolongtext], [0], []) -# Again a long and system specific error message which we ignore. -# Return code 1 is sufficient as proof of hard return (as wanted). -AT_CHECK([$COMPILE prog5.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog5 --static], [1], [], -[libcob: prog5.cob:37: error: Call to CBL_GC_GETOPT with wrong longoption size. -]) - -AT_CLEANUP - - -AT_SETUP([System routine CBL_GC_FORK]) -AT_KEYWORDS([extensions C$GETPID]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 77 CHILD-PID USAGE BINARY-LONG. - 77 PARENT-PID USAGE BINARY-LONG. - PROCEDURE DIVISION. - - CALL "C$GETPID" RETURNING PARENT-PID - CALL "CBL_GC_FORK" END-CALL - EVALUATE RETURN-CODE - WHEN ZERO - PERFORM CHILD-CODE - WHEN -1 - STOP RUN RETURNING 77 *> skip test - WHEN OTHER - PERFORM PARENT-CODE - END-EVALUATE - - STOP RUN. - - CHILD-CODE. - CALL "C$SLEEP" USING 1. - DISPLAY "Hello, I am the child". - CALL "C$GETPID" RETURNING CHILD-PID. - IF CHILD-PID = PARENT-PID - DISPLAY "CHILD: parent and child have same PID: " - "'" CHILD-PID "'" UPON SYSERR - END-DISPLAY - END-IF. - MOVE 0 TO RETURN-CODE. - - PARENT-CODE. - DISPLAY "Hello, I am the parent". - CALL "C$SLEEP" USING 4. - DISPLAY "Parent again". - IF RETURN-CODE = PARENT-PID - DISPLAY "PARENT: parent and child have same PID: " - "'" PARENT-PID "'" UPON SYSERR - END-DISPLAY - END-IF. - CALL "C$GETPID". - IF RETURN-CODE NOT = PARENT-PID - DISPLAY "PARENT: parent PID has changed: " - "'" PARENT-PID "' -> '" RETURN-CODE "'" - UPON SYSERR - END-DISPLAY - END-IF. - MOVE 0 TO RETURN-CODE. -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) - -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [Hello, I am the parent -Hello, I am the child -Parent again -], []) - -AT_CLEANUP - - -# Placed as extra routine as we should find a way to test this -# without CBL_GC_FORK (which isn't available on all systems where- -# CBL_GC_WAITPID is available, for example MINGW) -AT_SETUP([System routine CBL_GC_WAITPID]) -AT_KEYWORDS([extensions CBL_GC_FORK]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 CHILD-PID PIC S9(9) BINARY. - 01 WAIT-STS PIC S9(9) BINARY VALUE -3. - PROCEDURE DIVISION. - - CALL "CBL_GC_FORK" RETURNING CHILD-PID. - EVALUATE CHILD-PID - WHEN ZERO - PERFORM CHILD-CODE - WHEN -1 - STOP RUN RETURNING 77 *> skip test - WHEN OTHER - PERFORM PARENT-CODE - END-EVALUATE. - - STOP RUN. - - CHILD-CODE. - CALL "C$SLEEP" USING 1. - DISPLAY "Hello, I am the child". - MOVE 2 TO RETURN-CODE. - - PARENT-CODE. - DISPLAY "Hello, I am the parent". - CALL "CBL_GC_WAITPID" USING CHILD-PID - RETURNING WAIT-STS - END-CALL - MOVE 0 TO RETURN-CODE - IF WAIT-STS = -1 - STOP RUN RETURNING 77 *> skip test - END-IF - DISPLAY "Child ended status " WAIT-STS - END-DISPLAY. -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) - -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [Hello, I am the parent -Hello, I am the child -Child ended status +000000002 -], []) - -AT_CLEANUP - - -AT_SETUP([System routine CBL_GC_HOSTED]) -AT_KEYWORDS([extensions]) - -AT_DATA([test_errno.c], [ -#include -#include - -#include - -COB_EXT_EXPORT int -test_errno(void) -{ - FILE *fail; - fail = fopen("file-not-found", "r"); - if (errno != 2) { - printf("BAD ERRNO %d", errno); - } else { - if (fail) fclose(fail); - } - return 0; -} -]) - -AT_DATA([test_stdio.c], [ -#include - -#include -COB_EXT_EXPORT int -test_stdio(FILE *si, FILE *so, FILE *se) -{ - if (feof(si)) { - fprintf(se, "BAD STDIN EOF\n"); - } - fprintf(so, "OUT"); - return fprintf(se, "ERR"); -} -]) -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 STDIN USAGE POINTER. - 01 STDOUT USAGE POINTER. - 01 STDERR USAGE POINTER. - 01 CELL USAGE BINARY-LONG. - 01 ARGC USAGE BINARY-LONG. - 01 ARGV USAGE POINTER. - 01 ERRPTR USAGE POINTER. - 01 ERRNO USAGE BINARY-LONG BASED. - 01 TZNAME USAGE POINTER. - 01 TZNAMES USAGE POINTER BASED. - 05 TZS USAGE POINTER OCCURS 2 TIMES. - 01 TIMEZONE USAGE BINARY-C-LONG. - 01 DAYLIGHT USAGE BINARY-LONG. - - PROCEDURE DIVISION. - CALL "CBL_GC_HOSTED" USING STDIN "stdin" END-CALL - CALL "CBL_GC_HOSTED" USING STDOUT "stdout" END-CALL - CALL "CBL_GC_HOSTED" USING STDERR "stderr" END-CALL - CALL "CBL_GC_HOSTED" USING ARGC "argc" END-CALL - CALL "CBL_GC_HOSTED" USING ARGV "argv" END-CALL - CALL "CBL_GC_HOSTED" USING CELL "cell" END-CALL - CALL "CBL_GC_HOSTED" USING ERRPTR "errno" END-CALL - CALL "CBL_GC_HOSTED" USING ARGC "arg" END-CALL - CALL "CBL_GC_HOSTED" USING NULL "argc" END-CALL - SET ADDRESS OF ERRNO TO ERRPTR - CALL "CBL_GC_HOSTED" USING TZNAME "tzname" END-CALL - CALL "CBL_GC_HOSTED" USING TIMEZONE "timezone" END-CALL - CALL "CBL_GC_HOSTED" USING DAYLIGHT "daylight" END-CALL - - CALL "test_errno" - END-CALL - IF ERRNO NOT EQUAL 2 THEN - DISPLAY "BAD ERRNO " ERRNO END-DISPLAY - END-IF - - IF ARGC NOT EQUAL 2 THEN - DISPLAY "BAD ARGC " ARGC END-DISPLAY - END-IF - IF ARGV EQUAL NULL THEN - DISPLAY "BAD ARGV" END-DISPLAY - END-IF - - IF CELL LESS THAN 0 OR GREATER THAN 8 THEN - DISPLAY "UNK CELL " CELL END-DISPLAY - END-IF - - SET ENVIRONMENT "TZ" TO "PST8PDT" - CALL "tzset" RETURNING OMITTED - ON EXCEPTION CONTINUE - END-CALL - IF TZNAME NOT EQUAL NULL THEN - SET ADDRESS OF TZNAMES TO TZNAME - IF TZS(1) EQUAL NULL THEN - DISPLAY "BAD TZNAME" END-DISPLAY - END-IF - END-IF - - *> Test assumes return-code will be 3, chars output by last fprintf - CALL "test_stdio" USING BY VALUE STDIN STDOUT STDERR - END-CALL - - STOP RUN. -]) - -AT_CHECK([$COMPILE_MODULE test_errno.c], [0], [], []) -AT_CHECK([$COMPILE_MODULE test_stdio.c], [0], [], []) -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog 1ARG], [3], [OUT], [ERR]) - -AT_CLEANUP - - -AT_SETUP([System routine SYSTEM, parameter handling]) -AT_KEYWORDS([CHAINING TRIM]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - - DATA DIVISION. - WORKING-STORAGE SECTION. - * - 77 test-no PIC 9 VALUE 0. - 77 chaining-param PIC X(20). - 77 chaining-param-2 PIC X(20). - * - PROCEDURE DIVISION CHAINING chaining-param, chaining-param-2. - * - main. - EVALUATE chaining-param ALSO chaining-param-2 - WHEN SPACES ALSO SPACES - DISPLAY "started without options - closing" - WHEN "1" ALSO SPACES - WHEN '"1"' ALSO SPACES - WHEN "a v" ALSO SPACES - WHEN '"a v"' ALSO SPACES - DISPLAY " called with -" - function trim (chaining-param) "-" - WHEN "a" ALSO "v" - DISPLAY " called with -" - FUNCTION TRIM (chaining-param) "-" - " and with -" - FUNCTION TRIM (chaining-param-2) "-" - WHEN "start" ALSO SPACES - MOVE 'prog 1' TO chaining-param - PERFORM callme - MOVE 'prog "1"' TO chaining-param - PERFORM callme - MOVE '"prog" 1' TO chaining-param - PERFORM callme - MOVE '"prog" "1"' TO chaining-param - PERFORM callme - MOVE 'prog a v' TO chaining-param - PERFORM callme - MOVE 'prog "a v"' TO chaining-param - PERFORM callme - MOVE '"prog" a v' TO chaining-param - PERFORM callme - MOVE '"prog" "a v"' TO chaining-param - PERFORM callme - MOVE '"prog" "a" "v"' TO chaining-param - PERFORM callme - DISPLAY "tests finished" - WHEN OTHER - DISPLAY "called with unexpected -" - FUNCTION TRIM (chaining-param) "-" - END-EVALUATE - STOP RUN. - * - callme. - ADD 1 TO test-no. - DISPLAY "Test #" test-no ":" - DISPLAY " CALL 'SYSTEM' with " - FUNCTION TRIM (chaining-param) ":" - CALL "SYSTEM" USING FUNCTION TRIM (chaining-param) - DISPLAY " --> return of the given CALL 'SYSTEM': " - return-code. -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([PATH=.:$PATH $COBCRUN_DIRECT prog "start"], [0], -[Test #1: - CALL 'SYSTEM' with prog 1: - called with -1- - --> return of the given CALL 'SYSTEM': +000000000 -Test #2: - CALL 'SYSTEM' with prog "1": - called with -1- - --> return of the given CALL 'SYSTEM': +000000000 -Test #3: - CALL 'SYSTEM' with "prog" 1: - called with -1- - --> return of the given CALL 'SYSTEM': +000000000 -Test #4: - CALL 'SYSTEM' with "prog" "1": - called with -1- - --> return of the given CALL 'SYSTEM': +000000000 -Test #5: - CALL 'SYSTEM' with prog a v: - called with -a- and with -v- - --> return of the given CALL 'SYSTEM': +000000000 -Test #6: - CALL 'SYSTEM' with prog "a v": - called with -a v- - --> return of the given CALL 'SYSTEM': +000000000 -Test #7: - CALL 'SYSTEM' with "prog" a v: - called with -a- and with -v- - --> return of the given CALL 'SYSTEM': +000000000 -Test #8: - CALL 'SYSTEM' with "prog" "a v": - called with -a v- - --> return of the given CALL 'SYSTEM': +000000000 -Test #9: - CALL 'SYSTEM' with "prog" "a" "v": - called with -a- and with -v- - --> return of the given CALL 'SYSTEM': +000000000 -tests finished -]) - -AT_CLEANUP - - -AT_SETUP([System routine CBL_ERROR_PROC]) -AT_KEYWORDS([extensions exceptions error -EXCEPTION-LOCATION EXCEPTION-STATEMENT EXCEPTION-FILE EXCEPTION-STATUS]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. DemoErrProc. - ENVIRONMENT DIVISION. - DATA DIVISION. - WORKING-STORAGE SECTION. - 77 Err-Proc-Address USAGE PROGRAM-POINTER. - 77 Err-Message-Len PIC 9(04) USAGE COMP-5. - LINKAGE SECTION. - 77 Err-Message-From-Runtime PIC X(1023). - PROCEDURE DIVISION. - S1. - DISPLAY 'Program is starting' - SET Err-Proc-Address TO ENTRY 'ErrProc' - CALL 'CBL_ERROR_PROC' USING 0, Err-Proc-Address - SET Err-Proc-Address TO ENTRY 'ErrProc-internal' - CALL 'CBL_ERROR_PROC' USING 0, Err-Proc-Address - SET Err-Proc-Address TO NULL - CALL 'Tilt' *> THIS DOESN'T EXIST!!!! - DISPLAY 'Program is stopping' - STOP RUN - . - ENTRY 'ErrProc-internal' USING Err-Message-From-Runtime. - DISPLAY 'Error (interal): ' FUNCTION EXCEPTION-LOCATION '-' - DISPLAY ' ' FUNCTION EXCEPTION-STATEMENT '-' - DISPLAY ' ' FUNCTION EXCEPTION-STATUS '-' - *> NOTE: the error message is *EXPLICIT* specified to end with x'00' - MOVE 0 TO Err-Message-Len - INSPECT Err-Message-From-Runtime - TALLYING Err-Message-Len FOR CHARACTERS BEFORE x'00' - DISPLAY 'Error-Message: ' Err-Message-From-Runtime - (1:Err-Message-Len) - DISPLAY '-*- Returning to Next Error Routine -*-' - EXIT PROGRAM - . - END PROGRAM DemoErrProc. - - IDENTIFICATION DIVISION. - PROGRAM-ID. ErrProc. - PROCEDURE DIVISION. - 000-Main. - DISPLAY 'Error: ' FUNCTION EXCEPTION-LOCATION '-' - DISPLAY ' ' FUNCTION EXCEPTION-STATEMENT '-' - DISPLAY ' ' FUNCTION EXCEPTION-STATUS '-' - DISPLAY '-*- Returning to Standard Error Routine -*-' - EXIT PROGRAM - . - END PROGRAM ErrProc. -]) -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [1], -[Program is starting -Error (interal): DemoErrProc; S1; 19- - CALL - - EC-PROGRAM-NOT-FOUND - -Error-Message: prog.cob:19: module 'Tilt' not found --*- Returning to Next Error Routine -*- -Error: DemoErrProc; S1; 19- - CALL - - EC-PROGRAM-NOT-FOUND - --*- Returning to Standard Error Routine -*- -], -[libcob: prog.cob:19: error: module 'Tilt' not found -]) - -AT_CHECK([$COBC -x -o prog_noloc prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog_noloc], [1], -[Program is starting -Error (interal): - - - - EC-PROGRAM-NOT-FOUND - -Error-Message: module 'Tilt' not found --*- Returning to Next Error Routine -*- -Error: - - - - EC-PROGRAM-NOT-FOUND - --*- Returning to Standard Error Routine -*- -], -[libcob: error: module 'Tilt' not found -]) - -AT_CLEANUP - - -AT_SETUP([DISPLAY DIRECTIVE and $DISPLAY]) -AT_KEYWORDS([extensions]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - PROCEDURE DIVISION. - >> DISPLAY some text - >> DISPLAY other text #2 *> comment - >> DISPLAY "literal text *> no comment" - $DISPLAY MF compile time text *> without comment - GOBACK. -]) - -AT_CHECK([$COMPILE prog.cob], [0], -[some text -other text #2 -literal text *> no comment -MF compile time text -]) -AT_CLEANUP - - -AT_SETUP([Conditional/define directives (1)]) -AT_KEYWORDS([extensions directive]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - PROCEDURE DIVISION. - >>IF ACTIVATE NOT DEFINED - DISPLAY "OK" NO ADVANCING - END-DISPLAY - >>ELSE - DISPLAY "NOTOK" NO ADVANCING - END-DISPLAY - >>END-IF - STOP RUN. -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [OK], []) - -AT_CLEANUP - - -AT_SETUP([Conditional/define directives (2)]) -AT_KEYWORDS([extensions directive]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - PROCEDURE DIVISION. - >>IF ACTIVATE DEFINED - DISPLAY "OK" NO ADVANCING - END-DISPLAY - >>ELSE - DISPLAY "NOTOK" NO ADVANCING - END-DISPLAY - >>END-IF - STOP RUN. -]) - -AT_CHECK([$COMPILE -DACTIVATE prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [OK], []) - -AT_CLEANUP - - -AT_SETUP([Conditional/define directives (3)]) -AT_KEYWORDS([extensions directive]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - PROCEDURE DIVISION. - >>IF ACTIVATE DEFINED - DISPLAY "NOTOK" NO ADVANCING - END-DISPLAY - >>ELIF ACTIVATE2 DEFINED - DISPLAY "OK" NO ADVANCING - END-DISPLAY - >>ELSE - DISPLAY "NOTOK" NO ADVANCING - END-DISPLAY - >>END-IF - STOP RUN. -]) - -AT_CHECK([$COMPILE -DACTIVATE2 prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [OK], []) - -AT_CLEANUP - - -AT_SETUP([Conditional/define directives (4)]) -AT_KEYWORDS([extensions directive]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - PROCEDURE DIVISION. - >>IF ACTIVATE DEFINED - DISPLAY "NOTOK" NO ADVANCING - END-DISPLAY - >>ELIF ACTIVATE2 DEFINED - >>ELSE - DISPLAY "NOTOK" NO ADVANCING - END-DISPLAY - >>END-IF - STOP RUN. -]) - -AT_CHECK([$COMPILE -DACTIVATE2 prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [], []) - -AT_CLEANUP - - -AT_SETUP([Conditional/define directives (5)]) -AT_KEYWORDS([extensions directive]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - PROCEDURE DIVISION. - >>IF ACTIVATE DEFINED - >>DISPLAY NOTOK - >>ELIF ACTIVATE2 DEFINED - >>DISPLAY OK - >>ELSE - >>DISPLAY NOTOK - >>END-IF - STOP RUN. -]) - -AT_CHECK([$COMPILE -DACTIVATE2 prog.cob], [0], -[OK -]) -AT_CLEANUP - - -AT_SETUP([Conditional/define directives (6)]) -AT_KEYWORDS([extensions directive]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - PROCEDURE DIVISION. - >>IF X DEFINED - >>DISPLAY X defined - >>ELSE - >>DISPLAY X not defined - >>DEFINE X 1 - >>END-IF - CONTINUE - . -]) - -AT_CHECK([$COMPILE -D X prog.cob], [0], -[X defined -]) -AT_CHECK([$COMPILE prog.cob], [0], -[X not defined -]) -AT_CLEANUP - - -AT_SETUP([Conditional/define directives (7)]) -AT_KEYWORDS([extensions directive]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - PROCEDURE DIVISION. - >>IF A IS DEFINED - >>IF B IS DEFINED - CONTINUE - . - >>ELSE - CONTINUE - . - >>END-IF - >>END-IF -]) - -AT_CHECK([$COMPILE prog.cob], [0], []) -AT_CLEANUP - - -AT_SETUP([Conditional/define directives (8)]) -AT_KEYWORDS([extensions directive]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - PROCEDURE DIVISION. - >>IF A IS DEFINED - CONTINUE - . - >>else - CONTINUE - . - >>eNd-If -]) - -AT_CHECK([$COMPILE prog.cob], [0], []) -AT_CLEANUP - - -AT_SETUP([Variable format]) -AT_KEYWORDS([extensions runmisc]) - -AT_DATA([prog.cob], [ - >>SOURCE FORMAT VARIABLE -000010 IDENTIFICATION DIVISION. -000020 PROGRAM-ID. prog. -000030* blah blah blah -000040 PROCEDURE DIVISION. -000050 DISPLAY "Hello!" -000060 . -000070 END PROGRAM prog. -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], -[Hello! -]) - -AT_CLEANUP - - -AT_SETUP([Binary COMP-1 (1)]) -AT_KEYWORDS([extensions]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 comp1 COMP-1. - 01 num PIC 9.9. - - PROCEDURE DIVISION. - COMPUTE comp1 = 7 / 2 - MOVE comp1 TO num - DISPLAY num - . -]) - -AT_CHECK([$COMPILE -fbinary-comp-1 prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], -[3.0 -]) -AT_CHECK([$COMPILE -fno-binary-comp-1 prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], -[3.5 -]) - -AT_CLEANUP - - -AT_SETUP([Binary COMP-1 (2)]) -AT_KEYWORDS([extensions directives]) - -AT_DATA([prog.cob], [ - >>IF BINARY-COMP-1 IS DEFINED - $SET COMP-1(BINARY) - >>ELSE - $SET COMP1 "float" - >>END-IF - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 comp1 COMP-1. - 01 num PIC 9.9. - - PROCEDURE DIVISION. - COMPUTE comp1 = 7 / 2 - MOVE comp1 TO num - DISPLAY num - . -]) - -AT_CHECK([$COMPILE -DBINARY-COMP-1 prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], -[3.0 -]) -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], -[3.5 -]) - -AT_CLEANUP diff -Nru gnucobol-4.0~early~20200606/tests/testsuite.src/run_file.at gnucobol-5/tests/testsuite.src/run_file.at --- gnucobol-4.0~early~20200606/tests/testsuite.src/run_file.at 2020-06-06 20:52:00.000000000 +0000 +++ gnucobol-5/tests/testsuite.src/run_file.at 1970-01-01 00:00:00.000000000 +0000 @@ -1,18581 +0,0 @@ -## Copyright (C) 2003-2012, 2014-2020 Free Software Foundation, Inc. -## Written by Keisuke Nishida, Roger While, Simon Sobisch, Ron Norman, -## Brian Tiffin, Joe Robbins, Edward Hart -## -## This file is part of GnuCOBOL. -## -## The GnuCOBOL compiler is free software: you can redistribute it -## and/or modify it under the terms of the GNU General Public License -## as published by the Free Software Foundation, either version 3 of the -## License, or (at your option) any later version. -## -## GnuCOBOL is distributed in the hope that it will be useful, -## but WITHOUT ANY WARRANTY; without even the implied warranty of -## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -## GNU General Public License for more details. -## -## You should have received a copy of the GNU General Public License -## along with GnuCOBOL. If not, see . - -### GnuCOBOL Test Suite - - -AT_SETUP([READ INTO data item AT-END sequence]) -AT_KEYWORDS([runfile]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - INPUT-OUTPUT SECTION. - FILE-CONTROL. - SELECT TEST-FILE ASSIGN "./TEST-FILE". - DATA DIVISION. - FILE SECTION. - FD TEST-FILE. - 01 TEST-REC PIC X(10). - WORKING-STORAGE SECTION. - 01 X PIC X(10). - PROCEDURE DIVISION. - OPEN OUTPUT TEST-FILE. - CLOSE TEST-FILE. - OPEN INPUT TEST-FILE. - READ TEST-FILE INTO X - AT END MOVE ALL ZERO TO X - END-READ. - CLOSE TEST-FILE. - IF X NOT = "0000000000" - DISPLAY "Expected zeros - Got " X - END-DISPLAY - END-IF. - STOP RUN. -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [], []) - -AT_CLEANUP - - -AT_SETUP([LINAGE and LINAGE-COUNTER sample]) -AT_KEYWORDS([runfile optional file status READ WRITE END-OF-PAGE LINE SEQUENTIAL COB_CURRENT_DATE]) - -# modified version of GC-FAQ: Example of LINAGE File Descriptor -# Author: Brian Tiffin, Date: 10-July-2008 - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - INPUT-OUTPUT SECTION. - FILE-CONTROL. - select optional data-file assign to 'prog.cob' - organization is line sequential - file status is data-file-status. - select mini-report assign to "mini-report". - - DATA DIVISION. - FILE SECTION. - FD data-file. - 01 data-record. - 88 endofdata value high-values. - 02 data-line pic x(80). - FD mini-report - linage is 16 lines - with footing at 15 - lines at top 2 - lines at bottom 2. - 01 report-line pic x(80). - - WORKING-STORAGE SECTION. - 01 command-arguments pic x(1024). - 01 file-name pic x(160). - 01 data-file-status pic xx. - 01 lc pic 99. - 01 report-line-blank. - 02 filler pic x(18) value all "*". - 02 filler pic x(05) value spaces. - 02 filler pic x(34) - VALUE "THIS PAGE INTENTIONALLY LEFT BLANK". - 02 filler pic x(05) value spaces. - 02 filler pic x(18) value all "*". - 01 report-line-data. - 02 body-tag pic 9(6). - 02 line-3 pic x(74). - 01 report-line-header. - 02 filler pic x(6) VALUE "PAGE: ". - 02 page-no pic 9999. - 02 filler pic x(24). - 02 filler pic x(5) VALUE " LC: ". - 02 header-tag pic 9(6). - 02 filler pic x(23). - 02 filler pic x(6) VALUE "DATE: ". - 02 page-date pic x(6). - - 01 page-count pic 9999. - - PROCEDURE DIVISION. - - open input data-file. - read data-file - at end - display "File open error: " data-file-status - stop run - end-read. - - open output mini-report. - - write report-line - from report-line-blank - end-write. - - move 1 to page-count. - accept page-date from date end-accept. - move page-count to page-no. - write report-line - from report-line-header - after advancing page - end-write. - - perform readwrite-loop until endofdata. - - display - "Normal termination, ending status: " - data-file-status - close mini-report. - - close data-file. - stop run. - - **************************************************************** - readwrite-loop. - move data-record to report-line-data - move linage-counter to body-tag - write report-line from report-line-data - end-of-page - add 1 to page-count end-add - move page-count to page-no - move linage-counter to header-tag - write report-line from report-line-header - after advancing page - end-write - end-write - read data-file - at end set endofdata to true - end-read - . -]) - -AT_CAPTURE_FILE([mini-report]) -AT_DATA([reference-report], [ - -****************** THIS PAGE INTENTIONALLY LEFT BLANK ****************** - - - - - - - - - - - - - - - - - - -PAGE: 0001 LC: 000000 DATE: 150206 -000001 -000002 IDENTIFICATION DIVISION. -000003 PROGRAM-ID. prog. -000004 ENVIRONMENT DIVISION. -000005 INPUT-OUTPUT SECTION. -000006 FILE-CONTROL. -000007 select optional data-file assign to 'prog.cob' -000008 organization is line sequential -000009 file status is data-file-status. -000010 select mini-report assign to "mini-report". -000011 -000012 DATA DIVISION. -000013 FILE SECTION. -000014 FD data-file. - - - - - -PAGE: 0002 LC: 000015 DATE: 150206 -000001 01 data-record. -000002 88 endofdata value high-values. -000003 02 data-line pic x(80). -000004 FD mini-report -000005 linage is 16 lines -000006 with footing at 15 -000007 lines at top 2 -000008 lines at bottom 2. -000009 01 report-line pic x(80). -000010 -000011 WORKING-STORAGE SECTION. -000012 01 command-arguments pic x(1024). -000013 01 file-name pic x(160). -000014 01 data-file-status pic xx. - - - - - -PAGE: 0003 LC: 000015 DATE: 150206 -000001 01 lc pic 99. -000002 01 report-line-blank. -000003 02 filler pic x(18) value all "*". -000004 02 filler pic x(05) value spaces. -000005 02 filler pic x(34) -000006 VALUE "THIS PAGE INTENTIONALLY LEFT BLANK". -000007 02 filler pic x(05) value spaces. -000008 02 filler pic x(18) value all "*". -000009 01 report-line-data. -000010 02 body-tag pic 9(6). -000011 02 line-3 pic x(74). -000012 01 report-line-header. -000013 02 filler pic x(6) VALUE "PAGE: ". -000014 02 page-no pic 9999. - - - - - -PAGE: 0004 LC: 000015 DATE: 150206 -000001 02 filler pic x(24). -000002 02 filler pic x(5) VALUE " LC: ". -000003 02 header-tag pic 9(6). -000004 02 filler pic x(23). -000005 02 filler pic x(6) VALUE "DATE: ". -000006 02 page-date pic x(6). -000007 -000008 01 page-count pic 9999. -000009 -000010 PROCEDURE DIVISION. -000011 -000012 open input data-file. -000013 read data-file -000014 at end - - - - - -PAGE: 0005 LC: 000015 DATE: 150206 -000001 display "File open error: " data-file-status -000002 stop run -000003 end-read. -000004 -000005 open output mini-report. -000006 -000007 write report-line -000008 from report-line-blank -000009 end-write. -000010 -000011 move 1 to page-count. -000012 accept page-date from date end-accept. -000013 move page-count to page-no. -000014 write report-line - - - - - -PAGE: 0006 LC: 000015 DATE: 150206 -000001 from report-line-header -000002 after advancing page -000003 end-write. -000004 -000005 perform readwrite-loop until endofdata. -000006 -000007 display -000008 "Normal termination, ending status: " -000009 data-file-status -000010 close mini-report. -000011 -000012 close data-file. -000013 stop run. -000014 - - - - - -PAGE: 0007 LC: 000015 DATE: 150206 -000001**************************************************************** -000002 readwrite-loop. -000003 move data-record to report-line-data -000004 move linage-counter to body-tag -000005 write report-line from report-line-data -000006 end-of-page -000007 add 1 to page-count end-add -000008 move page-count to page-no -000009 move linage-counter to header-tag -000010 write report-line from report-line-header -000011 after advancing page -000012 end-write -000013 end-write -000014 read data-file - - - - - -PAGE: 0008 LC: 000015 DATE: 150206 -000001 at end set endofdata to true -000002 end-read -000003 . -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([COB_CURRENT_DATE="2015/02/06 16:40:52" $COBCRUN_DIRECT ./prog], [0], -[Normal termination, ending status: 10 -], []) -AT_CHECK([diff mini-report reference-report], [0], [], []) - -AT_CLEANUP - - -AT_SETUP([OUTPUT on INDEXED file to missing directory]) -AT_KEYWORDS([runfile OPEN ASSIGN]) - -AT_SKIP_IF([test "$COB_HAS_ISAM" = "no"]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - CONFIGURATION SECTION. - INPUT-OUTPUT SECTION. - FILE-CONTROL. - SELECT FILE0 ASSIGN TO "./nosubhere/MYFILE0" - ORGANIZATION IS INDEXED - RECORD KEY IS F0REC - FILE STATUS IS WSFS. - DATA DIVISION. - FILE SECTION. - FD FILE0. - 01 F0REC PIC X(80). - WORKING-STORAGE SECTION. - 01 WSFS PIC X(2). - PROCEDURE DIVISION. - * - OPEN OUTPUT FILE0 - DISPLAY "STATUS OPENO " WSFS - * - STOP RUN. -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) - -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], -[STATUS OPENO 35 -], []) - -AT_CHECK([echo Test > ./nosubhere], [0], [], []) - -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], -[STATUS OPENO 30 -], []) - -AT_CLEANUP - - -AT_SETUP([First READ on empty SEQUENTIAL INDEXED file]) -AT_KEYWORDS([runfile]) - -AT_SKIP_IF([test "$COB_HAS_ISAM" = "no"]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - INPUT-OUTPUT SECTION. - FILE-CONTROL. - SELECT TEST-FILE ASSIGN "./TEST-FILE" - ORGANIZATION IS INDEXED - ACCESS MODE IS SEQUENTIAL - RECORD KEY IS TEST-KEY. - DATA DIVISION. - FILE SECTION. - FD TEST-FILE. - 01 TEST-KEY PIC X(10). - PROCEDURE DIVISION. - OPEN OUTPUT TEST-FILE. - CLOSE TEST-FILE. - OPEN INPUT TEST-FILE. - READ TEST-FILE - AT END - CONTINUE - NOT AT END - DISPLAY "NOT OK" - END-DISPLAY - END-READ. - CLOSE TEST-FILE. - STOP RUN. -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [], []) - -AT_CLEANUP - - -AT_SETUP([READ NEXT without previous START]) -AT_KEYWORDS([runfile WRITE indexed]) - -AT_SKIP_IF([test "$COB_HAS_ISAM" = "no"]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - INPUT-OUTPUT SECTION. - FILE-CONTROL. - SELECT TEST-FILE ASSIGN "./TEST-FILE" - ORGANIZATION IS INDEXED - ACCESS MODE IS SEQUENTIAL - RECORD KEY IS TEST-KEY. - DATA DIVISION. - FILE SECTION. - FD TEST-FILE. - 01 TEST-REC. - 05 TEST-KEY PIC X(10). - 05 TEST-DATA PIC X. - PROCEDURE DIVISION. - OPEN OUTPUT TEST-FILE - MOVE '1' TO TEST-KEY - MOVE 'A' TO TEST-DATA - WRITE TEST-REC - MOVE '3' TO TEST-KEY - MOVE 'B' TO TEST-DATA - WRITE TEST-REC - CLOSE TEST-FILE - OPEN INPUT TEST-FILE - READ TEST-FILE NEXT - AT END - DISPLAY "AT END FOR REC1" - END-DISPLAY - CLOSE TEST-FILE - STOP RUN - NOT AT END - CONTINUE - END-READ - IF TEST-DATA NOT = 'A' - DISPLAY "WRONG REC1: '" TEST-REC "'" - END-DISPLAY - END-IF - READ TEST-FILE NEXT - AT END - DISPLAY "AT END FOR REC2" - END-DISPLAY - CLOSE TEST-FILE - STOP RUN - NOT AT END - CONTINUE - END-READ. - IF TEST-DATA NOT = 'B' - DISPLAY "WRONG REC2: '" TEST-REC "'" - END-DISPLAY - END-IF - READ TEST-FILE NEXT - AT END - CONTINUE - NOT AT END - DISPLAY "NOT AT END AFTER REC2" - END-DISPLAY - END-READ - IF TEST-DATA NOT = 'B' - DISPLAY "DATE CHANGED ON EOF: '" TEST-REC "'" - END-DISPLAY - END-IF - CLOSE TEST-FILE - STOP RUN. -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [], []) - -AT_CLEANUP - - -AT_SETUP([REWRITE a RELATIVE file with RANDOM access]) -AT_KEYWORDS([runfile]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - INPUT-OUTPUT SECTION. - FILE-CONTROL. - SELECT TEST-FILE ASSIGN "./TEST-FILE" - ORGANIZATION IS RELATIVE - ACCESS MODE IS RANDOM - RELATIVE KEY IS TEST-KEY. - DATA DIVISION. - FILE SECTION. - FD TEST-FILE. - 01 TEST-REC PIC X. - WORKING-STORAGE SECTION. - 01 TEST-KEY PIC 9. - PROCEDURE DIVISION. - * - OPEN OUTPUT TEST-FILE. - MOVE 1 TO TEST-KEY. - MOVE "A" TO TEST-REC. - WRITE TEST-REC - END-WRITE. - MOVE 2 TO TEST-KEY. - MOVE "B" TO TEST-REC. - WRITE TEST-REC - END-WRITE. - CLOSE TEST-FILE. - * - OPEN I-O TEST-FILE. - MOVE 1 TO TEST-KEY. - READ TEST-FILE - END-READ. - MOVE 2 TO TEST-KEY. - MOVE "C" TO TEST-REC. - REWRITE TEST-REC - END-REWRITE. - CLOSE TEST-FILE. - * - OPEN INPUT TEST-FILE. - MOVE 1 TO TEST-KEY. - READ TEST-FILE - END-READ. - IF TEST-REC NOT = "A" - DISPLAY "Expected 'A' - Got " TEST-REC - END-DISPLAY - END-IF. - MOVE 2 TO TEST-KEY. - READ TEST-FILE - END-READ. - IF TEST-REC NOT = "C" - DISPLAY "Expected 'C' - Got " TEST-REC - END-DISPLAY - END-IF. - CLOSE TEST-FILE. - STOP RUN. -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [], []) - -AT_CLEANUP - - -AT_SETUP([error status RELATIVE file]) -AT_KEYWORDS([runfile REWRITE WRITE DECLARATIVES]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - INPUT-OUTPUT SECTION. - FILE-CONTROL. - SELECT TEST-FILE ASSIGN "./TEST-FILE" - ORGANIZATION IS RELATIVE - ACCESS MODE IS RANDOM - RELATIVE KEY IS TEST-KEY - FILE STATUS IS FILE-STATUS. - DATA DIVISION. - FILE SECTION. - FD TEST-FILE. - 01 TEST-REC PIC X. - WORKING-STORAGE SECTION. - 01 TEST-KEY PIC 9. - 01 FILE-STATUS PIC XX. - PROCEDURE DIVISION. - - DECLARATIVES. - ERR-DISP SECTION. - USE AFTER ERROR PROCEDURE ON TEST-FILE. - DISPLAY FILE-STATUS WITH NO ADVANCING. - END DECLARATIVES. - * - OPEN OUTPUT TEST-FILE. - MOVE 1 TO TEST-KEY. - MOVE "A" TO TEST-REC. - WRITE TEST-REC - END-WRITE. - MOVE 2 TO TEST-KEY. - MOVE "B" TO TEST-REC. - WRITE TEST-REC - END-WRITE. - CLOSE TEST-FILE. - * - OPEN INPUT TEST-FILE. - MOVE 1 TO TEST-KEY. - READ TEST-FILE - END-READ. - MOVE 2 TO TEST-KEY. - MOVE "C" TO TEST-REC. - REWRITE TEST-REC - END-REWRITE. - CLOSE TEST-FILE. - * - OPEN INPUT TEST-FILE. - MOVE 3 TO TEST-KEY. - WRITE TEST-REC - END-WRITE. - CLOSE TEST-FILE. - * - STOP RUN. -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [4948], []) - -AT_CLEANUP - - -AT_SETUP([File SORT, SEQUENTIAL]) -AT_KEYWORDS([runfile using giving]) - -# Note: We shouldn't use AT_DATA to create sequential record -# data, because AT_DATA needs a \n at the end - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - INPUT-OUTPUT SECTION. - FILE-CONTROL. - SELECT SORT-IN ASSIGN "test.txt". - SELECT SORT-OUT ASSIGN "result.txt". - SELECT SORT-WRK ASSIGN "SORT-WRK". - DATA DIVISION. - FILE SECTION. - FD SORT-IN. - 01 IN-REC PIC X(6). - FD SORT-OUT. - 01 OUT-REC PIC X(6). - SD SORT-WRK. - 01 WRK-REC PIC X(6). - PROCEDURE DIVISION. - - * Special case: write test data in COBOL, see note above - OPEN OUTPUT SORT-IN. - WRITE IN-REC FROM SPACES END-WRITE. - WRITE IN-REC FROM SPACES END-WRITE. - WRITE IN-REC FROM "world " END-WRITE. - WRITE IN-REC FROM SPACES END-WRITE. - WRITE IN-REC FROM "hello " END-WRITE. - WRITE IN-REC FROM SPACES END-WRITE. - WRITE IN-REC FROM SPACES END-WRITE. - CLOSE SORT-IN. - - SORT SORT-WRK - ASCENDING KEY WRK-REC - USING SORT-IN - GIVING SORT-OUT. - STOP RUN. -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [], []) -AT_CHECK([cat result.txt], [0], [ hello world ], []) - -AT_CLEANUP - - -AT_SETUP([File SORT, SEQUENTIAL variable records]) -AT_KEYWORDS([runfile]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - INPUT-OUTPUT SECTION. - FILE-CONTROL. - SELECT file1 ORGANIZATION SEQUENTIAL - ASSIGN "./file1". - SELECT file2 ORGANIZATION SEQUENTIAL - ASSIGN "./file2". - SELECT file3 ASSIGN DISK. - DATA DIVISION. - FILE SECTION. - FD file1 RECORD VARYING FROM 3 TO 12 DEPENDING rsz. - 1 file1-rec pic x(12). - FD file2 RECORD VARYING FROM 3 TO 12 DEPENDING rsz. - 1 file2-rec pic x(12). - SD file3 RECORD VARYING FROM 3 TO 12 DEPENDING rsz. - 1 file3-rec. - 2 file3-key1 pic x. - 2 file3-key2 pic 9. - 2 filler pic x(10). - WORKING-STORAGE SECTION. - 77 rsz pic 99. - 1 1-data. - 2 filler pic x(14) VALUE "03A4X". - 2 filler pic x(14) VALUE "04A3XX". - 2 filler pic x(14) VALUE "05A2XXX". - 2 filler pic x(14) VALUE "06A1XXXX". - 2 filler pic x(14) VALUE "07A0XXXXX". - 2 filler pic x(14) VALUE "08B2XXXXXX". - 2 filler pic x(14) VALUE "09B1XXXXXXX". - 2 filler pic x(14) VALUE "10C2XXXXXXXX". - 2 filler pic x(14) VALUE "11C1XXXXXXXXX". - 2 filler pic x(14) VALUE "12Z9XXXXXXXXXX". - * - 1 filler redefines 1-data. - 2 filler occurs 10 times indexed by ix-1. - 3 1-rsz pic 99. - 3 1-rec pic x(12). - - PROCEDURE DIVISION. - OPEN OUTPUT file1. - PERFORM VARYING ix-1 FROM 1 BY 2 UNTIL ix-1 > 10 - MOVE 1-rsz(ix-1) TO rsz - MOVE 1-rec(ix-1) TO file1-rec - WRITE file1-rec - END-PERFORM. - PERFORM VARYING ix-1 FROM 2 BY 2 UNTIL ix-1 > 10 - MOVE 1-rsz(ix-1) TO rsz - MOVE 1-rec(ix-1) TO file1-rec - WRITE file1-rec - END-PERFORM. - CLOSE file1. - SORT file3 ON ASCENDING file3-key1 - DESCENDING file3-key2 - USING file1 - GIVING file2. - OPEN INPUT file2. - PERFORM VARYING ix-1 FROM 1 BY 1 UNTIL ix-1 > 10 - READ file2 - *>> fileio-sort currently returns constant length records - MOVE 1-rsz(ix-1) TO rsz - *>> END-OF-DETOUR - IF (1-rsz(ix-1) <> rsz) or - (1-rec(ix-1) <> file2-rec) - DISPLAY "FAILED" - END-IF - END-PERFORM. - CLOSE file2. - STOP RUN. -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0]) - -AT_CLEANUP - - -AT_SETUP([INDEXED File KEYCHECK]) -AT_KEYWORDS([runfile SUPPRESS WHEN]) - -AT_SKIP_IF([test "$COB_HAS_ISAM" = "no"]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - - PROGRAM-ID. prog. - - ENVIRONMENT DIVISION. - CONFIGURATION SECTION. - - INPUT-OUTPUT SECTION. - FILE-CONTROL. - SELECT OPTIONAL TSPFILE - ASSIGN TO "testisam" - ORGANIZATION INDEXED ACCESS DYNAMIC - RECORD KEY IS PRIME-KEY - SOURCE IS CM-CUST-NUM, CM-COMPANY - - ALTERNATE RECORD KEY IS SPLIT-KEY2 - SOURCE IS CM-TELEPHONE,CM-MACHINE WITH DUPLICATES - - ALTERNATE RECORD KEY IS SPLIT-KEY3 - SOURCE IS CM-DISK,CM-TAPE WITH DUPLICATES - SUPPRESS WHEN ALL "*" - FILE STATUS IS CUST-STAT - . - - SELECT TSTFILE - ASSIGN TO "testisam" - ORGANIZATION INDEXED ACCESS DYNAMIC - RECORD KEY IS TST-KEY - SOURCE IS TS-CUST-NUM, TS-COMPANY - - ALTERNATE RECORD KEY IS TST-KEY2 - SOURCE IS TS-TELEPHONE,TS-MACHINE WITH DUPLICATES - - ALTERNATE RECORD KEY IS TST-KEY3 - SOURCE IS TS-DISK,TS-TAPE WITH DUPLICATES - SUPPRESS WHEN ALL "*" - - FILE STATUS IS CUST-STAT - . - - SELECT BADFILE - ASSIGN TO "testisam" - ORGANIZATION INDEXED ACCESS DYNAMIC - RECORD KEY IS BAD-KEY - SOURCE IS BD-CUST-NUM, BD-COMPANY - - ALTERNATE RECORD KEY IS BAD-KEY2 - SOURCE IS BD-DISK,BD-TAPE WITH DUPLICATES - SUPPRESS WHEN ALL "*" - FILE STATUS IS CUST-STAT - . - - DATA DIVISION. - FILE SECTION. - FD TSPFILE - BLOCK CONTAINS 5 RECORDS. - - 01 TSPFL-RECORD. - 05 TSPFL-REC. - 10 CM-CUST-NUM. - 15 CM-CUST-PRE PICTURE X(3). - 15 CM-CUST-NNN PICTURE X(5). - 10 CM-STATUS PICTURE X. - 10 CM-COMPANY PICTURE X(25). - 10 CM-ADDRESS-1 PICTURE X(25). - 10 CM-ADDRESS-2 PICTURE X(25). - 10 CM-ADDRESS-3 PICTURE X(25). - 10 CM-TELEPHONE PICTURE 9(10). - 10 CM-DP-MGR PICTURE X(25). - 10 CM-MACHINE PICTURE X(8). - 10 CM-MEMORY PICTURE X(4). - 10 CM-DISK PICTURE X(8). - 10 CM-TAPE PICTURE X(8). - 10 CM-NO-TERMINALS PICTURE 9(5). - - FD BADFILE - BLOCK CONTAINS 5 RECORDS. - - 01 BAD-RECORD. - 05 BAD-REC. - 10 BD-CUST-NUM PICTURE X(8). - 10 BD-STATUS PICTURE X. - 10 BD-COMPANY PICTURE X(25). - 10 BD-ADDRESS-1 PICTURE X(25). - 10 BD-ADDRESS-2 PICTURE X(25). - 10 BD-ADDRESS-3 PICTURE X(25). - 10 BD-TELEPHONE PICTURE 9(10). - 10 BD-DP-MGR PICTURE X(25). - 10 BD-MACHINE PICTURE X(8). - 10 BD-MEMORY PICTURE X(4). - 10 BD-DISK PICTURE X(8). - 10 BD-TAPE PICTURE X(8). - 10 BD-NO-TERMINALS PICTURE 9(5). - 10 BD-XTRA PICTURE 9(5). - - FD TSTFILE - BLOCK CONTAINS 5 RECORDS. - - 01 TSTFL-RECORD. - 05 TSTFL-REC. - 10 TS-CUST-NUM PICTURE X(8). - 10 TS-STATUS PICTURE X. - 10 TS-COMPANY PICTURE X(25). - 10 TS-ADDRESS-1 PICTURE X(25). - 10 TS-ADDRESS-2 PICTURE X(25). - 10 TS-ADDRESS-3 PICTURE X(25). - 10 TS-TELEPHONE PICTURE 9(10). - 10 TS-DP-MGR PICTURE X(25). - 10 TS-MACHINE PICTURE X(8). - 10 TS-MEMORY PICTURE X(4). - 10 TS-DISK PICTURE X(8). - 10 TS-TAPE PICTURE X(8). - - - WORKING-STORAGE SECTION. - - 01 CUST-STAT. - 05 STAT-1 PICTURE 9(4) COMP SYNC. - 05 FILLER REDEFINES STAT-1. - 10 STAT-X1 PIC X COMP-X. - 10 STAT-X2 PIC X COMP-X. - 77 BYTE-1 PICTURE 9(3). - 77 BYTE-2 PICTURE 9(3). - 77 MAX-SUB VALUE 16 PICTURE 9(5) COMP SYNC. - 77 DO-REWRITE PICTURE X VALUE 'N'. - 77 ENVVAR-IN PICTURE X(30). - 77 ENVVAR-OUT PICTURE X(60). - - 01 TEST-DATA. - - 02 DATA-CUST-NUM-TBL. - - 05 FILLER PIC X(8) VALUE "ALP00000". - 05 FILLER PIC X(8) VALUE "BET00000". - 05 FILLER PIC X(8) VALUE "GAM00000". - 05 FILLER PIC X(8) VALUE "DEL00000". - 05 FILLER PIC X(8) VALUE "EPS00000". - 05 FILLER PIC X(8) VALUE "FOR00000". - 05 FILLER PIC X(8) VALUE "GIB00000". - 05 FILLER PIC X(8) VALUE "H&J00000". - 05 FILLER PIC X(8) VALUE "INC00000". - 05 FILLER PIC X(8) VALUE "JOH00000". - 05 FILLER PIC X(8) VALUE "KON00000". - 05 FILLER PIC X(8) VALUE "LEW00000". - 05 FILLER PIC X(8) VALUE "MOR00000". - 05 FILLER PIC X(8) VALUE "NEW00000". - 05 FILLER PIC X(8) VALUE "OLD00000". - 05 FILLER PIC X(8) VALUE "PRE00000". - - 02 DATA-CUST-NUM REDEFINES DATA-CUST-NUM-TBL - PIC X(8) OCCURS 16. - 02 DATA-COMPANY-TBL. - - 05 FILLER PIC X(25) VALUE "ALPHA ELECTRICAL CO. LTD.". - 05 FILLER PIC X(25) VALUE "BETA SHOE MFG. INC. ". - 05 FILLER PIC X(25) VALUE "GAMMA X-RAY TECHNOLOGY ". - 05 FILLER PIC X(25) VALUE "DELTA LUGGAGE REPAIRS ". - 05 FILLER PIC X(25) VALUE "EPSILON EQUIPMENT SUPPLY ". - 05 FILLER PIC X(25) VALUE "FORTUNE COOKIE COMPANY ". - 05 FILLER PIC X(25) VALUE "GIBRALTER LIFE INSURANCE ". - 05 FILLER PIC X(25) VALUE "H & J PLUMBING SUPPLIES ". - 05 FILLER PIC X(25) VALUE "INCREMENTAL BACKUP CORP. ". - 05 FILLER PIC X(25) VALUE "JOHNSON BOATING SUPPLIES ". - 05 FILLER PIC X(25) VALUE "KONFLAB PLASTIC PRODUCTS.". - 05 FILLER PIC X(25) VALUE "LEWISTON GRAPHICS LTD. ". - 05 FILLER PIC X(25) VALUE "MORNINGSIDE CARPENTRY. ". - 05 FILLER PIC X(25) VALUE "NEW WAVE SURF SHOPS INC. ". - 05 FILLER PIC X(25) VALUE "OLD TYME PIZZA MFG. CO. ". - 05 FILLER PIC X(25) VALUE "PRESTIGE OFFICE FURNITURE". - - 02 DATA-COMPANY REDEFINES DATA-COMPANY-TBL - PIC X(25) OCCURS 16. - 02 DATA-ADDRESS-1-TBL. - - 05 FILLER PIC X(25) VALUE "123 MAIN STREET ". - 05 FILLER PIC X(25) VALUE "1090 2ND AVE. WEST ". - 05 FILLER PIC X(25) VALUE "1401 JEFFERSON BLVD. ". - 05 FILLER PIC X(25) VALUE "1620 ARIZONA WAY ". - 05 FILLER PIC X(25) VALUE "1184 EAST FIRST STREET ". - 05 FILLER PIC X(25) VALUE "114 JOHN F. KENNEDY AVE. ". - 05 FILLER PIC X(25) VALUE "650 LIBERTY CRESCENT ". - 05 FILLER PIC X(25) VALUE "77 SUNSET BLVD. ". - 05 FILLER PIC X(25) VALUE "10908 SANTA MONICA BLVD. ". - 05 FILLER PIC X(25) VALUE "1134 PARIS ROAD ". - 05 FILLER PIC X(25) VALUE "808 NORTHWEST MAIN ST. ". - 05 FILLER PIC X(25) VALUE "9904 QUEEN STREET ". - 05 FILLER PIC X(25) VALUE "1709 DUNDAS CRESCENT W. ". - 05 FILLER PIC X(25) VALUE "3240 MARIS AVENUE ". - 05 FILLER PIC X(25) VALUE "1705 WISCONSIN ROAD ". - 05 FILLER PIC X(25) VALUE "114A MAPLE GROVE ". - - 02 DATA-ADDRESS-1 REDEFINES DATA-ADDRESS-1-TBL - PIC X(25) OCCURS 16. - 02 DATA-ADDRESS-2-TBL. - - 05 FILLER PIC X(10) VALUE "NEW YORK ". - 05 FILLER PIC X(10) VALUE "ATLANTA ". - 05 FILLER PIC X(10) VALUE "WASHINGTON". - 05 FILLER PIC X(10) VALUE "TORONTO ". - 05 FILLER PIC X(10) VALUE "CALGARY ". - 05 FILLER PIC X(10) VALUE "SAN DIEGO ". - 05 FILLER PIC X(10) VALUE "LOS RIOS ". - 05 FILLER PIC X(10) VALUE "MADISON ". - 05 FILLER PIC X(10) VALUE "WILBUR ". - 05 FILLER PIC X(10) VALUE "TOPEKA ". - 05 FILLER PIC X(10) VALUE "SEATTLE ". - 05 FILLER PIC X(10) VALUE "NEW JERSEY". - 05 FILLER PIC X(10) VALUE "FORT WAYNE". - 05 FILLER PIC X(10) VALUE "COLUMBUS ". - 05 FILLER PIC X(10) VALUE "RICHMOND ". - 05 FILLER PIC X(10) VALUE "WHITEPLAIN". - - 02 DATA-ADDRESS-2 REDEFINES DATA-ADDRESS-2-TBL - PIC X(10) OCCURS 16. - 02 DATA-ADDRESS-3-TBL. - - 05 FILLER PIC X(10) VALUE "N.Y. ". - 05 FILLER PIC X(10) VALUE "GEORGIA ". - 05 FILLER PIC X(10) VALUE "D.C. ". - 05 FILLER PIC X(10) VALUE "CANADA ". - 05 FILLER PIC X(10) VALUE "CANADA ". - 05 FILLER PIC X(10) VALUE "CALIFORNIA". - 05 FILLER PIC X(10) VALUE "NEW MEXICO". - 05 FILLER PIC X(10) VALUE "WISCONSIN ". - 05 FILLER PIC X(10) VALUE "DELAWARE ". - 05 FILLER PIC X(10) VALUE "KANSAS ". - 05 FILLER PIC X(10) VALUE "WASHINGTON". - 05 FILLER PIC X(10) VALUE "N.J. ". - 05 FILLER PIC X(10) VALUE "COLORADO ". - 05 FILLER PIC X(10) VALUE "OHIO ". - 05 FILLER PIC X(10) VALUE "VIRGINIA ". - 05 FILLER PIC X(10) VALUE "N.Y. ". - - 02 DATA-ADDRESS-3 REDEFINES DATA-ADDRESS-3-TBL - PIC X(10) OCCURS 16. - 02 DATA-TELEPHONE-TBL. - - 05 FILLER PIC 9(10) VALUE 3131234432. - 05 FILLER PIC 9(10) VALUE 4082938498. - 05 FILLER PIC 9(10) VALUE 8372487274. - 05 FILLER PIC 9(10) VALUE 4169898509. - 05 FILLER PIC 9(10) VALUE 5292398745. - 05 FILLER PIC 9(10) VALUE 8009329492. - 05 FILLER PIC 9(10) VALUE 6456445643. - 05 FILLER PIC 9(10) VALUE 6546456333. - 05 FILLER PIC 9(10) VALUE 3455445444. - 05 FILLER PIC 9(10) VALUE 6456445643. - 05 FILLER PIC 9(10) VALUE 7456434355. - 05 FILLER PIC 9(10) VALUE 6554456433. - 05 FILLER PIC 9(10) VALUE 4169898509. - 05 FILLER PIC 9(10) VALUE 7534587453. - 05 FILLER PIC 9(10) VALUE 8787458374. - 05 FILLER PIC 9(10) VALUE 4169898509. - - 02 DATA-TELEPHONE REDEFINES DATA-TELEPHONE-TBL - PIC 9(10) OCCURS 16. - 02 DATA-DP-MGR-TBL. - - 05 FILLER PIC X(20) VALUE "MR. DAVE HARRIS ". - 05 FILLER PIC X(20) VALUE "MS. JANICE SILCOX ". - 05 FILLER PIC X(20) VALUE "MR. ALLAN JONES ". - 05 FILLER PIC X(20) VALUE "MR. PETER MACKAY ". - 05 FILLER PIC X(20) VALUE "MRS. DONNA BREWER ". - 05 FILLER PIC X(20) VALUE "MR. MICHAEL SMYTHE ". - 05 FILLER PIC X(20) VALUE "MR. D.A. MORRISON ". - 05 FILLER PIC X(20) VALUE "MR. BRIAN PATTERSON ". - 05 FILLER PIC X(20) VALUE "MR. DARRYL TOWNSEND ". - 05 FILLER PIC X(20) VALUE "MS. VALERIE HARPER ". - 05 FILLER PIC X(20) VALUE "MR. FRED MILLER ". - 05 FILLER PIC X(20) VALUE "MR. DONALD FISCHER ". - 05 FILLER PIC X(20) VALUE "MR. STEVEN YOURDIN ". - 05 FILLER PIC X(20) VALUE "MS. Goldie Hawn ". - 05 FILLER PIC X(20) VALUE "MS. ALICE WINSTON ". - 05 FILLER PIC X(20) VALUE "MR. THOMAS JEFFERSON". - - 02 DATA-DP-MGR REDEFINES DATA-DP-MGR-TBL - PIC X(20) OCCURS 16. - 02 DATA-MACHINE-TBL. - - 05 FILLER PIC X(8) VALUE "UNI-9030". - 05 FILLER PIC X(8) VALUE "UNI-9040". - 05 FILLER PIC X(8) VALUE "UNI-80/3". - 05 FILLER PIC X(8) VALUE "UNI-80/5". - 05 FILLER PIC X(8) VALUE "UNI-80/6". - 05 FILLER PIC X(8) VALUE "UNI-80/6". - 05 FILLER PIC X(8) VALUE "UNI-80/6". - 05 FILLER PIC X(8) VALUE "UNI-80/8". - 05 FILLER PIC X(8) VALUE "UNI-80/8". - 05 FILLER PIC X(8) VALUE "UNI-80/8". - 05 FILLER PIC X(8) VALUE "UNI-80/8". - 05 FILLER PIC X(8) VALUE "UNI-80/8". - 05 FILLER PIC X(8) VALUE "UNI-80/8". - 05 FILLER PIC X(8) VALUE "UNI-80/8". - 05 FILLER PIC X(8) VALUE "UNI-9040". - 05 FILLER PIC X(8) VALUE "UNI-9040". - - 02 DATA-MACHINE REDEFINES DATA-MACHINE-TBL - PIC X(8) OCCURS 16. - 02 DATA-NO-TERMINALS-TBL. - - 05 FILLER PIC 9(3) COMP-3 VALUE 85. - 05 FILLER PIC 9(3) COMP-3 VALUE 34. - 05 FILLER PIC 9(3) COMP-3 VALUE 75. - 05 FILLER PIC 9(3) COMP-3 VALUE 45. - 05 FILLER PIC 9(3) COMP-3 VALUE 90. - 05 FILLER PIC 9(3) COMP-3 VALUE 107. - 05 FILLER PIC 9(3) COMP-3 VALUE 67. - 05 FILLER PIC 9(3) COMP-3 VALUE 32. - 05 FILLER PIC 9(3) COMP-3 VALUE 16. - 05 FILLER PIC 9(3) COMP-3 VALUE 34. - 05 FILLER PIC 9(3) COMP-3 VALUE 128. - 05 FILLER PIC 9(3) COMP-3 VALUE 64. - 05 FILLER PIC 9(3) COMP-3 VALUE 110. - 05 FILLER PIC 9(3) COMP-3 VALUE 324. - 05 FILLER PIC 9(3) COMP-3 VALUE 124. - 05 FILLER PIC 9(3) COMP-3 VALUE 86. - - 02 DATA-NO-TERMINALS REDEFINES DATA-NO-TERMINALS-TBL - PIC 9(3) COMP-3 OCCURS 16. - - 01 WORK-AREA. - 05 REC-NUM PICTURE 9(6) VALUE 0. - 05 REC-MAX PICTURE 9(6) VALUE 10. - 05 SUB PICTURE 9(4) COMP SYNC. - 88 ODD-RECORD VALUE 1 3 5 7 9 10 11. - 88 NULL-KEY VALUE 4 5 8 12 14. - - 05 TSPFL-KEY PICTURE X(8). - - PROCEDURE DIVISION. - - MAINFILE. - PERFORM LOADFILE. - PERFORM LOADFILE. - PERFORM REWRFILE. - PERFORM LISTFILE. - OPEN INPUT TSTFILE - IF CUST-STAT NOT = "00" - DISPLAY "A: Expected ERROR " CUST-STAT - " opening TSTFILE, Record size different" - UPON CONSOLE - ELSE - DISPLAY "A: Un-Expected open " - "TSTFILE, Record size different" UPON CONSOLE - CLOSE TSTFILE - END-IF. - OPEN INPUT BADFILE - IF CUST-STAT NOT = "00" - DISPLAY "B: Expected ERROR " CUST-STAT - " opening BADFILE, Index mismatch" UPON CONSOLE - ELSE - DISPLAY "B: Un-Expected open BADFILE, Index mismatch" - UPON CONSOLE - CLOSE BADFILE - END-IF. - - DISPLAY "IX_OPTIONS" UPON ENVIRONMENT-NAME. - ACCEPT ENVVAR-IN FROM ENVIRONMENT-VALUE. - IF ENVVAR-IN NOT = SPACES - STRING ENVVAR-IN DELIMITED BY SPACE - ",keycheck=off" INTO ENVVAR-OUT - DISPLAY "IX_OPTIONS" UPON ENVIRONMENT-NAME - DISPLAY ENVVAR-OUT UPON ENVIRONMENT-VALUE - * DISPLAY "IX_OPTIONS = '" ENVVAR-OUT "'" UPON CONSOLE - ELSE - DISPLAY "IX_OPTIONS" UPON ENVIRONMENT-NAME - DISPLAY "keycheck=off" UPON ENVIRONMENT-VALUE - END-IF - DISPLAY "IO_TESTISAM" UPON ENVIRONMENT-NAME. - ACCEPT ENVVAR-IN FROM ENVIRONMENT-VALUE. - IF ENVVAR-IN NOT = SPACES - STRING ENVVAR-IN DELIMITED BY SPACE - ",keycheck=off" INTO ENVVAR-OUT - DISPLAY "IO_TESTISAM" UPON ENVIRONMENT-NAME - DISPLAY ENVVAR-OUT UPON ENVIRONMENT-VALUE - DISPLAY "IO_TESTISAM = '" ENVVAR-OUT "'" UPON CONSOLE - END-IF - OPEN INPUT BADFILE - IF CUST-STAT NOT = "00" - DISPLAY "C: Un-Expected ERROR " CUST-STAT - " opening BADFILE, Index mismatch" - UPON CONSOLE - ELSE - DISPLAY "C: Expected open BADFILE, with Index mismatch" - UPON CONSOLE - MOVE SPACES TO BAD-RECORD - START BADFILE KEY GREATER THAN BAD-KEY2 - READ BADFILE NEXT RECORD WITH NO LOCK - DISPLAY "Key: " BD-CUST-NUM " is " BD-DISK " : " BD-TAPE - READ BADFILE NEXT RECORD WITH NO LOCK - DISPLAY "Key: " BD-CUST-NUM " is " BD-DISK " : " BD-TAPE - READ BADFILE NEXT RECORD WITH NO LOCK - DISPLAY "Key: " BD-CUST-NUM " is " BD-DISK " : " BD-TAPE - CLOSE BADFILE - END-IF. - STOP RUN. - - LOADFILE. - DISPLAY "Loading sample data file." - UPON CONSOLE. - - OPEN OUTPUT TSPFILE - IF CUST-STAT NOT = "00" - AND CUST-STAT NOT = "05" - DIVIDE STAT-1 BY 256 GIVING BYTE-1 REMAINDER BYTE-2 - DISPLAY "Error " CUST-STAT " " BYTE-1 " " BYTE-2 - " opening 'testisam' file" - UPON CONSOLE - STOP RUN - END-IF. - - PERFORM 1000-LOAD-RECORD - VARYING SUB FROM 1 BY 1 - UNTIL SUB > MAX-SUB. - - DISPLAY "Sample data file load complete." - UPON CONSOLE. - CLOSE TSPFILE. - - REWRFILE. - DELETE FILE TSPFILE. - DISPLAY "Rewrite sample data file: " CUST-STAT - UPON CONSOLE. - - OPEN I-O TSPFILE - IF CUST-STAT NOT = "00" - AND CUST-STAT NOT = "05" - DIVIDE STAT-1 BY 256 GIVING BYTE-1 REMAINDER BYTE-2 - DISPLAY "Error " CUST-STAT " " BYTE-1 " " BYTE-2 - " opening 'testisam' file" - UPON CONSOLE - STOP RUN - END-IF. - - MOVE 'N' TO DO-REWRITE. - PERFORM 1000-LOAD-RECORD - VARYING SUB FROM 1 BY 1 - UNTIL SUB > MAX-SUB. - MOVE 'Y' TO DO-REWRITE. - PERFORM 1000-LOAD-RECORD - VARYING SUB FROM 1 BY 2 - UNTIL SUB > MAX-SUB. - MOVE 'N' TO DO-REWRITE. - - DISPLAY "Sample data file rewrite complete." - UPON CONSOLE. - CLOSE TSPFILE. - - *---------------------------------------------------------------* - * LOAD A RECORD FROM DATA TABLES * - *---------------------------------------------------------------* - - 1000-LOAD-RECORD. - - MOVE SPACES TO TSPFL-RECORD. - MOVE DATA-CUST-NUM (SUB) TO CM-CUST-NUM. - MOVE CM-CUST-NUM TO TSPFL-KEY. - IF DO-REWRITE = 'Y' - READ TSPFILE WITH LOCK - MOVE DATA-CUST-NUM (SUB) TO CM-CUST-NUM - MOVE CM-CUST-NUM TO TSPFL-KEY - END-IF - MOVE DATA-COMPANY (SUB) TO CM-COMPANY. - MOVE DATA-ADDRESS-1 (SUB) TO CM-ADDRESS-1. - MOVE DATA-ADDRESS-2 (SUB) TO CM-ADDRESS-2. - MOVE DATA-ADDRESS-3 (SUB) TO CM-ADDRESS-3. - MOVE DATA-TELEPHONE (SUB) TO CM-TELEPHONE. - MOVE DATA-DP-MGR (SUB) TO CM-DP-MGR. - MOVE DATA-MACHINE (SUB) TO CM-MACHINE. - MOVE DATA-NO-TERMINALS (SUB) TO CM-NO-TERMINALS. - - IF ODD-RECORD - MOVE "8417" TO CM-DISK - MOVE "1600 BPI" TO CM-TAPE - MOVE "1MEG" TO CM-MEMORY - ELSE - MOVE "8470" TO CM-DISK - MOVE "6250 BPI" TO CM-TAPE - MOVE "3MEG" TO CM-MEMORY. - IF NULL-KEY - MOVE ALL "*" TO CM-DISK - MOVE ALL "*" TO CM-TAPE. - IF SUB = 1 OR 6 - MOVE "2417" TO CM-DISK - MOVE "549 mmm" TO CM-TAPE. - - IF DO-REWRITE = 'Y' - IF SUB NOT = 1 AND SUB NOT = 6 - MOVE "REWRITE" TO CM-DISK - END-IF - REWRITE TSPFL-RECORD - IF CUST-STAT NOT = "00" - AND CUST-STAT NOT = "02" - DISPLAY "REWRITE: " TSPFL-KEY ", Status: " - CUST-STAT UPON CONSOLE - END-IF - ELSE - WRITE TSPFL-RECORD - IF CUST-STAT NOT = "00" - AND CUST-STAT NOT = "02" - DISPLAY "WRITE: " TSPFL-KEY ", Status: " - CUST-STAT UPON CONSOLE - END-IF - END-IF. - - LISTFILE. - DISPLAY "LIST SAMPLE FILE" UPON CONSOLE. - MOVE ZERO TO REC-NUM - OPEN INPUT TSPFILE - IF CUST-STAT NOT = "00" - DISPLAY "ERROR " CUST-STAT " OPENING INPUT FILE" - UPON CONSOLE - IF CUST-STAT (1:1) = "9" - DISPLAY "Sub Error " STAT-X2 UPON CONSOLE - END-IF - STOP RUN - END-IF. - MOVE SPACES TO TSPFL-RECORD. - START TSPFILE KEY GREATER THAN PRIME-KEY - WITH SIZE 8 - START TSPFILE KEY GREATER THAN PRIME-KEY - WITH LENGTH 8 - START TSPFILE KEY GREATER THAN PRIME-KEY - WITH SIZE 8 - START TSPFILE KEY GREATER THAN PRIME-KEY - WITH LENGTH 8 - START TSPFILE KEY GREATER THAN PRIME-KEY - IF CUST-STAT NOT = "00" - DISPLAY "Error " CUST-STAT " starting file" - UPON CONSOLE - IF CUST-STAT (1:1) = "9" - DISPLAY "Sub Error " STAT-X2 UPON CONSOLE - END-IF - STOP RUN - END-IF. - READ TSPFILE NEXT RECORD WITH NO LOCK - IF CUST-STAT NOT = "00" - DISPLAY "Error " CUST-STAT " on 1st read of file" - UPON CONSOLE - IF CUST-STAT (1:1) = "9" - DISPLAY "Sub Error " STAT-X2 UPON CONSOLE - END-IF - STOP RUN - END-IF. - PERFORM UNTIL CUST-STAT NOT = "00" - OR REC-NUM > REC-MAX - DISPLAY "Key: " CM-CUST-NUM " is " CM-COMPANY - " Disk=" CM-DISK "." - UPON CONSOLE - READ TSPFILE NEXT RECORD - AT END - MOVE "99" TO CUST-STAT - END-READ - ADD 1 TO REC-NUM - END-PERFORM - IF CUST-STAT = "99" - DISPLAY "Hit End of File" UPON CONSOLE - END-IF. - - DISPLAY "LIST SAMPLE FILE DESCENDING" UPON CONSOLE. - MOVE ZERO TO REC-NUM - START TSPFILE KEY LESS THAN PRIME-KEY - IF CUST-STAT NOT = "00" - DISPLAY "Error " CUST-STAT " starting file" - UPON CONSOLE - STOP RUN - END-IF. - READ TSPFILE PREVIOUS RECORD WITH NO LOCK - IF CUST-STAT NOT = "00" - DISPLAY "Error " CUST-STAT " on 1st read of file" - UPON CONSOLE - STOP RUN - END-IF. - PERFORM UNTIL CUST-STAT NOT = "00" - OR REC-NUM > REC-MAX - DISPLAY "Key: " CM-CUST-NUM " is " CM-COMPANY - " Disk=" CM-DISK "." - UPON CONSOLE - READ TSPFILE PREVIOUS RECORD - AT END - MOVE "99" TO CUST-STAT - END-READ - ADD 1 TO REC-NUM - END-PERFORM. - - DISPLAY "LIST SAMPLE FILE BY KEY3" UPON CONSOLE. - MOVE ZERO TO REC-NUM - MOVE SPACES TO TSPFL-RECORD. - START TSPFILE KEY GREATER THAN OR EQUAL TO SPLIT-KEY3 - IF CUST-STAT NOT = "00" - AND CUST-STAT NOT = "02" - DISPLAY "Error " CUST-STAT " starting file" - UPON CONSOLE - STOP RUN - END-IF. - READ TSPFILE NEXT RECORD WITH NO LOCK - IF CUST-STAT NOT = "00" - AND CUST-STAT NOT = "02" - DISPLAY "Error " CUST-STAT " on 1st read of file" - UPON CONSOLE - STOP RUN - END-IF. - PERFORM UNTIL (CUST-STAT NOT = "00" - AND CUST-STAT NOT = "02") - OR REC-NUM > REC-MAX - DISPLAY "Key: " CM-CUST-NUM " is " CM-COMPANY - " Disk=" CM-DISK "." - UPON CONSOLE - READ TSPFILE NEXT RECORD - AT END - MOVE "99" TO CUST-STAT - END-READ - ADD 1 TO REC-NUM - END-PERFORM. - CLOSE TSPFILE. - - OPEN I-O TSPFILE. - MOVE SPACES TO TSPFL-RECORD. - MOVE DATA-CUST-NUM (2) TO CM-CUST-NUM. - READ TSPFILE KEY IS PRIME-KEY - IF CUST-STAT NOT = "23" - DISPLAY "Error " CUST-STAT " instead of 23" - UPON CONSOLE - END-IF. - MOVE DATA-COMPANY (2) TO CM-COMPANY. - READ TSPFILE KEY IS PRIME-KEY - IF CUST-STAT NOT = "00" - DISPLAY "Error " CUST-STAT " on primary read" - UPON CONSOLE - ELSE - DISPLAY "Got: " CM-CUST-NUM " is " CM-COMPANY - " Disk=" CM-DISK "." - UPON CONSOLE - END-IF. - READ TSPFILE NEXT RECORD - IF CUST-STAT NOT = "00" - DISPLAY "Error " CUST-STAT " on next read" - UPON CONSOLE - ELSE - DISPLAY "Nxt: " CM-CUST-NUM " is " CM-COMPANY - " Disk=" CM-DISK "." - UPON CONSOLE - END-IF. - MOVE DATA-TELEPHONE (7) TO CM-TELEPHONE. - MOVE DATA-MACHINE (7) TO CM-MACHINE. - READ TSPFILE KEY IS SPLIT-KEY2 - IF CUST-STAT NOT = "00" - DISPLAY "Error " CUST-STAT " instead of 23" - UPON CONSOLE - ELSE - DISPLAY "Ky2: " CM-CUST-NUM " is " CM-COMPANY - " Mach=" CM-MACHINE - UPON CONSOLE - END-IF. - WRITE TSPFL-RECORD - IF CUST-STAT NOT = "22" - DISPLAY "Error " CUST-STAT " instead of 22" - UPON CONSOLE - ELSE - DISPLAY " Write: " CM-CUST-NUM " got 22 as expected" - UPON CONSOLE - END-IF. - MOVE DATA-CUST-NUM (3) TO CM-CUST-NUM. - MOVE DATA-COMPANY (3) TO CM-COMPANY. - READ TSPFILE KEY IS PRIME-KEY - DISPLAY " Read: " CM-CUST-NUM " got " - CUST-STAT " as expected " - CM-NO-TERMINALS " terminals" - UPON CONSOLE. - ADD 5 TO CM-NO-TERMINALS - REWRITE TSPFL-RECORD - IF CUST-STAT NOT = "02" - AND CUST-STAT NOT = "00" - DISPLAY "Error " CUST-STAT " instead of 02" - UPON CONSOLE - ELSE - DISPLAY "ReWrite: " CM-CUST-NUM " got 00/02" - " as expected " - CM-NO-TERMINALS " terminals" - UPON CONSOLE - END-IF. - MOVE DATA-CUST-NUM (2) TO CM-CUST-NUM. - MOVE DATA-COMPANY (2) TO CM-COMPANY. - READ TSPFILE KEY IS PRIME-KEY - DISPLAY " Read: " CM-CUST-NUM " got " - CUST-STAT " as expected " - CM-NO-TERMINALS " terminals" - UPON CONSOLE. - MOVE DATA-CUST-NUM (3) TO CM-CUST-NUM. - MOVE DATA-COMPANY (3) TO CM-COMPANY. - REWRITE TSPFL-RECORD - IF CUST-STAT NOT = "02" - AND CUST-STAT NOT = "00" - DISPLAY "Error " CUST-STAT " instead of 02" - UPON CONSOLE - ELSE - DISPLAY "ReWrite: " CM-CUST-NUM " got 00/02" - " as expected" - UPON CONSOLE - END-IF. - MOVE DATA-CUST-NUM (6) TO CM-CUST-NUM. - MOVE DATA-COMPANY (6) TO CM-COMPANY. - READ TSPFILE KEY IS PRIME-KEY - MOVE DATA-TELEPHONE (7) TO CM-TELEPHONE. - MOVE DATA-MACHINE (7) TO CM-MACHINE. - REWRITE TSPFL-RECORD - IF CUST-STAT NOT = "02" - AND CUST-STAT NOT = "00" - DISPLAY "Error " CUST-STAT " instead of 02" - UPON CONSOLE - ELSE - DISPLAY "ReWrite: " CM-CUST-NUM " got 00/02" - " as expected" - UPON CONSOLE - END-IF. - CLOSE TSPFILE. -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) - -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], -[Loading sample data file. -Sample data file load complete. -Loading sample data file. -Sample data file load complete. -Rewrite sample data file: 00 -Sample data file rewrite complete. -LIST SAMPLE FILE -Key: ALP00000 is ALPHA ELECTRICAL CO. LTD. Disk=2417 . -Key: BET00000 is BETA SHOE MFG. INC. Disk=8470 . -Key: DEL00000 is DELTA LUGGAGE REPAIRS Disk=********. -Key: EPS00000 is EPSILON EQUIPMENT SUPPLY Disk=REWRITE . -Key: FOR00000 is FORTUNE COOKIE COMPANY Disk=2417 . -Key: GAM00000 is GAMMA X-RAY TECHNOLOGY Disk=REWRITE . -Key: GIB00000 is GIBRALTER LIFE INSURANCE Disk=REWRITE . -Key: H&J00000 is H & J PLUMBING SUPPLIES Disk=********. -Key: INC00000 is INCREMENTAL BACKUP CORP. Disk=REWRITE . -Key: JOH00000 is JOHNSON BOATING SUPPLIES Disk=8417 . -Key: KON00000 is KONFLAB PLASTIC PRODUCTS. Disk=REWRITE . -LIST SAMPLE FILE DESCENDING -Key: KON00000 is KONFLAB PLASTIC PRODUCTS. Disk=REWRITE . -Key: JOH00000 is JOHNSON BOATING SUPPLIES Disk=8417 . -Key: INC00000 is INCREMENTAL BACKUP CORP. Disk=REWRITE . -Key: H&J00000 is H & J PLUMBING SUPPLIES Disk=********. -Key: GIB00000 is GIBRALTER LIFE INSURANCE Disk=REWRITE . -Key: GAM00000 is GAMMA X-RAY TECHNOLOGY Disk=REWRITE . -Key: FOR00000 is FORTUNE COOKIE COMPANY Disk=2417 . -Key: EPS00000 is EPSILON EQUIPMENT SUPPLY Disk=REWRITE . -Key: DEL00000 is DELTA LUGGAGE REPAIRS Disk=********. -Key: BET00000 is BETA SHOE MFG. INC. Disk=8470 . -Key: ALP00000 is ALPHA ELECTRICAL CO. LTD. Disk=2417 . -LIST SAMPLE FILE BY KEY3 -Key: ALP00000 is ALPHA ELECTRICAL CO. LTD. Disk=2417 . -Key: FOR00000 is FORTUNE COOKIE COMPANY Disk=2417 . -Key: JOH00000 is JOHNSON BOATING SUPPLIES Disk=8417 . -Key: BET00000 is BETA SHOE MFG. INC. Disk=8470 . -Key: PRE00000 is PRESTIGE OFFICE FURNITURE Disk=8470 . -Key: EPS00000 is EPSILON EQUIPMENT SUPPLY Disk=REWRITE . -Key: GAM00000 is GAMMA X-RAY TECHNOLOGY Disk=REWRITE . -Key: GIB00000 is GIBRALTER LIFE INSURANCE Disk=REWRITE . -Key: INC00000 is INCREMENTAL BACKUP CORP. Disk=REWRITE . -Key: KON00000 is KONFLAB PLASTIC PRODUCTS. Disk=REWRITE . -Key: MOR00000 is MORNINGSIDE CARPENTRY. Disk=REWRITE . -Got: BET00000 is BETA SHOE MFG. INC. Disk=8470 . -Nxt: DEL00000 is DELTA LUGGAGE REPAIRS Disk=********. -Ky2: GIB00000 is GIBRALTER LIFE INSURANCE Mach=UNI-80/6 - Write: GIB00000 got 22 as expected - Read: GAM00000 got 00 as expected 00075 terminals -ReWrite: GAM00000 got 00/02 as expected 00080 terminals - Read: BET00000 got 00 as expected 00034 terminals -ReWrite: GAM00000 got 00/02 as expected -ReWrite: FOR00000 got 00/02 as expected -A: Expected ERROR 39 opening TSTFILE, Record size different -B: Expected ERROR 39 opening BADFILE, Index mismatch -C: Expected open BADFILE, with Index mismatch -Key: ALP00000 is 2417 : 549 mmm -Key: FOR00000 is 2417 : 549 mmm -Key: JOH00000 is 8417 : 1600 BPI -], []) - -AT_CLEANUP - - -AT_SETUP([SUPPRESS WHEN string]) -AT_KEYWORDS([FILE-IO]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - - PROGRAM-ID. prog. - - ENVIRONMENT DIVISION. - CONFIGURATION SECTION. - - INPUT-OUTPUT SECTION. - FILE-CONTROL. - SELECT OPTIONAL TSPFILE - ASSIGN TO "testisam" - ORGANIZATION INDEXED ACCESS DYNAMIC - RECORD KEY IS CM-CUST-NUM - - ALTERNATE RECORD KEY IS CM-TELEPHONE - SUPPRESS WHEN "90055569" - - ALTERNATE RECORD KEY IS SPLIT-KEY3 - SOURCE IS CM-DISK,CM-TAPE WITH DUPLICATES - SUPPRESS WHEN "8417" - FILE STATUS IS CUST-STAT - . - - DATA DIVISION. - FILE SECTION. - FD TSPFILE - BLOCK CONTAINS 5 RECORDS. - - 01 TSPFL-RECORD. - 05 TSPFL-REC. - 10 CM-CUST-NUM. - 15 CM-CUST-PRE PICTURE X(3). - 15 CM-CUST-NNN PICTURE X(5). - 10 CM-STATUS PICTURE X. - 10 CM-COMPANY PICTURE X(25). - 10 CM-ADDRESS-1 PICTURE X(25). - 10 CM-ADDRESS-2 PICTURE X(25). - 10 CM-ADDRESS-3 PICTURE X(25). - 10 CM-TELEPHONE PICTURE 9(10). - 10 CM-DP-MGR PICTURE X(25). - 10 CM-MACHINE PICTURE X(8). - 10 CM-MEMORY PICTURE X(4). - 10 CM-DISK PICTURE X(4). - 10 CM-TAPE PICTURE X(8). - - WORKING-STORAGE SECTION. - - 01 CUST-STAT PIC XX. - 77 MAX-SUB VALUE 16 PICTURE 9(5) COMP. - - 01 TEST-DATA. - 02 DATA-CUST-NUM-TBL. - 05 FILLER PIC X(8) VALUE "ALP00000". - 05 FILLER PIC X(8) VALUE "BET00000". - 05 FILLER PIC X(8) VALUE "GAM00000". - 05 FILLER PIC X(8) VALUE "DEL00000". - 05 FILLER PIC X(8) VALUE "EPS00000". - 05 FILLER PIC X(8) VALUE "FOR00000". - 05 FILLER PIC X(8) VALUE "GIB00000". - 05 FILLER PIC X(8) VALUE "H&J00000". - 05 FILLER PIC X(8) VALUE "INC00000". - 05 FILLER PIC X(8) VALUE "JOH00000". - 05 FILLER PIC X(8) VALUE "KON00000". - 05 FILLER PIC X(8) VALUE "LEW00000". - 05 FILLER PIC X(8) VALUE "MOR00000". - 05 FILLER PIC X(8) VALUE "NEW00000". - 05 FILLER PIC X(8) VALUE "OLD00000". - 05 FILLER PIC X(8) VALUE "PRE00000". - - 02 DATA-CUST-NUM REDEFINES DATA-CUST-NUM-TBL - PIC X(8) OCCURS 16. - 02 DATA-COMPANY-TBL. - 05 FILLER PIC X(25) VALUE "ALPHA ELECTRICAL CO. LTD.". - 05 FILLER PIC X(25) VALUE "BETA SHOE MFG. INC. ". - 05 FILLER PIC X(25) VALUE "GAMMA X-RAY TECHNOLOGY ". - 05 FILLER PIC X(25) VALUE "DELTA LUGGAGE REPAIRS ". - 05 FILLER PIC X(25) VALUE "EPSILON EQUIPMENT SUPPLY ". - 05 FILLER PIC X(25) VALUE "FORTUNE COOKIE COMPANY ". - 05 FILLER PIC X(25) VALUE "GIBRALTER LIFE INSURANCE ". - 05 FILLER PIC X(25) VALUE "H & J PLUMBING SUPPLIES ". - 05 FILLER PIC X(25) VALUE "INCREMENTAL BACKUP CORP. ". - 05 FILLER PIC X(25) VALUE "JOHNSON BOATING SUPPLIES ". - 05 FILLER PIC X(25) VALUE "KONFLAB PLASTIC PRODUCTS.". - 05 FILLER PIC X(25) VALUE "LEWISTON GRAPHICS LTD. ". - 05 FILLER PIC X(25) VALUE "MORNINGSIDE CARPENTRY. ". - 05 FILLER PIC X(25) VALUE "NEW WAVE SURF SHOPS INC. ". - 05 FILLER PIC X(25) VALUE "OLD TYME PIZZA MFG. CO. ". - 05 FILLER PIC X(25) VALUE "PRESTIGE OFFICE FURNITURE". - - 02 DATA-COMPANY REDEFINES DATA-COMPANY-TBL - PIC X(25) OCCURS 16. - 02 DATA-ADDRESS-1-TBL. - 05 FILLER PIC X(25) VALUE "123 MAIN STREET ". - 05 FILLER PIC X(25) VALUE "1090 2ND AVE. WEST ". - 05 FILLER PIC X(25) VALUE "1401 JEFFERSON BLVD. ". - 05 FILLER PIC X(25) VALUE "1620 ARIZONA WAY ". - 05 FILLER PIC X(25) VALUE "1184 EAST FIRST STREET ". - 05 FILLER PIC X(25) VALUE "114 JOHN F. KENNEDY AVE. ". - 05 FILLER PIC X(25) VALUE "650 LIBERTY CRESCENT ". - 05 FILLER PIC X(25) VALUE "77 SUNSET BLVD. ". - 05 FILLER PIC X(25) VALUE "10908 SANTA MONICA BLVD. ". - 05 FILLER PIC X(25) VALUE "1134 PARIS ROAD ". - 05 FILLER PIC X(25) VALUE "808 NORTHWEST MAIN ST. ". - 05 FILLER PIC X(25) VALUE "9904 QUEEN STREET ". - 05 FILLER PIC X(25) VALUE "1709 DUNDAS CRESCENT W. ". - 05 FILLER PIC X(25) VALUE "3240 MARIS AVENUE ". - 05 FILLER PIC X(25) VALUE "1705 WISCONSIN ROAD ". - 05 FILLER PIC X(25) VALUE "114A MAPLE GROVE ". - - 02 DATA-ADDRESS-1 REDEFINES DATA-ADDRESS-1-TBL - PIC X(25) OCCURS 16. - 02 DATA-ADDRESS-2-TBL. - 05 FILLER PIC X(10) VALUE "NEW YORK ". - 05 FILLER PIC X(10) VALUE "ATLANTA ". - 05 FILLER PIC X(10) VALUE "WASHINGTON". - 05 FILLER PIC X(10) VALUE "TORONTO ". - 05 FILLER PIC X(10) VALUE "CALGARY ". - 05 FILLER PIC X(10) VALUE "SAN DIEGO ". - 05 FILLER PIC X(10) VALUE "LOS RIOS ". - 05 FILLER PIC X(10) VALUE "MADISON ". - 05 FILLER PIC X(10) VALUE "WILBUR ". - 05 FILLER PIC X(10) VALUE "TOPEKA ". - 05 FILLER PIC X(10) VALUE "SEATTLE ". - 05 FILLER PIC X(10) VALUE "NEW JERSEY". - 05 FILLER PIC X(10) VALUE "FORT WAYNE". - 05 FILLER PIC X(10) VALUE "COLUMBUS ". - 05 FILLER PIC X(10) VALUE "RICHMOND ". - 05 FILLER PIC X(10) VALUE "WHITEPLAIN". - - 02 DATA-ADDRESS-2 REDEFINES DATA-ADDRESS-2-TBL - PIC X(10) OCCURS 16. - 02 DATA-ADDRESS-3-TBL. - 05 FILLER PIC X(10) VALUE "N.Y. ". - 05 FILLER PIC X(10) VALUE "GEORGIA ". - 05 FILLER PIC X(10) VALUE "D.C. ". - 05 FILLER PIC X(10) VALUE "CANADA ". - 05 FILLER PIC X(10) VALUE "CANADA ". - 05 FILLER PIC X(10) VALUE "CALIFORNIA". - 05 FILLER PIC X(10) VALUE "NEW MEXICO". - 05 FILLER PIC X(10) VALUE "WISCONSIN ". - 05 FILLER PIC X(10) VALUE "DELAWARE ". - 05 FILLER PIC X(10) VALUE "KANSAS ". - 05 FILLER PIC X(10) VALUE "WASHINGTON". - 05 FILLER PIC X(10) VALUE "N.J. ". - 05 FILLER PIC X(10) VALUE "COLORADO ". - 05 FILLER PIC X(10) VALUE "OHIO ". - 05 FILLER PIC X(10) VALUE "VIRGINIA ". - 05 FILLER PIC X(10) VALUE "N.Y. ". - - 02 DATA-ADDRESS-3 REDEFINES DATA-ADDRESS-3-TBL - PIC X(10) OCCURS 16. - 02 DATA-TELEPHONE-TBL. - 05 FILLER PIC 9(10) VALUE 3131234432. - 05 FILLER PIC 9(10) VALUE 4082938498. - 05 FILLER PIC 9(10) VALUE 8009329492. - 05 FILLER PIC 9(10) VALUE 7169898509. - 05 FILLER PIC 9(10) VALUE 5292398745. - 05 FILLER PIC 9(10) VALUE 8009329492. - 05 FILLER PIC 9(10) VALUE 6456445643. - 05 FILLER PIC 9(10) VALUE 9005556969. - 05 FILLER PIC 9(10) VALUE 9005556970. - 05 FILLER PIC 9(10) VALUE 6456445649. - 05 FILLER PIC 9(10) VALUE 7456434355. - 05 FILLER PIC 9(10) VALUE 9005556969. - 05 FILLER PIC 9(10) VALUE 4169898507. - 05 FILLER PIC 9(10) VALUE 7534587453. - 05 FILLER PIC 9(10) VALUE 9005556969. - 05 FILLER PIC 9(10) VALUE 4169898509. - - 02 DATA-TELEPHONE REDEFINES DATA-TELEPHONE-TBL - PIC 9(10) OCCURS 16. - 02 DATA-DP-MGR-TBL. - 05 FILLER PIC X(20) VALUE "MR. DAVE HARRIS ". - 05 FILLER PIC X(20) VALUE "MS. JANICE SILCOX ". - 05 FILLER PIC X(20) VALUE "MR. ALLAN JONES ". - 05 FILLER PIC X(20) VALUE "MR. PETER MACKAY ". - 05 FILLER PIC X(20) VALUE "MRS. DONNA BREWER ". - 05 FILLER PIC X(20) VALUE "MR. MICHAEL SMYTHE ". - 05 FILLER PIC X(20) VALUE "MR. D.A. MORRISON ". - 05 FILLER PIC X(20) VALUE "MR. BRIAN PATTERSON ". - 05 FILLER PIC X(20) VALUE "MR. DARRYL TOWNSEND ". - 05 FILLER PIC X(20) VALUE "MS. VALERIE HARPER ". - 05 FILLER PIC X(20) VALUE "MR. FRED MILLER ". - 05 FILLER PIC X(20) VALUE "MR. DONALD FISCHER ". - 05 FILLER PIC X(20) VALUE "MR. STEVEN YOURDIN ". - 05 FILLER PIC X(20) VALUE "MS. Goldie Hawn ". - 05 FILLER PIC X(20) VALUE "MS. ALICE WINSTON ". - 05 FILLER PIC X(20) VALUE "MR. THOMAS JEFFERSON". - - 02 DATA-DP-MGR REDEFINES DATA-DP-MGR-TBL - PIC X(20) OCCURS 16. - 02 DATA-MACHINE-TBL. - 05 FILLER PIC X(8) VALUE "UNI-9030". - 05 FILLER PIC X(8) VALUE "UNI-9040". - 05 FILLER PIC X(8) VALUE "UNI-80/3". - 05 FILLER PIC X(8) VALUE "UNI-80/5". - 05 FILLER PIC X(8) VALUE "UNI-80/6". - 05 FILLER PIC X(8) VALUE "UNI-80/6". - 05 FILLER PIC X(8) VALUE "UNI-80/6". - 05 FILLER PIC X(8) VALUE "UNI-80/8". - 05 FILLER PIC X(8) VALUE "UNI-80/8". - 05 FILLER PIC X(8) VALUE "UNI-80/8". - 05 FILLER PIC X(8) VALUE "UNI-80/8". - 05 FILLER PIC X(8) VALUE "UNI-80/8". - 05 FILLER PIC X(8) VALUE "UNI-80/8". - 05 FILLER PIC X(8) VALUE "UNI-80/8". - 05 FILLER PIC X(8) VALUE "UNI-9040". - 05 FILLER PIC X(8) VALUE "UNI-9040". - - 02 DATA-MACHINE REDEFINES DATA-MACHINE-TBL - PIC X(8) OCCURS 16. - 01 WORK-AREA. - 05 REC-NUM PICTURE 9(2) VALUE 0. - 05 SUB PICTURE 9(4) COMP. - 88 ODD-RECORD VALUE 1 3 5 7 9 10 11. - - 05 TSPFL-KEY PICTURE X(8). - - PROCEDURE DIVISION. - - MAINFILE. - PERFORM LOADFILE. - PERFORM LISTFILE. - STOP RUN. - - LOADFILE. - DISPLAY "Loading sample data file." - UPON CONSOLE. - - OPEN OUTPUT TSPFILE - IF CUST-STAT NOT = "00" - AND CUST-STAT NOT = "05" - DISPLAY "Error " CUST-STAT - " opening 'testisam' file" UPON CONSOLE - STOP RUN - END-IF. - - PERFORM 1000-LOAD-RECORD - VARYING SUB FROM 1 BY 1 - UNTIL SUB > MAX-SUB. - - DISPLAY "Sample data file load complete." - UPON CONSOLE. - CLOSE TSPFILE. - - *---------------------------------------------------------------* - * LOAD A RECORD FROM DATA TABLES * - *---------------------------------------------------------------* - - 1000-LOAD-RECORD. - MOVE SPACES TO TSPFL-RECORD. - MOVE DATA-CUST-NUM (SUB) TO CM-CUST-NUM. - MOVE CM-CUST-NUM TO TSPFL-KEY. - MOVE DATA-COMPANY (SUB) TO CM-COMPANY. - MOVE DATA-ADDRESS-1 (SUB) TO CM-ADDRESS-1. - MOVE DATA-ADDRESS-2 (SUB) TO CM-ADDRESS-2. - MOVE DATA-ADDRESS-3 (SUB) TO CM-ADDRESS-3. - MOVE DATA-TELEPHONE (SUB) TO CM-TELEPHONE. - MOVE DATA-DP-MGR (SUB) TO CM-DP-MGR. - MOVE DATA-MACHINE (SUB) TO CM-MACHINE. - - IF ODD-RECORD - MOVE "8417" TO CM-DISK - MOVE "1600 BPI" TO CM-TAPE - MOVE "1MEG" TO CM-MEMORY - ELSE - MOVE "8470" TO CM-DISK - MOVE "6250 BPI" TO CM-TAPE - MOVE "3MEG" TO CM-MEMORY - END-IF. - IF SUB = 1 OR 6 OR 12 - MOVE "2417" TO CM-DISK - MOVE "549 mmm" TO CM-TAPE - END-IF. - IF SUB = 6 - MOVE "749 mmm" TO CM-TAPE - END-IF. - - WRITE TSPFL-RECORD - IF CUST-STAT = "22" - DISPLAY "WRITE: " TSPFL-KEY ", Duplicate Status: " - CUST-STAT " Phone=" CM-TELEPHONE "." - UPON CONSOLE - ELSE - IF CUST-STAT NOT = "00" - AND CUST-STAT NOT = "02" - DISPLAY "WRITE: " TSPFL-KEY ", Status: " - CUST-STAT UPON CONSOLE - END-IF. - - LISTFILE. - DISPLAY "LIST SAMPLE FILE" UPON CONSOLE. - MOVE ZERO TO REC-NUM - OPEN INPUT TSPFILE - IF CUST-STAT NOT = "00" - DISPLAY "ERROR " CUST-STAT " OPENING INPUT FILE" - UPON CONSOLE - STOP RUN - END-IF. - MOVE SPACES TO TSPFL-RECORD. - START TSPFILE KEY GREATER THAN CM-CUST-NUM - IF CUST-STAT NOT = "00" - DISPLAY "Error " CUST-STAT " starting file" - UPON CONSOLE - STOP RUN - END-IF. - READ TSPFILE NEXT RECORD WITH NO LOCK - IF CUST-STAT NOT = "00" - DISPLAY "Error " CUST-STAT " on 1st read of file" - UPON CONSOLE - STOP RUN - END-IF. - PERFORM UNTIL CUST-STAT NOT = "00" - DISPLAY "Key: " CM-CUST-NUM " is " CM-COMPANY - " Disk=" CM-DISK - " Phone=" CM-TELEPHONE "." - UPON CONSOLE - READ TSPFILE NEXT RECORD - AT END - MOVE "99" TO CUST-STAT - END-READ - ADD 1 TO REC-NUM - END-PERFORM - IF CUST-STAT = "99" - DISPLAY "Hit End of File after " REC-NUM UPON CONSOLE - END-IF. - - MOVE ZERO TO REC-NUM - OPEN INPUT TSPFILE - DISPLAY "LIST SAMPLE FILE BY KEY2" UPON CONSOLE. - MOVE ZERO TO REC-NUM - MOVE SPACES TO TSPFL-RECORD. - START TSPFILE KEY GREATER THAN OR EQUAL TO CM-TELEPHONE - IF CUST-STAT NOT = "00" - AND CUST-STAT NOT = "02" - DISPLAY "Error " CUST-STAT " starting file" - UPON CONSOLE - STOP RUN - END-IF. - READ TSPFILE NEXT RECORD - IF CUST-STAT NOT = "00" - AND CUST-STAT NOT = "02" - DISPLAY "Error " CUST-STAT " on 1st read of file" - UPON CONSOLE - STOP RUN - END-IF. - PERFORM UNTIL (CUST-STAT NOT = "00" - AND CUST-STAT NOT = "02") - DISPLAY "Key: " CM-CUST-NUM " is " CM-COMPANY - " Phone=" CM-TELEPHONE "." - UPON CONSOLE - READ TSPFILE NEXT RECORD - AT END - MOVE "99" TO CUST-STAT - END-READ - ADD 1 TO REC-NUM - END-PERFORM. - IF CUST-STAT = "99" - DISPLAY "Hit End of File after " REC-NUM UPON CONSOLE - END-IF. - CLOSE TSPFILE. - MOVE ZERO TO REC-NUM - OPEN INPUT TSPFILE - DISPLAY "LIST SAMPLE FILE BY KEY3" UPON CONSOLE. - MOVE ZERO TO REC-NUM - MOVE SPACES TO TSPFL-RECORD. - START TSPFILE KEY GREATER THAN OR EQUAL TO SPLIT-KEY3 - IF CUST-STAT NOT = "00" - AND CUST-STAT NOT = "02" - DISPLAY "Error " CUST-STAT " starting file" - UPON CONSOLE - STOP RUN - END-IF. - READ TSPFILE NEXT RECORD - IF CUST-STAT NOT = "00" - AND CUST-STAT NOT = "02" - DISPLAY "Error " CUST-STAT " on 1st read of file" - UPON CONSOLE - STOP RUN - END-IF. - PERFORM UNTIL (CUST-STAT NOT = "00" - AND CUST-STAT NOT = "02") - DISPLAY "Key: " CM-CUST-NUM " is " CM-COMPANY - " Disk=" CM-DISK - " Tape=" CM-TAPE "." - UPON CONSOLE - READ TSPFILE NEXT RECORD - AT END - MOVE "99" TO CUST-STAT - END-READ - ADD 1 TO REC-NUM - END-PERFORM. - IF CUST-STAT = "99" - DISPLAY "Hit End of File after " REC-NUM UPON CONSOLE - END-IF. - CLOSE TSPFILE. -]) - -# FIXME: the syntax check part should be in syn_file.at, allowing to -# skip this test early and remove -Wno-unsupported. -AT_CHECK([$COMPILE -Wno-unsupported prog.cob], [0], [], []) - -AT_SKIP_IF([test "$COB_HAS_ISAM" = "no"]) - -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [Loading sample data file. -WRITE: FOR00000, Duplicate Status: 22 Phone=8009329492. -Sample data file load complete. -LIST SAMPLE FILE -Key: ALP00000 is ALPHA ELECTRICAL CO. LTD. Disk=2417 Phone=3131234432. -Key: BET00000 is BETA SHOE MFG. INC. Disk=8470 Phone=4082938498. -Key: DEL00000 is DELTA LUGGAGE REPAIRS Disk=8470 Phone=7169898509. -Key: EPS00000 is EPSILON EQUIPMENT SUPPLY Disk=8417 Phone=5292398745. -Key: GAM00000 is GAMMA X-RAY TECHNOLOGY Disk=8417 Phone=8009329492. -Key: GIB00000 is GIBRALTER LIFE INSURANCE Disk=8417 Phone=6456445643. -Key: H&J00000 is H & J PLUMBING SUPPLIES Disk=8470 Phone=9005556969. -Key: INC00000 is INCREMENTAL BACKUP CORP. Disk=8417 Phone=9005556970. -Key: JOH00000 is JOHNSON BOATING SUPPLIES Disk=8417 Phone=6456445649. -Key: KON00000 is KONFLAB PLASTIC PRODUCTS. Disk=8417 Phone=7456434355. -Key: LEW00000 is LEWISTON GRAPHICS LTD. Disk=2417 Phone=9005556969. -Key: MOR00000 is MORNINGSIDE CARPENTRY. Disk=8470 Phone=4169898507. -Key: NEW00000 is NEW WAVE SURF SHOPS INC. Disk=8470 Phone=7534587453. -Key: OLD00000 is OLD TYME PIZZA MFG. CO. Disk=8470 Phone=9005556969. -Key: PRE00000 is PRESTIGE OFFICE FURNITURE Disk=8470 Phone=4169898509. -Hit End of File after 15 -LIST SAMPLE FILE BY KEY2 -Key: ALP00000 is ALPHA ELECTRICAL CO. LTD. Phone=3131234432. -Key: BET00000 is BETA SHOE MFG. INC. Phone=4082938498. -Key: MOR00000 is MORNINGSIDE CARPENTRY. Phone=4169898507. -Key: PRE00000 is PRESTIGE OFFICE FURNITURE Phone=4169898509. -Key: EPS00000 is EPSILON EQUIPMENT SUPPLY Phone=5292398745. -Key: GIB00000 is GIBRALTER LIFE INSURANCE Phone=6456445643. -Key: JOH00000 is JOHNSON BOATING SUPPLIES Phone=6456445649. -Key: DEL00000 is DELTA LUGGAGE REPAIRS Phone=7169898509. -Key: KON00000 is KONFLAB PLASTIC PRODUCTS. Phone=7456434355. -Key: NEW00000 is NEW WAVE SURF SHOPS INC. Phone=7534587453. -Key: GAM00000 is GAMMA X-RAY TECHNOLOGY Phone=8009329492. -Hit End of File after 11 -LIST SAMPLE FILE BY KEY3 -Key: ALP00000 is ALPHA ELECTRICAL CO. LTD. Disk=2417 Tape=549 mmm. -Key: LEW00000 is LEWISTON GRAPHICS LTD. Disk=2417 Tape=549 mmm. -Key: BET00000 is BETA SHOE MFG. INC. Disk=8470 Tape=6250 BPI. -Key: DEL00000 is DELTA LUGGAGE REPAIRS Disk=8470 Tape=6250 BPI. -Key: H&J00000 is H & J PLUMBING SUPPLIES Disk=8470 Tape=6250 BPI. -Key: MOR00000 is MORNINGSIDE CARPENTRY. Disk=8470 Tape=6250 BPI. -Key: NEW00000 is NEW WAVE SURF SHOPS INC. Disk=8470 Tape=6250 BPI. -Key: OLD00000 is OLD TYME PIZZA MFG. CO. Disk=8470 Tape=6250 BPI. -Key: PRE00000 is PRESTIGE OFFICE FURNITURE Disk=8470 Tape=6250 BPI. -Hit End of File after 09 -], []) - -AT_CLEANUP - - -AT_SETUP([INDEXED File Sparse/Split keys]) -AT_KEYWORDS([runfile]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - INPUT-OUTPUT SECTION. - FILE-CONTROL. - SELECT file1 ORGANIZATION SEQUENTIAL - ASSIGN "./file1". - SELECT file2 ORGANIZATION SEQUENTIAL - ASSIGN "./file2". - SELECT file3 ASSIGN DISK. - DATA DIVISION. - FILE SECTION. - FD file1 RECORD VARYING FROM 3 TO 12 DEPENDING rsz. - 1 file1-rec pic x(12). - FD file2 RECORD VARYING FROM 3 TO 12 DEPENDING rsz. - 1 file2-rec pic x(12). - SD file3 RECORD VARYING FROM 3 TO 12 DEPENDING rsz. - 1 file3-rec. - 2 file3-key1 pic x. - 2 file3-key2 pic 9. - 2 filler pic x(10). - WORKING-STORAGE SECTION. - 77 rsz pic 99. - 1 1-data. - 2 filler pic x(14) VALUE "03A4X". - 2 filler pic x(14) VALUE "04A3XX". - 2 filler pic x(14) VALUE "05A2XXX". - 2 filler pic x(14) VALUE "06A1XXXX". - 2 filler pic x(14) VALUE "07A0XXXXX". - 2 filler pic x(14) VALUE "08B2XXXXXX". - 2 filler pic x(14) VALUE "09B1XXXXXXX". - 2 filler pic x(14) VALUE "10C2XXXXXXXX". - 2 filler pic x(14) VALUE "11C1XXXXXXXXX". - 2 filler pic x(14) VALUE "12Z9XXXXXXXXXX". - * - 1 filler redefines 1-data. - 2 filler occurs 10 times indexed by ix-1. - 3 1-rsz pic 99. - 3 1-rec pic x(12). - - PROCEDURE DIVISION. - OPEN OUTPUT file1. - PERFORM VARYING ix-1 FROM 1 BY 2 UNTIL ix-1 > 10 - MOVE 1-rsz(ix-1) TO rsz - MOVE 1-rec(ix-1) TO file1-rec - WRITE file1-rec - END-PERFORM. - PERFORM VARYING ix-1 FROM 2 BY 2 UNTIL ix-1 > 10 - MOVE 1-rsz(ix-1) TO rsz - MOVE 1-rec(ix-1) TO file1-rec - WRITE file1-rec - END-PERFORM. - CLOSE file1. - SORT file3 ON ASCENDING file3-key1 - DESCENDING file3-key2 - USING file1 - GIVING file2. - OPEN INPUT file2. - PERFORM VARYING ix-1 FROM 1 BY 1 UNTIL ix-1 > 10 - READ file2 - *>> fileio-sort currently returns constant length records - MOVE 1-rsz(ix-1) TO rsz - *>> END-OF-DETOUR - IF (1-rsz(ix-1) <> rsz) or - (1-rec(ix-1) <> file2-rec) - DISPLAY "FAILED" - END-IF - END-PERFORM. - CLOSE file2. - STOP RUN. -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) - -AT_SKIP_IF([test "$COB_HAS_ISAM" = "no"]) - -AT_CHECK([$COBCRUN_DIRECT ./prog], [0]) - -AT_CLEANUP - - -AT_SETUP([File SORT, LINE SEQUENTIAL]) -AT_KEYWORDS([runfile using giving]) - -# Note: We shouldn't use AT_DATA to create sequential record -# data, because AT_DATA needs a \n at the end - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - INPUT-OUTPUT SECTION. - FILE-CONTROL. - SELECT SORT-IN ASSIGN "test.txt" - ORGANISATION LINE SEQUENTIAL. - SELECT SORT-OUT ASSIGN "result.txt" - ORGANISATION LINE SEQUENTIAL. - SELECT SORT-WRK ASSIGN "SORT-WRK". - DATA DIVISION. - FILE SECTION. - FD SORT-IN. - 01 IN-REC PIC X(20). - FD SORT-OUT. - 01 OUT-REC PIC X(20). - SD SORT-WRK. - 01 WRK-REC PIC X(6). - PROCEDURE DIVISION. - - * Special case: write test data in COBOL, see note above - OPEN OUTPUT SORT-IN. - WRITE IN-REC FROM SPACES END-WRITE. - WRITE IN-REC FROM SPACES END-WRITE. - WRITE IN-REC FROM "world " END-WRITE. - WRITE IN-REC FROM SPACES END-WRITE. - WRITE IN-REC FROM "hello " END-WRITE. - WRITE IN-REC FROM SPACES END-WRITE. - WRITE IN-REC FROM SPACES END-WRITE. - CLOSE SORT-IN. - - SORT SORT-WRK - ASCENDING KEY WRK-REC - USING SORT-IN - GIVING SORT-OUT. - STOP RUN. -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [], []) -AT_CHECK([cat result.txt], [0], [ - - - - -hello -world -], []) - -AT_CLEANUP - - -AT_SETUP([File SORT, LINE SEQUENTIAL same file]) -AT_KEYWORDS([runfile using giving]) - -AT_DATA([test.txt], [ -bla -world -hello - -blubb -]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - INPUT-OUTPUT SECTION. - FILE-CONTROL. - SELECT SORT-IN ASSIGN "test.txt" - ORGANISATION LINE SEQUENTIAL. - SELECT SORT-WRK ASSIGN "dummy". - DATA DIVISION. - FILE SECTION. - FD SORT-IN. - 01 IN-REC PIC X(6). - SD SORT-WRK. - 01 sort-entry PIC X(6). - PROCEDURE DIVISION. - SORT SORT-WRK - ASCENDING sort-entry - USING SORT-IN - GIVING SORT-IN. - STOP RUN. -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [], []) -AT_CHECK([cat test.txt], [0], [ - -bla -blubb -hello -world -], []) - -AT_CLEANUP - - -AT_SETUP([File SORT, LINE SEQUENTIAL variable records]) -AT_KEYWORDS([runfile]) - -AT_DATA([file1], -[A1XXXX -A2XXX -A3XX -Z9XXXXXXXXXX -A4X -B1XXXXXXX -B2XXXXXX -A0XXXXX -C1XXXXXXXXX -C2XXXXXXXX -]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - INPUT-OUTPUT SECTION. - FILE-CONTROL. - SELECT file1 ORGANIZATION LINE SEQUENTIAL - ASSIGN "./file1". - SELECT file2 ORGANIZATION LINE SEQUENTIAL - ASSIGN "./file2". - SELECT file3 ASSIGN DISK. - DATA DIVISION. - FILE SECTION. - FD file1. - 1 file1-rec pic x(12). - FD file2. - 1 file2-rec pic x(12). - SD file3. - 1 file3-rec. - 2 file3-key1 pic x. - 2 file3-key2 pic 9. - 2 filler pic x(10). - PROCEDURE DIVISION. - SORT file3 ON ASCENDING file3-key1 - DESCENDING file3-key2 - USING file1 - GIVING file2. - STOP RUN. -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0]) -AT_CHECK([cat file2], [0], -[A4X -A3XX -A2XXX -A1XXXX -A0XXXXX -B2XXXXXX -B1XXXXXXX -C2XXXXXXXX -C1XXXXXXXXX -Z9XXXXXXXXXX -]) - -AT_CLEANUP - - -AT_SETUP([File MERGE, LINE SEQUENTIAL variable records]) -AT_KEYWORDS([runfile]) - -AT_DATA([file1], -[A1XXXX -A2XXX -A3XX -Z9XXXXXXXXXX -A4X -B1XXXXXXX -B2XXXXXX -A0XXXXX -C1XXXXXXXXX -C2XXXXXXXX -]) - -AT_DATA([file2], -[A1**** -A2*** -A3** -Z9********** -A4* -B1******* -B2****** -A0***** -C1********* -C2******** -]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - INPUT-OUTPUT SECTION. - FILE-CONTROL. - SELECT file1 ORGANIZATION LINE SEQUENTIAL - ASSIGN "./file1". - SELECT file2 ORGANIZATION LINE SEQUENTIAL - ASSIGN "./file2". - SELECT file3 ORGANIZATION LINE SEQUENTIAL - ASSIGN "./file3". - SELECT file4 ASSIGN DISK. - DATA DIVISION. - FILE SECTION. - FD file1. - 1 file1-rec pic x(12). - FD file2. - 1 file2-rec pic x(12). - FD file3. - 1 file3-rec pic x(12). - SD file4. - 1 file4-rec. - 2 file4-key1 pic x. - 2 file4-key2 pic 9. - 2 filler pic x(10). - PROCEDURE DIVISION. - MERGE file4 ON ASCENDING file4-key1 - DESCENDING file4-key2 - USING file1 file2 - GIVING file3. - STOP RUN. -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0]) -AT_CHECK([cat file3], [0], -[A4X -A4* -A3XX -A3** -A2XXX -A2*** -A1XXXX -A1**** -A0XXXXX -A0***** -B2XXXXXX -B2****** -B1XXXXXXX -B1******* -C2XXXXXXXX -C2******** -C1XXXXXXXXX -C1********* -Z9XXXXXXXXXX -Z9********** -]) - -AT_CLEANUP - - -AT_SETUP([SORT nonexistent file]) -AT_KEYWORDS([runfile]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - INPUT-OUTPUT SECTION. - FILE-CONTROL. - SELECT SORT-IN ASSIGN "SORT-IN". - SELECT SORT-OUT ASSIGN "SORT-OUT". - SELECT SORT-WRK ASSIGN "SORT-WRK". - DATA DIVISION. - FILE SECTION. - FD SORT-IN. - 01 IN-REC PIC X(100). - FD SORT-OUT. - 01 OUT-REC PIC X(100). - SD SORT-WRK. - 01 WRK-REC PIC X(100). - PROCEDURE DIVISION. - SORT SORT-WRK - ASCENDING KEY WRK-REC - USING SORT-IN - GIVING SORT-OUT. - STOP RUN. -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [], []) -AT_CHECK([cat SORT-OUT], [0], [], []) - -AT_CLEANUP - - -AT_SETUP([SORT with INPUT/OUTPUT PROCEDUREs]) -AT_KEYWORDS([runfile]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - INPUT-OUTPUT SECTION. - FILE-CONTROL. - SELECT file1 ASSIGN DISK. - DATA DIVISION. - FILE SECTION. - SD file1. - 1 file1-rec. - 2 file1-key pic 9(4). - 2 file1-data pic x(10). - WORKING-STORAGE SECTION. - 77 w-eof pic 9 value 0. - 1 1-values. - 2 filler pic x(14) value "0001A--------A". - 2 filler pic x(14) value "0002B--------B". - 2 filler pic x(14) value "0003C--------C". - 2 filler pic x(14) value "0004D--------D". - 2 filler pic x(14) value "0005E--------E". - 2 filler pic x(14) value "0006F--------F". - 2 filler pic x(14) value "0007G--------G". - 2 filler pic x(14) value "0008H--------H". - 2 filler pic x(14) value "0009I--------I". - 2 filler pic x(14) value "0010J--------J". - 2 filler pic x(14) value "0011K--------K". - 2 filler pic x(14) value "0012L--------L". - 2 filler pic x(14) value "0013M--------M". - 2 filler pic x(14) value "0014N--------N". - 2 filler pic x(14) value "0015O--------O". - 2 filler pic x(14) value "0016P--------P". - 2 filler pic x(14) value "0017Q--------Q". - 2 filler pic x(14) value "0018R--------R". - 2 filler pic x(14) value "0019S--------S". - 2 filler pic x(14) value "0020T--------T". - 2 filler pic x(14) value "0021U--------U". - 2 filler pic x(14) value "0022V--------V". - 2 filler pic x(14) value "0023W--------W". - 2 filler pic x(14) value "0024X--------X". - 2 filler pic x(14) value "0025Y--------Y". - 2 filler pic x(14) value "0026Z--------Z". - 1 filler redefines 1-values. - 2 1-record occurs 26 times indexed by ix-1. - 3 1-key pic 9(4). - 3 1-data pic x(10). - PROCEDURE DIVISION. - a01-main. - SORT file1 ON ASCENDING file1-key - INPUT PROCEDURE a02-release-to-sort - OUTPUT PROCEDURE a03-return-from-sort. - STOP RUN. - * - a02-release-to-sort. - PERFORM VARYING ix-1 FROM 1 BY 2 UNTIL ix-1 > 26 - RELEASE file1-rec from 1-record(ix-1) - END-PERFORM. - PERFORM VARYING ix-1 FROM 2 BY 2 UNTIL ix-1 > 26 - RELEASE file1-rec from 1-record(ix-1) - END-PERFORM. - * - a03-return-from-sort. - PERFORM VARYING ix-1 FROM 1 BY 1 - UNTIL (ix-1 > 26) OR (w-eof = 1) - RETURN file1 RECORD - AT END MOVE 1 TO w-eof - END-RETURN - IF (file1-rec <> 1-record(ix-1)) - MOVE 1 TO w-eof - END-IF - END-PERFORM. - IF (w-eof = 1) - DISPLAY "FAILED: unexpected eof" - ELSE - RETURN file1 RECORD - AT END CONTINUE - NOT AT END DISPLAY "FAILED: expected eof" - END-RETURN - END-IF. -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0]) - -AT_CLEANUP - - -AT_SETUP([SORT with key1 ASCENDING, key2 DESCENDING]) -AT_KEYWORDS([runfile]) - -AT_DATA([file1], -[A1 -A2 -A3 -Z9 -A4 -B1 -B2 -A0 -C1 -C2 -]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - INPUT-OUTPUT SECTION. - FILE-CONTROL. - SELECT file1 ORGANIZATION LINE SEQUENTIAL - ASSIGN "./file1". - SELECT file2 ORGANIZATION LINE SEQUENTIAL - ASSIGN "./file2". - SELECT file3 ASSIGN DISK. - DATA DIVISION. - FILE SECTION. - FD file1. - 1 file1-rec pic xxx. - FD file2. - 1 file2-rec pic xxx. - SD file3. - 1 file3-rec. - 2 file3-key1 pic x. - 2 file3-key2 pic 9. - 2 file3-dot pic x. - PROCEDURE DIVISION. - SORT file3 ON ASCENDING file3-key1 - DESCENDING file3-key2 - USING file1 - GIVING file2. - STOP RUN. -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0]) -AT_CHECK([cat file2], [0], -[A4 -A3 -A2 -A1 -A0 -B2 -B1 -C2 -C1 -Z9 -]) - -AT_CLEANUP - - -AT_SETUP([ASSIGN with LOCAL-STORAGE item]) -AT_KEYWORDS([runfile]) - -AT_DATA([test.txt], -[hello -]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - INPUT-OUTPUT SECTION. - FILE-CONTROL. - SELECT test-file ASSIGN path - ORGANIZATION LINE SEQUENTIAL. - DATA DIVISION. - FILE SECTION. - FD test-file. - 01 test-rec PIC X(5). - LOCAL-STORAGE SECTION. - 01 path PIC X(10) VALUE "test.txt". - PROCEDURE DIVISION. - OPEN INPUT test-file - READ test-file END-READ - IF test-rec NOT = "hello" - DISPLAY test-rec END-DISPLAY - END-IF - CLOSE test-file - STOP RUN. -]) - -AT_CHECK([$COMPILE prog.cob]) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [], []) - -AT_CLEANUP - - -AT_SETUP([ASSIGN with LOCAL-STORAGE item and INITIAL prog]) -AT_KEYWORDS([runfile]) - -# Files are initialised in a different location in INITIAL program, hence the -# need for a separate test. - -AT_DATA([test.txt], -[hello -]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog INITIAL. - ENVIRONMENT DIVISION. - INPUT-OUTPUT SECTION. - FILE-CONTROL. - SELECT test-file ASSIGN path - ORGANIZATION LINE SEQUENTIAL. - DATA DIVISION. - FILE SECTION. - FD test-file. - 01 test-rec PIC X(5). - LOCAL-STORAGE SECTION. - 01 path PIC X(10) VALUE "test.txt". - PROCEDURE DIVISION. - OPEN INPUT test-file - READ test-file END-READ - IF test-rec NOT = "hello" - DISPLAY test-rec END-DISPLAY - END-IF - CLOSE test-file - STOP RUN. -]) - -AT_CHECK([$COMPILE prog.cob]) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [], []) - -AT_CLEANUP - - -AT_SETUP([ASSIGN with BASED data item and CHAINING]) -AT_KEYWORDS([runfile status]) - -AT_DATA([TEST-FILE], -[hello -]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - INPUT-OUTPUT SECTION. - FILE-CONTROL. - SELECT test-file ASSIGN path - ORGANIZATION LINE SEQUENTIAL. - DATA DIVISION. - FILE SECTION. - FD test-file. - 01 test-rec PIC X(5). - WORKING-STORAGE SECTION. - 01 path BASED PIC X(10). - 01 x PIC X. - PROCEDURE DIVISION CHAINING x. - IF x NOT = SPACES - ALLOCATE path - MOVE "TEST-FILE" TO path - OPEN INPUT test-file - FREE path - ELSE - OPEN INPUT test-file - END-IF - READ test-file END-READ - IF test-rec NOT = "hello" - DISPLAY test-rec END-DISPLAY - END-IF - CLOSE test-file - STOP RUN. -]) - -AT_DATA([prog2.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog2. - ENVIRONMENT DIVISION. - INPUT-OUTPUT SECTION. - FILE-CONTROL. - SELECT test-file ASSIGN path - ORGANIZATION LINE SEQUENTIAL - FILE STATUS TEST-STAT. - DATA DIVISION. - FILE SECTION. - FD test-file. - 01 test-rec PIC X(5). - WORKING-STORAGE SECTION. - 01 path BASED PIC X(10). - 01 test-stat PIC X(2) VALUE "XX". - PROCEDURE DIVISION. - OPEN INPUT test-file - IF TEST-STAT NOT = '31' - DISPLAY 'BAD OPEN, STATUS "' test-stat '"' END-DISPLAY - END-IF - READ test-file END-READ - IF TEST-STAT NOT = '47' - DISPLAY 'BAD READ, STATUS "' test-stat '"' END-DISPLAY - END-IF - CLOSE test-file - STOP RUN. -]) - -AT_CHECK([$COMPILE prog.cob]) -AT_CHECK([$COBCRUN_DIRECT ./prog X], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [1], [], -[libcob: prog.cob:23: error: inconsistant file name (status = 31) for file test-file ('field with NULL address') on OPEN -]) - -AT_CHECK([$COMPILE prog2.cob]) -AT_CHECK([$COBCRUN_DIRECT ./prog2], [0], [], []) - -AT_CLEANUP - - -AT_SETUP([ASSIGN with data item in LINKAGE]) -AT_KEYWORDS([runfile-CONTROL file status]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - - ENVIRONMENT DIVISION. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 f-path PIC X(80) VALUE "fooasg.txt". - 01 x-path PIC X(80) VALUE "foxasg.txt". - 01 y-path PIC X(80) VALUE "foyasg.txt". - 01 REC1 PIC 9(4) VALUE 1. - 01 REC2 PIC 9(4) VALUE 2. - 01 CUST-STAT PIC X(2) VALUE "XX". - - PROCEDURE DIVISION. - CALL "TSTOPN" USING OMITTED. - CALL "TSTOPN" USING y-path. - CALL "TSTOPEN" USING f-path REC1 CUST-STAT. - CALL "TSTOPEN" USING x-path REC1 CUST-STAT. - CALL "TSTOPEN" USING OMITTED REC1 CUST-STAT. - CALL "TSTOPEN" USING f-path REC2 CUST-STAT. - CALL "TSTOPEN" USING x-path REC2 CUST-STAT. - STOP RUN. - END PROGRAM prog. - - IDENTIFICATION DIVISION. - PROGRAM-ID. TSTOPEN. - - ENVIRONMENT DIVISION. - INPUT-OUTPUT SECTION. - FILE-CONTROL. - SELECT f ASSIGN s-path - ORGANIZATION RELATIVE - ACCESS IS RANDOM - RELATIVE KEY IS REC-NUM - FILE STATUS IS CUST-STAT. - - DATA DIVISION. - FILE SECTION. - FD f. - 01 f-line PIC X(79). - - WORKING-STORAGE SECTION. - 01 z-path PIC X(80) VALUE "foozzz.txt". - - LINKAGE SECTION. - 01 s-path PIC X(80). - 01 REC-NUM PIC 9(4). - 01 CUST-STAT PIC X(2). - - PROCEDURE DIVISION USING s-path, REC-NUM, CUST-STAT. - IF ADDRESS OF s-path = NULL - SET ADDRESS OF s-path TO ADDRESS OF z-path - END-IF. - IF REC-NUM > 1 - OPEN I-O f - DISPLAY "Extend file: " s-path(1:10) - " - " CUST-STAT " #" REC-NUM "." - ELSE - OPEN OUTPUT f - DISPLAY "Output file: " s-path(1:10) - " - " CUST-STAT " #" REC-NUM "." - END-IF. - IF CUST-STAT NOT = "00" - DISPLAY "Opened error: " CUST-STAT "." - GOBACK - END-IF. - MOVE "Hello World" TO f-line. - MOVE REC-NUM TO f-line (20:4). - WRITE f-line. - IF CUST-STAT NOT = "00" - DISPLAY "WRITE error: " CUST-STAT "." - END-IF. - CLOSE f. - GOBACK. - END PROGRAM TSTOPEN. - - IDENTIFICATION DIVISION. - PROGRAM-ID. TSTOPN. - - ENVIRONMENT DIVISION. - INPUT-OUTPUT SECTION. - FILE-CONTROL. - SELECT f ASSIGN s-path - ORGANIZATION LINE SEQUENTIAL - FILE STATUS IS IO-STS. - - DATA DIVISION. - FILE SECTION. - FD f. - 01 f-line PIC X(80). - - WORKING-STORAGE SECTION. - 01 IO-STS PIC X(2) VALUE "00". - - LINKAGE SECTION. - 01 s-path PIC X(80). - - PROCEDURE DIVISION USING s-path. - OPEN OUTPUT f - IF IO-STS NOT = "00" - DISPLAY "Opened error: " IO-STS "." - GOBACK - END-IF. - DISPLAY "Opened file: " s-path(1:10) ".". - MOVE "Hello World" TO f-line. - WRITE f-line. - CLOSE f. - GOBACK. - END PROGRAM TSTOPN. -]) - -AT_DATA([prog2.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog2. - - ENVIRONMENT DIVISION. - DATA DIVISION. - WORKING-STORAGE SECTION. - - PROCEDURE DIVISION. - CALL "TSTOPEN" USING OMITTED. - STOP RUN. - END PROGRAM prog2. - - IDENTIFICATION DIVISION. - PROGRAM-ID. TSTOPEN. - - ENVIRONMENT DIVISION. - INPUT-OUTPUT SECTION. - FILE-CONTROL. - SELECT f ASSIGN s-path - ORGANIZATION SEQUENTIAL. - - DATA DIVISION. - FILE SECTION. - FD f. - 01 f-line PIC X(79). - - LINKAGE SECTION. - 01 s-path PIC X(80). - - PROCEDURE DIVISION USING s-path. - OPEN OUTPUT f - GOBACK. - END PROGRAM TSTOPEN. -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) - -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], -[Opened error: 31. -Opened file: foyasg.txt. -Output file: fooasg.txt - 00 #0001. -Output file: foxasg.txt - 00 #0001. -Output file: foozzz.txt - 00 #0001. -Extend file: fooasg.txt - 00 #0002. -Extend file: foxasg.txt - 00 #0002. -], []) - -AT_CHECK([$COMPILE prog2.cob], [0], [], []) - -AT_CHECK([$COBCRUN_DIRECT ./prog2], [1], [], -[libcob: prog2.cob:32: error: inconsistant file name (status = 31) for file f ('field with NULL address') on OPEN -]) - -AT_CLEANUP - - -AT_SETUP([INDEXED file sparse/split keys]) -AT_KEYWORDS([runfile split key sparse SUPPRESS]) - -# FIXME: separate both test parts - -AT_SKIP_IF([test "$COB_HAS_ISAM" = "no"]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - - PROGRAM-ID. prog. - - ENVIRONMENT DIVISION. - CONFIGURATION SECTION. - - INPUT-OUTPUT SECTION. - FILE-CONTROL. - SELECT TSPFILE - ASSIGN TO "testisam" - ORGANIZATION INDEXED ACCESS DYNAMIC - RECORD KEY IS PRIME-KEY - SOURCE IS CM-CUST-NUM, CM-COMPANY - - ALTERNATE RECORD KEY IS SPLIT-KEY2 - SOURCE IS CM-TELEPHONE,CM-MACHINE WITH DUPLICATES - - ALTERNATE RECORD KEY IS SPLIT-KEY3 - SOURCE IS CM-DISK,CM-TAPE WITH DUPLICATES - SUPPRESS WHEN ALL "*" - FILE STATUS IS CUST-STAT - . - - DATA DIVISION. - FILE SECTION. - FD TSPFILE - BLOCK CONTAINS 5 RECORDS. - - 01 TSPFL-RECORD. - 05 TSPFL-REC. - 10 CM-CUST-NUM PICTURE X(8). - 10 CM-STATUS PICTURE X. - 10 CM-COMPANY PICTURE X(25). - 10 CM-ADDRESS-1 PICTURE X(25). - 10 CM-ADDRESS-2 PICTURE X(25). - 10 CM-ADDRESS-3 PICTURE X(25). - 10 CM-TELEPHONE PICTURE 9(10). - 10 CM-DP-MGR PICTURE X(25). - 10 CM-MACHINE PICTURE X(8). - 10 CM-MEMORY PICTURE X(4). - 10 CM-DISK PICTURE X(8). - 10 CM-TAPE PICTURE X(8). - 10 CM-NO-TERMINALS PICTURE 9(5). - - WORKING-STORAGE SECTION. - - 01 CUST-STAT. - 05 STAT-1 PICTURE 9(4) COMP SYNC. - 05 FILLER REDEFINES STAT-1. - 10 STAT-X1 PIC X COMP-X. - 10 STAT-X2 PIC X COMP-X. - 77 BYTE-1 PICTURE 9(3). - 77 BYTE-2 PICTURE 9(3). - 77 MAX-SUB VALUE 16 PICTURE 9(5) COMP SYNC. - - 01 TEST-DATA. - - 02 DATA-CUST-NUM-TBL. - - 05 FILLER PIC X(8) VALUE "ALP00000". - 05 FILLER PIC X(8) VALUE "BET00000". - 05 FILLER PIC X(8) VALUE "GAM00000". - 05 FILLER PIC X(8) VALUE "DEL00000". - 05 FILLER PIC X(8) VALUE "EPS00000". - 05 FILLER PIC X(8) VALUE "FOR00000". - 05 FILLER PIC X(8) VALUE "GIB00000". - 05 FILLER PIC X(8) VALUE "H&J00000". - 05 FILLER PIC X(8) VALUE "INC00000". - 05 FILLER PIC X(8) VALUE "JOH00000". - 05 FILLER PIC X(8) VALUE "KON00000". - 05 FILLER PIC X(8) VALUE "LEW00000". - 05 FILLER PIC X(8) VALUE "MOR00000". - 05 FILLER PIC X(8) VALUE "NEW00000". - 05 FILLER PIC X(8) VALUE "OLD00000". - 05 FILLER PIC X(8) VALUE "PRE00000". - - 02 DATA-CUST-NUM REDEFINES DATA-CUST-NUM-TBL - PIC X(8) OCCURS 16. - 02 DATA-COMPANY-TBL. - - 05 FILLER PIC X(25) VALUE "ALPHA ELECTRICAL CO. LTD.". - 05 FILLER PIC X(25) VALUE "BETA SHOE MFG. INC. ". - 05 FILLER PIC X(25) VALUE "GAMMA X-RAY TECHNOLOGY ". - 05 FILLER PIC X(25) VALUE "DELTA LUGGAGE REPAIRS ". - 05 FILLER PIC X(25) VALUE "EPSILON EQUIPMENT SUPPLY ". - 05 FILLER PIC X(25) VALUE "FORTUNE COOKIE COMPANY ". - 05 FILLER PIC X(25) VALUE "GIBRALTER LIFE INSURANCE ". - 05 FILLER PIC X(25) VALUE "H & J PLUMBING SUPPLIES ". - 05 FILLER PIC X(25) VALUE "INCREMENTAL BACKUP CORP. ". - 05 FILLER PIC X(25) VALUE "JOHNSON BOATING SUPPLIES ". - 05 FILLER PIC X(25) VALUE "KONFLAB PLASTIC PRODUCTS.". - 05 FILLER PIC X(25) VALUE "LEWISTON GRAPHICS LTD. ". - 05 FILLER PIC X(25) VALUE "MORNINGSIDE CARPENTRY. ". - 05 FILLER PIC X(25) VALUE "NEW WAVE SURF SHOPS INC. ". - 05 FILLER PIC X(25) VALUE "OLD TYME PIZZA MFG. CO. ". - 05 FILLER PIC X(25) VALUE "PRESTIGE OFFICE FURNITURE". - - 02 DATA-COMPANY REDEFINES DATA-COMPANY-TBL - PIC X(25) OCCURS 16. - 02 DATA-ADDRESS-1-TBL. - - 05 FILLER PIC X(25) VALUE "123 MAIN STREET ". - 05 FILLER PIC X(25) VALUE "1090 2ND AVE. WEST ". - 05 FILLER PIC X(25) VALUE "1401 JEFFERSON BLVD. ". - 05 FILLER PIC X(25) VALUE "1620 ARIZONA WAY ". - 05 FILLER PIC X(25) VALUE "1184 EAST FIRST STREET ". - 05 FILLER PIC X(25) VALUE "114 JOHN F. KENNEDY AVE. ". - 05 FILLER PIC X(25) VALUE "650 LIBERTY CRESCENT ". - 05 FILLER PIC X(25) VALUE "77 SUNSET BLVD. ". - 05 FILLER PIC X(25) VALUE "10908 SANTA MONICA BLVD. ". - 05 FILLER PIC X(25) VALUE "1134 PARIS ROAD ". - 05 FILLER PIC X(25) VALUE "808 NORTHWEST MAIN ST. ". - 05 FILLER PIC X(25) VALUE "9904 QUEEN STREET ". - 05 FILLER PIC X(25) VALUE "1709 DUNDAS CRESCENT W. ". - 05 FILLER PIC X(25) VALUE "3240 MARIS AVENUE ". - 05 FILLER PIC X(25) VALUE "1705 WISCONSIN ROAD ". - 05 FILLER PIC X(25) VALUE "114A MAPLE GROVE ". - - 02 DATA-ADDRESS-1 REDEFINES DATA-ADDRESS-1-TBL - PIC X(25) OCCURS 16. - 02 DATA-ADDRESS-2-TBL. - - 05 FILLER PIC X(10) VALUE "NEW YORK ". - 05 FILLER PIC X(10) VALUE "ATLANTA ". - 05 FILLER PIC X(10) VALUE "WASHINGTON". - 05 FILLER PIC X(10) VALUE "TORONTO ". - 05 FILLER PIC X(10) VALUE "CALGARY ". - 05 FILLER PIC X(10) VALUE "SAN DIEGO ". - 05 FILLER PIC X(10) VALUE "LOS RIOS ". - 05 FILLER PIC X(10) VALUE "MADISON ". - 05 FILLER PIC X(10) VALUE "WILBUR ". - 05 FILLER PIC X(10) VALUE "TOPEKA ". - 05 FILLER PIC X(10) VALUE "SEATTLE ". - 05 FILLER PIC X(10) VALUE "NEW JERSEY". - 05 FILLER PIC X(10) VALUE "FORT WAYNE". - 05 FILLER PIC X(10) VALUE "COLUMBUS ". - 05 FILLER PIC X(10) VALUE "RICHMOND ". - 05 FILLER PIC X(10) VALUE "WHITEPLAIN". - - 02 DATA-ADDRESS-2 REDEFINES DATA-ADDRESS-2-TBL - PIC X(10) OCCURS 16. - 02 DATA-ADDRESS-3-TBL. - - 05 FILLER PIC X(10) VALUE "N.Y. ". - 05 FILLER PIC X(10) VALUE "GEORGIA ". - 05 FILLER PIC X(10) VALUE "D.C. ". - 05 FILLER PIC X(10) VALUE "CANADA ". - 05 FILLER PIC X(10) VALUE "CANADA ". - 05 FILLER PIC X(10) VALUE "CALIFORNIA". - 05 FILLER PIC X(10) VALUE "NEW MEXICO". - 05 FILLER PIC X(10) VALUE "WISCONSIN ". - 05 FILLER PIC X(10) VALUE "DELAWARE ". - 05 FILLER PIC X(10) VALUE "KANSAS ". - 05 FILLER PIC X(10) VALUE "WASHINGTON". - 05 FILLER PIC X(10) VALUE "N.J. ". - 05 FILLER PIC X(10) VALUE "COLORADO ". - 05 FILLER PIC X(10) VALUE "OHIO ". - 05 FILLER PIC X(10) VALUE "VIRGINIA ". - 05 FILLER PIC X(10) VALUE "N.Y. ". - - 02 DATA-ADDRESS-3 REDEFINES DATA-ADDRESS-3-TBL - PIC X(10) OCCURS 16. - 02 DATA-TELEPHONE-TBL. - - 05 FILLER PIC 9(10) VALUE 3131234432. - 05 FILLER PIC 9(10) VALUE 4082938498. - 05 FILLER PIC 9(10) VALUE 8372487274. - 05 FILLER PIC 9(10) VALUE 4169898509. - 05 FILLER PIC 9(10) VALUE 5292398745. - 05 FILLER PIC 9(10) VALUE 8009329492. - 05 FILLER PIC 9(10) VALUE 6456445643. - 05 FILLER PIC 9(10) VALUE 6546456333. - 05 FILLER PIC 9(10) VALUE 3455445444. - 05 FILLER PIC 9(10) VALUE 6456445643. - 05 FILLER PIC 9(10) VALUE 7456434355. - 05 FILLER PIC 9(10) VALUE 6554456433. - 05 FILLER PIC 9(10) VALUE 4169898509. - 05 FILLER PIC 9(10) VALUE 7534587453. - 05 FILLER PIC 9(10) VALUE 8787458374. - 05 FILLER PIC 9(10) VALUE 4169898509. - - 02 DATA-TELEPHONE REDEFINES DATA-TELEPHONE-TBL - PIC 9(10) OCCURS 16. - 02 DATA-DP-MGR-TBL. - - 05 FILLER PIC X(20) VALUE "MR. DAVE HARRIS ". - 05 FILLER PIC X(20) VALUE "MS. JANICE SILCOX ". - 05 FILLER PIC X(20) VALUE "MR. ALLAN JONES ". - 05 FILLER PIC X(20) VALUE "MR. PETER MACKAY ". - 05 FILLER PIC X(20) VALUE "MRS. DONNA BREWER ". - 05 FILLER PIC X(20) VALUE "MR. MICHAEL SMYTHE ". - 05 FILLER PIC X(20) VALUE "MR. D.A. MORRISON ". - 05 FILLER PIC X(20) VALUE "MR. BRIAN PATTERSON ". - 05 FILLER PIC X(20) VALUE "MR. DARRYL TOWNSEND ". - 05 FILLER PIC X(20) VALUE "MS. VALERIE HARPER ". - 05 FILLER PIC X(20) VALUE "MR. FRED MILLER ". - 05 FILLER PIC X(20) VALUE "MR. DONALD FISCHER ". - 05 FILLER PIC X(20) VALUE "MR. STEVEN YOURDIN ". - 05 FILLER PIC X(20) VALUE "MS. Goldie Hawn ". - 05 FILLER PIC X(20) VALUE "MS. ALICE WINSTON ". - 05 FILLER PIC X(20) VALUE "MR. THOMAS JEFFERSON". - - 02 DATA-DP-MGR REDEFINES DATA-DP-MGR-TBL - PIC X(20) OCCURS 16. - 02 DATA-MACHINE-TBL. - - 05 FILLER PIC X(8) VALUE "UNI-9030". - 05 FILLER PIC X(8) VALUE "UNI-9040". - 05 FILLER PIC X(8) VALUE "UNI-80/3". - 05 FILLER PIC X(8) VALUE "UNI-80/5". - 05 FILLER PIC X(8) VALUE "UNI-80/6". - 05 FILLER PIC X(8) VALUE "UNI-80/6". - 05 FILLER PIC X(8) VALUE "UNI-80/6". - 05 FILLER PIC X(8) VALUE "UNI-80/8". - 05 FILLER PIC X(8) VALUE "UNI-80/8". - 05 FILLER PIC X(8) VALUE "UNI-80/8". - 05 FILLER PIC X(8) VALUE "UNI-80/8". - 05 FILLER PIC X(8) VALUE "UNI-80/8". - 05 FILLER PIC X(8) VALUE "UNI-80/8". - 05 FILLER PIC X(8) VALUE "UNI-80/8". - 05 FILLER PIC X(8) VALUE "UNI-9040". - 05 FILLER PIC X(8) VALUE "UNI-9040". - - 02 DATA-MACHINE REDEFINES DATA-MACHINE-TBL - PIC X(8) OCCURS 16. - 02 DATA-NO-TERMINALS-TBL. - - 05 FILLER PIC 9(3) COMP-3 VALUE 85. - 05 FILLER PIC 9(3) COMP-3 VALUE 34. - 05 FILLER PIC 9(3) COMP-3 VALUE 75. - 05 FILLER PIC 9(3) COMP-3 VALUE 45. - 05 FILLER PIC 9(3) COMP-3 VALUE 90. - 05 FILLER PIC 9(3) COMP-3 VALUE 107. - 05 FILLER PIC 9(3) COMP-3 VALUE 67. - 05 FILLER PIC 9(3) COMP-3 VALUE 32. - 05 FILLER PIC 9(3) COMP-3 VALUE 16. - 05 FILLER PIC 9(3) COMP-3 VALUE 34. - 05 FILLER PIC 9(3) COMP-3 VALUE 128. - 05 FILLER PIC 9(3) COMP-3 VALUE 64. - 05 FILLER PIC 9(3) COMP-3 VALUE 110. - 05 FILLER PIC 9(3) COMP-3 VALUE 324. - 05 FILLER PIC 9(3) COMP-3 VALUE 124. - 05 FILLER PIC 9(3) COMP-3 VALUE 86. - - 02 DATA-NO-TERMINALS REDEFINES DATA-NO-TERMINALS-TBL - PIC 9(3) COMP-3 OCCURS 16. - - 01 WORK-AREA. - 05 REC-NUM PICTURE 9(6) VALUE 0. - 05 REC-MAX PICTURE 9(6) VALUE 10. - 05 SUB PICTURE 9(4) COMP SYNC. - 88 ODD-RECORD VALUE 1 3 5 7 9 10 11. - 88 NULL-KEY VALUE 4 5 8 12 14. - - 05 TSPFL-KEY PICTURE X(8). - - PROCEDURE DIVISION. - - MAINFILE. - PERFORM LOADFILE. - PERFORM LISTFILE. - STOP RUN. - - LOADFILE. - DISPLAY "Loading sample data file." - UPON CONSOLE. - - OPEN OUTPUT TSPFILE - IF CUST-STAT NOT = "00" - DIVIDE STAT-1 BY 256 GIVING BYTE-1 REMAINDER BYTE-2 - DISPLAY "Error " CUST-STAT " " BYTE-1 " " BYTE-2 - " opening 'testisam' file" - UPON CONSOLE - STOP RUN - END-IF. - - PERFORM 1000-LOAD-RECORD - VARYING SUB FROM 1 BY 1 - UNTIL SUB > MAX-SUB. - - DISPLAY "Sample data file load complete." - UPON CONSOLE. - CLOSE TSPFILE. - - *---------------------------------------------------------------* - * LOAD A RECORD FROM DATA TABLES * - *---------------------------------------------------------------* - - 1000-LOAD-RECORD. - - MOVE SPACES TO TSPFL-RECORD. - MOVE DATA-CUST-NUM (SUB) TO CM-CUST-NUM. - MOVE CM-CUST-NUM TO TSPFL-KEY. - MOVE DATA-COMPANY (SUB) TO CM-COMPANY. - MOVE DATA-ADDRESS-1 (SUB) TO CM-ADDRESS-1. - MOVE DATA-ADDRESS-2 (SUB) TO CM-ADDRESS-2. - MOVE DATA-ADDRESS-3 (SUB) TO CM-ADDRESS-3. - MOVE DATA-TELEPHONE (SUB) TO CM-TELEPHONE. - MOVE DATA-DP-MGR (SUB) TO CM-DP-MGR. - MOVE DATA-MACHINE (SUB) TO CM-MACHINE. - MOVE DATA-NO-TERMINALS (SUB) TO CM-NO-TERMINALS. - - IF ODD-RECORD - MOVE "8417" TO CM-DISK - MOVE "1600 BPI" TO CM-TAPE - MOVE "1MEG" TO CM-MEMORY - ELSE - MOVE "8470" TO CM-DISK - MOVE "6250 BPI" TO CM-TAPE - MOVE "3MEG" TO CM-MEMORY. - IF NULL-KEY - MOVE ALL "*" TO CM-DISK - MOVE ALL "*" TO CM-TAPE. - - WRITE TSPFL-RECORD. - IF CUST-STAT NOT = "00" - AND CUST-STAT NOT = "02" - DISPLAY "Key: " TSPFL-KEY ", Status: " CUST-STAT - UPON CONSOLE. - - LISTFILE. - DISPLAY "LIST SAMPLE FILE" UPON CONSOLE. - MOVE ZERO TO REC-NUM - OPEN INPUT TSPFILE - IF CUST-STAT NOT = "00" - DISPLAY "ERROR " CUST-STAT " OPENING INPUT FILE " - UPON CONSOLE - IF CUST-STAT (1:1) = "9" - DISPLAY "Sub Error " STAT-X2 UPON CONSOLE - END-IF - STOP RUN - END-IF. - MOVE SPACES TO TSPFL-RECORD. - START TSPFILE KEY GREATER THAN PRIME-KEY - IF CUST-STAT NOT = "00" - DISPLAY "Error " CUST-STAT " starting file" - UPON CONSOLE - IF CUST-STAT (1:1) = "9" - DISPLAY "Sub Error " STAT-X2 UPON CONSOLE - END-IF - STOP RUN - END-IF. - READ TSPFILE NEXT RECORD WITH NO LOCK - IF CUST-STAT NOT = "00" - DISPLAY "Error " CUST-STAT " on 1st read of file" - UPON CONSOLE - IF CUST-STAT (1:1) = "9" - DISPLAY "Sub Error " STAT-X2 UPON CONSOLE - END-IF - STOP RUN - END-IF. - PERFORM UNTIL CUST-STAT NOT = "00" - OR REC-NUM > REC-MAX - DISPLAY "Key: " CM-CUST-NUM " is " CM-COMPANY - " Disk=" CM-DISK ":" - UPON CONSOLE - READ TSPFILE NEXT RECORD - AT END - MOVE "99" TO CUST-STAT - END-READ - ADD 1 TO REC-NUM - END-PERFORM - IF CUST-STAT = "99" - DISPLAY "Hit End of File" UPON CONSOLE - END-IF. - - DISPLAY "LIST SAMPLE FILE DESCENDING" UPON CONSOLE. - MOVE ZERO TO REC-NUM - START TSPFILE KEY LESS THAN PRIME-KEY - IF CUST-STAT NOT = "00" - DISPLAY "Error " CUST-STAT " starting file" - UPON CONSOLE - STOP RUN - END-IF. - READ TSPFILE PREVIOUS RECORD WITH NO LOCK - IF CUST-STAT NOT = "00" - DISPLAY "Error " CUST-STAT " on 1st read of file" - UPON CONSOLE - STOP RUN - END-IF. - PERFORM UNTIL CUST-STAT NOT = "00" - OR REC-NUM > REC-MAX - DISPLAY "Key: " CM-CUST-NUM " is " CM-COMPANY - " Disk=" CM-DISK ":" - UPON CONSOLE - READ TSPFILE PREVIOUS RECORD - AT END - MOVE "99" TO CUST-STAT - END-READ - ADD 1 TO REC-NUM - END-PERFORM. - - DISPLAY "LIST SAMPLE FILE BY KEY3" UPON CONSOLE. - MOVE ZERO TO REC-NUM - MOVE SPACES TO TSPFL-RECORD. - START TSPFILE KEY GREATER THAN OR EQUAL TO SPLIT-KEY3 - IF CUST-STAT NOT = "00" - AND CUST-STAT NOT = "02" - DISPLAY "Error " CUST-STAT " starting file" - UPON CONSOLE - STOP RUN - END-IF. - READ TSPFILE NEXT RECORD WITH NO LOCK - IF CUST-STAT NOT = "00" - AND CUST-STAT NOT = "02" - DISPLAY "Error " CUST-STAT " on 1st read of file" - UPON CONSOLE - STOP RUN - END-IF. - PERFORM UNTIL (CUST-STAT NOT = "00" - AND CUST-STAT NOT = "02") - OR REC-NUM > REC-MAX - DISPLAY "Key: " CM-CUST-NUM " is " CM-COMPANY - " Disk=" CM-DISK ":" - UPON CONSOLE - READ TSPFILE NEXT RECORD - AT END - MOVE "99" TO CUST-STAT - END-READ - ADD 1 TO REC-NUM - END-PERFORM. - *---- Some results may be different with VB-ISAM ------* - MOVE SPACES TO TSPFL-RECORD. - MOVE DATA-CUST-NUM (2) TO CM-CUST-NUM. - READ TSPFILE KEY IS PRIME-KEY - IF CUST-STAT NOT = "23" - DISPLAY "Error " CUST-STAT " instead of 23" - UPON CONSOLE - END-IF. - MOVE DATA-COMPANY (2) TO CM-COMPANY. - READ TSPFILE KEY IS PRIME-KEY - IF CUST-STAT NOT = "00" - DISPLAY "Error " CUST-STAT " on primary read " - UPON CONSOLE - ELSE - DISPLAY "Got: " CM-CUST-NUM " is " CM-COMPANY - " Disk=" CM-DISK ":" - UPON CONSOLE - END-IF. - READ TSPFILE NEXT RECORD - IF CUST-STAT NOT = "00" - DISPLAY "Error " CUST-STAT " on next read " - UPON CONSOLE - ELSE - DISPLAY "Nxt: " CM-CUST-NUM " is " CM-COMPANY - " Disk=" CM-DISK ":" - UPON CONSOLE - END-IF. - MOVE DATA-TELEPHONE (7) TO CM-TELEPHONE. - MOVE DATA-MACHINE (7) TO CM-MACHINE. - READ TSPFILE KEY IS SPLIT-KEY2 - IF CUST-STAT NOT = "00" - DISPLAY "Error " CUST-STAT " instead of 23" - UPON CONSOLE - ELSE - DISPLAY "Ky2: " CM-CUST-NUM " is " CM-COMPANY - " Mach=" CM-MACHINE ":" - UPON CONSOLE - END-IF. - CLOSE TSPFILE. -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) - -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], -[Loading sample data file. -Sample data file load complete. -LIST SAMPLE FILE -Key: ALP00000 is ALPHA ELECTRICAL CO. LTD. Disk=8417 : -Key: BET00000 is BETA SHOE MFG. INC. Disk=8470 : -Key: DEL00000 is DELTA LUGGAGE REPAIRS Disk=********: -Key: EPS00000 is EPSILON EQUIPMENT SUPPLY Disk=********: -Key: FOR00000 is FORTUNE COOKIE COMPANY Disk=8470 : -Key: GAM00000 is GAMMA X-RAY TECHNOLOGY Disk=8417 : -Key: GIB00000 is GIBRALTER LIFE INSURANCE Disk=8417 : -Key: H&J00000 is H & J PLUMBING SUPPLIES Disk=********: -Key: INC00000 is INCREMENTAL BACKUP CORP. Disk=8417 : -Key: JOH00000 is JOHNSON BOATING SUPPLIES Disk=8417 : -Key: KON00000 is KONFLAB PLASTIC PRODUCTS. Disk=8417 : -LIST SAMPLE FILE DESCENDING -Key: KON00000 is KONFLAB PLASTIC PRODUCTS. Disk=8417 : -Key: JOH00000 is JOHNSON BOATING SUPPLIES Disk=8417 : -Key: INC00000 is INCREMENTAL BACKUP CORP. Disk=8417 : -Key: H&J00000 is H & J PLUMBING SUPPLIES Disk=********: -Key: GIB00000 is GIBRALTER LIFE INSURANCE Disk=8417 : -Key: GAM00000 is GAMMA X-RAY TECHNOLOGY Disk=8417 : -Key: FOR00000 is FORTUNE COOKIE COMPANY Disk=8470 : -Key: EPS00000 is EPSILON EQUIPMENT SUPPLY Disk=********: -Key: DEL00000 is DELTA LUGGAGE REPAIRS Disk=********: -Key: BET00000 is BETA SHOE MFG. INC. Disk=8470 : -Key: ALP00000 is ALPHA ELECTRICAL CO. LTD. Disk=8417 : -LIST SAMPLE FILE BY KEY3 -Key: ALP00000 is ALPHA ELECTRICAL CO. LTD. Disk=8417 : -Key: GAM00000 is GAMMA X-RAY TECHNOLOGY Disk=8417 : -Key: GIB00000 is GIBRALTER LIFE INSURANCE Disk=8417 : -Key: INC00000 is INCREMENTAL BACKUP CORP. Disk=8417 : -Key: JOH00000 is JOHNSON BOATING SUPPLIES Disk=8417 : -Key: KON00000 is KONFLAB PLASTIC PRODUCTS. Disk=8417 : -Key: BET00000 is BETA SHOE MFG. INC. Disk=8470 : -Key: FOR00000 is FORTUNE COOKIE COMPANY Disk=8470 : -Key: MOR00000 is MORNINGSIDE CARPENTRY. Disk=8470 : -Key: OLD00000 is OLD TYME PIZZA MFG. CO. Disk=8470 : -Key: PRE00000 is PRESTIGE OFFICE FURNITURE Disk=8470 : -Got: BET00000 is BETA SHOE MFG. INC. Disk=8470 : -Nxt: DEL00000 is DELTA LUGGAGE REPAIRS Disk=********: -Ky2: GIB00000 is GIBRALTER LIFE INSURANCE Mach=UNI-80/6: -], []) - -AT_CLEANUP - - -AT_SETUP([INDEXED file split keys WITH DUPLICATES]) -AT_KEYWORDS([runfile key]) - -AT_SKIP_IF([test "$COB_HAS_ISAM" = "no"]) -## Note: The order in which secondary records with duplicate keys -## are returnded is not guaranteed. - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - - ENVIRONMENT DIVISION. - INPUT-OUTPUT SECTION. - FILE-CONTROL. - SELECT test-file - ASSIGN "TESTFILE" - ACCESS DYNAMIC - ORGANIZATION INDEXED - RECORD KEY test-key-1 SOURCE IS test-key-p1 - ALTERNATE RECORD KEY test-key-2 SOURCE IS test-key-p2, - test-key-p3 - WITH DUPLICATES - . - - DATA DIVISION. - FILE SECTION. - FD test-file. - 01 test-rec. - 03 test-key-p1 PIC X(4). - 03 test-key-p2 PIC 9(4). - 03 test-data PIC X(4). - 03 test-key-p3 PIC X(4). - - WORKING-STORAGE SECTION. - 01 found PIC X(03). - - PROCEDURE DIVISION. - OPEN OUTPUT test-file - WRITE test-rec FROM "BBBB0001dat1aaaa" - WRITE test-rec FROM "AAAA0001dat2aaaa" - WRITE test-rec FROM "CCCC0002dat3aaaa" - WRITE test-rec FROM "DDDD0002dat4bbbb" - WRITE test-rec FROM "EEEE0002dat5bbbb" - CLOSE test-file - - OPEN INPUT test-file - - MOVE "CCCC" TO test-key-p1 - READ test-file KEY IS test-key-1 - INVALID KEY - DISPLAY "READ with CCCC found no record" - NOT INVALID KEY - IF test-data NOT = "dat3" - DISPLAY "READ with wrong result: " - test-rec - END-READ - - MOVE SPACES TO found - - MOVE 0001 TO test-key-p2 - MOVE "aaaa" TO test-key-p3 - START test-file KEY >= test-key-2 - INVALID KEY - DISPLAY "START >= 0001/aaaa found no record" - NOT INVALID KEY - READ test-file NEXT - AT END - DISPLAY "READ NEXT (1) found no record" - NOT AT END - EVALUATE test-data - WHEN "dat1" - MOVE 'X' TO found (1:1) - WHEN "dat2" - MOVE 'X' TO found (2:1) - WHEN OTHER - DISPLAY "READ NEXT (1) " - "with wrong result: " - test-data - END-READ - READ test-file NEXT - AT END - DISPLAY "READ NEXT (2) found no record" - NOT AT END - EVALUATE test-data - WHEN "dat1" - MOVE 'X' TO found (1:1) - WHEN "dat2" - MOVE 'X' TO found (2:1) - WHEN OTHER - DISPLAY "READ NEXT (2) " - "with wrong result: " - test-data - END-READ - IF found NOT = 'XX ' - DISPLAY "START >= + READ NEXT * 2 " - "with wrong result: " found - END-START - MOVE 0001 TO test-key-p2 - MOVE "aaaa" TO test-key-p3 - START test-file KEY > test-key-2 - INVALID KEY - DISPLAY "START > 0001/aaaa found no record" - NOT INVALID KEY - READ test-file NEXT - AT END - DISPLAY "READ NEXT (3) found no record" - NOT AT END - IF test-data NOT = "dat3" - DISPLAY "READ NEXT (3) " - "with wrong result: " - test-data - END-READ - END-START - - MOVE 0002 TO test-key-p2 - MOVE ALL "z" TO test-key-p3 - START test-file KEY IS < test-key-2 - INVALID KEY - DISPLAY "START < 0002/zzzz found no record" - NOT INVALID KEY - READ test-file PREVIOUS - AT END - DISPLAY "READ PREVIOUS (1) found no record" - NOT AT END - IF test-data NOT = "dat5" - DISPLAY "READ PREVIOUS (1) " - "with wrong result: " - test-data - END-READ - READ test-file PREVIOUS - AT END - DISPLAY "READ PREVIOUS (2) found no record" - NOT AT END - IF test-data NOT = "dat4" - DISPLAY "READ PREVIOUS (2) " - "with wrong result: " - test-data - END-READ - READ test-file PREVIOUS - AT END - DISPLAY "READ PREVIOUS (3) found no record" - NOT AT END - IF test-data NOT = "dat3" - DISPLAY "READ PREVIOUS (3) " - "with wrong result: " - test-data - END-READ - END-START - - CLOSE test-file - STOP RUN. -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [], []) -AT_CLEANUP - - -AT_SETUP([INDEXED file variable length record]) -AT_KEYWORDS([runfile WRITE START READ]) - -AT_SKIP_IF([test "$COB_HAS_ISAM" = "no"]) - -AT_DATA([prog.cob], [ - Identification division. - Program-id. prog. - * - Environment division. - - Input-output section. - File-control. - * - Select optional tbw - assign to path-tbw - organization is indexed - access mode is dynamic - record key is tbw-key - alternate record key is tbw-alt - suppress when space - sharing with no other - file status is fs-file-status. - * - I-o-control. - * - Data division. - File section. - * - FD tbw - record is varying in size - from 107 to 362 characters - depending on end-tbw-record - . - 01 tbw-record. - 02 tbw-key pic x(100). - 02 tbw-alt. - 03 tbw-alt-1 pic 9(02). - 03 tbw-alt-2 pic 9(04). - 02 tbw-f1 pic x(01). - 02 tbw-f2 pic x(255). - * - Working-storage section. - - 01 fs-file-status pic x(02). - - 01 end-tbw-record pic 9(09) binary. - - 01 flag-tbw pic x(01) value low-value. - 88 flag-tbw-open value high-value. - 88 flag-tbw-closed value low-value. - - 01 path-tbw pic x(255) value space. - - Procedure division. - - * Prepare. - Move "tbw" to path-tbw. - - * First test. - Perform tbw-delete-file thru tbw-exit. - - Perform tbw-open-i-o thru tbw-exit. - - Move low-values to tbw-key. - Perform tbw-start-primary-greater thru tbw-exit. - - Perform tbw-read-next thru tbw-exit. - - Move 122 to end-tbw-record. - Move "aaaaa" to tbw-key. - Move spaces to tbw-alt - tbw-f1 - tbw-f2. - Perform tbw-write thru tbw-exit. - - Move low-values to tbw-alt. - Perform tbw-start-alternate thru tbw-exit. - - Move low-values to tbw-key. - Perform tbw-start-primary-greater thru tbw-exit. - - Perform tbw-read-next thru tbw-exit. - - Perform tbw-read-next thru tbw-exit. - - * Second test. - Perform tbw-close thru tbw-exit. - - Perform tbw-delete-file thru tbw-exit. - - Perform tbw-open-i-o thru tbw-exit. - - Move low-values to tbw-key. - Perform tbw-start-primary-greater thru tbw-exit. - - Perform tbw-read-next thru tbw-exit. - - Move 163 to end-tbw-record. - Move "aaaaa" to tbw-key. - Move 1 to tbw-alt-1 - tbw-alt-2. - Move spaces to tbw-f1 - tbw-f2. - Perform tbw-write thru tbw-exit. - - Move 122 to end-tbw-record. - Move "aaaab" to tbw-key. - Move spaces to tbw-alt - tbw-f1 - tbw-f2. - Perform tbw-write thru tbw-exit. - - Move low-values to tbw-alt. - Perform tbw-start-alternate thru tbw-exit. - - Perform tbw-read-next thru tbw-exit. - - Move spaces to tbw-alt. - Perform tbw-rewrite thru tbw-exit. - - * Finish. - Perform tbw-close thru tbw-exit. - Display "Test completed". - Stop run. - - * I/O. - tbw-Open-I-O. - If flag-tbw-open - Perform tbw-Close thru tbw-Close-exit - end-if. - Display "open". - Open i-o tbw. - Display "open". - If fs-file-status is less than "10" - Set flag-tbw-open to true - end-if. - Go to tbw-exit. - * - tbw-Start-Primary-Greater. - Display "start > tbw-key". - Start tbw - key is greater than tbw-key - invalid key Continue - end-start. - Display "start > tbw-key". - Go to tbw-exit. - * - tbw-Start-Alternate. - Display "start >= tbw-alt". - Start tbw - key is not less than tbw-alt - invalid key Continue - end-start. - Display "start >= tbw-alt". - Go to tbw-exit. - * - tbw-Read-Next. - Display "read next". - Read tbw - next record - at end Continue - end-read. - Display "read next done". - Go to tbw-exit. - * - tbw-Write. - Display "write". - Write tbw-record - invalid key Continue - end-write. - Display "write". - Go to tbw-exit. - * - tbw-Rewrite. - Display "rewrite". - Rewrite tbw-record - invalid key Continue - end-rewrite. - Display "rewrite " fs-file-status. - Go to tbw-exit. - * - tbw-Delete-File. - If flag-tbw-open - Perform tbw-Close thru tbw-Close-exit - end-if. - Move "xx" to fs-file-status. - Display "delete file". - Delete file tbw - end-delete. - Display "delete file". - Go to tbw-exit. - * - tbw-Close. - If flag-tbw-open - Display "close" - Close tbw - Display "close" - Set flag-tbw-closed to true - end-if. - tbw-Close-exit. - Exit. - tbw-exit. - Exit. -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) - -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], -[delete file -delete file -open -open -start > tbw-key -start > tbw-key -read next -read next done -write -write -start >= tbw-alt -start >= tbw-alt -start > tbw-key -start > tbw-key -read next -read next done -read next -read next done -close -close -delete file -delete file -open -open -start > tbw-key -start > tbw-key -read next -read next done -write -write -write -write -start >= tbw-alt -start >= tbw-alt -read next -read next done -rewrite -rewrite 00 -close -close -Test completed -], []) - -AT_CLEANUP - - -AT_SETUP([INDEXED sample]) -AT_KEYWORDS([runfile optional file status READ WRITE DUPLICATES START]) - -# modified version of GC-FAQ: indexing example -# Author: Brian Tiffin, Date: 17-Feb-2009, 28-Jan-2014 - -AT_SKIP_IF([test "$COB_HAS_ISAM" = "no"]) - -AT_DATA([prog.cob], [ - - identification division. - program-id. linage. - - environment division. - configuration section. - - input-output section. - file-control. - select optional indexed-file - assign to "indexed-file.dat" - status is indexing-status - organization is indexed - access mode is dynamic - record key is keyfield of indexing-record - alternate record key is altkey of indexing-record - with duplicates - . - - data division. - file section. - fd indexed-file. - 01 indexing-record. - 03 keyfield pic x(8). - 03 filler pic x. - 03 altkey. - 05 first-part pic 99. - 05 middle-part pic x. - 05 last-part pic 99. - 03 filler pic x. - 03 data-part pic x(18). - - working-storage section. - 01 indexing-status. - 03 high-status-code pic xx. - 03 high-status redefines high-status-code pic 99. - 88 indexing-ok values 0 thru 10. - 03 low-status-code pic xx. - 03 low-status redefines low-status-code pic 99. - - 78 line-separator value - '-----------------------------------------'. - 01 display-record. - 03 filler pic x(4) value spaces. - 03 keyfield pic x(8). - 03 filler pic xx value spaces. - 03 altkey. - 05 first-part pic 99. - 05 filler pic x value space. - 05 middle-part pic x. - 05 filler pic x value space. - 05 last-part pic 99. - 03 filler pic xx value ", ". - 03 data-part pic x(18). - 77 safety-net pic 99. - - *> control break - 01 oldkey pic 99x99. - - *> read control fields - 01 duplicate-flag pic x. - 88 no-more-duplicates value high-value - when set to false low-value. - 01 record-flag pic x. - 88 no-more-records value high-value - when set to false low-value. - - *> *************************************************************** - procedure division. - main. - *> Populate a sample database, create or overwrite keys - perform populate-sample - - *> clear the record space for this example - move spaces to indexing-record - - *> open the data file again - open i-o indexed-file - perform indexing-check - if not indexing-ok - stop run returning 1 - end-if - - *> read all the duplicate 00b02 keys - move 00 to first-part of indexing-record - move "b" to middle-part of indexing-record - move 02 to last-part of indexing-record - - *> using read key and then next key / last key compare - set no-more-duplicates to false - - display "Read all 00b02 keys sequentially" end-display - perform read-indexing-record - perform read-next-record - *> this is only here for safety... - varying safety-net from 1 by 1 - until no-more-duplicates - *> s a f e against broken indexed i/o - or safety-net > 40 - if safety-net > 40 - display "Safety kicked in!" end-display - end-if - display line-separator end-display - - *> read by key of reference ... the cool stuff - move 00 to first-part of indexing-record - move "a" to middle-part of indexing-record - move 02 to last-part of indexing-record - set no-more-records to false - - *> using start and read next - display "Read all alternate keys greater than 00a02" - end-display - perform start-at-key - perform read-next-by-key - *> this is only here for safety... - varying safety-net from 1 by 1 - until no-more-records - *> s a f e against broken indexed i/o - or safety-net > 40 - if safety-net > 40 - display "Safety kicked in!" end-display - end-if - display line-separator end-display - - *> read by primary key of reference - move "87654321" to keyfield of indexing-record - set no-more-records to false - - *> using start and previous by key - display - "Read all primary keys less than " - function trim (keyfield of indexing-record) - end-display - perform start-prime-key - perform read-previous-by-key - *> this is only here for safety... - varying safety-net from 1 by 1 - until no-more-records - *> s a f e against broken indexed i/o - or safety-net > 40 - if safety-net > 40 - display "Safety kicked in!" end-display - end-if - display line-separator end-display - - *> and with that we are done with indexing sample - close indexed-file - - goback - . - *> *************************************************************** - - *> *************************************************************** - *><* read by alternate key paragraph - read-indexing-record. - display "Reading: " altkey of indexing-record end-display - read indexed-file key is altkey of indexing-record - invalid key - display - "bad read key: " - function trim (altkey of indexing-record) - upon syserr - end-display - set no-more-duplicates to true - end-read - perform indexing-check - . - - *><* read next sequential paragraph - read-next-record. - move corresponding indexing-record to display-record - display display-record end-display - move altkey of indexing-record to oldkey - - read indexed-file next record - at end set no-more-duplicates to true - not at end - if oldkey not equal altkey of indexing-record - set no-more-duplicates to true - end-if - end-read - perform indexing-check - . - - *><* start primary key of reference paragraph - start-prime-key. - display "Prime < " keyfield of indexing-record end-display - start indexed-file - key is less than - keyfield of indexing-record - invalid key - display - "bad start: " - function trim (keyfield of indexing-record) - upon syserr - end-display - set no-more-records to true - not invalid key - read indexed-file previous record - at end set no-more-records to true - end-read - end-start - perform indexing-check - . - - *><* read previous by key of reference paragraph - read-previous-by-key. - move corresponding indexing-record to display-record - display display-record end-display - - read indexed-file previous record - at end set no-more-records to true - end-read - perform indexing-check - . - *><* start alternate key of reference paragraph - start-at-key. - display "Seeking >= " altkey of indexing-record end-display - start indexed-file - key is greater than or equal to - altkey of indexing-record - invalid key - display - "bad start: " - function trim (altkey of indexing-record) - upon syserr - end-display - set no-more-records to true - not invalid key - read indexed-file next record - at end set no-more-records to true - end-read - end-start - perform indexing-check - . - - *><* read next by key of reference paragraph - read-next-by-key. - move corresponding indexing-record to display-record - display display-record end-display - - read indexed-file next record - at end set no-more-records to true - end-read - perform indexing-check - . - - *><* populate a sample database - populate-sample. - - *> Open optional index file for read write - open i-o indexed-file - perform indexing-check - - move "12345678 00a01 some 12345678 data" to indexing-record - perform write-indexing-record - move "87654321 00a01 some 87654321 data" to indexing-record - perform write-indexing-record - move "12348765 00a01 some 12348765 data" to indexing-record - perform write-indexing-record - move "87651234 00a01 some 87651234 data" to indexing-record - perform write-indexing-record - - move "12345679 00b02 some 12345679 data" to indexing-record - perform write-indexing-record - move "97654321 00b02 some 97654321 data" to indexing-record - perform write-indexing-record - move "12349765 00b02 some 12349765 data" to indexing-record - perform write-indexing-record - move "97651234 00b02 some 97651234 data" to indexing-record - perform write-indexing-record - - move "12345689 00c13 some 12345689 data" to indexing-record - perform write-indexing-record - move "98654321 00c13 some 98654321 data" to indexing-record - perform write-indexing-record - move "12349865 00c13 some 12349865 data" to indexing-record - perform write-indexing-record - move "98651234 00c13 some 98651234 data" to indexing-record - perform write-indexing-record - - *> close it ... not necessary, but for the example we will - close indexed-file - perform indexing-check - . - - *><* Write paragraph - write-indexing-record. - write indexing-record - invalid key - display - "rewriting key: " - function trim (keyfield of indexing-record) - upon syserr - end-display - rewrite indexing-record - invalid key - display - "really bad key: " - function trim (keyfield of indexing-record) - upon syserr - end-display - end-rewrite - end-write - . - - *><* file status quick check. For this sample, keep running - indexing-check. - if not indexing-ok then - display - "isam file io problem: " indexing-status - upon syserr - end-display - end-if - . -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], -[Read all 00b02 keys sequentially -Reading: 00b02 - 12345679 00 b 02, some 12345679 data - 97654321 00 b 02, some 97654321 data - 12349765 00 b 02, some 12349765 data - 97651234 00 b 02, some 97651234 data ------------------------------------------ -Read all alternate keys greater than 00a02 -Seeking >= 00a02 - 12345679 00 b 02, some 12345679 data - 97654321 00 b 02, some 97654321 data - 12349765 00 b 02, some 12349765 data - 97651234 00 b 02, some 97651234 data - 12345689 00 c 13, some 12345689 data - 98654321 00 c 13, some 98654321 data - 12349865 00 c 13, some 12349865 data - 98651234 00 c 13, some 98651234 data ------------------------------------------ -Read all primary keys less than 87654321 -Prime < 87654321 - 87651234 00 a 01, some 87651234 data - 12349865 00 c 13, some 12349865 data - 12349765 00 b 02, some 12349765 data - 12348765 00 a 01, some 12348765 data - 12345689 00 c 13, some 12345689 data - 12345679 00 b 02, some 12345679 data - 12345678 00 a 01, some 12345678 data ------------------------------------------ -], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], -[Read all 00b02 keys sequentially -Reading: 00b02 - 12345679 00 b 02, some 12345679 data - 97654321 00 b 02, some 97654321 data - 12349765 00 b 02, some 12349765 data - 97651234 00 b 02, some 97651234 data ------------------------------------------ -Read all alternate keys greater than 00a02 -Seeking >= 00a02 - 12345679 00 b 02, some 12345679 data - 97654321 00 b 02, some 97654321 data - 12349765 00 b 02, some 12349765 data - 97651234 00 b 02, some 97651234 data - 12345689 00 c 13, some 12345689 data - 98654321 00 c 13, some 98654321 data - 12349865 00 c 13, some 12349865 data - 98651234 00 c 13, some 98651234 data ------------------------------------------ -Read all primary keys less than 87654321 -Prime < 87654321 - 87651234 00 a 01, some 87651234 data - 12349865 00 c 13, some 12349865 data - 12349765 00 b 02, some 12349765 data - 12348765 00 a 01, some 12348765 data - 12345689 00 c 13, some 12345689 data - 12345679 00 b 02, some 12345679 data - 12345678 00 a 01, some 12345678 data ------------------------------------------ -], -[rewriting key: 12345678 -rewriting key: 87654321 -rewriting key: 12348765 -rewriting key: 87651234 -rewriting key: 12345679 -rewriting key: 97654321 -rewriting key: 12349765 -rewriting key: 97651234 -rewriting key: 12345689 -rewriting key: 98654321 -rewriting key: 12349865 -rewriting key: 98651234 -]) - -AT_CLEANUP - - -AT_SETUP([WRITE + REWRITE FILE name]) -AT_KEYWORDS([runfile]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - CONFIGURATION SECTION. - - INPUT-OUTPUT SECTION. - FILE-CONTROL. - SELECT FLATFILE ASSIGN EXTERNAL RELFIX - ORGANIZATION RELATIVE - ACCESS IS SEQUENTIAL RELATIVE KEY IS REC-NUM - FILE STATUS IS CUST-STAT. - - SELECT FLATFILE2 ASSIGN EXTERNAL RELFIX - ORGANIZATION RELATIVE - ACCESS IS RANDOM RELATIVE KEY IS REC-NUM - FILE STATUS IS CUST-STAT. - - DATA DIVISION. - FILE SECTION. - FD FLATFILE - BLOCK CONTAINS 5 RECORDS. - - 01 TSPFL-RECORD. - 10 CM-CUST-NUM PICTURE X(8). - 10 CM-COMPANY PICTURE X(25). - 10 CM-DISK PICTURE X(8). - 10 CM-NO-TERMINALS PICTURE 9(4). - - FD FLATFILE2 - BLOCK CONTAINS 5 RECORDS. - - 01 TSP2-RECORD. - 10 C2-CUST-NUM PICTURE X(8). - 10 C2-COMPANY PICTURE X(25). - 10 C2-DISK PICTURE X(8). - 10 C2-NO-TERMINALS PICTURE 9(4). - - WORKING-STORAGE SECTION. - - 77 MAX-SUB VALUE 6 PICTURE 9(4) COMP SYNC. - 77 CUST-STAT PICTURE X(2). - 77 REC-NUM VALUE 1 PICTURE 9(4). - - 01 TEST-DATA. - - 02 DATA-CUST-NUM-TBL. - - 05 FILLER PIC X(8) VALUE "ALP00000". - 05 FILLER PIC X(8) VALUE "BET00000". - 05 FILLER PIC X(8) VALUE "DEL00000". - 05 FILLER PIC X(8) VALUE "EPS00000". - 05 FILLER PIC X(8) VALUE "FOR00000". - 05 FILLER PIC X(8) VALUE "GAM00000". - - 02 DATA-CUST-NUM REDEFINES DATA-CUST-NUM-TBL - PIC X(8) OCCURS 6. - 02 DATA-COMPANY-TBL. - - 05 FILLER PIC X(25) VALUE "ALPHA ELECTRICAL CO. LTD.". - 05 FILLER PIC X(25) VALUE "BETA SHOE MFG. INC. ". - 05 FILLER PIC X(25) VALUE "DELTA LUGGAGE REPAIRS ". - 05 FILLER PIC X(25) VALUE "EPSILON EQUIPMENT SUPPLY ". - 05 FILLER PIC X(25) VALUE "FORTUNE COOKIE COMPANY ". - 05 FILLER PIC X(25) VALUE "GAMMA X-RAY TECHNOLOGY ". - 02 DATA-COMPANY REDEFINES DATA-COMPANY-TBL - PIC X(25) OCCURS 6. - 02 DATA-ADDRESS-2-TBL. - - 05 FILLER PIC X(10) VALUE "ATLANTA ". - 05 FILLER PIC X(10) VALUE "CALGARY ". - 05 FILLER PIC X(10) VALUE "NEW YORK ". - 05 FILLER PIC X(10) VALUE "TORONTO ". - 05 FILLER PIC X(10) VALUE "WASHINGTON". - 05 FILLER PIC X(10) VALUE "WHITEPLAIN". - 02 DATA-ADDRESS REDEFINES DATA-ADDRESS-2-TBL - PIC X(10) OCCURS 6. - - 02 DATA-NO-TERMINALS-TBL. - - 05 FILLER PIC 9(3) COMP-3 VALUE 10. - 05 FILLER PIC 9(3) COMP-3 VALUE 13. - 05 FILLER PIC 9(3) COMP-3 VALUE 75. - 05 FILLER PIC 9(3) COMP-3 VALUE 10. - 05 FILLER PIC 9(3) COMP-3 VALUE 90. - 05 FILLER PIC 9(3) COMP-3 VALUE 254. - - 02 DATA-NO-TERMINALS REDEFINES DATA-NO-TERMINALS-TBL - PIC 9(3) COMP-3 OCCURS 6. - 01 WORK-AREA. - 05 SUB PICTURE 9(4) COMP SYNC. - 88 ODD-RECORD VALUE 1 3 5. - - - PROCEDURE DIVISION. - - PERFORM LOADFILE. - - OPEN I-O FLATFILE2. - MOVE 2 TO REC-NUM - READ FLATFILE2 - DISPLAY "Read " C2-CUST-NUM " Sts:" CUST-STAT - " Trms:" C2-NO-TERMINALS. - ADD 1 TO C2-NO-TERMINALS - REWRITE FILE FLATFILE2 FROM TSP2-RECORD - READ FLATFILE2 - DISPLAY "REWROTE " C2-CUST-NUM " Sts:" CUST-STAT - " Trms:" C2-NO-TERMINALS. - CLOSE FLATFILE2. - STOP RUN. - - LOADFILE. - DISPLAY "Loading sample program data file." - UPON CONSOLE. - - OPEN OUTPUT FLATFILE. - - PERFORM LOAD-RECORD - VARYING SUB FROM 1 BY 1 - UNTIL SUB > MAX-SUB. - - DISPLAY "Sample program data file load complete." - UPON CONSOLE. - CLOSE FLATFILE. - - LOAD-RECORD. - - MOVE SPACES TO TSPFL-RECORD. - MOVE DATA-CUST-NUM (SUB) TO CM-CUST-NUM. - MOVE DATA-COMPANY (SUB) TO CM-COMPANY. - MOVE DATA-NO-TERMINALS (SUB) TO CM-NO-TERMINALS. - IF ODD-RECORD - MOVE "8417" TO CM-DISK - ELSE - MOVE "8470" TO CM-DISK. - WRITE FILE FLATFILE FROM TSPFL-RECORD. -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) - -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], -[Loading sample program data file. -Sample program data file load complete. -Read BET00000 Sts:00 Trms:0013 -REWROTE BET00000 Sts:00 Trms:0014 -], []) - -AT_CLEANUP - - -AT_SETUP([START RELATIVE (1)]) -AT_KEYWORDS([fundamental runfile DELETE FILE]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - INPUT-OUTPUT SECTION. - FILE-CONTROL. - SELECT OPTIONAL TEST-FILE - ASSIGN "TESTFILE" - ACCESS DYNAMIC - ORGANIZATION RELATIVE - STATUS TESTSTAT - RELATIVE KEY TESTKEY - . - DATA DIVISION. - FILE SECTION. - FD TEST-FILE. - 01 TEST-REC PIC X(4). - WORKING-STORAGE SECTION. - 01 TESTKEY USAGE BINARY-LONG UNSIGNED. - 01 TESTSTAT PIC XX. - 88 V-OK VALUE "00" "05". - PROCEDURE DIVISION. - DELETE FILE TEST-FILE. - OPEN I-O TEST-FILE. - IF NOT V-OK - DISPLAY "OPEN " TESTSTAT - END-DISPLAY - GOBACK - END-IF. - MOVE 99 TO TESTKEY. - START TEST-FILE KEY < TESTKEY - END-START. - IF TESTSTAT NOT = "23" - DISPLAY "START " TESTSTAT - END-DISPLAY - END-IF. - CLOSE TEST-FILE. - END PROGRAM prog. -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [], []) - -AT_CLEANUP - - -AT_SETUP([START RELATIVE (2)]) -AT_KEYWORDS([fundamental runfile]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - INPUT-OUTPUT SECTION. - FILE-CONTROL. - SELECT OPTIONAL TEST-FILE - ASSIGN "TESTFILE" - ACCESS DYNAMIC - ORGANIZATION RELATIVE - STATUS TESTSTAT - RELATIVE KEY TESTKEY - . - DATA DIVISION. - FILE SECTION. - FD TEST-FILE. - 01 TEST-REC PIC X(4). - WORKING-STORAGE SECTION. - 01 TESTKEY USAGE BINARY-LONG UNSIGNED. - 01 TESTSTAT PIC XX. - 88 V-OK VALUE "00" "05". - 88 V-ZERO VALUE "00". - PROCEDURE DIVISION. - OPEN OUTPUT TEST-FILE. - CLOSE TEST-FILE. - OPEN I-O TEST-FILE. - IF NOT V-OK - DISPLAY "OPEN " TESTSTAT - END-DISPLAY - GOBACK - END-IF. - MOVE 3 TO TESTKEY. - MOVE "0003" TO TEST-REC. - WRITE TEST-REC INVALID KEY - DISPLAY "WRITE " TESTSTAT - END-DISPLAY - END-WRITE. - MOVE 2 TO TESTKEY. - MOVE "0002" TO TEST-REC. - WRITE TEST-REC INVALID KEY - DISPLAY "WRITE " TESTSTAT - END-DISPLAY - END-WRITE. - MOVE 99 TO TESTKEY. - START TEST-FILE KEY < TESTKEY - END-START. - IF NOT V-ZERO - DISPLAY "START " TESTSTAT - END-DISPLAY - END-IF. - IF TESTKEY NOT = 99 - DISPLAY "TESTKEY " TESTKEY - END-DISPLAY - END-IF. - MOVE SPACE TO TEST-REC. - READ TEST-FILE NEXT - END-READ. - IF NOT V-ZERO - DISPLAY "READ " TESTSTAT - END-DISPLAY - END-IF. - IF TEST-REC NOT = "0003" - DISPLAY "READ RECORD " TEST-REC - END-DISPLAY - END-IF. - CLOSE TEST-FILE. - END PROGRAM prog. -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [], []) - -AT_CLEANUP - - -AT_SETUP([START RELATIVE (3)]) -AT_KEYWORDS([runfile]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - INPUT-OUTPUT SECTION. - FILE-CONTROL. - SELECT file1 ASSIGN TO DISK - ORGANIZATION RELATIVE - ACCESS DYNAMIC RELATIVE KEY file1-key. - DATA DIVISION. - FILE SECTION. - FD file1. - 1 file1-rec pic 999. - WORKING-STORAGE SECTION. - 77 file1-key pic 9(6). - PROCEDURE DIVISION. - OPEN OUTPUT file1. - CLOSE file1. - OPEN I-O file1. - MOVE 10 TO file1-key file1-rec. - WRITE file1-rec. - MOVE 11 TO file1-key file1-rec. - WRITE file1-rec. - MOVE 12 TO file1-key file1-rec. - WRITE file1-rec. - MOVE 13 TO file1-key file1-rec. - WRITE file1-rec. - * - MOVE 0 TO file1-key. - START file1 KEY > file1-key. - READ file1 NEXT. - IF (file1-rec <> 10) - DISPLAY "FAILED: START key > 0". - * - MOVE 99 TO file1-key. - START file1 KEY < file1-key. - READ file1 NEXT. - IF (file1-rec <> 13) - DISPLAY "FAILED: START key < 99". - * - MOVE 0 TO file1-key. - START file1 FIRST. - READ file1 NEXT. - IF (file1-rec <> 10) - DISPLAY "FAILED: START key FIRST". - * - MOVE 0 TO file1-key. - START file1 LAST. - READ file1 NEXT. - IF (file1-rec <> 13) - DISPLAY "FAILED: START key LAST". - * - MOVE 0 TO file1-key. - START file1 KEY >= file1-key. - READ file1 NEXT. - IF (file1-rec <> 10) - DISPLAY "FAILED: START key >= 0". - * - MOVE 99 TO file1-key. - START file1 KEY <= file1-key. - READ file1 NEXT. - IF (file1-rec <> 13) - DISPLAY "FAILED: START key <= 99". - * - CLOSE file1. - STOP RUN. -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0]) -AT_CLEANUP - - -AT_SETUP([READ on OPTIONAL missing RELATIVE / SEQUENTIAL]) -AT_KEYWORDS([runfile]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - CONFIGURATION SECTION. - INPUT-OUTPUT SECTION. - FILE-CONTROL. - SELECT OPTIONAL INFILE ASSIGN TO - "missing.txt" - ORGANIZATION IS RELATIVE - ACCESS IS SEQUENTIAL - FILE STATUS IS WSFS. - SELECT OPTIONAL INFILES ASSIGN TO - "missings.txt" - ORGANIZATION IS SEQUENTIAL - ACCESS IS SEQUENTIAL - FILE STATUS IS WSFS. - DATA DIVISION. - FILE SECTION. - FD INFILE. - 01 INREC PIC X(80). - FD INFILES. - 01 INRECS PIC X(80). - WORKING-STORAGE SECTION. - 01 WSFS PIC X(2). - 88 RECORDFOUND VALUE "00". - 01 WSINREC PIC X(80). - PROCEDURE DIVISION. - MAIN-PROCEDURE. - * Open missing file - OPEN INPUT INFILE - DISPLAY "R: OPEN INPUT on missing optional file = " WSFS " " - NO ADVANCING - IF WSFS = '05' - DISPLAY "OK" - ELSE - DISPLAY "Bad" - END-IF. - OPEN INPUT INFILES - DISPLAY "S: OPEN INPUT on missing optional file = " WSFS " " - NO ADVANCING - IF WSFS = '05' - DISPLAY "OK" - ELSE - DISPLAY "Bad" - END-IF. - * First read, raise a FS 10 (AT END) which is expected - READ INFILE INTO WSINREC - DISPLAY "R: 1st READ on missing optional file = " WSFS " " - NO ADVANCING - IF WSFS = '10' - DISPLAY "OK" - ELSE - DISPLAY "Bad" - END-IF. - READ INFILES INTO WSINREC - DISPLAY "S: 1st READ on missing optional file = " WSFS " " - NO ADVANCING - IF WSFS = '10' - DISPLAY "OK" - ELSE - DISPLAY "Bad" - END-IF. - - * Second read, should raise a FS 46 (READ AFTER AT END). - READ INFILE INTO WSINREC - DISPLAY "R: 2nd READ on missing optional file = " WSFS " " - NO ADVANCING - IF WSFS = '46' - DISPLAY "OK" - ELSE - DISPLAY "Bad" - END-IF. - READ INFILES INTO WSINREC - DISPLAY "S: 2nd READ on missing optional file = " WSFS " " - NO ADVANCING - IF WSFS = '46' - DISPLAY "OK" - ELSE - DISPLAY "Bad" - END-IF. - READ INFILE - DISPLAY "R: 3rd READ on missing optional file = " WSFS " " - NO ADVANCING - IF WSFS = '46' - DISPLAY "OK" - ELSE - DISPLAY "Bad" - END-IF. - READ INFILES - DISPLAY "S: 3rd READ on missing optional file = " WSFS " " - NO ADVANCING - IF WSFS = '46' - DISPLAY "OK" - ELSE - DISPLAY "Bad" - END-IF. - - CLOSE INFILE - CLOSE INFILES - STOP RUN. -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) - -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], -[R: OPEN INPUT on missing optional file = 05 OK -S: OPEN INPUT on missing optional file = 05 OK -R: 1st READ on missing optional file = 10 OK -S: 1st READ on missing optional file = 10 OK -R: 2nd READ on missing optional file = 46 OK -S: 2nd READ on missing optional file = 46 OK -R: 3rd READ on missing optional file = 46 OK -S: 3rd READ on missing optional file = 46 OK -], []) - -AT_CLEANUP - - -AT_SETUP([READ on OPTIONAL missing INDEXED file]) -AT_KEYWORDS([runfile]) - -AT_SKIP_IF([test "$COB_HAS_ISAM" = "no"]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - - ENVIRONMENT DIVISION. - INPUT-OUTPUT SECTION. - FILE-CONTROL. - SELECT OPTIONAL file1 ASSIGN "fileX" - ORGANIZATION IS INDEXED - RECORD KEY IS file1-key - STATUS f-status. - - DATA DIVISION. - FILE SECTION. - FD file1. - 01 file1-key PIC X. - - WORKING-STORAGE SECTION. - 01 f-status PIC XX. - - PROCEDURE DIVISION. - DELETE FILE file1. - OPEN INPUT file1. - IF (f-status <> "05") - DISPLAY "FAILED OPEN: fs=" f-status - END-IF - READ file1 - AT END - IF (f-status <> "10") - DISPLAY "FAILED READ AT END: fs=" f-status - END-IF - - NOT AT END - DISPLAY "FAILED READ NO AT END: status " f-status - END-READ - CLOSE file1 - . -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0]) - -AT_CLEANUP - - -AT_SETUP([EXTERNAL RELATIVE file]) -# FIXME: Check the function of the EXTERNAL file using a second program, too -AT_KEYWORDS([runfile]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - - ENVIRONMENT DIVISION. - INPUT-OUTPUT SECTION. - FILE-CONTROL. - SELECT my-file - ASSIGN TO "somefile" - ORGANIZATION IS RELATIVE - RELATIVE KEY IS my-key. - - DATA DIVISION. - FILE SECTION. - FD my-file EXTERNAL. - 01 my-record. - 03 my-record-data PIC X(80). - - WORKING-STORAGE SECTION. - 01 my-key PIC 9. - - PROCEDURE DIVISION. - CONTINUE - . -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [], []) - -AT_CLEANUP - - -AT_SETUP([DECLARATIVES procedure referencing]) -AT_KEYWORDS([runfile]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - INPUT-OUTPUT SECTION. - FILE-CONTROL. - SELECT TEST-FILE ASSIGN "./TEST-FILE". - DATA DIVISION. - FILE SECTION. - FD TEST-FILE. - 01 TEST-REC PIC X(10). - WORKING-STORAGE SECTION. - 01 Z USAGE BINARY-LONG VALUE 0. - PROCEDURE DIVISION. - DECLARATIVES. - P01 SECTION. - USE AFTER ERROR PROCEDURE ON TEST-FILE. - P0101. - ADD 1 TO Z. - END DECLARATIVES. - MP01 SECTION. - MP0101. - OPEN INPUT TEST-FILE. - PERFORM P0101. - IF Z NOT = 2 - DISPLAY Z - END-DISPLAY - END-IF. - STOP RUN. -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [], []) - -AT_CLEANUP - - -AT_SETUP([DECLARATIVES procedure referencing (multiple)]) -AT_KEYWORDS([runfile]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - INPUT-OUTPUT SECTION. - FILE-CONTROL. - SELECT TEST-FILE ASSIGN "./TEST-FILE". - DATA DIVISION. - FILE SECTION. - FD TEST-FILE. - 01 TEST-REC PIC X(10). - WORKING-STORAGE SECTION. - 01 Z USAGE BINARY-LONG VALUE 0. - PROCEDURE DIVISION. - DECLARATIVES. - P01 SECTION. - USE AFTER ERROR PROCEDURE ON TEST-FILE. - P0101. - ADD 1 TO Z. - P02 SECTION. - USE AFTER ERROR PROCEDURE ON OUTPUT. - P0201. - ADD 1 TO Z. - END DECLARATIVES. - MP01 SECTION. - MP0101. - OPEN INPUT TEST-FILE. - PERFORM P01 THRU P02. - IF Z NOT = 3 - DISPLAY Z - END-DISPLAY - END-IF. - STOP RUN. -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [], []) - -AT_CLEANUP - - -AT_SETUP([System routines for directories (1)]) -AT_KEYWORDS([extensions runfile CBL_CREATE_DIR CBL_CHANGE_DIR CBL_DELETE_DIR]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 DIR PIC X(4) VALUE 'ABCD'. - - PROCEDURE DIVISION. - CALL 'CBL_CREATE_DIR' USING DIR END-CALL - IF RETURN-CODE NOT = 0 - DISPLAY 'error creating dir ...' END-DISPLAY - END-IF - - CALL 'CBL_CHANGE_DIR' USING DIR END-CALL - IF RETURN-CODE NOT = 0 - DISPLAY 'error changing dir ...' END-DISPLAY - END-IF - - CALL 'CBL_CHANGE_DIR' USING '..' END-CALL - IF RETURN-CODE NOT = 0 - DISPLAY 'error changing dir up ...' END-DISPLAY - END-IF - - CALL 'CBL_DELETE_DIR' USING DIR END-CALL - IF RETURN-CODE NOT = 0 - DISPLAY 'error deleting dir' END-DISPLAY - END-IF - - STOP RUN. -]) - - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [], []) -AT_CHECK([test -e abcd], [1], [], []) - -AT_CLEANUP - - -AT_SETUP([System routines for directories (2)]) -AT_KEYWORDS([runfile extensions -CBL_CREATE_DIR CBL_CREATE_FILE CBL_CLOSE_FILE CBL_CHECK_FILE_EXIST -CBL_DELETE_DIR CBL_PURGE_DIR]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 fh PIC X(4) COMP-5. - 01 rb PIC X(8) COMP-X. - 01 cb-bfr PIC X(4) COMP-X VALUE 16. - 01 w-dirname-1 PIC X(4) VALUE "tmp1". - 01 w-dirname-2 PIC X(9) VALUE "tmp1/tmp2". - 01 w-dirname-3 PIC X(14) VALUE "tmp1/tmp2/tmp3". - 01 w-filename PIC X(20) VALUE "tmp1/tmp2/tmp3/file1". - 01 w-finfo PIC X(16). - - PROCEDURE DIVISION. - CALL "CBL_CREATE_DIR" USING w-dirname-1. - IF RETURN-CODE <> 0 - DISPLAY "FAILED 1: CBL_CREATE_DIR (res=" RETURN-CODE ")" - END-IF - - CALL "CBL_CREATE_DIR" USING w-dirname-2. - IF RETURN-CODE <> 0 - DISPLAY "FAILED 2: CBL_CREATE_DIR (res=" RETURN-CODE ")" - END-IF - - * Should fail because directory does NOT exists yet. - CALL "CBL_CREATE_FILE" - USING w-filename, 1, 0, 0, fh. - IF RETURN-CODE <> 35 - DISPLAY "FAILED 3: CBL_CREATE_FILE expected fail (res=" - RETURN-CODE ")" - IF RETURN-CODE = ZERO - CALL "CBL_CLOSE_FILE" USING fh - END-IF - END-IF - - CALL "CBL_CREATE_DIR" USING w-dirname-3. - IF RETURN-CODE <> 0 - DISPLAY "FAILED 4: CBL_CREATE_DIR (res=" RETURN-CODE ")" - END-IF - - CALL "CBL_CREATE_FILE" - USING w-filename, 1, 0, 0, fh. - IF RETURN-CODE <> 0 - DISPLAY "FAILED 5: CBL_CREATE_FILE (res=" - RETURN-CODE ")" - END-IF - - CALL "CBL_CLOSE_FILE" USING fh. - IF RETURN-CODE <> 0 - DISPLAY "FAILED 6: CBL_CLOSE_FILE (res=" - RETURN-CODE ")" - END-IF - - CALL "CBL_CHECK_FILE_EXIST" USING w-filename, w-finfo. - IF RETURN-CODE <> 0 - DISPLAY "FAILED 7: CBL_CHECK_FILE_EXIST (res=" - RETURN-CODE ")" - END-IF - - - * Should fail because directory is NOT empty. - CALL "CBL_DELETE_DIR" USING w-dirname-1. - IF RETURN-CODE = 0 - DISPLAY "FAILED 8: CBL_DELETE_DIR EXPECTED TO FAIL" - END-IF - *********************** - * TO-DO: IMPLEMENT CBL_PURGE_DIR? NOT IN MF OR ACU. - *********************** - * Remove all files (including sub-directories) in tmp1 - * CALL "CBL_PURGE_DIR" USING w-dirname-1. - * IF RETURN-CODE <> 0 - * DISPLAY "FAILED 9: CBL_PURGE_DIR (res=" RETURN-CODE ")" - * END-IF - * - * Should succeed because directory is NOW empty. - * CALL "CBL_DELETE_DIR" USING w-dirname-1. - * IF RETURN-CODE <> 0 - * DISPLAY "FAILED 10: CBL_DELETE_DIR (res=" RETURN-CODE ")" - * END-IF - - STOP RUN NORMAL - . -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0]) - -AT_CLEANUP - - -AT_SETUP([System routines for files]) -AT_KEYWORDS([extensions runfile CBL_CREATE_FILE CBL_WRITE_FILE CBL_FLUSH_FILE -CBL_OPEN_FILE CBL_READ_FILE CBL_CLOSE_FILE CBL_RENAME_FILE CBL_DELETE_FILE -C$DELETE]) - -AT_DATA([file1], [ -dummy -]) -AT_DATA([file2], [ -test -]) -AT_DATA([file3], [ -data -]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 FNAME PIC X(256) VALUE 'testtext.txt'. - 01 ACCESS-MODE PIC X USAGE COMP-X VALUE 2. - 01 FHANDLE PIC X(4) USAGE COMP-X. - - 01 OFFSET PIC X(8) USAGE COMP-X. - 01 NBYTES PIC X(4) USAGE COMP-X. - 01 WRITE-BUFFER PIC X(20). - - PROCEDURE DIVISION. - CALL 'CBL_CREATE_FILE' USING FNAME 55 11 22 FHANDLE - END-CALL - IF RETURN-CODE NOT = -1 - DISPLAY 'Wrong return codes ...' END-DISPLAY - END-IF - MOVE 0 TO RETURN-CODE - - CALL 'CBL_CREATE_FILE' USING - FNAME ACCESS-MODE 0 0 FHANDLE - END-CALL - IF RETURN-CODE NOT = 0 - DISPLAY 'error creating file ...' END-DISPLAY - MOVE 0 TO RETURN-CODE - END-IF - - MOVE 'TestText.ABCD' TO WRITE-BUFFER. - MOVE 0 TO OFFSET. - MOVE 9 TO NBYTES. - - CALL 'CBL_WRITE_FILE' USING - FHANDLE OFFSET NBYTES '0' WRITE-BUFFER - END-CALL - IF RETURN-CODE NOT = 0 - DISPLAY 'error writing file ...' END-DISPLAY - MOVE 0 TO RETURN-CODE - END-IF - - CALL 'CBL_FLUSH_FILE' USING FHANDLE END-CALL - IF RETURN-CODE NOT = 0 - DISPLAY 'error flushing file ...' END-DISPLAY - MOVE 0 TO RETURN-CODE - END-IF - - CALL 'CBL_CLOSE_FILE' USING FHANDLE END-CALL - IF RETURN-CODE NOT = 0 - DISPLAY 'error closing file ...' END-DISPLAY - MOVE 0 TO RETURN-CODE - END-IF - - STOP RUN. -]) - -AT_DATA([prog2.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog2. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 FNAME PIC X(256) VALUE 'testtext.txt'. - 01 RET PIC -9. - 01 FHANDLE PIC X(4) USAGE COMP-X. - - 01 OFFSET PIC X(8) USAGE COMP-X. - 01 NBYTES PIC X(4) USAGE COMP-X. - 01 READ-BUFFER PIC X(10). - - PROCEDURE DIVISION. - CALL 'CBL_OPEN_FILE' USING FNAME 1 0 0 FHANDLE - END-CALL - IF RETURN-CODE NOT = 0 - DISPLAY 'error opening file ...' END-DISPLAY - END-IF - - MOVE SPACES TO READ-BUFFER. - MOVE 2 TO OFFSET. - MOVE 9 TO NBYTES. - - CALL 'CBL_READ_FILE' USING - FHANDLE OFFSET NBYTES 0 READ-BUFFER - END-CALL - IF RETURN-CODE NOT = 0 - DISPLAY 'error reading file ...' - return-code - END-DISPLAY - MOVE 0 TO RETURN-CODE - END-IF - IF READ-BUFFER NOT = 'stText.' *> text from first test - DISPLAY 'Wrong readbuffer ...' END-DISPLAY - END-IF - - CALL 'CBL_CLOSE_FILE' USING FHANDLE END-CALL - IF RETURN-CODE NOT = 0 - DISPLAY 'error closing file ...' - return-code - END-DISPLAY - MOVE 0 TO RETURN-CODE - END-IF - - CALL 'CBL_RENAME_FILE' USING FNAME 'foo.txt' END-CALL - IF RETURN-CODE NOT = 0 - DISPLAY 'error renaming file ...' - return-code - END-DISPLAY - MOVE 0 TO RETURN-CODE - END-IF - - CALL 'CBL_DELETE_FILE' USING 'file1' END-CALL - IF RETURN-CODE NOT = 0 - DISPLAY 'error deleting file1 ...' - return-code - END-DISPLAY - MOVE 0 TO RETURN-CODE - END-IF - CALL 'CBL_DELETE_FILE' USING 'file1' END-CALL - IF RETURN-CODE = 0 - DISPLAY 'no error on deleting file1 for the second time...' - return-code - END-DISPLAY - END-IF - MOVE 0 TO RETURN-CODE - - CALL 'C$DELETE' USING 'file2' 'S' END-CALL - IF RETURN-CODE NOT = 0 - DISPLAY 'error deleting file2 ...' - return-code - END-DISPLAY - MOVE 0 TO RETURN-CODE - END-IF - CALL 'CBL_DELETE_FILE' USING 'file2' END-CALL - IF RETURN-CODE = 0 *> note: should only return 0 or 1 when in ACUCOBOL mode - DISPLAY 'no error on deleting file2 for the second time...' - return-code - END-DISPLAY - END-IF - MOVE 0 TO RETURN-CODE - - STOP RUN. -]) - - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$COMPILE prog2.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [], -[libcob: prog.cob:15: warning: call to CBL_CREATE_FILE with wrong file_lock: 11 -libcob: prog.cob:15: warning: call to CBL_CREATE_FILE with wrong file_dev: 22 -libcob: prog.cob:15: warning: call to CBL_OPEN_FILE with wrong access mode: 55 -]) -AT_CHECK([$COBCRUN_DIRECT ./prog2], [0], [], []) - -AT_CLEANUP - - -AT_SETUP([System routine CBL_COPY_FILE]) -AT_KEYWORDS([extensions runfile]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - PROCEDURE DIVISION. - DISPLAY "test" END-DISPLAY - STOP RUN. -]) - -AT_DATA([prog2.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog2. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 FILE1 PIC X(8) VALUE 'prog.cob'. - 01 FILE2 PIC X(9) VALUE 'prog3.cob'. - - PROCEDURE DIVISION. - CALL 'CBL_COPY_FILE' USING - FILE1 FILE2 - END-CALL - STOP RUN. -]) - -AT_CHECK([$COMPILE prog2.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog2], [0], [], []) -AT_CHECK([diff prog.cob prog3.cob], [0], [], []) - -AT_CLEANUP - - -AT_SETUP([Default file external name]) -AT_KEYWORDS([runfile]) - -AT_DATA([fexists_signed.c], [ - -#include -#include -#include -#include - -/* - * Check file is present and correct by comparing - * its content to a given signature. - */ -COB_EXT_EXPORT int -fexists_signed (char *fid, char *signature, int signature_size) -{ - char *bfr; - FILE *f; - int res = -1; - - f = fopen (fid, "r"); - if (f != NULL) { - bfr = (char *) malloc (signature_size); - if (1 == fread (bfr, signature_size, 1, f)) { - if (!memcmp (signature, bfr, signature_size)) { - res = 0; - } - } - free (bfr); - } - return res; -} -]) -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - INPUT-OUTPUT SECTION. - FILE-CONTROL. - SELECT file1 ASSIGN DISK. - DATA DIVISION. - FILE SECTION. - FD file1. - 1 file1-rec. - 2 file1-date pic x(8). - 2 file1-time pic x(8). - WORKING-STORAGE SECTION. - 77 erc PIC 9(8) COMP. - 77 rec-size PIC 9(8) COMP VALUE 16. - PROCEDURE DIVISION. - ACCEPT file1-date FROM DATE YYYYMMDD. - ACCEPT file1-time FROM TIME. - OPEN OUTPUT file1. - WRITE file1-rec. - CLOSE file1. - CALL "fexists_signed" USING - BY REFERENCE "./file1" file1-rec - BY VALUE rec-size - RETURNING erc. - IF (erc <> 0) - DISPLAY "FAILED file1". - STOP RUN. -]) - -AT_CHECK([$COMPILE_MODULE fexists_signed.c], [0], [], []) -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([unset COB_FILE_PATH; ./prog], [0]) - -AT_CLEANUP - -### TO-DO: Move "ASSIGN expansion" test here. -### TO-DO: Already in run_extensions.at. - -AT_SETUP([SEQUENTIAL basic I/O]) -AT_KEYWORDS([runfile]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - INPUT-OUTPUT SECTION. - FILE-CONTROL. - SELECT file1 ASSIGN DISK ORGANIZATION SEQUENTIAL. - DATA DIVISION. - FILE SECTION. - FD file1. - 1 file1-rec pic x. - PROCEDURE DIVISION. - DELETE FILE file1. - OPEN OUTPUT file1. - MOVE "A" TO file1-rec. - WRITE file1-rec. - CLOSE file1. - OPEN INPUT file1. - READ file1. - IF (file1-rec <> "A") - display "FAILED". - CLOSE file1. - STOP RUN. -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0]) - -AT_CLEANUP - - -AT_SETUP([LINE SEQUENTIAL basic I/O]) -AT_KEYWORDS([runfile]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - INPUT-OUTPUT SECTION. - FILE-CONTROL. - SELECT file1 ASSIGN DISK ORGANIZATION LINE SEQUENTIAL. - SELECT file2 ASSIGN DISK ORGANIZATION LINE SEQUENTIAL. - DATA DIVISION. - FILE SECTION. - FD file1. - 1 file1-rec pic x. - FD file2. - 1 file2-rec pic xx. - PROCEDURE DIVISION. - DELETE FILE file1, file2 - OPEN OUTPUT file1, file2 - MOVE "A" TO file1-rec, file2-rec - WRITE file1-rec - WRITE file2-rec - MOVE " " TO file1-rec, file2-rec - WRITE file1-rec - WRITE file2-rec - WRITE file1-rec FROM "A" - WRITE file2-rec FROM "AA" - WRITE file1-rec FROM " " - WRITE file2-rec FROM " A" - CLOSE file1, file2 - OPEN INPUT file1, file2 - READ file1 - IF file1-rec NOT = "A" - display "FAILED 1 file1 - '" file1-rec "'". - READ file2 - IF file2-rec NOT = "A" - display "FAILED 1 file2 - '" file2-rec "'". - READ file1 - IF file1-rec NOT = SPACE - display "FAILED 2 file1 - '" file1-rec "'". - READ file2 - IF file2-rec NOT = SPACES - display "FAILED 2 file2 - '" file2-rec "'". - READ file1 - IF file1-rec NOT = "A" - display "FAILED 3 file1 - '" file1-rec "'". - READ file2 - IF file2-rec NOT = "AA" - display "FAILED 3 file2 - '" file2-rec "'". - READ file1 - IF file1-rec NOT = SPACE - display "FAILED 4 file1 - '" file1-rec "'". - READ file2 - IF file2-rec NOT = " A" - display "FAILED 4 file2 - '" file2-rec "'". - CLOSE file1, file2. - STOP RUN. -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0]) - -AT_CLEANUP - - -AT_SETUP([LINE SEQUENTIAL record truncation]) -AT_KEYWORDS([runfile]) - -AT_DATA([TEST-FILE], -[a -ab -abc -abcd -abcde -abcdef -]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - INPUT-OUTPUT SECTION. - FILE-CONTROL. - SELECT TEST-FILE ASSIGN "./TEST-FILE" - ORGANIZATION IS LINE SEQUENTIAL. - DATA DIVISION. - FILE SECTION. - FD TEST-FILE. - 01 TEST-REC PIC X(4). - PROCEDURE DIVISION. - OPEN INPUT TEST-FILE. - PERFORM 6 TIMES - READ TEST-FILE - DISPLAY "(" TEST-REC ")" - END-PERFORM - CLOSE TEST-FILE. - STOP RUN. -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], -[(a ) -(ab ) -(abc ) -(abcd) -(abcd) -(abcd) -]) - -AT_CLEANUP - - -AT_SETUP([SEQUENTIAL file I/O with variable records]) -AT_KEYWORDS([runfile]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - - ENVIRONMENT DIVISION. - INPUT-OUTPUT SECTION. - FILE-CONTROL. - SELECT f ASSIGN DISK. - - DATA DIVISION. - FILE SECTION. - FD f RECORD VARYING FROM 10 TO 20 DEPENDING rec-size. - 01 f-rec. - 02 f-x OCCURS 20 PIC X. - - WORKING-STORAGE SECTION. - 01 rec-size PIC 99. - 01 i PIC 99. - 01 1-template VALUE "+12345678++12345678+". - 02 1-x OCCURS 20 PIC X. - - PROCEDURE DIVISION. - OPEN OUTPUT f - PERFORM VARYING rec-size FROM 20 BY -1 UNTIL rec-size < 10 - WRITE f-rec FROM 1-template - END-PERFORM - CLOSE f - - OPEN INPUT f - * rec-size should not influence READ - MOVE 15 TO rec-size - PERFORM VARYING i FROM 20 BY -1 UNTIL i < 10 - READ f - AT END - DISPLAY "Failed: EOF" - STOP RUN ERROR - END-READ - - * Note the characters f-rec (rec-size + 1:) are all undefined, - * hence the refmod (1:rec-size). - DISPLAY rec-size ": >" f-rec (1:rec-size) "<" - IF rec-size NOT = i - DISPLAY "Failed: bad record size" - STOP RUN ERROR - END-IF - IF f-x (rec-size) NOT = 1-x (rec-size) - DISPLAY "Failed: bad data" - STOP RUN ERROR - END-IF - END-PERFORM - CLOSE f - . -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], -[20: >+12345678++12345678+< -19: >+12345678++12345678< -18: >+12345678++1234567< -17: >+12345678++123456< -16: >+12345678++12345< -15: >+12345678++1234< -14: >+12345678++123< -13: >+12345678++12< -12: >+12345678++1< -11: >+12345678++< -10: >+12345678+< -]) - -AT_CLEANUP - - -AT_SETUP([LINE SEQUENTIAL file I/O with variable records]) -AT_KEYWORDS([runfile]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - - ENVIRONMENT DIVISION. - INPUT-OUTPUT SECTION. - FILE-CONTROL. - SELECT f ASSIGN DISK - LINE SEQUENTIAL. - - DATA DIVISION. - FILE SECTION. - FD f RECORD VARYING FROM 10 TO 20 DEPENDING rec-size. - 01 f-rec. - 02 f-x OCCURS 20 PIC X. - - WORKING-STORAGE SECTION. - 01 rec-size PIC 99. - 01 i PIC 99. - 01 1-template VALUE "+12345678++12345678+". - 02 1-x OCCURS 20 PIC X. - - PROCEDURE DIVISION. - OPEN OUTPUT f - PERFORM VARYING rec-size FROM 20 BY -1 UNTIL rec-size < 10 - WRITE f-rec FROM 1-template - END-PERFORM - CLOSE f - - OPEN INPUT f - * rec-size should not influence READ - MOVE 15 TO rec-size - PERFORM VARYING i FROM 20 BY -1 UNTIL i < 10 - READ f - AT END - DISPLAY "Failed: EOF" - STOP RUN ERROR - END-READ - - DISPLAY rec-size ": >" f-rec (1:rec-size) "<" - IF rec-size NOT = i - DISPLAY "Failed: bad record size" - STOP RUN ERROR - END-IF - IF f-x (rec-size) NOT = 1-x (rec-size) - DISPLAY "Failed: bad data" - STOP RUN ERROR - END-IF - END-PERFORM - CLOSE f - . -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], -[20: >+12345678++12345678+< -19: >+12345678++12345678< -18: >+12345678++1234567< -17: >+12345678++123456< -16: >+12345678++12345< -15: >+12345678++1234< -14: >+12345678++123< -13: >+12345678++12< -12: >+12345678++1< -11: >+12345678++< -10: >+12345678+< -]) - -AT_CLEANUP - - -AT_SETUP([SEQUENTIAL file REWRITE]) -AT_KEYWORDS([runfile]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - - ENVIRONMENT DIVISION. - CONFIGURATION SECTION. - INPUT-OUTPUT SECTION. - FILE-CONTROL. - SELECT file1 ASSIGN DISK. - - DATA DIVISION. - FILE SECTION. - FD file1. - 01 file1-rec. - 02 file1-serial-1 PIC 9(6). - 02 file1-xseen PIC 9(4). - 02 file1-serial-2 PIC 9(6). - - WORKING-STORAGE SECTION. - 01 w-count PIC 9(6) VALUE 0. - 01 w-eof PIC 9 VALUE 0. - 88 eof VALUE 1 FALSE 0. - 01 w-abort PIC 9 VALUE 0. - 88 abort VALUE 1 FALSE 0. - - PROCEDURE DIVISION. - OPEN OUTPUT file1 - PERFORM VARYING w-count FROM 1 BY 1 - UNTIL w-count > 20 - MOVE w-count TO file1-serial-1 - MOVE 0 TO file1-xseen - ADD 100 w-count GIVING file1-serial-2 - WRITE file1-rec - END-PERFORM - CLOSE file1 - - OPEN I-O file1 - SET eof TO FALSE - PERFORM VARYING w-count FROM 1 BY 1 - UNTIL eof OR abort - READ file1 - AT END - SET eof TO TRUE - - NOT AT END - IF (file1-serial-1 <> w-count) - DISPLAY "FAIL 1: " w-count " :: " - file1-serial-1 - SET abort TO TRUE - ELSE IF (file1-serial-2 <> (100 + w-count)) - DISPLAY "FAIL 2: " w-count " :: " - file1-serial-2 - SET abort TO TRUE - ELSE IF (file1-xseen <> 0) - DISPLAY "FAIL 3: " w-count " :: " file1-xseen - SET abort TO TRUE - ELSE IF (w-count = 5 OR 10 OR 15 OR 20) - ADD 1000 w-count GIVING file1-serial-2 - ADD 1 TO file1-xseen - REWRITE file1-rec - END-IF - END-READ - END-PERFORM - IF NOT ((w-count = 22) AND eof) - DISPLAY "FAIL 4" - END-IF - CLOSE file1 - - OPEN INPUT file1 - SET eof TO FALSE - SET abort TO FALSE - PERFORM VARYING w-count FROM 1 BY 1 - UNTIL eof OR abort - READ file1 - AT END - SET eof TO TRUE - - NOT AT END - IF (file1-serial-1 <> w-count) - DISPLAY "FAIL 5" - SET abort TO TRUE - ELSE IF (w-count = 5 OR 10 OR 15 OR 20) - IF NOT ((file1-serial-2 = (1000 + w-count)) - AND (file1-xseen = 1)) - DISPLAY "FAIL 6" - SET abort TO TRUE - END-IF - ELSE - IF NOT ((file1-serial-2 = (100 + w-count)) - AND (file1-xseen = 0)) - DISPLAY "FAIL 7" - SET abort TO TRUE - END-IF - END-IF - END-READ - END-PERFORM - CLOSE file1 - . -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0]) - -AT_CLEANUP - - -AT_SETUP([SEQUENTIAL file with LOCK MODE EXCLUSIVE]) -AT_KEYWORDS([runfile]) - -AT_XFAIL_IF([false]) - -AT_DATA([prog1.cob], [ - identification division. - program-id. prog1. - environment division. - input-output section. - file-control. - select file1 assign disk - lock mode is exclusive - status is fs. - data division. - file section. - fd file1. - 1 file1-rec pic x. - working-storage section. - 1 fs pic xx. - 1 os-check pic x(7). - 88 os-is-windows-or-dos values 'WINDOWS' 'FREEDOS'. - 78 callee value "./prog2". - 78 callee-wdos value ".\prog2". - procedure division. - open output file1. - close file1. - open input file1. - accept os-check from environment "OS". - if os-check = spaces - accept os-check from environment "OS_NAME". - inspect os-check converting "werfdosin" to "WERFDOSIN". - if os-is-windows-or-dos - call "SYSTEM" using callee-wdos - else - call "SYSTEM" using callee. - close file1. - stop run. -]) -AT_DATA([prog2.cob], [ - identification division. - program-id. prog2. - environment division. - input-output section. - file-control. - select file1 assign disk status is fs. - data division. - file section. - fd file1. - 1 file1-rec pic x. - working-storage section. - 1 fs pic xx. - procedure division. - open input file1. - if fs not = "61" - display "FAILED: " fs - close file1 - end-if. - stop run. -]) - -AT_CHECK([$COMPILE prog1.cob], [0], [], []) -AT_CHECK([$COMPILE prog2.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog1], [0]) - -AT_CLEANUP - - -AT_SETUP([SEQUENTIAL file with OPEN WITH LOCK]) -AT_KEYWORDS([runfile]) - -AT_XFAIL_IF([false]) - -AT_DATA([prog1.cob], [ - identification division. - program-id. prog1. - environment division. - input-output section. - file-control. - select file1 assign disk status is fs. - data division. - file section. - fd file1. - 1 file1-rec pic x. - working-storage section. - 1 fs pic xx. - 1 os-check pic x(7). - 88 os-is-windows-or-dos values 'WINDOWS' 'FREEDOS'. - 78 callee value "./prog2". - 78 callee-wdos value ".\prog2". - procedure division. - open output file1. - close file1. - open i-o file1 with lock. - accept os-check from environment "OS". - if os-check = spaces - accept os-check from environment "OS_NAME". - inspect os-check converting "werfdosin" to "WERFDOSIN". - if os-is-windows-or-dos - call "SYSTEM" using callee-wdos - else - call "SYSTEM" using callee. - close file1. - stop run. -]) -AT_DATA([prog2.cob], [ - identification division. - program-id. prog2. - environment division. - input-output section. - file-control. - select file1 assign disk status is fs. - data division. - file section. - fd file1. - 1 file1-rec pic x. - working-storage section. - 1 fs pic xx. - procedure division. - open input file1. - if fs not = "61" - display "FAILED: " fs - close file1 - end-if. - stop run. -]) - -AT_CHECK([$COMPILE prog1.cob], [0], [], []) -AT_CHECK([$COMPILE prog2.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog1], [0]) - -AT_CLEANUP - - -AT_SETUP([SEQUENTIAL file with SHARING NO]) -AT_KEYWORDS([runfile]) - -AT_XFAIL_IF([false]) - -AT_DATA([prog1.cob], [ - identification division. - program-id. prog1. - environment division. - input-output section. - file-control. - select file1 assign disk - sharing no - status is fs. - data division. - file section. - fd file1. - 1 file1-rec pic x. - working-storage section. - 1 fs pic xx. - 1 os-check pic x(7). - 88 os-is-windows-or-dos values 'WINDOWS' 'FREEDOS'. - 78 callee value "./prog2". - 78 callee-wdos value ".\prog2". - procedure division. - open output file1. - close file1. - open input file1. - accept os-check from environment "OS". - if os-check = spaces - accept os-check from environment "OS_NAME". - inspect os-check converting "werfdosin" to "WERFDOSIN". - if os-is-windows-or-dos - call "SYSTEM" using callee-wdos - else - call "SYSTEM" using callee. - close file1. - stop run. -]) -AT_DATA([prog2.cob], [ - identification division. - program-id. prog2. - environment division. - input-output section. - file-control. - select file1 assign disk status is fs. - data division. - file section. - fd file1. - 1 file1-rec pic x. - working-storage section. - 1 fs pic xx. - procedure division. - open input file1. - if fs not = "61" - display "FAILED: " fs - close file1 - end-if. - stop run. -]) - -AT_CHECK([$COMPILE prog1.cob], [0], [], []) -AT_CHECK([$COMPILE prog2.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog1], [0]) - -AT_CLEANUP - - -AT_SETUP([SEQUENTIAL file with SHARING READ ONLY]) -AT_KEYWORDS([runfile]) - -AT_XFAIL_IF([false]) - -AT_DATA([prog1.cob], [ - identification division. - program-id. prog1. - environment division. - input-output section. - file-control. - select file1 assign disk - sharing read only - status is fs. - data division. - file section. - fd file1. - 1 file1-rec pic x. - working-storage section. - 1 fs pic xx. - 1 os-check pic x(7). - 88 os-is-windows-or-dos values 'WINDOWS' 'FREEDOS'. - 78 callee value "./prog2". - 78 callee-wdos value ".\prog2". - procedure division. - open output file1. - close file1. - open input file1. - accept os-check from environment "OS". - if os-check = spaces - accept os-check from environment "OS_NAME". - inspect os-check converting "werfdosin" to "WERFDOSIN". - if os-is-windows-or-dos - call "SYSTEM" using callee-wdos - else - call "SYSTEM" using callee. - close file1. - stop run. -]) -AT_DATA([prog2.cob], [ - identification division. - program-id. prog2. - environment division. - input-output section. - file-control. - select file1 assign disk status is fs. - data division. - file section. - fd file1. - 1 file1-rec pic x. - working-storage section. - 1 fs pic xx. - procedure division. - open i-o file1. - if fs not = "61" - display "FAILED: " fs - close file1 - end-if. - open input file1. - if fs not = "00" - display "FAILED: " fs - else - close file1 - end-if. - stop run. -]) - -AT_CHECK([$COMPILE prog1.cob], [0], [], []) -AT_CHECK([$COMPILE prog2.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog1], [0]) - -AT_CLEANUP - - -## Check successor is blocked from exclusive open on file already open. -AT_SETUP([SEQUENTIAL file with blocked lock]) -AT_KEYWORDS([runfile]) - -AT_XFAIL_IF([true]) - -AT_DATA([prog1.cob], [ - identification division. - program-id. prog1. - environment division. - input-output section. - file-control. - select file1 assign disk. - data division. - file section. - fd file1. - 1 file1-rec pic x. - working-storage section. - 1 os-check pic x(7). - 88 os-is-windows-or-dos values 'WINDOWS' 'FREEDOS'. - 78 callee value "./prog2". - 78 callee-wdos value ".\prog2". - procedure division. - open output file1. - close file1. - open i-o file1. - accept os-check from environment "OS". - if os-check = spaces - accept os-check from environment "OS_NAME". - inspect os-check converting "werfdosin" to "WERFDOSIN". - if os-is-windows-or-dos - call "SYSTEM" using callee-wdos - else - call "SYSTEM" using callee. - close file1. - stop run. -]) -AT_DATA([prog2.cob], [ - identification division. - program-id. prog2. - environment division. - input-output section. - file-control. - select file1 assign disk status is fs. - data division. - file section. - fd file1. - 1 file1-rec pic x. - working-storage section. - 1 fs pic xx. - procedure division. - open input file1. - if fs not = "00" - display "FAILED: " fs - stop run - end-if. - close file1 - open input file1 with lock. - if fs not = "61" - display "FAILED: " fs - close file1 - end-if. - stop run. -]) - -AT_CHECK([$COMPILE prog1.cob], [0], [], []) -AT_CHECK([$COMPILE prog2.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog1], [0]) - -AT_CLEANUP - - -AT_SETUP([RELATIVE SEQUENTIAL basic I/O]) -AT_KEYWORDS([runfile]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - INPUT-OUTPUT SECTION. - FILE-CONTROL. - SELECT file1 ASSIGN DISK ORGANIZATION RELATIVE. - DATA DIVISION. - FILE SECTION. - FD file1. - 1 file1-rec pic x. - PROCEDURE DIVISION. - DELETE FILE file1. - OPEN OUTPUT file1. - MOVE "A" TO file1-rec. - WRITE file1-rec. - CLOSE file1. - OPEN INPUT file1. - READ file1. - IF (file1-rec <> "A") - display "FAILED". - CLOSE file1. - STOP RUN. -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0]) - -AT_CLEANUP - - -AT_SETUP([RELATIVE RANDOM basic I/O]) -AT_KEYWORDS([runfile]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - INPUT-OUTPUT SECTION. - FILE-CONTROL. - SELECT file1 ASSIGN DISK - ORGANIZATION RELATIVE - ACCESS RANDOM RELATIVE KEY file1-key. - DATA DIVISION. - FILE SECTION. - FD file1. - 1 file1-rec pic x. - WORKING-STORAGE SECTION. - 77 file1-key pic 99. - PROCEDURE DIVISION. - DELETE FILE file1. - OPEN OUTPUT file1. - MOVE 1 to file1-key. - MOVE "A" TO file1-rec. - WRITE file1-rec. - MOVE 2 to file1-key. - MOVE "B" TO file1-rec. - WRITE file1-rec. - MOVE 3 to file1-key. - MOVE "C" TO file1-rec. - WRITE file1-rec. - CLOSE file1. - OPEN INPUT file1. - MOVE 2 to file1-key. - READ file1. - IF (file1-rec <> "B") - display "FAILED". - MOVE 1 to file1-key. - READ file1. - IF (file1-rec <> "A") - display "FAILED". - CLOSE file1. - STOP RUN. -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0]) - -AT_CLEANUP - - -AT_SETUP([RELATIVE SEQUENTIAL with variable records]) -AT_KEYWORDS([runfile]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - - ENVIRONMENT DIVISION. - INPUT-OUTPUT SECTION. - FILE-CONTROL. - SELECT f ASSIGN DISK - ORGANIZATION RELATIVE. - - DATA DIVISION. - FILE SECTION. - FD f RECORD VARYING FROM 10 TO 20 DEPENDING rec-size. - 01 f-rec. - 02 f-x OCCURS 20 PIC X. - - WORKING-STORAGE SECTION. - 01 rec-size PIC 99. - 01 i PIC 99. - 01 1-template VALUE "+12345678++12345678+". - 02 1-x OCCURS 20 PIC X. - - PROCEDURE DIVISION. - OPEN OUTPUT f - PERFORM VARYING rec-size FROM 20 BY -1 UNTIL rec-size < 10 - WRITE f-rec FROM 1-template - END-PERFORM - CLOSE f - - OPEN INPUT f - * rec-size should not influence READ - MOVE 15 TO rec-size - PERFORM VARYING i FROM 20 BY -1 UNTIL i < 10 - READ f - AT END - DISPLAY "Failed: EOF" - STOP RUN ERROR - END-READ - - DISPLAY rec-size ": >" f-rec (1:rec-size) "<" - IF rec-size NOT = i - DISPLAY "Failed: bad record size" - STOP RUN ERROR - END-IF - IF f-x (rec-size) NOT = 1-x (rec-size) - DISPLAY "Failed: bad data" - STOP RUN ERROR - END-IF - END-PERFORM - CLOSE f - . -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], -[20: >+12345678++12345678+< -19: >+12345678++12345678< -18: >+12345678++1234567< -17: >+12345678++123456< -16: >+12345678++12345< -15: >+12345678++1234< -14: >+12345678++123< -13: >+12345678++12< -12: >+12345678++1< -11: >+12345678++< -10: >+12345678+< -]) - -AT_CLEANUP - - -AT_SETUP([INDEXED SEQUENTIAL basic I/O]) -AT_KEYWORDS([runfile]) - -AT_SKIP_IF([test "$COB_HAS_ISAM" = "no"]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - INPUT-OUTPUT SECTION. - FILE-CONTROL. - SELECT fileX ASSIGN DISK ORGANIZATION INDEXED - RECORD KEY fileX-key. - DATA DIVISION. - FILE SECTION. - FD fileX. - 1 fileX-rec. - 2 fileX-key pic x(6). - 2 fileX-data pic x(10). - PROCEDURE DIVISION. - OPEN OUTPUT fileX. - MOVE ALL "A" TO fileX-rec. - WRITE fileX-rec. - CLOSE fileX. - OPEN INPUT fileX. - READ fileX. - IF (fileX-rec <> ALL "A") - display "FAILED". - CLOSE fileX. - STOP RUN. -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0]) - -AT_CLEANUP - - -AT_SETUP([INDEXED SEQUENTIAL with variable records]) -AT_KEYWORDS([runfile]) - -AT_SKIP_IF([test "$COB_HAS_ISAM" = "no"]) -AT_SKIP_IF([test "$COB_HAS_ISAM" = "disam"]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - - ENVIRONMENT DIVISION. - INPUT-OUTPUT SECTION. - FILE-CONTROL. - SELECT f ASSIGN DISK - INDEXED - RECORD KEY f-key - ACCESS RANDOM. - - DATA DIVISION. - FILE SECTION. - FD f RECORD VARYING FROM 12 TO 22 DEPENDING rec-size. - 01 f-rec. - 02 f-key PIC 99. - 02 f-data. - 03 f-x OCCURS 20 PIC X. - - WORKING-STORAGE SECTION. - 01 rec-size PIC 99. - 01 1-template VALUE "+12345678++12345678+". - 02 1-x OCCURS 20 PIC X. - - PROCEDURE DIVISION. - OPEN OUTPUT f - MOVE 1 TO f-key - PERFORM VARYING rec-size FROM 22 BY -1 UNTIL rec-size < 12 - MOVE 1-template TO f-data - WRITE f-rec - ADD 1 TO f-key - END-PERFORM - CLOSE f - - OPEN INPUT f - * rec-size should not influence READ - MOVE 15 TO rec-size - PERFORM VARYING f-key FROM 1 BY 1 UNTIL f-key > 11 - READ f - AT END - DISPLAY "Failed: EOF" - STOP RUN ERROR - END-READ - - DISPLAY rec-size ": >" f-rec (3:rec-size - 2) "<" - IF rec-size NOT = (22 - f-key) + 1 - DISPLAY "Failed: bad record size - " rec-size - STOP RUN ERROR - END-IF - IF f-x (rec-size - 2) NOT = 1-x (rec-size - 2) - DISPLAY "Failed: bad data - " f-data - STOP RUN ERROR - END-IF - END-PERFORM - CLOSE f - . -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], -[22: >+12345678++12345678+< -21: >+12345678++12345678< -20: >+12345678++1234567< -19: >+12345678++123456< -18: >+12345678++12345< -17: >+12345678++1234< -16: >+12345678++123< -15: >+12345678++12< -14: >+12345678++1< -13: >+12345678++< -12: >+12345678+< -]) - -AT_CLEANUP - - -AT_SETUP([INDEXED file with LOCK MODE EXCLUSIVE]) -AT_KEYWORDS([runfile]) - -## TO-DO: Support INDEXED file sharing/locking. -AT_SKIP_IF([test "$COB_HAS_ISAM" = "no"]) -AT_XFAIL_IF([false]) - -AT_DATA([prog1.cob], [ - identification division. - program-id. prog1. - environment division. - input-output section. - file-control. - select file1 assign disk - organization indexed - record key file1-key - lock mode is exclusive - status is fs. - data division. - file section. - fd file1. - 1 file1-rec. - 2 file1-key pic x. - working-storage section. - 1 fs pic xx. - 1 os-check pic x(7). - 88 os-is-windows-or-dos values 'WINDOWS' 'FREEDOS'. - 78 callee value "./prog2". - 78 callee-wdos value ".\prog2". - procedure division. - open output file1. - close file1. - open input file1. - accept os-check from environment "OS". - if os-check = spaces - accept os-check from environment "OS_NAME". - inspect os-check converting "werfdosin" to "WERFDOSIN". - if os-is-windows-or-dos - call "SYSTEM" using callee-wdos - else - call "SYSTEM" using callee. - close file1. - stop run. -]) -AT_DATA([prog2.cob], [ - identification division. - program-id. prog2. - environment division. - input-output section. - file-control. - select file1 assign disk - organization indexed - record key file1-key - status is fs. - data division. - file section. - fd file1. - 1 file1-rec. - 2 file1-key pic x. - working-storage section. - 1 fs pic xx. - procedure division. - open input file1. - if fs not = "61" - display "FAILED: " fs - close file1 - end-if. - stop run. -]) - -AT_CHECK([$COMPILE prog1.cob], [0], [], []) -AT_CHECK([$COMPILE prog2.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog1], [0]) - -AT_CLEANUP - - -AT_SETUP([INDEXED file with OPEN WITH LOCK]) -AT_KEYWORDS([runfile]) - -## TO-DO: Support INDEXED file sharing/locking. -AT_SKIP_IF([test "$COB_HAS_ISAM" = "no"]) -AT_XFAIL_IF([true]) - -AT_DATA([prog1.cob], [ - identification division. - program-id. prog1. - environment division. - input-output section. - file-control. - select file1 assign disk - organization indexed - record key file1-key - status is fs. - data division. - file section. - fd file1. - 1 file1-rec. - 2 file1-key pic x. - working-storage section. - 1 fs pic xx. - 1 os-check pic x(7). - 88 os-is-windows-or-dos values 'WINDOWS' 'FREEDOS'. - 78 callee value "./prog2". - 78 callee-wdos value ".\prog2". - procedure division. - open output file1. - close file1. - open input file1 with lock. - accept os-check from environment "OS". - if os-check = spaces - accept os-check from environment "OS_NAME". - inspect os-check converting "werfdosin" to "WERFDOSIN". - if os-is-windows-or-dos - call "SYSTEM" using callee-wdos - else - call "SYSTEM" using callee. - close file1. - stop run. -]) -AT_DATA([prog2.cob], [ - identification division. - program-id. prog2. - environment division. - input-output section. - file-control. - select file1 assign disk - organization indexed - record key file1-key - status is fs. - data division. - file section. - fd file1. - 1 file1-rec. - 2 file1-key pic x. - working-storage section. - 1 fs pic xx. - procedure division. - open input file1. - if fs not = "61" - display "FAILED: " fs - close file1 - end-if. - stop run. -]) - -AT_CHECK([$COMPILE prog1.cob], [0], [], []) -AT_CHECK([$COMPILE prog2.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog1], [0]) - -AT_CLEANUP - - -AT_SETUP([INDEXED file with SHARING NO]) -AT_KEYWORDS([runfile]) - -## TO-DO: Support INDEXED file sharing/locking. -AT_SKIP_IF([test "$COB_HAS_ISAM" = "no"]) -AT_XFAIL_IF([false]) - -AT_DATA([prog1.cob], [ - identification division. - program-id. prog1. - environment division. - input-output section. - file-control. - select file1 assign disk - organization indexed - record key file1-key - sharing no - status is fs. - data division. - file section. - fd file1. - 1 file1-rec. - 2 file1-key pic x. - working-storage section. - 1 fs pic xx. - 1 os-check pic x(7). - 88 os-is-windows-or-dos values 'WINDOWS' 'FREEDOS'. - 78 callee value "./prog2". - 78 callee-wdos value ".\prog2". - procedure division. - open output file1. - close file1. - open input file1. - accept os-check from environment "OS". - if os-check = spaces - accept os-check from environment "OS_NAME". - inspect os-check converting "werfdosin" to "WERFDOSIN". - if os-is-windows-or-dos - call "SYSTEM" using callee-wdos - else - call "SYSTEM" using callee. - close file1. - stop run. -]) -AT_DATA([prog2.cob], [ - identification division. - program-id. prog2. - environment division. - input-output section. - file-control. - select file1 assign disk - organization indexed - record key file1-key - status is fs. - data division. - file section. - fd file1. - 1 file1-rec. - 2 file1-key pic x. - working-storage section. - 1 fs pic xx. - procedure division. - open input file1. - if fs not = "61" - display "FAILED: " fs - close file1 - end-if. - stop run. -]) - -AT_CHECK([$COMPILE prog1.cob], [0], [], []) -AT_CHECK([$COMPILE prog2.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog1], [0]) - -AT_CLEANUP - - -AT_SETUP([INDEXED file with SHARING READ ONLY]) -AT_KEYWORDS([runfile]) - -## TO-DO: Support INDEXED file sharing/locking. -AT_SKIP_IF([test "$COB_HAS_ISAM" = "no"]) -AT_XFAIL_IF([false]) - -AT_DATA([prog1.cob], [ - identification division. - program-id. prog1. - environment division. - input-output section. - file-control. - select file1 assign disk - organization indexed - record key file1-key - sharing read only - status is fs. - data division. - file section. - fd file1. - 1 file1-rec. - 2 file1-key pic x. - working-storage section. - 1 fs pic xx. - 1 os-check pic x(7). - 88 os-is-windows-or-dos values 'WINDOWS' 'FREEDOS'. - 78 callee value "./prog2". - 78 callee-wdos value ".\prog2". - procedure division. - open output file1. - close file1. - open input file1. - accept os-check from environment "OS". - if os-check = spaces - accept os-check from environment "OS_NAME". - inspect os-check converting "werfdosin" to "WERFDOSIN". - if os-is-windows-or-dos - call "SYSTEM" using callee-wdos - else - call "SYSTEM" using callee. - close file1. - stop run. -]) -AT_DATA([prog2.cob], [ - identification division. - program-id. prog2. - environment division. - input-output section. - file-control. - select file1 assign disk - organization indexed - record key file1-key - status is fs. - data division. - file section. - fd file1. - 1 file1-rec. - 2 file1-key pic x. - working-storage section. - 1 fs pic xx. - procedure division. - open i-o file1. - if fs not = "61" - display "FAILED: " fs - close file1 - end-if. - open input file1. - if fs not = "00" - display "FAILED: " fs - else - close file1 - end-if. - stop run. -]) - -AT_CHECK([$COMPILE prog1.cob], [0], [], []) -AT_CHECK([$COMPILE prog2.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog1], [0]) - -AT_CLEANUP - - -## Check successor is blocked from exclusive open on file already open. -AT_SETUP([INDEXED file with blocked lock]) -AT_KEYWORDS([runfile]) - -## TO-DO: Support INDEXED file sharing/locking. -AT_SKIP_IF([test "$COB_HAS_ISAM" = "no"]) -AT_XFAIL_IF([true]) - -AT_DATA([prog1.cob], [ - identification division. - program-id. prog1. - environment division. - input-output section. - file-control. - select file1 assign disk - organization indexed - record key file1-key. - data division. - file section. - fd file1. - 1 file1-rec. - 2 file1-key pic x. - working-storage section. - 1 os-check pic x(7). - 88 os-is-windows-or-dos values 'WINDOWS' 'FREEDOS'. - 78 callee value "./prog2". - 78 callee-wdos value ".\prog2". - procedure division. - open output file1. - close file1. - open input file1. - accept os-check from environment "OS". - if os-check = spaces - accept os-check from environment "OS_NAME". - inspect os-check converting "werfdosin" to "WERFDOSIN". - if os-is-windows-or-dos - call "SYSTEM" using callee-wdos - else - call "SYSTEM" using callee. - close file1. - stop run. -]) -AT_DATA([prog2.cob], [ - identification division. - program-id. prog2. - environment division. - input-output section. - file-control. - select file1 assign disk - organization indexed - record key file1-key - status is fs. - data division. - file section. - fd file1. - 1 file1-rec. - 2 file1-key pic x. - working-storage section. - 1 fs pic xx. - procedure division. - open input file1. - if fs not = "00" - display "FAILED: " fs - stop run - end-if. - close file1 - open input file1 with lock. - if fs not = "61" - display "FAILED: " fs - close file1 - end-if. - stop run. -]) - -AT_CHECK([$COMPILE prog1.cob], [0], [], []) -AT_CHECK([$COMPILE prog2.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog1], [0]) - -AT_CLEANUP - -## Try to read locked record -AT_SETUP([INDEXED file with LOCK AUTOMATIC (1)]) -AT_KEYWORDS([runfile]) - -AT_SKIP_IF([test "$COB_HAS_ISAM" = "no"]) -AT_XFAIL_IF([true]) - -AT_DATA([prog1.cob], [ - identification division. - program-id. prog1. - environment division. - input-output section. - file-control. - select file1 assign disk - access mode is random - organization indexed - record key file1-key - lock mode is automatic - status is fs. - data division. - file section. - fd file1. - 1 file1-rec. - 2 file1-key pic x. - working-storage section. - 1 fs pic xx. - 1 os-check pic x(7). - 88 os-is-windows-or-dos values 'WINDOWS' 'FREEDOS'. - 78 callee value "./prog2". - 78 callee-wdos value ".\prog2". - procedure division. - open output file1. - move "X" to file1-key. - write file1-rec. - if fs not = "00" - display "FAILED 1::w fs=" fs. - close file1. - open i-o file1. - move "X" to file1-key. - read file1. - if fs not = "00" - display "FAILED 1::r fs=" fs. - accept os-check from environment "OS". - if os-check = spaces - accept os-check from environment "OS_NAME". - inspect os-check converting "werfdosin" to "WERFDOSIN". - if os-is-windows-or-dos - call "SYSTEM" using callee-wdos - else - call "SYSTEM" using callee. - close file1. - stop run. -]) -AT_DATA([prog2.cob], [ - identification division. - program-id. prog2. - environment division. - input-output section. - file-control. - select file1 assign disk - access mode is random - organization indexed - record key file1-key - lock mode is automatic - status is fs. - data division. - file section. - fd file1. - 1 file1-rec. - 2 file1-key pic x. - working-storage section. - 1 fs pic xx. - procedure division. - open i-o file1. - move "X" to file1-key. - read file1. - if fs not = "61" - display "FAILED 2::r " fs. - close file1 - stop run. -]) - -AT_CHECK([$COMPILE prog1.cob], [0], [], []) -AT_CHECK([$COMPILE prog2.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog1], [0]) - - -AT_CLEANUP - -## Read unlocked record -AT_SETUP([INDEXED file with LOCK AUTOMATIC (2)]) -AT_KEYWORDS([runfile]) - -AT_SKIP_IF([test "$COB_HAS_ISAM" = "no"]) - -AT_DATA([prog1.cob], [ - identification division. - program-id. prog1. - environment division. - input-output section. - file-control. - select file1 assign disk - access mode is random - organization indexed - record key file1-key - lock mode is automatic - status is fs. - data division. - file section. - fd file1. - 1 file1-rec. - 2 file1-key pic x. - working-storage section. - 1 fs pic xx. - 1 os-check pic x(7). - 88 os-is-windows-or-dos values 'WINDOWS' 'FREEDOS'. - 78 callee value "./prog2". - 78 callee-wdos value ".\prog2". - procedure division. - open output file1. - move "X" to file1-key. - write file1-rec. - if fs not = "00" - display "FAILED 1::w fs=" fs. - close file1. - open i-o file1. - move "X" to file1-key. - read file1. - if fs not = "00" - display "FAILED 1::r fs=" fs. - rewrite file1-rec. - if fs not = "00" - display "FAILED 1::rw fs=" fs. - accept os-check from environment "OS". - if os-check = spaces - accept os-check from environment "OS_NAME". - inspect os-check converting "werfdosin" to "WERFDOSIN". - if os-is-windows-or-dos - call "SYSTEM" using callee-wdos - else - call "SYSTEM" using callee. - close file1. - stop run. -]) -AT_DATA([prog2.cob], [ - identification division. - program-id. prog2. - environment division. - input-output section. - file-control. - select file1 assign disk - access mode is random - organization indexed - record key file1-key - status is fs. - data division. - file section. - fd file1. - 1 file1-rec. - 2 file1-key pic x. - working-storage section. - 1 fs pic xx. - procedure division. - open input file1. - move "X" to file1-key. - read file1. - if fs not = "00" - display "FAILED 2::r " fs - end-if. - close file1 - stop run. -]) - -AT_CHECK([$COMPILE prog1.cob], [0], [], []) -AT_CHECK([$COMPILE prog2.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog1], [0]) - -AT_CLEANUP - - -AT_SETUP([INDEXED file with LOCK MANUAL]) -AT_KEYWORDS([runfile]) - -AT_SKIP_IF([test "$COB_HAS_ISAM" = "no"]) - -AT_DATA([prog1.cob], [ - identification division. - program-id. prog1. - environment division. - input-output section. - file-control. - select file1 assign disk - access mode is random - organization indexed - record key file1-key - lock mode is manual - status is fs. - data division. - file section. - fd file1. - 1 file1-rec. - 2 file1-key pic x. - working-storage section. - 1 fs pic xx. - 1 os-check pic x(7). - 88 os-is-windows-or-dos values 'WINDOWS' 'FREEDOS'. - 78 callee value "./prog2". - 78 callee-wdos value ".\prog2". - procedure division. - open output file1. - move "X" to file1-key. - write file1-rec. - if fs not = "00" - display "FAILED 1::w fs=" fs. - close file1. - open i-o file1. - move "X" to file1-key. - read file1 with lock. - if fs not = "00" - display "FAILED 1::r fs=" fs. - accept os-check from environment "OS". - if os-check = spaces - accept os-check from environment "OS_NAME". - inspect os-check converting "werfdosin" to "WERFDOSIN". - if os-is-windows-or-dos - call "SYSTEM" using callee-wdos - else - call "SYSTEM" using callee. - close file1. - stop run. -]) -AT_DATA([prog2.cob], [ - identification division. - program-id. prog2. - environment division. - input-output section. - file-control. - select file1 assign disk - access mode is random - organization indexed - record key file1-key - status is fs. - data division. - file section. - fd file1. - 1 file1-rec. - 2 file1-key pic x. - working-storage section. - 1 fs pic xx. - procedure division. - open i-o file1. - if fs not = "61" - display "FAILED 2::r " fs - end-if. - move "X" to file1-key. - read file1. - close file1 - stop run. -]) - -AT_CHECK([$COMPILE prog1.cob], [0], [], []) -AT_CHECK([$COMPILE prog2.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog1], [0]) - -AT_CLEANUP - - -AT_SETUP([START INDEXED]) -AT_KEYWORDS([runfile]) - -AT_SKIP_IF([test "$COB_HAS_ISAM" = "no"]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - INPUT-OUTPUT SECTION. - FILE-CONTROL. - SELECT file1 ASSIGN TO "./file1X" - ORGANIZATION INDEXED - ACCESS DYNAMIC RECORD KEY file1-key. - DATA DIVISION. - FILE SECTION. - FD file1. - 1 file1-rec. - 2 file1-key pic 999. - 2 file1-data pic 999. - PROCEDURE DIVISION. - OPEN OUTPUT file1. - CLOSE file1. - OPEN I-O file1. - MOVE 10 TO file1-key file1-data. - WRITE file1-rec. - MOVE 11 TO file1-key file1-data. - WRITE file1-rec. - MOVE 12 TO file1-key file1-data. - WRITE file1-rec. - MOVE 13 TO file1-key file1-data. - WRITE file1-rec. - * - MOVE 0 TO file1-key. - START file1 KEY > file1-key. - READ file1 NEXT. - IF (file1-data <> 10) - DISPLAY "FAILED: START key > 0". - * - MOVE 99 TO file1-key. - START file1 KEY < file1-key. - READ file1 NEXT. - IF (file1-data <> 13) - DISPLAY "FAILED: START key < 99". - * - MOVE 999 TO file1-key. - START file1 FIRST. - READ file1 NEXT. - IF (file1-data <> 10) - DISPLAY "FAILED: START key FIRST". - * - MOVE 0 TO file1-key. - START file1 LAST. - READ file1 NEXT. - IF (file1-data <> 13) - DISPLAY "FAILED: START key LAST". - * - MOVE 0 TO file1-key. - START file1 KEY >= file1-key. - READ file1 NEXT. - IF (file1-data <> 10) - DISPLAY "FAILED: START key >= 0". - * - MOVE 99 TO file1-key. - START file1 KEY <= file1-key. - READ file1 NEXT. - IF (file1-data <> 13) - DISPLAY "FAILED: START key <= 99". - - CLOSE file1. - STOP RUN. -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0]) - -AT_CLEANUP - - -AT_SETUP([INDEXED partial keys]) -AT_KEYWORDS([runfile]) - -AT_SKIP_IF([test "$COB_HAS_ISAM" = "no"]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - - ENVIRONMENT DIVISION. - INPUT-OUTPUT SECTION. - FILE-CONTROL. - SELECT OPTIONAL f ASSIGN "fileX" - ORGANIZATION INDEXED - ACCESS DYNAMIC - RECORD KEY f-key1 - ALTERNATE RECORD f-key2 - ALTERNATE RECORD f-key3 DUPLICATES - STATUS f-status. - - DATA DIVISION. - FILE SECTION. - FD f. - 01 f-rec. - 02 f-key1. - 03 f-key1-1 PIC X(3). - 03 f-key1-2 PIC X(3). - 02 f-key2. - 03 f-key2-1 PIC X(3). - 03 f-key2-2 PIC X(3). - 02 f-key3. - 03 f-key3-1 PIC X(3). - 03 f-key3-2 PIC X(3). - 02 file1-serial PIC 99. - - WORKING-STORAGE SECTION. - 01 f-status PIC XX. - 01 w-serial PIC 99 VALUE 0. - - PROCEDURE DIVISION. - DELETE FILE f - OPEN I-O f - MOVE "AAAAAAaaaaaaXX----" TO f-rec - PERFORM write-f - MOVE "AAAAABaaaaabXX----" TO f-rec - PERFORM write-f - MOVE "AAAABBaaaabbXX----" TO f-rec - PERFORM write-f - MOVE "AAABBBaaabbbXXX---" TO f-rec - PERFORM write-f - MOVE "AABBBBaabbbbXXX---" TO f-rec - PERFORM write-f - MOVE "ABBBBBabbbbbXXX---" TO f-rec - PERFORM write-f - MOVE "BBBBBBbbbbbbXXX---" TO f-rec - PERFORM write-f - - MOVE "AAB" TO f-key1-1 - MOVE "~~~" TO f-key1-2 - START f KEY = f-key1-1 - READ f NEXT - IF (f-status <> "00") OR - (file1-serial <> 4) - DISPLAY "FAILED 1: status " f-status - END-IF - - MOVE "AAB" TO f-key1-1 - MOVE "~~~" TO f-key1-2 - START f KEY < f-key1-1 - READ f PREVIOUS - IF (f-status <> "00") OR - (file1-serial <> 3) - DISPLAY "FAILED 2: status " f-status - END-IF - - MOVE "AAA" TO f-key1-1 - MOVE "~~~" TO f-key1-2 - START f KEY > f-key1-1 - READ f NEXT - IF (f-status <> "00") OR - (file1-serial <> 4) - DISPLAY "FAILED 3: status " f-status - "serial: " file1-serial - END-IF - - MOVE "aab" TO f-key2-1 - MOVE "~~~" TO f-key2-2 - START f KEY = f-key2-1 - READ f NEXT - IF (f-status <> "00") OR - (file1-serial <> 4) - DISPLAY "FAILED 4: status " f-status - "serial: " file1-serial - END-IF - - MOVE "aab" TO f-key2-1 - MOVE "~~~" TO f-key2-2 - START f KEY < f-key2-1 - READ f PREVIOUS - IF (f-status <> "00") OR - (file1-serial <> 3) - DISPLAY "FAILED 5: status " f-status - "serial: " file1-serial - END-IF - - MOVE "aaa" TO f-key2-1 - MOVE "~~~" TO f-key2-2 - START f KEY > f-key2-1 - READ f NEXT - IF (f-status <> "00") OR - (file1-serial <> 4) - DISPLAY "FAILED 6: status " f-status - "serial: " file1-serial - END-IF - - MOVE "XX-" TO f-key3-1 - START f KEY > f-key3-1 - READ f NEXT - * Not yet implemented: Return file-status "02" if duplicates exist - * IF (f-status <> "02") OR - IF (f-status <> "00") OR - (file1-serial <> 3) - DISPLAY "FAILED 7: status " f-status - "serial: " file1-serial - END-IF - CLOSE f - STOP RUN - . - write-f. - MOVE w-serial TO file1-serial - WRITE f-rec - ADD 1 TO w-serial - . -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0]) - -AT_CLEANUP - - -# Write records to a file with 3 keys declared. Check files with a subset of the -# keys can access file and that a record added by such files gets indexed for -# the 2nd and 3rd keys. -AT_SETUP([INDEXED undeclared keys]) -AT_KEYWORDS([runfile]) - -AT_SKIP_IF([test "$COB_HAS_ISAM" = "no"]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - INPUT-OUTPUT SECTION. - FILE-CONTROL. - SELECT file1 ASSIGN TO "./fileX" - ORGANIZATION INDEXED - ACCESS RANDOM - RECORD KEY file1-key1 - ALTERNATE RECORD KEY file1-key2 - ALTERNATE RECORD KEY file1-key3. - SELECT file2 ASSIGN TO "./fileX" - ORGANIZATION INDEXED - ACCESS RANDOM - RECORD KEY file2-key1 - ALTERNATE RECORD KEY file2-key2. - SELECT file3 ASSIGN TO "./fileX" - ORGANIZATION INDEXED - ACCESS RANDOM - RECORD KEY file3-key1. - DATA DIVISION. - FILE SECTION. - FD file1. - 1 file1-rec. - 2 file1-key1 pic 999. - 2 file1-key2 pic 999. - 2 file1-key3 pic 999. - 2 file1-data pic 999. - FD file2. - 1 file2-rec. - 2 file2-key1 pic 999. - 2 file2-key2 pic 999. - 2 file2-key3 pic 999. - 2 file2-data pic 999. - FD file3. - 1 file3-rec. - 2 file3-key1 pic 999. - 2 file3-key2 pic 999. - 2 file3-key3 pic 999. - 2 file3-data pic 999. - WORKING-STORAGE SECTION. - 77 ix pic 9(6). - PROCEDURE DIVISION. - OPEN OUTPUT file1. - PERFORM VARYING ix FROM 1 BY 1 - UNTIL ix > 10 - MOVE ix TO file1-key1 file1-data - ADD 100 TO ix GIVING file1-key2 - ADD 200 TO ix GIVING file1-key3 - WRITE file1-rec - END-PERFORM. - CLOSE file1. - * - OPEN INPUT file1. - PERFORM VARYING ix FROM 1 BY 1 - UNTIL ix > 10 - MOVE ix TO file1-key1 - READ file1 KEY file1-key1 - IF (file1-data <> ix) - DISPLAY "FAILED 1-1" - END-IF - END-PERFORM. - PERFORM VARYING ix FROM 1 BY 1 - UNTIL ix > 10 - ADD 100 TO ix GIVING file1-key2 - READ file1 KEY file1-key2 - IF (file1-data <> ix) - DISPLAY "FAILED 1-2" - END-IF - END-PERFORM. - PERFORM VARYING ix FROM 1 BY 1 - UNTIL ix > 10 - ADD 200 TO ix GIVING file1-key3 - READ file1 KEY file1-key3 - IF (file1-data <> ix) - DISPLAY "FAILED 1-3" - END-IF - END-PERFORM. - CLOSE file1. - * - OPEN INPUT file2. - PERFORM VARYING ix FROM 1 BY 1 - UNTIL ix > 10 - MOVE ix TO file2-key1 - READ file2 KEY file2-key1 - IF (file2-data <> ix) - DISPLAY "FAILED 2-1" - END-IF - END-PERFORM. - PERFORM VARYING ix FROM 1 BY 1 - UNTIL ix > 10 - ADD 100 TO ix GIVING file2-key2 - READ file2 KEY file2-key2 - IF (file2-data <> ix) - DISPLAY "FAILED 2-2" - END-IF - END-PERFORM. - CLOSE file2. - * - OPEN INPUT file3. - PERFORM VARYING ix FROM 1 BY 1 - UNTIL ix > 10 - MOVE ix TO file3-key1 - READ file3 KEY file3-key1 - IF (file3-data <> ix) - DISPLAY "FAILED 3-1" - END-IF - END-PERFORM. - CLOSE file3. - * - * Insert rec via file with only 1 index declared - OPEN I-O file3. - MOVE 20 TO ix. - MOVE ix TO file3-key1 file3-data - ADD 100 TO ix GIVING file3-key2 - ADD 200 TO ix GIVING file3-key3 - WRITE file3-rec - CLOSE file3 - * - * Check new rec is visible in other files - OPEN INPUT file1. - MOVE 10 TO file1-key1. - READ file1 KEY file1-key1. - IF (file1-data <> 10) - DISPLAY "FAILED 1-4". - MOVE SPACES TO file1-rec. - MOVE 110 TO file1-key2. - READ file1 KEY file1-key2. - IF (file1-data <> 10) - DISPLAY "FAILED 1-5". - MOVE SPACES TO file1-rec. - MOVE 210 TO file1-key3. - READ file1 KEY file1-key3. - IF (file1-data <> 10) - DISPLAY "FAILED 1-6". - CLOSE file1. - * - OPEN INPUT file2. - MOVE 10 TO file2-key1. - READ file2 KEY file2-key1. - IF (file2-data <> 10) - DISPLAY "FAILED 2-3". - MOVE SPACES TO file2-rec. - MOVE 110 TO file2-key2. - READ file2 KEY file2-key2. - IF (file2-data <> 10) - DISPLAY "FAILED 2-4". - CLOSE file2. - STOP RUN. -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([export IX_OPTIONS='keycheck=off' -$COBCRUN_DIRECT ./prog], [0], [], []) - -AT_CLEANUP - - -AT_SETUP([READ INPUT pipe & WRITE OUTPUT pipe]) -AT_KEYWORDS([runfile]) - -AT_DATA([test-data-in], -[NAME -STREET -TOWN -COUNTRY -]) - -AT_DATA([provider], [ -cat $1 -]) - -AT_DATA([consumer], [ -cat -]) - -AT_DATA([prog.cob], [ - identification division. - program-id. prog. - environment division. - configuration section. - input-output section. - file-control. - select pipe-in - organization line sequential - access sequential - assign to w-command - status is f-status. - select pipe-out - organization line sequential - access sequential - assign to w-command - status is f-status. - data division. - file section. - fd pipe-in. - 1 pipe-msg-in pic x(132). - fd pipe-out. - 1 pipe-msg-out pic x(132). - working-storage section. - 77 f-status pic xx. - 88 f-status-ok value "00". - 77 w-command pic x(100). - procedure division. - move "< sh ./provider ./test-data-in" - to w-command. - open input pipe-in. - if not f-status-ok - display "FAILED: OPEN INPUT" - stop run - end-if. - move "> sh ./consumer > ./test-data-out" - to w-command. - open output pipe-out. - if not f-status-ok - display "FAILED: OPEN OUTPUT" - stop run - end-if. - perform until not f-status-ok - read pipe-in - if f-status-ok - perform x01-100-map - write pipe-msg-out - end-if - end-perform. - close pipe-in. - close pipe-out. - stop run. - * - x01-100-map. - move "*** Jacques Tati ***" to pipe-msg-out. - if (pipe-msg-in = "COUNTRY") - move "Country: FRANCE" to pipe-msg-out. - if (pipe-msg-in = "TOWN") - move "Town: DEAUVILLE" to pipe-msg-out. - if (pipe-msg-in = "NAME") - move "Name: M. Hulot" to pipe-msg-out. - if (pipe-msg-in = "STREET") - move "Street: Rue des Anglais" to pipe-msg-out. -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0]) -AT_CHECK([cat test-data-out], [0], -[Name: M. Hulot -Street: Rue des Anglais -Town: DEAUVILLE -Country: FRANCE -]) - -AT_CLEANUP - - -AT_SETUP([EXTFH: using ISAM callback]) -AT_KEYWORDS([runfile EXTFH]) - -AT_SKIP_IF([test "$COB_HAS_ISAM" = "no"]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - - ENVIRONMENT DIVISION. - CONFIGURATION SECTION. - - INPUT-OUTPUT SECTION. - FILE-CONTROL. - SELECT OPTIONAL TSPFILE - ASSIGN TO "testisam" - ORGANIZATION INDEXED ACCESS DYNAMIC - RECORD KEY IS CM-CUST-NUM - ALTERNATE RECORD KEY IS CM-TELEPHONE WITH DUPLICATES - ALTERNATE RECORD KEY IS CM-DISK WITH DUPLICATES - FILE STATUS IS CUST-STAT . - - SELECT TSTFILE - ASSIGN TO "testisam" - ORGANIZATION INDEXED ACCESS DYNAMIC - RECORD KEY IS TS-CUST-NUM - ALTERNATE RECORD KEY IS TS-TELEPHONE WITH DUPLICATES - ALTERNATE RECORD KEY IS TS-DISK WITH DUPLICATES - FILE STATUS IS CUST-STAT . - - SELECT FLATFILE ASSIGN EXTERNAL RELFIX - ORGANIZATION RELATIVE - ACCESS IS RANDOM RELATIVE KEY IS REC-NUM - FILE STATUS IS CUST-STAT. - - DATA DIVISION. - FILE SECTION. - FD TSPFILE - BLOCK CONTAINS 5 RECORDS. - - 01 TSPFL-RECORD. - 05 TSPFL-REC. - 10 CM-CUST-NUM. - 15 CM-CUST-PRE PICTURE X(3). - 15 CM-CUST-NNN PICTURE X(5). - 10 CM-STATUS PICTURE X. - 10 CM-COMPANY PICTURE X(25). - 10 CM-ADDRESS-1 PICTURE X(25). - 10 CM-ADDRESS-2 PICTURE X(25). - 10 CM-ADDRESS-3 PICTURE X(25). - 10 CM-TELEPHONE PICTURE 9(10). - 10 CM-DP-MGR PICTURE X(25). - 10 CM-MACHINE PICTURE X(8). - 10 CM-MEMORY PICTURE X(4). - 10 CM-DISK PICTURE X(8). - 10 CM-TAPE PICTURE X(8). - 10 CM-NO-TERMINALS PICTURE 9(5). - - FD TSTFILE - BLOCK CONTAINS 5 RECORDS. - - 01 TSTFL-RECORD. - 05 TSTFL-REC. - 10 TS-CUST-NUM PICTURE X(8). - 10 TS-STATUS PICTURE X. - 10 TS-COMPANY PICTURE X(25). - 10 TS-ADDRESS-1 PICTURE X(25). - 10 TS-ADDRESS-2 PICTURE X(25). - 10 TS-ADDRESS-3 PICTURE X(25). - 10 TS-TELEPHONE PICTURE 9(10). - 10 TS-DP-MGR PICTURE X(25). - 10 TS-MACHINE PICTURE X(8). - 10 TS-MEMORY PICTURE X(4). - 10 TS-DISK PICTURE X(8). - 10 TS-TAPE PICTURE X(8). - - FD FLATFILE - BLOCK CONTAINS 5 RECORDS. - - 01 TSP2-RECORD. - 10 C2-CUST-NUM PICTURE X(8). - 10 C2-COMPANY PICTURE X(25). - 10 C2-DISK PICTURE X(8). - 10 C2-NO-TERMINALS PICTURE 9(4) COMP-4. - 10 C2-PK-DATE PICTURE S9(14) COMP-3. - - WORKING-STORAGE SECTION. - - 01 CUST-STAT. - 05 FILLER PICTURE XX. - 77 MAX-SUB VALUE 16 PICTURE 9(5) COMP SYNC. - - 01 TEST-DATA. - - 02 DATA-CUST-NUM-TBL. - - 05 FILLER PIC X(8) VALUE "ALP00000". - 05 FILLER PIC X(8) VALUE "BET00000". - 05 FILLER PIC X(8) VALUE "GAM00000". - 05 FILLER PIC X(8) VALUE "DEL00000". - 05 FILLER PIC X(8) VALUE "EPS00000". - 05 FILLER PIC X(8) VALUE "FOR00000". - 05 FILLER PIC X(8) VALUE "GIB00000". - 05 FILLER PIC X(8) VALUE "H&J00000". - 05 FILLER PIC X(8) VALUE "INC00000". - 05 FILLER PIC X(8) VALUE "JOH00000". - 05 FILLER PIC X(8) VALUE "KON00000". - 05 FILLER PIC X(8) VALUE "LEW00000". - 05 FILLER PIC X(8) VALUE "MOR00000". - 05 FILLER PIC X(8) VALUE "NEW00000". - 05 FILLER PIC X(8) VALUE "OLD00000". - 05 FILLER PIC X(8) VALUE "PRE00000". - - 02 DATA-CUST-NUM REDEFINES DATA-CUST-NUM-TBL - PIC X(8) OCCURS 16. - 02 DATA-COMPANY-TBL. - - 05 FILLER PIC X(25) VALUE "ALPHA ELECTRICAL CO. LTD.". - 05 FILLER PIC X(25) VALUE "BETA SHOE MFG. INC. ". - 05 FILLER PIC X(25) VALUE "GAMMA X-RAY TECHNOLOGY ". - 05 FILLER PIC X(25) VALUE "DELTA LUGGAGE REPAIRS ". - 05 FILLER PIC X(25) VALUE "EPSILON EQUIPMENT SUPPLY ". - 05 FILLER PIC X(25) VALUE "FORTUNE COOKIE COMPANY ". - 05 FILLER PIC X(25) VALUE "GIBRALTER LIFE INSURANCE ". - 05 FILLER PIC X(25) VALUE "H & J PLUMBING SUPPLIES ". - 05 FILLER PIC X(25) VALUE "INCREMENTAL BACKUP CORP. ". - 05 FILLER PIC X(25) VALUE "JOHNSON BOATING SUPPLIES ". - 05 FILLER PIC X(25) VALUE "KONFLAB PLASTIC PRODUCTS.". - 05 FILLER PIC X(25) VALUE "LEWISTON GRAPHICS LTD. ". - 05 FILLER PIC X(25) VALUE "MORNINGSIDE CARPENTRY. ". - 05 FILLER PIC X(25) VALUE "NEW WAVE SURF SHOPS INC. ". - 05 FILLER PIC X(25) VALUE "OLD TYME PIZZA MFG. CO. ". - 05 FILLER PIC X(25) VALUE "PRESTIGE OFFICE FURNITURE". - - 02 DATA-COMPANY REDEFINES DATA-COMPANY-TBL - PIC X(25) OCCURS 16. - 02 DATA-ADDRESS-1-TBL. - - 05 FILLER PIC X(25) VALUE "123 MAIN STREET ". - 05 FILLER PIC X(25) VALUE "1090 2ND AVE. WEST ". - 05 FILLER PIC X(25) VALUE "1401 JEFFERSON BLVD. ". - 05 FILLER PIC X(25) VALUE "1620 ARIZONA WAY ". - 05 FILLER PIC X(25) VALUE "1184 EAST FIRST STREET ". - 05 FILLER PIC X(25) VALUE "114 JOHN F. KENNEDY AVE. ". - 05 FILLER PIC X(25) VALUE "650 LIBERTY CRESCENT ". - 05 FILLER PIC X(25) VALUE "77 SUNSET BLVD. ". - 05 FILLER PIC X(25) VALUE "10908 SANTA MONICA BLVD. ". - 05 FILLER PIC X(25) VALUE "1134 PARIS ROAD ". - 05 FILLER PIC X(25) VALUE "808 NORTHWEST MAIN ST. ". - 05 FILLER PIC X(25) VALUE "9904 QUEEN STREET ". - 05 FILLER PIC X(25) VALUE "1709 DUNDAS CRESCENT W. ". - 05 FILLER PIC X(25) VALUE "3240 MARIS AVENUE ". - 05 FILLER PIC X(25) VALUE "1705 WISCONSIN ROAD ". - 05 FILLER PIC X(25) VALUE "114A MAPLE GROVE ". - - 02 DATA-ADDRESS-1 REDEFINES DATA-ADDRESS-1-TBL - PIC X(25) OCCURS 16. - 02 DATA-ADDRESS-2-TBL. - - 05 FILLER PIC X(10) VALUE "NEW YORK ". - 05 FILLER PIC X(10) VALUE "ATLANTA ". - 05 FILLER PIC X(10) VALUE "WASHINGTON". - 05 FILLER PIC X(10) VALUE "TORONTO ". - 05 FILLER PIC X(10) VALUE "CALGARY ". - 05 FILLER PIC X(10) VALUE "SAN DIEGO ". - 05 FILLER PIC X(10) VALUE "LOS RIOS ". - 05 FILLER PIC X(10) VALUE "MADISON ". - 05 FILLER PIC X(10) VALUE "WILBUR ". - 05 FILLER PIC X(10) VALUE "TOPEKA ". - 05 FILLER PIC X(10) VALUE "SEATTLE ". - 05 FILLER PIC X(10) VALUE "NEW JERSEY". - 05 FILLER PIC X(10) VALUE "FORT WAYNE". - 05 FILLER PIC X(10) VALUE "COLUMBUS ". - 05 FILLER PIC X(10) VALUE "RICHMOND ". - 05 FILLER PIC X(10) VALUE "WHITEPLAIN". - - 02 DATA-ADDRESS-2 REDEFINES DATA-ADDRESS-2-TBL - PIC X(10) OCCURS 16. - 02 DATA-ADDRESS-3-TBL. - - 05 FILLER PIC X(10) VALUE "N.Y. ". - 05 FILLER PIC X(10) VALUE "GEORGIA ". - 05 FILLER PIC X(10) VALUE "D.C. ". - 05 FILLER PIC X(10) VALUE "CANADA ". - 05 FILLER PIC X(10) VALUE "CANADA ". - 05 FILLER PIC X(10) VALUE "CALIFORNIA". - 05 FILLER PIC X(10) VALUE "NEW MEXICO". - 05 FILLER PIC X(10) VALUE "WISCONSIN ". - 05 FILLER PIC X(10) VALUE "DELAWARE ". - 05 FILLER PIC X(10) VALUE "KANSAS ". - 05 FILLER PIC X(10) VALUE "WASHINGTON". - 05 FILLER PIC X(10) VALUE "N.J. ". - 05 FILLER PIC X(10) VALUE "COLORADO ". - 05 FILLER PIC X(10) VALUE "OHIO ". - 05 FILLER PIC X(10) VALUE "VIRGINIA ". - 05 FILLER PIC X(10) VALUE "N.Y. ". - - 02 DATA-ADDRESS-3 REDEFINES DATA-ADDRESS-3-TBL - PIC X(10) OCCURS 16. - 02 DATA-TELEPHONE-TBL. - - 05 FILLER PIC 9(10) VALUE 3131234432. - 05 FILLER PIC 9(10) VALUE 4082938498. - 05 FILLER PIC 9(10) VALUE 8372487274. - 05 FILLER PIC 9(10) VALUE 4169898509. - 05 FILLER PIC 9(10) VALUE 5292398745. - 05 FILLER PIC 9(10) VALUE 8009329492. - 05 FILLER PIC 9(10) VALUE 6456445643. - 05 FILLER PIC 9(10) VALUE 6546456333. - 05 FILLER PIC 9(10) VALUE 3455445444. - 05 FILLER PIC 9(10) VALUE 6456445643. - 05 FILLER PIC 9(10) VALUE 7456434355. - 05 FILLER PIC 9(10) VALUE 6554456433. - 05 FILLER PIC 9(10) VALUE 4169898509. - 05 FILLER PIC 9(10) VALUE 7534587453. - 05 FILLER PIC 9(10) VALUE 8787458374. - 05 FILLER PIC 9(10) VALUE 4169898509. - - 02 DATA-TELEPHONE REDEFINES DATA-TELEPHONE-TBL - PIC 9(10) OCCURS 16. - 02 DATA-DP-MGR-TBL. - - 05 FILLER PIC X(20) VALUE "MR. DAVE HARRIS ". - 05 FILLER PIC X(20) VALUE "MS. JANICE SILCOX ". - 05 FILLER PIC X(20) VALUE "MR. ALLAN JONES ". - 05 FILLER PIC X(20) VALUE "MR. PETER MACKAY ". - 05 FILLER PIC X(20) VALUE "MRS. DONNA BREWER ". - 05 FILLER PIC X(20) VALUE "MR. MICHAEL SMYTHE ". - 05 FILLER PIC X(20) VALUE "MR. D.A. MORRISON ". - 05 FILLER PIC X(20) VALUE "MR. BRIAN PATTERSON ". - 05 FILLER PIC X(20) VALUE "MR. DARRYL TOWNSEND ". - 05 FILLER PIC X(20) VALUE "MS. VALERIE HARPER ". - 05 FILLER PIC X(20) VALUE "MR. FRED MILLER ". - 05 FILLER PIC X(20) VALUE "MR. DONALD FISCHER ". - 05 FILLER PIC X(20) VALUE "MR. STEVEN YOURDIN ". - 05 FILLER PIC X(20) VALUE "MS. Goldie Hawn ". - 05 FILLER PIC X(20) VALUE "MS. ALICE WINSTON ". - 05 FILLER PIC X(20) VALUE "MR. THOMAS JEFFERSON". - - 02 DATA-DP-MGR REDEFINES DATA-DP-MGR-TBL - PIC X(20) OCCURS 16. - 02 DATA-MACHINE-TBL. - - 05 FILLER PIC X(8) VALUE "UNI-9030". - 05 FILLER PIC X(8) VALUE "UNI-9040". - 05 FILLER PIC X(8) VALUE "UNI-80/3". - 05 FILLER PIC X(8) VALUE "UNI-80/5". - 05 FILLER PIC X(8) VALUE "UNI-80/6". - 05 FILLER PIC X(8) VALUE "UNI-80/6". - 05 FILLER PIC X(8) VALUE "UNI-80/6". - 05 FILLER PIC X(8) VALUE "UNI-80/8". - 05 FILLER PIC X(8) VALUE "UNI-80/8". - 05 FILLER PIC X(8) VALUE "UNI-80/8". - 05 FILLER PIC X(8) VALUE "UNI-80/8". - 05 FILLER PIC X(8) VALUE "UNI-80/8". - 05 FILLER PIC X(8) VALUE "UNI-80/8". - 05 FILLER PIC X(8) VALUE "UNI-80/8". - 05 FILLER PIC X(8) VALUE "UNI-9040". - 05 FILLER PIC X(8) VALUE "UNI-9040". - - 02 DATA-MACHINE REDEFINES DATA-MACHINE-TBL - PIC X(8) OCCURS 16. - 02 DATA-NO-TERMINALS-TBL. - - 05 FILLER PIC 9(3) COMP-3 VALUE 85. - 05 FILLER PIC 9(3) COMP-3 VALUE 34. - 05 FILLER PIC 9(3) COMP-3 VALUE 75. - 05 FILLER PIC 9(3) COMP-3 VALUE 45. - 05 FILLER PIC 9(3) COMP-3 VALUE 90. - 05 FILLER PIC 9(3) COMP-3 VALUE 107. - 05 FILLER PIC 9(3) COMP-3 VALUE 67. - 05 FILLER PIC 9(3) COMP-3 VALUE 32. - 05 FILLER PIC 9(3) COMP-3 VALUE 16. - 05 FILLER PIC 9(3) COMP-3 VALUE 34. - 05 FILLER PIC 9(3) COMP-3 VALUE 128. - 05 FILLER PIC 9(3) COMP-3 VALUE 64. - 05 FILLER PIC 9(3) COMP-3 VALUE 110. - 05 FILLER PIC 9(3) COMP-3 VALUE 324. - 05 FILLER PIC 9(3) COMP-3 VALUE 124. - 05 FILLER PIC 9(3) COMP-3 VALUE 86. - - 02 DATA-NO-TERMINALS REDEFINES DATA-NO-TERMINALS-TBL - PIC 9(3) COMP-3 OCCURS 16. - - 01 WORK-AREA. - 05 REC-NUM PICTURE 9(6) VALUE 0. - 05 REC-MAX PICTURE 9(6) VALUE 10. - 05 SUB PICTURE 9(4) COMP SYNC. - 88 ODD-RECORD VALUE 1 3 5 7 9 10 11. - - 05 TSPFL-KEY PICTURE X(8). - - PROCEDURE DIVISION. - - MAINFILE. - OPEN OUTPUT TSPFILE - CLOSE TSPFILE. - - OPEN I-O TSPFILE - MOVE '99' TO CUST-STAT - READ TSPFILE NEXT RECORD WITH NO LOCK - IF CUST-STAT NOT = "10" - DISPLAY "Error " CUST-STAT " on read of empty file" - UPON CONSOLE - STOP RUN - END-IF. - MOVE LOW-VALUES TO TSPFL-RECORD. - START TSPFILE KEY GREATER THAN CM-CUST-NUM - IF CUST-STAT NOT = "23" - DISPLAY "Error " CUST-STAT " starting empty file" - UPON CONSOLE - STOP RUN - END-IF. - READ TSPFILE NEXT RECORD WITH NO LOCK - IF CUST-STAT NOT = "46" - DISPLAY "Error " CUST-STAT " start/read of empty file" - UPON CONSOLE - STOP RUN - END-IF. - DISPLAY "OK: Operations on empty file" - CLOSE TSPFILE. - - PERFORM LOADFILE. - PERFORM LISTFILE. - OPEN INPUT TSTFILE - IF CUST-STAT NOT = "00" - DISPLAY "Expected ERROR " CUST-STAT - " opening TSTFILE, Record size different" - UPON CONSOLE - ELSE - DISPLAY "Un-Expected open TSTFILE, Record size different" - UPON CONSOLE - CLOSE TSTFILE - END-IF. - PERFORM LOADFLAT. - STOP RUN. - - LOADFILE. - DISPLAY "Loading sample data file." - UPON CONSOLE. - - OPEN OUTPUT TSPFILE - IF CUST-STAT NOT = "00" - DISPLAY "Error " CUST-STAT - " opening 'testisam' file" UPON CONSOLE - STOP RUN - END-IF. - - PERFORM 1000-LOAD-RECORD - VARYING SUB FROM 1 BY 1 - UNTIL SUB > MAX-SUB. - - DISPLAY "Sample data file load complete." - UPON CONSOLE. - CLOSE TSPFILE. - - *---------------------------------------------------------------* - * LOAD A RECORD FROM DATA TABLES * - *---------------------------------------------------------------* - - 1000-LOAD-RECORD. - - MOVE SPACES TO TSPFL-RECORD. - MOVE DATA-CUST-NUM (SUB) TO CM-CUST-NUM. - MOVE CM-CUST-NUM TO TSPFL-KEY. - MOVE DATA-COMPANY (SUB) TO CM-COMPANY. - MOVE DATA-ADDRESS-1 (SUB) TO CM-ADDRESS-1. - MOVE DATA-ADDRESS-2 (SUB) TO CM-ADDRESS-2. - MOVE DATA-ADDRESS-3 (SUB) TO CM-ADDRESS-3. - MOVE DATA-TELEPHONE (SUB) TO CM-TELEPHONE. - MOVE DATA-DP-MGR (SUB) TO CM-DP-MGR. - MOVE DATA-MACHINE (SUB) TO CM-MACHINE. - MOVE DATA-NO-TERMINALS (SUB) TO CM-NO-TERMINALS. - - IF ODD-RECORD - MOVE "8417" TO CM-DISK - MOVE "1600 BPI" TO CM-TAPE - MOVE "1MEG" TO CM-MEMORY - ELSE - MOVE "8470" TO CM-DISK - MOVE "6250 BPI" TO CM-TAPE - MOVE "3MEG" TO CM-MEMORY. - - WRITE TSPFL-RECORD. - IF CUST-STAT NOT = "00" - AND CUST-STAT NOT = "02" - DISPLAY "Load - Key: " TSPFL-KEY ", Status: " CUST-STAT - UPON CONSOLE. - - LISTFILE. - DISPLAY "LIST SAMPLE FILE" UPON CONSOLE. - OPEN INPUT TSTFILE - MOVE SPACES TO TSTFL-RECORD. - MOVE "PRE00000" TO CM-CUST-NUM. - START TSTFILE KEY GREATER THAN OR EQUAL TO TS-CUST-NUM - READ TSTFILE NEXT RECORD - READ TSTFILE NEXT RECORD - CLOSE TSTFILE. - - MOVE ZERO TO REC-NUM - OPEN INPUT TSPFILE - IF CUST-STAT NOT = "00" - DISPLAY "ERROR " CUST-STAT " OPENING INPUT FILE" - UPON CONSOLE - STOP RUN - END-IF. - MOVE SPACES TO TSPFL-RECORD. - MOVE "PRE00000" TO CM-CUST-NUM. - START TSPFILE KEY GREATER THAN OR EQUAL TO CM-CUST-NUM - READ TSPFILE NEXT RECORD - READ TSPFILE NEXT RECORD - - MOVE SPACES TO TSPFL-RECORD. - MOVE "DEL00000" TO CM-CUST-NUM. - START TSPFILE KEY GREATER THAN CM-CUST-NUM - IF CUST-STAT NOT = "00" - DISPLAY "Error " CUST-STAT " starting file" - UPON CONSOLE - STOP RUN - END-IF. - READ TSPFILE NEXT RECORD WITH NO LOCK - IF CUST-STAT NOT = "00" - DISPLAY "Error " CUST-STAT " on 1st read of file" - UPON CONSOLE - STOP RUN - END-IF. - PERFORM UNTIL CUST-STAT NOT = "00" - OR REC-NUM > REC-MAX - DISPLAY "Key: " CM-CUST-NUM " is " CM-COMPANY - " Disk=" CM-DISK "." - UPON CONSOLE - READ TSPFILE NEXT RECORD - AT END - MOVE "99" TO CUST-STAT - END-READ - ADD 1 TO REC-NUM - END-PERFORM - IF CUST-STAT = "99" - DISPLAY "Hit End of File" UPON CONSOLE - END-IF. - - DISPLAY "LIST SAMPLE FILE DESCENDING" UPON CONSOLE. - MOVE ZERO TO REC-NUM - START TSPFILE KEY LESS THAN CM-CUST-NUM - IF CUST-STAT NOT = "00" - DISPLAY "Error " CUST-STAT " starting file" - UPON CONSOLE - STOP RUN - END-IF. - READ TSPFILE PREVIOUS RECORD WITH NO LOCK - IF CUST-STAT NOT = "00" - DISPLAY "Error " CUST-STAT " on 1st read of file" - UPON CONSOLE - STOP RUN - END-IF. - PERFORM UNTIL CUST-STAT NOT = "00" - OR REC-NUM > REC-MAX - DISPLAY "Key: " CM-CUST-NUM " is " CM-COMPANY - " Disk=" CM-DISK "." - UPON CONSOLE - READ TSPFILE PREVIOUS RECORD - AT END - MOVE "99" TO CUST-STAT - END-READ - ADD 1 TO REC-NUM - END-PERFORM. - - CLOSE TSPFILE. - - OPEN I-O TSPFILE. - MOVE SPACES TO TSPFL-RECORD. - MOVE DATA-CUST-NUM (2) TO CM-CUST-NUM. - MOVE 'X' TO CM-CUST-NUM (5:1). - READ TSPFILE KEY IS CM-CUST-NUM - IF CUST-STAT NOT = "23" - DISPLAY "Error " CUST-STAT " instead of 23." - UPON CONSOLE - END-IF. - MOVE DATA-CUST-NUM (2) TO CM-CUST-NUM. - MOVE DATA-COMPANY (2) TO CM-COMPANY. - READ TSPFILE KEY IS CM-CUST-NUM - IF CUST-STAT NOT = "00" - DISPLAY "Error " CUST-STAT " on primary read ." - UPON CONSOLE - ELSE - DISPLAY "Got: " CM-CUST-NUM " is " CM-COMPANY - " Disk=" CM-DISK "." - UPON CONSOLE - END-IF. - READ TSPFILE NEXT RECORD - IF CUST-STAT NOT = "00" - DISPLAY "Error " CUST-STAT " on next read" - UPON CONSOLE - ELSE - DISPLAY "Nxt: " CM-CUST-NUM " is " CM-COMPANY - " Disk=" CM-DISK "." - UPON CONSOLE - END-IF. - MOVE DATA-TELEPHONE (7) TO CM-TELEPHONE. - MOVE DATA-MACHINE (7) TO CM-MACHINE. - READ TSPFILE KEY IS CM-TELEPHONE - IF CUST-STAT NOT = "00" - DISPLAY "Error " CUST-STAT " instead of 23" - UPON CONSOLE - ELSE - DISPLAY "Ky2: " CM-CUST-NUM " is " CM-COMPANY - " Mach=" CM-MACHINE "." - UPON CONSOLE - END-IF. - WRITE TSPFL-RECORD - IF CUST-STAT NOT = "22" - DISPLAY "Error " CUST-STAT " instead of 22" - UPON CONSOLE - ELSE - DISPLAY " Write: " CM-CUST-NUM " got 22 as expected" - UPON CONSOLE - END-IF. - MOVE DATA-CUST-NUM (3) TO CM-CUST-NUM. - MOVE DATA-COMPANY (3) TO CM-COMPANY. - READ TSPFILE KEY IS CM-CUST-NUM - DISPLAY " Read: " CM-CUST-NUM " got " - CUST-STAT " as expected " - CM-NO-TERMINALS " terminals" - UPON CONSOLE. - ADD 5 TO CM-NO-TERMINALS - REWRITE TSPFL-RECORD - IF CUST-STAT NOT = "02" - AND CUST-STAT NOT = "00" - DISPLAY "Error " CUST-STAT " instead of 02" - UPON CONSOLE - ELSE - DISPLAY "ReWrite: " CM-CUST-NUM " got " - "00/02 as expected " - CM-NO-TERMINALS " terminals" - UPON CONSOLE - END-IF. - MOVE DATA-CUST-NUM (2) TO CM-CUST-NUM. - MOVE DATA-COMPANY (2) TO CM-COMPANY. - READ TSPFILE KEY IS CM-CUST-NUM - DISPLAY " Read: " CM-CUST-NUM " got " - CUST-STAT " as expected " - CM-NO-TERMINALS " terminals" - UPON CONSOLE. - MOVE DATA-CUST-NUM (3) TO CM-CUST-NUM. - MOVE DATA-COMPANY (3) TO CM-COMPANY. - REWRITE TSPFL-RECORD - IF CUST-STAT NOT = "02" - AND CUST-STAT NOT = "00" - DISPLAY "Error " CUST-STAT " instead of 02" - UPON CONSOLE - ELSE - DISPLAY "ReWrite: " CM-CUST-NUM " got " - "00/02 as expected" - UPON CONSOLE - END-IF. - MOVE DATA-CUST-NUM (6) TO CM-CUST-NUM. - MOVE DATA-COMPANY (6) TO CM-COMPANY. - READ TSPFILE KEY IS CM-CUST-NUM - MOVE DATA-TELEPHONE (7) TO CM-TELEPHONE. - MOVE DATA-MACHINE (7) TO CM-MACHINE. - REWRITE TSPFL-RECORD - IF CUST-STAT NOT = "02" - AND CUST-STAT NOT = "00" - DISPLAY "Error " CUST-STAT " instead of 02" - UPON CONSOLE - ELSE - DISPLAY "ReWrite: " CM-CUST-NUM " got " - "00/02 as expected" - UPON CONSOLE - END-IF. - DELETE TSPFILE. - CLOSE TSPFILE. - - LOADFLAT. - OPEN OUTPUT FLATFILE. - PERFORM FLAT-RECORD - VARYING SUB FROM 1 BY 1 - UNTIL SUB > MAX-SUB - OR SUB > 5. - CLOSE FLATFILE. - OPEN INPUT FLATFILE. - MOVE 3 TO REC-NUM - READ FLATFILE - MOVE 999 TO REC-NUM - READ FLATFILE - CLOSE FLATFILE. - - FLAT-RECORD. - - MOVE SPACES TO TSP2-RECORD. - MOVE SUB TO REC-NUM. - MOVE DATA-CUST-NUM (SUB) TO C2-CUST-NUM. - MOVE DATA-COMPANY (SUB) TO C2-COMPANY. - MOVE DATA-NO-TERMINALS (SUB) TO C2-NO-TERMINALS. - MOVE 20070319 TO C2-PK-DATE. - IF ODD-RECORD - MOVE "8417" TO C2-DISK - ELSE - MOVE "8470" TO C2-DISK. - WRITE TSP2-RECORD. -]) - -AT_DATA([cmod.c], [[ -#include -#include - -/********************************************************* - * TSTFH - External File Handler entry point. -*********************************************************/ - -COB_EXT_EXPORT int -TSTFH (unsigned char *opCodep, FCD3 *fcd) -{ - unsigned int opCode; - - if (*opCodep == 0xfa) - opCode = 0xfa00 + opCodep[1]; - else - opCode = opCodep[1]; - - if (fcd->fileOrg == ORG_LINE_SEQ - || fcd->fileOrg == ORG_SEQ - || fcd->fileOrg == ORG_INDEXED - || fcd->fileOrg == ORG_RELATIVE) { - switch (opCode) { - case OP_OPEN_OUTPUT: - case OP_OPEN_IO: - case OP_OPEN_EXTEND: - case OP_OPEN_OUTPUT_NOREWIND: - return EXTFH(opCodep, fcd); - break; - - case OP_OPEN_INPUT: - case OP_OPEN_INPUT_NOREWIND: - case OP_OPEN_INPUT_REVERSED: - return EXTFH(opCodep, fcd); - break; - - default: - break; - } - - } - - if (opCode == OP_CLOSE - && (fcd->openMode & OPEN_NOT_OPEN) ) { - return 0; - } - - return EXTFH(opCodep, fcd); -} -]]) - -AT_CHECK([$COMPILE -fcallfh=TSTFH prog.cob cmod.c], [0], [], []) - -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], -[OK: Operations on empty file -Loading sample data file. -Sample data file load complete. -LIST SAMPLE FILE -Key: EPS00000 is EPSILON EQUIPMENT SUPPLY Disk=8417 . -Key: FOR00000 is FORTUNE COOKIE COMPANY Disk=8470 . -Key: GAM00000 is GAMMA X-RAY TECHNOLOGY Disk=8417 . -Key: GIB00000 is GIBRALTER LIFE INSURANCE Disk=8417 . -Key: H&J00000 is H & J PLUMBING SUPPLIES Disk=8470 . -Key: INC00000 is INCREMENTAL BACKUP CORP. Disk=8417 . -Key: JOH00000 is JOHNSON BOATING SUPPLIES Disk=8417 . -Key: KON00000 is KONFLAB PLASTIC PRODUCTS. Disk=8417 . -Key: LEW00000 is LEWISTON GRAPHICS LTD. Disk=8470 . -Key: MOR00000 is MORNINGSIDE CARPENTRY. Disk=8470 . -Key: NEW00000 is NEW WAVE SURF SHOPS INC. Disk=8470 . -LIST SAMPLE FILE DESCENDING -Key: NEW00000 is NEW WAVE SURF SHOPS INC. Disk=8470 . -Key: MOR00000 is MORNINGSIDE CARPENTRY. Disk=8470 . -Key: LEW00000 is LEWISTON GRAPHICS LTD. Disk=8470 . -Key: KON00000 is KONFLAB PLASTIC PRODUCTS. Disk=8417 . -Key: JOH00000 is JOHNSON BOATING SUPPLIES Disk=8417 . -Key: INC00000 is INCREMENTAL BACKUP CORP. Disk=8417 . -Key: H&J00000 is H & J PLUMBING SUPPLIES Disk=8470 . -Key: GIB00000 is GIBRALTER LIFE INSURANCE Disk=8417 . -Key: GAM00000 is GAMMA X-RAY TECHNOLOGY Disk=8417 . -Key: FOR00000 is FORTUNE COOKIE COMPANY Disk=8470 . -Key: EPS00000 is EPSILON EQUIPMENT SUPPLY Disk=8417 . -Got: BET00000 is BETA SHOE MFG. INC. Disk=8470 . -Nxt: DEL00000 is DELTA LUGGAGE REPAIRS Disk=8470 . -Ky2: GIB00000 is GIBRALTER LIFE INSURANCE Mach=UNI-80/6. - Write: GIB00000 got 22 as expected - Read: GAM00000 got 00 as expected 00075 terminals -ReWrite: GAM00000 got 00/02 as expected 00080 terminals - Read: BET00000 got 00 as expected 00034 terminals -ReWrite: GAM00000 got 00/02 as expected -ReWrite: FOR00000 got 00/02 as expected -Expected ERROR 39 opening TSTFILE, Record size different -], []) - -AT_CLEANUP - - -AT_SETUP([EXTFH: SEQUENTIAL files]) -AT_KEYWORDS([runfile EXTFH]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - - ENVIRONMENT DIVISION. - CONFIGURATION SECTION. - - INPUT-OUTPUT SECTION. - FILE-CONTROL. - SELECT FLATFILE ASSIGN EXTERNAL SEQFIX - ORGANIZATION SEQUENTIAL - FILE STATUS IS CUST-STAT . - - DATA DIVISION. - FILE SECTION. - FD FLATFILE - BLOCK CONTAINS 5 RECORDS. - - 01 TSPFL-RECORD. - 10 CM-CUST-NUM PICTURE X(8). - 10 CM-COMPANY PICTURE X(25). - 10 CM-DISK PICTURE X(8). - 10 CM-NO-TERMINALS PICTURE 9(4) COMP-4. - 10 CM-PK-DATE PICTURE S9(14) COMP-3. - 10 CM-TRAILER PICTURE X(8). - - WORKING-STORAGE SECTION. - - 77 MAX-SUB VALUE 6 PICTURE 9(4) COMP SYNC. - 77 CUST-STAT PICTURE X(2). - - 01 TEST-DATA. - - 02 DATA-CUST-NUM-TBL. - - 05 FILLER PIC X(8) VALUE "ALP00000". - 05 FILLER PIC X(8) VALUE "BET00000". - 05 FILLER PIC X(8) VALUE "GAM00000". - 05 FILLER PIC X(8) VALUE "DEL00000". - 05 FILLER PIC X(8) VALUE "EPS00000". - 05 FILLER PIC X(8) VALUE "FOR00000". - - 02 DATA-CUST-NUM REDEFINES DATA-CUST-NUM-TBL - PIC X(8) OCCURS 6. - 02 DATA-COMPANY-TBL. - - 05 FILLER PIC X(25) VALUE "ALPHA ELECTRICAL CO. LTD.". - 05 FILLER PIC X(25) VALUE "BETA SHOE MFG. INC. ". - 05 FILLER PIC X(25) VALUE "GAMMA X-RAY TECHNOLOGY ". - 05 FILLER PIC X(25) VALUE "DELTA LUGGAGE REPAIRS ". - 05 FILLER PIC X(25) VALUE "EPSILON EQUIPMENT SUPPLY ". - 05 FILLER PIC X(25) VALUE "FORTUNE COOKIE COMPANY ". - 02 DATA-COMPANY REDEFINES DATA-COMPANY-TBL - PIC X(25) OCCURS 6. - 02 DATA-ADDRESS-2-TBL. - - 05 FILLER PIC X(10) VALUE "NEW YORK ". - 05 FILLER PIC X(10) VALUE "ATLANTA ". - 05 FILLER PIC X(10) VALUE "WASHINGTON". - 05 FILLER PIC X(10) VALUE "TORONTO ". - 05 FILLER PIC X(10) VALUE "CALGARY ". - 05 FILLER PIC X(10) VALUE "WHITEPLAIN". - - 02 DATA-ADDRESS REDEFINES DATA-ADDRESS-2-TBL - PIC X(10) OCCURS 6. - - 02 DATA-NO-TERMINALS-TBL. - - 05 FILLER PIC 9(3) COMP-3 VALUE 10. - 05 FILLER PIC 9(3) COMP-3 VALUE 13. - 05 FILLER PIC 9(3) COMP-3 VALUE 75. - 05 FILLER PIC 9(3) COMP-3 VALUE 10. - 05 FILLER PIC 9(3) COMP-3 VALUE 90. - 05 FILLER PIC 9(3) COMP-3 VALUE 254. - - 02 DATA-NO-TERMINALS REDEFINES DATA-NO-TERMINALS-TBL - PIC 9(3) COMP-3 OCCURS 6. - 01 WORK-AREA. - 05 SUB PICTURE 9(4) COMP SYNC. - 88 ODD-RECORD VALUE 1 3 5. - - - PROCEDURE DIVISION. - - OPEN INPUT FLATFILE. - DISPLAY "Open Input when no file Sts:" CUST-STAT - OPEN EXTEND FLATFILE. - DISPLAY "Open Extend when no file Sts:" CUST-STAT - CLOSE FLATFILE. - DISPLAY "Close when no open file Sts:" CUST-STAT - OPEN OUTPUT FLATFILE. - CLOSE FLATFILE. - OPEN EXTEND FLATFILE. - DISPLAY "Open Extend when empty file Sts:" CUST-STAT - CLOSE FLATFILE. - - PERFORM LOADFILE. - OPEN INPUT FLATFILE. - DISPLAY "Open Sts:" CUST-STAT - READ FLATFILE - DISPLAY "Read " CM-CUST-NUM " Sts:" CUST-STAT. - READ FLATFILE - DISPLAY "Read " CM-CUST-NUM " Sts:" CUST-STAT. - CLOSE FLATFILE. - - OPEN I-O FLATFILE. - READ FLATFILE - DISPLAY "Read " CM-CUST-NUM " Sts:" CUST-STAT. - ADD 1 TO CM-NO-TERMINALS - REWRITE TSPFL-RECORD - DISPLAY "REWRITE " CM-CUST-NUM " Sts " CUST-STAT - " Trms:" CM-NO-TERMINALS. - CLOSE FLATFILE. - - OPEN I-O FLATFILE. - READ FLATFILE - DISPLAY "Read " CM-CUST-NUM " Sts:" CUST-STAT. - ADD 1 TO CM-NO-TERMINALS - REWRITE TSPFL-RECORD - DISPLAY "REWRITE " CM-CUST-NUM " Sts " CUST-STAT - " Trms:" CM-NO-TERMINALS. - READ FLATFILE WITH LOCK - DISPLAY "Read " CM-CUST-NUM - * DELETE FLATFILE - * DISPLAY "DELETE " CM-CUST-NUM " Sts " CUST-STAT. - CLOSE FLATFILE. - OPEN INPUT FLATFILE. - DISPLAY "Re-list File Open Sts:" CUST-STAT - PERFORM UNTIL CUST-STAT NOT = "00" - PERFORM READ-RECORD - END-PERFORM. - CLOSE FLATFILE. - OPEN EXTEND FLATFILE. - MOVE 2 TO SUB - PERFORM LOAD-RECORD - CLOSE FLATFILE. - OPEN INPUT FLATFILE. - DISPLAY "List File afer EXTEND Open Sts:" CUST-STAT - PERFORM UNTIL CUST-STAT NOT = "00" - PERFORM READ-RECORD - END-PERFORM. - CLOSE FLATFILE. - STOP RUN RETURNING 0. - - READ-RECORD. - MOVE SPACES TO TSPFL-RECORD. - READ FLATFILE - IF CUST-STAT NOT = "00" - DISPLAY "Read Status: " CUST-STAT - ELSE - DISPLAY "Read " CM-CUST-NUM - " Trms:" CM-NO-TERMINALS - END-IF. - - LOADFILE. - DISPLAY "Loading sample data file.". - - OPEN OUTPUT FLATFILE. - - PERFORM LOAD-RECORD - VARYING SUB FROM 1 BY 1 - UNTIL SUB > MAX-SUB. - - DISPLAY "Sample data file load complete.". - CLOSE FLATFILE. - - LOAD-RECORD. - - MOVE SPACES TO TSPFL-RECORD. - MOVE DATA-CUST-NUM (SUB) TO CM-CUST-NUM. - MOVE DATA-COMPANY (SUB) TO CM-COMPANY. - MOVE DATA-NO-TERMINALS (SUB) TO CM-NO-TERMINALS. - MOVE 20070319 TO CM-PK-DATE. - IF SUB = 1 OR 4 OR 6 - MOVE -20070319 TO CM-PK-DATE. - - IF ODD-RECORD - MOVE "8417" TO CM-DISK - ELSE - MOVE "8470" TO CM-DISK. - WRITE TSPFL-RECORD. -]) - -AT_DATA([cmod.c], [[ -#include -#include - -static char *txtOpCode(int opCode); - -static int -doOpenFile( - unsigned char *opCodep, - FCD3 *fcd, - char *opmsg) -{ - int sts; - - sts = EXTFH( opCodep, fcd ); - printf("EXFTH did %s; Status=%c%c; File now %s\n", - opmsg, fcd->fileStatus[0], fcd->fileStatus[1], - (fcd->openMode & OPEN_NOT_OPEN) ? "Closed" : "Open"); - return sts; -} - -/********************************************************* - * TSTFH - External File Handler entry point. -*********************************************************/ - -COB_EXT_EXPORT int -TSTFH (unsigned char *opCodep, FCD3 *fcd) -{ - unsigned int opCode; - int sts; - - if (*opCodep == 0xfa) - opCode = 0xfa00 + opCodep[1]; - else - opCode = opCodep[1]; - - if (fcd->fileOrg == ORG_LINE_SEQ - || fcd->fileOrg == ORG_SEQ - || fcd->fileOrg == ORG_INDEXED - || fcd->fileOrg == ORG_RELATIVE) { - switch (opCode) { - case OP_OPEN_OUTPUT: - case OP_OPEN_IO: - case OP_OPEN_EXTEND: - case OP_OPEN_OUTPUT_NOREWIND: - return doOpenFile( opCodep, fcd, txtOpCode(opCode)); - break; - - case OP_OPEN_INPUT: - case OP_OPEN_INPUT_NOREWIND: - case OP_OPEN_INPUT_REVERSED: - return doOpenFile( opCodep, fcd, txtOpCode(opCode)); - break; - - case OP_CLOSE: - return doOpenFile( opCodep, fcd, txtOpCode(opCode)); - break; - - default: - break; - } - - } - - if (opCode == OP_CLOSE - && (fcd->openMode & OPEN_NOT_OPEN) ) { - return 0; - } - - sts = EXTFH(opCodep, fcd); - printf("EXFTH did %s; Status=%c%c\n", txtOpCode(opCode), - fcd->fileStatus[0], fcd->fileStatus[1]); - return sts; -} - -static char * /* Return Text name of function */ -txtOpCode(int opCode) -{ - static char tmp[32]; - switch (opCode) { - case OP_OPEN_INPUT: return "OPEN_IN"; - case OP_OPEN_OUTPUT: return "OPEN_OUT"; - case OP_OPEN_IO: return "OPEN_IO"; - case OP_OPEN_EXTEND: return "OPEN_EXT"; - case OP_OPEN_INPUT_NOREWIND: return "OPEN_IN_NOREW"; - case OP_OPEN_OUTPUT_NOREWIND: return "OPEN_OUT_NOREW"; - case OP_OPEN_INPUT_REVERSED: return "OPEN_IN_REV"; - case OP_CLOSE: return "CLOSE"; - case OP_CLOSE_LOCK: return "CLOSE_LOCK"; - case OP_CLOSE_NOREWIND: return "CLOSE_NORED"; - case OP_CLOSE_REEL: return "CLOSE_REEL"; - case OP_CLOSE_REMOVE: return "CLOSE_REMOVE"; - case OP_CLOSE_NO_REWIND: return "CLOSE_NO_REW"; - case OP_START_EQ: return "START_EQ"; - case OP_START_EQ_ANY: return "START_EQ_ANY"; - case OP_START_GT: return "START_GT"; - case OP_START_GE: return "START_GE"; - case OP_START_LT: return "START_LT"; - case OP_START_LE: return "START_LE"; - case OP_READ_SEQ_NO_LOCK: return "READ_SEQ_NO_LK"; - case OP_READ_SEQ: return "READ_SEQ"; - case OP_READ_SEQ_LOCK: return "READ_SEQ_LK"; - case OP_READ_SEQ_KEPT_LOCK: return "READ_SEQ_KEPT_LK"; - case OP_READ_PREV_NO_LOCK: return "READ_PREV_NO_LK"; - case OP_READ_PREV: return "READ_PREV"; - case OP_READ_PREV_LOCK: return "READ_PREV_LK"; - case OP_READ_PREV_KEPT_LOCK: return "READ_PREV_KEPT_LK"; - case OP_READ_RAN: return "READ_RAN"; - case OP_READ_RAN_NO_LOCK: return "READ_RAN_NO_LK"; - case OP_READ_RAN_KEPT_LOCK: return "READ_RAN_KEPT_LK"; - case OP_READ_RAN_LOCK: return "READ_RAN_LK"; - case OP_READ_DIR: return "READ_DIR"; - case OP_READ_DIR_NO_LOCK: return "READ_DIR_NO_LK"; - case OP_READ_DIR_KEPT_LOCK: return "READ_DIR_KEPT_LK"; - case OP_READ_DIR_LOCK: return "READ_DIR_LK"; - case OP_READ_POSITION: return "READ_POSITION"; - case OP_WRITE: return "WRITE"; - case OP_REWRITE: return "REWRITE"; - case OP_DELETE: return "DELETE"; - case OP_DELETE_FILE: return "DELETE_FILE"; - case OP_UNLOCK: return "UNLOCK"; - case OP_ROLLBACK: return "ROLLBACK"; - case OP_COMMIT: return "COMMIT"; - case OP_WRITE_BEFORE: return "WRITE_BEFORE"; - case OP_WRITE_BEFORE_TAB: return "WRITE_BEFORE_TAB"; - case OP_WRITE_BEFORE_PAGE: return "WRITE_BEFORE_PAGE"; - case OP_WRITE_AFTER: return "WRITE_AFTER"; - case OP_WRITE_AFTER_TAB: return "WRITE_AFTER_TAB"; - case OP_WRITE_AFTER_PAGE: return "WRITE_AFTER_PAGE"; - } - sprintf(tmp, "Func 0x%02X:", opCode); - return tmp; -} -]]) - -AT_CHECK([$COMPILE -fcallfh=TSTFH prog.cob cmod.c], [0], [], []) - -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], -[EXFTH did OPEN_IN; Status=35; File now Closed -Open Input when no file Sts:35 -EXFTH did OPEN_EXT; Status=35; File now Closed -Open Extend when no file Sts:35 -EXFTH did CLOSE; Status=42; File now Closed -Close when no open file Sts:42 -EXFTH did OPEN_OUT; Status=00; File now Open -EXFTH did CLOSE; Status=00; File now Closed -EXFTH did OPEN_EXT; Status=00; File now Open -Open Extend when empty file Sts:00 -EXFTH did CLOSE; Status=00; File now Closed -Loading sample data file. -EXFTH did OPEN_OUT; Status=00; File now Open -EXFTH did WRITE; Status=00 -EXFTH did WRITE; Status=00 -EXFTH did WRITE; Status=00 -EXFTH did WRITE; Status=00 -EXFTH did WRITE; Status=00 -EXFTH did WRITE; Status=00 -Sample data file load complete. -EXFTH did CLOSE; Status=00; File now Closed -EXFTH did OPEN_IN; Status=00; File now Open -Open Sts:00 -EXFTH did READ_SEQ; Status=00 -Read ALP00000 Sts:00 -EXFTH did READ_SEQ; Status=00 -Read BET00000 Sts:00 -EXFTH did CLOSE; Status=00; File now Closed -EXFTH did OPEN_IO; Status=00; File now Open -EXFTH did READ_SEQ; Status=00 -Read ALP00000 Sts:00 -EXFTH did REWRITE; Status=00 -REWRITE ALP00000 Sts 00 Trms:0011 -EXFTH did CLOSE; Status=00; File now Closed -EXFTH did OPEN_IO; Status=00; File now Open -EXFTH did READ_SEQ; Status=00 -Read ALP00000 Sts:00 -EXFTH did REWRITE; Status=00 -REWRITE ALP00000 Sts 00 Trms:0012 -EXFTH did READ_SEQ; Status=00 -Read BET00000 -EXFTH did CLOSE; Status=00; File now Closed -EXFTH did OPEN_IN; Status=00; File now Open -Re-list File Open Sts:00 -EXFTH did READ_SEQ; Status=00 -Read ALP00000 Trms:0012 -EXFTH did READ_SEQ; Status=00 -Read BET00000 Trms:0013 -EXFTH did READ_SEQ; Status=00 -Read GAM00000 Trms:0075 -EXFTH did READ_SEQ; Status=00 -Read DEL00000 Trms:0010 -EXFTH did READ_SEQ; Status=00 -Read EPS00000 Trms:0090 -EXFTH did READ_SEQ; Status=00 -Read FOR00000 Trms:0254 -EXFTH did READ_SEQ; Status=10 -Read Status: 10 -EXFTH did CLOSE; Status=00; File now Closed -EXFTH did OPEN_EXT; Status=00; File now Open -EXFTH did WRITE; Status=00 -EXFTH did CLOSE; Status=00; File now Closed -EXFTH did OPEN_IN; Status=00; File now Open -List File afer EXTEND Open Sts:00 -EXFTH did READ_SEQ; Status=00 -Read ALP00000 Trms:0012 -EXFTH did READ_SEQ; Status=00 -Read BET00000 Trms:0013 -EXFTH did READ_SEQ; Status=00 -Read GAM00000 Trms:0075 -EXFTH did READ_SEQ; Status=00 -Read DEL00000 Trms:0010 -EXFTH did READ_SEQ; Status=00 -Read EPS00000 Trms:0090 -EXFTH did READ_SEQ; Status=00 -Read FOR00000 Trms:0254 -EXFTH did READ_SEQ; Status=00 -Read BET00000 Trms:0013 -EXFTH did READ_SEQ; Status=10 -Read Status: 10 -EXFTH did CLOSE; Status=00; File now Closed -], []) - -AT_CLEANUP - - -AT_SETUP([EXTFH: LINE SEQUENTIAL files, direct EXTFH]) -AT_KEYWORDS([runfile]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - CONFIGURATION SECTION. - INPUT-OUTPUT SECTION. - FILE-CONTROL. - DATA DIVISION. - FILE SECTION. - WORKING-STORAGE SECTION. - - 01 I PIC XX COMP-X. - - 01 WS-FCD-DDNAME PIC X(8) VALUE SPACES. - 01 WS-FCD-PTR POINTER VALUE NULL. - - 01 WS-FCD-SIZE PIC 9(04) VALUE 0 COMP-5. - 01 WS-FCD-FLAGS PIC 9(04) VALUE 0 COMP-5. - - 01 DISPLAY-BYTE. - 05 DISPLAY-XXX PIC X(03). - 05 DISPLAY-ZZ9 REDEFINES DISPLAY-XXX - PIC ZZ9. - 01 ACTION-CODE pic x(2). - 78 OP-OPEN-INPUT value x"fa00". - 78 OP-OPEN-OUTPUT value x"fa01". - 78 OP-OPEN-I-O value x"fa02". - 78 OP-WRITE value x"faf3". - 78 OP-RELEASE value x"faf3". - 78 OP-REWRITE value x"faf4". - 78 OP-READ-NEXT value x"faf5". - 78 OP-START-EQUAL value x"fae9". - 78 OP-CLOSE value x"fa80". - 78 OP-QUERY-FILE value x"0006". - - 01 ACTION-CODE-WORK redefines ACTION-CODE. - 05 ACTION-CODE-1 PIC x(01) COMP-X. - 05 ACTION-CODE-2 PIC x(01) COMP-X. - - 01 DISPLAY-A1-XXX PIC X(03). - 01 DISPLAY-A1-ZZ9 REDEFINES DISPLAY-A1-XXX - PIC ZZ9. - 01 DISPLAY-A2-XXX PIC X(03). - 01 DISPLAY-A2-ZZ9 REDEFINES DISPLAY-A2-XXX - PIC ZZ9. - - 01 FCD-FILENAME PIC X(80) value "test.out". - 01 FCD-RECORD PIC X(512) value spaces. - - LINKAGE SECTION. - - 01 FCD-MAP. - copy 'xfhfcd3.cpy'. - - *================================================================* - PROCEDURE DIVISION. - *----------------------------------------------------------------* - 000-MAIN. - - PERFORM 100-OPEN. - - PERFORM VARYING I FROM 1 BY 1 UNTIL I > 10 - MOVE I TO DISPLAY-A1-ZZ9 - MOVE DISPLAY-A1-ZZ9 TO FCD-RECORD - PERFORM 300-WRITE - END-PERFORM. - - PERFORM 400-CLOSE. - STOP RUN. - - *----------------------------------------------------------------* - * Process the open request - * - 100-OPEN. - - MOVE "TESTOUT" TO WS-FCD-DDNAME - - MOVE LENGTH OF FCD-MAP TO WS-FCD-SIZE - DISPLAY "FCD SIZE " WS-FCD-SIZE. - - IF WS-FCD-PTR EQUAL NULL - ALLOCATE ws-fcd-size characters - returning WS-FCD-PTR - - SET ADDRESS OF FCD-MAP TO WS-FCD-PTR - MOVE LOW-VALUES TO FCD-MAP - MOVE WS-FCD-SIZE TO FCD-LENGTH - move fcd--version-number TO FCD-VERSION - MOVE "00" TO FCD-FILE-STATUS - move fcd--status-defined to FCD-ACCESS-MODE - move fcd--open-closed to FCD-OPEN-MODE - move fcd--external-name to FCD-OTHER-FLAGS - SET FCD-HANDLE TO NULL - MOVE 8 TO FCD-NAME-LENGTH - SET FCD-FILENAME-ADDRESS TO ADDRESS - OF WS-FCD-DDNAME - SET FCD-KEY-DEF-ADDRESS TO NULL - move fcd--allow-readers to FCD-LOCKTYPES - ELSE - SET ADDRESS OF FCD-MAP TO WS-FCD-PTR - IF FCD-OPEN-MODE NOT = fcd--open-closed - DISPLAY "ERRROR - FILE ALREADY OPEN" - STOP RUN - END-IF - END-IF - - move fcd--line-sequential-org to FCD-ORGANIZATION - move fcd--recmode-fixed to FCD-RECORDING-MODE - move 10 to FCD-MIN-REC-LENGTH, FCD-MAX-REC-LENGTH - SET FCD-RECORD-ADDRESS TO ADDRESS OF FCD-RECORD - - * Move fcd--cr-delimiter for CR LF after each record - * move fcd--cr-delimiter to FCD-STATUS-TYPE - - move op-open-output to action-code - - PERFORM 800-CALL-EXTFH - . - - *----------------------------------------------------------------* - * Process the write request - * - 300-WRITE. - - move 10 to FCD-CURRENT-REC-LEN - move op-write to action-code - PERFORM 800-CALL-EXTFH - . - *----------------------------------------------------------------* - * Process the close request - * - 400-CLOSE. - MOVE "00" TO FCD-FILE-STATUS - move op-close to action-code - PERFORM 800-CALL-EXTFH - . - *----------------------------------------------------------------* - * External file handler interface -- all I/O goes through here - * - 800-CALL-EXTFH. - - CALL "EXTFH" USING ACTION-CODE, FCD-MAP - - IF FCD-STATUS-KEY-1 = "9" AND FCD-BINARY = 199 - MOVE "10" TO FCD-FILE-STATUS - END-IF - . -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) - -AT_CHECK([TESTOUT=TEST-OUT $COBCRUN_DIRECT ./prog], [0], -[FCD SIZE 00216 -], []) - - -AT_CAPTURE_FILE(./TEST-OUT) - -# note: currently with the same behaviour as MF -# (ignoring minimal record length for line-sequential) -# this may change in the future... -AT_DATA([reference], -[ 1 - 2 - 3 - 4 - 5 - 6 - 7 - 8 - 9 - 10 -]) - -AT_CHECK([diff reference TEST-OUT], [0], [], []) - -AT_CLEANUP - - -AT_SETUP([RELATIVE Multi-Record]) -AT_KEYWORDS([runfile]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - CONFIGURATION SECTION. - - INPUT-OUTPUT SECTION. - FILE-CONTROL. - SELECT FLATFILE ASSIGN EXTERNAL RELVAR - ORGANIZATION RELATIVE - ACCESS IS SEQUENTIAL - RELATIVE KEY IS REC-NUM - FILE STATUS IS CUST-STAT. - - DATA DIVISION. - FILE SECTION. - FD FLATFILE - BLOCK CONTAINS 5 RECORDS. - - 01 TSPFL-RECORD. - 10 CM-CUST-NUM PICTURE X(8). - 10 CM-TYPE PICTURE X. - 10 CM-COMPANY PICTURE X(25). - 10 CM-DISK PICTURE X(8). - 10 CM-NO-TERMINALS PICTURE 9(4) COMP-4. - 10 CM-PK-DATE PICTURE S9(14) COMP-3. - 10 CM-TRAILER PICTURE X(251). - - 01 TSP2-RECORD. - 10 C2-CUST-NUM PICTURE X(8). - 10 C2-TYPE PICTURE X. - 10 C2-COMPANY PICTURE X(25). - 10 C2-ADDRESS PICTURE X(25). - 10 C2-DISK PICTURE X(8). - 10 C2-NO-TERMINALS PICTURE 9(4) COMP-4. - 10 C2-PK-DATE PICTURE S9(14) COMP-3. - - - WORKING-STORAGE SECTION. - - 77 MAX-SUB VALUE 6 PICTURE 9(4) COMP SYNC. - 77 ZRO VALUE 1 PICTURE 9(4) COMP SYNC. - 77 CUST-STAT PICTURE X(2). - 77 REC-NUM VALUE 1 PICTURE 9(4) COMP SYNC. - - 01 TEST-DATA. - - 02 DATA-CUST-NUM-TBL. - - 05 FILLER PIC X(8) VALUE "ALP00000". - 05 FILLER PIC X(8) VALUE "BET00000". - 05 FILLER PIC X(8) VALUE "GAM00000". - 05 FILLER PIC X(8) VALUE "DEL00000". - 05 FILLER PIC X(8) VALUE "EPS00000". - 05 FILLER PIC X(8) VALUE "FOR00000". - - 02 DATA-CUST-NUM REDEFINES DATA-CUST-NUM-TBL - PIC X(8) OCCURS 6. - 02 DATA-COMPANY-TBL. - - 05 FILLER PIC X(25) VALUE "ALPHA ELECTRICAL CO. LTD.". - 05 FILLER PIC X(25) VALUE "BETA SHOE MFG. INC. ". - 05 FILLER PIC X(25) VALUE "GAMMA X-RAY TECHNOLOGY ". - 05 FILLER PIC X(25) VALUE "DELTA LUGGAGE REPAIRS ". - 05 FILLER PIC X(25) VALUE "EPSILON EQUIPMENT SUPPLY ". - 05 FILLER PIC X(25) VALUE "FORTUNE COOKIE COMPANY ". - 02 DATA-COMPANY REDEFINES DATA-COMPANY-TBL - PIC X(25) OCCURS 6. - 02 DATA-ADDRESS-2-TBL. - - 05 FILLER PIC X(10) VALUE "NEW YORK ". - 05 FILLER PIC X(10) VALUE "ATLANTA ". - 05 FILLER PIC X(10) VALUE "WASHINGTON". - 05 FILLER PIC X(10) VALUE "TORONTO ". - 05 FILLER PIC X(10) VALUE "CALGARY ". - 05 FILLER PIC X(10) VALUE "WHITEPLAIN". - - 02 DATA-ADDRESS REDEFINES DATA-ADDRESS-2-TBL - PIC X(10) OCCURS 6. - - 02 DATA-NO-TERMINALS-TBL. - - 05 FILLER PIC 9(3) COMP-3 VALUE 10. - 05 FILLER PIC 9(3) COMP-3 VALUE 13. - 05 FILLER PIC 9(3) COMP-3 VALUE 75. - 05 FILLER PIC 9(3) COMP-3 VALUE 10. - 05 FILLER PIC 9(3) COMP-3 VALUE 90. - 05 FILLER PIC 9(3) COMP-3 VALUE 254. - - 02 DATA-NO-TERMINALS REDEFINES DATA-NO-TERMINALS-TBL - PIC 9(3) COMP-3 OCCURS 6. - 01 WORK-AREA. - 05 SUB PICTURE 9(4) COMP SYNC. - 88 ODD-RECORD VALUE 1 3 5. - - - PROCEDURE DIVISION. - - PERFORM LOADFILE. - OPEN INPUT FLATFILE. - DISPLAY "Initial Re-Read Open Sts:" CUST-STAT - PERFORM UNTIL CUST-STAT NOT = "00" - PERFORM READ-RECORD - END-PERFORM. - IF CUST-STAT = "30" - CLOSE FLATFILE - STOP RUN - END-IF - CLOSE FLATFILE. - - OPEN I-O FLATFILE. - DISPLAY "For Rewrite Open I-O Sts:" CUST-STAT - PERFORM READ-RECORD - ADD 1 TO C2-NO-TERMINALS - REWRITE TSP2-RECORD - DISPLAY "REWRITE " CM-CUST-NUM " Sts " CUST-STAT - " Trms:" C2-NO-TERMINALS. - CLOSE FLATFILE. - - OPEN I-O FLATFILE. - DISPLAY "For Rewrite/Delete Open I-O Sts:" CUST-STAT - PERFORM READ-RECORD - ADD 1 TO C2-NO-TERMINALS - REWRITE TSP2-RECORD - DISPLAY "REWRITE " CM-CUST-NUM " Sts " CUST-STAT - " Trms:" C2-NO-TERMINALS. - PERFORM READ-RECORD - DELETE FLATFILE - DISPLAY "DELETE " CM-CUST-NUM " Sts " CUST-STAT. - CLOSE FLATFILE. - - OPEN INPUT FLATFILE. - DISPLAY "Re-list Open Sts:" CUST-STAT - PERFORM UNTIL CUST-STAT NOT = "00" - PERFORM READ-RECORD - END-PERFORM. - CLOSE FLATFILE. - - OPEN EXTEND FLATFILE. - PERFORM LOAD-RECORD - VARYING SUB FROM 1 BY 1 - UNTIL SUB > 2. - CLOSE FLATFILE. - - OPEN INPUT FLATFILE. - DISPLAY "Re-list afer Extend Open Sts:" CUST-STAT - PERFORM UNTIL CUST-STAT NOT = "00" - PERFORM READ-RECORD - END-PERFORM. - CLOSE FLATFILE. - STOP RUN RETURNING 0. - - LOADFILE. - DISPLAY "Loading sample program data file." - UPON CONSOLE. - - OPEN OUTPUT FLATFILE. - - PERFORM LOAD-RECORD - VARYING SUB FROM 1 BY 1 - UNTIL SUB > MAX-SUB. - - DISPLAY "Sample program data file load complete." - UPON CONSOLE. - CLOSE FLATFILE. - - READ-RECORD. - MOVE SPACES TO TSPFL-RECORD. - MOVE SPACES TO TSP2-RECORD. - READ FLATFILE - IF CUST-STAT NOT = "00" - DISPLAY "Read Status: " CUST-STAT - ELSE - IF CM-TYPE = SPACES - DISPLAY "Read " CM-CUST-NUM " #:" REC-NUM - " Trms:" CM-NO-TERMINALS - ELSE - DISPLAY "Read2 " C2-CUST-NUM " #:" REC-NUM - " Trms:" C2-NO-TERMINALS - END-IF. - * - LOAD-RECORD. - MOVE SPACES TO TSPFL-RECORD. - MOVE SPACES TO TSP2-RECORD. - MOVE DATA-CUST-NUM (SUB) TO CM-CUST-NUM. - MOVE DATA-COMPANY (SUB) TO CM-COMPANY. - MOVE DATA-NO-TERMINALS (SUB) TO CM-NO-TERMINALS. - MOVE 20070319 TO CM-PK-DATE. - IF SUB = 1 OR 4 OR 6 - MOVE -20070319 TO CM-PK-DATE. - * - IF ODD-RECORD - MOVE "8417" TO C2-DISK - * MOVE CM-CUST-NUM TO C2-CUST-NUM - MOVE '2' TO C2-TYPE - * MOVE CM-COMPANY TO C2-COMPANY - MOVE CM-PK-DATE TO C2-PK-DATE - MOVE CM-NO-TERMINALS TO C2-NO-TERMINALS - MOVE DATA-ADDRESS (SUB) TO C2-ADDRESS - WRITE TSP2-RECORD - ELSE - MOVE "8470" TO CM-DISK - MOVE ' ' TO CM-TYPE - WRITE TSPFL-RECORD. -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) - -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], -[Loading sample program data file. -Sample program data file load complete. -Initial Re-Read Open Sts:00 -Read2 ALP00000 #:0001 Trms:0010 -Read BET00000 #:0002 Trms:0013 -Read2 GAM00000 #:0003 Trms:0075 -Read DEL00000 #:0004 Trms:0010 -Read2 EPS00000 #:0005 Trms:0090 -Read FOR00000 #:0006 Trms:0254 -Read Status: 10 -For Rewrite Open I-O Sts:00 -Read2 ALP00000 #:0001 Trms:0010 -REWRITE ALP00000 Sts 00 Trms:0011 -For Rewrite/Delete Open I-O Sts:00 -Read2 ALP00000 #:0001 Trms:0011 -REWRITE ALP00000 Sts 00 Trms:0012 -Read BET00000 #:0002 Trms:0013 -DELETE BET00000 Sts 00 -Re-list Open Sts:00 -Read2 ALP00000 #:0001 Trms:0012 -Read2 GAM00000 #:0003 Trms:0075 -Read DEL00000 #:0004 Trms:0010 -Read2 EPS00000 #:0005 Trms:0090 -Read FOR00000 #:0006 Trms:0254 -Read Status: 10 -Re-list afer Extend Open Sts:00 -Read2 ALP00000 #:0001 Trms:0012 -Read2 GAM00000 #:0003 Trms:0075 -Read DEL00000 #:0004 Trms:0010 -Read2 EPS00000 #:0005 Trms:0090 -Read FOR00000 #:0006 Trms:0254 -Read2 ALP00000 #:0007 Trms:0010 -Read BET00000 #:0008 Trms:0013 -Read Status: 10 -], []) - -AT_CLEANUP - - -AT_SETUP([RELATIVE one Record]) -AT_KEYWORDS([runfile]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - CONFIGURATION SECTION. - - INPUT-OUTPUT SECTION. - FILE-CONTROL. - SELECT FLATFILE ASSIGN EXTERNAL RELFIX - ORGANIZATION RELATIVE - ACCESS IS SEQUENTIAL RELATIVE KEY IS REC-NUM - FILE STATUS IS CUST-STAT. - - SELECT FLATFILE2 ASSIGN EXTERNAL RELFIX - ORGANIZATION RELATIVE - ACCESS IS RANDOM RELATIVE KEY IS REC-NUM - FILE STATUS IS CUST-STAT. - - DATA DIVISION. - FILE SECTION. - FD FLATFILE - BLOCK CONTAINS 5 RECORDS. - - 01 TSPFL-RECORD. - 10 CM-CUST-NUM PICTURE X(8). - 10 CM-COMPANY PICTURE X(25). - 10 CM-DISK PICTURE X(8). - 10 CM-NO-TERMINALS PICTURE 9(4) COMP-4. - 10 CM-PK-DATE PICTURE S9(14) COMP-3. - 10 CM-TRAILER PICTURE X(252). - - FD FLATFILE2 - BLOCK CONTAINS 5 RECORDS. - - 01 TSP2-RECORD. - 10 C2-CUST-NUM PICTURE X(8). - 10 C2-COMPANY PICTURE X(25). - 10 C2-DISK PICTURE X(8). - 10 C2-NO-TERMINALS PICTURE 9(4) COMP-4. - 10 C2-PK-DATE PICTURE S9(14) COMP-3. - 10 C2-TRAILER PICTURE X(252). - - WORKING-STORAGE SECTION. - - 77 MAX-SUB VALUE 6 PICTURE 9(4) COMP SYNC. - 77 CUST-STAT PICTURE X(2). - 77 REC-NUM VALUE 1 PICTURE 9(4) COMP SYNC. - - 01 TEST-DATA. - - 02 DATA-CUST-NUM-TBL. - - 05 FILLER PIC X(8) VALUE "ALP00000". - 05 FILLER PIC X(8) VALUE "BET00000". - 05 FILLER PIC X(8) VALUE "DEL00000". - 05 FILLER PIC X(8) VALUE "EPS00000". - 05 FILLER PIC X(8) VALUE "FOR00000". - 05 FILLER PIC X(8) VALUE "GAM00000". - - 02 DATA-CUST-NUM REDEFINES DATA-CUST-NUM-TBL - PIC X(8) OCCURS 6. - 02 DATA-COMPANY-TBL. - - 05 FILLER PIC X(25) VALUE "ALPHA ELECTRICAL CO. LTD.". - 05 FILLER PIC X(25) VALUE "BETA SHOE MFG. INC. ". - 05 FILLER PIC X(25) VALUE "DELTA LUGGAGE REPAIRS ". - 05 FILLER PIC X(25) VALUE "EPSILON EQUIPMENT SUPPLY ". - 05 FILLER PIC X(25) VALUE "FORTUNE COOKIE COMPANY ". - 05 FILLER PIC X(25) VALUE "GAMMA X-RAY TECHNOLOGY ". - 02 DATA-COMPANY REDEFINES DATA-COMPANY-TBL - PIC X(25) OCCURS 6. - 02 DATA-ADDRESS-2-TBL. - - 05 FILLER PIC X(10) VALUE "ATLANTA ". - 05 FILLER PIC X(10) VALUE "CALGARY ". - 05 FILLER PIC X(10) VALUE "NEW YORK ". - 05 FILLER PIC X(10) VALUE "TORONTO ". - 05 FILLER PIC X(10) VALUE "WASHINGTON". - 05 FILLER PIC X(10) VALUE "WHITEPLAIN". - 02 DATA-ADDRESS REDEFINES DATA-ADDRESS-2-TBL - PIC X(10) OCCURS 6. - - 02 DATA-NO-TERMINALS-TBL. - - 05 FILLER PIC 9(3) COMP-3 VALUE 10. - 05 FILLER PIC 9(3) COMP-3 VALUE 13. - 05 FILLER PIC 9(3) COMP-3 VALUE 75. - 05 FILLER PIC 9(3) COMP-3 VALUE 10. - 05 FILLER PIC 9(3) COMP-3 VALUE 90. - 05 FILLER PIC 9(3) COMP-3 VALUE 254. - - 02 DATA-NO-TERMINALS REDEFINES DATA-NO-TERMINALS-TBL - PIC 9(3) COMP-3 OCCURS 6. - 01 WORK-AREA. - 05 SUB PICTURE 9(4) COMP SYNC. - 88 ODD-RECORD VALUE 1 3 5. - - - PROCEDURE DIVISION. - - PERFORM LOADFILE. - - OPEN INPUT FLATFILE. - DISPLAY "Open Sts:" CUST-STAT - PERFORM 4 TIMES - PERFORM READ-NEXT - END-PERFORM. - CLOSE FLATFILE. - - DISPLAY "*** Test Update of file ***". - OPEN I-O FLATFILE. - PERFORM READ-NEXT - ADD 1 TO CM-NO-TERMINALS - REWRITE TSPFL-RECORD - DISPLAY "REWRITE " CM-CUST-NUM " Sts " CUST-STAT - " Trms:" CM-NO-TERMINALS. - CLOSE FLATFILE. - - OPEN I-O FLATFILE. - READ FLATFILE - DISPLAY "Read " CM-CUST-NUM " Sts:" CUST-STAT. - ADD 1 TO CM-NO-TERMINALS - REWRITE TSPFL-RECORD - DISPLAY "REWRITE " CM-CUST-NUM " Sts " CUST-STAT - " Trms:" CM-NO-TERMINALS. - READ FLATFILE WITH LOCK - DISPLAY "Read " CM-CUST-NUM - DELETE FLATFILE - DISPLAY "DELETE " CM-CUST-NUM " Sts " CUST-STAT. - CLOSE FLATFILE. - - DISPLAY "*** List file afer Update/Delete ***". - OPEN INPUT FLATFILE. - PERFORM 4 TIMES - READ FLATFILE - DISPLAY "Read " CM-CUST-NUM " Sts " CUST-STAT - " Trms:" CM-NO-TERMINALS - END-PERFORM. - CLOSE FLATFILE. - OPEN I-O FLATFILE2. - MOVE SPACES TO TSP2-RECORD. - MOVE 5 TO REC-NUM. - PERFORM READ2. - MOVE 3 TO REC-NUM. - PERFORM READ2. - WRITE TSP2-RECORD. - DISPLAY "Write of " REC-NUM " Sts " CUST-STAT - PERFORM READ2. - MOVE SPACES TO TSP2-RECORD. - MOVE 2 TO REC-NUM. - READ FLATFILE2. - DISPLAY " Read of deleted " REC-NUM " Sts " CUST-STAT - MOVE SPACES TO TSP2-RECORD. - MOVE DATA-CUST-NUM (2) TO C2-CUST-NUM. - MOVE DATA-COMPANY (2) TO C2-COMPANY. - MOVE DATA-NO-TERMINALS (2) TO C2-NO-TERMINALS. - MOVE 20070319 TO C2-PK-DATE. - MOVE "8440" TO C2-DISK - MOVE 2 TO REC-NUM. - REWRITE TSP2-RECORD. - DISPLAY "ReWrite deleted " C2-CUST-NUM " Sts " CUST-STAT - MOVE SPACES TO TSP2-RECORD. - MOVE DATA-CUST-NUM (2) TO C2-CUST-NUM. - MOVE DATA-COMPANY (2) TO C2-COMPANY. - MOVE DATA-NO-TERMINALS (2) TO C2-NO-TERMINALS. - MOVE 20070319 TO C2-PK-DATE. - MOVE "8440" TO C2-DISK - MOVE 2 TO REC-NUM. - WRITE TSP2-RECORD. - DISPLAY "Write of deleted " C2-CUST-NUM " Sts " CUST-STAT - CLOSE FLATFILE2. - - DISPLAY "*** List file afer Re-Add ***". - OPEN INPUT FLATFILE. - PERFORM 4 TIMES - PERFORM READ-RECORD - END-PERFORM. - PERFORM READ-PREV - PERFORM READ-PREV - PERFORM READ-PREV - PERFORM READ-PREV - START FLATFILE LAST - DISPLAY "Start Last Sts " CUST-STAT " Rec#" REC-NUM. - PERFORM READ-PREV - PERFORM READ-PREV - START FLATFILE FIRST - DISPLAY "Start First Sts " CUST-STAT " Rec#" REC-NUM. - PERFORM READ-NEXT - PERFORM READ-NEXT - MOVE 4 TO REC-NUM. - START FLATFILE KEY GREATER OR EQUAL REC-NUM. - DISPLAY "Start GE 4:" REC-NUM - " Sts " CUST-STAT " Rec#" REC-NUM. - PERFORM READ-NEXT - PERFORM READ-NEXT - MOVE 4 TO REC-NUM. - START FLATFILE KEY GREATER REC-NUM. - DISPLAY "Start GT 4:" REC-NUM - " Sts " CUST-STAT " Rec#" REC-NUM. - PERFORM READ-NEXT - PERFORM READ-NEXT - MOVE 5 TO REC-NUM. - START FLATFILE KEY LESS REC-NUM. - DISPLAY "Start LT 5: " REC-NUM - " Sts " CUST-STAT " Rec#" REC-NUM. - PERFORM READ-RECORD. - PERFORM READ-PREV - MOVE 5 TO REC-NUM. - START FLATFILE KEY LESS OR EQUAL REC-NUM. - DISPLAY "Start LE 5:" REC-NUM - " Sts " CUST-STAT " Rec#" REC-NUM. - PERFORM READ-RECORD. - PERFORM READ-PREV - CLOSE FLATFILE. - - OPEN INPUT FLATFILE. - DISPLAY "Re-list Open Sts:" CUST-STAT - PERFORM UNTIL CUST-STAT NOT = "00" - PERFORM READ-RECORD - END-PERFORM. - CLOSE FLATFILE. - - OPEN EXTEND FLATFILE. - MOVE 2 TO SUB - PERFORM LOAD-RECORD . - CLOSE FLATFILE. - - OPEN INPUT FLATFILE. - DISPLAY "Re-list after Extend Open Sts:" CUST-STAT - PERFORM UNTIL CUST-STAT NOT = "00" - PERFORM READ-RECORD - END-PERFORM. - CLOSE FLATFILE. - OPEN INPUT FLATFILE2. - PERFORM READ2 - VARYING REC-NUM FROM 1 BY 1 - UNTIL REC-NUM > MAX-SUB + 5 - OR CUST-STAT NOT = "00". - CLOSE FLATFILE2. - STOP RUN RETURNING 0. - - READ2. - MOVE SPACES TO TSP2-RECORD. - READ FLATFILE2 - INVALID KEY - DISPLAY "Invalid Read2 " REC-NUM - " Status: " CUST-STAT - END-READ - IF CUST-STAT NOT = "00" - DISPLAY "Read2 Status: " CUST-STAT - ELSE - DISPLAY "Read2 " C2-CUST-NUM - " #" REC-NUM - " Trms:" C2-NO-TERMINALS - END-IF. - - READ-RECORD. - MOVE SPACES TO TSPFL-RECORD. - READ FLATFILE - IF CUST-STAT NOT = "00" - DISPLAY "Read Status: " CUST-STAT - ELSE - DISPLAY "Read " CM-CUST-NUM - " #" REC-NUM - " Trms:" CM-NO-TERMINALS - END-IF. - - READ-PREV. - MOVE SPACES TO TSPFL-RECORD. - READ FLATFILE PREVIOUS - IF CUST-STAT NOT = "00" - DISPLAY "Read Prev Status: " CUST-STAT - ELSE - DISPLAY "Prev " CM-CUST-NUM - " #" REC-NUM - " Trms:" CM-NO-TERMINALS - END-IF. - - READ-NEXT. - MOVE SPACES TO TSPFL-RECORD. - READ FLATFILE NEXT - IF CUST-STAT NOT = "00" - DISPLAY "Read Next Status: " CUST-STAT - ELSE - DISPLAY "Next " CM-CUST-NUM - " #" REC-NUM - " Trms:" CM-NO-TERMINALS - END-IF. - - LOADFILE. - DISPLAY "Loading sample program data file." - UPON CONSOLE. - - OPEN OUTPUT FLATFILE. - - PERFORM LOAD-RECORD - VARYING SUB FROM 1 BY 1 - UNTIL SUB > MAX-SUB. - - DISPLAY "Sample program data file load complete." - UPON CONSOLE. - CLOSE FLATFILE. - - LOAD-RECORD. - - MOVE SPACES TO TSPFL-RECORD. - MOVE DATA-CUST-NUM (SUB) TO CM-CUST-NUM. - MOVE DATA-COMPANY (SUB) TO CM-COMPANY. - MOVE DATA-NO-TERMINALS (SUB) TO CM-NO-TERMINALS. - MOVE 20070319 TO CM-PK-DATE. - IF SUB = 1 OR 4 OR 6 - MOVE -20070319 TO CM-PK-DATE. - - IF ODD-RECORD - MOVE "8417" TO CM-DISK - ELSE - MOVE "8470" TO CM-DISK. - WRITE TSPFL-RECORD. -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) - -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], -[Loading sample program data file. -Sample program data file load complete. -Open Sts:00 -Next ALP00000 #0001 Trms:0010 -Next BET00000 #0002 Trms:0013 -Next DEL00000 #0003 Trms:0075 -Next EPS00000 #0004 Trms:0010 -*** Test Update of file *** -Next ALP00000 #0001 Trms:0010 -REWRITE ALP00000 Sts 00 Trms:0011 -Read ALP00000 Sts:00 -REWRITE ALP00000 Sts 00 Trms:0012 -Read BET00000 -DELETE BET00000 Sts 00 -*** List file afer Update/Delete *** -Read ALP00000 Sts 00 Trms:0012 -Read DEL00000 Sts 00 Trms:0075 -Read EPS00000 Sts 00 Trms:0010 -Read FOR00000 Sts 00 Trms:0090 -Read2 FOR00000 #0005 Trms:0090 -Read2 DEL00000 #0003 Trms:0075 -Write of 0003 Sts 22 -Read2 DEL00000 #0003 Trms:0075 - Read of deleted 0002 Sts 23 -ReWrite deleted BET00000 Sts 23 -Write of deleted BET00000 Sts 00 -*** List file afer Re-Add *** -Read ALP00000 #0001 Trms:0012 -Read BET00000 #0002 Trms:0013 -Read DEL00000 #0003 Trms:0075 -Read EPS00000 #0004 Trms:0010 -Prev DEL00000 #0003 Trms:0075 -Prev BET00000 #0002 Trms:0013 -Prev ALP00000 #0001 Trms:0012 -Read Prev Status: 10 -Start Last Sts 00 Rec#0006 -Prev GAM00000 #0006 Trms:0254 -Prev FOR00000 #0005 Trms:0090 -Start First Sts 00 Rec#0001 -Next ALP00000 #0001 Trms:0012 -Next BET00000 #0002 Trms:0013 -Start GE 4:0004 Sts 00 Rec#0004 -Next EPS00000 #0004 Trms:0010 -Next FOR00000 #0005 Trms:0090 -Start GT 4:0005 Sts 00 Rec#0005 -Next FOR00000 #0005 Trms:0090 -Next GAM00000 #0006 Trms:0254 -Start LT 5: 0004 Sts 00 Rec#0004 -Read EPS00000 #0004 Trms:0010 -Prev DEL00000 #0003 Trms:0075 -Start LE 5:0005 Sts 00 Rec#0005 -Read FOR00000 #0005 Trms:0090 -Prev EPS00000 #0004 Trms:0010 -Re-list Open Sts:00 -Read ALP00000 #0001 Trms:0012 -Read BET00000 #0002 Trms:0013 -Read DEL00000 #0003 Trms:0075 -Read EPS00000 #0004 Trms:0010 -Read FOR00000 #0005 Trms:0090 -Read GAM00000 #0006 Trms:0254 -Read Status: 10 -Re-list after Extend Open Sts:00 -Read ALP00000 #0001 Trms:0012 -Read BET00000 #0002 Trms:0013 -Read DEL00000 #0003 Trms:0075 -Read EPS00000 #0004 Trms:0010 -Read FOR00000 #0005 Trms:0090 -Read GAM00000 #0006 Trms:0254 -Read BET00000 #0007 Trms:0013 -Read Status: 10 -Read2 ALP00000 #0001 Trms:0012 -Read2 BET00000 #0002 Trms:0013 -Read2 DEL00000 #0003 Trms:0075 -Read2 EPS00000 #0004 Trms:0010 -Read2 FOR00000 #0005 Trms:0090 -Read2 GAM00000 #0006 Trms:0254 -Read2 BET00000 #0007 Trms:0013 -Invalid Read2 0008 Status: 23 -Read2 Status: 23 -], []) - -AT_CLEANUP - - -AT_SETUP([SEQUENTIAL Multi-Record]) -AT_KEYWORDS([runfile]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - - ENVIRONMENT DIVISION. - CONFIGURATION SECTION. - - INPUT-OUTPUT SECTION. - FILE-CONTROL. - SELECT FLATFILE ASSIGN EXTERNAL SEQVAR - ORGANIZATION SEQUENTIAL - FILE STATUS IS CUST-STAT . - - DATA DIVISION. - FILE SECTION. - FD FLATFILE - BLOCK CONTAINS 5 RECORDS. - - 01 TSPFL-RECORD. - 10 CM-CUST-NUM PICTURE X(8). - 10 CM-TYPE PICTURE X. - 10 CM-COMPANY PICTURE X(25). - 10 CM-DISK PICTURE X(8). - 10 CM-NO-TERMINALS PICTURE 9(4) COMP-4. - 10 CM-PK-DATE PICTURE S9(14) COMP-3. - 10 CM-TRAILER PICTURE X(251). - - 01 TSP2-RECORD. - 10 C2-CUST-NUM PICTURE X(8). - 10 C2-TYPE PICTURE X. - 10 C2-COMPANY PICTURE X(25). - 10 C2-ADDRESS PICTURE X(25). - 10 C2-DISK PICTURE X(8). - 10 C2-NO-TERMINALS PICTURE 9(4) COMP-4. - 10 C2-PK-DATE PICTURE S9(14) COMP-3. - - WORKING-STORAGE SECTION. - - 77 MAX-SUB VALUE 6 PICTURE 9(4) COMP. - 77 ZRO VALUE 1 PICTURE 9(4) COMP. - 77 CUST-STAT PICTURE X(2). - 77 REC-NUM VALUE 1 PICTURE 9(8) COMP. - - 01 TEST-DATA. - - 02 DATA-CUST-NUM-TBL. - - 05 FILLER PIC X(8) VALUE "ALP00000". - 05 FILLER PIC X(8) VALUE "BET00000". - 05 FILLER PIC X(8) VALUE "GAM00000". - 05 FILLER PIC X(8) VALUE "DEL00000". - 05 FILLER PIC X(8) VALUE "EPS00000". - 05 FILLER PIC X(8) VALUE "FOR00000". - - 02 DATA-CUST-NUM REDEFINES DATA-CUST-NUM-TBL - PIC X(8) OCCURS 6. - 02 DATA-COMPANY-TBL. - - 05 FILLER PIC X(25) VALUE "ALPHA ELECTRICAL CO. LTD.". - 05 FILLER PIC X(25) VALUE "BETA SHOE MFG. INC. ". - 05 FILLER PIC X(25) VALUE "GAMMA X-RAY TECHNOLOGY ". - 05 FILLER PIC X(25) VALUE "DELTA LUGGAGE REPAIRS ". - 05 FILLER PIC X(25) VALUE "EPSILON EQUIPMENT SUPPLY ". - 05 FILLER PIC X(25) VALUE "FORTUNE COOKIE COMPANY ". - 02 DATA-COMPANY REDEFINES DATA-COMPANY-TBL - PIC X(25) OCCURS 6. - 02 DATA-ADDRESS-2-TBL. - - 05 FILLER PIC X(10) VALUE "NEW YORK ". - 05 FILLER PIC X(10) VALUE "ATLANTA ". - 05 FILLER PIC X(10) VALUE "WASHINGTON". - 05 FILLER PIC X(10) VALUE "TORONTO ". - 05 FILLER PIC X(10) VALUE "CALGARY ". - 05 FILLER PIC X(10) VALUE "WHITEPLAIN". - - 02 DATA-ADDRESS REDEFINES DATA-ADDRESS-2-TBL - PIC X(10) OCCURS 6. - - 02 DATA-NO-TERMINALS-TBL. - - 05 FILLER PIC 9(4) COMP-4 VALUE 10. - 05 FILLER PIC 9(4) COMP-4 VALUE 13. - 05 FILLER PIC 9(4) COMP-4 VALUE 75. - 05 FILLER PIC 9(4) COMP-4 VALUE 10. - 05 FILLER PIC 9(4) COMP-4 VALUE 90. - 05 FILLER PIC 9(4) COMP-4 VALUE 254. - - 02 DATA-NO-TERMINALS REDEFINES DATA-NO-TERMINALS-TBL - PIC 9(4) COMP-4 OCCURS 6. - 01 WORK-AREA. - 05 SUB PICTURE 9(4) COMP. - 88 ODD-RECORD VALUE 1 3 5. - - - PROCEDURE DIVISION. - - PERFORM LOADFILE. - OPEN INPUT FLATFILE. - DISPLAY "Open Sts:" CUST-STAT - PERFORM READ-RECORD - PERFORM READ-RECORD - CLOSE FLATFILE. - - OPEN I-O FLATFILE. - PERFORM READ-RECORD - ADD 1 TO C2-NO-TERMINALS - REWRITE TSP2-RECORD - DISPLAY "REWRITE " CM-CUST-NUM " Sts " CUST-STAT - " Trms:" C2-NO-TERMINALS. - CLOSE FLATFILE. - - OPEN I-O FLATFILE. - PERFORM READ-RECORD - ADD 1 TO C2-NO-TERMINALS - REWRITE TSP2-RECORD - DISPLAY "REWRITE " C2-CUST-NUM " Sts " CUST-STAT - " Trms:" C2-NO-TERMINALS. - PERFORM READ-RECORD - * DELETE should cause compiler error - * DELETE FLATFILE - * DISPLAY "DELETE " CM-CUST-NUM " Sts " CUST-STAT. - CLOSE FLATFILE. - - OPEN I-O FLATFILE. - PERFORM READ-RECORD. - PERFORM READ-RECORD. - ADD 1 TO C2-NO-TERMINALS - REWRITE TSP2-RECORD - DISPLAY "REWRITE2 " C2-CUST-NUM " Sts " CUST-STAT - " Trms:" C2-NO-TERMINALS. - CLOSE FLATFILE. - - OPEN I-O FLATFILE. - PERFORM READ-RECORD. - ADD 1 TO CM-NO-TERMINALS - REWRITE TSPFL-RECORD - DISPLAY "REWRITE " CM-CUST-NUM " Sts " CUST-STAT - " Trms:" CM-NO-TERMINALS. - CLOSE FLATFILE. - - - OPEN INPUT FLATFILE. - DISPLAY "Reread file after updates Open Sts:" CUST-STAT. - PERFORM UNTIL CUST-STAT NOT = "00" - PERFORM READ-RECORD - END-PERFORM. - CLOSE FLATFILE. - - OPEN EXTEND FLATFILE. - MOVE 1 TO SUB - PERFORM LOAD-RECORD - CLOSE FLATFILE. - - OPEN INPUT FLATFILE. - DISPLAY "Re-list after extend Open Sts:" CUST-STAT - PERFORM UNTIL CUST-STAT NOT = "00" - PERFORM READ-RECORD - END-PERFORM. - CLOSE FLATFILE. - STOP RUN RETURNING 0. - - LOADFILE. - DISPLAY "Loading sample program data file." - UPON CONSOLE. - - OPEN OUTPUT FLATFILE. - - PERFORM LOAD-RECORD - VARYING SUB FROM 1 BY 1 - UNTIL SUB > MAX-SUB. - - DISPLAY "Sample program data file load complete." - UPON CONSOLE. - CLOSE FLATFILE. - - READ-RECORD. - MOVE SPACES TO TSPFL-RECORD. - MOVE SPACES TO TSP2-RECORD. - READ FLATFILE - IF CUST-STAT NOT = "00" - DISPLAY "Read status: " CUST-STAT - ELSE - IF CM-TYPE = SPACES - DISPLAY "Read " CM-CUST-NUM - " Trms:" CM-NO-TERMINALS - ELSE - DISPLAY "Read2 " C2-CUST-NUM - " Trms:" C2-NO-TERMINALS - END-IF. - * - LOAD-RECORD. - MOVE SPACES TO TSPFL-RECORD. - MOVE SPACES TO TSP2-RECORD. - MOVE DATA-CUST-NUM (SUB) TO CM-CUST-NUM. - MOVE DATA-COMPANY (SUB) TO CM-COMPANY. - MOVE DATA-NO-TERMINALS (SUB) TO CM-NO-TERMINALS. - MOVE 20070319 TO CM-PK-DATE. - IF SUB = 1 OR 4 OR 6 - MOVE -20070319 TO CM-PK-DATE. - * - IF ODD-RECORD - MOVE "8417" TO CM-DISK - ELSE - MOVE "8470" TO CM-DISK. - IF ODD-RECORD - * MOVE CM-CUST-NUM TO C2-CUST-NUM - * MOVE CM-COMPANY TO C2-COMPANY - MOVE CM-DISK TO C2-DISK - MOVE CM-PK-DATE TO C2-PK-DATE - MOVE CM-NO-TERMINALS TO C2-NO-TERMINALS - MOVE DATA-ADDRESS (SUB) TO C2-ADDRESS - MOVE '2' TO C2-TYPE - WRITE TSP2-RECORD - ELSE - WRITE TSPFL-RECORD. -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) - -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], -[Loading sample program data file. -Sample program data file load complete. -Open Sts:00 -Read2 ALP00000 Trms:0010 -Read BET00000 Trms:0013 -Read2 ALP00000 Trms:0010 -REWRITE ALP00000 Sts 00 Trms:0011 -Read2 ALP00000 Trms:0011 -REWRITE ALP00000 Sts 00 Trms:0012 -Read BET00000 Trms:0013 -Read2 ALP00000 Trms:0012 -Read BET00000 Trms:0013 -REWRITE2 BET00000 Sts 44 Trms:8225 -Read2 ALP00000 Trms:0012 -REWRITE ALP00000 Sts 44 Trms:8225 -Reread file after updates Open Sts:00 -Read2 ALP00000 Trms:0012 -Read BET00000 Trms:0013 -Read2 GAM00000 Trms:0075 -Read DEL00000 Trms:0010 -Read2 EPS00000 Trms:0090 -Read FOR00000 Trms:0254 -Read status: 10 -Re-list after extend Open Sts:00 -Read2 ALP00000 Trms:0012 -Read BET00000 Trms:0013 -Read2 GAM00000 Trms:0075 -Read DEL00000 Trms:0010 -Read2 EPS00000 Trms:0090 -Read FOR00000 Trms:0254 -Read2 ALP00000 Trms:0010 -Read status: 10 -], []) - -AT_CLEANUP - - -AT_SETUP([SEQUENTIAL one Record]) -AT_KEYWORDS([runfile]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - - ENVIRONMENT DIVISION. - CONFIGURATION SECTION. - - INPUT-OUTPUT SECTION. - FILE-CONTROL. - SELECT FLATFILE ASSIGN EXTERNAL SEQFIX - ORGANIZATION SEQUENTIAL - FILE STATUS IS CUST-STAT . - - DATA DIVISION. - FILE SECTION. - FD FLATFILE - BLOCK CONTAINS 5 RECORDS. - - 01 TSPFL-RECORD. - 10 CM-CUST-NUM PICTURE X(8). - 10 CM-COMPANY PICTURE X(25). - 10 CM-DISK PICTURE X(8). - 10 CM-NO-TERMINALS PICTURE 9(4) COMP-4. - 10 CM-PK-DATE PICTURE S9(14) COMP-3. - 10 CM-TRAILER PICTURE X(8). - - WORKING-STORAGE SECTION. - - 77 MAX-SUB VALUE 6 PICTURE 9(4) COMP SYNC. - 77 CUST-STAT PICTURE X(2). - - 01 TEST-DATA. - - 02 DATA-CUST-NUM-TBL. - - 05 FILLER PIC X(8) VALUE "ALP00000". - 05 FILLER PIC X(8) VALUE "BET00000". - 05 FILLER PIC X(8) VALUE "GAM00000". - 05 FILLER PIC X(8) VALUE "DEL00000". - 05 FILLER PIC X(8) VALUE "EPS00000". - 05 FILLER PIC X(8) VALUE "FOR00000". - - 02 DATA-CUST-NUM REDEFINES DATA-CUST-NUM-TBL - PIC X(8) OCCURS 6. - 02 DATA-COMPANY-TBL. - - 05 FILLER PIC X(25) VALUE "ALPHA ELECTRICAL CO. LTD.". - 05 FILLER PIC X(25) VALUE "BETA SHOE MFG. INC. ". - 05 FILLER PIC X(25) VALUE "GAMMA X-RAY TECHNOLOGY ". - 05 FILLER PIC X(25) VALUE "DELTA LUGGAGE REPAIRS ". - 05 FILLER PIC X(25) VALUE "EPSILON EQUIPMENT SUPPLY ". - 05 FILLER PIC X(25) VALUE "FORTUNE COOKIE COMPANY ". - 02 DATA-COMPANY REDEFINES DATA-COMPANY-TBL - PIC X(25) OCCURS 6. - 02 DATA-ADDRESS-2-TBL. - - 05 FILLER PIC X(10) VALUE "NEW YORK ". - 05 FILLER PIC X(10) VALUE "ATLANTA ". - 05 FILLER PIC X(10) VALUE "WASHINGTON". - 05 FILLER PIC X(10) VALUE "TORONTO ". - 05 FILLER PIC X(10) VALUE "CALGARY ". - 05 FILLER PIC X(10) VALUE "WHITEPLAIN". - - 02 DATA-ADDRESS REDEFINES DATA-ADDRESS-2-TBL - PIC X(10) OCCURS 6. - - 02 DATA-NO-TERMINALS-TBL. - - 05 FILLER PIC 9(3) COMP-3 VALUE 10. - 05 FILLER PIC 9(3) COMP-3 VALUE 13. - 05 FILLER PIC 9(3) COMP-3 VALUE 75. - 05 FILLER PIC 9(3) COMP-3 VALUE 10. - 05 FILLER PIC 9(3) COMP-3 VALUE 90. - 05 FILLER PIC 9(3) COMP-3 VALUE 254. - - 02 DATA-NO-TERMINALS REDEFINES DATA-NO-TERMINALS-TBL - PIC 9(3) COMP-3 OCCURS 6. - 01 WORK-AREA. - 05 SUB PICTURE 9(4) COMP SYNC. - 88 ODD-RECORD VALUE 1 3 5. - - - PROCEDURE DIVISION. - - PERFORM LOADFILE. - OPEN INPUT FLATFILE. - DISPLAY "Open Sts:" CUST-STAT - READ FLATFILE - DISPLAY "Read " CM-CUST-NUM " Sts:" CUST-STAT. - READ FLATFILE - DISPLAY "Read " CM-CUST-NUM " Sts:" CUST-STAT. - CLOSE FLATFILE. - - OPEN I-O FLATFILE. - READ FLATFILE - DISPLAY "Read " CM-CUST-NUM " Sts:" CUST-STAT. - ADD 1 TO CM-NO-TERMINALS - REWRITE TSPFL-RECORD - DISPLAY "REWRITE " CM-CUST-NUM " Sts " CUST-STAT - " Trms:" CM-NO-TERMINALS. - CLOSE FLATFILE. - - OPEN I-O FLATFILE. - READ FLATFILE - DISPLAY "Read " CM-CUST-NUM " Sts:" CUST-STAT. - ADD 1 TO CM-NO-TERMINALS - REWRITE TSPFL-RECORD - DISPLAY "REWRITE " CM-CUST-NUM " Sts " CUST-STAT - " Trms:" CM-NO-TERMINALS. - READ FLATFILE WITH LOCK - DISPLAY "Read " CM-CUST-NUM - * DELETE FLATFILE - * DISPLAY "DELETE " CM-CUST-NUM " Sts " CUST-STAT. - CLOSE FLATFILE. - OPEN INPUT FLATFILE. - DISPLAY "Re-list File Open Sts:" CUST-STAT - PERFORM UNTIL CUST-STAT NOT = "00" - PERFORM READ-RECORD - END-PERFORM. - CLOSE FLATFILE. - OPEN EXTEND FLATFILE. - MOVE 2 TO SUB - PERFORM LOAD-RECORD - CLOSE FLATFILE. - OPEN INPUT FLATFILE. - DISPLAY "List File afer EXTEND Open Sts:" CUST-STAT - PERFORM UNTIL CUST-STAT NOT = "00" - PERFORM READ-RECORD - END-PERFORM. - CLOSE FLATFILE. - STOP RUN RETURNING 0. - - READ-RECORD. - MOVE SPACES TO TSPFL-RECORD. - READ FLATFILE - IF CUST-STAT NOT = "00" - DISPLAY "Read Status: " CUST-STAT - ELSE - DISPLAY "Read " CM-CUST-NUM - " Trms:" CM-NO-TERMINALS - END-IF. - - LOADFILE. - DISPLAY "Loading sample data file.". - - OPEN OUTPUT FLATFILE. - - PERFORM LOAD-RECORD - VARYING SUB FROM 1 BY 1 - UNTIL SUB > MAX-SUB. - - DISPLAY "Sample data file load complete.". - CLOSE FLATFILE. - - LOAD-RECORD. - - MOVE SPACES TO TSPFL-RECORD. - MOVE DATA-CUST-NUM (SUB) TO CM-CUST-NUM. - MOVE DATA-COMPANY (SUB) TO CM-COMPANY. - MOVE DATA-NO-TERMINALS (SUB) TO CM-NO-TERMINALS. - MOVE 20070319 TO CM-PK-DATE. - IF SUB = 1 OR 4 OR 6 - MOVE -20070319 TO CM-PK-DATE. - - IF ODD-RECORD - MOVE "8417" TO CM-DISK - ELSE - MOVE "8470" TO CM-DISK. - WRITE TSPFL-RECORD. -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) - -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], -[Loading sample data file. -Sample data file load complete. -Open Sts:00 -Read ALP00000 Sts:00 -Read BET00000 Sts:00 -Read ALP00000 Sts:00 -REWRITE ALP00000 Sts 00 Trms:0011 -Read ALP00000 Sts:00 -REWRITE ALP00000 Sts 00 Trms:0012 -Read BET00000 -Re-list File Open Sts:00 -Read ALP00000 Trms:0012 -Read BET00000 Trms:0013 -Read GAM00000 Trms:0075 -Read DEL00000 Trms:0010 -Read EPS00000 Trms:0090 -Read FOR00000 Trms:0254 -Read Status: 10 -List File afer EXTEND Open Sts:00 -Read ALP00000 Trms:0012 -Read BET00000 Trms:0013 -Read GAM00000 Trms:0075 -Read DEL00000 Trms:0010 -Read EPS00000 Trms:0090 -Read FOR00000 Trms:0254 -Read BET00000 Trms:0013 -Read Status: 10 -], []) - -AT_CLEANUP - - -AT_SETUP([trace feature]) -AT_KEYWORDS([runfile]) - -# FIXME: this test should use line sequential or relative files, -# possibly add a second one for INDEXED! -AT_SKIP_IF([test "$COB_HAS_ISAM" = "no"]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - - ENVIRONMENT DIVISION. - CONFIGURATION SECTION. - - INPUT-OUTPUT SECTION. - FILE-CONTROL. - SELECT TSPFILE - ASSIGN TO "testisam" - ORGANIZATION INDEXED ACCESS DYNAMIC - RECORD KEY IS CM-CUST-NUM - ALTERNATE RECORD KEY IS CM-TELEPHONE WITH DUPLICATES - ALTERNATE RECORD KEY IS CM-DISK WITH DUPLICATES - FILE STATUS IS CUST-STAT . - - SELECT TSTFILE - ASSIGN TO "testisam" - ORGANIZATION INDEXED ACCESS DYNAMIC - RECORD KEY IS TS-CUST-NUM - ALTERNATE RECORD KEY IS TS-TELEPHONE WITH DUPLICATES - ALTERNATE RECORD KEY IS TS-DISK WITH DUPLICATES - FILE STATUS IS CUST-STAT . - - DATA DIVISION. - FILE SECTION. - FD TSPFILE - BLOCK CONTAINS 5 RECORDS. - - 01 TSPFL-RECORD. - 05 TSPFL-REC. - 10 CM-CUST-NUM. - 15 CM-CUST-PRE PICTURE X(3). - 15 CM-CUST-NNN PICTURE X(5). - 10 CM-STATUS PICTURE X. - 10 CM-COMPANY PICTURE X(25). - 10 CM-ADDRESS-1 PICTURE X(25). - 10 CM-ADDRESS-2 PICTURE X(25). - 10 CM-ADDRESS-3 PICTURE X(25). - 10 CM-TELEPHONE PICTURE 9(10). - 10 CM-DP-MGR PICTURE X(25). - 10 CM-MACHINE PICTURE X(8). - 10 CM-MEMORY PICTURE X(4). - 10 CM-DISK PICTURE X(8). - 10 CM-TAPE PICTURE X(8). - 10 CM-NO-TERMINALS PICTURE 9(5). - - FD TSTFILE - BLOCK CONTAINS 5 RECORDS. - - 01 TSTFL-RECORD. - 05 TSTFL-REC. - 10 TS-CUST-NUM PICTURE X(8). - 10 TS-STATUS PICTURE X. - 10 TS-COMPANY PICTURE X(25). - 10 TS-ADDRESS-1 PICTURE X(25). - 10 TS-ADDRESS-2 PICTURE X(25). - 10 TS-ADDRESS-3 PICTURE X(25). - 10 TS-TELEPHONE PICTURE 9(10). - 10 TS-DP-MGR PICTURE X(25). - 10 TS-MACHINE PICTURE X(8). - 10 TS-MEMORY PICTURE X(4). - 10 TS-DISK PICTURE X(8). - 10 TS-TAPE PICTURE X(8). - - - WORKING-STORAGE SECTION. - - 01 CUST-STAT. - 05 STAT-1 PICTURE 9(4) COMP SYNC. - 05 FILLER REDEFINES STAT-1. - 10 STAT-X1 PIC X COMP-X. - 10 STAT-X2 PIC X COMP-X. - 77 BYTE-1 PICTURE 9(3). - 77 BYTE-2 PICTURE 9(3). - 77 MAX-SUB VALUE 16 PICTURE 9(5) COMP SYNC. - - 01 TEST-DATA. - - 02 DATA-CUST-NUM-TBL. - - 05 FILLER PIC X(8) VALUE "ALP00000". - 05 FILLER PIC X(8) VALUE "BET00000". - 05 FILLER PIC X(8) VALUE "GAM00000". - 05 FILLER PIC X(8) VALUE "DEL00000". - 05 FILLER PIC X(8) VALUE "EPS00000". - 05 FILLER PIC X(8) VALUE "FOR00000". - 05 FILLER PIC X(8) VALUE "GIB00000". - 05 FILLER PIC X(8) VALUE "H&J00000". - 05 FILLER PIC X(8) VALUE "INC00000". - 05 FILLER PIC X(8) VALUE "JOH00000". - 05 FILLER PIC X(8) VALUE "KON00000". - 05 FILLER PIC X(8) VALUE "LEW00000". - 05 FILLER PIC X(8) VALUE "MOR00000". - 05 FILLER PIC X(8) VALUE "NEW00000". - 05 FILLER PIC X(8) VALUE "OLD00000". - 05 FILLER PIC X(8) VALUE "PRE00000". - - 02 DATA-CUST-NUM REDEFINES DATA-CUST-NUM-TBL - PIC X(8) OCCURS 16. - 02 DATA-COMPANY-TBL. - - 05 FILLER PIC X(25) VALUE "ALPHA ELECTRICAL CO. LTD.". - 05 FILLER PIC X(25) VALUE "BETA SHOE MFG. INC. ". - 05 FILLER PIC X(25) VALUE "GAMMA X-RAY TECHNOLOGY ". - 05 FILLER PIC X(25) VALUE "DELTA LUGGAGE REPAIRS ". - 05 FILLER PIC X(25) VALUE "EPSILON EQUIPMENT SUPPLY ". - 05 FILLER PIC X(25) VALUE "FORTUNE COOKIE COMPANY ". - 05 FILLER PIC X(25) VALUE "GIBRALTER LIFE INSURANCE ". - 05 FILLER PIC X(25) VALUE "H & J PLUMBING SUPPLIES ". - 05 FILLER PIC X(25) VALUE "INCREMENTAL BACKUP CORP. ". - 05 FILLER PIC X(25) VALUE "JOHNSON BOATING SUPPLIES ". - 05 FILLER PIC X(25) VALUE "KONFLAB PLASTIC PRODUCTS.". - 05 FILLER PIC X(25) VALUE "LEWISTON GRAPHICS LTD. ". - 05 FILLER PIC X(25) VALUE "MORNINGSIDE CARPENTRY. ". - 05 FILLER PIC X(25) VALUE "NEW WAVE SURF SHOPS INC. ". - 05 FILLER PIC X(25) VALUE "OLD TYME PIZZA MFG. CO. ". - 05 FILLER PIC X(25) VALUE "PRESTIGE OFFICE FURNITURE". - - 02 DATA-COMPANY REDEFINES DATA-COMPANY-TBL - PIC X(25) OCCURS 16. - 02 DATA-ADDRESS-1-TBL. - - 05 FILLER PIC X(25) VALUE "123 MAIN STREET ". - 05 FILLER PIC X(25) VALUE "1090 2ND AVE. WEST ". - 05 FILLER PIC X(25) VALUE "1401 JEFFERSON BLVD. ". - 05 FILLER PIC X(25) VALUE "1620 ARIZONA WAY ". - 05 FILLER PIC X(25) VALUE "1184 EAST FIRST STREET ". - 05 FILLER PIC X(25) VALUE "114 JOHN F. KENNEDY AVE. ". - 05 FILLER PIC X(25) VALUE "650 LIBERTY CRESCENT ". - 05 FILLER PIC X(25) VALUE "77 SUNSET BLVD. ". - 05 FILLER PIC X(25) VALUE "10908 SANTA MONICA BLVD. ". - 05 FILLER PIC X(25) VALUE "1134 PARIS ROAD ". - 05 FILLER PIC X(25) VALUE "808 NORTHWEST MAIN ST. ". - 05 FILLER PIC X(25) VALUE "9904 QUEEN STREET ". - 05 FILLER PIC X(25) VALUE "1709 DUNDAS CRESCENT W. ". - 05 FILLER PIC X(25) VALUE "3240 MARIS AVENUE ". - 05 FILLER PIC X(25) VALUE "1705 WISCONSIN ROAD ". - 05 FILLER PIC X(25) VALUE "114A MAPLE GROVE ". - - 02 DATA-ADDRESS-1 REDEFINES DATA-ADDRESS-1-TBL - PIC X(25) OCCURS 16. - 02 DATA-ADDRESS-2-TBL. - - 05 FILLER PIC X(10) VALUE "NEW YORK ". - 05 FILLER PIC X(10) VALUE "ATLANTA ". - 05 FILLER PIC X(10) VALUE "WASHINGTON". - 05 FILLER PIC X(10) VALUE "TORONTO ". - 05 FILLER PIC X(10) VALUE "CALGARY ". - 05 FILLER PIC X(10) VALUE "SAN DIEGO ". - 05 FILLER PIC X(10) VALUE "LOS RIOS ". - 05 FILLER PIC X(10) VALUE "MADISON ". - 05 FILLER PIC X(10) VALUE "WILBUR ". - 05 FILLER PIC X(10) VALUE "TOPEKA ". - 05 FILLER PIC X(10) VALUE "SEATTLE ". - 05 FILLER PIC X(10) VALUE "NEW JERSEY". - 05 FILLER PIC X(10) VALUE "FORT WAYNE". - 05 FILLER PIC X(10) VALUE "COLUMBUS ". - 05 FILLER PIC X(10) VALUE "RICHMOND ". - 05 FILLER PIC X(10) VALUE "WHITEPLAIN". - - 02 DATA-ADDRESS-2 REDEFINES DATA-ADDRESS-2-TBL - PIC X(10) OCCURS 16. - 02 DATA-ADDRESS-3-TBL. - - 05 FILLER PIC X(10) VALUE "N.Y. ". - 05 FILLER PIC X(10) VALUE "GEORGIA ". - 05 FILLER PIC X(10) VALUE "D.C. ". - 05 FILLER PIC X(10) VALUE "CANADA ". - 05 FILLER PIC X(10) VALUE "CANADA ". - 05 FILLER PIC X(10) VALUE "CALIFORNIA". - 05 FILLER PIC X(10) VALUE "NEW MEXICO". - 05 FILLER PIC X(10) VALUE "WISCONSIN ". - 05 FILLER PIC X(10) VALUE "DELAWARE ". - 05 FILLER PIC X(10) VALUE "KANSAS ". - 05 FILLER PIC X(10) VALUE "WASHINGTON". - 05 FILLER PIC X(10) VALUE "N.J. ". - 05 FILLER PIC X(10) VALUE "COLORADO ". - 05 FILLER PIC X(10) VALUE "OHIO ". - 05 FILLER PIC X(10) VALUE "VIRGINIA ". - 05 FILLER PIC X(10) VALUE "N.Y. ". - - 02 DATA-ADDRESS-3 REDEFINES DATA-ADDRESS-3-TBL - PIC X(10) OCCURS 16. - 02 DATA-TELEPHONE-TBL. - - 05 FILLER PIC 9(10) VALUE 3131234432. - 05 FILLER PIC 9(10) VALUE 4082938498. - 05 FILLER PIC 9(10) VALUE 8372487274. - 05 FILLER PIC 9(10) VALUE 4169898509. - 05 FILLER PIC 9(10) VALUE 5292398745. - 05 FILLER PIC 9(10) VALUE 8009329492. - 05 FILLER PIC 9(10) VALUE 6456445643. - 05 FILLER PIC 9(10) VALUE 6546456333. - 05 FILLER PIC 9(10) VALUE 3455445444. - 05 FILLER PIC 9(10) VALUE 6456445643. - 05 FILLER PIC 9(10) VALUE 7456434355. - 05 FILLER PIC 9(10) VALUE 6554456433. - 05 FILLER PIC 9(10) VALUE 4169898509. - 05 FILLER PIC 9(10) VALUE 7534587453. - 05 FILLER PIC 9(10) VALUE 8787458374. - 05 FILLER PIC 9(10) VALUE 4169898509. - - 02 DATA-TELEPHONE REDEFINES DATA-TELEPHONE-TBL - PIC 9(10) OCCURS 16. - 02 DATA-DP-MGR-TBL. - - 05 FILLER PIC X(20) VALUE "MR. DAVE HARRIS ". - 05 FILLER PIC X(20) VALUE "MS. JANICE SILCOX ". - 05 FILLER PIC X(20) VALUE "MR. ALLAN JONES ". - 05 FILLER PIC X(20) VALUE "MR. PETER MACKAY ". - 05 FILLER PIC X(20) VALUE "MRS. DONNA BREWER ". - 05 FILLER PIC X(20) VALUE "MR. MICHAEL SMYTHE ". - 05 FILLER PIC X(20) VALUE "MR. D.A. MORRISON ". - 05 FILLER PIC X(20) VALUE "MR. BRIAN PATTERSON ". - 05 FILLER PIC X(20) VALUE "MR. DARRYL TOWNSEND ". - 05 FILLER PIC X(20) VALUE "MS. VALERIE HARPER ". - 05 FILLER PIC X(20) VALUE "MR. FRED MILLER ". - 05 FILLER PIC X(20) VALUE "MR. DONALD FISCHER ". - 05 FILLER PIC X(20) VALUE "MR. STEVEN YOURDIN ". - 05 FILLER PIC X(20) VALUE "MS. Goldie Hawn ". - 05 FILLER PIC X(20) VALUE "MS. ALICE WINSTON ". - 05 FILLER PIC X(20) VALUE "MR. THOMAS JEFFERSON". - - 02 DATA-DP-MGR REDEFINES DATA-DP-MGR-TBL - PIC X(20) OCCURS 16. - 02 DATA-MACHINE-TBL. - - 05 FILLER PIC X(8) VALUE "UNI-9030". - 05 FILLER PIC X(8) VALUE "UNI-9040". - 05 FILLER PIC X(8) VALUE "UNI-80/3". - 05 FILLER PIC X(8) VALUE "UNI-80/5". - 05 FILLER PIC X(8) VALUE "UNI-80/6". - 05 FILLER PIC X(8) VALUE "UNI-80/6". - 05 FILLER PIC X(8) VALUE "UNI-80/6". - 05 FILLER PIC X(8) VALUE "UNI-80/8". - 05 FILLER PIC X(8) VALUE "UNI-80/8". - 05 FILLER PIC X(8) VALUE "UNI-80/8". - 05 FILLER PIC X(8) VALUE "UNI-80/8". - 05 FILLER PIC X(8) VALUE "UNI-80/8". - 05 FILLER PIC X(8) VALUE "UNI-80/8". - 05 FILLER PIC X(8) VALUE "UNI-80/8". - 05 FILLER PIC X(8) VALUE "UNI-9040". - 05 FILLER PIC X(8) VALUE "UNI-9040". - - 02 DATA-MACHINE REDEFINES DATA-MACHINE-TBL - PIC X(8) OCCURS 16. - 02 DATA-NO-TERMINALS-TBL. - - 05 FILLER PIC 9(3) COMP-3 VALUE 85. - 05 FILLER PIC 9(3) COMP-3 VALUE 34. - 05 FILLER PIC 9(3) COMP-3 VALUE 75. - 05 FILLER PIC 9(3) COMP-3 VALUE 45. - 05 FILLER PIC 9(3) COMP-3 VALUE 90. - 05 FILLER PIC 9(3) COMP-3 VALUE 107. - 05 FILLER PIC 9(3) COMP-3 VALUE 67. - 05 FILLER PIC 9(3) COMP-3 VALUE 32. - 05 FILLER PIC 9(3) COMP-3 VALUE 16. - 05 FILLER PIC 9(3) COMP-3 VALUE 34. - 05 FILLER PIC 9(3) COMP-3 VALUE 128. - 05 FILLER PIC 9(3) COMP-3 VALUE 64. - 05 FILLER PIC 9(3) COMP-3 VALUE 110. - 05 FILLER PIC 9(3) COMP-3 VALUE 324. - 05 FILLER PIC 9(3) COMP-3 VALUE 124. - 05 FILLER PIC 9(3) COMP-3 VALUE 86. - - 02 DATA-NO-TERMINALS REDEFINES DATA-NO-TERMINALS-TBL - PIC 9(3) COMP-3 OCCURS 16. - - 01 WORK-AREA. - 05 REC-NUM PICTURE 9(6) VALUE 0. - 05 REC-MAX PICTURE 9(6) VALUE 10. - 05 SUB PICTURE 9(4) COMP SYNC. - 88 ODD-RECORD VALUE 1 3 5 7 9 10 11. - - 05 TSPFL-KEY PICTURE X(8). - - PROCEDURE DIVISION. - - MAINFILE. - OPEN OUTPUT TSPFILE - CLOSE TSPFILE. - - OPEN I-O TSPFILE - READ TSPFILE NEXT RECORD WITH NO LOCK - IF CUST-STAT NOT = "10" - DISPLAY "Error " CUST-STAT " on read of empty file" - UPON CONSOLE - STOP RUN - END-IF. - MOVE LOW-VALUES TO TSPFL-RECORD. - START TSPFILE KEY GREATER THAN CM-CUST-NUM - IF CUST-STAT NOT = "23" - DISPLAY "Error " CUST-STAT " starting empty file" - UPON CONSOLE - STOP RUN - END-IF. - READ TSPFILE NEXT RECORD WITH NO LOCK - IF CUST-STAT NOT = "46" - DISPLAY "Error " CUST-STAT " start/read of empty file" - UPON CONSOLE - STOP RUN - END-IF. - DISPLAY "OK: Operations on empty file" - CLOSE TSPFILE. - - PERFORM LOADFILE. - PERFORM LISTFILE. - OPEN INPUT TSTFILE - IF CUST-STAT NOT = "00" - DISPLAY "Expected ERROR " CUST-STAT - " opening TSTFILE, Record size different" - UPON CONSOLE - ELSE - DISPLAY "Un-Expected open TSTFILE, Record size different" - UPON CONSOLE - CLOSE TSTFILE - END-IF. - STOP RUN. - - LOADFILE. - DISPLAY "Loading sample data file." - UPON CONSOLE. - - OPEN OUTPUT TSPFILE - IF CUST-STAT NOT = "00" - DIVIDE STAT-1 BY 256 GIVING BYTE-1 REMAINDER BYTE-2 - DISPLAY "Error " CUST-STAT " " BYTE-1 " " BYTE-2 - " opening 'testisam' file" - UPON CONSOLE - STOP RUN - END-IF. - - PERFORM 1000-LOAD-RECORD - VARYING SUB FROM 1 BY 1 - UNTIL SUB > MAX-SUB. - - DISPLAY "Sample data file load complete." - UPON CONSOLE. - CLOSE TSPFILE. - - *---------------------------------------------------------------* - * LOAD A RECORD FROM DATA TABLES * - *---------------------------------------------------------------* - - 1000-LOAD-RECORD. - - MOVE SPACES TO TSPFL-RECORD. - MOVE DATA-CUST-NUM (SUB) TO CM-CUST-NUM. - MOVE CM-CUST-NUM TO TSPFL-KEY. - MOVE DATA-COMPANY (SUB) TO CM-COMPANY. - MOVE DATA-ADDRESS-1 (SUB) TO CM-ADDRESS-1. - MOVE DATA-ADDRESS-2 (SUB) TO CM-ADDRESS-2. - MOVE DATA-ADDRESS-3 (SUB) TO CM-ADDRESS-3. - MOVE DATA-TELEPHONE (SUB) TO CM-TELEPHONE. - MOVE DATA-DP-MGR (SUB) TO CM-DP-MGR. - MOVE DATA-MACHINE (SUB) TO CM-MACHINE. - MOVE DATA-NO-TERMINALS (SUB) TO CM-NO-TERMINALS. - - IF ODD-RECORD - MOVE "8417" TO CM-DISK - MOVE "1600 BPI" TO CM-TAPE - MOVE "1MEG" TO CM-MEMORY - ELSE - MOVE "8470" TO CM-DISK - MOVE "6250 BPI" TO CM-TAPE - MOVE "3MEG" TO CM-MEMORY. - - WRITE TSPFL-RECORD. - IF CUST-STAT NOT = "00" - AND CUST-STAT NOT = "02" - DISPLAY "Load - Key: " TSPFL-KEY ", Status: " CUST-STAT - UPON CONSOLE. - - LISTFILE. - DISPLAY "LIST SAMPLE FILE" UPON CONSOLE. - OPEN INPUT TSTFILE - MOVE SPACES TO TSTFL-RECORD. - MOVE "PRE00000" TO CM-CUST-NUM. - START TSTFILE KEY GREATER THAN OR EQUAL TO TS-CUST-NUM - READ TSTFILE NEXT RECORD - READ TSTFILE NEXT RECORD - CLOSE TSTFILE. - - MOVE ZERO TO REC-NUM - OPEN INPUT TSPFILE - IF CUST-STAT NOT = "00" - DISPLAY "ERROR " CUST-STAT " OPENING INPUT FILE" - UPON CONSOLE - IF CUST-STAT (1:1) = "9" - DISPLAY "Sub Error " STAT-X2 UPON CONSOLE - END-IF - STOP RUN - END-IF. - MOVE SPACES TO TSPFL-RECORD. - MOVE "PRE00000" TO CM-CUST-NUM. - START TSPFILE KEY GREATER THAN OR EQUAL TO CM-CUST-NUM - READ TSPFILE NEXT RECORD - READ TSPFILE NEXT RECORD - - MOVE SPACES TO TSPFL-RECORD. - MOVE "DEL00000" TO CM-CUST-NUM. - START TSPFILE KEY GREATER THAN CM-CUST-NUM - IF CUST-STAT NOT = "00" - DISPLAY "Error " CUST-STAT " starting file" - UPON CONSOLE - IF CUST-STAT (1:1) = "9" - DISPLAY "Sub Error " STAT-X2 UPON CONSOLE - END-IF - STOP RUN - END-IF. - READ TSPFILE NEXT RECORD WITH NO LOCK - IF CUST-STAT NOT = "00" - DISPLAY "Error " CUST-STAT " on 1st read of file" - UPON CONSOLE - IF CUST-STAT (1:1) = "9" - DISPLAY "Sub Error " STAT-X2 UPON CONSOLE - END-IF - STOP RUN - END-IF. - PERFORM UNTIL CUST-STAT NOT = "00" - OR REC-NUM > REC-MAX - DISPLAY "Key: " CM-CUST-NUM " is " CM-COMPANY - " Disk=" CM-DISK "." - UPON CONSOLE - READ TSPFILE NEXT RECORD - AT END - MOVE "99" TO CUST-STAT - END-READ - ADD 1 TO REC-NUM - END-PERFORM - IF CUST-STAT = "99" - DISPLAY "Hit End of File" UPON CONSOLE - END-IF. - - DISPLAY "LIST SAMPLE FILE DESCENDING" UPON CONSOLE. - MOVE ZERO TO REC-NUM - START TSPFILE KEY LESS THAN CM-CUST-NUM - IF CUST-STAT NOT = "00" - DISPLAY "Error " CUST-STAT " starting file" - UPON CONSOLE - STOP RUN - END-IF. - READ TSPFILE PREVIOUS RECORD WITH NO LOCK - IF CUST-STAT NOT = "00" - DISPLAY "Error " CUST-STAT " on 1st read of file" - UPON CONSOLE - STOP RUN - END-IF. - PERFORM UNTIL CUST-STAT NOT = "00" - OR REC-NUM > REC-MAX - DISPLAY "Key: " CM-CUST-NUM " is " CM-COMPANY - " Disk=" CM-DISK "." - UPON CONSOLE - READ TSPFILE PREVIOUS RECORD - AT END - MOVE "99" TO CUST-STAT - END-READ - ADD 1 TO REC-NUM - END-PERFORM. - - CLOSE TSPFILE. - - OPEN I-O TSPFILE. - MOVE SPACES TO TSPFL-RECORD. - MOVE DATA-CUST-NUM (2) TO CM-CUST-NUM. - MOVE 'X' TO CM-CUST-NUM (5:1). - READ TSPFILE KEY IS CM-CUST-NUM - IF CUST-STAT NOT = "23" - DISPLAY "Error " CUST-STAT " instead of 23." - UPON CONSOLE - END-IF. - MOVE DATA-CUST-NUM (2) TO CM-CUST-NUM. - MOVE DATA-COMPANY (2) TO CM-COMPANY. - READ TSPFILE KEY IS CM-CUST-NUM - IF CUST-STAT NOT = "00" - DISPLAY "Error " CUST-STAT " on primary read ." - UPON CONSOLE - ELSE - DISPLAY "Got: " CM-CUST-NUM " is " CM-COMPANY - " Disk=" CM-DISK "." - UPON CONSOLE - END-IF. - READ TSPFILE NEXT RECORD - IF CUST-STAT NOT = "00" - DISPLAY "Error " CUST-STAT " on next read" - UPON CONSOLE - ELSE - DISPLAY "Nxt: " CM-CUST-NUM " is " CM-COMPANY - " Disk=" CM-DISK "." - UPON CONSOLE - END-IF. - MOVE DATA-TELEPHONE (7) TO CM-TELEPHONE. - MOVE DATA-MACHINE (7) TO CM-MACHINE. - READ TSPFILE KEY IS CM-TELEPHONE - IF CUST-STAT NOT = "00" - DISPLAY "Error " CUST-STAT " instead of 23" - UPON CONSOLE - ELSE - DISPLAY "Ky2: " CM-CUST-NUM " is " CM-COMPANY - " Mach=" CM-MACHINE "." - UPON CONSOLE - END-IF. - WRITE TSPFL-RECORD - IF CUST-STAT NOT = "22" - DISPLAY "Error " CUST-STAT " instead of 22" - UPON CONSOLE - ELSE - DISPLAY " Write: " CM-CUST-NUM " got 22 as expected" - UPON CONSOLE - END-IF. - MOVE DATA-CUST-NUM (3) TO CM-CUST-NUM. - MOVE DATA-COMPANY (3) TO CM-COMPANY. - READ TSPFILE KEY IS CM-CUST-NUM - DISPLAY " Read: " CM-CUST-NUM " got " - CUST-STAT " as expected " - CM-NO-TERMINALS " terminals" - UPON CONSOLE. - ADD 5 TO CM-NO-TERMINALS - REWRITE TSPFL-RECORD - IF CUST-STAT NOT = "02" - AND CUST-STAT NOT = "00" - DISPLAY "Error " CUST-STAT " instead of 02" - UPON CONSOLE - ELSE - DISPLAY "ReWrite: " CM-CUST-NUM " got " - CUST-STAT " as expected " - CM-NO-TERMINALS " terminals" - UPON CONSOLE - END-IF. - MOVE DATA-CUST-NUM (2) TO CM-CUST-NUM. - MOVE DATA-COMPANY (2) TO CM-COMPANY. - READ TSPFILE KEY IS CM-CUST-NUM - DISPLAY " Read: " CM-CUST-NUM " got " - CUST-STAT " as expected " - CM-NO-TERMINALS " terminals" - UPON CONSOLE. - MOVE DATA-CUST-NUM (3) TO CM-CUST-NUM. - MOVE DATA-COMPANY (3) TO CM-COMPANY. - REWRITE TSPFL-RECORD - IF CUST-STAT NOT = "02" - AND CUST-STAT NOT = "00" - DISPLAY "Error " CUST-STAT " instead of 02" - UPON CONSOLE - ELSE - DISPLAY "ReWrite: " CM-CUST-NUM " got 00/02" - " as expected" - UPON CONSOLE - END-IF. - MOVE DATA-CUST-NUM (6) TO CM-CUST-NUM. - MOVE DATA-COMPANY (6) TO CM-COMPANY. - READ TSPFILE KEY IS CM-CUST-NUM - MOVE DATA-TELEPHONE (7) TO CM-TELEPHONE. - MOVE DATA-MACHINE (7) TO CM-MACHINE. - REWRITE TSPFL-RECORD - IF CUST-STAT NOT = "02" - AND CUST-STAT NOT = "00" - DISPLAY "Error " CUST-STAT " instead of 02" - UPON CONSOLE - ELSE - DISPLAY "ReWrite: " CM-CUST-NUM " got 00/02" - " as expected" - UPON CONSOLE - END-IF. - CLOSE TSPFILE. -]) - -AT_CHECK([$COMPILE -ftraceall prog.cob ], [0], [], []) - -AT_CHECK([export COB_TRACE_FILE=trace.txt -export COB_TRACE_IO=Y -export COB_SET_TRACE=Y -export COB_TRACE_FORMAT=' Line: %L%S' -export IO_TSPFILE=trace -export IO_TSTFILE=no-trace -./prog], [0], [OK: Operations on empty file -Loading sample data file. -Sample data file load complete. -LIST SAMPLE FILE -Key: EPS00000 is EPSILON EQUIPMENT SUPPLY Disk=8417 . -Key: FOR00000 is FORTUNE COOKIE COMPANY Disk=8470 . -Key: GAM00000 is GAMMA X-RAY TECHNOLOGY Disk=8417 . -Key: GIB00000 is GIBRALTER LIFE INSURANCE Disk=8417 . -Key: H&J00000 is H & J PLUMBING SUPPLIES Disk=8470 . -Key: INC00000 is INCREMENTAL BACKUP CORP. Disk=8417 . -Key: JOH00000 is JOHNSON BOATING SUPPLIES Disk=8417 . -Key: KON00000 is KONFLAB PLASTIC PRODUCTS. Disk=8417 . -Key: LEW00000 is LEWISTON GRAPHICS LTD. Disk=8470 . -Key: MOR00000 is MORNINGSIDE CARPENTRY. Disk=8470 . -Key: NEW00000 is NEW WAVE SURF SHOPS INC. Disk=8470 . -LIST SAMPLE FILE DESCENDING -Key: NEW00000 is NEW WAVE SURF SHOPS INC. Disk=8470 . -Key: MOR00000 is MORNINGSIDE CARPENTRY. Disk=8470 . -Key: LEW00000 is LEWISTON GRAPHICS LTD. Disk=8470 . -Key: KON00000 is KONFLAB PLASTIC PRODUCTS. Disk=8417 . -Key: JOH00000 is JOHNSON BOATING SUPPLIES Disk=8417 . -Key: INC00000 is INCREMENTAL BACKUP CORP. Disk=8417 . -Key: H&J00000 is H & J PLUMBING SUPPLIES Disk=8470 . -Key: GIB00000 is GIBRALTER LIFE INSURANCE Disk=8417 . -Key: GAM00000 is GAMMA X-RAY TECHNOLOGY Disk=8417 . -Key: FOR00000 is FORTUNE COOKIE COMPANY Disk=8470 . -Key: EPS00000 is EPSILON EQUIPMENT SUPPLY Disk=8417 . -Got: BET00000 is BETA SHOE MFG. INC. Disk=8470 . -Nxt: DEL00000 is DELTA LUGGAGE REPAIRS Disk=8470 . -Ky2: GIB00000 is GIBRALTER LIFE INSURANCE Mach=UNI-80/6. - Write: GIB00000 got 22 as expected - Read: GAM00000 got 00 as expected 00075 terminals -ReWrite: GAM00000 got 00 as expected 00080 terminals - Read: BET00000 got 00 as expected 00034 terminals -ReWrite: GAM00000 got 00/02 as expected -ReWrite: FOR00000 got 00/02 as expected -Expected ERROR 39 opening TSTFILE, Record size different -], []) - - -AT_CAPTURE_FILE(./trace.txt) - -AT_DATA([reference], [Source: 'prog.cob' -Program-Id: prog - Line: 279 Entry: prog - Line: 281Paragraph: MAINFILE - Line: 282 OPEN - OPEN OUTPUT TSPFILE -> 'testisam' Status: 00 - Line: 283 CLOSE - CLOSE TSPFILE Status: 00 - Line: 285 OPEN - OPEN I_O TSPFILE -> 'testisam' Status: 00 - Line: 286 READ - READ Sequential TSPFILE Status: 10 - Line: 287 IF - Line: 292 MOVE - Line: 293 START - START TSPFILE Status: 23 - Key : ALL LOW-VALUES - Line: 294 IF - Line: 299 READ - READ Sequential TSPFILE Status: 46 - Line: 300 IF - Line: 305 DISPLAY - Line: 306 CLOSE - CLOSE TSPFILE Status: 00 - Line: 308 PERFORM - Line: 322Paragraph: LOADFILE - Line: 323 DISPLAY - Line: 326 OPEN - OPEN OUTPUT TSPFILE -> 'testisam' Status: 00 - Line: 327 IF - Line: 335 PERFORM - Line: 347Paragraph: 1000-LOAD-RECORD - Line: 349 MOVE - Line: 350 MOVE - Line: 351 MOVE - Line: 352 MOVE - Line: 353 MOVE - Line: 354 MOVE - Line: 355 MOVE - Line: 356 MOVE - Line: 357 MOVE - Line: 358 MOVE - Line: 359 MOVE - Line: 361 IF - Line: 362 MOVE - Line: 363 MOVE - Line: 364 MOVE - Line: 370 WRITE - WRITE TSPFILE Status: 00 - Record : 'ALP00000 ALPHA ELECTRICAL CO. LTD.123 MAIN STREET NEW YORK ' - ' N.Y. 3131234432MR. DAVE HARRIS UNI-90301MEG8417' - ' 1600 BPI00085' - Line: 371 IF - Line: 347Paragraph: 1000-LOAD-RECORD - Line: 349 MOVE - Line: 350 MOVE - Line: 351 MOVE - Line: 352 MOVE - Line: 353 MOVE - Line: 354 MOVE - Line: 355 MOVE - Line: 356 MOVE - Line: 357 MOVE - Line: 358 MOVE - Line: 359 MOVE - Line: 361 IF - Line: 366 MOVE - Line: 367 MOVE - Line: 368 MOVE - Line: 370 WRITE - WRITE TSPFILE Status: 00 - Record : 'BET00000 BETA SHOE MFG. INC. 1090 2ND AVE. WEST ATLANTA ' - ' GEORGIA 4082938498MS. JANICE SILCOX UNI-90403MEG8470' - ' 6250 BPI00034' - Line: 371 IF - Line: 347Paragraph: 1000-LOAD-RECORD - Line: 349 MOVE - Line: 350 MOVE - Line: 351 MOVE - Line: 352 MOVE - Line: 353 MOVE - Line: 354 MOVE - Line: 355 MOVE - Line: 356 MOVE - Line: 357 MOVE - Line: 358 MOVE - Line: 359 MOVE - Line: 361 IF - Line: 362 MOVE - Line: 363 MOVE - Line: 364 MOVE - Line: 370 WRITE - WRITE TSPFILE Status: 02 - Record : 'GAM00000 GAMMA X-RAY TECHNOLOGY 1401 JEFFERSON BLVD. WASHINGTON ' - ' D.C. 8372487274MR. ALLAN JONES UNI-80/31MEG8417' - ' 1600 BPI00075' - Line: 371 IF - Line: 347Paragraph: 1000-LOAD-RECORD - Line: 349 MOVE - Line: 350 MOVE - Line: 351 MOVE - Line: 352 MOVE - Line: 353 MOVE - Line: 354 MOVE - Line: 355 MOVE - Line: 356 MOVE - Line: 357 MOVE - Line: 358 MOVE - Line: 359 MOVE - Line: 361 IF - Line: 366 MOVE - Line: 367 MOVE - Line: 368 MOVE - Line: 370 WRITE - WRITE TSPFILE Status: 02 - Record : 'DEL00000 DELTA LUGGAGE REPAIRS 1620 ARIZONA WAY TORONTO ' - ' CANADA 4169898509MR. PETER MACKAY UNI-80/53MEG8470' - ' 6250 BPI00045' - Line: 371 IF - Line: 347Paragraph: 1000-LOAD-RECORD - Line: 349 MOVE - Line: 350 MOVE - Line: 351 MOVE - Line: 352 MOVE - Line: 353 MOVE - Line: 354 MOVE - Line: 355 MOVE - Line: 356 MOVE - Line: 357 MOVE - Line: 358 MOVE - Line: 359 MOVE - Line: 361 IF - Line: 362 MOVE - Line: 363 MOVE - Line: 364 MOVE - Line: 370 WRITE - WRITE TSPFILE Status: 02 - Record : 'EPS00000 EPSILON EQUIPMENT SUPPLY 1184 EAST FIRST STREET CALGARY ' - ' CANADA 5292398745MRS. DONNA BREWER UNI-80/61MEG8417' - ' 1600 BPI00090' - Line: 371 IF - Line: 347Paragraph: 1000-LOAD-RECORD - Line: 349 MOVE - Line: 350 MOVE - Line: 351 MOVE - Line: 352 MOVE - Line: 353 MOVE - Line: 354 MOVE - Line: 355 MOVE - Line: 356 MOVE - Line: 357 MOVE - Line: 358 MOVE - Line: 359 MOVE - Line: 361 IF - Line: 366 MOVE - Line: 367 MOVE - Line: 368 MOVE - Line: 370 WRITE - WRITE TSPFILE Status: 02 - Record : 'FOR00000 FORTUNE COOKIE COMPANY 114 JOHN F. KENNEDY AVE. SAN DIEGO ' - ' CALIFORNIA 8009329492MR. MICHAEL SMYTHE UNI-80/63MEG8470' - ' 6250 BPI00107' - Line: 371 IF - Line: 347Paragraph: 1000-LOAD-RECORD - Line: 349 MOVE - Line: 350 MOVE - Line: 351 MOVE - Line: 352 MOVE - Line: 353 MOVE - Line: 354 MOVE - Line: 355 MOVE - Line: 356 MOVE - Line: 357 MOVE - Line: 358 MOVE - Line: 359 MOVE - Line: 361 IF - Line: 362 MOVE - Line: 363 MOVE - Line: 364 MOVE - Line: 370 WRITE - WRITE TSPFILE Status: 02 - Record : 'GIB00000 GIBRALTER LIFE INSURANCE 650 LIBERTY CRESCENT LOS RIOS ' - ' NEW MEXICO 6456445643MR. D.A. MORRISON UNI-80/61MEG8417' - ' 1600 BPI00067' - Line: 371 IF - Line: 347Paragraph: 1000-LOAD-RECORD - Line: 349 MOVE - Line: 350 MOVE - Line: 351 MOVE - Line: 352 MOVE - Line: 353 MOVE - Line: 354 MOVE - Line: 355 MOVE - Line: 356 MOVE - Line: 357 MOVE - Line: 358 MOVE - Line: 359 MOVE - Line: 361 IF - Line: 366 MOVE - Line: 367 MOVE - Line: 368 MOVE - Line: 370 WRITE - WRITE TSPFILE Status: 02 - Record : 'H&J00000 H & J PLUMBING SUPPLIES 77 SUNSET BLVD. MADISON ' - ' WISCONSIN 6546456333MR. BRIAN PATTERSON UNI-80/83MEG8470' - ' 6250 BPI00032' - Line: 371 IF - Line: 347Paragraph: 1000-LOAD-RECORD - Line: 349 MOVE - Line: 350 MOVE - Line: 351 MOVE - Line: 352 MOVE - Line: 353 MOVE - Line: 354 MOVE - Line: 355 MOVE - Line: 356 MOVE - Line: 357 MOVE - Line: 358 MOVE - Line: 359 MOVE - Line: 361 IF - Line: 362 MOVE - Line: 363 MOVE - Line: 364 MOVE - Line: 370 WRITE - WRITE TSPFILE Status: 02 - Record : 'INC00000 INCREMENTAL BACKUP CORP. 10908 SANTA MONICA BLVD. WILBUR ' - ' DELAWARE 3455445444MR. DARRYL TOWNSEND UNI-80/81MEG8417' - ' 1600 BPI00016' - Line: 371 IF - Line: 347Paragraph: 1000-LOAD-RECORD - Line: 349 MOVE - Line: 350 MOVE - Line: 351 MOVE - Line: 352 MOVE - Line: 353 MOVE - Line: 354 MOVE - Line: 355 MOVE - Line: 356 MOVE - Line: 357 MOVE - Line: 358 MOVE - Line: 359 MOVE - Line: 361 IF - Line: 362 MOVE - Line: 363 MOVE - Line: 364 MOVE - Line: 370 WRITE - WRITE TSPFILE Status: 02 - Record : 'JOH00000 JOHNSON BOATING SUPPLIES 1134 PARIS ROAD TOPEKA ' - ' KANSAS 6456445643MS. VALERIE HARPER UNI-80/81MEG8417' - ' 1600 BPI00034' - Line: 371 IF - Line: 347Paragraph: 1000-LOAD-RECORD - Line: 349 MOVE - Line: 350 MOVE - Line: 351 MOVE - Line: 352 MOVE - Line: 353 MOVE - Line: 354 MOVE - Line: 355 MOVE - Line: 356 MOVE - Line: 357 MOVE - Line: 358 MOVE - Line: 359 MOVE - Line: 361 IF - Line: 362 MOVE - Line: 363 MOVE - Line: 364 MOVE - Line: 370 WRITE - WRITE TSPFILE Status: 02 - Record : 'KON00000 KONFLAB PLASTIC PRODUCTS.808 NORTHWEST MAIN ST. SEATTLE ' - ' WASHINGTON 7456434355MR. FRED MILLER UNI-80/81MEG8417' - ' 1600 BPI00128' - Line: 371 IF - Line: 347Paragraph: 1000-LOAD-RECORD - Line: 349 MOVE - Line: 350 MOVE - Line: 351 MOVE - Line: 352 MOVE - Line: 353 MOVE - Line: 354 MOVE - Line: 355 MOVE - Line: 356 MOVE - Line: 357 MOVE - Line: 358 MOVE - Line: 359 MOVE - Line: 361 IF - Line: 366 MOVE - Line: 367 MOVE - Line: 368 MOVE - Line: 370 WRITE - WRITE TSPFILE Status: 02 - Record : 'LEW00000 LEWISTON GRAPHICS LTD. 9904 QUEEN STREET NEW JERSEY ' - ' N.J. 6554456433MR. DONALD FISCHER UNI-80/83MEG8470' - ' 6250 BPI00064' - Line: 371 IF - Line: 347Paragraph: 1000-LOAD-RECORD - Line: 349 MOVE - Line: 350 MOVE - Line: 351 MOVE - Line: 352 MOVE - Line: 353 MOVE - Line: 354 MOVE - Line: 355 MOVE - Line: 356 MOVE - Line: 357 MOVE - Line: 358 MOVE - Line: 359 MOVE - Line: 361 IF - Line: 366 MOVE - Line: 367 MOVE - Line: 368 MOVE - Line: 370 WRITE - WRITE TSPFILE Status: 02 - Record : 'MOR00000 MORNINGSIDE CARPENTRY. 1709 DUNDAS CRESCENT W. FORT WAYNE ' - ' COLORADO 4169898509MR. STEVEN YOURDIN UNI-80/83MEG8470' - ' 6250 BPI00110' - Line: 371 IF - Line: 347Paragraph: 1000-LOAD-RECORD - Line: 349 MOVE - Line: 350 MOVE - Line: 351 MOVE - Line: 352 MOVE - Line: 353 MOVE - Line: 354 MOVE - Line: 355 MOVE - Line: 356 MOVE - Line: 357 MOVE - Line: 358 MOVE - Line: 359 MOVE - Line: 361 IF - Line: 366 MOVE - Line: 367 MOVE - Line: 368 MOVE - Line: 370 WRITE - WRITE TSPFILE Status: 02 - Record : 'NEW00000 NEW WAVE SURF SHOPS INC. 3240 MARIS AVENUE COLUMBUS ' - ' OHIO 7534587453MS. Goldie Hawn UNI-80/83MEG8470' - ' 6250 BPI00324' - Line: 371 IF - Line: 347Paragraph: 1000-LOAD-RECORD - Line: 349 MOVE - Line: 350 MOVE - Line: 351 MOVE - Line: 352 MOVE - Line: 353 MOVE - Line: 354 MOVE - Line: 355 MOVE - Line: 356 MOVE - Line: 357 MOVE - Line: 358 MOVE - Line: 359 MOVE - Line: 361 IF - Line: 366 MOVE - Line: 367 MOVE - Line: 368 MOVE - Line: 370 WRITE - WRITE TSPFILE Status: 02 - Record : 'OLD00000 OLD TYME PIZZA MFG. CO. 1705 WISCONSIN ROAD RICHMOND ' - ' VIRGINIA 8787458374MS. ALICE WINSTON UNI-90403MEG8470' - ' 6250 BPI00124' - Line: 371 IF - Line: 347Paragraph: 1000-LOAD-RECORD - Line: 349 MOVE - Line: 350 MOVE - Line: 351 MOVE - Line: 352 MOVE - Line: 353 MOVE - Line: 354 MOVE - Line: 355 MOVE - Line: 356 MOVE - Line: 357 MOVE - Line: 358 MOVE - Line: 359 MOVE - Line: 361 IF - Line: 366 MOVE - Line: 367 MOVE - Line: 368 MOVE - Line: 370 WRITE - WRITE TSPFILE Status: 02 - Record : 'PRE00000 PRESTIGE OFFICE FURNITURE114A MAPLE GROVE WHITEPLAIN ' - ' N.Y. 4169898509MR. THOMAS JEFFERSON UNI-90403MEG8470' - ' 6250 BPI00086' - Line: 371 IF - Line: 339 DISPLAY - Line: 341 CLOSE - CLOSE TSPFILE Status: 00 - Line: 309 PERFORM - Line: 376Paragraph: LISTFILE - Line: 377 DISPLAY - Line: 378 OPEN - Line: 379 MOVE - Line: 380 MOVE - Line: 381 START - Line: 382 READ - Line: 383 READ - Line: 384 CLOSE - Line: 386 MOVE - Line: 387 OPEN - OPEN INPUT TSPFILE -> 'testisam' Status: 00 - Line: 388 IF - Line: 396 MOVE - Line: 397 MOVE - Line: 398 START - START TSPFILE Status: 00 - Key : 'PRE00000' - Line: 399 READ - READ Sequential TSPFILE Status: 00 - Record : 'PRE00000 PRESTIGE OFFICE FURNITURE114A MAPLE GROVE WHITEPLAIN ' - ' N.Y. 4169898509MR. THOMAS JEFFERSON UNI-90403MEG8470' - ' 6250 BPI00086' - Line: 400 READ - READ Sequential TSPFILE Status: 10 - Line: 402 MOVE - Line: 403 MOVE - Line: 404 START - START TSPFILE Status: 00 - Key : 'DEL00000' - Line: 405 IF - Line: 413 READ - READ Sequential TSPFILE Status: 00 - Record : 'EPS00000 EPSILON EQUIPMENT SUPPLY 1184 EAST FIRST STREET CALGARY ' - ' CANADA 5292398745MRS. DONNA BREWER UNI-80/61MEG8417' - ' 1600 BPI00090' - Line: 414 IF - Line: 422 PERFORM - Line: 424 DISPLAY - Line: 427 READ - READ Sequential TSPFILE Status: 00 - Record : 'FOR00000 FORTUNE COOKIE COMPANY 114 JOHN F. KENNEDY AVE. SAN DIEGO ' - ' CALIFORNIA 8009329492MR. MICHAEL SMYTHE UNI-80/63MEG8470' - ' 6250 BPI00107' - Line: 431 ADD - Line: 424 DISPLAY - Line: 427 READ - READ Sequential TSPFILE Status: 00 - Record : 'GAM00000 GAMMA X-RAY TECHNOLOGY 1401 JEFFERSON BLVD. WASHINGTON ' - ' D.C. 8372487274MR. ALLAN JONES UNI-80/31MEG8417' - ' 1600 BPI00075' - Line: 431 ADD - Line: 424 DISPLAY - Line: 427 READ - READ Sequential TSPFILE Status: 00 - Record : 'GIB00000 GIBRALTER LIFE INSURANCE 650 LIBERTY CRESCENT LOS RIOS ' - ' NEW MEXICO 6456445643MR. D.A. MORRISON UNI-80/61MEG8417' - ' 1600 BPI00067' - Line: 431 ADD - Line: 424 DISPLAY - Line: 427 READ - READ Sequential TSPFILE Status: 00 - Record : 'H&J00000 H & J PLUMBING SUPPLIES 77 SUNSET BLVD. MADISON ' - ' WISCONSIN 6546456333MR. BRIAN PATTERSON UNI-80/83MEG8470' - ' 6250 BPI00032' - Line: 431 ADD - Line: 424 DISPLAY - Line: 427 READ - READ Sequential TSPFILE Status: 00 - Record : 'INC00000 INCREMENTAL BACKUP CORP. 10908 SANTA MONICA BLVD. WILBUR ' - ' DELAWARE 3455445444MR. DARRYL TOWNSEND UNI-80/81MEG8417' - ' 1600 BPI00016' - Line: 431 ADD - Line: 424 DISPLAY - Line: 427 READ - READ Sequential TSPFILE Status: 00 - Record : 'JOH00000 JOHNSON BOATING SUPPLIES 1134 PARIS ROAD TOPEKA ' - ' KANSAS 6456445643MS. VALERIE HARPER UNI-80/81MEG8417' - ' 1600 BPI00034' - Line: 431 ADD - Line: 424 DISPLAY - Line: 427 READ - READ Sequential TSPFILE Status: 00 - Record : 'KON00000 KONFLAB PLASTIC PRODUCTS.808 NORTHWEST MAIN ST. SEATTLE ' - ' WASHINGTON 7456434355MR. FRED MILLER UNI-80/81MEG8417' - ' 1600 BPI00128' - Line: 431 ADD - Line: 424 DISPLAY - Line: 427 READ - READ Sequential TSPFILE Status: 00 - Record : 'LEW00000 LEWISTON GRAPHICS LTD. 9904 QUEEN STREET NEW JERSEY ' - ' N.J. 6554456433MR. DONALD FISCHER UNI-80/83MEG8470' - ' 6250 BPI00064' - Line: 431 ADD - Line: 424 DISPLAY - Line: 427 READ - READ Sequential TSPFILE Status: 00 - Record : 'MOR00000 MORNINGSIDE CARPENTRY. 1709 DUNDAS CRESCENT W. FORT WAYNE ' - ' COLORADO 4169898509MR. STEVEN YOURDIN UNI-80/83MEG8470' - ' 6250 BPI00110' - Line: 431 ADD - Line: 424 DISPLAY - Line: 427 READ - READ Sequential TSPFILE Status: 00 - Record : 'NEW00000 NEW WAVE SURF SHOPS INC. 3240 MARIS AVENUE COLUMBUS ' - ' OHIO 7534587453MS. Goldie Hawn UNI-80/83MEG8470' - ' 6250 BPI00324' - Line: 431 ADD - Line: 424 DISPLAY - Line: 427 READ - READ Sequential TSPFILE Status: 00 - Record : 'OLD00000 OLD TYME PIZZA MFG. CO. 1705 WISCONSIN ROAD RICHMOND ' - ' VIRGINIA 8787458374MS. ALICE WINSTON UNI-90403MEG8470' - ' 6250 BPI00124' - Line: 431 ADD - Line: 433 IF - Line: 437 DISPLAY - Line: 438 MOVE - Line: 439 START - START TSPFILE Status: 00 - Key : 'OLD00000' - Line: 440 IF - Line: 445 READ - READ Sequential TSPFILE Status: 00 - Record : 'NEW00000 NEW WAVE SURF SHOPS INC. 3240 MARIS AVENUE COLUMBUS ' - ' OHIO 7534587453MS. Goldie Hawn UNI-80/83MEG8470' - ' 6250 BPI00324' - Line: 446 IF - Line: 451 PERFORM - Line: 453 DISPLAY - Line: 456 READ - READ Sequential TSPFILE Status: 00 - Record : 'MOR00000 MORNINGSIDE CARPENTRY. 1709 DUNDAS CRESCENT W. FORT WAYNE ' - ' COLORADO 4169898509MR. STEVEN YOURDIN UNI-80/83MEG8470' - ' 6250 BPI00110' - Line: 460 ADD - Line: 453 DISPLAY - Line: 456 READ - READ Sequential TSPFILE Status: 00 - Record : 'LEW00000 LEWISTON GRAPHICS LTD. 9904 QUEEN STREET NEW JERSEY ' - ' N.J. 6554456433MR. DONALD FISCHER UNI-80/83MEG8470' - ' 6250 BPI00064' - Line: 460 ADD - Line: 453 DISPLAY - Line: 456 READ - READ Sequential TSPFILE Status: 00 - Record : 'KON00000 KONFLAB PLASTIC PRODUCTS.808 NORTHWEST MAIN ST. SEATTLE ' - ' WASHINGTON 7456434355MR. FRED MILLER UNI-80/81MEG8417' - ' 1600 BPI00128' - Line: 460 ADD - Line: 453 DISPLAY - Line: 456 READ - READ Sequential TSPFILE Status: 00 - Record : 'JOH00000 JOHNSON BOATING SUPPLIES 1134 PARIS ROAD TOPEKA ' - ' KANSAS 6456445643MS. VALERIE HARPER UNI-80/81MEG8417' - ' 1600 BPI00034' - Line: 460 ADD - Line: 453 DISPLAY - Line: 456 READ - READ Sequential TSPFILE Status: 00 - Record : 'INC00000 INCREMENTAL BACKUP CORP. 10908 SANTA MONICA BLVD. WILBUR ' - ' DELAWARE 3455445444MR. DARRYL TOWNSEND UNI-80/81MEG8417' - ' 1600 BPI00016' - Line: 460 ADD - Line: 453 DISPLAY - Line: 456 READ - READ Sequential TSPFILE Status: 00 - Record : 'H&J00000 H & J PLUMBING SUPPLIES 77 SUNSET BLVD. MADISON ' - ' WISCONSIN 6546456333MR. BRIAN PATTERSON UNI-80/83MEG8470' - ' 6250 BPI00032' - Line: 460 ADD - Line: 453 DISPLAY - Line: 456 READ - READ Sequential TSPFILE Status: 00 - Record : 'GIB00000 GIBRALTER LIFE INSURANCE 650 LIBERTY CRESCENT LOS RIOS ' - ' NEW MEXICO 6456445643MR. D.A. MORRISON UNI-80/61MEG8417' - ' 1600 BPI00067' - Line: 460 ADD - Line: 453 DISPLAY - Line: 456 READ - READ Sequential TSPFILE Status: 00 - Record : 'GAM00000 GAMMA X-RAY TECHNOLOGY 1401 JEFFERSON BLVD. WASHINGTON ' - ' D.C. 8372487274MR. ALLAN JONES UNI-80/31MEG8417' - ' 1600 BPI00075' - Line: 460 ADD - Line: 453 DISPLAY - Line: 456 READ - READ Sequential TSPFILE Status: 00 - Record : 'FOR00000 FORTUNE COOKIE COMPANY 114 JOHN F. KENNEDY AVE. SAN DIEGO ' - ' CALIFORNIA 8009329492MR. MICHAEL SMYTHE UNI-80/63MEG8470' - ' 6250 BPI00107' - Line: 460 ADD - Line: 453 DISPLAY - Line: 456 READ - READ Sequential TSPFILE Status: 00 - Record : 'EPS00000 EPSILON EQUIPMENT SUPPLY 1184 EAST FIRST STREET CALGARY ' - ' CANADA 5292398745MRS. DONNA BREWER UNI-80/61MEG8417' - ' 1600 BPI00090' - Line: 460 ADD - Line: 453 DISPLAY - Line: 456 READ - READ Sequential TSPFILE Status: 00 - Record : 'DEL00000 DELTA LUGGAGE REPAIRS 1620 ARIZONA WAY TORONTO ' - ' CANADA 4169898509MR. PETER MACKAY UNI-80/53MEG8470' - ' 6250 BPI00045' - Line: 460 ADD - Line: 463 CLOSE - CLOSE TSPFILE Status: 00 - Line: 465 OPEN - OPEN I_O TSPFILE -> 'testisam' Status: 00 - Line: 466 MOVE - Line: 467 MOVE - Line: 468 MOVE - Line: 469 READ - READ TSPFILE Status: 23 - Key : 'BET0X000' - Line: 470 IF - Line: 474 MOVE - Line: 475 MOVE - Line: 476 READ - READ TSPFILE Status: 00 - Record : 'BET00000 BETA SHOE MFG. INC. 1090 2ND AVE. WEST ATLANTA ' - ' GEORGIA 4082938498MS. JANICE SILCOX UNI-90403MEG8470' - ' 6250 BPI00034' - Key : 'BET00000' - Line: 477 IF - Line: 481 DISPLAY - Line: 485 READ - READ Sequential TSPFILE Status: 00 - Record : 'DEL00000 DELTA LUGGAGE REPAIRS 1620 ARIZONA WAY TORONTO ' - ' CANADA 4169898509MR. PETER MACKAY UNI-80/53MEG8470' - ' 6250 BPI00045' - Line: 486 IF - Line: 490 DISPLAY - Line: 494 MOVE - Line: 495 MOVE - Line: 496 READ - READ TSPFILE Status: 00 - Record : 'GIB00000 GIBRALTER LIFE INSURANCE 650 LIBERTY CRESCENT LOS RIOS ' - ' NEW MEXICO 6456445643MR. D.A. MORRISON UNI-80/61MEG8417' - ' 1600 BPI00067' - Key : 6456445643 - Line: 497 IF - Line: 501 DISPLAY - Line: 505 WRITE - WRITE TSPFILE Status: 22 - Record : 'GIB00000 GIBRALTER LIFE INSURANCE 650 LIBERTY CRESCENT LOS RIOS ' - ' NEW MEXICO 6456445643MR. D.A. MORRISON UNI-80/61MEG8417' - ' 1600 BPI00067' - Line: 506 IF - Line: 510 DISPLAY - Line: 513 MOVE - Line: 514 MOVE - Line: 515 READ - READ TSPFILE Status: 00 - Record : 'GAM00000 GAMMA X-RAY TECHNOLOGY 1401 JEFFERSON BLVD. WASHINGTON ' - ' D.C. 8372487274MR. ALLAN JONES UNI-80/31MEG8417' - ' 1600 BPI00075' - Key : 'GAM00000' - Line: 516 DISPLAY - Line: 520 ADD - Line: 521 REWRITE - REWRITE TSPFILE Status: 00 - Record : 'GAM00000 GAMMA X-RAY TECHNOLOGY 1401 JEFFERSON BLVD. WASHINGTON ' - ' D.C. 8372487274MR. ALLAN JONES UNI-80/31MEG8417' - ' 1600 BPI00080' - Line: 522 IF - Line: 527 DISPLAY - Line: 532 MOVE - Line: 533 MOVE - Line: 534 READ - READ TSPFILE Status: 00 - Record : 'BET00000 BETA SHOE MFG. INC. 1090 2ND AVE. WEST ATLANTA ' - ' GEORGIA 4082938498MS. JANICE SILCOX UNI-90403MEG8470' - ' 6250 BPI00034' - Key : 'BET00000' - Line: 535 DISPLAY - Line: 539 MOVE - Line: 540 MOVE - Line: 541 REWRITE - REWRITE TSPFILE Status: 02 - Record : 'GAM00000 GAMMA X-RAY TECHNOLOGY 1090 2ND AVE. WEST ATLANTA ' - ' GEORGIA 4082938498MS. JANICE SILCOX UNI-90403MEG8470' - ' 6250 BPI00034' - Line: 542 IF - Line: 547 DISPLAY - Line: 551 MOVE - Line: 552 MOVE - Line: 553 READ - READ TSPFILE Status: 00 - Record : 'FOR00000 FORTUNE COOKIE COMPANY 114 JOHN F. KENNEDY AVE. SAN DIEGO ' - ' CALIFORNIA 8009329492MR. MICHAEL SMYTHE UNI-80/63MEG8470' - ' 6250 BPI00107' - Key : 'FOR00000' - Line: 554 MOVE - Line: 555 MOVE - Line: 556 REWRITE - REWRITE TSPFILE Status: 02 - Record : 'FOR00000 FORTUNE COOKIE COMPANY 114 JOHN F. KENNEDY AVE. SAN DIEGO ' - ' CALIFORNIA 6456445643MR. MICHAEL SMYTHE UNI-80/63MEG8470' - ' 6250 BPI00107' - Line: 557 IF - Line: 562 DISPLAY - Line: 566 CLOSE - CLOSE TSPFILE Status: 00 - Line: 310 OPEN - Line: 311 IF - Line: 312 DISPLAY - Line: 320 STOP RUN -]) - -AT_CHECK([gcdiff -I'WRITE TSPFILE Status' reference trace.txt], [0], [], []) - -AT_CLEANUP - - -AT_SETUP([trace feature with subroutine]) - -# FIXME: this test should use line sequential or relative files! -AT_SKIP_IF([test "$COB_HAS_ISAM" = "no"]) -AT_KEYWORDS([runfile]) - -AT_DATA([callsub.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. callsub. - - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 NUM-A PIC 9(3) VALUE 399. - 01 NUM-B PIC 9(3) VALUE 211. - 01 RSLT PIC 9(5)V99. - - LINKAGE SECTION. - 01 n PIC 99. - - PROCEDURE DIVISION USING n. - MAIN-10. - ADD 1 TO n. - COMPUTE RSLT = ((NUM-A / (100.55 + -0.550)) - - (NUM-B / (10.11 * 10 - 1.1))) - * (220 / 2.2) * n. - END PROGRAM callsub. -]) - -AT_CHECK([$COMPILE_MODULE -m -o callsub callsub.cob ], [0], [], []) - - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - - ENVIRONMENT DIVISION. - CONFIGURATION SECTION. - - INPUT-OUTPUT SECTION. - FILE-CONTROL. - SELECT OPTIONAL TSPFILE - ASSIGN TO "testisam" - ORGANIZATION INDEXED ACCESS DYNAMIC - RECORD KEY IS CM-CUST-NUM - ALTERNATE RECORD KEY IS CM-TELEPHONE WITH DUPLICATES - ALTERNATE RECORD KEY IS CM-DISK WITH DUPLICATES - FILE STATUS IS CUST-STAT . - - SELECT TSTFILE - ASSIGN TO "testisam" - ORGANIZATION INDEXED ACCESS DYNAMIC - RECORD KEY IS TS-CUST-NUM - ALTERNATE RECORD KEY IS TS-TELEPHONE WITH DUPLICATES - ALTERNATE RECORD KEY IS TS-DISK WITH DUPLICATES - FILE STATUS IS CUST-STAT . - - SELECT FLATFILE - ASSIGN EXTERNAL RELFIX - ORGANIZATION RELATIVE - ACCESS IS RANDOM RELATIVE KEY IS REC-NUM - FILE STATUS IS CUST-STAT. - - DATA DIVISION. - FILE SECTION. - FD TSPFILE - BLOCK CONTAINS 5 RECORDS. - - 01 TSPFL-RECORD. - 05 TSPFL-REC. - 10 CM-CUST-NUM. - 15 CM-CUST-PRE PICTURE X(3). - 15 CM-CUST-NNN PICTURE X(5). - 10 CM-STATUS PICTURE X. - 10 CM-COMPANY PICTURE X(25). - 10 CM-ADDRESS-1 PICTURE X(25). - 10 CM-ADDRESS-2 PICTURE X(25). - 10 CM-ADDRESS-3 PICTURE X(25). - 10 CM-TELEPHONE PICTURE 9(10). - 10 CM-DP-MGR PICTURE X(25). - 10 CM-MACHINE PICTURE X(8). - 10 CM-MEMORY PICTURE X(4). - 10 CM-DISK PICTURE X(8). - 10 CM-TAPE PICTURE X(8). - 10 CM-NO-TERMINALS PICTURE 9(5). - - FD TSTFILE - BLOCK CONTAINS 5 RECORDS. - - 01 TSTFL-RECORD. - 05 TSTFL-REC. - 10 TS-CUST-NUM PICTURE X(8). - 10 TS-STATUS PICTURE X. - 10 TS-COMPANY PICTURE X(25). - 10 TS-ADDRESS-1 PICTURE X(25). - 10 TS-ADDRESS-2 PICTURE X(25). - 10 TS-ADDRESS-3 PICTURE X(25). - 10 TS-TELEPHONE PICTURE 9(10). - 10 TS-DP-MGR PICTURE X(25). - 10 TS-MACHINE PICTURE X(8). - 10 TS-MEMORY PICTURE X(4). - 10 TS-DISK PICTURE X(8). - 10 TS-TAPE PICTURE X(8). - - FD FLATFILE - BLOCK CONTAINS 5 RECORDS. - - 01 TSP2-RECORD. - 10 C2-CUST-NUM PICTURE X(8). - 10 C2-COMPANY PICTURE X(25). - 10 C2-DISK PICTURE X(8). - 10 C2-NO-TERMINALS PICTURE 9(4) COMP-4. - 10 C2-PK-DATE PICTURE S9(14) COMP-3. - - WORKING-STORAGE SECTION. - - 01 CUST-STAT. - 05 FILLER PICTURE XX. - 77 MAX-SUB VALUE 16 PICTURE 9(5) COMP SYNC. - 77 CALL-NUM VALUE 00 PICTURE 99. - - 01 TEST-DATA. - - 02 DATA-CUST-NUM-TBL. - - 05 FILLER PIC X(8) VALUE "ALP00000". - 05 FILLER PIC X(8) VALUE "BET00000". - 05 FILLER PIC X(8) VALUE "GAM00000". - 05 FILLER PIC X(8) VALUE "DEL00000". - 05 FILLER PIC X(8) VALUE "EPS00000". - 05 FILLER PIC X(8) VALUE "FOR00000". - 05 FILLER PIC X(8) VALUE "GIB00000". - 05 FILLER PIC X(8) VALUE "H&J00000". - 05 FILLER PIC X(8) VALUE "INC00000". - 05 FILLER PIC X(8) VALUE "JOH00000". - 05 FILLER PIC X(8) VALUE "KON00000". - 05 FILLER PIC X(8) VALUE "LEW00000". - 05 FILLER PIC X(8) VALUE "MOR00000". - 05 FILLER PIC X(8) VALUE "NEW00000". - 05 FILLER PIC X(8) VALUE "OLD00000". - 05 FILLER PIC X(8) VALUE "PRE00000". - - 02 DATA-CUST-NUM REDEFINES DATA-CUST-NUM-TBL - PIC X(8) OCCURS 16. - 02 DATA-COMPANY-TBL. - - 05 FILLER PIC X(25) VALUE "ALPHA ELECTRICAL CO. LTD.". - 05 FILLER PIC X(25) VALUE "BETA SHOE MFG. INC. ". - 05 FILLER PIC X(25) VALUE "GAMMA X-RAY TECHNOLOGY ". - 05 FILLER PIC X(25) VALUE "DELTA LUGGAGE REPAIRS ". - 05 FILLER PIC X(25) VALUE "EPSILON EQUIPMENT SUPPLY ". - 05 FILLER PIC X(25) VALUE "FORTUNE COOKIE COMPANY ". - 05 FILLER PIC X(25) VALUE "GIBRALTER LIFE INSURANCE ". - 05 FILLER PIC X(25) VALUE "H & J PLUMBING SUPPLIES ". - 05 FILLER PIC X(25) VALUE "INCREMENTAL BACKUP CORP. ". - 05 FILLER PIC X(25) VALUE "JOHNSON BOATING SUPPLIES ". - 05 FILLER PIC X(25) VALUE "KONFLAB PLASTIC PRODUCTS.". - 05 FILLER PIC X(25) VALUE "LEWISTON GRAPHICS LTD. ". - 05 FILLER PIC X(25) VALUE "MORNINGSIDE CARPENTRY. ". - 05 FILLER PIC X(25) VALUE "NEW WAVE SURF SHOPS INC. ". - 05 FILLER PIC X(25) VALUE "OLD TYME PIZZA MFG. CO. ". - 05 FILLER PIC X(25) VALUE "PRESTIGE OFFICE FURNITURE". - - 02 DATA-COMPANY REDEFINES DATA-COMPANY-TBL - PIC X(25) OCCURS 16. - 02 DATA-ADDRESS-1-TBL. - - 05 FILLER PIC X(25) VALUE "123 MAIN STREET ". - 05 FILLER PIC X(25) VALUE "1090 2ND AVE. WEST ". - 05 FILLER PIC X(25) VALUE "1401 JEFFERSON BLVD. ". - 05 FILLER PIC X(25) VALUE "1620 ARIZONA WAY ". - 05 FILLER PIC X(25) VALUE "1184 EAST FIRST STREET ". - 05 FILLER PIC X(25) VALUE "114 JOHN F. KENNEDY AVE. ". - 05 FILLER PIC X(25) VALUE "650 LIBERTY CRESCENT ". - 05 FILLER PIC X(25) VALUE "77 SUNSET BLVD. ". - 05 FILLER PIC X(25) VALUE "10908 SANTA MONICA BLVD. ". - 05 FILLER PIC X(25) VALUE "1134 PARIS ROAD ". - 05 FILLER PIC X(25) VALUE "808 NORTHWEST MAIN ST. ". - 05 FILLER PIC X(25) VALUE "9904 QUEEN STREET ". - 05 FILLER PIC X(25) VALUE "1709 DUNDAS CRESCENT W. ". - 05 FILLER PIC X(25) VALUE "3240 MARIS AVENUE ". - 05 FILLER PIC X(25) VALUE "1705 WISCONSIN ROAD ". - 05 FILLER PIC X(25) VALUE "114A MAPLE GROVE ". - - 02 DATA-ADDRESS-1 REDEFINES DATA-ADDRESS-1-TBL - PIC X(25) OCCURS 16. - 02 DATA-ADDRESS-2-TBL. - - 05 FILLER PIC X(10) VALUE "NEW YORK ". - 05 FILLER PIC X(10) VALUE "ATLANTA ". - 05 FILLER PIC X(10) VALUE "WASHINGTON". - 05 FILLER PIC X(10) VALUE "TORONTO ". - 05 FILLER PIC X(10) VALUE "CALGARY ". - 05 FILLER PIC X(10) VALUE "SAN DIEGO ". - 05 FILLER PIC X(10) VALUE "LOS RIOS ". - 05 FILLER PIC X(10) VALUE "MADISON ". - 05 FILLER PIC X(10) VALUE "WILBUR ". - 05 FILLER PIC X(10) VALUE "TOPEKA ". - 05 FILLER PIC X(10) VALUE "SEATTLE ". - 05 FILLER PIC X(10) VALUE "NEW JERSEY". - 05 FILLER PIC X(10) VALUE "FORT WAYNE". - 05 FILLER PIC X(10) VALUE "COLUMBUS ". - 05 FILLER PIC X(10) VALUE "RICHMOND ". - 05 FILLER PIC X(10) VALUE "WHITEPLAIN". - - 02 DATA-ADDRESS-2 REDEFINES DATA-ADDRESS-2-TBL - PIC X(10) OCCURS 16. - 02 DATA-ADDRESS-3-TBL. - - 05 FILLER PIC X(10) VALUE "N.Y. ". - 05 FILLER PIC X(10) VALUE "GEORGIA ". - 05 FILLER PIC X(10) VALUE "D.C. ". - 05 FILLER PIC X(10) VALUE "CANADA ". - 05 FILLER PIC X(10) VALUE "CANADA ". - 05 FILLER PIC X(10) VALUE "CALIFORNIA". - 05 FILLER PIC X(10) VALUE "NEW MEXICO". - 05 FILLER PIC X(10) VALUE "WISCONSIN ". - 05 FILLER PIC X(10) VALUE "DELAWARE ". - 05 FILLER PIC X(10) VALUE "KANSAS ". - 05 FILLER PIC X(10) VALUE "WASHINGTON". - 05 FILLER PIC X(10) VALUE "N.J. ". - 05 FILLER PIC X(10) VALUE "COLORADO ". - 05 FILLER PIC X(10) VALUE "OHIO ". - 05 FILLER PIC X(10) VALUE "VIRGINIA ". - 05 FILLER PIC X(10) VALUE "N.Y. ". - - 02 DATA-ADDRESS-3 REDEFINES DATA-ADDRESS-3-TBL - PIC X(10) OCCURS 16. - 02 DATA-TELEPHONE-TBL. - - 05 FILLER PIC 9(10) VALUE 3131234432. - 05 FILLER PIC 9(10) VALUE 4082938498. - 05 FILLER PIC 9(10) VALUE 8372487274. - 05 FILLER PIC 9(10) VALUE 4169898509. - 05 FILLER PIC 9(10) VALUE 5292398745. - 05 FILLER PIC 9(10) VALUE 8009329492. - 05 FILLER PIC 9(10) VALUE 6456445643. - 05 FILLER PIC 9(10) VALUE 6546456333. - 05 FILLER PIC 9(10) VALUE 3455445444. - 05 FILLER PIC 9(10) VALUE 6456445643. - 05 FILLER PIC 9(10) VALUE 7456434355. - 05 FILLER PIC 9(10) VALUE 6554456433. - 05 FILLER PIC 9(10) VALUE 4169898509. - 05 FILLER PIC 9(10) VALUE 7534587453. - 05 FILLER PIC 9(10) VALUE 8787458374. - 05 FILLER PIC 9(10) VALUE 4169898509. - - 02 DATA-TELEPHONE REDEFINES DATA-TELEPHONE-TBL - PIC 9(10) OCCURS 16. - 02 DATA-DP-MGR-TBL. - - 05 FILLER PIC X(20) VALUE "MR. DAVE HARRIS ". - 05 FILLER PIC X(20) VALUE "MS. JANICE SILCOX ". - 05 FILLER PIC X(20) VALUE "MR. ALLAN JONES ". - 05 FILLER PIC X(20) VALUE "MR. PETER MACKAY ". - 05 FILLER PIC X(20) VALUE "MRS. DONNA BREWER ". - 05 FILLER PIC X(20) VALUE "MR. MICHAEL SMYTHE ". - 05 FILLER PIC X(20) VALUE "MR. D.A. MORRISON ". - 05 FILLER PIC X(20) VALUE "MR. BRIAN PATTERSON ". - 05 FILLER PIC X(20) VALUE "MR. DARRYL TOWNSEND ". - 05 FILLER PIC X(20) VALUE "MS. VALERIE HARPER ". - 05 FILLER PIC X(20) VALUE "MR. FRED MILLER ". - 05 FILLER PIC X(20) VALUE "MR. DONALD FISCHER ". - 05 FILLER PIC X(20) VALUE "MR. STEVEN YOURDIN ". - 05 FILLER PIC X(20) VALUE "MS. Goldie Hawn ". - 05 FILLER PIC X(20) VALUE "MS. ALICE WINSTON ". - 05 FILLER PIC X(20) VALUE "MR. THOMAS JEFFERSON". - - 02 DATA-DP-MGR REDEFINES DATA-DP-MGR-TBL - PIC X(20) OCCURS 16. - 02 DATA-MACHINE-TBL. - - 05 FILLER PIC X(8) VALUE "UNI-9030". - 05 FILLER PIC X(8) VALUE "UNI-9040". - 05 FILLER PIC X(8) VALUE "UNI-80/3". - 05 FILLER PIC X(8) VALUE "UNI-80/5". - 05 FILLER PIC X(8) VALUE "UNI-80/6". - 05 FILLER PIC X(8) VALUE "UNI-80/6". - 05 FILLER PIC X(8) VALUE "UNI-80/6". - 05 FILLER PIC X(8) VALUE "UNI-80/8". - 05 FILLER PIC X(8) VALUE "UNI-80/8". - 05 FILLER PIC X(8) VALUE "UNI-80/8". - 05 FILLER PIC X(8) VALUE "UNI-80/8". - 05 FILLER PIC X(8) VALUE "UNI-80/8". - 05 FILLER PIC X(8) VALUE "UNI-80/8". - 05 FILLER PIC X(8) VALUE "UNI-80/8". - 05 FILLER PIC X(8) VALUE "UNI-9040". - 05 FILLER PIC X(8) VALUE "UNI-9040". - - 02 DATA-MACHINE REDEFINES DATA-MACHINE-TBL - PIC X(8) OCCURS 16. - 02 DATA-NO-TERMINALS-TBL. - - 05 FILLER PIC 9(3) COMP-3 VALUE 85. - 05 FILLER PIC 9(3) COMP-3 VALUE 34. - 05 FILLER PIC 9(3) COMP-3 VALUE 75. - 05 FILLER PIC 9(3) COMP-3 VALUE 45. - 05 FILLER PIC 9(3) COMP-3 VALUE 90. - 05 FILLER PIC 9(3) COMP-3 VALUE 107. - 05 FILLER PIC 9(3) COMP-3 VALUE 67. - 05 FILLER PIC 9(3) COMP-3 VALUE 32. - 05 FILLER PIC 9(3) COMP-3 VALUE 16. - 05 FILLER PIC 9(3) COMP-3 VALUE 34. - 05 FILLER PIC 9(3) COMP-3 VALUE 128. - 05 FILLER PIC 9(3) COMP-3 VALUE 64. - 05 FILLER PIC 9(3) COMP-3 VALUE 110. - 05 FILLER PIC 9(3) COMP-3 VALUE 324. - 05 FILLER PIC 9(3) COMP-3 VALUE 124. - 05 FILLER PIC 9(3) COMP-3 VALUE 86. - - 02 DATA-NO-TERMINALS REDEFINES DATA-NO-TERMINALS-TBL - PIC 9(3) COMP-3 OCCURS 16. - - 01 WORK-AREA. - 05 REC-NUM PICTURE 9(6) VALUE 0. - 05 REC-MAX PICTURE 9(6) VALUE 10. - 05 SUB PICTURE 9(4) COMP SYNC. - 88 ODD-RECORD VALUE 1 3 5 7 9 10 11. - - 05 TSPFL-KEY PICTURE X(8). - - PROCEDURE DIVISION. - - MAINFILE. - OPEN OUTPUT TSPFILE - CLOSE TSPFILE. - - OPEN I-O TSPFILE - MOVE '99' TO CUST-STAT - READ TSPFILE NEXT RECORD WITH NO LOCK - IF CUST-STAT NOT = "10" - DISPLAY "Error " CUST-STAT " on read of empty file" - UPON CONSOLE - STOP RUN - END-IF. - MOVE LOW-VALUES TO TSPFL-RECORD. - START TSPFILE KEY GREATER THAN CM-CUST-NUM - IF CUST-STAT NOT = "23" - DISPLAY "Error " CUST-STAT " starting empty file" - UPON CONSOLE - STOP RUN - END-IF. - READ TSPFILE NEXT RECORD WITH NO LOCK - IF CUST-STAT NOT = "46" - DISPLAY "Error " CUST-STAT " start/read of empty file" - UPON CONSOLE - STOP RUN - END-IF. - DISPLAY "OK: Operations on empty file" - CLOSE TSPFILE. - - PERFORM LOADFILE. - PERFORM LISTFILE. - OPEN INPUT TSTFILE - IF CUST-STAT NOT = "00" - DISPLAY "Expected ERROR " CUST-STAT - " opening TSTFILE, Record size different" - UPON CONSOLE - ELSE - DISPLAY "Un-Expected open TSTFILE, Record size different" - UPON CONSOLE - CLOSE TSTFILE - END-IF. - PERFORM LOADFLAT. - STOP RUN. - - LOADFILE. - DISPLAY "Loading sample data file." - UPON CONSOLE. - - OPEN OUTPUT TSPFILE - IF CUST-STAT NOT = "00" - DISPLAY "Error " CUST-STAT - " opening 'testisam' file" UPON CONSOLE - STOP RUN - END-IF. - - PERFORM 1000-LOAD-RECORD - VARYING SUB FROM 1 BY 1 - UNTIL SUB > MAX-SUB. - - DISPLAY "Sample data file load complete." - UPON CONSOLE. - CLOSE TSPFILE. - - *---------------------------------------------------------------* - * LOAD A RECORD FROM DATA TABLES * - *---------------------------------------------------------------* - - 1000-LOAD-RECORD. - - MOVE SPACES TO TSPFL-RECORD. - MOVE DATA-CUST-NUM (SUB) TO CM-CUST-NUM. - MOVE CM-CUST-NUM TO TSPFL-KEY. - MOVE DATA-COMPANY (SUB) TO CM-COMPANY. - MOVE DATA-ADDRESS-1 (SUB) TO CM-ADDRESS-1. - MOVE DATA-ADDRESS-2 (SUB) TO CM-ADDRESS-2. - MOVE DATA-ADDRESS-3 (SUB) TO CM-ADDRESS-3. - MOVE DATA-TELEPHONE (SUB) TO CM-TELEPHONE. - MOVE DATA-DP-MGR (SUB) TO CM-DP-MGR. - MOVE DATA-MACHINE (SUB) TO CM-MACHINE. - MOVE DATA-NO-TERMINALS (SUB) TO CM-NO-TERMINALS. - - IF ODD-RECORD - MOVE "8417" TO CM-DISK - MOVE "1600 BPI" TO CM-TAPE - MOVE "1MEG" TO CM-MEMORY - ELSE - MOVE "8470" TO CM-DISK - MOVE "6250 BPI" TO CM-TAPE - MOVE "3MEG" TO CM-MEMORY. - - WRITE TSPFL-RECORD. - IF CUST-STAT NOT = "00" - AND CUST-STAT NOT = "02" - DISPLAY "Load - Key: " TSPFL-KEY ", Status: " CUST-STAT - UPON CONSOLE. - - LISTFILE. - DISPLAY "LIST SAMPLE FILE" UPON CONSOLE. - OPEN INPUT TSTFILE - MOVE SPACES TO TSTFL-RECORD. - MOVE "PRE00000" TO CM-CUST-NUM. - START TSTFILE KEY GREATER THAN OR EQUAL TO TS-CUST-NUM - READ TSTFILE NEXT RECORD - READ TSTFILE NEXT RECORD - CLOSE TSTFILE. - - MOVE ZERO TO REC-NUM - OPEN INPUT TSPFILE - IF CUST-STAT NOT = "00" - DISPLAY "ERROR " CUST-STAT " OPENING INPUT FILE" - UPON CONSOLE - STOP RUN - END-IF. - MOVE SPACES TO TSPFL-RECORD. - MOVE "PRE00000" TO CM-CUST-NUM. - START TSPFILE KEY GREATER THAN OR EQUAL TO CM-CUST-NUM - READ TSPFILE NEXT RECORD - READ TSPFILE NEXT RECORD - - MOVE SPACES TO TSPFL-RECORD. - MOVE "DEL00000" TO CM-CUST-NUM. - START TSPFILE KEY GREATER THAN CM-CUST-NUM - IF CUST-STAT NOT = "00" - DISPLAY "Error " CUST-STAT " starting file" - UPON CONSOLE - STOP RUN - END-IF. - READ TSPFILE NEXT RECORD WITH NO LOCK - IF CUST-STAT NOT = "00" - DISPLAY "Error " CUST-STAT " on 1st read of file" - UPON CONSOLE - STOP RUN - END-IF. - PERFORM UNTIL CUST-STAT NOT = "00" - OR REC-NUM > REC-MAX - DISPLAY "Key: " CM-CUST-NUM " is " CM-COMPANY - " Disk=" CM-DISK "." - UPON CONSOLE - CALL "callsub" USING CALL-NUM - READ TSPFILE NEXT RECORD - AT END - MOVE "99" TO CUST-STAT - END-READ - ADD 1 TO REC-NUM - END-PERFORM - IF CUST-STAT = "99" - DISPLAY "Hit End of File: " CALL-NUM UPON CONSOLE - ELSE - DISPLAY "Stop read after: " CALL-NUM UPON CONSOLE - END-IF. - - DISPLAY "LIST SAMPLE FILE DESCENDING" UPON CONSOLE. - MOVE ZERO TO REC-NUM - START TSPFILE KEY LESS THAN CM-CUST-NUM - IF CUST-STAT NOT = "00" - DISPLAY "Error " CUST-STAT " starting file" - UPON CONSOLE - STOP RUN - END-IF. - READ TSPFILE PREVIOUS RECORD WITH NO LOCK - IF CUST-STAT NOT = "00" - DISPLAY "Error " CUST-STAT " on 1st read of file" - UPON CONSOLE - STOP RUN - END-IF. - PERFORM UNTIL CUST-STAT NOT = "00" - OR REC-NUM > REC-MAX - DISPLAY "Key: " CM-CUST-NUM " is " CM-COMPANY - " Disk=" CM-DISK "." - UPON CONSOLE - READ TSPFILE PREVIOUS RECORD - AT END - MOVE "99" TO CUST-STAT - END-READ - ADD 1 TO REC-NUM - END-PERFORM. - - CLOSE TSPFILE. - - OPEN I-O TSPFILE. - MOVE SPACES TO TSPFL-RECORD. - MOVE DATA-CUST-NUM (2) TO CM-CUST-NUM. - MOVE 'X' TO CM-CUST-NUM (5:1). - READ TSPFILE KEY IS CM-CUST-NUM - IF CUST-STAT NOT = "23" - DISPLAY "Error " CUST-STAT " instead of 23." - UPON CONSOLE - END-IF. - MOVE DATA-CUST-NUM (2) TO CM-CUST-NUM. - MOVE DATA-COMPANY (2) TO CM-COMPANY. - READ TSPFILE KEY IS CM-CUST-NUM - IF CUST-STAT NOT = "00" - DISPLAY "Error " CUST-STAT " on primary read ." - UPON CONSOLE - ELSE - DISPLAY "Got: " CM-CUST-NUM " is " CM-COMPANY - " Disk=" CM-DISK "." - UPON CONSOLE - END-IF. - READ TSPFILE NEXT RECORD - IF CUST-STAT NOT = "00" - DISPLAY "Error " CUST-STAT " on next read" - UPON CONSOLE - ELSE - DISPLAY "Nxt: " CM-CUST-NUM " is " CM-COMPANY - " Disk=" CM-DISK "." - UPON CONSOLE - END-IF. - MOVE DATA-TELEPHONE (7) TO CM-TELEPHONE. - MOVE DATA-MACHINE (7) TO CM-MACHINE. - READ TSPFILE KEY IS CM-TELEPHONE - IF CUST-STAT NOT = "00" - DISPLAY "Error " CUST-STAT " instead of 23" - UPON CONSOLE - ELSE - DISPLAY "Ky2: " CM-CUST-NUM " is " CM-COMPANY - " Mach=" CM-MACHINE "." - UPON CONSOLE - END-IF. - WRITE TSPFL-RECORD - IF CUST-STAT NOT = "22" - DISPLAY "Error " CUST-STAT " instead of 22" - UPON CONSOLE - ELSE - DISPLAY " Write: " CM-CUST-NUM " got 22 as expected" - UPON CONSOLE - END-IF. - MOVE DATA-CUST-NUM (3) TO CM-CUST-NUM. - MOVE DATA-COMPANY (3) TO CM-COMPANY. - READ TSPFILE KEY IS CM-CUST-NUM - DISPLAY " Read: " CM-CUST-NUM " got " - CUST-STAT " as expected " - CM-NO-TERMINALS " terminals" - UPON CONSOLE. - ADD 5 TO CM-NO-TERMINALS - REWRITE TSPFL-RECORD - IF CUST-STAT NOT = "00" - DISPLAY "Error " CUST-STAT - " instead of 00" - UPON CONSOLE - ELSE - DISPLAY "ReWrite: " CM-CUST-NUM " got " - CUST-STAT " as expected " - CM-NO-TERMINALS " terminals" - UPON CONSOLE - END-IF. - MOVE DATA-CUST-NUM (2) TO CM-CUST-NUM. - MOVE DATA-COMPANY (2) TO CM-COMPANY. - READ TSPFILE KEY IS CM-CUST-NUM - DISPLAY " Read: " CM-CUST-NUM " got " - CUST-STAT " as expected " - CM-NO-TERMINALS " terminals" - UPON CONSOLE. - MOVE DATA-CUST-NUM (3) TO CM-CUST-NUM. - MOVE DATA-COMPANY (3) TO CM-COMPANY. - REWRITE TSPFL-RECORD - IF CUST-STAT NOT = "02" - AND CUST-STAT NOT = "00" - DISPLAY "Error " CUST-STAT " instead of 00/02" - UPON CONSOLE - ELSE - DISPLAY "ReWrite: " CM-CUST-NUM " got " - "00/02 as expected" - UPON CONSOLE - END-IF. - MOVE DATA-CUST-NUM (6) TO CM-CUST-NUM. - MOVE DATA-COMPANY (6) TO CM-COMPANY. - READ TSPFILE KEY IS CM-CUST-NUM - MOVE DATA-TELEPHONE (7) TO CM-TELEPHONE. - MOVE DATA-MACHINE (7) TO CM-MACHINE. - REWRITE TSPFL-RECORD - IF CUST-STAT NOT = "02" - AND CUST-STAT NOT = "00" - DISPLAY "Error " CUST-STAT " instead of 00/02" - UPON CONSOLE - ELSE - DISPLAY "ReWrite: " CM-CUST-NUM " got " - "00/02 as expected" - UPON CONSOLE - END-IF. - DELETE TSPFILE. - CLOSE TSPFILE. - - LOADFLAT. - OPEN OUTPUT FLATFILE. - PERFORM FLAT-RECORD - VARYING SUB FROM 1 BY 1 - UNTIL SUB > MAX-SUB - OR SUB > 5. - CLOSE FLATFILE. - OPEN INPUT FLATFILE. - MOVE 3 TO REC-NUM - READ FLATFILE - MOVE 999 TO REC-NUM - READ FLATFILE - CLOSE FLATFILE. - - FLAT-RECORD. - - MOVE SPACES TO TSP2-RECORD. - MOVE SUB TO REC-NUM. - MOVE DATA-CUST-NUM (SUB) TO C2-CUST-NUM. - MOVE DATA-COMPANY (SUB) TO C2-COMPANY. - MOVE DATA-NO-TERMINALS (SUB) TO C2-NO-TERMINALS. - MOVE 20070319 TO C2-PK-DATE. - IF ODD-RECORD - MOVE "8417" TO C2-DISK - ELSE - MOVE "8470" TO C2-DISK. - WRITE TSP2-RECORD. -]) - -AT_CHECK([$COMPILE -ftraceall prog.cob ], [0], [], []) - -AT_CHECK([COB_TRACE_FILE=trace.txt \ -COB_TRACE_IO=Y \ -COB_SET_TRACE=Y \ -COB_TRACE_FORMAT=' Line: %L %S' \ -IO_TSPFILE=trace \ -IO_TSTFILE=no-trace \ -./prog], [0], -[OK: Operations on empty file -Loading sample data file. -Sample data file load complete. -LIST SAMPLE FILE -Key: EPS00000 is EPSILON EQUIPMENT SUPPLY Disk=8417 . -Key: FOR00000 is FORTUNE COOKIE COMPANY Disk=8470 . -Key: GAM00000 is GAMMA X-RAY TECHNOLOGY Disk=8417 . -Key: GIB00000 is GIBRALTER LIFE INSURANCE Disk=8417 . -Key: H&J00000 is H & J PLUMBING SUPPLIES Disk=8470 . -Key: INC00000 is INCREMENTAL BACKUP CORP. Disk=8417 . -Key: JOH00000 is JOHNSON BOATING SUPPLIES Disk=8417 . -Key: KON00000 is KONFLAB PLASTIC PRODUCTS. Disk=8417 . -Key: LEW00000 is LEWISTON GRAPHICS LTD. Disk=8470 . -Key: MOR00000 is MORNINGSIDE CARPENTRY. Disk=8470 . -Key: NEW00000 is NEW WAVE SURF SHOPS INC. Disk=8470 . -Stop read after: 11 -LIST SAMPLE FILE DESCENDING -Key: NEW00000 is NEW WAVE SURF SHOPS INC. Disk=8470 . -Key: MOR00000 is MORNINGSIDE CARPENTRY. Disk=8470 . -Key: LEW00000 is LEWISTON GRAPHICS LTD. Disk=8470 . -Key: KON00000 is KONFLAB PLASTIC PRODUCTS. Disk=8417 . -Key: JOH00000 is JOHNSON BOATING SUPPLIES Disk=8417 . -Key: INC00000 is INCREMENTAL BACKUP CORP. Disk=8417 . -Key: H&J00000 is H & J PLUMBING SUPPLIES Disk=8470 . -Key: GIB00000 is GIBRALTER LIFE INSURANCE Disk=8417 . -Key: GAM00000 is GAMMA X-RAY TECHNOLOGY Disk=8417 . -Key: FOR00000 is FORTUNE COOKIE COMPANY Disk=8470 . -Key: EPS00000 is EPSILON EQUIPMENT SUPPLY Disk=8417 . -Got: BET00000 is BETA SHOE MFG. INC. Disk=8470 . -Nxt: DEL00000 is DELTA LUGGAGE REPAIRS Disk=8470 . -Ky2: GIB00000 is GIBRALTER LIFE INSURANCE Mach=UNI-80/6. - Write: GIB00000 got 22 as expected - Read: GAM00000 got 00 as expected 00075 terminals -ReWrite: GAM00000 got 00 as expected 00080 terminals - Read: BET00000 got 00 as expected 00034 terminals -ReWrite: GAM00000 got 00/02 as expected -ReWrite: FOR00000 got 00/02 as expected -Expected ERROR 39 opening TSTFILE, Record size different -], []) - - -AT_CAPTURE_FILE(./trace.txt) - -AT_DATA([reference], [Source: 'prog.cob' -Program-Id: prog - Line: 290 Entry: prog - Line: 292 Paragraph: MAINFILE - Line: 293 OPEN - OPEN OUTPUT TSPFILE -> 'testisam' Status: 00 - Line: 294 CLOSE - CLOSE TSPFILE Status: 00 - Line: 296 OPEN - OPEN I_O TSPFILE -> 'testisam' Status: 00 - Line: 297 MOVE - Line: 298 READ - READ Sequential TSPFILE Status: 10 - Line: 299 IF - Line: 304 MOVE - Line: 305 START - START TSPFILE Status: 23 - Key : ALL LOW-VALUES - Line: 306 IF - Line: 311 READ - READ Sequential TSPFILE Status: 46 - Line: 312 IF - Line: 317 DISPLAY - Line: 318 CLOSE - CLOSE TSPFILE Status: 00 - Line: 320 PERFORM - Line: 335 Paragraph: LOADFILE - Line: 336 DISPLAY - Line: 339 OPEN - OPEN OUTPUT TSPFILE -> 'testisam' Status: 00 - Line: 340 IF - Line: 346 PERFORM - Line: 358 Paragraph: 1000-LOAD-RECORD - Line: 360 MOVE - Line: 361 MOVE - Line: 362 MOVE - Line: 363 MOVE - Line: 364 MOVE - Line: 365 MOVE - Line: 366 MOVE - Line: 367 MOVE - Line: 368 MOVE - Line: 369 MOVE - Line: 370 MOVE - Line: 372 IF - Line: 373 MOVE - Line: 374 MOVE - Line: 375 MOVE - Line: 381 WRITE - WRITE TSPFILE Status: 00 - Record : 'ALP00000 ALPHA ELECTRICAL CO. LTD.123 MAIN STREET NEW YORK ' - ' N.Y. 3131234432MR. DAVE HARRIS UNI-90301MEG8417' - ' 1600 BPI00085' - Line: 382 IF - Line: 358 Paragraph: 1000-LOAD-RECORD - Line: 360 MOVE - Line: 361 MOVE - Line: 362 MOVE - Line: 363 MOVE - Line: 364 MOVE - Line: 365 MOVE - Line: 366 MOVE - Line: 367 MOVE - Line: 368 MOVE - Line: 369 MOVE - Line: 370 MOVE - Line: 372 IF - Line: 377 MOVE - Line: 378 MOVE - Line: 379 MOVE - Line: 381 WRITE - WRITE TSPFILE Status: 00 - Record : 'BET00000 BETA SHOE MFG. INC. 1090 2ND AVE. WEST ATLANTA ' - ' GEORGIA 4082938498MS. JANICE SILCOX UNI-90403MEG8470' - ' 6250 BPI00034' - Line: 382 IF - Line: 358 Paragraph: 1000-LOAD-RECORD - Line: 360 MOVE - Line: 361 MOVE - Line: 362 MOVE - Line: 363 MOVE - Line: 364 MOVE - Line: 365 MOVE - Line: 366 MOVE - Line: 367 MOVE - Line: 368 MOVE - Line: 369 MOVE - Line: 370 MOVE - Line: 372 IF - Line: 373 MOVE - Line: 374 MOVE - Line: 375 MOVE - Line: 381 WRITE - WRITE TSPFILE Status: 02 - Record : 'GAM00000 GAMMA X-RAY TECHNOLOGY 1401 JEFFERSON BLVD. WASHINGTON ' - ' D.C. 8372487274MR. ALLAN JONES UNI-80/31MEG8417' - ' 1600 BPI00075' - Line: 382 IF - Line: 358 Paragraph: 1000-LOAD-RECORD - Line: 360 MOVE - Line: 361 MOVE - Line: 362 MOVE - Line: 363 MOVE - Line: 364 MOVE - Line: 365 MOVE - Line: 366 MOVE - Line: 367 MOVE - Line: 368 MOVE - Line: 369 MOVE - Line: 370 MOVE - Line: 372 IF - Line: 377 MOVE - Line: 378 MOVE - Line: 379 MOVE - Line: 381 WRITE - WRITE TSPFILE Status: 02 - Record : 'DEL00000 DELTA LUGGAGE REPAIRS 1620 ARIZONA WAY TORONTO ' - ' CANADA 4169898509MR. PETER MACKAY UNI-80/53MEG8470' - ' 6250 BPI00045' - Line: 382 IF - Line: 358 Paragraph: 1000-LOAD-RECORD - Line: 360 MOVE - Line: 361 MOVE - Line: 362 MOVE - Line: 363 MOVE - Line: 364 MOVE - Line: 365 MOVE - Line: 366 MOVE - Line: 367 MOVE - Line: 368 MOVE - Line: 369 MOVE - Line: 370 MOVE - Line: 372 IF - Line: 373 MOVE - Line: 374 MOVE - Line: 375 MOVE - Line: 381 WRITE - WRITE TSPFILE Status: 02 - Record : 'EPS00000 EPSILON EQUIPMENT SUPPLY 1184 EAST FIRST STREET CALGARY ' - ' CANADA 5292398745MRS. DONNA BREWER UNI-80/61MEG8417' - ' 1600 BPI00090' - Line: 382 IF - Line: 358 Paragraph: 1000-LOAD-RECORD - Line: 360 MOVE - Line: 361 MOVE - Line: 362 MOVE - Line: 363 MOVE - Line: 364 MOVE - Line: 365 MOVE - Line: 366 MOVE - Line: 367 MOVE - Line: 368 MOVE - Line: 369 MOVE - Line: 370 MOVE - Line: 372 IF - Line: 377 MOVE - Line: 378 MOVE - Line: 379 MOVE - Line: 381 WRITE - WRITE TSPFILE Status: 02 - Record : 'FOR00000 FORTUNE COOKIE COMPANY 114 JOHN F. KENNEDY AVE. SAN DIEGO ' - ' CALIFORNIA 8009329492MR. MICHAEL SMYTHE UNI-80/63MEG8470' - ' 6250 BPI00107' - Line: 382 IF - Line: 358 Paragraph: 1000-LOAD-RECORD - Line: 360 MOVE - Line: 361 MOVE - Line: 362 MOVE - Line: 363 MOVE - Line: 364 MOVE - Line: 365 MOVE - Line: 366 MOVE - Line: 367 MOVE - Line: 368 MOVE - Line: 369 MOVE - Line: 370 MOVE - Line: 372 IF - Line: 373 MOVE - Line: 374 MOVE - Line: 375 MOVE - Line: 381 WRITE - WRITE TSPFILE Status: 02 - Record : 'GIB00000 GIBRALTER LIFE INSURANCE 650 LIBERTY CRESCENT LOS RIOS ' - ' NEW MEXICO 6456445643MR. D.A. MORRISON UNI-80/61MEG8417' - ' 1600 BPI00067' - Line: 382 IF - Line: 358 Paragraph: 1000-LOAD-RECORD - Line: 360 MOVE - Line: 361 MOVE - Line: 362 MOVE - Line: 363 MOVE - Line: 364 MOVE - Line: 365 MOVE - Line: 366 MOVE - Line: 367 MOVE - Line: 368 MOVE - Line: 369 MOVE - Line: 370 MOVE - Line: 372 IF - Line: 377 MOVE - Line: 378 MOVE - Line: 379 MOVE - Line: 381 WRITE - WRITE TSPFILE Status: 02 - Record : 'H&J00000 H & J PLUMBING SUPPLIES 77 SUNSET BLVD. MADISON ' - ' WISCONSIN 6546456333MR. BRIAN PATTERSON UNI-80/83MEG8470' - ' 6250 BPI00032' - Line: 382 IF - Line: 358 Paragraph: 1000-LOAD-RECORD - Line: 360 MOVE - Line: 361 MOVE - Line: 362 MOVE - Line: 363 MOVE - Line: 364 MOVE - Line: 365 MOVE - Line: 366 MOVE - Line: 367 MOVE - Line: 368 MOVE - Line: 369 MOVE - Line: 370 MOVE - Line: 372 IF - Line: 373 MOVE - Line: 374 MOVE - Line: 375 MOVE - Line: 381 WRITE - WRITE TSPFILE Status: 02 - Record : 'INC00000 INCREMENTAL BACKUP CORP. 10908 SANTA MONICA BLVD. WILBUR ' - ' DELAWARE 3455445444MR. DARRYL TOWNSEND UNI-80/81MEG8417' - ' 1600 BPI00016' - Line: 382 IF - Line: 358 Paragraph: 1000-LOAD-RECORD - Line: 360 MOVE - Line: 361 MOVE - Line: 362 MOVE - Line: 363 MOVE - Line: 364 MOVE - Line: 365 MOVE - Line: 366 MOVE - Line: 367 MOVE - Line: 368 MOVE - Line: 369 MOVE - Line: 370 MOVE - Line: 372 IF - Line: 373 MOVE - Line: 374 MOVE - Line: 375 MOVE - Line: 381 WRITE - WRITE TSPFILE Status: 02 - Record : 'JOH00000 JOHNSON BOATING SUPPLIES 1134 PARIS ROAD TOPEKA ' - ' KANSAS 6456445643MS. VALERIE HARPER UNI-80/81MEG8417' - ' 1600 BPI00034' - Line: 382 IF - Line: 358 Paragraph: 1000-LOAD-RECORD - Line: 360 MOVE - Line: 361 MOVE - Line: 362 MOVE - Line: 363 MOVE - Line: 364 MOVE - Line: 365 MOVE - Line: 366 MOVE - Line: 367 MOVE - Line: 368 MOVE - Line: 369 MOVE - Line: 370 MOVE - Line: 372 IF - Line: 373 MOVE - Line: 374 MOVE - Line: 375 MOVE - Line: 381 WRITE - WRITE TSPFILE Status: 02 - Record : 'KON00000 KONFLAB PLASTIC PRODUCTS.808 NORTHWEST MAIN ST. SEATTLE ' - ' WASHINGTON 7456434355MR. FRED MILLER UNI-80/81MEG8417' - ' 1600 BPI00128' - Line: 382 IF - Line: 358 Paragraph: 1000-LOAD-RECORD - Line: 360 MOVE - Line: 361 MOVE - Line: 362 MOVE - Line: 363 MOVE - Line: 364 MOVE - Line: 365 MOVE - Line: 366 MOVE - Line: 367 MOVE - Line: 368 MOVE - Line: 369 MOVE - Line: 370 MOVE - Line: 372 IF - Line: 377 MOVE - Line: 378 MOVE - Line: 379 MOVE - Line: 381 WRITE - WRITE TSPFILE Status: 02 - Record : 'LEW00000 LEWISTON GRAPHICS LTD. 9904 QUEEN STREET NEW JERSEY ' - ' N.J. 6554456433MR. DONALD FISCHER UNI-80/83MEG8470' - ' 6250 BPI00064' - Line: 382 IF - Line: 358 Paragraph: 1000-LOAD-RECORD - Line: 360 MOVE - Line: 361 MOVE - Line: 362 MOVE - Line: 363 MOVE - Line: 364 MOVE - Line: 365 MOVE - Line: 366 MOVE - Line: 367 MOVE - Line: 368 MOVE - Line: 369 MOVE - Line: 370 MOVE - Line: 372 IF - Line: 377 MOVE - Line: 378 MOVE - Line: 379 MOVE - Line: 381 WRITE - WRITE TSPFILE Status: 02 - Record : 'MOR00000 MORNINGSIDE CARPENTRY. 1709 DUNDAS CRESCENT W. FORT WAYNE ' - ' COLORADO 4169898509MR. STEVEN YOURDIN UNI-80/83MEG8470' - ' 6250 BPI00110' - Line: 382 IF - Line: 358 Paragraph: 1000-LOAD-RECORD - Line: 360 MOVE - Line: 361 MOVE - Line: 362 MOVE - Line: 363 MOVE - Line: 364 MOVE - Line: 365 MOVE - Line: 366 MOVE - Line: 367 MOVE - Line: 368 MOVE - Line: 369 MOVE - Line: 370 MOVE - Line: 372 IF - Line: 377 MOVE - Line: 378 MOVE - Line: 379 MOVE - Line: 381 WRITE - WRITE TSPFILE Status: 02 - Record : 'NEW00000 NEW WAVE SURF SHOPS INC. 3240 MARIS AVENUE COLUMBUS ' - ' OHIO 7534587453MS. Goldie Hawn UNI-80/83MEG8470' - ' 6250 BPI00324' - Line: 382 IF - Line: 358 Paragraph: 1000-LOAD-RECORD - Line: 360 MOVE - Line: 361 MOVE - Line: 362 MOVE - Line: 363 MOVE - Line: 364 MOVE - Line: 365 MOVE - Line: 366 MOVE - Line: 367 MOVE - Line: 368 MOVE - Line: 369 MOVE - Line: 370 MOVE - Line: 372 IF - Line: 377 MOVE - Line: 378 MOVE - Line: 379 MOVE - Line: 381 WRITE - WRITE TSPFILE Status: 02 - Record : 'OLD00000 OLD TYME PIZZA MFG. CO. 1705 WISCONSIN ROAD RICHMOND ' - ' VIRGINIA 8787458374MS. ALICE WINSTON UNI-90403MEG8470' - ' 6250 BPI00124' - Line: 382 IF - Line: 358 Paragraph: 1000-LOAD-RECORD - Line: 360 MOVE - Line: 361 MOVE - Line: 362 MOVE - Line: 363 MOVE - Line: 364 MOVE - Line: 365 MOVE - Line: 366 MOVE - Line: 367 MOVE - Line: 368 MOVE - Line: 369 MOVE - Line: 370 MOVE - Line: 372 IF - Line: 377 MOVE - Line: 378 MOVE - Line: 379 MOVE - Line: 381 WRITE - WRITE TSPFILE Status: 02 - Record : 'PRE00000 PRESTIGE OFFICE FURNITURE114A MAPLE GROVE WHITEPLAIN ' - ' N.Y. 4169898509MR. THOMAS JEFFERSON UNI-90403MEG8470' - ' 6250 BPI00086' - Line: 382 IF - Line: 350 DISPLAY - Line: 352 CLOSE - CLOSE TSPFILE Status: 00 - Line: 321 PERFORM - Line: 387 Paragraph: LISTFILE - Line: 388 DISPLAY - Line: 389 OPEN - Line: 390 MOVE - Line: 391 MOVE - Line: 392 START - Line: 393 READ - Line: 394 READ - Line: 395 CLOSE - Line: 397 MOVE - Line: 398 OPEN - OPEN INPUT TSPFILE -> 'testisam' Status: 00 - Line: 399 IF - Line: 404 MOVE - Line: 405 MOVE - Line: 406 START - START TSPFILE Status: 00 - Key : 'PRE00000' - Line: 407 READ - READ Sequential TSPFILE Status: 00 - Record : 'PRE00000 PRESTIGE OFFICE FURNITURE114A MAPLE GROVE WHITEPLAIN ' - ' N.Y. 4169898509MR. THOMAS JEFFERSON UNI-90403MEG8470' - ' 6250 BPI00086' - Line: 408 READ - READ Sequential TSPFILE Status: 10 - Line: 410 MOVE - Line: 411 MOVE - Line: 412 START - START TSPFILE Status: 00 - Key : 'DEL00000' - Line: 413 IF - Line: 418 READ - READ Sequential TSPFILE Status: 00 - Record : 'EPS00000 EPSILON EQUIPMENT SUPPLY 1184 EAST FIRST STREET CALGARY ' - ' CANADA 5292398745MRS. DONNA BREWER UNI-80/61MEG8417' - ' 1600 BPI00090' - Line: 419 IF - Line: 424 PERFORM - Line: 426 DISPLAY - Line: 429 CALL - Line: 430 READ - READ Sequential TSPFILE Status: 00 - Record : 'FOR00000 FORTUNE COOKIE COMPANY 114 JOHN F. KENNEDY AVE. SAN DIEGO ' - ' CALIFORNIA 8009329492MR. MICHAEL SMYTHE UNI-80/63MEG8470' - ' 6250 BPI00107' - Line: 434 ADD - Line: 426 DISPLAY - Line: 429 CALL - Line: 430 READ - READ Sequential TSPFILE Status: 00 - Record : 'GAM00000 GAMMA X-RAY TECHNOLOGY 1401 JEFFERSON BLVD. WASHINGTON ' - ' D.C. 8372487274MR. ALLAN JONES UNI-80/31MEG8417' - ' 1600 BPI00075' - Line: 434 ADD - Line: 426 DISPLAY - Line: 429 CALL - Line: 430 READ - READ Sequential TSPFILE Status: 00 - Record : 'GIB00000 GIBRALTER LIFE INSURANCE 650 LIBERTY CRESCENT LOS RIOS ' - ' NEW MEXICO 6456445643MR. D.A. MORRISON UNI-80/61MEG8417' - ' 1600 BPI00067' - Line: 434 ADD - Line: 426 DISPLAY - Line: 429 CALL - Line: 430 READ - READ Sequential TSPFILE Status: 00 - Record : 'H&J00000 H & J PLUMBING SUPPLIES 77 SUNSET BLVD. MADISON ' - ' WISCONSIN 6546456333MR. BRIAN PATTERSON UNI-80/83MEG8470' - ' 6250 BPI00032' - Line: 434 ADD - Line: 426 DISPLAY - Line: 429 CALL - Line: 430 READ - READ Sequential TSPFILE Status: 00 - Record : 'INC00000 INCREMENTAL BACKUP CORP. 10908 SANTA MONICA BLVD. WILBUR ' - ' DELAWARE 3455445444MR. DARRYL TOWNSEND UNI-80/81MEG8417' - ' 1600 BPI00016' - Line: 434 ADD - Line: 426 DISPLAY - Line: 429 CALL - Line: 430 READ - READ Sequential TSPFILE Status: 00 - Record : 'JOH00000 JOHNSON BOATING SUPPLIES 1134 PARIS ROAD TOPEKA ' - ' KANSAS 6456445643MS. VALERIE HARPER UNI-80/81MEG8417' - ' 1600 BPI00034' - Line: 434 ADD - Line: 426 DISPLAY - Line: 429 CALL - Line: 430 READ - READ Sequential TSPFILE Status: 00 - Record : 'KON00000 KONFLAB PLASTIC PRODUCTS.808 NORTHWEST MAIN ST. SEATTLE ' - ' WASHINGTON 7456434355MR. FRED MILLER UNI-80/81MEG8417' - ' 1600 BPI00128' - Line: 434 ADD - Line: 426 DISPLAY - Line: 429 CALL - Line: 430 READ - READ Sequential TSPFILE Status: 00 - Record : 'LEW00000 LEWISTON GRAPHICS LTD. 9904 QUEEN STREET NEW JERSEY ' - ' N.J. 6554456433MR. DONALD FISCHER UNI-80/83MEG8470' - ' 6250 BPI00064' - Line: 434 ADD - Line: 426 DISPLAY - Line: 429 CALL - Line: 430 READ - READ Sequential TSPFILE Status: 00 - Record : 'MOR00000 MORNINGSIDE CARPENTRY. 1709 DUNDAS CRESCENT W. FORT WAYNE ' - ' COLORADO 4169898509MR. STEVEN YOURDIN UNI-80/83MEG8470' - ' 6250 BPI00110' - Line: 434 ADD - Line: 426 DISPLAY - Line: 429 CALL - Line: 430 READ - READ Sequential TSPFILE Status: 00 - Record : 'NEW00000 NEW WAVE SURF SHOPS INC. 3240 MARIS AVENUE COLUMBUS ' - ' OHIO 7534587453MS. Goldie Hawn UNI-80/83MEG8470' - ' 6250 BPI00324' - Line: 434 ADD - Line: 426 DISPLAY - Line: 429 CALL - Line: 430 READ - READ Sequential TSPFILE Status: 00 - Record : 'OLD00000 OLD TYME PIZZA MFG. CO. 1705 WISCONSIN ROAD RICHMOND ' - ' VIRGINIA 8787458374MS. ALICE WINSTON UNI-90403MEG8470' - ' 6250 BPI00124' - Line: 434 ADD - Line: 436 IF - Line: 439 DISPLAY - Line: 442 DISPLAY - Line: 443 MOVE - Line: 444 START - START TSPFILE Status: 00 - Key : 'OLD00000' - Line: 445 IF - Line: 450 READ - READ Sequential TSPFILE Status: 00 - Record : 'NEW00000 NEW WAVE SURF SHOPS INC. 3240 MARIS AVENUE COLUMBUS ' - ' OHIO 7534587453MS. Goldie Hawn UNI-80/83MEG8470' - ' 6250 BPI00324' - Line: 451 IF - Line: 456 PERFORM - Line: 458 DISPLAY - Line: 461 READ - READ Sequential TSPFILE Status: 00 - Record : 'MOR00000 MORNINGSIDE CARPENTRY. 1709 DUNDAS CRESCENT W. FORT WAYNE ' - ' COLORADO 4169898509MR. STEVEN YOURDIN UNI-80/83MEG8470' - ' 6250 BPI00110' - Line: 465 ADD - Line: 458 DISPLAY - Line: 461 READ - READ Sequential TSPFILE Status: 00 - Record : 'LEW00000 LEWISTON GRAPHICS LTD. 9904 QUEEN STREET NEW JERSEY ' - ' N.J. 6554456433MR. DONALD FISCHER UNI-80/83MEG8470' - ' 6250 BPI00064' - Line: 465 ADD - Line: 458 DISPLAY - Line: 461 READ - READ Sequential TSPFILE Status: 00 - Record : 'KON00000 KONFLAB PLASTIC PRODUCTS.808 NORTHWEST MAIN ST. SEATTLE ' - ' WASHINGTON 7456434355MR. FRED MILLER UNI-80/81MEG8417' - ' 1600 BPI00128' - Line: 465 ADD - Line: 458 DISPLAY - Line: 461 READ - READ Sequential TSPFILE Status: 00 - Record : 'JOH00000 JOHNSON BOATING SUPPLIES 1134 PARIS ROAD TOPEKA ' - ' KANSAS 6456445643MS. VALERIE HARPER UNI-80/81MEG8417' - ' 1600 BPI00034' - Line: 465 ADD - Line: 458 DISPLAY - Line: 461 READ - READ Sequential TSPFILE Status: 00 - Record : 'INC00000 INCREMENTAL BACKUP CORP. 10908 SANTA MONICA BLVD. WILBUR ' - ' DELAWARE 3455445444MR. DARRYL TOWNSEND UNI-80/81MEG8417' - ' 1600 BPI00016' - Line: 465 ADD - Line: 458 DISPLAY - Line: 461 READ - READ Sequential TSPFILE Status: 00 - Record : 'H&J00000 H & J PLUMBING SUPPLIES 77 SUNSET BLVD. MADISON ' - ' WISCONSIN 6546456333MR. BRIAN PATTERSON UNI-80/83MEG8470' - ' 6250 BPI00032' - Line: 465 ADD - Line: 458 DISPLAY - Line: 461 READ - READ Sequential TSPFILE Status: 00 - Record : 'GIB00000 GIBRALTER LIFE INSURANCE 650 LIBERTY CRESCENT LOS RIOS ' - ' NEW MEXICO 6456445643MR. D.A. MORRISON UNI-80/61MEG8417' - ' 1600 BPI00067' - Line: 465 ADD - Line: 458 DISPLAY - Line: 461 READ - READ Sequential TSPFILE Status: 00 - Record : 'GAM00000 GAMMA X-RAY TECHNOLOGY 1401 JEFFERSON BLVD. WASHINGTON ' - ' D.C. 8372487274MR. ALLAN JONES UNI-80/31MEG8417' - ' 1600 BPI00075' - Line: 465 ADD - Line: 458 DISPLAY - Line: 461 READ - READ Sequential TSPFILE Status: 00 - Record : 'FOR00000 FORTUNE COOKIE COMPANY 114 JOHN F. KENNEDY AVE. SAN DIEGO ' - ' CALIFORNIA 8009329492MR. MICHAEL SMYTHE UNI-80/63MEG8470' - ' 6250 BPI00107' - Line: 465 ADD - Line: 458 DISPLAY - Line: 461 READ - READ Sequential TSPFILE Status: 00 - Record : 'EPS00000 EPSILON EQUIPMENT SUPPLY 1184 EAST FIRST STREET CALGARY ' - ' CANADA 5292398745MRS. DONNA BREWER UNI-80/61MEG8417' - ' 1600 BPI00090' - Line: 465 ADD - Line: 458 DISPLAY - Line: 461 READ - READ Sequential TSPFILE Status: 00 - Record : 'DEL00000 DELTA LUGGAGE REPAIRS 1620 ARIZONA WAY TORONTO ' - ' CANADA 4169898509MR. PETER MACKAY UNI-80/53MEG8470' - ' 6250 BPI00045' - Line: 465 ADD - Line: 468 CLOSE - CLOSE TSPFILE Status: 00 - Line: 470 OPEN - OPEN I_O TSPFILE -> 'testisam' Status: 00 - Line: 471 MOVE - Line: 472 MOVE - Line: 473 MOVE - Line: 474 READ - READ TSPFILE Status: 23 - Key : 'BET0X000' - Line: 475 IF - Line: 479 MOVE - Line: 480 MOVE - Line: 481 READ - READ TSPFILE Status: 00 - Record : 'BET00000 BETA SHOE MFG. INC. 1090 2ND AVE. WEST ATLANTA ' - ' GEORGIA 4082938498MS. JANICE SILCOX UNI-90403MEG8470' - ' 6250 BPI00034' - Key : 'BET00000' - Line: 482 IF - Line: 486 DISPLAY - Line: 490 READ - READ Sequential TSPFILE Status: 00 - Record : 'DEL00000 DELTA LUGGAGE REPAIRS 1620 ARIZONA WAY TORONTO ' - ' CANADA 4169898509MR. PETER MACKAY UNI-80/53MEG8470' - ' 6250 BPI00045' - Line: 491 IF - Line: 495 DISPLAY - Line: 499 MOVE - Line: 500 MOVE - Line: 501 READ - READ TSPFILE Status: 00 - Record : 'GIB00000 GIBRALTER LIFE INSURANCE 650 LIBERTY CRESCENT LOS RIOS ' - ' NEW MEXICO 6456445643MR. D.A. MORRISON UNI-80/61MEG8417' - ' 1600 BPI00067' - Key : 6456445643 - Line: 502 IF - Line: 506 DISPLAY - Line: 510 WRITE - WRITE TSPFILE Status: 22 - Record : 'GIB00000 GIBRALTER LIFE INSURANCE 650 LIBERTY CRESCENT LOS RIOS ' - ' NEW MEXICO 6456445643MR. D.A. MORRISON UNI-80/61MEG8417' - ' 1600 BPI00067' - Line: 511 IF - Line: 515 DISPLAY - Line: 518 MOVE - Line: 519 MOVE - Line: 520 READ - READ TSPFILE Status: 00 - Record : 'GAM00000 GAMMA X-RAY TECHNOLOGY 1401 JEFFERSON BLVD. WASHINGTON ' - ' D.C. 8372487274MR. ALLAN JONES UNI-80/31MEG8417' - ' 1600 BPI00075' - Key : 'GAM00000' - Line: 521 DISPLAY - Line: 525 ADD - Line: 526 REWRITE - REWRITE TSPFILE Status: 00 - Record : 'GAM00000 GAMMA X-RAY TECHNOLOGY 1401 JEFFERSON BLVD. WASHINGTON ' - ' D.C. 8372487274MR. ALLAN JONES UNI-80/31MEG8417' - ' 1600 BPI00080' - Line: 527 IF - Line: 532 DISPLAY - Line: 537 MOVE - Line: 538 MOVE - Line: 539 READ - READ TSPFILE Status: 00 - Record : 'BET00000 BETA SHOE MFG. INC. 1090 2ND AVE. WEST ATLANTA ' - ' GEORGIA 4082938498MS. JANICE SILCOX UNI-90403MEG8470' - ' 6250 BPI00034' - Key : 'BET00000' - Line: 540 DISPLAY - Line: 544 MOVE - Line: 545 MOVE - Line: 546 REWRITE - REWRITE TSPFILE Status: 02 - Record : 'GAM00000 GAMMA X-RAY TECHNOLOGY 1090 2ND AVE. WEST ATLANTA ' - ' GEORGIA 4082938498MS. JANICE SILCOX UNI-90403MEG8470' - ' 6250 BPI00034' - Line: 547 IF - Line: 552 DISPLAY - Line: 556 MOVE - Line: 557 MOVE - Line: 558 READ - READ TSPFILE Status: 00 - Record : 'FOR00000 FORTUNE COOKIE COMPANY 114 JOHN F. KENNEDY AVE. SAN DIEGO ' - ' CALIFORNIA 8009329492MR. MICHAEL SMYTHE UNI-80/63MEG8470' - ' 6250 BPI00107' - Key : 'FOR00000' - Line: 559 MOVE - Line: 560 MOVE - Line: 561 REWRITE - REWRITE TSPFILE Status: 02 - Record : 'FOR00000 FORTUNE COOKIE COMPANY 114 JOHN F. KENNEDY AVE. SAN DIEGO ' - ' CALIFORNIA 6456445643MR. MICHAEL SMYTHE UNI-80/63MEG8470' - ' 6250 BPI00107' - Line: 562 IF - Line: 567 DISPLAY - Line: 571 DELETE - DELETE TSPFILE Status: 00 - Record : 'FOR00000 FORTUNE COOKIE COMPANY 114 JOHN F. KENNEDY AVE. SAN DIEGO ' - ' CALIFORNIA 6456445643MR. MICHAEL SMYTHE UNI-80/63MEG8470' - ' 6250 BPI00107' - Line: 572 CLOSE - CLOSE TSPFILE Status: 00 - Line: 322 OPEN - Line: 323 IF - Line: 324 DISPLAY - Line: 332 PERFORM - Line: 574 Paragraph: LOADFLAT - Line: 575 OPEN - OPEN OUTPUT FLATFILE -> 'RELFIX' Status: 00 - Line: 576 PERFORM - Line: 588 Paragraph: FLAT-RECORD - Line: 590 MOVE - Line: 591 MOVE - Line: 592 MOVE - Line: 593 MOVE - Line: 594 MOVE - Line: 595 MOVE - Line: 596 IF - Line: 597 MOVE - Line: 600 WRITE - WRITE FLATFILE Status: 00 - Record : A L P 0 0 0 0 0 A L P H A E L E C T R I C A L C O . L T D - 1 x 414C5030 30303030 414C5048 4120454C 45435452 4943414C 20434F2E 204C5444 - . 8 4 1 7 U p 1 - 33 x 2E383431 37202020 20005500 00000200 70319C - Record# : 000001 - Line: 588 Paragraph: FLAT-RECORD - Line: 590 MOVE - Line: 591 MOVE - Line: 592 MOVE - Line: 593 MOVE - Line: 594 MOVE - Line: 595 MOVE - Line: 596 IF - Line: 599 MOVE - Line: 600 WRITE - WRITE FLATFILE Status: 00 - Record : B E T 0 0 0 0 0 B E T A S H O E M F G . I N C . - 1 x 42455430 30303030 42455441 2053484F 45204D46 472E2049 4E432E20 20202020 - 8 4 7 0 " p 1 - 33 x 20383437 30202020 20002200 00000200 70319C - Record# : 000002 - Line: 588 Paragraph: FLAT-RECORD - Line: 590 MOVE - Line: 591 MOVE - Line: 592 MOVE - Line: 593 MOVE - Line: 594 MOVE - Line: 595 MOVE - Line: 596 IF - Line: 597 MOVE - Line: 600 WRITE - WRITE FLATFILE Status: 00 - Record : G A M 0 0 0 0 0 G A M M A X - R A Y T E C H N O L O G Y - 1 x 47414D30 30303030 47414D4D 4120582D 52415920 54454348 4E4F4C4F 47592020 - 8 4 1 7 K p 1 - 33 x 20383431 37202020 20004B00 00000200 70319C - Record# : 000003 - Line: 588 Paragraph: FLAT-RECORD - Line: 590 MOVE - Line: 591 MOVE - Line: 592 MOVE - Line: 593 MOVE - Line: 594 MOVE - Line: 595 MOVE - Line: 596 IF - Line: 599 MOVE - Line: 600 WRITE - WRITE FLATFILE Status: 00 - Record : D E L 0 0 0 0 0 D E L T A L U G G A G E R E P A I R S - 1 x 44454C30 30303030 44454C54 41204C55 47474147 45205245 50414952 53202020 - 8 4 7 0 - p 1 - 33 x 20383437 30202020 20002D00 00000200 70319C - Record# : 000004 - Line: 588 Paragraph: FLAT-RECORD - Line: 590 MOVE - Line: 591 MOVE - Line: 592 MOVE - Line: 593 MOVE - Line: 594 MOVE - Line: 595 MOVE - Line: 596 IF - Line: 597 MOVE - Line: 600 WRITE - WRITE FLATFILE Status: 00 - Record : E P S 0 0 0 0 0 E P S I L O N E Q U I P M E N T S U P P L Y - 1 x 45505330 30303030 45505349 4C4F4E20 45515549 504D454E 54205355 50504C59 - 8 4 1 7 Z p 1 - 33 x 20383431 37202020 20005A00 00000200 70319C - Record# : 000005 - Line: 580 CLOSE - CLOSE FLATFILE Status: 00 - Line: 581 OPEN - OPEN INPUT FLATFILE -> 'RELFIX' Status: 00 - Line: 582 MOVE - Line: 583 READ - READ FLATFILE Status: 00 - Record : G A M 0 0 0 0 0 G A M M A X - R A Y T E C H N O L O G Y - 1 x 47414D30 30303030 47414D4D 4120582D 52415920 54454348 4E4F4C4F 47592020 - 8 4 1 7 K p 1 - 33 x 20383431 37202020 20004B00 00000200 70319C - Record# : 000003 - Line: 584 MOVE - Line: 585 READ - READ FLATFILE Status: 23 - Record# : 000999 - Line: 586 CLOSE - CLOSE FLATFILE Status: 00 - Line: 333 STOP RUN -]) -# " <-- comment for fixing syntax highlighting - -# hack for not checking Status 02 as this isn't returned by all -# ISAM implementations - -AT_CHECK([sed -e 's/WRITE TSPFILE Status: 02/WRITE TSPFILE Status: 00/g' \ -reference > references], [0], [], []) -AT_CHECK([sed -e 's/WRITE TSPFILE Status: 02/WRITE TSPFILE Status: 00/g' \ --e 's/'"OPEN OUTPUT TSPFILE -> 'testisam' Status: 05"'/'"OPEN OUTPUT TSPFILE -> 'testisam' Status: 00"'/g' \ -trace.txt > traces.txt], [0], [], []) - -AT_CHECK([gcdiff references traces.txt], [0], [], []) - -AT_CLEANUP - - -AT_SETUP([trace feature with indexed EXTFH]) -AT_KEYWORDS([runfile]) - -AT_SKIP_IF([test "$COB_HAS_ISAM" = "no"]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - - ENVIRONMENT DIVISION. - CONFIGURATION SECTION. - - INPUT-OUTPUT SECTION. - FILE-CONTROL. - SELECT OPTIONAL TSPFILE - ASSIGN TO "testisam" - ORGANIZATION INDEXED ACCESS DYNAMIC - RECORD KEY IS CM-CUST-NUM - ALTERNATE RECORD KEY IS CM-TELEPHONE WITH DUPLICATES - ALTERNATE RECORD KEY IS CM-DISK WITH DUPLICATES - FILE STATUS IS CUST-STAT. - - SELECT TSTFILE - ASSIGN TO "testisam" - ORGANIZATION INDEXED ACCESS DYNAMIC - RECORD KEY IS TS-CUST-NUM - ALTERNATE RECORD KEY IS TS-TELEPHONE WITH DUPLICATES - ALTERNATE RECORD KEY IS TS-DISK WITH DUPLICATES - FILE STATUS IS CUST-STAT. - - SELECT FLATFILE - ASSIGN EXTERNAL RELFIX - ORGANIZATION RELATIVE - ACCESS IS RANDOM RELATIVE KEY IS REC-NUM - FILE STATUS IS CUST-STAT. - - DATA DIVISION. - FILE SECTION. - FD TSPFILE - BLOCK CONTAINS 5 RECORDS. - - 01 TSPFL-RECORD. - 05 TSPFL-REC. - 10 CM-CUST-NUM. - 15 CM-CUST-PRE PICTURE X(3). - 15 CM-CUST-NNN PICTURE X(5). - 10 CM-STATUS PICTURE X. - 10 CM-COMPANY PICTURE X(25). - 10 CM-ADDRESS-1 PICTURE X(25). - 10 CM-ADDRESS-2 PICTURE X(25). - 10 CM-ADDRESS-3 PICTURE X(25). - 10 CM-TELEPHONE PICTURE 9(10). - 10 CM-DP-MGR PICTURE X(25). - 10 CM-MACHINE PICTURE X(8). - 10 CM-MEMORY PICTURE X(4). - 10 CM-DISK PICTURE X(8). - 10 CM-TAPE PICTURE X(8). - 10 CM-NO-TERMINALS PICTURE 9(5). - - FD TSTFILE - BLOCK CONTAINS 5 RECORDS. - - 01 TSTFL-RECORD. - 05 TSTFL-REC. - 10 TS-CUST-NUM PICTURE X(8). - 10 TS-STATUS PICTURE X. - 10 TS-COMPANY PICTURE X(25). - 10 TS-ADDRESS-1 PICTURE X(25). - 10 TS-ADDRESS-2 PICTURE X(25). - 10 TS-ADDRESS-3 PICTURE X(25). - 10 TS-TELEPHONE PICTURE 9(10). - 10 TS-DP-MGR PICTURE X(25). - 10 TS-MACHINE PICTURE X(8). - 10 TS-MEMORY PICTURE X(4). - 10 TS-DISK PICTURE X(8). - 10 TS-TAPE PICTURE X(8). - - FD FLATFILE - BLOCK CONTAINS 5 RECORDS. - - 01 TSP2-RECORD. - 10 C2-CUST-NUM PICTURE X(8). - 10 C2-COMPANY PICTURE X(25). - 10 C2-DISK PICTURE X(8). - 10 C2-NO-TERMINALS PICTURE 9(4) COMP-4. - 10 C2-PK-DATE PICTURE S9(14) COMP-3. - - WORKING-STORAGE SECTION. - - 01 CUST-STAT. - 05 FILLER PICTURE XX. - 77 MAX-SUB VALUE 16 PICTURE 9(5) COMP SYNC. - 77 CALL-NUM VALUE 00 PICTURE 99. - - 01 TEST-DATA. - - 02 DATA-CUST-NUM-TBL. - - 05 FILLER PIC X(8) VALUE "ALP00000". - 05 FILLER PIC X(8) VALUE "BET00000". - 05 FILLER PIC X(8) VALUE "GAM00000". - 05 FILLER PIC X(8) VALUE "DEL00000". - 05 FILLER PIC X(8) VALUE "EPS00000". - 05 FILLER PIC X(8) VALUE "FOR00000". - 05 FILLER PIC X(8) VALUE "GIB00000". - 05 FILLER PIC X(8) VALUE "H&J00000". - 05 FILLER PIC X(8) VALUE "INC00000". - 05 FILLER PIC X(8) VALUE "JOH00000". - 05 FILLER PIC X(8) VALUE "KON00000". - 05 FILLER PIC X(8) VALUE "LEW00000". - 05 FILLER PIC X(8) VALUE "MOR00000". - 05 FILLER PIC X(8) VALUE "NEW00000". - 05 FILLER PIC X(8) VALUE "OLD00000". - 05 FILLER PIC X(8) VALUE "PRE00000". - - 02 DATA-CUST-NUM REDEFINES DATA-CUST-NUM-TBL - PIC X(8) OCCURS 16. - 02 DATA-COMPANY-TBL. - - 05 FILLER PIC X(25) VALUE "ALPHA ELECTRICAL CO. LTD.". - 05 FILLER PIC X(25) VALUE "BETA SHOE MFG. INC. ". - 05 FILLER PIC X(25) VALUE "GAMMA X-RAY TECHNOLOGY ". - 05 FILLER PIC X(25) VALUE "DELTA LUGGAGE REPAIRS ". - 05 FILLER PIC X(25) VALUE "EPSILON EQUIPMENT SUPPLY ". - 05 FILLER PIC X(25) VALUE "FORTUNE COOKIE COMPANY ". - 05 FILLER PIC X(25) VALUE "GIBRALTER LIFE INSURANCE ". - 05 FILLER PIC X(25) VALUE "H & J PLUMBING SUPPLIES ". - 05 FILLER PIC X(25) VALUE "INCREMENTAL BACKUP CORP. ". - 05 FILLER PIC X(25) VALUE "JOHNSON BOATING SUPPLIES ". - 05 FILLER PIC X(25) VALUE "KONFLAB PLASTIC PRODUCTS.". - 05 FILLER PIC X(25) VALUE "LEWISTON GRAPHICS LTD. ". - 05 FILLER PIC X(25) VALUE "MORNINGSIDE CARPENTRY. ". - 05 FILLER PIC X(25) VALUE "NEW WAVE SURF SHOPS INC. ". - 05 FILLER PIC X(25) VALUE "OLD TYME PIZZA MFG. CO. ". - 05 FILLER PIC X(25) VALUE "PRESTIGE OFFICE FURNITURE". - - 02 DATA-COMPANY REDEFINES DATA-COMPANY-TBL - PIC X(25) OCCURS 16. - 02 DATA-ADDRESS-1-TBL. - - 05 FILLER PIC X(25) VALUE "123 MAIN STREET ". - 05 FILLER PIC X(25) VALUE "1090 2ND AVE. WEST ". - 05 FILLER PIC X(25) VALUE "1401 JEFFERSON BLVD. ". - 05 FILLER PIC X(25) VALUE "1620 ARIZONA WAY ". - 05 FILLER PIC X(25) VALUE "1184 EAST FIRST STREET ". - 05 FILLER PIC X(25) VALUE "114 JOHN F. KENNEDY AVE. ". - 05 FILLER PIC X(25) VALUE "650 LIBERTY CRESCENT ". - 05 FILLER PIC X(25) VALUE "77 SUNSET BLVD. ". - 05 FILLER PIC X(25) VALUE "10908 SANTA MONICA BLVD. ". - 05 FILLER PIC X(25) VALUE "1134 PARIS ROAD ". - 05 FILLER PIC X(25) VALUE "808 NORTHWEST MAIN ST. ". - 05 FILLER PIC X(25) VALUE "9904 QUEEN STREET ". - 05 FILLER PIC X(25) VALUE "1709 DUNDAS CRESCENT W. ". - 05 FILLER PIC X(25) VALUE "3240 MARIS AVENUE ". - 05 FILLER PIC X(25) VALUE "1705 WISCONSIN ROAD ". - 05 FILLER PIC X(25) VALUE "114A MAPLE GROVE ". - - 02 DATA-ADDRESS-1 REDEFINES DATA-ADDRESS-1-TBL - PIC X(25) OCCURS 16. - 02 DATA-ADDRESS-2-TBL. - - 05 FILLER PIC X(10) VALUE "NEW YORK ". - 05 FILLER PIC X(10) VALUE "ATLANTA ". - 05 FILLER PIC X(10) VALUE "WASHINGTON". - 05 FILLER PIC X(10) VALUE "TORONTO ". - 05 FILLER PIC X(10) VALUE "CALGARY ". - 05 FILLER PIC X(10) VALUE "SAN DIEGO ". - 05 FILLER PIC X(10) VALUE "LOS RIOS ". - 05 FILLER PIC X(10) VALUE "MADISON ". - 05 FILLER PIC X(10) VALUE "WILBUR ". - 05 FILLER PIC X(10) VALUE "TOPEKA ". - 05 FILLER PIC X(10) VALUE "SEATTLE ". - 05 FILLER PIC X(10) VALUE "NEW JERSEY". - 05 FILLER PIC X(10) VALUE "FORT WAYNE". - 05 FILLER PIC X(10) VALUE "COLUMBUS ". - 05 FILLER PIC X(10) VALUE "RICHMOND ". - 05 FILLER PIC X(10) VALUE "WHITEPLAIN". - - 02 DATA-ADDRESS-2 REDEFINES DATA-ADDRESS-2-TBL - PIC X(10) OCCURS 16. - 02 DATA-ADDRESS-3-TBL. - - 05 FILLER PIC X(10) VALUE "N.Y. ". - 05 FILLER PIC X(10) VALUE "GEORGIA ". - 05 FILLER PIC X(10) VALUE "D.C. ". - 05 FILLER PIC X(10) VALUE "CANADA ". - 05 FILLER PIC X(10) VALUE "CANADA ". - 05 FILLER PIC X(10) VALUE "CALIFORNIA". - 05 FILLER PIC X(10) VALUE "NEW MEXICO". - 05 FILLER PIC X(10) VALUE "WISCONSIN ". - 05 FILLER PIC X(10) VALUE "DELAWARE ". - 05 FILLER PIC X(10) VALUE "KANSAS ". - 05 FILLER PIC X(10) VALUE "WASHINGTON". - 05 FILLER PIC X(10) VALUE "N.J. ". - 05 FILLER PIC X(10) VALUE "COLORADO ". - 05 FILLER PIC X(10) VALUE "OHIO ". - 05 FILLER PIC X(10) VALUE "VIRGINIA ". - 05 FILLER PIC X(10) VALUE "N.Y. ". - - 02 DATA-ADDRESS-3 REDEFINES DATA-ADDRESS-3-TBL - PIC X(10) OCCURS 16. - 02 DATA-TELEPHONE-TBL. - - 05 FILLER PIC 9(10) VALUE 3131234432. - 05 FILLER PIC 9(10) VALUE 4082938498. - 05 FILLER PIC 9(10) VALUE 8372487274. - 05 FILLER PIC 9(10) VALUE 4169898509. - 05 FILLER PIC 9(10) VALUE 5292398745. - 05 FILLER PIC 9(10) VALUE 8009329492. - 05 FILLER PIC 9(10) VALUE 6456445643. - 05 FILLER PIC 9(10) VALUE 6546456333. - 05 FILLER PIC 9(10) VALUE 3455445444. - 05 FILLER PIC 9(10) VALUE 6456445643. - 05 FILLER PIC 9(10) VALUE 7456434355. - 05 FILLER PIC 9(10) VALUE 6554456433. - 05 FILLER PIC 9(10) VALUE 4169898509. - 05 FILLER PIC 9(10) VALUE 7534587453. - 05 FILLER PIC 9(10) VALUE 8787458374. - 05 FILLER PIC 9(10) VALUE 4169898509. - - 02 DATA-TELEPHONE REDEFINES DATA-TELEPHONE-TBL - PIC 9(10) OCCURS 16. - 02 DATA-DP-MGR-TBL. - - 05 FILLER PIC X(20) VALUE "MR. DAVE HARRIS ". - 05 FILLER PIC X(20) VALUE "MS. JANICE SILCOX ". - 05 FILLER PIC X(20) VALUE "MR. ALLAN JONES ". - 05 FILLER PIC X(20) VALUE "MR. PETER MACKAY ". - 05 FILLER PIC X(20) VALUE "MRS. DONNA BREWER ". - 05 FILLER PIC X(20) VALUE "MR. MICHAEL SMYTHE ". - 05 FILLER PIC X(20) VALUE "MR. D.A. MORRISON ". - 05 FILLER PIC X(20) VALUE "MR. BRIAN PATTERSON ". - 05 FILLER PIC X(20) VALUE "MR. DARRYL TOWNSEND ". - 05 FILLER PIC X(20) VALUE "MS. VALERIE HARPER ". - 05 FILLER PIC X(20) VALUE "MR. FRED MILLER ". - 05 FILLER PIC X(20) VALUE "MR. DONALD FISCHER ". - 05 FILLER PIC X(20) VALUE "MR. STEVEN YOURDIN ". - 05 FILLER PIC X(20) VALUE "MS. Goldie Hawn ". - 05 FILLER PIC X(20) VALUE "MS. ALICE WINSTON ". - 05 FILLER PIC X(20) VALUE "MR. THOMAS JEFFERSON". - - 02 DATA-DP-MGR REDEFINES DATA-DP-MGR-TBL - PIC X(20) OCCURS 16. - 02 DATA-MACHINE-TBL. - - 05 FILLER PIC X(8) VALUE "UNI-9030". - 05 FILLER PIC X(8) VALUE "UNI-9040". - 05 FILLER PIC X(8) VALUE "UNI-80/3". - 05 FILLER PIC X(8) VALUE "UNI-80/5". - 05 FILLER PIC X(8) VALUE "UNI-80/6". - 05 FILLER PIC X(8) VALUE "UNI-80/6". - 05 FILLER PIC X(8) VALUE "UNI-80/6". - 05 FILLER PIC X(8) VALUE "UNI-80/8". - 05 FILLER PIC X(8) VALUE "UNI-80/8". - 05 FILLER PIC X(8) VALUE "UNI-80/8". - 05 FILLER PIC X(8) VALUE "UNI-80/8". - 05 FILLER PIC X(8) VALUE "UNI-80/8". - 05 FILLER PIC X(8) VALUE "UNI-80/8". - 05 FILLER PIC X(8) VALUE "UNI-80/8". - 05 FILLER PIC X(8) VALUE "UNI-9040". - 05 FILLER PIC X(8) VALUE "UNI-9040". - - 02 DATA-MACHINE REDEFINES DATA-MACHINE-TBL - PIC X(8) OCCURS 16. - 02 DATA-NO-TERMINALS-TBL. - - 05 FILLER PIC 9(3) COMP-3 VALUE 85. - 05 FILLER PIC 9(3) COMP-3 VALUE 34. - 05 FILLER PIC 9(3) COMP-3 VALUE 75. - 05 FILLER PIC 9(3) COMP-3 VALUE 45. - 05 FILLER PIC 9(3) COMP-3 VALUE 90. - 05 FILLER PIC 9(3) COMP-3 VALUE 107. - 05 FILLER PIC 9(3) COMP-3 VALUE 67. - 05 FILLER PIC 9(3) COMP-3 VALUE 32. - 05 FILLER PIC 9(3) COMP-3 VALUE 16. - 05 FILLER PIC 9(3) COMP-3 VALUE 34. - 05 FILLER PIC 9(3) COMP-3 VALUE 128. - 05 FILLER PIC 9(3) COMP-3 VALUE 64. - 05 FILLER PIC 9(3) COMP-3 VALUE 110. - 05 FILLER PIC 9(3) COMP-3 VALUE 324. - 05 FILLER PIC 9(3) COMP-3 VALUE 124. - 05 FILLER PIC 9(3) COMP-3 VALUE 86. - - 02 DATA-NO-TERMINALS REDEFINES DATA-NO-TERMINALS-TBL - PIC 9(3) COMP-3 OCCURS 16. - - 01 WORK-AREA. - 05 REC-NUM PICTURE 9(6) VALUE 0. - 05 REC-MAX PICTURE 9(6) VALUE 10. - 05 SUB PICTURE 9(4) COMP SYNC. - 88 ODD-RECORD VALUE 1 3 5 7 9 10 11. - - 05 TSPFL-KEY PICTURE X(8). - - PROCEDURE DIVISION. - - MAINFILE. - OPEN OUTPUT TSPFILE - CLOSE TSPFILE. - - OPEN I-O TSPFILE - MOVE '99' TO CUST-STAT - READ TSPFILE NEXT RECORD WITH NO LOCK - IF CUST-STAT NOT = "10" - DISPLAY "Error " CUST-STAT " on read of empty file" - UPON CONSOLE - STOP RUN - END-IF. - MOVE LOW-VALUES TO TSPFL-RECORD. - START TSPFILE KEY GREATER THAN CM-CUST-NUM - IF CUST-STAT NOT = "23" - DISPLAY "Error " CUST-STAT " starting empty file" - UPON CONSOLE - STOP RUN - END-IF. - READ TSPFILE NEXT RECORD WITH NO LOCK - IF CUST-STAT NOT = "46" - DISPLAY "Error " CUST-STAT " start/read of empty file" - UPON CONSOLE - STOP RUN - END-IF. - DISPLAY "OK: Operations on empty file" - CLOSE TSPFILE. - - PERFORM LOADFILE. - PERFORM LISTFILE. - OPEN INPUT TSTFILE - IF CUST-STAT NOT = "00" - DISPLAY "Expected ERROR " CUST-STAT - " opening TSTFILE, Record size different" - UPON CONSOLE - ELSE - DISPLAY "Un-Expected open TSTFILE, Record size different" - UPON CONSOLE - CLOSE TSTFILE - END-IF. - PERFORM LOADFLAT. - STOP RUN. - - LOADFILE. - DISPLAY "Loading sample data file." - UPON CONSOLE. - - OPEN OUTPUT TSPFILE - IF NOT (CUST-STAT = "00" or "05") *> the file may exist - DISPLAY "Error " CUST-STAT - " opening 'testisam' file" UPON CONSOLE - STOP RUN - END-IF. - - PERFORM 1000-LOAD-RECORD - VARYING SUB FROM 1 BY 1 - UNTIL SUB > MAX-SUB. - - DISPLAY "Sample data file load complete." - UPON CONSOLE. - CLOSE TSPFILE. - - *---------------------------------------------------------------* - * LOAD A RECORD FROM DATA TABLES * - *---------------------------------------------------------------* - - 1000-LOAD-RECORD. - - MOVE SPACES TO TSPFL-RECORD. - MOVE DATA-CUST-NUM (SUB) TO CM-CUST-NUM. - MOVE CM-CUST-NUM TO TSPFL-KEY. - MOVE DATA-COMPANY (SUB) TO CM-COMPANY. - MOVE DATA-ADDRESS-1 (SUB) TO CM-ADDRESS-1. - MOVE DATA-ADDRESS-2 (SUB) TO CM-ADDRESS-2. - MOVE DATA-ADDRESS-3 (SUB) TO CM-ADDRESS-3. - MOVE DATA-TELEPHONE (SUB) TO CM-TELEPHONE. - MOVE DATA-DP-MGR (SUB) TO CM-DP-MGR. - MOVE DATA-MACHINE (SUB) TO CM-MACHINE. - MOVE DATA-NO-TERMINALS (SUB) TO CM-NO-TERMINALS. - - IF ODD-RECORD - MOVE "8417" TO CM-DISK - MOVE "1600 BPI" TO CM-TAPE - MOVE "1MEG" TO CM-MEMORY - ELSE - MOVE "8470" TO CM-DISK - MOVE "6250 BPI" TO CM-TAPE - MOVE "3MEG" TO CM-MEMORY. - - WRITE TSPFL-RECORD. - IF CUST-STAT NOT = "00" - AND CUST-STAT NOT = "02" - DISPLAY "Load - Key: " TSPFL-KEY ", Status: " CUST-STAT - UPON CONSOLE. - - LISTFILE. - DISPLAY "LIST SAMPLE FILE" UPON CONSOLE. - OPEN INPUT TSTFILE - MOVE SPACES TO TSTFL-RECORD. - MOVE "PRE00000" TO CM-CUST-NUM. - START TSTFILE KEY GREATER THAN OR EQUAL TO TS-CUST-NUM - READ TSTFILE NEXT RECORD - READ TSTFILE NEXT RECORD - CLOSE TSTFILE. - - MOVE ZERO TO REC-NUM - OPEN INPUT TSPFILE - IF CUST-STAT NOT = "00" - DISPLAY "ERROR " CUST-STAT " OPENING INPUT FILE" - UPON CONSOLE - STOP RUN - END-IF. - MOVE SPACES TO TSPFL-RECORD. - MOVE "PRE00000" TO CM-CUST-NUM. - START TSPFILE KEY GREATER THAN OR EQUAL TO CM-CUST-NUM - READ TSPFILE NEXT RECORD - READ TSPFILE NEXT RECORD - - MOVE SPACES TO TSPFL-RECORD. - MOVE "DEL00000" TO CM-CUST-NUM. - START TSPFILE KEY GREATER THAN CM-CUST-NUM - IF CUST-STAT NOT = "00" - DISPLAY "Error " CUST-STAT " starting file" - UPON CONSOLE - STOP RUN - END-IF. - READ TSPFILE NEXT RECORD WITH NO LOCK - IF CUST-STAT NOT = "00" - DISPLAY "Error " CUST-STAT " on 1st read of file" - UPON CONSOLE - STOP RUN - END-IF. - PERFORM UNTIL CUST-STAT NOT = "00" - OR REC-NUM > REC-MAX - DISPLAY "Key: " CM-CUST-NUM " is " CM-COMPANY - " Disk=" CM-DISK "." - UPON CONSOLE - ADD 1 TO CALL-NUM - READ TSPFILE NEXT RECORD - AT END - MOVE "99" TO CUST-STAT - END-READ - ADD 1 TO REC-NUM - END-PERFORM - IF CUST-STAT = "99" - DISPLAY "Hit End of File: " CALL-NUM UPON CONSOLE - ELSE - DISPLAY "Stop read after: " CALL-NUM UPON CONSOLE - END-IF. - - DISPLAY "LIST SAMPLE FILE DESCENDING" UPON CONSOLE. - MOVE ZERO TO REC-NUM - START TSPFILE KEY LESS THAN CM-CUST-NUM - IF CUST-STAT NOT = "00" - DISPLAY "Error " CUST-STAT " starting file" - UPON CONSOLE - STOP RUN - END-IF. - READ TSPFILE PREVIOUS RECORD WITH NO LOCK - IF CUST-STAT NOT = "00" - DISPLAY "Error " CUST-STAT " on 1st read of file" - UPON CONSOLE - STOP RUN - END-IF. - PERFORM UNTIL CUST-STAT NOT = "00" - OR REC-NUM > REC-MAX - DISPLAY "Key: " CM-CUST-NUM " is " CM-COMPANY - " Disk=" CM-DISK "." - UPON CONSOLE - READ TSPFILE PREVIOUS RECORD - AT END - MOVE "99" TO CUST-STAT - END-READ - ADD 1 TO REC-NUM - END-PERFORM. - - CLOSE TSPFILE. - - OPEN I-O TSPFILE. - MOVE SPACES TO TSPFL-RECORD. - MOVE DATA-CUST-NUM (2) TO CM-CUST-NUM. - MOVE 'X' TO CM-CUST-NUM (5:1). - READ TSPFILE KEY IS CM-CUST-NUM - IF CUST-STAT NOT = "23" - DISPLAY "Error " CUST-STAT " instead of 23." - UPON CONSOLE - END-IF. - MOVE DATA-CUST-NUM (2) TO CM-CUST-NUM. - MOVE DATA-COMPANY (2) TO CM-COMPANY. - READ TSPFILE KEY IS CM-CUST-NUM - IF CUST-STAT NOT = "00" - DISPLAY "Error " CUST-STAT " on primary read ." - UPON CONSOLE - ELSE - DISPLAY "Got: " CM-CUST-NUM " is " CM-COMPANY - " Disk=" CM-DISK "." - UPON CONSOLE - END-IF. - READ TSPFILE NEXT RECORD - IF CUST-STAT NOT = "00" - DISPLAY "Error " CUST-STAT " on next read" - UPON CONSOLE - ELSE - DISPLAY "Nxt: " CM-CUST-NUM " is " CM-COMPANY - " Disk=" CM-DISK "." - UPON CONSOLE - END-IF. - MOVE DATA-TELEPHONE (7) TO CM-TELEPHONE. - MOVE DATA-MACHINE (7) TO CM-MACHINE. - READ TSPFILE KEY IS CM-TELEPHONE - IF CUST-STAT NOT = "00" - DISPLAY "Error " CUST-STAT " instead of 23" - UPON CONSOLE - ELSE - DISPLAY "Ky2: " CM-CUST-NUM " is " CM-COMPANY - " Mach=" CM-MACHINE "." - UPON CONSOLE - END-IF. - WRITE TSPFL-RECORD - IF CUST-STAT NOT = "22" - DISPLAY "Error " CUST-STAT " instead of 22" - UPON CONSOLE - ELSE - DISPLAY " Write: " CM-CUST-NUM " got 22 as expected" - UPON CONSOLE - END-IF. - MOVE DATA-CUST-NUM (3) TO CM-CUST-NUM. - MOVE DATA-COMPANY (3) TO CM-COMPANY. - READ TSPFILE KEY IS CM-CUST-NUM - DISPLAY " Read: " CM-CUST-NUM " got " - CUST-STAT " as expected " - CM-NO-TERMINALS " terminals" - UPON CONSOLE. - ADD 5 TO CM-NO-TERMINALS - REWRITE TSPFL-RECORD - IF CUST-STAT NOT = "02" - AND CUST-STAT NOT = "00" - DISPLAY "Error " CUST-STAT " instead of 00/02" - UPON CONSOLE - ELSE - - DISPLAY "ReWrite: " CM-CUST-NUM " got 00/02" - " as expected " - CM-NO-TERMINALS " terminals" - UPON CONSOLE - END-IF. - MOVE DATA-CUST-NUM (2) TO CM-CUST-NUM. - MOVE DATA-COMPANY (2) TO CM-COMPANY. - READ TSPFILE KEY IS CM-CUST-NUM - DISPLAY " Read: " CM-CUST-NUM " got " - CUST-STAT " as expected " - CM-NO-TERMINALS " terminals" - UPON CONSOLE. - MOVE DATA-CUST-NUM (3) TO CM-CUST-NUM. - MOVE DATA-COMPANY (3) TO CM-COMPANY. - REWRITE TSPFL-RECORD - IF CUST-STAT NOT = "02" - AND CUST-STAT NOT = "00" - DISPLAY "Error " CUST-STAT " instead of 00/02" - UPON CONSOLE - ELSE - DISPLAY "ReWrite: " CM-CUST-NUM " got 00/02" - " as expected" - UPON CONSOLE - END-IF. - MOVE DATA-CUST-NUM (6) TO CM-CUST-NUM. - MOVE DATA-COMPANY (6) TO CM-COMPANY. - READ TSPFILE KEY IS CM-CUST-NUM - MOVE DATA-TELEPHONE (7) TO CM-TELEPHONE. - MOVE DATA-MACHINE (7) TO CM-MACHINE. - REWRITE TSPFL-RECORD - IF CUST-STAT NOT = "02" - AND CUST-STAT NOT = "00" - DISPLAY "Error " CUST-STAT " instead of 00/02" - UPON CONSOLE - ELSE - DISPLAY "ReWrite: " CM-CUST-NUM " got 00/02" - " as expected" - UPON CONSOLE - END-IF. - DELETE TSPFILE. - CLOSE TSPFILE. - - LOADFLAT. - OPEN OUTPUT FLATFILE. - PERFORM FLAT-RECORD - VARYING SUB FROM 1 BY 1 - UNTIL SUB > MAX-SUB - OR SUB > 5. - CLOSE FLATFILE. - OPEN INPUT FLATFILE. - MOVE 3 TO REC-NUM - READ FLATFILE - MOVE 999 TO REC-NUM - READ FLATFILE - CLOSE FLATFILE. - - FLAT-RECORD. - - MOVE SPACES TO TSP2-RECORD. - MOVE SUB TO REC-NUM. - MOVE DATA-CUST-NUM (SUB) TO C2-CUST-NUM. - MOVE DATA-COMPANY (SUB) TO C2-COMPANY. - MOVE DATA-NO-TERMINALS (SUB) TO C2-NO-TERMINALS. - MOVE 20070319 TO C2-PK-DATE. - IF ODD-RECORD - MOVE "8417" TO C2-DISK - ELSE - MOVE "8470" TO C2-DISK. - WRITE TSP2-RECORD. -]) - -AT_DATA([cmod.c], [[ -/****************************************************************************** -* 2017, Ron Norman * -* Source for a Micro Focus COBOL External File Handler. * -* * -* For GnuCOBOL add -fcallfh=TSTFH as a compile option * -* * -* This is a sample module for GnuCOBOL, but it does not do very much * -******************************************************************************/ - -#include -#include -#include -#include - -#ifndef TRUE -#define TRUE 1 -#endif -#ifndef FALSE -#define FALSE 0 -#endif -#define MIN(a,b) (a < b ? a : b) - -static char *txtOpCode(int opCode); - -/************************************************************************* - Replace filename with environment variable value, then open the file - This is required as MF Cobol seems to have pre-read the ENV Variables -*************************************************************************/ -static int -doOpenFile( - unsigned char *opCodep, - FCD3 *fcd, - char *opmsg) -{ - int sts,oldlen,j,k; - char *oldFptr,*env,wrk[64]; - unsigned char svOther; - unsigned int opCode; - - oldFptr = fcd->fnamePtr; /* Save values */ - oldlen = LDCOMPX2(fcd->fnameLen); - fcd->otherFlags &= ~OTH_DOLSREAD; - svOther = fcd->otherFlags; - - return EXTFH( opCodep, fcd ); /* No DD_, so use normal MF File Open */ -} - -/********************************************************* - * TSTFH - External File Handler entry point. -*********************************************************/ -int -TSTFH( unsigned char *opCodep, FCD3 *fcd) -{ - unsigned int opCode; - char *fname; - int sts, ky, j, k; - - if(*opCodep == 0xfa) - opCode = 0xfa00 + opCodep[1]; - else - opCode = opCodep[1]; - - if(fcd->fileOrg == ORG_LINE_SEQ - || fcd->fileOrg == ORG_SEQ - || fcd->fileOrg == ORG_INDEXED - || fcd->fileOrg == ORG_RELATIVE) { - switch (opCode) { - case OP_OPEN_OUTPUT: - case OP_OPEN_IO: - case OP_OPEN_EXTEND: - case OP_OPEN_OUTPUT_NOREWIND: - return doOpenFile( opCodep, fcd, txtOpCode(opCode)); - break; - - case OP_OPEN_INPUT: - case OP_OPEN_INPUT_NOREWIND: - case OP_OPEN_INPUT_REVERSED: - return doOpenFile( opCodep, fcd, txtOpCode(opCode)); - break; - - default: - break; - } - - } - - if(opCode == OP_CLOSE - && (fcd->openMode & OPEN_NOT_OPEN) ) { - return 0; - } - - sts = EXTFH( opCodep, fcd ); - return sts; -} - -static char * /* Return Text name of function */ -txtOpCode(int opCode) -{ - static char tmp[32]; - switch (opCode) { - case OP_OPEN_INPUT: return "OPEN_IN"; - case OP_OPEN_OUTPUT: return "OPEN_OUT"; - case OP_OPEN_IO: return "OPEN_IO"; - case OP_OPEN_EXTEND: return "OPEN_EXT"; - case OP_OPEN_INPUT_NOREWIND: return "OPEN_IN_NOREW"; - case OP_OPEN_OUTPUT_NOREWIND: return "OPEN_OUT_NOREW"; - case OP_OPEN_INPUT_REVERSED: return "OPEN_IN_REV"; - case OP_CLOSE: return "CLOSE"; - case OP_CLOSE_LOCK: return "CLOSE_LOCK"; - case OP_CLOSE_NOREWIND: return "CLOSE_NORED"; - case OP_CLOSE_REEL: return "CLOSE_REEL"; - case OP_CLOSE_REMOVE: return "CLOSE_REMOVE"; - case OP_CLOSE_NO_REWIND: return "CLOSE_NO_REW"; - case OP_START_EQ: return "START_EQ"; - case OP_START_EQ_ANY: return "START_EQ_ANY"; - case OP_START_GT: return "START_GT"; - case OP_START_GE: return "START_GE"; - case OP_START_LT: return "START_LT"; - case OP_START_LE: return "START_LE"; - case OP_READ_SEQ_NO_LOCK: return "READ_SEQ_NO_LK"; - case OP_READ_SEQ: return "READ_SEQ"; - case OP_READ_SEQ_LOCK: return "READ_SEQ_LK"; - case OP_READ_SEQ_KEPT_LOCK: return "READ_SEQ_KEPT_LK"; - case OP_READ_PREV_NO_LOCK: return "READ_PREV_NO_LK"; - case OP_READ_PREV: return "READ_PREV"; - case OP_READ_PREV_LOCK: return "READ_PREV_LK"; - case OP_READ_PREV_KEPT_LOCK: return "READ_PREV_KEPT_LK"; - case OP_READ_RAN: return "READ_RAN"; - case OP_READ_RAN_NO_LOCK: return "READ_RAN_NO_LK"; - case OP_READ_RAN_KEPT_LOCK: return "READ_RAN_KEPT_LK"; - case OP_READ_RAN_LOCK: return "READ_RAN_LK"; - case OP_READ_DIR: return "READ_DIR"; - case OP_READ_DIR_NO_LOCK: return "READ_DIR_NO_LK"; - case OP_READ_DIR_KEPT_LOCK: return "READ_DIR_KEPT_LK"; - case OP_READ_DIR_LOCK: return "READ_DIR_LK"; - case OP_READ_POSITION: return "READ_POSITION"; - case OP_WRITE: return "WRITE"; - case OP_REWRITE: return "REWRITE"; - case OP_DELETE: return "DELETE"; - case OP_DELETE_FILE: return "DELETE_FILE"; - case OP_UNLOCK: return "UNLOCK"; - case OP_ROLLBACK: return "ROLLBACK"; - case OP_COMMIT: return "COMMIT"; - case OP_WRITE_BEFORE: return "WRITE_BEFORE"; - case OP_WRITE_BEFORE_TAB: return "WRITE_BEFORE_TAB"; - case OP_WRITE_BEFORE_PAGE: return "WRITE_BEFORE_PAGE"; - case OP_WRITE_AFTER: return "WRITE_AFTER"; - case OP_WRITE_AFTER_TAB: return "WRITE_AFTER_TAB"; - case OP_WRITE_AFTER_PAGE: return "WRITE_AFTER_PAGE"; - } - sprintf(tmp,"Func 0x%02X:",opCode); - return tmp; -} -]]) - -AT_CHECK([$COMPILE -fcallfh=TSTFH -ftraceall prog.cob cmod.c], [0], [], []) - -# first run without runtime tracing -AT_CHECK([export COB_TRACE_FILE=trace.txt -export COB_TRACE_IO=Y -export COB_SET_TRACE=Y -export COB_TRACE_FORMAT=%L%S -export IO_TSPFILE=trace -export IO_TSTFILE=no-trace -./prog], [0], -[OK: Operations on empty file -Loading sample data file. -Sample data file load complete. -LIST SAMPLE FILE -Key: EPS00000 is EPSILON EQUIPMENT SUPPLY Disk=8417 . -Key: FOR00000 is FORTUNE COOKIE COMPANY Disk=8470 . -Key: GAM00000 is GAMMA X-RAY TECHNOLOGY Disk=8417 . -Key: GIB00000 is GIBRALTER LIFE INSURANCE Disk=8417 . -Key: H&J00000 is H & J PLUMBING SUPPLIES Disk=8470 . -Key: INC00000 is INCREMENTAL BACKUP CORP. Disk=8417 . -Key: JOH00000 is JOHNSON BOATING SUPPLIES Disk=8417 . -Key: KON00000 is KONFLAB PLASTIC PRODUCTS. Disk=8417 . -Key: LEW00000 is LEWISTON GRAPHICS LTD. Disk=8470 . -Key: MOR00000 is MORNINGSIDE CARPENTRY. Disk=8470 . -Key: NEW00000 is NEW WAVE SURF SHOPS INC. Disk=8470 . -Stop read after: 11 -LIST SAMPLE FILE DESCENDING -Key: NEW00000 is NEW WAVE SURF SHOPS INC. Disk=8470 . -Key: MOR00000 is MORNINGSIDE CARPENTRY. Disk=8470 . -Key: LEW00000 is LEWISTON GRAPHICS LTD. Disk=8470 . -Key: KON00000 is KONFLAB PLASTIC PRODUCTS. Disk=8417 . -Key: JOH00000 is JOHNSON BOATING SUPPLIES Disk=8417 . -Key: INC00000 is INCREMENTAL BACKUP CORP. Disk=8417 . -Key: H&J00000 is H & J PLUMBING SUPPLIES Disk=8470 . -Key: GIB00000 is GIBRALTER LIFE INSURANCE Disk=8417 . -Key: GAM00000 is GAMMA X-RAY TECHNOLOGY Disk=8417 . -Key: FOR00000 is FORTUNE COOKIE COMPANY Disk=8470 . -Key: EPS00000 is EPSILON EQUIPMENT SUPPLY Disk=8417 . -Got: BET00000 is BETA SHOE MFG. INC. Disk=8470 . -Nxt: DEL00000 is DELTA LUGGAGE REPAIRS Disk=8470 . -Ky2: GIB00000 is GIBRALTER LIFE INSURANCE Mach=UNI-80/6. - Write: GIB00000 got 22 as expected - Read: GAM00000 got 00 as expected 00075 terminals -ReWrite: GAM00000 got 00/02 as expected 00080 terminals - Read: BET00000 got 00 as expected 00034 terminals -ReWrite: GAM00000 got 00/02 as expected -ReWrite: FOR00000 got 00/02 as expected -Expected ERROR 39 opening TSTFILE, Record size different -], []) - -# not merged yet: -#export COB_TRACE_IO=Y -#export IO_TSPFILE=trace -#export IO_TSTFILE=no-trace - -AT_CHECK([COB_TRACE_FILE=trace.txt \ -COB_SET_TRACE=Y \ -COB_TRACE_FORMAT=" Line: %L %S" \ -$COBCRUN_DIRECT ./prog], [0], -[OK: Operations on empty file -Loading sample data file. -Sample data file load complete. -LIST SAMPLE FILE -Key: EPS00000 is EPSILON EQUIPMENT SUPPLY Disk=8417 . -Key: FOR00000 is FORTUNE COOKIE COMPANY Disk=8470 . -Key: GAM00000 is GAMMA X-RAY TECHNOLOGY Disk=8417 . -Key: GIB00000 is GIBRALTER LIFE INSURANCE Disk=8417 . -Key: H&J00000 is H & J PLUMBING SUPPLIES Disk=8470 . -Key: INC00000 is INCREMENTAL BACKUP CORP. Disk=8417 . -Key: JOH00000 is JOHNSON BOATING SUPPLIES Disk=8417 . -Key: KON00000 is KONFLAB PLASTIC PRODUCTS. Disk=8417 . -Key: LEW00000 is LEWISTON GRAPHICS LTD. Disk=8470 . -Key: MOR00000 is MORNINGSIDE CARPENTRY. Disk=8470 . -Key: NEW00000 is NEW WAVE SURF SHOPS INC. Disk=8470 . -Stop read after: 11 -LIST SAMPLE FILE DESCENDING -Key: NEW00000 is NEW WAVE SURF SHOPS INC. Disk=8470 . -Key: MOR00000 is MORNINGSIDE CARPENTRY. Disk=8470 . -Key: LEW00000 is LEWISTON GRAPHICS LTD. Disk=8470 . -Key: KON00000 is KONFLAB PLASTIC PRODUCTS. Disk=8417 . -Key: JOH00000 is JOHNSON BOATING SUPPLIES Disk=8417 . -Key: INC00000 is INCREMENTAL BACKUP CORP. Disk=8417 . -Key: H&J00000 is H & J PLUMBING SUPPLIES Disk=8470 . -Key: GIB00000 is GIBRALTER LIFE INSURANCE Disk=8417 . -Key: GAM00000 is GAMMA X-RAY TECHNOLOGY Disk=8417 . -Key: FOR00000 is FORTUNE COOKIE COMPANY Disk=8470 . -Key: EPS00000 is EPSILON EQUIPMENT SUPPLY Disk=8417 . -Got: BET00000 is BETA SHOE MFG. INC. Disk=8470 . -Nxt: DEL00000 is DELTA LUGGAGE REPAIRS Disk=8470 . -Ky2: GIB00000 is GIBRALTER LIFE INSURANCE Mach=UNI-80/6. - Write: GIB00000 got 22 as expected - Read: GAM00000 got 00 as expected 00075 terminals -ReWrite: GAM00000 got 00/02 as expected 00080 terminals - Read: BET00000 got 00 as expected 00034 terminals -ReWrite: GAM00000 got 00/02 as expected -ReWrite: FOR00000 got 00/02 as expected -Expected ERROR 39 opening TSTFILE, Record size different -], []) - - -AT_CAPTURE_FILE(./trace.txt) - -AT_DATA([reference], -[Source: 'prog.cob' -Program-Id: prog - Line: 290 Entry: prog - Line: 292 Paragraph: MAINFILE - Line: 293 OPEN - Line: 294 CLOSE - Line: 296 OPEN - Line: 297 MOVE - Line: 298 READ - Line: 299 IF - Line: 304 MOVE - Line: 305 START - Line: 306 IF - Line: 311 READ - Line: 312 IF - Line: 317 DISPLAY - Line: 318 CLOSE - Line: 320 PERFORM - Line: 335 Paragraph: LOADFILE - Line: 336 DISPLAY - Line: 339 OPEN - Line: 340 IF - Line: 346 PERFORM - Line: 358 Paragraph: 1000-LOAD-RECORD - Line: 360 MOVE - Line: 361 MOVE - Line: 362 MOVE - Line: 363 MOVE - Line: 364 MOVE - Line: 365 MOVE - Line: 366 MOVE - Line: 367 MOVE - Line: 368 MOVE - Line: 369 MOVE - Line: 370 MOVE - Line: 372 IF - Line: 373 MOVE - Line: 374 MOVE - Line: 375 MOVE - Line: 381 WRITE - Line: 382 IF - Line: 358 Paragraph: 1000-LOAD-RECORD - Line: 360 MOVE - Line: 361 MOVE - Line: 362 MOVE - Line: 363 MOVE - Line: 364 MOVE - Line: 365 MOVE - Line: 366 MOVE - Line: 367 MOVE - Line: 368 MOVE - Line: 369 MOVE - Line: 370 MOVE - Line: 372 IF - Line: 377 MOVE - Line: 378 MOVE - Line: 379 MOVE - Line: 381 WRITE - Line: 382 IF - Line: 358 Paragraph: 1000-LOAD-RECORD - Line: 360 MOVE - Line: 361 MOVE - Line: 362 MOVE - Line: 363 MOVE - Line: 364 MOVE - Line: 365 MOVE - Line: 366 MOVE - Line: 367 MOVE - Line: 368 MOVE - Line: 369 MOVE - Line: 370 MOVE - Line: 372 IF - Line: 373 MOVE - Line: 374 MOVE - Line: 375 MOVE - Line: 381 WRITE - Line: 382 IF - Line: 358 Paragraph: 1000-LOAD-RECORD - Line: 360 MOVE - Line: 361 MOVE - Line: 362 MOVE - Line: 363 MOVE - Line: 364 MOVE - Line: 365 MOVE - Line: 366 MOVE - Line: 367 MOVE - Line: 368 MOVE - Line: 369 MOVE - Line: 370 MOVE - Line: 372 IF - Line: 377 MOVE - Line: 378 MOVE - Line: 379 MOVE - Line: 381 WRITE - Line: 382 IF - Line: 358 Paragraph: 1000-LOAD-RECORD - Line: 360 MOVE - Line: 361 MOVE - Line: 362 MOVE - Line: 363 MOVE - Line: 364 MOVE - Line: 365 MOVE - Line: 366 MOVE - Line: 367 MOVE - Line: 368 MOVE - Line: 369 MOVE - Line: 370 MOVE - Line: 372 IF - Line: 373 MOVE - Line: 374 MOVE - Line: 375 MOVE - Line: 381 WRITE - Line: 382 IF - Line: 358 Paragraph: 1000-LOAD-RECORD - Line: 360 MOVE - Line: 361 MOVE - Line: 362 MOVE - Line: 363 MOVE - Line: 364 MOVE - Line: 365 MOVE - Line: 366 MOVE - Line: 367 MOVE - Line: 368 MOVE - Line: 369 MOVE - Line: 370 MOVE - Line: 372 IF - Line: 377 MOVE - Line: 378 MOVE - Line: 379 MOVE - Line: 381 WRITE - Line: 382 IF - Line: 358 Paragraph: 1000-LOAD-RECORD - Line: 360 MOVE - Line: 361 MOVE - Line: 362 MOVE - Line: 363 MOVE - Line: 364 MOVE - Line: 365 MOVE - Line: 366 MOVE - Line: 367 MOVE - Line: 368 MOVE - Line: 369 MOVE - Line: 370 MOVE - Line: 372 IF - Line: 373 MOVE - Line: 374 MOVE - Line: 375 MOVE - Line: 381 WRITE - Line: 382 IF - Line: 358 Paragraph: 1000-LOAD-RECORD - Line: 360 MOVE - Line: 361 MOVE - Line: 362 MOVE - Line: 363 MOVE - Line: 364 MOVE - Line: 365 MOVE - Line: 366 MOVE - Line: 367 MOVE - Line: 368 MOVE - Line: 369 MOVE - Line: 370 MOVE - Line: 372 IF - Line: 377 MOVE - Line: 378 MOVE - Line: 379 MOVE - Line: 381 WRITE - Line: 382 IF - Line: 358 Paragraph: 1000-LOAD-RECORD - Line: 360 MOVE - Line: 361 MOVE - Line: 362 MOVE - Line: 363 MOVE - Line: 364 MOVE - Line: 365 MOVE - Line: 366 MOVE - Line: 367 MOVE - Line: 368 MOVE - Line: 369 MOVE - Line: 370 MOVE - Line: 372 IF - Line: 373 MOVE - Line: 374 MOVE - Line: 375 MOVE - Line: 381 WRITE - Line: 382 IF - Line: 358 Paragraph: 1000-LOAD-RECORD - Line: 360 MOVE - Line: 361 MOVE - Line: 362 MOVE - Line: 363 MOVE - Line: 364 MOVE - Line: 365 MOVE - Line: 366 MOVE - Line: 367 MOVE - Line: 368 MOVE - Line: 369 MOVE - Line: 370 MOVE - Line: 372 IF - Line: 373 MOVE - Line: 374 MOVE - Line: 375 MOVE - Line: 381 WRITE - Line: 382 IF - Line: 358 Paragraph: 1000-LOAD-RECORD - Line: 360 MOVE - Line: 361 MOVE - Line: 362 MOVE - Line: 363 MOVE - Line: 364 MOVE - Line: 365 MOVE - Line: 366 MOVE - Line: 367 MOVE - Line: 368 MOVE - Line: 369 MOVE - Line: 370 MOVE - Line: 372 IF - Line: 373 MOVE - Line: 374 MOVE - Line: 375 MOVE - Line: 381 WRITE - Line: 382 IF - Line: 358 Paragraph: 1000-LOAD-RECORD - Line: 360 MOVE - Line: 361 MOVE - Line: 362 MOVE - Line: 363 MOVE - Line: 364 MOVE - Line: 365 MOVE - Line: 366 MOVE - Line: 367 MOVE - Line: 368 MOVE - Line: 369 MOVE - Line: 370 MOVE - Line: 372 IF - Line: 377 MOVE - Line: 378 MOVE - Line: 379 MOVE - Line: 381 WRITE - Line: 382 IF - Line: 358 Paragraph: 1000-LOAD-RECORD - Line: 360 MOVE - Line: 361 MOVE - Line: 362 MOVE - Line: 363 MOVE - Line: 364 MOVE - Line: 365 MOVE - Line: 366 MOVE - Line: 367 MOVE - Line: 368 MOVE - Line: 369 MOVE - Line: 370 MOVE - Line: 372 IF - Line: 377 MOVE - Line: 378 MOVE - Line: 379 MOVE - Line: 381 WRITE - Line: 382 IF - Line: 358 Paragraph: 1000-LOAD-RECORD - Line: 360 MOVE - Line: 361 MOVE - Line: 362 MOVE - Line: 363 MOVE - Line: 364 MOVE - Line: 365 MOVE - Line: 366 MOVE - Line: 367 MOVE - Line: 368 MOVE - Line: 369 MOVE - Line: 370 MOVE - Line: 372 IF - Line: 377 MOVE - Line: 378 MOVE - Line: 379 MOVE - Line: 381 WRITE - Line: 382 IF - Line: 358 Paragraph: 1000-LOAD-RECORD - Line: 360 MOVE - Line: 361 MOVE - Line: 362 MOVE - Line: 363 MOVE - Line: 364 MOVE - Line: 365 MOVE - Line: 366 MOVE - Line: 367 MOVE - Line: 368 MOVE - Line: 369 MOVE - Line: 370 MOVE - Line: 372 IF - Line: 377 MOVE - Line: 378 MOVE - Line: 379 MOVE - Line: 381 WRITE - Line: 382 IF - Line: 358 Paragraph: 1000-LOAD-RECORD - Line: 360 MOVE - Line: 361 MOVE - Line: 362 MOVE - Line: 363 MOVE - Line: 364 MOVE - Line: 365 MOVE - Line: 366 MOVE - Line: 367 MOVE - Line: 368 MOVE - Line: 369 MOVE - Line: 370 MOVE - Line: 372 IF - Line: 377 MOVE - Line: 378 MOVE - Line: 379 MOVE - Line: 381 WRITE - Line: 382 IF - Line: 350 DISPLAY - Line: 352 CLOSE - Line: 321 PERFORM - Line: 387 Paragraph: LISTFILE - Line: 388 DISPLAY - Line: 389 OPEN - Line: 390 MOVE - Line: 391 MOVE - Line: 392 START - Line: 393 READ - Line: 394 READ - Line: 395 CLOSE - Line: 397 MOVE - Line: 398 OPEN - Line: 399 IF - Line: 404 MOVE - Line: 405 MOVE - Line: 406 START - Line: 407 READ - Line: 408 READ - Line: 410 MOVE - Line: 411 MOVE - Line: 412 START - Line: 413 IF - Line: 418 READ - Line: 419 IF - Line: 424 PERFORM - Line: 426 DISPLAY - Line: 429 ADD - Line: 430 READ - Line: 434 ADD - Line: 426 DISPLAY - Line: 429 ADD - Line: 430 READ - Line: 434 ADD - Line: 426 DISPLAY - Line: 429 ADD - Line: 430 READ - Line: 434 ADD - Line: 426 DISPLAY - Line: 429 ADD - Line: 430 READ - Line: 434 ADD - Line: 426 DISPLAY - Line: 429 ADD - Line: 430 READ - Line: 434 ADD - Line: 426 DISPLAY - Line: 429 ADD - Line: 430 READ - Line: 434 ADD - Line: 426 DISPLAY - Line: 429 ADD - Line: 430 READ - Line: 434 ADD - Line: 426 DISPLAY - Line: 429 ADD - Line: 430 READ - Line: 434 ADD - Line: 426 DISPLAY - Line: 429 ADD - Line: 430 READ - Line: 434 ADD - Line: 426 DISPLAY - Line: 429 ADD - Line: 430 READ - Line: 434 ADD - Line: 426 DISPLAY - Line: 429 ADD - Line: 430 READ - Line: 434 ADD - Line: 436 IF - Line: 439 DISPLAY - Line: 442 DISPLAY - Line: 443 MOVE - Line: 444 START - Line: 445 IF - Line: 450 READ - Line: 451 IF - Line: 456 PERFORM - Line: 458 DISPLAY - Line: 461 READ - Line: 465 ADD - Line: 458 DISPLAY - Line: 461 READ - Line: 465 ADD - Line: 458 DISPLAY - Line: 461 READ - Line: 465 ADD - Line: 458 DISPLAY - Line: 461 READ - Line: 465 ADD - Line: 458 DISPLAY - Line: 461 READ - Line: 465 ADD - Line: 458 DISPLAY - Line: 461 READ - Line: 465 ADD - Line: 458 DISPLAY - Line: 461 READ - Line: 465 ADD - Line: 458 DISPLAY - Line: 461 READ - Line: 465 ADD - Line: 458 DISPLAY - Line: 461 READ - Line: 465 ADD - Line: 458 DISPLAY - Line: 461 READ - Line: 465 ADD - Line: 458 DISPLAY - Line: 461 READ - Line: 465 ADD - Line: 468 CLOSE - Line: 470 OPEN - Line: 471 MOVE - Line: 472 MOVE - Line: 473 MOVE - Line: 474 READ - Line: 475 IF - Line: 479 MOVE - Line: 480 MOVE - Line: 481 READ - Line: 482 IF - Line: 486 DISPLAY - Line: 490 READ - Line: 491 IF - Line: 495 DISPLAY - Line: 499 MOVE - Line: 500 MOVE - Line: 501 READ - Line: 502 IF - Line: 506 DISPLAY - Line: 510 WRITE - Line: 511 IF - Line: 515 DISPLAY - Line: 518 MOVE - Line: 519 MOVE - Line: 520 READ - Line: 521 DISPLAY - Line: 525 ADD - Line: 526 REWRITE - Line: 527 IF - Line: 533 DISPLAY - Line: 538 MOVE - Line: 539 MOVE - Line: 540 READ - Line: 541 DISPLAY - Line: 545 MOVE - Line: 546 MOVE - Line: 547 REWRITE - Line: 548 IF - Line: 553 DISPLAY - Line: 557 MOVE - Line: 558 MOVE - Line: 559 READ - Line: 560 MOVE - Line: 561 MOVE - Line: 562 REWRITE - Line: 563 IF - Line: 568 DISPLAY - Line: 572 DELETE - Line: 573 CLOSE - Line: 322 OPEN - Line: 323 IF - Line: 324 DISPLAY - Line: 332 PERFORM - Line: 575 Paragraph: LOADFLAT - Line: 576 OPEN - Line: 577 PERFORM - Line: 589 Paragraph: FLAT-RECORD - Line: 591 MOVE - Line: 592 MOVE - Line: 593 MOVE - Line: 594 MOVE - Line: 595 MOVE - Line: 596 MOVE - Line: 597 IF - Line: 598 MOVE - Line: 601 WRITE - Line: 589 Paragraph: FLAT-RECORD - Line: 591 MOVE - Line: 592 MOVE - Line: 593 MOVE - Line: 594 MOVE - Line: 595 MOVE - Line: 596 MOVE - Line: 597 IF - Line: 600 MOVE - Line: 601 WRITE - Line: 589 Paragraph: FLAT-RECORD - Line: 591 MOVE - Line: 592 MOVE - Line: 593 MOVE - Line: 594 MOVE - Line: 595 MOVE - Line: 596 MOVE - Line: 597 IF - Line: 598 MOVE - Line: 601 WRITE - Line: 589 Paragraph: FLAT-RECORD - Line: 591 MOVE - Line: 592 MOVE - Line: 593 MOVE - Line: 594 MOVE - Line: 595 MOVE - Line: 596 MOVE - Line: 597 IF - Line: 600 MOVE - Line: 601 WRITE - Line: 589 Paragraph: FLAT-RECORD - Line: 591 MOVE - Line: 592 MOVE - Line: 593 MOVE - Line: 594 MOVE - Line: 595 MOVE - Line: 596 MOVE - Line: 597 IF - Line: 598 MOVE - Line: 601 WRITE - Line: 581 CLOSE - Line: 582 OPEN - Line: 583 MOVE - Line: 584 READ - Line: 585 MOVE - Line: 586 READ - Line: 587 CLOSE - Line: 333 STOP RUN -]) -# hack for not checking Status 02 as this isn't returned by all -# ISAM implementations - -AT_CHECK([sed -e 's/WRITE TSPFILE Status: 02/WRITE TSPFILE Status: 00/g' \ -reference > references], [0], [], []) -AT_CHECK([sed -e 's/WRITE TSPFILE Status: 02/WRITE TSPFILE Status: 00/g' \ --e 's/'"OPEN OUTPUT TSPFILE -> 'testisam' Status: 05"'/'"OPEN OUTPUT TSPFILE -> 'testisam' Status: 00"'/g' \ -trace.txt > traces.txt], [0], [], []) - -AT_CHECK([gcdiff references traces.txt], [0], [], []) - -AT_CLEANUP - - -AT_SETUP([RELATIVE File Locking]) -AT_KEYWORDS([runfile]) - -# has timing issues - just skip until resolved later -AT_SKIP_IF(true) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - CONFIGURATION SECTION. - - INPUT-OUTPUT SECTION. - FILE-CONTROL. - SELECT FLATFILE ASSIGN EXTERNAL RELFIX - ORGANIZATION RELATIVE - ACCESS IS SEQUENTIAL RELATIVE KEY IS REC-NUM - FILE STATUS IS CUST-STAT. - - SELECT FLATFILE2 ASSIGN EXTERNAL RELFIX - ORGANIZATION RELATIVE - ACCESS IS RANDOM RELATIVE KEY IS REC-NUM - FILE STATUS IS CUST-STAT. - - SELECT LOCKFILE ASSIGN EXTERNAL RELLCK - ORGANIZATION RELATIVE - SHARING READ ONLY - ACCESS IS RANDOM RELATIVE KEY IS LCK-REC - FILE STATUS IS CUST-STAT. - - SELECT OPTIONAL REPORTIT ASSIGN TO REPORT-FILE - ORGANIZATION LINE SEQUENTIAL. - - DATA DIVISION. - FILE SECTION. - FD REPORTIT - BLOCK CONTAINS 5 RECORDS. - - 01 REPORT-RECORD PIC X(80). - - FD FLATFILE - BLOCK CONTAINS 5 RECORDS. - - 01 TSPFL-RECORD. - 10 CM-CUST-NUM PICTURE X(8). - 10 CM-COMPANY PICTURE X(25). - 10 CM-DISK PICTURE X(8). - 10 CM-NO-TERMINALS PICTURE 9(4). - - FD FLATFILE2 - BLOCK CONTAINS 5 RECORDS. - - 01 TSP2-RECORD. - 10 C2-CUST-NUM PICTURE X(8). - 10 C2-COMPANY PICTURE X(25). - 10 C2-DISK PICTURE X(8). - 10 C2-NO-TERMINALS PICTURE S9(4). - - FD LOCKFILE - BLOCK CONTAINS 5 RECORDS. - - 01 LCK-RECORD. - 10 LCK-NUM PICTURE 9(3). - 10 LCK-TBL PICTURE X OCCURS 4 TIMES. - 10 LCK-MESSAGE PICTURE X(25). - - WORKING-STORAGE SECTION. - - 77 MAX-SUB PICTURE 9(4) VALUE 6. - 77 CUST-STAT PICTURE X(2). - 77 REC-NUM PICTURE 9(4) VALUE 1. - 77 LCK-REC PICTURE 9(4) VALUE 1. - 77 SLP-TIME PICTURE 9(9) BINARY VALUE 1. - 77 REPORT-FILE PICTURE X(32) VALUE "parent.txt". - - 01 TEST-DATA. - - 02 DATA-CUST-NUM-TBL. - - 05 FILLER PIC X(8) VALUE "ALP00000". - 05 FILLER PIC X(8) VALUE "BET00000". - 05 FILLER PIC X(8) VALUE "DEL00000". - 05 FILLER PIC X(8) VALUE "EPS00000". - 05 FILLER PIC X(8) VALUE "FOR00000". - 05 FILLER PIC X(8) VALUE "GAM00000". - - 02 DATA-CUST-NUM REDEFINES DATA-CUST-NUM-TBL - PIC X(8) OCCURS 6. - 02 DATA-COMPANY-TBL. - - 05 FILLER PIC X(25) VALUE "ALPHA ELECTRICAL CO. LTD.". - 05 FILLER PIC X(25) VALUE "BETA SHOE MFG. INC. ". - 05 FILLER PIC X(25) VALUE "DELTA LUGGAGE REPAIRS ". - 05 FILLER PIC X(25) VALUE "EPSILON EQUIPMENT SUPPLY ". - 05 FILLER PIC X(25) VALUE "FORTUNE COOKIE COMPANY ". - 05 FILLER PIC X(25) VALUE "GAMMA X-RAY TECHNOLOGY ". - 02 DATA-COMPANY REDEFINES DATA-COMPANY-TBL - PIC X(25) OCCURS 6. - 02 DATA-ADDRESS-2-TBL. - - 05 FILLER PIC X(10) VALUE "ATLANTA ". - 05 FILLER PIC X(10) VALUE "CALGARY ". - 05 FILLER PIC X(10) VALUE "NEW YORK ". - 05 FILLER PIC X(10) VALUE "TORONTO ". - 05 FILLER PIC X(10) VALUE "WASHINGTON". - 05 FILLER PIC X(10) VALUE "WHITEPLAIN". - 02 DATA-ADDRESS REDEFINES DATA-ADDRESS-2-TBL - PIC X(10) OCCURS 6. - - 01 WORK-AREA. - 05 SUB PICTURE 9(4) COMP SYNC. - 88 ODD-RECORD VALUE 1 3 5. - - 01 CMD-LINE PIC X(64). - 01 WMI PIC X(7). - 01 SEQ PIC 9(2) VALUE 0. - 01 MSG PIC X(64) VALUE " ". - - PROCEDURE DIVISION. - - ACCEPT CMD-LINE FROM COMMAND-LINE. - CALL "C$TOUPPER" USING CMD-LINE BY VALUE LENGTH OF CMD-LINE. - MOVE SPACES TO REPORT-RECORD. - EVALUATE CMD-LINE - WHEN SPACES - MOVE "control.txt" TO REPORT-FILE - OPEN EXTEND REPORTIT - MOVE "Control" TO WMI - PERFORM LOADFILE - PERFORM LOCK-EXCLUSIVE - CALL "SYSTEM" USING "./prog PARENT &" - CALL "SYSTEM" USING "./prog CHILD &" - CALL "C$SLEEP" USING 2 - MOVE "continue test " TO MSG - PERFORM DISPLAY-IT - PERFORM LOCK-RELEASE - CALL "C$SLEEP" USING 2 - PERFORM LOCK-EXCLUSIVE - MOVE "waiting step 1 completion " TO MSG - PERFORM DISPLAY-IT - CALL "C$SLEEP" USING 1 - PERFORM LOCK-RELEASE - CALL "C$SLEEP" USING 1 - PERFORM LOCK-EXCLUSIVE - CALL "C$SLEEP" USING 1 - PERFORM LOCK-RELEASE - CALL "C$SLEEP" USING 1 - CALL "SYSTEM" USING "./prog LOCK &" - CALL "SYSTEM" USING "./prog READADV &" - CALL "C$SLEEP" USING 6 - MOVE "waiting step 2 completion " TO MSG - PERFORM DISPLAY-IT - PERFORM LOCK-EXCLUSIVE - CALL "SYSTEM" USING "./prog UPDT &" - CALL "SYSTEM" USING "./prog CHILDUP &" - PERFORM LOCK-RELEASE - CALL "C$SLEEP" USING 3 - PERFORM LOCK-EXCLUSIVE - MOVE "waiting step 3 completion " TO MSG - PERFORM DISPLAY-IT - CALL "C$SLEEP" USING 1 - PERFORM LOCK-RELEASE - WHEN "PARENT" - MOVE "parent.txt" TO REPORT-FILE - OPEN EXTEND REPORTIT - MOVE " PARENT" TO WMI - PERFORM LOCK-SHARED - CALL "C$SLEEP" USING 1 - PERFORM READ-FILE - PERFORM LOCK-RELEASE - CALL "C$SLEEP" USING 2 - PERFORM LOCK-SHARED - PERFORM READ-FILE-NO-SHARE - PERFORM READ-FILE-RETRY-SHARE - PERFORM READ-FILE-RETRY-SHORT - PERFORM LOCK-RELEASE - WHEN "CHILD" - MOVE "child.txt" TO REPORT-FILE - OPEN EXTEND REPORTIT - MOVE " CHILD" TO WMI - PERFORM LOCK-SHARED - CALL "C$SLEEP" USING 2 - PERFORM READ-FILE - PERFORM LOCK-RELEASE - CALL "C$SLEEP" USING 2 - PERFORM LOCK-SHARED - PERFORM READ-FILE-NO-SHARE - PERFORM READ-FILE-RETRY-SHARE - PERFORM READ-FILE-RETRY-SHARE - PERFORM LOCK-RELEASE - WHEN "UPDT" - MOVE "parent.txt" TO REPORT-FILE - OPEN EXTEND REPORTIT - MOVE "Par Upd" TO WMI - PERFORM LOCK-SHARED - PERFORM UPDT-SHARE - PERFORM LOCK-RELEASE - WHEN "CHILDUP" - MOVE "child.txt" TO REPORT-FILE - OPEN EXTEND REPORTIT - MOVE "Cld Upd" TO WMI - MOVE 1 TO SLP-TIME - PERFORM LOCK-SHARED - PERFORM UPDT-SHARE - PERFORM LOCK-RELEASE - WHEN "LOCK" - MOVE "parent.txt" TO REPORT-FILE - OPEN EXTEND REPORTIT - MOVE "Par Lck" TO WMI - PERFORM READ-FILE-ADV - OPEN I-O SHARING ALL OTHER FLATFILE2 - MOVE 1 TO REC-NUM - READ FLATFILE2 WITH LOCK - DELETE FLATFILE2 - STRING "Deleted " C2-CUST-NUM " 1 Sts:" - CUST-STAT INTO MSG - PERFORM DISPLAY-IT - MOVE 3 TO REC-NUM - READ FLATFILE2 WITH LOCK - STRING "Read " C2-CUST-NUM " Locked 3 Sts:" - CUST-STAT INTO MSG - PERFORM DISPLAY-IT - CALL "C$SLEEP" USING 4 - CLOSE FLATFILE2 - WHEN "READADV" - MOVE "child.txt" TO REPORT-FILE - OPEN EXTEND REPORTIT - MOVE "Cld Adv" TO WMI - CALL "C$SLEEP" USING 2 - PERFORM READ-FILE-ADV - MOVE "Cld Ign" TO WMI - PERFORM READ-FILE-IGN - END-EVALUATE. - MOVE "ending " TO MSG - PERFORM DISPLAY-IT - CLOSE REPORTIT. - STOP RUN. - - READ-FILE. - OPEN INPUT FLATFILE. - STRING "READ Open Sts:" CUST-STAT INTO MSG - PERFORM DISPLAY-IT - PERFORM 2 TIMES - PERFORM READ-NEXT - CALL "C$SLEEP" USING 1 - END-PERFORM. - CLOSE FLATFILE. - - READ-FILE-NO-SHARE. - OPEN INPUT SHARING NO OTHER FLATFILE. - STRING "NO SHARE Open Sts:" CUST-STAT INTO MSG - PERFORM DISPLAY-IT - IF CUST-STAT = "00" - PERFORM 2 TIMES - PERFORM READ-NEXT - CALL "C$SLEEP" USING 1 - END-PERFORM - CLOSE FLATFILE - ELSE - PERFORM READ-NEXT - CALL "C$SLEEP" USING 1 - CLOSE FLATFILE - CALL "C$SLEEP" USING 1 - END-IF. - - READ-FILE-RETRY-SHARE. - OPEN INPUT SHARING NO OTHER RETRY 10 SECONDS FLATFILE. - STRING "RETRY SHARE Open Sts:" CUST-STAT INTO MSG - PERFORM DISPLAY-IT - IF CUST-STAT = "00" - PERFORM 2 TIMES - PERFORM READ-NEXT - CALL "C$SLEEP" USING 1 - END-PERFORM - CLOSE FLATFILE - ELSE - PERFORM READ-NEXT - CALL "C$SLEEP" USING 1 - CLOSE FLATFILE - CALL "C$SLEEP" USING 1 - END-IF. - - READ-FILE-RETRY-SHORT. - OPEN INPUT SHARING NO OTHER RETRY 2 SECONDS FLATFILE. - STRING "RETRY SHORT Open Sts:" CUST-STAT INTO MSG - PERFORM DISPLAY-IT - IF CUST-STAT = "00" - PERFORM 2 TIMES - PERFORM READ-NEXT - CALL "C$SLEEP" USING 1 - END-PERFORM - CLOSE FLATFILE - ELSE - PERFORM READ-NEXT - CALL "C$SLEEP" USING 1 - CLOSE FLATFILE - CALL "C$SLEEP" USING 1 - END-IF. - - UPDT-SHARE. - OPEN I-O SHARING ALL OTHER FLATFILE2. - MOVE 3 TO REC-NUM. - CALL "C$SLEEP" USING SLP-TIME - READ FLATFILE2 - STRING "Read " C2-CUST-NUM " no lock Sts:" CUST-STAT - INTO MSG - PERFORM DISPLAY-IT. - ADD 1 TO C2-NO-TERMINALS - REWRITE FILE FLATFILE2 FROM TSP2-RECORD WITH NO LOCK - * REWRITE TSP2-RECORD WITH NO LOCK - STRING "REWRITE " C2-CUST-NUM " Trms:" C2-NO-TERMINALS - " Sts:" CUST-STAT INTO MSG - PERFORM DISPLAY-IT - - READ FLATFILE2 WITH LOCK - STRING "Read " C2-CUST-NUM " with LOCK Sts:" CUST-STAT - INTO MSG - PERFORM DISPLAY-IT. - CALL "C$SLEEP" USING 2 - READ FLATFILE2 WITH LOCK - STRING "Re-Read " C2-CUST-NUM " with LOCK Sts:" CUST-STAT - INTO MSG - PERFORM DISPLAY-IT. - REWRITE TSP2-RECORD WITH NO LOCK - STRING "REWRITE " C2-CUST-NUM " Trms:" C2-NO-TERMINALS - " Sts:" CUST-STAT INTO MSG - PERFORM DISPLAY-IT - - READ FLATFILE2 WITH LOCK - STRING "Read " C2-CUST-NUM " and LOCK Sts:" CUST-STAT - INTO MSG - PERFORM DISPLAY-IT. - - MOVE 2 TO REC-NUM. - MOVE DATA-CUST-NUM (REC-NUM) TO C2-CUST-NUM - MOVE WMI TO C2-CUST-NUM (3:6) - REWRITE TSP2-RECORD RETRY 10 SECONDS WITH NO LOCK - STRING "REWRITE " C2-CUST-NUM " No read! " - " Sts:" CUST-STAT INTO MSG - PERFORM DISPLAY-IT - CLOSE FLATFILE2. - - READ-NEXT. - MOVE SPACES TO TSPFL-RECORD. - READ FLATFILE NEXT - IF CUST-STAT NOT = "00" - STRING "Read Next Sts:" CUST-STAT - INTO MSG - ELSE - STRING "Next " CM-CUST-NUM " Trms:" CM-NO-TERMINALS - " #" REC-NUM INTO MSG - END-IF. - PERFORM DISPLAY-IT. - - READ-FILE-ADV. - OPEN INPUT SHARING ALL OTHER FLATFILE - STRING "READ Open Sts:" CUST-STAT INTO MSG - PERFORM DISPLAY-IT - PERFORM 4 TIMES - PERFORM READ-NEXT-ADV - END-PERFORM. - CLOSE FLATFILE. - - READ-NEXT-ADV. - MOVE SPACES TO TSPFL-RECORD. - READ FLATFILE NEXT ADVANCING ON LOCK - IF CUST-STAT NOT = "00" - STRING "Read Next adv Sts:" CUST-STAT - INTO MSG - ELSE - STRING "Nextadv " CM-CUST-NUM " Trms:" CM-NO-TERMINALS - " #" REC-NUM INTO MSG - END-IF. - PERFORM DISPLAY-IT. - - READ-FILE-IGN. - OPEN INPUT SHARING ALL OTHER FLATFILE - STRING "READ Open Sts:" CUST-STAT INTO MSG - PERFORM DISPLAY-IT - PERFORM 4 TIMES - PERFORM READ-NEXT-IGN - END-PERFORM. - CLOSE FLATFILE. - - READ-NEXT-IGN. - MOVE SPACES TO TSPFL-RECORD. - READ FLATFILE NEXT IGNORE LOCK - IF CUST-STAT NOT = "00" - STRING "Read Next ign Sts:" CUST-STAT - INTO MSG - ELSE - STRING "Nextign " CM-CUST-NUM " Trms:" CM-NO-TERMINALS - " #" REC-NUM INTO MSG - END-IF. - PERFORM DISPLAY-IT. - - DISPLAY-IT. - ADD 1 TO SEQ. - STRING WMI " :" SEQ ": " MSG INTO REPORT-RECORD. - WRITE REPORT-RECORD. - MOVE SPACES TO MSG. - MOVE SPACES TO REPORT-RECORD. - - LOCK-EXCLUSIVE. - OPEN I-O SHARING NO OTHER RETRY FOREVER LOCKFILE. - - LOCK-SHARED. - OPEN INPUT SHARING READ ONLY RETRY FOREVER LOCKFILE. - - LOCK-RELEASE. - CLOSE LOCKFILE. - - LOADFILE. - STRING WMI " . . Loading sample program data file" - INTO REPORT-RECORD. - WRITE REPORT-RECORD. - MOVE SPACES TO REPORT-RECORD. - - OPEN OUTPUT LOCKFILE. - MOVE SPACES TO LCK-RECORD. - MOVE ZERO TO LCK-NUM. - MOVE "Lock control" TO LCK-MESSAGE. - WRITE FILE LOCKFILE FROM LCK-RECORD - * WRITE LCK-RECORD. - CLOSE LOCKFILE. - - OPEN OUTPUT FLATFILE. - PERFORM LOAD-RECORD - VARYING SUB FROM 1 BY 1 - UNTIL SUB > MAX-SUB. - - CLOSE FLATFILE. - - LOAD-RECORD. - MOVE SPACES TO TSPFL-RECORD. - MOVE DATA-CUST-NUM (SUB) TO CM-CUST-NUM. - MOVE DATA-COMPANY (SUB) TO CM-COMPANY. - MOVE 10 TO CM-NO-TERMINALS. - IF ODD-RECORD - MOVE "8417" TO CM-DISK - ELSE - MOVE "8470" TO CM-DISK. - WRITE TSPFL-RECORD. -]) - -# CHECKME: do we need -std/-fmf-files here? -AT_CHECK([$COMPILE -std=mf -fmf-files prog.cob], [0], [], []) - -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [], []) - - -AT_CAPTURE_FILE(./control.txt) - -AT_DATA([reference], -[Control . . Loading sample program data file -Control :01: continue test -Control :02: waiting step 1 completion -Control :03: waiting step 2 completion -Control :04: waiting step 3 completion -Control :05: ending -]) - -AT_CHECK([diff reference control.txt], [0], [], []) - - -AT_CAPTURE_FILE(./parent.txt) - -AT_DATA([reference], -[ PARENT :01: READ Open Sts:00 - PARENT :02: Next ALP00000 Trms:0010 #0001 - PARENT :03: Next BET00000 Trms:0010 #0002 - PARENT :04: NO SHARE Open Sts:00 - PARENT :05: Next ALP00000 Trms:0010 #0001 - PARENT :06: Next BET00000 Trms:0010 #0002 - PARENT :07: RETRY SHARE Open Sts:00 - PARENT :08: Next ALP00000 Trms:0010 #0001 - PARENT :09: Next BET00000 Trms:0010 #0002 - PARENT :10: RETRY SHORT Open Sts:61 - PARENT :11: Read Next Sts:47 - PARENT :12: ending -Par Lck :01: READ Open Sts:00 -Par Lck :02: Nextadv ALP00000 Trms:0010 #0001 -Par Lck :03: Nextadv BET00000 Trms:0010 #0002 -Par Lck :04: Nextadv DEL00000 Trms:0010 #0003 -Par Lck :05: Nextadv EPS00000 Trms:0010 #0004 -Par Lck :06: Deleted ALP00000 1 Sts:00 -Par Lck :07: Read DEL00000 Locked 3 Sts:00 -Par Lck :08: ending -Par Upd :01: Read DEL00000 no lock Sts:00 -Par Upd :02: REWRITE DEL00000 Trms:0011 Sts:00 -Par Upd :03: Read DEL00000 with LOCK Sts:00 -Par Upd :04: Re-Read DEL00000 with LOCK Sts:00 -Par Upd :05: REWRITE DEL00000 Trms:0011 Sts:00 -Par Upd :06: Read DEL00000 and LOCK Sts:00 -Par Upd :07: REWRITE BEPar Up No read! Sts:00 -Par Upd :08: ending -]) - -AT_CHECK([diff reference parent.txt], [0], [], []) - - -AT_CAPTURE_FILE(./child.txt) - -AT_DATA([reference], -[ CHILD :01: READ Open Sts:00 - CHILD :02: Next ALP00000 Trms:0010 #0001 - CHILD :03: Next BET00000 Trms:0010 #0002 - CHILD :04: NO SHARE Open Sts:61 - CHILD :05: Read Next Sts:47 - CHILD :06: RETRY SHARE Open Sts:00 - CHILD :07: Next ALP00000 Trms:0010 #0001 - CHILD :08: Next BET00000 Trms:0010 #0002 - CHILD :09: RETRY SHARE Open Sts:00 - CHILD :10: Next ALP00000 Trms:0010 #0001 - CHILD :11: Next BET00000 Trms:0010 #0002 - CHILD :12: ending -Cld Adv :01: READ Open Sts:00 -Cld Adv :02: Nextadv BET00000 Trms:0010 #0002 -Cld Adv :03: Nextadv EPS00000 Trms:0010 #0004 -Cld Adv :04: Nextadv FOR00000 Trms:0010 #0005 -Cld Adv :05: Nextadv GAM00000 Trms:0010 #0006 -Cld Ign :06: READ Open Sts:00 -Cld Ign :07: Nextign BET00000 Trms:0010 #0002 -Cld Ign :08: Nextign DEL00000 Trms:0010 #0003 -Cld Ign :09: Nextign EPS00000 Trms:0010 #0004 -Cld Ign :10: Nextign FOR00000 Trms:0010 #0005 -Cld Ign :11: ending -Cld Upd :01: Read DEL00000 no lock Sts:00 -Cld Upd :02: REWRITE DEL00000 Trms:0012 Sts:51 -Cld Upd :03: Read DEL00000 with LOCK Sts:51 -Cld Upd :04: Re-Read DEL00000 with LOCK Sts:00 -Cld Upd :05: REWRITE DEL00000 Trms:0011 Sts:00 -Cld Upd :06: Read DEL00000 and LOCK Sts:00 -Cld Upd :07: REWRITE BECld Up No read! Sts:00 -Cld Upd :08: ending -]) - -AT_CHECK([diff reference child.txt], [0], [], []) - -AT_CLEANUP - - -AT_SETUP([WRITE and REWRITE FILE name ]) -AT_KEYWORDS([runfile]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - CONFIGURATION SECTION. - - INPUT-OUTPUT SECTION. - FILE-CONTROL. - SELECT FLATFILE ASSIGN EXTERNAL RELFIX - ORGANIZATION RELATIVE - ACCESS IS SEQUENTIAL RELATIVE KEY IS REC-NUM - FILE STATUS IS CUST-STAT. - - SELECT FLATFILE2 ASSIGN EXTERNAL RELFIX - ORGANIZATION RELATIVE - ACCESS IS RANDOM RELATIVE KEY IS REC-NUM - FILE STATUS IS CUST-STAT. - - DATA DIVISION. - FILE SECTION. - FD FLATFILE - BLOCK CONTAINS 5 RECORDS. - - 01 TSPFL-RECORD. - 10 CM-CUST-NUM PICTURE X(8). - 10 CM-COMPANY PICTURE X(25). - 10 CM-DISK PICTURE X(8). - 10 CM-NO-TERMINALS PICTURE 9(4). - - FD FLATFILE2 - BLOCK CONTAINS 5 RECORDS. - - 01 TSP2-RECORD. - 10 C2-CUST-NUM PICTURE X(8). - 10 C2-COMPANY PICTURE X(25). - 10 C2-DISK PICTURE X(8). - 10 C2-NO-TERMINALS PICTURE 9(4). - - WORKING-STORAGE SECTION. - - 77 MAX-SUB VALUE 6 PICTURE 9(4) COMP SYNC. - 77 CUST-STAT PICTURE X(2). - 77 REC-NUM VALUE 1 PICTURE 9(4). - - 01 TEST-DATA. - - 02 DATA-CUST-NUM-TBL. - - 05 FILLER PIC X(8) VALUE "ALP00000". - 05 FILLER PIC X(8) VALUE "BET00000". - 05 FILLER PIC X(8) VALUE "DEL00000". - 05 FILLER PIC X(8) VALUE "EPS00000". - 05 FILLER PIC X(8) VALUE "FOR00000". - 05 FILLER PIC X(8) VALUE "GAM00000". - - 02 DATA-CUST-NUM REDEFINES DATA-CUST-NUM-TBL - PIC X(8) OCCURS 6. - 02 DATA-COMPANY-TBL. - - 05 FILLER PIC X(25) VALUE "ALPHA ELECTRICAL CO. LTD.". - 05 FILLER PIC X(25) VALUE "BETA SHOE MFG. INC. ". - 05 FILLER PIC X(25) VALUE "DELTA LUGGAGE REPAIRS ". - 05 FILLER PIC X(25) VALUE "EPSILON EQUIPMENT SUPPLY ". - 05 FILLER PIC X(25) VALUE "FORTUNE COOKIE COMPANY ". - 05 FILLER PIC X(25) VALUE "GAMMA X-RAY TECHNOLOGY ". - 02 DATA-COMPANY REDEFINES DATA-COMPANY-TBL - PIC X(25) OCCURS 6. - 02 DATA-ADDRESS-2-TBL. - - 05 FILLER PIC X(10) VALUE "ATLANTA ". - 05 FILLER PIC X(10) VALUE "CALGARY ". - 05 FILLER PIC X(10) VALUE "NEW YORK ". - 05 FILLER PIC X(10) VALUE "TORONTO ". - 05 FILLER PIC X(10) VALUE "WASHINGTON". - 05 FILLER PIC X(10) VALUE "WHITEPLAIN". - 02 DATA-ADDRESS REDEFINES DATA-ADDRESS-2-TBL - PIC X(10) OCCURS 6. - - 02 DATA-NO-TERMINALS-TBL. - - 05 FILLER PIC 9(3) COMP-3 VALUE 10. - 05 FILLER PIC 9(3) COMP-3 VALUE 13. - 05 FILLER PIC 9(3) COMP-3 VALUE 75. - 05 FILLER PIC 9(3) COMP-3 VALUE 10. - 05 FILLER PIC 9(3) COMP-3 VALUE 90. - 05 FILLER PIC 9(3) COMP-3 VALUE 254. - - 02 DATA-NO-TERMINALS REDEFINES DATA-NO-TERMINALS-TBL - PIC 9(3) COMP-3 OCCURS 6. - 01 WORK-AREA. - 05 SUB PICTURE 9(4) COMP SYNC. - 88 ODD-RECORD VALUE 1 3 5. - - - PROCEDURE DIVISION. - - PERFORM LOADFILE. - - OPEN I-O FLATFILE2. - MOVE 2 TO REC-NUM - READ FLATFILE2 - DISPLAY "Read " C2-CUST-NUM " Sts:" CUST-STAT - " Trms:" C2-NO-TERMINALS. - ADD 1 TO C2-NO-TERMINALS - REWRITE FILE FLATFILE2 FROM TSP2-RECORD - READ FLATFILE2 - DISPLAY "REWROTE " C2-CUST-NUM " Sts:" CUST-STAT - " Trms:" C2-NO-TERMINALS. - CLOSE FLATFILE2. - STOP RUN. - - LOADFILE. - DISPLAY "Loading sample program data file." - UPON CONSOLE. - - OPEN OUTPUT FLATFILE. - - PERFORM LOAD-RECORD - VARYING SUB FROM 1 BY 1 - UNTIL SUB > MAX-SUB. - - DISPLAY "Sample program data file load complete." - UPON CONSOLE. - CLOSE FLATFILE. - - LOAD-RECORD. - - MOVE SPACES TO TSPFL-RECORD. - MOVE DATA-CUST-NUM (SUB) TO CM-CUST-NUM. - MOVE DATA-COMPANY (SUB) TO CM-COMPANY. - MOVE DATA-NO-TERMINALS (SUB) TO CM-NO-TERMINALS. - IF ODD-RECORD - MOVE "8417" TO CM-DISK - ELSE - MOVE "8470" TO CM-DISK. - WRITE FILE FLATFILE FROM TSPFL-RECORD. -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) - -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], -[Loading sample program data file. -Sample program data file load complete. -Read BET00000 Sts:00 Trms:0013 -REWROTE BET00000 Sts:00 Trms:0014 -], []) - -AT_CLEANUP - - -AT_SETUP([INDEXED File Locking]) -AT_KEYWORDS([runfile]) - -# has timing issues - just skip until resolved later -AT_SKIP_IF(true) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - - PROGRAM-ID. prog. - - ENVIRONMENT DIVISION. - CONFIGURATION SECTION. - - INPUT-OUTPUT SECTION. - FILE-CONTROL. - SELECT TSPFILE ASSIGN TO "testisam" - ORGANIZATION INDEXED ACCESS DYNAMIC - LOCK MANUAL - * LOCK AUTOMATIC - WITH LOCK ON MULTIPLE RECORDS - * WITH LOCK ON RECORD - SHARING WITH ALL OTHER - RECORD KEY IS PRIME-KEY - SOURCE IS CM-CUST-NUM - - FILE STATUS IS CUST-STAT . - - SELECT LOCKFILE ASSIGN EXTERNAL RELLCK - ORGANIZATION RELATIVE - ACCESS IS RANDOM RELATIVE KEY IS LCK-REC - FILE STATUS IS CUST-STAT. - - SELECT OPTIONAL REPORTIT ASSIGN TO REPORT-FILE - ORGANIZATION LINE SEQUENTIAL. - - DATA DIVISION. - FILE SECTION. - FD LOCKFILE - BLOCK CONTAINS 5 RECORDS. - - 01 LCK-RECORD. - 10 LCK-NUM PICTURE 9(3). - 10 LCK-TBL PICTURE X OCCURS 4 TIMES. - 10 LCK-MESSAGE PICTURE X(25). - - FD REPORTIT - BLOCK CONTAINS 5 RECORDS. - - 01 REPORT-RECORD PICTURE X(80). - - FD TSPFILE - BLOCK CONTAINS 5 RECORDS. - - 01 TSPFL-RECORD. - 05 TSPFL-REC. - 10 CM-CUST-NUM PICTURE X(8). - 10 CM-COMPANY PICTURE X(25). - 10 CM-DISK PICTURE X(8). - 10 CM-NO-TERMINALS PICTURE 9(4). - - WORKING-STORAGE SECTION. - - 01 WS-TIME-NOW. - 05 WS-NOW-HH PIC 9(02) VALUE 0. - 05 WS-NOW-MM PIC 9(02) VALUE 0. - 05 WS-NOW-SS PIC 9(02) VALUE 0. - 05 WS-NOW-HS PIC 9(02) VALUE 0. - - 01 CUST-STAT PIC XX. - 77 BYTE-1 PICTURE 9(3). - 77 BYTE-2 PICTURE 9(3). - 77 MAX-SUB PICTURE 9(2) VALUE 8. - 77 REPORT-FILE PICTURE X(32) VALUE "control.txt". - 77 MSG PICTURE X(70) VALUE SPACES. - 77 CMD-LINE PICTURE X(80) VALUE SPACES. - 77 SEQ PICTURE 99 VALUE 0. - 77 LCK-REC PICTURE 9(4) VALUE 1. - - 01 SAVE-REC PIC X(250). - - 01 TEST-DATA. - 02 DATA-CUST-NUM-TBL. - 05 FILLER PIC X(8) VALUE "ALP00000". - 05 FILLER PIC X(8) VALUE "BET00000". - 05 FILLER PIC X(8) VALUE "CAM00000". - 05 FILLER PIC X(8) VALUE "DEL00000". - 05 FILLER PIC X(8) VALUE "EPS00000". - 05 FILLER PIC X(8) VALUE "FOR00000". - 05 FILLER PIC X(8) VALUE "GIB00000". - 05 FILLER PIC X(8) VALUE "HIJ00000". - - 02 DATA-CUST-NUM REDEFINES DATA-CUST-NUM-TBL - PIC X(8) OCCURS 8. - 02 DATA-COMPANY-TBL. - 05 FILLER PIC X(25) VALUE "ALPHA ELECTRICAL CO. LTD.". - 05 FILLER PIC X(25) VALUE "BETA SHOE MFG. INC. ". - 05 FILLER PIC X(25) VALUE "CAMERA X-RAY TECHNOLOGY ". - 05 FILLER PIC X(25) VALUE "DELTA LUGGAGE REPAIRS ". - 05 FILLER PIC X(25) VALUE "EPSILON EQUIPMENT SUPPLY ". - 05 FILLER PIC X(25) VALUE "FORTUNE COOKIE COMPANY ". - 05 FILLER PIC X(25) VALUE "GIBRALTER LIFE INSURANCE ". - 05 FILLER PIC X(25) VALUE "HECKLE PLUMBING SUPPLIES ". - - 02 DATA-COMPANY REDEFINES DATA-COMPANY-TBL - PIC X(25) OCCURS 8. - - 01 WORK-AREA. - 05 SLP-TIME PICTURE 9(9) BINARY VALUE 1. - 05 SLP-SHORT PICTURE 9(18) BINARY VALUE 20000000. - 05 SLP-LONG PICTURE 9(18) BINARY VALUE 320000000. - 05 LCK-IDX PICTURE 9(4) BINARY VALUE 1. - 05 REC-NUM PICTURE 9(4) VALUE 0. - 05 REC-MAX PICTURE 9(5) COMP VALUE 10. - 05 SUB PICTURE 9(4) COMP SYNC. - 88 ODD-RECORD VALUE 1 3 5 7 9 10 11. - - 05 TSPFL-KEY PICTURE X(8). - 05 WMI PICTURE X(8). - - PROCEDURE DIVISION. - - MAINFILE. - ACCEPT CMD-LINE FROM COMMAND-LINE. - CALL "C$TOUPPER" USING CMD-LINE BY VALUE LENGTH OF CMD-LINE. - MOVE SPACES TO REPORT-RECORD. - EVALUATE CMD-LINE - WHEN SPACES - MOVE "control.txt" TO REPORT-FILE - OPEN EXTEND REPORTIT - MOVE "Control" TO WMI - PERFORM LOADFILE - PERFORM LOCK-INIT - CALL "SYSTEM" USING "./prog PARENT &" - CALL "SYSTEM" USING "./prog CHILD &" - PERFORM LOCK-WAIT-READY - MOVE "continue test " TO MSG - PERFORM DISPLAY-IT - PERFORM LOCK-WAIT-COMPLETE 2 TIMES - MOVE "waiting step 1 completion " TO MSG - PERFORM DISPLAY-IT - PERFORM LOCK-WAIT-COMPLETE 2 TIMES - PERFORM LOCK-INIT - CALL "SYSTEM" USING "./prog LOCK &" - CALL "SYSTEM" USING "./prog READADV &" - PERFORM LOCK-WAIT-READY - MOVE "waiting step 2 completion " TO MSG - PERFORM DISPLAY-IT - PERFORM LOCK-WAIT-COMPLETE - PERFORM LOCK-INIT - CALL "SYSTEM" USING "./prog UPDT &" - CALL "SYSTEM" USING "./prog CHILDUP &" - PERFORM LOCK-WAIT-READY - MOVE "waiting step 3 completion " TO MSG - PERFORM DISPLAY-IT - PERFORM LOCK-WAIT-COMPLETE - WHEN "PARENT" - MOVE "parent.txt" TO REPORT-FILE - OPEN EXTEND REPORTIT - MOVE " PARENT" TO WMI - PERFORM LOCK-READY-AND-GO - PERFORM READ-FILE - PERFORM LOCK-COMPLETE-AND-GO - PERFORM READ-FILE-NO-SHARE - PERFORM LOCK-COMPLETE-AND-GO - PERFORM READ-FILE-RETRY-SHARE - PERFORM LOCK-COMPLETE-AND-GO - PERFORM READ-FILE-RETRY-SHORT - PERFORM LOCK-MARK-COMPLETE - WHEN "CHILD" - MOVE 2 TO LCK-IDX - MOVE "child.txt" TO REPORT-FILE - OPEN EXTEND REPORTIT - MOVE " CHILD" TO WMI - PERFORM LOCK-READY-AND-GO - PERFORM READ-FILE - PERFORM LOCK-COMPLETE-AND-GO - CALL "C$SLEEP" USING 1 - PERFORM READ-FILE-NO-SHARE - PERFORM LOCK-COMPLETE-AND-GO - PERFORM READ-FILE-RETRY-SHARE - PERFORM LOCK-COMPLETE-AND-GO - PERFORM READ-FILE-RETRY-SHARE - PERFORM LOCK-MARK-COMPLETE - WHEN "UPDT" - MOVE "parent.txt" TO REPORT-FILE - OPEN EXTEND REPORTIT - MOVE "Par Upd" TO WMI - PERFORM LOCK-READY-AND-GO - CALL "C$SLEEP" USING 1 - PERFORM UPDT-SHARE - PERFORM LOCK-MARK-COMPLETE - WHEN "CHILDUP" - MOVE 2 TO LCK-IDX - MOVE "child.txt" TO REPORT-FILE - OPEN EXTEND REPORTIT - MOVE "Cld Upd" TO WMI - PERFORM LOCK-READY-AND-GO - MOVE 2 TO SLP-TIME - PERFORM UPDT-SHARE - PERFORM LOCK-MARK-COMPLETE - WHEN "LOCK" - MOVE "parent.txt" TO REPORT-FILE - OPEN EXTEND REPORTIT - MOVE "Par Lck" TO WMI - PERFORM LOCK-READY-AND-GO - PERFORM READ-FILE-ADV - OPEN I-O SHARING ALL OTHER TSPFILE - MOVE DATA-CUST-NUM (1) TO CM-CUST-NUM - READ TSPFILE WITH LOCK - DELETE TSPFILE - STRING "Deleted " CM-CUST-NUM " Sts:" - CUST-STAT INTO MSG - PERFORM DISPLAY-IT - MOVE DATA-CUST-NUM (3) TO CM-CUST-NUM - READ TSPFILE WITH LOCK - STRING "Read " CM-CUST-NUM " Locked Sts:" - CUST-STAT INTO MSG - PERFORM DISPLAY-IT - MOVE DATA-CUST-NUM (6) TO CM-CUST-NUM - READ TSPFILE WITH LOCK - MOVE DATA-CUST-NUM (6) TO CM-CUST-NUM - READ TSPFILE WITH LOCK - STRING "Read " CM-CUST-NUM " Locked Sts:" - CUST-STAT INTO MSG - PERFORM DISPLAY-IT - CALL "C$SLEEP" USING 9 - READ TSPFILE - CLOSE TSPFILE - PERFORM LOCK-MARK-COMPLETE - WHEN "READADV" - MOVE 2 TO LCK-IDX - MOVE "child.txt" TO REPORT-FILE - OPEN EXTEND REPORTIT - PERFORM LOCK-READY-AND-GO - MOVE "Cld Adv" TO WMI - CALL "C$SLEEP" USING 2 - PERFORM READ-FILE-ADV - MOVE "Cld Ign" TO WMI - PERFORM READ-FILE-IGN - PERFORM LOCK-MARK-COMPLETE - WHEN OTHER - DISPLAY "Bad cmd:" CMD-LINE - END-EVALUATE. - MOVE "ending " TO MSG - PERFORM DISPLAY-IT - CLOSE REPORTIT. - STOP RUN. - - LOADFILE. - - MOVE "Loading test data file." TO MSG - PERFORM DISPLAY-IT. - - OPEN OUTPUT TSPFILE - IF CUST-STAT NOT = "00" - STRING "Error " CUST-STAT " opening 'testisam' file" - INTO MSG - PERFORM DISPLAY-IT - STOP RUN - END-IF. - - PERFORM 1000-LOAD-RECORD - VARYING SUB FROM 1 BY 1 - UNTIL SUB > MAX-SUB. - - CLOSE TSPFILE. - - *---------------------------------------------------------------* - * LOAD A RECORD FROM DATA TABLES * - *---------------------------------------------------------------* - - 1000-LOAD-RECORD. - - MOVE SPACES TO TSPFL-RECORD. - MOVE DATA-CUST-NUM (SUB) TO CM-CUST-NUM. - MOVE CM-CUST-NUM TO TSPFL-KEY. - MOVE DATA-COMPANY (SUB) TO CM-COMPANY. - MOVE 10 TO CM-NO-TERMINALS. - - IF ODD-RECORD - MOVE "8417" TO CM-DISK - ELSE - MOVE "8470" TO CM-DISK. - - WRITE TSPFL-RECORD. - IF CUST-STAT NOT = "00" - AND CUST-STAT NOT = "02" - STRING "Key: " TSPFL-KEY ", Status: " CUST-STAT - INTO MSG - PERFORM DISPLAY-IT. - - READ-FILE. - OPEN INPUT TSPFILE. - STRING "READ Open Sts:" CUST-STAT INTO MSG - PERFORM DISPLAY-IT - PERFORM 2 TIMES - PERFORM READ-NEXT - CALL "C$SLEEP" USING 1 - END-PERFORM. - CLOSE TSPFILE. - - READ-FILE-NO-SHARE. - OPEN INPUT SHARING NO OTHER TSPFILE. - STRING "OPEN NO SHARE Sts:" CUST-STAT INTO MSG - PERFORM DISPLAY-IT - IF CUST-STAT = "00" - PERFORM 2 TIMES - PERFORM READ-NEXT - CALL "C$SLEEP" USING 1 - END-PERFORM - ELSE - PERFORM READ-NEXT - END-IF. - CALL "C$SLEEP" USING 2 - CLOSE TSPFILE. - - READ-FILE-RETRY-SHARE. - OPEN INPUT SHARING NO OTHER RETRY 15 SECONDS TSPFILE. - STRING "OPEN NO SHARE RETRY 15 Sts:" CUST-STAT INTO MSG - PERFORM DISPLAY-IT - IF CUST-STAT = "00" - PERFORM 2 TIMES - PERFORM READ-NEXT - CALL "C$SLEEP" USING 1 - END-PERFORM - ELSE - PERFORM READ-NEXT - END-IF. - CALL "C$SLEEP" USING 4 - CLOSE TSPFILE. - - READ-FILE-RETRY-SHORT. - CALL "C$SLEEP" USING 1. - OPEN INPUT SHARING NO OTHER RETRY 2 SECONDS TSPFILE. - STRING "OPEN NO SHARE RETRY 2 Sts:" CUST-STAT INTO MSG - PERFORM DISPLAY-IT - IF CUST-STAT = "00" - PERFORM 2 TIMES - PERFORM READ-NEXT - CALL "C$SLEEP" USING 1 - END-PERFORM - ELSE - PERFORM READ-NEXT - END-IF. - CLOSE TSPFILE. - - UPDT-SHARE. - OPEN I-O SHARING ALL OTHER TSPFILE. - MOVE 3 TO REC-NUM. - MOVE DATA-CUST-NUM (REC-NUM) TO CM-CUST-NUM - READ TSPFILE WITH NO LOCK - STRING "Read " CM-CUST-NUM " no lock Sts:" CUST-STAT - INTO MSG - PERFORM DISPLAY-IT. - ADD 1 TO CM-NO-TERMINALS - REWRITE TSPFL-RECORD RETRY 25 SECONDS WITH NO LOCK - STRING "REWRITE " CM-CUST-NUM " Trms:" CM-NO-TERMINALS - " Sts:" CUST-STAT INTO MSG - PERFORM DISPLAY-IT. - CALL "C$SLEEP" USING SLP-TIME - - READ TSPFILE RETRY 2 SECONDS WITH LOCK - STRING "Read " CM-CUST-NUM " with LOCK Sts:" CUST-STAT - INTO MSG - PERFORM DISPLAY-IT. - IF CUST-STAT = "51" - READ TSPFILE RETRY 15 SECONDS WITH LOCK - STRING "Read " CM-CUST-NUM " retry LCK Sts:" - CUST-STAT INTO MSG - PERFORM DISPLAY-IT - ELSE - CALL "C$SLEEP" USING 5 - END-IF - READ TSPFILE WITH LOCK - STRING "Re-Read " CM-CUST-NUM " with LOCK Sts:" CUST-STAT - INTO MSG - PERFORM DISPLAY-IT. - REWRITE TSPFL-RECORD WITH NO LOCK - STRING "REWRITE " CM-CUST-NUM " Trms:" CM-NO-TERMINALS - " Sts:" CUST-STAT INTO MSG - PERFORM DISPLAY-IT - - READ TSPFILE WITH LOCK - STRING "Read " CM-CUST-NUM " and LOCK Sts:" CUST-STAT - INTO MSG - PERFORM DISPLAY-IT. - - MOVE 2 TO REC-NUM. - MOVE DATA-CUST-NUM (REC-NUM) TO CM-CUST-NUM - REWRITE TSPFL-RECORD RETRY 10 SECONDS WITH NO LOCK - STRING "REWRITE " CM-CUST-NUM " No read! " - " Sts:" CUST-STAT INTO MSG - PERFORM DISPLAY-IT - CLOSE TSPFILE. - - READ-NEXT. - MOVE SPACES TO TSPFL-RECORD. - READ TSPFILE NEXT - IF CUST-STAT NOT = "00" - STRING "Read Next Sts:" CUST-STAT - INTO MSG - ELSE - STRING "Next " CM-CUST-NUM " Trms:" CM-NO-TERMINALS - INTO MSG - END-IF. - PERFORM DISPLAY-IT. - - READ-FILE-ADV. - OPEN INPUT SHARING ALL OTHER TSPFILE - STRING "READ Open Sts:" CUST-STAT INTO MSG - PERFORM DISPLAY-IT - PERFORM 4 TIMES - PERFORM READ-NEXT-ADV - END-PERFORM. - START TSPFILE LAST - PERFORM 4 TIMES - PERFORM READ-PREV-ADV - END-PERFORM. - CLOSE TSPFILE. - - READ-NEXT-ADV. - MOVE SPACES TO TSPFL-RECORD. - READ TSPFILE NEXT ADVANCING ON LOCK - IF CUST-STAT NOT = "00" - STRING "Read Next adv Sts:" CUST-STAT - INTO MSG - ELSE - STRING "Nextadv " CM-CUST-NUM " Trms:" CM-NO-TERMINALS - INTO MSG - END-IF. - PERFORM DISPLAY-IT. - - READ-PREV-ADV. - MOVE SPACES TO TSPFL-RECORD. - READ TSPFILE PREVIOUS ADVANCING ON LOCK - IF CUST-STAT NOT = "00" - STRING "Read Prev adv Sts:" CUST-STAT - INTO MSG - ELSE - STRING "Prevadv " CM-CUST-NUM " Trms:" CM-NO-TERMINALS - INTO MSG - END-IF. - PERFORM DISPLAY-IT. - - READ-FILE-IGN. - OPEN INPUT SHARING ALL OTHER TSPFILE - STRING "READ Open Sts:" CUST-STAT INTO MSG - PERFORM DISPLAY-IT - PERFORM 7 TIMES - PERFORM READ-NEXT-IGN - END-PERFORM. - CLOSE TSPFILE. - - READ-NEXT-IGN. - MOVE SPACES TO TSPFL-RECORD. - READ TSPFILE NEXT IGNORE LOCK - IF CUST-STAT NOT = "00" - STRING "Read Next ign Sts:" CUST-STAT - INTO MSG - ELSE - STRING "Nextign " CM-CUST-NUM " Trms:" CM-NO-TERMINALS - INTO MSG - END-IF. - PERFORM DISPLAY-IT. - - LOCK-INIT. - OPEN OUTPUT LOCKFILE. - MOVE SPACES TO LCK-RECORD. - MOVE ZERO TO LCK-NUM. - MOVE "Lock control" TO LCK-MESSAGE. - WRITE LCK-RECORD. - CLOSE LOCKFILE. - - LOCK-WAIT-READY. - OPEN I-O SHARING ALL OTHER RETRY FOREVER LOCKFILE. - PERFORM UNTIL LCK-TBL (1) = 'R' - AND LCK-TBL (2) = 'R' - READ LOCKFILE - IF LCK-TBL (1) NOT = 'R' - OR LCK-TBL (2) NOT = 'R' - CALL "CBL_GC_NANOSLEEP" USING SLP-SHORT - END-IF - END-PERFORM. - READ LOCKFILE RETRY FOREVER WITH LOCK - MOVE 'G' TO LCK-TBL (1), LCK-TBL (2) - REWRITE LCK-RECORD. - CLOSE LOCKFILE. - - LOCK-WAIT-COMPLETE. - OPEN I-O SHARING ALL OTHER RETRY FOREVER LOCKFILE. - PERFORM UNTIL LCK-TBL (1) = 'C' - AND LCK-TBL (2) = 'C' - READ LOCKFILE - IF LCK-TBL (1) NOT = 'C' - OR LCK-TBL (2) NOT = 'C' - CALL "CBL_GC_NANOSLEEP" USING SLP-LONG - END-IF - END-PERFORM. - READ LOCKFILE RETRY FOREVER WITH LOCK - MOVE 'G' TO LCK-TBL (1), LCK-TBL (2) - REWRITE LCK-RECORD. - CLOSE LOCKFILE. - - LOCK-WAIT-FOR-GO. - OPEN I-O SHARING ALL OTHER RETRY FOREVER LOCKFILE. - PERFORM UNTIL LCK-TBL (LCK-IDX) = 'G' - READ LOCKFILE - IF LCK-TBL (LCK-IDX) NOT = 'G' - CALL "CBL_GC_NANOSLEEP" USING SLP-SHORT - END-IF - END-PERFORM. - READ LOCKFILE RETRY FOREVER WITH LOCK - MOVE 'X' TO LCK-TBL (LCK-IDX) - REWRITE LCK-RECORD. - CLOSE LOCKFILE. - - LOCK-MARK-READY. - OPEN I-O SHARING ALL OTHER RETRY FOREVER LOCKFILE. - READ LOCKFILE RETRY FOREVER WITH LOCK - MOVE 'R' TO LCK-TBL (LCK-IDX) - REWRITE LCK-RECORD. - CLOSE LOCKFILE. - - LOCK-MARK-COMPLETE. - OPEN I-O SHARING ALL OTHER RETRY FOREVER LOCKFILE. - READ LOCKFILE RETRY FOREVER WITH LOCK - MOVE 'C' TO LCK-TBL (LCK-IDX) - REWRITE LCK-RECORD. - CLOSE LOCKFILE. - - LOCK-COMPLETE-AND-GO. - PERFORM LOCK-MARK-COMPLETE - PERFORM LOCK-WAIT-FOR-GO. - - LOCK-READY-AND-GO. - PERFORM LOCK-MARK-READY - PERFORM LOCK-WAIT-FOR-GO. - - DISPLAY-IT. - ADD 1 TO SEQ. - IF MSG (1:1) = '*' - ACCEPT WS-TIME-NOW FROM TIME - STRING WMI " :" SEQ ": " - WS-NOW-MM ":" WS-NOW-SS "." WS-NOW-HS " : " - MSG (2:) INTO REPORT-RECORD - ELSE - STRING WMI " :" SEQ ": " MSG INTO REPORT-RECORD - END-IF. - WRITE REPORT-RECORD. - MOVE SPACES TO MSG. - MOVE SPACES TO REPORT-RECORD. -]) - -# CHECKME: do we need -std/-fmf-files here? -AT_CHECK([$COMPILE -std=mf -fmf-files prog.cob], [0], [], []) - -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [], []) - - -AT_CAPTURE_FILE(./control.txt) - -AT_DATA([reference], -[Control :01: Loading test data file. -Control :02: continue test -Control :03: waiting step 1 completion -Control :04: waiting step 2 completion -Control :05: waiting step 3 completion -Control :06: ending -]) - -AT_CHECK([diff reference control.txt], [0], [], []) - - -AT_CAPTURE_FILE(./parent.txt) - -AT_DATA([reference], -[ PARENT :01: READ Open Sts:00 - PARENT :02: Next ALP00000 Trms:0010 - PARENT :03: Next BET00000 Trms:0010 - PARENT :04: OPEN NO SHARE Sts:00 - PARENT :05: Next ALP00000 Trms:0010 - PARENT :06: Next BET00000 Trms:0010 - PARENT :07: OPEN NO SHARE RETRY 15 Sts:00 - PARENT :08: Next ALP00000 Trms:0010 - PARENT :09: Next BET00000 Trms:0010 - PARENT :10: OPEN NO SHARE RETRY 2 Sts:61 - PARENT :11: Read Next Sts:47 - PARENT :12: ending -Par Lck :01: READ Open Sts:00 -Par Lck :02: Nextadv ALP00000 Trms:0010 -Par Lck :03: Nextadv BET00000 Trms:0010 -Par Lck :04: Nextadv CAM00000 Trms:0010 -Par Lck :05: Nextadv DEL00000 Trms:0010 -Par Lck :06: Prevadv HIJ00000 Trms:0010 -Par Lck :07: Prevadv GIB00000 Trms:0010 -Par Lck :08: Prevadv FOR00000 Trms:0010 -Par Lck :09: Prevadv EPS00000 Trms:0010 -Par Lck :10: Deleted ALP00000 Sts:00 -Par Lck :11: Read CAM00000 Locked Sts:00 -Par Lck :12: Read FOR00000 Locked Sts:00 -Par Lck :13: ending -Par Upd :01: Read CAM00000 no lock Sts:00 -Par Upd :02: REWRITE CAM00000 Trms:0012 Sts:00 -Par Upd :03: Read CAM00000 with LOCK Sts:00 -Par Upd :04: Re-Read CAM00000 with LOCK Sts:00 -Par Upd :05: REWRITE CAM00000 Trms:0012 Sts:00 -Par Upd :06: Read CAM00000 and LOCK Sts:00 -Par Upd :07: REWRITE BET00000 No read! Sts:00 -Par Upd :08: ending -]) - -AT_CHECK([diff reference parent.txt], [0], [], []) - - -AT_CAPTURE_FILE(./child.txt) - -AT_DATA([reference], -[ CHILD :01: READ Open Sts:00 - CHILD :02: Next ALP00000 Trms:0010 - CHILD :03: Next BET00000 Trms:0010 - CHILD :04: OPEN NO SHARE Sts:61 - CHILD :05: Read Next Sts:47 - CHILD :06: OPEN NO SHARE RETRY 15 Sts:00 - CHILD :07: Next ALP00000 Trms:0010 - CHILD :08: Next BET00000 Trms:0010 - CHILD :09: OPEN NO SHARE RETRY 15 Sts:00 - CHILD :10: Next ALP00000 Trms:0010 - CHILD :11: Next BET00000 Trms:0010 - CHILD :12: ending -Cld Adv :01: READ Open Sts:00 -Cld Adv :02: Nextadv BET00000 Trms:0010 -Cld Adv :03: Nextadv DEL00000 Trms:0010 -Cld Adv :04: Nextadv EPS00000 Trms:0010 -Cld Adv :05: Nextadv GIB00000 Trms:0010 -Cld Adv :06: Prevadv HIJ00000 Trms:0010 -Cld Adv :07: Prevadv GIB00000 Trms:0010 -Cld Adv :08: Prevadv EPS00000 Trms:0010 -Cld Adv :09: Prevadv DEL00000 Trms:0010 -Cld Ign :10: READ Open Sts:00 -Cld Ign :11: Nextign BET00000 Trms:0010 -Cld Ign :12: Nextign CAM00000 Trms:0010 -Cld Ign :13: Nextign DEL00000 Trms:0010 -Cld Ign :14: Nextign EPS00000 Trms:0010 -Cld Ign :15: Nextign FOR00000 Trms:0010 -Cld Ign :16: Nextign GIB00000 Trms:0010 -Cld Ign :17: Nextign HIJ00000 Trms:0010 -Cld Ign :18: ending -Cld Upd :01: Read CAM00000 no lock Sts:00 -Cld Upd :02: REWRITE CAM00000 Trms:0011 Sts:00 -Cld Upd :03: Read CAM00000 with LOCK Sts:51 -Cld Upd :04: Read CAM00000 retry LCK Sts:00 -Cld Upd :05: Re-Read CAM00000 with LOCK Sts:00 -Cld Upd :06: REWRITE CAM00000 Trms:0012 Sts:00 -Cld Upd :07: Read CAM00000 and LOCK Sts:00 -Cld Upd :08: REWRITE BET00000 No read! Sts:00 -Cld Upd :09: ending -]) - -AT_CHECK([diff reference child.txt], [0], [], []) - -AT_CLEANUP - - -AT_SETUP([RELATIVE File Locking]) -AT_KEYWORDS([runfile]) - -# has timing issues - just skip until resolved later -AT_SKIP_IF(true) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - CONFIGURATION SECTION. - - INPUT-OUTPUT SECTION. - FILE-CONTROL. - SELECT FLATFILE ASSIGN EXTERNAL RELFIX - ORGANIZATION RELATIVE - ACCESS IS SEQUENTIAL RELATIVE KEY IS REC-NUM - FILE STATUS IS CUST-STAT. - - SELECT FLATFILE2 ASSIGN EXTERNAL RELFIX - ORGANIZATION RELATIVE - ACCESS IS RANDOM RELATIVE KEY IS REC-NUM - FILE STATUS IS CUST-STAT. - - SELECT LOCKFILE ASSIGN EXTERNAL RELLCK - ORGANIZATION RELATIVE - SHARING READ ONLY - ACCESS IS RANDOM RELATIVE KEY IS LCK-REC - FILE STATUS IS CUST-STAT. - - SELECT OPTIONAL REPORTIT ASSIGN TO REPORT-FILE - ORGANIZATION LINE SEQUENTIAL. - - DATA DIVISION. - FILE SECTION. - FD REPORTIT - BLOCK CONTAINS 5 RECORDS. - - 01 REPORT-RECORD PIC X(80). - - FD FLATFILE - BLOCK CONTAINS 5 RECORDS. - - 01 TSPFL-RECORD. - 10 CM-CUST-NUM PICTURE X(8). - 10 CM-COMPANY PICTURE X(25). - 10 CM-DISK PICTURE X(8). - 10 CM-NO-TERMINALS PICTURE 9(4). - - FD FLATFILE2 - BLOCK CONTAINS 5 RECORDS. - - 01 TSP2-RECORD. - 10 C2-CUST-NUM PICTURE X(8). - 10 C2-COMPANY PICTURE X(25). - 10 C2-DISK PICTURE X(8). - 10 C2-NO-TERMINALS PICTURE S9(4). - - FD LOCKFILE - BLOCK CONTAINS 5 RECORDS. - - 01 LCK-RECORD. - 10 LCK-NUM PICTURE 9(3). - 10 LCK-TBL PICTURE X OCCURS 4 TIMES. - 10 LCK-MESSAGE PICTURE X(25). - - WORKING-STORAGE SECTION. - - 77 MAX-SUB PICTURE 9(4) VALUE 6. - 77 CUST-STAT PICTURE X(2). - 77 REC-NUM PICTURE 9(4) VALUE 1. - 77 LCK-REC PICTURE 9(4) VALUE 1. - 77 SLP-TIME PICTURE 9(9) BINARY VALUE 1. - 77 REPORT-FILE PICTURE X(32) VALUE "parent.txt". - - 01 TEST-DATA. - - 02 DATA-CUST-NUM-TBL. - - 05 FILLER PIC X(8) VALUE "ALP00000". - 05 FILLER PIC X(8) VALUE "BET00000". - 05 FILLER PIC X(8) VALUE "DEL00000". - 05 FILLER PIC X(8) VALUE "EPS00000". - 05 FILLER PIC X(8) VALUE "FOR00000". - 05 FILLER PIC X(8) VALUE "GAM00000". - - 02 DATA-CUST-NUM REDEFINES DATA-CUST-NUM-TBL - PIC X(8) OCCURS 6. - 02 DATA-COMPANY-TBL. - - 05 FILLER PIC X(25) VALUE "ALPHA ELECTRICAL CO. LTD.". - 05 FILLER PIC X(25) VALUE "BETA SHOE MFG. INC. ". - 05 FILLER PIC X(25) VALUE "DELTA LUGGAGE REPAIRS ". - 05 FILLER PIC X(25) VALUE "EPSILON EQUIPMENT SUPPLY ". - 05 FILLER PIC X(25) VALUE "FORTUNE COOKIE COMPANY ". - 05 FILLER PIC X(25) VALUE "GAMMA X-RAY TECHNOLOGY ". - 02 DATA-COMPANY REDEFINES DATA-COMPANY-TBL - PIC X(25) OCCURS 6. - 02 DATA-ADDRESS-2-TBL. - - 05 FILLER PIC X(10) VALUE "ATLANTA ". - 05 FILLER PIC X(10) VALUE "CALGARY ". - 05 FILLER PIC X(10) VALUE "NEW YORK ". - 05 FILLER PIC X(10) VALUE "TORONTO ". - 05 FILLER PIC X(10) VALUE "WASHINGTON". - 05 FILLER PIC X(10) VALUE "WHITEPLAIN". - 02 DATA-ADDRESS REDEFINES DATA-ADDRESS-2-TBL - PIC X(10) OCCURS 6. - - 01 WORK-AREA. - 05 SUB PICTURE 9(4) COMP SYNC. - 88 ODD-RECORD VALUE 1 3 5. - - 01 CMD-LINE PIC X(64). - 01 WMI PIC X(7). - 01 SEQ PIC 9(2) VALUE 0. - 01 MSG PIC X(64) VALUE " ". - - PROCEDURE DIVISION. - - ACCEPT CMD-LINE FROM COMMAND-LINE. - CALL "C$TOUPPER" USING CMD-LINE BY VALUE LENGTH OF CMD-LINE. - MOVE SPACES TO REPORT-RECORD. - EVALUATE CMD-LINE - WHEN SPACES - MOVE "control.txt" TO REPORT-FILE - OPEN EXTEND REPORTIT - MOVE "Control" TO WMI - PERFORM LOADFILE - PERFORM LOCK-EXCLUSIVE - CALL "SYSTEM" USING "./prog PARENT &" - CALL "SYSTEM" USING "./prog CHILD &" - CALL "C$SLEEP" USING 2 - MOVE "continue test " TO MSG - PERFORM DISPLAY-IT - PERFORM LOCK-RELEASE - CALL "C$SLEEP" USING 2 - PERFORM LOCK-EXCLUSIVE - PERFORM LOCK-RELEASE - CALL "C$SLEEP" USING 2 - PERFORM LOCK-EXCLUSIVE - MOVE "waiting step 1 completion " TO MSG - PERFORM DISPLAY-IT - CALL "C$SLEEP" USING 1 - PERFORM LOCK-RELEASE - CALL "C$SLEEP" USING 2 - PERFORM LOCK-EXCLUSIVE - CALL "C$SLEEP" USING 2 - PERFORM LOCK-RELEASE - CALL "C$SLEEP" USING 1 - CALL "SYSTEM" USING "./prog LOCK &" - CALL "SYSTEM" USING "./prog READADV &" - CALL "C$SLEEP" USING 6 - MOVE "waiting step 2 completion " TO MSG - PERFORM DISPLAY-IT - PERFORM LOCK-EXCLUSIVE - CALL "SYSTEM" USING "./prog UPDT &" - CALL "SYSTEM" USING "./prog CHILDUP &" - PERFORM LOCK-RELEASE - CALL "C$SLEEP" USING 3 - PERFORM LOCK-EXCLUSIVE - MOVE "waiting step 3 completion " TO MSG - PERFORM DISPLAY-IT - CALL "C$SLEEP" USING 1 - PERFORM LOCK-RELEASE - WHEN "PARENT" - MOVE "parent.txt" TO REPORT-FILE - OPEN EXTEND REPORTIT - MOVE " PARENT" TO WMI - PERFORM LOCK-SHARED - CALL "C$SLEEP" USING 1 - PERFORM READ-FILE - PERFORM LOCK-RELEASE - CALL "C$SLEEP" USING 3 - PERFORM LOCK-SHARED - PERFORM READ-FILE-NO-SHARE - PERFORM READ-FILE-RETRY-SHARE - PERFORM LOCK-RELEASE - CALL "C$SLEEP" USING 4 - PERFORM LOCK-SHARED - PERFORM READ-FILE-RETRY-SHORT - PERFORM LOCK-RELEASE - WHEN "CHILD" - MOVE "child.txt" TO REPORT-FILE - OPEN EXTEND REPORTIT - MOVE " CHILD" TO WMI - PERFORM LOCK-SHARED - CALL "C$SLEEP" USING 2 - PERFORM READ-FILE - PERFORM LOCK-RELEASE - CALL "C$SLEEP" USING 3 - PERFORM LOCK-SHARED - PERFORM READ-FILE-NO-SHARE - PERFORM READ-FILE-RETRY-SHARE - PERFORM LOCK-RELEASE - CALL "C$SLEEP" USING 4 - PERFORM LOCK-SHARED - PERFORM READ-FILE-RETRY-SHARE - PERFORM LOCK-RELEASE - WHEN "UPDT" - MOVE "parent.txt" TO REPORT-FILE - OPEN EXTEND REPORTIT - MOVE "Par Upd" TO WMI - PERFORM LOCK-SHARED - PERFORM UPDT-SHARE - PERFORM LOCK-RELEASE - WHEN "CHILDUP" - MOVE "child.txt" TO REPORT-FILE - OPEN EXTEND REPORTIT - MOVE "Cld Upd" TO WMI - MOVE 1 TO SLP-TIME - PERFORM LOCK-SHARED - PERFORM UPDT-SHARE - PERFORM LOCK-RELEASE - WHEN "LOCK" - MOVE "parent.txt" TO REPORT-FILE - OPEN EXTEND REPORTIT - MOVE "Par Lck" TO WMI - PERFORM READ-FILE-ADV - OPEN I-O SHARING ALL OTHER FLATFILE2 - MOVE 1 TO REC-NUM - READ FLATFILE2 WITH LOCK - DELETE FLATFILE2 - STRING "Deleted " C2-CUST-NUM " 1 Sts:" - CUST-STAT INTO MSG - PERFORM DISPLAY-IT - MOVE 3 TO REC-NUM - READ FLATFILE2 WITH LOCK - STRING "Read " C2-CUST-NUM " Locked 3 Sts:" - CUST-STAT INTO MSG - PERFORM DISPLAY-IT - CALL "C$SLEEP" USING 4 - CLOSE FLATFILE2 - WHEN "READADV" - MOVE "child.txt" TO REPORT-FILE - OPEN EXTEND REPORTIT - MOVE "Cld Adv" TO WMI - CALL "C$SLEEP" USING 2 - PERFORM READ-FILE-ADV - MOVE "Cld Ign" TO WMI - PERFORM READ-FILE-IGN - END-EVALUATE. - MOVE "ending " TO MSG - PERFORM DISPLAY-IT - CLOSE REPORTIT. - STOP RUN. - - READ-FILE. - OPEN INPUT FLATFILE. - STRING "READ Open Sts:" CUST-STAT INTO MSG - PERFORM DISPLAY-IT - PERFORM 2 TIMES - PERFORM READ-NEXT - CALL "C$SLEEP" USING 1 - END-PERFORM. - CLOSE FLATFILE. - - READ-FILE-NO-SHARE. - OPEN INPUT SHARING NO OTHER FLATFILE. - STRING "NO SHARE Open Sts:" CUST-STAT INTO MSG - PERFORM DISPLAY-IT - IF CUST-STAT = "00" - PERFORM 2 TIMES - PERFORM READ-NEXT - CALL "C$SLEEP" USING 1 - END-PERFORM - CLOSE FLATFILE - ELSE - PERFORM READ-NEXT - CALL "C$SLEEP" USING 1 - CLOSE FLATFILE - CALL "C$SLEEP" USING 1 - END-IF. - - READ-FILE-RETRY-SHARE. - OPEN INPUT SHARING NO OTHER RETRY 10 SECONDS FLATFILE. - STRING "RETRY SHARE Open Sts:" CUST-STAT INTO MSG - PERFORM DISPLAY-IT - CALL "C$SLEEP" USING 2 - IF CUST-STAT = "00" - PERFORM 2 TIMES - PERFORM READ-NEXT - CALL "C$SLEEP" USING 1 - END-PERFORM - CALL "C$SLEEP" USING 2 - CLOSE FLATFILE - ELSE - PERFORM READ-NEXT - CALL "C$SLEEP" USING 2 - CLOSE FLATFILE - CALL "C$SLEEP" USING 1 - END-IF. - - READ-FILE-RETRY-SHORT. - OPEN INPUT SHARING NO OTHER RETRY 2 SECONDS FLATFILE. - STRING "RETRY SHORT Open Sts:" CUST-STAT INTO MSG - PERFORM DISPLAY-IT - IF CUST-STAT = "00" - PERFORM 2 TIMES - PERFORM READ-NEXT - CALL "C$SLEEP" USING 1 - END-PERFORM - CLOSE FLATFILE - ELSE - PERFORM READ-NEXT - CALL "C$SLEEP" USING 1 - CLOSE FLATFILE - CALL "C$SLEEP" USING 1 - END-IF. - - UPDT-SHARE. - OPEN I-O SHARING ALL OTHER FLATFILE2. - MOVE 3 TO REC-NUM. - CALL "C$SLEEP" USING SLP-TIME - READ FLATFILE2 - STRING "Read " C2-CUST-NUM " no lock Sts:" CUST-STAT - INTO MSG - PERFORM DISPLAY-IT. - ADD 1 TO C2-NO-TERMINALS - REWRITE FILE FLATFILE2 FROM TSP2-RECORD WITH NO LOCK - * REWRITE TSP2-RECORD WITH NO LOCK - STRING "REWRITE " C2-CUST-NUM " Trms:" C2-NO-TERMINALS - " Sts:" CUST-STAT INTO MSG - PERFORM DISPLAY-IT - - READ FLATFILE2 WITH LOCK - STRING "Read " C2-CUST-NUM " with LOCK Sts:" CUST-STAT - INTO MSG - PERFORM DISPLAY-IT. - CALL "C$SLEEP" USING 2 - READ FLATFILE2 WITH LOCK - STRING "Re-Read " C2-CUST-NUM " with LOCK Sts:" CUST-STAT - INTO MSG - PERFORM DISPLAY-IT. - REWRITE TSP2-RECORD WITH NO LOCK - STRING "REWRITE " C2-CUST-NUM " Trms:" C2-NO-TERMINALS - " Sts:" CUST-STAT INTO MSG - PERFORM DISPLAY-IT - - READ FLATFILE2 WITH LOCK - STRING "Read " C2-CUST-NUM " and LOCK Sts:" CUST-STAT - INTO MSG - PERFORM DISPLAY-IT. - - MOVE 2 TO REC-NUM. - MOVE DATA-CUST-NUM (REC-NUM) TO C2-CUST-NUM - MOVE WMI TO C2-CUST-NUM (3:6) - REWRITE TSP2-RECORD RETRY 10 SECONDS WITH NO LOCK - STRING "REWRITE " C2-CUST-NUM " No read! " - " Sts:" CUST-STAT INTO MSG - PERFORM DISPLAY-IT - CLOSE FLATFILE2. - - READ-NEXT. - MOVE SPACES TO TSPFL-RECORD. - READ FLATFILE NEXT - IF CUST-STAT NOT = "00" - STRING "Read Next Sts:" CUST-STAT - INTO MSG - ELSE - STRING "Next " CM-CUST-NUM " Trms:" CM-NO-TERMINALS - " #" REC-NUM INTO MSG - END-IF. - PERFORM DISPLAY-IT. - - READ-FILE-ADV. - OPEN INPUT SHARING ALL OTHER FLATFILE - STRING "READ Open Sts:" CUST-STAT INTO MSG - PERFORM DISPLAY-IT - PERFORM 4 TIMES - PERFORM READ-NEXT-ADV - END-PERFORM. - CLOSE FLATFILE. - - READ-NEXT-ADV. - MOVE SPACES TO TSPFL-RECORD. - READ FLATFILE NEXT ADVANCING ON LOCK - IF CUST-STAT NOT = "00" - STRING "Read Next adv Sts:" CUST-STAT - INTO MSG - ELSE - STRING "Nextadv " CM-CUST-NUM " Trms:" CM-NO-TERMINALS - " #" REC-NUM INTO MSG - END-IF. - PERFORM DISPLAY-IT. - - READ-FILE-IGN. - OPEN INPUT SHARING ALL OTHER FLATFILE - STRING "READ Open Sts:" CUST-STAT INTO MSG - PERFORM DISPLAY-IT - PERFORM 4 TIMES - PERFORM READ-NEXT-IGN - END-PERFORM. - CLOSE FLATFILE. - - READ-NEXT-IGN. - MOVE SPACES TO TSPFL-RECORD. - READ FLATFILE NEXT IGNORE LOCK - IF CUST-STAT NOT = "00" - STRING "Read Next ign Sts:" CUST-STAT - INTO MSG - ELSE - STRING "Nextign " CM-CUST-NUM " Trms:" CM-NO-TERMINALS - " #" REC-NUM INTO MSG - END-IF. - PERFORM DISPLAY-IT. - - DISPLAY-IT. - ADD 1 TO SEQ. - STRING WMI " :" SEQ ": " MSG INTO REPORT-RECORD. - WRITE REPORT-RECORD. - MOVE SPACES TO MSG. - MOVE SPACES TO REPORT-RECORD. - - LOCK-EXCLUSIVE. - OPEN I-O SHARING NO OTHER RETRY FOREVER LOCKFILE. - - LOCK-SHARED. - OPEN INPUT SHARING READ ONLY RETRY FOREVER LOCKFILE. - - LOCK-RELEASE. - CLOSE LOCKFILE. - - LOADFILE. - STRING WMI " . . Loading sample program data file" - INTO REPORT-RECORD. - WRITE REPORT-RECORD. - MOVE SPACES TO REPORT-RECORD. - - OPEN OUTPUT LOCKFILE. - MOVE SPACES TO LCK-RECORD. - MOVE ZERO TO LCK-NUM. - MOVE "Lock control" TO LCK-MESSAGE. - WRITE FILE LOCKFILE FROM LCK-RECORD - * WRITE LCK-RECORD. - CLOSE LOCKFILE. - - OPEN OUTPUT FLATFILE. - PERFORM LOAD-RECORD - VARYING SUB FROM 1 BY 1 - UNTIL SUB > MAX-SUB. - - CLOSE FLATFILE. - - LOAD-RECORD. - MOVE SPACES TO TSPFL-RECORD. - MOVE DATA-CUST-NUM (SUB) TO CM-CUST-NUM. - MOVE DATA-COMPANY (SUB) TO CM-COMPANY. - MOVE 10 TO CM-NO-TERMINALS. - IF ODD-RECORD - MOVE "8417" TO CM-DISK - ELSE - MOVE "8470" TO CM-DISK. - WRITE TSPFL-RECORD. -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [], []) - - -AT_CAPTURE_FILE(./control.txt) - -AT_DATA([reference], -[Control . . Loading sample program data file -Control :01: continue test -Control :02: waiting step 1 completion -Control :03: waiting step 2 completion -Control :04: waiting step 3 completion -Control :05: ending -]) - -AT_CHECK([diff reference control.txt], [0], [], []) - - -AT_CAPTURE_FILE(./parent.txt) - -AT_DATA([reference], -[ PARENT :01: READ Open Sts:00 - PARENT :02: Next ALP00000 Trms:0010 #0001 - PARENT :03: Next BET00000 Trms:0010 #0002 - PARENT :04: NO SHARE Open Sts:00 - PARENT :05: Next ALP00000 Trms:0010 #0001 - PARENT :06: Next BET00000 Trms:0010 #0002 - PARENT :07: RETRY SHARE Open Sts:00 - PARENT :08: Next ALP00000 Trms:0010 #0001 - PARENT :09: Next BET00000 Trms:0010 #0002 - PARENT :10: RETRY SHORT Open Sts:61 - PARENT :11: Read Next Sts:47 - PARENT :12: ending -Par Lck :01: READ Open Sts:00 -Par Lck :02: Nextadv ALP00000 Trms:0010 #0001 -Par Lck :03: Nextadv BET00000 Trms:0010 #0002 -Par Lck :04: Nextadv DEL00000 Trms:0010 #0003 -Par Lck :05: Nextadv EPS00000 Trms:0010 #0004 -Par Lck :06: Deleted ALP00000 1 Sts:00 -Par Lck :07: Read DEL00000 Locked 3 Sts:00 -Par Lck :08: ending -Par Upd :01: Read DEL00000 no lock Sts:00 -Par Upd :02: REWRITE DEL00000 Trms:0011 Sts:00 -Par Upd :03: Read DEL00000 with LOCK Sts:00 -Par Upd :04: Re-Read DEL00000 with LOCK Sts:00 -Par Upd :05: REWRITE DEL00000 Trms:0011 Sts:00 -Par Upd :06: Read DEL00000 and LOCK Sts:00 -Par Upd :07: REWRITE BEPar Up No read! Sts:00 -Par Upd :08: ending -]) - -AT_CHECK([diff reference parent.txt], [0], [], []) - - -AT_CAPTURE_FILE(./child.txt) - -AT_DATA([reference], -[ CHILD :01: READ Open Sts:00 - CHILD :02: Next ALP00000 Trms:0010 #0001 - CHILD :03: Next BET00000 Trms:0010 #0002 - CHILD :04: NO SHARE Open Sts:61 - CHILD :05: Read Next Sts:47 - CHILD :06: RETRY SHARE Open Sts:00 - CHILD :07: Next ALP00000 Trms:0010 #0001 - CHILD :08: Next BET00000 Trms:0010 #0002 - CHILD :09: RETRY SHARE Open Sts:00 - CHILD :10: Next ALP00000 Trms:0010 #0001 - CHILD :11: Next BET00000 Trms:0010 #0002 - CHILD :12: ending -Cld Adv :01: READ Open Sts:00 -Cld Adv :02: Nextadv BET00000 Trms:0010 #0002 -Cld Adv :03: Nextadv EPS00000 Trms:0010 #0004 -Cld Adv :04: Nextadv FOR00000 Trms:0010 #0005 -Cld Adv :05: Nextadv GAM00000 Trms:0010 #0006 -Cld Ign :06: READ Open Sts:00 -Cld Ign :07: Nextign BET00000 Trms:0010 #0002 -Cld Ign :08: Nextign DEL00000 Trms:0010 #0003 -Cld Ign :09: Nextign EPS00000 Trms:0010 #0004 -Cld Ign :10: Nextign FOR00000 Trms:0010 #0005 -Cld Ign :11: ending -Cld Upd :01: Read DEL00000 no lock Sts:00 -Cld Upd :02: REWRITE DEL00000 Trms:0012 Sts:51 -Cld Upd :03: Read DEL00000 with LOCK Sts:51 -Cld Upd :04: Re-Read DEL00000 with LOCK Sts:00 -Cld Upd :05: REWRITE DEL00000 Trms:0011 Sts:00 -Cld Upd :06: Read DEL00000 and LOCK Sts:00 -Cld Upd :07: REWRITE BECld Up No read! Sts:00 -Cld Upd :08: ending -]) - -AT_CHECK([diff reference child.txt], [0], [], []) - -AT_CLEANUP - - -AT_SETUP([Read on optional missing file]) -AT_KEYWORDS([runfile]) - -AT_DATA([prog.cob], -[ IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - CONFIGURATION SECTION. - INPUT-OUTPUT SECTION. - FILE-CONTROL. - SELECT OPTIONAL INFILE ASSIGN TO - "missing.txt" - ORGANIZATION IS RELATIVE - ACCESS IS SEQUENTIAL - FILE STATUS IS WSFS. - DATA DIVISION. - FILE SECTION. - FD INFILE. - 01 INREC PIC X(80). - WORKING-STORAGE SECTION. - 01 WSFS PIC X(2). - 88 RECORDFOUND VALUE "00". - 01 WSINREC PIC X(80). - PROCEDURE DIVISION. - MAIN-PROCEDURE. - * Open missing file - OPEN INPUT INFILE - * First read, raise a FS 10 (AT END) which is expected - READ INFILE INTO WSINREC - END-READ - IF WSFS = '10' - DISPLAY "1st Read on missing optional file = " WSFS " OK" - ELSE - DISPLAY "1st Read on missing optional file = " WSFS " Bad" - END-IF. - - * Second read, should raise a FS 46 (READ AFTER AT END) - * but a FS 23 is raised instead. - READ INFILE INTO WSINREC - END-READ - - IF WSFS = '46' - DISPLAY "2nd Read on missing optional file = " WSFS " OK" - ELSE - DISPLAY "2nd Read on missing optional file = " WSFS " Bad" - END-IF. - - CLOSE INFILE - STOP RUN. -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) - -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], -[1st Read on missing optional file = 10 OK -2nd Read on missing optional file = 46 OK -], []) - -AT_CLEANUP - - -AT_SETUP([SELECT with ASSIGN in LINKAGE]) -AT_KEYWORDS([runfile FILE-CONTROL]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - - ENVIRONMENT DIVISION. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 f-path PIC X(80) VALUE "fooasg.txt". - 01 x-path PIC X(80) VALUE "foxasg.txt". - 01 y-path PIC X(80) VALUE "foyasg.txt". - 01 REC1 PIC 9(4) VALUE 1. - 01 REC2 PIC 9(4) VALUE 2. - 01 CUST-STAT PIC X(2) VALUE "XX". - - PROCEDURE DIVISION. - CALL "TSTOPN" USING OMITTED. - CALL "TSTOPN" USING y-path. - CALL "TSTOPEN" USING f-path REC1 CUST-STAT. - CALL "TSTOPEN" USING x-path REC1 CUST-STAT. - CALL "TSTOPEN" USING OMITTED REC1 CUST-STAT. - CALL "TSTOPEN" USING f-path REC2 CUST-STAT. - CALL "TSTOPEN" USING x-path REC2 CUST-STAT. - STOP RUN. - END PROGRAM prog. - - IDENTIFICATION DIVISION. - PROGRAM-ID. TSTOPEN. - - ENVIRONMENT DIVISION. - INPUT-OUTPUT SECTION. - FILE-CONTROL. - SELECT f ASSIGN s-path - ORGANIZATION RELATIVE - ACCESS IS RANDOM - RELATIVE KEY IS REC-NUM - FILE STATUS IS CUST-STAT. - - DATA DIVISION. - FILE SECTION. - FD f. - 01 f-line PIC X(79). - - WORKING-STORAGE SECTION. - 01 z-path PIC X(80) VALUE "foozzz.txt". - - LINKAGE SECTION. - 01 s-path PIC X(80). - 01 REC-NUM PIC 9(4). - 01 CUST-STAT PIC X(2). - - PROCEDURE DIVISION USING s-path, REC-NUM, CUST-STAT. - IF ADDRESS OF s-path = NULL - SET ADDRESS OF s-path TO ADDRESS OF z-path - END-IF. - IF REC-NUM > 1 - OPEN I-O f - DISPLAY "Extend file: " s-path(1:10) - " - " CUST-STAT " #" REC-NUM "." - ELSE - OPEN OUTPUT f - DISPLAY "Output file: " s-path(1:10) - " - " CUST-STAT " #" REC-NUM "." - END-IF. - IF CUST-STAT NOT = "00" - DISPLAY "Opened error: " CUST-STAT "." - GOBACK - END-IF. - MOVE "Hello World" TO f-line. - MOVE REC-NUM TO f-line (20:4). - WRITE f-line. - IF CUST-STAT NOT = "00" - DISPLAY "WRITE error: " CUST-STAT "." - END-IF. - CLOSE f. - GOBACK. - END PROGRAM TSTOPEN. - - IDENTIFICATION DIVISION. - PROGRAM-ID. TSTOPN. - - ENVIRONMENT DIVISION. - INPUT-OUTPUT SECTION. - FILE-CONTROL. - SELECT f ASSIGN b-path - ORGANIZATION LINE SEQUENTIAL - FILE STATUS IS IO-STS. - - DATA DIVISION. - FILE SECTION. - FD f. - 01 f-line PIC X(80). - - WORKING-STORAGE SECTION. - 01 IO-STS PIC X(2) VALUE "00". - 01 b-path PIC X(80) BASED. - - LINKAGE SECTION. - 01 s-path PIC X(80). - - PROCEDURE DIVISION USING s-path. - SET ADDRESS OF b-path TO ADDRESS OF s-path - OPEN OUTPUT f - IF IO-STS NOT = "00" - DISPLAY "Opened error: " IO-STS "." - GOBACK - END-IF. - DISPLAY "Opened file: " s-path(1:10) ".". - MOVE "Hello World" TO f-line. - WRITE f-line. - CLOSE f. - GOBACK. - END PROGRAM TSTOPN. -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) - -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], -[Opened error: 31. -Opened file: foyasg.txt. -Output file: fooasg.txt - 00 #0001. -Output file: foxasg.txt - 00 #0001. -Output file: foozzz.txt - 00 #0001. -Extend file: fooasg.txt - 00 #0002. -Extend file: foxasg.txt - 00 #0002. -], []) - -AT_CLEANUP - - -AT_SETUP([INDEXED File Variable len record]) -AT_KEYWORDS([runfile]) - -AT_SKIP_IF([test "$COB_HAS_ISAM" = "no"]) - -AT_DATA([prog.cob], [ - Identification division. - Program-id. tb is initial program. - * - Environment division. - Configuration section. - * - Source-computer. GNU-Cobol. - Object-computer. GNU-Cobol. - - Special-names. - * - * Display x upon std-out, to get 1>file1.txt. - console is std-out - * Display x upon std-err, to get 2>file2.txt - syserr is std-err - . - - Input-output section. - File-control. - * - Select optional tbw - assign to path-tbw - organization is indexed - access mode is dynamic - record key is tbw-key - alternate record key is tbw-alt - suppress when space - sharing with no other - file status is fs-file-status. - * - I-o-control. - * - Data division. - File section. - * - FD tbw - record is varying in size - from 107 to 362 characters - depending on end-tbw-record - . - 01 tbw-record. - 02 tbw-key pic x(100). - 02 tbw-alt. - 03 tbw-alt-1 pic 9(02). - 03 tbw-alt-2 pic 9(04). - 02 tbw-f1 pic x(01). - 02 tbw-f2 pic x(255). - * - Working-storage section. - - 01 fs-file-status pic x(02). - - 01 end-tbw-record pic 9(09) binary. - - 01 flag-tbw pic x(01) value low-value. - 88 flag-tbw-open value high-value. - 88 flag-tbw-closed value low-value. - - 01 path-tbw pic x(255) value space. - - Procedure division. - - * Prepare. - Move "tbw" to path-tbw. - - * First test. - Perform tbw-delete-file thru tbw-exit. - - Perform tbw-open-i-o thru tbw-exit. - - Move low-values to tbw-key. - Perform tbw-start-primary-greater thru tbw-exit. - - Perform tbw-read-next thru tbw-exit. - - Move 122 to end-tbw-record. - Move "aaaaa" to tbw-key. - Move spaces to tbw-alt - tbw-f1 - tbw-f2. - Perform tbw-write thru tbw-exit. - - Move low-values to tbw-alt. - Perform tbw-start-alternate thru tbw-exit. - - Move low-values to tbw-key. - Perform tbw-start-primary-greater thru tbw-exit. - - Perform tbw-read-next thru tbw-exit. - - Perform tbw-read-next thru tbw-exit. - - * Second test. - Perform tbw-close thru tbw-exit. - - Perform tbw-delete-file thru tbw-exit. - - Perform tbw-open-i-o thru tbw-exit. - - Move low-values to tbw-key. - Perform tbw-start-primary-greater thru tbw-exit. - - Perform tbw-read-next thru tbw-exit. - - Move 163 to end-tbw-record. - Move "aaaaa" to tbw-key. - Move 1 to tbw-alt-1 - tbw-alt-2. - Move spaces to tbw-f1 - tbw-f2. - Perform tbw-write thru tbw-exit. - - Move 122 to end-tbw-record. - Move "aaaab" to tbw-key. - Move spaces to tbw-alt - tbw-f1 - tbw-f2. - Perform tbw-write thru tbw-exit. - - Move low-values to tbw-alt. - Perform tbw-start-alternate thru tbw-exit. - - Perform tbw-read-next thru tbw-exit. - - Move spaces to tbw-alt. - Perform tbw-rewrite thru tbw-exit. - - * Finish. - Perform tbw-close thru tbw-exit. - Display "Test completed". - Stop run. - - * I/O. - tbw-Open-I-O. - If flag-tbw-open - Perform tbw-Close thru tbw-Close-exit - end-if. - Display "open". - Open i-o tbw. - Display "open". - If fs-file-status is less than "10" - Set flag-tbw-open to true - end-if. - Go to tbw-exit. - * - tbw-Start-Primary-Greater. - Display "start > tbw-key". - Start tbw - key is greater than tbw-key - invalid key Continue - end-start. - Display "start > tbw-key". - Go to tbw-exit. - * - tbw-Start-Alternate. - Display "start >= tbw-alt". - Start tbw - key is not less than tbw-alt - invalid key Continue - end-start. - Display "start >= tbw-alt". - Go to tbw-exit. - * - tbw-Read-Next. - Display "read next". - Read tbw - next record - at end Continue - end-read. - Display "read next done". - Go to tbw-exit. - * - tbw-Write. - Display "write". - Write tbw-record - invalid key Continue - end-write. - Display "write". - Go to tbw-exit. - * - tbw-Rewrite. - Display "rewrite". - Rewrite tbw-record - invalid key Continue - end-rewrite. - Display "rewrite " fs-file-status. - Go to tbw-exit. - * - tbw-Delete-File. - If flag-tbw-open - Perform tbw-Close thru tbw-Close-exit - end-if. - Move "xx" to fs-file-status. - Display "delete file". - Delete file tbw - end-delete. - Display "delete file". - Go to tbw-exit. - * - tbw-Close. - If flag-tbw-open - Display "close" - Close tbw - Display "close" - Set flag-tbw-closed to true - end-if. - tbw-Close-exit. - Exit. - tbw-exit. - Exit. -]) - -# CHECKME: do we need -std=mf here? -AT_CHECK([$COMPILE -std=mf prog.cob], [0], [], []) - -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [delete file -delete file -open -open -start > tbw-key -start > tbw-key -read next -read next done -write -write -start >= tbw-alt -start >= tbw-alt -start > tbw-key -start > tbw-key -read next -read next done -read next -read next done -close -close -delete file -delete file -open -open -start > tbw-key -start > tbw-key -read next -read next done -write -write -write -write -start >= tbw-alt -start >= tbw-alt -read next -read next done -rewrite -rewrite 00 -close -close -Test completed -], []) - -AT_CLEANUP - - -AT_SETUP([GC LINE SEQUENTIAL Long-Record]) -AT_KEYWORDS([runfile]) - -AT_DATA([inp_data], -[Record 1................................X....... -Record 2.....................X -Record 3................................X... -]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - INPUT-OUTPUT SECTION. - FILE-CONTROL. - SELECT INFILE ASSIGN TO EXTERNAL INFILE - ORGANIZATION IS LINE SEQUENTIAL - FILE STATUS IS INPUT-STATUS . - - SELECT OUTFILE ASSIGN TO EXTERNAL OUTFILE - ORGANIZATION IS LINE SEQUENTIAL - FILE STATUS IS INPUT-STATUS . - - DATA DIVISION. - FILE SECTION. - FD INFILE - RECORD IS VARYING IN SIZE FROM 18 TO 40 CHARACTERS - DEPENDING ON INPUT-LEN - . - 01 INPUT-REC PIC X(40). - - FD OUTFILE - RECORD IS VARYING IN SIZE FROM 18 TO 40 CHARACTERS - DEPENDING ON INPUT-LEN - . - 01 OUTPUT-REC PIC X(40). - - WORKING-STORAGE SECTION. - - 01 OUTPUT-FILE PIC X(19) VALUE 'TEST-FILE'. - 01 INPUT-FILE PIC X(19) VALUE 'TEST-INP'. - 01 INPUT-STATUS PIC XX. - 01 INPUT-LEN PIC 999 VALUE 18 . - - PROCEDURE DIVISION. - A000-BEGIN. - OPEN INPUT INFILE. - READ INFILE - DISPLAY " Read 1: STATUS IS " INPUT-STATUS - " LENGTH IS " INPUT-LEN - DISPLAY " :" INPUT-REC ":" - READ INFILE - DISPLAY " Read 2: STATUS IS " INPUT-STATUS - " LENGTH IS " INPUT-LEN - DISPLAY " :" INPUT-REC ":" - MOVE 0 TO INPUT-LEN - READ INFILE - DISPLAY " Read 3: STATUS IS " INPUT-STATUS - " LENGTH IS " INPUT-LEN - DISPLAY " :" INPUT-REC ":" - MOVE SPACES TO INPUT-REC - MOVE 0 TO INPUT-LEN - READ INFILE - DISPLAY " Read 4: STATUS IS " INPUT-STATUS - " LENGTH IS " INPUT-LEN - IF INPUT-STATUS = "00" - DISPLAY " :" INPUT-REC ":" - END-IF - CLOSE INFILE - - OPEN OUTPUT OUTFILE - MOVE 9 TO INPUT-LEN - MOVE "Record 1............." TO OUTPUT-REC - WRITE OUTPUT-REC - DISPLAY "Write 1: STATUS IS " INPUT-STATUS - " LENGTH IS " INPUT-LEN - UPON CONSOLE - MOVE 64 TO INPUT-LEN - MOVE ALL '.' TO OUTPUT-REC - MOVE "Record 2" TO OUTPUT-REC (1:8) - WRITE OUTPUT-REC - DISPLAY "Write 2: STATUS IS " INPUT-STATUS - " LENGTH IS " INPUT-LEN - UPON CONSOLE - CLOSE OUTFILE - STOP RUN. -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) - -AT_CHECK([export DD_INFILE=./inp_data -export OUTFILE=TEST-FILE -./prog], [0], [ Read 1: STATUS IS 00 LENGTH IS 040 - :Record 1................................: - Read 2: STATUS IS 00 LENGTH IS 030 - :Record 2.....................X : - Read 3: STATUS IS 00 LENGTH IS 040 - :Record 3................................: - Read 4: STATUS IS 10 LENGTH IS 000 -Write 1: STATUS IS 00 LENGTH IS 009 -Write 2: STATUS IS 00 LENGTH IS 064 -], []) - - -AT_CAPTURE_FILE(./TEST-FILE) - -AT_DATA([reference], -[Record 1. -Record 2................................ -]) - -AT_CHECK([gcdiff reference TEST-FILE], [0], [], []) - -AT_CLEANUP - - -AT_SETUP([MF LINE SEQUENTIAL Long-Record]) -AT_KEYWORDS([runfile]) - -AT_DATA([inp_data], -[Record 1................................X....... -Record 2.....................X -Record 3................................X... -]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - INPUT-OUTPUT SECTION. - FILE-CONTROL. - SELECT INFILE ASSIGN TO EXTERNAL INFILE - ORGANIZATION IS LINE SEQUENTIAL - FILE STATUS IS INPUT-STATUS . - - SELECT OUTFILE ASSIGN TO EXTERNAL OUTFILE - ORGANIZATION IS LINE SEQUENTIAL - FILE STATUS IS INPUT-STATUS . - - DATA DIVISION. - FILE SECTION. - FD INFILE - RECORD IS VARYING IN SIZE FROM 18 TO 40 CHARACTERS - DEPENDING ON INPUT-LEN - . - 01 INPUT-REC PIC X(40). - - FD OUTFILE - RECORD IS VARYING IN SIZE FROM 18 TO 40 CHARACTERS - DEPENDING ON INPUT-LEN - . - 01 OUTPUT-REC PIC X(40). - - WORKING-STORAGE SECTION. - - 01 OUTPUT-FILE PIC X(19) VALUE 'TEST-FILE'. - 01 INPUT-FILE PIC X(19) VALUE 'TEST-INP'. - 01 INPUT-STATUS PIC XX. - 01 INPUT-LEN PIC 999 VALUE 18 . - - PROCEDURE DIVISION. - A000-BEGIN. - OPEN INPUT INFILE. - READ INFILE - DISPLAY " Read 1: STATUS IS " INPUT-STATUS - " LENGTH IS " INPUT-LEN - DISPLAY " :" INPUT-REC ":" - READ INFILE - DISPLAY " Read 2: STATUS IS " INPUT-STATUS - " LENGTH IS " INPUT-LEN - DISPLAY " :" INPUT-REC ":" - MOVE 0 TO INPUT-LEN - READ INFILE - DISPLAY " Read 3: STATUS IS " INPUT-STATUS - " LENGTH IS " INPUT-LEN - DISPLAY " :" INPUT-REC ":" - MOVE SPACES TO INPUT-REC - MOVE 0 TO INPUT-LEN - READ INFILE - DISPLAY " Read 4: STATUS IS " INPUT-STATUS - " LENGTH IS " INPUT-LEN - IF INPUT-STATUS = "00" - DISPLAY " :" INPUT-REC ":" - END-IF - CLOSE INFILE - - OPEN OUTPUT OUTFILE - MOVE 9 TO INPUT-LEN - MOVE "Record 1............." TO OUTPUT-REC - WRITE OUTPUT-REC - DISPLAY "Write 1: STATUS IS " INPUT-STATUS - " LENGTH IS " INPUT-LEN - UPON CONSOLE - MOVE 64 TO INPUT-LEN - MOVE ALL '.' TO OUTPUT-REC - MOVE "Record 2" TO OUTPUT-REC (1:8) - WRITE OUTPUT-REC - DISPLAY "Write 2: STATUS IS " INPUT-STATUS - " LENGTH IS " INPUT-LEN - UPON CONSOLE - CLOSE OUTFILE - STOP RUN. -]) - -# FIXME: must work with -std=mf alone --> -fmf-files split and included as configuration options! -# AT_CHECK([$COMPILE -std=mf prog.cob], [0], [], []) -AT_CHECK([$COMPILE -std=mf -fmf-files prog.cob], [0], [], []) - -AT_CHECK([export DD_INFILE=./inp_data -export OUTFILE=TEST-FILE -$COBCRUN_DIRECT ./prog], [0], -[ Read 1: STATUS IS 00 LENGTH IS 040 - :Record 1................................: - Read 2: STATUS IS 00 LENGTH IS 008 - :X....... : - Read 3: STATUS IS 00 LENGTH IS 030 - :Record 2.....................X : - Read 4: STATUS IS 00 LENGTH IS 040 - :Record 3................................: -Write 1: STATUS IS 00 LENGTH IS 009 -Write 2: STATUS IS 00 LENGTH IS 064 -], []) - - -AT_CAPTURE_FILE(./TEST-FILE) - -AT_DATA([reference], -[Record 1. -Record 2................................ -]) - -AT_CHECK([gcdiff reference TEST-FILE], [0], [], []) - -AT_CLEANUP - - -AT_SETUP([Indexed with FH--FCD]) -AT_KEYWORDS([FH--FCD]) - -AT_SKIP_IF([test "$COB_HAS_ISAM" = "no"]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - - PROGRAM-ID. prog. - - ENVIRONMENT DIVISION. - CONFIGURATION SECTION. - - $set fcdreg - INPUT-OUTPUT SECTION. - FILE-CONTROL. - SELECT TSPFILE - ASSIGN TO "mytstisam" - ORGANIZATION INDEXED ACCESS DYNAMIC - RECORD KEY IS PRIME-KEY - SOURCE IS CM-CUST-NUM - - ALTERNATE RECORD KEY IS SPLIT-KEY2 - SOURCE IS CM-TELEPHONE,CM-MACHINE - * WITH DUPLICATES - - ALTERNATE RECORD KEY IS SPLIT-KEY3 - SOURCE IS CM-DISK,CM-TAPE - * WITH DUPLICATES - * SUPPRESS WHEN ALL "*" - FILE STATUS IS CUST-STAT - . - - DATA DIVISION. - FILE SECTION. - FD TSPFILE - BLOCK CONTAINS 5 RECORDS. - - 01 TSPFL-RECORD. - 05 TSPFL-REC. - 10 CM-CUST-NUM. - 15 CM-CUST-PRE PICTURE X(3). - 15 CM-CUST-NNN PICTURE X(5). - 10 CM-STATUS PICTURE X. - 10 CM-COMPANY PICTURE X(25). - 10 CM-ADDRESS-1 PICTURE X(25). - 10 CM-ADDRESS-2 PICTURE X(25). - 10 CM-ADDRESS-3 PICTURE X(25). - 10 CM-TELEPHONE PICTURE 9(10). - 10 CM-DP-MGR PICTURE X(25). - 10 CM-MACHINE PICTURE X(8). - 10 CM-MEMORY PICTURE X(4). - 10 CM-DISK PICTURE X(8). - 10 CM-TAPE PICTURE X(8). - 10 CM-NO-TERMINALS PICTURE 9(5). - - WORKING-STORAGE SECTION. - 01 CUST-STAT. - 05 STAT-1 PICTURE 9(4) COMP SYNC. - 05 FILLER REDEFINES STAT-1. - 10 STAT-X1 PIC X COMP-X. - 10 STAT-X2 PIC X COMP-X. - 77 BYTE-1 PICTURE 9(3). - 77 BYTE-2 PICTURE 9(3). - 77 MAX-SUB VALUE 16 PICTURE 9(2). - 77 IDX PICTURE 9. - 77 IDX2 PICTURE 9. - 77 OUT-FILE-NAME PICTURE X(9) - VALUE "myextisam". - - 01 TEST-DATA. - - 02 DATA-CUST-NUM-TBL. - - 05 FILLER PIC X(8) VALUE "ALP00000". - 05 FILLER PIC X(8) VALUE "BET00000". - 05 FILLER PIC X(8) VALUE "GAM00000". - 05 FILLER PIC X(8) VALUE "DEL00000". - 05 FILLER PIC X(8) VALUE "EPS00000". - 05 FILLER PIC X(8) VALUE "FOR00000". - 05 FILLER PIC X(8) VALUE "GIB00000". - 05 FILLER PIC X(8) VALUE "H&J00000". - 05 FILLER PIC X(8) VALUE "INC00000". - 05 FILLER PIC X(8) VALUE "JOH00000". - 05 FILLER PIC X(8) VALUE "KON00000". - 05 FILLER PIC X(8) VALUE "LEW00000". - 05 FILLER PIC X(8) VALUE "MOR00000". - 05 FILLER PIC X(8) VALUE "NEW00000". - 05 FILLER PIC X(8) VALUE "OLD00000". - 05 FILLER PIC X(8) VALUE "PRE00000". - - 02 DATA-CUST-NUM REDEFINES DATA-CUST-NUM-TBL - PIC X(8) OCCURS 16. - 02 DATA-COMPANY-TBL. - - 05 FILLER PIC X(25) VALUE "ALPHA ELECTRICAL CO. LTD.". - 05 FILLER PIC X(25) VALUE "BETA SHOE MFG. INC. ". - 05 FILLER PIC X(25) VALUE "GAMMA X-RAY TECHNOLOGY ". - 05 FILLER PIC X(25) VALUE "DELTA LUGGAGE REPAIRS ". - 05 FILLER PIC X(25) VALUE "EPSILON EQUIPMENT SUPPLY ". - 05 FILLER PIC X(25) VALUE "FORTUNE COOKIE COMPANY ". - 05 FILLER PIC X(25) VALUE "GIBRALTER LIFE INSURANCE ". - 05 FILLER PIC X(25) VALUE "H & J PLUMBING SUPPLIES ". - 05 FILLER PIC X(25) VALUE "INCREMENTAL BACKUP CORP. ". - 05 FILLER PIC X(25) VALUE "JOHNSON BOATING SUPPLIES ". - 05 FILLER PIC X(25) VALUE "KONFLAB PLASTIC PRODUCTS.". - 05 FILLER PIC X(25) VALUE "LEWISTON GRAPHICS LTD. ". - 05 FILLER PIC X(25) VALUE "MORNINGSIDE CARPENTRY. ". - 05 FILLER PIC X(25) VALUE "NEW WAVE SURF SHOPS INC. ". - 05 FILLER PIC X(25) VALUE "OLD TYME PIZZA MFG. CO. ". - 05 FILLER PIC X(25) VALUE "PRESTIGE OFFICE FURNITURE". - - 02 DATA-COMPANY REDEFINES DATA-COMPANY-TBL - PIC X(25) OCCURS 16. - 02 DATA-ADDRESS-1-TBL. - - 05 FILLER PIC X(25) VALUE "123 MAIN STREET ". - 05 FILLER PIC X(25) VALUE "1090 2ND AVE. WEST ". - 05 FILLER PIC X(25) VALUE "1401 JEFFERSON BLVD. ". - 05 FILLER PIC X(25) VALUE "1620 ARIZONA WAY ". - 05 FILLER PIC X(25) VALUE "1184 EAST FIRST STREET ". - 05 FILLER PIC X(25) VALUE "114 JOHN F. KENNEDY AVE. ". - 05 FILLER PIC X(25) VALUE "650 LIBERTY CRESCENT ". - 05 FILLER PIC X(25) VALUE "77 SUNSET BLVD. ". - 05 FILLER PIC X(25) VALUE "10908 SANTA MONICA BLVD. ". - 05 FILLER PIC X(25) VALUE "1134 PARIS ROAD ". - 05 FILLER PIC X(25) VALUE "808 NORTHWEST MAIN ST. ". - 05 FILLER PIC X(25) VALUE "9904 QUEEN STREET ". - 05 FILLER PIC X(25) VALUE "1709 DUNDAS CRESCENT W. ". - 05 FILLER PIC X(25) VALUE "3240 MARIS AVENUE ". - 05 FILLER PIC X(25) VALUE "1705 WISCONSIN ROAD ". - 05 FILLER PIC X(25) VALUE "114A MAPLE GROVE ". - - 02 DATA-ADDRESS-1 REDEFINES DATA-ADDRESS-1-TBL - PIC X(25) OCCURS 16. - 02 DATA-ADDRESS-2-TBL. - - 05 FILLER PIC X(10) VALUE "NEW YORK ". - 05 FILLER PIC X(10) VALUE "ATLANTA ". - 05 FILLER PIC X(10) VALUE "WASHINGTON". - 05 FILLER PIC X(10) VALUE "TORONTO ". - 05 FILLER PIC X(10) VALUE "CALGARY ". - 05 FILLER PIC X(10) VALUE "SAN DIEGO ". - 05 FILLER PIC X(10) VALUE "LOS RIOS ". - 05 FILLER PIC X(10) VALUE "MADISON ". - 05 FILLER PIC X(10) VALUE "WILBUR ". - 05 FILLER PIC X(10) VALUE "TOPEKA ". - 05 FILLER PIC X(10) VALUE "SEATTLE ". - 05 FILLER PIC X(10) VALUE "NEW JERSEY". - 05 FILLER PIC X(10) VALUE "FORT WAYNE". - 05 FILLER PIC X(10) VALUE "COLUMBUS ". - 05 FILLER PIC X(10) VALUE "RICHMOND ". - 05 FILLER PIC X(10) VALUE "WHITEPLAIN". - - 02 DATA-ADDRESS-2 REDEFINES DATA-ADDRESS-2-TBL - PIC X(10) OCCURS 16. - 02 DATA-ADDRESS-3-TBL. - - 05 FILLER PIC X(10) VALUE "N.Y. ". - 05 FILLER PIC X(10) VALUE "GEORGIA ". - 05 FILLER PIC X(10) VALUE "D.C. ". - 05 FILLER PIC X(10) VALUE "CANADA ". - 05 FILLER PIC X(10) VALUE "CANADA ". - 05 FILLER PIC X(10) VALUE "CALIFORNIA". - 05 FILLER PIC X(10) VALUE "NEW MEXICO". - 05 FILLER PIC X(10) VALUE "WISCONSIN ". - 05 FILLER PIC X(10) VALUE "DELAWARE ". - 05 FILLER PIC X(10) VALUE "KANSAS ". - 05 FILLER PIC X(10) VALUE "WASHINGTON". - 05 FILLER PIC X(10) VALUE "N.J. ". - 05 FILLER PIC X(10) VALUE "COLORADO ". - 05 FILLER PIC X(10) VALUE "OHIO ". - 05 FILLER PIC X(10) VALUE "VIRGINIA ". - 05 FILLER PIC X(10) VALUE "N.Y. ". - - 02 DATA-ADDRESS-3 REDEFINES DATA-ADDRESS-3-TBL - PIC X(10) OCCURS 16. - 02 DATA-TELEPHONE-TBL. - - 05 FILLER PIC 9(10) VALUE 3131234432. - 05 FILLER PIC 9(10) VALUE 4082938498. - 05 FILLER PIC 9(10) VALUE 8372487274. - 05 FILLER PIC 9(10) VALUE 4169898509. - 05 FILLER PIC 9(10) VALUE 5292398745. - 05 FILLER PIC 9(10) VALUE 8009329492. - 05 FILLER PIC 9(10) VALUE 6456445643. - 05 FILLER PIC 9(10) VALUE 6546456333. - 05 FILLER PIC 9(10) VALUE 3455445444. - 05 FILLER PIC 9(10) VALUE 6456445643. - 05 FILLER PIC 9(10) VALUE 7456434355. - 05 FILLER PIC 9(10) VALUE 6554456433. - 05 FILLER PIC 9(10) VALUE 4169898509. - 05 FILLER PIC 9(10) VALUE 7534587453. - 05 FILLER PIC 9(10) VALUE 8787458374. - 05 FILLER PIC 9(10) VALUE 4169898509. - - 02 DATA-TELEPHONE REDEFINES DATA-TELEPHONE-TBL - PIC 9(10) OCCURS 16. - 02 DATA-DP-MGR-TBL. - - 05 FILLER PIC X(20) VALUE "MR. DAVE HARRIS ". - 05 FILLER PIC X(20) VALUE "MS. JANICE SILCOX ". - 05 FILLER PIC X(20) VALUE "MR. ALLAN JONES ". - 05 FILLER PIC X(20) VALUE "MR. PETER MACKAY ". - 05 FILLER PIC X(20) VALUE "MRS. DONNA BREWER ". - 05 FILLER PIC X(20) VALUE "MR. MICHAEL SMYTHE ". - 05 FILLER PIC X(20) VALUE "MR. D.A. MORRISON ". - 05 FILLER PIC X(20) VALUE "MR. BRIAN PATTERSON ". - 05 FILLER PIC X(20) VALUE "MR. DARRYL TOWNSEND ". - 05 FILLER PIC X(20) VALUE "MS. VALERIE HARPER ". - 05 FILLER PIC X(20) VALUE "MR. FRED MILLER ". - 05 FILLER PIC X(20) VALUE "MR. DONALD FISCHER ". - 05 FILLER PIC X(20) VALUE "MR. STEVEN YOURDIN ". - 05 FILLER PIC X(20) VALUE "MS. Goldie Hawn ". - 05 FILLER PIC X(20) VALUE "MS. ALICE WINSTON ". - 05 FILLER PIC X(20) VALUE "MR. THOMAS JEFFERSON". - - 02 DATA-DP-MGR REDEFINES DATA-DP-MGR-TBL - PIC X(20) OCCURS 16. - 02 DATA-MACHINE-TBL. - - 05 FILLER PIC X(8) VALUE "UNI-9030". - 05 FILLER PIC X(8) VALUE "UNI-9040". - 05 FILLER PIC X(8) VALUE "UNI-80/3". - 05 FILLER PIC X(8) VALUE "UNI-80/5". - 05 FILLER PIC X(8) VALUE "UNI-80/6". - 05 FILLER PIC X(8) VALUE "UNI-80/6". - 05 FILLER PIC X(8) VALUE "UNI-80/6". - 05 FILLER PIC X(8) VALUE "UNI-80/8". - 05 FILLER PIC X(8) VALUE "UNI-80/8". - 05 FILLER PIC X(8) VALUE "UNI-80/8". - 05 FILLER PIC X(8) VALUE "UNI-80/8". - 05 FILLER PIC X(8) VALUE "UNI-80/8". - 05 FILLER PIC X(8) VALUE "UNI-80/8". - 05 FILLER PIC X(8) VALUE "UNI-80/8". - 05 FILLER PIC X(8) VALUE "UNI-9040". - 05 FILLER PIC X(8) VALUE "UNI-9040". - - 02 DATA-MACHINE REDEFINES DATA-MACHINE-TBL - PIC X(8) OCCURS 16. - 02 DATA-NO-TERMINALS-TBL. - - 05 FILLER PIC 9(3) COMP-3 VALUE 85. - 05 FILLER PIC 9(3) COMP-3 VALUE 34. - 05 FILLER PIC 9(3) COMP-3 VALUE 75. - 05 FILLER PIC 9(3) COMP-3 VALUE 45. - 05 FILLER PIC 9(3) COMP-3 VALUE 90. - 05 FILLER PIC 9(3) COMP-3 VALUE 107. - 05 FILLER PIC 9(3) COMP-3 VALUE 67. - 05 FILLER PIC 9(3) COMP-3 VALUE 32. - 05 FILLER PIC 9(3) COMP-3 VALUE 16. - 05 FILLER PIC 9(3) COMP-3 VALUE 34. - 05 FILLER PIC 9(3) COMP-3 VALUE 128. - 05 FILLER PIC 9(3) COMP-3 VALUE 64. - 05 FILLER PIC 9(3) COMP-3 VALUE 110. - 05 FILLER PIC 9(3) COMP-3 VALUE 324. - 05 FILLER PIC 9(3) COMP-3 VALUE 124. - 05 FILLER PIC 9(3) COMP-3 VALUE 86. - - 02 DATA-NO-TERMINALS REDEFINES DATA-NO-TERMINALS-TBL - PIC 9(3) COMP-3 OCCURS 16. - - 01 WORK-AREA. - 05 REC-NUM PICTURE 9(2) VALUE 0. - 05 SUB PICTURE 9(4) COMP SYNC. - 88 ODD-RECORD VALUE 1 3 5 7 9 10 11. - 88 NULL-KEY VALUE 4 5 8 12 14. - - 05 TSPFL-KEY PICTURE X(8). - 05 KC-PTR USAGE POINTER. - - LINKAGE SECTION. - - 01 TSP-FCD. - COPY "xfhfcd.cpy". - - 01 key-def. - 03 kdb-len pic 9(4) comp-x. - 03 filler pic x(4). - 03 key-nkeys pic 9(4) comp-x. - 03 filler pic x(6). - 03 key-defs occurs 1 to 8 times depending on key-nkeys. - 05 key-count pic 9(3) comp-x. - 05 key-offset pic 9(3) comp-x. - 05 key-flags pic X comp-x. - 05 key-compression pic X comp-x. - 05 key-sparse pic x. - 05 filler pic x(9). - - 01 key-comp. - 03 kc-desc pic X comp-x. - 03 kc-type pic X comp-x. - 03 kc-pos pic 9(9) comp-x. - 03 kc-len pic 9(9) comp-x. - - 01 TSP-FILENAME PIC X(256). - PROCEDURE DIVISION. - - MAINFILE. - SET ADDRESS OF TSP-FCD TO ADDRESS OF FH--FCD OF TSPFILE. - SET ADDRESS OF KEY-DEF TO ADDRESS OF FH--KEYDEF OF TSPFILE. - DISPLAY "Other Flags " FCD-OTHER-FLAGS "." - DISPLAY "File has " key-nkeys " keys." - DISPLAY "Key def " kdb-len " bytes." - SET ADDRESS OF TSP-FILENAME TO FCD-FILENAME-ADDRESS. - DISPLAY "File assigned is '" - TSP-FILENAME (1:FCD-NAME-LENGTH) "'". - SET FCD-FILENAME-ADDRESS TO ADDRESS OF OUT-FILE-NAME. - MOVE LENGTH OF OUT-FILE-NAME TO FCD-NAME-LENGTH. - DISPLAY "*** Dump FCD before changes" - PERFORM DUMP-FCD. - MOVE 64 TO KEY-FLAGS (2) - MOVE 66 TO KEY-FLAGS (3) - MOVE '*' TO KEY-SPARSE (3) - DISPLAY "*** Dump FCD after changes" - PERFORM DUMP-FCD. - PERFORM LOADFILE. - PERFORM LISTFILE. - STOP RUN. - - DUMP-FCD. - PERFORM VARYING IDX FROM 1 BY 1 - UNTIL IDX > key-nkeys - IF key-sparse (idx) < ' ' - MOVE ' ' TO key-sparse (idx) - END-IF - DISPLAY "Key" IDX " has " key-count (idx) " parts," - " Offset " key-offset (idx) - " Flags " key-flags (idx) - " Comp " key-compression (idx) - " Sparse " key-sparse (idx) "." - SET KC-PTR TO ADDRESS OF KEY-DEF - SET KC-PTR UP BY key-offset (idx) - PERFORM VARYING IDX2 FROM 1 BY 1 - UNTIL IDX2 > key-count (idx) - SET ADDRESS OF KEY-COMP TO KC-PTR - DISPLAY " Pos " kc-pos " Len " kc-len - SET KC-PTR UP BY LENGTH OF KEY-COMP - END-PERFORM - END-PERFORM. - - LOADFILE. - OPEN OUTPUT TSPFILE - SET ADDRESS OF TSP-FILENAME TO FCD-FILENAME-ADDRESS. - DISPLAY "Loading sample file '" - TSP-FILENAME (1:FCD-NAME-LENGTH) "'" - UPON CONSOLE. - - IF CUST-STAT NOT = "00" - AND CUST-STAT NOT = "05" - DISPLAY "Error " CUST-STAT " opening '" - TSP-FILENAME (1:FCD-NAME-LENGTH) "' file" - UPON CONSOLE - STOP RUN - END-IF. - - PERFORM 1000-LOAD-RECORD - VARYING SUB FROM 1 BY 1 - UNTIL SUB > MAX-SUB. - - DISPLAY "Sample data file load complete." - UPON CONSOLE. - CLOSE TSPFILE. - - *---------------------------------------------------------------* - * LOAD A RECORD FROM DATA TABLES * - *---------------------------------------------------------------* - - 1000-LOAD-RECORD. - - MOVE SPACES TO TSPFL-RECORD. - MOVE DATA-CUST-NUM (SUB) TO CM-CUST-NUM. - MOVE CM-CUST-NUM TO TSPFL-KEY. - MOVE DATA-COMPANY (SUB) TO CM-COMPANY. - MOVE DATA-ADDRESS-1 (SUB) TO CM-ADDRESS-1. - MOVE DATA-ADDRESS-2 (SUB) TO CM-ADDRESS-2. - MOVE DATA-ADDRESS-3 (SUB) TO CM-ADDRESS-3. - MOVE DATA-TELEPHONE (SUB) TO CM-TELEPHONE. - MOVE DATA-DP-MGR (SUB) TO CM-DP-MGR. - MOVE DATA-MACHINE (SUB) TO CM-MACHINE. - MOVE DATA-NO-TERMINALS (SUB) TO CM-NO-TERMINALS. - - IF ODD-RECORD - MOVE "8417" TO CM-DISK - MOVE "1600 BPI" TO CM-TAPE - MOVE "1MEG" TO CM-MEMORY - ELSE - MOVE "8470" TO CM-DISK - MOVE "6250 BPI" TO CM-TAPE - MOVE "3MEG" TO CM-MEMORY. - IF NULL-KEY - MOVE ALL "*" TO CM-DISK - MOVE ALL "*" TO CM-TAPE. - IF SUB = 1 OR 6 - MOVE "2417" TO CM-DISK - MOVE "549 mmm" TO CM-TAPE. - - WRITE TSPFL-RECORD - IF CUST-STAT NOT = "00" - AND CUST-STAT NOT = "02" - DISPLAY "WRITE: " TSPFL-KEY ", Status: " - CUST-STAT UPON CONSOLE - END-IF. - - LISTFILE. - MOVE ZERO TO REC-NUM - OPEN INPUT TSPFILE - SET ADDRESS OF TSP-FILENAME TO FCD-FILENAME-ADDRESS. - DISPLAY "List sample file '" - TSP-FILENAME (1:FCD-NAME-LENGTH) "'" - UPON CONSOLE. - IF CUST-STAT NOT = "00" - DISPLAY "ERROR " CUST-STAT " OPENING INPUT FILE" - UPON CONSOLE - IF CUST-STAT (1:1) = "9" - DISPLAY "Sub Error " STAT-X2 UPON CONSOLE - END-IF - STOP RUN - END-IF. - MOVE SPACES TO TSPFL-RECORD. - START TSPFILE KEY GREATER THAN PRIME-KEY - IF CUST-STAT NOT = "00" - DISPLAY "Error " CUST-STAT " starting file" - UPON CONSOLE - IF CUST-STAT (1:1) = "9" - DISPLAY "Sub Error " STAT-X2 UPON CONSOLE - END-IF - STOP RUN - END-IF. - READ TSPFILE NEXT RECORD WITH NO LOCK - IF CUST-STAT NOT = "00" - DISPLAY "Error " CUST-STAT " on 1st read of file" - UPON CONSOLE - IF CUST-STAT (1:1) = "9" - DISPLAY "Sub Error " STAT-X2 UPON CONSOLE - END-IF - STOP RUN - END-IF. - PERFORM UNTIL CUST-STAT NOT = "00" - OR REC-NUM > MAX-SUB - DISPLAY "Key: " CM-CUST-NUM " is " CM-COMPANY - " Disk=" CM-DISK "." - UPON CONSOLE - READ TSPFILE NEXT RECORD - AT END - MOVE "99" TO CUST-STAT - END-READ - ADD 1 TO REC-NUM - END-PERFORM - IF CUST-STAT = "99" - DISPLAY "Hit End of File after " REC-NUM UPON CONSOLE - END-IF. - - DISPLAY "LIST SAMPLE FILE DESCENDING" UPON CONSOLE. - MOVE ZERO TO REC-NUM - MOVE ALL 'Z' TO TSPFL-RECORD. - START TSPFILE KEY LESS THAN PRIME-KEY - IF CUST-STAT NOT = "00" - DISPLAY "Error " CUST-STAT " starting file" - UPON CONSOLE - STOP RUN - END-IF. - READ TSPFILE PREVIOUS RECORD WITH NO LOCK - IF CUST-STAT NOT = "00" - DISPLAY "Error " CUST-STAT " on 1st read of file" - UPON CONSOLE - STOP RUN - END-IF. - PERFORM UNTIL CUST-STAT NOT = "00" - OR REC-NUM > MAX-SUB - DISPLAY "Key: " CM-CUST-NUM " is " CM-COMPANY - " Disk=" CM-DISK "." - UPON CONSOLE - READ TSPFILE PREVIOUS RECORD - AT END - MOVE "99" TO CUST-STAT - END-READ - ADD 1 TO REC-NUM - END-PERFORM. - IF CUST-STAT = "99" - DISPLAY "Hit End of File after " REC-NUM UPON CONSOLE - END-IF. - - DISPLAY "LIST SAMPLE FILE BY KEY3" UPON CONSOLE. - MOVE ZERO TO REC-NUM - MOVE SPACES TO TSPFL-RECORD. - START TSPFILE KEY GREATER THAN OR EQUAL TO SPLIT-KEY3 - IF CUST-STAT NOT = "00" - AND CUST-STAT NOT = "02" - DISPLAY "Error " CUST-STAT " starting file" - UPON CONSOLE - STOP RUN - END-IF. - READ TSPFILE NEXT RECORD WITH NO LOCK - IF CUST-STAT NOT = "00" - AND CUST-STAT NOT = "02" - DISPLAY "Error " CUST-STAT " on 1st read of file" - UPON CONSOLE - STOP RUN - END-IF. - PERFORM UNTIL (CUST-STAT NOT = "00" - AND CUST-STAT NOT = "02") - OR REC-NUM > MAX-SUB - DISPLAY "Key: " CM-CUST-NUM " is " CM-COMPANY - " Disk=" CM-DISK "." - UPON CONSOLE - READ TSPFILE NEXT RECORD - AT END - MOVE "99" TO CUST-STAT - END-READ - ADD 1 TO REC-NUM - END-PERFORM. - IF CUST-STAT = "99" - DISPLAY "Hit End of File after " REC-NUM UPON CONSOLE - END-IF. - CLOSE TSPFILE. -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) - -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [Other Flags 000. -File has 0003 keys. -Key def 0320 bytes. -File assigned is 'mytstisam' -*** Dump FCD before changes -Key1 has 001 parts, Offset 062 Flags 000 Comp 000 Sparse . - Pos 000000000 Len 000000008 -Key2 has 002 parts, Offset 072 Flags 000 Comp 000 Sparse . - Pos 000000109 Len 000000010 - Pos 000000144 Len 000000008 -Key3 has 002 parts, Offset 092 Flags 000 Comp 000 Sparse . - Pos 000000156 Len 000000008 - Pos 000000164 Len 000000008 -*** Dump FCD after changes -Key1 has 001 parts, Offset 062 Flags 000 Comp 000 Sparse . - Pos 000000000 Len 000000008 -Key2 has 002 parts, Offset 072 Flags 064 Comp 000 Sparse . - Pos 000000109 Len 000000010 - Pos 000000144 Len 000000008 -Key3 has 002 parts, Offset 092 Flags 066 Comp 000 Sparse *. - Pos 000000156 Len 000000008 - Pos 000000164 Len 000000008 -Loading sample file 'myextisam' -Sample data file load complete. -List sample file 'myextisam' -Key: ALP00000 is ALPHA ELECTRICAL CO. LTD. Disk=2417 . -Key: BET00000 is BETA SHOE MFG. INC. Disk=8470 . -Key: DEL00000 is DELTA LUGGAGE REPAIRS Disk=********. -Key: EPS00000 is EPSILON EQUIPMENT SUPPLY Disk=********. -Key: FOR00000 is FORTUNE COOKIE COMPANY Disk=2417 . -Key: GAM00000 is GAMMA X-RAY TECHNOLOGY Disk=8417 . -Key: GIB00000 is GIBRALTER LIFE INSURANCE Disk=8417 . -Key: H&J00000 is H & J PLUMBING SUPPLIES Disk=********. -Key: INC00000 is INCREMENTAL BACKUP CORP. Disk=8417 . -Key: JOH00000 is JOHNSON BOATING SUPPLIES Disk=8417 . -Key: KON00000 is KONFLAB PLASTIC PRODUCTS. Disk=8417 . -Key: LEW00000 is LEWISTON GRAPHICS LTD. Disk=********. -Key: MOR00000 is MORNINGSIDE CARPENTRY. Disk=8470 . -Key: NEW00000 is NEW WAVE SURF SHOPS INC. Disk=********. -Key: OLD00000 is OLD TYME PIZZA MFG. CO. Disk=8470 . -Key: PRE00000 is PRESTIGE OFFICE FURNITURE Disk=8470 . -Hit End of File after 16 -LIST SAMPLE FILE DESCENDING -Key: PRE00000 is PRESTIGE OFFICE FURNITURE Disk=8470 . -Key: OLD00000 is OLD TYME PIZZA MFG. CO. Disk=8470 . -Key: NEW00000 is NEW WAVE SURF SHOPS INC. Disk=********. -Key: MOR00000 is MORNINGSIDE CARPENTRY. Disk=8470 . -Key: LEW00000 is LEWISTON GRAPHICS LTD. Disk=********. -Key: KON00000 is KONFLAB PLASTIC PRODUCTS. Disk=8417 . -Key: JOH00000 is JOHNSON BOATING SUPPLIES Disk=8417 . -Key: INC00000 is INCREMENTAL BACKUP CORP. Disk=8417 . -Key: H&J00000 is H & J PLUMBING SUPPLIES Disk=********. -Key: GIB00000 is GIBRALTER LIFE INSURANCE Disk=8417 . -Key: GAM00000 is GAMMA X-RAY TECHNOLOGY Disk=8417 . -Key: FOR00000 is FORTUNE COOKIE COMPANY Disk=2417 . -Key: EPS00000 is EPSILON EQUIPMENT SUPPLY Disk=********. -Key: DEL00000 is DELTA LUGGAGE REPAIRS Disk=********. -Key: BET00000 is BETA SHOE MFG. INC. Disk=8470 . -Key: ALP00000 is ALPHA ELECTRICAL CO. LTD. Disk=2417 . -Hit End of File after 16 -LIST SAMPLE FILE BY KEY3 -Key: ALP00000 is ALPHA ELECTRICAL CO. LTD. Disk=2417 . -Key: FOR00000 is FORTUNE COOKIE COMPANY Disk=2417 . -Key: GAM00000 is GAMMA X-RAY TECHNOLOGY Disk=8417 . -Key: GIB00000 is GIBRALTER LIFE INSURANCE Disk=8417 . -Key: INC00000 is INCREMENTAL BACKUP CORP. Disk=8417 . -Key: JOH00000 is JOHNSON BOATING SUPPLIES Disk=8417 . -Key: KON00000 is KONFLAB PLASTIC PRODUCTS. Disk=8417 . -Key: BET00000 is BETA SHOE MFG. INC. Disk=8470 . -Key: MOR00000 is MORNINGSIDE CARPENTRY. Disk=8470 . -Key: OLD00000 is OLD TYME PIZZA MFG. CO. Disk=8470 . -Key: PRE00000 is PRESTIGE OFFICE FURNITURE Disk=8470 . -Hit End of File after 11 -], []) - -AT_CLEANUP - -AT_SETUP([PIPE I/O]) -AT_KEYWORDS([PIPE]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - CONFIGURATION SECTION. - - INPUT-OUTPUT SECTION. - FILE-CONTROL. - SELECT PIPEIO - ASSIGN TO PIPE-CMD - ORGANIZATION LINE SEQUENTIAL - FILE STATUS IS CUST-STAT . - - DATA DIVISION. - FILE SECTION. - FD PIPEIO - BLOCK CONTAINS 5 RECORDS. - 01 INP-RECORD PIC X(16). - - WORKING-STORAGE SECTION. - 01 PIPE-CMD PIC X(40). - 01 CUST-STAT PIC XX. - 01 SUB PIC 9(2). - 01 OPRN1 PIC 9(3). - 01 OPRN2 PIC 9(3). - 01 RSLT PIC 9(4). - 01 CMD-LINE. - 05 CMD PICTURE X(8). - 05 FILLER PICTURE X. - 05 CMD-KEY PICTURE X(8). - 01 ADD-LINE. - 05 NUM PICTURE 9(3). - 05 FILLER PICTURE X(8). - - PROCEDURE DIVISION. - - MAINFILE. - ACCEPT CMD-LINE FROM COMMAND-LINE. - IF CMD = 'HELLO' - DISPLAY "Bye Bye" - DISPLAY "Birdie" - STOP RUN - END-IF. - IF CMD = 'ECHO' - ACCEPT CMD-LINE FROM CONSOLE - DISPLAY "Echo: " CMD-LINE ":" - ACCEPT CMD-LINE FROM CONSOLE - DISPLAY "Echo: " CMD-LINE ":" - STOP RUN - END-IF. - IF CMD = 'ADD' - ACCEPT ADD-LINE FROM CONSOLE - MOVE NUM TO OPRN1 - ACCEPT ADD-LINE FROM CONSOLE - MOVE NUM TO OPRN2 - COMPUTE RSLT = OPRN1 + OPRN2 - DISPLAY "Result: " OPRN1 " + " OPRN2 " is " RSLT - STOP RUN - END-IF. - - PERFORM READPIPE. - PERFORM WRITEPIPE. - PERFORM ADD-PIPE. - PERFORM BAD-MODE. - PERFORM BAD-PIPE. - STOP RUN. - - READPIPE. - MOVE "<./prog HELLO" TO PIPE-CMD - DISPLAY "Show input from pipe". - OPEN INPUT PIPEIO. - PERFORM VARYING SUB FROM 1 BY 1 - UNTIL SUB > 50 - OR CUST-STAT NOT = "00" - READ PIPEIO - IF CUST-STAT = '00' - DISPLAY SUB ": " INP-RECORD ":" - END-IF - END-PERFORM. - CLOSE PIPEIO. - - WRITEPIPE. - MOVE ">./prog ECHO " TO PIPE-CMD - DISPLAY "Send data out pipe". - OPEN OUTPUT PIPEIO. - MOVE "Having" TO INP-RECORD - WRITE INP-RECORD. - MOVE "Fun Yet?" TO INP-RECORD - WRITE INP-RECORD. - CLOSE PIPEIO. - - ADD-PIPE. - MOVE "|./prog ADD " TO PIPE-CMD - DISPLAY "Exchange data via pipe". - OPEN I-O PIPEIO. - MOVE "001" TO INP-RECORD - WRITE INP-RECORD. - MOVE "003" TO INP-RECORD - WRITE INP-RECORD. - READ PIPEIO. - DISPLAY "Answer :" INP-RECORD ":" - CLOSE PIPEIO. - - BAD-PIPE. - MOVE "<./saywhat Foobar " TO PIPE-CMD - DISPLAY "Pipe read from unknown program.". - MOVE 'Peek a Boo' TO INP-RECORD - OPEN INPUT PIPEIO. - IF CUST-STAT NOT = '00' - DISPLAY "Bad Open status:" CUST-STAT - ELSE - READ PIPEIO - DISPLAY "Stat:" CUST-STAT ", Answer :" INP-RECORD ":" - CLOSE PIPEIO - END-IF. - MOVE ">./saywhat Foobar " TO PIPE-CMD - DISPLAY "Pipe write to unknown program.". - OPEN INPUT PIPEIO. - IF CUST-STAT NOT = '00' - DISPLAY "Bad Open status:" CUST-STAT - ELSE - MOVE 'Peek a Boo' TO INP-RECORD - WRITE INP-RECORD - DISPLAY "Stat:" CUST-STAT ", Sent :" INP-RECORD ":" - CLOSE PIPEIO - END-IF. - MOVE "|./saywhat Foobar " TO PIPE-CMD - DISPLAY "Pipe to unknown program.". - OPEN I-O PIPEIO. - IF CUST-STAT NOT = '00' - DISPLAY "Bad Open status:" CUST-STAT - ELSE - MOVE "001" TO INP-RECORD - WRITE INP-RECORD - IF CUST-STAT NOT = '00' - DISPLAY "Bad Write status:" CUST-STAT - END-IF - MOVE "003" TO INP-RECORD - WRITE INP-RECORD - READ PIPEIO - IF CUST-STAT NOT = '00' - DISPLAY "Bad Read status:" CUST-STAT - ELSE - DISPLAY "Answer :" INP-RECORD ":" - END-IF - CLOSE PIPEIO - END-IF. - - BAD-MODE. - MOVE "<./prog ECHO " TO PIPE-CMD - DISPLAY "Open pipe output mode mismatch". - OPEN OUTPUT PIPEIO. - IF CUST-STAT NOT = '00' - DISPLAY "Bad Mode Open status:" CUST-STAT - ELSE - MOVE "How did" TO INP-RECORD - WRITE INP-RECORD - MOVE "I get here" TO INP-RECORD - WRITE INP-RECORD - END-IF. - CLOSE PIPEIO. - - MOVE ">./prog HELLO " TO PIPE-CMD - DISPLAY "Open pipe input mode mismatch". - OPEN INPUT PIPEIO. - IF CUST-STAT NOT = '00' - DISPLAY "Bad Mode Open status:" CUST-STAT - ELSE - READ PIPEIO - DISPLAY "Got : " INP-RECORD ":" - CLOSE PIPEIO - END-IF. -]) - -AT_CHECK([$COBC -x -std=default -w prog.cob ], [0], [], []) - -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [Show input from pipe -01: Bye Bye : -02: Birdie : -Send data out pipe -Echo: Having : -Echo: Fun Yet? : -Exchange data via pipe -Answer :Result: 001 + 00: -Open pipe output mode mismatch -Bad Mode Open status:37 -Open pipe input mode mismatch -Bad Mode Open status:37 -Pipe read from unknown program. -Stat:10, Answer :Peek a Boo : -Pipe write to unknown program. -Bad Open status:37 -Pipe to unknown program. -Bad Read status:10 -], [ignore]) - -AT_CLEANUP - -AT_SETUP([LINE SEQUENTIAL one Record]) -AT_KEYWORDS([runfile]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - - ENVIRONMENT DIVISION. - CONFIGURATION SECTION. - - INPUT-OUTPUT SECTION. - FILE-CONTROL. - SELECT FLATFILE ASSIGN EXTERNAL SEQFIX - ORGANIZATION LINE SEQUENTIAL - FILE STATUS IS CUST-STAT . - - DATA DIVISION. - FILE SECTION. - FD FLATFILE - BLOCK CONTAINS 5 RECORDS. - - 01 TSPFL-RECORD. - 10 CM-CUST-NUM PICTURE X(8). - 10 CM-COMPANY PICTURE X(25). - 10 CM-DISK PICTURE X(8). - 10 CM-NO-TERMINALS PICTURE 9(5) COMP-4. - 10 CM-PK-DATE PICTURE S9(14) COMP-3. - 10 CM-TRAILER PICTURE X(52). - - WORKING-STORAGE SECTION. - - 77 MAX-SUB VALUE 6 PICTURE 9(4) COMP SYNC. - 77 CUST-STAT PICTURE X(2). - 77 REC-NUM VALUE 1 PICTURE 9(8) COMP SYNC. - - 01 TEST-DATA. - - 02 DATA-CUST-NUM-TBL. - - 05 FILLER PIC X(8) VALUE "ALP00000". - 05 FILLER PIC X(8) VALUE "BET00000". - 05 FILLER PIC X(8) VALUE "GAM00000". - 05 FILLER PIC X(8) VALUE "DEL00000". - 05 FILLER PIC X(8) VALUE "EPS00000". - 05 FILLER PIC X(8) VALUE "FOR00000". - - 02 DATA-CUST-NUM REDEFINES DATA-CUST-NUM-TBL - PIC X(8) OCCURS 6. - 02 DATA-COMPANY-TBL. - - 05 FILLER PIC X(25) VALUE "ALPHA ELECTRICAL CO. LTD.". - 05 FILLER PIC X(25) VALUE "BETA SHOE MFG. INC. ". - 05 FILLER PIC X(25) VALUE "GAMMA X-RAY TECHNOLOGY ". - 05 FILLER PIC X(25) VALUE "DELTA LUGGAGE REPAIRS ". - 05 FILLER PIC X(25) VALUE "EPSILON EQUIPMENT SUPPLY ". - 05 FILLER PIC X(25) VALUE "FORTUNE COOKIE COMPANY ". - 02 DATA-COMPANY REDEFINES DATA-COMPANY-TBL - PIC X(25) OCCURS 6. - 02 DATA-ADDRESS-2-TBL. - - 05 FILLER PIC X(10) VALUE "NEW YORK ". - 05 FILLER PIC X(10) VALUE "ATLANTA ". - 05 FILLER PIC X(10) VALUE "WASHINGTON". - 05 FILLER PIC X(10) VALUE "TORONTO ". - 05 FILLER PIC X(10) VALUE "CALGARY ". - 05 FILLER PIC X(10) VALUE "WHITEPLAIN". - - 02 DATA-ADDRESS REDEFINES DATA-ADDRESS-2-TBL - PIC X(10) OCCURS 6. - - 02 DATA-NO-TERMINALS-TBL. - - 05 FILLER PIC 9(5) COMP-3 VALUE 8240. - 05 FILLER PIC 9(5) COMP-3 VALUE 10. - 05 FILLER PIC 9(5) COMP-3 VALUE 13. - 05 FILLER PIC 9(5) COMP-3 VALUE 65535. - 05 FILLER PIC 9(5) COMP-3 VALUE 10. - 05 FILLER PIC 9(5) COMP-3 VALUE 254. - - 02 DATA-NO-TERMINALS REDEFINES DATA-NO-TERMINALS-TBL - PIC 9(5) COMP-3 OCCURS 6. - 01 WORK-AREA. - 05 SUB PICTURE 9(4) COMP SYNC. - 88 ODD-RECORD VALUE 1 3 5. - - - PROCEDURE DIVISION. - - PERFORM LOADFILE. - OPEN INPUT FLATFILE. - DISPLAY "Open Sts:" CUST-STAT - PERFORM READ-RECORD - PERFORM READ-RECORD - PERFORM READ-RECORD - PERFORM READ-RECORD - CLOSE FLATFILE. - - OPEN I-O FLATFILE. - PERFORM READ-RECORD - MOVE 10 TO CM-NO-TERMINALS - REWRITE TSPFL-RECORD - DISPLAY "REWRITE " CM-CUST-NUM " Sts " CUST-STAT - " Trms:" CM-NO-TERMINALS. - CLOSE FLATFILE. - - OPEN I-O FLATFILE. - PERFORM READ-RECORD - PERFORM READ-RECORD - ADD 1 TO CM-NO-TERMINALS - REWRITE TSPFL-RECORD - DISPLAY "REWRITE " CM-CUST-NUM " Sts " CUST-STAT - " Trms:" CM-NO-TERMINALS. - PERFORM READ-RECORD - CLOSE FLATFILE. - - OPEN I-O FLATFILE. - READ FLATFILE - READ FLATFILE - READ FLATFILE - READ FLATFILE - READ FLATFILE - DISPLAY "Read " CM-CUST-NUM " Sts:" CUST-STAT. - MOVE 8240 TO CM-NO-TERMINALS - REWRITE TSPFL-RECORD - DISPLAY "REWRITE " CM-CUST-NUM " Sts " CUST-STAT - " Trms:" CM-NO-TERMINALS. - CLOSE FLATFILE. - - OPEN INPUT FLATFILE. - DISPLAY "List back Open Sts:" CUST-STAT - PERFORM UNTIL CUST-STAT NOT = "00" - PERFORM READ-RECORD - END-PERFORM. - CLOSE FLATFILE. - - OPEN EXTEND FLATFILE. - PERFORM LOAD-RECORD - VARYING SUB FROM 1 BY 1 - UNTIL SUB > 2 - CLOSE FLATFILE. - - OPEN INPUT FLATFILE. - DISPLAY "List after extend Open Sts:" CUST-STAT - PERFORM UNTIL CUST-STAT NOT = "00" - PERFORM READ-RECORD - END-PERFORM. - CLOSE FLATFILE. - STOP RUN RETURNING 0. - - READ-RECORD. - MOVE SPACES TO TSPFL-RECORD. - READ FLATFILE - IF CUST-STAT NOT = "00" - DISPLAY "Read Status: " CUST-STAT - ELSE - DISPLAY "Read " CM-CUST-NUM - " Trms:" CM-NO-TERMINALS - END-IF. - - LOADFILE. - DISPLAY "Loading sample program data file." - UPON CONSOLE. - - OPEN OUTPUT FLATFILE. - - PERFORM LOAD-RECORD - VARYING SUB FROM 1 BY 1 - UNTIL SUB > MAX-SUB. - - DISPLAY "Sample program data file load complete." - UPON CONSOLE. - CLOSE FLATFILE. - - LOAD-RECORD. - - MOVE SPACES TO TSPFL-RECORD. - MOVE DATA-CUST-NUM (SUB) TO CM-CUST-NUM. - MOVE DATA-COMPANY (SUB) TO CM-COMPANY. - MOVE DATA-NO-TERMINALS (SUB) TO CM-NO-TERMINALS. - MOVE 20070319 TO CM-PK-DATE. - IF SUB = 5 - MOVE "Freddy Kruger" TO CM-TRAILER. - IF SUB = 1 OR 4 OR 6 - MOVE -20070319 TO CM-PK-DATE. - - IF ODD-RECORD - MOVE "8417" TO CM-DISK - ELSE - MOVE "8470" TO CM-DISK. - WRITE TSPFL-RECORD. - IF CUST-STAT NOT = "00" - DISPLAY "Write Error " CUST-STAT. -]) - -AT_CHECK([$COBC -x -std=mf -w -fmf-files prog.cob ], [0], [], []) - -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [Loading sample program data file. -Sample program data file load complete. -Open Sts:00 -Read ALP00000 Trms:08240 -Read BET00000 Trms:00010 -Read GAM00000 Trms:00013 -Read DEL00000 Trms:65535 -Read ALP00000 Trms:08240 -REWRITE ALP00000 Sts 44 Trms:00010 -Read ALP00000 Trms:08240 -Read BET00000 Trms:00010 -REWRITE BET00000 Sts 00 Trms:00011 -Read GAM00000 Trms:00013 -Read EPS00000 Sts:00 -REWRITE EPS00000 Sts 00 Trms:08240 -List back Open Sts:00 -Read ALP00000 Trms:08240 -Read BET00000 Trms:00011 -Read GAM00000 Trms:00013 -Read DEL00000 Trms:65535 -Read EPS00000 Trms:08240 -Read FOR00000 Trms:00254 -Read Status: 10 -List after extend Open Sts:00 -Read ALP00000 Trms:08240 -Read BET00000 Trms:00011 -Read GAM00000 Trms:00013 -Read DEL00000 Trms:65535 -Read EPS00000 Trms:08240 -Read FOR00000 Trms:00254 -Read ALP00000 Trms:08240 -Read BET00000 Trms:00010 -Read Status: 10 -], []) - -AT_CLEANUP - -AT_SETUP([INDEXED File READ/DELETE/READ]) -AT_KEYWORDS([FileIo]) - -AT_SKIP_IF([test "$COB_HAS_ISAM" = "no"]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - - PROGRAM-ID. prog. - - ENVIRONMENT DIVISION. - CONFIGURATION SECTION. - - INPUT-OUTPUT SECTION. - FILE-CONTROL. - SELECT TSPFILE - ASSIGN TO EXTERNAL TSPFILE - ORGANIZATION INDEXED ACCESS DYNAMIC - RECORD KEY IS CM-CUST-NUM - - ALTERNATE RECORD KEY IS SPLIT-KEY2 - SOURCE IS CM-TELEPHONE WITH DUPLICATES - - ALTERNATE RECORD KEY IS SPLIT-KEY3 - SOURCE IS CM-DISK,CM-TAPE WITH DUPLICATES - * SUPPRESS WHEN ALL "*" - SUPPRESS WHEN "8417" - FILE STATUS IS CUST-STAT - . - - DATA DIVISION. - FILE SECTION. - FD TSPFILE - BLOCK CONTAINS 5 RECORDS. - - 01 TSPFL-RECORD. - 05 TSPFL-REC. - 10 CM-CUST-NUM. - 15 CM-CUST-PRE PICTURE X(3). - 15 CM-CUST-NNN PICTURE X(5). - 10 CM-STATUS PICTURE X. - 10 CM-COMPANY PICTURE X(25). - 10 CM-ADDRESS-1 PICTURE X(25). - 10 CM-ADDRESS-2 PICTURE X(25). - 10 CM-ADDRESS-3 PICTURE X(25). - 10 CM-TELEPHONE PICTURE 9(10). - 10 CM-DP-MGR PICTURE X(25). - 10 CM-MACHINE PICTURE X(8). - 10 CM-MEMORY PICTURE X(4). - 10 CM-DISK PICTURE X(8). - 10 CM-TAPE PICTURE X(8). - 10 CM-NO-TERMINALS PICTURE 9(5). - - WORKING-STORAGE SECTION. - - 01 CUST-STAT. - 05 STAT-1 PICTURE 9(4) COMP SYNC. - 05 FILLER REDEFINES STAT-1. - 10 STAT-X1 PIC X COMP-X. - 10 STAT-X2 PIC X COMP-X. - 77 DATA-STAT PICTURE XX. - 77 ISAM-STAT PICTURE XX. - 77 BYTE-1 PICTURE 9(3). - 77 BYTE-2 PICTURE 9(3). - 77 MAX-SUB VALUE 16 PICTURE 9(5) COMP SYNC. - 77 SAV-KEY PIC X(8). - - 01 TEST-DATA. - - 02 DATA-CUST-NUM-TBL. - - 05 FILLER PIC X(8) VALUE "ALP00000". - 05 FILLER PIC X(8) VALUE "BET00000". - 05 FILLER PIC X(8) VALUE "GAM00000". - 05 FILLER PIC X(8) VALUE "DEL00000". - 05 FILLER PIC X(8) VALUE "EPS00000". - 05 FILLER PIC X(8) VALUE "FOR00000". - 05 FILLER PIC X(8) VALUE "GIB00000". - 05 FILLER PIC X(8) VALUE "H&J00000". - 05 FILLER PIC X(8) VALUE "INC00000". - 05 FILLER PIC X(8) VALUE "JOH00000". - 05 FILLER PIC X(8) VALUE "KON00000". - 05 FILLER PIC X(8) VALUE "LEW00000". - 05 FILLER PIC X(8) VALUE "MOR00000". - 05 FILLER PIC X(8) VALUE "NEW00000". - 05 FILLER PIC X(8) VALUE "OLD00000". - 05 FILLER PIC X(8) VALUE "PRE00000". - - 02 DATA-CUST-NUM REDEFINES DATA-CUST-NUM-TBL - PIC X(8) OCCURS 16. - 02 DATA-COMPANY-TBL. - - 05 FILLER PIC X(25) VALUE "ALPHA ELECTRICAL CO. LTD.". - 05 FILLER PIC X(25) VALUE "BETA SHOE MFG. INC. ". - 05 FILLER PIC X(25) VALUE "GAMMA X-RAY TECHNOLOGY ". - 05 FILLER PIC X(25) VALUE "DELTA LUGGAGE REPAIRS ". - 05 FILLER PIC X(25) VALUE "EPSILON EQUIPMENT SUPPLY ". - 05 FILLER PIC X(25) VALUE "FORTUNE COOKIE COMPANY ". - 05 FILLER PIC X(25) VALUE "GIBRALTER LIFE INSURANCE ". - 05 FILLER PIC X(25) VALUE "H & J PLUMBING SUPPLIES ". - 05 FILLER PIC X(25) VALUE "INCREMENTAL BACKUP CORP. ". - 05 FILLER PIC X(25) VALUE "JOHNSON BOATING SUPPLIES ". - 05 FILLER PIC X(25) VALUE "KONFLAB PLASTIC PRODUCTS.". - 05 FILLER PIC X(25) VALUE "LEWISTON GRAPHICS LTD. ". - 05 FILLER PIC X(25) VALUE "MORNINGSIDE CARPENTRY. ". - 05 FILLER PIC X(25) VALUE "NEW WAVE SURF SHOPS INC. ". - 05 FILLER PIC X(25) VALUE "OLD TYME PIZZA MFG. CO. ". - 05 FILLER PIC X(25) VALUE "PRESTIGE OFFICE FURNITURE". - - 02 DATA-COMPANY REDEFINES DATA-COMPANY-TBL - PIC X(25) OCCURS 16. - 02 DATA-ADDRESS-1-TBL. - - 05 FILLER PIC X(25) VALUE "123 MAIN STREET ". - 05 FILLER PIC X(25) VALUE "1090 2ND AVE. WEST ". - 05 FILLER PIC X(25) VALUE "1401 JEFFERSON BLVD. ". - 05 FILLER PIC X(25) VALUE "1620 ARIZONA WAY ". - 05 FILLER PIC X(25) VALUE "1184 EAST FIRST STREET ". - 05 FILLER PIC X(25) VALUE "114 JOHN F. KENNEDY AVE. ". - 05 FILLER PIC X(25) VALUE "650 LIBERTY CRESCENT ". - 05 FILLER PIC X(25) VALUE "77 SUNSET BLVD. ". - 05 FILLER PIC X(25) VALUE "10908 SANTA MONICA BLVD. ". - 05 FILLER PIC X(25) VALUE "1134 PARIS ROAD ". - 05 FILLER PIC X(25) VALUE "808 NORTHWEST MAIN ST. ". - 05 FILLER PIC X(25) VALUE "9904 QUEEN STREET ". - 05 FILLER PIC X(25) VALUE "1709 DUNDAS CRESCENT W. ". - 05 FILLER PIC X(25) VALUE "3240 MARIS AVENUE ". - 05 FILLER PIC X(25) VALUE "1705 WISCONSIN ROAD ". - 05 FILLER PIC X(25) VALUE "114A MAPLE GROVE ". - - 02 DATA-ADDRESS-1 REDEFINES DATA-ADDRESS-1-TBL - PIC X(25) OCCURS 16. - 02 DATA-ADDRESS-2-TBL. - - 05 FILLER PIC X(10) VALUE "NEW YORK ". - 05 FILLER PIC X(10) VALUE "ATLANTA ". - 05 FILLER PIC X(10) VALUE "WASHINGTON". - 05 FILLER PIC X(10) VALUE "TORONTO ". - 05 FILLER PIC X(10) VALUE "CALGARY ". - 05 FILLER PIC X(10) VALUE "SAN DIEGO ". - 05 FILLER PIC X(10) VALUE "LOS RIOS ". - 05 FILLER PIC X(10) VALUE "MADISON ". - 05 FILLER PIC X(10) VALUE "WILBUR ". - 05 FILLER PIC X(10) VALUE "TOPEKA ". - 05 FILLER PIC X(10) VALUE "SEATTLE ". - 05 FILLER PIC X(10) VALUE "NEW JERSEY". - 05 FILLER PIC X(10) VALUE "FORT WAYNE". - 05 FILLER PIC X(10) VALUE "COLUMBUS ". - 05 FILLER PIC X(10) VALUE "RICHMOND ". - 05 FILLER PIC X(10) VALUE "WHITEPLAIN". - - 02 DATA-ADDRESS-2 REDEFINES DATA-ADDRESS-2-TBL - PIC X(10) OCCURS 16. - 02 DATA-ADDRESS-3-TBL. - - 05 FILLER PIC X(10) VALUE "N.Y. ". - 05 FILLER PIC X(10) VALUE "GEORGIA ". - 05 FILLER PIC X(10) VALUE "D.C. ". - 05 FILLER PIC X(10) VALUE "CANADA ". - 05 FILLER PIC X(10) VALUE "CANADA ". - 05 FILLER PIC X(10) VALUE "CALIFORNIA". - 05 FILLER PIC X(10) VALUE "NEW MEXICO". - 05 FILLER PIC X(10) VALUE "WISCONSIN ". - 05 FILLER PIC X(10) VALUE "DELAWARE ". - 05 FILLER PIC X(10) VALUE "KANSAS ". - 05 FILLER PIC X(10) VALUE "WASHINGTON". - 05 FILLER PIC X(10) VALUE "N.J. ". - 05 FILLER PIC X(10) VALUE "COLORADO ". - 05 FILLER PIC X(10) VALUE "OHIO ". - 05 FILLER PIC X(10) VALUE "VIRGINIA ". - 05 FILLER PIC X(10) VALUE "N.Y. ". - - 02 DATA-ADDRESS-3 REDEFINES DATA-ADDRESS-3-TBL - PIC X(10) OCCURS 16. - 02 DATA-TELEPHONE-TBL. - - 05 FILLER PIC 9(10) VALUE 3131234432. - 05 FILLER PIC 9(10) VALUE 4169898509. - 05 FILLER PIC 9(10) VALUE 8372487274. - 05 FILLER PIC 9(10) VALUE 4169898509. - 05 FILLER PIC 9(10) VALUE 5292398745. - 05 FILLER PIC 9(10) VALUE 8009329492. - 05 FILLER PIC 9(10) VALUE 6456445643. - 05 FILLER PIC 9(10) VALUE 6546456333. - 05 FILLER PIC 9(10) VALUE 3455445444. - 05 FILLER PIC 9(10) VALUE 6456445643. - 05 FILLER PIC 9(10) VALUE 7456434355. - 05 FILLER PIC 9(10) VALUE 6554456433. - 05 FILLER PIC 9(10) VALUE 4169898509. - 05 FILLER PIC 9(10) VALUE 7534587453. - 05 FILLER PIC 9(10) VALUE 8787458374. - 05 FILLER PIC 9(10) VALUE 4169898509. - - 02 DATA-TELEPHONE REDEFINES DATA-TELEPHONE-TBL - PIC 9(10) OCCURS 16. - 02 DATA-DP-MGR-TBL. - - 05 FILLER PIC X(20) VALUE "MR. DAVE HARRIS ". - 05 FILLER PIC X(20) VALUE "MS. JANICE SILCOX ". - 05 FILLER PIC X(20) VALUE "MR. ALLAN JONES ". - 05 FILLER PIC X(20) VALUE "MR. PETER MACKAY ". - 05 FILLER PIC X(20) VALUE "MRS. DONNA BREWER ". - 05 FILLER PIC X(20) VALUE "MR. MICHAEL SMYTHE ". - 05 FILLER PIC X(20) VALUE "MR. D.A. MORRISON ". - 05 FILLER PIC X(20) VALUE "MR. BRIAN PATTERSON ". - 05 FILLER PIC X(20) VALUE "MR. DARRYL TOWNSEND ". - 05 FILLER PIC X(20) VALUE "MS. VALERIE HARPER ". - 05 FILLER PIC X(20) VALUE "MR. FRED MILLER ". - 05 FILLER PIC X(20) VALUE "MR. DONALD FISCHER ". - 05 FILLER PIC X(20) VALUE "MR. STEVEN YOURDIN ". - 05 FILLER PIC X(20) VALUE "MS. Goldie Hawn ". - 05 FILLER PIC X(20) VALUE "MS. ALICE WINSTON ". - 05 FILLER PIC X(20) VALUE "MR. THOMAS JEFFERSON". - - 02 DATA-DP-MGR REDEFINES DATA-DP-MGR-TBL - PIC X(20) OCCURS 16. - 02 DATA-MACHINE-TBL. - - 05 FILLER PIC X(8) VALUE "UNI-9030". - 05 FILLER PIC X(8) VALUE "UNI-9040". - 05 FILLER PIC X(8) VALUE "UNI-80/3". - 05 FILLER PIC X(8) VALUE "UNI-80/5". - 05 FILLER PIC X(8) VALUE "UNI-80/6". - 05 FILLER PIC X(8) VALUE "UNI-80/6". - 05 FILLER PIC X(8) VALUE "UNI-80/6". - 05 FILLER PIC X(8) VALUE "UNI-80/8". - 05 FILLER PIC X(8) VALUE "UNI-80/8". - 05 FILLER PIC X(8) VALUE "UNI-80/8". - 05 FILLER PIC X(8) VALUE "UNI-80/8". - 05 FILLER PIC X(8) VALUE "UNI-80/8". - 05 FILLER PIC X(8) VALUE "UNI-80/8". - 05 FILLER PIC X(8) VALUE "UNI-80/8". - 05 FILLER PIC X(8) VALUE "UNI-9040". - 05 FILLER PIC X(8) VALUE "UNI-9040". - - 02 DATA-MACHINE REDEFINES DATA-MACHINE-TBL - PIC X(8) OCCURS 16. - 02 DATA-NO-TERMINALS-TBL. - - 05 FILLER PIC 9(3) COMP-3 VALUE 85. - 05 FILLER PIC 9(3) COMP-3 VALUE 34. - 05 FILLER PIC 9(3) COMP-3 VALUE 75. - 05 FILLER PIC 9(3) COMP-3 VALUE 45. - 05 FILLER PIC 9(3) COMP-3 VALUE 90. - 05 FILLER PIC 9(3) COMP-3 VALUE 107. - 05 FILLER PIC 9(3) COMP-3 VALUE 67. - 05 FILLER PIC 9(3) COMP-3 VALUE 32. - 05 FILLER PIC 9(3) COMP-3 VALUE 16. - 05 FILLER PIC 9(3) COMP-3 VALUE 34. - 05 FILLER PIC 9(3) COMP-3 VALUE 128. - 05 FILLER PIC 9(3) COMP-3 VALUE 64. - 05 FILLER PIC 9(3) COMP-3 VALUE 110. - 05 FILLER PIC 9(3) COMP-3 VALUE 324. - 05 FILLER PIC 9(3) COMP-3 VALUE 124. - 05 FILLER PIC 9(3) COMP-3 VALUE 86. - - 02 DATA-NO-TERMINALS REDEFINES DATA-NO-TERMINALS-TBL - PIC 9(3) COMP-3 OCCURS 16. - - 01 WORK-AREA. - 05 REC-NUM PICTURE 9(8) COMP VALUE 0. - 05 REC-COUNT PICTURE 9(8) COMP VALUE 0. - 05 REC-MAX PICTURE 9(6) VALUE 16. - 05 SUB PICTURE 9(4) COMP SYNC. - 88 ODD-RECORD VALUE 1 3 5 7 9 10 11. - 88 NULL-KEY VALUE 4 5 8 12 14. - - 05 TSPFL-KEY PICTURE X(8). - - PROCEDURE DIVISION. - - MAINFILE. - DISPLAY "Loading sample data file." - UPON CONSOLE. - PERFORM LOADFILE. - DISPLAY "Sample data file load complete." - UPON CONSOLE. - PERFORM LIST-FILE. - PERFORM LIST-PHONE. - PERFORM DELSEQ-FILE. - PERFORM LIST-PHONE. - PERFORM LOADFILE. - PERFORM LIST-PHONE. - PERFORM DELPRV-FILE. - PERFORM LIST-PHONE. - * PERFORM DEL-FILE. - STOP RUN. - - LOADFILE. - OPEN OUTPUT TSPFILE - IF CUST-STAT NOT = "00" - AND CUST-STAT NOT = "05" - DIVIDE STAT-1 BY 256 GIVING BYTE-1 REMAINDER BYTE-2 - DISPLAY "Error " CUST-STAT " " BYTE-1 " " BYTE-2 - " opening 'testisam' file" - UPON CONSOLE - STOP RUN - END-IF. - - PERFORM 1000-LOAD-RECORD - VARYING SUB FROM 1 BY 1 - UNTIL SUB > MAX-SUB. - - CLOSE TSPFILE. - - DEL-FILE. - DISPLAY "Rewrite sample data file: " CUST-STAT - UPON CONSOLE. - - OPEN I-O TSPFILE - IF CUST-STAT NOT = "00" - AND CUST-STAT NOT = "05" - DIVIDE STAT-1 BY 256 GIVING BYTE-1 REMAINDER BYTE-2 - DISPLAY "Error " CUST-STAT " " BYTE-1 " " BYTE-2 - " opening 'testisam' file" - UPON CONSOLE - STOP RUN - END-IF. - MOVE "DEL00000" TO CM-CUST-NUM - READ TSPFILE - IF CUST-STAT NOT = "00" - DISPLAY "Error " CUST-STAT " read lock " CM-CUST-NUM - END-IF - DELETE TSPFILE - IF CUST-STAT NOT = "00" - DISPLAY "Error " CUST-STAT " delete " CM-CUST-NUM - END-IF - MOVE "INC00000" TO CM-CUST-NUM - READ TSPFILE - IF CUST-STAT NOT = "00" - DISPLAY "Error " CUST-STAT " read lock " CM-CUST-NUM - END-IF - DELETE TSPFILE - IF CUST-STAT NOT = "00" - DISPLAY "Error " CUST-STAT " delete " CM-CUST-NUM - END-IF - - DISPLAY "Sample data file rewrite complete." - UPON CONSOLE. - CLOSE TSPFILE. - - DELSEQ-FILE. - DISPLAY "Test Read/Delete" UPON CONSOLE. - MOVE "00" TO CUST-STAT. - OPEN I-O TSPFILE - IF CUST-STAT NOT = "00" - AND CUST-STAT NOT = "05" - DIVIDE STAT-1 BY 256 GIVING BYTE-1 REMAINDER BYTE-2 - DISPLAY "Error " CUST-STAT " " BYTE-1 " " BYTE-2 - " opening 'testisam' file" - UPON CONSOLE - STOP RUN - END-IF. - MOVE "INC00000" TO CM-CUST-NUM - READ TSPFILE - IF CUST-STAT NOT = "00" - DISPLAY "Error " CUST-STAT " read " CM-CUST-NUM - END-IF - DELETE TSPFILE - IF CUST-STAT NOT = "00" - AND CUST-STAT NOT = "02" - DISPLAY "Error " CUST-STAT " delete " CM-CUST-NUM - ELSE - DISPLAY " Delete: " CM-CUST-NUM " random" - END-IF - MOVE "ALP00000" TO CM-CUST-NUM - READ TSPFILE - IF CUST-STAT NOT = "00" - AND CUST-STAT NOT = "02" - DISPLAY "Error " CUST-STAT " read " CM-CUST-NUM - END-IF - DELETE TSPFILE - IF CUST-STAT NOT = "00" - AND CUST-STAT NOT = "02" - DISPLAY "Error " CUST-STAT " delete " CM-CUST-NUM - ELSE - DISPLAY " Delete: " CM-CUST-NUM " random" - END-IF - READ TSPFILE NEXT RECORD - IF CUST-STAT NOT = "00" - AND CUST-STAT NOT = "02" - DISPLAY "Error " CUST-STAT " read " CM-CUST-NUM - ELSE - DISPLAY " Read: " CM-CUST-NUM " " CM-TELEPHONE - END-IF - MOVE "PRE00000" TO CM-CUST-NUM - READ TSPFILE - IF CUST-STAT NOT = "00" - AND CUST-STAT NOT = "02" - DISPLAY "Error " CUST-STAT " read " CM-CUST-NUM - END-IF - DELETE TSPFILE - IF CUST-STAT NOT = "00" - AND CUST-STAT NOT = "02" - DISPLAY "Error " CUST-STAT " delete " CM-CUST-NUM - ELSE - DISPLAY " Delete: " CM-CUST-NUM " random" - END-IF - READ TSPFILE NEXT RECORD - IF CUST-STAT NOT = "00" - AND CUST-STAT NOT = "02" - DISPLAY "Expected " CUST-STAT - " after delete " CM-CUST-NUM - ELSE - DISPLAY " Read: " CM-CUST-NUM " " CM-TELEPHONE - END-IF - - MOVE SPACES TO TSPFL-RECORD - MOVE '4169898509' TO CM-TELEPHONE - START TSPFILE KEY GREATER THAN OR EQUAL TO SPLIT-KEY2 - IF CUST-STAT NOT = "00" - DISPLAY "Error " CUST-STAT " read " CM-CUST-NUM - END-IF - PERFORM 4 TIMES - READ TSPFILE NEXT RECORD - IF CUST-STAT NOT = "00" - AND CUST-STAT NOT = "02" - DISPLAY "Error " CUST-STAT " start " CM-CUST-NUM - ELSE - DISPLAY "Initial: " CM-CUST-NUM " " CM-TELEPHONE - IF CM-TELEPHONE = '4169898509' - MOVE CM-CUST-NUM TO SAV-KEY - END-IF - END-IF - END-PERFORM - MOVE SPACES TO TSPFL-RECORD - MOVE '4169898509' TO CM-TELEPHONE - START TSPFILE KEY GREATER THAN OR EQUAL TO SPLIT-KEY2 - IF CUST-STAT NOT = "00" - DISPLAY "Error " CUST-STAT " read " CM-CUST-NUM - END-IF - READ TSPFILE NEXT RECORD - IF CUST-STAT NOT = "00" - AND CUST-STAT NOT = "02" - DISPLAY "Error " CUST-STAT " start " CM-CUST-NUM - ELSE - DISPLAY " Start: " CM-CUST-NUM " " CM-TELEPHONE - END-IF - READ TSPFILE NEXT RECORD - IF CUST-STAT NOT = "00" - AND CUST-STAT NOT = "02" - DISPLAY "Error " CUST-STAT " read " CM-CUST-NUM - ELSE - DISPLAY " Next: " CM-CUST-NUM " " CM-TELEPHONE - END-IF - DELETE TSPFILE - IF CUST-STAT NOT = "00" - AND CUST-STAT NOT = "02" - DISPLAY "Error " CUST-STAT " delete " CM-CUST-NUM - ELSE - DISPLAY " Delete: " CM-CUST-NUM " sequential" - END-IF - READ TSPFILE NEXT RECORD - IF CUST-STAT NOT = "00" - AND CUST-STAT NOT = "02" - DISPLAY "Error " CUST-STAT " read " CM-CUST-NUM - ELSE - DISPLAY " Next: " CM-CUST-NUM " " CM-TELEPHONE - IF CM-CUST-NUM NOT = SAV-KEY - DISPLAY "Problem! Expected:" SAV-KEY - END-IF - END-IF - READ TSPFILE NEXT RECORD - IF CUST-STAT NOT = "00" - AND CUST-STAT NOT = "02" - DISPLAY "Error " CUST-STAT " read " CM-CUST-NUM - ELSE - DISPLAY " Next: " CM-CUST-NUM " " CM-TELEPHONE - END-IF - DELETE TSPFILE - IF CUST-STAT NOT = "00" - AND CUST-STAT NOT = "02" - DISPLAY "Error " CUST-STAT " delete " CM-CUST-NUM - ELSE - DISPLAY " Delete: " CM-CUST-NUM " sequential" - END-IF - - CLOSE TSPFILE. - - DELPRV-FILE. - DISPLAY "Read Prev/Delete" UPON CONSOLE. - MOVE "00" TO CUST-STAT. - OPEN I-O TSPFILE - IF CUST-STAT NOT = "00" - AND CUST-STAT NOT = "05" - DIVIDE STAT-1 BY 256 GIVING BYTE-1 REMAINDER BYTE-2 - DISPLAY "Error " CUST-STAT " " BYTE-1 " " BYTE-2 - " opening 'testisam' file" - UPON CONSOLE - STOP RUN - END-IF. - - MOVE SPACES TO TSPFL-RECORD - MOVE '5292398745' TO CM-TELEPHONE - START TSPFILE KEY LESS THAN SPLIT-KEY2 - IF CUST-STAT NOT = "00" - DISPLAY "Error " CUST-STAT " read " CM-CUST-NUM - END-IF - PERFORM VARYING REC-NUM FROM 1 BY 1 - UNTIL REC-NUM > 4 - READ TSPFILE PREVIOUS RECORD - IF CUST-STAT NOT = "00" - AND CUST-STAT NOT = "02" - DISPLAY "Error " CUST-STAT " start " CM-CUST-NUM - ELSE - DISPLAY REC-NUM " Initial: " CM-CUST-NUM - " " CM-TELEPHONE - IF REC-NUM = 3 - MOVE CM-CUST-NUM TO SAV-KEY - END-IF - END-IF - END-PERFORM - MOVE SPACES TO TSPFL-RECORD - MOVE '5292398745' TO CM-TELEPHONE - START TSPFILE KEY LESS THAN SPLIT-KEY2 - IF CUST-STAT NOT = "00" - DISPLAY "Error " CUST-STAT " read " CM-CUST-NUM - END-IF - READ TSPFILE PREVIOUS RECORD - IF CUST-STAT NOT = "00" - AND CUST-STAT NOT = "02" - DISPLAY "Error " CUST-STAT " start " CM-CUST-NUM - ELSE - DISPLAY " Start: " CM-CUST-NUM " " CM-TELEPHONE - END-IF - READ TSPFILE PREVIOUS RECORD - IF CUST-STAT NOT = "00" - AND CUST-STAT NOT = "02" - DISPLAY "Error " CUST-STAT " read " CM-CUST-NUM - ELSE - DISPLAY " Prev: " CM-CUST-NUM " " CM-TELEPHONE - END-IF - DELETE TSPFILE - IF CUST-STAT NOT = "00" - AND CUST-STAT NOT = "02" - DISPLAY "Error " CUST-STAT " delete " CM-CUST-NUM - ELSE - DISPLAY " Delete: " CM-CUST-NUM " sequential" - END-IF - READ TSPFILE PREVIOUS RECORD - IF CUST-STAT NOT = "00" - AND CUST-STAT NOT = "02" - DISPLAY "Error " CUST-STAT " read prev " CM-CUST-NUM - CLOSE TSPFILE - STOP RUN - ELSE - DISPLAY " Prev: " CM-CUST-NUM " " CM-TELEPHONE - IF CM-CUST-NUM NOT = SAV-KEY - DISPLAY "Problem! Expected:" SAV-KEY - CLOSE TSPFILE - STOP RUN - END-IF - END-IF - READ TSPFILE PREVIOUS RECORD - IF CUST-STAT NOT = "00" - AND CUST-STAT NOT = "02" - DISPLAY "Error " CUST-STAT " read prev " CM-CUST-NUM - ELSE - DISPLAY " Prev: " CM-CUST-NUM " " CM-TELEPHONE - END-IF - DELETE TSPFILE - IF CUST-STAT NOT = "00" - AND CUST-STAT NOT = "02" - DISPLAY "Error " CUST-STAT " delete " CM-CUST-NUM - ELSE - DISPLAY " Delete: " CM-CUST-NUM " sequential" - END-IF - - CLOSE TSPFILE. - - LIST-FILE. - DISPLAY "List sample data file" - UPON CONSOLE. - MOVE "00" TO CUST-STAT. - MOVE 0 TO REC-NUM. - OPEN I-O TSPFILE - MOVE " " TO CM-CUST-NUM - START TSPFILE KEY GREATER THAN OR EQUAL TO CM-CUST-NUM - IF CUST-STAT NOT = "00" - DISPLAY "Error " CUST-STAT " read " CM-CUST-NUM - END-IF - READ TSPFILE NEXT RECORD - AT END - MOVE "99" TO CUST-STAT - END-READ. - IF CUST-STAT NOT = "00" - DISPLAY "Error " CUST-STAT " first read " CM-CUST-NUM - END-IF - PERFORM UNTIL CUST-STAT NOT = "00" - OR REC-NUM > REC-MAX - DISPLAY "Key: " CM-CUST-NUM " is " CM-COMPANY - " Disk=" CM-DISK - "." UPON CONSOLE - READ TSPFILE NEXT RECORD - AT END - MOVE "99" TO CUST-STAT - END-READ - ADD 1 TO REC-NUM - END-PERFORM. - IF CUST-STAT = "99" - DISPLAY "Hit End of File" UPON CONSOLE - END-IF. - CLOSE TSPFILE. - - LIST-PHONE. - DISPLAY "List sample data file by Phone" - UPON CONSOLE. - MOVE "00" TO CUST-STAT. - MOVE 0 TO REC-NUM. - OPEN I-O TSPFILE - MOVE SPACES TO TSPFL-RECORD - START TSPFILE KEY GREATER THAN OR EQUAL TO SPLIT-KEY2 - IF CUST-STAT NOT = "00" - AND CUST-STAT NOT = "02" - DISPLAY "Error " CUST-STAT " read " CM-CUST-NUM - END-IF - READ TSPFILE NEXT RECORD - AT END - MOVE "99" TO CUST-STAT - END-READ. - IF CUST-STAT NOT = "00" - AND CUST-STAT NOT = "02" - DISPLAY "Error " CUST-STAT " first read " CM-CUST-NUM - END-IF - PERFORM UNTIL CUST-STAT NOT = "00" - AND CUST-STAT NOT = "02" - DISPLAY "Ph=" CM-TELEPHONE - " Key: " CM-CUST-NUM " is " CM-COMPANY - "." UPON CONSOLE - READ TSPFILE NEXT RECORD - AT END - MOVE "99" TO CUST-STAT - END-READ - ADD 1 TO REC-NUM - END-PERFORM. - IF CUST-STAT = "99" - DISPLAY "Hit End of File" UPON CONSOLE - END-IF. - CLOSE TSPFILE. - - *---------------------------------------------------------------* - * LOAD A RECORD FROM DATA TABLES * - *---------------------------------------------------------------* - - 1000-LOAD-RECORD. - - MOVE SPACES TO TSPFL-RECORD. - MOVE DATA-CUST-NUM (SUB) TO CM-CUST-NUM. - MOVE CM-CUST-NUM TO TSPFL-KEY. - MOVE DATA-COMPANY (SUB) TO CM-COMPANY. - MOVE DATA-ADDRESS-1 (SUB) TO CM-ADDRESS-1. - MOVE DATA-ADDRESS-2 (SUB) TO CM-ADDRESS-2. - MOVE DATA-ADDRESS-3 (SUB) TO CM-ADDRESS-3. - MOVE DATA-TELEPHONE (SUB) TO CM-TELEPHONE. - MOVE DATA-DP-MGR (SUB) TO CM-DP-MGR. - MOVE DATA-MACHINE (SUB) TO CM-MACHINE. - MOVE DATA-NO-TERMINALS (SUB) TO CM-NO-TERMINALS. - - IF ODD-RECORD - MOVE "8417" TO CM-DISK - MOVE "1600 BPI" TO CM-TAPE - MOVE "1MEG" TO CM-MEMORY - ELSE - MOVE "8470" TO CM-DISK - MOVE "6250 BPI" TO CM-TAPE - MOVE "3MEG" TO CM-MEMORY. - IF NULL-KEY - MOVE ALL "*" TO CM-DISK - MOVE ALL "*" TO CM-TAPE. - - WRITE TSPFL-RECORD - IF CUST-STAT NOT = "00" - AND CUST-STAT NOT = "02" - DISPLAY "WRITE: " TSPFL-KEY ", Status: " - CUST-STAT UPON CONSOLE - END-IF. -]) - -AT_CHECK([$COBC -x -std=mf -w prog.cob ], [0], [], []) - -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [Loading sample data file. -Sample data file load complete. -List sample data file -Key: ALP00000 is ALPHA ELECTRICAL CO. LTD. Disk=8417 . -Key: BET00000 is BETA SHOE MFG. INC. Disk=8470 . -Key: DEL00000 is DELTA LUGGAGE REPAIRS Disk=********. -Key: EPS00000 is EPSILON EQUIPMENT SUPPLY Disk=********. -Key: FOR00000 is FORTUNE COOKIE COMPANY Disk=8470 . -Key: GAM00000 is GAMMA X-RAY TECHNOLOGY Disk=8417 . -Key: GIB00000 is GIBRALTER LIFE INSURANCE Disk=8417 . -Key: H&J00000 is H & J PLUMBING SUPPLIES Disk=********. -Key: INC00000 is INCREMENTAL BACKUP CORP. Disk=8417 . -Key: JOH00000 is JOHNSON BOATING SUPPLIES Disk=8417 . -Key: KON00000 is KONFLAB PLASTIC PRODUCTS. Disk=8417 . -Key: LEW00000 is LEWISTON GRAPHICS LTD. Disk=********. -Key: MOR00000 is MORNINGSIDE CARPENTRY. Disk=8470 . -Key: NEW00000 is NEW WAVE SURF SHOPS INC. Disk=********. -Key: OLD00000 is OLD TYME PIZZA MFG. CO. Disk=8470 . -Key: PRE00000 is PRESTIGE OFFICE FURNITURE Disk=8470 . -Hit End of File -List sample data file by Phone -Ph=3131234432 Key: ALP00000 is ALPHA ELECTRICAL CO. LTD.. -Ph=3455445444 Key: INC00000 is INCREMENTAL BACKUP CORP. . -Ph=4169898509 Key: BET00000 is BETA SHOE MFG. INC. . -Ph=4169898509 Key: DEL00000 is DELTA LUGGAGE REPAIRS . -Ph=4169898509 Key: MOR00000 is MORNINGSIDE CARPENTRY. . -Ph=4169898509 Key: PRE00000 is PRESTIGE OFFICE FURNITURE. -Ph=5292398745 Key: EPS00000 is EPSILON EQUIPMENT SUPPLY . -Ph=6456445643 Key: GIB00000 is GIBRALTER LIFE INSURANCE . -Ph=6456445643 Key: JOH00000 is JOHNSON BOATING SUPPLIES . -Ph=6546456333 Key: H&J00000 is H & J PLUMBING SUPPLIES . -Ph=6554456433 Key: LEW00000 is LEWISTON GRAPHICS LTD. . -Ph=7456434355 Key: KON00000 is KONFLAB PLASTIC PRODUCTS.. -Ph=7534587453 Key: NEW00000 is NEW WAVE SURF SHOPS INC. . -Ph=8009329492 Key: FOR00000 is FORTUNE COOKIE COMPANY . -Ph=8372487274 Key: GAM00000 is GAMMA X-RAY TECHNOLOGY . -Ph=8787458374 Key: OLD00000 is OLD TYME PIZZA MFG. CO. . -Hit End of File -Test Read/Delete - Delete: INC00000 random - Delete: ALP00000 random - Read: BET00000 4169898509 - Delete: PRE00000 random -Expected 10 after delete PRE00000 -Initial: BET00000 4169898509 -Initial: DEL00000 4169898509 -Initial: MOR00000 4169898509 -Initial: EPS00000 5292398745 - Start: BET00000 4169898509 - Next: DEL00000 4169898509 - Delete: DEL00000 sequential - Next: MOR00000 4169898509 - Next: EPS00000 5292398745 - Delete: EPS00000 sequential -List sample data file by Phone -Ph=4169898509 Key: BET00000 is BETA SHOE MFG. INC. . -Ph=4169898509 Key: MOR00000 is MORNINGSIDE CARPENTRY. . -Ph=6456445643 Key: GIB00000 is GIBRALTER LIFE INSURANCE . -Ph=6456445643 Key: JOH00000 is JOHNSON BOATING SUPPLIES . -Ph=6546456333 Key: H&J00000 is H & J PLUMBING SUPPLIES . -Ph=6554456433 Key: LEW00000 is LEWISTON GRAPHICS LTD. . -Ph=7456434355 Key: KON00000 is KONFLAB PLASTIC PRODUCTS.. -Ph=7534587453 Key: NEW00000 is NEW WAVE SURF SHOPS INC. . -Ph=8009329492 Key: FOR00000 is FORTUNE COOKIE COMPANY . -Ph=8372487274 Key: GAM00000 is GAMMA X-RAY TECHNOLOGY . -Ph=8787458374 Key: OLD00000 is OLD TYME PIZZA MFG. CO. . -Hit End of File -List sample data file by Phone -Ph=3131234432 Key: ALP00000 is ALPHA ELECTRICAL CO. LTD.. -Ph=3455445444 Key: INC00000 is INCREMENTAL BACKUP CORP. . -Ph=4169898509 Key: BET00000 is BETA SHOE MFG. INC. . -Ph=4169898509 Key: DEL00000 is DELTA LUGGAGE REPAIRS . -Ph=4169898509 Key: MOR00000 is MORNINGSIDE CARPENTRY. . -Ph=4169898509 Key: PRE00000 is PRESTIGE OFFICE FURNITURE. -Ph=5292398745 Key: EPS00000 is EPSILON EQUIPMENT SUPPLY . -Ph=6456445643 Key: GIB00000 is GIBRALTER LIFE INSURANCE . -Ph=6456445643 Key: JOH00000 is JOHNSON BOATING SUPPLIES . -Ph=6546456333 Key: H&J00000 is H & J PLUMBING SUPPLIES . -Ph=6554456433 Key: LEW00000 is LEWISTON GRAPHICS LTD. . -Ph=7456434355 Key: KON00000 is KONFLAB PLASTIC PRODUCTS.. -Ph=7534587453 Key: NEW00000 is NEW WAVE SURF SHOPS INC. . -Ph=8009329492 Key: FOR00000 is FORTUNE COOKIE COMPANY . -Ph=8372487274 Key: GAM00000 is GAMMA X-RAY TECHNOLOGY . -Ph=8787458374 Key: OLD00000 is OLD TYME PIZZA MFG. CO. . -Hit End of File -Read Prev/Delete -00000001 Initial: PRE00000 4169898509 -00000002 Initial: MOR00000 4169898509 -00000003 Initial: DEL00000 4169898509 -00000004 Initial: BET00000 4169898509 - Start: PRE00000 4169898509 - Prev: MOR00000 4169898509 - Delete: MOR00000 sequential - Prev: DEL00000 4169898509 - Prev: BET00000 4169898509 - Delete: BET00000 sequential -List sample data file by Phone -Ph=3131234432 Key: ALP00000 is ALPHA ELECTRICAL CO. LTD.. -Ph=3455445444 Key: INC00000 is INCREMENTAL BACKUP CORP. . -Ph=4169898509 Key: DEL00000 is DELTA LUGGAGE REPAIRS . -Ph=4169898509 Key: PRE00000 is PRESTIGE OFFICE FURNITURE. -Ph=5292398745 Key: EPS00000 is EPSILON EQUIPMENT SUPPLY . -Ph=6456445643 Key: GIB00000 is GIBRALTER LIFE INSURANCE . -Ph=6456445643 Key: JOH00000 is JOHNSON BOATING SUPPLIES . -Ph=6546456333 Key: H&J00000 is H & J PLUMBING SUPPLIES . -Ph=6554456433 Key: LEW00000 is LEWISTON GRAPHICS LTD. . -Ph=7456434355 Key: KON00000 is KONFLAB PLASTIC PRODUCTS.. -Ph=7534587453 Key: NEW00000 is NEW WAVE SURF SHOPS INC. . -Ph=8009329492 Key: FOR00000 is FORTUNE COOKIE COMPANY . -Ph=8372487274 Key: GAM00000 is GAMMA X-RAY TECHNOLOGY . -Ph=8787458374 Key: OLD00000 is OLD TYME PIZZA MFG. CO. . -Hit End of File -], []) - -AT_CLEANUP - diff -Nru gnucobol-4.0~early~20200606/tests/testsuite.src/run_functions.at gnucobol-5/tests/testsuite.src/run_functions.at --- gnucobol-4.0~early~20200606/tests/testsuite.src/run_functions.at 2020-06-06 20:52:00.000000000 +0000 +++ gnucobol-5/tests/testsuite.src/run_functions.at 1970-01-01 00:00:00.000000000 +0000 @@ -1,4395 +0,0 @@ -## Copyright (C) 2003-2012, 2014-2020 Free Software Foundation, Inc. -## Written by Keisuke Nishida, Roger While, Simon Sobisch, Edward Hart -## -## This file is part of GnuCOBOL. -## -## The GnuCOBOL compiler is free software: you can redistribute it -## and/or modify it under the terms of the GNU General Public License -## as published by the Free Software Foundation, either version 3 of the -## License, or (at your option) any later version. -## -## GnuCOBOL is distributed in the hope that it will be useful, -## but WITHOUT ANY WARRANTY; without even the implied warranty of -## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -## GNU General Public License for more details. -## -## You should have received a copy of the GNU General Public License -## along with GnuCOBOL. If not, see . - -### GnuCOBOL Test Suite - -### ISO+IEC+1989-2002 15 Intrinsic Functions -### ISO+IEC+1989-2002 9.4 User-Defined Functions - -AT_SETUP([FUNCTION ABS]) -AT_KEYWORDS([functions]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 X PIC S9(4)V9(4) VALUE -1.2345. - PROCEDURE DIVISION. - DISPLAY FUNCTION ABS ( X ) NO ADVANCING - END-DISPLAY. - STOP RUN. -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], -[+0001.2345]) - -AT_CLEANUP - - -AT_SETUP([FUNCTION ACOS]) -AT_KEYWORDS([functions]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 Z PIC S9V9(35). - PROCEDURE DIVISION. - MOVE FUNCTION ACOS ( -0.2345 ) TO Z. - IF Z NOT = 1.80750052110824343510150043852321026 - DISPLAY Z - END-DISPLAY - END-IF. - STOP RUN. -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [], []) - -AT_CLEANUP - - -AT_SETUP([FUNCTION ANNUITY]) -AT_KEYWORDS([functions]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 Z PIC S9V9(35). - PROCEDURE DIVISION. - MOVE FUNCTION ANNUITY ( 3, 5 ) TO Z. - IF Z NOT = 3.00293255131964809384164222873900293 - DISPLAY Z - END-DISPLAY - END-IF. - STOP RUN. -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [], []) - -AT_CLEANUP - - -AT_SETUP([FUNCTION ASIN]) -AT_KEYWORDS([functions]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 Y PIC S9V9(35). - PROCEDURE DIVISION. - MOVE FUNCTION ASIN ( -0.2345 ) TO Y. - IF Y NOT = -0.23670419431334681587017874688345882 - DISPLAY Y - END-DISPLAY - END-IF. - STOP RUN. -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [], []) - -AT_CLEANUP - - -AT_SETUP([FUNCTION ATAN]) -AT_KEYWORDS([functions]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 Y PIC S9V9(35). - PROCEDURE DIVISION. - MOVE FUNCTION ATAN ( 1 ) TO Y. - IF Y NOT = 0.78539816339744830961566084581987572 - DISPLAY Y - END-DISPLAY - END-IF. - STOP RUN. -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [], []) - -AT_CLEANUP - - -AT_SETUP([FUNCTION BYTE-LENGTH]) -AT_KEYWORDS([functions length]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 X PIC X(4). - 01 Z PIC N(4). - 01 TEST-FLD PIC S9(04)V9(08). - PROCEDURE DIVISION. - MOVE FUNCTION BYTE-LENGTH ( X ) - TO TEST-FLD. - IF TEST-FLD NOT = 4 - DISPLAY 'BYTE-LENGTH X(4) wrong: ' TEST-FLD - END-DISPLAY - END-IF - MOVE FUNCTION BYTE-LENGTH ( Z ) - TO TEST-FLD - IF TEST-FLD NOT = 8 - DISPLAY 'BYTE-LENGTH N(4) wrong: ' TEST-FLD - END-DISPLAY - END-IF - - MOVE FUNCTION BYTE-LENGTH ( '00128' ) - TO TEST-FLD - IF TEST-FLD NOT = 5 - DISPLAY 'BYTE-LENGTH "00128" wrong: ' TEST-FLD - END-DISPLAY - END-IF - * note: we currently do not support items of category boolean... - *> MOVE FUNCTION BYTE-LENGTH ( b'100' ) - *> TO TEST-FLD - *> IF TEST-FLD NOT = 3 - *> DISPLAY 'BYTE-LENGTH b"100" wrong: ' TEST-FLD - *> END-DISPLAY - *> END-IF - MOVE FUNCTION BYTE-LENGTH ( x'a0' ) - TO TEST-FLD - IF TEST-FLD NOT = 1 - DISPLAY 'BYTE-LENGTH x"a0" wrong: ' TEST-FLD - END-DISPLAY - END-IF - MOVE FUNCTION BYTE-LENGTH ( z'a0' ) - TO TEST-FLD - IF TEST-FLD NOT = 3 - DISPLAY 'BYTE-LENGTH z"a0" wrong: ' TEST-FLD - END-DISPLAY - END-IF - * we currently generate national constants as - * alphanumeric constants... - * MOVE FUNCTION BYTE-LENGTH ( n'a0' ) - * TO TEST-FLD - * IF TEST-FLD NOT = 4 - * DISPLAY 'BYTE-LENGTH n"a0" wrong: ' TEST-FLD - * END-DISPLAY - * END-IF - - STOP RUN. -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], -[prog.cob:7: warning: handling of USAGE NATIONAL is unfinished; implementation is likely to be changed -]) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [], []) - -AT_CLEANUP - - -AT_SETUP([FUNCTION CHAR]) -AT_KEYWORDS([functions]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 X PIC S9(4)V9(4) VALUE 108. - 01 TEST-FLD. - 05 TEST-DATA PIC X(01). - 88 VALID-DATA VALUE 'k'. - 05 TEST-UNSET PIC X VALUE '_'. - 88 VALID-UNSET VALUE '_'. - PROCEDURE DIVISION. - STRING FUNCTION CHAR ( X ) - DELIMITED BY SIZE - INTO TEST-FLD - END-STRING. - EVALUATE TRUE - WHEN NOT VALID-UNSET - DISPLAY "FUNCTION result too long" - END-DISPLAY - WHEN VALID-DATA - CONTINUE - WHEN OTHER - DISPLAY TEST-DATA - END-DISPLAY - END-EVALUATE. - STOP RUN. -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [], []) - -AT_CLEANUP - - -AT_SETUP([FUNCTION COMBINED-DATETIME]) -AT_KEYWORDS([functions]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 TEST-FLD PIC S9(04)V9(08). - PROCEDURE DIVISION. - MOVE FUNCTION COMBINED-DATETIME ( 987, 345.6 ) - TO TEST-FLD. - IF TEST-FLD NOT = 987.003456 - DISPLAY TEST-FLD - END-DISPLAY - END-IF. - STOP RUN. -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [], []) - -AT_CLEANUP - - -AT_SETUP([FUNCTION CONCAT / CONCATENATE]) -AT_KEYWORDS([functions]) - -# note: CONCAT was added in COBOL 202x with GnuCOBOL's CONCATENATE -# as blueprint -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 Y PIC X(4). - 01 TEST-FLD. - 05 TEST-DATA PIC X(14). - 88 VALID-DATA VALUE 'defxabczz55666'. - 05 TEST-UNSET PIC X VALUE '_'. - 88 VALID-UNSET VALUE '_'. - PROCEDURE DIVISION. - MOVE "defx" TO Y. - STRING FUNCTION CONCATENATE ( Y "abc" "zz" "55" "666" ) - DELIMITED BY SIZE - INTO TEST-FLD - END-STRING. - EVALUATE TRUE - WHEN NOT VALID-UNSET - DISPLAY "FUNCTION result too long" - END-DISPLAY - WHEN TEST-DATA - <> FUNCTION CONCAT ( Y "abc" "zz" "55" "666" ) - DISPLAY "CONCAT issue, '" TEST-DATA - "' vs. '" - FUNCTION CONCAT ( Y "abc" "zz" "55" "666" ) "'" - END-DISPLAY - WHEN VALID-DATA - CONTINUE - WHEN OTHER - DISPLAY TEST-DATA - END-DISPLAY - END-EVALUATE. - STOP RUN. -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [], []) - -AT_CLEANUP - - -AT_SETUP([FUNCTION CONCATENATE with reference modding]) -AT_KEYWORDS([functions]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 Y PIC X(4). - 01 TEST-FLD PIC X(9) VALUE SPACES. - PROCEDURE DIVISION. - MOVE 'defx' TO Y. - MOVE FUNCTION CONCATENATE - ( Y "abc" "zz" "55" "666" ) (2 : 9) - TO TEST-FLD. - IF TEST-FLD NOT = 'efxabczz5' - DISPLAY TEST-FLD - END-DISPLAY - END-IF. - STOP RUN. -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [], []) - -AT_CLEANUP - - -AT_SETUP([FUNCTION CONTENT-LENGTH]) -AT_KEYWORDS([functions length]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 P USAGE POINTER. - 01 X PIC X(4) VALUE Z"ABC". - 01 TEST-FLD USAGE BINARY-LONG. - PROCEDURE DIVISION. - MOVE FUNCTION CONTENT-LENGTH ( P ) - TO TEST-FLD. - IF TEST-FLD NOT = 0 - DISPLAY 'CONTENT-LENGTH NULL wrong: ' TEST-FLD - END-DISPLAY - END-IF - SET P TO ADDRESS OF X - MOVE FUNCTION CONTENT-LENGTH ( P ) - TO TEST-FLD - IF TEST-FLD NOT = 3 - DISPLAY 'CONTENT-LENGTH z"abc" wrong: ' TEST-FLD - END-DISPLAY - END-IF - STOP RUN. -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [], []) - -AT_CLEANUP - - -AT_SETUP([FUNCTION CONTENT-OF]) -AT_KEYWORDS([functions POINTER literal BASED ALLOCATE FREE EXCEPTION-STATUS]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 P USAGE POINTER. - 01 X PIC X(4) VALUE Z"ABC". - 01 B PIC X(10) BASED. - PROCEDURE DIVISION. - SET P TO ADDRESS OF X - IF FUNCTION CONTENT-OF ( P ) NOT EQUAL 'ABC' THEN - DISPLAY 'CONTENT-OF(ptr) wrong' END-DISPLAY - END-IF - IF FUNCTION CONTENT-OF ( P, 2 ) NOT EQUAL 'AB' THEN - DISPLAY 'CONTENT-OF(ptr, len) wrong' END-DISPLAY - END-IF - IF FUNCTION EXCEPTION-STATUS NOT = SPACES THEN - DISPLAY 'unexpected exception (1): ' - FUNCTION EXCEPTION-STATUS - END-DISPLAY - END-IF - SET P TO NULL - MOVE 'PPPP' TO X - STRING FUNCTION CONTENT-OF ( P ) - DELIMITED BY SIZE - INTO X - END-STRING - *> Note: result *should* depend on dialect option zero-length literals - IF X NOT EQUAL 'PPPP' THEN - DISPLAY 'CONTENT-OF empty POINTER wrong: "' X "'" - END-DISPLAY - END-IF - IF FUNCTION EXCEPTION-STATUS NOT = "EC-DATA-PTR-NULL" THEN - DISPLAY 'missing exception (1)' - END-DISPLAY - END-IF - ALLOCATE B INITIALIZED - SET P TO ADDRESS OF B - IF FUNCTION CONTENT-OF ( P, 1 ) NOT EQUAL SPACES THEN - DISPLAY 'CONTENT-OF allocated BASED item wrong' - END-DISPLAY - END-IF - IF FUNCTION EXCEPTION-STATUS NOT = SPACES THEN - DISPLAY 'unexpected exception (2): ' - FUNCTION EXCEPTION-STATUS - END-DISPLAY - END-IF - FREE B - SET P TO ADDRESS OF B - MOVE 'BBBB' TO X - STRING FUNCTION CONTENT-OF ( P ) - DELIMITED BY SIZE - INTO X - END-STRING - *> Note: result *should* depend on dialect option zero-length literals - IF X NOT EQUAL 'BBBB' THEN - DISPLAY 'CONTENT-OF unallocated BASED item wrong: "' X '"' - END-DISPLAY - END-IF - IF FUNCTION EXCEPTION-STATUS NOT = "EC-DATA-PTR-NULL" THEN - DISPLAY 'missing exception (2)' - END-DISPLAY - END-IF - STOP RUN. -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [], []) - -AT_CLEANUP - - -AT_SETUP([FUNCTION as CALL parameter BY CONTENT]) -AT_KEYWORDS([functions]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - - PROCEDURE DIVISION. - PROG-MAIN. - CALL "subprog" USING BY CONTENT - FUNCTION CONCATENATE("Abc" "D") - STOP RUN. - END PROGRAM prog. - - *> ***************************** - IDENTIFICATION DIVISION. - PROGRAM-ID. subprog. - - DATA DIVISION. - LINKAGE SECTION. - 01 TESTING PIC X ANY LENGTH. - - PROCEDURE DIVISION USING TESTING. - SUBPROG-MAIN. - DISPLAY TESTING - GOBACK. - END PROGRAM subprog. -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [AbcD -], []) - -AT_CLEANUP - - -AT_SETUP([FUNCTION COS]) -AT_KEYWORDS([functions]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 Y PIC S9V9(35). - PROCEDURE DIVISION. - MOVE FUNCTION COS ( -0.2345 ) TO Y. - IF Y NOT = 0.97263064125625818471341696241456141 - DISPLAY Y - END-DISPLAY - END-IF. - STOP RUN. -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [], []) - -AT_CLEANUP - - -AT_SETUP([FUNCTION CURRENCY-SYMBOL]) -AT_KEYWORDS([functions]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 TEST-FLD PIC X(8) VALUE SPACES. - PROCEDURE DIVISION. - MOVE FUNCTION CURRENCY-SYMBOL TO TEST-FLD. - DISPLAY "OK" NO ADVANCING - END-DISPLAY - STOP RUN. -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [OK], []) - -AT_CLEANUP - - -AT_SETUP([FUNCTION CURRENT-DATE]) -AT_KEYWORDS([functions]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 TEST-FLD. - 02 WS-YEAR PIC 9(04). - 88 VALID-YEAR VALUE 1980 THRU 9999. - 02 WS-MONTH PIC 9(02). - 88 VALID-MONTH VALUE 01 THRU 12. - 02 WS-DAY PIC 9(02). - 88 VALID-DAY VALUE 01 THRU 31. - 02 WS-HOUR PIC 9(02). - 88 VALID-HOUR VALUE 00 THRU 23. - 02 WS-MIN PIC 9(02). - 88 VALID-MIN VALUE 00 THRU 59. - 02 WS-SEVALIDD PIC 9(02). - 88 VALID-SEC VALUE 00 THRU 59. - 02 WS-HUNDSEC PIC 9(02). - 88 VALID-HUNDSEC VALUE 00 THRU 99. - 02 WS-GREENW PIC X. - 88 VALID-GREENW VALUE "-", "+", "0". - 88 ZERO-GREENW VALUE "0". - 02 WS-OFFSET PIC 9(02). - 88 VALID-OFFSET VALUE 00 THRU 13. - 88 ZERO-OFFSET VALUE 00. - 02 WS-OFFSET2 PIC 9(02). - 88 VALID-OFFSET2 VALUE 00 THRU 59. - 88 ZERO-OFFSET2 VALUE 00. - 02 WS-UNSET PIC X VALUE '_'. - 88 VALID-UNSET VALUE '_'. - PROCEDURE DIVISION. - STRING FUNCTION CURRENT-DATE - DELIMITED BY SIZE - INTO TEST-FLD - END-STRING. - EVALUATE TRUE - WHEN NOT VALID-UNSET - DISPLAY "FUNCTION result too long" - END-DISPLAY - WHEN VALID-YEAR AND - VALID-MONTH AND - VALID-DAY AND - VALID-HOUR AND - VALID-MIN AND - VALID-SEC AND - VALID-HUNDSEC AND - VALID-GREENW AND - VALID-OFFSET AND - VALID-OFFSET2 AND - VALID-UNSET AND - ((NOT ZERO-GREENW) OR (ZERO-OFFSET AND ZERO-OFFSET2)) - CONTINUE - WHEN OTHER - DISPLAY "CURRENT-DATE with wrong format: " - TEST-FLD (01:21) - END-DISPLAY - END-EVALUATE. - STOP RUN. -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [], []) - -AT_CLEANUP - - -AT_SETUP([FUNCTION DATE-OF-INTEGER]) -AT_KEYWORDS([functions]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 TEST-FLD PIC S9(09)V9(02). - PROCEDURE DIVISION. - MOVE FUNCTION DATE-OF-INTEGER ( 146000 ) - TO TEST-FLD. - IF TEST-FLD NOT = 20000925 - DISPLAY TEST-FLD - END-DISPLAY - END-IF. - STOP RUN. -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [], []) - -AT_CLEANUP - - -AT_SETUP([FUNCTION DATE-TO-YYYYMMDD]) -AT_KEYWORDS([functions]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 TEST-FLD PIC S9(09)V9(02). - PROCEDURE DIVISION. - MOVE FUNCTION DATE-TO-YYYYMMDD ( 981002, -10, 1994 ) - TO TEST-FLD. - IF TEST-FLD NOT = 018981002 - DISPLAY TEST-FLD - END-DISPLAY - END-IF. - STOP RUN. -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [], []) - -AT_CLEANUP - - -AT_SETUP([FUNCTION DAY-OF-INTEGER]) -AT_KEYWORDS([functions]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 TEST-FLD PIC S9(09)V9(02). - PROCEDURE DIVISION. - MOVE FUNCTION DAY-OF-INTEGER ( 146000 ) - TO TEST-FLD. - IF TEST-FLD NOT = 2000269 - DISPLAY TEST-FLD - END-DISPLAY - END-IF. - STOP RUN. -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [], []) - -AT_CLEANUP - - -AT_SETUP([FUNCTION DAY-TO-YYYYDDD]) -AT_KEYWORDS([functions]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 TEST-FLD PIC S9(09)V9(02). - PROCEDURE DIVISION. - MOVE FUNCTION DAY-TO-YYYYDDD ( 95005, -10, 2013 ) - TO TEST-FLD. - IF TEST-FLD NOT = 001995005 - DISPLAY TEST-FLD - END-DISPLAY - END-IF. - STOP RUN. -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [], []) - -AT_CLEANUP - - -AT_SETUP([FUNCTION E]) -AT_KEYWORDS([functions]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 Y PIC 9V9(35). - PROCEDURE DIVISION. - MOVE FUNCTION E TO Y. - IF Y NOT = 2.71828182845904523536028747135266249 - DISPLAY Y - END-DISPLAY - END-IF. - STOP RUN. -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [], []) - -AT_CLEANUP - - -AT_SETUP([FUNCTION EXCEPTION-FILE]) -AT_KEYWORDS([functions exceptions]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - INPUT-OUTPUT SECTION. - FILE-CONTROL. - SELECT TEST-FILE ASSIGN "NOTEXIST" - FILE STATUS IS TEST-STATUS. - DATA DIVISION. - FILE SECTION. - FD TEST-FILE. - 01 TEST-REC PIC X(4). - WORKING-STORAGE SECTION. - 01 TEST-STATUS PIC XX. - PROCEDURE DIVISION. - DISPLAY FUNCTION EXCEPTION-FILE '|' - NO ADVANCING - END-DISPLAY. - OPEN INPUT TEST-FILE. - DISPLAY FUNCTION EXCEPTION-FILE - NO ADVANCING - END-DISPLAY. - STOP RUN. -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], -[00|35TEST-FILE], []) - -AT_CLEANUP - - -AT_SETUP([FUNCTION EXCEPTION-LOCATION]) -AT_KEYWORDS([functions exceptions]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - INPUT-OUTPUT SECTION. - FILE-CONTROL. - SELECT TEST-FILE ASSIGN "NOTEXIST" - FILE STATUS IS TEST-STATUS. - DATA DIVISION. - FILE SECTION. - FD TEST-FILE. - 01 TEST-REC PIC X(4). - WORKING-STORAGE SECTION. - 01 TEST-STATUS PIC XX. - PROCEDURE DIVISION. - A00-MAIN SECTION. - A00. - DISPLAY FUNCTION EXCEPTION-LOCATION '|' - NO ADVANCING - END-DISPLAY. - OPEN INPUT TEST-FILE. - B00-MAIN SECTION. - B00. - DISPLAY FUNCTION EXCEPTION-LOCATION - NO ADVANCING - END-DISPLAY. - STOP RUN. -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], -[ |prog; A00 OF A00-MAIN; 21], []) - -AT_CLEANUP - - -AT_SETUP([FUNCTION EXCEPTION-STATEMENT]) -AT_KEYWORDS([functions exceptions]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - INPUT-OUTPUT SECTION. - FILE-CONTROL. - SELECT TEST-FILE ASSIGN "NOTEXIST" - FILE STATUS IS TEST-STATUS. - DATA DIVISION. - FILE SECTION. - FD TEST-FILE. - 01 TEST-REC PIC X(4). - WORKING-STORAGE SECTION. - 01 TEST-STATUS PIC XX. - PROCEDURE DIVISION. - DISPLAY FUNCTION EXCEPTION-STATEMENT '|' - NO ADVANCING - END-DISPLAY. - OPEN INPUT TEST-FILE. - DISPLAY FUNCTION EXCEPTION-STATEMENT - NO ADVANCING - END-DISPLAY. - STOP RUN. -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], -[ |OPEN ], []) - -AT_CLEANUP - - -AT_SETUP([FUNCTION EXCEPTION-STATUS]) -AT_KEYWORDS([functions exceptions]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - INPUT-OUTPUT SECTION. - FILE-CONTROL. - SELECT TEST-FILE ASSIGN "NOTEXIST" - FILE STATUS IS TEST-STATUS. - DATA DIVISION. - FILE SECTION. - FD TEST-FILE. - 01 TEST-REC PIC X(4). - WORKING-STORAGE SECTION. - 01 TEST-STATUS PIC XX. - PROCEDURE DIVISION. - DISPLAY FUNCTION EXCEPTION-STATUS '|' - NO ADVANCING - END-DISPLAY. - OPEN INPUT TEST-FILE. - DISPLAY FUNCTION EXCEPTION-STATUS - NO ADVANCING - END-DISPLAY. - STOP RUN. -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], -[ |EC-I-O-PERMANENT-ERROR ], []) - -AT_CLEANUP - - -AT_SETUP([FUNCTION EXP]) -AT_KEYWORDS([functions]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 Y PIC S99V9(34). - PROCEDURE DIVISION. - MOVE FUNCTION EXP ( 3 ) TO Y. - IF Y NOT = 20.0855369231876677409285296545817178 - DISPLAY Y - END-DISPLAY - END-IF. - STOP RUN. -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [], []) - -AT_CLEANUP - - -AT_SETUP([FUNCTION EXP10]) -AT_KEYWORDS([functions]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 TEST-FLD PIC S9(09)V9(02). - PROCEDURE DIVISION. - MOVE FUNCTION EXP10 ( 4 ) - TO TEST-FLD. - IF TEST-FLD NOT = 000010000 - DISPLAY TEST-FLD - END-DISPLAY - END-IF. - STOP RUN. -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [], []) - -AT_CLEANUP - - -AT_SETUP([FUNCTION FACTORIAL]) -AT_KEYWORDS([functions]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 TEST-FLD PIC S9(09)V9(02). - PROCEDURE DIVISION. - MOVE FUNCTION FACTORIAL ( 6 ) - TO TEST-FLD. - IF TEST-FLD NOT = 000000720 - DISPLAY TEST-FLD - END-DISPLAY - END-IF. - STOP RUN. -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [], []) - -AT_CLEANUP - - -AT_SETUP([FUNCTION FORMATTED-CURRENT-DATE]) -AT_KEYWORDS([functions]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 Datetime-Format CONSTANT "YYYYMMDDThhmmss.ss+hhmm". - 01 str PIC X(25). - PROCEDURE DIVISION. - *> Test normal inputs. - MOVE FUNCTION FORMATTED-CURRENT-DATE ( Datetime-Format ) - TO str - IF FUNCTION TEST-FORMATTED-DATETIME ( Datetime-Format, str) - <> 0 - DISPLAY "Test 1 failed: " str END-DISPLAY - END-IF. - - STOP RUN. -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [], []) - -AT_CLEANUP - - -AT_SETUP([FUNCTION FORMATTED-DATE]) -AT_KEYWORDS([functions]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 str PIC X(10). - PROCEDURE DIVISION. - *> Test normal inputs. - MOVE FUNCTION FORMATTED-DATE ( "YYYYMMDD", 1 ) TO str - IF str <> "16010101" - DISPLAY "Test 1 failed: " str END-DISPLAY - END-IF - - MOVE FUNCTION FORMATTED-DATE ( "YYYY-MM-DD", 1 ) TO str - IF str <> "1601-01-01" - DISPLAY "Test 2 failed: " str END-DISPLAY - END-IF - - MOVE FUNCTION FORMATTED-DATE ( "YYYYDDD", 1 ) TO str - IF str <> "1601001" - DISPLAY "Test 3 failed: " str END-DISPLAY - END-IF - - MOVE FUNCTION FORMATTED-DATE ( "YYYY-DDD", 1 ) TO str - IF str <> "1601-001" - DISPLAY "Test 4 failed: " str END-DISPLAY - END-IF - - MOVE FUNCTION FORMATTED-DATE ( "YYYYWwwD", 1 ) TO str - IF str <> "1601W011" - DISPLAY "Test 5 failed: " str END-DISPLAY - END-IF - - MOVE FUNCTION FORMATTED-DATE ( "YYYY-Www-D", 1 ) TO str - IF str <> "1601-W01-1" - DISPLAY "Test 6 failed: " str END-DISPLAY - END-IF - - *> Test week number edge cases. - *> For 2012-01-01. - MOVE FUNCTION FORMATTED-DATE ( "YYYYWwwD", 150115 ) TO str - IF str <> "2011W527" - DISPLAY "Test 7 failed: " str END-DISPLAY - END-IF - - *> and for 2013-12-30. - MOVE FUNCTION FORMATTED-DATE ( "YYYYWwwD", 150844 ) TO str - IF str <> "2014W011" - DISPLAY "Test 8 failed: " str END-DISPLAY - END-IF - - STOP RUN. -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [], []) - -AT_CLEANUP - - -AT_SETUP([FUNCTION FORMATTED-DATE with ref modding]) -AT_KEYWORDS([functions]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 str PIC X(04). - PROCEDURE DIVISION. - MOVE FUNCTION FORMATTED-DATE ("YYYYMMDD", 1) (3:4) - TO STR - IF STR NOT = '0101' - DISPLAY STR - END-DISPLAY - END-IF - STOP RUN. -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [], []) - -AT_CLEANUP - - -AT_SETUP([FUNCTION FORMATTED-DATETIME]) -AT_KEYWORDS([functions]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 str PIC X(40). - PROCEDURE DIVISION. - *> Test normal inputs. - MOVE FUNCTION FORMATTED-DATETIME - ("YYYYMMDDThhmmss", 1, 45296) - TO str - IF str <> "16010101T123456" - DISPLAY "Test 1 failed: " str END-DISPLAY - END-IF - - MOVE FUNCTION FORMATTED-DATETIME - ("YYYY-MM-DDThh:mm:ss", 1, 45296) - TO str - IF str <> "1601-01-01T12:34:56" - DISPLAY "Test 2 failed: " str END-DISPLAY - END-IF - - MOVE FUNCTION FORMATTED-DATETIME - ("YYYYDDDThhmmss+hhmm", 1, 45296, -754) - TO str - IF str <> "1601001T123456-1234" - DISPLAY "Test 3 failed: " str END-DISPLAY - END-IF - - MOVE FUNCTION FORMATTED-DATETIME - ("YYYYDDDThhmmss+hhmm", 1, 45296) - TO str - IF str <> "1601001T123456+0000" - DISPLAY "Test 4 failed: " str END-DISPLAY - END-IF - - *> Test underflow to next day due to offset - MOVE FUNCTION FORMATTED-DATETIME - ("YYYYDDDThhmmss.sssssssssZ", 150846, 0, - 1) - TO str - IF str <> "2013365T235900.000000000Z" - DISPLAY "Test 5 failed: " str END-DISPLAY - END-IF - - STOP RUN. -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [], []) - -AT_CLEANUP - - -AT_SETUP([FUNCTION FORMATTED-DATETIME with ref modding]) -AT_KEYWORDS([functions]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 str PIC X(04). - PROCEDURE DIVISION. - MOVE FUNCTION FORMATTED-DATETIME - ("YYYYMMDDThhmmss", 1, 1) (3:4) - TO STR - IF STR NOT = '0101' - DISPLAY STR - END-DISPLAY - END-IF - STOP RUN. -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [], []) - -AT_CLEANUP - - -AT_SETUP([FUNCTION FORMATTED-TIME]) -AT_KEYWORDS([functions]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 str PIC X(20). - PROCEDURE DIVISION. - *> Test normal inputs. - MOVE FUNCTION FORMATTED-TIME ( "hhmmss", 45296 ) TO str - IF str <> "123456" - DISPLAY "Test 1 failed: " str END-DISPLAY - END-IF - - MOVE FUNCTION FORMATTED-TIME ( "hh:mm:ss", 45296 ) TO str - IF str <> "12:34:56" - DISPLAY "Test 2 failed: " str END-DISPLAY - END-IF - - MOVE FUNCTION FORMATTED-TIME ( "hhmmssZ", 86399, -1 ) TO str - IF str <> "000059Z" - DISPLAY "Test 3 failed: " str END-DISPLAY - END-IF - - MOVE FUNCTION FORMATTED-TIME ( "hh:mm:ssZ", 45296) - TO str - IF str <> "12:34:56Z" - DISPLAY "Test 4 failed: " str END-DISPLAY - END-IF - - MOVE FUNCTION FORMATTED-TIME ( "hhmmss.ss", 45296.78 ) TO str - IF str <> "123456.78" - DISPLAY "Test 5 failed: " str END-DISPLAY - END-IF - - MOVE FUNCTION FORMATTED-TIME ( "hh:mm:ss.ssZ", 0, 120) - TO str - IF str <> "22:00:00.00Z" - DISPLAY "Test 6 failed: " str END-DISPLAY - END-IF - - MOVE FUNCTION FORMATTED-TIME ( "hhmmss+hhmm", 45296) - TO str - IF str <> "123456+0000" - DISPLAY "Test 7 failed: " str END-DISPLAY - END-IF - - MOVE FUNCTION FORMATTED-TIME ( "hh:mm:ss+hh:mm", 45296, 0 ) - TO str - IF str <> "12:34:56+00:00" - DISPLAY "Test 8 failed: " str END-DISPLAY - END-IF - - MOVE FUNCTION FORMATTED-TIME ( "hhmmss+hhmm", 45296, -754) - TO str - IF str <> "123456-1234" - DISPLAY "Test 9 failed: " str END-DISPLAY - END-IF - - *> Test with invalid/missing offset times. - MOVE FUNCTION FORMATTED-TIME ( "hhmmss+hhmm", 1, 3000 ) - TO str - IF str <> SPACES - OR FUNCTION EXCEPTION-STATUS <> "EC-ARGUMENT-FUNCTION" - OR FUNCTION EXCEPTION-LOCATION <> "prog; ; 60" - DISPLAY "Test 10 failed: " str END-DISPLAY - END-IF - - MOVE FUNCTION FORMATTED-TIME ( "hhmmss+hhmm", 1, -3000 ) - TO str - IF str <> SPACES - OR FUNCTION EXCEPTION-STATUS <> "EC-ARGUMENT-FUNCTION" - OR FUNCTION EXCEPTION-LOCATION <> "prog; ; 68" - DISPLAY "Test 11 failed: " str END-DISPLAY - END-IF - - STOP RUN. -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [], []) - -AT_CLEANUP - - -AT_SETUP([FUNCTION FORMATTED-TIME DP.COMMA]) -AT_KEYWORDS([functions]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - - ENVIRONMENT DIVISION. - CONFIGURATION SECTION. - SPECIAL-NAMES. - DECIMAL-POINT IS COMMA. - - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 str PIC X(11). - - PROCEDURE DIVISION. - MOVE FUNCTION FORMATTED-TIME ("hh:mm:ss,ss", 45296) TO str - IF str <> "12:34:56,00" - DISPLAY "Test 1 failed: " str END-DISPLAY - END-IF - - STOP RUN. -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [], []) - -AT_CLEANUP - - -AT_SETUP([FUNCTION FORMATTED-TIME with ref modding]) -AT_KEYWORDS([functions]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 str PIC X(04). - PROCEDURE DIVISION. - MOVE FUNCTION FORMATTED-TIME ("hhmmss", 45296) (3:4) - TO STR - IF STR NOT = '3456' - DISPLAY STR - END-DISPLAY - END-IF - STOP RUN. -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [], []) - -AT_CLEANUP - - -AT_SETUP([FUNCTION FRACTION-PART]) -AT_KEYWORDS([functions]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 TEST-FLD PIC S9(04)V9(08). - PROCEDURE DIVISION. - MOVE FUNCTION FRACTION-PART ( 3.12345 ) - TO TEST-FLD. - IF TEST-FLD NOT = +0000.12345 - DISPLAY 'FRACTION-PART ( +3.12345 ) wrong: ' TEST-FLD - END-DISPLAY - END-IF. - MOVE FUNCTION FRACTION-PART ( -3.12345 ) - TO TEST-FLD. - IF TEST-FLD NOT = -0000.12345 - DISPLAY 'FRACTION-PART ( -3.12345 ) wrong: ' TEST-FLD - END-DISPLAY - END-IF. - STOP RUN. -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [], []) - -AT_CLEANUP - - -AT_SETUP([FUNCTION HIGHEST-ALGEBRAIC]) -AT_KEYWORDS([functions]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 F1 PIC S999. - 01 F2 PIC S9(4) BINARY. - 01 F3 PIC 99V9(3). - 01 F4 PIC $**,**9.99BCR. - 01 F5 PIC $**,**9.99. - 01 F6 USAGE BINARY-CHAR SIGNED. - 01 F7 USAGE BINARY-CHAR UNSIGNED. - 01 TEST-FLD PIC S9(08)V9(04). - PROCEDURE DIVISION. - MOVE FUNCTION HIGHEST-ALGEBRAIC (F1) - TO TEST-FLD. - IF TEST-FLD NOT = 999 - DISPLAY "Test 1 fail: " TEST-FLD - END-DISPLAY - END-IF. - MOVE FUNCTION HIGHEST-ALGEBRAIC (F2) - TO TEST-FLD. - IF TEST-FLD NOT = 9999 - DISPLAY "Test 2 fail: " TEST-FLD - END-DISPLAY - END-IF. - MOVE FUNCTION HIGHEST-ALGEBRAIC (F3) - TO TEST-FLD. - IF TEST-FLD NOT = 99.999 - DISPLAY "Test 3 fail: " TEST-FLD - END-DISPLAY - END-IF. - MOVE FUNCTION HIGHEST-ALGEBRAIC (F4) - TO TEST-FLD. - IF TEST-FLD NOT = 99999.99 - DISPLAY "Test 4 fail: " TEST-FLD - END-DISPLAY - END-IF. - MOVE FUNCTION HIGHEST-ALGEBRAIC (F5) - TO TEST-FLD. - IF TEST-FLD NOT = 99999.99 - DISPLAY "Test 5 fail: " TEST-FLD - END-DISPLAY - END-IF. - MOVE FUNCTION HIGHEST-ALGEBRAIC (F6) - TO TEST-FLD. - IF TEST-FLD NOT = 127 - DISPLAY "Test 6 fail: " TEST-FLD - END-DISPLAY - END-IF. - MOVE FUNCTION HIGHEST-ALGEBRAIC (F7) - TO TEST-FLD. - IF TEST-FLD NOT = 255 - DISPLAY "Test 7 fail: " TEST-FLD - END-DISPLAY - END-IF. - STOP RUN. -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [], []) - -AT_CLEANUP - - -AT_SETUP([FUNCTION INTEGER]) -AT_KEYWORDS([functions]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 X PIC S9(4)V9(4) VALUE -1.5. - 01 Y PIC 9(12) VALUE 600851475143. - 01 TEST-FLD PIC S9(14)V9(08). - PROCEDURE DIVISION. - MOVE FUNCTION INTEGER ( X ) - TO TEST-FLD. - IF TEST-FLD NOT = -2 - DISPLAY 'INTEGER ( X ) wrong: ' TEST-FLD - END-DISPLAY - END-IF. - MOVE FUNCTION INTEGER ( Y / 71 ) - TO TEST-FLD. - IF TEST-FLD NOT = 8462696833 - DISPLAY 'INTEGER ( Y / 71 ) wrong: ' TEST-FLD - END-DISPLAY - END-IF. - STOP RUN. -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [], []) - -AT_CLEANUP - - -AT_SETUP([FUNCTION INTEGER-OF-DATE]) -AT_KEYWORDS([functions]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 TEST-FLD PIC S9(09)V9(02). - PROCEDURE DIVISION. - MOVE FUNCTION INTEGER-OF-DATE ( 20000925 ) - TO TEST-FLD. - IF TEST-FLD NOT = 000146000 - DISPLAY TEST-FLD - END-DISPLAY - END-IF. - STOP RUN. -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [], []) - -AT_CLEANUP - - -AT_SETUP([FUNCTION INTEGER-OF-DAY]) -AT_KEYWORDS([functions]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 TEST-FLD PIC S9(09)V9(02). - PROCEDURE DIVISION. - MOVE FUNCTION INTEGER-OF-DAY ( 2000269 ) - TO TEST-FLD. - IF TEST-FLD NOT = 000146000 - DISPLAY TEST-FLD - END-DISPLAY - END-IF. - STOP RUN. -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [], []) - -AT_CLEANUP - - -AT_SETUP([FUNCTION INTEGER-OF-FORMATTED-DATE]) -AT_KEYWORDS([functions]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 day-int PIC 9(9). - - PROCEDURE DIVISION. - *> The date 2013-12-30 is used as it can also be used to - *> check the conversion of dates in week form. - MOVE FUNCTION INTEGER-OF-FORMATTED-DATE - ("YYYY-MM-DD", "2013-12-30") - TO day-int - IF day-int <> 150844 - DISPLAY "Test 1 failed: " day-int END-DISPLAY - END-IF - - MOVE FUNCTION INTEGER-OF-FORMATTED-DATE - ("YYYY-DDD", "2013-364") - TO day-int - IF day-int <> 150844 - DISPLAY "Test 2 failed: " day-int END-DISPLAY - END-IF - - MOVE FUNCTION INTEGER-OF-FORMATTED-DATE - ("YYYY-Www-D", "2014-W01-1") - TO day-int - IF day-int <> 150844 - DISPLAY "Test 3 failed: " day-int END-DISPLAY - END-IF - - MOVE FUNCTION INTEGER-OF-FORMATTED-DATE - ("YYYY-MM-DDThh:mm:ss", "2013-12-30T12:34:56") - TO day-int - IF day-int <> 150844 - DISPLAY "Test 4 failed: " day-int END-DISPLAY - END-IF - - STOP RUN. -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [], []) - -AT_CLEANUP - - -AT_SETUP([FUNCTION INTEGER-PART]) -AT_KEYWORDS([functions]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 X PIC S9(4)V9(4) VALUE -1.5. - 01 TEST-FLD PIC S9(04)V9(02). - PROCEDURE DIVISION. - MOVE FUNCTION INTEGER-PART ( X ) - TO TEST-FLD. - IF TEST-FLD NOT = -1 - DISPLAY TEST-FLD - END-DISPLAY - END-IF. - STOP RUN. -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [], []) - -AT_CLEANUP - - -AT_SETUP([FUNCTION LENGTH]) -AT_KEYWORDS([functions]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 X PIC S9(4)V9(4) VALUE -1.5. - 01 N PIC N(9). - 01 TEST-FLD PIC S9(04)V9(02). - PROCEDURE DIVISION. - MOVE FUNCTION LENGTH ( X ) - TO TEST-FLD - IF TEST-FLD NOT = 8 - DISPLAY 'LENGTH "00128" wrong: ' TEST-FLD - END-DISPLAY - END-IF - MOVE FUNCTION LENGTH ( N ) - TO TEST-FLD - IF TEST-FLD NOT = 9 - DISPLAY 'LENGTH N(9) wrong: ' TEST-FLD - END-DISPLAY - END-IF - - MOVE FUNCTION LENGTH ( '00128' ) - TO TEST-FLD - IF TEST-FLD NOT = 5 - DISPLAY 'LENGTH "00128" wrong: ' TEST-FLD - END-DISPLAY - END-IF - * note: we currently do not support items of category boolean... - *> MOVE FUNCTION LENGTH ( b'100' ) - *> TO TEST-FLD - *> IF TEST-FLD NOT = 3 - *> DISPLAY 'LENGTH b"100" wrong: ' TEST-FLD - *> END-DISPLAY - *> END-IF - MOVE FUNCTION LENGTH ( x'a0' ) - TO TEST-FLD - IF TEST-FLD NOT = 1 - DISPLAY 'LENGTH x"a0" wrong: ' TEST-FLD - END-DISPLAY - END-IF - MOVE FUNCTION LENGTH ( z'a0' ) - TO TEST-FLD - IF TEST-FLD NOT = 3 - DISPLAY 'LENGTH z"a0" wrong: ' TEST-FLD - END-DISPLAY - END-IF - MOVE FUNCTION LENGTH ( n'a0' ) - TO TEST-FLD - IF TEST-FLD NOT = 2 - DISPLAY 'LENGTH n"a0" wrong: ' TEST-FLD - END-DISPLAY - END-IF - STOP RUN. -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], -[prog.cob:7: warning: handling of USAGE NATIONAL is unfinished; implementation is likely to be changed -prog.cob:48: warning: handling of national literal is unfinished; implementation is likely to be changed -]) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [], []) - -AT_CLEANUP - - -AT_SETUP([FUNCTION LOCALE-COMPARE]) -AT_KEYWORDS([functions]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - PROCEDURE DIVISION. - IF FUNCTION LOCALE-COMPARE ("A", "B") NOT = "<" - DISPLAY "Test 1 fail" - END-DISPLAY - END-IF. - IF FUNCTION LOCALE-COMPARE ("B", "A") NOT = ">" - DISPLAY "Test 2 fail" - END-DISPLAY - END-IF. - IF FUNCTION LOCALE-COMPARE ("A", "A") NOT = "=" - DISPLAY "Test 3 fail" - END-DISPLAY - END-IF. - STOP RUN. -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [], []) - -AT_CLEANUP - - -AT_SETUP([FUNCTION LOCALE-DATE]) -AT_KEYWORDS([functions]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 X PIC X(32) VALUE SPACES. - PROCEDURE DIVISION. - MOVE FUNCTION LOCALE-DATE ( "19630302" ) TO X. - IF X NOT = SPACES - DISPLAY "OK" - END-DISPLAY - END-IF. - STOP RUN. -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], -[OK -]) - -AT_CLEANUP - - -AT_SETUP([FUNCTION LOCALE-TIME]) -AT_KEYWORDS([functions]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 X PIC X(32) VALUE SPACES. - PROCEDURE DIVISION. - MOVE FUNCTION LOCALE-TIME ( "233012" ) TO X. - IF X NOT = SPACES - DISPLAY "OK" - END-DISPLAY - END-IF. - STOP RUN. -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], -[OK -]) - -AT_CLEANUP - - -AT_SETUP([FUNCTION LOCALE-TIME-FROM-SECONDS]) -AT_KEYWORDS([functions]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 X PIC X(32) VALUE SPACES. - PROCEDURE DIVISION. - MOVE FUNCTION LOCALE-TIME-FROM-SECONDS ( 33012 ) TO X. - IF X NOT = SPACES - DISPLAY "OK" - END-DISPLAY - END-IF. - STOP RUN. -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], -[OK -]) - -AT_CLEANUP - - -AT_SETUP([FUNCTION LOG]) -AT_KEYWORDS([functions]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 Y PIC S9V9(35). - PROCEDURE DIVISION. - MOVE FUNCTION LOG ( 1.5 ) TO Y. - IF Y NOT = 0.40546510810816438197801311546434913 - DISPLAY Y - END-DISPLAY - END-IF. - STOP RUN. -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [], []) - -AT_CLEANUP - - -AT_SETUP([FUNCTION LOG10]) -AT_KEYWORDS([functions]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 Y PIC S9V9(35). - PROCEDURE DIVISION. - MOVE FUNCTION LOG10 ( 1.5 ) TO Y. - IF Y NOT = 0.17609125905568124208128900853062228 - DISPLAY Y - END-DISPLAY - END-IF. - STOP RUN. -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [], []) - -AT_CLEANUP - - -AT_SETUP([FUNCTION LOWER-CASE]) -AT_KEYWORDS([functions]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 X PIC X(10) VALUE "A#B.C%D+E$". - 01 TEST-FLD PIC X(12) VALUE ALL '_'. - PROCEDURE DIVISION. - STRING FUNCTION LOWER-CASE ( X ) - DELIMITED BY SIZE - INTO TEST-FLD - END-STRING - IF TEST-FLD NOT = 'a#b.c%d+e$__' - DISPLAY TEST-FLD - END-DISPLAY - END-IF. - STOP RUN. -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [], []) - -AT_CLEANUP - - -AT_SETUP([FUNCTION LOWER-CASE with reference modding]) -AT_KEYWORDS([functions]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 X PIC X(10) VALUE "A#B.C%D+E$". - 01 TEST-FLD PIC X(03). - PROCEDURE DIVISION. - MOVE FUNCTION LOWER-CASE ( X ) (1 : 3) - TO TEST-FLD - IF TEST-FLD NOT = 'a#b' - DISPLAY TEST-FLD - END-DISPLAY - END-IF. - STOP RUN. -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [], []) - -AT_CLEANUP - - -AT_SETUP([FUNCTION LOWEST-ALGEBRAIC]) -AT_KEYWORDS([functions]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 F1 PIC S999. - 01 F2 PIC S9(4) BINARY. - 01 F3 PIC 99V9(3). - 01 F4 PIC $**,**9.99BCR. - 01 F5 PIC $**,**9.99. - 01 F6 USAGE BINARY-CHAR SIGNED. - 01 F7 USAGE BINARY-CHAR UNSIGNED. - PROCEDURE DIVISION. - IF FUNCTION LOWEST-ALGEBRAIC (F1) NOT = -999 - DISPLAY "Test 1 fail" - END-DISPLAY - END-IF. - IF FUNCTION LOWEST-ALGEBRAIC (F2) NOT = -9999 - DISPLAY "Test 2 fail" - END-DISPLAY - END-IF. - IF FUNCTION LOWEST-ALGEBRAIC (F3) NOT = 0 - DISPLAY "Test 3 fail" - END-DISPLAY - END-IF. - IF FUNCTION LOWEST-ALGEBRAIC (F4) NOT = -99999.99 - DISPLAY "Test 4 fail" - END-DISPLAY - END-IF. - IF FUNCTION LOWEST-ALGEBRAIC (F5) NOT = 0 - DISPLAY "Test 5 fail" - END-DISPLAY - END-IF. - IF FUNCTION LOWEST-ALGEBRAIC (F6) NOT = -128 - DISPLAY "Test 6 fail" - END-DISPLAY - END-IF. - IF FUNCTION LOWEST-ALGEBRAIC (F7) NOT = 0 - DISPLAY "Test 7 fail" - END-DISPLAY - END-IF. - STOP RUN. -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [], []) - -AT_CLEANUP - - -AT_SETUP([FUNCTION MAX]) -AT_KEYWORDS([functions]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - PROCEDURE DIVISION. - DISPLAY FUNCTION MAX ( 3 -14 0 8 -3 ) - END-DISPLAY. - STOP RUN. -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], -[8 -], []) - -AT_CLEANUP - - -AT_SETUP([FUNCTION MEAN]) -AT_KEYWORDS([functions]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - PROCEDURE DIVISION. - DISPLAY FUNCTION MEAN ( 3 -14 0 8 -3 ) - END-DISPLAY. - STOP RUN. -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], -[-00000001.2 -]) - -AT_CLEANUP - - -AT_SETUP([FUNCTION MEDIAN]) -AT_KEYWORDS([functions]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - PROCEDURE DIVISION. - DISPLAY FUNCTION MEDIAN ( 3 -14 0 8 -3 ) - END-DISPLAY. - STOP RUN. -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], -[0 -]) - -AT_CLEANUP - - -AT_SETUP([FUNCTION MIDRANGE]) -AT_KEYWORDS([functions]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - PROCEDURE DIVISION. - DISPLAY FUNCTION MIDRANGE ( 3 -14 0 8 -3 ) - END-DISPLAY. - STOP RUN. -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], -[-000000003 -]) - -AT_CLEANUP - - -AT_SETUP([FUNCTION MIN]) -AT_KEYWORDS([functions]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - PROCEDURE DIVISION. - DISPLAY FUNCTION MIN ( 3 -14 0 8 -3 ) - END-DISPLAY. - STOP RUN. -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], -[-14 -]) - -AT_CLEANUP - - -AT_SETUP([FUNCTION MOD (valid)]) -AT_KEYWORDS([functions]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 Y PIC 9(12) VALUE 600851475143. - 01 R PIC S9(4)V9(4) VALUE 0. - PROCEDURE DIVISION. - MOVE FUNCTION MOD ( -11 5 ) TO R - IF R NOT = 4 - DISPLAY 'first one wrong: ' R - END-DISPLAY - END-IF - MOVE FUNCTION MOD ( Y, 71 ) TO R - IF R NOT = 0 - DISPLAY 'second one wrong: ' R - END-DISPLAY - END-IF - STOP RUN. -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [], []) - -AT_CLEANUP - - -AT_SETUP([FUNCTION MOD (invalid)]) -AT_KEYWORDS([functions exceptions]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 Z PIC 9 VALUE 0. - 01 R PIC S9(4)V9(4) VALUE 1. - PROCEDURE DIVISION. - MOVE FUNCTION MOD ( -11 Z ) TO R - IF FUNCTION TRIM(FUNCTION EXCEPTION-STATUS) - NOT = 'EC-ARGUMENT-FUNCTION' - DISPLAY 'Wrong/missing exception: ' - FUNCTION EXCEPTION-STATUS - END-DISPLAY - END-IF - IF R NOT = 0 - DISPLAY 'result is not zero: ' R - END-DISPLAY - END-IF - STOP RUN. -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [], []) - -AT_CLEANUP - - -AT_SETUP([FUNCTION MODULE-CALLER-ID]) -AT_KEYWORDS([functions]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - DATA DIVISION. - WORKING-STORAGE SECTION. - PROCEDURE DIVISION. - CALL "prog2" - END-CALL. - STOP RUN. -]) - -AT_DATA([prog2.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog2. - ENVIRONMENT DIVISION. - DATA DIVISION. - WORKING-STORAGE SECTION. - PROCEDURE DIVISION. - DISPLAY FUNCTION MODULE-CALLER-ID NO ADVANCING - END-DISPLAY. - EXIT PROGRAM. -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$COMPILE_MODULE prog2.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [prog]) - -AT_CLEANUP - - -AT_SETUP([FUNCTION MODULE-DATE]) -AT_KEYWORDS([functions]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 TEST-DATE PIC 9(8) VALUE 0. - PROCEDURE DIVISION. - MOVE FUNCTION MODULE-DATE TO TEST-DATE. - IF TEST-DATE NOT = 0 - DISPLAY "OK" NO ADVANCING - END-DISPLAY - END-IF. - STOP RUN. -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [OK], []) - -AT_CLEANUP - - -AT_SETUP([FUNCTION MODULE-FORMATTED-DATE]) -AT_KEYWORDS([functions]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 TEST-DATE PIC X(16) VALUE SPACES. - PROCEDURE DIVISION. - MOVE FUNCTION MODULE-FORMATTED-DATE TO TEST-DATE. - IF TEST-DATE NOT = SPACES - DISPLAY "OK" NO ADVANCING - END-DISPLAY - END-IF. - STOP RUN. -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [OK], []) - -AT_CLEANUP - - -AT_SETUP([FUNCTION MODULE-ID]) -AT_KEYWORDS([functions]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - DATA DIVISION. - WORKING-STORAGE SECTION. - PROCEDURE DIVISION. - DISPLAY FUNCTION MODULE-ID NO ADVANCING - END-DISPLAY. - STOP RUN. -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [prog]) - -AT_CLEANUP - - -AT_SETUP([FUNCTION MODULE-PATH]) -AT_KEYWORDS([functions]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 TEST-PATH PIC X(16) VALUE SPACES. - PROCEDURE DIVISION. - MOVE FUNCTION MODULE-PATH TO TEST-PATH. - IF TEST-PATH NOT = SPACES - DISPLAY "OK" NO ADVANCING - END-DISPLAY - END-IF. - STOP RUN. -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [OK], []) - -AT_CLEANUP - - -AT_SETUP([FUNCTION MODULE-SOURCE]) -AT_KEYWORDS([functions]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - DATA DIVISION. - WORKING-STORAGE SECTION. - PROCEDURE DIVISION. - DISPLAY FUNCTION MODULE-SOURCE NO ADVANCING - END-DISPLAY. - STOP RUN. -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [prog.cob]) - -AT_CLEANUP - - -AT_SETUP([FUNCTION MODULE-TIME]) -AT_KEYWORDS([functions]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 TEST-TIME PIC 9(6) VALUE 0. - PROCEDURE DIVISION. - MOVE FUNCTION MODULE-TIME TO TEST-TIME. - IF TEST-TIME NOT = 0 - DISPLAY "OK" NO ADVANCING - END-DISPLAY - END-IF. - STOP RUN. -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [OK], []) - -AT_CLEANUP - - -AT_SETUP([FUNCTION MONETARY-DECIMAL-POINT]) -AT_KEYWORDS([functions]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 TEST-FLD PIC X(8) VALUE SPACES. - PROCEDURE DIVISION. - MOVE FUNCTION MONETARY-DECIMAL-POINT TO TEST-FLD. - DISPLAY "OK" NO ADVANCING - END-DISPLAY - STOP RUN. -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [OK], []) - -AT_CLEANUP - - -AT_SETUP([FUNCTION MONETARY-THOUSANDS-SEPARATOR]) -AT_KEYWORDS([functions]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 TEST-FLD PIC X(8) VALUE SPACES. - PROCEDURE DIVISION. - MOVE FUNCTION MONETARY-THOUSANDS-SEPARATOR TO TEST-FLD. - DISPLAY "OK" NO ADVANCING - END-DISPLAY - STOP RUN. -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [OK], []) - -AT_CLEANUP - - -AT_SETUP([FUNCTION NUMERIC-DECIMAL-POINT]) -AT_KEYWORDS([functions]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 TEST-FLD PIC X(8) VALUE SPACES. - PROCEDURE DIVISION. - MOVE FUNCTION NUMERIC-DECIMAL-POINT TO TEST-FLD. - DISPLAY "OK" NO ADVANCING - END-DISPLAY - STOP RUN. -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [OK], []) - -AT_CLEANUP - - -AT_SETUP([FUNCTION NUMERIC-THOUSANDS-SEPARATOR]) -AT_KEYWORDS([functions]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 TEST-FLD PIC X(8) VALUE SPACES. - PROCEDURE DIVISION. - MOVE FUNCTION NUMERIC-THOUSANDS-SEPARATOR TO TEST-FLD. - DISPLAY "OK" NO ADVANCING - END-DISPLAY - STOP RUN. -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [OK], []) - -AT_CLEANUP - - -AT_SETUP([FUNCTION NUMVAL]) -AT_KEYWORDS([functions]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 X1 PIC X(12) VALUE " -9876.1234 ". - 01 X2 PIC X(18) VALUE " 19876.1234 CR". - 01 N PIC s9(5)v9(5). - PROCEDURE DIVISION. - MOVE FUNCTION NUMVAL ( X1 ) TO N - IF N NOT = -9876.1234 - DISPLAY N - END-DISPLAY - END-IF - MOVE FUNCTION NUMVAL ( X2 ) TO N - IF N NOT = -19876.1234 - DISPLAY N - END-DISPLAY - END-IF - STOP RUN. -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [], []) - -AT_CLEANUP - - -AT_SETUP([FUNCTION NUMVAL-C]) -AT_KEYWORDS([functions]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 X1 PIC X(14) VALUE " % -9876.1234 ". - 01 X2 PIC X(20) VALUE " % 19,876.1234 DB". - 01 N PIC s9(5)v9(5). - PROCEDURE DIVISION. - MOVE FUNCTION NUMVAL-C ( X1 , "%" ) TO N - IF N NOT = -9876.1234 - DISPLAY N - END-DISPLAY - END-IF - MOVE FUNCTION NUMVAL-C ( X2 , "%" ) TO N - IF N NOT = -19876.1234 - DISPLAY N - END-DISPLAY - END-IF - STOP RUN. -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [], []) - -AT_CLEANUP - - -AT_SETUP([FUNCTION NUMVAL-C DP.COMMA]) -AT_KEYWORDS([functions]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - CONFIGURATION SECTION. - SPECIAL-NAMES. - DECIMAL-POINT IS COMMA - . - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 X1 PIC X(20) VALUE " % 19.876,1234 DB". - 01 N PIC s9(5)v9(5). - PROCEDURE DIVISION. - MOVE FUNCTION NUMVAL-C ( X1 , "%" ) TO N - IF N NOT = -19876,1234 - DISPLAY N - END-DISPLAY - END-IF - STOP RUN. -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [], []) - -AT_CLEANUP - - -AT_SETUP([FUNCTION NUMVAL-F]) -AT_KEYWORDS([functions]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 X PIC X(12) VALUE " -0.1234E+4 ". - PROCEDURE DIVISION. - DISPLAY FUNCTION NUMVAL-F ( X ) - END-DISPLAY. - STOP RUN. -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], -[-000001234 -]) - -AT_CLEANUP - - -AT_SETUP([FUNCTION ORD]) -AT_KEYWORDS([functions]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - PROCEDURE DIVISION. - DISPLAY FUNCTION ORD ( "k" ) - END-DISPLAY. - STOP RUN. -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], -[0000000108 -]) - -AT_CLEANUP - - -AT_SETUP([FUNCTION ORD-MAX]) -AT_KEYWORDS([functions]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - PROCEDURE DIVISION. - DISPLAY FUNCTION ORD-MAX ( 3 -14 0 8 -3 ) - END-DISPLAY. - STOP RUN. -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], -[0000000004 -]) - -AT_CLEANUP - - -AT_SETUP([FUNCTION ORD-MIN]) -AT_KEYWORDS([functions]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - PROCEDURE DIVISION. - DISPLAY FUNCTION ORD-MIN ( 3 -14 0 8 -3 ) - END-DISPLAY. - STOP RUN. -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], -[0000000002 -]) - -AT_CLEANUP - - -AT_SETUP([FUNCTION PI]) -AT_KEYWORDS([functions]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 Y PIC 9V9(35). - PROCEDURE DIVISION. - MOVE FUNCTION PI TO Y. - IF Y NOT = 3.14159265358979323846264338327950288 - DISPLAY Y - END-DISPLAY - END-IF. - STOP RUN. -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [], []) - -AT_CLEANUP - - -AT_SETUP([FUNCTION PRESENT-VALUE]) -AT_KEYWORDS([functions]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - PROCEDURE DIVISION. - DISPLAY FUNCTION PRESENT-VALUE ( 3 2 1 ) - END-DISPLAY. - STOP RUN. -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], -[00000.5625 -]) - -AT_CLEANUP - - -AT_SETUP([FUNCTION RANDOM]) -AT_KEYWORDS([functions]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 Y PIC S99V99 COMP VALUE -1.0. - PROCEDURE DIVISION. - MOVE FUNCTION RANDOM ( ) TO Y. - IF Y < 0 - DISPLAY Y - END-DISPLAY - END-IF. - STOP RUN. -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [], []) - -AT_CLEANUP - - -AT_SETUP([FUNCTION RANGE]) -AT_KEYWORDS([functions]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 Z PIC S9(4)V9(4) COMP-5. - PROCEDURE DIVISION. - MOVE FUNCTION RANGE ( 3 -14 0 8 -3 ) TO Z. - IF Z NOT = 22 - DISPLAY Z - END-DISPLAY - END-IF. - STOP RUN. -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [], []) - -AT_CLEANUP - - -AT_SETUP([FUNCTION REM (valid)]) -AT_KEYWORDS([functions]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 R PIC S9(4)V9(4) COMP-5 VALUE 0. - PROCEDURE DIVISION. - MOVE FUNCTION REM ( -11 5 ) TO R - IF R NOT = -1 - DISPLAY R END-DISPLAY - END-IF - STOP RUN. -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [], []) - -AT_CLEANUP - - -AT_SETUP([FUNCTION REM (invalid)]) -AT_KEYWORDS([functions exceptions]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 R PIC S9(4)V9(4) COMP-5 VALUE 4.1. - 01 Z PIC 9 COMP-5 VALUE 0. - PROCEDURE DIVISION. - MOVE FUNCTION REM ( -11 Z ) TO R - IF FUNCTION TRIM(FUNCTION EXCEPTION-STATUS) - NOT = 'EC-ARGUMENT-FUNCTION' - DISPLAY 'Wrong/missing exception: ' - FUNCTION EXCEPTION-STATUS - END-DISPLAY - END-IF - IF R NOT = 0 - DISPLAY 'result is not zero: ' R - END-DISPLAY - END-IF - STOP RUN. -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [], []) - -AT_CLEANUP - - -AT_SETUP([FUNCTION REVERSE]) -AT_KEYWORDS([functions]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 X PIC X(10) VALUE "A#B.C%D+E$". - 01 Z PIC X(10). - PROCEDURE DIVISION. - MOVE FUNCTION REVERSE ( X ) TO Z. - IF Z NOT = "$E+D%C.B#A" - DISPLAY Z - END-DISPLAY - END-IF. - STOP RUN. -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [], []) - -AT_CLEANUP - - -AT_SETUP([FUNCTION REVERSE with reference modding]) -AT_KEYWORDS([functions]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 X PIC X(10) VALUE "A#B.C%D+E$". - 01 Z PIC X(10). - PROCEDURE DIVISION. - MOVE FUNCTION REVERSE ( X ) (1 : 4) TO Z. - IF Z NOT = "$E+D " - DISPLAY Z - END-DISPLAY - END-IF. - STOP RUN. -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [], []) - -AT_CLEANUP - - -AT_SETUP([FUNCTION SECONDS-FROM-FORMATTED-TIME]) -AT_KEYWORDS([functions]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 result PIC 9(8)V9(9) COMP-5. - PROCEDURE DIVISION. - MOVE FUNCTION SECONDS-FROM-FORMATTED-TIME - ("hhmmss", "010203") - TO result. - IF result NOT = 3723 - DISPLAY "Test 1 failed: " result - END-DISPLAY - END-IF. - - MOVE FUNCTION SECONDS-FROM-FORMATTED-TIME - ("hh:mm:ss", "01:02:03") - TO result. - IF result NOT = 3723 - DISPLAY "Test 2 failed: " result - END-DISPLAY - END-IF. - - MOVE FUNCTION SECONDS-FROM-FORMATTED-TIME - ("hhmmss.ssssssss", "010203.04050607") - TO result. - IF result NOT = 3723.04050607 - DISPLAY "Test 3 failed: " result - END-DISPLAY - END-IF. - - MOVE FUNCTION SECONDS-FROM-FORMATTED-TIME - ("hhmmssZ", "010203Z") - TO result. - IF result NOT = 3723 - DISPLAY "Test 4 failed: " result - END-DISPLAY - END-IF. - - MOVE FUNCTION SECONDS-FROM-FORMATTED-TIME - ("hhmmss+hhmm", "010203+0405") - TO result. - IF result NOT = 3723 - DISPLAY "Test 5 failed: " result - END-DISPLAY - END-IF. - - MOVE FUNCTION SECONDS-FROM-FORMATTED-TIME - ("YYYYMMDDThhmmss", "16010101T010203") - TO result. - IF result NOT = 3723 - DISPLAY "Test 6 failed: " result - END-DISPLAY - END-IF. - - STOP RUN. -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [], []) - -AT_CLEANUP - - -AT_SETUP([FUNCTION SECONDS-PAST-MIDNIGHT]) -AT_KEYWORDS([functions]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 Y PIC 9(8) COMP-5. - PROCEDURE DIVISION. - MOVE FUNCTION SECONDS-PAST-MIDNIGHT TO Y. - IF Y NOT < 86402 - DISPLAY Y - END-DISPLAY - END-IF. - STOP RUN. -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [], []) - -AT_CLEANUP - - -AT_SETUP([FUNCTION SIGN]) -AT_KEYWORDS([functions]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 Z USAGE BINARY-LONG SIGNED. - PROCEDURE DIVISION. - MOVE FUNCTION SIGN ( 3.12345 ) TO Z. - IF Z NOT = 1 - DISPLAY "Sign 1 " Z - END-DISPLAY - END-IF. - MOVE FUNCTION SIGN ( -0.0 ) TO Z. - IF Z NOT = 0 - DISPLAY "Sign 2 " Z - END-DISPLAY - END-IF. - MOVE FUNCTION SIGN ( 0.0 ) TO Z. - IF Z NOT = 0 - DISPLAY "Sign 3 " Z - END-DISPLAY - END-IF. - MOVE FUNCTION SIGN ( -3.12345 ) TO Z. - IF Z NOT = -1 - DISPLAY "Sign 4 " Z - END-DISPLAY - END-IF. - STOP RUN. -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [], []) - -AT_CLEANUP - - -AT_SETUP([FUNCTION SIN]) -AT_KEYWORDS([functions]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 Y PIC S9V9(35). - PROCEDURE DIVISION. - MOVE FUNCTION SIN ( 1.5 ) TO Y. - IF Y NOT = 0.99749498660405443094172337114148732 - DISPLAY Y - END-DISPLAY - END-IF. - STOP RUN. -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [], []) - -AT_CLEANUP - - -AT_SETUP([FUNCTION SQRT]) -AT_KEYWORDS([functions]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 Y PIC S9V9(35). - PROCEDURE DIVISION. - MOVE FUNCTION SQRT ( 1.5 ) TO Y. - IF Y NOT = 1.22474487139158904909864203735294569 - DISPLAY Y - END-DISPLAY - END-IF. - STOP RUN. -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [], []) - -AT_CLEANUP - - -AT_SETUP([FUNCTION STANDARD-DEVIATION]) -AT_KEYWORDS([functions]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 Y PIC S9V9(35). - PROCEDURE DIVISION. - MOVE FUNCTION STANDARD-DEVIATION ( 3 -14 0 8 -3 ) TO Y. - IF Y NOT = 7.35934779718963954877237043574538183 - DISPLAY Y - END-DISPLAY - END-IF. - STOP RUN. -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [], []) - -AT_CLEANUP - - -AT_SETUP([FUNCTION STORED-CHAR-LENGTH]) -AT_KEYWORDS([functions]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 Y PIC X(24). - 01 Z USAGE BINARY-LONG. - PROCEDURE DIVISION. - MOVE "123456789012" TO Y. - MOVE FUNCTION STORED-CHAR-LENGTH ( Y ) TO Z. - IF Z NOT = 12 - DISPLAY Z - END-DISPLAY - END-IF. - STOP RUN. -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [], []) - -AT_CLEANUP - - -AT_SETUP([FUNCTION SUBSTITUTE]) -AT_KEYWORDS([functions]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 Y PIC X(20). - 01 Z PIC X(20) VALUE ALL '_'. - PROCEDURE DIVISION. - MOVE "abc111444555defxxabc" TO Y. - STRING FUNCTION SUBSTITUTE ( Y "abc" "zz" "55" "666" ) - DELIMITED BY SIZE - INTO Z - END-STRING - IF Z NOT = "zz1114446665defxxzz_" - DISPLAY Z - END-DISPLAY - END-IF. - STOP RUN. -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [], []) - -AT_CLEANUP - - -AT_SETUP([FUNCTION SUBSTITUTE with reference modding]) -AT_KEYWORDS([functions]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 Y PIC X(20). - 01 Z PIC X(20). - PROCEDURE DIVISION. - MOVE "abc111444555defxxabc" TO Y. - MOVE FUNCTION SUBSTITUTE - ( Y "abc" "zz" "55" "666" ) (2 : 9) - TO Z. - IF Z NOT = "z11144466" - DISPLAY Z - END-DISPLAY - END-IF. - STOP RUN. -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [], []) - -AT_CLEANUP - - -AT_SETUP([FUNCTION SUBSTITUTE-CASE]) -AT_KEYWORDS([functions]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 Y PIC X(20). - 01 Z PIC X(20). - PROCEDURE DIVISION. - MOVE "ABC111444555defxxabc" TO Y. - MOVE FUNCTION SUBSTITUTE-CASE (Y "abc" "zz" "55" "666") - TO Z. - IF Z NOT = "zz1114446665defxxzz" - DISPLAY Z - END-DISPLAY - END-IF. - STOP RUN. -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [], []) - -AT_CLEANUP - - -AT_SETUP([FUNCTION SUBSTITUTE-CASE with reference mod]) -AT_KEYWORDS([functions]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 Y PIC X(20). - 01 Z PIC X(20). - PROCEDURE DIVISION. - MOVE "abc111444555defxxabc" TO Y. - MOVE FUNCTION SUBSTITUTE-CASE - ( Y "ABC" "zz" "55" "666" ) (2 : 9) - TO Z. - IF Z NOT = "z11144466" - DISPLAY Z - END-DISPLAY - END-IF. - STOP RUN. -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [], []) - -AT_CLEANUP - - -AT_SETUP([FUNCTION SUM]) -AT_KEYWORDS([functions]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 Z USAGE BINARY-LONG. - PROCEDURE DIVISION. - MOVE FUNCTION SUM ( 3 -14 0 8 -3 ) TO Z. - IF Z NOT = -6 - DISPLAY Z - END-DISPLAY - END-IF. - STOP RUN. -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [], []) - -AT_CLEANUP - - -AT_SETUP([FUNCTION TAN]) -AT_KEYWORDS([functions]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 Y PIC S99V9(34). - PROCEDURE DIVISION. - MOVE FUNCTION TAN ( 1.5 ) TO Y. - IF Y NOT = 14.1014199471717193876460836519877564 - DISPLAY Y - END-DISPLAY - END-IF. - STOP RUN. -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [], []) - -AT_CLEANUP - - -AT_SETUP([FUNCTION TEST-DATE-YYYYMMDD]) -AT_KEYWORDS([functions]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - PROCEDURE DIVISION. - DISPLAY FUNCTION TEST-DATE-YYYYMMDD ( 20020231 ) - END-DISPLAY. - STOP RUN. -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], -[0000000003 -]) - -AT_CLEANUP - - -AT_SETUP([FUNCTION TEST-DAY-YYYYDDD]) -AT_KEYWORDS([functions]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - PROCEDURE DIVISION. - DISPLAY FUNCTION TEST-DAY-YYYYDDD ( 2002400 ) - END-DISPLAY. - STOP RUN. -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], -[0000000002 -]) - -AT_CLEANUP - - -AT_SETUP([FUNCTION TEST-FORMATTED-DATETIME with dates]) -AT_KEYWORDS([functions]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - PROCEDURE DIVISION. - IF FUNCTION TEST-FORMATTED-DATETIME - ("YYYYMMDD", "16010101") <> 0 - DISPLAY "Test 1 failed" END-DISPLAY - END-IF - IF FUNCTION TEST-FORMATTED-DATETIME - ("YYYY-MM-DD", "1601-01-01") <> 0 - DISPLAY "Test 2 failed" END-DISPLAY - END-IF - IF FUNCTION TEST-FORMATTED-DATETIME - ("YYYYDDD", "1601001") <> 0 - DISPLAY "Test 3 failed" END-DISPLAY - END-IF - IF FUNCTION TEST-FORMATTED-DATETIME - ("YYYY-DDD", "1601-001") <> 0 - DISPLAY "Test 4 failed" END-DISPLAY - END-IF - IF FUNCTION TEST-FORMATTED-DATETIME - ("YYYYWwwD", "1601W011") <> 0 - DISPLAY "Test 5 failed" END-DISPLAY - END-IF - IF FUNCTION TEST-FORMATTED-DATETIME - ("YYYY-Www-D", "1601-W01-1") <> 0 - DISPLAY "Test 6 failed" END-DISPLAY - END-IF - - - *> How will this work with zero-length items? - IF FUNCTION TEST-FORMATTED-DATETIME - ("YYYYMMDD", "1") <> 2 - DISPLAY "Test 7 failed" END-DISPLAY - END-IF - IF FUNCTION TEST-FORMATTED-DATETIME - ("YYYYMMDD", "160A0101") <> 4 - DISPLAY "Test 8 failed" END-DISPLAY - END-IF - IF FUNCTION TEST-FORMATTED-DATETIME - ("YYYYMMDD", "00000101") <> 1 - DISPLAY "Test 9 failed" END-DISPLAY - END-IF - IF FUNCTION TEST-FORMATTED-DATETIME - ("YYYYMMDD", "16000101") <> 4 - DISPLAY "Test 10 failed" END-DISPLAY - END-IF - IF FUNCTION TEST-FORMATTED-DATETIME - ("YYYYMMDD", "16010001") <> 6 - DISPLAY "Test 11 failed" END-DISPLAY - END-IF - IF FUNCTION TEST-FORMATTED-DATETIME - ("YYYYMMDD", "16011301") <> 6 - DISPLAY "Test 12 failed" END-DISPLAY - END-IF - IF FUNCTION TEST-FORMATTED-DATETIME - ("YYYYMMDD", "16010190") <> 7 - DISPLAY "Test 13 failed" END-DISPLAY - END-IF - IF FUNCTION TEST-FORMATTED-DATETIME - ("YYYYMMDD", "18000229") <> 8 - DISPLAY "Test 14 failed" END-DISPLAY - END-IF - IF FUNCTION TEST-FORMATTED-DATETIME - ("YYYY-MM-DD", "1601 01 01") <> 5 - DISPLAY "Test 15 failed" END-DISPLAY - END-IF - IF FUNCTION TEST-FORMATTED-DATETIME - ("YYYYMMDD", "160101010") <> 9 - DISPLAY "Test 16 failed" END-DISPLAY - END-IF - IF FUNCTION TEST-FORMATTED-DATETIME - ("YYYYWwwD", "1601A011") <> 5 - DISPLAY "Test 17 failed" END-DISPLAY - END-IF - IF FUNCTION TEST-FORMATTED-DATETIME - ("YYYYWwwD", "1601W531") <> 7 - DISPLAY "Test 18 failed" END-DISPLAY - END-IF - IF FUNCTION TEST-FORMATTED-DATETIME - ("YYYYWwwD", "1601W601") <> 6 - DISPLAY "Test 19 failed" END-DISPLAY - END-IF - IF FUNCTION TEST-FORMATTED-DATETIME - ("YYYYWwwD", "2009W531") <> 0 - DISPLAY "Test 20 failed" END-DISPLAY - END-IF - IF FUNCTION TEST-FORMATTED-DATETIME - ("YYYYWwwD", "1601W018") <> 8 - DISPLAY "Test 21 failed" END-DISPLAY - END-IF - IF FUNCTION TEST-FORMATTED-DATETIME - ("YYYYDDD", "1601366") <> 7 - DISPLAY "Test 22 failed" END-DISPLAY - END-IF - IF FUNCTION TEST-FORMATTED-DATETIME - ("YYYYDDD", "1601370") <> 6 - DISPLAY "Test 23 failed" END-DISPLAY - END-IF - IF FUNCTION TEST-FORMATTED-DATETIME - ("YYYYDDD", "1601400") <> 5 - DISPLAY "Test 24 failed" END-DISPLAY - END-IF - IF FUNCTION TEST-FORMATTED-DATETIME - ("YYYYMMDD", "01") <> 1 - DISPLAY "Test 25 failed" END-DISPLAY - END-IF - IF FUNCTION TEST-FORMATTED-DATETIME - ("YYYYMMDD", "1601010") <> 8 - DISPLAY "Test 26 failed" END-DISPLAY - END-IF - - STOP RUN - . -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [], []) - -AT_CLEANUP - - -AT_SETUP([FUNCTION TEST-FORMATTED-DATETIME with times]) -AT_KEYWORDS([functions]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - PROCEDURE DIVISION. - IF FUNCTION TEST-FORMATTED-DATETIME - ("hhmmss.sssssssssZ", "000000.000000000Z") <> 0 - DISPLAY "Test 1 failed" END-DISPLAY - END-IF - IF FUNCTION TEST-FORMATTED-DATETIME - ("hh:mm:ss.sssssssssZ", "00:00:00.000000000Z") <> 0 - DISPLAY "Test 2 failed" END-DISPLAY - END-IF - *> 0 instead of +/- valid in sending fields with offset of zero. - IF FUNCTION TEST-FORMATTED-DATETIME - ("hhmmss.sssssssss+hhmm", "000000.00000000000000") - <> 0 - DISPLAY "Test 3 failed" END-DISPLAY - END-IF - IF FUNCTION TEST-FORMATTED-DATETIME - ("hh:mm:ss.sssssssss+hh:mm", - "00:00:00.000000000+00:00") - <> 0 - DISPLAY "Test 4 failed" END-DISPLAY - END-IF - - IF FUNCTION TEST-FORMATTED-DATETIME - ("hhmmss", "300000") <> 1 - DISPLAY "Test 5 failed" END-DISPLAY - END-IF - IF FUNCTION TEST-FORMATTED-DATETIME - ("hhmmss", "250000") <> 2 - DISPLAY "Test 6 failed" END-DISPLAY - END-IF - IF FUNCTION TEST-FORMATTED-DATETIME - ("hhmmss", "006000") <> 3 - DISPLAY "Test 7 failed" END-DISPLAY - END-IF - IF FUNCTION TEST-FORMATTED-DATETIME - ("hhmmss", "000060") <> 5 - DISPLAY "Test 8 failed" END-DISPLAY - END-IF - IF FUNCTION TEST-FORMATTED-DATETIME - ("hh:mm:ss", "00-00-00") <> 3 - DISPLAY "Test 9 failed" END-DISPLAY - END-IF - IF FUNCTION TEST-FORMATTED-DATETIME - ("hhmmss.ss", "000000,00") <> 7 - DISPLAY "Test 10 failed" END-DISPLAY - END-IF - IF FUNCTION TEST-FORMATTED-DATETIME - ("hhmmss+hhmm", "000000 0000") <> 7 - DISPLAY "Test 11 failed" END-DISPLAY - END-IF - IF FUNCTION TEST-FORMATTED-DATETIME - ("hhmmss+hhmm", "00000000001") <> 11 - DISPLAY "Test 12 failed" END-DISPLAY - END-IF - IF FUNCTION TEST-FORMATTED-DATETIME - ("hhmmssZ", "000000A") <> 7 - DISPLAY "Test 13 failed" END-DISPLAY - END-IF - IF FUNCTION TEST-FORMATTED-DATETIME - ("hhmmss", SPACE) <> 1 - DISPLAY "Test 14 failed" END-DISPLAY - END-IF - - STOP RUN - . -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [], []) - -AT_CLEANUP - - -AT_SETUP([FUNCTION TEST-FORMATTED-DATETIME with datetimes]) -AT_KEYWORDS([functions]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 77 RESULT PIC 9(02). - PROCEDURE DIVISION. - MOVE FUNCTION TEST-FORMATTED-DATETIME - ("YYYYMMDDThhmmss", "16010101T000000") - TO RESULT - IF RESULT <> 0 - DISPLAY "Test 1 failed: " RESULT END-DISPLAY - END-IF - MOVE FUNCTION TEST-FORMATTED-DATETIME - ("YYYY-MM-DDThh:mm:ss.sssssssss+hh:mm", - "1601-01-01T00:00:00.000000000+00:00") - TO RESULT - IF RESULT <> 0 - DISPLAY "Test 2 failed: " RESULT END-DISPLAY - END-IF - - MOVE FUNCTION TEST-FORMATTED-DATETIME - ("YYYYMMDDThhmmss", "16010101 000000") - TO RESULT - IF RESULT <> 9 - DISPLAY "Test 3 failed: " RESULT END-DISPLAY - END-IF - MOVE FUNCTION TEST-FORMATTED-DATETIME - ("YYYYMMDDThhmmss", SPACE) - TO RESULT - IF RESULT <> 1 - DISPLAY "Test 4 failed: " RESULT END-DISPLAY - END-IF - MOVE FUNCTION TEST-FORMATTED-DATETIME - ("YYYYMMDDThhmmss", "16010101T ") - TO RESULT - IF RESULT <> 10 - DISPLAY "Test 5 failed: " RESULT END-DISPLAY - END-IF - - STOP RUN - . -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [], []) - -AT_CLEANUP - - -AT_SETUP([FUNCTION TEST-FORMATTED-DATETIME DP.COMMA]) -AT_KEYWORDS([functions]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - CONFIGURATION SECTION. - SPECIAL-NAMES. - DECIMAL-POINT IS COMMA. - DATA DIVISION. - WORKING-STORAGE SECTION. - PROCEDURE DIVISION. - IF FUNCTION TEST-FORMATTED-DATETIME - ("hhmmss,ss", "000000,00") <> 0 - DISPLAY "Test 1 failed" END-DISPLAY - END-IF - IF FUNCTION TEST-FORMATTED-DATETIME - ("YYYYMMDDThhmmss,ss", "16010101T000000,00") <> 0 - DISPLAY "Test 2 failed" END-DISPLAY - END-IF - - IF FUNCTION TEST-FORMATTED-DATETIME - ("hhmmss,ss", "000000.00") <> 7 - DISPLAY "Test 3 failed" END-DISPLAY - END-IF - IF FUNCTION TEST-FORMATTED-DATETIME - ("YYYYMMDDThhmmss,ss", "16010101T000000.00") <> 16 - DISPLAY "Test 4 failed" END-DISPLAY - END-IF - - STOP RUN - . -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [], []) - -AT_CLEANUP - - -AT_SETUP([FUNCTION TEST-NUMVAL]) -AT_KEYWORDS([functions]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - PROCEDURE DIVISION. - IF FUNCTION TEST-NUMVAL ("+ 1") NOT = 0 - DISPLAY "Test 1 fail" - END-DISPLAY - END-IF. - IF FUNCTION TEST-NUMVAL (" + 1") NOT = 0 - DISPLAY "Test 2 fail" - END-DISPLAY - END-IF. - IF FUNCTION TEST-NUMVAL ("- 1") NOT = 0 - DISPLAY "Test 3 fail" - END-DISPLAY - END-IF. - IF FUNCTION TEST-NUMVAL (" - 1") NOT = 0 - DISPLAY "Test 4 fail" - END-DISPLAY - END-IF. - IF FUNCTION TEST-NUMVAL ("+- 1") NOT = 2 - DISPLAY "Test 5 fail" - END-DISPLAY - END-IF. - IF FUNCTION TEST-NUMVAL ("1 +") NOT = 0 - DISPLAY "Test 6 fail" - END-DISPLAY - END-IF. - IF FUNCTION TEST-NUMVAL ("1 -") NOT = 0 - DISPLAY "Test 7 fail" - END-DISPLAY - END-IF. - IF FUNCTION TEST-NUMVAL ("1 +-") NOT = 4 - DISPLAY "Test 8 fail" - END-DISPLAY - END-IF. - IF FUNCTION TEST-NUMVAL ("1 -+") NOT = 4 - DISPLAY "Test 9 fail" - END-DISPLAY - END-IF. - IF FUNCTION TEST-NUMVAL ("+ 1.1") NOT = 0 - DISPLAY "Test 10 fail" - END-DISPLAY - END-IF. - IF FUNCTION TEST-NUMVAL ("- 1.1") NOT = 0 - DISPLAY "Test 11 fail" - END-DISPLAY - END-IF. - IF FUNCTION TEST-NUMVAL ("1.1 +") NOT = 0 - DISPLAY "Test 12 fail" - END-DISPLAY - END-IF. - IF FUNCTION TEST-NUMVAL ("1.1 -") NOT = 0 - DISPLAY "Test 13 fail" - END-DISPLAY - END-IF. - IF FUNCTION TEST-NUMVAL ("1.1 CR") NOT = 0 - DISPLAY "Test 14 fail" - END-DISPLAY - END-IF. - IF FUNCTION TEST-NUMVAL ("1.1 DB") NOT = 0 - DISPLAY "Test 15 fail" - END-DISPLAY - END-IF. - IF FUNCTION TEST-NUMVAL ("1.1 -CR") NOT = 6 - DISPLAY "Test 16 fail" - END-DISPLAY - END-IF. - IF FUNCTION TEST-NUMVAL ("1.1 +DB") NOT = 6 - DISPLAY "Test 17 fail" - END-DISPLAY - END-IF. - IF FUNCTION TEST-NUMVAL ("1.1 CDB") NOT = 6 - DISPLAY "Test 18 fail" - END-DISPLAY - END-IF. - IF FUNCTION TEST-NUMVAL ("+1.1 CR") NOT = 6 - DISPLAY "Test 19 fail" - END-DISPLAY - END-IF. - IF FUNCTION TEST-NUMVAL ("+ ") NOT = 8 - DISPLAY "Test 20 fail" - END-DISPLAY - END-IF. - STOP RUN. -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [], []) - -AT_CLEANUP - - -AT_SETUP([FUNCTION TEST-NUMVAL-C]) -AT_KEYWORDS([functions]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - PROCEDURE DIVISION. - IF FUNCTION TEST-NUMVAL-C ("+ 1") NOT = 0 - DISPLAY "Test 1 fail" - END-DISPLAY - END-IF. - IF FUNCTION TEST-NUMVAL-C (" + 1") NOT = 0 - DISPLAY "Test 2 fail" - END-DISPLAY - END-IF. - IF FUNCTION TEST-NUMVAL-C ("- 1") NOT = 0 - DISPLAY "Test 3 fail" - END-DISPLAY - END-IF. - IF FUNCTION TEST-NUMVAL-C (" - 1") NOT = 0 - DISPLAY "Test 4 fail" - END-DISPLAY - END-IF. - IF FUNCTION TEST-NUMVAL-C ("+- 1") NOT = 2 - DISPLAY "Test 5 fail" - END-DISPLAY - END-IF. - IF FUNCTION TEST-NUMVAL-C ("1 +") NOT = 0 - DISPLAY "Test 6 fail" - END-DISPLAY - END-IF. - IF FUNCTION TEST-NUMVAL-C ("1 -") NOT = 0 - DISPLAY "Test 7 fail" - END-DISPLAY - END-IF. - IF FUNCTION TEST-NUMVAL-C ("1 +-") NOT = 4 - DISPLAY "Test 8 fail" - END-DISPLAY - END-IF. - IF FUNCTION TEST-NUMVAL-C ("1 -+") NOT = 4 - DISPLAY "Test 9 fail" - END-DISPLAY - END-IF. - IF FUNCTION TEST-NUMVAL-C ("+ 1.1") NOT = 0 - DISPLAY "Test 10 fail" - END-DISPLAY - END-IF. - IF FUNCTION TEST-NUMVAL-C ("- 1.1") NOT = 0 - DISPLAY "Test 11 fail" - END-DISPLAY - END-IF. - IF FUNCTION TEST-NUMVAL-C ("1.1 +") NOT = 0 - DISPLAY "Test 12 fail" - END-DISPLAY - END-IF. - IF FUNCTION TEST-NUMVAL-C ("1.1 -") NOT = 0 - DISPLAY "Test 13 fail" - END-DISPLAY - END-IF. - IF FUNCTION TEST-NUMVAL-C ("1.1 CR") NOT = 0 - DISPLAY "Test 14 fail" - END-DISPLAY - END-IF. - IF FUNCTION TEST-NUMVAL-C ("1.1 DB") NOT = 0 - DISPLAY "Test 15 fail" - END-DISPLAY - END-IF. - IF FUNCTION TEST-NUMVAL-C ("1.1 -CR") NOT = 6 - DISPLAY "Test 16 fail" - END-DISPLAY - END-IF. - IF FUNCTION TEST-NUMVAL-C ("+ $1.1 ") NOT = 0 - DISPLAY "Test 17 fail" - END-DISPLAY - END-IF. - IF FUNCTION TEST-NUMVAL-C ("- $1.1 ") NOT = 0 - DISPLAY "Test 18 fail" - END-DISPLAY - END-IF. - IF FUNCTION TEST-NUMVAL-C ("+ X1.1 ", "X") NOT = 0 - DISPLAY "Test 19 fail" - END-DISPLAY - END-IF. - IF FUNCTION TEST-NUMVAL-C ("- X1.1 ", "X") NOT = 0 - DISPLAY "Test 20 fail" - END-DISPLAY - END-IF. - STOP RUN. -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [], []) - -AT_CLEANUP - - -AT_SETUP([FUNCTION TEST-NUMVAL-F]) -AT_KEYWORDS([functions]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - PROCEDURE DIVISION. - IF FUNCTION TEST-NUMVAL-F ("+ 1") NOT = 0 - DISPLAY "Test 1 fail" - END-DISPLAY - END-IF. - IF FUNCTION TEST-NUMVAL-F (" + 1") NOT = 0 - DISPLAY "Test 2 fail" - END-DISPLAY - END-IF. - IF FUNCTION TEST-NUMVAL-F ("- 1") NOT = 0 - DISPLAY "Test 3 fail" - END-DISPLAY - END-IF. - IF FUNCTION TEST-NUMVAL-F (" - 1") NOT = 0 - DISPLAY "Test 4 fail" - END-DISPLAY - END-IF. - IF FUNCTION TEST-NUMVAL-F ("+- 1") NOT = 2 - DISPLAY "Test 5 fail" - END-DISPLAY - END-IF. - IF FUNCTION TEST-NUMVAL-F ("1 +") NOT = 0 - DISPLAY "Test 6 fail" - END-DISPLAY - END-IF. - IF FUNCTION TEST-NUMVAL-F ("1 -") NOT = 0 - DISPLAY "Test 7 fail" - END-DISPLAY - END-IF. - IF FUNCTION TEST-NUMVAL-F ("1 +-") NOT = 4 - DISPLAY "Test 8 fail" - END-DISPLAY - END-IF. - IF FUNCTION TEST-NUMVAL-F ("1 -+") NOT = 4 - DISPLAY "Test 9 fail" - END-DISPLAY - END-IF. - IF FUNCTION TEST-NUMVAL-F ("+ 1.1") NOT = 0 - DISPLAY "Test 10 fail" - END-DISPLAY - END-IF. - IF FUNCTION TEST-NUMVAL-F ("- 1.1") NOT = 0 - DISPLAY "Test 11 fail" - END-DISPLAY - END-IF. - IF FUNCTION TEST-NUMVAL-F ("1.1 +") NOT = 0 - DISPLAY "Test 12 fail" - END-DISPLAY - END-IF. - IF FUNCTION TEST-NUMVAL-F ("1.1 -") NOT = 0 - DISPLAY "Test 13 fail" - END-DISPLAY - END-IF. - IF FUNCTION TEST-NUMVAL-F ("1.1 ") NOT = 0 - DISPLAY "Test 14 fail" - END-DISPLAY - END-IF. - IF FUNCTION TEST-NUMVAL-F ("1.1 ") NOT = 0 - DISPLAY "Test 15 fail" - END-DISPLAY - END-IF. - IF FUNCTION TEST-NUMVAL-F ("1.1 -CR") NOT = 6 - DISPLAY "Test 16 fail" - END-DISPLAY - END-IF. - IF FUNCTION TEST-NUMVAL-F ("1.1 E+1") NOT = 0 - DISPLAY "Test 17 fail" - END-DISPLAY - END-IF. - IF FUNCTION TEST-NUMVAL-F ("1.1 E -1") NOT = 0 - DISPLAY "Test 18 fail" - END-DISPLAY - END-IF. - IF FUNCTION TEST-NUMVAL-F ("1.1 EE") NOT = 6 - DISPLAY "Test 19 fail" - END-DISPLAY - END-IF. - IF FUNCTION TEST-NUMVAL-F ("+1.1 E001") NOT = 7 - DISPLAY "Test 20 fail" - END-DISPLAY - END-IF. - STOP RUN. -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [], []) - -AT_CLEANUP - - -AT_SETUP([FUNCTION TRIM]) -AT_KEYWORDS([functions]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 X PIC X(12) VALUE " a#b.c%d+e$ ". - PROCEDURE DIVISION. - DISPLAY FUNCTION TRIM ( X ) - END-DISPLAY. - DISPLAY FUNCTION TRIM ( X TRAILING ) - END-DISPLAY. - STOP RUN. -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], -[a#b.c%d+e$ - a#b.c%d+e$ -]) - -AT_CLEANUP - - -AT_SETUP([FUNCTION TRIM with reference modding]) -AT_KEYWORDS([functions]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 X PIC X(12) VALUE " a#b.c%d+e$ ". - PROCEDURE DIVISION. - DISPLAY FUNCTION TRIM ( X ) (2 : 3) - END-DISPLAY. - DISPLAY FUNCTION TRIM ( X TRAILING ) (2 : 3) - END-DISPLAY. - STOP RUN. -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], -[#b. -a#b -]) - -AT_CLEANUP - - -AT_SETUP([FUNCTION TRIM zero length]) -AT_KEYWORDS([functions]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 X PIC X(4) VALUE "NOOK". - PROCEDURE DIVISION. - MOVE FUNCTION TRIM ( " " ) TO X. - DISPLAY ">" X "<" - END-DISPLAY. - DISPLAY ">" FUNCTION TRIM ( " " ) "<" - END-DISPLAY. - STOP RUN. -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], -[> < ->< -]) - -AT_CLEANUP - - -AT_SETUP([FUNCTION UPPER-CASE]) -AT_KEYWORDS([functions]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 X PIC X(10) VALUE "a#b.c%d+e$". - 01 Z PIC X(10). - PROCEDURE DIVISION. - MOVE FUNCTION UPPER-CASE ( X ) TO Z. - IF Z NOT = "A#B.C%D+E$" - DISPLAY Z - END-DISPLAY - END-IF. - STOP RUN. -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [], []) - -AT_CLEANUP - - -AT_SETUP([FUNCTION UPPER-CASE with reference modding]) -AT_KEYWORDS([functions]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 X PIC X(10) VALUE "a#b.c%d+e$". - 01 Z PIC X(4). - PROCEDURE DIVISION. - MOVE FUNCTION UPPER-CASE ( X ) (1 : 3) TO Z. - IF Z NOT = "A#B " - DISPLAY Z - END-DISPLAY - END-IF. - STOP RUN. -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [], []) - -AT_CLEANUP - - -AT_SETUP([FUNCTION VARIANCE]) -AT_KEYWORDS([functions]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 Z PIC S9(4)V9(4) COMP-5. - PROCEDURE DIVISION. - MOVE FUNCTION VARIANCE ( 3 -14 0 8 -3 ) TO Z. - IF Z NOT = 54.16 - DISPLAY Z - END-DISPLAY - END-IF. - STOP RUN. -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [], []) - -AT_CLEANUP - - -AT_SETUP([FUNCTION WHEN-COMPILED]) -AT_KEYWORDS([functions]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 compiled-datetime. - 03 compiled-date. - 05 millennium PIC X. - 05 FILLER PIC X(15). - 03 timezone PIC X(5). - PROCEDURE DIVISION. - *> Check millennium. - MOVE FUNCTION WHEN-COMPILED TO compiled-datetime. - IF millennium NOT = "2" - DISPLAY "Millennium NOT OK: " millennium - END-DISPLAY - END-IF. - - *> Check timezone. - IF timezone NOT = FUNCTION CURRENT-DATE (17:5) - DISPLAY "Timezone NOT OK: " timezone - END-DISPLAY - END-IF. - - *> Check date format. - INSPECT compiled-date CONVERTING "0123456789" - TO "9999999999". - IF compiled-date NOT = ALL "9" - DISPLAY "Date format NOT OK: " compiled-date - END-DISPLAY - END-IF. - - *> Check timezone format. - IF timezone NOT = "00000" - INSPECT timezone CONVERTING "0123456789" - TO "9999999999" - IF timezone NOT = "+9999" AND "-9999" - DISPLAY "Timezone format NOT OK: " timezone - END-DISPLAY - END-IF - END-IF. - - STOP RUN. -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [], []) - -AT_CLEANUP - - -AT_SETUP([FUNCTION YEAR-TO-YYYY]) -AT_KEYWORDS([functions]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 Z USAGE BINARY-LONG. - PROCEDURE DIVISION. - MOVE FUNCTION YEAR-TO-YYYY ( 50 ) TO Z. - IF Z NOT = 2050 - DISPLAY Z - END-DISPLAY - END-IF. - STOP RUN. -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [], []) - -AT_CLEANUP - - -AT_SETUP([Formatted funcs w/ invalid variable format]) -AT_KEYWORDS([functions FORMATTED-CURRENT-DATE FORMATTED-DATE -FORMATTED-TIME FORMATTED-DATETIME]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 invalid-date-format PIC X(10) VALUE "yyyymmdd". - 01 invalid-datetime-format PIC X(17) - VALUE "yyyymmddtHHMMSS". - 01 invalid-time-format PIC X(6) VALUE "HHMMSS". - PROCEDURE DIVISION. - IF FUNCTION FORMATTED-CURRENT-DATE - (invalid-date-format) <> SPACES - OR FUNCTION EXCEPTION-STATUS <> "EC-ARGUMENT-FUNCTION" - OR FUNCTION EXCEPTION-LOCATION <> "prog; ; 11" - DISPLAY "Test 1 failed" END-DISPLAY - END-IF - - IF FUNCTION FORMATTED-DATE (invalid-date-format, 1) <> SPACES - OR FUNCTION EXCEPTION-STATUS <> "EC-ARGUMENT-FUNCTION" - OR FUNCTION EXCEPTION-LOCATION <> "prog; ; 18" - DISPLAY "Test 2 failed" END-DISPLAY - END-IF - - IF FUNCTION FORMATTED-DATETIME - (invalid-datetime-format, 1, 1) <> SPACES - OR FUNCTION EXCEPTION-STATUS <> "EC-ARGUMENT-FUNCTION" - OR FUNCTION EXCEPTION-LOCATION <> "prog; ; 24" - DISPLAY "Test 3 failed" END-DISPLAY - END-IF - - IF FUNCTION FORMATTED-TIME (invalid-time-format, 1) <> SPACES - OR FUNCTION EXCEPTION-STATUS <> "EC-ARGUMENT-FUNCTION" - OR FUNCTION EXCEPTION-LOCATION <> "prog; ; 31" - DISPLAY "Test 4 failed" END-DISPLAY - END-IF - - IF FUNCTION INTEGER-OF-FORMATTED-DATE - (invalid-date-format, 1) <> ZERO - OR FUNCTION EXCEPTION-STATUS <> "EC-ARGUMENT-FUNCTION" - OR FUNCTION EXCEPTION-LOCATION <> "prog; ; 37" - DISPLAY "Test 5 failed" END-DISPLAY - END-IF - - IF FUNCTION SECONDS-FROM-FORMATTED-TIME - (invalid-time-format, 1) <> ZERO - OR FUNCTION EXCEPTION-STATUS <> "EC-ARGUMENT-FUNCTION" - OR FUNCTION EXCEPTION-LOCATION <> "prog; ; 44" - DISPLAY "Test 6 failed" END-DISPLAY - END-IF - - IF FUNCTION TEST-FORMATTED-DATETIME - (invalid-datetime-format, 1) <> ZERO - OR FUNCTION EXCEPTION-STATUS <> "EC-ARGUMENT-FUNCTION" - OR FUNCTION EXCEPTION-LOCATION <> "prog; ; 51" - DISPLAY "Test 7 failed" END-DISPLAY - END-IF - - STOP RUN. -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], -[prog.cob:11: warning: FUNCTION 'FORMATTED-CURRENT-DATE' has format in variable -prog.cob:18: warning: FUNCTION 'FORMATTED-DATE' has format in variable -prog.cob:24: warning: FUNCTION 'FORMATTED-DATETIME' has format in variable -prog.cob:31: warning: FUNCTION 'FORMATTED-TIME' has format in variable -prog.cob:37: warning: FUNCTION 'INTEGER-OF-FORMATTED-DATE' has format in variable -prog.cob:44: warning: FUNCTION 'SECONDS-FROM-FORMATTED-TIME' has format in variable -prog.cob:51: warning: FUNCTION 'TEST-FORMATTED-DATETIME' has format in variable -]) - -# running the program -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [], []) - - -AT_CLEANUP - - -AT_SETUP([FORMATTED-(DATE)TIME with SYSTEM-OFFSET]) -AT_KEYWORDS([functions FORMATTED-TIME FORMATTED-DATETIME extensions]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 str PIC X(30). - 77 val pic 9(02). - - PROCEDURE DIVISION. - MOVE FUNCTION FORMATTED-DATETIME - ("YYYYDDDThhmmss+hhmm", 1, 45296, SYSTEM-OFFSET) - TO str - MOVE FUNCTION TEST-FORMATTED-DATETIME - ("YYYYDDDThhmmss+hhmm", str) TO val - IF val not = 0 - DISPLAY "Test 1 failed: " str ' - ' val END-DISPLAY - END-IF - - MOVE FUNCTION FORMATTED-TIME - ("hhmmss.ssZ", 45296, SYSTEM-OFFSET) - TO str - MOVE FUNCTION TEST-FORMATTED-DATETIME - ("hhmmss.ssZ", str) TO val - IF val not = 0 - DISPLAY "Test 2 failed: " str ' - ' val END-DISPLAY - END-IF - . -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0]) - -AT_CLEANUP - - -AT_SETUP([Intrinsics without FUNCTION keyword (1)]) -AT_KEYWORDS([functions]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 Z PIC 99V99. - PROCEDURE DIVISION. - MOVE PI TO Z. - MOVE E TO Z. - STOP RUN. -]) - -AT_CHECK([$COMPILE -w -fintrinsics=all prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [], []) - -AT_CLEANUP - - -AT_SETUP([Intrinsics without FUNCTION keyword (2)]) -AT_KEYWORDS([functions]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 Z PIC 99V99. - PROCEDURE DIVISION. - MOVE PI TO Z. - MOVE E TO Z. - STOP RUN. -]) - -AT_CHECK([$COMPILE -w -fintrinsics=pi,e prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [], []) - -AT_CLEANUP - - -### ISO+IEC+1989-2002 9.4 User-Defined Functions - -AT_SETUP([User-Defined FUNCTION with/without parameter]) -AT_KEYWORDS([functions]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - FUNCTION-ID. WITHPAR. - DATA DIVISION. - LINKAGE SECTION. - 01 PAR-IN PIC 9. - 01 PAR-OUT PIC 9. - PROCEDURE DIVISION USING PAR-IN RETURNING PAR-OUT. - ADD 1 TO PAR-IN GIVING PAR-OUT END-ADD. - GOBACK. - END FUNCTION WITHPAR. - - IDENTIFICATION DIVISION. - FUNCTION-ID. WITHOUTPAR. - DATA DIVISION. - LINKAGE SECTION. - 01 PAR PIC 9. - PROCEDURE DIVISION RETURNING PAR. - MOVE 1 TO PAR. - GOBACK. - END FUNCTION WITHOUTPAR. - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - CONFIGURATION SECTION. - REPOSITORY. - FUNCTION WITHPAR - FUNCTION WITHOUTPAR. - PROCEDURE DIVISION. - IF WITHPAR(1) NOT = 2 - DISPLAY WITHPAR(1) - END-DISPLAY - END-IF. - IF WITHOUTPAR NOT = 1 - DISPLAY WITHOUTPAR - END-DISPLAY - END-IF. - STOP RUN. - END PROGRAM prog. -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [], []) - -AT_CLEANUP - - -AT_SETUP([UDF in COMPUTE]) -AT_KEYWORDS([functions]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - FUNCTION-ID. func. - - DATA DIVISION. - LINKAGE SECTION. - 01 num PIC 999. - - PROCEDURE DIVISION RETURNING num. - MOVE 100 TO num - . - END FUNCTION func. - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - - ENVIRONMENT DIVISION. - CONFIGURATION SECTION. - REPOSITORY. - FUNCTION func. - - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 x PIC 999. - - PROCEDURE DIVISION. - COMPUTE x = 101 + FUNCTION func - DISPLAY x - . - END PROGRAM prog. -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], -[201 -]) - -AT_CLEANUP - - -AT_SETUP([UDF replacing intrinsic function]) -AT_KEYWORDS([functions SUBSTITUTE]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - FUNCTION-ID. SUBSTITUTE. - - DATA DIVISION. - LINKAGE SECTION. - 01 func-in PIC X(15). - 01 func-sub PIC X. - 01 func-out PIC X(15). - - PROCEDURE DIVISION USING func-in, func-sub RETURNING func-out. - MOVE func-in TO func-out - INSPECT func-out REPLACING ALL '%' BY func-sub - . - END FUNCTION SUBSTITUTE. - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - - ENVIRONMENT DIVISION. - CONFIGURATION SECTION. - REPOSITORY. - FUNCTION SUBSTITUTE - . - PROCEDURE DIVISION. - DISPLAY '"' FUNCTION SUBSTITUTE(" % C%O%B%O%L % ", "_") '"' - DISPLAY '"' FUNCTION SUBSTITUTE(" % C%O%B%O%L % ", "-") '"' - . - END PROGRAM prog. -]) - -AT_CHECK([$COMPILE -fnot-intrinsic=substitute prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], -[" _ C_O_B_O_L _ " -" - C-O-B-O-L - " -]) - -AT_CLEANUP - - -AT_SETUP([UDF with recursion (1)]) -AT_KEYWORDS([functions LOCAL-STORAGE]) - -AT_SKIP_IF(true) # see bug #222 and r2291 - postponed - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - FUNCTION-ID. foo. - - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 ttl PIC 9 VALUE 1. - - LOCAL-STORAGE SECTION. - 01 num PIC 9. - - LINKAGE SECTION. - 01 arg PIC 9. - 01 ret PIC 9. - - PROCEDURE DIVISION USING arg RETURNING ret. - IF arg < 5 - ADD 1 TO arg GIVING num END-ADD - MOVE FUNCTION foo (num) TO ret - ELSE - MOVE arg TO ret - END-IF - DISPLAY "Step: " ttl ", Arg: " arg ", Return: " ret - END-DISPLAY - ADD 1 to ttl END-ADD - GOBACK. - END FUNCTION foo. - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - - ENVIRONMENT DIVISION. - CONFIGURATION SECTION. - REPOSITORY. - FUNCTION foo. - - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 num PIC 9 VALUE 1. - - PROCEDURE DIVISION. - DISPLAY "Return value '" FUNCTION foo (num) "'" - WITH NO ADVANCING - END-DISPLAY - GOBACK. - END PROGRAM prog. - -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) - -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], -[Step: 1, Arg: 5, Return: 5 -Step: 2, Arg: 4, Return: 5 -Step: 3, Arg: 3, Return: 5 -Step: 4, Arg: 2, Return: 5 -Step: 5, Arg: 1, Return: 5 -Return value '5'], []) - -AT_CLEANUP - - -AT_SETUP([UDF with recursion (2)]) -AT_KEYWORDS([functions LOCAL-STORAGE]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - - ENVIRONMENT DIVISION. - CONFIGURATION SECTION. - REPOSITORY. - FUNCTION foo. - - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 num PIC 9 VALUE 1. - - PROCEDURE DIVISION. - DISPLAY "Begin recursive function test". - DISPLAY "Return value '" FUNCTION foo (num) "'". - DISPLAY "End of test". - END PROGRAM prog. - - IDENTIFICATION DIVISION. - FUNCTION-ID. foo. - ENVIRONMENT DIVISION. - CONFIGURATION SECTION. - REPOSITORY. - FUNCTION foo. - - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 ttl PIC 9 VALUE 1. - - LOCAL-STORAGE SECTION. - 01 num PIC 9. - - LINKAGE SECTION. - 01 arg PIC 9. - 01 ret PIC 9. - - PROCEDURE DIVISION USING arg RETURNING ret. - IF arg < 5 - ADD 1 TO arg GIVING num - MOVE FUNCTION foo (num) TO ret - ELSE - MOVE arg TO ret - END-IF. - DISPLAY "Step: " ttl ", Arg: " arg ", '" ret "'". - ADD 1 to ttl. - END FUNCTION foo. -]) - -AT_CHECK([cobc -x -std=mf -w prog.cob ], [0], [], []) - -AT_CHECK([./prog], [0], [Begin recursive function test -Step: 1, Arg: 5, '5' -Step: 2, Arg: 4, '5' -Step: 3, Arg: 3, '5' -Step: 4, Arg: 2, '5' -Step: 5, Arg: 1, '5' -Return value '5' -End of test -], []) - -AT_CLEANUP - diff -Nru gnucobol-4.0~early~20200606/tests/testsuite.src/run_fundamental.at gnucobol-5/tests/testsuite.src/run_fundamental.at --- gnucobol-4.0~early~20200606/tests/testsuite.src/run_fundamental.at 2020-06-06 20:52:00.000000000 +0000 +++ gnucobol-5/tests/testsuite.src/run_fundamental.at 1970-01-01 00:00:00.000000000 +0000 @@ -1,5348 +0,0 @@ -## Copyright (C) 2003-2012, 2014-2015, 2017-2019 Free Software Foundation, Inc. -## Written by Keisuke Nishida, Roger While, Simon Sobisch, Edward Hart, -## Ron Norman -## -## This file is part of GnuCOBOL. -## -## The GnuCOBOL compiler is free software: you can redistribute it -## and/or modify it under the terms of the GNU General Public License -## as published by the Free Software Foundation, either version 3 of the -## License, or (at your option) any later version. -## -## GnuCOBOL is distributed in the hope that it will be useful, -## but WITHOUT ANY WARRANTY; without even the implied warranty of -## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -## GNU General Public License for more details. -## -## You should have received a copy of the GNU General Public License -## along with GnuCOBOL. If not, see . - -### GnuCOBOL Test Suite - -### Fundamental Tests - -AT_SETUP([DISPLAY literals]) -AT_KEYWORDS([fundamental]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - PROCEDURE DIVISION. - DISPLAY "abc" - END-DISPLAY. - DISPLAY 123 - END-DISPLAY. - DISPLAY +123 - END-DISPLAY. - DISPLAY -123 - END-DISPLAY. - DISPLAY 12.3 - END-DISPLAY. - DISPLAY +12.3 - END-DISPLAY. - DISPLAY -12.3 - END-DISPLAY. - DISPLAY 1.23E0 - END-DISPLAY. - DISPLAY +1.23E0 - END-DISPLAY. - DISPLAY -1.23E0 - END-DISPLAY. - DISPLAY 12.3E-2 - END-DISPLAY. - DISPLAY +12.3E-2 - END-DISPLAY. - DISPLAY -12.3E-2 - END-DISPLAY. - DISPLAY B'0101' - END-DISPLAY. - DISPLAY BX'EC' - END-DISPLAY. - STOP RUN. -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], -[abc -123 -+123 --123 -12.3 -+12.3 --12.3 -1.23 -+1.23 --1.23 -.123 -+.123 --.123 -5 -236 -]) - -AT_CLEANUP - - -AT_SETUP([DISPLAY literals, DECIMAL-POINT is COMMA]) -AT_KEYWORDS([fundamental]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - CONFIGURATION SECTION. - SPECIAL-NAMES. - DECIMAL-POINT IS COMMA. - PROCEDURE DIVISION. - DISPLAY 12,3 - END-DISPLAY. - DISPLAY +12,3 - END-DISPLAY. - DISPLAY -12,3 - END-DISPLAY. - DISPLAY 1,23E0 - END-DISPLAY. - DISPLAY +1,23E0 - END-DISPLAY. - DISPLAY -1,23E0 - END-DISPLAY. - STOP RUN. -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], -[12,3 -+12,3 --12,3 -1,23 -+1,23 --1,23 -]) - -AT_CLEANUP - - -AT_SETUP([Hexadecimal literal]) -AT_KEYWORDS([fundamental]) - -AT_DATA([dump.c], [ -#include -#include - -COB_EXT_EXPORT int -dump (unsigned char *data) -{ - int i; - for (i = 0; i < 4; i++) - printf ("%02x", data[[i]]); - return 0; -} -]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - PROCEDURE DIVISION. - >>IF CHARSET = 'EBCDIC' - DISPLAY X"F1F2F3" - >>ELSE - DISPLAY X"313233" - >>END-IF - END-DISPLAY. - CALL "dump" USING X"000102" - END-CALL. - STOP RUN. -]) - -AT_CHECK([$COMPILE_MODULE dump.c], [0], [], []) -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], -[123 -00010200]) - -AT_CLEANUP - - -AT_SETUP([DISPLAY data items with VALUE clause]) -AT_KEYWORDS([fundamental]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 X-ABC PIC XXX VALUE "abc". - 01 X-123 PIC 999 VALUE 123. - 01 X-P123 PIC S999 VALUE +123. - 01 X-N123 PIC S999 VALUE -123. - 01 X-12-3 PIC 99V9 VALUE 12.3. - 01 X-P12-3 PIC S99V9 VALUE +12.3. - 01 X-N12-3 PIC S99V9 VALUE -12.3. - PROCEDURE DIVISION. - DISPLAY X-ABC - END-DISPLAY. - DISPLAY X-123 - END-DISPLAY. - DISPLAY X-P123 - END-DISPLAY. - DISPLAY X-N123 - END-DISPLAY. - DISPLAY X-12-3 - END-DISPLAY. - DISPLAY X-P12-3 - END-DISPLAY. - DISPLAY X-N12-3 - END-DISPLAY. - STOP RUN. -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], -[abc -123 -+123 --123 -12.3 -+12.3 --12.3 -]) - -AT_CLEANUP - - -AT_SETUP([DISPLAY data items with MOVE statement]) -AT_KEYWORDS([fundamental]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 X-ABC PIC XXX VALUE "abc". - 01 X-123 PIC 999 VALUE 123. - 01 X-P123 PIC S999 VALUE +123. - 01 X-N123 PIC S999 VALUE -123. - 01 X-12-3 PIC 99V9 VALUE 12.3. - 01 X-P12-3 PIC S99V9 VALUE +12.3. - 01 X-N12-3 PIC S99V9 VALUE -12.3. - PROCEDURE DIVISION. - MOVE "abc" TO X-ABC. - DISPLAY X-ABC - END-DISPLAY. - MOVE 123 TO X-123. - DISPLAY X-123 - END-DISPLAY. - MOVE +123 TO X-P123. - DISPLAY X-P123 - END-DISPLAY. - MOVE -123 TO X-N123. - DISPLAY X-N123 - END-DISPLAY. - MOVE 12.3 TO X-12-3. - DISPLAY X-12-3 - END-DISPLAY. - MOVE +12.3 TO X-P12-3. - DISPLAY X-P12-3 - END-DISPLAY. - MOVE -12.3 TO X-N12-3. - DISPLAY X-N12-3 - END-DISPLAY. - STOP RUN. -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], -[abc -123 -+123 --123 -12.3 -+12.3 --12.3 -]) - -AT_CLEANUP - - -AT_SETUP([MOVE to edited item (1)]) -AT_KEYWORDS([fundamental editing]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 SRC-1 PIC S99V99 VALUE 1.10. - 01 SRC-2 PIC S99V99 VALUE 0.02. - 01 SRC-3 PIC S99V99 VALUE -0.03. - 01 SRC-4 PIC S99V99 VALUE -0.04. - 01 SRC-5 PIC S99V99 VALUE -0.05. - 01 EDT-1 PIC -(04)9. - 01 EDT-2 PIC -(04)9. - 01 EDT-3 PIC -(04)9. - 01 EDT-4 PIC +(04)9. - 01 EDT-5 PIC -(05). - PROCEDURE DIVISION. - MOVE SRC-1 TO EDT-1. - MOVE SRC-2 TO EDT-2. - MOVE SRC-3 TO EDT-3. - MOVE SRC-4 TO EDT-4. - MOVE SRC-5 TO EDT-5. - DISPLAY '>' EDT-1 '<' - END-DISPLAY. - DISPLAY '>' EDT-2 '<' - END-DISPLAY. - DISPLAY '>' EDT-3 '<' - END-DISPLAY. - DISPLAY '>' EDT-4 '<' - END-DISPLAY. - DISPLAY '>' EDT-5 '<' - END-DISPLAY. - STOP RUN. -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], -[> 1< -> 0< -> 0< -> +0< -> < -]) - -AT_CLEANUP - - -AT_SETUP([MOVE to edited item (2)]) -AT_KEYWORDS([fundamental editing]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 SRC-1 PIC S99V99 VALUE -0.06. - 01 SRC-2 PIC S99V99 VALUE -0.07. - 01 SRC-3 PIC S99V99 VALUE -0.08. - 01 SRC-4 PIC S99V99 VALUE -0.09. - 01 SRC-5 PIC S99V99 VALUE -1.10. - 01 EDT-1 PIC 9(04)-. - 01 EDT-2 PIC 9(04)+. - 01 EDT-3 PIC Z(04)+. - 01 EDT-4 PIC 9(04)DB. - 01 EDT-5 PIC 9(04)DB. - PROCEDURE DIVISION. - MOVE SRC-1 TO EDT-1. - MOVE SRC-2 TO EDT-2. - MOVE SRC-3 TO EDT-3. - MOVE SRC-4 TO EDT-4. - MOVE SRC-5 TO EDT-5. - DISPLAY '>' EDT-1 '<' - END-DISPLAY. - DISPLAY '>' EDT-2 '<' - END-DISPLAY. - DISPLAY '>' EDT-3 '<' - END-DISPLAY. - DISPLAY '>' EDT-4 '<' - END-DISPLAY. - DISPLAY '>' EDT-5 '<' - END-DISPLAY. - STOP RUN. -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], -[>0000 < ->0000+< -> < ->0000 < ->0001DB< -]) - -AT_CLEANUP - - -AT_SETUP([MOVE to item with simple and floating insertion]) -AT_KEYWORDS([fundamental edited editing]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 num-1 PIC -*B*99. - 01 num-2 PIC $BB**,***.**. - 01 num-3 PIC $BB--,---.--. - - PROCEDURE DIVISION. - MOVE -123 TO num-1 - DISPLAY ">" num-1 "<" - - MOVE 1234.56 TO num-2 - DISPLAY ">" num-2 "<" - - MOVE 1234.56 TO num-3 - DISPLAY ">" num-3 "<" - . -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], -[>-**123< ->$ *1,234.56< ->$ 1,234.56< -]) - -AT_CLEANUP - - -AT_SETUP([MOVE to JUSTIFIED item]) -AT_KEYWORDS([fundamental]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 SRC-1 PIC S9(04) VALUE 11. - 01 SRC-2 PIC S9(04) COMP VALUE 22. - 01 SRC-3 PIC S9(04) COMP-5 VALUE 33. - 01 SRC-4 PIC S9(04)PP VALUE 4400. - 01 SRC-5 PIC S9(04)PPPPP VALUE 55500000. - 01 EDT-FLD PIC X(07) JUSTIFIED RIGHT. - PROCEDURE DIVISION. - MOVE SRC-1 TO EDT-FLD. - DISPLAY '>' EDT-FLD '<' - END-DISPLAY. - MOVE SRC-2 TO EDT-FLD. - DISPLAY '>' EDT-FLD '<' - END-DISPLAY. - MOVE SRC-3 TO EDT-FLD. - DISPLAY '>' EDT-FLD '<' - END-DISPLAY. - MOVE SRC-4 TO EDT-FLD. - DISPLAY '>' EDT-FLD '<' - END-DISPLAY. - MOVE SRC-5 TO EDT-FLD. - DISPLAY '>' EDT-FLD '<' - END-DISPLAY. - STOP RUN. -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], -[> 0011< -> 0022< -> 0033< -> 004400< ->5500000< -]) - -AT_CLEANUP - - -AT_SETUP([MOVE integer literal to alphanumeric]) -AT_KEYWORDS([fundamental]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 X PIC X(04) VALUE SPACES. - PROCEDURE DIVISION. - MOVE 0 TO X. - DISPLAY X NO ADVANCING - END-DISPLAY. - STOP RUN. -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], -[prog.cob:8: warning: alphanumeric value is expected -prog.cob:6: warning: 'X' defined here as PIC X(04) -]) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [0 ]) - -AT_CLEANUP - - -AT_SETUP([Compare FLOAT-LONG with floating-point literal]) -AT_KEYWORDS([fundamental literal exponent]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 VAR FLOAT-LONG VALUE 0.0. - - PROCEDURE DIVISION. - MOVE 9.899999999999E+304 TO VAR - IF VAR < 0 - DISPLAY 'error: compare ' VAR ' < ' 0 - ' failed!' - END-DISPLAY - END-IF. - IF VAR < 9.799999999999E+304 - DISPLAY 'error: compare ' VAR ' < ' 9.799999999999E+304 - ' failed!' - END-DISPLAY - END-IF. - IF VAR > 9.999999999999E+304 - DISPLAY 'error: compare ' VAR ' > ' 9.999999999999E+304 - ' failed!' - END-DISPLAY - END-IF. - MOVE -9.899999999999E+304 TO VAR - IF VAR > 0 - DISPLAY 'error: compare ' VAR ' > ' 0 - ' failed!' - END-DISPLAY - END-IF. - IF VAR < -9.999999999999E+304 - DISPLAY 'error: compare ' VAR ' < ' -9.999999999999E+304 - ' failed!' - END-DISPLAY - END-IF. - IF VAR > -9.799999999999E+304 - DISPLAY 'error: compare ' VAR ' > ' -9.799999999999E+304 - ' failed!' - END-DISPLAY - END-IF. - - STOP RUN. -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [], []) - -AT_CLEANUP - - -AT_SETUP([Check for equality of FLOAT-SHORT / FLOAT-LONG]) -AT_KEYWORDS([fundamental]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 SRC1 FLOAT-LONG VALUE 11.55. - 01 DST1 FLOAT-SHORT. - 01 SRC2 FLOAT-SHORT VALUE 11.55. - 01 DST2 FLOAT-LONG. - - PROCEDURE DIVISION. - MOVE SRC1 TO DST1. - IF DST1 not = 11.55 - DISPLAY 'error: move/compare FLOAT-LONG to FLOAT-SHORT fa - - 'iled ' DST1 - END-DISPLAY - END-IF. - - MOVE SRC1 TO DST2. - IF DST1 not = 11.55 - DISPLAY 'error: move/compare FLOAT-LONG to FLOAT-LONG fai - - 'led ' DST2 - END-DISPLAY - END-IF. - - MOVE ZERO TO DST1. - MOVE ZERO TO DST2. - - MOVE SRC2 TO DST1. - IF DST1 not = 11.55 - DISPLAY 'error: move/compare FLOAT-SHORT to FLOAT-SHORT f - - 'ailed: ' DST1 - END-DISPLAY - END-IF. - - MOVE SRC2 TO DST2. - IF DST2 not = 11.55 - DISPLAY 'error: move/compare FLOAT-SHORT to FLOAT-LONG fa - - 'iled: ' DST2 - END-DISPLAY - END-IF. - - MOVE ZERO TO DST1. - IF not (DST1 = 0 AND 0.0) - DISPLAY "Zero compare failed: " DST1 END-DISPLAY - END-IF. - - MOVE -0.0 TO DST1. - IF not (DST1 = 0 AND 0.0) - DISPLAY "Negative Zero compare failed: " DST1 - END-DISPLAY - END-IF. - - MOVE 1.1234567 TO DST1. - MOVE DST1 TO DST2. - IF DST2 not = 1.1234567 - DISPLAY "move/compare number to FLOAT to DOUBLE failed: " - DST1 " - " DST2 - END-DISPLAY - END-IF. - - * Check for Tolerance - MOVE 1.1234567 TO DST1. - MOVE 1.1234568 TO DST2. - IF DST1 not = DST2 THEN - DISPLAY 'move/compare of very near numbers failed (not id - - 'entical): ' DST1 " - " DST2 - END-DISPLAY - END-IF. - - * Within tolerance by definition, therefore not checked - * MULTIPLY 10000000000 BY DST1 DST2 END-MULTIPLY. - * IF DST1 = DST2 THEN - * DISPLAY "compare of very near numbers computed failed (id - *- "entical): " DST1 " - " DST2 - * END-DISPLAY - * END-IF. - - MOVE 1.1234567 TO DST1. - MOVE 1.1234569 TO DST2. - IF DST1 = DST2 THEN - DISPLAY 'move/compare of near equal numbers failed (ident - - 'ical): ' DST1 " - " DST2 - END-DISPLAY - END-IF. - - MOVE 0.0001 TO DST1. - MOVE 0.0000 TO DST2. - IF DST1 = DST2 THEN - DISPLAY 'move/compare of nearly equal very small numbers - - 'failed (identical): ' DST1 " - " DST2 - END-DISPLAY - END-IF. - - MOVE 1000001.0 TO DST1. - MOVE 1000000.0 TO DST2. - IF DST1 = DST2 THEN - DISPLAY 'move/compare of nearly equal big numbers failed - - '(identical): ' DST1 " - " DST2 - END-DISPLAY - END-IF. - - * Within tolerance by definition, therefore not checked - * MOVE 1000000000.0 TO DST1. - * MOVE 1000000001.0 TO DST2. - * IF DST1 = DST2 THEN - * DISPLAY 'move/compare of nearly equal very big numbers fa - *- 'iled (identical): ' DST1 " - " DST2 - * END-DISPLAY - * END-IF. - - STOP RUN. -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [], []) - -AT_CLEANUP - - -AT_SETUP([Overlapping MOVE]) -AT_KEYWORDS([fundamental]) - -AT_DATA([subprog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. subprog. - DATA DIVISION. - WORKING-STORAGE SECTION. - LINKAGE SECTION. - 01 F1 PIC X(10). - 01 F2 PIC X(15). - - PROCEDURE DIVISION USING F1 F2. - MOVE F2(1:6) TO F1 (1:8). - IF F1 not = "Hallo1 90" - DISPLAY "error:3: " F1 - END-DISPLAY - END-IF - - GOBACK. -]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 STRUCTURE. - 05 FIELD1 PIC X(5). - 05 FIELD2 PIC X(10). - - PROCEDURE DIVISION. - MOVE "Hallo" TO FIELD1. - MOVE "1234567890" TO FIELD2. - - MOVE FIELD2 TO STRUCTURE. - IF FIELD1 not = "12345" - DISPLAY "error:1: " FIELD1 - END-DISPLAY - END-IF - IF FIELD2 not = "67890 " - DISPLAY "error:2: " FIELD2 - END-DISPLAY - END-IF - - - MOVE "Hallo" TO FIELD1. - MOVE "1234567890" TO FIELD2. - - CALL "subprog" USING BY REFERENCE FIELD2 STRUCTURE - END-CALL - - STOP RUN. -]) - -AT_CHECK([$COMPILE_MODULE subprog.cob], [0], [], []) -AT_CHECK([$COMPILE prog.cob], [0], [], -[prog.cob:15: warning: overlapping MOVE may produce unpredictable results -]) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [], []) - -AT_DATA([prog2.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog2. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 FILLER. - 05 TSTMOV1 PIC X(479). - 05 TSTMOV2 PIC X(10). - PROCEDURE DIVISION. - MOVE "0123456789" TO TSTMOV2. - MOVE TSTMOV2 (2:9) TO TSTMOV2 (1:9) - IF TSTMOV2 NOT = "1234567899" - DISPLAY " PROBLEM MOVE: " TSTMOV2 - ELSE - DISPLAY " OK with MOVE: " TSTMOV2. - MOVE "0123456789" TO TSTMOV2. - MOVE TSTMOV2 (1:8) TO TSTMOV2 (2:8) - IF TSTMOV2 = "0000000009" - DISPLAY "IBM style MOVE: " TSTMOV2 - ELSE IF TSTMOV2 NOT = "0012345679" - DISPLAY " PROBLEM MOVE: " TSTMOV2 - ELSE - DISPLAY " OK with MOVE: " TSTMOV2. - STOP RUN. -]) - -AT_CHECK([$COMPILE prog2.cob], [0], [], -[prog2.cob:11: warning: overlapping MOVE may produce unpredictable results -prog2.cob:17: warning: overlapping MOVE may produce unpredictable results -]) - -AT_CHECK([$COBCRUN_DIRECT ./prog2], [0], -[ OK with MOVE: 1234567899 - OK with MOVE: 0012345679 -], []) - -AT_CLEANUP - - -AT_SETUP([Overlapping MOVE]) -AT_KEYWORDS([fundamental]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 FILLER. - 05 TSTMOV1 PIC X(479). - 05 TSTMOV2 PIC X(10). - PROCEDURE DIVISION. - MOVE "0123456789" TO TSTMOV2. - MOVE TSTMOV2 (2:9) TO TSTMOV2 (1:9) - IF TSTMOV2 NOT = "1234567899" - DISPLAY " PROBLEM MOVE: " TSTMOV2 - ELSE - DISPLAY " OK with MOVE: " TSTMOV2. - MOVE "0123456789" TO TSTMOV2. - MOVE TSTMOV2 (1:8) TO TSTMOV2 (2:8) - IF TSTMOV2 = "0000000009" - DISPLAY "IBM style MOVE: " TSTMOV2 - ELSE IF TSTMOV2 NOT = "0012345679" - DISPLAY " PROBLEM MOVE: " TSTMOV2 - ELSE - DISPLAY " OK with MOVE: " TSTMOV2. - STOP RUN. -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], -[prog.cob:11: warning: overlapping MOVE may produce unpredictable results -prog.cob:17: warning: overlapping MOVE may produce unpredictable results -]) - -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], -[ OK with MOVE: 1234567899 - OK with MOVE: 0012345679 -], []) - -AT_CLEANUP - - -AT_SETUP([IBM MOVE]) -AT_KEYWORDS([fundamental]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 FILLER. - 05 TSTMOV1 PIC X(479). - 05 TSTMOV2 PIC X(10). - PROCEDURE DIVISION. - MOVE "0123456789" TO TSTMOV2. - MOVE TSTMOV2 (2:9) TO TSTMOV2 (1:9) - IF TSTMOV2 NOT = "1234567899" - DISPLAY " PROBLEM MOVE: " TSTMOV2 - ELSE - DISPLAY " OK with MOVE: " TSTMOV2. - MOVE "0123456789" TO TSTMOV2. - MOVE TSTMOV2 (1:8) TO TSTMOV2 (2:8) - IF TSTMOV2 = "0000000009" - DISPLAY "IBM style MOVE: " TSTMOV2 - ELSE IF TSTMOV2 NOT = "0012345679" - DISPLAY " PROBLEM MOVE: " TSTMOV2 - ELSE - DISPLAY " OK with MOVE: " TSTMOV2. - STOP RUN. -]) - -AT_CHECK([$COMPILE -fmove-ibm prog.cob], [0], [], []) - -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], -[ OK with MOVE: 1234567899 -IBM style MOVE: 0000000009 -], []) - -AT_CLEANUP - - -AT_SETUP([ALPHABETIC test]) -AT_KEYWORDS([fundamental]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 X PIC X(04) VALUE "AAAA". - 01 FILLER REDEFINES X. - 03 XBYTE PIC X. - 03 FILLER PIC XXX. - PROCEDURE DIVISION. - MOVE X"0D" TO XBYTE. - IF X ALPHABETIC - DISPLAY "Fail - Alphabetic" - END-DISPLAY - END-IF. - MOVE "A" TO XBYTE. - IF X NOT ALPHABETIC - DISPLAY "Fail - Not Alphabetic" - END-DISPLAY - END-IF. - STOP RUN. -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [], []) - -AT_CLEANUP - - -AT_SETUP([ALPHABETIC-UPPER test]) -AT_KEYWORDS([fundamental]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 X PIC X(04) VALUE "AAAA". - 01 FILLER REDEFINES X. - 03 XBYTE PIC X. - 03 FILLER PIC XXX. - PROCEDURE DIVISION. - MOVE X"0D" TO XBYTE. - IF X ALPHABETIC-UPPER - DISPLAY "Fail - Not alphabetic upper" - END-DISPLAY - END-IF. - MOVE "A" TO XBYTE. - IF X NOT ALPHABETIC-UPPER - DISPLAY "Fail - Alphabetic upper" - END-DISPLAY - END-IF. - STOP RUN. -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [], []) - -AT_CLEANUP - - -AT_SETUP([ALPHABETIC-LOWER test]) -AT_KEYWORDS([fundamental]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 X PIC X(04) VALUE "aaaa". - 01 FILLER REDEFINES X. - 03 XBYTE PIC X. - 03 FILLER PIC XXX. - PROCEDURE DIVISION. - MOVE X"0D" TO XBYTE. - IF X ALPHABETIC-LOWER - DISPLAY "Fail - Not alphabetic lower" - END-DISPLAY - END-IF. - MOVE "a" TO XBYTE. - IF X NOT ALPHABETIC-LOWER - DISPLAY "Fail - Alphabetic lower" - END-DISPLAY - END-IF. - STOP RUN. -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [], []) - -AT_CLEANUP - - -AT_SETUP([GLOBAL at same level]) -AT_KEYWORDS([fundamental]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 X PIC X(5) GLOBAL VALUE "prog1". - PROCEDURE DIVISION. - DISPLAY X - END-DISPLAY. - CALL "prog2" - END-CALL - CALL "prog3" - END-CALL - STOP RUN. - IDENTIFICATION DIVISION. - PROGRAM-ID. prog2. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 X PIC X(5) GLOBAL VALUE "prog2". - PROCEDURE DIVISION. - DISPLAY X - END-DISPLAY. - EXIT PROGRAM. - END PROGRAM prog2. - IDENTIFICATION DIVISION. - PROGRAM-ID. prog3. - DATA DIVISION. - WORKING-STORAGE SECTION. - PROCEDURE DIVISION. - DISPLAY X - END-DISPLAY. - EXIT PROGRAM. - END PROGRAM prog3. - END PROGRAM prog. -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], -[prog1 -prog2 -prog1 -]) - -AT_CLEANUP - - -AT_SETUP([GLOBAL at lower level]) -AT_KEYWORDS([fundamental]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 X PIC X(5) GLOBAL VALUE "prog1". - PROCEDURE DIVISION. - DISPLAY X - END-DISPLAY. - CALL "prog2" - END-CALL - STOP RUN. - IDENTIFICATION DIVISION. - PROGRAM-ID. prog2. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 X PIC X(5) GLOBAL VALUE "prog2". - PROCEDURE DIVISION. - DISPLAY X - END-DISPLAY. - CALL "prog3" - END-CALL - EXIT PROGRAM. - IDENTIFICATION DIVISION. - PROGRAM-ID. prog3. - DATA DIVISION. - WORKING-STORAGE SECTION. - PROCEDURE DIVISION. - DISPLAY X - END-DISPLAY. - EXIT PROGRAM. - END PROGRAM prog3. - END PROGRAM prog2. - END PROGRAM prog. -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], -[prog1 -prog2 -prog2 -]) - -AT_CLEANUP - - -AT_SETUP([GLOBAL CONSTANT]) -AT_KEYWORDS([fundamental]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - INPUT-OUTPUT SECTION. - FILE-CONTROL. - SELECT TEST-FILE - ASSIGN GLOB-PATH - . - DATA DIVISION. - FILE SECTION. - FD TEST-FILE GLOBAL. - 01 TEST-REC PIC X(4). - WORKING-STORAGE SECTION. - 78 GLOB-PATH GLOBAL VALUE "GLOBP1". - 01 GLOB-PATH2 CONSTANT GLOBAL "GLOBP2". - * Test global vars because of implicitly defined ASSIGN var, too. - 78 GLOB-VAR GLOBAL VALUE "GLOBV1". - 01 GLOB-VAR2 CONSTANT GLOBAL "GLOBV2". - PROCEDURE DIVISION. - DISPLAY GLOB-PATH GLOB-VAR - END-DISPLAY. - CALL "prog2" - END-CALL. - CALL "prog3" - END-CALL. - STOP RUN. - IDENTIFICATION DIVISION. - PROGRAM-ID. prog2. - ENVIRONMENT DIVISION. - INPUT-OUTPUT SECTION. - FILE-CONTROL. - SELECT TEST2-FILE - ASSIGN GLOB-PATH2 - . - DATA DIVISION. - FILE SECTION. - FD TEST2-FILE GLOBAL. - 01 TEST2-REC PIC X(4). - WORKING-STORAGE SECTION. - PROCEDURE DIVISION. - DISPLAY GLOB-PATH2 GLOB-VAR2 - END-DISPLAY. - EXIT PROGRAM. - END PROGRAM prog2. - END PROGRAM prog. - IDENTIFICATION DIVISION. - PROGRAM-ID. prog3. - ENVIRONMENT DIVISION. - INPUT-OUTPUT SECTION. - FILE-CONTROL. - SELECT TEST3-FILE - ASSIGN GLOB-PATH - . - DATA DIVISION. - FILE SECTION. - FD TEST3-FILE GLOBAL. - 01 TEST3-REC PIC X(4). - WORKING-STORAGE SECTION. - PROCEDURE DIVISION. - DISPLAY 'in prog3' - END-DISPLAY - IF GLOB-PATH NOT = SPACES - DISPLAY GLOB-PATH - END-DISPLAY - END-IF - EXIT PROGRAM. - END PROGRAM prog3. -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], -[prog.cob:60: warning: variable 'GLOB-PATH' will be implicitly defined -]) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], -[GLOBP1GLOBV1 -GLOBP2GLOBV2 -in prog3 -]) - -AT_CLEANUP - - -AT_SETUP([GLOBAL identifiers from ENVIRONMENT DIVISION]) -AT_KEYWORDS([fundamental function CURRENCY SIGN]) - -AT_DATA([prog.cob], [ - FUNCTION-ID. f1. - DATA DIVISION. - LINKAGE SECTION. - 01 r BINARY-LONG. - PROCEDURE DIVISION RETURNING r. - move 1 to r - GOBACK - . - END FUNCTION f1. - FUNCTION-ID. f2. - DATA DIVISION. - LINKAGE SECTION. - 01 i BINARY-LONG. - 01 r BINARY-LONG. - PROCEDURE DIVISION USING i RETURNING r. - add i to i giving r - GOBACK - . - END FUNCTION f2. - - PROGRAM-ID. prog. - - ENVIRONMENT DIVISION. - CONFIGURATION SECTION. - REPOSITORY. - FUNCTION f1 - FUNCTION f2. - SPECIAL-NAMES. - CURRENCY SIGN IS "Y" - DECIMAL-POINT IS COMMA. - - PROCEDURE DIVISION. - CALL "prog-nested" - . - - PROGRAM-ID. prog-nested. - - DATA DIVISION. - WORKING-STORAGE SECTION. - 77 n1 BINARY-LONG VALUE 0. - 77 curr PIC 9.9999,99Y. - - PROCEDURE DIVISION. - MOVE f1() TO n1 - IF n1 NOT = 1 - DISPLAY "ERROR 1" GOBACK - END-IF - MOVE f2(n1) TO n1 - IF n1 NOT = 2 - DISPLAY "ERROR 2" GOBACK - END-IF - MOVE f1() TO n1 - IF n1 NOT = 1 - DISPLAY "ERROR 1 2nd" GOBACK - END-IF - MOVE f2(f2(n1)) TO n1 - IF n1 NOT = 4 - DISPLAY "ERROR 4" GOBACK - END-IF - MOVE n1 TO curr - DISPLAY curr - - GOBACK - . - END PROGRAM prog-nested. - END PROGRAM prog. - -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], -[0.0004,00Y -]) - -AT_CLEANUP - - -AT_SETUP([Entry point visibility (1)]) -AT_KEYWORDS([fundamental CALL]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - PROCEDURE DIVISION. - CALL 'module' - CALL 'modulepart' - STOP RUN. -]) - -AT_DATA([module.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. module. - DATA DIVISION. - PROCEDURE DIVISION. - DISPLAY 'A' WITH NO ADVANCING - GOBACK. - ENTRY 'modulepart'. - DISPLAY 'B' WITH NO ADVANCING - GOBACK. -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$COMPILE_MODULE module.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [AB], []) - -AT_CLEANUP - - -AT_SETUP([Entry point visibility (2)]) -AT_KEYWORDS([fundamental CALL]) - -# TODO: skip on __OS400__ - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - PROCEDURE DIVISION. - CALL 'module' - STOP RUN. -]) - -AT_DATA([module.c], [ -#include -#include - -COB_EXT_EXPORT int -some (void) -{ - return 0; -} -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$COMPILE_MODULE module.c], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [1], [], -[libcob: prog.cob:6: error: entry point 'module' not found -]) - -AT_CLEANUP - - -AT_SETUP([Contained program visibility (1)]) -AT_KEYWORDS([fundamental CALL]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 X PIC X(5) GLOBAL VALUE "prog1". - PROCEDURE DIVISION. - IF X NOT = "prog1" - DISPLAY X - END-DISPLAY - END-IF. - CALL "prog2" - END-CALL. - CALL "prog3" - END-CALL. - STOP RUN. - IDENTIFICATION DIVISION. - PROGRAM-ID. prog2. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 X PIC X(5) GLOBAL VALUE "prog2". - PROCEDURE DIVISION. - IF X NOT = "prog2" - DISPLAY X - END-DISPLAY - END-IF. - CALL "prog3" - END-CALL. - EXIT PROGRAM. - IDENTIFICATION DIVISION. - PROGRAM-ID. prog3. - DATA DIVISION. - WORKING-STORAGE SECTION. - PROCEDURE DIVISION. - IF X NOT = "prog2" - DISPLAY X - END-DISPLAY - END-IF - EXIT PROGRAM. - END PROGRAM prog3. - END PROGRAM prog2. - END PROGRAM prog. -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [1], [], -[libcob: prog.cob:14: error: module 'prog3' not found -]) - -AT_CLEANUP - - -AT_SETUP([Contained program visibility (2)]) -AT_KEYWORDS([fundamental CALL]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 X PIC X(5) GLOBAL VALUE "prog1". - PROCEDURE DIVISION. - IF X NOT = "prog1" - DISPLAY X - END-DISPLAY - END-IF. - CALL "prog2" - END-CALL. - STOP RUN. - IDENTIFICATION DIVISION. - PROGRAM-ID. prog2. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 X PIC X(5) GLOBAL VALUE "prog2". - PROCEDURE DIVISION. - IF X NOT = "prog2" - DISPLAY X - END-DISPLAY - END-IF. - CALL "prog3" - END-CALL. - EXIT PROGRAM. - END PROGRAM prog2. - IDENTIFICATION DIVISION. - PROGRAM-ID. prog3. - DATA DIVISION. - WORKING-STORAGE SECTION. - PROCEDURE DIVISION. - IF X NOT = "prog2" - DISPLAY X - END-DISPLAY - END-IF. - EXIT PROGRAM. - END PROGRAM prog3. - END PROGRAM prog. -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [1], [], -[libcob: prog.cob:25: error: module 'prog3' not found -]) - -AT_CLEANUP - - -AT_SETUP([Contained program visibility (3)]) -AT_KEYWORDS([fundamental CALL]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 X PIC X(5) GLOBAL VALUE "prog1". - PROCEDURE DIVISION. - IF X NOT = "prog1" - DISPLAY X - END-DISPLAY - END-IF. - CALL "prog2" - END-CALL. - STOP RUN. - IDENTIFICATION DIVISION. - PROGRAM-ID. prog2. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 X PIC X(5) GLOBAL VALUE "prog2". - PROCEDURE DIVISION. - IF X NOT = "prog2" - DISPLAY X - END-DISPLAY - END-IF. - CALL "prog3" - END-CALL. - EXIT PROGRAM. - END PROGRAM prog2. - IDENTIFICATION DIVISION. - PROGRAM-ID. prog3 COMMON. - DATA DIVISION. - WORKING-STORAGE SECTION. - PROCEDURE DIVISION. - IF X NOT = "prog1" - DISPLAY X - END-DISPLAY - END-IF. - EXIT PROGRAM. - END PROGRAM prog3. - END PROGRAM prog. -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [], []) - -AT_CLEANUP - - -AT_SETUP([Contained program visibility (4)]) -AT_KEYWORDS([fundamental CALL]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - PROCEDURE DIVISION. - DISPLAY "P1" NO ADVANCING - END-DISPLAY. - CALL "prog2" - END-CALL - CALL "prog3" - END-CALL - STOP RUN. - IDENTIFICATION DIVISION. - PROGRAM-ID. prog2. - DATA DIVISION. - WORKING-STORAGE SECTION. - PROCEDURE DIVISION. - DISPLAY "P2" NO ADVANCING - END-DISPLAY. - EXIT PROGRAM. - END PROGRAM prog2. - END PROGRAM prog. - IDENTIFICATION DIVISION. - PROGRAM-ID. prog3. - DATA DIVISION. - WORKING-STORAGE SECTION. - PROCEDURE DIVISION. - DISPLAY "P3" NO ADVANCING - END-DISPLAY. - CALL "prog2" - END-CALL. - EXIT PROGRAM. - IDENTIFICATION DIVISION. - PROGRAM-ID. prog2. - DATA DIVISION. - WORKING-STORAGE SECTION. - PROCEDURE DIVISION. - DISPLAY "P4" NO ADVANCING - END-DISPLAY. - EXIT PROGRAM. - END PROGRAM prog2. - END PROGRAM prog3. -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], -[P1P2P3P4]) - -AT_CLEANUP - - -AT_SETUP([CALL/CANCEL with program-prototype-name]) -AT_KEYWORDS([fundamental]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - - ENVIRONMENT DIVISION. - CONFIGURATION SECTION. - REPOSITORY. - PROGRAM recursion-test - PROGRAM cancel-test - . - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 num PIC 9 VALUE 0. - - PROCEDURE DIVISION. - CALL recursion-test USING num - DISPLAY "<" - - CALL cancel-test - CALL cancel-test - CANCEL cancel-test - CALL cancel-test - DISPLAY "<" - . - END PROGRAM prog. - - - IDENTIFICATION DIVISION. - PROGRAM-ID. recursion-test RECURSIVE. - - DATA DIVISION. - LINKAGE SECTION. - 01 x PIC 9. - - PROCEDURE DIVISION USING x. - ADD 1 TO x - DISPLAY x NO ADVANCING - IF x = 1 - CALL recursion-test USING x - END-IF - . - END PROGRAM recursion-test. - - - IDENTIFICATION DIVISION. - PROGRAM-ID. cancel-test. - - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 x PIC 9 VALUE 1. - - PROCEDURE DIVISION. - DISPLAY x NO ADVANCING - ADD 1 TO x - . - END PROGRAM cancel-test. -]) - -# TO-DO: Fix these warnings when program prototypes are added. -AT_CHECK([$COMPILE -fno-program-name-redefinition prog.cob], [0], [], -[prog.cob:8: warning: no definition/prototype seen for PROGRAM 'recursion-test' -prog.cob:9: warning: no definition/prototype seen for PROGRAM 'cancel-test' -]) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], -[12< -121< -]) -AT_CLEANUP - - -AT_SETUP([GLOBAL FD (RELATIVE 1)]) -AT_KEYWORDS([fundamental]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - INPUT-OUTPUT SECTION. - FILE-CONTROL. - SELECT TEST-FILE - ASSIGN "TESTFILE" - ACCESS DYNAMIC - ORGANIZATION RELATIVE - STATUS TESTSTAT - RELATIVE KEY TESTKEY - . - DATA DIVISION. - FILE SECTION. - FD TEST-FILE GLOBAL. - 01 TEST-REC PIC X(4). - WORKING-STORAGE SECTION. - 01 GLOBVALS. - 03 TESTKEY PIC 9(4). - 03 TESTSTAT PIC XX. - PROCEDURE DIVISION. - OPEN INPUT TEST-FILE. - CALL "prog2" - END-CALL. - CLOSE TEST-FILE. - STOP RUN. - IDENTIFICATION DIVISION. - PROGRAM-ID. prog2. - DATA DIVISION. - WORKING-STORAGE SECTION. - PROCEDURE DIVISION. - READ TEST-FILE - INVALID KEY - DISPLAY "NOK" - END-DISPLAY - END-READ. - EXIT PROGRAM. - END PROGRAM prog2. - END PROGRAM prog. -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [], []) - -AT_CLEANUP - - -AT_SETUP([GLOBAL FD (INDEXED 1)]) -AT_KEYWORDS([fundamental]) - -AT_SKIP_IF([test "$COB_HAS_ISAM" = "no"]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - INPUT-OUTPUT SECTION. - FILE-CONTROL. - SELECT TEST-FILE - ASSIGN "TESTFILE" - ACCESS DYNAMIC - ORGANIZATION INDEXED - STATUS TESTSTAT - RECORD KEY TESTKEY - . - DATA DIVISION. - FILE SECTION. - FD TEST-FILE GLOBAL. - 01 TEST-REC. - 03 TESTKEY PIC X(4). - WORKING-STORAGE SECTION. - 01 GLOBVALS. - 03 TESTSTAT PIC XX. - PROCEDURE DIVISION. - OPEN INPUT TEST-FILE. - CALL "prog2" - END-CALL. - CLOSE TEST-FILE. - STOP RUN. - IDENTIFICATION DIVISION. - PROGRAM-ID. prog2. - DATA DIVISION. - WORKING-STORAGE SECTION. - PROCEDURE DIVISION. - READ TEST-FILE - INVALID KEY - DISPLAY "NOK" - END-DISPLAY - END-READ. - EXIT PROGRAM. - END PROGRAM prog2. - END PROGRAM prog. -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [], []) - -AT_CLEANUP - - -AT_SETUP([GLOBAL FD (RELATIVE 2)]) -AT_KEYWORDS([fundamental]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - INPUT-OUTPUT SECTION. - FILE-CONTROL. - SELECT TEST-FILE - ASSIGN "TESTFILE" - ACCESS DYNAMIC - ORGANIZATION RELATIVE - STATUS TESTSTAT - RELATIVE KEY TESTKEY - . - DATA DIVISION. - FILE SECTION. - FD TEST-FILE GLOBAL. - 01 TEST-REC PIC X(4). - WORKING-STORAGE SECTION. - 01 GLOBVALS. - 03 TESTKEY PIC 9(4). - 03 TESTSTAT PIC XX. - PROCEDURE DIVISION. - MOVE "00" TO TESTSTAT. - CALL "prog2" - END-CALL. - IF TESTSTAT = "00" - DISPLAY "Not OK" - END-DISPLAY - END-IF. - STOP RUN. - IDENTIFICATION DIVISION. - PROGRAM-ID. prog2. - DATA DIVISION. - WORKING-STORAGE SECTION. - PROCEDURE DIVISION. - OPEN INPUT TEST-FILE. - EXIT PROGRAM. - END PROGRAM prog2. - END PROGRAM prog. -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [], []) - -AT_CLEANUP - - -AT_SETUP([GLOBAL FD (INDEXED 2)]) -AT_KEYWORDS([fundamental]) - -AT_SKIP_IF([test "$COB_HAS_ISAM" = "no"]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - INPUT-OUTPUT SECTION. - FILE-CONTROL. - SELECT TEST-FILE - ASSIGN "TESTFILE" - ACCESS DYNAMIC - ORGANIZATION INDEXED - STATUS TESTSTAT - RECORD KEY TESTKEY - . - DATA DIVISION. - FILE SECTION. - FD TEST-FILE GLOBAL. - 01 TEST-REC. - 03 TESTKEY PIC X(4). - WORKING-STORAGE SECTION. - 01 GLOBVALS. - 03 TESTSTAT PIC XX. - PROCEDURE DIVISION. - MOVE "00" TO TESTSTAT. - CALL "prog2" - END-CALL. - IF TESTSTAT = "00" - DISPLAY "Not OK" - END-DISPLAY - END-IF. - STOP RUN. - IDENTIFICATION DIVISION. - PROGRAM-ID. prog2. - DATA DIVISION. - WORKING-STORAGE SECTION. - PROCEDURE DIVISION. - OPEN INPUT TEST-FILE. - EXIT PROGRAM. - END PROGRAM prog2. - END PROGRAM prog. -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [], []) - -AT_CLEANUP - - -AT_SETUP([CANCEL test (1)]) -AT_KEYWORDS([fundamental]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - PROCEDURE DIVISION. - CANCEL "notthere". - CANCEL "prog". - DISPLAY "NG" NO ADVANCING - END-DISPLAY. - STOP RUN. -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [1], [], -[libcob: prog.cob:8: error: attempt to CANCEL active program -]) -AT_CHECK([COB_PHYSICAL_CANCEL=1 ./prog], [1], [], -[libcob: prog.cob:8: error: attempt to CANCEL active program -]) - -AT_CLEANUP - - -AT_SETUP([CANCEL test (2)]) -AT_KEYWORDS([fundamental]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - PROCEDURE DIVISION. - CALL "prog2" - END-CALL. - DISPLAY "NG" NO ADVANCING - END-DISPLAY. - STOP RUN. -]) - -AT_DATA([prog2.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog2. - DATA DIVISION. - WORKING-STORAGE SECTION. - PROCEDURE DIVISION. - CANCEL "prog". - DISPLAY "NG" NO ADVANCING - END-DISPLAY. - STOP RUN. -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$COMPILE_MODULE prog2.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [1], [], -[libcob: prog2.cob:7: error: attempt to CANCEL active program -]) -AT_CHECK([COB_PHYSICAL_CANCEL=1 ./prog], [1], [], -[libcob: prog2.cob:7: error: attempt to CANCEL active program -]) - -AT_CLEANUP - - -AT_SETUP([CANCEL test (3)]) -AT_KEYWORDS([fundamental]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - PROCEDURE DIVISION. - CALL "prog2" - END-CALL. - CALL "prog2" - END-CALL. - CANCEL "prog2". - CALL "prog2" - END-CALL. - CANCEL "prog2". - DISPLAY "NG" NO ADVANCING - END-DISPLAY. - STOP RUN. -]) - -AT_DATA([prog2.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog2. - DATA DIVISION. - WORKING-STORAGE SECTION. - 77 VAR PIC 9(01) value 1. - PROCEDURE DIVISION. - DISPLAY VAR NO ADVANCING - END-DISPLAY. - ADD 1 TO VAR END-ADD. - GOBACK. -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$COMPILE_MODULE prog2.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [121NG], []) -AT_CHECK([COB_PHYSICAL_CANCEL=1 ./prog], [0], [121NG], []) - -AT_CLEANUP - - -AT_SETUP([Separate sign positions (1)]) -AT_KEYWORDS([fundamental]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 X PIC S9 VALUE -1 SIGN LEADING SEPARATE. - 01 Y PIC S9 VALUE -1 SIGN TRAILING SEPARATE. - PROCEDURE DIVISION. - DISPLAY X(1:1) X(2:1) NO ADVANCING - END-DISPLAY. - DISPLAY Y(1:1) Y(2:1) NO ADVANCING - END-DISPLAY. - STOP RUN. -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [-11-]) - -AT_CLEANUP - - -AT_SETUP([Separate sign positions (2)]) -AT_KEYWORDS([fundamental]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 X PIC S9 SIGN LEADING SEPARATE. - 01 Y PIC S9 SIGN TRAILING SEPARATE. - PROCEDURE DIVISION. - MOVE 0 TO X. - DISPLAY X NO ADVANCING - END-DISPLAY. - MOVE ZERO TO X. - DISPLAY X NO ADVANCING - END-DISPLAY. - MOVE 0 TO Y. - DISPLAY Y NO ADVANCING - END-DISPLAY. - MOVE ZERO TO Y. - DISPLAY Y NO ADVANCING - END-DISPLAY. - STOP RUN. -]) -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$COMPILE_MODULE -fpretty-display prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [+0+00+0+]) -AT_CHECK([$COBCRUN prog], [0], [+0+00+0+]) - -AT_CLEANUP - - -AT_SETUP([Context sensitive words (1)]) -AT_KEYWORDS([fundamental byte-length]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 BYTE-LENGTH PIC 9. - 01 X CONSTANT AS BYTE-LENGTH OF BYTE-LENGTH. - PROCEDURE DIVISION. - MOVE X TO BYTE-LENGTH. - DISPLAY BYTE-LENGTH NO ADVANCING - END-DISPLAY. - STOP RUN. -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [1]) - -AT_CLEANUP - - -AT_SETUP([Context sensitive words (2)]) -AT_KEYWORDS([fundamental yyyymmdd]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 YYYYMMDD PIC 9 VALUE 0. - 01 X PIC X(16). - PROCEDURE DIVISION. - ACCEPT X FROM DATE YYYYMMDD - END-ACCEPT. - DISPLAY YYYYMMDD NO ADVANCING - END-DISPLAY. - STOP RUN. -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [0], []) - -AT_CLEANUP - - -AT_SETUP([Context sensitive words (3)]) -AT_KEYWORDS([fundamental yyyyddd]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 YYYYDDD PIC 9 VALUE 0. - 01 X PIC X(16). - PROCEDURE DIVISION. - ACCEPT X FROM DAY YYYYDDD - END-ACCEPT. - DISPLAY YYYYDDD NO ADVANCING - END-DISPLAY. - STOP RUN. -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [0], []) - -AT_CLEANUP - - -AT_SETUP([Context sensitive words (4)]) -AT_KEYWORDS([fundamental intrinsic]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - CONFIGURATION SECTION. - REPOSITORY. - FUNCTION ALL INTRINSIC. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 INTRINSIC PIC 9 VALUE 0. - PROCEDURE DIVISION. - DISPLAY INTRINSIC NO ADVANCING - END-DISPLAY. - STOP RUN. -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [0], []) - -AT_CLEANUP - - -AT_SETUP([Context sensitive words (5)]) -AT_KEYWORDS([fundamental recursive]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog RECURSIVE. - ENVIRONMENT DIVISION. - CONFIGURATION SECTION. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 RECURSIVE PIC 9 VALUE 0. - PROCEDURE DIVISION. - DISPLAY RECURSIVE NO ADVANCING - END-DISPLAY. - STOP RUN. -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [0], []) - -AT_CLEANUP - - -AT_SETUP([Context sensitive words (6)]) -AT_KEYWORDS([fundamental normal]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - CONFIGURATION SECTION. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 NORMAL PIC 9 VALUE 0. - PROCEDURE DIVISION. - DISPLAY NORMAL NO ADVANCING *> Intentionally no period or END-DISPLAY - STOP RUN NORMAL. -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [0], []) - -AT_CLEANUP - - -AT_SETUP([Context sensitive words (7)]) -AT_KEYWORDS([fundamental compute away-from-zero]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - CONFIGURATION SECTION. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 X PIC 9 VALUE 0. - 01 AWAY-FROM-ZERO PIC 9 VALUE 0. - PROCEDURE DIVISION. - COMPUTE X ROUNDED MODE AWAY-FROM-ZERO - AWAY-FROM-ZERO = 1.1 - END-COMPUTE - DISPLAY X AWAY-FROM-ZERO NO ADVANCING - END-DISPLAY. - STOP RUN. -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [21]) - -AT_CLEANUP - - -AT_SETUP([Context sensitive words (8)]) -AT_KEYWORDS([fundamental ibm unbounded attributes]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - CONFIGURATION SECTION. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 UNBOUNDED. - 03 ATTRIBUTES PIC 9 VALUE 0. - 01 LOC. - 03 NAMESPACE PIC 9 VALUE 1. - PROCEDURE DIVISION. - DISPLAY UNBOUNDED ATTRIBUTES - NAMESPACE IN LOC - NO ADVANCING. - STOP RUN. -]) - -AT_CHECK([$COMPILE -std=ibm-strict prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [001], []) - -AT_CLEANUP - - -AT_SETUP([ROUNDED AWAY-FROM-ZERO]) -AT_KEYWORDS([fundamental compute]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 M PIC S9. - 01 N PIC S9. - 01 O PIC S9. - 01 P PIC S9. - 01 Q PIC S9. - 01 R PIC S9. - 01 S PIC S9. - 01 T PIC S9. - 01 U PIC S9. - 01 V PIC S9. - PROCEDURE DIVISION. - COMPUTE M ROUNDED MODE AWAY-FROM-ZERO - = 2.49 - END-COMPUTE - COMPUTE N ROUNDED MODE AWAY-FROM-ZERO - = -2.49 - END-COMPUTE - COMPUTE O ROUNDED MODE AWAY-FROM-ZERO - = 2.50 - END-COMPUTE - COMPUTE P ROUNDED MODE AWAY-FROM-ZERO - = -2.50 - END-COMPUTE - COMPUTE Q ROUNDED MODE AWAY-FROM-ZERO - = 3.49 - END-COMPUTE - COMPUTE R ROUNDED MODE AWAY-FROM-ZERO - = -3.49 - END-COMPUTE - COMPUTE S ROUNDED MODE AWAY-FROM-ZERO - = 3.50 - END-COMPUTE - COMPUTE T ROUNDED MODE AWAY-FROM-ZERO - = -3.50 - END-COMPUTE - COMPUTE U ROUNDED MODE AWAY-FROM-ZERO - = 3.510 - END-COMPUTE - COMPUTE V ROUNDED MODE AWAY-FROM-ZERO - = -3.510 - END-COMPUTE - DISPLAY M " " N " " O " " P " " Q " " R " " S " " T - " " U " " V - NO ADVANCING - END-DISPLAY - STOP RUN. -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [+3 -3 +3 -3 +4 -4 +4 -4 +4 -4]) - -AT_CLEANUP - - -AT_SETUP([ROUNDED NEAREST-AWAY-FROM-ZERO]) -AT_KEYWORDS([fundamental compute]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 M PIC S9. - 01 N PIC S9. - 01 O PIC S9. - 01 P PIC S9. - 01 Q PIC S9. - 01 R PIC S9. - 01 S PIC S9. - 01 T PIC S9. - 01 U PIC S9. - 01 V PIC S9. - PROCEDURE DIVISION. - COMPUTE M ROUNDED MODE NEAREST-AWAY-FROM-ZERO - = 2.49 - END-COMPUTE - COMPUTE N ROUNDED MODE NEAREST-AWAY-FROM-ZERO - = -2.49 - END-COMPUTE - COMPUTE O ROUNDED MODE NEAREST-AWAY-FROM-ZERO - = 2.50 - END-COMPUTE - COMPUTE P ROUNDED MODE NEAREST-AWAY-FROM-ZERO - = -2.50 - END-COMPUTE - COMPUTE Q ROUNDED MODE NEAREST-AWAY-FROM-ZERO - = 3.49 - END-COMPUTE - COMPUTE R ROUNDED MODE NEAREST-AWAY-FROM-ZERO - = -3.49 - END-COMPUTE - COMPUTE S ROUNDED MODE NEAREST-AWAY-FROM-ZERO - = 3.50 - END-COMPUTE - COMPUTE T ROUNDED MODE NEAREST-AWAY-FROM-ZERO - = -3.50 - END-COMPUTE - COMPUTE U ROUNDED MODE NEAREST-AWAY-FROM-ZERO - = 3.510 - END-COMPUTE - COMPUTE V ROUNDED MODE NEAREST-AWAY-FROM-ZERO - = -3.510 - END-COMPUTE - DISPLAY M " " N " " O " " P " " Q " " R " " S " " T - " " U " " V - NO ADVANCING - END-DISPLAY - STOP RUN. -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [+2 -2 +3 -3 +3 -3 +4 -4 +4 -4]) - -AT_CLEANUP - - -AT_SETUP([ROUNDED NEAREST-EVEN]) -AT_KEYWORDS([fundamental compute]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 M PIC S9. - 01 N PIC S9. - 01 O PIC S9. - 01 P PIC S9. - 01 Q PIC S9. - 01 R PIC S9. - 01 S PIC S9. - 01 T PIC S9. - 01 U PIC S9. - 01 V PIC S9. - PROCEDURE DIVISION. - COMPUTE M ROUNDED MODE NEAREST-EVEN - = 2.49 - END-COMPUTE - COMPUTE N ROUNDED MODE NEAREST-EVEN - = -2.49 - END-COMPUTE - COMPUTE O ROUNDED MODE NEAREST-EVEN - = 2.50 - END-COMPUTE - COMPUTE P ROUNDED MODE NEAREST-EVEN - = -2.50 - END-COMPUTE - COMPUTE Q ROUNDED MODE NEAREST-EVEN - = 3.49 - END-COMPUTE - COMPUTE R ROUNDED MODE NEAREST-EVEN - = -3.49 - END-COMPUTE - COMPUTE S ROUNDED MODE NEAREST-EVEN - = 3.50 - END-COMPUTE - COMPUTE T ROUNDED MODE NEAREST-EVEN - = -3.50 - END-COMPUTE - COMPUTE U ROUNDED MODE NEAREST-EVEN - = 3.510 - END-COMPUTE - COMPUTE V ROUNDED MODE NEAREST-EVEN - = -3.510 - END-COMPUTE - DISPLAY M " " N " " O " " P " " Q " " R " " S " " T - " " U " " V - NO ADVANCING - END-DISPLAY - STOP RUN. -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [+2 -2 +2 -2 +3 -3 +4 -4 +4 -4]) - -AT_CLEANUP - - -AT_SETUP([ROUNDED NEAREST-TOWARD-ZERO]) -AT_KEYWORDS([fundamental compute]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 M PIC S9. - 01 N PIC S9. - 01 O PIC S9. - 01 P PIC S9. - 01 Q PIC S9. - 01 R PIC S9. - 01 S PIC S9. - 01 T PIC S9. - 01 U PIC S9. - 01 V PIC S9. - PROCEDURE DIVISION. - COMPUTE M ROUNDED MODE NEAREST-TOWARD-ZERO - = 2.49 - END-COMPUTE - COMPUTE N ROUNDED MODE NEAREST-TOWARD-ZERO - = -2.49 - END-COMPUTE - COMPUTE O ROUNDED MODE NEAREST-TOWARD-ZERO - = 2.50 - END-COMPUTE - COMPUTE P ROUNDED MODE NEAREST-TOWARD-ZERO - = -2.50 - END-COMPUTE - COMPUTE Q ROUNDED MODE NEAREST-TOWARD-ZERO - = 3.49 - END-COMPUTE - COMPUTE R ROUNDED MODE NEAREST-TOWARD-ZERO - = -3.49 - END-COMPUTE - COMPUTE S ROUNDED MODE NEAREST-TOWARD-ZERO - = 3.50 - END-COMPUTE - COMPUTE T ROUNDED MODE NEAREST-TOWARD-ZERO - = -3.50 - END-COMPUTE - COMPUTE U ROUNDED MODE NEAREST-TOWARD-ZERO - = 3.510 - END-COMPUTE - COMPUTE V ROUNDED MODE NEAREST-TOWARD-ZERO - = -3.510 - END-COMPUTE - DISPLAY M " " N " " O " " P " " Q " " R " " S " " T - " " U " " V - NO ADVANCING - END-DISPLAY - STOP RUN. -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [+2 -2 +2 -2 +3 -3 +3 -3 +4 -4]) - -AT_CLEANUP - - -AT_SETUP([ROUNDED TOWARD-GREATER]) -AT_KEYWORDS([fundamental compute]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 M PIC S9. - 01 N PIC S9. - 01 O PIC S9. - 01 P PIC S9. - 01 Q PIC S9. - 01 R PIC S9. - 01 S PIC S9. - 01 T PIC S9. - 01 U PIC S9. - 01 V PIC S9. - PROCEDURE DIVISION. - COMPUTE M ROUNDED MODE TOWARD-GREATER - = 2.49 - END-COMPUTE - COMPUTE N ROUNDED MODE TOWARD-GREATER - = -2.49 - END-COMPUTE - COMPUTE O ROUNDED MODE TOWARD-GREATER - = 2.50 - END-COMPUTE - COMPUTE P ROUNDED MODE TOWARD-GREATER - = -2.50 - END-COMPUTE - COMPUTE Q ROUNDED MODE TOWARD-GREATER - = 3.49 - END-COMPUTE - COMPUTE R ROUNDED MODE TOWARD-GREATER - = -3.49 - END-COMPUTE - COMPUTE S ROUNDED MODE TOWARD-GREATER - = 3.50 - END-COMPUTE - COMPUTE T ROUNDED MODE TOWARD-GREATER - = -3.50 - END-COMPUTE - COMPUTE U ROUNDED MODE TOWARD-GREATER - = 3.510 - END-COMPUTE - COMPUTE V ROUNDED MODE TOWARD-GREATER - = -3.510 - END-COMPUTE - DISPLAY M " " N " " O " " P " " Q " " R " " S " " T - " " U " " V - NO ADVANCING - END-DISPLAY - STOP RUN. -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [+3 -2 +3 -2 +4 -3 +4 -3 +4 -3]) - -AT_CLEANUP - - -AT_SETUP([ROUNDED TOWARD-LESSER]) -AT_KEYWORDS([fundamental compute]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 M PIC S9. - 01 N PIC S9. - 01 O PIC S9. - 01 P PIC S9. - 01 Q PIC S9. - 01 R PIC S9. - 01 S PIC S9. - 01 T PIC S9. - 01 U PIC S9. - 01 V PIC S9. - PROCEDURE DIVISION. - COMPUTE M ROUNDED MODE TOWARD-LESSER - = 2.49 - END-COMPUTE - COMPUTE N ROUNDED MODE TOWARD-LESSER - = -2.49 - END-COMPUTE - COMPUTE O ROUNDED MODE TOWARD-LESSER - = 2.50 - END-COMPUTE - COMPUTE P ROUNDED MODE TOWARD-LESSER - = -2.50 - END-COMPUTE - COMPUTE Q ROUNDED MODE TOWARD-LESSER - = 3.49 - END-COMPUTE - COMPUTE R ROUNDED MODE TOWARD-LESSER - = -3.49 - END-COMPUTE - COMPUTE S ROUNDED MODE TOWARD-LESSER - = 3.50 - END-COMPUTE - COMPUTE T ROUNDED MODE TOWARD-LESSER - = -3.50 - END-COMPUTE - COMPUTE U ROUNDED MODE TOWARD-LESSER - = 3.510 - END-COMPUTE - COMPUTE V ROUNDED MODE TOWARD-LESSER - = -3.510 - END-COMPUTE - DISPLAY M " " N " " O " " P " " Q " " R " " S " " T - " " U " " V - NO ADVANCING - END-DISPLAY - STOP RUN. -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [+2 -3 +2 -3 +3 -4 +3 -4 +3 -4]) - -AT_CLEANUP - - -AT_SETUP([ROUNDED TRUNCATION]) -AT_KEYWORDS([fundamental compute]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 M PIC S9. - 01 N PIC S9. - 01 O PIC S9. - 01 P PIC S9. - 01 Q PIC S9. - 01 R PIC S9. - 01 S PIC S9. - 01 T PIC S9. - 01 U PIC S9. - 01 V PIC S9. - PROCEDURE DIVISION. - COMPUTE M ROUNDED MODE TRUNCATION - = 2.49 - END-COMPUTE - COMPUTE N ROUNDED MODE TRUNCATION - = -2.49 - END-COMPUTE - COMPUTE O ROUNDED MODE TRUNCATION - = 2.50 - END-COMPUTE - COMPUTE P ROUNDED MODE TRUNCATION - = -2.50 - END-COMPUTE - COMPUTE Q ROUNDED MODE TRUNCATION - = 3.49 - END-COMPUTE - COMPUTE R ROUNDED MODE TRUNCATION - = -3.49 - END-COMPUTE - COMPUTE S ROUNDED MODE TRUNCATION - = 3.50 - END-COMPUTE - COMPUTE T ROUNDED MODE TRUNCATION - = -3.50 - END-COMPUTE - COMPUTE U ROUNDED MODE TRUNCATION - = 3.510 - END-COMPUTE - COMPUTE V ROUNDED MODE TRUNCATION - = -3.510 - END-COMPUTE - DISPLAY M " " N " " O " " P " " Q " " R " " S " " T - " " U " " V - NO ADVANCING - END-DISPLAY - STOP RUN. -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [+2 -2 +2 -2 +3 -3 +3 -3 +3 -3]) - -AT_CLEANUP - - -AT_SETUP([Numeric operations (1)]) -AT_KEYWORDS([fundamental add subtract]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 X PIC S9V9. - 01 Y PIC S9V9 COMP-3. - PROCEDURE DIVISION. - MOVE -0.1 TO X. - ADD 1 TO X. - IF X NOT = 0.9 - DISPLAY X - END-DISPLAY - END-IF. - MOVE 0.1 TO X. - SUBTRACT 1 FROM X. - IF X NOT = -0.9 - DISPLAY X - END-DISPLAY - END-IF. - MOVE -0.1 TO Y. - ADD 1 TO Y. - IF Y NOT = 0.9 - DISPLAY Y - END-DISPLAY - END-IF. - MOVE 0.1 TO Y. - SUBTRACT 1 FROM Y. - IF Y NOT = -0.9 - DISPLAY Y - END-DISPLAY - END-IF. - STOP RUN. -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [], []) - -AT_CLEANUP - - -AT_SETUP([Numeric operations (2)]) -AT_KEYWORDS([fundamental add subtract]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 FIELD PIC S9(1)V9(1). - 01 FELD2 PIC S9(5)V9(5). - 01 FELD3 PIC 9(1)V9(1). - 01 FELD4 PIC S9(1). - PROCEDURE DIVISION. - MOVE 0.2 TO FIELD - ADD 1 TO FIELD - IF FIELD NOT = 1.2 - DISPLAY "Test 1 " FIELD - END-DISPLAY - END-IF. - - MOVE 0.2 TO FIELD - ADD -1 TO FIELD - IF FIELD NOT = -0.8 - DISPLAY "Test 2 " FIELD - END-DISPLAY - END-IF. - - MOVE -0.2 TO FIELD - ADD 1 TO FIELD - IF FIELD NOT = 0.8 - DISPLAY "Test 3 " FIELD - END-DISPLAY - END-IF. - - MOVE -0.2 TO FIELD - ADD -1 TO FIELD - IF FIELD NOT = -1.2 - DISPLAY "Test 4 " FIELD - END-DISPLAY - END-IF. - - MOVE 0.2 TO FIELD - SUBTRACT 1 FROM FIELD - IF FIELD NOT = -0.8 - DISPLAY "Test 5 " FIELD - END-DISPLAY - END-IF. - - MOVE 0.2 TO FIELD - SUBTRACT -1 FROM FIELD - IF FIELD NOT = 1.2 - DISPLAY "Test 6 " FIELD - END-DISPLAY - END-IF. - - MOVE -0.2 TO FIELD - SUBTRACT 1 FROM FIELD - IF FIELD NOT = -1.2 - DISPLAY "Test 7 " FIELD - END-DISPLAY - END-IF. - - MOVE -0.2 TO FIELD - SUBTRACT -1 FROM FIELD - IF FIELD NOT = 0.8 - DISPLAY "Test 8 " FIELD - END-DISPLAY - END-IF. - - MOVE 0.2 TO FELD2 - ADD 1 TO FELD2 - IF FELD2 NOT = 1.2 - DISPLAY "Test 9 " FELD2 - END-DISPLAY - END-IF. - - MOVE 0.2 TO FELD2 - ADD -1 TO FELD2 - IF FELD2 NOT = -0.8 - DISPLAY "Test 10 " FELD2 - END-DISPLAY - END-IF. - - MOVE -0.2 TO FELD2 - ADD 1 TO FELD2 - IF FELD2 NOT = 0.8 - DISPLAY "Test 11 " FELD2 - END-DISPLAY - END-IF. - - MOVE -0.2 TO FELD2 - ADD -1 TO FELD2 - IF FELD2 NOT = -1.2 - DISPLAY "Test 12 " FELD2 - END-DISPLAY - END-IF. - - MOVE 0.2 TO FELD2 - SUBTRACT 1 FROM FELD2 - IF FELD2 NOT = -0.8 - DISPLAY "Test 13 " FELD2 - END-DISPLAY - END-IF. - - MOVE 0.2 TO FELD2 - SUBTRACT -1 FROM FELD2 - IF FELD2 NOT = 1.2 - DISPLAY "Test 14 " FELD2 - END-DISPLAY - END-IF. - - MOVE -0.2 TO FELD2 - SUBTRACT 1 FROM FELD2 - IF FELD2 NOT = -1.2 - DISPLAY "Test 15 " FELD2 - END-DISPLAY - END-IF. - - MOVE -0.2 TO FELD2 - SUBTRACT -1 FROM FELD2 - IF FELD2 NOT = 0.8 - DISPLAY "Test 16 " FELD2 - END-DISPLAY - END-IF. - - MOVE 0.2 TO FELD3 - ADD 1 TO FELD3 - IF FELD3 NOT = 1.2 - DISPLAY "Test 17 " FELD3 - END-DISPLAY - END-IF. - - MOVE 0.2 TO FELD3 - ADD -1 TO FELD3 - IF FELD3 NOT = 0.8 - DISPLAY "Test 18 " FELD3 - END-DISPLAY - END-IF. - - MOVE -0.2 TO FELD3 - ADD 1 TO FELD3 - IF FELD3 NOT = 1.2 - DISPLAY "Test 19 " FELD3 - END-DISPLAY - END-IF. - - MOVE -0.2 TO FELD3 - ADD -1 TO FELD3 - IF FELD3 NOT = 0.8 - DISPLAY "Test 20 " FELD3 - END-DISPLAY - END-IF. - - MOVE 0.2 TO FELD3 - SUBTRACT 1 FROM FELD3 - IF FELD3 NOT = 0.8 - DISPLAY "Test 21 " FELD3 - END-DISPLAY - END-IF. - - MOVE 0.2 TO FELD3 - SUBTRACT -1 FROM FELD3 - IF FELD3 NOT = 1.2 - DISPLAY "Test 22 " FELD3 - END-DISPLAY - END-IF. - - MOVE -0.2 TO FELD3 - SUBTRACT 1 FROM FELD3 - IF FELD3 NOT = 0.8 - DISPLAY "Test 23 " FELD3 - END-DISPLAY - END-IF. - - MOVE -0.2 TO FELD3 - SUBTRACT -1 FROM FELD3 - IF FELD3 NOT = 1.2 - DISPLAY "Test 24 " FELD3 - END-DISPLAY - END-IF. - - MOVE 2 TO FELD4 - ADD 1 TO FELD4 - IF FELD4 NOT = 3 - DISPLAY "Test 25 " FELD4 - END-DISPLAY - END-IF. - - MOVE 2 TO FELD4 - ADD -1 TO FELD4 - IF FELD4 NOT = 1 - DISPLAY "Test 26 " FELD4 - END-DISPLAY - END-IF. - - MOVE -2 TO FELD4 - ADD 1 TO FELD4 - IF FELD4 NOT = -1 - DISPLAY "Test 27 " FELD4 - END-DISPLAY - END-IF. - - MOVE -2 TO FELD4 - ADD -1 TO FELD4 - IF FELD4 NOT = -3 - DISPLAY "Test 28 " FELD4 - END-DISPLAY - END-IF. - - MOVE 2 TO FELD4 - SUBTRACT 1 FROM FELD4 - IF FELD4 NOT = 1 - DISPLAY "Test 29 " FELD4 - END-DISPLAY - END-IF. - - MOVE 2 TO FELD4 - SUBTRACT -1 FROM FELD4 - IF FELD4 NOT = 3 - DISPLAY "Test 30 " FELD4 - END-DISPLAY - END-IF. - - MOVE -2 TO FELD4 - SUBTRACT 1 FROM FELD4 - IF FELD4 NOT = -3 - DISPLAY "Test 31 " FELD4 - END-DISPLAY - END-IF. - - MOVE -2 TO FELD4 - SUBTRACT -1 FROM FELD4 - IF FELD4 NOT = -1 - DISPLAY "Test 32 " FELD4 - END-DISPLAY - END-IF. - - MOVE 1 TO FELD4 - ADD 2 TO FELD4 - IF FELD4 NOT = 3 - DISPLAY "Test 33 " FELD4 - END-DISPLAY - END-IF. - - MOVE 1 TO FELD4 - ADD -2 TO FELD4 - IF FELD4 NOT = -1 - DISPLAY "Test 34 " FELD4 - END-DISPLAY - END-IF. - - MOVE -1 TO FELD4 - ADD 2 TO FELD4 - IF FELD4 NOT = 1 - DISPLAY "Test 35 " FELD4 - END-DISPLAY - END-IF. - - MOVE -1 TO FELD4 - ADD -2 TO FELD4 - IF FELD4 NOT = -3 - DISPLAY "Test 36 " FELD4 - END-DISPLAY - END-IF. - - MOVE 1 TO FELD4 - SUBTRACT 2 FROM FELD4 - IF FELD4 NOT = -1 - DISPLAY "Test 37 " FELD4 - END-DISPLAY - END-IF. - - MOVE 1 TO FELD4 - SUBTRACT -2 FROM FELD4 - IF FELD4 NOT = 3 - DISPLAY "Test 38 " FELD4 - END-DISPLAY - END-IF. - - MOVE -1 TO FELD4 - SUBTRACT 2 FROM FELD4 - IF FELD4 NOT = -3 - DISPLAY "Test 39 " FELD4 - END-DISPLAY - END-IF. - - MOVE -1 TO FELD4 - SUBTRACT -2 FROM FELD4 - IF FELD4 NOT = 1 - DISPLAY "Test 40 " FELD4 - END-DISPLAY - END-IF. - GOBACK. -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], -[prog.cob:137: warning: ignoring sign -prog.cob:144: warning: ignoring sign -prog.cob:165: warning: ignoring sign -prog.cob:172: warning: ignoring sign -]) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [], []) - -AT_CLEANUP - - -AT_SETUP([Numeric operations (3)]) -AT_KEYWORDS([fundamental add subtract]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 FIELD PIC S9(1)V9(1) COMP-3. - 01 FELD2 PIC S9(5)V9(5) COMP-3. - 01 FELD3 PIC 9(1)V9(1) COMP-3. - 01 FELD4 PIC S9(1) COMP-3. - PROCEDURE DIVISION. - MOVE 0.2 TO FIELD - ADD 1 TO FIELD - IF FIELD NOT = 1.2 - DISPLAY "Test 1 " FIELD - END-DISPLAY - END-IF. - - MOVE 0.2 TO FIELD - ADD -1 TO FIELD - IF FIELD NOT = -0.8 - DISPLAY "Test 2 " FIELD - END-DISPLAY - END-IF. - - MOVE -0.2 TO FIELD - ADD 1 TO FIELD - IF FIELD NOT = 0.8 - DISPLAY "Test 3 " FIELD - END-DISPLAY - END-IF. - - MOVE -0.2 TO FIELD - ADD -1 TO FIELD - IF FIELD NOT = -1.2 - DISPLAY "Test 4 " FIELD - END-DISPLAY - END-IF. - - MOVE 0.2 TO FIELD - SUBTRACT 1 FROM FIELD - IF FIELD NOT = -0.8 - DISPLAY "Test 5 " FIELD - END-DISPLAY - END-IF. - - MOVE 0.2 TO FIELD - SUBTRACT -1 FROM FIELD - IF FIELD NOT = 1.2 - DISPLAY "Test 6 " FIELD - END-DISPLAY - END-IF. - - MOVE -0.2 TO FIELD - SUBTRACT 1 FROM FIELD - IF FIELD NOT = -1.2 - DISPLAY "Test 7 " FIELD - END-DISPLAY - END-IF. - - MOVE -0.2 TO FIELD - SUBTRACT -1 FROM FIELD - IF FIELD NOT = 0.8 - DISPLAY "Test 8 " FIELD - END-DISPLAY - END-IF. - - MOVE 0.2 TO FELD2 - ADD 1 TO FELD2 - IF FELD2 NOT = 1.2 - DISPLAY "Test 9 " FELD2 - END-DISPLAY - END-IF. - - MOVE 0.2 TO FELD2 - ADD -1 TO FELD2 - IF FELD2 NOT = -0.8 - DISPLAY "Test 10 " FELD2 - END-DISPLAY - END-IF. - - MOVE -0.2 TO FELD2 - ADD 1 TO FELD2 - IF FELD2 NOT = 0.8 - DISPLAY "Test 11 " FELD2 - END-DISPLAY - END-IF. - - MOVE -0.2 TO FELD2 - ADD -1 TO FELD2 - IF FELD2 NOT = -1.2 - DISPLAY "Test 12 " FELD2 - END-DISPLAY - END-IF. - - MOVE 0.2 TO FELD2 - SUBTRACT 1 FROM FELD2 - IF FELD2 NOT = -0.8 - DISPLAY "Test 13 " FELD2 - END-DISPLAY - END-IF. - - MOVE 0.2 TO FELD2 - SUBTRACT -1 FROM FELD2 - IF FELD2 NOT = 1.2 - DISPLAY "Test 14 " FELD2 - END-DISPLAY - END-IF. - - MOVE -0.2 TO FELD2 - SUBTRACT 1 FROM FELD2 - IF FELD2 NOT = -1.2 - DISPLAY "Test 15 " FELD2 - END-DISPLAY - END-IF. - - MOVE -0.2 TO FELD2 - SUBTRACT -1 FROM FELD2 - IF FELD2 NOT = 0.8 - DISPLAY "Test 16 " FELD2 - END-DISPLAY - END-IF. - - MOVE 0.2 TO FELD3 - ADD 1 TO FELD3 - IF FELD3 NOT = 1.2 - DISPLAY "Test 17 " FELD3 - END-DISPLAY - END-IF. - - MOVE 0.2 TO FELD3 - ADD -1 TO FELD3 - IF FELD3 NOT = 0.8 - DISPLAY "Test 18 " FELD3 - END-DISPLAY - END-IF. - - MOVE -0.2 TO FELD3 - ADD 1 TO FELD3 - IF FELD3 NOT = 1.2 - DISPLAY "Test 19 " FELD3 - END-DISPLAY - END-IF. - - MOVE -0.2 TO FELD3 - ADD -1 TO FELD3 - IF FELD3 NOT = 0.8 - DISPLAY "Test 20 " FELD3 - END-DISPLAY - END-IF. - - MOVE 0.2 TO FELD3 - SUBTRACT 1 FROM FELD3 - IF FELD3 NOT = 0.8 - DISPLAY "Test 21 " FELD3 - END-DISPLAY - END-IF. - - MOVE 0.2 TO FELD3 - SUBTRACT -1 FROM FELD3 - IF FELD3 NOT = 1.2 - DISPLAY "Test 22 " FELD3 - END-DISPLAY - END-IF. - - MOVE -0.2 TO FELD3 - SUBTRACT 1 FROM FELD3 - IF FELD3 NOT = 0.8 - DISPLAY "Test 23 " FELD3 - END-DISPLAY - END-IF. - - MOVE -0.2 TO FELD3 - SUBTRACT -1 FROM FELD3 - IF FELD3 NOT = 1.2 - DISPLAY "Test 24 " FELD3 - END-DISPLAY - END-IF. - - MOVE 2 TO FELD4 - ADD 1 TO FELD4 - IF FELD4 NOT = 3 - DISPLAY "Test 25 " FELD4 - END-DISPLAY - END-IF. - - MOVE 2 TO FELD4 - ADD -1 TO FELD4 - IF FELD4 NOT = 1 - DISPLAY "Test 26 " FELD4 - END-DISPLAY - END-IF. - - MOVE -2 TO FELD4 - ADD 1 TO FELD4 - IF FELD4 NOT = -1 - DISPLAY "Test 27 " FELD4 - END-DISPLAY - END-IF. - - MOVE -2 TO FELD4 - ADD -1 TO FELD4 - IF FELD4 NOT = -3 - DISPLAY "Test 28 " FELD4 - END-DISPLAY - END-IF. - - MOVE 2 TO FELD4 - SUBTRACT 1 FROM FELD4 - IF FELD4 NOT = 1 - DISPLAY "Test 29 " FELD4 - END-DISPLAY - END-IF. - - MOVE 2 TO FELD4 - SUBTRACT -1 FROM FELD4 - IF FELD4 NOT = 3 - DISPLAY "Test 30 " FELD4 - END-DISPLAY - END-IF. - - MOVE -2 TO FELD4 - SUBTRACT 1 FROM FELD4 - IF FELD4 NOT = -3 - DISPLAY "Test 31 " FELD4 - END-DISPLAY - END-IF. - - MOVE -2 TO FELD4 - SUBTRACT -1 FROM FELD4 - IF FELD4 NOT = -1 - DISPLAY "Test 32 " FELD4 - END-DISPLAY - END-IF. - - MOVE 1 TO FELD4 - ADD 2 TO FELD4 - IF FELD4 NOT = 3 - DISPLAY "Test 33 " FELD4 - END-DISPLAY - END-IF. - - MOVE 1 TO FELD4 - ADD -2 TO FELD4 - IF FELD4 NOT = -1 - DISPLAY "Test 34 " FELD4 - END-DISPLAY - END-IF. - - MOVE -1 TO FELD4 - ADD 2 TO FELD4 - IF FELD4 NOT = 1 - DISPLAY "Test 35 " FELD4 - END-DISPLAY - END-IF. - - MOVE -1 TO FELD4 - ADD -2 TO FELD4 - IF FELD4 NOT = -3 - DISPLAY "Test 36 " FELD4 - END-DISPLAY - END-IF. - - MOVE 1 TO FELD4 - SUBTRACT 2 FROM FELD4 - IF FELD4 NOT = -1 - DISPLAY "Test 37 " FELD4 - END-DISPLAY - END-IF. - - MOVE 1 TO FELD4 - SUBTRACT -2 FROM FELD4 - IF FELD4 NOT = 3 - DISPLAY "Test 38 " FELD4 - END-DISPLAY - END-IF. - - MOVE -1 TO FELD4 - SUBTRACT 2 FROM FELD4 - IF FELD4 NOT = -3 - DISPLAY "Test 39 " FELD4 - END-DISPLAY - END-IF. - - MOVE -1 TO FELD4 - SUBTRACT -2 FROM FELD4 - IF FELD4 NOT = 1 - DISPLAY "Test 40 " FELD4 - END-DISPLAY - END-IF. - GOBACK. -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], -[prog.cob:137: warning: ignoring sign -prog.cob:144: warning: ignoring sign -prog.cob:165: warning: ignoring sign -prog.cob:172: warning: ignoring sign -]) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [], []) - -AT_CLEANUP - - -AT_SETUP([Numeric operations (4)]) -AT_KEYWORDS([fundamental add subtract]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 FIELD PIC S9(1)V9(1) COMP. - 01 FELD2 PIC S9(5)V9(5) COMP. - 01 FELD3 PIC 9(1)V9(1) COMP. - 01 FELD4 PIC S9(1) COMP. - PROCEDURE DIVISION. - MOVE 0.2 TO FIELD - ADD 1 TO FIELD - IF FIELD NOT = 1.2 - DISPLAY "Test 1 " FIELD - END-DISPLAY - END-IF. - - MOVE 0.2 TO FIELD - ADD -1 TO FIELD - IF FIELD NOT = -0.8 - DISPLAY "Test 2 " FIELD - END-DISPLAY - END-IF. - - MOVE -0.2 TO FIELD - ADD 1 TO FIELD - IF FIELD NOT = 0.8 - DISPLAY "Test 3 " FIELD - END-DISPLAY - END-IF. - - MOVE -0.2 TO FIELD - ADD -1 TO FIELD - IF FIELD NOT = -1.2 - DISPLAY "Test 4 " FIELD - END-DISPLAY - END-IF. - - MOVE 0.2 TO FIELD - SUBTRACT 1 FROM FIELD - IF FIELD NOT = -0.8 - DISPLAY "Test 5 " FIELD - END-DISPLAY - END-IF. - - MOVE 0.2 TO FIELD - SUBTRACT -1 FROM FIELD - IF FIELD NOT = 1.2 - DISPLAY "Test 6 " FIELD - END-DISPLAY - END-IF. - - MOVE -0.2 TO FIELD - SUBTRACT 1 FROM FIELD - IF FIELD NOT = -1.2 - DISPLAY "Test 7 " FIELD - END-DISPLAY - END-IF. - - MOVE -0.2 TO FIELD - SUBTRACT -1 FROM FIELD - IF FIELD NOT = 0.8 - DISPLAY "Test 8 " FIELD - END-DISPLAY - END-IF. - - MOVE 0.2 TO FELD2 - ADD 1 TO FELD2 - IF FELD2 NOT = 1.2 - DISPLAY "Test 9 " FELD2 - END-DISPLAY - END-IF. - - MOVE 0.2 TO FELD2 - ADD -1 TO FELD2 - IF FELD2 NOT = -0.8 - DISPLAY "Test 10 " FELD2 - END-DISPLAY - END-IF. - - MOVE -0.2 TO FELD2 - ADD 1 TO FELD2 - IF FELD2 NOT = 0.8 - DISPLAY "Test 11 " FELD2 - END-DISPLAY - END-IF. - - MOVE -0.2 TO FELD2 - ADD -1 TO FELD2 - IF FELD2 NOT = -1.2 - DISPLAY "Test 12 " FELD2 - END-DISPLAY - END-IF. - - MOVE 0.2 TO FELD2 - SUBTRACT 1 FROM FELD2 - IF FELD2 NOT = -0.8 - DISPLAY "Test 13 " FELD2 - END-DISPLAY - END-IF. - - MOVE 0.2 TO FELD2 - SUBTRACT -1 FROM FELD2 - IF FELD2 NOT = 1.2 - DISPLAY "Test 14 " FELD2 - END-DISPLAY - END-IF. - - MOVE -0.2 TO FELD2 - SUBTRACT 1 FROM FELD2 - IF FELD2 NOT = -1.2 - DISPLAY "Test 15 " FELD2 - END-DISPLAY - END-IF. - - MOVE -0.2 TO FELD2 - SUBTRACT -1 FROM FELD2 - IF FELD2 NOT = 0.8 - DISPLAY "Test 16 " FELD2 - END-DISPLAY - END-IF. - - MOVE 0.2 TO FELD3 - ADD 1 TO FELD3 - IF FELD3 NOT = 1.2 - DISPLAY "Test 17 " FELD3 - END-DISPLAY - END-IF. - - MOVE 0.2 TO FELD3 - ADD -1 TO FELD3 - IF FELD3 NOT = 0.8 - DISPLAY "Test 18 " FELD3 - END-DISPLAY - END-IF. - - MOVE -0.2 TO FELD3 - ADD 1 TO FELD3 - IF FELD3 NOT = 1.2 - DISPLAY "Test 19 " FELD3 - END-DISPLAY - END-IF. - - MOVE -0.2 TO FELD3 - ADD -1 TO FELD3 - IF FELD3 NOT = 0.8 - DISPLAY "Test 20 " FELD3 - END-DISPLAY - END-IF. - - MOVE 0.2 TO FELD3 - SUBTRACT 1 FROM FELD3 - IF FELD3 NOT = 0.8 - DISPLAY "Test 21 " FELD3 - END-DISPLAY - END-IF. - - MOVE 0.2 TO FELD3 - SUBTRACT -1 FROM FELD3 - IF FELD3 NOT = 1.2 - DISPLAY "Test 22 " FELD3 - END-DISPLAY - END-IF. - - MOVE -0.2 TO FELD3 - SUBTRACT 1 FROM FELD3 - IF FELD3 NOT = 0.8 - DISPLAY "Test 23 " FELD3 - END-DISPLAY - END-IF. - - MOVE -0.2 TO FELD3 - SUBTRACT -1 FROM FELD3 - IF FELD3 NOT = 1.2 - DISPLAY "Test 24 " FELD3 - END-DISPLAY - END-IF. - - MOVE 2 TO FELD4 - ADD 1 TO FELD4 - IF FELD4 NOT = 3 - DISPLAY "Test 25 " FELD4 - END-DISPLAY - END-IF. - - MOVE 2 TO FELD4 - ADD -1 TO FELD4 - IF FELD4 NOT = 1 - DISPLAY "Test 26 " FELD4 - END-DISPLAY - END-IF. - - MOVE -2 TO FELD4 - ADD 1 TO FELD4 - IF FELD4 NOT = -1 - DISPLAY "Test 27 " FELD4 - END-DISPLAY - END-IF. - - MOVE -2 TO FELD4 - ADD -1 TO FELD4 - IF FELD4 NOT = -3 - DISPLAY "Test 28 " FELD4 - END-DISPLAY - END-IF. - - MOVE 2 TO FELD4 - SUBTRACT 1 FROM FELD4 - IF FELD4 NOT = 1 - DISPLAY "Test 29 " FELD4 - END-DISPLAY - END-IF. - - MOVE 2 TO FELD4 - SUBTRACT -1 FROM FELD4 - IF FELD4 NOT = 3 - DISPLAY "Test 30 " FELD4 - END-DISPLAY - END-IF. - - MOVE -2 TO FELD4 - SUBTRACT 1 FROM FELD4 - IF FELD4 NOT = -3 - DISPLAY "Test 31 " FELD4 - END-DISPLAY - END-IF. - - MOVE -2 TO FELD4 - SUBTRACT -1 FROM FELD4 - IF FELD4 NOT = -1 - DISPLAY "Test 32 " FELD4 - END-DISPLAY - END-IF. - - MOVE 1 TO FELD4 - ADD 2 TO FELD4 - IF FELD4 NOT = 3 - DISPLAY "Test 33 " FELD4 - END-DISPLAY - END-IF. - - MOVE 1 TO FELD4 - ADD -2 TO FELD4 - IF FELD4 NOT = -1 - DISPLAY "Test 34 " FELD4 - END-DISPLAY - END-IF. - - MOVE -1 TO FELD4 - ADD 2 TO FELD4 - IF FELD4 NOT = 1 - DISPLAY "Test 35 " FELD4 - END-DISPLAY - END-IF. - - MOVE -1 TO FELD4 - ADD -2 TO FELD4 - IF FELD4 NOT = -3 - DISPLAY "Test 36 " FELD4 - END-DISPLAY - END-IF. - - MOVE 1 TO FELD4 - SUBTRACT 2 FROM FELD4 - IF FELD4 NOT = -1 - DISPLAY "Test 37 " FELD4 - END-DISPLAY - END-IF. - - MOVE 1 TO FELD4 - SUBTRACT -2 FROM FELD4 - IF FELD4 NOT = 3 - DISPLAY "Test 38 " FELD4 - END-DISPLAY - END-IF. - - MOVE -1 TO FELD4 - SUBTRACT 2 FROM FELD4 - IF FELD4 NOT = -3 - DISPLAY "Test 39 " FELD4 - END-DISPLAY - END-IF. - - MOVE -1 TO FELD4 - SUBTRACT -2 FROM FELD4 - IF FELD4 NOT = 1 - DISPLAY "Test 40 " FELD4 - END-DISPLAY - END-IF. - GOBACK. -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], -[prog.cob:137: warning: ignoring sign -prog.cob:144: warning: ignoring sign -prog.cob:165: warning: ignoring sign -prog.cob:172: warning: ignoring sign -]) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [], []) - -AT_CLEANUP - - -AT_SETUP([Numeric operations (5)]) -AT_KEYWORDS([fundamental add subtract]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 FIELD PIC S9(1)V9(1) COMP-5. - 01 FELD2 PIC S9(5)V9(5) COMP-5. - 01 FELD3 PIC 9(1)V9(1) COMP-5. - 01 FELD4 PIC S9(1) COMP-5. - PROCEDURE DIVISION. - MOVE 0.2 TO FIELD - ADD 1 TO FIELD - IF FIELD NOT = 1.2 - DISPLAY "Test 1 " FIELD - END-DISPLAY - END-IF. - - MOVE 0.2 TO FIELD - ADD -1 TO FIELD - IF FIELD NOT = -0.8 - DISPLAY "Test 2 " FIELD - END-DISPLAY - END-IF. - - MOVE -0.2 TO FIELD - ADD 1 TO FIELD - IF FIELD NOT = 0.8 - DISPLAY "Test 3 " FIELD - END-DISPLAY - END-IF. - - MOVE -0.2 TO FIELD - ADD -1 TO FIELD - IF FIELD NOT = -1.2 - DISPLAY "Test 4 " FIELD - END-DISPLAY - END-IF. - - MOVE 0.2 TO FIELD - SUBTRACT 1 FROM FIELD - IF FIELD NOT = -0.8 - DISPLAY "Test 5 " FIELD - END-DISPLAY - END-IF. - - MOVE 0.2 TO FIELD - SUBTRACT -1 FROM FIELD - IF FIELD NOT = 1.2 - DISPLAY "Test 6 " FIELD - END-DISPLAY - END-IF. - - MOVE -0.2 TO FIELD - SUBTRACT 1 FROM FIELD - IF FIELD NOT = -1.2 - DISPLAY "Test 7 " FIELD - END-DISPLAY - END-IF. - - MOVE -0.2 TO FIELD - SUBTRACT -1 FROM FIELD - IF FIELD NOT = 0.8 - DISPLAY "Test 8 " FIELD - END-DISPLAY - END-IF. - - MOVE 0.2 TO FELD2 - ADD 1 TO FELD2 - IF FELD2 NOT = 1.2 - DISPLAY "Test 9 " FELD2 - END-DISPLAY - END-IF. - - MOVE 0.2 TO FELD2 - ADD -1 TO FELD2 - IF FELD2 NOT = -0.8 - DISPLAY "Test 10 " FELD2 - END-DISPLAY - END-IF. - - MOVE -0.2 TO FELD2 - ADD 1 TO FELD2 - IF FELD2 NOT = 0.8 - DISPLAY "Test 11 " FELD2 - END-DISPLAY - END-IF. - - MOVE -0.2 TO FELD2 - ADD -1 TO FELD2 - IF FELD2 NOT = -1.2 - DISPLAY "Test 12 " FELD2 - END-DISPLAY - END-IF. - - MOVE 0.2 TO FELD2 - SUBTRACT 1 FROM FELD2 - IF FELD2 NOT = -0.8 - DISPLAY "Test 13 " FELD2 - END-DISPLAY - END-IF. - - MOVE 0.2 TO FELD2 - SUBTRACT -1 FROM FELD2 - IF FELD2 NOT = 1.2 - DISPLAY "Test 14 " FELD2 - END-DISPLAY - END-IF. - - MOVE -0.2 TO FELD2 - SUBTRACT 1 FROM FELD2 - IF FELD2 NOT = -1.2 - DISPLAY "Test 15 " FELD2 - END-DISPLAY - END-IF. - - MOVE -0.2 TO FELD2 - SUBTRACT -1 FROM FELD2 - IF FELD2 NOT = 0.8 - DISPLAY "Test 16 " FELD2 - END-DISPLAY - END-IF. - - MOVE 0.2 TO FELD3 - ADD 1 TO FELD3 - IF FELD3 NOT = 1.2 - DISPLAY "Test 17 " FELD3 - END-DISPLAY - END-IF. - - MOVE 0.2 TO FELD3 - ADD -1 TO FELD3 - IF FELD3 NOT = 0.8 - DISPLAY "Test 18 " FELD3 - END-DISPLAY - END-IF. - - MOVE -0.2 TO FELD3 - ADD 1 TO FELD3 - IF FELD3 NOT = 1.2 - DISPLAY "Test 19 " FELD3 - END-DISPLAY - END-IF. - - MOVE -0.2 TO FELD3 - ADD -1 TO FELD3 - IF FELD3 NOT = 0.8 - DISPLAY "Test 20 " FELD3 - END-DISPLAY - END-IF. - - MOVE 0.2 TO FELD3 - SUBTRACT 1 FROM FELD3 - IF FELD3 NOT = 0.8 - DISPLAY "Test 21 " FELD3 - END-DISPLAY - END-IF. - - MOVE 0.2 TO FELD3 - SUBTRACT -1 FROM FELD3 - IF FELD3 NOT = 1.2 - DISPLAY "Test 22 " FELD3 - END-DISPLAY - END-IF. - - MOVE -0.2 TO FELD3 - SUBTRACT 1 FROM FELD3 - IF FELD3 NOT = 0.8 - DISPLAY "Test 23 " FELD3 - END-DISPLAY - END-IF. - - MOVE -0.2 TO FELD3 - SUBTRACT -1 FROM FELD3 - IF FELD3 NOT = 1.2 - DISPLAY "Test 24 " FELD3 - END-DISPLAY - END-IF. - - MOVE 2 TO FELD4 - ADD 1 TO FELD4 - IF FELD4 NOT = 3 - DISPLAY "Test 25 " FELD4 - END-DISPLAY - END-IF. - - MOVE 2 TO FELD4 - ADD -1 TO FELD4 - IF FELD4 NOT = 1 - DISPLAY "Test 26 " FELD4 - END-DISPLAY - END-IF. - - MOVE -2 TO FELD4 - ADD 1 TO FELD4 - IF FELD4 NOT = -1 - DISPLAY "Test 27 " FELD4 - END-DISPLAY - END-IF. - - MOVE -2 TO FELD4 - ADD -1 TO FELD4 - IF FELD4 NOT = -3 - DISPLAY "Test 28 " FELD4 - END-DISPLAY - END-IF. - - MOVE 2 TO FELD4 - SUBTRACT 1 FROM FELD4 - IF FELD4 NOT = 1 - DISPLAY "Test 29 " FELD4 - END-DISPLAY - END-IF. - - MOVE 2 TO FELD4 - SUBTRACT -1 FROM FELD4 - IF FELD4 NOT = 3 - DISPLAY "Test 30 " FELD4 - END-DISPLAY - END-IF. - - MOVE -2 TO FELD4 - SUBTRACT 1 FROM FELD4 - IF FELD4 NOT = -3 - DISPLAY "Test 31 " FELD4 - END-DISPLAY - END-IF. - - MOVE -2 TO FELD4 - SUBTRACT -1 FROM FELD4 - IF FELD4 NOT = -1 - DISPLAY "Test 32 " FELD4 - END-DISPLAY - END-IF. - - MOVE 1 TO FELD4 - ADD 2 TO FELD4 - IF FELD4 NOT = 3 - DISPLAY "Test 33 " FELD4 - END-DISPLAY - END-IF. - - MOVE 1 TO FELD4 - ADD -2 TO FELD4 - IF FELD4 NOT = -1 - DISPLAY "Test 34 " FELD4 - END-DISPLAY - END-IF. - - MOVE -1 TO FELD4 - ADD 2 TO FELD4 - IF FELD4 NOT = 1 - DISPLAY "Test 35 " FELD4 - END-DISPLAY - END-IF. - - MOVE -1 TO FELD4 - ADD -2 TO FELD4 - IF FELD4 NOT = -3 - DISPLAY "Test 36 " FELD4 - END-DISPLAY - END-IF. - - MOVE 1 TO FELD4 - SUBTRACT 2 FROM FELD4 - IF FELD4 NOT = -1 - DISPLAY "Test 37 " FELD4 - END-DISPLAY - END-IF. - - MOVE 1 TO FELD4 - SUBTRACT -2 FROM FELD4 - IF FELD4 NOT = 3 - DISPLAY "Test 38 " FELD4 - END-DISPLAY - END-IF. - - MOVE -1 TO FELD4 - SUBTRACT 2 FROM FELD4 - IF FELD4 NOT = -3 - DISPLAY "Test 39 " FELD4 - END-DISPLAY - END-IF. - - MOVE -1 TO FELD4 - SUBTRACT -2 FROM FELD4 - IF FELD4 NOT = 1 - DISPLAY "Test 40 " FELD4 - END-DISPLAY - END-IF. - GOBACK. -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], -[prog.cob:137: warning: ignoring sign -prog.cob:144: warning: ignoring sign -prog.cob:165: warning: ignoring sign -prog.cob:172: warning: ignoring sign -]) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [], []) - -AT_CLEANUP - - -AT_SETUP([Numeric operations (6)]) -AT_KEYWORDS([fundamental add]) - -AT_DATA([dump.c], [ -#include -#include - -COB_EXT_EXPORT int -dump (char *p) -{ - printf ("%c%c", p[[0]], p[[1]]); - return 0; -} -]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - - DATA DIVISION. - WORKING-STORAGE SECTION. - - 01 P-FIELD1 PIC 99PPP. - 01 P-FIELD2 PIC PPP99. - - PROCEDURE DIVISION. - - MOVE 5000 TO P-FIELD1. - ADD 5 TO P-FIELD1 END-ADD - IF P-FIELD1 NOT = 5000 - DISPLAY "Error: Add 5 to PIC 99PPP." - END-DISPLAY - END-IF - CALL "dump" USING P-FIELD1 END-CALL - - ADD 5000 TO P-FIELD1 END-ADD - IF P-FIELD1 NOT = 10000 - DISPLAY "Error: Add 5000 to PIC 99PPP." - END-DISPLAY - END-IF - CALL "dump" USING P-FIELD1 END-CALL - - MOVE 0.00055 TO P-FIELD2. - ADD 0.00033 TO P-FIELD2 END-ADD - IF P-FIELD2 NOT = 0.00088 - DISPLAY "Error: Add 0.00033 to PIC PPP99." - END-DISPLAY - END-IF - CALL "dump" USING P-FIELD2 END-CALL - - MOVE 0.00055 TO P-FIELD2. - ADD 0.00300 TO P-FIELD2 END-ADD - IF P-FIELD2 NOT = 0.00055 - DISPLAY "Error: Add 0.00300 to PIC PPP99." - END-DISPLAY - END-IF - CALL "dump" USING P-FIELD2 END-CALL - - STOP RUN. - -]) - -AT_CHECK([$COMPILE_MODULE dump.c]) -AT_CHECK([$COMPILE prog.cob], [0], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [05108855], []) - -AT_CLEANUP - - -AT_SETUP([Numeric operations (7)]) -AT_KEYWORDS([fundamental add compute literal]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 FIELD PIC S9(4)V9(2) COMP-5. - 01 FIELD-DISP PIC S9(4)V9(2) DISPLAY. - PROCEDURE DIVISION. - MOVE 0.2 TO FIELD. - ADD 1 - 2 - 3 - 4 - 5 - 6 - 7 - 8 - 9 - 10 - 11 - 12 - 13 - 14 - 15 - 16 - 17 - 18 - 19 - 20 - 21 - 22 - 23 - 24 - 25 - 26 - 27 - 28 - 29 - 30 - 31 - 32 - 33 - 34 - 35 - 36 - 37 - 38 - 39 - 40 - 41 - 42 - 43 - 44 - 45 - 46 - 47 - 48 - 49 - 50 - 51 - 52 - 53 - 54 - 55 - 56 - 57 - 58 - 59 - 60 - 61 - 62 - 63 - 64 - 65 - 66 - 67 - 68 - 69 - 70 - 71 - 72 - 73 - 74 - 75 - 76 - 77 - 78 - 79 - 80 - 81 - 82 - 83 - 84 - 85 - 86 - 87 - 88 - 89 - 90 - 91 - 92 - 93 - 94 - 95 - 96 - 97 - 98 - 99 - 100 - 101 - 102 - 103 - 104 - 105 - 106 - 107 - 108 - 109 - 110 - 111 - 112 - 113 - 114 - 115 - 116 - 117 - 118 - 119 - 120 - 121 - 122 - 123 - 124 - 125 - 126 - 127 - 128 - 129 - TO FIELD - END-ADD. - IF FIELD NOT = 8385.2 - MOVE FIELD TO FIELD-DISP - DISPLAY 'ADD with wrong result: ' FIELD-DISP - END-DISPLAY - END-IF. - COMPUTE FIELD = (0.2 - + 2 - + 3 - + 4 - + 5 - + 6 - + 7 - + 8 - + 9 - + 10 - + 11 - + 12 - + 13 - + 14 - + 15 - + 16 - + 17 - + 18 - + 19 - + 20 - + 21 - + 22 - + 23 - + 24 - + 25 - + 26 - + 27 - + 28 - + 29 - + 30 - + 31 - + 32 - + 33 - + 34 - + 35 - + 36 - + 37 - + 38 - + 39 - + 40 - + 41 - + 42 - + 43 - + 44 - + 45 - + 46 - + 47 - + 48 - + 49 - + 50 - + 51 - + 52 - + 53 - + 54 - + 55 - + 56 - + 57 - + 58 - - 59 - - 60 - - 61 - - 62 - - 63 - - 64 - - 65 - - 66 - - 67 - - 68 - - 69 - - 70 - - 71 - - 72 - - 73 - - 74 - - 75 - - 76 - - 77 - - 78 - - 79 - - 80 - - 81 - - 82 - - 83 - - 84 - - 85 - - 86 - - 87 - - 88 - - 89 - - 90 - - 91 - - 92 - - 93 - - 94 - - 95 - - 96 - - 97 - - 98 - - 99 - - 100 - - 101 - - 102 - - 103 - - 104 - - 105 - - 106 - - 107 - - 108 - - 109 - - 110 - - 111 - - 112 - - 113 - - 114 - - 115 - - 116 - - 117 - - 118 - - 119 - - 120 - - 121 - - 122 - - 123 - - 124 - - 125 - - 126 - - 127) - * 12800000000 - / 12900000000 - END-COMPUTE. - IF FIELD NOT = -4670.31 - MOVE FIELD TO FIELD-DISP - DISPLAY 'COMPUTE with wrong result: ' FIELD-DISP - END-DISPLAY - END-IF. - GOBACK. -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [], []) - -AT_CLEANUP - - -AT_SETUP([Numeric operations (8)]) -AT_KEYWORDS([fundamental compute literal]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 1 COMPUTE-DATA. - 2 COMPUTE-8 PICTURE 999 VALUE ZERO. - PROCEDURE DIVISION. - COMPUTE COMPUTE-8 = (((24.0 + 1) * (60 - 10)) / 125) ** 2 - IF COMPUTE-8 NOT = 100 - DISPLAY 'COMPUTE with wrong result: ' COMPUTE-8 - END-DISPLAY - END-IF - COMPUTE COMPUTE-8 = 55 / (1 - 2 + 1) - NOT ON SIZE ERROR - DISPLAY 'SIZE ERROR not set from divide by zero!' - END-DISPLAY - END-COMPUTE - COMPUTE COMPUTE-8 = 0 ** 1 - IF COMPUTE-8 NOT = 0 - DISPLAY '0 ** 1 <> 0: ' COMPUTE-8 - END-DISPLAY - END-IF - COMPUTE COMPUTE-8 = 55 ** 0 - IF COMPUTE-8 NOT = 1 - DISPLAY '55 ** 0 <> 1: ' COMPUTE-8 - END-DISPLAY - END-IF - COMPUTE COMPUTE-8 = 1 ** 55 - IF COMPUTE-8 NOT = 1 - DISPLAY '11 ** 55 <> 1: ' COMPUTE-8 - END-DISPLAY - END-IF - - GOBACK. -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], -[prog.cob:14: warning: divide by constant ZERO -]) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [], []) - -AT_CLEANUP - - -# CORRESPONDING - -AT_SETUP([ADD CORRESPONDING]) -AT_KEYWORDS([fundamental corresponding]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 GROUP-1. - 05 FIELD-A PIC 9 VALUE 1. - 05 FIELD-B USAGE BINARY-CHAR VALUE 2. - 05 INNER-GROUP. - 10 FIELD-C USAGE FLOAT-SHORT VALUE 3. - 05 FIELD-D PIC X VALUE "A". - 01 GROUP-2. - 05 FIELD-A PIC 9. - 05 FIELD-B USAGE BINARY-LONG. - 05 INNER-GROUP. - 10 FIELD-C PIC 9. - 05 FIELD-D PIC 9. - - PROCEDURE DIVISION. - ADD CORRESPONDING GROUP-1 TO GROUP-2. - IF FIELD-A IN GROUP-2 NOT EQUAL 1 THEN - DISPLAY "BAD FIELD-A " FIELD-A IN GROUP-2 - END-DISPLAY - END-IF. - IF FIELD-B IN GROUP-2 NOT EQUAL 2 THEN - DISPLAY "BAD FIELD-B " FIELD-B IN GROUP-2 - END-DISPLAY - END-IF. - IF FIELD-C IN GROUP-2 NOT EQUAL 3 THEN - DISPLAY "BAD FIELD-C " FIELD-C IN GROUP-2 - END-DISPLAY - END-IF. - IF FIELD-D IN GROUP-2 NOT EQUAL 0 THEN - DISPLAY "BAD FIELD-D " FIELD-D IN GROUP-2 - END-DISPLAY - END-IF. - STOP RUN. -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [], []) - -AT_CLEANUP - - -AT_SETUP([ADD CORRESPONDING no match]) -AT_KEYWORDS([fundamental corresponding]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 GROUP-1. - 05 FIELD-A PIC X. - 05 FIELD-B PIC Z9. - 05 INNER-GROUP. - 10 FIELD-C PIC X. - 05 FIELD-D PIC 9. - 01 GROUP-2. - 05 FIELD-A PIC 9 VALUE 1. - 05 FIELD-B USAGE BINARY-CHAR VALUE 2. - 05 INNER-GROUP. - 10 FIELD-C USAGE FLOAT-SHORT VALUE 3. - 05 FIELD-D PIC X VALUE "A". - - PROCEDURE DIVISION. - SUBTRACT CORRESPONDING GROUP-2 FROM GROUP-1. - IF FIELD-A IN GROUP-2 NOT EQUAL 1 THEN - DISPLAY "BAD FIELD-A " FIELD-A IN GROUP-2 - END-DISPLAY - END-IF. - IF FIELD-B IN GROUP-2 NOT EQUAL 2 THEN - DISPLAY "BAD FIELD-B " FIELD-B IN GROUP-2 - END-DISPLAY - END-IF. - IF FIELD-C IN GROUP-2 NOT EQUAL 3 THEN - DISPLAY "BAD FIELD-C " FIELD-C IN GROUP-2 - END-DISPLAY - END-IF. - IF FIELD-D IN GROUP-2 NOT EQUAL "A" THEN - DISPLAY "BAD FIELD-D " FIELD-D IN GROUP-2 - END-DISPLAY - END-IF. - STOP RUN. -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], -[prog.cob:20: warning: no CORRESPONDING items found -]) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [], []) - -AT_CLEANUP - - -AT_SETUP([SYNC in OCCURS]) -AT_KEYWORDS([fundamental SYNCHRONIZE]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 x. - 03 ptrs OCCURS 5 TIMES. - 05 misalign-1 PIC X. - 05 ptr POINTER, SYNC. - 05 ptr-num REDEFINES ptr, - >>IF P64 SET - USAGE BINARY-DOUBLE UNSIGNED. - >>ELSE - USAGE BINARY-LONG UNSIGNED. - >>END-IF - 05 misalign-2 PIC X. - - 01 num BINARY-LONG. - - PROCEDURE DIVISION. - SET ptr (2) TO ADDRESS OF ptr (2) - SET ptr (3) TO ADDRESS OF ptr (3) - - SUBTRACT ptr-num (2) FROM ptr-num (3) GIVING num - DISPLAY FUNCTION MOD (num, FUNCTION LENGTH (ptr (1))) - . -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], -[000000000 -]) - -AT_CLEANUP - - -AT_SETUP([88 level with THRU]) -AT_KEYWORDS([runmisc]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 VAR-X PIC X VALUE SPACE. - 88 X VALUE "X". - 88 T-Y VALUE "T" THRU "Y". - 01 VAR-9 PIC 9 VALUE ZERO. - 88 V9 VALUE 9. - 88 V2-4 VALUE 2 THRU 4. - PROCEDURE DIVISION. - IF X - DISPLAY "NOT OK '" VAR-X "' IS X" - END-DISPLAY - END-IF - SET X TO TRUE - IF NOT X - DISPLAY "NOT OK '" VAR-X "' IS NOT X" - END-DISPLAY - END-IF - IF NOT T-Y - DISPLAY "NOT OK '" VAR-X "' IS NOT T-Y" - END-DISPLAY - END-IF - SET T-Y TO TRUE - IF NOT T-Y - DISPLAY "NOT OK '" VAR-X "' IS NOT T-Y" - END-DISPLAY - END-IF - MOVE 'Y' TO VAR-X - IF NOT T-Y - DISPLAY "NOT OK '" VAR-X "' IS NOT T-Y" - END-DISPLAY - END-IF - MOVE 'Z' TO VAR-X - IF T-Y - DISPLAY "NOT OK '" VAR-X "' IS T-Y" - END-DISPLAY - END-IF - MOVE 'A' TO VAR-X - IF T-Y - DISPLAY "NOT OK '" VAR-X "' IS T-Y" - END-DISPLAY - END-IF - IF V9 - DISPLAY "NOT OK '" VAR-9 "' IS V9" - END-DISPLAY - END-IF - SET V9 TO TRUE - IF NOT V9 - DISPLAY "NOT OK '" VAR-9 "' IS NOT V9" - END-DISPLAY - END-IF - SET V2-4 TO TRUE - IF V9 - DISPLAY "NOT OK '" VAR-9 "' IS V9" - END-DISPLAY - END-IF - IF NOT V2-4 - DISPLAY "NOT OK '" VAR-9 "' IS NOT V2-4" - END-DISPLAY - END-IF - MOVE 3 TO VAR-9 - IF NOT V2-4 - DISPLAY "NOT OK '" VAR-9 "' IS NOT V2-4" - END-DISPLAY - END-IF - MOVE 4 TO VAR-9 - IF NOT V2-4 - DISPLAY "NOT OK '" VAR-9 "' IS NOT V2-4" - END-DISPLAY - END-IF - MOVE 5 TO VAR-9 - IF V2-4 - DISPLAY "NOT OK '" VAR-9 "' IS V2-4" - END-DISPLAY - END-IF - MOVE 1 TO VAR-9 - IF V2-4 - DISPLAY "NOT OK '" VAR-9 "' IS V2-4" - END-DISPLAY - END-IF - STOP RUN. -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [], []) - -AT_CLEANUP - - -AT_SETUP([88 level with FILLER]) -AT_KEYWORDS([runmisc]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 FILLER PIC X VALUE SPACE. - 88 X VALUE "X". - PROCEDURE DIVISION. - IF X - DISPLAY "NOT OK" - END-DISPLAY - END-IF - SET X TO TRUE. - IF NOT X - DISPLAY "NOT OK" - END-DISPLAY - END-IF - STOP RUN. -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [], []) - -AT_CLEANUP - - -AT_SETUP([88 level with FALSE IS clause]) -AT_KEYWORDS([runmisc]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 MYFLD PIC X(6) VALUE "ABCDEF". - 88 MYFLD88 VALUE "ABCDEF" - FALSE IS "OKOKOK". - PROCEDURE DIVISION. - ASTART SECTION. - A01. - SET MYFLD88 TO FALSE - IF MYFLD NOT = "OKOKOK" - DISPLAY MYFLD - END-DISPLAY - END-IF - STOP RUN. -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [], []) - -AT_CLEANUP - - -AT_SETUP([BLANK WHEN ZERO]) -AT_KEYWORDS([fundamental]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 x PIC 9, BLANK WHEN ZERO, VALUE 1. - - PROCEDURE DIVISION. - DISPLAY x - MOVE 0 TO x - DISPLAY FUNCTION TRIM(x) - MOVE ZERO TO x - DISPLAY FUNCTION TRIM(x) - . -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], -[1 - - -]) - -AT_CLEANUP - - -AT_SETUP([MULTIPLY BY literal in INITIAL program]) -AT_KEYWORDS([decimal constants fundamental]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog INITIAL. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 num PIC 9(4) VALUE 5. - 01 result PIC 9(4). - 01 ws-temp PIC 9(8)V99. - 01 ws-temp2 PIC 9(3)V99 VALUE 10.50. - PROCEDURE DIVISION. - MULTIPLY num BY 4 GIVING result - MOVE 1.10 TO WS-TEMP. - MULTIPLY WS-TEMP2 BY WS-TEMP GIVING WS-TEMP. -]) - -AT_CHECK([$COMPILE prog.cob]) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [], []) - -AT_CLEANUP - - -AT_SETUP([debugging lines (not active)]) -AT_KEYWORDS([fundamental]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - PROCEDURE DIVISION. - DISPLAY "OK" NO ADVANCING - END-DISPLAY. - D DISPLAY "KO" NO ADVANCING - D END-DISPLAY. - STOP RUN. -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], -[OK], []) - -AT_CLEANUP - - -AT_SETUP([debugging lines (-fdebugging-line)]) -AT_KEYWORDS([fundamental]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - PROCEDURE DIVISION. - DISPLAY "OK" NO ADVANCING - END-DISPLAY. - D DISPLAY "KO" NO ADVANCING - D END-DISPLAY. - STOP RUN. -]) - -AT_CHECK([$COMPILE -fdebugging-line prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], -[OKKO], []) - -AT_CLEANUP - - -AT_SETUP([debugging lines (WITH DEBUGGING MODE)]) -AT_KEYWORDS([fundamental extensions]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - CONFIGURATION SECTION. - SOURCE-COMPUTER. mine WITH DEBUGGING MODE. - DATA DIVISION. - WORKING-STORAGE SECTION. - PROCEDURE DIVISION. - D DISPLAY "KO" NO ADVANCING UPON STDOUT - D END-DISPLAY. - DISPLAY "OK" NO ADVANCING UPON STDOUT - END-DISPLAY. - STOP RUN. -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], -[KOOK], []) - -AT_CLEANUP - - -AT_SETUP([debugging lines, free format (not active)]) -AT_KEYWORDS([fundamental extensions]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - PROCEDURE DIVISION. - DISPLAY "OK" NO ADVANCING - END-DISPLAY. - >>D DISPLAY "KO" NO ADVANCING - >>D END-DISPLAY. - STOP RUN. -]) - -AT_CHECK([$COMPILE -free prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], -[OK], []) - -AT_CLEANUP - - -AT_SETUP([debugging lines, free format (-fdebugging-line)]) -AT_KEYWORDS([fundamental extensions]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - PROCEDURE DIVISION. - DISPLAY "OK" NO ADVANCING - END-DISPLAY. - >>D DISPLAY "KO" NO ADVANCING - >>D END-DISPLAY. - STOP RUN. -]) - -AT_CHECK([$COMPILE -free -fdebugging-line prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], -[OKKO], []) - -AT_CLEANUP - - -AT_SETUP([USE FOR DEBUGGING (no DEBUGGING MODE)]) -AT_KEYWORDS([fundamental]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - CONFIGURATION SECTION. - SOURCE-COMPUTER. - DATA DIVISION. - WORKING-STORAGE SECTION. - PROCEDURE DIVISION. - DECLARATIVES. - TEST-DEBUG SECTION. USE FOR DEBUGGING ON ALL PROCEDURES. - DISPLAY DEBUG-ITEM END-DISPLAY. - END DECLARATIVES. - FIRST-PAR. - DISPLAY "OK1" END-DISPLAY. - GO TO SECOND-PAR. - SECOND-PAR. - DISPLAY "OK2" END-DISPLAY. - THIRD-PAR. - DISPLAY "OK3" END-DISPLAY. - PERFORM FIRST-PAR THRU SECOND-PAR. - DISPLAY "OK4" END-DISPLAY. - PERFORM SECOND-PAR. - DISPLAY "OK5" END-DISPLAY. - STOP RUN. -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([COB_SET_DEBUG=1 $COBCRUN_DIRECT ./prog], [0], -[OK1 -OK2 -OK3 -OK1 -OK2 -OK4 -OK2 -OK5 -], []) - -AT_CLEANUP - - -AT_SETUP([USE FOR DEBUGGING (COB_SET_DEBUG deactivated)]) -AT_KEYWORDS([fundamental]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - CONFIGURATION SECTION. - SOURCE-COMPUTER. mine WITH DEBUGGING MODE. - DATA DIVISION. - WORKING-STORAGE SECTION. - PROCEDURE DIVISION. - DECLARATIVES. - TEST-DEBUG SECTION. USE FOR DEBUGGING ON ALL PROCEDURES. - DISPLAY DEBUG-ITEM END-DISPLAY. - END DECLARATIVES. - FIRST-PAR. - DISPLAY "OK1" END-DISPLAY. - GO TO SECOND-PAR. - SECOND-PAR. - DISPLAY "OK2" END-DISPLAY. - THIRD-PAR. - DISPLAY "OK3" END-DISPLAY. - PERFORM FIRST-PAR THRU SECOND-PAR. - DISPLAY "OK4" END-DISPLAY. - PERFORM SECOND-PAR. - DISPLAY "OK5" END-DISPLAY. - STOP RUN. -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([COB_SET_DEBUG=0 $COBCRUN_DIRECT ./prog], [0], -[OK1 -OK2 -OK3 -OK1 -OK2 -OK4 -OK2 -OK5 -], []) - -AT_CLEANUP - - -AT_SETUP([USE FOR DEBUGGING ON ALL PROCEDURES]) -AT_KEYWORDS([fundamental]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - CONFIGURATION SECTION. - SOURCE-COMPUTER. mine WITH DEBUGGING MODE. - DATA DIVISION. - WORKING-STORAGE SECTION. - PROCEDURE DIVISION. - DECLARATIVES. - TEST-DEBUG SECTION. USE FOR DEBUGGING ON ALL PROCEDURES. - DISPLAY DEBUG-ITEM "|" END-DISPLAY. - END DECLARATIVES. - FIRST-PAR. - DISPLAY "OK1" END-DISPLAY. - GO TO SECOND-PAR. - SECOND-PAR. - DISPLAY "OK2" END-DISPLAY. - THIRD-PAR. - DISPLAY "OK3" END-DISPLAY. - PERFORM FIRST-PAR THRU SECOND-PAR. - DISPLAY "OK4" END-DISPLAY. - PERFORM SECOND-PAR. - DISPLAY "OK5" END-DISPLAY. - STOP RUN. -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([COB_SET_DEBUG=1 $COBCRUN_DIRECT ./prog], [0], -[ FIRST-PAR START PROGRAM | -OK1 - 16 SECOND-PAR | -OK2 - 18 THIRD-PAR FALL THROUGH | -OK3 - 21 FIRST-PAR PERFORM LOOP | -OK1 - 16 SECOND-PAR | -OK2 -OK4 - 23 SECOND-PAR PERFORM LOOP | -OK2 -OK5 -], []) - -AT_CLEANUP - - -AT_SETUP([USE FOR DEBUGGING ON procedure]) -AT_KEYWORDS([fundamental]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - CONFIGURATION SECTION. - SOURCE-COMPUTER. mine WITH DEBUGGING MODE. - DATA DIVISION. - WORKING-STORAGE SECTION. - PROCEDURE DIVISION. - DECLARATIVES. - TEST-DEBUG SECTION. USE FOR DEBUGGING ON SECOND-PAR. - DISPLAY DEBUG-ITEM "|" END-DISPLAY. - END DECLARATIVES. - FIRST-PAR. - DISPLAY "OK1" END-DISPLAY. - GO TO SECOND-PAR. - SECOND-PAR. - DISPLAY "OK2" END-DISPLAY. - THIRD-PAR. - DISPLAY "OK3" END-DISPLAY. - PERFORM FIRST-PAR THRU SECOND-PAR. - DISPLAY "OK4" END-DISPLAY. - PERFORM SECOND-PAR. - DISPLAY "OK5" END-DISPLAY. - STOP RUN. -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([COB_SET_DEBUG=1 $COBCRUN_DIRECT ./prog], [0], -[OK1 - 16 SECOND-PAR | -OK2 -OK3 -OK1 - 16 SECOND-PAR | -OK2 -OK4 - 23 SECOND-PAR PERFORM LOOP | -OK2 -OK5 -], []) - -AT_CLEANUP - - -AT_SETUP([USE FOR DEBUGGING (COB_SET_DEBUG switched)]) -AT_KEYWORDS([fundamental]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - CONFIGURATION SECTION. - SOURCE-COMPUTER. mine WITH DEBUGGING MODE. - DATA DIVISION. - WORKING-STORAGE SECTION. - PROCEDURE DIVISION. - DECLARATIVES. - TEST-DEBUG SECTION. USE FOR DEBUGGING ON ALL PROCEDURES. - DISPLAY DEBUG-ITEM "|" END-DISPLAY. - END DECLARATIVES. - FIRST-PAR. - SET ENVIRONMENT "COB_SET_DEBUG" TO "false" - DISPLAY "OK1" END-DISPLAY. - GO TO SECOND-PAR. - SECOND-PAR. - DISPLAY "OK2" END-DISPLAY. - THIRD-PAR. - DISPLAY "OK3" END-DISPLAY. - PERFORM FIRST-PAR THRU SECOND-PAR. - DISPLAY "OK4" END-DISPLAY. - SET ENVIRONMENT "COB_SET_DEBUG" TO "Y" - PERFORM SECOND-PAR. - DISPLAY "OK5" END-DISPLAY. - STOP RUN. -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([COB_SET_DEBUG=1 $COBCRUN_DIRECT ./prog], [0], -[ FIRST-PAR START PROGRAM | -OK1 -OK2 -OK3 -OK1 -OK2 -OK4 - 25 SECOND-PAR PERFORM LOOP | -OK2 -OK5 -], []) - -AT_CLEANUP - - -AT_SETUP([USE FOR DEBUGGING ON [[ALL]] REFERENCES OF field]) -AT_KEYWORDS([fundamental]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - CONFIGURATION SECTION. - SOURCE-COMPUTER. mine WITH DEBUGGING MODE. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 MY-DATA-FIELDS. - 02 MY-DATA-FIELD-1 PIC 9 VALUE 1. - 02 MY-DATA-FIELD-2 PIC 9 VALUE 4. - 01 MY-DATA-FIELD-B PIC X(40) VALUE "ABCD". - PROCEDURE DIVISION. - DECLARATIVES. - TEST-DEBUG SECTION. - USE FOR DEBUGGING ON ALL REFERENCES OF MY-DATA-FIELD-1 - ALL MY-DATA-FIELD-2 - MY-DATA-FIELD-B. - DISPLAY DEBUG-ITEM "|" END-DISPLAY. - END DECLARATIVES. - INIT-PAR. - MOVE 6 TO MY-DATA-FIELD-2. - FIRST-PAR. - PERFORM VARYING MY-DATA-FIELD-1 FROM 1 BY 1 - UNTIL MY-DATA-FIELD-1 > MY-DATA-FIELD-2 - *> empty by design - END-PERFORM. - END-PAR. - MOVE "99" TO MY-DATA-FIELD-B. - MOVE MY-DATA-FIELD-B TO MY-DATA-FIELDS. - STOP RUN. -]) - -AT_CHECK([$COMPILE -fmissing-statement=ok prog.cob], [0], [], []) -# TODO: validate against other compilers, especially the line 30; -# likely the second line should be 25 instead of 24: -AT_CHECK([COB_SET_DEBUG=1 $COBCRUN_DIRECT ./prog], [0], -[ 22 MY-DATA-FIELD-2 6 | - 24 MY-DATA-FIELD-1 1 | - 24 MY-DATA-FIELD-1 1 | - 24 MY-DATA-FIELD-2 6 | - 24 MY-DATA-FIELD-1 2 | - 24 MY-DATA-FIELD-1 2 | - 24 MY-DATA-FIELD-2 6 | - 24 MY-DATA-FIELD-1 3 | - 24 MY-DATA-FIELD-1 3 | - 24 MY-DATA-FIELD-2 6 | - 24 MY-DATA-FIELD-1 4 | - 24 MY-DATA-FIELD-1 4 | - 24 MY-DATA-FIELD-2 6 | - 24 MY-DATA-FIELD-1 5 | - 24 MY-DATA-FIELD-1 5 | - 24 MY-DATA-FIELD-2 6 | - 24 MY-DATA-FIELD-1 6 | - 24 MY-DATA-FIELD-1 6 | - 24 MY-DATA-FIELD-2 6 | - 24 MY-DATA-FIELD-1 7 | - 24 MY-DATA-FIELD-1 7 | - 24 MY-DATA-FIELD-2 6 | - 29 MY-DATA-FIELD-B 99 | -], []) - -AT_CLEANUP - - -AT_SETUP([USE FOR DEBUGGING, reference within DEBUGGING]) -AT_KEYWORDS([fundamental]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - CONFIGURATION SECTION. - SOURCE-COMPUTER. mine WITH DEBUGGING MODE. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 DATA-FIELD PIC X(40) VALUE "ABCD". - PROCEDURE DIVISION. - DECLARATIVES. - TEST-DEBUG SECTION. - USE FOR DEBUGGING ON ALL REFERENCES OF DATA-FIELD. - DISPLAY DEBUG-ITEM "|". - MOVE "ABCD" TO DATA-FIELD. - DISPLAY DEBUG-ITEM "|". - END DECLARATIVES. - SOME-PAR. - MOVE QUOTE TO DATA-FIELD. - IF DATA-FIELD = QUOTE DISPLAY "NO DEBUG" STOP RUN. - DISPLAY "DEBUG". - STOP RUN. -]) -AT_CHECK([$COMPILE -Wno-terminator prog.cob], [0], [], []) -AT_CHECK([COB_SET_DEBUG=1 $COBCRUN_DIRECT ./prog], [0], -[ 19 DATA-FIELD """"""""""""""""""""""""""""""""""""""""| - 19 DATA-FIELD """"""""""""""""""""""""""""""""""""""""| - 20 DATA-FIELD ABCD | - 20 DATA-FIELD ABCD | -DEBUG -], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], -[NO DEBUG -], []) - -AT_CLEANUP - - -AT_SETUP([USE FOR DEBUGGING, time of execution]) -AT_KEYWORDS([fundamental DEBUGGING]) - -# FIXME: the debugging procedure is executed after the statement, -# which is generally fine, but not for "nested" statements -# where DEBUG-ITEM contains wrong data and the -# debugging procedure is called too late -AT_XFAIL_IF(true) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - CONFIGURATION SECTION. - SOURCE-COMPUTER. mine WITH DEBUGGING MODE. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 DATA-FIELD PIC X(40) VALUE "ABCD". - PROCEDURE DIVISION. - DECLARATIVES. - TEST-DEBUG SECTION. - USE FOR DEBUGGING ON ALL REFERENCES OF DATA-FIELD. - DISPLAY DEBUG-ITEM "|". - MOVE "ABCD" TO DATA-FIELD. - END DECLARATIVES. - SOME-PAR. - MOVE QUOTE TO DATA-FIELD. - IF DATA-FIELD = QUOTE - DISPLAY "NO DEBUG" - ELSE - DISPLAY "DEBUG" - MOVE SPACES TO DATA-FIELD - CALL "NOTHERE" USING DATA-FIELD - ON OVERFLOW - DISPLAY "THIS IS FINE". - STOP RUN. -]) -AT_CHECK([$COMPILE -w prog.cob], [0], [], []) -AT_CHECK([COB_SET_DEBUG=1 $COBCRUN_DIRECT ./prog], [0], -[ 18 DATA-FIELD """"""""""""""""""""""""""""""""""""""""| - 19 DATA-FIELD ABCD | -DEBUG - 23 DATA-FIELD | - 24 DATA-FIELD ABCD | -THIS IS FINE -], []) - -AT_CLEANUP - - -AT_SETUP([USE FOR DEBUGGING, reference with OCCURS]) -AT_KEYWORDS([fundamental DEBUGGING]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - CONFIGURATION SECTION. - SOURCE-COMPUTER. mine WITH DEBUGGING MODE. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 FILLER. - 02 FILLER OCCURS 10. - 03 FILLER OCCURS 5. - 04 DATA-FIELD PIC X(40) VALUE "ABCD" OCCURS 2. - PROCEDURE DIVISION. - DECLARATIVES. - TEST-DEBUG SECTION. - USE FOR DEBUGGING ON ALL REFERENCES OF DATA-FIELD. - DISPLAY DEBUG-ITEM "|" END-DISPLAY. - END DECLARATIVES. - SOME-PAR. - MOVE QUOTE TO DATA-FIELD (4, 2, 1). - STOP RUN. -]) -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([COB_SET_DEBUG=1 $COBCRUN_DIRECT ./prog], [0], -[ 20 DATA-FIELD +0004 +0002 +0001 """"""""""""""""""""""""""""""""""""""""| -], []) - -AT_CLEANUP - - -AT_SETUP([USE FOR DEBUGGING, referencing BASED item]) -AT_KEYWORDS([fundamental DEBUGGING FREE ALLOCATE]) - -# uncommon issue but shouldn't SIGSEGV --> TODO: fix later -# TODO: also check "ADDRESS OF" (non)-ALLOCATED field -AT_XFAIL_IF(true) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - CONFIGURATION SECTION. - SOURCE-COMPUTER. mine WITH DEBUGGING MODE. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 DATA-FIELD PIC X(40) VALUE "ABCD" BASED. - PROCEDURE DIVISION. - DECLARATIVES. - TEST-DEBUG SECTION. - USE FOR DEBUGGING ON ALL REFERENCES OF DATA-FIELD. - DISPLAY DEBUG-ITEM "|" END-DISPLAY. - END DECLARATIVES. - SOME-PAR. - ALLOCATE DATA-FIELD INITIALIZED. - FREE DATA-FIELD. - STOP RUN. -]) -AT_CHECK([$COMPILE prog.cob], [0], [], []) -# not sure about the output, check MF, claiming to support BASED + DEBUGGING -AT_CHECK([COB_SET_DEBUG=1 $COBCRUN_DIRECT ./prog], [0], -[ 17 DATA-FIELD ABCD | - 18 DATA-FIELD ABCD | -], []) - -AT_CLEANUP - - -AT_SETUP([USE FOR DEBUGGING file]) -AT_KEYWORDS([fundamental OPEN WRITE READ CLOSE]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - CONFIGURATION SECTION. - SOURCE-COMPUTER. mine WITH DEBUGGING MODE. - INPUT-OUTPUT SECTION. - FILE-CONTROL. - SELECT TEST-FILE ASSIGN "./TEST-FILE" FILE STATUS FS. - DATA DIVISION. - FILE SECTION. - FD TEST-FILE. - 01 TEST-REC PIC X(40). - WORKING-STORAGE SECTION. - 01 FS PIC X(2). - PROCEDURE DIVISION. - DECLARATIVES. - TEST-DEBUG SECTION. - USE FOR DEBUGGING ON TEST-FILE. - DISPLAY DEBUG-ITEM "|" END-DISPLAY. - END DECLARATIVES. - SOME-PAR. - OPEN OUTPUT TEST-FILE. - WRITE TEST-REC FROM "DEF". - CLOSE TEST-FILE. - OPEN INPUT TEST-FILE. - READ TEST-FILE. - CLOSE TEST-FILE. - STOP RUN. -]) -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([COB_SET_DEBUG=1 $COBCRUN_DIRECT ./prog], [0], -[ 23 TEST-FILE | - 25 TEST-FILE | - 26 TEST-FILE | - 27 TEST-FILE DEF | - 28 TEST-FILE | -], []) - -AT_CLEANUP - - -AT_SETUP([Abbreviated Expressions]) -AT_KEYWORDS([expression conditional]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - CONFIGURATION SECTION. - SPECIAL-NAMES. - SWITCH-1 - IS WRK-SWITCH-1 - ON STATUS IS ON-WRK-SWITCH-1 - OFF STATUS IS OFF-WRK-SWITCH-1 - SWITCH-2 - IS WRK-SWITCH-2 - OFF STATUS IS OFF-WRK-SWITCH-2. - DATA DIVISION. - ****************************************************************** - WORKING-STORAGE SECTION. - * - 01 FLD9-0 PIC 9 VALUE 0. - 01 FLD9-1 PIC 9 VALUE 1. - 01 FLD9-2 PIC 9 VALUE 2. - 01 FLD9-5 PIC 9 VALUE 5. - 01 FLD9-7 PIC 9 VALUE 7. - 01 FLD9-9 PIC 9 VALUE 9. - 01 FLDX PIC X VALUE 'X'. - 01 FLDY PIC X VALUE 'Y'. - 01 FLDYY PIC X VALUE 'Y'. - 01 FLDZ PIC X VALUE 'Z'. - 01 TESTNUM PIC 99 VALUE 1. - - PROCEDURE DIVISION. - MAIN-LINE. - - IF FLD9-7 > FLD9-5 AND NOT < FLD9-0 OR FLD9-1 - PERFORM PASS ELSE PERFORM FAIL. - IF FLD9-7 NOT = FLD9-5 OR FLD9-1 - PERFORM PASS ELSE PERFORM FAIL. - IF FLD9-7 NOT = FLD9-5 AND FLD9-1 - PERFORM PASS ELSE PERFORM FAIL. - IF NOT FLD9-7 = FLD9-5 OR FLD9-1 - PERFORM PASS ELSE PERFORM FAIL. - IF NOT (FLD9-5 > FLD9-7 OR < FLD9-1) - PERFORM PASS ELSE PERFORM FAIL. - IF NOT (FLD9-7 NOT > FLD9-5 AND FLD9-2 AND NOT FLD9-1) - PERFORM PASS ELSE PERFORM FAIL. - IF FLD9-9 > FLD9-2 AND FLD9-7 AND FLD9-5 - PERFORM PASS ELSE PERFORM FAIL. - IF FLD9-9 > FLD9-2 AND FLD9-7 OR FLD9-5 - PERFORM PASS ELSE PERFORM FAIL. - IF FLD9-1 < FLD9-2 AND FLD9-5 AND FLD9-7 - PERFORM PASS ELSE PERFORM FAIL. - - * // DISPLAY "***Constant expressions***". - IF 9 > 2 AND 7 AND 5 AND 1 - PERFORM PASS ELSE PERFORM FAIL. - IF 1 < 2 AND 5 AND 7 AND 9 - PERFORM PASS ELSE PERFORM FAIL. - IF 5 < 2 OR 1 OR 9 OR 7 - PERFORM PASS ELSE PERFORM FAIL. - IF 5 > 1 AND < 3 OR 6 - PERFORM PASS ELSE PERFORM FAIL. - - * // DISPLAY "***Switch expressions***". - IF ON-WRK-SWITCH-1 - OR NOT OFF-WRK-SWITCH-2 - AND OFF-WRK-SWITCH-1 - PERFORM FAIL ELSE PERFORM PASS. - DISPLAY "***FINE***" WITH NO ADVANCING. - STOP RUN. - - PASS. - * // DISPLAY 'Test ' TESTNUM ' passed' - ADD 1 TO TESTNUM. - - FAIL. - DISPLAY 'Test ' TESTNUM ' failed!' - ADD 1 TO TESTNUM. -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], -[prog.cob: in paragraph 'MAIN-LINE': -prog.cob:47: warning: suggest parentheses around AND within OR -prog.cob:53: warning: expression '9' GREATER THAN '2' is always TRUE -prog.cob:53: warning: expression '9' GREATER THAN '7' is always TRUE -prog.cob:53: warning: expression '9' GREATER THAN '5' is always TRUE -prog.cob:53: warning: expression '9' GREATER THAN '1' is always TRUE -prog.cob:55: warning: expression '1' LESS THAN '2' is always TRUE -prog.cob:55: warning: expression '1' LESS THAN '5' is always TRUE -prog.cob:55: warning: expression '1' LESS THAN '7' is always TRUE -prog.cob:55: warning: expression '1' LESS THAN '9' is always TRUE -prog.cob:57: warning: expression '5' LESS THAN '2' is always FALSE -prog.cob:57: warning: expression '5' LESS THAN '1' is always FALSE -prog.cob:57: warning: expression '5' LESS THAN '9' is always TRUE -prog.cob:57: warning: expression '5' LESS THAN '7' is always TRUE -prog.cob:59: warning: expression '5' GREATER THAN '1' is always TRUE -prog.cob:59: warning: expression '5' LESS THAN '3' is always FALSE -prog.cob:59: warning: expression '5' LESS THAN '6' is always TRUE -]) - -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [***FINE***], []) - -AT_CLEANUP - - -AT_SETUP([integer arithmetic on floating-point var]) -AT_KEYWORDS([fundamental literal]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 x USAGE FLOAT-SHORT VALUE 123.456. - - PROCEDURE DIVISION. - ADD 360 TO x - IF x <> 483.456 - DISPLAY "ADD wrong: " x - MOVE 483.456 TO x - END-IF - - SUBTRACT 360 FROM x - IF x <> 123.456 - DISPLAY "SUBTRACT wrong: " x - MOVE 123.456 TO x - END-IF - - DIVIDE 2 INTO x - IF x <> 61.728 - DISPLAY "DIVIDE wrong: " x - MOVE 61.728 TO x - END-IF - - MULTIPLY 2 BY x - IF x <> 123.456 - DISPLAY "MULTIPLY wrong: " x - END-IF - . -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [], []) -AT_CLEANUP diff -Nru gnucobol-4.0~early~20200606/tests/testsuite.src/run_initialize.at gnucobol-5/tests/testsuite.src/run_initialize.at --- gnucobol-4.0~early~20200606/tests/testsuite.src/run_initialize.at 2020-06-06 20:52:00.000000000 +0000 +++ gnucobol-5/tests/testsuite.src/run_initialize.at 1970-01-01 00:00:00.000000000 +0000 @@ -1,393 +0,0 @@ -## Copyright (C) 2003-2012, 2014-2015, 2017-2018 Free Software Foundation, Inc. -## Written by Keisuke Nishida, Roger While, Simon Sobisch -## -## This file is part of GnuCOBOL. -## -## The GnuCOBOL compiler is free software: you can redistribute it -## and/or modify it under the terms of the GNU General Public License -## as published by the Free Software Foundation, either version 3 of the -## License, or (at your option) any later version. -## -## GnuCOBOL is distributed in the hope that it will be useful, -## but WITHOUT ANY WARRANTY; without even the implied warranty of -## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -## GNU General Public License for more details. -## -## You should have received a copy of the GNU General Public License -## along with GnuCOBOL. If not, see . - -### GnuCOBOL Test Suite - -### ISO+IEC+1989-2002 14.8.19 INITIALIZE statement - -## 14.8.19.3 General rules - - - -AT_SETUP([INITIALIZE group entry with OCCURS]) -AT_KEYWORDS([initialize]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 G1. - 02 G2 OCCURS 2. - 03 X1 PIC X. - 03 X2 PIC 9. - PROCEDURE DIVISION. - MOVE SPACE TO G1. - INITIALIZE G2 (2). - IF G1 NOT = " 0" - DISPLAY G1 NO ADVANCING - END-DISPLAY - END-IF. - STOP RUN. -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [], []) - -AT_CLEANUP - - -AT_SETUP([INITIALIZE OCCURS with numeric edited]) -AT_KEYWORDS([initialize editing]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 G1. - 02 G2 OCCURS 5. - 03 X PIC Z9. - PROCEDURE DIVISION. - INITIALIZE G1 - MOVE 5 TO X(1) - MOVE 99 TO X(3) - IF G1 NOT = " 5 099 0 0" - DISPLAY 'MOVE "' G1 '"' - END-DISPLAY - END-IF - INITIALIZE G1 - IF G1 NOT = " 0 0 0 0 0" - DISPLAY 'INIT "' G1 '"' - END-DISPLAY - END-IF - STOP RUN. -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [], []) - -AT_CLEANUP - - -AT_SETUP([INITIALIZE OCCURS with SIGN LEADING / TRAILING]) -AT_KEYWORDS([initialize display]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 G1. - 02 FILLER OCCURS 2. - 03 X PIC S9 SIGN LEADING SEPARATE. - 02 FILLER OCCURS 2. - 03 Y PIC S9 SIGN TRAILING SEPARATE. - *> definition taken from NC1184.2 - 01 MINUS-NAMES SIGN IS TRAILING SEPARATE CHARACTER. - 02 MINUS-NAMES-1. - 03 MINUS-NAME1 PIC S9(18) VALUE -999999999999999999. - 03 EVEN-NAME1 PIC S9(18) VALUE +1. - 03 PLUS-NAME1 PIC S9(18) VALUE +999999999999999999. - 02 MINUS-NAMES-2. - 03 MINUS-NAME3 PIC SV9(18) VALUE -.999999999999999999. - 03 EVEN-NAME2 PIC SV9(18) VALUE +.1. - 03 PLUS-NAME3 PIC SV9(18) VALUE +.999999999999999999. - PROCEDURE DIVISION. - INITIALIZE G1 - MOVE 5 TO X(1), PLUS-NAME1 - MOVE -9 TO Y(2), MINUS-NAME1 - IF G1 NOT = "+5+00+9-" - DISPLAY 'MOVE G "' G1 '"' - END-DISPLAY - END-IF - MOVE .123 TO PLUS-NAME3 - IF MINUS-NAMES-1 NOT = - "000000000000000009-000000000000000001+000000000000000005+" - OR MINUS-NAMES-2 NOT = - "999999999999999999-100000000000000000+123000000000000000+" - DISPLAY 'MOVE MN1 "' MINUS-NAMES-1 '"' - END-DISPLAY - DISPLAY 'MOVE MN2 "' MINUS-NAMES-2 '"' - END-DISPLAY - END-IF - INITIALIZE G1, MINUS-NAMES - IF G1 NOT = "+0+00+0+" - DISPLAY 'INIT G1 "' G1 '"' - END-DISPLAY - END-IF - IF MINUS-NAMES-1 NOT = - "000000000000000000+000000000000000000+000000000000000000+" - OR MINUS-NAMES-2 NOT = - "000000000000000000+000000000000000000+000000000000000000+" - DISPLAY 'MOVE MN1 "' MINUS-NAMES-1 '"' - END-DISPLAY - DISPLAY 'MOVE MN2 "' MINUS-NAMES-2 '"' - END-DISPLAY - END-IF - MOVE .123 TO PLUS-NAME3 - MOVE -.456 TO MINUS-NAME3 - DISPLAY PLUS-NAME3 END-DISPLAY - DISPLAY MINUS-NAME3 END-DISPLAY - STOP RUN. -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([./prog], [0], -[.123000000000000000+ -.456000000000000000- -], []) - -AT_CLEANUP - - -AT_SETUP([INITIALIZE complex group (1)]) -AT_KEYWORDS([initialize]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 G1. - 02 X PIC X. - 02 G2 OCCURS 2. - 03 Y PIC 9. - 02 Z PIC 9. - PROCEDURE DIVISION. - INITIALIZE G1. - IF G1 NOT = " 000" - DISPLAY G1 NO ADVANCING - END-DISPLAY - END-IF. - STOP RUN. -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [], []) - -AT_CLEANUP - - -AT_SETUP([INITIALIZE complex group (2)]) -AT_KEYWORDS([initialize]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 G1. - 02 G2 OCCURS 2. - 03 X PIC 9. - 03 Y PIC X OCCURS 2. - 03 Z PIC X. - PROCEDURE DIVISION. - INITIALIZE G1. - IF G1 NOT = "0 0 " - DISPLAY G1 NO ADVANCING - END-DISPLAY - END-IF. - STOP RUN. -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [], []) - -AT_CLEANUP - - -AT_SETUP([INITIALIZE with REDEFINES]) -AT_KEYWORDS([initialize]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 G1. - 02 X PIC X. - 02 Y REDEFINES X PIC 9. - 02 Z PIC 9. - PROCEDURE DIVISION. - INITIALIZE G1. - IF G1 NOT = " 0" - DISPLAY G1 NO ADVANCING - END-DISPLAY - END-IF. - STOP RUN. -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [], []) - -AT_CLEANUP - - -AT_SETUP([INITIALIZE with FILLER]) -AT_KEYWORDS([initialize]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 G1. - 02 X PIC 99. - 02 FILLER PIC X. - 02 Z PIC 99. - 01 MY-FILLER. - 02 FILLER PIC 9(6) VALUE 12345. - PROCEDURE DIVISION. - MOVE ALL 'A' TO G1. - INITIALIZE G1. - IF G1 NOT = "00A00" - DISPLAY "G1 (INIT): " G1 - END-DISPLAY - END-IF. - MOVE ALL 'A' TO G1. - INITIALIZE G1 WITH FILLER. - IF G1 NOT = "00 00" - DISPLAY "G1 (INIT FILLER):" G1 - END-DISPLAY - END-IF. - - INITIALIZE MY-FILLER - IF MY-FILLER NOT = "012345" - DISPLAY "MY-FILLER (INIT): " MY-FILLER - END-DISPLAY - END-IF - - INITIALIZE MY-FILLER WITH FILLER - IF MY-FILLER NOT = "000000" - DISPLAY "MY-FILLER (INIT FILLER): " MY-FILLER - END-DISPLAY - END-IF - - INITIALIZE MY-FILLER ALL TO VALUE - IF MY-FILLER NOT = "000000" - DISPLAY "MY-FILLER (INIT TO VAL): " MY-FILLER - END-DISPLAY - END-IF - - INITIALIZE MY-FILLER WITH FILLER ALL TO VALUE - IF MY-FILLER NOT = "012345" - DISPLAY "MY-FILLER (INIT FILLER TO VAL): " MY-FILLER - END-DISPLAY - END-IF - - INITIALIZE MY-FILLER (2:3) - IF MY-FILLER NOT = "0 45" - DISPLAY "MY-FILLER (REF-MOD): " MY-FILLER - END-DISPLAY - END-IF - - STOP RUN. -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [], []) - -AT_CLEANUP - - -AT_SETUP([INITIALIZE of EXTERNAL data items]) -AT_KEYWORDS([initialize]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 EXT-VAR-01 PIC X(5) EXTERNAL. - 01 EXT-VAR-GRP EXTERNAL. - 02 EXT-FIELD1 PIC 999. - 02 EXT-FIELD2 PIC x(4). - 02 EXT-FIELD3 PIC 9(6). - 02 EXT-FIELD4 PIC s9(5)v99. - PROCEDURE DIVISION. - MOVE "MOVE" TO EXT-VAR-01. - MOVE 1 TO EXT-FIELD1. - MOVE "X" TO EXT-FIELD2. - MOVE 123 TO EXT-FIELD3. - MOVE -2.1 TO EXT-FIELD4. - INITIALIZE EXT-VAR-01. - INITIALIZE EXT-VAR-GRP. - IF EXT-VAR-01 NOT = SPACES - DISPLAY "EXT-VAR-01 " EXT-VAR-01 - END-DISPLAY - END-IF. - IF EXT-FIELD1 NOT = ZERO - DISPLAY "EXT-FIELD1 " EXT-FIELD1 - END-DISPLAY - END-IF. - IF EXT-FIELD2 NOT = SPACES - DISPLAY "EXT-FIELD2 " EXT-FIELD2 - END-DISPLAY - END-IF. - IF EXT-FIELD3 NOT = ZERO - DISPLAY "EXT-FIELD3 " EXT-FIELD3 - END-DISPLAY - END-IF. - IF EXT-FIELD4 NOT = ZERO - DISPLAY "EXT-FIELD4 " EXT-FIELD4 - END-DISPLAY - END-IF. - STOP RUN. -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [], []) - -AT_CLEANUP - - -AT_SETUP([INITIALIZE with reference modification]) -AT_KEYWORDS([initialize]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 MY-FLD PIC X(6) VALUE "ABCDEF". - 01 MY-OTHER-FLD PIC 9(4) VALUE ZERO. - PROCEDURE DIVISION. - ASTART SECTION. - A01. - INITIALIZE MY-FLD (1:2). - IF MY-FLD NOT = " CDEF" - DISPLAY "MY-FLD: " MY-FLD - END-DISPLAY - END-IF - - *> note: INITIALIZE with refmod => handle field as alphanumeric - INITIALIZE MY-OTHER-FLD (2:2) - MOVE "0 0" TO MY-FLD - IF MY-OTHER-FLD NOT = MY-FLD (1:4) - DISPLAY "MY-OTHER-FLD: " MY-OTHER-FLD - END-DISPLAY - END-IF - - STOP RUN. -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [], []) - -AT_CLEANUP diff -Nru gnucobol-4.0~early~20200606/tests/testsuite.src/run_manual_screen.at gnucobol-5/tests/testsuite.src/run_manual_screen.at --- gnucobol-4.0~early~20200606/tests/testsuite.src/run_manual_screen.at 2020-06-06 20:52:00.000000000 +0000 +++ gnucobol-5/tests/testsuite.src/run_manual_screen.at 1970-01-01 00:00:00.000000000 +0000 @@ -1,2391 +0,0 @@ -## Copyright (C) 2014-2018,2020 Free Software Foundation, Inc. -## Written by Edward Hart, Simon Sobisch -## -## This file is part of GnuCOBOL. -## -## The GnuCOBOL compiler is free software: you can redistribute it -## and/or modify it under the terms of the GNU General Public License -## as published by the Free Software Foundation, either version 3 of the -## License, or (at your option) any later version. -## -## GnuCOBOL is distributed in the hope that it will be useful, -## but WITHOUT ANY WARRANTY; without even the implied warranty of -## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -## GNU General Public License for more details. -## -## You should have received a copy of the GNU General Public License -## along with GnuCOBOL. If not, see . - -### GnuCOBOL Test Suite - -### ISO+IEC+1989-2014 9.2 Screens, 13.17 Screen description entry, 13.18 Data -### division clauses. - -AT_SETUP([LINE]) -AT_KEYWORDS([screen]) - -AT_SKIP_IF(test "$COB_HAS_CURSES" != "yes") - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 success-flag PIC X VALUE 'Y'. - 88 success VALUE 'Y', 'y'. - - SCREEN SECTION. - 01 scr. - 03 LINE 1 VALUE 'Enter "y" if the numbers below correspond ' - & 'to their line number and are in the '. - 03 LINE 2 VALUE 'first column. (This is line 2.)'. - 03 LINE 3 VALUE '3'. - 03 LINE 4 VALUE '4'. - 03 LINE 5 VALUE '5'. - 03 group-1 LINE - 3. - 05 group-2 COL 5. - 07 LINE PLUS 6 VALUE '8'. - 07 LINE MINUS 2 VALUE '6'. - 03 group-3 LINE + 1. - 05 COL 1 VALUE '7'. - 03 LINE + 3 PIC X, REQUIRED USING success-flag. - - PROCEDURE DIVISION. - DISPLAY scr - ACCEPT scr - - IF success AND COB-CRT-STATUS = 0 - GOBACK RETURNING 0 - ELSE - GOBACK RETURNING 1 - END-IF - . -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$RUN_PROG_MANUAL ./prog], [0], [], []) - -AT_CLEANUP - - -AT_SETUP([COLUMN (1)]) -AT_KEYWORDS([COL]) - -AT_SKIP_IF(test "$COB_HAS_CURSES" != "yes") - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 dummy PIC X(5). - 01 success-flag PIC X VALUE 'Y'. - 88 success VALUE 'Y', 'y'. - - SCREEN SECTION. - 01 scr. - 03 VALUE 'Enter "y" if the numbers below correspond to ' - & 'their column number.'. - 03 LINE 2 VALUE '123456789'. - 03 LINE 3 COLUMN 2. - 05 COL 1 VALUE '1'. - 05 COL 5 VALUE '5'. - 05 COL MINUS 2 VALUE '3'. - 05 COL PLUS 1 VALUE '4'. - 05 group-1 LINE 3. - 07 VALUE '2'. - 07 group-2 COLUMN + 4. - 09 group-3. - 11 COL + 0 VALUE '6'. - 05 COLUMN + 1, VALUE '7'. - 03 LINE 5 PIC X, REQUIRED, USING success-flag. - - PROCEDURE DIVISION. - DISPLAY scr - ACCEPT scr - - IF success AND COB-CRT-STATUS = 0 - GOBACK RETURNING 0 - ELSE - GOBACK RETURNING 1 - END-IF - . -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$RUN_PROG_MANUAL ./prog], [0], [], []) - -AT_CLEANUP - - -AT_SETUP([COLUMN (2)]) -AT_KEYWORDS([COL]) - -AT_SKIP_IF(test "$COB_HAS_CURSES" != "yes") - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 dummy-1 PIC X(10). - 01 dummy-2 PIC X(10). - 01 dummy-3 PIC X(10). - - 01 success-flag PIC X VALUE 'Y'. - 88 success VALUE 'Y', 'y'. - - SCREEN SECTION. - 01 scr. - 03 PIC X(80) VALUE 'Enter "y" if there are three non-'- - 'overlapping input fields on one line below.'. - 03 LINE + 1, PIC X(80) VALUE 'field.'. - 03 LINE + 2, PIC X(10) TO dummy-1. - 03 COL + 2, PIC X(10) TO dummy-2. - 03 COL + 2, PIC X(10) TO dummy-3. - 03 success-field LINE + 2, PIC X, REQUIRED, - USING success-flag. - - PROCEDURE DIVISION. - DISPLAY scr - ACCEPT scr - - IF success AND COB-CRT-STATUS = 0 - GOBACK RETURNING 0 - ELSE - GOBACK RETURNING 1 - END-IF - . -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$RUN_PROG_MANUAL ./prog], [0], [], []) - -AT_CLEANUP - - -AT_SETUP([LINE non-zero, COLUMN zero]) -AT_KEYWORDS([COL extensions]) - -AT_SKIP_IF(test "$COB_HAS_CURSES" != "yes") - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 success-flag PIC X VALUE 'Y'. - 88 success VALUE 'Y', 'y'. - - SCREEN SECTION. - 01 scr. - 03 LINE 1 VALUE 'Enter "y" if you see 123 on the line '- - 'below starting at column 1.'. - 03 LINE + 3 PIC X, REQUIRED USING success-flag. - 03 LINE 2 VALUE '1'. - - PROCEDURE DIVISION. - DISPLAY scr - DISPLAY '2' LINE 2, COLUMN 0; '3' - ACCEPT scr - - IF success AND COB-CRT-STATUS = 0 - GOBACK RETURNING 0 - ELSE - GOBACK RETURNING 1 - END-IF - . -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$RUN_PROG_MANUAL ./prog], [0], [], []) - -AT_CLEANUP - - -AT_SETUP([LINE zero, COLUMN non-zero]) -AT_KEYWORDS([COL zero extensions]) - -AT_SKIP_IF(test "$COB_HAS_CURSES" != "yes") - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 success-flag PIC X VALUE 'Y'. - 88 success VALUE 'Y', 'y'. - - SCREEN SECTION. - 01 scr. - 03 LINE 1 VALUE 'Enter "y" if you see 123 on the line '- - 'below starting at column 1.'. - 03 LINE + 3 PIC X, REQUIRED USING success-flag. - 03 LINE 2 COL 3, VALUE '3'. - 03 LINE 1 COL 80 VALUE ' '. - - PROCEDURE DIVISION. - DISPLAY scr - DISPLAY '1' LINE 0, COLUMN 1; '2' - ACCEPT scr - - IF success AND COB-CRT-STATUS = 0 - GOBACK RETURNING 0 - ELSE - GOBACK RETURNING 1 - END-IF - . -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$RUN_PROG_MANUAL ./prog], [0], [], []) - -AT_CLEANUP - - -AT_SETUP([LINE zero, COLUMN zero]) -AT_KEYWORDS([COL extensions]) - -AT_SKIP_IF(test "$COB_HAS_CURSES" != "yes") - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 success-flag PIC X VALUE 'Y'. - 88 success VALUE 'Y', 'y'. - - SCREEN SECTION. - 01 scr. - 03 LINE 1 VALUE 'Enter "y" if you see 1234 on the line '- - 'below starting at column 1.'. - 03 LINE + 3 PIC X, REQUIRED USING success-flag. - 03 LINE 2 VALUE '1'. - - PROCEDURE DIVISION. - DISPLAY scr - DISPLAY '2' LINE 0, COLUMN 0 - DISPLAY '3' LINE 2, COLUMN 3 - DISPLAY '4' AT 0000 - - ACCEPT scr - - IF success AND COB-CRT-STATUS = 0 - GOBACK RETURNING 0 - ELSE - GOBACK RETURNING 1 - END-IF - . -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$RUN_PROG_MANUAL ./prog], [0], [], []) - -AT_CLEANUP - - -AT_SETUP([DISPLAY AT]) -AT_KEYWORDS([extensions]) - -AT_SKIP_IF(test "$COB_HAS_CURSES" != "yes") - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 success-flag PIC X VALUE 'Y'. - 88 success VALUE 'Y', 'y'. - - 01 screen-loc PIC 9(6) VALUE 4004. - - SCREEN SECTION. - 01 scr. - 03 VALUE 'Enter "y" if the numbers 1-3 are in a diagonal'- - ' line from line 2, column 2.'. - 03 success-field PIC X, LINE 6, REQUIRED, - USING success-flag. - - PROCEDURE DIVISION. - DISPLAY '1' AT 0202 - DISPLAY '2' AT 003003 - DISPLAY '3' AT screen-loc - DISPLAY scr - ACCEPT scr - - IF success AND COB-CRT-STATUS = 0 - GOBACK RETURNING 0 - ELSE - GOBACK RETURNING 1 - END-IF - . -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$RUN_PROG_MANUAL ./prog], [0], [], []) - -AT_CLEANUP - - -AT_SETUP([DISPLAY LOW-VALUES (one statement)]) -AT_KEYWORDS([LOW-VALUE extensions]) - -AT_SKIP_IF(test "$COB_HAS_CURSES" != "yes") - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 success-flag PIC X VALUE 'Y'. - 88 success VALUE 'Y', 'y'. - - SCREEN SECTION. - 01 scr. - 03 LINE 1 VALUE 'Enter "y" if the word below starts at line' - & ' 3, column 3.'. - 03 LINE + 4 PIC X, REQUIRED USING success-flag. - - PROCEDURE DIVISION. - DISPLAY scr - DISPLAY LOW-VALUES AT LINE 3, COL 3; 'Hello!' - ACCEPT scr - - IF success AND COB-CRT-STATUS = 0 - GOBACK RETURNING 0 - ELSE - GOBACK RETURNING 1 - END-IF - . -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$RUN_PROG_MANUAL ./prog], [0], [], []) - -AT_CLEANUP - - -AT_SETUP([DISPLAY LOW-VALUES (two statements)]) -AT_KEYWORDS([LOW-VALUE extensions]) - -AT_SKIP_IF(test "$COB_HAS_CURSES" != "yes") - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 success-flag PIC X VALUE 'Y'. - 88 success VALUE 'Y', 'y'. - - SCREEN SECTION. - 01 scr. - 03 LINE 1 VALUE 'Enter "y" if the word below starts at line' - & ' 3, column 3.'. - 03 LINE + 4 PIC X, REQUIRED USING success-flag. - - PROCEDURE DIVISION. - DISPLAY scr - DISPLAY LOW-VALUES AT LINE 3, COL 3 - DISPLAY 'Hello!' UPON CRT - ACCEPT scr - - IF success AND COB-CRT-STATUS = 0 - GOBACK RETURNING 0 - ELSE - GOBACK RETURNING 1 - END-IF - . -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$RUN_PROG_MANUAL ./prog], [0], [], []) - -AT_CLEANUP - - -AT_SETUP([DISPLAY SPACES]) -AT_KEYWORDS([SPACE extensions]) - -AT_SKIP_IF(test "$COB_HAS_CURSES" != "yes") - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 success-flag PIC X VALUE 'Y'. - 88 success VALUE 'Y', 'y'. - - SCREEN SECTION. - 01 scr-1. - 03 LINE 1 VALUE 'Enter "y" if all the text after foo in the' - & ' screen has been erased.'. - 03 LINE 3 VALUE 'Lorem ipsum dolor sit amet, consectetur ad' - & 'ipiscing elit. Curabitur dapibus dui'. - 03 LINE 4 VALUE 'vitae augue lobortis, non tempor diam tris' - & 'tique. Donec dignissim ex velit, ut'. - 03 LINE 5 VALUE 'efficitur tellus pharetra at. Curabitur at' - & ' condimentum nunc, nec accumsan'. - 03 LINE 6 VALUE 'nulla. Nulla at feugiat elit, eget condime' - & 'ntum justo. Nam lorem lectus,'. - 03 LINE 7 VALUE 'imperdiet sit amet odio eu, eleifend conse' - & 'ctetur ligula. Duis diam felis, porta'. - 03 LINE 8 VALUE 'id diam id, ultrices finibus augue. Mauris' - & ' imperdiet, dolor sed sodales porta,'. - 03 LINE 9 VALUE 'justo nunc consequat nulla, iaculis venena' - & 'tis lorem libero sit amet'. - 03 LINE 10 VALUE 'magna. Nullam pulvinar nullam.'. - 03 success-field LINE + 2, PIC X, REQUIRED, - USING success-flag. - - PROCEDURE DIVISION. - DISPLAY scr-1 - DISPLAY SPACES AT LINE 6, COL 8; 'foo' HIGHLIGHT - ACCEPT success-field - - IF success AND COB-CRT-STATUS = 0 - GOBACK RETURNING 0 - ELSE - GOBACK RETURNING 1 - END-IF - . -]) - -AT_CHECK([$COMPILE -fdisplay-special-fig-consts prog.cob], [0], [], []) -AT_CHECK([$RUN_PROG_MANUAL ./prog], [0], [], []) - -AT_CLEANUP - - -AT_SETUP([DISPLAY ALL X'01']) -AT_KEYWORDS([SOH extensions]) - -AT_SKIP_IF(test "$COB_HAS_CURSES" != "yes") - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 success-flag PIC X VALUE 'Y'. - 88 success VALUE 'Y', 'y'. - - SCREEN SECTION. - 01 scr-1. - 03 LINE 1 VALUE 'Enter "y" if all the text after foo on ' - & 'that line alone has been erased.'. - 03 LINE 3 VALUE 'Lorem ipsum dolor sit amet, consectetur ad' - & 'ipiscing elit. Curabitur dapibus dui'. - 03 LINE 4 VALUE 'vitae augue lobortis, non tempor diam tris' - & 'tique. Donec dignissim ex velit, ut'. - 03 LINE 5 VALUE 'efficitur tellus pharetra at. Curabitur at' - & ' condimentum nunc, nec accumsan'. - 03 LINE 6 VALUE 'nulla. Nulla at feugiat elit, eget condime' - & 'ntum justo. Nam lorem lectus,'. - 03 LINE 7 VALUE 'imperdiet sit amet odio eu, eleifend conse' - & 'ctetur ligula. Duis diam felis, porta'. - 03 LINE 8 VALUE 'id diam id, ultrices finibus augue. Mauris' - & ' imperdiet, dolor sed sodales porta,'. - 03 LINE 9 VALUE 'justo nunc consequat nulla, iaculis venena' - & 'tis lorem libero sit amet'. - 03 LINE 10 VALUE 'magna. Nullam pulvinar nullam.'. - 03 success-field LINE + 2, PIC X, REQUIRED, - USING success-flag. - - PROCEDURE DIVISION. - DISPLAY scr-1 - DISPLAY ALL X'01', LINE 6, COLUMN 8; 'foo' HIGHLIGHT - ACCEPT success-field - - IF success AND COB-CRT-STATUS = 0 - GOBACK RETURNING 0 - ELSE - GOBACK RETURNING 1 - END-IF - . -]) - -AT_CHECK([$COMPILE -fdisplay-special-fig-consts prog.cob], [0], [], []) -AT_CHECK([$RUN_PROG_MANUAL ./prog], [0], [], []) - -AT_CLEANUP - - -AT_SETUP([DISPLAY ALL X'02']) -AT_KEYWORDS([STX extensions]) - -AT_SKIP_IF(test "$COB_HAS_CURSES" != "yes") - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 success-flag PIC X VALUE 'Y'. - 88 success VALUE 'Y', 'y'. - - SCREEN SECTION. - 01 scr-1. - 03 LINE 3 VALUE 'Lorem ipsum dolor sit amet, consectetur ad' - & 'ipiscing elit. Curabitur dapibus dui'. - 03 LINE 4 VALUE 'vitae augue lobortis, non tempor diam tris' - & 'tique. Donec dignissim ex velit, ut'. - 03 LINE 5 VALUE 'efficitur tellus pharetra at. Curabitur at' - & ' condimentum nunc, nec accumsan'. - 03 LINE 6 VALUE 'nulla. Nulla at feugiat elit, eget condime' - & 'ntum justo. Nam lorem lectus,'. - 03 LINE 7 VALUE 'imperdiet sit amet odio eu, eleifend conse' - & 'ctetur ligula. Duis diam felis, porta'. - 03 LINE 8 VALUE 'id diam id, ultrices finibus augue. Mauris' - & ' imperdiet, dolor sed sodales porta,'. - 03 LINE 9 VALUE 'justo nunc consequat nulla, iaculis venena' - & 'tis lorem libero sit amet'. - 03 LINE 10 VALUE 'magna. Nullam pulvinar nullam.'. - - 01 scr-2. - 03 LINE 6 COL 8 VALUE 'foo' BLANK SCREEN, HIGHLIGHT. - 03 LINE 1 VALUE 'Enter "y" if foo is the only word below.'. - - 01 scr-3. - 03 VALUE 'Enter "y" if foo is the only word below.'. - 03 success-field COL + 2, PIC X, REQUIRED, - USING success-flag. - - PROCEDURE DIVISION. - DISPLAY scr-1 - DISPLAY ALL X'02' AT LINE 6 COL 8; 'foo' HIGHLIGHT - DISPLAY scr-3 - ACCEPT scr-3 - - IF success AND COB-CRT-STATUS = 0 - GOBACK RETURNING 0 - ELSE - GOBACK RETURNING 1 - END-IF - . -]) - -AT_CHECK([$COMPILE -fdisplay-special-fig-consts prog.cob], [0], [], []) -AT_CHECK([$RUN_PROG_MANUAL ./prog], [0], [], []) - -AT_CLEANUP - - -AT_SETUP([DISPLAY ALL X'07']) -AT_KEYWORDS([BELL BEEP extensions]) - -AT_SKIP_IF(test "$COB_HAS_CURSES" != "yes") - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 success-flag PIC X. - 88 success VALUE 'Y', 'y'. - - SCREEN SECTION. - 01 scr. - 03 VALUE 'Enter "y" if you heard a beep:'. - 03 success-field PIC X, COL + 2, REQUIRED, TO success-flag - FROM 'Y'. - 01 scr2. - 03 LINE 4 VALUE 'system beep may be turned off ' & - 'on this system.'. - 03 LINE 5 VALUE 'Retesting with COB_BELL=FLASH...'. - 03 LINE + 2 - VALUE 'Enter "y" if you''ve seen your terminal flash'. - 03 success-field PIC X, COL + 2, REQUIRED, TO success-flag - FROM 'Y'. - - PROCEDURE DIVISION. - DISPLAY scr - DISPLAY ALL X'07' UPON CRT - ACCEPT scr - - IF success AND COB-CRT-STATUS = 0 - GOBACK RETURNING 0 - END-IF - - SET ENVIRONMENT 'COB_BELL' TO 'FLASH' - CALL 'C$SLEEP' USING '1' - - DISPLAY scr2 - DISPLAY ALL X'07' UPON CRT - ACCEPT scr2 - - IF success AND COB-CRT-STATUS = 0 - GOBACK RETURNING 0 - ELSE - GOBACK RETURNING 1 - END-IF - . -]) - -AT_CHECK([$COMPILE -fdisplay-special-fig-consts prog.cob], [0], [], []) -AT_CHECK([$RUN_PROG_MANUAL ./prog], [0], [], []) - -AT_CLEANUP - - -AT_SETUP([Screen position after field display]) -AT_KEYWORDS([LINE COLUMN]) - -AT_SKIP_IF(test "$COB_HAS_CURSES" != "yes") - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 success-flag PIC X VALUE 'Y'. - 88 success VALUE 'Y', 'y'. - - SCREEN SECTION. - 01 scr. - 03 VALUE 'Enter "y" if this sentence starts at line 1,'- - ' column 1:'. - 03 success-field PIC X, COL + 2, REQUIRED, - USING success-flag. - - PROCEDURE DIVISION. - DISPLAY 'ignore this' AT LINE 4 COL 4 - DISPLAY scr - ACCEPT success-field - - IF success AND COB-CRT-STATUS = 0 - GOBACK RETURNING 0 - ELSE - GOBACK RETURNING 1 - END-IF - . -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$RUN_PROG_MANUAL ./prog], [0], [], []) - -AT_CLEANUP - -# See section 13.17.3 - -AT_SETUP([Overridden clauses (1)]) -AT_KEYWORDS([LINE COLUMN COL]) - -AT_SKIP_IF(test "$COB_HAS_CURSES" != "yes") - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 dummy PIC X(5). - 01 success-flag PIC X VALUE 'Y'. - 88 success VALUE 'Y', 'y'. - - SCREEN SECTION. - 01 scr. - 03 VALUE 'Enter "y" if the numbers below correspond to their' - & ' column number and all on'. - 03 LINE 2 VALUE 'lines 3 and 4.'. - 03 LINE 3 VALUE '123456789'. - 03 LINE 4 VALUE ' 34'. - 03 FILLER LINE + 6. - 05 COL 3. - 07 COL 1. - 09 LINE 4 VALUE '1'. - 09 VALUE '2'. - 05 LINE + 1, COL + 2. - 07 LINE 4, COL + 1, VALUE '5'. - 03 LINE 6 PIC X, REQUIRED, USING success-flag. - - PROCEDURE DIVISION. - DISPLAY scr - ACCEPT scr - - IF success AND COB-CRT-STATUS = 0 - GOBACK RETURNING 0 - ELSE - GOBACK RETURNING 1 - END-IF - . -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$RUN_PROG_MANUAL ./prog], [0], [], []) - -AT_CLEANUP - - -AT_SETUP([Overridden clauses (2)]) -AT_KEYWORDS([HIGHLIGHT LOWLIGHT]) - -AT_SKIP_IF(test "$COB_HAS_CURSES" != "yes") - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 dummy PIC X(5). - 01 success-flag PIC X VALUE 'Y'. - 88 success VALUE 'Y', 'y'. - - SCREEN SECTION. - 01 scr. - 03 VALUE 'Enter "y" if the word below is not dim and has' - & ' black background.'. - 03 LINE + 1, LOWLIGHT BACKGROUND-COLOR 3. - 05 HIGHLIGHT BACKGROUND-COLOR 0. - 07 VALUE 'Highlight'. - 03 LINE + 2, PIC X USING success-flag. - - PROCEDURE DIVISION. - DISPLAY scr - ACCEPT scr - - IF success AND COB-CRT-STATUS = 0 - GOBACK RETURNING 0 - ELSE - GOBACK RETURNING 1 - END-IF - . -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$RUN_PROG_MANUAL ./prog], [0], [], []) - -AT_CLEANUP - - -AT_SETUP([AUTO]) -AT_KEYWORDS([position]) - -AT_SKIP_IF(test "$COB_HAS_CURSES" != "yes") - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 dummy PIC X(5). - 01 success-flag PIC X. - 88 success VALUE 'Y', 'y'. - - SCREEN SECTION. - 01 scr. - 03 PIC X(80) VALUE 'Enter "y" in the bottom' - & ' field if:'. - 03 LINE + 1, PIC X(80) VALUE ' * when the left field is' - & ' full, the cursor automatically moves'. - 03 LINE + 1, PIC X(80) VALUE ' to the next field.'. - 03 LINE + 1, PIC X(80) VALUE ' * this does not happen' - & ' with the other fields.'. - 03 LINE + 1, PIC X(80) VALUE ' * the fields below are' - & ' on one line and separated by a single' - & ' column.'. - - 03 test-fields LINE + 2. - 05 field-1 COL 1, PIC X(5) AUTO TO dummy. - 05 field-2 COL + 2, PIC X(5) TO dummy. - 05 field-3 COL + 2, PIC X(5) TO dummy. - 03 success-field LINE + 2, COLUMN 1; PIC X, REQUIRED - TO success-flag FROM 'Y'. - - PROCEDURE DIVISION. - DISPLAY scr - ACCEPT scr - - IF success AND COB-CRT-STATUS = 0 - GOBACK RETURNING 0 - ELSE - GOBACK RETURNING 1 - END-IF - . -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$RUN_PROG_MANUAL ./prog], [0], [], []) - -AT_CLEANUP - - -AT_SETUP([BACKGROUND- / FOREGROUND-COLOUR]) -AT_KEYWORDS([BACKGROUND-COLOR BACKGROUND-COLOUR FOREGROUND-COLOR]) - -AT_SKIP_IF(test "$COB_HAS_CURSES" != "yes") - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 dummy PIC X(10). - 01 success-flag PIC X. - 88 success VALUE 'Y', 'y'. - - SCREEN SECTION. - 01 scr. - 03 PIC X(80) - VALUE 'Enter "y" if the text below matches the colour ' - & 'of the background/text.'. - 03 LINE + 1, COL 1, PIC X(80) - VALUE 'Note: the black text is on white background/the ' - & 'white background has black text'. - 03 LINE + 1, COL 1, PIC X(80) - VALUE 'to make the text visible.'. - - 03 LINE + 1. - 05 COL 1, PIC X(8) VALUE 'Black' FOREGROUND-COLOR 0 - BACKGROUND-COLOR 7. - 05 COL + 2, PIC X(8) VALUE 'Blue' FOREGROUND-COLOR 1. - 05 COL + 2, PIC X(8) VALUE 'Green' FOREGROUND-COLOR 2. - 05 COL + 2, PIC X(8) VALUE 'Cyan' FOREGROUND-COLOR 3. - 05 COL + 2, PIC X(8) VALUE 'Red' FOREGROUND-COLOR 4. - 05 COL + 2, PIC X(8) VALUE 'Magenta' FOREGROUND-COLOR 5. - 05 COL + 2, PIC X(15) VALUE 'Brown/Yellow' - FOREGROUND-COLOR 6. - 05 COL + 2, PIC X(8) VALUE 'White' FOREGROUND-COLOR 7. - - 03 LINE + 1. - 05 COL 1, PIC X(8) VALUE 'Black' BACKGROUND-COLOR 0 - FOREGROUND-COLOR 7. - 05 COL + 2, PIC X(8) VALUE 'Blue' BACKGROUND-COLOR 1. - 05 COL + 2, PIC X(8) VALUE 'Green' BACKGROUND-COLOR 2. - 05 COL + 2, PIC X(8) VALUE 'Cyan' BACKGROUND-COLOR 3. - 05 COL + 2, PIC X(8) VALUE 'Red' BACKGROUND-COLOR 4. - 05 COL + 2, PIC X(8) VALUE 'Magenta' BACKGROUND-COLOR 5. - 05 COL + 2, PIC X(15) VALUE 'Brown/Yellow' - BACKGROUND-COLOR 6. - 05 COL + 2, PIC X(8) VALUE 'White' BACKGROUND-COLOR 7 - FOREGROUND-COLOR 0. - - 03 success-field LINE + 2, COL 1, PIC X, REQUIRED, - TO success-flag FROM 'Y'. - - PROCEDURE DIVISION. - DISPLAY scr - ACCEPT scr - - IF success AND COB-CRT-STATUS = 0 - GOBACK RETURNING 0 - ELSE - GOBACK RETURNING 1 - END-IF - . -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$RUN_PROG_MANUAL ./prog], [0], [], []) - -AT_CLEANUP - - -AT_SETUP([BEEP]) -AT_KEYWORDS([BELL FLASH]) - -AT_SKIP_IF(test "$COB_HAS_CURSES" != "yes") - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 success-flag PIC X. - 88 success VALUE 'Y', 'y'. - - SCREEN SECTION. - 01 scr. - 03 BELL. - 03 VALUE 'Enter "y" if you heard a beep:'. - 03 success-field PIC X, COL + 2, REQUIRED, TO success-flag - FROM 'Y'. - 01 scr2. - 03 LINE 4 VALUE 'system beep may be turned off ' & - 'on this system.'. - 03 LINE 5 VALUE 'Retesting with COB_BELL=FLASH...'. - 03 LINE + 2, - VALUE 'Enter "y" if you''ve seen your terminal flash'. - 03 success-field PIC X, COL + 2, REQUIRED, TO success-flag - FROM 'Y'. - - PROCEDURE DIVISION. - DISPLAY scr - ACCEPT scr - - IF success AND COB-CRT-STATUS = 0 - GOBACK RETURNING 0 - END-IF - - SET ENVIRONMENT 'COB_BELL' TO 'FLASH' - CALL 'C$SLEEP' USING '1' - - DISPLAY scr2 - DISPLAY ALL X'07' UPON CRT - ACCEPT scr2 - - IF success AND COB-CRT-STATUS = 0 - GOBACK RETURNING 0 - ELSE - GOBACK RETURNING 1 - END-IF - . -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$RUN_PROG_MANUAL ./prog], [0], [], []) - -AT_CLEANUP - - -AT_SETUP([BLANK LINE]) -AT_KEYWORDS([screen]) - -AT_SKIP_IF(test "$COB_HAS_CURSES" != "yes") - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 success-flag PIC X VALUE 'Y'. - 88 success VALUE 'Y', 'y'. - - SCREEN SECTION. - 01 scr-1. - 03 LINE 3 VALUE 'Lorem ipsum dolor sit amet, consectetur ad' - & 'ipiscing elit. Curabitur dapibus dui'. - 03 LINE 4 VALUE 'vitae augue lobortis, non tempor diam tris' - & 'tique. Donec dignissim ex velit, ut'. - 03 LINE 5 VALUE 'efficitur tellus pharetra at. Curabitur at' - & ' condimentum nunc, nec accumsan'. - 03 LINE 6 VALUE 'nulla. Nulla at feugiat elit, eget condime' - & 'ntum justo. Nam lorem lectus,'. - 03 LINE 7 VALUE 'imperdiet sit amet odio eu, eleifend conse' - & 'ctetur ligula. Duis diam felis, porta'. - 03 LINE 8 VALUE 'id diam id, ultrices finibus augue. Mauris' - & ' imperdiet, dolor sed sodales porta,'. - 03 LINE 9 VALUE 'justo nunc consequat nulla, iaculis venena' - & 'tis lorem libero sit amet'. - 03 LINE 10 VALUE 'magna. Nullam pulvinar nullam.'. - 03 success-field LINE + 2, PIC X, REQUIRED, - USING success-flag. - - 01 scr-2. - 03 LINE 6 COL 8 VALUE 'foo' BLANK LINE, HIGHLIGHT. - 03 LINE 1 VALUE 'Enter "y" if foo is the only word on one' - & ' line.'. - - PROCEDURE DIVISION. - DISPLAY scr-1 - DISPLAY scr-2 - ACCEPT success-field - - IF success AND COB-CRT-STATUS = 0 - GOBACK RETURNING 0 - ELSE - GOBACK RETURNING 1 - END-IF - . -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$RUN_PROG_MANUAL ./prog], [0], [], []) - -AT_CLEANUP - - -AT_SETUP([BLANK SCREEN]) -AT_KEYWORDS([screen]) - -AT_SKIP_IF(test "$COB_HAS_CURSES" != "yes") - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 success-flag PIC X VALUE 'Y'. - 88 success VALUE 'Y', 'y'. - - SCREEN SECTION. - 01 scr-1. - 03 LINE 3 VALUE 'Lorem ipsum dolor sit amet, consectetur ad' - & 'ipiscing elit. Curabitur dapibus dui'. - 03 LINE 4 VALUE 'vitae augue lobortis, non tempor diam tris' - & 'tique. Donec dignissim ex velit, ut'. - 03 LINE 5 VALUE 'efficitur tellus pharetra at. Curabitur at' - & ' condimentum nunc, nec accumsan'. - 03 LINE 6 VALUE 'nulla. Nulla at feugiat elit, eget condime' - & 'ntum justo. Nam lorem lectus,'. - 03 LINE 7 VALUE 'imperdiet sit amet odio eu, eleifend conse' - & 'ctetur ligula. Duis diam felis, porta'. - 03 LINE 8 VALUE 'id diam id, ultrices finibus augue. Mauris' - & ' imperdiet, dolor sed sodales porta,'. - 03 LINE 9 VALUE 'justo nunc consequat nulla, iaculis venena' - & 'tis lorem libero sit amet'. - 03 LINE 10 VALUE 'magna. Nullam pulvinar nullam.'. - 03 success-field LINE + 2, PIC X, REQUIRED, - USING success-flag. - - 01 scr-2. - 03 LINE 6 COL 8 VALUE 'foo' BLANK SCREEN, HIGHLIGHT. - 03 LINE 1 VALUE 'Enter "y" if foo is the only word below.'. - - PROCEDURE DIVISION. - DISPLAY scr-1 - DISPLAY scr-2 - ACCEPT success-field - - IF success AND COB-CRT-STATUS = 0 - GOBACK RETURNING 0 - ELSE - GOBACK RETURNING 1 - END-IF - . -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$RUN_PROG_MANUAL ./prog], [0], [], []) - -AT_CLEANUP - - -AT_SETUP([BLANK ignored in ACCEPT]) -AT_KEYWORDS([screen]) - -AT_SKIP_IF(test "$COB_HAS_CURSES" != "yes") - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 success-flag PIC X VALUE 'Y'. - 88 success VALUE 'Y', 'y'. - - SCREEN SECTION. - 01 scr. - 03 LINE 1 VALUE 'Enter "y" if you can see lorem ipsum ' - & 'filler text.'. - 03 LINE 3 COL 3 VALUE 'Lorem ipsum dolor sit amet,' - & ' consectetur ad ipiscing elit.'. - - 01 success-scr. - 03 LINE 3, BLANK LINE, PIC X, REQUIRED, USING success-flag. - - PROCEDURE DIVISION. - DISPLAY scr - ACCEPT success-scr - - IF success AND COB-CRT-STATUS = 0 - GOBACK RETURNING 0 - ELSE - GOBACK RETURNING 1 - END-IF - . -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$RUN_PROG_MANUAL ./prog], [0], [], []) - -AT_CLEANUP - - -AT_SETUP([BLINK]) -AT_KEYWORDS([screen]) - -AT_SKIP_IF(test "$COB_HAS_CURSES" != "yes") - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 success-flag PIC X VALUE 'Y'. - 88 success VALUE 'Y', 'y'. - - SCREEN SECTION. - 01 scr. - 03 PIC X(80) - VALUE 'Enter "y" if the string below is blinking:'. - 03 LINE + 1, PIC X(10) VALUE 'Blink' BLINK. - 03 success-field LINE + 2, PIC X, REQUIRED, - USING success-flag. - - PROCEDURE DIVISION. - DISPLAY scr - ACCEPT scr - - IF success AND COB-CRT-STATUS = 0 - GOBACK RETURNING 0 - ELSE - GOBACK RETURNING 1 - END-IF - . -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$RUN_PROG_MANUAL ./prog], [0], [], []) - -AT_CLEANUP - - -AT_SETUP([ERASE EOS]) -AT_KEYWORDS([screen]) - -AT_SKIP_IF(test "$COB_HAS_CURSES" != "yes") - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 success-flag PIC X VALUE 'Y'. - 88 success VALUE 'Y', 'y'. - - SCREEN SECTION. - 01 scr-1. - 03 LINE 1 VALUE 'Enter "y" if all the text after foo in the' - & ' screen has been erased.'. - 03 LINE 3 VALUE 'Lorem ipsum dolor sit amet, consectetur ad' - & 'ipiscing elit. Curabitur dapibus dui'. - 03 LINE 4 VALUE 'vitae augue lobortis, non tempor diam tris' - & 'tique. Donec dignissim ex velit, ut'. - 03 LINE 5 VALUE 'efficitur tellus pharetra at. Curabitur at' - & ' condimentum nunc, nec accumsan'. - 03 LINE 6 VALUE 'nulla. Nulla at feugiat elit, eget condime' - & 'ntum justo. Nam lorem lectus,'. - 03 LINE 7 VALUE 'imperdiet sit amet odio eu, eleifend conse' - & 'ctetur ligula. Duis diam felis, porta'. - 03 LINE 8 VALUE 'id diam id, ultrices finibus augue. Mauris' - & ' imperdiet, dolor sed sodales porta,'. - 03 LINE 9 VALUE 'justo nunc consequat nulla, iaculis venena' - & 'tis lorem libero sit amet'. - 03 LINE 10 VALUE 'magna. Nullam pulvinar nullam.'. - 03 success-field LINE + 2, PIC X, REQUIRED, - USING success-flag. - - 01 scr-2. - 03 LINE 6 COL 8 VALUE 'foo' ERASE EOS, HIGHLIGHT. - - PROCEDURE DIVISION. - DISPLAY scr-1 - DISPLAY scr-2 - ACCEPT success-field - - IF success AND COB-CRT-STATUS = 0 - GOBACK RETURNING 0 - ELSE - GOBACK RETURNING 1 - END-IF - . -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$RUN_PROG_MANUAL ./prog], [0], [], []) - -AT_CLEANUP - - -AT_SETUP([ERASE EOL]) -AT_KEYWORDS([screen]) - -AT_SKIP_IF(test "$COB_HAS_CURSES" != "yes") - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 success-flag PIC X VALUE 'Y'. - 88 success VALUE 'Y', 'y'. - - SCREEN SECTION. - 01 scr-1. - 03 LINE 1 VALUE 'Enter "y" if all the text after foo on ' - & 'that line alone has been erased.'. - 03 LINE 3 VALUE 'Lorem ipsum dolor sit amet, consectetur ad' - & 'ipiscing elit. Curabitur dapibus dui'. - 03 LINE 4 VALUE 'vitae augue lobortis, non tempor diam tris' - & 'tique. Donec dignissim ex velit, ut'. - 03 LINE 5 VALUE 'efficitur tellus pharetra at. Curabitur at' - & ' condimentum nunc, nec accumsan'. - 03 LINE 6 VALUE 'nulla. Nulla at feugiat elit, eget condime' - & 'ntum justo. Nam lorem lectus,'. - 03 LINE 7 VALUE 'imperdiet sit amet odio eu, eleifend conse' - & 'ctetur ligula. Duis diam felis, porta'. - 03 LINE 8 VALUE 'id diam id, ultrices finibus augue. Mauris' - & ' imperdiet, dolor sed sodales porta,'. - 03 LINE 9 VALUE 'justo nunc consequat nulla, iaculis venena' - & 'tis lorem libero sit amet'. - 03 LINE 10 VALUE 'magna. Nullam pulvinar nullam.'. - 03 success-field LINE + 2, PIC X, REQUIRED, - USING success-flag. - - 01 scr-2. - 03 LINE 6 COL 8 VALUE 'foo' ERASE EOL, HIGHLIGHT. - - PROCEDURE DIVISION. - DISPLAY scr-1 - DISPLAY scr-2 - ACCEPT success-field - - IF success AND COB-CRT-STATUS = 0 - GOBACK RETURNING 0 - ELSE - GOBACK RETURNING 1 - END-IF - . -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$RUN_PROG_MANUAL ./prog], [0], [], []) - -AT_CLEANUP - - -AT_SETUP([ERASE ignored in ACCEPT]) -AT_KEYWORDS([EOS]) - -AT_SKIP_IF(test "$COB_HAS_CURSES" != "yes") - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 success-flag PIC X VALUE 'Y'. - 88 success VALUE 'Y', 'y'. - - SCREEN SECTION. - 01 scr. - 03 LINE 1 VALUE 'Enter "y" if you can see lorem ipsum ' - & 'filler text.'. - 03 LINE 3 VALUE 'Lorem ipsum dolor sit amet, consectetur ad' - & 'ipiscing elit. Curabitur dapibus dui'. - 03 LINE 4 VALUE 'vitae augue lobortis, non tempor diam tris' - & 'tique. Donec dignissim ex velit, ut'. - 03 LINE 5 VALUE 'efficitur tellus pharetra at. Curabitur at' - & ' condimentum nunc, nec accumsan'. - 03 LINE 6 VALUE 'nulla. Nulla at feugiat elit, eget condime' - & 'ntum justo. Nam lorem lectus,'. - 03 LINE 7 VALUE 'imperdiet sit amet odio eu, eleifend conse' - & 'ctetur ligula. Duis diam felis, porta'. - 03 LINE 8 VALUE 'id diam id, ultrices finibus augue. Mauris' - & ' imperdiet, dolor sed sodales porta,'. - 03 LINE 9 VALUE 'justo nunc consequat nulla, iaculis venena' - & 'tis lorem libero sit amet'. - 03 LINE 10 VALUE 'magna. Nullam pulvinar nullam.'. - 03 LINE 3 ERASE EOS. - 03 success-field LINE 12, PIC X, REQUIRED, - USING success-flag. - - PROCEDURE DIVISION. - DISPLAY scr - ACCEPT scr - - IF success AND COB-CRT-STATUS = 0 - GOBACK RETURNING 0 - ELSE - GOBACK RETURNING 1 - END-IF - . -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$RUN_PROG_MANUAL ./prog], [0], [], []) - -AT_CLEANUP - - -AT_SETUP([FULL and REQUIRED]) -AT_KEYWORDS([screen]) - -AT_SKIP_IF(test "$COB_HAS_CURSES" != "yes") - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 dummy PIC X(10). - 01 success-flag PIC X. - 88 success VALUE 'Y', 'y'. - - SCREEN SECTION. - 01 scr. - 03 PIC X(80) - VALUE 'Enter "y" if you cannot continue without filling ' - & 'all of the below field:'. - 03 LINE + 1, PIC X(10), FULL, REQUIRED, TO dummy. - *> no initial value for success as we request input - 03 success-field LINE + 2, PIC X, REQUIRED, TO success-flag. - - PROCEDURE DIVISION. - DISPLAY scr - ACCEPT scr - - IF success AND COB-CRT-STATUS = 0 - GOBACK RETURNING 0 - ELSE - GOBACK RETURNING 1 - END-IF - . -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$RUN_PROG_MANUAL ./prog], [0], [], []) - -AT_CLEANUP - - -AT_SETUP([HIGHLIGHT]) -AT_KEYWORDS([screen]) - -AT_SKIP_IF(test "$COB_HAS_CURSES" != "yes") - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 success-flag PIC X VALUE 'Y'. - 88 success VALUE 'Y', 'y'. - - SCREEN SECTION. - 01 scr. - 03 PIC X(80) - VALUE 'Enter "y" if the text below is bright ' - & '(highlighted):'. - 03 LINE + 1, PIC X(10) VALUE 'Highlight' HIGHLIGHT. - 03 success-field LINE + 2, PIC X, REQUIRED, - USING success-flag. - - PROCEDURE DIVISION. - DISPLAY scr - ACCEPT scr - - IF success AND COB-CRT-STATUS = 0 - GOBACK RETURNING 0 - ELSE - GOBACK RETURNING 1 - END-IF - . -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$RUN_PROG_MANUAL ./prog], [0], [], []) - -AT_CLEANUP - - -AT_SETUP([INITIAL]) -AT_KEYWORDS([screen]) - -AT_SKIP_IF(test "$COB_HAS_CURSES" != "yes") - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 dummy-1 PIC X(10). - 01 dummy-2 PIC X(10). - 01 dummy-3 PIC X(10). - - 01 success-flag PIC X VALUE 'Y'. - 88 success VALUE 'Y', 'y'. - - SCREEN SECTION. - 01 scr. - 03 PIC X(80) VALUE 'Enter "y" if the cursor is initially '- - 'located at the start of the rightmost'. - 03 LINE + 1, PIC X(80) VALUE 'field.'. - 03 LINE + 2, PIC X(10) TO dummy-1. - 03 COL + 2, PIC X(10) TO dummy-2. - 03 COL + 2, PIC X(10) TO dummy-3, INITIAL. - 03 success-field LINE + 2, PIC X, REQUIRED, - USING success-flag. - - PROCEDURE DIVISION. - DISPLAY scr - ACCEPT scr - - IF success AND COB-CRT-STATUS = 0 - GOBACK RETURNING 0 - ELSE - GOBACK RETURNING 1 - END-IF - . -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$RUN_PROG_MANUAL ./prog], [0], [], []) - -AT_CLEANUP - - -AT_SETUP([LEFTLINE]) -AT_KEYWORDS([GRID]) - -AT_SKIP_IF(test "$COB_HAS_CURSES" != "yes") - -# Currently not implemented -AT_XFAIL_IF([true]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 success-flag PIC X VALUE 'Y'. - 88 success VALUE 'Y', 'y'. - - SCREEN SECTION. - 01 scr. - 03 PIC X(80) - VALUE 'Enter "y" if the string has a vertical line to ' - & 'its left:'. - 03 LINE + 1, COL 2, PIC X(10) VALUE 'Leftline' LEFTLINE. - 03 success-field LINE + 2, PIC X, REQUIRED, - USING success-flag. - - PROCEDURE DIVISION. - DISPLAY scr - ACCEPT scr - - IF success AND COB-CRT-STATUS = 0 - GOBACK RETURNING 0 - ELSE - GOBACK RETURNING 1 - END-IF - . -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$RUN_PROG_MANUAL ./prog], [0], [], []) - -AT_CLEANUP - - -AT_SETUP([LOWLIGHT]) -AT_KEYWORDS([screen]) - -AT_SKIP_IF(test "$COB_HAS_CURSES" != "yes") - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 success-flag PIC X VALUE 'Y'. - 88 success VALUE 'Y', 'y'. - - SCREEN SECTION. - 01 scr. - 03 PIC X(80) - VALUE 'Enter "y" if the string below is dim (lowlight):'. - 03 LINE + 1, PIC X(10) VALUE 'Lowlight' LOWLIGHT. - 03 success-field LINE + 2, PIC X, REQUIRED, - USING success-flag. - - PROCEDURE DIVISION. - DISPLAY scr - ACCEPT scr - - IF success AND COB-CRT-STATUS = 0 - GOBACK RETURNING 0 - ELSE - GOBACK RETURNING 1 - END-IF - . -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$RUN_PROG_MANUAL ./prog], [0], [], []) - -AT_CLEANUP - - -AT_SETUP([OVERLINE]) -AT_KEYWORDS([screen]) - -AT_SKIP_IF(test "$COB_HAS_CURSES" != "yes") - -# Currently not implemented -AT_XFAIL_IF([true]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 success-flag PIC X VALUE 'Y'. - 88 success VALUE 'Y', 'y'. - - SCREEN SECTION. - 01 scr. - 03 PIC X(80) - VALUE 'Enter "y" if the string below is overlined:'. - 03 LINE + 1, PIC X(10) VALUE 'Overline' OVERLINE. - 03 success-field LINE + 2, PIC X, REQUIRED, - USING success-flag. - - PROCEDURE DIVISION. - DISPLAY scr - ACCEPT scr - - IF success AND COB-CRT-STATUS = 0 - GOBACK RETURNING 0 - ELSE - GOBACK RETURNING 1 - END-IF - . -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$RUN_PROG_MANUAL ./prog], [0], [], []) - -AT_CLEANUP - - -AT_SETUP([REVERSE-VIDEO]) -AT_KEYWORDS([screen]) - -AT_SKIP_IF(test "$COB_HAS_CURSES" != "yes") - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 success-flag PIC X VALUE 'Y'. - 88 success VALUE 'Y', 'y'. - - SCREEN SECTION. - 01 scr. - 03 PIC X(80) - VALUE 'Enter "y" if the background and foreground ' - & 'colours of the string below have'. - 03 LINE + 1, PIC X(80) VALUE 'swapped:'. - 03 LINE + 1, PIC X(20) VALUE 'Reversed colours' - REVERSE-VIDEO. - 03 success-field LINE + 2, PIC X USING success-flag. - - PROCEDURE DIVISION. - DISPLAY scr - ACCEPT scr - - IF success AND COB-CRT-STATUS = 0 - GOBACK RETURNING 0 - ELSE - GOBACK RETURNING 1 - END-IF - . -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$RUN_PROG_MANUAL ./prog], [0], [], []) - -AT_CLEANUP - - -AT_SETUP([SECURE]) -AT_KEYWORDS([PASSWORD]) - -AT_SKIP_IF(test "$COB_HAS_CURSES" != "yes") - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 dummy PIC X(10). - 01 success-flag PIC X VALUE 'Y'. - 88 success VALUE 'Y', 'y'. - - SCREEN SECTION. - 01 scr. - 03 PIC X(80) - VALUE 'Enter "y" if text in the field below is replaced ' - & 'with asterisks:'. - 03 LINE + 1, PIC X(10) SECURE TO dummy, PROMPT CHARACTER - "-". - 03 success-field LINE + 2, PIC X, REQUIRED, - USING success-flag. - - PROCEDURE DIVISION. - DISPLAY scr - ACCEPT scr - - IF success AND COB-CRT-STATUS = 0 - GOBACK RETURNING 0 - ELSE - GOBACK RETURNING 1 - END-IF - . -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$RUN_PROG_MANUAL ./prog], [0], [], []) - -AT_CLEANUP - - -AT_SETUP([SIZE with items]) -AT_KEYWORDS([PROTECTED extensions]) - -AT_SKIP_IF(test "$COB_HAS_CURSES" != "yes") - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 success-flag PIC X VALUE 'Y'. - 88 success VALUE 'Y', 'y'. - - 01 num-1 PIC 9(5) VALUE 12345. - 01 num-2 PIC X(10) VALUE '12345'. - 01 num-3 PIC 9(4) VALUE 1234. - - 01 four PIC 9 VALUE 4. - - PROCEDURE DIVISION. - DISPLAY 'Enter "y" if you see exactly four rows of 1234, all' - & ' aligned.' LINE 1 - - DISPLAY num-1 LINE 3 COL 3, SIZE 4; - num-2 LINE 4 COL 3, SIZE four; - num-3 LINE 5 COL 3, SIZE 8; - '1234' LINE 6 COL 3, SIZE ZERO - - ACCEPT success-flag LINE 8, REQUIRED UPDATE - - IF success AND COB-CRT-STATUS = 0 - GOBACK RETURNING 0 - ELSE - GOBACK RETURNING 1 - END-IF - . -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$RUN_PROG_MANUAL ./prog], [0], [], []) - -AT_CLEANUP - - -AT_SETUP([SIZE with figurative constants]) -AT_KEYWORDS([PROTECTED extensions]) - -AT_SKIP_IF(test "$COB_HAS_CURSES" != "yes") - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 success-flag PIC X VALUE 'Y'. - 88 success VALUE 'Y', 'y'. - - PROCEDURE DIVISION. - DISPLAY 'Enter "y" if you see exactly three rows of quotes, ' - & 'zeroes and ''abc'',', LINE 1 - DISPLAY '8 characters long, all aligned.', LINE 2 - - DISPLAY QUOTES LINE 4 COL 3, SIZE 8; - ZEROES LINE 5 COL 3, SIZE 8; - ALL 'abc' LINE 6 COL 3, SIZE 8 - - DISPLAY '123456789' LINE 7 COL 3 - DISPLAY SPACE LINE 7 COL 3, SIZE 9 - - ACCEPT success-flag LINE 8, REQUIRED UPDATE - - IF success AND COB-CRT-STATUS = 0 - GOBACK RETURNING 0 - ELSE - GOBACK RETURNING 1 - END-IF - . -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$RUN_PROG_MANUAL ./prog], [0], [], []) - -AT_CLEANUP - - -AT_SETUP([UPDATE]) -AT_KEYWORDS([extensions]) - -AT_SKIP_IF(test "$COB_HAS_CURSES" != "yes") - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 n-str PIC X(12) VALUE SPACES. - 01 success-flag PIC X. - 88 success VALUE 'Y', 'y'. - - SCREEN SECTION. - 01 scr. - 03 VALUE 'Enter "y" if the entry field below is filled with' - & ' N''s'. - 03 n-field, LINE + 1, PIC X(12) USING n-str. - 03 success-field, LINE + 2, PIC X, REQUIRED, - TO success-flag, FROM 'Y'. - - PROCEDURE DIVISION. - DISPLAY scr - MOVE ALL 'N' TO n-str - ACCEPT scr - - IF success AND COB-CRT-STATUS = 0 - GOBACK RETURNING 0 - ELSE - GOBACK RETURNING 1 - END-IF - . -]) - -AT_CHECK([$COMPILE -fno-accept-update prog.cob], [0], [], []) -AT_CHECK([$RUN_PROG_MANUAL ./prog], [0], [], []) - -AT_CLEANUP - - -AT_SETUP([UNDERLINE]) -AT_KEYWORDS([screen]) - -AT_SKIP_IF(test "$COB_HAS_CURSES" != "yes") - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 success-flag PIC X VALUE 'Y'. - 88 success VALUE 'Y', 'y'. - - SCREEN SECTION. - 01 scr. - 03 PIC X(80) - VALUE 'Enter "y" if the string below is underlined:'. - 03 LINE + 1, PIC X(10) VALUE 'Underline' UNDERLINE. - 03 success-field LINE + 2, PIC X, REQUIRED, - USING success-flag. - - PROCEDURE DIVISION. - DISPLAY scr - ACCEPT scr - - IF success AND COB-CRT-STATUS = 0 - GOBACK RETURNING 0 - ELSE - GOBACK RETURNING 1 - END-IF - . -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$RUN_PROG_MANUAL ./prog], [0], [], []) - -AT_CLEANUP - - -AT_SETUP([HOME key]) -AT_KEYWORDS([HOME SIZE]) - -AT_SKIP_IF(test "$COB_HAS_CURSES" != "yes") - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 success-flag PIC X VALUE 'Y'. - 88 success VALUE 'Y', 'y'. - 01 ws-x-20 PIC X(20). - PROCEDURE DIVISION. - DISPLAY "Enter 'y' if multiple presses of the HOME key" - LINE 1 COLUMN 1. - DISPLAY "go to the beginning of the field and the beginning" - LINE 2 COLUMN 1. - DISPLAY "of the characters." - LINE 3 COLUMN 1. - - MOVE " ABC " TO WS-X-20. - ACCEPT WS-X-20 - LINE 5 COLUMN 1 - WITH - AUTO-SKIP - SIZE 10 - UPDATE. - - ACCEPT SUCCESS-FLAG - LINE 7 COLUMN 1 - WITH UPDATE. - - IF success AND COB-CRT-STATUS = 0 - GOBACK RETURNING 0 - ELSE - GOBACK RETURNING 1 - END-IF - . -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$RUN_PROG_MANUAL ./prog], [0], [], []) - -AT_CLEANUP - - -AT_SETUP([END key]) -AT_KEYWORDS([END SIZE]) - -AT_SKIP_IF(test "$COB_HAS_CURSES" != "yes") - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 success-flag PIC X VALUE 'Y'. - 88 success VALUE 'Y', 'y'. - 01 ws-x-20 PIC X(20). - PROCEDURE DIVISION. - DISPLAY "Enter 'y' if multiple presses of the END key" - LINE 1 COLUMN 1. - DISPLAY "go to the end of the field and just after the end" - LINE 2 COLUMN 1. - DISPLAY "of the characters." - LINE 3 COLUMN 1. - - MOVE " ABC " TO WS-X-20. - ACCEPT WS-X-20 - LINE 5 COLUMN 1 - WITH - AUTO-SKIP - SIZE 10 - UPDATE. - - ACCEPT SUCCESS-FLAG - LINE 7 COLUMN 1 - WITH UPDATE. - - IF success AND COB-CRT-STATUS = 0 - GOBACK RETURNING 0 - ELSE - GOBACK RETURNING 1 - END-IF - . -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$RUN_PROG_MANUAL ./prog], [0], [], []) - -AT_CLEANUP - - -AT_SETUP([INSERT key]) -AT_KEYWORDS([INSERT SIZE]) - -AT_SKIP_IF(test "$COB_HAS_CURSES" != "yes") - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 success-flag PIC X VALUE 'Y'. - 88 success VALUE 'Y', 'y'. - 01 ws-x-20 PIC X(20). - PROCEDURE DIVISION. - DISPLAY "Enter 'y' if multiple presses of the INSERT key" - LINE 1 COLUMN 1. - DISPLAY "go back and forth between" - LINE 2 COLUMN 1. - DISPLAY "Insert Mode ON (characters move to the right)" - LINE 3 COLUMN 1. - DISPLAY "and Insert Mode OFF (characters type over)." - LINE 4 COLUMN 1. - - MOVE "ABCD " TO WS-X-20. - ACCEPT WS-X-20 - LINE 6 COLUMN 1 - WITH - AUTO-SKIP - SIZE 10 - UPDATE. - - ACCEPT SUCCESS-FLAG - LINE 8 COLUMN 1 - WITH UPDATE. - - IF success AND COB-CRT-STATUS = 0 - GOBACK RETURNING 0 - ELSE - GOBACK RETURNING 1 - END-IF - . -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$RUN_PROG_MANUAL ./prog], [0], [], []) - -AT_CLEANUP - - -AT_SETUP([BACKSPACE key]) -AT_KEYWORDS([BACKSPACE SIZE]) - -AT_SKIP_IF(test "$COB_HAS_CURSES" != "yes") - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 success-flag PIC X VALUE 'Y'. - 88 success VALUE 'Y', 'y'. - 01 ws-x-20 PIC X(20). - PROCEDURE DIVISION. - DISPLAY "Enter 'y' if each press of the BACKSPACE key" - LINE 1 COLUMN 1. - DISPLAY "deletes the character to the left and moves the" - LINE 2 COLUMN 1. - DISPLAY "cursor and remaining characters one space to the" - LINE 3 COLUMN 1. - DISPLAY "left." - LINE 4 COLUMN 1. - - MOVE "ABCD " TO WS-X-20. - ACCEPT WS-X-20 - LINE 6 COLUMN 1 - WITH - AUTO-SKIP - SIZE 10 - UPDATE. - - ACCEPT SUCCESS-FLAG - LINE 8 COLUMN 1 - WITH UPDATE. - - IF success AND COB-CRT-STATUS = 0 - GOBACK RETURNING 0 - ELSE - GOBACK RETURNING 1 - END-IF - . -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$RUN_PROG_MANUAL ./prog], [0], [], []) - -AT_CLEANUP - - -AT_SETUP([DELETE key]) -AT_KEYWORDS([DELETE SIZE]) - -AT_SKIP_IF(test "$COB_HAS_CURSES" != "yes") - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 success-flag PIC X VALUE 'Y'. - 88 success VALUE 'Y', 'y'. - 01 ws-x-20 PIC X(20). - PROCEDURE DIVISION. - DISPLAY "Enter 'y' if each press of the DELETE key deletes" - LINE 1 COLUMN 1. - DISPLAY "the cursor character and moves the remaining" - LINE 2 COLUMN 1. - DISPLAY "characters one space to the left. And the cursor" - LINE 3 COLUMN 1. - DISPLAY "does not move." - LINE 4 COLUMN 1. - - MOVE "ABCD " TO WS-X-20. - ACCEPT WS-X-20 - LINE 6 COLUMN 1 - WITH - AUTO-SKIP - SIZE 10 - UPDATE. - - ACCEPT SUCCESS-FLAG - LINE 8 COLUMN 1 - WITH UPDATE. - - IF success AND COB-CRT-STATUS = 0 - GOBACK RETURNING 0 - ELSE - GOBACK RETURNING 1 - END-IF - . -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$RUN_PROG_MANUAL ./prog], [0], [], []) - -AT_CLEANUP - - -AT_SETUP([ALT DELETE key]) -AT_KEYWORDS([ALT-DELETE SIZE]) - -AT_SKIP_IF(test "$COB_HAS_CURSES" != "yes") - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 success-flag PIC X VALUE 'Y'. - 88 success VALUE 'Y', 'y'. - 01 ws-x-20 PIC X(20). - PROCEDURE DIVISION. - DISPLAY "Enter 'y' if pressing the ALT and DELETE keys" - LINE 1 COLUMN 1. - DISPLAY "deletes all characters from the cursor to the end" - LINE 2 COLUMN 1. - DISPLAY "of the field. And the cursor does not move." - LINE 3 COLUMN 1. - - MOVE "ABCD " TO WS-X-20. - ACCEPT WS-X-20 - LINE 5 COLUMN 1 - WITH - AUTO-SKIP - SIZE 10 - UPDATE. - - ACCEPT SUCCESS-FLAG - LINE 7 COLUMN 1 - WITH UPDATE. - - IF success AND COB-CRT-STATUS = 0 - GOBACK RETURNING 0 - ELSE - GOBACK RETURNING 1 - END-IF - . -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$RUN_PROG_MANUAL ./prog], [0], [], []) - -AT_CLEANUP - - -AT_SETUP([ALT LEFT-ARROW key]) -AT_KEYWORDS([ALT-LEFT-ARROW SIZE]) - -AT_SKIP_IF(test "$COB_HAS_CURSES" != "yes") - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 success-flag PIC X VALUE 'Y'. - 88 success VALUE 'Y', 'y'. - 01 ws-x-20 PIC X(20). - PROCEDURE DIVISION. - DISPLAY "Enter 'y' if pressing the ALT and LEFT-ARROW keys" - LINE 1 COLUMN 1. - DISPLAY "at the first column does not exit the field." - LINE 2 COLUMN 1. - DISPLAY "But the LEFT-ARROW without ALT does exit." - LINE 3 COLUMN 1. - - MOVE "ABCD " TO WS-X-20. - ACCEPT WS-X-20 - LINE 5 COLUMN 1 - WITH - AUTO-SKIP - SIZE 10 - UPDATE. - - ACCEPT SUCCESS-FLAG - LINE 7 COLUMN 1 - WITH UPDATE. - - IF success AND COB-CRT-STATUS = 0 - GOBACK RETURNING 0 - ELSE - GOBACK RETURNING 1 - END-IF - . -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$RUN_PROG_MANUAL ./prog], [0], [], []) - -AT_CLEANUP - - -AT_SETUP([ALT RIGHT-ARROW key]) -AT_KEYWORDS([SIZE]) - -AT_SKIP_IF(test "$COB_HAS_CURSES" != "yes") - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 success-flag PIC X VALUE 'Y'. - 88 success VALUE 'Y', 'y'. - 01 ws-x-10 PIC X(10). - PROCEDURE DIVISION. - DISPLAY "Enter 'y' if pressing the ALT and RIGHT-ARROW keys" - LINE 1 COLUMN 1. - DISPLAY "at the last column does not exit the field." - LINE 2 COLUMN 1. - DISPLAY "But the RIGHT-ARROW without ALT does exit." - LINE 3 COLUMN 1. - - MOVE "ABCDE" TO WS-X-10. - ACCEPT WS-X-10 - LINE 5 COLUMN 1 - WITH - AUTO-SKIP - SIZE 5 - UPDATE. - - ACCEPT SUCCESS-FLAG - LINE 7 COLUMN 1 - WITH UPDATE. - - IF success AND COB-CRT-STATUS = 0 - GOBACK RETURNING 0 - ELSE - GOBACK RETURNING 1 - END-IF - . -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$RUN_PROG_MANUAL ./prog], [0], [], []) - -AT_CLEANUP - - -AT_SETUP([CURSOR clause]) -AT_KEYWORDS([SPECIAL-NAMES]) - -AT_SKIP_IF(test "$COB_HAS_CURSES" != "yes") - -AT_DATA([prog1.cob], [ - identification division. - program-id. prog. - - environment division. - configuration section. - special-names. - cursor is my-cur. - data division. - working-storage section. - - 01 my-cur. - 05 my-row pic 9(3) value 0. - 05 my-col pic 9(3) value 0. - - 77 loop pic 99. - 77 cursor-moves-here pic x(20). - - screen section. - - 01 screen-example . - 05 message1 value is "row (view only) is " line 1 col 10. - 05 filler from my-row. - - 05 message2 value is "col (adjust only) is " line 2 col 10. - 05 filler using my-col. - - 05 filler using cursor-moves-here line 3 col 14. - - procedure division. - - perform varying loop from 1 by 1 - until loop > 10 - display "screen accept no. " - at line 10 col 4 - loop "/10" - display screen-example - accept screen-example - end-perform - - goback. -]) - -AT_DATA([prog2.cob], [ - identification division. - program-id. prog. - - data division. - working-storage section. - - 01 my-cur is special-names cursor. - 05 my-row pic 9(3) value 0. - 05 my-col pic 9(3) value 0. - - 77 loop pic 99. - 77 cursor-moves-here pic x(20). - - screen section. - - 01 screen-example . - 05 message1 value is "row (view only) is " line 1 col 10. - 05 filler from my-row. - - 05 message2 value is "col (adjust only) is " line 2 col 10. - 05 filler using my-col. - - 05 filler using cursor-moves-here line 3 col 14. - - procedure division. - - perform varying loop from 1 by 1 - until loop > 10 - display "screen accept no. " - at line 10 col 4 - loop "/10" - display screen-example - accept screen-example - end-perform - - goback. -]) - -AT_CHECK([$COMPILE prog1.cob], [0], [], []) -AT_CHECK([$COMPILE prog2.cob], [0], [], []) - -# user-instructions what to test is missing -AT_SKIP_IF(true) - -AT_CHECK([$RUN_PROG_MANUAL ./prog1], [0], [], []) -AT_CHECK([$RUN_PROG_MANUAL ./prog2], [0], [], []) - -AT_CLEANUP - - -AT_SETUP([CRT STATUS clause]) -AT_KEYWORDS([SPECIAL-NAMES]) - -AT_SKIP_IF(test "$COB_HAS_CURSES" != "yes") - -AT_DATA([prog1.cob], [ - identification division. - program-id. prog. - - environment division. - configuration section. - special-names. - crt status is my-status. - data division. - working-storage section. - - 01 my-status. - 05 one pic X. - 05 two pic X. - 05 three pic X. - 05 four pic X. - - 77 loop pic 99. - 77 test-field pic x(5). - - screen section. - - 01 screen-example . - 05 message1 value is "status: " line 1 col 10. - 05 filler from my-status. - - 05 message2 value is "test-field: " line 2 col 10. - 05 filler using test-field. - - procedure division. - - set environment 'COB_SCREEN_EXCEPTIONS' to 'TRUE' - set environment 'COB_SCREEN_ESC' to 'TRUE' - perform varying loop from 1 by 1 - until loop > 10 - display "screen accept no. " - at line 10 col 4 - loop "/10" - display screen-example - accept screen-example - end-perform - - goback. -]) - -AT_DATA([prog2.cob], [ - identification division. - program-id. prog. - - data division. - working-storage section. - - 77 my-status pic 9(05) is special-names crt status. - - 77 loop pic 99. - 77 test-field pic x(5). - - screen section. - - 01 screen-example . - 05 message1 value is "status: " line 1 col 10. - 05 filler from my-status. - - 05 message2 value is "test-field: " line 2 col 10. - 05 filler using test-field. - - procedure division. - - set environment 'COB_SCREEN_EXCEPTIONS' to 'TRUE' - set environment 'COB_SCREEN_ESC' to 'TRUE' - perform varying loop from 1 by 1 - until loop > 10 - display "screen accept no. " - at line 10 col 4 - loop "/10" - display screen-example - accept screen-example - end-perform - - goback. -]) - -AT_CHECK([$COMPILE prog1.cob], [0], [], []) -AT_CHECK([$COMPILE prog2.cob], [0], [], []) - -# user-instructions what to test is missing -AT_SKIP_IF(true) - -AT_CHECK([$RUN_PROG_MANUAL ./prog1], [0], [], []) -AT_CHECK([$RUN_PROG_MANUAL ./prog2], [0], [], []) - -AT_CLEANUP - diff -Nru gnucobol-4.0~early~20200606/tests/testsuite.src/run_misc.at gnucobol-5/tests/testsuite.src/run_misc.at --- gnucobol-4.0~early~20200606/tests/testsuite.src/run_misc.at 2020-06-06 20:52:00.000000000 +0000 +++ gnucobol-5/tests/testsuite.src/run_misc.at 1970-01-01 00:00:00.000000000 +0000 @@ -1,13882 +0,0 @@ -## Copyright (C) 2003-2012, 2014-2020 Free Software Foundation, Inc. -## Written by Keisuke Nishida, Roger While, Simon Sobisch, Edward Hart, -## Ron Norman -## -## This file is part of GnuCOBOL. -## -## The GnuCOBOL compiler is free software: you can redistribute it -## and/or modify it under the terms of the GNU General Public License -## as published by the Free Software Foundation, either version 3 of the -## License, or (at your option) any later version. -## -## GnuCOBOL is distributed in the hope that it will be useful, -## but WITHOUT ANY WARRANTY; without even the implied warranty of -## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -## GNU General Public License for more details. -## -## You should have received a copy of the GNU General Public License -## along with GnuCOBOL. If not, see . - -### GnuCOBOL Test Suite - - -AT_SETUP([Comma separator without space]) -AT_KEYWORDS([runmisc]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - PROCEDURE DIVISION. - DISPLAY 1,1,1 NO ADVANCING - END-DISPLAY. - STOP RUN. -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [111]) - -AT_CLEANUP - - -## TODO: Check if the following DECIMAL-POINT tests are really all extensions. - - -AT_SETUP([DECIMAL-POINT is COMMA (1)]) -AT_KEYWORDS([misc extensions]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - CONFIGURATION SECTION. - SPECIAL-NAMES. - DECIMAL-POINT IS COMMA. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 X PIC 99V99. - PROCEDURE DIVISION. - MOVE FUNCTION MIN (3,,,,,,5) TO X. - DISPLAY X - END-DISPLAY. - STOP RUN. -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], -[00,50 -]) - -AT_CLEANUP - - -AT_SETUP([DECIMAL-POINT is COMMA (2)]) -AT_KEYWORDS([misc extensions]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - CONFIGURATION SECTION. - SPECIAL-NAMES. - DECIMAL-POINT IS COMMA. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 X PIC 99V99. - PROCEDURE DIVISION. - MOVE FUNCTION MIN (3,,,,,, 5) TO X. - DISPLAY X - END-DISPLAY. - STOP RUN. -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], -[03,00 -]) - -AT_CLEANUP - - -AT_SETUP([DECIMAL-POINT is COMMA (3)]) -AT_KEYWORDS([misc extensions]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - CONFIGURATION SECTION. - SPECIAL-NAMES. - DECIMAL-POINT IS COMMA. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 X PIC 99V99. - PROCEDURE DIVISION. - MOVE FUNCTION MIN (3,,,,,, 1,5) TO X. - DISPLAY X - END-DISPLAY. - STOP RUN. -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], -[01,50 -]) - -AT_CLEANUP - - -AT_SETUP([DECIMAL-POINT is COMMA (4)]) -AT_KEYWORDS([misc extensions]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - CONFIGURATION SECTION. - SPECIAL-NAMES. - DECIMAL-POINT IS COMMA. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 X PIC 99V99. - PROCEDURE DIVISION. - MOVE FUNCTION MIN (3,,,,,,1,5) TO X. - DISPLAY X - END-DISPLAY. - STOP RUN. -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], -[00,10 -]) - -AT_CLEANUP - - -AT_SETUP([DECIMAL-POINT is COMMA (5)]) -AT_KEYWORDS([misc extensions]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - CONFIGURATION SECTION. - SPECIAL-NAMES. - DECIMAL-POINT IS COMMA. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 X PIC 99V99. - PROCEDURE DIVISION. - COMPUTE X=1 + ,1 - END-COMPUTE - DISPLAY X - END-DISPLAY. - COMPUTE X=1*,1 - END-COMPUTE - DISPLAY X - END-DISPLAY. - STOP RUN. -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], -[01,10 -00,10 -]) - -AT_CLEANUP - - -AT_SETUP([CURRENCY SIGN]) -AT_KEYWORDS([misc fundamental]) - -AT_DATA([prog.cob], [ - PROGRAM-ID. prog. - - ENVIRONMENT DIVISION. - CONFIGURATION SECTION. - SPECIAL-NAMES. - CURRENCY SIGN IS "Y". - - DATA DIVISION. - WORKING-STORAGE SECTION. - 77 amount pic Y(6)9.99. - - PROCEDURE DIVISION. - Move 1512.34 to Amount - Display "Amount is #" Amount '#' with no advancing. - - GOBACK - . - END PROGRAM prog. -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], -[Amount is # Y1512.34#]) - -AT_CLEANUP - - -AT_SETUP([CURRENCY SIGN WITH PICTURE SYMBOL]) -AT_KEYWORDS([misc fundamental]) - -# FIXME - see FR #246 -AT_XFAIL_IF(true) - -AT_DATA([prog.cob], [ - PROGRAM-ID. prog. - - ENVIRONMENT DIVISION. - CONFIGURATION SECTION. - SPECIAL-NAMES. - *> note the space after EUR / before ct. - CURRENCY SIGN IS "EUR " WITH PICTURE SYMBOL "U", - CURRENCY SIGN IS " ct (EUR)" WITH PICTURE SYMBOL "c", - Currency Sign is "$US" with Picture Symbol "$". - - DATA DIVISION. - WORKING-STORAGE SECTION. - 77 EUROS PIC U99v99. - 77 cents PIC c9,999. - 77 DOLLARS Pic $$,$$9.99. - - PROCEDURE DIVISION. - MOVE 12.34 TO EUROS - MULTIPLY euros BY 1000 GIVING cents. - DISPLAY "#" EUROS "# equal #" cents '#'. - Move 1500 to Invoice-Amount - Display "Invoice amount #1 is " Invoice-Amount '.'. - Move 12.34 to Invoice-Amount - Display "Invoice amount #2 is " Invoice-Amount '.'. - - GOBACK - . - END PROGRAM prog. -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], -[#EUR 12.34# equal #1,234 ct (EUR)# -Invoice amount #1 is $US1,500.00. -Invoice amount #2 is $US12.34. -]) - -AT_CLEANUP - - -AT_SETUP([LOCAL-STORAGE (1)]) -AT_KEYWORDS([runmisc]) - -AT_DATA([callee.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. callee. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 WRK-X PIC XXX VALUE "abc". - LOCAL-STORAGE SECTION. - 01 LCL-X PIC XXX VALUE "abc". - PROCEDURE DIVISION. - DISPLAY WRK-X LCL-X NO ADVANCING - END-DISPLAY. - MOVE ZERO TO WRK-X LCL-X. - EXIT PROGRAM. -]) - -AT_DATA([caller.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. caller. - PROCEDURE DIVISION. - CALL "callee" - END-CALL. - CALL "callee" - END-CALL. - STOP RUN. -]) - -AT_CHECK([$COMPILE_MODULE callee.cob], [0], [], []) -AT_CHECK([$COMPILE -o prog caller.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [abcabc000abc], []) - -AT_CLEANUP - - -AT_SETUP([LOCAL-STORAGE (2)]) -AT_KEYWORDS([runmisc]) - -AT_DATA([callee2.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. callee2. - DATA DIVISION. - LINKAGE SECTION. - 01 LNK-X PIC XXX. - PROCEDURE DIVISION USING LNK-X. - DISPLAY LNK-X NO ADVANCING - END-DISPLAY. - EXIT PROGRAM. -]) - -AT_DATA([callee.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. callee. - DATA DIVISION. - LOCAL-STORAGE SECTION. - 01 LCL-X. - 05 FILLER PIC XXX VALUE "abc". - PROCEDURE DIVISION. - CALL "callee2" USING LCL-X - END-CALL. - MOVE ZERO TO LCL-X. - CALL "callee2" USING LCL-X - END-CALL. - EXIT PROGRAM. -]) - -AT_DATA([caller.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. caller. - PROCEDURE DIVISION. - CALL "callee" - END-CALL. - STOP RUN. -]) - -AT_CHECK([$COMPILE_MODULE callee2.cob], [0], [], []) -AT_CHECK([$COMPILE_MODULE callee.cob], [0], [], []) -AT_CHECK([$COMPILE -o prog caller.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [abc000], []) - -AT_CLEANUP - - -AT_SETUP([EXTERNAL data item]) -AT_KEYWORDS([runmisc]) - -AT_DATA([callee.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. callee. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 EXT-VAR PIC X(5) EXTERNAL. - PROCEDURE DIVISION. - IF EXT-VAR NOT = "Hello" - DISPLAY EXT-VAR - END-DISPLAY - END-IF. - MOVE "World" TO EXT-VAR. - EXIT PROGRAM. -]) - -AT_DATA([caller.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. caller. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 EXT-VAR PIC X(5) EXTERNAL. - PROCEDURE DIVISION. - MOVE "Hello" TO EXT-VAR. - CALL "callee" - END-CALL. - IF EXT-VAR NOT = "World" - DISPLAY EXT-VAR - END-DISPLAY - END-IF. - STOP RUN. -]) - -AT_CHECK([$COMPILE_MODULE callee.cob], [0], [], []) -AT_CHECK([$COMPILE caller.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./caller], [0], [], []) - -AT_CLEANUP - - -AT_SETUP([EXTERNAL AS data item]) -AT_KEYWORDS([runmisc]) - -AT_DATA([callee.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. callee. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 PRG-VAR PIC X(5) EXTERNAL AS "WRK-VAR". - 01 EXT-VAR PIC X(5) EXTERNAL. - PROCEDURE DIVISION. - IF PRG-VAR NOT = "Extrn" - DISPLAY PRG-VAR - END-DISPLAY - END-IF. - IF EXT-VAR NOT = "Hello" - DISPLAY EXT-VAR - END-DISPLAY - END-IF. - MOVE "World" TO EXT-VAR. - EXIT PROGRAM. -]) - -AT_DATA([caller.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. caller. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 MYVAR PIC X(5) EXTERNAL AS "EXT-VAR". - 01 WRK-VAR PIC X(5) EXTERNAL. - PROCEDURE DIVISION. - MOVE "Extrn" TO WRK-VAR. - MOVE "Hello" TO MYVAR. - CALL "callee" - END-CALL. - IF MYVAR NOT = "World" - DISPLAY MYVAR - END-DISPLAY - END-IF. - STOP RUN. -]) - -AT_CHECK([$COMPILE_MODULE callee.cob], [0], [], []) -AT_CHECK([$COMPILE caller.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./caller], [0], [], []) - -AT_CLEANUP - - -AT_SETUP([EXTERNAL data item size mismatch]) -AT_KEYWORDS([runmisc]) - -# FIXME - see Bug #445 -AT_XFAIL_IF(true) - -AT_DATA([callee.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. callee. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 PRG-VAR PIC X(8) EXTERNAL AS "WRK-VAR". - 01 COB-VAR PIC X(8) EXTERNAL. - 01 EXT-VAR PIC X(8) EXTERNAL. - PROCEDURE DIVISION. - IF PRG-VAR NOT = "Extrn" - DISPLAY PRG-VAR - END-DISPLAY - END-IF. - IF EXT-VAR NOT = "Hello" - DISPLAY EXT-VAR - END-DISPLAY - END-IF. - MOVE "World" TO EXT-VAR. - EXIT PROGRAM. -]) - -AT_DATA([bigger.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. error. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 MYVAR PIC X(10) EXTERNAL AS "COB-VAR". - 01 WRK-VAR PIC X(10) EXTERNAL. - 01 EXT-VAR PIC X(10) EXTERNAL. - PROCEDURE DIVISION. - MOVE "Extrn" TO WRK-VAR. - MOVE "Hello" TO MYVAR. - CALL "callee" - END-CALL. - IF MYVAR NOT = "World" - DISPLAY MYVAR - END-DISPLAY - END-IF. - STOP RUN. -]) - -AT_DATA([smaller.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. error. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 MYVAR PIC X(5) EXTERNAL AS "COB-VAR". - 01 WRK-VAR PIC X(5) EXTERNAL. - 01 EXT-VAR PIC X(5) EXTERNAL. - PROCEDURE DIVISION. - MOVE "Extrn" TO WRK-VAR. - MOVE "Hello" TO MYVAR. - CALL "callee" - END-CALL. - IF MYVAR NOT = "World" - DISPLAY MYVAR - END-DISPLAY - END-IF. - STOP RUN. -]) - -AT_CHECK([$COMPILE_MODULE callee.cob], [0], [], []) -AT_CHECK([$COMPILE bigger.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./bigger], [0], [], -[libcob: callee.cob:6: warning: EXTERNAL item 'WRK-VAR' previously allocated with size 10, requested size is 8 -libcob: callee.cob:7: warning: EXTERNAL item 'EXT-VAR' previously allocated with size 10, requested size is 8 -libcob: callee.cob:8: warning: EXTERNAL item 'EXT-VAR' previously allocated with size 10, requested size is 8 -]) - -AT_CHECK([$COMPILE smaller.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./smaller], [1], [], -[libcob: callee.cob:6: error: EXTERNAL item 'WRK-VAR' previously allocated with size 5, requested size is 8 -]) - -AT_CLEANUP - - -## MOVE statement - -AT_SETUP([MOVE to itself]) -AT_KEYWORDS([runmisc]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 X PIC 99 VALUE 12. - PROCEDURE DIVISION. - MOVE X TO X. - IF X NOT = 12 - DISPLAY X NO ADVANCING - END-DISPLAY - END-IF. - STOP RUN. -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], -[prog.cob:8: warning: overlapping MOVE may produce unpredictable results -]) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [], []) - -AT_CLEANUP - - -AT_SETUP([MOVE with refmod]) -AT_KEYWORDS([runmisc]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 X PIC 9(4) VALUE 0. - PROCEDURE DIVISION. - MOVE "1" TO X(1:1). - IF X NOT = 1000 - DISPLAY X NO ADVANCING - END-DISPLAY - END-IF. - STOP RUN. -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [], []) - -AT_CLEANUP - - -AT_SETUP([MOVE with refmod (variable)]) -AT_KEYWORDS([runmisc]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 X PIC X(4) VALUE "1234". - 01 Y PIC X(4) VALUE "abcd". - 01 I PIC 9 VALUE 1. - PROCEDURE DIVISION. - MOVE X(1:I) TO Y. - IF Y NOT = "1 " - DISPLAY Y NO ADVANCING - END-DISPLAY - END-IF. - STOP RUN. -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [], []) - -AT_CLEANUP - - -AT_SETUP([MOVE with group refmod]) -AT_KEYWORDS([runmisc]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 G. - 02 X PIC 9999 VALUE 1234. - PROCEDURE DIVISION. - MOVE "99" TO G(3:2). - IF G NOT = "1299" - DISPLAY G NO ADVANCING - END-DISPLAY - END-IF. - STOP RUN. -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [], []) - -AT_CLEANUP - - -AT_SETUP([MOVE indexes]) -AT_KEYWORDS([runmisc]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 G. - 02 X PIC X OCCURS 10 INDEXED I. - PROCEDURE DIVISION. - SET I TO ZERO. - MOVE I TO X(1). - IF X(1) NOT = "0" - DISPLAY X(1) NO ADVANCING - END-DISPLAY - END-IF. - STOP RUN. -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [], []) - -AT_CLEANUP - - -AT_SETUP([MOVE X'00']) -AT_KEYWORDS([runmisc]) - -AT_DATA([dump.c], [ -#include -#include - -COB_EXT_EXPORT int -dump (unsigned char *data) -{ - printf ("%02x%02x%02x", data[[0]], data[[1]], data[[2]]); - return 0; -} -]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 X PIC XXX. - PROCEDURE DIVISION. - MOVE X"000102" TO X. - CALL "dump" USING X - END-CALL. - STOP RUN. -]) - -AT_CHECK([$COMPILE_MODULE dump.c], [0], [], []) -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [000102]) - -AT_CLEANUP - - -AT_SETUP([MOVE Z'literal']) -AT_KEYWORDS([runmisc literal]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 X PIC XXXX. - 01 XRED REDEFINES X. - 03 XBYTE1 PIC X. - 03 XBYTE2 PIC X. - 03 XBYTE3 PIC X. - 03 XBYTE4 PIC X. - PROCEDURE DIVISION. - MOVE Z"012" TO X. - IF XBYTE1 = "0" AND - XBYTE2 = "1" AND - XBYTE3 = "2" AND - XBYTE4 = LOW-VALUE - DISPLAY "OK" NO ADVANCING - END-DISPLAY - ELSE - DISPLAY "X = " X (1:3) NO ADVANCING - END-DISPLAY - IF XBYTE4 = LOW-VALUE - DISPLAY " WITH LOW-VALUE" - END-DISPLAY - ELSE - DISPLAY " WITHOUT LOW-VALUE BUT '" XBYTE4 "'" - END-DISPLAY - END-IF - END-IF. - STOP RUN. -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [OK], []) - -AT_CLEANUP - - -AT_SETUP([Floating continuation indicator]) -AT_KEYWORDS([runmisc]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - PROCEDURE DIVISION. - DISPLAY "OK"- - "OK" - NO ADVANCING - END-DISPLAY - STOP RUN. -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [OKOK]) - -AT_CLEANUP - - -AT_SETUP([Fixed continuation indicator]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 X PIC X(333) VALUE - '0123456789abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWX - - 'YZ0123456789abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUV - - 'WXYZ0123456789abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRST - - 'UVWXYZ0123456789abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQR - - 'STUVWXYZ0123456789abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOP - - 'QRSTUVWXYZ'. - PROCEDURE DIVISION. - DISPLAY X NO ADVANCING - END-DISPLAY. - DISPLAY '_' - END-DISPLAY. - MOVE - "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ01234567 - - "89abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ012345 - - "6789abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123 - - "456789abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ01 - - "23456789abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXY - - "Z - - "0123456789" TO X. - DISPLAY X NO ADVANCING - END-DISPLAY. - DISPLAY '_' - END-DISPLAY. - STOP RUN. -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [0123456789abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ _ -abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789 _ -]) - -AT_CLEANUP - - -AT_SETUP([Concatenation operator]) -AT_KEYWORDS([runmisc]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 77 STR PIC X(05). - PROCEDURE DIVISION. - MOVE "OK" & " " - & "OK" - TO STR - DISPLAY STR NO ADVANCING - END-DISPLAY - STOP RUN. -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [OK OK]) - -AT_CLEANUP - - -AT_SETUP([SOURCE FIXED/FREE directives]) -AT_KEYWORDS([runmisc SOURCEFORMAT FIXED FREE]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - >>SOURCE FREE - DATA DIVISION. - WORKING-STORAGE SECTION. - >>SOURCE FIXED - PROCEDURE DIVISION. FIXED - DISPLAY "OK" NO ADVANCING - END-DISPLAY. - >>SOURCE FREE - DISPLAY - "OK" - NO ADVANCING - END-DISPLAY. - >>SET SOURCEFORMAT "FIXED" - DISPLAY "OK" NO ADVANCING FIXED - END-DISPLAY. - >>SET SOURCEFORMAT "FREE" - DISPLAY - "OK" - NO ADVANCING - END-DISPLAY. - STOP RUN. -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], -[OKOKOKOK]) - -AT_CLEANUP - -## OCCURS clause - -AT_SETUP([Level 01 subscripts]) -AT_KEYWORDS([runmisc]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 X PIC X OCCURS 10. - PROCEDURE DIVISION. - STOP RUN. -]) - -AT_CHECK([$COMPILE_ONLY -std=cobol2014 prog.cob], [1], [], -[prog.cob:6: error: level 01 item 'X' cannot have a OCCURS clause -]) - -AT_CLEANUP - - -## Expressions - -AT_SETUP([Class check with reference modification]) -AT_KEYWORDS([runmisc]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 X PIC X(6) VALUE "123 ". - PROCEDURE DIVISION. - IF X(1:3) NUMERIC - STOP RUN - END-IF. - DISPLAY "NG" NO ADVANCING - END-DISPLAY. - STOP RUN. -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [], []) - -AT_CLEANUP - - -AT_SETUP([Index and parenthesized expression]) -AT_KEYWORDS([runmisc]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 G. - 02 X PIC X OCCURS 1 INDEXED BY I. - PROCEDURE DIVISION. - IF I < (I + 2) - DISPLAY "OK" NO ADVANCING - END-DISPLAY - END-IF. - STOP RUN. -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [OK], []) - -AT_CLEANUP - - -AT_SETUP([Alphanumeric and binary numeric]) -AT_KEYWORDS([runmisc]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 X-X PIC XXXX VALUE "0001". - 01 X-9 PIC 9999 COMP VALUE 1. - PROCEDURE DIVISION. - IF X-X = X-9 - STOP RUN - END-IF. - DISPLAY "NG" NO ADVANCING - END-DISPLAY - STOP RUN. -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [], []) - -AT_CLEANUP - - -AT_SETUP([Non-numeric data in numeric items]) - -AT_KEYWORDS([runmisc]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 X. - 03 X-NUM PIC 9(06) VALUE 123. - 77 NUM PIC 9(06). - PROCEDURE DIVISION. - MOVE x"0000" TO X (2:2) - IF X-NUM NUMERIC - DISPLAY "low-value is numeric" UPON SYSERR - END-DISPLAY - END-IF - MOVE x"01" TO X (3:1) - IF X-NUM NUMERIC - DISPLAY "SOH is numeric" UPON SYSERR - END-DISPLAY - END-IF - MOVE X-NUM TO NUM - DISPLAY "test over" - END-DISPLAY - * - GOBACK. -]) - -AT_DATA([prog2.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog2. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 X. - 03 X-NUM PIC 9(06) PACKED-DECIMAL VALUE 123. - 77 NUM PIC 9(06). - PROCEDURE DIVISION. - MOVE x"0A" TO X (2:1) - IF X-NUM NUMERIC - DISPLAY "bad prog" - END-DISPLAY - END-IF - MOVE X-NUM TO NUM - DISPLAY "test over" - END-DISPLAY - * - GOBACK. -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$COBC -x -o unchecked_prog prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./unchecked_prog], [0], -[test over -], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [1], [], -[libcob: prog.cob:20: error: 'X-NUM' (Type: NUMERIC DISPLAY) not numeric: '0\000\001123' -]) - -AT_CHECK([$COMPILE prog2.cob], [0], [], []) -AT_CHECK([$COBC -x -o unchecked_prog2 prog2.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./unchecked_prog2], [0], -[test over -], []) -AT_CHECK([$COBCRUN_DIRECT ./prog2], [1], [], -[libcob: prog2.cob:15: error: 'X-NUM' (Type: PACKED-DECIMAL) not numeric: '0x000a123f' -]) - -AT_CLEANUP - - -## CALL statement - -AT_SETUP([Dynamic call with static linking]) -AT_KEYWORDS([runmisc]) - -AT_DATA([callee.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. callee. - PROCEDURE DIVISION. - EXIT PROGRAM. -]) - -AT_DATA([caller.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. caller. - PROCEDURE DIVISION. - CALL "callee" - END-CALL. - STOP RUN. -]) - -AT_CHECK([$COMPILE_MODULE -c callee.cob], [0], [], []) -AT_CHECK([$COMPILE -c caller.cob], [0], [], []) -AT_CHECK([$COMPILE -o prog caller.$COB_OBJECT_EXT callee.$COB_OBJECT_EXT], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [], []) -AT_CHECK([$COMPILE -o prog2 caller.cob callee.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog2], [0], [], []) - -AT_CLEANUP - - -AT_SETUP([Static call with static linking]) -AT_KEYWORDS([runmisc]) - -AT_DATA([callee.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. callee. - PROCEDURE DIVISION. - EXIT PROGRAM. -]) - -AT_DATA([caller.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. caller. - PROCEDURE DIVISION. - CALL STATIC "callee" - END-CALL. - STOP RUN. -]) - -AT_CHECK([$COMPILE_MODULE -c callee.cob], [0], [], []) -AT_CHECK([$COMPILE -c caller.cob], [0], [], []) -AT_CHECK([$COMPILE -o prog caller.$COB_OBJECT_EXT callee.$COB_OBJECT_EXT], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [], []) -AT_CHECK([$COMPILE -o prog2 -fstatic-call caller.cob callee.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog2], [0], [], []) -AT_CHECK([$COMPILE -o prog3 caller.cob callee.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog3], [0], [], []) - -AT_CLEANUP - - -AT_SETUP([Dynamic CALL with ON EXCEPTION]) - -AT_KEYWORDS([runmisc]) - -AT_DATA([caller.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. caller. - PROCEDURE DIVISION. - CALL "callee1" ON EXCEPTION - CALL "callee2" ON EXCEPTION - DISPLAY "neither calee1 nor callee2 found" - END-CALL - END-CALL - GOBACK. -]) - -AT_DATA([callee2.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. callee2. - PROCEDURE DIVISION. - DISPLAY "this is callee2" NO ADVANCING - GOBACK. -]) - -AT_CHECK([$COMPILE caller.cob], [0], [], []) -AT_CHECK([$COMPILE_MODULE callee2.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./caller], [0], -[this is callee2], []) - -AT_CLEANUP - - -AT_SETUP([Static CALL with ON EXCEPTION]) - -AT_KEYWORDS([runmisc]) - -AT_DATA([caller.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. caller. - PROCEDURE DIVISION. - CALL "callee1" ON EXCEPTION - CALL "callee2" ON EXCEPTION - DISPLAY "neither calee1 nor callee2 found" - END-CALL - END-CALL - GOBACK. -]) - -AT_DATA([callee2.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. callee2. - PROCEDURE DIVISION. - DISPLAY "this is callee2" NO ADVANCING - GOBACK. -]) - - -AT_CHECK([$COMPILE_MODULE -c callee2.cob], [0], [], []) -AT_CHECK([$COMPILE -c caller.cob], [0], [], []) -AT_CHECK([$COMPILE -o prog caller.$COB_OBJECT_EXT callee2.$COB_OBJECT_EXT], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], -[this is callee2], []) -AT_CHECK([$COMPILE -o prog2 -fstatic-call caller.cob callee2.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog2], [0], -[this is callee2], []) -AT_CHECK([$COMPILE -o prog3 caller.cob callee2.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog3], [0], -[this is callee2], []) - -AT_CLEANUP - - -AT_SETUP([CALL m1. CALL m2. CALL m1.]) -AT_KEYWORDS([runmisc]) - -AT_DATA([m1.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. m1. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 X PIC 9(4). - PROCEDURE DIVISION. - COMPUTE X = 1 + 2 - END-COMPUTE. - IF X NOT = 3 - DISPLAY X - END-DISPLAY - END-IF. -]) - -AT_DATA([m2.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. m2. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 X PIC 9(4). - PROCEDURE DIVISION. - COMPUTE X = 3 + 4 - END-COMPUTE. - IF X NOT = 7 - DISPLAY X - END-DISPLAY - END-IF. -]) - -AT_DATA([caller.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. caller. - PROCEDURE DIVISION. - CALL "m1" - END-CALL. - CALL "m2" - END-CALL. - CALL "m1" - END-CALL. - STOP RUN. -]) - -AT_CHECK([$COMPILE_MODULE m1.cob], [0], [], []) -AT_CHECK([$COMPILE_MODULE m2.cob], [0], [], []) -AT_CHECK([$COMPILE caller.cob], [0], [], []) - -AT_CHECK([$COBCRUN_DIRECT ./caller], [0], [], []) - -AT_CLEANUP - - -AT_SETUP([Recursive CALL of RECURSIVE program]) -AT_KEYWORDS([runmisc CANCEL EXTERNAL]) - -AT_DATA([caller.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. caller IS RECURSIVE. - ENVIRONMENT DIVISION. - CONFIGURATION SECTION. - DATA DIVISION. - WORKING-STORAGE SECTION. - 77 STOPPER PIC S9 EXTERNAL. - PROCEDURE DIVISION. - MOVE 0 TO STOPPER - CALL "callee" - DISPLAY 'OK' NO ADVANCING END-DISPLAY - CANCEL "callee" , "callee2" - DISPLAY ' + FINE' NO ADVANCING END-DISPLAY - STOP RUN. -]) - -AT_DATA([callee.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. callee IS RECURSIVE. - DATA DIVISION. - WORKING-STORAGE SECTION. - 77 STOPPER PIC S9 EXTERNAL. - PROCEDURE DIVISION. - IF STOPPER = 9 - MOVE -1 TO STOPPER - ELSE - ADD 1 TO STOPPER - CALL "callee2" - END-IF - GOBACK. -]) - -AT_DATA([callee2.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. callee2 IS RECURSIVE. - DATA DIVISION. - WORKING-STORAGE SECTION. - 77 STOPPER PIC S9 EXTERNAL. - PROCEDURE DIVISION. - IF STOPPER NOT EQUAL -1 - CALL "callee" - END-IF - GOBACK. -]) - -AT_CHECK([$COMPILE caller.cob], [0], [], []) -AT_CHECK([$COMPILE_MODULE callee.cob], [0], [], []) -AT_CHECK([$COMPILE_MODULE callee2.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./caller], [0], [OK + FINE], []) - -AT_CLEANUP - - -AT_SETUP([Recursive CALL of INITIAL program]) -AT_KEYWORDS([runmisc]) - -AT_DATA([caller.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. caller. - DATA DIVISION. - WORKING-STORAGE SECTION. - 77 STOPPER PIC 9 EXTERNAL. - PROCEDURE DIVISION. - MOVE 0 TO STOPPER - CALL "callee" END-CALL. - GOBACK. -]) - -AT_DATA([callee.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. callee IS INITIAL. - DATA DIVISION. - WORKING-STORAGE SECTION. - 77 STOPPER PIC 9 EXTERNAL. - PROCEDURE DIVISION. - IF STOPPER = 1 - DISPLAY 'INITIAL prog was called RECURSIVE' - END-DISPLAY - STOP RUN RETURNING 1 - ELSE - MOVE 1 TO STOPPER - CALL "callee2" END-CALL - END-IF. - GOBACK. -]) - -AT_DATA([callee2.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. callee2. - PROCEDURE DIVISION. - CALL "callee" END-CALL. - GOBACK. -]) - -AT_CHECK([$COMPILE caller.cob], [0], [], []) -AT_CHECK([$COMPILE_MODULE callee.cob], [0], [], []) -AT_CHECK([$COMPILE_MODULE callee2.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./caller], [1], [], -[libcob: callee2.cob:5: error: recursive CALL from callee2 to callee which is NOT RECURSIVE -]) - -AT_CLEANUP - - -AT_SETUP([Recursive CALL with RECURSIVE assumed]) -AT_KEYWORDS([runmisc]) - -AT_DATA([caller.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. caller. - DATA DIVISION. - WORKING-STORAGE SECTION. - 77 STOPPER PIC 9 EXTERNAL. - PROCEDURE DIVISION. - MOVE 0 TO STOPPER - CALL "callee" END-CALL. - GOBACK. -]) - -AT_DATA([callee.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. callee IS INITIAL. - DATA DIVISION. - WORKING-STORAGE SECTION. - 77 STOPPER PIC 9 EXTERNAL. - PROCEDURE DIVISION. - IF STOPPER = 9 - DISPLAY 'OK' NO ADVANCING END-DISPLAY - STOP RUN - ELSE - ADD 1 TO STOPPER END-ADD - CALL "callee2" END-CALL - END-IF. - GOBACK. -]) - -AT_DATA([callee2.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. callee2. - PROCEDURE DIVISION. - CALL "callee" END-CALL. - GOBACK. -]) - -AT_CHECK([$COMPILE caller.cob], [0], [], []) -AT_CHECK([$COMPILE_MODULE -fno-recursive-check callee.cob], [0], [], []) -AT_CHECK([$COMPILE_MODULE -fno-recursive-check callee2.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./caller], [0], [OK], []) - -AT_CLEANUP - - -AT_SETUP([Recursive CALL with ON EXCEPTION]) - -AT_KEYWORDS([runmisc EXCEPTION-STATUS]) - -AT_DATA([caller.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. caller. - DATA DIVISION. - WORKING-STORAGE SECTION. - 77 STOPPER PIC 9 EXTERNAL. - PROCEDURE DIVISION. - MOVE 0 TO STOPPER - CALL "callee" END-CALL. - GOBACK. -]) - -AT_DATA([callee.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. callee IS INITIAL. - DATA DIVISION. - WORKING-STORAGE SECTION. - 77 STOPPER PIC 9 EXTERNAL. - PROCEDURE DIVISION. - IF STOPPER = 1 - DISPLAY 'INITIAL prog was called RECURSIVE' - END-DISPLAY - STOP RUN RETURNING 1 - ELSE - MOVE 1 TO STOPPER - CALL "callee2" END-CALL - END-IF. - GOBACK. -]) - -AT_DATA([callee2.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. callee2. - PROCEDURE DIVISION. - CALL "callee" - ON EXCEPTION - DISPLAY "Exception " FUNCTION EXCEPTION-STATUS ";" - UPON SYSERR - STOP RUN RETURNING 1 - END-CALL. - GOBACK. -]) - -AT_CHECK([$COMPILE caller.cob], [0], [], []) -AT_CHECK([$COMPILE_MODULE callee.cob], [0], [], []) -AT_CHECK([$COMPILE_MODULE callee2.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./caller], [1], [], -[Exception EC-PROGRAM-RECURSIVE-CALL ; -]) - -AT_CLEANUP - - -AT_SETUP([Multiple calls of INITIAL program]) -AT_KEYWORDS([runmisc CALL]) - -AT_DATA([caller.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. caller. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 PARAM1 PIC X(08). - 01 PARAM2 PIC 9999 COMP VALUE 08. - PROCEDURE DIVISION. - MOVE ' PARAM 1' TO PARAM1 - PERFORM 10 TIMES - CALL "callee" USING PARAM1 PARAM2 END-CALL - END-PERFORM - DISPLAY 'PARAM1 = ' PARAM1 - END-DISPLAY - STOP RUN. -]) - -AT_DATA([callee.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. callee IS INITIAL. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 COUNTER PIC 999 VALUE ZERO. - 01 LPARAM PIC 9(8) COMP. - 01 WS-TEMP PIC 9(8)V99. - 01 PRICE-LOW PIC 9(3)V99 VALUE 10.50. - LINKAGE SECTION. - 01 PARAM1 PIC X(08). - 01 PARAM2 PIC 9999 COMP. - PROCEDURE DIVISION USING PARAM1 PARAM2. - ADD 1 TO COUNTER END-ADD - MOVE 1.10 TO WS-TEMP. - MULTIPLY PRICE-LOW BY WS-TEMP GIVING WS-TEMP. - CALL 'C$PARAMSIZE' USING 1 GIVING LPARAM END-CALL - DISPLAY 'COUNTER = ' COUNTER ' LPARAM1 = ' LPARAM - ' PARAM1 = ' PARAM1 - END-DISPLAY - GOBACK. -]) - -AT_CHECK([$COMPILE caller.cob], [0], [], []) -AT_CHECK([$COMPILE_MODULE callee.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./caller], [0], [COUNTER = 001 LPARAM1 = 00000008 PARAM1 = PARAM 1 -COUNTER = 001 LPARAM1 = 00000008 PARAM1 = PARAM 1 -COUNTER = 001 LPARAM1 = 00000008 PARAM1 = PARAM 1 -COUNTER = 001 LPARAM1 = 00000008 PARAM1 = PARAM 1 -COUNTER = 001 LPARAM1 = 00000008 PARAM1 = PARAM 1 -COUNTER = 001 LPARAM1 = 00000008 PARAM1 = PARAM 1 -COUNTER = 001 LPARAM1 = 00000008 PARAM1 = PARAM 1 -COUNTER = 001 LPARAM1 = 00000008 PARAM1 = PARAM 1 -COUNTER = 001 LPARAM1 = 00000008 PARAM1 = PARAM 1 -COUNTER = 001 LPARAM1 = 00000008 PARAM1 = PARAM 1 -PARAM1 = PARAM 1 -]) - -AT_CLEANUP - - -AT_SETUP([CALL binary literal parameter/LENGTH OF]) -AT_KEYWORDS([runmisc]) - -AT_DATA([dump.c], [ -#include -#include - -COB_EXT_EXPORT int -dump (unsigned char *p) -{ - if ( *p == 0 ) p++; - if ( *p == 0 ) p++; /* Skip leading bytes for BIG Endian value */ - if ( *p == 0 ) p++; - printf ("%8.8d\n", *p); - return 0; -} -]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 MYOCC PIC 9(8) COMP. - 01 MYTAB. - 03 MYBYTE PIC X OCCURS 1 TO 20 - DEPENDING ON MYOCC. - PROCEDURE DIVISION. - MOVE 9 TO MYOCC. - CALL "dump" USING BY CONTENT 1 - END-CALL. - CALL "dump" USING BY CONTENT LENGTH OF MYTAB - END-CALL. - CALL "dump" USING BY CONTENT LENGTH OF MYOCC - END-CALL. - STOP RUN. -]) - -AT_CHECK([$COMPILE_MODULE dump.c], [0], [], []) -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], -[00000001 -00000009 -00000004 -]) -AT_CHECK([$COMPILE -fbinary-byteorder=native prog.cob -o prog2], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog2], [0], -[00000001 -00000009 -00000004 -]) - -AT_CLEANUP - - -AT_SETUP([CALL binary literal]) -AT_KEYWORDS([CALL]) - -AT_DATA([prog.cob], [ IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - - DATA DIVISION. - WORKING-STORAGE SECTION. - - PROCEDURE DIVISION. - CALL "SUB" USING 1280 BY VALUE 15. - CALL "SUB" USING 2560 BY VALUE 16. - STOP RUN. - END PROGRAM prog. - - IDENTIFICATION DIVISION. - PROGRAM-ID. "SUB". - - DATA DIVISION. - LINKAGE SECTION. - 01 x PIC 9(9) COMP. - 01 y PIC 9(9) COMP-5. - - PROCEDURE DIVISION USING x, VALUE y. - DISPLAY "COBOL: X is " x " and Y is " y. - END PROGRAM "SUB". -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) - -AT_CHECK([./prog], [0], -[COBOL: X is 000001280 and Y is 0000000015 -COBOL: X is 000002560 and Y is 0000000016 -], []) - -AT_CLEANUP - - -## INSPECT - -AT_SETUP([INSPECT REPLACING LEADING ZEROS BY SPACES]) -AT_KEYWORDS([runmisc]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 X PIC X(4) VALUE "0001". - PROCEDURE DIVISION. - INSPECT X REPLACING LEADING ZEROS BY SPACES. - IF X NOT = " 1" - DISPLAY X NO ADVANCING - END-DISPLAY - END-IF. - STOP RUN. -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [], []) - -AT_CLEANUP - - -AT_SETUP([INSPECT No repeat conversion check]) -AT_KEYWORDS([runmisc]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 X PIC X(3) VALUE "BCA". - PROCEDURE DIVISION. - INSPECT X CONVERTING "ABC" TO "BCD". - IF X NOT = "CDB" - DISPLAY X NO ADVANCING - END-DISPLAY - END-IF. - STOP RUN. -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [], []) - -AT_CLEANUP - - -AT_SETUP([INSPECT CONVERTING alphabet]) -AT_KEYWORDS([runmisc ASCII EBCDIC]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. charset. - - ENVIRONMENT DIVISION. - CONFIGURATION SECTION. - SPECIAL-NAMES. - ALPHABET ALPHA IS ASCII. - ALPHABET BETA IS EBCDIC. - - DATA DIVISION. - WORKING-STORAGE SECTION. - - 01 TESTHEX PIC X(10) VALUE X'C17BD6F2F0F1F8404040'. - - procedure division. - sample-main. - - INSPECT testhex CONVERTING BETA TO ALPHA - DISPLAY 'Converted: "' TESTHEX '"' WITH NO ADVANCING - - GOBACK. - END PROGRAM charset. -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], -[Converted: "A#O2018 "], []) - -AT_CLEANUP - - -AT_SETUP([INSPECT CONVERTING TO figurative constant]) -AT_KEYWORDS([runmisc]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 X PIC X(3) VALUE "BCA". - PROCEDURE DIVISION. - INSPECT X CONVERTING "ABC" TO SPACES. - IF X NOT = SPACES - DISPLAY X NO ADVANCING - END-DISPLAY - END-IF. - STOP RUN. -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [], []) - -AT_CLEANUP - - -AT_SETUP([INSPECT CONVERTING NULL]) -AT_KEYWORDS([runmisc]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 X PIC X(3) VALUE LOW-VALUES. - PROCEDURE DIVISION. - INSPECT X CONVERTING NULL TO "A". - IF X NOT = "AAA" - DISPLAY X NO ADVANCING - END-DISPLAY - END-IF. - STOP RUN. -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [], []) - -AT_CLEANUP - - -AT_SETUP([INSPECT CONVERTING TO NULL]) -AT_KEYWORDS([runmisc]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 X PIC X(3) VALUE "AAA". - PROCEDURE DIVISION. - INSPECT X CONVERTING "A" TO NULL. - IF X NOT = LOW-VALUES - DISPLAY "NG" NO ADVANCING - END-DISPLAY - END-IF. - STOP RUN. -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [], []) - -AT_CLEANUP - - -AT_SETUP([INSPECT REPLACING figurative constant]) -AT_KEYWORDS([runmisc]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 X PIC X(3) VALUE "BCA". - PROCEDURE DIVISION. - INSPECT X REPLACING ALL "BC" BY SPACE. - IF X NOT = " A" - DISPLAY X NO ADVANCING - END-DISPLAY - END-IF. - STOP RUN. -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [], []) - -AT_CLEANUP - - -AT_SETUP([INSPECT TALLYING BEFORE]) -AT_KEYWORDS([runmisc]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 X PIC X(4) VALUE "ABC ". - 01 TAL PIC 999 VALUE 0. - PROCEDURE DIVISION. - MOVE 0 TO TAL. - INSPECT X TALLYING TAL FOR CHARACTERS - BEFORE INITIAL " ". - IF TAL NOT = 3 - DISPLAY TAL NO ADVANCING - END-DISPLAY - END-IF. - MOVE 0 TO TAL. - MOVE " ABC" TO X. - INSPECT X TALLYING TAL FOR CHARACTERS - BEFORE INITIAL " ". - IF TAL NOT = 0 - DISPLAY TAL NO ADVANCING - END-DISPLAY - END-IF. - STOP RUN. -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [], []) - -AT_CLEANUP - - -AT_SETUP([INSPECT TALLYING AFTER]) -AT_KEYWORDS([runmisc]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 X PIC X(4) VALUE "ABC ". - 01 TAL PIC 999 VALUE 0. - PROCEDURE DIVISION. - MOVE 0 TO TAL. - INSPECT X TALLYING TAL FOR CHARACTERS - AFTER INITIAL " ". - IF TAL NOT = 0 - DISPLAY TAL NO ADVANCING - END-DISPLAY - END-IF. - MOVE 0 TO TAL. - MOVE " ABC" TO X. - INSPECT X TALLYING TAL FOR CHARACTERS - AFTER INITIAL " ". - IF TAL NOT = 3 - DISPLAY TAL NO ADVANCING - END-DISPLAY - END-IF. - STOP RUN. -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [], []) - -AT_CLEANUP - - -AT_SETUP([INSPECT REPLACING TRAILING ZEROS BY SPACES]) -AT_KEYWORDS([runmisc]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 X PIC X(4) VALUE "1000". - PROCEDURE DIVISION. - INSPECT X REPLACING TRAILING ZEROS BY SPACES. - IF X NOT = "1 " - DISPLAY X NO ADVANCING - END-DISPLAY - END-IF. - STOP RUN. -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [], []) - -AT_CLEANUP - - -AT_SETUP([INSPECT REPLACING complex]) -AT_KEYWORDS([runmisc]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 X PIC X(12) VALUE "AAABBCDCCCCC". - PROCEDURE DIVISION. - INSPECT X REPLACING - ALL "A" BY "Z" - "B" BY "Y" - TRAILING "C" BY "X". - IF X NOT = "ZZZYYCDXXXXX" - DISPLAY X NO ADVANCING - END-DISPLAY - END-IF. - STOP RUN. -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [], []) -AT_CLEANUP - - -AT_SETUP([SWITCHES (environment COB_SWITCH_n and SET)]) -AT_KEYWORDS([runmisc]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - CONFIGURATION SECTION. - SPECIAL-NAMES. - SWITCH-1 IS SWIT1 - ON IS SWIT1-ON - OFF IS SWIT1-OFF - SWITCH-2 IS SWIT2 - ON IS SWIT2-ON - OFF IS SWIT2-OFF - SWITCH-3 - ON IS SWIT3-ON - OFF IS SWIT3-OFF - SWITCH-4 IS SWIT4 - OFF IS SWIT4-OFF - SWITCH-31 - ON IS SWIT31-ON - SWITCH-36 IS SWIT36 - OFF IS SWIT36-OFF. - DATA DIVISION. - WORKING-STORAGE SECTION. - PROCEDURE DIVISION. - IF SWIT1-ON - DISPLAY "ON" NO ADVANCING - END-DISPLAY - ELSE - DISPLAY "OFF" NO ADVANCING - END-DISPLAY - END-IF. - IF SWIT2-ON - DISPLAY " ON" NO ADVANCING - END-DISPLAY - ELSE - DISPLAY " OFF" NO ADVANCING - END-DISPLAY - END-IF. - IF SWIT3-ON - DISPLAY " ON" NO ADVANCING - END-DISPLAY - ELSE - DISPLAY " OFF" NO ADVANCING - END-DISPLAY - END-IF. - IF NOT SWIT4-OFF - DISPLAY " ON" NO ADVANCING - END-DISPLAY - ELSE - DISPLAY " OFF" NO ADVANCING - END-DISPLAY - END-IF. - SET SWIT1 TO OFF. - SET SWIT2 TO ON. - IF SWIT1-ON - DISPLAY " ON" NO ADVANCING - END-DISPLAY - ELSE - DISPLAY " OFF" NO ADVANCING - END-DISPLAY - END-IF. - IF SWIT2-ON - DISPLAY " ON" NO ADVANCING - END-DISPLAY - ELSE - DISPLAY " OFF" NO ADVANCING - END-DISPLAY - END-IF - IF SWIT31-ON - DISPLAY " ON" NO ADVANCING - END-DISPLAY - ELSE - DISPLAY " OFF" NO ADVANCING - END-DISPLAY - END-IF. - IF NOT SWIT36-OFF - DISPLAY " ON" NO ADVANCING - END-DISPLAY - ELSE - DISPLAY " OFF" NO ADVANCING - END-DISPLAY - END-IF. - STOP RUN. -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([COB_SWITCH_1=1 COB_SWITCH_2=0 COB_SWITCH_3=OFF COB_SWITCH_4=ON COB_SWITCH_36=ON ./prog], [0], -[ON OFF OFF ON OFF ON OFF ON]) - -AT_CLEANUP - - -## PERFORM - -AT_SETUP([Nested PERFORM]) -AT_KEYWORDS([runmisc]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - PROCEDURE DIVISION. - PERFORM 2 TIMES - DISPLAY "X" NO ADVANCING - END-DISPLAY - PERFORM 2 TIMES - DISPLAY "Y" NO ADVANCING - END-DISPLAY - END-PERFORM - END-PERFORM. - STOP RUN. -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [XYYXYY]) - -AT_CLEANUP - - -AT_SETUP([PERFORM VARYING BY -0.2]) -AT_KEYWORDS([runmisc]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 77 X PIC 9v9. - PROCEDURE DIVISION. - PERFORM VARYING X FROM 0.8 BY -0.2 - UNTIL X < 0.4 - DISPLAY "X" NO ADVANCING - END-DISPLAY - END-PERFORM. - IF X NOT = 0.2 - DISPLAY "WRONG X: " X END-DISPLAY - END-IF - STOP RUN. -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [XXX]) - -AT_CLEANUP - - -AT_SETUP([PERFORM VARYING BY phrase omitted]) -AT_KEYWORDS([runmisc]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 77 X PIC 9. - PROCEDURE DIVISION. - PERFORM VARYING X FROM 4 - UNTIL X > 6 - DISPLAY "X" NO ADVANCING - END-PERFORM. - IF X NOT = 7 - DISPLAY "WRONG X: " X - END-IF - STOP RUN. -]) - -AT_CHECK([$COMPILE_ONLY -std=cobol85 prog.cob], [1], [], -[prog.cob:9: error: PERFORM VARYING without BY phrase does not conform to COBOL 85 -]) -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [XXX]) - -AT_CLEANUP - - -## EXIT PERFORM see ISO/IEC 1989:2002(E) 14.8.13 Format 5 - -AT_SETUP([EXIT PERFORM]) -AT_KEYWORDS([runmisc]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - PROCEDURE DIVISION. - PERFORM 2 TIMES - DISPLAY "OK" NO ADVANCING - END-DISPLAY - EXIT PERFORM - DISPLAY "NOT OK" - END-DISPLAY - END-PERFORM - STOP RUN. -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [OK], []) - -AT_CLEANUP - - -## EXIT PERFORM see ISO/IEC 1989:2002(E) 14.8.13 Format 5 - -AT_SETUP([EXIT PERFORM CYCLE]) -AT_KEYWORDS([runmisc]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - PROCEDURE DIVISION. - PERFORM 2 TIMES - DISPLAY "OK" NO ADVANCING - END-DISPLAY - EXIT PERFORM CYCLE - DISPLAY "NOT OK" - END-DISPLAY - END-PERFORM - STOP RUN. -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [OKOK]) - -AT_CLEANUP - - -## EXIT PARAGRAPH see ISO/IEC 1989:2002(E) 14.8.13 Format 6 - -AT_SETUP([EXIT PARAGRAPH]) -AT_KEYWORDS([runmisc]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 INDVAL PIC 9(4). - PROCEDURE DIVISION. - A01. - PERFORM VARYING INDVAL FROM 1 BY 1 UNTIL INDVAL > 10 - IF INDVAL > 2 - EXIT PARAGRAPH - END-IF - END-PERFORM. - A02. - IF INDVAL NOT = 3 - DISPLAY INDVAL NO ADVANCING - END-DISPLAY - END-IF. - STOP RUN. -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [], []) - -AT_CLEANUP - - -## EXIT SECTION see ISO/IEC 1989:2002(E) 14.8.13 Format 6 - -AT_SETUP([EXIT SECTION]) -AT_KEYWORDS([runmisc]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 INDVAL PIC 9(4). - PROCEDURE DIVISION. - A01 SECTION. - A011. - PERFORM VARYING INDVAL FROM 1 BY 1 UNTIL INDVAL > 10 - IF INDVAL > 2 - EXIT SECTION - END-IF - END-PERFORM. - A012. - DISPLAY INDVAL NO ADVANCING - END-DISPLAY. - A02 SECTION. - IF INDVAL NOT = 3 - DISPLAY INDVAL NO ADVANCING - END-DISPLAY - END-IF. - STOP RUN. -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [], []) - -AT_CLEANUP - - -AT_SETUP([PERFORM FOREVER / PERFORM UNTIL EXIT]) -AT_KEYWORDS([runmisc extension]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 INDVAL PIC 9(4). - PROCEDURE DIVISION. - A01. - MOVE 0 TO INDVAL - PERFORM UNTIL EXIT - ADD 1 TO INDVAL - IF INDVAL > 2 - EXIT PERFORM - END-IF - END-PERFORM - IF INDVAL NOT = 3 - DISPLAY "1: " INDVAL - END-DISPLAY - END-IF - PERFORM FOREVER - ADD 1 TO INDVAL - IF INDVAL > 4 - EXIT PERFORM - END-IF - END-PERFORM - IF INDVAL NOT = 5 - DISPLAY "2: " INDVAL - END-DISPLAY - END-IF - STOP RUN. -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [], []) - -AT_CLEANUP - - -AT_SETUP([PERFORM inline (1)]) -AT_KEYWORDS([runmisc]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 INDVAL PIC 9(4). - PROCEDURE DIVISION. - PERFORM VARYING INDVAL FROM 1 - BY 1 UNTIL INDVAL > 2 - END-PERFORM - IF INDVAL NOT = 3 - DISPLAY INDVAL NO ADVANCING - END-DISPLAY - END-IF - STOP RUN - . -]) - -AT_CHECK([$COMPILE -fmissing-statement=ok prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [], []) - -AT_CLEANUP - - -AT_SETUP([PERFORM inline (2)]) -AT_KEYWORDS([runmisc]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 INDVAL PIC 9(4). - PROCEDURE DIVISION. - PERFORM VARYING INDVAL FROM 1 - BY 1 UNTIL INDVAL > 2. - IF INDVAL NOT = 3 - DISPLAY INDVAL NO ADVANCING - END-DISPLAY - END-IF - . -]) - -AT_CHECK([$COMPILE -frelax-syntax-checks -w prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [], []) - -AT_CLEANUP - - -AT_SETUP([Non-overflow after overflow]) -AT_KEYWORDS([runmisc]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 X PIC 9(2) VALUE 0. - 01 Y PIC 9(2) VALUE 0. - PROCEDURE DIVISION. - COMPUTE X = 100 - END-COMPUTE. - COMPUTE Y = 99 - END-COMPUTE. - IF Y NOT = 99 - DISPLAY Y NO ADVANCING - END-DISPLAY - END-IF. - STOP RUN. -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [], []) - -AT_CLEANUP - - -## PERFORM statement - -AT_SETUP([PERFORM ... CONTINUE]) -AT_KEYWORDS([runmisc]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - PROCEDURE DIVISION. - PERFORM 2 TIMES - CONTINUE - END-PERFORM. -]) - -AT_CHECK([$COMPILE_ONLY prog.cob], [0], [], []) - -AT_CLEANUP - - -AT_SETUP([STRING with subscript reference]) -AT_KEYWORDS([runmisc]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 G. - 02 X PIC X(3) OCCURS 3. - PROCEDURE DIVISION. - MOVE SPACES TO G. - STRING "abc" INTO X(2) - END-STRING. - IF G NOT = " abc " - DISPLAY X(1) NO ADVANCING - END-DISPLAY - END-IF. - STOP RUN. -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [], []) - -AT_CLEANUP - - -AT_SETUP([STRING / UNSTRING [NOT] ON OVERFLOW]) -AT_KEYWORDS([runmisc exceptions]) - -AT_DATA([prog.cob], [ - identification division. - program-id. prog. - data division. - working-storage section. - 77 simple-str pic x(20). - 77 err-str pic x(50). - *----------------------------------------------------------------- - procedure division. - * STRING test - move spaces to simple-str - string 'data' - delimited by size - into simple-str - on overflow - move spaces to err-str - string 'STRING OVERFLOW' - delimited by size - into err-str - end-string - display err-str upon syserr - end-display - display '1 failed' - end-display - not on overflow - display '1 passed' - end-display - end-string - if simple-str not = 'data' - display 'STRING ERROR (1): "' simple-str '"' - end-display - end-if - * - move spaces to simple-str - string 'data is too big here...' - delimited by size - into simple-str - on overflow - display '2 passed' - end-display - not on overflow - display '2 failed' - end-display - move spaces to err-str - string 'missing OVERFLOW' - delimited by size - into err-str - end-string - display err-str upon syserr - end-display - end-string - if simple-str not = 'data is too big here' - display 'STRING ERROR (2): "' simple-str '"' - end-display - end-if - * - * UNSTRING test - move spaces to simple-str - unstring 'data' - into simple-str - on overflow - move spaces to err-str - unstring 'UNSTRING OVERFLOW' - into err-str - end-unstring - display err-str upon syserr - end-display - display '3 failed' - end-display - not on overflow - display '3 passed' - end-display - end-unstring - if simple-str not = 'data' - display 'UNSTRING ERROR (1): "' simple-str '"' - end-display - end-if - * - move spaces to simple-str - unstring 'data is too big here...' - into simple-str - on overflow - display '4 passed' - end-display - not on overflow - display '4 failed' - end-display - move spaces to err-str - string 'missing OVERFLOW' - delimited by size - into err-str - end-string - display err-str upon syserr - end-display - end-unstring - if simple-str not = 'data is too big here' - display 'UNSTRING ERROR (2): "' simple-str '"' - end-display - end-if - * - STOP RUN. -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], -[1 passed -2 passed -3 passed -4 passed -], []) - -AT_CLEANUP - - -AT_SETUP([UNSTRING DELIMITED ALL LOW-VALUE]) -AT_KEYWORDS([runmisc]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 G. - 03 FILLER PIC XXX VALUE "ABC". - 03 FILLER PIC XX VALUE LOW-VALUES. - 03 FILLER PIC XXX VALUE "DEF". - 01 A PIC XXX. - 01 B PIC XXX. - PROCEDURE DIVISION. - UNSTRING G DELIMITED BY ALL LOW-VALUES - INTO A B - END-UNSTRING. - IF A NOT = "ABC" - DISPLAY A - END-DISPLAY - END-IF. - IF B NOT = "DEF" - DISPLAY B - END-DISPLAY - END-IF. - STOP RUN. -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [], []) - -AT_CLEANUP - - -AT_SETUP([UNSTRING DELIMITED ALL SPACE-2]) -AT_KEYWORDS([runmisc]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 WS-RECORD. - 02 VALUE SPACE PIC X(04). - 02 VALUE "ABC AND DE" PIC X(10). - 02 VALUE SPACE PIC X(07). - 02 VALUE "FG AND HIJ" PIC X(10). - 02 VALUE SPACE PIC X(08). - 01 SPACE-2 PIC X(02) VALUE SPACE. - 01 WS-DUMMY PIC X(15). - 01 WS-POINTER PIC 99. - PROCEDURE DIVISION. - MOVE 1 TO WS-POINTER. - * - PERFORM 0001-SUB. - IF WS-DUMMY NOT = SPACE - DISPLAY "Expected space - Got " WS-DUMMY - END-DISPLAY - END-IF. - IF WS-POINTER NOT = 5 - DISPLAY "Expected 5 - Got " WS-POINTER - END-DISPLAY - END-IF. - * - PERFORM 0001-SUB. - IF WS-DUMMY NOT = "ABC AND DE" - DISPLAY "Expected ABC AND DE - Got " WS-DUMMY - END-DISPLAY - END-IF. - IF WS-POINTER NOT = 21 - DISPLAY "Expected 21 - Got " WS-POINTER - END-DISPLAY - END-IF. - * - PERFORM 0001-SUB. - IF WS-DUMMY NOT = " FG AND HIJ" - DISPLAY "Expected FG AND HIJ - Got " WS-DUMMY - END-DISPLAY - END-IF. - IF WS-POINTER NOT = 40 - DISPLAY "Expected 40 - Got " WS-POINTER - END-DISPLAY - END-IF. - STOP RUN. - 0001-SUB. - UNSTRING WS-RECORD - DELIMITED BY ALL SPACE-2 - INTO WS-DUMMY - POINTER WS-POINTER - END-UNSTRING. -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [], []) - -AT_CLEANUP - - -AT_SETUP([UNSTRING DELIMITED POINTER]) -AT_KEYWORDS([runmisc]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 WS-LAY-RECORD PIC X(66). - 01 WS-DUMMY PIC X(50). - 01 WS-KEYWORD PIC X(32). - 01 WS-POINTER PIC 99. - PROCEDURE DIVISION. - MOVE - ' 10 AF-RECORD-TYPE-SEQUENCE-04 PIC 9(05) COMP-3.' - TO WS-LAY-RECORD. - MOVE 1 TO WS-POINTER. - PERFORM 0001-SUB. - IF WS-POINTER NOT = 48 - DISPLAY "Expected 48 - Got " WS-POINTER - END-DISPLAY - END-IF. - ADD 7 TO WS-POINTER - END-ADD. - PERFORM 0001-SUB. - IF WS-POINTER NOT = 62 - DISPLAY "Expected 62 - Got " WS-POINTER - END-DISPLAY - END-IF. - PERFORM 0001-SUB. - IF WS-POINTER NOT = 63 - DISPLAY "Expected 63 - Got " WS-POINTER - END-DISPLAY - END-IF. - STOP RUN. - 0001-SUB. - UNSTRING WS-LAY-RECORD - DELIMITED - BY ' PIC ' - OR ' COMP-3' - OR '.' - INTO WS-DUMMY - DELIMITER WS-KEYWORD - POINTER WS-POINTER - END-UNSTRING. -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [], []) - -AT_CLEANUP - - -AT_SETUP([UNSTRING DELIMITER IN]) -AT_KEYWORDS([runmisc]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 WK-CMD PIC X(8) VALUE "WWADDBCC". - 01 FILLER. - 02 WK-SIGNS PIC XX VALUE "AB". - 02 WKS REDEFINES WK-SIGNS. - 03 WK-SIGN PIC X OCCURS 2. - 02 WK-DELIM PIC X OCCURS 2. - 02 WK-DATA PIC X(2) OCCURS 3. - PROCEDURE DIVISION. - UNSTRING WK-CMD DELIMITED BY WK-SIGN(1) OR WK-SIGN(2) - INTO WK-DATA(1) DELIMITER IN WK-DELIM(1) - WK-DATA(2) DELIMITER IN WK-DELIM(2) - WK-DATA(3) - END-UNSTRING - IF WK-DATA(1) NOT = "WW" - OR WK-DATA(2) NOT = "DD" - OR WK-DATA(3) NOT = "CC" - OR WK-DELIM(1) NOT = "A" - OR WK-DELIM(2) NOT = "B" - DISPLAY WK-DATA(1) - WK-DATA(2) - WK-DATA(3) - WK-DELIM(1) - WK-DELIM(2) - END-DISPLAY - END-IF. - STOP RUN. -]) - -AT_CHECK([$COMPILE -ftop-level-occurs-clause=ok prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [], []) - -AT_CLEANUP - - -AT_SETUP([UNSTRING with FUNCTION / literal]) -AT_KEYWORDS([runmisc]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 FILLER. - 05 TSTUNS PIC X(479). - 05 PRM PIC X(16) OCCURS 4 TIMES. - PROCEDURE DIVISION. - MOVE "The,Quick,Brown,Fox" TO TSTUNS. - UNSTRING TSTUNS DELIMITED BY ',' - INTO PRM(1), PRM(2), PRM(3), PRM(4). - DISPLAY "PRM(1) is " PRM(1) ":". - DISPLAY "PRM(2) is " PRM(2) ":". - DISPLAY "PRM(3) is " PRM(3) ":". - DISPLAY "PRM(4) is " PRM(4) ":". - UNSTRING FUNCTION UPPER-CASE(TSTUNS) DELIMITED BY ',' - INTO PRM(1), PRM(2), PRM(3), PRM(4). - DISPLAY "Now using UPPER-CASE" - DISPLAY "PRM(1) is " PRM(1) ":". - DISPLAY "PRM(2) is " PRM(2) ":". - DISPLAY "PRM(3) is " PRM(3) ":". - DISPLAY "PRM(4) is " PRM(4) ":". - UNSTRING "Daddy,was,a,Rolling stone" DELIMITED BY ',' - INTO PRM(1), PRM(2), PRM(3), PRM(4). - DISPLAY "Now using Literal" - DISPLAY "PRM(1) is " PRM(1) ":". - DISPLAY "PRM(2) is " PRM(2) ":". - DISPLAY "PRM(3) is " PRM(3) ":". - DISPLAY "PRM(4) is " PRM(4) ":". - UNSTRING FUNCTION LOWER-CASE("Daddy,was,a,Rolling stone") - DELIMITED BY ',' - INTO PRM(1), PRM(2), PRM(3), PRM(4). - DISPLAY "Now using Literal + LOWER-CASE" - DISPLAY "PRM(1) is " PRM(1) ":". - DISPLAY "PRM(2) is " PRM(2) ":". - DISPLAY "PRM(3) is " PRM(3) ":". - DISPLAY "PRM(4) is " PRM(4) ":". - STOP RUN. -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], -[PRM(1) is The : -PRM(2) is Quick : -PRM(3) is Brown : -PRM(4) is Fox : -Now using UPPER-CASE -PRM(1) is THE : -PRM(2) is QUICK : -PRM(3) is BROWN : -PRM(4) is FOX : -Now using Literal -PRM(1) is Daddy : -PRM(2) is was : -PRM(3) is a : -PRM(4) is Rolling stone : -Now using Literal + LOWER-CASE -PRM(1) is daddy : -PRM(2) is was : -PRM(3) is a : -PRM(4) is rolling stone : -], []) - -AT_CLEANUP - - -AT_SETUP([PICTURE COMP-X]) -AT_KEYWORDS([Numeric]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 TST. - 05 BVAL PIC 9999 BINARY VALUE 512. - 05 XVAL PIC XX COMP-X VALUE 512. - 88 XLOW VALUE 0 THRU 256. - 88 XHIGH VALUE 257 THRU 65536. - 05 VAL9 PIC 99999 COMP-X VALUE 1024. - 88 LOW9 VALUE 0 THRU 256. - 88 HIGH9 VALUE 257 THRU 65536. - 05 XVAL2 PIC XX COMP-X VALUE 16706. - 05 XVALX REDEFINES XVAL2 PIC XX. - 05 YVALX PIC XX VALUE 'A '. - 05 YVAL2 REDEFINES YVALX PIC XX COMP-X. - - PROCEDURE DIVISION. - DISPLAY " XVAL is " XVAL "; Length is " LENGTH OF XVAL. - DISPLAY " VAL9 is " VAL9 "; Length is " LENGTH OF VAL9. - MOVE 10240 TO XVAL. - DISPLAY " XVAL is " XVAL "; Length is " LENGTH OF XVAL. - DISPLAY "XVAL2 is " XVAL2 "; Length is " LENGTH OF XVAL2. - DISPLAY "XVALX is " XVALX "; Length is " LENGTH OF XVALX. - ADD 1 TO XVAL2. - DISPLAY "XVALX is " XVALX " after +1;". - COMPUTE XVAL2 = XVAL2 / 256 + 8192. - DISPLAY "XVALX is " XVALX " after / 256 + 8192;". - MOVE 'DE' TO XVALX. - DISPLAY "Numeric: " XVAL2 " is char " XVALX. - MOVE ZERO TO YVAL2. - MOVE 'D' TO YVALX (1:1) - MOVE LOW-VALUES TO YVALX (2:1) - SUBTRACT YVAL2 FROM XVAL2. - MOVE ' ' TO YVALX (1:1) - MOVE LOW-VALUES TO YVALX (2:1) - ADD YVAL2 TO XVAL2. - DISPLAY "Numeric: " XVAL2 " is char " XVALX. - MOVE 0 TO XVAL. - ADD 10240 TO XVAL. - IF XVAL = 10240 - DISPLAY "XVAL is " XVAL - ELSE - DISPLAY "XVAL is not 10240 but " XVAL - END-IF. - MOVE 0 TO BVAL. - ADD 10240 TO BVAL. - IF BVAL = 0240 - DISPLAY "BVAL is " BVAL - ELSE - DISPLAY "BVAL is not 0240 but " BVAL - END-IF. - STOP RUN. -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) - -AT_CHECK([./prog], [0], [ XVAL is 00512; Length is 2 - VAL9 is 01024; Length is 3 - XVAL is 10240; Length is 2 -XVAL2 is 16706; Length is 2 -XVALX is AB; Length is 2 -XVALX is AC after +1; -XVALX is A after / 256 + 8192; -Numeric: 17477 is char DE -Numeric: 08261 is char E -XVAL is 10240 -BVAL is 0240 -], []) - -AT_CLEANUP - - -AT_SETUP([SORT: table sort]) -AT_KEYWORDS([runmisc]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 G VALUE "d4b2e1a3c5". - 02 TBL OCCURS 5. - 03 X PIC X. - 03 Y PIC 9. - PROCEDURE DIVISION. - SORT TBL ASCENDING KEY X. - IF G NOT = "a3b2c5d4e1" - DISPLAY G - END-DISPLAY - END-IF. - SORT TBL DESCENDING KEY Y. - IF G NOT = "c5d4a3b2e1" - DISPLAY G - END-DISPLAY - END-IF. - SORT TBL ASCENDING KEY TBL. - IF G NOT = "a3b2c5d4e1" - DISPLAY G - END-DISPLAY - END-IF. - SORT TBL DESCENDING KEY. - IF G NOT = "e1d4c5b2a3" - DISPLAY G - END-DISPLAY - END-IF. - STOP RUN. -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [], []) - -AT_CLEANUP - - -AT_SETUP([SORT: table sort (2)]) -AT_KEYWORDS([runmisc]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 K PIC 9(2). - - 01 CNT1 PIC 9(9) COMP-5 VALUE 4. - 01 TAB1. - 05 ROW1 OCCURS 1 TO 4 DEPENDING CNT1 - DESCENDING TAB1-NR. - 10 TAB1-NR PIC 99. - - 01 TAB2. - 05 CNT2 PIC 9(9) COMP-5 VALUE 4. - 05 ROW2 OCCURS 1 TO 4 DEPENDING CNT2 - DESCENDING TAB2-NR. - 10 TAB2-NR PIC 99. - - 01 TAB3. - 05 CNT3 PIC 9(9) COMP-5 VALUE 10. - 05 ROW3 OCCURS 1 TO 10 DEPENDING CNT3 - DESCENDING TAB3-NR - ASCENDING TAB3-DATA. - 10 TAB3-NR PIC 99. - 10 FILLER PIC X(2). - 10 TAB3-DATA PIC X(5). - 10 FILLER PIC X(2). - 10 TAB3-DATA2 PIC X(5). - - - PROCEDURE DIVISION. - A. - PERFORM VARYING K FROM 1 BY 1 UNTIL K > 4 - MOVE K TO TAB1-NR(K), TAB2-NR(K) - END-PERFORM - - MOVE 1 TO TAB3-NR(1). - MOVE 1 TO TAB3-NR(8). - MOVE 1 TO TAB3-NR(4). - MOVE 6 TO TAB3-NR(2). - MOVE 5 TO TAB3-NR(3). - MOVE 5 TO TAB3-NR(9). - MOVE 2 TO TAB3-NR(5). - MOVE 2 TO TAB3-NR(10). - MOVE 4 TO TAB3-NR(6). - MOVE 3 TO TAB3-NR(7). - - MOVE "abcde" TO TAB3-DATA(1). - MOVE "AbCde" TO TAB3-DATA(2). - MOVE "abcde" TO TAB3-DATA(3). - MOVE "zyx" TO TAB3-DATA(4). - MOVE "12345" TO TAB3-DATA(5). - MOVE "zyx" TO TAB3-DATA(6). - MOVE "abcde" TO TAB3-DATA(7). - MOVE "AbCde" TO TAB3-DATA(8). - MOVE "abc" TO TAB3-DATA(9). - MOVE "12346" TO TAB3-DATA(10). - - MOVE "day" TO TAB3-DATA2(1). - MOVE "The" TO TAB3-DATA2(2). - MOVE "eats" TO TAB3-DATA2(3). - MOVE "." TO TAB3-DATA2(4). - MOVE "mooos" TO TAB3-DATA2(5). - MOVE "grass" TO TAB3-DATA2(6). - MOVE "and" TO TAB3-DATA2(7). - MOVE "whole" TO TAB3-DATA2(8). - MOVE "cow" TO TAB3-DATA2(9). - MOVE "the" TO TAB3-DATA2(10). - - SORT ROW1 DESCENDING TAB1-NR - SORT ROW2 DESCENDING TAB2-NR - - DISPLAY "SINGLE TABLE" END-DISPLAY - PERFORM VARYING K FROM 1 BY 1 UNTIL K > 4 - DISPLAY FUNCTION TRIM(TAB1-NR(K)) END-DISPLAY - END-PERFORM - - DISPLAY "LOWER LEVEL TABLE" END-DISPLAY - PERFORM VARYING K FROM 1 BY 1 UNTIL K > 4 - DISPLAY FUNCTION TRIM(TAB2-NR(K)) END-DISPLAY - END-PERFORM - - SORT ROW3 DESCENDING TAB3-NR ASCENDING TAB3-DATA - - DISPLAY "MULTY KEY SORT" END-DISPLAY - PERFORM VARYING K FROM 1 BY 1 UNTIL K > 10 - DISPLAY FUNCTION TRIM(ROW3(K)) - END-DISPLAY - END-PERFORM - - STOP RUN. -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [SINGLE TABLE -04 -03 -02 -01 -LOWER LEVEL TABLE -04 -03 -02 -01 -MULTY KEY SORT -06 AbCde The -05 abc cow -05 abcde eats -04 zyx grass -03 abcde and -02 12345 mooos -02 12346 the -01 AbCde whole -01 abcde day -01 zyx . -], []) - -AT_CLEANUP - - -AT_SETUP([SORT: table sort (3)]) - -AT_KEYWORDS([runmisc]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 K PIC 9(2). - - 01 CNT1 PIC 9(9) COMP-5 VALUE 4. - 01 TAB1. - 05 ROW1 OCCURS 1 TO 4 DEPENDING CNT1 - DESCENDING TAB1-NR. - 10 TAB1-NR PIC 99. - 10 TAB-DATA PIC X(5). - 01 TAB2. - 05 ROW2 OCCURS 1 TO 4 DEPENDING CNT1 - ASCENDING ROW2. - 10 TAB2-NR PIC 99. - 10 TAB2-DATA PIC X(5). - - PROCEDURE DIVISION. - A. - PERFORM VARYING K FROM 1 BY 1 UNTIL K > 4 - MOVE K TO TAB1-NR (K) - MOVE 'BLA' TO TAB-DATA(K) - END-PERFORM - - SORT ROW1 - - PERFORM VARYING K FROM 1 BY 1 UNTIL K > 4 - DISPLAY TAB1-NR(K) NO ADVANCING END-DISPLAY - END-PERFORM - - MOVE TAB1 TO TAB2 - SORT ROW2 - - PERFORM VARYING K FROM 1 BY 1 UNTIL K > 4 - DISPLAY TAB2-NR(K) NO ADVANCING END-DISPLAY - END-PERFORM - - STOP RUN. -]) - -AT_DATA([prog2.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog2. - ENVIRONMENT DIVISION. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 K PIC 9(2). - - 01 CNT1 PIC 9(9) COMP-5 VALUE 4. - 01 TAB1. - 05 ROW1 OCCURS 5 DESCENDING TAB1-NR. - 10 TAB1-NR PIC 99 VALUE ZERO. - 10 TAB-DATA PIC X(5). - 01 TAB2. - 05 ROW1 OCCURS 1 TO 4 DEPENDING CNT1 - DESCENDING TAB1-NR. - 10 TAB1-NR PIC 99. - 10 TAB-DATA PIC X(5). - - PROCEDURE DIVISION. - A. - DISPLAY TAB1-NR OF TAB1 (2) NO ADVANCING END-DISPLAY - - PERFORM VARYING K FROM 1 BY 1 UNTIL K > 4 - MOVE K TO TAB1-NR OF TAB2(K) - MOVE 'BLA' TO TAB-DATA OF TAB2(K) - END-PERFORM - - SORT ROW1 OF TAB2. - - PERFORM VARYING K FROM 1 BY 1 UNTIL K > 4 - DISPLAY TAB1-NR OF TAB2(K) NO ADVANCING END-DISPLAY - END-PERFORM - - STOP RUN. -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [0403020101020304], []) - -AT_CHECK([$COMPILE prog2.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog2], [0], [0004030201], []) - -AT_CLEANUP - - -AT_SETUP([SORT: EBCDIC table sort]) -AT_KEYWORDS([runmisc ALPHABET]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - CONFIGURATION SECTION. - SPECIAL-NAMES. - ALPHABET ALPHA IS EBCDIC. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 Z PIC X(10) VALUE "d4b2e1a3c5". - 01 G. - 02 TBL OCCURS 10. - 03 X PIC X. - PROCEDURE DIVISION. - MOVE Z TO G. - SORT TBL ASCENDING KEY X SEQUENCE ALPHA. - IF G NOT = "abcde12345" - DISPLAY G - END-DISPLAY - END-IF. - MOVE Z TO G. - SORT TBL DESCENDING KEY X SEQUENCE ALPHA. - IF G NOT = "54321edcba" - DISPLAY G - END-DISPLAY - END-IF. - STOP RUN. -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [], []) - -AT_CLEANUP - - -AT_SETUP([PIC ZZZ-, ZZZ+]) -AT_KEYWORDS([runmisc editing]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 X-ZZZN PIC ZZZ-. - 01 XZN-RED REDEFINES X-ZZZN PIC X(4). - 01 X-ZZZP PIC ZZZ+. - 01 XZP-RED REDEFINES X-ZZZP PIC X(4). - PROCEDURE DIVISION. - MOVE -1 TO X-ZZZN. - IF XZN-RED NOT = " 1-" - DISPLAY "(" X-ZZZN ")" - END-DISPLAY - END-IF. - MOVE 0 TO X-ZZZN. - IF XZN-RED NOT = " " - DISPLAY "(" X-ZZZN ")" - END-DISPLAY - END-IF. - MOVE +1 TO X-ZZZN. - IF XZN-RED NOT = " 1 " - DISPLAY "(" X-ZZZN ")" - END-DISPLAY - END-IF. - - MOVE -1 TO X-ZZZP. - IF XZP-RED NOT = " 1-" - DISPLAY "(" X-ZZZP ")" - END-DISPLAY - END-IF. - MOVE 0 TO X-ZZZP. - IF XZP-RED NOT = " " - DISPLAY "(" X-ZZZP ")" - END-DISPLAY - END-IF. - MOVE +1 TO X-ZZZP. - IF XZP-RED NOT = " 1+" - DISPLAY "(" X-ZZZP ")" - END-DISPLAY - END-IF. - STOP RUN. -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [], []) - -AT_CLEANUP - - -AT_SETUP([PERFORM type OSVS]) -AT_KEYWORDS([runmisc]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 MYOCC PIC 9(8) COMP VALUE 0. - PROCEDURE DIVISION. - ASTART SECTION. - A01. - PERFORM BTEST. - IF MYOCC NOT = 2 - DISPLAY MYOCC - END-DISPLAY - END-IF. - STOP RUN. - BTEST SECTION. - B01. - PERFORM B02 VARYING MYOCC FROM 1 BY 1 - UNTIL MYOCC > 5. - GO TO B99. - B02. - IF MYOCC > 1 - GO TO B99 - END-IF. - B99. - EXIT. -]) - -AT_CHECK([$COMPILE -fperform-osvs prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [], []) - -AT_CLEANUP - - -AT_SETUP([Sticky LINKAGE]) -AT_KEYWORDS([runmisc]) - -AT_DATA([callee.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. callee. - DATA DIVISION. - LINKAGE SECTION. - 01 P1 PIC X. - 01 P2 PIC X(6). - 01 P3 PIC X(6). - PROCEDURE DIVISION USING P1 P2. - IF P1 = "A" - SET ADDRESS OF P3 TO ADDRESS OF P2 - ELSE - IF P3 NOT = "OKOKOK" - DISPLAY P3 - END-DISPLAY - END-IF - END-IF. - EXIT PROGRAM. -]) - -AT_DATA([caller.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. caller. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 P1 PIC X VALUE "A". - 01 P2 PIC X(6) VALUE "NOT OK". - PROCEDURE DIVISION. - CALL "callee" USING P1 P2 - END-CALL. - MOVE "B" TO P1. - MOVE "OKOKOK" TO P2. - CALL "callee" USING P1 - END-CALL. - STOP RUN. -]) - -AT_CHECK([$COMPILE_MODULE -fsticky-linkage callee.cob], [0], [], []) -AT_CHECK([$COMPILE -fsticky-linkage caller.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./caller], [0], [], []) - -AT_CLEANUP - - -AT_SETUP([COB_PRE_LOAD]) -AT_KEYWORDS([runmisc]) - -AT_DATA([callee.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. callee2. - PROCEDURE DIVISION. - EXIT PROGRAM. -]) - -AT_DATA([caller.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. caller. - PROCEDURE DIVISION. - CALL "callee2" - END-CALL. - STOP RUN. -]) - -AT_CHECK([$COMPILE_MODULE callee.cob], [0], [], []) -AT_CHECK([$COMPILE caller.cob], [0], [], []) -AT_CHECK([COB_PRE_LOAD=callee $COBCRUN_DIRECT ./caller], [0], [], []) - -AT_CLEANUP - - -AT_SETUP([COB_PRE_LOAD with entry points]) -AT_KEYWORDS([runmisc]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - - DATA DIVISION. - WORKING-STORAGE SECTION. - - 01 VAR1 PIC X(5) VALUE '12abc'. - 01 VAR2 PIC X(2) VALUE '11'. - - PROCEDURE DIVISION. - - ENTRY 'ent1'. - DISPLAY VAR1 END-DISPLAY - GOBACK. - - ENTRY 'ent2'. - DISPLAY VAR2 END-DISPLAY - GOBACK. -]) - -AT_DATA([prog1.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog1. - - DATA DIVISION. - WORKING-STORAGE SECTION. - - 01 VAR2 PIC X(2) VALUE '55'. - 01 VAR3 PIC X(5) VALUE 'xxxxx'. - - PROCEDURE DIVISION. - - ENTRY 'ent2'. - DISPLAY VAR2 END-DISPLAY - GOBACK. - - ENTRY 'ent3'. - DISPLAY VAR3 END-DISPLAY - GOBACK. -]) - -AT_DATA([main-prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. main-prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - PROCEDURE DIVISION. - - CALL 'ent1' END-CALL - CALL 'ent2' END-CALL - CALL 'ent3' END-CALL - - STOP RUN. -]) - -AT_CHECK([$COMPILE_MODULE prog.cob], [0], [], []) -AT_CHECK([$COMPILE_MODULE prog1.cob], [0], [], []) -AT_CHECK([$COMPILE main-prog.cob], [0], [], []) -AT_CHECK([COB_PRE_LOAD="prog"$PATHSEP"prog1" $COBCRUN_DIRECT ./main-prog], [0], -[12abc -11 -xxxxx -], []) - -AT_CLEANUP - - -AT_SETUP([Lookup ENTRY from main executable]) -AT_KEYWORDS([runmisc]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 PROGRAM-LINK USAGE PROGRAM-POINTER. - - PROCEDURE DIVISION. - SET PROGRAM-LINK TO ENTRY "subprogram" - IF PROGRAM-LINK EQUAL NULL THEN - DISPLAY "error: no subprogram linkage" UPON SYSERR - END-DISPLAY - ELSE - CALL PROGRAM-LINK - ON EXCEPTION - DISPLAY "hard error: unable to invoke subprogram" - UPON SYSERR - END-DISPLAY - END-CALL - DISPLAY RETURN-CODE WITH NO ADVANCING - END-DISPLAY - END-IF - GOBACK. - - ENTRY "subprogram". - DISPLAY "subprogram" WITH NO ADVANCING - END-DISPLAY - SET RETURN-CODE TO 42 - . -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [42], [subprogram+000000042], []) - -AT_CLEANUP - - -AT_SETUP([COB_LOAD_CASE=UPPER test]) -AT_KEYWORDS([runmisc]) - -AT_DATA([CALLEE.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. callee. - PROCEDURE DIVISION. - EXIT PROGRAM. -]) - -AT_DATA([caller.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. caller. - PROCEDURE DIVISION. - CALL "callee" - END-CALL. - STOP RUN. -]) - -AT_CHECK([$COMPILE_MODULE CALLEE.cob], [0], [], []) -AT_CHECK([$COMPILE caller.cob], [0], [], []) -AT_CHECK([COB_LOAD_CASE=UPPER ./caller], [0], [], []) - -AT_CLEANUP - - -AT_SETUP([ALLOCATE / FREE with BASED item (1)]) -AT_KEYWORDS([runmisc]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - LINKAGE SECTION. - 01 MYFLD PIC X(6) BASED VALUE "ABCDEF". - PROCEDURE DIVISION. - ASTART SECTION. - A01. - ALLOCATE MYFLD INITIALIZED. - IF MYFLD NOT = "ABCDEF" - DISPLAY MYFLD - END-DISPLAY - END-IF. - FREE ADDRESS OF MYFLD. - STOP RUN. -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [], []) - -AT_CLEANUP - - -AT_SETUP([ALLOCATE / FREE with BASED item (2)]) -AT_KEYWORDS([runmisc]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 MYFLD BASED. - 03 MYFLDX PIC X. - 03 MYFLD9 PIC 9. - PROCEDURE DIVISION. - IF ADDRESS OF MYFLD NOT = NULL - DISPLAY "BASED ITEM WITH ADDRESS ON START" - END-DISPLAY - END-IF. - FREE MYFLD. - ALLOCATE MYFLD. - IF ADDRESS OF MYFLD = NULL - DISPLAY "BASED ITEM WITHOUT ADDRESS AFTER ALLOCATE" - END-DISPLAY - END-IF. - INITIALIZE MYFLD. - IF MYFLD NOT = " 0" - DISPLAY "BASED ITEM INITIALIZED WRONG: " - WITH NO ADVANCING - END-DISPLAY - DISPLAY MYFLD - END-DISPLAY - END-IF. - - FREE ADDRESS OF MYFLD. - IF ADDRESS OF MYFLD NOT = NULL - DISPLAY "BASED ITEM WITH ADDRESS AFTER FREE" - END-DISPLAY - END-IF. -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [], []) -# Run both executable and module as we have a different code generation here -AT_CHECK([$COMPILE_MODULE prog.cob], [0], [], []) -AT_CHECK([$COBCRUN prog], [0], [], []) - -AT_CLEANUP - - -AT_SETUP([ALLOCATE CHARACTERS INITIALIZED TO]) -AT_KEYWORDS([runmisc]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 MYPTR USAGE POINTER. - LINKAGE SECTION. - 01 MYFLD PIC X(4). - PROCEDURE DIVISION. - ASTART SECTION. - A01. - ALLOCATE 4 CHARACTERS - INITIALIZED TO "ABCD" - RETURNING MYPTR. - SET ADDRESS OF MYFLD TO MYPTR. - IF MYFLD NOT = "ABCD" - DISPLAY MYFLD - END-DISPLAY - END-IF. - FREE MYPTR. - ALLOCATE 4 CHARACTERS - INITIALIZED TO ALL "Z" - RETURNING MYPTR. - SET ADDRESS OF MYFLD TO MYPTR. - IF MYFLD NOT = "ZZZZ" - DISPLAY MYFLD - END-DISPLAY - END-IF. - FREE MYPTR. - STOP RUN. -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [], []) - -AT_CLEANUP - - -AT_SETUP([Initialized value with defaultbyte]) -AT_KEYWORDS([runmisc]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 MYFLD PIC X(6). - PROCEDURE DIVISION. - ASTART SECTION. - A01. - IF MYFLD NOT = "AAAAAA" - DISPLAY MYFLD - END-DISPLAY - END-IF. - STOP RUN. -]) - -AT_CHECK([$COMPILE -fdefaultbyte=A prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [], []) - -AT_CLEANUP - - -AT_SETUP([CALL with OMITTED parameter]) -AT_KEYWORDS([runmisc]) - -AT_DATA([callee.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. callee. - DATA DIVISION. - LINKAGE SECTION. - 01 P1 PIC X. - 01 P2 PIC X(6). - PROCEDURE DIVISION USING P1 OPTIONAL P2. - IF P2 NOT OMITTED - DISPLAY P2 - END-DISPLAY - END-IF. - EXIT PROGRAM. -]) - -AT_DATA([caller.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. caller. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 P1 PIC X VALUE "A". - PROCEDURE DIVISION. - CALL "callee" USING P1 - END-CALL. - CALL "callee" USING P1 OMITTED - END-CALL. - STOP RUN. -]) - -AT_CHECK([$COMPILE_MODULE callee.cob], [0], [], []) -AT_CHECK([$COMPILE caller.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./caller], [0], [], []) - -AT_CLEANUP - - -AT_SETUP([CALL in from C, cob_call_params explicitly set]) -AT_KEYWORDS([runmisc]) - -AT_DATA([callee.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. callee. - DATA DIVISION. - LINKAGE SECTION. - 01 P1 PIC X. - 01 P2 PIC X(6). - PROCEDURE DIVISION USING P1 OPTIONAL P2. - IF P2 NOT OMITTED - DISPLAY 'UNEXPECTED P2: ' P2 - END-DISPLAY - END-IF - DISPLAY 'P1: ' P1 WITH NO ADVANCING - END-DISPLAY. - EXIT PROGRAM. -]) - -AT_DATA([caller.c], [[ -#include -#include - -int callee (char *, char *); - -#ifndef NULL -#define NULL (void*)0 -#endif - -int -main (int argc, char **argv) -{ - /* for storing COBOL return code */ - int cob_ret; - - /* initialize parameters */ - char *p1 = "A"; - - /* initialize the COBOL run-time library */ - cob_init(argc, argv); - - /* setup for COBOL parameter handling */ - cob_set_num_params (1); - - /* call COBOL program */ - cob_ret = callee (p1, NULL); - - /* Clean up and terminate - This does not return */ - cob_stop_run (cob_ret); -} -]]) - -AT_CHECK([$COMPILE -o caller caller.c callee.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./caller], [0], [P1: A], []) - -AT_CLEANUP - - -AT_SETUP([CALL in from C, cob_call_params unknown]) -AT_KEYWORDS([runmisc]) - -AT_DATA([callee.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. callee. - DATA DIVISION. - LINKAGE SECTION. - 01 P1 PIC X. - 01 P2 PIC X(6). - PROCEDURE DIVISION USING P1 P2. - IF P1 NOT EQUAL "A" - DISPLAY P1 - END-DISPLAY - END-IF. - IF P2 NOT EQUAL "FROM C" - DISPLAY P2 - END-DISPLAY - ELSE - DISPLAY "OK" WITH NO ADVANCING - END-DISPLAY - END-IF. - EXIT PROGRAM. -]) - -AT_DATA([caller.c], [[ -#include -#include - -int callee (char *, char *); - -int -main (int argc, char **argv) -{ - /* for storing COBOL return code */ - int cob_ret; - - /* initialize parameters */ - char *p1 = "A"; - char *p2 = "FROM C"; - - /* initialize the COBOL run-time library */ - cob_init (argc, argv); - - /* call COBOL program */ - cob_ret = callee (p1, p2); - - /* Clean up and terminate - This does not return */ - cob_stop_run (cob_ret); -} -]]) - -AT_CHECK([$COMPILE -o caller caller.c callee.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./caller], [0], [OK], []) - -AT_CLEANUP - - -AT_SETUP([CALL C with callback, PROCEDURE DIVISION EXTERN]) -AT_KEYWORDS([runmisc extensions call-convention]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 CB USAGE PROGRAM-POINTER. - PROCEDURE DIVISION. - SET CB TO ENTRY "callback" - CALL STATIC "cprog" USING BY VALUE CB - END-CALL - EXIT PROGRAM. - END PROGRAM prog. - - IDENTIFICATION DIVISION. - PROGRAM-ID. callback. - ENVIRONMENT DIVISION. - CONFIGURATION SECTION. - SPECIAL-NAMES. - CALL-CONVENTION 0 IS EXTERN. - DATA DIVISION. - LINKAGE SECTION. - 01 P1 USAGE POINTER. - 01 P2 USAGE BINARY-LONG. - 01 P3 PIC X(8). - PROCEDURE DIVISION EXTERN USING - BY VALUE P1 P2 BY REFERENCE P3. - IF P1 NOT EQUAL ADDRESS OF P3 - DISPLAY P1 - END-DISPLAY - END-IF - IF P2 NOT EQUAL 42 - DISPLAY P2 - END-DISPLAY - END-IF - IF P3 NOT EQUAL "CALLBACK" - DISPLAY P3 - END-DISPLAY - END-IF - EXIT PROGRAM. -]) - -AT_DATA([cprog.c], [[ -#include -#include - -COB_EXT_EXPORT int -cprog (void *cb) -{ - char *p1; - int p2 = 42; - char *p3 = "CALLBACK"; - - p1 = p3; - cob_set_num_params (3); - ((int (*)(char *, int, char *))cb)(p1, p2, p3); - return 0; -} -]]) - -AT_CHECK([$COMPILE -Wno-unfinished -o prog prog.cob cprog.c], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [], []) - -AT_CLEANUP - - -AT_SETUP([CALL C with callback, ENTRY-CONVENTION EXTERN]) -AT_KEYWORDS([runmisc CALL-CONVENTION LINKAGE]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - OPTIONS. - ENTRY-CONVENTION COBOL. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 CB USAGE PROGRAM-POINTER. - PROCEDURE DIVISION. - SET CB TO ENTRY "callback" - CALL STATIC "cprog" USING BY VALUE CB - END-CALL - EXIT PROGRAM. - END PROGRAM prog. - - IDENTIFICATION DIVISION. - PROGRAM-ID. callback. - OPTIONS. - ENTRY-CONVENTION EXTERN. - DATA DIVISION. - LINKAGE SECTION. - 01 P1 USAGE POINTER. - 01 P2 USAGE BINARY-LONG. - 01 P3 PIC X(8). - PROCEDURE DIVISION USING - BY VALUE P1 P2 BY REFERENCE P3. - IF P1 NOT EQUAL ADDRESS OF P3 - DISPLAY P1 - END-DISPLAY - END-IF - IF P2 NOT EQUAL 42 - DISPLAY P2 - END-DISPLAY - END-IF - IF P3 NOT EQUAL "CALLBACK" - DISPLAY P3 - END-DISPLAY - END-IF - EXIT PROGRAM. -]) - -AT_DATA([cprog.c], [[ -#include -#include - -COB_EXT_EXPORT int -cprog (void *cb) -{ - char *p1; - int p2 = 42; - char *p3 = "CALLBACK"; - - p1 = p3; - cob_set_num_params (3); - ((int (*)(char *, int, char *))cb)(p1, p2, p3); - return 0; -} -]]) - -AT_CHECK([$COMPILE -Wno-unfinished -o prog prog.cob cprog.c], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [], []) - -AT_DATA([prog2.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 CB USAGE PROGRAM-POINTER. - PROCEDURE DIVISION. - SET CB TO ENTRY "callback" - CALL STATIC "cprog" USING BY VALUE CB - END-CALL - EXIT PROGRAM. - END PROGRAM prog. - - IDENTIFICATION DIVISION. - PROGRAM-ID. callback. - DATA DIVISION. - LINKAGE SECTION. - 01 P1 USAGE POINTER. - 01 P2 USAGE BINARY-LONG. - 01 P3 PIC X(8). - PROCEDURE DIVISION WITH C LINKAGE - USING BY VALUE P1 P2 BY REFERENCE P3. - IF P1 NOT EQUAL ADDRESS OF P3 - DISPLAY P1 - END-DISPLAY - END-IF - IF P2 NOT EQUAL 42 - DISPLAY P2 - END-DISPLAY - END-IF - IF P3 NOT EQUAL "CALLBACK" - DISPLAY P3 - END-DISPLAY - END-IF - EXIT PROGRAM. -]) - -AT_DATA([prog3.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 CB USAGE PROGRAM-POINTER. - PROCEDURE DIVISION. - SET CB TO ENTRY "callback" - CALL STATIC "cprog" USING BY VALUE CB - END-CALL - EXIT PROGRAM. - END PROGRAM prog. - - IDENTIFICATION DIVISION. - PROGRAM-ID. callback. - ENVIRONMENT DIVISION. - CONFIGURATION SECTION. - SPECIAL-NAMES. - CALL-CONVENTION 0 IS EXTERN. - DATA DIVISION. - LINKAGE SECTION. - 01 P1 USAGE POINTER. - 01 P2 USAGE BINARY-LONG. - 01 P3 PIC X(8). - PROCEDURE DIVISION EXTERN - USING BY VALUE P1 P2 BY REFERENCE P3. - IF P1 NOT EQUAL ADDRESS OF P3 - DISPLAY P1 - END-DISPLAY - END-IF - IF P2 NOT EQUAL 42 - DISPLAY P2 - END-DISPLAY - END-IF - IF P3 NOT EQUAL "CALLBACK" - DISPLAY P3 - END-DISPLAY - END-IF - EXIT PROGRAM. -]) - -AT_CHECK([$COMPILE -Wno-unfinished -o prog prog2.cob cprog.c], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [], []) - -AT_CHECK([$COMPILE -Wno-unfinished -o prog prog3.cob cprog.c], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [], []) - -AT_CLEANUP - - -AT_SETUP([CALL in from C with init missing / implicit]) -AT_KEYWORDS([runmisc implicit-init]) - -AT_DATA([callee.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. callee. - DATA DIVISION. - LINKAGE SECTION. - 01 P1 PIC X. - 01 P2 PIC X(6). - PROCEDURE DIVISION USING P1 P2. - IF P1 NOT EQUAL "A" - DISPLAY P1 - END-DISPLAY - END-IF. - IF P2 NOT EQUAL "FROM C" - DISPLAY P2 - END-DISPLAY - ELSE - DISPLAY "OK" WITH NO ADVANCING - END-DISPLAY - END-IF. - STOP RUN. -]) - -AT_DATA([caller.c], [[ -int callee (char *, char *); - -int -main (int argc, char **argv) -{ - /* initialize parameters */ - char *p1 = "A"; - char *p2 = "FROM C"; - - /* call COBOL program (initialization missing) - note: COBOL program terminates the program by STOP RUN */ - (void)callee (p1, p2); - return 0; -} -]]) - -AT_CHECK([$COMPILE -o caller caller.c callee.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./caller], [1], [], -[libcob: error: cob_init() has not been called -]) - -AT_CHECK([$COMPILE -fimplicit-init -o caller caller.c callee.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./caller], [0], [OK], []) - -AT_CLEANUP - - -AT_SETUP([CALL STATIC C from COBOL]) -AT_KEYWORDS([runmisc]) - -AT_DATA([caller.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. caller. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 P1 PIC X VALUE "A". - 01 P2 PIC X(7). - 77 P2-COB PIC X(7). - PROCEDURE DIVISION. - CALL STATIC 'callee' USING P1 P2 - IF P1 NOT EQUAL "B" - DISPLAY 'NOT A: ' P1 - END-DISPLAY - END-IF - UNSTRING P2 DELIMITED BY LOW-VALUE - INTO P2-COB - END-UNSTRING - EVALUATE TRUE - WHEN P2-COB NOT EQUAL "FROM C" - DISPLAY P2-COB '-' P2 - END-DISPLAY - WHEN RETURN-CODE NOT = 3 - DISPLAY RETURN-CODE - END-DISPLAY - WHEN OTHER - DISPLAY 'OK' WITH NO ADVANCING - END-DISPLAY - MOVE 0 TO RETURN-CODE - END-EVALUATE - EXIT PROGRAM. -]) - -AT_DATA([callee.c], [[ -#include - -int -callee (char *p1, char *p2) -{ - if (p1[0] == 'A') { - p1[0] = 'B'; - } - memcpy (p2, "FROM C", 6); - - return 3; -} -]]) - -AT_CHECK([$COMPILE -o caller caller.cob callee.c], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./caller], [0], [OK], []) - -AT_CLEANUP - - -AT_SETUP([ANY LENGTH (1)]) -AT_KEYWORDS([runmisc CALL]) - -AT_DATA([callee.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. callee. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 P2 PIC 99. - LINKAGE SECTION. - 01 P1 PIC X ANY LENGTH. - PROCEDURE DIVISION USING P1. - MOVE LENGTH OF P1 TO P2. - IF P2 NOT = 6 - DISPLAY P2 - END-DISPLAY - END-IF. - IF P1 NOT = "OKOKOK" - DISPLAY P1 - END-DISPLAY - END-IF. - EXIT PROGRAM. -]) - -AT_DATA([caller.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. caller. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 P1 PIC X(6) VALUE "OKOKOK". - PROCEDURE DIVISION. - CALL "callee" USING P1 - END-CALL. - STOP RUN. -]) - -AT_CHECK([$COMPILE_MODULE callee.cob], [0], [], []) -AT_CHECK([$COMPILE caller.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./caller], [0], [], []) - -AT_CLEANUP - - -AT_SETUP([ANY LENGTH (2)]) -AT_KEYWORDS([runmisc CALL]) - -AT_DATA([callee.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. callee. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 P2 PIC XXX. - LINKAGE SECTION. - 01 P1 PIC X ANY LENGTH. - PROCEDURE DIVISION USING P1. - MOVE P1 TO P2. - IF P2 NOT = "OK " - DISPLAY P2 - END-DISPLAY - END-IF. - MOVE SPACE TO P1. - EXIT PROGRAM. -]) - -AT_DATA([caller.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. caller. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 P1 PIC X(2) VALUE "OK". - PROCEDURE DIVISION. - CALL "callee" USING P1 - END-CALL. - IF P1 NOT = SPACE - DISPLAY P1 - END-DISPLAY - END-IF. - STOP RUN. -]) - -AT_CHECK([$COMPILE_MODULE callee.cob], [0], [], []) -AT_CHECK([$COMPILE caller.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./caller], [0], [], []) - -AT_CLEANUP - - -AT_SETUP([ANY LENGTH (3)]) -AT_KEYWORDS([runmisc CALL]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 str PIC X(20) VALUE ALL "X". - - PROCEDURE DIVISION. - CALL "subprog" USING str - . - END PROGRAM prog. - - IDENTIFICATION DIVISION. - PROGRAM-ID. subprog. - - DATA DIVISION. - LINKAGE SECTION. - 01 str PIC X ANY LENGTH. - - PROCEDURE DIVISION USING str. - MOVE "abcd" TO str - DISPLAY FUNCTION TRIM (str) - MOVE "abcd" TO str (5:) - DISPLAY FUNCTION TRIM (str) - MOVE ALL "a" TO str - DISPLAY FUNCTION TRIM (str) - . - END PROGRAM subprog. -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], -[abcd -abcdabcd -aaaaaaaaaaaaaaaaaaaa -]) -AT_CLEANUP - - -AT_SETUP([ANY LENGTH (4)]) -AT_KEYWORDS([runmisc IF CALL]) - -# comparision of any length was done only for first character - see bug 511 - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 str PIC X(20) VALUE ALL "X". - - PROCEDURE DIVISION. - CALL "subprog" USING str - move ' 45' to str - CALL "subprog" USING str - . - END PROGRAM prog. - - IDENTIFICATION DIVISION. - PROGRAM-ID. subprog. - - DATA DIVISION. - LINKAGE SECTION. - 01 str PIC X ANY LENGTH. - - PROCEDURE DIVISION USING str. - IF str = 'X' - DISPLAY 'X is X' - END-IF - IF str = space - DISPLAY 'X is space' - END-IF - . - END PROGRAM subprog. -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [], []) -AT_CLEANUP - - -AT_SETUP([ANY LENGTH (5)]) -AT_KEYWORDS([runmisc]) - -# any length variables resulted in SIGSEGV when module was first program called - -AT_DATA([subprog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. subprog. - - DATA DIVISION. - LINKAGE SECTION. - 01 str1 PIC X ANY LENGTH. - 01 str2 PIC X ANY LENGTH. - - PROCEDURE DIVISION USING str1 str2. - DISPLAY 'IN' WITH NO ADVANCING - . - END PROGRAM subprog. -]) - -AT_CHECK([$COMPILE_MODULE subprog.cob], [0], [], []) -AT_CHECK([$COBCRUN subprog some test stuff], [0], [IN], []) -AT_CLEANUP - - -AT_SETUP([access to BASED item without allocation]) -AT_KEYWORDS([runmisc]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 X PIC X(4) BASED. - PROCEDURE DIVISION. - DISPLAY X NO ADVANCING - END-DISPLAY. - STOP RUN. -]) - -AT_DATA([prog2.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog2. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 X BASED. - 05 Y PIC X(4). - PROCEDURE DIVISION. - DISPLAY Y NO ADVANCING - END-DISPLAY. - STOP RUN. -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$COMPILE prog2.cob], [0], [], []) - -AT_CHECK([$COBCRUN_DIRECT ./prog], [1], [], -[libcob: prog.cob:8: error: BASED/LINKAGE item 'X' has NULL address -]) -AT_CHECK([$COBCRUN_DIRECT ./prog2], [1], [], -[libcob: prog2.cob:9: error: BASED/LINKAGE item 'X' (accessed by 'Y') has NULL address -]) - -AT_CLEANUP - - -AT_SETUP([access to OPTIONAL LINKAGE item not passed]) -AT_KEYWORDS([runmisc]) - -AT_DATA([caller.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. caller. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 X PIC X(4) VALUE '9876'. - PROCEDURE DIVISION. - CALL 'callee' USING X - END-CALL - CALL 'callee' USING OMITTED - END-CALL - STOP RUN. -]) - -AT_DATA([callee.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. callee. - DATA DIVISION. - LINKAGE SECTION. - 01 X. - 05 Y PIC X(4). - PROCEDURE DIVISION USING OPTIONAL X. - IF Y NOT = '9876' - DISPLAY Y NO ADVANCING - END-DISPLAY - END-IF. - GOBACK. -]) - -AT_CHECK([$COMPILE caller.cob], [0], [], []) -AT_CHECK([$COMPILE_MODULE callee.cob], [0], [], []) - -AT_CHECK([$COBCRUN_DIRECT ./caller], [1], [], -[libcob: callee.cob:9: error: LINKAGE item 'X' (accessed by 'Y') not passed by caller -]) - -AT_CLEANUP - - -AT_SETUP([STOP RUN WITH NORMAL STATUS]) -AT_KEYWORDS([runmisc]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - PROCEDURE DIVISION. - STOP RUN WITH NORMAL STATUS. -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [], []) - -AT_CLEANUP - - -AT_SETUP([STOP RUN WITH ERROR STATUS]) -AT_KEYWORDS([runmisc]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - PROCEDURE DIVISION. - STOP RUN WITH ERROR STATUS. -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [1]) - -AT_CLEANUP - - -AT_SETUP([SYMBOLIC clause]) -AT_KEYWORDS([runmisc ALPHABET]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - CONFIGURATION SECTION. - SPECIAL-NAMES. - ALPHABET A-EBC IS EBCDIC - ALPHABET A-ASC IS ASCII - SYMBOLIC Z-EBC IS 241 IN A-EBC - SYMBOLIC Z-ASC IS 49 IN A-ASC - . - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 Z PIC X. - PROCEDURE DIVISION. - MOVE Z-ASC TO Z. - IF Z NOT = "0" - DISPLAY Z - END-DISPLAY - END-IF. - MOVE Z-EBC TO Z. - IF Z NOT = "0" - DISPLAY Z - END-DISPLAY - END-IF. - STOP RUN. -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [], []) - -AT_CLEANUP - - -AT_SETUP([OCCURS clause with 1 entry]) -AT_KEYWORDS([runmisc]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 D1. - 03 FILLER OCCURS 1. - 05 D1-ENTRY PIC X(03) value '123'. - 01 D2. - 03 D2-ENTRY PIC X(03) value 'ABC' OCCURS 1. - 01 D1TOR. - 03 FILLER PIC X(03) value '456'. - 01 D1-R REDEFINES D1TOR. - 03 FILLER OCCURS 1. - 05 D1-R-ENTRY PIC X(03). - 01 D2TOR. - 03 FILLER PIC X(03) value 'DEF'. - 01 D2-R REDEFINES D2TOR. - 03 D2-R-ENTRY PIC X(03) OCCURS 1. - - PROCEDURE DIVISION. - IF D1-ENTRY (1) NOT = "123" - DISPLAY D1-ENTRY (1) - END-DISPLAY - END-IF. - IF D2-ENTRY (1) NOT = "ABC" - DISPLAY D2-ENTRY (1) - END-DISPLAY - END-IF. - IF D1-R-ENTRY (1) NOT = "456" - DISPLAY D1-R-ENTRY (1) - END-DISPLAY - END-IF. - IF D2-R-ENTRY (1) NOT = "DEF" - DISPLAY D2-R-ENTRY (1) - END-DISPLAY - END-IF. - STOP RUN. -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [], []) - -AT_CLEANUP - - -AT_SETUP([Computing of different USAGEs w/o decimal point]) -AT_KEYWORDS([runmisc -BINARY-C-LONG BINARY-CHAR BINARY-DOUBLE BINARY-LONG -COMP COMP-1 COMP-2 COMP-3 COMP-5 COMP-6 COMP-X COMP-N -FLOAT-DECIMAL-16 FLOAT-DECIMAL-34 FLOAT-LONG FLOAT-SHORT]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. 'prog'. - ENVIRONMENT DIVISION. - DATA DIVISION. - WORKING-STORAGE SECTION. - - * - 77 BCL-A BINARY-C-LONG VALUE 1. - 77 BCL-B BINARY-C-LONG VALUE 10. - 77 BCL-RES BINARY-C-LONG. - * - 77 BC-A BINARY-CHAR VALUE 1. - 77 BC-B BINARY-CHAR VALUE 10. - 77 BC-RES BINARY-CHAR. - * - 77 BD-A BINARY-DOUBLE VALUE 1. - 77 BD-B BINARY-DOUBLE VALUE 10. - 77 BD-RES BINARY-DOUBLE. - * - 77 BL-A BINARY-LONG VALUE 1. - 77 BL-B BINARY-LONG VALUE 10. - 77 BL-RES BINARY-LONG. - * - 77 C-A PIC S99 COMP VALUE 1. - 77 C-B PIC S99 COMP VALUE 10. - 77 C-RES PIC S99 COMP. - * - 77 C1-A COMP-1 VALUE 1. - 77 C1-B COMP-1 VALUE 10. - 77 C1-RES COMP-1. - * - 77 C2-A COMP-2 VALUE 1. - 77 C2-B COMP-2 VALUE 10. - 77 C2-RES COMP-2. - * - 77 C3-A PIC S99 COMP-3 VALUE 1. - 77 C3-B PIC S99 COMP-3 VALUE 10. - 77 C3-RES PIC S99 COMP-3. - * - 77 C5-A PIC S99 COMP-5 VALUE 1. - 77 C5-B PIC S99 COMP-5 VALUE 10. - 77 C5-RES PIC S99 COMP-5. - * - 77 C6-A PIC 99 COMP-6 VALUE 1. - 77 C6-B PIC 99 COMP-6 VALUE 10. - 77 C6-RES PIC 99 COMP-6. - * - 77 CN9-A PIC 99 COMP-N VALUE 1. - 77 CN9-B PIC 99 COMP-N VALUE 10. - 77 CN9-RES PIC 99 COMP-N. - * - 77 CNX-A PIC X COMP-N VALUE 1. - 77 CNX-B PIC X COMP-N VALUE 10. - 77 CNX-RES PIC X COMP-N. - * - 77 CX9-A PIC 99 COMP-X VALUE 1. - 77 CX9-B PIC 99 COMP-X VALUE 10. - 77 CX9-RES PIC 99 COMP-X. - * - 77 CXX-A PIC X COMP-X VALUE 1. - 77 CXX-B PIC X COMP-X VALUE 10. - 77 CXX-RES PIC X COMP-X. - * - 77 D-A PIC S99 VALUE 1. - 77 D-B PIC S99 VALUE 10. - 77 D-RES PIC S99. - * - 77 FD16-A FLOAT-DECIMAL-16 VALUE 1. - 77 FD16-B FLOAT-DECIMAL-16 VALUE 10. - 77 FD16-RES FLOAT-DECIMAL-16. - * - 77 FD34-A FLOAT-DECIMAL-34 VALUE 1. - 77 FD34-B FLOAT-DECIMAL-34 VALUE 10. - 77 FD34-RES FLOAT-DECIMAL-34. - * - 77 FL-A FLOAT-LONG VALUE 1. - 77 FL-B FLOAT-LONG VALUE 10. - 77 FL-RES FLOAT-LONG. - * - 77 FS-A FLOAT-SHORT VALUE 1. - 77 FS-B FLOAT-SHORT VALUE 10. - 77 FS-RES FLOAT-SHORT. - * - PROCEDURE DIVISION. - * - ADD BCL-B TO BCL-A END-ADD. - MOVE BCL-A TO BCL-RES. - IF BCL-RES NOT = 11 - DISPLAY 'ERROR BINARY-C-LONG + BINARY-C-LONG' - END-DISPLAY - END-IF. - MOVE 1 TO BCL-A. - ADD 10 TO BCL-A END-ADD. - MOVE BCL-A TO BCL-RES. - IF BCL-RES NOT = 11 - DISPLAY 'ERROR BINARY-C-LONG + NUM' - END-DISPLAY - END-IF. - MOVE 11 TO BCL-A. - SUBTRACT BCL-B FROM BCL-A END-SUBTRACT. - MOVE BCL-A TO BCL-RES. - IF BCL-RES NOT = 1 - DISPLAY 'ERROR BINARY-C-LONG - BINARY-C-LONG' - END-DISPLAY - END-IF. - MOVE 11 TO BCL-A. - SUBTRACT 10 FROM BCL-A END-SUBTRACT. - MOVE BCL-A TO BCL-RES. - IF BCL-RES NOT = 1 - DISPLAY 'ERROR BINARY-C-LONG - NUM' - END-DISPLAY - END-IF. - * - ADD BC-B TO BC-A END-ADD. - MOVE BC-A TO BC-RES. - IF BC-RES NOT = 11 - DISPLAY 'ERROR BINARY-CHAR + BINARY-CHAR' - END-DISPLAY - END-IF. - MOVE 1 TO BC-A. - ADD 10 TO BC-A END-ADD. - MOVE BC-A TO BC-RES. - IF BC-RES NOT = 11 - DISPLAY 'ERROR BINARY-CHAR + NUM' - END-DISPLAY - END-IF. - MOVE 11 TO BC-A. - SUBTRACT BC-B FROM BC-A END-SUBTRACT. - MOVE BC-A TO BC-RES. - IF BC-RES NOT = 1 - DISPLAY 'ERROR BINARY-CHAR - BINARY-CHAR' - END-DISPLAY - END-IF. - MOVE 11 TO BC-A. - SUBTRACT 10 FROM BC-A END-SUBTRACT. - MOVE BC-A TO BC-RES. - IF BC-RES NOT = 1 - DISPLAY 'ERROR BINARY-CHAR - NUM' - END-DISPLAY - END-IF. - * - ADD BD-B TO BD-A END-ADD. - MOVE BD-A TO BD-RES. - IF BD-RES NOT = 11 - DISPLAY 'ERROR BINARY-DOUBLE + BINARY-DOUBLE' - END-DISPLAY - END-IF. - MOVE 1 TO BD-A. - ADD 10 TO BD-A END-ADD. - MOVE BD-A TO BD-RES. - IF BD-RES NOT = 11 - DISPLAY 'ERROR BINARY-DOUBLE + NUM' - END-DISPLAY - END-IF. - MOVE 11 TO BD-A. - SUBTRACT BD-B FROM BD-A END-SUBTRACT. - MOVE BD-A TO BD-RES. - IF BD-RES NOT = 1 - DISPLAY 'ERROR BINARY-DOUBLE - BINARY-DOUBLE' - END-DISPLAY - END-IF. - MOVE 11 TO BD-A. - SUBTRACT 10 FROM BD-A END-SUBTRACT. - MOVE BD-A TO BD-RES. - IF BD-RES NOT = 1 - DISPLAY 'ERROR BINARY-DOUBLE - NUM' - END-DISPLAY - END-IF. - * - ADD BL-B TO BL-A END-ADD. - MOVE BL-A TO BL-RES. - IF BL-RES NOT = 11 - DISPLAY 'ERROR BINARY-LONG + BINARY-LONG' - END-DISPLAY - END-IF. - MOVE 1 TO BL-A. - ADD 10 TO BL-A END-ADD. - MOVE BL-A TO BL-RES. - IF BL-RES NOT = 11 - DISPLAY 'ERROR BINARY-LONG + NUM' - END-DISPLAY - END-IF. - MOVE 11 TO BL-A. - SUBTRACT BL-B FROM BL-A END-SUBTRACT. - MOVE BL-A TO BL-RES. - IF BL-RES NOT = 1 - DISPLAY 'ERROR BINARY-LONG - BINARY-LONG' - END-DISPLAY - END-IF. - MOVE 11 TO BL-A. - SUBTRACT 10 FROM BL-A END-SUBTRACT. - MOVE BL-A TO BL-RES. - IF BL-RES NOT = 1 - DISPLAY 'ERROR BINARY-LONG - NUM' - END-DISPLAY - END-IF. - * - ADD C-B TO C-A END-ADD. - MOVE C-A TO C-RES. - IF C-RES NOT = 11 - DISPLAY 'ERROR COMP + COMP' - END-DISPLAY - END-IF. - MOVE 1 TO C-A. - ADD 10 TO C-A END-ADD. - MOVE C-A TO C-RES. - IF C-RES NOT = 11 - DISPLAY 'ERROR COMP + NUM' - END-DISPLAY - END-IF. - MOVE 11 TO C-A. - SUBTRACT C-B FROM C-A END-SUBTRACT. - MOVE C-A TO C-RES. - IF C-RES NOT = 1 - DISPLAY 'ERROR COMP - COMP' - END-DISPLAY - END-IF. - MOVE 11 TO C-A. - SUBTRACT 10 FROM C-A END-SUBTRACT. - MOVE C-A TO C-RES. - IF C-RES NOT = 1 - DISPLAY 'ERROR COMP - NUM' - END-DISPLAY - END-IF. - * - ADD C1-B TO C1-A END-ADD. - MOVE C1-A TO C1-RES. - IF C1-RES NOT = 11 - DISPLAY 'ERROR COMP-1 + COMP-1' - END-DISPLAY - END-IF. - MOVE 1 TO C1-A. - ADD 10 TO C1-A END-ADD. - MOVE C1-A TO C1-RES. - IF C1-RES NOT = 11 - DISPLAY 'ERROR COMP-1 + NUM' - END-DISPLAY - END-IF. - MOVE 11 TO C1-A. - SUBTRACT C1-B FROM C1-A END-SUBTRACT. - MOVE C1-A TO C1-RES. - IF C1-RES NOT = 1 - DISPLAY 'ERROR COMP-1 - COMP-1' - END-DISPLAY - END-IF. - MOVE 11 TO C1-A. - SUBTRACT 10 FROM C1-A END-SUBTRACT. - MOVE C1-A TO C1-RES. - IF C1-RES NOT = 1 - DISPLAY 'ERROR COMP-1 - NUM' - END-DISPLAY - END-IF. - * - ADD C2-B TO C2-A END-ADD. - MOVE C2-A TO C2-RES. - IF C2-RES NOT = 11 - DISPLAY 'ERROR COMP-2 + COMP-2' - END-DISPLAY - END-IF. - MOVE 1 TO C2-A. - ADD 10 TO C2-A END-ADD. - MOVE C2-A TO C2-RES. - IF C2-RES NOT = 11 - DISPLAY 'ERROR COMP-2 + NUM' - END-DISPLAY - END-IF. - MOVE 11 TO C2-A. - SUBTRACT C2-B FROM C2-A END-SUBTRACT. - MOVE C2-A TO C2-RES. - IF C2-RES NOT = 1 - DISPLAY 'ERROR COMP-2 - COMP-2' - END-DISPLAY - END-IF. - MOVE 11 TO C2-A. - SUBTRACT 10 FROM C2-A END-SUBTRACT. - MOVE C2-A TO C2-RES. - IF C2-RES NOT = 1 - DISPLAY 'ERROR COMP-2 - NUM' - END-DISPLAY - END-IF. - * - ADD C3-B TO C3-A END-ADD. - MOVE C3-A TO C3-RES. - IF C3-RES NOT = 11 - DISPLAY 'ERROR COMP-3 + COMP-3' - END-DISPLAY - END-IF. - MOVE 1 TO C3-A. - ADD 10 TO C3-A END-ADD. - MOVE C3-A TO C3-RES. - IF C3-RES NOT = 11 - DISPLAY 'ERROR COMP-3 + NUM' - END-DISPLAY - END-IF. - MOVE 11 TO C3-A. - SUBTRACT C3-B FROM C3-A END-SUBTRACT. - MOVE C3-A TO C3-RES. - IF C3-RES NOT = 1 - DISPLAY 'ERROR COMP-3 - COMP-3' - END-DISPLAY - END-IF. - MOVE 11 TO C3-A. - SUBTRACT 10 FROM C3-A END-SUBTRACT. - MOVE C3-A TO C3-RES. - IF C3-RES NOT = 1 - DISPLAY 'ERROR COMP-3 - NUM' - END-DISPLAY - END-IF. - * - ADD C5-B TO C5-A END-ADD. - MOVE C5-A TO C5-RES. - IF C5-RES NOT = 11 - DISPLAY 'ERROR COMP-5 + COMP-5' - END-DISPLAY - END-IF. - MOVE 1 TO C5-A. - ADD 10 TO C5-A END-ADD. - MOVE C5-A TO C5-RES. - IF C5-RES NOT = 11 - DISPLAY 'ERROR COMP-5 + NUM' - END-DISPLAY - END-IF. - MOVE 11 TO C5-A. - SUBTRACT C5-B FROM C5-A END-SUBTRACT. - MOVE C5-A TO C5-RES. - IF C5-RES NOT = 1 - DISPLAY 'ERROR COMP-5 - COMP-5' - END-DISPLAY - END-IF. - MOVE 11 TO C5-A. - SUBTRACT 10 FROM C5-A END-SUBTRACT. - MOVE C5-A TO C5-RES. - IF C5-RES NOT = 1 - DISPLAY 'ERROR COMP-5 - NUM' - END-DISPLAY - END-IF. - * - ADD C6-B TO C6-A END-ADD. - MOVE C6-A TO C6-RES. - IF C6-RES NOT = 11 - DISPLAY 'ERROR COMP-6 + COMP-6' - END-DISPLAY - END-IF. - MOVE 1 TO C6-A. - ADD 10 TO C6-A END-ADD. - MOVE C6-A TO C6-RES. - IF C6-RES NOT = 11 - DISPLAY 'ERROR COMP-6 + NUM' - END-DISPLAY - END-IF. - MOVE 11 TO C6-A. - SUBTRACT C6-B FROM C6-A END-SUBTRACT. - MOVE C6-A TO C6-RES. - IF C6-RES NOT = 1 - DISPLAY 'ERROR COMP-6 - COMP-6' - END-DISPLAY - END-IF. - MOVE 11 TO C6-A. - SUBTRACT 10 FROM C6-A END-SUBTRACT. - MOVE C6-A TO C6-RES. - IF C6-RES NOT = 1 - DISPLAY 'ERROR COMP-6 - NUM' - END-DISPLAY - END-IF. - * - ADD CN9-B TO CN9-A END-ADD. - MOVE CN9-A TO CN9-RES. - IF CN9-RES NOT = 11 - DISPLAY 'ERROR COMP-N + COMP-N' - END-DISPLAY - END-IF. - MOVE 1 TO CN9-A. - ADD 10 TO CN9-A END-ADD. - MOVE CN9-A TO CN9-RES. - IF CN9-RES NOT = 11 - DISPLAY 'ERROR COMP-N + NUM' - END-DISPLAY - END-IF. - MOVE 11 TO CN9-A. - SUBTRACT CN9-B FROM CN9-A END-SUBTRACT. - MOVE CN9-A TO CN9-RES. - IF CN9-RES NOT = 1 - DISPLAY 'ERROR COMP-N - COMP-N' - END-DISPLAY - END-IF. - MOVE 11 TO CN9-A. - SUBTRACT 10 FROM CN9-A END-SUBTRACT. - MOVE CN9-A TO CN9-RES. - IF CN9-RES NOT = 1 - DISPLAY 'ERROR COMP-N - NUM' - END-DISPLAY - END-IF. - * - ADD CNX-B TO CNX-A END-ADD. - MOVE CNX-A TO CNX-RES. - IF CNX-RES NOT = 11 - DISPLAY 'ERROR COMP-N + COMP-N' - END-DISPLAY - END-IF. - MOVE 1 TO CNX-A. - ADD 10 TO CNX-A END-ADD. - MOVE CNX-A TO CNX-RES. - IF CNX-RES NOT = 11 - DISPLAY 'ERROR COMP-N + NUM' - END-DISPLAY - END-IF. - MOVE 11 TO CNX-A. - SUBTRACT CNX-B FROM CNX-A END-SUBTRACT. - MOVE CNX-A TO CNX-RES. - IF CNX-RES NOT = 1 - DISPLAY 'ERROR COMP-N - COMP-N' - END-DISPLAY - END-IF. - MOVE 11 TO CNX-A. - SUBTRACT 10 FROM CNX-A END-SUBTRACT. - MOVE CNX-A TO CNX-RES. - IF CNX-RES NOT = 1 - DISPLAY 'ERROR COMP-N - NUM' - END-DISPLAY - END-IF. - * - ADD CX9-B TO CX9-A END-ADD. - MOVE CX9-A TO CX9-RES. - IF CX9-RES NOT = 11 - DISPLAY 'ERROR COMP-X + COMP-X' - END-DISPLAY - END-IF. - MOVE 1 TO CX9-A. - ADD 10 TO CX9-A END-ADD. - MOVE CX9-A TO CX9-RES. - IF CX9-RES NOT = 11 - DISPLAY 'ERROR COMP-X + NUM' - END-DISPLAY - END-IF. - MOVE 11 TO CX9-A. - SUBTRACT CX9-B FROM CX9-A END-SUBTRACT. - MOVE CX9-A TO CX9-RES. - IF CX9-RES NOT = 1 - DISPLAY 'ERROR COMP-X - COMP-X' - END-DISPLAY - END-IF. - MOVE 11 TO CX9-A. - SUBTRACT 10 FROM CX9-A END-SUBTRACT. - MOVE CX9-A TO CX9-RES. - IF CX9-RES NOT = 1 - DISPLAY 'ERROR COMP-X - NUM' - END-DISPLAY - END-IF. - * - ADD CXX-B TO CXX-A END-ADD. - MOVE CXX-A TO CXX-RES. - IF CXX-RES NOT = 11 - DISPLAY 'ERROR COMP-X + COMP-X' - END-DISPLAY - END-IF. - MOVE 1 TO CXX-A. - ADD 10 TO CXX-A END-ADD. - MOVE CXX-A TO CXX-RES. - IF CXX-RES NOT = 11 - DISPLAY 'ERROR COMP-X + NUM' - END-DISPLAY - END-IF. - MOVE 11 TO CXX-A. - SUBTRACT CXX-B FROM CXX-A END-SUBTRACT. - MOVE CXX-A TO CXX-RES. - IF CXX-RES NOT = 1 - DISPLAY 'ERROR COMP-X - COMP-X' - END-DISPLAY - END-IF. - MOVE 11 TO CXX-A. - SUBTRACT 10 FROM CXX-A END-SUBTRACT. - MOVE CXX-A TO CXX-RES. - IF CXX-RES NOT = 1 - DISPLAY 'ERROR COMP-X - NUM' - END-DISPLAY - END-IF. - * - ADD D-B TO D-A END-ADD. - MOVE D-A TO D-RES. - IF D-RES NOT = 11 - DISPLAY 'ERROR DISPLAY + DISPLAY' - END-DISPLAY - END-IF. - MOVE 1 TO D-A. - ADD 10 TO D-A END-ADD. - MOVE D-A TO D-RES. - IF D-RES NOT = 11 - DISPLAY 'ERROR DISPLAY + NUM' - END-DISPLAY - END-IF. - MOVE 11 TO D-A. - SUBTRACT D-B FROM D-A END-SUBTRACT. - MOVE D-A TO D-RES. - IF D-RES NOT = 1 - DISPLAY 'ERROR DISPLAY - DISPLAY' - END-DISPLAY - END-IF. - MOVE 11 TO D-A. - SUBTRACT 10 FROM D-A END-SUBTRACT. - MOVE D-A TO D-RES. - IF D-RES NOT = 1 - DISPLAY 'ERROR DISPLAY - NUM' - END-DISPLAY - END-IF. - * - ADD FD16-B TO FD16-A END-ADD. - MOVE FD16-A TO FD16-RES. - IF FD16-RES NOT = 11 - DISPLAY 'ERROR FLOAT-DECIMAL-16 + FLOAT-DECIMAL-16' - END-DISPLAY - END-IF. - MOVE 1 TO FD16-A. - ADD 10 TO FD16-A END-ADD. - MOVE FD16-A TO FD16-RES. - IF FD16-RES NOT = 11 - DISPLAY 'ERROR FLOAT-DECIMAL-16 + NUM' - END-DISPLAY - END-IF. - MOVE 11 TO FD16-A. - SUBTRACT FD16-B FROM FD16-A END-SUBTRACT. - MOVE FD16-A TO FD16-RES. - IF FD16-RES NOT = 1 - DISPLAY 'ERROR FLOAT-DECIMAL-16 - FLOAT-DECIMAL-16' - END-DISPLAY - END-IF. - MOVE 11 TO FD16-A. - SUBTRACT 10 FROM FD16-A END-SUBTRACT. - MOVE FD16-A TO FD16-RES. - IF FD16-RES NOT = 1 - DISPLAY 'ERROR FLOAT-DECIMAL-16 - NUM' - END-DISPLAY - END-IF. - * - ADD FD34-B TO FD34-A END-ADD. - MOVE FD34-A TO FD34-RES. - IF FD34-RES NOT = 11 - DISPLAY 'ERROR FLOAT-DECIMAL-34 + FLOAT-DECIMAL-34' - END-DISPLAY - END-IF. - MOVE 1 TO FD34-A. - ADD 10 TO FD34-A END-ADD. - MOVE FD34-A TO FD34-RES. - IF FD34-RES NOT = 11 - DISPLAY 'ERROR FLOAT-DECIMAL-34 + NUM' - END-DISPLAY - END-IF. - MOVE 11 TO FD34-A. - SUBTRACT FD34-B FROM FD34-A END-SUBTRACT. - MOVE FD34-A TO FD34-RES. - IF FD34-RES NOT = 1 - DISPLAY 'ERROR FLOAT-DECIMAL-34 - FLOAT-DECIMAL-34' - END-DISPLAY - END-IF. - MOVE 11 TO FD34-A. - SUBTRACT 10 FROM FD34-A END-SUBTRACT. - MOVE FD34-A TO FD34-RES. - IF FD34-RES NOT = 1 - DISPLAY 'ERROR FLOAT-DECIMAL-34 - NUM' - END-DISPLAY - END-IF. - * - ADD FL-B TO FL-A END-ADD. - MOVE FL-A TO FL-RES. - IF FL-RES NOT = 11 - DISPLAY 'ERROR FLOAT-LONG + FLOAT-LONG' - END-DISPLAY - END-IF. - MOVE 1 TO FL-A. - ADD 10 TO FL-A END-ADD. - MOVE FL-A TO FL-RES. - IF FL-RES NOT = 11 - DISPLAY 'ERROR FLOAT-LONG + NUM' - END-DISPLAY - END-IF. - MOVE 11 TO FL-A. - SUBTRACT FL-B FROM FL-A END-SUBTRACT. - MOVE FL-A TO FL-RES. - IF FL-RES NOT = 1 - DISPLAY 'ERROR FLOAT-LONG - FLOAT-LONG' - END-DISPLAY - END-IF. - MOVE 11 TO FL-A. - SUBTRACT 10 FROM FL-A END-SUBTRACT. - MOVE FL-A TO FL-RES. - IF FL-RES NOT = 1 - DISPLAY 'ERROR FLOAT-LONG - NUM' - END-DISPLAY - END-IF. - * - ADD FS-B TO FS-A END-ADD. - MOVE FS-A TO FS-RES. - IF FS-RES NOT = 11 - DISPLAY 'ERROR FLOAT-SHORT + FLOAT-SHORT' - END-DISPLAY - END-IF. - MOVE 1 TO FS-A. - ADD 10 TO FS-A END-ADD. - MOVE FS-A TO FS-RES. - IF FS-RES NOT = 11 - DISPLAY 'ERROR FLOAT-SHORT + NUM' - END-DISPLAY - END-IF. - MOVE 11 TO FS-A. - SUBTRACT FS-B FROM FS-A END-SUBTRACT. - MOVE FS-A TO FS-RES. - IF FS-RES NOT = 1 - DISPLAY 'ERROR FLOAT-SHORT - FLOAT-SHORT' - END-DISPLAY - END-IF. - MOVE 11 TO FS-A. - SUBTRACT 10 FROM FS-A END-SUBTRACT. - MOVE FS-A TO FS-RES. - IF FS-RES NOT = 1 - DISPLAY 'ERROR FLOAT-SHORT - NUM' - END-DISPLAY - END-IF. - * - STOP RUN. -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [], []) - -AT_CHECK([$COMPILE -fnotrunc prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [], []) - -AT_CLEANUP - - -AT_SETUP([Computing of different USAGEs w/- decimal point]) -AT_KEYWORDS([runmisc -BINARY-C-LONG BINARY-CHAR BINARY-DOUBLE BINARY-LONG -COMP COMP-1 COMP-2 COMP-3 COMP-5 COMP-6 COMP-N COMP-X -FLOAT-DECIMAL-16 FLOAT-DECIMAL-34 FLOAT-LONG FLOAT-SHORT]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. 'prog'. - ENVIRONMENT DIVISION. - DATA DIVISION. - WORKING-STORAGE SECTION. - * - 77 BCL-A BINARY-C-LONG VALUE 1.0. - 77 BCL-B BINARY-C-LONG VALUE 10.0. - 77 BCL-RES BINARY-C-LONG. - * - 77 BC-A BINARY-CHAR VALUE 1.0. - 77 BC-B BINARY-CHAR VALUE 10.0. - 77 BC-RES BINARY-CHAR. - * - 77 BD-A BINARY-DOUBLE VALUE 1.0. - 77 BD-B BINARY-DOUBLE VALUE 10.0. - 77 BD-RES BINARY-DOUBLE. - * - 77 BL-A BINARY-LONG VALUE 1.0. - 77 BL-B BINARY-LONG VALUE 10.0. - 77 BL-RES BINARY-LONG. - * - 77 C-A PIC S99 COMP VALUE 1.0. - 77 C-B PIC S99 COMP VALUE 10.0. - 77 C-RES PIC S99 COMP. - * - 77 C1-A COMP-1 VALUE 1.0. - 77 C1-B COMP-1 VALUE 10.0. - 77 C1-RES COMP-1. - * - 77 C2-A COMP-2 VALUE 1.0. - 77 C2-B COMP-2 VALUE 10.0. - 77 C2-RES COMP-2. - * - 77 C3-A PIC S99 COMP-3 VALUE 1.0. - 77 C3-B PIC S99 COMP-3 VALUE 10.0. - 77 C3-RES PIC S99 COMP-3. - * - 77 C5-A PIC S99 COMP-5 VALUE 1.0. - 77 C5-B PIC S99 COMP-5 VALUE 10.0. - 77 C5-RES PIC S99 COMP-5. - * - 77 C6-A PIC 99 COMP-6 VALUE 1.0. - 77 C6-B PIC 99 COMP-6 VALUE 10.0. - 77 C6-RES PIC 99 COMP-6. - * - 77 CN9-A PIC 99 COMP-N VALUE 1. - 77 CN9-B PIC 99 COMP-N VALUE 10. - 77 CN9-RES PIC 99 COMP-N. - * - 77 CNX-A PIC X COMP-N VALUE 1. - 77 CNX-B PIC X COMP-N VALUE 10. - 77 CNX-RES PIC X COMP-N. - * - 77 CX9-A PIC 99 COMP-X VALUE 1. - 77 CX9-B PIC 99 COMP-X VALUE 10. - 77 CX9-RES PIC 99 COMP-X. - * - 77 CXX-A PIC X COMP-X VALUE 1. - 77 CXX-B PIC X COMP-X VALUE 10. - 77 CXX-RES PIC X COMP-X. - * - 77 D-A PIC S99 VALUE 1.0. - 77 D-B PIC S99 VALUE 10.0. - 77 D-RES PIC S99. - * - 77 FD16-A FLOAT-DECIMAL-16 VALUE 1.0. - 77 FD16-B FLOAT-DECIMAL-16 VALUE 10.0. - 77 FD16-RES FLOAT-DECIMAL-16. - * - 77 FD34-A FLOAT-DECIMAL-34 VALUE 1.0. - 77 FD34-B FLOAT-DECIMAL-34 VALUE 10.0. - 77 FD34-RES FLOAT-DECIMAL-34. - * - 77 FL-A FLOAT-LONG VALUE 1.0. - 77 FL-B FLOAT-LONG VALUE 10.0. - 77 FL-RES FLOAT-LONG. - * - 77 FS-A FLOAT-SHORT VALUE 1.0. - 77 FS-B FLOAT-SHORT VALUE 10.0. - 77 FS-RES FLOAT-SHORT. - * - PROCEDURE DIVISION. - * - ADD BCL-B TO BCL-A END-ADD. - MOVE BCL-A TO BCL-RES. - IF BCL-RES NOT = 11.0 - DISPLAY 'ERROR BINARY-C-LONG + BINARY-C-LONG' - END-DISPLAY - END-IF. - MOVE 1.0 TO BCL-A. - ADD 10.0 TO BCL-A END-ADD. - MOVE BCL-A TO BCL-RES. - IF BCL-RES NOT = 11.0 - DISPLAY 'ERROR BINARY-C-LONG + NUM' - END-DISPLAY - END-IF. - MOVE 11.0 TO BCL-A. - SUBTRACT BCL-B FROM BCL-A END-SUBTRACT. - MOVE BCL-A TO BCL-RES. - IF BCL-RES NOT = 1.0 - DISPLAY 'ERROR BINARY-C-LONG - BINARY-C-LONG' - END-DISPLAY - END-IF. - MOVE 11.0 TO BCL-A. - SUBTRACT 10.0 FROM BCL-A END-SUBTRACT. - MOVE BCL-A TO BCL-RES. - IF BCL-RES NOT = 1.0 - DISPLAY 'ERROR BINARY-C-LONG - NUM' - END-DISPLAY - END-IF. - * - ADD BC-B TO BC-A END-ADD. - MOVE BC-A TO BC-RES. - IF BC-RES NOT = 11.0 - DISPLAY 'ERROR BINARY-CHAR + BINARY-CHAR' - END-DISPLAY - END-IF. - MOVE 1.0 TO BC-A. - ADD 10.0 TO BC-A END-ADD. - MOVE BC-A TO BC-RES. - IF BC-RES NOT = 11.0 - DISPLAY 'ERROR BINARY-CHAR + NUM' - END-DISPLAY - END-IF. - MOVE 11.0 TO BC-A. - SUBTRACT BC-B FROM BC-A END-SUBTRACT. - MOVE BC-A TO BC-RES. - IF BC-RES NOT = 1.0 - DISPLAY 'ERROR BINARY-CHAR - BINARY-CHAR' - END-DISPLAY - END-IF. - MOVE 11.0 TO BC-A. - SUBTRACT 10.0 FROM BC-A END-SUBTRACT. - MOVE BC-A TO BC-RES. - IF BC-RES NOT = 1.0 - DISPLAY 'ERROR BINARY-CHAR - NUM' - END-DISPLAY - END-IF. - * - ADD BD-B TO BD-A END-ADD. - MOVE BD-A TO BD-RES. - IF BD-RES NOT = 11.0 - DISPLAY 'ERROR BINARY-DOUBLE + BINARY-DOUBLE' - END-DISPLAY - END-IF. - MOVE 1.0 TO BD-A. - ADD 10.0 TO BD-A END-ADD. - MOVE BD-A TO BD-RES. - IF BD-RES NOT = 11.0 - DISPLAY 'ERROR BINARY-DOUBLE + NUM' - END-DISPLAY - END-IF. - MOVE 11.0 TO BD-A. - SUBTRACT BD-B FROM BD-A END-SUBTRACT. - MOVE BD-A TO BD-RES. - IF BD-RES NOT = 1.0 - DISPLAY 'ERROR BINARY-DOUBLE - BINARY-DOUBLE' - END-DISPLAY - END-IF. - MOVE 11.0 TO BD-A. - SUBTRACT 10.0 FROM BD-A END-SUBTRACT. - MOVE BD-A TO BD-RES. - IF BD-RES NOT = 1.0 - DISPLAY 'ERROR BINARY-DOUBLE - NUM' - END-DISPLAY - END-IF. - * - ADD BL-B TO BL-A END-ADD. - MOVE BL-A TO BL-RES. - IF BL-RES NOT = 11.0 - DISPLAY 'ERROR BINARY-LONG + BINARY-LONG' - END-DISPLAY - END-IF. - MOVE 1.0 TO BL-A. - ADD 10.0 TO BL-A END-ADD. - MOVE BL-A TO BL-RES. - IF BL-RES NOT = 11.0 - DISPLAY 'ERROR BINARY-LONG + NUM' - END-DISPLAY - END-IF. - MOVE 11.0 TO BL-A. - SUBTRACT BL-B FROM BL-A END-SUBTRACT. - MOVE BL-A TO BL-RES. - IF BL-RES NOT = 1.0 - DISPLAY 'ERROR BINARY-LONG - BINARY-LONG' - END-DISPLAY - END-IF. - MOVE 11.0 TO BL-A. - SUBTRACT 10.0 FROM BL-A END-SUBTRACT. - MOVE BL-A TO BL-RES. - IF BL-RES NOT = 1.0 - DISPLAY 'ERROR BINARY-LONG - NUM' - END-DISPLAY - END-IF. - * - ADD C-B TO C-A END-ADD. - MOVE C-A TO C-RES. - IF C-RES NOT = 11.0 - DISPLAY 'ERROR COMP + COMP' - END-DISPLAY - END-IF. - MOVE 1.0 TO C-A. - ADD 10.0 TO C-A END-ADD. - MOVE C-A TO C-RES. - IF C-RES NOT = 11.0 - DISPLAY 'ERROR COMP + NUM' - END-DISPLAY - END-IF. - MOVE 11.0 TO C-A. - SUBTRACT C-B FROM C-A END-SUBTRACT. - MOVE C-A TO C-RES. - IF C-RES NOT = 1.0 - DISPLAY 'ERROR COMP - COMP' - END-DISPLAY - END-IF. - MOVE 11.0 TO C-A. - SUBTRACT 10.0 FROM C-A END-SUBTRACT. - MOVE C-A TO C-RES. - IF C-RES NOT = 1.0 - DISPLAY 'ERROR COMP - NUM' - END-DISPLAY - END-IF. - * - ADD C1-B TO C1-A END-ADD. - MOVE C1-A TO C1-RES. - IF C1-RES NOT = 11.0 - DISPLAY 'ERROR COMP-1 + COMP-1' - END-DISPLAY - END-IF. - MOVE 1.0 TO C1-A. - ADD 10.0 TO C1-A END-ADD. - MOVE C1-A TO C1-RES. - IF C1-RES NOT = 11.0 - DISPLAY 'ERROR COMP-1 + NUM' - END-DISPLAY - END-IF. - MOVE 11.0 TO C1-A. - SUBTRACT C1-B FROM C1-A END-SUBTRACT. - MOVE C1-A TO C1-RES. - IF C1-RES NOT = 1.0 - DISPLAY 'ERROR COMP-1 - COMP-1' - END-DISPLAY - END-IF. - MOVE 11.0 TO C1-A. - SUBTRACT 10.0 FROM C1-A END-SUBTRACT. - MOVE C1-A TO C1-RES. - IF C1-RES NOT = 1.0 - DISPLAY 'ERROR COMP-1 - NUM' - END-DISPLAY - END-IF. - * - ADD C2-B TO C2-A END-ADD. - MOVE C2-A TO C2-RES. - IF C2-RES NOT = 11.0 - DISPLAY 'ERROR COMP-2 + COMP-2' - END-DISPLAY - END-IF. - MOVE 1.0 TO C2-A. - ADD 10.0 TO C2-A END-ADD. - MOVE C2-A TO C2-RES. - IF C2-RES NOT = 11.0 - DISPLAY 'ERROR COMP-2 + NUM' - END-DISPLAY - END-IF. - MOVE 11.0 TO C2-A. - SUBTRACT C2-B FROM C2-A END-SUBTRACT. - MOVE C2-A TO C2-RES. - IF C2-RES NOT = 1.0 - DISPLAY 'ERROR COMP-2 - COMP-2' - END-DISPLAY - END-IF. - MOVE 11.0 TO C2-A. - SUBTRACT 10.0 FROM C2-A END-SUBTRACT. - MOVE C2-A TO C2-RES. - IF C2-RES NOT = 1.0 - DISPLAY 'ERROR COMP-2 - NUM' - END-DISPLAY - END-IF. - * - ADD C3-B TO C3-A END-ADD. - MOVE C3-A TO C3-RES. - IF C3-RES NOT = 11.0 - DISPLAY 'ERROR COMP-3 + COMP-3' - END-DISPLAY - END-IF. - MOVE 1.0 TO C3-A. - ADD 10.0 TO C3-A END-ADD. - MOVE C3-A TO C3-RES. - IF C3-RES NOT = 11.0 - DISPLAY 'ERROR COMP-3 + NUM' - END-DISPLAY - END-IF. - MOVE 11.0 TO C3-A. - SUBTRACT C3-B FROM C3-A END-SUBTRACT. - MOVE C3-A TO C3-RES. - IF C3-RES NOT = 1.0 - DISPLAY 'ERROR COMP-3 - COMP-3' - END-DISPLAY - END-IF. - MOVE 11.0 TO C3-A. - SUBTRACT 10.0 FROM C3-A END-SUBTRACT. - MOVE C3-A TO C3-RES. - IF C3-RES NOT = 1.0 - DISPLAY 'ERROR COMP-3 - NUM' - END-DISPLAY - END-IF. - * - ADD C5-B TO C5-A END-ADD. - MOVE C5-A TO C5-RES. - IF C5-RES NOT = 11.0 - DISPLAY 'ERROR COMP-5 + COMP-5' - END-DISPLAY - END-IF. - MOVE 1.0 TO C5-A. - ADD 10.0 TO C5-A END-ADD. - MOVE C5-A TO C5-RES. - IF C5-RES NOT = 11.0 - DISPLAY 'ERROR COMP-5 + NUM' - END-DISPLAY - END-IF. - MOVE 11.0 TO C5-A. - SUBTRACT C5-B FROM C5-A END-SUBTRACT. - MOVE C5-A TO C5-RES. - IF C5-RES NOT = 1.0 - DISPLAY 'ERROR COMP-5 - COMP-5' - END-DISPLAY - END-IF. - MOVE 11.0 TO C5-A. - SUBTRACT 10.0 FROM C5-A END-SUBTRACT. - MOVE C5-A TO C5-RES. - IF C5-RES NOT = 1.0 - DISPLAY 'ERROR COMP-5 - NUM' - END-DISPLAY - END-IF. - * - ADD C6-B TO C6-A END-ADD. - MOVE C6-A TO C6-RES. - IF C6-RES NOT = 11.0 - DISPLAY 'ERROR COMP-6 + COMP-6' - END-DISPLAY - END-IF. - MOVE 1.0 TO C6-A. - ADD 10.0 TO C6-A END-ADD. - MOVE C6-A TO C6-RES. - IF C6-RES NOT = 11.0 - DISPLAY 'ERROR COMP-6 + NUM' - END-DISPLAY - END-IF. - MOVE 11.0 TO C6-A. - SUBTRACT C6-B FROM C6-A END-SUBTRACT. - MOVE C6-A TO C6-RES. - IF C6-RES NOT = 1.0 - DISPLAY 'ERROR COMP-6 - COMP-6' - END-DISPLAY - END-IF. - MOVE 11.0 TO C6-A. - SUBTRACT 10.0 FROM C6-A END-SUBTRACT. - MOVE C6-A TO C6-RES. - IF C6-RES NOT = 1.0 - DISPLAY 'ERROR COMP-6 - NUM' - END-DISPLAY - END-IF. - * - ADD CN9-B TO CN9-A END-ADD. - MOVE CN9-A TO CN9-RES. - IF CN9-RES NOT = 11.0 - DISPLAY 'ERROR COMP-N + COMP-N' - END-DISPLAY - END-IF. - MOVE 1.0 TO CN9-A. - ADD 10.0 TO CN9-A END-ADD. - MOVE CN9-A TO CN9-RES. - IF CN9-RES NOT = 11.0 - DISPLAY 'ERROR COMP-N + NUM' - END-DISPLAY - END-IF. - MOVE 11.0 TO CN9-A. - SUBTRACT CN9-B FROM CN9-A END-SUBTRACT. - MOVE CN9-A TO CN9-RES. - IF CN9-RES NOT = 1.0 - DISPLAY 'ERROR COMP-N - COMP-N' - END-DISPLAY - END-IF. - MOVE 11.0 TO CN9-A. - SUBTRACT 10.0 FROM CN9-A END-SUBTRACT. - MOVE CN9-A TO CN9-RES. - IF CN9-RES NOT = 1.0 - DISPLAY 'ERROR COMP-N - NUM' - END-DISPLAY - END-IF. - * - ADD CNX-B TO CNX-A END-ADD. - MOVE CNX-A TO CNX-RES. - IF CNX-RES NOT = 11.0 - DISPLAY 'ERROR COMP-N + COMP-N' - END-DISPLAY - END-IF. - MOVE 1.0 TO CNX-A. - ADD 10.0 TO CNX-A END-ADD. - MOVE CNX-A TO CNX-RES. - IF CNX-RES NOT = 11.0 - DISPLAY 'ERROR COMP-N + NUM' - END-DISPLAY - END-IF. - MOVE 11.0 TO CNX-A. - SUBTRACT CNX-B FROM CNX-A END-SUBTRACT. - MOVE CNX-A TO CNX-RES. - IF CNX-RES NOT = 1.0 - DISPLAY 'ERROR COMP-N - COMP-N' - END-DISPLAY - END-IF. - MOVE 11.0 TO CNX-A. - SUBTRACT 10.0 FROM CNX-A END-SUBTRACT. - MOVE CNX-A TO CNX-RES. - IF CNX-RES NOT = 1.0 - DISPLAY 'ERROR COMP-N - NUM' - END-DISPLAY - END-IF. - * - ADD CX9-B TO CX9-A END-ADD. - MOVE CX9-A TO CX9-RES. - IF CX9-RES NOT = 11.0 - DISPLAY 'ERROR COMP-X + COMP-X' - END-DISPLAY - END-IF. - MOVE 1.0 TO CX9-A. - ADD 10.0 TO CX9-A END-ADD. - MOVE CX9-A TO CX9-RES. - IF CX9-RES NOT = 11.0 - DISPLAY 'ERROR COMP-X + NUM' - END-DISPLAY - END-IF. - MOVE 11.0 TO CX9-A. - SUBTRACT CX9-B FROM CX9-A END-SUBTRACT. - MOVE CX9-A TO CX9-RES. - IF CX9-RES NOT = 1.0 - DISPLAY 'ERROR COMP-X - COMP-X' - END-DISPLAY - END-IF. - MOVE 11.0 TO CX9-A. - SUBTRACT 10.0 FROM CX9-A END-SUBTRACT. - MOVE CX9-A TO CX9-RES. - IF CX9-RES NOT = 1.0 - DISPLAY 'ERROR COMP-X - NUM' - END-DISPLAY - END-IF. - * - ADD CXX-B TO CXX-A END-ADD. - MOVE CXX-A TO CXX-RES. - IF CXX-RES NOT = 11.0 - DISPLAY 'ERROR COMP-X + COMP-X' - END-DISPLAY - END-IF. - MOVE 1.0 TO CXX-A. - ADD 10.0 TO CXX-A END-ADD. - MOVE CXX-A TO CXX-RES. - IF CXX-RES NOT = 11.0 - DISPLAY 'ERROR COMP-X + NUM' - END-DISPLAY - END-IF. - MOVE 11.0 TO CXX-A. - SUBTRACT CXX-B FROM CXX-A END-SUBTRACT. - MOVE CXX-A TO CXX-RES. - IF CXX-RES NOT = 1.0 - DISPLAY 'ERROR COMP-X - COMP-X' - END-DISPLAY - END-IF. - MOVE 11.0 TO CXX-A. - SUBTRACT 10.0 FROM CXX-A END-SUBTRACT. - MOVE CXX-A TO CXX-RES. - IF CXX-RES NOT = 1.0 - DISPLAY 'ERROR COMP-X - NUM' - END-DISPLAY - END-IF. - * - ADD D-B TO D-A END-ADD. - MOVE D-A TO D-RES. - IF D-RES NOT = 11.0 - DISPLAY 'ERROR DISPLAY + DISPLAY' - END-DISPLAY - END-IF. - MOVE 1.0 TO D-A. - ADD 10.0 TO D-A END-ADD. - MOVE D-A TO D-RES. - IF D-RES NOT = 11.0 - DISPLAY 'ERROR DISPLAY + NUM' - END-DISPLAY - END-IF. - MOVE 11.0 TO D-A. - SUBTRACT D-B FROM D-A END-SUBTRACT. - MOVE D-A TO D-RES. - IF D-RES NOT = 1.0 - DISPLAY 'ERROR DISPLAY - DISPLAY' - END-DISPLAY - END-IF. - MOVE 11.0 TO D-A. - SUBTRACT 10.0 FROM D-A END-SUBTRACT. - MOVE D-A TO D-RES. - IF D-RES NOT = 1.0 - DISPLAY 'ERROR DISPLAY - NUM' - END-DISPLAY - END-IF. - * - ADD FD16-B TO FD16-A END-ADD. - MOVE FD16-A TO FD16-RES. - IF FD16-RES NOT = 11.0 - DISPLAY 'ERROR FLOAT-DECIMAL-16 + FLOAT-DECIMAL-16' - END-DISPLAY - END-IF. - MOVE 1.0 TO FD16-A. - ADD 10.0 TO FD16-A END-ADD. - MOVE FD16-A TO FD16-RES. - IF FD16-RES NOT = 11.0 - DISPLAY 'ERROR FLOAT-DECIMAL-16 + NUM' - END-DISPLAY - END-IF. - MOVE 11.0 TO FD16-A. - SUBTRACT FD16-B FROM FD16-A END-SUBTRACT. - MOVE FD16-A TO FD16-RES. - IF FD16-RES NOT = 1.0 - DISPLAY 'ERROR FLOAT-DECIMAL-16 - FLOAT-DECIMAL-16' - END-DISPLAY - END-IF. - MOVE 11.0 TO FD16-A. - SUBTRACT 10.0 FROM FD16-A END-SUBTRACT. - MOVE FD16-A TO FD16-RES. - IF FD16-RES NOT = 1.0 - DISPLAY 'ERROR FLOAT-DECIMAL-16 - NUM' - END-DISPLAY - END-IF. - * - ADD FD34-B TO FD34-A END-ADD. - MOVE FD34-A TO FD34-RES. - IF FD34-RES NOT = 11.0 - DISPLAY 'ERROR FLOAT-DECIMAL-34 + FLOAT-DECIMAL-34' - END-DISPLAY - END-IF. - MOVE 1.0 TO FD34-A. - ADD 10.0 TO FD34-A END-ADD. - MOVE FD34-A TO FD34-RES. - IF FD34-RES NOT = 11.0 - DISPLAY 'ERROR FLOAT-DECIMAL-34 + NUM' - END-DISPLAY - END-IF. - MOVE 11.0 TO FD34-A. - SUBTRACT FD34-B FROM FD34-A END-SUBTRACT. - MOVE FD34-A TO FD34-RES. - IF FD34-RES NOT = 1.0 - DISPLAY 'ERROR FLOAT-DECIMAL-34 - FLOAT-DECIMAL-34' - END-DISPLAY - END-IF. - MOVE 11.0 TO FD34-A. - SUBTRACT 10.0 FROM FD34-A END-SUBTRACT. - MOVE FD34-A TO FD34-RES. - IF FD34-RES NOT = 1.0 - DISPLAY 'ERROR FLOAT-DECIMAL-34 - NUM' - END-DISPLAY - END-IF. - * - ADD FL-B TO FL-A END-ADD. - MOVE FL-A TO FL-RES. - IF FL-RES NOT = 11.0 - DISPLAY 'ERROR FLOAT-LONG + FLOAT-LONG' - END-DISPLAY - END-IF. - MOVE 1.0 TO FL-A. - ADD 10.0 TO FL-A END-ADD. - MOVE FL-A TO FL-RES. - IF FL-RES NOT = 11.0 - DISPLAY 'ERROR FLOAT-LONG + NUM' - END-DISPLAY - END-IF. - MOVE 11.0 TO FL-A. - SUBTRACT FL-B FROM FL-A END-SUBTRACT. - MOVE FL-A TO FL-RES. - IF FL-RES NOT = 1.0 - DISPLAY 'ERROR FLOAT-LONG - FLOAT-LONG' - END-DISPLAY - END-IF. - MOVE 11.0 TO FL-A. - SUBTRACT 10.0 FROM FL-A END-SUBTRACT. - MOVE FL-A TO FL-RES. - IF FL-RES NOT = 1.0 - DISPLAY 'ERROR FLOAT-LONG - NUM' - END-DISPLAY - END-IF. - * - ADD FS-B TO FS-A END-ADD. - MOVE FS-A TO FS-RES. - IF FS-RES NOT = 11.0 - DISPLAY 'ERROR FLOAT-SHORT + FLOAT-SHORT' - END-DISPLAY - END-IF. - MOVE 1.0 TO FS-A. - ADD 10.0 TO FS-A END-ADD. - MOVE FS-A TO FS-RES. - IF FS-RES NOT = 11.0 - DISPLAY 'ERROR FLOAT-SHORT + NUM' - END-DISPLAY - END-IF. - MOVE 11.0 TO FS-A. - SUBTRACT FS-B FROM FS-A END-SUBTRACT. - MOVE FS-A TO FS-RES. - IF FS-RES NOT = 1.0 - DISPLAY 'ERROR FLOAT-SHORT - FLOAT-SHORT' - END-DISPLAY - END-IF. - MOVE 11.0 TO FS-A. - SUBTRACT 10.0 FROM FS-A END-SUBTRACT. - MOVE FS-A TO FS-RES. - IF FS-RES NOT = 1.0 - DISPLAY 'ERROR FLOAT-SHORT - NUM' - END-DISPLAY - END-IF. - * - STOP RUN. -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [], []) - -AT_CHECK([$COMPILE -fnotrunc prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [], []) - -AT_CLEANUP - - -AT_SETUP([C/C++ reserved words/predefined identifiers]) -AT_KEYWORDS([runmisc]) - -AT_DATA([caller.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. caller. - DATA DIVISION. - WORKING-STORAGE SECTION. - * - * Reserved Words in C (that aren't reserved in COBOL) - * var names MUST BE IN LOWER CASE (!) - * - 77 const PIC X VALUE "A". - 77 double PIC X VALUE "B". - 77 float PIC X VALUE "C". - 77 int PIC X VALUE "D". - 77 short PIC X VALUE "E". - 77 struct PIC X VALUE "F". - 77 break PIC X VALUE "G". - 77 long PIC X VALUE "H". - 77 switch PIC X VALUE "I". - 77 void PIC X VALUE "J". - 77 case PIC X VALUE "K". - 77 enum PIC X VALUE "L". - 77 goto PIC X VALUE "M". - 77 register PIC X VALUE "N". - 77 sizeof PIC X VALUE "O". - 77 volatile PIC X VALUE "P". - 77 char PIC X VALUE "Q". - 77 do PIC X VALUE "R". - 77 extern PIC X VALUE "S". - 77 static PIC X VALUE "T". - 77 union PIC X VALUE "U". - 77 while PIC X VALUE "V". - * - * More Reserved Words in C++ - * var names MUST BE IN LOWER CASE (!) - * - 77 asm PIC X VALUE "W". - 77 dynamic_cast PIC X VALUE "X". - 77 namespace PIC X VALUE "Y". - 77 reinterpret_cast PIC X VALUE "Z". - 77 try PIC X VALUE "a". - 77 bool PIC X VALUE "b". - 77 explicit PIC X VALUE "c". - *77 new PIC X VALUE "d". - 77 static_cast PIC X VALUE "e". - 77 typeid PIC X VALUE "f". - 77 catch PIC X VALUE "g". - 77 operator PIC X VALUE "h". - 77 template PIC X VALUE "i". - 77 typename PIC X VALUE "j". - 77 friend PIC X VALUE "k". - 77 private PIC X VALUE "l". - 77 this PIC X VALUE "m". - 77 const_cast PIC X VALUE "n". - 77 inline PIC X VALUE "o". - 77 public PIC X VALUE "p". - 77 throw PIC X VALUE "q". - 77 virtual PIC X VALUE "r". - 77 mutable PIC X VALUE "s". - 77 protected PIC X VALUE "t". - 77 wchar_t PIC X VALUE "u". - * - * More Reserved Words in C++ (not essential) - * var names MUST BE IN LOWER CASE (!) - * - 77 bitand PIC X VALUE "v". - 77 compl PIC X VALUE "w". - 77 not_eq PIC X VALUE "x". - 77 or_eq PIC X VALUE "y". - 77 xor_eq PIC X VALUE "z". - 77 and_eq PIC X VALUE "0". - 77 bitor PIC X VALUE "1". - 77 xor PIC X VALUE "2". - * - PROCEDURE DIVISION. - CALL "callee" USING const - double - float - int - short - struct - break - long - switch - void - case - enum - goto - register - sizeof - volatile - char - do - *>extern - *>static - union - while - END-CALL. - CALL "callee2" USING asm - dynamic_cast - namespace - reinterpret_cast - try - bool - explicit - * new - static_cast - typeid - catch - operator - template - typename - friend - private - this - const_cast - inline - public - throw - virtual - mutable - protected - wchar_t - bitand - compl - not_eq - or_eq - xor_eq - and_eq - bitor - xor - END-CALL. - MOVE x'00' TO const - double - float - int - short - struct - break - long - switch - void - case - enum - goto - register - sizeof - volatile - char - do - extern - static - union - while - asm - dynamic_cast - namespace - reinterpret_cast - try - bool - explicit - * new - static_cast - typeid - catch - operator - template - typename - friend - private - this - const_cast - inline - public - throw - virtual - mutable - protected - wchar_t - bitand - compl - not_eq - or_eq - xor_eq - and_eq - bitor - xor - . - STOP RUN. -]) - -AT_DATA([callee.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. callee. - DATA DIVISION. - LINKAGE SECTION. - * - * Reserved Words in C (that aren't reserved in COBOL) - * var names MUST BE IN LOWER CASE (!) - * - 77 const PIC X. - 77 double PIC X. - 77 float PIC X. - 77 int PIC X. - 77 short PIC X. - 77 struct PIC X. - 77 break PIC X. - 77 long PIC X. - 77 switch PIC X. - 77 void PIC X. - 77 case PIC X. - 77 enum PIC X. - 77 goto PIC X. - 77 register PIC X. - 77 sizeof PIC X. - 77 volatile PIC X. - 77 char PIC X. - 77 do PIC X. - *77 extern PIC X. - *77 static PIC X. - 77 union PIC X. - 77 while PIC X. - PROCEDURE DIVISION USING - const - double - float - int - short - struct - break - long - switch - void - case - enum - goto - register - sizeof - volatile - char - do - *>extern - *>static - union - while - . - IF (const NOT = "A") OR - (double NOT = "B") OR - (float NOT = "C") OR - (int NOT = "D") OR - (short NOT = "E") OR - (struct NOT = "F") OR - (break NOT = "G") OR - (long NOT = "H") OR - (switch NOT = "I") OR - (void NOT = "J") OR - (case NOT = "K") OR - (enum NOT = "L") OR - (goto NOT = "M") OR - (register NOT = "N") OR - (sizeof NOT = "O") OR - (volatile NOT = "P") OR - (char NOT = "Q") OR - (do NOT = "R") OR - *>(extern NOT = "S") OR - *>(static NOT = "T") OR - (union NOT = "U") OR - (while NOT = "V") - DISPLAY "At least one var has wrong content!" - END-DISPLAY - END-IF. - MOVE x'FF' TO const - double - float - int - short - struct - break - long - switch - void - case - enum - goto - register - sizeof - volatile - char - do - *>extern - *>static - union - while - . - EXIT PROGRAM. -]) - -AT_DATA([callee2.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. callee2. - DATA DIVISION. - LINKAGE SECTION. - * - * More Reserved Words in C++ - * var names MUST BE IN LOWER CASE (!) - * - 77 asm PIC X. - 77 dynamic_cast PIC X. - 77 namespace PIC X. - 77 reinterpret_cast PIC X. - 77 try PIC X. - 77 bool PIC X. - 77 explicit PIC X. - *77 new PIC X. - 77 static_cast PIC X. - 77 typeid PIC X. - 77 catch PIC X. - 77 operator PIC X. - 77 template PIC X. - 77 typename PIC X. - 77 friend PIC X. - 77 private PIC X. - 77 this PIC X. - 77 const_cast PIC X. - 77 inline PIC X. - 77 public PIC X. - 77 throw PIC X. - 77 virtual PIC X. - 77 mutable PIC X. - 77 protected PIC X. - 77 wchar_t PIC X. - * - * More Reserved Words in C++ (not essential) - * - 77 bitand PIC X. - 77 compl PIC X. - 77 not_eq PIC X. - 77 or_eq PIC X. - 77 xor_eq PIC X. - 77 and_eq PIC X. - 77 bitor PIC X. - 77 xor PIC X. - PROCEDURE DIVISION USING - asm - dynamic_cast - namespace - reinterpret_cast - try - bool - explicit - * new - static_cast - typeid - catch - operator - template - typename - friend - private - this - const_cast - inline - public - throw - virtual - mutable - protected - wchar_t - bitand - compl - not_eq - or_eq - xor_eq - and_eq - bitor - xor - . - IF (asm NOT = "W") OR - (dynamic_cast NOT = "X") OR - (namespace NOT = "Y") OR - (reinterpret_cast NOT = "Z") OR - (try NOT = "a") OR - (bool NOT = "b") OR - (explicit NOT = "c") OR - * (new NOT = "d") OR - (static_cast NOT = "e") OR - (typeid NOT = "f") OR - (catch NOT = "g") OR - (operator NOT = "h") OR - (template NOT = "i") OR - (typename NOT = "j") OR - (friend NOT = "k") OR - (private NOT = "l") OR - (this NOT = "m") OR - (const_cast NOT = "n") OR - (inline NOT = "o") OR - (public NOT = "p") OR - (throw NOT = "q") OR - (virtual NOT = "r") OR - (mutable NOT = "s") OR - (protected NOT = "t") OR - (wchar_t NOT = "u") OR - (bitand NOT = "v") OR - (compl NOT = "w") OR - (not_eq NOT = "x") OR - (or_eq NOT = "y") OR - (xor_eq NOT = "z") OR - (and_eq NOT = "0") OR - (bitor NOT = "1") OR - (xor NOT = "2") - DISPLAY "At least one var has wrong content!" - END-DISPLAY - END-IF. - MOVE x'FF' TO asm - dynamic_cast - namespace - reinterpret_cast - try - bool - explicit - * new - static_cast - typeid - catch - operator - template - typename - friend - private - this - const_cast - inline - public - throw - virtual - mutable - protected - wchar_t - bitand - compl - not_eq - or_eq - xor_eq - and_eq - bitor - xor - . - EXIT PROGRAM. -]) - -AT_CHECK([$COMPILE_MODULE -fnot-reserved=double,float,new,volatile callee.cob], [0], [], []) -AT_CHECK([$COMPILE_MODULE -fnot-reserved=double,float,new,volatile callee2.cob], [0], [], []) -AT_CHECK([$COMPILE -fnot-reserved=double,float,new,volatile -o prog caller.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [], []) - -AT_CLEANUP - - -AT_SETUP([ON EXCEPTION clause of DISPLAY]) -AT_KEYWORDS([runmisc exceptions screen]) - -AT_CHECK([test "$COB_HAS_CURSES" = "yes" || exit 77]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - - PROCEDURE DIVISION. - DISPLAY "hello" AT COLUMN 500 - ON EXCEPTION - GOBACK RETURNING 0 - NOT ON EXCEPTION - GOBACK RETURNING 1 - END-DISPLAY - . -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([COB_EXIT_WAIT=0 ./prog], [0], ignore, []) - -AT_CLEANUP - - -AT_SETUP([EC-SCREEN-LINE-NUMBER and -STARTING-COLUMN]) -AT_KEYWORDS([runmisc exceptions screen]) - -AT_CHECK([test "$COB_HAS_CURSES" = "yes" || exit 77]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - - DATA DIVISION. - SCREEN SECTION. - 01 invalid-line. - 03 a VALUE "a" LINE 99999999. - 01 invalid-col. - 03 c VALUE "c" COLUMN 99999999. - - PROCEDURE DIVISION. - DISPLAY invalid-line END-DISPLAY - IF FUNCTION EXCEPTION-STATUS = "EC-SCREEN-LINE-NUMBER" - CONTINUE - ELSE - GOBACK RETURNING 1 - END-IF - - DISPLAY invalid-col END-DISPLAY - IF FUNCTION EXCEPTION-STATUS = "EC-SCREEN-STARTING-COLUMN" - CONTINUE - ELSE - GOBACK RETURNING 2 - END-IF - - GOBACK RETURNING 0 - . -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([COB_EXIT_WAIT=0 ./prog], [0], ignore, []) - -AT_CLEANUP - - -AT_SETUP([LINE/COLUMN 0 exceptions]) -AT_KEYWORDS([LINE COLUMN runmisc exceptions extensions screen]) - -AT_CHECK([test "$COB_HAS_CURSES" = "yes" || exit 77]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 zero-var PIC 9 VALUE 0. - - SCREEN SECTION. - 01 scr. - 03 VALUE "a". - - PROCEDURE DIVISION. - DISPLAY scr AT LINE zero-var - IF FUNCTION EXCEPTION-STATUS <> "EC-SCREEN-LINE-NUMBER" - GOBACK RETURNING 1 - END-IF - - DISPLAY scr AT COLUMN zero-var - IF FUNCTION EXCEPTION-STATUS <> "EC-SCREEN-STARTING-COLUMN" - GOBACK RETURNING 2 - END-IF - - GOBACK RETURNING 0 - . -]) - -AT_CHECK([$COMPILE -faccept-display-extensions=error prog.cob], [0], [], []) -AT_CHECK([COB_EXIT_WAIT=0 ./prog], [0], ignore, []) - -AT_CLEANUP - - -AT_SETUP([SET LAST EXCEPTION TO OFF]) -AT_KEYWORDS([runmisc exceptions EXCEPTION-STATUS EXCEPTION-LOCATION]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 x PIC 9. - - PROCEDURE DIVISION. - COMPUTE x = 10 - DISPLAY FUNCTION TRIM(FUNCTION EXCEPTION-STATUS) - DISPLAY FUNCTION TRIM(FUNCTION EXCEPTION-LOCATION) - DISPLAY FUNCTION TRIM(FUNCTION EXCEPTION-STATUS) - DISPLAY FUNCTION TRIM(FUNCTION EXCEPTION-LOCATION) - SET LAST EXCEPTION TO OFF - DISPLAY FUNCTION TRIM(FUNCTION EXCEPTION-STATUS) - DISPLAY FUNCTION TRIM(FUNCTION EXCEPTION-LOCATION) - . -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], -[EC-SIZE-OVERFLOW -prog; ; 10 -EC-SIZE-OVERFLOW -prog; ; 10 - - -]) -AT_CLEANUP - - -# PROCEDURE DIVISION RETURNING OMITTED -AT_SETUP([void PROCEDURE]) -AT_KEYWORDS([runmisc]) - -AT_DATA([callee.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. callee. - DATA DIVISION. - PROCEDURE DIVISION RETURNING OMITTED. - MOVE 42 TO RETURN-CODE - EXIT PROGRAM. -]) - -AT_DATA([caller.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. caller. - PROCEDURE DIVISION. - CALL "callee" RETURNING OMITTED - END-CALL. - DISPLAY RETURN-CODE WITH NO ADVANCING - STOP RUN. -]) - -AT_CHECK([$COMPILE_MODULE callee.cob], [0], [], []) -AT_CHECK([$COMPILE caller.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./caller], [0], [+000000000], []) - -AT_CLEANUP - - -AT_SETUP([Figurative constants to numeric field]) -AT_KEYWORDS([Numeric]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 NUM9 PIC 9(6). - PROCEDURE DIVISION. - MOVE SPACES TO NUM9 - DISPLAY "NUM9 value SPACES is " NUM9 "." UPON SYSOUT - MOVE LOW-VALUES TO NUM9 - IF NUM9 = LOW-VALUES - DISPLAY "9(6) tests OK for LOW-VALUES" UPON SYSOUT - ELSE - DISPLAY "9(6) Does NOT test OK for LOW-VALUES" - UPON SYSOUT - IF NUM9 = ZERO - DISPLAY "9(6) tests as ZERO instead of LOW-VALUES" - UPON SYSOUT - END-IF - END-IF. - MOVE HIGH-VALUES TO NUM9 - IF NUM9 = HIGH-VALUES - DISPLAY "9(6) tests OK for HIGH-VALUES" UPON SYSOUT - ELSE - DISPLAY "9(6) Does NOT test OK for HIGH-VALUES" - UPON SYSOUT - IF NUM9 = ZERO - DISPLAY "9(6) tests as ZERO instead of HIGH-VALUES" - UPON SYSOUT - END-IF - END-IF. - STOP RUN. -]) - -AT_CHECK([$COMPILE -std=mf prog.cob], [0], [], -[prog.cob:8: warning: source is non-numeric - substituting zero -prog.cob:10: warning: source is non-numeric - substituting zero -prog.cob:21: warning: source is non-numeric - substituting zero -]) - -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], -[NUM9 value SPACES is 000000. -9(6) Does NOT test OK for LOW-VALUES -9(6) tests as ZERO instead of LOW-VALUES -9(6) Does NOT test OK for HIGH-VALUES -9(6) tests as ZERO instead of HIGH-VALUES -], []) - -AT_CHECK([$COMPILE -std=acu prog.cob -o aprog], [0], [], []) - -AT_CHECK([$COBCRUN_DIRECT ./aprog], [0], -[NUM9 value SPACES is . -9(6) tests OK for LOW-VALUES -9(6) tests OK for HIGH-VALUES -], []) - -AT_CLEANUP - - -AT_SETUP([MF FIGURATIVE to NUMERIC]) -AT_KEYWORDS([MOVE]) - -# FIXME: This test will NOT work on EBCDIC machines, -# either add it explicit here and split into two or add -# a pre-test and check the expected "native" result - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 MYFLD PIC 9(4) VALUE 96. - 01 BIGFLT COMP-1 VALUE 543.12345E10. - PROCEDURE DIVISION. - MAIN-1. - DISPLAY "Initial value" - PERFORM SHOW-IT. - DISPLAY "MOVE BIGFLT" - MOVE BIGFLT TO MYFLD. - PERFORM SHOW-IT. - DISPLAY "MOVE SPACES" - MOVE SPACES TO MYFLD. - PERFORM SHOW-IT. - DISPLAY "MOVE LOW-VALUES" - MOVE LOW-VALUES TO MYFLD. - PERFORM SHOW-IT. - DISPLAY "MOVE HIGH-VALUES" - MOVE HIGH-VALUES TO MYFLD. - PERFORM SHOW-IT. - DISPLAY "MOVE QUOTE" - MOVE QUOTE TO MYFLD. - PERFORM SHOW-IT. - DISPLAY "MOVE ALL *" - MOVE ALL '*' TO MYFLD. - PERFORM SHOW-IT. - DISPLAY "MOVE ALL 0" - MOVE ALL '0' TO MYFLD. - PERFORM SHOW-IT. - DISPLAY "MOVE ALL 'A1'" - MOVE ALL 'A1' TO MYFLD. - PERFORM SHOW-IT. - DISPLAY "MOVE ALL '21'" - MOVE ALL '21' TO MYFLD. - PERFORM SHOW-IT. - DISPLAY "MOVE HIGH-VALUES TO (1:)" - MOVE HIGH-VALUES TO MYFLD (1:). - PERFORM SHOW-IT. - - DISPLAY "MOVE HIGH-VALUES TO BIGFLT" - MOVE HIGH-VALUES TO BIGFLT. - PERFORM SHOW-BIG. - CALL "dump" USING BIGFLT. - DISPLAY "MOVE QUOTE TO BIGFLT" - MOVE QUOTE TO BIGFLT. - PERFORM SHOW-BIG. - CALL "dump" USING BIGFLT. - DISPLAY "MOVE ALL * TO BIGFLT" - MOVE ALL '*' TO BIGFLT. - PERFORM SHOW-BIG. - *> Note: the next results are dependant on endianess - *> therefore no dump here - DISPLAY "MOVE ALL '21' TO BIGFLT" - MOVE ALL '21' TO BIGFLT. - PERFORM SHOW-BIG. - STOP RUN. - SHOW-IT. - CALL "dump" USING MYFLD. - SHOW-BIG. - DISPLAY "BIGFLT is " BIGFLT. -]) - -AT_DATA([cmod.c], [[ -#include -#include - -COB_EXT_EXPORT int -dump (unsigned char *data) -{ - int i; - for (i = 0; i < 4; i++) - printf ("%02X", data[i]); - puts (" ."); - return 0; -} -]]) - -AT_CHECK([$COMPILE -std=mf -fno-move-non-numeric-lit-to-numeric-is-zero prog.cob cmod.c], [0], [], -[prog.cob: in paragraph 'MAIN-1': -prog.cob:28: warning: numeric value is expected -prog.cob:6: warning: 'MYFLD' defined here as PIC 9(4) -prog.cob:34: warning: numeric value is expected -prog.cob:6: warning: 'MYFLD' defined here as PIC 9(4) -prog.cob:52: warning: numeric value is expected -prog.cob:7: warning: 'BIGFLT' defined here as USAGE FLOAT -]) - -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], -[Initial value -30303936 . -MOVE BIGFLT -38333034 . -MOVE SPACES -20202020 . -MOVE LOW-VALUES -00000000 . -MOVE HIGH-VALUES -FFFFFFFF . -MOVE QUOTE -22222222 . -MOVE ALL * -2A2A2A2A . -MOVE ALL 0 -30303030 . -MOVE ALL 'A1' -41314131 . -MOVE ALL '21' -32313231 . -MOVE HIGH-VALUES TO (1:) -FFFFFFFF . -MOVE HIGH-VALUES TO BIGFLT -BIGFLT is NaN -FFFFFFFF . -MOVE QUOTE TO BIGFLT -BIGFLT is 2.1973164E-18 -22222222 . -MOVE ALL * TO BIGFLT -BIGFLT is 5.4312347E+12 -MOVE ALL '21' TO BIGFLT -BIGFLT is 2.1212121E+37 -], []) - -AT_CLEANUP - - -# PROCEDURE DIVISION RETURNING OMITTED, CALL RETURNING NOTHING -AT_SETUP([void PROCEDURE, NOTHING return]) -AT_KEYWORDS([runmisc]) - -AT_DATA([callee.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. callee. - DATA DIVISION. - PROCEDURE DIVISION RETURNING OMITTED. - MOVE 42 TO RETURN-CODE - EXIT PROGRAM. -]) - -AT_DATA([caller.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. caller. - PROCEDURE DIVISION. - MOVE 42 TO RETURN-CODE - CALL "callee" RETURNING NOTHING - END-CALL. - DISPLAY RETURN-CODE WITH NO ADVANCING - STOP RUN. -]) - -AT_CHECK([$COMPILE_MODULE callee.cob], [0], [], []) -AT_CHECK([$COMPILE caller.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./caller], [42], [+000000042], []) - -AT_CLEANUP - - -AT_SETUP([C API Test]) -AT_KEYWORDS([CALL]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 BIN5FLD PIC 9(5) COMP-5 VALUE 5555. - 01 BINFLD5S PIC S9(5) BINARY VALUE 4444. - 01 BINFLD9 PIC 9(9) BINARY VALUE 6666. - 01 COMP3 PIC 9(8) COMP-3 VALUE 3333. - 01 COMP3V99 PIC S9(7)V99 COMP-3 VALUE 12.50. - 01 PIC9 PIC S9(8) DISPLAY VALUE 8888. - 01 NE PIC Z(4)9.99-. - 01 CHRX PIC X(9) VALUE 'Hello'. - 01 GRPX. - 05 FILLER PIC X(9) VALUE 'Hello'. - 05 FILLER PIC X(9) VALUE 'World'. - 01 MYOCC PIC 9(8) COMP. - 01 MYTAB. - 03 MYBYTE PIC XX OCCURS 1 TO 20 - DEPENDING ON MYOCC. - - PROCEDURE DIVISION. - MOVE -512.77 TO NE. - CALL "CAPI" USING BY CONTENT - FUNCTION CONCATENATE("ABC" "DEF"). - CALL "CAPI" USING 2560 BY VALUE 16. - CALL "CAPI" USING BIN5FLD, NE. - CALL "CAPI" USING BINFLD5S. - CALL "CAPI" USING BINFLD9. - CALL "CAPI" USING BY CONTENT BIN5FLD, NE. - CALL "CAPI" USING BY CONTENT BIN5FLD, NE. - CALL "CAPI" USING BY CONTENT BINFLD5S. - CALL "CAPI" USING BY CONTENT BINFLD5S. - CALL "CAPI" USING BY CONTENT BINFLD9. - CALL "CAPI" USING BY CONTENT BINFLD9. - CALL "CAPI" USING BY VALUE BIN5FLD, NE. - CALL "CAPI" USING BY VALUE BIN5FLD, NE. - CALL "CAPI" USING BY VALUE BINFLD5S. - CALL "CAPI" USING BY VALUE BINFLD5S. - CALL "CAPI" USING BY VALUE BINFLD9. - CALL "CAPI" USING BY VALUE BINFLD9. - MOVE 512.77 TO NE. - CALL "CAPI" USING COMP3, NE. - DISPLAY "GRPX was " GRPX ";". - CALL "CAPI" USING PIC9 BINFLD5S CHRX GRPX. - DISPLAY "GRPX is now " GRPX ";". - CALL "CAPI" USING COMP3, NE, CHRX. - CALL "CAPI" USING BIN5FLD, NE. - MOVE "Hello!" TO CHRX. - DISPLAY "BIN5FLD BY VALUE & " CHRX ";". - CALL "CAPI" USING BY VALUE BIN5FLD, CHRX. - CALL "CAPI" USING BY VALUE BIN5FLD, CHRX. - CALL "CAPI" USING LENGTH OF GRPX. - MOVE "Anyone out there?" TO GRPX. - DISPLAY "GRPX was " GRPX ";". - CALL "CAPI" USING BY VALUE GRPX LENGTH OF GRPX. - DISPLAY "GRPX is now " GRPX ";". - CALL "CAPI" USING "Fred Fish", COMP3. - CALL "CAPI" USING COMP3V99. - CALL "CAPI" . - DISPLAY "COMP3 is now " COMP3 ";". - DISPLAY "COMP4 is now " BIN5FLD ";". - DISPLAY "BINFLD5S is now " BINFLD5S ";". - DISPLAY "CHRX is now " CHRX ";". - DISPLAY "NE is now " NE ";". - MOVE 9 TO MYOCC. - CALL "CAPI" USING BY CONTENT 1. - CALL "CAPI" USING BY VALUE 1. - CALL "CAPI" USING BY REFERENCE 1. - DISPLAY "Now BY CONTENT LENGTH OF MYTAB;". - CALL "CAPI" USING BY CONTENT LENGTH OF MYTAB. - DISPLAY "Now BY CONTENT LENGTH OF MYOCC;". - CALL "CAPI" USING BY CONTENT LENGTH OF MYOCC. - MOVE 7 TO MYOCC. - DISPLAY "Now LENGTH OF MYTAB;". - CALL "CAPI" USING LENGTH OF MYTAB. - DISPLAY "Now LENGTH OF MYOCC;". - CALL "CAPI" USING LENGTH OF MYOCC. - MOVE 5 TO MYOCC. - DISPLAY "Now BY VALUE LENGTH OF MYTAB;". - CALL "CAPI" USING BY VALUE LENGTH OF MYTAB. - DISPLAY "Now BY VALUE LENGTH OF MYOCC;". - CALL "CAPI" USING BY VALUE LENGTH OF MYOCC. - STOP RUN. -]) - -AT_DATA([cmod.c], [[ -#include -#include -#include - -static char * -getType(int type, int byvalue) -{ - static char wrk[24]; - switch (type) { - case COB_TYPE_GROUP: return "Group"; - case COB_TYPE_NUMERIC_COMP5: return byvalue==2?"COMP-4":"COMP-5"; - case COB_TYPE_NUMERIC_BINARY: return "COMP-4"; - case COB_TYPE_NUMERIC_PACKED: return "COMP-3"; - case COB_TYPE_NUMERIC_FLOAT: return "COMP-1"; - case COB_TYPE_NUMERIC_DOUBLE: return "COMP-2"; - case COB_TYPE_NUMERIC_DISPLAY: return "DISPLAY"; - case COB_TYPE_ALPHANUMERIC: return "X"; - case COB_TYPE_NUMERIC_EDITED: return "EDITED"; - } - sprintf(wrk,"Type %04X",type); - return wrk; -} - -int -CAPI(void *p1, ...) -{ - int k,nargs,type,digits,scale,size,sign,byvalue; - cob_s64_t val; - char *str, wrk[80],pic[24]; - - nargs = cob_get_num_params(); - if ((k = cob_get_name_line (wrk, NULL)) > 0) { - printf("Line%3d: ",k); - } - printf("CALL with %d parameters\n",nargs); - for(k=1; k <= nargs; k++) { - type = cob_get_param_type (k); - digits = cob_get_param_digits (k); - scale = cob_get_param_scale (k); - size = cob_get_param_size (k); - sign = cob_get_param_sign (k); - byvalue = cob_get_param_constant(k); - printf(" P%d: %-8s ",k,getType(type,byvalue)); - if (byvalue == 3) - printf("BY CONTENT "); - else if (byvalue == 2) - printf("BY VALUE "); - else if (byvalue == 1) - printf("LITERAL "); - else - printf("BY REFERENCE "); - if (type == COB_TYPE_ALPHANUMERIC) { - sprintf(pic,"X(%d)",size); - str = cob_get_picx_param (k, NULL, 0); - printf("%-11s '%s'",pic,str); - cob_free ((void*)str); - cob_put_picx_param (k, "Bye!"); - } else if (type == COB_TYPE_GROUP) { - sprintf(pic,"(%d)",size); - str = cob_get_grp_param (k, NULL, 0); - printf("%-11s '%.*s'",pic,size,str); - cob_free ((void*)str); - memset(wrk,' ',sizeof(wrk)); - memcpy(wrk,"Bye-Bye Birdie!",15); - cob_put_grp_param (k, wrk, sizeof(wrk)); - str = cob_get_grp_param (k, NULL, 0); - printf(" --> '%.*s'",size,str); - cob_free ((void*)str); - } else if (type == COB_TYPE_NUMERIC_EDITED) { - if(scale > 0) { - sprintf(pic,"%s9(%d)V9(%d)",sign?"S":"",digits-scale,scale); - } else { - sprintf(pic,"%s9(%d)",sign?"S":"",digits-scale); - } - val = cob_get_s64_param (k); - printf("%-11s %lld ",pic,val); - val = val + 130; - val = -val; - cob_put_s64_param (k, val); - cob_get_grp_param (k, wrk, sizeof(wrk)); - printf(" to %.*s",size,wrk); - } else { - if(scale > 0) { - sprintf(pic,"%s9(%d)V9(%d)",sign?"S":"",digits-scale,scale); - } else { - sprintf(pic,"%s9(%d)",sign?"S":"",digits-scale); - } - val = cob_get_s64_param (k); - printf("%-11s %lld",pic,val); - cob_put_s64_param (k, val + 3); - } - printf(";\n"); - fflush(stdout); - } - if (nargs > 2) - cob_put_s64_param (7, val + 3); - return 0; -} -]]) - -AT_CHECK([cobc -x -std=mf -Wall -debug -fstatic-call prog.cob cmod.c], [0], [], [prog.cob:37: warning: BY CONTENT assumed for alphanumeric item 'NE' -prog.cob:38: warning: BY CONTENT assumed for alphanumeric item 'NE' -prog.cob:52: warning: BY CONTENT assumed for alphanumeric item 'CHRX' -prog.cob:53: warning: BY CONTENT assumed for alphanumeric item 'CHRX' -prog.cob:57: warning: BY CONTENT assumed for alphanumeric item 'GRPX' -]) - -AT_CHECK([./prog], [0], [Line 25: CALL with 1 parameters - P1: X BY REFERENCE X(6) 'ABCDEF'; -Line 27: CALL with 2 parameters - P1: COMP-4 LITERAL S9(9) 2560; - P2: DISPLAY BY VALUE 9(2) 16; -Line 28: CALL with 2 parameters - P1: COMP-5 BY REFERENCE 9(5) 5555; - P2: EDITED BY REFERENCE S9(5)V9(2) -51277 to 511.47 ; -Line 29: CALL with 1 parameters - P1: COMP-4 BY REFERENCE S9(5) 4444; -Line 30: CALL with 1 parameters - P1: COMP-4 BY REFERENCE 9(9) 6666; -Line 31: CALL with 2 parameters - P1: COMP-5 BY CONTENT 9(5) 5558; - P2: EDITED BY CONTENT S9(5)V9(2) 51147 to 512.77-; -Line 32: CALL with 2 parameters - P1: COMP-5 BY CONTENT 9(5) 5558; - P2: EDITED BY CONTENT S9(5)V9(2) 51147 to 512.77-; -Line 33: CALL with 1 parameters - P1: COMP-4 BY CONTENT S9(5) 4447; -Line 34: CALL with 1 parameters - P1: COMP-4 BY CONTENT S9(5) 4447; -Line 35: CALL with 1 parameters - P1: COMP-4 BY CONTENT 9(9) 6669; -Line 36: CALL with 1 parameters - P1: COMP-4 BY CONTENT 9(9) 6669; -Line 37: CALL with 2 parameters - P1: COMP-4 BY VALUE 9(5) 5558; - P2: EDITED BY CONTENT S9(5)V9(2) 51147 to 512.77-; -Line 38: CALL with 2 parameters - P1: COMP-4 BY VALUE 9(5) 5558; - P2: EDITED BY CONTENT S9(5)V9(2) 51147 to 512.77-; -Line 39: CALL with 1 parameters - P1: COMP-4 BY VALUE S9(5) 4447; -Line 40: CALL with 1 parameters - P1: COMP-4 BY VALUE S9(5) 4447; -Line 41: CALL with 1 parameters - P1: COMP-4 BY VALUE 9(9) 6669; -Line 42: CALL with 1 parameters - P1: COMP-4 BY VALUE 9(9) 6669; -Line 44: CALL with 2 parameters - P1: COMP-3 BY REFERENCE 9(8) 3333; - P2: EDITED BY REFERENCE S9(5)V9(2) 51277 to 514.07-; -GRPX was Hello World ; -Line 46: CALL with 4 parameters - P1: DISPLAY BY REFERENCE S9(8) 8888; - P2: COMP-4 BY REFERENCE S9(5) 4447; - P3: X BY REFERENCE X(9) 'Hello'; - P4: Group BY REFERENCE (18) 'Hello World ' --> 'Bye-Bye Birdie! '; -GRPX is now Bye-Bye Birdie! ; -Line 48: CALL with 3 parameters - P1: COMP-3 BY REFERENCE 9(8) 3336; - P2: EDITED BY REFERENCE S9(5)V9(2) -51407 to 512.77 ; - P3: X BY REFERENCE X(9) 'Bye!'; -Line 49: CALL with 2 parameters - P1: COMP-5 BY REFERENCE 9(5) 5558; - P2: EDITED BY REFERENCE S9(5)V9(2) 51277 to 514.07-; -BIN5FLD BY VALUE & Hello! ; -Line 52: CALL with 2 parameters - P1: COMP-4 BY VALUE 9(5) 5561; - P2: X BY CONTENT X(9) 'Hello!'; -Line 53: CALL with 2 parameters - P1: COMP-4 BY VALUE 9(5) 5561; - P2: X BY CONTENT X(9) 'Hello!'; -Line 54: CALL with 1 parameters - P1: COMP-4 LITERAL S9(9) 18; -GRPX was Anyone out there? ; -Line 57: CALL with 2 parameters - P1: Group BY CONTENT (18) 'Anyone out there? ' --> 'Bye-Bye Birdie! '; - P2: DISPLAY BY VALUE 9(2) 18; -GRPX is now Anyone out there? ; -Line 59: CALL with 2 parameters - P1: X BY CONTENT X(9) 'Fred Fish'; - P2: COMP-3 BY REFERENCE 9(8) 3339; -Line 60: CALL with 1 parameters - P1: COMP-3 BY REFERENCE S9(7)V9(2) 1250; -Line 61: CALL with 0 parameters -COMP3 is now 00003342; -COMP4 is now 00005561; -BINFLD5S is now +04450; -CHRX is now Hello! ; -NE is now 514.07-; -Line 68: CALL with 1 parameters - P1: COMP-4 LITERAL S9(9) 1; -Line 69: CALL with 1 parameters - P1: DISPLAY BY VALUE 9(1) 1; -Line 70: CALL with 1 parameters - P1: COMP-4 LITERAL S9(9) 1; -Now BY CONTENT LENGTH OF MYTAB; -Line 72: CALL with 1 parameters - P1: COMP-4 LITERAL 9(9) 18; -Now BY CONTENT LENGTH OF MYOCC; -Line 74: CALL with 1 parameters - P1: COMP-4 LITERAL S9(9) 4; -Now LENGTH OF MYTAB; -Line 77: CALL with 1 parameters - P1: COMP-4 LITERAL 9(9) 14; -Now LENGTH OF MYOCC; -Line 79: CALL with 1 parameters - P1: COMP-4 LITERAL S9(9) 4; -Now BY VALUE LENGTH OF MYTAB; -Line 82: CALL with 1 parameters - P1: COMP-4 BY VALUE 9(9) 10; -Now BY VALUE LENGTH OF MYOCC; -Line 84: CALL with 1 parameters - P1: DISPLAY BY VALUE 9(1) 4; -], [libcob: prog.cob:27: warning: cob_put_s64_param: attempt to over-write constant parameter 1 with 2563 -libcob: prog.cob:27: warning: cob_put_s64_param: attempt to over-write constant parameter 2 with 19 -libcob: prog.cob:46: warning: cob_put_s64_param: parameter 7 is not within range of 4 -libcob: prog.cob:48: warning: cob_put_s64_param: parameter 7 is not within range of 3 -libcob: prog.cob:54: warning: cob_put_s64_param: attempt to over-write constant parameter 1 with 21 -libcob: prog.cob:57: warning: cob_put_s64_param: attempt to over-write constant parameter 2 with 21 -libcob: prog.cob:59: warning: cob_put_picx_param: attempt to over-write constant parameter 1 with 'Bye!' -libcob: prog.cob:68: warning: cob_put_s64_param: attempt to over-write constant parameter 1 with 4 -libcob: prog.cob:69: warning: cob_put_s64_param: attempt to over-write constant parameter 1 with 4 -libcob: prog.cob:70: warning: cob_put_s64_param: attempt to over-write constant parameter 1 with 4 -libcob: prog.cob:72: warning: cob_put_s64_param: attempt to over-write constant parameter 1 with 21 -libcob: prog.cob:74: warning: cob_put_s64_param: attempt to over-write constant parameter 1 with 7 -libcob: prog.cob:77: warning: cob_put_s64_param: attempt to over-write constant parameter 1 with 17 -libcob: prog.cob:79: warning: cob_put_s64_param: attempt to over-write constant parameter 1 with 7 -libcob: prog.cob:84: warning: cob_put_s64_param: attempt to over-write constant parameter 1 with 7 -]) - -AT_CLEANUP - - -AT_SETUP([CALL with program prototypes]) -AT_KEYWORDS([runmisc]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - - PROCEDURE DIVISION. - CALL "c" - . - END PROGRAM prog. - - - IDENTIFICATION DIVISION. - PROGRAM-ID. a AS "blah?Sdk". - - PROCEDURE DIVISION. - DISPLAY "Hello!" - . - END PROGRAM a. - - - IDENTIFICATION DIVISION. - PROGRAM-ID. b. - - PROCEDURE DIVISION. - DISPLAY "Hello again!" - . - END PROGRAM b. - - - IDENTIFICATION DIVISION. - PROGRAM-ID. c. - - ENVIRONMENT DIVISION. - CONFIGURATION SECTION. - REPOSITORY. - PROGRAM d AS "blah?Sdk" - PROGRAM b - . - - PROCEDURE DIVISION. - CALL d - CALL b - . - END PROGRAM c. -]) - -AT_CHECK([$COMPILE -o prog prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], -[Hello! -Hello again! -]) -AT_CLEANUP - - -AT_SETUP([REDEFINES values on FILLER and INITIALIZE]) -AT_KEYWORDS([runmisc INITIALIZE]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 TSRDF. - 05 WS-ASK-ID-DATE PIC X(10) VALUE ALL '*'. - 05 WS-ASK-ID-DATE-R REDEFINES WS-ASK-ID-DATE. - 10 WS-ASK-ID-DATE-YYYY PIC 9(4) VALUE 2017. - 10 FILLER PIC X VALUE '-'. - 10 WS-ASK-ID-DATE-MM PIC 9(2). - 10 FILLER PIC X VALUE '-'. - 10 WS-ASK-ID-DATE-DD PIC 9(2). - PROCEDURE DIVISION. - MOVE 2015 TO WS-ASK-ID-DATE-YYYY - MOVE 08 TO WS-ASK-ID-DATE-MM - MOVE 21 TO WS-ASK-ID-DATE-DD - DISPLAY "The date is " WS-ASK-ID-DATE " Compiled". - - INITIALIZE WS-ASK-ID-DATE-R. - MOVE 08 TO WS-ASK-ID-DATE-MM - MOVE 21 TO WS-ASK-ID-DATE-DD - DISPLAY "The date is " WS-ASK-ID-DATE " INITIALIZE". - - INITIALIZE WS-ASK-ID-DATE-R WITH FILLER. - MOVE 08 TO WS-ASK-ID-DATE-MM - MOVE 21 TO WS-ASK-ID-DATE-DD - DISPLAY "The date is " WS-ASK-ID-DATE " WITH FILLER". - - INITIALIZE WS-ASK-ID-DATE-R WITH FILLER ALL TO VALUE. - MOVE 08 TO WS-ASK-ID-DATE-MM - MOVE 21 TO WS-ASK-ID-DATE-DD - DISPLAY "The date is " WS-ASK-ID-DATE " ALL TO VALUE". - STOP RUN. -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], -[prog.cob:9: warning: initial VALUE clause ignored for REDEFINES item 'WS-ASK-ID-DATE-YYYY' -prog.cob:10: warning: initial VALUE clause ignored for REDEFINES item 'FILLER' -prog.cob:12: warning: initial VALUE clause ignored for REDEFINES item 'FILLER' -]) - -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], -[The date is 2015*08*21 Compiled -The date is 0000*08*21 INITIALIZE -The date is 0000 08 21 WITH FILLER -The date is 2017-08-21 ALL TO VALUE -], []) - -AT_CLEANUP - - -AT_SETUP([PICTURE with constant-name]) -AT_KEYWORDS([runmisc]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 foo-bar CONSTANT 8. - 01 x PIC 9(foo-bar)9(foo-bar). - - PROCEDURE DIVISION. - IF FUNCTION LENGTH (x) <> 16 - DISPLAY FUNCTION LENGTH (x) - END-IF - . - END PROGRAM prog. -]) -# " <-- comment for fixing syntax highlighting - -AT_CHECK([$COMPILE_ONLY prog.cob], [0], [], -[prog.cob:11: warning: expression '16' NOT EQUAL '16' is always FALSE -]) -AT_CHECK([$COMPILE -fno-constant-folding prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [], []) -AT_CLEANUP - - -AT_SETUP([Quote marks in comment paragraphs]) -AT_KEYWORDS([runmisc]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATE-written. hello'". - *> Written is intentionally lowercase. - *> extra " to fix syntax highlighting - PROCEDURE DIVISION. - DISPLAY "Hello, world!" - . -]) - -AT_CHECK([$COMPILE -o prog prog.cob], [0], [], -[prog.cob:4: warning: DATE-WRITTEN is obsolete in GnuCOBOL -]) -AT_CHECK([$COMPILE -free -o prog prog.cob], [0], [], -[prog.cob:3: warning: DATE-WRITTEN is obsolete in GnuCOBOL -]) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], -[Hello, world! -]) -AT_CLEANUP - - -AT_SETUP([Numeric MOVE with/without -fbinary-truncate]) -AT_KEYWORDS([runmisc size]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 x PIC 9(4) COMP. - - PROCEDURE DIVISION. - MOVE 30000 TO x - PERFORM check-x-val - - COMPUTE x = 30000 - PERFORM check-x-val - - MOVE ZERO TO x - ADD 30000 TO x - PERFORM check-x-val - - GOBACK - . - check-x-val SECTION. - EVALUATE x - WHEN >= 10000 - DISPLAY "x >= 10000" - - WHEN ZERO - DISPLAY "x IS ZERO" - - WHEN OTHER - CONTINUE - END-EVALUATE - . - END PROGRAM prog. -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], -[prog.cob:10: warning: value size exceeds data size -prog.cob:10: warning: value is 30000 -prog.cob:7: warning: 'x' defined here as PIC 9(4) -]) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], -[x IS ZERO -x IS ZERO -x IS ZERO -]) - -AT_CHECK([$COMPILE -fno-binary-truncate prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], -[x >= 10000 -x >= 10000 -x >= 10000 -]) - -AT_CLEANUP - - -AT_SETUP([Alphanumeric MOVE with truncation]) -AT_KEYWORDS([misc fundamental size]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 x-left PIC X(03). - 01 x-right PIC X(03) JUSTIFIED RIGHT. - - PROCEDURE DIVISION. - MOVE '1234' TO x-left, x-right - IF x-left not = '123' - OR x-right not = '234' - DISPLAY 'error with "1234":' - END-DISPLAY - DISPLAY x-left - END-DISPLAY - DISPLAY x-right - END-DISPLAY - END-IF - MOVE ' 3' TO x-left, x-right - IF x-left not = spaces - OR x-right not = ' 3' - DISPLAY 'error with " 3":' - END-DISPLAY - DISPLAY x-left - END-DISPLAY - DISPLAY x-right - END-DISPLAY - END-IF - MOVE '3 ' TO x-left, x-right - IF x-left not = '3' - OR x-right not = spaces - DISPLAY 'error with "3 ":' - END-DISPLAY - DISPLAY x-left - END-DISPLAY - DISPLAY x-right - END-DISPLAY - END-IF - . -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], -[prog.cob:11: warning: value size exceeds data size -prog.cob:11: warning: value size is 4 -prog.cob:7: warning: 'x-left' defined here as PIC X(03) -prog.cob:11: warning: value size exceeds data size -prog.cob:11: warning: value size is 4 -prog.cob:8: warning: 'x-right' defined here as PIC X(03) -prog.cob:21: warning: value size exceeds data size -prog.cob:21: warning: value size is 4 -prog.cob:7: warning: 'x-left' defined here as PIC X(03) -prog.cob:31: warning: value size exceeds data size -prog.cob:31: warning: value size is 4 -prog.cob:8: warning: 'x-right' defined here as PIC X(03) -]) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [], []) -AT_CLEANUP - - -AT_SETUP([PROGRAM-ID / CALL literal/variable with spaces]) -AT_KEYWORDS([CALL]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 MYRTN PIC X(9) VALUE " SUB ". - - PROCEDURE DIVISION. - CALL " SUB " USING 'X'. - MOVE x'00' TO MYRTN (6:1). - CALL MYRTN USING 'Y'. - CALL "SUB" USING 'Z'. - CALL "S U B" USING 'A'. - MOVE " S U B" TO MYRTN. - CALL MYRTN USING 'B'. - STOP RUN. - END PROGRAM prog. - - IDENTIFICATION DIVISION. - PROGRAM-ID. "SUB ". - - DATA DIVISION. - LINKAGE SECTION. - 01 x PIC X. - - PROCEDURE DIVISION USING x. - DISPLAY "SUB GOT " X - END-DISPLAY. - END PROGRAM " SUB". - - IDENTIFICATION DIVISION. - PROGRAM-ID. "S U B". - - DATA DIVISION. - LINKAGE SECTION. - 01 x PIC X. - - PROCEDURE DIVISION USING x. - DISPLAY "S U B GOT " X - END-DISPLAY. - END PROGRAM "S U B". -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], -[prog.cob:10: warning: ' SUB ' literal includes leading spaces which are omitted -prog.cob:10: warning: ' SUB ' literal includes trailing spaces which are omitted -prog.cob:21: warning: 'SUB ' literal includes trailing spaces which are omitted -prog.cob:30: warning: ' SUB' literal includes leading spaces which are omitted -]) - -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], -[SUB GOT X -SUB GOT Y -SUB GOT Z -S U B GOT A -S U B GOT B -], -[libcob: prog.cob:12: warning: ' SUB' literal includes leading spaces which are omitted -libcob: prog.cob:16: warning: ' S U B' literal includes leading spaces which are omitted -]) - -AT_CLEANUP - - -AT_SETUP([DEFAULT ROUNDED MODE]) -AT_KEYWORDS([runmisc]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - OPTIONS. - DEFAULT ROUNDED NEAREST-EVEN. - - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 x PIC 9. - - PROCEDURE DIVISION. - COMPUTE x ROUNDED = 1.5 - DISPLAY x - COMPUTE x ROUNDED = 2.5 - DISPLAY x - . -]) - -AT_CHECK([$COMPILE -o prog prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], -[2 -2 -]) - -AT_CLEANUP - - -AT_SETUP([OCCURS INDEXED ASCENDING]) -AT_KEYWORDS([occurs extension]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 DBI-RECORD-NAMEST. - 05 FILLER. - 10 FILLER PIC X(35) - VALUE 'A-F-GEN-LEDGER-ACM 0315 '. - 10 FILLER PIC X(35) - VALUE 'A-F-GEN-LEDGER-MGL 0303 '. - 10 FILLER PIC X(35) - VALUE 'A-F-GEN-LEDGER-ZBL 0304 '. - 10 FILLER PIC X(35) - VALUE 'A-F-GEN-LEDGER-ZCC 0308 '. - 10 FILLER PIC X(35) - VALUE 'A-F-GEN-LEDGER-ZGL 0305 '. - 10 FILLER PIC X(35) - VALUE 'A-F-GEN-LEDGER-ZOO 0306 '. - 10 FILLER PIC X(35) - VALUE 'A-F-GEN-LEDGER-ZTR 0307 '. - 01 DBI-RECORD-NAMESR REDEFINES DBI-RECORD-NAMEST. - 05 DBI-RECORD-NAMES - OCCURS 7 TIMES - INDEXED BY REC-NAME-IDX - ASCENDING KEY IS DBI-RECORD-NAME - . - 10 DBI-RECORD-NAME PIC X(30). - 10 DBI-RECORD-CODE PIC 9(4). - 10 DBI-RECORD-DIR PIC X. - 01 REC-NAME PIC X(30). - 01 DBX-RECORD-NAMEST. - 05 FILLER. - 10 FILLER PIC X(35) - VALUE 'A-F-GEN-LEDGER-ACM 0315 '. - 10 FILLER PIC X(35) - VALUE 'A-F-GEN-LEDGER-MGL 0303 '. - 10 FILLER PIC X(35) - VALUE 'A-F-GEN-LEDGER-ZBL 0304 '. - 10 FILLER PIC X(35) - VALUE 'A-F-GEN-LEDGER-ZCC 0308 '. - 10 FILLER PIC X(35) - VALUE 'A-F-GEN-LEDGER-ZGL 0305 '. - 10 FILLER PIC X(35) - VALUE 'A-F-GEN-LEDGER-ZOO 0306 '. - 10 FILLER PIC X(35) - VALUE 'A-F-GEN-LEDGER-ZTR 0307 '. - 01 DBX-RECORD-NAMESR REDEFINES DBX-RECORD-NAMEST. - 05 DBX-RECORD-NAMES - OCCURS 7 TIMES - ASCENDING KEY IS DBX-RECORD-NAME - INDEXED BY REC-NAME-DBX - . - 10 DBX-RECORD-NAME PIC X(30). - 10 DBX-RECORD-CODE PIC 9(4). - 10 DBX-RECORD-DIR PIC X. - - PROCEDURE DIVISION. - MAIN. - MOVE 'A-F-GEN-LEDGER-ZGL' TO REC-NAME. - PERFORM FINDIT. - MOVE 'JUNK' TO REC-NAME. - PERFORM FINDIT. - STOP RUN. - - FINDIT. - SEARCH DBI-RECORD-NAMES - AT END - DISPLAY 'A ' REC-NAME ' is invalid.' - WHEN REC-NAME = DBI-RECORD-NAME (REC-NAME-IDX) - DISPLAY 'A ' REC-NAME ' is code ' - DBI-RECORD-CODE (REC-NAME-IDX) '.'. - - SEARCH DBX-RECORD-NAMES - AT END - DISPLAY 'B ' REC-NAME ' is invalid.' - WHEN REC-NAME = DBX-RECORD-NAME (REC-NAME-DBX) - DISPLAY 'B ' REC-NAME ' is code ' - DBX-RECORD-CODE (REC-NAME-DBX) '.'. -]) - -AT_CHECK([$COMPILE -frelax-syntax-checks prog.cob ], [0], [], -[prog.cob:26: warning: INDEXED should follow ASCENDING/DESCENDING -]) - -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], -[A A-F-GEN-LEDGER-ZGL is code 0305. -B A-F-GEN-LEDGER-ZGL is code 0305. -A JUNK is invalid. -B JUNK is invalid. -], []) - -AT_CLEANUP - - - -AT_SETUP([ZERO unsigned and negative binary subscript]) -AT_KEYWORDS([runmisc]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 77 UBIN PIC 9(8) BINARY. - 77 SBIN PIC S9(8) BINARY. - 77 UNUP PIC 9(8). - 77 SNUP PIC S9(8). - - 01 TSTREC. - 05 TSTX PIC X(4) OCCURS 3 TIMES. - 05 TSTY PIC X(4) OCCURS 3 TIMES. - - PROCEDURE DIVISION. - MOVE ALL 'A' TO TSTX(1). - MOVE ALL 'B' TO TSTX(2). - MOVE ALL 'C' TO TSTX(3). - MOVE ALL '1' TO TSTY(1). - MOVE ALL '2' TO TSTY(2). - MOVE ALL '3' TO TSTY(3). - MOVE 0 TO UNUP. - DISPLAY "UNUP: " UNUP " is :" TSTY(UNUP) ":" UPON CONSOLE. - MOVE 0 TO SNUP. - DISPLAY "SNUP: " SNUP " is :" TSTY(SNUP) ":" UPON CONSOLE. - MOVE 0 TO SBIN. - DISPLAY "SBIN: " SBIN " is :" TSTY(SBIN) ":" UPON CONSOLE. - MOVE -1 TO SBIN. - DISPLAY "SBIN: " SBIN " is :" TSTY(SBIN) ":" UPON CONSOLE. - MOVE 'xxx' TO TSTY(SBIN). - DISPLAY "SBIN: " SBIN " is :" TSTY(SBIN) ":" UPON CONSOLE. - * The following would often core dump - MOVE 0 TO UBIN. - DISPLAY "UBIN: " UBIN " is :" TSTY(UBIN) ":" UPON CONSOLE. - MOVE 'xxx' TO TSTY(UBIN). - MOVE 1 TO UBIN. - DISPLAY "UBIN: " UBIN " is :" TSTY(UBIN) ":" UPON CONSOLE. - STOP RUN. -]) - -# Safe run with runtime checks -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [1], [], -[libcob: prog.cob:23: error: subscript of 'TSTY' out of bounds: 0 -]) - -# Runtime checks disable, subscript may be zero or even negative -AT_CHECK([$COBC -x prog.cob -o prog_unsafe], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog_unsafe], [0], -[UNUP: 00000000 is :CCCC: -SNUP: +00000000 is :CCCC: -SBIN: +00000000 is :CCCC: -SBIN: -00000001 is :BBBB: -SBIN: -00000001 is :xxx : -UBIN: 00000000 is :CCCC: -UBIN: 00000001 is :1111: -], []) - -AT_CLEANUP - - -AT_SETUP([Default Arithmetic (1)]) -AT_KEYWORDS([runmisc]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 NUM-A PIC 9(3) VALUE 399. - 01 NUM-B PIC 9(3) VALUE 211. - 01 NUM-C PIC 9(3)V99 VALUE 212.34. - 01 NUMV1 PIC 9(3)V9. - 01 PICX PIC X VALUE 'A'. - 01 RSLT PIC 9(3). - 01 RSLTV1 PIC 9(3).9. - 01 RSLTV2 PIC 9(3).99. - 01 SGN-INT USAGE SIGNED-INT VALUE 0. - 88 A-ONE VALUE 1. - 88 A-TWO VALUE 2. - * - PROCEDURE DIVISION. - MAIN. - COMPUTE RSLT = NUM-A + 1.1. - DISPLAY 'Simple Compute RSLT IS ' RSLT - COMPUTE RSLT = ((NUM-A / 100) - (NUM-B / 100)) * 100 - DISPLAY 'Single Variable RSLT IS ' RSLT - COMPUTE RSLTV2, RSLT = ((NUM-A / 100) - (NUM-B / 100)) * 100 - DISPLAY 'Compute RSLT IS ' RSLT - DISPLAY 'Compute RSLTv99 IS ' RSLTV2 - COMPUTE RSLTV1, RSLT = ((NUM-A / 100) - (NUM-B / 100)) * 100 - DISPLAY 'Compute RSLT IS ' RSLT - DISPLAY 'Compute RSLTv9 IS ' RSLTV1 - MOVE 0 TO RSLT - ADD NUM-C TO RSLT. - DISPLAY 'Add RSLT IS ' RSLT. - MOVE 0 TO RSLT - ADD NUM-A NUM-C 10 TO RSLT. - DISPLAY 'Add RSLT IS ' RSLT. - SUBTRACT NUM-C FROM RSLT. - DISPLAY 'Subtract RSLT IS ' RSLT. - SUBTRACT NUM-A -10 FROM RSLT. - DISPLAY 'Subtract RSLT IS ' RSLT. - MOVE 0 TO RSLT - ADD NUM-A NUM-C TO RSLT GIVING RSLTV1. - DISPLAY 'Add RSLTv9 IS ' RSLTV1 - MULTIPLY NUM-A BY NUM-C GIVING RSLT. - DISPLAY 'Multiply RSLT IS ' RSLT. - MULTIPLY RSLT BY NUM-C. - DISPLAY 'Multiply RSLT IS ' RSLT. - DIVIDE NUM-A BY 10 GIVING RSLT. - DISPLAY 'Divide RSLT IS ' RSLT. - DIVIDE RSLT BY 4 GIVING RSLTV1. - DISPLAY 'Divide RSLTv9 IS ' RSLTV1. - DIVIDE RSLT BY 4 GIVING RSLT. - DISPLAY 'Divide RSLT IS ' RSLT. - - COMPUTE RSLTV1, RSLT = ((NUM-A / 100) - (NUM-B / 100)) * 100 - DISPLAY 'Simple RSLT IS ' RSLT - ' RSLTv9 IS ' RSLTV1. - - COMPUTE RSLTV1, RSLT = ((NUM-A / (100.55 + -0.550)) - - (NUM-B / (10.11 * 10 - 1.1))) - * (220 / 2.2) - DISPLAY 'Complex RSLT IS ' RSLT - ' RSLTv9 IS ' RSLTV1. - - COMPUTE RSLTV1, RSLT = ((NUM-A / (101 - 1)) - - (NUM-B / (10 * 10))) * (200 / 2) - DISPLAY 'Reduced RSLT IS ' RSLT - ' RSLTv9 IS ' RSLTV1. - MOVE NUM-A TO NUMV1. - IF ((NUMV1 / (101 - 1)) - - (NUM-B / (10 * 10))) * (200 / 2) EQUAL 188 - DISPLAY "Not Using ARITHMETIC-OSVS" - ELSE - DISPLAY "Using ARITHMETIC-OSVS" - END-IF. - IF NOT A-ONE AND NOT A-TWO - DISPLAY '88 test SUCCESS' - ELSE - DISPLAY '88 test FAILED' - END-IF. - STOP RUN. -]) -AT_CHECK([$COMPILE prog.cob], [0], [], []) - -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], -[Simple Compute RSLT IS 400 -Single Variable RSLT IS 188 -Compute RSLT IS 188 -Compute RSLTv99 IS 188.00 -Compute RSLT IS 188 -Compute RSLTv9 IS 188.0 -Add RSLT IS 212 -Add RSLT IS 621 -Subtract RSLT IS 408 -Subtract RSLT IS 019 -Add RSLTv9 IS 611.3 -Multiply RSLT IS 723 -Multiply RSLT IS 723 -Divide RSLT IS 039 -Divide RSLTv9 IS 009.7 -Divide RSLT IS 009 -Simple RSLT IS 188 RSLTv9 IS 188.0 -Complex RSLT IS 188 RSLTv9 IS 188.0 -Reduced RSLT IS 188 RSLTv9 IS 188.0 -Not Using ARITHMETIC-OSVS -88 test SUCCESS -], []) - -AT_CLEANUP - - -AT_SETUP([Default Arithmetic Test (2)]) -AT_KEYWORDS([runmisc]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 VAL PIC S9(7)V99 COMP-3 VALUE 20500. - 01 DIV1 PIC S9(7)V99 COMP-3 VALUE 0.9. - 01 DIV2 PIC S9(7)V99 COMP-3 VALUE 33.45. - 01 DIV3 PIC S9(7)V99 COMP-3 VALUE 9. - 01 MUL1 PIC S9(7)V99 COMP-3 VALUE 10. - 01 MUL2 PIC S9(7)V99 COMP-3 VALUE 5. - 01 MUL3 PIC S9(7)V99 COMP-3 VALUE 2. - 01 RES PIC S9(7)V99 COMP-3. - PROCEDURE DIVISION. - COMPUTE RES = VAL / DIV1 / DIV2. - DISPLAY 'RES = ' RES. - COMPUTE RES ROUNDED = VAL / DIV1 / DIV2. - DISPLAY 'RES ROUNDED = ' RES. - COMPUTE RES = VAL * MUL1 / DIV3 / DIV2. - DISPLAY 'RES MULT1 = ' RES. - COMPUTE RES = VAL * MUL2 * MUL3 / DIV3 / DIV2. - DISPLAY 'RES MULT2 = ' RES. - COMPUTE RES = VAL / DIV1. - DISPLAY 'RES 1 = ' RES. - COMPUTE RES = RES / DIV2. - DISPLAY 'RES F = ' RES. - COMPUTE RES ROUNDED MODE AWAY-FROM-ZERO = - VAL / DIV1 / DIV2. - DISPLAY 'RES ROUNDED AWAY = ' RES. - STOP RUN. -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) - -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], -[RES = +0000680.95 -RES ROUNDED = +0000680.95 -RES MULT1 = +0000680.95 -RES MULT2 = +0000680.95 -RES 1 = +0022777.77 -RES F = +0000680.94 -RES ROUNDED AWAY = +0000680.96 -], []) - -AT_CLEANUP - - -AT_SETUP([OSVS Arithmetic (1)]) -AT_KEYWORDS([runmisc]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 NUM-A PIC 9(3) VALUE 399. - 01 NUM-B PIC 9(3) VALUE 211. - 01 NUM-C PIC 9(3)V99 VALUE 212.34. - 01 NUMV1 PIC 9(3)V9. - 01 PICX PIC X VALUE 'A'. - 01 RSLT PIC 9(3). - 01 RSLTV1 PIC 9(3).9. - 01 RSLTV2 PIC 9(3).99. - * - PROCEDURE DIVISION. - MAIN. - COMPUTE RSLT = NUM-A + 1.1. - DISPLAY 'Simple Compute RSLT IS ' RSLT - COMPUTE RSLT = ((NUM-A / 100) - (NUM-B / 100)) * 100 - DISPLAY 'Single Variable RSLT IS ' RSLT - COMPUTE RSLTV2, RSLT = ((NUM-A / 100) - (NUM-B / 100)) * 100 - DISPLAY 'Compute RSLT IS ' RSLT - DISPLAY 'Compute RSLTv99 IS ' RSLTV2 - COMPUTE RSLTV1, RSLT = ((NUM-A / 100) - (NUM-B / 100)) * 100 - DISPLAY 'Compute RSLT IS ' RSLT - DISPLAY 'Compute RSLTv9 IS ' RSLTV1 - MOVE 0 TO RSLT - ADD NUM-C TO RSLT. - DISPLAY 'Add RSLT IS ' RSLT. - MOVE 0 TO RSLT - ADD NUM-A NUM-C 10 TO RSLT. - DISPLAY 'Add RSLT IS ' RSLT. - SUBTRACT NUM-C FROM RSLT. - DISPLAY 'Subtract RSLT IS ' RSLT. - SUBTRACT NUM-A -10 FROM RSLT. - DISPLAY 'Subtract RSLT IS ' RSLT. - MOVE 0 TO RSLT - ADD NUM-A NUM-C TO RSLT GIVING RSLTV1. - DISPLAY 'Add RSLTv9 IS ' RSLTV1 - MULTIPLY NUM-A BY NUM-C GIVING RSLT. - DISPLAY 'Multiply RSLT IS ' RSLT. - MULTIPLY RSLT BY NUM-C. - DISPLAY 'Multiply RSLT IS ' RSLT. - DIVIDE NUM-A BY 10 GIVING RSLT. - DISPLAY 'Divide RSLT IS ' RSLT. - DIVIDE RSLT BY 4 GIVING RSLTV1. - DISPLAY 'Divide RSLTv9 IS ' RSLTV1. - DIVIDE RSLT BY 4 GIVING RSLT. - DISPLAY 'Divide RSLT IS ' RSLT. - - COMPUTE RSLTV1, RSLT = ((NUM-A / 100) - (NUM-B / 100)) * 100 - DISPLAY 'Simple RSLT IS ' RSLT - ' RSLTv9 IS ' RSLTV1. - - COMPUTE RSLTV1, RSLT = ((NUM-A / (100.55 + -0.550)) - - (NUM-B / (10.11 * 10 - 1.1))) - * (220 / 2.2) - DISPLAY 'Complex RSLT IS ' RSLT - ' RSLTv9 IS ' RSLTV1. - - COMPUTE RSLTV1, RSLT = ((NUM-A / (101 - 1)) - - (NUM-B / (10 * 10))) * (200 / 2) - DISPLAY 'Reduced RSLT IS ' RSLT - ' RSLTv9 IS ' RSLTV1. - MOVE NUM-A TO NUMV1. - IF ((NUMV1 / (101 - 1)) - - (NUM-B / (10 * 10))) * (200 / 2) EQUAL 188 - DISPLAY "Not Using ARITHMETIC-OSVS" - ELSE - DISPLAY "Using ARITHMETIC-OSVS" - END-IF. - STOP RUN. -]) - -AT_CHECK([$COMPILE -farithmetic-osvs prog.cob], [0], [], -[prog.cob: in paragraph 'MAIN': -prog.cob:19: warning: precision of result may change with arithmetic-osvs -prog.cob:21: warning: precision of result may change with arithmetic-osvs -prog.cob:24: warning: precision of result may change with arithmetic-osvs -prog.cob:31: warning: precision of result may change with arithmetic-osvs -prog.cob:35: warning: precision of result may change with arithmetic-osvs -prog.cob:38: warning: precision of result may change with arithmetic-osvs -prog.cob:51: warning: precision of result may change with arithmetic-osvs -prog.cob:55: warning: precision of result may change with arithmetic-osvs -prog.cob:61: warning: precision of result may change with arithmetic-osvs -prog.cob:66: warning: precision of result may change with arithmetic-osvs -]) - -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], -[Simple Compute RSLT IS 400 -Single Variable RSLT IS 100 -Compute RSLT IS 188 -Compute RSLTv99 IS 188.00 -Compute RSLT IS 180 -Compute RSLTv9 IS 180.0 -Add RSLT IS 212 -Add RSLT IS 621 -Subtract RSLT IS 408 -Subtract RSLT IS 019 -Add RSLTv9 IS 611.3 -Multiply RSLT IS 723 -Multiply RSLT IS 723 -Divide RSLT IS 039 -Divide RSLTv9 IS 009.7 -Divide RSLT IS 009 -Simple RSLT IS 180 RSLTv9 IS 180.0 -Complex RSLT IS 188 RSLTv9 IS 188.0 -Reduced RSLT IS 180 RSLTv9 IS 180.0 -Using ARITHMETIC-OSVS -], []) - -AT_CLEANUP - - -AT_SETUP([OSVS Arithmetic Test (2)]) -AT_KEYWORDS([runmisc]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 VAL PIC S9(7)V99 COMP-3 VALUE 20500. - 01 DIV1 PIC S9(7)V99 COMP-3 VALUE 0.9. - 01 DIV2 PIC S9(7)V99 COMP-3 VALUE 33.45. - 01 DIV3 PIC S9(7)V99 COMP-3 VALUE 9. - 01 MUL1 PIC S9(7)V99 COMP-3 VALUE 10. - 01 MUL2 PIC S9(7)V99 COMP-3 VALUE 5. - 01 MUL3 PIC S9(7)V99 COMP-3 VALUE 2. - 01 RES PIC S9(7)V99 COMP-3. - PROCEDURE DIVISION. - COMPUTE RES = VAL / DIV1 / DIV2. - DISPLAY 'RES = ' RES. - COMPUTE RES ROUNDED = VAL / DIV1 / DIV2. - DISPLAY 'RES ROUNDED = ' RES. - COMPUTE RES = VAL * MUL1 / DIV3 / DIV2. - DISPLAY 'RES MULT1 = ' RES. - COMPUTE RES = VAL * MUL2 * MUL3 / DIV3 / DIV2. - DISPLAY 'RES MULT2 = ' RES. - COMPUTE RES = VAL / DIV1. - DISPLAY 'RES 1 = ' RES. - COMPUTE RES = RES / DIV2. - DISPLAY 'RES F = ' RES. - COMPUTE RES ROUNDED MODE AWAY-FROM-ZERO = - VAL / DIV1 / DIV2. - DISPLAY 'RES ROUNDED AWAY = ' RES. - STOP RUN. -]) - -AT_CHECK([$COMPILE -std=ibm prog.cob], [0], [], -[prog.cob:16: warning: precision of result may change with arithmetic-osvs -prog.cob:18: warning: precision of result may change with arithmetic-osvs -prog.cob:20: warning: precision of result may change with arithmetic-osvs -prog.cob:22: warning: precision of result may change with arithmetic-osvs -prog.cob:28: warning: precision of result may change with arithmetic-osvs -]) - -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], -[RES = +000068094 -RES ROUNDED = +000068095 -RES MULT1 = +000068094 -RES MULT2 = +000068095 -RES 1 = +002277777 -RES F = +000068094 -RES ROUNDED AWAY = +000068095 -], []) - -AT_CLEANUP - -AT_SETUP([OSVS Arithmetic Test (3)]) -AT_KEYWORDS([OSVS]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - - 01 PERCENT PIC S9(03)V99. - 01 AMOUNT PIC S9(11)V99. - 01 RESULT PIC S9(11)V99. - 01 D-RESULT PIC -9(5).99. - 01 D-MSG PIC X(37) VALUE " ". - 01 D-RND PIC X(4) VALUE " ". - 01 X-RSLT PIC S9(5). - 01 NUM-A PIC 9(3) VALUE 399. - 01 NUM-B PIC 9(3) VALUE 211. - 01 NUMV1 PIC 9(3)V9. - 01 RSLT PIC 9(3). - 01 RSLTV1 PIC 9(3).9. - - LOCAL-STORAGE SECTION. - PROCEDURE DIVISION. - - DISPLAY '-- TEST COMPUTE WITH ROUNDING --' - - MOVE 24 TO PERCENT - MOVE 123.45 TO AMOUNT - DISPLAY ' AMOUNT: 123.45 ' - ' PERCENT: 24' - - DISPLAY " ALL TESTS HAVE COMPUTE ROUNDED EXCEPT 'NR:'" - - MOVE 'AMOUNT + (AMOUNT * PERCENT / 100)' TO D-MSG - COMPUTE RESULT ROUNDED = AMOUNT + (AMOUNT * PERCENT / 100) - PERFORM SHOW-IT. - - MOVE 'PERCENT / 100 * AMOUNT + AMOUNT' TO D-MSG - COMPUTE RESULT ROUNDED = PERCENT / 100 * AMOUNT + AMOUNT - PERFORM SHOW-IT. - - MOVE 'NR:' TO D-RND - MOVE 'PERCENT / 100 * AMOUNT + AMOUNT' TO D-MSG - COMPUTE RESULT = PERCENT / 100 * AMOUNT + AMOUNT - PERFORM SHOW-IT. - - MOVE '(AMOUNT * PERCENT / 100) + AMOUNT' TO D-MSG - COMPUTE RESULT ROUNDED = (AMOUNT * PERCENT / 100) + AMOUNT - PERFORM SHOW-IT. - - MOVE '(123.45 * 24 / 100) + 123.45' TO D-MSG - COMPUTE RESULT ROUNDED = (123.45 * 24 / 100) + 123.45 - PERFORM SHOW-IT. - - MOVE '123.45 + (123.45 * 24 / 100)' TO D-MSG - COMPUTE RESULT ROUNDED = 123.45 + (123.45 * 24 / 100) - PERFORM SHOW-IT. - - MOVE 'NR:' TO D-RND - MOVE '123.45 + (123.45 * 24 / 100)' TO D-MSG - COMPUTE RESULT = 123.45 + (123.45 * 24 / 100) - PERFORM SHOW-IT. - - MOVE '(AMOUNT * PERCENT / 100) ' TO D-MSG - COMPUTE RESULT = (AMOUNT * PERCENT / 100) - PERFORM SHOW-IT. - - MOVE '(AMOUNT * PERCENT / 100) ROUNDED' TO D-MSG - COMPUTE RESULT ROUNDED = (AMOUNT * PERCENT / 100) - PERFORM SHOW-IT. - - MOVE 399 TO NUMV1. - MOVE 211 TO NUM-B. - COMPUTE X-RSLT = ((NUMV1 / (101 - 1)) - - (NUM-B / (10 * 10))) * (200 / 2) - IF ((NUMV1 / (101 - 1)) - - (NUM-B / (10 * 10))) * (200 / 2) EQUAL 188 - DISPLAY "Not Using ARITHMETIC-OSVS: " X-RSLT - ELSE - DISPLAY "Using ARITHMETIC-OSVS: " X-RSLT - END-IF. - - COMPUTE X-RSLT ROUNDED = ((NUMV1 / (101 - 1)) - - (NUM-B / (10 * 10))) * (200 / 2) - IF ((NUMV1 / (101 - 1)) - - (NUM-B / (10 * 10))) * (200 / 2) EQUAL 188 - DISPLAY "Not Using ARITHMETIC-OSVS: " X-RSLT - ELSE - DISPLAY "Using ARITHMETIC-OSVS: " X-RSLT - END-IF. - - COMPUTE RSLTV1, RSLT = ((NUM-A / 100) - (NUM-B / 100)) * 100 - DISPLAY 'Simple RSLT IS ' RSLT - ' RSLTv9 IS ' RSLTV1. - - COMPUTE RSLTV1, RSLT = ((NUM-A / (100.55 + -0.550)) - - (NUM-B / (10.11 * 10 - 1.1))) - * (220 / 2.2) - DISPLAY 'Complex RSLT IS ' RSLT - ' RSLTv9 IS ' RSLTV1. - - DISPLAY '-- TEST FINISHED --'. - - STOP RUN. - - SHOW-IT. - MOVE RESULT TO D-RESULT - DISPLAY D-RND D-MSG ' = ' D-RESULT. - MOVE SPACES TO D-RND. -]) - -AT_CHECK([$COBC -x -std=ibm -farithmetic-osvs -w prog.cob ], [0], [], []) - -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [-- TEST COMPUTE WITH ROUNDING -- - AMOUNT: 123.45 PERCENT: 24 - ALL TESTS HAVE COMPUTE ROUNDED EXCEPT 'NR:' - AMOUNT + (AMOUNT * PERCENT / 100) = 00153.08 - PERCENT / 100 * AMOUNT + AMOUNT = 00153.08 -NR: PERCENT / 100 * AMOUNT + AMOUNT = 00153.07 - (AMOUNT * PERCENT / 100) + AMOUNT = 00153.08 - (123.45 * 24 / 100) + 123.45 = 00153.08 - 123.45 + (123.45 * 24 / 100) = 00153.08 -NR: 123.45 + (123.45 * 24 / 100) = 00153.07 - (AMOUNT * PERCENT / 100) = 00029.62 - (AMOUNT * PERCENT / 100) ROUNDED = 00029.63 -Using ARITHMETIC-OSVS: 00180+ -Using ARITHMETIC-OSVS: 00180+ -Simple RSLT IS 180 RSLTv9 IS 180.0 -Complex RSLT IS 188 RSLTv9 IS 188.0 --- TEST FINISHED -- -], []) - -AT_CHECK([$COBC -x -std=ibm -w -fno-arithmetic-osvs prog.cob ], [0], [], []) - -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [-- TEST COMPUTE WITH ROUNDING -- - AMOUNT: 123.45 PERCENT: 24 - ALL TESTS HAVE COMPUTE ROUNDED EXCEPT 'NR:' - AMOUNT + (AMOUNT * PERCENT / 100) = 00153.08 - PERCENT / 100 * AMOUNT + AMOUNT = 00153.08 -NR: PERCENT / 100 * AMOUNT + AMOUNT = 00153.07 - (AMOUNT * PERCENT / 100) + AMOUNT = 00153.08 - (123.45 * 24 / 100) + 123.45 = 00153.08 - 123.45 + (123.45 * 24 / 100) = 00153.08 -NR: 123.45 + (123.45 * 24 / 100) = 00153.07 - (AMOUNT * PERCENT / 100) = 00029.62 - (AMOUNT * PERCENT / 100) ROUNDED = 00029.63 -Not Using ARITHMETIC-OSVS: 00188+ -Not Using ARITHMETIC-OSVS: 00188+ -Simple RSLT IS 188 RSLTv9 IS 188.0 -Complex RSLT IS 188 RSLTv9 IS 188.0 --- TEST FINISHED -- -], []) - -AT_CLEANUP - - -AT_SETUP([SET CONSTANT directive]) -AT_KEYWORDS([misc directives extensions]) - -# The SET CONSTANT directive defines a level78 variable -# for the current compilation unit - -# original MF extension: $SET CONSTANT -AT_DATA([prog.cob], [ - $SET CONSTANT DOGGY "Barky" - $SET CONSTANT PONY "Blacky" - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 THEDOG PIC X(6) VALUE DOGGY. - 77 MYHORSE PIC X(7) VALUE PONY. - $SET CONSTANT PONY "White" - * - PROCEDURE DIVISION. - MAIN. - DISPLAY "Your Dog's name is " DOGGY ";". - DISPLAY "The Dog's name is " THEDOG ";". - DISPLAY "My Horse is " MYHORSE ";". - DISPLAY "My little pony is " PONY ".". - STOP RUN. -]) - -# OpenCOBOL/GnuCOBOL extension: >>SET CONSTANT -AT_DATA([prog2.cob], [ - >>SET CONSTANT DOGGY "Barky" - >>SET CONSTANT PONY "Blacky" - IDENTIFICATION DIVISION. - PROGRAM-ID. prog2. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 THEDOG PIC X(6) VALUE DOGGY. - 77 MYHORSE PIC X(7) VALUE PONY. - >>SET CONSTANT PONY "White" - * - PROCEDURE DIVISION. - MAIN. - DISPLAY "Your Dog's name is " DOGGY ";". - DISPLAY "The Dog's name is " THEDOG ";". - DISPLAY "My Horse is " MYHORSE ";". - DISPLAY "My little pony is " PONY ".". - STOP RUN. -]) - -# OpenCOBOL/GnuCOBOL extension: >>DEFINE CONSTANT -AT_DATA([prog3.cob], [ - >>DEFINE CONSTANT DOGGY "Barky" - >>DEFINE CONSTANT PONY "Blacky" - IDENTIFICATION DIVISION. - PROGRAM-ID. prog3. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 THEDOG PIC X(6) VALUE DOGGY. - 77 MYHORSE PIC X(7) VALUE PONY. - >>DEFINE CONSTANT PONY "White" OVERRIDE - * - PROCEDURE DIVISION. - MAIN. - DISPLAY "Your Dog's name is " DOGGY ";". - DISPLAY "The Dog's name is " THEDOG ";". - DISPLAY "My Horse is " MYHORSE ";". - DISPLAY "My little pony is " PONY ".". - STOP RUN. -]) - -AT_CHECK([$COMPILE -std=mf prog.cob], [0], [], []) - -# Note: MF does not redefine a value via SET CONSTANT -# the first definitions wins (we should add a warning) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], -[Your Dog's name is Barky; -The Dog's name is Barky ; -My Horse is Blacky ; -My little pony is Blacky. -], []) - -AT_CHECK([$COMPILE prog2.cob], [0], [], []) - -# Note: MF does not redefine a value via SET CONSTANT -# the first definitions wins (we should add a warning) -AT_CHECK([$COBCRUN_DIRECT ./prog2], [0], -[Your Dog's name is Barky; -The Dog's name is Barky ; -My Horse is Blacky ; -My little pony is Blacky. -], []) - -AT_CHECK([$COMPILE -fdefine-constant-directive=ok prog3.cob], [0], [], []) - -AT_CHECK([$COBCRUN_DIRECT ./prog3], [0], -[Your Dog's name is Barky; -The Dog's name is Barky ; -My Horse is Blacky ; -My little pony is White. -], []) - -AT_CLEANUP - - -AT_SETUP([DEFINE OVERRIDE]) -AT_KEYWORDS([CDF directive]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - >>SET CONSTANT DOGGY "Pluto" - >>SET CONSTANT PONY "Piper" - WORKING-STORAGE SECTION. - 01 THEDOG PIC X(6) VALUE DOGGY. - - >>DEFINE DPONY AS PARAMETER OVERRIDE - >>IF DPONY IS NOT DEFINED - >>DEFINE DPONY AS "No Dpony" - >>END-IF - 01 CNSPONY CONSTANT FROM DPONY. - - >>DEFINE ENVPONY AS PARAMETER OVERRIDE - >>IF ENVPONY IS NOT DEFINED - >>DEFINE ENVPONY AS "No EnvPony" - >>END-IF - 01 HORSE CONSTANT FROM ENVPONY. - 77 MYHORSE PIC X(12) VALUE HORSE . - 77 MYPONYENV PIC X(12). - * - PROCEDURE DIVISION. - MAIN. - DISPLAY "ENVPONY" UPON ENVIRONMENT-NAME - ACCEPT MYPONYENV FROM ENVIRONMENT-VALUE. - DISPLAY "ENVPONY env var set to " MYPONYENV ";". - DISPLAY "1st Dog's name is " DOGGY ";". - DISPLAY "2nd Dog's name is " PONY ";". - >>IF ENVPONY IS DEFINED - DISPLAY "ENVPONY is DEFINED as " HORSE ";". - >>ELSE - DISPLAY "ENVPONY was NOT DEFINED;". - >>END-IF - DISPLAY "DPONY set to " CNSPONY ";". - >>IF ENVPONY = "WHITE" - >>DEFINE CONSTANT PONY AS "White Horse" OVERRIDE - >>ELSE - >>DEFINE CONSTANT PONY AS "default Dirty" OVERRIDE - >>END-IF - DISPLAY "My pony is " PONY ";". - >>IF DPONY IS DEFINED - DISPLAY "DPONY is DEFINED as " CNSPONY ";". - >>END-IF - STOP RUN. -]) - -AT_CHECK([ENVPONY=WHITE $COMPILE prog.cob -fdefine-constant-directive=ok -DDPONY=Stallone], [0], [], []) - -AT_CHECK([ENVPONY=WHITE ./prog], [0], -[ENVPONY env var set to WHITE ; -1st Dog's name is Pluto; -2nd Dog's name is Piper; -ENVPONY is DEFINED as WHITE; -DPONY set to Stallone; -My pony is White Horse; -DPONY is DEFINED as Stallone; -], []) - -AT_CLEANUP - - -AT_SETUP([DEFINE Defaults]) -AT_KEYWORDS([CDF directive]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - >>SET CONSTANT DOGGY "Pluto" - >>SET CONSTANT PONY "Piper" - WORKING-STORAGE SECTION. - 01 THEDOG PIC X(6) VALUE DOGGY. - - >>DEFINE DPONY AS PARAMETER OVERRIDE - >>IF DPONY IS NOT DEFINED - >>DEFINE DPONY AS "No Dpony" - >>END-IF - 01 CNSPONY CONSTANT FROM DPONY. - - >>DEFINE ENVPONY AS PARAMETER OVERRIDE - >>IF ENVPONY IS NOT DEFINED - >>DEFINE ENVPONY AS "No EnvPony" - >>END-IF - 01 HORSE CONSTANT FROM ENVPONY. - 77 MYHORSE PIC X(12) VALUE HORSE . - 77 MYPONYENV PIC X(12). - * - PROCEDURE DIVISION. - MAIN. - DISPLAY "ENVPONY" UPON ENVIRONMENT-NAME - ACCEPT MYPONYENV FROM ENVIRONMENT-VALUE. - DISPLAY "ENVPONY env var set to " MYPONYENV ";". - DISPLAY "1st Dog's name is " DOGGY ";". - DISPLAY "2nd Dog's name is " PONY ";". - >>IF ENVPONY IS DEFINED - DISPLAY "ENVPONY is DEFINED as " HORSE ";". - >>ELSE - DISPLAY "ENVPONY was NOT DEFINED;". - >>END-IF - DISPLAY "DPONY set to " CNSPONY ";". - >>IF ENVPONY = "WHITE" - >>DEFINE CONSTANT PONY AS "White Horse" OVERRIDE - >>ELSE - >>DEFINE CONSTANT PONY AS "default Dirty" OVERRIDE - >>END-IF - DISPLAY "My pony is " PONY ";". - >>IF DPONY IS DEFINED - DISPLAY "DPONY is DEFINED as " CNSPONY ";". - >>END-IF - STOP RUN. -]) - -AT_CHECK([$COMPILE prog.cob -fdefine-constant-directive=ok], [0], [], []) - -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], -[ENVPONY env var set to ; -1st Dog's name is Pluto; -2nd Dog's name is Piper; -ENVPONY is DEFINED as No EnvPony; -DPONY set to No Dpony; -My pony is default Dirty; -DPONY is DEFINED as No Dpony; -], []) - -AT_CLEANUP - - -AT_SETUP([78 VALUE]) -AT_KEYWORDS([CONSTANT misc]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 78 DOGGY VALUE "Barky". - 01 MYREC. - 05 FLD1 PIC 9(2). - 05 FLD2 PIC X(7). - 05 FLD3 PIC X(2) OCCURS 5 TIMES. - 05 FLD4 PIC X(4). - 05 FLD5 PIC X(4). - 01 PICX PIC XXX VALUE 'Abc'. - 78 HUN VALUE 10 * (10 + LENGTH OF PICX) + 12.35-2+3. - 78 HUN2 VALUE HUN * (10 + LENGTH OF PICX) -4. - 01 THEDOG PIC X(6) VALUE DOGGY. - 78 DIV1 VALUE 100 / 3. - 78 NUM2 VALUE 1 + 2 * 3. - LINKAGE SECTION. - 01 XMYREC. - 05 XFLD1 PIC 9(2). - 05 XFLD2 PIC X(7). - 78 XPOS3 VALUE NEXT. - 05 XFLD3 PIC X(2) OCCURS 5 TIMES. - 78 XPOS4 VALUE NEXT. - 05 XFLD4 PIC X(4). - 05 XFLD5 PIC X(4). - 78 XSTRT4 VALUE START OF XFLD4. - * - PROCEDURE DIVISION. - MAIN. - DISPLAY "DIV1 is " DIV1. - DISPLAY "HUN is " HUN. - DISPLAY "HUN2 is " HUN2. - MOVE NUM2 TO FLD1 - IF FLD1 = 9 - DISPLAY "NUM2 is " NUM2 " left to right precedence." - ELSE - DISPLAY "NUM2 is " NUM2 " normal precedence." - END-IF. - DISPLAY "XFLD3 starts at " XPOS3. - DISPLAY "XFLD4 starts at " XSTRT4. - DISPLAY "XFLD4 starts at " XPOS4. - DISPLAY "Your Dog's name is " DOGGY ";". - DISPLAY "The Dog's name is " THEDOG ";". - STOP RUN. -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) - -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], -[DIV1 is 33 -HUN is 143 -HUN2 is 1855 -NUM2 is 9 left to right precedence. -XFLD3 starts at 9 -XFLD4 starts at 19 -XFLD4 starts at 11 -Your Dog's name is Barky; -The Dog's name is Barky ; -], []) - -AT_CLEANUP - - -AT_SETUP([01 CONSTANT]) -AT_KEYWORDS([misc]) - -AT_DATA([prog.cob], [ - >>DEFINE MYDOG AS "Piper" - >>DEFINE MYNUM1 AS 11 - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 MYREC. - 05 FLD1 PIC 9(2). - 05 FLD2 PIC X(7). - 05 FLD3 PIC X(2) OCCURS 5 TIMES. - 05 FLD4 PIC X(4). - 05 FLD5 PIC X(4). - 01 PICX PIC XXX VALUE 'Abc'. - 01 CAT CONSTANT 'Cat '. - 01 DOG CONSTANT 'Dog '. - 01 YARD CONSTANT CAT & "& " & DOG. - 78 HUN VALUE 10 * (10 + LENGTH OF PICX) + 12.35-2+3. - 78 HUN2 VALUE HUN * (10 + LENGTH OF PICX) -4. - 78 DIV1 VALUE 100 / 3. - 78 NUM2 VALUE 1 + 2 * 3. - 01 CON3 CONSTANT (((1 + 2) * NUM2) - 4). - 01 CON4 CONSTANT AS 3.1416 + CON3. - 01 CON5 CONSTANT 1 + 2 * 3. - 01 DOGNAME CONSTANT FROM MYDOG. - 01 NUM1 CONSTANT FROM MYNUM1. - 01 CON6 CONSTANT AS CON5 + NUM1. - >> IF NUM2 DEFINED *> optional passed from command line - 01 NUM2 CONSTANT FROM MYNUM2. - >> END-IF - * - PROCEDURE DIVISION. - MAIN. - DISPLAY "CAT is '" CAT "'". - DISPLAY "Yard is '" YARD "'". - DISPLAY "DIV1 is " DIV1. - DISPLAY "HUN is " HUN. - DISPLAY "HUN2 is " HUN2. - MOVE NUM2 TO FLD1 - IF FLD1 = 9 - DISPLAY "78 VALUE has simple left to right precedence." - ELSE - DISPLAY "78 VALUE is " NUM2 " normal precedence." - END-IF. - MOVE CON5 TO FLD1 - IF FLD1 = 7 - DISPLAY "01 CONSTANT has normal operator precedence." - ELSE - DISPLAY "01 CONSTANT is " CON5 " left to right precedence." - END-IF. - DISPLAY "CON3 is " CON3. - DISPLAY "CON4 is " CON4 " vs " 3.141596 - " & " -2.189 " & " +12. - DISPLAY "CON6 is " CON6 "." - DISPLAY "My Dog's name is " DOGNAME ";". - STOP RUN. -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) - -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], -[CAT is 'Cat ' -Yard is 'Cat & Dog ' -DIV1 is 33 -HUN is 143 -HUN2 is 1855 -78 VALUE has simple left to right precedence. -01 CONSTANT has normal operator precedence. -CON3 is 23 -CON4 is 26 vs 3.141596 & -2.189 & +12 -CON6 is 18. -My Dog's name is Piper; -], []) - -AT_CLEANUP - - -AT_SETUP([DISPLAY UPON]) -AT_SKIP_IF(true) -AT_KEYWORDS([CHAINING PRINTER PIPE CONSOLE SYSERR SYSPCH SYSPUNCH -COB_DISPLAY_PRINT_PIPE COB_DISPLAY_PRINT_FILE COB_DISPLAY_PUNCH_FILE]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - CONFIGURATION SECTION. - SPECIAL-NAMES. - PRINTER IS PRINTER. - DATA DIVISION. - WORKING-STORAGE SECTION. - 77 note PIC X(05). - PROCEDURE DIVISION CHAINING note. - DISPLAY "This is sent to CONSOLE " note UPON CONSOLE. - DISPLAY "This is sent to SYSERR " note UPON SYSERR. - DISPLAY "This is sent to PRINTER " note UPON PRINTER. - DISPLAY "This is also sent to CONSOLE " note UPON CONSOLE. - DISPLAY "This is also sent to SYSERR " note UPON SYSERR. - DISPLAY "This is also sent to PRINTER " note UPON PRINTER. - DISPLAY "This is sent to SYSPUNCH " note UPON SYSPUNCH - ON EXCEPTION DISPLAY 'NO ...' UPON SYSERR. - DISPLAY "This is also sent to SYSPUNCH " note UPON SYSPCH - ON EXCEPTION DISPLAY ' ... SYSPUNCH' UPON SYSERR. - STOP RUN RETURNING 0. -]) - -AT_CHECK([$COMPILE -std=ibm prog.cob], [0], [], []) - -AT_CHECK([$COBCRUN_DIRECT ./prog PLAIN], [0], -[This is sent to CONSOLE PLAIN -This is sent to PRINTER PLAIN -This is also sent to CONSOLE PLAIN -This is also sent to PRINTER PLAIN -], -[This is sent to SYSERR PLAIN -This is also sent to SYSERR PLAIN -libcob: prog.cob:18: warning: COB_DISPLAY_PUNCH_FILE is invalid, output to SYSPUNCH skipped -NO ... - ... SYSPUNCH -]) - -AT_CHECK([COB_DISPLAY_PRINT_PIPE='cat >>prt.log' \ -COB_DISPLAY_PUNCH_FILE='punch.out' \ -$COBCRUN_DIRECT ./prog PIPE.], [0], -[This is sent to CONSOLE PIPE. -This is also sent to CONSOLE PIPE. -], -[This is sent to SYSERR PIPE. -This is also sent to SYSERR PIPE. -]) - -AT_CHECK([COB_DISPLAY_PRINT_FILE='prt.log' \ -COB_DISPLAY_PUNCH_FILE='punch.out' \ -$COBCRUN_DIRECT ./prog PRINT], [0], -[This is sent to CONSOLE PRINT -This is also sent to CONSOLE PRINT -], -[This is sent to SYSERR PRINT -This is also sent to SYSERR PRINT -]) - -AT_CAPTURE_FILE(./prt.log) - -AT_DATA([reference], -[This is sent to PRINTER PIPE. -This is also sent to PRINTER PIPE. -This is sent to PRINTER PRINT -This is also sent to PRINTER PRINT -]) - -AT_CHECK([diff reference prt.log], [0], [], [], - -# Previous test "failed" --> check if EOL of PIPE is the issue - -AT_CHECK([sed -e 's/PIPE.\r/PIPE./g' prt.log > prt2.log], [0], [], []) -AT_CHECK([diff reference prt2.log], [0], [], []) -) - -AT_CAPTURE_FILE(./punch.out) - -AT_DATA([reference], -[This is sent to SYSPUNCH PRINT -This is also sent to SYSPUNCH PRINT -]) - -AT_CHECK([diff reference punch.out], [0], [], []) - -AT_CLEANUP - - -AT_SETUP([FLOAT-DECIMAL w/o SIZE ERROR]) -AT_KEYWORDS([Numeric runmisc -FLOAT-DECIMAL-16 FLOAT-DECIMAL-34 -DISPLAY COMPUTE]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 FD16 USAGE FLOAT-DECIMAL-16. - 01 SV16 USAGE FLOAT-DECIMAL-16. - 01 FD34 USAGE FLOAT-DECIMAL-34. - 01 SV34 USAGE FLOAT-DECIMAL-34. - - PROCEDURE DIVISION. - CND-000. - DISPLAY "--- FLOAT-DECIMAL-34 ---" - COMPUTE FD34 = (((1.0E7 / 2.1E0) / 3.1E0) - 5.0E-1) * 6.0E0 - DISPLAY "A: " FD34 - - COMPUTE FD34 = (((1.0E7 / 2.9E0) / 3.9E0) - 5.0E-1) * 6.0E0 - DISPLAY "B: " FD34 - MOVE ZERO TO FD34. - COMPUTE FD34 = 1.0E3 / 2.1E0 - ON SIZE ERROR DISPLAY "Z: " FD34 " SIZE ERROR" - NOT ON SIZE ERROR DISPLAY "Z: " FD34 " IS OK" - END-COMPUTE. - - DISPLAY " ..." - DISPLAY "--- FLOAT-DECIMAL-16 ---" - COMPUTE FD16 = (((1.0E7 / 2.1E0) / 3.1E0) - 5.0E-1) * 6.0E0 - DISPLAY "A: " FD16 - - COMPUTE FD16 = (((1.0E7 / 2.9E0) / 3.9E0) - 5.0E-1) * 6.0E0 - DISPLAY "B: " FD16 - MOVE ZERO TO FD16. - COMPUTE FD16 = 1.0E3 / 2.1E0 - ON SIZE ERROR DISPLAY "Z: " FD16 " SIZE ERROR" - NOT ON SIZE ERROR DISPLAY "Z: " FD16 " IS OK" - END-COMPUTE. - - DISPLAY " ..." - DISPLAY "--- 99 + 1 / 3 ---" - MOVE -1 TO FD16, FD34. - COMPUTE FD34 = 99 + 1 / 3 - ON SIZE ERROR DISPLAY "FD34: " FD34 " SIZE ERROR" - NOT ON SIZE ERROR DISPLAY "FD34: " FD34 " IS OK" - END-COMPUTE. - COMPUTE FD16 = 99 + 1 / 3 - ON SIZE ERROR DISPLAY "FD16: " FD16 " SIZE ERROR" - NOT ON SIZE ERROR DISPLAY "FD16: " FD16 " IS OK" - END-COMPUTE. - - DISPLAY " ..." - DISPLAY "--- 99 ---" - MOVE -1 TO FD16, FD34. - COMPUTE FD34 = 99 - ON SIZE ERROR DISPLAY "FD34: " FD34 " SIZE ERROR" - NOT ON SIZE ERROR DISPLAY "FD34: " FD34 " IS OK" - END-COMPUTE. - COMPUTE FD16 = 99 - ON SIZE ERROR DISPLAY "FD16: " FD16 " SIZE ERROR" - NOT ON SIZE ERROR DISPLAY "FD16: " FD16 " IS OK" - END-COMPUTE. - - CND-100-OK. - DISPLAY " ..." - DISPLAY "--- Test overflow ---" - MOVE 9900000000000 TO FD16, FD34. - PERFORM 390 TIMES - MOVE FD16 TO SV16 - COMPUTE FD16 = FD16 * 10 - ON SIZE ERROR GO TO CND-100-ERR - END-COMPUTE - IF FD16 < 9.0 - DISPLAY "FD16: " FD16 " IS Wrong" - GO TO CND-100-ERR - END-IF - END-PERFORM. - DISPLAY "FD16: " FD16 " IS OK". - GO TO CND-200-OK. - CND-100-ERR. - DISPLAY "FD16: after " SV16 " SIZE ERROR". - - CND-200-OK. - MOVE 9900000000000 TO FD16, FD34. - PERFORM 6500 TIMES - MOVE FD34 TO SV34 - COMPUTE FD34 = FD34 * 10 - ON SIZE ERROR GO TO CND-200-ERR - END-COMPUTE - IF FD34 < 9.0 - GO TO CND-200-ERR - END-IF - END-PERFORM. - DISPLAY "FD34: " FD34 " IS OK". - GO TO CND-380-OK. - CND-200-ERR. - DISPLAY "FD34: after " SV34 " SIZE ERROR". - - CND-380-OK. - DISPLAY " ..." - DISPLAY "--- Test underflow ---" - MOVE 0.000000099 TO FD16, FD34. - PERFORM 400 TIMES - MOVE FD16 TO SV16 - COMPUTE FD16 = FD16 / 10 - ON SIZE ERROR GO TO CND-300-ERR - END-COMPUTE - IF FD16 = 0.0 - GO TO CND-300-ERR - END-IF - END-PERFORM. - DISPLAY "FD16: " FD16 " IS OK". - GO TO CND-400-OK. - CND-300-ERR. - DISPLAY "FD16: after " SV16 " SIZE ERROR". - - CND-400-OK. - MOVE 0.000000099 TO FD16, FD34. - PERFORM 6600 TIMES - MOVE FD34 TO SV34 - COMPUTE FD34 = FD34 / 10.0 - ON SIZE ERROR GO TO CND-400-ERR - END-COMPUTE - IF FD34 = 0.0 - GO TO CND-400-ERR - END-IF - END-PERFORM. - DISPLAY "FD34: " FD34 " IS OK". - GO TO CND-999. - CND-400-ERR. - DISPLAY "FD34: after " SV34 " SIZE ERROR". - - CND-999. - STOP RUN. - END PROGRAM prog. -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) - -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], -[--- FLOAT-DECIMAL-34 --- -A: 9216586.861751152073732718894009216 -B: 5305036.78779840848806366047745358 -Z: 476.1904761904761904761904761904761 IS OK - ... ---- FLOAT-DECIMAL-16 --- -A: 9216586.861751152 -B: 5305036.787798408 -Z: 476.1904761904761 IS OK - ... ---- 99 + 1 / 3 --- -FD34: 99.33333333333333333333333333333333 IS OK -FD16: 99.33333333333333 IS OK - ... ---- 99 --- -FD34: 99 IS OK -FD16: 99 IS OK - ... ---- Test overflow --- -FD16: after 99E369 SIZE ERROR -FD34: after 99E6111 SIZE ERROR - ... ---- Test underflow --- -FD16: after 99E-398 SIZE ERROR -FD34: after 99E-6176 SIZE ERROR -], []) - -AT_CLEANUP - - -AT_SETUP([FLOAT-SHORT / FLOAT-LONG w/o SIZE ERROR]) -AT_KEYWORDS([Numeric runmisc -COMP-1 COMP-2 -DISPLAY COMPUTE]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 CMP1 COMP-1. - 01 SV1 COMP-1. - 01 CMP2 COMP-2. - 01 SV2 COMP-2. - - PROCEDURE DIVISION. - CND-000. - - DISPLAY "--- COMP-1 ---" - COMPUTE CMP1 = (((1.0E7 / 2.1E0) / 3.1E0) - 5.0E-1) * 6.0E0 - DISPLAY "A: " CMP1 - COMPUTE CMP1 = (((1.0E7 / 2.9E0) / 3.9E0) - 5.0E-1) * 6.0E0 - DISPLAY "B: " CMP1 - MOVE ZERO TO CMP1. - COMPUTE CMP1 = 1.0E3 / 2.1E0 - ON SIZE ERROR DISPLAY "Z: " CMP1 " SIZE ERROR" - NOT ON SIZE ERROR DISPLAY "Z: " CMP1 " IS OK" - END-COMPUTE. - - DISPLAY " ..." - DISPLAY "--- COMP-2 ---" - COMPUTE CMP2 = (((1.0E7 / 2.1E0) / 3.1E0) - 5.0E-1) * 6.0E0 - *> because of possible rounding of intermediates and different - *> precision depending on math library / version: plain DISPLAY - IF CMP2 >= 9216586.86175114 AND <= 9216586.86175116 - DISPLAY "A ~ 9216586.86175115" - ELSE - DISPLAY "A: " CMP2 - END-IF - COMPUTE CMP2 = (((1.0E7 / 2.9E0) / 3.9E0) - 5.0E-1) * 6.0E0 - IF CMP2 >= 5305036.7877983 AND <= 5305036.7877985 - DISPLAY "B ~ 5305036.787798408" - ELSE - DISPLAY "B: " CMP2 - END-IF - MOVE ZERO TO CMP2. - COMPUTE CMP2 = 1.0E3 / 2.1E0 - ON SIZE ERROR DISPLAY "Z: " CMP2 " SIZE ERROR" - NOT ON SIZE ERROR - *> see note above - IF CMP2 >= 476.1904761904760 AND <= 476.1904761904763 - DISPLAY "Z ~ 476.1904761904761 IS OK" - ELSE - DISPLAY "Z: " CMP2 " IS OK" - END-IF - END-COMPUTE. - - DISPLAY " ..." - DISPLAY "--- 99 + 1 / 3 ---" - MOVE -1 TO CMP1, CMP2. - COMPUTE CMP1 = 99 + 1 / 3 - ON SIZE ERROR DISPLAY "CMP1: " CMP1 " SIZE ERROR" - NOT ON SIZE ERROR DISPLAY "CMP1: " CMP1 " IS OK" - END-COMPUTE. - COMPUTE CMP2 = 99 + 1 / 3 - ON SIZE ERROR DISPLAY "CMP2: " CMP2 " SIZE ERROR" - NOT ON SIZE ERROR DISPLAY "CMP2: " CMP2 " IS OK" - END-COMPUTE. - - DISPLAY " ..." - DISPLAY "--- 99 ---" - MOVE -1 TO CMP1, CMP2. - COMPUTE CMP1 = 99 - ON SIZE ERROR DISPLAY "CMP1: " CMP1 " SIZE ERROR" - NOT ON SIZE ERROR DISPLAY "CMP1: " CMP1 " IS OK" - END-COMPUTE. - COMPUTE CMP2 = 99 - ON SIZE ERROR DISPLAY "CMP2: " CMP2 " SIZE ERROR" - NOT ON SIZE ERROR DISPLAY "CMP2: " CMP2 " IS OK" - END-COMPUTE. - - CND-100-OK. - DISPLAY " ..." - DISPLAY "--- Test overflow ---" - - MOVE 990000 TO CMP1. - PERFORM 6500 TIMES - MOVE CMP1 TO SV1 - COMPUTE CMP1 = CMP1 * 10 - ON SIZE ERROR GO TO CND-350-ERR - END-COMPUTE - IF CMP1 < 9.0 - GO TO CND-350-ERR - END-IF - END-PERFORM. - DISPLAY "CMP1: " CMP1 " IS OK". - GO TO CND-350-OK. - CND-350-ERR. - DISPLAY "CMP1: after " SV1 " SIZE ERROR". - - CND-350-OK. - MOVE 9900000000 TO CMP2. - PERFORM 6500 TIMES - MOVE CMP2 TO SV2 - COMPUTE CMP2 = CMP2 * 10 - ON SIZE ERROR GO TO CND-380-ERR - END-COMPUTE - IF CMP2 < 9.0 - GO TO CND-380-ERR - END-IF - END-PERFORM. - DISPLAY "CMP2: " CMP2 " IS OK". - GO TO CND-500-OK. - CND-380-ERR. - *> because of possible rounding of intermediates and different - *> precision depending on math library / version: plain DISPLAY - IF SV2 >= 9.899999999999E+307 AND - <= 9.900000000001E+307 - DISPLAY "CMP2: after ~ 9.899999999999781E+307 SIZE ERROR" - ELSE - DISPLAY "CMP2: after " SV2 " SIZE ERROR" - END-IF - . - - CND-500-OK. - MOVE 0.000000099 TO CMP1. - PERFORM 350 TIMES - MOVE CMP1 TO SV1 - COMPUTE CMP1 = CMP1 / 10.0 - ON SIZE ERROR GO TO CND-500-ERR - END-COMPUTE - IF CMP1 = 0.0 - GO TO CND-500-ERR - END-IF - END-PERFORM. - DISPLAY "CMP1: " CMP1 " IS OK". - GO TO CND-600-OK. - CND-500-ERR. - DISPLAY "CMP1: after " SV1 " SIZE ERROR". - - CND-600-OK. - MOVE 0.000000099 TO CMP2. - PERFORM 350 TIMES - MOVE CMP2 TO SV2 - COMPUTE CMP2 = CMP2 / 10.0 - ON SIZE ERROR GO TO CND-600-ERR - END-COMPUTE - IF CMP2 = 0.0 - GO TO CND-600-ERR - END-IF - END-PERFORM. - DISPLAY "CMP2: " CMP2 " IS OK". - GO TO CND-600-XIT. - CND-600-ERR. - IF SV2 >= 9.8813129168249E-324 AND <= 9.881312916825E-324 - DISPLAY "CMP2: after ~ 9.881312916824931E-324 SIZE ERROR" - ELSE - DISPLAY "CMP2: after " SV2 " SIZE ERROR" - END-IF - . - CND-600-XIT. - - CND-999. - STOP RUN. - END PROGRAM prog. -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) - -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], -[--- COMP-1 --- -A: 9216587 -B: 5305037 -Z: 476.19049 IS OK - ... ---- COMP-2 --- -A ~ 9216586.86175115 -B ~ 5305036.787798408 -Z ~ 476.1904761904761 IS OK - ... ---- 99 + 1 / 3 --- -CMP1: 99.333336 IS OK -CMP2: 99.33333333333333 IS OK - ... ---- 99 --- -CMP1: 99 IS OK -CMP2: 99 IS OK - ... ---- Test overflow --- -CMP1: after 9.8999983E+37 SIZE ERROR -CMP2: after ~ 9.899999999999781E+307 SIZE ERROR -CMP1: after 1.4012985E-45 SIZE ERROR -CMP2: after ~ 9.881312916824931E-324 SIZE ERROR -], []) - -AT_CLEANUP - - -AT_SETUP([FLOAT-SHORT with SIZE ERROR]) -AT_KEYWORDS([COMP-1]) - -AT_DATA([prog.cob], [ - identification division. - program-id. prog. - - data division. - working-storage section. - *------------------------ - 77 counter pic s9(4) binary value zero. - * FLOAT-SHORT (if binary-comp-1 is not active) - 77 floatValue COMP-1 value 2. - 77 lastFloatValue COMP-1. - - ****************************************************************** - procedure division. - main section. - perform varying counter from 1 by 1 until - counter > 130 - *> display 'counter: ' counter ', value: ' floatValue - compute floatValue = floatValue * 2 - ON SIZE ERROR - display 'SIZE ERROR, last value = ' floatValue - exit perform - not ON SIZE ERROR - if floatValue > lastFloatValue - move floatValue to lastFloatValue - else - display 'math ERROR, last value > current: ' - lastFloatValue ' > ' floatValue - exit perform - end-if - end-compute - end-perform - if counter not = 127 - display 'counter is ' counter - end-if - - goback. -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) - -AT_CHECK([./prog], [0], -[SIZE ERROR, last value = 1.7014118E+38 -], []) - -AT_CLEANUP - - -AT_SETUP([FLOAT-LONG with SIZE ERROR]) -AT_KEYWORDS([COMP-2]) - -AT_DATA([prog.cob], [ - identification division. - program-id. prog. - - data division. - working-storage section. - *------------------------ - 77 counter pic s9(4) binary value zero. - * FLOAT-LONG - 77 doubleValue COMP-2 value 2. - 77 lastDoubleValue COMP-2. - - ****************************************************************** - procedure division. - main section. - perform varying counter from 1 by 1 until - counter > 1060 - *> display 'counter: ' counter ', value: ' doubleValue - compute doubleValue = doubleValue * 2 - ON SIZE ERROR - display 'SIZE ERROR raised' - with no advancing upon syserr - end-display - display 'SIZE ERROR, last value = ' doubleValue - upon sysout - end-display - exit perform - not ON SIZE ERROR - if doubleValue > lastdoubleValue - move doubleValue to lastdoubleValue - else - display 'math ERROR, last value > current: ' - lastdoubleValue ' > ' doubleValue - upon syserr - end-display - exit perform - end-if - end-compute - end-perform - if not (counter >= 1023 and <=1025) - display ' ' upon syserr - display 'counter is ' counter upon syserr - end-if - - goback. -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -# note: the actual value is not checked as this depends on intermediate rounding -AT_CHECK([./prog], [0], ignore, [SIZE ERROR raised]) - -AT_CLEANUP - - -AT_SETUP([EC-SIZE-ZERO-DIVIDE]) -AT_KEYWORDS([misc fundamental exceptions -DIVIDE COMPUTE EXCEPTION-STATUS]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 x PIC 9 VALUE 0. - 01 y PIC 9 VALUE 0. - - PROCEDURE DIVISION. - DIVIDE x BY y GIVING y - ON SIZE ERROR CONTINUE END-DIVIDE - IF FUNCTION TRIM(FUNCTION EXCEPTION-STATUS) - NOT = 'EC-SIZE-ZERO-DIVIDE' - DISPLAY 'Wrong/missing exception: ' - FUNCTION EXCEPTION-STATUS - END-DISPLAY - END-IF - SET LAST EXCEPTION TO OFF - IF FUNCTION EXCEPTION-STATUS NOT = SPACES - DISPLAY 'Exception is not empty after reset: ' - FUNCTION EXCEPTION-STATUS - END-DISPLAY - END-IF - MOVE 0 TO y - COMPUTE y = x - 1 / y + 6.5 - ON SIZE ERROR CONTINUE END-COMPUTE - IF FUNCTION TRIM(FUNCTION EXCEPTION-STATUS) - NOT = 'EC-SIZE-ZERO-DIVIDE' - DISPLAY 'Wrong/missing exception: ' - FUNCTION EXCEPTION-STATUS - END-DISPLAY - END-IF - . -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [], []) -AT_CLEANUP - - -AT_SETUP([EC-SIZE-OVERFLOW]) -AT_KEYWORDS([misc fundamental exceptions]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 x PIC 9 VALUE 1. - 01 y PIC 9. - - PROCEDURE DIVISION. - * raise exception checked in previous test - * as it may interfere with the expected exception - DIVIDE x BY y GIVING y - ON SIZE ERROR CONTINUE END-DIVIDE - DIVIDE x BY 0.1 GIVING y - ON SIZE ERROR CONTINUE END-DIVIDE - IF FUNCTION TRIM(FUNCTION EXCEPTION-STATUS) - NOT = 'EC-SIZE-OVERFLOW' - DISPLAY 'Wrong/missing exception: ' - FUNCTION EXCEPTION-STATUS - END-DISPLAY - END-IF - . -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [], []) -AT_CLEANUP - - -AT_SETUP([Constant Expressions]) -AT_KEYWORDS([runmisc condition expression]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 VAR PIC X(200). - 01 OTHERVAR PIC X(115). - 78 VAR-LEN VALUE 115. - - PROCEDURE DIVISION. - MAIN-10. - MOVE "Peek a boo" TO VAR. - EVALUATE TRUE - ALSO FALSE - ALSO TRUE - WHEN TRUE - ALSO VAR-LEN > 16 AND VAR-LEN < 200 - ALSO TRUE - MOVE OTHERVAR (1 : VAR-LEN - 9) - TO VAR (16 - VAR-LEN : VAR-LEN - 9) - DISPLAY "A: Should NOT be executed" - WHEN TRUE - ALSO VAR-LEN < 16 - ALSO TRUE - MOVE OTHERVAR TO VAR - DISPLAY "A: OK VAR-LEN > 16 AND VAR-LEN < 200" - WHEN TRUE - ALSO VAR = SPACES - ALSO TRUE - MOVE OTHERVAR TO VAR - DISPLAY "A: OK VAR IS SPACES" - END-EVALUATE. - - MOVE "Peek a boo" TO VAR. - EVALUATE 3 EQUALS 7 - WHEN VAR = SPACES - DISPLAY "B: OK VAR IS NOT SPACES" - WHEN VAR NOT = SPACES - DISPLAY "B: FALSE VAR IS SPACES" - END-EVALUATE. - - MOVE SPACES TO VAR. - EVALUATE FALSE - WHEN VAR = SPACES - DISPLAY "C: FALSE VAR IS SPACES" - WHEN VAR NOT = SPACES - DISPLAY "C: OK VAR IS SPACES" - END-EVALUATE. - - MOVE "Peek a boo" TO VAR. - EVALUATE TRUE - WHEN VAR = SPACES - DISPLAY "D: BAD VAR IS SPACES" - WHEN VAR NOT = SPACES - DISPLAY "D: OK VAR IS NOT SPACES" - END-EVALUATE. - - MOVE SPACES TO VAR. - EVALUATE VAR-LEN ALSO VAR - WHEN < 32 ALSO SPACES - DISPLAY "E: OK VAR IS SPACES" - WHEN > 16 ALSO NOT SPACES - DISPLAY "E: BAD VAR IS NOT SPACES" - WHEN OTHER - DISPLAY "E: OK OTHER option taken" - END-EVALUATE. - - STOP RUN. -]) - -AT_CHECK([$COMPILE prog.cob -w], [0], [], -[prog.cob: in paragraph 'MAIN-10': -prog.cob:20: error (ignored): offset must be greater than zero -]) - -AT_CHECK([./prog], [0], -[A: OK VAR-LEN > 16 AND VAR-LEN < 200 -B: OK VAR IS NOT SPACES -C: OK VAR IS SPACES -D: OK VAR IS NOT SPACES -E: OK OTHER option taken -], []) - -AT_CLEANUP - - -AT_SETUP([ENTRY FOR GO TO / GO TO ENTRY]) -AT_KEYWORDS([runmisc condition expression]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 JUMP-ENTRY PIC 9 VALUE 6. - 88 EXT-MODUS VALUES 3, 4. - LINKAGE SECTION. - PROCEDURE DIVISION. - GO TO ENTRY 'STMT05'. - MAIN. - GO TO ENTRY 'STMT01' - 'STMT02' - 'STMT03' - 'STMT04' - 'STMT05' - DEPENDING ON JUMP-ENTRY - DISPLAY 'NOT JUMPED' - GOBACK. - ENTRY FOR GO TO 'STMT01' - DISPLAY 'STMT01' - ENTRY FOR GO TO 'STMT02' - PERFORM 3 TIMES - ENTRY FOR GO TO 'STMT03' - DISPLAY 'STMT03' - ENTRY FOR GO TO 'STMT04' DISPLAY 'STMT04' - IF EXT-MODUS EXIT PERFORM END-IF - END-PERFORM - ENTRY FOR GO TO 'STMT05' - DISPLAY 'STMT05' - SUBTRACT 1 FROM JUMP-ENTRY - GO TO MAIN. - -]) - -# TODO: move to syntax checks, together with all expected error messages -AT_CHECK([$COMPILE -std=mf-strict prog.cob], [1], [], -[prog.cob:10: error: ENTRY FOR GO TO does not conform to Micro Focus COBOL -prog.cob: in paragraph 'MAIN': -prog.cob:18: error: ENTRY FOR GO TO does not conform to Micro Focus COBOL -prog.cob:20: error: ENTRY FOR GO TO does not conform to Micro Focus COBOL -prog.cob:22: error: ENTRY FOR GO TO does not conform to Micro Focus COBOL -prog.cob:24: error: ENTRY FOR GO TO does not conform to Micro Focus COBOL -prog.cob:26: error: ENTRY FOR GO TO does not conform to Micro Focus COBOL -prog.cob:29: error: ENTRY FOR GO TO does not conform to Micro Focus COBOL -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], -[prog.cob:10: warning: ENTRY FOR GO TO used -prog.cob: in paragraph 'MAIN': -prog.cob:18: warning: ENTRY FOR GO TO used -prog.cob:20: warning: ENTRY FOR GO TO used -prog.cob:22: warning: ENTRY FOR GO TO used -prog.cob:24: warning: ENTRY FOR GO TO used -prog.cob:26: warning: ENTRY FOR GO TO used -prog.cob:29: warning: ENTRY FOR GO TO used -]) - -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], -[STMT05 -STMT05 -STMT04 -STMT05 -STMT03 -STMT04 -STMT05 -STMT03 -STMT04 -STMT03 -STMT04 -STMT03 -STMT04 -STMT05 -STMT01 -STMT03 -STMT04 -STMT03 -STMT04 -STMT03 -STMT04 -STMT05 -NOT JUMPED -], []) - -AT_CLEANUP - - -AT_SETUP([PERFORM VARYING Float]) -AT_KEYWORDS([Perform]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 i USAGE FLOAT-LONG. - - PROCEDURE DIVISION. - PERFORM VARYING i FROM 1.0 BY 1.0 UNTIL i > 5.0 - DISPLAY i " " NO ADVANCING - END-PERFORM . - DISPLAY "Test Part 1 Completed". - PERFORM VARYING i FROM 1 BY 1 UNTIL i > 5 - DISPLAY i " " NO ADVANCING - END-PERFORM . - DISPLAY "Test Part 2 Completed". - PERFORM VARYING i FROM 5 BY -1 UNTIL i < 1 - DISPLAY i " " NO ADVANCING - END-PERFORM . - DISPLAY "Test Part 3 Completed". - STOP RUN. - END PROGRAM prog. -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) - -AT_CHECK([./prog], [0], [1 2 3 4 5 Test Part 1 Completed -1 2 3 4 5 Test Part 2 Completed -5 4 3 2 1 Test Part 3 Completed -], []) - -AT_CLEANUP - - -AT_SETUP([Test PICTURE with Edit mask]) -AT_KEYWORDS([Numeric]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 TST. - 05 DEPT-SUB PIC 9(7)V999 VALUE 18536.232. - 05 DEPT-COST-YTD PIC 9(5)V999 VALUE 18536.232. - 05 DL-PROD-COST PIC $$$,$$9.99. - 77 WFLT PIC $$$,$$9.99. - - PROCEDURE DIVISION. - MOVE 18536.23 TO WFLT. - DISPLAY "WFLT IS " WFLT. - MULTIPLY DEPT-COST-YTD BY 1 GIVING DL-PROD-COST ROUNDED. - DISPLAY "COST IS " DL-PROD-COST. - STOP RUN. -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) - -AT_CHECK([./prog], [0], [WFLT IS $18,536.23 -COST IS $18,536.23 -], []) - -AT_CLEANUP - - -AT_SETUP([COMP-3 Index]) -AT_KEYWORDS([numeric]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 WS-PAGE-NUMBER PIC 9(4) COMP-3 VALUE ZERO. - 01 WS-LINE-NUMBER PIC 9(3) VALUE ZERO. - PROCEDURE DIVISION. - PERFORM VARYING WS-LINE-NUMBER FROM 1 BY 1 - UNTIL WS-LINE-NUMBER > 10 - ADD 1 TO WS-PAGE-NUMBER - DISPLAY WS-PAGE-NUMBER - END-PERFORM. - STOP RUN RETURNING 0. -]) - -AT_CHECK([cobc -x -std=mf -w prog.cob], [0], [], []) - -AT_CHECK([./prog], [0], [0001 -0002 -0003 -0004 -0005 -0006 -0007 -0008 -0009 -0010 -], []) - -AT_CLEANUP - - -AT_SETUP([POINTER]) -AT_KEYWORDS([numeric]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 XX. - 02 XX-1 PIC X(4) VALUE "1234". - 02 XX-2 PIC X(4) VALUE "5678". - 01 P-XX-1 POINTER. - 01 P-XX-2 POINTER. - LINKAGE SECTION. - 01 Y2 PIC X(4). - PROCEDURE DIVISION. - SET P-XX-1 TO ADDRESS OF XX-1 - SET P-XX-2 TO ADDRESS OF XX-2 - SET ADDRESS OF Y2 TO ADDRESS OF XX-1 - SET ADDRESS OF Y2 UP BY 4 - IF Y2 NOT = XX-2 - DISPLAY "Test 2 '" Y2 "'" - END-DISPLAY - END-IF - IF ADDRESS OF Y2 NOT= P-XX-2 - DISPLAY "Pointer test failed" - ELSE - DISPLAY "Pointer test was good" - END-IF - STOP RUN. -]) - -AT_CHECK([cobc -x -std=mf -w prog.cob], [0], [], []) - -AT_CHECK([./prog], [0], [Pointer test was good -], []) - -AT_CLEANUP - -AT_SETUP([Figurative constants to numeric field]) -AT_KEYWORDS([Numeric]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 NUM9 PIC 9(6). - PROCEDURE DIVISION. - MOVE SPACES TO NUM9 - DISPLAY "NUM9 value SPACES is " NUM9 "." UPON SYSOUT - MOVE LOW-VALUES TO NUM9 - IF NUM9 = LOW-VALUES - DISPLAY "9(6) tests OK for LOW-VALUES" UPON SYSOUT - ELSE - DISPLAY "9(6) Does NOT test OK for LOW-VALUES" - UPON SYSOUT - IF NUM9 = ZERO - DISPLAY "9(6) tests as ZERO instead of LOW-VALUES" - UPON SYSOUT - END-IF - END-IF. - MOVE HIGH-VALUES TO NUM9 - IF NUM9 = HIGH-VALUES - DISPLAY "9(6) tests OK for HIGH-VALUES" UPON SYSOUT - ELSE - DISPLAY "9(6) Does NOT test OK for HIGH-VALUES" - UPON SYSOUT - IF NUM9 = ZERO - DISPLAY "9(6) tests as ZERO instead of HIGH-VALUES" - UPON SYSOUT - END-IF - END-IF. - STOP RUN. -]) - -AT_CHECK([$COMPILE -std=mf prog.cob], [0], [], -[prog.cob:8: warning: source is non-numeric - substituting zero -prog.cob:10: warning: source is non-numeric - substituting zero -prog.cob:21: warning: source is non-numeric - substituting zero -]) - -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], -[NUM9 value SPACES is 000000. -9(6) Does NOT test OK for LOW-VALUES -9(6) tests as ZERO instead of LOW-VALUES -9(6) Does NOT test OK for HIGH-VALUES -9(6) tests as ZERO instead of HIGH-VALUES -], []) - -AT_CHECK([$COMPILE -std=acu prog.cob -o aprog], [0], [], []) - -AT_CHECK([$COBCRUN_DIRECT ./aprog], [0], -[NUM9 value SPACES is . -9(6) tests OK for LOW-VALUES -9(6) tests OK for HIGH-VALUES -], []) - -AT_CLEANUP - - -# Checks both -ftrace(all), which needs to be manually set -# and -fsource-location, which is implied by -debug/g -AT_SETUP([READY TRACE / RESET TRACE]) -AT_KEYWORDS([runmisc -ftrace -ftraceall -fsource-location -CALL RECURSIVE RETURN-CODE -COB_PHYSICAL_CANCEL COB_PRE_LOAD]) - -AT_DATA([caller.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. caller. - * - PROCEDURE DIVISION. - READY TRACE - MOVE 1 TO RETURN-CODE - RESET TRACE - CALL "callee1" - END-CALL - READY TRACE - MOVE 2 TO RETURN-CODE - CALL "callee1" - END-CALL - CALL "callee1" - CANCEL "callee1" - CALL "callrec" - MOVE 0 TO RETURN-CODE - STOP RUN. -]) - -AT_DATA([callee1.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. callee1. - PROCEDURE DIVISION. - ADD 1 TO RETURN-CODE - NOT ON SIZE ERROR - IF RETURN-CODE = 1 - CONTINUE - ELSE IF RETURN-CODE = 2 - CONTINUE - ELSE - CONTINUE - . - EVALUATE RETURN-CODE - WHEN 1 - CONTINUE - WHEN 2 - WHEN 3 - CONTINUE - WHEN OTHER - CONTINUE - END-EVALUATE - EVALUATE TRUE - WHEN RETURN-CODE = 1 - CONTINUE - WHEN RETURN-CODE = 2 - WHEN RETURN-CODE = 3 - CONTINUE - WHEN OTHER - CONTINUE - END-EVALUATE - CALL "callee2" END-CALL - CANCEL "callee2" CALL "callee2b" END-CALL CANCEL "callee2b" - SUBTRACT 1 FROM RETURN-CODE END-SUBTRACT - EXIT PROGRAM. -]) - -AT_DATA([callee2.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. callee2. - PROCEDURE DIVISION. - COMPUTE RETURN-CODE - = 1 + 1 - ON SIZE ERROR - MOVE -1 TO RETURN-CODE - NOT ON SIZE ERROR - COMPUTE RETURN-CODE - = 1 + 1 - END-COMPUTE - END-COMPUTE. - CALL "callee2c" END-CALL - CANCEL "callee2c" - MOVE 0 TO RETURN-CODE. - EXIT PROGRAM. -]) - -AT_DATA([preload.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. callee2b. - PROCEDURE DIVISION. - SOME-SEC SECTION. - SOME-PAR. - PERFORM OTHER-SEC - MOVE 0 TO RETURN-CODE. - ENTRY "LEAVE-ME". - END-PAR. - EXIT PROGRAM. - OTHER-SEC SECTION. - COMPUTE RETURN-CODE = 1 + 2 END-COMPUTE. - EX. EXIT. -]) - -AT_DATA([preload2.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. callrec IS RECURSIVE. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 filler PIC 9 VALUE 0. - 88 first-call VALUE 0. - 88 called VALUE 1. - PROCEDURE DIVISION. - SOME-SEC SECTION. - IF first-call - SET called TO TRUE - CALL 'callrec' - END-IF - GOBACK. -]) - -AT_DATA([callee2c.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. callee2c. - PROCEDURE DIVISION. - SOME-SEC SECTION. - SOME-PAR. - PERFORM OTHER-SEC - MOVE 0 TO RETURN-CODE. - END-PAR. - EXIT PROGRAM. - OTHER-SEC SECTION. - COMPUTE RETURN-CODE = 1 + 2 END-COMPUTE. - EX. EXIT. -]) - -AT_CHECK([$COBC -ftraceall callee1.cob], [0], [], []) -AT_CHECK([$COBC callee2.cob], [0], [], []) -AT_CHECK([$COBC -ftrace preload.cob], [0], [], []) -AT_CHECK([$COBC -ftraceall preload2.cob], [0], [], []) -AT_CHECK([$COBC -fsource-location callee2c.cob], [0], [], []) -AT_CHECK([$COBC -x -o prog -ftraceall caller.cob], [0], [], []) -AT_CHECK([COB_PHYSICAL_CANCEL=1 COB_PRE_LOAD="preload"$PATHSEP"preload2" $COBCRUN_DIRECT ./prog], [0], [], -[Source: 'caller.cob' -Program-Id: caller -Program-Id: caller MOVE Line: 7 -Program-Id: caller RESET TRACE Line: 8 -Program-Id: caller MOVE Line: 12 -Program-Id: caller CALL Line: 13 -Source: 'callee1.cob' -Program-Id: callee1 -Program-Id: callee1 Entry: callee1 Line: 4 -Program-Id: callee1 ADD Line: 5 -Program-Id: callee1 IF Line: 7 -Program-Id: callee1 IF Line: 9 -Program-Id: callee1 CONTINUE Line: 12 -Program-Id: callee1 EVALUATE Line: 14 -Program-Id: callee1 WHEN Line: 15 -Program-Id: callee1 CONTINUE Line: 21 -Program-Id: callee1 EVALUATE Line: 23 -Program-Id: callee1 WHEN Line: 24 -Program-Id: callee1 WHEN Line: 27 -Program-Id: callee1 CONTINUE Line: 30 -Program-Id: callee1 CALL Line: 32 -Program-Id: callee1 CANCEL Line: 33 -Program-Id: callee1 CALL Line: 33 -Source: 'preload.cob' -Program-Id: callee2b -Program-Id: callee2b Entry: callee2b Line: 4 -Program-Id: callee2b Section: SOME-SEC Line: 5 -Program-Id: callee2b Paragraph: SOME-PAR Line: 6 -Program-Id: callee2b Section: OTHER-SEC Line: 12 -Program-Id: callee2b Paragraph: EX Line: 14 -Program-Id: callee2b Entry: LEAVE-ME Line: 14 -Program-Id: callee2b Paragraph: END-PAR Line: 10 -Program-Id: callee2b Exit: callee2b Line: 10 -Source: 'callee1.cob' -Program-Id: callee1 -Program-Id: callee1 CANCEL Line: 33 -Program-Id: callee1 SUBTRACT Line: 34 -Program-Id: callee1 EXIT PROGRAM Line: 35 -Program-Id: callee1 Exit: callee1 Line: 35 -Source: 'caller.cob' -Program-Id: caller -Program-Id: caller CALL Line: 15 -Source: 'callee1.cob' -Program-Id: callee1 -Program-Id: callee1 Entry: callee1 Line: 4 -Program-Id: callee1 ADD Line: 5 -Program-Id: callee1 IF Line: 7 -Program-Id: callee1 IF Line: 9 -Program-Id: callee1 CONTINUE Line: 12 -Program-Id: callee1 EVALUATE Line: 14 -Program-Id: callee1 WHEN Line: 15 -Program-Id: callee1 CONTINUE Line: 21 -Program-Id: callee1 EVALUATE Line: 23 -Program-Id: callee1 WHEN Line: 24 -Program-Id: callee1 WHEN Line: 27 -Program-Id: callee1 CONTINUE Line: 30 -Program-Id: callee1 CALL Line: 32 -Program-Id: callee1 CANCEL Line: 33 -Program-Id: callee1 CALL Line: 33 -Source: 'preload.cob' -Program-Id: callee2b -Program-Id: callee2b Entry: callee2b Line: 4 -Program-Id: callee2b Section: SOME-SEC Line: 5 -Program-Id: callee2b Paragraph: SOME-PAR Line: 6 -Program-Id: callee2b Section: OTHER-SEC Line: 12 -Program-Id: callee2b Paragraph: EX Line: 14 -Program-Id: callee2b Entry: LEAVE-ME Line: 14 -Program-Id: callee2b Paragraph: END-PAR Line: 10 -Program-Id: callee2b Exit: callee2b Line: 10 -Source: 'callee1.cob' -Program-Id: callee1 -Program-Id: callee1 CANCEL Line: 33 -Program-Id: callee1 SUBTRACT Line: 34 -Program-Id: callee1 EXIT PROGRAM Line: 35 -Program-Id: callee1 Exit: callee1 Line: 35 -Source: 'caller.cob' -Program-Id: caller -Program-Id: caller CANCEL Line: 16 -Program-Id: caller CALL Line: 17 -Source: 'preload2.cob' -Program-Id: callrec -Program-Id: callrec Entry: callrec Line: 9 -Program-Id: callrec Section: SOME-SEC Line: 10 -Program-Id: callrec IF Line: 11 -Program-Id: callrec SET Line: 12 -Program-Id: callrec CALL Line: 13 -Program-Id: callrec Entry: callrec Line: 9 -Program-Id: callrec Section: SOME-SEC Line: 10 -Program-Id: callrec IF Line: 11 -Program-Id: callrec GOBACK Line: 15 -Program-Id: callrec Exit: callrec Line: 15 -Program-Id: callrec GOBACK Line: 15 -Program-Id: callrec Exit: callrec Line: 15 -Source: 'caller.cob' -Program-Id: caller -Program-Id: caller MOVE Line: 18 -Program-Id: caller STOP RUN Line: 19 -]) - -AT_CLEANUP - - -AT_SETUP([Test dump feature]) -AT_KEYWORDS([Dump]) - -AT_DATA([./cpyabrt], [ - MOVE "Quick brown fox jumped over the dog" - TO TSTTAILX (1:40). - MOVE CM-COMPANY TO TSTTAILX (42:20). - * DISPLAY ':' X ':'. - * DISPLAY CM-COMPANY. - * DISPLAY '>' CM-COMPANY '<'. -]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - CONFIGURATION SECTION. - - INPUT-OUTPUT SECTION. - FILE-CONTROL. - SELECT FLATFILE ASSIGN EXTERNAL RELFIX - ORGANIZATION RELATIVE - ACCESS IS SEQUENTIAL RELATIVE KEY IS REC-NUM - FILE STATUS IS CUST-STAT. - - DATA DIVISION. - FILE SECTION. - FD FLATFILE - BLOCK CONTAINS 5 RECORDS. - - 01 TSPFL-RECORD. - 10 CM-CUST-NUM PICTURE X(8). - 10 CM-COMPANY PICTURE X(25). - 10 CM-DISK PICTURE X(8). - 10 CM-NO-TERMINALS PICTURE 9(4). - - WORKING-STORAGE SECTION. - 77 MAX-SUB VALUE 6 PICTURE 9(4) COMP SYNC. - 77 CUST-STAT PICTURE X(2). - 77 REC-NUM VALUE 1 PICTURE 9(4). - 01 BIN PIC 9(9) BINARY VALUE 0. - - 01 TEST-DATA. - 02 DATA-CUST-NUM-TBL. - 05 FILLER PIC X(8) VALUE "ALP00000". - 05 FILLER PIC X(8) VALUE "BET00000". - 05 FILLER PIC X(8) VALUE "DEL00000". - 05 FILLER PIC X(8) VALUE "EPS00000". - 05 FILLER PIC X(8) VALUE "FOR00000". - 05 FILLER PIC X(8) VALUE "GAM00000". - - 02 DATA-CUST-NUM REDEFINES DATA-CUST-NUM-TBL - PIC X(8) OCCURS 6. - 02 DATA-COMPANY-TBL. - 05 FILLER PIC X(25) VALUE "ALPHA ELECTRICAL CO. LTD.". - 05 FILLER PIC X(25) VALUE "BETA SHOE MFG. INC. ". - 05 FILLER PIC X(25) VALUE "DELTA LUGGAGE REPAIRS ". - 05 FILLER PIC X(25) VALUE "EPSILON EQUIPMENT SUPPLY ". - 05 FILLER PIC X(25) VALUE "FORTUNE COOKIE COMPANY ". - 05 FILLER PIC X(25) VALUE "GAMMA X-RAY TECHNOLOGY ". - 02 DATA-COMPANY REDEFINES DATA-COMPANY-TBL - PIC X(25) OCCURS 6. - 02 DATA-ADDRESS-2-TBL. - 05 FILLER PIC X(10) VALUE "ATLANTA ". - 05 FILLER PIC X(10) VALUE "CALGARY ". - 05 FILLER PIC X(10) VALUE "NEW YORK ". - 05 FILLER PIC X(10) VALUE "TORONTO ". - 05 FILLER PIC X(10) VALUE "WASHINGTON". - 05 FILLER PIC X(10) VALUE "WHITEPLAIN". - 02 DATA-ADDRESS REDEFINES DATA-ADDRESS-2-TBL - PIC X(10) OCCURS 6. - - 02 DATA-NO-TERMINALS-TBL. - 05 FILLER PIC 9(3) COMP-3 VALUE 10. - 05 FILLER PIC 9(3) COMP-3 VALUE 13. - 05 FILLER PIC 9(3) COMP-3 VALUE 75. - 05 FILLER PIC 9(3) COMP-3 VALUE 10. - 05 FILLER PIC 9(3) COMP-3 VALUE 90. - 05 FILLER PIC 9(3) COMP-3 VALUE 254. - 02 DATA-NO-TERMINALS REDEFINES DATA-NO-TERMINALS-TBL - PIC 9(3) COMP-3 OCCURS 6. - 01 WORK-AREA IS EXTERNAL. - 05 SUB PICTURE 9(4) COMP SYNC. - 88 ODD-RECORD VALUE 1 3 5. - - - PROCEDURE DIVISION. - - PERFORM LOADFILE. - - OPEN INPUT FLATFILE. - READ FLATFILE. - - MAIN-100. - PERFORM CALL-SUB-1. - PERFORM CALL-SUB-2. - PERFORM CALL-IT-OMIT. - STOP RUN. - - LOADFILE. - OPEN OUTPUT FLATFILE. - - PERFORM LOAD-RECORD - VARYING SUB FROM 1 BY 1 - UNTIL SUB > MAX-SUB. - - CLOSE FLATFILE. - - LOAD-RECORD. - - MOVE SPACES TO TSPFL-RECORD. - MOVE DATA-CUST-NUM (SUB) TO CM-CUST-NUM. - MOVE DATA-COMPANY (SUB) TO CM-COMPANY. - MOVE DATA-NO-TERMINALS (SUB) TO CM-NO-TERMINALS. - IF ODD-RECORD - MOVE "8417" TO CM-DISK - ELSE - MOVE "8470" TO CM-DISK. - WRITE TSPFL-RECORD. - - CALL-SUB-1 SECTION. - CALL "sub1" USING bin, TSPFL-RECORD. - - CALL-SUB-2 SECTION. - MOVE 4096 TO bin - CALL "sub2" USING bin, TSPFL-RECORD. - - CALL-IT-OMIT SECTION. - MOVE 5440 TO bin - CALL "sub1" USING bin, OMITTED. - - END PROGRAM prog. - - IDENTIFICATION DIVISION. - PROGRAM-ID. sub1. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 ZRO PIC 9(9) BINARY VALUE 0. - 01 HEXV PIC X COMP-X. - 01 HEXC REDEFINES HEXV PIC X. - - 01 TEST-BASED BASED. - 05 TEST-BASED-SUB PIC X(00000100000). - - 01 TEST-ALLOCED BASED. - 05 TEST-ALLOCED-SUB1 PIC X(010). - 05 TEST-ALLOCED-SUB2 PIC 9(006). - - 01 IDX PIC 9(9) BINARY VALUE 0. - 01 TSTREC. - 05 TSTDEP PIC XXX. - 05 TSTX OCCURS 4 TIMES. - 15 TSTG-1 PIC 99. - 15 TSTX-2 PIC XX OCCURS 4 TIMES. - 05 TSTTAIL1 PIC 99. - 05 TSTCOMP3 PIC 9(5) COMP-3. - 05 TSTLONG PIC X(100). - 05 TSTHEX PIC X(100). - 05 TSTHEX2 PIC X(60). - 05 TSTTAILX PIC X(80). - - LINKAGE SECTION. - 01 X PIC 9(9) BINARY. - 01 TSPFL-RECORD. - 10 CM-CUST-NUM PICTURE X(8). - 10 CM-COMPANY PICTURE X(25). - 10 CM-DISK PICTURE X(8). - 10 CM-NO-TERMINALS PICTURE 9(4). - - PROCEDURE DIVISION USING X, TSPFL-RECORD. - MAIN-1 SECTION. - MOVE ALL "X" TO TSTREC. - MOVE 1 TO TSTG-1 (1). - MOVE 2 TO TSTG-1 (2). - MOVE 3 TO TSTG-1 (3). - MOVE 'A' TO TSTX-2 (1,1). - MOVE 'B' TO TSTX-2 (2,1). - MOVE 'C' TO TSTX-2 (3,1). - MOVE 'xx' TO TSTX-2 (1,4). - MOVE 'yy' TO TSTX-2 (2,4). - MOVE 'zz' TO TSTX-2 (3,4). - MOVE SPACES TO TSTX-2 (1,3). - MOVE HIGH-VALUES TO TSTX (4). - MOVE LOW-VALUES TO TSTX-2 (2,3). - MOVE HIGH-VALUES TO TSTX-2 (3,3). - MOVE "Quick brown fox jumped over the dog" - TO TSTLONG, TSTLONG (50:36). - MOVE "Quicker grey fox jumped the cougar" - TO TSTHEX (1:35). - MAIN-2. - MOVE 17 TO HEXV. - MOVE HEXC TO TSTHEX (39:1). - MOVE HEXC TO TSTTAIL1 (2:1). - MOVE 7 TO HEXV. - MOVE HEXC TO TSTHEX (47:1). - MOVE 13 TO HEXV. - MOVE HEXC TO TSTHEX (59:1). - MOVE 0 TO HEXV. - MOVE HEXC TO TSTHEX2 (39:1), TSTHEX2 (10:1). - MOVE 9 TO HEXV. - MOVE HEXC TO TSTHEX2 (47:1). - MOVE '\' TO TSTHEX2 (32:1). - MOVE 13 TO HEXV. - MOVE HEXC TO TSTHEX2 (59:1). - MOVE 'A' TO TSTHEX2 (54:1). - MOVE LOW-VALUES TO TSTTAILX - ADD 1 TO X. - DISPLAY "X is " X. - ALLOCATE TEST-ALLOCED INITIALIZED. - COPY cpyabrt. - IF ADDRESS OF TEST-BASED NOT = NULL - DISPLAY TEST-BASED-SUB - END-IF. - GOBACK. - END PROGRAM sub1. - - IDENTIFICATION DIVISION. - PROGRAM-ID. sub2. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 ZRO PIC 9(9) BINARY VALUE 0. - 01 HEXV PIC X COMP-X. - 01 HEXC REDEFINES HEXV PIC X. - - 01 IDX PIC 9(9) BINARY VALUE 0. - 01 TSTREC. - 05 TSTDEP PIC XXX. - 05 TSTX OCCURS 4 TIMES. - 15 TSTG-1 PIC 99. - 15 TSTX-2 PIC XX OCCURS 4 TIMES. - 05 TSTTAIL1 PIC 99. - 05 TSTCOMP3 PIC 9(5) COMP-3. - 05 TSTLONG PIC X(100). - 05 TSTHEX PIC X(100). - 05 TSTHEX2 PIC X(60). - 05 TSTTAILX PIC X(80). - - LINKAGE SECTION. - 01 X PIC 9(9) BINARY. - 01 TSPFL-RECORD. - 10 CM-CUST-NUM PICTURE X(8). - 10 CM-COMPANY PICTURE X(25). - 10 CM-DISK PICTURE X(8). - 10 CM-NO-TERMINALS PICTURE 9(4). - - PROCEDURE DIVISION USING X, TSPFL-RECORD. - MOVE ALL "X" TO TSTREC. - MOVE 1 TO TSTG-1 (1). - MOVE 2 TO TSTG-1 (2). - MOVE 3 TO TSTG-1 (3). - MOVE 'A' TO TSTX-2 (1,1). - MOVE 'B' TO TSTX-2 (2,1). - MOVE 'C' TO TSTX-2 (3,1). - MOVE 'xx' TO TSTX-2 (1,4). - MOVE 'yy' TO TSTX-2 (2,4). - MOVE 'zz' TO TSTX-2 (3,4). - MOVE SPACES TO TSTX-2 (1,3). - MOVE HIGH-VALUES TO TSTX (4). - MOVE LOW-VALUES TO TSTX-2 (2,3). - MOVE HIGH-VALUES TO TSTX-2 (3,3). - MOVE "Quick brown fox jumped over the dog" - TO TSTLONG, TSTLONG (50:36). - MOVE "Quicker grey fox jumped the cougar" - TO TSTHEX (1:35). - MOVE 17 TO HEXV. - MOVE HEXC TO TSTHEX (39:1). - MOVE HEXC TO TSTTAIL1 (2:1). - MOVE 7 TO HEXV. - MOVE HEXC TO TSTHEX (47:1). - MOVE 13 TO HEXV. - MOVE HEXC TO TSTHEX (59:1). - MOVE 0 TO HEXV. - MOVE HEXC TO TSTHEX2 (39:1), TSTHEX2 (10:1). - MOVE 9 TO HEXV. - MOVE HEXC TO TSTHEX2 (47:1). - MOVE '\' TO TSTHEX2 (32:1). - MOVE 13 TO HEXV. - MOVE HEXC TO TSTHEX2 (59:1). - MOVE 'A' TO TSTHEX2 (54:1). - MOVE LOW-VALUES TO TSTTAILX. - COPY cpyabrt. - END PROGRAM sub2. -]) - -AT_CHECK([$COMPILE -fdump=ALL prog.cob], [0], [], []) - -AT_CHECK([COB_DUMP_FILE=tstdump.txt \ -$COBCRUN_DIRECT ./prog], [1], -[X is 000000001 -X is 000005441 -], -[libcob: cpyabrt:4: error: LINKAGE item 'TSPFL-RECORD' (accessed by 'CM-COMPANY') not passed by caller -libcob: cpyabrt:4: warning: implicit CLOSE of FLATFILE ('RELFIX') -]) - -AT_CAPTURE_FILE(./tstdump.txt) - -AT_DATA([reference_tmpl], -[Module dump due to LINKAGE item 'TSPFL-RECORD' (accessed by 'CM-COMPANY') not passed by caller - Last statement of sub1 was Line 4 of cpyabrt - Last statement of prog was Line 118 of prog.cob - -Dump Program-Id sub1 from prog.cob compiled MMM DD YYYY HH:MM:SS - -WORKING-STORAGE -********************** -01 ZRO 000000000 -01 HEXV 013 -01 TEST-BASED. address -01 TEST-ALLOCED. - 05 TEST-ALLOCED-SUB1 ALL SPACES - 05 TEST-ALLOCED-SUB2 000000 -01 IDX 000000000 -01 TSTREC. - 05 TSTDEP 'XXX' - 05 TSTX. - 15 TSTG-1 (1) 01 - 15 TSTX-2 (1,1) 'A' - 15 TSTX-2 (1,2) 'XX' - 15 TSTX-2 (1,3) ALL SPACES - 15 TSTX-2 (1,4) 'xx' - 15 TSTG-1 (2) 02 - 15 TSTX-2 (2,1) 'B' - 15 TSTX-2 (2,2) 'XX' - 15 TSTX-2 (2,3) ALL LOW-VALUES - 15 TSTX-2 (2,4) 'yy' - 15 TSTG-1 (3) 03 - 15 TSTX-2 (3,1) 'C' - 15 TSTX-2 (3,2) 'XX' - 15 TSTX-2 (3,3) ALL HIGH-VALUES - 15 TSTX-2 (3,4) 'zz' - 15 TSTG-1 (4) ALL HIGH-VALUES - 15 TSTX-2 (4,1) ALL HIGH-VALUES - 15 TSTX-2 (4,2) ALL HIGH-VALUES - 15 TSTX-2 (4,3) ALL HIGH-VALUES - 15 TSTX-2 (4,4) ALL HIGH-VALUES - 05 TSTTAIL1 X _ - 1 x 5811 - 05 TSTCOMP3 58585 - 05 TSTLONG 'Quick brown fox jumped over the dog Quick br' - 'own fox jumped over the dog' - 05 TSTHEX Q u i c k e r g r e y f o x j u m p e d _ - 1 x 51756963 6B657220 67726579 20666F78 206A756D 70656420 _ - t h e c o u g a r X X X X X X X X X X X _ - 25 x 74686520 636F7567 61722058 58581158 58585858 58580758 _ - X X X X X X X X X X X X X X X X X X X X X X X _ - 49 x 58585858 58585858 58580D58 58585858 58585858 58585858 _ - X X X X X X X X X X X X X X X X X X X X X X X X _ - 73 x 58585858 58585858 58585858 58585858 58585858 58585858 _ - X X X X - 97 x 58585858 - 05 TSTHEX2 XXXXXXXXX\0XXXXXXXXXXXXXXXXXXXXX\\XXXXXX\0XXXXXXX\tXXXXXX - 54 : AXXXX\rX - 05 TSTTAILX 'Quick brown fox jumped over the dog ' - trailing LOW-VALUES - -LINKAGE -********************** -01 X 000005441 -01 TSPFL-RECORD. address - -Dump Program-Id prog from prog.cob compiled MMM DD YYYY HH:MM:SS - -FD FLATFILE -********************** - File is OPEN - FILE STATUS '00' -01 TSPFL-RECORD. - 10 CM-CUST-NUM 'ALP00000' - 10 CM-COMPANY 'ALPHA ELECTRICAL CO. LTD.' - 10 CM-DISK '8417' - 10 CM-NO-TERMINALS 0010 - -WORKING-STORAGE -********************** -77 MAX-SUB 0006 -77 CUST-STAT '00' -77 REC-NUM 0001 -01 BIN 000005441 -01 TEST-DATA. - 02 DATA-CUST-NUM-TBL. - 05 FILLER 'ALP00000' - 05 FILLER 'BET00000' - 05 FILLER 'DEL00000' - 05 FILLER 'EPS00000' - 05 FILLER 'FOR00000' - 05 FILLER 'GAM00000' - 02 DATA-COMPANY-TBL. - 05 FILLER 'ALPHA ELECTRICAL CO. LTD.' - 05 FILLER 'BETA SHOE MFG. INC.' - 05 FILLER 'DELTA LUGGAGE REPAIRS' - 05 FILLER 'EPSILON EQUIPMENT SUPPLY' - 05 FILLER 'FORTUNE COOKIE COMPANY' - 05 FILLER 'GAMMA X-RAY TECHNOLOGY' - 02 DATA-ADDRESS-2-TBL. - 05 FILLER 'ATLANTA' - 05 FILLER 'CALGARY' - 05 FILLER 'NEW YORK' - 05 FILLER 'TORONTO' - 05 FILLER 'WASHINGTON' - 05 FILLER 'WHITEPLAIN' - 02 DATA-NO-TERMINALS-TBL. - 05 FILLER 010 - 05 FILLER 013 - 05 FILLER 075 - 05 FILLER 010 - 05 FILLER 090 - 05 FILLER 254 -01 WORK-AREA. - 05 SUB 0007 - -]) - -# AT_DATA workaround via sed: -AT_CHECK([sed -e 's/_$//' reference_tmpl > reference], [0], [], []) -AT_CHECK([sed -e 's/compiled ... .. .... ..:..:../compiled MMM DD YYYY HH:MM:SS/g' \ -tstdump.txt > tstdump.sed], [0], [], []) - -AT_CHECK([diff reference tstdump.sed], [0], [], []) - -AT_CHECK([$COMPILE -fdump=FD,LS prog.cob -o prog_fdls], [0], [], []) - -AT_CHECK([COB_DUMP_FILE=tstdump_fdls.txt \ -$COBCRUN_DIRECT ./prog_fdls], [1], -[X is 000000001 -X is 000005441 -], -[libcob: cpyabrt:4: error: LINKAGE item 'TSPFL-RECORD' (accessed by 'CM-COMPANY') not passed by caller -libcob: cpyabrt:4: warning: implicit CLOSE of FLATFILE ('RELFIX') -]) - - -AT_CAPTURE_FILE(./tstdump_fdls.txt) - -AT_DATA([reference_fdls_tmpl], -[Module dump due to LINKAGE item 'TSPFL-RECORD' (accessed by 'CM-COMPANY') not passed by caller - Last statement of sub1 was Line 4 of cpyabrt - Last statement of prog was Line 118 of prog.cob - -Dump Program-Id sub1 from prog.cob compiled MMM DD YYYY HH:MM:SS - -LINKAGE -********************** -01 X 000005441 -01 TSPFL-RECORD. address - -Dump Program-Id prog from prog.cob compiled MMM DD YYYY HH:MM:SS - -FD FLATFILE -********************** - File is OPEN - FILE STATUS '00' -01 TSPFL-RECORD. - 10 CM-CUST-NUM 'ALP00000' - 10 CM-COMPANY 'ALPHA ELECTRICAL CO. LTD.' - 10 CM-DISK '8417' - 10 CM-NO-TERMINALS 0010 - -]) - -# AT_DATA workaround via sed: -AT_CHECK([sed -e 's/_$//' reference_fdls_tmpl > reference], [0], [], []) -AT_CHECK([sed -e 's/compiled ... .. .... ..:..:../compiled MMM DD YYYY HH:MM:SS/g' \ -tstdump_fdls.txt > tstdump.sed], [0], [], []) - -AT_CHECK([diff reference tstdump.sed], [0], [], []) - -AT_CLEANUP - -AT_SETUP([Test COBOL-C interface]) -AT_KEYWORDS([CALL]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 SUB-NAME PIC X(10) VALUE "SUB2". - 01 FLT9 USAGE COMP-1 VALUE 9.0. - 01 NUMPI PIC 9(6) VALUE 314. - 01 NUM5 PIC 9(5) VALUE 12345. - 01 NUM9 PIC 9(7)V99 VALUE 1234567.88. - 01 NUMED PIC Z(5)9.99CR. - PROCEDURE DIVISION. - CALL "SUB" USING BY VALUE 1, - BY REFERENCE "Fun and games for you". - CALL "SUB" USING BY VALUE 2, - BY REFERENCE "More Fun and games for all". - CALL "SUB2" USING "Fun and games", BY VALUE 3. - CALL SUB-NAME USING "More Fun and games ....", BY VALUE 4. - CALL "SUB3" . - CALL "COBCSUB" USING BY VALUE 6, - BY REFERENCE "Hi to C Code...". - CALL "COBCSUB" USING BY VALUE NUMPI, - BY REFERENCE "Pass PI to C...". - CALL "COBCSUB" USING BY VALUE NUM9, - BY REFERENCE "Pass V99 to C...". - CALL "CSUB4" USING FLT9, "Hi from COBOL!.". - ADD 1.4 TO FLT9. - CALL "CSUB5" USING FLT9, "Called from COBOL instead of C!.". - CALL "SUB6" USING NUM5. - CALL "SUB6" USING NUM9. - CALL "SUB6" USING NUMPI. - CALL "SUB6" USING FLT9. - CALL "SUB6" USING "31415926". - MOVE 10.50 TO NUMED. - CALL "SUB6" USING NUMED. - MOVE -4510.66 TO NUMED. - CALL "SUB6" USING NUMED. - STOP RUN. - END PROGRAM prog. - - IDENTIFICATION DIVISION. - PROGRAM-ID. SUB. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 xn PIC 9(8) BINARY VALUE 99. - 01 xx PIC X(13) VALUE '"x" was NULL!'. - 01 yy PIC X(8) VALUE "Garbage!". - LINKAGE SECTION. - 01 n PIC 9(8). - 01 x PIC X ANY LENGTH. - 01 y PIC X ANY LENGTH. - 01 z PIC X ANY LENGTH. - 01 num PIC 9 ANY NUMERIC. - 01 cn PIC 9(9) COMP-5. - 01 flt1 USAGE COMP-1. - 01 cx PIC X(15). - PROCEDURE DIVISION USING BY VALUE n, x, BY REFERENCE y. - DISPLAY n " '" x "'". - EXIT PROGRAM. - ENTRY "SUB2" USING z, BY VALUE n. - DISPLAY n " '" z "' via SUB2". - EXIT PROGRAM. - ENTRY "SUB3". - IF ADDRESS OF n = NULL - SET ADDRESS OF n TO ADDRESS OF xn. - IF ADDRESS OF x = NULL - SET ADDRESS OF x TO ADDRESS OF xx. - DISPLAY n " '" x "' via SUB3". - EXIT PROGRAM. - ENTRY "CSUB4" USING BY VALUE cn, BY REFERENCE cx. - DISPLAY cn " '" cx "' via CSUB4". - EXIT PROGRAM. - ENTRY "CSUB5" USING BY VALUE cn, BY REFERENCE z. - DISPLAY cn " '" z "' via CSUB5". - EXIT PROGRAM. - ENTRY "SUB6" USING num. - DISPLAY 'ANY NUMERIC is ' num ' Length ' LENGTH OF num. - EXIT PROGRAM. - ENTRY "CSUB7" USING VALUE flt1. - DISPLAY 'Float value is ' flt1 ' via CSUB7'. - EXIT PROGRAM. - ENTRY "CSUB8" USING flt1. - DISPLAY 'Float reference is ' flt1 ' via CSUB8'. - EXIT PROGRAM. - END PROGRAM SUB. -]) - -AT_DATA([cmod.c], [[ -#include -#include -extern int CSUB4(); -extern int CSUB5(); -extern int SUB6(); -extern int CSUB7(float f); -extern int CSUB8(float *f); -int -COBCSUB(int y, unsigned char x[15]) -{ - float flt1; - printf("C routine passed: Y is %d; X is '%.15s'\n",y,x); - CSUB4(y, x); - CSUB4(y+1, "A C-String is being passed"); - CSUB5(y+2, "A much longer C-String is being passed"); - SUB6("314159265358"); - SUB6("31415926"); - SUB6("000314"); - flt1 = 3.1415926; - CSUB7(flt1); - flt1 = 2.71828; - CSUB8(&flt1); - return 0; -} - -]]) - -AT_CHECK([cobc -x -std=ibm -debug -Wall prog.cob cmod.c], [0], [], []) - -AT_CHECK([./prog], [0], [00000001 'Fun and games for you' -00000002 'More Fun and games for all' -00000003 'Fun and games' via SUB2 -00000004 'More Fun and games ....' via SUB2 -00000004 'More Fun and games for all' via SUB3 -C routine passed: Y is 6; X is 'Hi to C Code...' -0000000006 'Hi to C Code...' via CSUB4 -0000000007 'A C-String is b' via CSUB4 -0000000008 'A much longer C-String is being passed' via CSUB5 -ANY NUMERIC is 314159265358 Length 0000000012 -ANY NUMERIC is 31415926 Length 0000000008 -ANY NUMERIC is 000314 Length 0000000006 -Float value is 3.1415925 via CSUB7 -Float reference is 2.7182801 via CSUB8 -C routine passed: Y is 314; X is 'Pass PI to C...' -0000000314 'Pass PI to C...' via CSUB4 -0000000315 'A C-String is b' via CSUB4 -0000000316 'A much longer C-String is being passed' via CSUB5 -ANY NUMERIC is 314159265358 Length 0000000012 -ANY NUMERIC is 31415926 Length 0000000008 -ANY NUMERIC is 000314 Length 0000000006 -Float value is 3.1415925 via CSUB7 -Float reference is 2.7182801 via CSUB8 -C routine passed: Y is 1234567; X is 'Pass V99 to C..' -0001234567 'Pass V99 to C..' via CSUB4 -0001234568 'A C-String is b' via CSUB4 -0001234569 'A much longer C-String is being passed' via CSUB5 -ANY NUMERIC is 314159265358 Length 0000000012 -ANY NUMERIC is 31415926 Length 0000000008 -ANY NUMERIC is 000314 Length 0000000006 -Float value is 3.1415925 via CSUB7 -Float reference is 2.7182801 via CSUB8 -0000000009 'Hi from COBOL!.' via CSUB4 -0000000010 'Called from COBOL instead of C!.' via CSUB5 -ANY NUMERIC is 12345 Length 0000000005 -ANY NUMERIC is 123456788 Length 0000000009 -ANY NUMERIC is 000314 Length 0000000006 -ANY NUMERIC is 10.4 Length 0000000004 -ANY NUMERIC is 31415926 Length 0000000008 -ANY NUMERIC is 10.50 Length 0000000011 -ANY NUMERIC is 4510.66CR Length 0000000011 -], []) - -AT_CLEANUP - -AT_SETUP([Test COBOL-C interface (2)]) -AT_KEYWORDS([CALL]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. routine1. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 PDUMP POINTER. - 01 PNUM REDEFINES PDUMP BINARY-LONG. - 01 DUMMY PICTURE X(1). - 01 PN PICTURE 9(1). - LINKAGE SECTION. - 01 P1 PICTURE X(1). - 01 P2 PICTURE X(1). - PROCEDURE DIVISION USING P1 P2. - MOVE NUMBER-OF-CALL-PARAMETERS TO PN. - DISPLAY "Now in routine1 with " PN " params" - SET PDUMP TO ADDRESS OF P1. - MOVE PNUM TO PN. - DISPLAY "Expect '1' and got " PN. - SET PDUMP TO ADDRESS OF P2. - MOVE PNUM TO PN. - DISPLAY "Expect '2' and got " PN. - call "one_parameter" USING DUMMY. - GOBACK. - - DISPLAY "Call routine2 with P2" - call "routine2" USING P2. - DISPLAY "Call routine2 with nothing" - call "routine2". - DISPLAY "Call routine2 with P2, P1" - call "routine2" USING P2, P1. - DISPLAY "Leaving routine1". - GOBACK. - END PROGRAM routine1. - - IDENTIFICATION DIVISION. - PROGRAM-ID. routine2. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 PDUMP POINTER. - 01 PNUM REDEFINES PDUMP BINARY-LONG. - 01 DUMMY PICTURE X(1). - 01 PN PICTURE 9(1). - LINKAGE SECTION. - 01 P1 PICTURE X(1). - 01 P2 PICTURE X(1). - PROCEDURE DIVISION USING P1 P2. - MOVE NUMBER-OF-CALL-PARAMETERS TO PN. - DISPLAY "Now in routine2 with " PN " params" - SET PDUMP TO ADDRESS OF P1. - MOVE PNUM TO PN. - DISPLAY "Expect '3' and got " PN. - SET PDUMP TO ADDRESS OF P2. - MOVE PNUM TO PN. - DISPLAY "Expect '4' and got " PN. - DISPLAY "Leaving routine2". - GOBACK. - END PROGRAM routine2. -]) - -AT_DATA([cmod.c], [[ -#include -#include - -extern int routine1(void *, void *); -extern int routine2(void *, void *); - -int main() -{ - cob_init(0,NULL); - routine1((void *)(0x1),(void *)(0x2)); - return 0; -} - -void one_parameter(void *dummy) -{ - printf("Now in one_parameter\n"); - routine2((void *)(0x3),(void *)(0x4)); -} -]]) - -AT_CHECK([$COMPILE -std=ibm -o prog cmod.c prog.cob], [0], [], []) - -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [Now in routine1 with 2 params -Expect '1' and got 1 -Expect '2' and got 2 -Now in one_parameter -Now in routine2 with 2 params -Expect '3' and got 3 -Expect '4' and got 4 -Leaving routine2 -], []) - -AT_CLEANUP - -AT_SETUP([COBOL2002 SYNC]) -AT_KEYWORDS([Numeric]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - CONFIGURATION SECTION. - DATA DIVISION. - FILE SECTION. - - WORKING-STORAGE SECTION. - - 77 VLEN PIC 99 VALUE 1. - 77 TESTMODE PIC 99 VALUE 1. - 77 TESTIDX PIC 99 VALUE 1. - 77 BIT-MODE PIC 99 VALUE 32. - 77 TESTNUM PIC 99 VALUE 0. - 77 TESTMAX PIC 99 VALUE 23. - 77 TESTCASE PIC 99 VALUE 0. - 77 TESTFAIL PIC 99 VALUE 0. - 77 TESTEND PIC X(15) VALUE " ". - 77 TESTNAME PIC X(10) VALUE " ". - 77 TESTRESULT PIC X(40) VALUE " ". - 77 TESTPTR USAGE POINTER. - - 01 TEST-MODES. - 05 FILLER PIC X(10) VALUE "MF". - 05 FILLER PIC X(10) VALUE "IBMCOMP". - 05 FILLER PIC X(10) VALUE "C2002". - - 01 FILLER REDEFINES TEST-MODES. - 05 FILLER OCCURS 3 TIMES. - 10 TEST-MODE PIC X(10). - - 01 TEST-CASES. - 05 FILLER PIC X(10) VALUE "COMP-FLD1". - 05 FILLER PIC X(40) VALUE "xxxxx1". - 05 FILLER PIC X(40) VALUE "xxxxx11". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - - 05 FILLER PIC X(10) VALUE "COMP-FLD2". - 05 FILLER PIC X(40) VALUE "xxxxx22". - 05 FILLER PIC X(40) VALUE "xxxxxx22". - 05 FILLER PIC X(40) VALUE "xxxxxx22". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - - 05 FILLER PIC X(10) VALUE "COMP-FLDO". - 05 FILLER PIC X(40) VALUE "xxxxxxx11xxx22xxx33". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - - 05 FILLER PIC X(10) VALUE "COMP-FLDS". - 05 FILLER PIC X(40) VALUE "xxxxxxx11xxx22xxx33". - 05 FILLER PIC X(40) VALUE "xxxxxxxx11xxxx22xxxx33". - 05 FILLER PIC X(40) VALUE "xxxxxxxx11xxxx22xxxx33". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - - 05 FILLER PIC X(10) VALUE "COMP-FLD3". - 05 FILLER PIC X(40) VALUE "xxxxx123". - 05 FILLER PIC X(40) VALUE "xxxxxxxx1234". - 05 FILLER PIC X(40) VALUE "xxxxxxxx1234". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - - 05 FILLER PIC X(10) VALUE "COMP-FLDL". - 05 FILLER PIC X(40) VALUE "xxxxx1". - 05 FILLER PIC X(40) VALUE "xxxxxx12". - 05 FILLER PIC X(40) VALUE "xxxxx1". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - - 05 FILLER PIC X(10) VALUE "COMP-FLDR". - 05 FILLER PIC X(40) VALUE "xxxxx1". - 05 FILLER PIC X(40) VALUE "xxxxxx12". - 05 FILLER PIC X(40) VALUE "xxxxx1". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - - 05 FILLER PIC X(10) VALUE "COM1-FLD". - 05 FILLER PIC X(40) VALUE "xxxxx12xxx123xxx12345678". - 05 FILLER PIC X(40) VALUE "xxxxxx12xxxx1234xxxx12345678". - 05 FILLER PIC X(40) VALUE "xxxxxx12xxxx1234xxxxxxxx12345678". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE "xxxxxx12xxxx1234xxxx12345678". - - 05 FILLER PIC X(10) VALUE "COM2-FLD". - 05 FILLER PIC X(40) VALUE "xxxxx12345xxx1234567xxx12345678". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - - 05 FILLER PIC X(10) VALUE "COM3-FLD". - 05 FILLER PIC X(40) VALUE "xxxxx123xxx1234xxx1234567". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - - 05 FILLER PIC X(10) VALUE "COM4-FLD". - 05 FILLER PIC X(40) VALUE "x123456x1234x123456x123". - 05 FILLER PIC X(40) VALUE "xxxx12345678xxxx1234x12345678x1234". - 05 FILLER PIC X(40) - VALUE "xxxxxxxx12345678xxxx1234x12345678x1234". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE "xxxx12345678xxxx1234x12345678x1234". - - 05 FILLER PIC X(10) VALUE "NOSYNC". - 05 FILLER PIC X(40) VALUE "x123456x123". - 05 FILLER PIC X(40) VALUE "x12345678x1234". - 05 FILLER PIC X(40) VALUE "x12345678x1234". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - - 05 FILLER PIC X(10) VALUE "SYNC". - 05 FILLER PIC X(40) VALUE "x123456x1234". - 05 FILLER PIC X(40) VALUE "xxxx12345678xxxx1234". - 05 FILLER PIC X(40) VALUE "xxxxxxxx12345678xxxx1234". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE "xxxx12345678xxxx1234". - - 05 FILLER PIC X(10) VALUE "COMP-3". - 05 FILLER PIC X(40) VALUE "x1234567x1234". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - - 05 FILLER PIC X(10) VALUE "COMP-1". - 05 FILLER PIC X(40) VALUE "12341234". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - - 05 FILLER PIC X(10) VALUE "COMP-2". - 05 FILLER PIC X(40) VALUE "1234567812345678". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - - 05 FILLER PIC X(10) VALUE "SIGN L/T". - 05 FILLER PIC X(40) VALUE "x-01x02-x-03x04-". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - - 05 FILLER PIC X(10) VALUE "COMP-X". - 05 FILLER PIC X(40) VALUE "x123x1234567x1234x12345678". - 05 FILLER PIC X(40) VALUE "x123x1234567xxxx1234xxxx12345678". - 05 FILLER PIC X(40) VALUE "x123x1234567xxxx1234xxxx12345678". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - - 05 FILLER PIC X(10) VALUE "BIN-SHORT". - 05 FILLER PIC X(40) VALUE "x12xx12". - 05 FILLER PIC X(40) VALUE "x12xx12". - 05 FILLER PIC X(40) VALUE "x12xx12". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - - 05 FILLER PIC X(10) VALUE "BIN-DBL". - 05 FILLER PIC X(40) VALUE "x12345678x12345678". - 05 FILLER PIC X(40) VALUE "x12345678x12345678". - 05 FILLER PIC X(40) VALUE "x12345678x12345678". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE "x12345678x12345678". - - 05 FILLER PIC X(10) VALUE "COMP-5". - 05 FILLER PIC X(40) VALUE "x12345678x12345678". - 05 FILLER PIC X(40) VALUE "x12345678xxx12345678". - 05 FILLER PIC X(40) VALUE "x1234x1234". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE "x1234x1234". - - 05 FILLER PIC X(10) VALUE "CMP-1". - 05 FILLER PIC X(40) VALUE "x1234x1234". - 05 FILLER PIC X(40) VALUE "x1234xxx1234". - 05 FILLER PIC X(40) VALUE "x1234xxx1234". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - - 05 FILLER PIC X(10) VALUE "CMP-2". - 05 FILLER PIC X(40) VALUE "x12345678x12345678". - 05 FILLER PIC X(40) VALUE "x12345678xxxxxxx12345678". - 05 FILLER PIC X(40) VALUE "x12345678xxxxxxx12345678". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE "x12345678xxx12345678". - - 01 FILLER REDEFINES TEST-CASES. - 05 FILLER OCCURS 23 TIMES. - 10 TEST-NAME PIC X(10). - 10 TEST-RESULTS. - 15 MF-64RESULT PIC X(40). - 15 IBM-64RESULT PIC X(40). - 15 C2002-64RESULT PIC X(40). - 15 MF-32RESULT PIC X(40). - 15 IBM-32RESULT PIC X(40). - 15 C2002-32RESULT PIC X(40). - 10 FILLER REDEFINES TEST-RESULTS. - 15 TEST-RESULT PIC X(40) OCCURS 6 TIMES. - - 01 TESTRECORD PIC X(40). - - 01 FILLER REDEFINES TESTRECORD. - 02 TSTREC1. - 10 FILLER PICTURE X(5). - 10 COMP-FLD1 PICTURE S9(2) COMP. - 10 FILLER PICTURE X(5). - - 01 FILLER REDEFINES TESTRECORD. - 02 TSTREC2. - 10 FILLER PICTURE X(5). - 10 COMP-FLD2 PICTURE S9(4) COMP SYNC . - - 01 FILLER REDEFINES TESTRECORD. - 02 TSTREC3. - 10 FILLER PICTURE X(5). - 10 COMP-FLD3 PICTURE S9(6) COMP SYNC. - 10 FILLER PICTURE X(5). - - 01 FILLER REDEFINES TESTRECORD. - 02 TSTRECL. - 10 FILLER PICTURE X(5). - 10 COMP-FLDL PICTURE S9(2) COMP SYNC LEFT. - 10 FILLER PICTURE X(5). - - 01 FILLER REDEFINES TESTRECORD. - 02 TSTRECR. - 10 FILLER PICTURE X(5). - 10 COMP-FLDR PICTURE S9(2) COMP SYNC RIGHT. - 10 FILLER PICTURE X(5). - - 01 FILLER REDEFINES TESTRECORD. - 02 TSTRECS. - 10 FILLER PICTURE X(5). - 10 FILLER OCCURS 3 TIMES. - 15 FILLER PICTURE X(2). - 15 COMP-FLDS PICTURE S9(4) COMP SYNC . - 15 FILLER PICTURE X(1). - 10 FILLER PICTURE X(1). - - 01 FILLER REDEFINES TESTRECORD. - 02 TSTRECO. - 10 FILLER PICTURE X(5). - 10 FILLER OCCURS 3 TIMES. - 15 FILLER PICTURE X(2). - 15 COMP-FLDO PICTURE S9(4) COMP. - 15 FILLER PICTURE X(1). - 10 FILLER PICTURE X(1). - - 01 FILLER REDEFINES TESTRECORD. - 02 TSTGRP SYNC COMP. - 05 GRP1. - 10 FILLER PICTURE X(5). - 10 COM1-FLD1 PICTURE S9(4). - 10 FILLER PICTURE X(3). - 10 COM1-FLD2 PICTURE S9(6). - 10 FILLER PICTURE X(3). - 10 COM1-FLD3 PICTURE S9(18). - - 01 FILLER REDEFINES TESTRECORD. - 02 TSTGRP2 SIGN LEADING SEPARATE. - 05 GRP2-1. - 10 FILLER PICTURE X(5). - 10 COM2-FLD1 PICTURE S9(4). - 10 FILLER PICTURE X(3). - 10 COM2-FLD2 PICTURE S9(6) SIGN TRAILING SEPARATE. - 10 FILLER PICTURE X(3). - 10 COM2-FLD3 PICTURE S9(7). - - 01 FILLER REDEFINES TESTRECORD. - 02 TSTGRP3 PACKED-DECIMAL. - 05 GRP3-1. - 10 FILLER PICTURE X(5). - 10 COM3-FLD1 PICTURE S9(4). - 10 FILLER PICTURE X(3). - 10 COM3-FLD2 PICTURE S9(6). - 10 FILLER PICTURE X(3). - 05 GRP3-2. - 10 COM3-FLD3 PICTURE S9(13). - - 01 FILLER REDEFINES TESTRECORD. - 02 TSTGRP4 COMP. - 05 GRP4-1 SYNC. - 10 FILLER PICTURE X(1). - 10 COM4-FLD1 PICTURE S9(13). - 10 FILLER PICTURE X(1). - 10 COM4-FLD2 PICTURE S9(7). - 10 FILLER PICTURE X(1). - 05 GRP4-2. - 10 COM4-FLD3 PICTURE S9(13). - 10 FILLER PICTURE X(1). - 10 COM4-FLD4 PICTURE S9(6). - 10 FILLER PICTURE X(1). - - 01 FILLER REDEFINES TESTRECORD. - 02 TSTGRP5 COMP. - 10 FILLER PICTURE X(1). - 10 COM5-FLD1 PICTURE S9(13). - 10 FILLER PICTURE X(1). - 10 COM5-FLD2 PICTURE S9(6). - 10 FILLER PICTURE X(1). - - 01 FILLER REDEFINES TESTRECORD. - 02 TSTGRP5S COMP SYNC. - 10 FILLER PICTURE X(1). - 10 COM5S-FLD1 PICTURE S9(13). - 10 FILLER PICTURE X(1). - 10 COM5S-FLD2 PICTURE S9(7). - 10 FILLER PICTURE X(1). - - 01 FILLER REDEFINES TESTRECORD. - 02 TSTGRP6 PACKED-DECIMAL. - 10 FILLER PICTURE X(1). - 10 COM6-FLD1 PICTURE S9(13). - 10 FILLER PICTURE X(1). - 10 COM6-FLD2 PICTURE S9(6). - 10 FILLER PICTURE X(1). - - 01 FILLER REDEFINES TESTRECORD. - 02 TSTGRP7 FLOAT-SHORT. - 10 COM7-FLD1 . - 10 COM7-FLD2 . - - 01 FILLER REDEFINES TESTRECORD. - 02 TSTGRP8 FLOAT-LONG. - 10 COM8-FLD1 . - 10 COM8-FLD2 . - - 01 FILLER REDEFINES TESTRECORD. - 02 TSTGRP9. - 05 GRP9-1 SIGN LEADING SEPARATE. - 10 FILLER PICTURE X(1). - 10 COM9-FLD1 PICTURE S9(2). - 10 FILLER PICTURE X(1). - 10 COM9-FLD2 PICTURE S9(2) SIGN TRAILING SEPARATE. - 10 FILLER PICTURE X(1). - 05 GRP9-2 SIGN TRAILING SEPARATE. - 10 COM9-FLD3 PICTURE S9(2) SIGN LEADING SEPARATE. - 10 FILLER PICTURE X(1). - 10 COM9-FLD4 PICTURE S9(2). - 10 FILLER PICTURE X(1). - - 01 FILLER REDEFINES TESTRECORD. - 02 TSTGRPX. - 10 FILLER PICTURE X(1). - 10 COMX-FLD1 PICTURE X(3). - 10 FILLER PICTURE X(1). - 10 COMX-FLD2 PICTURE X(7). - 10 FILLER PICTURE X(1). - 10 COMX-FLT FLOAT-SHORT SYNC. - 10 FILLER PICTURE X(1). - 10 COMX-DBL FLOAT-LONG SYNC. - 10 FILLER PICTURE X(1). - - 01 FILLER REDEFINES TESTRECORD. - 02 TST-BSHORT. - 10 FILLER PICTURE X(1). - 10 COMS-FLD1 BINARY-SHORT. - 10 FILLER PICTURE X(2). - 10 COMS-FLD2 BINARY-SHORT SYNC. - 10 FILLER PICTURE X(1). - - 01 FILLER REDEFINES TESTRECORD. - 02 TST-BLONG. - 10 FILLER PICTURE X(1). - 10 COML-FLD1 BINARY-LONG. - 10 FILLER PICTURE X(1). - 10 COML-FLD2 BINARY-LONG SYNC. - 10 FILLER PICTURE X(1). - - 01 FILLER REDEFINES TESTRECORD. - 02 TST-BDBL. - 10 FILLER PICTURE X(1). - 10 COMD-FLD1 BINARY-DOUBLE. - 10 FILLER PICTURE X(1). - 10 COMD-FLD2 BINARY-DOUBLE UNSIGNED SYNC. - 10 FILLER PICTURE X(1). - - 01 FILLER REDEFINES TESTRECORD. - 02 TST-CMP5. - 10 FILLER PICTURE X(1). - 10 CMP5-FLD1 BINARY-LONG. - 10 FILLER PICTURE X(1). - 10 CMP5-FLD2 BINARY-LONG SYNC. - 10 FILLER PICTURE X(1). - - 01 FILLER REDEFINES TESTRECORD. - 02 TST-CMP1. - 10 FILLER PICTURE X(1). - 10 CMP1-FLD1 FLOAT-SHORT. - 10 FILLER PICTURE X(1). - 10 CMP1-FLD2 FLOAT-SHORT SYNC. - 10 FILLER PICTURE X(1). - - 01 FILLER REDEFINES TESTRECORD. - 02 TST-CMP2. - 10 FILLER PICTURE X(1). - 10 CMP2-FLD1 FLOAT-LONG. - 10 FILLER PICTURE X(1). - 10 CMP2-FLD2 FLOAT-LONG SYNC. - 10 FILLER PICTURE X(1). - - PROCEDURE DIVISION. - - MOVE LENGTH OF TESTPTR TO VLEN. - IF VLEN = 8 - MOVE 64 TO BIT-MODE - ELSE - MOVE 32 TO BIT-MODE. - MOVE ALL "x" TO TESTRECORD. - MOVE 1 TO TESTMODE. - MOVE ALL "x" TO TSTREC2. - MOVE "22" TO COMP-FLD2 (1:). - IF TSTREC2 = 'xxxxxx22' - MOVE 3 TO TESTMODE. - MOVE "12345678" TO COML-FLD2 (1:). - IF COML-FLD2 = 875770417 - MOVE "Little-Endian" TO TESTEND - ELSE - MOVE "Big-Endian" TO TESTEND - END-IF. - MOVE LENGTH OF COMP-FLD1 TO VLEN. - IF VLEN = 2 - MOVE 2 TO TESTMODE. - MOVE ALL "x" TO TESTRECORD. - - MOVE "COMP-FLD1" TO TESTNAME. - MOVE "11" TO COMP-FLD1 (1:). - PERFORM CHECK-IT. - - MOVE "COMP-FLD2" TO TESTNAME. - MOVE "22" TO COMP-FLD2 (1:). - PERFORM CHECK-IT. - - MOVE "COMP-FLDO" TO TESTNAME. - MOVE "11" TO COMP-FLDO (1) (1:2) - MOVE "22" TO COMP-FLDO (2) (1:2) - MOVE "33" TO COMP-FLDO (3) (1:2) - PERFORM CHECK-IT. - - MOVE "COMP-FLDS" TO TESTNAME. - MOVE "11" TO COMP-FLDS (1) (1:2) - MOVE "22" TO COMP-FLDS (2) (1:2) - MOVE "33" TO COMP-FLDS (3) (1:2) - PERFORM CHECK-IT. - - MOVE "COMP-FLD3" TO TESTNAME. - MOVE "1234678" TO COMP-FLD3 (1:). - PERFORM CHECK-IT. - - MOVE "COMP-FLDL" TO TESTNAME. - MOVE "12345678" TO COMP-FLDL (1:). - PERFORM CHECK-IT. - - MOVE "COMP-FLDR" TO TESTNAME. - MOVE "12345678" TO COMP-FLDR (1:). - PERFORM CHECK-IT. - - MOVE "COM1-FLD" TO TESTNAME. - MOVE "12345678" TO COM1-FLD1 (1:). - MOVE "12345678" TO COM1-FLD2 (1:). - MOVE "12345678" TO COM1-FLD3 (1:). - PERFORM CHECK-IT. - - MOVE "COM2-FLD" TO TESTNAME. - MOVE "12345678" TO COM2-FLD1 (1:). - MOVE "12345678" TO COM2-FLD2 (1:). - MOVE "12345678" TO COM2-FLD3 (1:). - PERFORM CHECK-IT. - - MOVE "COM3-FLD" TO TESTNAME. - MOVE "12345678" TO COM3-FLD1 (1:). - MOVE "12345678" TO COM3-FLD2 (1:). - MOVE "12345678" TO COM3-FLD3 (1:). - PERFORM CHECK-IT. - - MOVE "COM4-FLD" TO TESTNAME. - MOVE "12345678" TO COM4-FLD1 (1:). - MOVE "12345678" TO COM4-FLD2 (1:). - MOVE "12345678" TO COM4-FLD3 (1:). - MOVE "12345678" TO COM4-FLD4 (1:). - PERFORM CHECK-IT. - - MOVE "NOSYNC" TO TESTNAME. - MOVE "12345678" TO COM5-FLD1 (1:). - MOVE "12345678" TO COM5-FLD2 (1:). - PERFORM CHECK-IT. - - MOVE "SYNC" TO TESTNAME. - MOVE "12345678" TO COM5S-FLD1 (1:). - MOVE "12345678" TO COM5S-FLD2 (1:). - PERFORM CHECK-IT. - - MOVE "COMP-3" TO TESTNAME. - MOVE "12345678" TO COM6-FLD1 (1:). - MOVE "12345678" TO COM6-FLD2 (1:). - PERFORM CHECK-IT. - - MOVE "COMP-1" TO TESTNAME. - MOVE "12345678" TO COM7-FLD1 (1:). - MOVE "12345678" TO COM7-FLD2 (1:). - PERFORM CHECK-IT. - - MOVE "COMP-2" TO TESTNAME. - MOVE "12345678" TO COM8-FLD1 (1:). - MOVE "12345678" TO COM8-FLD2 (1:). - PERFORM CHECK-IT. - - MOVE "SIGN L/T" TO TESTNAME. - MOVE -1 TO COM9-FLD1 . - MOVE -2 TO COM9-FLD2 . - MOVE -3 TO COM9-FLD3 . - MOVE -4 TO COM9-FLD4 . - PERFORM CHECK-IT. - - MOVE "COMP-X" TO TESTNAME. - MOVE "12345678" TO COMX-FLD1 (1:). - MOVE "12345678" TO COMX-FLD2 (1:). - MOVE "12345678" TO COMX-FLT (1:). - MOVE "12345678" TO COMX-DBL (1:). - PERFORM CHECK-IT. - - MOVE "BIN-SHORT" TO TESTNAME. - MOVE "12345678" TO COMS-FLD1 (1:). - MOVE "12345678" TO COMS-FLD2 (1:). - PERFORM CHECK-IT. - - MOVE "BIN-DBL" TO TESTNAME. - MOVE "12345678" TO COMD-FLD1 (1:). - MOVE "12345678" TO COMD-FLD2 (1:). - PERFORM CHECK-IT. - - MOVE "COMP-5" TO TESTNAME. - MOVE "12345678" TO CMP5-FLD1 (1:). - MOVE "12345678" TO CMP5-FLD2 (1:). - PERFORM CHECK-IT. - - MOVE "CMP-1" TO TESTNAME. - MOVE "12345678" TO CMP1-FLD1 (1:). - MOVE "12345678" TO CMP1-FLD2 (1:). - PERFORM CHECK-IT. - - MOVE "CMP-2" TO TESTNAME. - MOVE "12345678" TO CMP2-FLD1 (1:). - MOVE "12345678" TO CMP2-FLD2 (1:). - PERFORM CHECK-IT. - - DISPLAY TESTCASE " tests & " TESTFAIL " failed". - STOP RUN RETURNING 0. - - CHECK-IT SECTION. - CHECK-01. - INSPECT TESTRECORD REPLACING TRAILING 'x' BY ' '. - ADD 1 TO TESTCASE. - PERFORM VARYING TESTNUM FROM 1 BY 1 - UNTIL TEST-NAME (TESTNUM) = TESTNAME - OR TESTNUM > TESTMAX - CONTINUE - END-PERFORM. - IF TESTNUM > TESTMAX - DISPLAY TESTNAME " :NOT FOUND" - DISPLAY " : GOT: " TESTRECORD ":" - ADD 1 TO TESTFAIL - MOVE ALL "x" TO TESTRECORD - GO TO CHECK-EXIT - END-IF. - MOVE TEST-RESULT (TESTNUM, TESTMODE) TO TESTRESULT. - COMPUTE TESTIDX = TESTMODE + 3. - IF BIT-MODE = 32 - AND TEST-RESULT (TESTNUM, TESTIDX) NOT = SPACES - MOVE TEST-RESULT (TESTNUM, TESTIDX) TO TESTRESULT. - IF TESTRESULT = SPACES - MOVE TEST-RESULT (TESTNUM, 1) TO TESTRESULT. - IF TESTRESULT NOT = TESTRECORD - DISPLAY TESTNAME - " :FAILED: Mode " BIT-MODE - " " TEST-MODE (TESTMODE) - ", Case " TESTCASE ", " TESTEND - DISPLAY " : GOT: " TESTRECORD ":" - DISPLAY " :EXPECT: " TESTRESULT ":" - ADD 1 TO TESTFAIL - END-IF. - MOVE ALL "x" TO TESTRECORD. - CHECK-EXIT. - EXIT. - -]) - -AT_CHECK([cobc -x -std=cobol2002 -w prog.cob ], [0], [], []) - -AT_CHECK([./prog], [0], [23 tests & 00 failed -], []) - -AT_CLEANUP -AT_SETUP([NO Subscript]) -AT_KEYWORDS([LENGTH]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - CONFIGURATION SECTION. - DATA DIVISION. - WORKING-STORAGE SECTION. - - 01 DATA-SIZE PIC 999. - 01 MY-DATA. - 03 MY-TABLE OCCURS 20 TIMES. - 05 MY-ELEMENT-1 PIC X(10). - 05 MY-ELEMENT-2 PIC 99. - 78 MY-LEN VALUE LENGTH OF MY-DATA. - - 01 TBLX PIC 99 VALUE 5. - 01 ODO-DATA. - 03 ODO-TABLE OCCURS 1 TO 15 TIMES DEPENDING ON TBLX. - 05 ODO-ELEMENT-1 PIC X(10). - 05 ODO-ELEMENT-2 PIC 99. - - PROCEDURE DIVISION. - DISPLAY "MY-LEN is " MY-LEN. - MOVE LENGTH OF MY-DATA TO DATA-SIZE. - DISPLAY "MY-DATA is " FUNCTION LENGTH (MY-DATA) - " and " DATA-SIZE. - MOVE LENGTH OF MY-ELEMENT-1 TO DATA-SIZE. - DISPLAY "MY-ELEMENT-1 is " FUNCTION LENGTH (MY-ELEMENT-1) - " and " DATA-SIZE. - MOVE LENGTH OF MY-TABLE TO DATA-SIZE. - DISPLAY "MY-TABLE is " LENGTH OF MY-TABLE - " and " DATA-SIZE. - MOVE LENGTH OF MY-TABLE(1) TO DATA-SIZE. - DISPLAY "MY-TABLE(1) is " FUNCTION LENGTH (MY-TABLE(1)) - " and " DATA-SIZE. - - MOVE LENGTH OF ODO-DATA TO DATA-SIZE. - DISPLAY "ODO-DATA a is " FUNCTION LENGTH (ODO-DATA) - " and " DATA-SIZE. - MOVE FUNCTION LENGTH (ODO-DATA) TO DATA-SIZE. - DISPLAY "ODO-DATA b is " LENGTH OF ODO-DATA - " and " DATA-SIZE. - MOVE LENGTH OF ODO-TABLE TO DATA-SIZE. - DISPLAY "ODO-TABLE is " LENGTH OF ODO-TABLE - " and " DATA-SIZE. - MOVE LENGTH OF ODO-TABLE(1) TO DATA-SIZE. - DISPLAY "ODO-TABLE(1) is " FUNCTION LENGTH (ODO-TABLE(1)) - " and " DATA-SIZE. - STOP RUN. -]) - -AT_CHECK([cobc -x -std=mf prog.cob ], [0], [], [prog.cob:28: warning: subscript missing for 'MY-ELEMENT-1' - defaulting to 1 -]) - -AT_CHECK([./prog], [0], [MY-LEN is 240 -MY-DATA is 240 and 240 -MY-ELEMENT-1 is 10 and 010 -MY-TABLE is 12 and 012 -MY-TABLE(1) is 12 and 012 -ODO-DATA a is 60 and 060 -ODO-DATA b is 60 and 060 -ODO-TABLE is 12 and 012 -ODO-TABLE(1) is 12 and 012 -], []) - -AT_CLEANUP - - -AT_SETUP([NO Subscript ACU]) -AT_KEYWORDS([ACU LENGTH]) -AT_SKIP_IF(true) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - CONFIGURATION SECTION. - DATA DIVISION. - WORKING-STORAGE SECTION. - - 01 DATA-SIZE PIC 999. - 01 MY-DATA. - 03 MY-TABLE OCCURS 20 TIMES. - 05 MY-ELEMENT-1 PIC X(10). - 05 MY-ELEMENT-2 PIC 99. - 78 MY-LEN VALUE LENGTH OF MY-DATA. - - 01 TBLX PIC 99 VALUE 5. - 01 ODO-DATA. - 03 ODO-TABLE OCCURS 1 TO 15 TIMES DEPENDING ON TBLX. - 05 ODO-ELEMENT-1 PIC X(10). - 05 ODO-ELEMENT-2 PIC 99. - - PROCEDURE DIVISION. - DISPLAY "MY-LEN is " MY-LEN. - MOVE LENGTH OF MY-DATA TO DATA-SIZE. - DISPLAY "MY-DATA is " FUNCTION LENGTH (MY-DATA) - " and " DATA-SIZE. - MOVE LENGTH OF MY-ELEMENT-1 TO DATA-SIZE. - DISPLAY "MY-ELEMENT-1 is " FUNCTION LENGTH (MY-ELEMENT-1) - " and " DATA-SIZE. - MOVE LENGTH OF MY-TABLE TO DATA-SIZE. - DISPLAY "MY-TABLE is " LENGTH OF MY-TABLE - " and " DATA-SIZE. - MOVE LENGTH OF MY-TABLE(1) TO DATA-SIZE. - DISPLAY "MY-TABLE(1) is " FUNCTION LENGTH (MY-TABLE(1)) - " and " DATA-SIZE. - - MOVE LENGTH OF ODO-DATA TO DATA-SIZE. - DISPLAY "ODO-DATA a is " FUNCTION LENGTH (ODO-DATA) - " and " DATA-SIZE. - MOVE FUNCTION LENGTH (ODO-DATA) TO DATA-SIZE. - DISPLAY "ODO-DATA b is " LENGTH OF ODO-DATA - " and " DATA-SIZE. - MOVE LENGTH OF ODO-TABLE TO DATA-SIZE. - DISPLAY "ODO-TABLE is " LENGTH OF ODO-TABLE - " and " DATA-SIZE. - MOVE LENGTH OF ODO-TABLE(1) TO DATA-SIZE. - DISPLAY "ODO-TABLE(1) is " FUNCTION LENGTH (ODO-TABLE(1)) - " and " DATA-SIZE. - STOP RUN. -]) - -AT_CHECK([cobc -x -std=acu prog.cob ], [0], [], [prog.cob:28: warning: subscript missing for 'MY-ELEMENT-1' - defaulting to 1 -]) - -AT_CHECK([./prog], [0], [MY-LEN is 0000000240 -MY-DATA is 0000000240 and 240 -MY-ELEMENT-1 is 0000000010 and 010 -MY-TABLE is 0000000240 and 240 -MY-TABLE(1) is 0000000012 and 012 -ODO-DATA a is 0000000060 and 180 -ODO-DATA b is 0000000180 and 060 -ODO-TABLE is 0000000180 and 180 -ODO-TABLE(1) is 0000000012 and 012 -], []) - -AT_CLEANUP - -AT_SETUP([IBM SYNC]) -AT_KEYWORDS([Numeric]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - CONFIGURATION SECTION. - DATA DIVISION. - FILE SECTION. - - WORKING-STORAGE SECTION. - - 77 VLEN PIC 99 VALUE 1. - 77 TESTMODE PIC 99 VALUE 1. - 77 TESTIDX PIC 99 VALUE 1. - 77 BIT-MODE PIC 99 VALUE 32. - 77 TESTNUM PIC 99 VALUE 0. - 77 TESTMAX PIC 99 VALUE 24. - 77 TESTCASE PIC 99 VALUE 0. - 77 TESTFAIL PIC 99 VALUE 0. - 77 TESTEND PIC X(15) VALUE " ". - 77 TESTNAME PIC X(10) VALUE " ". - 77 TESTRESULT PIC X(40) VALUE " ". - 77 TESTPTR USAGE POINTER. - - 01 TEST-MODES. - 05 FILLER PIC X(10) VALUE "MF". - 05 FILLER PIC X(10) VALUE "IBMCOMP". - 05 FILLER PIC X(10) VALUE "DEFAULT". - - 01 FILLER REDEFINES TEST-MODES. - 05 FILLER OCCURS 3 TIMES. - 10 TEST-MODE PIC X(10). - - 01 TEST-CASES. - 05 FILLER PIC X(10) VALUE "COMP-FLD1". - 05 FILLER PIC X(40) VALUE "xxxxx1". - 05 FILLER PIC X(40) VALUE "xxxxx11". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - - 05 FILLER PIC X(10) VALUE "COMP-FLD2". - 05 FILLER PIC X(40) VALUE "xxxxx22". - 05 FILLER PIC X(40) VALUE "xxxxxx22". - 05 FILLER PIC X(40) VALUE "xxxxxx22". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - - 05 FILLER PIC X(10) VALUE "COMP-FLDO". - 05 FILLER PIC X(40) VALUE "xxxxxxx11xxx22xxx33". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - - 05 FILLER PIC X(10) VALUE "COMP-FLDS". - 05 FILLER PIC X(40) VALUE "xxxxxxx11xxx22xxx33". - 05 FILLER PIC X(40) VALUE "xxxxxxxx11xxxx22xxxx33". - 05 FILLER PIC X(40) VALUE "xxxxxxxx11xxxx22xxxx33". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - - 05 FILLER PIC X(10) VALUE "COMP-FLD3". - 05 FILLER PIC X(40) VALUE "xxxxx123". - 05 FILLER PIC X(40) VALUE "xxxxxxxx1234". - 05 FILLER PIC X(40) VALUE "xxxxxxxx1234". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - - 05 FILLER PIC X(10) VALUE "COMP-FLDL". - 05 FILLER PIC X(40) VALUE "xxxxx1". - 05 FILLER PIC X(40) VALUE "xxxxxx12". - 05 FILLER PIC X(40) VALUE "xxxxx1". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - - 05 FILLER PIC X(10) VALUE "COMP-FLDR". - 05 FILLER PIC X(40) VALUE "xxxxx1". - 05 FILLER PIC X(40) VALUE "xxxxxx12". - 05 FILLER PIC X(40) VALUE "xxxxx1". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - - 05 FILLER PIC X(10) VALUE "COM1-FLD". - 05 FILLER PIC X(40) VALUE "xxxxx12xxx123xxx12345678". - 05 FILLER PIC X(40) VALUE "xxxxxx12xxxx1234xxxx12345678". - 05 FILLER PIC X(40) VALUE "xxxxxx12xxxx1234xxxxxxxx12345678". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE "xxxxxx12xxxx1234xxxx12345678". - - 05 FILLER PIC X(10) VALUE "COM2-FLD". - 05 FILLER PIC X(40) VALUE "xxxxx12345xxx1234567xxx12345678". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - - 05 FILLER PIC X(10) VALUE "COM3-FLD". - 05 FILLER PIC X(40) VALUE "xxxxx123xxx1234xxx1234567". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - - 05 FILLER PIC X(10) VALUE "COM4-FLD". - 05 FILLER PIC X(40) VALUE "x123456x1234x123456x123". - 05 FILLER PIC X(40) VALUE "xxxx12345678xxxx1234x12345678x1234". - 05 FILLER PIC X(40) - VALUE "xxxxxxxx12345678xxxx1234x12345678x1234". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE "xxxx12345678xxxx1234x12345678x1234". - - 05 FILLER PIC X(10) VALUE "NOSYNC". - 05 FILLER PIC X(40) VALUE "x123456x123". - 05 FILLER PIC X(40) VALUE "x12345678x1234". - 05 FILLER PIC X(40) VALUE "x12345678x1234". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - - 05 FILLER PIC X(10) VALUE "SYNC". - 05 FILLER PIC X(40) VALUE "x123456x1234". - 05 FILLER PIC X(40) VALUE "xxxx12345678xxxx1234". - 05 FILLER PIC X(40) VALUE "xxxxxxxx12345678xxxx1234". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE "xxxx12345678xxxx1234". - - 05 FILLER PIC X(10) VALUE "COMP-3". - 05 FILLER PIC X(40) VALUE "x1234567x1234". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - - 05 FILLER PIC X(10) VALUE "COMP-1". - 05 FILLER PIC X(40) VALUE "12341234". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - - 05 FILLER PIC X(10) VALUE "COMP-2". - 05 FILLER PIC X(40) VALUE "1234567812345678". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - - 05 FILLER PIC X(10) VALUE "SIGN L/T". - 05 FILLER PIC X(40) VALUE "x-01x02-x-03x04-". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - - 05 FILLER PIC X(10) VALUE "COMP-X". - 05 FILLER PIC X(40) VALUE "x123x1234567x1234x12345678". - 05 FILLER PIC X(40) VALUE "x123x1234567xxxx1234xxxx12345678". - 05 FILLER PIC X(40) VALUE "x123x1234567xxxx1234xxxx12345678". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - - 05 FILLER PIC X(10) VALUE "BIN-SHORT". - 05 FILLER PIC X(40) VALUE "x12xx12". - 05 FILLER PIC X(40) VALUE "x12xx12". - 05 FILLER PIC X(40) VALUE "x12xx12". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - - 05 FILLER PIC X(10) VALUE "BIN-DBL". - 05 FILLER PIC X(40) VALUE "x12345678x12345678". - 05 FILLER PIC X(40) VALUE "x12345678x12345678". - 05 FILLER PIC X(40) VALUE "x12345678x12345678". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE "x12345678xxx12345678". - - 05 FILLER PIC X(10) VALUE "BIN-LNG". - 05 FILLER PIC X(40) VALUE "x1234x1234". - 05 FILLER PIC X(40) VALUE "x1234x1234". - 05 FILLER PIC X(40) VALUE "x1234x1234". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE "x1234xxx1234". - - 05 FILLER PIC X(10) VALUE "COMP-5". - 05 FILLER PIC X(40) VALUE "x12345678x12345678". - 05 FILLER PIC X(40) VALUE "x12345678xxx12345678". - 05 FILLER PIC X(40) VALUE "x12345678xxxxxxx12345678". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE "x12345678xxx12345678". - - 05 FILLER PIC X(10) VALUE "CMP-1". - 05 FILLER PIC X(40) VALUE "x1234x1234". - 05 FILLER PIC X(40) VALUE "x1234xxx1234". - 05 FILLER PIC X(40) VALUE "x1234xxx1234". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - - 05 FILLER PIC X(10) VALUE "CMP-2". - 05 FILLER PIC X(40) VALUE "x12345678x12345678". - 05 FILLER PIC X(40) VALUE "x12345678xxxxxxx12345678". - 05 FILLER PIC X(40) VALUE "x12345678xxxxxxx12345678". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE "x12345678xxx12345678". - - 01 FILLER REDEFINES TEST-CASES. - 05 FILLER OCCURS 24 TIMES. - 10 TEST-NAME PIC X(10). - 10 TEST-RESULTS. - 15 MF-64RESULT PIC X(40). - 15 IBM-64RESULT PIC X(40). - 15 C2002-64RESULT PIC X(40). - 15 MF-32RESULT PIC X(40). - 15 IBM-32RESULT PIC X(40). - 15 C2002-32RESULT PIC X(40). - 10 FILLER REDEFINES TEST-RESULTS. - 15 TEST-RESULT PIC X(40) OCCURS 6 TIMES. - - 01 TESTRECORD PIC X(40). - - 01 FILLER REDEFINES TESTRECORD. - 02 TSTREC1. - 10 FILLER PICTURE X(5). - 10 COMP-FLD1 PICTURE S9(2) COMP-4. - 10 FILLER PICTURE X(5). - - 01 FILLER REDEFINES TESTRECORD. - 02 TSTREC2. - 10 FILLER PICTURE X(5). - 10 COMP-FLD2 PICTURE S9(4) COMP-4 SYNC . - - 01 FILLER REDEFINES TESTRECORD. - 02 TSTREC3. - 10 FILLER PICTURE X(5). - 10 COMP-FLD3 PICTURE S9(6) COMP-4 SYNC. - 10 FILLER PICTURE X(5). - - 01 FILLER REDEFINES TESTRECORD. - 02 TSTRECL. - 10 FILLER PICTURE X(5). - 10 COMP-FLDL PICTURE S9(2) COMP-4 SYNC LEFT. - 10 FILLER PICTURE X(5). - - 01 FILLER REDEFINES TESTRECORD. - 02 TSTRECR. - 10 FILLER PICTURE X(5). - 10 COMP-FLDR PICTURE S9(2) COMP-4 SYNC RIGHT. - 10 FILLER PICTURE X(5). - - 01 FILLER REDEFINES TESTRECORD. - 02 TSTRECS. - 10 FILLER PICTURE X(5). - 10 FILLER OCCURS 3 TIMES. - 15 FILLER PICTURE X(2). - 15 COMP-FLDS PICTURE S9(4) COMP-4 SYNC . - 15 FILLER PICTURE X(1). - 10 FILLER PICTURE X(1). - - 01 FILLER REDEFINES TESTRECORD. - 02 TSTRECO. - 10 FILLER PICTURE X(5). - 10 FILLER OCCURS 3 TIMES. - 15 FILLER PICTURE X(2). - 15 COMP-FLDO PICTURE S9(4) COMP-4 . - 15 FILLER PICTURE X(1). - 10 FILLER PICTURE X(1). - - 01 FILLER REDEFINES TESTRECORD. - 02 TSTGRP. - 05 GRP1. - 10 FILLER PICTURE X(5). - 10 COM1-FLD1 PICTURE S9(4) SYNC COMP-4. - 10 FILLER PICTURE X(3). - 10 COM1-FLD2 PICTURE S9(6) SYNC COMP-4. - 10 FILLER PICTURE X(3). - 10 COM1-FLD3 PICTURE S9(18) SYNC COMP-4. - - 01 FILLER REDEFINES TESTRECORD. - 02 TSTGRP2 SIGN LEADING SEPARATE. - 05 GRP2-1. - 10 FILLER PICTURE X(5). - 10 COM2-FLD1 PICTURE S9(4). - 10 FILLER PICTURE X(3). - 10 COM2-FLD2 PICTURE S9(6) SIGN TRAILING SEPARATE. - 10 FILLER PICTURE X(3). - 10 COM2-FLD3 PICTURE S9(7). - - 01 FILLER REDEFINES TESTRECORD. - 02 TSTGRP3. - 05 GRP3-1. - 10 FILLER PICTURE X(5). - 10 COM3-FLD1 PICTURE S9(4) COMP-3. - 10 FILLER PICTURE X(3). - 10 COM3-FLD2 PICTURE S9(6) COMP-3. - 10 FILLER PICTURE X(3). - 05 GRP3-2. - 10 COM3-FLD3 PICTURE S9(13) COMP-3. - - 01 FILLER REDEFINES TESTRECORD. - 02 TSTGRP4. - 05 GRP4-1. - 10 FILLER PICTURE X(1). - 10 COM4-FLD1 PICTURE S9(13) COMP-4 SYNC. - 10 FILLER PICTURE X(1). - 10 COM4-FLD2 PICTURE S9(7) COMP-4 SYNC. - 10 FILLER PICTURE X(1). - 05 GRP4-2. - 10 COM4-FLD3 PICTURE S9(13) COMP-4. - 10 FILLER PICTURE X(1). - 10 COM4-FLD4 PICTURE S9(6) COMP-4. - 10 FILLER PICTURE X(1). - - 01 FILLER REDEFINES TESTRECORD. - 02 TSTGRP5. - 10 FILLER PICTURE X(1). - 10 COM5-FLD1 PICTURE S9(13) COMP-4. - 10 FILLER PICTURE X(1). - 10 COM5-FLD2 PICTURE S9(6) COMP-4. - 10 FILLER PICTURE X(1). - - 01 FILLER REDEFINES TESTRECORD. - 02 TSTGRP5S. - 10 FILLER PICTURE X(1). - 10 COM5S-FLD1 PICTURE S9(13) COMP-4 SYNC. - 10 FILLER PICTURE X(1). - 10 COM5S-FLD2 PICTURE S9(7) COMP-4 SYNC. - 10 FILLER PICTURE X(1). - - 01 FILLER REDEFINES TESTRECORD. - 02 TSTGRP6 COMP-3. - 10 FILLER PICTURE 9(1). - 10 COM6-FLD1 PICTURE S9(13). - 10 FILLER PICTURE 9(1). - 10 COM6-FLD2 PICTURE S9(6). - 10 FILLER PICTURE 9(1). - - 01 FILLER REDEFINES TESTRECORD. - 02 TSTGRP7 COMP-1. - 10 COM7-FLD1 . - 10 COM7-FLD2 . - - 01 FILLER REDEFINES TESTRECORD. - 02 TSTGRP8 COMP-2. - 10 COM8-FLD1 . - 10 COM8-FLD2 . - - 01 FILLER REDEFINES TESTRECORD. - 02 TSTGRP9. - 05 GRP9-1 SIGN LEADING SEPARATE. - 10 FILLER PICTURE X(1). - 10 COM9-FLD1 PICTURE S9(2). - 10 FILLER PICTURE X(1). - 10 COM9-FLD2 PICTURE S9(2) SIGN TRAILING SEPARATE. - 10 FILLER PICTURE X(1). - 05 GRP9-2 SIGN TRAILING SEPARATE. - 10 COM9-FLD3 PICTURE S9(2) SIGN LEADING SEPARATE. - 10 FILLER PICTURE X(1). - 10 COM9-FLD4 PICTURE S9(2). - 10 FILLER PICTURE X(1). - - 01 FILLER REDEFINES TESTRECORD. - 02 TSTGRPX. - 10 FILLER PICTURE X(1). - 10 COMX-FLD1 PICTURE X(3) COMP-X SYNC. - 10 FILLER PICTURE X(1). - 10 COMX-FLD2 PICTURE X(7) COMP-X. - 10 FILLER PICTURE X(1). - 10 COMX-FLT COMP-1 SYNC. - 10 FILLER PICTURE X(1). - 10 COMX-DBL COMP-2 SYNC. - 10 FILLER PICTURE X(1). - - 01 FILLER REDEFINES TESTRECORD. - 02 TST-BSHORT. - 10 FILLER PICTURE X(1). - 10 COMS-FLD1 BINARY-SHORT. - 10 FILLER PICTURE X(2). - 10 COMS-FLD2 BINARY-SHORT SYNC. - 10 FILLER PICTURE X(1). - - 01 FILLER REDEFINES TESTRECORD. - 02 TST-BLONG. - 10 FILLER PICTURE X(1). - 10 COML-FLD1 BINARY-LONG. - 10 FILLER PICTURE X(1). - 10 COML-FLD2 BINARY-LONG SYNC. - 10 FILLER PICTURE X(1). - - 01 FILLER REDEFINES TESTRECORD. - 02 TST-BDBL. - 10 FILLER PICTURE X(1). - 10 COMD-FLD1 BINARY-DOUBLE. - 10 FILLER PICTURE X(1). - 10 COMD-FLD2 BINARY-DOUBLE SYNC. - 10 FILLER PICTURE X(1). - - 01 FILLER REDEFINES TESTRECORD. - 02 TST-BLNG. - 10 FILLER PICTURE X(1). - 10 COMBL-FLD1 BINARY-LONG. - 10 FILLER PICTURE X(1). - 10 COMBL-FLD2 BINARY-LONG SYNC. - 10 FILLER PICTURE X(1). - - 01 FILLER REDEFINES TESTRECORD. - 02 TST-CMP5. - 10 FILLER PICTURE X(1). - 10 CMP5-FLD1 PIC 9(18) COMP-5. - 10 FILLER PICTURE X(1). - 10 CMP5-FLD2 PIC 9(18) COMP-5 SYNC. - 10 FILLER PICTURE X(1). - - 01 FILLER REDEFINES TESTRECORD. - 02 TST-CMP1. - 10 FILLER PICTURE X(1). - 10 CMP1-FLD1 COMP-1. - 10 FILLER PICTURE X(1). - 10 CMP1-FLD2 COMP-1 SYNC. - 10 FILLER PICTURE X(1). - - 01 FILLER REDEFINES TESTRECORD. - 02 TST-CMP2. - 10 FILLER PICTURE X(1). - 10 CMP2-FLD1 COMP-2. - 10 FILLER PICTURE X(1). - 10 CMP2-FLD2 COMP-2 SYNC. - 10 FILLER PICTURE X(1). - - PROCEDURE DIVISION. - - MOVE LENGTH OF TESTPTR TO VLEN. - IF VLEN EQUAL 8 - MOVE 64 TO BIT-MODE - ELSE - MOVE 32 TO BIT-MODE. - MOVE ALL "x" TO TESTRECORD. - MOVE 1 TO TESTMODE. - MOVE ALL "x" TO TSTREC2. - MOVE "22" TO COMP-FLD2 (1:). - IF TSTREC2 = 'xxxxxx22' - MOVE 3 TO TESTMODE. - MOVE "12345678" TO COML-FLD2 (1:). - IF COML-FLD2 = 875770417 - MOVE "Little-Endian" TO TESTEND - ELSE - MOVE "Big-Endian" TO TESTEND - END-IF. - MOVE LENGTH OF COMP-FLD1 TO VLEN. - IF VLEN = 2 - MOVE 2 TO TESTMODE. - MOVE ALL "x" TO TESTRECORD. - - MOVE "COMP-FLD1" TO TESTNAME. - MOVE "11" TO COMP-FLD1 (1:). - PERFORM CHECK-IT. - - MOVE "COMP-FLD2" TO TESTNAME. - MOVE "22" TO COMP-FLD2 (1:). - PERFORM CHECK-IT. - - MOVE "COMP-FLDO" TO TESTNAME. - MOVE "11" TO COMP-FLDO (1) (1:2) - MOVE "22" TO COMP-FLDO (2) (1:2) - MOVE "33" TO COMP-FLDO (3) (1:2) - PERFORM CHECK-IT. - - MOVE "COMP-FLDS" TO TESTNAME. - MOVE "11" TO COMP-FLDS (1) (1:2) - MOVE "22" TO COMP-FLDS (2) (1:2) - MOVE "33" TO COMP-FLDS (3) (1:2) - PERFORM CHECK-IT. - - MOVE "COMP-FLD3" TO TESTNAME. - MOVE "1234678" TO COMP-FLD3 (1:). - PERFORM CHECK-IT. - - MOVE "COMP-FLDL" TO TESTNAME. - MOVE "12345678" TO COMP-FLDL (1:). - PERFORM CHECK-IT. - - MOVE "COMP-FLDR" TO TESTNAME. - MOVE "12345678" TO COMP-FLDR (1:). - PERFORM CHECK-IT. - - MOVE "COM1-FLD" TO TESTNAME. - MOVE "12345678" TO COM1-FLD1 (1:). - MOVE "12345678" TO COM1-FLD2 (1:). - MOVE "12345678" TO COM1-FLD3 (1:). - PERFORM CHECK-IT. - - MOVE "COM2-FLD" TO TESTNAME. - MOVE "12345678" TO COM2-FLD1 (1:). - MOVE "12345678" TO COM2-FLD2 (1:). - MOVE "12345678" TO COM2-FLD3 (1:). - PERFORM CHECK-IT. - - MOVE "COM3-FLD" TO TESTNAME. - MOVE "12345678" TO COM3-FLD1 (1:). - MOVE "12345678" TO COM3-FLD2 (1:). - MOVE "12345678" TO COM3-FLD3 (1:). - PERFORM CHECK-IT. - - MOVE "COM4-FLD" TO TESTNAME. - MOVE "12345678" TO COM4-FLD1 (1:). - MOVE "12345678" TO COM4-FLD2 (1:). - MOVE "12345678" TO COM4-FLD3 (1:). - MOVE "12345678" TO COM4-FLD4 (1:). - PERFORM CHECK-IT. - - MOVE "NOSYNC" TO TESTNAME. - MOVE "12345678" TO COM5-FLD1 (1:). - MOVE "12345678" TO COM5-FLD2 (1:). - PERFORM CHECK-IT. - - MOVE "SYNC" TO TESTNAME. - MOVE "12345678" TO COM5S-FLD1 (1:). - MOVE "12345678" TO COM5S-FLD2 (1:). - PERFORM CHECK-IT. - - MOVE "COMP-3" TO TESTNAME. - MOVE "12345678" TO COM6-FLD1 (1:). - MOVE "12345678" TO COM6-FLD2 (1:). - PERFORM CHECK-IT. - - MOVE "COMP-1" TO TESTNAME. - MOVE "12345678" TO COM7-FLD1 (1:). - MOVE "12345678" TO COM7-FLD2 (1:). - PERFORM CHECK-IT. - - MOVE "COMP-2" TO TESTNAME. - MOVE "12345678" TO COM8-FLD1 (1:). - MOVE "12345678" TO COM8-FLD2 (1:). - PERFORM CHECK-IT. - - MOVE "SIGN L/T" TO TESTNAME. - MOVE -1 TO COM9-FLD1 . - MOVE -2 TO COM9-FLD2 . - MOVE -3 TO COM9-FLD3 . - MOVE -4 TO COM9-FLD4 . - PERFORM CHECK-IT. - - MOVE "COMP-X" TO TESTNAME. - MOVE "12345678" TO COMX-FLD1 (1:). - MOVE "12345678" TO COMX-FLD2 (1:). - MOVE "12345678" TO COMX-FLT (1:). - MOVE "12345678" TO COMX-DBL (1:). - PERFORM CHECK-IT. - - MOVE "BIN-SHORT" TO TESTNAME. - MOVE "12345678" TO COMS-FLD1 (1:). - MOVE "12345678" TO COMS-FLD2 (1:). - PERFORM CHECK-IT. - - MOVE "BIN-DBL" TO TESTNAME. - MOVE "12345678" TO COMD-FLD1 (1:). - MOVE "12345678" TO COMD-FLD2 (1:). - PERFORM CHECK-IT. - - MOVE "BIN-LNG" TO TESTNAME. - MOVE "12345678" TO COMBL-FLD1 (1:). - MOVE "12345678" TO COMBL-FLD2 (1:). - PERFORM CHECK-IT. - - MOVE "COMP-5" TO TESTNAME. - MOVE "12345678" TO CMP5-FLD1 (1:). - MOVE "12345678" TO CMP5-FLD2 (1:). - PERFORM CHECK-IT. - - MOVE "CMP-1" TO TESTNAME. - MOVE "12345678" TO CMP1-FLD1 (1:). - MOVE "12345678" TO CMP1-FLD2 (1:). - PERFORM CHECK-IT. - - MOVE "CMP-2" TO TESTNAME. - MOVE "12345678" TO CMP2-FLD1 (1:). - MOVE "12345678" TO CMP2-FLD2 (1:). - PERFORM CHECK-IT. - - DISPLAY TEST-MODE (TESTMODE) - TESTCASE " tests with " TESTFAIL " failed". - STOP RUN RETURNING 0. - - CHECK-IT SECTION. - CHECK-01. - INSPECT TESTRECORD REPLACING TRAILING 'x' BY ' '. - ADD 1 TO TESTCASE. - PERFORM VARYING TESTNUM FROM 1 BY 1 - UNTIL TEST-NAME (TESTNUM) = TESTNAME - OR TESTNUM > TESTMAX - CONTINUE - END-PERFORM. - IF TESTNUM > TESTMAX - DISPLAY TESTNAME " :NOT FOUND" - DISPLAY " : GOT: " TESTRECORD ":" - ADD 1 TO TESTFAIL - MOVE ALL "x" TO TESTRECORD - GO TO CHECK-EXIT - END-IF. - MOVE TEST-RESULT (TESTNUM, TESTMODE) TO TESTRESULT. - COMPUTE TESTIDX = TESTMODE + 3. - IF BIT-MODE = 32 - AND TEST-RESULT (TESTNUM, TESTIDX) NOT = SPACES - MOVE TEST-RESULT (TESTNUM, TESTIDX) TO TESTRESULT. - IF TESTRESULT = SPACES - MOVE TEST-RESULT (TESTNUM, 1) TO TESTRESULT. - IF TESTRESULT NOT = TESTRECORD - DISPLAY TESTNAME - " :FAILED: Mode " BIT-MODE - " " TEST-MODE (TESTMODE) - ", Case " TESTCASE ", " TESTEND - DISPLAY " : GOT: " TESTRECORD ":" - DISPLAY " :EXPECT: " TESTRESULT ":" - ADD 1 TO TESTFAIL - END-IF. - MOVE ALL "x" TO TESTRECORD. - CHECK-EXIT. - EXIT. - -]) - -AT_CHECK([cobc -x -std=ibm -w prog.cob ], [0], [], []) - -AT_CHECK([./prog], [0], [IBMCOMP 24 tests with 00 failed -], []) - -AT_CLEANUP - - -AT_SETUP([MF IBMCOMP SYNC]) -AT_KEYWORDS([Numeric]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - CONFIGURATION SECTION. - DATA DIVISION. - FILE SECTION. - - WORKING-STORAGE SECTION. - - 77 VLEN PIC 99 VALUE 1. - 77 TESTMODE PIC 99 VALUE 1. - 77 TESTIDX PIC 99 VALUE 1. - 77 BIT-MODE PIC 99 VALUE 32. - 77 TESTNUM PIC 99 VALUE 0. - 77 TESTMAX PIC 99 VALUE 24. - 77 TESTCASE PIC 99 VALUE 0. - 77 TESTFAIL PIC 99 VALUE 0. - 77 TESTEND PIC X(15) VALUE " ". - 77 TESTNAME PIC X(10) VALUE " ". - 77 TESTRESULT PIC X(40) VALUE " ". - 77 TESTPTR USAGE POINTER. - - 01 TEST-MODES. - 05 FILLER PIC X(10) VALUE "MF". - 05 FILLER PIC X(10) VALUE "IBMCOMP". - 05 FILLER PIC X(10) VALUE "DEFAULT". - - 01 FILLER REDEFINES TEST-MODES. - 05 FILLER OCCURS 3 TIMES. - 10 TEST-MODE PIC X(10). - - 01 TEST-CASES. - 05 FILLER PIC X(10) VALUE "COMP-FLD1". - 05 FILLER PIC X(40) VALUE "xxxxx1". - 05 FILLER PIC X(40) VALUE "xxxxx11". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - - 05 FILLER PIC X(10) VALUE "COMP-FLD2". - 05 FILLER PIC X(40) VALUE "xxxxx22". - 05 FILLER PIC X(40) VALUE "xxxxxx22". - 05 FILLER PIC X(40) VALUE "xxxxxx22". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - - 05 FILLER PIC X(10) VALUE "COMP-FLDO". - 05 FILLER PIC X(40) VALUE "xxxxxxx11xxx22xxx33". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - - 05 FILLER PIC X(10) VALUE "COMP-FLDS". - 05 FILLER PIC X(40) VALUE "xxxxxxx11xxx22xxx33". - 05 FILLER PIC X(40) VALUE "xxxxxxxx11xxxx22xxxx33". - 05 FILLER PIC X(40) VALUE "xxxxxxxx11xxxx22xxxx33". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - - 05 FILLER PIC X(10) VALUE "COMP-FLD3". - 05 FILLER PIC X(40) VALUE "xxxxx123". - 05 FILLER PIC X(40) VALUE "xxxxxxxx1234". - 05 FILLER PIC X(40) VALUE "xxxxxxxx1234". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - - 05 FILLER PIC X(10) VALUE "COMP-FLDL". - 05 FILLER PIC X(40) VALUE "xxxxx1". - 05 FILLER PIC X(40) VALUE "xxxxxx12". - 05 FILLER PIC X(40) VALUE "xxxxx1". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - - 05 FILLER PIC X(10) VALUE "COMP-FLDR". - 05 FILLER PIC X(40) VALUE "xxxxx1". - 05 FILLER PIC X(40) VALUE "xxxxxx12". - 05 FILLER PIC X(40) VALUE "xxxxx1". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - - 05 FILLER PIC X(10) VALUE "COM1-FLD". - 05 FILLER PIC X(40) VALUE "xxxxx12xxx123xxx12345678". - 05 FILLER PIC X(40) VALUE "xxxxxx12xxxx1234xxxx12345678". - 05 FILLER PIC X(40) VALUE "xxxxxx12xxxx1234xxxxxxxx12345678". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE "xxxxxx12xxxx1234xxxx12345678". - - 05 FILLER PIC X(10) VALUE "COM2-FLD". - 05 FILLER PIC X(40) VALUE "xxxxx12345xxx1234567xxx12345678". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - - 05 FILLER PIC X(10) VALUE "COM3-FLD". - 05 FILLER PIC X(40) VALUE "xxxxx123xxx1234xxx1234567". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - - 05 FILLER PIC X(10) VALUE "COM4-FLD". - 05 FILLER PIC X(40) VALUE "x123456x1234x123456x123". - 05 FILLER PIC X(40) VALUE "xxxx12345678xxxx1234x12345678x1234". - 05 FILLER PIC X(40) - VALUE "xxxxxxxx12345678xxxx1234x12345678x1234". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE "xxxx12345678xxxx1234x12345678x1234". - - 05 FILLER PIC X(10) VALUE "NOSYNC". - 05 FILLER PIC X(40) VALUE "x123456x123". - 05 FILLER PIC X(40) VALUE "x12345678x1234". - 05 FILLER PIC X(40) VALUE "x12345678x1234". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - - 05 FILLER PIC X(10) VALUE "SYNC". - 05 FILLER PIC X(40) VALUE "x123456x1234". - 05 FILLER PIC X(40) VALUE "xxxx12345678xxxx1234". - 05 FILLER PIC X(40) VALUE "xxxxxxxx12345678xxxx1234". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE "xxxx12345678xxxx1234". - - 05 FILLER PIC X(10) VALUE "COMP-3". - 05 FILLER PIC X(40) VALUE "x1234567x1234". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - - 05 FILLER PIC X(10) VALUE "COMP-1". - 05 FILLER PIC X(40) VALUE "12341234". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - - 05 FILLER PIC X(10) VALUE "COMP-2". - 05 FILLER PIC X(40) VALUE "1234567812345678". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - - 05 FILLER PIC X(10) VALUE "SIGN L/T". - 05 FILLER PIC X(40) VALUE "x-01x02-x-03x04-". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - - 05 FILLER PIC X(10) VALUE "COMP-X". - 05 FILLER PIC X(40) VALUE "x123x1234567x1234x12345678". - 05 FILLER PIC X(40) VALUE "x123x1234567xxxx1234xxxx12345678". - 05 FILLER PIC X(40) VALUE "x123x1234567xxxx1234xxxx12345678". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - - 05 FILLER PIC X(10) VALUE "BIN-SHORT". - 05 FILLER PIC X(40) VALUE "x12xx12". - 05 FILLER PIC X(40) VALUE "x12xx12". - 05 FILLER PIC X(40) VALUE "x12xx12". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - - 05 FILLER PIC X(10) VALUE "BIN-DBL". - 05 FILLER PIC X(40) VALUE "x12345678x12345678". - 05 FILLER PIC X(40) VALUE "x12345678x12345678". - 05 FILLER PIC X(40) VALUE "x12345678x12345678". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE "x12345678xxx12345678". - - 05 FILLER PIC X(10) VALUE "BIN-LNG". - 05 FILLER PIC X(40) VALUE "x1234x1234". - 05 FILLER PIC X(40) VALUE "x1234x1234". - 05 FILLER PIC X(40) VALUE "x1234x1234". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE "x1234xxx1234". - - 05 FILLER PIC X(10) VALUE "COMP-5". - 05 FILLER PIC X(40) VALUE "x12345678x12345678". - 05 FILLER PIC X(40) VALUE "x12345678xxx12345678". - 05 FILLER PIC X(40) VALUE "x12345678xxxxxxx12345678". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE "x12345678xxx12345678". - - 05 FILLER PIC X(10) VALUE "CMP-1". - 05 FILLER PIC X(40) VALUE "x1234x1234". - 05 FILLER PIC X(40) VALUE "x1234xxx1234". - 05 FILLER PIC X(40) VALUE "x1234xxx1234". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - - 05 FILLER PIC X(10) VALUE "CMP-2". - 05 FILLER PIC X(40) VALUE "x12345678x12345678". - 05 FILLER PIC X(40) VALUE "x12345678xxxxxxx12345678". - 05 FILLER PIC X(40) VALUE "x12345678xxxxxxx12345678". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE "x12345678xxx12345678". - - 01 FILLER REDEFINES TEST-CASES. - 05 FILLER OCCURS 24 TIMES. - 10 TEST-NAME PIC X(10). - 10 TEST-RESULTS. - 15 MF-64RESULT PIC X(40). - 15 IBM-64RESULT PIC X(40). - 15 C2002-64RESULT PIC X(40). - 15 MF-32RESULT PIC X(40). - 15 IBM-32RESULT PIC X(40). - 15 C2002-32RESULT PIC X(40). - 10 FILLER REDEFINES TEST-RESULTS. - 15 TEST-RESULT PIC X(40) OCCURS 6 TIMES. - - 01 TESTRECORD PIC X(40). - - 01 FILLER REDEFINES TESTRECORD. - 02 TSTREC1. - 10 FILLER PICTURE X(5). - 10 COMP-FLD1 PICTURE S9(2) COMP-4. - 10 FILLER PICTURE X(5). - - 01 FILLER REDEFINES TESTRECORD. - 02 TSTREC2. - 10 FILLER PICTURE X(5). - 10 COMP-FLD2 PICTURE S9(4) COMP-4 SYNC . - - 01 FILLER REDEFINES TESTRECORD. - 02 TSTREC3. - 10 FILLER PICTURE X(5). - 10 COMP-FLD3 PICTURE S9(6) COMP-4 SYNC. - 10 FILLER PICTURE X(5). - - 01 FILLER REDEFINES TESTRECORD. - 02 TSTRECL. - 10 FILLER PICTURE X(5). - 10 COMP-FLDL PICTURE S9(2) COMP-4 SYNC LEFT. - 10 FILLER PICTURE X(5). - - 01 FILLER REDEFINES TESTRECORD. - 02 TSTRECR. - 10 FILLER PICTURE X(5). - 10 COMP-FLDR PICTURE S9(2) COMP-4 SYNC RIGHT. - 10 FILLER PICTURE X(5). - - 01 FILLER REDEFINES TESTRECORD. - 02 TSTRECS. - 10 FILLER PICTURE X(5). - 10 FILLER OCCURS 3 TIMES. - 15 FILLER PICTURE X(2). - 15 COMP-FLDS PICTURE S9(4) COMP-4 SYNC . - 15 FILLER PICTURE X(1). - 10 FILLER PICTURE X(1). - - 01 FILLER REDEFINES TESTRECORD. - 02 TSTRECO. - 10 FILLER PICTURE X(5). - 10 FILLER OCCURS 3 TIMES. - 15 FILLER PICTURE X(2). - 15 COMP-FLDO PICTURE S9(4) COMP-4 . - 15 FILLER PICTURE X(1). - 10 FILLER PICTURE X(1). - - 01 FILLER REDEFINES TESTRECORD. - 02 TSTGRP. - 05 GRP1. - 10 FILLER PICTURE X(5). - 10 COM1-FLD1 PICTURE S9(4) SYNC COMP-4. - 10 FILLER PICTURE X(3). - 10 COM1-FLD2 PICTURE S9(6) SYNC COMP-4. - 10 FILLER PICTURE X(3). - 10 COM1-FLD3 PICTURE S9(18) SYNC COMP-4. - - 01 FILLER REDEFINES TESTRECORD. - 02 TSTGRP2 SIGN LEADING SEPARATE. - 05 GRP2-1. - 10 FILLER PICTURE X(5). - 10 COM2-FLD1 PICTURE S9(4). - 10 FILLER PICTURE X(3). - 10 COM2-FLD2 PICTURE S9(6) SIGN TRAILING SEPARATE. - 10 FILLER PICTURE X(3). - 10 COM2-FLD3 PICTURE S9(7). - - 01 FILLER REDEFINES TESTRECORD. - 02 TSTGRP3. - 05 GRP3-1. - 10 FILLER PICTURE X(5). - 10 COM3-FLD1 PICTURE S9(4) COMP-3. - 10 FILLER PICTURE X(3). - 10 COM3-FLD2 PICTURE S9(6) COMP-3. - 10 FILLER PICTURE X(3). - 05 GRP3-2. - 10 COM3-FLD3 PICTURE S9(13) COMP-3. - - 01 FILLER REDEFINES TESTRECORD. - 02 TSTGRP4. - 05 GRP4-1. - 10 FILLER PICTURE X(1). - 10 COM4-FLD1 PICTURE S9(13) COMP-4 SYNC. - 10 FILLER PICTURE X(1). - 10 COM4-FLD2 PICTURE S9(7) COMP-4 SYNC. - 10 FILLER PICTURE X(1). - 05 GRP4-2. - 10 COM4-FLD3 PICTURE S9(13) COMP-4. - 10 FILLER PICTURE X(1). - 10 COM4-FLD4 PICTURE S9(6) COMP-4. - 10 FILLER PICTURE X(1). - - 01 FILLER REDEFINES TESTRECORD. - 02 TSTGRP5. - 10 FILLER PICTURE X(1). - 10 COM5-FLD1 PICTURE S9(13) COMP-4. - 10 FILLER PICTURE X(1). - 10 COM5-FLD2 PICTURE S9(6) COMP-4. - 10 FILLER PICTURE X(1). - - 01 FILLER REDEFINES TESTRECORD. - 02 TSTGRP5S. - 10 FILLER PICTURE X(1). - 10 COM5S-FLD1 PICTURE S9(13) COMP-4 SYNC. - 10 FILLER PICTURE X(1). - 10 COM5S-FLD2 PICTURE S9(7) COMP-4 SYNC. - 10 FILLER PICTURE X(1). - - 01 FILLER REDEFINES TESTRECORD. - 02 TSTGRP6 COMP-3. - 10 FILLER PICTURE 9(1). - 10 COM6-FLD1 PICTURE S9(13). - 10 FILLER PICTURE 9(1). - 10 COM6-FLD2 PICTURE S9(6). - 10 FILLER PICTURE 9(1). - - 01 FILLER REDEFINES TESTRECORD. - 02 TSTGRP7 COMP-1. - 10 COM7-FLD1 . - 10 COM7-FLD2 . - - 01 FILLER REDEFINES TESTRECORD. - 02 TSTGRP8 COMP-2. - 10 COM8-FLD1 . - 10 COM8-FLD2 . - - 01 FILLER REDEFINES TESTRECORD. - 02 TSTGRP9. - 05 GRP9-1 SIGN LEADING SEPARATE. - 10 FILLER PICTURE X(1). - 10 COM9-FLD1 PICTURE S9(2). - 10 FILLER PICTURE X(1). - 10 COM9-FLD2 PICTURE S9(2) SIGN TRAILING SEPARATE. - 10 FILLER PICTURE X(1). - 05 GRP9-2 SIGN TRAILING SEPARATE. - 10 COM9-FLD3 PICTURE S9(2) SIGN LEADING SEPARATE. - 10 FILLER PICTURE X(1). - 10 COM9-FLD4 PICTURE S9(2). - 10 FILLER PICTURE X(1). - - 01 FILLER REDEFINES TESTRECORD. - 02 TSTGRPX. - 10 FILLER PICTURE X(1). - 10 COMX-FLD1 PICTURE X(3) COMP-X SYNC. - 10 FILLER PICTURE X(1). - 10 COMX-FLD2 PICTURE X(7) COMP-X. - 10 FILLER PICTURE X(1). - 10 COMX-FLT COMP-1 SYNC. - 10 FILLER PICTURE X(1). - 10 COMX-DBL COMP-2 SYNC. - 10 FILLER PICTURE X(1). - - 01 FILLER REDEFINES TESTRECORD. - 02 TST-BSHORT. - 10 FILLER PICTURE X(1). - 10 COMS-FLD1 BINARY-SHORT. - 10 FILLER PICTURE X(2). - 10 COMS-FLD2 BINARY-SHORT SYNC. - 10 FILLER PICTURE X(1). - - 01 FILLER REDEFINES TESTRECORD. - 02 TST-BLONG. - 10 FILLER PICTURE X(1). - 10 COML-FLD1 BINARY-LONG. - 10 FILLER PICTURE X(1). - 10 COML-FLD2 BINARY-LONG SYNC. - 10 FILLER PICTURE X(1). - - 01 FILLER REDEFINES TESTRECORD. - 02 TST-BDBL. - 10 FILLER PICTURE X(1). - 10 COMD-FLD1 BINARY-DOUBLE. - 10 FILLER PICTURE X(1). - 10 COMD-FLD2 BINARY-DOUBLE SYNC. - 10 FILLER PICTURE X(1). - - 01 FILLER REDEFINES TESTRECORD. - 02 TST-BLNG. - 10 FILLER PICTURE X(1). - 10 COMBL-FLD1 BINARY-LONG. - 10 FILLER PICTURE X(1). - 10 COMBL-FLD2 BINARY-LONG SYNC. - 10 FILLER PICTURE X(1). - - 01 FILLER REDEFINES TESTRECORD. - 02 TST-CMP5. - 10 FILLER PICTURE X(1). - 10 CMP5-FLD1 PIC 9(18) COMP-5. - 10 FILLER PICTURE X(1). - 10 CMP5-FLD2 PIC 9(18) COMP-5 SYNC. - 10 FILLER PICTURE X(1). - - 01 FILLER REDEFINES TESTRECORD. - 02 TST-CMP1. - 10 FILLER PICTURE X(1). - 10 CMP1-FLD1 COMP-1. - 10 FILLER PICTURE X(1). - 10 CMP1-FLD2 COMP-1 SYNC. - 10 FILLER PICTURE X(1). - - 01 FILLER REDEFINES TESTRECORD. - 02 TST-CMP2. - 10 FILLER PICTURE X(1). - 10 CMP2-FLD1 COMP-2. - 10 FILLER PICTURE X(1). - 10 CMP2-FLD2 COMP-2 SYNC. - 10 FILLER PICTURE X(1). - - PROCEDURE DIVISION. - - MOVE LENGTH OF TESTPTR TO VLEN. - IF VLEN EQUAL 8 - MOVE 64 TO BIT-MODE - ELSE - MOVE 32 TO BIT-MODE. - MOVE ALL "x" TO TESTRECORD. - MOVE 1 TO TESTMODE. - MOVE ALL "x" TO TSTREC2. - MOVE "22" TO COMP-FLD2 (1:). - IF TSTREC2 = 'xxxxxx22' - MOVE 3 TO TESTMODE. - MOVE "12345678" TO COML-FLD2 (1:). - IF COML-FLD2 = 875770417 - MOVE "Little-Endian" TO TESTEND - ELSE - MOVE "Big-Endian" TO TESTEND - END-IF. - MOVE LENGTH OF COMP-FLD1 TO VLEN. - IF VLEN = 2 - MOVE 2 TO TESTMODE. - MOVE ALL "x" TO TESTRECORD. - - MOVE "COMP-FLD1" TO TESTNAME. - MOVE "11" TO COMP-FLD1 (1:). - PERFORM CHECK-IT. - - MOVE "COMP-FLD2" TO TESTNAME. - MOVE "22" TO COMP-FLD2 (1:). - PERFORM CHECK-IT. - - MOVE "COMP-FLDO" TO TESTNAME. - MOVE "11" TO COMP-FLDO (1) (1:2) - MOVE "22" TO COMP-FLDO (2) (1:2) - MOVE "33" TO COMP-FLDO (3) (1:2) - PERFORM CHECK-IT. - - MOVE "COMP-FLDS" TO TESTNAME. - MOVE "11" TO COMP-FLDS (1) (1:2) - MOVE "22" TO COMP-FLDS (2) (1:2) - MOVE "33" TO COMP-FLDS (3) (1:2) - PERFORM CHECK-IT. - - MOVE "COMP-FLD3" TO TESTNAME. - MOVE "1234678" TO COMP-FLD3 (1:). - PERFORM CHECK-IT. - - MOVE "COMP-FLDL" TO TESTNAME. - MOVE "12345678" TO COMP-FLDL (1:). - PERFORM CHECK-IT. - - MOVE "COMP-FLDR" TO TESTNAME. - MOVE "12345678" TO COMP-FLDR (1:). - PERFORM CHECK-IT. - - MOVE "COM1-FLD" TO TESTNAME. - MOVE "12345678" TO COM1-FLD1 (1:). - MOVE "12345678" TO COM1-FLD2 (1:). - MOVE "12345678" TO COM1-FLD3 (1:). - PERFORM CHECK-IT. - - MOVE "COM2-FLD" TO TESTNAME. - MOVE "12345678" TO COM2-FLD1 (1:). - MOVE "12345678" TO COM2-FLD2 (1:). - MOVE "12345678" TO COM2-FLD3 (1:). - PERFORM CHECK-IT. - - MOVE "COM3-FLD" TO TESTNAME. - MOVE "12345678" TO COM3-FLD1 (1:). - MOVE "12345678" TO COM3-FLD2 (1:). - MOVE "12345678" TO COM3-FLD3 (1:). - PERFORM CHECK-IT. - - MOVE "COM4-FLD" TO TESTNAME. - MOVE "12345678" TO COM4-FLD1 (1:). - MOVE "12345678" TO COM4-FLD2 (1:). - MOVE "12345678" TO COM4-FLD3 (1:). - MOVE "12345678" TO COM4-FLD4 (1:). - PERFORM CHECK-IT. - - MOVE "NOSYNC" TO TESTNAME. - MOVE "12345678" TO COM5-FLD1 (1:). - MOVE "12345678" TO COM5-FLD2 (1:). - PERFORM CHECK-IT. - - MOVE "SYNC" TO TESTNAME. - MOVE "12345678" TO COM5S-FLD1 (1:). - MOVE "12345678" TO COM5S-FLD2 (1:). - PERFORM CHECK-IT. - - MOVE "COMP-3" TO TESTNAME. - MOVE "12345678" TO COM6-FLD1 (1:). - MOVE "12345678" TO COM6-FLD2 (1:). - PERFORM CHECK-IT. - - MOVE "COMP-1" TO TESTNAME. - MOVE "12345678" TO COM7-FLD1 (1:). - MOVE "12345678" TO COM7-FLD2 (1:). - PERFORM CHECK-IT. - - MOVE "COMP-2" TO TESTNAME. - MOVE "12345678" TO COM8-FLD1 (1:). - MOVE "12345678" TO COM8-FLD2 (1:). - PERFORM CHECK-IT. - - MOVE "SIGN L/T" TO TESTNAME. - MOVE -1 TO COM9-FLD1 . - MOVE -2 TO COM9-FLD2 . - MOVE -3 TO COM9-FLD3 . - MOVE -4 TO COM9-FLD4 . - PERFORM CHECK-IT. - - MOVE "COMP-X" TO TESTNAME. - MOVE "12345678" TO COMX-FLD1 (1:). - MOVE "12345678" TO COMX-FLD2 (1:). - MOVE "12345678" TO COMX-FLT (1:). - MOVE "12345678" TO COMX-DBL (1:). - PERFORM CHECK-IT. - - MOVE "BIN-SHORT" TO TESTNAME. - MOVE "12345678" TO COMS-FLD1 (1:). - MOVE "12345678" TO COMS-FLD2 (1:). - PERFORM CHECK-IT. - - MOVE "BIN-DBL" TO TESTNAME. - MOVE "12345678" TO COMD-FLD1 (1:). - MOVE "12345678" TO COMD-FLD2 (1:). - PERFORM CHECK-IT. - - MOVE "BIN-LNG" TO TESTNAME. - MOVE "12345678" TO COMBL-FLD1 (1:). - MOVE "12345678" TO COMBL-FLD2 (1:). - PERFORM CHECK-IT. - - MOVE "COMP-5" TO TESTNAME. - MOVE "12345678" TO CMP5-FLD1 (1:). - MOVE "12345678" TO CMP5-FLD2 (1:). - PERFORM CHECK-IT. - - MOVE "CMP-1" TO TESTNAME. - MOVE "12345678" TO CMP1-FLD1 (1:). - MOVE "12345678" TO CMP1-FLD2 (1:). - PERFORM CHECK-IT. - - MOVE "CMP-2" TO TESTNAME. - MOVE "12345678" TO CMP2-FLD1 (1:). - MOVE "12345678" TO CMP2-FLD2 (1:). - PERFORM CHECK-IT. - - DISPLAY TEST-MODE (TESTMODE) - TESTCASE " tests with " TESTFAIL " failed". - STOP RUN RETURNING 0. - - CHECK-IT SECTION. - CHECK-01. - INSPECT TESTRECORD REPLACING TRAILING 'x' BY ' '. - ADD 1 TO TESTCASE. - PERFORM VARYING TESTNUM FROM 1 BY 1 - UNTIL TEST-NAME (TESTNUM) = TESTNAME - OR TESTNUM > TESTMAX - CONTINUE - END-PERFORM. - IF TESTNUM > TESTMAX - DISPLAY TESTNAME " :NOT FOUND" - DISPLAY " : GOT: " TESTRECORD ":" - ADD 1 TO TESTFAIL - MOVE ALL "x" TO TESTRECORD - GO TO CHECK-EXIT - END-IF. - MOVE TEST-RESULT (TESTNUM, TESTMODE) TO TESTRESULT. - COMPUTE TESTIDX = TESTMODE + 3. - IF BIT-MODE = 32 - AND TEST-RESULT (TESTNUM, TESTIDX) NOT = SPACES - MOVE TEST-RESULT (TESTNUM, TESTIDX) TO TESTRESULT. - IF TESTRESULT = SPACES - MOVE TEST-RESULT (TESTNUM, 1) TO TESTRESULT. - IF TESTRESULT NOT = TESTRECORD - DISPLAY TESTNAME - " :FAILED: Mode " BIT-MODE - " " TEST-MODE (TESTMODE) - ", Case " TESTCASE ", " TESTEND - DISPLAY " : GOT: " TESTRECORD ":" - DISPLAY " :EXPECT: " TESTRESULT ":" - ADD 1 TO TESTFAIL - END-IF. - MOVE ALL "x" TO TESTRECORD. - CHECK-EXIT. - EXIT. - -]) - -AT_CHECK([cobc -x -std=mf -w -fibmcomp prog.cob ], [0], [], []) - -AT_CHECK([./prog], [0], [IBMCOMP 24 tests with 00 failed -], []) - -AT_CLEANUP - - -AT_SETUP([MF SYNC]) -AT_KEYWORDS([Numeric]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - CONFIGURATION SECTION. - DATA DIVISION. - FILE SECTION. - - WORKING-STORAGE SECTION. - - 77 VLEN PIC 99 VALUE 1. - 77 TESTMODE PIC 99 VALUE 1. - 77 TESTIDX PIC 99 VALUE 1. - 77 BIT-MODE PIC 99 VALUE 32. - 77 TESTNUM PIC 99 VALUE 0. - 77 TESTMAX PIC 99 VALUE 24. - 77 TESTCASE PIC 99 VALUE 0. - 77 TESTFAIL PIC 99 VALUE 0. - 77 TESTEND PIC X(15) VALUE " ". - 77 TESTNAME PIC X(10) VALUE " ". - 77 TESTRESULT PIC X(40) VALUE " ". - 77 TESTPTR USAGE POINTER. - - 01 TEST-MODES. - 05 FILLER PIC X(10) VALUE "MF". - 05 FILLER PIC X(10) VALUE "IBMCOMP". - 05 FILLER PIC X(10) VALUE "DEFAULT". - - 01 FILLER REDEFINES TEST-MODES. - 05 FILLER OCCURS 3 TIMES. - 10 TEST-MODE PIC X(10). - - 01 TEST-CASES. - 05 FILLER PIC X(10) VALUE "COMP-FLD1". - 05 FILLER PIC X(40) VALUE "xxxxx1". - 05 FILLER PIC X(40) VALUE "xxxxx11". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - - 05 FILLER PIC X(10) VALUE "COMP-FLD2". - 05 FILLER PIC X(40) VALUE "xxxxx22". - 05 FILLER PIC X(40) VALUE "xxxxxx22". - 05 FILLER PIC X(40) VALUE "xxxxxx22". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - - 05 FILLER PIC X(10) VALUE "COMP-FLDO". - 05 FILLER PIC X(40) VALUE "xxxxxxx11xxx22xxx33". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - - 05 FILLER PIC X(10) VALUE "COMP-FLDS". - 05 FILLER PIC X(40) VALUE "xxxxxxx11xxx22xxx33". - 05 FILLER PIC X(40) VALUE "xxxxxxxx11xxxx22xxxx33". - 05 FILLER PIC X(40) VALUE "xxxxxxxx11xxxx22xxxx33". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - - 05 FILLER PIC X(10) VALUE "COMP-FLD3". - 05 FILLER PIC X(40) VALUE "xxxxx123". - 05 FILLER PIC X(40) VALUE "xxxxxxxx1234". - 05 FILLER PIC X(40) VALUE "xxxxxxxx1234". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - - 05 FILLER PIC X(10) VALUE "COMP-FLDL". - 05 FILLER PIC X(40) VALUE "xxxxx1". - 05 FILLER PIC X(40) VALUE "xxxxxx12". - 05 FILLER PIC X(40) VALUE "xxxxx1". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - - 05 FILLER PIC X(10) VALUE "COMP-FLDR". - 05 FILLER PIC X(40) VALUE "xxxxx1". - 05 FILLER PIC X(40) VALUE "xxxxxx12". - 05 FILLER PIC X(40) VALUE "xxxxx1". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - - 05 FILLER PIC X(10) VALUE "COM1-FLD". - 05 FILLER PIC X(40) VALUE "xxxxx12xxx123xxx12345678". - 05 FILLER PIC X(40) VALUE "xxxxxx12xxxx1234xxxx12345678". - 05 FILLER PIC X(40) VALUE "xxxxxx12xxxx1234xxxxxxxx12345678". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE "xxxxxx12xxxx1234xxxx12345678". - - 05 FILLER PIC X(10) VALUE "COM2-FLD". - 05 FILLER PIC X(40) VALUE "xxxxx12345xxx1234567xxx12345678". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - - 05 FILLER PIC X(10) VALUE "COM3-FLD". - 05 FILLER PIC X(40) VALUE "xxxxx123xxx1234xxx1234567". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - - 05 FILLER PIC X(10) VALUE "COM4-FLD". - 05 FILLER PIC X(40) VALUE "x123456x1234x123456x123". - 05 FILLER PIC X(40) VALUE "xxxx12345678xxxx1234x12345678x1234". - 05 FILLER PIC X(40) - VALUE "xxxxxxxx12345678xxxx1234x12345678x1234". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE "xxxx12345678xxxx1234x12345678x1234". - - 05 FILLER PIC X(10) VALUE "NOSYNC". - 05 FILLER PIC X(40) VALUE "x123456x123". - 05 FILLER PIC X(40) VALUE "x12345678x1234". - 05 FILLER PIC X(40) VALUE "x12345678x1234". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - - 05 FILLER PIC X(10) VALUE "SYNC". - 05 FILLER PIC X(40) VALUE "x123456x1234". - 05 FILLER PIC X(40) VALUE "xxxx12345678xxxx1234". - 05 FILLER PIC X(40) VALUE "xxxxxxxx12345678xxxx1234". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE "xxxx12345678xxxx1234". - - 05 FILLER PIC X(10) VALUE "COMP-3". - 05 FILLER PIC X(40) VALUE "x1234567x1234". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - - 05 FILLER PIC X(10) VALUE "COMP-1". - 05 FILLER PIC X(40) VALUE "12341234". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - - 05 FILLER PIC X(10) VALUE "COMP-2". - 05 FILLER PIC X(40) VALUE "1234567812345678". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - - 05 FILLER PIC X(10) VALUE "SIGN L/T". - 05 FILLER PIC X(40) VALUE "x-01x02-x-03x04-". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - - 05 FILLER PIC X(10) VALUE "COMP-X". - 05 FILLER PIC X(40) VALUE "x123x1234567x1234x12345678". - 05 FILLER PIC X(40) VALUE "x123x1234567xxxx1234xxxx12345678". - 05 FILLER PIC X(40) VALUE "x123x1234567xxxx1234xxxx12345678". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - - 05 FILLER PIC X(10) VALUE "BIN-SHORT". - 05 FILLER PIC X(40) VALUE "x12xx12". - 05 FILLER PIC X(40) VALUE "x12xx12". - 05 FILLER PIC X(40) VALUE "x12xx12". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - - 05 FILLER PIC X(10) VALUE "BIN-DBL". - 05 FILLER PIC X(40) VALUE "x12345678x12345678". - 05 FILLER PIC X(40) VALUE "x12345678x12345678". - 05 FILLER PIC X(40) VALUE "x12345678x12345678". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE "x12345678xxx12345678". - - 05 FILLER PIC X(10) VALUE "BIN-LNG". - 05 FILLER PIC X(40) VALUE "x1234x1234". - 05 FILLER PIC X(40) VALUE "x1234x1234". - 05 FILLER PIC X(40) VALUE "x1234x1234". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE "x1234xxx1234". - - 05 FILLER PIC X(10) VALUE "COMP-5". - 05 FILLER PIC X(40) VALUE "x12345678x12345678". - 05 FILLER PIC X(40) VALUE "x12345678xxx12345678". - 05 FILLER PIC X(40) VALUE "x12345678xxxxxxx12345678". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE "x12345678xxx12345678". - - 05 FILLER PIC X(10) VALUE "CMP-1". - 05 FILLER PIC X(40) VALUE "x1234x1234". - 05 FILLER PIC X(40) VALUE "x1234xxx1234". - 05 FILLER PIC X(40) VALUE "x1234xxx1234". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - - 05 FILLER PIC X(10) VALUE "CMP-2". - 05 FILLER PIC X(40) VALUE "x12345678x12345678". - 05 FILLER PIC X(40) VALUE "x12345678xxxxxxx12345678". - 05 FILLER PIC X(40) VALUE "x12345678xxxxxxx12345678". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE "x12345678xxx12345678". - - 01 FILLER REDEFINES TEST-CASES. - 05 FILLER OCCURS 24 TIMES. - 10 TEST-NAME PIC X(10). - 10 TEST-RESULTS. - 15 MF-64RESULT PIC X(40). - 15 IBM-64RESULT PIC X(40). - 15 C2002-64RESULT PIC X(40). - 15 MF-32RESULT PIC X(40). - 15 IBM-32RESULT PIC X(40). - 15 C2002-32RESULT PIC X(40). - 10 FILLER REDEFINES TEST-RESULTS. - 15 TEST-RESULT PIC X(40) OCCURS 6 TIMES. - - 01 TESTRECORD PIC X(40). - - 01 FILLER REDEFINES TESTRECORD. - 02 TSTREC1. - 10 FILLER PICTURE X(5). - 10 COMP-FLD1 PICTURE S9(2) COMP-4. - 10 FILLER PICTURE X(5). - - 01 FILLER REDEFINES TESTRECORD. - 02 TSTREC2. - 10 FILLER PICTURE X(5). - 10 COMP-FLD2 PICTURE S9(4) COMP-4 SYNC . - - 01 FILLER REDEFINES TESTRECORD. - 02 TSTREC3. - 10 FILLER PICTURE X(5). - 10 COMP-FLD3 PICTURE S9(6) COMP-4 SYNC. - 10 FILLER PICTURE X(5). - - 01 FILLER REDEFINES TESTRECORD. - 02 TSTRECL. - 10 FILLER PICTURE X(5). - 10 COMP-FLDL PICTURE S9(2) COMP-4 SYNC LEFT. - 10 FILLER PICTURE X(5). - - 01 FILLER REDEFINES TESTRECORD. - 02 TSTRECR. - 10 FILLER PICTURE X(5). - 10 COMP-FLDR PICTURE S9(2) COMP-4 SYNC RIGHT. - 10 FILLER PICTURE X(5). - - 01 FILLER REDEFINES TESTRECORD. - 02 TSTRECS. - 10 FILLER PICTURE X(5). - 10 FILLER OCCURS 3 TIMES. - 15 FILLER PICTURE X(2). - 15 COMP-FLDS PICTURE S9(4) COMP-4 SYNC . - 15 FILLER PICTURE X(1). - 10 FILLER PICTURE X(1). - - 01 FILLER REDEFINES TESTRECORD. - 02 TSTRECO. - 10 FILLER PICTURE X(5). - 10 FILLER OCCURS 3 TIMES. - 15 FILLER PICTURE X(2). - 15 COMP-FLDO PICTURE S9(4) COMP-4 . - 15 FILLER PICTURE X(1). - 10 FILLER PICTURE X(1). - - 01 FILLER REDEFINES TESTRECORD. - 02 TSTGRP. - 05 GRP1. - 10 FILLER PICTURE X(5). - 10 COM1-FLD1 PICTURE S9(4) SYNC COMP-4. - 10 FILLER PICTURE X(3). - 10 COM1-FLD2 PICTURE S9(6) SYNC COMP-4. - 10 FILLER PICTURE X(3). - 10 COM1-FLD3 PICTURE S9(18) SYNC COMP-4. - - 01 FILLER REDEFINES TESTRECORD. - 02 TSTGRP2 SIGN LEADING SEPARATE. - 05 GRP2-1. - 10 FILLER PICTURE X(5). - 10 COM2-FLD1 PICTURE S9(4). - 10 FILLER PICTURE X(3). - 10 COM2-FLD2 PICTURE S9(6) SIGN TRAILING SEPARATE. - 10 FILLER PICTURE X(3). - 10 COM2-FLD3 PICTURE S9(7). - - 01 FILLER REDEFINES TESTRECORD. - 02 TSTGRP3. - 05 GRP3-1. - 10 FILLER PICTURE X(5). - 10 COM3-FLD1 PICTURE S9(4) COMP-3. - 10 FILLER PICTURE X(3). - 10 COM3-FLD2 PICTURE S9(6) COMP-3. - 10 FILLER PICTURE X(3). - 05 GRP3-2. - 10 COM3-FLD3 PICTURE S9(13) COMP-3. - - 01 FILLER REDEFINES TESTRECORD. - 02 TSTGRP4. - 05 GRP4-1. - 10 FILLER PICTURE X(1). - 10 COM4-FLD1 PICTURE S9(13) COMP-4 SYNC. - 10 FILLER PICTURE X(1). - 10 COM4-FLD2 PICTURE S9(7) COMP-4 SYNC. - 10 FILLER PICTURE X(1). - 05 GRP4-2. - 10 COM4-FLD3 PICTURE S9(13) COMP-4. - 10 FILLER PICTURE X(1). - 10 COM4-FLD4 PICTURE S9(6) COMP-4. - 10 FILLER PICTURE X(1). - - 01 FILLER REDEFINES TESTRECORD. - 02 TSTGRP5. - 10 FILLER PICTURE X(1). - 10 COM5-FLD1 PICTURE S9(13) COMP-4. - 10 FILLER PICTURE X(1). - 10 COM5-FLD2 PICTURE S9(6) COMP-4. - 10 FILLER PICTURE X(1). - - 01 FILLER REDEFINES TESTRECORD. - 02 TSTGRP5S. - 10 FILLER PICTURE X(1). - 10 COM5S-FLD1 PICTURE S9(13) COMP-4 SYNC. - 10 FILLER PICTURE X(1). - 10 COM5S-FLD2 PICTURE S9(7) COMP-4 SYNC. - 10 FILLER PICTURE X(1). - - 01 FILLER REDEFINES TESTRECORD. - 02 TSTGRP6 COMP-3. - 10 FILLER PICTURE 9(1). - 10 COM6-FLD1 PICTURE S9(13). - 10 FILLER PICTURE 9(1). - 10 COM6-FLD2 PICTURE S9(6). - 10 FILLER PICTURE 9(1). - - 01 FILLER REDEFINES TESTRECORD. - 02 TSTGRP7 COMP-1. - 10 COM7-FLD1 . - 10 COM7-FLD2 . - - 01 FILLER REDEFINES TESTRECORD. - 02 TSTGRP8 COMP-2. - 10 COM8-FLD1 . - 10 COM8-FLD2 . - - 01 FILLER REDEFINES TESTRECORD. - 02 TSTGRP9. - 05 GRP9-1 SIGN LEADING SEPARATE. - 10 FILLER PICTURE X(1). - 10 COM9-FLD1 PICTURE S9(2). - 10 FILLER PICTURE X(1). - 10 COM9-FLD2 PICTURE S9(2) SIGN TRAILING SEPARATE. - 10 FILLER PICTURE X(1). - 05 GRP9-2 SIGN TRAILING SEPARATE. - 10 COM9-FLD3 PICTURE S9(2) SIGN LEADING SEPARATE. - 10 FILLER PICTURE X(1). - 10 COM9-FLD4 PICTURE S9(2). - 10 FILLER PICTURE X(1). - - 01 FILLER REDEFINES TESTRECORD. - 02 TSTGRPX. - 10 FILLER PICTURE X(1). - 10 COMX-FLD1 PICTURE X(3) COMP-X SYNC. - 10 FILLER PICTURE X(1). - 10 COMX-FLD2 PICTURE X(7) COMP-X. - 10 FILLER PICTURE X(1). - 10 COMX-FLT COMP-1 SYNC. - 10 FILLER PICTURE X(1). - 10 COMX-DBL COMP-2 SYNC. - 10 FILLER PICTURE X(1). - - 01 FILLER REDEFINES TESTRECORD. - 02 TST-BSHORT. - 10 FILLER PICTURE X(1). - 10 COMS-FLD1 BINARY-SHORT. - 10 FILLER PICTURE X(2). - 10 COMS-FLD2 BINARY-SHORT SYNC. - 10 FILLER PICTURE X(1). - - 01 FILLER REDEFINES TESTRECORD. - 02 TST-BLONG. - 10 FILLER PICTURE X(1). - 10 COML-FLD1 BINARY-LONG. - 10 FILLER PICTURE X(1). - 10 COML-FLD2 BINARY-LONG SYNC. - 10 FILLER PICTURE X(1). - - 01 FILLER REDEFINES TESTRECORD. - 02 TST-BDBL. - 10 FILLER PICTURE X(1). - 10 COMD-FLD1 BINARY-DOUBLE. - 10 FILLER PICTURE X(1). - 10 COMD-FLD2 BINARY-DOUBLE SYNC. - 10 FILLER PICTURE X(1). - - 01 FILLER REDEFINES TESTRECORD. - 02 TST-BLNG. - 10 FILLER PICTURE X(1). - 10 COMBL-FLD1 BINARY-LONG. - 10 FILLER PICTURE X(1). - 10 COMBL-FLD2 BINARY-LONG SYNC. - 10 FILLER PICTURE X(1). - - 01 FILLER REDEFINES TESTRECORD. - 02 TST-CMP5. - 10 FILLER PICTURE X(1). - 10 CMP5-FLD1 PIC 9(18) COMP-5. - 10 FILLER PICTURE X(1). - 10 CMP5-FLD2 PIC 9(18) COMP-5 SYNC. - 10 FILLER PICTURE X(1). - - 01 FILLER REDEFINES TESTRECORD. - 02 TST-CMP1. - 10 FILLER PICTURE X(1). - 10 CMP1-FLD1 COMP-1. - 10 FILLER PICTURE X(1). - 10 CMP1-FLD2 COMP-1 SYNC. - 10 FILLER PICTURE X(1). - - 01 FILLER REDEFINES TESTRECORD. - 02 TST-CMP2. - 10 FILLER PICTURE X(1). - 10 CMP2-FLD1 COMP-2. - 10 FILLER PICTURE X(1). - 10 CMP2-FLD2 COMP-2 SYNC. - 10 FILLER PICTURE X(1). - - PROCEDURE DIVISION. - - MOVE LENGTH OF TESTPTR TO VLEN. - IF VLEN EQUAL 8 - MOVE 64 TO BIT-MODE - ELSE - MOVE 32 TO BIT-MODE. - MOVE ALL "x" TO TESTRECORD. - MOVE 1 TO TESTMODE. - MOVE ALL "x" TO TSTREC2. - MOVE "22" TO COMP-FLD2 (1:). - IF TSTREC2 = 'xxxxxx22' - MOVE 3 TO TESTMODE. - MOVE "12345678" TO COML-FLD2 (1:). - IF COML-FLD2 = 875770417 - MOVE "Little-Endian" TO TESTEND - ELSE - MOVE "Big-Endian" TO TESTEND - END-IF. - MOVE LENGTH OF COMP-FLD1 TO VLEN. - IF VLEN = 2 - MOVE 2 TO TESTMODE. - MOVE ALL "x" TO TESTRECORD. - - MOVE "COMP-FLD1" TO TESTNAME. - MOVE "11" TO COMP-FLD1 (1:). - PERFORM CHECK-IT. - - MOVE "COMP-FLD2" TO TESTNAME. - MOVE "22" TO COMP-FLD2 (1:). - PERFORM CHECK-IT. - - MOVE "COMP-FLDO" TO TESTNAME. - MOVE "11" TO COMP-FLDO (1) (1:2) - MOVE "22" TO COMP-FLDO (2) (1:2) - MOVE "33" TO COMP-FLDO (3) (1:2) - PERFORM CHECK-IT. - - MOVE "COMP-FLDS" TO TESTNAME. - MOVE "11" TO COMP-FLDS (1) (1:2) - MOVE "22" TO COMP-FLDS (2) (1:2) - MOVE "33" TO COMP-FLDS (3) (1:2) - PERFORM CHECK-IT. - - MOVE "COMP-FLD3" TO TESTNAME. - MOVE "1234678" TO COMP-FLD3 (1:). - PERFORM CHECK-IT. - - MOVE "COMP-FLDL" TO TESTNAME. - MOVE "12345678" TO COMP-FLDL (1:). - PERFORM CHECK-IT. - - MOVE "COMP-FLDR" TO TESTNAME. - MOVE "12345678" TO COMP-FLDR (1:). - PERFORM CHECK-IT. - - MOVE "COM1-FLD" TO TESTNAME. - MOVE "12345678" TO COM1-FLD1 (1:). - MOVE "12345678" TO COM1-FLD2 (1:). - MOVE "12345678" TO COM1-FLD3 (1:). - PERFORM CHECK-IT. - - MOVE "COM2-FLD" TO TESTNAME. - MOVE "12345678" TO COM2-FLD1 (1:). - MOVE "12345678" TO COM2-FLD2 (1:). - MOVE "12345678" TO COM2-FLD3 (1:). - PERFORM CHECK-IT. - - MOVE "COM3-FLD" TO TESTNAME. - MOVE "12345678" TO COM3-FLD1 (1:). - MOVE "12345678" TO COM3-FLD2 (1:). - MOVE "12345678" TO COM3-FLD3 (1:). - PERFORM CHECK-IT. - - MOVE "COM4-FLD" TO TESTNAME. - MOVE "12345678" TO COM4-FLD1 (1:). - MOVE "12345678" TO COM4-FLD2 (1:). - MOVE "12345678" TO COM4-FLD3 (1:). - MOVE "12345678" TO COM4-FLD4 (1:). - PERFORM CHECK-IT. - - MOVE "NOSYNC" TO TESTNAME. - MOVE "12345678" TO COM5-FLD1 (1:). - MOVE "12345678" TO COM5-FLD2 (1:). - PERFORM CHECK-IT. - - MOVE "SYNC" TO TESTNAME. - MOVE "12345678" TO COM5S-FLD1 (1:). - MOVE "12345678" TO COM5S-FLD2 (1:). - PERFORM CHECK-IT. - - MOVE "COMP-3" TO TESTNAME. - MOVE "12345678" TO COM6-FLD1 (1:). - MOVE "12345678" TO COM6-FLD2 (1:). - PERFORM CHECK-IT. - - MOVE "COMP-1" TO TESTNAME. - MOVE "12345678" TO COM7-FLD1 (1:). - MOVE "12345678" TO COM7-FLD2 (1:). - PERFORM CHECK-IT. - - MOVE "COMP-2" TO TESTNAME. - MOVE "12345678" TO COM8-FLD1 (1:). - MOVE "12345678" TO COM8-FLD2 (1:). - PERFORM CHECK-IT. - - MOVE "SIGN L/T" TO TESTNAME. - MOVE -1 TO COM9-FLD1 . - MOVE -2 TO COM9-FLD2 . - MOVE -3 TO COM9-FLD3 . - MOVE -4 TO COM9-FLD4 . - PERFORM CHECK-IT. - - MOVE "COMP-X" TO TESTNAME. - MOVE "12345678" TO COMX-FLD1 (1:). - MOVE "12345678" TO COMX-FLD2 (1:). - MOVE "12345678" TO COMX-FLT (1:). - MOVE "12345678" TO COMX-DBL (1:). - PERFORM CHECK-IT. - - MOVE "BIN-SHORT" TO TESTNAME. - MOVE "12345678" TO COMS-FLD1 (1:). - MOVE "12345678" TO COMS-FLD2 (1:). - PERFORM CHECK-IT. - - MOVE "BIN-DBL" TO TESTNAME. - MOVE "12345678" TO COMD-FLD1 (1:). - MOVE "12345678" TO COMD-FLD2 (1:). - PERFORM CHECK-IT. - - MOVE "BIN-LNG" TO TESTNAME. - MOVE "12345678" TO COMBL-FLD1 (1:). - MOVE "12345678" TO COMBL-FLD2 (1:). - PERFORM CHECK-IT. - - MOVE "COMP-5" TO TESTNAME. - MOVE "12345678" TO CMP5-FLD1 (1:). - MOVE "12345678" TO CMP5-FLD2 (1:). - PERFORM CHECK-IT. - - MOVE "CMP-1" TO TESTNAME. - MOVE "12345678" TO CMP1-FLD1 (1:). - MOVE "12345678" TO CMP1-FLD2 (1:). - PERFORM CHECK-IT. - - MOVE "CMP-2" TO TESTNAME. - MOVE "12345678" TO CMP2-FLD1 (1:). - MOVE "12345678" TO CMP2-FLD2 (1:). - PERFORM CHECK-IT. - - DISPLAY TEST-MODE (TESTMODE) - TESTCASE " tests with " TESTFAIL " failed". - STOP RUN RETURNING 0. - - CHECK-IT SECTION. - CHECK-01. - INSPECT TESTRECORD REPLACING TRAILING 'x' BY ' '. - ADD 1 TO TESTCASE. - PERFORM VARYING TESTNUM FROM 1 BY 1 - UNTIL TEST-NAME (TESTNUM) = TESTNAME - OR TESTNUM > TESTMAX - CONTINUE - END-PERFORM. - IF TESTNUM > TESTMAX - DISPLAY TESTNAME " :NOT FOUND" - DISPLAY " : GOT: " TESTRECORD ":" - ADD 1 TO TESTFAIL - MOVE ALL "x" TO TESTRECORD - GO TO CHECK-EXIT - END-IF. - MOVE TEST-RESULT (TESTNUM, TESTMODE) TO TESTRESULT. - COMPUTE TESTIDX = TESTMODE + 3. - IF BIT-MODE = 32 - AND TEST-RESULT (TESTNUM, TESTIDX) NOT = SPACES - MOVE TEST-RESULT (TESTNUM, TESTIDX) TO TESTRESULT. - IF TESTRESULT = SPACES - MOVE TEST-RESULT (TESTNUM, 1) TO TESTRESULT. - IF TESTRESULT NOT = TESTRECORD - DISPLAY TESTNAME - " :FAILED: Mode " BIT-MODE - " " TEST-MODE (TESTMODE) - ", Case " TESTCASE ", " TESTEND - DISPLAY " : GOT: " TESTRECORD ":" - DISPLAY " :EXPECT: " TESTRESULT ":" - ADD 1 TO TESTFAIL - END-IF. - MOVE ALL "x" TO TESTRECORD. - CHECK-EXIT. - EXIT. - -]) - -AT_CHECK([cobc -x -std=mf -w prog.cob ], [0], [], []) - -AT_CHECK([./prog], [0], [MF 24 tests with 00 failed -], []) - -AT_CLEANUP - - -AT_SETUP([default SYNC]) -AT_KEYWORDS([Numeric]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - CONFIGURATION SECTION. - DATA DIVISION. - FILE SECTION. - - WORKING-STORAGE SECTION. - - 77 VLEN PIC 99 VALUE 1. - 77 TESTMODE PIC 99 VALUE 1. - 77 TESTIDX PIC 99 VALUE 1. - 77 BIT-MODE PIC 99 VALUE 32. - 77 TESTNUM PIC 99 VALUE 0. - 77 TESTMAX PIC 99 VALUE 24. - 77 TESTCASE PIC 99 VALUE 0. - 77 TESTFAIL PIC 99 VALUE 0. - 77 TESTEND PIC X(15) VALUE " ". - 77 TESTNAME PIC X(10) VALUE " ". - 77 TESTRESULT PIC X(40) VALUE " ". - 77 TESTPTR USAGE POINTER. - - 01 TEST-MODES. - 05 FILLER PIC X(10) VALUE "MF". - 05 FILLER PIC X(10) VALUE "IBMCOMP". - 05 FILLER PIC X(10) VALUE "DEFAULT". - - 01 FILLER REDEFINES TEST-MODES. - 05 FILLER OCCURS 3 TIMES. - 10 TEST-MODE PIC X(10). - - 01 TEST-CASES. - 05 FILLER PIC X(10) VALUE "COMP-FLD1". - 05 FILLER PIC X(40) VALUE "xxxxx1". - 05 FILLER PIC X(40) VALUE "xxxxx11". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - - 05 FILLER PIC X(10) VALUE "COMP-FLD2". - 05 FILLER PIC X(40) VALUE "xxxxx22". - 05 FILLER PIC X(40) VALUE "xxxxxx22". - 05 FILLER PIC X(40) VALUE "xxxxxx22". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - - 05 FILLER PIC X(10) VALUE "COMP-FLDO". - 05 FILLER PIC X(40) VALUE "xxxxxxx11xxx22xxx33". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - - 05 FILLER PIC X(10) VALUE "COMP-FLDS". - 05 FILLER PIC X(40) VALUE "xxxxxxx11xxx22xxx33". - 05 FILLER PIC X(40) VALUE "xxxxxxxx11xxxx22xxxx33". - 05 FILLER PIC X(40) VALUE "xxxxxxxx11xxxx22xxxx33". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - - 05 FILLER PIC X(10) VALUE "COMP-FLD3". - 05 FILLER PIC X(40) VALUE "xxxxx123". - 05 FILLER PIC X(40) VALUE "xxxxxxxx1234". - 05 FILLER PIC X(40) VALUE "xxxxxxxx1234". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - - 05 FILLER PIC X(10) VALUE "COMP-FLDL". - 05 FILLER PIC X(40) VALUE "xxxxx1". - 05 FILLER PIC X(40) VALUE "xxxxxx12". - 05 FILLER PIC X(40) VALUE "xxxxx1". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - - 05 FILLER PIC X(10) VALUE "COMP-FLDR". - 05 FILLER PIC X(40) VALUE "xxxxx1". - 05 FILLER PIC X(40) VALUE "xxxxxx12". - 05 FILLER PIC X(40) VALUE "xxxxx1". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - - 05 FILLER PIC X(10) VALUE "COM1-FLD". - 05 FILLER PIC X(40) VALUE "xxxxx12xxx123xxx12345678". - 05 FILLER PIC X(40) VALUE "xxxxxx12xxxx1234xxxx12345678". - 05 FILLER PIC X(40) VALUE "xxxxxx12xxxx1234xxxxxxxx12345678". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE "xxxxxx12xxxx1234xxxx12345678". - - 05 FILLER PIC X(10) VALUE "COM2-FLD". - 05 FILLER PIC X(40) VALUE "xxxxx12345xxx1234567xxx12345678". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - - 05 FILLER PIC X(10) VALUE "COM3-FLD". - 05 FILLER PIC X(40) VALUE "xxxxx123xxx1234xxx1234567". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - - 05 FILLER PIC X(10) VALUE "COM4-FLD". - 05 FILLER PIC X(40) VALUE "x123456x1234x123456x123". - 05 FILLER PIC X(40) VALUE "xxxx12345678xxxx1234x12345678x1234". - 05 FILLER PIC X(40) - VALUE "xxxxxxxx12345678xxxx1234x12345678x1234". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE "xxxx12345678xxxx1234x12345678x1234". - - 05 FILLER PIC X(10) VALUE "NOSYNC". - 05 FILLER PIC X(40) VALUE "x123456x123". - 05 FILLER PIC X(40) VALUE "x12345678x1234". - 05 FILLER PIC X(40) VALUE "x12345678x1234". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - - 05 FILLER PIC X(10) VALUE "SYNC". - 05 FILLER PIC X(40) VALUE "x123456x1234". - 05 FILLER PIC X(40) VALUE "xxxx12345678xxxx1234". - 05 FILLER PIC X(40) VALUE "xxxxxxxx12345678xxxx1234". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE "xxxx12345678xxxx1234". - - 05 FILLER PIC X(10) VALUE "COMP-3". - 05 FILLER PIC X(40) VALUE "x1234567x1234". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - - 05 FILLER PIC X(10) VALUE "COMP-1". - 05 FILLER PIC X(40) VALUE "12341234". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - - 05 FILLER PIC X(10) VALUE "COMP-2". - 05 FILLER PIC X(40) VALUE "1234567812345678". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - - 05 FILLER PIC X(10) VALUE "SIGN L/T". - 05 FILLER PIC X(40) VALUE "x-01x02-x-03x04-". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - - 05 FILLER PIC X(10) VALUE "COMP-X". - 05 FILLER PIC X(40) VALUE "x123x1234567x1234x12345678". - 05 FILLER PIC X(40) VALUE "x123x1234567xxxx1234xxxx12345678". - 05 FILLER PIC X(40) VALUE "x123x1234567xxxx1234xxxx12345678". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - - 05 FILLER PIC X(10) VALUE "BIN-SHORT". - 05 FILLER PIC X(40) VALUE "x12xx12". - 05 FILLER PIC X(40) VALUE "x12xx12". - 05 FILLER PIC X(40) VALUE "x12xx12". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - - 05 FILLER PIC X(10) VALUE "BIN-DBL". - 05 FILLER PIC X(40) VALUE "x12345678x12345678". - 05 FILLER PIC X(40) VALUE "x12345678x12345678". - 05 FILLER PIC X(40) VALUE "x12345678x12345678". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE "x12345678x12345678". - - 05 FILLER PIC X(10) VALUE "BIN-LNG". - 05 FILLER PIC X(40) VALUE "x1234x1234". - 05 FILLER PIC X(40) VALUE "x1234x1234". - 05 FILLER PIC X(40) VALUE "x1234x1234". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE "x1234x1234". - - 05 FILLER PIC X(10) VALUE "COMP-5". - 05 FILLER PIC X(40) VALUE "x12345678x12345678". - 05 FILLER PIC X(40) VALUE "x12345678xxx12345678". - 05 FILLER PIC X(40) VALUE "x12345678xxxxxxx12345678". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE "x12345678xxx12345678". - - 05 FILLER PIC X(10) VALUE "CMP-1". - 05 FILLER PIC X(40) VALUE "x1234x1234". - 05 FILLER PIC X(40) VALUE "x1234xxx1234". - 05 FILLER PIC X(40) VALUE "x1234xxx1234". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - - 05 FILLER PIC X(10) VALUE "CMP-2". - 05 FILLER PIC X(40) VALUE "x12345678x12345678". - 05 FILLER PIC X(40) VALUE "x12345678xxxxxxx12345678". - 05 FILLER PIC X(40) VALUE "x12345678xxxxxxx12345678". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE " ". - 05 FILLER PIC X(40) VALUE "x12345678xxx12345678". - - 01 FILLER REDEFINES TEST-CASES. - 05 FILLER OCCURS 24 TIMES. - 10 TEST-NAME PIC X(10). - 10 TEST-RESULTS. - 15 MF-64RESULT PIC X(40). - 15 IBM-64RESULT PIC X(40). - 15 C2002-64RESULT PIC X(40). - 15 MF-32RESULT PIC X(40). - 15 IBM-32RESULT PIC X(40). - 15 C2002-32RESULT PIC X(40). - 10 FILLER REDEFINES TEST-RESULTS. - 15 TEST-RESULT PIC X(40) OCCURS 6 TIMES. - - 01 TESTRECORD PIC X(40). - - 01 FILLER REDEFINES TESTRECORD. - 02 TSTREC1. - 10 FILLER PICTURE X(5). - 10 COMP-FLD1 PICTURE S9(2) COMP-4. - 10 FILLER PICTURE X(5). - - 01 FILLER REDEFINES TESTRECORD. - 02 TSTREC2. - 10 FILLER PICTURE X(5). - 10 COMP-FLD2 PICTURE S9(4) COMP-4 SYNC . - - 01 FILLER REDEFINES TESTRECORD. - 02 TSTREC3. - 10 FILLER PICTURE X(5). - 10 COMP-FLD3 PICTURE S9(6) COMP-4 SYNC. - 10 FILLER PICTURE X(5). - - 01 FILLER REDEFINES TESTRECORD. - 02 TSTRECL. - 10 FILLER PICTURE X(5). - 10 COMP-FLDL PICTURE S9(2) COMP-4 SYNC LEFT. - 10 FILLER PICTURE X(5). - - 01 FILLER REDEFINES TESTRECORD. - 02 TSTRECR. - 10 FILLER PICTURE X(5). - 10 COMP-FLDR PICTURE S9(2) COMP-4 SYNC RIGHT. - 10 FILLER PICTURE X(5). - - 01 FILLER REDEFINES TESTRECORD. - 02 TSTRECS. - 10 FILLER PICTURE X(5). - 10 FILLER OCCURS 3 TIMES. - 15 FILLER PICTURE X(2). - 15 COMP-FLDS PICTURE S9(4) COMP-4 SYNC . - 15 FILLER PICTURE X(1). - 10 FILLER PICTURE X(1). - - 01 FILLER REDEFINES TESTRECORD. - 02 TSTRECO. - 10 FILLER PICTURE X(5). - 10 FILLER OCCURS 3 TIMES. - 15 FILLER PICTURE X(2). - 15 COMP-FLDO PICTURE S9(4) COMP-4 . - 15 FILLER PICTURE X(1). - 10 FILLER PICTURE X(1). - - 01 FILLER REDEFINES TESTRECORD. - 02 TSTGRP. - 05 GRP1. - 10 FILLER PICTURE X(5). - 10 COM1-FLD1 PICTURE S9(4) SYNC COMP-4. - 10 FILLER PICTURE X(3). - 10 COM1-FLD2 PICTURE S9(6) SYNC COMP-4. - 10 FILLER PICTURE X(3). - 10 COM1-FLD3 PICTURE S9(18) SYNC COMP-4. - - 01 FILLER REDEFINES TESTRECORD. - 02 TSTGRP2 SIGN LEADING SEPARATE. - 05 GRP2-1. - 10 FILLER PICTURE X(5). - 10 COM2-FLD1 PICTURE S9(4). - 10 FILLER PICTURE X(3). - 10 COM2-FLD2 PICTURE S9(6) SIGN TRAILING SEPARATE. - 10 FILLER PICTURE X(3). - 10 COM2-FLD3 PICTURE S9(7). - - 01 FILLER REDEFINES TESTRECORD. - 02 TSTGRP3. - 05 GRP3-1. - 10 FILLER PICTURE X(5). - 10 COM3-FLD1 PICTURE S9(4) COMP-3. - 10 FILLER PICTURE X(3). - 10 COM3-FLD2 PICTURE S9(6) COMP-3. - 10 FILLER PICTURE X(3). - 05 GRP3-2. - 10 COM3-FLD3 PICTURE S9(13) COMP-3. - - 01 FILLER REDEFINES TESTRECORD. - 02 TSTGRP4. - 05 GRP4-1. - 10 FILLER PICTURE X(1). - 10 COM4-FLD1 PICTURE S9(13) COMP-4 SYNC. - 10 FILLER PICTURE X(1). - 10 COM4-FLD2 PICTURE S9(7) COMP-4 SYNC. - 10 FILLER PICTURE X(1). - 05 GRP4-2. - 10 COM4-FLD3 PICTURE S9(13) COMP-4. - 10 FILLER PICTURE X(1). - 10 COM4-FLD4 PICTURE S9(6) COMP-4. - 10 FILLER PICTURE X(1). - - 01 FILLER REDEFINES TESTRECORD. - 02 TSTGRP5. - 10 FILLER PICTURE X(1). - 10 COM5-FLD1 PICTURE S9(13) COMP-4. - 10 FILLER PICTURE X(1). - 10 COM5-FLD2 PICTURE S9(6) COMP-4. - 10 FILLER PICTURE X(1). - - 01 FILLER REDEFINES TESTRECORD. - 02 TSTGRP5S. - 10 FILLER PICTURE X(1). - 10 COM5S-FLD1 PICTURE S9(13) COMP-4 SYNC. - 10 FILLER PICTURE X(1). - 10 COM5S-FLD2 PICTURE S9(7) COMP-4 SYNC. - 10 FILLER PICTURE X(1). - - 01 FILLER REDEFINES TESTRECORD. - 02 TSTGRP6 COMP-3. - 10 FILLER PICTURE 9(1). - 10 COM6-FLD1 PICTURE S9(13). - 10 FILLER PICTURE 9(1). - 10 COM6-FLD2 PICTURE S9(6). - 10 FILLER PICTURE 9(1). - - 01 FILLER REDEFINES TESTRECORD. - 02 TSTGRP7 COMP-1. - 10 COM7-FLD1 . - 10 COM7-FLD2 . - - 01 FILLER REDEFINES TESTRECORD. - 02 TSTGRP8 COMP-2. - 10 COM8-FLD1 . - 10 COM8-FLD2 . - - 01 FILLER REDEFINES TESTRECORD. - 02 TSTGRP9. - 05 GRP9-1 SIGN LEADING SEPARATE. - 10 FILLER PICTURE X(1). - 10 COM9-FLD1 PICTURE S9(2). - 10 FILLER PICTURE X(1). - 10 COM9-FLD2 PICTURE S9(2) SIGN TRAILING SEPARATE. - 10 FILLER PICTURE X(1). - 05 GRP9-2 SIGN TRAILING SEPARATE. - 10 COM9-FLD3 PICTURE S9(2) SIGN LEADING SEPARATE. - 10 FILLER PICTURE X(1). - 10 COM9-FLD4 PICTURE S9(2). - 10 FILLER PICTURE X(1). - - 01 FILLER REDEFINES TESTRECORD. - 02 TSTGRPX. - 10 FILLER PICTURE X(1). - 10 COMX-FLD1 PICTURE X(3) COMP-X SYNC. - 10 FILLER PICTURE X(1). - 10 COMX-FLD2 PICTURE X(7) COMP-X. - 10 FILLER PICTURE X(1). - 10 COMX-FLT COMP-1 SYNC. - 10 FILLER PICTURE X(1). - 10 COMX-DBL COMP-2 SYNC. - 10 FILLER PICTURE X(1). - - 01 FILLER REDEFINES TESTRECORD. - 02 TST-BSHORT. - 10 FILLER PICTURE X(1). - 10 COMS-FLD1 BINARY-SHORT. - 10 FILLER PICTURE X(2). - 10 COMS-FLD2 BINARY-SHORT SYNC. - 10 FILLER PICTURE X(1). - - 01 FILLER REDEFINES TESTRECORD. - 02 TST-BLONG. - 10 FILLER PICTURE X(1). - 10 COML-FLD1 BINARY-LONG. - 10 FILLER PICTURE X(1). - 10 COML-FLD2 BINARY-LONG SYNC. - 10 FILLER PICTURE X(1). - - 01 FILLER REDEFINES TESTRECORD. - 02 TST-BDBL. - 10 FILLER PICTURE X(1). - 10 COMD-FLD1 BINARY-DOUBLE. - 10 FILLER PICTURE X(1). - 10 COMD-FLD2 BINARY-DOUBLE SYNC. - 10 FILLER PICTURE X(1). - - 01 FILLER REDEFINES TESTRECORD. - 02 TST-BLNG. - 10 FILLER PICTURE X(1). - 10 COMBL-FLD1 BINARY-LONG. - 10 FILLER PICTURE X(1). - 10 COMBL-FLD2 BINARY-LONG SYNC. - 10 FILLER PICTURE X(1). - - 01 FILLER REDEFINES TESTRECORD. - 02 TST-CMP5. - 10 FILLER PICTURE X(1). - 10 CMP5-FLD1 PIC 9(18) COMP-5. - 10 FILLER PICTURE X(1). - 10 CMP5-FLD2 PIC 9(18) COMP-5 SYNC. - 10 FILLER PICTURE X(1). - - 01 FILLER REDEFINES TESTRECORD. - 02 TST-CMP1. - 10 FILLER PICTURE X(1). - 10 CMP1-FLD1 COMP-1. - 10 FILLER PICTURE X(1). - 10 CMP1-FLD2 COMP-1 SYNC. - 10 FILLER PICTURE X(1). - - 01 FILLER REDEFINES TESTRECORD. - 02 TST-CMP2. - 10 FILLER PICTURE X(1). - 10 CMP2-FLD1 COMP-2. - 10 FILLER PICTURE X(1). - 10 CMP2-FLD2 COMP-2 SYNC. - 10 FILLER PICTURE X(1). - - PROCEDURE DIVISION. - - MOVE LENGTH OF TESTPTR TO VLEN. - IF VLEN EQUAL 8 - MOVE 64 TO BIT-MODE - ELSE - MOVE 32 TO BIT-MODE. - MOVE ALL "x" TO TESTRECORD. - MOVE 1 TO TESTMODE. - MOVE ALL "x" TO TSTREC2. - MOVE "22" TO COMP-FLD2 (1:). - IF TSTREC2 = 'xxxxxx22' - MOVE 3 TO TESTMODE. - MOVE "12345678" TO COML-FLD2 (1:). - IF COML-FLD2 = 875770417 - MOVE "Little-Endian" TO TESTEND - ELSE - MOVE "Big-Endian" TO TESTEND - END-IF. - MOVE LENGTH OF COMP-FLD1 TO VLEN. - IF VLEN = 2 - MOVE 2 TO TESTMODE. - MOVE ALL "x" TO TESTRECORD. - - MOVE "COMP-FLD1" TO TESTNAME. - MOVE "11" TO COMP-FLD1 (1:). - PERFORM CHECK-IT. - - MOVE "COMP-FLD2" TO TESTNAME. - MOVE "22" TO COMP-FLD2 (1:). - PERFORM CHECK-IT. - - MOVE "COMP-FLDO" TO TESTNAME. - MOVE "11" TO COMP-FLDO (1) (1:2) - MOVE "22" TO COMP-FLDO (2) (1:2) - MOVE "33" TO COMP-FLDO (3) (1:2) - PERFORM CHECK-IT. - - MOVE "COMP-FLDS" TO TESTNAME. - MOVE "11" TO COMP-FLDS (1) (1:2) - MOVE "22" TO COMP-FLDS (2) (1:2) - MOVE "33" TO COMP-FLDS (3) (1:2) - PERFORM CHECK-IT. - - MOVE "COMP-FLD3" TO TESTNAME. - MOVE "1234678" TO COMP-FLD3 (1:). - PERFORM CHECK-IT. - - MOVE "COMP-FLDL" TO TESTNAME. - MOVE "12345678" TO COMP-FLDL (1:). - PERFORM CHECK-IT. - - MOVE "COMP-FLDR" TO TESTNAME. - MOVE "12345678" TO COMP-FLDR (1:). - PERFORM CHECK-IT. - - MOVE "COM1-FLD" TO TESTNAME. - MOVE "12345678" TO COM1-FLD1 (1:). - MOVE "12345678" TO COM1-FLD2 (1:). - MOVE "12345678" TO COM1-FLD3 (1:). - PERFORM CHECK-IT. - - MOVE "COM2-FLD" TO TESTNAME. - MOVE "12345678" TO COM2-FLD1 (1:). - MOVE "12345678" TO COM2-FLD2 (1:). - MOVE "12345678" TO COM2-FLD3 (1:). - PERFORM CHECK-IT. - - MOVE "COM3-FLD" TO TESTNAME. - MOVE "12345678" TO COM3-FLD1 (1:). - MOVE "12345678" TO COM3-FLD2 (1:). - MOVE "12345678" TO COM3-FLD3 (1:). - PERFORM CHECK-IT. - - MOVE "COM4-FLD" TO TESTNAME. - MOVE "12345678" TO COM4-FLD1 (1:). - MOVE "12345678" TO COM4-FLD2 (1:). - MOVE "12345678" TO COM4-FLD3 (1:). - MOVE "12345678" TO COM4-FLD4 (1:). - PERFORM CHECK-IT. - - MOVE "NOSYNC" TO TESTNAME. - MOVE "12345678" TO COM5-FLD1 (1:). - MOVE "12345678" TO COM5-FLD2 (1:). - PERFORM CHECK-IT. - - MOVE "SYNC" TO TESTNAME. - MOVE "12345678" TO COM5S-FLD1 (1:). - MOVE "12345678" TO COM5S-FLD2 (1:). - PERFORM CHECK-IT. - - MOVE "COMP-3" TO TESTNAME. - MOVE "12345678" TO COM6-FLD1 (1:). - MOVE "12345678" TO COM6-FLD2 (1:). - PERFORM CHECK-IT. - - MOVE "COMP-1" TO TESTNAME. - MOVE "12345678" TO COM7-FLD1 (1:). - MOVE "12345678" TO COM7-FLD2 (1:). - PERFORM CHECK-IT. - - MOVE "COMP-2" TO TESTNAME. - MOVE "12345678" TO COM8-FLD1 (1:). - MOVE "12345678" TO COM8-FLD2 (1:). - PERFORM CHECK-IT. - - MOVE "SIGN L/T" TO TESTNAME. - MOVE -1 TO COM9-FLD1 . - MOVE -2 TO COM9-FLD2 . - MOVE -3 TO COM9-FLD3 . - MOVE -4 TO COM9-FLD4 . - PERFORM CHECK-IT. - - MOVE "COMP-X" TO TESTNAME. - MOVE "12345678" TO COMX-FLD1 (1:). - MOVE "12345678" TO COMX-FLD2 (1:). - MOVE "12345678" TO COMX-FLT (1:). - MOVE "12345678" TO COMX-DBL (1:). - PERFORM CHECK-IT. - - MOVE "BIN-SHORT" TO TESTNAME. - MOVE "12345678" TO COMS-FLD1 (1:). - MOVE "12345678" TO COMS-FLD2 (1:). - PERFORM CHECK-IT. - - MOVE "BIN-DBL" TO TESTNAME. - MOVE "12345678" TO COMD-FLD1 (1:). - MOVE "12345678" TO COMD-FLD2 (1:). - PERFORM CHECK-IT. - - MOVE "BIN-LNG" TO TESTNAME. - MOVE "12345678" TO COMBL-FLD1 (1:). - MOVE "12345678" TO COMBL-FLD2 (1:). - PERFORM CHECK-IT. - - MOVE "COMP-5" TO TESTNAME. - MOVE "12345678" TO CMP5-FLD1 (1:). - MOVE "12345678" TO CMP5-FLD2 (1:). - PERFORM CHECK-IT. - - MOVE "CMP-1" TO TESTNAME. - MOVE "12345678" TO CMP1-FLD1 (1:). - MOVE "12345678" TO CMP1-FLD2 (1:). - PERFORM CHECK-IT. - - MOVE "CMP-2" TO TESTNAME. - MOVE "12345678" TO CMP2-FLD1 (1:). - MOVE "12345678" TO CMP2-FLD2 (1:). - PERFORM CHECK-IT. - - DISPLAY TEST-MODE (TESTMODE) - TESTCASE " tests with " TESTFAIL " failed". - STOP RUN RETURNING 0. - - CHECK-IT SECTION. - CHECK-01. - INSPECT TESTRECORD REPLACING TRAILING 'x' BY ' '. - ADD 1 TO TESTCASE. - PERFORM VARYING TESTNUM FROM 1 BY 1 - UNTIL TEST-NAME (TESTNUM) = TESTNAME - OR TESTNUM > TESTMAX - CONTINUE - END-PERFORM. - IF TESTNUM > TESTMAX - DISPLAY TESTNAME " :NOT FOUND" - DISPLAY " : GOT: " TESTRECORD ":" - ADD 1 TO TESTFAIL - MOVE ALL "x" TO TESTRECORD - GO TO CHECK-EXIT - END-IF. - MOVE TEST-RESULT (TESTNUM, TESTMODE) TO TESTRESULT. - COMPUTE TESTIDX = TESTMODE + 3. - IF BIT-MODE = 32 - AND TEST-RESULT (TESTNUM, TESTIDX) NOT = SPACES - MOVE TEST-RESULT (TESTNUM, TESTIDX) TO TESTRESULT. - IF TESTRESULT = SPACES - MOVE TEST-RESULT (TESTNUM, 1) TO TESTRESULT. - IF TESTRESULT NOT = TESTRECORD - DISPLAY TESTNAME - " :FAILED: Mode " BIT-MODE - " " TEST-MODE (TESTMODE) - ", Case " TESTCASE ", " TESTEND - DISPLAY " : GOT: " TESTRECORD ":" - DISPLAY " :EXPECT: " TESTRESULT ":" - ADD 1 TO TESTFAIL - END-IF. - MOVE ALL "x" TO TESTRECORD. - CHECK-EXIT. - EXIT. - -]) - -AT_CHECK([cobc -x -std=default -w prog.cob ], [0], [], []) - -AT_CHECK([./prog], [0], [DEFAULT 24 tests with 00 failed -], []) - -AT_CLEANUP - -AT_SETUP([Group Usage 1]) -AT_KEYWORDS([Numeric]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - CONFIGURATION SECTION. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 TESTRECORD. - 02 TSTGRP3 COMP-4. - 05 GRP3-1. - 10 FILLER PICTURE X(1). - 10 COM3-FLD1 PICTURE S9(3). - 10 FILLER PICTURE X(3). - 10 COM3-FLD2 PICTURE S9(6). - 05 GRP3-2 SYNC. - 10 FILLER PICTURE X(1). - 10 COM3-FLD3 PICTURE S9(5). - 10 FILLER PICTURE X. - - PROCEDURE DIVISION. - - MOVE ALL 'x' TO TESTRECORD. - MOVE "12345678" TO COM3-FLD1 (1:). - MOVE "12345678" TO COM3-FLD2 (1:). - MOVE "12345678" TO COM3-FLD3 (1:). - DISPLAY TESTRECORD. - STOP RUN. - - -]) - -AT_CHECK([cobc -x -std=mf -w prog.cob ], [0], [], []) - -AT_CHECK([./prog], [0], [x12xxx123x123x -], []) - -AT_CLEANUP - - -AT_SETUP([Group Usage 2]) -AT_KEYWORDS([Numeric]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - CONFIGURATION SECTION. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 TESTRECORD. - 02 TSTGRP3 COMP-4. - 05 GRP3-1. - 10 FILLER PICTURE X(1). - 10 COM3-FLD1 PICTURE S9(3). - 10 FILLER PICTURE X(3). - 10 COM3-FLD2 PICTURE S9(6). - 05 GRP3-2 SYNC. - 10 FILLER PICTURE X(1). - 10 COM3-FLD3 PICTURE S9(5). - 10 FILLER PICTURE X. - - PROCEDURE DIVISION. - - MOVE ALL 'x' TO TESTRECORD. - MOVE "12345678" TO COM3-FLD1 (1:). - MOVE "12345678" TO COM3-FLD2 (1:). - MOVE "12345678" TO COM3-FLD3 (1:). - DISPLAY TESTRECORD. - STOP RUN. - - -]) - -AT_CHECK([cobc -x -std=mf -w -fibmcomp prog.cob ], [0], [], []) - -AT_CHECK([./prog], [0], [x12xxx1234xx1234x -], []) - -AT_CLEANUP - -AT_SETUP([MF COMP-5 noibmcomp]) -AT_KEYWORDS([NOIBMCOMP]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - DATA DIVISION. - WORKING-STORAGE SECTION. - 77 CMP4 PIC 99 COMP-4. - 77 CMP5 PIC 99 COMP-5. - 77 CMP4-4 PIC 9(4) COMP-4. - 77 CMP5-4 PIC 9(4) COMP-5. - PROCEDURE DIVISION. - DISPLAY 'LEN PIC 99 COMP-5 is ' LENGTH OF CMP5 " :". - DISPLAY 'LEN PIC 99 COMP-4 is ' LENGTH OF CMP4 " :". - DISPLAY 'LEN PIC 9(4) COMP-5 is ' LENGTH OF CMP5-4 " :". - DISPLAY 'LEN PIC 9(4) COMP-4 is ' LENGTH OF CMP4-4 " :". - STOP RUN RETURNING 0. -]) - -AT_CHECK([cobc -x -std=mf -w prog.cob ], [0], [], []) - -AT_CHECK([./prog], [0], [LEN PIC 99 COMP-5 is 1 : -LEN PIC 99 COMP-4 is 1 : -LEN PIC 9(4) COMP-5 is 2 : -LEN PIC 9(4) COMP-4 is 2 : -], []) - -AT_CLEANUP - - -AT_SETUP([MF COMP-5]) -AT_KEYWORDS([IBMCOMP]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - DATA DIVISION. - WORKING-STORAGE SECTION. - 77 CMP4 PIC 99 COMP-4. - 77 CMP5 PIC 99 COMP-5. - 77 CMP4-4 PIC 9(4) COMP-4. - 77 CMP5-4 PIC 9(4) COMP-5. - PROCEDURE DIVISION. - DISPLAY 'LEN PIC 99 COMP-5 is ' LENGTH OF CMP5 " :". - DISPLAY 'LEN PIC 99 COMP-4 is ' LENGTH OF CMP4 " :". - DISPLAY 'LEN PIC 9(4) COMP-5 is ' LENGTH OF CMP5-4 " :". - DISPLAY 'LEN PIC 9(4) COMP-4 is ' LENGTH OF CMP4-4 " :". - STOP RUN RETURNING 0. -]) - -AT_CHECK([cobc -x -std=mf -w -fibmcomp prog.cob ], [0], [], []) - -AT_CHECK([./prog], [0], [LEN PIC 99 COMP-5 is 2 : -LEN PIC 99 COMP-4 is 2 : -LEN PIC 9(4) COMP-5 is 2 : -LEN PIC 9(4) COMP-4 is 2 : -], []) - -AT_CLEANUP - - -AT_SETUP([Test HEX String]) -AT_KEYWORDS([Numeric]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 var9 PIC 9(5). - 01 varb PIC 9(4) COMP-4. - 01 varx REDEFINES varb PIC XX. - 88 MAXVAL VALUE X"7FFF". - - PROCEDURE DIVISION. - - SET MAXVAL TO TRUE. - MOVE varb TO var9. - DISPLAY varb " vs " var9. - MOVE HIGH-VALUES TO varx. - MOVE varb TO var9. - DISPLAY varb " vs " var9. - - STOP RUN. -]) - -AT_CHECK([cobc -x -std=mf -w prog.cob ], [0], [], []) - -AT_CHECK([./prog], [0], [2767 vs 32767 -5535 vs 65535 -], []) - -AT_CHECK([cobc -x -std=mf -fnotrunc -w prog.cob ], [0], [], []) - -AT_CHECK([./prog], [0], [32767 vs 32767 -65535 vs 65535 -], []) - -AT_CLEANUP - diff -Nru gnucobol-4.0~early~20200606/tests/testsuite.src/run_ml.at gnucobol-5/tests/testsuite.src/run_ml.at --- gnucobol-4.0~early~20200606/tests/testsuite.src/run_ml.at 2020-06-06 20:52:00.000000000 +0000 +++ gnucobol-5/tests/testsuite.src/run_ml.at 1970-01-01 00:00:00.000000000 +0000 @@ -1,733 +0,0 @@ -## Copyright (C) 2018-2019 Free Software Foundation, Inc. -## Written by Edward Hart, Simon Sobisch -## -## This file is part of GnuCOBOL. -## -## The GnuCOBOL compiler is free software: you can redistribute it -## and/or modify it under the terms of the GNU General Public License -## as published by the Free Software Foundation, either version 3 of the -## License, or (at your option) any later version. -## -## GnuCOBOL is distributed in the hope that it will be useful, -## but WITHOUT ANY WARRANTY; without even the implied warranty of -## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -## GNU General Public License for more details. -## -## You should have received a copy of the GNU General Public License -## along with GnuCOBOL. If not, see . - -AT_SETUP([XML GENERATE general]) -AT_KEYWORDS([extensions]) - -AT_SKIP_IF([test "$COB_HAS_XML2" = "no"]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 namespace-str PIC X(100) - VALUE 'http://www.w3.org/1999/xhtml'. - 01 prefix-str PIC X(100) VALUE 'pre'. - - 01 out PIC X(200). - 01 rec. - 03 a PIC X(3) VALUE 'A'. - 03 b PIC X(3) VALUE ALL 'B'. - 03 c. - 05 d PIC X(3) VALUE SPACES. - - 01 0SpecialTAGName PIC X(3) VALUE "abc". - - 01 employee. - 05 id PIC 9(1) value 1. - 05 name PIC X(10) value "Someone". - 05 dept PIC X(10) value "Marketing". - - PROCEDURE DIVISION. - XML GENERATE out - FROM rec - WITH XML-DECLARATION - NAME OF a IS 'alpha', d IS 'ABCDEF'; - TYPE OF a IS ATTRIBUTE - SUPPRESS WHEN SPACES - IF out <> '' & X'0A' - & 'BBB' - DISPLAY 'Test 1 failed: ' FUNCTION TRIM (out) - END-IF - - XML GENERATE out FROM d - IF out <> ' ' - DISPLAY 'Test 2 failed: ' FUNCTION TRIM (out) - END-IF - - XML GENERATE out FROM c, WITH ATTRIBUTES. - IF out <> '' - DISPLAY 'Test 3 failed: ' FUNCTION TRIM (out) - END-IF - - MOVE ALL 'A' TO a - MOVE ALL 'C' TO c - XML GENERATE out FROM rec, TYPE OF a IS CONTENT, - b IS CONTENT, d IS CONTENT - IF out <> 'AAABBBCCC' - DISPLAY 'Test 4 failed: ' FUNCTION TRIM (out) - END-IF - - XML GENERATE out FROM rec, TYPE OF a IS CONTENT, d IS CONTENT - IF out <> 'AAABBBCCC' - DISPLAY 'Test 5 failed: ' FUNCTION TRIM (out) - END-IF - - XML GENERATE out FROM c, NAMESPACE namespace-str, - NAMESPACE-PREFIX prefix-str - IF out <> ''- - 'CCC' - DISPLAY 'Test 6 failed: ' FUNCTION TRIM (out) - " " XML-CODE - END-IF - - MOVE SPACES TO namespace-str, prefix-str - XML GENERATE out FROM c, NAMESPACE namespace-str, - NAMESPACE-PREFIX prefix-str - IF out <> 'CCC' - DISPLAY 'Test 7 failed: ' FUNCTION TRIM (out) - END-IF - - MOVE ALL "&" TO d - XML GENERATE out FROM d - IF out <> '&&&' - DISPLAY 'Test 8 failed: ' FUNCTION TRIM (out) - END-IF - - *> Test the case of the id in the DATA DIVISION is preserved. - XML GENERATE out FROM 0specialtagname - IF out <> '<_0SpecialTAGName>abc' - DISPLAY 'Test 9 failed: ' FUNCTION TRIM (out) - END-IF - . - - *> Another test with mixed attributes and values - XML GENERATE out FROM EMPLOYEE TYPE OF ID IS ATTRIBUTE - IF out <> ''- - 'Someone'- - 'Marketing'- - '' - DISPLAY 'Test 10 failed: ' FUNCTION TRIM (out) - END-IF - . -]) - -AT_CHECK([$COMPILE -fnot-reserved=ID prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [], []) -AT_CLEANUP - - -AT_SETUP([XML GENERATE SUPPRESS]) -AT_KEYWORDS([extensions]) - -AT_SKIP_IF([test "$COB_HAS_XML2" = "no"]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 a. - 03 b PIC X(3) VALUE SPACES. - 03 c PIC X(3) VALUE SPACES. - - 01 p. - 03 q PIC 9(3) VALUE ZERO. - 03 r PIC X(3) VALUE "abc". - - 01 x. - 03 y. - 05 z PIC X VALUE SPACE. - - 01 out PIC X(100). - - PROCEDURE DIVISION. - XML GENERATE out FROM a SUPPRESS WHEN SPACES - IF out <> '' - DISPLAY 'Test 1 failed: ' out - END-IF - - XML GENERATE out FROM a SUPPRESS b WHEN SPACES - IF out <> ' ' - DISPLAY 'Test 2 failed: ' out - END-IF - - XML GENERATE out FROM a SUPPRESS EVERY NONNUMERIC WHEN SPACES - IF out <> '' - DISPLAY 'Test 3 failed: ' out - END-IF - - XML GENERATE out FROM p - WITH ATTRIBUTES - SUPPRESS EVERY ATTRIBUTE WHEN ZERO - IF out <> '

' - DISPLAY 'Test 4 failed: ' out - END-IF - - XML GENERATE out FROM a - SUPPRESS c WHEN LOW-VALUES, c WHEN SPACES, - c WHEN LOW-VALUES, - EVERY ELEMENT WHEN SPACES - IF out <> ' ' - DISPLAY 'Test 5 failed: ' out - END-IF - - MOVE HIGH-VALUES TO b - MOVE LOW-VALUES TO c - XML GENERATE out FROM a - SUPPRESS EVERY ELEMENT WHEN HIGH-VALUES OR LOW-VALUES - OR ZEROES OR SPACES - IF out <> '' - DISPLAY 'Test 6 failed: ' out - END-IF - - XML GENERATE out FROM x SUPPRESS z WHEN SPACE - IF out <> '' - DISPLAY 'Test 7 failed: ' out - END-IF - . -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [], []) -AT_CLEANUP - - -AT_SETUP([XML GENERATE exceptions]) -AT_KEYWORDS([extensions XML-CODE]) - -AT_SKIP_IF([test "$COB_HAS_XML2" = "no"]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 normal-str PIC X(200). - - 01 valid-rec. - 03 a PIC XX VALUE "aa". - 03 b PIC XX VALUE "bb". - 01 short-str PIC X(5). - 01 xml-len PIC 99. - - 01 valid-namespace CONSTANT "http://www.w3.org/1999/xhtml". - 01 invalid-namespace CONSTANT X"00". - 01 invalid-prefix PIC XXX VALUE "#<>". - 01 invalid-content PIC X(3) VALUE X"8AFF00". - 01 count-in-too-small PIC 9. - - PROCEDURE DIVISION. - XML GENERATE short-str FROM valid-rec - COUNT IN xml-len - IF short-str <> " 42 - OR XML-CODE <> 400 - DISPLAY "Failed 1: " short-str " " xml-len " " XML-CODE - END-IF - - XML GENERATE normal-str FROM valid-rec - NAMESPACE invalid-namespace - IF XML-CODE <> 416 - DISPLAY "Failed 2: " FUNCTION TRIM (normal-str) - " " XML-CODE - END-IF - - XML GENERATE normal-str FROM invalid-content - IF normal-str <> '8aff00' - OR XML-CODE <> 417 - DISPLAY "Failed 3: " FUNCTION TRIM (normal-str) - " " XML-CODE - END-IF - - XML GENERATE normal-str FROM valid-rec - NAMESPACE "http://www.w3.org/1999/xhtml" - NAMESPACE-PREFIX invalid-prefix - IF XML-CODE <> 419 - DISPLAY "Failed 4: " FUNCTION TRIM (normal-str) - " " XML-CODE - END-IF - - XML GENERATE normal-str FROM valid-rec - ON EXCEPTION - DISPLAY "Failed 5: EXCEPTION " - FUNCTION TRIM (normal-str) - " " XML-CODE - END-DISPLAY - *> The END-DISPLAY is important! Otherwise the DISPLAY will - *> take the NOT ON EXCEPTION. - - NOT ON EXCEPTION - IF XML-CODE <> 0 - DISPLAY "Failed 5: NOT EXCEPTION " - FUNCTION TRIM (normal-str) - " " XML-CODE - END-IF - END-XML - - XML GENERATE short-str FROM valid-rec - NOT EXCEPTION - DISPLAY "Failed 6: NOT EXCEPTION " - FUNCTION TRIM (normal-str) - " " XML-CODE - END-DISPLAY - - EXCEPTION - IF XML-CODE <> 400 - DISPLAY "Failed 6: ON EXCEPTION " - FUNCTION TRIM (normal-str) - " " XML-CODE - END-IF - END-XML - . -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [], []) -AT_CLEANUP - - -AT_SETUP([XML GENERATE record selection]) -AT_KEYWORDS([extensions]) - -AT_SKIP_IF([test "$COB_HAS_XML2" = "no"]) - -# TO-DO: Add support for generating OCCURS items. - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 a. - 03 b. - 05 c1 PIC X(3) VALUE "abc". - 05 c2 PIC 9(3) VALUE 0. - 03 d REDEFINES b. - 05 e PIC X(6). - 03 f PIC X OCCURS 3 VALUE "f". - - 66 h RENAMES c1 THRU c2. - - 01 out PIC X(60). - - PROCEDURE DIVISION. - *> XML GENERATE out FROM a - *> IF out <> 'abc0ff'- - *> 'f' - *> DISPLAY "Failed 1: " FUNCTION TRIM (out) - *> END-IF - - XML GENERATE out FROM d - IF out <> 'abc000' - DISPLAY "Failed 2: " FUNCTION TRIM (out) - END-IF - . - END PROGRAM prog. -]) -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [], []) -AT_CLEANUP - - -AT_SETUP([XML GENERATE trimming]) -AT_KEYWORDS([extensions]) - -AT_SKIP_IF([test "$COB_HAS_XML2" = "no"]) - -# TO-DO: Add support for IBM/COBOL 2002 edited floating point (e.g. PIC 9(3)E+99). - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 str PIC X(3) VALUE "ab". - 01 num-edited PIC 99.99 VALUE "01.00". - 01 leading-zeroes PIC 9(5) VALUE 5. - 01 decimal-num PIC 99V999 PACKED-DECIMAL VALUE 0.12. - 01 signed-decimal-num PIC S999 COMP-X VALUE -1. - 01 comp-5-item PIC 9(10) COMP-5 VALUE 5. - 01 index-item INDEX. - 01 float-short-item FLOAT-SHORT VALUE 100. - 01 float-long-item FLOAT-LONG VALUE 123.0E-10. - 01 just-item PIC X(10) JUST. - 01 integer-with-p PIC 999PPP VALUE 10000. - 01 decimal-with-p PIC VPP99 VALUE 0.0004. - - 01 out PIC X(300). - - PROCEDURE DIVISION. - XML GENERATE out FROM str - IF out <> 'ab' - DISPLAY "Failed 1: " FUNCTION TRIM (out) - END-IF - - XML GENERATE out FROM num-edited - IF out <> '01.00' - DISPLAY "Failed 2: " FUNCTION TRIM (out) - END-IF - - XML GENERATE out FROM leading-zeroes - IF out <> '5' - DISPLAY "Failed 3: " FUNCTION TRIM (out) - END-IF - - XML GENERATE out FROM decimal-num - IF out <> '0.120' - DISPLAY "Failed 4: " FUNCTION TRIM (out) - END-IF - - XML GENERATE out FROM signed-decimal-num - IF out <> '-1' - DISPLAY "Failed 5: " FUNCTION TRIM (out) - END-IF - - XML GENERATE out FROM comp-5-item - IF out <> '5' - DISPLAY "Failed 6: " FUNCTION TRIM (out) - END-IF - - SET index-item TO 500 - XML GENERATE out FROM index-item - IF out <> '500' - DISPLAY "Failed 7: " FUNCTION TRIM (out) - END-IF - - *> XML GENERATE out FROM float-short-item - *> IF out <> '1E+02' - *> DISPLAY "Failed 8: " FUNCTION TRIM (out) - *> END-IF - - *> XML GENERATE out FROM float-long-item - *> IF out <> '123E-10' - *> DISPLAY "Failed 9: " FUNCTION TRIM (out) - *> END-IF - - MOVE "blah " TO just-item - XML GENERATE out FROM just-item - IF out <> 'blah ' - DISPLAY "Failed 10: " FUNCTION TRIM (out) - END-IF - - XML GENERATE out FROM integer-with-p - IF out <> '10000' - DISPLAY "Failed 11: " FUNCTION TRIM (out) - END-IF - - XML GENERATE out FROM decimal-with-p - IF out <> '0.0004' - DISPLAY "Failed 12: " FUNCTION TRIM (out) - END-IF - . -]) -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [], []) -AT_CLEANUP - - -AT_SETUP([JSON GENERATE general]) -AT_KEYWORDS([extensions]) - -AT_SKIP_IF([test "$COB_HAS_CJSON" = "no"]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 out PIC X(200). - 01 rec. - 03 a PIC X(3) VALUE 'A'. - 03 b PIC X(3) VALUE ALL 'B'. - 03 c. - 05 d PIC X(3) VALUE SPACES. - - PROCEDURE DIVISION. - JSON GENERATE out - FROM rec - NAME OF a IS 'alpha', d IS 'ABCDEF' - SUPPRESS c - IF out <> '{"rec":{"alpha":"A","b":"BBB"}}' - DISPLAY 'Test 1 failed: ' FUNCTION TRIM (out) - END-IF - - JSON GENERATE out FROM d - IF out <> '{"d":" "}' - DISPLAY 'Test 2 failed: ' FUNCTION TRIM (out) - END-IF - - JSON GENERATE out FROM c - IF out <> '{"c":{"d":" "}}' - DISPLAY 'Test 3 failed: ' FUNCTION TRIM (out) - END-IF - - MOVE ALL QUOTES TO d - JSON GENERATE out FROM d - IF out <> '{"d":"\"\"\""}' - DISPLAY 'Test 4 failed: ' FUNCTION TRIM (out) - END-IF - . -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [], []) -AT_CLEANUP - - -AT_SETUP([JSON GENERATE SUPPRESS]) -AT_KEYWORDS([extensions]) - -AT_SKIP_IF([test "$COB_HAS_CJSON" = "no"]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 a. - 03 b PIC X(3) VALUE SPACES. - 03 c PIC X(3) VALUE SPACES. - - 01 x. - 03 y. - 05 z PIC X VALUE SPACE. - - 01 out PIC X(100). - - PROCEDURE DIVISION. - JSON GENERATE out FROM a SUPPRESS b - IF out <> '{"a":{"c":" "}}' - DISPLAY 'Test 1 failed: ' out - END-IF - - JSON GENERATE out FROM x SUPPRESS z - IF out <> '{"x":{}}' - DISPLAY 'Test 2 failed: ' out - END-IF - . -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [], []) -AT_CLEANUP - - -AT_SETUP([JSON GENERATE exceptions]) -AT_KEYWORDS([extensions JSON-CODE]) - -AT_SKIP_IF([test "$COB_HAS_CJSON" = "no"]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 normal-str PIC X(200). - - 01 valid-rec. - 03 a PIC XX VALUE "aa". - 03 b PIC XX VALUE "bb". - 01 short-str PIC X(5). - 01 json-len PIC 99. - - PROCEDURE DIVISION. - JSON GENERATE short-str FROM valid-rec - COUNT IN json-len - IF short-str <> '{"val' - OR json-len <> 33 - OR JSON-CODE <> 1 - DISPLAY "Failed 1: " short-str " " json-len " " JSON-CODE - END-IF - - JSON GENERATE normal-str FROM valid-rec - ON EXCEPTION - DISPLAY "Failed 2: EXCEPTION " - FUNCTION TRIM (normal-str) - " " JSON-CODE - END-DISPLAY - - NOT ON EXCEPTION - IF JSON-CODE <> 0 - DISPLAY "Failed 2: NOT EXCEPTION " - FUNCTION TRIM (normal-str) - " " JSON-CODE - END-IF - END-JSON - - JSON GENERATE short-str FROM valid-rec - NOT EXCEPTION - DISPLAY "Failed 3: NOT EXCEPTION " - FUNCTION TRIM (normal-str) - " " JSON-CODE - END-DISPLAY - - EXCEPTION - IF JSON-CODE <> 1 - DISPLAY "Failed 3: ON EXCEPTION " - FUNCTION TRIM (normal-str) - " " JSON-CODE - END-IF - END-JSON - . -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [], []) -AT_CLEANUP - - -AT_SETUP([JSON GENERATE record selection]) -AT_KEYWORDS([extensions]) - -AT_SKIP_IF([test "$COB_HAS_CJSON" = "no"]) - -# TO-DO: Add support for generating OCCURS items. - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 a. - 03 b. - 05 c1 PIC X(3) VALUE "abc". - 05 c2 PIC 9(3) VALUE 0. - 03 d REDEFINES b. - 05 e PIC X(6). - 03 f PIC X OCCURS 3 VALUE "f". - - 66 h RENAMES c1 THRU c2. - - 01 out PIC X(60). - - PROCEDURE DIVISION. - *> JSON GENERATE out FROM a - *> IF out <> 'abc0ff'- - *> 'f' - *> DISPLAY "Failed 1: " FUNCTION TRIM (out) - *> END-IF - - JSON GENERATE out FROM d - IF out <> '{"d":{"e":"abc000"}}' - DISPLAY "Failed 2: " FUNCTION TRIM (out) - END-IF - . - END PROGRAM prog. -]) -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [], []) -AT_CLEANUP - - -AT_SETUP([JSON GENERATE trimming]) -AT_KEYWORDS([extensions]) - -AT_SKIP_IF([test "$COB_HAS_CJSON" = "no"]) - -# TO-DO: Add support for IBM/COBOL 2002 edited floating point (e.g. PIC 9(3)E+99). - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 str PIC X(3) VALUE "ab". - 01 num-edited PIC 99.99 VALUE "01.00". - 01 leading-zeroes PIC 9(5) VALUE 5. - 01 decimal-num PIC 99V999 PACKED-DECIMAL VALUE 0.12. - 01 signed-decimal-num PIC S999 COMP-X VALUE -1. - 01 comp-5-item PIC 9(10) COMP-5 VALUE 5. - 01 index-item INDEX. - 01 float-short-item FLOAT-SHORT VALUE 100. - 01 float-long-item FLOAT-LONG VALUE 123.0E-10. - 01 just-item PIC X(10) JUST. - 01 integer-with-p PIC 999PPP VALUE 10000. - 01 decimal-with-p PIC VPP99 VALUE 0.0004. - - 01 out PIC X(300). - - PROCEDURE DIVISION. - JSON GENERATE out FROM str - IF out <> '{"str":"ab"}' - DISPLAY "Failed 1: " FUNCTION TRIM (out) - END-IF - - JSON GENERATE out FROM num-edited - IF out <> '{"num-edited":"01.00"}' - DISPLAY "Failed 2: " FUNCTION TRIM (out) - END-IF - - JSON GENERATE out FROM leading-zeroes - IF out <> '{"leading-zeroes":5}' - DISPLAY "Failed 3: " FUNCTION TRIM (out) - END-IF - - JSON GENERATE out FROM decimal-num - IF out <> '{"decimal-num":0.120}' - DISPLAY "Failed 4: " FUNCTION TRIM (out) - END-IF - - JSON GENERATE out FROM signed-decimal-num - IF out <> '{"signed-decimal-num":-1}' - DISPLAY "Failed 5: " FUNCTION TRIM (out) - END-IF - - JSON GENERATE out FROM comp-5-item - IF out <> '{"comp-5-item":5}' - DISPLAY "Failed 6: " FUNCTION TRIM (out) - END-IF - - SET index-item TO 500 - JSON GENERATE out FROM index-item - IF out <> '{"index-item":500}' - DISPLAY "Failed 7: " FUNCTION TRIM (out) - END-IF - - *> JSON GENERATE out FROM float-short-item - *> IF out <> '{"float-short-item":1E+02}' - *> DISPLAY "Failed 8: " FUNCTION TRIM (out) - *> END-IF - - *> JSON GENERATE out FROM float-long-item - *> IF out <> '{"float-long-item":123E-10}' - *> DISPLAY "Failed 9: " FUNCTION TRIM (out) - *> END-IF - - MOVE "blah " TO just-item - JSON GENERATE out FROM just-item - IF out <> '{"just-item":"blah "}' - DISPLAY "Failed 10: " FUNCTION TRIM (out) - END-IF - - JSON GENERATE out FROM integer-with-p - IF out <> '{"integer-with-p":10000}' - DISPLAY "Failed 11: " FUNCTION TRIM (out) - END-IF - - JSON GENERATE out FROM decimal-with-p - IF out <> '{"decimal-with-p":0.0004}' - DISPLAY "Failed 12: " FUNCTION TRIM (out) - END-IF - . -]) -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [], []) -AT_CLEANUP diff -Nru gnucobol-4.0~early~20200606/tests/testsuite.src/run_refmod.at gnucobol-5/tests/testsuite.src/run_refmod.at --- gnucobol-4.0~early~20200606/tests/testsuite.src/run_refmod.at 2020-06-06 20:52:00.000000000 +0000 +++ gnucobol-5/tests/testsuite.src/run_refmod.at 1970-01-01 00:00:00.000000000 +0000 @@ -1,380 +0,0 @@ -## Copyright (C) 2003-2012, 2014-2015, 2017-2019 Free Software Foundation, Inc. -## Written by Keisuke Nishida, Roger While, Simon Sobisch -## -## This file is part of GnuCOBOL. -## -## The GnuCOBOL compiler is free software: you can redistribute it -## and/or modify it under the terms of the GNU General Public License -## as published by the Free Software Foundation, either version 3 of the -## License, or (at your option) any later version. -## -## GnuCOBOL is distributed in the hope that it will be useful, -## but WITHOUT ANY WARRANTY; without even the implied warranty of -## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -## GNU General Public License for more details. -## -## You should have received a copy of the GNU General Public License -## along with GnuCOBOL. If not, see . - -### GnuCOBOL Test Suite - -### ISO+IEC+1989-2002 8.4.2.3 Reference-modification - -## 8.4.2.3.3 General rules - -AT_SETUP([Static reference modification]) -AT_KEYWORDS([refmod]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 X PIC X(4) VALUE "abcd". - PROCEDURE DIVISION. - DISPLAY X(1:1) ":" X(1:2) ":" X(1:3) ":" X(1:4) ":" X(1:) - END-DISPLAY. - DISPLAY X(2:1) ":" X(2:2) ":" X(2:3) ":" X(2:) - END-DISPLAY. - DISPLAY X(3:1) ":" X(3:2) ":" X(3:) - END-DISPLAY. - DISPLAY X(4:1) ":" X(4:) - END-DISPLAY. - STOP RUN. -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], -[a:ab:abc:abcd:abcd -b:bc:bcd:bcd -c:cd:cd -d:d -]) - -AT_CLEANUP - - -AT_SETUP([Dynamic reference modification]) -AT_KEYWORDS([refmod]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 X PIC X(4) VALUE "abcd". - 01 I PIC 9. - PROCEDURE DIVISION. - MOVE 1 TO I. - DISPLAY X(I:1) - END-DISPLAY. - MOVE 4 TO I. - DISPLAY X(I:1) - END-DISPLAY. - MOVE 1 TO I. - DISPLAY X(1:I) - END-DISPLAY. - MOVE 4 TO I. - DISPLAY X(1:I) - END-DISPLAY. - STOP RUN. -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], -[a -d -a -abcd -]) - -AT_CLEANUP - - -AT_SETUP([Offset underflow]) -AT_KEYWORDS([refmod]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 X PIC X(4) VALUE "abcd". - 01 I PIC 9 VALUE 0. - PROCEDURE DIVISION. - DISPLAY X(I:1) NO ADVANCING - END-DISPLAY. - STOP RUN. -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [1], [], -[libcob: prog.cob:9: error: offset of 'X' out of bounds: 0 -]) - -AT_CLEANUP - - -AT_SETUP([Offset overflow]) -AT_KEYWORDS([refmod]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 X PIC X(4) VALUE "abcd". - 01 I PIC 9 VALUE 5. - PROCEDURE DIVISION. - DISPLAY X(I:1) NO ADVANCING - END-DISPLAY. - STOP RUN. -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [1], [], -[libcob: prog.cob:9: error: offset of 'X' out of bounds: 5, maximum: 4 -]) - -AT_DATA([prog2.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog2. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 X PIC X(4) VALUE "abcd". - 01 I PIC 9 VALUE 5. - PROCEDURE DIVISION. - DISPLAY X(I:1) NO ADVANCING - END-DISPLAY. - STOP RUN. -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [1], [], -[libcob: prog.cob:9: error: offset of 'X' out of bounds: 5, maximum: 4 -]) - -AT_CHECK([$COMPILE prog2.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog2], [1], [], -[libcob: prog2.cob:9: error: offset of 'X' out of bounds: 5, maximum: 4 -]) - -AT_CLEANUP - - -AT_SETUP([Length underflow]) -AT_KEYWORDS([refmod]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 X PIC X(4) VALUE "abcd". - 01 I PIC 9 VALUE 0. - PROCEDURE DIVISION. - DISPLAY X(1:I) NO ADVANCING - END-DISPLAY. - STOP RUN. -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [1], [], -[libcob: prog.cob:9: error: length of 'X' out of bounds: 0 -]) - -AT_CLEANUP - - -AT_SETUP([Length overflow]) -AT_KEYWORDS([refmod]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 X PIC X(4) VALUE "abcd". - 01 I PIC 9 VALUE 5. - PROCEDURE DIVISION. - DISPLAY X(1:I) NO ADVANCING - END-DISPLAY. - STOP RUN. -]) - -AT_DATA([prog2.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog2. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 X PIC X(4) VALUE "abcd". - 01 I PIC 9 VALUE 5. - PROCEDURE DIVISION. - DISPLAY X(3:I) NO ADVANCING - END-DISPLAY. - STOP RUN. -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [1], [], -[libcob: prog.cob:9: error: length of 'X' out of bounds: 5, maximum: 4 -]) - -AT_CHECK([$COMPILE prog2.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog2], [1], [], -[libcob: prog2.cob:9: error: length of 'X' out of bounds: 5, maximum: 4 -]) - -AT_CLEANUP - - -AT_SETUP([Length overflow with offset]) -AT_KEYWORDS([refmod]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 X PIC X(4) VALUE "abcd". - 01 I PIC 9 VALUE 3. - PROCEDURE DIVISION. - DISPLAY X(3:I) NO ADVANCING - END-DISPLAY. - STOP RUN. -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [1], [], -[libcob: prog.cob:9: error: length of 'X' out of bounds: 3, starting at: 3, maximum: 4 -]) - -AT_CLEANUP - -AT_SETUP([Test Reference Modification]) -AT_KEYWORDS([Numeric]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 TSTLEN PIC 99 VALUE 10. - 01 TSTBIN PIC 99 COMP VALUE 10. - 01 TSTBIN10 PIC 9(9) COMP VALUE 825373492. - 01 TSTX4 PIC X(4). - 01 TSTREC. - 05 TSTTAIL2 PIC X. - 05 TSTTAIL3 PIC X. - 05 FILLER PIC X(8). - 05 TSTEND PIC X. - 01 TSTREC2 PIC X(20). - 01 TSTXX PIC X(2). - PROCEDURE DIVISION. - MOVE ALL "x" TO TSTREC. - DISPLAY "MOVEs to TSTTAIL3 (2:8)". - MOVE SPACES TO TSTTAIL3 (2:8). - DISPLAY "SPACES : " TSTREC. - MOVE ALL "x" TO TSTREC. - MOVE ALL " " TO TSTTAIL3 (2:8). - DISPLAY "ALL ' ': " TSTREC. - MOVE ALL "x" TO TSTREC. - MOVE " " TO TSTTAIL3 (2:8). - DISPLAY "' ' : " TSTREC. - MOVE ALL "x" TO TSTREC. - MOVE "ABC" TO TSTTAIL3 (2:8). - DISPLAY "ABC : " TSTREC. - MOVE ALL "x" TO TSTREC. - MOVE X"4142" TO TSTTAIL3 (2:8). - DISPLAY "x4142 : " TSTREC. - IF TSTTAIL3 (2:8) = X"4142" - DISPLAY "IF = 'AB' is good" - ELSE - DISPLAY "IF = 'AB' is Bad!" - END-IF. - - DISPLAY "MOVEs to TSTREC2 (3:15)". - MOVE ALL "x" TO TSTREC2. - MOVE SPACES TO TSTREC2 (3:15). - DISPLAY "SPACE : " TSTREC2. - MOVE ALL "x" TO TSTREC2. - MOVE ALL " " TO TSTREC2 (3:15). - DISPLAY "ALL' ' : " TSTREC2. - MOVE ALL "x" TO TSTREC2. - MOVE " " TO TSTREC2 (3:15). - DISPLAY "' ' : " TSTREC2. - MOVE ALL "x" TO TSTREC2. - MOVE "DEF" TO TSTREC2 (3:15). - DISPLAY "DEF : " TSTREC2. - MOVE ALL "x" TO TSTREC2. - MOVE X"4344" TO TSTREC2 (3:15). - DISPLAY "x4344 : " TSTREC2. - - MOVE SPACES TO TSTREC2. - - MOVE " " TO TSTTAIL2 (1:2). - MOVE ALL "*" TO TSTREC (1:TSTLEN). - MOVE '$' TO TSTEND. - DISPLAY "TSTREC is " TSTREC. - MOVE ALL "+" TO TSTTAIL3 (1:TSTLEN). - MOVE '$' TO TSTEND. - DISPLAY "TSTREC is " TSTREC. - MOVE 11 to TSTLEN. - MOVE SPACES TO TSTTAIL2 (1:TSTLEN). - MOVE '$' TO TSTEND. - DISPLAY "TSTREC is " TSTREC. - MOVE '12' TO TSTXX. - MOVE TSTXX TO TSTLEN. - DISPLAY "TSTLEN is " TSTLEN. - MOVE ' 3' TO TSTXX. - MOVE TSTXX TO TSTLEN. - DISPLAY "TSTLEN is " TSTLEN. - MOVE ' ' TO TSTXX. - MOVE TSTXX TO TSTLEN. - DISPLAY "TSTLEN is " TSTLEN. - MOVE 75 TO TSTLEN. - MOVE TSTLEN TO TSTXX. - DISPLAY "TSTXX is " TSTXX " vs " TSTLEN. - MOVE ' 3' TO TSTXX. - MOVE TSTXX TO TSTBIN. - DISPLAY "TSTBIN is " TSTBIN. - ADD 1 to TSTBIN. - MOVE TSTBIN TO TSTXX. - DISPLAY "TSTXX is " TSTXX " vs " TSTBIN. - MOVE TSTBIN10 (1:4) TO TSTX4 (1:4). - DISPLAY "TSTBIN10 is " TSTBIN10 " vs '" TSTX4 "'". - MOVE 10 TO TSTLEN. - MOVE ALL "x" TO TSTTAIL3 (1:TSTLEN + 2). - STOP RUN. -]) - -AT_CHECK([cobc -x -std=mf -debug -Wall prog.cob ], [0], [], []) - -AT_CHECK([./prog], [1], [MOVEs to TSTTAIL3 (2:8) -SPACES : xx x -ALL ' ': xx x -' ' : xx x -ABC : xxABC x -x4142 : xxAB x -IF = 'AB' is good -MOVEs to TSTREC2 (3:15) -SPACE : xx xxx -ALL' ' : xx xxx -' ' : xx xxx -DEF : xxDEF xxx -x4344 : xxCD xxx -TSTREC is **********$ -TSTREC is *+++++++++$ -TSTREC is $ -TSTLEN is 12 -TSTLEN is 03 -TSTLEN is 00 -TSTXX is 75 vs 75 -TSTBIN is 03 -TSTXX is 04 vs 04 -TSTBIN10 is 825373492 vs '1234' -], [libcob: prog.cob:91: error: length of 'TSTTAIL3' out of bounds: 12, maximum: 10 -]) - -AT_CLEANUP - diff -Nru gnucobol-4.0~early~20200606/tests/testsuite.src/run_reportwriter.at gnucobol-5/tests/testsuite.src/run_reportwriter.at --- gnucobol-4.0~early~20200606/tests/testsuite.src/run_reportwriter.at 2020-06-06 20:52:00.000000000 +0000 +++ gnucobol-5/tests/testsuite.src/run_reportwriter.at 1970-01-01 00:00:00.000000000 +0000 @@ -1,9206 +0,0 @@ -## Copyright (C) 2014-2020 Free Software Foundation, Inc. -## Written by Ron Norman, Simon Sobisch -## -## This file is part of GnuCOBOL. -## -## The GnuCOBOL compiler is free software: you can redistribute it -## and/or modify it under the terms of the GNU General Public License -## as published by the Free Software Foundation, either version 3 of the -## License, or (at your option) any later version. -## -## GnuCOBOL is distributed in the hope that it will be useful, -## but WITHOUT ANY WARRANTY; without even the implied warranty of -## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -## GNU General Public License for more details. -## -## You should have received a copy of the GNU General Public License -## along with GnuCOBOL. If not, see . - -### GnuCOBOL Test Suite - -### ISO+IEC+1989-2014 REPORT WRITER module - -AT_SETUP([Report Line Order]) -AT_KEYWORDS([report file mapping]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - *>**************************************************************** - *> 11NOV2013 BUG 001 - RWCS Presents RF before it presents the ** - *> last PF ** - *>**************************************************************** - ENVIRONMENT DIVISION. - INPUT-OUTPUT SECTION. - FILE-CONTROL. - SELECT REPORT-FILE ASSIGN TO EXTERNAL PRINTOUT - LINE SEQUENTIAL. - DATA DIVISION. - FILE SECTION. - FD REPORT-FILE - REPORT IS RWCS-Report. - WORKING-STORAGE SECTION. - REPORT SECTION. - RD RWCS-Report - PAGE LIMIT 12 - HEADING 1 - FIRST DETAIL 4 - LAST DETAIL 7. - - 01 TYPE REPORT HEADING LINE 1. - 05 COL 1 VALUE 'RH'. - - 01 TYPE PAGE HEADING LINE PLUS 1. - 05 COL 1 VALUE 'PH'. - - 01 Detail-Line TYPE DETAIL LINE PLUS 1. - 05 COL 1 VALUE 'DE'. - - 01 TYPE PAGE FOOTING LINE NUMBER 10. - 05 COL 1 VALUE 'PF'. - - 01 TYPE REPORT FOOTING LINE NUMBER PLUS 1. - 05 COL 1 VALUE 'RF'. - - PROCEDURE DIVISION. - 010-Main SECTION. - 1. OPEN OUTPUT REPORT-FILE - INITIATE RWCS-Report - GENERATE Detail-Line - GENERATE Detail-Line - GENERATE Detail-Line - GENERATE Detail-Line - GENERATE Detail-Line - GENERATE Detail-Line - GENERATE Detail-Line - GENERATE Detail-Line - TERMINATE RWCS-Report - CLOSE REPORT-FILE - . -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) - -AT_CHECK([DD_PRINTOUT="./report.txt" $COBCRUN_DIRECT ./prog], [0], [], []) - - -AT_CAPTURE_FILE(./report.txt) - -AT_DATA([reference], [RH -PH - -DE -DE -DE -DE - - -PF - -PH - - -DE -DE -DE -DE - - - -PF - -RF -]) - -AT_CHECK([diff reference report.txt], [0], [], []) - -AT_CLEANUP - - -AT_SETUP([REPORT COL PLUS]) -AT_KEYWORDS([report runfile]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - *>**************************************************************** - *> 11NOV2013 BUG 002 - RWCS Treats "COL PLUS n" the same as ** - *> "COL n". ** - *>**************************************************************** - ENVIRONMENT DIVISION. - INPUT-OUTPUT SECTION. - FILE-CONTROL. - SELECT REPORT-FILE ASSIGN TO EXTERNAL PRINTOUT - LINE SEQUENTIAL. - DATA DIVISION. - FILE SECTION. - FD REPORT-FILE - REPORT IS RWCS-Report. - WORKING-STORAGE SECTION. - REPORT SECTION. - RD RWCS-Report - PAGE LIMIT 12 - HEADING 1 - FIRST DETAIL 4 - LAST DETAIL 7. - - 01 Detail-Line TYPE DETAIL. - 05 LINE NUMBER PLUS 1. - 10 COL 1 PIC X(20) VALUE '12345678901234567890'. - 10 COL PLUS 3 PIC X(4) VALUE 'ABCD'. - 10 COL 30 PIC X(1) VALUE '!'. - - PROCEDURE DIVISION. - 010-Main SECTION. - 1. OPEN OUTPUT REPORT-FILE - INITIATE RWCS-Report - GENERATE Detail-Line - TERMINATE RWCS-Report - CLOSE REPORT-FILE - . -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) - -AT_CHECK([DD_PRINTOUT="./report.txt" $COBCRUN_DIRECT ./prog], [0], [], []) - - -AT_CAPTURE_FILE(./report.txt) - -AT_DATA([reference], [ - - -12345678901234567890 ABCD ! - - - - - - - - -]) - -AT_CHECK([diff reference report.txt], [0], [], []) - -AT_CLEANUP - - -AT_SETUP([Report Overlapping Fields]) -AT_KEYWORDS([report runfile]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - *>**************************************************************** - *> 11NOV2013 BUG 003 - RWCS causes "Abort trap 6" if an attempt ** - *> is made to overwrite previous field on ** - *> a line ** - *>**************************************************************** - ENVIRONMENT DIVISION. - INPUT-OUTPUT SECTION. - FILE-CONTROL. - SELECT REPORT-FILE ASSIGN TO EXTERNAL PRINTOUT - LINE SEQUENTIAL. - DATA DIVISION. - FILE SECTION. - FD REPORT-FILE - REPORT IS RWCS-Report. - WORKING-STORAGE SECTION. - REPORT SECTION. - RD RWCS-Report - PAGE LIMIT 12 - HEADING 1 - FIRST DETAIL 4 - LAST DETAIL 7. - - 01 Detail-Line TYPE DETAIL. - 05 LINE NUMBER PLUS 1. - 10 COL 1 PIC X(20) VALUE '12345678901234567890'. - 10 COL 10 PIC X(4) VALUE 'ABCD'. - - PROCEDURE DIVISION. - 010-Main SECTION. - 1. OPEN OUTPUT REPORT-FILE - INITIATE RWCS-Report - GENERATE Detail-Line - TERMINATE RWCS-Report - CLOSE REPORT-FILE - . -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) - -AT_CHECK([DD_PRINTOUT="./report.txt" $COBCRUN_DIRECT ./prog], [0], [], []) - - -AT_CAPTURE_FILE(./report.txt) - -AT_DATA([reference], [ - - -123456789ABCD4567890 - - - - - - - - -]) - -AT_CHECK([diff reference report.txt], [0], [], []) - -AT_CLEANUP - - -AT_SETUP([EMPTY REPORT]) -AT_KEYWORDS([report runfile]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - *>**************************************************************** - *> 11NOV2013 BUG 004 - RWCS INITIATE TERMINATE W/O GENERATE ** - *> IS NOT SUPPOSED TO PRODUCE ANY OUTPUT ** - *>**************************************************************** - ENVIRONMENT DIVISION. - INPUT-OUTPUT SECTION. - FILE-CONTROL. - SELECT REPORT-FILE ASSIGN TO EXTERNAL PRINTOUT - LINE SEQUENTIAL. - DATA DIVISION. - FILE SECTION. - FD REPORT-FILE - REPORT IS RWCS-Report. - WORKING-STORAGE SECTION. - REPORT SECTION. - RD RWCS-Report - PAGE LIMIT 12 - HEADING 1 - FIRST DETAIL 4 - LAST DETAIL 7 - CONTROL IS FINAL. - - 01 TYPE REPORT HEADING LINE 1. - 05 COL 1 VALUE 'RH'. - - 01 TYPE PAGE HEADING LINE PLUS 1. - 05 COL 1 VALUE 'PH'. - - 01 Detail-Line TYPE DETAIL LINE PLUS 1. - 05 COL 1 VALUE 'DE'. - - 01 TYPE CONTROL FOOTING FINAL. - 05 COL 1 VALUE 'CFF'. - - 01 TYPE PAGE FOOTING LINE NUMBER 10. - 05 COL 1 VALUE 'PF'. - - 01 TYPE REPORT FOOTING LINE NUMBER 1. - 05 COL 1 VALUE 'RF'. - - PROCEDURE DIVISION. - 010-Main SECTION. - 1. OPEN OUTPUT REPORT-FILE - INITIATE RWCS-Report - TERMINATE RWCS-Report - CLOSE REPORT-FILE - . -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) - -AT_CHECK([DD_PRINTOUT="./report.txt" $COBCRUN_DIRECT ./prog], [0], [], []) - - -AT_CAPTURE_FILE(./report.txt) - -AT_DATA([reference], []) - -AT_CHECK([diff reference report.txt], [0], [], []) - -AT_CLEANUP - - -AT_SETUP([PAGE LIMIT REPORT]) -AT_KEYWORDS([report runfile]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - - ENVIRONMENT DIVISION. - INPUT-OUTPUT SECTION. - FILE-CONTROL. - SELECT report-file ASSIGN EXTERNAL PRINTOUT - ORGANIZATION LINE SEQUENTIAL. - - DATA DIVISION. - FILE SECTION. - FD report-file REPORT rp. - - WORKING-STORAGE SECTION. - 01 foo PIC X(20). - 01 hedpos PIC 99 VALUE 10. - - REPORT SECTION. - RD rp PAGE LIMIT 3. - - 01 rp-detail TYPE DE. - 02 LINE + 1. - 03 COL 1; SOURCE foo, PIC X(30). - 03 COL + 2 PIC X(6) VALUE "<--->". - - PROCEDURE DIVISION. - OPEN OUTPUT report-file. - INITIATE rp. - - MOVE "hello" TO foo. - GENERATE rp-detail. - - MOVE "goodbye" TO foo. - GENERATE rp-detail. - - TERMINATE rp. - CLOSE report-file. - STOP RUN. - END PROGRAM prog. -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) - -AT_CHECK([DD_PRINTOUT=./report.txt $COBCRUN_DIRECT ./prog], [0], [], []) - - -AT_CAPTURE_FILE(./report.txt) - -AT_DATA([reference], [hello <---> -goodbye <---> - -]) - -AT_CHECK([diff reference report.txt], [0]) - -AT_CLEANUP - - -AT_SETUP([PAGE LIMIT REPORT 2]) -AT_KEYWORDS([report runfile]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - INPUT-OUTPUT SECTION. - FILE-CONTROL. - SELECT report-file ASSIGN EXTERNAL PRINTOUT - ORGANIZATION LINE SEQUENTIAL. - - DATA DIVISION. - FILE SECTION. - FD report-file REPORT rp. - - WORKING-STORAGE SECTION. - 01 foo PIC X(20). - - REPORT SECTION. - RD rp PAGE LIMIT 3 LINES. - - 01 rp-detail TYPE DE. - 02 LINE + 1. - 03 SOURCE foo, PIC X(30). - 03 COL + 2 PIC X(6) VALUE "<--->". - - PROCEDURE DIVISION. - OPEN OUTPUT report-file. - INITIATE rp. - - MOVE "hello" TO foo. - GENERATE rp-detail. - - MOVE "world" TO foo. - GENERATE rp-detail. - - MOVE "from" TO foo. - GENERATE rp-detail. - - MOVE "REPORT WRITER" TO foo. - GENERATE rp-detail. - - MOVE "goodbye" TO foo. - GENERATE rp-detail. - - TERMINATE rp - CLOSE report-file. - - STOP RUN. -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) - -AT_CHECK([DD_PRINTOUT=./report.txt $COBCRUN_DIRECT ./prog], [0], [], []) - - -AT_CAPTURE_FILE(./report.txt) - -AT_DATA([reference], [hello <---> -world <---> -from <---> -REPORT WRITER <---> -goodbye <---> - -]) - -AT_CHECK([diff reference report.txt], [0]) - -AT_CLEANUP - - -AT_SETUP([Sample Customer Report]) -AT_KEYWORDS([report runfile]) - -AT_DATA([inp_data],[0152 J. LANGDON 87653 02475 -0152 J. LANGDON 64025 00945 -0152 J. LANGDON 41915 01370 -0152 J. LANGDON 17410 00251 -2468 L. MORRISEY 18520 00375 -2468 L. MORRISEY 20012 00420 -2468 L. MORRISEY 31572 01015 -2468 L. MORRISEY 48792 03750 -2468 L. MORRISEY 50407 01515 -2468 L. MORRISEY 61575 02010 -2468 L. MORRISEY 79204 05170 -2468 L. MORRISEY 85075 03784 -2468 L. MORRISEY 98476 08794 -3451 M. JACKSON 37847 02790 -3451 M. JACKSON 58492 06850 -3451 M. JACKSON 60010 02040 -3451 M. JACKSON 85260 07852 -3451 M. JACKSON 90520 02752 -4512 S. LEVITT 24680 03050 -4512 S. LEVITT 56784 05253 -4512 S. LEVITT 60410 01215 -4512 S. LEVITT 78952 08925 -4512 S. LEVITT 85278 04975 -4512 S. LEVITT 87492 06425 -4512 S. LEVITT 97204 08475 -5417 K. CONKLIN 13579 03572 -5417 K. CONKLIN 24615 01875 -5417 K. CONKLIN 34928 03745 -5417 K. CONKLIN 48527 08750 -5417 K. CONKLIN 50150 01895 -5417 K. CONKLIN 54652 03892 -5417 K. CONKLIN 59765 09895 -5417 K. CONKLIN 71572 01895 -5417 K. CONKLIN 85175 08010 -5417 K. CONKLIN 90275 00460 -5417 K. CONKLIN 91572 01857 -5417 K. CONKLIN 97576 08495 -6213 Z. HAMPTON 15792 06425 -6213 Z. HAMPTON 19975 09875 -6213 Z. HAMPTON 34576 05115 -6213 Z. HAMPTON 49512 08520 -7545 M. LARSON 14676 03845 -7545 M. LARSON 18592 08251 -7545 M. LARSON 19994 09898 -7545 M. LARSON 21214 01515 -7545 M. LARSON 37515 08212 -7545 M. LARSON 38592 09615 -7545 M. LARSON 48485 08714 -7545 M. LARSON 52762 03792 -7545 M. LARSON 57684 08015 -7545 M. LARSON 79015 09625 -7545 M. LARSON 80123 00560 -7545 M. LARSON 82462 02015 -7545 M. LARSON 91520 01815 -7545 M. LARSON 93715 04015 -]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - - * ************************************************************* * - * REPORT WRITER EXAMPLE #1. * - * ************************************************************* * - - ENVIRONMENT DIVISION. - CONFIGURATION SECTION. - - INPUT-OUTPUT SECTION. - FILE-CONTROL. - - SELECT TRANSACTION-DATA - ASSIGN TO EXTERNAL DATAIN - ORGANIZATION IS LINE SEQUENTIAL. - - SELECT REPORT-FILE - ASSIGN TO EXTERNAL LINE ADVANCING SYSPRINT. - - DATA DIVISION. - FILE SECTION. - - FD TRANSACTION-DATA. - - 01 TRANSACTION-RECORD. - 03 TR-CUSTOMER-NUMBER PIC 9(04). - 03 FILLER PIC X(01). - 03 TR-CUSTOMER-NAME PIC X(16). - 03 FILLER PIC X(01). - 03 TR-ITEM-NUMBER PIC 9(05). - 03 FILLER REDEFINES TR-ITEM-NUMBER. - 05 TR-ITEM-DEPARTMENT PIC 9(01). - 05 FILLER PIC 9(04). - 03 FILLER PIC X(01). - 03 TR-ITEM-COST PIC 9(03)V99. - 03 FILLER PIC X(47). - - FD REPORT-FILE - REPORT IS CUSTOMER-REPORT. - - WORKING-STORAGE SECTION. - 77 END-OF-FILE-SWITCH PIC X(1) VALUE 'N'. - 88 END-OF-FILE VALUE 'Y'. - - REPORT SECTION. - RD CUSTOMER-REPORT - PAGE LIMIT IS 66 LINES - HEADING 1 - FIRST DETAIL 5 - LAST DETAIL 58. - - 01 PAGE-HEAD-GROUP TYPE PAGE HEADING. - 02 LINE 1. - 03 COLUMN 27 PIC X(41) VALUE - 'C U S T O M E R C H A R G E R E P O R T'. - 02 LINE PLUS 2. - 03 COLUMN 01 PIC X(09) VALUE 'CUST. NO.'. - 03 COLUMN 15 PIC X(10) VALUE 'CUST. NAME'. - 03 COLUMN 30 PIC X(05) VALUE 'DEPT.'. - 03 COLUMN 39 PIC X(08) VALUE 'ITEM NO.'. - 03 COLUMN 51 PIC X(09) VALUE 'ITEM COST'. - - 01 CHARGE-DETAIL TYPE DETAIL. - 02 LINE PLUS 1. - 03 COLUMN 03 PIC Z(04) SOURCE TR-CUSTOMER-NUMBER. - 03 COLUMN 10 PIC X(16) SOURCE TR-CUSTOMER-NAME. - 03 COLUMN 32 PIC 9(01) SOURCE TR-ITEM-DEPARTMENT. - 03 COLUMN 40 PIC 9(05) SOURCE TR-ITEM-NUMBER. - 03 COLUMN 51 PIC $$$$.99 SOURCE TR-ITEM-COST. - - PROCEDURE DIVISION. - - 000-INITIATE. - - OPEN INPUT TRANSACTION-DATA, - OUTPUT REPORT-FILE. - - INITIATE CUSTOMER-REPORT. - - READ TRANSACTION-DATA - AT END - MOVE 'Y' TO END-OF-FILE-SWITCH. - * END-READ. - - PERFORM 100-PROCESS-TRANSACTION-DATA THRU 199-EXIT - UNTIL END-OF-FILE. - - 000-TERMINATE. - TERMINATE CUSTOMER-REPORT. - - CLOSE TRANSACTION-DATA, - REPORT-FILE. - - STOP RUN. - - 100-PROCESS-TRANSACTION-DATA. - GENERATE CHARGE-DETAIL. - READ TRANSACTION-DATA - AT END - MOVE 'Y' TO END-OF-FILE-SWITCH. - * END-READ. - - 199-EXIT. - EXIT. - - -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) - -AT_CHECK([DD_DATAIN="./inp_data" DD_SYSPRINT="./report.txt" $COBCRUN_DIRECT ./prog], [0], [], []) - - -AT_CAPTURE_FILE(./report.txt) - -AT_DATA([reference], [ C U S T O M E R C H A R G E R E P O R T - -CUST. NO. CUST. NAME DEPT. ITEM NO. ITEM COST - - 152 J. LANGDON 8 87653 $24.75 - 152 J. LANGDON 6 64025 $9.45 - 152 J. LANGDON 4 41915 $13.70 - 152 J. LANGDON 1 17410 $2.51 - 2468 L. MORRISEY 1 18520 $3.75 - 2468 L. MORRISEY 2 20012 $4.20 - 2468 L. MORRISEY 3 31572 $10.15 - 2468 L. MORRISEY 4 48792 $37.50 - 2468 L. MORRISEY 5 50407 $15.15 - 2468 L. MORRISEY 6 61575 $20.10 - 2468 L. MORRISEY 7 79204 $51.70 - 2468 L. MORRISEY 8 85075 $37.84 - 2468 L. MORRISEY 9 98476 $87.94 - 3451 M. JACKSON 3 37847 $27.90 - 3451 M. JACKSON 5 58492 $68.50 - 3451 M. JACKSON 6 60010 $20.40 - 3451 M. JACKSON 8 85260 $78.52 - 3451 M. JACKSON 9 90520 $27.52 - 4512 S. LEVITT 2 24680 $30.50 - 4512 S. LEVITT 5 56784 $52.53 - 4512 S. LEVITT 6 60410 $12.15 - 4512 S. LEVITT 7 78952 $89.25 - 4512 S. LEVITT 8 85278 $49.75 - 4512 S. LEVITT 8 87492 $64.25 - 4512 S. LEVITT 9 97204 $84.75 - 5417 K. CONKLIN 1 13579 $35.72 - 5417 K. CONKLIN 2 24615 $18.75 - 5417 K. CONKLIN 3 34928 $37.45 - 5417 K. CONKLIN 4 48527 $87.50 - 5417 K. CONKLIN 5 50150 $18.95 - 5417 K. CONKLIN 5 54652 $38.92 - 5417 K. CONKLIN 5 59765 $98.95 - 5417 K. CONKLIN 7 71572 $18.95 - 5417 K. CONKLIN 8 85175 $80.10 - 5417 K. CONKLIN 9 90275 $4.60 - 5417 K. CONKLIN 9 91572 $18.57 - 5417 K. CONKLIN 9 97576 $84.95 - 6213 Z. HAMPTON 1 15792 $64.25 - 6213 Z. HAMPTON 1 19975 $98.75 - 6213 Z. HAMPTON 3 34576 $51.15 - 6213 Z. HAMPTON 4 49512 $85.20 - 7545 M. LARSON 1 14676 $38.45 - 7545 M. LARSON 1 18592 $82.51 - 7545 M. LARSON 1 19994 $98.98 - 7545 M. LARSON 2 21214 $15.15 - 7545 M. LARSON 3 37515 $82.12 - 7545 M. LARSON 3 38592 $96.15 - 7545 M. LARSON 4 48485 $87.14 - 7545 M. LARSON 5 52762 $37.92 - 7545 M. LARSON 5 57684 $80.15 - 7545 M. LARSON 7 79015 $96.25 - 7545 M. LARSON 8 80123 $5.60 - 7545 M. LARSON 8 82462 $20.15 - 7545 M. LARSON 9 91520 $18.15 - - - - - - - - C U S T O M E R C H A R G E R E P O R T - -CUST. NO. CUST. NAME DEPT. ITEM NO. ITEM COST - - 7545 M. LARSON 9 93715 $40.15 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -]) - -AT_CHECK([diff reference report.txt], [0], [], []) - -AT_CLEANUP - - -AT_SETUP([Sample Charge Report]) -AT_KEYWORDS([report runfile]) - -AT_DATA([inp_data],[0152 J. LANGDON 87653 02475 -0152 J. LANGDON 64025 00945 -0152 J. LANGDON 41915 01370 -0152 J. LANGDON 17410 00251 -2468 L. MORRISEY 18520 00375 -2468 L. MORRISEY 20012 00420 -2468 L. MORRISEY 31572 01015 -2468 L. MORRISEY 48792 03750 -2468 L. MORRISEY 50407 01515 -2468 L. MORRISEY 61575 02010 -2468 L. MORRISEY 79204 05170 -2468 L. MORRISEY 85075 03784 -2468 L. MORRISEY 98476 08794 -3451 M. JACKSON 37847 02790 -3451 M. JACKSON 58492 06850 -3451 M. JACKSON 60010 02040 -3451 M. JACKSON 85260 07852 -3451 M. JACKSON 90520 02752 -4512 S. LEVITT 24680 03050 -4512 S. LEVITT 56784 05253 -4512 S. LEVITT 60410 01215 -4512 S. LEVITT 78952 08925 -4512 S. LEVITT 85278 04975 -4512 S. LEVITT 87492 06425 -4512 S. LEVITT 97204 08475 -5417 K. CONKLIN 13579 03572 -5417 K. CONKLIN 24615 01875 -5417 K. CONKLIN 34928 03745 -5417 K. CONKLIN 48527 08750 -5417 K. CONKLIN 50150 01895 -5417 K. CONKLIN 54652 03892 -5417 K. CONKLIN 59765 09895 -5417 K. CONKLIN 71572 01895 -5417 K. CONKLIN 85175 08010 -5417 K. CONKLIN 90275 00460 -5417 K. CONKLIN 91572 01857 -5417 K. CONKLIN 97576 08495 -6213 Z. HAMPTON 15792 06425 -6213 Z. HAMPTON 19975 09875 -6213 Z. HAMPTON 34576 05115 -6213 Z. HAMPTON 49512 08520 -7545 M. LARSON 14676 03845 -7545 M. LARSON 18592 08251 -7545 M. LARSON 19994 09898 -7545 M. LARSON 21214 01515 -7545 M. LARSON 37515 08212 -7545 M. LARSON 38592 09615 -7545 M. LARSON 48485 08714 -7545 M. LARSON 52762 03792 -7545 M. LARSON 57684 08015 -7545 M. LARSON 79015 09625 -7545 M. LARSON 80123 00560 -7545 M. LARSON 82462 02015 -7545 M. LARSON 91520 01815 -7545 M. LARSON 93715 04015 -]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - * ************************************************************* * - * REPORT WRITER EXAMPLE #2. * - * ************************************************************* * - - ENVIRONMENT DIVISION. - CONFIGURATION SECTION. - - INPUT-OUTPUT SECTION. - FILE-CONTROL. - - SELECT TRANSACTION-DATA - ASSIGN TO EXTERNAL DATAIN - ORGANIZATION IS LINE SEQUENTIAL. - - SELECT REPORT-FILE - ASSIGN TO EXTERNAL LINE ADVANCING SYSPRINT. - - DATA DIVISION. - FILE SECTION. - - FD TRANSACTION-DATA. - - 01 TRANSACTION-RECORD. - 03 TR-CUSTOMER-NUMBER PIC 9(04). - 03 FILLER PIC X(01). - 03 TR-CUSTOMER-NAME PIC X(16). - 03 FILLER PIC X(01). - 03 TR-ITEM-NUMBER PIC 9(05). - 03 FILLER REDEFINES TR-ITEM-NUMBER. - 05 TR-ITEM-DEPARTMENT PIC 9(01). - 05 FILLER PIC 9(04). - 03 FILLER PIC X(01). - 03 TR-ITEM-COST PIC 9(03)V99. - 03 FILLER PIC X(47). - - FD REPORT-FILE - REPORT IS CUSTOMER-REPORT. - - WORKING-STORAGE SECTION. - 77 END-OF-FILE-SWITCH PIC X(1) VALUE 'N'. - 88 END-OF-FILE VALUE 'Y'. - - 01 DISCOUNT-TABLE. - 02 FILLER PIC 99 VALUE 05. - 02 FILLER PIC 99 VALUE 07. - 02 FILLER PIC 99 VALUE 10. - 02 FILLER PIC 99 VALUE 15. - 02 FILLER PIC 99 VALUE 06. - 02 FILLER PIC 99 VALUE 22. - 02 FILLER PIC 99 VALUE 12. - 02 FILLER PIC 99 VALUE 09. - 02 FILLER PIC 99 VALUE 20. - 01 FILLER REDEFINES DISCOUNT-TABLE. - 02 DISCOUNT OCCURS 9 TIMES - INDEXED BY DISCOUNT-IX - PIC V99. - - 01 CALCULATED-FIELDS. - 03 WS-DISCOUNT-AMT PIC 9(3)V99. - 03 WS-CHARGE-AMT PIC 9(3)V99. - - REPORT SECTION. - RD CUSTOMER-REPORT - CONTROL IS TR-CUSTOMER-NUMBER - PAGE LIMIT IS 66 LINES - HEADING 1 - FIRST DETAIL 5 - LAST DETAIL 58. - - 01 PAGE-HEAD-GROUP TYPE PAGE HEADING. - 02 LINE 1. - 03 COLUMN 27 PIC X(41) VALUE - 'C U S T O M E R C H A R G E R E P O R T'. - 03 COLUMN 90 PIC X(04) VALUE 'PAGE'. - 03 COLUMN 95 PIC ZZZZ9 SOURCE PAGE-COUNTER. - 02 LINE PLUS 2. - 03 COLUMN 01 PIC X(09) VALUE 'CUST. NO.'. - 03 COLUMN 15 PIC X(10) VALUE 'CUST. NAME'. - 03 COLUMN 30 PIC X(05) VALUE 'DEPT.'. - 03 COLUMN 39 PIC X(08) VALUE 'ITEM NO.'. - 03 COLUMN 51 PIC X(09) VALUE 'ITEM COST'. - 03 COLUMN 64 PIC X(08) VALUE 'DISCT. %'. - 03 COLUMN 76 PIC X(11) VALUE 'DISCT. AMT.'. - 03 COLUMN 91 PIC X(06) VALUE 'CHARGE'. - - 01 CHARGE-DETAIL TYPE DETAIL. - 02 LINE PLUS 1. - 03 COLUMN 03 PIC Z(04) SOURCE TR-CUSTOMER-NUMBER. - 03 COLUMN 10 PIC X(16) SOURCE TR-CUSTOMER-NAME. - 03 COLUMN 32 PIC 9(01) SOURCE TR-ITEM-DEPARTMENT. - 03 COLUMN 40 PIC 9(05) SOURCE TR-ITEM-NUMBER. - 03 COLUMN 51 PIC $$$$.99 SOURCE TR-ITEM-COST. - 03 COLUMN 67 PIC V99 SOURCE DISCOUNT (DISCOUNT-IX). - 03 COLUMN 69 PIC X(01) VALUE '%'. - 03 COLUMN 78 PIC $$$$.99 SOURCE WS-DISCOUNT-AMT. - 03 COLUMN 93 PIC $$$$.99 SOURCE WS-CHARGE-AMT. - - 01 CUSTOMER-TOTAL TYPE CONTROL FOOTING TR-CUSTOMER-NUMBER - NEXT GROUP IS PLUS 2. - 02 LINE PLUS 1. - 03 COLUMN 92 PIC $$$$$.99 SUM WS-CHARGE-AMT. - 03 COLUMN 101 PIC X VALUE '*'. - - PROCEDURE DIVISION. - - 000-INITIATE. - - OPEN INPUT TRANSACTION-DATA, - OUTPUT REPORT-FILE. - - INITIATE CUSTOMER-REPORT. - - READ TRANSACTION-DATA - AT END - MOVE 'Y' TO END-OF-FILE-SWITCH - END-READ. - - PERFORM 100-PROCESS-TRANSACTION-DATA THRU 199-EXIT - UNTIL END-OF-FILE. - - 000-TERMINATE. - TERMINATE CUSTOMER-REPORT. - - CLOSE TRANSACTION-DATA, - REPORT-FILE. - - STOP RUN. - - 100-PROCESS-TRANSACTION-DATA. - SET DISCOUNT-IX TO TR-ITEM-DEPARTMENT. - COMPUTE WS-DISCOUNT-AMT ROUNDED = - TR-ITEM-COST * DISCOUNT (DISCOUNT-IX). - COMPUTE WS-CHARGE-AMT = - TR-ITEM-COST - WS-DISCOUNT-AMT. - GENERATE CHARGE-DETAIL. - READ TRANSACTION-DATA - AT END - MOVE 'Y' TO END-OF-FILE-SWITCH - END-READ. - - 199-EXIT. - EXIT. - -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) - -AT_CHECK([DD_DATAIN="./inp_data" DD_SYSPRINT="./report.txt" $COBCRUN_DIRECT ./prog], [0], [], []) - - -AT_CAPTURE_FILE(./report.txt) - -AT_DATA([reference], [ C U S T O M E R C H A R G E R E P O R T PAGE 1 - -CUST. NO. CUST. NAME DEPT. ITEM NO. ITEM COST DISCT. % DISCT. AMT. CHARGE - - 152 J. LANGDON 8 87653 $24.75 09% $2.23 $22.52 - 152 J. LANGDON 6 64025 $9.45 22% $2.08 $7.37 - 152 J. LANGDON 4 41915 $13.70 15% $2.06 $11.64 - 152 J. LANGDON 1 17410 $2.51 05% $.13 $2.38 - $43.91 * - - - 2468 L. MORRISEY 1 18520 $3.75 05% $.19 $3.56 - 2468 L. MORRISEY 2 20012 $4.20 07% $.29 $3.91 - 2468 L. MORRISEY 3 31572 $10.15 10% $1.02 $9.13 - 2468 L. MORRISEY 4 48792 $37.50 15% $5.63 $31.87 - 2468 L. MORRISEY 5 50407 $15.15 06% $.91 $14.24 - 2468 L. MORRISEY 6 61575 $20.10 22% $4.42 $15.68 - 2468 L. MORRISEY 7 79204 $51.70 12% $6.20 $45.50 - 2468 L. MORRISEY 8 85075 $37.84 09% $3.41 $34.43 - 2468 L. MORRISEY 9 98476 $87.94 20% $17.59 $70.35 - $228.67 * - - - 3451 M. JACKSON 3 37847 $27.90 10% $2.79 $25.11 - 3451 M. JACKSON 5 58492 $68.50 06% $4.11 $64.39 - 3451 M. JACKSON 6 60010 $20.40 22% $4.49 $15.91 - 3451 M. JACKSON 8 85260 $78.52 09% $7.07 $71.45 - 3451 M. JACKSON 9 90520 $27.52 20% $5.50 $22.02 - $198.88 * - - - 4512 S. LEVITT 2 24680 $30.50 07% $2.14 $28.36 - 4512 S. LEVITT 5 56784 $52.53 06% $3.15 $49.38 - 4512 S. LEVITT 6 60410 $12.15 22% $2.67 $9.48 - 4512 S. LEVITT 7 78952 $89.25 12% $10.71 $78.54 - 4512 S. LEVITT 8 85278 $49.75 09% $4.48 $45.27 - 4512 S. LEVITT 8 87492 $64.25 09% $5.78 $58.47 - 4512 S. LEVITT 9 97204 $84.75 20% $16.95 $67.80 - $337.30 * - - - 5417 K. CONKLIN 1 13579 $35.72 05% $1.79 $33.93 - 5417 K. CONKLIN 2 24615 $18.75 07% $1.31 $17.44 - 5417 K. CONKLIN 3 34928 $37.45 10% $3.75 $33.70 - 5417 K. CONKLIN 4 48527 $87.50 15% $13.13 $74.37 - 5417 K. CONKLIN 5 50150 $18.95 06% $1.14 $17.81 - 5417 K. CONKLIN 5 54652 $38.92 06% $2.34 $36.58 - 5417 K. CONKLIN 5 59765 $98.95 06% $5.94 $93.01 - 5417 K. CONKLIN 7 71572 $18.95 12% $2.27 $16.68 - 5417 K. CONKLIN 8 85175 $80.10 09% $7.21 $72.89 - 5417 K. CONKLIN 9 90275 $4.60 20% $.92 $3.68 - 5417 K. CONKLIN 9 91572 $18.57 20% $3.71 $14.86 - 5417 K. CONKLIN 9 97576 $84.95 20% $16.99 $67.96 - $482.91 * - - - 6213 Z. HAMPTON 1 15792 $64.25 05% $3.21 $61.04 - 6213 Z. HAMPTON 1 19975 $98.75 05% $4.94 $93.81 - - - - - - - - C U S T O M E R C H A R G E R E P O R T PAGE 2 - -CUST. NO. CUST. NAME DEPT. ITEM NO. ITEM COST DISCT. % DISCT. AMT. CHARGE - - 6213 Z. HAMPTON 3 34576 $51.15 10% $5.12 $46.03 - 6213 Z. HAMPTON 4 49512 $85.20 15% $12.78 $72.42 - $273.30 * - - - 7545 M. LARSON 1 14676 $38.45 05% $1.92 $36.53 - 7545 M. LARSON 1 18592 $82.51 05% $4.13 $78.38 - 7545 M. LARSON 1 19994 $98.98 05% $4.95 $94.03 - 7545 M. LARSON 2 21214 $15.15 07% $1.06 $14.09 - 7545 M. LARSON 3 37515 $82.12 10% $8.21 $73.91 - 7545 M. LARSON 3 38592 $96.15 10% $9.62 $86.53 - 7545 M. LARSON 4 48485 $87.14 15% $13.07 $74.07 - 7545 M. LARSON 5 52762 $37.92 06% $2.28 $35.64 - 7545 M. LARSON 5 57684 $80.15 06% $4.81 $75.34 - 7545 M. LARSON 7 79015 $96.25 12% $11.55 $84.70 - 7545 M. LARSON 8 80123 $5.60 09% $.50 $5.10 - 7545 M. LARSON 8 82462 $20.15 09% $1.81 $18.34 - 7545 M. LARSON 9 91520 $18.15 20% $3.63 $14.52 - 7545 M. LARSON 9 93715 $40.15 20% $8.03 $32.12 - $723.30 * - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -]) - -AT_CHECK([diff reference report.txt], [0], [], []) - -AT_CLEANUP - - -AT_SETUP([Sample Charge Report 2]) -AT_KEYWORDS([report runfile]) - -AT_DATA([inp_data],[0152 J. LANGDON 87653 02475 -0152 J. LANGDON 64025 00945 -0152 J. LANGDON 41915 01370 -0152 J. LANGDON 17410 00251 -2468 L. MORRISEY 18520 00375 -2468 L. MORRISEY 20012 00420 -2468 L. MORRISEY 31572 01015 -2468 L. MORRISEY 48792 03750 -2468 L. MORRISEY 50407 01515 -2468 L. MORRISEY 61575 02010 -2468 L. MORRISEY 79204 05170 -2468 L. MORRISEY 85075 03784 -2468 L. MORRISEY 98476 08794 -3451 M. JACKSON 37847 02790 -3451 M. JACKSON 58492 06850 -3451 M. JACKSON 60010 02040 -3451 M. JACKSON 85260 07852 -3451 M. JACKSON 90520 02752 -4512 S. LEVITT 24680 03050 -4512 S. LEVITT 56784 05253 -4512 S. LEVITT 60410 01215 -4512 S. LEVITT 78952 08925 -4512 S. LEVITT 85278 04975 -4512 S. LEVITT 87492 06425 -4512 S. LEVITT 97204 08475 -5417 K. CONKLIN 13579 03572 -5417 K. CONKLIN 24615 01875 -5417 K. CONKLIN 34928 03745 -5417 K. CONKLIN 48527 08750 -5417 K. CONKLIN 50150 01895 -5417 K. CONKLIN 54652 03892 -5417 K. CONKLIN 59765 09895 -5417 K. CONKLIN 71572 01895 -5417 K. CONKLIN 85175 08010 -5417 K. CONKLIN 90275 00460 -5417 K. CONKLIN 91572 01857 -5417 K. CONKLIN 97576 08495 -6213 Z. HAMPTON 15792 06425 -6213 Z. HAMPTON 19975 09875 -6213 Z. HAMPTON 34576 05115 -6213 Z. HAMPTON 49512 08520 -7545 M. LARSON 14676 03845 -7545 M. LARSON 18592 08251 -7545 M. LARSON 19994 09898 -7545 M. LARSON 21214 01515 -7545 M. LARSON 37515 08212 -7545 M. LARSON 38592 09615 -7545 M. LARSON 48485 08714 -7545 M. LARSON 52762 03792 -7545 M. LARSON 57684 08015 -7545 M. LARSON 79015 09625 -7545 M. LARSON 80123 00560 -7545 M. LARSON 82462 02015 -7545 M. LARSON 91520 01815 -7545 M. LARSON 93715 04015 -]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - * ************************************************************* * - * REPORT WRITER EXAMPLE #3. * - * ************************************************************* * - - ENVIRONMENT DIVISION. - CONFIGURATION SECTION. - - INPUT-OUTPUT SECTION. - FILE-CONTROL. - - SELECT TRANSACTION-DATA - ASSIGN TO EXTERNAL DATAIN - ORGANIZATION IS LINE SEQUENTIAL. - - SELECT REPORT-FILE - ASSIGN TO EXTERNAL LINE ADVANCING SYSPRINT. - - DATA DIVISION. - FILE SECTION. - - FD TRANSACTION-DATA. - - 01 TRANSACTION-RECORD. - 03 TR-CUSTOMER-NUMBER PIC 9(04). - 03 FILLER PIC X(01). - 03 TR-CUSTOMER-NAME PIC X(16). - 03 FILLER PIC X(01). - 03 TR-ITEM-NUMBER PIC 9(05). - 03 FILLER REDEFINES TR-ITEM-NUMBER. - 05 TR-ITEM-DEPARTMENT PIC 9(01). - 05 FILLER PIC 9(04). - 03 FILLER PIC X(01). - 03 TR-ITEM-COST PIC 9(03)V99. - 03 FILLER PIC X(47). - - FD REPORT-FILE - REPORT IS CUSTOMER-REPORT. - - WORKING-STORAGE SECTION. - 77 END-OF-FILE-SWITCH PIC X(1) VALUE 'N'. - 88 END-OF-FILE VALUE 'Y'. - - 01 DISCOUNT-TABLE. - 02 FILLER PIC 99 VALUE 05. - 02 FILLER PIC 99 VALUE 07. - 02 FILLER PIC 99 VALUE 10. - 02 FILLER PIC 99 VALUE 15. - 02 FILLER PIC 99 VALUE 06. - 02 FILLER PIC 99 VALUE 22. - 02 FILLER PIC 99 VALUE 12. - 02 FILLER PIC 99 VALUE 09. - 02 FILLER PIC 99 VALUE 20. - 01 FILLER REDEFINES DISCOUNT-TABLE. - 02 DISCOUNT OCCURS 9 TIMES - INDEXED BY DISCOUNT-IX - PIC V99. - - 01 CALCULATED-FIELDS. - 03 WS-DISCOUNT-AMT PIC 9(3)V99. - 03 WS-CHARGE-AMT PIC 9(3)V99. - - REPORT SECTION. - RD CUSTOMER-REPORT - CONTROLS ARE FINAL, TR-CUSTOMER-NUMBER - PAGE LIMIT IS 66 LINES - HEADING 1 - FIRST DETAIL 5 - LAST DETAIL 58. - - 01 PAGE-HEAD-GROUP TYPE PAGE HEADING. - 02 LINE 1. - 03 COLUMN 27 PIC X(41) VALUE - 'C U S T O M E R C H A R G E R E P O R T'. - 03 COLUMN 90 PIC X(04) VALUE 'PAGE'. - 03 COLUMN 95 PIC ZZZZ9 SOURCE PAGE-COUNTER. - 02 LINE PLUS 2. - 03 COLUMN 01 PIC X(09) VALUE 'CUST. NO.'. - 03 COLUMN 15 PIC X(10) VALUE 'CUST. NAME'. - 03 COLUMN 30 PIC X(05) VALUE 'DEPT.'. - 03 COLUMN 39 PIC X(08) VALUE 'ITEM NO.'. - 03 COLUMN 51 PIC X(09) VALUE 'ITEM COST'. - 03 COLUMN 64 PIC X(08) VALUE 'DISCT. %'. - 03 COLUMN 76 PIC X(11) VALUE 'DISCT. AMT.'. - 03 COLUMN 91 PIC X(06) VALUE 'CHARGE'. - - 01 CHARGE-DETAIL TYPE DETAIL. - 02 LINE PLUS 1. - 03 COLUMN 03 PIC Z(04) SOURCE TR-CUSTOMER-NUMBER - GROUP INDICATE. - 03 COLUMN 10 PIC X(16) SOURCE TR-CUSTOMER-NAME - GROUP INDICATE. - 03 COLUMN 32 PIC 9(01) SOURCE TR-ITEM-DEPARTMENT. - 03 COLUMN 40 PIC 9(05) SOURCE TR-ITEM-NUMBER. - 03 COLUMN 51 PIC $$$$.99 SOURCE TR-ITEM-COST. - 03 COLUMN 67 PIC V99 SOURCE DISCOUNT (DISCOUNT-IX). - 03 COLUMN 69 PIC X(01) VALUE '%'. - 03 COLUMN 78 PIC $$$$.99 SOURCE WS-DISCOUNT-AMT. - 03 COLUMN 93 PIC $$$$.99 SOURCE WS-CHARGE-AMT. - - 01 CUSTOMER-TOTAL TYPE CONTROL FOOTING TR-CUSTOMER-NUMBER - NEXT GROUP IS PLUS 2. - 02 LINE PLUS 1. - 03 COLUMN 50 PIC $$$$$.99 SUM TR-ITEM-COST. - 03 COLUMN 59 PIC X VALUE '*'. - 03 COLUMN 77 PIC $$$$$.99 SUM WS-DISCOUNT-AMT. - 03 COLUMN 86 PIC X VALUE '*'. - 03 COLUMN 92 PIC $$$$$.99 SUM WS-CHARGE-AMT. - 03 COLUMN 101 PIC X VALUE '*'. - - 01 FINAL-TOTAL TYPE CONTROL FOOTING FINAL. - 02 LINE PLUS 1. - 03 COLUMN 10 PIC X(12) VALUE 'GRAND TOTALS'. - 03 COLUMN 48 PIC $$$,$$$.99 SUM TR-ITEM-COST. - 03 COLUMN 59 PIC XX VALUE '**'. - 03 COLUMN 75 PIC $$$,$$$.99 SUM WS-DISCOUNT-AMT. - 03 COLUMN 86 PIC XX VALUE '**'. - 03 COLUMN 90 PIC $$$,$$$.99 SUM WS-CHARGE-AMT. - 03 COLUMN 101 PIC XX VALUE '**'. - - PROCEDURE DIVISION. - - 000-INITIATE. - - OPEN INPUT TRANSACTION-DATA, - OUTPUT REPORT-FILE. - - INITIATE CUSTOMER-REPORT. - - READ TRANSACTION-DATA - AT END - MOVE 'Y' TO END-OF-FILE-SWITCH. - * END-READ. - - PERFORM 100-PROCESS-TRANSACTION-DATA THRU 199-EXIT - UNTIL END-OF-FILE. - - 000-TERMINATE. - TERMINATE CUSTOMER-REPORT. - - CLOSE TRANSACTION-DATA, - REPORT-FILE. - - STOP RUN. - - 100-PROCESS-TRANSACTION-DATA. - SET DISCOUNT-IX TO TR-ITEM-DEPARTMENT. - COMPUTE WS-DISCOUNT-AMT ROUNDED = - TR-ITEM-COST * DISCOUNT (DISCOUNT-IX). - COMPUTE WS-CHARGE-AMT = - TR-ITEM-COST - WS-DISCOUNT-AMT. - GENERATE CHARGE-DETAIL. - READ TRANSACTION-DATA - AT END - MOVE 'Y' TO END-OF-FILE-SWITCH. - * END-READ. - - 199-EXIT. - EXIT. - - -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) - -AT_CHECK([DD_DATAIN="./inp_data" DD_SYSPRINT="./report.txt" $COBCRUN_DIRECT ./prog], [0], [], []) - - -AT_CAPTURE_FILE(./report.txt) - -AT_DATA([reference], [ C U S T O M E R C H A R G E R E P O R T PAGE 1 - -CUST. NO. CUST. NAME DEPT. ITEM NO. ITEM COST DISCT. % DISCT. AMT. CHARGE - - 152 J. LANGDON 8 87653 $24.75 09% $2.23 $22.52 - 6 64025 $9.45 22% $2.08 $7.37 - 4 41915 $13.70 15% $2.06 $11.64 - 1 17410 $2.51 05% $.13 $2.38 - $50.41 * $6.50 * $43.91 * - - - 2468 L. MORRISEY 1 18520 $3.75 05% $.19 $3.56 - 2 20012 $4.20 07% $.29 $3.91 - 3 31572 $10.15 10% $1.02 $9.13 - 4 48792 $37.50 15% $5.63 $31.87 - 5 50407 $15.15 06% $.91 $14.24 - 6 61575 $20.10 22% $4.42 $15.68 - 7 79204 $51.70 12% $6.20 $45.50 - 8 85075 $37.84 09% $3.41 $34.43 - 9 98476 $87.94 20% $17.59 $70.35 - $268.33 * $39.66 * $228.67 * - - - 3451 M. JACKSON 3 37847 $27.90 10% $2.79 $25.11 - 5 58492 $68.50 06% $4.11 $64.39 - 6 60010 $20.40 22% $4.49 $15.91 - 8 85260 $78.52 09% $7.07 $71.45 - 9 90520 $27.52 20% $5.50 $22.02 - $222.84 * $23.96 * $198.88 * - - - 4512 S. LEVITT 2 24680 $30.50 07% $2.14 $28.36 - 5 56784 $52.53 06% $3.15 $49.38 - 6 60410 $12.15 22% $2.67 $9.48 - 7 78952 $89.25 12% $10.71 $78.54 - 8 85278 $49.75 09% $4.48 $45.27 - 8 87492 $64.25 09% $5.78 $58.47 - 9 97204 $84.75 20% $16.95 $67.80 - $383.18 * $45.88 * $337.30 * - - - 5417 K. CONKLIN 1 13579 $35.72 05% $1.79 $33.93 - 2 24615 $18.75 07% $1.31 $17.44 - 3 34928 $37.45 10% $3.75 $33.70 - 4 48527 $87.50 15% $13.13 $74.37 - 5 50150 $18.95 06% $1.14 $17.81 - 5 54652 $38.92 06% $2.34 $36.58 - 5 59765 $98.95 06% $5.94 $93.01 - 7 71572 $18.95 12% $2.27 $16.68 - 8 85175 $80.10 09% $7.21 $72.89 - 9 90275 $4.60 20% $.92 $3.68 - 9 91572 $18.57 20% $3.71 $14.86 - 9 97576 $84.95 20% $16.99 $67.96 - $543.41 * $60.50 * $482.91 * - - - 6213 Z. HAMPTON 1 15792 $64.25 05% $3.21 $61.04 - 1 19975 $98.75 05% $4.94 $93.81 - - - - - - - - C U S T O M E R C H A R G E R E P O R T PAGE 2 - -CUST. NO. CUST. NAME DEPT. ITEM NO. ITEM COST DISCT. % DISCT. AMT. CHARGE - - 6213 Z. HAMPTON 3 34576 $51.15 10% $5.12 $46.03 - 4 49512 $85.20 15% $12.78 $72.42 - $299.35 * $26.05 * $273.30 * - - - 7545 M. LARSON 1 14676 $38.45 05% $1.92 $36.53 - 1 18592 $82.51 05% $4.13 $78.38 - 1 19994 $98.98 05% $4.95 $94.03 - 2 21214 $15.15 07% $1.06 $14.09 - 3 37515 $82.12 10% $8.21 $73.91 - 3 38592 $96.15 10% $9.62 $86.53 - 4 48485 $87.14 15% $13.07 $74.07 - 5 52762 $37.92 06% $2.28 $35.64 - 5 57684 $80.15 06% $4.81 $75.34 - 7 79015 $96.25 12% $11.55 $84.70 - 8 80123 $5.60 09% $.50 $5.10 - 8 82462 $20.15 09% $1.81 $18.34 - 9 91520 $18.15 20% $3.63 $14.52 - 9 93715 $40.15 20% $8.03 $32.12 - $798.87 * $75.57 * $723.30 * - GRAND TOTALS $2,566.39 ** $278.12 ** $2,288.27 ** - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -]) - -AT_CHECK([diff reference report.txt], [0], [], []) - -AT_CLEANUP - - -AT_SETUP([Sample Charge Report 3]) -AT_KEYWORDS([report runfile]) - -AT_DATA([inp_data],[0152 J. LANGDON 87653 02475 -0152 J. LANGDON 64025 00945 -0152 J. LANGDON 41915 01370 -0152 J. LANGDON 17410 00251 -2468 L. MORRISEY 18520 00375 -2468 L. MORRISEY 20012 00420 -2468 L. MORRISEY 31572 01015 -2468 L. MORRISEY 48792 03750 -2468 L. MORRISEY 50407 01515 -2468 L. MORRISEY 61575 02010 -2468 L. MORRISEY 79204 05170 -2468 L. MORRISEY 85075 03784 -2468 L. MORRISEY 98476 08794 -3451 M. JACKSON 37847 02790 -3451 M. JACKSON 58492 06850 -3451 M. JACKSON 60010 02040 -3451 M. JACKSON 85260 07852 -3451 M. JACKSON 90520 02752 -4512 S. LEVITT 24680 03050 -4512 S. LEVITT 56784 05253 -4512 S. LEVITT 60410 01215 -4512 S. LEVITT 78952 08925 -4512 S. LEVITT 85278 04975 -4512 S. LEVITT 87492 06425 -4512 S. LEVITT 97204 08475 -5417 K. CONKLIN 13579 03572 -5417 K. CONKLIN 24615 01875 -5417 K. CONKLIN 34928 03745 -5417 K. CONKLIN 48527 08750 -5417 K. CONKLIN 50150 01895 -5417 K. CONKLIN 54652 03892 -5417 K. CONKLIN 59765 09895 -5417 K. CONKLIN 71572 01895 -5417 K. CONKLIN 85175 08010 -5417 K. CONKLIN 90275 00460 -5417 K. CONKLIN 91572 01857 -5417 K. CONKLIN 97576 08495 -6213 Z. HAMPTON 15792 06425 -6213 Z. HAMPTON 19975 09875 -6213 Z. HAMPTON 34576 05115 -6213 Z. HAMPTON 49512 08520 -7545 M. LARSON 14676 03845 -7545 M. LARSON 18592 08251 -7545 M. LARSON 19994 09898 -7545 M. LARSON 21214 01515 -7545 M. LARSON 37515 08212 -7545 M. LARSON 38592 09615 -7545 M. LARSON 48485 08714 -7545 M. LARSON 52762 03792 -7545 M. LARSON 57684 08015 -7545 M. LARSON 79015 09625 -7545 M. LARSON 80123 00560 -7545 M. LARSON 82462 02015 -7545 M. LARSON 91520 01815 -7545 M. LARSON 93715 04015 -]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - * ************************************************************* * - * * MODIFICATIONS: * - * * ADDED GROUP ITEM TO INPUT RECORD DEFINITION AND CHANGED * 20110227 - * * REPORT SECTION REFERENCES TO ELEMENTS UNDER GROUP TO FIX * 20110227 - * * MISMATCHED CUSTOMER NAME/NUMBER ON REPORT. * 20110227 - * ************************************************************* * - - * ************************************************************* * - * REPORT WRITER EXAMPLE #4. * - * ************************************************************* * - - ENVIRONMENT DIVISION. - CONFIGURATION SECTION. - - INPUT-OUTPUT SECTION. - FILE-CONTROL. - - SELECT TRANSACTION-DATA - ASSIGN TO EXTERNAL DATAIN - ORGANIZATION IS LINE SEQUENTIAL. - - SELECT REPORT-FILE - ASSIGN TO EXTERNAL LINE ADVANCING SYSPRINT. - - DATA DIVISION. - FILE SECTION. - - FD TRANSACTION-DATA. - - 01 TRANSACTION-RECORD. - 03 TR-CUSTOMER. 20110227 - 05 TR-CUSTOMER-NUMBER PIC 9(04). 20110227 - 05 FILLER PIC X(01). 20110227 - 05 TR-CUSTOMER-NAME PIC X(16). 20110227 - 03 FILLER PIC X(01). - 03 TR-ITEM-NUMBER PIC 9(05). - 03 FILLER REDEFINES TR-ITEM-NUMBER. - 05 TR-ITEM-DEPARTMENT PIC 9(01). - 05 FILLER PIC 9(04). - 03 FILLER PIC X(01). - 03 TR-ITEM-COST PIC 9(03)V99. - 03 FILLER PIC X(47). - - FD REPORT-FILE - REPORT IS CUSTOMER-REPORT. - - WORKING-STORAGE SECTION. - 77 END-OF-FILE-SWITCH PIC X(1) VALUE 'N'. - 88 END-OF-FILE VALUE 'Y'. - - 01 DISCOUNT-TABLE. - 02 FILLER PIC 99 VALUE 05. - 02 FILLER PIC 99 VALUE 07. - 02 FILLER PIC 99 VALUE 10. - 02 FILLER PIC 99 VALUE 15. - 02 FILLER PIC 99 VALUE 06. - 02 FILLER PIC 99 VALUE 22. - 02 FILLER PIC 99 VALUE 12. - 02 FILLER PIC 99 VALUE 09. - 02 FILLER PIC 99 VALUE 20. - 01 FILLER REDEFINES DISCOUNT-TABLE. - 02 DISCOUNT OCCURS 9 TIMES - INDEXED BY DISCOUNT-IX - PIC V99. - - 01 CALCULATED-FIELDS. - 03 WS-DISCOUNT-AMT PIC 9(3)V99. - 03 WS-CHARGE-AMT PIC 9(3)V99. - - REPORT SECTION. - RD CUSTOMER-REPORT - CONTROLS ARE FINAL, TR-CUSTOMER - PAGE LIMIT IS 66 LINES - HEADING 1 - FIRST DETAIL 5 - LAST DETAIL 58. - - 01 PAGE-HEAD-GROUP TYPE PAGE HEADING. - 02 LINE 1. - 03 COLUMN 27 PIC X(41) VALUE - 'C U S T O M E R C H A R G E R E P O R T'. - 03 COLUMN 90 PIC X(04) VALUE 'PAGE'. - 03 COLUMN +2 PIC ZZZZ9 SOURCE PAGE-COUNTER. - 02 LINE +2. - 03 COLUMN 01 PIC X(09) VALUE 'CUST. NO.'. - 03 COLUMN 15 PIC X(10) VALUE 'CUST. NAME'. - 03 COLUMN 51 PIC X(09) VALUE 'ITEM COST'. - 03 COLUMN 76 PIC X(11) VALUE 'DISCT. AMT.'. - 03 COLUMN 91 PIC X(06) VALUE 'CHARGE'. - - 01 CHARGE-DETAIL TYPE DETAIL. - 02 LINE PLUS 1. - 03 COLUMN 51 PIC $$$$.99 SOURCE TR-ITEM-COST. - 03 COLUMN 78 PIC $$$$.99 SOURCE WS-DISCOUNT-AMT. - 03 COLUMN 93 PIC $$$$.99 SOURCE WS-CHARGE-AMT. - - 01 CUSTOMER-TOTAL TYPE CONTROL FOOTING TR-CUSTOMER 20110227 - NEXT GROUP IS PLUS 2. - 02 LINE PLUS 1. - 03 COLUMN 03 PIC Z(04) SOURCE TR-CUSTOMER-NUMBER. - 03 COLUMN 10 PIC X(16) SOURCE TR-CUSTOMER-NAME. - 03 COLUMN 50 PIC $$$$$.99 SUM TR-ITEM-COST. - 03 COLUMN 77 PIC $$$$$.99 SUM WS-DISCOUNT-AMT. - 03 COLUMN 92 PIC $$$$$.99 SUM WS-CHARGE-AMT. - - 01 FINAL-TOTAL TYPE CONTROL FOOTING FINAL. - 02 LINE PLUS 1. - 03 COLUMN 10 PIC X(12) VALUE 'GRAND TOTALS'. - 03 COLUMN 48 PIC $$$,$$$.99 SUM TR-ITEM-COST. - 03 COLUMN 59 PIC X VALUE '*'. - 03 COLUMN 75 PIC $$$,$$$.99 SUM WS-DISCOUNT-AMT. - 03 COLUMN 86 PIC X VALUE '*'. - 03 COLUMN 90 PIC $$$,$$$.99 SUM WS-CHARGE-AMT. - 03 COLUMN 101 PIC X VALUE '*'. - - PROCEDURE DIVISION. - - 000-INITIATE. - - OPEN INPUT TRANSACTION-DATA, - OUTPUT REPORT-FILE. - - INITIATE CUSTOMER-REPORT. - - READ TRANSACTION-DATA - AT END - MOVE 'Y' TO END-OF-FILE-SWITCH - END-READ. - - PERFORM 100-PROCESS-TRANSACTION-DATA THRU 199-EXIT - UNTIL END-OF-FILE. - - 000-TERMINATE. - TERMINATE CUSTOMER-REPORT. - - CLOSE TRANSACTION-DATA, - REPORT-FILE. - - STOP RUN. - - 100-PROCESS-TRANSACTION-DATA. - SET DISCOUNT-IX TO TR-ITEM-DEPARTMENT. - COMPUTE WS-DISCOUNT-AMT ROUNDED = - TR-ITEM-COST * DISCOUNT (DISCOUNT-IX). - COMPUTE WS-CHARGE-AMT = - TR-ITEM-COST - WS-DISCOUNT-AMT. - GENERATE CUSTOMER-REPORT. - READ TRANSACTION-DATA - AT END - MOVE 'Y' TO END-OF-FILE-SWITCH. - * END-READ. - - 199-EXIT. - EXIT. - -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) - -AT_CHECK([DD_DATAIN="./inp_data" DD_SYSPRINT="./report.txt" $COBCRUN_DIRECT ./prog], [0], [], []) - - -AT_CAPTURE_FILE(./report.txt) - -AT_DATA([reference], [ C U S T O M E R C H A R G E R E P O R T PAGE 1 - -CUST. NO. CUST. NAME ITEM COST DISCT. AMT. CHARGE - - 152 J. LANGDON $50.41 $6.50 $43.91 - - - 2468 L. MORRISEY $268.33 $39.66 $228.67 - - - 3451 M. JACKSON $222.84 $23.96 $198.88 - - - 4512 S. LEVITT $383.18 $45.88 $337.30 - - - 5417 K. CONKLIN $543.41 $60.50 $482.91 - - - 6213 Z. HAMPTON $299.35 $26.05 $273.30 - - - 7545 M. LARSON $798.87 $75.57 $723.30 - GRAND TOTALS $2,566.39 * $278.12 * $2,288.27 * - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -]) - -AT_CHECK([diff reference report.txt], [0], [], []) - -AT_CLEANUP - - -AT_SETUP([Sample Charge Report 4]) -AT_KEYWORDS([report runfile]) - -AT_DATA([inp_data],[05 A 007328 -05 A 090620 -05 A 034602 -05 A 017837 -13 A 005035 -13 A 049851 -13 A 012139 -22 A 077572 -29 A 013491 -33 A 050628 -33 A 044987 -33 A 050162 -39 A 068745 -39 A 058384 -39 A 053005 -44 A 085669 -44 A 057891 -49 A 065134 -03 B 032035 -03 B 054694 -03 B 069591 -03 B 046023 -03 B 025725 -19 B 045550 -19 B 099371 -19 B 049703 -25 B 047000 -25 B 087106 -31 B 049157 -34 B 005994 -09 C 007980 -14 C 092224 -14 C 062942 -23 C 002974 -28 C 042394 -28 C 014745 -34 C 053467 -34 C 054332 -42 C 089295 -42 C 073826 -04 D 029685 -04 D 060676 -06 D 013230 -06 D 042290 -15 D 013076 -15 D 024104 -15 D 013078 -38 D 078771 -38 D 085871 -11 E 099350 -17 E 066301 -27 E 038144 -27 E 097807 -27 E 008055 -08 F 073201 -09 F 008278 -09 F 040898 -09 F 039688 -16 F 019308 -16 F 015173 -16 F 022865 -16 F 003568 -36 F 029276 -40 F 078631 -40 F 010249 -40 F 059583 -48 F 043877 -48 F 006755 -01 G 018347 -20 G 098123 -21 G 077346 -22 G 025953 -26 G 009587 -41 G 083126 -41 G 073046 -32 H 038823 -32 H 009989 -32 H 065838 -32 H 024994 -32 H 016065 -32 H 097042 -43 H 077895 -45 H 038692 -46 H 088151 -46 H 069538 -09 J 039764 -18 J 088890 -18 J 039421 -37 J 044560 -45 J 018770 -45 J 032993 -45 J 089631 -45 J 072659 -02 K 075925 -02 K 072909 -02 K 040544 -12 K 002138 -12 K 029239 -35 K 065936 -35 K 093046 -]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - - * ************************************************************* * - * REPORT WRITER EXAMPLE #5. * - * ************************************************************* * - - ENVIRONMENT DIVISION. - CONFIGURATION SECTION. - - INPUT-OUTPUT SECTION. - FILE-CONTROL. - - SELECT SALES-DATA - ASSIGN TO EXTERNAL DATAIN - ORGANIZATION IS LINE SEQUENTIAL. - - SELECT REPORT-FILE - ASSIGN TO EXTERNAL LINE ADVANCING SYSPRINT. - - DATA DIVISION. - FILE SECTION. - - FD SALES-DATA. - - 01 SALES-RECORD. - 03 SR-SALESMAN-NUMBER PIC 9(02). - 03 FILLER PIC X(01). - 03 SR-DISTRICT-CODE PIC X(01). - 03 FILLER PIC X(01). - 03 SR-SALE-AMOUNT PIC 9(04)V99. - 03 FILLER PIC X(69). - - FD REPORT-FILE - REPORT IS DISTRICT-SALES-REPORT. - - WORKING-STORAGE SECTION. - 77 END-OF-FILE-SWITCH PIC X(1) VALUE 'N'. - 88 END-OF-FILE VALUE 'Y'. - - 01 COMMISSION-TABLE. - 02 FILLER PIC X(03) VALUE 'A20'. - 02 FILLER PIC X(03) VALUE 'B18'. - 02 FILLER PIC X(03) VALUE 'C15'. - 02 FILLER PIC X(03) VALUE 'D12'. - 02 FILLER PIC X(03) VALUE 'E10'. - 02 FILLER PIC X(03) VALUE 'F12'. - 02 FILLER PIC X(03) VALUE 'G10'. - 02 FILLER PIC X(03) VALUE 'H08'. - 02 FILLER PIC X(03) VALUE 'J05'. - 02 FILLER PIC X(03) VALUE 'K07'. - 01 FILLER REDEFINES COMMISSION-TABLE. - 02 COMMISSION-ENTRY OCCURS 10 TIMES - INDEXED BY COMMISSION-IX. - 03 CE-DISTRICT PIC X(01). - 03 CE-RATE PIC V99. - - 01 CALCULATED-FIELDS. - 03 WS-COMMISSION PIC 9(5)V99. - - REPORT SECTION. - RD DISTRICT-SALES-REPORT - CONTROLS ARE FINAL, SR-DISTRICT-CODE, SR-SALESMAN-NUMBER - PAGE LIMIT IS 66 LINES - HEADING 1 - FIRST DETAIL 5 - LAST DETAIL 58. - - 01 PAGE-HEAD-GROUP TYPE PAGE HEADING. - 02 LINE 1. - 03 COLUMN 27 PIC X(41) VALUE - 'D I S T R I C T S A L E S R E P O R T'. - 03 COLUMN 90 PIC X(04) VALUE 'PAGE'. - 03 COLUMN 95 PIC ZZZZ9 SOURCE PAGE-COUNTER. - 02 LINE 3. - 03 COLUMN 20 PIC X(26) VALUE - '-------- SALESMAN --------'. - 03 COLUMN 54 PIC X(15) VALUE - '-- DISTRICT --'. - 02 LINE 4. - 03 COLUMN 20 PIC X(03) VALUE 'NO.'. - 03 COLUMN 28 PIC X(05) VALUE 'SALES'. - 03 COLUMN 37 PIC X(10) VALUE 'COMMISSION'. - 03 COLUMN 54 PIC X(03) VALUE 'NO.'. - 03 COLUMN 61 PIC X(05) VALUE 'SALES'. - - 01 SALE-DETAIL TYPE DETAIL. - 02 LINE PLUS 1. - 03 COLUMN 01 PIC 99 SOURCE SR-SALESMAN-NUMBER. - 03 COLUMN 04 PIC X SOURCE SR-DISTRICT-CODE. - 03 COLUMN 06 PIC 9999.99 SOURCE SR-SALE-AMOUNT. - - 01 SALESMAN-TOTAL TYPE CONTROL FOOTING SR-SALESMAN-NUMBER. - 02 LINE PLUS 1. - 03 COLUMN 20 PIC 99 SOURCE SR-SALESMAN-NUMBER. - 03 ST-SALES-AMT COLUMN 24 PIC $$$,$$9.99 SUM - SR-SALE-AMOUNT. - 03 COLUMN 37 PIC $$$,$$9.99 SOURCE WS-COMMISSION. - - 01 DISTRICT-TOTAL TYPE CONTROL FOOTING SR-DISTRICT-CODE - NEXT GROUP PLUS 2. - 02 LINE PLUS 1. - 03 COLUMN 54 PIC X SOURCE SR-DISTRICT-CODE. - 03 COLUMN 58 PIC $$$,$$9.99 SUM ST-SALES-AMT. - - 01 FINAL-TOTAL TYPE CONTROL FOOTING FINAL. - 02 LINE PLUS 2. - 03 COLUMN 15 PIC X(19) VALUE - 'MONTHLY TOTAL SALES'. - 03 COLUMN 57 PIC $$$$,$$9.99 SUM ST-SALES-AMT. - 03 COLUMN 69 PIC XX VALUE '**'. - - PROCEDURE DIVISION. - - DECLARATIVES. - USE-SALESMAN-TOTAL SECTION. USE BEFORE REPORTING SALESMAN-TOTAL. - USE-SALESMAN-TOTAL-PROC. - SET COMMISSION-IX TO 1. - SEARCH COMMISSION-ENTRY - AT END - MOVE 0.00 TO WS-COMMISSION - WHEN CE-DISTRICT (COMMISSION-IX) = SR-DISTRICT-CODE - COMPUTE WS-COMMISSION ROUNDED = - CE-RATE (COMMISSION-IX) * ST-SALES-AMT. - - USE-SALESMAN-TOTAL-EXIT. - EXIT. - - END DECLARATIVES. - - 000-INITIATE. - - OPEN INPUT SALES-DATA, - OUTPUT REPORT-FILE. - - INITIATE DISTRICT-SALES-REPORT. - - READ SALES-DATA - AT END - MOVE 'Y' TO END-OF-FILE-SWITCH - END-READ. - - PERFORM 100-PROCESS-SALES-DATA THRU 199-EXIT - UNTIL END-OF-FILE. - - 000-TERMINATE. - TERMINATE DISTRICT-SALES-REPORT. - - CLOSE SALES-DATA, - REPORT-FILE. - - STOP RUN. - - 100-PROCESS-SALES-DATA. - GENERATE DISTRICT-SALES-REPORT. - READ SALES-DATA - AT END - MOVE 'Y' TO END-OF-FILE-SWITCH - END-READ. - - 199-EXIT. - EXIT. - -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) - -AT_CHECK([DD_DATAIN="./inp_data" DD_SYSPRINT="./report.txt" $COBCRUN_DIRECT ./prog], [0], [], []) - - -AT_CAPTURE_FILE(./report.txt) - -AT_DATA([reference], [ D I S T R I C T S A L E S R E P O R T PAGE 1 - - -------- SALESMAN -------- -- DISTRICT -- - NO. SALES COMMISSION NO. SALES - 05 $1,503.87 $300.77 - 13 $670.25 $134.05 - 22 $775.72 $155.14 - 29 $134.91 $26.98 - 33 $1,457.77 $291.55 - 39 $1,801.34 $360.27 - 44 $1,435.60 $287.12 - 49 $651.34 $130.27 - A $8,430.80 - - - 03 $2,280.68 $410.52 - 19 $1,946.24 $350.32 - 25 $1,341.06 $241.39 - 31 $491.57 $88.48 - 34 $59.94 $10.79 - B $6,119.49 - - - 09 $79.80 $11.97 - 14 $1,551.66 $232.75 - 23 $29.74 $4.46 - 28 $571.39 $85.71 - 34 $1,077.99 $161.70 - 42 $1,631.21 $244.68 - C $4,941.79 - - - 04 $903.61 $108.43 - 06 $555.20 $66.62 - 15 $502.58 $60.31 - 38 $1,646.42 $197.57 - D $3,607.81 - - - 11 $993.50 $99.35 - 17 $663.01 $66.30 - 27 $1,440.06 $144.01 - E $3,096.57 - - - 08 $732.01 $87.84 - 09 $888.64 $106.64 - 16 $609.14 $73.10 - 36 $292.76 $35.13 - 40 $1,484.63 $178.16 - 48 $506.32 $60.76 - F $4,513.50 - - - 01 $183.47 $18.35 - 20 $981.23 $98.12 - 21 $773.46 $77.35 - 22 $259.53 $25.95 - - - - - - - - D I S T R I C T S A L E S R E P O R T PAGE 2 - - -------- SALESMAN -------- -- DISTRICT -- - NO. SALES COMMISSION NO. SALES - 26 $95.87 $9.59 - 41 $1,561.72 $156.17 - G $3,855.28 - - - 32 $2,527.51 $202.20 - 43 $778.95 $62.32 - 45 $386.92 $30.95 - 46 $1,576.89 $126.15 - H $5,270.27 - - - 09 $397.64 $19.88 - 18 $1,283.11 $64.16 - 37 $445.60 $22.28 - 45 $2,140.53 $107.03 - J $4,266.88 - - - 02 $1,893.78 $132.56 - 12 $313.77 $21.96 - 35 $1,589.82 $111.29 - K $3,797.37 - - MONTHLY TOTAL SALES $47,899.76 ** - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -]) - -AT_CHECK([diff reference report.txt], [0], [], []) - -AT_CLEANUP - - -AT_SETUP([Sample Payroll Report]) -AT_KEYWORDS([report runfile]) - -AT_DATA([inp_data],[01 6622 M GAVIN SHAFER 19740201 026000 01521 03362 00075 021042 -01 6622 M GAVIN SHAFER 19740215 026000 01521 03362 00175 020942 -01 6622 M GAVIN SHAFER 19740301 026000 01521 03362 00175 020942 -01 6622 M GAVIN SHAFER 19740315 026000 01521 03362 00050 021067 -01 7078 F VERA ALSTON 19740101 030000 01755 02304 00050 025891 -01 7078 F VERA ALSTON 19740115 030000 01755 02304 00100 025841 -01 7078 F VERA ALSTON 19740201 030000 01755 02304 00050 025891 -01 7078 F VERA ALSTON 19740215 030000 01755 02304 00000 025941 -01 7078 F VERA ALSTON 19740301 030000 01755 02304 00075 025866 -01 7078 F VERA ALSTON 19740315 030000 01755 02304 00100 025841 -01 8093 M GRADY KAISER 19740101 045000 02633 05819 00175 036374 -01 8093 M GRADY KAISER 19740115 045000 02633 05819 00100 036449 -01 8093 M GRADY KAISER 19740201 045000 02633 05819 00100 036449 -01 8093 M GRADY KAISER 19740215 047500 02779 03648 00100 040973 -01 8093 M GRADY KAISER 19740301 047500 02779 03648 00175 040898 -05 1720 F PAULINE WINSTON 19740101 013000 00761 20110 00050 010080 -05 1720 F PAULINE WINSTON 19740115 013000 00761 02110 00000 010130 -05 1720 F PAULINE WINSTON 19740201 014000 00819 02272 00075 010834 -05 1720 F PAULINE WINSTON 19740215 014000 00819 02272 00175 010734 -05 1720 F PAULINE WINSTON 19740301 014000 00819 02272 00050 010859 -05 2116 M HERMAN COX 19740101 010000 00585 01293 00175 007947 -05 2116 M HERMAN COX 19740115 010000 00585 01293 00175 007947 -05 2116 M HERMAN COX 19740201 010000 00585 01293 00100 008022 -05 2116 M HERMAN COX 19740215 010000 00585 01293 00100 008022 -05 2116 M HERMAN COX 19740301 010000 00585 01293 00075 008047 -05 2116 M HERMAN COX 19740315 011000 00644 01187 00100 009070 -05 6925 M ADOLF TRUJILLO 19740115 012500 00731 02379 00050 009340 -05 6925 M ADOLF TRUJILLO 19740201 012500 00731 02379 00100 009290 -05 6925 M ADOLF TRUJILLO 19740215 012500 00731 02379 00175 009215 -05 6925 M ADOLF TRUJILLO 19740301 012500 00731 02379 00075 009315 -05 6925 M ADOLF TRUJILLO 19740315 012500 00731 02379 00000 009390 -10 1504 F TIFFANY KEIR 19740101 029000 01697 03129 00050 024124 -10 1504 F TIFFANY KEIR 19740115 029000 01697 03129 00000 024174 -10 1504 F TIFFANY KEIR 19740201 029000 01697 03129 00075 024099 -10 1504 F TIFFANY KEIR 19740215 029000 01697 03129 00000 024174 -10 1504 F TIFFANY KEIR 19740301 029000 01697 03129 00000 024174 -10 1504 F TIFFANY KEIR 19740315 029000 01697 03129 00050 024124 -10 6640 M ALEXANDER CATHEY 19740101 032500 01901 06185 00000 024414 -10 6640 M ALEXANDER CATHEY 19740115 032500 01901 06185 00175 024239 -10 6640 M ALEXANDER CATHEY 19740201 032500 01901 06185 00175 024239 -10 6640 M ALEXANDER CATHEY 19740215 032500 01901 06185 00175 024239 -10 6640 M ALEXANDER CATHEY 19740301 032500 01901 06185 00100 024314 -10 6640 M ALEXANDER CATHEY 19740315 032500 01901 06185 00100 024314 -10 9465 M STEVE HUGHES 19740101 029500 01726 04788 00175 022811 -10 9465 M STEVE HUGHES 19740115 029500 01726 04788 00000 022986 -10 9465 M STEVE HUGHES 19740201 029500 01726 04788 00000 022986 -10 9465 M STEVE HUGHES 19740215 029500 01726 04788 00050 022936 -10 9465 M STEVE HUGHES 19740301 029500 01726 04788 00075 022911 -15 2903 F KAYLA VERBECK 19740101 014000 00819 02272 00050 010859 -15 2903 F KAYLA VERBECK 19740115 014000 00819 02272 00175 010734 -15 2903 F KAYLA VERBECK 19740201 014000 00819 02272 00050 010859 -15 2903 F KAYLA VERBECK 19740215 014000 00819 02272 00175 010734 -15 2903 F KAYLA VERBECK 19740301 014000 00819 02272 00000 010909 -15 2903 F KAYLA VERBECK 19740315 014000 00819 02272 00075 010834 -15 5196 F CLAIRE KELLAR 19740101 014500 00848 01114 00075 012463 -15 5196 F CLAIRE KELLAR 19740115 014500 00848 01114 00100 012438 -15 5196 F CLAIRE KELLAR 19740201 014500 00848 01114 00175 012363 -15 5196 F CLAIRE KELLAR 19740215 014500 00848 01114 00050 012488 -15 5196 F CLAIRE KELLAR 19740301 015300 00895 02912 00175 011318 -15 5196 F CLAIRE KELLAR 19740315 015300 00895 02912 00100 011393 -20 5190 F MARYANN GLAZENER 19740101 009000 00527 01164 00050 007260 -20 5190 F MARYANN GLAZENER 19740115 009000 00527 01164 00075 007235 -20 5190 F MARYANN GLAZENER 19740201 009000 00527 01164 00000 007310 -20 5190 F MARYANN GLAZENER 19740215 009000 00527 01164 00075 007235 -20 5190 F MARYANN GLAZENER 19740301 009000 00527 01164 00050 007260 -20 5190 F MARYANN GLAZENER 19740315 009000 00527 01164 00100 007210 -20 6580 F CAROLINE TROMBETTA 19740101 008000 00468 00863 00000 006669 -20 6580 F CAROLINE TROMBETTA 19740115 008000 00468 00863 00075 006594 -20 6580 F CAROLINE TROMBETTA 19740201 008000 00468 00863 00000 006569 -20 6580 F CAROLINE TROMBETTA 19740215 008000 00468 00863 00075 006594 -20 6580 F CAROLINE TROMBETTA 19740301 008000 00468 00863 00050 006619 -20 6580 F CAROLINE TROMBETTA 19740315 008000 00468 00863 00075 006594 -20 9507 F ADRIANA CHANGAZI 19740101 008300 00486 01347 00075 006392 -20 9507 F ADRIANA CHANGAZI 19740115 008300 00486 01347 00175 006292 -20 9507 F ADRIANA CHANGAZI 19740201 008300 00486 01347 00075 006392 -20 9507 F ADRIANA CHANGAZI 19740215 008300 00486 01347 00175 006292 -20 9507 F ADRIANA CHANGAZI 19740301 008300 00486 01347 00000 006467 -20 9507 F ADRIANA CHANGAZI 19740315 008300 00486 01347 00175 006292 -25 0428 M MELVIN BEHRENS 19740101 007800 00456 00842 00000 006502 -25 0428 M MELVIN BEHRENS 19740115 007800 00456 00842 00175 006327 -25 0428 M MELVIN BEHRENS 19740201 007800 00456 00842 00175 006327 -25 0428 M MELVIN BEHRENS 19740215 007800 00456 00842 00075 006427 -25 0428 M MELVIN BEHRENS 19740301 007800 00456 00842 00000 006502 -25 0428 M MELVIN BEHRENS 19740315 007800 00456 00842 00075 006427 -25 2003 M BALDWIN SIMONSEN 19740101 011000 00644 02093 00050 008213 -25 2003 M BALDWIN SIMONSEN 19740115 011000 00644 02093 00075 008188 -25 2003 M BALDWIN SIMONSEN 19740201 011000 00644 02093 00000 008263 -25 2003 M BALDWIN SIMONSEN 19740215 011000 00644 02093 00100 008163 -25 2003 M BALDWIN SIMONSEN 19740301 011500 00673 01487 00075 009265 -25 2003 M BALDWIN SIMONSEN 19740315 011500 00673 01487 00175 009165 -25 6491 M LEO TILLEY 19740101 010100 00591 00776 00050 008683 -25 6491 M LEO TILLEY 19740115 010100 00591 00776 00075 008658 -25 6491 M LEO TILLEY 19740201 010100 00591 00776 00050 008683 -25 6491 M LEO TILLEY 19740215 010100 00591 00776 00075 008658 -25 6491 M LEO TILLEY 19740301 010100 00591 00776 00100 008633 -25 6491 M LEO TILLEY 19740315 010100 00591 00776 00000 008733 -]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - * ************************************************************* * - * * MODIFICATIONS: * - * * CORRECT PARAGRAPH NAME AND GO TO CODING ERRORS. * - * ************************************************************* * - - * ************************************************************* * - * REPORT WRITER EXAMPLE #6. * - * ************************************************************* * - - ENVIRONMENT DIVISION. - CONFIGURATION SECTION. - - INPUT-OUTPUT SECTION. - FILE-CONTROL. - - SELECT PAYROLL-REGISTER-DATA - ASSIGN TO EXTERNAL DATAIN - ORGANIZATION IS LINE SEQUENTIAL. - - SELECT REPORT-FILE - ASSIGN TO EXTERNAL LINE ADVANCING SYSPRINT. - - DATA DIVISION. - FILE SECTION. - - FD PAYROLL-REGISTER-DATA. - - 01 PAYROLL-REGISTER-RECORD. - 03 PRR-DEPARTMENT-NUMBER PIC 9(02). - 03 FILLER PIC X(01). - 03 PRR-EMPLOYEE-KEY. - 05 PRR-EMPLOYEE-NO PIC 9(04). - 05 FILLER PIC X(01). - 05 PRR-GENDER PIC X(01). - 05 FILLER PIC X(01). - 05 PRR-EMPLOYEE-NAME PIC X(20). - 03 FILLER PIC X(01). - 03 PRR-PAY-DATE PIC 9(08). - 03 FILLER REDEFINES PRR-PAY-DATE. - 05 PRR-PAY-DATE-YEAR PIC 9(04). - 05 PRR-PAY-DATE-MONTH PIC 9(02). - 05 PRR-PAY-DATE-DAY PIC 9(02). - 03 FILLER PIC X(01). - 03 PRR-GROSS-PAY PIC 9(04)V99. - 03 FILLER PIC X(01). - 03 PRR-FICA-WH PIC 9(03)V99. - 03 FILLER PIC X(01). - 03 PRR-FED-WH PIC 9(03)V99. - 03 FILLER PIC X(01). - 03 PRR-MISC-DED PIC 9(03)V99. - 03 FILLER PIC X(01). - 03 PRR-NET-PAY PIC 9(04)V99. - 03 FILLER PIC X(09). - - FD REPORT-FILE - REPORT IS QUARTERLY-PAY-REGISTER. - - WORKING-STORAGE SECTION. - 77 END-OF-FILE-SWITCH PIC X(1) VALUE 'N'. - 88 END-OF-FILE VALUE 'Y'. - 77 PR-SW PIC X(1) VALUE 'N'. - 77 SUM-FED-WH PIC 9(04)V99 VALUE 0. - 77 HI-GROSS PIC 9(05) VALUE 2000. - - 01 WS-EMPLOYEE-KEY. - 03 WS-EMPLOYEE-NUMBER PIC 9(04). - 03 FILLER PIC X(03). - 03 WS-EMPLOYEE-NAME PIC X(20). - - 01 WS-PERCENTS-COMPUTED. - 03 WPC-DEPT OCCURS 6 TIMES - INDEXED BY WPCD-IX. - 05 WPC-PERCENT OCCURS 5 TIMES - INDEXED BY WPCC-IX - PIC 9(3)V99. - - 01 DEPARTMENT-TABLE. - 03 FILLER PIC X(17) VALUE '01MANAGEMENT '. - 03 FILLER PIC X(50) VALUE ZEROS. - 03 FILLER PIC X(17) VALUE '05ADMINISTRATIVE '. - 03 FILLER PIC X(50) VALUE ZEROS. - 03 FILLER PIC X(17) VALUE '10SKILLED NURSING'. - 03 FILLER PIC X(50) VALUE ZEROS. - 03 FILLER PIC X(17) VALUE '15PATIENT SUPPORT'. - 03 FILLER PIC X(50) VALUE ZEROS. - 03 FILLER PIC X(17) VALUE '20HOUSEKEEPING '. - 03 FILLER PIC X(50) VALUE ZEROS. - 03 FILLER PIC X(17) VALUE '25MAINTENANCE '. - 03 FILLER PIC X(50) VALUE ZEROS. - 01 FILLER REDEFINES DEPARTMENT-TABLE. - 03 DEPARTMENT-ENTRY OCCURS 6 TIMES - INDEXED BY DE-IX. - 05 DE-NUMBER PIC 9(02). - 05 DE-NAME PIC X(15). - 05 DE-GROSS PIC 9(08)V99. - 05 DE-FICA PIC 9(08)V99. - 05 DE-FWT PIC 9(08)V99. - 05 DE-MISC PIC 9(08)V99. - 05 DE-NET PIC 9(08)V99. - - REPORT SECTION. - RD QUARTERLY-PAY-REGISTER - CONTROLS ARE FINAL, PRR-DEPARTMENT-NUMBER, - PRR-EMPLOYEE-KEY - PAGE LIMIT IS 66 LINES - HEADING 1 - FIRST DETAIL 7 - LAST DETAIL 60. - - 01 TYPE PAGE HEADING. - 02 LINE 1. - 03 COLUMN 39 PIC X(13) VALUE 'C E N T U R Y'. - 03 COLUMN 55 PIC X(13) VALUE 'M E D I C A L'. - 03 COLUMN 71 PIC X(11) VALUE 'C E N T E R'. - 02 LINE 2. - 03 COLUMN 35 PIC X(17) VALUE 'Q U A R T E R L Y'. - 03 COLUMN 55 PIC X(13) VALUE 'P A Y R O L L'. - 03 COLUMN 71 PIC X(15) VALUE 'R E G I S T E R'. - 03 COLUMN 111 PIC X(04) VALUE 'PAGE'. - 03 COLUMN 116 PIC ZZZZ9 SOURCE PAGE-COUNTER. - 02 LINE 4. - 03 COLUMN 06 PIC X(9) VALUE ALL '-'. - 03 COLUMN 15 PIC X(28) VALUE - ' EMPLOYEE ---------'. - 03 COLUMN 40 PIC X(05) VALUE 'GROSS'. - 03 COLUMN 54 PIC X(04) VALUE 'FICA'. - 03 COLUMN 66 PIC X(07) VALUE 'FED W/H'. - 03 COLUMN 80 PIC X(05) VALUE 'MISC.'. - 03 COLUMN 95 PIC X(03) VALUE 'NET'. - 02 LINE 5. - 03 COLUMN 07 PIC X(02) VALUE 'NO'. - 03 COLUMN 22 PIC X(04) VALUE 'NAME'. - 03 COLUMN 41 PIC X(03) VALUE 'PAY'. - 03 COLUMN 55 PIC X(03) VALUE 'TAX'. - 03 COLUMN 68 PIC X(03) VALUE 'TAX'. - 03 COLUMN 79 PIC X(07) VALUE 'DEDUCT.'. - 03 COLUMN 95 PIC X(03) VALUE 'PAY'. - - 01 DEPT-HEAD TYPE CONTROL HEADING PRR-DEPARTMENT-NUMBER - NEXT GROUP + 1. - 02 LINE PLUS 1. - 03 COLUMN 01 PIC X(18) VALUE - 'DEPARTMENT NUMBER:'. - 03 COLUMN 21 PIC 9(02) SOURCE PRR-DEPARTMENT-NUMBER. - 03 COLUMN 24 PIC X(15) SOURCE DE-NAME (DE-IX). - - 01 EMPLOYEE-DETAIL TYPE DETAIL. - 02 LINE + 1. - 03 COLUMN 01 PIC X(27) SOURCE PRR-EMPLOYEE-KEY. - 03 COLUMN 30 PIC X(5) VALUE "Hello" - PRESENT AFTER NEW PRR-EMPLOYEE-KEY - OR PAGE. - 03 COLUMN 30 PIC X(5) VALUE " '' " - ABSENT AFTER NEW PRR-EMPLOYEE-KEY - OR PAGE. - 03 COLUMN 50 PIC 9(04).99 SOURCE PRR-GROSS-PAY. - 03 COLUMN 60 PIC 9(03).99 SOURCE PRR-FICA-WH. - 03 COLUMN 70 PIC 9(03).99 SOURCE PRR-FED-WH. - 03 COLUMN 80 PIC 9(03).99 SOURCE PRR-MISC-DED. - 03 COLUMN 90 PIC 9(04).99 SOURCE PRR-NET-PAY. - - 01 EMPL-FOOT TYPE CONTROL FOOTING PRR-EMPLOYEE-KEY. - 02 LINE PLUS 1 - PRESENT WHEN SUM-FED-WH > 80.00 - . - 03 COLUMN 06 PIC ZZZ9 SOURCE WS-EMPLOYEE-NUMBER. - 03 COLUMN 14 PIC X(20) SOURCE WS-EMPLOYEE-NAME. - 03 COLUMN 38 PIC $$,$$9.99 SUM PRR-GROSS-PAY. - 03 COLUMN 53 PIC $$$9.99 SUM PRR-FICA-WH. - 03 COLUMN 66 PIC $$$9.99 SUM PRR-FED-WH. - 03 COLUMN 79 PIC $$$9.99 SUM PRR-MISC-DED. - 03 COLUMN 92 PIC $$,$$9.99 SUM PRR-NET-PAY. - - 01 DEPT-FOOT TYPE CONTROL FOOTING PRR-DEPARTMENT-NUMBER - NEXT GROUP PLUS 2. - 02 LINE PLUS 2. - 03 COLUMN 14 PIC X(20) VALUE - 'DEPARTMENT TOTALS'. - 03 DEPT-FOOT-GROSS COLUMN 38 PIC $$,$$9.99 - SUM PRR-GROSS-PAY. - 03 COLUMN 48 PIC X VALUE '*'. - 03 DEPT-FOOT-FICA COLUMN 53 PIC $$$9.99 - SUM PRR-FICA-WH. - 03 COLUMN 61 PIC X VALUE '*'. - 03 DEPT-FOOT-FWT COLUMN 66 PIC $$$9.99 - SUM PRR-FED-WH. - 03 COLUMN 74 PIC X VALUE '*'. - 03 DEPT-FOOT-MISC COLUMN 79 PIC $$$9.99 - SUM PRR-MISC-DED. - 03 COLUMN 87 PIC X VALUE '*'. - 03 DEPT-FOOT-NET COLUMN 92 PIC $$,$$9.99 - SUM PRR-NET-PAY. - 03 COLUMN 102 PIC X VALUE '*'. - - 01 COMP-FOOT TYPE CONTROL FOOTING FINAL. - 02 LINE PLUS 2. - 03 COLUMN 14 PIC X(20) VALUE - 'COMPANY TOTALS'. - 03 CO-GROSS COLUMN 37 PIC $$$,$$9.99 - SUM PRR-GROSS-PAY. - 03 COLUMN 48 PIC XX VALUE '**'. - 03 CO-FICA COLUMN 51 PIC $$,$$9.99 - SUM PRR-FICA-WH. - 03 COLUMN 61 PIC XX VALUE '**'. - 03 CO-FWT COLUMN 64 PIC $$,$$9.99 - SUM PRR-FED-WH. - 03 COLUMN 74 PIC XX VALUE '**'. - 03 CO-MISC COLUMN 77 PIC $$,$$9.99 - SUM PRR-MISC-DED. - 03 COLUMN 87 PIC XX VALUE '**'. - 03 CO-NET COLUMN 91 PIC $$$,$$9.99 - SUM PRR-NET-PAY. - 03 COLUMN 102 PIC XX VALUE '**'. - - 01 REPORT-FOOT TYPE REPORT FOOTING. - 02 LINE 1. - 03 COLUMN 39 PIC X(13) VALUE 'C e n t u r y'. - 03 COLUMN 55 PIC X(13) VALUE 'M e d i c a l'. - 03 COLUMN 71 PIC X(11) VALUE 'C e n t e r'. - 02 LINE 2. - 03 COLUMN 35 PIC X(17) VALUE 'Q u a r t e r l y'. - 03 COLUMN 55 PIC X(13) VALUE 'P a y r o l l'. - 03 COLUMN 71 PIC X(15) VALUE 'R e g i s t e r'. - 03 COLUMN 111 PIC X(04) VALUE 'PAGE'. - 03 COLUMN 116 PIC ZZZZ9 SOURCE PAGE-COUNTER. - 02 LINE 4. - 03 COLUMN 40 PIC X(05) VALUE 'GROSS'. - 03 COLUMN 58 PIC X(04) VALUE 'FICA'. - 03 COLUMN 74 PIC X(07) VALUE 'FED W/H'. - 03 COLUMN 92 PIC X(05) VALUE 'MISC.'. - 03 COLUMN 111 PIC X(03) VALUE 'NET'. - 02 LINE 5. - 03 COLUMN 41 PIC X(03) VALUE 'PAY'. - 03 COLUMN 59 PIC X(03) VALUE 'TAX'. - 03 COLUMN 76 PIC X(03) VALUE 'TAX'. - 03 COLUMN 91 PIC X(07) VALUE 'DEDUCT.'. - 03 COLUMN 111 PIC X(03) VALUE 'PAY'. - - 02 LINE PLUS 2. - 03 COLUMN 05 PIC X(29) VALUE - '* * * DEPARTMENT TOTALS * * *'. - 02 LINE PLUS 2. - 03 COLUMN 05 PIC 9(02) SOURCE DE-NUMBER (1). - 03 COLUMN 08 PIC X(15) SOURCE DE-NAME (1). - 03 FILLER PRESENT WHEN DE-GROSS (1) > HI-GROSS. - 05 COLUMN 30 PIC X(4) VALUE "High". - 03 COLUMN 38 PIC $$,$$9.99 SOURCE DE-GROSS (1). - 03 COLUMN 48 PIC ZZ9 SOURCE WPC-PERCENT (1 1). - 03 COLUMN 51 PIC X VALUE '%'. - 03 COLUMN 57 PIC $$$9.99 SOURCE DE-FICA (1). - 03 COLUMN 65 PIC ZZ9 SOURCE WPC-PERCENT (1 2). - 03 COLUMN 68 PIC X VALUE '%'. - 03 COLUMN 74 PIC $$$9.99 SOURCE DE-FWT (1). - 03 COLUMN 82 PIC ZZ9 SOURCE WPC-PERCENT (1 3). - 03 COLUMN 85 PIC X VALUE '%'. - 03 COLUMN 91 PIC $$$9.99 SOURCE DE-MISC (1). - 03 COLUMN 99 PIC ZZ9 SOURCE WPC-PERCENT (1 4). - 03 COLUMN 102 PIC X VALUE '%'. - 03 COLUMN 108 PIC $$,$$9.99 SOURCE DE-NET (1). - 03 COLUMN 118 PIC ZZ9 SOURCE WPC-PERCENT (1 5). - 03 COLUMN 121 PIC X VALUE '%'. - 03 FILLER PRESENT WHEN WPC-PERCENT (1 5) < 15 . - 05 COLUMN PLUS 1 PIC X(2) VALUE "Lo". - 02 LINE PLUS 2. - 03 COLUMN 05 PIC 9(02) SOURCE DE-NUMBER (2). - 03 COLUMN 08 PIC X(15) SOURCE DE-NAME (2). - 03 FILLER PRESENT WHEN DE-GROSS (2) > HI-GROSS. - 05 COLUMN 30 PIC X(4) VALUE "High". - 03 COLUMN 38 PIC $$,$$9.99 SOURCE DE-GROSS (2). - 03 COLUMN 48 PIC ZZ9 SOURCE WPC-PERCENT (2 1). - 03 COLUMN 51 PIC X VALUE '%'. - 03 COLUMN 57 PIC $$$9.99 SOURCE DE-FICA (2). - 03 COLUMN 65 PIC ZZ9 SOURCE WPC-PERCENT (2 2). - 03 COLUMN 68 PIC X VALUE '%'. - 03 COLUMN 74 PIC $$$9.99 SOURCE DE-FWT (2). - 03 COLUMN 82 PIC ZZ9 SOURCE WPC-PERCENT (2 3). - 03 COLUMN 85 PIC X VALUE '%'. - 03 COLUMN 91 PIC $$$9.99 SOURCE DE-MISC (2). - 03 COLUMN 99 PIC ZZ9 SOURCE WPC-PERCENT (2 4). - 03 COLUMN 102 PIC X VALUE '%'. - 03 COLUMN 108 PIC $$,$$9.99 SOURCE DE-NET (2). - 03 COLUMN 118 PIC ZZ9 SOURCE WPC-PERCENT (2 5). - 03 COLUMN 121 PIC X VALUE '%'. - 03 FILLER PRESENT WHEN WPC-PERCENT (2 5) < 15 . - 05 COLUMN PLUS 1 PIC X(2) VALUE "Lo". - 02 LINE PLUS 2. - 03 COLUMN 05 PIC 9(02) SOURCE DE-NUMBER (3). - 03 COLUMN 08 PIC X(15) SOURCE DE-NAME (3). - 03 FILLER PRESENT WHEN DE-GROSS (3) > HI-GROSS. - 05 COLUMN 30 PIC X(4) VALUE "High". - 03 COLUMN 38 PIC $$,$$9.99 SOURCE DE-GROSS (3). - 03 COLUMN 48 PIC ZZ9 SOURCE WPC-PERCENT (3 1). - 03 COLUMN 51 PIC X VALUE '%'. - 03 COLUMN 57 PIC $$$9.99 SOURCE DE-FICA (3). - 03 COLUMN 65 PIC ZZ9 SOURCE WPC-PERCENT (3 2). - 03 COLUMN 68 PIC X VALUE '%'. - 03 COLUMN 74 PIC $$$9.99 SOURCE DE-FWT (3). - 03 COLUMN 82 PIC ZZ9 SOURCE WPC-PERCENT (3 3). - 03 COLUMN 85 PIC X VALUE '%'. - 03 COLUMN 91 PIC $$$9.99 SOURCE DE-MISC (3). - 03 COLUMN 99 PIC ZZ9 SOURCE WPC-PERCENT (3 4). - 03 COLUMN 102 PIC X VALUE '%'. - 03 COLUMN 108 PIC $$,$$9.99 SOURCE DE-NET (3). - 03 COLUMN 118 PIC ZZ9 SOURCE WPC-PERCENT (3 5). - 03 COLUMN 121 PIC X VALUE '%'. - 03 FILLER PRESENT WHEN WPC-PERCENT (3 5) < 15 . - 05 COLUMN PLUS 1 PIC X(2) VALUE "Lo". - 02 LINE PLUS 2. - 03 COLUMN 05 PIC 9(02) SOURCE DE-NUMBER (4). - 03 COLUMN 08 PIC X(15) SOURCE DE-NAME (4). - 03 COLUMN 38 PIC $$,$$9.99 SOURCE DE-GROSS (4). - 03 COLUMN 48 PIC ZZ9 SOURCE WPC-PERCENT (4 1). - 03 COLUMN 51 PIC X VALUE '%'. - 03 COLUMN 57 PIC $$$9.99 SOURCE DE-FICA (4). - 03 COLUMN 65 PIC ZZ9 SOURCE WPC-PERCENT (4 2). - 03 COLUMN 68 PIC X VALUE '%'. - 03 COLUMN 74 PIC $$$9.99 SOURCE DE-FWT (4). - 03 COLUMN 82 PIC ZZ9 SOURCE WPC-PERCENT (4 3). - 03 COLUMN 85 PIC X VALUE '%'. - 03 COLUMN 91 PIC $$$9.99 SOURCE DE-MISC (4). - 03 COLUMN 99 PIC ZZ9 SOURCE WPC-PERCENT (4 4). - 03 COLUMN 102 PIC X VALUE '%'. - 03 COLUMN 108 PIC $$,$$9.99 SOURCE DE-NET (4). - 03 COLUMN 118 PIC ZZ9 SOURCE WPC-PERCENT (4 5). - 03 COLUMN 121 PIC X VALUE '%'. - 02 LINE PLUS 2. - 03 COLUMN 05 PIC 9(02) SOURCE DE-NUMBER (5). - 03 COLUMN 08 PIC X(15) SOURCE DE-NAME (5). - 03 COLUMN 38 PIC $$,$$9.99 SOURCE DE-GROSS (5). - 03 COLUMN 48 PIC ZZ9 SOURCE WPC-PERCENT (5 1). - 03 COLUMN 51 PIC X VALUE '%'. - 03 COLUMN 57 PIC $$$9.99 SOURCE DE-FICA (5). - 03 COLUMN 65 PIC ZZ9 SOURCE WPC-PERCENT (5 2). - 03 COLUMN 68 PIC X VALUE '%'. - 03 COLUMN 74 PIC $$$9.99 SOURCE DE-FWT (5). - 03 COLUMN 82 PIC ZZ9 SOURCE WPC-PERCENT (5 3). - 03 COLUMN 85 PIC X VALUE '%'. - 03 COLUMN 91 PIC $$$9.99 SOURCE DE-MISC (5). - 03 COLUMN 99 PIC ZZ9 SOURCE WPC-PERCENT (5 4). - 03 COLUMN 102 PIC X VALUE '%'. - 03 COLUMN 108 PIC $$,$$9.99 SOURCE DE-NET (5). - 03 COLUMN 118 PIC ZZ9 SOURCE WPC-PERCENT (5 5). - 03 COLUMN 121 PIC X VALUE '%'. - 02 LINE PLUS 2. - 03 COLUMN 05 PIC 9(02) SOURCE DE-NUMBER (6). - 03 COLUMN 08 PIC X(15) SOURCE DE-NAME (6). - 03 COLUMN 38 PIC $$,$$9.99 SOURCE DE-GROSS (6). - 03 COLUMN 48 PIC ZZ9 SOURCE WPC-PERCENT (6 1). - 03 COLUMN 51 PIC X VALUE '%'. - 03 COLUMN 57 PIC $$$9.99 SOURCE DE-FICA (6). - 03 COLUMN 65 PIC ZZ9 SOURCE WPC-PERCENT (6 2). - 03 COLUMN 68 PIC X VALUE '%'. - 03 COLUMN 74 PIC $$$9.99 SOURCE DE-FWT (6). - 03 COLUMN 82 PIC ZZ9 SOURCE WPC-PERCENT (6 3). - 03 COLUMN 85 PIC X VALUE '%'. - 03 COLUMN 91 PIC $$$9.99 SOURCE DE-MISC (6). - 03 COLUMN 99 PIC ZZ9 SOURCE WPC-PERCENT (6 4). - 03 COLUMN 102 PIC X VALUE '%'. - 03 COLUMN 108 PIC $$,$$9.99 SOURCE DE-NET (6). - 03 COLUMN 118 PIC ZZ9 SOURCE WPC-PERCENT (6 5). - 03 COLUMN 121 PIC X VALUE '%'. - 02 LINE PLUS 2. - 03 COLUMN 37 PIC $$$,$$9.99 SOURCE CO-GROSS. - 03 COLUMN 48 PIC X(5) VALUE '100%'. - 03 COLUMN 55 PIC $$,$$9.99 SOURCE CO-FICA. - 03 COLUMN 65 PIC X(5) VALUE '100%'. - 03 COLUMN 72 PIC $$,$$9.99 SOURCE CO-FWT. - 03 COLUMN 82 PIC X(5) VALUE '100%'. - 03 COLUMN 89 PIC $$,$$9.99 SOURCE CO-MISC. - 03 COLUMN 99 PIC X(5) VALUE '100%'. - 03 COLUMN 107 PIC $$$,$$9.99 SOURCE CO-NET. - 03 COLUMN 118 PIC X(5) VALUE '100%'. - - PROCEDURE DIVISION. - - DECLARATIVES. - - DEPT-HEAD-USE SECTION. USE BEFORE REPORTING DEPT-HEAD. - DEPT-HEAD-PROC. - SET DE-IX TO +1. - SEARCH DEPARTMENT-ENTRY - WHEN DE-NUMBER (DE-IX) = PRR-DEPARTMENT-NUMBER - MOVE ZEROS TO DE-GROSS (DE-IX), DE-FICA (DE-IX), - DE-FWT (DE-IX), DE-MISC (DE-IX), - DE-NET (DE-IX). - - DEPT-HEAD-EXIT. - EXIT. - - EMPL-FOOT-USE SECTION. USE BEFORE REPORTING EMPL-FOOT. - EMPL-FOOT-PROC. - MOVE PRR-EMPLOYEE-KEY TO WS-EMPLOYEE-KEY. - MOVE 'Y' TO PR-SW. - - EMPL-FOOT-EXIT. - EXIT. - - DEPT-FOOT-USE SECTION. USE BEFORE REPORTING DEPT-FOOT. - DEPT-FOOT-PROC. - MOVE DEPT-FOOT-GROSS TO DE-GROSS (DE-IX). - MOVE DEPT-FOOT-FICA TO DE-FICA (DE-IX). - MOVE DEPT-FOOT-FWT TO DE-FWT (DE-IX). - MOVE DEPT-FOOT-MISC TO DE-MISC (DE-IX). - MOVE DEPT-FOOT-NET TO DE-NET (DE-IX). - * SUPPRESS PRINTING. - - DEPT-FOOT-EXIT. - EXIT. - - COMP-FOOT-USE SECTION. USE BEFORE REPORTING COMP-FOOT. - COMP-FOOT-PROC. - PERFORM COMP-FOOT-CALC - VARYING WPCD-IX FROM +1 BY +1 - UNTIL WPCD-IX > +6. - GO TO COMP-FOOT-EXIT. - - COMP-FOOT-CALC. - SET DE-IX TO WPCD-IX. - SET WPCC-IX TO +1. - COMPUTE WPC-PERCENT (WPCD-IX WPCC-IX) ROUNDED = - ((DE-GROSS (DE-IX) / CO-GROSS) * 100) + .5. - SET WPCC-IX TO +2. - COMPUTE WPC-PERCENT (WPCD-IX WPCC-IX) ROUNDED = - ((DE-FICA (DE-IX) / CO-FICA) * 100) + .5. - SET WPCC-IX TO +3. - COMPUTE WPC-PERCENT (WPCD-IX WPCC-IX) ROUNDED = - ((DE-FWT (DE-IX) / CO-FWT) * 100) + .5. - SET WPCC-IX TO +4. - COMPUTE WPC-PERCENT (WPCD-IX WPCC-IX) ROUNDED = - ((DE-MISC (DE-IX) / CO-MISC) * 100) + .5. - SET WPCC-IX TO +5. - COMPUTE WPC-PERCENT (WPCD-IX WPCC-IX) ROUNDED = - ((DE-NET (DE-IX) / CO-NET) * 100) + .5. - - COMP-FOOT-EXIT. - EXIT. - - END DECLARATIVES. - - 000-INITIATE. - - OPEN INPUT PAYROLL-REGISTER-DATA, - OUTPUT REPORT-FILE. - - INITIATE QUARTERLY-PAY-REGISTER. - - READ PAYROLL-REGISTER-DATA - AT END - MOVE 'Y' TO END-OF-FILE-SWITCH. - - PERFORM 100-PROCESS-PAYROLL-DATA THRU 199-EXIT - UNTIL END-OF-FILE. - - 000-TERMINATE. - TERMINATE QUARTERLY-PAY-REGISTER. - - CLOSE PAYROLL-REGISTER-DATA, - REPORT-FILE. - - STOP RUN. - - 100-PROCESS-PAYROLL-DATA. - ADD PRR-FED-WH TO SUM-FED-WH. - GENERATE QUARTERLY-PAY-REGISTER. - IF PR-SW = 'Y' - MOVE 'N' TO PR-SW - MOVE ZERO TO SUM-FED-WH. - READ PAYROLL-REGISTER-DATA - AT END - MOVE 'Y' TO END-OF-FILE-SWITCH. - - 199-EXIT. - EXIT. - -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], -[prog.cob:266: warning: PLUS is ignored on first field of line -prog.cob:288: warning: PLUS is ignored on first field of line -prog.cob:310: warning: PLUS is ignored on first field of line -]) - -AT_CHECK([DD_DATAIN="./inp_data" DD_SYSPRINT="./report.txt" $COBCRUN_DIRECT ./prog], [0], [], []) - - -AT_CAPTURE_FILE(./report.txt) - -AT_DATA([reference], [ C E N T U R Y M E D I C A L C E N T E R - Q U A R T E R L Y P A Y R O L L R E G I S T E R PAGE 1 - - --------- EMPLOYEE --------- GROSS FICA FED W/H MISC. NET - NO NAME PAY TAX TAX DEDUCT. PAY - -DEPARTMENT NUMBER: 01 MANAGEMENT - - 6622 GAVIN SHAFER $1,040.00 $60.84 $134.48 $4.75 $839.93 - 7078 VERA ALSTON $1,800.00 $105.30 $138.24 $3.75 $1,552.71 - 8093 GRADY KAISER $2,300.00 $134.57 $247.53 $6.50 $1,911.43 - - DEPARTMENT TOTALS $5,140.00 * $300.71 * $520.25 * $15.00 * $4,304.07 * - - -DEPARTMENT NUMBER: 05 ADMINISTRATIVE - - 1720 PAULINE WINSTON $680.00 $39.79 $290.36 $3.50 $526.37 - 2116 HERMAN COX $610.00 $35.69 $76.52 $7.25 $490.55 - 6925 ADOLF TRUJILLO $625.00 $36.55 $118.95 $4.00 $465.50 - - DEPARTMENT TOTALS $1,915.00 * $112.03 * $485.83 * $14.75 * $1,482.42 * - - -DEPARTMENT NUMBER: 10 SKILLED NURSING - - 1504 TIFFANY KEIR $1,740.00 $101.82 $187.74 $1.75 $1,448.69 - 6640 ALEXANDER CATHEY $1,950.00 $114.06 $371.10 $7.25 $1,457.59 - 9465 STEVE HUGHES $1,475.00 $86.30 $239.40 $3.00 $1,146.30 - - DEPARTMENT TOTALS $5,165.00 * $302.18 * $798.24 * $12.00 * $4,052.58 * - - -DEPARTMENT NUMBER: 15 PATIENT SUPPORT - - 2903 KAYLA VERBECK $840.00 $49.14 $136.32 $5.25 $649.29 - 5196 CLAIRE KELLAR $886.00 $51.82 $102.80 $6.75 $724.63 - - DEPARTMENT TOTALS $1,726.00 * $100.96 * $239.12 * $12.00 * $1,373.92 * - - -DEPARTMENT NUMBER: 20 HOUSEKEEPING - - - DEPARTMENT TOTALS $1,518.00 * $88.86 * $202.44 * $13.00 * $1,212.76 * - - -DEPARTMENT NUMBER: 25 MAINTENANCE - - 2003 BALDWIN SIMONSEN $670.00 $39.22 $113.46 $4.75 $512.57 - - DEPARTMENT TOTALS $1,744.00 * $102.04 * $210.54 * $13.25 * $1,418.17 * - - COMPANY TOTALS $17,208.00 ** $1,006.78 ** $2,456.42 ** $80.00 ** $13,843.92 ** - - - - - - - - - - - - - C e n t u r y M e d i c a l C e n t e r - Q u a r t e r l y P a y r o l l R e g i s t e r PAGE 2 - - GROSS FICA FED W/H MISC. NET - PAY TAX TAX DEDUCT. PAY - - * * * DEPARTMENT TOTALS * * * - - 01 MANAGEMENT High $5,140.00 30% $300.71 30% $520.25 21% $15.00 19% $4,304.07 31% - -Lo 05 ADMINISTRATIVE $1,915.00 11% $112.03 11% $485.83 20% $14.75 18% $1,482.42 11% - - 10 SKILLED NURSING High $5,165.00 30% $302.18 30% $798.24 33% $12.00 15% $4,052.58 29% - - 15 PATIENT SUPPORT $1,726.00 10% $100.96 10% $239.12 10% $12.00 15% $1,373.92 10% - - 20 HOUSEKEEPING $1,518.00 9% $88.86 9% $202.44 8% $13.00 16% $1,212.76 9% - - 25 MAINTENANCE $1,744.00 10% $102.04 10% $210.54 9% $13.25 17% $1,418.17 10% - - $17,208.00 100% $1,006.78 100% $2,456.42 100% $80.00 100% $13,843.92 100% -]) - -AT_CHECK([diff reference report.txt], [0], [], []) - -AT_CLEANUP - - -AT_SETUP([Sample REPORT with RIGHT/CENTER]) -AT_KEYWORDS([report runfile]) - -AT_DATA([inp_data], -[00099Dorken, Keith CS 000008 -00007Allinson, Sandy MA 000118 -00125Allinson, Nina MA 012308 -00126Allinson, Natalia MA 000008 -00127Allinson, Kristina MBA000008 -00131Norman, Nancy SC 000006 -00132Norman, Becky SC 000116 -00133Norman, Michelle SC 112306 -00134Norman, James AM 000006 -12345Norman, Ron CS 000008 -]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - CONFIGURATION SECTION. - INPUT-OUTPUT SECTION. - - FILE-CONTROL. - SELECT INPUT-FILE ASSIGN TO EXTERNAL STUDENT - ORGANIZATION IS LINE SEQUENTIAL. - SELECT PRINT-FILE ASSIGN TO EXTERNAL - LINE ADVANCING REPORT1. - - DATA DIVISION. - FILE SECTION. - FD INPUT-FILE. - 01 INPUT-REC. - 05 STUDENT-ID PIC 9(5). - 05 STUDENT-NAME PIC X(20). - 05 MAJOR PIC XXX. - 05 NUM-COURSES PIC 9(6). - - FD PRINT-FILE - BLOCK CONTAINS 0 RECORDS - RECORDING MODE IS F - RECORD CONTAINS 132 CHARACTERS - REPORT IS STUDENT-REPORT. - 01 RW-REC PIC X(90). - - WORKING-STORAGE SECTION. - 01 ARE-THERE-MORE-RECORDS PIC XXX VALUE "YES". - - REPORT SECTION. - RD STUDENT-REPORT - PAGE LIMIT 30 - HEADING 1 - FIRST DETAIL 5 - LAST DETAIL 25 - FOOTING 28 - LINE LIMIT 90 - . - 01 HEADING-LINE. - 02 TYPE PAGE HEADING LINE PLUS 1. - 05 COLUMN 1 PIC X(50) VALUE - " 1 2 3 4 5". - 05 COLUMN 51 PIC X(20) VALUE " 6 7". - 02 TYPE PAGE HEADING LINE PLUS 1. - 05 COLUMN 1 PIC X(50) VALUE - "12345678901234567890123456789012345678901234567890". - 05 COLUMN 51 PIC X(20) VALUE "12345678901234567890". - 02 TYPE PAGE HEADING LINE PLUS 1. - 05 COLUMN 1 PIC X(2) VALUE "Ln". - 05 COLUMN 5 PIC X(6) VALUE "--ID--". - 05 COLUMN 16 PIC X(20) VALUE "--------Name--------". - 05 COLUMN 39 PIC X(5) VALUE "Major". - 05 COLUMN 45 PIC XXX VALUE "*-*". - 05 COLUMN 54 PIC X(5) VALUE "+Odd+". - 05 COLUMN 61 PIC X(6) VALUE "+Even+". - - 01 REPORT-LINE - TYPE DETAIL LINE PLUS 1. - 05 COLUMN PLUS 1 PIC Z9 - SOURCE LINE-COUNTER OF STUDENT-REPORT. - 05 COLUMN LEFT PLUS 3 PIC Z(5)9 SOURCE STUDENT-ID. - 05 COLUMN CENTER 25 PIC X(20) SOURCE STUDENT-NAME. - 05 COLUMN RIGHT 43 PIC X(5) SOURCE MAJOR. - 05 COLUMN 45 PIC XXX VALUE ":-:". - 05 COLUMN CENTER 56 PIC Z(4)9 SOURCE NUM-COURSES. - 05 COLUMN CENTER 63 PIC Z(5)9 SOURCE NUM-COURSES. - 05 COLUMN 68 PIC X VALUE ":". - - PROCEDURE DIVISION. - A000-MAINLINE. - OPEN INPUT INPUT-FILE - OUTPUT PRINT-FILE - PERFORM DO-INIT. - READ INPUT-FILE - AT END - MOVE "NO" TO ARE-THERE-MORE-RECORDS. - PERFORM A001-LOOP - UNTIL ARE-THERE-MORE-RECORDS = "NO ". - PERFORM DO-TERM. - CLOSE INPUT-FILE - PRINT-FILE. - STOP RUN. - - A001-LOOP. - GENERATE REPORT-LINE. - READ INPUT-FILE - AT END - MOVE "NO " TO ARE-THERE-MORE-RECORDS. - DO-INIT. - INITIATE STUDENT-REPORT. - - DO-TERM. - TERMINATE STUDENT-REPORT. -]) - -AT_CHECK([$COMPILE prog.cob], [1], [], -[prog.cob:62: warning: PLUS is ignored on first field of line -prog.cob:64: error: PLUS is not allowed with LEFT, RIGHT or CENTER -]) - -AT_CHECK([$COMPILE -std=mf prog.cob], [0], [], -[prog.cob:62: warning: PLUS is ignored on first field of line -prog.cob:64: warning: PLUS is not recommended with LEFT, RIGHT or CENTER -]) - -AT_CHECK([DD_STUDENT=./inp_data DD_REPORT1=./report.txt \ -$COBCRUN_DIRECT ./prog], [0], [], []) - - -AT_CAPTURE_FILE(./report.txt) - -AT_DATA([reference], -[ 1 2 3 4 5 6 7 -1234567890123456789012345678901234567890123456789012345678901234567890 -Ln --ID-- --------Name-------- Major *-* +Odd+ +Even+ - - 5 99 Dorken, Keith CS :-: 8 8 : - 6 7 Allinson, Sandy MA :-: 118 118 : - 7 125 Allinson, Nina MA :-: 12308 12308 : - 8 126 Allinson, Natalia MA :-: 8 8 : - 9 127 Allinson, Kristina MBA :-: 8 8 : -10 131 Norman, Nancy SC :-: 6 6 : -11 132 Norman, Becky SC :-: 116 116 : -12 133 Norman, Michelle SC :-: 12306 112306 : -13 134 Norman, James AM :-: 6 6 : -14 12345 Norman, Ron CS :-: 8 8 : - - - - - - - - - - - - - - - - -]) - -AT_CHECK([diff reference report.txt], [0]) - -AT_CLEANUP - - -AT_SETUP([STUDENT REPORT with INITIAL]) -AT_KEYWORDS([report runfile]) - -AT_DATA([inp_data], -[00123Dorken, Keith CS 08 -00124Allinson, Sandy MA 08 -00125Allinson, Nina MA 08 -00126Allinson, Natalia MA 08 -00127Allinson, Kristina MBA08 -00131Norman, Nancy SC 06 -00132Norman, Becky SC 06 -00133Norman, Michelle SC 06 -00134Norman, James AM 06 -12345Norman, Ron CS 08 -]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog INITIAL. - ENVIRONMENT DIVISION. - CONFIGURATION SECTION. - INPUT-OUTPUT SECTION. - FILE-CONTROL. - SELECT INPUT-FILE ASSIGN TO EXTERNAL STUDENT - ORGANIZATION IS LINE SEQUENTIAL. - SELECT PRINT-FILE ASSIGN TO EXTERNAL - LINE ADVANCING REPORT1. - - DATA DIVISION. - FILE SECTION. - FD INPUT-FILE. - 01 INPUT-REC. - 05 STUDENT-ID PIC 9(5). - 05 STUDENT-NAME PIC X(20). - 05 MAJOR PIC XXX. - 05 NUM-COURSES PIC 99. - - FD PRINT-FILE - REPORT IS STUDENT-REPORT STUDENT-REPORT2. - - WORKING-STORAGE SECTION. - 01 ARE-THERE-MORE-RECORDS PIC XXX VALUE "YES". - - REPORT SECTION. - RD STUDENT-REPORT - PAGE LIMIT 30 LINES - HEADING 2 - FIRST DETAIL 3 - LAST DETAIL 25 - FOOTING 28. - 01 REPORT-LINE - TYPE DETAIL - LINE PLUS 1. - 05 COLUMN 1 PIC 9(2) - SOURCE LINE-COUNTER OF STUDENT-REPORT. - 05 COLUMN 4 PIC 9(6) SOURCE STUDENT-ID. - 05 COLUMN 15 PIC X(20) SOURCE STUDENT-NAME. - 05 COLUMN 40 PIC XXX SOURCE MAJOR. - 05 COLUMN 45 PIC XXX VALUE "-*-". - 05 COLUMN 52 PIC 99 SOURCE NUM-COURSES. - - RD STUDENT-REPORT2 - PAGE LIMIT 60 LINES - HEADING 2 - FIRST DETAIL 5 - LAST DETAIL 55 - FOOTING 58. - 01 REPORT-LINE2 - TYPE DETAIL - LINE PLUS 1. - 05 COLUMN 4 PIC 9(6) SOURCE STUDENT-ID. - 05 COLUMN 15 PIC X(20) SOURCE STUDENT-NAME. - 05 COLUMN 40 PIC XXX SOURCE MAJOR. - 05 COLUMN 45 PIC 99 SOURCE NUM-COURSES. - 01 REPORT-LINE3 - TYPE DETAIL - LINE PLUS 2. - 05 COLUMN 4 PIC 9(6) SOURCE STUDENT-ID. - 05 COLUMN 15 PIC X(20) SOURCE STUDENT-NAME. - 05 COLUMN 40 PIC XXX SOURCE MAJOR. - - PROCEDURE DIVISION. - A000-MAINLINE. - OPEN INPUT INPUT-FILE - OUTPUT PRINT-FILE - PERFORM DO-INIT. - READ INPUT-FILE - AT END - MOVE "NO" TO ARE-THERE-MORE-RECORDS. - PERFORM A001-LOOP - UNTIL ARE-THERE-MORE-RECORDS = "NO ". - PERFORM DO-TERM. - CLOSE INPUT-FILE - PRINT-FILE. - STOP RUN. - - A001-LOOP. - GENERATE REPORT-LINE. - READ INPUT-FILE - AT END - MOVE "NO " TO ARE-THERE-MORE-RECORDS. - DO-INIT. - INITIATE STUDENT-REPORT. - - DO-TERM. - TERMINATE STUDENT-REPORT. -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) - -AT_CHECK([DD_STUDENT="./inp_data" DD_REPORT1="./report.txt" $COBCRUN_DIRECT ./prog], [0], [], []) - - -AT_CAPTURE_FILE(./report.txt) - -AT_DATA([reference], [ - -03 000123 Dorken, Keith CS -*- 08 -04 000124 Allinson, Sandy MA -*- 08 -05 000125 Allinson, Nina MA -*- 08 -06 000126 Allinson, Natalia MA -*- 08 -07 000127 Allinson, Kristina MBA -*- 08 -08 000131 Norman, Nancy SC -*- 06 -09 000132 Norman, Becky SC -*- 06 -10 000133 Norman, Michelle SC -*- 06 -11 000134 Norman, James AM -*- 06 -12 012345 Norman, Ron CS -*- 08 - - - - - - - - - - - - - - - - - - -]) - -AT_CHECK([diff reference report.txt], [0], [], []) - -AT_CLEANUP - - -AT_SETUP([ORDER REPORT; Test substring]) -AT_KEYWORDS([report runfile]) - -AT_DATA([inp_data], -[10001090001012010590416 $ -10001090002013016950416 $ -10002090002023016950416 $ -10002090001022010590416 $ -10003090007023016950417 $ -10003090008032010590417 $ -10003090009023016950417 $ -10003090010032010590417 $ -10004090007023016950417 $ -10004090008032010590417 $ -10004090009023016950417 $ -10004090010032010590417 $ -10004090011032010590417 $ -10004090012032010590417 $ -10004090013032010590417 $ -10004090014032010590417 $ -10004090015032010590417 $ -10005090007023016950417 $ -10005090008032010590417 $ -10005090009023016950417 $ -10005090010032010590417 $ -10005090011032010590417 $ -10005090012032010590417 $ -10005090013032010590417 $ -10005090014032010590417 $ -10005090015032010590417 $ -10005090016032010590417 $ -10005090017032010590417 $ -10005090018032010590417 $ -10006090007023016950417 $ -10006090008032010590417 $ -10006090009023016950417 $ -10006090010032010590417 $ -10006090011032010590417 $ -10006090012032010590417 $ -10006090013032010590417 $ -10006090014032010590417 $ -10006090015032010590417 $ -10006090016032010590417 $ -10006090017032010590417 $ -10006090018032010590417 $ -10006090019032010590417 $ -10006090020032010590417 $ -10007090007023016950417 $ -10007090008032010590417 $ -10007090009023016950417 $ -10007090010032010590417 $ -10007090011032010590417 $ -10007090012032010590417 $ -10007090013032010590417 $ -10007090014032010590417 $ -10007090015032010590417 $ -10007090016032010590417 $ -10007090017032010590417 $ -10007090018032010590417 $ -10007090019032010590417 $ -10007090020032010590417 $ -10007090021032010590417 $ -10007090022032010590417 $ -10008090007023016950417 $ -10008090008032010590417 $ -10008090009023016950417 $ -10008090010032010590417 $ -10008090011032010590417 $ -10008090012032010590417 $ -10008090013032010590417 $ -10008090014032010590417 $ -10008090015032010590417 $ -10008090016032010590417 $ -10008090017032010590417 $ -10008090018032010590417 $ -10008090019032010590417 $ -10008090020032010590417 $ -10008090021032010590417 $ -10008090022032010590417 $ -10009090007023016950417 $ -10009090008032010590417 $ -10009090009023016950417 $ -10009090010032010590417 $ -10009090011032010590417 $ -10009090012032010590417 $ -10009090013032010590417 $ -10009090014032010590417 $ -10009090015032010590417 $ -10009090016032010590417 $ -10009090017032010590417 $ -10009090018032010590417 $ -10009090019032010590417 $ -10009090020032010590417 $ -10009090021032010590417 $ -10009090022032010590417 $ -]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - CONFIGURATION SECTION. - INPUT-OUTPUT SECTION. - FILE-CONTROL. - SELECT CUST-ORDER-FILE ASSIGN TO EXTERNAL CUSTORD - ORGANIZATION IS LINE SEQUENTIAL. - SELECT CUST-PRINT-FILE ASSIGN TO EXTERNAL - LINE ADVANCING REPORT2. - - DATA DIVISION. - FILE SECTION. - FD CUST-ORDER-FILE. - 01 CUST-ORDER-REC. - 05 CUST-NUM PIC 9(5). - 05 ITEM-NUM PIC 9(6). - 05 NUM-ORD PIC 999. - 05 PRICE PIC 999V99. - 05 SHIPPING PIC 99V99. - 05 FILLER PIC X(7). - - FD CUST-PRINT-FILE - REPORT IS ORDER-REPORT. - - WORKING-STORAGE SECTION. - 01 INDICATORS. - 05 ARE-THERE-MORE-RECORDS PIC XXX VALUE 'YES'. - 88 THERE-ARE-NO-MORE-RECORDS VALUE 'NO '. - 01 CONSTANTS. - 05 SALES-TAX PIC 9V99 VALUE 0.05. - 01 WORK-AREAS. - 05 AMT-TAX PIC 9999V99 VALUE 0. - 05 AMT-ORDER PIC 9(5)V99 VALUE 0. - 05 TOT-ORDER PIC 9(6)V99 VALUE 0. - 05 CURRENT-TIME PIC 9(8) VALUE 14301275. - - REPORT SECTION. - RD ORDER-REPORT - CONTROLS ARE FINAL - PAGE 55 LINES - FIRST DETAIL 6. - 01 TYPE REPORT HEADING - LINE 1. - 10 COLUMN 44 PIC X(21) - VALUE 'CUSTOMER ORDER REPORT'. - 01 TYPE PAGE HEADING. - 05 LINE 2. - 10 COLUMN 10 PIC X(8) VALUE " Time:". - 10 COLUMN 20 PIC 99 SOURCE CURRENT-TIME (1:2). - 10 COLUMN 22 PIC X VALUE ':'. - 10 COLUMN 23 PIC 99 SOURCE CURRENT-TIME (3:2). - 10 COLUMN 25 PIC X VALUE ':'. - 10 COLUMN 26 PIC 99 SOURCE CURRENT-TIME (5:2). - 10 COLUMN 94 PIC X(5) VALUE 'Page'. - 10 COLUMN 106 PIC ZZ9 - SOURCE PAGE-COUNTER. - 05 LINE 4. - 10 COLUMN 11 PIC X(8) VALUE 'CUST NUM'. - 10 COLUMN 26 PIC XXXX VALUE 'PART'. - 10 COLUMN 39 PIC X(7) VALUE '# ITEMS'. - 10 COLUMN 50 PIC X(5) VALUE 'PRICE'. - 10 COLUMN 66 PIC X(8) VALUE 'QUANTITY'. - 10 COLUMN 82 PIC XXX VALUE 'TAX'. - 10 COLUMN 91 PIC X(8) VALUE 'SHIPPING'. - 10 COLUMN 108 PIC X(5) VALUE 'TOTAL'. - - 01 DETAIL-LINE TYPE IS DETAIL - LINE PLUS 1. - 05 COLUMN 12 PIC 9(5) - SOURCE CUST-NUM. - 05 COLUMN 25 PIC 9(6) - SOURCE ITEM-NUM. - 05 COLUMN 41 PIC 999 - SOURCE NUM-ORD. - 05 COLUMN 49 PIC ZZZ.99 - SOURCE PRICE. - 05 COLUMN 64 PIC ZZ,ZZZ.99 - SOURCE AMT-ORDER. - 05 COLUMN 80 PIC Z,ZZZ.99 - SOURCE AMT-TAX. - 05 COLUMN 93 PIC ZZ.99 - SOURCE SHIPPING. - 05 COLUMN 104 PIC ZZZ,ZZZ.99 - SOURCE TOT-ORDER. - - - 01 TYPE CONTROL FOOTING FINAL - LINE PLUS 2. - 05 COLUMN 42 PIC X(12) - VALUE 'FINAL TOTALS'. - 05 COLUMN 63 PIC ZZZ,ZZZ.99 - SOURCE AMT-ORDER. - 05 COLUMN 79 PIC ZZ,ZZZ.99 - SUM AMT-TAX. - 05 COLUMN 92 PIC ZZZ.99 - SUM SHIPPING. - 05 COLUMN 102 PIC Z,ZZZ,ZZZ.99 - SUM TOT-ORDER. - - PROCEDURE DIVISION. - A000-MAINLINE. - * Use hard coded time value so test is repeatable - * ACCEPT CURRENT-TIME FROM TIME. - OPEN INPUT CUST-ORDER-FILE - OUTPUT CUST-PRINT-FILE. - INITIATE ORDER-REPORT. - READ CUST-ORDER-FILE - AT END - MOVE 'NO' TO ARE-THERE-MORE-RECORDS. - PERFORM A001-LOOP - UNTIL THERE-ARE-NO-MORE-RECORDS. - TERMINATE ORDER-REPORT. - CLOSE CUST-ORDER-FILE - CUST-PRINT-FILE. - STOP RUN. - A001-LOOP. - MULTIPLY NUM-ORD BY PRICE GIVING AMT-ORDER. - MULTIPLY AMT-ORDER BY SALES-TAX GIVING AMT-TAX. - ADD AMT-ORDER SHIPPING AMT-TAX GIVING TOT-ORDER. - GENERATE DETAIL-LINE. - READ CUST-ORDER-FILE - AT END - MOVE 'NO' TO ARE-THERE-MORE-RECORDS. -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) - -AT_CHECK([DD_CUSTORD="./inp_data" DD_REPORT2="./report.txt" $COBCRUN_DIRECT ./prog], [0], [], []) - - -AT_CAPTURE_FILE(./report.txt) - -AT_DATA([reference], [ CUSTOMER ORDER REPORT - Time: 14:30:12 Page 1 - - CUST NUM PART # ITEMS PRICE QUANTITY TAX SHIPPING TOTAL - - 10001 090001 012 10.59 127.08 6.35 4.16 137.59 - 10001 090002 013 16.95 220.35 11.01 4.16 235.52 - 10002 090002 023 16.95 389.85 19.49 4.16 413.50 - 10002 090001 022 10.59 232.98 11.64 4.16 248.78 - 10003 090007 023 16.95 389.85 19.49 4.17 413.51 - 10003 090008 032 10.59 338.88 16.94 4.17 359.99 - 10003 090009 023 16.95 389.85 19.49 4.17 413.51 - 10003 090010 032 10.59 338.88 16.94 4.17 359.99 - 10004 090007 023 16.95 389.85 19.49 4.17 413.51 - 10004 090008 032 10.59 338.88 16.94 4.17 359.99 - 10004 090009 023 16.95 389.85 19.49 4.17 413.51 - 10004 090010 032 10.59 338.88 16.94 4.17 359.99 - 10004 090011 032 10.59 338.88 16.94 4.17 359.99 - 10004 090012 032 10.59 338.88 16.94 4.17 359.99 - 10004 090013 032 10.59 338.88 16.94 4.17 359.99 - 10004 090014 032 10.59 338.88 16.94 4.17 359.99 - 10004 090015 032 10.59 338.88 16.94 4.17 359.99 - 10005 090007 023 16.95 389.85 19.49 4.17 413.51 - 10005 090008 032 10.59 338.88 16.94 4.17 359.99 - 10005 090009 023 16.95 389.85 19.49 4.17 413.51 - 10005 090010 032 10.59 338.88 16.94 4.17 359.99 - 10005 090011 032 10.59 338.88 16.94 4.17 359.99 - 10005 090012 032 10.59 338.88 16.94 4.17 359.99 - 10005 090013 032 10.59 338.88 16.94 4.17 359.99 - 10005 090014 032 10.59 338.88 16.94 4.17 359.99 - 10005 090015 032 10.59 338.88 16.94 4.17 359.99 - 10005 090016 032 10.59 338.88 16.94 4.17 359.99 - 10005 090017 032 10.59 338.88 16.94 4.17 359.99 - 10005 090018 032 10.59 338.88 16.94 4.17 359.99 - 10006 090007 023 16.95 389.85 19.49 4.17 413.51 - 10006 090008 032 10.59 338.88 16.94 4.17 359.99 - 10006 090009 023 16.95 389.85 19.49 4.17 413.51 - 10006 090010 032 10.59 338.88 16.94 4.17 359.99 - 10006 090011 032 10.59 338.88 16.94 4.17 359.99 - 10006 090012 032 10.59 338.88 16.94 4.17 359.99 - 10006 090013 032 10.59 338.88 16.94 4.17 359.99 - 10006 090014 032 10.59 338.88 16.94 4.17 359.99 - 10006 090015 032 10.59 338.88 16.94 4.17 359.99 - 10006 090016 032 10.59 338.88 16.94 4.17 359.99 - 10006 090017 032 10.59 338.88 16.94 4.17 359.99 - 10006 090018 032 10.59 338.88 16.94 4.17 359.99 - 10006 090019 032 10.59 338.88 16.94 4.17 359.99 - 10006 090020 032 10.59 338.88 16.94 4.17 359.99 - 10007 090007 023 16.95 389.85 19.49 4.17 413.51 - 10007 090008 032 10.59 338.88 16.94 4.17 359.99 - 10007 090009 023 16.95 389.85 19.49 4.17 413.51 - 10007 090010 032 10.59 338.88 16.94 4.17 359.99 - 10007 090011 032 10.59 338.88 16.94 4.17 359.99 - 10007 090012 032 10.59 338.88 16.94 4.17 359.99 - 10007 090013 032 10.59 338.88 16.94 4.17 359.99 - - Time: 14:30:12 Page 2 - - CUST NUM PART # ITEMS PRICE QUANTITY TAX SHIPPING TOTAL - - 10007 090014 032 10.59 338.88 16.94 4.17 359.99 - 10007 090015 032 10.59 338.88 16.94 4.17 359.99 - 10007 090016 032 10.59 338.88 16.94 4.17 359.99 - 10007 090017 032 10.59 338.88 16.94 4.17 359.99 - 10007 090018 032 10.59 338.88 16.94 4.17 359.99 - 10007 090019 032 10.59 338.88 16.94 4.17 359.99 - 10007 090020 032 10.59 338.88 16.94 4.17 359.99 - 10007 090021 032 10.59 338.88 16.94 4.17 359.99 - 10007 090022 032 10.59 338.88 16.94 4.17 359.99 - 10008 090007 023 16.95 389.85 19.49 4.17 413.51 - 10008 090008 032 10.59 338.88 16.94 4.17 359.99 - 10008 090009 023 16.95 389.85 19.49 4.17 413.51 - 10008 090010 032 10.59 338.88 16.94 4.17 359.99 - 10008 090011 032 10.59 338.88 16.94 4.17 359.99 - 10008 090012 032 10.59 338.88 16.94 4.17 359.99 - 10008 090013 032 10.59 338.88 16.94 4.17 359.99 - 10008 090014 032 10.59 338.88 16.94 4.17 359.99 - 10008 090015 032 10.59 338.88 16.94 4.17 359.99 - 10008 090016 032 10.59 338.88 16.94 4.17 359.99 - 10008 090017 032 10.59 338.88 16.94 4.17 359.99 - 10008 090018 032 10.59 338.88 16.94 4.17 359.99 - 10008 090019 032 10.59 338.88 16.94 4.17 359.99 - 10008 090020 032 10.59 338.88 16.94 4.17 359.99 - 10008 090021 032 10.59 338.88 16.94 4.17 359.99 - 10008 090022 032 10.59 338.88 16.94 4.17 359.99 - 10009 090007 023 16.95 389.85 19.49 4.17 413.51 - 10009 090008 032 10.59 338.88 16.94 4.17 359.99 - 10009 090009 023 16.95 389.85 19.49 4.17 413.51 - 10009 090010 032 10.59 338.88 16.94 4.17 359.99 - 10009 090011 032 10.59 338.88 16.94 4.17 359.99 - 10009 090012 032 10.59 338.88 16.94 4.17 359.99 - 10009 090013 032 10.59 338.88 16.94 4.17 359.99 - 10009 090014 032 10.59 338.88 16.94 4.17 359.99 - 10009 090015 032 10.59 338.88 16.94 4.17 359.99 - 10009 090016 032 10.59 338.88 16.94 4.17 359.99 - 10009 090017 032 10.59 338.88 16.94 4.17 359.99 - 10009 090018 032 10.59 338.88 16.94 4.17 359.99 - 10009 090019 032 10.59 338.88 16.94 4.17 359.99 - 10009 090020 032 10.59 338.88 16.94 4.17 359.99 - 10009 090021 032 10.59 338.88 16.94 4.17 359.99 - 10009 090022 032 10.59 338.88 16.94 4.17 359.99 - - FINAL TOTALS 338.88 1,557.97 379.43 33,103.80 - - - - - - - -]) - -AT_CHECK([diff reference report.txt], [0], [], []) - -AT_CLEANUP - - -AT_SETUP([Sample Control Break]) -AT_KEYWORDS([report runfile]) - -AT_DATA([inp_data],[Norman, Ronald J 25CS Malcolm, Mike Waterloo -Dorken, Keith A 35CS Malcolm, Mike Waterloo -Norman, James J 25CS Manning, Eric Waterloo -Dorken, Kevin 35CS Manning, Eric Waterloo -Allinson, A R 25EC Manning, Eric Whistler -Norman, Michelle 27EC Manning, Donna Toronto -Dorken, Melissa 37EC Manning, Donna Toronto -Norseman, Ben01 27EC DiMetri, Gary Toronto -Norseman, Ben02 27EC DiMetri, Gary Toronto -Norseman, Ben03 27EC DiMetri, Gary Toronto -Norseman, Ben04 27EC DiMetri, Gary Toronto -Norseman, Ben05 27EC DiMetri, Gary Toronto -Norseman, Ben06 27EC DiMetri, Gary Toronto -Norseman, Ben07 27EC DiMetri, Gary Toronto -Norseman, Ben08 27EC DiMetri, Gary Toronto -Norseman, Ben09 27EC DiMetri, Gary Toronto -Norseman, Ben10 27EC DiMetri, Gary Toronto -]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - CONFIGURATION SECTION. - INPUT-OUTPUT SECTION. - FILE-CONTROL. - SELECT STUDENT-FILE ASSIGN TO EXTERNAL STUDREC - ORGANIZATION IS LINE SEQUENTIAL. - SELECT PRINT-FILE ASSIGN TO EXTERNAL - LINE ADVANCING REPORT3. - - DATA DIVISION. - FILE SECTION. - FD STUDENT-FILE. - 01 STUDENT-REC PIC X(60). - - FD PRINT-FILE - REPORT IS CONTROL-BREAK. - - WORKING-STORAGE SECTION. - 01 INDICATORS. - 05 ARE-THERE-MORE-RECORDS PIC XXX VALUE 'YES'. - 88 THERE-ARE-NO-MORE-RECORDS VALUE 'NO'. - - 01 CONSTANTS. - 05 NUM PIC 99 VALUE 1. - - 01 STUDENT-AREA. - 05 STUDENT-NAME PIC X(20). - 05 COURSE-PTS PIC 99. - 05 MAJOR PIC XXX. - 05 ADVISOR PIC X(20). - 05 CAMPUS PIC X(15). - - REPORT SECTION. - RD CONTROL-BREAK - CONTROLS ARE MAJOR ADVISOR - PAGE LIMIT 25 LINES - HEADING 1 - FIRST DETAIL 5 - FOOTING 23. - 01 TYPE IS PAGE HEADING. - 05 LINE 1. - 10 COLUMN 61 PIC X(4) VALUE 'PAGE'. - 10 COLUMN 66 PIC ZZZ9 SOURCE PAGE-COUNTER. - 05 LINE PLUS 2. - 10 COLUMN 26 PIC X(23) - VALUE 'STUDENT ADVISEMENT LIST'. - - 01 TYPE IS CONTROL HEADING MAJOR. - 05 LINE 5 ON NEXT PAGE . - 10 COLUMN 37 PIC X(5) VALUE 'MAJOR'. - 10 COLUMN 44 PIC X(20) SOURCE MAJOR. - - 05 LINE 7. - 10 COLUMN 4 PIC X(12) VALUE 'STUDENT NAME'. - 10 COLUMN 25 PIC XXX VALUE 'PTS'. - 10 COLUMN 34 PIC X(6) VALUE 'CAMPUS'. - 10 COLUMN 60 PIC X(8) VALUE 'ADVISOR'. - 05 LINE PLUS 1. - 10 COLUMN 4 PIC X(68) VALUE ALL '-'. - - 01 TRANS-LINE TYPE IS DETAIL. - 05 LINE NUMBER PLUS 1. - 10 COLUMN 3 PIC X(20) SOURCE STUDENT-NAME. - 10 COLUMN 26 PIC 99 SOURCE COURSE-PTS. - 10 COLUMN 34 PIC X(15) SOURCE CAMPUS. - 10 COLUMN 51 PIC X(5) VALUE "Hello" - PRESENT AFTER PAGE OR ADVISOR. - 10 COLUMN 51 PIC X(5) VALUE ' " ' - ABSENT AFTER PAGE OR ADVISOR. - 10 COLUMN 60 PIC X(20) SOURCE ADVISOR - GROUP INDICATE. - - 01 TYPE IS CONTROL FOOTING ADVISOR. - 05 LINE PLUS 2. - 10 COLUMN 5 PIC X(8) VALUE 'ADVISOR'. - 10 COLUMN 13 PIC X(20) SOURCE ADVISOR. - 10 COLUMN 34 PIC X(6) VALUE 'TOTAL'. - 10 ADV-TOTAL - COLUMN 40 PIC ZZ9 SUM NUM. - 05 LINE PLUS 1. - 10 COLUMN 1 PIC X(8) VALUE ' '. - - 01 TYPE IS CONTROL FOOTING MAJOR. - 05 LINE PLUS 2. - 10 COLUMN 5 PIC X(11) VALUE 'MAJOR TOTAL'. - 10 MAJ-TOTAL - COLUMN 22 PIC ZZ9 SUM ADV-TOTAL. - - 01 TYPE IS CONTROL FOOTING FINAL. - 05 LINE PLUS 3. - 10 COLUMN 10 PIC X(11) VALUE 'FINAL TOTAL'. - 10 STU-TOTAL - COLUMN 21 PIC ZZZ9 SUM MAJ-TOTAL. - - PROCEDURE DIVISION. - A000-CREATE-REPORTS. - OPEN INPUT STUDENT-FILE - OUTPUT PRINT-FILE. - INITIATE CONTROL-BREAK. - READ STUDENT-FILE INTO STUDENT-AREA - AT END - MOVE 'NO ' TO ARE-THERE-MORE-RECORDS. - PERFORM A001-LOOP - UNTIL THERE-ARE-NO-MORE-RECORDS. - TERMINATE CONTROL-BREAK. - CLOSE STUDENT-FILE - PRINT-FILE. - STOP RUN. - - A001-LOOP. - GENERATE TRANS-LINE. - READ STUDENT-FILE INTO STUDENT-AREA - AT END - MOVE 'NO ' TO ARE-THERE-MORE-RECORDS. -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) - -AT_CHECK([DD_STUDREC="./inp_data" DD_REPORT3="./report.txt" $COBCRUN_DIRECT ./prog], [0], [], []) - - -AT_CAPTURE_FILE(./report.txt) - -AT_DATA([reference], [ PAGE 1 - - STUDENT ADVISEMENT LIST - - MAJOR CS - - STUDENT NAME PTS CAMPUS ADVISOR - -------------------------------------------------------------------- - Norman, Ronald J 25 Waterloo Hello Malcolm, Mike - Dorken, Keith A 35 Waterloo " - - ADVISOR Malcolm, Mike TOTAL 2 - - Norman, James J 25 Waterloo Hello Manning, Eric - Dorken, Kevin 35 Waterloo " - - ADVISOR Manning, Eric TOTAL 2 - - - MAJOR TOTAL 4 - - - - - - PAGE 2 - - STUDENT ADVISEMENT LIST - - MAJOR EC - - STUDENT NAME PTS CAMPUS ADVISOR - -------------------------------------------------------------------- - Allinson, A R 25 Whistler Hello Manning, Eric - - ADVISOR Manning, Eric TOTAL 1 - - Norman, Michelle 27 Toronto Hello Manning, Donna - Dorken, Melissa 37 Toronto " - - ADVISOR Manning, Donna TOTAL 2 - - Norseman, Ben01 27 Toronto Hello DiMetri, Gary - Norseman, Ben02 27 Toronto " - Norseman, Ben03 27 Toronto " - Norseman, Ben04 27 Toronto " - Norseman, Ben05 27 Toronto " - Norseman, Ben06 27 Toronto " - - PAGE 3 - - STUDENT ADVISEMENT LIST - - Norseman, Ben07 27 Toronto Hello DiMetri, Gary - Norseman, Ben08 27 Toronto " - Norseman, Ben09 27 Toronto " - Norseman, Ben10 27 Toronto " - - ADVISOR DiMetri, Gary TOTAL 10 - - - MAJOR TOTAL 13 - - - FINAL TOTAL 17 - - - - - - - - - -]) -#" <- fix code highlighting -AT_CHECK([diff reference report.txt], [0], [], []) - -AT_CLEANUP - -AT_SETUP([Sample Inventory Report]) -AT_KEYWORDS([report runfile]) - -AT_DATA([inp_data],[01Data Processing 02000500012388 -02Cow Milking 02000600054398 -03Grass Cutting 03000600054397 -03Lawn mowing 03000600054397 -]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - CONFIGURATION SECTION. - INPUT-OUTPUT SECTION. - FILE-CONTROL. - SELECT INV-FILE ASSIGN TO EXTERNAL INVFILE - ORGANIZATION IS LINE SEQUENTIAL. - SELECT REPORT-FILE ASSIGN TO EXTERNAL - LINE ADVANCING REPORT4. - - DATA DIVISION. - FILE SECTION. - FD INV-FILE. - 01 INV-REC. - 05 DEPT-IN PIC 99. - 05 DEPT-NAM-IN PIC X(18). - 05 MONTH-IN PIC 99. - 05 ITEM-NO-IN PIC 9(5). - 05 INV-TOT-IN PIC 9(6)V99. - - FD REPORT-FILE - REPORT IS INV-REPORT. - - WORKING-STORAGE SECTION. - 01 INDICATORS. - 05 ARE-THERE-MORE-RECORDS PIC XXX VALUE 'YES'. - - REPORT SECTION. - RD INV-REPORT - CONTROLS ARE FINAL DEPT-IN MONTH-IN - PAGE LIMIT 25 LINES - HEADING 2 - FIRST DETAIL 5 - LAST DETAIL 18 - FOOTING 20. - 01 TYPE IS REPORT HEADING. - 05 LINE 2 COLUMN 50 PIC X(16) VALUE 'INVENTORY REPORT'. - 05 LINE 2 COLUMN 80 PIC X VALUE ' '. - - 01 TYPE IS CONTROL HEADING DEPT-IN - LINE NUMBER IS PLUS 2 - NEXT GROUP IS PLUS 2. - 05 COLUMN 2 PIC X(13) VALUE 'DEPARTMENT #:'. - 05 COLUMN 27 PIC 99 SOURCE DEPT-IN. - 05 COLUMN 31 PIC X(16) VALUE 'DEPARTMENT NAME:'. - 05 COLUMN 50 PIC X(18) SOURCE DEPT-NAM-IN. - - 01 INV-DETAIL TYPE IS DETAIL - LINE PLUS 2. - 05 COLUMN 10 PIC 99 SOURCE MONTH-IN GROUP INDICATE. - 05 COLUMN 25 PIC 9(5) SOURCE ITEM-NO-IN. - 05 COLUMN 40 PIC ZZZ,ZZZ.99 SOURCE IS INV-TOT-IN. - - 01 TYPE IS CONTROL FOOTING MONTH-IN - LINE PLUS 2. - 05 MONTH-TOTAL COLUMN 55 PIC Z,ZZZ,ZZZ.99 SUM INV-TOT-IN. - - 01 TYPE IS CONTROL FOOTING DEPT-IN - LINE PLUS 2. - 05 DEPT-TOTAL COLUMN 75 PIC ZZ,ZZZ,ZZZ.99 SUM MONTH-TOTAL. - - 01 TYPE IS CONTROL FOOTING FINAL - LINE PLUS 2. - 05 FINAL-TOTAL COLUMN 95 PIC ZZZ,ZZZ,ZZZ.99 SUM DEPT-TOTAL. - - 01 TYPE IS PAGE FOOTING LINE 24. - 05 COLUMN 30 PIC X(30) VALUE "-+* End of Page *+-". - 05 COLUMN 55 PIC X(12) VALUE "************". - 05 COLUMN 75 PIC X(13) VALUE "*************". - 05 COLUMN 95 PIC X(14) VALUE "**************". - - PROCEDURE DIVISION. - A000-MAINLINE. - OPEN INPUT INV-FILE - OUTPUT REPORT-FILE. - INITIATE INV-REPORT. - READ INV-FILE - AT END - MOVE 'NO ' TO ARE-THERE-MORE-RECORDS. - PERFORM A001-LOOP - UNTIL ARE-THERE-MORE-RECORDS = 'NO '. - TERMINATE INV-REPORT. - CLOSE INV-FILE - REPORT-FILE. - STOP RUN. - A001-LOOP. - GENERATE INV-DETAIL. - READ INV-FILE - AT END - MOVE 'NO ' TO ARE-THERE-MORE-RECORDS. - -]) - -AT_CHECK([$COMPILE -std=cobol2002 -fassign-ext-dyn=ok prog.cob ], [0], [], -[prog.cob:40: warning: duplicate LINE 2 ignored -]) - -AT_CHECK([DD_INVFILE="./inp_data" DD_REPORT4="./report.txt" $COBCRUN_DIRECT ./prog], [0], [], []) - - -AT_CAPTURE_FILE(./report.txt) - -AT_DATA([reference], [ - INVENTORY REPORT - - - DEPARTMENT #: 01 DEPARTMENT NAME: Data Processing - - - - 02 00050 1,238.80 - - 1,238.80 - - 1,238.80 - - DEPARTMENT #: 02 DEPARTMENT NAME: Cow Milking - - - - - - - - - -+* End of Page *+- ************ ************* ************** - - - - - 02 00060 5,439.80 - - 5,439.80 - - 5,439.80 - - DEPARTMENT #: 03 DEPARTMENT NAME: Grass Cutting - - - - 03 00060 5,439.70 - - 00060 5,439.70 - - 10,879.40 - - - - - - -+* End of Page *+- ************ ************* ************** - - - - - 10,879.40 - - 17,558.00 - - - - - - - - - - - - - - - - - -+* End of Page *+- ************ ************* ************** -]) - -AT_CHECK([diff reference report.txt], [0], [], []) - -AT_CLEANUP - - -AT_SETUP([Duplicate Detail Line]) -AT_KEYWORDS([report runfile]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - CONFIGURATION SECTION. - INPUT-OUTPUT SECTION. - FILE-CONTROL. - SELECT REPORT-FILE - LINE SEQUENTIAL - ASSIGN TO EXTERNAL DUPDTL. - DATA DIVISION. - FILE SECTION. - FD REPORT-FILE - REPORT IS MYREPORT. - WORKING-STORAGE SECTION. - 01 SAVE-ITEM PIC X. - - REPORT SECTION. - RD MYREPORT - CONTROLS ARE SAVE-ITEM - PAGE LIMIT IS 15 LINES - FIRST DETAIL 1 - LAST DETAIL 12. - - 01 TYPE IS CONTROL HEADING SAVE-ITEM. - 05 LINE NUMBER IS 1. - 10 COLUMN 1 PIC X(20) VALUE "HEADING SAVE-ITEM". - - 01 DETAIL-LINE TYPE IS DETAIL. - 05 LINE NUMBER PLUS 1. - 10 COLUMN 1 PIC X SOURCE SAVE-ITEM. - 10 COLUMN 10 PIC X(15) VALUE "1st Detail". - - 01 SND-DETAIL-LINE TYPE IS DETAIL. - 05 LINE NUMBER PLUS 1. - 10 COLUMN 1 PIC X SOURCE SAVE-ITEM. - 10 COLUMN 10 PIC X(15) VALUE "2nd Detail". - - 01 TRD-DETAIL-LINE TYPE IS DETAIL. - 05 LINE NUMBER PLUS 1. - 10 COLUMN 1 PIC X SOURCE SAVE-ITEM. - 10 COLUMN 10 PIC X(15) VALUE "3rd Detail 1". - 05 LINE NUMBER PLUS 1. - 10 COLUMN 1 PIC X SOURCE SAVE-ITEM. - 10 COLUMN 10 PIC X(15) VALUE "3rd Detail 2". - - 01 TYPE IS CONTROL FOOTING SAVE-ITEM. - 03 LINE NUMBER IS PLUS 1. - 05 COLUMN 07 PIC X(27) VALUE "FOOTING SAVE-ITEM". - - PROCEDURE DIVISION. - OPEN OUTPUT REPORT-FILE. - INITIATE MYREPORT. - MOVE "A" TO SAVE-ITEM. - GENERATE DETAIL-LINE. - MOVE "B" TO SAVE-ITEM. - GENERATE DETAIL-LINE. - GENERATE SND-DETAIL-LINE. - GENERATE TRD-DETAIL-LINE. - MOVE "C" TO SAVE-ITEM. - GENERATE TRD-DETAIL-LINE. - TERMINATE MYREPORT. - CLOSE REPORT-FILE. - STOP RUN. -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) - -AT_CHECK([DD_DUPDTL=./report.txt $COBCRUN_DIRECT ./prog], [0], [], []) - - -AT_CAPTURE_FILE(./report.txt) - -AT_DATA([reference], [HEADING SAVE-ITEM -A 1st Detail - FOOTING SAVE-ITEM - - - - - - - - - - - - -HEADING SAVE-ITEM -B 1st Detail -B 2nd Detail -B 3rd Detail 1 -B 3rd Detail 2 - FOOTING SAVE-ITEM - - - - - - - - - -HEADING SAVE-ITEM -C 3rd Detail 1 -C 3rd Detail 2 - FOOTING SAVE-ITEM - - - - - - - - - - - -]) - -AT_CHECK([diff reference report.txt], [0], [], []) - -AT_CLEANUP - - -AT_SETUP([Report with OCCURS]) -AT_KEYWORDS([report runfile]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - - ENVIRONMENT DIVISION. - INPUT-OUTPUT SECTION. - FILE-CONTROL. - SELECT rp-file ASSIGN EXTERNAL PRINTOUT - ORGANIZATION LINE SEQUENTIAL. - - DATA DIVISION. - FILE SECTION. - FD rp-file REPORT rp. - - REPORT SECTION. - RD RP - PAGE LIMIT 10 LINES - HEADING 1 - FIRST DETAIL 4. - 01 HEADING-LINE. - 02 TYPE PAGE HEADING LINE PLUS 1. - 05 COLUMN 1 PIC X(50) VALUE - " 1 2 3 4 5". - 02 TYPE PAGE HEADING LINE PLUS 1. - 05 COLUMN 1 PIC X(50) VALUE - "12345678901234567890123456789012345678901234567890". - - 01 RP-DTL1 TYPE DETAIL, LINE + 1. - 03 NUMS COLUMN 1 PIC 999 OCCURS 3 TIMES STEP 10. - 03 MARK COLUMN +3 PIC X(4). - - 01 rp-dtl2 TYPE DETAIL, LINE + 1. - 03 grps COLUMN 1 OCCURS 3 TIMES. - 05 tag1 PIC X(5). - 05 FILLER PIC X. - 05 tag2 PIC X(5). - 05 FILLER PIC XX. - - 01 RP-DTL3 TYPE DETAIL, LINE + 1. - 03 NNNS COLUMN 1, 11, 21, 27 PIC 999. - 03 TAGP COLUMN PLUS 4 PIC X(4). - - 01 RP-DTL4 TYPE DETAIL, LINE + 1. - 03 NUM4A PIC 999. - 03 NUM4B COLUMN PLUS 8 PIC 999 OCCURS 3 STEP 10. - 03 MRK4 COLUMN + 3 PIC X(4). - - PROCEDURE DIVISION. - OPEN OUTPUT rp-file - INITIATE rp - - MOVE 100 TO NUMS (1), NUMS (2), NUMS (3) - MOVE "<1>" TO MARK. - GENERATE rp-dtl1 - - MOVE ALL '*' TO grps(1), grps(2), grps(3) - MOVE "Tag1" to tag1 (1), tag1 (2), tag1 (3) - MOVE "Tag2" to tag2 (1), tag2 (2), tag2 (3) - GENERATE rp-dtl2 - - MOVE 200 TO NNNS (1), NNNS (2), NNNS (3) NNNS (4) - MOVE "<3>" TO TAGP. - GENERATE RP-DTL3. - - MOVE 400 TO NUM4A - MOVE 401 TO NUM4B (1) - MOVE 402 TO NUM4B (2) - MOVE 403 TO NUM4B (3) - MOVE "<4>" TO MRK4. - GENERATE RP-DTL4 - - TERMINATE rp - CLOSE rp-file - - STOP RUN. - END PROGRAM prog. -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) - -AT_CHECK([DD_PRINTOUT=./report.txt $COBCRUN_DIRECT ./prog], [0], [], []) - - -AT_CAPTURE_FILE(./report.txt) - -AT_DATA([reference], [ 1 2 3 4 5 -12345678901234567890123456789012345678901234567890 - -100 100 100 <1> -Tag1 *Tag2 **Tag1 *Tag2 **Tag1 *Tag2 ** -200 200 200 200 <3> -400 401 402 403 <4> - - - -]) - -AT_CHECK([diff reference report.txt], [0]) - -AT_CLEANUP - - -AT_SETUP([Report CODE and LIMIT COLUMNS]) -AT_KEYWORDS([report runfile]) - -AT_DATA([progv.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. progv. - - ENVIRONMENT DIVISION. - INPUT-OUTPUT SECTION. - FILE-CONTROL. - SELECT RP-FILE ASSIGN EXTERNAL PRINTOUT - ORGANIZATION LINE SEQUENTIAL. - - DATA DIVISION. - FILE SECTION. - FD RP-FILE REPORT RP. - - WORKING-STORAGE SECTION. - 01 IDX1 PIC 99 VALUE 1. - 01 MAXCOL PIC 99 VALUE 50. - 01 MYCODE PIC X(6) VALUE "Hi-Q:". - 01 DIGX PIC X(50) VALUE - "123456789b123456789c123456789d123456789e123456789f". - 01 FILLER REDEFINES DIGX. - 05 DIGS PIC X(10) OCCURS 5 TIMES. - - REPORT SECTION. - RD RP - CODE IS MYCODE *> variable - PAGE LIMIT 10 LINES - MAXCOL COLUMNS *> variable - HEADING 1 - FIRST DETAIL 4. - 01 HEADING-LINE. - 02 TYPE PAGE HEADING LINE PLUS 1. - 05 COLUMN 1 PIC X(50) VALUE - " 1 2 3 4 5". - 02 TYPE PAGE HEADING LINE PLUS 1. - * 05 COLUMN 1 PIC X(50) VALUE - * "12345678901234567890123456789012345678901234567890". - 05 COLUMN 1 OCCURS 5 TIMES - VARYING IDX1 FROM 1 BY 1. - 10 FILLER PIC X(10) SOURCE DIGS (IDX1). - - 01 RP-DTL1 TYPE DETAIL, LINE + 1. - 03 NUMS COLUMN 1 PIC 999 OCCURS 3 TIMES STEP 10. - 03 MARK COLUMN + 3 PIC X(4). - - 01 RP-DTL2 TYPE DETAIL, LINE + 1. - 03 GRPS COLUMN 1 OCCURS 3 TIMES. - 05 TAG1 PIC X(5). - 05 FILLER PIC X. - 05 TAG2 PIC X(5). - 05 FILLER PIC XX. - - 01 RP-DTL3 TYPE DETAIL, LINE + 1. - 03 NNNS COLUMN 1, 11, 21, 27 PIC 999. - 03 TAGP COLUMN PLUS 4 PIC X(4). - - 01 RP-DTL4 TYPE DETAIL, LINE + 1. - 03 NUM4A PIC 999. - 03 NUM4B COLUMN 11 PIC 999 OCCURS 3 STEP 10. - 03 MRK4 COLUMN + 3 PIC X(4). - - PROCEDURE DIVISION. - OPEN OUTPUT RP-FILE - INITIATE RP - - MOVE 100 TO NUMS (1), NUMS (2), NUMS (3) - MOVE "<1>" TO MARK. - GENERATE rp-dtl1 - - MOVE ALL '*' TO GRPS(1), GRPS(2), GRPS(3) - MOVE "Tag1" TO TAG1 (1), TAG1 (2), TAG1 (3) - MOVE "Tag2" TO TAG2 (1), TAG2 (2), TAG2 (3) - GENERATE RP-DTL2 - - MOVE 200 TO NNNS (1), NNNS (2), NNNS (3) NNNS (4) - MOVE "<3>" TO TAGP. - GENERATE RP-DTL3. - - MOVE 400 TO NUM4A - MOVE 401 TO NUM4B (1) - MOVE 402 TO NUM4B (2) - MOVE 403 TO NUM4B (3) - MOVE "<4>" TO MRK4. - GENERATE RP-DTL4 - - TERMINATE rp - CLOSE RP-FILE - - STOP RUN. -]) - -AT_CHECK([$COMPILE -std=cobol2002 -fassign-ext-dyn=ok progv.cob], [0], [], -[progv.cob:39: warning: RW VARYING clause is not implemented -]) - -AT_CHECK([DD_PRINTOUT=./report_var.txt \ -$COBCRUN_DIRECT ./progv], [0], [], []) - -AT_DATA([progl.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. progl. - - ENVIRONMENT DIVISION. - INPUT-OUTPUT SECTION. - FILE-CONTROL. - SELECT RP-FILE ASSIGN EXTERNAL PRINTOUT - ORGANIZATION LINE SEQUENTIAL. - - DATA DIVISION. - FILE SECTION. - FD RP-FILE REPORT RP. - - WORKING-STORAGE SECTION. - 01 IDX1 PIC 99 VALUE 1. - 01 DIGX PIC X(50) VALUE - "123456789b123456789c123456789d123456789e123456789f". - 01 FILLER REDEFINES DIGX. - 05 DIGS PIC X(10) OCCURS 5 TIMES. - - REPORT SECTION. - RD RP - CODE IS "Hi-Q: " *> literal - PAGE LIMIT 10 LINES - 50 COLUMNS *> literal - HEADING 1 - FIRST DETAIL 4. - 01 HEADING-LINE. - 02 TYPE PAGE HEADING LINE PLUS 1. - 05 COLUMN 1 PIC X(50) VALUE - " 1 2 3 4 5". - 02 TYPE PAGE HEADING LINE PLUS 1. - * 05 COLUMN 1 PIC X(50) VALUE - * "12345678901234567890123456789012345678901234567890". - 05 COLUMN 1 OCCURS 5 TIMES - VARYING IDX1 FROM 1 BY 1. - 10 FILLER PIC X(10) SOURCE DIGS (IDX1). - - 01 RP-DTL1 TYPE DETAIL, LINE + 1. - 03 NUMS COLUMN 1 PIC 999 OCCURS 3 TIMES STEP 10. - 03 MARK COLUMN + 3 PIC X(4). - - 01 RP-DTL2 TYPE DETAIL, LINE + 1. - 03 GRPS COLUMN 1 OCCURS 3 TIMES. - 05 TAG1 PIC X(5). - 05 FILLER PIC X. - 05 TAG2 PIC X(5). - 05 FILLER PIC XX. - - 01 RP-DTL3 TYPE DETAIL, LINE + 1. - 03 NNNS COLUMN 1, 11, 21, 27 PIC 999. - 03 TAGP COLUMN PLUS 4 PIC X(4). - - 01 RP-DTL4 TYPE DETAIL, LINE + 1. - 03 NUM4A PIC 999. - 03 NUM4B COLUMN 11 PIC 999 OCCURS 3 STEP 10. - 03 MRK4 COLUMN + 3 PIC X(4). - - PROCEDURE DIVISION. - OPEN OUTPUT RP-FILE - INITIATE RP - - MOVE 100 TO NUMS (1), NUMS (2), NUMS (3) - MOVE "<1>" TO MARK. - GENERATE rp-dtl1 - - MOVE ALL '*' TO GRPS(1), GRPS(2), GRPS(3) - MOVE "Tag1" TO TAG1 (1), TAG1 (2), TAG1 (3) - MOVE "Tag2" TO TAG2 (1), TAG2 (2), TAG2 (3) - GENERATE RP-DTL2 - - MOVE 200 TO NNNS (1), NNNS (2), NNNS (3) NNNS (4) - MOVE "<3>" TO TAGP. - GENERATE RP-DTL3. - - MOVE 400 TO NUM4A - MOVE 401 TO NUM4B (1) - MOVE 402 TO NUM4B (2) - MOVE 403 TO NUM4B (3) - MOVE "<4>" TO MRK4. - GENERATE RP-DTL4 - - TERMINATE rp - CLOSE RP-FILE - - STOP RUN. -]) - -AT_CHECK([$COMPILE -std=cobol2002 -fdump=all -fassign-ext-dyn=ok progl.cob], [0], [], -[progl.cob:37: warning: RW VARYING clause is not implemented -]) - -AT_CHECK([DD_PRINTOUT=./report_lit.txt \ -$COBCRUN_DIRECT ./progl], [0], [], []) - - -AT_CAPTURE_FILE(./report_var.txt) -AT_CAPTURE_FILE(./report_lit.txt) - -AT_DATA([reference.at], -[Hi-Q: 1 2 3 4 5 -Hi-Q: 1 2 3 4 5 -Hi-Q: _ -Hi-Q: 100 100 100 <1> -Hi-Q: Tag1 *Tag2 **Tag1 *Tag2 **Tag1 *Tag2 ** -Hi-Q: 200 200 200 200 <3> -Hi-Q: 400 401 402 403 <4> -Hi-Q: _ -Hi-Q: _ -Hi-Q: _ -]) - -AT_CHECK([cat reference.at | tr -d _ > reference], [0]) -AT_CHECK([diff reference report_var.txt], [0]) -AT_CHECK([diff reference report_lit.txt], [0]) - -AT_CLEANUP - - -AT_SETUP([Duplicate INITIATE]) -AT_KEYWORDS([report runfile]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - - ENVIRONMENT DIVISION. - INPUT-OUTPUT SECTION. - FILE-CONTROL. - SELECT report-file ASSIGN EXTERNAL PRINTOUT - ORGANIZATION LINE SEQUENTIAL. - - DATA DIVISION. - FILE SECTION. - FD report-file REPORT rp. - - WORKING-STORAGE SECTION. - 01 foo PIC X(20). - 01 hedpos PIC 99 VALUE 10. - - REPORT SECTION. - RD rp PAGE LIMIT 3. - - 01 rp-detail TYPE DE. - 02 LINE + 1. - 03 COL 1; SOURCE foo, PIC X(30). - 03 COL +2 PIC X(6) VALUE "<--->". - - PROCEDURE DIVISION. - OPEN OUTPUT report-file. - INITIATE rp. - - MOVE "hello" TO foo. - GENERATE rp-detail. - - INITIATE rp. - - MOVE "goodbye" TO foo. - GENERATE rp-detail. - - TERMINATE rp. - CLOSE report-file. - STOP RUN. - END PROGRAM prog. -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) - -AT_CHECK([DD_PRINTOUT=./report.txt $COBCRUN_DIRECT ./prog], [0], [], -[libcob: prog.cob:34: error: INITIATE rp was already done -]) - - -AT_CAPTURE_FILE(./report.txt) - -AT_DATA([reference], [hello <---> -goodbye <---> - -]) - -AT_CHECK([diff reference report.txt], [0]) - -AT_CLEANUP - - -AT_SETUP([Missing INITIATE and GENERATE]) -AT_KEYWORDS([report runfile]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - - ENVIRONMENT DIVISION. - INPUT-OUTPUT SECTION. - FILE-CONTROL. - SELECT report-file ASSIGN EXTERNAL PRINTOUT - ORGANIZATION LINE SEQUENTIAL. - - DATA DIVISION. - FILE SECTION. - FD report-file REPORT rp. - - WORKING-STORAGE SECTION. - 01 foo PIC X(20). - 01 hedpos PIC 99 VALUE 10. - - REPORT SECTION. - RD rp PAGE LIMIT 3. - - 01 rp-detail TYPE DE. - 02 LINE + 1. - 03 COL 1; SOURCE foo, PIC X(30). - 03 COL +2 PIC X(6) VALUE "<--->". - - PROCEDURE DIVISION. - OPEN OUTPUT report-file. - - MOVE "hello" TO foo. - GENERATE rp-detail. - - MOVE "goodbye" TO foo. - GENERATE rp-detail. - - TERMINATE rp. - CLOSE report-file. - STOP RUN. -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) - -AT_CHECK([DD_PRINTOUT=./report.txt $COBCRUN_DIRECT ./prog], [1], [], -[libcob: prog.cob:31: error: GENERATE rp but no INITIATE was done -libcob: prog.cob:31: warning: implicit CLOSE of report-file ('PRINTOUT') -]) - - -AT_CAPTURE_FILE(./report.txt) - -AT_DATA([reference], []) - -AT_CHECK([diff reference report.txt], [0]) - -AT_CLEANUP - - -AT_SETUP([Missing INITIATE and TERMINATE]) -AT_KEYWORDS([report runfile]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - - ENVIRONMENT DIVISION. - INPUT-OUTPUT SECTION. - FILE-CONTROL. - SELECT report-file ASSIGN EXTERNAL PRINTOUT - ORGANIZATION LINE SEQUENTIAL. - - DATA DIVISION. - FILE SECTION. - FD report-file REPORT rp. - - WORKING-STORAGE SECTION. - 01 foo PIC X(20). - 01 hedpos PIC 99 VALUE 10. - - REPORT SECTION. - RD rp PAGE LIMIT 3. - - 01 rp-detail TYPE DE. - 02 LINE + 1. - 03 COL 1; SOURCE foo, PIC X(30). - 03 COL + 2 PIC X(6) VALUE "<--->". - - PROCEDURE DIVISION. - OPEN OUTPUT report-file. - - TERMINATE rp. - CLOSE report-file. - STOP RUN. -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) - -AT_CHECK([DD_PRINTOUT=./report.txt $COBCRUN_DIRECT ./prog], [1], [], -[libcob: prog.cob:30: error: TERMINATE rp but no INITIATE was done -libcob: prog.cob:30: warning: implicit CLOSE of report-file ('PRINTOUT') -]) - - -AT_CAPTURE_FILE(./report.txt) - -AT_DATA([reference], []) - -AT_CHECK([diff reference report.txt], [0]) - -AT_CLEANUP - - -AT_SETUP([Next Group Next Page]) -AT_KEYWORDS([report runfile]) - -AT_DATA([inp_data],[MW1000051IN15021220150212OR150212043ITEM_NUMBER_22 0000002800002999 -MW1000051IN15022220150222OR150226020ITEM_NUMBER_06 0000004300000999 -MW1000071IN15021420150214OR150212057ITEM_NUMBER_51 0000007000005999 -MW1000071IN15022820150228OR150225098ITEM_NUMBER_92 0000001400009999 -MW1000201IN15020920150209OR150216083ITEM_NUMBER_77 0000007700007999 -MW1000201IN15022720150227OR150223079ITEM_NUMBER_20 0000009600002999 -MW1000291IN15021720150217OR150218088ITEM_NUMBER_86 0000001900008999 -MW1000411IN15022320150223OR150210063ITEM_NUMBER_66 0000008800006999 -MW1000451IN15021720150217OR150202053ITEM_NUMBER_60 0000005100006999 -MW1000471IN15022420150224OR150201036ITEM_NUMBER_45 0000003800004999 -MW1000831IN15021020150210OR150227042ITEM_NUMBER_70 0000007200007999 -MW1000831IN15021420150214OR150228090ITEM_NUMBER_07 0000002300000999 -MW1000831IN15022020150220OR150226048ITEM_NUMBER_61 0000005900006999 -MW1000891IN15022120150221OR150219018ITEM_NUMBER_72 0000007300007999 -MW1000891IN15022320150223OR150227069ITEM_NUMBER_73 0000007400007999 -NE1000001IN15021020150210OR150217060ITEM_NUMBER_38 0000009800003999 -NE1000201IN15021920150219OR150209035ITEM_NUMBER_94 0000009600009999 -NE1000431IN15021520150215OR150227047ITEM_NUMBER_64 0000008700006999 -NE1000431IN15022220150222OR150213062ITEM_NUMBER_97 0000007300009999 -NE1000451IN15020320150203OR150213087ITEM_NUMBER_85 0000005300008999 -NE1000471IN15022120150221OR150222034ITEM_NUMBER_74 0000008400007999 -NE1000471IN15022120150221OR150225077ITEM_NUMBER_78 0000002400007999 -NE1000491IN15021720150217OR150210037ITEM_NUMBER_17 0000000700001999 -NE1000601IN15021520150215OR150211070ITEM_NUMBER_06 0000004400000999 -NE1000631IN15022720150227OR150209051ITEM_NUMBER_09 0000005400000999 -NE1000671IN15020620150206OR150220045ITEM_NUMBER_56 0000006600005999 -NE1000811IN15022020150220OR150212086ITEM_NUMBER_27 0000001700002999 -NE1000811IN15022820150228OR150222075ITEM_NUMBER_66 0000008600006999 -NE1000831IN15021620150216OR150224004ITEM_NUMBER_52 0000004200005999 -NW1000001IN15022420150224OR150215029ITEM_NUMBER_79 0000003500007999 -NW1000011IN15022820150228OR150209023ITEM_NUMBER_62 0000009800006999 -NW1000051IN15021020150210OR150225076ITEM_NUMBER_50 0000003900005999 -NW1000051IN15021820150218OR150229093ITEM_NUMBER_94 0000003700009999 -NW1000051IN15022020150220OR150221050ITEM_NUMBER_89 0000003800008999 -NW1000071IN15020220150202OR150223014ITEM_NUMBER_54 0000004800005999 -NW1000091IN15020820150208OR150229094ITEM_NUMBER_17 0000007200001999 -NW1000091IN15021220150212OR150222096ITEM_NUMBER_89 0000004900008999 -NW1000091IN15022420150224OR150211074ITEM_NUMBER_90 0000004300009999 -NW1000091IN15022720150227OR150219030ITEM_NUMBER_12 0000001900001999 -NW1000201IN15020820150208OR150210061ITEM_NUMBER_34 0000001200003999 -NW1000231IN15021420150214OR150210044ITEM_NUMBER_89 0000005400008999 -NW1000251IN15021220150212OR150204059ITEM_NUMBER_39 0000006000003999 -NW1000401IN15021520150215OR150222049ITEM_NUMBER_40 0000008100004999 -NW1000401IN15021720150217OR150203085ITEM_NUMBER_77 0000003700007999 -NW1000411IN15020720150207OR150224056ITEM_NUMBER_99 0000005400009999 -NW1000411IN15022820150228OR150221008ITEM_NUMBER_68 0000009000006999 -NW1000491IN15022820150228OR150201002ITEM_NUMBER_47 0000008600004999 -NW1000611IN15022720150227OR150224097ITEM_NUMBER_11 0000008000001999 -NW1000631IN15020720150207OR150206031ITEM_NUMBER_49 0000001500004999 -NW1000631IN15021420150214OR150210054ITEM_NUMBER_40 0000004200004999 -NW1000631IN15022420150224OR150218024ITEM_NUMBER_84 0000003300008999 -NW1000651IN15020620150206OR150225099ITEM_NUMBER_57 0000004300005999 -NW1000671IN15021320150213OR150224041ITEM_NUMBER_22 0000000200002999 -NW1000691IN15020420150204OR150211092ITEM_NUMBER_13 0000009400001999 -NW1000811IN15022720150227OR150217081ITEM_NUMBER_45 0000001600004999 -NW1000851IN15020820150208OR150203091ITEM_NUMBER_63 0000006600006999 -NW1000871IN15021820150218OR150209082ITEM_NUMBER_30 0000005500003999 -NW1000871IN15022820150228OR150222015ITEM_NUMBER_73 0000005100007999 -NW1000891IN15022520150225OR150201026ITEM_NUMBER_80 0000004700008999 -SE1000001IN15022320150223OR150203064ITEM_NUMBER_03 0000007100000999 -SE1000011IN15020120150201OR150213017ITEM_NUMBER_09 0000000600000999 -SE1000011IN15021220150212OR150209066ITEM_NUMBER_06 0000004000000999 -SE1000091IN15020420150204OR150201001ITEM_NUMBER_68 0000001900006999 -SE1000091IN15021020150210OR150223084ITEM_NUMBER_11 0000009300001999 -SE1000091IN15022620150226OR150219038ITEM_NUMBER_97 0000003700009999 -SE1000211IN15020620150206OR150221089ITEM_NUMBER_05 0000004500000999 -SE1000411IN15021220150212OR150208012ITEM_NUMBER_46 0000002300004999 -SE1000431IN15020720150207OR150214072ITEM_NUMBER_25 0000004600002999 -SE1000431IN15022520150225OR150220040ITEM_NUMBER_01 0000006100000999 -SE1000451IN15021420150214OR150204022ITEM_NUMBER_34 0000004700003999 -SE1000471IN15020320150203OR150217010ITEM_NUMBER_25 0000003400002999 -SE1000471IN15021120150211OR150213025ITEM_NUMBER_54 0000009200005999 -SE1000491IN15020220150202OR150202013ITEM_NUMBER_19 0000007800001999 -SE1000601IN15022420150224OR150210039ITEM_NUMBER_19 0000005600001999 -SE1000631IN15020120150201OR150216003ITEM_NUMBER_65 0000001100006999 -SE1000671IN15020320150203OR150205071ITEM_NUMBER_64 0000009400006999 -SE1000671IN15022020150220OR150214032ITEM_NUMBER_53 0000005900005999 -SE1000891IN15022620150226OR150229068ITEM_NUMBER_75 0000008400007999 -SW1000011IN15020220150202OR150206000ITEM_NUMBER_30 0000005900003999 -SW1000031IN15020320150203OR150214033ITEM_NUMBER_09 0000006000000999 -SW1000031IN15020620150206OR150206021ITEM_NUMBER_91 0000005400009999 -SW1000091IN15022320150223OR150221028ITEM_NUMBER_67 0000003900006999 -SW1000201IN15020920150209OR150205065ITEM_NUMBER_21 0000007000002999 -SW1000201IN15022520150225OR150203052ITEM_NUMBER_55 0000007500005999 -SW1000201IN15022520150225OR150210067ITEM_NUMBER_83 0000001500008999 -SW1000211IN15020220150202OR150221055ITEM_NUMBER_16 0000001300001999 -SW1000211IN15020820150208OR150215007ITEM_NUMBER_97 0000008900009999 -SW1000271IN15021120150211OR150228080ITEM_NUMBER_45 0000005200004999 -SW1000271IN15021320150213OR150207095ITEM_NUMBER_09 0000005400000999 -SW1000401IN15022820150228OR150202027ITEM_NUMBER_83 0000000100008999 -SW1000411IN15021020150210OR150220073ITEM_NUMBER_63 0000001400006999 -SW1000431IN15020820150208OR150227078ITEM_NUMBER_23 0000005200002999 -SW1000431IN15022020150220OR150227006ITEM_NUMBER_50 0000008500005999 -SW1000601IN15020620150206OR150201011ITEM_NUMBER_73 0000008400007999 -SW1000611IN15020620150206OR150218019ITEM_NUMBER_67 0000006100006999 -SW1000651IN15020920150209OR150224009ITEM_NUMBER_23 0000001800002999 -SW1000831IN15020120150201OR150221046ITEM_NUMBER_44 0000006900004999 -SW1000831IN15022020150220OR150213005ITEM_NUMBER_44 0000003700004999 -SW1000831IN15022220150222OR150213058ITEM_NUMBER_86 0000008300008999 -SW1000871IN15020220150202OR150216016ITEM_NUMBER_62 0000008300006999 -]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - *AUTHOR. Gerard Robinson. - *DATE-WRITTEN. February 25, 2015. - - ENVIRONMENT DIVISION. - - INPUT-OUTPUT SECTION. - - FILE-CONTROL. - - SELECT REPORT-FILE - ASSIGN TO EXTERNAL REPORTFILE - ORGANIZATION IS LINE SEQUENTIAL. - - SELECT TEMP-FILE - ASSIGN TO EXTERNAL TEMPFILE - ORGANIZATION IS LINE SEQUENTIAL. - - DATA DIVISION. - - FILE SECTION. - - FD REPORT-FILE - REPORT IS RPTA. - - FD TEMP-FILE. - - 01 TEMP-REC. - 03 TEMP-REGION PIC X(2). - 03 TEMP-BRANCH PIC X(7). - 03 TEMP-INVOICE PIC X(8). - 03 TEMP-DATE PIC X(8). - 03 TEMP-ORDER PIC X(8). - 03 TEMP-LINE-NO PIC X(3). - 03 TEMP-ITEM PIC X(20). - 03 TEMP-TX-QTY PIC S9(8). - 03 TEMP-COST PIC 999999V99. - - WORKING-STORAGE SECTION. - - 01 WS-CURRENT-DATE PIC X(23). - - 01 WS-SYSTEM-DATE-R REDEFINES WS-CURRENT-DATE. - 05 WS-DATE-YYYY PIC X(4). - 05 WS-DATE-MM PIC X(2). - 05 WS-DATE-DD PIC X(2). - 05 WS-TIME PIC X(6). - 05 WS-REST PIC X(9). - - 01 TEMP-FILE-EOF PIC 9 VALUE 0. - - REPORT SECTION. - - RD RPTA - CONTROLS ARE - FINAL, - TEMP-REGION, - TEMP-BRANCH, - TEMP-INVOICE - - PAGE LIMIT IS 60 LINES - HEADING 1 - FIRST DETAIL 8 - LAST DETAIL 48. - - 01 RPTA-PAGE-HEADING TYPE PAGE HEADING. - 03 LINE NUMBER IS 1. - 05 COLUMN 1 PIC X(4) VALUE "Run:". - 05 COLUMN 5 PIC X(2) SOURCE WS-DATE-MM. - 05 COLUMN 7 PIC X VALUE "/". - 05 COLUMN 8 PIC X(2) SOURCE WS-DATE-DD. - 05 COLUMN 10 PIC X VALUE "/". - 05 COLUMN 11 PIC X(4) SOURCE WS-DATE-YYYY. - 05 COLUMN 16 PIC X(6) SOURCE WS-TIME. - 05 COLUMN 40 PIC X(16) VALUE "NEXT PAGE ISSUE". - 05 COLUMN 61 PIC X(4) VALUE 'Page'. - 05 COLUMN 66 PIC ZZZ9 SOURCE PAGE-COUNTER. - - 03 LINE NUMBER IS 2. - 05 COLUMN 1 PIC X(08) VALUE "Region: ". - 05 COLUMN 12 PIC XX SOURCE TEMP-REGION. - - 03 LINE NUMBER IS 3. - 05 COLUMN 1 PIC X(21) VALUE "Location: ". - 05 COLUMN 22 PIC X(7) SOURCE TEMP-BRANCH. - - 03 LINE NUMBER IS 4. - 05 COLUMN 1 PIC X(8) VALUE "Invoice#". - 05 COLUMN 12 PIC X(4) VALUE "Date". - 05 COLUMN 46 PIC X(6) VALUE "Order#". - 05 COLUMN 62 PIC X(5) VALUE "Line#". - 05 COLUMN 69 PIC X(5) VALUE "Item#". - 05 COLUMN 102 PIC X(6) VALUE "TX Qty". - 05 COLUMN 114 PIC X(4) VALUE "Cost". - - 03 LINE NUMBER IS 5. - 05 COLUMN 1 PIC X(128) VALUE ALL "-". - - 01 RPTA-DETAIL-LINE TYPE DETAIL. - 05 LINE PLUS 1. - 07 COLUMN 1 PIC X(8) GROUP INDICATE - SOURCE TEMP-INVOICE. - 07 COLUMN 12 PIC X(8) GROUP INDICATE - SOURCE TEMP-DATE. - 07 COLUMN 46 PIC X(8) GROUP INDICATE - SOURCE TEMP-ORDER. - 07 COLUMN 64 PIC X(3) SOURCE TEMP-LINE-NO. - 07 COLUMN 69 PIC X(20) SOURCE TEMP-ITEM. - 07 COLUMN 102 PIC S9(8) SOURCE TEMP-TX-QTY. - 07 COLUMN 114 PIC ZZZZZZ9.99 SOURCE TEMP-COST. - - 01 RPTA-INVOICE-FOOTING TYPE CONTROL FOOTING TEMP-INVOICE - NEXT GROUP PLUS 1. - 03 LINE NUMBER IS PLUS 1. - 05 COLUMN 69 PIC X(15) VALUE "Invoice Total: ". - 05 COLUMN 101 PIC S9(9) SUM TEMP-TX-QTY. - 05 COLUMN 113 PIC ZZZZZZZ9.99 SUM TEMP-COST. - - 01 RPTA-BRANCH-FOOTING TYPE CONTROL FOOTING TEMP-BRANCH - NEXT GROUP NEXT PAGE. - 03 LINE NUMBER IS PLUS 2. - 05 COLUMN 69 PIC X(15) VALUE "Branch Total: ". - 05 COLUMN 101 PIC S9(9) SUM TEMP-TX-QTY. - 05 COLUMN 113 PIC ZZZZZZZ9.99 SUM TEMP-COST. - - 01 RPTA-REGION-FOOTING TYPE CONTROL FOOTING TEMP-REGION - NEXT GROUP NEXT PAGE. - 03 LINE NUMBER IS PLUS 2. - 05 COLUMN 69 PIC X(15) VALUE "Region Total: ". - 05 COLUMN 101 PIC S9(9) SUM TEMP-TX-QTY. - 05 COLUMN 113 PIC ZZZZZZZ9.99 SUM TEMP-COST. - - 01 RPTA-FINAL-FOOTING TYPE CONTROL FOOTING FINAL. - 03 LINE NUMBER IS PLUS 2. - 05 COLUMN 69 PIC X(15) VALUE "Grand Total: ". - 05 COLUMN 101 PIC S9(9) SUM TEMP-TX-QTY. - 05 COLUMN 113 PIC ZZZZZZZ9.99 SUM TEMP-COST. - - PROCEDURE DIVISION. - - OPEN INPUT TEMP-FILE. - OPEN OUTPUT REPORT-FILE. - - MOVE "20150225153000000000000" TO WS-CURRENT-DATE. - - INITIATE RPTA. - - PERFORM PROCESS-DETAIL-LEVEL-REPORT THRU PDLR-EXIT. - - TERMINATE RPTA. - - CLOSE TEMP-FILE. - CLOSE REPORT-FILE. - - STOP RUN. - - - PROCESS-DETAIL-LEVEL-REPORT. - PERFORM READ-NEXT-TEMP-REC THRU RNTR-EXIT. - - IF TEMP-FILE-EOF EQUALS 1 - GO TO PDLR-EXIT - END-IF. - - GENERATE RPTA-DETAIL-LINE. - - GO TO PROCESS-DETAIL-LEVEL-REPORT. - - PDLR-EXIT. - EXIT. - - - READ-NEXT-TEMP-REC. - READ TEMP-FILE NEXT RECORD - AT END - MOVE 1 TO TEMP-FILE-EOF - END-READ. - - RNTR-EXIT. - EXIT. -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) - -AT_CHECK([DD_TEMPFILE=./inp_data DD_REPORTFILE=./report.txt $COBCRUN_DIRECT ./prog], [0], [], []) - - -AT_CAPTURE_FILE(./report.txt) - -AT_DATA([reference], [Run:02/25/2015 153000 NEXT PAGE ISSUE Page 1 -Region: MW -Location: 1000051 -Invoice# Date Order# Line# Item# TX Qty Cost --------------------------------------------------------------------------------------------------------------------------------- - - -IN150212 20150212 OR150212 043 ITEM_NUMBER_22 00000028 29.99 - Invoice Total: 000000028 29.99 - -IN150222 20150222 OR150226 020 ITEM_NUMBER_06 00000043 9.99 - Invoice Total: 000000043 9.99 - - - Branch Total: 000000071 39.98 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -Run:02/25/2015 153000 NEXT PAGE ISSUE Page 2 -Region: MW -Location: 1000071 -Invoice# Date Order# Line# Item# TX Qty Cost --------------------------------------------------------------------------------------------------------------------------------- - - -IN150214 20150214 OR150212 057 ITEM_NUMBER_51 00000070 59.99 - Invoice Total: 000000070 59.99 - -IN150228 20150228 OR150225 098 ITEM_NUMBER_92 00000014 99.99 - Invoice Total: 000000014 99.99 - - - Branch Total: 000000084 159.98 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -Run:02/25/2015 153000 NEXT PAGE ISSUE Page 3 -Region: MW -Location: 1000201 -Invoice# Date Order# Line# Item# TX Qty Cost --------------------------------------------------------------------------------------------------------------------------------- - - -IN150209 20150209 OR150216 083 ITEM_NUMBER_77 00000077 79.99 - Invoice Total: 000000077 79.99 - -IN150227 20150227 OR150223 079 ITEM_NUMBER_20 00000096 29.99 - Invoice Total: 000000096 29.99 - - - Branch Total: 000000173 109.98 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -Run:02/25/2015 153000 NEXT PAGE ISSUE Page 4 -Region: MW -Location: 1000291 -Invoice# Date Order# Line# Item# TX Qty Cost --------------------------------------------------------------------------------------------------------------------------------- - - -IN150217 20150217 OR150218 088 ITEM_NUMBER_86 00000019 89.99 - Invoice Total: 000000019 89.99 - - - Branch Total: 000000019 89.99 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -Run:02/25/2015 153000 NEXT PAGE ISSUE Page 5 -Region: MW -Location: 1000411 -Invoice# Date Order# Line# Item# TX Qty Cost --------------------------------------------------------------------------------------------------------------------------------- - - -IN150223 20150223 OR150210 063 ITEM_NUMBER_66 00000088 69.99 - Invoice Total: 000000088 69.99 - - - Branch Total: 000000088 69.99 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -Run:02/25/2015 153000 NEXT PAGE ISSUE Page 6 -Region: MW -Location: 1000451 -Invoice# Date Order# Line# Item# TX Qty Cost --------------------------------------------------------------------------------------------------------------------------------- - - -IN150217 20150217 OR150202 053 ITEM_NUMBER_60 00000051 69.99 - Invoice Total: 000000051 69.99 - - - Branch Total: 000000051 69.99 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -Run:02/25/2015 153000 NEXT PAGE ISSUE Page 7 -Region: MW -Location: 1000471 -Invoice# Date Order# Line# Item# TX Qty Cost --------------------------------------------------------------------------------------------------------------------------------- - - -IN150224 20150224 OR150201 036 ITEM_NUMBER_45 00000038 49.99 - Invoice Total: 000000038 49.99 - - - Branch Total: 000000038 49.99 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -Run:02/25/2015 153000 NEXT PAGE ISSUE Page 8 -Region: MW -Location: 1000831 -Invoice# Date Order# Line# Item# TX Qty Cost --------------------------------------------------------------------------------------------------------------------------------- - - -IN150210 20150210 OR150227 042 ITEM_NUMBER_70 00000072 79.99 - Invoice Total: 000000072 79.99 - -IN150214 20150214 OR150228 090 ITEM_NUMBER_07 00000023 9.99 - Invoice Total: 000000023 9.99 - -IN150220 20150220 OR150226 048 ITEM_NUMBER_61 00000059 69.99 - Invoice Total: 000000059 69.99 - - - Branch Total: 000000154 159.97 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -Run:02/25/2015 153000 NEXT PAGE ISSUE Page 9 -Region: MW -Location: 1000891 -Invoice# Date Order# Line# Item# TX Qty Cost --------------------------------------------------------------------------------------------------------------------------------- - - -IN150221 20150221 OR150219 018 ITEM_NUMBER_72 00000073 79.99 - Invoice Total: 000000073 79.99 - -IN150223 20150223 OR150227 069 ITEM_NUMBER_73 00000074 79.99 - Invoice Total: 000000074 79.99 - - - Branch Total: 000000147 159.98 - - Region Total: 000000825 909.85 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -Run:02/25/2015 153000 NEXT PAGE ISSUE Page 10 -Region: NE -Location: 1000001 -Invoice# Date Order# Line# Item# TX Qty Cost --------------------------------------------------------------------------------------------------------------------------------- - - -IN150210 20150210 OR150217 060 ITEM_NUMBER_38 00000098 39.99 - Invoice Total: 000000098 39.99 - - - Branch Total: 000000098 39.99 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -Run:02/25/2015 153000 NEXT PAGE ISSUE Page 11 -Region: NE -Location: 1000201 -Invoice# Date Order# Line# Item# TX Qty Cost --------------------------------------------------------------------------------------------------------------------------------- - - -IN150219 20150219 OR150209 035 ITEM_NUMBER_94 00000096 99.99 - Invoice Total: 000000096 99.99 - - - Branch Total: 000000096 99.99 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -Run:02/25/2015 153000 NEXT PAGE ISSUE Page 12 -Region: NE -Location: 1000431 -Invoice# Date Order# Line# Item# TX Qty Cost --------------------------------------------------------------------------------------------------------------------------------- - - -IN150215 20150215 OR150227 047 ITEM_NUMBER_64 00000087 69.99 - Invoice Total: 000000087 69.99 - -IN150222 20150222 OR150213 062 ITEM_NUMBER_97 00000073 99.99 - Invoice Total: 000000073 99.99 - - - Branch Total: 000000160 169.98 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -Run:02/25/2015 153000 NEXT PAGE ISSUE Page 13 -Region: NE -Location: 1000451 -Invoice# Date Order# Line# Item# TX Qty Cost --------------------------------------------------------------------------------------------------------------------------------- - - -IN150203 20150203 OR150213 087 ITEM_NUMBER_85 00000053 89.99 - Invoice Total: 000000053 89.99 - - - Branch Total: 000000053 89.99 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -Run:02/25/2015 153000 NEXT PAGE ISSUE Page 14 -Region: NE -Location: 1000471 -Invoice# Date Order# Line# Item# TX Qty Cost --------------------------------------------------------------------------------------------------------------------------------- - - -IN150221 20150221 OR150222 034 ITEM_NUMBER_74 00000084 79.99 - 077 ITEM_NUMBER_78 00000024 79.99 - Invoice Total: 000000108 159.98 - - - Branch Total: 000000108 159.98 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -Run:02/25/2015 153000 NEXT PAGE ISSUE Page 15 -Region: NE -Location: 1000491 -Invoice# Date Order# Line# Item# TX Qty Cost --------------------------------------------------------------------------------------------------------------------------------- - - -IN150217 20150217 OR150210 037 ITEM_NUMBER_17 00000007 19.99 - Invoice Total: 000000007 19.99 - - - Branch Total: 000000007 19.99 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -Run:02/25/2015 153000 NEXT PAGE ISSUE Page 16 -Region: NE -Location: 1000601 -Invoice# Date Order# Line# Item# TX Qty Cost --------------------------------------------------------------------------------------------------------------------------------- - - -IN150215 20150215 OR150211 070 ITEM_NUMBER_06 00000044 9.99 - Invoice Total: 000000044 9.99 - - - Branch Total: 000000044 9.99 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -Run:02/25/2015 153000 NEXT PAGE ISSUE Page 17 -Region: NE -Location: 1000631 -Invoice# Date Order# Line# Item# TX Qty Cost --------------------------------------------------------------------------------------------------------------------------------- - - -IN150227 20150227 OR150209 051 ITEM_NUMBER_09 00000054 9.99 - Invoice Total: 000000054 9.99 - - - Branch Total: 000000054 9.99 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -Run:02/25/2015 153000 NEXT PAGE ISSUE Page 18 -Region: NE -Location: 1000671 -Invoice# Date Order# Line# Item# TX Qty Cost --------------------------------------------------------------------------------------------------------------------------------- - - -IN150206 20150206 OR150220 045 ITEM_NUMBER_56 00000066 59.99 - Invoice Total: 000000066 59.99 - - - Branch Total: 000000066 59.99 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -Run:02/25/2015 153000 NEXT PAGE ISSUE Page 19 -Region: NE -Location: 1000811 -Invoice# Date Order# Line# Item# TX Qty Cost --------------------------------------------------------------------------------------------------------------------------------- - - -IN150220 20150220 OR150212 086 ITEM_NUMBER_27 00000017 29.99 - Invoice Total: 000000017 29.99 - -IN150228 20150228 OR150222 075 ITEM_NUMBER_66 00000086 69.99 - Invoice Total: 000000086 69.99 - - - Branch Total: 000000103 99.98 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -Run:02/25/2015 153000 NEXT PAGE ISSUE Page 20 -Region: NE -Location: 1000831 -Invoice# Date Order# Line# Item# TX Qty Cost --------------------------------------------------------------------------------------------------------------------------------- - - -IN150216 20150216 OR150224 004 ITEM_NUMBER_52 00000042 59.99 - Invoice Total: 000000042 59.99 - - - Branch Total: 000000042 59.99 - - Region Total: 000000831 819.86 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -Run:02/25/2015 153000 NEXT PAGE ISSUE Page 21 -Region: NW -Location: 1000001 -Invoice# Date Order# Line# Item# TX Qty Cost --------------------------------------------------------------------------------------------------------------------------------- - - -IN150224 20150224 OR150215 029 ITEM_NUMBER_79 00000035 79.99 - Invoice Total: 000000035 79.99 - - - Branch Total: 000000035 79.99 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -Run:02/25/2015 153000 NEXT PAGE ISSUE Page 22 -Region: NW -Location: 1000011 -Invoice# Date Order# Line# Item# TX Qty Cost --------------------------------------------------------------------------------------------------------------------------------- - - -IN150228 20150228 OR150209 023 ITEM_NUMBER_62 00000098 69.99 - Invoice Total: 000000098 69.99 - - - Branch Total: 000000098 69.99 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -Run:02/25/2015 153000 NEXT PAGE ISSUE Page 23 -Region: NW -Location: 1000051 -Invoice# Date Order# Line# Item# TX Qty Cost --------------------------------------------------------------------------------------------------------------------------------- - - -IN150210 20150210 OR150225 076 ITEM_NUMBER_50 00000039 59.99 - Invoice Total: 000000039 59.99 - -IN150218 20150218 OR150229 093 ITEM_NUMBER_94 00000037 99.99 - Invoice Total: 000000037 99.99 - -IN150220 20150220 OR150221 050 ITEM_NUMBER_89 00000038 89.99 - Invoice Total: 000000038 89.99 - - - Branch Total: 000000114 249.97 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -Run:02/25/2015 153000 NEXT PAGE ISSUE Page 24 -Region: NW -Location: 1000071 -Invoice# Date Order# Line# Item# TX Qty Cost --------------------------------------------------------------------------------------------------------------------------------- - - -IN150202 20150202 OR150223 014 ITEM_NUMBER_54 00000048 59.99 - Invoice Total: 000000048 59.99 - - - Branch Total: 000000048 59.99 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -Run:02/25/2015 153000 NEXT PAGE ISSUE Page 25 -Region: NW -Location: 1000091 -Invoice# Date Order# Line# Item# TX Qty Cost --------------------------------------------------------------------------------------------------------------------------------- - - -IN150208 20150208 OR150229 094 ITEM_NUMBER_17 00000072 19.99 - Invoice Total: 000000072 19.99 - -IN150212 20150212 OR150222 096 ITEM_NUMBER_89 00000049 89.99 - Invoice Total: 000000049 89.99 - -IN150224 20150224 OR150211 074 ITEM_NUMBER_90 00000043 99.99 - Invoice Total: 000000043 99.99 - -IN150227 20150227 OR150219 030 ITEM_NUMBER_12 00000019 19.99 - Invoice Total: 000000019 19.99 - - - Branch Total: 000000183 229.96 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -Run:02/25/2015 153000 NEXT PAGE ISSUE Page 26 -Region: NW -Location: 1000201 -Invoice# Date Order# Line# Item# TX Qty Cost --------------------------------------------------------------------------------------------------------------------------------- - - -IN150208 20150208 OR150210 061 ITEM_NUMBER_34 00000012 39.99 - Invoice Total: 000000012 39.99 - - - Branch Total: 000000012 39.99 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -Run:02/25/2015 153000 NEXT PAGE ISSUE Page 27 -Region: NW -Location: 1000231 -Invoice# Date Order# Line# Item# TX Qty Cost --------------------------------------------------------------------------------------------------------------------------------- - - -IN150214 20150214 OR150210 044 ITEM_NUMBER_89 00000054 89.99 - Invoice Total: 000000054 89.99 - - - Branch Total: 000000054 89.99 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -Run:02/25/2015 153000 NEXT PAGE ISSUE Page 28 -Region: NW -Location: 1000251 -Invoice# Date Order# Line# Item# TX Qty Cost --------------------------------------------------------------------------------------------------------------------------------- - - -IN150212 20150212 OR150204 059 ITEM_NUMBER_39 00000060 39.99 - Invoice Total: 000000060 39.99 - - - Branch Total: 000000060 39.99 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -Run:02/25/2015 153000 NEXT PAGE ISSUE Page 29 -Region: NW -Location: 1000401 -Invoice# Date Order# Line# Item# TX Qty Cost --------------------------------------------------------------------------------------------------------------------------------- - - -IN150215 20150215 OR150222 049 ITEM_NUMBER_40 00000081 49.99 - Invoice Total: 000000081 49.99 - -IN150217 20150217 OR150203 085 ITEM_NUMBER_77 00000037 79.99 - Invoice Total: 000000037 79.99 - - - Branch Total: 000000118 129.98 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -Run:02/25/2015 153000 NEXT PAGE ISSUE Page 30 -Region: NW -Location: 1000411 -Invoice# Date Order# Line# Item# TX Qty Cost --------------------------------------------------------------------------------------------------------------------------------- - - -IN150207 20150207 OR150224 056 ITEM_NUMBER_99 00000054 99.99 - Invoice Total: 000000054 99.99 - -IN150228 20150228 OR150221 008 ITEM_NUMBER_68 00000090 69.99 - Invoice Total: 000000090 69.99 - - - Branch Total: 000000144 169.98 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -Run:02/25/2015 153000 NEXT PAGE ISSUE Page 31 -Region: NW -Location: 1000491 -Invoice# Date Order# Line# Item# TX Qty Cost --------------------------------------------------------------------------------------------------------------------------------- - - -IN150228 20150228 OR150201 002 ITEM_NUMBER_47 00000086 49.99 - Invoice Total: 000000086 49.99 - - - Branch Total: 000000086 49.99 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -Run:02/25/2015 153000 NEXT PAGE ISSUE Page 32 -Region: NW -Location: 1000611 -Invoice# Date Order# Line# Item# TX Qty Cost --------------------------------------------------------------------------------------------------------------------------------- - - -IN150227 20150227 OR150224 097 ITEM_NUMBER_11 00000080 19.99 - Invoice Total: 000000080 19.99 - - - Branch Total: 000000080 19.99 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -Run:02/25/2015 153000 NEXT PAGE ISSUE Page 33 -Region: NW -Location: 1000631 -Invoice# Date Order# Line# Item# TX Qty Cost --------------------------------------------------------------------------------------------------------------------------------- - - -IN150207 20150207 OR150206 031 ITEM_NUMBER_49 00000015 49.99 - Invoice Total: 000000015 49.99 - -IN150214 20150214 OR150210 054 ITEM_NUMBER_40 00000042 49.99 - Invoice Total: 000000042 49.99 - -IN150224 20150224 OR150218 024 ITEM_NUMBER_84 00000033 89.99 - Invoice Total: 000000033 89.99 - - - Branch Total: 000000090 189.97 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -Run:02/25/2015 153000 NEXT PAGE ISSUE Page 34 -Region: NW -Location: 1000651 -Invoice# Date Order# Line# Item# TX Qty Cost --------------------------------------------------------------------------------------------------------------------------------- - - -IN150206 20150206 OR150225 099 ITEM_NUMBER_57 00000043 59.99 - Invoice Total: 000000043 59.99 - - - Branch Total: 000000043 59.99 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -Run:02/25/2015 153000 NEXT PAGE ISSUE Page 35 -Region: NW -Location: 1000671 -Invoice# Date Order# Line# Item# TX Qty Cost --------------------------------------------------------------------------------------------------------------------------------- - - -IN150213 20150213 OR150224 041 ITEM_NUMBER_22 00000002 29.99 - Invoice Total: 000000002 29.99 - - - Branch Total: 000000002 29.99 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -Run:02/25/2015 153000 NEXT PAGE ISSUE Page 36 -Region: NW -Location: 1000691 -Invoice# Date Order# Line# Item# TX Qty Cost --------------------------------------------------------------------------------------------------------------------------------- - - -IN150204 20150204 OR150211 092 ITEM_NUMBER_13 00000094 19.99 - Invoice Total: 000000094 19.99 - - - Branch Total: 000000094 19.99 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -Run:02/25/2015 153000 NEXT PAGE ISSUE Page 37 -Region: NW -Location: 1000811 -Invoice# Date Order# Line# Item# TX Qty Cost --------------------------------------------------------------------------------------------------------------------------------- - - -IN150227 20150227 OR150217 081 ITEM_NUMBER_45 00000016 49.99 - Invoice Total: 000000016 49.99 - - - Branch Total: 000000016 49.99 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -Run:02/25/2015 153000 NEXT PAGE ISSUE Page 38 -Region: NW -Location: 1000851 -Invoice# Date Order# Line# Item# TX Qty Cost --------------------------------------------------------------------------------------------------------------------------------- - - -IN150208 20150208 OR150203 091 ITEM_NUMBER_63 00000066 69.99 - Invoice Total: 000000066 69.99 - - - Branch Total: 000000066 69.99 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -Run:02/25/2015 153000 NEXT PAGE ISSUE Page 39 -Region: NW -Location: 1000871 -Invoice# Date Order# Line# Item# TX Qty Cost --------------------------------------------------------------------------------------------------------------------------------- - - -IN150218 20150218 OR150209 082 ITEM_NUMBER_30 00000055 39.99 - Invoice Total: 000000055 39.99 - -IN150228 20150228 OR150222 015 ITEM_NUMBER_73 00000051 79.99 - Invoice Total: 000000051 79.99 - - - Branch Total: 000000106 119.98 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -Run:02/25/2015 153000 NEXT PAGE ISSUE Page 40 -Region: NW -Location: 1000891 -Invoice# Date Order# Line# Item# TX Qty Cost --------------------------------------------------------------------------------------------------------------------------------- - - -IN150225 20150225 OR150201 026 ITEM_NUMBER_80 00000047 89.99 - Invoice Total: 000000047 89.99 - - - Branch Total: 000000047 89.99 - - Region Total: 000001496 1859.70 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -Run:02/25/2015 153000 NEXT PAGE ISSUE Page 41 -Region: SE -Location: 1000001 -Invoice# Date Order# Line# Item# TX Qty Cost --------------------------------------------------------------------------------------------------------------------------------- - - -IN150223 20150223 OR150203 064 ITEM_NUMBER_03 00000071 9.99 - Invoice Total: 000000071 9.99 - - - Branch Total: 000000071 9.99 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -Run:02/25/2015 153000 NEXT PAGE ISSUE Page 42 -Region: SE -Location: 1000011 -Invoice# Date Order# Line# Item# TX Qty Cost --------------------------------------------------------------------------------------------------------------------------------- - - -IN150201 20150201 OR150213 017 ITEM_NUMBER_09 00000006 9.99 - Invoice Total: 000000006 9.99 - -IN150212 20150212 OR150209 066 ITEM_NUMBER_06 00000040 9.99 - Invoice Total: 000000040 9.99 - - - Branch Total: 000000046 19.98 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -Run:02/25/2015 153000 NEXT PAGE ISSUE Page 43 -Region: SE -Location: 1000091 -Invoice# Date Order# Line# Item# TX Qty Cost --------------------------------------------------------------------------------------------------------------------------------- - - -IN150204 20150204 OR150201 001 ITEM_NUMBER_68 00000019 69.99 - Invoice Total: 000000019 69.99 - -IN150210 20150210 OR150223 084 ITEM_NUMBER_11 00000093 19.99 - Invoice Total: 000000093 19.99 - -IN150226 20150226 OR150219 038 ITEM_NUMBER_97 00000037 99.99 - Invoice Total: 000000037 99.99 - - - Branch Total: 000000149 189.97 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -Run:02/25/2015 153000 NEXT PAGE ISSUE Page 44 -Region: SE -Location: 1000211 -Invoice# Date Order# Line# Item# TX Qty Cost --------------------------------------------------------------------------------------------------------------------------------- - - -IN150206 20150206 OR150221 089 ITEM_NUMBER_05 00000045 9.99 - Invoice Total: 000000045 9.99 - - - Branch Total: 000000045 9.99 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -Run:02/25/2015 153000 NEXT PAGE ISSUE Page 45 -Region: SE -Location: 1000411 -Invoice# Date Order# Line# Item# TX Qty Cost --------------------------------------------------------------------------------------------------------------------------------- - - -IN150212 20150212 OR150208 012 ITEM_NUMBER_46 00000023 49.99 - Invoice Total: 000000023 49.99 - - - Branch Total: 000000023 49.99 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -Run:02/25/2015 153000 NEXT PAGE ISSUE Page 46 -Region: SE -Location: 1000431 -Invoice# Date Order# Line# Item# TX Qty Cost --------------------------------------------------------------------------------------------------------------------------------- - - -IN150207 20150207 OR150214 072 ITEM_NUMBER_25 00000046 29.99 - Invoice Total: 000000046 29.99 - -IN150225 20150225 OR150220 040 ITEM_NUMBER_01 00000061 9.99 - Invoice Total: 000000061 9.99 - - - Branch Total: 000000107 39.98 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -Run:02/25/2015 153000 NEXT PAGE ISSUE Page 47 -Region: SE -Location: 1000451 -Invoice# Date Order# Line# Item# TX Qty Cost --------------------------------------------------------------------------------------------------------------------------------- - - -IN150214 20150214 OR150204 022 ITEM_NUMBER_34 00000047 39.99 - Invoice Total: 000000047 39.99 - - - Branch Total: 000000047 39.99 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -Run:02/25/2015 153000 NEXT PAGE ISSUE Page 48 -Region: SE -Location: 1000471 -Invoice# Date Order# Line# Item# TX Qty Cost --------------------------------------------------------------------------------------------------------------------------------- - - -IN150203 20150203 OR150217 010 ITEM_NUMBER_25 00000034 29.99 - Invoice Total: 000000034 29.99 - -IN150211 20150211 OR150213 025 ITEM_NUMBER_54 00000092 59.99 - Invoice Total: 000000092 59.99 - - - Branch Total: 000000126 89.98 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -Run:02/25/2015 153000 NEXT PAGE ISSUE Page 49 -Region: SE -Location: 1000491 -Invoice# Date Order# Line# Item# TX Qty Cost --------------------------------------------------------------------------------------------------------------------------------- - - -IN150202 20150202 OR150202 013 ITEM_NUMBER_19 00000078 19.99 - Invoice Total: 000000078 19.99 - - - Branch Total: 000000078 19.99 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -Run:02/25/2015 153000 NEXT PAGE ISSUE Page 50 -Region: SE -Location: 1000601 -Invoice# Date Order# Line# Item# TX Qty Cost --------------------------------------------------------------------------------------------------------------------------------- - - -IN150224 20150224 OR150210 039 ITEM_NUMBER_19 00000056 19.99 - Invoice Total: 000000056 19.99 - - - Branch Total: 000000056 19.99 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -Run:02/25/2015 153000 NEXT PAGE ISSUE Page 51 -Region: SE -Location: 1000631 -Invoice# Date Order# Line# Item# TX Qty Cost --------------------------------------------------------------------------------------------------------------------------------- - - -IN150201 20150201 OR150216 003 ITEM_NUMBER_65 00000011 69.99 - Invoice Total: 000000011 69.99 - - - Branch Total: 000000011 69.99 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -Run:02/25/2015 153000 NEXT PAGE ISSUE Page 52 -Region: SE -Location: 1000671 -Invoice# Date Order# Line# Item# TX Qty Cost --------------------------------------------------------------------------------------------------------------------------------- - - -IN150203 20150203 OR150205 071 ITEM_NUMBER_64 00000094 69.99 - Invoice Total: 000000094 69.99 - -IN150220 20150220 OR150214 032 ITEM_NUMBER_53 00000059 59.99 - Invoice Total: 000000059 59.99 - - - Branch Total: 000000153 129.98 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -Run:02/25/2015 153000 NEXT PAGE ISSUE Page 53 -Region: SE -Location: 1000891 -Invoice# Date Order# Line# Item# TX Qty Cost --------------------------------------------------------------------------------------------------------------------------------- - - -IN150226 20150226 OR150229 068 ITEM_NUMBER_75 00000084 79.99 - Invoice Total: 000000084 79.99 - - - Branch Total: 000000084 79.99 - - Region Total: 000000996 769.81 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -Run:02/25/2015 153000 NEXT PAGE ISSUE Page 54 -Region: SW -Location: 1000011 -Invoice# Date Order# Line# Item# TX Qty Cost --------------------------------------------------------------------------------------------------------------------------------- - - -IN150202 20150202 OR150206 000 ITEM_NUMBER_30 00000059 39.99 - Invoice Total: 000000059 39.99 - - - Branch Total: 000000059 39.99 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -Run:02/25/2015 153000 NEXT PAGE ISSUE Page 55 -Region: SW -Location: 1000031 -Invoice# Date Order# Line# Item# TX Qty Cost --------------------------------------------------------------------------------------------------------------------------------- - - -IN150203 20150203 OR150214 033 ITEM_NUMBER_09 00000060 9.99 - Invoice Total: 000000060 9.99 - -IN150206 20150206 OR150206 021 ITEM_NUMBER_91 00000054 99.99 - Invoice Total: 000000054 99.99 - - - Branch Total: 000000114 109.98 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -Run:02/25/2015 153000 NEXT PAGE ISSUE Page 56 -Region: SW -Location: 1000091 -Invoice# Date Order# Line# Item# TX Qty Cost --------------------------------------------------------------------------------------------------------------------------------- - - -IN150223 20150223 OR150221 028 ITEM_NUMBER_67 00000039 69.99 - Invoice Total: 000000039 69.99 - - - Branch Total: 000000039 69.99 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -Run:02/25/2015 153000 NEXT PAGE ISSUE Page 57 -Region: SW -Location: 1000201 -Invoice# Date Order# Line# Item# TX Qty Cost --------------------------------------------------------------------------------------------------------------------------------- - - -IN150209 20150209 OR150205 065 ITEM_NUMBER_21 00000070 29.99 - Invoice Total: 000000070 29.99 - -IN150225 20150225 OR150203 052 ITEM_NUMBER_55 00000075 59.99 - 067 ITEM_NUMBER_83 00000015 89.99 - Invoice Total: 000000090 149.98 - - - Branch Total: 000000160 179.97 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -Run:02/25/2015 153000 NEXT PAGE ISSUE Page 58 -Region: SW -Location: 1000211 -Invoice# Date Order# Line# Item# TX Qty Cost --------------------------------------------------------------------------------------------------------------------------------- - - -IN150202 20150202 OR150221 055 ITEM_NUMBER_16 00000013 19.99 - Invoice Total: 000000013 19.99 - -IN150208 20150208 OR150215 007 ITEM_NUMBER_97 00000089 99.99 - Invoice Total: 000000089 99.99 - - - Branch Total: 000000102 119.98 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -Run:02/25/2015 153000 NEXT PAGE ISSUE Page 59 -Region: SW -Location: 1000271 -Invoice# Date Order# Line# Item# TX Qty Cost --------------------------------------------------------------------------------------------------------------------------------- - - -IN150211 20150211 OR150228 080 ITEM_NUMBER_45 00000052 49.99 - Invoice Total: 000000052 49.99 - -IN150213 20150213 OR150207 095 ITEM_NUMBER_09 00000054 9.99 - Invoice Total: 000000054 9.99 - - - Branch Total: 000000106 59.98 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -Run:02/25/2015 153000 NEXT PAGE ISSUE Page 60 -Region: SW -Location: 1000401 -Invoice# Date Order# Line# Item# TX Qty Cost --------------------------------------------------------------------------------------------------------------------------------- - - -IN150228 20150228 OR150202 027 ITEM_NUMBER_83 00000001 89.99 - Invoice Total: 000000001 89.99 - - - Branch Total: 000000001 89.99 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -Run:02/25/2015 153000 NEXT PAGE ISSUE Page 61 -Region: SW -Location: 1000411 -Invoice# Date Order# Line# Item# TX Qty Cost --------------------------------------------------------------------------------------------------------------------------------- - - -IN150210 20150210 OR150220 073 ITEM_NUMBER_63 00000014 69.99 - Invoice Total: 000000014 69.99 - - - Branch Total: 000000014 69.99 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -Run:02/25/2015 153000 NEXT PAGE ISSUE Page 62 -Region: SW -Location: 1000431 -Invoice# Date Order# Line# Item# TX Qty Cost --------------------------------------------------------------------------------------------------------------------------------- - - -IN150208 20150208 OR150227 078 ITEM_NUMBER_23 00000052 29.99 - Invoice Total: 000000052 29.99 - -IN150220 20150220 OR150227 006 ITEM_NUMBER_50 00000085 59.99 - Invoice Total: 000000085 59.99 - - - Branch Total: 000000137 89.98 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -Run:02/25/2015 153000 NEXT PAGE ISSUE Page 63 -Region: SW -Location: 1000601 -Invoice# Date Order# Line# Item# TX Qty Cost --------------------------------------------------------------------------------------------------------------------------------- - - -IN150206 20150206 OR150201 011 ITEM_NUMBER_73 00000084 79.99 - Invoice Total: 000000084 79.99 - - - Branch Total: 000000084 79.99 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -Run:02/25/2015 153000 NEXT PAGE ISSUE Page 64 -Region: SW -Location: 1000611 -Invoice# Date Order# Line# Item# TX Qty Cost --------------------------------------------------------------------------------------------------------------------------------- - - -IN150206 20150206 OR150218 019 ITEM_NUMBER_67 00000061 69.99 - Invoice Total: 000000061 69.99 - - - Branch Total: 000000061 69.99 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -Run:02/25/2015 153000 NEXT PAGE ISSUE Page 65 -Region: SW -Location: 1000651 -Invoice# Date Order# Line# Item# TX Qty Cost --------------------------------------------------------------------------------------------------------------------------------- - - -IN150209 20150209 OR150224 009 ITEM_NUMBER_23 00000018 29.99 - Invoice Total: 000000018 29.99 - - - Branch Total: 000000018 29.99 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -Run:02/25/2015 153000 NEXT PAGE ISSUE Page 66 -Region: SW -Location: 1000831 -Invoice# Date Order# Line# Item# TX Qty Cost --------------------------------------------------------------------------------------------------------------------------------- - - -IN150201 20150201 OR150221 046 ITEM_NUMBER_44 00000069 49.99 - Invoice Total: 000000069 49.99 - -IN150220 20150220 OR150213 005 ITEM_NUMBER_44 00000037 49.99 - Invoice Total: 000000037 49.99 - -IN150222 20150222 OR150213 058 ITEM_NUMBER_86 00000083 89.99 - Invoice Total: 000000083 89.99 - - - Branch Total: 000000189 189.97 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -Run:02/25/2015 153000 NEXT PAGE ISSUE Page 67 -Region: SW -Location: 1000871 -Invoice# Date Order# Line# Item# TX Qty Cost --------------------------------------------------------------------------------------------------------------------------------- - - -IN150202 20150202 OR150216 016 ITEM_NUMBER_62 00000083 69.99 - Invoice Total: 000000083 69.99 - - Branch Total: 000000083 69.99 - - Region Total: 000001167 1269.78 - - Grand Total: 000005315 5629.00 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -]) - -AT_CHECK([diff reference report.txt], [0]) - -AT_CLEANUP - - -AT_SETUP([Report PRESENT AFTER]) -AT_KEYWORDS([report runfile]) - -AT_DATA([inp_data], -[SAINATH KOTGIRE 30/03/201611029473 20 00100000 00000100 -UDAY PRATIVADI 30/03/201604547552 20 00100000 00000200 -MILIND PARDESHI 30/03/201611256856 20 00100000 00000300 -AJIT PATIL 30/03/201610503086 20 00000500 00000400 -VINOD KAMBLE 30/03/201615487558 20 00100000 00000500 -SACHIN TENDUNLKAR 30/03/201614645425 20 00500000 00000600 -]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - INPUT-OUTPUT SECTION. - FILE-CONTROL. - - SELECT IN-FILE ASSIGN TO EXTERNAL INFILE - LINE SEQUENTIAL - FILE STATUS IS WS-INPUT-STATUS. - - SELECT OUT-FILE ASSIGN TO EXTERNAL OREPORT - LINE SEQUENTIAL - FILE STATUS IS WS-OUTPUT-STATUS. - - DATA DIVISION. - - FILE SECTION. - - FD IN-FILE - RECORDING MODE IS F - BLOCK 0. - - 01 IN-REC. - 05 IN-EMP-NAME PIC X(25). - 05 IN-REPORT-PERIOD PIC X(10). - 05 IN-EMP-USERID PIC X(10). - 05 IN-BILL-DAYS PIC X(3). - 05 IN-SALARY PIC 9(8). - 05 FILLER PIC X(34). - - FD OUT-FILE - RECORDING MODE IS F - REPORT IS REPORT1. - - 01 REP-REC PIC X(100). - - WORKING-STORAGE SECTION. - 01 WS-FILE-FLAGS. - 05 WS-INPUT-STATUS PIC XX. - 88 WS-INPUT-OK VALUE '00'. - 88 WS-INPUT-EOF VALUE '10'. - 05 WS-OUTPUT-STATUS PIC XX. - 88 WS-OUTPUT-OK VALUE '00'. - *-----------------------------------------------------------* - * MISCELLANOUS FIELDS * - *-----------------------------------------------------------* - 01 WS-MISC. - 05 WS-EMP-NAME PIC X(25). - 05 WS-REPORT-PERIOD PIC X(10). - 05 WS-EMP-USERID PIC X(10). - 05 WS-BILL-DAYS PIC X(3). - 05 WS-SALARY PIC 9(8). - - 01 WS-MISC-DATE. - 05 WS-DATE PIC 9(8) VALUE 20160422. - 05 WS-TIME PIC 9(8) VALUE 10550000. - 05 FILLER REDEFINES WS-TIME. - 10 WS-HH PIC 99. - 10 WS-MI PIC 99. - 10 WS-SS PIC 99. - 10 WS-HU PIC 99. - - REPORT SECTION. - - RD REPORT1 - PAGE LIMIT IS 65 LINES - LINE LIMIT 132 - HEADING 1 - CONTROL ARE WS-SALARY. - - 01 MAIN-HEADER TYPE IS PAGE HEADING. - 05 LINE 1. - 10 COLUMN CENTER 45 PIC X(35) VALUE - 'STARK TECHNOLOGIES MONTHLY REPORT'. - - 05 LINE 2. - 10 COLUMN CENTER 45 PIC X(50) VALUE ALL '-'. - - 05 LINE 3. - 10 COLUMN 02 PIC X(14) VALUE 'REPORT PERIOD:'. - 10 COLUMN 20 PIC 9999/99/99 SOURCE WS-DATE. - 10 COLUMN 32 PIC 99 SOURCE WS-HH. - 10 COLUMN 34 PIC X VALUE ':'. - 10 COLUMN 35 PIC 99 SOURCE WS-MI. - - 01 TYPE IS CONTROL HEADING - FOR WS-SALARY OR PAGE. - 05 LINE PLUS 2 PRESENT AFTER NEW WS-SALARY. - 10 COLUMN 6 PIC X(9) VALUE 'EMP NAME:'. - 10 COLUMN 30 PIC X(13) VALUE 'EMP USERID:'. - 10 COLUMN 60 PIC X(13) VALUE 'BILLING DAYS'. - 10 COLUMN 80 PIC X(15) VALUE 'SALARY CREDITED'. - 05 LINE PLUS 1 PRESENT AFTER NEW WS-SALARY. - 10 COLUMN 2 PIC X(100) VALUE ALL '+'. - - 01 DETAIL-1 TYPE DETAIL. - 05 LINE PLUS 1. - 10 COLUMN 6 PIC X(25) SOURCE WS-EMP-NAME. - 10 COLUMN 30 PIC X(08) SOURCE WS-EMP-USERID. - 10 COLUMN 60 PIC X(3) SOURCE WS-BILL-DAYS. - 10 COLUMN 80 PIC Z(7)9 SOURCE WS-SALARY. - - 01 REP-FOOTER TYPE DETAIL. - 05 LINE PLUS 2. - 10 COLUMN 2 PIC X(100) VALUE ALL '*'. - 05 LINE PLUS 1. - 10 COLUMN 30 PIC X(23) VALUE 'END OF SALARY REPORT'. - 05 LINE PLUS 1. - 10 COLUMN 2 PIC X(100) VALUE ALL '*'. - - PROCEDURE DIVISION. - - * ACCEPT WS-DATE FROM DATE YYYYMMDD. - * ACCEPT WS-TIME FROM TIME. - - INITIATE REPORT1 - - * GENERATE MAIN-HEADER - - PERFORM 100-OPEN-FILES - PERFORM 200-MAIN-PROCESS - - TERMINATE REPORT1 - - CLOSE IN-FILE - CLOSE OUT-FILE - STOP RUN. - - 100-OPEN-FILES. - - OPEN INPUT IN-FILE - - IF WS-INPUT-OK - CONTINUE - ELSE - DISPLAY 'ERROR OPENING INFILE FILE.STATUS = ' - WS-INPUT-STATUS - STOP RUN - END-IF - - OPEN OUTPUT OUT-FILE - - IF WS-OUTPUT-OK - INITIALIZE REP-REC - ELSE - DISPLAY 'ERROR OPENING OREPORT FILE.STATUS = ' - WS-OUTPUT-STATUS - STOP RUN - END-IF. - - 200-MAIN-PROCESS. - * GENERATE HEADER-1 - - PERFORM UNTIL WS-INPUT-EOF - READ IN-FILE - MOVE IN-REC TO WS-MISC - EVALUATE WS-INPUT-STATUS - WHEN '00' - GENERATE DETAIL-1 - WHEN '10' - GENERATE REP-FOOTER - WHEN OTHER - DISPLAY ':ERROR READING INFILE FILE.STATUS = ' - WS-INPUT-STATUS - STOP RUN - END-EVALUATE - END-PERFORM. -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) - -AT_CHECK([DD_INFILE=./inp_data DD_OREPORT=./report.txt \ -$COBCRUN_DIRECT ./prog], [0], [], []) - - -AT_CAPTURE_FILE(./report.txt) - -AT_DATA([reference], [ STARK TECHNOLOGIES MONTHLY REPORT - -------------------------------------------------- - REPORT PERIOD: 2016/04/22 10:55 - - EMP NAME: EMP USERID: BILLING DAYS SALARY CREDITED - ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - SAINATH KOTGIRE 11029473 20 100000 - UDAY PRATIVADI 04547552 20 100000 - MILIND PARDESHI 11256856 20 100000 - - EMP NAME: EMP USERID: BILLING DAYS SALARY CREDITED - ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - AJIT PATIL 10503086 20 500 - - EMP NAME: EMP USERID: BILLING DAYS SALARY CREDITED - ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - VINOD KAMBLE 15487558 20 100000 - - EMP NAME: EMP USERID: BILLING DAYS SALARY CREDITED - ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - SACHIN TENDUNLKAR 14645425 20 500000 - - **************************************************************************************************** - END OF SALARY REPORT - **************************************************************************************************** - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -]) - -AT_CHECK([diff reference report.txt], [0]) - -AT_CLEANUP - diff -Nru gnucobol-4.0~early~20200606/tests/testsuite.src/run_returncode.at gnucobol-5/tests/testsuite.src/run_returncode.at --- gnucobol-4.0~early~20200606/tests/testsuite.src/run_returncode.at 2020-06-06 20:52:00.000000000 +0000 +++ gnucobol-5/tests/testsuite.src/run_returncode.at 1970-01-01 00:00:00.000000000 +0000 @@ -1,136 +0,0 @@ -## Copyright (C) 2003-2012, 2014-2015 Free Software Foundation, Inc. -## Written by Keisuke Nishida, Roger While, Simon Sobisch -## -## This file is part of GnuCOBOL. -## -## The GnuCOBOL compiler is free software: you can redistribute it -## and/or modify it under the terms of the GNU General Public License -## as published by the Free Software Foundation, either version 3 of the -## License, or (at your option) any later version. -## -## GnuCOBOL is distributed in the hope that it will be useful, -## but WITHOUT ANY WARRANTY; without even the implied warranty of -## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -## GNU General Public License for more details. -## -## You should have received a copy of the GNU General Public License -## along with GnuCOBOL. If not, see . - -### GnuCOBOL Test Suite - -### Non-standard extensions - -AT_SETUP([RETURN-CODE moving]) -AT_KEYWORDS([returncode]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 I PIC 99 COMP. - PROCEDURE DIVISION. - INITIALIZE RETURN-CODE. - MOVE ZERO TO RETURN-CODE. - MOVE 1 TO RETURN-CODE. - MOVE RETURN-CODE TO I. - IF I NOT = 1 - DISPLAY I NO ADVANCING - END-DISPLAY - END-IF. - STOP RUN. -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [1]) - -AT_CLEANUP - -AT_SETUP([RETURN-CODE passing]) -AT_KEYWORDS([returncode]) - -AT_DATA([mod1.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. mod1. - PROCEDURE DIVISION. - IF RETURN-CODE NOT = 0 - DISPLAY RETURN-CODE NO ADVANCING - END-DISPLAY - END-IF. - MOVE 1 TO RETURN-CODE. - IF RETURN-CODE NOT = 1 - DISPLAY RETURN-CODE NO ADVANCING - END-DISPLAY - END-IF. - EXIT PROGRAM. -]) - -AT_DATA([mod2.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. mod2. - PROCEDURE DIVISION. - EXIT PROGRAM. -]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - PROCEDURE DIVISION. - CALL "mod1" - END-CALL. - IF RETURN-CODE NOT = 1 - DISPLAY RETURN-CODE NO ADVANCING - END-DISPLAY - END-IF. - CALL "mod2" - END-CALL. - IF RETURN-CODE NOT = 0 - DISPLAY RETURN-CODE NO ADVANCING - END-DISPLAY - END-IF. - STOP RUN. -]) - -AT_CHECK([$COMPILE_MODULE mod1.cob], [0], [], []) -AT_CHECK([$COMPILE_MODULE mod2.cob], [0], [], []) -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [], []) - -AT_CLEANUP - -AT_SETUP([RETURN-CODE nested]) -AT_KEYWORDS([returncode]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - PROCEDURE DIVISION. - MOVE 1 TO RETURN-CODE. - IF RETURN-CODE NOT = 1 - DISPLAY RETURN-CODE NO ADVANCING - END-DISPLAY - END-IF. - CALL "mod1" - END-CALL. - IF RETURN-CODE NOT = 2 - DISPLAY RETURN-CODE NO ADVANCING - END-DISPLAY - END-IF. - MOVE ZERO TO RETURN-CODE. - STOP RUN. - PROGRAM-ID. mod1. - PROCEDURE DIVISION. - IF RETURN-CODE NOT = 1 - DISPLAY RETURN-CODE NO ADVANCING - END-DISPLAY - END-IF. - MOVE 2 TO RETURN-CODE. - EXIT PROGRAM. - END PROGRAM mod1. - END PROGRAM prog. -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [], []) - -AT_CLEANUP diff -Nru gnucobol-4.0~early~20200606/tests/testsuite.src/run_subscripts.at gnucobol-5/tests/testsuite.src/run_subscripts.at --- gnucobol-4.0~early~20200606/tests/testsuite.src/run_subscripts.at 2020-06-06 20:52:00.000000000 +0000 +++ gnucobol-5/tests/testsuite.src/run_subscripts.at 1970-01-01 00:00:00.000000000 +0000 @@ -1,286 +0,0 @@ -## Copyright (C) 2003-2012, 2014-2017, 2019 Free Software Foundation, Inc. -## Written by Keisuke Nishida, Roger While, Simon Sobisch -## -## This file is part of GnuCOBOL. -## -## The GnuCOBOL compiler is free software: you can redistribute it -## and/or modify it under the terms of the GNU General Public License -## as published by the Free Software Foundation, either version 3 of the -## License, or (at your option) any later version. -## -## GnuCOBOL is distributed in the hope that it will be useful, -## but WITHOUT ANY WARRANTY; without even the implied warranty of -## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -## GNU General Public License for more details. -## -## You should have received a copy of the GNU General Public License -## along with GnuCOBOL. If not, see . - -### GnuCOBOL Test Suite - -### ISO+IEC+1989-2002 8.4.1.2 Subscripts - -## 8.4.1.2.3 General rules - - -AT_SETUP([Subscript out of bounds]) -AT_KEYWORDS([runsubscripts subscripts]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 G. - 02 X PIC X OCCURS 10. - 01 I PIC 9 VALUE 0. - PROCEDURE DIVISION. - DISPLAY X(I) - END-DISPLAY. - STOP RUN. -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [1], [], -[libcob: prog.cob:10: error: subscript of 'X' out of bounds: 0 -]) - -AT_DATA([prog2.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog2. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 G. - 02 X PIC X OCCURS 10. - 01 I PIC 99 VALUE 11. - PROCEDURE DIVISION. - DISPLAY X(I) - END-DISPLAY. - STOP RUN. -]) - -AT_CHECK([$COMPILE prog2.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog2], [1], [], -[libcob: prog2.cob:10: error: subscript of 'X' out of bounds: 11 - maximum subscript for 'X': 10 -]) - -AT_CLEANUP - - -AT_SETUP([Value of DEPENDING ON N out of bounds]) -AT_KEYWORDS([runsubscripts subscripts]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 G. - 02 X PIC X OCCURS 4 TO 6 DEPENDING ON N. - 01 N PIC 9. - PROCEDURE DIVISION. - MOVE 5 TO N. - MOVE '12345' TO G - DISPLAY X(3) WITH NO ADVANCING - END-DISPLAY. - MOVE 3 TO N. - DISPLAY X(5) - END-DISPLAY. - STOP RUN. -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [1], [3], -[libcob: prog.cob:15: error: OCCURS DEPENDING ON 'N' out of bounds: 3 - minimum subscript for 'X': 4 -]) - -AT_DATA([prog2.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog2. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 G. - 02 X PIC X OCCURS 4 TO 6 DEPENDING ON N. - 01 N PIC 9 VALUE 7. - PROCEDURE DIVISION. - DISPLAY X(5) - END-DISPLAY. - STOP RUN. -]) - -AT_CHECK([$COMPILE prog2.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog2], [1], [], -[libcob: prog2.cob:10: error: OCCURS DEPENDING ON 'N' out of bounds: 7 - maximum subscript for 'X': 6 -]) - -AT_CLEANUP - - -AT_SETUP([Subscript bounds with OCCURS DEPENDING ON]) -AT_KEYWORDS([runsubscripts subscripts odo]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 G. - 02 X PIC X OCCURS 4 TO 6 DEPENDING ON N. - 01 N PIC 9 VALUE 4. - PROCEDURE DIVISION. - DISPLAY X(5) - END-DISPLAY. - STOP RUN. -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [1], [], -[libcob: prog.cob:10: error: subscript of 'X' out of bounds: 5 - current maximum subscript for 'X': 4 -]) - -AT_CLEANUP - - -AT_SETUP([Subscript by arithmetic expression]) -AT_KEYWORDS([runsubscripts subscripts]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 G VALUE "1234". - 02 X PIC X OCCURS 4. - 01 Z PIC X. - PROCEDURE DIVISION. - MOVE X((3 + 1) / 2) TO Z. - IF Z NOT = "2" - DISPLAY Z - END-DISPLAY - END-IF. - MOVE X(2 ** 2) TO Z. - IF Z NOT = "4" - DISPLAY Z - END-DISPLAY - END-IF. - STOP RUN. -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [], []) - -AT_CLEANUP - - -AT_SETUP([length of ODO w/- reference modification]) -AT_KEYWORDS([runsubscripts subscripts]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 PLINE. - 03 PLINE-LEN PIC S9(4) COMP-5. - 03 PLINE-TEXT. - 04 FILLER PIC X(1) OCCURS 1 TO 80 - DEPENDING ON PLINE-LEN. - procedure division. - a-main section. - MOVE 5 TO PLINE-LEN - MOVE 'the first part in' TO PLINE-TEXT - MOVE 30 TO PLINE-LEN - IF PLINE-TEXT NOT = 'the f' - DISPLAY 'text1 wrong: ' PLINE-TEXT - END-DISPLAY - END-IF - MOVE 'the first part in' TO PLINE-TEXT - MOVE 4 TO PLINE-LEN - MOVE 'second' TO PLINE-TEXT - MOVE 14 TO PLINE-LEN - IF PLINE-TEXT NOT = 'secofirst part' - DISPLAY 'text2 wrong: ' PLINE-TEXT - END-DISPLAY - END-IF - MOVE 80 TO PLINE-LEN - MOVE SPACES TO PLINE-TEXT - MOVE 5 TO PLINE-LEN - MOVE 'the first part in' TO PLINE-TEXT (2:) - MOVE 30 TO PLINE-LEN - IF PLINE-TEXT NOT = ' the ' - DISPLAY 'text3 wrong: ' PLINE-TEXT - END-DISPLAY - END-IF - MOVE 'the first part in' TO PLINE-TEXT (2:) - MOVE 4 TO PLINE-LEN - MOVE 'second' TO PLINE-TEXT (2:) - MOVE 14 TO PLINE-LEN - IF PLINE-TEXT NOT = ' sec first par' - DISPLAY 'text4 wrong: ' PLINE-TEXT - END-DISPLAY - END-IF - STOP RUN. -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [], []) - -AT_CLEANUP - - -AT_SETUP([SEARCH ALL with OCCURS DEPENDING ON]) -AT_KEYWORDS([runsubscripts subscripts odo]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - * - 77 SCREEN-AKT PIC 9(02) VALUE 0. - 01 SCREEN-TAB. - 03 SCREEN-ENTRY OCCURS 0 TO 20 - DEPENDING ON SCREEN-AKT - ASCENDING KEY SCREEN-NAME - INDEXED BY SCREEN-IDX. - 05 SCREEN-NAME PIC X(02). - - PROCEDURE DIVISION. - - SEARCH ALL SCREEN-ENTRY - AT END - DISPLAY 'END' - WHEN SCREEN-NAME (SCREEN-IDX) = 'AB' - DISPLAY 'FOUND' - END-SEARCH - MOVE 1 TO SCREEN-AKT - MOVE 'AB' TO SCREEN-NAME (1) - SEARCH ALL SCREEN-ENTRY - AT END - DISPLAY 'END' - WHEN SCREEN-NAME (SCREEN-IDX) = 'AB' - DISPLAY 'FOUND' - END-SEARCH - MOVE 2 TO SCREEN-AKT - MOVE 'CD' TO SCREEN-NAME (2) - SEARCH ALL SCREEN-ENTRY - AT END - DISPLAY 'END' - WHEN SCREEN-NAME (SCREEN-IDX) = 'CD' - DISPLAY 'FOUND' - END-SEARCH - EXIT PROGRAM. -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [END -FOUND -FOUND -], []) - -AT_CLEANUP - diff -Nru gnucobol-4.0~early~20200606/tests/testsuite.src/syn_copy.at gnucobol-5/tests/testsuite.src/syn_copy.at --- gnucobol-4.0~early~20200606/tests/testsuite.src/syn_copy.at 2020-06-06 20:52:00.000000000 +0000 +++ gnucobol-5/tests/testsuite.src/syn_copy.at 1970-01-01 00:00:00.000000000 +0000 @@ -1,345 +0,0 @@ -## Copyright (C) 2003-2012, 2014-2015, 2017-2018 Free Software Foundation, Inc. -## Written by Keisuke Nishida, Roger While, Simon Sobisch -## -## This file is part of GnuCOBOL. -## -## The GnuCOBOL compiler is free software: you can redistribute it -## and/or modify it under the terms of the GNU General Public License -## as published by the Free Software Foundation, either version 3 of the -## License, or (at your option) any later version. -## -## GnuCOBOL is distributed in the hope that it will be useful, -## but WITHOUT ANY WARRANTY; without even the implied warranty of -## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -## GNU General Public License for more details. -## -## You should have received a copy of the GNU General Public License -## along with GnuCOBOL. If not, see . - -### GnuCOBOL Test Suite - -AT_SETUP([COPY: within comment]) -AT_KEYWORDS([copy]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - *COPY "copy.inc". - PROCEDURE DIVISION. - STOP RUN. -]) - -AT_DATA([prog2.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog2. - DATA DIVISION. - WORKING-STORAGE SECTION. - *> COPY "copy.inc". - PROCEDURE DIVISION. - STOP RUN. -]) - -AT_CHECK([$COMPILE_ONLY prog.cob], [0], [], []) -AT_CHECK([$COMPILE_ONLY -free prog2.cob], [0], [], []) - -AT_CLEANUP - - -AT_SETUP([COPY: file not found]) -AT_KEYWORDS([copy case fold-copy]) - -# FIXME: possibly move "name without literal" to an extra test -# also testing the library name part (as "found", because -# of different slash) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - COPY "copy.inc". - PROCEDURE DIVISION. - STOP RUN. -]) - -AT_CHECK([$COMPILE_ONLY prog.cob], [1], [], -[prog.cob:6: error: copy.inc: No such file or directory -]) - -AT_DATA([prog2.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - COPY copy.inc. - PROCEDURE DIVISION. - STOP RUN. -]) - -AT_CHECK([$COMPILE_ONLY prog2.cob], [1], [], -[prog2.cob:6: error: COPY.INC: No such file or directory -]) - -AT_DATA([prog3.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - COPY copy.INC.inc. - PROCEDURE DIVISION. - STOP RUN. -]) - -AT_CHECK([$COMPILE_ONLY prog3.cob], [1], [], -[prog3.cob:6: error: COPY.INC.INC: No such file or directory -]) - -AT_CHECK([$COMPILE_ONLY -ffold-copy=lower prog3.cob], [1], [], -[prog3.cob:6: error: copy.inc.inc: No such file or directory -]) - -AT_CLEANUP - - -AT_SETUP([COPY: recursive]) -AT_KEYWORDS([copy]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - COPY copy1. - PROCEDURE DIVISION. - DISPLAY TEST-VAR. - STOP RUN. -]) - -AT_DATA([copy1.CPY], [ - COPY copy2. - 01 TEST-VAR PIC X(2) VALUE "V1". -]) - -AT_DATA([copy2.CPY], [ - 01 TEST-VAR2 PIC X(2) VALUE "V2". - COPY copy3. -]) - -AT_DATA([copy3.CPY], -[ COPY "copy1.CPY". - 01 TEST-VAR3 PIC X(2) VALUE "V3". -]) - -AT_CHECK([$COMPILE_ONLY prog.cob], [1], [], -[copy1.CPY: error: recursive inclusion -copy3.CPY:1: warning: file was included here -copy2.CPY:3: warning: file was included here -copy1.CPY:2: warning: file was included here -prog.cob:6: warning: file was included here -]) - -AT_CLEANUP - - -AT_SETUP([COPY: replacement order]) -AT_KEYWORDS([copy]) - -AT_DATA([copy.inc], [ - 01 TEST-VAR PIC X(2) VALUE "OK". -]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - COPY "copy.inc" - REPLACING ==TEST-VAR== BY ==FIRST-MATCH== - ==TEST-VAR== BY ==SECOND-MATCH==. - PROCEDURE DIVISION. - DISPLAY FIRST-MATCH NO ADVANCING - END-DISPLAY. - STOP RUN. -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [OK], []) - -AT_CLEANUP - - -AT_SETUP([COPY: separators]) -AT_KEYWORDS([copy]) - -AT_DATA([copy.inc], [ - 01 TEST-VAR PIC X(2) VALUE "OK". -]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - COPY "copy.inc" - REPLACING ==TEST-VAR==, BY ==FIRST-MATCH==, - , ==TEST-VAR==; BY ==SECOND-MATCH==; - ; ==TEST-VAR== , BY ==THIRD-MATCH== - ==TEST-VAR== ; BY ==FOURTH-MATCH==. - PROCEDURE DIVISION. - DISPLAY FIRST-MATCH NO ADVANCING - END-DISPLAY. - STOP RUN. -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [OK], []) - -AT_CLEANUP - - -AT_SETUP([COPY: partial replacement]) -AT_KEYWORDS([copy]) - -AT_DATA([copy.inc], [ - 01 :TEST:-VAR PIC X(2) VALUE "OK". - 01 (TEST)-VAR PIC X(2) VALUE "OK". -]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - COPY "copy.inc" - REPLACING ==:TEST:== BY ==COLON== - ==(TEST)== BY ==PAREN==. - PROCEDURE DIVISION. - DISPLAY COLON-VAR NO ADVANCING - END-DISPLAY. - DISPLAY PAREN-VAR NO ADVANCING - END-DISPLAY. - STOP RUN. -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [OKOK]) - -AT_CLEANUP - - -AT_SETUP([COPY: LEADING replacement]) -AT_KEYWORDS([copy]) - -AT_DATA([copy.inc], [ - 01 TEST-VAR PIC X(2) VALUE "OK". - 01 NORM-VAR PIC X(2) VALUE "OK". -]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - COPY "copy.inc" - REPLACING LEADING ==TEST== BY ==FIRST== - LEADING ==NORM== BY ==SECOND==. - PROCEDURE DIVISION. - DISPLAY FIRST-VAR NO ADVANCING - END-DISPLAY. - DISPLAY SECOND-VAR NO ADVANCING - END-DISPLAY. - STOP RUN. -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [OKOK]) - -AT_CLEANUP - - -AT_SETUP([COPY: TRAILING replacement]) -AT_KEYWORDS([copy]) - -AT_DATA([copy.inc], [ - 01 TEST-FIRST PIC X(2) VALUE "OK". - 01 TEST-SECOND PIC X(2) VALUE "OK". -]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - COPY "copy.inc" - REPLACING TRAILING ==FIRST== BY ==VAR1== - TRAILING ==SECOND== BY ==VAR2==. - PROCEDURE DIVISION. - DISPLAY TEST-VAR1 NO ADVANCING - END-DISPLAY. - DISPLAY TEST-VAR2 NO ADVANCING - END-DISPLAY. - STOP RUN. -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [OKOK]) - -AT_CLEANUP - - -AT_SETUP([COPY: recursive replacement]) -AT_KEYWORDS([copy]) - -AT_DATA([copy-2.inc], [ - 01 TEST-VAR PIC X(2) VALUE "OK". -]) - -AT_DATA([copy-1.inc], [ - COPY "copy-2.inc". -]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - COPY "copy-1.inc" - REPLACING ==TEST-VAR== BY ==COPY-VAR==. - PROCEDURE DIVISION. - DISPLAY COPY-VAR NO ADVANCING - END-DISPLAY. - STOP RUN. -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [OK], []) - -AT_CLEANUP - - -AT_SETUP([COPY: fixed/free format]) -AT_KEYWORDS([copy]) - -AT_DATA([copy.inc], [ - >>SOURCE FIXED - 01 TEST-VAR PIC X(2) VALUE "OK". -]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - COPY "copy.inc". - PROCEDURE DIVISION. - DISPLAY TEST-VAR NO ADVANCING - END-DISPLAY. - STOP RUN. -]) - -AT_CHECK([$COMPILE -free prog.cob], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [OK], []) - -AT_CLEANUP diff -Nru gnucobol-4.0~early~20200606/tests/testsuite.src/syn_definition.at gnucobol-5/tests/testsuite.src/syn_definition.at --- gnucobol-4.0~early~20200606/tests/testsuite.src/syn_definition.at 2020-06-06 20:52:00.000000000 +0000 +++ gnucobol-5/tests/testsuite.src/syn_definition.at 1970-01-01 00:00:00.000000000 +0000 @@ -1,2093 +0,0 @@ -## Copyright (C) 2003-2012, 2016-2020 Free Software Foundation, Inc. -## Written by Keisuke Nishida, Roger While, Edward Hart, Simon Sobisch -## -## This file is part of GnuCOBOL. -## -## The GnuCOBOL compiler is free software: you can redistribute it -## and/or modify it under the terms of the GNU General Public License -## as published by the Free Software Foundation, either version 3 of the -## License, or (at your option) any later version. -## -## GnuCOBOL is distributed in the hope that it will be useful, -## but WITHOUT ANY WARRANTY; without even the implied warranty of -## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -## GNU General Public License for more details. -## -## You should have received a copy of the GNU General Public License -## along with GnuCOBOL. If not, see . - -### GnuCOBOL Test Suite - -### -### Invalid PROGRAM-ID -### - -AT_SETUP([Invalid source name]) -AT_KEYWORDS([definition]) - -AT_DATA([short.cob], []) - -AT_CHECK([$COMPILE_ONLY short.cob], [1], [], -[short.cob: error: invalid file base name 'short' - name duplicates a 'C' keyword -]) - -AT_CLEANUP - - -AT_SETUP([Invalid PROGRAM-ID]) -AT_KEYWORDS([definition]) - -AT_DATA([SHORT.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. short. - PROCEDURE DIVISION. - STOP RUN. -]) - -AT_CHECK([$COMPILE_ONLY SHORT.cob], [1], [], -[SHORT.cob:3: error: invalid PROGRAM-ID 'short' - name duplicates a 'C' keyword -]) - -AT_CLEANUP - - -AT_SETUP([Invalid PROGRAM-ID type clause (1)]) -AT_KEYWORDS([definition]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog IS COMMON. - PROCEDURE DIVISION. - STOP RUN. -]) - -AT_CHECK([$COMPILE_ONLY prog.cob], [1], [], -[prog.cob:3: error: COMMON may only be used in a contained program -]) - -AT_CLEANUP - - -AT_SETUP([invalid PROGRAM-ID type clause (2)]) -AT_KEYWORDS([definition]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog IS INITIAL RECURSIVE. - PROCEDURE DIVISION. - STOP RUN. -]) - -AT_CHECK([$COMPILE_ONLY prog.cob], [1], [], -[prog.cob:3: error: syntax error, unexpected RECURSIVE, expecting . -]) - -AT_CLEANUP - - -AT_SETUP([INITIAL / RECURSIVE before COMMON]) -AT_KEYWORDS([PROGRAM-ID definition]) - -AT_DATA([containing-prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. containing-prog. - - PROCEDURE DIVISION. - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog-1 IS INITIAL COMMON. - PROCEDURE DIVISION. - STOP RUN. - END PROGRAM prog-1. - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog-2 IS RECURSIVE COMMON. - PROCEDURE DIVISION. - STOP RUN. - END PROGRAM prog-2. -]) - -AT_CHECK([$COMPILE_ONLY containing-prog.cob], [0], [], []) - -AT_CLEANUP - -### -### Data name -### - -## Undefined - -AT_SETUP([Undefined data name]) -AT_KEYWORDS([definition]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - PROCEDURE DIVISION. - DISPLAY X - END-DISPLAY. - STOP RUN. -]) - -AT_CHECK([$COMPILE_ONLY prog.cob], [1], [], -[prog.cob:5: error: 'X' cannot be used here -]) - -AT_CLEANUP - - -AT_SETUP([Undefined group name]) -AT_KEYWORDS([definition]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 X PIC X. - PROCEDURE DIVISION. - DISPLAY X IN G - END-DISPLAY. - STOP RUN. -]) - -AT_CHECK([$COMPILE_ONLY prog.cob], [1], [], -[prog.cob:8: error: 'X IN G' is not defined -]) - -AT_CLEANUP - - -AT_SETUP([Undefined data name in group]) -AT_KEYWORDS([definition]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 G. - 02 X PIC X. - 01 Y PIC X. - PROCEDURE DIVISION. - DISPLAY Y IN G - END-DISPLAY. - STOP RUN. -]) - -AT_CHECK([$COMPILE_ONLY prog.cob], [1], [], -[prog.cob:10: error: 'Y IN G' is not defined -]) - -AT_CLEANUP - - -AT_SETUP([Reference not a group name]) -AT_KEYWORDS([definition]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 X PIC X. - PROCEDURE DIVISION. - DISPLAY X IN X - END-DISPLAY. - STOP RUN. -]) - -AT_CHECK([$COMPILE_ONLY prog.cob], [1], [], -[prog.cob:8: error: 'X IN X' is not defined -]) - -AT_CLEANUP - - -AT_SETUP([Incomplete 01 definition]) -AT_KEYWORDS([definition]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 X. -]) - -AT_CHECK([$COMPILE_ONLY prog.cob], [1], [], -[prog.cob:6: error: PICTURE clause required for 'X' -]) - -AT_CLEANUP - - -AT_SETUP([error handling in conditions]) -AT_KEYWORDS([definition]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 TESTME PIC X(1). - - PROCEDURE DIVISION. - - EVALUATE TRUE - WHEN TESTME IS NOT-DEFINED - CONTINUE - WHEN TESTME = 'A' - CONTINUE - WHEN OTHER - IF NOT TESTME IS NOT-DEFINED - THEN - CONTINUE - ELSE - CONTINUE - END-IF - END-EVALUATE - EVALUATE TRUE - WHEN TESTME IS 'ABC' - CONTINUE - WHEN TESTME = 'B' - CONTINUE - END-EVALUATE - EVALUATE TRUE - WHEN TESTME IS TESTME - CONTINUE - WHEN TESTME = 'C' - CONTINUE - END-EVALUATE - EVALUATE TRUE - WHEN TESTME NOT = NOT-DEFINED - CONTINUE - WHEN TESTME = 'D' - CONTINUE - END-EVALUATE - EVALUATE TRUE - WHEN TESTME ELSE NOT-DEFINED - CONTINUE - WHEN TESTME = 'E' - CONTINUE - END-EVALUATE - EVALUATE broken - WHEN NOT-DEFINED - continue - END-EVALUATE - - GOBACK. -]) - -AT_CHECK([$COMPILE_ONLY prog.cob], [1], [], -[prog.cob:11: error: syntax error, unexpected Identifier -prog.cob:16: error: syntax error, unexpected Identifier -prog.cob:24: error: syntax error, unexpected Literal -prog.cob:30: error: syntax error, unexpected Identifier -prog.cob:36: error: 'NOT-DEFINED' is not defined -prog.cob:42: error: syntax error, unexpected ELSE -prog.cob:42: error: syntax error, unexpected Identifier -prog.cob:42: error: invalid expression -prog.cob:47: error: 'broken' is not defined -prog.cob:48: error: 'NOT-DEFINED' is not defined -]) -AT_CLEANUP - - -## Same labels in different sections - -AT_SETUP([Same labels in different sections]) -AT_KEYWORDS([definition]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - PROCEDURE DIVISION. - S-1 SECTION. - L. - - S-2 SECTION. - L. - - S-3 SECTION. - GO TO L. - L. -]) - -AT_CHECK([$COMPILE_ONLY prog.cob], [0], [], []) - -AT_CLEANUP - - -## Redefinition - -AT_SETUP([Redefinition of 01 items]) -AT_KEYWORDS([definition]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 X PIC X. - 01 X PIC X. -]) - -AT_CHECK([$COMPILE_ONLY prog.cob], [0], [], -[prog.cob:7: warning: redefinition of 'X' -prog.cob:6: warning: 'X' previously defined here -]) - -AT_CHECK([$COMPILE_ONLY -Wno-extra prog.cob], [0], [], []) - -AT_CLEANUP - - -AT_SETUP([Redefinition of 01 and 02 items]) -AT_KEYWORDS([definition]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 X. - 02 X PIC X. -]) - -AT_CHECK([$COMPILE_ONLY prog.cob], [0], [], -[prog.cob:7: warning: redefinition of 'X' -prog.cob:6: warning: 'X' previously defined here -]) - -AT_CLEANUP - - -AT_SETUP([Redefinition of 02 items]) -AT_KEYWORDS([definition]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 G. - 02 X PIC X. - 02 X PIC X. -]) - -AT_CHECK([$COMPILE_ONLY prog.cob], [0], [], -[prog.cob:8: warning: redefinition of 'X' -prog.cob:7: warning: 'X' previously defined here -]) - -AT_CLEANUP - - -AT_SETUP([Redefinition of 77 items]) -AT_KEYWORDS([definition]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 77 X PIC X. - 77 X PIC X. -]) - -AT_CHECK([$COMPILE_ONLY prog.cob], [0], [], -[prog.cob:7: warning: redefinition of 'X' -prog.cob:6: warning: 'X' previously defined here -]) - -AT_CLEANUP - - -AT_SETUP([Redefinition of 01 and 77 items]) -AT_KEYWORDS([definition]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 X PIC X. - 77 X PIC X. -]) - -AT_CHECK([$COMPILE_ONLY prog.cob], [0], [], -[prog.cob:7: warning: redefinition of 'X' -prog.cob:6: warning: 'X' previously defined here -]) - -AT_CLEANUP - - -AT_SETUP([Redefinition of 88 items]) -AT_KEYWORDS([definition]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 X PIC X. - 88 A VALUE "A". - 88 A VALUE "B". -]) - -AT_CHECK([$COMPILE_ONLY prog.cob], [0], [], -[prog.cob:8: warning: redefinition of 'A' -prog.cob:7: warning: 'A' previously defined here -]) - -AT_CLEANUP - - -AT_SETUP([Redefinition of program-name by other programs]) -AT_KEYWORDS([definition]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 PROG PIC X. - - PROCEDURE DIVISION. - CONTINUE - . - IDENTIFICATION DIVISION. - PROGRAM-ID. foo COMMON. - END PROGRAM foo. - - IDENTIFICATION DIVISION. - PROGRAM-ID. barr. - PROCEDURE DIVISION. - CONTINUE - . - *> This should cause an error (clashes with COMMON subprog foo) - IDENTIFICATION DIVISION. - PROGRAM-ID. foo. - END PROGRAM foo. - END PROGRAM barr. - END PROGRAM prog. - - - *> This should cause an error. - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 foo PIC X. - - PROCEDURE DIVISION. - CONTINUE - . - *> This should clash with the data definition. - IDENTIFICATION DIVISION. - PROGRAM-ID. foo. - END PROGRAM foo. - END PROGRAM prog. - - *> This should cause an error - IDENTIFICATION DIVISION. - PROGRAM-ID. samename. - IDENTIFICATION DIVISION. - PROGRAM-ID. samename. - END PROGRAM samename. - END PROGRAM samename. -]) - -AT_CHECK([$COMPILE_ONLY --ffold-call=upper prog.cob], [1], [], -[prog.cob:7: warning: redefinition of 'prog' -prog.cob:3: warning: 'prog' previously defined here -prog.cob:23: error: redefinition of program name 'foo' -prog.cob:31: error: redefinition of program name 'prog' -prog.cob:42: error: redefinition of 'foo' -prog.cob:35: error: 'foo' previously defined here -prog.cob:42: error: redefinition of program name 'foo' -prog.cob:49: error: PROCEDURE DIVISION header missing -prog.cob:50: error: redefinition of program name 'samename' -]) - -AT_CHECK([$COMPILE_ONLY prog.cob], [1], [], -[prog.cob:23: error: redefinition of program ID 'foo' -prog.cob:31: error: redefinition of program ID 'prog' -prog.cob:42: error: redefinition of program ID 'foo' -prog.cob:49: error: PROCEDURE DIVISION header missing -prog.cob:50: error: redefinition of program ID 'samename' -]) - -AT_CLEANUP - - -AT_SETUP([Redefinition of program-name within program]) -AT_KEYWORDS([definition]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 prog PIC 99 VALUE 0. - - PROCEDURE DIVISION. - prog. - CONTINUE - . -]) - -AT_CHECK([$COMPILE_ONLY prog.cob], [1], [], -[prog.cob:10: error: redefinition of 'prog' -prog.cob:7: error: 'prog' previously defined here -]) -AT_CHECK([$COMPILE_ONLY -fno-program-name-redefinition prog.cob], [1], [], -[prog.cob:7: warning: redefinition of 'prog' -prog.cob:3: warning: 'prog' previously defined here -prog.cob:10: error: redefinition of 'prog' -prog.cob:3: error: 'prog' previously defined here -]) -AT_CLEANUP - - -AT_SETUP([Redefinition of function-prototype name]) -AT_KEYWORDS([definition]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - - ENVIRONMENT DIVISION. - CONFIGURATION SECTION. - REPOSITORY. - FUNCTION func - . - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 func PIC X. -]) - -AT_CHECK([$COMPILE_ONLY prog.cob], [1], [], -[prog.cob:8: warning: no definition/prototype seen for FUNCTION 'func' -prog.cob:12: error: syntax error, unexpected user function name -]) -AT_CLEANUP - - -# Disallow PROCEDURE DIVISION RETURNING OMITTED for main -AT_SETUP([PROCEDURE DIVISION RETURNING OMITTED: main]) -AT_KEYWORDS([runmisc]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - PROCEDURE DIVISION RETURNING OMITTED. - MOVE 42 TO RETURN-CODE - GOBACK. -]) - - -AT_CHECK([$COMPILE_MODULE prog.cob], [0], [], []) -AT_CHECK([$COMPILE prog.cob], [1], [], -[prog.cob:4: error: RETURNING clause cannot be OMITTED for main program -]) - -AT_CLEANUP - - -AT_SETUP([PROCEDURE DIVISION RETURNING OMITTED: FUNCTION]) -AT_KEYWORDS([runmisc]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - FUNCTION-ID. func. - PROCEDURE DIVISION RETURNING OMITTED. - MOVE 42 TO RETURN-CODE - GOBACK. - END FUNCTION func. -]) - -AT_CHECK([$COMPILE_ONLY prog.cob], [1], [], -[prog.cob:4: error: RETURNING clause cannot be OMITTED for a FUNCTION -]) - -AT_CLEANUP - - -AT_SETUP([PROCEDURE DIVISION RETURNING item]) -AT_KEYWORDS([runmisc]) - - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - FUNCTION-ID. func. - DATA DIVISION. - LINKAGE SECTION. - 01 PAR-OUT PIC 9. - PROCEDURE DIVISION RETURNING PAR-OUT. - MOVE 4 TO PAR-OUT - GOBACK. - END FUNCTION func. -]) - -AT_DATA([prog2.cob], [ - IDENTIFICATION DIVISION. - FUNCTION-ID. func. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 PAR-OUT PIC 9. - PROCEDURE DIVISION RETURNING PAR-OUT. - MOVE 4 TO PAR-OUT - GOBACK. - END FUNCTION func. -]) - -AT_DATA([prog3.cob], [ - IDENTIFICATION DIVISION. - FUNCTION-ID. func. - DATA DIVISION. - LINKAGE SECTION. - 01 PAR-OUT PIC 9 OCCURS 10. - PROCEDURE DIVISION RETURNING PAR-OUT. - MOVE 4 TO PAR-OUT (1) - GOBACK. - END FUNCTION func. -]) - -AT_DATA([prog4.cob], [ - IDENTIFICATION DIVISION. - FUNCTION-ID. func. - DATA DIVISION. - LINKAGE SECTION. - 01 PAR. - 02 PAR-OUT PIC 9. - PROCEDURE DIVISION RETURNING PAR-OUT. - MOVE 4 TO PAR-OUT - GOBACK. - END FUNCTION func. -]) - -AT_DATA([prog5.cob], [ - IDENTIFICATION DIVISION. - FUNCTION-ID. func. - DATA DIVISION. - LINKAGE SECTION. - 01 PAR PIC 9. - PROCEDURE DIVISION USING PAR RETURNING PAR. - MOVE 4 TO PAR - GOBACK. - END FUNCTION func. - - IDENTIFICATION DIVISION. - FUNCTION-ID. func2. - DATA DIVISION. - LINKAGE SECTION. - 01 PAR-IN PIC 9. - 01 PAR-OUT REDEFINES PAR-IN PIC 9. - PROCEDURE DIVISION USING PAR-IN RETURNING PAR-OUT. - MOVE 4 TO PAR-OUT - GOBACK. - END FUNCTION func2. -]) - -AT_CHECK([$COMPILE_ONLY prog.cob], [0], [], []) -AT_CHECK([$COMPILE_ONLY prog2.cob], [1], [], -[prog2.cob:7: error: RETURNING item is not defined in LINKAGE SECTION -]) -AT_CHECK([$COMPILE_ONLY prog3.cob], [1], [], -[prog3.cob:7: error: RETURNING item should not have OCCURS -prog3.cob:9: error: 'PAR-OUT' requires one subscript -]) -AT_CHECK([$COMPILE_ONLY prog4.cob], [1], [], -[prog4.cob:8: error: RETURNING item must have level 01 -]) -AT_CHECK([$COMPILE_ONLY prog5.cob], [1], [], -[prog5.cob:7: error: 'PAR' USING item duplicates RETURNING item -prog5.cob:18: error: 'PAR-OUT' REDEFINES field not allowed here -]) - -AT_CLEANUP - - -AT_SETUP([Data item with same name as program-name]) -AT_KEYWORDS([definition]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - FUNCTION-ID. x. - DATA DIVISION. - LINKAGE SECTION. - 01 ret PIC 99. - PROCEDURE DIVISION RETURNING ret. - CONTINUE - . - END FUNCTION x. - - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 x PIC 999 VALUE 134. -]) - -AT_CHECK([$COMPILE_ONLY prog.cob], [0], [], []) -AT_CLEANUP - -## Ambiguous reference - -AT_SETUP([Ambiguous reference to 02 items]) -AT_KEYWORDS([definition]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 G1. - 02 X PIC X. - 01 G2. - 02 X PIC X. - PROCEDURE DIVISION. - DISPLAY X - END-DISPLAY. - STOP RUN. -]) - -AT_CHECK([$COMPILE_ONLY prog.cob], [1], [], -[prog.cob:11: error: 'X' is ambiguous; needs qualification -prog.cob:7: error: 'X IN G1' defined here -prog.cob:9: error: 'X IN G2' defined here -]) - -AT_CLEANUP - - -AT_SETUP([Ambiguous reference to 02 and 03 items]) -AT_KEYWORDS([definition]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 G. - 02 X. - 03 X PIC X. - PROCEDURE DIVISION. - DISPLAY X - END-DISPLAY. - STOP RUN. -]) - -AT_CHECK([$COMPILE_ONLY prog.cob], [1], [], -[prog.cob:10: error: 'X' is ambiguous; needs qualification -prog.cob:7: error: 'X IN G' defined here -prog.cob:8: error: 'X IN X IN G' defined here -]) - -AT_CLEANUP - - -AT_SETUP([Ambiguous reference with qualification]) -AT_KEYWORDS([definition]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 G1. - 02 X. - 03 Y PIC X. - 01 G2. - 02 X. - 03 Y PIC X. - PROCEDURE DIVISION. - DISPLAY Y IN X - END-DISPLAY. - STOP RUN. -]) - -AT_CHECK([$COMPILE_ONLY prog.cob], [1], [], -[prog.cob:13: error: 'Y IN X' is ambiguous; needs qualification -prog.cob:8: error: 'Y IN X IN G1' defined here -prog.cob:11: error: 'Y IN X IN G2' defined here -]) - -AT_CLEANUP - - -AT_SETUP([Unique reference with ambiguous qualifiers]) -AT_KEYWORDS([definition]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 G1. - 02 X. - 03 Y PIC X VALUE "Y". - 01 G2. - 02 X. - 03 Z PIC X VALUE "Z". - PROCEDURE DIVISION. - DISPLAY Z IN X NO ADVANCING - END-DISPLAY. - STOP RUN. -]) - -AT_CHECK([$COMPILE_ONLY prog.cob], [0], [], []) - -AT_CLEANUP - - -AT_SETUP([SYNCHRONIZED clause]) -AT_KEYWORDS([definition sync]) - -# GC simply ignored RIGHT which is wrong according to ANSI/ISO; -# most dialects just skip this, but according to docs IBM handles it - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 77 CS-FULL PICTURE 9(4) COMPUTATIONAL SYNCHRONIZED. - 77 CS PIC 9(4) COMP SYNC. - 77 CSL PIC 9(4) COMP SYNC LEFT. - 77 CSR PIC 9(4) COMP SYNC RIGHT. - PROCEDURE DIVISION. - MOVE 1 TO CS-FULL, CS, CSL, CSR. - STOP RUN. -]) - -# currently is: -AT_CHECK([$COMPILE_ONLY prog.cob], [0], [], -[prog.cob:8: warning: SYNCHRONIZED LEFT/RIGHT is not implemented -prog.cob:9: warning: SYNCHRONIZED LEFT/RIGHT is not implemented -]) -#should be -#AT_CHECK([$COMPILE_ONLY prog.cob], [0], [], []) - -AT_CLEANUP - - -### -### File name -### - - -### -### Label name -### - -## Undefined - -AT_SETUP([Undefined procedure name]) -AT_KEYWORDS([definition]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - PROCEDURE DIVISION. - GO TO END-OF-PROGRAM. - STOP RUN. -]) - -AT_CHECK([$COMPILE_ONLY prog.cob], [1], [], -[prog.cob:5: error: 'END-OF-PROGRAM' is not defined -]) - -AT_CLEANUP - - -## Redefinition - -AT_SETUP([Redefinition of section names]) -AT_KEYWORDS([definition]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - PROCEDURE DIVISION. - L SECTION. - L SECTION. - STOP RUN. -]) - -AT_CHECK([$COMPILE_ONLY prog.cob], [1], [], -[prog.cob: in section 'L': -prog.cob:6: error: redefinition of 'L' -prog.cob:5: error: 'L' previously defined here -]) - -# FIXME: as long as there is no direct reference to the section -# this should be not more than a warning, -# maybe depending on a compiler configuration - -AT_CLEANUP - - -AT_SETUP([Redefinition of section and paragraph names]) -AT_KEYWORDS([definition]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - PROCEDURE DIVISION. - L SECTION. - L. - STOP RUN. -]) - -AT_CHECK([$COMPILE_ONLY prog.cob], [1], [], -[prog.cob: in section 'L': -prog.cob:6: error: redefinition of 'L' -prog.cob:5: error: 'L' previously defined here -]) - -# FIXME: as long as there is no direct reference to -# the paragraph/section this should be not more -# than a warning, maybe depending on a compiler -# configuration - -AT_CLEANUP - - -AT_SETUP([Redefinition of label and variable names]) -AT_KEYWORDS([definition]) - -# currently failing, see FR #260 -AT_XFAIL_IF(true) - -AT_DATA([prog.cob], [ - identification division. - program-id. WORD. - data division. - working-storage section. - *----------------------------------------------------------------- - 77 word pic 9. - *----------------------------------------------------------------- - PROCEDURE DIVISION. - main section. - * - move 0 to word - perform word - * - stop run returning word. - *----------------------------------------------------------------- - word section. - add 1 to word. -]) - -AT_CHECK([$COMPILE_ONLY -std=cobol2014 prog.cob], [1], [], -[prog.cob: in section 'main': -prog.cob:17: error: user-defined word re-used with different type does not conform to COBOL 2014 -prog.cob:17: error: redefinition of 'word' as label-name -prog.cob:7: error: 'word' previously defined here as data-name -]) -AT_CHECK([$COMPILE_ONLY prog.cob], [0], [], []) - -AT_CLEANUP - - -AT_SETUP([Redefinition of paragraph names]) -AT_KEYWORDS([definition]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - PROCEDURE DIVISION. - L. - L. - STOP RUN. -]) - -AT_CHECK([$COMPILE_ONLY prog.cob], [0], [], -[]) - -## Change when we DON'T allow this (likely as a warning, -## depending on compiler configuration) -## AT_CHECK([$COMPILE_ONLY prog.cob], [1], [], -## [prog.cob: in paragraph 'L': -## prog.cob:6: error: redefinition of 'L' -## prog.cob:5: error: 'L' previously defined here -## ]) - -AT_CLEANUP - - -AT_SETUP([Ambiguous reference to paragraph name]) -AT_KEYWORDS([definition]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - PROCEDURE DIVISION. - S-1 SECTION. - L. - S-2 SECTION. - L. - S-3 SECTION. - GO TO L. - STOP RUN. -]) - -AT_CHECK([$COMPILE_ONLY prog.cob], [1], [], -[prog.cob: in section 'S-3': -prog.cob:10: error: 'L' is ambiguous; needs qualification -prog.cob:6: error: 'L IN S-1' defined here -prog.cob:8: error: 'L IN S-2' defined here -]) - -AT_CLEANUP - - -AT_SETUP([Non-matching level numbers (extension)]) -AT_KEYWORDS([definition]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 A. - 05 B. - 10 C PIC X. - 04 D. - 05 E PIC X. - PROCEDURE DIVISION. - STOP RUN. -]) - -AT_CHECK([$COMPILE_ONLY -frelax-level-hierarchy prog.cob], [0], [], -[prog.cob:9: warning: no previous data item of level 04 -]) - -AT_CLEANUP - - -AT_SETUP([CALL BY VALUE alphanumeric item (extension)]) -AT_KEYWORDS([definition]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 X PIC X(4). - PROCEDURE DIVISION. - CALL "PROG2" USING BY VALUE X - END-CALL. - STOP RUN. -]) - -AT_CHECK([$COMPILE_ONLY prog.cob], [0], [], -[prog.cob:8: warning: BY CONTENT assumed for alphanumeric item 'X' -]) - -AT_CLEANUP - - -AT_SETUP([CALL BY VALUE national item (extension)]) -AT_KEYWORDS([definition]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 N PIC N(4). - PROCEDURE DIVISION. - CALL "PROG2" USING BY VALUE N - END-CALL. - STOP RUN. -]) - -AT_CHECK([$COMPILE_ONLY prog.cob], [0], [], -[prog.cob:6: warning: handling of USAGE NATIONAL is unfinished; implementation is likely to be changed -prog.cob:8: warning: BY CONTENT assumed for national item 'N' -]) - -AT_CLEANUP - - -AT_SETUP([CALL BY VALUE figurative constants]) -AT_KEYWORDS([definition]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - PROCEDURE DIVISION. - CALL "PROG2" USING BY VALUE - low-value - high-value - space - quote - zero - END-CALL. - CALL "PROG2" USING - low-value - high-value - space - quote - zero - END-CALL. - CALL "PROG3" USING - null - END-CALL. - STOP RUN. -]) - -# FIXME: should raise an error with -std=cobolNNNN, no warning with -std=default -# --> revise after rw-merge -AT_CHECK([$COMPILE_ONLY -w prog.cob], [0], [], []) - -AT_CLEANUP - - -AT_SETUP([Duplicate identification division header]) -AT_KEYWORDS([definition]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. -]) - -AT_CHECK([$COMPILE_ONLY prog.cob], [1], [], -[prog.cob:3: error: syntax error, unexpected IDENTIFICATION, expecting FUNCTION-ID or PROGRAM-ID -]) -AT_CLEANUP - - -AT_SETUP([RETURNING in STOP RUN / GOBACK / EXIT PROGRAM]) -AT_KEYWORDS([definition RETURN-CODE]) - -AT_DATA([prog1.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog1. - PROCEDURE DIVISION. - EXIT PROGRAM RETURNING -1. -]) - -AT_DATA([prog2.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog2. - PROCEDURE DIVISION. - GOBACK GIVING 2. -]) - -AT_DATA([prog3.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog3. - PROCEDURE DIVISION. - STOP RUN GIVING 0. -]) - -AT_DATA([prog4.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog4. - PROCEDURE DIVISION. - MOVE 42 TO RETURN-CODE - GOBACK. -]) - -AT_DATA([prog5.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog5. - PROCEDURE DIVISION. - GOBACK. -]) - -AT_CHECK([$COMPILE prog1.cob prog2.cob prog3.cob prog4.cob prog5.cob], -[0], [], []) -AT_CHECK([$COMPILE -fnot-register=return-code \ -prog1.cob prog2.cob prog3.cob prog4.cob prog5.cob], [1], [], -[prog1.cob:5: error: RETURNING/GIVING not allowed for non-returning runtime elements -prog2.cob:5: error: RETURNING/GIVING not allowed for non-returning runtime elements -prog4.cob:5: error: 'RETURN-CODE' is not defined -]) - -AT_CLEANUP - - -AT_SETUP([Invalid ENVIRONMENT DIVISION order]) -AT_KEYWORDS([definition]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - - ENVIRONMENT DIVISION. - CONFIGURATION SECTION. - SPECIAL-NAMES. - CONSOLE IS CRT - . - SPECIAL-NAMES. - DECIMAL-POINT IS COMMA - . - SOURCE-COMPUTER. a-computer. -]) - -AT_CHECK([$COMPILE_ONLY -fincorrect-conf-sec-order=error prog.cob], [1], [], -[prog.cob:10: error: duplicate SPECIAL-NAMES -prog.cob:13: error: SOURCE-COMPUTER incorrectly after SPECIAL-NAMES used -]) -AT_CLEANUP - - -AT_SETUP([Function without END FUNCTION]) -AT_KEYWORDS([definition functions]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - FUNCTION-ID. func. -]) - -AT_CHECK([$COMPILE_ONLY prog.cob], [1], [], -[prog.cob:4: error: syntax error, unexpected end of file, expecting END FUNCTION -]) -AT_CLEANUP - - -AT_SETUP([Nested programs without END PROGRAM]) -AT_KEYWORDS([definition]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - PROCEDURE DIVISION. - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog-2. - PROCEDURE DIVISION. - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog-3. - - END PROGRAM prog. -]) - -AT_CHECK([$COMPILE_ONLY prog.cob], [0], [], []) -AT_CLEANUP - - -AT_SETUP([Nested programs not in procedure division]) -AT_KEYWORDS([definition]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog-2. - - END PROGRAM prog. -]) - -AT_CHECK([$COMPILE_ONLY prog.cob], [1], [], -[prog.cob:5: error: PROCEDURE DIVISION header missing -]) -AT_CLEANUP - - -AT_SETUP([Screen section starts with 78-level]) -AT_KEYWORDS([screen definition]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - - DATA DIVISION. - SCREEN SECTION. - 78 const VALUE "x". -]) - -AT_CHECK([$COMPILE_ONLY prog.cob], [0], [], []) -AT_CLEANUP - - -AT_SETUP([Invalid PICTURE strings]) -AT_KEYWORDS([definition USAGE]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 empty-pic PIC. - 01 too-long-pic PIC XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX - -XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX. - 01 too-long-pic2 PIC XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX - -XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX - -XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX - -XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX - -XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX. - 01 multiple-symbols. - 03 PIC 9CRCR. - 03 PIC 9DBDB. - 03 PIC SS99S. - 03 PIC 99..9. - 03 PIC 99VV9. - 03 PIC +$99+. - 03 PIC $+99$-. - 01 non-symbols. - 03 PIC 9K. - 03 PIC 999C. - 03 PIC 999D. - 01 too-many-digits PIC 9(50). - 01 too-long-number-in-parens PIC 9(11111111111111). - 01 nested-parens PIC 9((100)). - 01 unbalanced-parens PIC 9(. - 01 multiple-pairs-of-parens PIC 9(5)(3). - 01 no-digit-in-parens PIC 9(). - 01 mutually-exclusive-symbols. - 03 PIC P(3)9.9. - 03 PIC 9V.9. - 03 PIC Z*. - 03 PIC +(5)--. - 03 PIC $(4)Z(9). - 03 PIC $$B*(4). - 03 PIC NX. - 03 PIC AN. - 03 PIC AZ(3). - 03 PIC 99.99XXXXX. - 03 PIC SA. - 03 PIC $$$B+++B---. - 03 PIC +++9+. - 03 PIC +9(5)CR. - 03 PIC -9(5)DB. - 01 non-rightmost-leftmost-symbols. - 03 PIC BBB+BB99. - 03 PIC 99-B. - 03 PIC 9CRB. - 03 PIC DB9(5). - 03 PIC 99$$$. - 03 PIC 99$B. - 03 PIC 0$99. - 03 PIC PPPVP9. - 01 missing-symbols. - 03 PIC B(5). - 03 PIC +. - 03 PIC $. - - 01 str-constant CONSTANT "hello". - 01 float-constant CONSTANT 1.0. - 01 signed-constant CONSTANT -1. - 01 invalid-constant. - 03 PIC X(str-constant). - 03 PIC X(float-constant). - 03 PIC X(signed-constant). - 03 PIC X(unseen-constant). - - 01 integer-constant CONSTANT 5. - 01 valid-pics. - 03 PIC VP9B. - 03 PIC B9P(3). - 03 PIC B$$$. - 03 PIC 0000+B0+++0B,+. - 03 PIC +(5)P(3). - 03 PIC ++.++. - 03 PIC $(integer-constant). - 03 PIC $$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$ - -(integer-constant). *> CHECKME: should this be really valid? - - - 01 PC-COLOR-BACKGROUND-TABLE. - 05 BIT-BACKGROUND-BLACK PIC 1(8) BIT VALUE B"00000000". - 05 BIT-BACKGROUND-BLUE PIC 1(8) BIT VALUE B"00010000". - 05 BIT-BACKGROUND-GREEN PIC 1(8) BIT VALUE B"00100000". - 05 BIT-BACKGROUND-CYAN PIC 1(8) BIT VALUE B"00110000". - 05 BIT-BACKGROUND-RED PIC 1(8) BIT VALUE B"01000000". - 05 BIT-BACKGROUND-MAGENTA PIC 1(8) BIT VALUE B"01010000". - 05 BIT-BACKGROUND-BROWN PIC 1(8) BIT VALUE B"01100000". - 05 BIT-BACKGROUND-LIGHT-GRAY PIC 1(8) BIT VALUE B"01110000". - 01 FILLER REDEFINES PC-COLOR-BACKGROUND-TABLE. - 05 COLOR-BACKGROUND - OCCURS 8 TIMES PIC 1(8) BIT. -]) - -AT_CHECK([$COMPILE_ONLY -std=cobol2014 prog.cob], [1], [], -[prog.cob:9: warning: continuation of COBOL words is archaic in COBOL 2014 -prog.cob:11: warning: continuation of COBOL words is archaic in COBOL 2014 -prog.cob:12: warning: continuation of COBOL words is archaic in COBOL 2014 -prog.cob:13: warning: continuation of COBOL words is archaic in COBOL 2014 -prog.cob:14: warning: continuation of COBOL words is archaic in COBOL 2014 -prog.cob:82: warning: continuation of COBOL words is archaic in COBOL 2014 -prog.cob:7: error: missing PICTURE string -prog.cob:8: error: PICTURE string may not contain more than 63 characters; contains 76 characters -prog.cob:10: error: PICTURE string may not contain more than 63 characters; contains 301 characters -prog.cob:16: error: CR or DB may only occur once in a PICTURE string -prog.cob:17: error: CR or DB may only occur once in a PICTURE string -prog.cob:18: error: S may only occur once in a PICTURE string -prog.cob:18: error: S must be at start of PICTURE string -prog.cob:19: error: . may only occur once in a PICTURE string -prog.cob:20: error: V may only occur once in a PICTURE string -prog.cob:21: error: a trailing +/- sign cannot follow a leading +/- sign -prog.cob:22: error: a leading +/- sign cannot follow a leading currency symbol -prog.cob:22: error: a trailing currency symbol cannot follow a leading currency symbol -prog.cob:22: error: a trailing +/- sign cannot follow a leading +/- sign -prog.cob:24: error: invalid PICTURE character 'K' -prog.cob:25: error: C must be followed by R -prog.cob:26: error: D must be followed by B -prog.cob:27: error: numeric field cannot be larger than 38 digits -prog.cob:28: error: only up to 9 significant digits are permitted within parentheses -prog.cob:29: error: parentheses must be preceded by a picture symbol -prog.cob:30: error: unbalanced parentheses -prog.cob:31: error: parentheses must be preceded by a picture symbol -prog.cob:32: error: parentheses must contain an unsigned integer -prog.cob:34: error: . cannot follow a P which is after the decimal point -prog.cob:35: error: . cannot follow V -prog.cob:36: error: cannot have both Z and * in PICTURE string -prog.cob:37: error: a trailing +/- sign cannot follow a floating +/- string which is before the decimal point -prog.cob:37: error: a trailing +/- sign may only occur once in a PICTURE string -prog.cob:38: error: a Z or * which is before the decimal point cannot follow a floating currency symbol string which is before the decimal point -prog.cob:39: error: a Z or * which is before the decimal point cannot follow a floating currency symbol string which is before the decimal point -prog.cob:40: warning: handling of USAGE NATIONAL is unfinished; implementation is likely to be changed -prog.cob:40: error: A or X cannot follow N -prog.cob:41: warning: handling of USAGE NATIONAL is unfinished; implementation is likely to be changed -prog.cob:41: error: N cannot follow A or X -prog.cob:42: error: a Z or * which is before the decimal point cannot follow A or X -prog.cob:43: error: A or X cannot follow . -prog.cob:44: error: A or X cannot follow S -prog.cob:45: error: a leading +/- sign cannot follow B, 0 or / -prog.cob:45: error: a leading +/- sign cannot follow a floating currency symbol string which is before the decimal point -prog.cob:45: error: a leading +/- sign may only occur once in a PICTURE string -prog.cob:45: error: a trailing +/- sign cannot follow a leading +/- sign -prog.cob:45: error: a trailing +/- sign may only occur once in a PICTURE string -prog.cob:46: error: a trailing +/- sign cannot follow a floating +/- string which is before the decimal point -prog.cob:47: error: CR or DB cannot follow a leading +/- sign -prog.cob:48: error: CR or DB cannot follow a leading +/- sign -prog.cob:50: error: a leading +/- sign cannot follow B, 0 or / -prog.cob:51: error: a leading +/- sign cannot follow 9 -prog.cob:52: error: B, 0 or / cannot follow CR or DB -prog.cob:53: error: 9 cannot follow CR or DB -prog.cob:54: error: a floating currency symbol string which is before the decimal point cannot follow 9 -prog.cob:55: error: a leading currency symbol cannot follow 9 -prog.cob:56: error: a leading currency symbol cannot follow B, 0 or / -prog.cob:57: error: P must be at start or end of PICTURE string -prog.cob:57: error: V cannot follow a P which is after the decimal point -prog.cob:59: error: PICTURE string must contain at least one of the set A, N, X, Z, 1, 9 and *; or at least two of the set +, - and the currency symbol -prog.cob:60: error: PICTURE string must contain at least one of the set A, N, X, Z, 1, 9 and *; or at least two of the set +, - and the currency symbol -prog.cob:61: error: PICTURE string must contain at least one of the set A, N, X, Z, 1, 9 and *; or at least two of the set +, - and the currency symbol -prog.cob:67: error: 'STR-CONSTANT' is not a numeric literal -prog.cob:68: error: 'FLOAT-CONSTANT' is not an integer -prog.cob:69: error: 'SIGNED-CONSTANT' is not unsigned -prog.cob:70: error: 'UNSEEN-CONSTANT' is not defined -prog.cob:81: warning: uncommon parentheses -prog.cob:86: warning: USAGE BIT is not implemented -prog.cob:87: warning: USAGE BIT is not implemented -prog.cob:88: warning: USAGE BIT is not implemented -prog.cob:89: warning: USAGE BIT is not implemented -prog.cob:90: warning: USAGE BIT is not implemented -prog.cob:91: warning: USAGE BIT is not implemented -prog.cob:92: warning: USAGE BIT is not implemented -prog.cob:93: warning: USAGE BIT is not implemented -prog.cob:96: warning: USAGE BIT is not implemented -]) - -AT_CHECK([$COMPILE_ONLY prog.cob], [1], [], -[prog.cob:9: warning: continuation of COBOL words used -prog.cob:11: warning: continuation of COBOL words used -prog.cob:12: warning: continuation of COBOL words used -prog.cob:13: warning: continuation of COBOL words used -prog.cob:14: warning: continuation of COBOL words used -prog.cob:82: warning: continuation of COBOL words used -prog.cob:7: error: missing PICTURE string -prog.cob:10: error: PICTURE string may not contain more than 255 characters; contains 301 characters -prog.cob:16: error: CR or DB may only occur once in a PICTURE string -prog.cob:17: error: CR or DB may only occur once in a PICTURE string -prog.cob:18: error: S may only occur once in a PICTURE string -prog.cob:18: error: S must be at start of PICTURE string -prog.cob:19: error: . may only occur once in a PICTURE string -prog.cob:20: error: V may only occur once in a PICTURE string -prog.cob:21: error: a trailing +/- sign cannot follow a leading +/- sign -prog.cob:22: error: a leading +/- sign cannot follow a leading currency symbol -prog.cob:22: error: a trailing currency symbol cannot follow a leading currency symbol -prog.cob:22: error: a trailing +/- sign cannot follow a leading +/- sign -prog.cob:24: error: invalid PICTURE character 'K' -prog.cob:25: error: C must be followed by R -prog.cob:26: error: D must be followed by B -prog.cob:27: error: numeric field cannot be larger than 38 digits -prog.cob:28: error: only up to 9 significant digits are permitted within parentheses -prog.cob:29: error: parentheses must be preceded by a picture symbol -prog.cob:30: error: unbalanced parentheses -prog.cob:31: error: parentheses must be preceded by a picture symbol -prog.cob:32: error: parentheses must contain an unsigned integer -prog.cob:34: error: . cannot follow a P which is after the decimal point -prog.cob:35: error: . cannot follow V -prog.cob:36: error: cannot have both Z and * in PICTURE string -prog.cob:37: error: a trailing +/- sign cannot follow a floating +/- string which is before the decimal point -prog.cob:37: error: a trailing +/- sign may only occur once in a PICTURE string -prog.cob:38: error: a Z or * which is before the decimal point cannot follow a floating currency symbol string which is before the decimal point -prog.cob:39: error: a Z or * which is before the decimal point cannot follow a floating currency symbol string which is before the decimal point -prog.cob:40: warning: handling of USAGE NATIONAL is unfinished; implementation is likely to be changed -prog.cob:40: error: A or X cannot follow N -prog.cob:41: warning: handling of USAGE NATIONAL is unfinished; implementation is likely to be changed -prog.cob:41: error: N cannot follow A or X -prog.cob:42: error: a Z or * which is before the decimal point cannot follow A or X -prog.cob:43: error: A or X cannot follow . -prog.cob:44: error: A or X cannot follow S -prog.cob:45: error: a leading +/- sign cannot follow B, 0 or / -prog.cob:45: error: a leading +/- sign cannot follow a floating currency symbol string which is before the decimal point -prog.cob:45: error: a leading +/- sign may only occur once in a PICTURE string -prog.cob:45: error: a trailing +/- sign cannot follow a leading +/- sign -prog.cob:45: error: a trailing +/- sign may only occur once in a PICTURE string -prog.cob:46: error: a trailing +/- sign cannot follow a floating +/- string which is before the decimal point -prog.cob:47: error: CR or DB cannot follow a leading +/- sign -prog.cob:48: error: CR or DB cannot follow a leading +/- sign -prog.cob:50: error: a leading +/- sign cannot follow B, 0 or / -prog.cob:51: error: a leading +/- sign cannot follow 9 -prog.cob:52: error: B, 0 or / cannot follow CR or DB -prog.cob:53: error: 9 cannot follow CR or DB -prog.cob:54: error: a floating currency symbol string which is before the decimal point cannot follow 9 -prog.cob:55: error: a leading currency symbol cannot follow 9 -prog.cob:56: error: a leading currency symbol cannot follow B, 0 or / -prog.cob:57: error: P must be at start or end of PICTURE string -prog.cob:57: error: V cannot follow a P which is after the decimal point -prog.cob:59: error: PICTURE string must contain at least one of the set A, N, X, Z, 1, 9 and *; or at least two of the set +, - and the currency symbol -prog.cob:60: error: PICTURE string must contain at least one of the set A, N, X, Z, 1, 9 and *; or at least two of the set +, - and the currency symbol -prog.cob:61: error: PICTURE string must contain at least one of the set A, N, X, Z, 1, 9 and *; or at least two of the set +, - and the currency symbol -prog.cob:67: error: 'STR-CONSTANT' is not a numeric literal -prog.cob:68: error: 'FLOAT-CONSTANT' is not an integer -prog.cob:69: error: 'SIGNED-CONSTANT' is not unsigned -prog.cob:70: error: 'UNSEEN-CONSTANT' is not defined -prog.cob:81: warning: uncommon parentheses -prog.cob:86: warning: USAGE BIT is not implemented -prog.cob:87: warning: USAGE BIT is not implemented -prog.cob:88: warning: USAGE BIT is not implemented -prog.cob:89: warning: USAGE BIT is not implemented -prog.cob:90: warning: USAGE BIT is not implemented -prog.cob:91: warning: USAGE BIT is not implemented -prog.cob:92: warning: USAGE BIT is not implemented -prog.cob:93: warning: USAGE BIT is not implemented -prog.cob:96: warning: USAGE BIT is not implemented -]) -AT_CLEANUP - - -AT_SETUP([PICTURE strings invalid with BLANK WHEN ZERO]) -AT_KEYWORDS([definition]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 x PIC S9(5) BLANK ZERO. - 01 y PIC *(5) BLANK ZERO. - - *> Actually valid - 01 z PIC -9(5) BLANK ZERO. -]) - -AT_CHECK([$COMPILE_ONLY prog.cob], [1], [], -[prog.cob:7: error: 'x' cannot have S in PICTURE string and BLANK WHEN ZERO -prog.cob:8: error: 'y' cannot have * in PICTURE string and BLANK WHEN ZERO -]) -AT_CLEANUP - - -AT_SETUP([PICTURE strings invalid with USAGE]) -AT_KEYWORDS([definition]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 x PIC XXX, COMP-6. - 01 y PIC +999, PACKED-DECIMAL. -]) - -AT_CHECK([$COMPILE_ONLY prog.cob], [1], [], -[prog.cob:7: error: PICTURE clause not compatible with USAGE COMP-6 -prog.cob:8: error: PICTURE clause not compatible with USAGE COMP-3 -]) -AT_CLEANUP - - -AT_SETUP([ALPHABET definition]) -AT_KEYWORDS([definition]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - CONFIGURATION SECTION. - SPECIAL-NAMES. - ALPHABET TESTME IS - 'A' THROUGH 'Z', x'00' thru x'05'; - x'41' ALSO x'42', ALSO x'00', x'C1' ALSO x'C2'. - ALPHABET FINE - 'A' also 'B' also 'C' also 'd' also 'e' ALSO 'f', - 'g' also 'G', '1' thru '9', x'00'. -]) - -AT_CHECK([$COMPILE_ONLY prog.cob], [1], [], -[prog.cob:7: error: duplicate character values in alphabet 'TESTME': x'00', A, B -]) -AT_CLEANUP - - -AT_SETUP([PROGRAM COLLATING SEQUENCE]) -AT_KEYWORDS([definition ALPHABET]) - -# check that a reference on the bad alphabet does not break cobc -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - CONFIGURATION SECTION. - SOURCE-COMPUTER. GNU-LINUX. - OBJECT-COMPUTER. GC-MACHINE, - PROGRAM COLLATING SEQUENCE IS TESTME. - SPECIAL-NAMES. - ALPHABET TESTME IS - x'00' thru x'05', 'A' THROUGH 'Z'; - x'41' ALSO x'42', ALSO x'00', x'C1' ALSO x'C2'. -]) - -AT_DATA([prog2.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog2. - ENVIRONMENT DIVISION. - CONFIGURATION SECTION. - SOURCE-COMPUTER. GNU-LINUX. - OBJECT-COMPUTER. GC-MACHINE, - PROGRAM COLLATING SEQUENCE IS TESTNO. -]) - -AT_DATA([prog3.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog3. - ENVIRONMENT DIVISION. - CONFIGURATION SECTION. - SOURCE-COMPUTER. GNU-LINUX. - OBJECT-COMPUTER. GC-MACHINE, - PROGRAM COLLATING SEQUENCE IS ALPHABET-1, - ALPHABET-2. - SPECIAL-NAMES. - ALPHABET ALPHABET-1 IS - 'A' THROUGH 'Z', x'00' thru x'05'. - ALPHABET ALPHABET-2 - n'A' also n'B' ALSO n'f', - n'g' also n'G', n'1' thru n'9'. - END PROGRAM prog3. - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog3b. - ENVIRONMENT DIVISION. - CONFIGURATION SECTION. - SOURCE-COMPUTER. GNU-LINUX. - OBJECT-COMPUTER. GC-MACHINE, - PROGRAM SEQUENCE IS ALPHABET-1, - ALPHABET-2. - SPECIAL-NAMES. - ALPHABET ALPHABET-1 IS - 'A' THROUGH 'Z', x'00' thru x'05'. - ALPHABET ALPHABET-2 IS - n'A' ALSO n'f', - n'g' also n'G'. - END PROGRAM prog3b. - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog3c. - ENVIRONMENT DIVISION. - CONFIGURATION SECTION. - SOURCE-COMPUTER. GNU-LINUX. - OBJECT-COMPUTER. GC-MACHINE, SEQUENCE ALPHABET-1, ALPHABET-2. - SPECIAL-NAMES. - ALPHABET ALPHABET-1 x'00' thru x'05'. - ALPHABET ALPHABET-2 IS n'g' also n'G', n'1' thru n'9'. - END PROGRAM prog3c. - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog3d. - ENVIRONMENT DIVISION. - CONFIGURATION SECTION. - SOURCE-COMPUTER. GNU-LINUX. - OBJECT-COMPUTER. GC-MACHINE, SEQUENCE ALPHABET-1, ALPHABET-2. - SPECIAL-NAMES. - ALPHABET ALPHABET-1 IS 'A' THROUGH 'Z'. - ALPHABET ALPHABET-2 n'A' also n'B', n'1' thru n'9'. - END PROGRAM prog3d. - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog3e. - ENVIRONMENT DIVISION. - CONFIGURATION SECTION. - SOURCE-COMPUTER. GNU-LINUX. - OBJECT-COMPUTER. GC-MACHINE, SEQUENCE ALPHABET-1. - SPECIAL-NAMES. - ALPHABET ALPHABET-1 IS 'Z', x'00'. - END PROGRAM prog3e. - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog3f. - ENVIRONMENT DIVISION. - CONFIGURATION SECTION. - SOURCE-COMPUTER. GNU-LINUX. - OBJECT-COMPUTER. GC-MACHINE, - COLLATING SEQUENCE - FOR ALPHANUMERIC IS ALPHABET-1. - SPECIAL-NAMES. - ALPHABET ALPHABET-1 IS - 'A' THROUGH 'Z', x'00', x'05'. - END PROGRAM prog3f. - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog3g. - ENVIRONMENT DIVISION. - CONFIGURATION SECTION. - SOURCE-COMPUTER. GNU-LINUX. - OBJECT-COMPUTER. GC-MACHINE, - SEQUENCE ALPHANUMERIC ALPHABET-1. - SPECIAL-NAMES. - ALPHABET ALPHABET-1 IS - 'A' THROUGH 'D'. - END PROGRAM prog3g. - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog3h. - ENVIRONMENT DIVISION. - CONFIGURATION SECTION. - SOURCE-COMPUTER. GNU-LINUX. - OBJECT-COMPUTER. GC-MACHINE, - COLLATING SEQUENCE - FOR ALPHANUMERIC IS ALPHABET-1 - NATIONAL IS ALPHABET-2. - SPECIAL-NAMES. - ALPHABET ALPHABET-1 IS - 'A', 'C', x'05'. - ALPHABET ALPHABET-2 - n'A', n'1' thru n'9'. - END PROGRAM prog3h. - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog3i. - ENVIRONMENT DIVISION. - CONFIGURATION SECTION. - SOURCE-COMPUTER. GNU-LINUX. - OBJECT-COMPUTER. GC-MACHINE, - COLLATING SEQUENCE - NATIONAL ALPHABET-2 - ALPHANUMERIC ALPHABET-1. - SPECIAL-NAMES. - ALPHABET ALPHABET-1 IS - 'a' THROUGH 'z'. - ALPHABET ALPHABET-2 - n'B', n'C'; n'g' also n'G'. - END PROGRAM prog3i. - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog3j. - ENVIRONMENT DIVISION. - CONFIGURATION SECTION. - SOURCE-COMPUTER. GNU-LINUX. - OBJECT-COMPUTER. GC-MACHINE, - COLLATING SEQUENCE - NATIONAL ALPHABET-2. - SPECIAL-NAMES. - ALPHABET ALPHABET-2 - n'B', n'C'; n'g' also n'G'. - END PROGRAM prog3j. -]) - -AT_CHECK([$COMPILE_ONLY prog.cob], [1], [], -[prog.cob:10: error: duplicate character values in alphabet 'TESTME': x'00', A, B -]) -AT_CHECK([$COMPILE_ONLY prog2.cob], [1], [], -[prog2.cob:8: error: 'TESTNO' is not defined -prog2.cob:8: error: 'TESTNO' is not an alphabet name -]) -AT_CHECK([$COMPILE_ONLY -Wno-unfinished prog3.cob], [0], [], -[prog3.cob:9: warning: NATIONAL COLLATING SEQUENCE is not implemented -prog3.cob:25: warning: NATIONAL COLLATING SEQUENCE is not implemented -prog3.cob:39: warning: NATIONAL COLLATING SEQUENCE is not implemented -prog3.cob:50: warning: NATIONAL COLLATING SEQUENCE is not implemented -prog3.cob:99: warning: NATIONAL COLLATING SEQUENCE is not implemented -prog3.cob:114: warning: NATIONAL COLLATING SEQUENCE is not implemented -prog3.cob:130: warning: NATIONAL COLLATING SEQUENCE is not implemented -]) -AT_CLEANUP - - -AT_SETUP([RENAMES item]) -AT_KEYWORDS([definition 66]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 a. - 03 b PIC 9. - 03 c. - 05 d PIC 9. - 05 e PIC 9. - - 66 valid-1 RENAMES b. - 66 valid-2 RENAMES d THRU e. - - 66 invalid-1 RENAMES a. - 66 invalid-2 RENAMES c THRU d. - 66 invalid-3 RENAMES e THRU d. - 66 invalid-4 RENAMES valid-2. - - 01 f. - 03 g PIC X. - 88 h VALUE "a". - 03 i PIC X. - 03 j OCCURS 5 TIMES. - 05 k PIC X. - 05 l PIC X. - 03 m PIC 9. - 03 n POINTER, SYNC. - 03 o. - 05 p PIC X OCCURS 1 TO 10 DEPENDING ON l. - - 66 valid-3 RENAMES g THRU i. - 66 invalid-5 RENAMES h. - 66 invalid-6 RENAMES k THRU l. - 66 invalid-7 RENAMES j. - 66 invalid-8 RENAMES m THRU o. - 66 invalid-9 RENAMES b THRU m. - - 78 my-ext-const VALUE "123". - 66 invalid-ec RENAMES my-ext-const. - - 01 my-std-const CONSTANT AS "123". - 66 invalid-sc RENAMES my-std-const. - - PROCEDURE DIVISION. - DISPLAY valid-2 OF a - IF valid-1 = 1 - CONTINUE - END-IF - . -]) - -AT_CHECK([$COMPILE_ONLY -std=cobol2014 prog.cob], [1], [], -[prog.cob:15: error: RENAMES of 01-, 66- and 77-level items does not conform to COBOL 2014 -prog.cob:16: error: THRU item 'd' may not be subordinate to 'c' -prog.cob:17: error: THRU item 'd' may not come before 'e' -prog.cob:18: error: RENAMES of 01-, 66- and 77-level items does not conform to COBOL 2014 -prog.cob:33: error: RENAMES may not reference a level 88 -prog.cob:34: error: cannot use RENAMES on part of the table 'j' -prog.cob:35: error: RENAMES cannot start/end at the OCCURS item 'j' -prog.cob:36: error: RENAMES may not contain 'n' as it is a pointer or object reference -prog.cob:36: error: RENAMES may not contain 'p' as it is an OCCURS DEPENDING table -prog.cob:37: error: 'invalid-9' must immediately follow the record 'a' -prog.cob:37: error: 'b' and 'm' must be in the same record -prog.cob:39: error: 78 VALUE does not conform to COBOL 2014 -prog.cob:40: error: a constant may not be used here - 'my-ext-const' -prog.cob:43: error: a constant may not be used here - 'my-std-const' -]) -AT_CLEANUP - - -AT_SETUP([RENAMES of 01-, 66- and 77-level items]) -AT_KEYWORDS([definition 66 extensions]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 a PIC X. - 66 renames-a RENAMES a. - 66 renames-a2 RENAMES renames-a. - - 77 b PIC X. - 66 renames-b RENAMES b. -]) - -AT_CHECK([$COMPILE_ONLY -std=cobol2014 prog.cob], [1], [], -[prog.cob:7: error: RENAMES of 01-, 66- and 77-level items does not conform to COBOL 2014 -prog.cob:8: error: RENAMES of 01-, 66- and 77-level items does not conform to COBOL 2014 -prog.cob:11: error: RENAMES of 01-, 66- and 77-level items does not conform to COBOL 2014 -]) -AT_CHECK([$COMPILE_ONLY -frenames-uncommon-levels=ok prog.cob], [0], [], []) - -AT_CLEANUP - - -AT_SETUP([SAME AS clause]) -AT_KEYWORDS([definition EXTERNAL GLOBAL ]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 MESSAGE-TEXT-2 EXTERNAL. - 02 AUSGABE-FILE-NAME PIC X(50). - 02 FILLER REDEFINES AUSGABE-FILE-NAME. - 05 FILLER PIC 9999. - 02 AUSGABE-FILE-NAME-2. - 05 FILLER PIC 9999. - 05 DETAIL-NO PIC 9999. - 02 FILLER SAME AS AUSGABE-FILE-NAME. - - 77 OUTPUT-NAME SAME AS DETAIL-NO GLOBAL. - - 01 Z-MESSAGE-T2 SAME AS AUSGABE-FILE-NAME-2. - 01 Z-MESSAGE-T3. - 49 MT3 SAME AS MESSAGE-TEXT-2. - 49 MT3-REN REDEFINES MT3 SAME AS MESSAGE-TEXT-2. - - PROCEDURE DIVISION. - DISPLAY AUSGABE-FILE-NAME OF MESSAGE-TEXT-2 - DISPLAY DETAIL-NO OF Z-MESSAGE-T2 - DISPLAY AUSGABE-FILE-NAME OF MT3 - DISPLAY OUTPUT-NAME - GOBACK. -]) - -AT_DATA([badprog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 MESSAGE-TEXT-2. - 02 AUSGABE-FILE-NAME PIC X(50). - 02 F1 SAME AS MESSAGE-TEXT-2. - 01 MT2 SAME AS MESSAGE-TEXT-2. - 05 FILLER PIC 9999. - 01 MT3 SAME AS MESSAGE-TEXT-2 PIC X. - 77 OUTPUT-NAME SAME AS MESSAGE-TEXT-2. -]) - -AT_CHECK([$COMPILE_ONLY -std=mf-strict prog.cob], [1], [], -[prog.cob:13: error: SAME AS clause does not conform to Micro Focus COBOL -prog.cob:15: error: SAME AS clause does not conform to Micro Focus COBOL -prog.cob:17: error: SAME AS clause does not conform to Micro Focus COBOL -prog.cob:19: error: SAME AS clause does not conform to Micro Focus COBOL -prog.cob:20: error: SAME AS clause does not conform to Micro Focus COBOL -]) -AT_CHECK([$COMPILE_ONLY prog.cob], [0], [], []) -AT_CHECK([$COMPILE_ONLY badprog.cob], [1], [], -[badprog.cob:8: error: SAME AS item may not reference itself -badprog.cob:10: error: entry following SAME AS may not be subordinate to it -badprog.cob:11: error: illegal combination of SAME AS with other clauses -badprog.cob:12: error: elementary item expected -]) - -AT_CLEANUP - - -AT_SETUP([APPLY COMMIT clause]) -AT_KEYWORDS([definition I-O-CONTROL ROLLBACK]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. *> taken from "commit and rollback example" - *> from COBOL 202x draft - ENVIRONMENT DIVISION. - INPUT-OUTPUT SECTION. - FILE-CONTROL. - SELECT STCK-FILE - ASSIGN TO "STOCK" - ORGANIZATION IS INDEXED - ACCESS MODE IS RANDOM - FILE STATUS IS STCK-FILE-STATUS - RECORD KEY IS APPLY - SHARING WITH ALL OTHER. - - SELECT CHNG-FILE - ASSIGN TO "CHANGE" - ORGANIZATION IS SEQUENTIAL - ACCESS MODE IS SEQUENTIAL - FILE STATUS IS CHNG-FILE-STATUS - SHARING WITH ALL OTHER. - - SELECT SORT-FILE - ASSIGN TO "SORT". - - I-O-CONTROL. - APPLY COMMIT ON STCK-FILE CHNG-FILE STCK-FILE not-there - SORT-FILE UPDATE-COUNT not-there-again BASED-STUFF - RED-DATA SOME-DATA. - - DATA DIVISION. - FILE SECTION. - - FD STCK-FILE. - 01 STCK-REC. - 03 APPLY PIC X(5). - 03 STCK-QTY PIC 9(5)V99. - - SD SORT-FILE. - 01 SORT-REC PIC X(100). - - FD CHNG-FILE. - 01 CHNG-REC. - 03 CHNG-KEY PIC X(5). - 03 CHNG-QTY PIC 9(5)V99. - 03 CHNG-ACTION PIC X. - 03 CHNG-STATE PIC X. - - WORKING-STORAGE SECTION. - - 01 FILE-STATES. - 03 STCK-FILE-STATUS PIC XX. - 88 STCK-FILE-OK VALUE "00". - 03 CHNG-FILE-STATUS PIC XX. - 88 CHNG-FILE-OK VALUE "00". - 77 UPDATE-COUNT BINARY-LONG. - 77 BASED-STUFF PIC X BASED. - 01 DATA-HERE. - 03 SOME-DATA PIC 9. - 01 RED-DATA REDEFINES DATA-HERE PIC X. - - PROCEDURE DIVISION. - - MAIN SECTION. - - PERFORM INITIALISATION - PERFORM TERMINATION - STOP RUN WITH NORMAL STATUS 0 - - . INITIALISATION SECTION. - - OPEN I-O CHNG-FILE, STCK-FILE - IF NOT STCK-FILE-OK OR NOT CHNG-FILE-OK - PERFORM FATAL-ERROR - END-IF - - . TERMINATION SECTION. - - COMMIT - IF NOT STCK-FILE-OK OR NOT CHNG-FILE-OK - PERFORM FATAL-ERROR - END-IF - - . FATAL-ERROR SECTION. - - ROLLBACK - STOP RUN WITH ERROR STATUS 16. -]) - -AT_CHECK([$COMPILE_ONLY prog.cob], [1], [], -[prog.cob:29: warning: APPLY COMMIT is not implemented -prog.cob:27: error: 'not-there' is not defined -prog.cob:28: error: 'not-there-again' is not defined -prog.cob:27: error: duplicate APPLY COMMIT target: 'STCK-FILE' -prog.cob:28: error: APPLY COMMIT statement invalid for SORT file -prog.cob:29: error: 'RED-DATA' REDEFINES field not allowed here -prog.cob:29: error: 'SOME-DATA' not level 01 or 77 -]) - -AT_CLEANUP diff -Nru gnucobol-4.0~early~20200606/tests/testsuite.src/syn_file.at gnucobol-5/tests/testsuite.src/syn_file.at --- gnucobol-4.0~early~20200606/tests/testsuite.src/syn_file.at 2020-06-06 20:52:00.000000000 +0000 +++ gnucobol-5/tests/testsuite.src/syn_file.at 1970-01-01 00:00:00.000000000 +0000 @@ -1,2993 +0,0 @@ -## Copyright (C) 2003-2012, 2014, 2016-2020 Free Software Foundation, Inc. -## Written by Keisuke Nishida, Roger While, Simon Sobisch, Joe Robbins, -## Edward Hart -## -## This file is part of GnuCOBOL. -## -## The GnuCOBOL compiler is free software: you can redistribute it -## and/or modify it under the terms of the GNU General Public License -## as published by the Free Software Foundation, either version 3 of the -## License, or (at your option) any later version. -## -## GnuCOBOL is distributed in the hope that it will be useful, -## but WITHOUT ANY WARRANTY; without even the implied warranty of -## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -## GNU General Public License for more details. -## -## You should have received a copy of the GNU General Public License -## along with GnuCOBOL. If not, see . - -### GnuCOBOL Test Suite - - -AT_SETUP([Missing SELECT]) -AT_KEYWORDS([file]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - INPUT-OUTPUT SECTION. - FILE-CONTROL. - SELECT file2 ASSIGN DISK. - DATA DIVISION. - FILE SECTION. - FD file1. - 01 file1-rec PIC X. - FD file2. - 01 file2-rec PIC X. - PROCEDURE DIVISION. - STOP RUN. -]) - -AT_CHECK([$COMPILE_ONLY prog.cob], [1], [], -[prog.cob:10: error: 'file1' is not defined -prog.cob:10: error: 'file1' is not a file name -]) -AT_CLEANUP - - -AT_SETUP([Duplicated SELECT]) -AT_KEYWORDS([file]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - INPUT-OUTPUT SECTION. - FILE-CONTROL. - SELECT file1 ASSIGN DISK. - SELECT file2 ASSIGN DISK. - SELECT file1 ASSIGN DISK. - DATA DIVISION. - FILE SECTION. - FD file1. - 01 file1-rec PIC X. - FD file2. - 01 file2-rec PIC X. - PROCEDURE DIVISION. - STOP RUN. -]) - -AT_CHECK([$COMPILE_ONLY prog.cob], [1], [], -[prog.cob:9: error: redefinition of 'file1' -prog.cob:7: error: 'file1' previously defined here -]) -AT_CLEANUP - - -## Each file named in a SELECT clause must be described once in the -## DATA DIVISION. -AT_SETUP([Missing FD]) -AT_KEYWORDS([file]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - INPUT-OUTPUT SECTION. - FILE-CONTROL. - SELECT file1 ASSIGN DISK. - SELECT file2 ASSIGN DISK. - DATA DIVISION. - FILE SECTION. - FD file2. - 01 file2-rec PIC X. - PROCEDURE DIVISION. - OPEN input file1 - STOP RUN. -]) - -AT_CHECK([$COMPILE_ONLY prog.cob], [1], [], -[prog.cob:7: error: missing file description for FILE file1 -]) -AT_CLEANUP - - -AT_SETUP([Duplicated FD]) -AT_KEYWORDS([file]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - INPUT-OUTPUT SECTION. - FILE-CONTROL. - SELECT file1 ASSIGN DISK. - SELECT file2 ASSIGN DISK. - DATA DIVISION. - FILE SECTION. - FD file1. - 01 file1-rec PIC X. - FD file2. - 01 file2-rec PIC X. - FD file1. - 01 file1-rec-2 PIC X. - PROCEDURE DIVISION. - STOP RUN. -]) - -AT_CHECK([$COMPILE_ONLY prog.cob], [1], [], -[prog.cob:15: error: duplicate file description for FILE file1 -]) -AT_CLEANUP - - -AT_SETUP([ASSIGN to device-name]) -AT_KEYWORDS([file DISK device]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - INPUT-OUTPUT SECTION. - FILE-CONTROL. - SELECT TEST-FILE ASSIGN TO DISK - ORGANIZATION IS SEQUENTIAL. - DATA DIVISION. - FILE SECTION. - FD TEST-FILE. - 01 TEST-REC PIC X(4). - PROCEDURE DIVISION. - OPEN INPUT TEST-FILE. - CLOSE TEST-FILE. - STOP RUN. -]) - -AT_DATA([prog2.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog2. - ENVIRONMENT DIVISION. - INPUT-OUTPUT SECTION. - FILE-CONTROL. - SELECT TEST-FILE ASSIGN TO DISK 'TFILE' - ORGANIZATION IS SEQUENTIAL. - DATA DIVISION. - FILE SECTION. - FD TEST-FILE. - 01 TEST-REC PIC X(4). - PROCEDURE DIVISION. - OPEN INPUT TEST-FILE. - CLOSE TEST-FILE. - STOP RUN. -]) - -AT_DATA([prog3.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog3. - ENVIRONMENT DIVISION. - INPUT-OUTPUT SECTION. - FILE-CONTROL. - SELECT TEST-FILE ASSIGN TO DISK FNAME OF F1 - ORGANIZATION IS SEQUENTIAL. - DATA DIVISION. - FILE SECTION. - FD TEST-FILE. - 01 TEST-REC PIC X(4). - WORKING-STORAGE SECTION. - 01 F1. - 05 FNAME PIC X(255) VALUE 'TFILEOF'. - PROCEDURE DIVISION. - OPEN INPUT TEST-FILE. - CLOSE TEST-FILE. - STOP RUN. -]) - -AT_CHECK([$COMPILE_ONLY -std=acu prog.cob], [0], [], []) -AT_CHECK([$COMPILE_ONLY -std=acu prog2.cob], [0], [], []) -AT_CHECK([$COMPILE_ONLY -std=acu prog3.cob], [0], [], []) - -AT_CLEANUP - - -AT_SETUP([ASSIGN to printer-name]) -AT_KEYWORDS([file PRINTER PRINT device]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - INPUT-OUTPUT SECTION. - FILE-CONTROL. - SELECT TEST-FILE ASSIGN TO PRINT - ORGANIZATION IS SEQUENTIAL. - DATA DIVISION. - FILE SECTION. - FD TEST-FILE. - 01 TEST-REC PIC X(4). - PROCEDURE DIVISION. - OPEN INPUT TEST-FILE. - CLOSE TEST-FILE. - STOP RUN. -]) - -AT_DATA([prog2.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog2. - ENVIRONMENT DIVISION. - INPUT-OUTPUT SECTION. - FILE-CONTROL. - SELECT TEST-FILE ASSIGN TO PRINTER 'PFILE' - ORGANIZATION IS SEQUENTIAL. - DATA DIVISION. - FILE SECTION. - FD TEST-FILE. - 01 TEST-REC PIC X(4). - PROCEDURE DIVISION. - OPEN INPUT TEST-FILE. - CLOSE TEST-FILE. - STOP RUN. -]) - -AT_DATA([prog3.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog3. - ENVIRONMENT DIVISION. - INPUT-OUTPUT SECTION. - FILE-CONTROL. - SELECT TEST-FILE ASSIGN TO PRINTER-1 FNAME OF F1 - ORGANIZATION IS SEQUENTIAL. - DATA DIVISION. - FILE SECTION. - FD TEST-FILE. - 01 TEST-REC PIC X(4). - WORKING-STORAGE SECTION. - 01 F1. - 05 FNAME PIC X(255) VALUE 'PFILEOF'. - PROCEDURE DIVISION. - OPEN INPUT TEST-FILE. - CLOSE TEST-FILE. - STOP RUN. -]) - -AT_CHECK([$COMPILE_ONLY -std=acu prog.cob], [0], [], []) -AT_CHECK([$COMPILE_ONLY -std=acu prog2.cob], [0], [], []) -AT_CHECK([$COMPILE_ONLY -std=acu prog3.cob], [0], [], []) - -AT_CLEANUP - - -AT_SETUP([ASSIGN to lsq-device-name]) -AT_KEYWORDS([file PRINTER device]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - INPUT-OUTPUT SECTION. - FILE-CONTROL. - SELECT TST-FILE1 ASSIGN TO CARD-PUNCH "F1". - SELECT TST-FILE2 ASSIGN TO CARD-READER "F2". - SELECT TST-FILE3 ASSIGN TO CASSETTE "F3". - SELECT TST-FILE4 ASSIGN TO INPUT "F4". - SELECT TST-FILE5 ASSIGN TO INPUT-OUTPUT. - SELECT TST-FILE6 ASSIGN TO MAGNETIC-TAPE. - SELECT TST-FILE7 ASSIGN TO OUTPUT "F7". - DATA DIVISION. - FILE SECTION. - FD TST-FILE1. - 01 TST1-REC PIC X(4). - FD TST-FILE2. - 01 TST2-REC PIC X(4). - FD TST-FILE3. - 01 TST3-REC PIC X(4). - FD TST-FILE4. - 01 TST4-REC PIC X(4). - FD TST-FILE5. - 01 TST5-REC PIC X(4). - FD TST-FILE6. - 01 TST6-REC PIC X(4). - FD TST-FILE7. - 01 TST7-REC PIC X(4). - PROCEDURE DIVISION. - OPEN INPUT TST-FILE1. - CLOSE TST-FILE1. - OPEN INPUT TST-FILE2. - CLOSE TST-FILE2. - OPEN INPUT TST-FILE3. - CLOSE TST-FILE3. - OPEN INPUT TST-FILE4. - CLOSE TST-FILE4. - OPEN INPUT TST-FILE5. - CLOSE TST-FILE5. - OPEN INPUT TST-FILE6. - CLOSE TST-FILE6. - OPEN INPUT TST-FILE7. - CLOSE TST-FILE7. - STOP RUN. -]) - -AT_CHECK([$COMPILE_ONLY -std=acu prog.cob], [0], [], []) - -AT_CLEANUP - - -AT_SETUP([ASSIGN to variable]) -AT_KEYWORDS([file]) - -# Valid ASSIGNs -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - INPUT-OUTPUT SECTION. - FILE-CONTROL. - SELECT test-file-1 ASSIGN TO var-1 - ORGANIZATION IS SEQUENTIAL. - SELECT test-file-2 ASSIGN USING var-2 - ORGANIZATION IS SEQUENTIAL. - SELECT test-file-3 ASSIGN TO VARYING var-3 - ORGANIZATION IS SEQUENTIAL. - SELECT test-file-4 ASSIGN DISK USING var-4 - ORGANIZATION IS SEQUENTIAL. - SELECT test-file-5 ASSIGN DYNAMIC DISK var-5 - ORGANIZATION IS SEQUENTIAL. - SELECT test-file-6 ASSIGN DISK FROM var-6 - ORGANIZATION IS SEQUENTIAL. - DATA DIVISION. - FILE SECTION. - FD test-file-1. - 01 test-rec-1 PIC X(4). - FD test-file-2. - 01 test-rec-2 PIC X(4). - FD test-file-3. - 01 test-rec-3 PIC X(4). - FD test-file-4. - 01 test-rec-4 PIC X(4). - FD test-file-5. - 01 test-rec-5 PIC X(4). - FD test-file-6. - 01 test-rec-6 PIC X(4). - WORKING-STORAGE SECTION. - 01 var-1 PIC X(255). - 01 var-2 PIC X(255). - 01 var-3 PIC X(255). - 01 var-4 PIC X(255). - 01 var-5 PIC X(255). - 01 var-6 PIC X(255). - PROCEDURE DIVISION. - OPEN INPUT test-file-1 - CLOSE test-file-1 - OPEN INPUT test-file-2 - CLOSE test-file-2 - OPEN INPUT test-file-3 - CLOSE test-file-3 - OPEN INPUT test-file-4 - CLOSE test-file-4 - OPEN INPUT test-file-5 - CLOSE test-file-5 - OPEN INPUT test-file-6 - CLOSE test-file-6 - . -]) - -# Invalid assigns -AT_DATA([prog2.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - INPUT-OUTPUT SECTION. - FILE-CONTROL. - SELECT test-file-1 ASSIGN USING not-a-var - ORGANIZATION IS SEQUENTIAL. - SELECT test-file-2 ASSIGN DYNAMIC not-a-var - ORGANIZATION IS SEQUENTIAL. - SELECT test-file-3 ASSIGN DISK FROM not-a-var - ORGANIZATION IS SEQUENTIAL. - DATA DIVISION. - FILE SECTION. - FD test-file-1. - 01 test-rec-1 PIC X(4). - FD test-file-2. - 01 test-rec-2 PIC X(4). - FD test-file-3. - 01 test-rec-3 PIC X(4). - PROCEDURE DIVISION. - OPEN INPUT test-file-1 - CLOSE test-file-1 - OPEN INPUT test-file-2 - CLOSE test-file-2 - OPEN INPUT test-file-3 - CLOSE test-file-3 - . -]) - -AT_CHECK([$COMPILE_ONLY -fassign-variable=warning -fassign-using-variable=warning -fassign-ext-dyn=warning -fassign-disk-from=warning prog.cob], [0], [], -[prog.cob:10: warning: ASSIGN USING/VARYING variable used -prog.cob:12: warning: ASSIGN USING/VARYING variable used -prog.cob:14: warning: ASSIGN USING/VARYING variable used -prog.cob:15: warning: ASSIGN EXTERNAL/DYNAMIC used -prog.cob:18: warning: ASSIGN DISK FROM used -prog.cob:7: warning: ASSIGN variable used -]) -AT_CHECK([$COMPILE_ONLY prog2.cob], [1], [], -[prog2.cob:11: error: 'not-a-var' is not defined -prog2.cob:9: error: 'not-a-var' is not defined -prog2.cob:7: error: 'not-a-var' is not defined -]) - -AT_CLEANUP - - -AT_SETUP([SELECT without ASSIGN]) -AT_KEYWORDS([file]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - INPUT-OUTPUT SECTION. - FILE-CONTROL. - SELECT TEST-FILE - ORGANIZATION IS SEQUENTIAL. - DATA DIVISION. - FILE SECTION. - FD TEST-FILE. - 01 TEST-REC PIC X(4). - PROCEDURE DIVISION. - OPEN INPUT TEST-FILE. - CLOSE TEST-FILE. - STOP RUN. -]) - -AT_CHECK([$COMPILE_ONLY prog.cob], [1], [], -[prog.cob:7: error: ASSIGN clause is required for file 'TEST-FILE' -]) - -AT_CLEANUP - - -AT_SETUP([START on SEQUENTIAL file]) -AT_KEYWORDS([file]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - INPUT-OUTPUT SECTION. - FILE-CONTROL. - SELECT TEST-FILE ASSIGN "./TEST-FILE" - ORGANIZATION IS SEQUENTIAL. - SELECT TEST-FILE2 ASSIGN "./TEST-FILE" - ORGANIZATION IS LINE SEQUENTIAL. - DATA DIVISION. - FILE SECTION. - FD TEST-FILE. - 01 TEST-REC PIC X(4). - FD TEST-FILE2. - 01 TEST-REC2 PIC X(4). - PROCEDURE DIVISION. - OPEN INPUT TEST-FILE TEST-FILE2 - START TEST-FILE KEY EQUAL TEST-REC - END-START - START TEST-FILE2 KEY EQUAL TEST-REC2 - END-START - CLOSE TEST-FILE TEST-FILE2 - STOP RUN. -]) - -AT_CHECK([$COMPILE_ONLY prog.cob], [1], [], -[prog.cob:19: error: START not allowed on SEQUENTIAL files -prog.cob:21: error: START not allowed on SEQUENTIAL files -]) - -AT_CLEANUP - - -AT_SETUP([OPEN SEQUENTIAL file REVERSED]) -AT_KEYWORDS([file]) - -# FIXME: only allowed for INPUT + sequential files (currently not checked). -# If added we likely can allow this for LINE SEQUENTIAL, too. - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - INPUT-OUTPUT SECTION. - FILE-CONTROL. - SELECT TEST-FILE ASSIGN "./TEST-FILE" - ORGANIZATION IS SEQUENTIAL. - DATA DIVISION. - FILE SECTION. - FD TEST-FILE. - 01 TEST-REC PIC X(4). - PROCEDURE DIVISION. - OPEN INPUT TEST-FILE - READ TEST-FILE NEXT - END-READ - CLOSE TEST-FILE - OPEN INPUT TEST-FILE REVERSED - READ TEST-FILE NEXT - END-READ - CLOSE TEST-FILE - OPEN INPUT TEST-FILE WITH LOCK REVERSED - READ TEST-FILE NEXT - END-READ - CLOSE TEST-FILE - STOP RUN. -]) - -AT_CHECK([$COMPILE_ONLY prog.cob], [0], [], -[prog.cob:18: warning: OPEN REVERSED is not implemented -prog.cob:22: warning: OPEN REVERSED is not implemented -]) - -# note: as soon as implemented: won't be obsolete in GnuCOBOL, but leave message for now... -AT_CHECK([$COMPILE_ONLY -Werror=obsolete prog.cob], [1], [], -[prog.cob:18: error [[-Werror]]: OPEN REVERSED is obsolete in GnuCOBOL -prog.cob:22: error [[-Werror]]: OPEN REVERSED is obsolete in GnuCOBOL -]) - -AT_CLEANUP - - -AT_SETUP([OPEN SEQUENTIAL file NO REWIND]) -AT_KEYWORDS([file]) - -# FIXME: only allowed for INPUT/OUTPUT sequential files (currently not checked). - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - INPUT-OUTPUT SECTION. - FILE-CONTROL. - SELECT TEST-FILE ASSIGN "./TEST-FILE" - ORGANIZATION IS SEQUENTIAL. - DATA DIVISION. - FILE SECTION. - FD TEST-FILE. - 01 TEST-REC PIC X(4). - PROCEDURE DIVISION. - OPEN OUTPUT TEST-FILE NO REWIND - WRITE TEST-REC FROM "tEsT" - END-WRITE - WRITE TEST-REC FROM "TeSt" - END-WRITE - CLOSE TEST-FILE WITH NO REWIND - OPEN INPUT TEST-FILE WITH LOCK WITH NO REWIND - READ TEST-FILE NEXT *> should get EOF - END-READ - CLOSE TEST-FILE - STOP RUN. -]) - -AT_CHECK([$COMPILE_ONLY prog.cob], [0], [], -[prog.cob:14: warning: OPEN WITH NO REWIND is not implemented -prog.cob:20: warning: OPEN WITH NO REWIND is not implemented -]) - -AT_CLEANUP - - -AT_SETUP([valid key items]) -AT_KEYWORDS([file record alternate]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - INPUT-OUTPUT SECTION. - FILE-CONTROL. - SELECT TEST-SOME ASSIGN TO 'FILE-TEST' - ORGANIZATION IS INDEXED - ACCESS MODE IS DYNAMIC - RECORD KEY IS TEST-P2 IN TEST-SOME - ALTERNATE KEY IS TEST-P3 IN TEST-SOME. - SELECT TEST-FILE ASSIGN TO 'FILE-TEST2' - ORGANIZATION IS INDEXED - ACCESS MODE IS DYNAMIC - RECORD KEY IS TEST-P1 - ALTERNATE KEY IS TEST-P4. - DATA DIVISION. - FILE SECTION. - FD TEST-SOME. - 01 SOME-REC. - 05 TEST-P2 PIC S9(4) COMP. - 05 TEST-P3 PIC S9(5) COMP-3. - FD TEST-FILE. - 01 TEST-REC. - 05 TEST-P1 PIC X(4). - 05 FILLER PIC X(4). - 05 TEST-P4 PIC X(4). - WORKING-STORAGE SECTION. - 01 WS-REC. - 05 TEST-P2 PIC S9(4) COMP. - 05 TEST-P3 PIC S9(5) COMP-3. - PROCEDURE DIVISION. - OPEN INPUT TEST-FILE - CLOSE TEST-FILE - OPEN OUTPUT TEST-SOME - MOVE CORRESPONDING WS-REC TO SOME-REC - WRITE SOME-REC - CLOSE TEST-SOME - * - STOP RUN. -]) - -AT_CHECK([$COMPILE_ONLY prog.cob], [0], [], []) - -AT_CLEANUP - - -AT_SETUP([INDEXED file invalid key items]) -AT_KEYWORDS([record ALTERNATE split]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - INPUT-OUTPUT SECTION. - FILE-CONTROL. - SELECT TEST-SOME ASSIGN TO 'FILE-TEST' - ORGANIZATION IS INDEXED - ACCESS MODE IS DYNAMIC - RECORD KEY IS TEST-P2 - ALTERNATE KEY IS TEST-P1 - ALTERNATE KEY IS TEST-P3. - SELECT TEST-FILE ASSIGN TO 'FILE-TEST2' - ORGANIZATION IS INDEXED - ACCESS MODE IS DYNAMIC - RECORD KEY IS TEST-P1 - ALTERNATE KEY IS TEST-P4 - ALTERNATE KEY IS NOT-THERE - ALTERNATE KEY IS SOME-REC. - SELECT TEST-MORE ASSIGN TO 'FILE-TEST-EXT' - ORGANIZATION IS INDEXED - ACCESS MODE IS DYNAMIC - RECORD KEY IS NOT-HERE-KEY - SOURCE IS NOT-IN-FILE1 - NOT-IN-FILE2. - DATA DIVISION. - FILE SECTION. - FD TEST-SOME. - 01 SOME-REC PIC X(20). - FD TEST-FILE. - 01 TEST-REC. - 05 TEST-P1 PIC X(4). - 05 FILLER PIC X(4). - 05 TEST-P4 PIC X(4). - FD TEST-MORE. - 01 MORE-REC. - 05 MORE-DATA PIC X(4). - WORKING-STORAGE SECTION. - 77 TEST-P2 PIC S9(4) COMP. - 77 TEST-P3 PIC S9(5) COMP-3. - PROCEDURE DIVISION. - OPEN INPUT TEST-FILE. - CLOSE TEST-FILE. - STOP RUN. -]) - -# FIXME: "is not defined" should be changed in "is not defined in file ..." -AT_CHECK([$COMPILE_ONLY prog.cob], [1], [], -[prog.cob:10: error: 'TEST-P2' is not defined -prog.cob:11: error: 'TEST-P1' is not defined -prog.cob:12: error: 'TEST-P3' is not defined -prog.cob:18: error: 'NOT-THERE' is not defined -prog.cob:13: error: invalid KEY item 'SOME-REC', not in file 'TEST-FILE' -prog.cob:24: error: 'NOT-IN-FILE1' is not defined -prog.cob:20: error: invalid KEY item 'NOT-HERE-KEY', not in file 'TEST-MORE' -prog.cob:25: error: 'NOT-IN-FILE2' is not defined -]) - -AT_CLEANUP - - -AT_SETUP([variable record length]) -AT_KEYWORDS([file]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - INPUT-OUTPUT SECTION. - FILE-CONTROL. - SELECT TEST-FILE ASSIGN TO 'FILE-TEST' - ORGANIZATION IS SEQUENTIAL. - DATA DIVISION. - FILE SECTION. - FD TEST-FILE - RECORD IS VARYING IN SIZE - RECORD CONTAINS 1 TO 1250 CHARACTERS. - 01 TEST-REC. - 05 TEST-P1 PIC X(4). - 05 TEST-P2 PIC S9(4) COMP. - 05 TEST-P3 PIC S9(5) COMP-3. - 05 TEST-P4 PIC S9(5). - 05 TEST-P5 PIC S9(2) BINARY. - 05 FILLER PIC X(129). - PROCEDURE DIVISION. - OPEN INPUT TEST-FILE. - CLOSE TEST-FILE. - STOP RUN. -]) - -AT_DATA([prog2.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog2. - ENVIRONMENT DIVISION. - INPUT-OUTPUT SECTION. - FILE-CONTROL. - SELECT TEST-FILE ASSIGN TO 'FILE-TEST' - ORGANIZATION IS INDEXED - ACCESS MODE IS DYNAMIC - RECORD KEY IS TEST-P2 - ALTERNATE KEY IS TEST-P1 - ALTERNATE KEY IS TEST-P3. - DATA DIVISION. - FILE SECTION. - FD TEST-FILE - RECORD IS VARYING IN SIZE - FROM 2 TO 1250 CHARACTERS. - 01 TEST-REC. - 05 TEST-P1 PIC X(4). - 05 TEST-P2 PIC S9(4) COMP. - 05 TEST-P3 PIC S9(5) COMP-3. - 05 TEST-P4 PIC S9(5). - 05 TEST-P5 PIC S9(2) BINARY. - 05 FILLER PIC X(129). - 01 RECORDSIZE PIC X(04). - PROCEDURE DIVISION. - OPEN INPUT TEST-FILE. - CLOSE TEST-FILE. - STOP RUN. -]) - -AT_DATA([prog3.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog3. - ENVIRONMENT DIVISION. - INPUT-OUTPUT SECTION. - FILE-CONTROL. - SELECT TEST-FILE ASSIGN TO 'FILE-TEST' - ORGANIZATION IS SEQUENTIAL. - DATA DIVISION. - FILE SECTION. - FD TEST-FILE - RECORD CONTAINS 5 TO 10 CHARACTERS. - 01 TEST-REC-1. - 05 FILLER PIC X(4). - 01 TEST-REC-2. - 05 FILLER PIC X(50). - PROCEDURE DIVISION. - OPEN INPUT TEST-FILE. - CLOSE TEST-FILE. - STOP RUN. -]) - -AT_CHECK([$COMPILE_ONLY prog.cob], [1], [], -[prog.cob:13: error: duplicate RECORD clause -]) - -AT_CHECK([$COMPILE_ONLY -frelax-syntax-checks prog.cob], [0], [], -[prog.cob:13: warning: duplicate RECORD clause -]) - -AT_CHECK([$COMPILE_ONLY prog2.cob], [1], [], -[prog2.cob:20: error: minimal record length 2 can not hold the key item 'TEST-P2'; needs to be at least 6 -prog2.cob:19: error: minimal record length 2 can not hold the key item 'TEST-P1'; needs to be at least 4 -prog2.cob:21: error: minimal record length 2 can not hold the key item 'TEST-P3'; needs to be at least 9 -]) - -AT_CHECK([$COMPILE_ONLY -std=cobol2014 prog3.cob], [1], [], -[prog3.cob:13: error: size of record 'TEST-REC-1' (4) smaller than minimum of file 'TEST-FILE' (5) -prog3.cob:15: error: size of record 'TEST-REC-2' (50) larger than maximum of file 'TEST-FILE' (10) -]) - -AT_CHECK([$COMPILE_ONLY prog3.cob], [0], [], -[prog3.cob:13: warning: size of record 'TEST-REC-1' (4) smaller than minimum of file 'TEST-FILE' (5) -prog3.cob:13: warning: file size adjusted -prog3.cob:15: warning: size of record 'TEST-REC-2' (50) larger than maximum of file 'TEST-FILE' (10) -prog3.cob:15: warning: file size adjusted -]) - -AT_CLEANUP - - -AT_SETUP([variable record length DEPENDING item]) -AT_KEYWORDS([file]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - INPUT-OUTPUT SECTION. - FILE-CONTROL. - SELECT TEST-FILE ASSIGN TO 'FILE-TEST' - ORGANIZATION IS SEQUENTIAL. - SELECT TEST-FIL2 ASSIGN TO 'FILE-TEST-2' - ORGANIZATION IS SEQUENTIAL. - SELECT TEST-FIL3 ASSIGN TO 'FILE-TEST-3' - ORGANIZATION IS SEQUENTIAL. - SELECT TEST-FIL4 ASSIGN TO 'FILE-TEST-4' - ORGANIZATION IS SEQUENTIAL. - DATA DIVISION. - FILE SECTION. - FD TEST-FILE - RECORD IS VARYING IN SIZE - FROM 12 TO 125 CHARACTERS - DEPENDING ON RECORDSIZE. - 01 TEST-REC. - 05 FILLER PIC X(40). - FD TEST-FIL2 - RECORD IS VARYING IN SIZE - FROM 20 TO 250 CHARACTERS - DEPENDING ON TEST-FILE. - 01 TEST-REC2. - 05 FILLER PIC X(129). - 05 RECORDSIZE3 PIC 9(04). - 05 RECORDSIZE4 PIC X(04). - FD TEST-FIL3 - RECORD IS VARYING IN SIZE - FROM 40 TO 50 CHARACTERS - DEPENDING ON RECORDSIZE3. - 01 TEST-REC3. - 05 FILLER PIC X(50). - FD TEST-FIL4 - RECORD IS VARYING IN SIZE - FROM 1 TO 2 CHARACTERS - DEPENDING ON RECORDSIZE4. - 01 TEST-REC4. - 05 FILLER PIC X(2). - PROCEDURE DIVISION. - OPEN INPUT TEST-FILE. - CLOSE TEST-FILE. - OPEN INPUT TEST-FIL2. - CLOSE TEST-FIL2. - OPEN INPUT TEST-FIL3. - CLOSE TEST-FIL3. - OPEN INPUT TEST-FIL4. - CLOSE TEST-FIL4. - STOP RUN. -]) - -# FIXME: the check misses "prog.cob:40: error: RECORD DEPENDING item must be unsigned numeric" -AT_CHECK([$COMPILE_ONLY prog.cob], [1], [], -[prog.cob:20: error: 'RECORDSIZE' is not defined -prog.cob:26: error: RECORD DEPENDING must reference a data-item -prog.cob:34: error: RECORD DEPENDING item 'RECORDSIZE3' should be defined in WORKING-STORAGE, LOCAL-STORAGE or LINKAGE SECTION -prog.cob:40: error: RECORD DEPENDING item 'RECORDSIZE4' should be defined in WORKING-STORAGE, LOCAL-STORAGE or LINKAGE SECTION -]) -AT_CHECK([$COMPILE_ONLY -frelax-syntax-checks prog.cob], [1], [], -[prog.cob:20: error: 'RECORDSIZE' is not defined -prog.cob:26: error: RECORD DEPENDING must reference a data-item -prog.cob:34: warning: RECORD DEPENDING item 'RECORDSIZE3' should be defined in WORKING-STORAGE, LOCAL-STORAGE or LINKAGE SECTION -prog.cob:40: warning: RECORD DEPENDING item 'RECORDSIZE4' should be defined in WORKING-STORAGE, LOCAL-STORAGE or LINKAGE SECTION -]) - -AT_CLEANUP - - -AT_SETUP([DECLARATIVES invalid procedure reference (1)]) -AT_KEYWORDS([file]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - INPUT-OUTPUT SECTION. - FILE-CONTROL. - SELECT GO-FILE ASSIGN "./TEST-FILE" - ORGANIZATION IS LINE SEQUENTIAL. - SELECT PERF-FILE ASSIGN "./TEST-FILE" - ORGANIZATION IS LINE SEQUENTIAL. - DATA DIVISION. - FILE SECTION. - FD GO-FILE. - 01 GO-REC PIC X(4). - FD PERF-FILE. - 01 PERF-REC PIC X(4). - PROCEDURE DIVISION. - DECLARATIVES. - G01 SECTION. - USE AFTER ERROR PROCEDURE ON GO-FILE. - G02. - DISPLAY "OK" - END-DISPLAY. - GO TO GG02. - P01 SECTION. - USE AFTER ERROR PROCEDURE ON PERF-FILE. - P02. - DISPLAY "OK" - END-DISPLAY. - * programs may do this -> nothing happens there with PERF-FILE - PERFORM PPOK. - * programs should not do this - * (the compiler currently cannot distinguish this) - PERFORM PP02. - END DECLARATIVES. - GG01 SECTION. - GG02. - OPEN INPUT GO-FILE. - CLOSE GO-FILE. - PP01 SECTION. - PP02. - OPEN INPUT PERF-FILE. - CLOSE PERF-FILE. - PP03. - DISPLAY 'LOG OUTPUT HERE'. - PPOK. - STOP RUN. -]) - -AT_CHECK([$COMPILE_ONLY -Wno-dialect prog.cob], [0], [], []) - -AT_CHECK([$COMPILE_ONLY prog.cob], [0], [], -[prog.cob: in section 'G01': -prog.cob: in paragraph 'G02': -prog.cob:24: warning: 'GG02' is not in DECLARATIVES -prog.cob: in section 'P01': -prog.cob: in paragraph 'P02': -prog.cob:31: warning: 'PPOK' is not in DECLARATIVES -prog.cob:34: warning: 'PP02' is not in DECLARATIVES -]) - -AT_CHECK([$COMPILE_ONLY -freference-out-of-declaratives=ok prog.cob], [0], [], []) - -AT_CHECK([$COMPILE_ONLY -std=cobol2014 prog.cob], [1], [], -[prog.cob: in section 'G01': -prog.cob: in paragraph 'G02': -prog.cob:24: error: 'GG02' is not in DECLARATIVES -prog.cob: in section 'P01': -prog.cob: in paragraph 'P02': -prog.cob:31: error: 'PPOK' is not in DECLARATIVES -prog.cob:34: error: 'PP02' is not in DECLARATIVES -]) - -AT_CHECK([$COMPILE_ONLY -std=cobol2014 -frelax-syntax prog.cob], [0], [], -[prog.cob: in section 'G01': -prog.cob: in paragraph 'G02': -prog.cob:24: warning: 'GG02' is not in DECLARATIVES -prog.cob: in section 'P01': -prog.cob: in paragraph 'P02': -prog.cob:31: warning: 'PPOK' is not in DECLARATIVES -prog.cob:34: warning: 'PP02' is not in DECLARATIVES -]) - -AT_CLEANUP - - -AT_SETUP([DECLARATIVES invalid procedure reference (2)]) -AT_KEYWORDS([file]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - INPUT-OUTPUT SECTION. - FILE-CONTROL. - SELECT TEST-FILE ASSIGN "./TEST-FILE" - ORGANIZATION IS LINE SEQUENTIAL. - DATA DIVISION. - FILE SECTION. - FD TEST-FILE. - 01 TEST-REC PIC X(4). - PROCEDURE DIVISION. - DECLARATIVES. - P01 SECTION. - USE AFTER ERROR PROCEDURE ON TEST-FILE. - P02. - DISPLAY "OK" - END-DISPLAY. - END DECLARATIVES. - PP01 SECTION. - PP02. - OPEN INPUT TEST-FILE. - CLOSE TEST-FILE. - PERFORM P02. - GO TO P02. - STOP RUN. -]) - -AT_CHECK([$COMPILE_ONLY prog.cob], [1], [], -[prog.cob: in section 'PP01': -prog.cob: in paragraph 'PP02': -prog.cob:26: error: invalid reference to 'P02' (in DECLARATIVES) -]) - -AT_CLEANUP - - -AT_SETUP([EXTERNAL file]) -AT_KEYWORDS([file]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - - ENVIRONMENT DIVISION. - INPUT-OUTPUT SECTION. - FILE-CONTROL. - SELECT my-file - ASSIGN TO "somefile" - ORGANIZATION IS SEQUENTIAL. - - DATA DIVISION. - FILE SECTION. - FD my-file EXTERNAL. - 01 my-record. - 03 my-record-data PIC X(80). - - PROCEDURE DIVISION. - GOBACK. -]) - -AT_CHECK([$COMPILE_ONLY prog.cob], [0], [], []) -AT_CLEANUP - - -AT_SETUP([RECORDING MODE]) -AT_KEYWORDS([file extensions]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - - ENVIRONMENT DIVISION. - INPUT-OUTPUT SECTION. - FILE-CONTROL. - SELECT f ASSIGN "f.dat" LINE SEQUENTIAL. - - DATA DIVISION. - FILE SECTION. - FD f RECORDING MODE IS U. - 01 x PIC X. - - PROCEDURE DIVISION. - OPEN INPUT f - CLOSE f - . -]) - -AT_CHECK([$COMPILE_ONLY prog.cob], [1], [], -[prog.cob:12: error: RECORDING MODE U or S can only be used with RECORD SEQUENTIAL files -]) -AT_CLEANUP - - -AT_SETUP([CODE-SET clause]) -AT_KEYWORDS([file]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - - ENVIRONMENT DIVISION. - CONFIGURATION SECTION. - SPECIAL-NAMES. - ALPHABET A IS ASCII. - - INPUT-OUTPUT SECTION. - FILE-CONTROL. - SELECT f, ASSIGN "f.dat", LINE SEQUENTIAL. - SELECT g, ASSIGN "g.dat", LINE SEQUENTIAL. - - DATA DIVISION. - FILE SECTION. - FD f CODE-SET A. - 01 f-rec PIC X(10). - - FD g CODE-SET foo. - 01 g-rec PIC X(10). -]) - -AT_CHECK([$COMPILE_ONLY prog.cob], [1], [], -[prog.cob:17: warning: ignoring CODE-SET 'A' -prog.cob:20: error: 'foo' is not defined -prog.cob:20: error: 'foo' is not an alphabet-name -]) -AT_CLEANUP - - -AT_SETUP([CODE-SET FOR clause]) -AT_KEYWORDS([file extensions]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - - ENVIRONMENT DIVISION. - CONFIGURATION SECTION. - SPECIAL-NAMES. - ALPHABET A IS EBCDIC. - - INPUT-OUTPUT SECTION. - FILE-CONTROL. - SELECT f ASSIGN "f.dat" LINE SEQUENTIAL. - - DATA DIVISION. - FILE SECTION. - FD f CODE-SET A FOR x, y, z. - 01 x. - 03 y PIC X(10). - 01 x-2. - 03 z PIC X(10). -]) - -AT_CHECK([$COMPILE_ONLY prog.cob], [1], [], -[prog.cob:16: warning: FOR sub-records is not implemented -prog.cob:16: warning: CODE-SET is not implemented -prog.cob:16: error: FOR item 'x' is a record -prog.cob:16: error: FOR item 'z' is in different record to 'x' -]) -AT_CLEANUP - - -AT_SETUP([WRITE / REWRITE FROM clause and FILE]) -AT_KEYWORDS([file record condition-name level-88 88]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - INPUT-OUTPUT SECTION. - FILE-CONTROL. - SELECT TEST-FILE ASSIGN TO 'FILE-TEST' - ORGANIZATION IS INDEXED - ACCESS MODE IS DYNAMIC - RECORD KEY IS TEST-P1. - DATA DIVISION. - FILE SECTION. - FD TEST-FILE. - 01 TEST-REC. - 05 TEST-P1 PIC X(4). - 05 TEST-P2 PIC S9(4) COMP. - WORKING-STORAGE SECTION. - 01 SOME-REC PIC X(04). - 88 SOME-VAL VALUE 'ABCD'. - PROCEDURE DIVISION. - OPEN I-O TEST-FILE. - WRITE SOME-VAL. - WRITE SOME-REC. - WRITE TEST-REC. - WRITE TEST-REC FROM SOME-REC. - WRITE TEST-FILE. - WRITE FILE TEST-REC. - WRITE FILE TEST-FILE. - WRITE FILE TEST-FILE FROM TEST-REC. - WRITE FILE TEST-FILE FROM SOME-REC. - REWRITE SOME-VAL. - REWRITE SOME-REC. - REWRITE TEST-REC. - REWRITE TEST-REC FROM SOME-REC. - REWRITE TEST-FILE. - REWRITE FILE TEST-REC. - REWRITE FILE TEST-FILE. - REWRITE FILE TEST-FILE FROM TEST-REC. - REWRITE FILE TEST-FILE FROM SOME-REC. - CLOSE TEST-FILE. - STOP RUN. -]) - -AT_CHECK([$COMPILE_ONLY prog.cob], [1], [], -[prog.cob:22: error: condition-name not allowed here: 'SOME-VAL' -prog.cob:23: error: WRITE subject does not refer to a record name -prog.cob:26: error: WRITE requires a record name as subject -prog.cob:27: error: 'TEST-REC' is not a file name -prog.cob:28: error: WRITE FILE requires a FROM clause -prog.cob:31: error: condition-name not allowed here: 'SOME-VAL' -prog.cob:32: error: REWRITE subject does not refer to a record name -prog.cob:35: error: REWRITE requires a record name as subject -prog.cob:36: error: 'TEST-REC' is not a file name -prog.cob:37: error: REWRITE FILE requires a FROM clause -]) -AT_CLEANUP - - -AT_SETUP([Clauses following invalid ACCESS clause]) -AT_KEYWORDS([file]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - - ENVIRONMENT DIVISION. - INPUT-OUTPUT SECTION. - FILE-CONTROL. - SELECT testfile - ASSIGN TO filename - ORGANIZATION RELATIVE - ACCESS IS sequentia - STATUS IS stat. -]) - -AT_CHECK([$COMPILE_ONLY prog.cob], [1], [], -[prog.cob:11: error: syntax error, unexpected Identifier, expecting DYNAMIC or RANDOM or SEQUENTIAL -prog.cob:8: error: missing file description for FILE testfile -prog.cob:13: warning: variable 'filename' will be implicitly defined -]) -AT_CLEANUP - - -AT_SETUP([RELATIVE KEY type checks]) -AT_KEYWORDS([RELATIVE FILE]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - INPUT-OUTPUT SECTION. - FILE-CONTROL. - SELECT FILE1 ASSIGN DISK - ORGANIZATION RELATIVE ACCESS MODE RANDOM - RELATIVE KEY FILE1-KEY. - SELECT FILE2 ASSIGN DISK - ORGANIZATION RELATIVE ACCESS MODE RANDOM - RELATIVE KEY FILE2-KEY. - SELECT FILE3 ASSIGN DISK - ORGANIZATION RELATIVE ACCESS MODE RANDOM - RELATIVE KEY FILE3-KEY. - SELECT FILE4 ASSIGN DISK - ORGANIZATION RELATIVE ACCESS MODE RANDOM - RELATIVE KEY FILE4-KEY. - SELECT FILE5 ASSIGN DISK - ORGANIZATION RELATIVE ACCESS MODE RANDOM - RELATIVE KEY FILE5-KEY. - DATA DIVISION. - FILE SECTION. - FD FILE1. - 01 FILE1-REC PIC X. - FD FILE2. - 01 FILE2-REC PIC X. - FD FILE3. - 01 FILE3-REC PIC X. - FD FILE4. - 01 FILE4-REC. - 05 FLD1 PIC X. - 05 FILE4-KEY PIC 999. - FD FILE5. - 01 FILE5-REC PIC X. - WORKING-STORAGE SECTION. - 77 FILE1-KEY PIC XXXX. - 01 FILE2-KEY. - 05 F2-KEY PIC 9(5). - 01 F3-KEY. - 05 FILE3-KEY PIC 9(5) OCCURS 2 TIMES. - 77 FILE5-KEY PIC 999V9. - PROCEDURE DIVISION. - STOP RUN. -]) - -AT_CHECK([$COMPILE_ONLY prog.cob], [1], [], -[prog.cob:9: error: file FILE1: RELATIVE KEY FILE1-KEY is not numeric -prog.cob:12: error: file FILE2: RELATIVE KEY FILE2-KEY is not numeric -prog.cob:15: error: file FILE3: RELATIVE KEY FILE3-KEY cannot have OCCURS -prog.cob:18: error: RELATIVE KEY FILE4-KEY cannot be in file record belonging to FILE4 -prog.cob:21: error: file FILE5: RELATIVE KEY FILE5-KEY must be integer -]) - -AT_CLEANUP - - -AT_SETUP([Mismatched KEY clause]) -AT_KEYWORDS([file RELATIVE INDEXED]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - INPUT-OUTPUT SECTION. - FILE-CONTROL. - SELECT file-1 ASSIGN DISK, - INDEXED, RELATIVE KEY file-1-key. - SELECT file-2 ASSIGN DISK, - RELATIVE, RECORD KEY file-2-key. -]) - -AT_CHECK([$COMPILE_ONLY prog.cob], [1], [], -[prog.cob:8: error: cannot use RELATIVE KEY clause on INDEXED files -prog.cob:10: error: cannot use RECORD KEY clause on RELATIVE files -prog.cob:7: error: missing file description for FILE file-1 -prog.cob:8: error: 'file-1-key' is not defined -prog.cob:9: error: missing file description for FILE file-2 -prog.cob:10: error: 'file-2-key' is not defined -]) - -AT_CLEANUP - - -AT_SETUP([RECORD DELIMITER]) -AT_KEYWORDS([file]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - - ENVIRONMENT DIVISION. - INPUT-OUTPUT SECTION. - FILE-CONTROL. - *> Valid. - SELECT good-1 ASSIGN "a" - RECORD DELIMITER LINE-SEQUENTIAL. - - SELECT good-2 ASSIGN "a" - SEQUENTIAL - RECORD DELIMITER LINE-SEQUENTIAL. - - SELECT good-3 ASSIGN "a" - RECORD DELIMITER LINE-SEQUENTIAL - LINE SEQUENTIAL. - - SELECT good-4 ASSIGN "a" - RECORD DELIMITER BINARY-SEQUENTIAL. - - *> Warning. - SELECT ok-i-guess-1 ASSIGN "a" - RECORD DELIMITER STANDARD-1. - - SELECT ok-i-guess-2 ASSIGN "a" - RECORD DELIMITER THE-END-OF-THE-WORLD. - - *> Not valid. - SELECT bad-1 ASSIGN "a" - RECORD DELIMITER LINE-SEQUENTIAL - INDEXED - RECORD KEY bad-1-rec. - - SELECT bad-2 ASSIGN "a" - INDEXED - RECORD KEY bad-2-rec - RECORD DELIMITER LINE-SEQUENTIAL. - - SELECT bad-3 ASSIGN "a" - LINE SEQUENTIAL - RECORD DELIMITER BINARY-SEQUENTIAL. - - SELECT bad-4 ASSIGN "a" - LINE SEQUENTIAL - RECORD DELIMITER STANDARD-1. - - SELECT bad-5 ASSIGN "a" - RECORD DELIMITER BINARY-SEQUENTIAL. - - DATA DIVISION. - FILE SECTION. - FD good-1. - 01 good-1-rec PIC 9. - 01 good-1-rec-2 PIC 99. - - FD good-2 RECORD VARYING FROM 1 TO 5 CHARACTERS. - 01 good-2-rec PIC 9. - - FD good-3. - 01 good-3-rec PIC 9. - 01 good-3-rec-2 PIC 99. - - FD good-4 RECORD CONTAINS 1 TO 5 CHARACTERS. - 01 good-4-rec PIC 9. - - FD ok-i-guess-1. - 01 ok-i-guess-1-rec PIC 9. - 01 ok-i-guess-1-rec-2 PIC 99. - - FD ok-i-guess-2. - 01 ok-i-guess-2-rec PIC 9. - 01 ok-i-guess-2-rec-2 PIC 99. - - FD bad-1. - 01 bad-1-rec PIC 9. - - FD bad-2. - 01 bad-2-rec PIC 9. - - FD bad-3. - 01 bad-3-rec PIC 9. - - FD bad-4. - 01 bad-4-rec PIC 9. - - FD bad-5 RECORD CONTAINS 1 CHARACTERS. - 01 bad-5-rec PIC 9. -]) - -AT_CHECK([$COMPILE_ONLY -frecord-delim-with-fixed-recs=warning prog.cob], [1], [], -[prog.cob:25: warning: RECORD DELIMITER STANDARD-1 ignored -prog.cob:28: warning: RECORD DELIMITER THE-END-OF-THE-WORLD not recognized; will be ignored -prog.cob:33: error: ORGANIZATION INDEXED is incompatible with RECORD DELIMITER -prog.cob:39: error: RECORD DELIMITER LINE-SEQUENTIAL only allowed with (LINE) SEQUENTIAL files -prog.cob:36: error: RECORD clause is invalid for file 'bad-2' (file type) -prog.cob:43: error: RECORD DELIMITER BINARY-SEQUENTIAL only allowed with SEQUENTIAL files -prog.cob:47: error: RECORD DELIMITER STANDARD-1 only allowed with SEQUENTIAL files -prog.cob:79: warning: RECORD DELIMITER clause on file with fixed-length records used -prog.cob:82: warning: RECORD DELIMITER clause on file with fixed-length records used -prog.cob:85: warning: RECORD DELIMITER clause on file with fixed-length records used -prog.cob:88: warning: RECORD DELIMITER clause on file with fixed-length records used -prog.cob:90: warning: RECORD DELIMITER clause on file with fixed-length records used -]) -AT_CLEANUP - - -AT_SETUP([FILE STATUS]) -AT_KEYWORDS([file status]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - INPUT-OUTPUT SECTION. - FILE-CONTROL. - SELECT file1 ASSIGN TO 'FILE-TEST' - ORGANIZATION IS INDEXED - ACCESS MODE IS DYNAMIC - RECORD KEY IS file1-key - STATUS IS STATUS-1. - SELECT file2 ASSIGN TO 'FILE-TEST' - ORGANIZATION IS INDEXED - ACCESS MODE IS DYNAMIC - RECORD KEY IS file2-key - STATUS IS STATUS-1, STATUS-2. - DATA DIVISION. - FILE SECTION. - FD FILE1. - 01 FILE1-REC. - 05 FILE1-KEY PIC X. - FD FILE2. - 01 FILE2-REC. - 05 FILE2-KEY PIC 9. - 05 FILE2-DAT PIC X. - WORKING-STORAGE SECTION. - 77 STATUS-1 PIC X(02). - 77 STATUS-2 PIC X(06). - PROCEDURE DIVISION. - STOP RUN. -]) - -AT_CHECK([$COMPILE_ONLY prog.cob], [1], [], -[prog.cob:16: error: VSAM STATUS does not conform to GnuCOBOL -]) - -AT_CHECK([$COMPILE_ONLY -frelax-syntax-checks prog.cob], [0], [], -[prog.cob:16: warning: VSAM STATUS ignored -]) - -AT_CHECK([$COMPILE_ONLY -std=ibm-strict prog.cob], [0], [], -[prog.cob:16: warning: VSAM STATUS ignored -]) - -AT_CLEANUP - - -AT_SETUP([INDEXED file PASSWORD clause]) -AT_KEYWORDS([file external split key]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - INPUT-OUTPUT SECTION. - FILE-CONTROL. - SELECT file1 ASSIGN TO 'FILE-TEST' - ORGANIZATION IS INDEXED - ACCESS MODE IS DYNAMIC - RECORD KEY IS file1-key PASSWORD IS PASS1 - STATUS IS FSTAT. - SELECT file2 ASSIGN TO 'FILE-TEST-EXT' - ORGANIZATION IS INDEXED - ACCESS MODE IS DYNAMIC - RECORD KEY IS file2-key PASSWORD IS PASS2 - ALTERNATE RECORD KEY IS NOTHEREKEY - SOURCE IS file2-dat file2-key - PASSWORD IS PASS-EXT - STATUS IS FSTAT. - DATA DIVISION. - FILE SECTION. - FD FILE1. - 01 FILE1-REC. - 05 FILE1-KEY PIC X. - FD FILE2 EXTERNAL. - 01 FILE2-REC. - 05 FILE2-KEY PIC 9. - 05 FILE2-DAT PIC X. - WORKING-STORAGE SECTION. - 77 FSTAT PIC X(02). - *> note: IBM specifies PASSWORDs are cut at / space filled to 8 bytes - 77 PASS1 PIC X(08). - 77 PASS2 PIC X(10). - 77 PASS-EXT PIC X(04) EXTERNAL. - PROCEDURE DIVISION. - STOP RUN. -]) - -AT_CHECK([$COMPILE_ONLY prog.cob], [1], [], -[prog.cob:10: warning: PASSWORD clause is not implemented -prog.cob:15: warning: PASSWORD clause is not implemented -prog.cob:18: warning: PASSWORD clause is not implemented -prog.cob:15: error: PASSWORD 'PASS2' for EXTERNAL file 'file2' must have EXTERNAL attribute -]) - -AT_CLEANUP - - -AT_SETUP([RECORD clause equal limits]) -AT_KEYWORDS([file]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - - ENVIRONMENT DIVISION. - INPUT-OUTPUT SECTION. - FILE-CONTROL. - SELECT f1 ASSIGN "f1". - SELECT f2 ASSIGN "f2". - SELECT f3 ASSIGN "f3". - SELECT f4 ASSIGN "f4". - - DATA DIVISION. - FILE SECTION. - FD f1 RECORD VARYING. - 01 f1-rec-1 PIC X. - 01 f1-rec-2 PIC 9. - - FD f2 RECORD VARYING 1 TO 1. - 01 f2-rec PIC X. - - FD f3 RECORD 1 TO 1. - 01 f3-rec PIC X. - - FD f4 RECORD IS VARYING IN SIZE. - 01 f4-rec-1 PIC X. - 01 f4-rec-2 PIC 99. -]) - -AT_CHECK([$COMPILE_ONLY -frecords-mismatch-record-clause=error prog.cob], [1], [], -[prog.cob:19: error: file 'f1': RECORD VARYING specified without limits, but implied limits are equal -prog.cob:19: error: RECORD clause invalid -prog.cob:22: error: RECORD clause invalid -]) -AT_CLEANUP - - -AT_SETUP([FILE ... FROM literal]) -AT_KEYWORDS([file]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - - ENVIRONMENT DIVISION. - INPUT-OUTPUT SECTION. - FILE-CONTROL. - SELECT f ASSIGN TO "ssad". - - DATA DIVISION. - FILE SECTION. - FD f. - 01 f-rec PIC 999999. - - WORKING-STORAGE SECTION. - 01 num PIC 9(6) VALUE 123456. - - PROCEDURE DIVISION. - OPEN OUTPUT f - WRITE FILE f FROM zero - WRITE FILE f FROM 0 - WRITE FILE f FROM "abc" - REWRITE FILE f FROM zero - REWRITE FILE f FROM 0 - REWRITE FILE f FROM "abc" - CLOSE f - . -]) - -# FIXME: the references to ZERO should actually show one less - -AT_CHECK([$COMPILE_ONLY prog.cob], [1], [], -[prog.cob:21: error: figurative constants not allowed in FROM clause -prog.cob:21: error: literal in FROM clause must be alphanumeric, national or boolean -prog.cob:22: warning: numeric value is expected -prog.cob:13: warning: 'f-rec' defined here as PIC 999999 -prog.cob:24: error: figurative constants not allowed in FROM clause -prog.cob:24: error: literal in FROM clause must be alphanumeric, national or boolean -prog.cob:25: warning: numeric value is expected -prog.cob:13: warning: 'f-rec' defined here as PIC 999999 -]) -AT_CHECK([$COMPILE_ONLY -frelax-syntax-checks prog.cob], [0], [], -[prog.cob:22: warning: numeric value is expected -prog.cob:13: warning: 'f-rec' defined here as PIC 999999 -prog.cob:25: warning: numeric value is expected -prog.cob:13: warning: 'f-rec' defined here as PIC 999999 -]) -AT_CHECK([$COMPILE_ONLY -std=mf-strict prog.cob], [0], [], -[prog.cob:22: warning: source is non-numeric - substituting zero -prog.cob:25: warning: source is non-numeric - substituting zero -]) - -AT_CLEANUP - - - -AT_SETUP([WRITE / REWRITE on LINE SEQUENTIAL files]) -AT_KEYWORDS([file]) -AT_XFAIL_IF(true) - -# FIXME: this should be depending on a compilation flag, -# see reportwriter branch for this feature - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - - ENVIRONMENT DIVISION. - INPUT-OUTPUT SECTION. - FILE-CONTROL. - SELECT f ASSIGN TO "ssad" LINE SEQUENTIAL. - - DATA DIVISION. - FILE SECTION. - FD f. - 01 f-rec PIC X(05). - - PROCEDURE DIVISION. - OPEN OUTPUT f - WRITE FILE f FROM "abc" - REWRITE FILE f FROM "abc" - CLOSE f - . -]) - -AT_CHECK([$COMPILE_ONLY prog.cob], [1], [], -[prog.cob:18: error: REWRITE not allowed on LINE SEQUENTIAL files -]) -AT_CLEANUP - - - -AT_SETUP([WRITE / REWRITE on REPORT files]) -AT_KEYWORDS([file]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - - ENVIRONMENT DIVISION. - INPUT-OUTPUT SECTION. - FILE-CONTROL. - SELECT f ASSIGN TO "ssad" LINE SEQUENTIAL. - - DATA DIVISION. - FILE SECTION. - FD f REPORT f-rep. - 01 f-rec PIC X(05). - - REPORT SECTION. - RD f-rep. - 01 f-rep-line TYPE DE PIC XXX. - - PROCEDURE DIVISION. - OPEN OUTPUT f - WRITE FILE f FROM "abc" - REWRITE FILE f FROM "abc" - CLOSE f - . -]) - -AT_CHECK([$COMPILE_ONLY prog.cob], [1], [], -[prog.cob:21: error: WRITE not allowed on REPORT files -prog.cob:22: error: REWRITE not allowed on REPORT files -]) -AT_CLEANUP - - - -AT_SETUP([SELECT without fd-name]) -AT_KEYWORDS([file]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - - ENVIRONMENT DIVISION. - INPUT-OUTPUT SECTION. - FILE-CONTROL. - SELECT ASSIGN "asd". -]) - -AT_CHECK([$COMPILE_ONLY prog.cob], [1], [], -[prog.cob:8: error: syntax error, unexpected ASSIGN, expecting Identifier -prog.cob:8: error: syntax error, unexpected Literal -]) -AT_CLEANUP - -AT_SETUP([Undeclared FILE-ID variable]) -AT_KEYWORDS([file]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - INPUT-OUTPUT SECTION. - FILE-CONTROL. - SELECT file1 ASSIGN DISK. - DATA DIVISION. - FILE SECTION. - FD file1 VALUE OF FILE-ID fid-file1. - 01 file1-rec PIC X. - PROCEDURE DIVISION. - STOP RUN. -]) - -AT_CHECK([$COMPILE_ONLY prog.cob], [0], [], -[prog.cob:10: warning: VALUE OF is obsolete in GnuCOBOL -prog.cob:12: warning: variable 'fid-file1' will be implicitly defined -]) -AT_CLEANUP - - -AT_SETUP([Undeclared FILE STATUS variable]) -AT_KEYWORDS([file]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - INPUT-OUTPUT SECTION. - FILE-CONTROL. - SELECT file1 ASSIGN DISK - STATUS fs. - DATA DIVISION. - FILE SECTION. - FD file1. - 1 file1-rec pic x. - PROCEDURE DIVISION. - STOP RUN. -]) - -AT_CHECK([$COMPILE_ONLY prog.cob], [1], [], -[prog.cob:8: error: 'fs' is not defined -]) -AT_CLEANUP - - -AT_SETUP([FILE STATUS field subordinate to FD]) -AT_KEYWORDS([file]) - -AT_XFAIL_IF(true) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - INPUT-OUTPUT SECTION. - FILE-CONTROL. - SELECT file1 ASSIGN DISK - STATUS fs. - DATA DIVISION. - FILE SECTION. - FD file1. - 01 file1-rec. - 02 filler pic x. - 02 fs pic xx. - PROCEDURE DIVISION. - STOP RUN. -]) - -AT_CHECK([$COMPILE_ONLY prog.cob], [1], [], -[prog.cob: NOT DETECTED AT COMPILE TIME -]) -AT_CLEANUP - - -AT_SETUP([FILE STATUS not PIC XX]) -AT_KEYWORDS([file]) - -AT_XFAIL_IF(true) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - - ENVIRONMENT DIVISION. - INPUT-OUTPUT SECTION. - FILE-CONTROL. - SELECT file1 ASSIGN DISK - STATUS fs-1. - SELECT file2 ASSIGN DISK - STATUS fs-2. - - DATA DIVISION. - FILE SECTION. - FD file1. - 01 file1-rec PIC x. - - FD file2. - 01 file2-rec PIC X. - - WORKING-STORAGE SECTION. - 01 fs-1 PIC XXX. - 01 fs-2 PIC 99. - - PROCEDURE DIVISION. - STOP RUN. -]) - -AT_CHECK([$COMPILE_ONLY prog.cob], [1], [], -[prog.cob: NOT DETECTED AT COMPILE TIME -]) -AT_CLEANUP - - -AT_SETUP([DELETE with LINE SEQUENTIAL]) -AT_KEYWORDS([file]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - INPUT-OUTPUT SECTION. - FILE-CONTROL. - SELECT file1 ASSIGN DISK ORGANIZATION LINE SEQUENTIAL. - DATA DIVISION. - FILE SECTION. - FD file1. - 01 file1-rec PIC X. - PROCEDURE DIVISION. - OPEN I-O file1. - DELETE file1. - CLOSE file1. -]) - -AT_CHECK([$COMPILE_ONLY prog.cob], [1], [], -[prog.cob:14: error: DELETE not allowed on LINE SEQUENTIAL files -]) - -AT_CLEANUP - - -AT_SETUP([DELETE with SEQUENTIAL]) -AT_KEYWORDS([file]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - INPUT-OUTPUT SECTION. - FILE-CONTROL. - SELECT file1 ASSIGN DISK ORGANIZATION SEQUENTIAL. - DATA DIVISION. - FILE SECTION. - FD file1. - 01 file1-rec PIC X. - PROCEDURE DIVISION. - OPEN I-O file1. - DELETE file1. - CLOSE file1. -]) - -AT_CHECK([$COMPILE_ONLY prog.cob], [1], [], -[prog.cob:14: error: DELETE not allowed on SEQUENTIAL files -]) - -AT_CLEANUP - -AT_SETUP([ACCESS RANDOM with ORG SEQUENTIAL]) -AT_KEYWORDS([file]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - INPUT-OUTPUT SECTION. - FILE-CONTROL. - SELECT file1 ASSIGN DISK ORGANIZATION SEQUENTIAL - ACCESS RANDOM. - DATA DIVISION. - FILE SECTION. - FD file1. - 01 file1-rec PIC X. - PROCEDURE DIVISION. - STOP RUN. -]) - -# TO-DO: Improve error message - say ACCESS RANDOM is incompatible with ORGANIZATION SEQUENTIAL. -AT_CHECK([$COMPILE_ONLY prog.cob], [1], [], -[prog.cob:7: error: ORGANIZATION clause is invalid for file 'file1' -]) - -AT_CLEANUP - - -AT_SETUP([ALTERNATE RECORD KEY SUPPRESS WHEN]) -AT_KEYWORDS([file]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - INPUT-OUTPUT SECTION. - FILE-CONTROL. - SELECT TEST-FILE - ASSIGN "TESTFILE" - ACCESS DYNAMIC - ORGANIZATION INDEXED - RECORD KEY TESTKEY-P1 - ALTERNATE RECORD KEY TESTKEY-P2 - WITH DUPLICATES - SUPPRESS WHEN ZEROES - ALTERNATE RECORD KEY TESTKEY-P3 - WITH DUPLICATES - SUPPRESS WHEN SPACES - ALTERNATE RECORD KEY TESTKEY-P4 - WITH DUPLICATES - SUPPRESS WHEN ALL "A" - ALTERNATE RECORD KEY TESTKEY-P5 - WITH DUPLICATES - SUPPRESS WHEN ALL SPACES - . - DATA DIVISION. - FILE SECTION. - FD TEST-FILE. - 01 TEST-REC. - 03 TESTKEY-P1 PIC X(4). - 03 TESTKEY-P2 PIC 9(4). - 03 TESTDATA PIC X(4). - 03 TESTKEY-P3 PIC X(4). - 03 TESTKEY-P4 PIC X(4). - 03 TESTKEY-P5 PIC X(4). - PROCEDURE DIVISION. - STOP RUN. -]) - -AT_CHECK([$COMPILE_ONLY -std=mf prog.cob], [0], [], []) -AT_CLEANUP - - -AT_SETUP([RECORD definition with SOURCE IS / =]) -AT_KEYWORDS([file]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - INPUT-OUTPUT SECTION. - FILE-CONTROL. - SELECT TEST-FILE1 - ASSIGN "TESTFILE" - ACCESS DYNAMIC - ORGANIZATION INDEXED - RECORD KEY TESTKEY-P1 OF TEST-REC1 - ALTERNATE RECORD KEY - TEST1KEY2 = TESTKEY-P2 OF TEST-REC1, - TESTKEY-P3 OF TEST-REC1 - WITH DUPLICATES - . - SELECT TEST-FILE2 - ASSIGN "TESTFILE" - ACCESS DYNAMIC - ORGANIZATION INDEXED - RECORD KEY TESTKEY-P1 OF TEST-REC2 - ALTERNATE RECORD KEY - TEST2KEY2 SOURCE IS TESTKEY-P2 OF TEST-REC2, - TESTKEY-P3 OF TEST-REC2 - WITH DUPLICATES - . - DATA DIVISION. - FILE SECTION. - FD TEST-FILE1. - 01 TEST-REC1. - 03 TESTKEY-P1 PIC X(4). - 03 TESTKEY-P2 PIC 9(4). - 03 TESTDATA PIC X(4). - 03 TESTKEY-P3 PIC X(4). - FD TEST-FILE2. - 01 TEST-REC2. - 03 TESTKEY-P1 PIC X(4). - 03 TESTKEY-P2 PIC 9(4). - 03 TESTDATA PIC X(4). - 03 TESTKEY-P3 PIC X(4). - PROCEDURE DIVISION. - STOP RUN. -]) - -AT_CHECK([$COMPILE_ONLY prog.cob], [0], [], []) -AT_CLEANUP - - -AT_SETUP([ALTERNATE RECORD definition WITH NO DUPLICATES]) -AT_KEYWORDS([file]) - -AT_XFAIL_IF([true]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - INPUT-OUTPUT SECTION. - FILE-CONTROL. - SELECT TEST-FILE - ASSIGN "TESTFILE" - ACCESS DYNAMIC - ORGANIZATION INDEXED - RECORD KEY TESTKEY1 - ALTERNATE RECORD KEY TESTKEY2 - WITH DUPLICATES - ALTERNATE RECORD KEY TESTKEY3 - WITH NO DUPLICATES - . -]) - -AT_CHECK([$COMPILE_ONLY prog.cob], [1], [], -[prog.cob:7: error: missing file description for FILE TEST-FILE -prog.cob:11: error: 'TESTKEY1' is not defined -prog.cob:12: error: 'TESTKEY2' is not defined -prog.cob:14: error: 'TESTKEY3' is not defined -]) -AT_CHECK([$COMPILE_ONLY -frelax-syntax prog.cob], [0], [], []) -AT_CLEANUP - - -AT_SETUP([ALTERNATE RECORD definition omitting RECORD]) -AT_KEYWORDS([file]) - -AT_XFAIL_IF([true]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - INPUT-OUTPUT SECTION. - FILE-CONTROL. - SELECT TEST-FILE - ASSIGN "TESTFILE" - ACCESS DYNAMIC - ORGANIZATION INDEXED - RECORD KEY TESTKEY1 - ALTERNATE KEY TESTKEY2 - . - PROCEDURE DIVISION. - STOP RUN. -]) - -AT_CHECK([$COMPILE_ONLY prog.cob], [1], [], -[prog.cob:7: error: missing file description for FILE TEST-FILE -prog.cob:11: error: 'TESTKEY1' is not defined -prog.cob:12: error: 'TESTKEY2' is not defined -]) -AT_CHECK([$COMPILE_ONLY -frelax-syntax prog.cob], [0], [], []) -AT_CLEANUP - - -AT_SETUP([SELECT/OPEN syntax extensions]) -AT_KEYWORDS([file SELECT OPEN MASS-UPDATE BULK-ADDITION LOCK]) - -# FIXME: split tests, possibly add dialect configuration, -# add checks for "mutually exclusive" and ORGANIZATION - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - INPUT-OUTPUT SECTION. - FILE-CONTROL. - SELECT TEST-FILE1 - ASSIGN "TESTFILE1" - *> WITH ENCRYPTION shift/reduce conflict ? - ORGANIZATION INDEXED - ACCESS DYNAMIC - RECORD KEY TESTKEY-1P1 - WITH DUPLICATES - ALTERNATE RECORD KEY TESTKEY-1P2 - WITH NO DUPLICATES - LOCK EXCLUSIVE MASS-UPDATE - . - SELECT TEST-FILE2 - ASSIGN "TESTFILE2" - *> ENCRYPTION shift/reduce conflict ? - ORGANIZATION INDEXED - ACCESS DYNAMIC - RECORD KEY TESTKEY-2P1 - WITH NO DUPLICATES - ALTERNATE RECORD KEY TESTKEY-2P2 - WITH DUPLICATES - . - DATA DIVISION. - FILE SECTION. - FD TEST-FILE1. - 01 TEST-REC1. - 03 TESTKEY-1P1 PIC X(4). - 03 TESTKEY-1P2 PIC 9(4). - 03 ENCRYPTION PIC X(4). - FD TEST-FILE2. - 01 TEST-REC2. - 03 TESTKEY-2P1 PIC X(4). - 03 ALLOWING PIC X(4). - 03 TESTKEY-2P2 PIC 9(4). - PROCEDURE DIVISION. - OPEN EXCLUSIVE INPUT TEST-FILE2 - CLOSE TEST-FILE2 - OPEN I-O TEST-FILE1 TEST-FILE2 ALLOWING UPDATERS - CLOSE TEST-FILE1 - OPEN I-O TEST-FILE1 ALLOWING UPDATERS - CLOSE TEST-FILE1 - CLOSE TEST-FILE1 - OPEN I-O TEST-FILE1 ALLOWING READERS - CLOSE TEST-FILE1 - CLOSE TEST-FILE1 - OPEN I-O TEST-FILE1 ALLOWING WRITERS - CLOSE TEST-FILE1 - CLOSE TEST-FILE1 - OPEN I-O TEST-FILE1 ALLOWING ALL - CLOSE TEST-FILE1 - CLOSE TEST-FILE1 - OPEN I-O TEST-FILE1 ALLOWING NO - CLOSE TEST-FILE1 - OPEN I-O TEST-FILE1 ALLOWING NO OTHERS - CLOSE TEST-FILE1 - OPEN I-O TEST-FILE1 FOR LOCK - CLOSE TEST-FILE1 - OPEN I-O TEST-FILE1 LOCK - CLOSE TEST-FILE1 - OPEN I-O TEST-FILE1 BULK-ADDITION - CLOSE TEST-FILE1 - OPEN I-O TEST-FILE1 MASS-UPDATE - CLOSE TEST-FILE1 - * - STOP RUN. -]) - -AT_CHECK([$COMPILE_ONLY prog.cob], [0], [], -[prog.cob:13: warning: DUPLICATES for primary keys is not implemented -prog.cob:16: warning: WITH MASS-UPDATE is not implemented -prog.cob:65: warning: WITH BULK-ADDITION is not implemented -prog.cob:67: warning: WITH MASS-UPDATE is not implemented -]) -AT_CHECK([$COMPILE_ONLY -std=acu-strict prog.cob], [1], [], -[prog.cob:13: warning: DUPLICATES for primary keys is not implemented -prog.cob:16: warning: WITH MASS-UPDATE is not implemented -prog.cob:34: error: syntax error, unexpected ENCRYPTION -prog.cob:38: error: syntax error, unexpected ALLOWING -prog.cob:65: warning: WITH BULK-ADDITION is not implemented -prog.cob:67: warning: WITH MASS-UPDATE is not implemented -]) -AT_CLEANUP - - -AT_SETUP([GLOBAL FD nested progam]) -AT_KEYWORDS([file]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - - ENVIRONMENT DIVISION. - INPUT-OUTPUT SECTION. - FILE-CONTROL. - SELECT f ASSIGN "foo.dat" - ORGANIZATION INDEXED - RECORD KEY f-key. - - DATA DIVISION. - FILE SECTION. - FD f GLOBAL. - 01 f-rec GLOBAL. - 03 f-key PIC 9. - - PROCEDURE DIVISION. - CALL "output-statement". - - IDENTIFICATION DIVISION. - PROGRAM-ID. output-statement. - - PROCEDURE DIVISION. - WRITE f-rec. - END PROGRAM output-statement. - END PROGRAM prog. -]) - -# note: we actually want to check codegen -> C compilation here -AT_CHECK([$COMPILE -Wno-unsupported prog.cob], [0], [], []) - -AT_CLEANUP - - -AT_SETUP([XFD directive and creation]) -AT_KEYWORDS([file cobc sql SUPPRESS WHEN]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - - PROGRAM-ID. prog. - - ENVIRONMENT DIVISION. - CONFIGURATION SECTION. - - INPUT-OUTPUT SECTION. - FILE-CONTROL. - SELECT OPTIONAL TSPFILE - ASSIGN TO "testsql" - ORGANIZATION INDEXED ACCESS DYNAMIC - RECORD KEY IS PRIME-KEY - SOURCE IS CM-CUST-NUM - - ALTERNATE RECORD KEY IS SPLIT-KEY2 - SOURCE IS CM-TELEPHONE,CM-MACHINE WITH DUPLICATES - SUPPRESS WHEN "900" - - ALTERNATE RECORD KEY IS SPLIT-KEY3 - SOURCE IS CM-DISK,CM-DP-MGR,CM-MACHINE WITH DUPLICATES - SUPPRESS WHEN ALL "*" - FILE STATUS IS CUST-STAT - . - - DATA DIVISION. - FILE SECTION. - FD TSPFILE - BLOCK CONTAINS 5 RECORDS. - - $XFD NAME=tspfilex - 01 TSPFL-RECORD. - 05 TSPFL-REC. - $XFD USE GROUP CUSTNUM - 10 CM-CUST-NUM. - 15 CM-CUST-PRE PICTURE X(3). - 15 CM-CUST-NNN PICTURE X(5). - 10 CM-STATUS PICTURE X. - 10 CM-COMPANY PICTURE X(25). - $XFD USE GROUP VAR_LENGTH custaddr - 10 CM-ADDRESS. - 15 CM-ADDRESS-1 PICTURE X(25). - 15 CM-ADDRESS-2 PICTURE X(25). - 15 CM-ADDRESS-3 PICTURE X(25). - 10 CM-TELEPHONE PICTURE 9(10). - 10 CM-DP-MGR PICTURE X(25). - 10 CM-MACHINE PICTURE X(8). - 10 CM-MEMORY PICTURE X(4). - $XFD WHEN (CM-STATUS = 'A' && CM-TELEPHONE > 100) - $XFD AND CM-MACHINE = 'B' || CM-COMPANY = ' ' - 10 CM-MEMORYX REDEFINES CM-MEMORY. - 15 CM-MEMSZ PICTURE 9(2). - 15 CM-MEMUNIT PICTURE X(2). - 10 CM-DISK PICTURE X(8). - 10 CM-TAPE PICTURE X(8). - $XFD WHEN CM-STATUS = 'X' - 10 CM-TAPEX REDEFINES CM-TAPE PICTURE 9(8). - $XFD WHEN CM-STATUS = 'Y' - 10 CM-TAPEY REDEFINES CM-TAPE PICTURE 9(6)V99. - 10 CM-NO-TERMINALS PICTURE 9(5) BINARY. - 10 CM-COMPX PICTURE XXX COMP-X. - 10 CM-COMP5 PICTURE 9(7) COMP-5. - 10 CM-COMP1 COMP-1. - 10 CM-COMP2 COMP-2. - 10 CM-PRICE PICTURE 9(3)V99 COMP-3. - 10 CM-PRICES PICTURE S9(5)V99. - $XFD DATE "MMDDYYYY" - 10 CM-DATE PICTURE 9(8) COMP-3. - $XFD DATE "YYMMDDCC" - 10 CM-DATE2 PICTURE 9(8) COMP-3. - - WORKING-STORAGE SECTION. - - 01 CUST-STAT. - 05 STAT-1 PICTURE 9(4) COMP SYNC. - 05 FILLER REDEFINES STAT-1. - 10 STAT-X1 PIC X COMP-X. - 10 STAT-X2 PIC X COMP-X. - 77 BYTE-1 PICTURE 9(3). - 77 BYTE-2 PICTURE 9(3). - 77 MAX-SUB VALUE 16 PICTURE 9(5) COMP SYNC. - 77 DO-REWRITE PICTURE X VALUE 'N'. - 77 ENVVAR-IN PICTURE X(30). - 77 SAV-KEY PICTURE X(8). - 77 ENVVAR-OUT PICTURE X(60). - - 01 TEST-DATA. - - 02 DATA-CUST-NUM-TBL. - 05 FILLER PIC X(8) VALUE "ALP00000". - 05 FILLER PIC X(8) VALUE "BET00000". - 05 FILLER PIC X(8) VALUE "GAM00000". - 05 FILLER PIC X(8) VALUE "DEL00000". - 05 FILLER PIC X(8) VALUE "EPS00000". - 05 FILLER PIC X(8) VALUE "FOR00000". - 05 FILLER PIC X(8) VALUE "GIB00000". - 05 FILLER PIC X(8) VALUE "H&J00000". - 05 FILLER PIC X(8) VALUE "INC00000". - 05 FILLER PIC X(8) VALUE "JOH00000". - 05 FILLER PIC X(8) VALUE "KON00000". - 05 FILLER PIC X(8) VALUE "LEW00000". - 05 FILLER PIC X(8) VALUE "MOR00000". - 05 FILLER PIC X(8) VALUE "NEW00000". - 05 FILLER PIC X(8) VALUE "OLD00000". - 05 FILLER PIC X(8) VALUE "PRE00000". - - 02 DATA-CUST-NUM REDEFINES DATA-CUST-NUM-TBL - PIC X(8) OCCURS 16. - 02 DATA-COMPANY-TBL. - 05 FILLER PIC X(25) VALUE "ALPHA ELECTRICAL CO. LTD.". - 05 FILLER PIC X(25) VALUE "BETA SHOE MFG. INC. ". - 05 FILLER PIC X(25) VALUE "GAMMA X-RAY TECHNOLOGY ". - 05 FILLER PIC X(25) VALUE "DELTA LUGGAGE REPAIRS ". - 05 FILLER PIC X(25) VALUE "EPSILON EQUIPMENT SUPPLY ". - 05 FILLER PIC X(25) VALUE "FORTUNE COOKIE COMPANY ". - 05 FILLER PIC X(25) VALUE "GIBRALTER LIFE INSURANCE ". - 05 FILLER PIC X(25) VALUE "H & J PLUMBING SUPPLIES ". - 05 FILLER PIC X(25) VALUE "INCREMENTAL BACKUP CORP. ". - 05 FILLER PIC X(25) VALUE "JOHNSON BOATING SUPPLIES ". - 05 FILLER PIC X(25) VALUE "KONFLAB PLASTIC PRODUCTS.". - 05 FILLER PIC X(25) VALUE "LEWISTON GRAPHICS LTD. ". - 05 FILLER PIC X(25) VALUE "MORNINGSIDE CARPENTRY. ". - 05 FILLER PIC X(25) VALUE "NEW WAVE SURF SHOPS INC. ". - 05 FILLER PIC X(25) VALUE "OLD TYME PIZZA MFG. CO. ". - 05 FILLER PIC X(25) VALUE "PRESTIGE OFFICE FURNITURE". - - 02 DATA-COMPANY REDEFINES DATA-COMPANY-TBL - PIC X(25) OCCURS 16. - 02 DATA-ADDRESS-1-TBL. - 05 FILLER PIC X(25) VALUE "123 MAIN STREET ". - 05 FILLER PIC X(25) VALUE "1090 2ND AVE. WEST ". - 05 FILLER PIC X(25) VALUE "1401 JEFFERSON BLVD. ". - 05 FILLER PIC X(25) VALUE "1620 ARIZONA WAY ". - 05 FILLER PIC X(25) VALUE "1184 EAST FIRST STREET ". - 05 FILLER PIC X(25) VALUE "114 JOHN F. KENNEDY AVE. ". - 05 FILLER PIC X(25) VALUE "650 LIBERTY CRESCENT ". - 05 FILLER PIC X(25) VALUE "77 SUNSET BLVD. ". - 05 FILLER PIC X(25) VALUE "10908 SANTA MONICA BLVD. ". - 05 FILLER PIC X(25) VALUE "1134 PARIS ROAD ". - 05 FILLER PIC X(25) VALUE "808 NORTHWEST MAIN ST. ". - 05 FILLER PIC X(25) VALUE "9904 QUEEN STREET ". - 05 FILLER PIC X(25) VALUE "1709 DUNDAS CRESCENT W. ". - 05 FILLER PIC X(25) VALUE "3240 MARIS AVENUE ". - 05 FILLER PIC X(25) VALUE "1705 WISCONSIN ROAD ". - 05 FILLER PIC X(25) VALUE "114A MAPLE GROVE ". - - 02 DATA-ADDRESS-1 REDEFINES DATA-ADDRESS-1-TBL - PIC X(25) OCCURS 16. - 02 DATA-ADDRESS-2-TBL. - 05 FILLER PIC X(10) VALUE "NEW YORK ". - 05 FILLER PIC X(10) VALUE "ATLANTA ". - 05 FILLER PIC X(10) VALUE "WASHINGTON". - 05 FILLER PIC X(10) VALUE "TORONTO ". - 05 FILLER PIC X(10) VALUE "CALGARY ". - 05 FILLER PIC X(10) VALUE "SAN DIEGO ". - 05 FILLER PIC X(10) VALUE "LOS RIOS ". - 05 FILLER PIC X(10) VALUE "MADISON ". - 05 FILLER PIC X(10) VALUE "WILBUR ". - 05 FILLER PIC X(10) VALUE "TOPEKA ". - 05 FILLER PIC X(10) VALUE "SEATTLE ". - 05 FILLER PIC X(10) VALUE "NEW JERSEY". - 05 FILLER PIC X(10) VALUE "FORT WAYNE". - 05 FILLER PIC X(10) VALUE "COLUMBUS ". - 05 FILLER PIC X(10) VALUE "RICHMOND ". - 05 FILLER PIC X(10) VALUE "WHITEPLAIN". - - 02 DATA-ADDRESS-2 REDEFINES DATA-ADDRESS-2-TBL - PIC X(10) OCCURS 16. - 02 DATA-ADDRESS-3-TBL. - 05 FILLER PIC X(10) VALUE "N.Y. ". - 05 FILLER PIC X(10) VALUE "GEORGIA ". - 05 FILLER PIC X(10) VALUE "D.C. ". - 05 FILLER PIC X(10) VALUE "CANADA ". - 05 FILLER PIC X(10) VALUE "CANADA ". - 05 FILLER PIC X(10) VALUE "CALIFORNIA". - 05 FILLER PIC X(10) VALUE "NEW MEXICO". - 05 FILLER PIC X(10) VALUE "WISCONSIN ". - 05 FILLER PIC X(10) VALUE "DELAWARE ". - 05 FILLER PIC X(10) VALUE "KANSAS ". - 05 FILLER PIC X(10) VALUE "WASHINGTON". - 05 FILLER PIC X(10) VALUE "N.J. ". - 05 FILLER PIC X(10) VALUE "COLORADO ". - 05 FILLER PIC X(10) VALUE "OHIO ". - 05 FILLER PIC X(10) VALUE "VIRGINIA ". - 05 FILLER PIC X(10) VALUE "N.Y. ". - - 02 DATA-ADDRESS-3 REDEFINES DATA-ADDRESS-3-TBL - PIC X(10) OCCURS 16. - 02 DATA-TELEPHONE-TBL. - 05 FILLER PIC 9(10) VALUE 3131234432. - 05 FILLER PIC 9(10) VALUE 4082938498. - 05 FILLER PIC 9(10) VALUE 8372487274. - 05 FILLER PIC 9(10) VALUE 4169898509. - 05 FILLER PIC 9(10) VALUE 5292398745. - 05 FILLER PIC 9(10) VALUE 8009329492. - 05 FILLER PIC 9(10) VALUE 6456445643. - 05 FILLER PIC 9(10) VALUE 6546456333. - 05 FILLER PIC 9(10) VALUE 3455445444. - 05 FILLER PIC 9(10) VALUE 9006445643. - 05 FILLER PIC 9(10) VALUE 7456434355. - 05 FILLER PIC 9(10) VALUE 6554456433. - 05 FILLER PIC 9(10) VALUE 4169898509. - 05 FILLER PIC 9(10) VALUE 9004587453. - 05 FILLER PIC 9(10) VALUE 8787458374. - 05 FILLER PIC 9(10) VALUE 4169898509. - - 02 DATA-TELEPHONE REDEFINES DATA-TELEPHONE-TBL - PIC 9(10) OCCURS 16. - 02 DATA-DP-MGR-TBL. - 05 FILLER PIC X(20) VALUE "MR. DAVE HARRIS ". - 05 FILLER PIC X(20) VALUE "MS. JANICE SILCOX ". - 05 FILLER PIC X(20) VALUE "MR. ALLAN JONES ". - 05 FILLER PIC X(20) VALUE "MR. PETER MACKAY ". - 05 FILLER PIC X(20) VALUE "MRS. DONNA BREWER ". - 05 FILLER PIC X(20) VALUE "MR. MICHAEL SMYTHE ". - 05 FILLER PIC X(20) VALUE "MR. D.A. MORRISON ". - 05 FILLER PIC X(20) VALUE "MR. BRIAN PATTERSON ". - 05 FILLER PIC X(20) VALUE "MR. DARRYL TOWNSEND ". - 05 FILLER PIC X(20) VALUE "MS. VALERIE HARPER ". - 05 FILLER PIC X(20) VALUE "MR. FRED MILLER ". - 05 FILLER PIC X(20) VALUE "MR. DONALD FISCHER ". - 05 FILLER PIC X(20) VALUE "MR. STEVEN YOURDIN ". - 05 FILLER PIC X(20) VALUE "MS. Goldie Hawn ". - 05 FILLER PIC X(20) VALUE "MS. ALICE WINSTON ". - 05 FILLER PIC X(20) VALUE "MR. THOMAS JEFFERSON". - - 02 DATA-DP-MGR REDEFINES DATA-DP-MGR-TBL - PIC X(20) OCCURS 16. - 02 DATA-MACHINE-TBL. - 05 FILLER PIC X(8) VALUE "UNI-9030". - 05 FILLER PIC X(8) VALUE "UNI-9040". - 05 FILLER PIC X(8) VALUE "UNI-80/3". - 05 FILLER PIC X(8) VALUE "UNI-80/5". - 05 FILLER PIC X(8) VALUE "UNI-80/6". - 05 FILLER PIC X(8) VALUE "UNI-80/6". - 05 FILLER PIC X(8) VALUE "UNI-80/6". - 05 FILLER PIC X(8) VALUE "UNI-80/8". - 05 FILLER PIC X(8) VALUE "UNI-80/8". - 05 FILLER PIC X(8) VALUE "UNI-80/8". - 05 FILLER PIC X(8) VALUE "UNI-80/8". - 05 FILLER PIC X(8) VALUE "UNI-80/8". - 05 FILLER PIC X(8) VALUE "UNI-80/8". - 05 FILLER PIC X(8) VALUE "UNI-80/8". - 05 FILLER PIC X(8) VALUE "UNI-9040". - 05 FILLER PIC X(8) VALUE "UNI-9040". - - 02 DATA-MACHINE REDEFINES DATA-MACHINE-TBL - PIC X(8) OCCURS 16. - 02 DATA-NO-TERMINALS-TBL. - 05 FILLER PIC 9(3) COMP-3 VALUE 85. - 05 FILLER PIC 9(3) COMP-3 VALUE 34. - 05 FILLER PIC 9(3) COMP-3 VALUE 75. - 05 FILLER PIC 9(3) COMP-3 VALUE 45. - 05 FILLER PIC 9(3) COMP-3 VALUE 90. - 05 FILLER PIC 9(3) COMP-3 VALUE 107. - 05 FILLER PIC 9(3) COMP-3 VALUE 67. - 05 FILLER PIC 9(3) COMP-3 VALUE 32. - 05 FILLER PIC 9(3) COMP-3 VALUE 16. - 05 FILLER PIC 9(3) COMP-3 VALUE 34. - 05 FILLER PIC 9(3) COMP-3 VALUE 128. - 05 FILLER PIC 9(3) COMP-3 VALUE 64. - 05 FILLER PIC 9(3) COMP-3 VALUE 110. - 05 FILLER PIC 9(3) COMP-3 VALUE 324. - 05 FILLER PIC 9(3) COMP-3 VALUE 124. - 05 FILLER PIC 9(3) COMP-3 VALUE 86. - - 02 DATA-NO-TERMINALS REDEFINES DATA-NO-TERMINALS-TBL - PIC 9(3) COMP-3 OCCURS 16. - - 01 WORK-AREA. - 05 REC-NUM PICTURE 9(6) VALUE 0. - 05 REC-MAX PICTURE 9(6) VALUE 10. - 05 SUB PICTURE 9(4) COMP SYNC. - 88 ODD-RECORD VALUE 1 3 5 7 9 10 11. - 88 NULL-KEY VALUE 4 5 8 12 14. - - 05 TSPFL-KEY PICTURE X(8). - 01 CMD-LINE. - 05 CMD PICTURE X(3). - 05 FILLER PICTURE X. - 05 CMD-KEY PICTURE X(8). - - PROCEDURE DIVISION. - - MAINFILE. - ACCEPT CMD-LINE FROM COMMAND-LINE. - DISPLAY "IX_OPTIONS" UPON ENVIRONMENT-NAME - IF CMD = 'OCI' - OR CMD = 'OLK' - DISPLAY "format=oci" UPON ENVIRONMENT-VALUE - ELSE - DISPLAY "format=odbc" UPON ENVIRONMENT-VALUE. - IF CMD = 'LCK' - OR CMD = 'OLK' - OR CMD = 'SKP' - PERFORM LOCKTEST. - PERFORM LOADFILE. - PERFORM LISTFILE. - PERFORM REWRFILE. - PERFORM READFILE. - STOP RUN. - - LOADFILE. - DISPLAY "Loading sample data file." - UPON CONSOLE. - - OPEN EXCLUSIVE OUTPUT TSPFILE - IF CUST-STAT NOT = "00" - AND CUST-STAT NOT = "05" - DIVIDE STAT-1 BY 256 GIVING BYTE-1 REMAINDER BYTE-2 - DISPLAY "Error " CUST-STAT " " BYTE-1 " " BYTE-2 - " opening 'testisam' file" UPON CONSOLE - STOP RUN - END-IF. - - PERFORM 1000-LOAD-RECORD - VARYING SUB FROM 1 BY 1 - UNTIL SUB > MAX-SUB. - - DISPLAY "Sample data file load complete." - UPON CONSOLE. - CLOSE TSPFILE. - - REWRFILE. - DELETE FILE TSPFILE. - DISPLAY "Rewrite sample data file: " CUST-STAT - UPON CONSOLE. - - OPEN I-O TSPFILE - IF CUST-STAT NOT = "00" - AND CUST-STAT NOT = "05" - DIVIDE STAT-1 BY 256 GIVING BYTE-1 REMAINDER BYTE-2 - DISPLAY "Error " CUST-STAT " " BYTE-1 " " BYTE-2 - " opening 'testisam' file" - UPON CONSOLE - STOP RUN - END-IF. - - MOVE 'N' TO DO-REWRITE. - PERFORM 1000-LOAD-RECORD - VARYING SUB FROM 1 BY 1 - UNTIL SUB > MAX-SUB. - MOVE 'Y' TO DO-REWRITE. - PERFORM 1000-LOAD-RECORD - VARYING SUB FROM 1 BY 2 - UNTIL SUB > MAX-SUB. - MOVE 'N' TO DO-REWRITE. - - DISPLAY "Sample data file rewrite complete." - UPON CONSOLE. - CLOSE TSPFILE. - - *---------------------------------------------------------------* - * LOAD A RECORD FROM DATA TABLES * - *---------------------------------------------------------------* - - 1000-LOAD-RECORD. - - MOVE SPACES TO TSPFL-RECORD. - MOVE DATA-CUST-NUM (SUB) TO CM-CUST-NUM. - MOVE CM-CUST-NUM TO TSPFL-KEY. - MOVE DATA-COMPANY (SUB) TO CM-COMPANY. - MOVE DATA-ADDRESS-1 (SUB) TO CM-ADDRESS-1. - MOVE DATA-ADDRESS-2 (SUB) TO CM-ADDRESS-2. - MOVE DATA-ADDRESS-3 (SUB) TO CM-ADDRESS-3. - MOVE DATA-TELEPHONE (SUB) TO CM-TELEPHONE. - MOVE DATA-DP-MGR (SUB) TO CM-DP-MGR. - MOVE DATA-MACHINE (SUB) TO CM-MACHINE. - MOVE DATA-NO-TERMINALS (SUB) TO CM-NO-TERMINALS. - MOVE DATA-NO-TERMINALS (SUB) TO CM-COMPX. - MOVE DATA-NO-TERMINALS (SUB) TO CM-COMP5. - MOVE DATA-NO-TERMINALS (SUB) TO CM-COMP1. - MOVE DATA-NO-TERMINALS (SUB) TO CM-COMP2. - - IF ODD-RECORD - MOVE "8417" TO CM-DISK - MOVE "1600 BPI" TO CM-TAPE - MOVE 1.50 TO CM-PRICE - MOVE -91.50 TO CM-PRICES - MOVE 12192019 TO CM-DATE - MOVE 19121920 TO CM-DATE2 - MOVE "01MB" TO CM-MEMORY - ADD 3.12 TO CM-COMP2 - ELSE - MOVE "8470" TO CM-DISK - MOVE 7.50 TO CM-PRICE - MOVE -97.50 TO CM-PRICES - MOVE "6250 BPI" TO CM-TAPE - MOVE 04112022 TO CM-DATE - MOVE 22041120 TO CM-DATE2 - ADD 2.71 TO CM-COMP1 - MOVE "03GB" TO CM-MEMORY. - IF NULL-KEY - MOVE ALL "*" TO CM-DISK CM-DP-MGR CM-MACHINE - MOVE "X" TO CM-STATUS - MOVE ALL "7" TO CM-TAPE. - IF SUB = 1 OR 6 - MOVE "2417" TO CM-DISK - MOVE "549 mmm" TO CM-TAPE. - - IF DO-REWRITE = 'Y' - IF SUB NOT = 1 AND SUB NOT = 6 - MOVE "REWRITE" TO CM-DISK - END-IF - REWRITE TSPFL-RECORD - IF CUST-STAT NOT = "00" - AND CUST-STAT NOT = "02" - DISPLAY "REWRITE: " TSPFL-KEY ", Status: " - CUST-STAT UPON CONSOLE - END-IF - ELSE - WRITE TSPFL-RECORD - IF CUST-STAT NOT = "00" - AND CUST-STAT NOT = "02" - DISPLAY "WRITE: " TSPFL-KEY ", Status: " - CUST-STAT UPON CONSOLE - END-IF - END-IF. - - READFILE. - DISPLAY "READ SAMPLE FILE" UPON CONSOLE. - MOVE ZERO TO REC-NUM - OPEN I-O TSPFILE. - IF CUST-STAT NOT = "00" - DISPLAY "ERROR " CUST-STAT " OPENING INPUT FILE" - UPON CONSOLE - STOP RUN - END-IF. - COMMIT. - MOVE SPACES TO TSPFL-RECORD. - MOVE DATA-CUST-NUM (4) TO CM-CUST-NUM. - MOVE DATA-COMPANY (4) TO CM-COMPANY. - READ TSPFILE WITH NO LOCK - IF CUST-STAT NOT = "00" - DISPLAY "Error " CUST-STAT " on direct read of file" - UPON CONSOLE - CLOSE TSPFILE - STOP RUN - END-IF. - DISPLAY "Key: " CM-CUST-NUM " is " CM-COMPANY UPON CONSOLE - READ TSPFILE NEXT RECORD WITH NO LOCK - IF CUST-STAT NOT = "00" - DISPLAY "Error " CUST-STAT " on read next of file" - UPON CONSOLE - CLOSE TSPFILE - STOP RUN - END-IF. - DISPLAY "Key: " CM-CUST-NUM " is " CM-COMPANY UPON CONSOLE. - READ TSPFILE PREVIOUS RECORD WITH NO LOCK - IF CUST-STAT NOT = "00" - DISPLAY "Error " CUST-STAT " on read previous of file" - UPON CONSOLE - CLOSE TSPFILE - STOP RUN - END-IF. - DISPLAY "Key: " CM-CUST-NUM " is " CM-COMPANY UPON CONSOLE. - MOVE DATA-CUST-NUM (8) TO CM-CUST-NUM. - MOVE DATA-COMPANY (8) TO CM-COMPANY. - READ TSPFILE WITH LOCK - DISPLAY "Key: " CM-CUST-NUM " is " CM-COMPANY UPON CONSOLE. - READ TSPFILE NEXT RECORD WITH LOCK - IF CUST-STAT NOT = "00" - DISPLAY "Error " CUST-STAT " on read next lock of file" - UPON CONSOLE - CLOSE TSPFILE - STOP RUN - END-IF. - DISPLAY "Key: " CM-CUST-NUM " is " CM-COMPANY UPON CONSOLE. - MOVE CM-CUST-NUM TO SAV-KEY. - DELETE TSPFILE - IF CUST-STAT NOT = "00" - DISPLAY "Error " CUST-STAT " on DELETE " - UPON CONSOLE - CLOSE TSPFILE - STOP RUN - END-IF. - DISPLAY "Key: " CM-CUST-NUM " was deleted " UPON CONSOLE. - DELETE TSPFILE - DISPLAY "Error " CUST-STAT " on DUP DELETE " - UPON CONSOLE. - READ TSPFILE - IF CUST-STAT NOT = "00" - DISPLAY "Error " CUST-STAT " on reread of file" - UPON CONSOLE - ELSE - DISPLAY "Read:" CM-CUST-NUM " unexpected" UPON CONSOLE - END-IF. - REWRITE TSPFL-RECORD - DISPLAY "Error " CUST-STAT " on Bad REWRITE" - UPON CONSOLE. - * CLOSE TSPFILE. - * STOP RUN. - ROLLBACK. - MOVE SAV-KEY TO CM-CUST-NUM. - READ TSPFILE WITH LOCK - IF CUST-STAT NOT = "00" - DISPLAY "Error " CUST-STAT " on reread after Rollback" - UPON CONSOLE - ELSE - DISPLAY "Read Key: " CM-CUST-NUM " after Rollback" - END-IF. - MOVE SAV-KEY TO CM-CUST-NUM. - READ TSPFILE WITH NO LOCK - IF CUST-STAT NOT = "00" - DISPLAY "Error " CUST-STAT " on reread after Rollback" - UPON CONSOLE - END-IF. - CLOSE TSPFILE. - - LISTFILE. - DISPLAY "LIST SAMPLE FILE" UPON CONSOLE. - MOVE ZERO TO REC-NUM - OPEN INPUT TSPFILE - IF CUST-STAT NOT = "00" - DISPLAY "ERROR " CUST-STAT " OPENING INPUT FILE" - UPON CONSOLE - IF CUST-STAT (1:1) = "9" - DISPLAY "Sub Error " STAT-X2 UPON CONSOLE - END-IF - STOP RUN - END-IF. - MOVE SPACES TO TSPFL-RECORD. - MOVE DATA-CUST-NUM (4) TO CM-CUST-NUM. - READ TSPFILE WITH NO LOCK - IF CUST-STAT NOT = "00" - DISPLAY "Error " CUST-STAT " on direct read of file" - UPON CONSOLE - CLOSE TSPFILE - STOP RUN - END-IF. - DISPLAY "Key: " CM-CUST-NUM " is " CM-COMPANY UPON CONSOLE - IF CM-COMPANY = LOW-VALUES - DISPLAY "Error with direct read of file" UPON CONSOLE - CLOSE TSPFILE - STOP RUN - END-IF. - - MOVE SPACES TO TSPFL-RECORD. - START TSPFILE KEY GREATER THAN PRIME-KEY - IF CUST-STAT NOT = "00" - DISPLAY "Error " CUST-STAT " starting file" - UPON CONSOLE - CLOSE TSPFILE - STOP RUN - END-IF. - READ TSPFILE NEXT RECORD WITH NO LOCK - IF CUST-STAT NOT = "00" - DISPLAY "Error " CUST-STAT " on 1st read of file" - UPON CONSOLE - CLOSE TSPFILE - STOP RUN - END-IF. - PERFORM UNTIL CUST-STAT NOT = "00" - OR REC-NUM > REC-MAX - DISPLAY "Key: " CM-CUST-NUM " is " CM-COMPANY - " Disk=" CM-DISK "." - UPON CONSOLE - READ TSPFILE NEXT RECORD - AT END - MOVE "99" TO CUST-STAT - END-READ - ADD 1 TO REC-NUM - END-PERFORM - IF CUST-STAT = "99" - DISPLAY "Hit End of File" UPON CONSOLE - END-IF. - - DISPLAY "LIST SAMPLE FILE DESCENDING from " - CM-CUST-NUM UPON CONSOLE. - MOVE ZERO TO REC-NUM - START TSPFILE KEY LESS THAN PRIME-KEY - IF CUST-STAT NOT = "00" - DISPLAY "Error " CUST-STAT " starting file" - UPON CONSOLE - STOP RUN - END-IF. - READ TSPFILE PREVIOUS RECORD WITH NO LOCK - IF CUST-STAT NOT = "00" - DISPLAY "Error " CUST-STAT " on 1st read of file" - UPON CONSOLE - STOP RUN - END-IF. - PERFORM UNTIL CUST-STAT NOT = "00" - OR REC-NUM > REC-MAX - DISPLAY "Key: " CM-CUST-NUM " is " CM-COMPANY - " Disk=" CM-DISK "." - UPON CONSOLE - READ TSPFILE PREVIOUS RECORD - AT END - MOVE "99" TO CUST-STAT - END-READ - ADD 1 TO REC-NUM - END-PERFORM. - - DISPLAY "LIST SAMPLE FILE BY KEY2" UPON CONSOLE. - MOVE ZERO TO REC-NUM - MOVE SPACES TO TSPFL-RECORD. - START TSPFILE KEY GREATER THAN OR EQUAL TO SPLIT-KEY2 - IF CUST-STAT NOT = "00" - AND CUST-STAT NOT = "02" - DISPLAY "Error " CUST-STAT " starting file" - UPON CONSOLE - STOP RUN - END-IF. - READ TSPFILE NEXT RECORD WITH NO LOCK - IF CUST-STAT NOT = "00" - AND CUST-STAT NOT = "02" - DISPLAY "Error " CUST-STAT " on 1st read of file" - UPON CONSOLE - STOP RUN - END-IF. - PERFORM UNTIL (CUST-STAT NOT = "00" - AND CUST-STAT NOT = "02") - OR REC-NUM > REC-MAX - DISPLAY "Key: " CM-CUST-NUM - " Phone=" CM-TELEPHONE - " Machine=" CM-MACHINE - "." UPON CONSOLE - READ TSPFILE NEXT RECORD - AT END - MOVE "99" TO CUST-STAT - END-READ - ADD 1 TO REC-NUM - END-PERFORM. - CLOSE TSPFILE. - - DISPLAY "LIST SAMPLE FILE BY KEY3" UPON CONSOLE. - MOVE ZERO TO REC-NUM - MOVE SPACES TO TSPFL-RECORD. - START TSPFILE KEY GREATER THAN OR EQUAL TO SPLIT-KEY3 - IF CUST-STAT NOT = "00" - AND CUST-STAT NOT = "02" - DISPLAY "Error " CUST-STAT " starting file" - UPON CONSOLE - STOP RUN - END-IF. - READ TSPFILE NEXT RECORD WITH NO LOCK - IF CUST-STAT NOT = "00" - AND CUST-STAT NOT = "02" - DISPLAY "Error " CUST-STAT " on 1st read of file" - UPON CONSOLE - STOP RUN - END-IF. - PERFORM UNTIL (CUST-STAT NOT = "00" - AND CUST-STAT NOT = "02") - OR REC-NUM > REC-MAX - DISPLAY "Key: " CM-CUST-NUM - " Disk=" CM-DISK - " Mgr=" CM-DP-MGR - " Machine=" CM-MACHINE - "." UPON CONSOLE - READ TSPFILE NEXT RECORD - AT END - MOVE "99" TO CUST-STAT - END-READ - ADD 1 TO REC-NUM - END-PERFORM. - CLOSE TSPFILE. - - LOCKTEST. - DISPLAY "Locking record " CMD-KEY UPON CONSOLE. - MOVE ZERO TO REC-NUM - OPEN I-O TSPFILE. - IF CUST-STAT NOT = "00" - DISPLAY "ERROR " CUST-STAT " OPENING INPUT FILE" - UPON CONSOLE - STOP RUN - END-IF. - COMMIT. - MOVE SPACES TO TSPFL-RECORD. - MOVE CMD-KEY TO CM-CUST-NUM. - IF CMD = 'SKP' - DISPLAY "Read with SKIP " CMD-KEY - READ TSPFILE ADVANCING ON LOCK WITH LOCK - ELSE - DISPLAY "Read with LOCK " CMD-KEY - READ TSPFILE RETRY FOR 5 SECONDS WITH LOCK - END-IF. - IF CUST-STAT NOT = "00" - DISPLAY "Error " CUST-STAT " on read of " CMD-KEY - UPON CONSOLE - CLOSE TSPFILE - STOP RUN - END-IF. - DISPLAY "Hold: " CM-CUST-NUM " is " CM-COMPANY UPON CONSOLE - CALL "sleep" USING BY VALUE 20. - CLOSE TSPFILE. - STOP RUN. -]) - -# FIXME: currently the .ddl is always created, should be only upon request -AT_CHECK([$COMPILE -Wno-unsupported -fsqldb=mysql prog.cob], [0], [], []) - - -AT_CAPTURE_FILE(./tspfilex.ddl) - -AT_DATA([reference], [DROP TABLE tspfilex; -CREATE TABLE tspfilex ( - custnum CHAR(8) NOT NULL, - status CHAR(1), - company CHAR(25), - custaddr VARCHAR(75), - telephone DECIMAL(10) NOT NULL, - dp_mgr CHAR(25) NOT NULL, - machine CHAR(8) NOT NULL, - memory CHAR(4), - memsz DECIMAL(2), - memunit CHAR(2), - disk CHAR(8) NOT NULL, - tape CHAR(8), - tapex DECIMAL(8), - tapey DECIMAL(8,2), - no_terminals DECIMAL(5), - compx DECIMAL(8), - comp5 DECIMAL(7), - comp1 FLOAT(23), - comp2 FLOAT(53), - price DECIMAL(5,2), - prices DECIMAL(7,2), - date_x DATE, - date2 DATE -); -CREATE UNIQUE INDEX pk_tspfilex ON tspfilex (custnum); -CREATE INDEX k1_tspfilex ON tspfilex (telephone,machine); -CREATE INDEX k2_tspfilex ON tspfilex (disk,dp_mgr,machine); -]) - -AT_CHECK([diff reference tspfilex.ddl], [0], [], []) - - -AT_CAPTURE_FILE(./tspfilex.xd) - -AT_DATA([reference], -[# generation comment here -H,1,tspfilex,2,',','.',0,3 -D,1,'MMDDYYYY',8,1,0,,0,4:4,0:2,2:2,0:0,0:0,0:0,0:0 -D,2,'YYMMDDCC',8,1,0,,0,0:2,2:2,4:2,0:0,0:0,0:0,6:2 -F,0000,0008,20,0009,0,0,,10,custnum -F,0008,0001,20,0002,0,0,,10,status -F,0009,0025,20,0026,0,0,,10,company -F,0034,0075,21,0076,0,0,,10,custaddr -F,0109,0010,16,0013,10,0,,10,telephone -F,0119,0025,20,0026,0,0,,10,dp_mgr -F,0144,0008,20,0009,0,0,,10,machine -C,0,=,status,'A' -C,0,>,telephone,100 -C,0,&& -C,0,=,machine,'B' -C,0,=,company,' ' -C,0,|| -C,2,&& -F,0152,0004,20,0005,0,0,,10,memory -G,3 -L,2 -F,0152,0002,16,0005,2,0,,15,memsz -F,0154,0002,20,0003,0,0,,15,memunit -L,3 -F,0156,0008,20,0009,0,0,,10,disk -C,5,=,status,'X' -C,6,=,status,'Y' -F,0164,0008,20,0009,0,0,,10,tape -G,7 -L,5 -F,0164,0008,16,0011,8,0,,10,tapex -G,7 -L,6 -F,0164,0008,16,0011,8,2,,10,tapey -L,7 -F,0172,0004,06,0013,5,0,,10,no_terminals -F,0176,0003,07,0011,8,0,,10,compx -F,0179,0004,03,0013,7,0,,10,comp5 -F,0183,0004,08,0036,15,8,,10,comp1 -F,0187,0008,08,0036,34,17,,10,comp2 -F,0195,0003,10,0008,5,2,,10,price -F,0198,0007,13,0010,7,2,,10,prices -F,0205,0005,10,0032,8,0,1,10,date_x -F,0210,0005,10,0032,8,0,2,10,date2 -K,0,N,N,,custnum -K,1,Y,Y,"900",telephone,machine -K,2,Y,Y,0x2A,disk,dp_mgr,machine -]) - -AT_CHECK([gcdiff -I# reference tspfilex.xd], [0], [], []) - -AT_CLEANUP diff -Nru gnucobol-4.0~early~20200606/tests/testsuite.src/syn_functions.at gnucobol-5/tests/testsuite.src/syn_functions.at --- gnucobol-4.0~early~20200606/tests/testsuite.src/syn_functions.at 2020-06-06 20:52:00.000000000 +0000 +++ gnucobol-5/tests/testsuite.src/syn_functions.at 1970-01-01 00:00:00.000000000 +0000 @@ -1,604 +0,0 @@ -## Copyright (C) 2007-2012, 2014-2018 Free Software Foundation, Inc. -## Written by Roger While, Simon Sobisch, Edward Hart -## -## This file is part of GnuCOBOL. -## -## The GnuCOBOL compiler is free software: you can redistribute it -## and/or modify it under the terms of the GNU General Public License -## as published by the Free Software Foundation, either version 3 of the -## License, or (at your option) any later version. -## -## GnuCOBOL is distributed in the hope that it will be useful, -## but WITHOUT ANY WARRANTY; without even the implied warranty of -## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -## GNU General Public License for more details. -## -## You should have received a copy of the GNU General Public License -## along with GnuCOBOL. If not, see . - -### GnuCOBOL Test Suite - - -AT_SETUP([ANY LENGTH / NUMERIC as function RETURNING item]) -AT_KEYWORDS([functions extensions]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - FUNCTION-ID. func. - - DATA DIVISION. - LINKAGE SECTION. - 01 any-len PIC X ANY LENGTH. - - PROCEDURE DIVISION RETURNING any-len. - CONTINUE - . - END FUNCTION func. -]) - -AT_CHECK([$COMPILE_ONLY prog.cob], [1], [], -[prog.cob:9: error: function RETURNING item may not be ANY LENGTH -]) - -AT_DATA([prog2.cob], [ - IDENTIFICATION DIVISION. - FUNCTION-ID. func. - - DATA DIVISION. - LINKAGE SECTION. - 01 any-len PIC 9 ANY NUMERIC. - - PROCEDURE DIVISION RETURNING any-len. - CONTINUE - . - END FUNCTION func. -]) - -AT_CHECK([$COMPILE_ONLY prog2.cob], [1], [], -[prog2.cob:9: error: function RETURNING item may not be ANY LENGTH -]) - -AT_CLEANUP - - -AT_SETUP([REPOSITORY INTRINSIC phrase]) -AT_KEYWORDS([functions]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - CONFIGURATION SECTION. - REPOSITORY. - FUNCTION pi e intrinsic - . - DATA DIVISION. - WORKING-STORAGE SECTION. - PROCEDURE DIVISION. - DISPLAY PI. - DISPLAY E. - STOP RUN. -]) - -AT_CHECK([$COMPILE_ONLY prog.cob], [0], [], []) -AT_CLEANUP - - -AT_SETUP([REPOSITORY FUNCTION phrase]) -AT_KEYWORDS([functions]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - FUNCTION-ID. x AS "y". - - DATA DIVISION. - LINKAGE SECTION. - 01 ret PIC 9(4). - - PROCEDURE DIVISION RETURNING ret. - MOVE 100 TO ret - . - END FUNCTION x. - - IDENTIFICATION DIVISION. - FUNCTION-ID. z. - - DATA DIVISION. - LINKAGE SECTION. - 01 ret PIC 9(5). - - PROCEDURE DIVISION RETURNING ret. - MOVE 1 TO ret - . - END FUNCTION z. - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - - ENVIRONMENT DIVISION. - CONFIGURATION SECTION. - REPOSITORY. - FUNCTION y AS "y" - FUNCTION z - . - PROCEDURE DIVISION. - DISPLAY FUNCTION y - DISPLAY FUNCTION z - . - END PROGRAM prog. -]) - -AT_CHECK([$COMPILE_ONLY prog.cob], [0], [], []) -AT_CLEANUP - - -AT_SETUP([Redundant REPOSITORY entries]) -AT_KEYWORDS([functions]) - -AT_DATA([prog.cob], [ - PROGRAM-ID. prog. - END PROGRAM prog. - - IDENTIFICATION DIVISION. - FUNCTION-ID. alpha. - - ENVIRONMENT DIVISION. - CONFIGURATION SECTION. - SPECIAL-NAMES. - ALPHABET gamma IS ASCII - . - REPOSITORY. - FUNCTION alpha - PROGRAM prog - PROGRAM prog - PROGRAM prog AS "alpha" - FUNCTION prog - FUNCTION gamma - . - END FUNCTION alpha. -]) - -AT_CHECK([$COMPILE_ONLY prog.cob], [1], [], -[prog.cob:14: warning: prototype has same name as current function and will be ignored -prog.cob:16: warning: duplicate REPOSITORY entry for 'prog' -prog.cob:17: error: duplicate REPOSITORY entries for 'prog' do not match -prog.cob:18: error: duplicate REPOSITORY entries for 'prog' do not match -prog.cob:19: warning: no definition/prototype seen for FUNCTION 'gamma' -prog.cob:19: error: redefinition of 'gamma' -prog.cob:11: error: 'gamma' previously defined here -prog.cob:21: error: FUNCTION 'alpha' has no PROCEDURE DIVISION -]) -AT_CLEANUP - - -AT_SETUP([Missing prototype/definition]) -AT_KEYWORDS([functions programs prototypes]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - FUNCTION-ID. blah. - - ENVIRONMENT DIVISION. - CONFIGURATION SECTION. - REPOSITORY. - FUNCTION x - PROGRAM y - . - DATA DIVISION. - LINKAGE SECTION. - 01 ret PIC X. - - PROCEDURE DIVISION RETURNING ret. - MOVE FUNCTION x TO ret - MOVE FUNCTION x TO ret - . - END FUNCTION blah. -]) - -AT_CHECK([$COMPILE_ONLY prog.cob], [0], [], -[prog.cob:8: warning: no definition/prototype seen for FUNCTION 'x' -prog.cob:9: warning: no definition/prototype seen for PROGRAM 'y' -]) -AT_CLEANUP - - -AT_SETUP([Empty function]) -AT_KEYWORDS([functions]) - -# Note: Test case for "Function without END FUNCTION" in syn_definition - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - FUNCTION-ID. func. - - END FUNCTION func. - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 x PIC 999 VALUE 124. - END PROGRAM prog. -]) - -AT_CHECK([$COMPILE_ONLY prog.cob], [1], [], -[prog.cob:5: error: FUNCTION 'func' has no PROCEDURE DIVISION -]) - -AT_CLEANUP - - -AT_SETUP([Function definition inside program]) -AT_KEYWORDS([functions]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - - PROCEDURE DIVISION. - CONTINUE - . - - IDENTIFICATION DIVISION. - FUNCTION-ID. f. - END FUNCTION f. -]) - -AT_CHECK([$COMPILE_ONLY prog.cob], [1], [], -[prog.cob:10: error: functions may not be defined within a program/function -prog.cob:11: error: FUNCTION 'f' has no PROCEDURE DIVISION -]) -AT_CLEANUP - - -AT_SETUP([Intrinsic functions: dialect]) -AT_KEYWORDS([functions]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - DATA DIVISION. - WORKING-STORAGE SECTION. - PROCEDURE DIVISION. - DISPLAY FUNCTION ABS (1). - DISPLAY FUNCTION TRIM (" some text here"). - DISPLAY FUNCTION SUBSTITUTE ('some text' 'some' 'nice'). - STOP RUN. -]) - -AT_CHECK([$COMPILE_ONLY prog.cob], [0], [], []) -AT_CHECK([$COMPILE_ONLY -std=acu-strict prog.cob], [1], [], -[prog.cob:9: error: FUNCTION 'TRIM' unknown -prog.cob:10: error: FUNCTION 'SUBSTITUTE' unknown -]) - -AT_CLEANUP - - -AT_SETUP([Intrinsic functions: replaced]) -AT_KEYWORDS([functions SUBSTITUTE]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - FUNCTION-ID. SUBSTITUTE. - - DATA DIVISION. - LINKAGE SECTION. - 01 func-in PIC X(15). - 01 func-sub PIC X. - 01 func-out PIC X(15). - - PROCEDURE DIVISION USING func-in, func-sub RETURNING func-out. - MOVE func-in TO func-out - INSPECT func-out REPLACING ALL '%' BY func-sub - . - END FUNCTION SUBSTITUTE. - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - - ENVIRONMENT DIVISION. - CONFIGURATION SECTION. - REPOSITORY. - FUNCTION SUBSTITUTE - . - PROCEDURE DIVISION. - DISPLAY FUNCTION SUBSTITUTE(" % C%O%B%O%L % ", "_") - DISPLAY FUNCTION SUBSTITUTE(" % C%O%B%O%L % ", "-") - . - END PROGRAM prog. -]) - -AT_CHECK([$COMPILE_ONLY -fnot-intrinsic=substitute prog.cob], [0], [], []) -AT_CHECK([$COMPILE_ONLY prog.cob], [1], [], -[prog.cob:24: error: syntax error, unexpected ., expecting intrinsic function name or INTRINSIC -prog.cob:26: error: FUNCTION 'SUBSTITUTE' has wrong number of arguments -prog.cob:27: error: FUNCTION 'SUBSTITUTE' has wrong number of arguments -]) - -AT_CLEANUP - - -AT_SETUP([Intrinsic functions: number of arguments]) -AT_KEYWORDS([functions]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - DATA DIVISION. - WORKING-STORAGE SECTION. - PROCEDURE DIVISION. - DISPLAY FUNCTION PI. - DISPLAY FUNCTION PI ( ). - DISPLAY FUNCTION PI (1). - DISPLAY FUNCTION ABS. - DISPLAY FUNCTION ABS (1). - DISPLAY FUNCTION ABS (1, 2). - DISPLAY FUNCTION DAY-TO-YYYYDDD. - DISPLAY FUNCTION DAY-TO-YYYYDDD (6000). - DISPLAY FUNCTION DAY-TO-YYYYDDD (6000,50). - DISPLAY FUNCTION DAY-TO-YYYYDDD (6000,50,1600). - DISPLAY FUNCTION DAY-TO-YYYYDDD (6000,50,1600,500). - DISPLAY FUNCTION MAX (). - DISPLAY FUNCTION MAX (6000). - DISPLAY FUNCTION SUBSTITUTE ('A' 'B' 'C' 'D'). - STOP RUN. -]) - -AT_CHECK([$COMPILE_ONLY prog.cob], [1], [], -[prog.cob:10: error: FUNCTION 'PI' has wrong number of arguments -prog.cob:11: error: FUNCTION 'ABS' has wrong number of arguments -prog.cob:13: error: FUNCTION 'ABS' has wrong number of arguments -prog.cob:14: error: FUNCTION 'DAY-TO-YYYYDDD' has wrong number of arguments -prog.cob:18: error: FUNCTION 'DAY-TO-YYYYDDD' has wrong number of arguments -prog.cob:19: error: FUNCTION 'MAX' has wrong number of arguments -prog.cob:21: error: FUNCTION 'SUBSTITUTE' has wrong number of arguments -]) - -AT_CLEANUP - - -AT_SETUP([Intrinsic functions: reference modification]) -AT_KEYWORDS([functions refmod]) - -# the following should be checked, currently doesn't work -#AT_DATA([prog.cob], [ -# IDENTIFICATION DIVISION. -# PROGRAM-ID. prog. -# ENVIRONMENT DIVISION. -# DATA DIVISION. -# WORKING-STORAGE SECTION. -# PROCEDURE DIVISION. -# DISPLAY FUNCTION CHAR (66)(1:2). -# DISPLAY FUNCTION NUMVAL-C (123)(1:2). -# DISPLAY FUNCTION REVERSE ("TESTME")(20:1). -# DISPLAY FUNCTION REVERSE ("TESTME")(-1:1). -# DISPLAY FUNCTION REVERSE ("TESTME")(1:0). -# STOP RUN. -#]) -# -#AT_CHECK([$COMPILE_ONLY prog.cob], [1], [], -#[prog.cob:8: error: FUNCTION 'PI' can not have reference modification -#prog.cob:9: error: FUNCTION 'NUMVAL-C' can not have reference modification -#prog.cob:10: error: FUNCTION 'REVERSE' has invalid reference modification -#prog.cob:11: error: FUNCTION 'REVERSE' has invalid reference modification -#prog.cob:12: error: FUNCTION 'REVERSE' has invalid reference modification -#]) - -# test what is in already... -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - DATA DIVISION. - WORKING-STORAGE SECTION. - PROCEDURE DIVISION. - DISPLAY FUNCTION REVERSE ("TESTME")(-1:1). - DISPLAY FUNCTION REVERSE ("TESTME")(1:0). - STOP RUN. -]) - -AT_CHECK([$COMPILE_ONLY prog.cob], [1], [], -[prog.cob:8: error: FUNCTION 'REVERSE' has invalid reference modification -prog.cob:9: error: FUNCTION 'REVERSE' has invalid reference modification -]) - -AT_CLEANUP - - -AT_SETUP([Intrinsic functions: argument type]) -AT_KEYWORDS([functions]) - -# TODO: Add more tests - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - DATA DIVISION. - WORKING-STORAGE SECTION. - PROCEDURE DIVISION. - DISPLAY FUNCTION ABS ('1'). - STOP RUN. -]) - -AT_CHECK([$COMPILE_ONLY prog.cob], [1], [], -[prog.cob:8: error: FUNCTION 'ABS' has invalid argument -]) - -AT_CLEANUP - - -AT_SETUP([invalid formatted date/time args]) -AT_KEYWORDS([functions FORMATTED-DATE FORMATTED-CURRENT-DATE FORMATTED-TIME FORMATTED-DATETIME INTEGER-OF-FORMATTED-DATE SECONDS-FROM-FORMATTED-TIME]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 format-str PIC X(8) VALUE "YYYYMMDD". - 01 Date-Format CONSTANT "YYYYMMDD". - 01 Time-Format CONSTANT "hhmmss". - 01 Datetime-Format CONSTANT "YYYYMMDDThhmmss". - PROCEDURE DIVISION. - *> Test wrong formats - DISPLAY FUNCTION FORMATTED-DATE ( "YYYYWWWD", 1 ) - END-DISPLAY - DISPLAY FUNCTION FORMATTED-TIME ( "HHMMSS", 1) - END-DISPLAY - DISPLAY FUNCTION FORMATTED-DATETIME - ( "YYYYWWWDTHHMMSS", 1, 1) - END-DISPLAY - - *> Test format in variable - DISPLAY FUNCTION FORMATTED-DATE ( format-str, 1) - END-DISPLAY - - *> Test incompatible formats - DISPLAY FUNCTION FORMATTED-CURRENT-DATE (Date-Format) - END-DISPLAY - DISPLAY FUNCTION FORMATTED-CURRENT-DATE (Time-Format) - END-DISPLAY - - DISPLAY FUNCTION FORMATTED-DATE ( Time-Format, 1) - END-DISPLAY - DISPLAY FUNCTION FORMATTED-DATE ( Datetime-Format, 1) - END-DISPLAY - - DISPLAY FUNCTION FORMATTED-TIME ( Date-Format, 1) - END-DISPLAY - DISPLAY FUNCTION FORMATTED-TIME ( Datetime-Format, 1) - END-DISPLAY - - DISPLAY FUNCTION FORMATTED-DATETIME ( Date-Format, 1, 1) - END-DISPLAY - DISPLAY FUNCTION FORMATTED-DATETIME ( Time-Format, 1, 1) - END-DISPLAY - - DISPLAY FUNCTION INTEGER-OF-FORMATTED-DATE ( Time-Format, 1) - END-DISPLAY - - DISPLAY FUNCTION SECONDS-FROM-FORMATTED-TIME - ( Date-Format, 1) - END-DISPLAY - - *> Time format with more than 9 decimal places. - DISPLAY FUNCTION FORMATTED-TIME ( "hhmmss.ssssssssss", 1) - END-DISPLAY - - STOP RUN. -]) - -AT_CHECK([$COMPILE_ONLY prog.cob], [1], [], -[prog.cob:12: error: FUNCTION 'FORMATTED-DATE' has invalid date/time format -prog.cob:14: error: FUNCTION 'FORMATTED-TIME' has invalid date/time format -prog.cob:16: error: FUNCTION 'FORMATTED-DATETIME' has invalid date/time format -prog.cob:21: warning: FUNCTION 'FORMATTED-DATE' has format in variable -prog.cob:25: error: FUNCTION 'FORMATTED-CURRENT-DATE' has invalid date/time format -prog.cob:27: error: FUNCTION 'FORMATTED-CURRENT-DATE' has invalid date/time format -prog.cob:30: error: FUNCTION 'FORMATTED-DATE' has invalid date/time format -prog.cob:32: error: FUNCTION 'FORMATTED-DATE' has invalid date/time format -prog.cob:35: error: FUNCTION 'FORMATTED-TIME' has invalid date/time format -prog.cob:37: error: FUNCTION 'FORMATTED-TIME' has invalid date/time format -prog.cob:40: error: FUNCTION 'FORMATTED-DATETIME' has invalid date/time format -prog.cob:42: error: FUNCTION 'FORMATTED-DATETIME' has invalid date/time format -prog.cob:45: error: FUNCTION 'INTEGER-OF-FORMATTED-DATE' has invalid date/time format -prog.cob:48: error: FUNCTION 'SECONDS-FROM-FORMATTED-TIME' has invalid date/time format -prog.cob:53: error: FUNCTION 'FORMATTED-TIME' has invalid date/time format -]) - -AT_CLEANUP - -AT_SETUP([invalid formats w/ DECIMAL-POINT IS COMMA]) -AT_KEYWORDS([functions FORMATTED-TIME FORMATTED-DATETIME]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - CONFIGURATION SECTION. - SPECIAL-NAMES. - DECIMAL-POINT IS COMMA. - PROCEDURE DIVISION. - DISPLAY FUNCTION FORMATTED-TIME ("hhmmss,ss", 1) - END-DISPLAY - DISPLAY FUNCTION FORMATTED-DATETIME - ("YYYYMMDDThhmmss,ss", 1, 1) - END-DISPLAY - - DISPLAY FUNCTION FORMATTED-TIME ("hhmmss.ss", 1) - END-DISPLAY - DISPLAY FUNCTION FORMATTED-DATETIME - ("YYYYMMDDThhmmss.ss", 1, 1) - END-DISPLAY - - STOP RUN. -]) - -AT_CHECK([$COMPILE_ONLY prog.cob], [1], [], -[prog.cob:15: error: FUNCTION 'FORMATTED-TIME' has invalid date/time format -prog.cob:17: error: FUNCTION 'FORMATTED-DATETIME' has invalid date/time format -]) - -AT_CLEANUP - - -AT_SETUP([Specified offset and SYSTEM-OFFSET]) -AT_KEYWORDS([functions FORMATTED-TIME FORMATTED-DATETIME]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - PROCEDURE DIVISION. - DISPLAY FUNCTION FORMATTED-DATETIME - ("YYYYDDDThhmmssZ", 1, 1, 1, SYSTEM-OFFSET) - END-DISPLAY - DISPLAY FUNCTION FORMATTED-TIME - ("hhmmssZ", 1, 1, SYSTEM-OFFSET) - END-DISPLAY - . -]) - -AT_CHECK([$COMPILE prog.cob], [1], [], -[prog.cob:6: error: cannot specify offset and SYSTEM-OFFSET at the same time -prog.cob:9: error: cannot specify offset and SYSTEM-OFFSET at the same time -]) - -AT_CLEANUP - - -AT_SETUP([FUNCTION LENGTH / BYTE-LENGTH]) -AT_KEYWORDS([functions PREFIXED]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - PROCEDURE DIVISION. - DISPLAY FUNCTION LENGTH ("abcd" & "xyz") - END-DISPLAY - DISPLAY FUNCTION BYTE-LENGTH ("abcd" & "xyz") - END-DISPLAY - DISPLAY FUNCTION LENGTH ("abcd" "xyz") - END-DISPLAY - DISPLAY FUNCTION BYTE-LENGTH (01234) - END-DISPLAY - DISPLAY FUNCTION LENGTH (567) - END-DISPLAY - DISPLAY FUNCTION LENGTH ("abcd" & "xyz" PHYSICAL) - END-DISPLAY - DISPLAY FUNCTION BYTE-LENGTH ("abcd" & "xyz" PHYSICAL) - END-DISPLAY - . -]) - -AT_CHECK([$COMPILE -Wno-pending prog.cob], [1], [], -[prog.cob:9: error: syntax error, unexpected Literal, expecting PHYSICAL or ) -prog.cob:11: error: a non-numeric literal is expected here -prog.cob:13: error: a non-numeric literal is expected here -]) - -AT_CLEANUP diff -Nru gnucobol-4.0~early~20200606/tests/testsuite.src/syn_misc.at gnucobol-5/tests/testsuite.src/syn_misc.at --- gnucobol-4.0~early~20200606/tests/testsuite.src/syn_misc.at 2020-06-06 20:52:00.000000000 +0000 +++ gnucobol-5/tests/testsuite.src/syn_misc.at 1970-01-01 00:00:00.000000000 +0000 @@ -1,7036 +0,0 @@ -## Copyright (C) 2007-2012, 2014-2020 Free Software Foundation, Inc. -## Written by Keisuke Nishida, Roger While, Simon Sobisch, Edward Hart, -## Ron Norman -## -## This file is part of GnuCOBOL. -## -## The GnuCOBOL compiler is free software: you can redistribute it -## and/or modify it under the terms of the GNU General Public License -## as published by the Free Software Foundation, either version 3 of the -## License, or (at your option) any later version. -## -## GnuCOBOL is distributed in the hope that it will be useful, -## but WITHOUT ANY WARRANTY; without even the implied warranty of -## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -## GNU General Public License for more details. -## -## You should have received a copy of the GNU General Public License -## along with GnuCOBOL. If not, see . - -### GnuCOBOL Test Suite - - -AT_SETUP([ambiguous AND/OR]) -AT_KEYWORDS([misc expression]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 ONE PIC 9 VALUE 1. - 01 TWO PIC 9 VALUE 2. - 01 THREE PIC 9 VALUE 3. - PROCEDURE DIVISION. - IF THREE = ONE AND TWO OR THREE - DISPLAY "OK" - END-DISPLAY - END-IF. - IF 3 = 1 OR 2 AND 3 - DISPLAY "NO" - END-DISPLAY - END-IF. - STOP RUN. -]) - -AT_CHECK([$COMPILE_ONLY -Wno-constant-expression prog.cob], [0], [], -[prog.cob:10: warning: suggest parentheses around AND within OR -prog.cob:14: warning: suggest parentheses around OR within AND -]) - -AT_CLEANUP - - -AT_SETUP([warn constant expressions]) -AT_KEYWORDS([misc expression]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - PROCEDURE DIVISION. - IF 3 = 1 - AND 2 OR 3 - DISPLAY "OK" - END-DISPLAY - END-IF. - IF 3 = 1 OR - 2 AND 3 - DISPLAY "NO" - END-DISPLAY - END-IF. - STOP RUN. -]) - -# FIXME positions broken -AT_CHECK([$COMPILE_ONLY -w -Wconstant-expression prog.cob], [0], [], -[prog.cob:5: warning: expression '3' EQUALS '1' is always FALSE -prog.cob:6: warning: expression '3' EQUALS '2' is always FALSE -prog.cob:6: warning: expression '3' EQUALS '3' is always TRUE -prog.cob:10: warning: expression '3' EQUALS '1' is always FALSE -prog.cob:11: warning: expression '3' EQUALS '2' is always FALSE -prog.cob:11: warning: expression '3' EQUALS '3' is always TRUE -]) - -AT_CLEANUP - - -AT_SETUP([warn literal size]) -AT_KEYWORDS([misc numeric constant expression]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 WS-LINE-NUMBER PIC 9(3) VALUE ZERO. - 01 WS-NUMBER PIC 9(3)V99 VALUE ZERO. - 01 WS-TEXT PIC X(5) VALUE 'CAT'. - 01 PIC-9-SIGNED PIC S9(2) VALUE 5. - 01 PIC-9-SIGNED-DECIMAL PIC S9(2)V99 VALUE 5. - 01 PIC-9-NOT-SIGNED PIC 9(3) VALUE 5. - 01 PIC-9-NOT-DECIMAL PIC 9(3) VALUE 5. - 01 XX PIC 9(2) VALUE 2. - 01 PIC-9-DECIMAL PIC 9(3)V9 VALUE 5. - 01 COMPUTE-1 PIC 999V9999 VALUE 654.1873. - 01 GROUP-ITEM-X6. - 05 FILLER PIC X(6) VALUE 'CAT'. - 78 CONST1 VALUE 'CAT '. - 01 CONST2 CONSTANT AS 00000001234. - 01 IF-D16 PIC PP99 VALUE .0012. - PROCEDURE DIVISION. - MAIN. - IF GROUP-ITEM-X6 = '1234567' CONTINUE. - IF PIC-9-NOT-DECIMAL = 1.1 CONTINUE. - IF PIC-9-NOT-DECIMAL = 1.0 - CONTINUE. - IF PIC-9-DECIMAL = 1.01 - CONTINUE. - IF PIC-9-DECIMAL = 1.100 - CONTINUE. - IF PIC-9-SIGNED NOT = 11.0 - CONTINUE. - IF PIC-9-NOT-SIGNED < 0 - CONTINUE. - IF PIC-9-NOT-SIGNED < ZERO - CONTINUE. - IF PIC-9-NOT-SIGNED < (25 - 50) - CONTINUE. - IF PIC-9-DECIMAL = (2.24 / 2) - CONTINUE. - IF PIC-9-NOT-DECIMAL = "123" - CONTINUE. - IF PIC-9-NOT-DECIMAL = "1B0" *> field is numeric - CONTINUE. - IF PIC-9-NOT-DECIMAL (1:3) = "1B0" *> refmod is always alphanumeric - CONTINUE. - IF PIC-9-NOT-DECIMAL (1:3) NOT = "Hot Doggy" - CONTINUE. - IF PIC-9-NOT-DECIMAL (1:XX) NOT = "Hi" - CONTINUE. - IF WS-LINE-NUMBER > '123' - CONTINUE. - IF WS-TEXT > 'DOGGY' - CONTINUE. - IF WS-NUMBER > 123.999 - CONTINUE. - IF WS-LINE-NUMBER > 2345 - CONTINUE. - IF WS-LINE-NUMBER <= 1234 - CONTINUE. - IF WS-LINE-NUMBER > '1234' - CONTINUE. - IF 5432 < WS-LINE-NUMBER - CONTINUE. - IF 7855 >= WS-LINE-NUMBER - CONTINUE. - IF 1234 < WS-LINE-NUMBER - CONTINUE. - IF 5432 >= WS-LINE-NUMBER - CONTINUE. - IF WS-TEXT > 'DOGGY++' - CONTINUE. - IF WS-TEXT > 3141596 - CONTINUE. - IF WS-TEXT > 3.141596 - CONTINUE. - IF WS-TEXT = 3.141596 - CONTINUE. - IF 'DOG+CAT' NOT = WS-TEXT - CONTINUE. - IF WS-TEXT = 'CAT+DOG' - CONTINUE. - EVALUATE TRUE - WHEN 'DOG+CAT' = WS-TEXT - CONTINUE - WHEN CONST1 = 'CAT+DOG' - CONTINUE - WHEN CONST1 = 'CAT' - CONTINUE - WHEN CONST2 = 1234 - CONTINUE - END-EVALUATE - IF WS-LINE-NUMBER > 0000234 - CONTINUE. - IF WS-TEXT = 'CAT ' - CONTINUE. - IF ( COMPUTE-1 < 654.20038) AND - ( COMPUTE-1 > 654.17422) THEN - CONTINUE. - IF ( COMPUTE-1 < 5654.20) CONTINUE. - IF ( COMPUTE-1 > 5654.20) CONTINUE. - IF COMPUTE-1 < 05654.20 CONTINUE. - IF COMPUTE-1 > 05654.20 CONTINUE. - IF ( 5654.20 > COMPUTE-1) CONTINUE. - IF ( 5654.20 < COMPUTE-1) CONTINUE. - IF 05654.20 > COMPUTE-1 CONTINUE. - IF 05654.20 < COMPUTE-1 CONTINUE. - IF IF-D16 POSITIVE - CONTINUE. - IF IF-D16 NOT POSITIVE - CONTINUE. - IF IF-D16 NEGATIVE - CONTINUE. - IF IF-D16 NOT NEGATIVE - CONTINUE. - IF PIC-9-NOT-SIGNED > (25 - 50) - CONTINUE. - IF PIC-9-NOT-SIGNED >= -1 CONTINUE. - IF PIC-9-NOT-SIGNED >= -.1 CONTINUE. - IF PIC-9-NOT-SIGNED > 0.0 CONTINUE. - IF PIC-9-NOT-SIGNED > .0 CONTINUE. - IF PIC-9-NOT-SIGNED > ZERO - CONTINUE. - IF PIC-9-NOT-SIGNED >= 0.0 CONTINUE. - IF PIC-9-NOT-SIGNED >= .0 CONTINUE. - IF PIC-9-NOT-SIGNED >= ZERO - CONTINUE. - IF GROUP-ITEM-X6 (1:6) = '123456' - CONTINUE. - * Both have correct error check verified in syn_refmod.at - * IF GROUP-ITEM-X6 (2:6) = '123456' - * CONTINUE. - * IF GROUP-ITEM-X6 (WS-LINE-NUMBER:7) = '123456' - * CONTINUE. - IF GROUP-ITEM-X6 (1:5) = '123456' - CONTINUE. - IF GROUP-ITEM-X6 (3:) = '12345' - CONTINUE. - IF GROUP-ITEM-X6 (3:WS-LINE-NUMBER) = '12345' - CONTINUE. - IF GROUP-ITEM-X6 (WS-LINE-NUMBER:3) = '12345' - CONTINUE. - IF GROUP-ITEM-X6 (WS-LINE-NUMBER:WS-LINE-NUMBER) = '12345' - CONTINUE. - IF GROUP-ITEM-X6 (WS-LINE-NUMBER:) = '12345' - CONTINUE. - IF PIC-9-NOT-DECIMAL > 9 CONTINUE. - IF PIC-9-NOT-DECIMAL > 009 CONTINUE. - IF PIC-9-NOT-DECIMAL > 900 CONTINUE. - IF PIC-9-NOT-DECIMAL > 909 CONTINUE. - IF PIC-9-NOT-DECIMAL > 999 CONTINUE. - IF PIC-9-NOT-DECIMAL > 0000999 CONTINUE. - IF PIC-9-DECIMAL > 999 CONTINUE. - IF PIC-9-DECIMAL > 990.9 CONTINUE. - IF PIC-9-DECIMAL > 999.9 CONTINUE. - IF PIC-9-DECIMAL > 0999.90 CONTINUE. - IF PIC-9-DECIMAL > -0999.90 CONTINUE. - IF PIC-9-SIGNED-DECIMAL > 99.99 CONTINUE. - IF PIC-9-SIGNED-DECIMAL >= 99.99 CONTINUE. - IF PIC-9-SIGNED-DECIMAL < -99.99 CONTINUE. - IF PIC-9-SIGNED-DECIMAL <= -099.990 CONTINUE. - IF PIC-9-SIGNED-DECIMAL <= -099.991 CONTINUE. - - - STOP RUN. -]) - -AT_CHECK([$COMPILE_ONLY prog.cob], [0], [], -[prog.cob: in paragraph 'MAIN': -prog.cob:23: warning: literal '1234567' is longer than 'GROUP-ITEM-X6' -prog.cob:23: warning: expression is always FALSE -prog.cob:24: warning: literal '1.1' has more decimals than 'PIC-9-NOT-DECIMAL' -prog.cob:24: warning: expression is always FALSE -prog.cob:27: warning: literal '1.01' has more decimals than 'PIC-9-DECIMAL' -prog.cob:27: warning: expression is always FALSE -prog.cob:33: warning: unsigned 'PIC-9-NOT-SIGNED' may not be LESS THAN ZERO -prog.cob:35: warning: unsigned 'PIC-9-NOT-SIGNED' may not be LESS THAN ZERO -prog.cob:38: warning: unsigned 'PIC-9-NOT-SIGNED' may not be LESS THAN -25 -prog.cob:40: warning: literal '1.12' has more decimals than 'PIC-9-DECIMAL' -prog.cob:40: warning: expression is always FALSE -prog.cob:43: warning: literal '1B0' is alphanumeric but 'PIC-9-NOT-DECIMAL' is numeric -prog.cob:47: warning: literal 'Hot Doggy' is longer than 'PIC-9-NOT-DECIMAL' -prog.cob:47: warning: expression is always TRUE -prog.cob:55: warning: literal '123.999' has more decimals than 'WS-NUMBER' -prog.cob:57: warning: literal '2345' has more digits than 'WS-LINE-NUMBER' -prog.cob:57: warning: expression is always FALSE -prog.cob:59: warning: literal '1234' has more digits than 'WS-LINE-NUMBER' -prog.cob:59: warning: expression is always TRUE -prog.cob:61: warning: literal '1234' has more digits than 'WS-LINE-NUMBER' -prog.cob:61: warning: expression is always FALSE -prog.cob:63: warning: literal '5432' has more digits than 'WS-LINE-NUMBER' -prog.cob:63: warning: expression is always FALSE -prog.cob:65: warning: literal '7855' has more digits than 'WS-LINE-NUMBER' -prog.cob:65: warning: expression is always TRUE -prog.cob:67: warning: literal '1234' has more digits than 'WS-LINE-NUMBER' -prog.cob:67: warning: expression is always FALSE -prog.cob:69: warning: literal '5432' has more digits than 'WS-LINE-NUMBER' -prog.cob:69: warning: expression is always TRUE -prog.cob:71: warning: literal 'DOGGY++' is longer than 'WS-TEXT' -prog.cob:73: warning: literal '3141596' is longer than 'WS-TEXT' -prog.cob:75: warning: literal '3.141596' is longer than 'WS-TEXT' -prog.cob:77: warning: literal '3.141596' is longer than 'WS-TEXT' -prog.cob:77: warning: expression is always FALSE -prog.cob:79: warning: literal 'DOG+CAT' is longer than 'WS-TEXT' -prog.cob:79: warning: expression is always TRUE -prog.cob:81: warning: literal 'CAT+DOG' is longer than 'WS-TEXT' -prog.cob:81: warning: expression is always FALSE -prog.cob:84: warning: literal 'DOG+CAT' is longer than 'WS-TEXT' -prog.cob:84: warning: expression is always FALSE -prog.cob:86: warning: expression 'CAT ' EQUALS 'CAT+DOG' is always FALSE -prog.cob:88: warning: expression 'CAT ' EQUALS 'CAT' is always TRUE -prog.cob:90: warning: expression '00000001234' EQUALS '1234' is always TRUE -prog.cob:97: warning: literal '654.20038' has more decimals than 'COMPUTE-1' -prog.cob:98: warning: literal '654.17422' has more decimals than 'COMPUTE-1' -prog.cob:100: warning: literal '5654.20' has more digits than 'COMPUTE-1' -prog.cob:100: warning: expression is always TRUE -prog.cob:101: warning: literal '5654.20' has more digits than 'COMPUTE-1' -prog.cob:101: warning: expression is always FALSE -prog.cob:102: warning: literal '5654.20' has more digits than 'COMPUTE-1' -prog.cob:102: warning: expression is always TRUE -prog.cob:103: warning: literal '5654.20' has more digits than 'COMPUTE-1' -prog.cob:103: warning: expression is always FALSE -prog.cob:104: warning: literal '5654.20' has more digits than 'COMPUTE-1' -prog.cob:104: warning: expression is always TRUE -prog.cob:105: warning: literal '5654.20' has more digits than 'COMPUTE-1' -prog.cob:105: warning: expression is always FALSE -prog.cob:106: warning: literal '5654.20' has more digits than 'COMPUTE-1' -prog.cob:106: warning: expression is always TRUE -prog.cob:107: warning: literal '5654.20' has more digits than 'COMPUTE-1' -prog.cob:107: warning: expression is always FALSE -prog.cob:112: warning: unsigned 'IF-D16' may not be LESS THAN ZERO -prog.cob:114: warning: unsigned 'IF-D16' may not be LESS THAN ZERO -prog.cob:117: warning: unsigned 'PIC-9-NOT-SIGNED' may always be GREATER THAN -25 -prog.cob:118: warning: unsigned 'PIC-9-NOT-SIGNED' may always be GREATER OR EQUAL -1 -prog.cob:119: warning: literal '-.1' has more decimals than 'PIC-9-NOT-SIGNED' -prog.cob:119: warning: unsigned 'PIC-9-NOT-SIGNED' may always be GREATER OR EQUAL -.1 -prog.cob:124: warning: unsigned 'PIC-9-NOT-SIGNED' may always be GREATER OR EQUAL ZERO -prog.cob:125: warning: unsigned 'PIC-9-NOT-SIGNED' may always be GREATER OR EQUAL ZERO -prog.cob:126: warning: unsigned 'PIC-9-NOT-SIGNED' may always be GREATER OR EQUAL ZERO -prog.cob:135: warning: literal '123456' is longer than reference-modification of 'GROUP-ITEM-X6' -prog.cob:135: warning: expression is always FALSE -prog.cob:137: warning: literal '12345' is longer than reference-modification of 'GROUP-ITEM-X6' -prog.cob:137: warning: expression is always FALSE -prog.cob:139: warning: literal '12345' is longer than reference-modification of 'GROUP-ITEM-X6' -prog.cob:139: warning: expression is always FALSE -prog.cob:141: warning: literal '12345' is longer than reference-modification of 'GROUP-ITEM-X6' -prog.cob:141: warning: expression is always FALSE -prog.cob:151: warning: 'PIC-9-NOT-DECIMAL' may not be GREATER THAN 999 -prog.cob:152: warning: 'PIC-9-NOT-DECIMAL' may not be GREATER THAN 999 -prog.cob:155: warning: 'PIC-9-DECIMAL' may not be GREATER THAN 999.9 -prog.cob:156: warning: 'PIC-9-DECIMAL' may not be GREATER THAN 999.9 -prog.cob:157: warning: unsigned 'PIC-9-DECIMAL' may always be GREATER THAN -999.90 -prog.cob:158: warning: 'PIC-9-SIGNED-DECIMAL' may not be GREATER THAN 99.99 -prog.cob:159: warning: 'PIC-9-SIGNED-DECIMAL' may not be GREATER THAN 99.99 -prog.cob:160: warning: 'PIC-9-SIGNED-DECIMAL' may not be LESS THAN -99.99 -prog.cob:161: warning: 'PIC-9-SIGNED-DECIMAL' may not be LESS THAN -99.99 -prog.cob:162: warning: literal '-99.991' has more decimals than 'PIC-9-SIGNED-DECIMAL' -]) - -AT_CLEANUP - - -AT_SETUP([warn literal size in constant expr. (level 88)]) -AT_KEYWORDS([misc numeric constant expression]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 x PIC 9. - 88 never-true value 99. - 01 y PIC 9. - 88 never-truen value -9. - 01 xx pic x. - 88 some-not values 'a', 'b', 'cd'. - 88 some-not-s values '00', 'a', 'b', 'cd'. - - PROCEDURE DIVISION. - if never-true - continue - end-if - if never-truen - continue - end-if - if some-not-s - set some-not to true - set some-not-s to true - end-if - set never-true to true - goback. -]) - -AT_CHECK([$COMPILE_ONLY prog.cob], [0], [], -[prog.cob:8: warning: literal '99' has more digits than 'x' -prog.cob:8: warning: expression is always FALSE -prog.cob:13: warning: literal '00' is longer than 'xx' -prog.cob:13: warning: expression is always FALSE -prog.cob:13: warning: literal 'cd' is longer than 'xx' -prog.cob:13: warning: expression is always FALSE -prog.cob:24: warning: value size exceeds data size -prog.cob:24: warning: value size is 2 -prog.cob:11: warning: 'xx' defined here as PIC X -prog.cob:26: warning: value size exceeds data size -prog.cob:26: warning: value is 99 -prog.cob:7: warning: 'x' defined here as PIC 9 -]) - -AT_CLEANUP - - -AT_SETUP([Invalid conditional expression (1)]) -AT_KEYWORDS([misc]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 CON CONSTANT 10. - 01 V PIC 9. - 78 C78 VALUE 'A'. - PROCEDURE DIVISION. - IF FUNCTION TRIM (' ') - CONTINUE - CONTINUE - END-IF. - IF CON - CONTINUE - CONTINUE - END-IF. - IF V - CONTINUE - CONTINUE - END-IF. - IF C78 - CONTINUE - CONTINUE - END-IF. - IF '2' - CONTINUE - CONTINUE - END-IF. - IF C78 OR V - CONTINUE - CONTINUE - END-IF. - EVALUATE TRUE - WHEN FUNCTION TRIM (' ') - CONTINUE - CONTINUE - WHEN CON - CONTINUE - CONTINUE - WHEN V - CONTINUE - CONTINUE - WHEN C78 - CONTINUE - CONTINUE - WHEN '2' - CONTINUE - WHEN OTHER - CONTINUE - END-EVALUATE. - PERFORM VARYING V - FROM 1 BY 1 - UNTIL FUNCTION TRIM (' ') - CONTINUE - CONTINUE - END-PERFORM. - PERFORM VARYING V - FROM 1 BY 1 - UNTIL V - CONTINUE - CONTINUE - END-PERFORM. - PERFORM VARYING V - FROM 1 BY 1 - UNTIL C78 - CONTINUE - CONTINUE - END-PERFORM. - PERFORM VARYING V - FROM 1 BY 1 - UNTIL '2' - CONTINUE - CONTINUE - END-PERFORM. - IF NOTDEFINED = 1 OR 2 - CONTINUE - END-IF. - - IF (V = 1) AND V - CONTINUE - END-IF - - STOP RUN. -]) - -AT_CHECK([$COMPILE_ONLY prog.cob], [1], [], -[prog.cob:10: error: invalid expression -prog.cob:14: error: invalid expression -prog.cob:18: error: invalid expression -prog.cob:22: error: invalid expression -prog.cob:26: error: invalid expression -prog.cob:30: error: invalid conditional expression -prog.cob:35: error: invalid expression -prog.cob:38: error: invalid expression -prog.cob:41: error: invalid expression -prog.cob:44: error: invalid expression -prog.cob:47: error: invalid expression -prog.cob:54: error: invalid expression -prog.cob:60: error: invalid expression -prog.cob:66: error: invalid expression -prog.cob:72: error: invalid expression -prog.cob:76: error: 'NOTDEFINED' is not defined -prog.cob:76: error: invalid expression -prog.cob:80: error: invalid expression -]) - -AT_CLEANUP - - -AT_SETUP([Invalid conditional expression (2)]) -AT_KEYWORDS([misc]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 WRKN PIC S999 VALUE 123. - 01 WRKX PIC X(8) VALUE 'House'. - PROCEDURE DIVISION. - MAIN. - EVALUATE WRKN - GREATER ZERO - < 0 - > 0 - WHEN TRUE - DISPLAY "WHAT IS IT?" - END-EVALUATE. - IF WRKN = 123 EQUAL 456 - DISPLAY "Strange brew! " WRKN - END-IF. - IF WRKN NOT EQUAL 123 NOT = 456 - DISPLAY "Strange brew! " WRKN - END-IF. - IF WRKN = 123 OR 456 - DISPLAY "Home brew! " WRKN - END-IF. - IF WRKX = "Red" OR "White" - DISPLAY "Home wine! " WRKX - END-IF. - IF WRKX <= "Red" = "White" - DISPLAY "Home wine! " WRKX - END-IF. - IF WRKX = "Red" NOT "White" - DISPLAY "Home wine! " WRKX - END-IF. - IF WRKN = (123 - 12) OR - >= (456 + 16) - DISPLAY "And another brew! " WRKN - END-IF. - STOP RUN. -]) - -AT_CHECK([$COMPILE_ONLY prog.cob], [1], [], -[prog.cob: in paragraph 'MAIN': -prog.cob:10: error: GREATER THAN operator may be misplaced -prog.cob:17: error: EQUALS operator may be misplaced -prog.cob:20: error: NOT EQUAL operator may be misplaced -prog.cob:29: error: LESS OR EQUAL operator may be misplaced -prog.cob:32: error: invalid expression -]) - -AT_CLEANUP - - -AT_SETUP([Invalid conditional expression (3)]) -AT_KEYWORDS([expression condition]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - DATA DIVISION. - ****************************************************************** - WORKING-STORAGE SECTION. - * - 01 FLD1 PIC 9 VALUE 1. - 01 FLD2 PIC 9 VALUE 2. - 01 FLDX PIC 9 VALUE 5. - 01 FLDY PIC 9 VALUE 6. - - PROCEDURE DIVISION. - IF 1 AND 2 > 1 THEN - DISPLAY 'Test 1 is WRONG' - ELSE - DISPLAY 'Test 1 is OK'. - - IF FLD1 AND FLDX > FLD2 THEN - DISPLAY 'Test 2 is OK' - ELSE - DISPLAY 'Test 2 is Wrong'. - - IF FLD1 OR FLDX > FLD2 THEN - DISPLAY 'Test 2 is OK' - ELSE - DISPLAY 'Test 2 is Wrong'. - - IF FLD1 > 2 AND FLDX > FLD2 THEN - DISPLAY 'Test 2 is OK' - ELSE - DISPLAY 'Test 2 is Wrong'. - - IF FLD2 IS NUMERIC AND FLD1 THEN - DISPLAY 'Test 2 is OK' - ELSE - DISPLAY 'Test 2 is Wrong'. - - IF FLDX > FLD2 AND FLD1 AND 8 THEN - DISPLAY 'Test 3 is OK ' FLDX ' > ' FLD2 ' & ' FLD1 - ELSE - DISPLAY 'Test 3 is Wrong'. - - IF FLDX > FLD2 OR FLD1 OR 8 THEN - DISPLAY 'Test 3 is OK' - ELSE - DISPLAY 'Test 3 is Wrong'. - STOP RUN. -]) - -AT_CHECK([$COMPILE_ONLY prog.cob], [1], [], -[prog.cob:15: error: invalid conditional expression -prog.cob:20: error: invalid conditional expression -prog.cob:25: error: invalid conditional expression -prog.cob:35: error: invalid expression -]) - -AT_CLEANUP - - -AT_SETUP([Valid conditional expression]) -AT_KEYWORDS([misc]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 var PIC 999. - - PROCEDURE DIVISION. - IF var = 83 AND > 1 + 1 - CONTINUE - END-IF - IF var = 83 AND > 2 - CONTINUE - END-IF - IF var = 83 AND > (1 + 1) - CONTINUE - END-IF - IF (var NOT = 1) OR (var NOT = 2) - CONTINUE - END-IF - . -]) - -AT_CHECK([$COMPILE_ONLY prog.cob], [0], [], []) -AT_CHECK([$COMPILE_ONLY -fno-constant-folding prog.cob], [0], [], []) - -AT_CLEANUP - - -AT_SETUP([missing headers]) -AT_KEYWORDS([misc]) - -AT_DATA([prog.cob], [ - SOURCE-COMPUTER. GNU-LINUX. - SPECIAL-NAMES. - SYMBOLIC NL IS 101 - NL2 102 - NUMERIC SIGN TRAILING SEPARATE - DECIMAL-POINT IS COMMA - . - - SELECT PRINT-FILE ASSIGN "EXTRXW" - ORGANIZATION LINE SEQUENTIAL - . - DATA DIVISION. - FD PRINT-FILE EXTERNAL. - 01 PRINT-REC PIC X(64). - - DISPLAY "X" - END-DISPLAY - ACCEPT OMITTED - END-ACCEPT - GOBACK - . -]) - -AT_CHECK([$COMPILE_ONLY prog.cob], [1], [], -[prog.cob:2: error: PROGRAM-ID header missing -prog.cob:2: error: ENVIRONMENT DIVISION header missing -prog.cob:2: error: CONFIGURATION SECTION header missing -prog.cob:10: error: INPUT-OUTPUT SECTION header missing -prog.cob:10: error: FILE-CONTROL header missing -prog.cob:14: error: FILE SECTION header missing -prog.cob:17: error: PROCEDURE DIVISION header missing -]) - -AT_CHECK([$COMPILE_ONLY -frelax-syntax-checks prog.cob], [0], [], -[prog.cob:2: warning: PROGRAM-ID header missing - assumed -prog.cob:2: warning: ENVIRONMENT DIVISION header missing - assumed -prog.cob:2: warning: CONFIGURATION SECTION header missing - assumed -prog.cob:10: warning: INPUT-OUTPUT SECTION header missing - assumed -prog.cob:10: warning: FILE-CONTROL header missing - assumed -prog.cob:14: warning: FILE SECTION header missing - assumed -prog.cob:17: warning: PROCEDURE DIVISION header missing - assumed -]) - -AT_CLEANUP - - -AT_SETUP([one line program]) -AT_KEYWORDS([misc]) - -AT_DATA([prog.cob], [ DISPLAY "minimal". -]) - -AT_CHECK([$COMPILE_ONLY prog.cob], [1], [], -[prog.cob:1: error: PROGRAM-ID header missing -prog.cob:1: error: PROCEDURE DIVISION header missing -]) - -AT_CHECK([$COMPILE_ONLY -frelax-syntax-checks prog.cob], [0], [], -[prog.cob:1: warning: PROGRAM-ID header missing - assumed -prog.cob:1: warning: PROCEDURE DIVISION header missing - assumed -]) - -AT_CLEANUP - - -AT_SETUP([empty program]) -AT_KEYWORDS([misc]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 x PIC 999 VALUE 124. - END PROGRAM prog. -]) - -# Note: we need to test for generating a valid C source (with normal/no flags) -# here, not only for COBOL compilation -AT_CHECK([$COMPILE prog.cob], [0], [], []) -AT_CHECK([$COBC prog.cob], [0], [], []) - -AT_DATA([prog2.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog2. - - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 x PIC 999 VALUE 124. -]) - -AT_CHECK([$COMPILE prog2.cob], [0], [], []) -AT_CHECK([$COBC prog2.cob], [0], [], []) - -AT_DATA([prog3.cob], []) - -AT_CHECK([$COMPILE_ONLY prog3.cob], [1], [], -[prog3.cob:1: error: PROGRAM-ID header missing -]) - -AT_CHECK([$COMPILE -frelax-syntax-checks prog3.cob], [0], [], -[prog3.cob:1: warning: PROGRAM-ID header missing - assumed -]) -AT_CHECK([$COBC -frelax-syntax-checks prog3.cob], [0], [], -[prog3.cob:1: warning: PROGRAM-ID header missing - assumed -]) - -AT_CLEANUP - - -AT_SETUP([INITIALIZE constant]) -AT_KEYWORDS([misc]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 CON CONSTANT 10. - 01 V PIC 9. - 78 C78 VALUE 'A'. - PROCEDURE DIVISION. - INITIALIZE CON. - INITIALIZE V. - INITIALIZE V, 9. - INITIALIZE C78, V. -]) - -AT_CHECK([$COMPILE_ONLY prog.cob], [1], [], -[prog.cob:10: error: invalid INITIALIZE statement -prog.cob:12: error: invalid INITIALIZE statement -prog.cob:13: error: invalid INITIALIZE statement -]) - -AT_CLEANUP - - -AT_SETUP([CLASS duplicate values]) -AT_KEYWORDS([misc]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - CONFIGURATION SECTION. - SPECIAL-NAMES. - SYMBOLIC NL IS 101 - NL2 102 - CLASS CHECK-VALID 'a' THRU 'z' - 'A' THRU 'Z' - 'cdef' - . - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 X PIC X(8). - PROCEDURE DIVISION. - IF X IS CHECK-VALID - DISPLAY "OK" - END-DISPLAY - END-IF. - STOP RUN. -]) - -AT_CHECK([$COMPILE_ONLY prog.cob], [0], [], -[prog.cob:9: warning: duplicate character values in class 'CHECK-VALID' -]) - -AT_CLEANUP - - -AT_SETUP([INSPECT invalid size]) -AT_KEYWORDS([misc refmod]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - CONFIGURATION SECTION. - SPECIAL-NAMES. - ALPHABET ALPHA IS ASCII. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01. - 02 X-POS PIC 9 VALUE 3. - 02 X PIC X(8) OCCURS 2. - PROCEDURE DIVISION. - INSPECT X(1) REPLACING ALL SPACES BY "AA". - INSPECT X(1) REPLACING ALL "ABC" BY "AA". - INSPECT X(1) REPLACING ALL "DEF" BY SPACES. - INSPECT X(1) CONVERTING SPACES TO "AA". - INSPECT X(1) CONVERTING "ABC" TO "AA". - INSPECT X(1) (X-POS:2) CONVERTING "DEF" TO SPACES. - INSPECT X(1) CONVERTING "GHI" TO ALPHA. - *> the following is allowed, see NC221A and ref-mod definition - INSPECT X(1) CONVERTING "DEF" TO X(2) (X-POS:3). - INSPECT X(1) CONVERTING "DEF" TO X(2) (X-POS:4). - STOP RUN. -]) - -AT_CHECK([$COMPILE_ONLY prog.cob], [1], [], -[prog.cob:14: error: REPLACING operands differ in size -prog.cob:15: error: REPLACING operands differ in size -prog.cob:17: error: CONVERTING operands differ in size -prog.cob:18: error: CONVERTING operands differ in size -prog.cob:20: error: CONVERTING operands differ in size -prog.cob:23: error: CONVERTING operands differ in size -]) - -AT_CLEANUP - - -AT_SETUP([INSPECT invalid target]) -AT_KEYWORDS([misc]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 X PIC X(8). - PROCEDURE DIVISION. - INSPECT FUNCTION TRIM(X) REPLACING ALL "ABC" BY "DEF". - INSPECT FUNCTION TRIM(X) CONVERTING "ABC" TO "AAA". - STOP RUN. -]) - -AT_CHECK([$COMPILE_ONLY prog.cob], [1], [], -[prog.cob:8: error: invalid target for REPLACING -prog.cob:9: error: invalid target for CONVERTING -]) - -AT_CLEANUP - - -AT_SETUP([INSPECT missing keyword]) -AT_KEYWORDS([misc]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 X PIC X(8). - PROCEDURE DIVISION. - INSPECT X REPLACING "AB" BY "CD". - STOP RUN. -]) - -AT_CHECK([$COMPILE_ONLY prog.cob], [1], [], -[prog.cob:8: error: INSPECT missing ALL/FIRST/LEADING/TRAILING -]) - -AT_CLEANUP - - -AT_SETUP([INSPECT repeated keywords]) -AT_KEYWORDS([misc]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 x PIC 9(5). - - PROCEDURE DIVISION. - *> Ok - INSPECT "abcde" TALLYING x FOR CHARACTERS CHARACTERS - - *> Not ok - INSPECT "abcde" TALLYING x FOR ALL LEADING - TRAILING ALL ALL ALL TRAILING - INSPECT "abcde" TALLYING x FOR x FOR LEADING "a" - . -]) - -AT_CHECK([$COMPILE_ONLY prog.cob], [1], [], -[prog.cob:14: error: missing value between ALL/LEADING/TRAILING words -prog.cob:15: error: missing value between ALL/LEADING/TRAILING words -prog.cob:15: error: missing value between ALL/LEADING/TRAILING words -prog.cob:15: error: missing value between ALL/LEADING/TRAILING words -prog.cob:15: error: missing value between ALL/LEADING/TRAILING words -prog.cob:15: error: missing value between ALL/LEADING/TRAILING words -prog.cob:16: error: TALLYING clause is incomplete -prog.cob:16: error: missing CHARACTERS/ALL/LEADING/TRAILING phrase after FOR phrase -]) - -AT_CLEANUP - - -AT_SETUP([INSPECT incomplete clause]) -AT_KEYWORDS([misc]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 x PIC 9(5). - - PROCEDURE DIVISION. - INSPECT "abcde" TALLYING x FOR - . -]) - -AT_CHECK([$COMPILE_ONLY prog.cob], [1], [], -[prog.cob:11: error: TALLYING clause is incomplete -]) -AT_CLEANUP - - -AT_SETUP([INSPECT multiple BEFORE/AFTER clauses]) -AT_KEYWORDS([misc]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 x PIC X(10). - - PROCEDURE DIVISION. - INSPECT x REPLACING CHARACTERS BY "x" - BEFORE "A" BEFORE "b" AFTER "c" - . -]) - -AT_CHECK([$COMPILE_ONLY prog.cob], [1], [], -[prog.cob:11: error: syntax error, unexpected BEFORE -]) -AT_CLEANUP - - -AT_SETUP([maximum data size]) -AT_KEYWORDS([misc]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 SINGLE-ITEM PIC X(999999999). - 01 GROUP-ITEM1. - 05 FILLER PIC X(999999999). - 01 GROUP-ITEM2. - 05 FILLER PIC X(199999999). - 05 FILLER PIC X(199999999). - PROCEDURE DIVISION. - STOP RUN. - -]) - -AT_CHECK([$COMPILE_ONLY prog.cob], [1], [], -[prog.cob:6: error: 'SINGLE-ITEM' cannot be larger than 268435456 bytes -prog.cob:8: error: 'FILLER 1' cannot be larger than 268435456 bytes -prog.cob:7: error: 'GROUP-ITEM1' cannot be larger than 268435456 bytes -prog.cob:9: error: 'GROUP-ITEM2' cannot be larger than 268435456 bytes -]) - -AT_CLEANUP - - -AT_SETUP([unreachable statement]) -AT_KEYWORDS([misc extensions]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - INPUT-OUTPUT SECTION. - FILE-CONTROL. - SELECT f ASSIGN TO 'f' LINE SEQUENTIAL. - DATA DIVISION. - FILE SECTION. - FD f. - 01 f-rec PIC X. - WORKING-STORAGE SECTION. - PROCEDURE DIVISION. - DECLARATIVES. - f-error SECTION. - USE AFTER ERROR ON f. - GOBACK - . - END DECLARATIVES. - - DISPLAY "VALID" - END-DISPLAY. - - P01. - GO TO P02. - DISPLAY "INVALID" - END-DISPLAY. - P02. - GO TO P03 - CONTINUE. *> explicit no unreachable warning - P03. - GO TO P04 - CONTINUE AFTER 2 SECONDS. *> that's one again - P04. - STOP RUN. -]) - -AT_CHECK([$COMPILE_ONLY -Wunreachable prog.cob], [0], [], -[prog.cob: in paragraph 'P01': -prog.cob:26: warning: unreachable statement 'DISPLAY' -prog.cob: in paragraph 'P03': -prog.cob:33: warning: unreachable statement 'CONTINUE AFTER' -]) - -AT_CLEANUP - - -AT_SETUP([CRT STATUS]) -AT_KEYWORDS([SPECIAL-NAMES misc]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - CONFIGURATION SECTION. - SPECIAL-NAMES. - CRT STATUS IS MY-CRT-STATUS. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 X PIC X. - PROCEDURE DIVISION. - ACCEPT X END-ACCEPT. - STOP RUN. -]) - -AT_DATA([prog2.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog2. - ENVIRONMENT DIVISION. - CONFIGURATION SECTION. - SPECIAL-NAMES. - CRT STATUS IS MY-CRT-STATUS. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 X PIC X. - 77 MY-CRT-STATUS PIC 9(04). - PROCEDURE DIVISION. - ACCEPT X END-ACCEPT. - STOP RUN. -]) - -AT_CHECK([$COMPILE_ONLY prog.cob], [1], [], -[prog.cob:7: error: 'MY-CRT-STATUS' is not defined -]) -AT_CHECK([$COMPILE_ONLY prog2.cob], [0], [], []) - -AT_CLEANUP - - -AT_SETUP([SPECIAL-NAMES clause]) -AT_KEYWORDS([misc extensions CURSOR CRT STATUS]) - -# FIXME: actually this is the only place for some CRT STATUS checks... - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - CONFIGURATION SECTION. - SPECIAL-NAMES. - CRT STATUS IS MY-CRT-STATUS. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 CURSOR-POSITION IS SPECIAL-NAMES CURSOR. - 03 CURSOR-ROW PIC 999. - 03 CURSOR-COL PIC 999. - 77 MY-CRT-STATUS PIC 9(04). - 77 CRT-STATUS IS SPECIAL-NAMES CRT STATUS PIC 9(5). - PROCEDURE DIVISION. - ACCEPT OMITTED END-ACCEPT. - STOP RUN. -]) - -AT_DATA([prog2.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 77 CRT-STATUS IS SPECIAL-NAMES CRT STATUS PIC X(5). - PROCEDURE DIVISION. - ACCEPT OMITTED END-ACCEPT. - STOP RUN. -]) - -AT_DATA([prog3.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 CURSOR-POSITION IS SPECIAL-NAMES CURSOR. - 03 CURSOR-ROW PIC 999. - 03 CURSOR-COL PIC 999. - 77 CRT-STATUS PIC X(4) IS SPECIAL-NAMES CRT STATUS. - PROCEDURE DIVISION. - ACCEPT OMITTED END-ACCEPT. - STOP RUN. -]) - -AT_DATA([prog4.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 CURSOR-POSITION IS SPECIAL-NAMES CURSOR. - 03 CURSOR-ROW PIC 999. - 03 CURSOR-COL PIC 999. - 77 CRT-STATUS PIC 9(5) IS SPECIAL-NAMES CRT STATUS. - PROCEDURE DIVISION. - ACCEPT OMITTED END-ACCEPT. - STOP RUN. -]) - -AT_DATA([prog5.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 77 CRT-STATUS PIC 9(3) IS SPECIAL-NAMES CRT STATUS. - PROCEDURE DIVISION. - ACCEPT OMITTED END-ACCEPT. - STOP RUN. -]) - -AT_CHECK([$COMPILE_ONLY prog.cob], [1], [], -[prog.cob:14: error: duplicate CRT STATUS clause -]) -AT_CHECK([$COMPILE_ONLY prog2.cob], [1], [], -[prog2.cob:6: error: 'CRT-STATUS' CRT STATUS must be 4 characters long -]) -AT_CHECK([$COMPILE_ONLY prog3.cob], [0], [], []) -AT_CHECK([$COMPILE_ONLY prog4.cob], [0], [], []) -AT_CHECK([$COMPILE_ONLY prog5.cob], [1], [], -[prog5.cob:6: error: 'CRT-STATUS' CRT STATUS must have at least 4 digits -]) - -AT_CLEANUP - - -AT_SETUP([CURRENCY SIGN]) -AT_KEYWORDS([SPECIAL-NAMES misc]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - CONFIGURATION SECTION. - SPECIAL-NAMES. - CURRENCY SIGN IS '*'. -]) - -AT_DATA([prog2.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog2. - ENVIRONMENT DIVISION. - CONFIGURATION SECTION. - SPECIAL-NAMES. - CURRENCY 'DOLLAR'. -]) - -AT_DATA([prog3.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog3. - ENVIRONMENT DIVISION. - CONFIGURATION SECTION. - SPECIAL-NAMES. - CURRENCY 'DOLLAR' - WITH PICTURE SYMBOL '$'. - DATA DIVISION. - WORKING-STORAGE SECTION. - 77 SOME-CASH PIC 9(04).99$. - PROCEDURE DIVISION. - MOVE 123.4 TO SOME-CASH - DISPLAY SOME-CASH END-DISPLAY. - STOP RUN. -]) - -AT_DATA([prog4.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog4. - ENVIRONMENT DIVISION. - CONFIGURATION SECTION. - SPECIAL-NAMES. - CURRENCY ' ' - PICTURE SYMBOL '*'. -]) - -AT_DATA([prog5.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog5. - ENVIRONMENT DIVISION. - CONFIGURATION SECTION. - SPECIAL-NAMES. - CURRENCY ' T ' - PICTURE SYMBOL ' '. -]) - -AT_DATA([prog6.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog6. - ENVIRONMENT DIVISION. - CONFIGURATION SECTION. - SPECIAL-NAMES. - CURRENCY '+-' - PICTURE SYMBOL 'TT'. -]) - -AT_DATA([prog7.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog7. - ENVIRONMENT DIVISION. - CONFIGURATION SECTION. - SPECIAL-NAMES. - CURRENCY SIGN IS 'T'. - DATA DIVISION. - WORKING-STORAGE SECTION. - 77 SOME-CASH PIC 9(04).99T. - PROCEDURE DIVISION. - MOVE 123.4 TO SOME-CASH - DISPLAY SOME-CASH END-DISPLAY. - STOP RUN. -]) - -AT_CHECK([$COMPILE_ONLY prog.cob], [1], [], -[prog.cob:7: error: invalid character '*' in currency symbol -]) -AT_CHECK([$COMPILE_ONLY prog2.cob], [1], [], -[prog2.cob:7: error: currency symbol must be one character long -]) -AT_CHECK([$COMPILE_ONLY prog3.cob], [0], [], -[prog3.cob:7: warning: separate currency symbol and currency string is not implemented -]) -AT_CHECK([$COMPILE_ONLY prog4.cob], [1], [], -[prog4.cob:7: warning: separate currency symbol and currency string is not implemented -prog4.cob:7: error: invalid CURRENCY SIGN ' ' -prog4.cob:8: error: invalid character '*' in currency symbol -]) -AT_CHECK([$COMPILE_ONLY prog5.cob], [1], [], -[prog5.cob:7: warning: separate currency symbol and currency string is not implemented -prog5.cob:8: error: invalid character ' ' in currency symbol -]) -AT_CHECK([$COMPILE_ONLY prog6.cob], [1], [], -[prog6.cob:7: warning: separate currency symbol and currency string is not implemented -prog6.cob:7: error: invalid CURRENCY SIGN '+-' -prog6.cob:8: error: currency symbol must be one character long -]) -AT_CHECK([$COMPILE_ONLY prog7.cob], [0], [], []) - -AT_CLEANUP - - -AT_SETUP([SWITCHES]) -AT_KEYWORDS([runmisc extensions]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - CONFIGURATION SECTION. - SPECIAL-NAMES. - SW1 - ON IS SWIT1-ON - OFF IS SWIT1-OFF - . - SWITCH B IS SWITCH-B - ON IS SWIT2-ON - OFF IS SWIT2-OFF - . - SWITCH-25 - ON IS SWIT25-ON - OFF IS SWIT25-OFF - . - SWITCH-25 - ON IS SWIT25-IS-ON - OFF IS SWIT25-IS-OFF - . - SWITCH 25 - ON IS SWIT25-SP-ON - OFF IS SWIT25-SP-OFF - . - SWITCH Y - ON IS SWIT25-Y-ON - OFF IS SWIT25-Y-OFF - . - SWITCH Z - ON IS SWIT26-ON - ON IS SWIT26-OFF - . - SWITCH-32 - ON IS SWIT32-ON - . - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 SWITCH PIC 99 VALUE 12. - PROCEDURE DIVISION. - ADD SWITCH 1 GIVING SWITCH - END-ADD. - IF SWITCH NOT = 13 - DISPLAY "SWITCH (variable) WRONG: " - SWITCH - END-DISPLAY - END-IF. - IF SWIT1-ON - DISPLAY "ON" - END-DISPLAY - ELSE - DISPLAY "OFF" - END-DISPLAY - END-IF. - IF SWIT2-ON - DISPLAY " ON" - END-DISPLAY - ELSE - DISPLAY " OFF" - END-DISPLAY - END-IF. - SET SWITCH-B TO OFF - IF SWIT2-ON - CONTINUE - END-IF. - IF SWIT25-ON - CONTINUE - END-IF. - IF SWIT26-ON - CONTINUE - END-IF. - IF SWIT32-ON - CONTINUE - END-IF. - IF SWIT32-OFF - CONTINUE - END-IF. - STOP RUN. -]) - -AT_CHECK([$COMPILE_ONLY prog.cob], [1], [], -[prog.cob:7: error: invalid system-name 'SW1' -prog.cob:8: error: ON/OFF usage requires a SWITCH name -prog.cob:9: error: ON/OFF usage requires a SWITCH name -prog.cob:11: error: invalid system-name 'SWITCH B' -prog.cob:12: error: ON/OFF usage requires a SWITCH name -prog.cob:13: error: ON/OFF usage requires a SWITCH name -prog.cob:23: error: invalid system-name 'SWITCH 25' -prog.cob:24: error: ON/OFF usage requires a SWITCH name -prog.cob:25: error: ON/OFF usage requires a SWITCH name -prog.cob:27: error: invalid system-name 'SWITCH Y' -prog.cob:28: error: ON/OFF usage requires a SWITCH name -prog.cob:29: error: ON/OFF usage requires a SWITCH name -prog.cob:31: error: invalid system-name 'SWITCH Z' -prog.cob:32: error: ON/OFF usage requires a SWITCH name -prog.cob:33: error: ON/OFF usage requires a SWITCH name -prog.cob:49: error: 'SWIT1-ON' is not defined -prog.cob:56: error: 'SWIT2-ON' is not defined -prog.cob:63: error: 'SWITCH-B' is not defined -prog.cob:63: error: syntax error, unexpected OFF -prog.cob:64: error: 'SWIT2-ON' is not defined -prog.cob:70: error: 'SWIT26-ON' is not defined -prog.cob:76: error: 'SWIT32-OFF' is not defined -]) -# FIXME: There should be an additional -#prog.cob:19: error: duplicate definition of 'SWITCH-25' -#prog.cob:15: error: 'SWITCH-25' previously defined here -# -AT_CHECK([$COMPILE_ONLY -std=acu-strict -fsystem-name=SW1 -fno-relax-syntax-checks prog.cob], [1], [], -[prog.cob:33: error: duplicate ON clause -prog.cob:76: error: 'SWIT32-OFF' is not defined -]) -# FIXME: There should be an additional -#prog.cob:19: error: duplicate definition of 'SWITCH-25' -#prog.cob:15: error: 'SWITCH-25' previously defined here -#prog.cob:23: error: duplicate definition of 'SWITCH 25' -#prog.cob:15: error: 'SWITCH-25' previously defined here -#prog.cob:27: error: duplicate definition of 'SWITCH Y' -#prog.cob:15: error: 'SWITCH-25' previously defined here - -AT_CLEANUP - - -AT_SETUP([unexpected mnemonic-name location]) -AT_KEYWORDS([misc]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - CONFIGURATION SECTION. - SPECIAL-NAMES. - stdin IS my-stdin - . - PROCEDURE DIVISION. - CALL "something" USING stdout - CALL "something" USING stdin - CALL "something" USING my-stdin - . -]) - -AT_CHECK([$COMPILE_ONLY prog.cob], [1], [], -[prog.cob:10: error: invalid mnemonic identifier -prog.cob:11: error: invalid mnemonic identifier -prog.cob:12: error: invalid mnemonic identifier -]) - -AT_CLEANUP - - -AT_SETUP([wrong device for mnemonic-name]) -AT_KEYWORDS([misc ACCEPT DISPLAY SPECIAL-NAMES]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 77 var PIC x. - PROCEDURE DIVISION. - ACCEPT var FROM SYSOUT - DISPLAY var UPON SYSIN - ACCEPT var FROM SYSIN - DISPLAY var UPON SYSOUT - . -]) - -AT_CHECK([$COMPILE_ONLY prog.cob], [1], [], -[prog.cob:8: error: 'SYSOUT' is not an input device -prog.cob:9: error: 'SYSIN' is not an output device -]) - -AT_CLEANUP - - -AT_SETUP([missing mnemonic-name declaration]) -AT_KEYWORDS([misc ACCEPT SPECIAL-NAMES]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 77 var PIC x. - PROCEDURE DIVISION. - ACCEPT var FROM mnemonic-name - . -]) - -AT_CHECK([$COMPILE_ONLY prog.cob], [1], [], -[prog.cob:8: error: unknown device 'mnemonic-name'; not defined in SPECIAL-NAMES -]) - -AT_CLEANUP - - -AT_SETUP([unknown device in dialect]) -AT_KEYWORDS([misc ACCEPT DISPLAY SPECIAL-NAMES]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 77 var PIC x. - PROCEDURE DIVISION. - ACCEPT var FROM COMMAND-LINE - DISPLAY var UPON COMMAND-LINE - . -]) - -AT_CHECK([$COMPILE_ONLY prog.cob], [0], [], []) - -# Checkme: Error currently doesn't occur for UPON_COMMAND_LINE as this is already tokenized -# in scanner.l. We just ignore this for now and maybe fix it later. -#AT_CHECK([$COMPILE_ONLY -fnot-reserved=COMMAND-LINE prog.cob], [1], [], -#[prog.cob:8: error: unknown device 'COMMAND-LINE'; it may exist in another dialect -#prog.cob:9: error: unknown device 'COMMAND-LINE'; it may exist in another dialect -#]) -AT_CHECK([$COMPILE_ONLY -fnot-reserved=COMMAND-LINE prog.cob], [1], [], -[prog.cob:8: error: unknown device 'COMMAND-LINE'; it may exist in another dialect -]) - -AT_CLEANUP - - -AT_SETUP([ACCEPT WITH ( NO ) UPDATE / DEFAULT]) -AT_KEYWORDS([misc extensions]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - CONFIGURATION SECTION. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 X PIC X. - PROCEDURE DIVISION. - ACCEPT X END-ACCEPT. - ACCEPT X WITH UPDATE END-ACCEPT. - ACCEPT X WITH DEFAULT END-ACCEPT. - ACCEPT X WITH NO UPDATE END-ACCEPT. - ACCEPT X WITH NO DEFAULT END-ACCEPT. - STOP RUN. -]) - -AT_CHECK([$COMPILE_ONLY -faccept-update prog.cob], [0], [], []) - -AT_CLEANUP - - -AT_SETUP([ACCEPT WITH AUTO / TAB]) -AT_KEYWORDS([AUTO-SKIP AUTOTERMINATE misc extensions screen]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - CONFIGURATION SECTION. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 X PIC X. - PROCEDURE DIVISION. - ACCEPT X END-ACCEPT. - ACCEPT X WITH AUTO END-ACCEPT. - ACCEPT X WITH AUTO-SKIP END-ACCEPT. - ACCEPT X WITH AUTOTERMINATE END-ACCEPT. - ACCEPT X WITH TAB END-ACCEPT. - STOP RUN. -]) - -AT_CHECK([$COMPILE_ONLY -faccept-auto prog.cob], [0], [], []) - -AT_CLEANUP - - -AT_SETUP([ACCEPT WITH LOWER / UPPER]) -AT_KEYWORDS([misc extensions screen]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 X PIC X(05). - PROCEDURE DIVISION. - ACCEPT X WITH LOWER END-ACCEPT. - ACCEPT X WITH UPPER END-ACCEPT. - ACCEPT X LOWER - ACCEPT X UPPER - STOP RUN. -]) - -AT_CHECK([$COMPILE_ONLY prog.cob], [0], [], []) - -AT_CLEANUP - - -AT_SETUP([ACCEPT WITH SIZE]) -AT_KEYWORDS([PROTECTED SIZE misc extensions screen]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 X PIC X(05). - 01 Y PIC 9(04) BINARY VALUE 4. - PROCEDURE DIVISION. - ACCEPT X WITH SIZE 0 END-ACCEPT. - ACCEPT X WITH SIZE IS 1 END-ACCEPT. - ACCEPT X WITH PROTECTED SIZE 2 END-ACCEPT. - ACCEPT X WITH PROTECTED SIZE IS 3 END-ACCEPT. - ACCEPT X SIZE Y END-ACCEPT. - ACCEPT X SIZE 0 - ACCEPT X SIZE IS 1 - ACCEPT X PROTECTED SIZE 2 - ACCEPT X PROTECTED SIZE IS 3 - ACCEPT X SIZE Y - STOP RUN. -]) - -AT_CHECK([$COMPILE_ONLY prog.cob], [0], [], []) - -AT_CLEANUP - - -AT_SETUP([DISPLAY WITH SIZE]) -AT_KEYWORDS([SIZE misc extensions screen]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 X PIC X(05). - 01 Y PIC 9(04) BINARY VALUE 7. - PROCEDURE DIVISION. - DISPLAY X AT 0101 WITH SIZE 5 END-DISPLAY. - DISPLAY X AT 0101 WITH SIZE IS 6 END-DISPLAY. - DISPLAY X AT 0101 WITH SIZE IS Y END-DISPLAY. - DISPLAY X AT 0101 SIZE 5 END-DISPLAY. - DISPLAY X AT 0101 SIZE IS 6 END-DISPLAY. - DISPLAY X AT 0101 SIZE IS Y END-DISPLAY. - STOP RUN. -]) - -AT_CHECK([$COMPILE_ONLY prog.cob], [0], [], []) - -AT_CLEANUP - - -AT_SETUP([source text after program-text area]) -AT_KEYWORDS([misc fixed]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - CONFIGURATION SECTION. - DATA DIVISION. - WORKING-STORAGE SECTION. - PROCEDURE DIVISION. COMMENT - STOP RUN. -]) - -AT_CHECK([$COMPILE_ONLY -W prog.cob], [0], [], -[prog.cob:8: warning: source text after program-text area (column 72) -]) - -AT_CLEANUP - - -AT_SETUP([line overflow in Fixed-form / Free-form]) -AT_KEYWORDS([misc]) - -# We're testing trailing tabs and whitespace (should not lead to warning) -# along with comments after boundaries (col 72 / col 512) - -# AT_DATA removes trailing spaces, workaround: add "_" and -# remove it later via sed - -AT_DATA([prog_tmpl.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - CONFIGURATION SECTION. _ - DATA DIVISION. _ - WORKING-STORAGE SECTION. *> This is a real comment - PROCEDURE DIVISION. This is commentary only - CONTINUE. *> comment after column 72 - * This is a very long comment that exceeds column 72 but doesn't exceed 512 bytes, therefore not leading to a line overflow. As it is a comment line there is no "Source text after column 72" warning - CONTINUE. CONTINUE. - CONTINUE. _ - STOP RUN. -]) - -# AT_DATA workaround via sed: -AT_CHECK([sed -e 's/_$//' prog_tmpl.cob > prog.cob], [0], [], []) - -AT_CHECK([$COMPILE_ONLY -fixed -W prog.cob], [0], [], -[prog.cob:7: warning: source text exceeds 512 bytes, will be truncated -prog.cob:8: warning: source text exceeds 512 bytes, will be truncated -prog.cob:11: warning: source text after program-text area (column 72) -]) - -AT_CHECK([$COMPILE_ONLY -free -W prog.cob], [1], [], -[prog.cob:7: warning: source text exceeds 512 bytes, will be truncated -prog.cob:8: warning: source text exceeds 512 bytes, will be truncated -prog.cob:8: error: unknown statement 'This' -]) - -AT_CHECK([$COMPILE_ONLY -F -W prog.cob], [1], [], -[prog.cob:7: warning: source text exceeds 512 bytes, will be truncated -prog.cob:8: warning: source text exceeds 512 bytes, will be truncated -prog.cob:8: error: unknown statement 'This' -]) - -AT_CLEANUP - - -AT_SETUP([continuation Indicator - too many lines]) -AT_KEYWORDS([misc fixed literals listing]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - CONFIGURATION SECTION. - DATA DIVISION. - WORKING-STORAGE SECTION. - PROCEDURE DIVISION. - DISPLAY ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' ' END-DISPLAY. - STOP RUN. -]) - -AT_CHECK([$COMPILE_ONLY prog.cob], [1], [], -[prog.cob:538: error: buffer overrun - too many continuation lines -]) - -# extra test with listing as this is an edge case there -AT_CAPTURE_FILE([prog.lst]) -AT_CHECK([$COMPILE_ONLY -t prog.lst prog.cob], [1], [], -[prog.cob:538: error: buffer overrun - too many continuation lines -]) - -AT_CLEANUP - - -AT_SETUP([continuation of COBOL words]) -AT_KEYWORDS([misc fixed literals]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - PROCEDURE DIVISION. - GO - - BACK. -]) - -AT_CHECK([$COMPILE_ONLY -std=cobol2014 prog.cob], [0], [], -[prog.cob:6: warning: continuation of COBOL words is archaic in COBOL 2014 -]) -AT_CHECK([$COMPILE_ONLY prog.cob], [0], [], -[prog.cob:6: warning: continuation of COBOL words used -]) - -AT_CLEANUP - - -AT_SETUP([literal too long]) -AT_KEYWORDS([misc literals literal-length continuation listing]) - - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - CONFIGURATION SECTION. - DATA DIVISION. - WORKING-STORAGE SECTION. - PROCEDURE DIVISION. - DISPLAY ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' - - ' '. - STOP RUN. -]) - -AT_DATA([prog2.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog2. - ENVIRONMENT DIVISION. - CONFIGURATION SECTION. - DATA DIVISION. - WORKING-STORAGE SECTION. - PROCEDURE DIVISION. - DISPLAY ' '- - ' '- - ' '- - ' '- - ' '- - ' '- - ' '- - ' '- - ' '- - ' '- - ' '- - ' '- - ' '- - ' '- - ' '- - ' '- - ' '- - ' '- - ' '- - ' '- - ' '- - ' '- - ' '- - ' '- - ' '- - ' '- - ' '- - ' '- - ' '- - ' '- - ' '- - ' '- - ' '- - ' '- - ' '- - ' '- - ' '- - ' ' END-DISPLAY. - STOP RUN. -]) - -AT_CHECK([$COMPILE_ONLY prog.cob], [1], [], -[prog.cob:9: error: invalid literal: ' ...' -prog.cob:9: error: literal length exceeds 8191 characters -]) - -AT_CHECK([$COMPILE_ONLY -fliteral-length=160 prog.cob], [1], [], -[prog.cob:9: error: invalid literal: ' ...' -prog.cob:9: error: literal length exceeds 160 characters -]) - -AT_CHECK([$COMPILE_ONLY -free prog2.cob], [1], [], -[prog2.cob:43: error: invalid literal: ' ...' -prog2.cob:43: error: literal length 8299 exceeds 8191 characters -]) - -# extra test with listing as this is an edge case there -AT_CAPTURE_FILE([prog.lst]) -AT_CHECK([$COMPILE_ONLY -t prog.lst prog.cob], [1], [], -[prog.cob:9: error: invalid literal: ' ...' -prog.cob:9: error: literal length exceeds 8191 characters -]) - -AT_CAPTURE_FILE([prog2.lst]) -AT_CHECK([$COMPILE_ONLY -free -t prog2.lst prog2.cob], [1], [], -[prog2.cob:43: error: invalid literal: ' ...' -prog2.cob:43: error: literal length 8299 exceeds 8191 characters -]) - -AT_CLEANUP - - -AT_SETUP([line and floating comments]) -AT_KEYWORDS([misc extensions indicator]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - CONFIGURATION SECTION. - DATA DIVISION. - WORKING-STORAGE SECTION. - PROCEDURE DIVISION. - * DISPLAY 'COMMENT' END-DISPLAY - / DISPLAY 'COMMENTSLASH' END-DISPLAY -* DISPLAY 'MFCOMMENTASTERISK' END-DISPLAY -/ DISPLAY 'MFCOMMENTSLASH' END-DISPLAY - * DISPLAY 'NOMFCOMMENTASTERISK' END-DISPLAY - / DISPLAY 'NOMFCOMMENTSLASH' END-DISPLAY - *> DISPLAY 'FLOATING' END-DISPLAY - *> DISPLAY 'NOFLOATING' END-DISPLAY - STOP RUN. -]) - -AT_DATA([prog2.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog2. - ENVIRONMENT DIVISION. - CONFIGURATION SECTION. - DATA DIVISION. - WORKING-STORAGE SECTION. - PROCEDURE DIVISION. - * DISPLAY 'COMMENT' END-DISPLAY - / DISPLAY 'COMMENTSLASH' END-DISPLAY - $ DISPLAY 'COMMENTDOLLAR' END-DISPLAY -* DISPLAY 'MFCOMMENTASTERISK' END-DISPLAY -/ DISPLAY 'MFCOMMENTSLASH' END-DISPLAY - * DISPLAY 'NOMFCOMMENTASTERISK' END-DISPLAY - / DISPLAY 'NOMFCOMMENTSLASH' END-DISPLAY - *> DISPLAY 'FLOATING' END-DISPLAY - | DISPLAY 'ACUFLOATING' END-DISPLAY - | DISPLAY 'NOACUFLOATING' END-DISPLAY - *> DISPLAY 'NOFLOATING' END-DISPLAY - STOP RUN. -]) - -AT_DATA([prog3.cob], [ -IDENTIFICATION DIVISION. -PROGRAM-ID. prog3. -ENVIRONMENT DIVISION. -CONFIGURATION SECTION. -DATA DIVISION. -WORKING-STORAGE SECTION. -PROCEDURE DIVISION. - * DISPLAY 'NOCOMMENT' END-DISPLAY - / DISPLAY 'NOCOMMENTSLASH' END-DISPLAY - $ DISPLAY 'NOCOMMENTDOLLAR' END-DISPLAY -* DISPLAY 'NOMFCOMMENTASTERISK' END-DISPLAY -/ DISPLAY 'NOMFCOMMENTSLASH' END-DISPLAY - | DISPLAY 'ACUFLOATING' END-DISPLAY - *> DISPLAY 'FLOATING' END-DISPLAY - x DISPLAY 'WRONGINDICATOR' END-DISPLAY - STOP RUN. -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) - -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], -[MFCOMMENTASTERISK -MFCOMMENTSLASH -NOMFCOMMENTASTERISK -NOMFCOMMENTSLASH -NOFLOATING -], []) - -AT_CHECK([$COMPILE_ONLY prog2.cob], [1], [], -[prog2.cob:11: error: invalid indicator '$' at column 7 -prog2.cob:17: error: invalid symbol '|' - skipping word -]) - -# note: for checking the result we actually either need to run the program -# or change it to string concatenation and raise a constant compile time warning -# we do (historically) the first (for now) -# -AT_CHECK([$COMPILE -fmfcomment prog.cob], [0], [], -[]) - -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], -[NOMFCOMMENTASTERISK -NOMFCOMMENTSLASH -NOFLOATING -], []) - -AT_CHECK([$COMPILE_ONLY -fmfcomment prog2.cob], [1], [], -[prog2.cob:11: error: invalid indicator '$' at column 7 -prog2.cob:17: error: invalid symbol '|' - skipping word -]) - -# COMPILE needed, see note above -AT_CHECK([$COMPILE -facucomment prog.cob -o prog1], [0], [], []) - -AT_CHECK([$COBCRUN_DIRECT ./prog1], [0], -[MFCOMMENTASTERISK -MFCOMMENTSLASH -NOMFCOMMENTASTERISK -NOMFCOMMENTSLASH -NOFLOATING -], []) - -# COMPILE needed, see note above -AT_CHECK([$COMPILE -facucomment prog2.cob], [0], [], []) - -AT_CHECK([$COBCRUN_DIRECT ./prog2], [0], -[MFCOMMENTASTERISK -MFCOMMENTSLASH -NOMFCOMMENTASTERISK -NOMFCOMMENTSLASH -NOACUFLOATING -NOFLOATING -], []) - - -AT_CHECK([$COMPILE_ONLY -free prog3.cob], [1], [], -[prog3.cob:11: warning: spurious '$' detected - ignored -prog3.cob:9: error: syntax error, unexpected * -prog3.cob:10: error: syntax error, unexpected / -prog3.cob:12: error: syntax error, unexpected * -prog3.cob:13: error: syntax error, unexpected / -prog3.cob:14: error: invalid symbol '|' - skipping word -prog3.cob:16: error: syntax error, unexpected Identifier -]) -AT_CHECK([$COMPILE_ONLY -free -fmfcomment prog3.cob], [1], [], -[prog3.cob:11: warning: spurious '$' detected - ignored -prog3.cob:9: error: syntax error, unexpected * -prog3.cob:10: error: syntax error, unexpected / -prog3.cob:12: error: syntax error, unexpected * -prog3.cob:13: error: syntax error, unexpected / -prog3.cob:14: error: invalid symbol '|' - skipping word -prog3.cob:16: error: syntax error, unexpected Identifier -]) -AT_CHECK([$COMPILE_ONLY -free -facucomment prog3.cob], [1], [], -[prog3.cob:11: warning: spurious '$' detected - ignored -prog3.cob:9: error: syntax error, unexpected * -prog3.cob:10: error: syntax error, unexpected / -prog3.cob:12: error: syntax error, unexpected * -prog3.cob:13: error: syntax error, unexpected / -prog3.cob:16: error: syntax error, unexpected Identifier -]) -# Check that invalid indicator and doesn't abort preprocessing -# and that errors in preprocessing doesn't abort compilation -AT_CHECK([$COMPILE_ONLY prog3.cob], [1], [], -[prog3.cob:2: error: invalid indicator 'F' at column 7 -prog3.cob:3: error: invalid indicator 'M' at column 7 -prog3.cob:4: error: invalid indicator 'N' at column 7 -prog3.cob:5: error: invalid indicator 'U' at column 7 -prog3.cob:7: error: invalid indicator 'G' at column 7 -prog3.cob:8: error: invalid indicator 'U' at column 7 -prog3.cob:11: error: invalid indicator '$' at column 7 -prog3.cob:16: error: invalid indicator 'x' at column 7 -prog3.cob:6: error: PROGRAM-ID header missing -prog3.cob:6: error: PROCEDURE DIVISION header missing -prog3.cob:6: error: syntax error, unexpected DIVISION -]) - -AT_CLEANUP - - -AT_SETUP([word length]) -AT_KEYWORDS([misc word-length]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - CONFIGURATION SECTION. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 FILLER PIC 9(01) VALUE 0. - 88 SOME-SPECIAL-VAL-WITH-LENGTH30 VALUE 0. - 88 SOME-SPECIAL-VAL-WITH-LENGTH-31 VALUE 1. - 88 SOME-SPECIAL-VAL-WITH-LENGTH-32C VALUE 1. - 88 SOME-SPECIAL-VAL-WITH-LENGTH-58C-WHO-NEEDS-THAT-LONG-NAMES VALUE 3. - 88 SOME-SPECIAL-VAL-WITH-LENGTH-90-CHARS-WHO-NEEDS-THAT-LONG-NAMES-I-CANNOT-THINK-OF-SOMEONE VALUE 4. - PROCEDURE DIVISION. - SOME-SPECIAL-PAR-WITH-LENGTH30. - SET SOME-SPECIAL-VAL-WITH-LENGTH30 TO TRUE. - SOME-SPECIAL-PAR-WITH-LENGTH-31. - SET SOME-SPECIAL-VAL-WITH-LENGTH-31 TO TRUE. - SOME-SPECIAL-PAR-WITH-LENGTH-32C. - SET SOME-SPECIAL-VAL-WITH-LENGTH-32C TO TRUE. - SOME-SPECIAL-PAR-WITH-LENGTH-58C-WHO-NEEDS-THAT-LONG-NAMES. - SET SOME-SPECIAL-VAL-WITH-LENGTH-58C-WHO-NEEDS-THAT-LONG-NAMES TO TRUE. - SOME-SPECIAL-PAR-WITH-LENGTH-90-CHARS-WHO-NEEDS-THAT-LONG-NAMES-I-CANNOT-THINK-OF-SOMEONE. - SET SOME-SPECIAL-VAL-WITH-LENGTH-90-CHARS-WHO-NEEDS-THAT-LONG-NAMES-I-CANNOT-THINK-OF-SOMEONE TO TRUE. - STOP RUN. -]) - -AT_DATA([prog2.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog2. - ENVIRONMENT DIVISION. - CONFIGURATION SECTION. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 FILLER PIC 9(01) VALUE 0. - 88 SOME-SPECIAL-VAL-WITH-LENGTH30 VALUE 0. - 88 SOME-SPECIAL-VAL-WITH-LENGTH-31 VALUE 1. - 88 SOME-SPECIAL-VAL-WITH-LENGTH-32C VALUE 1. - 88 SOME-SPECIAL-VAL-WITH-LENGTH-58C-WHO-NEEDS-THAT-LONG-NAMES VALUE 3. - PROCEDURE DIVISION. - SOME-SPECIAL-PAR-WITH-LENGTH30. - SET SOME-SPECIAL-VAL-WITH-LENGTH30 TO TRUE. - SOME-SPECIAL-PAR-WITH-LENGTH-31. - SET SOME-SPECIAL-VAL-WITH-LENGTH-31 TO TRUE. - SOME-SPECIAL-PAR-WITH-LENGTH-32C. - SET SOME-SPECIAL-VAL-WITH-LENGTH-32C TO TRUE. - SOME-SPECIAL-PAR-WITH-LENGTH-58C-WHO-NEEDS-THAT-LONG-NAMES. - SET SOME-SPECIAL-VAL-WITH-LENGTH-58C-WHO-NEEDS-THAT-LONG-NAMES TO TRUE. - STOP RUN. -]) - -AT_DATA([prog3.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog3. - DATA DIVISION. - WORKING-STORAGE SECTION. - 77 COUNTER PIC 9 VALUE 0. - PROCEDURE DIVISION. - - 00000000000000000000000000000000000000000000000000000000000 - SECTION. - 000000000000000000000000000000000000000000000000000000000000. - ADD 1 TO COUNTER END-ADD - EVALUATE COUNTER - WHEN 1 - PERFORM - 00000000000000000000000000000000000000000000000000000000000 - WHEN 2 - PERFORM - 000000000000000000000000000000000000000000000000000000000000 - WHEN 3 - MOVE 0 TO COUNTER - END-EVALUATE. - - 100000000000000000000000000000000000000000000000000000000001 - SECTION. - 20000000000000000000000000000000000000000000000000000000002. - ADD 1 TO COUNTER END-ADD - EVALUATE COUNTER - WHEN 1 - PERFORM - 100000000000000000000000000000000000000000000000000000000001 - WHEN 2 - PERFORM - 20000000000000000000000000000000000000000000000000000000002 - WHEN 3 - MOVE 0 TO COUNTER - END-EVALUATE. - - STOP RUN. -]) - -AT_CHECK([$COMPILE_ONLY -free -fword-length=31 prog.cob], [1], [], -[prog.cob:11: error: word length exceeds 31 characters: 'SOME-SPECIAL-VAL-WITH-LENGTH-32C' -prog.cob:12: error: word length exceeds 31 characters: 'SOME-SPECIAL-VAL-WITH-LENGTH-58C-WHO-NEEDS-THAT-LONG-NAMES' -prog.cob:13: error: word length exceeds maximum of 63 characters: 'SOME-SPECIAL-VAL-WITH-LENGTH-90-CHARS-WHO-NEEDS-THAT-LONG-NAMES-I-CANNOT-THINK-OF-SOMEONE' -prog.cob: in paragraph 'SOME-SPECIAL-PAR-WITH-LENGTH-31': -prog.cob:19: error: word length exceeds 31 characters: 'SOME-SPECIAL-PAR-WITH-LENGTH-32C' -prog.cob: in paragraph 'SOME-SPECIAL-PAR-WITH-LENGTH-32C': -prog.cob:20: error: word length exceeds 31 characters: 'SOME-SPECIAL-VAL-WITH-LENGTH-32C' -prog.cob:21: error: word length exceeds 31 characters: 'SOME-SPECIAL-PAR-WITH-LENGTH-58C-WHO-NEEDS-THAT-LONG-NAMES' -prog.cob: in paragraph 'SOME-SPECIAL-PAR-WITH-LENGTH-58C-WHO-NEEDS-THAT-LONG-NAMES': -prog.cob:22: error: word length exceeds 31 characters: 'SOME-SPECIAL-VAL-WITH-LENGTH-58C-WHO-NEEDS-THAT-LONG-NAMES' -prog.cob:23: error: word length exceeds maximum of 63 characters: 'SOME-SPECIAL-PAR-WITH-LENGTH-90-CHARS-WHO-NEEDS-THAT-LONG-NAMES-I-CANNOT-THINK-OF-SOMEONE' -prog.cob: in paragraph 'SOME-SPECIAL-PAR-WITH-LENGTH-90-CHARS-WHO-NEEDS-THAT-LONG-NAMES-I-CANNOT-THINK-OF-SOMEONE': -prog.cob:24: error: word length exceeds maximum of 63 characters: 'SOME-SPECIAL-VAL-WITH-LENGTH-90-CHARS-WHO-NEEDS-THAT-LONG-NAMES-I-CANNOT-THINK-OF-SOMEONE' -]) - -AT_CHECK([$COMPILE_ONLY -free -fword-length=45 prog.cob], [1], [], -[prog.cob:12: error: word length exceeds 45 characters: 'SOME-SPECIAL-VAL-WITH-LENGTH-58C-WHO-NEEDS-THAT-LONG-NAMES' -prog.cob:13: error: word length exceeds maximum of 63 characters: 'SOME-SPECIAL-VAL-WITH-LENGTH-90-CHARS-WHO-NEEDS-THAT-LONG-NAMES-I-CANNOT-THINK-OF-SOMEONE' -prog.cob: in paragraph 'SOME-SPECIAL-PAR-WITH-LENGTH-32C': -prog.cob:21: error: word length exceeds 45 characters: 'SOME-SPECIAL-PAR-WITH-LENGTH-58C-WHO-NEEDS-THAT-LONG-NAMES' -prog.cob: in paragraph 'SOME-SPECIAL-PAR-WITH-LENGTH-58C-WHO-NEEDS-THAT-LONG-NAMES': -prog.cob:22: error: word length exceeds 45 characters: 'SOME-SPECIAL-VAL-WITH-LENGTH-58C-WHO-NEEDS-THAT-LONG-NAMES' -prog.cob:23: error: word length exceeds maximum of 63 characters: 'SOME-SPECIAL-PAR-WITH-LENGTH-90-CHARS-WHO-NEEDS-THAT-LONG-NAMES-I-CANNOT-THINK-OF-SOMEONE' -prog.cob: in paragraph 'SOME-SPECIAL-PAR-WITH-LENGTH-90-CHARS-WHO-NEEDS-THAT-LONG-NAMES-I-CANNOT-THINK-OF-SOMEONE': -prog.cob:24: error: word length exceeds maximum of 63 characters: 'SOME-SPECIAL-VAL-WITH-LENGTH-90-CHARS-WHO-NEEDS-THAT-LONG-NAMES-I-CANNOT-THINK-OF-SOMEONE' -]) - -AT_CHECK([$COMPILE_ONLY -free -fword-length=60 prog.cob], [1], [], -[prog.cob:13: error: word length exceeds maximum of 63 characters: 'SOME-SPECIAL-VAL-WITH-LENGTH-90-CHARS-WHO-NEEDS-THAT-LONG-NAMES-I-CANNOT-THINK-OF-SOMEONE' -prog.cob: in paragraph 'SOME-SPECIAL-PAR-WITH-LENGTH-58C-WHO-NEEDS-THAT-LONG-NAMES': -prog.cob:23: error: word length exceeds maximum of 63 characters: 'SOME-SPECIAL-PAR-WITH-LENGTH-90-CHARS-WHO-NEEDS-THAT-LONG-NAMES-I-CANNOT-THINK-OF-SOMEONE' -prog.cob: in paragraph 'SOME-SPECIAL-PAR-WITH-LENGTH-90-CHARS-WHO-NEEDS-THAT-LONG-NAMES-I-CANNOT-THINK-OF-SOMEONE': -prog.cob:24: error: word length exceeds maximum of 63 characters: 'SOME-SPECIAL-VAL-WITH-LENGTH-90-CHARS-WHO-NEEDS-THAT-LONG-NAMES-I-CANNOT-THINK-OF-SOMEONE' -]) - -AT_CHECK([$COMPILE_ONLY -free -fword-length=45 -frelax-syntax-checks prog2.cob], [0], [], -[prog2.cob:12: warning: word length exceeds 45 characters: 'SOME-SPECIAL-VAL-WITH-LENGTH-58C-WHO-NEEDS-THAT-LONG-NAMES' -prog2.cob: in paragraph 'SOME-SPECIAL-PAR-WITH-LENGTH-32C': -prog2.cob:20: warning: word length exceeds 45 characters: 'SOME-SPECIAL-PAR-WITH-LENGTH-58C-WHO-NEEDS-THAT-LONG-NAMES' -prog2.cob: in paragraph 'SOME-SPECIAL-PAR-WITH-LENGTH-58C-WHO-NEEDS-THAT-LONG-NAMES': -prog2.cob:21: warning: word length exceeds 45 characters: 'SOME-SPECIAL-VAL-WITH-LENGTH-58C-WHO-NEEDS-THAT-LONG-NAMES' -]) - -AT_CHECK([$COMPILE_ONLY -free -fword-length=60 prog2.cob], [0], [], []) - -AT_CHECK([$COMPILE_ONLY -free -fword-length=31 -frelax-syntax-checks prog2.cob], [0], [], -[prog2.cob:11: warning: word length exceeds 31 characters: 'SOME-SPECIAL-VAL-WITH-LENGTH-32C' -prog2.cob:12: warning: word length exceeds 31 characters: 'SOME-SPECIAL-VAL-WITH-LENGTH-58C-WHO-NEEDS-THAT-LONG-NAMES' -prog2.cob: in paragraph 'SOME-SPECIAL-PAR-WITH-LENGTH-31': -prog2.cob:18: warning: word length exceeds 31 characters: 'SOME-SPECIAL-PAR-WITH-LENGTH-32C' -prog2.cob: in paragraph 'SOME-SPECIAL-PAR-WITH-LENGTH-32C': -prog2.cob:19: warning: word length exceeds 31 characters: 'SOME-SPECIAL-VAL-WITH-LENGTH-32C' -prog2.cob:20: warning: word length exceeds 31 characters: 'SOME-SPECIAL-PAR-WITH-LENGTH-58C-WHO-NEEDS-THAT-LONG-NAMES' -prog2.cob: in paragraph 'SOME-SPECIAL-PAR-WITH-LENGTH-58C-WHO-NEEDS-THAT-LONG-NAMES': -prog2.cob:21: warning: word length exceeds 31 characters: 'SOME-SPECIAL-VAL-WITH-LENGTH-58C-WHO-NEEDS-THAT-LONG-NAMES' -]) - -AT_CHECK([$COMPILE_ONLY -fword-length=59 prog3.cob], [1], [], -[prog3.cob: in section '00000000000000000000000000000000000000000000000000000000000': -prog3.cob:11: error: word length exceeds 59 characters: '000000000000000000000000000000000000000000000000000000000000' -prog3.cob: in paragraph '000000000000000000000000000000000000000000000000000000000000': -prog3.cob:25: error: word length exceeds 59 characters: '100000000000000000000000000000000000000000000000000000000001' -]) - -AT_CLEANUP - - -AT_SETUP([Segmentation Module]) -AT_KEYWORDS([misc]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - PROCEDURE DIVISION. - - DECLARATIVES. - - DEC-1 SECTION 49. - CONTINUE. - - DEC-2 SECTION 50. - CONTINUE. - - END DECLARATIVES. - - SEC-1 SECTION 00. - CONTINUE. - - SEC-2 SECTION 01. - CONTINUE. - - SEC-3 SECTION -00. - CONTINUE. - - SEC-4 SECTION 100. - CONTINUE. - - SEC-5 SECTION 49. - CONTINUE. - - SEC-6 SECTION 50. - PERFORM SEC-1. - - SEC-7 SECTION 99. - PERFORM SEC-1. - - STOP RUN. -]) - -AT_CHECK([$COMPILE_ONLY prog.cob], [1], [], -[prog.cob: in section 'DEC-1': -prog.cob:9: warning: section segments ignored -prog.cob: in section 'DEC-2': -prog.cob:12: warning: section segments ignored -prog.cob: in section 'SEC-1': -prog.cob:17: warning: section segments ignored -prog.cob: in section 'SEC-2': -prog.cob:20: warning: section segments ignored -prog.cob: in section 'SEC-3': -prog.cob:23: error: unsigned integer value expected -prog.cob:23: warning: section segments ignored -prog.cob: in section 'SEC-4': -prog.cob:26: warning: section segments ignored -prog.cob: in section 'SEC-5': -prog.cob:29: warning: section segments ignored -prog.cob: in section 'SEC-6': -prog.cob:32: warning: section segments ignored -prog.cob: in section 'SEC-7': -prog.cob:35: warning: section segments ignored -]) -AT_CHECK([$COMPILE_ONLY -std=cobol85 prog.cob], [1], [], -[prog.cob: in section 'DEC-1': -prog.cob:9: warning: section segments is obsolete in COBOL 85 -prog.cob:9: warning: SECTION segment within DECLARATIVES is not implemented -prog.cob: in section 'DEC-2': -prog.cob:12: warning: section segments is obsolete in COBOL 85 -prog.cob:12: error: SECTION segment-number in DECLARATIVES must be less than 50 -prog.cob:12: warning: SECTION segment within DECLARATIVES is not implemented -prog.cob: in section 'SEC-1': -prog.cob:17: warning: section segments is obsolete in COBOL 85 -prog.cob: in section 'SEC-2': -prog.cob:20: warning: section segments is obsolete in COBOL 85 -prog.cob: in section 'SEC-3': -prog.cob:23: error: unsigned integer value expected -prog.cob:23: warning: section segments is obsolete in COBOL 85 -prog.cob: in section 'SEC-4': -prog.cob:26: warning: section segments is obsolete in COBOL 85 -prog.cob:26: error: SECTION segment-number must be less than or equal to 99 -prog.cob: in section 'SEC-5': -prog.cob:29: warning: section segments is obsolete in COBOL 85 -prog.cob: in section 'SEC-6': -prog.cob:32: warning: section segments is obsolete in COBOL 85 -prog.cob: in section 'SEC-7': -prog.cob:35: warning: section segments is obsolete in COBOL 85 -]) -AT_CLEANUP - - -AT_SETUP([ACCEPT FROM ESCAPE KEY]) -AT_KEYWORDS([misc]) - -# TODO: add function test to run_manual_screen.at - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 77 KEYNUM PIC 9(04). - PROCEDURE DIVISION. - - ACCEPT KEYNUM FROM ESCAPE KEY - DISPLAY "Key pressed: " KEYNUM - ACCEPT KEYNUM FROM ESCAPE - DISPLAY "Key pressed: " KEYNUM - ACCEPT OMITTED - - STOP RUN. -]) -AT_CHECK([$COMPILE_ONLY prog.cob], [0], [], []) -AT_CLEANUP - - -AT_SETUP([Numeric literals]) -AT_KEYWORDS([misc numeric-literal-length]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 77 COUNTER PIC 9 VALUE 0. - PROCEDURE DIVISION. - - *> No literals at all - 00000000000000000000000000000000000000000000000000000000000 - SECTION. - 000000000000000000000000000000000000000000000000000000000000. - ADD 1 TO COUNTER END-ADD - EVALUATE COUNTER - WHEN 1 - PERFORM - 00000000000000000000000000000000000000000000000000000000000 - WHEN 2 - PERFORM - 000000000000000000000000000000000000000000000000000000000000 - WHEN 3 - MOVE 0 TO COUNTER - END-EVALUATE. - - 100000000000000000000000000000000000000000000000000000000001 - SECTION. - 20000000000000000000000000000000000000000000000000000000002. - ADD 1 TO COUNTER END-ADD - EVALUATE COUNTER - WHEN 1 - PERFORM - 100000000000000000000000000000000000000000000000000000000001 - WHEN 2 - PERFORM - 20000000000000000000000000000000000000000000000000000000002 - WHEN 3 - MOVE 0 TO COUNTER - END-EVALUATE. - - STOP RUN. -]) - -AT_DATA([prog2.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog2. - ENVIRONMENT DIVISION. - CONFIGURATION SECTION. - SPECIAL-NAMES. - PROCEDURE DIVISION. - - *> Valid literals, depending on numeric literal size - DISPLAY 1.0076, +100000.03, +1.0, -0078, - +.1234567890123456789012345678901234 - .123456789012345678901234567890123450 - END-DISPLAY - - *> Invalid literals - DISPLAY 1.03.0 END-DISPLAY - DISPLAY --123 END-DISPLAY - DISPLAY -123- END-DISPLAY - DISPLAY -123-456 END-DISPLAY - DISPLAY -123-4.56 END-DISPLAY - DISPLAY -12.3-456 END-DISPLAY - DISPLAY -12.3-4.56 END-DISPLAY - DISPLAY 1000003+ END-DISPLAY - DISPLAY 1.000003+ END-DISPLAY - DISPLAY .3+ END-DISPLAY - DISPLAY 3.+ END-DISPLAY - - STOP RUN. -]) - -AT_DATA([prog3.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog3. - ENVIRONMENT DIVISION. - CONFIGURATION SECTION. - SPECIAL-NAMES. DECIMAL-POINT IS COMMA. - PROCEDURE DIVISION. - - *> Valid literals, depending on numeric literal size - DISPLAY 1,0076, +100000,03, +1,0, -0078, - +,1234567890123456789012345678901234 - ,123456789012345678901234567890123450 - END-DISPLAY - - *> Invalid literals - DISPLAY 1,03,0 END-DISPLAY - DISPLAY --123 END-DISPLAY - DISPLAY -123- END-DISPLAY - DISPLAY -123-456 END-DISPLAY - DISPLAY -123-4,56 END-DISPLAY - DISPLAY -12,3-456 END-DISPLAY - DISPLAY -12,3-4,56 END-DISPLAY - DISPLAY 1000003+ END-DISPLAY - DISPLAY 1,000003+ END-DISPLAY - DISPLAY ,3+ END-DISPLAY - DISPLAY 3,+ END-DISPLAY - - STOP RUN. -]) - -AT_CHECK([$COMPILE_ONLY -fliteral-length=1 -fnumeric-literal-length=1 -fword-length=60 prog.cob], [0], [], []) - -# result with extended scanner for wrong numeric literals: -#AT_CHECK([$COMPILE_ONLY prog2.cob], [1], [], -#[prog2.cob:16: error: invalid numeric literal: '1.03.0' -#prog2.cob:16: error: literal with more than one decimal point -#prog2.cob:17: error: invalid numeric literal: '--123' -#prog2.cob:17: error: literal with more than one sign character -#prog2.cob:18: error: invalid numeric literal: '-123-' -#prog2.cob:18: error: literal with more than one sign character -#prog2.cob:19: error: invalid numeric literal: '-123-456' -#prog2.cob:19: error: literal with more than one sign character -#prog2.cob:20: error: invalid numeric literal: '-123-4.56' -#prog2.cob:20: error: literal with more than one sign character -#prog2.cob:21: error: invalid numeric literal: '-12.3-456' -#prog2.cob:21: error: literal with more than one sign character -#prog2.cob:22: error: invalid numeric literal: '-12.3-4.56' -#prog2.cob:22: error: literal with more than one sign character -#prog2.cob:22: error: literal with more than one decimal point -#prog2.cob:23: error: invalid numeric literal: '1000003+' -#prog2.cob:23: error: sign must appear as leftmost character -#prog2.cob:24: error: invalid numeric literal: '1.000003+' -#prog2.cob:24: error: sign must appear as leftmost character -#prog2.cob:25: error: invalid numeric literal: '.3+' -#prog2.cob:25: error: sign must appear as leftmost character -#prog2.cob:26: error: invalid numeric literal: '3.+' -#prog2.cob:26: error: sign must appear as leftmost character -#]) -#AT_CHECK([$COMPILE_ONLY prog3.cob], [1], [], -#[prog3.cob:16: error: invalid numeric literal: '1,03,0' -#prog3.cob:16: error: literal with more than one decimal point -#prog3.cob:17: error: invalid numeric literal: '--123' -#prog3.cob:17: error: literal with more than one sign character -#prog3.cob:18: error: invalid numeric literal: '-123-' -#prog3.cob:18: error: literal with more than one sign character -#prog3.cob:19: error: invalid numeric literal: '-123-456' -#prog3.cob:19: error: literal with more than one sign character -#prog3.cob:20: error: invalid numeric literal: '-123-4,56' -#prog3.cob:20: error: literal with more than one sign character -#prog3.cob:21: error: invalid numeric literal: '-12,3-456' -#prog3.cob:21: error: literal with more than one sign character -#prog3.cob:22: error: invalid numeric literal: '-12,3-4,56' -#prog3.cob:22: error: literal with more than one sign character -#prog3.cob:22: error: literal with more than one decimal point -#prog3.cob:23: error: invalid numeric literal: '1000003+' -#prog3.cob:23: error: sign must appear as leftmost character -#prog3.cob:24: error: invalid numeric literal: '1,000003+' -#prog3.cob:24: error: sign must appear as leftmost character -#prog3.cob:25: error: invalid numeric literal: ',3+' -#prog3.cob:25: error: sign must appear as leftmost character -#prog3.cob:26: error: invalid numeric literal: '3,+' -#prog3.cob:26: error: sign must appear as leftmost character -#]) - -AT_CHECK([$COMPILE_ONLY prog2.cob], [1], [], -[prog2.cob:17: error: syntax error, unexpected -, expecting [(] -prog2.cob:18: error: syntax error, unexpected - -prog2.cob:23: error: syntax error, unexpected + -prog2.cob:24: error: syntax error, unexpected + -prog2.cob:25: error: syntax error, unexpected + -prog2.cob:26: error: syntax error, unexpected + -]) -AT_CHECK([$COMPILE_ONLY prog3.cob], [1], [], -[prog3.cob:17: error: syntax error, unexpected -, expecting [(] -prog3.cob:18: error: syntax error, unexpected - -prog3.cob:23: error: syntax error, unexpected + -prog3.cob:24: error: syntax error, unexpected + -prog3.cob:25: error: syntax error, unexpected + -prog3.cob:26: error: syntax error, unexpected + -]) - -AT_CLEANUP - - -AT_SETUP([floating-point literals]) -# Refer to Section 8.3.1.2.2.2 of COBOL 2014. -AT_KEYWORDS([misc]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - PROCEDURE DIVISION. - *> Valid literals - DISPLAY 1.0E6144, +1.0E+3, +1.0E-6143, 123.E1, - +.123456789012345678901234567890123456E+0000 - END-DISPLAY - - *> invalid literals - DISPLAY 1.0D3 END-DISPLAY - DISPLAY 1E3 END-DISPLAY - DISPLAY '1.0E3'BLAH END-DISPLAY - DISPLAY 1.0E3.0 END-DISPLAY - DISPLAY -0.0E-0 END-DISPLAY - DISPLAY 1.0E00003 END-DISPLAY - DISPLAY .123456789012345678901234567890123456789E0 - END-DISPLAY - DISPLAY 0.0E3 END-DISPLAY - - *> Implementor-defined invalid literals - DISPLAY 1.0E6145 END-DISPLAY - DISPLAY 1.0E-6144 END-DISPLAY - - STOP RUN. -]) - -AT_DATA([prog2.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog2. - ENVIRONMENT DIVISION. - CONFIGURATION SECTION. - SPECIAL-NAMES. - DECIMAL-POINT IS COMMA. - PROCEDURE DIVISION. - *> Valid literals - DISPLAY 1,0E6144; +1,0E+3; +1,0E-6143; 123,E1; - +,123456789012345678901234567890123456E+0000 - END-DISPLAY - - *> invalid literals - DISPLAY 1,0D3 END-DISPLAY - DISPLAY 1E3 END-DISPLAY - DISPLAY 1,0E3BLAH END-DISPLAY - DISPLAY 1,0E3,0 END-DISPLAY - DISPLAY -0,0E-0 END-DISPLAY - DISPLAY 1,0E00003 END-DISPLAY - DISPLAY ,123456789012345678901234567890123456789E0 - END-DISPLAY - DISPLAY 0,0E3 END-DISPLAY - - *> Implementor-defined invalid literals - DISPLAY 1,0E6145 END-DISPLAY - DISPLAY 1,0E-6144 END-DISPLAY - - STOP RUN. -]) - -AT_CHECK([$COMPILE_ONLY prog.cob], [1], [], -[prog.cob:11: error: 'D3' is not defined -prog.cob:12: error: '1E3' is not defined -prog.cob:13: error: 'BLAH' is not defined -prog.cob:14: error: invalid floating-point literal: '1.0E3.0' -prog.cob:14: error: exponent has decimal point -prog.cob:15: error: invalid floating-point literal: '-0.0E-0' -prog.cob:15: error: significand of 0 must be positive -prog.cob:15: error: exponent of 0 must be positive -prog.cob:16: error: invalid floating-point literal: '1.0E00003' -prog.cob:16: error: exponent has more than 4 digits -prog.cob:17: error: invalid floating-point literal: '.1234567890123456789012345678901234...' -prog.cob:17: error: significand has more than 36 digits -prog.cob:19: error: invalid floating-point literal: '0.0E3' -prog.cob:19: error: exponent of 0 must be 0 -prog.cob:22: error: invalid floating-point literal: '1.0E6145' -prog.cob:22: error: exponent not between -6143 and 6144 -prog.cob:23: error: invalid floating-point literal: '1.0E-6144' -prog.cob:23: error: exponent not between -6143 and 6144 -]) - -AT_CHECK([$COMPILE_ONLY prog2.cob], [1], [], -[prog2.cob:15: error: 'D3' is not defined -prog2.cob:16: error: '1E3' is not defined -prog2.cob:17: error: 'BLAH' is not defined -prog2.cob:18: error: invalid floating-point literal: '1,0E3,0' -prog2.cob:18: error: exponent has decimal point -prog2.cob:19: error: invalid floating-point literal: '-0,0E-0' -prog2.cob:19: error: significand of 0 must be positive -prog2.cob:19: error: exponent of 0 must be positive -prog2.cob:20: error: invalid floating-point literal: '1,0E00003' -prog2.cob:20: error: exponent has more than 4 digits -prog2.cob:21: error: invalid floating-point literal: ',1234567890123456789012345678901234...' -prog2.cob:21: error: significand has more than 36 digits -prog2.cob:23: error: invalid floating-point literal: '0,0E3' -prog2.cob:23: error: exponent of 0 must be 0 -prog2.cob:26: error: invalid floating-point literal: '1,0E6145' -prog2.cob:26: error: exponent not between -6143 and 6144 -prog2.cob:27: error: invalid floating-point literal: '1,0E-6144' -prog2.cob:27: error: exponent not between -6143 and 6144 -]) - -AT_CLEANUP - - -AT_SETUP([X literals]) -AT_KEYWORDS([misc]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - PROCEDURE DIVISION. - *> Valid form - DISPLAY X"0123456789ABCDEF" - - *> invalid form - DISPLAY X"GH" - X"1" - END-DISPLAY. -]) - -AT_CHECK([$COMPILE_ONLY prog.cob], [1], [], -[prog.cob:9: error: invalid X literal: 'GH' -prog.cob:9: error: literal contains invalid character 'G' -prog.cob:9: error: literal contains invalid character 'H' -prog.cob:10: error: invalid X literal: '1' -prog.cob:10: error: literal does not have an even number of digits -]) - -AT_CLEANUP - - -AT_SETUP([national literals]) -AT_KEYWORDS([misc]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - PROCEDURE DIVISION. - DISPLAY N"UTF-16 string". - DISPLAY N'0123456789ABCDEF'. - DISPLAY N"0123456789ABCDEF"- - N"0123456789ABCDEF". - DISPLAY NC"0123456789ABCDEF"- - NC'0123456789ABCDEF'. -]) - -AT_CHECK([$COMPILE_ONLY prog.cob], [0], [], -[prog.cob:5: warning: handling of national literal is unfinished; implementation is likely to be changed -prog.cob:6: warning: handling of national literal is unfinished; implementation is likely to be changed -prog.cob:7: warning: handling of national literal is unfinished; implementation is likely to be changed -prog.cob:8: warning: handling of national literal is unfinished; implementation is likely to be changed -prog.cob:9: warning: national-character literal used -prog.cob:9: warning: handling of national literal is unfinished; implementation is likely to be changed -prog.cob:10: warning: national-character literal used -prog.cob:10: warning: handling of national literal is unfinished; implementation is likely to be changed -]) - -AT_CHECK([$COMPILE_ONLY -std=cobol85 prog.cob], [1], [], -[prog.cob:5: error: national literal does not conform to COBOL 85 -prog.cob:6: error: national literal does not conform to COBOL 85 -prog.cob:7: error: national literal does not conform to COBOL 85 -prog.cob:8: error: national literal does not conform to COBOL 85 -prog.cob:9: error: national-character literal does not conform to COBOL 85 -prog.cob:10: error: national-character literal does not conform to COBOL 85 -]) - -AT_CLEANUP - - -AT_SETUP([NX literals]) -AT_KEYWORDS([misc]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - PROCEDURE DIVISION. - *> Valid form - DISPLAY NX"265E" - DISPLAY NX"0123456789ABCDEF" - - *> invalid form - DISPLAY NX"GH" - NX"1". -]) - -AT_CHECK([$COMPILE_ONLY prog.cob], [1], [], -[prog.cob:6: warning: handling of national literal is unfinished; implementation is likely to be changed -prog.cob:7: warning: handling of national literal is unfinished; implementation is likely to be changed -prog.cob:10: warning: handling of national literal is unfinished; implementation is likely to be changed -prog.cob:10: error: invalid NX literal: 'GH' -prog.cob:10: error: literal contains invalid character 'G' -prog.cob:10: error: literal contains invalid character 'H' -prog.cob:11: warning: handling of national literal is unfinished; implementation is likely to be changed -prog.cob:11: error: invalid NX literal: '1' -prog.cob:11: error: literal does not have an even number of digits -]) - -AT_CHECK([$COMPILE_ONLY -std=cobol85 prog.cob], [1], [], -[prog.cob:6: error: hexadecimal-national literal does not conform to COBOL 85 -prog.cob:7: error: hexadecimal-national literal does not conform to COBOL 85 -prog.cob:10: error: hexadecimal-national literal does not conform to COBOL 85 -prog.cob:11: error: hexadecimal-national literal does not conform to COBOL 85 -]) - -AT_CLEANUP - - -AT_SETUP([binary literals]) -AT_KEYWORDS([misc extensions]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - PROCEDURE DIVISION. - DISPLAY B"101010" - DISPLAY B"111111111111111111111111111111111111111111111111111 - - "1111111111111" *> " Syntax highlighting hack - - DISPLAY B"23" - DISPLAY B"111111111111111111111111111111111111111111111111111 - - "111111111111111111111111111111111111111111111111111 - - "11111111111111111111111111111111111111111111111111" - STOP RUN. -]) - -AT_CHECK([$COMPILE_ONLY -std=mf prog.cob], [1], [], -[prog.cob:9: error: invalid B literal: '23' -prog.cob:9: error: literal contains invalid character '2' -prog.cob:9: error: literal contains invalid character '3' -prog.cob:10: error: invalid B literal: '11111111111111111111111111111111111...' -prog.cob:10: error: literal length 152 exceeds 64 characters -]) - -AT_CHECK([$COMPILE_ONLY -std=cobol85 prog.cob], [1], [], -[prog.cob:5: error: numeric boolean literal does not conform to COBOL 85 -prog.cob:6: error: numeric boolean literal does not conform to COBOL 85 -prog.cob:9: error: numeric boolean literal does not conform to COBOL 85 -prog.cob:10: error: numeric boolean literal does not conform to COBOL 85 -]) - -AT_CLEANUP - - -AT_SETUP([binary-hexadecimal literals]) -AT_KEYWORDS([misc extensions]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - PROCEDURE DIVISION. - DISPLAY BX"AB05CD0F" - DISPLAY BX"0123456789ABCDEF0123456789ABCDEF0123456789A - - "BCDEF" *> " Syntax highlighting hack - - DISPLAY BX"A" - STOP RUN. -]) - -AT_CHECK([$COMPILE_ONLY prog.cob], [1], [], -[prog.cob:6: error: invalid BX literal: '0123456789ABCDEF0123456789ABCDEF012...' -prog.cob:6: error: literal length 192 exceeds 64 characters -]) - -AT_CHECK([$COMPILE_ONLY -std=cobol85 prog.cob], [1], [], -[prog.cob:5: error: hexadecimal-boolean literal does not conform to COBOL 85 -prog.cob:6: error: hexadecimal-boolean literal does not conform to COBOL 85 -prog.cob:9: error: hexadecimal-boolean literal does not conform to COBOL 85 -]) - -AT_CLEANUP - - -AT_SETUP([HP COBOL octal literals]) -AT_KEYWORDS([misc extensions]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - PROCEDURE DIVISION. - *> Valid forms - DISPLAY %17 %37777777777 %456 - - *> invalid forms - DISPLAY %11111111111111111111111 - DISPLAY %89 - - STOP RUN. -]) - -AT_CHECK([$COMPILE_ONLY -Wno-unfinished -fhp-octal-literals=ok prog.cob], [1], [], -[prog.cob:9: error: invalid % literal: '11111111111111111111111' -prog.cob:9: error: literal length 23 exceeds 22 characters -prog.cob:10: error: invalid % literal: '89' -prog.cob:10: error: literal contains invalid character '8' -prog.cob:10: error: literal contains invalid character '9' -]) - -AT_CHECK([$COMPILE_ONLY -std=cobol2014 prog.cob], [1], [], -[prog.cob:6: error: HP COBOL octal literal does not conform to COBOL 2014 -prog.cob:6: error: HP COBOL octal literal does not conform to COBOL 2014 -prog.cob:6: error: HP COBOL octal literal does not conform to COBOL 2014 -prog.cob:9: error: HP COBOL octal literal does not conform to COBOL 2014 -prog.cob:10: error: HP COBOL octal literal does not conform to COBOL 2014 -]) - -AT_CLEANUP - - -AT_SETUP([ACUCOBOL literals]) -AT_KEYWORDS([misc acu extensions binary octal hexadecimal]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - PROCEDURE DIVISION. - *> Valid forms - DISPLAY B#10 O#12345670123 X#12345678 H#90aBcDeF - END-DISPLAY - - *> invalid forms - >>SOURCE FREE - DISPLAY B#11111111111111111111111111111111111111111111111111111111111111111 - O#11111111111111111111111 X#11111111111111111 H#22222222222222222 - >>SOURCE FIXED - DISPLAY B#23 O#89 X#GG H#HH - - STOP RUN. -]) - -AT_CHECK([$COMPILE_ONLY -std=acu prog.cob], [1], [], -[prog.cob:11: error: invalid B# literal: '11111111111111111111111111111111111...' -prog.cob:11: error: literal length 65 exceeds 64 characters -prog.cob:12: error: invalid O# literal: '11111111111111111111111' -prog.cob:12: error: literal length 23 exceeds 22 characters -prog.cob:12: error: invalid hexadecimal literal: '11111111111111111' -prog.cob:12: error: literal length 17 exceeds 16 characters -prog.cob:12: error: invalid hexadecimal literal: '22222222222222222' -prog.cob:12: error: literal length 17 exceeds 16 characters -prog.cob:14: error: invalid B# literal: '23' -prog.cob:14: error: literal contains invalid character '2' -prog.cob:14: error: literal contains invalid character '3' -prog.cob:14: error: invalid O# literal: '89' -prog.cob:14: error: literal contains invalid character '8' -prog.cob:14: error: literal contains invalid character '9' -prog.cob:14: error: invalid X# literal: 'GG' -prog.cob:14: error: literal contains invalid character 'G' -prog.cob:14: error: literal contains invalid character 'G' -prog.cob:14: error: invalid H# literal: 'HH' -prog.cob:14: error: literal contains invalid character 'H' -prog.cob:14: error: literal contains invalid character 'H' -]) - -AT_CHECK([$COMPILE_ONLY -std=cobol2014 prog.cob], [1], [], -[prog.cob:6: error: ACUCOBOL numeric literal does not conform to COBOL 2014 -prog.cob:6: error: ACUCOBOL numeric literal does not conform to COBOL 2014 -prog.cob:6: error: ACUCOBOL numeric literal does not conform to COBOL 2014 -prog.cob:6: error: ACUCOBOL numeric literal does not conform to COBOL 2014 -prog.cob:11: error: ACUCOBOL numeric literal does not conform to COBOL 2014 -prog.cob:12: error: ACUCOBOL numeric literal does not conform to COBOL 2014 -prog.cob:12: error: ACUCOBOL numeric literal does not conform to COBOL 2014 -prog.cob:12: error: ACUCOBOL numeric literal does not conform to COBOL 2014 -prog.cob:14: error: ACUCOBOL numeric literal does not conform to COBOL 2014 -prog.cob:14: error: ACUCOBOL numeric literal does not conform to COBOL 2014 -prog.cob:14: error: ACUCOBOL numeric literal does not conform to COBOL 2014 -prog.cob:14: error: ACUCOBOL numeric literal does not conform to COBOL 2014 -]) - -AT_CLEANUP - - -AT_SETUP([ACUCOBOL 32bit literal size]) -# ACUCOBOL literal max - the result is system dependent on size of unsigned long int -AT_SKIP_IF(true) - -AT_KEYWORDS([extensions literals]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - PROCEDURE DIVISION. - - >>SOURCE FREE - DISPLAY B#1111111111111111111111111111111111111111111111111111111111111111 - O#1111111111111111111111 X#1111111111111111 - - STOP RUN. -]) - -#AT_CHECK([$COMPILE_ONLY -std=acu prog.cob], [0], [], []) -# TODO check the result according to COB_32_BIT_LONG --> 1 should result in the following -AT_CHECK([$COMPILE_ONLY -std=acu prog.cob], [1], [], -[prog.cob:7: error: invalid B# literal: '11111111111111111111111111111111111...' -prog.cob:7: error: literal exceeds limit 4294967295 -prog.cob:8: error: invalid O# literal: '1111111111111111111111' -prog.cob:8: error: literal exceeds limit 4294967295 -prog.cob:8: error: invalid X# literal: '1111111111111111' -prog.cob:8: error: literal exceeds limit 4294967295 -]) -AT_CLEANUP - - -AT_SETUP([ACUCOBOL USAGE FLOAT / DOUBLE]) -AT_KEYWORDS([misc acu extensions reserved]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 77 myfloat usage float - value is 3.97E+24. - 77 mydouble usage double - value is 3.97E+44. - PROCEDURE DIVISION. - MAIN. - * - STOP RUN. -]) - -AT_CHECK([$COMPILE_ONLY -std=acu-strict prog.cob], [0], [], []) -AT_CHECK([$COMPILE_ONLY prog.cob], [0], [], []) - -AT_CHECK([$COMPILE_ONLY -std=mf-strict prog.cob], [1], [], -[prog.cob:6: error: 'float' is not defined, but is a reserved word in another dialect -prog.cob:8: error: 'double' is not defined, but is a reserved word in another dialect -]) - -AT_CLEANUP - - -AT_SETUP([ACUCOBOL USAGE HANDLE]) -AT_KEYWORDS([misc acu extensions reserved CALL DESTROY]) - -# TODO: need a better test here -# TODO: maybe add a compiler support configuration to provide better messages - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 78 listdir-open value 1. - 78 listdir-next value 2. - 78 listdir-close value 3. - 77 pattern pic x(5) value "*.cob". - 77 directory pic x(5) value ".". - 77 filename pic x(256). - 77 mydir usage handle. - - 77 mythread usage handle of thread. - 77 unused-thread handle thread. - - 77 mywindow usage handle of window. - - 77 nor-a-handle usage handle bananas. - 77 neither-a-handle usage handle of apes. - 77 control-handle usage handle of label. - - PROCEDURE DIVISION. - MAIN. - * Call LISTDIR-OPEN to get a directory handle. - call "C$LIST-DIRECTORY" - using listdir-open, directory, pattern. - move return-code to mydir. - * Call LISTDIR-NEXT to get the names of the files. - * Repeat this operation until a filename containing only - * spaces is returned. The filenames are not necessarily - * returned in any particular order. Filenames may be - * sorted on some machines and not on others. - perform thread with test after until filename = spaces - handle in mywindow - call "C$LIST-DIRECTORY" - using listdir-next, mydir, filename - end-perform. - stop thread mywindow - * Call LISTDIR-CLOSE to close the directory and deallocate - * memory. Omitting this call will result in memory leaks. - call "C$LIST-DIRECTORY" using listdir-close, mydir. - * - CALL IN THREAD 'NOTHERE' - HANDLE IN mywindow - USING 'STUFF' - NOT ON EXCEPTION DISPLAY 'called in THREAD' - END-CALL - * - * Just to check that the handles are still recognized and usable: - destroy neither-a-handle, control-handle - * - * check for invalid use - add neither-a-handle to control-handle - compute mywindow = 0 - string mydir delimited by size into filename - * - STOP RUN. -]) - -AT_CHECK([$COMPILE_ONLY -std=acu-strict prog.cob], [1], [], -[prog.cob:19: error: unknown HANDLE type: bananas -prog.cob:20: error: unknown HANDLE type: apes -prog.cob:21: warning: HANDLE OF control-type is not implemented -prog.cob: in paragraph 'MAIN': -prog.cob:34: warning: THREAD is not implemented -prog.cob:36: warning: THREAD is not implemented -prog.cob:35: error: HANDLE must be either a generic or a THREAD HANDLE -prog.cob:39: error: HANDLE must be either a generic or a THREAD HANDLE -prog.cob:39: warning: STOP THREAD is replaced by STOP RUN -prog.cob:44: warning: THREAD is not implemented -prog.cob:46: warning: THREAD is not implemented -prog.cob:45: error: HANDLE must be either a generic or a THREAD HANDLE -prog.cob:51: warning: GRAPHICAL CONTROL is not implemented -prog.cob:54: error: HANDLE item not allowed here: 'neither-a-handle' -prog.cob:55: error: HANDLE item not allowed here: 'mywindow' -prog.cob:56: error: HANDLE item not allowed here: 'mydir' -]) - -AT_CHECK([$COMPILE_ONLY -std=rm-strict prog.cob], [1], [], -[prog.cob:12: error: 'handle' is not defined, but is a reserved word in another dialect -prog.cob:14: error: 'handle' is not defined, but is a reserved word in another dialect -prog.cob:15: error: syntax error, unexpected Identifier -prog.cob:17: error: 'handle' is not defined, but is a reserved word in another dialect -prog.cob:19: error: 'handle' is not defined, but is a reserved word in another dialect -prog.cob:20: error: 'handle' is not defined, but is a reserved word in another dialect -prog.cob:21: error: 'handle' is not defined, but is a reserved word in another dialect -prog.cob:15: error: PICTURE clause required for 'unused-thread' -prog.cob: in paragraph 'MAIN': -prog.cob:35: error: 'handle IN mywindow' is not defined -prog.cob:34: error: invalid expression -prog.cob:38: error: syntax error, unexpected END-PERFORM -prog.cob:39: error: 'thread' is not defined, but is a reserved word in another dialect -prog.cob:39: error: syntax error, unexpected Identifier -prog.cob:44: error: syntax error, unexpected Identifier, expecting THREAD -prog.cob:48: error: syntax error, unexpected END-CALL -prog.cob:51: error: syntax error, unexpected Identifier -prog.cob:34: error: 'thread' is not defined, but is a reserved word in another dialect -]) - -AT_CLEANUP - - -AT_SETUP([ACUCOBOL WINDOW statements]) -AT_KEYWORDS([misc acu extensions screen]) - -# TODO: need a better tests when we implement this, -# likely split into multiple ones - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 77 myhandle usage handle. - 77 mythread usage handle of thread. - 77 WINDOW-HANDLE usage handle of window. - PROCEDURE DIVISION. - MAIN. - DISPLAY WINDOW, LINE 1, COLUMN 29, SIZE 51, LINES 12, - ERASE SCREEN BOXED SHADOW, POP-UP AREA IS WINDOW-HANDLE - END-DISPLAY - DISPLAY "THIS IS TEXT IN A WINDOW" - DISPLAY FLOATING WINDOW UPON WINDOW-HANDLE, - LINE 5, COLUMN 10, SIZE 20, LINES 2, - ERASE SCREEN, POP-UP AREA IS myhandle - END-DISPLAY - DISPLAY "Some text for the floating window" - ACCEPT OMITTED - CLOSE WINDOW myhandle - DISPLAY FLOATING WINDOW, - LINE 5, COLUMN 10, SIZE 20, LINES 2, - ERASE SCREEN, POP-UP AREA mythread - END-DISPLAY - ACCEPT OMITTED - DESTROY WINDOW-HANDLE - DISPLAY WINDOW AT 1020 SIZE 36 LINES 15 BOXED - FOREGROUND-COLOR IS 7 - BACKGROUND-COLOR IS 0 - TOP CENTERED TITLE IS 'SOME TITLE' - pop-up area = WINDOW-HANDLE. - DISPLAY SUBWINDOW UPON WINDOW-HANDLE SHADOW - AT 0505 SIZE 25 LINES 10 - BOTTOM LEFT TITLE = 'buttom left' - BACKGROUND-COLOR IS 10 - FOREGROUND-COLOR IS 5. - DISPLAY WINDOW UPON WINDOW-HANDLE SHADOW - AT 0808 SIZE 18 LINES 5 - RIGHT TITLE 'top right' - BACKGROUND-COLOR 1 - FOREGROUND-COLOR 14. - ACCEPT OMITTED - DESTROY WINDOW-HANDLE - * - STOP RUN. -]) - -AT_CHECK([$COMPILE_ONLY -std=acu-strict prog.cob], [1], [], -[prog.cob: in paragraph 'MAIN': -prog.cob:11: warning: GRAPHICAL WINDOW is not implemented -prog.cob:15: warning: GRAPHICAL WINDOW is not implemented -prog.cob:21: warning: GRAPHICAL WINDOW is not implemented -prog.cob:22: warning: GRAPHICAL WINDOW is not implemented -prog.cob:24: error: HANDLE must be either a generic or a WINDOW HANDLE or X(10) -prog.cob:27: warning: GRAPHICAL CONTROL is not implemented -prog.cob:28: warning: GRAPHICAL WINDOW is not implemented -prog.cob:33: warning: GRAPHICAL WINDOW is not implemented -prog.cob:38: warning: GRAPHICAL WINDOW is not implemented -prog.cob:44: warning: GRAPHICAL CONTROL is not implemented -]) - -AT_CHECK([$COMPILE_ONLY prog.cob], [1], [], -[prog.cob: in paragraph 'MAIN': -prog.cob:11: warning: GRAPHICAL WINDOW is not implemented -prog.cob:15: warning: GRAPHICAL WINDOW is not implemented -prog.cob:21: warning: GRAPHICAL WINDOW is not implemented -prog.cob:22: warning: GRAPHICAL WINDOW is not implemented -prog.cob:24: error: HANDLE must be either a generic or a WINDOW HANDLE or X(10) -prog.cob:27: warning: GRAPHICAL CONTROL is not implemented -prog.cob:28: warning: GRAPHICAL WINDOW is not implemented -prog.cob:33: warning: GRAPHICAL WINDOW is not implemented -prog.cob:38: warning: GRAPHICAL WINDOW is not implemented -prog.cob:44: warning: GRAPHICAL CONTROL is not implemented -]) - -AT_CLEANUP - - -AT_SETUP([ACUCOBOL GRAPHICAL controls]) -AT_KEYWORDS([misc acu extensions screen MODIFY INQUIRE]) - -# TODO: need a better tests when we implement this, -# likely split into multiple ones - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 77 window-handle USAGE HANDLE OF WINDOW. - 77 lb-row PIC X(10). - 77 lb-color PIC 9(05) VALUE 8192. - 77 lb-num-lines PIC 9(02) VALUE 20. - 77 lb-num-rows PIC 9(02) VALUE 11. - 77 window-lines PIC 9(02) VALUE 22. - 77 window-rows PIC 9(02) VALUE 13. - 77 selection-idx PIC S9(02). - SCREEN SECTION. - 01 lb-screen. - 03 lb-frm LIST-BOX 3-D - * FIXME: the following should be possible in any order - UNSORTED - EXCEPTION-VALUE = 13 - COLOR lb-color - CLINE 1 CCOL 1 - LINES = lb-num-lines - SIZE IS lb-num-rows - * VALUE lb-row raises error as no identifer according - * to cobol2002, but here it is fine - . - PROCEDURE DIVISION. - MAIN. - MODIFY lb-frm ITEM-TO-ADD = 'Row 1' - MODIFY lb-frm ITEM-TO-ADD = 'Row 2' - MODIFY lb-frm ITEM-TO-ADD = 'Row 3' - MODIFY lb-frm ITEM-TO-ADD = 'Row 4' - MODIFY lb-frm ITEM-TO-ADD = 'Row 5' - MODIFY lb-frm ITEM-TO-ADD = 'Row 6' - MODIFY lb-frm ITEM-TO-ADD = 'Row 7' - DISPLAY FLOATING WINDOW - LINE 5 COL 5 - LINES window-lines - SIZE window-rows - BOXED - COLOR lb-color - HANDLE IS window-handle - END-DISPLAY - DISPLAY lb-screen - ACCEPT lb-screen - IF lb-row = SPACES - INQUIRE lb-frm SELECTION-INDEX IN selection-idx - IF selection-idx > ZERO - MODIFY lb-frm QUERY-INDEX = selection-idx - INQUIRE lb-frm ITEM-VALUE IN lb-row - END-IF - END-IF - CLOSE WINDOW window-handle - DISPLAY "chosen row value was '" lb-row "'" - ACCEPT OMITTED - * - STOP RUN. -]) - -AT_CHECK([$COMPILE_ONLY -std=acu-strict prog.cob], [0], [], -[prog.cob:16: warning: GRAPHICAL CONTROL is not implemented -prog.cob:21: warning: COLOR clause is not implemented -prog.cob:23: warning: LINES clause is not implemented -prog.cob:26: warning: screen positions from data-item is not implemented -prog.cob: in paragraph 'MAIN': -prog.cob:36: warning: GRAPHICAL WINDOW is not implemented -prog.cob:42: warning: COLOR is not implemented -prog.cob:53: warning: GRAPHICAL WINDOW is not implemented -]) - -AT_CLEANUP - - -AT_SETUP([DISPLAY MESSAGE BOX]) -AT_KEYWORDS([misc acu extensions screen]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 77 my-text pic x(10) value "TEXT". - 78 MB-OK VALUE 1. - 78 MB-YES-NO VALUE 2. - 78 MB-OK-CANCEL VALUE 3. - 78 MB-YES-NO-CANCEL VALUE 4. - 78 MB-YES VALUE 1. - 78 MB-NO VALUE 2. - 78 MB-CANCEL VALUE 3. - 78 MB-DEFAULT-ICON VALUE 1. - 78 MB-WARNING-ICON VALUE 2. - 78 MB-ERROR-ICON VALUE 3. - PROCEDURE DIVISION. - DISPLAY MESSAGE "Important" - TITLE "Very important" - TYPE = MB-OK - ICON IS MB-WARNING-ICON - DISPLAY MESSAGE "This is" space "my" space my-text - DISPLAY MESSAGE BOX "More messages?" - TYPE MB-YES-NO - TITLE = "box title" - DEFAULT IS MB-YES - RETURNING RETURN-CODE - * - STOP RUN. -]) - -AT_CHECK([$COMPILE_ONLY -std=acu-strict prog.cob], [0], [], -[prog.cob:18: warning: handling of DISPLAY MESSAGE is unfinished; implementation is likely to be changed -prog.cob:22: warning: handling of DISPLAY MESSAGE is unfinished; implementation is likely to be changed -prog.cob:23: warning: handling of DISPLAY MESSAGE is unfinished; implementation is likely to be changed -]) - -AT_CLEANUP - - -AT_SETUP([DISPLAY OMITTED]) -AT_KEYWORDS([misc extensions screen]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - PROCEDURE DIVISION. - DISPLAY OMITTED WITH BELL - DISPLAY OMITTED LINE 10 COL 15 ERASE EOL - * - STOP RUN. -]) - -AT_CHECK([$COMPILE_ONLY prog.cob], [0], [], -[prog.cob:5: warning: handling of DISPLAY OMITTED is unfinished; implementation is likely to be changed -prog.cob:6: warning: handling of DISPLAY OMITTED is unfinished; implementation is likely to be changed -]) - -AT_CLEANUP - - -AT_SETUP([CGI: EXTERNAL-FORM]) -AT_KEYWORDS([misc acu extensions accept display]) - -# TODO: need a better tests when we implement this, -# likely split into multiple ones - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 GNUCOBOL-URL IS EXTERNAL-FORM - IDENTIFIED BY "http://www.gnu.org/software/gnucobol/". - 01 WEB-PAGE-1 EXTERNAL-FORM, - IDENTIFIED "cgipage1". - 01 SIMPLE-FORM IS EXTERNAL-FORM. - 03 SIMPLE-FORM-VAR1 PIC X(10). - 03 SIMPLE-FORM-VAR2 PIC 9(5). - 01 MY-FORM EXTERNAL-FORM. - 03 CGI-VAR1 PIC X(20) IDENTIFIED "Name". - 03 CGI-VAR2 PIC X(50) IDENTIFIED BY CGI-VAR1. - - PROCEDURE DIVISION. - MAIN. - *> CGI display of static content (full URL) - DISPLAY GNUCOBOL-URL - *> CGI display of static content (current URL + "cgipage1" + ".html") - DISPLAY WEB-PAGE-1 - *> CGI display of output form - DISPLAY MY-FORM - *> CGI display of input form (docs say: used for debugging purposes) - DISPLAY SIMPLE-FORM - *> CGI accept - ACCEPT SIMPLE-FORM - *> normal accept - ACCEPT SIMPLE-FORM-VAR1 - *> CGI accept with first var (with cgi identifier Name) - *> setting the cgi identifier of the second - ACCEPT MY-FORM - * - STOP RUN. -]) - -AT_CHECK([$COMPILE_ONLY -std=acu-strict prog.cob], [0], [], -[prog.cob:6: warning: EXTERNAL-FORM is not implemented -prog.cob:8: warning: EXTERNAL-FORM is not implemented -prog.cob:10: warning: EXTERNAL-FORM is not implemented -prog.cob:13: warning: EXTERNAL-FORM is not implemented -prog.cob:14: warning: EXTERNAL-FORM (IDENTIFIED BY) is not implemented -prog.cob:15: warning: EXTERNAL-FORM (IDENTIFIED BY) is not implemented -]) - -AT_CLEANUP - - -AT_SETUP([adding/removing reserved words]) -AT_KEYWORDS([misc extensions configuration]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 hello PIC X. - 01 foo PIC X. - 01 bars PIC X. - 01 file PIC X. - 01 background-color PIC X. - - PROCEDURE DIVISION. - CONTINUE - . -]) - -AT_CHECK([$COMPILE_ONLY -freserved=hello,foo,bars,background-color -fnot-reserved=file prog.cob], [1], [], -[prog.cob:7: error: 'hello' is a reserved word, but isn't supported -prog.cob:8: error: 'foo' is a reserved word, but isn't supported -prog.cob:9: error: 'bars' is a reserved word, but isn't supported -prog.cob:11: error: syntax error, unexpected BACKGROUND-COLOR -]) -AT_CHECK([$COMPILE_ONLY -fnot-reserved=file prog.cob], [0], []) -AT_CLEANUP - - -AT_SETUP([adding aliases]) -AT_KEYWORDS([misc extensions configuration reserved]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - - PROCEDURE DIVISION. - FOO "Hello, world!" - . -]) - -# FIXME: user defined words need to store a reference to the name originally defining the word -# otherwise we can't help the user to know where the error came from -# (command line is only a special case, but even then it may be wrapped and not visible -# to the user) -#AT_CHECK([$COMPILE_ONLY -freserved=FOO=DISPLAY* -freserved=BARS:FOO prog.cob], [1], [], -#[configuration warning: -freserved=FOO=DISPLAY*: ignored asterisk at end of alias target -#configuration error: -#-freserved=BARS:FOO: alias target 'FOO' is not a default reserved word -#]) - -AT_CHECK([$COMPILE_ONLY -freserved=FOO=DISPLAY* -freserved=BARS:FOO prog.cob], [1], [], -[configuration warning: -freserved=FOO=DISPLAY*: ignored asterisk at end of alias target -configuration error: -alias target 'FOO' is not a default reserved word -]) - -AT_CHECK([$COMPILE_ONLY -freserved=FOO=DISPLAY prog.cob], [0], [], []) -AT_CHECK([$COMPILE_ONLY -freserved=FOO:DISPLAY prog.cob], [0], [], []) -AT_CHECK([$COMPILE_ONLY -freserved=" FOO = DISPLAY " prog.cob], [0], [], []) -AT_CLEANUP - - -AT_SETUP([overriding default words]) -AT_KEYWORDS([misc extensions configuration reserved]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - - PROCEDURE DIVISION. - COMP-1 "Hello, world!" - DISPLAY "Hello, world!". -]) - -AT_CHECK([$COMPILE_ONLY -freserved=COMP-1=DISPLAY prog.cob], [0], [], []) - -AT_DATA([prog2.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog2. - - PROCEDURE DIVISION. - COMP-1 "Hello, world!". - DISPLAY "Hello, world!". -]) - -AT_CHECK([$COMPILE_ONLY -fnot-reserved=DISPLAY -freserved=COMP-1=DISPLAY prog2.cob], [1], [], -[prog2.cob:7: error: unknown statement 'DISPLAY'; it may exist in another dialect -]) - -AT_CLEANUP - - -AT_SETUP([complete specified word list]) -AT_KEYWORDS([misc extensions configuration reserved]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 SQLCA. - 03 SQLCABC USAGE BINARY-LONG VALUE 136. -]) - -AT_CHECK([$COMPILE_ONLY -std=ibm-strict prog.cob], [1], [], -[prog.cob:7: error: 'BINARY-LONG' is not defined, but is a reserved word in another dialect -]) -AT_CHECK([$COMPILE_ONLY -std=ibm-strict -freserved=BINARY-LONG prog.cob], [0], [], []) -AT_CHECK([$COMPILE_ONLY -std=ibm prog.cob], [0], [], []) -AT_CLEANUP - - -AT_SETUP([ANY LENGTH item as BY VALUE formal parameter]) -AT_KEYWORDS([misc BY VALUE]) -AT_SKIP_IF(true) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - - DATA DIVISION. - LINKAGE SECTION. - 01 str ANY LENGTH PIC X. - - PROCEDURE DIVISION USING VALUE str. - GOBACK - . -]) - -AT_CHECK([$COMPILE_ONLY prog.cob], [1], [], -[prog.cob:9: error: ANY LENGTH items may only be BY REFERENCE formal parameters -]) -AT_CLEANUP - - -AT_SETUP([swapped SOURCE- and OBJECT-COMPUTER]) -AT_KEYWORDS([misc extensions]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - - ENVIRONMENT DIVISION. - CONFIGURATION SECTION. - OBJECT-COMPUTER. a. - SOURCE-COMPUTER. b. -]) - -# MF extension, supported by GnuCOBOL -AT_CHECK([$COMPILE_ONLY prog.cob], [0], [], []) -# note: testing with lax configuration, otherwise there would be an error -AT_CHECK([$COMPILE_ONLY -std=acu prog.cob], [0], [], -[prog.cob:8: warning: SOURCE-COMPUTER incorrectly after OBJECT-COMPUTER used -]) -AT_CLEANUP - - -AT_SETUP([CONF. SECTION paragraphs in wrong order]) -AT_KEYWORDS([misc extensions]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - - ENVIRONMENT DIVISION. - CONFIGURATION SECTION. - REPOSITORY. - SOURCE-COMPUTER. b. - OBJECT-COMPUTER. a. - SPECIAL-NAMES. - - END PROGRAM prog. - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog2. - - ENVIRONMENT DIVISION. - CONFIGURATION SECTION. - SOURCE-COMPUTER. b. - OBJECT-COMPUTER. a. - REPOSITORY. - SPECIAL-NAMES. - - END PROGRAM prog2. - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog3. - - ENVIRONMENT DIVISION. - CONFIGURATION SECTION. - REPOSITORY. - SOURCE-COMPUTER. b. - OBJECT-COMPUTER. a. - - END PROGRAM prog3. - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog4. - - ENVIRONMENT DIVISION. - CONFIGURATION SECTION. - REPOSITORY. - SPECIAL-NAMES. - SOURCE-COMPUTER. b. - OBJECT-COMPUTER. a. - - END PROGRAM prog4. -]) - -# MF extension, supported by GnuCOBOL -AT_CHECK([$COMPILE_ONLY prog.cob], [0], [], []) -# note: testing with lax configuration, otherwise there would be an error -AT_CHECK([$COMPILE_ONLY -std=acu prog.cob], [0], [], -[prog.cob:8: warning: SOURCE-COMPUTER incorrectly after REPOSITORY used -prog.cob:22: warning: SPECIAL-NAMES incorrectly after REPOSITORY used -prog.cob:32: warning: SOURCE-COMPUTER incorrectly after REPOSITORY used -prog.cob:43: warning: SPECIAL-NAMES incorrectly after REPOSITORY used -prog.cob:44: warning: SOURCE-COMPUTER incorrectly after SPECIAL-NAMES used -]) -AT_CHECK([$COMPILE_ONLY -std=cobol2014 prog.cob], [1], [], -[prog.cob:8: error: SOURCE-COMPUTER incorrectly after REPOSITORY used -prog.cob:22: error: SPECIAL-NAMES incorrectly after REPOSITORY used -prog.cob:32: error: SOURCE-COMPUTER incorrectly after REPOSITORY used -prog.cob:43: error: SPECIAL-NAMES incorrectly after REPOSITORY used -prog.cob:44: error: SOURCE-COMPUTER incorrectly after SPECIAL-NAMES used -]) -AT_CLEANUP - - -AT_SETUP([NOT ON EXCEPTION with STATIC CALL convention]) -AT_KEYWORDS([misc CALL-CONVENTION]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - PROCEDURE DIVISION. - CALL STATIC "stuff" - ON EXCEPTION - CONTINUE - END-CALL - GOBACK. -]) - -AT_DATA([prog2.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog2. - PROCEDURE DIVISION. - CALL "stuff" - ON EXCEPTION - CONTINUE - END-CALL - GOBACK. -]) - -AT_DATA([prog3.cob], [ - >> CALL-CONVENTION STATIC - IDENTIFICATION DIVISION. - PROGRAM-ID. prog3. - PROCEDURE DIVISION. - CALL "stuff" - ON EXCEPTION - CONTINUE - END-CALL - GOBACK. -]) - -AT_CHECK([$COMPILE_ONLY prog.cob], [0], [], -[prog.cob:5: warning: ON EXCEPTION ignored because of STATIC CALL -]) -AT_CHECK([$COMPILE_ONLY prog2.cob], [0], [], []) -AT_CHECK([$COMPILE_ONLY -fstatic-call prog2.cob], [0], [], []) -AT_CHECK([$COMPILE_ONLY prog3.cob], [0], [], -[prog3.cob:6: warning: STATIC CALL convention ignored because of ON EXCEPTION -]) -AT_CLEANUP - - -AT_SETUP([NOT ON EXCEPTION phrases before ON EXCEPTION]) -AT_KEYWORDS([misc]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - - ENVIRONMENT DIVISION. - INPUT-OUTPUT SECTION. - FILE-CONTROL. - SELECT f ASSIGN "f.txt" - ORGANIZATION LINE SEQUENTIAL. - - DATA DIVISION. - FILE SECTION. - FD f LINAGE 10. - 01 f-rec PIC X. - - PROCEDURE DIVISION. - WRITE f-rec FROM "x" - NOT END-OF-PAGE - CONTINUE - END-OF-PAGE - CONTINUE - END-WRITE - WRITE f-rec FROM "x" - END-OF-PAGE - CONTINUE - NOT END-OF-PAGE - CONTINUE - END-WRITE - WRITE f-rec FROM "x" - NOT END-OF-PAGE - CONTINUE - END-WRITE - WRITE f-rec FROM "x" - END-OF-PAGE - CONTINUE - END-WRITE - - DISPLAY "blah" - ON EXCEPTION - CALL "err" - NOT ON EXCEPTION - CONTINUE - ON EXCEPTION - CONTINUE. - DISPLAY "blah" - NOT ON EXCEPTION - CALL "err" - ON EXCEPTION - CONTINUE - NOT ON EXCEPTION - CONTINUE. -]) - -AT_CHECK([$COMPILE_ONLY -std=cobol85 prog.cob], [1], [], -[prog.cob:22: error: NOT AT END-OF-PAGE before AT END-OF-PAGE does not conform to COBOL 85 -prog.cob:44: error: NOT EXCEPTION before EXCEPTION does not conform to COBOL 85 -]) -AT_CHECK([$COMPILE_ONLY prog.cob], [0], [], []) -AT_CLEANUP - - -AT_SETUP([wrong dialect hints]) -AT_KEYWORDS([misc configuration reserved]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 x PIC X. - - PROCEDURE DIVISION. - DISPLAY x CONVERSION. - TRANSFORM x - . -]) - -AT_CHECK([$COMPILE_ONLY -std=cobol85 prog.cob], [1], [], -[prog.cob:10: error: 'CONVERSION' is not defined, but is a reserved word in another dialect -prog.cob:11: error: unknown statement 'TRANSFORM'; it may exist in another dialect -]) -AT_CLEANUP - - -AT_SETUP([redundant periods]) -AT_KEYWORDS([misc]) - -AT_DATA([a.cpy], [ - 01 var PIC X -]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - - DATA DIVISION. - WORKING-STORAGE SECTION. - REPLACE ==a== BY ==b==.. *> blah blah - . - - COPY a.. - - 78 var VALUE "hello". - * blah blah - . -]) - -AT_CHECK([$COMPILE_ONLY prog.cob], [0], [], -[prog.cob:6: warning: ignoring redundant . -prog.cob:12: warning: ignoring redundant . -]) -AT_CLEANUP - - -AT_SETUP([IF-ELSE statement list with invalid syntax]) -AT_KEYWORDS([misc]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 a-variable PIC 9. - - PROCEDURE DIVISION. - IF a-variable = 1 - ACCEPT a-variable, not-a-variable - ON EXCEPTION - CONTINUE - END-ACCEPT - ELSE - CONTINUE - END-IF - . -]) - -AT_CHECK([$COMPILE_ONLY prog.cob], [1], [], -[prog.cob:11: error: syntax error, unexpected Identifier -prog.cob:14: error: syntax error, unexpected END-ACCEPT -prog.cob:15: error: syntax error, unexpected ELSE -prog.cob:17: error: syntax error, unexpected END-IF -]) - -AT_CLEANUP - - -AT_SETUP([EVALUATE statement with invalid syntax]) -AT_KEYWORDS([misc expression]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 a-variable PIC 9. - - PROCEDURE DIVISION. - EVALUATE a-variable - - ALSO true - - WHEN 1 - - ALSO a-variable - CONTINUE - - WHEN 1 OR 2 - CONTINUE - - END-EVALUATE - . - EVALUATE a-variable - - ALSO true - - WHEN 3 - CONTINUE - - WHEN 5 - CONTINUE - - END-EVALUATE - . -]) - -AT_CHECK([$COMPILE_ONLY prog.cob], [1], [], -[prog.cob:19: error: invalid conditional expression -prog.cob:16: error: invalid expression -prog.cob:28: error: wrong number of WHEN parameters -prog.cob:31: error: wrong number of WHEN parameters -]) - -AT_CLEANUP - - -AT_SETUP([MF reserved word directives]) -AT_KEYWORDS([extensions ADDRSV ADDSYN MAKESYN OVERRIDE REMOVE]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - - *> Valid - $SET ADDRSV"DOG""CAT" - - *> Valid - $SET ADD-SYN "VALUE" = "VA" - *> Bread is not reserved. - $SET ADDSYN "BREAD" = "BARA" - *> ID is already reserved - $SET ADDSYN "IDENTIFICATION" = "ID" - - *> Valid - $SET MAKESYN(PROGRAM) = (FUNCTION) - *> BREAD is not reserved. - $SET MAKESYN "BREAD" = "PROGRAM" - $SET MAKESYN "PROGRAM" = "BREAD" - - *> Valid - $SET OVERRIDE "DIVISION" = "DIV" "JUST" = "JS" - *> Bread is not reserved - $SET OVERRIDE "BREAD"="BARA" - *> ID is already reserved - $SET OVERRIDE "IDENTIFICATION"="ID" - - *> Valid - $SET REMOVE "BREAD" (BARA)REMOVE(DOG) - - DATA DIV. - WORKING-STORAGE SECTION. - *> Check ADDSYN and OVERRIDE work correctly - 01 just PIC XX VA "1" JS. - *> Check ADDRSV - 01 cat PIC 9 VA 1. - *> Check REMOVE - 01 dog PIC 9 VA 1. -]) - -AT_CHECK([$COMPILE_ONLY prog.cob], [1], [], -[prog.cob:11: error: 'BREAD' is not a default reserved word, so cannot be aliased -prog.cob:13: error: 'ID' is already reserved; you may want MAKESYN instead -prog.cob:18: error: 'BREAD' is not a default reserved word, so cannot be aliased -prog.cob:19: error: 'BREAD' is not a reserved word; you may want ADDSYN or OVERRIDE instead -prog.cob:24: error: 'BREAD' is not a default reserved word, so cannot be aliased -prog.cob:26: error: 'ID' is already reserved; you may want MAKESYN instead -prog.cob:36: error: 'cat' is a reserved word, but isn't supported -]) - -AT_CLEANUP - - -AT_SETUP([STRING / UNSTRING with invalid syntax]) -AT_KEYWORDS([misc]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - - DATA DIVISION. - WORKING-STORAGE SECTION. - 77 a PIC X. - 77 b PIC X. - 77 c PIC XXX. - - PROCEDURE DIVISION. - STRING DELIMITED BY SPACE INTO - END-STRING - STRING a DELIMITED BY SPACE c - END-STRING - STRING a DELIMITED BY SPACE INTO - END-STRING - STRING - DELIMITED BY SPACE - INTO c - END-STRING - STRING a DELIMITED BY SPACE - - DELIMITED BY SIZE - INTO c - END-STRING - STRING a DELIMITED BY SPACE - b DELIMITED BY SIZE - INTO c - END-STRING - * - UNSTRING DELIMITED BY SPACE INTO a - END-UNSTRING - UNSTRING c DELIMITED BY SPACE a - END-UNSTRING - UNSTRING c DELIMITED BY SPACE INTO - END-UNSTRING - UNSTRING DELIMITED BY SPACE INTO a - END-UNSTRING - UNSTRING c DELIMITED BY SPACE INTO a - END-UNSTRING - UNSTRING c DELIMITED BY SPACE - DELIMITED BY SIZE INTO a - END-UNSTRING - . -]) - -AT_CHECK([$COMPILE_ONLY prog.cob], [1], [], -[prog.cob:12: error: syntax error, unexpected DELIMITED -prog.cob:15: error: syntax error, unexpected END-STRING, expecting INTO -prog.cob:17: error: syntax error, unexpected END-STRING, expecting Identifier -prog.cob:19: error: syntax error, unexpected DELIMITED -prog.cob:24: error: syntax error, unexpected DELIMITED, expecting INTO -prog.cob:32: error: syntax error, unexpected DELIMITED -prog.cob:34: error: syntax error, unexpected Identifier, expecting INTO -prog.cob:37: error: syntax error, unexpected END-UNSTRING, expecting Identifier -prog.cob:38: error: syntax error, unexpected DELIMITED -prog.cob:43: error: syntax error, unexpected DELIMITED, expecting INTO -]) -AT_CLEANUP - - -AT_SETUP([use of program-prototypes]) -AT_KEYWORDS([misc]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - - ENVIRONMENT DIVISION. - CONFIGURATION SECTION. - REPOSITORY. - PROGRAM test-prog - . - PROCEDURE DIVISION. - CALL test-prog - CANCEL test-prog - . -]) - -AT_CHECK([$COMPILE_ONLY -fprogram-prototypes=warning prog.cob], [0], [], -[prog.cob:9: warning: PROGRAM phrase used -prog.cob:8: warning: no definition/prototype seen for PROGRAM 'test-prog' -prog.cob:11: warning: CALL/CANCEL with program-prototype-name used -prog.cob:12: warning: CALL/CANCEL with program-prototype-name used -]) -AT_CLEANUP - - -AT_SETUP([invalid INSPECT/TRANSFORM operands]) -AT_KEYWORDS([misc INSPECT TRANSFORM]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - - ENVIRONMENT DIVISION. - INPUT-OUTPUT SECTION. - FILE-CONTROL. - SELECT f ASSIGN "A". - - DATA DIVISION. - FILE SECTION. - FD f. - 01 f-rec PIC X. - - WORKING-STORAGE SECTION. - 01 not-display PIC 9(5) COMP. - 01 not-a-num PIC X(5). - - PROCEDURE DIVISION. - INSPECT f TALLYING not-a-num FOR ALL 3 - REPLACING FIRST "abcde" BY not-display - TRANSFORM f FROM 3 TO 2 - . -]) - -AT_CHECK([$COMPILE_ONLY prog.cob], [1], [], -[prog.cob:20: error: 'f' is not a field -prog.cob:20: error: 'not-a-num' is not numeric -prog.cob:20: error: 3 is not an alphanumeric literal -prog.cob:20: error: invalid target for TALLYING -prog.cob:21: error: 'not-display' is not USAGE DISPLAY -prog.cob:20: error: REPLACING operands differ in size -prog.cob:20: error: invalid target for REPLACING -prog.cob:22: error: 'f' is not a field -prog.cob:22: error: 3 is not an alphanumeric literal -prog.cob:22: error: 2 is not an alphanumeric literal -prog.cob:22: error: invalid target for TRANSFORM -]) -AT_CLEANUP - - -AT_SETUP([SIGN clause checks]) -AT_KEYWORDS([misc]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 valid-1 SIGN TRAILING. - 03 x PIC S999. - 03 y PIC S999. - 01 valid-2 PIC S99. - - 01 invalid-1 PIC 99 SIGN LEADING. - 01 invalid-2 PIC S99 SIGN TRAILING, USAGE BINARY. -]) - -AT_CHECK([$COMPILE_ONLY prog.cob], [1], [], -[prog.cob:12: error: elementary items with SIGN clause must have S in PICTURE -prog.cob:13: error: elementary items with SIGN clause must be USAGE DISPLAY or NATIONAL -]) -AT_CLEANUP - - -AT_SETUP([conflicting entry conventions]) -AT_KEYWORDS([misc ENTRY-CONVENTION CALL-CONVENTION LINKAGE]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - OPTIONS. - ENTRY-CONVENTION COBOL. - ENVIRONMENT DIVISION. - CONFIGURATION SECTION. - SPECIAL-NAMES. - CALL-CONVENTION 0 IS EXTERN. - - PROCEDURE DIVISION EXTERN. - CONTINUE - . -]) -AT_CHECK([$COMPILE_ONLY prog.cob], [0], [], -[prog.cob:11: warning: overriding convention specified in ENTRY-CONVENTION -]) - -AT_DATA([prog2.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog2. - OPTIONS. - ENTRY-CONVENTION COBOL. - ENVIRONMENT DIVISION. - CONFIGURATION SECTION. - - PROCEDURE DIVISION WITH C LINKAGE. - CONTINUE - . -]) -AT_CHECK([$COMPILE_ONLY prog2.cob], [0], [], -[prog2.cob:9: warning: overriding convention specified in ENTRY-CONVENTION -]) - -AT_DATA([prog3.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog3. - ENVIRONMENT DIVISION. - CONFIGURATION SECTION. - SPECIAL-NAMES. - CALL-CONVENTION 0 IS EXTERN. - - PROCEDURE DIVISION - EXTERN - WITH C LINKAGE. - CONTINUE - ENTRY 'ANOTHERSTATEMENT'. - CONTINUE - ENTRY EXTERN 'ANOTHERSTATEMENT2'. - CONTINUE - ENTRY 'ANOTHERSTATEMENT3' WITH C LINKAGE. - CONTINUE - ENTRY - EXTERN - 'ANOTHERSTATEMENT4' - WITH C LINKAGE. - CONTINUE - . -]) -AT_CHECK([$COMPILE_ONLY prog3.cob], [1], [], -[prog3.cob:11: error: CALL-CONVENTION and WITH LINKAGE are mutually exclusive -prog3.cob:22: error: CALL-CONVENTION and WITH LINKAGE are mutually exclusive -]) -AT_CLEANUP - - -AT_SETUP([conflicting call conventions]) -AT_KEYWORDS([misc CALL-CONVENTION LINKAGE]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - PROCEDURE DIVISION. - CALL EXTERN 'callee'. - CALL 'callee' WITH C LINKAGE. - CALL - EXTERN - 'callee' - WITH C LINKAGE - . - GOBACK. -]) -AT_CHECK([$COMPILE_ONLY prog.cob], [1], [], -[prog.cob:10: error: CALL-CONVENTION and WITH LINKAGE are mutually exclusive -]) -AT_CHECK([$COMPILE_ONLY -std=cobol85 -freserved=EXTERN,C prog.cob], [1], [], -[prog.cob:5: error: CALL-/ENTRY-CONVENTION does not conform to COBOL 85 -prog.cob:6: error: WITH ... LINKAGE does not conform to COBOL 85 -prog.cob:8: error: CALL-/ENTRY-CONVENTION does not conform to COBOL 85 -prog.cob:10: error: WITH ... LINKAGE does not conform to COBOL 85 -prog.cob:10: error: CALL-CONVENTION and WITH LINKAGE are mutually exclusive -]) -AT_CLEANUP - - -AT_SETUP([dangling LINKAGE items]) -AT_KEYWORDS([misc]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - LINKAGE SECTION. - * constants may occur anywhere but don't belong to LINKAGE - 78 NSIZE VALUE 1. - * - * two variables in USING - 77 A PIC X. - 01 B. - 03 B1 PIC X. - 03 B2 PIC 9(NSIZE). - * variable not referenced anywhere - no warning - 77 C PIC X. - * variable referenced by its REDEFINE - 01 D PIC XX. - 01 filler redefines D. - 03 D1 PIC X. - 03 D2 PIC 9(NSIZE). - * variable referenced by its second REDEFINE - 01 E PIC XX. - 01 filler redefines E. - 03 Ea1 PIC X. - 03 Ea2 PIC 9(NSIZE). - 01 filler redefines E. - 03 Eb1 PIC X. - 03 Eb2 PIC 9(NSIZE). - * variable referenced by its child - 01 F. - 03 F1 PIC X. - 03 F2 PIC 9(NSIZE). - * variable referenced by level 88 (a validation entry) - 01 G. - 03 filler PIC X. - 88 g-val-a value 'a'. - 88 g-val-b value 'b'. - PROCEDURE DIVISION USING A B. - - IF D2 OMITTED OR Eb2 OMITTED or F2 OMITTED - set g-val-b to true - END-IF - . -]) -AT_CHECK([$COMPILE_ONLY -Wlinkage prog.cob], [0], [], -[prog.cob:17: warning: LINKAGE item 'D' is not a PROCEDURE USING parameter -prog.cob:22: warning: LINKAGE item 'E' is not a PROCEDURE USING parameter -prog.cob:30: warning: LINKAGE item 'F' is not a PROCEDURE USING parameter -prog.cob:34: warning: LINKAGE item 'G' is not a PROCEDURE USING parameter -]) -AT_CLEANUP - - -AT_SETUP([ADD / SUBTRACT TABLE]) -AT_KEYWORDS([misc]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 tab1. - 03 tab1-entry OCCURS 5 PIC S999. - 01 tab2. - 03 tab2-entry OCCURS 7 PIC S99. - 03 tab2b-entry OCCURS 7. - 05 x PIC S99. - 01 tab3. - 03 sub-tab-3 OCCURS 2. - 05 tab3-entry OCCURS 5 PIC S999. - - PROCEDURE DIVISION. - ADD TABLE tab1-entry TO tab2-entry. - SUBTRACT TABLE tab2-entry FROM tab1-entry. - ADD TABLE tab1-entry TO tab3-entry (1). - SUBTRACT TABLE tab2-entry FROM tab3-entry (2). - ADD TABLE tab1-entry TO x. - SUBTRACT TABLE x FROM tab1-entry. - ADD TABLE tab1-entry TO tab2b-entry. - GOBACK. -]) - -AT_CHECK([$COMPILE_ONLY prog.cob], [1], [], -[prog.cob:18: warning: ADD TABLE is not implemented -prog.cob:19: warning: SUBTRACT TABLE is not implemented -prog.cob:20: warning: ADD TABLE is not implemented -prog.cob:21: warning: SUBTRACT TABLE is not implemented -prog.cob:22: warning: ADD TABLE is not implemented -prog.cob:23: warning: SUBTRACT TABLE is not implemented -prog.cob:24: warning: ADD TABLE is not implemented -prog.cob:24: error: 'tab2b-entry' is not numeric -]) -AT_CLEANUP - - -AT_SETUP([USE FOR DEBUGGING invalid ref-mod / subscripts]) -AT_KEYWORDS([misc]) - -# COBOL85 3.2.3 Syntax Rules 10+12 - "no subscripts. not reference-modified" -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - - ENVIRONMENT DIVISION. - CONFIGURATION SECTION. - SOURCE-COMPUTER. - whatever WITH DEBUGGING MODE. - - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 i PIC 9. - 01 FILLER. - 03 x OCCURS 2 PIC 9. - - PROCEDURE DIVISION. - DECLARATIVES. - test-DEBUG SECTION. - USE FOR DEBUGGING ON ALL OF I (1:1). - DISPLAY DEBUG-LINE. - test-DEBUGo SECTION. - USE FOR DEBUGGING ON ALL OF X (1). - DISPLAY DEBUG-LINE. - END DECLARATIVES. - - MAIN SECTION. - MOVE 1 TO i, x(2) - STOP RUN. -]) - - -AT_CHECK([$COMPILE_ONLY prog.cob], [1], [], -[prog.cob: in section 'test-DEBUG': -prog.cob:19: error: DEBUGGING target may not be reference modified -prog.cob: in section 'test-DEBUGo': -prog.cob:22: error: DEBUGGING target may not be subscripted -]) - -AT_CLEANUP - - -AT_SETUP([USE FOR DEBUGGING duplicate targets]) -AT_KEYWORDS([misc]) - -# TODO: add cd-names and file-names here - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - - ENVIRONMENT DIVISION. - CONFIGURATION SECTION. - SOURCE-COMPUTER. - whatever WITH DEBUGGING MODE. - - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 i PIC 9. - 01 j PIC 9. - - PROCEDURE DIVISION. - DECLARATIVES. - test-DEBUG SECTION. - USE FOR DEBUGGING ON MAIN MAIN. - DISPLAY DEBUG-LINE. - test-DEBUG2 SECTION. - USE FOR DEBUGGING ON ALL I - ALL REFERENCES OF J - ALL PROCEDURES. - DISPLAY DEBUG-LINE. - test-DEBUG3 SECTION. - USE FOR DEBUGGING ON ALL PROCEDURES - J - ALL OF I. - DISPLAY DEBUG-LINE. - END DECLARATIVES. - - MAIN SECTION. - MOVE 1 TO i - STOP RUN. -]) - -AT_CHECK([$COMPILE_ONLY prog.cob], [1], [], -[prog.cob: in section 'test-DEBUG3': -prog.cob:26: error: duplicate USE DEBUGGING ON ALL PROCEDURES -prog.cob:27: error: duplicate DEBUGGING target: 'j' -prog.cob:28: error: duplicate DEBUGGING target: 'i' -prog.cob: in section 'test-DEBUG': -prog.cob:18: error: DEBUGGING target already specified with ALL PROCEDURES: 'MAIN' -prog.cob:18: error: duplicate DEBUGGING target: 'MAIN' -]) -AT_CLEANUP - - -AT_SETUP([USE FOR DEBUGGING syntax-checks]) -AT_KEYWORDS([misc]) - -# TODO: still need tests/checks (3.2.3 Syntax Rules 9+11): -# 09 Identifier must not reference any data item defined in the Report -# Section except sum counters. -# 11 References to the special register DEBUG-ITEM are restricted to -# references from within a debugging section. - -AT_XFAIL_IF(true) -# we currently fail to detect references into DECLARATIVES and -# references to debugging-procedures other than PERFORM --> both in prog2 - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - - ENVIRONMENT DIVISION. - CONFIGURATION SECTION. - SOURCE-COMPUTER. - whatever WITH DEBUGGING MODE. - - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 i PIC 9. - 01 j PIC 9. - - PROCEDURE DIVISION. - DECLARATIVES. - test-DEBUG SECTION. - USE FOR DEBUGGING ON ALL REFERENCES OF I - TEST-debug - MAIN. - DISPLAY DEBUG-LINE. - PERFORM MAIN. PERFORM TEST-DEBUG2. GO TO TEST-DEBUG2. - test-DEBUG2 SECTION. - USE FOR DEBUGGING ON ALL OF I - TEST-debug. - DISPLAY DEBUG-LINE. - END DECLARATIVES. - - MAIN SECTION. - MOVE 1 TO i, j - PERFORM TesT-DebuG - STOP RUN. -]) - -AT_CHECK([$COMPILE_ONLY prog.cob], [1], [], -[prog.cob: in section 'TEST-DEBUG2': -prog.cob:24: error: duplicate DEBUGGING target: 'i' -prog.cob: in section 'test-DEBUG': -prog.cob:22: warning: 'MAIN' is not in DECLARATIVES -prog.cob:19: error: DEBUGGING target invalid: 'test-DEBUG' -prog.cob: in section 'TEST-DEBUG2': -prog.cob:25: error: DEBUGGING target invalid: 'test-DEBUG' -]) -AT_CHECK([$COMPILE_ONLY -std=cobol85 prog.cob], [1], [], -[prog.cob: in section 'TEST-DEBUG2': -prog.cob:24: error: duplicate DEBUGGING target: 'i' -prog.cob: in section 'test-DEBUG': -prog.cob:22: error: 'MAIN' is not in DECLARATIVES -prog.cob:19: error: DEBUGGING target invalid: 'test-DEBUG' -prog.cob: in section 'TEST-DEBUG2': -prog.cob:25: error: DEBUGGING target invalid: 'test-DEBUG' -]) -AT_CLEANUP - - -AT_SETUP([Empty PERFORM with DEBUGGING MODE]) -AT_KEYWORDS([misc]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - - ENVIRONMENT DIVISION. - CONFIGURATION SECTION. - SOURCE-COMPUTER. - whatever WITH DEBUGGING MODE. - - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 i PIC 9. - - PROCEDURE DIVISION. - PERFORM VARYING i FROM 1 BY 1 - UNTIL i = 5 - END-PERFORM - . -]) - -AT_CHECK([$COMPILE_ONLY -fmissing-statement=ok prog.cob], [0], [], []) -AT_CLEANUP - - -# TODO: add more here -AT_SETUP([whitespace handling]) -AT_KEYWORDS([misc]) - -AT_DATA([prog1.cob], [ - IDENTIFICATION - DIVISION - . - author. - tester. - PROGRAM-ID - . - prog1 - . - REMARKS;. Should work.,, - - ENVIRONMENT - DIVISION - . - CONFIGURATION - SECTION - . - SOURCE-COMPUTER - . - whatever - WITH - DEBUGGING - MODE - . - - DDATA - D DIVISION - D . - WORKING-STORAGE - SECTION - . - 01 - i - PIC - 9 - . - - PROCEDURE - DIVISION - . - >> SOURCE FORMAT IS FREE -IF -i -GREATER -THAN -OR -EQUAL - -TO - -5 - -THEN - -GOBACK. - STOP - RUN - . -]) - -AT_DATA([prog2.cob], [ - ID,;DIVISION;,.,; - author,.;tester. - PROGRAM-ID,;.;,prog2;,.;, - REMARKS;. Should work.,, - ENVIRONMENT,;DIVISION;,.,; - CONFIGURATION;;,,SECTION;;,,. - SOURCE-COMPUTER;;.,,whatever;;DEBUGGING,,MODE;,. - - DDATA;DIVISION,. - DWORKING-STORAGE,SECTION;. - 01;i,PIC;9;. - - PROCEDURE;DIVISION,.; - IF;,i;,GREATER,;THAN;,OR,;EQUAL ,;TO;;5; - ,,,THEN;;;GOBACK. - STOP,RUN;., -]) - -AT_CHECK([$COMPILE_ONLY -Wno-obsolete prog1.cob], [0], [], []) -AT_CHECK([$COMPILE_ONLY -Wno-obsolete prog2.cob], [0], [], []) -AT_CLEANUP - - -AT_SETUP([STOP identifier]) -AT_KEYWORDS([misc extensions]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 x PIC 9(5) VALUE 1. - 01 y CONSTANT "ab". - - PROCEDURE DIVISION. - STOP x - STOP y - . -]) - -AT_CHECK([$COMPILE_ONLY prog.cob], [0], [], -[prog.cob:12: warning: STOP identifier is obsolete in GnuCOBOL -prog.cob:12: warning: STOP literal is obsolete in GnuCOBOL -]) -AT_CHECK([$COMPILE_ONLY -fstop-identifier=ok -fstop-literal=ok prog.cob], [0], [], []) -AT_CLEANUP - - -AT_SETUP([01 CONSTANT]) -AT_KEYWORDS([mirc reserved]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 NUM2 CONSTANT 3. - 01 CON3 CONSTANT ((1 + 2) * NUM2 - 4. - 01 CON4 CONSTANT (1 + 2) * NUM2 - 4). - 01 CON5 CONSTANT (1 + 2) // NUM2. - 01 CON6 CONSTANT (1 + 2 + 3 + (4)) / (NUM2). - * - PROCEDURE DIVISION. - MAIN. - STOP RUN. -]) - -AT_CHECK([$COMPILE_ONLY prog.cob], [1], [], -[prog.cob:7: error: missing right parenthesis -prog.cob:8: error: missing left parenthesis -prog.cob:9: error: '/' operator misplaced -]) - -AT_CHECK([$COMPILE_ONLY -std=mf-strict prog.cob], [1], [], -[prog.cob:6: error: syntax error, unexpected Identifier -prog.cob:7: error: syntax error, unexpected Identifier -prog.cob:8: error: syntax error, unexpected Identifier -prog.cob:9: error: syntax error, unexpected Identifier -prog.cob:10: error: syntax error, unexpected Identifier -]) - -AT_CHECK([$COMPILE_ONLY -std=mf-strict -freserved=CONSTANT prog.cob], [1], [], -[prog.cob:6: error: 01 CONSTANT does not conform to Micro Focus COBOL -prog.cob:7: error: 01 CONSTANT does not conform to Micro Focus COBOL -prog.cob:7: error: syntax error, unexpected Identifier, expecting . -]) - -AT_CHECK([$COMPILE_ONLY -std=mf prog.cob], [1], [], -[prog.cob:7: error: missing right parenthesis -prog.cob:8: error: missing left parenthesis -prog.cob:9: error: '/' operator misplaced -]) - -AT_CLEANUP - - -AT_SETUP([78 VALUE]) -AT_KEYWORDS([CONSTANT]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 78 NUM2 VALUE 3. - 78 NEG1 VALUE -1. - 78 CON3 VALUE ((1 + 2) * NUM2 - 4. - 78 CON4 VALUE (1 + 2) * NUM2 - 4). - 78 CON5 VALUE (1 + 2) // NUM2. - 78 CON6 VALUE (1 + 2 + 3 + (4)) / (NUM2). - * - PROCEDURE DIVISION. - MAIN. - STOP RUN. -]) - -AT_CHECK([$COMPILE_ONLY prog.cob], [1], [], -[prog.cob:8: error: missing right parenthesis -prog.cob:9: error: missing left parenthesis -prog.cob:10: error: '/' operator misplaced -]) - -AT_CHECK([$COMPILE_ONLY -std=ibm-strict prog.cob ], [1], [], -[prog.cob:6: error: 78 VALUE does not conform to IBM COBOL -prog.cob:7: error: 78 VALUE does not conform to IBM COBOL -prog.cob:8: error: 78 VALUE does not conform to IBM COBOL -prog.cob:8: error: missing right parenthesis -prog.cob:9: error: 78 VALUE does not conform to IBM COBOL -prog.cob:9: error: missing left parenthesis -prog.cob:10: error: 78 VALUE does not conform to IBM COBOL -prog.cob:10: error: '/' operator misplaced -prog.cob:11: error: 78 VALUE does not conform to IBM COBOL -]) - -AT_CHECK([$COMPILE_ONLY -std=ibm prog.cob], [1], [], -[prog.cob:8: error: missing right parenthesis -prog.cob:9: error: missing left parenthesis -prog.cob:10: error: '/' operator misplaced -]) - -AT_CLEANUP - - -AT_SETUP([level 78 NEXT / START OF]) -AT_KEYWORDS([extensions constant length]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 78 POS0 VALUE NEXT. - 01 MYREC. - 05 FLD1 PIC 9(2). - 05 FLD2 PIC X(7). - 78 POS3 VALUE NEXT. - 05 FLD3 PIC X(2) OCCURS 5 TIMES. - 78 POS4 VALUE NEXT. - 05 FLD4 PIC X(4). - 78 POS-NEXT VALUE NEXT. - 77 MYREC2 PIC X. - 01 MYREC3 EXTERNAL. - 05 FLD5 PIC X(4). - 78 POS5 VALUE NEXT. - 05 FLD6 PIC X(4). - 01 PICX PIC XXX VALUE 'Abc'. - 78 HUN VALUE 10 * (10 + LENGTH OF PICX) + 12.35-2+3. - 78 HUN2 VALUE HUN * (10 + LENGTH - OF PICX) -4. - 78 DIV1 VALUE 100 / 3. - 78 STRT4 VALUE START OF FLD4. - LINKAGE SECTION. - 01 XMYREC. - 05 XFLD1 PIC 9(2). - 05 XFLD2 PIC X(7). - 78 XPOS3 VALUE NEXT. - 05 XFLD3 PIC X(2) OCCURS 5 TIMES. - 78 XPOS4 VALUE NEXT. - 05 XFLD4 PIC X(4). - 05 XFLD5 PIC X(4). - 78 XSTRT4 VALUE START OF XFLD4. - * - PROCEDURE DIVISION. - STOP RUN. -]) - -AT_CHECK([$COMPILE_ONLY prog.cob], [1], [], -[prog.cob:6: error: VALUE of 'POS0': NEXT target is invalid -prog.cob:6: error: no previous data-item found -prog.cob:10: error: VALUE of 'POS3': NEXT target is invalid -prog.cob:10: error: target must be in FILE SECTION or LINKAGE SECTION or have the EXTERNAL clause -prog.cob:12: error: VALUE of 'POS4': NEXT target is invalid -prog.cob:12: error: target must be in FILE SECTION or LINKAGE SECTION or have the EXTERNAL clause -prog.cob:14: error: VALUE of 'POS-NEXT': NEXT target is invalid -prog.cob:14: error: target must be in FILE SECTION or LINKAGE SECTION or have the EXTERNAL clause -prog.cob:25: error: VALUE of 'STRT4': START OF target 'FLD4' is invalid -prog.cob:25: error: target must be in FILE SECTION or LINKAGE SECTION or have the EXTERNAL clause -]) - -AT_CLEANUP - - -AT_SETUP([SYMBOLIC CONSTANT]) -AT_KEYWORDS([misc SPECIAL-NAMES]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - CONFIGURATION SECTION. - SPECIAL-NAMES. - SYMBOLIC CONSTANT - con-1 IS 1 - 25156c "25156c". - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 NUM2 PIC 9. - 01 SHORT-X PIC X(5). - * - PROCEDURE DIVISION. - MAIN. - MOVE CON-1 TO NUM2. - MOVE 25156C TO SHORT-X - STOP RUN. -]) - -AT_CHECK([$COMPILE_ONLY prog.cob], [0], [], -[prog.cob: in paragraph 'MAIN': -prog.cob:18: warning: value size exceeds data size -prog.cob:18: warning: value size is 6 -prog.cob:13: warning: 'SHORT-X' defined here as PIC X(5) -]) - -AT_CHECK([$COMPILE_ONLY -std=mf-strict prog.cob], [1], [], -[prog.cob:9: error: invalid SYMBOLIC clause -prog.cob:9: error: integer value expected -prog.cob: in paragraph 'MAIN': -prog.cob:17: error: 'con-1' is not defined -]) - -AT_CHECK([$COMPILE_ONLY -std=cobol2014 prog.cob], [1], [], -[prog.cob:9: error: SYMBOLIC CONSTANT does not conform to COBOL 2014 -prog.cob: in paragraph 'MAIN': -prog.cob:18: warning: value size exceeds data size -prog.cob:18: warning: value size is 6 -prog.cob:13: warning: 'SHORT-X' defined here as PIC X(5) -]) - -AT_CLEANUP - - -AT_SETUP([Constant Expressions (1)]) -AT_KEYWORDS([condition expression refmod IF EVALUATE]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 var PIC X(200). - 01 othervar PIC X(115). - 01 A PIC 9 VALUE 1. - 01 B PIC 9 VALUE 2. - 01 C PIC 9 VALUE 3. - 78 var-len value 115. - - PROCEDURE DIVISION. - - IF var-len < 16 - move othervar (1:var-len - 8) - to var (17 - var-len:var-len - 8) - ELSE - move othervar to var - END-IF - - IF (2 = 3) - move othervar to var - ELSE - IF 1 = 1 - move var to othervar - ELSE - move othervar (1:var-len - 8) - to var (17 - var-len:var-len - 8) - IF 1 = 1 - move var to othervar - END-IF - END-IF - move A to B - IF 1 = 1 - IF 2 = 1 - move othervar (1:var-len - 8) - to var (17 - var-len:var-len - 8) - . - - PERFORM WITH TEST BEFORE UNTIL 1 = 3 - move othervar to var - END-PERFORM - - PERFORM WITH TEST BEFORE UNTIL 1 = 1 - move othervar (1:var-len - 8) - to var (17 - var-len:var-len - 8) - END-PERFORM - - PERFORM WITH TEST AFTER UNTIL 1 = 3 - move othervar to var - END-PERFORM - - PERFORM WITH TEST AFTER UNTIL 1 = 1 - move othervar to var - END-PERFORM - - EVALUATE TRUE - WHEN var-len < 16 - move othervar (1:var-len - 8) - to var (17 - var-len:var-len - 8) - WHEN var-len > 16 - move othervar to var - WHEN A = B - move var to othervar - WHEN OTHER - CONTINUE - END-EVALUATE - - EVALUATE FALSE - WHEN var-len < 16 - move othervar (1:var-len - 9) - to var (16 - var-len:var-len - 9) - WHEN var-len > 16 - move othervar to var - WHEN A = B - move var to othervar - WHEN OTHER - CONTINUE - END-EVALUATE. - - IF 15 = var-len - move othervar to var. - - IF var-len = 15 - move var to othervar. - - STOP RUN. -]) - -AT_CHECK([$COMPILE_ONLY prog.cob], [1], [], -[prog.cob:15: warning: expression '115' LESS THAN '16' is always FALSE -prog.cob:17: error (ignored): offset must be greater than zero -prog.cob:22: warning: expression '2' EQUALS '3' is always FALSE -prog.cob:25: warning: expression '1' EQUALS '1' is always TRUE -prog.cob:29: error (ignored): offset must be greater than zero -prog.cob:30: warning: expression '1' EQUALS '1' is always TRUE -prog.cob:35: warning: expression '1' EQUALS '1' is always TRUE -prog.cob:36: warning: expression '2' EQUALS '1' is always FALSE -prog.cob:38: error (ignored): offset must be greater than zero -prog.cob:41: warning: expression '1' EQUALS '3' is always FALSE -prog.cob:41: warning: PERFORM FOREVER since UNTIL is always FALSE -prog.cob:45: warning: expression '1' EQUALS '1' is always TRUE -prog.cob:45: warning: PERFORM NEVER since UNTIL is always TRUE -prog.cob:47: error (ignored): offset must be greater than zero -prog.cob:50: warning: expression '1' EQUALS '3' is always FALSE -prog.cob:50: warning: PERFORM FOREVER since UNTIL is always FALSE -prog.cob:54: warning: expression '1' EQUALS '1' is always TRUE -prog.cob:54: warning: PERFORM ONCE since UNTIL is always TRUE -prog.cob:59: warning: expression '115' LESS THAN '16' is always FALSE -prog.cob:61: error (ignored): offset must be greater than zero -prog.cob:62: warning: expression '115' GREATER THAN '16' is always TRUE -prog.cob:71: warning: expression '115' LESS THAN '16' is always FALSE -prog.cob:73: error: offset must be greater than zero -prog.cob:74: warning: expression '115' GREATER THAN '16' is always TRUE -prog.cob:82: warning: expression '15' EQUALS '115' is always FALSE -prog.cob:85: warning: expression '115' EQUALS '15' is always FALSE -]) - -AT_CLEANUP - - -AT_SETUP([Constant Expressions (2)]) -AT_KEYWORDS([condition expression unreachable 78]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 78 const1 value 115. - 01 const2 CONSTANT 200. - 78 const3 value const2. - 78 const4 value const2 + const1. - 77 othervar PIC X(const1). - 01 var PIC X(const2). - - PROCEDURE DIVISION. - - IF const1 = const2 - OR const2 = const1 - OR const3 = const4 - OR const4 = const3 - DISPLAY 'no way' END-DISPLAY - END-IF - - EVALUATE const1 - WHEN 15 - WHEN 115 - display '1' - WHEN < 16 - move othervar (1:8) - to var (17:8) - WHEN > 16 - display othervar - *> actually WHEN OTHER is also FALSE in this case (115 = 16), - *> but this is too complex to check - WHEN OTHER - display othervar - END-EVALUATE - - STOP RUN. -]) - -AT_CHECK([$COMPILE_ONLY prog.cob ], [0], [], -[prog.cob:15: warning: expression '115' EQUALS '200' is always FALSE -prog.cob:16: warning: expression '200' EQUALS '115' is always FALSE -prog.cob:17: warning: expression '200' EQUALS '315' is always FALSE -prog.cob:18: warning: expression '315' EQUALS '200' is always FALSE -prog.cob:26: warning: expression '115' LESS THAN '16' is always FALSE -prog.cob:29: warning: expression '115' GREATER THAN '16' is always TRUE -prog.cob:23: warning: expression '115' EQUALS '15' is always FALSE -prog.cob:24: warning: expression '115' EQUALS '115' is always TRUE -]) - -AT_CLEANUP - - -AT_SETUP([Constant Expressions (3)]) -AT_KEYWORDS([condition expression refmod undefined]) - -# verify that we do ignore undefined errors where possible -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 var PIC X(200). - 78 var-len value 115. - - PROCEDURE DIVISION. - - IF var-len < 16 - move spaces - to var (17 - var-len:var-len - 8) - END-IF - - IF var-len < 16 - move notdefined to var - END-IF - - IF var-len < 16 - perform notdefined - END-IF - - IF var-len < 16 - if notdefined continue. - - STOP RUN. -]) - -# note: the last error message comes from program validation -# and therefore cannot be raised earlier -AT_CHECK([$COMPILE_ONLY prog.cob], [0], [], -[prog.cob:11: warning: expression '115' LESS THAN '16' is always FALSE -prog.cob:13: error (ignored): offset must be greater than zero -prog.cob:16: warning: expression '115' LESS THAN '16' is always FALSE -prog.cob:17: error (ignored): 'notdefined' is not defined -prog.cob:20: warning: expression '115' LESS THAN '16' is always FALSE -prog.cob:24: warning: expression '115' LESS THAN '16' is always FALSE -prog.cob:25: error (ignored): 'notdefined' is not defined -prog.cob:21: error (ignored): 'notdefined' is not defined -]) - -AT_CLEANUP - - -AT_SETUP([Constant Expressions (4)]) -AT_KEYWORDS([condition expression refmod]) - -# verify that we do not ignore parsing errors as -# these are likely to raise issues in codegen - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 var PIC X(200). - 78 var-len value 115. - - PROCEDURE DIVISION. - - IF var-len < 16 - move spaces - to var (17 - var-len:var-len - 8) - IF IF. - - STOP RUN. -]) - -AT_CHECK([$COMPILE_ONLY prog.cob], [1], [], -[prog.cob:11: warning: expression '115' LESS THAN '16' is always FALSE -prog.cob:13: error (ignored): offset must be greater than zero -prog.cob:14: error: syntax error, unexpected IF -]) - -AT_CLEANUP - - -AT_SETUP([Constant Expressions (5)]) -AT_KEYWORDS([condition expression unreachable]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 VAR PIC X(200). - 01 OTHERVAR PIC X(115). - 78 VAR-LEN VALUE 115. - - PROCEDURE DIVISION. - MAIN-10. - MOVE "Peek a boo" TO VAR. - EVALUATE TRUE - ALSO FALSE - ALSO TRUE - WHEN TRUE - ALSO VAR-LEN > 16 AND VAR-LEN < 200 - ALSO TRUE - MOVE OTHERVAR (1 : VAR-LEN - 9) - TO VAR (16 - VAR-LEN : VAR-LEN - 9) - DISPLAY "A: Should NOT be executed" - WHEN TRUE - ALSO VAR-LEN < 16 - ALSO TRUE - MOVE OTHERVAR TO VAR - DISPLAY "A: OK VAR-LEN > 16 AND VAR-LEN < 200" - WHEN TRUE - ALSO VAR = SPACES - ALSO TRUE - MOVE OTHERVAR TO VAR - DISPLAY "A: OK VAR IS SPACES" - END-EVALUATE. - - MOVE "Peek a boo" TO VAR. - EVALUATE 3 EQUALS 7 - WHEN VAR = SPACES - DISPLAY "B: OK VAR IS NOT SPACES" - WHEN VAR NOT = SPACES - DISPLAY "B: FALSE VAR IS SPACES" - END-EVALUATE. - - MOVE SPACES TO VAR. - EVALUATE FALSE - WHEN VAR = SPACES - DISPLAY "C: FALSE VAR IS SPACES" - WHEN VAR NOT = SPACES - DISPLAY "C: OK VAR IS SPACES" - END-EVALUATE. - - MOVE "Peek a boo" TO VAR. - EVALUATE TRUE - WHEN VAR = SPACES - DISPLAY "D: BAD VAR IS SPACES" - WHEN VAR NOT = SPACES - DISPLAY "D: OK VAR IS NOT SPACES" - END-EVALUATE. - - MOVE SPACES TO VAR. - EVALUATE VAR-LEN ALSO VAR - WHEN < 32 ALSO SPACES - DISPLAY "E: OK VAR IS SPACES" - WHEN > 16 ALSO NOT SPACES - DISPLAY "E: BAD VAR IS NOT SPACES" - WHEN OTHER - DISPLAY "E: OK OTHER option taken" - END-EVALUATE. - - STOP RUN. -]) - -# Note: ideally this should not result in a difference compared to the next one - -AT_CHECK([$COMPILE_ONLY -C -fno-remove-unreachable prog.cob], [1], [], -[prog.cob: in paragraph 'MAIN-10': -prog.cob:17: warning: expression '115' GREATER THAN '16' is always TRUE -prog.cob:17: warning: expression '115' LESS THAN '200' is always TRUE -prog.cob:20: error: offset must be greater than zero -prog.cob:23: warning: expression '115' LESS THAN '16' is always FALSE -prog.cob:35: warning: expression '3' EQUALS '7' is always FALSE -prog.cob:60: warning: expression '115' LESS THAN '32' is always FALSE -prog.cob:62: warning: expression '115' GREATER THAN '16' is always TRUE -]) - -AT_CHECK([$COMPILE_ONLY -C prog.cob], [0], [], -[prog.cob: in paragraph 'MAIN-10': -prog.cob:17: warning: expression '115' GREATER THAN '16' is always TRUE -prog.cob:17: warning: expression '115' LESS THAN '200' is always TRUE -prog.cob:20: error (ignored): offset must be greater than zero -prog.cob:23: warning: expression '115' LESS THAN '16' is always FALSE -prog.cob:35: warning: expression '3' EQUALS '7' is always FALSE -prog.cob:60: warning: expression '115' LESS THAN '32' is always FALSE -prog.cob:62: warning: expression '115' GREATER THAN '16' is always TRUE -]) - -AT_CLEANUP - - -AT_SETUP([Missing imperative statements]) -AT_KEYWORDS([condition expression IF EVALUATE WHEN PERFORM]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 var PIC X(200). - 01 othervar PIC X(115). - 01 A PIC 9 VALUE 1. - 01 B PIC 9 VALUE 2. - 01 C PIC 9 VALUE 3. - 78 var-len value 115. - - PROCEDURE DIVISION. - - IF var-len < 16 - ELSE - move othervar to var - END-IF - - IF var-len > 16 - ELSE - move othervar to var - END-IF - - IF (2 = 3) - ELSE - IF 1 = 1 - ELSE - IF 1 = 1 - move var to othervar - END-IF - END-IF - . - - EVALUATE TRUE - WHEN A = B - move var to othervar - WHEN OTHER - END-EVALUATE - - PERFORM WITH TEST BEFORE UNTIL 1 <> 3 - END-PERFORM - - EVALUATE FALSE - WHEN A = B - WHEN B = A - END-EVALUATE. - - EVALUATE TRUE - WHEN A = B - move var to othervar - WHEN OTHER - . - - EVALUATE TRUE - WHEN A = B - WHEN B = A - . - - STOP RUN. -]) - -AT_CHECK([$COMPILE_ONLY -w -fmissing-statement=error prog.cob], [1], [], -[prog.cob:18: error: IF without imperative statement used -prog.cob:23: error: IF without imperative statement used -prog.cob:32: error: IF without imperative statement used -prog.cob:33: error: IF without imperative statement used -prog.cob:39: error: WHEN OTHER without imperative statement used -prog.cob:42: error: inline PERFORM without imperative statement used -prog.cob:47: error: WHEN without imperative statement used -prog.cob:53: error: WHEN OTHER without imperative statement used -prog.cob:58: error: WHEN without imperative statement used -]) - -AT_CHECK([$COMPILE_ONLY -fno-constant-folding -fmissing-statement=warning prog.cob], [0], [], -[prog.cob:18: warning: IF without imperative statement used -prog.cob:23: warning: IF without imperative statement used -prog.cob:32: warning: IF without imperative statement used -prog.cob:33: warning: IF without imperative statement used -prog.cob:39: warning: WHEN OTHER without imperative statement used -prog.cob:42: warning: inline PERFORM without imperative statement used -prog.cob:47: warning: WHEN without imperative statement used -prog.cob:53: warning: WHEN OTHER without imperative statement used -prog.cob:58: warning: WHEN without imperative statement used -]) - -AT_CLEANUP - - -AT_SETUP([Fall-Through to WHEN OTHER]) -AT_KEYWORDS([condition expression EVALUATE WHEN]) - -# we currently don't do the necessary parsing steps for -# this test to pass - and likely need a different option -# than frelax-syntax-checks.. - -AT_XFAIL_IF(true) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 A PIC 9 VALUE 1. - 01 B PIC 9 VALUE 2. - - PROCEDURE DIVISION. - - EVALUATE TRUE - WHEN A = B - WHEN OTHER - DISPLAY 'other' END-DISPLAY - END-EVALUATE - - STOP RUN. -]) - -AT_CHECK([$COMPILE_ONLY prog.cob], [1], [], -[prog.cob:12: error: fall-through to WHEN OTHER is not allowed -]) - -AT_CHECK([$COMPILE_ONLY -frelax-syntax-checks prog.cob], [1], [], -[prog.cob:12: warning: fall-through to WHEN OTHER -]) - -AT_CLEANUP - -AT_SETUP([CONSTANT LENGTH / BYTE-LENGTH]) -AT_KEYWORDS([misc]) - -AT_DATA([prog.cob], [ - identification division. - program-id. prog. - environment division. - data division. - working-storage section. - 01 item-01. - 05 item-05-a pointer. - 05 item-05-b pic x(01). - 01 myk-01 constant global as length of item-01. - 01 myk-02 constant is global as length item-05-a. - 01 myk-03 constant global as length of pointer. *> extension - 01 myk-04 constant global as byte-length of item-01. - 01 myk-05 constant is global as byte-length item-05-a. - 01 myk-06 constant global as byte-length of pointer. *> extension -]) - -AT_CHECK([$COMPILE_ONLY prog.cob], [0], [], []) -AT_CLEANUP - - -AT_SETUP([ANY LENGTH/NUMERIC with incorrect PIC]) -AT_KEYWORDS([misc]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - - DATA DIVISION. - LINKAGE SECTION. - *> Valid - 01 valid-1 PIC X ANY LENGTH. - 01 valid-2 PIC N ANY LENGTH. - 01 valid-3 PIC 9 ANY NUMERIC. - - *> Invalid - 01 invalid-1 PIC A ANY LENGTH. - 01 invalid-2 PIC Z ANY LENGTH. - 01 invalid-3 PIC 9 ANY LENGTH. - 01 invalid-4 PIC X ANY NUMERIC. - 01 invalid-5 PIC XX ANY LENGTH. - 01 invalid-6 PIC NN ANY LENGTH. -]) - -AT_CHECK([$COMPILE_ONLY prog.cob], [1], [], -[prog.cob:9: warning: handling of USAGE NATIONAL is unfinished; implementation is likely to be changed -prog.cob:18: warning: handling of USAGE NATIONAL is unfinished; implementation is likely to be changed -prog.cob:13: error: 'invalid-1' ANY LENGTH must be PIC X or PIC N -prog.cob:14: error: 'invalid-2' ANY LENGTH must be PIC X or PIC N -prog.cob:15: error: 'invalid-3' ANY LENGTH must be PIC X or PIC N -prog.cob:16: error: 'invalid-4' ANY NUMERIC must be PIC 9 -prog.cob:17: error: 'invalid-5' ANY LENGTH has invalid definition -prog.cob:18: error: 'invalid-6' ANY LENGTH has invalid definition -]) - -AT_CLEANUP - - -AT_SETUP([VOLATILE clause]) -AT_KEYWORDS([extensions]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 DATA-COLLECTION. - 03 DATA-ITEMS-A VOLATILE. - 05 DATA-A1 PIC S9(9) BINARY. - 05 DATA-A2 PIC S9(9) BINARY. - 03 VOLATILE. - 05 DATA-FILLER PIC S9(9) BINARY. - 03 DATA-ITEMS-B. - 05 DATA-B1 PIC S9(9). - 05 DATA-B2 PIC S9(9) VOLATILE. - 03 DATA-ITEMS-C. - 05 DATA-C1 PIC S9(9). - 05 DATA-C2 PIC S9(9). - 01 STEP PIC 9(8) BINARY VALUE 0 EXTERNAL VOLATILE. - *01 WRONGY PIC X. - * 88 TESTVAL-A VALUE 'A' VOLATILE. - * 88 TESTVAL-B VOLATILE VALUE 'B'. - LINKAGE SECTION. - 01 XMYREC. - 05 XFLD1 PIC 9(2) VOLATILE. - SCREEN SECTION. - *01 WRONG-SCREEN. - * 05 WRONG-FIELD PIC X VOLATILE. - * - PROCEDURE DIVISION. - MOVE DATA-ITEMS-B TO DATA-ITEMS-C. - STOP RUN. -]) - -AT_CHECK([$COMPILE_ONLY -Wno-unfinished prog.cob], [0], [], -[prog.cob:18: warning: initial VALUE clause ignored for EXTERNAL item 'STEP' -]) - -AT_CLEANUP - - -AT_SETUP([SET SOURCEFORMAT syntax checks]) -AT_KEYWORDS([misc extensions directives]) - -AT_DATA([prog.cob], [ - *> Valid - $set sourceformat(free) - $SET SOURCEFORMAT"FIXED" - *> Invalid - $SET SOURCEFORMAT"hi!" - $SET SOURCEFORMAT() - $SET sourceformat'mis-matched" -]) - -AT_CHECK([$COMPILE_ONLY prog.cob], [1], [], -[prog.cob:6: error: invalid SOURCEFORMAT directive option 'hi!' -prog.cob:7: error: invalid SOURCEFORMAT directive option '' -prog.cob:8: error: syntax error, unexpected Variable, expecting Literal -prog.cob:8: warning: alphanumeric literal has zero length; a SPACE will be assumed -prog.cob:8: error: PROGRAM-ID header missing -prog.cob:8: error: PROCEDURE DIVISION header missing -prog.cob:8: error: syntax error, unexpected Literal -]) -AT_CLEANUP - - -# normal register extension, -# active for lax and standard configurations -AT_SETUP([WHEN-COMPILED register in dialect]) -AT_KEYWORDS([misc extensions]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - - PROCEDURE DIVISION. - DISPLAY WHEN-COMPILED - . -]) - -AT_CHECK([$COMPILE_ONLY -std=cobol2014 prog.cob], [1], [], -[prog.cob:6: error: 'WHEN-COMPILED' is not defined -]) -AT_CHECK([$COMPILE_ONLY -std=ibm prog.cob], [0], [], []) -AT_CHECK([$COMPILE_ONLY -std=mvs prog.cob], [0], [], []) -AT_CHECK([$COMPILE_ONLY -std=rm prog.cob], [0], [], []) -AT_CHECK([$COMPILE_ONLY -fregister=WHEN-COMPILED prog.cob], [0], [], []) -AT_CHECK([$COMPILE_ONLY -freserved=WHEN-COMPILED -fregister=WHEN-COMPILED prog.cob], [0], [], []) -AT_CLEANUP - - - -# rare/conflicting register extension, -# active only if explicit requested -AT_SETUP([LIN / COL register]) -AT_KEYWORDS([misc extensions]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - - PROCEDURE DIVISION. - MOVE 1 TO LIN, COL - . -]) - -# "strict" configuration: -AT_CHECK([$COMPILE_ONLY -std=cobol2014 prog.cob], [1], [], -[prog.cob:6: error: 'LIN' is not defined -prog.cob:6: error: syntax error, unexpected COL -]) -# "lax" configuration: -AT_CHECK([$COMPILE_ONLY -std=acu prog.cob], [1], [], -[prog.cob:6: error: 'LIN' is not defined -prog.cob:6: error: syntax error, unexpected COL -]) -# standard configuration: -AT_CHECK([$COMPILE_ONLY prog.cob], [1], [], -[prog.cob:6: error: 'LIN' is not defined -prog.cob:6: error: syntax error, unexpected COL -]) -# explicit enabled -AT_CHECK([$COMPILE_ONLY -fregister=LIN,COL prog.cob], [0], [], []) -AT_CLEANUP - - -AT_SETUP([tokens consisting of multiple words]) -# note: we actually do not check for all possible cases, but two are better than none... -AT_KEYWORDS([misc]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 test-var pic xx. - 88 endOfFile value '10'. - 01 todo pic xx. - - PROCEDURE DIVISION. - if not endOfFile - display 'all fine' - end-if - if test-var greater or equal todo - display 'still fine' - end-if - . -]) - -AT_CHECK([$COMPILE_ONLY prog.cob], [0], [], []) -AT_CLEANUP - - -AT_SETUP([zero-length literals]) -AT_KEYWORDS([misc]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 x PIC X. - 01 nat PIC N. - 01 n PIC 9. - - PROCEDURE DIVISION. - MOVE X'' TO x - MOVE H'' TO x - MOVE Z'' TO x - MOVE L'' TO x - MOVE N"" TO nat - MOVE NX'' TO nat - MOVE B"" TO n - MOVE BX"" TO n - . -]) - -AT_CHECK([$COMPILE_ONLY prog.cob], [1], [], -[prog.cob:8: warning: handling of USAGE NATIONAL is unfinished; implementation is likely to be changed -prog.cob:12: warning: hexadecimal literal has zero length; X'00' will be assumed -prog.cob:13: error: H literals must contain at least one character -prog.cob:14: error: invalid Z literal: '' -prog.cob:14: error: Z literals must contain at least one character -prog.cob:15: error: invalid L literal: '' -prog.cob:15: error: L literals must contain at least one character -prog.cob:16: warning: national literal has zero length; a SPACE will be assumed -prog.cob:16: warning: handling of national literal is unfinished; implementation is likely to be changed -prog.cob:17: warning: hexadecimal literal has zero length; X'00' will be assumed -prog.cob:18: warning: Boolean literal has zero length; B'0' will be assumed -prog.cob:19: warning: hexadecimal literal has zero length; X'00' will be assumed -]) -AT_CHECK([$COMPILE_ONLY -fzero-length-literals=error prog.cob], [1], [], -[prog.cob:8: warning: handling of USAGE NATIONAL is unfinished; implementation is likely to be changed -prog.cob:12: error: zero-length literal used -prog.cob:12: warning: hexadecimal literal has zero length; X'00' will be assumed -prog.cob:13: error: H literals must contain at least one character -prog.cob:14: error: invalid Z literal: '' -prog.cob:14: error: Z literals must contain at least one character -prog.cob:15: error: invalid L literal: '' -prog.cob:15: error: L literals must contain at least one character -prog.cob:16: error: zero-length literal used -prog.cob:16: warning: national literal has zero length; a SPACE will be assumed -prog.cob:16: warning: handling of national literal is unfinished; implementation is likely to be changed -prog.cob:17: error: zero-length literal used -prog.cob:17: warning: hexadecimal literal has zero length; X'00' will be assumed -prog.cob:18: error: zero-length literal used -prog.cob:18: warning: Boolean literal has zero length; B'0' will be assumed -prog.cob:19: error: zero-length literal used -prog.cob:19: warning: hexadecimal literal has zero length; X'00' will be assumed -]) -AT_CLEANUP - - -AT_SETUP([@OPTIONS parsing]) -AT_KEYWORDS([misc OPTIONS]) - -# GnuCOBOL currently only skips these, see FR 305 - -AT_DATA([valid.cob], [ -000100 @OPTIONS NOMAIN,APOST -000200 IDENTIFICATION DIVISION. -000300 PROGRAM-ID. VALID. -]) - -AT_CHECK([$COMPILE_ONLY valid.cob], [0], [], -[valid.cob:3: warning: ignoring unknown directive: '@OPTIONS' -]) - -#AT_DATA([invalid.cob], [ -# @OPTIONS ALPHAL(WORD) -# @OPTIONS INITVALUE(100) -# @OPTIONS INITVALUE(F) -# @OPTIONS INITVALUE(AG) -# @OPTIONS BINARY(WORD,MLBON) INITVALUE(00) NOTRUNC -# @OPTIONS INITVALUE(00) -# @OPTIONS NOTRUNC -# @OPTIONS APOST,MAIN -# @OPTIONS THREAD(SINGLE) -# IDENTIFICATION DIVISION. -# PROGRAM-ID. INVALID. -#]) - -#AT_CHECK([$COMPILE_ONLY valid.cob], [0], [], []) -#AT_CHECK([$COMPILE_ONLY invalid.cob], [1], [], -#[invalid.cob:2: warning: unknown @OPTIONS directive 'ALPHAL' -#invalid.cob:3: error: invalid @OPTIONS INITVALUE value '100' -#invalid.cob:4: error: invalid @OPTIONS INITVALUE value 'F' -#invalid.cob:5: error: invalid @OPTIONS INITVALUE value 'AG' -#invalid.cob:6: warning: skipping line after first space -#invalid.cob:7: error: @OPTIONS MAIN conflicts with command line option '-m' -#]) - -AT_CLEANUP - - -AT_SETUP([system routines with wrong number of parameters]) -AT_KEYWORDS([misc CALL 91 C$TOUPPER CBL_GC_FORK]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 VAR1 PIC 9. - 01 VAR2 PIC 9. - 01 VAR3 PIC 9. - 01 VAR4 PIC 9. - PROCEDURE DIVISION. - CALL X"91" USING VAR1 VAR2 VAR3 VAR4. - CALL X"91" USING VAR1. - CALL "C$TOUPPER" USING VAR1 VAR2 VAR3. - CALL "CBL_GC_FORK" USING VAR1. -]) - -AT_CHECK([$COMPILE_ONLY prog.cob], [1], [], -[prog.cob:11: warning: wrong number of CALL parameters for 'X"91"', 4 given, 3 expected -prog.cob:12: error: wrong number of CALL parameters for 'X"91"', 1 given, 3 expected -prog.cob:13: warning: wrong number of CALL parameters for 'C$TOUPPER', 3 given, 2 expected -prog.cob:14: warning: wrong number of CALL parameters for 'CBL_GC_FORK', 1 given, 0 expected -]) - -AT_CLEANUP - - -AT_SETUP([invalid use of condition-name]) -AT_KEYWORDS([misc MOVE STRING UNSTRING COMPUTE]) -# see Bug #543 "level 88 item not checked in all places for STRING" -# and FR #339 -# Note: we actually check much more here, for example special data types -# like HANDLE, see "ACUCOBOL USAGE HANDLE"; -# condition-name is also checked in syn_file.at "WRITE / REWRITE FROM clause" - -AT_DATA([prog.cob], [ - identification division. - program-id. prog. - data division. - working-storage section. - 77 p usage pointer. - 01 val pic x(10). - 88 val-i1 value 'some'. - 88 val-i2 value 'val'. - 77 val2 pic x(50). - 77 target pic x(50). - 01 vnum pic 9. - 88 vnum-1 value 1. - 88 vnum-2 values 2 thru 5. - 88 vnum-9 value 9. - 01 filler. - 02 tentry pic x occurs 0 to 6 depending on vnum-1. - procedure division. - string val-i1 delimited by size into target - string val2 delimited by val-i2 into target - string val2 delimited by size into val-i1 - with pointer val-i2 - unstring val-i1 into target - unstring val2 delimited by val-i1 into target - unstring val2 into val-i1 - with pointer val-i2 - move val-i1 - to val-i2, tentry (vnum-9) - compute vnum-1 = vnum - compute vnum = vnum-1 / - vnum-2 - go to val-i1 - set p to val-i1 - set p to address of val-i2. -]) - -AT_CHECK([$COMPILE_ONLY prog.cob], [1], [], -[prog.cob:17: error: condition-name not allowed here: 'vnum-1' -prog.cob:19: error: condition-name not allowed here: 'val-i1' -prog.cob:20: error: condition-name not allowed here: 'val-i2' -prog.cob:21: error: condition-name not allowed here: 'val-i1' -prog.cob:23: error: condition-name not allowed here: 'val-i1' -prog.cob:24: error: condition-name not allowed here: 'val-i1' -prog.cob:25: error: condition-name not allowed here: 'val-i1' -prog.cob:28: error: condition-name not allowed here: 'vnum-9' -prog.cob:27: error: condition-name not allowed here: 'val-i1' -prog.cob:29: error: condition-name not allowed here: 'vnum-1' -prog.cob:30: error: condition-name not allowed here: 'vnum-1' -prog.cob:31: error: condition-name not allowed here: 'vnum-2' -prog.cob:33: error: condition-name not allowed here: 'val-i1' -prog.cob:34: error: condition-name not allowed here: 'val-i2' -prog.cob:32: error: 'val-i1 (MAIN SECTION:)' is not a procedure name -]) -AT_CLEANUP - - -AT_SETUP([XML GENERATE syntax checks]) -AT_KEYWORDS([extensions]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 str. - 03 str-1 PIC XX. - 03 str-2 PIC X. - 66 renames-item RENAMES str-1 THRU str-2. - 01 bool-area. - 03 bool-item PIC 1(30) USAGE BIT. - 03 zoned-decimal PIC 99V99 PACKED-DECIMAL. - 01 just-item PIC X(30) JUST. - 01 table-area. - 03 table-entry PIC X(30) OCCURS 2 TIMES. - 01 long-str PIC X(200). - - 01 float-item FLOAT-SHORT. - 01 pic-p-item PIC 99P(3). - - 01 rec. - 03 child-1 PIC X(30). - 03 child-1a REDEFINES child-1 PIC 9(30). - 03 child-2 PIC X(30). - 03 child-3. - 05 child-3-1 PIC X OCCURS 5 TIMES. - - 01 all-filler-rec. - 03 FILLER PIC XXXX. - 03 FILLER PIC 9999. - - 01 invalid-sub-elt-rec. - 03 non-unique-name PIC X. - 03 valid-sub-rec. - 05 non-unique-name PIC X. - 03 bit-item PIC 1 USAGE BIT. - 03 ptr-item USAGE POINTER. - - 01 with-attrs-does-nothing. - 03 FILLER PIC X. - 03 table-elt PIC X OCCURS 2 TIMES. - 03 with-attrs-group. - 05 with-attrs-group-child PIC X. - 03 with-attrs-child PIC X. - - PROCEDURE DIVISION. - *> Receiving area is not alphanumeric or national. - XML GENERATE bool-item FROM str - *> Receiving area is JUSTIFIED RIGHT. - XML GENERATE just-item FROM str - *> Receiving area is subscripted or ref-mod'd. - XML GENERATE table-entry (1) FROM str - XML GENERATE long-str (1:100) FROM str - - *> Input record cannot be function identifier. - XML GENERATE long-str FROM FUNCTION CHAR(4) - *> Input record cannot be ref-mod'd. - XML GENERATE long-str FROM str (2:1) - *> " " is not RENAMES (children may be RENAMES). - XML GENERATE long-str FROM renames-item - *> Non-ignored items of the input record must: - *> * alphabetic, alphanumeric, national, numeric or index. - *> * there must be at least one item. - *> * each non-FILLER name must be unique within the input record. - XML GENERATE long-str FROM invalid-sub-elt-rec *> XXXXXXXXX ptr element is invalid - XML GENERATE long-str FROM all-filler-rec - - *> COUNT IN field must be an integer. - XML GENERATE long-str FROM str COUNT float-item - *> COUNT IN field must not have P in PIC. - XML GENERATE long-str FROM str COUNT pic-p-item - - *> ENCODING codepage must be unsigned integer. - *> If receiving area is national, codepage must be 1200. - *> " " " alphanumeric, codepage must be 1208 or EBCDIC - *> page supported with XML. - - *> WITH ATTRIBUTES, generated immediate children must be - *> * elementary - *> * be non-FILLER - *> * not be OCCURS - *> * not be subject of a TYPE phrase. - XML GENERATE long-str FROM with-attrs-does-nothing - WITH ATTRIBUTES - TYPE OF with-attrs-child IS ELEMENT - - *> NAMESPACE must be a valid URI. - XML GENERATE long-str FROM str NAMESPACE "<>" - *> NAMESPACE and -PREFIX must be alphanumeric or national. - XML GENERATE long-str FROM str - NAMESPACE bool-item NAMESPACE-PREFIX bool-item - *> " " " may not be figurative constants. - XML GENERATE long-str FROM str - NAMESPACE SPACES NAMESPACE-PREFIX QUOTES - *> NAMESPACE-PREFIX must be a valid XML name. - XML GENERATE long-str FROM str - NAMESPACE "http://www.w3.org/xml" NAMESPACE-PREFIX X"00" - - *> NAME items must reference input record or its children. - XML GENERATE long-str FROM rec - NAME OF child-1 IS "c1", long-str IS "c2", rec IS "r" - *> NAME items cannot be reference modified or subscripted. - XML GENERATE long-str FROM rec - NAME OF child-1 (1:2) IS "c1" - *> NAME items may not be ignored by the statement. - XML GENERATE long-str FROM rec - NAME OF child-1a IS "c1a" - *> NAME literals must be valid XML names. - XML GENERATE long-str FROM rec - NAME OF child-1 IS X"00" - - *> TYPE items must be elementary and children of input record. - XML GENERATE long-str FROM rec - TYPE OF child-3 IS ELEMENT, long-str IS CONTENT, - rec IS CONTENT - *> TYPE items cannot be ref-mod'd or subscripted. - XML GENERATE long-str FROM rec - TYPE OF child-1 (1:3) IS ATTRIBUTE, - child-3-1 (1) IS CONTENT - *> TYPE items may not be ignored by the statement - XML GENERATE long-str FROM rec - TYPE OF child-1a IS ELEMENT - *> TYPE ATTRIBUTE items must satisfy the conditions for WITH - *> ATTRIBUTES. (Covered by the above.) - - *> SUPPRESS WHEN items must be: - *> * elementary - *> * not ignored - *> * child of input record. - XML GENERATE long-str FROM rec - SUPPRESS child-3 WHEN SPACES, child-1a WHEN SPACES, - rec WHEN SPACES - *> All SUPPRESS items must not be functions - XML GENERATE long-str FROM rec - SUPPRESS FUNCTION CHAR(5) WHEN SPACE - *> All SUPPRESS items must not be ref-mod'd or subscripted. - XML GENERATE long-str FROM rec - SUPPRESS child-1 (1:3) WHEN ZERO, - child-3-1 (1) WHEN SPACES - *> If non-WHEN SUPPRESS items may be groups. (No error message here.) - XML GENERATE long-str FROM rec SUPPRESS child-3 - *> If SUPPRESS WHEN ZEROES, item is not DISPLAY-1. - *> If SUPPRESS WHEN SPACES, item must be USAGE DISPLAY, DISPLAY-1 or - *> NATIONAL - XML GENERATE long-str FROM bool-area - SUPPRESS bool-item WHEN SPACES - *> If SUPPRESS WHEN LOW-/HIGH-VALUES, item must be USAGE DISPLAY or - *> NATIONAL. If item is a zoned/national decimal item, it must be - *> an integer. - XML GENERATE long-str FROM bool-area - SUPPRESS bool-item WHEN LOW-VALUES, - zoned-decimal WHEN HIGH-VALUE - *> (For generic WHEN phrases, invalid items above are ignored.) - GOBACK. -]) - -AT_CHECK([$COMPILE_ONLY prog.cob], [1], [], -[prog.cob:12: warning: USAGE BIT is not implemented -prog.cob:37: warning: USAGE BIT is not implemented -prog.cob:49: error: JSON/XML GENERATE receiving item must be alphanumeric or national -prog.cob:51: error: JSON/XML GENERATE receiving item may not have JUSTIFIED clause -prog.cob:53: error: JSON/XML GENERATE receiving item may not be subscripted -prog.cob:54: error: JSON/XML GENERATE receiving item may not be reference modified -prog.cob:57: error: syntax error, unexpected intrinsic function name, expecting Identifier -prog.cob:59: error: JSON/XML GENERATE input record may not be reference modified -prog.cob:61: error: JSON/XML GENERATE input record may not have RENAMES clause -prog.cob:66: error: JSON/XML GENERATE input record has subrecords with non-unique names -prog.cob:67: error: all the children of 'all-filler-rec' are ignored in JSON/XML GENERATE -prog.cob:70: error: COUNT IN item must be numeric and an integer -prog.cob:72: error: COUNT IN item may not have PICTURE with P in it -prog.cob:89: warning: OCCURS items in JSON/XML GENERATE is not implemented -prog.cob:89: warning: WITH ATTRIBUTES specified, but no attributes can be generated -prog.cob:89: error: NAMESPACE must be a valid URI -prog.cob:92: error: NAMESPACE must be alphanumeric or national -prog.cob:92: error: NAMESPACE-PREFIX must be alphanumeric or national -prog.cob:97: error: NAMESPACE may not be a figurative constant -prog.cob:97: error: NAMESPACE-PREFIX may not be a figurative constant -prog.cob:98: error: NAMESPACE-PREFIX must be a valid XML name -prog.cob:104: warning: OCCURS items in JSON/XML GENERATE is not implemented -prog.cob:102: error: NAME OF item must be the input record or a child of it -prog.cob:107: warning: OCCURS items in JSON/XML GENERATE is not implemented -prog.cob:105: error: NAME OF item may not be reference modified -prog.cob:110: warning: OCCURS items in JSON/XML GENERATE is not implemented -prog.cob:108: error: NAME OF item may not be an ignored item in JSON/XML GENERATE -prog.cob:114: warning: OCCURS items in JSON/XML GENERATE is not implemented -prog.cob:111: error: NAME OF name must be a valid XML name -prog.cob:118: warning: OCCURS items in JSON/XML GENERATE is not implemented -prog.cob:115: error: TYPE OF item must be elementary -prog.cob:115: error: TYPE OF item must be a child of the input record -prog.cob:116: error: TYPE OF item must be elementary -prog.cob:116: error: TYPE OF item must be a child of the input record -prog.cob:122: warning: OCCURS items in JSON/XML GENERATE is not implemented -prog.cob:119: error: TYPE OF item may not be reference modified -prog.cob:120: error: TYPE OF item may not be subscripted -prog.cob:131: warning: OCCURS items in JSON/XML GENERATE is not implemented -prog.cob:123: error: TYPE OF item may not be an ignored item in JSON/XML GENERATE -prog.cob:135: warning: OCCURS items in JSON/XML GENERATE is not implemented -prog.cob:133: error: SUPPRESS item with WHEN clause must be elementary -prog.cob:133: error: SUPPRESS item must be a child of the input record -prog.cob:132: error: SUPPRESS item may not be an ignored item in JSON/XML GENERATE -prog.cob:132: error: SUPPRESS item with WHEN clause must be elementary -prog.cob:136: error: syntax error, unexpected intrinsic function name, expecting EVERY or WHEN or Identifier -prog.cob:142: warning: OCCURS items in JSON/XML GENERATE is not implemented -prog.cob:140: error: SUPPRESS item may not be subscripted -prog.cob:139: error: SUPPRESS item may not be reference modified -prog.cob:146: warning: OCCURS items in JSON/XML GENERATE is not implemented -prog.cob:147: error: SUPPRESS WHEN SPACE item must be USAGE DISPLAY or NATIONAL -prog.cob:153: error: SUPPRESS WHEN HIGH-VALUE item must be USAGE DISPLAY or NATIONAL -prog.cob:153: error: SUPPRESS WHEN HIGH-VALUE item must be an integer -prog.cob:152: error: SUPPRESS WHEN LOW-VALUE item must be USAGE DISPLAY or NATIONAL -]) -AT_CLEANUP - - -AT_SETUP([IBM Data Division]) -AT_KEYWORDS([78 LENGTH]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - CONFIGURATION SECTION. - DATA DIVISION. - WORKING-STORAGE SECTION. - - 01 DATA-SIZE PIC 999. - 01 MY-DATA. - 03 MY-TABLE OCCURS 20 TIMES. - 05 MY-ELEMENT-1 PIC X(10). - 05 MY-ELEMENT-2 PIC 99. - 78 MY-LEN VALUE LENGTH OF MY-DATA. - - 01 TBLX PIC 99 VALUE 5. - 01 ODO-DATA. - 03 ODO-TABLE OCCURS 1 TO 15 TIMES DEPENDING ON TBLX. - 05 ODO-ELEMENT-1 PIC X(10). - 05 ODO-ELEMENT-2 PIC 99. - 78 ODO-LEN VALUE LENGTH OF ODO-DATA. - - PROCEDURE DIVISION. - DISPLAY "MY-LEN is " MY-LEN. - DISPLAY "ODO-LEN is " ODO-LEN. - MOVE LENGTH OF MY-DATA TO DATA-SIZE. - DISPLAY "MY-DATA is " FUNCTION LENGTH (MY-DATA) - " and " DATA-SIZE. - MOVE LENGTH OF MY-ELEMENT-1 TO DATA-SIZE. - DISPLAY "MY-ELEMENT-1 is " FUNCTION LENGTH (MY-ELEMENT-1) - " and " DATA-SIZE. - MOVE LENGTH OF MY-TABLE TO DATA-SIZE. - DISPLAY "MY-TABLE is " LENGTH OF MY-TABLE - " and " DATA-SIZE. - MOVE LENGTH OF MY-TABLE(1) TO DATA-SIZE. - DISPLAY "MY-TABLE(1) is " FUNCTION LENGTH (MY-TABLE(1)) - " and " DATA-SIZE. - - MOVE LENGTH OF ODO-DATA TO DATA-SIZE. - DISPLAY "ODO-DATA a is " FUNCTION LENGTH (ODO-DATA) - " and " DATA-SIZE. - MOVE FUNCTION LENGTH (ODO-DATA) TO DATA-SIZE. - DISPLAY "ODO-DATA b is " LENGTH OF ODO-DATA - " and " DATA-SIZE. - MOVE LENGTH OF ODO-TABLE TO DATA-SIZE. - DISPLAY "ODO-TABLE is " LENGTH OF ODO-TABLE - " and " DATA-SIZE. - MOVE LENGTH OF ODO-TABLE(1) TO DATA-SIZE. - DISPLAY "ODO-TABLE(1) is " FUNCTION LENGTH (ODO-TABLE(1)) - " and " DATA-SIZE. - STOP RUN. -]) - -AT_CHECK([$COMPILE_ONLY -std=ibm prog.cob], [1], [], -[prog.cob:21: error: variable length item not allowed here -prog.cob:21: error: constant item 'ODO-LEN' requires a VALUE clause -prog.cob:30: warning: subscript missing for 'MY-ELEMENT-1' - defaulting to 1 -]) - -AT_CHECK([$COMPILE_ONLY -std=ibm-strict prog.cob], [1], [], -[prog.cob:14: error: LENGTH OF 'MY-DATA' not allowed outside of Procedure Division -prog.cob:14: error: 78 VALUE does not conform to IBM COBOL -prog.cob:14: error: constant item 'MY-LEN' requires a VALUE clause -prog.cob:21: error: LENGTH OF 'ODO-DATA' not allowed outside of Procedure Division -prog.cob:21: error: 78 VALUE does not conform to IBM COBOL -prog.cob:21: error: constant item 'ODO-LEN' requires a VALUE clause -prog.cob:30: error: 'MY-ELEMENT-1' requires one subscript -]) - -AT_CHECK([$COMPILE_ONLY prog.cob], [1], [], -[prog.cob:21: error: variable length item not allowed here -prog.cob:21: error: constant item 'ODO-LEN' requires a VALUE clause -prog.cob:30: error: 'MY-ELEMENT-1' requires one subscript -]) - -AT_CLEANUP - - -AT_SETUP([BASED clause, ALLOCATE / FREE statements]) -AT_KEYWORDS([BASED]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 str. - 03 str-1 PIC XX BASED. - 01 str-2 BASED. - 03 str-2a PIC X SYNC. - 03 str-2b PIC 9. - 01 one PIC XX BASED. - 77 seven PIC 9 BASED. - 77 var PIC 9. - 77 ptr USAGE POINTER. - SCREEN-STORAGE SECTION. - 01 scrn BASED. - 03 scrn-field pic x. - - PROCEDURE DIVISION. - ALLOCATE one - ALLOCATE seven INITIALIZED - ALLOCATE seven CHARACTERS. - ALLOCATE seven CHARACTERS RETURNING ptr. - ALLOCATE 1 + 2 * 3 CHARACTERS RETURNING ptr. - ALLOCATE 1 + one * 3 CHARACTERS RETURNING ptr. - ALLOCATE one CHARACTERS RETURNING ptr. - ALLOCATE seven CHARACTERS INITIALIZED RETURNING ptr. - ALLOCATE var - FREE var - FREE ADDRESS OF var - FREE one - FREE ADDRESS OF seven - MOVE ADDRESS OF seven TO ptr - FREE ptr - GOBACK. -]) - -AT_CHECK([$COMPILE_ONLY prog.cob], [1], [], -[prog.cob:8: error: BASED only allowed at 01/77 level -prog.cob:16: error: PROCEDURE DIVISION header missing -prog.cob:16: error: syntax error, unexpected Identifier -prog.cob:17: error: unknown statement '01' -prog.cob:18: error: unknown statement '03' -prog.cob:20: error: syntax error, unexpected PROCEDURE -prog.cob:23: error: ALLOCATE CHARACTERS requires RETURNING clause -prog.cob:26: error: 'one' is not a numeric value -prog.cob:27: error: amount must be specified as a numeric expression -prog.cob:29: error: target of ALLOCATE is not a BASED item -prog.cob:30: error: target 1 of FREE is not a BASED data item -prog.cob:31: error: target 1 of FREE is not a BASED data item -]) -AT_CLEANUP - - -AT_SETUP([CONTINUE statement]) -AT_KEYWORDS([BASED]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 one PIC X. - 77 seven PIC 9 BASED. - 77 var PIC 9. - 77 ptr USAGE POINTER. - PROCEDURE DIVISION. - CONTINUE - PERFORM VARYING var FROM 1 BY 1 UNTIL var = 4 - CONTINUE - END-PERFORM - CONTINUE AFTER 42 SECONDS *> COBOL 202x - CONTINUE AFTER 4 + 2 SECONDS - CONTINUE AFTER var + 2 SECONDS - CONTINUE AFTER '1' SECONDS - CONTINUE AFTER ptr SECONDS - CONTINUE AFTER one SECONDS - . -]) - -AT_CHECK([$COMPILE_ONLY prog.cob], [1], [], -[prog.cob:19: error: amount must be specified as a numeric expression -prog.cob:20: error: amount must be specified as a numeric expression -prog.cob:21: error: amount must be specified as a numeric expression -]) - -AT_CHECK([$COMPILE_ONLY -std=cobol2014 prog.cob], [1], [], -[prog.cob:16: error: AFTER phrase in CONTINUE statement does not conform to COBOL 2014 -prog.cob:17: error: AFTER phrase in CONTINUE statement does not conform to COBOL 2014 -prog.cob:18: error: AFTER phrase in CONTINUE statement does not conform to COBOL 2014 -prog.cob:19: error: AFTER phrase in CONTINUE statement does not conform to COBOL 2014 -prog.cob:20: error: AFTER phrase in CONTINUE statement does not conform to COBOL 2014 -prog.cob:21: error: AFTER phrase in CONTINUE statement does not conform to COBOL 2014 -]) -AT_CLEANUP - - -AT_SETUP([conflict markers]) -AT_KEYWORDS([]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - - DATA DIVISION. - WORKING-STORAGE SECTION. - *> Verify that we report conflict markers correctly -<<<<<<< HEAD - 01 one-1 PIC X. -======= there may be something here - 01 one-2 PIC X. ->>>>>>> some note - *> Verify that we don't have an issue with unmatched conflict markers - 77 var PIC 9. -<<<<<<< HEAD - 01 var2 PIC X. -======= -<<<<<<< HEAD - *> Verify that we only report conflict markers at the start of lines. - <<<<<<< HEAD - 01 one PIC X. - ======= - 01 two PIC 9. - >>>>>>> some note - PROCEDURE DIVISION. - GOBACK. -]) - -AT_CHECK([$COMPILE_ONLY prog.cob], [1], [], -[prog.cob:8: error: version control conflict marker in file -prog.cob:10: error: version control conflict marker in file -prog.cob:12: error: version control conflict marker in file -prog.cob:15: error: version control conflict marker in file -prog.cob:17: error: version control conflict marker in file -prog.cob:18: error: version control conflict marker in file -prog.cob:20: error: invalid indicator '<' at column 7 -prog.cob:22: error: invalid indicator '=' at column 7 -prog.cob:24: warning: ignoring invalid directive: '>> some' -]) - -AT_CHECK([$COMPILE_ONLY -free prog.cob], [1], [], -[prog.cob:8: error: version control conflict marker in file -prog.cob:10: error: version control conflict marker in file -prog.cob:12: error: version control conflict marker in file -prog.cob:15: error: version control conflict marker in file -prog.cob:17: error: version control conflict marker in file -prog.cob:18: error: version control conflict marker in file -prog.cob:24: warning: ignoring invalid directive -prog.cob:20: error: PROCEDURE DIVISION header missing -prog.cob:20: error: syntax error, unexpected < -prog.cob:22: error: syntax error, unexpected = -prog.cob:25: error: syntax error, unexpected PROCEDURE -]) -AT_CLEANUP - - -AT_SETUP([SORT syntax]) -AT_KEYWORDS([misc fundamental KEY]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - - ENVIRONMENT DIVISION. - INPUT-OUTPUT SECTION. - FILE-CONTROL. - SELECT SRTFIL ASSIGN TO "SRTFIL" - ORGANIZATION LINE SEQUENTIAL. - SELECT STFILE ASSIGN TO "STFILE" - ORGANIZATION LINE SEQUENTIAL. - - DATA DIVISION. - FILE SECTION. - FD SRTFIL. - 01 SRTREC PIC X(256). - SD STFILE. - 01 STFREC PIC X(256). - - WORKING-STORAGE SECTION. - 01 G VALUE "d4b2e1a3c5". - 02 TBL OCCURS 5. - 03 X PIC X. - 03 Y PIC 9. - 02 TBL-ORD OCCURS 5 ASCENDING YO. - 03 XO PIC X. - 03 YO PIC 9. - - PROCEDURE DIVISION. - SORT TBL ASCENDING KEY X. - SORT TBL DESCENDING. - SORT TBL. - SORT TBL-ORD ASCENDING. - SORT TBL-ORD. - SORT STFILE DESCENDING KEY SRTREC. - SORT STFILE DESCENDING KEY SRTREC USING SRTFIL GIVING SRTFIL. - SORT STFILE ASCENDING. - SORT STFILE. - STOP RUN. -]) - -AT_CHECK([$COMPILE_ONLY prog.cob], [1], [], -[prog.cob:32: error: table SORT requires KEY phrase -prog.cob:35: error: file sort requires USING or INPUT PROCEDURE -prog.cob:35: error: file sort requires GIVING or OUTPUT PROCEDURE -prog.cob:37: error: file sort requires KEY phrase -prog.cob:38: error: file sort requires KEY phrase -]) -AT_CLEANUP - - -AT_SETUP([Group Usage Error]) -AT_KEYWORDS([numeric]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - CONFIGURATION SECTION. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 TESTRECORD. - 02 TSTGRP3 COMP-3. - 05 GRP3-1. - 10 FILLER PICTURE X(1). - 10 COM3-FLD1 PICTURE S9(4) COMP-4. - 10 FILLER PICTURE X(1). - 10 COM3-FLD2 PICTURE S9(6). - 10 FILLER PICTURE X(1). - 10 COM3-FLD3 PICTURE S9(6) DISPLAY. - 10 FILLER PICTURE X(1). - 05 GRP3-2. - 10 FILLER USAGE COMP-1. - - PROCEDURE DIVISION. - - MOVE ALL 'x' TO TESTRECORD. - MOVE "12345678" TO COM3-FLD1 (1:). - MOVE "12345678" TO COM3-FLD2 (1:). - DISPLAY TESTRECORD. - STOP RUN. - - -]) - -AT_CHECK([$COMPILE_ONLY -std=mf -Wno-truncate prog.cob], [1], [], -[prog.cob:12: error: TSTGRP3 USAGE COMP-3 incompatible with COM3-FLD1 USAGE COMP -prog.cob:16: error: TSTGRP3 USAGE COMP-3 incompatible with COM3-FLD3 USAGE DISPLAY -prog.cob:19: error: TSTGRP3 USAGE COMP-3 incompatible with FILLER USAGE COMP-1 -]) - -AT_CLEANUP - -AT_SETUP([OSVS I/O extensions]) -AT_KEYWORDS([ibm file extensions]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - - ENVIRONMENT DIVISION. - INPUT-OUTPUT SECTION. - FILE-CONTROL. - SELECT f ASSIGN "f.dat" SEQUENTIAL - FILE-LIMITS ARE 1 THRU 10, 100 THRU f-max - TRACK-AREA 100 CHARACTERS - TRACK-LIMIT 5 TRACKS. - SELECT g ASSIGN "g.dat" RELATIVE - RELATIVE KEY g-key - ACTUAL KEY g-actual-key. - - I-O-CONTROL. - APPLY RECORD-OVERFLOW f, g - APPLY CORE-INDEX core-idx ON f - APPLY CYL-INDEX TO 5 ON f - APPLY CYL-OVERFLOW 10 TRACKS f - APPLY EXTENDED-SEARCH g - APPLY MASTER-INDEX TO 5 on g - APPLY WRITE-VERIFY f, g - APPLY REORG-CRITERIA f-rec, f - RERUN ON "g2.dat" EVERY END REEL g - . - DATA DIVISION. - FILE SECTION. - FD f. - 01 f-rec PIC X(100). - - FD g. - 01 g-rec PIC 9(10). - - WORKING-STORAGE SECTION. - 01 core-idx PIC 999. - 01 f-max PIC 9(5) VALUE 1000. - 01 g-key PIC 999. - 01 g-actual-key PIC XXX. - - PROCEDURE DIVISION. - OPEN INPUT f DISP, INPUT g REREAD - . -]) - -AT_CHECK([$COMPILE_ONLY prog.cob], [0], [], -[prog.cob:10: warning: FILE-LIMIT is obsolete in GnuCOBOL -prog.cob:10: warning: TRACK-AREA is obsolete in GnuCOBOL -prog.cob:11: warning: TRACK-LIMIT is obsolete in GnuCOBOL -prog.cob:14: warning: ACTUAL KEY is obsolete in GnuCOBOL -prog.cob:18: warning: DOS/VS APPLY phrase is obsolete in GnuCOBOL -prog.cob:19: warning: DOS/VS APPLY phrase is obsolete in GnuCOBOL -prog.cob:20: warning: DOS/VS APPLY phrase is obsolete in GnuCOBOL -prog.cob:21: warning: DOS/VS APPLY phrase is obsolete in GnuCOBOL -prog.cob:22: warning: DOS/VS APPLY phrase is obsolete in GnuCOBOL -prog.cob:23: warning: DOS/VS APPLY phrase is obsolete in GnuCOBOL -prog.cob:24: warning: DOS/VS APPLY phrase is obsolete in GnuCOBOL -prog.cob:25: warning: DOS/VS APPLY phrase is obsolete in GnuCOBOL -prog.cob:42: warning: OPEN LEAVE/REREAD/DISP is obsolete in GnuCOBOL -prog.cob:42: warning: OPEN LEAVE/REREAD/DISP is obsolete in GnuCOBOL -]) -AT_CLEANUP - - -AT_SETUP([very long literal in error message]) -AT_KEYWORDS([misc literals]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. tutorial. - PROCEDURE DIVISION. - move low-values to - 'vove length of ex-keydef to key2length'- - 'move 1 to key-count'- - 'vove length of ex-keydef to key2length'- - 'move 1 to key-count'- - 'vove length of ex-keydef to key2length'- - 'move 1 to key-count'- - 'vove length of ex-keydef to key2length'- - 'move 1 to key-count'- - 'vove length of ex-keydef to key2length'- - 'move 1 to key-count'- - 'vove length of ex-keydef to key2length'- - 'move 1 to key-count'- - 'vove length of ex-keydef to key2length'- - 'move 1 to key-count'- - 'vove length of ex-keydef to key2length'- - 'move 1 to key-count'- - 'vove length of ex-keydef to key2length'- - 'move 1 to key-count'- - 'vove length of ex-keydef to key2length'- - 'move 1 to key-count'- - 'vove length of ex-keydef to key2length'- - 'move 1 to key-count'- - 'vove length of ex-keydef to key2length'- - 'move 1 to key-count'- - 'vove length of ex-keydef to key2length'- - 'move 1 to key-count'- - 'vove length of ex-keydef to key2length'- - 'move 1 to key-count'- - 'vove length of ex-keydef to key2length'- - 'move 1 to key-count'- - 'vove length of ex-keydef to key2length'- - 'move 1 to key-count'- - 'vove length of ex-keydef to key2length'- - 'move 1 to key-count'- - 'vove length of ex-keydef to key2length'- - 'move 1 to key-count'- - 'vove length of ex-keydef to key2length'- - 'move 1 to key-count'- - 'vove length of ex-keydef to key2length'- - 'move 1 to key-count'- - 'vove length of ex-keydef to key2length'- - 'move 1 to key-count'- - 'vove length of ex-keydef to key2length'- - 'move 1 to key-count'- - 'vove length of ex-keydef to key2length'- - 'move 1 to key-count'- - 'vove length of ex-keydef to key2length'- - 'move 1 to key-count'- - 'vove length of ex-keydef to key2length'- - 'move 1 to key-count'- - 'vove length of ex-keydef to key2length'- - 'move 1 to key-count'- - 'vove length of ex-keydef to key2length'- - 'move 1 to key-count'- - 'vove length of ex-keydef to key2length'- - 'move 1 to key-count'- - 'vove length of ex-keydef to key2length'- - 'move 1 to key-count'- - 'vove length of ex-keydef to key2length'- - 'move 1 to key-count'- - 'vove length of ex-keydef to key2length'- - 'move 1 to key-count'- - 'vove length of ex-keydef to key2length'- - 'move 1 to key-count'- - 'vove length of ex-keydef to key2length'- - 'move 1 to key-count'- - 'vove length of ex-keydef to key2length'- - 'move 1 to key-count'- - 'vove length of ex-keydef to key2length'- - 'move 1 to key-countaaaaaaaaaaaaaaaaaaa'- - 'aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa -]) - -AT_CHECK([$COMPILE_ONLY prog.cob], [1], [], -[prog.cob:5: error: invalid MOVE target: literal 'vove length of ex-keydef to key2len...' -prog.cob:76: error: syntax error, unexpected end of file -]) -AT_CLEANUP diff -Nru gnucobol-4.0~early~20200606/tests/testsuite.src/syn_move.at gnucobol-5/tests/testsuite.src/syn_move.at --- gnucobol-4.0~early~20200606/tests/testsuite.src/syn_move.at 2020-06-06 20:52:00.000000000 +0000 +++ gnucobol-5/tests/testsuite.src/syn_move.at 1970-01-01 00:00:00.000000000 +0000 @@ -1,656 +0,0 @@ -## Copyright (C) 2003-2012, 2015-2018,2020 Free Software Foundation, Inc. -## Written by Keisuke Nishida, Roger While, Simon Sobisch -## -## This file is part of GnuCOBOL. -## -## The GnuCOBOL compiler is free software: you can redistribute it -## and/or modify it under the terms of the GNU General Public License -## as published by the Free Software Foundation, either version 3 of the -## License, or (at your option) any later version. -## -## GnuCOBOL is distributed in the hope that it will be useful, -## but WITHOUT ANY WARRANTY; without even the implied warranty of -## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -## GNU General Public License for more details. -## -## You should have received a copy of the GNU General Public License -## along with GnuCOBOL. If not, see . - -### GnuCOBOL Test Suite - -### ISO+IEC+1989-2002 14.8.24 MOVE statement - -## 14.8.24.2 Syntax rules - - -# 1) TODO - -# 2) TODO - -# 3) DONE - -# 4) DONE - - -# 5) DONE - -AT_SETUP([MOVE SPACE TO numeric or numeric-edited item]) -AT_KEYWORDS([move editing]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 X PIC 9. - 01 Y PIC 09. - PROCEDURE DIVISION. - MOVE SPACE TO X. - MOVE SPACE TO Y. - STOP RUN. -]) - -AT_CHECK([$COMPILE_ONLY prog.cob], [1], [], -[prog.cob:9: error: MOVE of figurative constant SPACE to numeric item used -prog.cob:10: error: MOVE of figurative constant SPACE to numeric item used -]) - -AT_CLEANUP - - -# 6) DONE - -AT_SETUP([MOVE ZERO TO alphabetic item]) -AT_KEYWORDS([move]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 A PIC A. - PROCEDURE DIVISION. - MOVE ZERO TO A. - STOP RUN. -]) - -AT_CHECK([$COMPILE_ONLY prog.cob], [1], [], -[prog.cob:8: error: invalid MOVE statement -]) - -AT_CLEANUP - - -# 7) TODO - - -# 8) TODO - -AT_SETUP([MOVE alphabetic TO x]) -AT_KEYWORDS([move]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 X PIC A. - 01 Y-A PIC A. - 01 Y-X PIC X. - 01 Y-BX PIC BX. - 01 Y-9 PIC 9. - 01 Y-09 PIC 09. - PROCEDURE DIVISION. - MOVE X TO Y-A. - MOVE X TO Y-X. - MOVE X TO Y-BX. - MOVE X TO Y-9. - MOVE X TO Y-09. - STOP RUN. -]) - -AT_CHECK([$COMPILE_ONLY prog.cob], [1], [], -[prog.cob:16: error: invalid MOVE statement -prog.cob:17: error: invalid MOVE statement -]) - -AT_CLEANUP - - -AT_SETUP([MOVE alphanumeric TO x]) -AT_KEYWORDS([move]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 X PIC X. - 01 Y-A PIC A. - 01 Y-X PIC X. - 01 Y-BX PIC BX. - 01 Y-9 PIC 9. - 01 Y-09 PIC 09. - PROCEDURE DIVISION. - MOVE X TO Y-A. - MOVE X TO Y-X. - MOVE X TO Y-BX. - MOVE X TO Y-9. - MOVE X TO Y-09. - STOP RUN. -]) - -AT_CHECK([$COMPILE_ONLY prog.cob], [0], [], []) - -AT_CLEANUP - - -AT_SETUP([MOVE alphanumeric-edited TO x]) -AT_KEYWORDS([move editing]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 X PIC BX. - 01 Y-A PIC A. - 01 Y-X PIC X. - 01 Y-BX PIC BX. - 01 Y-9 PIC 9. - 01 Y-09 PIC 09. - PROCEDURE DIVISION. - MOVE X TO Y-A. - MOVE X TO Y-X. - MOVE X TO Y-BX. - MOVE X TO Y-9. - MOVE X TO Y-09. - STOP RUN. -]) - -AT_CHECK([$COMPILE_ONLY prog.cob], [1], [], -[prog.cob:16: error: invalid MOVE statement -prog.cob:17: error: invalid MOVE statement -]) - -AT_CLEANUP - - -AT_SETUP([MOVE numeric (integer) TO x]) -AT_KEYWORDS([move]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 X PIC 9. - 01 Y-A PIC A. - 01 Y-X PIC X. - 01 Y-BX PIC BX. - 01 Y-9 PIC 9. - 01 Y-09 PIC 09. - PROCEDURE DIVISION. - MOVE X TO Y-A. - MOVE X TO Y-X. - MOVE X TO Y-BX. - MOVE X TO Y-9. - MOVE X TO Y-09. - STOP RUN. -]) - -AT_CHECK([$COMPILE_ONLY prog.cob], [1], [], -[prog.cob:13: error: invalid MOVE statement -]) - -AT_CLEANUP - - -AT_SETUP([MOVE numeric (non-integer) TO x]) -AT_KEYWORDS([move]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 X PIC 9V9. - 01 Y-A PIC A. - 01 Y-X PIC X. - 01 Y-BX PIC BX. - 01 Y-9 PIC 9. - 01 Y-09 PIC 09. - PROCEDURE DIVISION. - MOVE X TO Y-A. - MOVE X TO Y-X. - MOVE X TO Y-BX. - MOVE X TO Y-9. - MOVE X TO Y-09. - STOP RUN. -]) - -AT_CHECK([$COMPILE_ONLY prog.cob], [1], [], -[prog.cob:13: error: invalid MOVE statement -prog.cob:14: error: invalid MOVE statement -prog.cob:15: error: invalid MOVE statement -]) - -AT_CLEANUP - - -AT_SETUP([MOVE numeric-edited TO x]) -AT_KEYWORDS([move editing]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 X PIC 09. - 01 Y-A PIC A. - 01 Y-X PIC X. - 01 Y-BX PIC BX. - 01 Y-9 PIC 9. - 01 Y-09 PIC 09. - PROCEDURE DIVISION. - MOVE X TO Y-A. - MOVE X TO Y-X. - MOVE X TO Y-BX. - MOVE X TO Y-9. - MOVE X TO Y-09. - STOP RUN. -]) - -AT_CHECK([$COMPILE_ONLY prog.cob], [1], [], -[prog.cob:13: error: invalid MOVE statement -]) - -AT_CLEANUP - - -# 9) DONE - - -# 10) DONE - -AT_SETUP([CORRESPONDING - Operands must be groups]) -AT_KEYWORDS([move]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 G-1. - 02 X PIC X. - 01 G-2. - 02 Y PIC X. - PROCEDURE DIVISION. - MOVE CORR X TO G-1. - MOVE CORR G-1 TO X. - MOVE CORR G-1(1:1) TO G-2. - MOVE CORR G-1 TO G-2(1:1). - STOP RUN. -]) - -AT_CHECK([$COMPILE_ONLY prog.cob], [1], [], -[prog.cob:11: error: 'X' is not a group name -prog.cob:12: error: 'X' is not a group name -prog.cob:13: error: 'G-1 (1:1)' is not a group name -prog.cob:14: error: 'G-2 (1:1)' is not a group name -]) - -AT_CLEANUP - - -AT_SETUP([CORRESPONDING - Target has no matching items]) -AT_KEYWORDS([move]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 G-1. - 02 X PIC X. - 01 G-2. - 02 Y PIC X. - PROCEDURE DIVISION. - MOVE CORR G-1 TO G-2. - STOP RUN. -]) - -AT_CHECK([$COMPILE_ONLY prog.cob], [0], [], -[prog.cob:11: warning: no CORRESPONDING items found -]) - -AT_CLEANUP - - -# 11) DONE - -AT_SETUP([MOVE to erroneous field]) -AT_KEYWORDS([move]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 INVALID-ITEM. - 01 I PIC 9(3). - PROCEDURE DIVISION. - MOVE 1 TO INVALID-ITEM. - MOVE SPACE TO I(1:2). - STOP RUN. -]) - -AT_CHECK([$COMPILE_ONLY prog.cob], [1], [], -[prog.cob:6: error: PICTURE clause required for 'INVALID-ITEM' -]) - -AT_CLEANUP - - -AT_SETUP([Overlapping MOVE]) -AT_KEYWORDS([move]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 STRUCTURE1. - 05 FIELD1-1 PIC X(5). - 05 FIELD1-2 PIC X(10). - 01 STRUCTURE2 REDEFINES STRUCTURE1. - 05 FIELD2-1 PIC X(10). - 05 FIELD2-2 PIC X(5). - 01 FILLER REDEFINES STRUCTURE1. - 05 FILLER PIC X(01). - 05 FIELD PIC X(02) OCCURS 7. - 01 FILLER. - 05 FIELDO PIC X(02) OCCURS 7. - 77 NUMVAR PIC 9(02) VALUE 1. - 78 CONST4 VALUE 4. - PROCEDURE DIVISION. - MOVE FIELD1-2 TO STRUCTURE1 - MOVE FIELD1-2 TO FIELD1-1 - MOVE FIELD1-1 TO FIELD1-2, FIELD2-2 - MOVE FIELD1-2 TO FIELD2-1 - MOVE FIELD2-1 TO FIELD2-2 - MOVE FIELD2-1 (2:5) TO FIELD1-2 - MOVE STRUCTURE1 (2:4) TO STRUCTURE1 (5:4) - MOVE STRUCTURE1 (2:4) TO STRUCTURE1 (6:4) - MOVE STRUCTURE1 (1:NUMVAR) TO STRUCTURE1 (3:13) - MOVE STRUCTURE1 (NUMVAR:1) TO STRUCTURE1 (3:13) - MOVE STRUCTURE1 (3:13) TO STRUCTURE1 (1:NUMVAR) - MOVE STRUCTURE1 (3:13) TO STRUCTURE1 (NUMVAR:1) - MOVE STRUCTURE1 (CONST4:2) TO STRUCTURE1 (3:2) - MOVE STRUCTURE1 (6:4) TO STRUCTURE1 (2:4) - MOVE STRUCTURE1 (6:4) TO STRUCTURE1 (2: ) - MOVE FIELD (6) TO STRUCTURE1 (13:2) - MOVE FIELD (5) TO STRUCTURE1 (13:2) - MOVE FIELD (NUMVAR) TO STRUCTURE1 (13:2) - MOVE FIELD (CONST4) TO STRUCTURE1 (13:2) - MOVE FIELDO (1) TO FIELDO (1) - MOVE FIELDO (CONST4) TO FIELDO (CONST4) - MOVE FIELDO (1) TO FIELDO (2) - MOVE FIELDO (4) TO FIELDO (CONST4) - MOVE FIELDO (CONST4) TO FIELDO (4) - MOVE FIELDO (4) TO FIELDO (NUMVAR) - MOVE FIELDO (NUMVAR) TO FIELDO (4) - MOVE FIELDO (NUMVAR) TO FIELDO (NUMVAR) - MOVE FIELDO (NUMVAR) (1:1) TO FIELDO (NUMVAR) (2:1) - MOVE FIELDO (NUMVAR) (2:1) TO FIELDO (NUMVAR) - MOVE FIELDO (4) (2:1) TO FIELDO (CONST4) - STOP RUN. -]) - -AT_CHECK([$COMPILE -w prog.cob], [0], [], []) - -AT_CHECK([$COMPILE prog.cob], [0], [], -[prog.cob:20: warning: overlapping MOVE may produce unpredictable results -prog.cob:23: warning: overlapping MOVE may produce unpredictable results -prog.cob:25: warning: overlapping MOVE may produce unpredictable results -prog.cob:26: warning: overlapping MOVE may produce unpredictable results -prog.cob:32: warning: overlapping MOVE may produce unpredictable results -prog.cob:34: warning: overlapping MOVE may produce unpredictable results -prog.cob:39: warning: overlapping MOVE may produce unpredictable results -prog.cob:40: warning: overlapping MOVE may produce unpredictable results -prog.cob:42: warning: overlapping MOVE may produce unpredictable results -prog.cob:43: warning: overlapping MOVE may produce unpredictable results -prog.cob:46: warning: overlapping MOVE may produce unpredictable results -prog.cob:48: warning: overlapping MOVE may produce unpredictable results -prog.cob:49: warning: overlapping MOVE may produce unpredictable results -]) - -AT_CHECK([$COMPILE -Wpossible-overlap prog.cob], [0], [], -[prog.cob:20: warning: overlapping MOVE may produce unpredictable results -prog.cob:23: warning: overlapping MOVE may produce unpredictable results -prog.cob:25: warning: overlapping MOVE may produce unpredictable results -prog.cob:26: warning: overlapping MOVE may produce unpredictable results -prog.cob:28: warning: overlapping MOVE may occur and produce unpredictable results -prog.cob:29: warning: overlapping MOVE may occur and produce unpredictable results -prog.cob:30: warning: overlapping MOVE may occur and produce unpredictable results -prog.cob:31: warning: overlapping MOVE may occur and produce unpredictable results -prog.cob:32: warning: overlapping MOVE may produce unpredictable results -prog.cob:34: warning: overlapping MOVE may produce unpredictable results -prog.cob:39: warning: overlapping MOVE may produce unpredictable results -prog.cob:40: warning: overlapping MOVE may produce unpredictable results -prog.cob:42: warning: overlapping MOVE may produce unpredictable results -prog.cob:43: warning: overlapping MOVE may produce unpredictable results -prog.cob:46: warning: overlapping MOVE may produce unpredictable results -prog.cob:48: warning: overlapping MOVE may produce unpredictable results -prog.cob:49: warning: overlapping MOVE may produce unpredictable results -]) -# special case: for GnuCOBOL the result is predictable, -# therefore maybe test in run_misc we have the expected result -# AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [], []) - -AT_CLEANUP - - -AT_SETUP([invalid source for MOVE]) -AT_KEYWORDS([move label program-prototype]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - CONFIGURATION SECTION. - REPOSITORY. - PROGRAM repo-prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 77 MAIN-VAR PIC X(3). - PROCEDURE DIVISION. - MAIN. - MOVE MAIN TO MAIN-VAR. - MOVE repo-prog TO MAIN. - STOP RUN. -]) - -AT_CHECK([$COMPILE_ONLY prog.cob], [1], [], -[prog.cob:7: warning: no definition/prototype seen for PROGRAM 'repo-prog' -prog.cob: in paragraph 'MAIN': -prog.cob:13: error: 'MAIN' is not a field -prog.cob:14: error: 'repo-prog' is not a field -]) - -AT_CLEANUP - - -AT_SETUP([invalid target for MOVE]) -AT_KEYWORDS([move constant label program-prototype]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - CONFIGURATION SECTION. - REPOSITORY. - PROGRAM repo-prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 78 DEFINED-CONST VALUE 'A'. - 77 MAIN-VAR PIC X(3). - PROCEDURE DIVISION. - MAIN. - MOVE 'A' TO MAIN-VAR. - MOVE 'B' TO MAIN. - MOVE 'C' TO repo-prog. - MOVE 'D' TO QUOTE. - MOVE 'E' TO DEFINED-CONST. - STOP RUN. -]) - -AT_CHECK([$COMPILE_ONLY prog.cob], [1], [], -[prog.cob:7: warning: no definition/prototype seen for PROGRAM 'repo-prog' -prog.cob: in paragraph 'MAIN': -prog.cob:15: error: invalid MOVE target: MAIN -prog.cob:16: error: invalid MOVE target: repo-prog -prog.cob:17: error: invalid MOVE target: QUOTE -prog.cob:18: error: invalid MOVE target: literal 'A' -]) - -AT_CLEANUP - - -AT_SETUP([SET error]) -AT_KEYWORDS([SET-MOVE]) - -AT_DATA([prog.cob], [ - program-id. prog. - data division. - working-storage section. - 01 default-float usage float-long. - 01 no-pointer pic s9(9) comp. - - linkage section. - 01 float-var usage float-long. - - procedure division . - *> previously generated error message about invalid MOVE statement, - *> see bug #255 and an internal compiler error, see bug #295: - set address of float-var to default-float - set no-pointer to address of default-float - *> all fine... - set address of float-var to address of default-float - goback. - end program prog . -]) - -AT_CHECK([$COMPILE_ONLY prog.cob], [1], [], -[prog.cob:14: error: invalid SET statement -prog.cob:15: error: invalid SET statement -]) - -AT_CLEANUP - - -AT_SETUP([MOVE FIGURATIVE to NUMERIC]) -AT_KEYWORDS([MOVE]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 MYFLD PIC 9(4) VALUE 96. - 01 BIGFLT COMP-1 VALUE 543.12345E10. - PROCEDURE DIVISION. - MAIN-1. - MOVE BIGFLT TO MYFLD. - MOVE SPACES TO MYFLD. - MOVE LOW-VALUES TO MYFLD. - MOVE HIGH-VALUES TO MYFLD. - MOVE QUOTE TO MYFLD. - MOVE ALL '*' TO MYFLD. - MOVE ALL '0' TO MYFLD. - MOVE ALL 'A1' TO MYFLD. - MOVE ALL '21' TO MYFLD. - SET MYFLD TO HIGH-VALUES. - SET MYFLD TO SPACES. - MOVE HIGH-VALUES TO MYFLD (1:). - - MOVE HIGH-VALUES TO BIGFLT. - MOVE QUOTE TO BIGFLT. - MOVE ALL '*' TO BIGFLT. - MOVE ALL '21' TO BIGFLT. - STOP RUN. -]) - -AT_CHECK([$COMPILE_ONLY -std=cobol2002 -freserved=COMP-1:FLOAT prog.cob], [1], [], -[prog.cob: in paragraph 'MAIN-1': -prog.cob:11: error: MOVE of figurative constant SPACE to numeric item used -prog.cob:12: warning: MOVE of figurative constant to numeric item is archaic in COBOL 2002 -prog.cob:13: warning: MOVE of figurative constant to numeric item is archaic in COBOL 2002 -prog.cob:14: warning: MOVE of figurative constant QUOTE to numeric item is archaic in COBOL 2002 -prog.cob:15: warning: numeric value is expected -prog.cob:6: warning: 'MYFLD' defined here as PIC 9(4) -prog.cob:17: warning: numeric value is expected -prog.cob:6: warning: 'MYFLD' defined here as PIC 9(4) -prog.cob:19: error: invalid SET statement -prog.cob:20: error: invalid SET statement -prog.cob:23: warning: MOVE of figurative constant to numeric item is archaic in COBOL 2002 -prog.cob:24: warning: MOVE of figurative constant QUOTE to numeric item is archaic in COBOL 2002 -prog.cob:25: warning: numeric value is expected -prog.cob:7: warning: 'BIGFLT' defined here as USAGE FLOAT -]) - -AT_CHECK([$COMPILE_ONLY -std=ibm prog.cob], [1], [], -[prog.cob: in paragraph 'MAIN-1': -prog.cob:11: error: MOVE of figurative constant SPACE to numeric item used -prog.cob:12: warning: MOVE of figurative constant to numeric item is archaic in IBM COBOL (lax) -prog.cob:13: warning: MOVE of figurative constant to numeric item is archaic in IBM COBOL (lax) -prog.cob:14: warning: MOVE of figurative constant QUOTE to numeric item is archaic in IBM COBOL (lax) -prog.cob:15: warning: numeric value is expected -prog.cob:6: warning: 'MYFLD' defined here as PIC 9(4) -prog.cob:17: warning: numeric value is expected -prog.cob:6: warning: 'MYFLD' defined here as PIC 9(4) -prog.cob:19: error: invalid SET statement -prog.cob:20: error: invalid SET statement -prog.cob:23: warning: MOVE of figurative constant to numeric item is archaic in IBM COBOL (lax) -prog.cob:24: warning: MOVE of figurative constant QUOTE to numeric item is archaic in IBM COBOL (lax) -prog.cob:25: warning: numeric value is expected -prog.cob:7: warning: 'BIGFLT' defined here as USAGE FLOAT -]) - -AT_CHECK([$COMPILE_ONLY -std=mf prog.cob], [1], [], -[prog.cob: in paragraph 'MAIN-1': -prog.cob:11: warning: source is non-numeric - substituting zero -prog.cob:12: warning: source is non-numeric - substituting zero -prog.cob:13: warning: source is non-numeric - substituting zero -prog.cob:14: warning: source is non-numeric - substituting zero -prog.cob:15: warning: source is non-numeric - substituting zero -prog.cob:17: warning: source is non-numeric - substituting zero -prog.cob:19: error: invalid SET statement -prog.cob:20: error: invalid SET statement -prog.cob:23: warning: source is non-numeric - substituting zero -prog.cob:24: warning: source is non-numeric - substituting zero -prog.cob:25: warning: source is non-numeric - substituting zero -]) - -AT_CHECK([$COMPILE_ONLY prog.cob], [1], [], -[prog.cob: in paragraph 'MAIN-1': -prog.cob:11: error: MOVE of figurative constant SPACE to numeric item used -prog.cob:12: warning: MOVE of figurative constant to numeric item is archaic in GnuCOBOL -prog.cob:13: warning: MOVE of figurative constant to numeric item is archaic in GnuCOBOL -prog.cob:14: warning: MOVE of figurative constant QUOTE to numeric item is obsolete in GnuCOBOL -prog.cob:14: warning: MOVE of figurative constant to numeric item is archaic in GnuCOBOL -prog.cob:15: warning: numeric value is expected -prog.cob:6: warning: 'MYFLD' defined here as PIC 9(4) -prog.cob:17: warning: numeric value is expected -prog.cob:6: warning: 'MYFLD' defined here as PIC 9(4) -prog.cob:19: error: invalid SET statement -prog.cob:20: error: invalid SET statement -prog.cob:23: warning: MOVE of figurative constant to numeric item is archaic in GnuCOBOL -prog.cob:24: warning: MOVE of figurative constant QUOTE to numeric item is obsolete in GnuCOBOL -prog.cob:24: warning: MOVE of figurative constant to numeric item is archaic in GnuCOBOL -prog.cob:25: warning: numeric value is expected -prog.cob:7: warning: 'BIGFLT' defined here as USAGE FLOAT -]) - -AT_CLEANUP - diff -Nru gnucobol-4.0~early~20200606/tests/testsuite.src/syn_multiply.at gnucobol-5/tests/testsuite.src/syn_multiply.at --- gnucobol-4.0~early~20200606/tests/testsuite.src/syn_multiply.at 2020-06-06 20:52:00.000000000 +0000 +++ gnucobol-5/tests/testsuite.src/syn_multiply.at 1970-01-01 00:00:00.000000000 +0000 @@ -1,131 +0,0 @@ -## Copyright (C) 2003-2012, 2018 Free Software Foundation, Inc. -## Written by Keisuke Nishida, Roger While -## -## This file is part of GnuCOBOL. -## -## The GnuCOBOL compiler is free software: you can redistribute it -## and/or modify it under the terms of the GNU General Public License -## as published by the Free Software Foundation, either version 3 of the -## License, or (at your option) any later version. -## -## GnuCOBOL is distributed in the hope that it will be useful, -## but WITHOUT ANY WARRANTY; without even the implied warranty of -## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -## GNU General Public License for more details. -## -## You should have received a copy of the GNU General Public License -## along with GnuCOBOL. If not, see . - -### GnuCOBOL Test Suite - -### ISO+IEC+1989-2002 14.8.25 MULTIPLY statement - -## 14.8.25.2 Syntax rules - - -# 1) DONE - -AT_SETUP([Category check of Format 1]) -AT_KEYWORDS([multiply]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 X-X PIC X. - 01 X-9 PIC 9. - 01 X-09 PIC 09. - PROCEDURE DIVISION. - MULTIPLY 123 BY 456 - MULTIPLY "a" BY "b" - MULTIPLY 123 BY "b" - MULTIPLY X-X BY X-9 - MULTIPLY X-9 BY X-09 - MULTIPLY X-09 BY X-X - MULTIPLY 123 BY X-X - STOP RUN. -]) - -AT_CHECK([$COMPILE_ONLY prog.cob], [1], , -[prog.cob:10: error: '456' is not a numeric name -prog.cob:11: error: '"a"' is not a numeric value -prog.cob:12: error: '"b"' is not a numeric name -prog.cob:13: error: 'X-X' is not a numeric value -prog.cob:14: error: 'X-09' is not a numeric name -prog.cob:15: error: 'X-09' is not a numeric value -prog.cob:16: error: 'X-X' is not a numeric name -]) - -AT_CLEANUP - -# 2) DONE - -AT_SETUP([Category check of Format 2]) -AT_KEYWORDS([multiply]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 X-X PIC X. - 01 X-9 PIC 9. - 01 X-09 PIC 09. - PROCEDURE DIVISION. - MULTIPLY 123 BY 456 GIVING 789 - MULTIPLY "a" BY "b" GIVING "c" - MULTIPLY 123 BY 456 GIVING "c" - MULTIPLY X-X BY X-9 GIVING X-09 - MULTIPLY X-9 BY X-09 GIVING X-X - MULTIPLY 123 BY 456 GIVING X-X - MULTIPLY X-09 BY X-X GIVING X-9 - STOP RUN. -]) - -AT_CHECK([$COMPILE_ONLY prog.cob], [1], , -[prog.cob:10: error: '789' is not a numeric or numeric-edited name -prog.cob:11: error: '"a"' is not a numeric value -prog.cob:11: error: '"b"' is not a numeric value -prog.cob:12: error: '"c"' is not a numeric or numeric-edited name -prog.cob:13: error: 'X-X' is not a numeric value -prog.cob:14: error: 'X-09' is not a numeric value -prog.cob:15: error: 'X-X' is not a numeric or numeric-edited name -prog.cob:16: error: 'X-09' is not a numeric value -prog.cob:16: error: 'X-X' is not a numeric value -]) - -AT_CLEANUP - -# 3) DONE - -AT_SETUP([Category check of literals]) -AT_KEYWORDS([multiply]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 X PIC 9. - PROCEDURE DIVISION. - MULTIPLY 123 BY X - END-MULTIPLY. - MULTIPLY "a" BY X - END-MULTIPLY. - MULTIPLY 123 BY 456 GIVING X - END-MULTIPLY. - MULTIPLY "a" BY "b" GIVING X - END-MULTIPLY. - STOP RUN. -]) - -AT_CHECK([$COMPILE_ONLY prog.cob], [1], , -[prog.cob:10: error: '"a"' is not a numeric value -prog.cob:14: error: '"a"' is not a numeric value -prog.cob:14: error: '"b"' is not a numeric value -]) - -AT_CLEANUP - -# 4) TODO diff -Nru gnucobol-4.0~early~20200606/tests/testsuite.src/syn_occurs.at gnucobol-5/tests/testsuite.src/syn_occurs.at --- gnucobol-4.0~early~20200606/tests/testsuite.src/syn_occurs.at 2020-06-06 20:52:00.000000000 +0000 +++ gnucobol-5/tests/testsuite.src/syn_occurs.at 1970-01-01 00:00:00.000000000 +0000 @@ -1,484 +0,0 @@ -## Copyright (C) 2003-2012, 2015-2019 Free Software Foundation, Inc. -## Written by Keisuke Nishida, Roger While, Simon Sobisch, Edward Hart -## -## This file is part of GnuCOBOL. -## -## The GnuCOBOL compiler is free software: you can redistribute it -## and/or modify it under the terms of the GNU General Public License -## as published by the Free Software Foundation, either version 3 of the -## License, or (at your option) any later version. -## -## GnuCOBOL is distributed in the hope that it will be useful, -## but WITHOUT ANY WARRANTY; without even the implied warranty of -## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -## GNU General Public License for more details. -## -## You should have received a copy of the GNU General Public License -## along with GnuCOBOL. If not, see . - -### GnuCOBOL Test Suite - -### ISO+IEC+1989-2002 13.16.36 OCCURS clause -### ISO+IEC+1989-202x 3rd WD 13.18.38 OCCURS clause - -## .2 Syntax rules - - -# 1a) level number rules (extended with level 78) - -AT_SETUP([OCCURS with level 01 and 77]) -#AT_KEYWORDS([occurs]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 X-01 PIC X OCCURS 10. - 01 G OCCURS 10. - 02 X-02 PIC X OCCURS 10. - 01 G2. - 02 X2-02 PIC X OCCURS 10. - 77 X-77 PIC X OCCURS 10. -]) - -AT_CHECK([$COMPILE_ONLY -std=cobol2014 prog.cob], [1], [], -[prog.cob:6: error: level 01 item 'X-01' cannot have a OCCURS clause -prog.cob:7: error: level 01 item 'G' cannot have a OCCURS clause -prog.cob:11: error: level 77 item 'X-77' cannot have a OCCURS clause -]) - -AT_CHECK([$COMPILE_ONLY prog.cob], [0], [], []) -AT_CHECK([$COMPILE_ONLY -ftop-level-occurs-clause=warning prog.cob], [0], [], -[prog.cob:6: warning: 01/77 OCCURS used -prog.cob:7: warning: 01/77 OCCURS used -prog.cob:11: warning: 01/77 OCCURS used -]) - -AT_CLEANUP - - -# FIXME: should be a single test but the error recovery is broken -#AT_SETUP([OCCURS with level 66 / 78 / 88]) -#AT_KEYWORDS([RENAMES]) -# -#AT_DATA([prog.cob], [ -# IDENTIFICATION DIVISION. -# PROGRAM-ID. prog. -# DATA DIVISION. -# WORKING-STORAGE SECTION. -# 01 x PIC X. -# 66 y RENAMES x OCCURS 10. -# 88 y VALUE "a" OCCURS 10. -# 78 y VALUE "a" OCCURS 10. -#]) -# -#AT_CHECK([$COMPILE_ONLY prog.cob], [1], [], -#[prog.cob:7: error: syntax error, unexpected OCCURS, expecting . -#prog.cob:8: error: syntax error, unexpected OCCURS, expecting . -#prog.cob:9: error: syntax error, unexpected OCCURS, expecting . -#]) -#AT_CLEANUP - - -AT_SETUP([OCCURS with level 66]) -AT_KEYWORDS([RENAMES]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 x PIC X. - 66 y RENAMES x OCCURS 10. -]) - -AT_CHECK([$COMPILE_ONLY prog.cob], [1], [], -[prog.cob:7: error: syntax error, unexpected OCCURS, expecting . -]) - -AT_CLEANUP - - -AT_SETUP([OCCURS with level 78]) -#AT_KEYWORDS([occurs]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 78 c value "a" OCCURS 10. -]) - -AT_CHECK([$COMPILE_ONLY prog.cob], [1], [], -[prog.cob:6: error: syntax error, unexpected OCCURS, expecting . -]) - -AT_CLEANUP - - -AT_SETUP([OCCURS with level 88]) -#AT_KEYWORDS([occurs]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 x PIC X. - 88 y VALUE "a" OCCURS 10. -]) - -AT_CHECK([$COMPILE_ONLY prog.cob], [1], [], -[prog.cob:7: error: syntax error, unexpected OCCURS, expecting . -]) - -AT_CLEANUP - -# 1b) with ODO below (allowed with IBM extension) - -AT_SETUP([OCCURS with variable-occurrence data item]) -AT_KEYWORDS([nested depending extensions odo]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 G-1. - 02 G-2 OCCURS 10. - 03 X PIC X(10) OCCURS 1 TO 4 DEPENDING ON I. - 77 I PIC 9. -]) - -AT_DATA([prog2.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog2. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 G-1. - 02 G-2 OCCURS 1 TO 10 DEPENDING ON I. - 03 X PIC X(10) OCCURS 1 TO 4 DEPENDING ON I. - 77 I PIC 9. - PROCEDURE DIVISION. - DISPLAY X(I, I) END-DISPLAY - DISPLAY G-2 (I) END-DISPLAY - DISPLAY G-1 END-DISPLAY - . - -]) - -AT_CHECK([$COMPILE_ONLY prog.cob], [1], [], -[prog.cob:7: error: 'G-2' cannot have the OCCURS clause due to 'X' -]) - -AT_CHECK([$COMPILE_ONLY -fcomplex-odo prog.cob], [0], [], []) - -AT_CHECK([$COMPILE_ONLY -fcomplex-odo prog2.cob], [1], [], -[prog2.cob:8: error: 'X' cannot have nested OCCURS DEPENDING -]) - -AT_CHECK([$COMPILE_ONLY -fodoslide prog2.cob], [0], [], []) - -AT_CLEANUP - - -# 2) no subscript for key+index - -AT_SETUP([OCCURS data-items for INDEXED and KEY]) -AT_KEYWORDS([ASCENDING DESCENDING]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 TAB. - 05 TAB-ENTRY1 - OCCURS 5 TIMES - ASCENDING KEY IS X1 - OF TAB-ENTRY1 - OF TAB - INDEXED BY IDX1 OF TAB. - 10 X1 PIC 9. -]) - -AT_CHECK([$COMPILE_ONLY prog.cob], [1], [], -[prog.cob:9: error: a subscripted data-item cannot be used here -prog.cob:12: error: a subscripted data-item cannot be used here -]) - -AT_CLEANUP - -# 3) KEY specification - -# 4) TODO - -# 5) TODO - -# 6) TODO - -# 7) TODO - -# 8) TODO - - -# 9) DONE - -AT_SETUP([Nested OCCURS clause]) -#AT_KEYWORDS([occurs]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 G-1. - 02 G-2 OCCURS 2. - 03 G-3 OCCURS 2. - 04 G-4 OCCURS 2. - 05 G-5 OCCURS 2. - 06 G-6 OCCURS 2. - 07 G-7 OCCURS 2. - 08 G-8 OCCURS 2. - 09 X PIC X. -]) - -AT_CHECK([$COMPILE_ONLY prog.cob], [0], [], []) - -AT_CLEANUP - - -# 10) TODO - -# 11) TODO - -# 12) TODO - -# 13) TODO - -# 14) TODO - -# 15) TODO - -# in COBOL 2014 this is rule 16, not sure about COBOL 2002. -AT_SETUP([OCCURS DEPENDING with wrong size]) -AT_KEYWORDS([range]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 FILLER. - 02 G-1 PIC X OCCURS 1 TO 1 DEPENDING ON I. - 01 FILLER. - 02 G-2 PIC X OCCURS -1 TO 1 DEPENDING ON I. - 01 FILLER. - 02 G-3 PIC X OCCURS +1 TO 1 DEPENDING ON I. - 01 FILLER. - 02 G-4 PIC X OCCURS 0 TO 1 DEPENDING ON I. - 01 I PIC 9. -]) - -AT_CHECK([$COMPILE_ONLY prog.cob], [1], [], -[prog.cob:7: error: OCCURS TO must be greater than OCCURS FROM -prog.cob:9: error: unsigned integer value expected -prog.cob:11: error: unsigned integer value expected -]) - -AT_CLEANUP - - -# 16) TODO - -# 17) TODO - -# 18) TODO - -# 19) TODO - - -# 20) DONE - -AT_SETUP([OCCURS DEPENDING followed by another field]) -AT_KEYWORDS([extensions]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 G-1. - 02 X PIC X OCCURS 1 TO 3 DEPENDING ON I. - 02 Y PIC X. - 01 G-2. - 02 G-3 OCCURS 1 TO 3 DEPENDING ON I. - 03 X PIC X. - 02 Y PIC X. - 01 G-4. - 02 G-5. - 03 X PIC X OCCURS 1 TO 3 DEPENDING ON I. - 02 Y PIC X. - 01 I PIC 9. -]) - -AT_CHECK([$COMPILE_ONLY prog.cob], [1], [], -[prog.cob:7: error: 'X' cannot have OCCURS DEPENDING because of 'Y' -prog.cob:10: error: 'G-3' cannot have OCCURS DEPENDING because of 'Y' -prog.cob:15: error: 'X' cannot have OCCURS DEPENDING because of 'Y' -]) - -AT_CHECK([$COMPILE_ONLY -fcomplex-odo prog.cob], [0], [], []) - -AT_CLEANUP - - -# 21) TODO - -# 22) TODO - -# 23) TODO - -# 24) -# in COBOL 2014 this is rule 24, not sure about COBOL 2002. -# for X3-Test, see also bug #544 -AT_SETUP([OCCURS with unmatched DEPENDING / TO phrases]) -AT_KEYWORDS([odo]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 Y PIC 9. - 01 XTAB. - 03 X PIC X OCCURS 10 DEPENDING ON Y. - 01 XTAB2. - 03 X2 PIC X OCCURS 1 TO 10. - 01 XTAB3. - 03 X3 PIC X OCCURS 1 TO 10 DEPENDING ON MISSING. - PROCEDURE DIVISION. - MOVE 'A' TO X(1), X2(2), X3(3) - GOBACK. -]) - -AT_CHECK([$COMPILE_ONLY -std=cobol2014 prog.cob], [1], [], -[prog.cob:8: error: OCCURS DEPENDING ON without TO phrase does not conform to COBOL 2014 -prog.cob:10: error: TO phrase without DEPENDING phrase -prog.cob:12: error: 'MISSING' is not defined -]) -AT_CHECK([$COMPILE_ONLY prog.cob], [1], [], -[prog.cob:8: warning: OCCURS DEPENDING ON without TO phrase used -prog.cob:10: error: TO phrase without DEPENDING phrase -prog.cob:12: error: 'MISSING' is not defined -]) -AT_CHECK([$COMPILE_ONLY -frelax-syntax prog.cob], [1], [], -[prog.cob:8: warning: OCCURS DEPENDING ON without TO phrase used -prog.cob:10: warning: TO phrase without DEPENDING phrase -prog.cob:10: warning: maximum number of occurrences assumed to be exact number -prog.cob:12: error: 'MISSING' is not defined -]) - -AT_CLEANUP - - -# GnuCOBOL additional checks - - -AT_SETUP([OCCURS INDEXED before KEY]) -AT_KEYWORDS([ASCENDING DESCENDING]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 TAB. - 05 TAB-ENTRY1 - OCCURS 5 TIMES - INDEXED BY IDX1 - ASCENDING KEY IS X1 - DESCENDING Y1. - 10 X1 PIC 9(4). - 10 Y1 PIC X. - 05 TAB-ENTRY - OCCURS 2 TIMES - INDEXED BY IDX2 - DESCENDING KEY IS X2 - ASCENDING Y2. - 10 X2 PIC 9(4). - 10 Y2 PIC X. -]) - -AT_CHECK([$COMPILE_ONLY prog.cob], [1], [], -[prog.cob:10: error: INDEXED should follow ASCENDING/DESCENDING -prog.cob:17: error: INDEXED should follow ASCENDING/DESCENDING -]) - -AT_CHECK([$COMPILE_ONLY -frelax-syntax-checks prog.cob], [0], [], -[prog.cob:10: warning: INDEXED should follow ASCENDING/DESCENDING -prog.cob:17: warning: INDEXED should follow ASCENDING/DESCENDING -]) - -AT_CLEANUP - - -AT_SETUP([OCCURS size check]) -AT_KEYWORDS([limit]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 X1. - 03 X PIC X OCCURS 1530001234 TIMES. - 01 X2. - 03 X PIC X OCCURS 2147483648 TIMES. - 01 X3. - 03 X PIC X OCCURS 9223372036854775808 TIMES. -]) - -# Don't check actual output here as the actual limit depends on INT_MAX, therefore -# all entries may raise this error but only the last error message is guaranteed. -AT_CHECK([$COMPILE_ONLY prog.cob], [1], [], ignore) -AT_CHECK([$COMPILE_ONLY prog.cob 2>&1 | \ -grep "prog.cob:11: error: numeric literal '9223372036854775808' exceeds limit"], -[0], ignore, []) - -AT_CLEANUP - - -AT_SETUP([ODO not Fixed Loc]) -AT_KEYWORDS([ODO]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ****************************************************************** - ENVIRONMENT DIVISION. - DATA DIVISION. - ****************************************************************** - WORKING-STORAGE SECTION. - 01 DAT. - 02 ODO-1 PIC 9. - 02 ODO-1-DATA OCCURS 1 TO 6 TIMES DEPENDING ON ODO-1 - PIC 9. - 02 ODO-2 PIC 9. - 02 ODO-2-DATA OCCURS 1 TO 6 TIMES DEPENDING ON ODO-2 - PIC 9. - 02 ODO-3 PIC XXX. - - ****************************************************************** - PROCEDURE DIVISION. - STOP RUN. - -]) - -AT_CHECK([$COMPILE_ONLY -std=mf prog.cob ], [0], [], []) -AT_CHECK([$COMPILE_ONLY -std=mf -fodoslide prog.cob ], [0], [], []) - -AT_CLEANUP - diff -Nru gnucobol-4.0~early~20200606/tests/testsuite.src/syn_redefines.at gnucobol-5/tests/testsuite.src/syn_redefines.at --- gnucobol-4.0~early~20200606/tests/testsuite.src/syn_redefines.at 2020-06-06 20:52:00.000000000 +0000 +++ gnucobol-5/tests/testsuite.src/syn_redefines.at 1970-01-01 00:00:00.000000000 +0000 @@ -1,448 +0,0 @@ -## Copyright (C) 2003-2012, 2016-2017 Free Software Foundation, Inc. -## Written by Keisuke Nishida, Roger While -## -## This file is part of GnuCOBOL. -## -## The GnuCOBOL compiler is free software: you can redistribute it -## and/or modify it under the terms of the GNU General Public License -## as published by the Free Software Foundation, either version 3 of the -## License, or (at your option) any later version. -## -## GnuCOBOL is distributed in the hope that it will be useful, -## but WITHOUT ANY WARRANTY; without even the implied warranty of -## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -## GNU General Public License for more details. -## -## You should have received a copy of the GNU General Public License -## along with GnuCOBOL. If not, see . - -### GnuCOBOL Test Suite - -### ISO+IEC+1989-2002 13.16.42 REDEFINES clause - -## 13.16.42.2 Syntax rules - - -# 1) DONE - -AT_SETUP([REDEFINES: not following entry-name]) -AT_KEYWORDS([redefines]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 X PIC X. - 01 Y PIC 9 REDEFINES X. -]) - -AT_CHECK([$COMPILE_ONLY -ffree-redefines-position=error prog.cob], [1], [], -[prog.cob:7: error: REDEFINES clause not following entry-name used -]) - -AT_CHECK([$COMPILE_ONLY prog.cob], [0], [], -[prog.cob:7: warning: REDEFINES clause not following entry-name used -]) - -AT_CLEANUP - - -# 2) DONE - -AT_SETUP([REDEFINES: level 02 by 01]) -AT_KEYWORDS([redefines]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 G. - 02 X PIC X. - 01 Y REDEFINES X PIC 9. - PROCEDURE DIVISION. - STOP RUN. -]) - -AT_CHECK([$COMPILE_ONLY prog.cob], [1], [], -[prog.cob:8: error: level number of REDEFINES entries must be identical -]) - -AT_CLEANUP - -AT_SETUP([REDEFINES: level 03 by 02]) -AT_KEYWORDS([redefines]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 G1. - 02 G2. - 03 X PIC X. - 02 Y REDEFINES X PIC 9. - PROCEDURE DIVISION. - STOP RUN. -]) - -AT_CHECK([$COMPILE_ONLY prog.cob], [1], [], -[prog.cob:9: error: 'X' is not defined in 'G1' -]) - -AT_CLEANUP - -AT_SETUP([REDEFINES: level 66]) -AT_KEYWORDS([redefines]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 G. - 02 X PIC X. - 66 A RENAMES X. - 66 B REDEFINES A PIC 9. - PROCEDURE DIVISION. - STOP RUN. -]) - -AT_CHECK([$COMPILE_ONLY prog.cob], [1], [], -[prog.cob:9: error: syntax error, unexpected REDEFINES, expecting RENAMES -]) - -AT_CLEANUP - -AT_SETUP([REDEFINES: level 88]) -AT_KEYWORDS([redefines]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 X PIC X. - 88 A VALUE "A". - 88 B REDEFINES A VALUE "B". - PROCEDURE DIVISION. - STOP RUN. -]) - -AT_CHECK([$COMPILE_ONLY prog.cob], [1], [], -[prog.cob:8: error: syntax error, unexpected REDEFINES, expecting VALUE -]) - -AT_CLEANUP - - -# 3) TODO - -# 4) TODO - - -# 5) DONE - -AT_SETUP([REDEFINES: lower level number]) -AT_KEYWORDS([redefines]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 G1. - 02 G2. - 03 X PIC X. - 02 G3. - 03 A REDEFINES X PIC 9. - PROCEDURE DIVISION. - STOP RUN. -]) - -AT_CHECK([$COMPILE_ONLY prog.cob], [1], [], -[prog.cob:10: error: 'X' is not defined in 'G3' -]) - -AT_CLEANUP - - -# 6) DONE - -AT_SETUP([REDEFINES: with OCCURS]) -AT_KEYWORDS([redefines]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 G. - 02 X PIC X OCCURS 2. - 02 Y REDEFINES X PIC XX. - PROCEDURE DIVISION. - STOP RUN. -]) - -AT_CHECK([$COMPILE_ONLY prog.cob], [0], [], -[prog.cob:8: warning: the original definition 'X' should not have OCCURS clause -]) - -AT_CLEANUP - -AT_SETUP([REDEFINES: with subscript]) -AT_KEYWORDS([redefines]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 G1. - 02 G2 OCCURS 2. - 03 X PIC X. - 03 Y REDEFINES X(1) PIC X. - PROCEDURE DIVISION. - STOP RUN. -]) - -AT_CHECK([$COMPILE_ONLY prog.cob], [1], [], -[prog.cob:9: error: 'X' cannot be subscripted here -]) - -AT_CLEANUP - -AT_SETUP([REDEFINES: with variable occurrence]) -AT_KEYWORDS([redefines]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 G1. - 02 X PIC XX. - 02 Y REDEFINES X PIC X OCCURS 1 TO 2 DEPENDING ON I. - 01 G2. - 02 X PIC XX. - 02 Y REDEFINES X. - 03 A PIC X OCCURS 1 TO 2 DEPENDING ON I. - 01 G3. - 02 X. - 03 A PIC X OCCURS 1 TO 2 DEPENDING ON I. - 02 Y REDEFINES X PIC X. - 01 I PIC 9. - PROCEDURE DIVISION. - STOP RUN. -]) - -AT_CHECK([$COMPILE_ONLY prog.cob], [1], [], -[prog.cob:8: error: 'Y' cannot be variable length -prog.cob:11: error: 'Y' cannot be variable length -prog.cob:16: error: the original definition 'X' cannot be variable length -]) - -AT_CLEANUP - - -# 7) DONE - -AT_SETUP([REDEFINES: with qualification]) -AT_KEYWORDS([redefines]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 G1. - 02 X PIC X. - 01 G2. - 02 X PIC X. - 02 A REDEFINES X IN G1. - PROCEDURE DIVISION. - STOP RUN. -]) - -AT_CHECK([$COMPILE_ONLY prog.cob], [1], [], -[prog.cob:10: error: 'X' cannot be qualified here -]) - -AT_CLEANUP - - -# 8) DONE - -AT_SETUP([REDEFINES: multiple redefinition]) -AT_KEYWORDS([redefines]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 G1. - 02 X PIC X. - 02 A REDEFINES X PIC 9. - 02 B REDEFINES X PIC 9. - 02 C REDEFINES B PIC 9. - PROCEDURE DIVISION. - STOP RUN. -]) - -AT_CHECK([$COMPILE_ONLY prog.cob], [1], [], -[prog.cob:10: error: 'B' is not the original definition -]) - -AT_CHECK([$COMPILE_ONLY -std=mvs prog.cob], [0], [], []) - -AT_CLEANUP - - -# 9) DONE - -AT_SETUP([REDEFINES: size exceeds]) -AT_KEYWORDS([redefines]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 G1. - 02 X PIC X. - 02 A REDEFINES X PIC 99. - 01 G2. - 02 X PIC X. - 02 A REDEFINES X PIC 9 OCCURS 2. - 01 WRK-X PIC X. - 01 WRK-X-REDEF REDEFINES WRK-X PIC 99. - 01 EXT-X PIC X EXTERNAL. - 01 EXT-X-REDEF REDEFINES EXT-X PIC 99. - PROCEDURE DIVISION. - STOP RUN. -]) - -AT_CHECK([$COMPILE_ONLY prog.cob], [1], [], -[prog.cob:8: error: size of 'A' larger than size of 'X' -prog.cob:11: error: size of 'A' larger than size of 'X' -prog.cob:15: error: size of 'EXT-X-REDEF' larger than size of 'EXT-X' -]) - -AT_CLEANUP - - -# 10) DONE - -AT_SETUP([REDEFINES: with VALUE]) -AT_KEYWORDS([redefines]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 X PIC X. - 01 A REDEFINES X PIC X VALUE "A". - 01 G REDEFINES X. - 02 B PIC X VALUE "A". - 01 Y REDEFINES X PIC X. - 88 C VALUE "A". - PROCEDURE DIVISION. - STOP RUN. -]) - -# FIXME: add a compiler configuration as the COBOL standard forbids this -# default.conf will allow it (with a warning) - -AT_CHECK([$COMPILE_ONLY prog.cob], [0], [], -[prog.cob:7: warning: initial VALUE clause ignored for REDEFINES item 'A' -prog.cob:9: warning: initial VALUE clause ignored for REDEFINES item 'B' -]) -AT_CHECK([$COMPILE -frelax-syntax-checks prog.cob], [0], [], []) - -AT_CLEANUP - - -# 11) DONE - -AT_SETUP([REDEFINES: with intervention]) -AT_KEYWORDS([redefines]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 X PIC X. - 01 Y PIC X. - 01 A REDEFINES X PIC X. - 01 G. - 02 G-X PIC X. - 02 G-Y PIC X. - 02 G-A REDEFINES G-X PIC X. - PROCEDURE DIVISION. - STOP RUN. -]) - -AT_CHECK([$COMPILE_ONLY prog.cob], [1], [], -[prog.cob:8: error: REDEFINES must follow the original definition -prog.cob:12: error: REDEFINES must follow the original definition -]) - -AT_CLEANUP - - -# 12) DONE - -AT_SETUP([REDEFINES: within REDEFINES]) -AT_KEYWORDS([redefines]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 X PIC X. - 01 G REDEFINES X. - 02 A PIC X. - 02 B REDEFINES A PIC 9. - PROCEDURE DIVISION. - STOP RUN. -]) - -AT_CHECK([$COMPILE_ONLY prog.cob], [0], [], []) - -AT_CLEANUP - -AT_SETUP([REDEFINES: non-referenced ambiguous item]) -AT_KEYWORDS([redefines]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 X PIC X. - 01 X PIC X. - 01 G REDEFINES X PIC 9. - PROCEDURE DIVISION. - STOP RUN. -]) - -AT_CHECK([$COMPILE_ONLY prog.cob], [0], [], -[prog.cob:7: warning: redefinition of 'X' -prog.cob:6: warning: 'X' previously defined here -]) - -AT_CLEANUP - - -# 13) TODO - -# 14) TODO - -# 15) TODO - -# 16) TODO diff -Nru gnucobol-4.0~early~20200606/tests/testsuite.src/syn_refmod.at gnucobol-5/tests/testsuite.src/syn_refmod.at --- gnucobol-4.0~early~20200606/tests/testsuite.src/syn_refmod.at 2020-06-06 20:52:00.000000000 +0000 +++ gnucobol-5/tests/testsuite.src/syn_refmod.at 1970-01-01 00:00:00.000000000 +0000 @@ -1,200 +0,0 @@ -## Copyright (C) 2003-2012, 2014-2015, 2017-2018 Free Software Foundation, Inc. -## Written by Keisuke Nishida, Roger While, Simon Sobisch -## -## This file is part of GnuCOBOL. -## -## The GnuCOBOL compiler is free software: you can redistribute it -## and/or modify it under the terms of the GNU General Public License -## as published by the Free Software Foundation, either version 3 of the -## License, or (at your option) any later version. -## -## GnuCOBOL is distributed in the hope that it will be useful, -## but WITHOUT ANY WARRANTY; without even the implied warranty of -## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -## GNU General Public License for more details. -## -## You should have received a copy of the GNU General Public License -## along with GnuCOBOL. If not, see . - -### GnuCOBOL Test Suite - -### ISO+IEC+1989-2002 8.4.2.3 Reference-modification - -## 8.4.2.3.3 General rules - -AT_SETUP([valid reference modification]) -AT_KEYWORDS([refmod]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 X PIC X(4) VALUE "abcd". - PROCEDURE DIVISION. - DISPLAY X(1:1) ":" X(1:2) ":" X(1:3) ":" X(1:4) ":" X(1:) - END-DISPLAY. - DISPLAY X(2:1) ":" X(2:2) ":" X(2:3) ":" X(2:) - END-DISPLAY. - DISPLAY X(3:1) ":" X(3:2) ":" X(3:) - END-DISPLAY. - DISPLAY X(4:1) ":" X(4:) - END-DISPLAY. - STOP RUN. -]) - -AT_CHECK([$COMPILE prog.cob], [0], [], []) - -AT_CLEANUP - - -AT_SETUP([Static out of bounds]) -AT_KEYWORDS([refmod]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 X PIC X(4). - 01 Y PIC 9 VALUE 1. - PROCEDURE DIVISION. - DISPLAY X(0:1) - END-DISPLAY. - DISPLAY X(0:Y) - END-DISPLAY. - DISPLAY X(5:1) - END-DISPLAY. - DISPLAY X(5:Y) - END-DISPLAY. - DISPLAY X(1:0) - END-DISPLAY. - DISPLAY X(Y:0) - END-DISPLAY. - DISPLAY X(1:5) - END-DISPLAY. - DISPLAY X(Y:5) - END-DISPLAY. - STOP RUN. -]) - -AT_CHECK([$COMPILE_ONLY -std=cobol2002 prog.cob], [1], [], -[prog.cob:9: error: offset must be greater than zero -prog.cob:11: error: offset must be greater than zero -prog.cob:13: error: offset of 'X' out of bounds: 5 -prog.cob:15: error: offset of 'X' out of bounds: 5 -prog.cob:17: error: length must be greater than zero -prog.cob:19: error: length must be greater than zero -prog.cob:21: error: length of 'X' out of bounds: 5 -prog.cob:23: error: length of 'X' out of bounds: 5 -]) - -AT_CLEANUP - - -AT_SETUP([constant-folding out of bounds]) -AT_KEYWORDS([refmod expression]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 78 VAR-LEN VALUE 4. - 01 X PIC X(VAR-LEN). - PROCEDURE DIVISION. - IF VAR-LEN < 4 - DISPLAY X(4 - VAR-LEN:1) - END-DISPLAY - DISPLAY X(1: 4 - VAR-LEN) - END-DISPLAY - DISPLAY X(9 - VAR-LEN:1) - END-DISPLAY - DISPLAY X(1:9 - VAR-LEN) - END-DISPLAY - *> special test... - INSPECT X CONVERTING "DEF" TO X (1:0 + VAR-LEN) - END-IF - STOP RUN. -]) - -AT_CHECK([$COMPILE_ONLY -std=default -freference-bounds-check=error -Wno-constant-expr prog.cob], [0], [], -[prog.cob:10: error (ignored): offset must be greater than zero -prog.cob:12: error (ignored): length must be greater than zero -prog.cob:14: error (ignored): offset of 'X' out of bounds: 5 -prog.cob:16: error (ignored): length of 'X' out of bounds: 5 -prog.cob:19: error (ignored): CONVERTING operands differ in size -]) -AT_CHECK([$COMPILE_ONLY -Wno-constant-expr -fno-constant-folding prog.cob], -[0], [], []) - -AT_CLEANUP - -AT_SETUP([Reference Bounds check]) -AT_KEYWORDS([REFMOD]) - -AT_DATA([prog.cob], [ IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 TSTLEN PIC 99 VALUE 10. - 01 TSTBIN PIC 99 COMP VALUE 10. - 01 TSTBIN10 PIC 9(9) COMP VALUE 825373492. - 01 TSTX4 PIC X(4). - 01 TSTREC. - 05 TSTTAIL2 PIC X. - 05 TSTTAIL3 PIC X. - 05 FILLER PIC X(8). - 05 TSTEND PIC X. - 01 TSTREC2 PIC X(20). - 01 TSTXX PIC X(2). - PROCEDURE DIVISION. - MOVE " " TO TSTTAIL2 (1:2). - MOVE SPACES TO TSTTAIL3 (2:8). - MOVE " " TO TSTTAIL3 (1:15). - MOVE ALL "*" TO TSTREC (-1:-1). - MOVE " " TO TSTTAIL2 (1:0). - MOVE '$' TO TSTEND. - DISPLAY "TSTREC is " TSTREC. - MOVE ALL "+" TO TSTTAIL3 (0:TSTLEN). - MOVE '$' TO TSTEND. - DISPLAY "TSTREC is " TSTREC. - MOVE 11 to TSTLEN. - MOVE SPACES TO TSTTAIL2 (1:TSTLEN). - MOVE '$' TO TSTEND. - DISPLAY "TSTREC is " TSTREC. - MOVE '12' TO TSTXX. - MOVE TSTXX TO TSTLEN. - DISPLAY "TSTLEN is " TSTLEN. - MOVE ' 3' TO TSTXX. - MOVE TSTXX TO TSTLEN. - DISPLAY "TSTLEN is " TSTLEN. - MOVE ' ' TO TSTXX. - MOVE TSTXX TO TSTLEN. - DISPLAY "TSTLEN is " TSTLEN. - MOVE 75 TO TSTLEN. - MOVE TSTLEN TO TSTXX. - DISPLAY "TSTXX is " TSTXX " vs " TSTLEN. - MOVE ' 3' TO TSTXX. - MOVE TSTXX TO TSTBIN. - DISPLAY "TSTBIN is " TSTBIN. - ADD 1 to TSTBIN. - MOVE TSTBIN TO TSTXX. - DISPLAY "TSTXX is " TSTXX " vs " TSTBIN. - MOVE TSTBIN10 (1:4) TO TSTX4 (1:4). - DISPLAY "TSTBIN10 is " TSTBIN10 " vs '" TSTX4 "'". - STOP RUN. -]) - -AT_CHECK([$COMPILE_ONLY -std=cobol2002 prog.cob ], [1], [], -[prog.cob:17: error: length of 'TSTTAIL2' out of bounds: 2 -prog.cob:18: error: offset of 'TSTTAIL3' out of bounds: 2 -prog.cob:19: error: length of 'TSTTAIL3' out of bounds: 15 -prog.cob:20: error: offset must be greater than zero -prog.cob:20: error: length must be greater than zero -prog.cob:21: error: length must be greater than zero -prog.cob:24: error: offset must be greater than zero -]) - -AT_CLEANUP - diff -Nru gnucobol-4.0~early~20200606/tests/testsuite.src/syn_reportwriter.at gnucobol-5/tests/testsuite.src/syn_reportwriter.at --- gnucobol-4.0~early~20200606/tests/testsuite.src/syn_reportwriter.at 2020-06-06 20:52:00.000000000 +0000 +++ gnucobol-5/tests/testsuite.src/syn_reportwriter.at 1970-01-01 00:00:00.000000000 +0000 @@ -1,631 +0,0 @@ -## Copyright (C) 2014-2015, 2017-2020 Free Software Foundation, Inc. -## Written by Simon Sobisch, Edward Hart, Ron Norman -## -## This file is part of GnuCOBOL. -## -## The GnuCOBOL compiler is free software: you can redistribute it -## and/or modify it under the terms of the GNU General Public License -## as published by the Free Software Foundation, either version 3 of the -## License, or (at your option) any later version. -## -## GnuCOBOL is distributed in the hope that it will be useful, -## but WITHOUT ANY WARRANTY; without even the implied warranty of -## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -## GNU General Public License for more details. -## -## You should have received a copy of the GNU General Public License -## along with GnuCOBOL. If not, see . - -### GnuCOBOL Test Suite - -### ISO+IEC+1989-2014 REPORT WRITER module - -AT_SETUP([REPORT error/warning]) -AT_KEYWORDS([report]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - INPUT-OUTPUT SECTION. - FILE-CONTROL. - SELECT TRANSACTION-DATA - ASSIGN TO EXTERNAL DATAIN - ORGANIZATION IS LINE SEQUENTIAL. - - SELECT REPORT-FILE - ASSIGN TO EXTERNAL LINE ADVANCING SYSPRINT. - - DATA DIVISION. - FILE SECTION. - FD TRANSACTION-DATA. - 01 TRANSACTION-RECORD. - 03 TR-CUSTOMER-NUMBER PIC 9(04). - 03 FILLER PIC X(01). - 03 TR-CUSTOMER-NAME PIC X(16). - 03 FILLER PIC X(01). - 03 TR-ITEM-NUMBER PIC 9(05). - 03 FILLER REDEFINES TR-ITEM-NUMBER. - 05 TR-ITEM-DEPARTMENT PIC 9(01). - 05 FILLER PIC 9(04). - 03 FILLER PIC X(01). - 03 TR-ITEM-COST PIC 9(03)V99. - 03 FILLER PIC X(47). - FD REPORT-FILE - REPORT IS NO-REPORT. - WORKING-STORAGE SECTION. - 01 END-OF-FILE-SWITCH PIC X(1) VALUE 'N'. - 88 END-OF-FILE VALUE 'Y'. - 88 GOFOREVER VALUE 'X'. - - REPORT SECTION. - RD NO-REPORT - PAGE LIMIT IS 66 LINES - HEADING 1 - FIRST DETAIL 5 - LAST DETAIL 58. - - 01 PAGE-HEAD-GROUP TYPE PAGE HEADING. - 02 LINE 1. - 03 COLUMN 27 PIC X(41) VALUE - 'S A M P L E R E P O R T'. - 02 LINE PLUS 2. - 03 COLUMN 01 PIC X(09) VALUE 'CUST. NO.'. - 03 COLUMN 15 PIC X(10) VALUE 'CUST. NAME'. - 03 COLUMN 30 PIC X(05) VALUE 'DEPT.'. - 03 COLUMN 39 PIC X(08) VALUE 'ITEM NO.'. - 03 COLUMN 51 PIC X(09) VALUE 'ITEM COST'. - - 01 CHARGE-DETAIL TYPE DETAIL. - 02 LINE PLUS 1. - 03 COLUMN 03 PIC Z(04) SOURCE TR-CUSTOMER-NUMBER. - 03 COLUMN 10 PIC X(16) SOURCE TR-CUSTOMER-NAME. - 03 COLUMN 32 PIC 9(01) SOURCE TR-ITEM-DEPARTMENT. - 03 COLUMN 40 PIC 9(05) SOURCE TR-ITEM-NUMBER. - 03 COLUMN 51 PIC $$$$.99 SOURCE TR-ITEM-COST. - - PROCEDURE DIVISION. - - OPEN INPUT TRANSACTION-DATA, - OUTPUT REPORT-FILE. - - INITIATE CUSTOMER-REPORT. - - READ TRANSACTION-DATA - AT END - MOVE 'Y' TO END-OF-FILE-SWITCH - END-READ. - - PERFORM UNTIL GOFOREVER - GENERATE CHARGE-DETAIL - READ TRANSACTION-DATA - AT END - EXIT PERFORM - END-READ - END-PERFORM. - - TERMINATE CUSTOMER-REPORT. - - CLOSE TRANSACTION-DATA, - REPORT-FILE. - - STOP RUN. -]) - -AT_CHECK([$COMPILE_ONLY prog.cob], [1], [], -[prog.cob:67: error: 'CUSTOMER-REPORT' is not defined -prog.cob:67: error: 'CUSTOMER-REPORT' is not a valid report name -prog.cob:82: error: 'CUSTOMER-REPORT' is not defined -prog.cob:82: error: 'CUSTOMER-REPORT' is not a valid report name -]) - -AT_CLEANUP - - -AT_SETUP([REPORT not positive integers in COL / LINE PLUS]) -AT_KEYWORDS([LINES COLS COLUMNS]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - - ENVIRONMENT DIVISION. - INPUT-OUTPUT SECTION. - FILE-CONTROL. - SELECT out-file ASSIGN "blah.txt" - ORGANIZATION LINE SEQUENTIAL. - - DATA DIVISION. - FILE SECTION. - FD out-file REPORT rp. - - REPORT SECTION. - RD rp. - 01 rp-head TYPE PH. - 02 LINE NUMBER IS 1, COLUMNS 0 VALUE "Hello!". - 02 LINE IS 2, COLS 2 VALUE "Hello!". - 02 LINE NUMBERS ARE PLUS 1. - 03 COLUMN NUMBER 01 PIC X(09) VALUE 'CUST. NO.'. - 03 COLUMN PLUS 0 PIC X(09) VALUE 'ITEM'. - 02 LINES ARE PLUS 2 COL NUMBERS PLUS 0. - 03 COLUMN 1.5 PIC X(09) VALUE 'CUST. NO.'. - 03 COLUMN + -10 PIC X(09) VALUE 'ITEM'. - - 01 rp-detail TYPE DETAIL. - 02 LINE PLUS 1. - 03 COLUMN 03 PIC X(06) VALUE 'SAMPLE'. - 03 COLUMN +9 PIC X(06) VALUE 'REPORT'. - - PROCEDURE DIVISION. - OPEN OUTPUT out-file. - INITIATE rp. - GENERATE rp-detail. - TERMINATE rp. - CLOSE out-file. - STOP RUN. -]) - -AT_CHECK([$COMPILE_ONLY -std=mf prog.cob], [1], [], -[prog.cob:18: error: invalid COLUMN integer; must be > 0 -prog.cob:24: error: unsigned integer value expected -prog.cob:25: error: unsigned integer value expected -prog.cob:30: error: unsigned integer value expected -]) - -AT_CLEANUP - - -AT_SETUP([Missing DETAIL line]) -AT_KEYWORDS([report]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - - ENVIRONMENT DIVISION. - INPUT-OUTPUT SECTION. - FILE-CONTROL. - SELECT out-file ASSIGN "blah.txt" - ORGANIZATION LINE SEQUENTIAL. - - DATA DIVISION. - FILE SECTION. - FD out-file REPORT rp. - - REPORT SECTION. - RD rp. - 01 rp-head TYPE PH. - 02 LINE 1, COL 2 VALUE "Hello!". - 02 LINE PLUS 1. - 03 COLUMN 01 PIC X(09) VALUE 'CUST. NO.'. - 03 COLUMN PLUS 20 PIC X(09) VALUE 'ITEM'. - - - PROCEDURE DIVISION. - OPEN OUTPUT out-file. - INITIATE rp. - GENERATE rp-detail. - TERMINATE rp. - CLOSE out-file. - STOP RUN. -]) - -AT_CHECK([$COMPILE_ONLY prog.cob], [1], [], -[prog.cob:13: warning: no DETAIL line defined in report rp -prog.cob:27: error: 'rp-detail' is not defined -]) - -AT_CLEANUP - - -AT_SETUP([REPORT LINE PLUS ZERO]) -AT_KEYWORDS([report]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - - ENVIRONMENT DIVISION. - INPUT-OUTPUT SECTION. - FILE-CONTROL. - SELECT out-file ASSIGN "blah.txt" - ORGANIZATION LINE SEQUENTIAL. - - DATA DIVISION. - FILE SECTION. - FD out-file REPORT rp. - - REPORT SECTION. - RD rp. - 01 rp-head TYPE PH. - 02 LINE 1 COL 5 PIC X(20) VALUE "Hello World!". - 02 LINE 2 COL 4 PIC X(20) VALUE "Hello Goodbye!". - 02 LINE PLUS 0. - 03 COLUMN 1 PIC X(09) VALUE 'CUST. No.'. - 03 COLUMN PLUS 0 PIC X(09) VALUE 'ITEM'. - 02 LINE PLUS ZERO. - 03 COLUMN 1 PIC X(09) VALUE 'Cust. No.'. - 03 COLUMN + 10 PIC X(09) VALUE 'Item'. - - 01 rp-detail TYPE DETAIL. - 02 LINE PLUS 1. - 03 COLUMN 03 PIC X(06) VALUE 'SAMPLE'. - - PROCEDURE DIVISION. - OPEN OUTPUT out-file. - INITIATE rp. - GENERATE rp-detail. - TERMINATE rp. - CLOSE out-file. - STOP RUN. -]) - -AT_CHECK([$COMPILE_ONLY prog.cob], [0], [], -[prog.cob:20: warning: LINE PLUS 0 is not implemented -prog.cob:23: warning: LINE PLUS 0 is not implemented -]) - -AT_CLEANUP - - -AT_SETUP([Incorrect REPORT NAME]) -AT_KEYWORDS([report]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - INPUT-OUTPUT SECTION. - FILE-CONTROL. - SELECT TRANSACTION-DATA - ASSIGN TO EXTERNAL DATAIN - ORGANIZATION IS LINE SEQUENTIAL. - - SELECT REPORT-FILE - ASSIGN TO EXTERNAL LINE ADVANCING SYSPRINT. - - DATA DIVISION. - FILE SECTION. - FD TRANSACTION-DATA - LABEL RECORDS ARE OMITTED - BLOCK CONTAINS 0 RECORDS - RECORD CONTAINS 80 CHARACTERS - DATA RECORD IS TRANSACTION-RECORD. - 01 TRANSACTION-RECORD. - 03 TR-CUSTOMER-NUMBER PIC 9(04). - 03 FILLER PIC X(01). - 03 TR-CUSTOMER-NAME PIC X(16). - 03 FILLER PIC X(01). - 03 TR-ITEM-NUMBER PIC 9(05). - 03 FILLER REDEFINES TR-ITEM-NUMBER. - 05 TR-ITEM-DEPARTMENT PIC 9(01). - 05 FILLER PIC 9(04). - 03 FILLER PIC X(01). - 03 TR-ITEM-COST PIC 9(03)V99. - 03 FILLER PIC X(47). - FD REPORT-FILE - LABEL RECORDS ARE OMITTED - REPORT IS NO-REPORT. - WORKING-STORAGE SECTION. - 01 END-OF-FILE-SWITCH PIC X(1) VALUE 'N'. - 88 END-OF-FILE VALUE 'Y'. - 88 GOFOREVER VALUE 'X'. - - REPORT SECTION. - RD SOME-REPORT - PAGE LIMIT IS 66 LINES - HEADING 1 - FIRST DETAIL 5 - LAST DETAIL 58. - - 01 PAGE-HEAD-GROUP TYPE PAGE HEADING. - 02 LINE 1. - 03 COLUMN 27 PIC X(41) VALUE - 'S A M P L E R E P O R T'. - 02 LINE PLUS 2. - 03 COLUMN 01 PIC X(09) VALUE 'CUST. NO.'. - 03 COLUMN 15 PIC X(10) VALUE 'CUST. NAME'. - 03 COLUMN 30 PIC X(05) VALUE 'DEPT.'. - 03 COLUMN 39 PIC X(08) VALUE 'ITEM NO.'. - 03 COLUMN 51 PIC X(09) VALUE 'ITEM COST'. - - 01 CHARGE-DETAIL TYPE DETAIL. - 02 LINE PLUS 1. - 03 COLUMN 03 PIC Z(04) SOURCE TR-CUSTOMER-NUMBER. - 03 COLUMN 10 PIC X(16) SOURCE TR-CUSTOMER-NAME. - 03 COLUMN 32 PIC 9(01) SOURCE TR-ITEM-DEPARTMENT. - 03 COLUMN 40 PIC 9(05) SOURCE TR-ITEM-NUMBER. - 03 COLUMN 51 PIC $$$$.99 SOURCE TR-ITEM-COST. - - PROCEDURE DIVISION. - - OPEN INPUT TRANSACTION-DATA, - OUTPUT REPORT-FILE. - - INITIATE CUSTOMER-REPORT. - - READ TRANSACTION-DATA - AT END - MOVE 'Y' TO END-OF-FILE-SWITCH - END-READ. - - PERFORM UNTIL GOFOREVER - GENERATE CHARGE-DETAIL - READ TRANSACTION-DATA - AT END - EXIT PERFORM - END-READ - END-PERFORM. - - TERMINATE CUSTOMER-REPORT. - - CLOSE TRANSACTION-DATA, - REPORT-FILE. - - STOP RUN. -]) - -AT_CHECK([$COMPILE_ONLY -std=mf-strict prog.cob], [1], [], -[prog.cob:17: warning: LABEL RECORDS is obsolete in Micro Focus COBOL -prog.cob:19: warning: RECORD clause ignored for LINE SEQUENTIAL -prog.cob:20: warning: DATA RECORDS is obsolete in Micro Focus COBOL -prog.cob:34: warning: LABEL RECORDS is obsolete in Micro Focus COBOL -prog.cob:42: error: 'SOME-REPORT' is not defined -prog.cob:42: error: 'SOME-REPORT' is not a valid report name -]) - -AT_CHECK([$COMPILE_ONLY -std=cobol2002 -fassign-ext-dyn=ok prog.cob], [1], [], -[prog.cob:17: error: syntax error, unexpected Identifier, expecting EXTERNAL or GLOBAL -prog.cob:34: error: syntax error, unexpected Identifier, expecting EXTERNAL or GLOBAL -prog.cob:36: error: RECORD description missing or invalid -prog.cob:42: error: 'SOME-REPORT' is not defined -prog.cob:42: error: 'SOME-REPORT' is not a valid report name -]) - -AT_CLEANUP - - -AT_SETUP([REPORT with PLUS RIGHT/CENTER]) -AT_KEYWORDS([report]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - ENVIRONMENT DIVISION. - CONFIGURATION SECTION. - INPUT-OUTPUT SECTION. - FILE-CONTROL. - SELECT INPUT-FILE ASSIGN TO EXTERNAL STUDENT - ORGANIZATION IS LINE SEQUENTIAL. - SELECT PRINT-FILE ASSIGN TO EXTERNAL - LINE ADVANCING REPORT1. - - DATA DIVISION. - FILE SECTION. - FD INPUT-FILE. - 01 INPUT-REC. - 05 STUDENT-ID PIC 9(5). - 05 STUDENT-NAME PIC X(20). - 05 MAJOR PIC XXX. - 05 NUM-COURSES PIC 9(6). - - FD PRINT-FILE - REPORT IS STUDENT-REPORT. - - WORKING-STORAGE SECTION. - 01 ARE-THERE-MORE-RECORDS PIC XXX VALUE "YES". - - REPORT SECTION. - RD STUDENT-REPORT - PAGE LIMIT 30 LINES - HEADING 1 - FIRST DETAIL 3 - LAST DETAIL 25 - FOOTING 28. - 01 HEADING-LINE - TYPE PAGE HEADING LINE PLUS 1. - 05 COLUMN 1 PIC X(2) VALUE "Ln". - 05 COLUMN 4 PIC X(6) VALUE "--ID--". - 05 COLUMN 16 PIC X(20) VALUE "--------Name--------". - 05 COLUMN 39 PIC X(5) VALUE " Mjr". - 05 COLUMN 48 PIC XXX VALUE "*-*". - 05 COLUMN 54 PIC X(5) VALUE "+Num+". - - 01 REPORT-LINE - TYPE DETAIL LINE PLUS 1. - 05 COLUMN PLUS 1 PIC 9(2) - SOURCE LINE-COUNTER OF STUDENT-REPORT. - 05 COLUMN LEFT PLUS 1 PIC Z(5)9 SOURCE STUDENT-ID. - 05 COLUMN CENTER 25 PIC X(20) SOURCE STUDENT-NAME. - 05 COLUMN RIGHT 43 PIC X(5) SOURCE MAJOR. - 05 COLUMN 48 PIC XXX VALUE "<->". - 05 COLUMN CENTER 56 PIC Z(4)9 SOURCE NUM-COURSES. - 05 COLUMN 60 62 65 PIC Z9 OCCURS 3 TIMES. - - PROCEDURE DIVISION. - A000-MAINLINE. - OPEN INPUT INPUT-FILE - OUTPUT PRINT-FILE - PERFORM DO-INIT. - READ INPUT-FILE - AT END - MOVE "NO" TO ARE-THERE-MORE-RECORDS. - PERFORM A001-LOOP - UNTIL ARE-THERE-MORE-RECORDS = "NO ". - PERFORM DO-TERM. - CLOSE INPUT-FILE - PRINT-FILE. - STOP RUN. - - A001-LOOP. - GENERATE REPORT-LINE. - READ INPUT-FILE - AT END - MOVE "NO " TO ARE-THERE-MORE-RECORDS. - DO-INIT. - INITIATE STUDENT-REPORT. - - DO-TERM. - TERMINATE STUDENT-REPORT. -]) - -AT_CHECK([$COMPILE_ONLY prog.cob], [1], [], -[prog.cob:46: warning: PLUS is ignored on first field of line -prog.cob:48: error: PLUS is not allowed with LEFT, RIGHT or CENTER -prog.cob:53: error: OCCURS and multi COLUMNs is not allowed -]) - -AT_CLEANUP - - -AT_SETUP([PAGE LIMITS clause]) -AT_KEYWORDS([report]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - - ENVIRONMENT DIVISION. - INPUT-OUTPUT SECTION. - FILE-CONTROL. - SELECT f ASSIGN "f.txt". - - DATA DIVISION. - FILE SECTION. - FD f REPORT r1, r2. - 01 f-rec PIC XXXXX. - - REPORT SECTION. - RD r1 PAGE LIMIT 1 LINES 1 COLUMNS - HEADING f-rec, - HEADING f-rec, - LINE LIMIT 1. - - RD r2 PAGE LIMIT 1 COLUMNS - HEADING f-rec. -]) - -AT_CHECK([$COMPILE_ONLY prog.cob], [1], [], -[prog.cob:19: error: duplicate HEADING clause -prog.cob:19: error: duplicate LINE LIMIT clause -prog.cob:22: error: Cannot specify HEADING without number of lines on page -]) -AT_CLEANUP - - -AT_SETUP([Report FD without period]) -AT_KEYWORDS([report]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - - ENVIRONMENT DIVISION. - INPUT-OUTPUT SECTION. - FILE-CONTROL. - SELECT f ASSIGN "f.txt". - - DATA DIVISION. - FILE SECTION. - FD f REPORT r -]) - -# In this case, the error handler enters an infinite loop, but it's OK as the -# error is still easy to identify and it doesn't occur if anything follows the -# "REPORT r". -AT_CHECK([$COMPILE_ONLY -fmax-errors=4 prog.cob], [97], [], -[prog.cob:13: error: syntax error, unexpected end of file -prog.cob:13: error: syntax error, unexpected end of file -prog.cob:13: error: syntax error, unexpected end of file -prog.cob:13: error: syntax error, unexpected end of file -prog.cob:13: error: syntax error, unexpected end of file -cobc: too many errors - -cobc: aborting compile of prog.cob at line 13 (PROGRAM-ID: prog) -]) -AT_CLEANUP - - -AT_SETUP([REPORT with unreferenced control field]) -AT_KEYWORDS([report]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - - ENVIRONMENT DIVISION. - INPUT-OUTPUT SECTION. - FILE-CONTROL. - SELECT f ASSIGN "f.txt". - - DATA DIVISION. - FILE SECTION. - FD f REPORT r. - 01 f-rec PIC X. - - REPORT SECTION. - RD r. - 01 r0 TYPE DETAIL, PRESENT AFTER NEW f-rec. -]) - -# no compile_only here as we check the C generation -AT_CHECK([$COMPILE prog.cob ], [0], [], []) - -AT_CLEANUP - - -AT_SETUP([Incorrect USAGE clause]) -AT_KEYWORDS([report]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - - ENVIRONMENT DIVISION. - INPUT-OUTPUT SECTION. - FILE-CONTROL. - SELECT report-file ASSIGN EXTERNAL PRINTOUT - ORGANIZATION LINE SEQUENTIAL. - - DATA DIVISION. - FILE SECTION. - FD report-file REPORT rp. - - WORKING-STORAGE SECTION. - 01 foo PIC X(20). - - REPORT SECTION. - RD rp PAGE LIMIT 3. - - 01 rp-detail TYPE DE. - 02 LINE PLUS 1. - 03 FILLER SOURCE foo PIC X(30). - 03 FILLER PIC X(6) VALUE "<--->". - 03 THING1 PIC 9(3) BINARY VALUE 12. - 03 FILLER PIC 9 COMP-5 VALUE 1. - 03 THING3 COMP-2 VALUE 12. - - PROCEDURE DIVISION. - OPEN OUTPUT report-file. - INITIATE rp. - - MOVE "hello" TO foo. - GENERATE rp-detail. - - MOVE "goodbye" TO foo. - GENERATE rp-detail. - - TERMINATE rp. - CLOSE report-file. - STOP RUN. - END PROGRAM prog. -]) - -AT_CHECK([$COMPILE prog.cob], [1], [], -[prog.cob:25: error: REPORT SECTION item 'THING1' should be USAGE DISPLAY -prog.cob:26: error: REPORT SECTION item 'FILLER 4' should be USAGE DISPLAY -prog.cob:27: error: REPORT SECTION item 'THING3' should be USAGE DISPLAY -]) - -AT_CLEANUP - diff -Nru gnucobol-4.0~early~20200606/tests/testsuite.src/syn_screen.at gnucobol-5/tests/testsuite.src/syn_screen.at --- gnucobol-4.0~early~20200606/tests/testsuite.src/syn_screen.at 2020-06-06 20:52:00.000000000 +0000 +++ gnucobol-5/tests/testsuite.src/syn_screen.at 1970-01-01 00:00:00.000000000 +0000 @@ -1,831 +0,0 @@ -## Copyright (C) 2014-2019 Free Software Foundation, Inc. -## Written by Simon Sobisch, Edward Hart, Ron Norman -## -## This file is part of GnuCOBOL. -## -## The GnuCOBOL compiler is free software: you can redistribute it -## and/or modify it under the terms of the GNU General Public License -## as published by the Free Software Foundation, either version 3 of the -## License, or (at your option) any later version. -## -## GnuCOBOL is distributed in the hope that it will be useful, -## but WITHOUT ANY WARRANTY; without even the implied warranty of -## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -## GNU General Public License for more details. -## -## You should have received a copy of the GNU General Public License -## along with GnuCOBOL. If not, see . - -### GnuCOBOL Test Suite - -### ISO+IEC+1989-2014 13.9 SCREEN section - - -AT_SETUP([Flexible ACCEPT/DISPLAY syntax]) -AT_KEYWORDS([screen ACCEPT DISPLAY]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - - ENVIRONMENT DIVISION. - CONFIGURATION SECTION. - SPECIAL-NAMES. - SYSERR IS ERR-STREAM - . - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 a-field PIC XXX. - - SCREEN SECTION. - 01 scr. - 03 VALUE "blah" LINE 5 COL 5. - - PROCEDURE DIVISION. - *> Valid statements - DISPLAY "123" "456" "789" NO ADVANCING - DISPLAY "foo" COL 1 HIGHLIGHT AT LINE 1 WITH UNDERLINE, - "bar", "foo" - DISPLAY "a" UPON CRT, "b" LINE 3 COL 3, "c" UPON CRT-UNDER - DISPLAY scr, scr - - ACCEPT a-field LINE 5 SIZE 3 AT COL 1 WITH AUTO WITH - REVERSE-VIDEO, BLINK - - *> invalid statements - DISPLAY scr WITH NO ADVANCING - DISPLAY scr, scr LINE 2 COL 2 UPON ERR-STREAM - DISPLAY "foo" LINE 2 COL 2, scr - DISPLAY "foo" LINE 2 COL 2, "bar" UPON ERR-STREAM - DISPLAY "foo" LINE 1 UPON ERR-STREAM - DISPLAY scr, "foo" - . - END PROGRAM prog. - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog-2. - - ENVIRONMENT DIVISION. - CONFIGURATION SECTION. - SPECIAL-NAMES. - CONSOLE IS CRT - . - PROCEDURE DIVISION. - DISPLAY "foo" NO ADVANCING - . - END PROGRAM prog-2. -]) - -AT_CHECK([$COMPILE_ONLY prog.cob], [1], [], -[prog.cob:31: error: cannot specify NO ADVANCING in screen DISPLAY -prog.cob:31: error: screens may only be displayed on CRT -prog.cob:32: error: cannot mix screens and fields in the same DISPLAY statement -prog.cob:33: error: ambiguous DISPLAY; put items to display on device in separate DISPLAY -prog.cob:34: error: screen clauses may only be used for DISPLAY on CRT -prog.cob:35: error: cannot mix screens and fields in the same DISPLAY statement -prog.cob:49: error: cannot specify NO ADVANCING in screen DISPLAY -]) - -AT_CLEANUP - - -AT_SETUP([Duplicate ACCEPT/DISPLAY clauses]) -AT_KEYWORDS([screen ACCEPT DISPLAY]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 a-field PIC XXX. - PROCEDURE DIVISION. - DISPLAY "foo" LINE 1 COL 1 HIGHLIGHT LINE 1 HIGHLIGHT - AT 0101 MODE IS BLOCK MODE IS BLOCK - ACCEPT a-field LINE 1 COL 1 HIGHLIGHT LINE 1 HIGHLIGHT - AT 0101 - . -]) - -AT_CHECK([$COMPILE_ONLY prog.cob], [1], [], -[prog.cob:8: error: duplicate LINE clause -prog.cob:8: error: duplicate HIGHLIGHT clause -prog.cob:9: error: cannot specify both AT screen-location and LINE or COLUMN -prog.cob:9: error: duplicate MODE IS BLOCK clause -prog.cob:10: error: duplicate LINE clause -prog.cob:10: error: duplicate HIGHLIGHT clause -prog.cob:11: error: cannot specify both AT screen-location and LINE or COLUMN -]) -AT_CLEANUP - - -AT_SETUP([AT clause]) -AT_KEYWORDS([screen extensions]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 curs-1 PIC 9(4) VALUE 00000000001111. - 01 curs-2. - 03 linee PIC 999. - 03 coll PIC 999. - 01 posc CONSTANT 0101. - - 01 curs-3 PIC 99. - 01 curs-4 PIC 9(8) VALUE 0101. - 01 curs-5 PIC X(4). - - PROCEDURE DIVISION. - *> Valid AT clauses - DISPLAY "a" AT curs-1 - DISPLAY "a" AT curs-2 - DISPLAY "a" AT posc - - *> Invalid AT clauses - DISPLAY "a" AT curs-3 - DISPLAY "a" AT curs-4 - DISPLAY "a" AT curs-5 - DISPLAY "a" AT 101 - DISPLAY "a" AT ZERO - . -]) - -AT_CHECK([$COMPILE_ONLY prog.cob], [1], [], -[prog.cob:24: error: value in AT clause must have 4 or 6 digits -prog.cob:25: error: value in AT clause must have 4 or 6 digits -prog.cob:26: error: value in AT clause is not numeric -prog.cob:27: error: value in AT clause must have 4 or 6 digits -prog.cob:29: error: cannot specify figurative constant ZERO in AT clause -]) -AT_CLEANUP - - -AT_SETUP([ACCEPT/DISPLAY extensions detection]) -AT_KEYWORDS([AT LINE COLUMN ACCEPT DISPLAY screen extensions]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 zero-const CONSTANT 0. - 01 x PIC 99. - - SCREEN SECTION. - 01 scr. - 03 y PIC 99 FROM x LINE 3 COLUMN 5. - - PROCEDURE DIVISION. - DISPLAY "hello" AT 0000 - DISPLAY "world" LINE ZERO COLUMN zero-const - ACCEPT x WITH TIME-OUT 5 - - DISPLAY scr WITH UNDERLINE - ACCEPT scr WITH HIGHLIGHT - - DISPLAY scr, scr - - *> Valid statements - DISPLAY scr UPON CRT-UNDER - ACCEPT scr AT LINE 4 COLUMN 4 - . -]) - -AT_CHECK([$COMPILE_ONLY -faccept-display-extensions=error prog.cob], [1], [], -[prog.cob:15: error: AT clause used -prog.cob:15: error: non-standard DISPLAY used -prog.cob:16: error: LINE 0 used -prog.cob:16: error: COLUMN 0 used -prog.cob:16: error: non-standard DISPLAY used -prog.cob:17: error: non-standard ACCEPT used -prog.cob:19: error: non-standard DISPLAY used -prog.cob:20: error: non-standard ACCEPT used -prog.cob:22: error: non-standard DISPLAY used -]) -AT_CLEANUP - - -AT_SETUP([FROM clause]) -AT_KEYWORDS([screen]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 X PIC X. - SCREEN SECTION. - 01 SG. - 05 SI1 LINE 1 COL 1 PIC X FROM X. - 05 SI2 LINE 2 COL 1 PIC X FROM SPACE. - 05 SI2-2 LINE 2 COL 5 PIC X(03) FROM ALL SPACES. - 05 SI3 LINE 3 COL 1 PIC 9 FROM ZERO. - 05 SI3-2 LINE 3 COL 5 PIC X(03) FROM ALL ZEROES. - PROCEDURE DIVISION. - DISPLAY SG END-DISPLAY. - STOP RUN. -]) - -AT_CHECK([$COMPILE_ONLY prog.cob], [0], [], []) - -AT_CLEANUP - - -AT_SETUP([Incorrect USAGE clause]) -AT_KEYWORDS([screen]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 X PIC X. - SCREEN SECTION. - 01 SG. - 05 SI1 LINE 1 COL 1 PIC X FROM X. - 05 SI2 LINE 2 COL 1 PIC X FROM SPACE. - 05 SI2-2 LINE 2 COL 5 PIC X(03) FROM ALL SPACES. - 05 BAD1 LINE 4 COL 1 PIC 9 BINARY FROM ZERO. - 05 FILLER LINE 4 COL 10 PIC 9 COMP-5 FROM ZERO. - 05 BAD3 LINE 4 COL 5 COMP-2 FROM ALL ZEROES. - PROCEDURE DIVISION. - DISPLAY SG END-DISPLAY. - STOP RUN. -]) - -AT_CHECK([$COMPILE prog.cob], [1], [], -[prog.cob:12: error: SCREEN SECTION item 'BAD1' should be USAGE DISPLAY -prog.cob:13: error: SCREEN SECTION item 'FILLER' should be USAGE DISPLAY -prog.cob:14: error: SCREEN SECTION item 'BAD3' should be USAGE DISPLAY -]) - -AT_CLEANUP - - -AT_SETUP([SCREEN SECTION clause numbers]) -AT_KEYWORDS([screen]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - SCREEN SECTION. - *> Valid numbers - 01 v1 VALUE "-" LINE 1. - 01 v2 VALUE "-" LINE + 1. - 01 v3 VALUE "-" LINE - 1. - 01 v4 VALUE "-" LINE 0. - - *> invalid numbers - 01 i1 VALUE "-" LINE +1. - 01 i2 VALUE "-" LINE -1. - 01 i3 VALUE "-" LINE 1.0. - PROCEDURE DIVISION. - STOP RUN. -]) - -AT_CHECK([$COMPILE_ONLY prog.cob], [1], [], -[prog.cob:13: error: unsigned integer value expected -prog.cob:14: error: unsigned integer value expected -prog.cob:15: error: unsigned integer value expected -]) - -AT_CLEANUP - - -# ToDo: Add all clauses, maybe split into multiple tests -AT_SETUP([Screen clauses]) -AT_KEYWORDS([screen]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 foo PIC X. - SCREEN SECTION. - 01 scr. - 03 a PIC X TO foo FULL, LEFTLINE, OVERLINE, REQUIRED, - GRID. - PROCEDURE DIVISION. - STOP RUN. -]) - -AT_CHECK([$COMPILE_ONLY prog.cob], [0], [], -[prog.cob:9: warning: LEFTLINE is not implemented -prog.cob:9: warning: OVERLINE is not implemented -prog.cob:10: warning: GRID is not implemented -]) - -AT_CLEANUP - - -AT_SETUP([ACCEPT ON EXCEPTION/ESCAPE]) -AT_KEYWORDS([screen]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 foo PIC X. - PROCEDURE DIVISION. - ACCEPT foo - ON EXCEPTION - CONTINUE - NOT EXCEPTION - CONTINUE - END-ACCEPT - - ACCEPT foo - ESCAPE - CONTINUE - NOT ON ESCAPE - CONTINUE - END-ACCEPT - . -]) - -AT_CHECK([$COMPILE_ONLY prog.cob], [0], [], []) -AT_CLEANUP - - -AT_SETUP([Referencing 88-level]) -# see bug #178 -AT_KEYWORDS([screen]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 flag PIC X. - 88 blah VALUE "N". - - SCREEN SECTION. - 01 scr. - 03 PIC X COLUMN blah TO blah FROM blah. - - PROCEDURE DIVISION. - ACCEPT scr - . -]) - -AT_CHECK([$COMPILE_ONLY prog.cob], [1], [], -[prog.cob:12: error: condition-name not allowed here: 'blah' -prog.cob:12: error: condition-name not allowed here: 'blah' -prog.cob:12: error: condition-name not allowed here: 'blah' -]) - -AT_CLEANUP - - -AT_SETUP([Conflicting screen clauses]) -AT_KEYWORDS([screen]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 x PIC 999. - - SCREEN SECTION. - 01 scr. - 03 VALUE "foo" HIGHLIGHT, LOWLIGHT; - ERASE EOL, ERASE EOS; - BLANK LINE, BLANK SCREEN. - - PROCEDURE DIVISION. - DISPLAY "blah" WITH HIGHLIGHT, LOWLIGHT; - ERASE EOL, ERASE EOS; - BLANK LINE, BLANK SCREEN; - SCROLL UP, SCROLL DOWN; - - ACCEPT x WITH AUTO, TAB; SCROLL UP, SCROLL DOWN; - UPDATE, NO UPDATE - - SET scr ATTRIBUTE HIGHLIGHT ON, LOWLIGHT OFF - . -]) - -AT_CHECK([$COMPILE_ONLY prog.cob], [1], [], -[prog.cob:11: error: cannot specify both LOWLIGHT and HIGHLIGHT -prog.cob:12: error: cannot specify both ERASE EOS and ERASE EOL -prog.cob:13: error: cannot specify both BLANK SCREEN and BLANK LINE -prog.cob:16: error: cannot specify both LOWLIGHT and HIGHLIGHT -prog.cob:17: error: cannot specify both ERASE EOS and ERASE EOL -prog.cob:18: error: cannot specify both BLANK SCREEN and BLANK LINE -prog.cob:21: error: cannot specify both SCROLL DOWN and SCROLL UP -prog.cob:21: error: cannot specify both TAB and AUTO -prog.cob:22: error: cannot specify both SCROLL DOWN and SCROLL UP -prog.cob:22: error: cannot specify both NO UPDATE and UPDATE -prog.cob:24: error: cannot specify both HIGHLIGHT and LOWLIGHT -]) - -AT_CHECK([$COMPILE_ONLY -frelax-syntax-checks prog.cob], [1], [], -[prog.cob:11: warning: cannot specify both LOWLIGHT and HIGHLIGHT; LOWLIGHT is ignored -prog.cob:12: warning: cannot specify both ERASE EOS and ERASE EOL; ERASE EOS is ignored -prog.cob:13: warning: cannot specify both BLANK SCREEN and BLANK LINE; BLANK SCREEN is ignored -prog.cob:16: warning: cannot specify both LOWLIGHT and HIGHLIGHT; LOWLIGHT is ignored -prog.cob:17: warning: cannot specify both ERASE EOS and ERASE EOL; ERASE EOS is ignored -prog.cob:18: warning: cannot specify both BLANK SCREEN and BLANK LINE; BLANK SCREEN is ignored -prog.cob:21: warning: cannot specify both SCROLL DOWN and SCROLL UP; SCROLL DOWN is ignored -prog.cob:21: warning: cannot specify both TAB and AUTO; TAB is ignored -prog.cob:22: warning: cannot specify both SCROLL DOWN and SCROLL UP; SCROLL DOWN is ignored -prog.cob:22: warning: cannot specify both NO UPDATE and UPDATE; NO UPDATE is ignored -prog.cob:24: error: cannot specify both HIGHLIGHT and LOWLIGHT -]) - -AT_CLEANUP - - -AT_SETUP([Redundant screen clauses]) -AT_KEYWORDS([screen]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 x PIC 999. - - SCREEN SECTION. - 01 scr. - 03 HIGHLIGHT FULL. - 05 HIGHLIGHT FULL. - 07 FULL FULL VALUE "foo". - - PROCEDURE DIVISION. - DISPLAY "hello" WITH BACKGROUND-COLOR 2, BACKGROUND-COLOR 2 - ACCEPT x WITH HIGHLIGHT, HIGHLIGHT, UPDATE, DEFAULT - . -]) - -AT_CHECK([$COMPILE_ONLY prog.cob], [1], [], -[prog.cob:13: error: duplicate FULL clause -prog.cob:16: error: duplicate BACKGROUND-COLOR clause -prog.cob:17: error: duplicate HIGHLIGHT clause -prog.cob:17: error: duplicate UPDATE clause -]) - -AT_CLEANUP - - -AT_SETUP([Screen item OCCURS w-/wo relative LINE/COL]) -AT_KEYWORDS([occurs]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - SCREEN SECTION. - 01 x-scr. - 03 x PIC X VALUE "a" OCCURS 10. -]) - -AT_DATA([prog2.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog2. - DATA DIVISION. - SCREEN SECTION. - 01 x-scr. - 03 x PIC X VALUE "a" OCCURS 10 COL 10. - 01 y-scr. - 03 y PIC X VALUE "a" OCCURS 10 LINE 10. -]) - -AT_DATA([prog3.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog3. - DATA DIVISION. - SCREEN SECTION. - 01 x-scr. - 03 x PIC X VALUE "a" OCCURS 10 COL + 10. - 01 y-scr. - 03 y PIC X VALUE "a" OCCURS 10 LINE - 10. - 01 a-scr. - 03 a PIC X VALUE "a" OCCURS 10 COL PLUS 10. - 01 b-scr. - 03 b PIC X VALUE "a" OCCURS 10 LINE MINUS 10. -]) - -AT_CHECK([$COMPILE_ONLY prog.cob], [1], [], -[prog.cob:7: warning: OCCURS screen items is not implemented -prog.cob:7: error: relative LINE/COLUMN clause required with OCCURS -]) - -AT_CHECK([$COMPILE_ONLY prog2.cob], [1], [], -[prog2.cob:7: warning: OCCURS screen items is not implemented -prog2.cob:7: error: relative LINE/COLUMN clause required with OCCURS -prog2.cob:9: warning: OCCURS screen items is not implemented -prog2.cob:9: error: relative LINE/COLUMN clause required with OCCURS -]) - -AT_CHECK([$COMPILE_ONLY prog3.cob], [0], [], -[prog3.cob:7: warning: OCCURS screen items is not implemented -prog3.cob:9: warning: OCCURS screen items is not implemented -prog3.cob:11: warning: OCCURS screen items is not implemented -prog3.cob:13: warning: OCCURS screen items is not implemented -]) - -AT_CLEANUP - - -AT_SETUP([VALUE clause missing]) -AT_KEYWORDS([screen]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - SCREEN SECTION. - 01 SG. - 05 LINE 21 COL 1 VALUE "TESTING". - 05 " IMPLICIT VALUE " HIGHLIGHT. - PROCEDURE DIVISION. - DISPLAY SG END-DISPLAY. - STOP RUN. -]) - -AT_CHECK([$COMPILE_ONLY prog.cob], [1], [], -[prog.cob:9: error: syntax error, unexpected Literal -]) - -AT_CLEANUP - - -AT_SETUP([FULL on numeric item]) -AT_KEYWORDS([screen]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 num PIC 999. - - SCREEN SECTION. - 01 scr. - 03 full-pointless PIC 999 TO num FULL. - 03 full-useful PIC ZZZ TO num FULL. -]) - -AT_CHECK([$COMPILE_ONLY prog.cob], [0], [], -[prog.cob:11: warning: FULL has no effect on numeric items; you may want REQUIRED or PIC Z -]) - -AT_CLEANUP - - -AT_SETUP([Compiler-specific SCREEN SECTION clause rules]) -AT_KEYWORDS([screen]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 x PIC X. - 01 num PIC 9. - - SCREEN SECTION. - 01 scr. - 03 no-clauses. - 03 no-required-clauses BACKGROUND-COLOR 1. - 03 only-line LINE 1. - 03 numeric-pic-and-value PIC 999 VALUE 100. - 03 only-pic PIC 9. - 03 from-to-using-without-pic FROM x. - 03 auto-without-from-to-using PIC 9 AUTO. - 03 full-without-to-using PIC X FROM x FULL. - 03 full-and-justified PIC X USING x, FULL, JUST. - 03 secure-with-from PIC X FROM x SECURE. - 03 secure-justified-no-clauses VALUE "Hello" SECURE, JUST. - 03 blank-when-zero-without-pic FROM num, BLANK ZERO. - 03 justified-without-pic FROM x, JUST. - 03 sign-no-clauses PIC S9, SIGN LEADING SEPARATE. - 03 figurative-constant-value VALUE SPACES. - 03 only-erase ERASE EOL. - 03 only-blank BLANK SCREEN. - 03 only-bell BELL. - 03 numeric-value-no-pic VALUE 1. - - 01 always-ok-scr. - 03 my-group LINE 1, COL 1, FULL. - 05 PIC X FROM "x" TO x. - 05 PIC Z USING num. - 05 VALUE "Hello, world!". -]) - -AT_CHECK([$COMPILE_ONLY -fscreen-section-rules=std prog.cob], [1], [], -[prog.cob:12: error: 'no-clauses' needs a PIC, FROM, TO, USING, VALUE, BELL, BLANK or ERASE clause -prog.cob:13: error: 'no-required-clauses' needs a PIC, FROM, TO, USING, VALUE, BELL, BLANK or ERASE clause -prog.cob:14: error: 'only-line' needs a PIC, FROM, TO, USING, VALUE, BELL, BLANK or ERASE clause -prog.cob:16: error: 'only-pic' cannot have PIC without FROM, TO, USING or numeric VALUE -prog.cob:17: warning: 'from-to-using-without-pic' has FROM, TO or USING without PIC; PIC will be implied -prog.cob:18: error: 'auto-without-from-to-using' cannot have PIC without FROM, TO, USING or numeric VALUE -prog.cob:20: error: cannot specify both FULL and JUSTIFIED -prog.cob:23: warning: 'blank-when-zero-without-pic' has FROM, TO or USING without PIC; PIC will be implied -prog.cob:24: warning: 'justified-without-pic' has FROM, TO or USING without PIC; PIC will be implied -prog.cob:25: error: 'sign-no-clauses' cannot have PIC without FROM, TO, USING or numeric VALUE -prog.cob:26: error: VALUE may not contain a figurative constant -prog.cob:30: warning: 'numeric-value-no-pic' has numeric VALUE without PIC; PIC will be implied -]) - -AT_CHECK([$COMPILE_ONLY -fscreen-section-rules=acu prog.cob], [1], [], -[prog.cob:15: error: cannot specify both PIC and VALUE -prog.cob:15: error: cannot have PIC without FROM, TO or USING -prog.cob:15: error: VALUE item may not be numeric -prog.cob:16: error: cannot have PIC without FROM, TO or USING -prog.cob:17: warning: 'from-to-using-without-pic' has FROM, TO or USING without PIC; PIC will be implied -prog.cob:18: error: cannot have PIC without FROM, TO or USING -prog.cob:22: error: cannot have JUSTIFIED without PIC -prog.cob:23: warning: 'blank-when-zero-without-pic' has FROM, TO or USING without PIC; PIC will be implied -prog.cob:23: error: cannot have BLANK WHEN ZERO without PIC -prog.cob:24: warning: 'justified-without-pic' has FROM, TO or USING without PIC; PIC will be implied -prog.cob:24: error: cannot have JUSTIFIED without PIC -prog.cob:25: error: cannot have PIC without FROM, TO or USING -prog.cob:30: error: VALUE item may not be numeric -]) - -AT_CHECK([$COMPILE_ONLY -fscreen-section-rules=mf prog.cob], [1], [], -[prog.cob:12: error: 'no-clauses' needs a PIC, COL, LINE, VALUE, BELL or BLANK clause -prog.cob:13: error: 'no-required-clauses' needs a PIC, COL, LINE, VALUE, BELL or BLANK clause -prog.cob:15: error: cannot specify both PIC and VALUE -prog.cob:15: error: cannot have PIC without FROM, TO or USING -prog.cob:15: error: VALUE item may not be numeric -prog.cob:16: error: cannot have PIC without FROM, TO or USING -prog.cob:17: error: 'from-to-using-without-pic' needs a PIC, COL, LINE, VALUE, BELL or BLANK clause -prog.cob:17: warning: 'from-to-using-without-pic' has FROM, TO or USING without PIC; PIC will be implied -prog.cob:18: error: cannot have PIC without FROM, TO or USING -prog.cob:18: error: cannot use AUTO, FULL, PROMPT, REQUIRED or SECURE on elementary item without TO or USING -prog.cob:19: error: cannot use AUTO, FULL, PROMPT, REQUIRED or SECURE on elementary item without TO or USING -prog.cob:21: error: cannot use AUTO, FULL, PROMPT, REQUIRED or SECURE on elementary item without TO or USING -prog.cob:22: error: cannot use AUTO, FULL, PROMPT, REQUIRED or SECURE on elementary item without TO or USING -prog.cob:22: error: cannot use BLANK WHEN ZERO, JUSTIFIED, OCCURS or SIGN on item without FROM, TO or USING -prog.cob:23: error: 'blank-when-zero-without-pic' needs a PIC, COL, LINE, VALUE, BELL or BLANK clause -prog.cob:23: warning: 'blank-when-zero-without-pic' has FROM, TO or USING without PIC; PIC will be implied -prog.cob:24: error: 'justified-without-pic' needs a PIC, COL, LINE, VALUE, BELL or BLANK clause -prog.cob:24: warning: 'justified-without-pic' has FROM, TO or USING without PIC; PIC will be implied -prog.cob:25: error: cannot have PIC without FROM, TO or USING -prog.cob:25: error: cannot use BLANK WHEN ZERO, JUSTIFIED, OCCURS or SIGN on item without FROM, TO or USING -prog.cob:26: error: VALUE may not contain a figurative constant -prog.cob:27: error: 'only-erase' needs a PIC, COL, LINE, VALUE, BELL or BLANK clause -prog.cob:30: error: VALUE item may not be numeric -prog.cob:36: error: cannot use AUTO, FULL, PROMPT, REQUIRED or SECURE on elementary item without TO or USING -]) - -AT_CHECK([$COMPILE_ONLY -fscreen-section-rules=rm prog.cob], [1], [], -[prog.cob:15: error: cannot specify both PIC and VALUE -prog.cob:15: error: cannot have PIC without FROM, TO or USING -prog.cob:15: error: VALUE item may not be numeric -prog.cob:16: error: cannot have PIC without FROM, TO or USING -prog.cob:17: error: cannot have FROM, TO or USING without PIC -prog.cob:18: error: cannot have PIC without FROM, TO or USING -prog.cob:22: error: cannot use AUTO, FULL, REQUIRED or SECURE on elementary item without FROM, TO or USING -prog.cob:22: error: cannot use BLANK WHEN ZERO, JUSTIFIED or SIGN without FROM, TO or USING -prog.cob:23: error: cannot have FROM, TO or USING without PIC -prog.cob:23: error: cannot use BLANK WHEN ZERO, JUSTIFIED or SIGN without FROM, TO or USING -prog.cob:24: error: cannot have FROM, TO or USING without PIC -prog.cob:24: error: cannot use BLANK WHEN ZERO, JUSTIFIED or SIGN without FROM, TO or USING -prog.cob:25: error: cannot have PIC without FROM, TO or USING -prog.cob:30: error: VALUE item may not be numeric -prog.cob:36: error: cannot use AUTO, FULL, REQUIRED or SECURE on elementary item without FROM, TO or USING -]) - -AT_CHECK([$COMPILE_ONLY -fscreen-section-rules=xopen prog.cob], [1], [], -[prog.cob:12: error: 'no-clauses' needs a PIC, COL, LINE, VALUE, BELL or BLANK clause -prog.cob:13: error: 'no-required-clauses' needs a PIC, COL, LINE, VALUE, BELL or BLANK clause -prog.cob:15: error: cannot specify both PIC and VALUE -prog.cob:15: error: cannot have PIC without FROM, TO or USING -prog.cob:15: error: VALUE item may not be numeric -prog.cob:16: error: cannot have PIC without FROM, TO or USING -prog.cob:17: error: 'from-to-using-without-pic' needs a PIC, COL, LINE, VALUE, BELL or BLANK clause -prog.cob:17: error: cannot have FROM, TO or USING without PIC -prog.cob:18: error: cannot have PIC without FROM, TO or USING -prog.cob:18: error: cannot have AUTO without FROM, TO or USING -prog.cob:19: error: cannot use FULL or REQUIRED on item without TO or USING -prog.cob:20: error: cannot specify both FULL and JUSTIFIED -prog.cob:21: error: SECURE can be used with TO only -prog.cob:22: error: SECURE must be used with TO -prog.cob:23: error: 'blank-when-zero-without-pic' needs a PIC, COL, LINE, VALUE, BELL or BLANK clause -prog.cob:23: error: cannot have FROM, TO or USING without PIC -prog.cob:24: error: 'justified-without-pic' needs a PIC, COL, LINE, VALUE, BELL or BLANK clause -prog.cob:24: error: cannot have FROM, TO or USING without PIC -prog.cob:25: error: cannot have PIC without FROM, TO or USING -prog.cob:27: error: 'only-erase' needs a PIC, COL, LINE, VALUE, BELL or BLANK clause -prog.cob:30: error: VALUE item may not be numeric -prog.cob:36: error: cannot use FULL or REQUIRED on item without TO or USING -]) - -AT_CHECK([$COMPILE_ONLY -fscreen-section-rules=gc prog.cob], [0], [], -[prog.cob:12: warning: 'no-clauses' does nothing -prog.cob:13: warning: 'no-required-clauses' does nothing -prog.cob:15: warning: 'numeric-pic-and-value' has numeric VALUE without PIC; PIC will be implied -prog.cob:16: warning: 'only-pic' does nothing -prog.cob:17: warning: 'from-to-using-without-pic' has FROM, TO or USING without PIC; PIC will be implied -prog.cob:18: warning: 'auto-without-from-to-using' does nothing -prog.cob:23: warning: 'blank-when-zero-without-pic' has FROM, TO or USING without PIC; PIC will be implied -prog.cob:24: warning: 'justified-without-pic' has FROM, TO or USING without PIC; PIC will be implied -prog.cob:25: warning: 'sign-no-clauses' does nothing -prog.cob:30: warning: 'numeric-value-no-pic' has numeric VALUE without PIC; PIC will be implied -]) - -AT_CLEANUP - - -AT_SETUP([MS-COBOL position-spec]) -AT_KEYWORDS([screen position LIN COL]) - -# FIXME: WITH clause including a WITH COLUMN (both separate (working) -# and combined - error - must be added - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 FIELD-A PIC X(06) VALUE "ms-cob". - 01 A PIC X. - PROCEDURE DIVISION. - DISPLAY ERASE - MOVE 10 TO LIN. MOVE 15 TO COL. - DISPLAY (LIN , COL - 3) FIELD-A. - DISPLAY (LIN + 1 , COL) FIELD-A. - ACCEPT ( , 10) A. - DISPLAY (08 , 12) FIELD-A. - ACCEPT ( , 08) A WITH NO-ECHO. - DISPLAY FIELD-A AT LINE 06 COLUMN 12. - ACCEPT A AT COLUMN 8. - SUBTRACT 2 FROM LIN. - SUBTRACT 3 FROM COL. - DISPLAY FIELD-A AT LINE LIN COLUMN COL. - ACCEPT ( , 10) A. - DISPLAY ( 1 , 1 ) ERASE. - DISPLAY ( 2 , 1 ) "Field value : ", FIELD-A. - DISPLAY ( 3 , 1 ) A " --> A value" - DISPLAY ( 5 , 1 ) "Press ENTER to exit". - ACCEPT (11 , 1 ) A. - STOP RUN. -]) - -AT_CHECK([$COMPILE_ONLY prog.cob], [1], [], -[prog.cob:10: error: 'LIN' is not defined -prog.cob:10: error: syntax error, unexpected COL -prog.cob:11: error: 'LIN' is not defined -prog.cob:11: error: syntax error, unexpected COL, expecting Literal or [)] or Identifier -prog.cob:12: error: 'LIN' is not defined -prog.cob:12: error: syntax error, unexpected COL, expecting Literal or [)] or Identifier -prog.cob:18: error: 'LIN' is not defined -prog.cob:19: error: syntax error, unexpected COL -prog.cob:20: error: 'LIN' is not defined -prog.cob:20: error: syntax error, unexpected COL, expecting Literal or Identifier or ZERO -]) -AT_CHECK([$COMPILE_ONLY -fregister=LIN,COL prog.cob], [0], [], []) - -AT_CLEANUP - - -AT_SETUP([Screen with invalid FROM clause]) -AT_KEYWORDS([screen constant]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 some-const CONSTANT AS '123'. - - SCREEN SECTION. - 01 bild. - 05 from-constant-with-size FROM some-const. - 05 from-constant-without-pic FROM ZERO. - 05 LINE 24 COL 1 FROM message. -]) - -AT_CHECK([$COMPILE_ONLY prog.cob], [1], [], -[prog.cob:13: error: syntax error, unexpected MESSAGE -prog.cob:11: warning: 'from-constant-with-size' has FROM, TO or USING without PIC; PIC will be implied -prog.cob:12: warning: 'from-constant-without-pic' has FROM, TO or USING without PIC; PIC will be implied -prog.cob:12: error: PICTURE clause required for 'from-constant-without-pic' -]) -AT_CHECK([$COMPILE_ONLY -fnot-reserved=MESSAGE prog.cob], [1], [], -[prog.cob:13: error: 'message' is not defined, but is a reserved word in another dialect -prog.cob:11: warning: 'from-constant-with-size' has FROM, TO or USING without PIC; PIC will be implied -prog.cob:12: warning: 'from-constant-without-pic' has FROM, TO or USING without PIC; PIC will be implied -prog.cob:12: error: PICTURE clause required for 'from-constant-without-pic' -prog.cob:13: warning: 'FILLER' has FROM, TO or USING without PIC; PIC will be implied -]) - -AT_CLEANUP diff -Nru gnucobol-4.0~early~20200606/tests/testsuite.src/syn_set.at gnucobol-5/tests/testsuite.src/syn_set.at --- gnucobol-4.0~early~20200606/tests/testsuite.src/syn_set.at 2020-06-06 20:52:00.000000000 +0000 +++ gnucobol-5/tests/testsuite.src/syn_set.at 1970-01-01 00:00:00.000000000 +0000 @@ -1,78 +0,0 @@ -## Copyright (C) 2003-2012, 2014, 2017-2018 Free Software Foundation, Inc. -## Written by Keisuke Nishida, Roger While, Simon Sobisch -## -## This file is part of GnuCOBOL. -## -## The GnuCOBOL compiler is free software: you can redistribute it -## and/or modify it under the terms of the GNU General Public License -## as published by the Free Software Foundation, either version 3 of the -## License, or (at your option) any later version. -## -## GnuCOBOL is distributed in the hope that it will be useful, -## but WITHOUT ANY WARRANTY; without even the implied warranty of -## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -## GNU General Public License for more details. -## -## You should have received a copy of the GNU General Public License -## along with GnuCOBOL. If not, see . - -### GnuCOBOL Test Suite - -### ISO+IEC+1989-2002 14.8.35 SET statement - - -AT_SETUP([SET ADDRESS OF item]) -AT_KEYWORDS([set]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 X PIC X. - - LINKAGE SECTION. - 01 Y BASED. - 03 Z PIC X. - - PROCEDURE DIVISION. - SET ADDRESS OF X TO NULL. - SET ADDRESS OF Z TO NULL. - STOP RUN. -]) - -AT_CHECK([$COMPILE_ONLY prog.cob], [1], [], -[prog.cob:14: error: cannot change address of 'X', which is not BASED or a LINKAGE item -prog.cob:15: error: cannot change address of 'Z', which is not level 1 or 77 -]) - -AT_CLEANUP - - -AT_SETUP([SET item TO 88-level]) -AT_KEYWORDS([set]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 X PIC 9. - 88 x-wrong-init value space. - 01 Y PIC X. - 88 y-wrong-init value low-value. - - PROCEDURE DIVISION. - SET x-wrong-init TO TRUE. - SET y-wrong-init TO TRUE. - STOP RUN. -]) - -AT_CHECK([$COMPILE_ONLY prog.cob], [1], [], -[prog.cob:8: error: literal type does not match numeric data type -prog.cob:13: error: invalid SET statement -]) - -AT_CLEANUP diff -Nru gnucobol-4.0~early~20200606/tests/testsuite.src/syn_subscripts.at gnucobol-5/tests/testsuite.src/syn_subscripts.at --- gnucobol-4.0~early~20200606/tests/testsuite.src/syn_subscripts.at 2020-06-06 20:52:00.000000000 +0000 +++ gnucobol-5/tests/testsuite.src/syn_subscripts.at 1970-01-01 00:00:00.000000000 +0000 @@ -1,186 +0,0 @@ -## Copyright (C) 2003-2012, 2014 Free Software Foundation, Inc. -## Written by Keisuke Nishida, Roger While, Simon Sobisch -## -## This file is part of GnuCOBOL. -## -## The GnuCOBOL compiler is free software: you can redistribute it -## and/or modify it under the terms of the GNU General Public License -## as published by the Free Software Foundation, either version 3 of the -## License, or (at your option) any later version. -## -## GnuCOBOL is distributed in the hope that it will be useful, -## but WITHOUT ANY WARRANTY; without even the implied warranty of -## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -## GNU General Public License for more details. -## -## You should have received a copy of the GNU General Public License -## along with GnuCOBOL. If not, see . - -### GnuCOBOL Test Suite - -### ISO+IEC+1989-2002 8.4.1.2 Subscripts## 8.4.1.2.3 General rules - -AT_SETUP([Non-numeric subscript]) -AT_KEYWORDS([subscripts]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 G1. - 02 X PIC X OCCURS 10. - 01 I PIC X. - PROCEDURE DIVISION. - DISPLAY X(I) - END-DISPLAY. - DISPLAY X(I + 1) - END-DISPLAY. - STOP RUN. -]) - -AT_CHECK([$COMPILE_ONLY prog.cob], [1], , -[prog.cob:10: error: 'I' is not an integer value -prog.cob:12: error: 'I' is not a numeric value -]) - -AT_CLEANUP - - -AT_SETUP([Subscript range check]) -AT_KEYWORDS([subscripts]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 G1. - 02 X OCCURS 2. - 03 Y PIC X OCCURS 3. - PROCEDURE DIVISION. - DISPLAY X(0) - END-DISPLAY. - DISPLAY X(1) - END-DISPLAY. - DISPLAY X(2) - END-DISPLAY. - DISPLAY X(3) - END-DISPLAY. - DISPLAY Y(1, 0) - END-DISPLAY. - DISPLAY Y(1, 1) - END-DISPLAY. - DISPLAY Y(1, 3) - END-DISPLAY. - DISPLAY Y(1, 4) - END-DISPLAY. - STOP RUN. -]) - -AT_CHECK([$COMPILE_ONLY prog.cob], [1], , -[prog.cob:10: error: subscript of 'X' out of bounds: 0 -prog.cob:16: error: subscript of 'X' out of bounds: 3 -prog.cob:18: error: subscript of 'Y' out of bounds: 0 -prog.cob:24: error: subscript of 'Y' out of bounds: 4 -]) - -AT_CLEANUP - - -AT_SETUP([Subscript bounds with OCCURS DEPENDING ON]) -AT_KEYWORDS([runsubscripts subscripts odo]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 G. - 02 X PIC X OCCURS 4 TO 6 DEPENDING ON N. - 01 N PIC 9 VALUE 4. - PROCEDURE DIVISION. - DISPLAY X(0) - DISPLAY X(7) - STOP RUN. -]) - -AT_CHECK([$COMPILE_ONLY prog.cob], [1], , -[prog.cob:10: error: subscript of 'X' out of bounds: 0 -prog.cob:11: error: subscript of 'X' out of bounds: 7 -]) - -AT_CLEANUP - - -## 8.4.1.2.2 Syntax rules - -AT_SETUP([Subscripted item requires OCCURS clause]) -AT_KEYWORDS([subscripts]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 G. - 02 X PIC X. - PROCEDURE DIVISION. - DISPLAY G(1) - END-DISPLAY. - DISPLAY X(1) - END-DISPLAY. - STOP RUN. -]) - -AT_CHECK([$COMPILE_ONLY prog.cob], [1], , -[prog.cob:9: error: 'G' cannot be subscripted -prog.cob:11: error: 'X' cannot be subscripted -]) - -AT_CLEANUP - - -AT_SETUP([Number of subscripts]) -AT_KEYWORDS([subscripts]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 G1. - 02 X OCCURS 2. - 03 Y PIC X OCCURS 3. - PROCEDURE DIVISION. - DISPLAY X - END-DISPLAY. - DISPLAY X(1) - END-DISPLAY. - DISPLAY X(1, 2) - END-DISPLAY. - DISPLAY Y(1) - END-DISPLAY. - DISPLAY Y(1, 2) - END-DISPLAY. - DISPLAY Y(1, 2, 3) - END-DISPLAY. - STOP RUN. -]) - -AT_CHECK([$COMPILE_ONLY prog.cob], [1], [], -[prog.cob:10: error: 'X' requires one subscript -prog.cob:14: error: 'X' requires one subscript -prog.cob:16: error: 'Y' requires 2 subscripts -prog.cob:20: error: 'Y' requires 2 subscripts -]) - -AT_CHECK([$COMPILE_ONLY -frelax-syntax-checks prog.cob], [1], [], -[prog.cob:10: warning: subscript missing for 'X' - defaulting to 1 -prog.cob:14: error: 'X' requires one subscript -prog.cob:16: warning: subscript missing for 'Y' - defaulting to 1 -prog.cob:20: error: 'Y' requires 2 subscripts -]) - -AT_CLEANUP - diff -Nru gnucobol-4.0~early~20200606/tests/testsuite.src/syn_value.at gnucobol-5/tests/testsuite.src/syn_value.at --- gnucobol-4.0~early~20200606/tests/testsuite.src/syn_value.at 2020-06-06 20:52:00.000000000 +0000 +++ gnucobol-5/tests/testsuite.src/syn_value.at 1970-01-01 00:00:00.000000000 +0000 @@ -1,366 +0,0 @@ -## Copyright (C) 2003-2012, 2017-2018 Free Software Foundation, Inc. -## Written by Keisuke Nishida, Roger While, Simon Sobisch -## -## This file is part of GnuCOBOL. -## -## The GnuCOBOL compiler is free software: you can redistribute it -## and/or modify it under the terms of the GNU General Public License -## as published by the Free Software Foundation, either version 3 of the -## License, or (at your option) any later version. -## -## GnuCOBOL is distributed in the hope that it will be useful, -## but WITHOUT ANY WARRANTY; without even the implied warranty of -## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -## GNU General Public License for more details. -## -## You should have received a copy of the GNU General Public License -## along with GnuCOBOL. If not, see . - -### GnuCOBOL Test Suite - -### ISO+IEC+1989-2002 13.16.61 VALUE clause - -## 13.16.61.1 General format - -# Format 1 (data-item): DONE - -# Format 2 (table): TODO - -# Format 3 (condition-name): TODO - -# Format 4 (report-section): TODO - -# Format 5 (content-validation-entry): TODO - -## 13.16.61.2 Syntax rules - - -# 1) TODO - - -# 2) TODO - -AT_SETUP([Numeric item (integer)]) -AT_KEYWORDS([value size]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 X-SPACE PIC 999 VALUE SPACE. - 01 X-ABC PIC 999 VALUE "abc". - 01 X-12-3 PIC 999 VALUE 12.3. - 01 X-123 PIC 999 VALUE 123. - 01 X-1234 PIC 999 VALUE 1234. - PROCEDURE DIVISION. - STOP RUN. -]) - -AT_CHECK([$COMPILE_ONLY prog.cob], [1], , -[prog.cob:6: error: invalid VALUE clause -prog.cob:7: warning: numeric value is expected -prog.cob:8: warning: value size exceeds data size -prog.cob:10: warning: value size exceeds data size -]) - -AT_CLEANUP - - -AT_SETUP([Numeric item (non-integer)]) -AT_KEYWORDS([value size]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 X-12 PIC 99V9 VALUE 12. - 01 X-123 PIC 99V9 VALUE 123. - 01 X-12-3 PIC 99V9 VALUE 12.3. - 01 X-12-34 PIC 99V9 VALUE 12.34. - PROCEDURE DIVISION. - STOP RUN. -]) - -AT_CHECK([$COMPILE_ONLY prog.cob], [0], [], -[prog.cob:7: warning: value size exceeds data size -prog.cob:9: warning: value size exceeds data size -]) - -AT_CLEANUP - - -AT_SETUP([Numeric item with picture P]) -AT_KEYWORDS([value size]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 X-99PP-0 PIC 99PP VALUE 0. - 01 X-99PP-1200 PIC 99PP VALUE 1200. - 01 X-99PP-1230 PIC 99PP VALUE 1230. - 01 X-99PP-10000 PIC 99PP VALUE 10000. - 01 X-PP99--0 PIC PP99 VALUE .0. - 01 X-PP99--0012 PIC PP99 VALUE .0012. - 01 X-PP99--0123 PIC PP99 VALUE .0123. - 01 X-PP99--00001 PIC PP99 VALUE .00001. - PROCEDURE DIVISION. - STOP RUN. -]) - -AT_CHECK([$COMPILE_ONLY prog.cob], [0], [], -[prog.cob:8: warning: value does not fit the picture string -prog.cob:9: warning: value size exceeds data size -prog.cob:12: warning: value does not fit the picture string -prog.cob:13: warning: value size exceeds data size -]) - -AT_CLEANUP - - -# 3) DONE - -AT_SETUP([Signed numeric literal]) -AT_KEYWORDS([value]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 X-9P PIC 9 VALUE +1. - 01 X-9N PIC 9 VALUE -1. - 01 X-S9P PIC S9 VALUE +1. - 01 X-S9N PIC S9 VALUE -1. - PROCEDURE DIVISION. - STOP RUN. -]) - -AT_CHECK([$COMPILE_ONLY prog.cob], [1], , -[prog.cob:6: error: data item not signed -prog.cob:7: error: data item not signed -]) - -AT_CLEANUP - - -# 4) DONE - -AT_SETUP([Alphabetic item]) -AT_KEYWORDS([value size]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 X-123 PIC AAA VALUE 123. - 01 X-ZERO PIC AAA VALUE ZERO. - 01 X-AB1 PIC AAA VALUE "ab1". - 01 X-ABC PIC AAA VALUE "abc". - 01 X-ABCD PIC AAA VALUE "abcd". - PROCEDURE DIVISION. - STOP RUN. -]) - -AT_CHECK([$COMPILE_ONLY prog.cob], [1], , -[prog.cob:6: warning: alphanumeric value is expected -prog.cob:7: error: invalid VALUE clause -prog.cob:8: warning: value does not fit the picture string -prog.cob:10: warning: value size exceeds data size -]) - -AT_CLEANUP - - -AT_SETUP([Alphanumeric item]) -AT_KEYWORDS([value size]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 X-123 PIC XXX VALUE 123. - 01 X-ABC PIC XXX VALUE "abc". - 01 X-ABCD PIC XXX VALUE "abcd". - 01 X-SPACE PIC XXX VALUE "abc ". - PROCEDURE DIVISION. - STOP RUN. -]) - -AT_CHECK([$COMPILE_ONLY prog.cob], [0], [], -[prog.cob:6: warning: alphanumeric value is expected -prog.cob:8: warning: value size exceeds data size -prog.cob:9: warning: value does not fit the picture string -]) - -AT_CLEANUP - - -AT_SETUP([Alphanumeric group item]) -AT_KEYWORDS([value size]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 G-1 VALUE 123. - 02 X PIC XXX. - 01 G-2 VALUE "abc". - 02 X PIC XXX. - 01 G-3 VALUE "abcd". - 02 X PIC XXX. - PROCEDURE DIVISION. - STOP RUN. -]) - -AT_CHECK([$COMPILE_ONLY prog.cob], [0], [], -[prog.cob:6: warning: alphanumeric value is expected -prog.cob:10: warning: value size exceeds data size -]) - -AT_CLEANUP - - -# 5) TODO - -# 6) TODO - -# 7) DONE - - -# 8) DONE - -AT_SETUP([Numeric-edited item]) -AT_KEYWORDS([value editing size]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 X-SPACE PIC **99.00 VALUE SPACE. - 01 X-123 PIC **999.00 VALUE 123. - 01 X-ABC PIC **99.00 VALUE "abc". - 01 X-MATCH PIC **99.00 VALUE "*123.00". - 01 X-OVERFLOW PIC **99.00 VALUE "*123.000". - PROCEDURE DIVISION. - MOVE 320.00 TO X-123 - STOP RUN. -]) - -AT_CHECK([$COMPILE_ONLY prog.cob], [0], [], -[prog.cob:10: warning: value size exceeds data size -]) -AT_CHECK([$COMPILE_ONLY -std=ibm-strict prog.cob], [1], [], -[prog.cob:7: error: numeric literal in VALUE clause of numeric-edited item used -prog.cob:10: warning: value size exceeds data size -]) -AT_CHECK([$COMPILE_ONLY -std=ibm prog.cob], [0], [], -[prog.cob:7: warning: numeric literal in VALUE clause of numeric-edited item used -prog.cob:10: warning: value size exceeds data size -]) - -AT_CLEANUP - - -AT_SETUP([Alphanumeric-edited item]) -AT_KEYWORDS([value editing size]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 X-123 PIC BXX VALUE 123. - 01 X-ABC PIC BXX VALUE "abc". - 01 X-MATCH PIC BXX VALUE " ab". - 01 X-OVERFLOW PIC BXX VALUE " abc". - PROCEDURE DIVISION. - STOP RUN. -]) - -AT_CHECK([$COMPILE_ONLY prog.cob], [0], [], -[prog.cob:6: warning: alphanumeric value is expected -prog.cob:9: warning: value size exceeds data size -]) - -AT_CLEANUP - - -# 9) TODO - -# 10) DONE (tested in syn_redefines.at) - -# 11) TODO - -# 12) TODO - -# 13) TODO - -# 14) TODO - -# 15) TODO - -# 16) TODO - -# 17) TODO - -# 18) TODO - -# 19) TODO - -# 20) DONE - -# 21) TODO - -# 22) TODO - -# 23) TODO - -# 24) TODO - -# 25) TODO - -# 26) TODO - -# 27) TODO - -# 28) TODO - -# 29) TODO - - - -AT_SETUP([Implicit picture from value]) -AT_KEYWORDS([value]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 IMPHEAD. - 05 IMPPIC VALUE " abc". - PROCEDURE DIVISION. - DISPLAY IMPPIC END-DISPLAY - STOP RUN. -]) - -# Check: should we raise an error without -frelax-syntax-checks? -#AT_CHECK([$COMPILE_ONLY prog.cob], [1], [], -#[prog.cob:7: error: PICTURE clause required for 'IMPPIC' -#]) - -AT_CHECK([$COMPILE_ONLY -frelax-syntax-checks prog.cob], [0], [], -[prog.cob:7: warning: defining implicit picture size 4 for 'IMPPIC' -]) - -AT_CHECK([$COMPILE_ONLY -frelax-syntax-checks -w prog.cob], [0], [], []) - -AT_CLEANUP diff -Nru gnucobol-4.0~early~20200606/tests/testsuite.src/used_binaries.at gnucobol-5/tests/testsuite.src/used_binaries.at --- gnucobol-4.0~early~20200606/tests/testsuite.src/used_binaries.at 2020-06-06 20:52:00.000000000 +0000 +++ gnucobol-5/tests/testsuite.src/used_binaries.at 1970-01-01 00:00:00.000000000 +0000 @@ -1,649 +0,0 @@ -## Copyright (C) 2014-2020 Free Software Foundation, Inc. -## Written by Simon Sobisch, Brian Tiffin -## -## This file is part of GnuCOBOL. -## -## The GnuCOBOL compiler is free software: you can redistribute it -## and/or modify it under the terms of the GNU General Public License -## as published by the Free Software Foundation, either version 3 of the -## License, or (at your option) any later version. -## -## GnuCOBOL is distributed in the hope that it will be useful, -## but WITHOUT ANY WARRANTY; without even the implied warranty of -## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -## GNU General Public License for more details. -## -## You should have received a copy of the GNU General Public License -## along with GnuCOBOL. If not, see . - -### GnuCOBOL Test Suite - - -## Note: cobc -c file / cobc --config=file -## and cobcrun -c file / cobcrun --config=file -## are tested via configuration.at - - -AT_SETUP([Compiler help and information]) -AT_KEYWORDS([runmisc cobc]) - -# FIXME: check at least some parts of the output by using $GREP -AT_CHECK([$COBC --version], [0], [ignore], []) -AT_CHECK([$COBC --help], [0], [ignore], []) -AT_CHECK([$COBC --info], [0], [ignore], []) -AT_CHECK([$COBC --list-reserved], [0], [ignore], []) -AT_CHECK([$COBC --list-registers], [0], [ignore], []) -AT_CHECK([$COBC --list-intrinsics], [0], [ignore], []) -AT_CHECK([$COBC --list-mnemonics], [0], [ignore], []) -AT_CHECK([$COBC -std=mf --list-reserved], [0], [ignore], []) -AT_CHECK([$COBC -std=acu --list-registers], [0], [ignore], []) -AT_CHECK([$COBC -std=cobol2002 --list-intrinsics], [0], [ignore], []) -AT_CHECK([$COBC -std=ibm --list-mnemonics], [0], [ignore], []) -AT_CHECK([$COBC --list-system], [0], [ignore], []) -AT_CLEANUP - - -AT_SETUP([Compiler outputs (general)]) -AT_KEYWORDS([runmisc cobc]) - -AT_DATA([prog.cob],[ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 BLA PIC X(5) VALUE 'bluBb'. - PROCEDURE DIVISION. - DISPLAY BLA NO ADVANCING END-DISPLAY - STOP RUN. -]) - -AT_CHECK([$COBC -C prog.cob], [0], [ignore], [ignore]) -AT_CHECK([$COBC -v -c prog.c], [0], [ignore], [ignore]) -AT_CHECK([$COBC -v prog.$COB_OBJECT_EXT], [0], [ignore], [ignore]) -AT_CHECK([$COBCRUN prog], [0], [bluBb], []) -AT_CHECK([$COBC -x -C prog.cob], [0], [ignore], [ignore]) -AT_CHECK([$COBC -v -x -c prog.c], [0], [ignore], [ignore]) -AT_CHECK([$COBC -v -x prog.$COB_OBJECT_EXT -o progo], [0], [ignore], [ignore]) -AT_CHECK([$COBCRUN_DIRECT ./progo], [0], [bluBb], []) -AT_CHECK([$COBC -E prog.cob], [0], -[#line 1 "prog.cob" - - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 BLA PIC X(5) VALUE 'bluBb'. - PROCEDURE DIVISION. - DISPLAY BLA NO ADVANCING END-DISPLAY - STOP RUN. -], []) -AT_CHECK([$COBC -E -o prog.i prog.cob], [0], [], []) -AT_CHECK([$COBC -x prog.i], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [bluBb], []) -AT_CLEANUP - - -AT_SETUP([Compiler outputs (file specified)]) -AT_KEYWORDS([runmisc cobc]) - -AT_DATA([prog.cob],[ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 BLA PIC X(5) VALUE 'bluBb'. - PROCEDURE DIVISION. - DISPLAY BLA NO ADVANCING END-DISPLAY - STOP RUN. -]) - -AT_CHECK([$COBC prog.cob -o prog.c], [0], [], []) -AT_CHECK([$COBC prog.c -o prog.$COB_OBJECT_EXT], [0], [], []) -AT_CHECK([$COBC prog.$COB_OBJECT_EXT -o prog]) -AT_CHECK([$COBCRUN prog], [0], [bluBb], []) -AT_CHECK([$COBC -x prog.cob -o prog.c], [0], [], []) -AT_CHECK([$COBC -x prog.c -o prog.$COB_OBJECT_EXT], [0], [], []) -AT_CHECK([$COBC -x prog.$COB_OBJECT_EXT -o progo$COB_EXE_EXT], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./progo], [0], [bluBb], []) -AT_CHECK([$COBC prog.cob -o prog.i], [0], [], []) -AT_CHECK([$COBC -x prog.i -o prog$COB_EXE_EXT], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [bluBb], []) -AT_CLEANUP - - -AT_SETUP([Compiler outputs (path specified)]) -AT_KEYWORDS([runmisc cobc]) - -AT_DATA([prog.cob],[ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 BLA PIC X(5) VALUE 'bluBb'. - PROCEDURE DIVISION. - DISPLAY BLA NO ADVANCING END-DISPLAY - STOP RUN. -]) - -AT_CHECK([mkdir -p sub], [0], [], []) -AT_CHECK([$COBC prog.cob -o sub/prog.c], [0], [], []) -AT_CHECK([$COBC $(_return_path "sub/prog.c") -o $(_return_path "sub/prog.$COB_OBJECT_EXT")], [0], [], []) -AT_CHECK([$COBC $(_return_path "sub/prog.$COB_OBJECT_EXT") -o $(_return_path "sub/prog")]) -AT_CHECK([$COBCRUN -M $(_return_path "sub/") prog], [0], [bluBb], []) -AT_CHECK([$COBC -x prog.cob -o $(_return_path "sub/prog.c")], [0], [], []) -AT_CHECK([$COBC -x $(_return_path "sub/prog.c") -o $(_return_path "sub/prog.$COB_OBJECT_EXT")], [0], [], []) -AT_CHECK([$COBC -x $(_return_path "sub/prog.$COB_OBJECT_EXT") -o $(_return_path "sub/progo$COB_EXE_EXT")]) -AT_CHECK([$COBCRUN_DIRECT ./sub/progo], [0], [bluBb], []) -AT_CHECK([$COBC prog.cob -o $(_return_path "sub/prog.i")], [0], [], []) -AT_CHECK([$COBC -x sub/prog.i -o $(_return_path "sub/prog$COB_EXE_EXT")], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./sub/prog], [0], [bluBb], []) -AT_CLEANUP - - -AT_SETUP([Compiler outputs (assembler)]) -AT_KEYWORDS([runmisc cobc]) - -AT_DATA([prog.cob],[ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 BLA PIC X(5) VALUE 'bluBb'. - PROCEDURE DIVISION. - DISPLAY BLA NO ADVANCING END-DISPLAY - STOP RUN. -]) - -AT_CHECK([$COBC -v -S prog.cob], [0], [ignore], [ignore]) -AT_CHECK([test -f prog.s], [0], [], [], -# Previous test "failed" --> prog.s not available --> likely a VS build -# only check for file as cl.exe cannot create executables from self-created -# assembler sources -[AT_CHECK([test -f prog.asm], [0], [], [])], -# Previous test "passed" --> prog.s is available, test compilation and run -[AT_CHECK([$COBC -v prog.s], [0], [ignore], [ignore]) - AT_CHECK([$COBCRUN prog], [0], [bluBb], [])]) -AT_CHECK([$COBC -v -x -S prog.cob], [0], [ignore], [ignore]) -AT_CHECK([test -f prog.s], [0], [], [], -# Previous test "failed" --> prog.s not available --> likely a VS build -# only check for file as cl.exe cannot create executables from self-created -# assembler sources -[AT_CHECK([test -f prog.asm], [0], [], [])], -# Previous test "passed" --> prog.s is available, test compilation and run -[AT_CHECK([$COBC -v -x prog.s], [0], [ignore], [ignore]) - AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [bluBb], [])]) -AT_CLEANUP - - -AT_SETUP([Source file not found]) -AT_KEYWORDS([cobc runmisc]) - -AT_CHECK([$COMPILE_ONLY prog.cob], [1], [], -[cobc: prog.cob: No such file or directory -]) - -AT_CLEANUP - - -AT_SETUP([Temporary path invalid]) -AT_KEYWORDS([cobc runmisc]) - -# Note: may be either removed completely as there was a report about -# this test "failing" - or skipped as this very often fails for -# WIN32 builds - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - PROCEDURE DIVISION. - DISPLAY "OK" NO ADVANCING - END-DISPLAY. - EXIT PROGRAM. -]) - -AT_CHECK([TMPDIR="" TMP="notthere" TEMP="" $COMPILE prog.cob], [0], [], -[libcob: warning: Temporary directory TMP is invalid, adjust TMPDIR! -]) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [OK], []) -AT_CHECK([TMPDIR="" TMP="" TEMP="./prog.cob" $COMPILE prog.cob], [0], [], -[libcob: warning: Temporary directory TEMP is invalid, adjust TMPDIR! -]) -# TMPDIR is only checked when actually needed which is currently only the case -# for SORT -#AT_CHECK([TMPDIR="./prog.cob" $COBCRUN_DIRECT ./prog], [0], [OK], -#[libcob: warning: Temporary directory TEMP is invalid, adjust TMPDIR! -#]) -#AT_CHECK([COB_DISABLE_WARNINGS=1 TMPDIR="./prog.cob" $COBCRUN_DIRECT ./prog], [0], [OK], -#[libcob: warning: Temporary directory TEMP is invalid, adjust TMPDIR! -#]) - -AT_CLEANUP - - -AT_SETUP([Using full path for cobc]) -AT_KEYWORDS([runmisc]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - PROCEDURE DIVISION. - DISPLAY "OK" NO ADVANCING - END-DISPLAY. - EXIT PROGRAM. -]) - -AT_CHECK([$COMPILE "$(_return_path "$(pwd)/prog.cob")"], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [OK], []) - -AT_CLEANUP - - -AT_SETUP([C Compiler optimizations]) -AT_KEYWORDS([runmisc cobc optimization]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - PROCEDURE DIVISION. - DISPLAY "OK" NO ADVANCING - END-DISPLAY. - EXIT PROGRAM. -]) - -AT_CHECK([$COMPILE -v -O -o prog prog.cob], [0], [ignore], [ignore]) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [OK], []) - -AT_CHECK([$COMPILE -v -O2 -o prog2 prog.cob], [0], [ignore], [ignore]) -AT_CHECK([$COBCRUN_DIRECT ./prog2], [0], [OK], []) - -AT_CHECK([$COMPILE -v -Os -o progs prog.cob], [0], [ignore], [ignore]) -AT_CHECK([$COBCRUN_DIRECT ./progs], [0], [OK], []) - -AT_CHECK([$COMPILE -v -O3 -o prog3 prog.cob], [0], [ignore], [ignore]) -AT_CHECK([$COBCRUN_DIRECT ./prog3], [0], [OK], []) - -AT_CHECK([$COMPILE -v -O0 -o prog prog.cob], [0], [ignore], [ignore]) -AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [OK], []) - -# last test with O2 (strips output) and output name -AT_CHECK([mkdir -p sub], [0], [], []) -AT_CHECK([$COMPILE_MODULE -v -O2 -o $(_return_path "sub/prog") prog.cob], [0], [ignore], [ignore]) -AT_CHECK([$COBCRUN -M sub/ prog], [0], [OK], []) -AT_CHECK([$COMPILE -v -O2 -o $(_return_path "sub/prog$COB_EXE_EXT") prog.cob], [0], [ignore], [ignore]) -AT_CHECK([$COBCRUN_DIRECT ./sub/prog], [0], [OK], []) - -AT_CLEANUP - - -AT_SETUP([Invalid cobc option]) -AT_KEYWORDS([runmisc cobc]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. -]) - -# normal option -AT_CHECK([$COMPILE -q --thisoptiondoesntexist prog.cob], [1], [], -[cobc: unrecognized option '--thisoptiondoesntexist' -]) -# flag -AT_CHECK([$COMPILE -q -flagdoesntexist prog.cob], [1], [], -[cobc: unrecognized option '-flagdoesntexist' -]) -# warning -AT_CHECK([$COMPILE -q -Wdoesntexist prog.cob], [1], [], -[cobc: unrecognized option '-Wdoesntexist' -]) - -AT_CLEANUP - - -AT_SETUP([cobcrun help and information]) -AT_KEYWORDS([runmisc cobcrun]) - -# FIXME: check at least some parts of the output by using $GREP -AT_CHECK([$COBCRUN --version], [0], [ignore], []) -AT_CHECK([$COBCRUN --help], [0], [ignore], []) -AT_CHECK([$COBCRUN --info], [0], [ignore], []) -AT_CLEANUP - - -AT_SETUP([cobcrun validation]) -AT_KEYWORDS([runmisc]) - -AT_DATA([callee.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. callee. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 WRK-VAR PIC X(5). - 01 EXT-VAR PIC X(5) EXTERNAL. - PROCEDURE DIVISION. - DISPLAY EXT-VAR NO ADVANCING - END-DISPLAY. - MOVE "World" TO EXT-VAR. - EXIT PROGRAM. -]) - -AT_DATA([caller.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. caller. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 EXT-VAR PIC X(5) EXTERNAL. - 01 WRK-VAR PIC X(5). - PROCEDURE DIVISION. - MOVE "Hello" TO EXT-VAR. - CALL "callee" - END-CALL. - DISPLAY EXT-VAR NO ADVANCING - END-DISPLAY. - STOP RUN. -]) - -AT_CHECK([$COMPILE_MODULE callee.cob], [0], [], []) -AT_CHECK([$COMPILE_MODULE caller.cob], [0], [], []) -AT_CHECK([$COBCRUN caller], [0], [HelloWorld], []) - -AT_CLEANUP - - -AT_SETUP([cobcrun -M DSO entry argument]) -AT_KEYWORDS([runmisc]) - -AT_DATA([callee.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. callee. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 EXT-VAR PIC X(5) EXTERNAL. - PROCEDURE DIVISION. - DISPLAY EXT-VAR END-DISPLAY. - MOVE "World" TO EXT-VAR. - EXIT PROGRAM. -]) - -AT_DATA([caller.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. caller. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 EXT-VAR PIC X(5) EXTERNAL. - PROCEDURE DIVISION. - MOVE "Hello" TO EXT-VAR. - CALL "callee" END-CALL. - DISPLAY EXT-VAR END-DISPLAY. - STOP RUN. - END PROGRAM caller. - - IDENTIFICATION DIVISION. - PROGRAM-ID. inside. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 EXT-VAR PIC X(5) EXTERNAL. - 01 CLA-VAR PIC X(5). - PROCEDURE DIVISION. - MOVE "Aloha" TO EXT-VAR. - CALL "callee" END-CALL. - DISPLAY EXT-VAR END-DISPLAY. - ACCEPT CLA-VAR FROM COMMAND-LINE END-ACCEPT. - DISPLAY CLA-VAR END-DISPLAY. - STOP RUN. - END PROGRAM inside. -]) - -AT_CHECK([$COMPILE_MODULE callee.cob], [0], [], []) -AT_CHECK([$COMPILE_MODULE caller.cob], [0], [], []) -AT_CHECK([$COBCRUN -M ./caller inside again], [0], -[Aloha -World -again -], []) - -AT_CLEANUP - - -## FIXME: missing tests: -## * combining $COBCRUN -M with COB_PRE_LOAD / COB_LIBRARY_PATH -## * $COBCRUN -m - - -AT_SETUP([cobcrun -M directory/ default]) -AT_KEYWORDS([runmisc]) - -AT_DATA([callee.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. callee. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 EXT-VAR PIC X(5) EXTERNAL. - PROCEDURE DIVISION. - DISPLAY EXT-VAR END-DISPLAY. - MOVE "World" TO EXT-VAR. - EXIT PROGRAM. -]) - -AT_DATA([caller.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. caller. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 EXT-VAR PIC X(5) EXTERNAL. - PROCEDURE DIVISION. - MOVE "Hello" TO EXT-VAR. - CALL "callee" END-CALL. - DISPLAY EXT-VAR END-DISPLAY. - STOP RUN. -]) - -AT_CHECK([$COMPILE_MODULE callee.cob], [0], [], []) -AT_CHECK([$COMPILE_MODULE caller.cob], [0], [], []) -AT_CHECK([$COBCRUN -M ./ caller], [0], -[Hello -World -], []) - - -AT_CLEANUP - - -AT_SETUP([cobcrun -M directory/dso alternate]) -AT_KEYWORDS([runmisc]) - -AT_DATA([callee.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. callee. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 EXT-VAR PIC X(5) EXTERNAL. - PROCEDURE DIVISION. - DISPLAY EXT-VAR END-DISPLAY. - MOVE "World" TO EXT-VAR. - EXIT PROGRAM. -]) - -AT_DATA([caller.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. caller. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 EXT-VAR PIC X(5) EXTERNAL. - PROCEDURE DIVISION. - MOVE "Hello" TO EXT-VAR. - CALL "callee" END-CALL. - DISPLAY EXT-VAR END-DISPLAY. - STOP RUN. - END PROGRAM caller. - - IDENTIFICATION DIVISION. - PROGRAM-ID. inside. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 EXT-VAR PIC X(5) EXTERNAL. - PROCEDURE DIVISION. - MOVE "Aloha" TO EXT-VAR. - CALL "callee" END-CALL. - DISPLAY EXT-VAR END-DISPLAY. - STOP RUN. - END PROGRAM inside. -]) - -AT_CHECK([$COMPILE_MODULE callee.cob], [0], [], []) -AT_CHECK([$COMPILE_MODULE caller.cob], [0], [], []) -AT_CHECK([$COBCRUN -M ./caller inside], [0], -[Aloha -World -], []) - -AT_CLEANUP - - -AT_SETUP([cobcrun -M DSO entry multiple arguments]) -AT_KEYWORDS([runmisc]) - -# Test that modules can be called with ARGUMENT-VALUES -AT_DATA([called.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. called. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 CLI-ARGS PIC X(27). - 01 ARG-TWO PIC X(6). - PROCEDURE DIVISION. - ACCEPT CLI-ARGS FROM COMMAND-LINE END-ACCEPT. - DISPLAY 2 UPON ARGUMENT-NUMBER END-DISPLAY. - ACCEPT ARG-TWO FROM ARGUMENT-VALUE END-ACCEPT. - DISPLAY CLI-ARGS ":" ARG-TWO END-DISPLAY. - EXIT PROGRAM. -]) - -AT_DATA([mainer.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. mainer. - PROCEDURE DIVISION. - STOP RUN. - END PROGRAM mainer. -]) - -AT_CHECK([$COBC -b ${FLAGS} mainer.cob called.cob], [0], [], []) -AT_CHECK([$COBCRUN -M ./mainer called "first argument" "second" "third"], [0], -[first argument second third:second -], []) - -# additional test with environment configuration settings removed: -AT_CHECK([unset COB_PRE_LOAD COB_LIBRARY_PATH; $COBCRUN -M ./mainer called "first argument" "second" "third"], [0], -[first argument second third:second -], []) - -# additional test with showing the preloaded environment -# FIXME: check at least some parts of the output ("configuration" and the expected output) by using $GREP -AT_CHECK([$COBCRUN -M ./mainer --runtime-conf called "first argument" "second" "third"], [0], -[ignore], []) - -AT_CLEANUP - - -AT_SETUP([cobcrun error messages]) -AT_KEYWORDS([runmisc]) - -AT_CHECK([$COBCRUN -q], [1], [], -[cobcrun: missing PROGRAM name -Try 'cobcrun --help' for more information. -]) -AT_CHECK([$COBCRUN -q -prog], [1], [], -[cobcrun: unrecognized option '-prog' -]) -AT_CHECK([$COBCRUN noprog], [1], [], -[libcob: error: module 'noprog' not found -]) -AT_CHECK([$COBCRUN -q -M], [1], [], -[cobcrun: option requires an argument -- M -]) -# FIXME - The following doesn't seem to work correct, -# we expect an error about missing module name -#AT_CHECK([$COBCRUN -q -M noprog], [1], [], []) - -AT_CLEANUP - - -AT_SETUP([Compile from stdin]) -AT_KEYWORDS([runmisc stdin]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. a. - DATA DIVISION. - WORKING-STORAGE SECTION. - PROCEDURE DIVISION. - STOP RUN WITH NORMAL STATUS. -]) - -AT_CHECK([cat prog.cob | $COMPILE -], [0], [], []) -AT_CHECK([$COBCRUN_DIRECT ./a.out], [0], [], []) - -AT_CHECK([cat prog.cob | $COMPILE_MODULE -], [0], [], []) -AT_CHECK([$COBCRUN a], [0], [], []) - -AT_CLEANUP - - -AT_SETUP([Run job after compilation]) -AT_KEYWORDS([runmisc job]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - PROCEDURE DIVISION. - DISPLAY "job" WITH NO ADVANCING END-DISPLAY - STOP RUN WITH NORMAL STATUS. -]) - -AT_CHECK([$COMPILE -jd prog.cob], [0], [job], []) -AT_CHECK([$COMPILE_MODULE -jd prog.cob], [0], [job], []) - -AT_CLEANUP - - -AT_SETUP([Run job after compilation (path specified)]) -AT_KEYWORDS([runmisc job]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - PROCEDURE DIVISION. - DISPLAY "job" WITH NO ADVANCING END-DISPLAY - STOP RUN WITH NORMAL STATUS. -]) - -AT_CHECK([mkdir -p sub], [0], [], []) -AT_CHECK([$COMPILE_MODULE -jd -o $(_return_path "sub/prog") prog.cob], [0], [job], []) -AT_CHECK([$COMPILE -jd -o $(_return_path "sub/prog$COB_EXE_EXT") prog.cob], [0], [job], []) - -AT_CLEANUP - - -AT_SETUP([Run job with optional arguments]) -AT_KEYWORDS([runmisc job]) - -AT_DATA([prog.cob], [ - IDENTIFICATION DIVISION. - PROGRAM-ID. prog. - DATA DIVISION. - WORKING-STORAGE SECTION. - 01 CLI PIC X(8). - PROCEDURE DIVISION. - ACCEPT CLI FROM COMMAND-LINE - DISPLAY CLI WITH NO ADVANCING END-DISPLAY - STOP RUN WITH NORMAL STATUS. -]) - -AT_CHECK([$COMPILE -j="job 123" prog.cob], [0], [job 123 ], []) -AT_CHECK([$COMPILE -jdg prog.cob], [0], [ ], []) -AT_CHECK([$COMPILE_MODULE --job=job123 prog.cob], [0], [job123 ], []) - -AT_CLEANUP diff -Nru gnucobol-4.0~early~20200606/THANKS gnucobol-5/THANKS --- gnucobol-4.0~early~20200606/THANKS 2020-06-06 20:52:02.000000000 +0000 +++ gnucobol-5/THANKS 1970-01-01 00:00:00.000000000 +0000 @@ -1,40 +0,0 @@ -Alain Lucari -Brian Tiffin -David Korn -Dave Pitts -Edward Hart -Joe Robbins (-2017) -Keiichi Takahashi -Keisuke Nishida -Peg -Richard Smith -Roger While (1950-2015) -Simon Sobisch -Thomas Biehler -William M. Klein -Yoshiki Kusumoto - -Also to the many people that have helped out in testing this product. -We hope that everybody will continue to provide feedback. This is invaluable -to the continuing development process. - -A special mention here of people who have provided exceptional support in terms -of time and resources on hardware that was not available to the developers: -Oleg Philon - For his work on the PowerPC -David Wilson - For his work on the MAC (Darwin) -Sergey Kashyrin - For his work on: - SUN Solaris - IBM AIX - HP-UX - -And continuing this amazing support: -Ludwin Janvier - patches concerning build/packaging issues -Hans-Martin Rasch - Work on compiler syntax -Michel Gouget - Work on syntax - IS -Bill Klein - The mainstay for COBOL questions -Frank Swarbrick - Work on compiler syntax -Warren Gay - For testing systems that we didn't known that we even support! - (eg. old DEC Alpha systems) -Ron Norman - Work on C/D/VB-ISAM handler - - Development of Report Writer -Fabrizio Calabretta - Work on the EXTFH interface diff -Nru gnucobol-4.0~early~20200606/TODO gnucobol-5/TODO --- gnucobol-4.0~early~20200606/TODO 2020-06-06 20:52:02.000000000 +0000 +++ gnucobol-5/TODO 1970-01-01 00:00:00.000000000 +0000 @@ -1,79 +0,0 @@ -GnuCOBOL TODO -*- outline -*- - -1 Pending requests - -1.1 Handling of EBCDIC files - - -2 Other features to be implemented - -2.1 New option handling. - -A new configuration file, cobc.conf, is described in -https://sourceforge.net/p/open-cobol/feature-requests/342/ -Integrate that file with existing command-line parsing, -allowing for overrides and warning-defeats as outlined in -that document. - -2.2 New preprocessor support. - -https://sourceforge.net/p/open-cobol/feature-requests/341/ defines -configuration for preprocessors. Add support for preprocessors to cobc. -Modify the -E option to be - - -E [preprocessor] - -meaning that all preprocessors should be run up to and including the -one named in the -E argument. If no argument is provided, -E -continues to work as currently. - -2.3 Embedded SQL - ship as sample configurations for 2.2 - -esqlOC - preprocessor by Sergey Kashyrin.Sergey Kashryin (ODBC) - -ocesql - https://github.com/opensourcecobol/Open-COBOL-ESQL (MySQL/ODBC) - -PostgreSQL using epcpg, wrapper for COBOL by Frank Polscheit (ruby based) -http://lists.gnu.org/archive/html/gnucobol-users/2004-02/msg00053.html - -Firebird (firebird.sourceforge.net) has a SQL preprocessor -for their database. - -Oracle Pro*COBOL - - -3 Improvement of compiler internals - -3.1 Error checking - -3.1.1 Strict error checking depending on the standard -Partially implemented - -3.1.2 Use `error' token in the parser for better error recovery - - -4 Optimization - -4.1 More inlining of run-time functions - -Done with various binary operands and expressions, open for some -intrinsic functions (actually using libcob at compile time). - - -5 Debugging support - -5.1 Data access method - -We should generate all data hierarchy defined in a COBOL program -with all relevant information, including data names, picture clauses, -and source locations. We should also define a debugging function -that receives a data name and displays its value using the generated -data hierarchy. By calling the function from gdb, we can easily -access the COBOL data at debugging time. - - -6 Better user manual - -Yes, we should, for now: refer to the GnuCOBOL Programmer's Guide -https://sourceforge.net/p/open-cobol/code/HEAD/tree/external-doc/guide/ -